;;; -*- Mode: COMMON-LISP; Fonts:(MEDFNT HL12B HL12I MEDFNB); Package: PASCALX; Base: 10 -*-

;1;;; GLOBAL TYPE DEFINITIONS
3(DEFTYPE COUNTER ()**
   `(integer 0 ,MOST-POSITIVE-FIXNUM))

3(DEFTYPE PASCAL-LEVEL-NO ()*
  `(integer -1 ,MOST-POSITIVE-FIXNUM))

3(DEFTYPE PASCAL-LABEL-NO ()*
  `(integer 0 9999))

3(DEFMACRO WHEN-TYPE-CHECKING (&body body)*
  2"Executes BODY only if *TYPE-CHECKING-P* is true."*
   `(when *TYPE-CHECKING-P* ,@body))



;1;;; ESTABLISH PERMANENT AREAS
3(DEFUN IN-AREA (&rest make-area-args** 3&key name &allow-other-keys)*
  "2Returns the area number corresponding to NAME.  If the area does not yet exist, then it is made."*
  (declare (values area-number))
  (dotimes (area-number si:size-of-area-arrays (apply #'make-area make-area-args))
    (when (eq (area-name area-number) name)
      (return area-number)))
  );1in-area

3(DEFVAR *PASCALX-DEFAULT-AREA*** (in-area :name 'PASCALX-DEFAULT-AREA :gc :dynamic   :room t)
   2"default consing area for PASCAL translator"*)

3(DEFVAR *PASCALX-STATIC-AREA**  (in-area :name 'PASCALX-STATIC-AREA  :gc :static    :room t)
   2" consing area for permanent PASCAL translator data structures"*)

3(DEFVAR *PASCALX-TEMP-AREA**    (in-area :name 'PASCALX-TEMP-AREA    :gc :temporary :room t)
   2"consing area for program-specific PASCAL translator data structures"*)




;1;;; GLOBAL VARIABLE DEFINITIONS
3(DEFVAR *BATCH-MODE-P*** nil
  2"true => we are in batch mode, don't query user, or print anything"*)

3(DEFVAR *GRIND-THE-DEF* t*
  "2true => use GRIND-TOP-LEVEL when outputting the LISP code, else PRIN1*")

3(DEFVAR *CURRENT-DEFINITION-STACK* ()*
  2"the stack of all current*, 2unfinished definitions"*) 
(proclaim '(type list *CURRENT-DEFINITION-STACK*))

3(DEFVAR *CURRENT-LEVEL** 0
  2"the current level we are on"*)
(proclaim '(type pascal-level-no *CURRENT-LEVEL*))

3(DEFVAR *DEBUG-CODE-GEN-P** nil
  2"true => we are debugging the code generator"*)

3(DEFVAR *DEBUG-PARSER-P** nil
  2"true => we are debugging the parser"*)

3(DEFVAR *DEBUG-SYMTAB-P** nil
  2"true => we are debugging the symbol table routines"*)

3(DEFVAR *FORWARD-DECLARED-ROUTINES-PARAMETERS* *:UNBOUND
3  2"an alist that holds the name of forward declared routines and their parameter lists"*)*
(proclaim '(type list *FORWARD-DECLARED-ROUTINES-PARAMETERS*)) 

3(DEFVAR *LINE-END-POS**   0
  2"the ending position, zero based,  in the line of the current token"*)
(proclaim '(type counter *LINE-END-POS*))

3(DEFVAR *LINE-IMAGE**     ""
  2"holds the image of the current line"*)
(proclaim '(type string *LINE-IMAGE*))

3(DEFVAR *LINE-NO* *       0
  2"the number of the line, one based, we are on"*)
(proclaim '(type counter *LINE-NO*))

3(DEFVAR *LINE-START-POS** 0
  2"the starting position, zero based,  in the line of the current token"*)
(proclaim '(type counter *LINE-START-POS*))

3(DEFVAR *LISP-STREAM**        *STANDARD-OUTPUT*
  2"the stream the lisp is written to"*)
(proclaim '(type stream *LISP-STREAM*))

3(DEFVAR *LOG-STREAM**         :UNBOUND
  2"the stream the errors and warnings are written in"*)
(proclaim '(type stream *LOG-STREAM*))

3(DEFVAR *OUTPUT-PACKAGE* *'USER
  2"the package to put the LISP code into"*)
(proclaim '(type symbol *OUTPUT-PACKAGE*))

(DEFVAR *program-default-pathname* ""
  "2The pathname used in all I/O of the pascal program")

3(DEFVAR *PASCAL-STREAM*  **      nil
  2"the stream the pascal is read in from"*)
(proclaim '(type stream *PASCAL-STREAM*))

3(DEFVAR *PASCAL-STREAM-EOF-P** nil
  2"true => we are at the end of *PASCAL-STREAM*"*)

3(DEFVAR *SET-OF-GLOBAL-SYMBOLS-USED** ()
  2"the set of symbols used at this level defined at higher ones"*)
(proclaim '(type list *SET-OF-GLOBAL-SYMBOLS-USED*)) 

3(DEFVAR *SETS-OF-SYMBOLS-USED-BY-OTHER-LEVELS** ()
  2"the sets of symbols (one for each level) that are used by lower levels inside me."*)
(proclaim '(type list *SETS-OF-SYMBOLS-USED-BY-OTHER-LEVELS*))

3(DEFVAR *TYPE-CHECKING-P* t*
  "2true => CHECK-TYPEs are executed, otherwise, they are skipped"*)


;1;;; FUNCTION NAME SYNONYMS
3(DEFF OPER 'FIRST)
(DEFF ARG1 'SECOND)
(DEFF ARG2 'THIRD)
(DEFF ARG3 'FOURTH)
(DEFF ARG4 'FIFTH)**




;1;;;  STRUCTURE DEFINITIONS

3(DEFSTRUCT (TOKEN (:copier nil) (:predicate nil))**
  "2a token record"*
  (value nil :read-only t)		   ;1 an atom => a Pascal keyword*
					   ;1 a string  => a Pascal string*
					   ;1 a number => a Pascal label or constant*
					   ;1 a (string) => a Pascal identifier*
  (start   *LINE-START-POS* :type counter :read-only t)
  (end     *LINE-END-POS*   :type counter :read-only t)
  (line-no *LINE-NO*        :type counter :read-only t)
  (comment nil              :type (or null string))   
  );1token


3(defstruct (PRINT-IDENTIFIER (:CONC-NAME "PID-") (:COPIER nil) (:PREDICATE nil)**
				3(:PRINT-FUNCTION print-print-identifier))*
  "2a Pascal Translator identifier"*
  (name    nil :type symbol)		   ;1identifier print name*
  (package nil :type symbol :read-only t)  ;1identifier package name*
  );1print-identifier

3(DEFCONSTANT BUF-VARIABLE-OP **(make-print-identifier :name '*file*-buffer-variable :package 'pascalx))
3(DEFCONSTANT COPYARRAY-OP    *(make-print-identifier :name '*copyarray*            :package 'pascalx))
3(DEFCONSTANT COPY-OBJECT-OP  *(make-print-identifier :name '*copy-object*          :package 'pascalx))
3(DEFCONSTANT DO-OP           *(make-print-identifier :name 'do))
3(DEFCONSTANT INIT-ARRAY-OP   *(make-print-identifier :name '*init-array*           :package 'pascalx)) 
3(DEFCONSTANT LOOP-OP         *(make-print-identifier :name 'loop))
3(DEFCONSTANT ORD-OP          *(make-print-identifier :name 'ord                    :package 'pascalx))
3(DEFCONSTANT POINTER-OP      *(make-print-identifier :name '*pointer*              :package 'pascalx))
B(DEFCONSTANT 3PREDECESSOR-OP  **(make-print-identifier :name '*predecessor*          :package 'pascalx))
3(DEFCONSTANT SET-FOR-SETS-OP *(make-print-identifier :name '*set-for-sets*         :package 'pascalx))
3(DEFCONSTANT SET-OP          *(make-print-identifier :name '*set*                  :package 'pascalx))
3(DEFCONSTANT SUCCESSOR-OP    *(make-print-identifier :name '*successor*            :package 'pascalx))
3(DEFCONSTANT VAR-PARM-REF-OP *(make-print-identifier :name '*var-parm-ref*         :package 'pascalx))
3(DEFCONSTANT WHILE-OP        *(make-print-identifier :name 'while))

3(defun print-print-identifier (self stream level)*
  "2custom print function for PRINT-IDENTIFIER structure"*
;   (declare (function print-print-identifier (print-identifier stream counter) nil))
   (when (print-level-p stream level)
     ;1; then we can still print*
     (if *PRINT-ESCAPE*
	 (format stream "~:[~;PASCAL3X*:~]~A" (eq (pid-package self) 'pascalx) (pid-name self))
	 (format stream "~A:~A"            (pid-package self) (pid-name self)))
     );1when*
  );1print-print-identifier

3(defun describe-print-identifier (self)**
  "2custom decsribe function for PRINT-IDENTIFIER structure"*
;   (declare (function describe-print-identifier (print-identifier) nil))
2     *(format t "~%~S is a PASCALX identifer in package ~S" (pid-name self) (pid-package self))
  );1describe-print-identifier


3(DEFSTRUCT (OPERATOR (:CONC-NAME "OP-") (:COPIER nil) (:PREDICATE nil) **
		        3(:CONSTRUCTOR MAKE-OPERATOR (name comment start line-no))*
			3(:PRINT-FUNCTION* (lambda (self stream level)
					       (when (print-level-p stream level)
						 (format stream "#<op ~S ~@[~A~]>:"
							 (op-name self) (op-comment self)))3))*)
  "2a Pascal operator structure"*
  (name           nil :type symbol)		           1; name of operator*
  (comment        nil :type (or null string))	           1; the comment (if any) associated with the operator*
  (major-or-minor nil :type (member nil 'major 'minor))	   1; whether the comment is major or minor (NIL if no comment)*
  (start          0   :type counter :read-only t)          1; the position on the line, zero based, where operator starts*
  (line-no        0   :type counter :read-only t)          1; the line number the operator came from*
  );1operator

3(defun describe-operator (self)**
  "2custom describe function for OPERATOR structure"*
;   (declare (function describe-operator (operator) nil))
   (format t "~%~S is an operator~
             ~%~10,10Tcomment:  ~S ~S~
             ~%~10,10Tstart:    ~S~
             ~%~10,10Tline no:  ~S"
	   (op-name self) (op-comment self) (op-major-or-minor self) (op-start self) (op-line-no self))
  );1describe-operator


3(DEFSTRUCT (LISP-STRUCT (:CONC-NAME "LISP-") (:COPIER nil) (:PREDICATE nil)**
			   3(:PRINT-FUNCTION* 3print-lisp-struct)*
			   3(:CONSTRUCTOR MAKE-LISP-STRUCT (form comment major-or-minor)))*
   "2a Lisp form plus optional comment"*
   (form           nil :read-only t)
   (comment        nil :type (or nil string))	           1; optional comment associated with the formerator*
   (major-or-minor nil :type (member nil 'major 'minor))   1; whether the comment is major or minor (NIL if no comment)*
  );1lisp-struct

3(defun print-lisp-struct (self stream level)**
   "2custom print function for LISP-STRUCT structure"*
   (when (print-level-p stream level)
     ;1; then we can still print*
     (if (eq (lisp-form self) '*comment*)  1; if this is just a comment just print the comment*
	 ;1; then it is just a simple comment*
	 (print-comment self stream)
	 ;1; else there is a form to print*
	 (if (eq (lisp-major-or-minor self) 'minor)
	     (progn (print-comment self stream)
		    (prin1 (lisp-form self) stream))
	     (progn (prin1 (lisp-form self) stream)
		    (print-comment self stream))
	     );1if*
	 );1if*
     );1when*
   );1print-lisp-struct


3(defun describe-lisp-struct (self)**
  "2custom describe function for LISP-STRUCT structure"*
;   (declare (function describe-lisp-struct (lisp-struct) nil))
  (format t "~%~S is a lisp structure2~*
             ~%~4,4T Comment:       ~S~
             ~%~4,4T Major or Minor:~S"
	     (lisp-form self) (lisp-comment self) (lisp-major-or-minor self))
  );1describe-lisp-struct


3(DEFSTRUCT (SYMTAB-ENTRY (:CONC-NAME nil) (:COPIER nil) (:PREDICATE nil))**
   "2a symbol table entry"*
   (current   () :type list)		   1; a stack of the currently defined symbols*
   (discarded () :type list)		   1; the symbols that are no longer valid*
  );1symtab-entry*




;1;;; GENERIC-SYMBOL Family
3(DEFSTRUCT (GENERIC-SYMBOL (:CONC-NAME nil) (:COPIER nil) (:PREDICATE nil))**
   "2a general symbol found in the Pascal source (inherited by other more specific structures)"*
  (pascal-id   nil :type symbol)	           1; identifier name in the Pascal source, used for DESCRIBE*
  (access-form nil :type (or symbol cons)  )	   1; form to access this symbol (usually the name of the symbol*
					           ;1 (made unique), except e.g., in the case of* 1VAR parameters*
  (level       0   :type (integer -1 *)    )	   1;* 1the level that this identifier is defined on.*
  (parameter   nil :type (member nil 'VAR 'VALUE 'PROCEDURE 'FUNCTION))
  );1generic-symbol

3(defun print-generic-symbol (self stream level)**
   "2custom print function for subtypes of GENERIC-SYMBOL"*
;   (declare (function print-generic-symbol (generic-symbol stream counter) nil))
   (when (print-level-p stream level)
     (format stream "#<~A: ~A>" (type-of self) (pascal-id self))
     );1when*
   );1print-generic-symbol

3(defun describe-generic-symbol (self)**
   "2custom describe function for GENERIC-SYMBOL structure"*
;   (declare (function describe-generic-symbol (generic-symbol) nil))
   (format t "~@[ [~A PARAMETER]:~]2 *~%~4,4T Access Form:~22,2T~S2 *~%~4,4T Level:~22,2T~S"
	   (parameter self) (access-form self) (level self))
   );1describe-generic-symbol


3(DEFSTRUCT (CONST (:INCLUDE GENERIC-SYMBOL) (:CONC-NAME nil) (:COPIER nil) (:PREDICATE nil)**
		3    (:PRINT-FUNCTION* 3print-generic-symbol))*
   "2a Pascal const symbol"*
  (value        nil :read-only t)	   1; the value of the constant*
  (part-of-type nil :read-only t)	   1; if this is part of an enumerated type, the parent type*
  );1const

3(defun describe-const (self)**
  "2custom describe function for CONST structure"*
;   (declare (function describe-const (const) nil))
   (format t "~%~S is a constant" (pascal-id self))
   (describe-generic-symbol self)
   (format t "~%~4,4T Part of Type:~22,2T~S~]" (part-of-type self))
   );1describe-const


3(DEFSTRUCT (LABEL (:INCLUDE GENERIC-SYMBOL) (:CONC-NAME nil) (:COPIER nil) (:PREDICATE nil)**
		    3(:PRINT-FUNCTION* 3print-generic-symbol*))
   "2a Pascal label symbol"*
  );1label

3(defun describe-label (self)**
  "2custom describe function for LABEL structure"*
;   (declare (function describe-label (label) nil))
   (format t "~%~S is a label" (pascal-id self))
   (describe-generic-symbol self)
   );1describe-label


3(DEFSTRUCT (PROCEDURE (:INCLUDE GENERIC-SYMBOL) (:CONC-NAME nil) (:COPIER nil) (:PREDICATE nil)**
			 3(:PRINT-FUNCTION* 3print-generic-symbol*))
   "2a Pascal PROCEDURE"*
  (parms () :type list)			   1; an a-list containing the name and type of the parameters*
					1    ; Note: var parameters have the form (<name> VAR <type>)*
					1    ; other parameters have the form (<name> . <type>)*
  (external-labels-used () :type list)	   1; labels used (by GOTO), that are not in the body.*
  );1procedure

3(defun describe-procedure (self)**
  "2custom describe function fo PROCEDURE structure"*
;   (declare (function describe-procedure (procedure) nil))
   (format t "~%~S is a procedure" (pascal-id self))
   (describe-generic-symbol self)
   (format t "~%~4,4T Parameters:~22,2T~S ~%~4,4T Labels:~22,2T~S"
	   (parms self) (external-labels-used self))
  );1describe-procedure


3(DEFSTRUCT (FUNCTION (:INCLUDE PROCEDURE) (:CONC-NAME nil) (:COPIER nil) (:PREDICATE nil)**
		        3(:PRINT-FUNCTION* 3print-generic-symbol))*
   "2a Pascal FUNCTION"*
  (returns nil :type symbol :read-only t)  1; the type the function returns*
  );1function

3(defun describe-function (self)**
  "2custom describe function for FUNCTION structure"*
;   (declare (function describe-function (function) nil))
   (format t "~%~S is a function" (pascal-id self))
   (describe-generic-symbol self)
   (format t "~%~4,4T Parameters:~22,2T~S ~%~4,4T Labels:~22,2T~S~%~4,4T Returns:~22,2T~S"
	   (parms self) (external-labels-used self) (returns self))
  );1describe-function


3(DEFSTRUCT (PROGRAM (:INCLUDE GENERIC-SYMBOL) (:CONC-NAME nil) (:COPIER nil) (:PREDICATE nil)**
		       3(:PRINT-FUNCTION* 3print-generic-symbol))*
   "2the Pascal PROGRAM"*
  (prog-parms () :type list)		   1; list containing the names of the program parameters*
  );1program

3(defun describe-program (self)**
  "2custom describe function for PROGRAM structure"*
;   (declare (function describe-program (program) nil))
   (format t "~%~S is a program" (pascal-id self))
   (describe-generic-symbol self)
   (format t "~%~4,4T Program Parameters:~22,2T~S" (prog-parms self))
   );1describe-program


3(DEFSTRUCT (TYPE (:INCLUDE GENERIC-SYMBOL) (:CONC-NAME nil) (:COPIER nil) (:PREDICATE nil))**
   "2a Pascal type symbol"*
  (init-function   nil :type symbol :read-only t)  1; function to initialize variables of this type with,*
  (assign-function nil :type symbol)	           v1; the function used for assignment of this form*
  );1type

3(defun describe-type (self)**
   "2custom describe function for TYPE structure"*
;   (declare (function describe-type (type) nil))
   (describe-generic-symbol self)
   (format t "~%~4,4T Init Function:~22,2T~S ~%~4,4T Assign Function:~22,2T~S"
	  (init-function self) (assign-function self))
   );1describe-type


3(DEFSTRUCT (PRIMITIVE-TYPE (:INCLUDE TYPE (ASSIGN-FUNCTION SET-OP)) (:CONC-NAME nil)**
			      3(:PREDICATE nil)* 3(:PRINT-FUNCTION* 3print-generic-symbol))*
  (required-type nil :type :keyword :read-only t)  1; the type this is part of*
  );1primitive-type

3(defun describe-primitive-type (self)**
   "2custom describe function for PRIMITIVE TYPE structure"*
;   (declare (function describe-primitive-type (primitive-type) nil))
   (format t "~%~S is a primitive type" (pascal-id self))
   (describe-type self)
   (format t "~%~4,4T Required Type:~22,2T~S" (required-type self))
   );1describe-primitive-type


3(DEFSTRUCT (VAR (:INCLUDE GENERIC-SYMBOL) (:CONC-NAME nil) (:COPIER nil) (:PREDICATE nil)**
		  3(:PRINT-FUNCTION* 3print-generic-symbol*))
  (var-type nil :type symbol)		   1; the type of the variable*
  );1var

3(defun describe-var (self)**
   "2custom describe-function for VAR structure"*
;   (declare (function describe-var (var) nil))
   (format t "~%~S is a var" (pascal-id self))
   (describe-generic-symbol self)
   (format t "~%~4,4T Type:~22,2T~S" (var-type self))
   );1describe-var*



;1;;; SYMBOL TABLE Structures
3(DEFSTRUCT (SYMTAB-ENUMERATED-TYPE**
	3     (:PREDICATE nil) (:CONC-NAME nil)* 3(:PRINT-FUNCTION print-generic-symbol)*
	3     (:INCLUDE TYPE (ASSIGN-FUNCTION SET-OP)*
		3            (INIT-FUNCTION (MAKE-PRINT-IDENTIFIER :NAME '*INIT-ENUMERATED**
								        3:PACKAGE 'PASCALX))))*
  (poss-values () :type list :read-only t)1 ; the list of possible values*
  );1symtab-enumerated-type

3(defun describe-symtab-enumerated-type (self)**
   "2custom describe-function for SYMTAB-ENUMERATED-TYPE structure"*
;   (declare (function describe-symtab-enumerated-type (symtab-enumerated-type) nil))
   (format t "~%~S is a enumerated type" (pascal-id self))
   (describe-type self)
   (format t "~%~4,4T Possible Values:~22,2T~S" (poss-values self))
   );1describe-symtab-enumerated-type


3(DEFSTRUCT (SYMTAB-SUBRANGE-TYPE (:INCLUDE TYPE (ASSIGN-FUNCTION SET-OP))** 3(:PREDICATE nil)*
				     3(:CONC-NAME nil)* 3(:PRINT-FUNCTION print-generic-symbol))*
  (host-type nil :type symbol :read-only t)	   1; the type that this is a subrange of*
  (smallest  nil :type t      :read-only t)	   1; the smallest value in the range*
  (largest   nil :type t      :read-only t)	   1; the largest value in the range*
  );1symtab-subrange-type

3(defun describe-symtab-subrange-type (self)**
   2"custom describe-function for SYMTAB-SUBRANGE-TYPE structure"*
;   (declare (function describe-symtab-subrange-type (symtab-subrange-type) nil))
   (format t "~%~S is a subrange type" (pascal-id self))
   (describe-type self)
   (format t "~%~4,4T Host Type:~22,2T~S ~%~4,4T Smallest:~22,2T~S~
              ~%~4,4T Largest:~22,2T~S"
	   (host-type self) (smallest self) (largest self))
1    *);1describe-symtab-subrange-type



3(DEFSTRUCT (SYMTAB-POINTER-TYPE (:PREDICATE nil) (:CONC-NAME nil)**
				    3(:INCLUDE TYPE (ASSIGN-FUNCTION SET-OP) *
					             3(INIT-FUNCTION (MAKE-PRINT-IDENTIFIER*
								        3:NAME '*INIT-POINTER**
									3:PACKAGE 'PASCALX)))*
				    3(:PRINT-FUNCTION print-generic-symbol))*
  (symtab-domain-type nil :type symbol :read-only t)	1   ; the type this one points to*
  );1symtab-pointer-type

3(defun describe-symtab-pointer-type (self)**
   2"custom describe-function for SYMTAB-POINTER-TYPE structure"*
;   (declare (function describe-symtab-pointer-type (symtab-pointer-type) nil))
   (format t "~%~S is a pointer type" (pascal-id self))
   (describe-type self)
   (format t "~%~4,4T Domain Type:~22,2T~S" (symtab-domain-type self))
   );1describe-symtab-pointer-type


3(DEFSTRUCT (SYMTAB-STRUCTURED-TYPE (:INCLUDE TYPE) (:PREDICATE nil) (:COPIER nil) (:CONC-NAME nil))**
  (packed nil :type t :read-only t)	1   ; true => this is a packed type*
  );1symtab-structured-type

3(defun describe-structured-type (self)**
   "2custom describe-function for SYMTAB-STRUCTURED-TYPE structure"*
;   (declare (function describe-structured-type (symtab-structured-type) nil))
   (describe-type self)
   (format t "~%~4,4T Packed: ~22,2T~S" (packed self))
   );1describe-structured-type


3(DEFSTRUCT (SYMTAB-ARRAY-TYPE (:CONC-NAME nil) (:PRINT-FUNCTION print-generic-symbol) **
				3  (:INCLUDE SYMTAB-STRUCTURED-TYPE (ASSIGN-FUNCTION COPYARRAY-OP))*
				3  (:PREDICATE nil))*
  (type-of-array    nil :type symbol :read-only t)1  ; the component type of the array*
  (array-index-type nil :type symbol :read-only t) 1; the type of the array dimensions*
  (array-accessor   nil :type symbol :read-only t) 1; the name of the access function*
  );1symtab-array-type

3(defun describe-symtab-array-type (self)**
   "2custom describe-function for SYMTAB-ARRAY-TYPE structure"*
;   (declare (function describe-symtab-array-type (symtab-array-type) nil))
   (format t "~%~S is an array type" (pascal-id self))
   (describe-structured-type self)
   (format t "~%~4,4T Component Type:~22,2T~S ~%~4,4T Index Type:~22,2T~S~
              ~%~4,4T Access Function:~22,2T~S"
	   (type-of-array self) (array-index-type self) (array-accessor self))
   );1describe-symtab-array-type


3(DEFSTRUCT (SYMTAB-RECORD-TYPE (:INCLUDE SYMTAB-STRUCTURED-TYPE (ASSIGN-FUNCTION COPYARRAY-OP))**
				3  (:PREDICATE nil) (:CONC-NAME nil)*
				  3(:PRINT-FUNCTION print-generic-symbol))*
  (record-fields          nil :type symtab-field-list :read-only t) 1; a SYMTAB-FIELD-LIST structure of record's field list*
  (field-accessor-prefix  nil :type string            :read-only t) 1; field name prefix to get the field-accessor*
  (do-not-need-array      nil :type (or null counter) :read-only t)1 ; false=>this record takes more than one word, and*
					1  *                           1; we have to use array; true=> the number of bits*
					1  *                           1; required for this record.*
  );1symtab-record-type

3(defun describe-symtab-record-type (self)**
   "2custom describe-function for SYMTAB-RECORD-TYPE structure"*
;   (declare (function describe-symtab-record-type (symtab-array-type) nil))
   (format t "~%~S is a record type" (pascal-id self))
   (describe-structured-type self)
   (format t " ~%~4,4T Field Accessor Prefix:~22,2T~S" (field-accessor-prefix self))
   (if (do-not-need-array self)
       (format t "~%~4,4T Does not require an array, needs ~D bits" (do-not-need-array self))
       (format t "~%~4,4T Needs an array:~22,2T~S"                  t))
   (format t "~%     Record Fields:~%")
   (describe-symtab-field-list (record-fields self) 0)
   );1describe-symtab-record-type


3(DEFSTRUCT (SYMTAB-FIELD-LIST (:PREDICATE nil) (:CONC-NAME nil)**
				  3(:CONSTRUCTOR*
				     3make-field-list (fixed-fields symtab-tag-field variant-fields)))*
  (fixed-fields	    () :type list)	   1; a-list of fixed field names and associated type*
  (symtab-tag-field () :type list)	   1; name and associated type of tag field*
  (variant-fields   () :type list)	   1; a-list of field names and associated field list*
  );1symtab-field-list*

 3(defun describe-symtab-field-list (field-list indent)*
   "2custom describe-function for a SYMTAB-FIELD-LIST  structure"*
;   (declare (function describe-symtab-field-list (symtab-field-list counter) nil))
   (let ((spaces (* 30 indent)))
     (when (not (null field-list))
       ;1; then there is something to describe*
       (format t "~V,4T Fixed Fields:~V,2T~S ~%~V,4T Tag Field:~V,2T~S~
                  ~@[~*~%~V,4T Variant Fields:~]"
	       (+ spaces 7) (+ spaces 25) (fixed-fields field-list) 
	       (+ spaces 7) (+ spaces 25) (symtab-tag-field field-list)
	       (variant-fields field-list) (+ spaces 7))
       (mapcar #'(lambda (var)
		   (format t " ~V,2T~S:" (+ spaces 25) (car var))
		   (describe-symtab-field-list (cdr var) (1+ indent))
		   (terpri))
	       (variant-fields field-list))
       );1when*
     );1let*
   );1describe-symtab-field-list


3(DEFSTRUCT (SYMTAB-SET-TYPE (:INCLUDE SYMTAB-STRUCTURED-TYPE**
					   3(INIT-FUNCTION (MAKE-PRINT-IDENTIFIER :NAME '*INIT-SET**
										      3:PACKAGE 'PASCALX))*
					   3(ASSIGN-FUNCTION SET-FOR-SETS-OP))*
			        3(:PREDICATE nil) (:CONC-NAME nil)*
				3(:PRINT-FUNCTION print-generic-symbol))*
  (symtab-base-type nil :type symbol :read-only t)1 ; the base type of this set*
  );1symtab-set-type

3(defun describe-symtab-set-type (self)**
   "2custom describe-function for SYMTAB-SET-TYPE structure"*
;   (declare (function describe-symtab-set-type (symtab-set-type) nil))
   (format t "~%~S is a set type" (pascal-id self))
   (describe-structured-type self)
   (format t "~%~4,4T Base Type:~22,2T~S" (symtab-base-type self))
   );1describe-symtab-set-type


3(DEFSTRUCT (SYMTAB-FILE-TYPE (:INCLUDE**
				      3SYMTAB-STRUCTURED-TYPE*
			3      (INIT-FUNCTION (MAKE-PRINT-IDENTIFIER *:3NAME '*MAKE-FILE-VARIABLE**
									 :3PACKAGE 'PASCAL*x3))*
			3      (ASSIGN-FUNCTION COPYARRAY-OP))*
			3     (:CONC-NAME nil) (:PREDICATE nil) (:PRINT-FUNCTION print-generic-symbol))*
  (symtab-component-type nil :type symbol :read-only t)	1   ; the component type of the file*
  (num-of-bits           0   :type counter :read-only t)   1; how many bits per byte for packed files (only matters*
					1  *                 1; if the type is a numeric subrange*
  );1symtab-file-type

3(defun describe-symtab-file-type (self)**
   "2custom describe-function for SYMTAB-FILE-TYPE structure"*
;;   (declare (function describe-symtab-file-type (symtab-file-type) nil))
   (format t "~%~S is a file type" (pascal-id self))
   (describe-structured-type self)
   (format t "~%~4,4T Component Type:~22,2T~S" (symtab-component-type self))
   );1describe-symtab-file-type