├── .gitignore ├── CHANGES ├── COPYING ├── COPYING.LESSER ├── COPYRIGHTS ├── Examples ├── List │ ├── BEGIN │ ├── END │ ├── Makefile │ ├── README │ ├── argv-library.c │ ├── argv.alw │ ├── expected.output │ ├── io-library.c │ ├── io.alw │ ├── list.alw │ ├── test1.txt │ ├── test2.txt │ └── test3.txt ├── Logic │ ├── Makefile │ ├── README │ ├── argv.c │ ├── expected.output │ ├── logic.alw │ ├── logic.py │ ├── logic68.a68 │ ├── logicpas.pas │ └── tests.sh ├── Macro │ ├── Makefile │ ├── macro.1.md │ ├── macro.1.src │ ├── macro.alw │ ├── man.py │ ├── stip_begin.alw │ ├── stip_end.alw │ ├── test.expected │ └── test.input ├── Roman │ ├── BEGIN │ ├── END │ ├── Makefile │ ├── argv-library.c │ ├── argv.alw │ ├── expected.output │ ├── number.alw │ └── roman.alw ├── Wumpus │ ├── Makefile │ └── wumpus.alw └── test-cords │ ├── BEGIN │ ├── END │ ├── Makefile │ ├── README │ ├── cords.alw │ ├── cords.c │ ├── cords │ ├── README.txt │ ├── cord.h │ ├── cordbscs.c │ ├── cordprnt.c │ ├── cordtest.c │ ├── cordxtra.c │ ├── ec.h │ └── private │ │ └── cord_pos.h │ ├── file.alw │ ├── file.c │ └── try-it.alw ├── INSTALL.md ├── Makefile ├── Makefile.awe ├── Makefile.testparsing ├── OCamlMakefile ├── README.md ├── Tests ├── Argv-Multisource │ ├── Makefile │ ├── argv-headers.alw │ ├── argv.c │ ├── begin │ ├── end │ ├── expected.output │ └── program.alw ├── Argv │ ├── Makefile │ ├── argv.c │ ├── expected.output │ └── program.alw ├── ExternalRecords │ ├── Makefile │ ├── expected.output │ ├── external.txt │ ├── io-library.c │ └── program.alw ├── InitFlag │ └── withinit.alw ├── Makefile ├── Multifile-Error │ ├── Makefile │ ├── argv-headers.alw │ ├── begin.alw │ ├── end.alw │ ├── expected.output │ └── program.alw ├── OldParse │ ├── GRAMMAR │ ├── Makefile │ ├── expected.output │ └── original-parse.alw ├── Separate │ ├── Makefile │ ├── expected.output │ ├── program.alw │ └── separate.alw ├── SeparateC │ ├── Makefile │ ├── cprocedure.c │ ├── expected.output │ └── program.alw ├── Stderr-redirection │ ├── Makefile │ ├── expected-stderr.output │ ├── expected-stdout.output │ └── program.alw ├── Strings-as-bytes │ ├── Makefile │ ├── byte-access.c │ └── program.alw ├── Tracing │ ├── Makefile │ ├── expected.output │ ├── program.alw │ └── tracing.c ├── array-bounds-empty-arrays-2.alw ├── array-bounds-empty-arrays.alw ├── array-bounds-subscript-count.alw ├── array-bounds.alw ├── array-designator-as-parameter.alw ├── array-parameters-type-cast.alw ├── array-parameters-type-error.alw ├── array-parameters.alw ├── array-range.alw ├── array-references-init.alw ├── array-strings.alw ├── array.alw ├── arrays-multidimensional-range.alw ├── arrays-multidimensional.alw ├── begin ├── constants-range-bits-too-big.alw ├── constants-range-integer-too-big.alw ├── constants-range.alw ├── directives-lexical-error.alw ├── directives-source-position.alw ├── directives.alw ├── end ├── exceptions-divzero-complex.alw ├── exceptions-divzero.alw ├── exceptions-establishment.alw ├── exceptions-intdivzero.alw ├── expressions-case-incompatible.alw ├── expressions-case-too-high.alw ├── expressions-case-too-low.alw ├── expressions-case.alw ├── expressions-if-then-incompatible.alw ├── expressions-if-then-needs-else.alw ├── expressions-if-then-string-expressions.alw ├── expressions-if-then.alw ├── lexing-unclosed-comment.alw ├── lexing-unclosed-string.alw ├── long-comment-error-1.alw ├── long-comment-error-2.alw ├── long-comment-error-3.alw ├── long-comment.alw ├── operators-bits.alw ├── operators-integer-divide-by-0.alw ├── operators-integer-division.alw ├── operators-integer.alw ├── operators-logical-comparison.alw ├── operators-logical.alw ├── operators-pwr.alw ├── operators-real-divide-by-0.alw ├── operators-string-substring-negative-index.alw ├── operators-string-substring-too-long.alw ├── operators-string-substring.alw ├── operators-string.alw ├── operators-triplet-rule.alw ├── parser-declarations.dat ├── parser-expressions.dat ├── parser-lexing-operators.dat ├── parser-lexing.dat ├── parser-statements.dat ├── procedure-external-invalid.alw ├── procedure-external.alw ├── procedure-misnamed-block.alw ├── procedure-parameters-equality-2.alw ├── procedure-parameters-equality.alw ├── procedure-parameters-general.alw ├── procedure-parameters-hendrik.alw ├── procedure-parameters-incompatable.alw ├── procedure-parameters-manorboy.alw ├── procedure-parameters-name-manorboy.alw ├── procedure-parameters-name-name.alw ├── procedure-parameters-name.alw ├── procedure-parameters-procedure-incompatible.alw ├── procedure-parameters-procedure.alw ├── procedure-parameters-result-incompatible-2.alw ├── procedure-parameters-result-incompatible.alw ├── procedure-parameters.alw ├── procedure-result.alw ├── procedure-value-result.alw ├── procedure-value.alw ├── procedure-visibility.alw ├── program-exit-code-int.alw ├── program-exit-code-none.alw ├── program-exit-code-statement.alw ├── program-exit-code-wrong-type.alw ├── prototypes.alw ├── records-0.alw ├── records-allocation-expressions.alw ├── records-class-set-compatibility-error.alw ├── records-class-set-compatibility.alw ├── records-field-of-null-run-time.alw ├── records-fields-do-not-work-on-null.alw ├── records-fields-wrong-class-compile-time.alw ├── records-fields-wrong-class-run-time.alw ├── records-is-never-of-class.alw ├── records-is-null.alw ├── records-is.alw ├── records-parameters.alw ├── records-record-designator-class.alw ├── records-record-designators.alw ├── records-string-fields.alw ├── records-uninitialized-element.alw ├── records-uninitialized-field.alw ├── records-uninitialized-variable.alw ├── records-visibility.alw ├── records.alw ├── roman4.alw ├── standard-analysis-exp.alw ├── standard-analysis.alw ├── standard-predefined-variables.alw ├── standard-read-complex.alw ├── standard-read-exception-null.alw ├── standard-read-exception.alw ├── standard-read-integer.alw ├── standard-read-iocontrol.alw ├── standard-read-real.alw ├── standard-read-strings.alw ├── standard-read.alw ├── standard-readcard-eof.alw ├── standard-readcard-exception-eof.alw ├── standard-readcard-exception-null.alw ├── standard-readcard-exception.alw ├── standard-readcard.alw ├── standard-transfer-base.alw ├── standard-transfer-roundtoreal.alw ├── standard-transfer.alw ├── standard-write-eject-last-page.alw ├── standard-write-example.alw ├── standard-write-i_w.alw ├── standard-write-line-wrap.alw ├── standard-write-page-breaks-off.alw ├── standard-write-page-breaks.alw ├── standard-write-reference.alw ├── standard-writecard-error.alw ├── standard-writecard.alw ├── statements-assignment.alw ├── statements-block-empty.alw ├── statements-block-out-of-scope.alw ├── statements-block-overshadowed-2.alw ├── statements-block-overshadowed-3.alw ├── statements-block-overshadowed.alw ├── statements-block.alw ├── statements-case-too-high.alw ├── statements-case-too-low.alw ├── statements-case.alw ├── statements-for-control-variable-scope.alw ├── statements-for-list.alw ├── statements-for-step-0.alw ├── statements-for-step.alw ├── statements-for.alw ├── statements-goto-scope.alw ├── statements-goto-wrong-direction.alw ├── statements-goto.alw ├── statements-if.alw ├── statements-while-body-is-statement.alw ├── statements-while-is-statement.alw ├── statements-while.alw ├── string-case.alw ├── string-character-order.alw ├── string-comparisions.alw ├── string-constants-non-printing.alw ├── string-constants.alw ├── string-result-parameters.alw ├── string-substring-1.alw ├── string-substring-all-of-length-1.alw ├── string-substring-assignment-off-end.alw ├── string-substring-assignment-too-long.alw ├── string-substring-assignment.alw ├── string-substring-io.alw ├── string-substring-multiple-assignment.alw ├── string-substring-name-parameter.alw ├── string-substring-of-short-string.alw ├── string-too-long.alw ├── string-value-parameters.alw └── string.alw ├── Tools ├── Makefile ├── algolw.lang ├── algolw.ssh ├── awnest-test-file.alw ├── awnest.1 ├── awnest.mll └── expected.output ├── VERSION ├── algolw.pdf ├── algolw.tex ├── awe.1.md ├── awe.c ├── awe.h ├── awe.md ├── awe.mk ├── awe.mk.7.md ├── awe.ml ├── awearray.c ├── aweexcept.c ├── aweio.c ├── aweio.h ├── awestd.c ├── awestr.c ├── class.ml ├── class.mli ├── code.ml ├── code.mli ├── compiler.ml ├── dynArray.ml ├── dynArray.mli ├── email_address.png ├── github-markdown.css ├── htmltext.py ├── lexer.mll ├── location.ml ├── location.mli ├── man.py ├── markdown-to-html.py ├── options.ml ├── parser.mly ├── predeclared.ml ├── scanner.py ├── scope.ml ├── scope.mli ├── table.ml ├── table.mli ├── testparsing.mll ├── testprograms.ml ├── tree.ml ├── tree.mli ├── type.ml └── type.mli /.gitignore: -------------------------------------------------------------------------------- 1 | /awe.1 2 | /awe.mk.7 3 | *.o 4 | *.cmi 5 | *.cmo 6 | *.awe.c 7 | *.awe.h 8 | test.output 9 | actual*.output 10 | *.zip 11 | .hg 12 | .hgignore 13 | ._d 14 | ._bcdi 15 | .vscode 16 | .idea 17 | /scratch 18 | /awe.1.html 19 | /awe.html 20 | /awe.mk.7.html 21 | /awe 22 | /libawe.a 23 | /lexer.ml 24 | /parser.ml 25 | /parser.mli 26 | /scanner.dot 27 | /scanner.inc 28 | /testparsing 29 | /testparsing.ml 30 | /Tools/awnest.ml 31 | /Tools/awnest 32 | /Tests/Argv-Multisource/program 33 | /Tests/Argv/program 34 | /Tests/ExternalRecords/program 35 | /Tests/OldParse/parse 36 | /Tests/OldParse/parse.alw 37 | /Tests/Separate/program 38 | /Tests/Separate/program.c 39 | /Tests/Separate/separate.c 40 | /Tests/SeparateC/program 41 | /Tests/Stderr-redirection/program 42 | /Tests/Strings-as-bytes/program 43 | /Tests/Tracing/program 44 | /INSTALL.html 45 | /Examples/List/list 46 | /Examples/Macro/macro 47 | /Examples/Roman/roman 48 | /Examples/test-cords/test-cords 49 | /Examples/Logic/logicpas 50 | /Examples/Logic/logic 51 | /Examples/Logic/Logic.tar.gz 52 | testme* 53 | a.out 54 | x.c 55 | -------------------------------------------------------------------------------- /COPYRIGHTS: -------------------------------------------------------------------------------- 1 | ────────────────────────────────────────────────────────────────────── 2 | AWE COPYRIGHTS 3 | ────────────────────────────────────────────────────────────────────── 4 | 5 | The Awe test suite contains 'parser.alw', a parser generator by 6 | Hendrik Boom, it remains copyright to its author, but is used here 7 | with permission. 8 | 9 | An Awe example program uses Hans Boehm's Cords library, it is 10 | copyright to Xerox Corporation, under an open source licence. 11 | 12 | The example program "macro" is derived from the source code 13 | provided for the book Software Tools in Pascal by Brian W. Kernighan 14 | and P. J. Plauger, Copyright (C) 1981 by Bell Laboratories, Inc. 15 | and Whitesmiths Ltd. 16 | 17 | The Awe makefile uses OCamlMakefile, copyright Markus Mottl, 18 | under the GPL licence. 19 | 20 | Otherwise, Copyright 2012, 2020 by Glyn Webster. 21 | 22 | Awe is free software: you can redistribute it and/or modify it 23 | under the terms of the GNU General Public and Lesser GNU General 24 | Public licenses as published by the Free Software Foundation, either 25 | version 3 of the License, or (at your option) any later version. 26 | 27 | Awe is distributed in the hope that it will be useful, 28 | but WITHOUT ANY WARRANTY; without even the implied warranty of 29 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 30 | GNU General Public License for more details. 31 | 32 | You should have received a copy of the GNU General Public 33 | License along with Awe. If not, see . 34 | -------------------------------------------------------------------------------- /Examples/List/BEGIN: -------------------------------------------------------------------------------- 1 | comment 2 | A "begin" to let the contents of a following 3 | sequence of source files exist in the same scope, 4 | which gives you a primitive module system. 5 | The idea is that you do something like this: 6 | 7 | awe BEGIN defs1.alw defs1.alw prog.alw END -o prog.c ; 8 | BEGIN 9 | -------------------------------------------------------------------------------- /Examples/List/END: -------------------------------------------------------------------------------- 1 | comment 2 | An "end" to let the contents of a preceeding 3 | sequence of source files exist in the same scope, 4 | which gives you a primitive module system. 5 | The idea is that you do something like this: 6 | 7 | awe BEGIN defs1.alw defs1.alw prog.alw END -c prog.c 8 | 9 | (Note that prog.alw cannot end on a fullstop.) ; 10 | END. 11 | -------------------------------------------------------------------------------- /Examples/List/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = list 2 | ALGOLW_SOURCES = BEGIN argv.alw io.alw list.alw END 3 | C_SOURCES = argv-library.c io-library.c 4 | C_INCLUDES = 5 | EXTRA_FILES = README test?.txt expected.output 6 | 7 | include awe.mk 8 | 9 | test : clean build 10 | ./list test1.txt test2.txt test3.txt test4.txt > actual.output 11 | diff --strip-trailing-cr expected.output actual.output 12 | rm actual.output 13 | echo "Success!" 14 | -------------------------------------------------------------------------------- /Examples/List/README: -------------------------------------------------------------------------------- 1 | This program lists files to the standard output with line numbers: 2 | 3 | list [files]... 4 | 5 | It's nothing fancy. 6 | 7 | But the code demonstrates how to use multiple Algol W source files as 8 | a primitive module system, how to write and use external procedures in 9 | C, and shows you a general-purpose Makefile for Algol W programs, 10 | which you can reuse. 11 | 12 | --Glyn -------------------------------------------------------------------------------- /Examples/List/argv-library.c: -------------------------------------------------------------------------------- 1 | /* argc.c -- external procedures to let Algol W programs to access argc and argv. */ 2 | 3 | #include "awe.h" 4 | #include 5 | #include 6 | #include 7 | 8 | 9 | #define STRING_LENGTH 100 /* This MUST match the string length in the Algol W declarations. */ 10 | 11 | 12 | /* Note: '_awe_argc' and '_awe_argc' are global copies of the 'main' function's arguments. */ 13 | 14 | 15 | int 16 | get_argc (void) 17 | { 18 | return _awe_argc; 19 | } 20 | 21 | 22 | int 23 | get_argv_length (int index) 24 | { 25 | assert(_awe_argv != NULL); 26 | if (index < 0 || index > _awe_argc) 27 | _awe_error(_awe_HERE, "attempted to access argv[%i], argc is %i\n", index, _awe_argc); 28 | assert(_awe_argv[index] != NULL); 29 | return strlen(_awe_argv[index]); 30 | } 31 | 32 | 33 | _awe_str 34 | get_argv (int index) 35 | { 36 | int len; 37 | 38 | assert(_awe_argv != NULL); 39 | if (index < 0 || index > _awe_argc) 40 | _awe_error(_awe_HERE, "attempted to access argv[%i], argc is %i\n", index, _awe_argc); 41 | assert(_awe_argv[index] != NULL); 42 | len = strlen(_awe_argv[index]); 43 | if (len > STRING_LENGTH) 44 | _awe_error(_awe_HERE, "strlen(argv[%i] == %i: greater than target string's length of %i", index, len, STRING_LENGTH); 45 | return _awe_str_cast(_awe_argv[index], len, STRING_LENGTH); 46 | } 47 | 48 | /* end */ 49 | -------------------------------------------------------------------------------- /Examples/List/argv.alw: -------------------------------------------------------------------------------- 1 | integer procedure argc; algol "get_argc"; 2 | string(100) procedure argv (integer value index); algol "get_argv"; 3 | integer procedure argv_length (integer value index); algol "get_argv_length"; 4 | -------------------------------------------------------------------------------- /Examples/List/expected.output: -------------------------------------------------------------------------------- 1 | test1.txt 2 | 0 |A rule appears in the makefile and says when and how to remake certain 3 | 1 |files, called the rule's targets (most often only one per rule). It 4 | 2 |lists the other files that are the dependencies of the target, and 5 | 3 |commands to use to create or update the target. 6 | test2.txt 7 | 0 |The order of rules is not significant, except for determining the 8 | 1 |default goal: the target for make to consider, if you do not otherwise 9 | 2 |specify one. The default goal is the target of the first rule in the 10 | 3 |first makefile. If the first rule has multiple targets, only the first 11 | 4 |target is taken as the default. There are two exceptions: a target 12 | 5 |starting with a period is not a default unless it contains one or more 13 | 6 |slashes, `/', as well; and, a target that defines a pattern rule has 14 | 7 |no effect on the default goal. (See section Defining and Redefining 15 | 8 |Pattern Rules.) 16 | test3.txt 17 | 0 |Therefore, we usually write the makefile so that the first rule is the 18 | 1 |one for compiling the entire program or all the programs described by 19 | 2 |the makefile (often with a target called `all'). See section Arguments 20 | 3 |to Specify the Goals. 21 | Cannot open test4.txt 22 | -------------------------------------------------------------------------------- /Examples/List/io-library.c: -------------------------------------------------------------------------------- 1 | /* io.c --very simple I/O library for Algol W programs */ 2 | 3 | /* This provides the functions for the external procdure declarations in io.alw. */ 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include "awe.h" 11 | 12 | 13 | #define LINE_LENGTH 256 /* This MUST match the result string lengths in io.alw. */ 14 | #define PATH_LENGTH 256 /* This MUST match the path string lengths in io.alw. */ 15 | 16 | 17 | void * 18 | algolw_open (_awe_str path, _awe_str mode) 19 | { 20 | FILE *f; 21 | 22 | char c_path [PATH_LENGTH + 1]; 23 | char c_mode [3]; 24 | 25 | _awe_str_unpadded_copy(c_path, path, PATH_LENGTH); 26 | _awe_str_unpadded_copy(c_mode, mode, 2); 27 | 28 | f = fopen(c_path, c_mode); 29 | if (f == NULL) 30 | /* We want to demonstrate returning a NULL pointer as a reference here, so: */ 31 | return NULL; 32 | /* _awe_error(_awe_HERE, "algolw_open: '%s': %s", c_path, strerror(errno)); */ 33 | else 34 | return (void*)f; 35 | } 36 | 37 | 38 | void 39 | algolw_readline (void *f, _awe_str line, int *success) 40 | { 41 | char *s; 42 | size_t size; 43 | ssize_t len; 44 | 45 | size = LINE_LENGTH + 2; /* allow for "\n\0" at end of line */ 46 | s = (char *)malloc(size); 47 | assert(s); 48 | 49 | len = getline(&s, &size, (FILE*)f); /* Note: this a GNU C function. */ 50 | if (ferror((FILE*)f)) 51 | _awe_error(_awe_HERE, "algolw_readline: %s", strerror(errno)); 52 | assert (len >= -1); 53 | 54 | if (len == -1) { /* at EOF */ 55 | _awe_str_init(line, LINE_LENGTH); /* clear the string */ 56 | *success = 0; 57 | } 58 | else { 59 | if (len > 0 && s[len - 1] == '\n') --len; 60 | assert(len <= LINE_LENGTH); 61 | _awe_str_cpy(line, LINE_LENGTH, s, len); 62 | *success = 1; 63 | } 64 | free(s); 65 | }; 66 | 67 | 68 | void 69 | algolw_writeline (void * f, _awe_str line) 70 | { 71 | int i, len; 72 | 73 | assert(line); 74 | if (f == NULL) 75 | _awe_error(_awe_HERE, "algolw_writeline: File handle is NULL"); 76 | 77 | len = _awe_str_unpadded_length(line, LINE_LENGTH); 78 | for (i = 0; i < len; ++i) 79 | if (fputc(line[i], (FILE*)f) == EOF) 80 | _awe_error(_awe_HERE, "algolw_writeline: %s", strerror(errno)); 81 | if (fputc('\n', (FILE*)f) == EOF) 82 | _awe_error(_awe_HERE, "algolw_writeline: %s", strerror(errno)); 83 | } 84 | 85 | 86 | void 87 | algolw_close (void * f) 88 | { 89 | if (f == NULL) 90 | _awe_error(_awe_HERE, "algolw_close: File handle is NULL"); 91 | 92 | if (fclose((FILE*)f) != 0) 93 | _awe_error(_awe_HERE, "algolw_close: %s", strerror(errno)); 94 | } 95 | 96 | /* end */ 97 | -------------------------------------------------------------------------------- /Examples/List/io.alw: -------------------------------------------------------------------------------- 1 | % io.alw -- simple file I/O procedures % 2 | 3 | % (This file is a header for functions in io-library.c) % 4 | 5 | record file_handle (integer dummy); 6 | 7 | reference(file_handle) procedure open ( string(256) value path; 8 | string(2) value mode ); 9 | algol "algolw_open"; 10 | 11 | procedure readline ( reference(file_handle) value handle; 12 | string(256) result line; 13 | logical result success ); 14 | algol "algolw_readline"; 15 | 16 | procedure writeline ( reference(file_handle) value handle; 17 | string(256) value line ); 18 | algol "algolw_writeline"; 19 | 20 | procedure close (reference(file_handle) value handle); 21 | algol "algolw_close"; 22 | -------------------------------------------------------------------------------- /Examples/List/list.alw: -------------------------------------------------------------------------------- 1 | % list -- list the files named in this program's arguments % 2 | 3 | % This program requires io.alw amd argv.alw % 4 | 5 | begin 6 | iocontrol(11000); % ignore line widths % 7 | for i := 1 until argc - 1 do 8 | begin 9 | reference(file_handle) file; 10 | string(256) path; 11 | path := argv(i); 12 | file := open(path, "r"); 13 | if file = null then 14 | write("Cannot open ", path) 15 | else 16 | begin 17 | logical continue; 18 | string(256) line; 19 | integer linenum; 20 | linenum := 0; 21 | write(path); 22 | continue := true; 23 | while continue do 24 | begin 25 | readline(file, line, continue); 26 | if continue then 27 | write(i_w := 3, linenum, "|", line); 28 | linenum := linenum + 1 29 | end 30 | end 31 | end 32 | end 33 | -------------------------------------------------------------------------------- /Examples/List/test1.txt: -------------------------------------------------------------------------------- 1 | A rule appears in the makefile and says when and how to remake certain 2 | files, called the rule's targets (most often only one per rule). It 3 | lists the other files that are the dependencies of the target, and 4 | commands to use to create or update the target. 5 | -------------------------------------------------------------------------------- /Examples/List/test2.txt: -------------------------------------------------------------------------------- 1 | The order of rules is not significant, except for determining the 2 | default goal: the target for make to consider, if you do not otherwise 3 | specify one. The default goal is the target of the first rule in the 4 | first makefile. If the first rule has multiple targets, only the first 5 | target is taken as the default. There are two exceptions: a target 6 | starting with a period is not a default unless it contains one or more 7 | slashes, `/', as well; and, a target that defines a pattern rule has 8 | no effect on the default goal. (See section Defining and Redefining 9 | Pattern Rules.) 10 | -------------------------------------------------------------------------------- /Examples/List/test3.txt: -------------------------------------------------------------------------------- 1 | Therefore, we usually write the makefile so that the first rule is the 2 | one for compiling the entire program or all the programs described by 3 | the makefile (often with a target called `all'). See section Arguments 4 | to Specify the Goals. 5 | -------------------------------------------------------------------------------- /Examples/Logic/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = logic 2 | ALGOLW_SOURCES = logic.alw 3 | C_SOURCES = argv.c 4 | EXTRA_FILES = expected.output README logic68.a68 logicpas.pas tests.sh 5 | 6 | test : clean logic 7 | bash tests.sh ./logic 8 | ./logic '~a \/ b, a -> b' > actual.output 9 | diff --strip-trailing-cr expected.output actual.output 10 | 11 | # an additional cleaning rule: 12 | clean :: 13 | rm -f actual.output logicpas logicpas.o logic68 logic68.c logic68.o 14 | 15 | # Bonus Algol 68 program! You need Algol 68RS to compile this. 16 | logic68: logic68.a68 17 | ca -u AAAAAAA logic68.a68 18 | bash tests.sh ./logic68 19 | ./logic68 '~a \/ b, a -> b' > actual.output 20 | diff --strip-trailing-cr expected.output actual.output 21 | 22 | # Bonus Pascal program! You need Free Pascal to compile this. 23 | logicpas: logicpas.pas 24 | fpc logicpas.pas 25 | bash tests.sh ./logicpas 26 | ./logicpas '~a \/ b, a -> b' > actual.output 27 | diff --strip-trailing-cr expected.output actual.output 28 | 29 | include ../../awe.mk 30 | -------------------------------------------------------------------------------- /Examples/Logic/README: -------------------------------------------------------------------------------- 1 | This is a toy intepreter for predicates (boolean expressions). 2 | It produces a table of all possible valuations. You can put in 3 | multiple predicates separated by commas, all of them will be 4 | shown in the right hand columns. 5 | 6 | a b | ~a \/ b, a -> b 7 | 0 0 | 1 1 8 | 0 1 | 1 1 9 | 1 0 | 0 0 10 | 1 1 | 1 1 11 | 12 | The program compiles an infix expression into RPN notion and 13 | interprets that on a stack machine. It is the toy program that I write 14 | when learning a new computer language. (I've included my Pascal and 15 | Algol 68 versions for comparison.) 16 | 17 | This program is also a demonstration of how to mix Algol W and C code. 18 | The Algol W program uses C functions to access the command line. 19 | 20 | Boolean expression syntax: 21 | 22 | predicates = equivalence ("," equivalence)* 23 | equivalence = implication ("<->" implication)* 24 | implication = exclusiveOR ("->" exclusiveOR)* 25 | exclusiveOR = disjunction ("@" disjunction)* 26 | disjunction = conjunction ("\/" conjunction)* 27 | conjunction = unary ("/\" unary)* 28 | unary = "0" | "1" | variable | "~" unary | "(" equivalence ")" 29 | 30 | Variables are any letter but "T" or "F". Spaces are ignored. 31 | 32 | Alternative symbols: 33 | 34 | "/\" --> "." 35 | "\/" --> "+" 36 | "<->" --> "=" 37 | "->" --> ">" 38 | "0" --> "F" 39 | "1" --> "T" 40 | -------------------------------------------------------------------------------- /Examples/Logic/argv.c: -------------------------------------------------------------------------------- 1 | /* argc.c -- external procedures to let Algol W programs to access argc and argv. */ 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | #include "logic.awe.h" /* Prototypes for external procedures. Generated by the Makefile. */ 9 | 10 | 11 | #define STRING_LENGTH 100 /* This MUST match the string length in the Algol W declarations. */ 12 | 13 | 14 | /* Note: '_awe_argc' and '_awe_argc' are global copies of the 'main' function's arguments. */ 15 | 16 | 17 | int 18 | get_argc (void) 19 | { 20 | return _awe_argc; 21 | } 22 | 23 | 24 | int 25 | get_argv_length (int index) 26 | { 27 | assert(_awe_argv != NULL); 28 | if (index < 0 || index > _awe_argc) 29 | _awe_error(_awe_HERE, "attempted to access argv[%i], argc is %i\n", index, _awe_argc); 30 | assert(_awe_argv[index] != NULL); 31 | return strlen(_awe_argv[index]); 32 | } 33 | 34 | 35 | _awe_str 36 | get_argv (int index) 37 | { 38 | int len; 39 | 40 | assert(_awe_argv != NULL); 41 | if (index < 0 || index > _awe_argc) 42 | _awe_error(_awe_HERE, "attempted to access argv[%i], argc is %i\n", index, _awe_argc); 43 | assert(_awe_argv[index] != NULL); 44 | len = strlen(_awe_argv[index]); 45 | if (len > STRING_LENGTH) 46 | _awe_error(_awe_HERE, "strlen(argv[%i] == %i: greater than target string's length of %i", index, len, STRING_LENGTH); 47 | return _awe_str_cast(_awe_argv[index], len, STRING_LENGTH); 48 | } 49 | 50 | 51 | void 52 | do_exit (int code) 53 | { 54 | _awe_finalize(_awe_HERE); 55 | exit(code); 56 | } 57 | 58 | 59 | /* end */ 60 | -------------------------------------------------------------------------------- /Examples/Logic/expected.output: -------------------------------------------------------------------------------- 1 | 2 | a b | ~a \/ b, a -> b 3 | 0 0 | 1 1 4 | 0 1 | 1 1 5 | 1 0 | 0 0 6 | 1 1 | 1 1 7 | 8 | -------------------------------------------------------------------------------- /Examples/Logic/tests.sh: -------------------------------------------------------------------------------- 1 | #/bin/bash 2 | $1 -t 'A = A' 3 | $1 -t '~F = T' 4 | $1 -t '~T = F' 5 | $1 -t 'A \/ A = A' 6 | $1 -t 'A /\ A = A' 7 | $1 -t 'A /\ B = B /\ A' 8 | $1 -t 'A \/ B = B \/ A' 9 | $1 -t 'A /\ (B /\ C) = (A /\ B) /\ C' 10 | $1 -t 'A \/ (B \/ C) = (A \/ B) \/ C' 11 | $1 -t 'A /\ (B \/ C) = A /\ B \/ A /\ C' 12 | $1 -t 'A \/ (B /\ C) = (A \/ B) /\ (A \/ C)' 13 | $1 -t '~(A /\ B) = ~A \/ ~B' 14 | $1 -t '~(A \/ B) = ~A /\ ~B' 15 | $1 -t '~~A = A' 16 | $1 -t 'A /\ ~A = F' 17 | $1 -t 'A \/ ~A = T' 18 | $1 -t 'A /\ T = A' 19 | $1 -t 'A \/ F = A ' 20 | $1 -t 'A /\ F = F' 21 | $1 -t 'A \/ T = T' 22 | $1 -t 'A -> B = ~A \/ B' 23 | $1 -t '(A <-> B) = (A -> B) /\ (B -> A)' 24 | $1 -t 'A @ B = A /\ ~B \/ ~A /\ B' 25 | $1 -t 'A @ B = ~(A <-> B)' 26 | $1 -t '(A <-> (B <-> C)) = ((A <-> B) <-> C)' 27 | $1 -t 'T -> F = F' 28 | $1 -t 'A /\ B \/ C = (A /\ B) \/ C' 29 | $1 -t 'A \/ B /\ C = A \/ (B /\ C)' 30 | $1 -t 'A -> B -> C = (A -> B) -> C' 31 | $1 -t 'a.b = a /\ b' 32 | $1 -t 'a+b = a \/ b' 33 | $1 -t 'a>b = a -> b' 34 | $1 -t '(a=b) = (a <-> b)' 35 | $1 -t '0 = F' 36 | $1 -t '1 = T' 37 | -------------------------------------------------------------------------------- /Examples/Macro/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = macro 2 | ALGOLW_SOURCES = stip_begin.alw macro.alw stip_end.alw 3 | OTHER_FILES = test.input test.expected man.py macro.1.src 4 | 5 | BINDIR = /usr/local/bin 6 | MANDIR = /usr/local/share/man/man1 7 | 8 | .PHONY: build test install uninstall 9 | 10 | build: macro macro.1 test 11 | 12 | test: macro 13 | ./macro < test.input > test.output 14 | diff --strip-trailing-cr test.expected test.output 15 | 16 | install: 17 | install -m 755 -d $(BINDIR) $(MANDIR) 18 | install -m 755 -t $(BINDIR) macro 19 | install -m 644 -t $(MANDIR) macro.1 20 | 21 | uninstall: 22 | rm -f $(BINDIR)/macro 23 | rm -f $(MANDIR)/macro.1 24 | 25 | macro.1: 26 | python3 man.py macro.1.md macro.1 27 | 28 | clean:: 29 | rm -f test.output macro.1 30 | 31 | include awe.mk 32 | -------------------------------------------------------------------------------- /Examples/Macro/man.py: -------------------------------------------------------------------------------- 1 | #!/usr/env python3 2 | # man.py -- very simple markup preprocessor for man pages 3 | 4 | 5 | import re, time, sys 6 | 7 | def usage(): 8 | print('''usage: python3 man.py manpage.1.md manpage.1 MACRO="value"... 9 | 10 | This is a rough preprocessor to convert a subset of Markdown to man pages. 11 | A summary of the markup commands you can use in your src file: 12 | 13 | # PAGE TITLE / program name / program description 14 | ## heading 15 | *itatics* 16 | **bold** 17 | `monospace` 18 | {{MACRO}} 19 | ``` 20 | example code block 21 | ``` 22 | ''') 23 | sys.exit(1) 24 | 25 | if len(sys.argv) < 3: usage() 26 | 27 | macros = {'DATE': time.strftime("%Y-%m-%d"), 28 | 'YEAR': time.strftime("%Y")} 29 | for arg in sys.argv[3:]: 30 | m = re.match(r'([A-Z][A-Za-z0-9_]+)=(.*)', arg) 31 | if m: 32 | macros[m.group(1)] = m.group(2) 33 | else: 34 | usage() 35 | 36 | repls = [ 37 | (r'^###? +(.+?)$', r'.SH "\1"'), # ## heading 38 | (r'\*\*(.+?)\*\*', r'\\fB\1\\fR'), # **bold** 39 | (r'\*(.+?)\*', r'\\fI\1\\fR'), # *itatics* 40 | (r'`(.+?)`', r'\\fI\1\\fR'), # `monospace` 41 | (r'^(.+?) -$', r'\n.TP\n.B \1'), # definition - 42 | (r'^# +(.+?) */ *(.+?) */ *(.+?) *$', 43 | r'.TH \1 "{{DATE}}" "\2" "\3"'), # man page heading 44 | (r'{{(.+?)}}', 45 | lambda m: macros[m.group(1)]) ] # {{macro}} substitution 46 | 47 | 48 | with open(sys.argv[1], "r") as f: 49 | page = f.read() 50 | 51 | # split into text and code example sections, 52 | # odd-numbered sections will be code: 53 | sections = re.split('```[A-Za-z]*', page) 54 | 55 | with open(sys.argv[2], "w") as f: 56 | for i, s in enumerate(sections): 57 | if i % 2 == 0: # text section 58 | for pattern, repl in repls: 59 | s = re.sub(pattern, repl, s, flags=re.MULTILINE) 60 | else: # code section 61 | s = s.replace('\n', '\n ') 62 | s = '\n.nf\n' + s + '\n.fi\n' 63 | f.write(s) 64 | -------------------------------------------------------------------------------- /Examples/Macro/stip_end.alw: -------------------------------------------------------------------------------- 1 | % stip_end.alw -- 'Software Tools in Pascal' library for Algol W % 2 | 3 | % stip_begin.alw and stip_end.alw provide an outer block 4 | for programs writen in the 'Software Tools in Pascal' style, 5 | they define string and I/O functions very like those found in C. 6 | 7 | This file cleans up after the library and closes the block. % 8 | 9 | end; % program section % 10 | 11 | EXIT_POINT: 12 | 13 | stip_finialize; 14 | 15 | end; % library section % 16 | 17 | end. % global constants section % 18 | -------------------------------------------------------------------------------- /Examples/Macro/test.expected: -------------------------------------------------------------------------------- 1 | 2 | inc(abc) ---> inc(abc) 3 | define(inc,$1:=$1+1) inc(abc) ---> abc:=abc+1 4 | define(incr,$1 := $1 + $2) incr(x,3) ---> x := x + 3 5 | incr ---> := + 6 | incr() ---> := + 7 | incr(x) ---> x := x + 8 | incr(x,`6') ---> x := x + 6 9 | define(`dbl',(($1) * 2)) dbl(42) ---> ((42) * 2) 10 | incr(x,dbl(3)) ---> x := x + ((3) * 2) 11 | 12 | 13 | define(def,`define($1,$2)') 14 | def(a,xyz) a ---> xyz 15 | 16 | substr(123456789,1,1) ---> 1 17 | substr(123456789,9,1) ---> 9 18 | substr(123456789,9,2) ---> 9 19 | substr(123456789,3,5) ---> 34567 20 | substr(123456789,3,1) ---> 3 21 | substr(123456789,3,0) ---> 22 | substr(123456789,0,1) ---> 23 | substr(,1,1) ---> 24 | 25 | len(xyz) ---> 3 26 | len() ---> 0 27 | len ---> 0 28 | len(len(a)) ---> 1 29 | len(len(abcdeABCDE)) ---> 2 30 | 31 | ifelse(123,123,a,b) ---> a 32 | ifelse(123,,a,b) ---> b 33 | ifelse(123,456,a,b) ---> b 34 | ifelse(,,a,b) ---> a 35 | ifelse(test,,a,b) ---> b 36 | define(test,`') 37 | ifelse(test,,a,b) ---> a 38 | 39 | expr(100) ---> 100 40 | expr(20+30) ---> 50 41 | expr(2*5+10) ---> 20 42 | expr(10+2*5) ---> 20 43 | expr((10+2)*5) ---> 60 44 | expr(5*(10+2)) ---> 60 45 | expr(2*5+10/5) ---> 12 46 | expr(10+2*10/5) ---> 14 47 | expr((10+2)*(10/5)) ---> 24 48 | expr(x) ---> 0 49 | expr(1x) ---> 1 50 | expr(1+1x) ---> 2 51 | expr(x1) ---> 0 52 | expr(1&1) ---> 1 53 | expr(1&) ---> 1 54 | expr ---> 0 55 | 56 | changeq({}) {ab} `ab' ---> ab `ab' 57 | changeq() `ab' {ab} ---> ab {ab} 58 | -------------------------------------------------------------------------------- /Examples/Macro/test.input: -------------------------------------------------------------------------------- 1 | 2 | `inc(abc)' ---> inc(abc) 3 | `define(inc,$1:=$1+1) inc(abc)' ---> define(inc,$1:=$1+1) inc(abc) 4 | `define(incr,$1 := $1 + $2) incr(x,3)' ---> define(incr,$1 := $1 + $2) incr(x,3) 5 | `incr' ---> incr 6 | `incr()' ---> incr() 7 | `incr(x)' ---> incr(x) 8 | `incr(x,`6')' ---> incr(x,`6') 9 | `define(`dbl',(($1) * 2)) dbl(42)' ---> define(`dbl',(($1) * 2)) dbl(42) 10 | `incr(x,dbl(3))' ---> incr(x,dbl(3)) 11 | 12 | 13 | `define(def,`define($1,$2)')' define(def,`define($1,$2)') 14 | `def(a,xyz) a' ---> def(c,xyz) c 15 | 16 | `substr(123456789,1,1)' ---> substr(123456789,1,1) 17 | `substr(123456789,9,1)' ---> substr(123456789,9,1) 18 | `substr(123456789,9,2)' ---> substr(123456789,9,2) 19 | `substr(123456789,3,5)' ---> substr(123456789,3,5) 20 | `substr(123456789,3,1)' ---> substr(123456789,3,1) 21 | `substr(123456789,3,0)' ---> substr(123456789,3,0) 22 | `substr(123456789,0,1)' ---> substr(123456789,0,1) 23 | `substr(,1,1)' ---> substr(,1,1) 24 | 25 | `len(xyz)' ---> len(xyz) 26 | `len()' ---> len() 27 | `len' ---> len 28 | `len(len(a))' ---> len(len(a)) 29 | `len(len(abcdeABCDE))' ---> len(len(abcdeABCDEabcde)) 30 | 31 | `ifelse(123,123,a,b)' ---> ifelse(123,123,a,b) 32 | `ifelse(123,,a,b)' ---> ifelse(123,,a,b) 33 | `ifelse(123,456,a,b)' ---> ifelse(123,456,a,b) 34 | `ifelse(,,a,b)' ---> ifelse(,,a,b) 35 | `ifelse(test,,a,b)' ---> ifelse(test,,a,b) 36 | `define(test,`')' define(test,`') 37 | `ifelse(test,,a,b)' ---> ifelse(test,,a,b) 38 | 39 | `expr(100)' ---> expr(100) 40 | `expr(20+30)' ---> expr(20+30) 41 | `expr(2*5+10)' ---> expr(2*5+10) 42 | `expr(10+2*5)' ---> expr(10+2*5) 43 | `expr((10+2)*5)' ---> expr((10+2)*5) 44 | `expr(5*(10+2))' ---> expr(5*(10+2)) 45 | `expr(2*5+10/5)' ---> expr(2*5+10/5) 46 | `expr(10+2*10/5)' ---> expr(10+2*10/5) 47 | `expr((10+2)*(10/5))' ---> expr((10+2)*(10/5)) 48 | `expr(x)' ---> expr(x) 49 | `expr(1x)' ---> expr(1x) 50 | `expr(1+1x)' ---> expr(1+1x) 51 | `expr(x1)' ---> expr(x1) 52 | `expr(1&1)' ---> expr(1&1) 53 | `expr(1&)' ---> expr(1&) 54 | `expr' ---> expr 55 | 56 | `changeq({}) {ab} `ab'' ---> changeq({}) {ab} `ab' 57 | {changeq() `ab' {ab}} ---> changeq() `ab' {ab} 58 | -------------------------------------------------------------------------------- /Examples/Roman/BEGIN: -------------------------------------------------------------------------------- 1 | comment 2 | A "begin" to let the contents of a following 3 | sequence of source files exist in the same scope, 4 | which gives you a primitive module system. 5 | The idea is that you do something like this: 6 | 7 | awe BEGIN defs1.alw defs1.alw prog.alw END -o prog.c ; 8 | BEGIN 9 | -------------------------------------------------------------------------------- /Examples/Roman/END: -------------------------------------------------------------------------------- 1 | comment 2 | An "end" to let the contents of a preceeding 3 | sequence of source files exist in the same scope, 4 | which gives you a primitive module system. 5 | The idea is that you do something like this: 6 | 7 | awe BEGIN defs1.alw defs1.alw prog.alw END -c prog.c 8 | 9 | (Note that prog.alw cannot end on a fullstop.) ; 10 | END. 11 | -------------------------------------------------------------------------------- /Examples/Roman/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = roman 2 | ALGOLW_SOURCES = BEGIN argv.alw number.alw roman.alw END 3 | C_SOURCES = argv-library.c 4 | EXTRA_FILES = README expected.output 5 | 6 | test : build 7 | ./$(PROGRAM) 1 3999 849 ' + 83 ' 4890 -1 lolwut > actual.output 8 | diff --strip-trailing-cr expected.output actual.output 9 | rm actual.output 10 | 11 | clean:: 12 | rm -f actual.output 13 | 14 | include awe.mk 15 | -------------------------------------------------------------------------------- /Examples/Roman/argv-library.c: -------------------------------------------------------------------------------- 1 | /* argc.c -- external procedures to let Algol W programs to access argc and argv. */ 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | #include "roman.awe.h" 9 | 10 | #define STRING_LENGTH 100 /* This MUST match the string length in the Algol W declarations. */ 11 | 12 | 13 | /* Note: '_awe_argc' and '_awe_argc' are global copies of the 'main' function's arguments. */ 14 | 15 | 16 | int 17 | get_argc (void) 18 | { 19 | return _awe_argc; 20 | } 21 | 22 | 23 | int 24 | get_argv_length (int index) 25 | { 26 | assert(_awe_argv != NULL); 27 | if (index < 0 || index > _awe_argc) 28 | _awe_error(_awe_HERE, "attempted to access argv[%i], argc is %i\n", index, _awe_argc); 29 | assert(_awe_argv[index] != NULL); 30 | return strlen(_awe_argv[index]); 31 | } 32 | 33 | 34 | _awe_str 35 | get_argv (int index) 36 | { 37 | int len; 38 | 39 | assert(_awe_argv != NULL); 40 | if (index < 0 || index > _awe_argc) 41 | _awe_error(_awe_HERE, "attempted to access argv[%i], argc is %i\n", index, _awe_argc); 42 | assert(_awe_argv[index] != NULL); 43 | len = strlen(_awe_argv[index]); 44 | if (len > STRING_LENGTH) 45 | _awe_error(_awe_HERE, "strlen(argv[%i]) == %i: greater than the Algol W target string's length of %i", index, len, STRING_LENGTH); 46 | return _awe_str_cast(_awe_argv[index], len, STRING_LENGTH); 47 | } 48 | 49 | /* end */ 50 | -------------------------------------------------------------------------------- /Examples/Roman/argv.alw: -------------------------------------------------------------------------------- 1 | integer procedure argc; algol "get_argc"; 2 | string(100) procedure argv (integer value index); algol "get_argv"; 3 | integer procedure argv_length (integer value index); algol "get_argv_length"; 4 | -------------------------------------------------------------------------------- /Examples/Roman/expected.output: -------------------------------------------------------------------------------- 1 | I 2 | MMMCMXCIX 3 | DCCCXLIX 4 | LXXXIII 5 | The Romans didn't think that big. 6 | The Romans didn't think that small. 7 | Not an number. 8 | -------------------------------------------------------------------------------- /Examples/Roman/number.alw: -------------------------------------------------------------------------------- 1 | comment number.alw --- read a decimal number out of a string; 2 | 3 | procedure number (string(256) value s; integer result r; logical result okay); 4 | begin 5 | integer i; 6 | logical negative; 7 | logical procedure inside; i < 256; 8 | procedure spaces; while inside and s(i|1) = " " do i := i + 1; 9 | r := 0; 10 | i := 0; 11 | negative := false; 12 | okay := true; 13 | spaces; 14 | if inside and s(i|1) = "+" then 15 | i := i + 1 16 | else if inside and s(i|1) = "-" then 17 | begin negative := true; i := i + 1 end; 18 | spaces; 19 | if ~inside then okay := false; 20 | while okay and inside and s(i|1) >= "0" and s(i|1) <= "9" do 21 | begin 22 | integer r0; 23 | r0 := r; 24 | r := r * 10 + (decode(s(i|1)) - decode("0")); 25 | if r < r0 then okay := false; % overflow % 26 | i := i + 1; 27 | end; 28 | spaces; 29 | if inside then okay := false; % there is something after the spaces % 30 | if negative then r := -r 31 | end number; 32 | -------------------------------------------------------------------------------- /Examples/Roman/roman.alw: -------------------------------------------------------------------------------- 1 | comment roman.alw -- converts a numeric argument to roman; 2 | comment depends on number.alw, argv.alw; 3 | 4 | begin 5 | procedure roman (integer value number; string(15) result characters; integer result length); 6 | comment 7 | Returns the Roman number of an integer between 1 and 3999. 8 | "MMMDCCCLXXXVIII" (15 characters long) is the longest Roman number under 4000; 9 | begin 10 | integer place, power; 11 | 12 | procedure append (string(1) value c); 13 | begin characters(length|1) := c; length := length + 1 end; 14 | 15 | procedure i; append(case place of ("I","X","C","M")); 16 | procedure v; append(case place of ("V","L","D")); 17 | procedure x; append(case place of ("X","C","M")); 18 | 19 | assert (number >= 1) and (number < 4000); 20 | 21 | characters := " "; 22 | length := 0; 23 | power := 1000; 24 | place := 4; 25 | while place > 0 do 26 | begin 27 | case number div power + 1 of begin 28 | begin end; 29 | begin i end; 30 | begin i; i end; 31 | begin i; i; i end; 32 | begin i; v end; 33 | begin v end; 34 | begin v; i end; 35 | begin v; i; i end; 36 | begin v; i; i; i end; 37 | begin i; x end 38 | end; 39 | number := number rem power; 40 | power := power div 10; 41 | place := place - 1 42 | end 43 | end roman; 44 | 45 | for i := 1 until argc - 1 do 46 | begin 47 | integer n; 48 | logical success; 49 | number(argv(i), n, success); 50 | if not success then 51 | write("Not an number.") 52 | else if n < 1 then 53 | write("The Romans didn't think that small.") 54 | else if n > 3999 then 55 | write("The Romans didn't think that big.") 56 | else 57 | begin 58 | string(15) r; 59 | integer len; 60 | roman(n, r, len); 61 | write(r) 62 | end 63 | end 64 | end 65 | -------------------------------------------------------------------------------- /Examples/Wumpus/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = wumpus 2 | ALGOLW_SOURCES = wumpus.alw 3 | include awe.mk 4 | -------------------------------------------------------------------------------- /Examples/test-cords/BEGIN: -------------------------------------------------------------------------------- 1 | comment 2 | A "begin" to let the contents of a following 3 | sequence of source files exist in the same scope, 4 | which gives you a primitive module system. 5 | The idea is that you do something like this: 6 | 7 | awe BEGIN defs1.alw defs1.alw prog.alw END -o prog.c ; 8 | BEGIN 9 | -------------------------------------------------------------------------------- /Examples/test-cords/END: -------------------------------------------------------------------------------- 1 | comment 2 | An "end" to let the contents of a preceeding 3 | sequence of source files exist in the same scope, 4 | which gives you a primitive module system. 5 | The idea is that you do something like this: 6 | 7 | awe BEGIN defs1.alw defs1.alw prog.alw END -c prog.c 8 | 9 | (Note that prog.alw cannot end on a fullstop.) ; 10 | END. 11 | -------------------------------------------------------------------------------- /Examples/test-cords/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = test-cords 2 | ALGOLW_SOURCES = BEGIN file.alw cords.alw try-it.alw END 3 | C_SOURCES = file.c cords.c cords/cordbscs.c cords/cordxtra.c 4 | C_INCLUDES = cords/cord.h cords/private/cord_pos.h 5 | EXTRA_FILES = cords/README.txt cords/*.[hc] 6 | 7 | CFLAGS = -Icord -I/usr/include/gc # For the cords/* code. 8 | LDLIBS = 9 | 10 | include awe.mk 11 | 12 | test : clean build 13 | ./$(PROGRAM) 14 | echo "Success!" 15 | -------------------------------------------------------------------------------- /Examples/test-cords/README: -------------------------------------------------------------------------------- 1 | This is an example of interfacing an Algol program to an existing C 2 | library: Hans Boehm's Cord data type. 3 | 4 | (I've made the lazy assumption that 'char', 'size_t' are represented 5 | by the same type as 'int'. It works on my 32-bit 686 system. I suspect 6 | the interface would have to be defined more strictly on others.) 7 | 8 | --Glyn 9 | -------------------------------------------------------------------------------- /Examples/test-cords/cords.alw: -------------------------------------------------------------------------------- 1 | % cord.alw -- cord string datatype % 2 | 3 | record CORD (integer cord_dummy); % NULL is the empty string % 4 | 5 | % transfer functions ------------------------------------------------------------------------------------ 6 | 7 | CORD_OF_TEXT(s) copies all of the string except the padding on the right. 8 | CORD_OF_STRING(s,i,n) copies n characters of string s starting at position i (where 0 < i+n <= 256) 9 | STRING_OF_CORD(x) copies cord into the string, (where 0 < cord_len(x) <= 256) 10 | 11 | To create a space: space := cord_of_string(" ",1,1) 12 | % 13 | 14 | reference(cord) procedure CORD_OF_TEXT (string(256) value S); algol "CORD_of_text"; 15 | reference(cord) procedure CORD_OF_STRING (string(256) value S; integer value I, N); algol "CORD_of_string"; 16 | reference(cord) procedure CORD_OF_CHARS (string(1) value C; integer value N); algol "CORD_of_chars"; 17 | string(256) procedure STRING_OF_CORD (reference(cord) value SRC); algol "string_of_CORD"; 18 | 19 | % string functions. ------------------------------------------------------------------------------------- % 20 | 21 | integer procedure CHR (string(1) value S); algol "chr"; % returns Latin-1 code of s % 22 | string(1) procedure ORD (integer value I); algol "ord"; % returns character with Latin-1 code of i % 23 | % Note: CODE and DECODE work on EBCDIC codes. % 24 | 25 | integer procedure TEXT_LEN (string(256) value S); algol "text_len"; % length of s, ignoring its padding % 26 | 27 | % Cord functions. --------------------------------------------------------------------------------------- % 28 | 29 | reference(cord) procedure CORD_CAT (reference(cord) value X, Y); algol "CORD_cat"; 30 | integer procedure CORD_LEN (reference(cord) value X); algol "CORD_len"; 31 | reference(cord) procedure CORD_SUBSTR (reference(cord) value X; integer value I, N); algol "CORD_substr"; 32 | integer procedure CORD_CMP (reference(cord) value X, Y); algol "CORD_cmp"; 33 | 34 | integer procedure CORD_CHR (reference(cord) value X; integer value I; string(1) value C); algol "CORD_chr"; 35 | integer procedure CORD_RCHR (reference(cord) value X; integer value I; string(1) value C); algol "CORD_rchr"; 36 | 37 | % (I've made the wild and wrong assumption that size_t int and char are interchangeable above.) % 38 | 39 | 40 | % I/O functions. ---------------------------------------------------------------------------------------- % 41 | 42 | integer procedure CORD_PUT (reference(cord) value X; reference(file) value F); algol "CORD_put"; 43 | reference(cord) procedure CORD_FROM_FILE (reference(file) value F); algol "CORD_from_file"; 44 | reference(cord) procedure CORD_FROM_FILE_EAGER (reference(file) value F); algol "CORD_from_file_eager"; 45 | 46 | % end % 47 | -------------------------------------------------------------------------------- /Examples/test-cords/cords.c: -------------------------------------------------------------------------------- 1 | /* cords_a.c -- adapts cords functions to the data types that Algol W uses */ 2 | 3 | /* Mostly size_t --> int */ 4 | 5 | #include 6 | #include 7 | #include 8 | #include "cords/cord.h" 9 | 10 | #define AWE_STRING_LEN 256 11 | 12 | 13 | CORD 14 | CORD_of_text (_awe_str src) 15 | { 16 | int length; 17 | 18 | char s [AWE_STRING_LEN + 1]; 19 | 20 | _awe_str_unpadded_copy(s, src, AWE_STRING_LEN); 21 | 22 | length = strlen(s); 23 | return CORD_from_char_star(s); 24 | } 25 | 26 | 27 | CORD 28 | CORD_of_string (_awe_str src, int index, int length) 29 | { 30 | char s [AWE_STRING_LEN + 1]; 31 | if (index < 0 || length <= 0 || index + length > AWE_STRING_LEN) 32 | _awe_error( _awe_HERE, 33 | "Cannot take substring (%d|%d) of a STRING(%d).", 34 | index, length, AWE_STRING_LEN ); 35 | strncpy(s, src + index, length); 36 | s[length] ='\0'; 37 | return CORD_from_char_star(s); 38 | } 39 | 40 | 41 | CORD 42 | CORD_of_chars (unsigned char c, int n) 43 | { 44 | return CORD_chars(c, (size_t)n); 45 | } 46 | 47 | 48 | _awe_str 49 | string_of_CORD (CORD src) 50 | { 51 | int length; 52 | const char *s; 53 | 54 | length = CORD_len(src); 55 | if (length > AWE_STRING_LEN) 56 | _awe_error( _awe_HERE, 57 | "A CORD of length(%d) will not fit in a string(%d)", 58 | length, AWE_STRING_LEN ); 59 | 60 | s = CORD_to_const_char_star(src); 61 | return _awe_str_cast((_awe_str)s, length, AWE_STRING_LEN); 62 | } 63 | 64 | 65 | int 66 | ord (unsigned char c) 67 | { 68 | return c; 69 | } 70 | 71 | 72 | unsigned char 73 | chr (int i) 74 | { 75 | if (i < 0 || i > 255) _awe_error(_awe_HERE, "chr: %d is not a Latin-1 code", i); 76 | return i; 77 | } 78 | 79 | 80 | int 81 | text_len (_awe_str src) 82 | { 83 | return _awe_str_unpadded_length(src, AWE_STRING_LEN); 84 | } 85 | 86 | 87 | /* end */ 88 | -------------------------------------------------------------------------------- /Examples/test-cords/cords/README.txt: -------------------------------------------------------------------------------- 1 | These files are copied from: 2 | 3 | http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/bdwgc-7_2alpha5-20110107.tar.bz2 4 | 5 | They require the libgc-dev package to be intalled. 6 | 7 | To test: 8 | 9 | gcc -lgc -I. -I/usr/include/gc cord*.c && ./a.out 10 | -------------------------------------------------------------------------------- /Examples/test-cords/cords/ec.h: -------------------------------------------------------------------------------- 1 | # ifndef EC_H 2 | # define EC_H 3 | 4 | # ifndef CORD_H 5 | # include "cord.h" 6 | # endif 7 | 8 | /* Extensible cords are strings that may be destructively appended to. */ 9 | /* They allow fast construction of cords from characters that are */ 10 | /* being read from a stream. */ 11 | /* 12 | * A client might look like: 13 | * 14 | * { 15 | * CORD_ec x; 16 | * CORD result; 17 | * char c; 18 | * FILE *f; 19 | * 20 | * ... 21 | * CORD_ec_init(x); 22 | * while(...) { 23 | * c = getc(f); 24 | * ... 25 | * CORD_ec_append(x, c); 26 | * } 27 | * result = CORD_balance(CORD_ec_to_cord(x)); 28 | * 29 | * If a C string is desired as the final result, the call to CORD_balance 30 | * may be replaced by a call to CORD_to_char_star. 31 | */ 32 | 33 | # ifndef CORD_BUFSZ 34 | # define CORD_BUFSZ 128 35 | # endif 36 | 37 | typedef struct CORD_ec_struct { 38 | CORD ec_cord; 39 | char * ec_bufptr; 40 | char ec_buf[CORD_BUFSZ+1]; 41 | } CORD_ec[1]; 42 | 43 | /* This structure represents the concatenation of ec_cord with */ 44 | /* ec_buf[0 ... (ec_bufptr-ec_buf-1)] */ 45 | 46 | /* Flush the buffer part of the extended chord into ec_cord. */ 47 | /* Note that this is almost the only real function, and it is */ 48 | /* implemented in 6 lines in cordxtra.c */ 49 | void CORD_ec_flush_buf(CORD_ec x); 50 | 51 | /* Convert an extensible cord to a cord. */ 52 | # define CORD_ec_to_cord(x) (CORD_ec_flush_buf(x), (x)[0].ec_cord) 53 | 54 | /* Initialize an extensible cord. */ 55 | # define CORD_ec_init(x) ((x)[0].ec_cord = 0, (x)[0].ec_bufptr = (x)[0].ec_buf) 56 | 57 | /* Append a character to an extensible cord. */ 58 | # define CORD_ec_append(x, c) \ 59 | { \ 60 | if ((x)[0].ec_bufptr == (x)[0].ec_buf + CORD_BUFSZ) { \ 61 | CORD_ec_flush_buf(x); \ 62 | } \ 63 | *((x)[0].ec_bufptr)++ = (c); \ 64 | } 65 | 66 | /* Append a cord to an extensible cord. Structure remains shared with */ 67 | /* original. */ 68 | void CORD_ec_append_cord(CORD_ec x, CORD s); 69 | 70 | # endif /* EC_H */ 71 | -------------------------------------------------------------------------------- /Examples/test-cords/file.alw: -------------------------------------------------------------------------------- 1 | % io.alw -- simple file I/O procedures % 2 | 3 | record file (integer file_dummy); 4 | 5 | reference(file) procedure file_open (string(256) value path; string(2) value mode); algol "file_open"; 6 | 7 | procedure file_close (reference(file) value handle); algol "file_close"; 8 | -------------------------------------------------------------------------------- /Examples/test-cords/file.c: -------------------------------------------------------------------------------- 1 | /* io.c --very simple I/O library for Algol W programs */ 2 | 3 | /* This provides the functions for the external procdure declarations in io.alw. */ 4 | 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include "awe.h" 11 | 12 | 13 | #define LINE_LENGTH 256 /* This MUST match the result string lengths in io.alw. */ 14 | #define PATH_LENGTH 256 /* This MUST match the path string lengths in file.alw. */ 15 | 16 | 17 | void * 18 | file_open (_awe_str path, _awe_str mode) 19 | { 20 | FILE *f; 21 | 22 | char c_path [PATH_LENGTH + 1]; 23 | char c_mode [3]; 24 | 25 | _awe_str_unpadded_copy(c_path, path, PATH_LENGTH); 26 | _awe_str_unpadded_copy(c_mode, mode, 2); 27 | 28 | f = fopen(c_path, c_mode); 29 | if (f == NULL) 30 | _awe_error(_awe_HERE, "file_open: '%s': %s", c_path, strerror(errno)); 31 | else 32 | return (void*)f; 33 | } 34 | 35 | 36 | void 37 | file_close (void * f) 38 | { 39 | if (f == NULL) 40 | _awe_error(_awe_HERE, "file_close: File handle is NULL"); 41 | 42 | if (fclose((FILE*)f) != 0) 43 | _awe_error(_awe_HERE, "file_close: %s", strerror(errno)); 44 | } 45 | 46 | /* end */ 47 | -------------------------------------------------------------------------------- /Examples/test-cords/try-it.alw: -------------------------------------------------------------------------------- 1 | comment cord.alw -- test Boehm's CORD library; 2 | 3 | begin 4 | reference(cord) a, b, c, space; 5 | integer i; 6 | 7 | space := cord_of_string(" ", 1, 1); 8 | 9 | a := cord_of_text("Now we see"); 10 | b := cord_of_text("if this works."); 11 | 12 | c := cord_cat(cord_cat(a, space), b); 13 | 14 | assert(string_of_cord(c) = "Now we see if this works."); 15 | assert(cord_cmp(c, cord_of_text("Now we see if this works.")) = 0); 16 | assert(cord_len(c) = text_len("Now we see if this works.")); 17 | 18 | i := cord_chr(c, 0, "e"); 19 | assert(i = 5) 20 | end 21 | -------------------------------------------------------------------------------- /INSTALL.md: -------------------------------------------------------------------------------- 1 | # INSTALLING AWE 2 | 3 | 4 | ## Requirements 5 | 6 | A Unix-like operating system, Gnu C, Python 3, OCaml 4.08 or later, 7 | make, ar, markdown and the Boehm GC. 8 | 9 | Ubuntu or Debian Linux are ideal. Awe is reported to successfully compile 10 | and run the test and example programs on macOS. 11 | 12 | On Debian or Ubuntu install these packages: 13 | 14 | gcc ocaml-nox python3 python3-markdown binutils make libgc-dev 15 | 16 | 17 | ## Building Awe 18 | 19 | These are commands to compile and install Awe, to be run from within 20 | the `awe/` source code directory: 21 | 22 | `make` 23 | 24 | This builds Awe, then performs a large number of automated tests on it. 25 | 26 | `sudo make install` 27 | 28 | This installs Awe. 29 | 30 | The default destination is the standard "/usr/local" directories. 31 | Edit `Makefile` if you do not want this. 32 | 33 | `man awe` 34 | 35 | Learn how to run your new Algol W compiler. 36 | 37 | 38 | That's it, it should be that simple. 39 | 40 | Feel free to ask me any questions. 41 | My email address is in the distribution files. 42 | 43 | --- 44 | Glyn Webster, 2024 45 | -------------------------------------------------------------------------------- /Makefile.awe: -------------------------------------------------------------------------------- 1 | # Makefile.awe -- Make the 'awe' compiler executable. 2 | 3 | OCAMLMAKEFILE = OCamlMakefile 4 | 5 | RESULT = awe 6 | 7 | LIBS = unix 8 | 9 | ML = options.ml \ 10 | dynArray.mli dynArray.ml \ 11 | location.mli location.ml \ 12 | table.mli table.ml \ 13 | class.mli class.ml \ 14 | type.mli type.ml \ 15 | scope.mli scope.ml \ 16 | tree.mli tree.ml \ 17 | code.mli code.ml \ 18 | predeclared.ml \ 19 | compiler.ml 20 | 21 | SOURCES = $(ML) parser.mly lexer.mll awe.ml 22 | 23 | DEP_MODULES = $(ML) parser.mli parser.ml lexer.ml awe.ml 24 | 25 | include $(OCAMLMAKEFILE) 26 | -------------------------------------------------------------------------------- /Makefile.testparsing: -------------------------------------------------------------------------------- 1 | # Makefile.testP -- make for the lexer/parser tester 2 | 3 | OCAMLMAKEFILE = OCamlMakefile 4 | 5 | RESULT = testparsing 6 | 7 | SOURCES = dynArray.mli dynArray.ml \ 8 | location.mli location.ml \ 9 | table.mli table.ml \ 10 | tree.ml \ 11 | parser.mly \ 12 | lexer.mll \ 13 | testparsing.mll 14 | 15 | include $(OCAMLMAKEFILE) 16 | 17 | #end -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Awe 2 | ALGOL W is a successor to Algol 60 closely based on A Contribution to the Development of ALGOL by Niklaus Wirth and C. A. R. Hoare. It includes dynamically allocated records, string handling, complex numbers and a standard I/O system. 3 | 4 | Awe is a new compiler for the ALGOL W language. It is a complete implementation of the language described in the [ALGOL W Language Description, June 1972](algolw.pdf). Awe should be able to compile code intended for the OS/360 ALGOL W compilers with little or no modification. For details read the [Awe manual](awe.md), [awe](awe.1.md)(1) and [awe.mk](awe.mk.7.md)(7). 5 | 6 | The main requirements for compiling Awe are a Unix-like operating system, GCC, Python3, OCaml and Boehm GC. For details read [INSTALL](INSTALL.md) and awe(1). 7 | 8 | ## Thank You 9 | 10 | Thank you to: Hendrick Boom, Tony Marsland, Carey Bloodworth, John Boutland and Nicolas Brouard for a great deal of expert advice, encouragement and testing; and the authors of the *Algol W Language Description* for creating such an unambiguous work. 11 | 12 | ## By the Way 13 | 14 | If you have found this software useful or enlightening, please consider buying one of the late Frank Key's [books](https://www.lulu.com/search/?contributor=Frank+Key). Frank kept me sane, somehow. -------------------------------------------------------------------------------- /Tests/Argv-Multisource/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = program 2 | ALGOLW_SOURCES = begin argv-headers.alw program.alw end 3 | C_SOURCES = argv.c 4 | OTHER_FILES = expected.output 5 | 6 | test : clean build 7 | ./program Argument1 Arg2 'argument 3' > actual.output 8 | diff --strip-trailing-cr expected.output actual.output 9 | 10 | clean:: 11 | rm -f actual.output 12 | 13 | include awe.mk -------------------------------------------------------------------------------- /Tests/Argv-Multisource/argv-headers.alw: -------------------------------------------------------------------------------- 1 | integer procedure argc; algol "get_argc"; 2 | string(100) procedure argv (integer value index); algol "get_argv"; 3 | integer procedure argv_length (integer value index); algol "get_argv_length"; 4 | 5 | -------------------------------------------------------------------------------- /Tests/Argv-Multisource/argv.c: -------------------------------------------------------------------------------- 1 | /* argc.c -- external procedures to let Algol W programs to access argc and argv. */ 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | 9 | #define STRING_LENGTH 100 /* This MUST match the string length in the Algol W declarations. */ 10 | 11 | 12 | /* Note: '_awe_argc' and '_awe_argc' are global copies of the 'main' function's arguments. */ 13 | 14 | 15 | int 16 | get_argc (void) 17 | { 18 | return _awe_argc; 19 | } 20 | 21 | 22 | int 23 | get_argv_length (int index) 24 | { 25 | assert(_awe_argv != NULL); 26 | if (index < 0 || index > _awe_argc) 27 | _awe_error(_awe_HERE, "attempted to access argv[%i], argc is %i\n", index, _awe_argc); 28 | assert(_awe_argv[index] != NULL); 29 | return strlen(_awe_argv[index]); 30 | } 31 | 32 | 33 | _awe_str 34 | get_argv (int index) 35 | { 36 | int len; 37 | 38 | assert(_awe_argv != NULL); 39 | if (index < 0 || index > _awe_argc) 40 | _awe_error(_awe_HERE, "attempted to access argv[%i], argc is %i\n", index, _awe_argc); 41 | assert(_awe_argv[index] != NULL); 42 | len = strlen(_awe_argv[index]); 43 | if (len > STRING_LENGTH) 44 | _awe_error(_awe_HERE, "strlen(argv[%i] == %i: greater than target string's length of %i", index, len, STRING_LENGTH); 45 | return _awe_str_cast(_awe_argv[index], len, STRING_LENGTH); 46 | } 47 | 48 | /* end */ 49 | -------------------------------------------------------------------------------- /Tests/Argv-Multisource/begin: -------------------------------------------------------------------------------- 1 | begin 2 | -------------------------------------------------------------------------------- /Tests/Argv-Multisource/end: -------------------------------------------------------------------------------- 1 | end. 2 | -------------------------------------------------------------------------------- /Tests/Argv-Multisource/expected.output: -------------------------------------------------------------------------------- 1 | 0 9 ./program 2 | 1 9 Argument1 3 | 2 4 Arg2 4 | 3 10 argument 3 5 | -------------------------------------------------------------------------------- /Tests/Argv-Multisource/program.alw: -------------------------------------------------------------------------------- 1 | for i := 0 until argc - 1 do 2 | write(i_w := 2, i, argv_length(i), argv(i)) 3 | -------------------------------------------------------------------------------- /Tests/Argv/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = program 2 | ALGOLW_SOURCES = program.alw 3 | C_SOURCES = argv.c 4 | OTHER_FILES = expected.output 5 | 6 | test : clean program 7 | ./program Argument1 Arg2 'argument 3' > actual.output 8 | diff --strip-trailing-cr expected.output actual.output 9 | 10 | # an additional cleaning rule: 11 | clean :: 12 | rm -f actual.output 13 | 14 | include awe.mk 15 | 16 | -------------------------------------------------------------------------------- /Tests/Argv/argv.c: -------------------------------------------------------------------------------- 1 | /* argc.c -- external procedures to let Algol W programs to access argc and argv. */ 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | #include "program.awe.h" /* Prototypes for external procedures. Generated by the Makefile. */ 9 | 10 | 11 | #define STRING_LENGTH 100 /* This MUST match the string length in the Algol W declarations. */ 12 | 13 | 14 | /* Note: '_awe_argc' and '_awe_argc' are global copies of the 'main' function's arguments. */ 15 | 16 | 17 | int 18 | get_argc (void) 19 | { 20 | return _awe_argc; 21 | } 22 | 23 | 24 | int 25 | get_argv_length (int index) 26 | { 27 | assert(_awe_argv != NULL); 28 | if (index < 0 || index > _awe_argc) 29 | _awe_error(_awe_HERE, "attempted to access argv[%i], argc is %i\n", index, _awe_argc); 30 | assert(_awe_argv[index] != NULL); 31 | return strlen(_awe_argv[index]); 32 | } 33 | 34 | 35 | _awe_str 36 | get_argv (int index) 37 | { 38 | int len; 39 | 40 | assert(_awe_argv != NULL); 41 | if (index < 0 || index > _awe_argc) 42 | _awe_error(_awe_HERE, "attempted to access argv[%i], argc is %i\n", index, _awe_argc); 43 | assert(_awe_argv[index] != NULL); 44 | len = strlen(_awe_argv[index]); 45 | if (len > STRING_LENGTH) 46 | _awe_error(_awe_HERE, "strlen(argv[%i] == %i: greater than target string's length of %i", index, len, STRING_LENGTH); 47 | return _awe_str_cast(_awe_argv[index], len, STRING_LENGTH); 48 | } 49 | 50 | /* end */ 51 | -------------------------------------------------------------------------------- /Tests/Argv/expected.output: -------------------------------------------------------------------------------- 1 | 0 9 ./program 2 | 1 9 Argument1 3 | 2 4 Arg2 4 | 3 10 argument 3 5 | -------------------------------------------------------------------------------- /Tests/Argv/program.alw: -------------------------------------------------------------------------------- 1 | % Test argc/argv access. % 2 | begin 3 | integer procedure argc; algol "get_argc"; 4 | 5 | string(100) procedure argv (integer value index); algol "get_argv"; 6 | 7 | integer procedure argv_length (integer value index); algol "get_argv_length"; 8 | 9 | for i := 0 until argc - 1 do 10 | write(i_w := 2, i, argv_length(i), argv(i)) 11 | end. 12 | -------------------------------------------------------------------------------- /Tests/ExternalRecords/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = program 2 | ALGOLW_SOURCES = program.alw 3 | C_SOURCES = io-library.c 4 | OTHER_FILES = expected.output 5 | 6 | test : clean build 7 | ./program > actual.output 8 | diff --strip-trailing-cr expected.output actual.output 9 | 10 | clean:: 11 | rm -f actual.output 12 | 13 | include awe.mk 14 | -------------------------------------------------------------------------------- /Tests/ExternalRecords/expected.output: -------------------------------------------------------------------------------- 1 | 1 |Empty arrays 2 | 2 |============ 3 | 3 | 4 | 4 |Hendrik Boom wrote to me that the OS/360 ALGOLW compiler allowed 5 | 5 |"empty arrays" to be declared, with the semantics defined below, and 6 | 6 |that using them made some algorithms considerably clearer. Awe allows 7 | 7 |them also, for the sake of backward compatibility. 8 | 8 | 9 | 9 |**Definition** 10 | 10 | 11 | 11 |Replace the last sentence of 5.2.2. *Array Declarations, Semantics* with this: 12 | 12 | 13 | 13 | In order to be valid, for every bound pair, the value of the upper 14 | 14 | bound may be no lower than one less than the upper bound. If a valid 15 | 15 | array has any bound pair where the upper bound is one less than the 16 | 16 | lower bound then it is an empty array. 17 | 17 | 18 | 18 |Replace the second sentence of 6.1.2. *Variables, Semantics* with this: 19 | 19 | 20 | 20 | An array designator is invalid if its array identifier denotes an 21 | 21 | empty array (Cf. 5.2.2) or if any of its subscripts lie outside 22 | 22 | the declared bounds for that subscript's position. 23 | -------------------------------------------------------------------------------- /Tests/ExternalRecords/external.txt: -------------------------------------------------------------------------------- 1 | Empty arrays 2 | ============ 3 | 4 | Hendrik Boom wrote to me that the OS/360 ALGOLW compiler allowed 5 | "empty arrays" to be declared, with the semantics defined below, and 6 | that using them made some algorithms considerably clearer. Awe allows 7 | them also, for the sake of backward compatibility. 8 | 9 | **Definition** 10 | 11 | Replace the last sentence of 5.2.2. *Array Declarations, Semantics* with this: 12 | 13 | In order to be valid, for every bound pair, the value of the upper 14 | bound may be no lower than one less than the upper bound. If a valid 15 | array has any bound pair where the upper bound is one less than the 16 | lower bound then it is an empty array. 17 | 18 | Replace the second sentence of 6.1.2. *Variables, Semantics* with this: 19 | 20 | An array designator is invalid if its array identifier denotes an 21 | empty array (Cf. 5.2.2) or if any of its subscripts lie outside 22 | the declared bounds for that subscript's position. 23 | -------------------------------------------------------------------------------- /Tests/ExternalRecords/io-library.c: -------------------------------------------------------------------------------- 1 | /* io.c --very simple I/O library for Algol W programs, to demonstrate external records. */ 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include "awe.h" 9 | 10 | 11 | #define LINE_LENGTH 256 /* This MUST match the result string length in the Algol W declarations. */ 12 | #define PATH_LENGTH 256 /* This MUST match the path string length in the Algol W declarations. */ 13 | 14 | 15 | void * 16 | algolw_open (_awe_str path, _awe_str mode) 17 | { 18 | FILE *f; 19 | 20 | char c_path [PATH_LENGTH + 1]; 21 | char c_mode [3]; 22 | 23 | _awe_str_unpadded_copy(c_path, path, PATH_LENGTH); 24 | _awe_str_unpadded_copy(c_mode, mode, 2); 25 | 26 | f = fopen(c_path, c_mode); 27 | if (f == NULL) 28 | /* _awe_error(_awe_HERE, "algolw_open: '%s': %s", c_path, strerror(errno)); */ 29 | /* We want to demonstrate returning a NULL pointer as a reference here, so: */ 30 | return NULL; 31 | else 32 | return (void*)f; 33 | } 34 | 35 | 36 | void 37 | algolw_readline (void *f, _awe_str line, int *success) 38 | { 39 | char *s; 40 | size_t size; 41 | int len; 42 | 43 | size = LINE_LENGTH + 2; /* allow for "\n\0" at end of line */ 44 | s = (char *)malloc(size); 45 | assert(s); 46 | 47 | len = getline(&s, &size, (FILE*)f); /* Note: this a GNU C function. */ 48 | if (ferror((FILE*)f)) 49 | _awe_error(_awe_HERE, "algolw_readline: %s", strerror(errno)); 50 | assert (len >= -1); 51 | 52 | if (len == -1) { /* at EOF */ 53 | _awe_str_init(line, LINE_LENGTH); /* clear the string */ 54 | *success = 0; 55 | } 56 | else { 57 | if (len > 0 && s[len - 1] == '\n') --len; 58 | assert(len <= LINE_LENGTH); 59 | _awe_str_cpy(line, LINE_LENGTH, s, len); 60 | *success = 1; 61 | } 62 | free(s); 63 | }; 64 | 65 | 66 | void 67 | algolw_writeline (void * f, _awe_str line) 68 | { 69 | int i, len; 70 | 71 | assert(line); 72 | if (f == NULL) 73 | _awe_error(_awe_HERE, "algolw_writeline: File handle is NULL"); 74 | 75 | len = _awe_str_unpadded_length(line, LINE_LENGTH); 76 | for (i = 0; i < len; ++i) 77 | if (fputc(line[i], (FILE*)f) == EOF) 78 | _awe_error(_awe_HERE, "algolw_writeline: %s", strerror(errno)); 79 | if (fputc('\n', (FILE*)f) == EOF) 80 | _awe_error(_awe_HERE, "algolw_writeline: %s", strerror(errno)); 81 | } 82 | 83 | 84 | void 85 | algolw_close (void * f) 86 | { 87 | if (f == NULL) 88 | _awe_error(_awe_HERE, "algolw_close: File handle is NULL"); 89 | 90 | if (fclose((FILE*)f) != 0) 91 | _awe_error(_awe_HERE, "algolw_close: %s", strerror(errno)); 92 | } 93 | 94 | /* end */ 95 | -------------------------------------------------------------------------------- /Tests/ExternalRecords/program.alw: -------------------------------------------------------------------------------- 1 | BEGIN 2 | RECORD file (INTEGER dummy); 3 | 4 | REFERENCE(file) PROCEDURE open ( STRING(256) VALUE path; STRING(2) VALUE mode ); 5 | ALGOL "algolw_open"; 6 | 7 | PROCEDURE readline ( REFERENCE(file) VALUE handle; 8 | STRING(256) RESULT line; LOGICAL RESULT success ); 9 | ALGOL "algolw_readline"; 10 | 11 | PROCEDURE writeline ( REFERENCE(file) VALUE handle; STRING(256) VALUE line ); 12 | ALGOL "algolw_writeline"; 13 | 14 | PROCEDURE close ( REFERENCE(file) VALUE handle ); 15 | ALGOL "algolw_close"; 16 | 17 | STRING(256) path; 18 | REFERENCE(file) f; 19 | STRING(256) s; 20 | LOGICAL continue; 21 | INTEGER n; 22 | 23 | iocontrol(11000); % 1000-column pages (no enforced linebreaks) % 24 | path := "external.txt"; 25 | f := open(path, "r"); 26 | IF f = NULL THEN 27 | write("could not open ", path) 28 | ELSE 29 | BEGIN 30 | n := 1; 31 | continue := TRUE; 32 | WHILE continue DO 33 | BEGIN 34 | readline(f, s, continue); 35 | IF continue THEN 36 | write(i_w := 3, n, "|", s); 37 | n := n + 1; 38 | END; 39 | close(f); 40 | END 41 | END. 42 | -------------------------------------------------------------------------------- /Tests/InitFlag/withinit.alw: -------------------------------------------------------------------------------- 1 | comment Tests that initializations 2 | begin 3 | integer i, j; 4 | real r; 5 | logical l; 6 | bits b; 7 | string(1) c; 8 | string(4) s; 9 | 10 | record rec (integer field_i; real field_i; string(4) field_i); 11 | reference(rec) ref_rec; 12 | record ext; 13 | reference(ext) ref_ext; 14 | 15 | integer array (1::10) a; 16 | integer array (1::10, 1::10) a2; 17 | string(4) array (1::10) sa; 18 | 19 | procedure p (integer result x); assert(x = 0); 20 | 21 | assert(i = 0); 22 | assert(j = 0); 23 | assert(r = 0.0); 24 | assert(b = #0); 25 | assert(c = " "); 26 | assert(s = " "); 27 | 28 | assert(ref_rec = null); 29 | ref_rec := rec; 30 | assert(field_i(rec) = 0); 31 | assert(field_r(rec) = 0.0); 32 | assert(field_s(rec) = " "); 33 | 34 | assert(ext_ref = null); 35 | 36 | for i := 1 until 10 do 37 | assert(a(i) = 0); 38 | 39 | for i := 1 until 10 do 40 | for j := 1 until 10 do 41 | assert(a(i,j) = 0); 42 | 43 | for i := 1 until 10 do 44 | assert(s(i) = 0); 45 | 46 | i := 1; 47 | p(i) 48 | end. 49 | -------------------------------------------------------------------------------- /Tests/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | make -C .. -k -f Makefile test 3 | -------------------------------------------------------------------------------- /Tests/Multifile-Error/Makefile: -------------------------------------------------------------------------------- 1 | AWE=../../awe 2 | LIBAWE=../../libawe.a 3 | AWEH_PATH=../.. 4 | 5 | CFLAGS= -z execstack -I$(AWEH_PATH) 6 | LDLIBS=-lm -lgc $(LIBAWE) 7 | LDFLAGS += -z execstack 8 | 9 | .SUFFIXES: .alw 10 | .PHONY: test clean 11 | 12 | test : clean 13 | $(AWE) begin.alw argv-headers.alw program.alw end.alw 2> actual.output || diff --strip-trailing-cr expected.output actual.output 14 | echo "testprograms: argv test passed!" 15 | 16 | clean: 17 | rm -f *.c actual.output 18 | -------------------------------------------------------------------------------- /Tests/Multifile-Error/argv-headers.alw: -------------------------------------------------------------------------------- 1 | integer procedure argc; algol "get_argc"; 2 | string(100) procedure argv (integer value index); algol "get_argv"; 3 | integer procedure argv_length (integer value index); algol "get_argv_length"; 4 | -------------------------------------------------------------------------------- /Tests/Multifile-Error/begin.alw: -------------------------------------------------------------------------------- 1 | begin 2 | -------------------------------------------------------------------------------- /Tests/Multifile-Error/end.alw: -------------------------------------------------------------------------------- 1 | end. 2 | -------------------------------------------------------------------------------- /Tests/Multifile-Error/expected.output: -------------------------------------------------------------------------------- 1 | program.alw:2:48: Syntax error 2 | -------------------------------------------------------------------------------- /Tests/Multifile-Error/program.alw: -------------------------------------------------------------------------------- 1 | for i := 0 until argc - 1 do 2 | write(i_w := 2, i, argv_length(i), argv(i))syntax error 3 | 4 | -------------------------------------------------------------------------------- /Tests/OldParse/Makefile: -------------------------------------------------------------------------------- 1 | # OldParse test one of Hendrik Boom's 1970's source files. 2 | 3 | PROGRAM = parse 4 | ALGOLW_SOURCES = parse.alw 5 | OTHER_FILES = original-parse.alw expected.output 6 | 7 | test: clean parse 8 | ./parse < GRAMMAR > actual.output 9 | diff --strip-trailing-cr expected.output actual.output 10 | echo "testprograms: run of PARSE passed!" 11 | 12 | parse.alw: original-parse.alw 13 | # The timing is different every run, so to compare the actual output 14 | # with our expected one, we cheap a little and remove the timing 15 | # statements from the program 16 | sed -e 's/WRITE("Time:.*;//g' < original-parse.alw > parse.alw 17 | 18 | clean :: 19 | rm -f parse.alw actual.output 20 | 21 | include awe.mk 22 | -------------------------------------------------------------------------------- /Tests/Separate/Makefile: -------------------------------------------------------------------------------- 1 | AWE = ../../awe 2 | 3 | CFLAGS = -z execstack -I../.. -L../.. 4 | LDLIBS = -lawe -lm -lgc 5 | LDFLAGS += -z execstack 6 | 7 | .PHONY: test clean 8 | 9 | test : clean program 10 | ./program > actual.output 11 | diff --strip-trailing-cr expected.output actual.output 12 | echo "testprograms: separate compilation test passed!" 13 | 14 | program : separate.c program.c 15 | 16 | program.c: program.alw 17 | $(AWE) program.alw -c program.c 18 | 19 | separate.c: separate.alw 20 | $(AWE) separate.alw -p separate.c 21 | 22 | clean:: 23 | rm -f program program.o program.c separate.o separate.c actual.output 24 | -------------------------------------------------------------------------------- /Tests/Separate/expected.output: -------------------------------------------------------------------------------- 1 | Here we go: 2 | separate says: 3 | Hi there! 4 | Done. 5 | -------------------------------------------------------------------------------- /Tests/Separate/program.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure separate(string(10) value message); 3 | algol "separate"; 4 | 5 | write("Here we go:"); 6 | separate("Hi there!"); 7 | write("Done."); 8 | end. 9 | -------------------------------------------------------------------------------- /Tests/Separate/separate.alw: -------------------------------------------------------------------------------- 1 | procedure separate (string(10) value message); 2 | begin 3 | write("separate says:"); 4 | write(message); 5 | end. 6 | -------------------------------------------------------------------------------- /Tests/SeparateC/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = program 2 | ALGOLW_SOURCES = program.alw 3 | C_SOURCES = cprocedure.c 4 | OTHER_FILES = expected.output 5 | 6 | test : clean program 7 | ./program > actual.output 8 | diff --strip-trailing-cr expected.output actual.output 9 | 10 | clean:: 11 | rm -f actual.output 12 | 13 | include awe.mk 14 | -------------------------------------------------------------------------------- /Tests/SeparateC/cprocedure.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include "program.awe.h" 5 | 6 | void Test (int v, int *r, int *vr, int *(*n)(void), _awe_array_t *a) 7 | { 8 | #define N *n() /* Name parameter */ 9 | #define A(j) *_awe_array_SUB(_awe_HERE, int, a, (j)) /* array parameter */ 10 | 11 | int j; 12 | 13 | printf("v = %d\n", v); 14 | printf("vr = %d\n", *vr); 15 | printf("n = %d\n", N); 16 | for (j = 1; j <= 3; ++j) printf("a(%d) = %d\n", j, A(j)); 17 | 18 | v++; 19 | ++(*vr); 20 | ++N; /* increment Name parameter */ 21 | *r = 41; 22 | for (j = 1; j <= 3; ++j) ++A(j); 23 | 24 | printf("v = %d\n", v); 25 | printf("vr = %d\n", *vr); 26 | printf("n = %d\n", N); /* fetch Name parameter again */ 27 | for (j = 1; j <= 3; ++j) printf("a(%d) = %d\n", j, A(j)); 28 | 29 | #undef A 30 | #undef N 31 | } 32 | -------------------------------------------------------------------------------- /Tests/SeparateC/expected.output: -------------------------------------------------------------------------------- 1 | v = 1 2 | vr = 50 3 | n = 60 4 | a(1) = 10 5 | a(2) = 20 6 | a(3) = 30 7 | v = 2 8 | vr = 51 9 | n = 61 10 | a(1) = 11 11 | a(2) = 21 12 | a(3) = 31 13 | -------------------------------------------------------------------------------- /Tests/SeparateC/program.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer array A(1::3); 3 | integer r, n, vr; 4 | 5 | procedure test_c_parameters ( integer value v; 6 | integer result r; 7 | integer value result vr; 8 | integer n; 9 | integer array a(*) ); algol "Test"; 10 | 11 | A(1) := 10; 12 | A(2) := 20; 13 | A(3) := 30; 14 | r := 40; 15 | vr := 50; 16 | n := 60; 17 | 18 | test_c_parameters(1, r, vr, n, A); 19 | 20 | assert A(1) = 11; 21 | assert A(2) = 21; 22 | assert A(3) = 31; 23 | assert r = 41; 24 | assert vr = 51; 25 | assert n = 61; 26 | end. 27 | -------------------------------------------------------------------------------- /Tests/Stderr-redirection/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = program 2 | ALGOLW_SOURCES = program.alw 3 | OTHER_FILES = expected-stdout.output expected-stderr.output 4 | 5 | test : clean program 6 | ./program > actual-stdout.output 2> actual-stderr.output 7 | diff --strip-trailing-cr expected-stderr.output actual-stderr.output 8 | diff --strip-trailing-cr expected-stdout.output actual-stdout.output 9 | 10 | # an additional cleaning rule: 11 | clean :: 12 | rm -f actual-stdout.output actual-stderr.output 13 | 14 | include awe.mk 15 | 16 | -------------------------------------------------------------------------------- /Tests/Stderr-redirection/expected-stderr.output: -------------------------------------------------------------------------------- 1 | Whoops, didn't expect this! ;-) 2 | -------------------------------------------------------------------------------- /Tests/Stderr-redirection/expected-stdout.output: -------------------------------------------------------------------------------- 1 | Some text, and some more text. 2 | -------------------------------------------------------------------------------- /Tests/Stderr-redirection/program.alw: -------------------------------------------------------------------------------- 1 | % Test stderr/stdout redirection. % 2 | begin 3 | write("Some text, "); 4 | 5 | iocontrol(50001); 6 | write("Whoops, didn't expect this! ;-)"); 7 | iocontrol(50000); 8 | 9 | writeon("and some more text."); 10 | end. 11 | -------------------------------------------------------------------------------- /Tests/Strings-as-bytes/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = program 2 | ALGOLW_SOURCES = program.alw 3 | C_SOURCES = byte-access.c 4 | 5 | # just run it, it's full of ASSERT statements 6 | test : clean build 7 | ./program 8 | 9 | include awe.mk 10 | -------------------------------------------------------------------------------- /Tests/Strings-as-bytes/byte-access.c: -------------------------------------------------------------------------------- 1 | int byte (unsigned char s) { return (int)s; } 2 | unsigned char debyte (int x) { return (unsigned char)( x % 256); } 3 | -------------------------------------------------------------------------------- /Tests/Strings-as-bytes/program.alw: -------------------------------------------------------------------------------- 1 | BEGIN 2 | INTEGER PROCEDURE CODE (STRING(1) VALUE S); ALGOL "byte"; 3 | 4 | STRING(1) PROCEDURE DECODE (INTEGER VALUE X); ALGOL "debyte"; 5 | 6 | STRING(13) S; 7 | 8 | S(0|1) := DECODE(123); comment ASCII codes ; 9 | S(1|1) := DECODE(72); 10 | S(2|1) := DECODE(111); 11 | S(3|1) := DECODE(119); 12 | S(4|1) := DECODE(39); 13 | S(5|1) := DECODE(115); 14 | S(6|1) := DECODE(32); 15 | S(7|1) := DECODE(116); 16 | S(8|1) := DECODE(104); 17 | S(9|1) := DECODE(105); 18 | S(10|1) := DECODE(115); 19 | S(11|1) := DECODE(63); 20 | S(12|1) := DECODE(125); 21 | ASSERT(S = "{How's this?}"); 22 | 23 | S := "{And this?}"; 24 | ASSERT(CODE(S(0|1)) = 123); 25 | ASSERT(CODE(S(1|1)) = 65); 26 | ASSERT(CODE(S(2|1)) = 110); 27 | ASSERT(CODE(S(3|1)) = 100); 28 | ASSERT(CODE(S(4|1)) = 32); 29 | ASSERT(CODE(S(5|1)) = 116); 30 | ASSERT(CODE(S(6|1)) = 104); 31 | ASSERT(CODE(S(7|1)) = 105); 32 | ASSERT(CODE(S(8|1)) = 115); 33 | ASSERT(CODE(S(9|1)) = 63); 34 | ASSERT(CODE(S(10|1)) = 125) 35 | END. 36 | -------------------------------------------------------------------------------- /Tests/Tracing/Makefile: -------------------------------------------------------------------------------- 1 | PROGRAM = program 2 | ALGOLW_SOURCES = program.alw 3 | C_SOURCES = tracing.c 4 | OTHER_FILES = expected.output 5 | AWE_FLAGS = -t 6 | 7 | test : clean program 8 | ./program 2> actual.output 9 | diff --strip-trailing-cr expected.output actual.output 10 | 11 | clean :: 12 | rm -f actual.output 13 | 14 | include awe.mk 15 | -------------------------------------------------------------------------------- /Tests/Tracing/expected.output: -------------------------------------------------------------------------------- 1 | program.alw:15:5: --> a 2 | program.alw:2:5: a 3 | program.alw:15:5: <-- a 4 | program.alw:16:5: --> b 5 | program.alw:6:5: b 6 | program.alw:8:30: --> c 7 | program.alw:11:5: c 8 | program.alw:8:30: <-- c 9 | program.alw:8:30: --> c 10 | program.alw:11:5: c 11 | program.alw:8:30: <-- c 12 | program.alw:8:30: --> c 13 | program.alw:11:5: c 14 | program.alw:8:30: <-- c 15 | program.alw:16:5: <-- b 16 | -------------------------------------------------------------------------------- /Tests/Tracing/program.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure a; 3 | begin 4 | end; 5 | 6 | procedure b; 7 | begin 8 | for i := 1 until 3 do c 9 | end; 10 | 11 | procedure c; 12 | begin 13 | end; 14 | 15 | a; 16 | b 17 | end. 18 | -------------------------------------------------------------------------------- /Tests/Tracing/tracing.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | int nesting = 0; 4 | 5 | void _awe_trace_procedure_called (_awe_loc call_loc, const char *procedure_name) 6 | { 7 | _awe_warning(call_loc, "%*s--> %s", nesting, "", procedure_name); 8 | nesting += 4; 9 | } 10 | 11 | void _awe_trace_procedure_entered (_awe_loc procedure_loc, const char *procedure_name) 12 | { 13 | _awe_warning(procedure_loc, "%*s%s", nesting, "", procedure_name); 14 | } 15 | 16 | void _awe_trace_procedure_exited (_awe_loc call_loc, const char *procedure_name) 17 | { 18 | nesting -= 4; 19 | _awe_warning(call_loc, "%*s<-- %s", nesting, "", procedure_name); 20 | } 21 | -------------------------------------------------------------------------------- /Tests/array-bounds-empty-arrays-2.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer array a (1::2, 2::1); 3 | a(1,0) := 1; 4 | end. 5 | ----stderr 6 | Tests/array-bounds-empty-arrays-2.alw:3:4: array subscript error: subscript 2 = 0, outside the range (2::1) 7 | ----exitcode 8 | 1 9 | ----end 10 | -------------------------------------------------------------------------------- /Tests/array-bounds-empty-arrays.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer array a (0::-1); 3 | integer array b (-1::-2); 4 | integer array c (1::0); 5 | a(0) := 1; 6 | end. 7 | ----stderr 8 | Tests/array-bounds-empty-arrays.alw:5:4: array subscript error: subscript 1 = 0, outside the range (0::-1) 9 | ----exitcode 10 | 1 11 | ----end 12 | -------------------------------------------------------------------------------- /Tests/array-bounds-subscript-count.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer array a (1::2, 1::2); 3 | a(0) := 1; 4 | end. 5 | ----compile 6 | Tests/array-bounds-subscript-count.alw:3:4: Array 'a' requires 2 parameters 7 | ----end 8 | -------------------------------------------------------------------------------- /Tests/array-bounds.alw: -------------------------------------------------------------------------------- 1 | % Note that an array with bounds (1::0) is allowed here, 2 | it is an array with no elements that must not be accessed. 3 | This is an AWE extension to Algol W. 4 | % 5 | begin 6 | integer i; 7 | i := 5; 8 | while i >= -1 do comment Uh oh!; 9 | begin 10 | integer array a(1 :: i); comment Uh oh!; 11 | if i > 0 then 12 | begin 13 | a(1) := i; 14 | write(a(1)); 15 | end; 16 | i := i - 1 17 | end; 18 | end. 19 | ----stdout 20 | 5 21 | 4 22 | 3 23 | 2 24 | 1 25 | ----stderr 26 | Tests/array-bounds.alw:10:13: array dimension error: dimension 1 is (1::-1) 27 | ----exitcode 28 | 1 29 | ----end 30 | -------------------------------------------------------------------------------- /Tests/array-designator-as-parameter.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure p(integer array A(*)); 3 | ; 4 | integer i; 5 | integer array B(1::3); 6 | i := 0; 7 | p(B(i+2)) 8 | end. 9 | ----compiler 10 | Tests/array-designator-as-parameter.alw:7:7: expected a 1 dimensional INTEGER ARRAY parameter here 11 | ----end 12 | -------------------------------------------------------------------------------- /Tests/array-parameters-type-cast.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure p(real array A(*); integer value n); 3 | for i := 1 until n do 4 | writeon(A(i)); 5 | 6 | real array I(1::2); 7 | 8 | I(1) := 1; 9 | I(2) := 3; 10 | 11 | p(I, 2); 12 | end. 13 | ----stdout 14 | 1 3 15 | ----end 16 | -------------------------------------------------------------------------------- /Tests/array-parameters-type-error.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure p(integer array A(*); integer value n); 3 | for i := 1 until n do 4 | writeon(A(i)); 5 | 6 | logical array L(1::2); 7 | 8 | L(1) := true; 9 | L(2) := false; 10 | 11 | p(L, 2) 12 | end. 13 | ----compile 14 | Tests/array-parameters-type-error.alw:11:6: expected a 1 dimensional INTEGER ARRAY parameter here, this is a 1 dimensional LOGICAL ARRAY 15 | ----end 16 | -------------------------------------------------------------------------------- /Tests/array-parameters.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure p(integer array A(*,*); integer value m, n); 3 | begin 4 | i_w := 2; 5 | for i := 1 until m do 6 | begin 7 | for j := 1 until n do 8 | writeon(A(i,j)); 9 | iocontrol(2) 10 | end 11 | end p; 12 | 13 | procedure q(integer array A(*); integer value n); 14 | begin 15 | i_w := 2; 16 | for i := 1 until n do 17 | writeon(A(i)); 18 | end; 19 | 20 | procedure r(integer array A(*,*); integer value m, n); 21 | begin 22 | i_w := 2; 23 | for i := 1 until m do 24 | begin 25 | q(A(i,*), n); 26 | iocontrol(2) 27 | end 28 | end; 29 | 30 | 31 | procedure break; begin write("*"); iocontrol(2) end; 32 | 33 | begin 34 | integer array A(1::3, 1::4); 35 | integer array B(1::4, 1::3); 36 | integer n; 37 | n := 1; 38 | for i := 1 until 3 do 39 | for j := 1 until 4 do 40 | begin 41 | A(i,j) := n; 42 | B(j,i) := n; 43 | n := n + 1 44 | end; 45 | 46 | p(A, 3, 4); break; 47 | p(A(*,*), 3, 4); break; 48 | p(B, 4, 3); break; 49 | q(A(1,*), 4); break; 50 | q(A(*,1), 3); break; 51 | r(B, 4, 3) 52 | end 53 | end. 54 | ----stdout 55 | 1 2 3 4 56 | 5 6 7 8 57 | 9 10 11 12 58 | * 59 | 1 2 3 4 60 | 5 6 7 8 61 | 9 10 11 12 62 | * 63 | 1 5 9 64 | 2 6 10 65 | 3 7 11 66 | 4 8 12 67 | * 68 | 1 2 3 4 69 | * 70 | 1 5 9 71 | * 72 | 1 5 9 73 | 2 6 10 74 | 3 7 11 75 | 4 8 12 76 | ----end 77 | -------------------------------------------------------------------------------- /Tests/array-range.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer array a(1::5); 3 | 4 | for i := 1 until 5 do 5 | a(i) := i * 2; 6 | 7 | for i := 1 until 6 do comment Uh oh!; 8 | write(a(i)) 9 | end. 10 | ----stdout 11 | 2 12 | 4 13 | 6 14 | 8 15 | 10 16 | ----stderr 17 | Tests/array-range.alw:8:15: array subscript error: subscript 1 = 6, outside the range (1::5) 18 | ----exitcode 19 | 1 20 | ----end 21 | -------------------------------------------------------------------------------- /Tests/array-references-init.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record r (integer f); 3 | reference(r) array a (1 :: 5); 4 | write(a(1)) %not initialised% 5 | end. 6 | ----stdout 7 | UNINITIALIZED 8 | ----end 9 | -------------------------------------------------------------------------------- /Tests/array-strings.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(5) array a (1::6, 1::6); 3 | 4 | a(3,4) := "abcbe"; 5 | a(3,5) := "ABCBE"; 6 | 7 | assert a(3,4) = "abcbe"; 8 | assert a(3,5) = "ABCBE"; 9 | end. 10 | -------------------------------------------------------------------------------- /Tests/array.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer array a(1::9, 3::4); 3 | comment do nothing; 4 | end. 5 | -------------------------------------------------------------------------------- /Tests/arrays-multidimensional-range.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer array a(1::10, 1::10); 3 | 4 | for i := 1 until 10 do 5 | for j := 1 until 10 do 6 | a(i,j) := i * 10 + j; 7 | assert(a(1,1) = 11); 8 | assert(a(5,4) = 54); 9 | assert(a(6,3) = 63); 10 | assert(a(3,11) = 0); comment Uh oh; 11 | end. 12 | ----stderr 13 | Tests/arrays-multidimensional-range.alw:10:12: array subscript error: subscript 2 = 11, outside the range (1::10) 14 | ----exitcode 15 | 1 16 | ----end 17 | -------------------------------------------------------------------------------- /Tests/arrays-multidimensional.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer array a(1::10, 1::10); 3 | integer array b(1::10, 1::10, 1::10); 4 | 5 | for i := 1 until 10 do 6 | for j := 1 until 10 do 7 | a(i,j) := i * 10 + j; 8 | assert(a(1,1) = 11); 9 | assert(a(5,4) = 54); 10 | assert(a(6,3) = 63); 11 | 12 | for i := 1 until 10 do 13 | for j := 1 until 10 do 14 | for k := 1 until 10 do 15 | b(i,j,k) := i * 100 + j * 10 + k; 16 | assert(b(1,1,1) = 111); 17 | assert(b(5,4,6) = 546); 18 | assert(b(6,3,9) = 639); 19 | end. 20 | -------------------------------------------------------------------------------- /Tests/begin: -------------------------------------------------------------------------------- 1 | begin 2 | -------------------------------------------------------------------------------- /Tests/constants-range-bits-too-big.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write(#fffffffff); 3 | end. 4 | ----compiler 5 | Tests/constants-range-bits-too-big.alw:2:9: BITS constant #FFFFFFFFF will not fit in a 32 bit word 6 | ----end 7 | -------------------------------------------------------------------------------- /Tests/constants-range-integer-too-big.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write(2147483648); 3 | end. 4 | ----compiler 5 | Tests/constants-range-integer-too-big.alw:2:9: integer 2147483648 will not fit in a 32 bit word 6 | ----end 7 | -------------------------------------------------------------------------------- /Tests/constants-range.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write(0); 3 | write(-0); 4 | write(1); 5 | write(-1); 6 | write(2147483647); 7 | write(-2147483647); 8 | write(-2147483647 - 1); 9 | write(#0); 10 | write(#ffffffff); 11 | end. 12 | ----stdout 13 | 0 14 | 0 15 | 1 16 | -1 17 | 2147483647 18 | -2147483647 19 | -2147483648 20 | 0 21 | FFFFFFFF 22 | ----end 23 | -------------------------------------------------------------------------------- /Tests/directives-lexical-error.alw: -------------------------------------------------------------------------------- 1 | comment This compiler directive does not start in column 1; 2 | begin 3 | @I'm a bad directive 4 | end. 5 | ----compiler 6 | Tests/directives-lexical-error.alw:3:3: Misplaced directive "@I'm a bad directive" 7 | ----end -------------------------------------------------------------------------------- /Tests/directives-source-position.alw: -------------------------------------------------------------------------------- 1 | comment Awe will output a compiler note for each Name paramter, 2 | the linemarker directives should ensure that they are 3 | reported as coming from different files; 4 | begin 5 | procedure p (integer i); % Tests/directives-source-position.alw:5:18 % 6 | begin 7 | end; 8 | 9 | # 1 "here.alw" 10 | procedure q (integer i); % here.alw:1:18 % 11 | begin 12 | end; 13 | 14 | procedure r (integer i); % here.alw:5:18 % 15 | begin 16 | end; 17 | 18 | # 4 "there.alw" 19 | procedure s (integer i); % there.alw:4:18 % 20 | begin 21 | end; 22 | 23 | # 10 "here.alw" 1 24 | procedure t (integer i); % here.alw:10:18 % 25 | begin 26 | end; 27 | end. 28 | ----compiler 29 | Tests/directives-source-position.alw:5:18: Note, this is a call-by-name formal parameter. 30 | here.alw:1:18: Note, this is a call-by-name formal parameter. 31 | here.alw:5:18: Note, this is a call-by-name formal parameter. 32 | there.alw:4:18: Note, this is a call-by-name formal parameter. 33 | here.alw:10:18: Note, this is a call-by-name formal parameter. 34 | ----end 35 | -------------------------------------------------------------------------------- /Tests/directives.alw: -------------------------------------------------------------------------------- 1 | comment The compiler should ignore the "@" directive lines; 2 | begin 3 | @I'm not here 4 | string(1) c; 5 | @I'm not here 6 | c := "@"; 7 | comment @; c := "!"; 8 | assert c = "!" 9 | @I'm not here 10 | end. 11 | -------------------------------------------------------------------------------- /Tests/end: -------------------------------------------------------------------------------- 1 | end. 2 | -------------------------------------------------------------------------------- /Tests/exceptions-divzero-complex.alw: -------------------------------------------------------------------------------- 1 | begin 2 | complex x; 3 | 4 | assert ~xcpnoted(divzero); 5 | assert xcplimit(divzero) = 0; 6 | assert xcpaction(divzero) = 0; 7 | assert xcpmark(divzero); 8 | 9 | xcplimit(divzero) := 3; 10 | 11 | xcpaction(divzero) := 0; 12 | x := 10 / 0; 13 | assert(x = 10); 14 | 15 | xcpaction(divzero) := 1; 16 | x := 10 / 0; 17 | assert(x = maxreal); 18 | 19 | xcpaction(divzero) := 2; 20 | x := 10 / 0; 21 | assert(x = 0); 22 | 23 | divzero := null; comment Returns the divdend and ignores the error; 24 | x := 10 / 0; 25 | assert(x = 10); 26 | end. 27 | ----stderr 28 | Tests/exceptions-divzero-complex.alw:12:11: Floating-point division by zero. 29 | Tests/exceptions-divzero-complex.alw:16:11: Floating-point division by zero. 30 | Tests/exceptions-divzero-complex.alw:20:11: Floating-point division by zero. 31 | ----exitcode 32 | 0 33 | ----end 34 | -------------------------------------------------------------------------------- /Tests/exceptions-divzero.alw: -------------------------------------------------------------------------------- 1 | begin 2 | real r; 3 | 4 | assert ~xcpnoted(divzero); 5 | assert xcplimit(divzero) = 0; 6 | assert xcpaction(divzero) = 0; 7 | assert xcpmark(divzero); 8 | 9 | xcplimit(divzero) := 3; 10 | 11 | xcpaction(divzero) := 0; 12 | r := 10 / 0; 13 | assert(r = 10); 14 | 15 | xcpaction(divzero) := 1; 16 | r := 10 / 0; 17 | assert(r = maxreal); 18 | 19 | xcpaction(divzero) := 2; 20 | r := 10 / 0; 21 | assert(r = 0); 22 | 23 | divzero := null; comment Returns the divdend and ignores the error; 24 | r := 10 / 0; 25 | assert(r = 10); 26 | end. 27 | ----stderr 28 | Tests/exceptions-divzero.alw:12:11: Floating-point division by zero. 29 | Tests/exceptions-divzero.alw:16:11: Floating-point division by zero. 30 | Tests/exceptions-divzero.alw:20:11: Floating-point division by zero. 31 | ----exitcode 32 | 0 33 | ----end 34 | -------------------------------------------------------------------------------- /Tests/exceptions-establishment.alw: -------------------------------------------------------------------------------- 1 | comment Can an Exceptional Condition record be set and read?; 2 | begin 3 | DIVZERO := EXCEPTION(false, 10, 1, true, "DIVISION BY ZERO"); 4 | 5 | assert DIVZERO is EXCEPTION; 6 | assert ~XCPNOTED(DIVZERO); 7 | assert XCPLIMIT(DIVZERO) = 10; 8 | assert XCPACTION(DIVZERO) = 1; 9 | assert XCPMARK(DIVZERO); 10 | assert XCPMSG(DIVZERO) = "DIVISION BY ZERO" 11 | end. 12 | -------------------------------------------------------------------------------- /Tests/exceptions-intdivzero.alw: -------------------------------------------------------------------------------- 1 | begin 2 | assert ~xcpnoted(intdivzero); 3 | assert xcplimit(intdivzero) = 0; 4 | assert xcpaction(intdivzero) = 0; 5 | assert xcpmark(intdivzero); 6 | assert xcpmsg(intdivzero) = "Integer division by zero."; 7 | 8 | intdivzero := exception(false, 4, 1, true, "Divide by zero."); 9 | 10 | assert ~xcpnoted(intdivzero); comment No exceptions seen yet; 11 | assert xcplimit(intdivzero) = 4; comment Only 5 exceptions are allowed to occur; 12 | assert xcpaction(intdivzero) = 1; comment Action to take (all are the same for intdivzero); 13 | assert xcpmark(intdivzero); comment Give warning messages on exceptions; 14 | assert xcpmsg(intdivzero) = "Divide by zero."; 15 | 16 | ASSERT 42 DIV 0 = 42; comment <--- line 12; 17 | 18 | assert xcpnoted(intdivzero); comment We've seen one!; 19 | assert xcplimit(intdivzero) = 3; comment 4 to go...; 20 | 21 | xcpnoted(intdivzero) := false; comment Will this become true again?; 22 | xcpmark(intdivzero) := false; comment No warning for the next one; 23 | ASSERT 42 DIV 0 = 42; 24 | 25 | assert xcpnoted(intdivzero); comment It did become true!; 26 | assert xcplimit(intdivzero) = 2; 27 | 28 | xcpmsg(intdivzero) := "DIVIDE BY ZERO!"; comment A new warning message this time; 29 | xcpmark(intdivzero) := true; 30 | ASSERT 42 DIV 0 = 42; comment <--- line 26; 31 | 32 | assert xcplimit(intdivzero) = 1; comment Same message again; 33 | 34 | ASSERT 42 DIV 0 = 42; comment <--- line 30; 35 | 36 | assert xcplimit(intdivzero) = 0; comment That's our lot, the next exception will be the last; 37 | 38 | xcpmsg(intdivzero) := "DIVIDE BY ZERO!!!"; 39 | ASSERT 42 DIV 0 = 42; comment <--- line 35; 40 | 41 | write("I shouldn't happen.") 42 | end. 43 | ----stderr 44 | Tests/exceptions-intdivzero.alw:16:13: Divide by zero. 45 | Tests/exceptions-intdivzero.alw:30:13: DIVIDE BY ZERO! 46 | Tests/exceptions-intdivzero.alw:34:13: DIVIDE BY ZERO! 47 | Tests/exceptions-intdivzero.alw:39:13: DIVIDE BY ZERO!!! 48 | ----exitcode 49 | 1 50 | ----end 51 | -------------------------------------------------------------------------------- /Tests/expressions-case-incompatible.alw: -------------------------------------------------------------------------------- 1 | begin 2 | for i := 1, 6, 0, 4 do 3 | write(case i of (1,2,true,4,5,6)) 4 | end. 5 | ----compile 6 | Tests/expressions-case-incompatible.alw:3:13: This CASE expression's branch expressions have incompatible types. 7 | ----end 8 | -------------------------------------------------------------------------------- /Tests/expressions-case-too-high.alw: -------------------------------------------------------------------------------- 1 | begin 2 | for i := 1, 6, 7 do 3 | write(case i of (1,2,3,4,5,6)) 4 | end. 5 | ----stdout 6 | 1 7 | 6 8 | ----stderr 9 | Tests/expressions-case-too-high.alw:3:13: CASE range error: selector is 7 10 | ----exitcode 11 | 1 12 | ----end 13 | -------------------------------------------------------------------------------- /Tests/expressions-case-too-low.alw: -------------------------------------------------------------------------------- 1 | begin 2 | for i := 1, 6, 0, 4 do 3 | write(case i of (1,2,3,4,5,6)) 4 | end. 5 | ----stdout 6 | 1 7 | 6 8 | ----stderr 9 | Tests/expressions-case-too-low.alw:3:13: CASE range error: selector is 0 10 | ----exitcode 11 | 1 12 | ----end 13 | -------------------------------------------------------------------------------- /Tests/expressions-case.alw: -------------------------------------------------------------------------------- 1 | begin 2 | for i := 1, 6, 5, 4 do 3 | write (case i of (1, 2, 3, 4, 5, 6)) 4 | end. 5 | ----stdout 6 | 1 7 | 6 8 | 5 9 | 4 10 | ----end 11 | -------------------------------------------------------------------------------- /Tests/expressions-if-then-incompatible.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | logical b; 4 | i := if b then #1FFC else 3; 5 | end. 6 | ----compile 7 | Tests/expressions-if-then-incompatible.alw:4:8: incompatible types: the THEN clause is BITS and the ELSE clause is an INTEGER 8 | ----end -------------------------------------------------------------------------------- /Tests/expressions-if-then-needs-else.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | logical b; 4 | i := if b then 1; 5 | end. 6 | ----compile 7 | Tests/expressions-if-then-needs-else.alw:4:18: expected a statement here, got an INTEGER 8 | ----end -------------------------------------------------------------------------------- /Tests/expressions-if-then-string-expressions.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(5) s5; 3 | string(2) s2; 4 | string(1) s1, c; 5 | logical b; 6 | 7 | s2 := "ab"; 8 | c := "x"; 9 | 10 | s5 := if true then s2 else " "; assert s5 = "ab "; 11 | s5 := if false then s2 else "cd"; assert s5 = "cd "; 12 | s5 := if true then s2 else " "; assert s5 = "ab "; 13 | s5 := if false then s2 else "c"; assert s5 = "c "; 14 | s5 := if false then s2 else c; assert s5 = "x "; 15 | 16 | s1 := if true then "t" else s2(0|1); assert s1 = "t"; 17 | s1 := if false then "c" else s2(0|1); assert s1 = "a"; 18 | s1 := if true then c else s2(0|1); assert s1 = "x"; 19 | end. 20 | -------------------------------------------------------------------------------- /Tests/expressions-if-then.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write(if false then 1.0 else 3); 3 | write(if false then 4 else 3.2); 4 | write(if false then 4 else 3); 5 | write(if false then false else true); 6 | write(if false then #0FF else #f67e); 7 | end. 8 | ----stdout 9 | 3 10 | 3.2 11 | 3 12 | TRUE 13 | F67E 14 | ----end -------------------------------------------------------------------------------- /Tests/lexing-unclosed-comment.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | i := 0; 4 | comment 5 | now we are in trouble -->: 6 | end. 7 | ----compiler 8 | Tests/lexing-unclosed-comment.alw:4:5: This comment is not closed with a semicolon 9 | ----end 10 | -------------------------------------------------------------------------------- /Tests/lexing-unclosed-string.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | i := 0; 4 | write("now we are in trouble -->'); 5 | end. 6 | ----compiler 7 | Tests/lexing-unclosed-string.alw:4:11: This string is not closed with a double quote 8 | ----end 9 | -------------------------------------------------------------------------------- /Tests/long-comment-error-1.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write("1"); 3 | @awe_text 4 | write("2"); 5 | end. 6 | ----compiler 7 | Tests/long-comment-error-1.alw:3:1: This @AWE_TEXT directive is not closed with an @AWE_CODE directive 8 | ----end -------------------------------------------------------------------------------- /Tests/long-comment-error-2.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write("1"); 3 | @awe_text 4 | write("2"); 5 | @awe_text 6 | write("3"); 7 | @awe_code 8 | write("4"); 9 | end. 10 | ----compile 11 | Tests/long-comment-error-2.alw:3:1: This @AWE_TEXT directive is not closed with an @AWE_CODE directive 12 | ----end 13 | -------------------------------------------------------------------------------- /Tests/long-comment-error-3.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write("1"); 3 | @awe_text 4 | write(x); %we shouldn't see this error% 5 | @awe_code 6 | write(x); %error message should point to the right place% 7 | end. 8 | ----compiler 9 | Tests/long-comment-error-3.alw:6:10: 'x' is undefined here 10 | ----end 11 | -------------------------------------------------------------------------------- /Tests/long-comment.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write("1"); 3 | @awe_text 4 | write("2"); woot! we do what we like in here! 5 | write("3"); 6 | @awe_code 7 | write("4"); 8 | end. 9 | ----stdout 10 | 1 11 | 4 12 | ----end -------------------------------------------------------------------------------- /Tests/operators-bits.alw: -------------------------------------------------------------------------------- 1 | begin 2 | 3 | comment Equality; 4 | assert(#1 = #1); 5 | assert(#2 = #2); 6 | assert(#1 ~= #0); 7 | 8 | comment Bit operators; 9 | assert((#88888888 shl 1) = #11111110); 10 | assert((#11111111 shl 0) = #11111111); 11 | assert((#88888888 shl 7) = #44444400); 12 | assert((#88888888 shr 0) = #88888888); 13 | assert((#11111111 shr 1) = #08888888); 14 | assert((#11111111 shr 7) = #00222222); 15 | 16 | assert((#88888888 shl -1) = #11111110); 17 | assert((#88888888 shl -7) = #44444400); 18 | assert((#11111111 shr -1) = #08888888); 19 | assert((#11111111 shr -7) = #00222222); 20 | 21 | assert((#11 or #11) = #11); 22 | assert((#11 or #22) = #33); 23 | assert((#ee and #77) = #66); 24 | 25 | assert((~ #1001)= #ffffeffe); 26 | 27 | end. 28 | -------------------------------------------------------------------------------- /Tests/operators-integer-divide-by-0.alw: -------------------------------------------------------------------------------- 1 | write(1 div 0). 2 | ----stderr 3 | Tests/operators-integer-divide-by-0.alw:1:9: Integer division by zero. 4 | ----exitcode 5 | 1 6 | ----end 7 | -------------------------------------------------------------------------------- /Tests/operators-integer-division.alw: -------------------------------------------------------------------------------- 1 | begin 2 | 3 | comment Section 6.3.2.3; 4 | 5 | integer procedure SGN(integer value A); 6 | if A < 0 then -1 else 1; 7 | 8 | integer procedure D(integer value A, B); 9 | if A < B then 0 else D(A-B, B) + 1; 10 | 11 | for a := 91, 10, 0, -13, -10 do 12 | for b := 43, 5, -5, -10 do 13 | assert A div B = SGN(A * B) * D(abs A, abs B); 14 | 15 | 16 | comment Section 6.3.2.4; 17 | 18 | for a := 91, 10, 0, -13, -10 do 19 | for b := 43, 5, -5, -10 do 20 | assert a rem b = a - (a div b) * b; 21 | 22 | 23 | comment Section 6.3.2.1; 24 | 25 | assert 5 / 2 = 2.5; 26 | 27 | end. 28 | -------------------------------------------------------------------------------- /Tests/operators-integer.alw: -------------------------------------------------------------------------------- 1 | begin 2 | 3 | assert +1 = 1; 4 | assert -1 = -1; 5 | 6 | assert 2 + 2 = 4; 7 | assert 2 - 3 = -1; 8 | assert 2 * 3 = 6; 9 | assert 8 div 2 = 4; 10 | assert 9 div 2 = 4; 11 | assert 9 rem 2 = 1; 12 | assert 8 rem 2 = 0; 13 | 14 | assert (if true then 2 else 3) + 2 = 4; 15 | assert case 2 of (1,2,3,4,5) + 2 = 4; 16 | 17 | assert entier(32.4) = 32; 18 | assert entier(32.7) = 32; 19 | 20 | assert abs -42 = 42; 21 | assert abs 42 = 42; 22 | assert long 3 = 3.0L; 23 | 24 | end. 25 | -------------------------------------------------------------------------------- /Tests/operators-logical-comparison.alw: -------------------------------------------------------------------------------- 1 | begin 2 | 3 | comment Comparision of LOGICAL values was an ALGOLW extension to Algol W (inherited from MTS Algol); 4 | 5 | assert(true = true); 6 | assert(false = false); 7 | 8 | assert(true ~= false); 9 | assert(false ~= true); 10 | 11 | assert(true > false); 12 | assert(true >= false); 13 | assert(true >= true); 14 | 15 | assert(false < true); 16 | assert(false <= true); 17 | assert(false <= false); 18 | 19 | end. 20 | -------------------------------------------------------------------------------- /Tests/operators-logical.alw: -------------------------------------------------------------------------------- 1 | begin 2 | assert (true and true); 3 | assert ~(true and false); 4 | assert ~(false and true); 5 | assert ~(false and false); 6 | 7 | assert (true or true); 8 | assert (true or false); 9 | assert (false or true); 10 | assert ~(false or false); 11 | 12 | assert ~~true; 13 | assert ~false; 14 | 15 | assert ~(if true then false else true); 16 | assert (if false then false else true); 17 | 18 | begin comment The "shortcut" property; 19 | integer i; 20 | i := 0; 21 | write(i > 0 and 1 div i = 1); comment the divisions won't happen; 22 | write(i = 0 or 1 div i = 1); 23 | end; 24 | end. 25 | ----stdout 26 | FALSE 27 | TRUE 28 | ----end -------------------------------------------------------------------------------- /Tests/operators-pwr.alw: -------------------------------------------------------------------------------- 1 | begin 2 | complex x; 3 | 4 | write(0 ** 0); 5 | write(1 ** 0, 1 ** 1, 1 ** 2); 6 | write(1 ** 0, 1 ** 1, 1 ** 2); 7 | write(" "); 8 | 9 | write(0.0 ** 0); 10 | write(10.0 ** 0, 10.0 ** 1, 10.0 ** 2, 10.0 ** 20); 11 | write(10.0 ** 0, 10.0 ** -1, 10.0 ** -2, 10.0 ** -20); 12 | write(" "); 13 | 14 | x := 7 - 4i; 15 | write(x ** 0); 16 | write(x ** 1); 17 | write(x ** 2); 18 | write(x ** 20); 19 | end. 20 | ----stdout 21 | 1 22 | 1 1 1 23 | 1 1 1 24 | 25 | 1 26 | 1 10 100 1'+20 27 | 1 0.1 0.01 1'-20 28 | 29 | 1 0I 30 | 7 -4I 31 | 33 -56I 32 | -7.741605'+17 1.101422'+18I 33 | ----end 34 | -------------------------------------------------------------------------------- /Tests/operators-real-divide-by-0.alw: -------------------------------------------------------------------------------- 1 | begin 2 | real x, y; 3 | x := 0.0; 4 | y := 1.0 / x; 5 | write(y); 6 | end. 7 | ----stderr 8 | Tests/operators-real-divide-by-0.alw:4:14: Floating-point division by zero. 9 | ----exitcode 10 | 1 11 | ----end 12 | -------------------------------------------------------------------------------- /Tests/operators-string-substring-negative-index.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(6) s6; 3 | 4 | s6 := "012345"; 5 | for i := 4 step -1 until -1 do 6 | write(s6(i|2)) 7 | end. 8 | ----stdout 9 | 45 10 | 34 11 | 23 12 | 12 13 | 01 14 | ----stderr 15 | Tests/operators-string-substring-negative-index.alw:6:14: Invalid substring (-1|2). 16 | ----exitcode 17 | 1 18 | ----end 19 | -------------------------------------------------------------------------------- /Tests/operators-string-substring-too-long.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(3) s3; 3 | 4 | s3 := "012"; 5 | s3 := s3(0|4); 6 | end. 7 | ----compile 8 | Tests/operators-string-substring-too-long.alw:5:11: a STRING(3) can never contain 4 character substrings 9 | ----end 10 | -------------------------------------------------------------------------------- /Tests/operators-string-substring.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(6) s; 3 | string(6) array A (1::2); 4 | 5 | A(1) := "abcdef"; 6 | assert A(1)(0|3) = "abc"; 7 | s := "012345"; 8 | s(2|3) := A(1)(0|3); 9 | assert s = "01abc5"; 10 | 11 | A(1)(0|2) := s(4|2); 12 | assert A(1) = "c5cdef" 13 | end. 14 | -------------------------------------------------------------------------------- /Tests/operators-string.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(3) s3; 3 | string(6) s6, s6_2; 4 | 5 | assert "aaa" < "zzz"; 6 | assert "zzz" > "aaa"; 7 | assert "aaa" <= "zzz"; 8 | assert "zzz" >= "aaa"; 9 | assert "zzz" ~= "aaa"; 10 | assert "aaa" = "aaa"; 11 | assert "aaa" >= "aaa"; 12 | assert "aaa" <= "aaa"; 13 | assert "aaa" < "aaaa"; 14 | assert "aaaa" > "aaa"; 15 | assert "aaaa" ~= "aaa"; 16 | 17 | 18 | s6 := "012345"; 19 | s3 := s6(0|3); assert s3 = "012"; 20 | s3 := s6(1|3); assert s3 = "123"; 21 | s3 := s6(2|3); assert s3 = "234"; 22 | s3 := s6(3|3); assert s3 = "345"; 23 | 24 | s6 := s6(4|2); assert s6 = "45 "; 25 | 26 | s6 := "12"; 27 | s6_2 := "12 "; 28 | assert s6 = s6_2; 29 | assert s6_2 = s6; 30 | end. -------------------------------------------------------------------------------- /Tests/operators-triplet-rule.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write(3 / 7); comment INTEGER / INTEGER -> LONG REAL (special case); 3 | write(3 / 7.0); comment INTEGER / REAL -> REAL; 4 | write(3.0 / 7); comment REAL / INTEGER -> REAL; 5 | write(3I / 7); comment COMPLEX / INTEGER -> COMPLEX; 6 | write(3I / 7.0); comment COMPLEX / REAL -> COMPLEX; 7 | end. 8 | ----stdout 9 | 0.4285714 10 | 0.4285714 11 | 0.4285714 12 | 0 0.4285714I 13 | 0 0.4285714I 14 | ----end -------------------------------------------------------------------------------- /Tests/parser-expressions.dat: -------------------------------------------------------------------------------- 1 | a 2 | a 3 | 4 | a(b) 5 | a(b) 6 | 7 | a(b,c) 8 | a(b, c) 9 | 10 | a(b,c)(d|1) 11 | a(b, c)(d | 1) 12 | 13 | a(b,c)(d|e) 14 | ^Syntax Error 15 | 16 | $ // is a synonym for | 17 | 18 | a(b,c)(d//1) 19 | a(b, c)(d | 1) 20 | 21 | a(b / c // 1) 22 | a((b / c) | 1) 23 | 24 | $ Empty statements may be actual parameters 25 | 26 | a() 27 | a((*empty*)) 28 | 29 | a(, b) 30 | a((*empty*), b) 31 | 32 | a(b,) 33 | a(b, (*empty*)) 34 | 35 | a(b,,c) 36 | a(b, (*empty*), c) 37 | 38 | a + b 39 | (a + b) 40 | 41 | a * b 42 | (a * b) 43 | 44 | a + b + c 45 | ((a + b) + c) 46 | 47 | a / b / c 48 | ((a / b) / c) 49 | 50 | $ looks wrong, but is correct: 51 | a ** b ** c 52 | ((a ** b) ** c) 53 | 54 | a + b * c 55 | (a + (b * c)) 56 | 57 | a * b + c 58 | ((a * b) + c) 59 | 60 | (a + b) * c 61 | ((a + b) * c) 62 | 63 | a * (b + c) 64 | (a * (b + c)) 65 | 66 | a = b OR c 67 | ((a = b) OR c) 68 | 69 | ~ a = b OR c 70 | ((~ (a = b)) OR c) 71 | 72 | $This is the proper symbol for "not": 73 | ¬ a 74 | (~ a) 75 | 76 | a AND b OR c 77 | ((a AND b) OR c) 78 | 79 | IF a THEN b ELSE c 80 | (IF a THEN b ELSE c) 81 | 82 | a + IF b THEN c ELSE d 83 | (a + (IF b THEN c ELSE d)) 84 | 85 | IF a THEN b ELSE c + d 86 | (IF a THEN b ELSE (c + d)) 87 | 88 | IF IF a THEN b ELSE c THEN d ELSE e 89 | (IF (IF a THEN b ELSE c) THEN d ELSE e) 90 | 91 | IF a THEN IF b THEN c ELSE d ELSE e 92 | (IF a THEN (IF b THEN c ELSE d) ELSE e) 93 | 94 | IF a THEN b ELSE IF c THEN d ELSE e 95 | (IF a THEN b ELSE (IF c THEN d ELSE e)) 96 | 97 | $ The precedence of unary minus is up with binary minus, which is a little odd: 98 | 99 | -a 100 | (- a) 101 | 102 | -a - b 103 | ((- a) - b) 104 | 105 | $ This looks odd, but is correct: 106 | - a * b 107 | (- (a * b)) 108 | 109 | $ This looks odd, but is correct: 110 | - a ** b 111 | (- (a ** b)) 112 | 113 | - IF a THEN b ELSE c 114 | (- (IF a THEN b ELSE c)) 115 | 116 | $ Other unary operators are where you'd expect them to be: 117 | 118 | ~ a AND b 119 | ((~ a) AND b) 120 | 121 | $ I though this would be a syntax error, 122 | $ because negation is non-associative, 123 | $ but it is accepted: 124 | - - a 125 | (- (- a)) 126 | 127 | x := a + b 128 | (x := (a + b)) 129 | 130 | $ This is not really allowed. Maybe it can be a type error (:= returns VOID). 131 | x := y := a + b 132 | (x := (y := (a + b))) 133 | 134 | ASSERT a > b 135 | (ASSERT (a > b)) 136 | 137 | -------------------------------------------------------------------------------- /Tests/parser-lexing-operators.dat: -------------------------------------------------------------------------------- 1 | $ parser-lexing-operators.dat -- some operator lexing peculiarities 2 | 3 | $ "NOT" was introduced as an operator after 1972 4 | 5 | a NOT= b 6 | (a ~= b) 7 | 8 | a NOT = b 9 | (a ~= b) 10 | 11 | a Not= b 12 | (a ~= b) 13 | 14 | a not = b 15 | (a ~= b) 16 | 17 | (not a) 18 | (~ a) 19 | 20 | $ Spaces are allowed between the two characters of an operator 21 | $ (Any whitespace is, but I haven't allowed newlines) 22 | 23 | a >= b 24 | (a >= b) 25 | 26 | a > = b 27 | (a >= b) 28 | 29 | a > = b 30 | (a >= b) 31 | 32 | -------------------------------------------------------------------------------- /Tests/parser-lexing.dat: -------------------------------------------------------------------------------- 1 | algolw 2 | algolw 3 | 4 | ALGOLW 5 | algolw 6 | 7 | AlgolW 8 | algolw 9 | 10 | Algol_W 11 | algol_w 12 | 13 | _Algol_W 14 | ^Unexpected character '_' 15 | 16 | $ This gets lexed as an integer followed by a constant, but that isn't allowed anyway. 17 | 5algolW 18 | ^Syntax Error 19 | 20 | algol68 21 | algol68 22 | 23 | COMMENT blah blah; AlgolW 24 | algolw 25 | 26 | Comment blah blah; AlgolW 27 | algolw 28 | 29 | comment blah blah; AlgolW 30 | algolw 31 | 32 | comment blah blah AlgolW 33 | ^This comment is not closed with a semicolon 34 | 35 | % blah blah; AlgolW 36 | algolw 37 | 38 | % blah blah % AlgolW 39 | algolw 40 | 41 | % blah blah AlgolW 42 | ^This comment is not closed with a semicolon 43 | 44 | 1200 45 | 1200 46 | 47 | 0 48 | 0 49 | 50 | $too big, but lexically correct: 51 | 100000000000000000 52 | 100000000000000000 53 | 54 | "String" 55 | "String" 56 | 57 | #00000000 58 | #00000000 59 | 60 | #0000BEEF 61 | #0000BEEF 62 | 63 | #FFFFFFFF 64 | #FFFFFFFF 65 | 66 | $too big, but lexically correct: 67 | #FFFFFFFFF 68 | #FFFFFFFFF 69 | 70 | # 71 | ^Unexpected character '#' 72 | 73 | ' 74 | ^Unexpected character '\'' 75 | 76 | 0.1 77 | 0.1 78 | 79 | 1. 80 | 1.0 81 | 82 | 1.0'3 83 | 1.0'3 84 | 85 | 0.1 86 | 0.1 87 | 88 | .1 89 | 0.1 90 | 91 | 1.'3 92 | 1.0'3 93 | 94 | 1'3 95 | 1.0'3 96 | 97 | 1.'3 98 | 1.0'3 99 | 100 | '3 101 | 1.0'3 102 | 103 | 0.1I 104 | 0.1I 105 | 106 | 1.I 107 | 1.0I 108 | 109 | 1.0'3I 110 | 1.0'3I 111 | 112 | 0.1I 113 | 0.1I 114 | 115 | 1I 116 | 1.0I 117 | 118 | 1.'3I 119 | 1.0'3I 120 | 121 | 1.'3I 122 | 1.0'3I 123 | 124 | '3I 125 | 1.0'3I 126 | 127 | 0.1L 128 | 0.1L 129 | 130 | 1.L 131 | 1.0L 132 | 133 | 1.0'3L 134 | 1.0'3L 135 | 136 | 0.1L 137 | 0.1L 138 | 139 | 1L 140 | 1.0L 141 | 142 | 1.'3L 143 | 1.0'3L 144 | 145 | 1.'3L 146 | 1.0'3L 147 | 148 | '3L 149 | 1.0'3L 150 | 151 | 0.1IL 152 | 0.1IL 153 | 154 | 1IL 155 | 1.0IL 156 | 157 | 1.0'3IL 158 | 1.0'3IL 159 | 160 | 0.1IL 161 | 0.1IL 162 | 163 | 1.IL 164 | 1.0IL 165 | 166 | 1.'3IL 167 | 1.0'3IL 168 | 169 | 1.'3IL 170 | 1.0'3IL 171 | 172 | '3IL 173 | 1.0'3IL 174 | 175 | "String" 176 | "String" 177 | 178 | "String 179 | ^This string is not closed with a double quote 180 | 181 | "String\" 182 | "String\" 183 | 184 | "String"" 185 | ^This string is not closed with a double quote 186 | 187 | -------------------------------------------------------------------------------- /Tests/procedure-external-invalid.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure p1 (integer value result i); 3 | algol "{bluh}"; 4 | assert(true) 5 | end. 6 | ----compiler 7 | Tests/procedure-external-invalid.alw:3:6: the external reference "{bluh}" is not a valid C identifier 8 | ----end 9 | -------------------------------------------------------------------------------- /Tests/procedure-external.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure p1 (integer value result i); 3 | algol "p1"; 4 | 5 | integer procedure p2 (real value r); 6 | fortran "P2"; 7 | 8 | comment We just want to look at the C code of the above; 9 | assert(true) 10 | end. 11 | ----messages 12 | /* PROCEDURE p1 (INTEGER VALUE RESULT i); ALGOL "p1"; */ 13 | void p1 (int *i); 14 | 15 | /* INTEGER PROCEDURE p2 (REAL VALUE r); ALGOL "P2"; */ 16 | int P2 (double r); 17 | 18 | ----end 19 | -------------------------------------------------------------------------------- /Tests/procedure-misnamed-block.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure p; 3 | begin 4 | end p; 5 | 6 | procedure q; 7 | begin 8 | end r; 9 | 10 | procedure r; 11 | begin 12 | end; 13 | 14 | ; 15 | end 16 | ----compiler 17 | Tests/procedure-misnamed-block.alw:6:4: Note, this procedure is named q, but its block ends with r. 18 | ----end 19 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-equality-2.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record c1 (integer i1); 3 | record c2 (integer i2); 4 | record c3 (integer i3); 5 | 6 | reference(c1) r1; 7 | reference(c1,c2) r2; 8 | reference(c3) r3; 9 | 10 | reference(c1) procedure a (reference(c1) result b); 11 | null; 12 | 13 | procedure b ( reference(c1,c2) value a; 14 | reference(c1,c2) b; 15 | integer value c; 16 | reference(c1,c2) procedure d (reference(c1,c2) value a) ); 17 | begin end; 18 | 19 | r1 := a(r2); 20 | b(r2, r3, 1, a); comment should fail; 21 | end. 22 | ----compile 23 | Tests/procedure-parameters-equality-2.alw:14:19: Note, this is a call-by-name formal parameter. 24 | Tests/procedure-parameters-equality-2.alw:20:11: a REFERENCE(c3) variable is not compatible with a REFERENCE(c1, c2) name parameter 25 | ----end 26 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-equality.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record c1 (integer i1); 3 | record c2 (integer i2); 4 | record c3 (integer i3); 5 | 6 | reference(c1) r1; 7 | reference(c1,c2) r2; 8 | reference(c3) r3; 9 | 10 | reference(c1) procedure a (reference(c1) value b); 11 | null; 12 | 13 | procedure b ( reference(c1,c2) value a; 14 | reference(c1,c2) b; 15 | integer value c; 16 | reference(c1,c2) procedure d (reference(c1,c2) value a) ); 17 | begin end; 18 | 19 | b(r1, r2, 1, a); 20 | b(null, null, 1, a); 21 | b(r2, r1, 1, a); 22 | b(r2, r3, 1, a); comment should fail; 23 | end. 24 | ----compile 25 | Tests/procedure-parameters-equality.alw:14:19: Note, this is a call-by-name formal parameter. 26 | Tests/procedure-parameters-equality.alw:20:13: Note, this call-by-name parameter is an expression. 27 | Tests/procedure-parameters-equality.alw:22:11: a REFERENCE(c3) variable is not compatible with a REFERENCE(c1, c2) name parameter 28 | ----end 29 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-general.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer procedure p ( integer value v; 3 | integer result r; 4 | integer value result vr; 5 | integer n ); 6 | begin 7 | v := v + 1; 8 | r := v + vr; 9 | vr := r + v; 10 | n := n + v; 11 | v 12 | end; 13 | 14 | integer i, r0, vr0, n0; 15 | 16 | vr0 := 2; 17 | n0 := 6; 18 | i := p(1, r0, vr0, n0); 19 | write(i, r0, vr0, n0); 20 | end. 21 | ----compiler 22 | Tests/procedure-parameters-general.alw:5:26: Note, this is a call-by-name formal parameter. 23 | ----stdout 24 | 2 4 6 8 25 | ----end 26 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-hendrik.alw: -------------------------------------------------------------------------------- 1 | COMMENT 2 | Q: "Trivia question: What's the defined semantics for a VALUE 3 | RESULT parameter when the actual parameter is an array element 4 | A(i) and i changes during execution of the procedure?" 5 | 6 | A: The designator expression 'A(i)' is evaluated once at the 7 | beginning of the call, to copy a value into the VALUE RESULT 8 | parameter, and once again at the end of the call, to copy the 9 | VALUE RESULT parameter back out. ; 10 | begin 11 | integer array A(1::2); 12 | integer i; 13 | 14 | procedure p(integer value result ai); 15 | 16 | begin comment ai = A(i) = A(1) here; 17 | ai := ai + 1; 18 | 19 | i := 2; comment <--- Oh no! What have you done?; 20 | 21 | end p; comment ai = A(i) = A(2) here; 22 | 23 | A(1) := 2; 24 | A(2) := 4; 25 | 26 | i := 1; 27 | 28 | p(A(i)); 29 | 30 | assert A(1) = 2; 31 | assert A(2) = 3 32 | end. 33 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-incompatable.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer procedure a; 3 | 1; 4 | 5 | procedure p (logical procedure x); 6 | write(x); 7 | 8 | p(a) 9 | end. 10 | ----compile 11 | Tests/procedure-parameters-incompatable.alw:8:6: expected a LOGICAL PROCEDURE parameter, this is an INTEGER 12 | ----end -------------------------------------------------------------------------------- /Tests/procedure-parameters-manorboy.alw: -------------------------------------------------------------------------------- 1 | comment Knuth's "Man or boy?" test; 2 | begin 3 | integer procedure A (integer value k; integer procedure x1, x2, x3, x4, x5); 4 | begin 5 | integer procedure B; 6 | begin 7 | k := k - 1; 8 | A(k, B, x1, x2, x3, x4) 9 | end B; 10 | 11 | if k <= 0 then 12 | x4 + x5 13 | else 14 | B 15 | end A; 16 | 17 | assert A(10, 1, -1, -1 , 1 , 0) = -67 18 | end. 19 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-name-manorboy.alw: -------------------------------------------------------------------------------- 1 | comment Knuth's "Man or boy?" test; 2 | comment (Uses expressions in Name parameters, and gets away with it); 3 | begin 4 | integer procedure A (integer value k; integer x1, x2, x3, x4, x5); 5 | begin 6 | integer procedure B; 7 | begin 8 | k := k - 1; 9 | A(k, B, x1, x2, x3, x4) 10 | end B; 11 | 12 | if k <= 0 then 13 | x4 + x5 14 | else 15 | B 16 | end A; 17 | 18 | assert A(10, 1, -1, -1 , 1 , 0) = -67 19 | end. 20 | ----compiler 21 | Tests/procedure-parameters-name-manorboy.alw:4:42: Note, this is a call-by-name formal parameter. 22 | Tests/procedure-parameters-name-manorboy.alw:9:15: Note, this call-by-name parameter is an expression. 23 | Tests/procedure-parameters-name-manorboy.alw:18:17: Note, this call-by-name parameter is an expression. 24 | Tests/procedure-parameters-name-manorboy.alw:18:20: Note, this call-by-name parameter is an expression. 25 | Tests/procedure-parameters-name-manorboy.alw:18:24: Note, this call-by-name parameter is an expression. 26 | Tests/procedure-parameters-name-manorboy.alw:18:29: Note, this call-by-name parameter is an expression. 27 | Tests/procedure-parameters-name-manorboy.alw:18:33: Note, this call-by-name parameter is an expression. 28 | ----end 29 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-name-name.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer array a(1::2); 3 | 4 | integer i; 5 | 6 | procedure p (integer ai); 7 | begin 8 | assert ai = 1; 9 | ai := ai * 2; 10 | q(ai) 11 | end; 12 | 13 | procedure q (integer ai); 14 | begin 15 | i := i + 1; 16 | assert ai = 2; 17 | ai := ai * 2; 18 | assert ai = 4; 19 | end; 20 | 21 | a(1) := 1; 22 | a(2) := 2; 23 | i := 1; 24 | 25 | p(a(i)); 26 | 27 | assert a(1) = 2; 28 | assert a(2) = 4 29 | end. 30 | ----compile 31 | Tests/procedure-parameters-name-name.alw:6:17: Note, this is a call-by-name formal parameter. 32 | Tests/procedure-parameters-name-name.alw:13:17: Note, this is a call-by-name formal parameter. 33 | ----end 34 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-name.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer array a(1::2); 3 | 4 | integer i; 5 | 6 | procedure p (integer ai); 7 | begin 8 | assert ai = 1; 9 | ai := ai * 2; 10 | i := i + 1; 11 | assert ai = 2; 12 | ai := ai * 2; 13 | assert ai = 4; 14 | end; 15 | 16 | a(1) := 1; 17 | a(2) := 2; 18 | i := 1; 19 | 20 | p(a(i)); 21 | 22 | assert a(1) = 2; 23 | assert a(2) = 4 24 | end. 25 | ----compile 26 | Tests/procedure-parameters-name.alw:6:17: Note, this is a call-by-name formal parameter. 27 | ----end 28 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-procedure-incompatible.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure p (procedure q (integer i)); 3 | q(0); 4 | 5 | procedure q0 (integer result i); 6 | i := 1; 7 | 8 | p(q0) 9 | end. 10 | ----compile 11 | Tests/procedure-parameters-procedure-incompatible.alw:2:31: Note, this is a call-by-name formal parameter. 12 | Tests/procedure-parameters-procedure-incompatible.alw:3:10: Note, this call-by-name parameter is an expression. 13 | Tests/procedure-parameters-procedure-incompatible.alw:8:7: expected PROCEDURE (INTEGER) here, this is PROCEDURE (INTEGER RESULT) 14 | ----end 15 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-procedure.alw: -------------------------------------------------------------------------------- 1 | begin 2 | real procedure f (real value i); 3 | i + i / 3; 4 | 5 | real procedure g (real value i); 6 | i + i / 2; 7 | 8 | real procedure sum (integer value first, last; real procedure f (real value x)); 9 | begin 10 | real total; 11 | total := 0; 12 | for i := first until last do 13 | total := total + f(i); 14 | total 15 | end sum; 16 | 17 | real procedure sum2 (integer value first, last; real procedure f, g (real value x)); 18 | begin 19 | real total; 20 | total := 0; 21 | for i := first until last do 22 | total := total + f(g(i)); 23 | total 24 | end sum2; 25 | 26 | real procedure c (real procedure a, b (real value x); real value x); 27 | a(b(x)); 28 | 29 | real procedure sum3 ( integer value first, last; 30 | real procedure c (real procedure a, b (real value x); real value x); 31 | real procedure f, g (real value x) ); 32 | begin 33 | real total; 34 | total := 0; 35 | for i := first until last do 36 | total := total + c(f, g, i); 37 | total 38 | end sum3; 39 | 40 | write(sum(1, 10, f)); 41 | write(sum(1, 10, g)); 42 | write(sum2(1, 10, f, g)); 43 | write(sum3(1, 10, c, f, g)); 44 | end. 45 | ----stdout 46 | 73.33333 47 | 82.5 48 | 110 49 | 110 50 | ----end 51 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-result-incompatible-2.alw: -------------------------------------------------------------------------------- 1 | begin 2 | logical x; 3 | procedure p(integer result i); begin end; 4 | p(x) 5 | end. 6 | ----compile 7 | Tests/procedure-parameters-result-incompatible-2.alw:4:6: an INTEGER cannot be assigned to a LOGICAL variable 8 | ----end 9 | -------------------------------------------------------------------------------- /Tests/procedure-parameters-result-incompatible.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | procedure p(real value okay; real result not_okay); begin end; 4 | p(i, i) 5 | end. 6 | ----compile 7 | Tests/procedure-parameters-result-incompatible.alw:4:9: a REAL cannot be assigned to an INTEGER variable 8 | ----end 9 | -------------------------------------------------------------------------------- /Tests/procedure-parameters.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure a; 3 | begin 4 | write("BING!"); 5 | end a; 6 | 7 | procedure p (procedure w); 8 | begin 9 | for i := 1 until 3 do 10 | w; 11 | end p; 12 | 13 | integer i; 14 | 15 | p(a); 16 | p(write("BONG!")); 17 | 18 | p( ); 19 | 20 | i := 0; 21 | p(i := i + 1); 22 | assert i = 3 23 | end. 24 | ----stdout 25 | BING! 26 | BING! 27 | BING! 28 | BONG! 29 | BONG! 30 | BONG! 31 | ----end -------------------------------------------------------------------------------- /Tests/procedure-result.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i0; 3 | procedure p(integer result i1); 4 | begin 5 | i1 := 2; 6 | assert i0 = 1; 7 | i0 := 3; 8 | assert i0 = 3; 9 | assert i1 = 2; 10 | end; 11 | i0 := 1; 12 | p(i0); 13 | assert i0 = 2 14 | end. 15 | -------------------------------------------------------------------------------- /Tests/procedure-value-result.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i0; 3 | procedure p(integer value result i1); 4 | begin 5 | assert i1 = 1; 6 | i1 := 2; 7 | assert i0 = 1; 8 | i0 := 3; 9 | assert i0 = 3; 10 | assert i1 = 2; 11 | end; 12 | i0 := 1; 13 | p(i0); 14 | assert i0 = 2 15 | end. 16 | -------------------------------------------------------------------------------- /Tests/procedure-value.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i0; 3 | procedure p(integer value i1); 4 | begin 5 | assert i1 = 1; 6 | i1 := 2; 7 | assert i0 = 1; 8 | i0 := 3; 9 | assert i0 = 3; 10 | assert i1 = 2; 11 | end; 12 | i0 := 1; 13 | p(i0); 14 | assert i0 = 3 15 | end. 16 | -------------------------------------------------------------------------------- /Tests/procedure-visibility.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure P1; begin P2 end; 3 | procedure P2; begin I := 42 end; 4 | bits B; 5 | integer I; 6 | 7 | P1; 8 | assert I = 42 9 | end. 10 | -------------------------------------------------------------------------------- /Tests/program-exit-code-int.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure exit(integer value code); algol "exit"; %use C's exit function% 3 | write(2 + 2); 4 | exit(3); 5 | end. 6 | ----messages 7 | /* PROCEDURE exit (INTEGER VALUE code); ALGOL "exit"; */ 8 | void exit (int code); 9 | 10 | ----stdout 11 | 4 12 | ----exitcode 13 | 3 14 | ----end 15 | -------------------------------------------------------------------------------- /Tests/program-exit-code-none.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write(2 + 2) 3 | end. 4 | ----stdout 5 | 4 6 | ----exitcode 7 | 0 8 | ----end -------------------------------------------------------------------------------- /Tests/program-exit-code-statement.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write(2 + 2) 3 | end. 4 | ----stdout 5 | 4 6 | ----exitcode 7 | 0 8 | ----end -------------------------------------------------------------------------------- /Tests/program-exit-code-wrong-type.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write(2 + 2); 3 | TRUE 4 | end. 5 | ----compile 6 | Tests/program-exit-code-wrong-type.alw:3:4: a program should be a statement, this returns a LOGICAL 7 | ----end 8 | -------------------------------------------------------------------------------- /Tests/records-0.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record R1 (integer f1); 3 | record R2 (integer f2); 4 | record R3 (integer f3); 5 | 6 | reference (R1,R2,R3) x1; 7 | reference ( R2,R3) x2; 8 | reference (R1,R2 ) x3; 9 | 10 | x1 := R1(1); 11 | x2 := R2(3); 12 | x3 := x2; 13 | 14 | end. -------------------------------------------------------------------------------- /Tests/records-allocation-expressions.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record C ( 3 | reference(C) r; 4 | string(5) s; 5 | string(8) t; 6 | integer i 7 | ); 8 | reference(C) a, b; 9 | 10 | a := C(null, "AAA", "BBB", 1); 11 | assert(r(a)=null and s(a)="AAA" and t(a)="BBB" and i(a)=1); 12 | 13 | b := C(a, , "XXX", 2); 14 | assert(r(b)=a and t(b)="XXX" and i(b)=2); 15 | 16 | a := b; 17 | b := C(b, "XXX", , 3); 18 | assert(r(b)=a and r(b)~=b); %i.e. the 'b' from before the assignment% 19 | assert(s(b)="XXX"); 20 | assert(i(b)=3); 21 | 22 | b := C( , , , ); 23 | 24 | b := C; 25 | end. 26 | -------------------------------------------------------------------------------- /Tests/records-class-set-compatibility-error.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec2(integer f2); 3 | record rec3(integer f3); 4 | record rec4(integer f4); 5 | record rec5(integer f5); 6 | 7 | reference(rec2, rec3, rec4) r234; 8 | reference(rec4, rec5) r45; 9 | 10 | r45 := rec5; 11 | r234 := r45 12 | end. 13 | ----stderr 14 | Tests/records-class-set-compatibility-error.alw:11:4: reference error: a REFERENCE(rec4, rec3, rec2) cannot be made to refer to a 'rec5' record. 15 | ----exitcode 16 | 1 17 | ----end 18 | -------------------------------------------------------------------------------- /Tests/records-class-set-compatibility.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec2(integer f2); 3 | record rec3(integer f3); 4 | record rec4(integer f4); 5 | 6 | reference(rec2 ) r2; 7 | reference( rec3 ) r3; 8 | reference( rec4) r4; 9 | reference(rec2, rec3 ) r23; 10 | reference(rec2, rec4) r24; 11 | reference(rec2, rec3, rec4) r234; 12 | 13 | r2 := rec2; 14 | r2 := r2; assert r2 is rec2; 15 | r23 := r2; assert r23 is rec2; 16 | r24 := r2; assert r24 is rec2; 17 | r234 := r2; assert r234 is rec2; 18 | 19 | r23 := rec2; 20 | r2 := r23; assert r2 is rec2; 21 | r23 := r23; assert r23 is rec2; 22 | r24 := r23; assert r24 is rec2; 23 | r234 := r23; assert r234 is rec2; 24 | 25 | r234 := rec2; 26 | r2 := r234; assert r2 is rec2; 27 | r23 := r234; assert r23 is rec2; 28 | r24 := r234; assert r24 is rec2; 29 | r234 := r234; assert r234 is rec2; 30 | end. 31 | -------------------------------------------------------------------------------- /Tests/records-field-of-null-run-time.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec1 (integer f1); 3 | reference(rec1) r; 4 | r := null; 5 | f1(r) := 1; 6 | end. 7 | ----stderr 8 | Tests/records-field-of-null-run-time.alw:5:4: reference error: tried to find field f1 of a NULL reference 9 | ----exitcode 10 | 1 11 | ----end -------------------------------------------------------------------------------- /Tests/records-fields-do-not-work-on-null.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec(integer f); 3 | reference(rec) r; 4 | 5 | r := rec(42); 6 | assert(f(r) = 42); 7 | 8 | r := null; 9 | assert(f(r) = 42) 10 | end. 11 | ----stderr 12 | Tests/records-fields-do-not-work-on-null.alw:9:11: reference error: tried to find field f of a NULL reference 13 | ----exitcode 14 | 1 15 | ----end 16 | -------------------------------------------------------------------------------- /Tests/records-fields-wrong-class-compile-time.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec1 (integer f1); 3 | record rec2 (integer f2); 4 | reference(rec1) r1; 5 | r1 := rec1; 6 | f2(r1) := 1; 7 | end. 8 | ----compiler 9 | Tests/records-fields-wrong-class-compile-time.alw:6:7: a REFERENCE(rec1) can never have the field f2 10 | ----end -------------------------------------------------------------------------------- /Tests/records-fields-wrong-class-run-time.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec1 (integer f1); 3 | record rec2 (integer f2); 4 | reference(rec1,rec2) r; 5 | r := rec1; 6 | f2(r) := 1; 7 | end. 8 | ----stderr 9 | Tests/records-fields-wrong-class-run-time.alw:6:4: reference error: tried to find field f2 of a REFERENCE(rec1) 10 | ----exitcode 11 | 1 12 | ----end -------------------------------------------------------------------------------- /Tests/records-is-never-of-class.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record a (integer i); 3 | record b (integer j); 4 | record c (integer k); 5 | reference(a, b) x; 6 | assert(x is c) 7 | end. 8 | ----compiler 9 | Tests/records-is-never-of-class.alw:6:18: a REFERENCE(a, b) will never refer to a RECORD c 10 | ----end 11 | -------------------------------------------------------------------------------- /Tests/records-is-null.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record node (integer label; reference(node) next); 3 | reference(node) node1, node2, node3, ptr; 4 | node3 := node(3, null); 5 | node2 := node(2, node3); 6 | node1 := node(1, node2); 7 | ptr := node1; 8 | while ptr is node do begin 9 | write(label(ptr)); 10 | ptr := next(ptr) 11 | end; 12 | write("done"); 13 | end. 14 | ----stdout 15 | 1 16 | 2 17 | 3 18 | done 19 | ----end 20 | -------------------------------------------------------------------------------- /Tests/records-is.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec1(integer f1); 3 | record rec2(integer f2); 4 | record rec3(integer f3); 5 | 6 | reference(rec1, rec2, rec3) r; 7 | 8 | r := null; 9 | assert(r = null); 10 | assert(~ r is rec1); 11 | assert(~ r is rec2); 12 | assert(~ r is rec3); 13 | 14 | r := rec1; 15 | assert(r ~= null); 16 | assert( r is rec1); 17 | assert(~ r is rec2); 18 | assert(~ r is rec3); 19 | 20 | r := rec2; 21 | assert(r ~= null); 22 | assert(~ r is rec1); 23 | assert( r is rec2); 24 | assert(~ r is rec3); 25 | 26 | r := rec3; 27 | assert(r ~= null); 28 | assert(~ r is rec1); 29 | assert(~ r is rec2); 30 | assert( r is rec3); 31 | end. 32 | 33 | -------------------------------------------------------------------------------- /Tests/records-parameters.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec1(integer f1); 3 | record rec2(integer f2); 4 | record rec3(integer f3); 5 | 6 | 7 | procedure p(reference(rec1, rec2) v); 8 | begin 9 | if v ~= null then v := rec2; 10 | end; 11 | 12 | reference(rec1, rec2) r; 13 | reference(rec2) r2; 14 | 15 | r := rec1; 16 | p(r); 17 | assert(r is rec2); 18 | end. 19 | ----compile 20 | Tests/records-parameters.alw:7:16: Note, this is a call-by-name formal parameter. 21 | ----end 22 | -------------------------------------------------------------------------------- /Tests/records-record-designator-class.alw: -------------------------------------------------------------------------------- 1 | comment Record designators: return a reference of the correct class; 2 | begin 3 | record rec1(integer f1); 4 | record rec2(integer f2); 5 | reference(rec1, rec2) r0; 6 | reference(rec1) r1; 7 | reference(rec2) r2; 8 | 9 | r0 := rec1; 10 | r0 := rec2; 11 | 12 | r1 := rec1; 13 | r2 := rec2; 14 | 15 | r1 := rec2 comment It won't like that; 16 | end. 17 | ----compiler 18 | Tests/records-record-designator-class.alw:15:4: a REFERENCE(rec2) cannot be assigned to a REFERENCE(rec1) variable 19 | ----end 20 | -------------------------------------------------------------------------------- /Tests/records-record-designators.alw: -------------------------------------------------------------------------------- 1 | comment Record designators take no parameters or as many parameters as fields; 2 | comment Uninitialized record fields are assigned zero-like default values by default (not required); 3 | comment EXCEPT for ninitialized references, which the algolw runtime will give an error for; 4 | begin 5 | record rec ( 6 | integer i; 7 | real x; 8 | complex c; 9 | logical l; 10 | bits b; 11 | reference(rec) r; 12 | string(3) s 13 | ); 14 | 15 | reference(rec) ref; 16 | 17 | ref := rec; 18 | 19 | assert(ref ~= null); 20 | 21 | i(ref) := 1; comment Just to be sure that we really do get a new record next; 22 | x(ref) := 2.0; 23 | c(ref) := 3.0; 24 | 25 | ref := rec(,,,,,,); 26 | 27 | ref := rec(1, , 2+3i, true, , , "Yay"); 28 | 29 | assert(i(ref) = 1); 30 | assert(c(ref) = 2+3i); 31 | assert(l(ref)); 32 | assert(s(ref) = "Yay"); 33 | end. 34 | -------------------------------------------------------------------------------- /Tests/records-string-fields.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec(string(5) s); 3 | string(5) t, u; 4 | reference(rec) r; 5 | 6 | r := rec("012"); 7 | u := "012"; 8 | 9 | t := u; 10 | assert t = "012 "; 11 | assert t = "012"; 12 | 13 | t := s(r); 14 | assert t = "012 "; 15 | assert t = "012"; 16 | assert s(r) = "012"; 17 | assert s(r) = "012 "; 18 | end. -------------------------------------------------------------------------------- /Tests/records-uninitialized-element.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec(reference(rec) f); 3 | reference(rec) array a (1::2); 4 | f(a(1)) := null 5 | end. 6 | ----stderr 7 | Tests/records-uninitialized-element.alw:4:5: reference error: tried to find field f of an uninitialized reference 8 | ----exitcode 9 | 1 10 | ----end 11 | -------------------------------------------------------------------------------- /Tests/records-uninitialized-field.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec(reference(rec) f); 3 | reference(rec) r; 4 | f(r) := null 5 | end. 6 | ----stderr 7 | Tests/records-uninitialized-field.alw:4:5: reference error: tried to find field f of an uninitialized reference 8 | ----exitcode 9 | 1 10 | ----end 11 | -------------------------------------------------------------------------------- /Tests/records-uninitialized-variable.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record rec(integer f); 3 | reference(rec) r; 4 | r := null; 5 | write(f(r)) 6 | end. 7 | ----stderr 8 | Tests/records-uninitialized-variable.alw:5:11: reference error: tried to find field f of a NULL reference 9 | ----exitcode 10 | 1 11 | ----end 12 | -------------------------------------------------------------------------------- /Tests/records-visibility.alw: -------------------------------------------------------------------------------- 1 | comment A reference type for a record can be made anywhere it is in scope, including in its own definition; 2 | comment nested field designators work; 3 | begin 4 | record rec1(reference(rec1,rec2) f1); 5 | record rec2(reference(rec1,rec2) f2); 6 | begin 7 | record rec3(reference(rec1,rec2,rec3) f3); 8 | 9 | reference(rec1,rec2,rec3) r; 10 | 11 | r := rec3(rec2(rec1(null))); 12 | 13 | assert r is rec3; 14 | assert f3(r) is rec2; 15 | assert f2(f3(r)) is rec1; 16 | assert f1(f2(f3(r))) = null; 17 | end 18 | end. 19 | -------------------------------------------------------------------------------- /Tests/records.alw: -------------------------------------------------------------------------------- 1 | begin 2 | record r (integer i; real n); 3 | reference(r) x; 4 | 5 | x := r(1, 1.0); 6 | assert i(x) = 1; 7 | assert n(x) = 1.0; 8 | 9 | i(x) := 2; 10 | n(x) := 2.0; 11 | assert i(x) = 2; 12 | assert n(x) = 2.0 13 | end. 14 | -------------------------------------------------------------------------------- /Tests/roman4.alw: -------------------------------------------------------------------------------- 1 | BEGIN 2 | 3 | PROCEDURE ROMAN (INTEGER VALUE NUMBER; STRING(15) RESULT CHARACTERS; INTEGER RESULT LENGTH); 4 | COMMENT 5 | Returns the Roman number of an integer between 1 and 3999. 6 | "MMMDCCCLXXXVIII" (15 characters long) is the longest Roman number under 4000; 7 | BEGIN 8 | INTEGER PLACE, POWER; 9 | 10 | PROCEDURE APPEND (STRING(1) VALUE C); 11 | BEGIN CHARACTERS(LENGTH|1) := C; LENGTH := LENGTH + 1 END; 12 | 13 | PROCEDURE I; APPEND(CASE PLACE OF ("I","X","C","M")); 14 | PROCEDURE V; APPEND(CASE PLACE OF ("V","L","D")); 15 | PROCEDURE X; APPEND(CASE PLACE OF ("X","C","M")); 16 | 17 | ASSERT (NUMBER >= 1) AND (NUMBER < 4000); 18 | 19 | CHARACTERS := " "; 20 | LENGTH := 0; 21 | POWER := 1000; 22 | PLACE := 4; 23 | WHILE PLACE > 0 DO 24 | BEGIN 25 | CASE NUMBER DIV POWER + 1 OF BEGIN 26 | BEGIN END; 27 | BEGIN I END; 28 | BEGIN I; I END; 29 | BEGIN I; I; I END; 30 | BEGIN I; V END; 31 | BEGIN V END; 32 | BEGIN V; I END; 33 | BEGIN V; I; I END; 34 | BEGIN V; I; I; I END; 35 | BEGIN I; X END 36 | END; 37 | NUMBER := NUMBER REM POWER; 38 | POWER := POWER DIV 10; 39 | PLACE := PLACE - 1 40 | END 41 | END ROMAN; 42 | 43 | INTEGER I; 44 | STRING(15) S; 45 | 46 | ROMAN(1, S, I); WRITE(S, I); 47 | ROMAN(3999, S, I); WRITE(S, I); 48 | ROMAN(3888, S, I); WRITE(S, I); 49 | ROMAN(2009, S, I); WRITE(S, I); 50 | ROMAN(405, S, I); WRITE(S, I); 51 | END. 52 | ----stdout 53 | I 1 54 | MMMCMXCIX 9 55 | MMMDCCCLXXXVIII 15 56 | MMIX 4 57 | CDV 3 58 | ----end 59 | -------------------------------------------------------------------------------- /Tests/standard-analysis-exp.alw: -------------------------------------------------------------------------------- 1 | begin 2 | for i := 700 until 710 do 3 | write(i, exp(i)) 4 | end. 5 | ----stdout 6 | 700 1.014232'+304 7 | 701 2.756969'+304 8 | 702 7.494218'+304 9 | 703 2.03714'+305 10 | 704 5.537519'+305 11 | 705 1.505254'+306 12 | 706 4.091704'+306 13 | 707 1.112241'+307 14 | 708 3.023383'+307 15 | 709 8.218407'+307 16 | 710 17 | ----stderr 18 | Tests/standard-analysis-exp.alw:3:16: Argument of EXP or LONGEXP out of domain. 19 | ----exitcode 20 | 1 21 | ----end 22 | -------------------------------------------------------------------------------- /Tests/standard-analysis.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write("sqrt(0.5) ", sqrt(0.5)); 3 | write("exp(0.5) ", exp(0.5)); 4 | write("ln(0.5) ", ln(0.5)); 5 | write("log(0.5) ", log(0.5)); 6 | write("sin(0.5) ", sin(0.5)); 7 | write("cos(0.5) ", cos(0.5)); 8 | write("arctan(0.5) ", arctan(0.5)); 9 | write(" "); 10 | write("longsqrt(0.5) ", longsqrt(0.5)); 11 | write("longexp(0.5) ", longexp(0.5)); 12 | write("longln(0.5) ", longln(0.5)); 13 | write("longlog(0.5) ", longlog(0.5)); 14 | write("longsin(0.5) ", longsin(0.5)); 15 | write("longcos(0.5) ", longcos(0.5)); 16 | write("longarctan(0.5) ", longarctan(0.5)); 17 | end. 18 | ----stdout 19 | sqrt(0.5) 0.7071068 20 | exp(0.5) 1.648721 21 | ln(0.5) -0.6931472 22 | log(0.5) -0.30103 23 | sin(0.5) 0.4794255 24 | cos(0.5) 0.8775826 25 | arctan(0.5) 0.4636476 26 | 27 | longsqrt(0.5) 0.7071068 28 | longexp(0.5) 1.648721 29 | longln(0.5) -0.6931472 30 | longlog(0.5) -0.30103 31 | longsin(0.5) 0.4794255 32 | longcos(0.5) 0.8775826 33 | longarctan(0.5) 0.4636476 34 | ----end -------------------------------------------------------------------------------- /Tests/standard-predefined-variables.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write(maxinteger); 3 | write(pi); 4 | write(maxreal); 5 | write(epsilon); 6 | write(longepsilon); 7 | end. 8 | ----stdout 9 | 2147483647 10 | 3.141593 11 | 1.797693'+308 12 | 2.220446'-16 13 | 2.220446'-16 14 | ----end 15 | -------------------------------------------------------------------------------- /Tests/standard-read-exception-null.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(5) s; 3 | integer i; 4 | real r; 5 | complex c; 6 | logical l; 7 | bits b; 8 | 9 | endfile := null; 10 | for counter := 1 until 6 do 11 | begin 12 | read(s, i, r, c, l, b); 13 | write(s, i, r, c, l, b) 14 | end; 15 | write("(end)") 16 | end. 17 | ----stdin 18 | "aaaaa" 1 1.0 1.0+1.0i true #1 19 | "bbbbb" 2 2.0 2.0+2.0i true #2 20 | "ccccc" 3 3.0 3.0+3.0i true #3 21 | ----stdout 22 | aaaaa 1 1 1 1I TRUE 1 23 | bbbbb 2 2 2 2I TRUE 2 24 | ccccc 3 3 3 3I TRUE 3 25 | 0 0 0 0I FALSE 0 26 | 0 0 0 0I FALSE 0 27 | 0 0 0 0I FALSE 0 28 | (end) 29 | ----end -------------------------------------------------------------------------------- /Tests/standard-read-exception.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(5) s; 3 | integer i; 4 | real r; 5 | complex c; 6 | logical l; 7 | bits b; 8 | 9 | xcplimit(endfile) := 6; 10 | xcpmark(endfile) := false; 11 | xcpmsg(endfile) := "That's your lot."; 12 | 13 | while true do 14 | begin 15 | read(s, i, r, c, l, b); 16 | write(s, i, r, c, l, b) 17 | end; 18 | write("You shouldn't see this.") 19 | end. 20 | ----stdin 21 | "aaaaa" 1 1.0 1.0+1.0i true #1 22 | "bbbbb" 2 2.0 2.0+2.0i true #2 23 | "ccccc" 3 3.0 3.0+3.0i true #3 24 | ----stdout 25 | aaaaa 1 1 1 1I TRUE 1 26 | bbbbb 2 2 2 2I TRUE 2 27 | ccccc 3 3 3 3I TRUE 3 28 | 0 0 0 0I FALSE 0 29 | ----stderr 30 | Tests/standard-read-exception.alw:15:10: That's your lot. 31 | ----exitcode 32 | 1 33 | ----end -------------------------------------------------------------------------------- /Tests/standard-read-integer.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i, j, k; 3 | read(i, j, k); 4 | write(i, j, k); 5 | read(i, j); 6 | write(i, j); 7 | readon(i); 8 | write(i) 9 | end. 10 | ----stdin 11 | 1 123 -42 -9999 12 | 2 3 -9999 13 | ----stdout 14 | 1 123 -42 15 | 2 3 16 | -9999 17 | ----end 18 | -------------------------------------------------------------------------------- /Tests/standard-read-iocontrol.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | readon(i); write(i); 4 | readon(i); write(i); 5 | 6 | iocontrol(1); 7 | 8 | readon(i); write(i); 9 | readon(i); write(i); 10 | 11 | read(i); write(i); 12 | readon(i); write(i); 13 | end. 14 | ----stdin 15 | 1 2 3 16 | 4 5 6 17 | 7 8 18 | ----stdout 19 | 1 20 | 2 21 | 4 22 | 5 23 | 7 24 | 8 25 | ----end -------------------------------------------------------------------------------- /Tests/standard-read-real.alw: -------------------------------------------------------------------------------- 1 | begin 2 | real r; 3 | while true do 4 | begin 5 | readon(r); 6 | write(r); 7 | end 8 | end. 9 | ----stdin 10 | 12 +12 12l 11 | 12. +12. 12.l 12 | .34 +.34 .34l 13 | 12.34 +12.34 12.34l 14 | 12'5 +12'5 12'5l 15 | 12.'5 +12.'5 12.'5l 16 | .34'5 +.34'5 .34'5l 17 | 12.34'5 +12.34'5 12.34'5l 18 | 12'+5 +12'+5 12'+5l 19 | 12.'+5 +12.'+5 12.'+5l 20 | .34'+5 +.34'+5 .34'+5l 21 | 12.34'+5 +12.34'+5 12.34'+5l 22 | '+5 +'+5 '+5l 23 | ----stdout 24 | 12 25 | 12 26 | 12 27 | 12 28 | 12 29 | 12 30 | 0.34 31 | 0.34 32 | 0.34 33 | 12.34 34 | 12.34 35 | 12.34 36 | 1200000 37 | 1200000 38 | 1200000 39 | 1200000 40 | 1200000 41 | 1200000 42 | 34000 43 | 34000 44 | 34000 45 | 1234000 46 | 1234000 47 | 1234000 48 | 1200000 49 | 1200000 50 | 1200000 51 | 1200000 52 | 1200000 53 | 1200000 54 | 34000 55 | 34000 56 | 34000 57 | 1234000 58 | 1234000 59 | 1234000 60 | 100000 61 | 100000 62 | 100000 63 | ----stderr 64 | Tests/standard-read-real.alw:5:10: Unexpected end of input. 65 | ----exitcode 66 | 1 67 | ----end 68 | -------------------------------------------------------------------------------- /Tests/standard-read-strings.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(3) s; 3 | while true do 4 | begin 5 | readon(s); 6 | write("'", s, "' ") 7 | end 8 | end. 9 | ----stdin 10 | "abc" "a" "" """" """a" "a""" "abcd" 11 | ----stdout 12 | 'abc' 13 | 'a ' 14 | ' ' 15 | '"" ' 16 | '""a' 17 | 'a""' 18 | ----stderr 19 | Tests/standard-read-strings.alw:5:11: String too long on line 1 of the standard input. 20 | ----exitcode 21 | 1 22 | ----end 23 | -------------------------------------------------------------------------------- /Tests/standard-read.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(3) s; 3 | logical a,b; 4 | bits x; 5 | integer n; 6 | real r; 7 | complex c; 8 | 9 | for i := 1 until 6 do 10 | begin 11 | readon(s); 12 | write("'", s, "' ") 13 | end; 14 | read(a,b); 15 | write(a,b); 16 | for i := 1 until 4 do 17 | begin 18 | readon(x); 19 | write(x) 20 | end; 21 | for i := 1 until 5 do 22 | begin 23 | readon(n); 24 | write(n) 25 | end; 26 | for i := 1 until 8 do 27 | begin 28 | readon(r); 29 | write(r) 30 | end; 31 | for i := 1 until 2 do 32 | for i := 1 until 8 do 33 | begin 34 | readon(c); 35 | write(c) 36 | end; 37 | end. 38 | ----stdin 39 | "abc" "a" "" """" """a" "a""" 40 | TRUE FALSE 41 | #0 #1 #ffffffff #FFFFFFFF 42 | +10 -10 10 00010 -000010 43 | 10. .1 0.1 1'-1 10'0 +10'2 +10'+2 10 44 | 10.i 45 | .1i 46 | 0.1i 47 | 1'-1i 48 | 10'0i 49 | +10'2i 50 | +10'+2i 51 | 10i 52 | 10.+2i 53 | .1+2i 54 | 0.1+0.2i 55 | 1'-1+2'-2i 56 | 10'0-2.0i 57 | +10'2-.2i 58 | +10'+2 59 | 10+2i 60 | 61 | ----stdout 62 | 'abc' 63 | 'a ' 64 | ' ' 65 | '"" ' 66 | '""a' 67 | 'a""' 68 | TRUE FALSE 69 | 0 70 | 1 71 | FFFFFFFF 72 | FFFFFFFF 73 | 10 74 | -10 75 | 10 76 | 10 77 | -10 78 | 10 79 | 0.1 80 | 0.1 81 | 0.1 82 | 10 83 | 1000 84 | 1000 85 | 10 86 | 0 10I 87 | 0 0.1I 88 | 0 0.1I 89 | 0 0.1I 90 | 0 10I 91 | 0 1000I 92 | 0 1000I 93 | 0 10I 94 | 10 2I 95 | 0.1 2I 96 | 0.1 0.2I 97 | 0.1 0.02I 98 | 10 -2I 99 | 1000 -0.2I 100 | 1000 0I 101 | 10 2I 102 | ----end 103 | -------------------------------------------------------------------------------- /Tests/standard-readcard-eof.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(80) card; 3 | for i := 1 until 4 do 4 | begin 5 | readcard(card); 6 | write(card); 7 | end 8 | end. 9 | ----stdin 10 | line 1 11 | line 2 12 | line 3 13 | ----stdout 14 | line 1 15 | line 2 16 | line 3 17 | ----stderr 18 | Tests/standard-readcard-eof.alw:5:10: Unexpected end of input. 19 | ----exitcode 20 | 1 21 | ----end 22 | -------------------------------------------------------------------------------- /Tests/standard-readcard-exception-eof.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(5) s; 3 | 4 | xcplimit(endfile) := 1; 5 | xcpmark(endfile) := false; 6 | while 7 | begin 8 | readcard(s); 9 | ~xcpnoted(endfile) 10 | end 11 | do 12 | write("""", s, """"); 13 | 14 | write("(eof)") 15 | end. 16 | ----stdin 17 | one 18 | two 19 | three 20 | four 21 | five 22 | ----stdout 23 | "one " 24 | "two " 25 | "three" 26 | "four " 27 | "five " 28 | (eof) 29 | ----end -------------------------------------------------------------------------------- /Tests/standard-readcard-exception-null.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(5) s; 3 | endfile := null; 4 | for i := 1 until 10 do 5 | begin 6 | readcard(s); 7 | write("""", s, """") 8 | end 9 | end. 10 | ----stdin 11 | one 12 | two 13 | three 14 | four 15 | five 16 | ----stdout 17 | "one " 18 | "two " 19 | "three" 20 | "four " 21 | "five " 22 | " " 23 | " " 24 | " " 25 | " " 26 | " " 27 | ----end -------------------------------------------------------------------------------- /Tests/standard-readcard-exception.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(5) s; 3 | xcplimit(endfile) := 3; 4 | xcpmark(endfile) := false; 5 | xcpmsg(endfile) := "Expected more lines on the input."; 6 | for i := 1 until 10 do 7 | begin 8 | readcard(s); 9 | write("""", s, """") 10 | end; 11 | write("You shouldn't see this.") 12 | end. 13 | ----stdin 14 | one 15 | two 16 | three 17 | four 18 | five 19 | ----stdout 20 | "one " 21 | "two " 22 | "three" 23 | "four " 24 | "five " 25 | " " 26 | " " 27 | " " 28 | ----stderr 29 | Tests/standard-readcard-exception.alw:8:10: Expected more lines on the input. 30 | ----exitcode 31 | 1 32 | ----end -------------------------------------------------------------------------------- /Tests/standard-readcard.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(80) card; 3 | for i := 1 until 9 do 4 | begin 5 | readcard(card); 6 | write(i_w := 2, i, card); 7 | end 8 | end. 9 | ----stdin 10 | 1 2 3 4 5 6 7 8 11 | ....|....|....|....|....|....|....|....|....|....|....|....|....|....|....|....| 12 | 13 | The hardware representation is case-insensitive. Algol comments are allowed 14 | anywhere white space is allowed. Comments begin with the keyword 15 | "comment" and end after the next semicolon. The optional identifier at 16 | the end of a block is a comment. UTF-8 symbols may be used in comments 17 | and as alternatives to the standard ASCII/EDCBIC operators. 18 | ***************************************************************************************** 19 | ----stdout 20 | 1 1 2 3 4 5 6 7 8 21 | 2 ....|....|....|....|....|....|....|....|....|....|....|....|....|....|....|....| 22 | 3 23 | 4 The hardware representation is case-insensitive. Algol comments are allowed 24 | 5 anywhere white space is allowed. Comments begin with the keyword 25 | 6 "comment" and end after the next semicolon. The optional identifier at 26 | 7 the end of a block is a comment. UTF-8 symbols may be used in comments 27 | 8 and as alternatives to the standard ASCII/EDCBIC operators. 28 | 9 ******************************************************************************** 29 | ----end 30 | -------------------------------------------------------------------------------- /Tests/standard-transfer-base.alw: -------------------------------------------------------------------------------- 1 | begin 2 | real r; 3 | 4 | procedure w (real value x); 5 | begin 6 | write( base10(x), " ", longbase10(x)); 7 | end; 8 | 9 | w(0); 10 | w(1); 11 | w(10); 12 | w(16); 13 | w(32); 14 | w(-91'101); 15 | w(91'-101); 16 | write(" "); 17 | 18 | r := 1.23456789012345; 19 | for i := 0 until 10 do 20 | begin 21 | w(r * 10**i); 22 | w(r * 10**-i); 23 | w(-r * 10**i); 24 | w(-r * 10**-i) 25 | end 26 | end. 27 | ----stdout 28 | +00+0000000 +00+000000000000000 29 | +00+1000000 +00+100000000000000 30 | +01+1000000 +01+100000000000000 31 | +01+1600000 +01+160000000000000 32 | +01+3200000 +01+320000000000000 33 | +102-9100000 +102-910000000000000 34 | -100+9100000 -100+910000000000000 35 | 36 | +00+1234568 +00+123456789012345 37 | +00+1234568 +00+123456789012345 38 | +00-1234568 +00-123456789012345 39 | +00-1234568 +00-123456789012345 40 | +01+1234568 +01+123456789012345 41 | -01+1234568 -01+123456789012345 42 | +01-1234568 +01-123456789012345 43 | -01-1234568 -01-123456789012345 44 | +02+1234568 +02+123456789012345 45 | -02+1234568 -02+123456789012345 46 | +02-1234568 +02-123456789012345 47 | -02-1234568 -02-123456789012345 48 | +03+1234568 +03+123456789012345 49 | -03+1234568 -03+123456789012345 50 | +03-1234568 +03-123456789012345 51 | -03-1234568 -03-123456789012345 52 | +04+1234568 +04+123456789012345 53 | -04+1234568 -04+123456789012345 54 | +04-1234568 +04-123456789012345 55 | -04-1234568 -04-123456789012345 56 | +05+1234568 +05+123456789012345 57 | -05+1234568 -05+123456789012345 58 | +05-1234568 +05-123456789012345 59 | -05-1234568 -05-123456789012345 60 | +06+1234568 +06+123456789012345 61 | -06+1234568 -06+123456789012345 62 | +06-1234568 +06-123456789012345 63 | -06-1234568 -06-123456789012345 64 | +07+1234568 +07+123456789012345 65 | -07+1234568 -07+123456789012345 66 | +07-1234568 +07-123456789012345 67 | -07-1234568 -07-123456789012345 68 | +08+1234568 +08+123456789012345 69 | -08+1234568 -08+123456789012345 70 | +08-1234568 +08-123456789012345 71 | -08-1234568 -08-123456789012345 72 | +09+1234568 +09+123456789012345 73 | -09+1234568 -09+123456789012345 74 | +09-1234568 +09-123456789012345 75 | -09-1234568 -09-123456789012345 76 | +10+1234568 +10+123456789012345 77 | -10+1234568 -10+123456789012345 78 | +10-1234568 +10-123456789012345 79 | -10-1234568 -10-123456789012345 80 | ----end. 81 | -------------------------------------------------------------------------------- /Tests/standard-transfer-roundtoreal.alw: -------------------------------------------------------------------------------- 1 | begin 2 | real array x (1::5); 3 | x(1) := -0.05459357; 4 | x(2) := 0.11644; 5 | x(3) := -0.01825297; 6 | x(4) := 0.5555555555555; 7 | x(5) := 0.3333333333333; 8 | for i := 1 until 5 do 9 | writeon(roundtoreal(x(i))); 10 | iocontrol(2); 11 | write("roundtoreal(0.5555555555555) ", roundtoreal(0.5555555555555)); 12 | write("roundtoreal(0.3333333333333) ", roundtoreal(0.3333333333333)); 13 | end. 14 | ----stdout 15 | -0.05459357 0.11644 -0.01825297 0.5555556 0.3333333 16 | roundtoreal(0.5555555555555) 0.5555556 17 | roundtoreal(0.3333333333333) 0.3333333 18 | ----end 19 | -------------------------------------------------------------------------------- /Tests/standard-transfer.alw: -------------------------------------------------------------------------------- 1 | begin 2 | assert truncate(+2.3) = +2; 3 | assert truncate(+2.5) = +2; 4 | assert truncate(+2.7) = +2; 5 | assert truncate(-2.3) = -2; 6 | assert truncate(-2.5) = -2; 7 | assert truncate(-2.7) = -2; 8 | 9 | assert entier(+2.3) = +2; 10 | assert entier(+2.5) = +2; 11 | assert entier(+2.7) = +2; 12 | assert entier(-2.3) = -3; 13 | assert entier(-2.5) = -3; 14 | assert entier(-2.7) = -3; 15 | 16 | assert round(+2.3) = +2; 17 | assert round(+2.5) = +3; 18 | assert round(+2.7) = +3; 19 | assert round(-2.3) = -2; 20 | assert round(-2.5) = -3; 21 | assert round(-2.7) = -3; 22 | 23 | assert odd(3); 24 | assert ~odd(2); 25 | assert odd(1); 26 | assert ~odd(0); 27 | assert odd(-1); 28 | 29 | assert number(#0) = 0; 30 | assert number(#1) = 1; 31 | assert number(#7FFFFFFF) = 2147483647; 32 | assert number(#7FFFFFFF) = maxinteger; 33 | assert number(#FFFFFFFF) = -1; 34 | 35 | assert bitstring(0) = #0; 36 | assert bitstring(1) = #1; 37 | assert bitstring(-1) = #FFFFFFFF; 38 | assert bitstring(2147483647) = #7FFFFFFF; 39 | assert bitstring(maxinteger) = #7FFFFFFF; 40 | 41 | assert decode(" ") = 64; COMMENT these are EBCDIC codes; 42 | assert decode("""") = 127; 43 | assert decode("~") = 161; 44 | assert code(64) = " "; 45 | assert code(127) = """"; 46 | assert code(161) = "~"; 47 | 48 | assert intbase10(0) = " +0000000000"; 49 | assert intbase10(1) = " +0000000001"; 50 | assert intbase10(-1) = " -0000000001"; 51 | assert intbase10(2147483647) = " +2147483647"; 52 | assert intbase10(-2147483647) = " -2147483647"; 53 | 54 | comment C itself doesn't like to see -2147483648; 55 | 56 | assert intbase16(0) = " 00000000"; 57 | assert intbase16(1) = " 00000001"; 58 | assert intbase16(-1) = " FFFFFFFF"; 59 | assert intbase16(2147483647) = " 7FFFFFFF"; 60 | assert intbase16(-2147483647) = " 80000001"; 61 | end. -------------------------------------------------------------------------------- /Tests/standard-write-eject-last-page.alw: -------------------------------------------------------------------------------- 1 | begin 2 | iocontrol(10014); % 14 character lines % 3 | iocontrol(20005); % 5 line pages % 4 | iocontrol(40005); % pretty_page_breaks % 5 | iocontrol(40011); % eject last page % 6 | for i := 1 until 6 do 7 | write(i) 8 | end. 9 | ----stdout 10 | 1 11 | 2 12 | 3 13 | 4 14 | 5 15 | ~~~~~~~~~~~~~~ 16 | 6 17 | 18 | 19 | 20 | 21 | ~~~~~~~~~~~~~~ 22 | ----end 23 | -------------------------------------------------------------------------------- /Tests/standard-write-example.alw: -------------------------------------------------------------------------------- 1 | begin 2 | procedure SCALED (integer value N); 3 | begin R_FORMAT := "S"; R_W := N+7 4 | end; 5 | procedure ALIGNED (integer value N,D); 6 | begin R_FORMAT := "A"; R_W := N+D+1; R_D := D 7 | end; 8 | procedure FREE_POINT (integer value N); 9 | begin R_FORMAT := "F"; R_W := N+7 10 | end; 11 | procedure NEW_LINE; IOCONTROL(2); 12 | 13 | FREE_POINT(5); I_W := 2; S_W := 1; 14 | 15 | for I := -1, 0, 32 do 16 | begin WRITE(S_W := 0, I, ":", NEW_LINE, I/3); 17 | WRITEON("I ", ALIGNED(3,2), I/3, "*", SCALED(12), I/3, "*") 18 | end 19 | end. 20 | ----stdout 21 | -1: 22 | -0.33333I -0.33 * -3.33333333333'-01 * 23 | 0: 24 | 0I 0.00 * 0 * 25 | 32: 26 | 10.667I 10.67 * 1.06666666667'+01 * 27 | ----end 28 | -------------------------------------------------------------------------------- /Tests/standard-write-i_w.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write(i_w := 0, 1); 3 | write(i_w := 1, 2); 4 | write(i_w := 2, 3); 5 | write(i_w := 3, 4); 6 | write(5); 7 | i_w := 3; 8 | write(6); 9 | i_w := 1; 10 | write(7, 8, 9); 11 | s_w := 0; 12 | i_w := 3; 13 | write(10, 11, 12); 14 | write(i_w := -5, 13, 14, 15); comment C allows this, maybe Algol W shouldn't; 15 | write(16, 17, 18); 16 | writeon(19); 17 | end. 18 | ----stdout 19 | 1 20 | 2 21 | 3 22 | 4 23 | 5 24 | 6 25 | 7 8 9 26 | 10 11 12 27 | 13 14 15 28 | 16 17 18 19 29 | ----end -------------------------------------------------------------------------------- /Tests/standard-write-line-wrap.alw: -------------------------------------------------------------------------------- 1 | comment this tests the lower extreme of line/page breaking; 2 | begin 3 | iocontrol(5); comment Hard page breaks are not on by default (Awe behaviour); 4 | iocontrol(40005); comment Pretty page breaks = on; 5 | 6 | s_w := 0; comment Write one digit at a time; 7 | i_w := 1; 8 | 9 | iocontrol(10001); comment Page width = 1; 10 | iocontrol(20001); comment Page height = 1; 11 | 12 | for i := 1 until 4 do 13 | writeon(i); 14 | 15 | iocontrol(2); comment Line break; 16 | 17 | iocontrol(10002); 18 | iocontrol(20002); 19 | 20 | for i := 1 until 8 do 21 | writeon(i); 22 | 23 | iocontrol(2); 24 | iocontrol(20003); 25 | writeon("ab"); 26 | writeon("cd"); 27 | end. 28 | ----stdout 29 | 1 30 | ~ 31 | 2 32 | ~ 33 | 3 34 | ~ 35 | 4 36 | ~ 37 | 12 38 | 34 39 | ~~ 40 | 56 41 | 78 42 | ~~ 43 | ab 44 | cd 45 | ----end 46 | -------------------------------------------------------------------------------- /Tests/standard-write-page-breaks-off.alw: -------------------------------------------------------------------------------- 1 | begin 2 | iocontrol(4); 3 | for i := 1 until 61 do 4 | write(i) 5 | end. 6 | ----stdout 7 | 1 8 | 2 9 | 3 10 | 4 11 | 5 12 | 6 13 | 7 14 | 8 15 | 9 16 | 10 17 | 11 18 | 12 19 | 13 20 | 14 21 | 15 22 | 16 23 | 17 24 | 18 25 | 19 26 | 20 27 | 21 28 | 22 29 | 23 30 | 24 31 | 25 32 | 26 33 | 27 34 | 28 35 | 29 36 | 30 37 | 31 38 | 32 39 | 33 40 | 34 41 | 35 42 | 36 43 | 37 44 | 38 45 | 39 46 | 40 47 | 41 48 | 42 49 | 43 50 | 44 51 | 45 52 | 46 53 | 47 54 | 48 55 | 49 56 | 50 57 | 51 58 | 52 59 | 53 60 | 54 61 | 55 62 | 56 63 | 57 64 | 58 65 | 59 66 | 60 67 | 61 68 | ----end -------------------------------------------------------------------------------- /Tests/standard-write-page-breaks.alw: -------------------------------------------------------------------------------- 1 | begin 2 | iocontrol(5); 3 | for i := 1 until 61 do 4 | write(i) 5 | end. 6 | ----stdout 7 | 1 8 | 2 9 | 3 10 | 4 11 | 5 12 | 6 13 | 7 14 | 8 15 | 9 16 | 10 17 | 11 18 | 12 19 | 13 20 | 14 21 | 15 22 | 16 23 | 17 24 | 18 25 | 19 26 | 20 27 | 21 28 | 22 29 | 23 30 | 24 31 | 25 32 | 26 33 | 27 34 | 28 35 | 29 36 | 30 37 | 31 38 | 32 39 | 33 40 | 34 41 | 35 42 | 36 43 | 37 44 | 38 45 | 39 46 | 40 47 | 41 48 | 42 49 | 43 50 | 44 51 | 45 52 | 46 53 | 47 54 | 48 55 | 49 56 | 50 57 | 51 58 | 52 59 | 53 60 | 54 61 | 55 62 | 56 63 | 57 64 | 58 65 | 59 66 | 60 61 67 | ----end -------------------------------------------------------------------------------- /Tests/standard-write-reference.alw: -------------------------------------------------------------------------------- 1 | comment Writing references; 2 | begin 3 | record x (integer i); 4 | record y (integer j); 5 | reference(x) a; 6 | reference(y) b; 7 | reference(x,y) c; 8 | reference(x,y) d, e; 9 | reference(x,y) f; 10 | a := x; 11 | b := y; 12 | c := y; 13 | d := c; 14 | e := null; 15 | write("These should be different: ", a, b); 16 | write("These should be the same: ", c, d); 17 | write("This should be ""null"": ", e); 18 | write("This should be ""UNINITIALIZED"":", f); 19 | end. 20 | ----stdout 21 | These should be different: x.1 y.2 22 | These should be the same: y.3 y.3 23 | This should be "null": null 24 | This should be "UNINITIALIZED": UNINITIALIZED 25 | ----end 26 | -------------------------------------------------------------------------------- /Tests/standard-writecard-error.alw: -------------------------------------------------------------------------------- 1 | begin 2 | writecard(1) 3 | end. 4 | ----compiler 5 | Tests/standard-writecard-error.alw:2:13: Expected a statement or string expression, this is an INTEGER expression 6 | ----end -------------------------------------------------------------------------------- /Tests/standard-writecard.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | string(8) four; 4 | four := "44444444"; 5 | write("*"); 6 | writecard("1", "2", i := 1, "33333", four); 7 | write("*"); 8 | 9 | comment "*" Should not be on the same line as "5", writecard writes entire lines; 10 | writecard("5"); 11 | writeon("*"); 12 | 13 | assert i = 1 14 | end. 15 | ----stdout 16 | * 17 | 1 18 | 2 19 | 33333 20 | 44444444 21 | * 22 | 5 23 | * 24 | ----end -------------------------------------------------------------------------------- /Tests/statements-assignment.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i, j; 3 | real r; 4 | 5 | i := j := 42; 6 | assert i = 42 and j = 42; 7 | 8 | r := j := 42; 9 | assert r = 42.0 and j = 42 10 | end. -------------------------------------------------------------------------------- /Tests/statements-block-empty.alw: -------------------------------------------------------------------------------- 1 | begin 2 | end. -------------------------------------------------------------------------------- /Tests/statements-block-out-of-scope.alw: -------------------------------------------------------------------------------- 1 | begin 2 | begin 3 | integer i; 4 | i := 1; 5 | end; 6 | assert i = 1; 7 | end. 8 | ----compile 9 | Tests/statements-block-out-of-scope.alw:6:12: 'i' is undefined here 10 | ----end -------------------------------------------------------------------------------- /Tests/statements-block-overshadowed-2.alw: -------------------------------------------------------------------------------- 1 | begin 2 | logical x; 3 | begin 4 | integer x; 5 | write(x and true); 6 | end; 7 | end. 8 | ----compile 9 | Tests/statements-block-overshadowed-2.alw:5:16: Incorrect operand types: INTEGER AND LOGICAL 10 | ----end -------------------------------------------------------------------------------- /Tests/statements-block-overshadowed-3.alw: -------------------------------------------------------------------------------- 1 | comment Labels and declarations share scope, 2 | declarations are added to the scope first 3 | to make the error messages more sensible; 4 | begin 5 | integer x; 6 | x: ; 7 | end. 8 | ----compile 9 | Tests/statements-block-overshadowed-3.alw:6:4: 'x' is already defined here, as an INTEGER variable 10 | ----end -------------------------------------------------------------------------------- /Tests/statements-block-overshadowed.alw: -------------------------------------------------------------------------------- 1 | begin 2 | x: begin 3 | integer x; 4 | goto x; 5 | end; 6 | end. 7 | ----compile 8 | Tests/statements-block-overshadowed.alw:4:8: 'x' should be a label here, it is an INTEGER variable 9 | ----end -------------------------------------------------------------------------------- /Tests/statements-block.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i, j; 3 | i := 1; 4 | j := 1; 5 | begin 6 | integer i; 7 | assert j = 1; 8 | i := 2; 9 | j := 2; 10 | assert i = 2; 11 | assert j = 2; 12 | end; 13 | assert i = 1; 14 | assert j = 2; 15 | end. -------------------------------------------------------------------------------- /Tests/statements-case-too-high.alw: -------------------------------------------------------------------------------- 1 | begin 2 | for i := 1, 6, 7 do 3 | case i of 4 | begin 5 | write(1); 6 | write(2); 7 | write(3); 8 | write(4); 9 | write(5); 10 | write(6) 11 | end 12 | end. 13 | ----stdout 14 | 1 15 | 6 16 | ----stderr 17 | Tests/statements-case-too-high.alw:3:7: CASE range error: selector is 7 18 | ----exitcode 19 | 1 20 | ----end 21 | -------------------------------------------------------------------------------- /Tests/statements-case-too-low.alw: -------------------------------------------------------------------------------- 1 | begin 2 | for i := 1, 6, 0 do 3 | case i of 4 | begin 5 | write(1); 6 | write(2); 7 | write(3); 8 | write(4); 9 | write(5); 10 | write(6); 11 | end 12 | end. 13 | ----stdout 14 | 1 15 | 6 16 | ----stderr 17 | Tests/statements-case-too-low.alw:3:7: CASE range error: selector is 0 18 | ----exitcode 19 | 1 20 | ----end 21 | -------------------------------------------------------------------------------- /Tests/statements-case.alw: -------------------------------------------------------------------------------- 1 | begin 2 | for i := 1, 6, 5, 4 do 3 | case i of 4 | begin 5 | write(1); 6 | write(2); 7 | write(3); 8 | write(4); 9 | write(5); 10 | write(6); 11 | end 12 | end. 13 | ----stdout 14 | 1 15 | 6 16 | 5 17 | 4 18 | ----end 19 | -------------------------------------------------------------------------------- /Tests/statements-for-control-variable-scope.alw: -------------------------------------------------------------------------------- 1 | % The control variable should not clash with variables % 2 | % outside the FOR loop's scope, so it should be declared last. % 3 | % (Examine Awe C output to be sure that this is really happening.) % 4 | begin 5 | integer i; 6 | integer kk; 7 | i := 10; 8 | kk := 1; 9 | for i := i step 2 until 20 do 10 | write(i); 11 | assert i = 10; 12 | for i := i until 12 do 13 | write(i); 14 | i := 2; 15 | for i := 1 step i until i * 4 do 16 | write(i); 17 | end. 18 | ----stdout 19 | 10 20 | 12 21 | 14 22 | 16 23 | 18 24 | 20 25 | 10 26 | 11 27 | 12 28 | 1 29 | 3 30 | 5 31 | 7 32 | ----end 33 | -------------------------------------------------------------------------------- /Tests/statements-for-list.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | i := 42; 4 | for i := 5 do 5 | write(i); 6 | for i := 1, 2, 4, 8 do 7 | write(i); 8 | assert(i = 42) 9 | end. 10 | ----stdout 11 | 5 12 | 1 13 | 2 14 | 4 15 | 8 16 | ----end -------------------------------------------------------------------------------- /Tests/statements-for-step-0.alw: -------------------------------------------------------------------------------- 1 | begin 2 | for i := 1 step 0 until 8 do 3 | write(i); 4 | end. 5 | ----stderr 6 | Tests/statements-for-step-0.alw:2:5: FOR step of 0 7 | ----exitcode 8 | 1 9 | ----end -------------------------------------------------------------------------------- /Tests/statements-for-step.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | i := 42; 4 | for i := 1 step 2 until 8 do 5 | write(i); 6 | for i := 8 step -2 until 1 do 7 | write(i); 8 | for i := 1 step -2 until 8 do comment shouldn't do anything; 9 | write(i); 10 | assert(i = 42) 11 | end. 12 | ----stdout 13 | 1 14 | 3 15 | 5 16 | 7 17 | 8 18 | 6 19 | 4 20 | 2 21 | ----end -------------------------------------------------------------------------------- /Tests/statements-for.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | i := 42; 4 | for i := 1 until 4 do 5 | write(i); 6 | for i := 4 until 1 do 7 | write(i); 8 | assert(i = 42) 9 | end. 10 | ----stdout 11 | 1 12 | 2 13 | 3 14 | 4 15 | ----end -------------------------------------------------------------------------------- /Tests/statements-goto-scope.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | i := 1; 4 | top: 5 | 6 | begin 7 | integer j, k; 8 | j := 1; 9 | top: 10 | k := 10 * i + j; 11 | write(k); 12 | j := j + 1; 13 | if j = 4 then goto bottom; 14 | if k = 32 then goto exit; 15 | go to top; 16 | bottom: 17 | end; 18 | 19 | i := i + 1; 20 | if i = 4 then goto bottom; 21 | go to top; 22 | bottom: 23 | exit: 24 | end. 25 | ----stdout 26 | 11 27 | 12 28 | 13 29 | 21 30 | 22 31 | 23 32 | 31 33 | 32 34 | ----end 35 | -------------------------------------------------------------------------------- /Tests/statements-goto-wrong-direction.alw: -------------------------------------------------------------------------------- 1 | begin 2 | for i := 1 until 4 do 3 | begin 4 | uh_oh: write(i); 5 | end; 6 | goto uh_oh 7 | end. 8 | ----compile 9 | Tests/statements-goto-wrong-direction.alw:6:5: 'uh_oh' is undefined here 10 | ----end -------------------------------------------------------------------------------- /Tests/statements-goto.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | i := 8; 4 | top: 5 | write(i); 6 | i := i + 1; 7 | if i = 12 then goto bottom; 8 | go to top; 9 | bottom: 10 | end. 11 | ----stdout 12 | 8 13 | 9 14 | 10 15 | 11 16 | ----end 17 | -------------------------------------------------------------------------------- /Tests/statements-if.alw: -------------------------------------------------------------------------------- 1 | begin 2 | % this is okay % 3 | if true then 4 | if true then 5 | assert true; 6 | 7 | % this is okay % 8 | if true then 9 | if true then 10 | assert true 11 | else 12 | assert true; 13 | 14 | % this SHOULD not be okay (THEN followed by non , c.f. 7.5.1) % 15 | % but we are allowing it % 16 | if true then 17 | if true then 18 | assert true 19 | else 20 | assert true 21 | else 22 | assert true; 23 | end. 24 | -------------------------------------------------------------------------------- /Tests/statements-while-body-is-statement.alw: -------------------------------------------------------------------------------- 1 | begin 2 | while true do 3 | 1 4 | end. 5 | ----compile 6 | Tests/statements-while-body-is-statement.alw:3:9: expected a statement here, got an INTEGER 7 | ----end 8 | -------------------------------------------------------------------------------- /Tests/statements-while-is-statement.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | i := while true do 1 4 | end. 5 | ----compile 6 | Tests/statements-while-is-statement.alw:3:24: expected a statement here, got an INTEGER 7 | ----end 8 | -------------------------------------------------------------------------------- /Tests/statements-while.alw: -------------------------------------------------------------------------------- 1 | begin 2 | integer i; 3 | i := 1; 4 | while i <= 5 do 5 | begin 6 | write(i); 7 | i := i + 1 8 | end 9 | end. 10 | ----stdout 11 | 1 12 | 2 13 | 3 14 | 4 15 | 5 16 | ----end 17 | -------------------------------------------------------------------------------- /Tests/string-case.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(6) a1, a2, a3, s; 3 | 4 | procedure p (string(6) value x); 5 | begin 6 | x(0|1) := code(decode(x(0|1)) + 64); 7 | write(x); 8 | end; 9 | 10 | a1 := "a"; 11 | a2 := "b123"; 12 | a3 := "c12345"; 13 | for i := 1 until 3 do p(case i of (a1, a2, a3)); 14 | 15 | assert a1 = "a"; 16 | assert a2 = "b123"; 17 | assert a3 = "c12345"; 18 | 19 | for i := 1 until 3 do p(case i of ("a", "b123", "c12345")); 20 | end. 21 | ----stdout 22 | A 23 | B123 24 | C12345 25 | A 26 | B123 27 | C12345 28 | ----end 29 | -------------------------------------------------------------------------------- /Tests/string-character-order.alw: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/glynawe/awe/659346c6042ae10e5b544cd907ca9c7dcc38eec4/Tests/string-character-order.alw -------------------------------------------------------------------------------- /Tests/string-comparisions.alw: -------------------------------------------------------------------------------- 1 | begin 2 | assert("abc" = "abc"); 3 | assert("bce" > "abc"); 4 | assert("abc" < "bce"); 5 | 6 | assert("abc" ~= "abcd"); 7 | assert("abcd" > "abc"); 8 | assert("abc" < "abcd"); 9 | 10 | 11 | comment Spaces at the ends of strings do not count in comparisions; 12 | 13 | assert("abc" = "abc "); 14 | assert("bce " > "abc"); 15 | assert("abc " < "bce"); 16 | assert("bce" > "abc "); 17 | assert("abc" < "bce "); 18 | 19 | assert("abc " = "abc "); 20 | assert("bce " > "abc "); 21 | assert("abc " < "bce "); 22 | assert("bce " > "abc "); 23 | assert("abc " < "bce "); 24 | end. -------------------------------------------------------------------------------- /Tests/string-constants-non-printing.alw: -------------------------------------------------------------------------------- 1 | begin 2 | write("This non-printing character should not be accepted: "); 3 | end. 4 | ----compiler 5 | Tests/string-constants-non-printing.alw:2:10: This string contains a non-printing or non ISO 8859-1 character code 6 | ----end 7 | 8 | -------------------------------------------------------------------------------- /Tests/string-constants.alw: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/glynawe/awe/659346c6042ae10e5b544cd907ca9c7dcc38eec4/Tests/string-constants.alw -------------------------------------------------------------------------------- /Tests/string-result-parameters.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(4) procedure p ( string(4) value v; 3 | string(4) result r; 4 | string(4) value result vr; 5 | string(4) n ); 6 | begin 7 | r(0|2) := v(0|2); 8 | r(2|2) := vr(0|2); 9 | n(0|2) := v(0|2); 10 | vr := n; 11 | vr 12 | end; 13 | 14 | string(4) s, r0, vr0, n0; 15 | vr0 := "VVVV"; 16 | n0 := "nnnn"; 17 | s := p("vvvv", r0, vr0, n0); 18 | write(s, r0, vr0, n0) 19 | end. 20 | ----compile 21 | Tests/string-result-parameters.alw:5:28: Note, this is a call-by-name formal parameter. 22 | ----stdout 23 | vvnnvvVVvvnnvvnn 24 | ----end 25 | -------------------------------------------------------------------------------- /Tests/string-substring-1.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(5) s; 3 | string(1) c; 4 | procedure p(string(3) value x); 5 | x := "xxx"; 6 | 7 | string(5) procedure z; 8 | " "; 9 | 10 | string(1) procedure q(string(5) value x); 11 | begin x := "x"; x(0|1) end; 12 | 13 | string(1) procedure r(string(1) value x); 14 | begin x := "x"; x(0|1) end; 15 | 16 | 17 | s := "01234"; 18 | p(s(0|3)); 19 | assert(s = "01234"); 20 | 21 | c := "a"; 22 | s := c; 23 | s := q(c); 24 | s := q(s); 25 | s := q(s(0|1)); 26 | s := q(c(0|1)); 27 | s := q(" "); 28 | s := q(" "); 29 | 30 | c := r(c(0|1)); 31 | c := r(c); 32 | c := r(" "); 33 | s := r(c(0|1)); 34 | s := r(c); 35 | s := r(" "); 36 | 37 | c := " "; 38 | s := " "; 39 | s := c; 40 | s := z; 41 | s := begin s := z; " " end 42 | end. -------------------------------------------------------------------------------- /Tests/string-substring-all-of-length-1.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(10) s; 3 | s := "0123456789"; 4 | for i := 0 until 9 do 5 | write(s(i|1)) 6 | end. 7 | ----stdout 8 | 0 9 | 1 10 | 2 11 | 3 12 | 4 13 | 5 14 | 6 15 | 7 16 | 8 17 | 9 18 | ----end 19 | -------------------------------------------------------------------------------- /Tests/string-substring-assignment-off-end.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(10) s; 3 | s := "0123456789"; 4 | s(8|3) := "abc"; 5 | end. 6 | ----stderr 7 | Tests/string-substring-assignment-off-end.alw:4:4: Substring (8|3) of a string of length 10. 8 | ----exitcode 9 | 1 10 | ----end 11 | -------------------------------------------------------------------------------- /Tests/string-substring-assignment-too-long.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(10) s; 3 | s := "0123456789"; 4 | s(4|3) := "abcd"; 5 | write(s); 6 | end. 7 | ----compile 8 | Tests/string-substring-assignment-too-long.alw:4:4: a STRING(4) cannot be assigned to a STRING(3) variable 9 | ----end 10 | -------------------------------------------------------------------------------- /Tests/string-substring-assignment.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(10) s; 3 | 4 | s := "0123456789"; 5 | s(4|3) := "abc"; 6 | assert s = "0123abc789"; 7 | s(0|3) := "___"; 8 | assert s = "___3abc789"; 9 | s(6|4) := "????"; 10 | assert s = "___3ab????"; 11 | 12 | s := "0123456789"; 13 | s(3|5) := "ab"; 14 | assert s = "012ab 89"; 15 | end. -------------------------------------------------------------------------------- /Tests/string-substring-io.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(8) s; 3 | s := "01234567"; 4 | readcard(s(2|4)); 5 | assert(s = "01abcd67"); 6 | write(s(1|6)); 7 | end. 8 | ----stdin 9 | abcd 10 | ----stdout 11 | 1abcd6 12 | ----end 13 | -------------------------------------------------------------------------------- /Tests/string-substring-multiple-assignment.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(2) a, b; 3 | string(1) c; 4 | 5 | a := b := "ab"; 6 | assert(a = "ab"); 7 | assert(b = "ab"); 8 | 9 | c := b(1|1) := "2"; 10 | assert(c = "2"); 11 | assert(b = "a2"); 12 | 13 | a(1|1) := c := "3"; 14 | assert(c = "3"); 15 | assert(a = "a3"); 16 | 17 | a(1|1) := b(1|1) := "4"; 18 | assert(a = "a4"); 19 | assert(b = "a4"); 20 | end. 21 | -------------------------------------------------------------------------------- /Tests/string-substring-name-parameter.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(8) s; 3 | integer i; 4 | 5 | procedure p (string(4) x); 6 | begin 7 | assert(x = "0123"); 8 | i := 1; 9 | assert(x = "1234"); 10 | i := 2; 11 | x := "abcd"; 12 | assert(x = "abcd"); 13 | assert(s = "01abcd67") comment Eerie isn't it; 14 | end; 15 | 16 | s := "01234567"; 17 | i := 0; 18 | p(s(i|4)) 19 | end. 20 | ----compiler 21 | Tests/string-substring-name-parameter.alw:5:17: Note, this is a call-by-name formal parameter. 22 | ----end 23 | -------------------------------------------------------------------------------- /Tests/string-substring-of-short-string.alw: -------------------------------------------------------------------------------- 1 | comment In A2WC generated code Algol strings can be represented by C 2 | strings shorter than the string length. This happens when 3 | string variables are assigned constants. Let's see if the 4 | substring operators can handle that; 5 | begin 6 | string(6) a; 7 | string(6) b; 8 | 9 | a := "01"; 10 | assert(a(2|2) = " "); 11 | 12 | b := "01"; 13 | b(3|2) := "xx"; 14 | assert(b = "01 xx ") 15 | end. -------------------------------------------------------------------------------- /Tests/string-too-long.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(3) s; 3 | s := " "; 4 | s := "1"; 5 | s := "12"; 6 | s := "123"; 7 | s := "1234" 8 | end. 9 | ----compiler 10 | Tests/string-too-long.alw:7:4: a STRING(4) cannot be assigned to a STRING(3) variable 11 | ----end 12 | -------------------------------------------------------------------------------- /Tests/string-value-parameters.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(12) s; 3 | string(40) d; 4 | 5 | procedure p(string(40) value u); 6 | write("""", u, """"); 7 | 8 | procedure q(string(20) value v); 9 | write("""", v, """"); 10 | 11 | s := "Hello world!"; 12 | write(s); 13 | 14 | d := s; 15 | write(d); 16 | p(s); 17 | p(d); 18 | q(s); 19 | end. 20 | ----stdout 21 | Hello world! 22 | Hello world! 23 | "Hello world! " 24 | "Hello world! " 25 | "Hello world! " 26 | ----end 27 | -------------------------------------------------------------------------------- /Tests/string.alw: -------------------------------------------------------------------------------- 1 | begin 2 | string(12) s; 3 | s := "Hello world!"; 4 | write(s) 5 | end. 6 | ----stdout 7 | Hello world! 8 | ----end 9 | -------------------------------------------------------------------------------- /Tools/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile -- build, test and install Awe tools 2 | 3 | # This file is part of Awe. Copyright 2012 Glyn Webster. 4 | # 5 | # Awe is free software: you can redistribute it and/or modify it 6 | # under the terms of the GNU General Public License as published 7 | # by the Free Software Foundation, either version 3 of the License, or 8 | # (at your option) any later version. 9 | # 10 | # Awe is distributed in the hope that it will be useful, 11 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | # GNU General Public License for more details. 14 | # 15 | # You should have received a copy of the GNU General Public 16 | # License along with Awe. If not, see . 17 | 18 | 19 | # Where the file will be installed. Edit these to suit your system: 20 | 21 | PREFIX = $(DESTDIR)/usr/local 22 | BINDIR = $(PREFIX)/bin 23 | TOOLDIR = $(PREFIX)/share/awe 24 | MANDIR = $(PREFIX)/share/man/man1 25 | 26 | .phony:: build test install clean 27 | 28 | default: test 29 | 30 | install: build 31 | install -m 755 -d $(BINDIR) $(TOOLDIR) $(MANDIR) 32 | install -m 755 -t $(BINDIR) awnest 33 | install -m 644 -t $(MANDIR) awnest.1 34 | install -m 644 -t $(TOOLDIR) algolw.ssh 35 | 36 | build: 37 | ocamllex awnest.mll && ocamlc awnest.ml -o awnest 38 | 39 | test : clean build 40 | ./awnest < awnest-test-file.alw > actual.output 41 | diff --strip-trailing-cr expected.output actual.output 42 | rm actual.output 43 | echo "Success!" 44 | 45 | clean: 46 | rm -f awnest awnest.cmi awnest.cmo awnest.ml actual.output 47 | -------------------------------------------------------------------------------- /Tools/algolw.ssh: -------------------------------------------------------------------------------- 1 | # algolw.ssh -- `a2ps' style sheet for Algol W 2 | 3 | # a2ps --line-numbers=1 --pretty-print=./algolw.ssh -o 4 | # a2ps --line-numbers=1 --highlight-level=heavy --pretty-print=./algolw.ssh -o 5 | 6 | style AlgolW is 7 | requires a2ps 4.13 8 | written by "Glyn Webster" 9 | version is 1.0 10 | documentation is 11 | "This style highlights Algol W. Keywords are always printed in" 12 | "lowercase. Heavy pretty-printing gives you the mathematical symbols" 13 | "used in 'A Contribution to the Development of Algol' (except for the" 14 | "subscript 10 symbol)." 15 | end documentation 16 | 17 | first alphabet is "abcdefghijklmnopqrstuvwxyz" 18 | second alphabet is "abcdefghijklmnopqrstuvwxyz0123456789_" 19 | case insensitive 20 | 21 | keywords in Keyword_strong are 22 | "algol" "algol", 23 | "and" "and", 24 | "array" "array", 25 | "assert" "assert", 26 | "begin" "begin", 27 | "bits" "bits", 28 | "case" "case", 29 | "complex" "complex", 30 | "div" "div", 31 | "do" "do", 32 | "else" "else", 33 | "end" "end", 34 | "false" "false", 35 | "for" "for", 36 | "fortran" "fortran", 37 | "goto" "goto", 38 | "if" "if", 39 | "integer" "integer", 40 | "is" "is", 41 | "logical" "logical", 42 | "long" "long", 43 | "null" "null", 44 | "of" "of", 45 | "or" "or", 46 | "procedure" "procedure", 47 | "real" "real", 48 | "record" "record", 49 | "reference" "reference", 50 | "rem" "rem", 51 | "result" "result", 52 | "shl" "shl", 53 | "short" "short", 54 | "shr" "shr", 55 | "step" "step", 56 | "string" "string", 57 | "then" "then", 58 | "true" "true", 59 | "until" "until", 60 | "value" "value", 61 | "while" "while", 62 | /(go[\\t ]*to)/ 63 | end keywords 64 | 65 | operators are 66 | (~= \not,"="), 67 | ~ \not 68 | end operators 69 | 70 | optional keywords are 71 | "and" \wedge, 72 | "or" \vee, 73 | "shl" \uparrow, 74 | "shr" \downarrow, 75 | "div" \div 76 | end keywords 77 | 78 | optional operators are 79 | # * \times, 80 | ** \uparrow, 81 | <= \leq, 82 | >= \geq, 83 | ~= \neq 84 | end operators 85 | 86 | sequences are 87 | "comment" Comment Comment ";" Plain, 88 | "%" Comment Comment ";" Plain, 89 | "%" Comment Comment "%" Plain, 90 | "@" Comment Comment /$/ Plain, 91 | 92 | # String and character constants (Quotes are escaped by doubling them): 93 | "\"" Plain 94 | Plain 95 | "\"" Plain 96 | exceptions are "\"\"" end exceptions 97 | end sequences 98 | 99 | end style 100 | -------------------------------------------------------------------------------- /Tools/awnest-test-file.alw: -------------------------------------------------------------------------------- 1 | BEGIN 2 | 3 | PROCEDURE ROMAN (INTEGER VALUE NUMBER; STRING(15) RESULT CHARACTERS; INTEGER RESULT LENGTH); 4 | COMMENT 5 | Returns the Roman number of an integer between 1 and 3999. 6 | "MMMDCCCLXXXVIII" (15 characters long) is the longest Roman number under 4000; 7 | BEGIN 8 | INTEGER PLACE, POWER; 9 | 10 | PROCEDURE APPEND (STRING(1) VALUE C); 11 | BEGIN CHARACTERS(LENGTH|1) := C; LENGTH := LENGTH + 1 END; 12 | 13 | PROCEDURE I; APPEND(CASE PLACE OF ("I","X","C","M")); 14 | PROCEDURE V; APPEND(CASE PLACE OF ("V","L","D")); 15 | PROCEDURE X; APPEND(CASE PLACE OF ("X","C","M")); 16 | 17 | ASSERT (NUMBER >= 1) AND (NUMBER < 4000); 18 | 19 | CHARACTERS := " "; 20 | LENGTH := 0; 21 | POWER := 1000; 22 | PLACE := 4; 23 | WHILE PLACE > 0 DO 24 | BEGIN 25 | CASE NUMBER DIV POWER + 1 OF BEGIN 26 | BEGIN END; 27 | BEGIN I END; 28 | BEGIN I; I END; 29 | BEGIN I; I; I END; 30 | BEGIN I; V END; 31 | BEGIN V END; 32 | BEGIN V; I END; 33 | BEGIN V; I; I END; 34 | BEGIN V; I; I; I END; 35 | BEGIN I; X END 36 | END; 37 | NUMBER := NUMBER REM POWER; 38 | POWER := POWER DIV 10; 39 | PLACE := PLACE - 1 40 | END 41 | END ROMAN; 42 | 43 | INTEGER I; 44 | STRING(15) S; 45 | 46 | ROMAN(1, S, I); WRITE(S, I); 47 | ROMAN(3999, S, I); WRITE(S, I); 48 | ROMAN(3888, S, I); WRITE(S, I); 49 | ROMAN(2009, S, I); WRITE(S, I); 50 | ROMAN(405, S, I); WRITE(S, I); 51 | 52 | @AWE_TEXT 53 | 54 | Ignore this rubbish, it is commented out. 55 | PROCEDURE ROMAN (INTEGER VALUE NUMBER; STRING(15) RESULT CHARACTERS; INTEGER RESULT LENGTH); 56 | COMMENT 57 | Returns the Roman number of an integer between 1 and 3999. 58 | "MMMDCCCLXXXVIII" (15 characters long) is the longest Roman number under 4000; 59 | BEGIN 60 | 61 | @AWE_CODE 62 | 63 | END. 64 | -------------------------------------------------------------------------------- /Tools/awnest.1: -------------------------------------------------------------------------------- 1 | .TH awnest 1 "2012-06-01" "awnest" "Algol W source code lister" 2 | .SH "NAME" 3 | awnest \- line number and block-level lister for the Algol W language 4 | .SH "SYNOPSIS" 5 | \fBawnest\fR < \fIsource.alw\fR > \fIlisting.text\fR 6 | .SH "DESCRIPTION" 7 | This produces a source code listing of an Algol W program with 8 | line numbers and block levels in columns on left. 9 | (The block level is the number of unclosed BEGINs that preceed the line.) 10 | .PP 11 | Legacy code source can be quite densely packed (perhaps to save punch cards) 12 | so this kind of listing can be very useful. 13 | .SH "VERSION" 14 | 1.0 15 | .SH "COPYRIGHTS" 16 | Copyright 2012 by Glyn Webster. 17 | .PP 18 | alnest is free software: you can redistribute it and/or modify it under 19 | the terms of the GNU General Public License and Lesser GNU General 20 | Public License as published by the Free Software Foundation, either 21 | version 3 of the License, or (at your option) any later version. 22 | .SH "SEE ALSO" 23 | .PP 24 | \fIawe\fR\|(1) 25 | \fIAlgol W Language Description, June 1972\fR 26 | -------------------------------------------------------------------------------- /VERSION: -------------------------------------------------------------------------------- 1 | 2024-12 Version -------------------------------------------------------------------------------- /algolw.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/glynawe/awe/659346c6042ae10e5b544cd907ca9c7dcc38eec4/algolw.pdf -------------------------------------------------------------------------------- /awe.mk: -------------------------------------------------------------------------------- 1 | # awe.mk -- General purpose Makefile for Algol W programs. 2 | 3 | # See man page awe.mk(7) 4 | 5 | #Cygwin's libgc library (cygwin 1.7.16-1, libgc-devel 7.1-1) does not 6 | #currently work with Awe, it issues warnings and corrupts memory, so 7 | #'libawe.a' is not linked to 'libgc' on Cygwin. 8 | # 9 | ifeq ($(shell uname -o),Cygwin) 10 | $(warning "This is Cygwin, so not linking your program to 'libgc'.") 11 | LDLIBS += -lawe -lm 12 | else 13 | LDLIBS += -lawe -lm -lgc 14 | endif 15 | 16 | # Awe programs require an executable stack for call-by-name 17 | # "-z execstack" suppresses a warning from the GCC linker 18 | # See: https://www.redhat.com/en/blog/linkers-warnings-about-executable-stacks-and-segments 19 | # 20 | CFLAGS += -z execstack 21 | LDFLAGS += -z execstack 22 | 23 | ifdef COMPILER_PATH 24 | CFLAGS += -I$(COMPILER_PATH) -L$(COMPILER_PATH) 25 | AWE=$(COMPILER_PATH)/awe 26 | else 27 | AWE=awe 28 | endif 29 | 30 | ifndef DISTNAME 31 | DISTNAME = $(shell basename `pwd`) 32 | endif 33 | 34 | .PHONY: default build clean test dist 35 | 36 | # default rule: 37 | build: Makefile $(PROGRAM) 38 | 39 | $(PROGRAM) : $(PROGRAM).awe.c $(PROGRAM).awe.h $(C_SOURCES) $(C_INCLUDES) 40 | gcc $(CFLAGS) $(C_SOURCES) $(PROGRAM).awe.c $(LDLIBS) -o $(PROGRAM) 41 | 42 | $(PROGRAM).awe.c $(PROGRAM).awe.h : $(ALGOLW_SOURCES) 43 | $(AWE) $(AWE_FLAGS) $(ALGOLW_SOURCES) -c $(PROGRAM).awe.c > $(PROGRAM).awe.h 44 | 45 | clean:: 46 | rm -f $(PROGRAM) $(PROGRAM).awe.c $(PROGRAM).awe.h $(DISTNAME).tar.gz 47 | 48 | # Tar the files with the program's name as a directory prefix. 49 | # 50 | # /$(sort ...)' = sort and remove duplicate file names (the latter is important) 51 | # 52 | # '--transform=...' = edit the path names going into 'tar' using 'sed' 53 | # 54 | ALL_FILES = $(sort $(wildcard Makefile $(ALGOLW_SOURCES) $(C_SOURCES) $(C_INCLUDES) $(EXTRA_FILES))) 55 | dist: 56 | rm -f $(DISTNAME).tar.gz 57 | tar --create --gzip \ 58 | --no-recursion \ 59 | --transform "s|^|$(DISTNAME)/|" \ 60 | --file $(DISTNAME).tar.gz $(ALL_FILES) 61 | #end 62 | -------------------------------------------------------------------------------- /class.ml: -------------------------------------------------------------------------------- 1 | (* class.mli -- record class identifiers 2 | 3 | -- 4 | 5 | This file is part of Awe. Copyright 2012 Glyn Webster. 6 | 7 | Awe is free software: you can redistribute it and/or modify it 8 | under the terms of the GNU General Public License as published 9 | by the Free Software Foundation, either version 3 of the License, or 10 | (at your option) any later version. 11 | 12 | Awe is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public 18 | License along with Awe. If not, see . 19 | 20 | *) 21 | 22 | (* Record classes are identified by their index in a global class 23 | array. Awe must give record classes unique C identifiers because C 24 | structure definitions are always global. *) 25 | 26 | type t = int 27 | 28 | let compare a b = a - b 29 | 30 | let exception_class = (Table.Id.create "_awe_class_0_exception", "exception") 31 | 32 | let global_class_array = DynArray.create (Table.Id.dummy, "") 33 | 34 | let create loc id = 35 | let name = Table.Id.to_string id in 36 | let number = DynArray.length global_class_array in 37 | let global_id = Table.Id.create (Printf.sprintf "_awe_class_%i_%s" number name) in 38 | DynArray.add global_class_array (global_id, name) ; 39 | number 40 | 41 | let to_id c = fst (DynArray.get global_class_array c) 42 | 43 | let to_string c = snd (DynArray.get global_class_array c) 44 | 45 | let contents () = DynArray.to_list global_class_array 46 | 47 | 48 | 49 | (* end *) 50 | -------------------------------------------------------------------------------- /class.mli: -------------------------------------------------------------------------------- 1 | (* class.mli -- record class identifiers 2 | 3 | -- 4 | 5 | This file is part of Awe. Copyright 2012 Glyn Webster. 6 | 7 | Awe is free software: you can redistribute it and/or modify it 8 | under the terms of the GNU General Public License as published 9 | by the Free Software Foundation, either version 3 of the License, or 10 | (at your option) any later version. 11 | 12 | Awe is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public 18 | License along with Awe. If not, see . 19 | 20 | *) 21 | 22 | 23 | (* Record classes need unique global C identifiers. This module generates them. *) 24 | 25 | type t 26 | 27 | val compare : t -> t -> int 28 | 29 | val create : Location.t -> Table.Id.t -> t 30 | 31 | val to_id : t -> Table.Id.t 32 | 33 | val to_string : t -> string (* the C identifier for the class *) 34 | 35 | val contents : unit -> (Table.Id.t * string) list 36 | 37 | (* end *) 38 | -------------------------------------------------------------------------------- /code.mli: -------------------------------------------------------------------------------- 1 | (* code.ml 2 | 3 | -- 4 | 5 | This file is part of Awe. Copyright 2012 Glyn Webster. 6 | 7 | Awe is free software: you can redistribute it and/or modify it 8 | under the terms of the GNU General Public License as published 9 | by the Free Software Foundation, either version 3 of the License, or 10 | (at your option) any later version. 11 | 12 | Awe is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public 18 | License along with Awe. If not, see . 19 | 20 | *) 21 | 22 | (* Rapidly concatenatable scraps of C code text. *) 23 | 24 | (* A scrap of C code. *) 25 | type t 26 | 27 | val empty : t 28 | 29 | (* 'string s' converts the string 's' to a scrap. *) 30 | val string : string -> t 31 | 32 | val id : Table.Id.t -> t 33 | 34 | val to_string : t -> string 35 | 36 | 37 | (* 'separate seperator scrap_list' concatenates a list of C code scraps, 38 | using the string 'separator' as a separator. *) 39 | val separate : string -> t list -> t 40 | 41 | 42 | val concat : t list -> t 43 | val add : t -> t -> t 44 | 45 | (* Adds two code scraps with a comma between them. 46 | But if either of the scraps is empty the separator is not used. *) 47 | 48 | val add_with_comma : t -> t -> t 49 | 50 | (* 'template template scrap_list' makes a C code scrap, replacing '$' 51 | signs in 'template' with C code scraps from 'scrap_list'. *) 52 | val template : string -> t list -> t 53 | 54 | (* 'output_code channel scrap' outputs 'scrap' to 'channel' as a string. *) 55 | val output_code : out_channel -> t -> unit 56 | 57 | (* 'is_empty scrap' returns true if 'scrap' represents an empty string. *) 58 | val is_empty : t -> bool 59 | 60 | (* end *) 61 | -------------------------------------------------------------------------------- /dynArray.ml: -------------------------------------------------------------------------------- 1 | (* dynArray.ml 2 | 3 | -- 4 | 5 | This file is part of Awe. Copyright 2012 Glyn Webster. 6 | 7 | Awe is free software: you can redistribute it and/or modify it 8 | under the terms of the GNU General Public License as published 9 | by the Free Software Foundation, either version 3 of the License, or 10 | (at your option) any later version. 11 | 12 | Awe is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public 18 | License along with Awe. If not, see . 19 | 20 | *) 21 | 22 | type 'a t = { 23 | mutable length : int; 24 | mutable arr : 'a array; 25 | filler : 'a 26 | } 27 | 28 | let initial_size = 20 29 | 30 | let create filler = 31 | { length = 0; 32 | arr = Array.make initial_size filler; 33 | filler = filler } 34 | 35 | let get a i = Array.get a.arr i 36 | 37 | let add a element = 38 | let len = Array.length a.arr in 39 | if len = a.length then 40 | a.arr <- Array.append a.arr (Array.make len a.filler) ; (* double the array length *) 41 | Array.set a.arr a.length element ; 42 | a.length <- a.length + 1 43 | 44 | let length a = a.length 45 | 46 | let to_list (a : 'a t) : 'a list = 47 | let xs = ref [] in 48 | for i = a.length - 1 downto 0 do 49 | xs := a.arr.(i) :: !xs 50 | done ; 51 | !xs 52 | 53 | (* end *) 54 | 55 | -------------------------------------------------------------------------------- /dynArray.mli: -------------------------------------------------------------------------------- 1 | (* dynArray.mli -- An array that grows when elements are added to the end. 2 | 3 | A newly created DynArray.t has no elements. 4 | 5 | -- 6 | 7 | This file is part of Awe. Copyright 2012 Glyn Webster. 8 | 9 | Awe is free software: you can redistribute it and/or modify it 10 | under the terms of the GNU General Public License as published 11 | by the Free Software Foundation, either version 3 of the License, or 12 | (at your option) any later version. 13 | 14 | Awe is distributed in the hope that it will be useful, 15 | but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | GNU General Public License for more details. 18 | 19 | You should have received a copy of the GNU General Public 20 | License along with Awe. If not, see . 21 | 22 | *) 23 | 24 | type 'a t 25 | 26 | val create : 'a -> 'a t (* the parameter is a dummy *) 27 | val get : 'a t -> int -> 'a 28 | val add : 'a t -> 'a -> unit 29 | val length : 'a t -> int 30 | val to_list : 'a t -> 'a list 31 | 32 | (* end *) 33 | 34 | -------------------------------------------------------------------------------- /email_address.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/glynawe/awe/659346c6042ae10e5b544cd907ca9c7dcc38eec4/email_address.png -------------------------------------------------------------------------------- /htmltext.py: -------------------------------------------------------------------------------- 1 | #!/usr/env python3 2 | 3 | template = ''' 4 | 5 | 6 | %s 7 | 8 | 9 | 
%s
10 | 11 | 12 | ''' 13 | 14 | from sys import stdout, stdin, argv 15 | from html import escape 16 | 17 | stdout.write(template % (escape(argv[1]), escape(stdin.read()))) 18 | -------------------------------------------------------------------------------- /location.ml: -------------------------------------------------------------------------------- 1 | (* location.ml 2 | 3 | -- 4 | 5 | This file is part of Awe. Copyright 2012 Glyn Webster. 6 | 7 | Awe is free software: you can redistribute it and/or modify it 8 | under the terms of the GNU General Public License as published 9 | by the Free Software Foundation, either version 3 of the License, or 10 | (at your option) any later version. 11 | 12 | Awe is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public 18 | License along with Awe. If not, see . 19 | 20 | *) 21 | 22 | type source_t = { file_name : string; 23 | file_number : int } 24 | 25 | type t = { source : source_t; 26 | line : int; 27 | column : int } 28 | 29 | let filename loc = loc.source.file_name 30 | let file_number loc = loc.source.file_number 31 | let line loc = loc.line 32 | let column loc = loc.column 33 | 34 | let to_string loc = 35 | Printf.sprintf "%s:%i:%i:" (filename loc) (line loc) (column loc + 1) 36 | 37 | 38 | let sources : (string, source_t) Hashtbl.t = Hashtbl.create 20 39 | 40 | let source_list : source_t list ref = ref [] 41 | 42 | 43 | let source_files () = List.map (function source -> source.file_name) !source_list 44 | 45 | 46 | let create_source file_name = 47 | try 48 | Hashtbl.find sources file_name 49 | with Not_found -> 50 | let file_number = List.length !source_list in 51 | let source = {file_name; file_number} in 52 | source_list := !source_list @ [source] ; 53 | Hashtbl.add sources file_name source ; 54 | source 55 | 56 | 57 | let current_source : source_t ref = 58 | let stdin_source = create_source "" in 59 | ref stdin_source 60 | 61 | 62 | let set_source filename = 63 | let source = create_source filename in 64 | current_source := source 65 | 66 | 67 | let create filename line column = 68 | let source = create_source filename in 69 | {source; line; column} 70 | 71 | 72 | let of_position (position : Lexing.position) : t = 73 | let source = !current_source in 74 | let line = position.Lexing.pos_lnum in 75 | let column = position.Lexing.pos_cnum - position.Lexing.pos_bol in 76 | {source; line; column} 77 | 78 | (* end *) 79 | -------------------------------------------------------------------------------- /location.mli: -------------------------------------------------------------------------------- 1 | (* location.mli -- Algol W source code locations, for runtime error messages 2 | 3 | -- 4 | 5 | This file is part of Awe. Copyright 2012 Glyn Webster. 6 | 7 | Awe is free software: you can redistribute it and/or modify it 8 | under the terms of the GNU General Public License as published 9 | by the Free Software Foundation, either version 3 of the License, or 10 | (at your option) any later version. 11 | 12 | Awe is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public 18 | License along with Awe. If not, see . 19 | 20 | *) 21 | 22 | type t 23 | 24 | val filename : t -> string 25 | val file_number : t -> int 26 | val line : t -> int 27 | val column : t -> int 28 | 29 | val source_files : unit -> string list (* The names of all the source files, in file_number order. *) 30 | 31 | val set_source : string -> unit (* set a source file name as the one for error reports, 32 | appends a new source file to list of sources in needed *) 33 | 34 | val create : string -> int -> int -> t (* Create from source file, line number and column number. *) 35 | 36 | val of_position : Lexing.position -> t 37 | 38 | val to_string : t -> string (* Convert to an Emacs-compatible source code location string *) 39 | 40 | (* end *) 41 | -------------------------------------------------------------------------------- /man.py: -------------------------------------------------------------------------------- 1 | #!/usr/env python3 2 | # man.py -- very simple markup preprocessor for man pages 3 | 4 | import re, time, sys 5 | 6 | def usage(): 7 | print('''usage: python3 man.py manpage.1.md manpage.1 MACRO=value... 8 | 9 | This is a rough preprocessor to convert a subset of Markdown to man pages. 10 | 11 | A summary of the markup commands you can use in your src file: 12 | 13 | # TITLE 1 / program name / short program description 14 | 15 | ## heading 16 | *itatics* 17 | **bold** 18 | `monospace` 19 | {{MACRO}} 20 | 21 | ``` 22 | example code block 23 | ``` 24 | 25 | definition 26 | : description 27 | ''') 28 | sys.exit(1) 29 | 30 | if len(sys.argv) < 3: usage() 31 | 32 | macros = {'DATE': time.strftime("%Y-%m-%d"), 33 | 'YEAR': time.strftime("%Y")} 34 | for arg in sys.argv[3:]: 35 | m = re.match(r'([A-Z][A-Za-z0-9_]+)=(.*)', arg) 36 | if m: 37 | macros[m.group(1)] = m.group(2) 38 | else: 39 | usage() 40 | 41 | repls = [ 42 | (r'^###? +(.+?)$', r'.SH "\1"'), # ## heading 43 | (r'\*\*(.+?)\*\*', r'\\fB\1\\fR'), # **bold** 44 | (r'\*(.+?)\*', r'\\fI\1\\fR'), # *itatics* 45 | (r'`(.+?)`', r'\\fI\1\\fR'), # `monospace` 46 | ('^(.+?) *\n: +', '\n.TP\n.B \\1\n'), # definition 47 | (r'^# +(.+?) */ *(.+?) */ *(.+?) *$', 48 | r'.TH \1 "{{DATE}}" "\2" "\3"'), # man page heading 49 | (r'{{(.+?)}}', 50 | lambda m: macros[m.group(1)]) ] # {{macro}} substitution 51 | 52 | 53 | with open(sys.argv[1], "r") as f: 54 | page = f.read() 55 | 56 | # split into text and code example sections, 57 | # odd-numbered sections will be code: 58 | sections = re.split('```[A-Za-z]*', page) 59 | 60 | with open(sys.argv[2], "w") as f: 61 | for i, s in enumerate(sections): 62 | if i % 2 == 0: # text section 63 | for pattern, repl in repls: 64 | s = re.sub(pattern, repl, s, flags=re.MULTILINE) 65 | else: # code section 66 | s = s.replace('\n', '\n ') 67 | s = '\n.nf\n' + s + '\n.fi\n' 68 | f.write(s) 69 | -------------------------------------------------------------------------------- /markdown-to-html.py: -------------------------------------------------------------------------------- 1 | ''' markdown-to-html.py -- convert a Markdown file to an HTML page''' 2 | 3 | # The HTML page will require 'github-markdown.css' from 4 | # https://github.com/sindresorhus/github-markdown-css 5 | # 6 | # The Markdown file must contain a top-level heading 7 | 8 | from pathlib import Path 9 | from sys import argv 10 | from markdown import markdown 11 | from html import escape 12 | import re 13 | 14 | markdown_text = Path(argv[1]).read_text() 15 | html_file = Path(argv[2]) 16 | 17 | html = markdown(markdown_text, extensions=['extra', 'toc']) 18 | title = escape(re.search(r'^# +(.+) *$', markdown_text, re.MULTILINE).group(1)) 19 | 20 | html_file.write_text(''' 21 | 22 | 23 | 24 | 25 | 26 | %s 27 | 28 | 29 | 30 | 31 | 40 | 41 | 42 |
43 | %s 44 |
45 | 46 | ''' % (title, html)) 47 | -------------------------------------------------------------------------------- /options.ml: -------------------------------------------------------------------------------- 1 | (* options.ml --- Awe compiler options. *) 2 | 3 | let initialize_all = ref true 4 | let add_tracing_hooks = ref false 5 | -------------------------------------------------------------------------------- /scope.ml: -------------------------------------------------------------------------------- 1 | (* scope.ml 2 | 3 | -- 4 | 5 | This file is part of Awe. Copyright 2012 Glyn Webster. 6 | 7 | Awe is free software: you can redistribute it and/or modify it 8 | under the terms of the GNU General Public License as published 9 | by the Free Software Foundation, either version 3 of the License, or 10 | (at your option) any later version. 11 | 12 | Awe is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public 18 | License along with Awe. If not, see . 19 | 20 | *) 21 | 22 | 23 | exception Undefined of Table.Id.t 24 | 25 | exception Redefined of Table.Id.t * Type.definition_t 26 | 27 | 28 | module Local = 29 | struct 30 | type t = Type.definition_t Table.IdMap.t 31 | 32 | let empty = Table.IdMap.empty 33 | 34 | let get block id = 35 | try 36 | Some (Table.IdMap.find id block) 37 | with 38 | Not_found -> None 39 | 40 | let set block id defn = 41 | try 42 | let existing_defn = Table.IdMap.find id block in 43 | raise (Redefined (id, existing_defn)) 44 | with Not_found -> 45 | Table.IdMap.add id defn block 46 | 47 | let redefine block id defn = 48 | Table.IdMap.add id defn (Table.IdMap.remove id block) 49 | 50 | let fold = Table.IdMap.fold 51 | end 52 | 53 | 54 | type t = Local.t list 55 | 56 | 57 | let empty = [Local.empty] 58 | 59 | 60 | let push scope = Local.empty :: scope 61 | 62 | 63 | let pop = 64 | function 65 | | [] -> failwith "Scope.pop: this popped the global scope." 66 | | _ :: outer_scope -> outer_scope 67 | 68 | 69 | let rec get scope id = 70 | match scope with 71 | | [] -> raise (Undefined id) 72 | | local_block :: global_scope -> 73 | match Local.get local_block id with 74 | | Some defn -> defn 75 | | None -> get global_scope id 76 | 77 | 78 | let set scope id defn = 79 | match scope with 80 | | [] -> failwith "This should never happen." 81 | | local_block :: global_scope -> 82 | Local.set local_block id defn :: global_scope 83 | 84 | let redefine scope id defn = 85 | match scope with 86 | | [] -> failwith "This should never happen." 87 | | local_block :: global_scope -> 88 | Local.redefine local_block id defn :: global_scope 89 | 90 | (* end*) 91 | -------------------------------------------------------------------------------- /table.mli: -------------------------------------------------------------------------------- 1 | (* table.mli 2 | 3 | -- 4 | 5 | This file is part of Awe. Copyright 2012 Glyn Webster. 6 | 7 | Awe is free software: you can redistribute it and/or modify it 8 | under the terms of the GNU General Public License as published 9 | by the Free Software Foundation, either version 3 of the License, or 10 | (at your option) any later version. 11 | 12 | Awe is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public 18 | License along with Awe. If not, see . 19 | 20 | *) 21 | 22 | (* The global symbol table. *) 23 | 24 | (* Algol W identifiers. These are case insensitive, but they are always output in lowercase. 25 | This interface is compatible with 'Set.OrderedType' and 'Hashtbl.HashableType'. 26 | *) 27 | module Id : sig 28 | 29 | (* An identifier in an Algol W program. *) 30 | type t 31 | 32 | (* 'create string' creates a new identifier from an identifier string *) 33 | val create : string -> t 34 | 35 | (* 'to_string identifier' returns the string representation of an identifier. 36 | Returns the identifier as a lowercase string *) 37 | val to_string : t -> string 38 | 39 | (* Returns the string representation of an identifier, with a "_" appended 40 | if it would clash with GNU C's reserved words or global identifiers. *) 41 | val to_C_id_string : t -> string 42 | 43 | val hash : t -> int 44 | val compare : t -> t -> int 45 | val eq : t -> t -> bool 46 | 47 | val dummy : t (* an identifer that is never used *) 48 | end 49 | 50 | 51 | (* Maps of identifiers to any type. Used in Scope module. *) 52 | module IdMap : Map.S with type key = Id.t 53 | 54 | 55 | (* end *) 56 | --------------------------------------------------------------------------------