Check-in [3c37614ec4]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Updated to 5th version of the Pascal-P compiler -- pascal-p5
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:3c37614ec42e6fda5eee9b2946702526ead63993
User & Date: tonypdmtr 2016-11-20 22:13:36
Context
2016-11-20
22:23
Compressed all EXE files with UPX check-in: a3dab7471a user: tonypdmtr tags: trunk
22:13
Updated to 5th version of the Pascal-P compiler -- pascal-p5 check-in: 3c37614ec4 user: tonypdmtr tags: trunk
2014-10-20
11:05
Added missing comment closing brace (pint.pas) check-in: e0844d3905 user: tonypdmtr tags: trunk
Changes

Added INSTALL.

































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Installation instructions

To install Pascal-p5, execute:

[Linux]

> ./configure
> make

[Windows]

> configure
> make

To access binaries in the project, execute:

[Linux]

./setpath

[Windows --

setpath

Note that you can copy the path set within the setpath or setpath.bat batch file
to your startup environment to prevent the need to execute this again.

You can then compile and run single Pascal sources with the command:

p5 <file>

The extension .pas is supplied automatically.

Added LICENSE.































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Pascal-P5 is derived from the original sources of the Pascal-P compiler from
ETH Zurich, as created by Niklaus Wirth and his students. It was and is public
domain, as acknowledged by Professor Wirth, and I add my modifications to it to
the public domain as well.

Public domain is a widely misunderstood concept. There is no "license" possible
nor needed for public domain works. There are no restrictions on it's use, nor 
do it's authors have any rights to it. It can be used for any purpose, public or
private, and distributed or modified for any use whatever, paid or not.

The following are typical answers to questions about public domain works in
general, and this work in specific.

Q. The Berne convention states that copyright in europe, where Pascal-P 
originated, is automatic. Doesn't that make Pascal-P a copyrighted work?

A. The laws in all copyright countries dictate what must be done to qualify
as a copyrighted work. Since there is no specific legal agreement concerning
public domain work, public domain is shaped by what constitutes enforceable
copyright. The most common features of public domain are, but not limited to:

   1. The author has stated the work is public domain.
   
   2. The work has been distributed freely and with knowledge of the author(s).
   
In the case of Pascal-P, both are true.

Q. Dosen't public domain mean that I may no longer be able to gain access to the
source?

A. If every copy of the work were to be erased or burned, but that is virtually
impossible. Nobody can order you to release your copy since, by definition, 
there are no "rights" to a public domain work.

Q. Can't someone just copyright or patent the work later?

A. Showing that a work is in the public domain is part of denying copyright or
patent to a work. By definition, a legitimate public domain work cannot later
be copyrighted or patented.

Q. Can't someone improve the work, then gain rights to that derived work and
thus restrict it's use?

A. Anyone can improve a public domain work, but they only have rights to their
improvements, not to the original work. If their improvements are trivial, then
it would be trivial for others to add that functionality. If it is not trivial,
then you might want to pay for it.

Added Makefile.





















































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
#
# Makefile for Pascal-p5
#
# Makes the main compiler interpreter set.
#
PC=gpc
CFLAGS=--classic-pascal-level-0 --no-warnings --transparent-file-names --no-range-checking

all: pcom pint

pcom: source/pcom.pas
	$(PC) $(CFLAGS) -o bin/pcom source/pcom.pas
	
pint: source/pint.pas
	$(PC) $(CFLAGS) -o bin/pint source/pint.pas
	
clean:
	rm -f bin/pcom bin/pint 
	find . -name "*.p5" -type f -delete
	find . -name "*.p4" -type f -delete
	find . -name "*.p2" -type f -delete
	find . -name "*.out" -type f -delete
	find . -name "*.lst" -type f -delete
	find . -name "*.obj" -type f -delete
	find . -name "*.sym" -type f -delete
	find . -name "*.int" -type f -delete
	find . -name "*.dif" -type f -delete
	find . -name "*.err" -type f -delete
	find . -name "*.tmp" -type f -delete
	find . -name "prd" -type f -delete
	find . -name "prr" -type f -delete
	find . -name "temp" -type f -delete
	find . -name "tmp" -type f -delete
	find . -name "*~" -type f -delete
	find . -name "temp?" -type f -delete

#
# Make ready for repository
#
# This target makes the code ready for the repository.
# We configure for GPC 32 bit as normal target, and clean
# all files.
#
repo_ready:
	configure --gpc --32
	
#
# Make flip program
#
flip: c_support\flip.c
	gcc -o bin\flip c_support\flip.c

#
# Make archive
#
archive:
	rm -f pascal-p5.tar.gz
	tar --exclude='./.git' --exclude='./.cproject' --exclude='./.project' --exclude='./pascal-p5*.tar.gz' -zcvf pascal-p5.tar.gz .

Added NEWS.









>
>
>
>
1
2
3
4
In design and coding is the Pascal-P5 version 1.2. You will find news releases
concerning it at:

https://sourceforge.net/p/pascalp5/discussion/news/

Added README.









































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
                         THE P5 COMPILER/INTERPRETER

============================== Description =====================================

This is the 5th version of the Pascal-P compiler from Zurich. This is the
Pascal-P4 compiler modified to be ISO 7185 Pascal compilant, both in the the
implementation language, and in the language it processes. It is the first
version of Pascal-P created outside of Zurich.

Pascal-P was an implementation kit, created between 1972 and 1974, for the
original language Pascal. The source for the original compiler was passed around
and modified quite a bit, but Niklaus Wirth noted that it was very popular, and
represented a good method to popularize the language. He gathered the source
into a clean version called Pascal-P2, which was the basis of UCSD Pascal, which
in turn was the base language for Borland Pascal. The Zurich group then created
an improved version called Pascal-P4.

Pascal-P5 is Pascal-P4 modified to accept all of the ISO 7185 language.

The full instructions for running and setting up the P5 compiler/interpreter
have all been incorporated into the document:

doc/the_p5_compiler.docx

Which is a Microsoft Word document, 2007 or later. it is also available in the
formats:

doc/the_p5_compiler.pdf     Adobe Portable Document Format.
doc/the_p5_compiler.html    Web page format.
doc/the_p5_compiler.doc     Word 1997-2003 format.

Please consult one of these documents for full instructions on how to use P5.

============================== Quick start =====================================

Pascal-p5 uses the standard GNU release layout. You execute:

[Windows]

> setpath
> configure
> make

[linux]

> ./setpath
> ./configure
> make

(You can avoid "setpath" by placing the ./bin directory on your path)

This will make the compiler and interpreter set. You can then try a sample
program as:

> p5 sample_programs/hello

================================== Problems ====================================

You need a working gpc implementation. It is strongly suggested you use the
gpc version 20070904. gpc has/had various compliance issues with ISO 7185, and
the compiler has ceased to be supported. This version is found to be solid.

You will need a working set of linux tooling (grep, ls, rm, etc). Mingw has
an excellent set of tools for Windows users.

You need the "flip" line ending adapation program. If you don't have it, we
include a copy you can compile, or you can simply go find it. It is a widely
available program.

Added TODO.



























>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
The Pascal-P5 project is resident at sourceforge.net in:

https://sourceforge.net/projects/pascalp5/

There is an ongoing bug and feature request tracking system ongoing at:

https://sourceforge.net/p/pascalp5/tickets/

You will find a general discussion forum for it at:

https://sourceforge.net/p/pascalp5/discussion/

These are the places you will find items "to do" in Pascal-P5.

Added bin/chgver.bat.

























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
@echo off
rem
rem Change version numbers on compare file
rem
rem Format:
rem
rem chgver file from_ver to_ver
rem
if not "%1"=="" goto paramok1
echo *** Error: Missing file name
goto stop
:paramok1
if not "%2"=="" goto paramok2
echo *** Error: Missing "from" version number
goto stop
:paramok2
if not "%3"=="" goto paramok3
echo *** Error: Missing "to" version number
goto stop
:paramok3
if exist "%1.pas" goto fileexists
echo *** Error: Missing "%1" file
goto stop
:fileexists
sed -e 's/P5 Pascal interpreter vs. %2/P5 Pascal interpreter vs. %3/g' %1 > temp
copy temp %1
del temp
:stop

Added bin/chgvers.bat.













































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
@echo off
rem
rem Change version numbers on all compare files
rem
if not "%2"=="" goto paramok1
echo *** Error: Missing "from" version number
goto stop
:paramok1
if not "%3"=="" goto paramok2
echo *** Error: Missing "to" version number
goto stop
:paramok2
call chgver sample_programs\basics.cmp %1 %2
call chgver sample_programs\hello.cmp %1 %2
call chgver sample_programs\match.cmp %1 %2
call chgver sample_programs\pascals.cmp %1 %2
call chgver sample_programs\roman.cmp %1 %2
call chgver sample_programs\startrek.cmp %1 %2

call chgver standard_tests\iso7185pat.cmp
call chgver standard_tests\iso7185pats.cmp
:stop

Added bin/compile.











































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
#!/bin/bash
#
# Compile file in batch mode using GPC Pascal.
#
# Runs a compile with the input and output coming from/
# going to files.
#
# Execution:
#
# Compile <file>
#
# <file> is the filename without extention.
#
# The files are:
#
# <file>.pas - The Pascal source file
# <file>.p5  - The intermediate file produced
# <file>.err - The errors output from the compiler
#
# Note that the l+ option must be specified to get a full
# listing in the .err file (or just a lack of l-).
#

if [ -z "$1" ]
then
   echo "*** Error: Missing parameter"
   exit 1
fi

if [ ! -f $1.pas ]
then
   echo "*** Error: Missing $1.pas file"
   exit 1
fi

cp $1.pas prd
pcom > $1.err
#
# The status of the compile is not returned, so convert a non-zero
# error message to fail status
#
grep -q "Errors in program: 0" $1.err
rc=$?
if [[ $rc != 0 ]] ; then

    exit 1
        
fi
#
# Move the prr file to <file.p5>
#
rm -f $1.p5
mv prr $1.p5

Added bin/compile.bat.







































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
@echo off
rem
rem Compile file in batch mode using GPC Pascal.
rem
rem Runs a compile with the input and output coming from/
rem going to files.
rem
rem Execution:
rem
rem Compile <file>
rem
rem <file> is the filename without extention.
rem
rem The files are:
rem
rem <file>.pas - The Pascal source file
rem <file>.p5  - The intermediate file produced
rem <file>.err - The errors output from the compiler
rem
rem Note that the l+ option must be specified to get a full
rem listing in the .err file (or just a lack of l-).
rem

if "%1"=="" (

    echo *** Error: Missing parameter
    exit /b 1

)

if not exist "%1.pas" (

    echo *** Error: Missing %1.pas file
    exit /b 1

)

cp %1.pas prd
pcom > %1.err
rem
rem The status of the compile is not returned, so convert a non-zero
rem error message to fail status
rem
grep -q "Errors in program: 0" %1.err
if errorlevel 1 exit /b 1
rem
rem Move the prr file to <file.p5>
rem
if exist "%1.p5" del %1.p5
mv prr %1.p5
chmod +w %1.p5

Added bin/cpcom.





































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#!/bin/bash
#
# Compile pcom using IP Pascal
#
# *** This script does not work, use the .bat file.
# There is a problem with getting command parameters from Bash.
#

if [ ! -f pcom.pas ]
then
   echo "*** Error: Missing pcom.pas file"
   exit 1
fi

echo
echo Compiling pcom.pas to create pcom.exe
echo
echo pc pcom /standard /nrf /r

Added bin/cpcom.bat.







































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
@echo off
rem
rem Compile pcom using IP Pascal
rem

if exist "pcom.pas" goto fileexists
echo *** Error: Missing pcom.pas file
goto stop
:fileexists

echo.
echo Compiling pcom.pas to create pcom.exe
echo.
pc pcom/standard/nrf/r

rem
rem Terminate
rem
:stop

Added bin/cpcoms.





























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
#!/bin/bash
#
# Script to run a pcom self compile
#
# First, change elide patterns to #ove prr file statements.
# The modified file goes in pcomm.pas (pcom modified).
#
sed -e 's/{elide}/{/g' -e 's/{noelide}/}/g' source/pcom.pas > pcomm.pas
#
# Compile pcom to intermediate code using its binary version.
#
echo Compiling pcom to intermediate code
compile pcomm
cat pcomm.err
#
# Now run that code on the interpreter and have it compile itself
# to intermediate again.
#
echo Running pcom to compile itself

cat pcomm.p5 pcomm.pas > tmp.p5
mv pcomm.p5 pcomm.p5.org
cp tmp.p5 pcomm.p5
echo > pcomm.inp

run pcomm
cat pcomm.lst
#
# Now we have the original intermediate from the binary version
# of pcom, and the intermediate generated by the interpreted
# pcom. Compare them for equality. Put the result in pcomm.dif.
#
echo -n "Comparing the intermediate code for the runs ... "
diffnole pcomm.p5.org pcomm.out > pcomm.dif
#
# Show the file, so if the length is zero, it compared ok.
#
#echo Resulting diff file length should be zero for pass
if test -s pcomm.dif
then
    echo FAILED
else
    echo PASS
fi
echo
#ls -l pcomm.dif

Added bin/cpcoms.bat.













































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
@echo off
rem
rem Script to run a pcom self compile
rem
rem First, change elide patterns to remove prr file statements.
rem The modified file goes in pcomm.pas (pcom modified).
rem
sed -e 's/{elide}/{/g' -e 's/{noelide}/}/g' source\pcom.pas > pcomm.pas
rem
rem Compile pcom to intermediate code using its binary version.
rem
echo Compiling pcom to intermediate code
call compile pcomm
type pcomm.err
rem
rem Now run that code on the interpreter and have it compile itself
rem to intermediate again.
rem
echo Running pcom to compile itself
cat pcomm.p5 pcomm.pas > tmp.p5
mv pcomm.p5 pcomm.p5.org
cp tmp.p5 pcomm.p5
echo.> pcomm.inp
call run pcomm
type pcomm.lst
rem
rem Now we have the original intermediate from the binary version
rem of pcom, and the intermediate generated by the interpreted
rem pcom. Compare them for equality. Put the result in pcomm.dif.
rem
echo Comparing the intermediate code for the runs
call diffnole pcomm.p5.org pcomm.out > pcomm.dif
rem
rem Show the file, so if the length is zero, it compared ok.
rem
echo Resulting diff file length should be zero for pass
dir pcomm.dif
del temp

Added bin/cpint.





































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#!/bin/bash
#
# Compile pint using IP Pascal
#
# This script does not work, use the .bat file.
# There is a problem with getting command parameters from Bash.
#

if [ ! -f pint.pas ]
then
   echo "*** Error: Missing pint.pas file"
   exit 1
fi

echo
echo Compiling pint.pas to create pint.exe
echo
pc pint/standard/nrf/r

Added bin/cpint.bat.







































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
@echo off
rem
rem Compile pcom using IP Pascal
rem

if exist "pcom.pas" goto fileexists
echo *** Error: Missing pcom.pas file
goto stop
:fileexists

echo.
echo Compiling pint.pas to create pint.exe
echo.
pc pint/standard/nrf/r

rem
rem Terminate
rem
:stop

Added bin/cpints.









































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
#!/bin/bash
#
# Script to run a pint self compile
#
# First, change elide patterns to #ove prd and prr file statements.
# The modified file goes in pintm.pas (pint modified).
#
sed -e 's/{elide}/{/g' -e 's/{noelide}/}/g' -e 's/{remove//g' -e 's/remove}//g' source/pint.pas > pintm.pas
#
# Compile the final target, the PAT
#
echo Compiling the ISO 7185 PAT
compile standard_tests/iso7185pat
cat standard_tests/iso7185pat.err
#
# Compile pint itself
#
echo Compiling pint to intermediate code
compile pintm
cat pintm.err
#
# Add the final target program (the pat) to the end of pint.
# This means that the version of pint will read and interpret
# this.
#
cat pintm.p5 standard_tests/iso7185pat.p5 > tmp.p5
rm pintm.p5
mv tmp.p5 pintm.p5
#
# Create null input file
#
echo > pintm.inp
#
# Now run pint on pint, which runs the PAT.
#
echo Running pint on itself, to run the ISO 7185 PAT
run pintm
cp pintm.lst standard_tests/iso7185pats.lst
echo -n "Comparing PAT result to reference ... "
diffnole standard_tests/iso7185pats.lst standard_tests/iso7185pats.cmp > standard_tests/iso7185pats.dif
if test -s iso7185pats.dif
then
    echo FAILED
else
    echo PASS
fi

#
# Show the file, so if the length is zero, it compared ok.
#
#echo Resulting diff file length should be zero for pass
#ls -l standard_tests/iso7185pats.dif

Added bin/cpints.bat.





























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
@echo off
rem
rem Script to run a pint self compile
rem
rem First, change elide patterns to remove prd and prr file statements.
rem The modified file goes in pintm.pas (pint modified).
rem
sed -e 's/{elide}/{/g' -e 's/{noelide}/}/g' -e 's/{remove//g' -e 's/remove}//g' source\pint.pas > pintm.pas
rem
rem Compile the final target, the PAT
rem
echo Compiling the ISO 7185 PAT
call compile standard_tests\iso7185pat
type standard_tests\iso7185pat.err
rem
rem Compile pint itself
rem
echo Compiling pint to intermediate code
call compile pintm
type pintm.err
rem
rem Add the final target program (the pat) to the end of pint.
rem This means that the version of pint will read and interpret
rem this.
rem
cat pintm.p5 standard_tests\iso7185pat.p5 > tmp.p5
del pintm.p5
ren tmp.p5 pintm.p5
rem
rem Create null input file
rem
echo.>pintm.inp
rem
rem Now run pint on pint, which runs the PAT.
rem
echo Running pint on itself, to run the ISO 7185 PAT
call run pintm
copy pintm.lst standard_tests\iso7185pats.lst > temp
del temp
echo Comparing PAT result to reference
call diffnole standard_tests\iso7185pats.lst standard_tests\iso7185pats.cmp > standard_tests\iso7185pats.dif
rem
rem Show the file, so if the length is zero, it compared ok.
rem
echo Resulting diff file length should be zero for pass
dir standard_tests\iso7185pats.dif

Added bin/diffnole.

























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
#!/bin/bash
#
# Difference without line endings
#
# Same as diff, but ignores the DOS/Unix line ending differences.
#

if [ -z "$1" ]
then

   echo "*** Error: Missing parameter 1"
   echo "*** s/b \"diffnole <file1> <file2>\""
   exit 1

fi

if [ ! -f $1 ]
then
   echo "*** Error: Missing $1 file"
   exit 1
fi

if [ -z "$2" ]
then

   echo "*** Error: Missing parameter 2"
   echo "*** s/b \"diffnole <file1> <file2>\""
   exit 1

fi

if [ ! -f $2 ]
then
   echo "*** Error: Missing $2 file"
   exit 1
fi

cp $1 tmp1
cp $2 tmp2
flip -u -b tmp1
flip -u -b tmp2
diff tmp1 tmp2
rm tmp1
rm tmp2

Added bin/diffnole.bat.

























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
@echo off
rem
rem Difference without line endings
rem
rem Same as diff, but ignores the DOS/Unix line ending differences.
rem

if "%1" == "" (

    echo *** Error: Missing parameter 1
    echo "*** s/b \"diffnole \<file1> \<file2>\""
    exit /b 1

)

if not exist "%1" (

    echo *** Error: Missing %1 file
    exit /b 1

)

if "%2"=="" (

    echo *** Error: Missing parameter 2
    echo "*** s/b \"diffnole \<file1> \<file2>\""
    exit /b 1

)

if not exist "%2" (

    echo *** Error: Missing %2 file
    exit /b 1

)

cp %1 %1.tmp
cp %2 %2.tmp
flip -d -b %1.tmp
flip -d -b %2.tmp
diff %1.tmp %2.tmp
rm -f %1.tmp
rm -f %2.tmp

Added bin/doseol.













































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
#!/bin/bash
#
# Change all line endings to Unix mode
#
echo
echo Fixing the line endings on Unix files
echo
flip -u source/*.pas

flip -u sample_programs/*.pas
flip -u sample_programs/*.cmp
flip -u sample_programs/*.inp

flip -u standard_tests/*.pas
flip -u standard_tests/*.cmp
flip -u standard_tests/*.inp

flip -m p2/*.pas
flip -m p2/*.cmp

flip -m p4/*.pas
flip -m p4/*.cmp

Added bin/doseol.bat.













































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
@echo off
rem
rem Change all line endings to DOS mode
rem
echo.
echo Fixing the line endings on DOS files
echo.
flip -m source/*.pas

flip -m sample_programs/*.pas
flip -m sample_programs/*.cmp
flip -m sample_programs/*.inp

flip -m standard_tests/*.pas
flip -m standard_tests/*.cmp
flip -m standard_tests/*.inp

flip -m p2/*.pas
flip -m p2/*.cmp

flip -m p4/*.pas
flip -m p4/*.cmp

Added bin/fixeol.













































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
#!/bin/bash
#
# Fix line ending on bash scripts
#
echo
echo Fixing the line endings on Unix files
echo
flip -u bin\build
flip -u bin\clean
flip -u bin\compile
flip -u bin\configure
flip -u bin\cpcom
flip -u bin\cpcoms
flip -u bin\cpint
flip -u bin\cpints
flip -u bin\diffnole
flip -u bin\doseol
flip -u bin\fixeol
flip -u bin\make_flip
flip -u bin\p5
flip -u bin\regress
flip -u bin\run
flip -u bin\testpascals
flip -u bin\testprog
flip -u bin\unixeol
flip -u bin\zipp5
flip -u gpc/compile
flip -u gpc/cpcom
flip -u gpc/cpint
flip -u gpc/p5
flip -u gpc/run
flip -u ip_pascal/compile
flip -u bin\ip_pascal/cpcom
flip -u bin\ip_pascal/cpint
flip -u bin\ip_pascal/p5
flip -u bin\ip_pascal/run
flip -u bin\make_flip
echo
echo Fixing the line endings on DOS/Windows files
echo
flip -m bin\build.bat
flip -m bin\clean.bat
flip -m bin\compile.bat
flip -m bin\configure.bat
flip -m bin\cpcom.bat
flip -m bin\cpcoms.bat
flip -m bin\cpint.bat
flip -m bin\cpints.bat
flip -m bin\diffnole.bat
flip -m bin\doseol.bat
# flip -m bin\fixeol.bat
flip -m bin\make_flip.bat
flip -m bin\p5.bat
flip -m bin\prtprt.bat
flip -m bin\regress.bat
flip -m bin\run.bat
flip -m bin\testpascals.bat
flip -m bin\testprog.bat
flip -m bin\unixeol.bat
flip -m bin\zipp5.bat
flip -m gpc/compile.bat
flip -m gpc/cpcom.bat
flip -m gpc/cpint.bat
flip -m gpc/p5.bat
flip -m gpc/run.bat
flip -m ip_pascal/compile.bat
flip -m ip_pascal/cpcom.bat
flip -m ip_pascal/cpint.bat
flip -m ip_pascal/p5.bat
flip -m ip_pascal/run.bat

Added bin/fixeol.bat.











































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
rem
rem Fix line ending on bash scripts
rem
echo.
echo Fixing the line endings on Unix files
echo.
flip -u bin\build
flip -u bin\clean
flip -u bin\compile
flip -u bin\configure
flip -u bin\cpcom
flip -u bin\cpcoms
flip -u bin\cpint
flip -u bin\cpints
flip -u bin\diffnole
flip -u bin\doseol
flip -u bin\fixeol
flip -u bin\make_flip
flip -u bin\p5
flip -u bin\regress
flip -u bin\run
flip -u bin\testpascals
flip -u bin\testprog
flip -u bin\unixeol
flip -u bin\zipp5
flip -u gpc/compile
flip -u gpc/cpcom
flip -u gpc/cpint
flip -u gpc/p5
flip -u gpc/run
flip -u ip_pascal/compile
flip -u ip_pascal/cpcom
flip -u ip_pascal/cpint
flip -u ip_pascal/p5
flip -u ip_pascal/run
flip -u make_flip
echo.
echo Fixing the line endings on DOS/Windows files
echo.
flip -m bin\build.bat
flip -m bin\clean.bat
flip -m bin\compile.bat
flip -m bin\configure.bat
flip -m bin\cpcom.bat
flip -m bin\cpcoms.bat
flip -m bin\cpint.bat
flip -m bin\cpints.bat
flip -m bin\diffnole.bat
flip -m bin\doseol.bat
rem flip -m     bin\fixeol.bat
flip -m bin\make_flip.bat
flip -m bin\p5.bat
flip -m bin\prtprt.bat
flip -m bin\regress.bat
flip -m bin\run.bat
flip -m bin\testpascals.bat
flip -m bin\testprog.bat
flip -m bin\unixeol.bat
flip -m bin\zipp5.bat
flip -m gpc/compile.bat
flip -m gpc/cpcom.bat
flip -m gpc/cpint.bat
flip -m gpc/p5.bat
flip -m gpc/run.bat
flip -m ip_pascal/compile.bat
flip -m ip_pascal/cpcom.bat
flip -m ip_pascal/cpint.bat
flip -m ip_pascal/p5.bat
flip -m ip_pascal/run.bat

Added bin/flip.exe.

cannot compute difference between binary files

Added bin/make_flip.

















>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
#!/bin/bash
#
# Create flip utility
#
echo
echo Compiling and creating flip script
echo
gcc -o flip flip.c

Added bin/make_flip.bat.

















>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
@echo off
rem
rem Create flip utility
rem
echo.
echo Compiling and creating flip script
echo.
gcc -o bin\flip c_support\flip.c

Added bin/p5.























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#!/bin/bash
#
# Compile with P5 using GPC Pascal
#
# Execute with:
#
# p5 <file>
#
# Where <file> is the name of the source file without
# extention. The Pascal file is compiled and run.
# Any compiler errors are output to the screen. Input
# and output to and from the running program are from
# the console, but output to the prr file is placed
# in <file>.out.
# The intermediate code is placed in <file>.p5.
#

if [ -z "$1" ]
then

   echo "*** Error: Missing parameter"
   exit 1

fi

if [ ! -f $1.pas ]
then

   echo "*** Error: Missing $1.pas file"
   exit 1

fi

echo
echo Compiling and running $1
echo
cp $1.pas prd
pcom < $1.pas
mv prr $1.p5
cp $1.p5 prd
pint
rm prd
rm prr

Added bin/p5.bat.













































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
@echo off
rem
rem Compile with P5 using GPC
rem
rem Execute with:
rem
rem p5 <sourcefile> [<inputfile>[<outputfile>]]
rem
rem where <sourcefile> is the name of the source file without
rem extention. The Pascal file is compiled and run.
rem Any compiler errors are output to the screen. Input
rem and output to and from the running program are from
rem the console, but output to the prr file is placed
rem in <sourcefile>.out.
rem
rem The intermediate code is placed in <file>.p5.
rem
rem If <inputfile> and <outputfile> are specified, then these will be
rem placed as input to the "prd" file, and output from the "prr" file.
rem Note that the prd file cannot or should not be reset, since that
rem would cause it to back up to the start of the intermediate code.
rem
if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop
:paramok
if exist "%1.pas" goto fileexists
echo *** Error: Missing %1.pas file
goto stop
:fileexists
if "%2"=="" goto continue
if exist "%2" goto continue
echo *** Error: Missing %2 input file
goto stop
:continue
echo.
echo Compiling and running %1
echo.
cp %1.pas prd
pcom
mv prr %1.p5
if not "%2"=="" goto useinputfile
cp %1.p5 prd
goto run
:useinputfile
rem The input file, if it exists, gets put on the end of the intermediate
cat %1.p5 %2 > prd
:run
pint
if "%3"=="" goto stop
cp %prr %3
:stop
rm -f prd
rm -f prr

Added bin/pcom.exe.

cannot compute difference between binary files

Added bin/pint.exe.

cannot compute difference between binary files

Added bin/regress.





















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
#!/bin/bash
#
# Regression test
#
# Run the compiler through a few typical programs
# to a "gold" standard file
#
testprog sample_programs/hello
testprog sample_programs/roman
testprog sample_programs/match
testprog sample_programs/startrek
testprog sample_programs/basics
#
# Now run the ISO7185pat compliance test
#
testprog standard_tests/iso7185pat
if [ "$1" = "full" ]; then
	#
	# Run pcom self compile (note this runs on P5 only)
	#
	cpcoms
	#
	# Run pint self compile (note this runs on P5 only)
	#
	cpints
fi

Added bin/regress.bat.









































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
@echo off
rem
rem Regression test
rem
rem Run the compiler through a few typical programs
rem to a "gold" standard file
rem
call testprog sample_programs\hello
call testprog sample_programs\roman
call testprog sample_programs\match
call testprog sample_programs\startrek
call testprog sample_programs\basics
call testprog sample_programs\drystone
call testprog sample_programs\fbench
call testprog sample_programs\prime
call testprog sample_programs\qsort
rem
rem Now run the ISO7185pat compliance test
rem
call testprog standard_tests\iso7185pat
rem
rem Run previous versions of the system and Pascal-S
rem
call testpascals
call testp2
call testp4
if not "%1"=="full" exit /b
echo Running self compile...
rem
rem Run pcom self compile (note this runs on P5 only)
rem
call cpcoms
rem
rem Run pint self compile (note this runs on P5 only)
rem
call cpints

Added bin/repo_ready.





















>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
#!/bin/bash
#
# Make p5 ready for GIT
#
# This script fixes up the GIT directories to the form that GIT
# expects. This minimizes the differences between the P5 directories
# and the GIT repository in preparation for checkins.
#
./configure --gpc --64
make clean

Added bin/repo_ready.bat.





















>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
@echo off
rem
rem Make p5 ready for GIT
rem
rem This script fixes up the GIT directories to the form that GIT
rem expects. This minimizes the differences between the P5 directories
rem and the GIT repository in preparation for checkins.
rem
call configure --gpc --64
make clean

Added bin/run.





















































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
#!/bin/bash
#
# Run a Pascal file in batch mode using GPC Pascal
#
# Runs a Pascal intermediate in batch mode.
#
# Execution:
#
# run <file>
#
# <file> is the filename without extention.
#
# The files are:
#
# <file>.p5  - The intermediate file
# <file>.out - The prr file produced
# <file>.inp - The input file to the program
# <file>.lst - The output file from the program
#

if [ -z "$1" ]
then
   echo "*** Error: Missing parameter"
   exit 1
fi

if [ ! -f $1.p5 ]
then
   echo "*** Error: Missing $1.p5 file"
   exit 1
fi

if [ ! -f $1.inp ]
then
   echo "*** Error: Missing $1.inp file"
   exit 1
fi

cp $1.p5 prd 
pint < $1.inp &> $1.lst
rm -f $1
mv prd $1.out

Added bin/run.bat.





























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
@echo off
rem
rem Run a Pascal file in batch mode using GPC Pascal
rem
rem Runs a Pascal intermediate in batch mode.
rem
rem Execution:
rem
rem run <file>
rem
rem <file> is the filename without extention.
rem
rem The files are:
rem
rem <file>.p5  - The intermediate file
rem <file>.out - The prr file produced
rem <file>.inp - The input file to the program
rem <file>.lst - The output file from the program
rem

if "%1"=="" (

    echo *** Error: Missing parameter
    exit /b 1

)

if not exist "%1.p5" (

    echo *** Error: Missing %1.p5 file
    exit /b 1

)

if not exist "%1.inp" (

    echo *** Error: Missing %1.inp file
    exit /b 1

)

cp %1.p5 prd
pint < %1.inp > %1.lst 2>&1
if exist "%1" rm %1.out
mv prr %1.out
chmod +w %1.out

Added bin/runprt.bat.































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
@echo off
rem
rem Run rejection tests
rem
rem The rejection tests use the same format as the acceptance tests, but there
rem is no positive go/no go indication for them. Each test should generate a
rem failure, and all you can say is that the test has failed if there were no
rem error(s).
rem
rem This file is GPC specific.
rem
rem Run the tests
rem
echo Running tests
set List=standard_tests\iso7185prt*.pas
for /f "delims=" %%a in ('dir /b "%List%"') do (

    call testprog standard_tests\%%~na

)

echo Creating combined listing
echo *******************************************************************************> standard_tests\iso7185prt.lst
echo.>> standard_tests\iso7185prt.lst
echo Pascal Rejection test run for iso7185prt >> standard_tests\iso7185prt.lst
echo.>> standard_tests\iso7185prt.lst
echo *******************************************************************************>> standard_tests\iso7185prt.lst
rem
rem Make a list of files WITHOUT compile errors
rem
echo Creating error accounting listings
grep -l "Errors in program: 0" standard_tests/iso7185prt*.err > standard_tests/iso7185prt.nocerr
rem
rem Make a list of files WITHOUT runtime errors. This is GPC specific.
rem
grep -L "pint:\|\*\*\*" standard_tests/iso7185prt*.lst > standard_tests/iso7185prt.norerr
rem
rem Find files with NO errors either at compile time or runtime. This is done
rem by concatenating the files, sorting and finding duplicate filenames. That
rem is, if the filename list in both the no compile error and no runtime error
rem lists, then no error at all occurred on the file and it needs to be looked
rem at.
rem
cat standard_tests/iso7185prt.nocerr standard_tests/iso7185prt.norerr > temp
sort temp | uniq -d -w 30 > standard_tests/iso7185prt.noerr
rem
rem Place in combined listing as report
rem
echo.>> standard_tests\iso7185prt.lst
echo Tests for which no compile or runtime error was flagged: **********************>> standard_tests\iso7185prt.lst
echo.>> standard_tests\iso7185prt.lst
type standard_tests\iso7185prt.noerr >> standard_tests\iso7185prt.lst

rem
rem Make a listing of compiler output difference files to look at. If you are
rem satisfied with each of the prt output runs, then you can copy the .err file
rem to the .ecp file and get a 0 dif length file. Then this file will show you
rem the files that don't converge. Note DIFFERENT DOES NOT MEAN *** WRONG ***.
rem It simply may mean the error handling has changed. The purpose of diffing
rem the output files is that it allows you to check that simple changes have
rem not broken anything.
rem
echo creating compile time difference list
set List=standard_tests\iso7185prt*.err
for /f "delims=" %%a in ('dir /b "%List%"') do (

    call diffnole standard_tests\%%~na.err standard_tests\%%~na.ecp > standard_tests\%%~na.ecd

)
dir standard_tests\iso7185prt*.ecd > standard_tests/iso7185prt.ecdlst
rem
rem Place in combined listing
rem
echo.>> standard_tests\iso7185prt.lst
echo Compile output differences: **********************>> standard_tests\iso7185prt.lst
echo.>> standard_tests\iso7185prt.lst
type standard_tests\iso7185prt.ecdlst >> standard_tests\iso7185prt.lst

rem
rem Make a listing of run output difference files to look at. If you are satisfied
rem with each of the prt output runs, then you can copy the .lst file to the .cmp
rem file and get a 0 dif length file. Then this file will show you the files that
rem don't converge. Note DIFFERENT DOES NOT MEAN *** WRONG ***. It simply may
rem mean the error handling has changed. The purpose of diffing the output files
rem is that it allows you to check that simple changes have not broken anything.
rem
echo creating runtime difference list
dir standard_tests\iso7185prt*.dif > standard_tests/iso7185prt.diflst
rem
rem Place in combined listing
rem
echo.>> standard_tests\iso7185prt.lst
echo Run output differences: **********************>> standard_tests\iso7185prt.lst
echo.>> standard_tests\iso7185prt.lst
type standard_tests\iso7185prt.diflst >> standard_tests\iso7185prt.lst

rem
rem Add individual program compiles and runs
rem
echo Adding program compile and runs
echo.>> standard_tests\iso7185prt.lst
echo *******************************************************************************>> standard_tests\iso7185prt.lst
echo.>> standard_tests\iso7185prt.lst
echo Listings for compile and run of iso7185prt >> standard_tests\iso7185prt.lst
echo.>> standard_tests\iso7185prt.lst
echo *******************************************************************************>> standard_tests\iso7185prt.lst
set List=standard_tests\iso7185prt*.pas
for /f "delims=" %%a in ('dir /b "%List%"') do (

    echo.>> standard_tests\iso7185prt.lst
    echo Listing for standard_tests\%%~na *************************************>> standard_tests\iso7185prt.lst
    echo.>> standard_tests\iso7185prt.lst
    echo Compile: >> standard_tests\iso7185prt.lst
    echo.>> standard_tests\iso7185prt.lst
    type standard_tests\%%~na.err >> standard_tests\iso7185prt.lst
    echo.>> standard_tests\iso7185prt.lst
    if exist "standard_tests\%%~na.lst" (

        echo Run: >> standard_tests\iso7185prt.lst
        echo.>> standard_tests\iso7185prt.lst
        type standard_tests\%%~na.lst >> standard_tests\iso7185prt.lst

    )


)

Added bin/set32.





































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#!/bin/bash

#
# Convert pcom and pint to 64 bit definitions
#
function replace {

    sed "s/$1\(\s*\)=\(\s*\){\([0-9][0-9]*\)}\(\s*\)\([0-9][0-9]*\)/$1\1=\2\3\4{\5}/" <  $2 > temp
    cp temp $2

}

function replaceinfile {

    replace intsize $1
    replace intdig $1
    replace inthex $1
    replace ptrsize $1
    replace adrsize $1
    replace stackelsize $1
    replace marksize $1
    replace begincode $1
    replace markfv $1
    replace marksl $1
    replace markdl $1
    replace markep $1
    replace marksb $1
    replace market $1
    replace markra $1

}

replaceinfile source/pcom.pas
replaceinfile source/pint.pas

Added bin/set32.bat.













































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
@echo off
rem
rem Convert pcom and pint to 32 bit definitions
rem

call :replaceinfile source\pcom.pas
call :replaceinfile source\pint.pas

exit /b

: replaceinfile

rem echo Will execute: replaceinfile %1
    call :replace intsize %1
    call :replace intdig %1
    call :replace inthex %1
    call :replace ptrsize %1
    call :replace adrsize %1
    call :replace stackelsize %1
    call :replace marksize %1
    call :replace begincode %1
    call :replace markfv %1
    call :replace marksl %1
    call :replace markdl %1
    call :replace markep %1
    call :replace marksb %1
    call :replace market %1
    call :replace markra %1

exit /b

:replace

rem echo Will execute: replace %1 %2
    sed "s/%1\(\s*\)=\(\s*\){\([0-9][0-9]*\)}\(\s*\)\([0-9][0-9]*\)/%1\1=\2\3\4{\5}/" < %2 > temp
    cp temp %2

exit /b

Added bin/set64.









































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
#!/bin/bash

#
# Convert pcom and pint to 64 bit definitions
#
function replace {

    sed "s/$1\(\s*\)=\(\s*\)\([0-9][0-9]*\)\(\s*\){\([0-9][0-9]*\)}/$1\1=\2{\3}\4\5/" <  $2 > temp
    cp temp $2

}

function replaceinfile {

    replace intsize $1
    replace intdig $1
    replace inthex $1
    replace ptrsize $1
    replace adrsize $1
    replace stackelsize $1
    replace marksize $1
    replace begincode $1
    replace markfv $1
    replace marksl $1
    replace markdl $1
    replace markep $1
    replace marksb $1
    replace market $1
    replace markra $1

}

replaceinfile source/pcom.pas
replaceinfile source/pint.pas


Added bin/set64.bat.















































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
@echo off
rem
rem Convert pcom and pint to 32 bit definitions
rem

call :replaceinfile source\pcom.pas
call :replaceinfile source\pint.pas

exit /b

: replaceinfile

rem echo Will execute: replaceinfile %1
    call :replace intsize %1
    call :replace intdig %1
    call :replace inthex %1
    call :replace ptrsize %1
    call :replace adrsize %1
    call :replace stackelsize %1
    call :replace marksize %1
    call :replace begincode %1
    call :replace markfv %1
    call :replace marksl %1
    call :replace markdl %1
    call :replace markep %1
    call :replace marksb %1
    call :replace market %1
    call :replace markra %1

exit /b

:replace

rem echo Will execute: replace %1 %2

    sed "s/%1\(\s*\)=\(\s*\)\([0-9][0-9]*\)\(\s*\){\([0-9][0-9]*\)}/%1\1=\2{\3}\4\5/" < %2 > temp
    cp temp %2

exit /b

Added bin/setok.bat.























>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
@echo off
rem
rem Set prt test as passed. Copies the compiler and run outputs to
rem the compare files.
rem
cp standard_tests/iso7185prt%1.err standard_tests/iso7185prt%1.ecp
if exist "standard_tests/iso7185prt%1.lst" (

    cp standard_tests/iso7185prt%1.lst standard_tests/iso7185prt%1.cmp

)

Added bin/testp2.bat.



























































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
@echo off
rem
rem Script to test p2 compile and run
rem
rem Compile p2
rem
echo Compling pcomp to intermediate code
call compile p2\pcomp
type p2\pcomp.err
rem
rem Copy the test file to the input file and compile it via interpreted p2
rem
cp p2\roman.pas p2\pcomp.inp
call run p2\pcomp
cat p2\pcomp.lst
rem
rem For neatness sake, copy out the intermediate to .p2 file
rem
cp p2\pcomp.out p2\roman.p2
rem
rem Compile pasint
rem
echo Compiling pasint to intermediate code
call compile p2\pasint
rem
rem Add the final target program to the end of pasint.
rem This means that the version of pint will read and interpret
rem this.
rem
rem For those of you having fun reading this, yes, the next statement accurately
rem describes what is going on: we are concatenating and running two different
rem intermediate codes together in completely different formats!
rem
cat p2\pasint.p5 p2\roman.p2 > tmp.p5
rm p2\pasint.p5
mv tmp.p5 p2\pasint.p5
rem
rem Create null input file
rem
echo.>p2\pasint.inp
rem
rem Now run pasint on pint, which runs the test program.
rem
echo Running pasint on pint to execute test program
call run p2\pasint
rem
rem Copy the result listing back to roman.lst, again for neatness
rem
cp p2\pasint.lst p2\roman.lst
rem
rem Now compare with reference
rem
echo Comparing PAT result to reference
call diffnole p2\roman.lst p2\roman.cmp > p2\roman.dif
rem
rem Show the file, so if the length is zero, it compared ok.
rem
echo Resulting diff file length should be zero for pass
dir p2\roman.dif
del p2\pcomp.inp
del p2\pasint.inp

Added bin/testp4.bat.



























































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
@echo off
rem
rem Script to test p4 compile and run
rem
rem Compile p4
rem
echo Compling pcom to intermediate code
call compile p4\pcom
cat p4\pcom.err
rem
rem Copy the test file to the input file and compile it via interpreted p4
rem
cp p4\standardp.pas p4\pcom.inp
call run p4\pcom
cat p4\pcom.lst
rem
rem For neatness sake, copy out the intermediate to .p4 file
rem
cp p4\pcom.out p4\standardp.p4
rem
rem Compile pint
rem
echo Compiling pint to intermediate code
call compile p4\pint
rem
rem Add the final target program to the end of pint.
rem This means that the version of pint will read and interpret
rem this.
rem
rem For those of you having fun reading this, yes, the next statement accurately
rem describes what is going on: we are concatenating and running two different
rem intermediate codes together in completely different formats!
rem
cat p4\pint.p5 p4\standardp.p4 > tmp.p5
del p4\pint.p5
cp tmp.p5 p4\pint.p5
rem
rem Create null input file
rem
echo.>p4\pint.inp
rem
rem Now run pint(p4) on pint(p5), which runs the test program.
rem
echo Running pint(p4) on pint(p5) to execute test program
call run p4\pint
rem
rem Copy the result listing back to standardp.lst, again for neatness
rem
cp p4\pint.lst p4\standardp.lst
rem
rem Now compare with reference
rem
echo Comparing PAT result to reference
call diffnole p4\standardp.lst p4\standardp.cmp > p4\standardp.dif
rem
rem Show the file, so if the length is zero, it compared ok.
rem
echo Resulting diff file length should be zero for pass
dir p4\standardp.dif
del p4\pcom.inp
del p4\pint.inp

Added bin/testpascals.























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
#!/bin/bash
#
# Script to test pascals
#
# Compile pascals
#
compile sample_programs/pascals
#
# Prepare a prd deck that has the pascals intermediate first, followed by the
# program to run.
#
cat sample_programs/pascals.p5 sample_programs/roman.pas > sample_programs/tmp.p5
rm sample_programs/pascals.p5
cp sample_programs/tmp.p5 sample_programs/pascals.p5 > tmp
rm sample_programs/tmp.p5
#
# Run that
#
run sample_programs/pascals
#
# Compare to reference
call diffnole sample_programs/pascals.lst sample_programs/pascals.cmp > sample_programs/pascals.dif
#
# Show the file, so if the length is zero, it compared ok.
#
echo Resulting diff file length should be zero for pass
ls -l sample_programs/pascals.dif

Added bin/testpascals.bat.























































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
@echo off
rem
rem Script to test pascals
rem
rem Compile pascals
rem
call compile sample_programs\pascals
rem
rem Prepare a prd deck that has the pascals intermediate first, followed by the
rem program to run.
rem
cat sample_programs\pascals.p5 sample_programs\roman.pas > sample_programs\tmp.p5
rm sample_programs\pascals.p5
cp sample_programs\tmp.p5 sample_programs\pascals.p5
rm sample_programs\tmp.p5
rem
rem Run that
rem
call run sample_programs\pascals
rem
rem Compare to reference
call diffnole sample_programs\pascals.lst sample_programs\pascals.cmp > sample_programs\pascals.dif
rem
rem Show the file, so if the length is zero, it compared ok.
rem
echo Resulting diff file length should be zero for pass
dir sample_programs\pascals.dif

Added bin/testprog.





































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
#!/bin/bash
#
# Test a single program run
#
# Tests the compile and run of a single program.
#
# To do this, there must be the files:
#
# <file>.inp - Contains all input to the program
# <file>.cmp - Used to compare the <file>.lst program to, should
#              contain an older, fully checked version of <file>.lst.
#
# <file>.dif will contain the differences in output of the run.
#

if [ -z "$1" ]
then

   echo "*** Error: Missing parameter"
   echo "*** s/b \"testprog <file>\""
   exit 1

fi

if [ ! -f $1.pas ]
then

   echo "*** Error: Source file $1.pas does not exist"
   exit 1

fi

if [ ! -f $1.inp ]
then

   echo "*** Error: Input file $1.inp does not exist"
   exit 1

fi

if [ ! -f $1.cmp ]
then

   echo "*** Error: Compare file $1.cmp does not exist"
   exit 1

fi

echo -n "Compiling $1 ... "
compile $1
rc=$?
if [[ $rc = 0 ]]
then

    echo -n "running ... "; run $1
    echo -n "checking ... "; diffnole $1.lst $1.cmp > $1.dif

    ## pass if diff file is empty
    if test -s "$1.dif"; then
       echo FAIL
    else
       echo PASS
    fi
else
    echo FAIL
fi

Added bin/testprog.bat.





















































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
@echo off
rem
rem Test a single program run
rem
rem Tests the compile and run of a single program.
rem
rem To do this, there must be the files:
rem
rem <file>.inp - Contains all input to the program
rem <file>.cmp - Used to compare the <file>.lst program to, should
rem              contain an older, fully checked version of <file>.lst.
rem
rem <file>.dif will contain the differences in output of the run.
rem

rem
rem Check there is a parameter
rem
if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop
:paramok

rem
rem Check the source file exists
rem
if exist %1.pas goto :sourcefileexist
echo *** Error: Source file %1.pas does not exist
goto stop
:sourcefileexist

rem
rem Check the input file exists
rem
if exist %1.inp goto :inputfileexist
echo *** Error: Input file %1.inp does not exist
goto stop
:inputfileexist

rem
rem Check the result compile file exists
rem
if exist %1.cmp goto :comparefileexist
echo *** Error: Compare file %1.cmp does not exist
goto stop
:comparefileexist

rem
rem Compile and run the program
rem
echo Compile and run %1
call compile %1
rem echo Error return after compile: %errorlevel%
rem
rem Proceed to run and compare only if compile suceeded
rem
if not errorlevel 1 (

    call run %1

    rem
    rem Check output matches the compare file
    rem
    call diffnole %1.lst %1.cmp > %1.dif
    dir %1.dif > %1.tmp
    grep ".dif" %1.tmp
    rm -f %1.tmp

)

rem
rem Terminate program
rem
:stop

Added bin/unixeol.













































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
#!/bin/bash
#
# Change all line endings to Unix mode
#
echo
echo Fixing the line endings on Unix files
echo
flip -u source/*.pas

flip -u sample_programs/*.pas
flip -u sample_programs/*.cmp
flip -u sample_programs/*.inp

flip -u standard_tests/*.pas
flip -u standard_tests/*.cmp
flip -u standard_tests/*.inp

flip -u p2/*.pas
flip -u p2/*.cmp

flip -u p4/*.pas
flip -u p4/*.cmp

Added bin/unixeol.bat.













































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
@echo off
rem
rem Change all line endings to Unix mode
rem
echo.
echo Fixing the line endings on Unix files
echo.
flip -u source/*.pas

flip -u sample_programs/*.pas
flip -u sample_programs/*.cmp
flip -u sample_programs/*.inp

flip -u standard_tests/*.pas
flip -u standard_tests/*.cmp
flip -u standard_tests/*.inp

flip -u p2/*.pas
flip -u p2/*.cmp

flip -u p4/*.pas
flip -u p4/*.cmp

Added bin/zipp5.











>
>
>
>
>
1
2
3
4
5
#!/bin/bash
#
# Make Zip archive of this directory
#
zip -r p5.zip *

Added bin/zipp5.bat.











>
>
>
>
>
1
2
3
4
5
@echo off
rem
rem Make Zip archive of this directory
rem
zip -r p5.zip *

Added c_support/flip.c.





































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
/*******************************************************************************
*
*                 CONVERT LINE ENDINGS BETWEEN UNIX AND DOS
*
* Converts line endings from dos format to Unix, or Unix to dos.
*
* Format:
*
* flip [-udbc] [file] ...
*
* The options are:
*
*    u     Generate Unix mode line endings.
*    d,m   Generate DOS mode line endings.
*    b     Force convertion on binary file (default is do not convert).
*    c     Send output to standard output instead of converting in place.
*
* This is the same utilitiy that comes with several versions of Unix.
*
* Note that we use a universal line ending recognizer, that sees any of the
* following line endings as valid:
*
* crlf
* lfcr
* cf
* lf
*
* Thus, it will convert anything to the desired line ending, and is a no-op
* if the file is already in that format.
*
* This is the WAY LINE ENDINGS SHOULD BE RECOGNIZED IN *** ANY *** PROGRAM.
* Copy this code and USE IT. Type your input files binary and provide your OWN
* line ending recognizer instead of the braindead one standard with libc.
* Think for yourself, use the force. Peace.
*
* Unlike the original flip utility there is no automatic sensing of system type.
* It defaults to Unix line endings. The lesson here is don't use the default.
*
*******************************************************************************/

#include <stdio.h>
#include <stdlib.h>

main(int argc, char *argv[])

{

    int c;
    int lf = 0;
    int cr = 0;
    FILE *sfp, *dfp;
    /* options */    
    int unixmode;
    int forcebin;
    int pstdout;
    char *cp;

    unixmode = 1; /* set default is unix mode */
    forcebin = 0; /* do not force convertion of bin file */
    pstdout = 0; /* do not send to standard output */

    /* process all present files */
    while (--argc > 0) {

        if (argv[1][0] == '-') { /* there are options */

            cp = &argv[1][1]; /* index 1st option character */
            while (*cp) { /* not end */

                if (*cp == 'd' || *cp == 'm') unixmode = 0; /* set dos mode */
                else if (*cp == 'u') unixmode = 1; /* set unix mode */
                else if (*cp == 'b') forcebin = 1; /* set force convert binary */
                else if (*cp == 'c') pstdout = 1; /* send to stdout */
                else { /* bad option */

                    printf("Bad option character %c\n", *cp);
                    exit(1);

                }
                cp++; /* next character */

            }
            ++argv; /* next argument */
            goto skip; /* skip to next */

        }
        if ((sfp = fopen(*++argv, "rb")) == NULL) {

            printf("flip: Can't open %s\n", *argv);
            exit(1);

        }
        if (pstdout) dfp = stdout; /* send to standard output */
        else if ((dfp = fopen("flip_temp", "wb")) == NULL) {

            printf("flip: Can't open output file\n", *argv);
            exit(1);

        }
        /* copy contents and fix line endings to temp file */
        while ((c = getc(sfp)) != EOF) {
        
            if (c == '\n') {
        
                if (cr) {
        
                    /* Last was lf, this is cr, ignore */
                    cr = 0;
                    lf = 0;
        
                } else {
        
                    /* output newline and flag last */
                    if (unixmode) fprintf(dfp, "\n");
                    else fprintf(dfp, "\r\n");
                    lf = 1;
        
                }
        
             } else if (c == '\r') {
        
                if (lf) {
        
                    /* last was cr, this is lf, ignore */
                    cr = 0;
                    lf = 0;
                  
                } else {
        
                    /* output newline and flag last */
                    if (unixmode) fprintf(dfp, "\n");
                    else fprintf(dfp, "\r\n");
                    cr = 1;
        
                }
        
            } else {
        
                /* Check binary character. We also check for common control 
                   characters (characters under space). The idea of this check
                   is that if the command is executed on too wide a swath
                   (like *), that it won't convert any binary files in the 
                   directory. */
                if ((c > 0x7f || (c < ' ' && c != '\t' && c != '\v' && 
                                 c != '\b' && c != '\f' && c != '\a')) && !forcebin) {

                    printf("File %s is binary, skipping\n", *argv);
                    fclose(sfp); // close input file
                    fclose(dfp); // close output file
                    remove("flip_temp"); // remove temp file
                    goto skip; // skip to next file

                }
                /* output normal character */
                putc(c, dfp);
                cr = 0;
                lf = 0;
        
            }
        
        }
        /* close files and rename destination to source */
        fclose(sfp); /* close input file */
        if (!pstdout)  { /* didn't print to stdout */

            fclose(dfp); /* close output file */
            if (remove(*argv)) { /* delete original */

                printf("Cannot remove file %s\n", *argv);
                exit(1);

            }
            if (rename("flip_temp", *argv)) { /* rename temp to final */

                printf("Cannot rename flip_temp to %s\n", *argv);
                exit(1);

            }

        }
        skip: ; // skip to next file
        
    }

}
            
            
            
            
            
            
            
            
            

Changes to configure.

1

2


























3


4
5
6






































































7
8
9


10

11
12

13
14
15
16













17









18









19



20
21







22
23
24
25
26

27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43





44
45
46
47
48
49

50
51
52
53
54
55

56
57
58
59
60
61


62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

83
84
85


















#!/bin/bash

#


























# Set up compiler to use.


#
# Presently implements:
#






































































# IP Pascal, named "ip_pascal"
#
# GPC Pascal, named "GPC" (or "gpc")


#


if [ -z "$1" ]

then

   echo "*** Error: Missing parameter"
   echo "*** Must be \"ip_pascal\" or \"gpc\""













   exit 1



















fi




if [ $1 = "ip_pascal" ]







then

   #
   # Set up for IP Pascal
   #

   cp ip_pascal/p5.bat      p5.bat
   cp ip_pascal/compile.bat compile.bat
   cp ip_pascal/run.bat     run.bat
   cp ip_pascal/cpcom.bat   cpcom.bat
   cp ip_pascal/cpint.bat   cpint.bat

   cp ip_pascal/p5          p5
   cp ip_pascal/compile     compile
   cp ip_pascal/run         run

   cp ip_pascal/cpcom       cpcom
   cp ip_pascal/cpint       cpint

   cp ip_pascal/standard_tests/iso7185pat.cmp standard_tests
   cp ip_pascal/standard_tests/iso7185pats.cmp standard_tests

   echo Compiler set to IP Pascal






elif [ $1 = "gpc" ] || [ $1 = "GPC" ]
then 

   #
   # Set up for GPC Pascal
   #

   cp gpc/p5.bat      p5.bat
   cp gpc/compile.bat compile.bat
   cp gpc/run.bat     run.bat
   cp gpc/cpcom.bat   cpcom.bat
   cp gpc/cpint.bat   cpint.bat


   cp gpc/p5          p5
   cp gpc/compile     compile
   cp gpc/run         run
   cp gpc/cpcom       cpcom
   cp gpc/cpint       cpint



   cp gpc/standard_tests/iso7185pat.cmp standard_tests
   cp gpc/standard_tests/iso7185pats.cmp standard_tests

   #
   # GPC has been problematic for line endings. This changes them
   # all to Unix mode for GPC compiles, which at this moment is
   # all there is. GPC for Windows has serious problems.
   #
   unixeol

   echo Compiler set to GPC Pascal

else

   #
   # No compiler name found!
   #
   echo "*** Compiler name does not match currently implemented"
   echo "*** compilers"
   echo
   echo "IP Pascal  - use \"ip_pascal\""

   echo "GPC Pascal - use \"GPC\""

fi



















>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
|
<
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
<
>
>
|
>
|
<
>
|
|
<
<
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
|
>
>
>
|
<
>
>
>
>
>
>
>





>
|
|
|
<
<
|
|
|
|
>
|
<




<
|
>
>
>
>
>
|
|
|
|
|
|
>
|
|
|
<
<
|
>
|
|
|
<
<
|
>
>
|
|






|
<
<










>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

107
108
109
110
111

112
113
114


115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152

153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168


169
170
171
172
173
174

175
176
177
178

179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194


195
196
197
198
199


200
201
202
203
204
205
206
207
208
209
210
211


212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
#!/bin/bash
################################################################################
#
# Configure scipt for Pascal-P5
#
# Sets up the complete Pascal-P5 project.
#
################################################################################

#
# Check command exists
#
# Uses the bash "command" built in.
#
function checkexists {

    command -v $1 >/dev/null
    rc=$?
    if [[ $rc != 0 ]] ; then

        echo "*** No $1 was found"

    fi

}

#
# Set default variables
#
compiler="gpc"
bits="32"
host="linux"


#
# Determine if needed programs exist. The only fatal one is grep, because we
# need that to run this script. The rest will impact the running of various
# test and build scripts.
#
checkexists grep
if [[ $rc != 0 ]] ; then

    exit 1

fi

checkexists diff
checkexists sed
checkexists rm
checkexists cp
checkexists mv

checkexists flip > /dev/null

if [[ $rc != 0 ]] ; then

    echo -n "flip does not exist"
    echo $PATH | grep -q "$PWD/bin" || echo -n ", has PATH been set up?"
    echo
    echo "attempting to make it"
    gcc -o ./bin/flip ./c_support/flip.c
    checkexists flip > /dev/null
    flip=$rc
    if [[ $rc != 0 ]] ; then

        echo "*** Unable to make flip"

    fi

fi
checkexists ls
checkexists zip

#
# Check user arguments
#
for var in "$@"
do

    if [ $var = "--help" ]
    then

        echo "Configure program for Pascal-P5"
        echo
        echo "--gpc:       Select GPC as target compiler"
        echo "--p5c:       Select p5c as target compiler"
        echo "--ip_pascal: Select IP Pascal as target compiler"
        echo "--32:        Select 32 bit target"
        echo "--64:        Select 64 bit target"
        echo
        exit 0

    elif [ $var = "--gpc" ]
    then

        compiler="gpc"

    elif [ $var = "--p5c" ]
    then

        compiler="p5c"

    elif [ $var = "--ip_pascal" ]
    then

        compiler="ip_pascal"


    elif [ $var = "--32" ]
    then

        bits="32"


    elif [ $var = "--64" ]
    then



        bits="64"

    fi

done


if [ $compiler = "p5c" ]; then
    checkexists "$P5CDIR/$compiler" > /dev/null
    if [[ $rc != 0 ]] ; then
        echo "p5c not found - has environment variable P5CDIR been set?"
        compiler=""
        # fatal this for now
        exit 1
    fi
else
    checkexists $compiler
    if [[ $rc != 0 ]] ; then
        compiler=""
        # fatal this for now
        exit 1
    fi
fi


if [ $compiler = "gpc" ]
then    gpc -v 2> temp
    grep "gpc version 20070904" temp > /dev/null
    rc=$?
    if [[ $rc != 0 ]] ; then

        echo "*** Warning, Pascal-P5 is only validated to work with gpc version 20070904"

    fi
    grep "build=x86_64" temp > /dev/null
    rc=$?
    if [[ $rc == 0 ]] ; then


        bits="64"

    fi

fi

if [ $compiler = "ip_pascal" ] || [ $compiler = "IP_Pascal" ]
then

   #
   # Set up for IP Pascal
   #
   echo "Set up for IP Pascal"
   cp ip_pascal/p5.bat      bin/p5.bat
   cp ip_pascal/compile.bat bin/compile.bat
   cp ip_pascal/run.bat     bin/run.bat



   cp ip_pascal/p5          bin/p5
   cp ip_pascal/compile     bin/compile
   cp ip_pascal/run         bin/run

   cp ip_pascal/Makefile    .


   cp ip_pascal/standard_tests/iso7185pat.cmp standard_tests
   cp ip_pascal/standard_tests/iso7185pats.cmp standard_tests


   #
   # IP Pascal does not care about line endings, but returning to DOS mode
   # line endings normalizes the files for SVN checkin.
   #
   #unixeol

elif [ $compiler = "gpc" ] || [ $compiler = "p5c" ]
then

   #
   # Set up for chosen Pascal compiler
   #
   echo "Set up for $compiler"
   cp $compiler/p5.bat      bin/p5.bat
   cp $compiler/compile.bat bin/compile.bat
   cp $compiler/run.bat     bin/run.bat




   cp $compiler/p5          bin/p5
   cp $compiler/compile     bin/compile
   cp $compiler/run         bin/run



   cp $compiler/Makefile    .

   cp $compiler/standard_tests/iso7185pat.cmp standard_tests
   cp $compiler/standard_tests/iso7185pats.cmp standard_tests

   #
   # GPC has been problematic for line endings. This changes them
   # all to Unix mode for GPC compiles, which at this moment is
   # all there is. GPC for Windows has serious problems.
   #
   #unixeol



else

   #
   # No compiler name found!
   #
   echo "*** Compiler name does not match currently implemented"
   echo "*** compilers"
   echo
   echo "IP Pascal  - use \"ip_pascal\""
   echo "P5C Pascal - use \"P5C\""
   echo "GPC Pascal - use \"GPC\""

fi

#
# Set according to number of bits
#
if [ $bits = "32" ]
then

    echo "Setting for 32 bit target"
    set32

else

    echo "Setting for 64 bit target"
    set64

fi

echo "Configure completed!"

Changes to configure.bat.

1








2












































































































































3
4
5
6
7
8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35






36
37
38
39
40
41
42




43
44
45
46
47
48
49
50
51
52
53
54
55
56
57


58
59
60






61
62
63


64
65

66
67
68
69
70
71
72
73
74
75
76
77















@echo off








rem












































































































































rem Set up compiler to use.
rem
rem Presently implements:
rem
rem IP Pascal, named "ip_pascal"
rem
rem GPC Pascal, named "GPC" (or "gpc")
rem

if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop
:paramok


if not "%1"=="ip_pascal" goto chkgpc
rem
rem Set up for IP Pascal
rem
cp ip_pascal\p5.bat      p5.bat
cp ip_pascal\compile.bat compile.bat
cp ip_pascal\run.bat     run.bat
cp ip_pascal\cpcom.bat   cpcom.bat
cp ip_pascal\cpint.bat   cpint.bat

cp ip_pascal\p5          p5
cp ip_pascal\compile     compile
cp ip_pascal\run         run

cp ip_pascal\cpcom       cpcom
cp ip_pascal\cpint       cpint

cp ip_pascal\standard_tests/iso7185pat.cmp standard_tests
cp ip_pascal\standard_tests/iso7185pats.cmp standard_tests







echo Compiler set to IP Pascal
goto stop
:chkgpc

if "%1"=="gpc" goto dogpc
if not "%1"=="GPC" goto nonefound
:dogpc




rem
rem Set up for GPC Pascal
rem
cp gpc\p5.bat      p5.bat
cp gpc\compile.bat compile.bat
cp gpc\run.bat     run.bat
cp gpc\cpcom.bat   cpcom.bat
cp gpc\cpint.bat   cpint.bat

cp gpc\p5          p5
cp gpc\compile     compile
cp gpc\run         run
cp gpc\cpcom       cpcom
cp gpc\cpint       cpint



cp gpc/standard_tests/iso7185pat.cmp standard_tests
cp gpc/standard_tests/iso7185pats.cmp standard_tests







echo Compiler set to GPC Pascal
goto stop



rem
rem No compiler name found!

rem
:nonefound
echo *** Compiler name does not match currently implemented
echo *** compilers.
echo. 
echo IP Pascal  - use "ip_pascal"
echo GPC Pascal - use "GPC"
echo.
rem
rem Terminate script
rem
:stop
















>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






|


<
<
<
<
>

<
|
|
|
|
|
|
<
<

|
|
|
>
|
<

|
|

>
>
>
>
>
>
|
<
<
|
<
<
<
>
>
>
>
|
|
|
|
|
|
<
<

|
|
|
<
<

>
>
|
|

>
>
>
>
>
>
|
<

>
>

<
>

<
<
<
<
<
<
<
<
<
<
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159




160
161

162
163
164
165
166
167


168
169
170
171
172
173

174
175
176
177
178
179
180
181
182
183
184


185



186
187
188
189
190
191
192
193
194
195


196
197
198
199


200
201
202
203
204
205
206
207
208
209
210
211
212

213
214
215
216

217
218











219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
@echo off
rem ################################################################################
rem #
rem # Configure scipt for Pascal-P5
rem #
rem # Sets up the complete Pascal-P5 project.
rem #
rem ################################################################################

rem
rem Set default variables
rem
set compiler=gpc
set bits=32
set host=windows

rem
rem Determine if needed programs exist. The only fatal one is grep, because we
rem need that to run this script. The rest will impact the running of various
rem test and build scripts.
rem

where /q grep
if %errorlevel% neq 0 (

    echo *** No grep was found
    echo Terminating
    exit /b 1
    
)

where /q diff || echo *** No diff was found
where /q sed || echo *** No sed was found
where /q rm || echo *** No rm was found
where /q cp || echo *** No cp was found
where /q mv || echo *** No mv was found
where /q flip || echo *** No flip was found
where /q ls || echo *** No ls was found
where /q gzip || echo *** No zip was found
where /q tar || echo *** No tar was found

rem
rem Check flip (Unix/dos end of line changer) exists, and make it if not.
rem
where /q flip
if %errorlevel% neq 0 (

    echo Making flip.exe
    call bin\make_flip
    dir bin\flip.exe > temp
    grep "flip.exe" temp > temp2
    grep "flip.exe" temp > temp2 || echo *** Unable to make flip
    
)

rem
rem Detect and prioritize IP Pascal. The reason for this is, if IP Pascal
rem exists on the system, that is the preferable compiler.
rem pc.exe is the IP Pascal command shell. You might have to fix this up
rem if there is another pc.exe in the system.
rem
where /q pc
if %errorlevel% equ 0 (

    set compiler=ip_pascal
    goto :compiler_check_done
    
)

rem
rem Now check for GPC. Output scary message for no compiler found, but 
rem otherwise do nothing. rem Its up to the user to find a compiler.
rem 
where /q gpc
if %errorlevel% neq 0 (

    echo *** No gpc or pc was found, there is no ISO 7185 Pascal compiler installed
    goto :compiler_check_done

)

rem
rem Evaluate GPC compiler version and word size. This is required with GPC
rem because not all versions work as ISO 7185 Compilers. Also, we do the
rem 32 or 64 bit detection here.
rem
gpc -v 2> temp
grep "gpc version 20070904" temp > temp2
if %errorlevel% neq 0 (

    echo *** Warning, Pascal-P5 is only validated to work with gpc version 20070904

)
rm temp2
rem check 32/64 bit mode
set bits=64
grep "build=x86_64" temp > temp2
if %errorlevel% neq 0 (

    set bits=32

)
    
:compiler_check_done

rem
rem Check all arguments. Note that we don't attempt to check or fix bad choices
rem on the users part. We figure they know what they are doing.
rem

for %%x in (%*) do (

	if "%%x" == "--help" (

        echo "Configure program for Pascal-P5"
        echo
        echo "--gpc:       Select GPC as target compiler"
        echo "--ip_pascal: Select IP Pascal as target compiler"
        echo "--32:        Select 32 bit target"
        echo "--64:        Select 64 bit target"
        echo
        exit /b 1

	) else if "%%x" == "--gpc" (

    	set compiler=gpc

    ) else if "%%x" == "--ip_pascal" (

		set compiler=ip_pascal

    ) else if "%%x" == "--32" (

		set bits=32

    ) else if "%%x" == "--64" (

		set bits=64

    ) else (
    
        echo *** Option not recognized
        echo Terminating
        exit /b 1
        
    )

)

rem
rem Set up compiler to use.
rem
rem Presently implements:
rem
rem IP Pascal, named "ip_pascal"
rem
rem GPC Pascal, named "gpc"
rem





if "%compiler%" == "ip_pascal" (


    rem
    rem Set up for IP Pascal
    rem
    cp ip_pascal\p5.bat      bin\p5.bat
    cp ip_pascal\compile.bat bin\compile.bat
    cp ip_pascal\run.bat     bin\run.bat



    cp ip_pascal\p5          bin\p5
    cp ip_pascal\compile     bin\compile
    cp ip_pascal\run         bin\run

    cp ip_pascal\Makefile    .


    cp ip_pascal\standard_tests/iso7185pat.cmp standard_tests
    cp ip_pascal\standard_tests/iso7185pats.cmp standard_tests

    rem
    rem IP Pascal does not care about line endings, but returning to DOS mode
    rem line endings normalizes the files for checkin.
    rem
    rem doseol

    echo Compiler set to IP Pascal


    



)

if "%compiler%" == "gpc" (

    rem
    rem Set up for GPC Pascal
    rem
    cp gpc\p5.bat      bin\p5.bat
    cp gpc\compile.bat bin\compile.bat
    cp gpc\run.bat     bin\run.bat



    cp gpc\p5          bin\p5
    cp gpc\compile     bin\compile
    cp gpc\run         bin\run



    cp gpc/Makefile    .

    cp gpc/standard_tests/iso7185pat.cmp standard_tests
    cp gpc/standard_tests/iso7185pats.cmp standard_tests

    rem
    rem GPC needs Unix line endings in both the Unix and cygwin
    rem versions.
    rem
    rem doseol

    echo Compiler set to GPC Pascal


)

rem

rem Set bit length
rem











:setbits
if "%bits%" == "32" (

    echo Setting for 32 bit target
    set32

)
if "%bits%" == "64" (

    echo Setting for 64 bit target
    set64

)

echo Configure completed!

Added doc/The_Programming_Language_Pascal_1973.pdf.

cannot compute difference between binary files

Added doc/iso7185rules.html.

















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
<!doctype html public "-//w3c//dtd html 4.0 transitional//en">
<html>
<head>
   <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">
   <meta name="GENERATOR" content="Mozilla/4.75 [en] (Windows NT 5.0; U) [Netscape]">
   <meta name="Author" content="Scott A. Moore">
   <title>Rules of ISO 7185 PASCAL</title>
</head>
<body text="#000000" bgcolor="#66FFFF" link="#0000EE" vlink="#551A8B" alink="#FF0000" background="graphpaper.gif">

<center>
    <h1>Rules of ISO 7185 Pascal</h1>
</center>

<hr WIDTH="100%">
<p>This file contains an overview of the basic rules of ISO 7185 Pascal. See 
also the books on the subject. For serious users, I recommend:</p>
<p>Standard Pascal: Users Reference Manual, Doug Cooper</p>
<p>Oh ! Pascal !, Doug Cooper</p>
<p>Both available from Amazon.com.</p>
<p>Note that the following description could be wrong or incomplete.</p>
<hr>
<h2 align="center">Index</h2>
<h3><a href="#Lexography">Lexography</a></h3>
<h3><a href="#Program structure">Program structure</a></h3>
<h3><a href="#Label declaration">Label declaration</a></h3>
<h3><a href="#Constant declaration">Constant declaration</a></h3>
<h3><a href="#Types">Types</a></h3>
<h3><a href="#Variable declaration">Variable declaration</a></h3>
<h3><a href="#Block declaration">Block declaration</a></h3>
<h3><a href="#Declaration order">Declaration order</a></h3>
<h3><a href="#Predefined types">Predefined types</a></h3>
<h3><a href="#Basic types">Basic types</a></h3>
<h3><a href="#Integer types">Integer types</a></h3>
<h3><a href="#Enumerated types">Enumerated types</a></h3>
<h3><a href="#Boolean types">Boolean types</a></h3>
<h3><a href="#Character types">Character types</a></h3>
<h3><a href="#Subrange types">Subrange types</a></h3>
<h3><a href="#Real types">Real types</a></h3>
<h3><a href="#Structured types">Structured types</a></h3>
<h3><a href="#Packing">Packing</a></h3>
<h3><a href="#Set types">Set types</a></h3>
<h3><a href="#Array types">Array types</a></h3>
<h3><a href="#Record types">Record types</a></h3>
<h3><a href="#File types">File types</a></h3>
<h3><a href="#Pointer types">Pointer types</a></h3>
<h3><a href="#Type compatibility">Type compatibility</a></h3>
<h3><a href="#Expressions">Expressions</a></h3>
<h3><a href="#Predefined functions">Predefined functions</a></h3>
<h3><a href="#Statements">Statements</a></h3>
<h3><a href="#Assignment">Assignment</a></h3>
<h3><a href="#If statement">If statement</a></h3>
<h3><a href="#While statement">While statement</a></h3>
<h3><a href="#Repeat statement">Repeat statement</a></h3>
<h3><a href="#For statement">For statement</a></h3>
<h3><a href="#Case statement">Case statement</a></h3>
<h3><a href="#Goto statement">Goto statement</a></h3>
<h3><a href="#Compound statement">Compound statement</a></h3>
<h3><a href="#Procedures and functions">Procedures and functions</a></h3>
<h3><a href="#Predefined procedures and file operations">Predefined procedures and file operations</a></h3>
<h3><a href="#Predefined procedures and text files">Predefined procedures and text files</a></h3>
<h3><a href="#Header files">Header files</a></h3>
<h3><a href="#Packing procedures">Packing procedures</a></h3>
<h3><a href="#Dynamic allocation">Dynamic allocation</a></h3>
<hr>
<h2><a name="Lexography">Lexography</a></h2>
<p>Pascal source consists of identifiers, keywords, numbers and special &nbsp;character 
sequences. A Pascal identifier must begin with 'a' to 'z', but may continue 
with 'a' to 'z' and '0' to '9'. There is no length limit on labels, but there 
may be a practical limit. If the compiler cannot process a source line longer 
than N, you cannot have a label longer than N, since labels may not cross lines.</p>
<p>Keywords (or reserved words) appear just as labels, but have special meaning 
wherever they appear, and may never be used as identifiers:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">and &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;array &nbsp;&nbsp;&nbsp;&nbsp;begin &nbsp;&nbsp;&nbsp;&nbsp;case &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;const &nbsp;&nbsp;&nbsp;&nbsp;div &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;do</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">downto &nbsp;&nbsp;else &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;end &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;file &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;function &nbsp;goto</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">if &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;in &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;label &nbsp;&nbsp;&nbsp;&nbsp;mod &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;nil &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;not &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;of</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">or &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;packed &nbsp;&nbsp;&nbsp;procedure program &nbsp;&nbsp;record &nbsp;&nbsp;&nbsp;repeat &nbsp;&nbsp;&nbsp;set</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">then &nbsp;&nbsp;&nbsp;&nbsp;to &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;type &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;until &nbsp;&nbsp;&nbsp;&nbsp;var &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;while &nbsp;&nbsp;&nbsp;&nbsp;with</pre>
<p>A number can appear in both integer and real form. Integers will appear as 
a sequence of digits:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">83</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">00004</pre>
<p>Are valid integer numbers. For a number to be taken as &quot;real&quot; (or 
&quot;floating point&quot;) format, it must either have a decimal point, or 
use scientific notation:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">1.0</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">1e-12</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">0.000000001</pre>
<p>Are all valid reals. At least one digit must exist on either side of a decimal 
point. Strings are made up of a sequence of characters between single quotes:</p>
<pre>'string'</pre>
<p>The single quote itself can appear as two single quotes back to back in a 
string:</p>
<pre>'isn''t'</pre>
<p>Finally, special character sequences are one of the following:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">+ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;* &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;= &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&gt;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">[ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;] &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;. &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;, &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;: &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;^</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">( &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;&gt; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&lt;= &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&gt;= &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.. &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;@</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">{ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;} &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(* &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;*) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(. &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.)</pre>
<p>Note that these are just aliases for the same character sequence:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">@ &nbsp;and ^ (or the &quot;up arrow&quot; if allowed in the typeface)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">(. and [</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">.) and ]</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">(* and {</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">*) and }</pre>
<p>Spaces and line endings in the source are ignored except that they may act 
as &quot;separators&quot;. No identifier, keyword, special character sequence 
or number may be broken by a separator or other object. No two identifiers, 
keywords or numbers may appear in sequence without an intervening separator:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">MyLabel &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Valid</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">My Label &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Invalid</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin farg := 1 - Valid</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">beginfarg := 1 &nbsp;- Invalid</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">1.0e-12 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Valid</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">1.e-122e-3 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Invalid</pre>
<h2><a name="Program structure">Program structure</a></h2>
<p>A Pascal program appears as a nested set of &quot;blocks&quot;, each of which 
has the following form:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">block_type name(parameter [, parameter]...);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">label x[, y]...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">const x = y; </pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[q = r;]...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">type x = y;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[q = r;]...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var &nbsp;x[,y]...: z;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[x[,y]...: z;]...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">[block]...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;statement[; statement]</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end[. | ;]</pre>
<p>Note that:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">[option] &nbsp;&nbsp;&nbsp;means optional.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">[repeat]... means can appear 0 or more times.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">[x | y] &nbsp;&nbsp;&nbsp;&nbsp;means one or the other.</pre>
<p>There are three types of blocks, program, procedure and function. Every program 
must contain a program block, and exactly one program block exists in the source 
file.</p>
<p>Each block has two distinct sections, the declaration and statements sections. 
The declarations immediately before a statement section are considered &quot;local&quot; 
to that section.</p>
<p>The declaration section builds a description of the data used by the coming 
statement section in a logical order. For example, constants are usually used 
to build type declarations, and type declarations are used to build variables, 
and all of these may be used by nested blocks.</p>
<h2><a name="Label declaration">Label declaration</a></h2>
<p>The first declaration, labels, are numeric sequences that denote the target 
of any goto's appearing in the block:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">label 99,</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;1234;</pre>
<p>Are valid labels. Labels &quot;appear&quot; to be numbers, and must be in 
the range 0 to 9999. The &quot;appearance&quot; of a number means that:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">label 1,</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;01,</pre>
<p>Are the same label.</p>
<h2><a name="Constant declaration">Constant declaration</a></h2>
<p>Constant declarations introduce fixed valued data as a specified identifier:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">const x = 10;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;q= -1;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;y = 'hi there';</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;r = 1.0e-12;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;z = x;</pre>
<p>Are all valid constant declarations. Only integer, real and character constants 
may be so defined (no sets may appear).</p>
<h2><a name="Types">Types</a></h2>
<p>The type declaration allows types to be given names, and are used to create 
variables later:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">type x = array [1..10] of integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;i = integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;z = x;</pre>
<p>Types can be new types, aliases of old types, etc.</p>
<h2><a name="Variable declaration">Variable declaration</a></h2>
<p>Variables set aside computer storage for a element of the given type:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var x, y: integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;z: &nbsp;&nbsp;&nbsp;array [1..10] of char;</pre>
<h2><a name="Block declaration">Block declaration</a></h2>
<p>A block can be declared within a block, and that block can declare blocks 
within it, etc. There is no defined limit as to the nesting level. Because only 
one program block may exist, by definition all &quot;sub blocks&quot; must be 
either procedure or function blocks. Once defined, a block may be accessed by 
the block it was declared in. But the &quot;surrounding&quot; block cannot access 
blocks that are declared within such blocks:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">program test;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure junk;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure trash;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin { trash }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end; &nbsp;{ trash }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin { junk }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;trash;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end; &nbsp;{ junk }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin { test }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;junk;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end. &nbsp;{ test }</pre>
<p>Here test can call junk, but only junk can call trash. Trash is &quot;hidden&quot; 
from the view of test. Similarly, a subblock can access any of the variables 
or other blocks that are defined in surrounding blocks:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">program test;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var x;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure q;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure y;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;q;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;x := 1</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;y;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;writeln('x')</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end.</pre>
<p>The variable &quot;x&quot; can be accessed from all blocks declared within 
the same block. It is also possible for a block to call itself, or another block 
that calls it. This means that recursion is allowed in Pascal.</p>
<h2><a name="Declaration order">Declaration order</a></h2>
<p>Every identifier must be declared before it is used, with only one exception, 
pointers, which are discussed later. But there is a way to declare procedures 
and functions before they are fully defined to get around problems this may 
cause.</p>
<h2><a name="Predefined types">Predefined types</a></h2>
<p>Several types are predeclared in Pascal. These include integer, boolean, 
char, real and text. predeclared types, just as predeclared functions and procedures, 
exist in a conceptual &quot;outer block&quot; around the program, and can be 
replaced by other objects in the program.</p>
<h2><a name="Basic types">Basic types</a></h2>
<p>Types in Pascal can be classed as ordinal, real and structured. The ordinal 
and real types are referred to as the &quot;basic&quot; types, because they 
have no complex internal structure. &nbsp;Ordinal types are types whose elements 
can be numbered, and there are a &nbsp;finite number of such elements.</p>
<h2><a name="Integer types">Integer types</a></h2>
<p>The basic ordinal type is &quot;integer&quot;, and typically it represents 
the accuracy of a single word on the target machine:</p>
<pre>var i: integer;</pre>
<p>A predefined constant exists, &quot;maxint&quot;, which tells you what the 
maximum integral value of an integer is. So:</p>
<pre>type integer = -maxint..maxint;</pre>
<p>Would be identical to the predefined type &quot;integer&quot;. Specifically, 
the results of any operation involving ordinals will only be error free if they 
lie within -maxint to +maxint. Although other ordinal types exist in Pascal, 
all such types have a mapping into the type &quot;integer&quot;, and are bounded 
by the same rules. The &quot;ord&quot; function can be used on any ordinal to 
find the corresponding integer.</p>
<h2><a name="Enumerated types">Enumerated types</a></h2>
<p>Enumerated types allow you to specify an identifier for each and every value 
of an ordinal:</p>
<pre>type x = (one, two, three, four);</pre>
<p>Introduces four new identifiers, each one having a constant value in sequence 
from the number 0. So for the above:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">one &nbsp;&nbsp;= 0</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">two &nbsp;&nbsp;= 1</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">three = 2</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">four &nbsp;= 3</pre>
<p>Enumerated types may have no relationship to numbers whatever:</p>
<pre>type y = (red, green, blue);</pre>
<p>Or some relationship:</p>
<pre>type day = (mon, tue, wed, thur, fri, sat, sun);</pre>
<p>Here the fact that &quot;day&quot;s are numbers (say, isn't that a lyric 
?) is useful because the ordering has real world applications:</p>
<pre>if mon &lt; fri then writeln('yes');</pre>
<p>And of course, subranges of enumerated types are quite possible:</p>
<pre>type workday = (mon..fri);</pre>
<p>Enumerated types are fundamentally different from integer and subrange types 
in the fact that they cannot be freely converted to and from each other. There 
is only one conversion direction defined, to integer, and that must be done 
by special predefined function:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var i: integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;d: day;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">i := ord(d); { find integral value of d }</pre>
<h2><a name="Boolean types">Boolean types</a></h2>
<p>The only predefined enumerated type is &quot;boolean&quot;, which could be 
declared:</p>
<pre>type boolean = (false, true);</pre>
<p>However, booleans cannot be cross converted (being enumerated types), this 
user created type could not in fact be used just as the predeclared one. Booleans 
are special in that several predefined procedures, and all of the Comparison 
operators (&quot;=&quot;, &quot;&gt;&quot;, etc.) give boolean results. In addition, 
several special operators are defined just for booleans, such as &quot;and&quot;, 
&quot;or&quot; etc.</p>
<h2><a name="Character types">Character types</a></h2>
<p>Character types in Pascal hold the values of the underlying character set, 
usually ISO single byte encoded (including ASCII). The Pascal standard makes 
no requirements as to what characters will be present or what order they will 
appear in. However, as a practical matter, most Pascal programs rely on the 
characters of the alphabet and the digits '0'-'9' being present, and that these 
are numbered sequentially (which leaves out EBCDIC, for example). A character 
declaration appears as:</p>
<pre>var c: char;</pre>
<p>Character values can also be converted to and from integers at will, but 
only by using the special functions to do so:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">ord(c); { find integer value of character }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">chr(i); { find character value of integer }</pre>
<h2><a name="Subrange types">Subrange types</a></h2>
<p>Subrange types are simply a voluntary programmer restriction of the values 
an ordinal type may hold:</p>
<pre>type constrained = -10..50;</pre>
<p>(the notation x..y means all values from x to y inclusive.)</p>
<p>It is an error to assign a value outside of the corresponding range to a 
variable of that type:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var x: constrained</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">x := 100; { invalid! }</pre>
<p>But note that there are no restrictions on the USE of such a type:</p>
<pre>writeln('The sum is: ', x+100);</pre>
<p>Here, even though the result of x+100 is greater than the type of x, it is 
not an error. When used in an expression, a subrange is directly equivalent 
to the type &quot;integer&quot;.</p>
<p>Subranges can be declared of any ordinal type:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">type enum = (one, two, three, four, five, six, seven, eight, nine, ten);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var e: three..seven;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var c: 'a'..'z';</pre>
<p>Etc.</p>
<h2><a name="Real types">Real types</a></h2>
<p>Real types, or &quot;floating point&quot;, allow approximations of a large 
range of numbers to be stored. The tradeoff is that reals have no direct ordinality 
(cannot be counted), and so have no direct relationship with integers. Real 
types are the only basic type which is not ordinal.</p>
<pre>var r: real;</pre>
<p>Integers are considered &quot;promotable&quot; to reals. That is, is is assumed 
that an integer can always be represented as a real. However, there may be a 
loss of precision when this is done (because the mantissa of a real may not 
be as large as an integer). Reals are never automatically promoted to integer, 
however, and the programmer must choose between finding the nearest whole number 
to the real, or simply discarding the fraction. This choice must be made explicitly 
by predefined function.</p>
<h2><a name="Structured types">Structured types</a></h2>
<p>A structured type is a type with a complex internal structure. In fact, the 
structured types all have one thing in common: they can hold more than one basic 
type object at one time. They are structured because they are &quot;built up&quot; 
from basic types, and from other structured types.</p>
<h2><a name="Packing">Packing</a></h2>
<p>Structured types can also be &quot;packed&quot;, which is indicated by the 
keyword &quot;packed&quot; before the type declaration. Packing isn't supposed 
to change the function of the program at all. Stripping the &quot;packed&quot; 
keywords out of a program will not change the way it works (with the exception 
of &quot;strings&quot;, below). Packing means that (if implemented: its optional) 
the program should conserve space by placing the values in as few bits as possible, 
even if this takes more code (and time) to perform.</p>
<p>Packing is better understood if you understand the state of computers before 
Microprocessors (the Jurassic age of computers ?). Most mainframe computers 
access memory as a single word size only, and not even a neat multiple of 8 
bits either (for example, 36 bit computer; the CDC 6000 has 60 bit words). The 
machine reads or writes in words only. There is no byte access, no even/odd 
addressing, etc. Because storage on such a machine of small items could be wasteful 
(especially characters), programs often pack many single data items into a single 
word.</p>
<p>The advent of the Minicomputer changed that. DEC started with an 8 bit machine 
(just as microprocessors did), and when they changed to 16, then 32 bits the 
&nbsp;ability to address single bytes was maintained.</p>
<p>For this reason, many people refer to such a machine as &quot;automatically 
packed&quot;, or that Pascal's packing feature is unnecessary on such machines. 
However, &nbsp;quantizing data by 8 bit bytes is not necessarily the most extreme 
packing method available. For example, a structure of boolean values, which 
take up only 1 bit per element, left to byte packing would waste 7/8s of the 
storage allocated.</p>
<h2><a name="Set types">Set types</a></h2>
<p>Set types are perhaps the most radical feature of Pascal. A set type can 
be thought of as an array of bits indicating the presence or absence of each 
value in the base type:</p>
<pre>var s: set of char;</pre>
<p>Would declare a set containing a yes/present or no/not present indicator 
for each character in the computer's character set. The base type of a set must 
be ordinal.</p>
<h2><a name="Array types">Array types</a></h2>
<p>The most basic structured type is the array. Pascal is unusual in that both 
the upper and lower bounds of arrays are declared (instead of just the upper 
bound or length), and that the index type can be any ordinal type:</p>
<pre>var a: array [1..10] of integer;</pre>
<p>Would declare an array of 10 integers with indexes from 1 to 10. You may 
recognize the index declaration as a subrange, and indeed any subrange type 
can be used as an index type:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">type sub = 0..99;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var a: array [sub] of integer;</pre>
<p>Arrays can also be declared as multidimensional:</p>
<pre>var a: array [1..10] of array [1..10] of char;</pre>
<p>There is also a shorthand form for array declarations:</p>
<pre>var a: array [1..10, 1..10] of char;</pre>
<p>Is equivalent to the last declaration.</p>
<p>A special type of array definition is a &quot;string&quot;. Strings are arrays 
of packed characters, with integer indexes, whose lower bound is 1:</p>
<pre>var s: packed array [1..10] of char;</pre>
<p>String types are special in that any two strings with the same number of 
components are compatible with each other, including constant strings.</p>
<h2><a name="Record types">Record types</a></h2>
<p>Records give the ability to store completely different component types together 
as a unit. There they can be manipulated, copied and passed as a unit. It is 
also possible to create different typed objects that occupy the same storage 
space. </p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var r: record</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;a: integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;b: char</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;end;</pre>
<p>Gives a single variable with two completely different components, which can 
be accessed independently, or used as a unit.</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var vr: record</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;a: integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;case b: boolean of { variant }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;true: (c: integer; d: char);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;false: (e: real)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{ end }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;end;</pre>
<p>Variant records allow the same &quot;collection of types&quot;, but introduce 
the idea that not all of the components are in use at the same time, and thus 
can occupy the same storage area. In the above definition, a, b, c, d, and e 
are all elements of the record, and can be addressed individually. However, 
there are three basic &quot;types&quot; of record elements in play:</p>
<p>1. &quot;base&quot; or normal fixed record elements, such as a.</p>
<p>2. The &quot;tagfield&quot; element. Such as b.</p>
<p>3. The &quot;variants&quot;, such as c, d, and e.</p>
<p>All the elements before the case variant are normal record elements and are 
always present in the record. The tagfield is also always present, but has special 
function with regards to the variant. It must be an ordinal type, and ALL of 
it's possible values must be accounted for by a corresponding variant. The tagfield 
gives both the program and the compiler the chance to tell what the rest of 
the record holds (ie., what case variant is &quot;active&quot;). The tagfield 
can also be omitted optionally:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var vr: record</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;a: integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;case boolean of { variant }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;true: (c: integer; d: char);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;false: (e: real)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{ end }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;end;</pre>
<p>In this case, the variant can be anything the program says it is, without 
&nbsp;checking. The variants introduce what essentially is a &quot;sub record&quot; 
definition that gives the record elements that are only present if the selecting 
variant is &quot;active&quot;. A variant can hold any number of such elements. 
If the compiler chooses to implement variants, the total size of the resulting 
record will be no larger than the fixed record parts plus the size of the &nbsp;largest 
variant. It is possible for the compiler to treat the variant as a normal record, 
&nbsp;allocating each record element normally, in which case the variant record 
would be no different from a normal record.</p>
<h2><a name="File types">File types</a></h2>
<p>Files are identical to arrays in that they store a number of identical components. 
Files are different from arrays in that the number of components they may store 
is not limited or fixed beforehand. The number of components in a file can change 
during the run of a program. A file can have any type as a component type, with 
the exception of other file types. This rule is strict: you may not even have 
structures which contain files as components. A typical file declaration is:</p>
<pre>var f: file of integer;</pre>
<p>Would declare a file with standard integer components. A special predefined 
file type exists:</p>
<pre>var f: text;</pre>
<p>Text files are supposedly equivalent to:</p>
<pre>type text = file of char;</pre>
<p>But there are special procedures and functions that apply to text files only.</p>
<h2><a name="Pointer types">Pointer types</a></h2>
<p>Pointers are indirect references to variables that are created at runtime:</p>
<pre>var ip: ^integer;</pre>
<p>Pointers are neither basic or structured types (they are not structured because 
they do not have multiple components). Any type can be pointed to. In practice, 
pointers allow you to create a series of unnamed components which can be arranged 
in various ways. The type declaration for pointers is special in that the type 
&nbsp;specified to the right of &quot;^&quot; must be a type name, not a full 
type specification. Pointer declarations are also special in that a pointer 
type can be declared using base types that have not been declared yet:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">type rp: ^rec;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;rec: record</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;next: rp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;val: &nbsp;integer</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;end;</pre>
<p>The declaration for rp contains a reference to an undeclared type, rec. This 
&quot;forward referencing&quot; of pointers allows recursive definition of pointer 
types, essential in list processing.</p>
<h2><a name="Type compatibility">Type compatibility</a></h2>
<p>Type compatibility (ability to use two different objects in relation to each 
other), occurs on three different levels:</p>
<p>1. Two types are identical.</p>
<p>2. Two types are compatible.</p>
<p>3. Two types are assignment compatible.</p>
<p>Two types are identical if the exact same type definition was used to create 
the objects in question. This can happen in several different ways. Two objects 
can be declared in the same way:</p>
<pre>var a, b: array [1..10] of record a, b: integer end;</pre>
<p>Here a and b are the same (unnamed) type. They can also be declared using 
the same type name:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">type mytype = record a, b: integer end;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var a: mytype;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;b: mytype;</pre>
<p>Finally, an &quot;alias&quot; can be used to create types:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">type mytype = array [1..10] of integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;myother = mytype;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var a: mytype;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;b: myother;</pre>
<p>Even though an alias is used, these objects till have the same type. Two 
types are considered compatible if:</p>
<p>1. They are identical types (as described above).</p>
<p>2. Both are ordinal types, and one or both are subranges of an identical 
type.</p>
<p>3. Both are sets with compatible base types and &quot;packed&quot; status.</p>
<p>4. Both are string types with the same number of components.</p>
<p>Finally, two types are assignment compatible if:</p>
<p>1. The types are compatible, as described above.</p>
<p>2. Neither is a file, or has components of file type.</p>
<p>3. The destination is real, and the source is integer (because integers can 
always be promoted to real, as above).</p>
<p>4. The source &quot;fits&quot; within the destination. If the types are subranges 
of the same base type, the source must fall within the destination's range:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var x: 1..10;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">x := 1; { legal }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">x := 20; { not legal }</pre>
<p>5. Both are sets, and the source &quot;fits&quot; within the destination. 
If the base types of the sets are subranges, all the source elements must also 
exist in the destination:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var s1: set of 1..10;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">s1 := [1, 2, 3]; { legal }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">s1 := [1, 15]; { not legal } </pre>
<h2><a name="Expressions">Expressions</a></h2>
<p>The basic operands in Pascal are:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">xxx &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Integer constant. A string of digits, without sign, whose</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;value is bounded by -maxint..maxint.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">x.xex &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Real constant.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">'string' &nbsp;&nbsp;- String constant.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">[set] &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Set constant. A set constant consists of zero or more elements</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;separated by &quot;,&quot;:</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[1, 2, 3]</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;A range of elements can also appear:</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[1, 2..5, 10]</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;The elements of a set must be of the same type, and the </pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&quot;apparent&quot; base type of the set is the type of the elements.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;The packed or unpacked status of the set is whatever is</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;required for the context where it appears.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">ident &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Identifier. Can be a variable or constant from a const </pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;declaration.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">func(x, y) - A function call. Each parameter is evaluated, and the</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;function called. The result of the function is then used</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;in the encompassing expression.</pre>
<p>The basic construct built on these operands is a &quot;variable access&quot;, 
where &quot;a&quot; is any variable access.</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">ident &nbsp;&nbsp;&nbsp;- A variable indentifier.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a[index] - Array access. It is also possible to access any number of</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dimensions by listing multiple indexes separated by &quot;,&quot;:</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;[x, y, z, ...]</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a.off &nbsp;&nbsp;&nbsp;- Record access. The &quot;off&quot; will be the element identifier as</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;used in the record declaration.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a^ &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Pointer reference. The resulting reference will be of the</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;variable that the pointer indexes. If the variable reference</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;is a file, the result is a reference to the &quot;buffer variable&quot;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;for the file.</pre>
<p>Note that a VAR parameter only allows a variable reference, not a full &nbsp;expression. 
For the rest of the expression operators, here they are in precedence, with 
the operators appearing in groups according to priority (highest first). &quot;a&quot; 
and &quot;b&quot; are operands.</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">(a) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- A subexpresion.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">not &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- The boolean &quot;not&quot; of the operand, which must be boolean.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a*b &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Multiplication/set intersection. If the operands are real or</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;integer, the multiplication is found. If either operand is</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;real, the result is real. If the operands are sets, the </pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;intersection is found, or a new set with elements that exist</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;in both sets.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a/b &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Divide. The operands are real or integer. The result is a real</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;representing a divided by b.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a div b &nbsp;- Integer divide. The operands must be integer. The result is an</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;integer giving a divided by b with no fractional part.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a mod b &nbsp;- Integer modulo. The operands must be integer. The result is an</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;integer giving the modulo of a divided by b.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a and b &nbsp;- Boolean &quot;and&quot;. Both operands must be boolean. The result is a</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;boolean, giving the &quot;and&quot; of the operands.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">+a &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Identity. The operand is real or integer. The result is the</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;same type as the operand, and gives the same sign result as the</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;operand (essentially a no-op).</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">-a &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Negation. The operand is real or integer. The result is the</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;same type as the operand, and gives the negation of the</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;operand.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a+b &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Add/set union. If the operands are real or integer, finds the</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sum of the operands. If either operand is real, the result is</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;real. If both operands are sets, finds a new set which contains</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;the elements of both.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a-b &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;- Subtract/set difference. If the operands are real or integer,</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;finds a minus b. If either operand is real, the result is</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;real. If both operands are sets, finds a new set which contains</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;the elements of a that are not also elements of b.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a or b &nbsp;&nbsp;- Boolean &quot;or&quot;. Both operands must be boolean. The result is</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;boolean, giving the boolean &quot;or&quot; of the operands.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a &lt; b &nbsp;&nbsp;&nbsp;- Finds if a is less than b, and returns a boolean result.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;The operands can be basic or string types.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a &gt; b &nbsp;&nbsp;&nbsp;- Finds if a is greater than b, and returns a boolean result.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;The operands can be basic or string types.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a &lt;= b &nbsp;&nbsp;- Finds if a is less than or equal to b, and returns a boolean</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;result. The operands can be basic, string, set or pointer</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;types.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a &gt;= b &nbsp;&nbsp;- Finds if a is greater than or equal to b, and returns a boolean</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;result. The operands can be basic, string, set or pointer</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;types.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a = b &nbsp;&nbsp;&nbsp;- Finds if a is equal to b, and returns a boolean result.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;The operands can be basic, string, set or pointer types.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a &lt;&gt; b &nbsp;&nbsp;- Finds if a is not equal to b, and returns a boolean result.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;The operands can be basic, string, set or pointer types.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">a in b &nbsp;&nbsp;- Set inclusion. A is an ordinal, b is a set with the same base</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;type as a. Returns true if there is an element matching a in</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;the set.</pre>
<h2><a name="Predefined functions">Predefined functions</a></h2>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">The following predefined functions exist:</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">sqr(x) &nbsp;&nbsp;&nbsp;- Finds the square of x, which can be real or integer. The</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;result is the same type as x.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">sqrt(x) &nbsp;&nbsp;- Finds the square root of x, which can be real or integer. The</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;result is always real.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">abs(x) &nbsp;&nbsp;&nbsp;- Finds the absolute value of x, which can be real or integer.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;The result is the same type as x.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">sin(x) &nbsp;&nbsp;&nbsp;- Finds the sine of x,which can be real or integer. x is</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;expressed in radians. The result is always real.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">cos(x) &nbsp;&nbsp;&nbsp;- Finds the cosine of x,which can be real or integer. x is </pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;expressed in radians. The result is always real.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">arctan(x) - Finds the arctangent of x, which can be real or integer. The</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;result is always real, and is expressed in radians.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">exp(x) &nbsp;&nbsp;&nbsp;- Finds the exponential of x, which can be real or integer. The</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;result is always real.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">ln(x) &nbsp;&nbsp;&nbsp;&nbsp;- Finds the natural logarithm of x, which can be real or</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;integer. The result is always real.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">ord(x) &nbsp;&nbsp;&nbsp;- Finds the integer equivalent of any ordinal type x.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">succ(x) &nbsp;&nbsp;- Finds the next value of any ordinal type x.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">pred(x) &nbsp;&nbsp;- Finds the last value of any ordinal type x.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">chr(x) &nbsp;&nbsp;&nbsp;- Finds the char type equivalent of any integer x.</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">trunc(x) &nbsp;- Finds the nearest integer below the given real x (converts a</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">           &nbsp;real to an integer).</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">round(x) &nbsp;- Finds the nearest integer to the given real x.</pre>
<h2><a name="Statements">Statements</a></h2>
<p>Pascal uses &quot;structured statements&quot;. This means you are given a 
few standard control flow methods to build a program with.</p>
<h2><a name="Assignment">Assignment</a></h2>
<p>The fundamental statement is the assignment statement:</p>
<pre>v := x;</pre>
<p>There is a special operator for assignment, &quot;:=&quot; (or &quot;becomes&quot;). 
Only a single variable reference may appear to the right, and any expression 
may appear to the left. The operands must be assignment compatible, as defined 
above.</p>
<h2><a name="If statement">If statement</a></h2>
<p>The if statement is the fundamental flow of control structure:</p>
<pre>if cond then statement [else statement]</pre>
<p>In Pascal, only boolean type expressions may appear for the condition (not 
integers). The if statement specifies a single statement to be executed if the 
condition is true, and an optional statement if the condition is false. You 
must beware of the &quot;bonding problem&quot; if you create multiple nested 
if statements:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">if a = 1 then if b = 2 then writeln('a = 1, b = 2')</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">else writeln('a &lt;&gt; 1');</pre>
<p>Here the else clause is attached to the very last statement that appeared, 
which may not be the one we want.</p>
<h2><a name="While statement">While statement</a></h2>
<p>Just as if is the fundamental flow of control statement, while is the fundamental 
loop statement:</p>
<pre>while cond do statement</pre>
<p>The while statement continually executes it's single statement as long as 
the condition is true. It may not execute the statement at all if the condition 
is never true.</p>
<h2><a name="Repeat statement">Repeat statement</a></h2>
<p>A repeat statement executes a block of statements one or more times:</p>
<pre>repeat statement [; statement] until cond</pre>
<p>It will execute the block of statements as long as the condition is false. 
The statement block will always be executed at least once.</p>
<h2><a name="For statement">For statement</a></h2>
<p>The for statement executes a statement a fixed number of times:</p>
<pre>for i := lower to upper do statement</pre>
<pre>for i := upper downto lower do statement</pre>
<p>The for statement executes the target statement as long as the &quot;control 
variable&quot; lies within the set range of lower..upper. It may not execute 
at all if lower &gt; upper. The control variable in a for is special, and it 
must obey several rules:</p>
<p>1. It must be ordinal.</p>
<p>2. It must be local to the present block (declared in the present block).</p>
<p>3. It must not be &quot;threatened&quot; in the executed statement. To threaten 
means to modify, or give the potential to modify, as in passing as a VAR parameter 
to a procedure or function (see below).</p>
<h2><a name="Case statement">Case statement</a></h2>
<p>The case statement defines an action to be executed on each of the values 
of an ordinal:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">case x of</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;c1: statement;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;c2: statement;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end;</pre>
<p>The &quot;selector&quot; is an expression that must result in an ordinal 
type. Each of the &quot;case labels&quot; must be type compatible with the selector. 
The case &nbsp;statement will execute one, and only one, statement that matches 
the current selector value. If the selector matches none of the cases, then 
an error results. It is NOT possible to assume that execution simply continues 
if none of the cases are matched. A case label MUST match the value of the selector.</p>
<h2><a name="Goto statement">Goto statement</a></h2>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">The goto statement directly branches to a given labeled statement:</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">goto 123</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">123:</pre>
<p>Several requirements exist for gotos:</p>
<p>1. The goto label must have been declared in a label declaration.</p>
<p>2. A goto cannot jump into any one of the structured statements above (if, 
while, repeat, for or case statements).</p>
<p>3. If the target of the goto is in another procedure or function, that 
target label must be in the &quot;outer level&quot; of the procedure or function. 
That means that it may not appear inside any structured statement at all.</p>
<h2><a name="Compound statement">Compound statement</a></h2>
<p>A statement block gives the ability to make any number of statements appear 
as one:</p>
<pre>begin statement [; statement]... end</pre>
<p>All of the above statements control only one statement at a time, with the 
exception of repeat. The compound statement allows the inclusion of a whole 
substructure to be controlled by those statements.</p>
<h2><a name="Procedures and functions">Procedures and functions</a></h2>
<p>When you need to use a block of the same statements several times, a compound 
block can be turned into a procedure or function and given a name:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure x;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">function y: integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end;</pre>
<p>Then, the block of statements can be called from anywhere:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var i: integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">x; { calls the procedure }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">i := y; { calls the function }</pre>
<p>The difference between a procedure and a function is that a function returns 
a result, which can only be a basic or pointer type (not structured). This makes 
it possible to use a function in an expression. In a function, the result is 
returned by a special form of the assign statement:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">function y: integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;y := 1 { set function return }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end;</pre>
<p>The assignment is special because only the name of the function appears on 
the left hand side of &quot;:=&quot;. It does not matter where the function 
return assignment appears in the function, and it is even possible to have multiple 
assignments to the function, but AT LEAST one such assignment must be executed 
before the function ends. If the procedure or function uses parameters, they 
are declared as:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure x(one: integer; two, three: char);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end;</pre>
<p>The declaration of a parameter is special in that only a type name may be 
specified, not a full type specification. Once appearing in the procedure or 
function header, parameters can be treated as variables that just happen to 
have been initialized to the value passed to the procedure or function. The 
modification of parameters has no effect on the original parameters themselves. 
Any expression that is assignment compatible with the parameter declaration 
can be used in place of the parameter during it's call:</p>
<pre>x(x*3, 'a', succ('a'));</pre>
<p>If it is desired that the original parameter be modified, then a special 
form of parameter declaration is used:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure x(var y: integer);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;y := 1</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end;</pre>
<p>Declaring y as a VAR parameter means that y will stand for the original parameter, 
including taking on any values given it:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var q: integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;x(q);</pre>
<p>Would change q to have the value 1. In order to be compatible with a VAR 
the passed parameter must be of identical type as the parameter declaration, 
and be a variable reference. Finally, Pascal provides a special mode of parameter 
known as a procedure or function parameter which passes a reference to a given 
procedure or function:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure x(procedure y(x, q: integer));</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure z(function y: integer);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<p>To declare a procedure or function parameter, you must give it's full parameter 
list, including a function result if it is a function. A procedure or function 
is passed to a procedure or function by just it's name:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure r(a, b: integer);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;x(r); { pass procedure r to procedure x }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<p>The parameter list for the procedure or function passed must be &quot;congruent&quot; 
with the declared procedure or function parameter declaration. This means that 
all it's parameters, and all of the parameters of it's procedure or function 
parameters, etc., must match the declared parameter. Once the procedure or function 
has been passed, it is then ok for the procedure or function that accepts it 
to use it:</p>
<p>procedure x(procedure y(x, q: integer));</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;y(1, 2);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<p>Would call r with parameters 1 and 2.</p>
<p>Procedures and functions can be declared in advance of the actual appearance 
of the procedure or function block using the forward keyword:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure x(a, b: integer); forward;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure y;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;x(1, 2)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">end;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">procedure x;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">begin</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;...</pre>
<p>The forward keyword replaces the appearance of the block in the first &nbsp;appearance 
of the declaration. In the second appearance, only the name of the procedure 
appears, not it's header parameters. Then the block appears as normal. The advance 
declaration allows recursive structuring of procedure and function calls that 
would be otherwise not be possible.</p>
<h2><a name="Predefined procedures and file operations">Predefined procedures and file operations</a></h2>
<p>A file is not accessed directly (as an array is). Instead, Pascal automatically 
declares one component of the files base type which is accessed by special syntax:</p>
<pre>f^</pre>
<p>So that:</p>
<pre>f^ := 1;</pre>
<p>Assigns to the file &quot;buffer&quot; component, and:</p>
<pre>v := f^;</pre>
<p>Reads the file buffer. Unless the file is empty or you are at the end of 
the file, the file buffer component will contain the contents of the component 
at the file location you are currently reading or writing. Other than that, 
the file buffer behaves as an ordinary variable, and can even be passed as a 
parameter to routines. The way to actually read or write through a file is by 
using the predeclared procedures:</p>
<pre>get(f);</pre>
<p>Loads the buffer variable with the next element in the file, and advances 
the file position by one element, and:</p>
<pre>put(f);</pre>
<p>Outputs the contents of the buffer variable to the file and advances the 
file position by one. These two procedures are really all you need to implement 
full reading and writing on a file. It also has the advantage of keeping the 
next component in the file as a &quot;lookahead&quot; mechanism. However, it 
is much more common to access files via the predefined procedures read and write:</p>
<pre>read(f, x);</pre>
<p>Is equivalent to:</p>
<pre>x := f^; get(f);</pre>
<p>And:</p>
<pre>write(f, x);</pre>
<p>Is equivalent to:</p>
<pre>f^ := x; put(f);</pre>
<p>Read and write are special in that any number of parameters can appear:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">read(f, x, y, z, ...);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">write(f, x, y, z, ...);</pre>
<p>The parameters to read must be variable references. The parameters to write 
can be expressions of matching type, except for the file parameter (files must 
always be VAR references). Writing to a file is special in that you cannot write 
to a file unless you are at the end of the file. That is, you may only append 
new elements to the end of the file, not modify existing components of the file.</p>
<p>Files are said to exist in three &quot;states&quot;:</p>
<p>1. Inactive.</p>
<p>2. Read.</p>
<p>3. Write.</p>
<p>All files begin life in the inactive state. For a file to be read from, it 
must be placed into the read state. For a file to be written, it must be placed 
in the write state. The reset and rewrite procedures do this:</p>
<pre>reset(f);</pre>
<p>Places the buffer variable at the 1st element of the file (if it exists), 
and sets the file mode to &quot;read&quot;.</p>
<pre>rewrite(f);</pre>
<p>Clears any previous contents of the file, and places the buffer variable 
at the start of the file. The file mode is set to &quot;write&quot;. A file 
can be tested for only one kind of position, that is if it has reached the end:</p>
<pre>eof(f);</pre>
<p>Is a function that returns true if the end of the file has been reached. 
eof must be true before the file can be written.</p>
<h2><a name="Predefined procedures and text files">Predefined procedures and text files</a></h2>
<p>As alluded to before, text files are treated specially under Pascal. First, 
The ends of lines are treated specially. If the end of a line is reached, a 
read call will just return a space. A special function is required to determine 
if the end of the line has been reached:</p>
<pre>eoln(f);</pre>
<p>Returns true if the current file position is at the end of a line. Pascal 
strictly enforces the following structure to text files:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">line 1&lt;eoln&gt;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">line 2&lt;eoln&gt;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">line N&lt;eoln&gt;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&lt;eof&gt;</pre>
<p>There will always be an eoln terminating each line. If the file being read 
does not have an eoln on the last line, it will be added automatically. Besides 
the standard read and write calls, two procedures are special to text files:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">readln(f...);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">writeln(f...);</pre>
<p>Readln behaves as a normal read, but after all the items in the list are 
read, The rest of the line is skipped until eoln is encountered. Writeln behaves 
as a normal write, but after all the items in the list are written, an eoln 
is appended to the output. Text files can be treated as simple files of characters, 
but it is also possible to read and write other types to a text file. Integers 
and reals can be read from a text file, and integers, reals, booleans, 
and strings can be written to text files. These types are written or read from 
the file by converting them to or from a character based format. The format 
for integers on read must be:</p>
<pre>[+/-]digit[digit]...</pre>
<p>Examples:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;9</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">+56</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">-19384</pre>
<p>The format for reals on read is:</p>
<pre>[+/-]digit[digit]...[.digit[digit]...][e[+/-]digit[digit]...]</pre>
<p>Examples:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">-1</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">-356.44</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">7e9</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">+22.343e-22</pre>
<p>All blanks are skipped before reading the number. Since eolns are defined 
as blanks, this means that even eoln is skipped to find the number. This can 
lead to an interesting situation when a number is read from the console. If 
the user presses return without entering a number (on most systems), nothing 
will happen until a number is entered, no matter how many times return is hit!</p>
<p>Write parameters to textfiles are of the format:</p>
<pre>write(x[:field[:fraction]]);</pre>
<p>The field states the number of character positions that you expect the object 
to occupy. The fraction is special to reals. The output format that occurs in 
each case are:</p>
<p>integer: The default field for integers is implementation defined, but is 
usually the number of digits in maxint, plus a position for the sign. If a field 
is specified, and is larger than the number of positions required to output 
the number and sign, then blanks are added to the left side of the output until 
the total size equals the field width. If the field width is less than the required 
positions, the field width is ignored.</p>
<p>real: The default field for reals is implementation defined. There are two 
different format modes depending on whether the fraction parameter appears. 
</p>
<p>If there is no fraction, the format is:</p>
<pre>-0.0000000e+000</pre>
<p>Starting from the left, the sign is either a &quot;-&quot; sign if the number 
is negative, or blank if the number is positive or zero. Then the first digit 
of the number, then the decimal point, then the fraction of the number, then 
either 'e' or 'E' (the case is implementation defined), then the sign of the 
exponent, then the digits of the exponent. The number of digits in the exponent 
are implementation defined, as are the number of digits in a fraction if no 
field width is defined. If the field width appears, and it is larger than the 
total number of required positions in the number (all the characters in the 
above format without the fraction digits), then the fraction is expanded until 
the entire number fills the specified field, using right hand zeros if required. 
Otherwise, the minimum required positions are always printed.</p>
<p>If a fraction appears (which means the field must also appear), the format 
used is:</p>
<pre>[-]00...00.000..00</pre>
<p>The number is converted to it's whole number equivalent, and all the of whole 
number portion of the number printed, regardless of the field size, proceeded 
by &quot;-&quot; if the number is negative. Then, a decimal point appears, followed 
by the number of fractional digits specified in the fraction parameter. If the 
field is greater then the number of required positions and specified fraction 
digits, then leading spaces are appended until the total size equals the field 
width. The minimum positions and the specified fractional digits are always 
printed.</p>
<h2><a name="Header files">Header files</a></h2>
<p>The header files feature was originally designed to be the interface of Pascal 
to the external files system, and as such is implementation by definition. It 
is also (unfortunately) ignored in most implementations. The header files appear 
as a simple list of identifiers in the program header:</p>
<p>program test(input, output, source, object);</p>
<p>Each header file automatically assumes the type text. If the file needs to 
be another type, it should be declared again in the variables section of the 
program block:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">program test(intlist);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var intlist: file of integer;</pre>
<p>Two files are special, and should not be redeclared. These are input and 
output. The input files are understood to represent the main input and main 
output from the program, and are present in all Pascal programs. In addition, 
they are the default files is special forms of these &nbsp;procedures and functions:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">This form &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;is equivalent to &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;This form</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">--------------------------------------------------------------</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">write(...) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;write(output, ...)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">writeln(...) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;writeln(output, ...)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">writeln &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;writeln(output)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">read(...) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;read(input, ...)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">readln(...) &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;readln(input, ...)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">readln &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;readln(input)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">eof &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;eof(input)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">eoln &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;eoln(input)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">page                                 page(output)</pre>
<h2><a name="Packing procedures">Packing procedures</a></h2>
<p>Because arrays are incompatible with each other even when they are of the 
same type if their packing status differs, two procedures allow a packed array 
to be copied to a non-packed array and vice versa:</p>
<pre>unpack(PackedArray, UnpackedArray, Index);</pre>
<p>Unpacks the packed array and places the contents into the unpacked array. 
The index gives the starting index of the unpacked array where the data is to 
be placed. Interestingly, the two arrays need not have the same index type or 
even be the same size ! The unpacked array must simply have enough elements 
after the specified starting index to hold the number of elements in the packed 
array.</p>
<pre>pack(UnpackedArray, Index, PackedArray);</pre>
<p>Packs part of the unpacked array into the packed array. The index again gives 
the starting position to copy data from in the unpacked array. Again, the arrays 
need not be of the same index type or size. The unpacked array simply need enough 
elements after the index to provide all the values in the packed array.</p>
<h2><a name="Dynamic allocation">Dynamic allocation</a></h2>
<p>In Pascal, pointer variables are limited to the mode of variable they can 
index. The objects indexed by pointer types are anonymous, and created or destroyed 
by the programmer at will. A pointer variable is undefined when it is first 
used, and it is an error to access the variable it points to unless that variable 
has been created:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var p: ^integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;new(p); { create a new integer type }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;p^ := 1; { place value }</pre>
<p>Would create a new variable. Variables can also be destroyed:</p>
<pre>dispose(p);</pre>
<p>Would release the storage allocated to the variable. It is an error (a very 
serious one) to access the contents of a variable that has been disposed. A 
special syntax exists for the allocation of variant records:</p>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">var r: record</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;a: integer;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;case b: boolean 
of</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;true: 
(c: integer);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;false: 
(d: char)</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{ end }</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;end;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">new(p, true);</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">...</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">&nbsp;</pre>
<pre style="line-height:100%; margin-top:0; margin-bottom:0;">dispose(p, true);</pre>
<p>For each of new and dispose, each of the tagfields we want to discriminate 
are parameters to the procedure. The appearance of the tagfield values allow 
the compiler to allocate a variable with only the amount of space required for 
the record with that variant. This can allow considerable storage savings if 
used correctly. The appearance of a discriminant in a new procedure does not 
also &nbsp;automatically SET the value of the tagfield. You must do that yourself. 
For the entire life of the variable, you must not set the tagfield to any other 
value than the value used in the new procedure, nor access any of the &nbsp;variants 
in the record that are not active. The dispose statement should be called with 
the exact same tagfield values and number. Note that ALL the tagfields in a 
variable need not appear, just all the ones, in order, that we wish to allocate 
as fixed.</p>
<center>
<hr WIDTH="100%"></center>

<address>
For more information contact: <a href="mailto:samiam@moorecad.com">Scott A. Moore samiam@moorecad.com</a></address>

</body>
</html>

Added doc/news.txt.



































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
************************** WHATS NEW IN THIS VERSION ***************************

Welcome to version 1.2

2013/11/11

- Added run of P4 on P5 to regression test suite.

- Added a section on use of GPC under Mingw/msys to installation descriptions.

- Fixed error generated on p2 directory fixups.

- Removed 7185 documentation, which was claimed as an ISO copyright violation.

- Fixed overflow check bug in pint.

********************************************************************************

Added doc/the_p5_compiler.doc.

cannot compute difference between binary files

Added doc/the_p5_compiler.docx.

cannot compute difference between binary files

Added doc/the_p5_compiler.html.

more than 10,000 changes

Added doc/the_p5_compiler.pdf.

cannot compute difference between binary files

Added doc/todo.txt.























>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
****************************** DO TO FILE FOR P5 *******************************

This file contains issues to be corrected in the P5 projects.

1. Add array, record and function result variables to the various scalar tests
   in iso7185pat.

2. Add input file and testing to iso7185pat.

3. Create word document describing P5 changes and end with a full instruction
   description.

Added gpc/Makefile.

































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
#
# Makefile for Pascal-p5
#
# Makes the main compiler interpreter set.
#
PC=gpc
CFLAGS=--classic-pascal-level-0 --no-warnings --transparent-file-names --no-range-checking

all: pcom pint

pcom: source/pcom.pas
	$(PC) $(CFLAGS) -o bin/pcom source/pcom.pas
	
pint: source/pint.pas
	$(PC) $(CFLAGS) -o bin/pint source/pint.pas
	
clean:
	rm -f bin/pcom bin/pint 
	find . -name "*.p5" -type f -delete
	find . -name "*.out" -type f -delete
	find . -name "*.lst" -type f -delete
	find . -name "*.obj" -type f -delete
	find . -name "*.sym" -type f -delete
	find . -name "*.int" -type f -delete
	find . -name "*.dif" -type f -delete
	find . -name "*.err" -type f -delete
	find . -name "*.tmp" -type f -delete
	find . -name "prd" -type f -delete
	find . -name "prr" -type f -delete
	find . -name "temp" -type f -delete
	find . -name "tmp" -type f -delete
	find . -name "*~" -type f -delete

Changes to gpc/compile.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
..
29
30
31
32
33
34
35

36















37
#!/bin/bash
#
# Compile file in batch mode using GPC Pascal.
#
# Runs a compile with the input and output coming from/
# going to files.
# 
# Execution:
# 
# Compile <file>
#
# <file> is the filename without extention.
#
# The files are:
#
# <file>.pas - The Pascal source file
................................................................................

if [ ! -f $1.pas ]
then
   echo "*** Error: Missing $1.pas file"
   exit 1
fi


./pcom < $1.pas > $1.err















mv prr $1.p5






|
|
|







 







>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
..
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
#!/bin/bash
#
# Compile file in batch mode using GPC Pascal.
#
# Runs a compile with the input and output coming from/
# going to files.
#
# Execution:
#
# Compile <file>
#
# <file> is the filename without extention.
#
# The files are:
#
# <file>.pas - The Pascal source file
................................................................................

if [ ! -f $1.pas ]
then
   echo "*** Error: Missing $1.pas file"
   exit 1
fi

cp $1.pas prd
pcom > $1.err
#
# The status of the compile is not returned, so convert a non-zero
# error message to fail status
#
grep -q "Errors in program: 0" $1.err
rc=$?
if [[ $rc != 0 ]] ; then

    exit 1
        
fi
#
# Move the prr file to <file.p5>
#
rm -f $1.p5
mv prr $1.p5

Changes to gpc/compile.bat.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41










@echo off
rem
rem Compile file in batch mode using GPC Pascal.
rem
rem Runs a compile with the input and output coming from/
rem going to files.
rem 
rem Execution:
rem 
rem Compile <file>
rem
rem <file> is the filename without extention.
rem
rem The files are:
rem
rem <file>.pas - The Pascal source file
rem <file>.p5  - The intermediate file produced
rem <file>.err - The errors output from the compiler
rem
rem Note that the l+ option must be specified to get a full
rem listing in the .err file (or just a lack of l-).
rem
if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop
:paramok
if exist "%1.pas" goto fileexists
echo *** Error: Missing %1.pas file
goto stop
:fileexists
pcom < %1.pas > %1.err
if not exist "%1.p5" goto nodel1
del %1.p5
:nodel1
cp prr %1.p5
rm prr
chmod +w %1.p5
rem
rem Terminate
rem
:stop
















|

|













|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
@echo off
rem
rem Compile file in batch mode using GPC Pascal.
rem
rem Runs a compile with the input and output coming from/
rem going to files.
rem
rem Execution:
rem
rem Compile <file>
rem
rem <file> is the filename without extention.
rem
rem The files are:
rem
rem <file>.pas - The Pascal source file
rem <file>.p5  - The intermediate file produced
rem <file>.err - The errors output from the compiler
rem
rem Note that the l+ option must be specified to get a full
rem listing in the .err file (or just a lack of l-).
rem

if "%1"=="" (

    echo *** Error: Missing parameter
    exit /b 1

)

if not exist "%1.pas" (

    echo *** Error: Missing %1.pas file
    exit /b 1

)

cp %1.pas prd
pcom > %1.err
rem
rem The status of the compile is not returned, so convert a non-zero
rem error message to fail status
rem
grep -q "Errors in program: 0" %1.err
if errorlevel 1 exit /b 1
rem
rem Move the prr file to <file.p5>
rem
if exist "%1.p5" del %1.p5
mv prr %1.p5
chmod +w %1.p5

Changes to gpc/p5.

30
31
32
33
34
35
36

37
38
39
40


   exit 1

fi

echo
echo Compiling and running $1
echo

./pcom < $1.pas
mv prr $1.p5
cp $1.p5 prd 
./pint









>
|
|
|
|
>
>
30
31
32
33
34
35
36
37
38
39
40
41
42
43
   exit 1

fi

echo
echo Compiling and running $1
echo
cp $1.pas prd
pcom < $1.pas
mv prr $1.p5
cp $1.p5 prd
pint
rm prd
rm prr

Changes to gpc/p5.bat.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

15





16
17
18
19
20
21
22
23
24





25
26
27
28
29
30
31
32
33


34

35
36
37
38


39


@echo off
rem
rem Compile with P5 using GPC
rem
rem Execute with:
rem
rem p5 <file>
rem
rem where <file> is the name of the source file without
rem extention. The Pascal file is compiled and run.
rem Any compiler errors are output to the screen. Input
rem and output to and from the running program are from
rem the console, but output to the prr file is placed
rem in <file>.out.

rem The intermediate code is placed in <file>.p5.





rem
if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop
:paramok
if exist "%1.pas" goto fileexists
echo *** Error: Missing %1.pas file
goto stop
:fileexists





echo.
echo Compiling and running %1
echo.
pcom < %1.pas
if not exist "%1.p5" goto nodel
del %1.p5
:nodel
cp prr %1.p5
del prr


copy %1.p5 prd 

pint
rem
rem Terminate
rem


:stop








|

|




|
>

>
>
>
>
>









>
>
>
>
>



|
|
|
|
|
|
>
>
|
>

<
<
<
>
>

>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49



50
51
52
53
54
@echo off
rem
rem Compile with P5 using GPC
rem
rem Execute with:
rem
rem p5 <sourcefile> [<inputfile>[<outputfile>]]
rem
rem where <sourcefile> is the name of the source file without
rem extention. The Pascal file is compiled and run.
rem Any compiler errors are output to the screen. Input
rem and output to and from the running program are from
rem the console, but output to the prr file is placed
rem in <sourcefile>.out.
rem
rem The intermediate code is placed in <file>.p5.
rem
rem If <inputfile> and <outputfile> are specified, then these will be
rem placed as input to the "prd" file, and output from the "prr" file.
rem Note that the prd file cannot or should not be reset, since that
rem would cause it to back up to the start of the intermediate code.
rem
if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop
:paramok
if exist "%1.pas" goto fileexists
echo *** Error: Missing %1.pas file
goto stop
:fileexists
if "%2"=="" goto continue
if exist "%2" goto continue
echo *** Error: Missing %2 input file
goto stop
:continue
echo.
echo Compiling and running %1
echo.
cp %1.pas prd
pcom
mv prr %1.p5
if not "%2"=="" goto useinputfile
cp %1.p5 prd
goto run
:useinputfile
rem The input file, if it exists, gets put on the end of the intermediate
cat %1.p5 %2 > prd
:run
pint



if "%3"=="" goto stop
cp %prr %3
:stop
rm -f prd
rm -f prr

Changes to gpc/run.

33
34
35
36
37
38
39
40
41
42
43
44
45
if [ ! -f $1.inp ]
then
   echo "*** Error: Missing $1.inp file"
   exit 1
fi

cp $1.p5 prd 
./pint < $1.inp > $1.lst
if [ -e "$1" ]
then
   rm $1.out
fi
mv prd $1.out







|
<
<
|
<
|
33
34
35
36
37
38
39
40


41

42
if [ ! -f $1.inp ]
then
   echo "*** Error: Missing $1.inp file"
   exit 1
fi

cp $1.p5 prd 
pint < $1.inp &> $1.lst


rm -f $1

mv prd $1.out

Changes to gpc/run.bat.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44


rem The files are:
rem
rem <file>.p5  - The intermediate file
rem <file>.out - The prr file produced
rem <file>.inp - The input file to the program
rem <file>.lst - The output file from the program
rem
if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop
:paramok
if exist "%1.p5" goto fileexists1
echo *** Error: Missing %1.p5 file
goto stop
:fileexists1
if exist "%1.inp" goto fileexists2
echo *** Error: Missing %1.inp file
goto stop
:fileexists2
copy %1.p5 prd 
pint < %1.inp > %1.lst
if not exist "%1.out" goto fileexists3
del %1.out
:fileexists3
cp prd %1.out
del prd
chmod +w %1.out
rem
rem Terminate
rem
:stop










|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
rem The files are:
rem
rem <file>.p5  - The intermediate file
rem <file>.out - The prr file produced
rem <file>.inp - The input file to the program
rem <file>.lst - The output file from the program
rem

if "%1"=="" (

    echo *** Error: Missing parameter
    exit /b 1

)

if not exist "%1.p5" (

    echo *** Error: Missing %1.p5 file
    exit /b 1

)

if not exist "%1.inp" (

    echo *** Error: Missing %1.inp file
    exit /b 1

)

cp %1.p5 prd
pint < %1.inp > %1.lst 2>&1
if exist "%1" rm %1.out
mv prr %1.out
chmod +w %1.out

Changes to gpc/standard_tests/iso7185pat.cmp.

1
2
3
4
5
6
7
8
..
19
20
21
22
23
24
25


26
27
28
29
30


31
32
33
34
35
36
37
..
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
...
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
...
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
...
800
801
802
803
804
805
806

807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
....
1081
1082
1083
1084
1085
1086
1087

1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
....
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
....
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
....
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
P5 Pascal interpreter vs. 1.0

Assembling/loading program
Running program

*******************************************************************************

                 TEST SUITE FOR ISO 7185 PASCAL
................................................................................
         1111111111222222222233333333334
1234567890123456789012345678901234567890
          1
Real default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
 1.200000000000000e+00


Boolean default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
False
 True


Char default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
a
Appears to be ASCII

******************* Control structures tests *******************
................................................................................
Control7: yes s/b yes
Control8: yes stop s/b yes stop
Control9: stop s/b stop
Control10: one two three four five six seven eight nine-ten nine-ten 
Control10: s/b one two three four five six seven eight nine-ten nine-ten
Control11: start stop s/b start stop
Control12: start stop s/b start stop
Control13: start   1  2  3  4  5  6  7  8  9 10 s/b   1  2  3  4  5  6  7  8  9 10
Control14: start  10  9  8  7  6  5  4  3  2  1 s/b  10  9  8  7  6  5  4  3  2  1
Control15: start  0 1 2 3 4 5 6 7 8 9 s/b 0 1 2 3 4 5 6 7 8 9
Control16: start  9 8 7 6 5 4 3 2 1 0 s/b 9 8 7 6 5 4 3 2 1 0
Control17: start good start s/b good

******************* Integers *******************

Integer1:   121 s/b 121
Integer2:   35 s/b 35
Integer3:   3354 s/b 3354
Integer4:   1 s/b 1
................................................................................
Character53:  y s/b y
Character54:  99 s/b 99
Character55:  g s/b g
Character56:   True s/b true
Character57:  False s/b false
Character58:   True s/b true
Character59:  False s/b false
Character50:   True s/b true
Character61:  False s/b false
Character62:   True s/b true
Character63:  False s/b false
Character64:   True s/b true
Character65:   True s/b true
Character66:  False s/b false
Character67:   True s/b true
................................................................................
Scalar15:   True s/b true
Scalar16:  False s/b false
Scalar17:   True s/b true
Scalar18:   True s/b true
Scalar19:  False s/b false
Scalar20:  0 1 2 3 4 5 6 s/b 0 1 2 3 4 5 6
Scalar21:  6 5 4 3 2 1 0 s/b 6 5 4 3 2 1 0
Scalar1:    True s/b true
Scalar2:    True s/b true
Scalar3:   2 s/b 2
Scalar4:   6 s/b 6
Scalar5:    True s/b true
Scalar6:    True s/b true
Scalar7:   False s/b false
Scalar8:    True s/b true
Scalar9:   False s/b false
Scalar10:   True s/b true
Scalar11:  False s/b false
Scalar12:   True s/b true
Scalar13:  False s/b false
Scalar14:   True s/b true
Scalar15:   True s/b true
Scalar16:  False s/b false
Scalar17:   True s/b true
Scalar18:   True s/b true
Scalar19:  False s/b false

******************* Reals ******************************

Real1:    1.55400000e+00 s/b  1.554000e+00
Real2:    3.34000000e-03 s/b  3.340000e-03
Real3:    3.34000000e-24 s/b  3.34000e-24
Real4:    4.00000000e-45 s/b  4.000000e-45
Real5:   -5.56500000e+00 s/b -5.565000e+03
Real6:   -9.44000000e-03 s/b -9.440000e-03
Real7:   -6.36400000e+29 s/b -6.364000e+29
Real8:   -2.00000000e-14 s/b -2.000000e-14
Real9:
         11111111112222222222333333333344444444445
12345678901234567890123456789012345678901234567890
 1.2e+00
................................................................................
Set9:   True s/b true
Set10:  True s/b true
Set11: False s/b false
Set12:  True s/b true
Set13:  True s/b true
Set14: False s/b false
Set15: 0101010000 s/b 0101010000

Set16: a_c_e_g_i_k_m_o_q_s_ s/b a_c_e_g_i_k_m_o_q_s_
Set17: a_cd_fg___ s/b a_cd_fg___
Set18: a______h__ s/b a______h__
Set19: _b_______j s/b _b_______j
Set20: False s/b false
Set21:  True s/b true
Set22:  True s/b true
Set23: False s/b false
Set24:  True s/b true
Set25:  True s/b true
Set26: False s/b false
Set27:  True s/b true
Set28:  True s/b true
Set29: False s/b false
Set30: a___e_____ s/b a___e_____
Set31: 0101010101 s/b 0101010101
Set32: 1101110001 s/b 1101110001
Set33: 0100010000 s/b 0100010000
Set34: 0100001000 s/b 0100001000
Set35: False s/b false
Set36:  True s/b true
Set37:  True s/b true
Set38: False s/b false
Set39:  True s/b true
Set40:  True s/b true
Set41: False s/b false
Set42:  True s/b true
Set43:  True s/b true
Set44: False s/b false
Set45: 0110000000 s/b 0110000000
Set46: 01 s/b 01
Set47: 11 s/b 11
Set48: 10 s/b 10
Set49: 10 s/b 10
Set50: False s/b false
Set51:  True s/b true
Set52:  True s/b true
Set53: False s/b false
Set54:  True s/b true
Set55:  True s/b true
Set56: False s/b false
Set57:  True s/b true
Set58:  True s/b true
Set59: False s/b false
Set60: 11 s/b 11
set61:  True s/b true

******************* Pointers ******************************

Pointer1:   4594 s/b 4594
Pointer2:    True s/b  true
Pointer3:   False s/b false
Pointer4:   p s/b p
................................................................................
Record16:  19  True s/b 19  true
Record17:   True 2343 s/b  true 2343
Record18:  False  True s/b false  true
Record19:  2 2343 s/b 2 2343
Record20:  7  True s/b 7  true
Record21:  3 2343 s/b 3 2343
Record22:  4  True s/b 4  true

Record23:  1 2 3 4 5 6 7 8 9 10 s/b 1 2 3 4 5 6 7 8 9 10
Record24:  10 9 8 7 6 5 4 3 2 1 s/b 10 9 8 7 6 5 4 3 2 1
Record25:  10 9 8 7 6 5 4 3 2 76 s/b 10 9 8 7 6 5 4 3 2 76
Record26:  1 g s/b 1 g
Record27:  20 19 18 17 16 15 14 13 12 11 s/b 20 19 18 17 16 15 14 13 12 11

******************* files ******************************

File1:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File2:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File3:    True False  True False  True False  True False  True False 
   s/b:    true false  true false  true false  true false  true false
................................................................................
7384
8342
m
q
 1.2345678000e+00
 1.2345678000e+00
 5.6894321000e+01
 9.3837632000e+01
file11:
'how now<eoln> brown cow<eoln> ' s/b 'how now<eoln> brown cow<eoln> '
file12:
'too much<eoln> too soon<eoln> ' s/b 'too much<eoln> too soon<eoln> '
File13:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File14:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File15:    True False  True False  True False  True False  True False 
................................................................................
   s/b:    true false  true false  true false  true false  true false
File16:    True False  True False  True False  True False  True False 
   s/b:    true false  true false  true false  true false  true false
File17:   a b c d e f g h i j s/b a b c d e f g h i j
File18:   a b c d e f g h i j s/b a b c d e f g h i j
File19:   0 1 2 3 4 5 6 7 8 9 s/b 0 1 2 3 4 5 6 7 8 9
File20:   0 1 2 3 4 5 6 7 8 9 s/b 0 1 2 3 4 5 6 7 8 9
File21:    s/b 50
File22:    True s/b true

************ Procedures and functions ******************

ProcedureFunction1:   45 89 s/b 45 89
ProcedureFunction2:   46 s/b 46
ProcedureFunction3:   total junk s/b total junk
ProcedureFunction4:   tota? junk s/b tota? junk
total junk s/b total junk
ProcedureFunction5:   35 s/b 35
ProcedureFunction6:   10 9 8 6 5 4 3 2 1 78
s/b:   10 9 8 6 5 4 3 2 1 78
ProcedureFunction7:
93  True k 7 4 10  3.14140000e+00 hello, guy
11 12 13 14 15 16 17 18 19 20 
64 False j 1 3 12  4.54512000e-29 what ? who
................................................................................
23487 n False
help me123
abcd___h__
734
s/b:
93  true k 7 4 10  3.14140000e+00 hello, guy
11 12 13 14 15 16 17 18 19 20
64 false j 1 3 12  4.54500000e-29 what ? who
21 22 23 24 25 26 27 28 29 30
2324 y
_bcde___i_
8454
23487 n false
help me123
abcd___h__
|







 







>
>





>
>







 







|
|
|
|
|







 







|







 







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







|







 







>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







 







>
|
|
|
|
|







 







|







 







|








|







 







|







1
2
3
4
5
6
7
8
..
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
..
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
...
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
...
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
...
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
....
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
....
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
....
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
....
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
P5 Pascal interpreter vs. 1.2.x

Assembling/loading program
Running program

*******************************************************************************

                 TEST SUITE FOR ISO 7185 PASCAL
................................................................................
         1111111111222222222233333333334
1234567890123456789012345678901234567890
          1
Real default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
 1.200000000000000e+00
Note that the exponent character 'e' or 'E' is implementation
defined as well as the number of exponent digits
Boolean default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
False
 True
Note that the upper or lower case state of the characters in
'true' and 'false' are implementation defined
Char default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
a
Appears to be ASCII

******************* Control structures tests *******************
................................................................................
Control7: yes s/b yes
Control8: yes stop s/b yes stop
Control9: stop s/b stop
Control10: one two three four five six seven eight nine-ten nine-ten 
Control10: s/b one two three four five six seven eight nine-ten nine-ten
Control11: start stop s/b start stop
Control12: start stop s/b start stop
Control13: start   1  2  3  4  5  6  7  8  9 10 s/b start  1  2  3  4  5  6  7  8  9 10
Control14: start  10  9  8  7  6  5  4  3  2  1 s/b start 10  9  8  7  6  5  4  3  2  1
Control15: start  0 1 2 3 4 5 6 7 8 9 s/b start 0 1 2 3 4 5 6 7 8 9
Control16: start  9 8 7 6 5 4 3 2 1 0 s/b start 9 8 7 6 5 4 3 2 1 0
Control17: start good start s/b start good

******************* Integers *******************

Integer1:   121 s/b 121
Integer2:   35 s/b 35
Integer3:   3354 s/b 3354
Integer4:   1 s/b 1
................................................................................
Character53:  y s/b y
Character54:  99 s/b 99
Character55:  g s/b g
Character56:   True s/b true
Character57:  False s/b false
Character58:   True s/b true
Character59:  False s/b false
Character60:   True s/b true
Character61:  False s/b false
Character62:   True s/b true
Character63:  False s/b false
Character64:   True s/b true
Character65:   True s/b true
Character66:  False s/b false
Character67:   True s/b true
................................................................................
Scalar15:   True s/b true
Scalar16:  False s/b false
Scalar17:   True s/b true
Scalar18:   True s/b true
Scalar19:  False s/b false
Scalar20:  0 1 2 3 4 5 6 s/b 0 1 2 3 4 5 6
Scalar21:  6 5 4 3 2 1 0 s/b 6 5 4 3 2 1 0
Scalar20:    True s/b true
Scalar21:    True s/b true
Scalar22:   2 s/b 2
Scalar23:   6 s/b 6
Scalar24:    True s/b true
Scalar25:    True s/b true
Scalar26:   False s/b false
Scalar27:    True s/b true
Scalar28:   False s/b false
Scalar29:   True s/b true
Scalar30:  False s/b false
Scalar31:   True s/b true
Scalar32:  False s/b false
Scalar33:   True s/b true
Scalar34:   True s/b true
Scalar35:  False s/b false
Scalar36:   True s/b true
Scalar37:   True s/b true
Scalar38:  False s/b false

******************* Reals ******************************

Real1:    1.55400000e+00 s/b  1.554000e+00
Real2:    3.34000000e-03 s/b  3.340000e-03
Real3:    3.34000000e-24 s/b  3.34000e-24
Real4:    4.00000000e-45 s/b  4.000000e-45
Real5:   -5.56500000e+00 s/b -5.565000e+00
Real6:   -9.44000000e-03 s/b -9.440000e-03
Real7:   -6.36400000e+29 s/b -6.364000e+29
Real8:   -2.00000000e-14 s/b -2.000000e-14
Real9:
         11111111112222222222333333333344444444445
12345678901234567890123456789012345678901234567890
 1.2e+00
................................................................................
Set9:   True s/b true
Set10:  True s/b true
Set11: False s/b false
Set12:  True s/b true
Set13:  True s/b true
Set14: False s/b false
Set15: 0101010000 s/b 0101010000
Set16:  True s/b true
Set17: a_c_e_g_i_k_m_o_q_s_ s/b a_c_e_g_i_k_m_o_q_s_
Set18: a_cd_fg___ s/b a_cd_fg___
Set19: a______h__ s/b a______h__
Set20: _b_______j s/b _b_______j
Set21: False s/b false
Set22:  True s/b true
Set23:  True s/b true
Set24: False s/b false
Set25:  True s/b true
Set26:  True s/b true
Set27: False s/b false
Set28:  True s/b true
Set29:  True s/b true
Set30: False s/b false
Set31: a___e_____ s/b a___e_____
Set32: 0101010101 s/b 0101010101
Set33: 1101110001 s/b 1101110001
Set34: 0100010000 s/b 0100010000
Set35: 0100001000 s/b 0100001000
Set36: False s/b false
Set37:  True s/b true
Set38:  True s/b true
Set39: False s/b false
Set40:  True s/b true
Set41:  True s/b true
Set42: False s/b false
Set43:  True s/b true
Set44:  True s/b true
Set45: False s/b false
Set46: 0110000000 s/b 0110000000
Set47: 01 s/b 01
Set48: 11 s/b 11
Set49: 10 s/b 10
Set50: 10 s/b 10
Set51: False s/b false
Set52:  True s/b true
Set53:  True s/b true
Set54: False s/b false
Set55:  True s/b true
Set56:  True s/b true
Set57: False s/b false
Set58:  True s/b true
Set59:  True s/b true
Set60: False s/b false
Set61: 11 s/b 11
set62:  True s/b true

******************* Pointers ******************************

Pointer1:   4594 s/b 4594
Pointer2:    True s/b  true
Pointer3:   False s/b false
Pointer4:   p s/b p
................................................................................
Record16:  19  True s/b 19  true
Record17:   True 2343 s/b  true 2343
Record18:  False  True s/b false  true
Record19:  2 2343 s/b 2 2343
Record20:  7  True s/b 7  true
Record21:  3 2343 s/b 3 2343
Record22:  4  True s/b 4  true
Record23:  42 s/b 42
Record24:  1 2 3 4 5 6 7 8 9 10 s/b 1 2 3 4 5 6 7 8 9 10
Record25:  10 9 8 7 6 5 4 3 2 1 s/b 10 9 8 7 6 5 4 3 2 1
Record26:  10 9 8 7 6 5 4 3 2 76 s/b 10 9 8 7 6 5 4 3 2 76
Record27:  1 g s/b 1 g
Record28:  20 19 18 17 16 15 14 13 12 11 s/b 20 19 18 17 16 15 14 13 12 11

******************* files ******************************

File1:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File2:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File3:    True False  True False  True False  True False  True False 
   s/b:    true false  true false  true false  true false  true false
................................................................................
7384
8342
m
q
 1.2345678000e+00
 1.2345678000e+00
 5.6894321000e+01
 9.3837632000e-01
file11:
'how now<eoln> brown cow<eoln> ' s/b 'how now<eoln> brown cow<eoln> '
file12:
'too much<eoln> too soon<eoln> ' s/b 'too much<eoln> too soon<eoln> '
File13:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File14:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File15:    True False  True False  True False  True False  True False 
................................................................................
   s/b:    true false  true false  true false  true false  true false
File16:    True False  True False  True False  True False  True False 
   s/b:    true false  true false  true false  true false  true false
File17:   a b c d e f g h i j s/b a b c d e f g h i j
File18:   a b c d e f g h i j s/b a b c d e f g h i j
File19:   0 1 2 3 4 5 6 7 8 9 s/b 0 1 2 3 4 5 6 7 8 9
File20:   0 1 2 3 4 5 6 7 8 9 s/b 0 1 2 3 4 5 6 7 8 9
File21:   50 s/b 50
File22:    True s/b true

************ Procedures and functions ******************

ProcedureFunction1:   45 89 s/b 45 89
ProcedureFunction2:   46 s/b 46
ProcedureFunction3:   total junk s/b total junk
ProcedureFunction4:   tota? junk s/b tota? junk
                      total junk s/b total junk
ProcedureFunction5:   35 s/b 35
ProcedureFunction6:   10 9 8 6 5 4 3 2 1 78
s/b:   10 9 8 6 5 4 3 2 1 78
ProcedureFunction7:
93  True k 7 4 10  3.14140000e+00 hello, guy
11 12 13 14 15 16 17 18 19 20 
64 False j 1 3 12  4.54512000e-29 what ? who
................................................................................
23487 n False
help me123
abcd___h__
734
s/b:
93  true k 7 4 10  3.14140000e+00 hello, guy
11 12 13 14 15 16 17 18 19 20
64 false j 1 3 12  4.54512000e-29 what ? who
21 22 23 24 25 26 27 28 29 30
2324 y
_bcde___i_
8454
23487 n false
help me123
abcd___h__

Changes to gpc/standard_tests/iso7185pats.cmp.

1
2
3
4
5
6
7
8
9
10
11
12
13
..
24
25
26
27
28
29
30


31
32
33
34
35


36
37
38
39
40
41
42
P5 Pascal interpreter vs. 1.0

Assembling/loading program
Running program

P5 Pascal interpreter vs. 1.0

Assembling/loading program
Running program

*******************************************************************************

                 TEST SUITE FOR ISO 7185 PASCAL
................................................................................
         1111111111222222222233333333334
1234567890123456789012345678901234567890
          1
Real default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
 1.200000000000000e+00


Boolean default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
False
 True


Char default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
a
Appears to be ASCII

******************* Control structures tests *******************
|




|







 







>
>





>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
..
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
P5 Pascal interpreter vs. 1.2

Assembling/loading program
Running program

P5 Pascal interpreter vs. 1.2

Assembling/loading program
Running program

*******************************************************************************

                 TEST SUITE FOR ISO 7185 PASCAL
................................................................................
         1111111111222222222233333333334
1234567890123456789012345678901234567890
          1
Real default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
 1.200000000000000e+00
Note that the exponent character 'e' or 'E' is implementation
defined as well as the number of exponent digits
Boolean default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
False
 True
Note that the upper or lower case state of the characters in
'true' and 'false' are implementation defined
Char default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
a
Appears to be ASCII

******************* Control structures tests *******************

Added ip_pascal/Makefile.































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
#
# Makefile for Pascal-p5 using IP Pascal
#
# Makes the main compiler interpreter settings.
#
all: pcom pint

pcom: source\pcom.pas
	pc source\pcom.pas/nrf
	mv source\pcom.exe bin
	
pint: source\pint.pas
	pc source\pint/nrf
	mv source\pint.exe bin
	
clean:
	rm -f bin\pcom.exe bin\pint.exe 
	find . -name "*.p5" -type f -delete
	find . -name "*.out" -type f -delete
	find . -name "*.lst" -type f -delete
	find . -name "*.obj" -type f -delete
	find . -name "*.sym" -type f -delete
	find . -name "*.int" -type f -delete
	find . -name "*.dif" -type f -delete
	find . -name "*.err" -type f -delete
	find . -name "*.tmp" -type f -delete
	find . -name "prd" -type f -delete
	find . -name "prr" -type f -delete
	find . -name "temp" -type f -delete
	find . -name "tmp" -type f -delete
	find . -name "*~" -type f -delete

Changes to ip_pascal/compile.

Changes to ip_pascal/compile.bat.

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
..
53
54
55
56
57
58
59

60
61
62
63
64
65
66
67

rem <file>.p5  - The intermediate file produced
rem <file>.err - The errors output from the compiler
rem
rem Note that the l+ option must be specified to get a full
rem listing in the .err file (or just a lack of l-).
rem

rem
rem Check there is a parameter
rem
if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop
:paramok

rem
rem Check the source file exists
rem
if exist "%1.pas" goto fileexists
echo *** Error: Missing %1.pas file
goto stop
:fileexists

rem
rem Run the compile
rem
pcom %1.p5 < %1.pas > %1.err

rem
rem Set the error status of the compile
rem
rem This will be zero if the compile was sucessful
rem
grep "Errors in program: 0" %1.err > %1.tmp
................................................................................

    rem
    rem For failed compiles, remove the intermediate file
    rem so it can't be run.
    rem
    echo Compile fails, examine the %1.err file
    del %1.p5


)
rem del %1.tmp

rem
rem Terminate
rem
:stop








|
|
|
|
|
|
|
|
|
|
|
|
|
<
<




|







 







>








>
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36


37
38
39
40
41
42
43
44
45
46
47
48
..
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
rem <file>.p5  - The intermediate file produced
rem <file>.err - The errors output from the compiler
rem
rem Note that the l+ option must be specified to get a full
rem listing in the .err file (or just a lack of l-).
rem

if "%1"=="" (

    echo *** Error: Missing parameter
    exit /b 1

)

if not exist "%1.pas" (

    echo *** Error: Missing %1.pas file
    exit /b 1

)



rem
rem Run the compile
rem
pcom %1.pas %1.p5 > %1.err

rem
rem Set the error status of the compile
rem
rem This will be zero if the compile was sucessful
rem
grep "Errors in program: 0" %1.err > %1.tmp
................................................................................

    rem
    rem For failed compiles, remove the intermediate file
    rem so it can't be run.
    rem
    echo Compile fails, examine the %1.err file
    del %1.p5
    exit /b 1

)
rem del %1.tmp

rem
rem Terminate
rem
:stop
exit /b 0

Changes to ip_pascal/p5.

Changes to ip_pascal/p5.bat.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17





18
19
20
21
22

23
24
25

26




27

28
29
30
31


32
33
34
35







36


@echo off
rem
rem Compile with P5 using IP Pascal
rem
rem Execute with:
rem
rem p5 <file>
rem
rem where <file> is the name of the source file without
rem extention. The Pascal file is compiled and run.
rem Any compiler errors are output to the screen. Input
rem and output to and from the running program are from
rem the console, but output to the prr file is placed
rem in <file>.out.

rem The intermediate code is placed in <file>.p5.
rem






if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop
:paramok


if exist "%1.pas" goto fileexists
echo *** Error: Missing %1.pas file
goto stop

:fileexists






echo.
echo Compiling and running %1
echo.
pcom %1.p5 < %1.pas


pint %1.p5 %1.out
rem
rem Terminate
rem







:stop








|

|




|
>


<
>
>
>
>
>



<

>



>

>
>
>
>

>



|
>
>
|
<
<
|
>
>
>
>
>
>
>

>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45


46
47
48
49
50
51
52
53
54
55
56
@echo off
rem
rem Compile with P5 using IP Pascal
rem
rem Execute with:
rem
rem p5 <sourcefile> [<inputfile>[<outputfile>]]
rem
rem where <sourcefile> is the name of the source file without
rem extention. The Pascal file is compiled and run.
rem Any compiler errors are output to the screen. Input
rem and output to and from the running program are from
rem the console, but output to the prr file is placed
rem in <sourcefile>.out.
rem
rem The intermediate code is placed in <file>.p5.
rem

rem If <inputfile> and <outputfile> are specified, then these will be
rem placed as input to the "prd" file, and output from the "prr" file.
rem Note that the prd file cannot or should not be reset, since that
rem would cause it to back up to the start of the intermediate code.
rem
if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop


:paramok
if exist "%1.pas" goto fileexists
echo *** Error: Missing %1.pas file
goto stop

:fileexists
if "%2"=="" goto continue
if exist "%2" goto continue
echo *** Error: Missing %2 input file
goto stop

:continue
echo.
echo Compiling and running %1
echo.
pcom %1.pas %1.p5

if not "%2"=="" goto useinputfile
cp %1.p5 temp1


goto run
:useinputfile
rem The input file, if it exists, gets put on the end of the intermediate
cat %1.p5 %2 > temp1
:run
pint temp1 temp2
if "%3"=="" goto stop
cp temp2 %3
:stop
rm -f temp1
rm -f temp2

Changes to ip_pascal/run.

Changes to ip_pascal/run.bat.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34






35
36
37
38
39
40
rem
rem <file>.p5  - The intermediate file
rem <file>.out - The prr file produced
rem <file>.inp - The input file to the program
rem <file>.lst - The output file from the program
rem

if not "%1"=="" goto paramok
echo *** Error: Missing parameter
goto stop
:paramok

if exist "%1.p5" goto fileexists1
echo *** Error: Missing %1.p5 file
goto stop
:fileexists1

if exist "%1.inp" goto fileexists2
echo *** Error: Missing %1.inp file
goto stop
:fileexists2







pint %1.p5 %1.out < %1.inp > %1.lst
rem
rem Terminate
rem
:stop







|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>






14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
rem
rem <file>.p5  - The intermediate file
rem <file>.out - The prr file produced
rem <file>.inp - The input file to the program
rem <file>.lst - The output file from the program
rem

if "%1"=="" (

    echo *** Error: Missing parameter
    exit /b 1

)

if not exist "%1.p5" (

    echo *** Error: Missing %1.p5 file
    exit /b 1

)

if not exist "%1.inp" (

    echo *** Error: Missing %1.inp file
    exit /b 1

)

pint %1.p5 %1.out < %1.inp > %1.lst
rem
rem Terminate
rem
:stop

Changes to ip_pascal/standard_tests/iso7185pat.cmp.

1
2
3
4
5
6
7
8
..
19
20
21
22
23
24
25


26
27
28
29
30


31
32
33
34
35
36
37
....
1081
1082
1083
1084
1085
1086
1087

1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
P5 Pascal interpreter vs. 1.0

Assembling/loading program
Running program

*******************************************************************************

                 TEST SUITE FOR ISO 7185 PASCAL
................................................................................
         1111111111222222222233333333334
1234567890123456789012345678901234567890
          1
Real default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
 1.20000000000000e+000


Boolean default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
false
 true


Char default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
a
Appears to be ASCII

******************* Control structures tests *******************
................................................................................
Record16:  19  true s/b 19  true
Record17:   true 2343 s/b  true 2343
Record18:  false  true s/b false  true
Record19:  2 2343 s/b 2 2343
Record20:  7  true s/b 7  true
Record21:  3 2343 s/b 3 2343
Record22:  4  true s/b 4  true

Record23:  1 2 3 4 5 6 7 8 9 10 s/b 1 2 3 4 5 6 7 8 9 10
Record24:  10 9 8 7 6 5 4 3 2 1 s/b 10 9 8 7 6 5 4 3 2 1
Record25:  10 9 8 7 6 5 4 3 2 76 s/b 10 9 8 7 6 5 4 3 2 76
Record26:  1 g s/b 1 g
Record27:  20 19 18 17 16 15 14 13 12 11 s/b 20 19 18 17 16 15 14 13 12 11

******************* files ******************************

File1:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File2:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File3:    true false  true false  true false  true false  true false 
   s/b:    true false  true false  true false  true false  true false
|







 







>
>





>
>







 







>
|
|
|
|
|







1
2
3
4
5
6
7
8
..
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
....
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
P5 Pascal interpreter vs. 1.2

Assembling/loading program
Running program

*******************************************************************************

                 TEST SUITE FOR ISO 7185 PASCAL
................................................................................
         1111111111222222222233333333334
1234567890123456789012345678901234567890
          1
Real default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
 1.20000000000000e+000
Note that the exponent character 'e' or 'E' is implementation
defined as well as the number of exponent digits
Boolean default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
false
 true
Note that the upper or lower case state of the characters in
'true' and 'false' are implementation defined
Char default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
a
Appears to be ASCII

******************* Control structures tests *******************
................................................................................
Record16:  19  true s/b 19  true
Record17:   true 2343 s/b  true 2343
Record18:  false  true s/b false  true
Record19:  2 2343 s/b 2 2343
Record20:  7  true s/b 7  true
Record21:  3 2343 s/b 3 2343
Record22:  4  true s/b 4  true
Record23:  42 s/b 42
Record24:  1 2 3 4 5 6 7 8 9 10 s/b 1 2 3 4 5 6 7 8 9 10
Record25:  10 9 8 7 6 5 4 3 2 1 s/b 10 9 8 7 6 5 4 3 2 1
Record26:  10 9 8 7 6 5 4 3 2 76 s/b 10 9 8 7 6 5 4 3 2 76
Record27:  1 g s/b 1 g
Record28:  20 19 18 17 16 15 14 13 12 11 s/b 20 19 18 17 16 15 14 13 12 11

******************* files ******************************

File1:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File2:   11 12 13 14 15 16 17 18 19 20 s/b 11 12 13 14 15 16 17 18 19 20
File3:    true false  true false  true false  true false  true false 
   s/b:    true false  true false  true false  true false  true false

Changes to ip_pascal/standard_tests/iso7185pats.cmp.

1
2
3
4
5
6
7
8
9
10
11
12
13
..
24
25
26
27
28
29
30


31
32
33
34
35


36
37
38
39
40
41
42
P5 Pascal interpreter vs. 1.0

Assembling/loading program
Running program

P5 Pascal interpreter vs. 1.0

Assembling/loading program
Running program

*******************************************************************************

                 TEST SUITE FOR ISO 7185 PASCAL
................................................................................
         1111111111222222222233333333334
1234567890123456789012345678901234567890
          1
Real default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
 1.20000000000000e+000


Boolean default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
false
 true


Char default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
a
Appears to be ASCII

******************* Control structures tests *******************
|




|







 







>
>





>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
..
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
P5 Pascal interpreter vs. 1.2

Assembling/loading program
Running program

P5 Pascal interpreter vs. 1.2

Assembling/loading program
Running program

*******************************************************************************

                 TEST SUITE FOR ISO 7185 PASCAL
................................................................................
         1111111111222222222233333333334
1234567890123456789012345678901234567890
          1
Real default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
 1.20000000000000e+000
Note that the exponent character 'e' or 'E' is implementation
defined as well as the number of exponent digits
Boolean default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
false
 true
Note that the upper or lower case state of the characters in
'true' and 'false' are implementation defined
Char default output field
         1111111111222222222233333333334
1234567890123456789012345678901234567890
a
Appears to be ASCII

******************* Control structures tests *******************

Added p2/pasint.pas.

































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960

(* ASSEMBLER AND INTERPRETER OF PASCAL CODE.  K.JENSEN, N.WIRTH, E.T.H. 15.3.73 *)
PROGRAM PCODE(INPUT,OUTPUT,PRD,PRR);
(* NOTE FOR THE IMPLEMENTATION.
   ===========================
THIS INTERPRETER IS WRITTEN FOR THE CASE WHERE ALL THE FUNDAMENTAL
TYPES TAKE ONE STORAGE UNIT.
IN AN IMPLEMENTATION ALL THE HANDLING OF THE SP POINTER HAS TO TAKE
INTO ACCOUNT THE FACT TAHT THE TYPES MAY HAVE A LENGTH DIFFERENT FROM
ONE. SO IN PUSH AND POP OPERATIONS THE IMPLEMENTOR HAS TO INCREASE
AND DECREASE THE SP NOT BY 1 BUT BY A NUMBER DEPENDING ON THE TYPE
CONCERNED.
WHERE A COMMENT SAYS THAT SOME VARIABLE IS EXPRESSED 'IN UNITS OF
STORAGE' THE VALUE OF THIS VARIABLE MUST NOT BE CORRECTED, BECAUSE
THE COMPILER HAS COMPUTED IT TAKING INTO ACCOUNT THE LENGTHS OF THE
TYPES INVOLVED.
THE SAME HOLDS FOR THE HANDLING OF THE NP POINTER (WHICH MUST NOT BE
CORRECTED)                                                       *)

(*****************************************************
 *                                                   *
 * CONVERTED TO ISO 7185 PASCAL BY SCOTT A. MOORE    *
 * [SAM] ON JAN 22, 2011.                            *
 *                                                   *
 * VARIOUS CHANGES WERE MADE, ALL MARKED WITH MY     *
 * INITIALS THUS [SAM]. THERE ARE COMMENTS FOR ALL   *
 * CHANGES MADE. THE ONLY OTHERS WERE MINOR FORMAT   *
 * GLITCHES, APPARENTLY DUE TO SEVERAL EOLS          *
 * INSERTED AT VARIOUS PLACES INTO THE CODE.         *
 *                                                   *
 *****************************************************)

LABEL 1;
CONST  CODEMAX     = 6735;  (* SIZE OF PROGRAM AREA *)
       PCMAX       = 13470; (* 2 * CODEMAX *)
       MAXSTK      = 13650; (* SIZE OF VARIABLE STORE *)
       OVERI       = 13655; (* SIZE OF INTEGER CONSTANT TABLE = 5 *)
       OVERR       = 13660; (* SIZE OF REAL CONSTANT TABLE = 5 *)
       OVERS       = 13730; (* SIZE OF SET CONSTANT TABLE = 70 *)
       OVERB       = 13734; (* SIZE OF BOUNDARY CONSTANT TABLE = 4 *)
       OVERM       = 15034; (* SIZE OF MULTIPLE CONSTANT TABLE = 1300 *)
       MAXSTR      = 15035;
       LARGEINT    = 524288;  (* = 2**19 *)
       BEGINCODE   = 3;
       INPUTADR    = 4;    (* ABSOLUTE ADDRESS *)
       OUTPUTADR   = 5;
       PRDADR      = 6;
       PRRADR      = 7;

TYPE  BIT4         = 0..15;
      BIT6         = 0..63;
      BIT20        = -524287..524287;
      DATATYPE     = (UNDEF,INT,REEL,BOOL,SETT,ADR,MARK);
      ADDRESS      = -1..MAXSTR;
      BETA         = PACKED ARRAY[1..25] OF CHAR; (*ERROR MESSAGE*)
      { ALFA WAS APPARENTLY A COMPILER DEFINED TYPE. [SAM] }
      ALFA = PACKED ARRAY [1..10] OF CHAR;

VAR  CODE          : ARRAY[0..CODEMAX] OF   (* THE PROGRAM *)
                     PACKED RECORD  OP1    :BIT6;
                                    P1     :BIT4;
                                    Q1     :BIT20;
                                    OP2    :BIT6;
                                    P2     :BIT4;
                                    Q2     :BIT20
                            END;
     PC            : 0..PCMAX;  (*PROGRAM ADDRESS REGISTER*)
     OP : BIT6;  P : BIT4;  Q : BIT20;  (*INSTRUCTION REGISTER*)

     STORE         : ARRAY [0..OVERM] OF
                        RECORD  CASE STYPE :DATATYPE OF
                                UNDEF      :(); { ISO 7185 requires all cases present. [sam] }
                                INT        :(VI :INTEGER);
                                REEL       :(VR :REAL);
                                BOOL       :(VB :BOOLEAN);
                                SETT       :(VS :SET OF 0..58);
                                ADR        :(VA :ADDRESS); (*ADDRESS IN STORE*)
                                MARK       :(VM :INTEGER);
                        END;
     MP,SP,NP      : ADDRESS;  (* ADDRESS REGISTERS *)
     (*MP  POINTS TO BEGINNING OF A DATA SEGMENT
      SP  POINTS TO TOP OF THE STACK
      NP  POINTS TO TOP OF DYNAMICLY ALLOCATED AREA*)

     INTERPRETING  : BOOLEAN;
     { PRD,PRR: TEXT; } (*PRD FOR READ ONLY, PRR FOR WRITE ONLY *)

     INSTR         : ARRAY[BIT6] OF ALFA; (* MNEMONIC INSTRUCTION CODES *)
     SPTABLE       : ARRAY[0..20] OF ALFA; (* STANDARD FUNCTIONS AND  PROCEDURES *)


(*-----------------------------------------------------------------------------*)

PROCEDURE LOAD;
   CONST MAXLABEL = 1550; (* COMPLETE COMPILER PROCESSING *)
   TYPE  LABELST  = (ENTERED,DEFINED); (*LABEL SITUATION*)
         LABELRG  = 0..MAXLABEL;   (*LABEL RANGE*)
         LABELREC = RECORD
                          VAL: ADDRESS;
                           ST: LABELST
                    END;
   VAR  ICP,RCP,SCP,BCP,MCP  : ADDRESS;  (*POINTERS TO NEXT FREE POSITION*)
        WORD : ARRAY[1..10] OF CHAR; I  : INTEGER;  CH  : CHAR;
        LABELTAB: ARRAY[LABELRG] OF LABELREC;
        LABELVALUE: ADDRESS;

   PROCEDURE INIT;
      VAR I: INTEGER;
   BEGIN INSTR[ 0]:='LOD       '; INSTR[ 1]:='LDO       ';
         INSTR[ 2]:='STR       '; INSTR[ 3]:='SRO       ';
         INSTR[ 4]:='LDA       '; INSTR[ 5]:='LAO       ';
         INSTR[ 6]:='STO       '; INSTR[ 7]:='LDC       ';
         INSTR[ 8]:='...       '; INSTR[ 9]:='IND       ';
         INSTR[10]:='INC       '; INSTR[11]:='MST       ';
         INSTR[12]:='CUP       '; INSTR[13]:='ENT       ';
         INSTR[14]:='RET       '; INSTR[15]:='CSP       ';
         INSTR[16]:='IXA       '; INSTR[17]:='EQU       ';
         INSTR[18]:='NEQ       '; INSTR[19]:='GEQ       ';
         INSTR[20]:='GRT       '; INSTR[21]:='LEQ       ';
         INSTR[22]:='LES       '; INSTR[23]:='UJP       ';
         INSTR[24]:='FJP       '; INSTR[25]:='XJP       ';
         INSTR[26]:='CHK       '; INSTR[27]:='EOF       ';
         INSTR[28]:='ADI       '; INSTR[29]:='ADR       ';
         INSTR[30]:='SBI       '; INSTR[31]:='SBR       ';
         INSTR[32]:='SGS       '; INSTR[33]:='FLT       ';
         INSTR[34]:='FLO       '; INSTR[35]:='TRC       ';
         INSTR[36]:='NGI       '; INSTR[37]:='NGR       ';
         INSTR[38]:='SQI       '; INSTR[39]:='SQR       ';
         INSTR[40]:='ABI       '; INSTR[41]:='ABR       ';
         INSTR[42]:='NOT       '; INSTR[43]:='AND       ';
         INSTR[44]:='IOR       '; INSTR[45]:='DIF       ';
         INSTR[46]:='INT       '; INSTR[47]:='UNI       ';
         INSTR[48]:='INN       '; INSTR[49]:='MOD       ';
         INSTR[50]:='ODD       '; INSTR[51]:='MPI       ';
         INSTR[52]:='MPR       '; INSTR[53]:='DVI       ';
         INSTR[54]:='DVR       '; INSTR[55]:='MOV       ';
         INSTR[56]:='LCA       '; INSTR[57]:='DEC       ';
         INSTR[58]:='STP       ';

         SPTABLE[ 0]:='GET       '; SPTABLE[ 1]:='PUT       ';
         SPTABLE[ 2]:='RST       '; SPTABLE[ 3]:='RLN       ';
         SPTABLE[ 4]:='NEW       '; SPTABLE[ 5]:='WLN       ';
         SPTABLE[ 6]:='WRS       '; SPTABLE[ 7]:='ELN       ';
         SPTABLE[ 8]:='WRI       '; SPTABLE[ 9]:='WRR       ';
         SPTABLE[10]:='WRC       '; SPTABLE[11]:='RDI       ';
         SPTABLE[12]:='RDR       '; SPTABLE[13]:='RDC       ';
         SPTABLE[14]:='SIN       '; SPTABLE[15]:='COS       ';
         SPTABLE[16]:='EXP       '; SPTABLE[17]:='LOG       ';
         SPTABLE[18]:='SQT       '; SPTABLE[19]:='ATN       ';
         SPTABLE[20]:='SAV       ';
         PC:= BEGINCODE;
         ICP:= MAXSTK+1; FOR I:= ICP TO OVERI DO STORE[I].STYPE:= INT;
         RCP:= OVERI+1; FOR I:= RCP TO OVERR DO STORE[I].STYPE:= REEL;
         SCP:= OVERR+1; FOR I:= SCP TO OVERS DO STORE[I].STYPE:= SETT;
         BCP:= OVERS+2; FOR I:= OVERS+1 TO OVERB DO STORE[I].STYPE:= INT;
         MCP:= OVERB+1; FOR I:= MCP TO OVERM DO STORE[I].STYPE:= INT;
         FOR I:= 1 TO 10 DO WORD[I]:= ' ';
         FOR I:= 0 TO MAXLABEL DO
             WITH LABELTAB[I] DO BEGIN VAL:=-1; ST:= ENTERED END;
         { RESET(PRD); }
   END;(*INIT*)
   PROCEDURE ERRORL(STRING: BETA); (*ERROR IN LOADING*)
   BEGIN WRITELN;
         WRITE(STRING); GOTO 1 (* TO END PROGRAM PCODE*)
   END; (*ERRORL*)
   PROCEDURE UPDATE(X: LABELRG); (*WHEN A LABEL DEFINITION LX IS FOUND*)
      VAR CURR,SUCC: -1..PCMAX; (*RESP. CURRENT ELEMENT AND SUCCESSOR ELEMENT
                                      OF A LIST OF FUTURE REFERENCE*)
          ENDLIST: BOOLEAN;
   BEGIN
      IF LABELTAB[X].ST=DEFINED THEN ERRORL(' DUPLICATED LABEL        ')
      ELSE BEGIN
             IF LABELTAB[X].VAL<>-1 THEN (*FORWARD REFERENCE(S)*)
             BEGIN CURR:= LABELTAB[X].VAL; ENDLIST:= FALSE;
                WHILE NOT ENDLIST DO
                      WITH CODE[CURR DIV 2] DO
                      BEGIN
                         IF ODD(CURR) THEN BEGIN SUCC:= Q2;
                                                 Q2:= LABELVALUE
                                           END
                                          ELSE BEGIN SUCC:= Q1;
                                                     Q1:= LABELVALUE
                                               END;
                         IF SUCC=-1 THEN ENDLIST:= TRUE
                                    ELSE CURR:= SUCC
                      END;
              END;
              LABELTAB[X].ST:= DEFINED;
              LABELTAB[X].VAL:= LABELVALUE;
           END
   END;(*UPDATE*)
   PROCEDURE ASSEMBLE; FORWARD;
   PROCEDURE GENERATE;(*GENERATE SEGMENT OF CODE*)
      VAR X: INTEGER; (* LABEL NUMMER *)
   BEGIN
      WHILE NOT EOLN(PRD) DO
            BEGIN READ(PRD,CH);(* FIRST LINE OF CHARACTER*)
                  CASE CH OF
                       'I': READLN(PRD);
                       'L': BEGIN READ(PRD,X);
                                  IF NOT EOLN(PRD) THEN READ(PRD,CH);
                                  IF CH='=' THEN READ(PRD,LABELVALUE)
                                            ELSE LABELVALUE:= PC;
                                  UPDATE(X); READLN(PRD);
                            END;
                       ' ': BEGIN READ(PRD,CH); ASSEMBLE END
                  END;
            END
   END; (*GENERATE*)
   PROCEDURE ASSEMBLE; (*TRANSLATE SYMBOLIC CODE INTO MACHINE CODE AND STORE*)
      VAR NAME :ALFA;  B :BOOLEAN;  R :REAL;  S :SET OF 0..58;
          C1 :CHAR;  I,S1,LB,UB :INTEGER;
      PROCEDURE LOOKUP(X: LABELRG); (* SEARCH IN LABEL TABLE*)
      BEGIN CASE LABELTAB[X].ST OF
            ENTERED:IF LABELTAB[X].VAL=-1 THEN BEGIN LABELTAB[X].VAL:=PC;
                                                     Q:=-1(*NIL=-1*)
                                               END
                    ELSE BEGIN Q:=LABELTAB[X].VAL;
                               LABELTAB[X].VAL:=PC
                         END;
           DEFINED: Q:= LABELTAB[X].VAL
           END(*CASE LABEL..*)
      END;(*LOOKUP*)
      PROCEDURE LABELSEARCH;
         VAR X: LABELRG;
      BEGIN WHILE (CH<>'L') AND NOT EOLN(PRD) DO READ(PRD,CH);
            READ(PRD,X); LOOKUP(X)
      END;(*LABELSEARCH*)

      PROCEDURE GETNAME;
      BEGIN  WORD[1] := CH;
         READ(PRD,WORD[2],WORD[3]);
         IF NOT EOLN(PRD) THEN READ(PRD,CH) (*NEXT CHARACTER*);
         PACK(WORD,1,NAME)
      END; (*GETNAME*)

   BEGIN  P := 0;  Q := 0;  OP := 0;
      GETNAME;
      WHILE INSTR[OP]<>NAME DO OP := OP+1;

      CASE OP OF  (* GET PARAMETERS P,Q *)

          (*EQU,NEQ,GEQ,GRT,LEQ,LES*)
          17,18,19,
          20,21,22 :    BEGIN CASE CH OF
                              'A': ; (*P = 0*)
                              'I': P := 1;
                              'R': P := 2;
                              'B': P := 3;
                              'S': P := 4;
                              'M' :BEGIN P := 5;
                                     READ(PRD,Q)
                                   END
                              END
                          END;

          (*LOD,STR,LDA*)
          0,2,4 : READ(PRD,P,Q);
          12 (*CUP*): BEGIN READ(PRD,P); LABELSEARCH END;

          11 (*MST*) :    READ(PRD,P);

          14 (*RET*) : CASE CH OF
                            'P': P:=0;
                            'I': P:=1;
                            'R': P:=2;
                            'C': P:=3;
                            'B': P:=4;
                            'A': P:= 5
                       END;

          (*LDO,SRO,LAO,IND,INC,IXA,MOV,DEC*)
          1,3,5,9,10,
          16,55,57: READ(PRD,Q);
          (*ENT,UJP,FJP,XJP*)
          13,23,24,25: LABELSEARCH;

          15 (*CSP*) :    BEGIN FOR I:=1 TO 9 DO READ(PRD,CH); GETNAME;
                           WHILE NAME<>SPTABLE[Q] DO  Q := Q+1
                          END;

          7 (*LDC*) :     BEGIN CASE CH OF  (*GET Q*)
                           'I' :BEGIN  P := 1;  READ(PRD,I);
                                   IF ABS(I)>=LARGEINT THEN
                                   BEGIN  OP := 8;
                                      STORE[ICP].VI := I;  Q := MAXSTK;
                                      REPEAT  Q := Q+1  UNTIL STORE[Q].VI=I;
                                      IF Q=ICP THEN
                                      BEGIN  ICP := ICP+1;
                                         IF ICP=OVERI THEN ERRORL(' INTEGER TABLE OVERFLOW  ')
                                      END
                                   END  ELSE Q := I
                                END;

                           'R' :BEGIN  OP := 8; P := 2;
                                   READ(PRD,R);
                                   STORE[RCP].VR := R;  Q := OVERI;
                                   REPEAT  Q := Q+1  UNTIL STORE[Q].VR=R;
                                   IF Q=RCP THEN
                                      BEGIN  RCP := RCP+1;
                                      IF RCP=OVERR THEN ERRORL(' REAL TABLE OVERFLOW     ')
                                   END
                                END;

                           'N' :; (*P,Q = 0*)

                           'B' :BEGIN  P := 3;  READ(PRD,Q)  END;

                           '(' :BEGIN  OP := 8;  P := 4;
                                   S := [ ];  READ(PRD,CH);
                                   WHILE CH<>')' DO
                                   BEGIN READ(PRD,S1,CH); S := S + [S1]
                                   END;
                                   STORE[SCP].VS := S;  Q := OVERR;
                                   REPEAT  Q := Q+1  UNTIL STORE[Q].VS=S;
                                   IF Q=SCP THEN
                                   BEGIN  SCP := SCP+1;
                                      IF SCP=OVERS THEN ERRORL(' SET TABLE OVERFLOW      ')
                                   END
                                END
                           END (*CASE*)
                        END;

          26 (*CHK*) :    BEGIN  READ(PRD,LB,UB);
                           STORE[BCP-1].VI := LB; STORE[BCP].VI := UB;
                           Q := OVERS;
                           REPEAT  Q := Q+2
                           UNTIL (STORE[Q-1].VI=LB)AND (STORE[Q].VI=UB);
                           IF Q=BCP THEN
                           BEGIN  BCP := BCP+2;
                              IF BCP=OVERB THEN ERRORL(' BOUNDARY TABLE OVERFLOW ')
                           END
                        END;

          56 (*LCA*) :    BEGIN  READ(PRD,CH);  (*CH = FIRST CHAR IN STRING*)
                           Q := MCP;
                           WHILE CH<>'''' DO
                           BEGIN STORE[MCP].VI := ORD(CH);
                              MCP := MCP+1;  READ(PRD,CH)
                           END
                        END;

          6,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
          48,49,50,51,52,53,54,58  :  ;

      END; (*CASE*)

      READLN(PRD);
      (* STORE INSTRUCTION *)
      WITH CODE[PC DIV 2] DO
         IF ODD(PC) THEN
         BEGIN  OP2 := OP; P2 := P; Q2 := Q
         END  ELSE
         BEGIN  OP1 := OP; P1 := P; Q1 := Q
         END;
      PC := PC+1;
   END; (*ASSEMBLE*)

BEGIN (*LOAD*)
   INIT;
   GENERATE;
   PC:=0; READ(PRD,CH);
   GENERATE;

END; (*LOAD*)

(*------------------------------------------------------------------------*)


PROCEDURE PMD;
   VAR S :INTEGER; I: INTEGER;

   PROCEDURE PT;
   { ADDED INDEX VARIABLE J. [SAM] }
   VAR J: INTEGER;
   BEGIN  WRITE(S:6);
      CASE STORE[S].STYPE OF
          UNDEF: BEGIN WHILE (S>=1)AND (STORE[S].STYPE=UNDEF) DO S := S-1;
                    IF S>=1 THEN S := S+1;
                    WRITE(' --',S:5,' UNDEF')
                 END;
          INT  : WRITE(STORE[S].VI);
          REEL : WRITE(STORE[S].VR);
          BOOL : WRITE(STORE[S].VB);
          { CHANGED SET WRITE TO BITS. THE OLD FORMULATION WAS COMPILER
            DEPENDENT. [SAM] }
          SETT : {WRITE(STORE[S].VS:21 OCT);}
                 BEGIN
                   WRITE('[');
                   FOR J := 1 TO 58 DO IF J IN STORE[S].VS THEN WRITE('1')
                   ELSE WRITE('0');
                   WRITE(']')
                 END;
          ADR  : WRITE('  ^ ',STORE[S].VA:6);
          MARK : WRITE(' ***',STORE[S].VM:6)
      END; (*CASE*)
      S := S - 1;
      I := I + 1;
write('>', i:1, '<');
      IF I = 4 THEN
         BEGIN WRITELN(OUTPUT); I := 0 END;
   END; (*PT*)

BEGIN WRITE(' PC =',PC-1:5,' OP =',OP:3,'  SP =',SP:5,'  MP =',MP:5,'  NP =',NP:5);
   WRITELN; WRITELN('--------------------------------------');
   S := SP; I := 0;
   WHILE S>=0 DO PT;
   S := MAXSTK;
   WHILE S>=NP DO PT;
END; (*PMD*)
PROCEDURE ERRORI(STRING: BETA);
BEGIN WRITELN; WRITELN(STRING);
      PMD; GOTO 1
END;(*ERRORI*)

FUNCTION BASE(LD :INTEGER):ADDRESS;
   VAR AD :ADDRESS;
BEGIN  AD := MP;
   WHILE LD>0 DO
   BEGIN  AD := STORE[AD+1].VM;  LD := LD-1
   END;
   BASE := AD
END; (*BASE*)


PROCEDURE EX0;
   VAR AD,AD1 :ADDRESS;  I,J: INTEGER;
   PROCEDURE PUSH;
   BEGIN  SP := SP+1;
      IF SP>=NP THEN ERRORI(' STORE OVERFLOW          ')
   END;
   PROCEDURE CALLSP;
      VAR LINE: BOOLEAN; ADPTR,ADELNT: ADDRESS;
          I: INTEGER;
      PROCEDURE READI(VAR F:TEXT);
         VAR AD: ADDRESS;
      BEGIN AD:= STORE[SP-1].VA;
            STORE[AD].STYPE:= INT; READ(F,STORE[AD].VI);
            STORE[STORE[SP].VA].VI:= ORD(F^);
            SP:= SP-2
      END;(*READI*)
      PROCEDURE READR(VAR F: TEXT);
         VAR AD: ADDRESS;
      BEGIN AD:= STORE[SP-1].VA;
            STORE[AD].STYPE:= REEL; READ(F,STORE[AD].VR);
            STORE[STORE[SP].VA].VI:= ORD(F^);
            SP:= SP-2
      END;(*READR*)
      PROCEDURE READC(VAR F: TEXT);
         VAR C: CHAR; AD: ADDRESS;
      BEGIN READ(F,C);
            AD:= STORE[SP-1].VA;
            STORE[AD].STYPE:= INT; STORE[AD].VI:= ORD(C);
            STORE[STORE[SP].VA].VI:= ORD(F^);
            SP:= SP-2
      END;(*READC*)
      PROCEDURE WRITESTR(VAR F: TEXT);
         VAR I,J,K: INTEGER;
             AD: ADDRESS;
      BEGIN AD:= STORE[SP-3].VA;
            K:= STORE[SP-1].VI; J:= STORE[SP-2].VI;
           (* J AND K ARE NUMBERS OF CHARACTERS *)
            IF K>J THEN FOR I:=1 TO K-J DO WRITE(F,' ')
                   ELSE J:= K;
            FOR I:=0 TO J-1 DO WRITE(F,CHR(STORE[AD+I].VI));
            (* IN THE INDEX OF STORE I HAS TO BE MULTIPLIED
               BY CHARSIZE *)
            SP:= SP-4
      END;(*WRITESTR*)
      PROCEDURE GETFILE(VAR F: TEXT);
         VAR AD: ADDRESS;
      BEGIN AD:=STORE[SP].VA;
            GET(F); STORE[AD].VI:= ORD(F^);
            SP:=SP-1
      END;(*GETFILE*)
      PROCEDURE PUTFILE(VAR F: TEXT);
         VAR AD: ADDRESS;
      BEGIN AD:= STORE[SP].VA;
            F^:= CHR(STORE[AD].VI); PUT(F);
            STORE[AD].STYPE:= UNDEF;
            SP:= SP-1;
      END;(*PUTFILE*)
   BEGIN (*CALLSP*)
         CASE Q OF
              0 (*GET*): CASE STORE[SP].VA OF
                              4: GETFILE(INPUT);
                              5: ERRORI(' GET ON OUTPUT FILE      ');
                              6: GETFILE(PRD);
                              7: ERRORI(' GET ON PRR FILE         ')
                         END;
              1 (*PUT*): CASE STORE[SP].VA OF
                              4: ERRORI(' PUT ON READ FILE        ');
                              5: PUTFILE(OUTPUT);
                              6: ERRORI(' PUT ON PRD FILE         ');
                              7: PUTFILE(PRR)
                         END;
              2 (*RST*): BEGIN NP:= STORE[SP].VI; SP:=SP-1
                         END;
              3 (*RLN*) : BEGIN CASE STORE[SP].VA OF
                                     4: BEGIN READLN(INPUT);STORE[INPUTADR].VI:=ORD(INPUT^) END;
                                     5: ERRORI(' READLN ON OUTPUT FILE   ');
                                     6: BEGIN READLN(PRD); STORE[PRDADR].VI:= ORD(PRD^) END;
                                     7: ERRORI(' READLN ON PRR FILE      ')
                                END;
                                SP:= SP-1
                          END;
               4 (*NEW*): BEGIN AD:= NP-STORE[SP].VA;
                          (*TOP OF STACK GIVES THE LENGTH IN UNITS OF STORAGE *)
                                IF AD<= SP THEN ERRORI(' STORE OVERFLOW          ');
                                FOR I:=NP-1 DOWNTO AD DO STORE[I].STYPE:= UNDEF;
                                NP:= AD; AD:= STORE[SP-1].VA;
                                STORE[AD].STYPE:=ADR; STORE[AD].VA:= NP;
                                SP:=SP-2
                          END;
               5 (*WLN*) : BEGIN CASE STORE[SP].VA OF
                                      4: ERRORI(' WRITELN ON INPUT FILE   ');
                                      5: WRITELN(OUTPUT);
                                      6: ERRORI(' WRITELN ON PRD FILE     ');
                                      7: WRITELN(PRR)
                                 END;
                                 SP:= SP-1
                           END;
               6 (*WRS*): CASE STORE[SP].VA OF
                               4: ERRORI(' WRITE ON INPUT FILE     ');
                               5: WRITESTR(OUTPUT);
                               6: ERRORI(' WRITE ON PRD FILE       ');
                               7: WRITESTR(PRR)
                          END;
               7 (*ELN*) : BEGIN CASE STORE[SP].VA OF
                                      4: LINE:= EOLN(INPUT);
                                      5: ERRORI(' EOLN OUTPUT FILE        ');
                                      6: LINE:=EOLN(PRD);
                                      7: ERRORI(' EOLN ON PRR FILE        ')
                                 END;
                                 STORE[SP].STYPE:= BOOL; STORE[SP].VB:= LINE
                           END;
               8 (*WRI*) : BEGIN CASE STORE[SP].VA OF
                                      4: ERRORI(' WRITE ON INPUT FILE     ');
                                      5: WRITE(OUTPUT,STORE[SP-2].VI:STORE[SP-1].VI);
                                      6: ERRORI(' WRITE ON PRD FILE       ');
                                      7: WRITE(PRR,STORE[SP-2].VI:STORE[SP-1].VI)
                                  END;
                                 SP:=SP-3
                           END;
               9 (*WRR*) : BEGIN CASE STORE[SP].VA OF
                                      4: ERRORI(' WRITE ON INPUT FILE     ');
                                      5: WRITE(OUTPUT,STORE[SP-2].VR:STORE[SP-1].VI);
                                      6: ERRORI(' WRITE ON PRD FILE       ');
                                      7: WRITE(PRR,STORE[SP-2].VR:STORE[SP-1].VI)
                                 END;
                                 SP:=SP-3
                          END;
               10 (*WRC*):BEGIN CASE STORE[SP].VA OF
                                     4: ERRORI(' WRITE ON INPUT FILE     ');
                                     5: WRITE(OUTPUT,CHR(STORE[SP-2].VI):STORE[SP-1].VI);
                                     6: ERRORI(' WRITE ON PRD FILE       ');
                                     7: WRITE(PRR,CHR(STORE[SP-2].VI):STORE[SP-1].VI)
                                END;
                                SP:=SP-3
                          END;
               11(*RDI*) : CASE STORE[SP].VA OF
                                4: READI(INPUT);
                                5: ERRORI(' READ ON OUTPUT FILE     ');
                                6: READI(PRD);
                                7: ERRORI(' READ ON PRR FILE        ')
                          END;
               12(*RDR*) : CASE STORE[SP].VA OF
                                4: READR(INPUT);
                                5: ERRORI(' READ ON OUTPUT FILE     ');
                                6: READR(PRD);
                                7: ERRORI(' READ ON PRR FILE        ')
                           END;
               13(*RDC*):  CASE STORE[SP].VA OF
                                4: READC(INPUT);
                                5: ERRORI(' READ ON OUTPUT FILE     ');
                                6: READC(PRD);
                                7: ERRORI(' READ ON PRR FILE        ')
                           END;
               14(*SIN*): STORE[SP].VR:= SIN(STORE[SP].VR);
               15(*COS*): STORE[SP].VR:= COS(STORE[SP].VR);
               16(*EXP*): STORE[SP].VR:= EXP(STORE[SP].VR);
               17(*LOG*): STORE[SP].VR:= LN(STORE[SP].VR);
               18(*SQT*): STORE[SP].VR:= SQRT(STORE[SP].VR);
               19(*ATN*): STORE[SP].VR:= ARCTAN(STORE[SP].VR);
               20(*SAV*): BEGIN AD:=STORE[SP].VA;
                             STORE[AD].STYPE:=ADR; STORE[AD].VI:= NP;
                             SP:= SP-1
                          END;
         END;(*CASE Q*)
   END;(*CALLSP*)

BEGIN  CASE OP OF (* IN THIS PROCEDURE Q MUST NOT BE CORRECTED *)

          0 (*LOD*): BEGIN  AD := BASE(P) + Q;
                      IF STORE[AD].STYPE=UNDEF THEN ERRORI(' VALUE UNDEFINED         ');
                      PUSH;
                      STORE[SP] := STORE[AD]
                   END;

          1 (*LDO*): BEGIN
                      IF STORE[Q].STYPE=UNDEF THEN ERRORI(' VALUE UNDEFINED         ');
                      PUSH;
                      STORE[SP] := STORE[Q]
                   END;

          2 (*STR*): BEGIN  STORE[BASE(P)+Q] := STORE[SP];  SP := SP-1
                   END;

          3 (*SRO*): BEGIN  STORE[Q] := STORE[SP];  SP := SP-1
                   END;

          4 (*LDA*): BEGIN  PUSH;
                      STORE[SP].STYPE := ADR; STORE[SP].VA := BASE(P) + Q
                   END;

          5 (*LAO*): BEGIN  PUSH;
                      STORE[SP].STYPE := ADR; STORE[SP].VA := Q
                   END;

          6 (*STO*): BEGIN  STORE[STORE[SP-1].VA] := STORE[SP];  SP := SP-2
                   END;

          7 (*LDC*): BEGIN  PUSH;
                      IF P=1 THEN
                      BEGIN  STORE[SP].STYPE := INT; STORE[SP].VI := Q
                      END ELSE
                          IF P=3 THEN
                          BEGIN  STORE[SP].STYPE := BOOL; STORE[SP].VB := Q=1
                          END ELSE (*LOAD NIL*)
                          BEGIN  STORE[SP].STYPE := ADR; STORE[SP].VA := MAXSTR
                          END
                   END;

          8 (*LCI*): BEGIN  PUSH;  STORE[SP] := STORE[Q]
                   END;

          9 (*IND*): BEGIN  AD := STORE[SP].VI + Q; (* Q IS A NUMBER OF STORAGE UNITS *)
                      IF STORE[AD].STYPE=UNDEF THEN ERRORI(' VALUE UNDEFINED         ');
                      STORE[SP] := STORE[AD]
                   END;

          10 (*INC*):STORE[SP].VI := STORE[SP].VI + Q;

          11 (*MST*):BEGIN (*P=LEVEL OF CALLING PROCEDURE MINUS LEVEL OF CALLED
                          PROCEDURE + 1;  SET DL AND SL, INCREMENT SP*)
                      STORE[SP+1].STYPE := UNDEF;
                      (* THEN LENTH OF THIS ELEMENT IS
                        MAX(INTSIZE,REALSIZE,BOOLSIZE,CHARSIZE,PTRSIZE *)
                      STORE[SP+2].STYPE := MARK;  STORE[SP+2].VM := BASE(P);
                      (* THE LENGTH OF THIS ELEMENT IS PTRSIZE *)
                      STORE[SP+3].STYPE := MARK;  STORE[SP+3].VM := MP;
                      (* IDEM *)
                      STORE[SP+4].STYPE := UNDEF;
                      (* IDEM *)
                      SP := SP+4
                   END;

          12 (*CUP*):BEGIN  (*P=NO OF LOCATIONS FOR PARAMETERS, Q=ENTRY POINT*)
                      MP := SP-(P+3);
                      STORE[MP+3].STYPE := MARK;  STORE[MP+3].VM := PC;
                      PC := Q
                   END;

          13 (*ENT*):BEGIN  J := MP+Q;  (*Q=LENGTH OF DATA SEG*)
                      IF J>NP THEN ERRORI(' STORE OVERFLOW          ');
                      (*RESET TO UNDEFINED--MAY DECIDE TO REMOVE THIS TEST*)
                      IF SP<INPUTADR THEN SP := PRDADR;
                      FOR I := SP+1 TO J DO STORE[I].STYPE := UNDEF;
                      SP := J;
                   END;

          14 (*RET*):BEGIN  CASE P OF
                                 0: SP:= MP-1;
                                 1,2,3,4,5: SP:= MP
                            END;
                            PC:= STORE[MP+3].VM;
                            MP:= STORE[MP+2].VM;
                     END;

          15 (*CSP*): CALLSP;

       END (*CASE OP*)
END; (*EX0*)

PROCEDURE EX1;
   VAR I,I1,I2  :INTEGER;  B :BOOLEAN;

   PROCEDURE COMPARE;
   BEGIN  I1 := STORE[SP].VA;  I2 := STORE[SP+1].VA;
      I := 0;  B := TRUE;
      WHILE B AND (I<>Q) DO
         IF STORE[I1+I].VI=STORE[I2+I].VI THEN I := I+1
         ELSE B := FALSE
   END; (*COMPARE*)

BEGIN  CASE OP OF (* IN THIS PROCEDURE Q MUST NOT BE CORRECTED *)

          16 (*IXA*):BEGIN  SP := SP-1; (* Q IS A NUMBER OF STORAGE UNITS *)
                      STORE[SP].VA := Q*STORE[SP+1].VA + STORE[SP].VA
                   END;

          17 (*EQU*):BEGIN  SP := SP-1;
                      CASE P OF
                      0,1: B := STORE[SP].VI=STORE[SP+1].VI;
                        2: B := STORE[SP].VR=STORE[SP+1].VR;
                        3: B := STORE[SP].VB=STORE[SP+1].VB;
                        4: B := STORE[SP].VS=STORE[SP+1].VS;
                        5: COMPARE;
                      END; (*CASE P*)
                      STORE[SP].STYPE := BOOL;
                      STORE[SP].VB := B
                   END;

          18 (*NEQ*):BEGIN  SP := SP-1;
                      CASE P OF
                      0,1: B := STORE[SP].VI<>STORE[SP+1].VI;
                        2: B := STORE[SP].VR<>STORE[SP+1].VR;
                        3: B := STORE[SP].VB<>STORE[SP+1].VB;
                        4: B := STORE[SP].VS<>STORE[SP+1].VS;
                        5: BEGIN  COMPARE;
                              B := NOT B;
                           END
                      END; (*CASE P*)
                      STORE[SP].STYPE := BOOL;
                      STORE[SP].VB := B
                   END;

          19 (*GEQ*):BEGIN  SP := SP-1;
                      CASE P OF
                      0,1: B := STORE[SP].VI>=STORE[SP+1].VI;
                        2: B := STORE[SP].VR>=STORE[SP+1].VR;
                        3: B := STORE[SP].VB>=STORE[SP+1].VB;
                        4: B := STORE[SP].VS>=STORE[SP+1].VS;
                        5: BEGIN COMPARE;
                              B := (STORE[I1+I].VI>=STORE[I2+I].VI)OR B
                           END
                      END; (*CASE P*)
                      STORE[SP].STYPE := BOOL;
                      STORE[SP].VB := B
                   END;

          20 (*GRT*):BEGIN  SP := SP-1;
                      CASE P OF
                      0,1: B := STORE[SP].VI>STORE[SP+1].VI;
                        2: B := STORE[SP].VR>STORE[SP+1].VR;
                        3: B := STORE[SP].VB>STORE[SP+1].VB;
                        4: ERRORI(' SET INCLUSION           ');
                        5: BEGIN  COMPARE;
                              B := (STORE[I1+I].VI>STORE[I2+I].VI)AND NOT B
                           END
                      END; (*CASEP*)
                      STORE[SP].STYPE := BOOL;
                      STORE[SP].VB := B
                   END;

          21 (*LEQ*):BEGIN  SP := SP-1;
                      CASE P OF
                      0,1: B := STORE[SP].VI<=STORE[SP+1].VI;
                        2: B := STORE[SP].VR<=STORE[SP+1].VR;
                        3: B := STORE[SP].VB<=STORE[SP+1].VB;
                        4: B := STORE[SP].VS<=STORE[SP+1].VS;
                        5: BEGIN  COMPARE;
                              B := (STORE[I1+I].VI<=STORE[I2+I].VI)OR B
                           END;
                      END; (*CASE P*)
                      STORE[SP].STYPE := BOOL;
                      STORE[SP].VB := B
                   END;

          22 (*LES*):BEGIN  SP := SP-1;
                      CASE P OF
                      0,1: B := STORE[SP].VI<STORE[SP+1].VI;
                        2: B := STORE[SP].VR<STORE[SP+1].VR;
                        3: B := STORE[SP].VB<STORE[SP+1].VB;
                        5: BEGIN  COMPARE;
                              B := (STORE[I1+I].VI<STORE[I2+I].VI)AND NOT B
                           END
                      END; (*CASE P*)
                      STORE[SP].STYPE := BOOL;
                      STORE[SP].VB := B
                   END;


          23 (*UJP*):PC := Q;

          24 (*FJP*):BEGIN  IF NOT STORE[SP].VB THEN PC := Q;  SP := SP-1
                   END;

          25 (*XJP*):BEGIN  PC := STORE[SP].VI + Q;  SP := SP-1
                   END;

          26 (*CHK*):IF(STORE[SP].VI<STORE[Q-1].VI)OR (STORE[SP].VI>STORE[Q].VI)THEN
                     ERRORI(' VALUE OUT OF RANGE      ');

          27 (*EOF*):BEGIN  I := STORE[SP].VI;
                      IF I=INPUTADR THEN
                      BEGIN STORE[SP].STYPE := BOOL; STORE[SP].VB := EOF(INPUT);
                      END ELSE ERRORI(' CODE IN ERROR           ')
                   END;

          28 (*ADI*):BEGIN  SP := SP-1;
                      STORE[SP].VI := STORE[SP].VI + STORE[SP+1].VI
                   END;

          29 (*ADR*):BEGIN  SP := SP-1;
                      STORE[SP].VR := STORE[SP].VR + STORE[SP+1].VR
                   END;

          30 (*SBI*):BEGIN SP := SP-1;
                      STORE[SP].VI := STORE[SP].VI - STORE[SP+1].VI
                   END;

          31 (*SBR*):BEGIN  SP := SP-1;
                      STORE[SP].VR := STORE[SP].VR - STORE[SP+1].VR
                   END;

       END (*CASE OP*)
END; (*EX1*)

PROCEDURE EX2;
   var i: integer; s: set of 0..58;

BEGIN  CASE OP OF

          32 (*SGS*):BEGIN  s := [STORE[SP].VI];
                      STORE[SP].STYPE := SETT; STORE[SP].VS := s
                   END;

          33 (*FLT*):BEGIN  i := STORE[SP].VI;
                      STORE[SP].STYPE := REEL;  STORE[SP].VR := i
                   END;

          34 (*FLO*):BEGIN  i := STORE[SP-1].VI;
                      STORE[SP-1].STYPE := REEL; STORE[SP-1].VR := i
                   END;

          35 (*TRC*):BEGIN i := TRUNC(STORE[SP].VR);
                      STORE[SP].STYPE := INT; STORE[SP].VI := i
                   END;

          36 (*NGI*):STORE[SP].VI := -STORE[SP].VI;

          37 (*NGR*):STORE[SP].VR := -STORE[SP].VR;

          38 (*SQI*):STORE[SP].VI := SQR(STORE[SP].VI);

          39 (*SQR*):STORE[SP].VR := SQR(STORE[SP].VR);

          40 (*ABI*):STORE[SP].VI := ABS(STORE[SP].VI);

          41 (*ABR*):STORE[SP].VR := ABS(STORE[SP].VR);

          42 (*NOT*):STORE[SP].VB := NOT STORE[SP].VB;

          43 (*AND*):BEGIN  SP := SP-1;
                      STORE[SP].VB := STORE[SP].VB AND STORE[SP+1].VB
                   END;

          44 (*IOR*):BEGIN  SP := SP-1;
                      STORE[SP].VB := STORE[SP].VB OR STORE[SP+1].VB
                   END;

          45 (*DIF*):BEGIN  SP := SP-1;
                      STORE[SP].VS := STORE[SP].VS - STORE[SP+1].VS
                   END;

          46 (*INT*):BEGIN  SP := SP-1;
                      STORE[SP].VS := STORE[SP].VS *  STORE[SP+1].VS
                   END;

          47 (*UNI*):BEGIN  SP := SP-1;
                      STORE[SP].VS := STORE[SP].VS +  STORE[SP+1].VS
                   END;

       END (*CASE OP*)
END; (*EX2*)

PROCEDURE EX3;
   VAR I,I1,I2 :ADDRESS; b: boolean;
BEGIN  CASE OP OF

          48 (*INN*):BEGIN  SP := SP-1;
                      b := STORE[SP].VI IN STORE[SP+1].VS;
                      STORE[SP].STYPE := BOOL; STORE[SP].VB := b
                   END;

          49 (*MOD*):BEGIN  SP := SP-1;
                      STORE[SP].VI := STORE[SP].VI MOD STORE[SP+1].VI
                   END;

          50 (*ODD*):BEGIN  b := ODD(STORE[SP].VI);
                      STORE[SP].STYPE := BOOL; STORE[SP].VB := b
                   END;

          51 (*MPI*):BEGIN  SP := SP-1;
                      STORE[SP].VI := STORE[SP].VI * STORE[SP+1].VI

         END;

          52 (*MPR*):BEGIN  SP := SP-1;
                      STORE[SP].VR := STORE[SP].VR * STORE[SP+1].VR
                   END;

          53 (*DVI*):BEGIN  SP := SP-1;
                      STORE[SP].VI := STORE[SP].VI DIV STORE[SP+1].VI
                   END;

          54 (*DVR*):BEGIN  SP := SP-1;
                      STORE[SP].VR := STORE[SP].VR/STORE[SP+1].VR
                   END;

          55 (*MOV*): BEGIN I1 := STORE[SP-1].VA; I2 := STORE[SP].VA; SP := SP-2;
                       FOR I := 0 TO Q-1 DO STORE[I1+I] := STORE[I2+I]
                      (* Q IS A NUMBER OF STORAGE UNITS *)
                    END;

          56 (*LCA*):BEGIN SP := SP + 1;
                      IF SP >= NP THEN ERRORI(' STORE OVERFLOW          ');
                      STORE[SP].STYPE := ADR; STORE[SP].VA := Q
                   END;

          57 (*DEC*):STORE[SP].VI := STORE[SP].VI - Q;

          58 (*STP*):INTERPRETING := FALSE;

       END (*CASE OP*)
END; (*EX3*)

(*------------------------------------------------------------------------*)

BEGIN   (*  M A I N  *)
   { REWRITE(PRR); }
   LOAD;  (* ASSEMBLES AND STORES CODE *)
   WRITELN(OUTPUT); (*FOR TESTING*)
   PC := 0;  SP := -1;  MP := 0;  NP := MAXSTK+1;
   STORE[INPUTADR].STYPE := INT;  STORE[INPUTADR].VI := ORD(INPUT^);
   STORE[PRDADR].STYPE:= INT; STORE[PRDADR].VI:= ORD(PRD^);
   STORE[OUTPUTADR].STYPE:= UNDEF;
   INTERPRETING := TRUE;
   WHILE INTERPRETING DO
   BEGIN  (*FETCH*)
      WITH CODE[PC DIV 2] DO
         IF ODD(PC) THEN
         BEGIN  OP := OP2;  P := P2;  Q := Q2
         END  ELSE
         BEGIN  OP := OP1;  P := P1;  Q := Q1
         END;
      PC := PC+1;

      (*EXECUTE*)
      CASE OP DIV 16 OF
       0:  EX0;
       1:  EX1;
       2:  EX2;
       3:  EX3
      END
   END; (*WHILE INTERPRETING*)

1 :
END.

Added p2/pcomp.pas.



































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745

(*$L-*)
 (*********************************************************
  *                                                       *
  *                                                       *
  *     STEP-WISE DEVELOPMENT OF A PASCAL COMPILER        *
  *     ******************************************        *
  *                                                       *
  *                                                       *
  *     STEP 5:   SYNTAX ANALYSIS INCLUDING ERROR         *
  *               HANDLING; CHECKS BASED ON DECLARA-      *
  *     10/7/73   TIONS; ADDRESS AND CODE GENERATION      *
  *               FOR A HYPOTHETICAL STACK COMPUTER       *
  *                                                       *
  *                                                       *
  *     AUTHOR:   URS AMMANN                              *
  *               FACHGRUPPE COMPUTERWISSENSCHAFTEN       *
  *               EIDG. TECHNISCHE HOCHSCHULE             *
  *               CH-8006 ZUERICH                         *
  *                                                       *
  *                                                       *
  *                                                       *
  *     MODIFICATION OF STEP 5 OF PASCAL COMPILER         *
  *     *****************************************         *
  *                                                       *
  *     THE COMPILER IS NOW WRITTEN IN A SUBSET OF        *
  *     STANDARD PASCAL  -  AS DEFINED IN THE NEW         *
  *     MANUAL BY K. JENSEN AND N. WIRTH  - AND IT        *
  *     PROCESSES EXACTLY THIS SUBSET.                    *
  *                                                       *
  *     AUTHOR OF CHANGES:   KESAV NORI                   *
  *                          COMPUTER GROUP               *
  *                          T.I.F.R.                     *
  *                          HOMI BHABHA ROAD             *
  *                          BOMBAY - 400005              *
  *                          INDIA                        *
  *                                                       *
  *     THESE CHANGES WERE COMPLETED AT ETH, ZURICH       *
  *     ON 20/5/74.                                       *
  *                                                       *
  *     CONVERTED TO ISO 7185 PASCAL BY SCOTT A. MOORE    *
  *     [SAM] ON JAN 22, 2011.                            *
  *                                                       *
  *     VARIOUS CHANGES WERE MADE, ALL MARKED WITH MY     *
  *     INITIALS THUS [SAM]. THERE ARE COMMENTS FOR ALL   *
  *     CHANGES MADE. THE ONLY OTHERS WERE MINOR FORMAT   *
  *     GLITCHES, APPARENTLY DUE TO SEVERAL EOLS          *
  *     INSERTED AT VARIOUS PLACES INTO THE CODE.         *
  *                                                       *
  *********************************************************)


PROGRAM PASCALCOMPILER(INPUT,OUTPUT,PRR);



CONST DISPLIMIT = 20; MAXLEVEL = 10; MAXADDR = 8096;
      INTSIZE = 1; REALSIZE = 2;
      CHARSIZE = 1; BOOLSIZE = 1; SETSIZE =2; PTRSIZE = 1;
      STRGLGTH = 100; MAXINT = 32767;
      { THE NUMBER FOR LCAFTERMARKSTACK WAS FOUND WRONG. THE FORUMLA BELOW AND
        THE MST CODE IN PASINT SHOW IT SHOULD BE 4. [SAM] }
      LCAFTERMARKSTACK = 4{5};
      (*  3*PTRSIZE+MAX OF STANDARD SCALAR SIZES AND PTRSIZE  *)
      FILEBUFFER = 4;
      maxchr = 255; { range of char is 0..255 }



TYPE                                                        (*DESCRIBING:*)
                                                            (*************)


                                                            (*BASIC SYMBOLS*)
                                                            (***************)

     SYMBOL = (IDENT,INTCONST,REALCONST,STRINGCONST,NOTSY,MULOP,ADDOP,RELOP,
               LPARENT,RPARENT,LBRACK,RBRACK,COMMA,SEMICOLON,PERIOD,ARROW,
               COLON,BECOMES,LABELSY,CONSTSY,TYPESY,VARSY,FUNCSY,PROGSY,
               PROCSY,SETSY,PACKEDSY,ARRAYSY,RECORDSY,FILESY,FORWARDSY,
               BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,FORSY,WITHSY,
               GOTOSY,ENDSY,ELSESY,UNTILSY,OFSY,DOSY,TOSY,DOWNTOSY,
               THENSY,OTHERSY);
     OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP,GEOP,GTOP,
                 NEOP,EQOP,INOP,NOOP);
     SETOFSYS = SET OF SYMBOL;

                                                            (*CONSTANTS*)
                                                            (***********)

     CSTCLASS = (REEL,PSET,STRG);
     CSP = ^ CONSTANT;
     CONSTANT = RECORD CASE CCLASS: CSTCLASS OF
                         REEL: (RVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR);
                         PSET: (PVAL: SET OF 0..58);
                         STRG: (SLGTH: 0..STRGLGTH;
                                SVAL: PACKED ARRAY [1..STRGLGTH] OF CHAR)
                       END;

     VALU = RECORD CASE {INTVAL:} BOOLEAN OF  (*INTVAL NEVER SET NORE TESTED*)
                     TRUE:  (IVAL: INTEGER);
                     FALSE: (VALP: CSP)
                   END;

                                                           (*DATA STRUCTURES*)
                                                           (*****************)
     LEVRANGE = 0..MAXLEVEL; ADDRRANGE = 0..MAXADDR;
     STRUCTFORM = (SCALAR,SUBRANGE,POINTER,POWER,ARRAYS,RECORDS,FILES,
                   TAGFLD,VARIANT);
     DECLKIND = (STANDARD,DECLARED);
     STP = ^ STRUCTURE; CTP = ^ IDENTIFIER;

     STRUCTURE = { PACKED } RECORD
                   MARKED: BOOLEAN;   (*FOR TEST PHASE ONLY*)
                   SIZE: ADDRRANGE;
                   CASE FORM: STRUCTFORM OF
                     SCALAR:   (CASE SCALKIND: DECLKIND OF
                                  STANDARD: (); { ADDED EMPTY CASE PER ISO 7185
                                                  [SAM] }
                                  DECLARED: (FCONST: CTP));
                     SUBRANGE: (RANGETYPE: STP; MIN,MAX: VALU);
                     POINTER:  (ELTYPE: STP);
                     POWER:    (ELSET: STP);
                     ARRAYS:   (AELTYPE,INXTYPE: STP);
                     RECORDS:  (FSTFLD: CTP; RECVAR: STP);
                     FILES:    (FILTYPE: STP);
                     TAGFLD:   (TAGFIELDP: CTP; FSTVAR: STP);
                     VARIANT:  (NXTVAR,SUBVAR: STP; VARVAL: VALU)
                   END;

                                                            (*NAMES*)
                                                            (*******)

     IDCLASS = (TYPES,KONST,VARS,FIELD,PROC,FUNC);
     SETOFIDS = SET OF IDCLASS;
     IDKIND = (ACTUAL,FORMAL);
     ALPHA = PACKED ARRAY [1..8] OF CHAR;

     IDENTIFIER = { PACKED } RECORD
                   NAME: ALPHA; LLINK, RLINK: CTP;
                   IDTYPE: STP; NEXT: CTP;
                   CASE KLASS: IDCLASS OF
                     TYPES: (); { ADDED EMPTY CASE PER ISO 7185 [SAM] }
                     KONST: (VALUES: VALU);
                     VARS:  (VKIND: IDKIND; VLEV: LEVRANGE; VADDR: ADDRRANGE);
                     FIELD: (FLDADDR: ADDRRANGE);
                     PROC,
                     FUNC:  (CASE PFDECKIND: DECLKIND OF
                              STANDARD: (KEY: 1..15);
                              DECLARED: (PFLEV: LEVRANGE; PFNAME: INTEGER;
                                          CASE PFKIND: IDKIND OF
                                           ACTUAL: (FORWDECL, EXTERN:
                                                    BOOLEAN);
                                           FORMAL: ())) { ADDED EMPTY CASE PER
                                                          ISO 7185 [SAM] }
                   END;


     DISPRANGE = 0..DISPLIMIT;
     WHERE = (BLCK,CREC,VREC,REC);

                                                            (*EXPRESSIONS*)
                                                            (*************)
     ATTRKIND = (CST,VARBL,EXPR);
     VACCESS = (DRCT,INDRCT,INXD);

     ATTR = RECORD TYPTR: STP;
              CASE KIND: ATTRKIND OF
                CST:   (CVAL: VALU);
                VARBL: (CASE ACCESS: VACCESS OF
                          DRCT: (VLEVEL: LEVRANGE; DPLMT: ADDRRANGE);
                          INDRCT: (IDPLMT: ADDRRANGE);
                          INXD: ()); { ADDED EMPTY CASE PER ISO 7185 [SAM] }
                EXPR: () { ADDED EMPTY CASE PER ISO 7185 [SAM] }
              END;

     TESTP = ^ TESTPOINTER;
     TESTPOINTER = PACKED RECORD
                     ELT1,ELT2 : STP;
                     LASTTESTP : TESTP
                   END;

                                                                 (*LABELS*)
                                                                 (********)
     LBP = ^ LABL;
     LABL = RECORD NEXTLAB: LBP; DEFINED: BOOLEAN;
                   LABVAL, LABNAME: INTEGER
            END;

     EXTFILEP = ^FILEREC;
     FILEREC = RECORD FILENAME:ALPHA; NEXTFILE:EXTFILEP END;

     MARKTYPE = ^ INTEGER; { ADDED TYPE FOR STACK MARKS [SAM] }

(*-------------------------------------------------------------------------*)


VAR
 (*PRD, PRR:                    TEXT; *)
    { PRR: TEXT; }                      { DECLARES THE OUTPUT INTERMEDIATE FILE
                                      [SAM] }

                                    (*RETURNED BY SOURCE PROGRAM SCANNER
                                     INSYMBOL:
                                     **********)

    SY: SYMBOL;                     (*LAST SYMBOL*)
    OP: OPERATOR;                   (*CLASSIFICATION OF LAST SYMBOL*)
    VAL: VALU;                      (*VALUE OF LAST CONSTANT*)
    LGTH: INTEGER;                  (*LENGTH OF LAST STRING CONSTANT*)
    ID: ALPHA;                      (*LAST IDENTIFIER (POSSIBLY TRUNCATED)*)
    KK: 1..8;                       (*NR OF CHARS IN LAST IDENTIFIER*)
    CH: CHAR;                       (*LAST CHARACTER*)
    EOL: BOOLEAN;                   (*END OF LINE FLAG*)


                                    (*COUNTERS:*)
                                    (***********)

    CHCNT: 0..81;                   (*CHARACTER COUNTER*)
    LC,IC: ADDRRANGE;               (*DATA LOCATION AND INSTRUCTION COUNTER*)
    LINECOUNT: INTEGER;


                                    (*SWITCHES:*)
                                    (***********)

    DP,                             (*DECLARATION PART*)
    PRTERR,                     (*TO ALLOW FORWARD REFERENCES IN POINTER TYPE
                                  DECLARATION BY SUPPRESSING ERROR MESSAGE*)
    LIST,PRCODE,PRTABLES: BOOLEAN;  (*OUTPUT OPTIONS FOR
                                        -- SOURCE PROGRAM LISTING
                                        -- PRINTING SYMBOLIC CODE
                                        -- DISPLAYING IDENT AND STRUCT TABLES
                                        --> PROCEDURE OPTION*)


                                    (*POINTERS:*)
                                    (***********)
    INTPTR,REALPTR,CHARPTR,
    BOOLPTR,NILPTR,TEXTPTR: STP;    (*POINTERS TO ENTRIES OF STANDARD IDS*)
    UTYPPTR,UCSTPTR,UVARPTR,
    UFLDPTR,UPRCPTR,UFCTPTR,        (*POINTERS TO ENTRIES FOR UNDECLARED IDS*)
    FWPTR: CTP;                     (*HEAD OF CHAIN OF FORW DECL TYPE IDS*)
    FEXTFILEP: EXTFILEP;            (*HEAD OF CHAIN OF EXTERNAL FILES*)
    GLOBTESTP: TESTP;                (*LAST TESTPOINTER*)


                                    (*BOOKKEEPING OF DECLARATION LEVELS:*)
                                    (************************************)

    LEVEL: LEVRANGE;                (*CURRENT STATIC LEVEL*)
    DISX,                           (*LEVEL OF LAST ID SEARCHED BY SEARCHID*)
    TOP: DISPRANGE;                 (*TOP OF DISPLAY*)

    DISPLAY:                        (*WHERE:   MEANS:*)
      ARRAY [DISPRANGE] OF
        PACKED RECORD               (*=BLCK:   ID IS VARIABLE ID*)
          FNAME: CTP; FLABEL: LBP;  (*=CREC:   ID IS FIELD ID IN RECORD WITH*)
          CASE OCCUR: WHERE OF      (*         CONSTANT ADDRESS*)
            BLCK: (); { ADDED EMPTY CASE PER ISO 7185 [SAM] }
            CREC: (CLEV: LEVRANGE;  (*=VREC:   ID IS FIELD ID IN RECORD WITH*)
                  CDSPL: ADDRRANGE);(*         VARIABLE ADDRESS*)
            VREC: (VDSPL: ADDRRANGE);
            REC:  () { ADDED EMPTY CASE PER ISO 7185 [SAM] }
          END;                      (* --> PROCEDURE WITHSTATEMENT*)


                                    (*ERROR MESSAGES:*)
                                    (*****************)

    ERRINX: 0..10;                  (*NR OF ERRORS IN CURRENT SOURCE LINE*)
    ERRLIST:
      ARRAY [1..10] OF
        PACKED RECORD POS: 1..81;
                      NMR: 1..400
               END;




                                    (*EXPRESSION COMPILATION:*)
                                    (*************************)

    GATTR: ATTR;                    (*DESCRIBES THE EXPR CURRENTLY COMPILED*)


                                    (*STRUCTURED CONSTANTS:*)
                                    (***********************)

    CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,BLOCKBEGSYS,SELECTSYS,FACBEGSYS,
    STATBEGSYS,TYPEDELS: SETOFSYS;
    RW:  ARRAY [1..35(*NR. OF RES. WORDS*)] OF ALPHA;
    FRW: ARRAY [1..9] OF 1..36(*NR. OF RES. WORDS + 1*);
    RSY: ARRAY [1..35(*NR. OF RES. WORDS*)] OF SYMBOL;
    { THIS DEFINITION IS CDC DEPENDENT, CHANGED TO ALL CHARACTERS [SAM] }
    SSY: ARRAY [CHAR {'+'..';'}] OF SYMBOL;
    ROP: ARRAY [1..35(*NR. OF RES. WORDS*)] OF OPERATOR;
    { THIS DEFINITION IS CDC DEPENDENT, CHANGED TO ALL CHARACTERS [SAM] }
    SOP: ARRAY [CHAR {'+'..';'}] OF OPERATOR;
    NA:  ARRAY [1..35] OF ALPHA;
    MN:  ARRAY [0..57] OF PACKED ARRAY [1..4] OF CHAR;
    SNA: ARRAY [1..23] OF PACKED ARRAY [1..4] OF CHAR;

    INTLABEL,MXINT10,DIGMAX: INTEGER;

(*-------------------------------------------------------------------------*)

{ THESE ARE ADDED AS NO-OPS TO GET THINGS WORKING. THE RESULT IS LOSS OF
  STORAGE. [SAM] }
PROCEDURE MARK(VAR P: MARKTYPE); BEGIN P := P (* SHUT UP *) END;
PROCEDURE RELEASE(P: MARKTYPE); BEGIN P := P (* SHUT UP *) END;

PROCEDURE ENDOFLINE;
    VAR LASTPOS,FREEPOS,CURRPOS,CURRNMR,F,K: INTEGER;
  BEGIN
    IF ERRINX > 0 THEN   (*OUTPUT ERROR MESSAGES*)
      BEGIN WRITE(OUTPUT,' ****  ':15);
        LASTPOS := 0; FREEPOS := 1;
        FOR K := 1 TO ERRINX DO
          BEGIN
            WITH ERRLIST[K] DO
              BEGIN CURRPOS := POS; CURRNMR := NMR END;
            IF CURRPOS = LASTPOS THEN WRITE(OUTPUT,',')
            ELSE
              BEGIN
                WHILE FREEPOS < CURRPOS DO
                  BEGIN WRITE(OUTPUT,' '); FREEPOS := FREEPOS + 1 END;
                WRITE(OUTPUT,'^');
                LASTPOS := CURRPOS
              END;
            IF CURRNMR < 10 THEN F := 1
            ELSE IF CURRNMR < 100 THEN F := 2
              ELSE F := 3;
            WRITE(OUTPUT,CURRNMR:F);
            FREEPOS := FREEPOS + F + 1
          END;
        WRITELN(OUTPUT); ERRINX := 0
      END;
    IF LIST THEN
      BEGIN LINECOUNT := LINECOUNT + 1; WRITE(OUTPUT,LINECOUNT:6,'  ':2);
        IF DP THEN WRITE(OUTPUT,LC:7) ELSE WRITE(OUTPUT,IC:7);
        WRITE(OUTPUT,' ')
      END;
    CHCNT := 0
  END  (*ENDOFLINE*) ;

  PROCEDURE ERROR(FERRNR: INTEGER);
  BEGIN
    IF ERRINX >= 9 THEN
      BEGIN ERRLIST[10].NMR := 255; ERRINX := 10 END
    ELSE
      BEGIN ERRINX := ERRINX + 1;
        ERRLIST[ERRINX].NMR := FERRNR
      END;
    ERRLIST[ERRINX].POS := CHCNT
  END (*ERROR*) ;

  PROCEDURE INSYMBOL;
    (*READ NEXT BASIC SYMBOL OF SOURCE PROGRAM AND RETURN ITS
    DESCRIPTION IN THE GLOBAL VARIABLES SY, OP, ID, VAL AND LGTH*)
    LABEL 1,2,3;
    VAR I,K: INTEGER;
        DIGIT: PACKED ARRAY [1..STRGLGTH] OF CHAR;
        STRING: PACKED ARRAY [1..STRGLGTH] OF CHAR;
        LVP: CSP;TEST: BOOLEAN;

    PROCEDURE NEXTCH;
    BEGIN IF EOL THEN
      BEGIN IF LIST THEN WRITELN(OUTPUT); ENDOFLINE
      END;
      IF NOT EOF(INPUT) THEN
       BEGIN EOL := EOLN(INPUT); READ(INPUT,CH);
        IF LIST THEN WRITE(OUTPUT,CH);
        CHCNT := CHCNT + 1
       END
      ELSE WRITELN(OUTPUT,'EOF ENCOUNTERED')
    END;

    PROCEDURE OPTIONS;
    BEGIN
      REPEAT NEXTCH;
        IF CH <> '*' THEN
          BEGIN
            IF CH = 'T' THEN
              BEGIN NEXTCH; PRTABLES := CH = '+' END
            ELSE
              IF CH = 'L' THEN
                BEGIN NEXTCH; LIST := CH = '+';
                  IF NOT LIST THEN WRITELN(OUTPUT)
                END
              ELSE
                IF CH = 'C' THEN
                  BEGIN NEXTCH; PRCODE := CH = '+' END;
            NEXTCH
          END
      UNTIL CH <> ','
    END (*OPTIONS*) ;

  { THIS CODE WAS MOVED HERE TO REFACTOR THE INSYMBOL CODE AND REMOVE THE
    NEED TO JUMP INTO AN INNER BLOCK. [SAM] }
  PROCEDURE CVTINT;
  VAR K: INTEGER;
  BEGIN
     IF I > DIGMAX THEN BEGIN ERROR(203); VAL.IVAL := 0 END
     ELSE
       WITH VAL DO
         BEGIN IVAL := 0;
           FOR K := 1 TO I DO
             BEGIN
               IF IVAL <= MXINT10 THEN
                 IVAL := IVAL*10 + (ORD(DIGIT[K])-ORD('0'))
               ELSE BEGIN ERROR(203); IVAL := 0 END
             END;
           SY := INTCONST
        END
  END;

  BEGIN (*INSYMBOL*)
  1:
    REPEAT WHILE (CH = ' ') AND NOT EOL DO NEXTCH;
      TEST := EOL;
      IF TEST THEN NEXTCH
    UNTIL NOT TEST;
    CASE CH OF
      'A','B','C','D','E','F','G','H','I',
      'J','K','L','M','N','O','P','Q','R',
      'S','T','U','V','W','X','Y','Z':
        BEGIN K := 0;
          REPEAT
            IF K < 8 THEN
             BEGIN K := K + 1; ID[K] := CH END ;
            NEXTCH
          { REPLACED CDC SPECIFIC CHARACTER TEST }
          UNTIL NOT (CH IN ['A','B','C','D','E','F','G','H','I',
                            'J','K','L','M','N','O','P','Q','R',
                            'S','T','U','V','W','X','Y','Z',
                            '0', '1', '1', '2', '3', '4',
                            '5', '6', '7', '8', '9'])
                {(ORD(CH)<ORD('A')) OR (ORD(CH)>ORD('9'))};
          IF K >= KK THEN KK := K
          ELSE
            REPEAT ID[KK] := ' '; KK := KK - 1
            UNTIL KK = K;
          FOR I := FRW[K] TO FRW[K+1] - 1 DO
            IF RW[I] = ID THEN
              BEGIN SY := RSY[I]; OP := ROP[I]; GOTO 2 END;
            SY := IDENT; OP := NOOP;
  2:    END;
      '0','1','2','3','4','5','6','7','8','9':
        BEGIN OP := NOOP; I := 0;
          REPEAT I := I+1; IF I<= DIGMAX THEN DIGIT[I] := CH; NEXTCH
          UNTIL (ORD(CH)<ORD('0')) OR (ORD(CH)>ORD('9'));
          IF (CH = '.') OR (CH = 'E') THEN
            BEGIN
                  K := I;
                  IF CH = '.' THEN
                    BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH;
                      NEXTCH; IF CH = '.' THEN BEGIN CH := ':'; CVTINT; GOTO 3
                                               END;
                      IF (ORD(CH)<ORD('0')) OR (ORD(CH)>ORD('9')) THEN
                        ERROR(201)
                      ELSE
                        REPEAT K := K + 1;
                          IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH
                        UNTIL (ORD(CH)<ORD('0')) OR (ORD(CH)>ORD('9'))
                    END;
                  IF CH = 'E' THEN
                    BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH;
                      NEXTCH;
                      IF (CH = '+') OR (CH ='-') THEN
                        BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH;
                          NEXTCH
                        END;
                      IF (ORD(CH)<ORD('0')) OR (ORD(CH)>ORD('9')) THEN
                        ERROR(201)
                      ELSE
                        REPEAT K := K+1;
                          IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH
                        UNTIL (ORD(CH)<ORD('0')) OR (ORD(CH)>ORD('9'))
                     END;
                   NEW(LVP,REEL); SY:= REALCONST; LVP^.CCLASS := REEL;
                   WITH LVP^ DO
                     BEGIN FOR I := 1 TO STRGLGTH DO RVAL[I] := ' ';
                       IF K <= DIGMAX THEN
                         FOR I := 2 TO K + 1 DO RVAL[I] := DIGIT[I-1]
                       ELSE BEGIN ERROR(203); RVAL[2] := '0';
                              RVAL[3] := '.'; RVAL[4] := '0'
                            END
                     END;
                   VAL.VALP := LVP;
  3:        END
          ELSE
  {3:}      BEGIN
              { MOVED TO REFACTOR [SAM] }
              CVTINT
              {
              IF I > DIGMAX THEN BEGIN ERROR(203); VAL.IVAL := 0 END
              ELSE
                WITH VAL DO
                  BEGIN IVAL := 0;
                    FOR K := 1 TO I DO
                      BEGIN
                        IF IVAL <= MXINT10 THEN
                          IVAL := IVAL*10 + (ORD(DIGIT[K])-ORD('0'))
                        ELSE BEGIN ERROR(203); IVAL := 0 END
                      END;
                    SY := INTCONST
                 END
              }
            END
        END;
      '''':
        BEGIN LGTH := 0; SY := STRINGCONST;  OP := NOOP;
          REPEAT
            REPEAT NEXTCH; LGTH := LGTH + 1;
                   IF LGTH <= STRGLGTH THEN STRING[LGTH] := CH
            UNTIL (EOL) OR (CH = '''');
            IF EOL THEN ERROR(202) ELSE NEXTCH
          UNTIL CH <> '''';
          LGTH := LGTH - 1;   (*NOW LGTH = NR OF CHARS IN STRING*)
          IF LGTH = 1 THEN VAL.IVAL := ORD(STRING[1])
          ELSE
            BEGIN NEW(LVP,STRG); LVP^.CCLASS:=STRG;
              IF LGTH > STRGLGTH THEN
                BEGIN ERROR(399); LGTH := STRGLGTH END;
              WITH LVP^ DO
                BEGIN SLGTH := LGTH;
                  FOR I := 1 TO LGTH DO SVAL[I] := STRING[I]
                END;
              VAL.VALP := LVP
            END
        END;
      ':':
        BEGIN OP := NOOP; NEXTCH;
          IF CH = '=' THEN
            BEGIN SY := BECOMES; NEXTCH END
          ELSE SY := COLON
        END;
      '.':
        BEGIN OP := NOOP; NEXTCH;
          IF CH = '.' THEN
            BEGIN SY := COLON; NEXTCH END
          ELSE SY := PERIOD
        END;
      '<':
        BEGIN NEXTCH; SY := RELOP;
          IF CH = '=' THEN
            BEGIN OP := LEOP; NEXTCH END
          ELSE
            IF CH = '>' THEN
              BEGIN OP := NEOP; NEXTCH END
            ELSE OP := LTOP
        END;
      '>':
        BEGIN NEXTCH; SY := RELOP;
          IF CH = '=' THEN
            BEGIN OP := GEOP; NEXTCH END
          ELSE OP := GTOP
        END;
      '(':
       BEGIN NEXTCH;
         IF CH = '*' THEN
           BEGIN NEXTCH;
             IF CH = '$' THEN OPTIONS;
             REPEAT
               WHILE CH <> '*'  DO NEXTCH;
               NEXTCH
             UNTIL CH = ')';
             NEXTCH; GOTO 1
           END;
         SY := LPARENT; OP := NOOP
       END;
      '*','+','-',
      '=','/',')',
      '[',']',',',';','^','$':
        BEGIN SY := SSY[CH]; OP := SOP[CH];
          NEXTCH
        END;
      { THIS SECTION FILLS OUT THE CASE FOR THE ENTIRE CHARACTER SET. I CHANGED
        IT TO USE THE ISO 8859-1 (ASCII) CHARACTER SET FROM THE ORIGINAL CDC
        CHARACTER SET. THE CHARACTERS ARE ALL THOSE THAT ARE NOT USED IN THE
        LANGUAGE, AND THEY APPEAR IN ISO 8859-1 ORDERING. [SAM] }
      '!','"','#','%', '&','?','@','\','_','`','{','|','~',' ':
        BEGIN SY := OTHERSY; OP := NOOP; ERROR(399) END
    END (*CASE*)
  END (*INSYMBOL*) ;

  PROCEDURE ENTERID(FCP: CTP);
    (*ENTER ID POINTED AT BY FCP INTO THE NAME-TABLE,
     WHICH ON EACH DECLARATION LEVEL IS ORGANISED AS
     AN UNBALANCED BINARY TREE*)
    VAR NAM: ALPHA; LCP, LCP1: CTP; LLEFT: BOOLEAN;
  BEGIN NAM := FCP^.NAME;
    LCP := DISPLAY[TOP].FNAME;
    IF LCP = NIL THEN
      DISPLAY[TOP].FNAME := FCP
    ELSE
      BEGIN
        REPEAT LCP1 := LCP;
          IF LCP^.NAME = NAM THEN   (*NAME CONFLICT, FOLLOW RIGHT LINK*)
            BEGIN ERROR(101); LCP := LCP^.RLINK; LLEFT := FALSE END
          ELSE
            IF LCP^.NAME < NAM THEN
              BEGIN LCP := LCP^.RLINK; LLEFT := FALSE END
            ELSE BEGIN LCP := LCP^.LLINK; LLEFT := TRUE END
        UNTIL LCP = NIL;
        IF LLEFT THEN LCP1^.LLINK := FCP ELSE LCP1^.RLINK := FCP
      END;
    FCP^.LLINK := NIL; FCP^.RLINK := NIL
  END (*ENTERID*) ;

  PROCEDURE SEARCHSECTION(FCP: CTP; VAR FCP1: CTP);
    (*TO FIND RECORD FIELDS AND FORWARD DECLARED PROCEDURE ID'S
     --> PROCEDURE PROCEDUREDECLARATION
     --> PROCEDURE SELECTOR*)
     LABEL 1;
  BEGIN
    WHILE FCP <> NIL DO
      IF FCP^.NAME = ID THEN GOTO 1
      ELSE IF FCP^.NAME < ID THEN FCP := FCP^.RLINK
        ELSE FCP := FCP^.LLINK;
1:  FCP1 := FCP
  END (*SEARCHSECTION*) ;

  PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP);
    LABEL 1;
    VAR LCP: CTP;
        { THIS NEEDED TO BE LOCAL [SAM] }
        DISXL: DISPRANGE; (*LEVEL OF LAST ID SEARCHED BY SEARCHID*)
  BEGIN
    FOR DISXL := TOP DOWNTO 0 DO
      { BECAUSE THE ORIGINAL PROGRAM RELIES ON USING THE EARLY OUT VALUE OF
        DISX, WE SIMULATE THIS BEHAVIOR BY ASSIGNING THE LOCAL DISXL (LOCAL
        DISX, AS ISO 7185 REQUIRES) TO THE GLOBAL DISX ON EACH LOOP. }
      BEGIN DISX := DISXL; LCP := DISPLAY[DISXL].FNAME;
        WHILE LCP <> NIL DO
          IF LCP^.NAME = ID THEN
            IF LCP^.KLASS IN FIDCLS THEN GOTO 1
            ELSE
              BEGIN IF PRTERR THEN ERROR(103);
                LCP := LCP^.RLINK
              END
          ELSE
            IF LCP^.NAME < ID THEN
              LCP := LCP^.RLINK
            ELSE LCP := LCP^.LLINK
      END;
    (*SEARCH NOT SUCCSESSFUL; SUPPRESS ERROR MESSAGE IN CASE
     OF FORWARD REFERENCED TYPE ID IN POINTER TYPE DEFINITION
     --> PROCEDURE SIMPLETYPE*)
    IF PRTERR THEN
      BEGIN ERROR(104);
        (*TO AVOID RETURNING NIL, REFERENCE AN ENTRY
         FOR AN UNDECLARED ID OF APPROPRIATE CLASS
         --> PROCEDURE ENTERUNDECL*)
        IF TYPES IN FIDCLS THEN LCP := UTYPPTR
        ELSE
          IF VARS IN FIDCLS THEN LCP := UVARPTR
          ELSE
            IF FIELD IN FIDCLS THEN LCP := UFLDPTR
            ELSE
              IF KONST IN FIDCLS THEN LCP := UCSTPTR
              ELSE
                IF PROC IN FIDCLS THEN LCP := UPRCPTR
                ELSE LCP := UFCTPTR;
      END;
1:  FCP := LCP
  END (*SEARCHID*) ;

  PROCEDURE GETBOUNDS(FSP: STP; VAR FMIN,FMAX: INTEGER);
    (*GET INTERNAL BOUNDS OF SUBRANGE OR SCALAR TYPE*)
    (*ASSUME (FSP <> NIL) AND (FSP^.FORM <= SUBRANGE) AND (FSP <> INTPTR)
     AND NOT COMPTYPES(REALPTR,FSP)*)
  BEGIN
    WITH FSP^ DO
      IF FORM = SUBRANGE THEN
        BEGIN FMIN := MIN.IVAL; FMAX := MAX.IVAL END
      ELSE
        BEGIN FMIN := 0;
          IF FSP = CHARPTR THEN FMAX := 63
          ELSE
            IF FSP^.FCONST <> NIL THEN
              FMAX := FSP^.FCONST^.VALUES.IVAL
            ELSE FMAX := 0
        END
  END (*GETBOUNDS*) ;

  PROCEDURE PRINTTABLES(FB: BOOLEAN);
    (*PRINT DATA STRUCTURE AND NAME TABLE*)
    VAR I, LIM: DISPRANGE;

    PROCEDURE MARKER;
      (*MARK DATA STRUCTURE ENTRIES TO AVOID MULTIPLE PRINTOUT*)
      VAR I: INTEGER;

      PROCEDURE MARKCTP(FP: CTP); FORWARD;

      PROCEDURE MARKSTP(FP: STP);
        (*MARK DATA STRUCTURES, PREVENT CYCLES*)
      BEGIN
        IF FP <> NIL THEN
          WITH FP^ DO
            BEGIN MARKED := TRUE;
              CASE FORM OF
              SCALAR:   ;
              SUBRANGE: MARKSTP(RANGETYPE);
              POINTER:  (*DON'T MARK ELTYPE: CYCLE POSSIBLE; WILL BE MARKED
                        ANYWAY, IF FP = TRUE*) ;
              POWER:    MARKSTP(ELSET) ;
              ARRAYS:   BEGIN MARKSTP(AELTYPE); MARKSTP(INXTYPE) END;
              RECORDS:  BEGIN MARKCTP(FSTFLD); MARKSTP(RECVAR) END;
              FILES:    MARKSTP(FILTYPE);
              TAGFLD:   MARKSTP(FSTVAR);
              VARIANT:  BEGIN MARKSTP(NXTVAR); MARKSTP(SUBVAR) END
              END (*CASE*)
            END (*WITH*)
      END (*MARKSTP*);

      PROCEDURE MARKCTP;
      BEGIN
        IF FP <> NIL THEN
          WITH FP^ DO
            BEGIN MARKCTP(LLINK); MARKCTP(RLINK);
              MARKSTP(IDTYPE)
            END
      END (*MARKCTP*);

    BEGIN (*MARK*)
      FOR I := TOP DOWNTO LIM DO
        MARKCTP(DISPLAY[I].FNAME)
    END (*MARK*);

    { THE ORIGINAL COMPILER USED ORD() TO ACT AS A UNIVERSAL TYPE ESCAPE.
      THIS WAS CHANGED TO USE A MORE GENERALLY AVAILABLE METHOD WITH
      UNDISCRIMINATED VARIANTS. LOOK FOR THESE NEW DEFINITIONS IN THE ROUTINES
      FOLLOWSTP AND FOLLOWCTP BELOW. [SAM] }
    FUNCTION ORDSTP(P: STP): INTEGER;
    VAR TCR: RECORD CASE BOOLEAN OF TRUE: (A: STP); FALSE: (B: INTEGER) END;
    BEGIN TCR.A := P; ORDSTP := TCR.B END;
    FUNCTION ORDCTP(P: CTP): INTEGER;
    VAR TCR: RECORD CASE BOOLEAN OF TRUE: (A: CTP); FALSE: (B: INTEGER) END;
    BEGIN TCR.A := P; ORDCTP := TCR.B END;

    PROCEDURE FOLLOWCTP(FP: CTP); FORWARD;

    PROCEDURE FOLLOWSTP(FP: STP);
    BEGIN
      IF FP <> NIL THEN
        WITH FP^ DO
          IF MARKED THEN
            BEGIN MARKED := FALSE; WRITE(OUTPUT,' ':4,ORDSTP(FP):6,SIZE:10);
              CASE FORM OF
              SCALAR:   BEGIN WRITE(OUTPUT,'SCALAR':10);
                          IF SCALKIND = STANDARD THEN
                           WRITE(OUTPUT,'STANDARD':10)
                          ELSE WRITE(OUTPUT,'DECLARED':10,' ':4,ORDCTP(FCONST):6);
                          WRITELN(OUTPUT)
                        END;
              SUBRANGE:BEGIN
                        WRITE(OUTPUT,'SUBRANGE':10,' ':4,ORDSTP(RANGETYPE):6);
                            IF RANGETYPE <> REALPTR THEN
                              WRITE(OUTPUT,MIN.IVAL,MAX.IVAL)
                            ELSE
                              IF (MIN.VALP <> NIL) AND (MAX.VALP <> NIL) THEN
                                WRITE(OUTPUT,' ',MIN.VALP^.RVAL:9,
                                      ' ',MAX.VALP^.RVAL:9);
                            WRITELN(OUTPUT); FOLLOWSTP(RANGETYPE);
                          END;

              POINTER:  WRITELN(OUTPUT,'POINTER':10,' ':4,ORDSTP(ELTYPE):6);
              POWER:    BEGIN WRITELN(OUTPUT,'SET':10,' ':4,ORDSTP(ELSET):6);
                            FOLLOWSTP(ELSET)
                          END;
              ARRAYS:   BEGIN
                         WRITELN(OUTPUT,'ARRAY':10,' ':4,ORDSTP(AELTYPE):6,' ':4,
                            ORDSTP(INXTYPE):6);
                            FOLLOWSTP(AELTYPE); FOLLOWSTP(INXTYPE)
                          END;
              RECORDS:  BEGIN
                        WRITELN(OUTPUT,'RECORD':10,' ':4,ORDCTP(FSTFLD):6,' ':4,
                            ORDSTP(RECVAR):6); FOLLOWCTP(FSTFLD);
                            FOLLOWSTP(RECVAR)
                          END;
              FILES:    BEGIN WRITE(OUTPUT,'FILE':10,' ':4,ORDSTP(FILTYPE):6);
                            FOLLOWSTP(FILTYPE)
                          END;
              TAGFLD:   BEGIN WRITELN(OUTPUT,'TAGFLD':10,' ':4,ORDCTP(TAGFIELDP):6,
                            ' ':4,ORDSTP(FSTVAR):6);
                            FOLLOWSTP(FSTVAR)
                          END;
              VARIANT:  BEGIN WRITELN(OUTPUT,'VARIANT':10,' ':4,ORDSTP(NXTVAR):6,
                            ' ':4,ORDSTP(SUBVAR):6,VARVAL.IVAL);
                            FOLLOWSTP(NXTVAR); FOLLOWSTP(SUBVAR)
                          END
              END (*CASE*)
            END (*IF MARKED*)
    END (*FOLLOWSTP*);

    PROCEDURE FOLLOWCTP;
      VAR I: INTEGER;
    BEGIN
      IF FP <> NIL THEN
        WITH FP^ DO
          BEGIN WRITE(OUTPUT,' ':4,ORDCTP(FP):6,' ',NAME:9,' ':4,ORDCTP(LLINK):6,
            ' ':4,ORDCTP(RLINK):6,' ':4,ORDSTP(IDTYPE):6);
            CASE KLASS OF
              TYPES: WRITE(OUTPUT,'TYPE':10);
              KONST: BEGIN WRITE(OUTPUT,'CONSTANT':10,' ':4,ORDCTP(NEXT):6);
                     IF IDTYPE <> NIL THEN
                         IF IDTYPE = REALPTR THEN
                           BEGIN
                             IF VALUES.VALP <> NIL THEN
                               WRITE(OUTPUT,' ',VALUES.VALP^.RVAL:9)
                           END
                         ELSE
                           IF IDTYPE^.FORM = ARRAYS THEN  (*STRINGCONST*)
                             BEGIN
                               IF VALUES.VALP <> NIL THEN
                                 BEGIN WRITE(OUTPUT,' ');
                                   WITH VALUES.VALP^ DO
                                     FOR I := 1 TO SLGTH DO
                                      WRITE(OUTPUT,SVAL[I])
                                 END
                             END
                           ELSE WRITE(OUTPUT,VALUES.IVAL)
                       END;
              VARS:  BEGIN WRITE(OUTPUT,'VARIABLE':10);
                        IF VKIND = ACTUAL THEN WRITE(OUTPUT,'ACTUAL':10)
                        ELSE WRITE(OUTPUT,'FORMAL':10);
                        WRITE(OUTPUT,' ':4,ORDCTP(NEXT):6,VLEV,' ':4,VADDR:6 );
                      END;
              FIELD: WRITE(OUTPUT,'FIELD':10,' ':4,ORDCTP(NEXT):6,' ':4,FLDADDR:6);
              PROC,
              FUNC:  BEGIN
                        IF KLASS = PROC THEN WRITE(OUTPUT,'PROCEDURE':10)
                        ELSE WRITE(OUTPUT,'FUNCTION':10);
                        IF PFDECKIND = STANDARD THEN
                         WRITE(OUTPUT,'STANDARD':10,
                          KEY:10)
                        ELSE
                          BEGIN WRITE(OUTPUT,'DECLARED':10,' ':4,ORDCTP(NEXT):6);
                            WRITE(OUTPUT,PFLEV,' ':4,PFNAME:6);
                            IF PFKIND = ACTUAL THEN
                              BEGIN WRITE(OUTPUT,'ACTUAL':10);
                                IF FORWDECL THEN WRITE(OUTPUT,'FORWARD':10)
                                ELSE WRITE(OUTPUT,'NOTFORWARD':10);
                                IF EXTERN THEN WRITE(OUTPUT,'EXTERN':10)
                                ELSE WRITE(OUTPUT,'NOT EXTERN':10);
                              END
                            ELSE WRITE(OUTPUT,'FORMAL':10)
                          END
                     END
            END (*CASE*);
            WRITELN(OUTPUT); FOLLOWCTP(LLINK); FOLLOWCTP(RLINK);
            FOLLOWSTP(IDTYPE)
          END (*WITH*)
    END (*FOLLOWCTP*);

  BEGIN (*PRINTTABLES*)
    WRITELN(OUTPUT); WRITELN(OUTPUT); WRITELN(OUTPUT);
    IF FB THEN LIM := 0
    ELSE BEGIN LIM := TOP; WRITE(OUTPUT,' LOCAL') END;
    WRITELN(OUTPUT,' TABLES '); WRITELN(OUTPUT);
    MARKER;
    FOR I := TOP DOWNTO LIM DO
      FOLLOWCTP(DISPLAY[I].FNAME);
      WRITELN(OUTPUT);
      IF NOT EOL THEN WRITE(OUTPUT,' ':CHCNT+16)
  END (*PRINTTABLES*);

  PROCEDURE GENLABEL(VAR NXTLAB: INTEGER);
  BEGIN INTLABEL := INTLABEL + 1;
    NXTLAB := INTLABEL
  END (*GENLABEL*);

  PROCEDURE BLOCK(FSYS: SETOFSYS; FSY: SYMBOL; FPROCP: CTP);
    VAR LSY: SYMBOL; TEST: BOOLEAN;

    PROCEDURE SKIP(FSYS: SETOFSYS);
      (*SKIP INPUT STRING UNTIL RELEVANT SYMBOL FOUND*)
    BEGIN WHILE NOT(SY IN FSYS) DO INSYMBOL
    END (*SKIP*) ;

    PROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU);
      VAR LSP: STP; LCP: CTP; SIGN: (NONE,POS,NEG);
          LVP: CSP; I: 2..STRGLGTH;
    BEGIN LSP := NIL; FVALU.IVAL := 0;
      IF NOT(SY IN CONSTBEGSYS) THEN
        BEGIN ERROR(50); SKIP(FSYS+CONSTBEGSYS) END;
      IF SY IN CONSTBEGSYS THEN
        BEGIN
          { STRINGCONSTSY CHANGED TO STRINGCONST. THE MISTAKE SURVIVED ONLY
            BECAUSE THE ORIGINAL IMPLEMENTATIONS RECOGNIZED 8 CHARACTERS ONLY.
            [SAM] }
          IF SY = STRINGCONST THEN
            BEGIN
              IF LGTH = 1 THEN LSP := CHARPTR
              ELSE
                BEGIN
                  NEW(LSP,ARRAYS);
                  WITH LSP^ DO
                    BEGIN AELTYPE := CHARPTR; INXTYPE := NIL;
                       SIZE := LGTH*CHARSIZE; FORM := ARRAYS
                    END
                END;
              FVALU := VAL; INSYMBOL
            END
          ELSE
            BEGIN
              SIGN := NONE;
              IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THEN
                BEGIN IF OP = PLUS THEN SIGN := POS ELSE SIGN := NEG;
                  INSYMBOL
                END;
              IF SY = IDENT THEN
                BEGIN SEARCHID([KONST],LCP);
                  WITH LCP^ DO
                    BEGIN LSP := IDTYPE; FVALU := VALUES END;
                  IF SIGN <> NONE THEN
                    IF LSP = INTPTR THEN
                      BEGIN IF SIGN = NEG THEN FVALU.IVAL := -FVALU.IVAL END
                    ELSE
                      IF LSP = REALPTR THEN
                        BEGIN
                          IF SIGN = NEG THEN
                            BEGIN NEW(LVP,REEL);
                              IF FVALU.VALP^.RVAL[1] = '-' THEN
                                LVP^.RVAL[1] := '+'
                              ELSE LVP^.RVAL[1] := '-';
                              FOR I := 2 TO STRGLGTH DO
                                LVP^.RVAL[I] := FVALU.VALP^.RVAL[I];
                              FVALU.VALP := LVP;
                            END
                          END
                        ELSE ERROR(105);
                  INSYMBOL;
                END
              ELSE
                IF SY = INTCONST THEN
                  BEGIN IF SIGN = NEG THEN VAL.IVAL := -VAL.IVAL;
                    LSP := INTPTR; FVALU := VAL; INSYMBOL
                  END
                ELSE
                  IF SY = REALCONST THEN
                    BEGIN IF SIGN = NEG THEN VAL.VALP^.RVAL[1] := '-';
                      LSP := REALPTR; FVALU := VAL; INSYMBOL
                    END
                  ELSE
                    BEGIN ERROR(106); SKIP(FSYS) END
            END;
          IF NOT (SY IN FSYS) THEN
            BEGIN ERROR(6); SKIP(FSYS) END
          END;
      FSP := LSP
    END (*CONSTANT*) ;

    FUNCTION COMPTYPES(FSP1,FSP2: STP) : BOOLEAN;
      (*DECIDE WHETHER STRUCTURES POINTED AT BY FSP1 AND FSP2 ARE COMPATIBLE*)
      VAR NXT1,NXT2: CTP; COMP: BOOLEAN;
        LTESTP1,LTESTP2 : TESTP;
    BEGIN
      IF FSP1 = FSP2 THEN COMPTYPES := TRUE
      ELSE
        IF (FSP1 <> NIL) AND (FSP2 <> NIL) THEN
          IF FSP1^.FORM = FSP2^.FORM THEN
            CASE FSP1^.FORM OF
              SCALAR:
                COMPTYPES := FALSE;
                (* IDENTICAL SCALARS DECLARED ON DIFFERENT LEVELS ARE
                 NOT RECOGNIZED TO BE COMPATIBLE*)
              SUBRANGE:
                COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,FSP2^.RANGETYPE);
              POINTER:
                  BEGIN
                    COMP := FALSE; LTESTP1 := GLOBTESTP;
                    LTESTP2 := GLOBTESTP;
                    WHILE LTESTP1 <> NIL DO
                      WITH LTESTP1^ DO
                        BEGIN
                          IF (ELT1 = FSP1^.ELTYPE) AND
                            (ELT2 = FSP2^.ELTYPE) THEN COMP := TRUE;
                          LTESTP1 := LASTTESTP
                        END;
                    IF NOT COMP THEN

            BEGIN NEW(LTESTP1);
                        WITH LTESTP1^ DO
                          BEGIN ELT1 := FSP1^.ELTYPE;
                            ELT2 := FSP2^.ELTYPE;
                            LASTTESTP := GLOBTESTP
                          END;
                        GLOBTESTP := LTESTP1;
                        COMP := COMPTYPES(FSP1^.ELTYPE,FSP2^.ELTYPE)
                      END;
                    COMPTYPES := COMP; GLOBTESTP := LTESTP2
                  END;
              POWER:
                COMPTYPES := COMPTYPES(FSP1^.ELSET,FSP2^.ELSET);
              ARRAYS:
                COMPTYPES := COMPTYPES(FSP1^.AELTYPE,FSP2^.AELTYPE)
                             AND (FSP1^.SIZE = FSP2^.SIZE);
                (*ALTERNATIVES: -- ADD A THIRD BOOLEAN TERM: INDEXTYPE MUST
                                  BE COMPATIBLE.
                               -- ADD A FOURTH BOOLEAN TERM: LOWBOUNDS MUST
                                  BE THE SAME*)
              RECORDS:
                BEGIN NXT1 := FSP1^.FSTFLD; NXT2 := FSP2^.FSTFLD; COMP:=TRUE;
                  WHILE (NXT1 <> NIL) AND (NXT2 <> NIL) DO
                    BEGIN COMP:=COMP AND COMPTYPES(NXT1^.IDTYPE,NXT2^.IDTYPE);
                      NXT1 := NXT1^.NEXT; NXT2 := NXT2^.NEXT
                    END;
                  COMPTYPES := COMP AND (NXT1 = NIL) AND (NXT2 = NIL)
                              AND(FSP1^.RECVAR = NIL)AND(FSP2^.RECVAR = NIL)
                END;
                (*IDENTICAL RECORDS ARE RECOGNIZED TO BE COMPATIBLE
                 IFF NO VARIANTS OCCUR*)
              FILES:
                COMPTYPES := COMPTYPES(FSP1^.FILTYPE,FSP2^.FILTYPE)
            END (*CASE*)
          ELSE (*FSP1^.FORM <> FSP2^.FORM*)
            IF FSP1^.FORM = SUBRANGE THEN
              COMPTYPES := COMPTYPES(FSP1^.RANGETYPE,FSP2)
            ELSE
              IF FSP2^.FORM = SUBRANGE THEN
                COMPTYPES := COMPTYPES(FSP1,FSP2^.RANGETYPE)
              ELSE COMPTYPES := FALSE
        ELSE COMPTYPES := TRUE
    END (*COMPTYPES*) ;

    FUNCTION STRING(FSP: STP) : BOOLEAN;
    BEGIN STRING := FALSE;
      IF FSP <> NIL THEN
        IF FSP^.FORM = ARRAYS THEN
          IF COMPTYPES(FSP^.AELTYPE,CHARPTR) THEN STRING := TRUE
    END (*STRING*) ;

    PROCEDURE TYP(FSYS: SETOFSYS; VAR FSP: STP; VAR FSIZE: ADDRRANGE);
      VAR LSP,LSP1,LSP2: STP; OLDTOP: DISPRANGE; LCP: CTP;
          LSIZE,DISPL: ADDRRANGE; LMIN,LMAX: INTEGER;

      PROCEDURE SIMPLETYPE(FSYS:SETOFSYS; VAR FSP:STP; VAR FSIZE:ADDRRANGE);
        VAR LSP,LSP1: STP; LCP,LCP1: CTP; TTOP: DISPRANGE;
            LCNT: INTEGER; LVALU: VALU;
      BEGIN FSIZE := 1;
        IF NOT (SY IN SIMPTYPEBEGSYS) THEN
          BEGIN ERROR(1); SKIP(FSYS + SIMPTYPEBEGSYS) END;
        IF SY IN SIMPTYPEBEGSYS THEN
          BEGIN
            IF SY = LPARENT THEN
              BEGIN TTOP := TOP;   (*DECL. CONSTS LOCAL TO INNERMOST BLOCK*)
                WHILE DISPLAY[TOP].OCCUR <> BLCK DO TOP := TOP - 1;
                NEW(LSP,SCALAR,DECLARED);
                WITH LSP^ DO
                  BEGIN SIZE := INTSIZE; FORM := SCALAR;
                    SCALKIND := DECLARED
                  END;
                LCP1 := NIL; LCNT := 0;
                REPEAT INSYMBOL;
                  IF SY = IDENT THEN
                    BEGIN NEW(LCP,KONST);
                      WITH LCP^ DO
                        BEGIN NAME := ID; IDTYPE := LSP; NEXT := LCP1;
                          VALUES.IVAL := LCNT; KLASS := KONST
                        END;
                      ENTERID(LCP);
                      LCNT := LCNT + 1;
                      LCP1 := LCP; INSYMBOL
                    END
                  ELSE ERROR(2);
                  IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN
                    BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END
                UNTIL SY <> COMMA;
                LSP^.FCONST := LCP1; TOP := TTOP;
                IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
              END
            ELSE
              BEGIN
                IF SY = IDENT THEN
                  BEGIN SEARCHID([TYPES,KONST],LCP);
                    INSYMBOL;
                    IF LCP^.KLASS = KONST THEN
                      BEGIN NEW(LSP,SUBRANGE);
                        WITH LSP^, LCP^ DO
                          BEGIN RANGETYPE := IDTYPE; FORM := SUBRANGE;
                            IF STRING(RANGETYPE) THEN
                              BEGIN ERROR(148); RANGETYPE := NIL END;
                            MIN := VALUES; SIZE := INTSIZE
                          END;
                        IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
                        CONSTANT(FSYS,LSP1,LVALU);
                        LSP^.MAX := LVALU;
                        IF LSP^.RANGETYPE <> LSP1 THEN ERROR(107)
                      END
                    ELSE
                      BEGIN LSP := LCP^.IDTYPE;
                        IF LSP <> NIL THEN FSIZE := LSP^.SIZE
                      END
                  END (*SY = IDENT*)
                ELSE
                  BEGIN NEW(LSP,SUBRANGE); LSP^.FORM := SUBRANGE;
                    CONSTANT(FSYS + [COLON],LSP1,LVALU);
                    IF STRING(LSP1) THEN
                      BEGIN ERROR(148); LSP1 := NIL END;
                    WITH LSP^ DO
                      BEGIN RANGETYPE:=LSP1; MIN:=LVALU; SIZE:=INTSIZE END;
                    IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
                    CONSTANT(FSYS,LSP1,LVALU);
                    LSP^.MAX := LVALU;
                    IF LSP^.RANGETYPE <> LSP1 THEN ERROR(107)
                  END;
                IF LSP <> NIL THEN
                  WITH LSP^ DO
                    IF FORM = SUBRANGE THEN
                      IF RANGETYPE <> NIL THEN
                        IF RANGETYPE = REALPTR THEN ERROR(399)
                        ELSE
                          IF MIN.IVAL > MAX.IVAL THEN ERROR(102)
              END;
            FSP := LSP;
            IF NOT (SY IN FSYS) THEN
              BEGIN ERROR(6); SKIP(FSYS) END
          END
            ELSE FSP := NIL
      END (*SIMPLETYPE*) ;

      PROCEDURE FIELDLIST(FSYS: SETOFSYS; VAR FRECVAR: STP);
        VAR LCP,LCP1,NXT,NXT1: CTP; LSP,LSP1,LSP2,LSP3,LSP4: STP;
            MINSIZE,MAXSIZE,LSIZE: ADDRRANGE; LVALU: VALU;
      BEGIN NXT1 := NIL; LSP := NIL;
        IF NOT (SY IN [IDENT,CASESY]) THEN
          BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END;
        WHILE SY = IDENT DO
          BEGIN NXT := NXT1;
            REPEAT
              IF SY = IDENT THEN
                BEGIN NEW(LCP,FIELD);
                  WITH LCP^ DO
                    BEGIN NAME := ID; IDTYPE := NIL; NEXT := NXT;
                      KLASS := FIELD
                    END;
                  NXT := LCP;
                  ENTERID(LCP);
                  INSYMBOL
                END
              ELSE ERROR(2);
              IF NOT (SY IN [COMMA,COLON]) THEN
                BEGIN ERROR(6); SKIP(FSYS + [COMMA,COLON,SEMICOLON,CASESY])
                END;
            TEST := SY <> COMMA;
              IF NOT TEST  THEN INSYMBOL
            UNTIL TEST;
            IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
            TYP(FSYS + [CASESY,SEMICOLON],LSP,LSIZE);
            WHILE NXT <> NXT1 DO
              WITH NXT^ DO
                BEGIN IDTYPE := LSP; FLDADDR := DISPL;
                  NXT := NEXT; DISPL := DISPL + LSIZE
                END;
            NXT1 := LCP;
            IF SY = SEMICOLON THEN
              BEGIN INSYMBOL;
                IF NOT (SY IN [IDENT,CASESY]) THEN
                  BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END
              END
          END (*WHILE*);
        NXT := NIL;
        WHILE NXT1 <> NIL DO
          WITH NXT1^ DO
            BEGIN LCP := NEXT; NEXT := NXT; NXT := NXT1; NXT1 := LCP END;
        IF SY = CASESY THEN
          BEGIN NEW(LSP,TAGFLD);
            WITH LSP^ DO
              BEGIN TAGFIELDP := NIL; FSTVAR := NIL; FORM:=TAGFLD END;
            FRECVAR := LSP;
            INSYMBOL;
            IF SY = IDENT THEN
              BEGIN NEW(LCP,FIELD);
                WITH LCP^ DO
                  BEGIN NAME := ID; IDTYPE := NIL; KLASS:=FIELD;
                    NEXT := NIL; FLDADDR := DISPL
                  END;
                ENTERID(LCP);
                INSYMBOL;
                IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
                IF SY = IDENT THEN
                  BEGIN SEARCHID([TYPES],LCP1);
                    LSP1 := LCP1^.IDTYPE;
                    IF LSP1 <> NIL THEN
                      BEGIN DISPL := DISPL + LSP1^.SIZE;
                        IF (LSP1^.FORM <= SUBRANGE) OR STRING(LSP1) THEN
                          BEGIN IF COMPTYPES(REALPTR,LSP1) THEN ERROR(109)
                            ELSE IF STRING(LSP1) THEN ERROR(399);
                            LCP^.IDTYPE := LSP1; LSP^.TAGFIELDP := LCP;
                          END
                        ELSE ERROR(110);
                    END;
                    INSYMBOL;
                  END
                ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END
              END
            ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END;
            LSP^.SIZE := DISPL;
            IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
            LSP1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL;
            REPEAT LSP2 := NIL;
              REPEAT CONSTANT(FSYS + [COMMA,COLON,LPARENT],LSP3,LVALU);
                IF LSP^.TAGFIELDP <> NIL THEN
                 IF NOT COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP3)THEN ERROR(111);
                NEW(LSP3,VARIANT);
                WITH LSP3^ DO
                  BEGIN NXTVAR := LSP1; SUBVAR := LSP2; VARVAL := LVALU;
                    FORM := VARIANT
                  END;
                LSP1 := LSP3; LSP2 := LSP3;
                TEST := SY <> COMMA;
                IF NOT TEST THEN INSYMBOL
              UNTIL TEST;
              IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
              IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9);
              FIELDLIST(FSYS + [RPARENT,SEMICOLON],LSP2);
              IF DISPL > MAXSIZE THEN MAXSIZE := DISPL;
              WHILE LSP3 <> NIL DO
                BEGIN LSP4 := LSP3^.SUBVAR; LSP3^.SUBVAR := LSP2;
                  LSP3^.SIZE := DISPL;
                  LSP3 := LSP4
                END;
              IF SY = RPARENT THEN
                BEGIN INSYMBOL;
                  IF NOT (SY IN FSYS + [SEMICOLON]) THEN
                    BEGIN ERROR(6); SKIP(FSYS + [SEMICOLON]) END
                END
              ELSE ERROR(4);
              TEST := SY <> SEMICOLON;
              IF NOT TEST THEN
                BEGIN DISPL := MINSIZE;
                      INSYMBOL
                END
            UNTIL TEST;
            DISPL := MAXSIZE;
            LSP^.FSTVAR := LSP1;
          END
        ELSE FRECVAR := NIL
      END (*FIELDLIST*) ;

    BEGIN (*TYP*)
      IF NOT (SY IN TYPEBEGSYS) THEN
         BEGIN ERROR(10); SKIP(FSYS + TYPEBEGSYS) END;
      IF SY IN TYPEBEGSYS THEN
        BEGIN
          IF SY IN SIMPTYPEBEGSYS THEN SIMPLETYPE(FSYS,FSP,FSIZE)
          ELSE
    (*^*)     IF SY = ARROW THEN
              BEGIN NEW(LSP,POINTER); FSP := LSP;
                WITH LSP^ DO
                  BEGIN ELTYPE := NIL; SIZE := PTRSIZE; FORM:=POINTER END;
                INSYMBOL;
                IF SY = IDENT THEN
                  BEGIN PRTERR := FALSE; (*NO ERROR IF SEARCH NOT SUCCESSFUL*)
                    SEARCHID([TYPES],LCP); PRTERR := TRUE;
                    IF LCP = NIL THEN   (*FORWARD REFERENCED TYPE ID*)
                      BEGIN NEW(LCP,TYPES);
                        WITH LCP^ DO
                          BEGIN NAME := ID; IDTYPE := LSP;
                            NEXT := FWPTR; KLASS := TYPES
                          END;
                        FWPTR := LCP
                      END
                    ELSE
                      BEGIN
                        IF LCP^.IDTYPE <> NIL THEN
                          IF LCP^.IDTYPE^.FORM = FILES THEN ERROR(108)
                          ELSE LSP^.ELTYPE := LCP^.IDTYPE
                      END;
                    INSYMBOL;
                  END
                ELSE ERROR(2);
              END
            ELSE
              BEGIN
                IF SY = PACKEDSY THEN
                  BEGIN INSYMBOL;
                    IF NOT (SY IN TYPEDELS) THEN
                      BEGIN
                        ERROR(10); SKIP(FSYS + TYPEDELS)
                      END
                  END;
    (*ARRAY*)     IF SY = ARRAYSY THEN
                  BEGIN INSYMBOL;
                    IF SY = LBRACK THEN INSYMBOL ELSE ERROR(11);
                    LSP1 := NIL;
                    REPEAT NEW(LSP,ARRAYS);
                      WITH LSP^ DO
                        BEGIN AELTYPE := LSP1; INXTYPE := NIL; FORM:=ARRAYS END;
                      LSP1 := LSP;
                      SIMPLETYPE(FSYS + [COMMA,RBRACK,OFSY],LSP2,LSIZE);
                      LSP1^.SIZE := LSIZE;
                      IF LSP2 <> NIL THEN
                        IF LSP2^.FORM <= SUBRANGE THEN
                          BEGIN
                            IF LSP2 = REALPTR THEN
                              BEGIN ERROR(109); LSP2 := NIL END
                            ELSE
                              IF LSP2 = INTPTR THEN
                                BEGIN ERROR(149); LSP2 := NIL END;
                            LSP^.INXTYPE := LSP2
                          END
                        ELSE BEGIN ERROR(113); LSP2 := NIL END;
                      TEST := SY <> COMMA;
                      IF NOT TEST THEN INSYMBOL
                    UNTIL TEST;
                    IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12);
                    IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
                    TYP(FSYS,LSP,LSIZE);
                    REPEAT
                      WITH LSP1^ DO
                        BEGIN LSP2 := AELTYPE; AELTYPE := LSP;
                          IF INXTYPE <> NIL THEN
                            BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);
                              LSIZE := LSIZE*(LMAX - LMIN + 1);
                              SIZE := LSIZE
                            END
                        END;
                      LSP := LSP1; LSP1 := LSP2
                    UNTIL LSP1 = NIL
                  END
                ELSE
    (*RECORD*)      IF SY = RECORDSY THEN
                    BEGIN INSYMBOL;
                      OLDTOP := TOP;
                      IF TOP < DISPLIMIT THEN
                        BEGIN TOP := TOP + 1;
                          WITH DISPLAY[TOP] DO
                            BEGIN FNAME := NIL;
                              FLABEL := NIL;
                                  OCCUR := REC
                            END
                        END
                      ELSE ERROR(250);
                      DISPL := 0;
                      FIELDLIST(FSYS-[SEMICOLON]+[ENDSY],LSP1);
                      NEW(LSP,RECORDS);
                      WITH LSP^ DO
                        BEGIN FSTFLD := DISPLAY[TOP].FNAME;
                          RECVAR := LSP1; SIZE := DISPL; FORM := RECORDS
                        END;
                      TOP := OLDTOP;
                      IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)
                    END
                  ELSE
    (*SET*)           IF SY = SETSY THEN
                      BEGIN INSYMBOL;
                        IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
                        SIMPLETYPE(FSYS,LSP1,LSIZE);
                        IF LSP1 <> NIL THEN
                          IF LSP1^.FORM > SUBRANGE THEN
                            BEGIN ERROR(115); LSP1 := NIL END
                          ELSE
                            IF LSP1 = REALPTR THEN ERROR(114);
                        NEW(LSP,POWER);
                        WITH LSP^ DO
                          BEGIN ELSET:=LSP1; SIZE:=SETSIZE; FORM:=POWER END;
                      END
                    ELSE
    (*FILE*)            IF SY = FILESY THEN
                        BEGIN ERROR(399);SKIP(FSYS);FSP:= NIL END;
                FSP := LSP
              END;
          IF NOT (SY IN FSYS) THEN
            BEGIN ERROR(6); SKIP(FSYS) END
        END
      ELSE FSP := NIL;
      IF FSP = NIL THEN FSIZE := 1 ELSE FSIZE := FSP^.SIZE
    END (*TYP*) ;

    PROCEDURE LABELDECLARATION;
      VAR LLP: LBP; REDEF: BOOLEAN; LBNAME: INTEGER;
    BEGIN
      REPEAT
        IF SY = INTCONST THEN
          WITH DISPLAY[TOP] DO
            BEGIN LLP := FLABEL; REDEF := FALSE;
              WHILE (LLP <> NIL) AND NOT REDEF DO
                IF LLP^.LABVAL <> VAL.IVAL THEN
                  LLP := LLP^.NEXTLAB
                ELSE BEGIN REDEF := TRUE; ERROR(166) END;
              IF NOT REDEF THEN
                BEGIN NEW(LLP);
                  WITH LLP^ DO
                    BEGIN LABVAL := VAL.IVAL; GENLABEL(LBNAME);
                      DEFINED := FALSE; NEXTLAB := FLABEL; LABNAME := LBNAME
                    END;
                  FLABEL := LLP
                END;
              INSYMBOL
            END
        ELSE ERROR(15);
        IF NOT ( SY IN FSYS + [COMMA, SEMICOLON] ) THEN
          BEGIN ERROR(6); SKIP(FSYS+[COMMA,SEMICOLON]) END;
        TEST := SY <> COMMA;
        IF NOT TEST THEN INSYMBOL
      UNTIL TEST;
      IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14)
    END (* LABELDECLARATION *) ;

    PROCEDURE CONSTDECLARATION;
      VAR LCP: CTP; LSP: STP; LVALU: VALU;
    BEGIN
      IF SY <> IDENT THEN
        BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END;
      WHILE SY = IDENT DO
        BEGIN NEW(LCP,KONST);
          WITH LCP^ DO
            BEGIN NAME := ID; IDTYPE := NIL; NEXT := NIL; KLASS:=KONST END;
          INSYMBOL;
          IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16);
          CONSTANT(FSYS + [SEMICOLON],LSP,LVALU);
          ENTERID(LCP);
          LCP^.IDTYPE := LSP; LCP^.VALUES := LVALU;
          IF SY = SEMICOLON THEN
            BEGIN INSYMBOL;
              IF NOT (SY IN FSYS + [IDENT]) THEN
                BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
            END
          ELSE ERROR(14)
        END
    END (*CONSTDECLARATION*) ;

    PROCEDURE TYPEDECLARATION;
      VAR LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE;
    BEGIN
      IF SY <> IDENT THEN
        BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END;
      WHILE SY = IDENT DO
        BEGIN NEW(LCP,TYPES);
          WITH LCP^ DO
            BEGIN NAME := ID; IDTYPE := NIL; KLASS := TYPES END;
          INSYMBOL;
          IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16);
          TYP(FSYS + [SEMICOLON],LSP,LSIZE);
          ENTERID(LCP);
          LCP^.IDTYPE := LSP;
          (*HAS ANY FORWARD REFERENCE BEEN SATISFIED:*)
          LCP1 := FWPTR;
          WHILE LCP1 <> NIL DO
            BEGIN
              IF LCP1^.NAME = LCP^.NAME THEN
                BEGIN LCP1^.IDTYPE^.ELTYPE := LCP^.IDTYPE;
                  IF LCP1 <> FWPTR THEN
                    LCP2^.NEXT := LCP1^.NEXT
                  ELSE FWPTR := LCP1^.NEXT;
                END;
              LCP2 := LCP1; LCP1 := LCP1^.NEXT
            END;
          IF SY = SEMICOLON THEN
            BEGIN INSYMBOL;
              IF NOT (SY IN FSYS + [IDENT]) THEN
                BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
            END
          ELSE ERROR(14)
        END;
      IF FWPTR <> NIL THEN
        BEGIN ERROR(117); WRITELN(OUTPUT);
          REPEAT WRITELN(OUTPUT,' TYPE-ID ',FWPTR^.NAME);
            FWPTR := FWPTR^.NEXT
          UNTIL FWPTR = NIL;
          IF NOT EOL THEN WRITE(OUTPUT,' ': CHCNT+16)
        END
    END (*TYPEDECLARATION*) ;

    PROCEDURE VARDECLARATION;
      VAR LCP,NXT: CTP; LSP: STP; LSIZE: ADDRRANGE;
    BEGIN NXT := NIL;
      REPEAT
        REPEAT
          IF SY = IDENT THEN
            BEGIN NEW(LCP,VARS);
              WITH LCP^ DO
               BEGIN NAME := ID; NEXT := NXT; KLASS := VARS;
                  IDTYPE := NIL; VKIND := ACTUAL; VLEV := LEVEL
                END;
              ENTERID(LCP);
              NXT := LCP;
              INSYMBOL;
            END
          ELSE ERROR(2);
          IF NOT (SY IN FSYS + [COMMA,COLON] + TYPEDELS) THEN
            BEGIN ERROR(6); SKIP(FSYS+[COMMA,COLON,SEMICOLON]+TYPEDELS) END;
          TEST := SY <> COMMA;
          IF NOT TEST THEN INSYMBOL
        UNTIL TEST;
        IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
        TYP(FSYS + [SEMICOLON] + TYPEDELS,LSP,LSIZE);
        WHILE NXT <> NIL DO
          WITH  NXT^ DO
            BEGIN IDTYPE := LSP; VADDR := LC;
              LC := LC + LSIZE; NXT := NEXT
            END;
        IF SY = SEMICOLON THEN
          BEGIN INSYMBOL;
            IF NOT (SY IN FSYS + [IDENT]) THEN
              BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
          END
        ELSE ERROR(14)
      UNTIL (SY <> IDENT) AND NOT (SY IN TYPEDELS);
      IF FWPTR <> NIL THEN
        BEGIN ERROR(117); WRITELN(OUTPUT);
          REPEAT WRITELN(OUTPUT,' TYPE-ID ',FWPTR^.NAME);
            FWPTR := FWPTR^.NEXT
          UNTIL FWPTR = NIL;
          IF NOT EOL THEN WRITE(OUTPUT,' ': CHCNT+16)
        END
    END (*VARDECLARATION*) ;

    PROCEDURE PROCDECLARATION(FSY: SYMBOL);
      VAR OLDLEV: 0..MAXLEVEL; {LSY: SYMBOL;} LCP,LCP1: CTP; LSP: STP;
          FORW: BOOLEAN; OLDTOP: DISPRANGE; {PARCNT: INTEGER;}
          LLC,LCM: ADDRRANGE; LBNAME: INTEGER;
          MARKP: MARKTYPE; { CHANGED TO USE THE MARK TYPE FOR ROUTINES. [SAM] }

      PROCEDURE PARAMETERLIST(FSY: SETOFSYS; VAR FPAR: CTP);
        VAR LCP,LCP1,LCP2,LCP3: CTP; LSP: STP; LKIND: IDKIND;
          LLC,LEN : ADDRRANGE; COUNT : INTEGER;
      BEGIN LCP1 := NIL;
        IF NOT (SY IN FSY + [LPARENT]) THEN
          BEGIN ERROR(7); SKIP(FSYS + FSY + [LPARENT]) END;
        IF SY = LPARENT THEN
          BEGIN IF FORW THEN ERROR(119);
            INSYMBOL;
            IF NOT (SY IN [IDENT,VARSY,PROCSY,FUNCSY]) THEN
              BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END;
            WHILE SY IN [IDENT,VARSY,PROCSY,FUNCSY] DO
              BEGIN
                IF SY = PROCSY THEN
                  BEGIN ERROR(399);
                    REPEAT INSYMBOL;
                      IF SY = IDENT THEN
                      BEGIN NEW(LCP,PROC,DECLARED,FORMAL);
                          WITH LCP^ DO
                            BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP1;
                              PFLEV := LEVEL (*BEWARE OF PARAMETER PROCEDURES*);
                              KLASS:=PROC;PFDECKIND:=DECLARED;PFKIND:=FORMAL
                            END;
                          ENTERID(LCP);
                          LCP1 := LCP; LC := LC + PTRSIZE;
                          INSYMBOL
                        END
                      ELSE ERROR(2);
                      IF NOT (SY IN FSYS + [COMMA,SEMICOLON,RPARENT]) THEN
                        BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT])END
                    UNTIL SY <> COMMA
                  END
                ELSE
                  BEGIN
                    IF SY = FUNCSY THEN
                      BEGIN ERROR(399); LCP2 := NIL;
                        REPEAT INSYMBOL;
                          IF SY = IDENT THEN
                            BEGIN NEW(LCP,FUNC,DECLARED,FORMAL);
                              WITH LCP^ DO
                                BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP2;
                                  PFLEV := LEVEL (*BEWARE PARAM FUNCS*);
                                  KLASS:=FUNC;PFDECKIND:=DECLARED;
                                  PFKIND:=FORMAL
                                END;
                              ENTERID(LCP);
                              LCP2 := LCP; LC := LC + PTRSIZE;
                              INSYMBOL;
                            END;
                          IF NOT (SY IN [COMMA,COLON] + FSYS) THEN
                           BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT])
                            END
                        UNTIL SY <> COMMA;
                        IF SY = COLON THEN
                          BEGIN INSYMBOL;
                            IF SY = IDENT THEN
                              BEGIN SEARCHID([TYPES],LCP);
                                LSP := LCP^.IDTYPE;
                                IF LSP <> NIL THEN
                                 IF NOT(LSP^.FORM IN[SCALAR,SUBRANGE,POINTER])
                                    THEN BEGIN ERROR(120); LSP := NIL END;
                                LCP3 := LCP2;
                                WHILE LCP2 <> NIL DO
                                  BEGIN LCP2^.IDTYPE := LSP; LCP := LCP2;
                                    LCP2 := LCP2^.NEXT
                                  END;
                                LCP^.NEXT := LCP1; LCP1 := LCP3;
                                INSYMBOL
                              END
                            ELSE ERROR(2);
                            IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN
                              BEGIN ERROR(7);SKIP(FSYS+[SEMICOLON,RPARENT])END
                          END
                        ELSE ERROR(5)
                      END
                    ELSE
                      BEGIN
                        IF SY = VARSY THEN
                          BEGIN LKIND := FORMAL; INSYMBOL END
                        ELSE LKIND := ACTUAL;
                        LCP2 := NIL;
                        COUNT := 0;
                        REPEAT
                          IF SY = IDENT THEN
                            BEGIN NEW(LCP,VARS);
                              WITH LCP^ DO
                                BEGIN NAME:=ID; IDTYPE:=NIL; KLASS:=VARS;
                                  VKIND := LKIND; NEXT := LCP2; VLEV := LEVEL;
                                END;
                              ENTERID(LCP);
                              LCP2 := LCP; COUNT := COUNT+1;
                              INSYMBOL;
                            END;
                          IF NOT (SY IN [COMMA,COLON] + FSYS) THEN
                           BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT])
                            END;
                          TEST := SY <> COMMA;
                          IF NOT TEST THEN INSYMBOL
                        UNTIL TEST;
                        IF SY = COLON THEN
                          BEGIN INSYMBOL;
                            IF SY = IDENT THEN
                              BEGIN SEARCHID([TYPES],LCP);
                                LSP := LCP^.IDTYPE;
                                IF LSP <> NIL THEN
                                  IF (LKIND=ACTUAL)AND(LSP^.FORM=FILES) THEN
                                    ERROR(121);
                                LCP3 := LCP2;
                                IF (LKIND=ACTUAL) AND (LSP^.SIZE<=PTRSIZE)
                                THEN LEN := LSP^.SIZE
                                ELSE LEN := PTRSIZE;
                                LC := LC+COUNT*LEN;
                                LLC := LC;
                                WHILE LCP2 <> NIL DO
                                  BEGIN LCP := LCP2;
                                    WITH LCP2^ DO
                                      BEGIN IDTYPE := LSP; LLC := LLC-LEN;
                                        VADDR := LLC;
                                      END;
                                    LCP2 := LCP2^.NEXT
                                  END;
                                LCP^.NEXT := LCP1; LCP1 := LCP3;
                                INSYMBOL
                              END
                            ELSE ERROR(2);
                            IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN
                              BEGIN ERROR(7);SKIP(FSYS+[SEMICOLON,RPARENT])END
                          END
                        ELSE ERROR(5);
                      END;
                  END;
                IF SY = SEMICOLON THEN
                  BEGIN INSYMBOL;
                    IF NOT (SY IN FSYS + [IDENT,VARSY,PROCSY,FUNCSY]) THEN
                      BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END
                  END
              END (*WHILE*) ;
            IF SY = RPARENT THEN
              BEGIN INSYMBOL;
                IF NOT (SY IN FSY + FSYS) THEN
                  BEGIN ERROR(6); SKIP(FSY + FSYS) END
              END
            ELSE ERROR(4);
            LCP3 := NIL;
            (*REVERSE POINTERS AND RESERVE LOCAL CELLS FOR COPIES OF MULTIPLE
             VALUES*)
            WHILE LCP1 <> NIL DO
              WITH LCP1^ DO
                BEGIN LCP2 := NEXT; NEXT := LCP3;
                  IF KLASS = VARS THEN
                    IF IDTYPE <> NIL THEN
                      IF (VKIND = ACTUAL) AND (IDTYPE^.SIZE > PTRSIZE) THEN
                        BEGIN VADDR := LC; LC := LC + IDTYPE^.SIZE
                        END;
                  LCP3 := LCP1; LCP1 := LCP2
                END;
            FPAR := LCP3
          END
            ELSE FPAR := NIL
    END (*PARAMETERLIST*) ;

    BEGIN (*PROCDECLARATION*)
      LLC := LC; LC := LCAFTERMARKSTACK;
      IF SY = IDENT THEN
        BEGIN SEARCHSECTION(DISPLAY[TOP].FNAME,LCP); (*DECIDE WHETHER FORW.*)
          IF LCP <> NIL THEN
          BEGIN
            IF LCP^.KLASS = PROC THEN
              FORW := LCP^.FORWDECL AND(FSY = PROCSY)AND(LCP^.PFKIND = ACTUAL)
            ELSE
              IF LCP^.KLASS = FUNC THEN
                FORW:=LCP^.FORWDECL AND(FSY=FUNCSY)AND(LCP^.PFKIND=ACTUAL)
              ELSE FORW := FALSE;
            IF NOT FORW THEN ERROR(160)
          END
          ELSE FORW := FALSE;
          IF NOT FORW THEN
            BEGIN
              IF FSY = PROCSY THEN NEW(LCP,PROC,DECLARED,ACTUAL)
              ELSE NEW(LCP,FUNC,DECLARED,ACTUAL);
              WITH LCP^ DO
                BEGIN NAME := ID; IDTYPE := NIL;
                  EXTERN := FALSE; PFLEV := LEVEL; GENLABEL(LBNAME);
                  PFDECKIND := DECLARED; PFKIND := ACTUAL; PFNAME := LBNAME;
                  IF FSY = PROCSY THEN KLASS := PROC
                  ELSE KLASS := FUNC
                END;
              ENTERID(LCP)
            END
          ELSE
            BEGIN LCP1 := LCP^.NEXT;
              WHILE LCP1 <> NIL DO
                BEGIN
                  WITH LCP1^ DO
                    IF KLASS = VARS THEN
                      IF IDTYPE <> NIL THEN
                        BEGIN LCM := VADDR + IDTYPE^.SIZE;
                          IF LCM > LC THEN LC := LCM
                        END;
                  LCP1 := LCP1^.NEXT
                END
              END;
          INSYMBOL
        END
      ELSE ERROR(2);
      OLDLEV := LEVEL; OLDTOP := TOP;
      IF LEVEL < MAXLEVEL THEN LEVEL := LEVEL + 1 ELSE ERROR(251);
      IF TOP < DISPLIMIT THEN
        BEGIN TOP := TOP + 1;
          WITH DISPLAY[TOP] DO
            BEGIN
              IF FORW THEN FNAME := LCP^.NEXT
              ELSE FNAME := NIL;
              FLABEL := NIL;
              OCCUR := BLCK
            END
        END
      ELSE ERROR(250);
      IF FSY = PROCSY THEN
        BEGIN PARAMETERLIST([SEMICOLON],LCP1);
          IF NOT FORW THEN LCP^.NEXT := LCP1
        END
      ELSE
        BEGIN PARAMETERLIST([SEMICOLON,COLON],LCP1);
          IF NOT FORW THEN LCP^.NEXT := LCP1;
          IF SY = COLON THEN
            BEGIN INSYMBOL;
              IF SY = IDENT THEN
                BEGIN IF FORW THEN ERROR(122);
                  SEARCHID([TYPES],LCP1);
                  LSP := LCP1^.IDTYPE;
                  LCP^.IDTYPE := LSP;
                  IF LSP <> NIL THEN
                    IF NOT (LSP^.FORM IN [SCALAR,SUBRANGE,POINTER]) THEN
                      BEGIN ERROR(120); LCP^.IDTYPE := NIL END;
                  INSYMBOL
                END
              ELSE BEGIN ERROR(2); SKIP(FSYS + [SEMICOLON]) END
            END
          ELSE
            IF NOT FORW THEN ERROR(123)
        END;
      IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14);
      IF SY = FORWARDSY THEN
        BEGIN
          IF FORW THEN ERROR(161)
          ELSE LCP^.FORWDECL := TRUE;
          INSYMBOL;
          IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14);
          IF NOT (SY IN FSYS) THEN
            BEGIN ERROR(6); SKIP(FSYS) END
        END
      ELSE
        BEGIN LCP^.FORWDECL := FALSE; MARK(MARKP); (* MARK HEAP *)
          REPEAT BLOCK(FSYS,SEMICOLON,LCP);
            IF SY = SEMICOLON THEN
              BEGIN IF PRTABLES THEN PRINTTABLES(FALSE); INSYMBOL;
                IF NOT (SY IN [BEGINSY,PROCSY,FUNCSY]) THEN
                  BEGIN ERROR(6); SKIP(FSYS) END
              END
            ELSE ERROR(14)
          UNTIL SY IN [BEGINSY,PROCSY,FUNCSY];
          RELEASE(MARKP); (* RETURN LOCAL ENTRIES ON RUNTIME HEAP *)
        END;
      LEVEL := OLDLEV; TOP := OLDTOP; LC := LLC;
    END (*PROCDECLARATION*) ;

    PROCEDURE BODY(FSYS: SETOFSYS);
      CONST CSTOCCMAX = 60; CIXMAX = 1000;
      TYPE OPRANGE = 0..63;
      VAR
          LLCP:CTP; SAVEID:ALPHA;
          CSTPTR: ARRAY [1..CSTOCCMAX] OF CSP;
          CSTPTRIX: 0..CSTOCCMAX;
          (*ALLOWS REFERENCING OF NONINTEGER CONSTANTS BY AN INDEX
           (INSTEAD OF A POINTER), WHICH CAN BE STORED IN THE P2-FIELD
           OF THE INSTRUCTION RECORD UNTIL WRITEOUT.
           --> PROCEDURE LOAD, PROCEDURE WRITEOUT*)
          {I, }ENTNAME, SEGSIZE: INTEGER;
          LCMAX,LLC1: ADDRRANGE; LCP: CTP;
          LLP: LBP;


      PROCEDURE PUTIC;
      BEGIN IF IC MOD 10 = 0 THEN WRITELN(PRR,'I',IC:5) END;


      PROCEDURE GEN0(FOP: OPRANGE);
      BEGIN
        IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[FOP]:4) END;
        IC := IC + 1
      END (*GEN0*) ;

      PROCEDURE GEN1(FOP: OPRANGE; FP2: INTEGER);
        VAR K: INTEGER;
      BEGIN
        IF PRCODE THEN
          BEGIN PUTIC; WRITE(PRR,MN[FOP]:4);
            IF FOP = 30 THEN WRITELN(PRR,SNA[FP2]:12)
            ELSE IF FOP = 38 THEN
                   BEGIN WRITE(PRR,'''');
                     WITH CSTPTR[FP2]^ DO
                       FOR K := 1 TO SLGTH DO WRITE(PRR,SVAL[K]:1);
                     WRITELN(PRR,'''')
                   END
                 ELSE IF FOP = 42 THEN WRITELN(PRR,CHR(FP2))
                      ELSE WRITELN(PRR,FP2:12)
          END;
        IC := IC + 1
      END (*GEN1*) ;

      PROCEDURE GEN2(FOP: OPRANGE; FP1,FP2: INTEGER);
        VAR K : INTEGER;
      BEGIN
        IF PRCODE THEN
          BEGIN PUTIC; WRITE(PRR,MN[FOP]:4);
            CASE FOP OF
              45,50,54,56:
                WRITELN(PRR,' ',FP1:3,FP2:8);
              47,48,49,52,53,55:
                BEGIN WRITE(PRR,CHR(FP1));
                  IF CHR(FP1) = 'M' THEN WRITE(PRR,FP2:11);
                  WRITELN(PRR)
                END;
              51:
                CASE FP1 OF
                  1: WRITELN(PRR,'I ',FP2);
                  2: BEGIN WRITE(PRR,'R ');
                       WITH CSTPTR[FP2]^ DO
                         FOR K := 1 TO STRGLGTH DO WRITE(PRR,RVAL[K]);
                       WRITELN(PRR)
                     END;
                  3: WRITELN(PRR,'B ',FP2);
                  4: WRITELN(PRR,'N');
                  5: BEGIN WRITE(PRR,'(');
                       WITH CSTPTR[FP2]^ DO
                         FOR K := 0 TO 58 DO
                           IF K IN PVAL THEN WRITE(PRR,K:3);
                       WRITELN(PRR,')')
                     END
                END
            END;
          END;
          IC := IC + 1
      END (*GEN2*) ;

      PROCEDURE LOAD;
      BEGIN
        WITH GATTR DO
          IF TYPTR <> NIL THEN
            BEGIN
              CASE KIND OF
                CST:   IF (TYPTR^.FORM = SCALAR) AND (TYPTR <> REALPTR) THEN
                         IF TYPTR = BOOLPTR THEN GEN2(51(*LDC*),3,CVAL.IVAL)
                         ELSE GEN2(51(*LDC*),1,CVAL.IVAL)
                       ELSE
                         IF TYPTR = NILPTR THEN GEN2(51(*LDC*),4,0)
                         ELSE
                           IF CSTPTRIX >= CSTOCCMAX THEN ERROR(254)
                           ELSE
                             BEGIN CSTPTRIX := CSTPTRIX + 1;
                               CSTPTR[CSTPTRIX] := CVAL.VALP;
                               IF TYPTR = REALPTR THEN
                                 GEN2(51(*LDC*),2,CSTPTRIX)
                               ELSE
                                  GEN2(51(*LDC*),5,CSTPTRIX)
                             END;
                VARBL: CASE ACCESS OF
                         DRCT:   IF VLEVEL <= 1 THEN GEN1(39(*LDO*),DPLMT)
                                 ELSE GEN2(54(*LOD*),LEVEL-VLEVEL,DPLMT);
                         INDRCT: GEN1(35(*IND*),IDPLMT);
                         INXD:   ERROR(400)
                       END;
                EXPR:
              END;
              KIND := EXPR
            END
      END (*LOAD*) ;

      PROCEDURE STORE(VAR FATTR: ATTR);
      BEGIN
        WITH FATTR DO
          IF TYPTR <> NIL THEN
            CASE ACCESS OF
              DRCT:   IF VLEVEL <= 1 THEN GEN1(43(*SRO*),DPLMT)
                      ELSE GEN2(56(*STR*),LEVEL-VLEVEL,DPLMT);
              INDRCT: IF IDPLMT <> 0 THEN ERROR(400)
                      ELSE GEN0(26(*STO*));
              INXD:   ERROR(400)
            END
      END (*STORE*) ;

      PROCEDURE LOADADDRESS;
      BEGIN
        WITH GATTR DO
          IF TYPTR <> NIL THEN
            BEGIN
              CASE KIND OF
                CST:   IF STRING(TYPTR) THEN
                         IF CSTPTRIX >= CSTOCCMAX THEN ERROR(254)
                         ELSE
                           BEGIN CSTPTRIX := CSTPTRIX + 1;
                             CSTPTR[CSTPTRIX] := CVAL.VALP;
                             GEN1(38(*LCA*),CSTPTRIX)
                           END
                       ELSE ERROR(400);
                VARBL: CASE ACCESS OF
                         DRCT:   IF VLEVEL <= 1 THEN GEN1(37(*LAO*),DPLMT)
                                 ELSE GEN2(50(*LDA*),LEVEL-VLEVEL,DPLMT);
                         INDRCT: IF IDPLMT <> 0 THEN GEN1(34(*INC*),IDPLMT);
                         INXD:   ERROR(400)
                       END;
                EXPR:  ERROR(400)
              END;
              KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0
            END
      END (*LOADADDRESS*) ;


      PROCEDURE GENFJP(FADDR: INTEGER);
      BEGIN LOAD;
        IF GATTR.TYPTR <> NIL THEN
          IF GATTR.TYPTR <> BOOLPTR THEN ERROR(144);
        IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[33]:4,' L':8,FADDR:4) END;
        IC := IC + 1
      END (*GENFJP*) ;

      PROCEDURE GENUJPENT(FOP: OPRANGE; FP2: INTEGER);
     BEGIN
       IF PRCODE THEN
          BEGIN PUTIC; WRITELN(PRR, MN[FOP]:4, ' L':8,FP2:4) END;
        IC := IC + 1
      END (*GENUJPENT*);


      PROCEDURE GENCUP(FP1, FP2: INTEGER);
     BEGIN
       IF PRCODE THEN
          BEGIN PUTIC; WRITELN(PRR, MN[46]:4, FP1:4, ' L':4, FP2:4) END;
        IC := IC + 1
      END (*GENCUP*);


      PROCEDURE PUTLABEL(LABNAME: INTEGER);
      BEGIN IF PRCODE THEN WRITELN(PRR, 'L', LABNAME:4)
      END (*PUTLABEL*);

      PROCEDURE STATEMENT(FSYS: SETOFSYS);
        LABEL 1;
        VAR LCP: CTP; LLP: LBP;

        PROCEDURE EXPRESSION(FSYS: SETOFSYS); FORWARD;

        PROCEDURE SELECTOR(FSYS: SETOFSYS; FCP: CTP);
          VAR LATTR: ATTR; LCP: CTP; LMIN,LMAX: INTEGER;
        BEGIN
          WITH FCP^, GATTR DO
            BEGIN TYPTR := IDTYPE; KIND := VARBL;
              CASE KLASS OF
                VARS:
                  IF VKIND = ACTUAL THEN
                    BEGIN ACCESS := DRCT; VLEVEL := VLEV;
                      DPLMT := VADDR
                    END
                  ELSE
                    BEGIN GEN2(54(*LOD*),LEVEL-VLEV,VADDR);
                      ACCESS := INDRCT; IDPLMT := 0
                    END;
                FIELD:
                  WITH DISPLAY[DISX] DO
                    IF OCCUR = CREC THEN
                      BEGIN ACCESS := DRCT; VLEVEL := CLEV;
                        DPLMT := CDSPL + FLDADDR
                      END
                    ELSE
                      BEGIN
                        IF LEVEL = 1 THEN GEN1(39(*LDO*),VDSPL)
                        ELSE GEN2(54(*LOD*),0,VDSPL);
                        ACCESS := INDRCT; IDPLMT := FLDADDR
                      END;
                FUNC:
                  IF PFDECKIND = STANDARD THEN ERROR(150)
                  ELSE
                    IF PFLEV = 0 THEN ERROR(150)   (*EXTERNAL FCT*)
                    ELSE
                      IF PFKIND = FORMAL THEN ERROR(151)
                      ELSE
                        BEGIN ACCESS := DRCT; VLEVEL := PFLEV + 1;
                          DPLMT := 0   (*IMPL. RELAT. ADDR. OF FCT. RESULT*)
                        END
              END (*CASE*)
            END (*WITH*);
          IF NOT (SY IN SELECTSYS + FSYS) THEN
            BEGIN ERROR(59); SKIP(SELECTSYS + FSYS) END;
          WHILE SY IN SELECTSYS DO
            BEGIN
        (*[*)   IF SY = LBRACK THEN
                BEGIN
                  REPEAT LATTR := GATTR;
                    WITH LATTR DO
                      IF TYPTR <> NIL THEN
                        IF TYPTR^.FORM <> ARRAYS THEN
                          BEGIN ERROR(138); TYPTR := NIL END;
                    LOADADDRESS;
                    INSYMBOL; EXPRESSION(FSYS + [COMMA,RBRACK]);
                    LOAD;
                    IF GATTR.TYPTR <> NIL THEN
                      IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(113);
                    IF LATTR.TYPTR <> NIL THEN
                      WITH LATTR.TYPTR^ DO
                        BEGIN
                          IF COMPTYPES(INXTYPE,GATTR.TYPTR) THEN
                            BEGIN
                              IF INXTYPE <> NIL THEN
                                BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);
                                  IF LMIN > 0 THEN GEN1(31(*DEC*),LMIN)
                                  ELSE IF LMIN < 0 THEN GEN1(34(*INC*),-LMIN)
                                  (*OR SIMPLY GEN1(31,LMIN)*)
                                END
                            END
                          ELSE ERROR(139);
                          WITH GATTR DO
                            BEGIN TYPTR := AELTYPE; KIND := VARBL;
                              ACCESS := INDRCT; IDPLMT := 0
                            END;
                          IF GATTR.TYPTR <> NIL THEN
                            GEN1(36(*IXA*),GATTR.TYPTR^.SIZE)
                        END
                  UNTIL SY <> COMMA;
                  IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12)
                END (*IF SY = LBRACK*)
              ELSE
        (*.*)     IF SY = PERIOD THEN
                  BEGIN
                    WITH GATTR DO
                      BEGIN
                        IF TYPTR <> NIL THEN
                          IF TYPTR^.FORM <> RECORDS THEN
                            BEGIN ERROR(140); TYPTR := NIL END;
                        INSYMBOL;
                        IF SY = IDENT THEN
                          BEGIN
                            IF TYPTR <> NIL THEN
                              BEGIN SEARCHSECTION(TYPTR^.FSTFLD,LCP);
                                IF LCP = NIL THEN
                                  BEGIN ERROR(152); TYPTR := NIL END
                                ELSE
                                  WITH LCP^ DO
                                    BEGIN TYPTR := IDTYPE;
                                      CASE ACCESS OF

                    DRCT:   DPLMT := DPLMT + FLDADDR;
                                        INDRCT: IDPLMT := IDPLMT + FLDADDR;
                                        INXD:   ERROR(400)
                                      END
                                    END
                              END;
                            INSYMBOL
                          END (*SY = IDENT*)
                        ELSE ERROR(2)
                      END (*WITH GATTR*)
                  END (*IF SY = PERIOD*)
                ELSE
        (*^*)       BEGIN
                    IF GATTR.TYPTR <> NIL THEN
                      WITH GATTR,TYPTR^ DO
                        IF FORM = POINTER THEN
                          BEGIN TYPTR := ELTYPE; LOAD;
                            WITH GATTR DO
                              BEGIN KIND := VARBL; ACCESS := INDRCT;
                                IDPLMT := 0
                              END
                          END
                        ELSE
                          IF FORM = FILES THEN TYPTR := FILTYPE
                          ELSE ERROR(141);
                    INSYMBOL
                  END;
              IF NOT (SY IN FSYS + SELECTSYS) THEN
                BEGIN ERROR(6); SKIP(FSYS + SELECTSYS) END
            END (*WHILE*)
        END (*SELECTOR*) ;

        PROCEDURE CALL(FSYS: SETOFSYS; FCP: CTP);
          VAR LKEY: 1..15;

          PROCEDURE VARIABLE(FSYS: SETOFSYS);
            VAR LCP: CTP;
          BEGIN
            IF SY = IDENT THEN
              BEGIN SEARCHID([VARS,FIELD],LCP); INSYMBOL END
            ELSE BEGIN ERROR(2); LCP := UVARPTR END;
            SELECTOR(FSYS,LCP)
          END (*VARIABLE*) ;

          PROCEDURE GETPUTRESETREWRITE;
          BEGIN VARIABLE(FSYS + [RPARENT]); LOADADDRESS;
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(116);
            IF LKEY <= 2 THEN GEN1(30(*CSP*),LKEY(*GET,PUT*))
            ELSE ERROR(399)
          END (*GETPUTRESETREWRITE*) ;

          PROCEDURE READ;
            VAR LCP:CTP; LLEV:LEVRANGE; LADDR:ADDRRANGE;
          BEGIN
            IF SY = IDENT THEN
              BEGIN SEARCHID([VARS],LCP);
                IF LCP <> NIL THEN
                  IF LCP^.IDTYPE^.FORM = FILES THEN
                    WITH LCP^ DO
                      BEGIN
                        IF IDTYPE^.FILTYPE = CHARPTR THEN
                          BEGIN LLEV := VLEV; LADDR := VADDR END
                        ELSE ERROR(399);
                        INSYMBOL;
                        IF NOT (SY IN [COMMA,RPARENT]) THEN ERROR(20)
                      END
                  ELSE BEGIN LLEV := 1; LADDR := LCAFTERMARKSTACK END
                ELSE BEGIN LLEV := 1; LADDR := LCAFTERMARKSTACK END
              END
            ELSE BEGIN ERROR(2); LLEV := 1; LADDR := LCAFTERMARKSTACK;
                   INSYMBOL
                 END;
           IF SY = COMMA THEN INSYMBOL;
           IF SY = IDENT THEN
           BEGIN
            REPEAT VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS;
              GEN2(50(*LDA*),LEVEL-LLEV,LADDR);
              IF GATTR.TYPTR <> NIL THEN
                IF GATTR.TYPTR^.FORM <= SUBRANGE THEN
                  IF COMPTYPES(INTPTR,GATTR.TYPTR) THEN
                    GEN1(30(*CSP*),3(*RDI*))
                  ELSE
                    IF COMPTYPES(REALPTR,GATTR.TYPTR) THEN
                      GEN1(30(*CSP*),4(*RDR*))
                    ELSE
                      IF COMPTYPES(CHARPTR,GATTR.TYPTR) THEN
                        GEN1(30(*CSP*),5(*RDC*))
                      ELSE ERROR(399)
                ELSE ERROR(116);
              TEST := SY <> COMMA;
              IF NOT TEST THEN INSYMBOL
            UNTIL TEST
           END;
           IF LKEY = 11 THEN
             BEGIN GEN2(50(*LDA*),LEVEL - LLEV, LADDR);
               GEN1(30(*CSP*),21(*RLN*))
             END
          END (*READ*) ;

          PROCEDURE WRITE;
            VAR LSP: STP; DEFAULT : BOOLEAN; LLKEY: 1..15;
                LCP:CTP; LLEV:LEVRANGE; LADDR,LEN:ADDRRANGE;
          BEGIN LLKEY := LKEY;
            IF SY = IDENT THEN
              BEGIN SEARCHID([VARS],LCP);
                IF LCP <> NIL THEN
                  IF LCP^.IDTYPE^.FORM = FILES THEN
                    WITH LCP^ DO
                      BEGIN
                        IF IDTYPE^.FILTYPE = CHARPTR THEN
                          BEGIN LLEV := VLEV; LADDR := VADDR END
                        ELSE ERROR(399);
                        INSYMBOL;
                        IF NOT (SY IN [COMMA,RPARENT]) THEN ERROR(20)
                      END
                  ELSE BEGIN LLEV := 1; LADDR := LCAFTERMARKSTACK+CHARSIZE
                       END
                ELSE BEGIN LLEV := 1; LADDR := LCAFTERMARKSTACK+CHARSIZE END
              END
            ELSE BEGIN LLEV := 1; LADDR := LCAFTERMARKSTACK+CHARSIZE END;
           IF SY = COMMA THEN INSYMBOL;
           IF SY IN FACBEGSYS THEN
           BEGIN
            REPEAT EXPRESSION(FSYS + [COMMA,COLON,RPARENT]);
              LSP := GATTR.TYPTR;
              IF LSP <> NIL THEN
                IF LSP^.FORM <= SUBRANGE THEN LOAD ELSE LOADADDRESS;
              IF SY = COLON THEN
                BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,COLON,RPARENT]);
                  IF GATTR.TYPTR <> NIL THEN
                    IF GATTR.TYPTR <> INTPTR THEN ERROR(116);
                  LOAD; DEFAULT := FALSE
                END
              ELSE DEFAULT := TRUE;
              IF SY = COLON THEN
                BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,RPARENT]);
                  IF GATTR.TYPTR <> NIL THEN
                    IF GATTR.TYPTR <> INTPTR THEN ERROR(116);
                  IF LSP <> REALPTR THEN ERROR(124);
                  LOAD; ERROR(399);
                END
              ELSE
                IF LSP = INTPTR THEN
                  BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,10);
                    GEN2(50(*LDA*),LEVEL-LLEV,LADDR);
                    GEN1(30(*CSP*),6(*WRI*))
                  END
                ELSE
                  IF LSP = REALPTR THEN
                    BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,20);
                      GEN2(50(*LDA*),LEVEL-LLEV,LADDR);
                      GEN1(30(*CSP*),8(*WRR*))
                    END
                  ELSE
                    IF LSP = CHARPTR THEN
                      BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,1);
                        GEN2(50(*LDA*),LEVEL-LLEV,LADDR);
                        GEN1(30(*CSP*),9(*WRC*))
                      END
                    ELSE
                      IF LSP <> NIL THEN
                        BEGIN
                          IF LSP^.FORM = SCALAR THEN ERROR(399)
                          ELSE
                            IF STRING(LSP) THEN
                              BEGIN LEN := LSP^.SIZE DIV CHARSIZE;
                                IF DEFAULT THEN
                                      GEN2(51(*LDC*),1,LEN);
                                GEN2(51(*LDC*),1,LEN);
                                GEN2(50(*LDA*),LEVEL-LLEV,LADDR);
                                GEN1(30(*CSP*),10(*WRS*))
                              END
                            ELSE ERROR(116)
                        END;
              TEST := SY <> COMMA;
              IF NOT TEST THEN INSYMBOL
            UNTIL TEST;
           END;
            IF LLKEY = 12 THEN (*WRITELN*)
              BEGIN GEN2(50(*LDA*),LEVEL-LLEV,LADDR);
                GEN1(30(*CSP*),22(*WLN*))
              END
          END (*WRITE*) ;

          PROCEDURE PACK;
            VAR LSP,LSP1: STP;
          BEGIN ERROR(399); VARIABLE(FSYS + [COMMA,RPARENT]);
            LSP := NIL; LSP1 := NIL;
            IF GATTR.TYPTR <> NIL THEN
              WITH GATTR.TYPTR^ DO
                IF FORM = ARRAYS THEN
                  BEGIN LSP := INXTYPE; LSP1 := AELTYPE END
                ELSE ERROR(116);
            IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
            EXPRESSION(FSYS + [COMMA,RPARENT]);
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(116)
              ELSE
                IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEN ERROR(116);
            IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
            VARIABLE(FSYS + [RPARENT]);
            IF GATTR.TYPTR <> NIL THEN
              WITH GATTR.TYPTR^ DO
                IF FORM = ARRAYS THEN
                  BEGIN
                    IF NOT COMPTYPES(AELTYPE,LSP1)
                      OR NOT COMPTYPES(INXTYPE,LSP) THEN
                      ERROR(116)
                  END
                ELSE ERROR(116)
          END (*PACK*) ;

          PROCEDURE UNPACK;
            VAR LSP,LSP1: STP;
          BEGIN ERROR(399); VARIABLE(FSYS + [COMMA,RPARENT])
;
            LSP := NIL; LSP1 := NIL;
            IF GATTR.TYPTR <> NIL THEN
              WITH GATTR.TYPTR^ DO
                IF FORM = ARRAYS THEN
                  BEGIN LSP := INXTYPE; LSP1 := AELTYPE END
                ELSE ERROR(116);
            IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
            VARIABLE(FSYS + [COMMA,RPARENT]);
            IF GATTR.TYPTR <> NIL THEN
              WITH GATTR.TYPTR^ DO
                IF FORM = ARRAYS THEN
                  BEGIN
                    IF NOT COMPTYPES(AELTYPE,LSP1)
                      OR NOT COMPTYPES(INXTYPE,LSP) THEN
                      ERROR(116)
                  END
                ELSE ERROR(116);
            IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
            EXPRESSION(FSYS + [RPARENT]);
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(116)
              ELSE
                IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEN ERROR(116);
          END (*UNPACK*) ;

          PROCEDURE NEW;
            LABEL 1;
            VAR LSP,LSP1: STP; VARTS{,LMIN,LMAX}: INTEGER;
                LSIZE{,LSZ}: ADDRRANGE; LVAL: VALU;
          BEGIN VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS;
            LSP := NIL; VARTS := 0; LSIZE := 0;
            IF GATTR.TYPTR <> NIL THEN
              WITH GATTR.TYPTR^ DO
                IF FORM = POINTER THEN
                  BEGIN
                    IF ELTYPE <> NIL THEN
                      BEGIN LSIZE := ELTYPE^.SIZE;
                        IF ELTYPE^.FORM = RECORDS THEN LSP := ELTYPE^.RECVAR
                      END
                  END
                ELSE ERROR(116);
            WHILE SY = COMMA DO
              BEGIN INSYMBOL;CONSTANT(FSYS + [COMMA,RPARENT],LSP1,LVAL);
                VARTS := VARTS + 1;
                (*CHECK TO INSERT HERE: IS CONSTANT IN TAGFIELDTYPE RANGE*)
                IF LSP = NIL THEN ERROR(158)
                ELSE
                  IF LSP^.FORM <> TAGFLD THEN ERROR(162)
                  ELSE
                    IF LSP^.TAGFIELDP <> NIL THEN
                      IF STRING(LSP1) OR (LSP1 = REALPTR) THEN ERROR(159)
                      ELSE
                        IF COMPTYPES(LSP^.TAGFIELDP^.IDTYPE,LSP1) THEN
                          BEGIN
                            LSP1 := LSP^.FSTVAR;
                            WHILE LSP1 <> NIL DO
                              WITH LSP1^ DO
                                IF VARVAL.IVAL = LVAL.IVAL THEN
                                  BEGIN LSIZE := SIZE; LSP := SUBVAR;
                                    GOTO 1
                                  END
                                ELSE LSP1 := NXTVAR;
                            LSIZE := LSP^.SIZE; LSP := NIL;
                          END
                        ELSE ERROR(116);
          1:  END (*WHILE*) ;
            GEN2(51(*LDC*),1,LSIZE);
            GEN1(30(*CSP*),12(*NEW*));
          END (*NEW*) ;

          PROCEDURE MARK;
          BEGIN VARIABLE(FSYS+[RPARENT]);
             IF GATTR.TYPTR <> NIL THEN
               IF GATTR.TYPTR^.FORM = POINTER THEN
                 BEGIN LOADADDRESS; GEN1(30(*CSP*),23(*SAV*)) END
               ELSE ERROR(125)
          END(*MARK*);

          PROCEDURE RELEASE;
          BEGIN VARIABLE(FSYS+[RPARENT]);
                IF GATTR.TYPTR <> NIL THEN
                   IF GATTR.TYPTR^.FORM = POINTER THEN
                      BEGIN LOAD; GEN1(30(*CSP*),13(*RST*)) END
                   ELSE ERROR(125)
          END (*RELEASE*);



          PROCEDURE ABS;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR = INTPTR THEN GEN0(0(*ABI*))
              ELSE
                IF GATTR.TYPTR = REALPTR THEN GEN0(1(*ABR*))
                ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END
          END (*ABS*) ;

          PROCEDURE SQR;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR = INTPTR THEN GEN0(24(*SQI*))
              ELSE
                IF GATTR.TYPTR = REALPTR THEN GEN0(25(*SQR*))
                ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END
          END (*SQR*) ;

          PROCEDURE TRUNC;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR <> REALPTR THEN ERROR(125);
            GEN0(27(*TRC*));
            GATTR.TYPTR := INTPTR
          END (*TRUNC*) ;

          PROCEDURE ODD;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
            GEN0(20(*ODD*));
            GATTR.TYPTR := BOOLPTR
          END (*ODD*) ;

          PROCEDURE ORD;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR^.FORM >= POWER THEN ERROR(125);
            GATTR.TYPTR := INTPTR
          END (*ORD*) ;

          PROCEDURE CHR;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
            GATTR.TYPTR := CHARPTR
          END (*CHR*) ;



          PROCEDURE PREDSUCC;
          BEGIN ERROR(399);
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(125);
          END (*PREDSUCC*) ;

          PROCEDURE EOF;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125);
            IF LKEY = 9 THEN GEN0(8(*EOF*)) ELSE GEN1(30(*CSP*),14(*ELN*));
              GATTR.TYPTR := BOOLPTR
          END (*EOF*) ;

          PROCEDURE CALLNONSTANDARD;
            VAR NXT,LCP: CTP; LSP: STP; LKIND: IDKIND; LB: BOOLEAN;
                LOCPAR, LLC: ADDRRANGE;
          BEGIN LOCPAR := 0;
            WITH FCP^ DO
              BEGIN NXT := NEXT; LKIND := PFKIND;
                IF NOT EXTERN THEN GEN1(41(*MST*),LEVEL-PFLEV)
              END;
            IF SY = LPARENT THEN
              BEGIN LLC := LC;
                REPEAT LB := FALSE; (*DECIDE WHETHER PROC/FUNC MUST BE PASSED*)
                  IF LKIND = ACTUAL THEN
                    BEGIN
                      IF NXT = NIL THEN ERROR(126)
                      ELSE LB := NXT^.KLASS IN [PROC,FUNC]
                    END ELSE ERROR(399);
                  (*FOR FORMAL PROC/FUNC LB IS FALSE AND EXPRESSION
                   WILL BE CALLED, WHICH WILL ALLWAYS INTERPRET A PROC/FUNC ID
                  AT ITS BEGINNING AS A CALL RATHER THAN A PARAMETER PASSING.
                  IN THIS IMPLEMENTATION, PARAMETER PROCEDURES/FUNCTIONS
                  ARE THEREFORE NOT ALLOWED TO HAVE PROCEDURE/FUNCTION
                  PARAMETERS*)
                  INSYMBOL;
                  IF LB THEN   (*PASS FUNCTION OR PROCEDURE*)
                    BEGIN ERROR(399);
                      IF SY <> IDENT THEN
                        BEGIN ERROR(2); SKIP(FSYS + [COMMA,RPARENT]) END
                      ELSE
                        BEGIN
                          IF NXT^.KLASS = PROC THEN SEARCHID([PROC],LCP)
                          ELSE
                            BEGIN SEARCHID([FUNC],LCP);
                              IF NOT COMPTYPES(LCP^.IDTYPE,NXT^.IDTYPE) THEN
                                ERROR(128)
                            END;
                          INSYMBOL;
                          IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN
                            BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END
                        END
                    END (*IF LB*)
                  ELSE
                    BEGIN EXPRESSION(FSYS + [COMMA,RPARENT]);
                      IF GATTR.TYPTR <> NIL THEN
                        IF LKIND = ACTUAL THEN
                          BEGIN
                            IF NXT <> NIL THEN
                              BEGIN LSP := NXT^.IDTYPE;
                                IF LSP <> NIL THEN
                                  BEGIN
                                    IF (NXT^.VKIND = ACTUAL) THEN
                                      IF LSP^.SIZE <= PTRSIZE THEN
                                      BEGIN LOAD;
                                        IF COMPTYPES(REALPTR,LSP)
                                           AND (GATTR.TYPTR = INTPTR) THEN
                                          BEGIN GEN0(10(*FLT*));
                                            GATTR.TYPTR := REALPTR
                                          END;
                                        LOCPAR := LOCPAR + LSP^.SIZE
                                      END
                                      ELSE
                                      BEGIN
                                        IF (GATTR.KIND = EXPR)
                                         OR (GATTR.KIND = CST) THEN
                                        BEGIN LOAD;
                                          IF COMPTYPES(REALPTR,LSP)
                                             AND (GATTR.TYPTR = INTPTR) THEN
                                            BEGIN GEN0(10(*FLT*));
                                              GATTR.TYPTR := REALPTR
                                            END;
                                          GEN2(56(*STR*),0,LC);
                                          GEN2(50(*LDA*),0,LC);
                                          LC := LC + GATTR.TYPTR^.SIZE;
                                          IF LCMAX < LC THEN LCMAX := LC
                                        END
                                        ELSE
                                          IF COMPTYPES(REALPTR,LSP)
                                           AND (GATTR.TYPTR = INTPTR) THEN
                                          BEGIN LOAD;
                                            GEN0(10(*FLT*));
                                            GEN2(56(*STR*),0,LC);
                                            GEN2(50(*LDA*),0,LC);
                                            LC := LC + GATTR.TYPTR^.SIZE;
                                            IF LCMAX < LC THEN LCMAX := LC
                                          END
                                          ELSE LOADADDRESS;
                                        LOCPAR := LOCPAR + PTRSIZE
                                      END
                                    ELSE
                                      IF GATTR.KIND = VARBL THEN
                                        BEGIN LOADADDRESS; LOCPAR := LOCPAR + PTRSIZE
                                        END
                                      ELSE ERROR(154);
                                    IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEN
                                      ERROR(142)
                                  END
                              END
                          END
                      ELSE (*LKIND = FORMAL*)
                        BEGIN (*PASS FORMAL PARAM*)
                        END
                    END;
                  IF (LKIND = ACTUAL) AND (NXT <> NIL) THEN NXT := NXT^.NEXT
                UNTIL SY <> COMMA;
                LC := LLC;
              IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
            END (*IF LPARENT*);
            IF LKIND = ACTUAL THEN
              BEGIN IF NXT <> NIL THEN ERROR(126);
                WITH FCP^ DO
                  BEGIN
                    IF EXTERN THEN GEN1(30(*CSP*),PFNAME)
                    ELSE GENCUP(LOCPAR, PFNAME);
                  END
              END;
            GATTR.TYPTR := FCP^.IDTYPE
          END (*CALLNONSTANDARD*) ;

        BEGIN (*CALL*)
          IF FCP^.PFDECKIND = STANDARD THEN
            BEGIN IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9);
              LKEY := FCP^.KEY;
              IF FCP^.KLASS = PROC THEN
                CASE LKEY OF
                  1,2,
                  3,4:  GETPUTRESETREWRITE;
                  5,11:    READ;
                  6,12:    WRITE;
                  7:    PACK;
                  8:    UNPACK;
                  9:    NEW;
                  10:   RELEASE;
                  13:   MARK
                END
              ELSE
                BEGIN EXPRESSION(FSYS + [RPARENT]);
                      IF LKEY <= 8 THEN LOAD ELSE LOADADDRESS;
                  CASE LKEY OF
                    1:    ABS;
                    2:    SQR;
                    3:    TRUNC;
                    4:    ODD;
                    5:    ORD;
                    6:    CHR;
                    7,8:  PREDSUCC;
                    9,10:    EOF
                  END
                END;
              IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
            END (*STANDARD PROCEDURES AND FUNCTIONS*)
          ELSE CALLNONSTANDARD
        END (*CALL*) ;

        PROCEDURE EXPRESSION;
          VAR LATTR: ATTR; LOP: OPERATOR; TYPIND: CHAR; LSIZE: ADDRRANGE;

          PROCEDURE SIMPLEEXPRESSION(FSYS: SETOFSYS);
            VAR LATTR: ATTR; LOP: OPERATOR; SIGNED: BOOLEAN;

            PROCEDURE TERM(FSYS: SETOFSYS);
              VAR LATTR: ATTR; LOP: OPERATOR;

              PROCEDURE FACTOR(FSYS: SETOFSYS);
                VAR LCP: CTP; LVP: CSP; VARPART: BOOLEAN;
                    CSTPART: SET OF 0..58; LSP: STP;
              BEGIN
                IF NOT (SY IN FACBEGSYS) THEN
                  BEGIN ERROR(58); SKIP(FSYS + FACBEGSYS);
                    GATTR.TYPTR := NIL
                  END;
                WHILE SY IN FACBEGSYS DO
                  BEGIN
                    CASE SY OF
              (*ID*)    IDENT:
                        BEGIN SEARCHID([KONST,VARS,FIELD,FUNC],LCP);
                          INSYMBOL;
                          IF LCP^.KLASS = FUNC THEN
                            BEGIN CALL(FSYS,LCP); GATTR.KIND := EXPR END
                          ELSE
                            IF LCP^.KLASS = KONST THEN
                              WITH GATTR, LCP^ DO
                                BEGIN TYPTR := IDTYPE; KIND := CST;
                                  CVAL := VALUES
                                END
                            ELSE
                              BEGIN SELECTOR(FSYS,LCP);
                                IF GATTR.TYPTR<>NIL THEN(*ELIM.SUBR.TYPES TO*)
                                  WITH GATTR,TYPTR^ DO(*SIMPLIFY LATER TESTS*)
                                    IF FORM = SUBRANGE THEN
                                      TYPTR := RANGETYPE
                              END
                        END;
              (*CST*)   INTCONST:
                        BEGIN
                          WITH GATTR DO
                            BEGIN TYPTR := INTPTR; KIND := CST;
                              CVAL := VAL
                            END;
                          INSYMBOL
                        END;
                      REALCONST:
                        BEGIN
                          WITH GATTR DO
                            BEGIN TYPTR := REALPTR; KIND := CST;
                              CVAL := VAL
                            END;
                          INSYMBOL
                        END;
                      STRINGCONST:
                        BEGIN
                          WITH GATTR DO
                            BEGIN
                              IF LGTH = 1 THEN TYPTR := CHARPTR
                              ELSE
                                BEGIN NEW(LSP,ARRAYS);
                                  WITH LSP^ DO
                                    BEGIN AELTYPE := CHARPTR; FORM:=ARRAYS;
                                      INXTYPE := NIL; SIZE := LGTH*CHARSIZE
                                    END;
                                  TYPTR := LSP
                                END;
                              KIND := CST; CVAL := VAL
                            END;
                          INSYMBOL
                        END;
              (*(*)     LPARENT:
                        BEGIN INSYMBOL; EXPRESSION(FSYS + [RPARENT]);
                          IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
                        END;
              (*NOT*)   NOTSY:
                        BEGIN INSYMBOL; FACTOR(FSYS);
                          LOAD; GEN0(19(*NOT*));
                          IF GATTR.TYPTR <> NIL THEN
                            IF GATTR.TYPTR <> BOOLPTR THEN
                              BEGIN ERROR(135); GATTR.TYPTR := NIL END;
                        END;
              (*[*)     LBRACK:
                        BEGIN INSYMBOL; CSTPART := [ ]; VARPART := FALSE;
                          NEW(LSP,POWER);
                          WITH LSP^ DO
                            BEGIN ELSET:=NIL;SIZE:=SETSIZE;FORM:=POWER END;
                          IF SY = RBRACK THEN
                            BEGIN
                              WITH GATTR DO
                                BEGIN TYPTR := LSP; KIND := CST END;
                              INSYMBOL
                            END
                          ELSE
                            BEGIN
                              REPEAT EXPRESSION(FSYS + [COMMA,RBRACK]);
                                IF GATTR.TYPTR <> NIL THEN
                                  IF GATTR.TYPTR^.FORM <> SCALAR THEN
                                    BEGIN ERROR(136); GATTR.TYPTR := NIL END
                                  ELSE
                                    IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR) THEN
                                      BEGIN
                                        IF GATTR.KIND = CST THEN
                                          CSTPART := CSTPART+[GATTR.CVAL.IVAL]
                                        ELSE
                                          BEGIN LOAD; GEN0(23(*SGS*));
                                            IF VARPART THEN GEN0(28(*UNI*))
                                            ELSE VARPART := TRUE
                                          END;
                                        LSP^.ELSET := GATTR.TYPTR;
                                        GATTR.TYPTR := LSP
                                      END
                                    ELSE ERROR(137);
                                TEST := SY <> COMMA;
                                IF NOT TEST THEN INSYMBOL
                              UNTIL TEST;
                              IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12)
                            END;
                          IF VARPART THEN
                            BEGIN
                              IF CSTPART <> [ ] THEN
                                BEGIN NEW(LVP,PSET); LVP^.PVAL := CSTPART;
                                  LVP^.CCLASS := PSET;
                                  IF CSTPTRIX = CSTOCCMAX THEN ERROR(254)
                                  ELSE
                                    BEGIN CSTPTRIX := CSTPTRIX + 1;
                                      CSTPTR[CSTPTRIX] := LVP;
                                      GEN2(51(*LDC*),5,CSTPTRIX);
                                      GEN0(28(*UNI*)); GATTR.KIND := EXPR
                                    END
                                END
                            END
                          ELSE
                            BEGIN NEW(LVP,PSET); LVP^.PVAL := CSTPART;
                              LVP^.CCLASS := PSET;
                              GATTR.CVAL.VALP := LVP
                            END
                        END
                    END (*CASE*) ;
                    IF NOT (SY IN FSYS) THEN
                      BEGIN ERROR(6); SKIP(FSYS + FACBEGSYS) END
                  END (*WHILE*)
              END (*FACTOR*) ;

            BEGIN (*TERM*)
              FACTOR(FSYS + [MULOP]);
              WHILE SY = MULOP DO
                      BEGIN LOAD; LATTR := GATTR; LOP := OP;
                  INSYMBOL; FACTOR(FSYS + [MULOP]); LOAD;
                  IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
                    CASE LOP OF
            (***)       MUL:  IF (LATTR.TYPTR=INTPTR)AND(GATTR.TYPTR=INTPTR)
                              THEN GEN0(15(*MPI*))
                            ELSE
                              BEGIN
                                IF LATTR.TYPTR = INTPTR THEN
                                  BEGIN GEN0(9(*FLO*));
                                    LATTR.TYPTR := REALPTR
                                  END
                                ELSE
                                  IF GATTR.TYPTR = INTPTR THEN
                                    BEGIN GEN0(10(*FLT*));
                                      GATTR.TYPTR := REALPTR
                                    END;
                                IF (LATTR.TYPTR = REALPTR)
                                  AND(GATTR.TYPTR=REALPTR)THEN GEN0(16(*MPR*))
                                ELSE
                                  IF(LATTR.TYPTR^.FORM=POWER)
                                    AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)THEN
                                    GEN0(12(*INT*))
                                  ELSE BEGIN ERROR(134);GATTR.TYPTR:=NIL END
                              END;
            (*/*)       RDIV: BEGIN
                              IF LATTR.TYPTR = INTPTR THEN
                                BEGIN GEN0(9(*FLO*));
                                  LATTR.TYPTR := REALPTR
                                END;
                              IF GATTR.TYPTR = INTPTR THEN
                                  BEGIN GEN0(10(*FLT*));
                                  GATTR.TYPTR := REALPTR
                                END;
                              IF (LATTR.TYPTR = REALPTR)
                                AND (GATTR.TYPTR=REALPTR)THEN GEN0(7(*DVR*))
                              ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                            END;
            (*DIV*)     IDIV: IF (LATTR.TYPTR = INTPTR)
                              AND (GATTR.TYPTR = INTPTR) THEN GEN0(6(*DVI*))
                            ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END;
            (*MOD*)     IMOD: IF (LATTR.TYPTR = INTPTR)
                              AND (GATTR.TYPTR = INTPTR) THEN GEN0(14(*MOD*))
                            ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END;
            (*AND*)     ANDOP:IF (LATTR.TYPTR = BOOLPTR)

          AND (GATTR.TYPTR = BOOLPTR) THEN GEN0(4(*AND*))
                            ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                    END (*CASE*)
                  ELSE GATTR.TYPTR := NIL
                END (*WHILE*)
            END (*TERM*) ;

          BEGIN (*SIMPLEEXPRESSION*)
            SIGNED := FALSE;
            IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THEN
              BEGIN SIGNED := OP = MINUS; INSYMBOL END;
            TERM(FSYS + [ADDOP]);
            IF SIGNED THEN
              BEGIN LOAD;
                IF GATTR.TYPTR = INTPTR THEN GEN0(17(*NGI*))
                ELSE
                  IF GATTR.TYPTR = REALPTR THEN GEN0(18(*NGR*))
                  ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
              END;
            WHILE SY = ADDOP DO
              BEGIN LOAD; LATTR := GATTR; LOP := OP;
                INSYMBOL; TERM(FSYS + [ADDOP]); LOAD;
                IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
                  CASE LOP OF
          (*+*)       PLUS:
                      IF (LATTR.TYPTR = INTPTR)AND(GATTR.TYPTR = INTPTR) THEN
                        GEN0(2(*ADI*))
                      ELSE
                        BEGIN
                          IF LATTR.TYPTR = INTPTR THEN
                            BEGIN GEN0(9(*FLO*));
                              LATTR.TYPTR := REALPTR
                            END
                          ELSE
                            IF GATTR.TYPTR = INTPTR THEN
                              BEGIN GEN0(10(*FLT*));
                                GATTR.TYPTR := REALPTR
                              END;
                          IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR)
                            THEN GEN0(3(*ADR*))
                          ELSE IF(LATTR.TYPTR^.FORM=POWER)
                                 AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                                 GEN0(28(*UNI*))
                               ELSE BEGIN ERROR(134);GATTR.TYPTR:=NIL END
                        END;
          (*-*)       MINUS:
                      IF (LATTR.TYPTR = INTPTR)AND(GATTR.TYPTR = INTPTR) THEN
                        GEN0(21(*SBI*))
                      ELSE
                        BEGIN
                          IF LATTR.TYPTR = INTPTR THEN
                            BEGIN GEN0(9(*FLO*));
                              LATTR.TYPTR := REALPTR
                            END
                          ELSE
                            IF GATTR.TYPTR = INTPTR THEN
                            BEGIN GEN0(10(*FLT*));
                                GATTR.TYPTR := REALPTR
                              END;
                          IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR)
                            THEN GEN0(22(*SBR*))
                          ELSE
                            IF (LATTR.TYPTR^.FORM = POWER)
                              AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                              GEN0(5(*DIF*))
                            ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                        END;
          (*OR*)      OROP:
                      IF(LATTR.TYPTR=BOOLPTR)AND(GATTR.TYPTR=BOOLPTR)THEN
                        GEN0(13(*IOR*))
                      ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                  END (*CASE*)
                ELSE GATTR.TYPTR := NIL
              END (*WHILE*)
          END (*SIMPLEEXPRESSION*) ;

        BEGIN (*EXPRESSION*)
          SIMPLEEXPRESSION(FSYS + [RELOP]);
          IF SY = RELOP THEN
            BEGIN
              IF GATTR.TYPTR <> NIL THEN
                IF GATTR.TYPTR^.FORM <= POWER THEN LOAD
                ELSE LOADADDRESS;
                LATTR := GATTR; LOP := OP;
              INSYMBOL; SIMPLEEXPRESSION(FSYS);
              IF GATTR.TYPTR <> NIL THEN
                IF GATTR.TYPTR^.FORM <= POWER THEN LOAD
                ELSE LOADADDRESS;
              IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
                IF LOP = INOP THEN
                  IF GATTR.TYPTR^.FORM = POWER THEN
                    IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR^.ELSET) THEN
                      GEN0(11(*INN*))
                    ELSE BEGIN ERROR(129); GATTR.TYPTR := NIL END
                  ELSE BEGIN ERROR(130); GATTR.TYPTR := NIL END
                ELSE
                  BEGIN

                    IF LATTR.TYPTR <> GATTR.TYPTR THEN
                      IF LATTR.TYPTR = INTPTR THEN
                        BEGIN GEN0(9(*FLO*));
                          LATTR.TYPTR := REALPTR
                        END
                      ELSE
                        IF GATTR.TYPTR = INTPTR THEN
                          BEGIN GEN0(10(*FLT*));
                            GATTR.TYPTR := REALPTR
                          END;
                    IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                      BEGIN LSIZE := LATTR.TYPTR^.SIZE;
                        CASE LATTR.TYPTR^.FORM OF
                          SCALAR:
                            IF LATTR.TYPTR = REALPTR THEN TYPIND := 'R'
                            ELSE
                              IF LATTR.TYPTR = BOOLPTR THEN TYPIND := 'B'
                              ELSE TYPIND := 'I';
                          POINTER:
                            BEGIN
                              IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131);
                              TYPIND := 'A'
                            END;
                          POWER:
                            BEGIN IF LOP IN [LTOP,GTOP] THEN ERROR(132);
                              TYPIND := 'S'
                          END;
                          ARRAYS:
                            BEGIN
                              IF NOT STRING(LATTR.TYPTR)
                              AND(LOP IN[LTOP,LEOP,GTOP,GEOP])THEN ERROR(131);
                              TYPIND := 'M'
                            END;
                          RECORDS:
                            BEGIN
                              IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131);
                              TYPIND := 'M'
                            END;
                          FILES:
                            BEGIN ERROR(133); TYPIND := 'F' END
                        END;
                        CASE LOP OF
                          LTOP: GEN2(53(*LES*),ORD(TYPIND),LSIZE);
                          LEOP: GEN2(52(*LEQ*),ORD(TYPIND),LSIZE);
                          GTOP: GEN2(49(*GRT*),ORD(TYPIND),LSIZE);
                          GEOP: GEN2(48(*GEQ*),ORD(TYPIND),LSIZE);
                          NEOP: GEN2(55(*NEQ*),ORD(TYPIND),LSIZE);
                          EQOP: GEN2(47(*EQU*),ORD(TYPIND),LSIZE)
                        END
                      END
                    ELSE ERROR(129)
                  END;
              GATTR.TYPTR := BOOLPTR; GATTR.KIND := EXPR
            END (*SY = RELOP*)
        END (*EXPRESSION*) ;

        PROCEDURE ASSIGNMENT(FCP: CTP);
          VAR LATTR: ATTR;
        BEGIN SELECTOR(FSYS + [BECOMES],FCP);
          IF SY = BECOMES THEN
            BEGIN
              IF GATTR.TYPTR <> NIL THEN
                IF (GATTR.ACCESS<>DRCT) OR (GATTR.TYPTR^.FORM>POWER) THEN
                  LOADADDRESS;
              LATTR := GATTR;
              INSYMBOL; EXPRESSION(FSYS);
              IF GATTR.TYPTR <> NIL THEN
                IF GATTR.TYPTR^.FORM <= POWER THEN LOAD
                ELSE LOADADDRESS;
              IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
                BEGIN
                  IF COMPTYPES(REALPTR,LATTR.TYPTR)AND(GATTR.TYPTR=INTPTR)THEN
                    BEGIN GEN0(10(*FLT*));
                      GATTR.TYPTR := REALPTR
                    END;
                  IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                    CASE LATTR.TYPTR^.FORM OF
                      SCALAR,
                      SUBRANGE,
                      POINTER,
                      POWER:   STORE(LATTR);
                      ARRAYS,
                      RECORDS: GEN1(40(*MOV*),LATTR.TYPTR^.SIZE);
                      FILES: ERROR(146)
                    END
                  ELSE ERROR(129)
                END
            END (*SY = BECOMES*)
          ELSE ERROR(51)
        END (*ASSIGNMENT*) ;

        PROCEDURE GOTOSTATEMENT;
          VAR LLP: LBP; FOUND: BOOLEAN; TTOP,TTOP1: DISPRANGE;
        BEGIN
          IF SY = INTCONST THEN
            BEGIN
              FOUND := FALSE;
              TTOP := TOP;
              REPEAT
                WHILE DISPLAY[TTOP].OCCUR <> BLCK DO TTOP := TTOP - 1;
                TTOP1 := TTOP; LLP := DISPLAY[TTOP].FLABEL;
                WHILE (LLP <> NIL) AND NOT FOUND DO
                  WITH LLP^ DO
                    IF LABVAL = VAL.IVAL THEN
                      BEGIN FOUND := TRUE;
                        IF TTOP = TTOP1 THEN
                          GENUJPENT(57(*UJP*),LABNAME)
                        ELSE (*GOTO LEADS OUT OF PROCEDURE*) ERROR(399)
                      END
                    ELSE LLP := NEXTLAB;
                TTOP := TTOP - 1
              UNTIL FOUND OR (TTOP = 0);
              IF NOT FOUND THEN ERROR(167);
              INSYMBOL
            END
          ELSE ERROR(15)
        END (*GOTOSTATEMENT*) ;

        PROCEDURE COMPOUNDSTATEMENT;
        BEGIN
          REPEAT
            REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY])
            UNTIL NOT (SY IN STATBEGSYS);
            TEST := SY <> SEMICOLON;
            IF NOT TEST THEN INSYMBOL
          UNTIL TEST;
          IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)
        END (*COMPOUNDSTATEMENET*) ;

        PROCEDURE IFSTATEMENT;
          VAR LCIX1,LCIX2: INTEGER;
        BEGIN EXPRESSION(FSYS + [THENSY]);
          GENLABEL(LCIX1); GENFJP(LCIX1);
          IF SY = THENSY THEN INSYMBOL ELSE ERROR(52);

          STATEMENT(FSYS + [ELSESY]);
          IF SY = ELSESY THEN
            BEGIN GENLABEL(LCIX2); GENUJPENT(57(*UJP*),LCIX2);
              PUTLABEL(LCIX1);
              INSYMBOL; STATEMENT(FSYS);
              PUTLABEL(LCIX2)
            END
          ELSE PUTLABEL(LCIX1)
        END (*IFSTATEMENT*) ;

        PROCEDURE CASESTATEMENT;
          LABEL 1;
          TYPE CIP = ^CASEINFO;
               CASEINFO = PACKED
                          RECORD NEXT: CIP;
                            CSSTART: INTEGER;
                            CSLAB: INTEGER
                          END;
          VAR LSP,LSP1: STP; FSTPTR,LPT1,LPT2,LPT3: CIP; LVAL: VALU;
              LADDR, LCIX, LCIX1, LMIN, LMAX: INTEGER;
        BEGIN EXPRESSION(FSYS + [OFSY,COMMA,COLON]);
          LOAD; GENLABEL(LCIX); GENUJPENT(57(*UJP*),LCIX);
          LSP := GATTR.TYPTR;
          IF LSP <> NIL THEN
            IF (LSP^.FORM <> SCALAR) OR (LSP = REALPTR) THEN
              BEGIN ERROR(144); LSP := NIL END;
          IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
          FSTPTR := NIL; GENLABEL(LADDR);
          REPEAT
            LPT3 := NIL; GENLABEL(LCIX1);
            REPEAT CONSTANT(FSYS + [COMMA,COLON],LSP1,LVAL);
              IF LSP <> NIL THEN
                IF COMPTYPES(LSP,LSP1) THEN
                  BEGIN LPT1 := FSTPTR; LPT2 := NIL;
                    WHILE LPT1 <> NIL DO
                      WITH LPT1^ DO
                        BEGIN
                          IF CSLAB <= LVAL.IVAL THEN
                            BEGIN IF CSLAB = LVAL.IVAL THEN ERROR(156);
                              GOTO 1
                            END;
                          LPT2 := LPT1; LPT1 := NEXT
                        END;
        1:          NEW(LPT3);
                    WITH LPT3^ DO
                      BEGIN NEXT := LPT1; CSLAB := LVAL.IVAL;
                        CSSTART := LCIX1
                      END;
                    IF LPT2 = NIL THEN FSTPTR := LPT3
                    ELSE LPT2^.NEXT := LPT3
                  END
                ELSE ERROR(147);
              TEST := SY <> COMMA;
              IF NOT TEST THEN INSYMBOL
            UNTIL TEST;
            IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
            PUTLABEL(LCIX1);
            REPEAT STATEMENT(FSYS + [SEMICOLON])
            UNTIL NOT (SY IN STATBEGSYS);
            IF LPT3 <> NIL THEN
              GENUJPENT(57(*UJP*),LADDR);
            TEST := SY <> SEMICOLON;
            IF NOT TEST THEN INSYMBOL
          UNTIL TEST;
          PUTLABEL(LCIX);
          IF FSTPTR <> NIL THEN
            BEGIN LMAX := FSTPTR^.CSLAB;
              (*REVERSE POINTERS*)
              LPT1 := FSTPTR; FSTPTR := NIL;
              REPEAT LPT2 := LPT1^.NEXT; LPT1^.NEXT := FSTPTR;
                FSTPTR := LPT1; LPT1 := LPT2
              UNTIL LPT1 = NIL;
              LMIN := FSTPTR^.CSLAB;
              IF LMAX - LMIN < CIXMAX THEN
                BEGIN IF LC+INTSIZE > LCMAX THEN LCMAX := LC + INTSIZE;
                  GEN2(56(*STR*),0,LC); GEN2(54(*LOD*),0,LC);
                  GEN2(51(*LDC*),1,LMIN); GEN2(48(*GEQ*),ORD('I'),0);
                  GENUJPENT(33(*FJP*),LADDR); GEN2(54(*LOD*),0,LC);
                  GEN2(51(*LDC*),1,LMAX); GEN2(52(*LEQI*),ORD('I'),0);
                  GENUJPENT(33(*FJP*),LADDR); GEN2(54(*LOD*),0,LC);
                  GEN2(51(*LDC*),1,LMIN); GEN0(21(*SBI*)); GENLABEL(LCIX);
                  GENUJPENT(44(*XJP*),LCIX); PUTLABEL(LCIX);
                  REPEAT
                    WITH FSTPTR^ DO
                      BEGIN
                        WHILE CSLAB > LMIN DO
                          BEGIN GENUJPENT(57(*UJP*),LADDR); LMIN:=LMIN+1 END;
                        GENUJPENT(57(*UJP*),CSSTART);
                        FSTPTR := NEXT; LMIN := LMIN + 1
                      END
                  UNTIL FSTPTR = NIL;
                  PUTLABEL(LADDR)
                END
              ELSE ERROR(157)
            END;
            IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)
        END (*CASESTATEMENT*) ;

        PROCEDURE REPEATSTATEMENT;
          VAR LADDR: INTEGER;
        BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);
          REPEAT
            REPEAT STATEMENT(FSYS + [SEMICOLON,UNTILSY])
            UNTIL NOT (SY IN STATBEGSYS);
            TEST := SY <> SEMICOLON;
            IF NOT TEST THEN INSYMBOL
          UNTIL TEST;
          IF SY = UNTILSY THEN
            BEGIN INSYMBOL; EXPRESSION(FSYS); GENFJP(LADDR)
            END
          ELSE ERROR(53)
        END (*REPEATSTATEMENT*) ;

        PROCEDURE WHILESTATEMENT;
          VAR LADDR, LCIX: INTEGER;
        BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);
          EXPRESSION(FSYS + [DOSY]); GENLABEL(LCIX); GENFJP(LCIX);
          IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
          STATEMENT(FSYS); GENUJPENT(57(*UJP*),LADDR); PUTLABEL(LCIX)
        END (*WHILESTATEMENT*) ;

        PROCEDURE FORSTATEMENT;
          VAR LATTR: ATTR; {LSP: STP;}  LSY: SYMBOL;
              LCIX, LADDR: INTEGER;
        BEGIN
          IF SY = IDENT THEN
            BEGIN SEARCHID([VARS],LCP);
              WITH LCP^, LATTR DO
                BEGIN TYPTR := IDTYPE; KIND := VARBL;
                  IF VKIND = ACTUAL THEN
                    BEGIN ACCESS := DRCT; VLEVEL := VLEV;
                      DPLMT := VADDR
                    END
                  ELSE BEGIN ERROR(155); TYPTR := NIL END
                END;
              IF LATTR.TYPTR <> NIL THEN
                IF (LATTR.TYPTR^.FORM > SUBRANGE)
                   OR COMPTYPES(REALPTR,LATTR.TYPTR) THEN
                  BEGIN ERROR(143); LATTR.TYPTR := NIL END;
              INSYMBOL
            END
          ELSE
            BEGIN ERROR(2); SKIP(FSYS + [BECOMES,TOSY,DOWNTOSY,DOSY]) END;
          IF SY = BECOMES THEN
            BEGIN INSYMBOL; EXPRESSION(FSYS + [TOSY,DOWNTOSY,DOSY]);
              IF GATTR.TYPTR <> NIL THEN
                  IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(144)
                  ELSE
                    IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                      BEGIN LOAD; STORE(LATTR) END
                    ELSE ERROR(145)
            END
          ELSE
            BEGIN ERROR(51); SKIP(FSYS + [TOSY,DOWNTOSY,DOSY]) END;
          IF SY IN [TOSY,DOWNTOSY] THEN
            BEGIN LSY := SY; INSYMBOL; EXPRESSION(FSYS + [DOSY]);
              IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(144)
                ELSE
                  IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                    BEGIN LOAD; GEN2(56(*STR*),0,LC);
                      GENLABEL(LADDR); PUTLABEL(LADDR);
                      GATTR := LATTR; LOAD; GEN2(54(*LOD*),0,LC);
                      LC := LC + INTSIZE;
                      IF LC > LCMAX THEN LCMAX := LC;
                      IF LSY = TOSY THEN GEN2(52(*LEQ*),ORD('I'),1)
                      ELSE GEN2(48(*GEQ*),ORD('I'),1);
                    END
                  ELSE ERROR(145)
            END
          ELSE BEGIN ERROR(55); SKIP(FSYS + [DOSY]) END;
          GENLABEL(LCIX); GENUJPENT(33(*FJP*),LCIX);
          IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
          STATEMENT(FSYS);
          GATTR := LATTR; LOAD;
          IF LSY = TOSY THEN GEN1(34(*INC*),1) ELSE GEN1(31(*DEC*),1);
          STORE(LATTR); GENUJPENT(57(*UJP*),LADDR); PUTLABEL(LCIX);
          LC := LC - INTSIZE
        END (*FORSTATEMENT*) ;


        PROCEDURE WITHSTATEMENT;
          VAR LCP: CTP; LCNT1,LCNT2: DISPRANGE;
        BEGIN LCNT1 := 0; LCNT2 := 0;
          REPEAT
            IF SY = IDENT THEN
              BEGIN SEARCHID([VARS,FIELD],LCP); INSYMBOL END
            ELSE BEGIN ERROR(2); LCP := UVARPTR END;
            SELECTOR(FSYS + [COMMA,DOSY],LCP);
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR^.FORM = RECORDS THEN
                IF TOP < DISPLIMIT THEN
                  BEGIN TOP := TOP + 1; LCNT1 := LCNT1 + 1;
                    WITH DISPLAY[TOP] DO
                      BEGIN FNAME := GATTR.TYPTR^.FSTFLD;
                        FLABEL := NIL
                      END;
                    IF GATTR.ACCESS = DRCT THEN
                      WITH DISPLAY[TOP] DO
                        BEGIN OCCUR := CREC; CLEV := GATTR.VLEVEL;
                          CDSPL := GATTR.DPLMT
                        END
                    ELSE
                      BEGIN LOADADDRESS; GEN2(56(*STR*),0,LC);
                        WITH DISPLAY[TOP] DO
                          BEGIN OCCUR := VREC; VDSPL := LC END;
                        LC := LC + PTRSIZE; LCNT2 := LCNT2 + PTRSIZE;
                        IF LC > LCMAX THEN LCMAX := LC
                      END
                  END
                ELSE ERROR(250)
              ELSE ERROR(140);
            TEST := SY <> COMMA;
            IF NOT TEST THEN INSYMBOL
          UNTIL TEST;
          IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
          STATEMENT(FSYS);
          TOP := TOP - LCNT1; LC := LC - LCNT2;
        END (*WITHSTATEMENT*) ;

      BEGIN (*STATEMENT*)
        IF SY = INTCONST THEN (*LABEL*)
          BEGIN LLP := DISPLAY[TOP].FLABEL;
            WHILE LLP <> NIL DO
              WITH LLP^ DO
                IF LABVAL = VAL.IVAL THEN
                  BEGIN IF DEFINED THEN ERROR(165);
                    PUTLABEL(LABNAME); DEFINED := TRUE;
                    GOTO 1
                  END
                ELSE LLP := NEXTLAB;
            ERROR(167);
      1:    INSYMBOL;
            IF SY = COLON THEN INSYMBOL ELSE ERROR(5)
          END;
        IF NOT (SY IN FSYS + [IDENT]) THEN
          BEGIN ERROR(6); SKIP(FSYS) END;
        IF SY IN STATBEGSYS + [IDENT] THEN
          BEGIN
            CASE SY OF
              IDENT:    BEGIN SEARCHID([VARS,FIELD,FUNC,PROC],LCP); INSYMBOL;
                          IF LCP^.KLASS = PROC THEN CALL(FSYS,LCP)
                          ELSE ASSIGNMENT(LCP)
                        END;
              BEGINSY:  BEGIN INSYMBOL; COMPOUNDSTATEMENT END;
              GOTOSY:   BEGIN INSYMBOL; GOTOSTATEMENT END;
              IFSY:     BEGIN INSYMBOL; IFSTATEMENT END;
              CASESY:   BEGIN INSYMBOL; CASESTATEMENT END;
              WHILESY:  BEGIN INSYMBOL; WHILESTATEMENT END;
              REPEATSY: BEGIN INSYMBOL; REPEATSTATEMENT END;
              FORSY:    BEGIN INSYMBOL; FORSTATEMENT END;
              WITHSY:   BEGIN INSYMBOL; WITHSTATEMENT END
            END;
            IF NOT (SY IN [SEMICOLON,ENDSY,ELSESY,UNTILSY]) THEN
              BEGIN ERROR(6); SKIP(FSYS) END
          END
      END (*STATEMENT*) ;

    BEGIN (*BODY*)
      IF FPROCP <> NIL THEN ENTNAME := FPROCP^.PFNAME
      ELSE GENLABEL(ENTNAME);
      CSTPTRIX := 0;
      PUTLABEL(ENTNAME); GENLABEL(SEGSIZE);
      GENUJPENT(32(*ENT*),SEGSIZE);
      IF FPROCP <> NIL THEN (*COPY MULTIPLE VALUES INTO LOACAL CELLS*)
        BEGIN LLC1 := LCAFTERMARKSTACK;
          LCP := FPROCP^.NEXT;
          WHILE LCP <> NIL DO
            WITH LCP^ DO
              BEGIN
                IF KLASS = VARS THEN
                  IF IDTYPE <> NIL THEN
                    IF (VKIND = ACTUAL) AND (IDTYPE^.SIZE > PTRSIZE) THEN
                      BEGIN
                        GEN2(50(*LDA*),0,VADDR);
                        GEN2(54(*LOD*),0,LLC1);
                        GEN1(40(*MOV*),IDTYPE^.SIZE);
                        LLC1 := LLC1 + PTRSIZE
                      END
                    ELSE LLC1 := LLC1 + IDTYPE^.SIZE;
                LCP := LCP^.NEXT;
              END;
        END;
      LCMAX := LC;
      REPEAT
        REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY])
        UNTIL NOT (SY IN STATBEGSYS);
        TEST := SY <> SEMICOLON;
        IF NOT TEST THEN INSYMBOL
      UNTIL TEST;
      IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13);
      LLP := DISPLAY[TOP].FLABEL; (*TEST FOR UNDEFINED LABELS*)
      WHILE LLP <> NIL DO
        WITH LLP^ DO
          BEGIN
            IF NOT DEFINED THEN
              BEGIN ERROR(168);
                WRITELN(OUTPUT); WRITELN(OUTPUT,' LABEL ',LABVAL);
                WRITE(OUTPUT,' ':CHCNT+16)
              END;
            LLP := NEXTLAB
          END;
      IF FPROCP <> NIL THEN
        BEGIN
          IF FPROCP^.IDTYPE = NIL THEN GEN1(42(*RET*),ORD('P'))
          ELSE
            WITH FPROCP^ DO
              IF IDTYPE = REALPTR THEN GEN1(42(*RET*),ORD('R'))
              ELSE IF IDTYPE = BOOLPTR THEN GEN1(42(*RET*),ORD('B'))
                   ELSE IF IDTYPE^.FORM = POINTER THEN
                          GEN1(42(*RET*),ORD('A'))
                        ELSE IF (IDTYPE = CHARPTR)
                                OR ((IDTYPE^.FORM = SUBRANGE)
                                    AND (IDTYPE^.RANGETYPE = CHARPTR)) THEN
                               GEN1(42(*RET*),ORD('C'))
                             ELSE GEN1(42(*RET*),ORD('I'));
          IF PRCODE THEN WRITELN(PRR,'L',SEGSIZE:4,'=',LCMAX)
        END
      ELSE
        BEGIN GEN1(42(*RET*),ORD('P')); LCMAX := LCMAX - 1;
          IF PRCODE THEN WRITELN(PRR,'L',SEGSIZE:4,'=',LCMAX);
          IF PRCODE THEN
            BEGIN  WRITELN(PRR) (*SIMULATES EOR*) END;
          IC := 0;
          (*GENERATE CALL OF MAIN PROGRAM; NOTE THAT THIS CALL MUST BE LOADED
           AT ABSOLUTE ADDRESS ZERO*)
          GEN1(41(*MST*),0); GENCUP(0,ENTNAME); GEN0(29(*STP*));
          IF PRCODE THEN
            BEGIN  WRITELN(PRR) (*SIMULATES EOR*) END;
          SAVEID := ID;
          WHILE FEXTFILEP <> NIL DO
            BEGIN
              WITH FEXTFILEP^ DO
                IF NOT ((FILENAME = 'INPUT   ') OR (FILENAME = 'OUTPUT  ') OR
                        (FILENAME = 'PRD     ') OR (FILENAME = 'PRR     '))
                THEN BEGIN ID := FILENAME;
                       SEARCHID([VARS],LLCP);
                       IF LLCP <> NIL THEN
                         IF LLCP^.IDTYPE^.FORM <> FILES THEN
                           LLCP := NIL;
                       IF LLCP = NIL THEN
                         BEGIN WRITELN(OUTPUT);
                           WRITELN(OUTPUT,' ':8,'UNDECLARED ','EXTERNAL FILE',
                                     FEXTFILEP^.FILENAME:8);
                           WRITE(OUTPUT,' ':CHCNT+16)
                         END
                     END;
                FEXTFILEP := FEXTFILEP^.NEXTFILE
            END;
          ID := SAVEID;
          IF LIST THEN
            WRITELN(OUTPUT);
          IF PRTABLES THEN PRINTTABLES(TRUE)
        END;
    END (*BODY*) ;

  BEGIN (*BLOCK*)
    DP := TRUE;
    REPEAT
      IF SY = LABELSY THEN
        BEGIN INSYMBOL; LABELDECLARATION END;
      IF SY = CONSTSY THEN
        BEGIN INSYMBOL; CONSTDECLARATION END;
      IF SY = TYPESY THEN
        BEGIN INSYMBOL; TYPEDECLARATION END;
      IF SY = VARSY THEN
        BEGIN INSYMBOL; VARDECLARATION END;
      WHILE SY IN [PROCSY,FUNCSY] DO
        BEGIN LSY := SY; INSYMBOL; PROCDECLARATION(LSY) END;
      IF SY <> BEGINSY THEN
        BEGIN ERROR(18); SKIP(FSYS) END
    UNTIL SY IN STATBEGSYS;
    DP := FALSE;
    IF SY = BEGINSY THEN INSYMBOL ELSE ERROR(17);
    REPEAT BODY(FSYS + [CASESY]);
      IF SY <> FSY THEN
        BEGIN ERROR(6); SKIP(FSYS + [FSY]) END
    UNTIL (SY = FSY) OR (SY IN BLOCKBEGSYS);
  END (*BLOCK*) ;

  PROCEDURE PROGRAMME(FSYS:SETOFSYS);
    VAR EXTFP:EXTFILEP;
  BEGIN
    IF SY = PROGSY THEN
      BEGIN INSYMBOL; IF SY <> IDENT THEN ERROR(2); INSYMBOL;
        IF NOT (SY IN [LPARENT,SEMICOLON]) THEN ERROR(14);
        IF SY = LPARENT  THEN
          BEGIN
            REPEAT INSYMBOL;
              IF SY = IDENT THEN
                BEGIN NEW(EXTFP);
                  WITH EXTFP^ DO
                    BEGIN FILENAME := ID; NEXTFILE := FEXTFILEP END;
                  FEXTFILEP := EXTFP;
                  INSYMBOL;
                  IF NOT ( SY IN [COMMA,RPARENT] ) THEN ERROR(20)
                END
              ELSE ERROR(2)
            UNTIL SY <> COMMA;
            IF SY <> RPARENT THEN ERROR(4);
            INSYMBOL
          END;
        IF SY <> SEMICOLON THEN ERROR(14)
        ELSE INSYMBOL;
      END;
    REPEAT BLOCK(FSYS,PERIOD,NIL);
      IF SY <> PERIOD THEN ERROR(21)
    UNTIL SY = PERIOD
  END (*PROGRAMME*) ;


  PROCEDURE STDNAMES;
  BEGIN
    NA[ 1] := 'FALSE   '; NA[ 2] := 'TRUE    '; NA[ 3] := 'INPUT   ';
    NA[ 4] := 'OUTPUT  '; NA[ 5] := 'GET     '; NA[ 6] := 'PUT     ';
    NA[ 7] := 'RESET   '; NA[ 8] := 'REWRITE '; NA[ 9] := 'READ    ';
    NA[10] := 'WRITE   '; NA[11] := 'PACK    '; NA[12] := 'UNPACK  ';
    NA[13] := 'NEW     '; NA[14] := 'RELEASE '; NA[15] := 'READLN  ';
    NA[16] := 'WRITELN ';
    NA[17] := 'ABS     '; NA[18] := 'SQR     '; NA[19] := 'TRUNC   ';
    NA[20] := 'ODD     '; NA[21] := 'ORD     '; NA[22] := 'CHR     ';
    NA[23] := 'PRED    '; NA[24] := 'SUCC    '; NA[25] := 'EOF     ';
    NA[26] := 'EOLN    ';
    NA[27] := 'SIN     '; NA[28] := 'COS     '; NA[29] := 'EXP     ';
    NA[30] := 'SQRT    '; NA[31] := 'LN      '; NA[32] := 'ARCTAN  ';
    NA[33] := 'PRD     '; NA[34] := 'PRR     '; NA[35] := 'MARK    ';
  END (*STDNAMES*) ;

  PROCEDURE ENTERSTDTYPES;
    {VAR SP: STP;}
  BEGIN                                                 (*TYPE UNDERLIEING:*)
                                                         (*******************)

    NEW(INTPTR,SCALAR,STANDARD);                              (*INTEGER*)
    WITH INTPTR^ DO
      BEGIN SIZE := INTSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
    NEW(REALPTR,SCALAR,STANDARD);                             (*REAL*)
    WITH REALPTR^ DO
      BEGIN SIZE := REALSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
    NEW(CHARPTR,SCALAR,STANDARD);                             (*CHAR*)
    WITH CHARPTR^ DO
      BEGIN SIZE := CHARSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
    NEW(BOOLPTR,SCALAR,DECLARED);                             (*BOOLEAN*)
    WITH BOOLPTR^ DO
      BEGIN SIZE := BOOLSIZE; FORM := SCALAR; SCALKIND := DECLARED END;
    NEW(NILPTR,POINTER);                                      (*NIL*)
    WITH NILPTR^ DO
      BEGIN ELTYPE := NIL; SIZE := PTRSIZE; FORM := POINTER END;
    NEW(TEXTPTR,FILES);                                       (*TEXT*)
    WITH TEXTPTR^ DO
      BEGIN FILTYPE := CHARPTR; SIZE := CHARSIZE; FORM := FILES END
  END (*ENTERSTDTYPES*) ;

  PROCEDURE ENTSTDNAMES;
    VAR CP,CP1: CTP; I: INTEGER;
  BEGIN                                                       (*NAME:*)
                                                              (*******)

    NEW(CP,TYPES);                                            (*INTEGER*)
    WITH CP^ DO
      BEGIN NAME := 'INTEGER '; IDTYPE := INTPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);                                            (*REAL*)
    WITH CP^ DO
      BEGIN NAME := 'REAL    '; IDTYPE := REALPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);                                            (*CHAR*)
    WITH CP^ DO
      BEGIN NAME := 'CHAR    '; IDTYPE := CHARPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);                                            (*BOOLEAN*)
    WITH CP^ DO
      BEGIN NAME := 'BOOLEAN '; IDTYPE := BOOLPTR; KLASS := TYPES END;
    ENTERID(CP);
    CP1 := NIL;
    FOR I := 1 TO 2 DO
      BEGIN NEW(CP,KONST);                                    (*FALSE,TRUE*)
        WITH CP^ DO
          BEGIN NAME := NA[I]; IDTYPE := BOOLPTR;
            NEXT := CP1; VALUES.IVAL := I - 1; KLASS := KONST
          END;
        ENTERID(CP); CP1 := CP
      END;
    BOOLPTR^.FCONST := CP;
    NEW(CP,KONST);                                             (*NIL*)
    WITH CP^ DO
      BEGIN NAME := 'NIL     '; IDTYPE := NILPTR;
        NEXT := NIL; VALUES.IVAL := 0; KLASS := KONST
      END;
    ENTERID(CP);
    FOR I := 3 TO 4 DO
      BEGIN NEW(CP,VARS);                                     (*INPUT,OUTPUT*)
        WITH CP^ DO
          BEGIN NAME := NA[I]; IDTYPE := TEXTPTR; KLASS := VARS;
            VKIND := ACTUAL; NEXT := NIL; VLEV := 1;
            VADDR := LCAFTERMARKSTACK + (I-3)*CHARSIZE
          END;
        ENTERID(CP)
      END;
    FOR I:=33 TO 34 DO
      BEGIN NEW(CP,VARS);                                     (*PRD,PRR FILES*)
         WITH CP^ DO
           BEGIN NAME := NA[I]; IDTYPE := TEXTPTR; KLASS := VARS;
              VKIND := ACTUAL; NEXT := NIL; VLEV := 1;
              VADDR := LCAFTERMARKSTACK + (I-31)*CHARSIZE
           END;
         ENTERID(CP)
      END;
    FOR I := 5 TO 16 DO
      BEGIN NEW(CP,PROC,STANDARD);                         (*GET,PUT,RESET*)
        WITH CP^ DO                                           (*REWRITE,READ*)
          BEGIN NAME := NA[I]; IDTYPE := NIL;                 (*WRITE,PACK*)
            NEXT := NIL; KEY := I - 4;                        (*UNPACK,PACK*)
            KLASS := PROC; PFDECKIND := STANDARD
          END;
        ENTERID(CP)
      END;
    NEW(CP,PROC,STANDARD);
    WITH CP^ DO
        BEGIN NAME:=NA[35]; IDTYPE:=NIL;
              NEXT:= NIL; KEY:=13;
              KLASS:=PROC; PFDECKIND:= STANDARD
        END; ENTERID(CP);
    FOR I := 17 TO 26 DO
      BEGIN NEW(CP,FUNC,STANDARD);                         (*ABS,SQR,TRUNC*)
        WITH CP^ DO                                           (*ODD,ORD,CHR*)
          BEGIN NAME := NA[I]; IDTYPE := NIL;              (*PRED,SUCC,EOF*)
            NEXT := NIL; KEY := I - 16;
            KLASS := FUNC; PFDECKIND := STANDARD
          END;
        ENTERID(CP)
      END;
    NEW(CP,VARS);                      (*PARAMETER OF PREDECLARED FUNCTIONS*)
    WITH CP^ DO
      BEGIN NAME := '        '; IDTYPE := REALPTR; KLASS := VARS;
        VKIND := ACTUAL; NEXT := NIL; VLEV := 1; VADDR := 0
      END;
    FOR I := 27 TO 32 DO
      BEGIN NEW(CP1,FUNC,DECLARED,ACTUAL);                    (*SIN,COS,EXP*)
        WITH CP1^ DO                                       (*SQRT,LN,ARCTAN*)
          BEGIN NAME := NA[I]; IDTYPE := REALPTR; NEXT := CP;
            FORWDECL := FALSE; EXTERN := TRUE; PFLEV := 0; PFNAME := I - 12;
            KLASS := FUNC; PFDECKIND := DECLARED; PFKIND := ACTUAL
          END;
        ENTERID(CP1)
      END
  END (*ENTSTDNAMES*) ;

  PROCEDURE ENTERUNDECL;
  BEGIN
    NEW(UTYPPTR,TYPES);
    WITH UTYPPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; KLASS := TYPES END;
    NEW(UCSTPTR,KONST);
    WITH UCSTPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;
        KLASS := KONST; VALUES.IVAL := 0
      END;
    NEW(UVARPTR,VARS);
    WITH UVARPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; VKIND := ACTUAL;
        NEXT := NIL; VLEV := 0; VADDR := 0; KLASS := VARS
      END;
    NEW(UFLDPTR,FIELD);
    WITH UFLDPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL; FLDADDR := 0;
        KLASS := FIELD
      END;
    NEW(UPRCPTR,PROC,DECLARED,ACTUAL);
    WITH UPRCPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; FORWDECL := FALSE;
        NEXT := NIL; EXTERN := FALSE; PFLEV := 0; GENLABEL(PFNAME);
        KLASS := PROC; PFDECKIND := DECLARED; PFKIND := ACTUAL
      END;
    NEW(UFCTPTR,FUNC,DECLARED,ACTUAL);
    WITH UFCTPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;
        FORWDECL := FALSE; EXTERN := FALSE; PFLEV := 0; GENLABEL(PFNAME);
        KLASS := FUNC; PFDECKIND := DECLARED; PFKIND := ACTUAL
      END
  END (*ENTERUNDECL*) ;

  PROCEDURE INITSCALARS;
  BEGIN FWPTR := NIL;
    { TURN OUTPUT CODE BACK ON. [SAM] }
    PRTABLES := FALSE; LIST := TRUE; PRCODE := TRUE {FALSE};
    DP := TRUE; PRTERR := TRUE; ERRINX := 0;
    INTLABEL := 0; KK := 8; FEXTFILEP := NIL;
    LC := LCAFTERMARKSTACK + FILEBUFFER*CHARSIZE;
    (* NOTE IN THE ABOVE RESERVATION OF BUFFER STORE FOR 2 TEXT FILES *)
    IC := 3; EOL := TRUE; LINECOUNT := 0;
    CH := ' '; CHCNT := 0;
    GLOBTESTP := NIL;
    MXINT10 := MAXINT DIV 10; DIGMAX := STRGLGTH - 1;

  END (*INITSCALARS*) ;

  PROCEDURE INITSETS;
  BEGIN
    CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT];
    SIMPTYPEBEGSYS := [LPARENT] + CONSTBEGSYS;
    TYPEBEGSYS:=[ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY]+SIMPTYPEBEGSYS;
    TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY];
    BLOCKBEGSYS := [LABELSY,CONSTSY,TYPESY,VARSY,PROCSY,FUNCSY,
                    BEGINSY];
    SELECTSYS := [ARROW,PERIOD,LBRACK];
    FACBEGSYS := [INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT,LBRACK,NOTSY];
    STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY,
                   CASESY];
  END (*INITSETS*) ;

  PROCEDURE INITTABLES;
    PROCEDURE RESWORDS;
    BEGIN
      RW[ 1] := 'IF      '; RW[ 2] := 'DO      '; RW[ 3] := 'OF      ';
      RW[ 4] := 'TO      '; RW[ 5] := 'IN      '; RW[ 6] := 'OR      ';
      RW[ 7] := 'END     '; RW[ 8] := 'FOR     '; RW[ 9] := 'VAR     ';
      RW[10] := 'DIV     '; RW[11] := 'MOD     '; RW[12] := 'SET     ';
      RW[13] := 'AND     '; RW[14] := 'NOT     '; RW[15] := 'THEN    ';
      RW[16] := 'ELSE    '; RW[17] := 'WITH    '; RW[18] := 'GOTO    ';
      RW[19] := 'CASE    '; RW[20] := 'TYPE    ';
      RW[21] := 'FILE    '; RW[22] := 'BEGIN   ';
      RW[23] := 'UNTIL   '; RW[24] := 'WHILE   '; RW[25] := 'ARRAY   ';
      RW[26] := 'CONST   '; RW[27] := 'LABEL   ';
      RW[28] := 'REPEAT  '; RW[29] := 'RECORD  '; RW[30] := 'DOWNTO  ';
      RW[31] := 'PACKED  '; RW[32] := 'FORWARD '; RW[33] := 'PROGRAM ';
      RW[34] := 'FUNCTION'; RW[35] := 'PROCEDUR';
      FRW[1] :=  1; FRW[2] :=  1; FRW[3] :=  7; FRW[4] := 15; FRW[5] := 22;
      FRW[6] := 28; FRW[7] := 32; FRW[8] := 34; FRW[9] := 36;
    END (*RESWORDS*) ;

    PROCEDURE SYMBOLS;
    BEGIN
      RSY[1] := IFSY; RSY[2] := DOSY; RSY[3] := OFSY; RSY[4] := TOSY;
      RSY[5] := RELOP; RSY[6] := ADDOP; RSY[7] := ENDSY; RSY[8] := FORSY;
      RSY[9] := VARSY; RSY[10] := MULOP; RSY[11] := MULOP; RSY[12] := SETSY;
      RSY[13] := MULOP; RSY[14] := NOTSY; RSY[15] := THENSY;
      RSY[16] := ELSESY; RSY[17] := WITHSY; RSY[18] := GOTOSY;
      RSY[19] := CASESY; RSY[20] := TYPESY;
      RSY[21] := FILESY; RSY[22] := BEGINSY;
      RSY[23] := UNTILSY; RSY[24] := WHILESY; RSY[25] := ARRAYSY;
      RSY[26] := CONSTSY; RSY[27] := LABELSY;
      RSY[28] := REPEATSY; RSY[29] := RECORDSY; RSY[30] := DOWNTOSY;
      RSY[31] := PACKEDSY; RSY[32] := FORWARDSY; RSY[33] := PROGSY;
      RSY[34] := FUNCSY; RSY[35] := PROCSY;
      SSY['+'] := ADDOP; SSY['-'] := ADDOP; SSY['*'] := MULOP;
      SSY['/'] := MULOP; SSY['('] := LPARENT; SSY[')'] := RPARENT;
      SSY['$'] := OTHERSY; SSY['='] := RELOP; SSY[' '] := OTHERSY;
      SSY[','] := COMMA; SSY['.'] := PERIOD; SSY[''''] := OTHERSY;
      SSY['['] := LBRACK; SSY[']'] := RBRACK; SSY[':'] := COLON;
      SSY['^'] := ARROW;
      SSY['<'] := RELOP; SSY['>'] := RELOP;
      SSY[';'] := SEMICOLON;
    END (*SYMBOLS*) ;

    PROCEDURE RATORS;
      VAR I: INTEGER; CH: CHAR;
    BEGIN
      FOR I := 1 TO 35 (*NR OF RES WORDS*) DO ROP[I] := NOOP;
      ROP[5] := INOP; ROP[10] := IDIV; ROP[11] := IMOD;
      ROP[6] := OROP; ROP[13] := ANDOP;
      FOR CH := chr(0) { '+' } TO chr(maxchr) { ';' } DO SOP[CH] := NOOP;
      SOP['+'] := PLUS; SOP['-'] := MINUS; SOP['*'] := MUL; SOP['/'] := RDIV;
      SOP['='] := EQOP;
      SOP['<'] := LTOP; SOP['>'] := GTOP;
    END (*RATORS*) ;

    PROCEDURE PROCMNEMONICS;
    BEGIN
      SNA[ 1] :=' GET'; SNA[ 2] :=' PUT'; SNA[ 3] :=' RDI'; SNA[ 4] :=' RDR';
      SNA[ 5] :=' RDC'; SNA[ 6] :=' WRI'; SNA[ 7] :=' WRO'; SNA[ 8] :=' WRR';
      SNA[ 9] :=' WRC'; SNA[10] :=' WRS'; SNA[11] :=' PAK'; SNA[12] :=' NEW';
      SNA[13] :=' RST'; SNA[14] :=' ELN'; SNA[15] :=' SIN'; SNA[16] :=' COS';
      SNA[17] :=' EXP'; SNA[18] :=' SQT'; SNA[19] :=' LOG'; SNA[20] :=' ATN';
      SNA[21] :=' RLN'; SNA[22] :=' WLN'; SNA[23] :=' SAV';
    END (*PROCMNEMONICS*) ;

    PROCEDURE INSTRMNEMONICS;
    BEGIN
      MN[0] :=' ABI'; MN[1] :=' ABR'; MN[2] :=' ADI'; MN[3] :=' ADR';
      MN[4] :=' AND'; MN[5] :=' DIF'; MN[6] :=' DVI'; MN[7] :=' DVR';
      MN[8] :=' EOF'; MN[9] :=' FLO'; MN[10] :=' FLT'; MN[11] :=' INN';
      MN[12] :=' INT'; MN[13] :=' IOR'; MN[14] :=' MOD'; MN[15] :=' MPI';
      MN[16] :=' MPR'; MN[17] :=' NGI'; MN[18] :=' NGR'; MN[19] :=' NOT';
      MN[20] :=' ODD'; MN[21] :=' SBI'; MN[22] :=' SBR'; MN[23] :=' SGS';
      MN[24] :=' SQI'; MN[25] :=' SQR'; MN[26] :=' STO'; MN[27] :=' TRC';
      MN[28] :=' UNI'; MN[29] :=' STP'; MN[30] :=' CSP'; MN[31] :=' DEC';
      MN[32] :=' ENT'; MN[33] :=' FJP'; MN[34] :=' INC'; MN[35] :=' IND';
      MN[36] :=' IXA'; MN[37] :=' LAO'; MN[38] :=' LCA'; MN[39] :=' LDO';
      MN[40] :=' MOV'; MN[41] :=' MST'; MN[42] :=' RET'; MN[43] :=' SRO';
      MN[44] :=' XJP'; MN[45] :=' CHK'; MN[46] :=' CUP'; MN[47] :=' EQU';
      MN[48] :=' GEQ'; MN[49] :=' GRT'; MN[50] :=' LDA'; MN[51] :=' LDC';
      MN[52] :=' LEQ'; MN[53] :=' LES'; MN[54] :=' LOD'; MN[55] :=' NEQ';
      MN[56] :=' STR'; MN[57] :=' UJP';
    END (*INSTRMNEMONICS*) ;

  BEGIN (*INITTABLES*)
    RESWORDS; SYMBOLS; RATORS;
    INSTRMNEMONICS; PROCMNEMONICS;
  END (*INITTABLES*) ;

BEGIN

  (*INITIALIZE*)
  (************)
  INITSCALARS; INITSETS; INITTABLES;

  (*ENTER STANDARD NAMES AND STANDARD TYPES:*)
  (******************************************)

  LEVEL := 0; TOP := 0;
  WITH DISPLAY[0] DO
    BEGIN FNAME := NIL; FLABEL := NIL; OCCUR := BLCK END;
  ENTERSTDTYPES;   STDNAMES; ENTSTDNAMES;   ENTERUNDECL;
  TOP := 1; LEVEL := 1;
  WITH DISPLAY[1] DO
    BEGIN FNAME := NIL; FLABEL := NIL; OCCUR := BLCK END;

  (*COMPILE:*)
  (**********)

  { REWRITE(PRR); } (* REQUIRED FOR ISO 7185 [SAM] *)
  INSYMBOL;
  PROGRAMME(BLOCKBEGSYS+STATBEGSYS-[CASESY]);

END.

Added p2/roman.cmp.











































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
P5 Pascal interpreter vs. 1.2.x

Assembling/loading program
Running program


         1 I
         2 II
         4 IIII
         8 VIII
        16 XVI
        32 XXXII
        64 LXIIII
       128 CXXVIII
       256 CCLVI
       512 DXII
      1024 MXXIIII
      2048 MMXXXXVIII
      4096 MMMMLXXXXVI

program complete

Added p2/roman.pas.





















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
(*$L-*)
(* PROGRAM  4.7
 WRITE ROMAN NUMERALS *)
 
PROGRAM ROMAN(OUTPUT);
 
VAR X, Y : INTEGER;
BEGIN Y := 1;
   REPEAT X := Y; WRITE(X, ' ');
      WHILE X >= 1000 DO
         BEGIN WRITE('M'); X := X - 1000 END;
      IF X >= 500 THEN
         BEGIN WRITE('D'); X := X - 500 END;
      WHILE X >= 100 DO
         BEGIN WRITE('C'); X := X - 100 END;
      IF X >= 50 THEN
         BEGIN WRITE('L'); X := X - 50 END;
      WHILE X >= 10 DO
         BEGIN WRITE('X'); X := X - 10 END;
      IF X >= 5 THEN
         BEGIN WRITE('V'); X := X - 5 END;
      WHILE X >= 1 DO
         BEGIN WRITE('I'); X := X - 1 END;
      WRITELN(OUTPUT); Y := 2 * Y
   UNTIL Y > 5000
END.

Added p4/pcom.pas.

















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
(*$c+,t-,d-,l-*)
 (***********************************************
  *                                             *
  *      Portable Pascal compiler               *
  *      ************************               *
  *                                             *
  *             Pascal P4                       *
  *                                             *
  *     Authors:                                *
  *           Urs Ammann                        *
  *           Kesav Nori                        *
  *           Christian Jacobi                  *
  *     Address:                                *
  *       Institut Fuer Informatik              *
  *       Eidg. Technische Hochschule           *
  *       CH-8096 Zuerich                       *
  *                                             *
  *  This code is fully documented in the book  *
  *        "Pascal Implementation"              *
  *   by Steven Pemberton and Martin Daniels    *
  * published by Ellis Horwood, Chichester, UK  *
  *         ISBN: 0-13-653-0311                 *
  *       (also available in Japanese)          *
  *                                             *
  * Steven Pemberton, CWI/AA,                   *
  * Kruislaan 413, 1098 SJ Amsterdam, NL        *
  * Steven.Pemberton@cwi.nl                     *
  *                                             *
  ***********************************************)

 (***********************************************
  *                                             *
  * Adaption comments                           *
  *                                             *
  * Scott A. Moore samiam@moorecad.com          *
  *                                             *
  * The purpose of my changes is to upgrade the *
  * code to ISO 7185, and to make the           *
  * non-portable features more generic (see     *
  * below).                                     *
  *                                             *
  * Note: you will find my comments with ISO    *
  * 7185 brackets. See my mark [sam].           *
  *                                             *
  * - I detabbed it, at 8th tabs. Not everyone  *
  * uses the same tab stops. Use spaces please. *
  *                                             *
  * - In procedure "printtables", the author    *
  *   uses "ord" to convert pointers to         *
  *   so they can be printed as part of tables. *
  *   "ord" used this way is nonstandard, but   *
  *   any such printout of pointers is bound to *
  *   be. Converted it to tagless record        *
  *   convertion, which is going to work on     *
  *   more processors than the "ord" trick      *
  *   (including mine).                         *
  *                                             *
  * - Increased the size of strglgth from 16    *
  *   to 100. This limits the size of string    *
  *   constants that can be accepted, and 16    *
  *   is just not practical.                    *
  *                                             *
  * - Eliminated the specific set of maxint.    *
  *   this means that maxint gets native        *
  *   sizing.                                   *
  *                                             *
  * - Changed the source input to "source"      *
  *                                             *
  * - Changed the size of set to 0..255.        *
  *                                             *
  * - Added ISO 7185 required header file       *
  *   declarations.                             *
  *                                             *
  * - Added "disxl" local "for" index to        *
  *   searchid, as ISO 7185 requires.           *
  *                                             *
  * - In printtables, P4 was using "ord" to     *
  *   convert pointers to integers and vice     *
  *   versa. While this is a dirty trick on any *
  *   Pascal, I converted it to untagged        *
  *   variant records, which works on most      *
  *   Pascal compilers.                         *
  *                                             *
  * - In body, cstoccmax was increased so we    *
  *   could compile bigger test programs.       *
  *                                             *
  * - In assemble, removed unused variables.    *
  *   This is not required, but nice for        *
  *   compilers that check this.                *
  *                                             *
  * - Increased the number of digits in gen2t.  *
  *                                             *
  * Other notes:                                *
  *                                             *
  * The control statement at the top of the     *
  * program should probably be removed for use  *
  * on a third party compiler. The p4 system    *
  * itself uses them, so they are useful when   *
  * self compiling, but your compiler may have  *
  * conflicting definitions.                    *
  *                                             *
  * On my compiler, the "prr" output file is    *
  * a command line parameter. You may have to   *
  * make other arrangements.                    *
  *                                             *
  * Under Unix and DOS/Windows, using IP        *
  * Pascal,the command line is:                 *
  *                                             *
  * pcom program.pas program.p4                 *
  *                                             *
  * Where "program" is the name of the program, *
  * program.pas is the Pascal source, and       *
  * program.p4 is the portable intermediate.    *
  *                                             *
  **********************************************)

program pascalcompiler(input,output,prr);

const displimit = 20; maxlevel = 10;
   intsize     =      1;
   intal       =      1;
   realsize    =      1;
   realal      =      1;
   charsize    =      1;
   charal      =      1;
   charmax     =      1;
   boolsize    =      1;
   boolal      =      1;
   ptrsize     =      1;
   adral       =      1;
   setsize     =      1;
   setal       =      1;
   stackal     =      1;
   stackelsize =      1;
   strglgth    = 100(*16*); (* This was not a very practical limit [sam] *)
   sethigh     =     255(*47*); (* changed to byte from the old CDC limit [sam] *)
   setlow      =      0;
   ordmaxchar  =     255(*63*); (* standard 8 bit ASCII limits [sam] *)
   ordminchar  =      0;
   maxint      =  2147483647(*32767*); (* Use 32 bit limit [sam] *)
   lcaftermarkstack = 5;
   fileal      = charal;
   (* stackelsize = minimum size for 1 stackelement
                  = k*stackal
      stackal     = scm(all other al-constants)
      charmax     = scm(charsize,charal)
                    scm = smallest common multiple
      lcaftermarkstack >= 4*ptrsize+max(x-size)
                        = k1*stackelsize          *)
   maxstack   =       1;
   parmal     = stackal;
   parmsize   = stackelsize;
   recal      = stackal;
   filebuffer =       4;
   maxaddr    =  maxint;



type                                                        (*describing:*)
                                                            (*************)

     marktype= ^integer;
                                                            (*basic symbols*)
                                                            (***************)

     symbol = (ident,intconst,realconst,stringconst,notsy,mulop,addop,relop,
               lparent,rparent,lbrack,rbrack,comma,semicolon,period,arrow,
               colon,becomes,labelsy,constsy,typesy,varsy,funcsy,progsy,
               procsy,setsy,packedsy,arraysy,recordsy,filesy,forwardsy,
               beginsy,ifsy,casesy,repeatsy,whilesy,forsy,withsy,
               gotosy,endsy,elsesy,untilsy,ofsy,dosy,tosy,downtosy,
               thensy,othersy);
     operator = (mul,rdiv,andop,idiv,imod,plus,minus,orop,ltop,leop,geop,gtop,
                 neop,eqop,inop,noop);
     setofsys = set of symbol;
     chtp = (letter,number,special,illegal,
             chstrquo,chcolon,chperiod,chlt,chgt,chlparen,chspace);

                                                            (*constants*)
                                                            (***********)
     setty = set of setlow..sethigh;
     cstclass = (reel,pset,strg);
     csp = ^ constant;
     constant = record case cclass: cstclass of
                         reel: (rval: packed array [1..strglgth] of char);
                         pset: (pval: setty);
                         strg: (slgth: 0..strglgth;
                                sval: packed array [1..strglgth] of char)
                       end;

     valu = record case {intval:} boolean of  (*intval never set nor tested*)
                     true:  (ival: integer);
                     false: (valp: csp)
                   end;

                                                           (*data structures*)
                                                           (*****************)
     levrange = 0..maxlevel; addrrange = 0..maxaddr;
     structform = (scalar,subrange,pointer,power,arrays,records,files,
                   tagfld,variant);
     declkind = (standard,declared);
     stp = ^ structure; ctp = ^ identifier;

     structure = { packed } record
                   marked: boolean;   (*for test phase only*)
                   size: addrrange;
                   case form: structform of
                     scalar:   (case scalkind: declkind of
                                  declared: (fconst: ctp); standard: ());
                     subrange: (rangetype: stp; min,max: valu);
                     pointer:  (eltype: stp);
                     power:    (elset: stp);
                     arrays:   (aeltype,inxtype: stp);
                     records:  (fstfld: ctp; recvar: stp);
                     files:    (filtype: stp);
                     tagfld:   (tagfieldp: ctp; fstvar: stp);
                     variant:  (nxtvar,subvar: stp; varval: valu)
                   end;

                                                            (*names*)
                                                            (*******)

     idclass = (types,konst,vars,field,proc,func);
     setofids = set of idclass;
     idkind = (actual,formal);
     alpha = packed array [1..8] of char;

     identifier = { packed } record
                   name: alpha; llink, rlink: ctp;
                   idtype: stp; next: ctp;
                   case klass: idclass of
                     types: ();
                     konst: (values: valu);
                     vars:  (vkind: idkind; vlev: levrange; vaddr: addrrange);
                     field: (fldaddr: addrrange);
                     proc, func:  (case pfdeckind: declkind of
                              standard: (key: 1..15);
                              declared: (pflev: levrange; pfname: integer;
                                          case pfkind: idkind of
                                           actual: (forwdecl, externl: boolean);
                                           formal: ()))
                   end;


     disprange = 0..displimit;
     where = (blck,crec,vrec,rec);

                                                            (*expressions*)
                                                            (*************)
     attrkind = (cst,varbl,expr);
     vaccess = (drct,indrct,inxd);

     attr = record typtr: stp;
              case kind: attrkind of
                cst:   (cval: valu);
                varbl: (case access: vaccess of
                          drct: (vlevel: levrange; dplmt: addrrange);
                          indrct: (idplmt: addrrange);
           inxd: ());
      expr: ()
              end;

     testp = ^ testpointer;
     testpointer = packed record
                     elt1,elt2 : stp;
                     lasttestp : testp
                   end;

                                                                 (*labels*)
                                                                 (********)
     lbp = ^ labl;
     labl = record nextlab: lbp; defined: boolean;
                   labval, labname: integer
            end;

     extfilep = ^filerec;
     filerec = record filename:alpha; nextfile:extfilep end;

(*-------------------------------------------------------------------------*)

var
     {prr: text;}
                                    (*returned by source program scanner
                                     insymbol:
                                     **********)

    sy: symbol;                     (*last symbol*)
    op: operator;                   (*classification of last symbol*)
    val: valu;                      (*value of last constant*)
    lgth: integer;                  (*length of last string constant*)
    id: alpha;                      (*last identifier (possibly truncated)*)
    kk: 1..8;                       (*nr of chars in last identifier*)
    ch: char;                       (*last character*)
    eol: boolean;                   (*end of line flag*)


                                    (*counters:*)
                                    (***********)

    chcnt: integer;                 (*character counter*)
    lc,ic: addrrange;               (*data location and instruction counter*)
    linecount: integer;


                                    (*switches:*)
                                    (***********)

    dp,                             (*declaration part*)
    prterr,                         (*to allow forward references in pointer type
                                      declaration by suppressing error message*)
    list,prcode,prtables: boolean;  (*output options for
                                        -- source program listing
                                        -- printing symbolic code
                                        -- displaying ident and struct tables
                                        --> procedure option*)
    debug: boolean;


                                    (*pointers:*)
                                    (***********)
    parmptr,
    intptr,realptr,charptr,
    boolptr,nilptr,textptr: stp;    (*pointers to entries of standard ids*)
    utypptr,ucstptr,uvarptr,
    ufldptr,uprcptr,ufctptr,        (*pointers to entries for undeclared ids*)
    fwptr: ctp;                     (*head of chain of forw decl type ids*)
    fextfilep: extfilep;            (*head of chain of external files*)
    globtestp: testp;               (*last testpointer*)


                                    (*bookkeeping of declaration levels:*)
                                    (************************************)

    level: levrange;                (*current static level*)
    disx,                           (*level of last id searched by searchid*)
    top: disprange;                 (*top of display*)

    display:                        (*where:   means:*)
      array [disprange] of
        packed record               (*=blck:   id is variable id*)
          fname: ctp; flabel: lbp;  (*=crec:   id is field id in record with*)
          case occur: where of      (*   constant address*)
            crec: (clev: levrange;  (*=vrec:   id is field id in record with*)
                  cdspl: addrrange);(*   variable address*)
            vrec: (vdspl: addrrange);
       blck: ();
       rec: ()
          end;                      (* --> procedure withstatement*)


                                    (*error messages:*)
                                    (*****************)

    errinx: 0..10;                  (*nr of errors in current source line*)
    errlist:
      array [1..10] of
        packed record pos: integer;
                      nmr: 1..400
               end;



                                    (*expression compilation:*)
                                    (*************************)

    gattr: attr;                    (*describes the expr currently compiled*)


                                    (*structured constants:*)
                                    (***********************)

    constbegsys,simptypebegsys,typebegsys,blockbegsys,selectsys,facbegsys,
    statbegsys,typedels: setofsys;
    chartp : array[char] of chtp;
    rw:  array [1..35(*nr. of res. words*)] of alpha;
    frw: array [1..9] of 1..36(*nr. of res. words + 1*);
    rsy: array [1..35(*nr. of res. words*)] of symbol;
    ssy: array [char] of symbol;
    rop: array [1..35(*nr. of res. words*)] of operator;
    sop: array [char] of operator;
    na:  array [1..35] of alpha;
    mn:  array [0..60] of packed array [1..4] of char;
    sna: array [1..23] of packed array [1..4] of char;
    cdx: array [0..60] of -4..+4;
    pdx: array [1..23] of -7..+7;
    ordint: array [char] of integer;

    intlabel,mxint10,digmax: integer;
(*-------------------------------------------------------------------------*)
  procedure mark(var p: marktype); begin new(p) (* shut up *) end;
  procedure release(p: marktype); begin dispose(p) (* shut up *) end;

  procedure endofline;
    var lastpos,freepos,currpos,currnmr,f,k: integer;
  begin
    if errinx > 0 then   (*output error messages*)
      begin write(output,linecount:6,' ****  ':9);
        lastpos := 0; freepos := 1;
        for k := 1 to errinx do
          begin
            with errlist[k] do
              begin currpos := pos; currnmr := nmr end;
            if currpos = lastpos then write(output,',')
            else
              begin
                while freepos < currpos do
                  begin write(output,' '); freepos := freepos + 1 end;
                write(output,'^');
                lastpos := currpos
              end;
            if currnmr < 10 then f := 1
            else if currnmr < 100 then f := 2
              else f := 3;
            write(output,currnmr:f);
            freepos := freepos + f + 1
          end;
        writeln(output); errinx := 0
      end;
    linecount := linecount + 1;
    if list and (not eof(input)) then
      begin write(output,linecount:6,'  ':2);
        if dp then write(output,lc:7) else write(output,ic:7);
        write(output,' ')
      end;
    chcnt := 0
  end  (*endofline*) ;

  procedure error(ferrnr: integer);
  begin
    if errinx >= 9 then
      begin errlist[10].nmr := 255; errinx := 10 end
    else
      begin errinx := errinx + 1;
        errlist[errinx].nmr := ferrnr
      end;
    errlist[errinx].pos := chcnt
  end (*error*) ;

  procedure insymbol;
    (*read next basic symbol of source program and return its
    description in the global variables sy, op, id, val and lgth*)
    label 1,2(*,3*);
    var i,k: integer;
        digit: packed array [1..strglgth] of char;
        string: packed array [1..strglgth] of char;
        lvp: csp; test: boolean;

    procedure nextch;
    begin if eol then
      begin if list then writeln(output); endofline
      end;
      if not eof(input) then
       begin eol := eoln(input); read(input,ch);
        if list then write(output,ch);
        chcnt := chcnt + 1
       end
      else
        begin writeln(output,'   *** eof ','encountered');
          test := false
        end
    end;

    procedure options;
    begin
      repeat nextch;
        if ch <> '*' then
          begin
            if ch = 't' then
              begin nextch; prtables := ch = '+' end
            else
              if ch = 'l' then
                begin nextch; list := ch = '+';
                  if not list then writeln(output)
                end
              else
             if ch = 'd' then
               begin nextch; debug := ch = '+' end
             else
                if ch = 'c' then
                  begin nextch; prcode := ch = '+' end;
            nextch
          end
      until ch <> ','
    end (*options*) ;

  begin (*insymbol*)
  1:
    repeat while (ch = ' ') and not eol do nextch;
      test := eol;
      if test then nextch
    until not test;
    if chartp[ch] = illegal then
      begin sy := othersy; op := noop;
        error(399); nextch
      end
    else
    case chartp[ch] of
      letter:
        begin k := 0;
          repeat
            if k < 8 then
             begin k := k + 1; id[k] := ch end ;
            nextch
          until chartp[ch] in [special,illegal,chstrquo,chcolon,
                                chperiod,chlt,chgt,chlparen,chspace];
          if k >= kk then kk := k
          else
            repeat id[kk] := ' '; kk := kk - 1
            until kk = k;
          for i := frw[k] to frw[k+1] - 1 do
            if rw[i] = id then
              begin sy := rsy[i]; op := rop[i]; goto 2 end;
            sy := ident; op := noop;
  2:    end;
      number:
        begin op := noop; i := 0;
          repeat i := i+1; if i<= digmax then digit[i] := ch; nextch
          until chartp[ch] <> number;
          if ((ch = '.') and (input^ <> '.')) or (ch = 'e') then
            begin
                  k := i;
                  if ch = '.' then
                    begin k := k+1; if k <= digmax then digit[k] := ch;
                      nextch; (*if ch = '.' then begin ch := ':'; goto 3 end;*)
                      if chartp[ch] <> number then error(201)
                      else
                        repeat k := k + 1;
                          if k <= digmax then digit[k] := ch; nextch
                        until chartp[ch] <>  number
                    end;
                  if ch = 'e' then
                    begin k := k+1; if k <= digmax then digit[k] := ch;
                      nextch;
                      if (ch = '+') or (ch ='-') then
                        begin k := k+1; if k <= digmax then digit[k] := ch;
                          nextch
                        end;
                      if chartp[ch] <> number then error(201)
                      else
                        repeat k := k+1;
                          if k <= digmax then digit[k] := ch; nextch
                        until chartp[ch] <> number
                     end;
                   new(lvp,reel); sy:= realconst; lvp^.cclass := reel;
                   with lvp^ do
                     begin for i := 1 to strglgth do rval[i] := ' ';
                       if k <= digmax then
                         for i := 2 to k + 1 do rval[i] := digit[i-1]
                       else begin error(203); rval[2] := '0';
                              rval[3] := '.'; rval[4] := '0'
                            end
                     end;
                   val.valp := lvp
            end
          else
  (* 3: *)        begin
              if i > digmax then begin error(203); val.ival := 0 end
              else
                with val do
                  begin ival := 0;
                    for k := 1 to i do
                      begin
                        if ival <= mxint10 then
                          ival := ival*10+ordint[digit[k]]
                        else begin error(203); ival := 0 end
                      end;
                    sy := intconst
                  end
            end
        end;
      chstrquo:
        begin lgth := 0; sy := stringconst;  op := noop;
          repeat
            repeat nextch; lgth := lgth + 1;
                   if lgth <= strglgth then string[lgth] := ch
            until (eol) or (ch = '''');
            if eol then error(202) else nextch
          until ch <> '''';
          lgth := lgth - 1;   (*now lgth = nr of chars in string*)
          if lgth = 0 then error(205) else
          if lgth = 1 then val.ival := ord(string[1])
          else
            begin new(lvp,strg); lvp^.cclass:=strg;
              if lgth > strglgth then
                begin error(399); lgth := strglgth end;
              with lvp^ do
                begin slgth := lgth;
                  for i := 1 to lgth do sval[i] := string[i]
                end;
              val.valp := lvp
            end
        end;
      chcolon:
        begin op := noop; nextch;
          if ch = '=' then
            begin sy := becomes; nextch end
          else sy := colon
        end;
      chperiod:
        begin op := noop; nextch;
          if ch = '.' then
            begin sy := colon; nextch end
          else sy := period
        end;
      chlt:
        begin nextch; sy := relop;
          if ch = '=' then
            begin op := leop; nextch end
          else
            if ch = '>' then
              begin op := neop; nextch end
            else op := ltop
        end;
      chgt:
        begin nextch; sy := relop;
          if ch = '=' then
            begin op := geop; nextch end
          else op := gtop
        end;
      chlparen:
       begin nextch;
         if ch = '*' then
           begin nextch;
             if ch = '$' then options;
             repeat
               while (ch <> '*') and not eof(input) do nextch;
               nextch
             until (ch = ')') or eof(input);
             nextch; goto 1
           end;
         sy := lparent; op := noop
       end;
      special:
        begin sy := ssy[ch]; op := sop[ch];
          nextch
        end;
      chspace: sy := othersy
    end (*case*)
  end (*insymbol*) ;

  procedure enterid(fcp: ctp);
    (*enter id pointed at by fcp into the name-table,
     which on each declaration level is organised as
     an unbalanced binary tree*)
    var nam: alpha; lcp, lcp1: ctp; lleft: boolean;
  begin nam := fcp^.name;
    lcp := display[top].fname;
    if lcp = nil then
      display[top].fname := fcp
    else
      begin
        repeat lcp1 := lcp;
          if lcp^.name = nam then   (*name conflict, follow right link*)
            begin error(101); lcp := lcp^.rlink; lleft := false end
          else
            if lcp^.name < nam then
              begin lcp := lcp^.rlink; lleft := false end
            else begin lcp := lcp^.llink; lleft := true end
        until lcp = nil;
        if lleft then lcp1^.llink := fcp else lcp1^.rlink := fcp
      end;
    fcp^.llink := nil; fcp^.rlink := nil
  end (*enterid*) ;

  procedure searchsection(fcp: ctp; var fcp1: ctp);
    (*to find record fields and forward declared procedure id's
     --> procedure proceduredeclaration
     --> procedure selector*)
     label 1;
  begin
    while fcp <> nil do
      if fcp^.name = id then goto 1
      else if fcp^.name < id then fcp := fcp^.rlink
        else fcp := fcp^.llink;
1:  fcp1 := fcp
  end (*searchsection*) ;

  (* Added to search id, disxl is now used for a local "for" index,
    which matches ISO 7185. Also, depending on the index keeping
    its contents after the containing statement is a violation,
    so the behavior of setting disx to last search id was
    emulated [sam] *)
  procedure searchid(fidcls: setofids; var fcp: ctp);
    label 1;
    var lcp: ctp;
        disxl: disprange;
  begin
    for disxl := top downto 0 do
      begin lcp := display[disxl].fname;
        while lcp <> nil do
          if lcp^.name = id then
            if lcp^.klass in fidcls then begin disx := disxl; goto 1 end
            else
              begin if prterr then error(103);
                lcp := lcp^.rlink
              end
          else
            if lcp^.name < id then
              lcp := lcp^.rlink
            else lcp := lcp^.llink
      end;
      disx := 0;
    (*search not successful; suppress error message in case
     of forward referenced type id in pointer type definition
     --> procedure simpletype*)
    if prterr then
      begin error(104);
        (*to avoid returning nil, reference an entry
         for an undeclared id of appropriate class
         --> procedure enterundecl*)
        if types in fidcls then lcp := utypptr
        else
          if vars in fidcls then lcp := uvarptr
          else
            if field in fidcls then lcp := ufldptr
            else
              if konst in fidcls then lcp := ucstptr
              else
                if proc in fidcls then lcp := uprcptr
                else lcp := ufctptr;
      end;
1:  fcp := lcp
  end (*searchid*) ;

  procedure getbounds(fsp: stp; var fmin,fmax: integer);
    (*get internal bounds of subrange or scalar type*)
    (*assume fsp<>intptr and fsp<>realptr*)
  begin
    fmin := 0; fmax := 0;
    if fsp <> nil then
    with fsp^ do
      if form = subrange then
        begin fmin := min.ival; fmax := max.ival end
      else
          if fsp = charptr then
            begin fmin := ordminchar; fmax := ordmaxchar
            end
          else
            if fconst <> nil then
              fmax := fconst^.values.ival
  end (*getbounds*) ;

  function alignquot(fsp: stp): integer;
  begin
    alignquot := 1;
    if fsp <> nil then
      with fsp^ do
        case form of
          scalar:   if fsp=intptr then alignquot := intal
                    else if fsp=boolptr then alignquot := boolal
                    else if scalkind=declared then alignquot := intal
                    else if fsp=charptr then alignquot := charal
                    else if fsp=realptr then alignquot := realal
                    else (*parmptr*) alignquot := parmal;
          subrange: alignquot := alignquot(rangetype);
          pointer:  alignquot := adral;
          power:    alignquot := setal;
          files:    alignquot := fileal;
          arrays:   alignquot := alignquot(aeltype);
          records:  alignquot := recal;
          variant,tagfld: error(501)
        end
  end (*alignquot*);

  procedure align(fsp: stp; var flc: addrrange);
    var k,l: integer;
  begin
    k := alignquot(fsp);
    l := flc-1;
    flc := l + k  -  (k+l) mod k
  end (*align*);

  procedure printtables(fb: boolean);
    (*print data structure and name table*)
    (* Added these functions to convert pointers to integers.
      Works on any machine where pointers and integers are the same format.
      The original code was for a processor where "ord" would do this, a
      very nonstandard feature [sam] *)
    const intsize = 11; (* size of printed integer *)

    var i, lim: disprange;

    function stptoint(p: stp): integer;
    var r: record case boolean of false: (p: stp); true: (i: integer) end;
    begin r.p := p; stptoint := r.i end;

    function ctptoint(p: ctp): integer;
    var r: record case boolean of false: (p: ctp); true: (i: integer) end;
    begin r.p := p; ctptoint := r.i end;

    procedure marker;
      (*mark data structure entries to avoid multiple printout*)
      var i: integer;

      procedure markctp(fp: ctp); forward;

      procedure markstp(fp: stp);
        (*mark data structures, prevent cycles*)
      begin
        if fp <> nil then
          with fp^ do
            begin marked := true;
              case form of
              scalar:   ;
              subrange: markstp(rangetype);
              pointer:  (*don't mark eltype: cycle possible; will be marked
                        anyway, if fp = true*) ;
              power:    markstp(elset) ;
              arrays:   begin markstp(aeltype); markstp(inxtype) end;
              records:  begin markctp(fstfld); markstp(recvar) end;
              files:    markstp(filtype);
              tagfld:   markstp(fstvar);
              variant:  begin markstp(nxtvar); markstp(subvar) end
              end (*case*)
            end (*with*)
      end (*markstp*);

      procedure markctp;
      begin
        if fp <> nil then
          with fp^ do
            begin markctp(llink); markctp(rlink);
              markstp(idtype)
            end
      end (*markctp*);

    begin (*marker*)
      for i := top downto lim do
        markctp(display[i].fname)
    end (*marker*);

    procedure followctp(fp: ctp); forward;

    procedure followstp(fp: stp);
    begin
      if fp <> nil then
        with fp^ do
          if marked then
            begin marked := false; write(output,' ':4,stptoint(*ord*)(fp):intsize(*6*),size:10);
              case form of
              scalar:   begin write(output,'scalar':10);
                          if scalkind = standard then
                            write(output,'standard':10)
                          else write(output,'declared':10,' ':4,ctptoint(*ord*)(fconst):intsize(*6*));
                          writeln(output)
                        end;
              subrange: begin
                          write(output,'subrange':10,' ':4,stptoint(*ord*)(rangetype):6);
                          if rangetype <> realptr then
                            write(output,min.ival,max.ival)
                          else
                            if (min.valp <> nil) and (max.valp <> nil) then
                              write(output,' ',min.valp^.rval:9,
                                    ' ',max.valp^.rval:9);
                          writeln(output); followstp(rangetype);
                        end;
              pointer:  writeln(output,'pointer':10,' ':4,stptoint(*ord*)(eltype):intsize(*6*));
              power:    begin writeln(output,'set':10,' ':4,stptoint(*ord*)(elset):intsize(*6*));
                          followstp(elset)
                        end;
              arrays:   begin
                          writeln(output,'array':10,' ':4,stptoint(*ord*)(aeltype):intsize(*6*),' ':4,
                            stptoint(*ord*)(inxtype):6);
                          followstp(aeltype); followstp(inxtype)
                        end;
              records:  begin
                          writeln(output,'record':10,' ':4,ctptoint(*ord*)(fstfld):intsize(*6*),' ':4,
                            stptoint(*ord*)(recvar):intsize(*6*)); followctp(fstfld);
                          followstp(recvar)
                        end;
              files:    begin write(output,'file':10,' ':4,stptoint(*ord*)(filtype):intsize(*6*));
                          followstp(filtype)
                        end;
              tagfld:   begin writeln(output,'tagfld':10,' ':4,ctptoint(*ord*)(tagfieldp):intsize(*6*),
                            ' ':4,stptoint(*ord*)(fstvar):intsize(*6*));
                          followstp(fstvar)
                        end;
              variant:  begin writeln(output,'variant':10,' ':4,stptoint(*ord*)(nxtvar):intsize(*6*),
                            ' ':4,stptoint(*ord*)(subvar):intsize(*6*),varval.ival);
                          followstp(nxtvar); followstp(subvar)
                        end
              end (*case*)
            end (*if marked*)
    end (*followstp*);

    procedure followctp;
      var i: integer;
    begin
      if fp <> nil then
        with fp^ do
          begin write(output,' ':4,ctptoint(*ord*)(fp):intsize(*6*),' ',name:9,' ':4,ctptoint(*ord*)(llink):intsize(*6*),
            ' ':4,ctptoint(*ord*)(rlink):intsize(*6*),' ':4,stptoint(*ord*)(idtype):intsize(*6*));
            case klass of
              types: write(output,'type':10);
              konst: begin write(output,'constant':10,' ':4,ctptoint(*ord*)(next):intsize(*6*));
                       if idtype <> nil then
                         if idtype = realptr then
                           begin
                             if values.valp <> nil then
                               write(output,' ',values.valp^.rval:9)
                           end
                         else
                           if idtype^.form = arrays then  (*stringconst*)
                             begin
                               if values.valp <> nil then
                                 begin write(output,' ');
                                   with values.valp^ do
                                     for i := 1 to slgth do
                                       write(output,sval[i])
                                 end
                             end
                           else write(output,values.ival)
                     end;
              vars:  begin write(output,'variable':10);
                       if vkind = actual then write(output,'actual':10)
                       else write(output,'formal':10);
                       write(output,' ':4,ctptoint(*ord*)(next):intsize(*6*),vlev,' ':4,vaddr:6 );
                     end;
              field: write(output,'field':10,' ':4,ctptoint(*ord*)(next):intsize(*6*),' ':4,fldaddr:6);
              proc,
              func:  begin
                       if klass = proc then write(output,'procedure':10)
                       else write(output,'function':10);
                       if pfdeckind = standard then
                         write(output,'standard':10, key:10)
                       else
                         begin write(output,'declared':10,' ':4,ctptoint(*ord*)(next):intsize(*6*));
                           write(output,pflev,' ':4,pfname:6);
                           if pfkind = actual then
                             begin write(output,'actual':10);
                               if forwdecl then write(output,'forward':10)
                               else write(output,'notforward':10);
                               if externl then write(output,'extern':10)
                               else write(output,'not extern':10);
                             end
                           else write(output,'formal':10)
                         end
                     end
            end (*case*);
            writeln(output);
            followctp(llink); followctp(rlink);
            followstp(idtype)
          end (*with*)
    end (*followctp*);

  begin (*printtables*)
    writeln(output); writeln(output); writeln(output);
    if fb then lim := 0
    else begin lim := top; write(output,' local') end;
    writeln(output,' tables '); writeln(output);
    marker;
    for i := top downto lim do
      followctp(display[i].fname);
    writeln(output);
    if not eol then write(output,' ':chcnt+16)
  end (*printtables*);

  procedure genlabel(var nxtlab: integer);
  begin intlabel := intlabel + 1;
    nxtlab := intlabel
  end (*genlabel*);

  procedure block(fsys: setofsys; fsy: symbol; fprocp: ctp);
    var lsy: symbol; test: boolean;

    procedure skip(fsys: setofsys);
      (*skip input string until relevant symbol found*)
    begin
      if not eof(input) then
        begin while not(sy in fsys) and (not eof(input)) do insymbol;
          if not (sy in fsys) then insymbol
        end
    end (*skip*) ;

    procedure constant(fsys: setofsys; var fsp: stp; var fvalu: valu);
      var lsp: stp; lcp: ctp; sign: (none,pos,neg);
          lvp: csp; i: 2..strglgth;
    begin lsp := nil; fvalu.ival := 0;
      if not(sy in constbegsys) then
        begin error(50); skip(fsys+constbegsys) end;
      if sy in constbegsys then
        begin
          if sy = stringconst then
            begin
              if lgth = 1 then lsp := charptr
              else
                begin
                  new(lsp,arrays);
                  with lsp^ do
                    begin aeltype := charptr; inxtype := nil;
                       size := lgth*charsize; form := arrays
                    end
                end;
              fvalu := val; insymbol
            end
          else
            begin
              sign := none;
              if (sy = addop) and (op in [plus,minus]) then
                begin if op = plus then sign := pos else sign := neg;
                  insymbol
                end;
              if sy = ident then
                begin searchid([konst],lcp);
                  with lcp^ do
                    begin lsp := idtype; fvalu := values end;
                  if sign <> none then
                    if lsp = intptr then
                      begin if sign = neg then fvalu.ival := -fvalu.ival end
                    else
                      if lsp = realptr then
                        begin
                          if sign = neg then
                            begin new(lvp,reel);
                              if fvalu.valp^.rval[1] = '-' then
                                lvp^.rval[1] := '+'
                              else lvp^.rval[1] := '-';
                              for i := 2 to strglgth do
                                lvp^.rval[i] := fvalu.valp^.rval[i];
                              fvalu.valp := lvp;
                            end
                          end
                        else error(105);
                  insymbol;
                end
              else
                if sy = intconst then
                  begin if sign = neg then val.ival := -val.ival;
                    lsp := intptr; fvalu := val; insymbol
                  end
                else
                  if sy = realconst then
                    begin if sign = neg then val.valp^.rval[1] := '-';
                      lsp := realptr; fvalu := val; insymbol
                    end
                  else
                    begin error(106); skip(fsys) end
            end;
          if not (sy in fsys) then
            begin error(6); skip(fsys) end
          end;
      fsp := lsp
    end (*constant*) ;

    function equalbounds(fsp1,fsp2: stp): boolean;
      var lmin1,lmin2,lmax1,lmax2: integer;
    begin
      if (fsp1=nil) or (fsp2=nil) then equalbounds := true
      else
        begin
          getbounds(fsp1,lmin1,lmax1);
          getbounds(fsp2,lmin2,lmax2);
          equalbounds := (lmin1=lmin2) and (lmax1=lmax2)
        end
    end (*equalbounds*) ;

    function comptypes(fsp1,fsp2: stp) : boolean;
      (*decide whether structures pointed at by fsp1 and fsp2 are compatible*)
      var nxt1,nxt2: ctp; comp: boolean;
        ltestp1,ltestp2 : testp;
    begin
      if fsp1 = fsp2 then comptypes := true
      else
        if (fsp1 <> nil) and (fsp2 <> nil) then
          if fsp1^.form = fsp2^.form then
            case fsp1^.form of
              scalar:
                comptypes := false;
                (* identical scalars declared on different levels are
                 not recognized to be compatible*)
              subrange:
                comptypes := comptypes(fsp1^.rangetype,fsp2^.rangetype);
              pointer:
                  begin
                    comp := false; ltestp1 := globtestp;
                    ltestp2 := globtestp;
                    while ltestp1 <> nil do
                      with ltestp1^ do
                        begin
                          if (elt1 = fsp1^.eltype) and
                             (elt2 = fsp2^.eltype) then comp := true;
                          ltestp1 := lasttestp
                        end;
                    if not comp then
                      begin new(ltestp1);
                        with ltestp1^ do
                          begin elt1 := fsp1^.eltype;
                            elt2 := fsp2^.eltype;
                            lasttestp := globtestp
                          end;
                        globtestp := ltestp1;
                        comp := comptypes(fsp1^.eltype,fsp2^.eltype)
                      end;
                    comptypes := comp; globtestp := ltestp2
                  end;
              power:
                comptypes := comptypes(fsp1^.elset,fsp2^.elset);
              arrays:
                begin
                  comp := comptypes(fsp1^.aeltype,fsp2^.aeltype)
                      and comptypes(fsp1^.inxtype,fsp2^.inxtype);
                  comptypes := comp and (fsp1^.size = fsp2^.size) and
                      equalbounds(fsp1^.inxtype,fsp2^.inxtype)
                end;
              records:
                begin nxt1 := fsp1^.fstfld; nxt2 := fsp2^.fstfld; comp:=true;
                  while (nxt1 <> nil) and (nxt2 <> nil) do
                    begin comp:=comp and comptypes(nxt1^.idtype,nxt2^.idtype);
                      nxt1 := nxt1^.next; nxt2 := nxt2^.next
                    end;
                  comptypes := comp and (nxt1 = nil) and (nxt2 = nil)
                              and(fsp1^.recvar = nil)and(fsp2^.recvar = nil)
                end;
                (*identical records are recognized to be compatible
                 iff no variants occur*)
              files:
                comptypes := comptypes(fsp1^.filtype,fsp2^.filtype)
            end (*case*)
          else (*fsp1^.form <> fsp2^.form*)
            if fsp1^.form = subrange then
              comptypes := comptypes(fsp1^.rangetype,fsp2)
            else
              if fsp2^.form = subrange then
                comptypes := comptypes(fsp1,fsp2^.rangetype)
              else comptypes := false
        else comptypes := true
    end (*comptypes*) ;

    function string(fsp: stp) : boolean;
    begin string := false;
      if fsp <> nil then
        if fsp^.form = arrays then
          if comptypes(fsp^.aeltype,charptr) then string := true
    end (*string*) ;

    procedure typ(fsys: setofsys; var fsp: stp; var fsize: addrrange);
      var lsp,lsp1,lsp2: stp; oldtop: disprange; lcp: ctp;
          lsize,displ: addrrange; lmin,lmax: integer;

      procedure simpletype(fsys:setofsys; var fsp:stp; var fsize:addrrange);
        var lsp,lsp1: stp; lcp,lcp1: ctp; ttop: disprange;
            lcnt: integer; lvalu: valu;
      begin fsize := 1;
        if not (sy in simptypebegsys) then
          begin error(1); skip(fsys + simptypebegsys) end;
        if sy in simptypebegsys then
          begin
            if sy = lparent then
              begin ttop := top;   (*decl. consts local to innermost block*)
                while display[top].occur <> blck do top := top - 1;
                new(lsp,scalar,declared);
                with lsp^ do
                  begin size := intsize; form := scalar;
                    scalkind := declared
                  end;
                lcp1 := nil; lcnt := 0;
                repeat insymbol;
                  if sy = ident then
                    begin new(lcp,konst);
                      with lcp^ do
                        begin name := id; idtype := lsp; next := lcp1;
                          values.ival := lcnt; klass := konst
                        end;
                      enterid(lcp);
                      lcnt := lcnt + 1;
                      lcp1 := lcp; insymbol
                    end
                  else error(2);
                  if not (sy in fsys + [comma,rparent]) then
                    begin error(6); skip(fsys + [comma,rparent]) end
                until sy <> comma;
                lsp^.fconst := lcp1; top := ttop;
                if sy = rparent then insymbol else error(4)
              end
            else
              begin
                if sy = ident then
                  begin searchid([types,konst],lcp);
                    insymbol;
                    if lcp^.klass = konst then
                      begin new(lsp,subrange);
                        with lsp^, lcp^ do
                          begin rangetype := idtype; form := subrange;
                            if string(rangetype) then
                              begin error(148); rangetype := nil end;
                            min := values; size := intsize
                          end;
                        if sy = colon then insymbol else error(5);
                        constant(fsys,lsp1,lvalu);
                        lsp^.max := lvalu;
                        if lsp^.rangetype <> lsp1 then error(107)
                      end
                    else
                      begin lsp := lcp^.idtype;
                        if lsp <> nil then fsize := lsp^.size
                      end
                  end (*sy = ident*)
                else
                  begin new(lsp,subrange); lsp^.form := subrange;
                    constant(fsys + [colon],lsp1,lvalu);
                    if string(lsp1) then
                      begin error(148); lsp1 := nil end;
                    with lsp^ do
                      begin rangetype:=lsp1; min:=lvalu; size:=intsize end;
                    if sy = colon then insymbol else error(5);
                    constant(fsys,lsp1,lvalu);
                    lsp^.max := lvalu;
                    if lsp^.rangetype <> lsp1 then error(107)
                  end;
                if lsp <> nil then
                  with lsp^ do
                    if form = subrange then
                      if rangetype <> nil then
                        if rangetype = realptr then error(399)
                        else
                          if min.ival > max.ival then error(102)
              end;
            fsp := lsp;
            if not (sy in fsys) then
              begin error(6); skip(fsys) end
          end
            else fsp := nil
      end (*simpletype*) ;

      procedure fieldlist(fsys: setofsys; var frecvar: stp);
        var lcp,lcp1,nxt,nxt1: ctp; lsp,lsp1,lsp2,lsp3,lsp4: stp;
            minsize,maxsize,lsize: addrrange; lvalu: valu;
      begin nxt1 := nil; lsp := nil;
        if not (sy in (fsys+[ident,casesy])) then
          begin error(19); skip(fsys + [ident,casesy]) end;
        while sy = ident do
          begin nxt := nxt1;
            repeat
              if sy = ident then
                begin new(lcp,field);
                  with lcp^ do
                    begin name := id; idtype := nil; next := nxt;
                      klass := field
                    end;
                  nxt := lcp;
                  enterid(lcp);
                  insymbol
                end
              else error(2);
              if not (sy in [comma,colon]) then
                begin error(6); skip(fsys + [comma,colon,semicolon,casesy])
                end;
              test := sy <> comma;
              if not test  then insymbol
            until test;
            if sy = colon then insymbol else error(5);
            typ(fsys + [casesy,semicolon],lsp,lsize);
            while nxt <> nxt1 do
              with nxt^ do
                begin align(lsp,displ);
                  idtype := lsp; fldaddr := displ;
                  nxt := next; displ := displ + lsize
                end;
            nxt1 := lcp;
            while sy = semicolon do
              begin insymbol;
                if not (sy in fsys + [ident,casesy,semicolon]) then
                  begin error(19); skip(fsys + [ident,casesy]) end
              end
          end (*while*);
        nxt := nil;
        while nxt1 <> nil do
          with nxt1^ do
            begin lcp := next; next := nxt; nxt := nxt1; nxt1 := lcp end;
        if sy = casesy then
          begin new(lsp,tagfld);
            with lsp^ do
              begin tagfieldp := nil; fstvar := nil; form:=tagfld end;
            frecvar := lsp;
            insymbol;
            if sy = ident then
              begin new(lcp,field);
                with lcp^ do
                  begin name := id; idtype := nil; klass:=field;
                    next := nil; fldaddr := displ
                  end;
                enterid(lcp);
                insymbol;
                if sy = colon then insymbol else error(5);
                if sy = ident then
                  begin searchid([types],lcp1);
                    lsp1 := lcp1^.idtype;
                    if lsp1 <> nil then
                      begin align(lsp1,displ);
                        lcp^.fldaddr := displ;
                        displ := displ+lsp1^.size;
                        if (lsp1^.form <= subrange) or string(lsp1) then
                          begin if comptypes(realptr,lsp1) then error(109)
                            else if string(lsp1) then error(399);
                            lcp^.idtype := lsp1; lsp^.tagfieldp := lcp;
                          end
                        else error(110);
                      end;
                    insymbol;
                  end
                else begin error(2); skip(fsys + [ofsy,lparent]) end
              end
            else begin error(2); skip(fsys + [ofsy,lparent]) end;
            lsp^.size := displ;
            if sy = ofsy then insymbol else error(8);
            lsp1 := nil; minsize := displ; maxsize := displ;
            repeat lsp2 := nil;
              if not (sy in fsys + [semicolon]) then
              begin
                repeat constant(fsys + [comma,colon,lparent],lsp3,lvalu);
                  if lsp^.tagfieldp <> nil then
                   if not comptypes(lsp^.tagfieldp^.idtype,lsp3)then error(111);
                  new(lsp3,variant);
                  with lsp3^ do
                    begin nxtvar := lsp1; subvar := lsp2; varval := lvalu;
                      form := variant
                    end;
                  lsp4 := lsp1;
                  while lsp4 <> nil do
                    with lsp4^ do
                      begin
                        if varval.ival = lvalu.ival then error(178);
                        lsp4 := nxtvar
                      end;
                  lsp1 := lsp3; lsp2 := lsp3;
                  test := sy <> comma;
                  if not test then insymbol
                until test;
                if sy = colon then insymbol else error(5);
                if sy = lparent then insymbol else error(9);
                fieldlist(fsys + [rparent,semicolon],lsp2);
                if displ > maxsize then maxsize := displ;
                while lsp3 <> nil do
                  begin lsp4 := lsp3^.subvar; lsp3^.subvar := lsp2;
                    lsp3^.size := displ;
                    lsp3 := lsp4
                  end;
                if sy = rparent then
                  begin insymbol;
                    if not (sy in fsys + [semicolon]) then
                      begin error(6); skip(fsys + [semicolon]) end
                  end
                else error(4);
              end;
              test := sy <> semicolon;
              if not test then
                begin displ := minsize;
                      insymbol
                end
            until test;
            displ := maxsize;
            lsp^.fstvar := lsp1;
          end
        else frecvar := nil
      end (*fieldlist*) ;

    begin (*typ*)
      if not (sy in typebegsys) then
         begin error(10); skip(fsys + typebegsys) end;
      if sy in typebegsys then
        begin
          if sy in simptypebegsys then simpletype(fsys,fsp,fsize)
          else
    (*^*)     if sy = arrow then
              begin new(lsp,pointer); fsp := lsp;
                with lsp^ do
                  begin eltype := nil; size := ptrsize; form:=pointer end;
                insymbol;
                if sy = ident then
                  begin prterr := false; (*no error if search not successful*)
                    searchid([types],lcp); prterr := true;
                    if lcp = nil then   (*forward referenced type id*)
                      begin new(lcp,types);
                        with lcp^ do
                          begin name := id; idtype := lsp;
                            next := fwptr; klass := types
                          end;
                        fwptr := lcp
                      end
                    else
                      begin
                        if lcp^.idtype <> nil then
                          if lcp^.idtype^.form = files then error(108)
                          else lsp^.eltype := lcp^.idtype
                      end;
                    insymbol;
                  end
                else error(2);
              end
            else
              begin
                if sy = packedsy then
                  begin insymbol;
                    if not (sy in typedels) then
                      begin
                        error(10); skip(fsys + typedels)
                      end
                  end;
    (*array*)     if sy = arraysy then
                  begin insymbol;
                    if sy = lbrack then insymbol else error(11);
                    lsp1 := nil;
                    repeat new(lsp,arrays);
                      with lsp^ do
                        begin aeltype := lsp1; inxtype := nil; form:=arrays end;
                      lsp1 := lsp;
                      simpletype(fsys + [comma,rbrack,ofsy],lsp2,lsize);
                      lsp1^.size := lsize;
                      if lsp2 <> nil then
                        if lsp2^.form <= subrange then
                          begin
                            if lsp2 = realptr then
                              begin error(109); lsp2 := nil end
                            else
                              if lsp2 = intptr then
                                begin error(149); lsp2 := nil end;
                            lsp^.inxtype := lsp2
                          end
                        else begin error(113); lsp2 := nil end;
                      test := sy <> comma;
                      if not test then insymbol
                    until test;
                    if sy = rbrack then insymbol else error(12);
                    if sy = ofsy then insymbol else error(8);
                    typ(fsys,lsp,lsize);
                    repeat
                      with lsp1^ do
                        begin lsp2 := aeltype; aeltype := lsp;
                          if inxtype <> nil then
                            begin getbounds(inxtype,lmin,lmax);
                              align(lsp,lsize);
                              lsize := lsize*(lmax - lmin + 1);
                              size := lsize
                            end
                        end;
                      lsp := lsp1; lsp1 := lsp2
                    until lsp1 = nil
                  end
                else
    (*record*)      if sy = recordsy then
                    begin insymbol;
                      oldtop := top;
                      if top < displimit then
                        begin top := top + 1;
                          with display[top] do
                            begin fname := nil;
                                  flabel := nil;
                                  occur := rec
                            end
                        end
                      else error(250);
                      displ := 0;
                      fieldlist(fsys-[semicolon]+[endsy],lsp1);
                      new(lsp,records);
                      with lsp^ do
                        begin fstfld := display[top].fname;
                          recvar := lsp1; size := displ; form := records
                        end;
                      top := oldtop;
                      if sy = endsy then insymbol else error(13)
                    end
                  else
    (*set*)        if sy = setsy then
                      begin insymbol;
                        if sy = ofsy then insymbol else error(8);
                        simpletype(fsys,lsp1,lsize);
                        if lsp1 <> nil then
                          if lsp1^.form > subrange then
                            begin error(115); lsp1 := nil end
                          else
                            if lsp1 = realptr then
                              begin error(114); lsp1 := nil end
                            else if lsp1 = intptr then
                              begin error(169); lsp1 := nil end
                            else
                              begin getbounds(lsp1,lmin,lmax);
                                if (lmin < setlow) or (lmax > sethigh)
                                  then error(169);
                              end;
                        new(lsp,power);
                        with lsp^ do
                          begin elset:=lsp1; size:=setsize; form:=power end;
                      end
                    else
    (*file*)        if sy = filesy then
                          begin insymbol;
                            error(399); skip(fsys); lsp := nil
                          end;
                fsp := lsp
              end;
          if not (sy in fsys) then
            begin error(6); skip(fsys) end
        end
      else fsp := nil;
      if fsp = nil then fsize := 1 else fsize := fsp^.size
    end (*typ*) ;

    procedure labeldeclaration;
      var llp: lbp; redef: boolean; lbname: integer;
    begin
      repeat
        if sy = intconst then
          with display[top] do
            begin llp := flabel; redef := false;
              while (llp <> nil) and not redef do
                if llp^.labval <> val.ival then
                  llp := llp^.nextlab
                else begin redef := true; error(166) end;
              if not redef then
                begin new(llp);
                  with llp^ do
                    begin labval := val.ival; genlabel(lbname);
                      defined := false; nextlab := flabel; labname := lbname
                    end;
                  flabel := llp
                end;
              insymbol
            end
        else error(15);
        if not ( sy in fsys + [comma, semicolon] ) then
          begin error(6); skip(fsys+[comma,semicolon]) end;
        test := sy <> comma;
        if not test then insymbol
      until test;
      if sy = semicolon then insymbol else error(14)
    end (* labeldeclaration *) ;

    procedure constdeclaration;
      var lcp: ctp; lsp: stp; lvalu: valu;
    begin
      if sy <> ident then
        begin error(2); skip(fsys + [ident]) end;
      while sy = ident do
        begin new(lcp,konst);
          with lcp^ do
            begin name := id; idtype := nil; next := nil; klass:=konst end;
          insymbol;
          if (sy = relop) and (op = eqop) then insymbol else error(16);
          constant(fsys + [semicolon],lsp,lvalu);
          enterid(lcp);
          lcp^.idtype := lsp; lcp^.values := lvalu;
          if sy = semicolon then
            begin insymbol;
              if not (sy in fsys + [ident]) then
                begin error(6); skip(fsys + [ident]) end
            end
          else error(14)
        end
    end (*constdeclaration*) ;

    procedure typedeclaration;
      var lcp,lcp1,lcp2: ctp; lsp: stp; lsize: addrrange;
    begin
      if sy <> ident then
        begin error(2); skip(fsys + [ident]) end;
      while sy = ident do
        begin new(lcp,types);
          with lcp^ do
            begin name := id; idtype := nil; klass := types end;
          insymbol;
          if (sy = relop) and (op = eqop) then insymbol else error(16);
          typ(fsys + [semicolon],lsp,lsize);
          enterid(lcp);
          lcp^.idtype := lsp;
          (*has any forward reference been satisfied:*)
          lcp1 := fwptr;
          while lcp1 <> nil do
            begin
              if lcp1^.name = lcp^.name then
                begin lcp1^.idtype^.eltype := lcp^.idtype;
                  if lcp1 <> fwptr then
                    lcp2^.next := lcp1^.next
                  else fwptr := lcp1^.next;
                end
              else lcp2 := lcp1;
              lcp1 := lcp1^.next
            end;
          if sy = semicolon then
            begin insymbol;
              if not (sy in fsys + [ident]) then
                begin error(6); skip(fsys + [ident]) end
            end
          else error(14)
        end;
      if fwptr <> nil then
        begin error(117); writeln(output);
          repeat writeln(output,' type-id ',fwptr^.name);
            fwptr := fwptr^.next
          until fwptr = nil;
          if not eol then write(output,' ': chcnt+16)
        end
    end (*typedeclaration*) ;

    procedure vardeclaration;
      var lcp,nxt: ctp; lsp: stp; lsize: addrrange;
    begin nxt := nil;
      repeat
        repeat
          if sy = ident then
            begin new(lcp,vars);
              with lcp^ do
               begin name := id; next := nxt; klass := vars;
                  idtype := nil; vkind := actual; vlev := level
                end;
              enterid(lcp);
              nxt := lcp;
              insymbol;
            end
          else error(2);
          if not (sy in fsys + [comma,colon] + typedels) then
            begin error(6); skip(fsys+[comma,colon,semicolon]+typedels) end;
          test := sy <> comma;
          if not test then insymbol
        until test;
        if sy = colon then insymbol else error(5);
        typ(fsys + [semicolon] + typedels,lsp,lsize);
        while nxt <> nil do
          with  nxt^ do
            begin align(lsp,lc);
              idtype := lsp; vaddr := lc;
              lc := lc + lsize; nxt := next
            end;
        if sy = semicolon then
          begin insymbol;
            if not (sy in fsys + [ident]) then
              begin error(6); skip(fsys + [ident]) end
          end
        else error(14)
      until (sy <> ident) and not (sy in typedels);
      if fwptr <> nil then
        begin error(117); writeln(output);
          repeat writeln(output,' type-id ',fwptr^.name);
            fwptr := fwptr^.next
          until fwptr = nil;
          if not eol then write(output,' ': chcnt+16)
        end
    end (*vardeclaration*) ;

    procedure procdeclaration(fsy: symbol);
      var oldlev: 0..maxlevel; lcp,lcp1: ctp; lsp: stp;
          forw: boolean; oldtop: disprange;
          llc,lcm: addrrange; lbname: integer; markp: marktype;

      procedure parameterlist(fsy: setofsys; var fpar: ctp);
        var lcp,lcp1,lcp2,lcp3: ctp; lsp: stp; lkind: idkind;
          llc,lsize: addrrange; count: integer;
      begin lcp1 := nil;
        if not (sy in fsy + [lparent]) then
          begin error(7); skip(fsys + fsy + [lparent]) end;
        if sy = lparent then
          begin if forw then error(119);
            insymbol;
            if not (sy in [ident,varsy,procsy,funcsy]) then
              begin error(7); skip(fsys + [ident,rparent]) end;
            while sy in [ident,varsy,procsy,funcsy] do
              begin
                if sy = procsy then
                  begin error(399);
                    repeat insymbol;
                      if sy = ident then
                        begin new(lcp,proc,declared,formal);
                          with lcp^ do
                            begin name := id; idtype := nil; next := lcp1;
                              pflev := level (*beware of parameter procedures*);
                              klass:=proc;pfdeckind:=declared;pfkind:=formal
                            end;
                          enterid(lcp);
                          lcp1 := lcp;
                          align(parmptr,lc);
                          (*lc := lc + some size *)
                          insymbol
                        end
                      else error(2);
                      if not (sy in fsys + [comma,semicolon,rparent]) then
                        begin error(7);skip(fsys+[comma,semicolon,rparent])end
                    until sy <> comma
                  end
                else
                  begin
                    if sy = funcsy then
                      begin error(399); lcp2 := nil;
                        repeat insymbol;
                          if sy = ident then
                            begin new(lcp,func,declared,formal);
                              with lcp^ do
                                begin name := id; idtype := nil; next := lcp2;
                                  pflev := level (*beware param funcs*);
                                  klass:=func;pfdeckind:=declared;
                                  pfkind:=formal
                                end;
                              enterid(lcp);
                             lcp2 := lcp;
                             align(parmptr,lc);
                             (*lc := lc + some size*)
                              insymbol;
                            end;
                          if not (sy in [comma,colon] + fsys) then
                            begin error(7);skip(fsys+[comma,semicolon,rparent])
                            end
                        until sy <> comma;
                        if sy = colon then
                          begin insymbol;
                            if sy = ident then
                              begin searchid([types],lcp);
                                lsp := lcp^.idtype;
                                if lsp <> nil then
                                 if not(lsp^.form in[scalar,subrange,pointer])
                                    then begin error(120); lsp := nil end;
                                lcp3 := lcp2;
                                while lcp2 <> nil do
                                  begin lcp2^.idtype := lsp; lcp := lcp2;
                                    lcp2 := lcp2^.next
                                  end;
                                lcp^.next := lcp1; lcp1 := lcp3;
                                insymbol
                              end
                            else error(2);
                            if not (sy in fsys + [semicolon,rparent]) then
                              begin error(7);skip(fsys+[semicolon,rparent])end
                          end
                        else error(5)
                      end
                    else
                      begin
                        if sy = varsy then
                          begin lkind := formal; insymbol end
                        else lkind := actual;
                        lcp2 := nil;
                        count := 0;
                        repeat
                          if sy = ident then
                            begin new(lcp,vars);
                              with lcp^ do
                                begin name:=id; idtype:=nil; klass:=vars;
                                  vkind := lkind; next := lcp2; vlev := level;
                                end;
                              enterid(lcp);
                              lcp2 := lcp; count := count+1;
                              insymbol;
                            end;
                          if not (sy in [comma,colon] + fsys) then
                            begin error(7);skip(fsys+[comma,semicolon,rparent])
                            end;
                          test := sy <> comma;
                          if not test then insymbol
                        until test;
                        if sy = colon then
                          begin insymbol;
                            if sy = ident then
                              begin searchid([types],lcp);
                                lsp := lcp^.idtype;
                                lsize := ptrsize;
                                if lsp <> nil then
                                  if lkind=actual then
                                    if lsp^.form<=power then lsize := lsp^.size
                                    else if lsp^.form=files then error(121);
                                align(parmptr,lsize);
                                lcp3 := lcp2;
                                align(parmptr,lc);
                                lc := lc+count*lsize;
                                llc := lc;
                                while lcp2 <> nil do
                                  begin lcp := lcp2;
                                    with lcp2^ do
                                      begin idtype := lsp;
                                        llc := llc-lsize;
                                        vaddr := llc;
                                      end;
                                    lcp2 := lcp2^.next
                                  end;
                                lcp^.next := lcp1; lcp1 := lcp3;
                                insymbol
                              end
                            else error(2);
                            if not (sy in fsys + [semicolon,rparent]) then
                              begin error(7);skip(fsys+[semicolon,rparent])end
                          end
                        else error(5);
                      end;
                  end;
                if sy = semicolon then
                  begin insymbol;
                    if not (sy in fsys + [ident,varsy,procsy,funcsy]) then
                      begin error(7); skip(fsys + [ident,rparent]) end
                  end
              end (*while*) ;
            if sy = rparent then
              begin insymbol;
                if not (sy in fsy + fsys) then
                  begin error(6); skip(fsy + fsys) end
              end
            else error(4);
            lcp3 := nil;
            (*reverse pointers and reserve local cells for copies of multiple
             values*)
            while lcp1 <> nil do
              with lcp1^ do
                begin lcp2 := next; next := lcp3;
                  if klass = vars then
                    if idtype <> nil then
                      if (vkind=actual)and(idtype^.form>power) then
                        begin align(idtype,lc);
                          vaddr := lc;
                          lc := lc+idtype^.size;
                        end;
                  lcp3 := lcp1; lcp1 := lcp2
                end;
            fpar := lcp3
          end
            else fpar := nil
    end (*parameterlist*) ;

    begin (*procdeclaration*)
      llc := lc; lc := lcaftermarkstack; forw := false;
      if sy = ident then
        begin searchsection(display[top].fname,lcp); (*decide whether forw.*)
          if lcp <> nil then
            begin
              if lcp^.klass = proc then
                forw := lcp^.forwdecl and(fsy=procsy)and(lcp^.pfkind=actual)
              else
                if lcp^.klass = func then
                  forw:=lcp^.forwdecl and(fsy=funcsy)and(lcp^.pfkind=actual)
                else forw := false;
              if not forw then error(160)
            end;
          if not forw then
            begin
              if fsy = procsy then new(lcp,proc,declared,actual)
              else new(lcp,func,declared,actual);
              with lcp^ do
                begin name := id; idtype := nil;
                  externl := false; pflev := level; genlabel(lbname);
                  pfdeckind := declared; pfkind := actual; pfname := lbname;
                  if fsy = procsy then klass := proc
                  else klass := func
                end;
              enterid(lcp)
            end
          else
            begin lcp1 := lcp^.next;
              while lcp1 <> nil do
                begin
                  with lcp1^ do
                    if klass = vars then
                      if idtype <> nil then
                        begin lcm := vaddr + idtype^.size;
                          if lcm > lc then lc := lcm
                        end;
                  lcp1 := lcp1^.next
                end
            end;
          insymbol
        end
      else
        begin error(2); lcp := ufctptr end;
      oldlev := level; oldtop := top;
      if level < maxlevel then level := level + 1 else error(251);
      if top < displimit then
        begin top := top + 1;
          with display[top] do
            begin
              if forw then fname := lcp^.next
              else fname := nil;
              flabel := nil;
              occur := blck
            end
        end
      else error(250);
      if fsy = procsy then
        begin parameterlist([semicolon],lcp1);
          if not forw then lcp^.next := lcp1
        end
      else
        begin parameterlist([semicolon,colon],lcp1);
          if not forw then lcp^.next := lcp1;
          if sy = colon then
            begin insymbol;
              if sy = ident then
                begin if forw then error(122);
                  searchid([types],lcp1);
                  lsp := lcp1^.idtype;
                  lcp^.idtype := lsp;
                  if lsp <> nil then
                    if not (lsp^.form in [scalar,subrange,pointer]) then
                      begin error(120); lcp^.idtype := nil end;
                  insymbol
                end
              else begin error(2); skip(fsys + [semicolon]) end
            end
          else
            if not forw then error(123)
        end;
      if sy = semicolon then insymbol else error(14);
      if sy = forwardsy then
        begin
          if forw then error(161)
          else lcp^.forwdecl := true;
          insymbol;
          if sy = semicolon then insymbol else error(14);
          if not (sy in fsys) then
            begin error(6); skip(fsys) end
        end
      else
        begin lcp^.forwdecl := false; mark(markp);
          repeat block(fsys,semicolon,lcp);
            if sy = semicolon then
              begin if prtables then printtables(false); insymbol;
                if not (sy in [beginsy,procsy,funcsy]) then
                  begin error(6); skip(fsys) end
              end
            else error(14)
          until (sy in [beginsy,procsy,funcsy]) or eof(input);
          release(markp); (* return local entries on runtime heap *)
        end;
      level := oldlev; top := oldtop; lc := llc;
    end (*procdeclaration*) ;

    procedure body(fsys: setofsys);
      const cstoccmax=4000(*65*); cixmax=1000; (* cstoccmax was too small [sam] *)
      type oprange = 0..63;
      var
          llcp:ctp; saveid:alpha;
          cstptr: array [1..cstoccmax] of csp;
          cstptrix: 0..cstoccmax;
          (*allows referencing of noninteger constants by an index
           (instead of a pointer), which can be stored in the p2-field
           of the instruction record until writeout.
           --> procedure load, procedure writeout*)
          entname, segsize: integer;
          stacktop, topnew, topmax: integer;
          lcmax,llc1: addrrange; lcp: ctp;
          llp: lbp;


      procedure mes(i: integer);
      begin topnew := topnew + cdx[i]*maxstack;
        if topnew > topmax then topmax := topnew
      end;

      procedure putic;
      begin if ic mod 10 = 0 then writeln(prr,'i',ic:5) end;

      procedure gen0(fop: oprange);
      begin
        if prcode then begin putic; writeln(prr,mn[fop]:4) end;
        ic := ic + 1; mes(fop)
      end (*gen0*) ;

      procedure gen1(fop: oprange; fp2: integer);
        var k: integer;
      begin
        if prcode then
          begin putic; write(prr,mn[fop]:4);
            if fop = 30 then
              begin writeln(prr,sna[fp2]:12);
                topnew := topnew + pdx[fp2]*maxstack;
                if topnew > topmax then topmax := topnew
              end
            else
              begin
                if fop = 38 then
                   begin write(prr,'''');
                     with cstptr[fp2]^ do
                     begin
                       for k := 1 to slgth do write(prr,sval[k]:1);
                       for k := slgth+1 to strglgth do write(prr,' ');
                     end;
                     writeln(prr,'''')
                   end
                else if fop = 42 then writeln(prr,chr(fp2))
                     else writeln(prr,fp2:12);
                mes(fop)
              end
          end;
        ic := ic + 1
      end (*gen1*) ;

      procedure gen2(fop: oprange; fp1,fp2: integer);
        var k : integer;
      begin
        if prcode then
          begin putic; write(prr,mn[fop]:4);
            case fop of
              45,50,54,56:
                writeln(prr,' ',fp1:3,fp2:8);
              47,48,49,52,53,55:
                begin write(prr,chr(fp1));
                  if chr(fp1) = 'm' then write(prr,fp2:11);
                  writeln(prr)
                end;
              51:
                case fp1 of
                  1: writeln(prr,'i ',fp2);
                  2: begin write(prr,'r ');
                       with cstptr[fp2]^ do
                         for k := 1 to strglgth do write(prr,rval[k]);
                       writeln(prr)
                     end;
                  3: writeln(prr,'b ',fp2);
                  4: writeln(prr,'n');
                  6: writeln(prr,'c ''':3,chr(fp2),'''');
                  5: begin write(prr,'(');
                       with cstptr[fp2]^ do
                         for k := setlow to sethigh do
                           (* increased for testing [sam] *)
                           if k in pval then write(prr,k:7(*3*));
                       writeln(prr,')')
                     end
                end
            end;
          end;
        ic := ic + 1; mes(fop)
      end (*gen2*) ;

      procedure gentypindicator(fsp: stp);
      begin
        if fsp<>nil then
          with fsp^ do
            case form of
             scalar: if fsp=intptr then write(prr,'i')
                     else
                       if fsp=boolptr then write(prr,'b')
                       else
                         if fsp=charptr then write(prr,'c')
                         else
                           if scalkind = declared then write(prr,'i')
                           else write(prr,'r');
             subrange: gentypindicator(rangetype);
             pointer:  write(prr,'a');
             power:    write(prr,'s');
             records,arrays: write(prr,'m');
             files,tagfld,variant: error(500)
            end
      end (*typindicator*);

      procedure gen0t(fop: oprange; fsp: stp);
      begin
        if prcode then
          begin putic;
            write(prr,mn[fop]:4);
            gentypindicator(fsp);
            writeln(prr);
          end;
        ic := ic + 1; mes(fop)
      end (*gen0t*);

      procedure gen1t(fop: oprange; fp2: integer; fsp: stp);
      begin
        if prcode then
          begin putic;
            write(prr,mn[fop]:4);
            gentypindicator(fsp);
            writeln(prr,fp2:11)
          end;
        ic := ic + 1; mes(fop)
      end (*gen1t*);

      procedure gen2t(fop: oprange; fp1,fp2: integer; fsp: stp);
      begin
        if prcode then
          begin putic;
            write(prr,mn[fop]: 4);
            gentypindicator(fsp);
            (* needed to increase the range of digits here. [sam] *)
            writeln(prr,fp1:3+5*ord(abs(fp1)>99),fp2:11(*8*));
          end;
        ic := ic + 1; mes(fop)
      end (*gen2t*);

      procedure load;
      begin
        with gattr do
          if typtr <> nil then
            begin
              case kind of
                cst:   if (typtr^.form = scalar) and (typtr <> realptr) then
                         if typtr = boolptr then gen2(51(*ldc*),3,cval.ival)
                         else
                           if typtr=charptr then
                             gen2(51(*ldc*),6,cval.ival)
                           else gen2(51(*ldc*),1,cval.ival)
                       else
                         if typtr = nilptr then gen2(51(*ldc*),4,0)
                         else
                           if cstptrix >= cstoccmax then error(254)
                           else
                             begin cstptrix := cstptrix + 1;
                               cstptr[cstptrix] := cval.valp;
                               if typtr = realptr then
                                 gen2(51(*ldc*),2,cstptrix)
                               else
                                 gen2(51(*ldc*),5,cstptrix)
                             end;
                varbl: case access of
                         drct:   if vlevel<=1 then
                                   gen1t(39(*ldo*),dplmt,typtr)
                                 else gen2t(54(*lod*),level-vlevel,dplmt,typtr);
                         indrct: gen1t(35(*ind*),idplmt,typtr);
                         inxd:   error(400)
                       end;
                expr:
              end;
              kind := expr
            end
      end (*load*) ;

      procedure store(var fattr: attr);
      begin
        with fattr do
          if typtr <> nil then
            case access of
              drct:   if vlevel <= 1 then gen1t(43(*sro*),dplmt,typtr)
                      else gen2t(56(*str*),level-vlevel,dplmt,typtr);
              indrct: if idplmt <> 0 then error(400)
                      else gen0t(26(*sto*),typtr);
              inxd:   error(400)
            end
      end (*store*) ;

      procedure loadaddress;
      begin
        with gattr do
          if typtr <> nil then
            begin
              case kind of
                cst:   if string(typtr) then
                         if cstptrix >= cstoccmax then error(254)
                         else
                           begin cstptrix := cstptrix + 1;
                             cstptr[cstptrix] := cval.valp;
                             gen1(38(*lca*),cstptrix)
                           end
                       else error(400);
                varbl: case access of
                         drct:   if vlevel <= 1 then gen1(37(*lao*),dplmt)
                                 else gen2(50(*lda*),level-vlevel,dplmt);
                         indrct: if idplmt <> 0 then
                                   gen1t(34(*inc*),idplmt,nilptr);
                         inxd:   error(400)
                       end;
                expr:  error(400)
              end;
              kind := varbl; access := indrct; idplmt := 0
            end
      end (*loadaddress*) ;


      procedure genfjp(faddr: integer);
      begin load;
        if gattr.typtr <> nil then
          if gattr.typtr <> boolptr then error(144);
        if prcode then begin putic; writeln(prr,mn[33]:4,' l':8,faddr:4) end;
        ic := ic + 1; mes(33)
      end (*genfjp*) ;

      procedure genujpxjp(fop: oprange; fp2: integer);
      begin
       if prcode then
          begin putic; writeln(prr, mn[fop]:4, ' l':8,fp2:4) end;
        ic := ic + 1; mes(fop)
      end (*genujpxjp*);


      procedure gencupent(fop: oprange; fp1,fp2: integer);
      begin
        if prcode then
          begin putic;
            writeln(prr,mn[fop]:4,fp1:4,'l':4,fp2:4)
          end;
        ic := ic + 1; mes(fop)
      end;


      procedure checkbnds(fsp: stp);
        var lmin,lmax: integer;
      begin
        if fsp <> nil then
          if fsp <> intptr then
            if fsp <> realptr then
              if fsp^.form <= subrange then
                begin
                  getbounds(fsp,lmin,lmax);
                  gen2t(45(*chk*),lmin,lmax,fsp)
                end
      end (*checkbnds*);


      procedure putlabel(labname: integer);
      begin if prcode then writeln(prr, 'l', labname:4)
      end (*putlabel*);

      procedure statement(fsys: setofsys);
        label 1;
        var lcp: ctp; llp: lbp;

        procedure expression(fsys: setofsys); forward;

        procedure selector(fsys: setofsys; fcp: ctp);
        var lattr: attr; lcp: ctp; lsize: addrrange; lmin,lmax: integer;
        begin
          with fcp^, gattr do
            begin typtr := idtype; kind := varbl;
              case klass of
                vars:
                  if vkind = actual then
                    begin access := drct; vlevel := vlev;
                      dplmt := vaddr
                    end
                  else
                    begin gen2t(54(*lod*),level-vlev,vaddr,nilptr);
                      access := indrct; idplmt := 0
                    end;
                field:
                  with display[disx] do
                    if occur = crec then
                      begin access := drct; vlevel := clev;
                        dplmt := cdspl + fldaddr
                      end
                    else
                      begin
                        if level = 1 then gen1t(39(*ldo*),vdspl,nilptr)
                        else gen2t(54(*lod*),0,vdspl,nilptr);
                        access := indrct; idplmt := fldaddr
                      end;
                func:
                  if pfdeckind = standard then
                    begin error(150); typtr := nil end
                  else
                    begin
                      if pfkind = formal then error(151)
                      else
                        if (pflev+1<>level)or(fprocp<>fcp) then error(177);
                        begin access := drct; vlevel := pflev + 1;
                          dplmt := 0   (*impl. relat. addr. of fct. result*)
                        end
                    end
              end (*case*)
            end (*with*);
          if not (sy in selectsys + fsys) then
            begin error(59); skip(selectsys + fsys) end;
          while sy in selectsys do
            begin
        (*[*) if sy = lbrack then
                begin
                  repeat lattr := gattr;
                    with lattr do
                      if typtr <> nil then
                        if typtr^.form <> arrays then
                          begin error(138); typtr := nil end;
                    loadaddress;
                    insymbol; expression(fsys + [comma,rbrack]);
                    load;
                    if gattr.typtr <> nil then
                      if gattr.typtr^.form<>scalar then error(113)
                      else if not comptypes(gattr.typtr,intptr) then
                             gen0t(58(*ord*),gattr.typtr);
                    if lattr.typtr <> nil then
                      with lattr.typtr^ do
                        begin
                          if comptypes(inxtype,gattr.typtr) then
                            begin
                              if inxtype <> nil then
                                begin getbounds(inxtype,lmin,lmax);
                                  if debug then
                                    gen2t(45(*chk*),lmin,lmax,intptr);
                                  if lmin>0 then gen1t(31(*dec*),lmin,intptr)
                                  else if lmin<0 then
                                    gen1t(34(*inc*),-lmin,intptr);
                                  (*or simply gen1(31,lmin)*)
                                end
                            end
                          else error(139);
                          with gattr do
                            begin typtr := aeltype; kind := varbl;
                              access := indrct; idplmt := 0
                            end;
                          if gattr.typtr <> nil then
                            begin
                              lsize := gattr.typtr^.size;
                              align(gattr.typtr,lsize);
                              gen1(36(*ixa*),lsize)
                            end
                        end
                  until sy <> comma;
                  if sy = rbrack then insymbol else error(12)
                end (*if sy = lbrack*)
              else
        (*.*)   if sy = period then
                  begin
                    with gattr do
                      begin
                        if typtr <> nil then
                          if typtr^.form <> records then
                            begin error(140); typtr := nil end;
                        insymbol;
                        if sy = ident then
                          begin
                            if typtr <> nil then
                              begin searchsection(typtr^.fstfld,lcp);
                                if lcp = nil then
                                  begin error(152); typtr := nil end
                                else
                                  with lcp^ do
                                    begin typtr := idtype;
                                      case access of
                                        drct:   dplmt := dplmt + fldaddr;
                                        indrct: idplmt := idplmt + fldaddr;
                                        inxd:   error(400)
                                      end
                                    end
                              end;
                            insymbol
                          end (*sy = ident*)
                        else error(2)
                      end (*with gattr*)
                  end (*if sy = period*)
                else
        (*^*)     begin
                    if gattr.typtr <> nil then
                      with gattr,typtr^ do
                        if form = pointer then
                          begin load; typtr := eltype;
                            if debug then gen2t(45(*chk*),1,maxaddr,nilptr);
                            with gattr do
                              begin kind := varbl; access := indrct;
                                idplmt := 0
                              end
                          end
                        else
                          if form = files then typtr := filtype
                          else error(141);
                    insymbol
                  end;
              if not (sy in fsys + selectsys) then
                begin error(6); skip(fsys + selectsys) end
            end (*while*)
        end (*selector*) ;

        procedure call(fsys: setofsys; fcp: ctp);
          var lkey: 1..15;

          procedure variable(fsys: setofsys);
            var lcp: ctp;
          begin
            if sy = ident then
              begin searchid([vars,field],lcp); insymbol end
            else begin error(2); lcp := uvarptr end;
            selector(fsys,lcp)
          end (*variable*) ;

          procedure getputresetrewrite;
          begin variable(fsys + [rparent]); loadaddress;
            if gattr.typtr <> nil then
              if gattr.typtr^.form <> files then error(116);
            if lkey <= 2 then gen1(30(*csp*),lkey(*get,put*))
            else error(399)
          end (*getputresetrewrite*) ;

          procedure read;
            var llev:levrange; laddr:addrrange;
                lsp : stp;
          begin
            llev := 1; laddr := lcaftermarkstack;
            if sy = lparent then
              begin insymbol;
                variable(fsys + [comma,rparent]);
                lsp := gattr.typtr; test := false;
                if lsp <> nil then
                  if lsp^.form = files then
                    with gattr, lsp^ do
                      begin
                        if filtype = charptr then
                          begin llev := vlevel; laddr := dplmt end
                        else error(399);
                        if sy = rparent then
                          begin if lkey = 5 then error(116);
                            test := true
                          end
                        else
                          if sy <> comma then
                            begin error(116); skip(fsys + [comma,rparent]) end;
                        if sy = comma then
                          begin insymbol; variable(fsys + [comma,rparent])
                          end
                        else test := true
                      end;
               if not test then
                repeat loadaddress;
                  gen2(50(*lda*),level-llev,laddr);
                  if gattr.typtr <> nil then
                    if gattr.typtr^.form <= subrange then
                      if comptypes(intptr,gattr.typtr) then
                        gen1(30(*csp*),3(*rdi*))
                      else
                        if comptypes(realptr,gattr.typtr) then
                          gen1(30(*csp*),4(*rdr*))
                        else
                          if comptypes(charptr,gattr.typtr) then
                            gen1(30(*csp*),5(*rdc*))
                          else error(399)
                    else error(116);
                  test := sy <> comma;
                  if not test then
                    begin insymbol; variable(fsys + [comma,rparent])
                    end
                until test;
                if sy = rparent then insymbol else error(4)
              end
            else if lkey = 5 then error(116);
            if lkey = 11 then
              begin gen2(50(*lda*),level-llev,laddr);
                gen1(30(*csp*),21(*rln*))
              end
          end (*read*) ;

          procedure write;
            var lsp: stp; default : boolean; llkey: 1..15;
                llev:levrange; laddr,len:addrrange;
          begin llkey := lkey;
            llev := 1; laddr := lcaftermarkstack + charmax;
            if sy = lparent then
            begin insymbol;
            expression(fsys + [comma,colon,rparent]);
            lsp := gattr.typtr; test := false;
            if lsp <> nil then
              if lsp^.form = files then
                with gattr, lsp^ do
                  begin
                    if filtype = charptr then
                      begin llev := vlevel; laddr := dplmt end
                    else error(399);
                    if sy = rparent then
                      begin if llkey = 6 then error(116);
                        test := true
                      end
                    else
                      if sy <> comma then
                        begin error(116); skip(fsys+[comma,rparent]) end;
                    if sy = comma then
                      begin insymbol; expression(fsys+[comma,colon,rparent])
                      end
                    else test := true
                  end;
           if not test then
            repeat
              lsp := gattr.typtr;
              if lsp <> nil then
                if lsp^.form <= subrange then load else loadaddress;
              if sy = colon then
                begin insymbol; expression(fsys + [comma,colon,rparent]);
                  if gattr.typtr <> nil then
                    if gattr.typtr <> intptr then error(116);
                  load; default := false
                end
              else default := true;
              if sy = colon then
                begin insymbol; expression(fsys + [comma,rparent]);
                  if gattr.typtr <> nil then
                    if gattr.typtr <> intptr then error(116);
                  if lsp <> realptr then error(124);
                  load; error(399);
                end
              else
                if lsp = intptr then
                  begin if default then gen2(51(*ldc*),1,10);
                    gen2(50(*lda*),level-llev,laddr);
                    gen1(30(*csp*),6(*wri*))
                  end
                else
                  if lsp = realptr then
                    begin if default then gen2(51(*ldc*),1,20);
                      gen2(50(*lda*),level-llev,laddr);
                      gen1(30(*csp*),8(*wrr*))
                    end
                  else
                    if lsp = charptr then
                      begin if default then gen2(51(*ldc*),1,1);
                        gen2(50(*lda*),level-llev,laddr);
                        gen1(30(*csp*),9(*wrc*))
                      end
                    else
                      if lsp <> nil then
                        begin
                          if lsp^.form = scalar then error(399)
                          else
                            if string(lsp) then
                              begin len := lsp^.size div charmax;
                                if default then
                                      gen2(51(*ldc*),1,len);
                                gen2(51(*ldc*),1,len);
                                gen2(50(*lda*),level-llev,laddr);
                                gen1(30(*csp*),10(*wrs*))
                              end
                            else error(116)
                        end;
              test := sy <> comma;
              if not test then
                begin insymbol; expression(fsys + [comma,colon,rparent])
                end
            until test;
            if sy = rparent then insymbol else error(4)
            end
              else if lkey = 6 then error(116);
            if llkey = 12 then (*writeln*)
              begin gen2(50(*lda*),level-llev,laddr);
                gen1(30(*csp*),22(*wln*))
              end
          end (*write*) ;

          procedure pack;
            var lsp,lsp1: stp;
          begin error(399); variable(fsys + [comma,rparent]);
            lsp := nil; lsp1 := nil;
            if gattr.typtr <> nil then
              with gattr.typtr^ do
                if form = arrays then
                  begin lsp := inxtype; lsp1 := aeltype end
                else error(116);
            if sy = comma then insymbol else error(20);
            expression(fsys + [comma,rparent]);
            if gattr.typtr <> nil then
              if gattr.typtr^.form <> scalar then error(116)
              else
                if not comptypes(lsp,gattr.typtr) then error(116);
            if sy = comma then insymbol else error(20);
            variable(fsys + [rparent]);
            if gattr.typtr <> nil then
              with gattr.typtr^ do
                if form = arrays then
                  begin
                    if not comptypes(aeltype,lsp1)
                      or not comptypes(inxtype,lsp) then
                      error(116)
                  end
                else error(116)
          end (*pack*) ;

          procedure unpack;
            var lsp,lsp1: stp;
          begin error(399); variable(fsys + [comma,rparent]);
            lsp := nil; lsp1 := nil;
            if gattr.typtr <> nil then
              with gattr.typtr^ do
                if form = arrays then
                  begin lsp := inxtype; lsp1 := aeltype end
                else error(116);
            if sy = comma then insymbol else error(20);
            variable(fsys + [comma,rparent]);
            if gattr.typtr <> nil then
              with gattr.typtr^ do
                if form = arrays then
                  begin
                    if not comptypes(aeltype,lsp1)
                      or not comptypes(inxtype,lsp) then
                      error(116)
                  end
                else error(116);
            if sy = comma then insymbol else error(20);
            expression(fsys + [rparent]);
            if gattr.typtr <> nil then
              if gattr.typtr^.form <> scalar then error(116)
              else
                if not comptypes(lsp,gattr.typtr) then error(116);
          end (*unpack*) ;

          procedure new;
            label 1;
            var lsp,lsp1: stp; varts: integer;
                lsize: addrrange; lval: valu;
          begin variable(fsys + [comma,rparent]); loadaddress;
            lsp := nil; varts := 0; lsize := 0;
            if gattr.typtr <> nil then
              with gattr.typtr^ do
                if form = pointer then
                  begin
                    if eltype <> nil then
                      begin lsize := eltype^.size;
                        if eltype^.form = records then lsp := eltype^.recvar
                      end
                  end
                else error(116);
            while sy = comma do
              begin insymbol;constant(fsys + [comma,rparent],lsp1,lval);
                varts := varts + 1;
                (*check to insert here: is constant in tagfieldtype range*)
                if lsp = nil then error(158)
                else
                  if lsp^.form <> tagfld then error(162)
                  else
                    if lsp^.tagfieldp <> nil then
                      if string(lsp1) or (lsp1 = realptr) then error(159)
                      else
                        if comptypes(lsp^.tagfieldp^.idtype,lsp1) then
                          begin
                            lsp1 := lsp^.fstvar;
                            while lsp1 <> nil do
                              with lsp1^ do
                                if varval.ival = lval.ival then
                                  begin lsize := size; lsp := subvar;
                                    goto 1
                                  end
                                else lsp1 := nxtvar;
                            lsize := lsp^.size; lsp := nil;
                          end
                        else error(116);
          1:  end (*while*) ;
            gen2(51(*ldc*),1,lsize);
            gen1(30(*csp*),12(*new*));
          end (*new*) ;

          procedure mark;
          begin variable(fsys+[rparent]);
             if gattr.typtr <> nil then
               if gattr.typtr^.form = pointer then
                 begin loadaddress; gen1(30(*csp*),23(*sav*)) end
               else error(116)
          end(*mark*);

          procedure release;
          begin variable(fsys+[rparent]);
                if gattr.typtr <> nil then
                   if gattr.typtr^.form = pointer then
                      begin load; gen1(30(*csp*),13(*rst*)) end
                   else error(116)
          end (*release*);



          procedure abs;
          begin
            if gattr.typtr <> nil then
              if gattr.typtr = intptr then gen0(0(*abi*))
              else
                if gattr.typtr = realptr then gen0(1(*abr*))
                else begin error(125); gattr.typtr := intptr end
          end (*abs*) ;

          procedure sqr;
          begin
            if gattr.typtr <> nil then
              if gattr.typtr = intptr then gen0(24(*sqi*))
              else
                if gattr.typtr = realptr then gen0(25(*sqr*))
                else begin error(125); gattr.typtr := intptr end
          end (*sqr*) ;

          procedure trunc;
          begin
            if gattr.typtr <> nil then
              if gattr.typtr <> realptr then error(125);
            gen0(27(*trc*));
            gattr.typtr := intptr
          end (*trunc*) ;

          procedure odd;
          begin
            if gattr.typtr <> nil then
              if gattr.typtr <> intptr then error(125);
            gen0(20(*odd*));
            gattr.typtr := boolptr
          end (*odd*) ;

          procedure ord;
          begin
            if gattr.typtr <> nil then
              if gattr.typtr^.form >= power then error(125);
            gen0t(58(*ord*),gattr.typtr);
            gattr.typtr := intptr
          end (*ord*) ;

          procedure chr;
          begin
            if gattr.typtr <> nil then
              if gattr.typtr <> intptr then error(125);
            gen0(59(*chr*));
            gattr.typtr := charptr
          end (*chr*) ;

          procedure predsucc;
          begin
            if gattr.typtr <> nil then
              if gattr.typtr^.form <> scalar then error(125);
            if lkey = 7 then gen1t(31(*dec*),1,gattr.typtr)
            else gen1t(34(*inc*),1,gattr.typtr)
          end (*predsucc*) ;

          procedure eof;
          begin
            if sy = lparent then
              begin insymbol; variable(fsys + [rparent]);
                if sy = rparent then insymbol else error(4)
              end
            else
              with gattr do
                begin typtr := textptr; kind := varbl; access := drct;
                  vlevel := 1; dplmt := lcaftermarkstack
                end;
            loadaddress;
            if gattr.typtr <> nil then
              if gattr.typtr^.form <> files then error(125);
            if lkey = 9 then gen0(8(*eof*)) else gen1(30(*csp*),14(*eln*));
              gattr.typtr := boolptr
          end (*eof*) ;



          procedure callnonstandard;
            var nxt,lcp: ctp; lsp: stp; lkind: idkind; lb: boolean;
                locpar, llc: addrrange;
          begin locpar := 0;
            with fcp^ do
              begin nxt := next; lkind := pfkind;
                if not externl then gen1(41(*mst*),level-pflev)
              end;
            if sy = lparent then
              begin llc := lc;
                repeat lb := false; (*decide whether proc/func must be passed*)
                  if lkind = actual then
                    begin
                      if nxt = nil then error(126)
                      else lb := nxt^.klass in [proc,func]
                    end else error(399);
                  (*For formal proc/func, lb is false and expression
                   will be called, which will always interpret a proc/func id
                   at its beginning as a call rather than a parameter passing.
                   In this implementation, parameter procedures/functions
                   are therefore not allowed to have procedure/function
                   parameters*)
                  insymbol;
                  if lb then   (*pass function or procedure*)
                    begin error(399);
                      if sy <> ident then
                        begin error(2); skip(fsys + [comma,rparent]) end
                      else
                        begin
                          if nxt^.klass = proc then searchid([proc],lcp)
                          else
                            begin searchid([func],lcp);
                              if not comptypes(lcp^.idtype,nxt^.idtype) then
                                error(128)
                            end;
                          insymbol;
                          if not (sy in fsys + [comma,rparent]) then
                            begin error(6); skip(fsys + [comma,rparent]) end
                        end
                    end (*if lb*)
                  else
                    begin expression(fsys + [comma,rparent]);
                      if gattr.typtr <> nil then
                        if lkind = actual then
                          begin
                            if nxt <> nil then
                              begin lsp := nxt^.idtype;
                                if lsp <> nil then
                                  begin
                                    if (nxt^.vkind = actual) then
                                      if lsp^.form <= power then
                                        begin load;
                                          if debug then checkbnds(lsp);
                                          if comptypes(realptr,lsp)
                                             and (gattr.typtr = intptr) then
                                            begin gen0(10(*flt*));
                                              gattr.typtr := realptr
                                            end;
                                          locpar := locpar+lsp^.size;
                                          align(parmptr,locpar);
                                        end
                                      else
                                        begin
                                          loadaddress;
                                          locpar := locpar+ptrsize;
                                          align(parmptr,locpar)
                                        end
                                    else
                                      if gattr.kind = varbl then
                                        begin loadaddress;
                                          locpar := locpar+ptrsize;
                                          align(parmptr,locpar);
                                        end
                                      else error(154);
                                    if not comptypes(lsp,gattr.typtr) then
                                      error(142)
                                  end
                              end
                          end
                      else (*lkind = formal*)
                        begin (*pass formal param*)
                        end
                    end;
                  if (lkind = actual) and (nxt <> nil) then nxt := nxt^.next
                until sy <> comma;
                lc := llc;
                if sy = rparent then insymbol else error(4)
              end (*if lparent*);
            if lkind = actual then
              begin if nxt <> nil then error(126);
                with fcp^ do
                  begin
                    if externl then gen1(30(*csp*),pfname)
                    else gencupent(46(*cup*),locpar,pfname);
                  end
              end;
            gattr.typtr := fcp^.idtype
          end (*callnonstandard*) ;

        begin (*call*)
          if fcp^.pfdeckind = standard then
            begin lkey := fcp^.key;
              if fcp^.klass = proc then
               begin
                if not(lkey in [5,6,11,12]) then
                  if sy = lparent then insymbol else error(9);
                case lkey of
                  1,2,
                  3,4:  getputresetrewrite;
                  5,11: read;
                  6,12: write;
                  7:    pack;
                  8:    unpack;
                  9:    new;
                  10:   release;
                  13:   mark
                end;
                if not(lkey in [5,6,11,12]) then
                  if sy = rparent then insymbol else error(4)
               end
              else
                begin
                  if lkey <= 8 then
                    begin
                      if sy = lparent then insymbol else error(9);
                      expression(fsys+[rparent]); load
                    end;
                  case lkey of
                    1:    abs;
                    2:    sqr;
                    3:    trunc;
                    4:    odd;
                    5:    ord;
                    6:    chr;
                    7,8:  predsucc;
                    9,10: eof
                  end;
                  if lkey <= 8 then
                    if sy = rparent then insymbol else error(4)
                end;
            end (*standard procedures and functions*)
          else callnonstandard
        end (*call*) ;

        procedure expression;
          var lattr: attr; lop: operator; typind: char; lsize: addrrange;

          procedure simpleexpression(fsys: setofsys);
            var lattr: attr; lop: operator; signed: boolean;

            procedure term(fsys: setofsys);
              var lattr: attr; lop: operator;

              procedure factor(fsys: setofsys);
                var lcp: ctp; lvp: csp; varpart: boolean;
                    cstpart: setty; lsp: stp;
              begin
                if not (sy in facbegsys) then
                  begin error(58); skip(fsys + facbegsys);
                    gattr.typtr := nil
                  end;
                while sy in facbegsys do
                  begin
                    case sy of
              (*id*)    ident:
                        begin searchid([konst,vars,field,func],lcp);
                          insymbol;
                          if lcp^.klass = func then
                            begin call(fsys,lcp);
                              with gattr do
                                begin kind := expr;
                                  if typtr <> nil then
                                    if typtr^.form=subrange then
                                      typtr := typtr^.rangetype
                                end
                            end
                          else
                            if lcp^.klass = konst then
                              with gattr, lcp^ do
                                begin typtr := idtype; kind := cst;
                                  cval := values
                                end
                            else
                              begin selector(fsys,lcp);
                                if gattr.typtr<>nil then(*elim.subr.types to*)
                                  with gattr,typtr^ do(*simplify later tests*)
                                    if form = subrange then
                                      typtr := rangetype
                              end
                        end;
              (*cst*)   intconst:
                        begin
                          with gattr do
                            begin typtr := intptr; kind := cst;
                              cval := val
                            end;
                          insymbol
                        end;
                      realconst:
                        begin
                          with gattr do
                            begin typtr := realptr; kind := cst;
                              cval := val
                            end;
                          insymbol
                        end;
                      stringconst:
                        begin
                          with gattr do
                            begin
                              if lgth = 1 then typtr := charptr
                              else
                                begin new(lsp,arrays);
                                  with lsp^ do
                                    begin aeltype := charptr; form:=arrays;
                                      inxtype := nil; size := lgth*charsize
                                    end;
                                  typtr := lsp
                                end;
                              kind := cst; cval := val
                            end;
                          insymbol
                        end;
              (* ( *)   lparent:
                        begin insymbol; expression(fsys + [rparent]);
                          if sy = rparent then insymbol else error(4)
                        end;
              (*not*)   notsy:
                        begin insymbol; factor(fsys);
                          load; gen0(19(*not*));
                          if gattr.typtr <> nil then
                            if gattr.typtr <> boolptr then
                              begin error(135); gattr.typtr := nil end;
                        end;
              (*[*)     lbrack:
                        begin insymbol; cstpart := [ ]; varpart := false;
                          new(lsp,power);
                          with lsp^ do
                            begin elset:=nil;size:=setsize;form:=power end;
                          if sy = rbrack then
                            begin
                              with gattr do
                                begin typtr := lsp; kind := cst end;
                              insymbol
                            end
                          else
                            begin
                              repeat expression(fsys + [comma,rbrack]);
                                if gattr.typtr <> nil then
                                  if gattr.typtr^.form <> scalar then
                                    begin error(136); gattr.typtr := nil end
                                  else
                                    if comptypes(lsp^.elset,gattr.typtr) then
                                      begin
                                        if gattr.kind = cst then
                                          if (gattr.cval.ival < setlow) or
                                            (gattr.cval.ival > sethigh) then
                                            error(304)
                                          else
                                            cstpart := cstpart+[gattr.cval.ival]
                                        else
                                          begin load;
                                            if not comptypes(gattr.typtr,intptr)
                                            then gen0t(58(*ord*),gattr.typtr);
                                            gen0(23(*sgs