(*$A+,U+,L'COMPILER FOR PASCAL-6000.' *) COMP 2 COMP 3 COMP 4 (********************************************************************* COMP 5 * * COMP 6 * * COMP 7 * COMPILER FOR PASCAL-6000 * COMP 8 * ************************ * COMP 9 * * COMP 10 * * COMP 11 * (FOR CDC 6000/7000, CYBER 70,170,700,800 SERIES COMPUTER SYSTEMS) * COMP 12 * * COMP 13 * * COMP 14 * AUTHOR: URS AMMANN * COMP 15 * INSTITUT FUER INFORMATIK * COMP 16 * EIDG. TECHNISCHE HOCHSCHULE * COMP 17 * CH-8092 ZUERICH * COMP 18 * SWITZERLAND * COMP 19 * * COMP 20 * RELEASE 1 - URS AMMANN. * COMP 21 * 1974 MAY ORIGINAL RELEASE IMPLEMENTING THE REVISED PASCAL * COMP 22 * REPORT. KNOWN AS PASCAL 6000-3.4. GENERATE * COMP 23 * RELOCATABLE CODE; REMEMBER REGISTERS. * COMP 24 * UPDATES 1-10 - URS AMMANN. * COMP 25 * 1974-1975 CORRECT ERRORS. * COMP 26 * * COMP 27 * RELEASE 2 - URS AMMANN AND JOHN P. STRAIT. * COMP 28 * 1976 MAR IMPROVE PERFORMANCE; PROVIDE DIAGNOSTIC SUMMARY * COMP 29 * UPDATES 1-2 - URS AMMANN. * COMP 30 * 1976 CORRECT ERRORS. * COMP 31 * * COMP 32 * MAINTENANCE ASSUMED BY ANDY MICKEL AND JOHN P. STRAIT * COMP 33 * 1977 JAN UNIVERSITY COMPUTER CENTER * COMP 34 * UNIVERSITY OF MINNESOTA * COMP 35 * * COMP 36 * RELEASE 3 - JOHN P. STRAIT. * COMP 37 * 1979 JAN IMPLEMENT CHANGES WHICH WILL BECOME STANDARD: * COMP 38 * NEW TYPE-COMPATIBILITY RULES, ETC. IMPROVE * COMP 39 * RUN-TIME CHECKS, USABILITY; CORRECT ERRORS. * COMP 40 * UPDATES 1-4 - JOHN P. STRAIT, ANDY MICKEL, RICK L. MARCUS, * COMP 41 * AND DANIEL E. GERMANN. * COMP 42 * 1979-1982 CORRECT ERRORS. * COMP 43 * * COMP 44 * RELEASE 4 - DAVE BIANCHI, DANIEL E. GERMANN, * COMP 45 * ANDY MICKEL, AND JIM MINER. * COMP 46 * 1984 JUN IMPLEMENT CHANGES FOR ISO 7185 PASCAL STANDARD, * COMP 47 * DYNAMIC MEMORY MANAGEMENT, OPTIMIZATIONS, * COMP 48 * AND STANDARD CONTROL STATEMENT; CORRECT ERRORS. * COMP 49 * WORK SUPPORTED IN PART BY CONTROL DATA GRANTS. * COMP 50 * * COMP 51 * * COMP 52 * THIS COMPILER IS THE PROPERTY OF THE INSTITUT FUER INFORMATIK, * COMP 53 * E.T.H., ZUERICH, SWITZERLAND. CONTROL DATA CORPORATION HAS THE * COMP 54 * NON-EXCLUSIVE RIGHT TO DISTRIBUTE IT. * COMP 55 * * COMP 56 *********************************************************************) COMP 57 (*$L'MODIFICATION HISTORY.'*) COMP 58 COMP 59 HCOMP 1 (* PASCAL-6000 MODIFICATION HISTORY. HCOMP 2 * HCOMP 3 * CHANGE PREDECLARED FUNCTION "OFFSET" TO "RELVALUE". V410C01 6 * CORRECT MISTAKE IN FOR STATEMENT RANGE CHECKING FOR CONSTANTS. V41FC02 6 * FIX PROBLEM WITH COMPILER COMMAND PROCESSING. V41FC01 7 * FIX BUG WHERE "/L+" ON CONTROL STATEMENT TURNS OFF LISTING. V41EC08 5 * AVOID TRASHING FUNCTION RESULT. V41EC02 7 * CREATE PMD FILE AS "OUTPUT" IF OUTPUT NOT USED AND (PMD <> PMDNONE). V41DC06 10 * CHANGE CONTROL STATEMENT PROCESSING. V41DC05 191 * ADD NEW PREDECLARED ORDINAL FUNCTION OFFSET. V41CC21 8 * ADD RANGE CHECKS TO CHR, SUCC, AND PRED. V41CC21 9 * CHANGE CHECKS FOR FORWARD DECLARATIONS AND UNDECLARED PROG PARAMS. V41CC20 10 * ALLOW UNDERSCORE CHARACTERS IN IDENTIFIERS. V41CC18 10 * FIX BUG IN STRINGPARAM TO HANDLE PACKED STRINGS. V41CC15 6 * DETECT AND ABORT ON EMPTY INPUT FILE. V41CC12 5 * DISALLOW STRING-COMPARE PROCESSING OF CONFORMANT ARRAY PARAMS. V41CC11 7 * FIX PROBLEM WHERE MULTI-DIMENSIONAL ARRAYS ARE NOT HANDLED CORRECTLY. V41CC08 6 * 1. REWORK DATA STRUCTURE FOR RECORD TYPES. V41CC07 17 * 2. PROVIDE FOR OTHERWISE CLAUSE IN VARIANT-PART OF VARIANT RECORDS. V41CC07 18 * 3. PROVIDE FOR SUBRANGES IN CASE STATEMENTS AND VARIANT RECORDS. V41CC07 19 * USE SYMBOLIC EFET OFFSETS AND BIT POSITIONS IN COMPILER. V41CC04 7 * CALL "CLOSE" INSTEAD OF "CLOSEB" AND "CLOSET". V41BC01 7 * CORRECT ERROR IN ERROR-RECOVERY IN PROCEDURE PAGE. V41AC21 5 * ADD LANGUAGE DIALECT SELECTION PARAMETER. V41AC20 8 * SPLIT NONSTANDARD TYPE AND NAME DEFINITIONS INTO TWO PROCEDURES. V41AC19 5 * PREVENT INVALID USE OF FUNCTION IDENTIFIER IN ITS OWN BLOCK. V41AC18 6 * ENSURE THAT THE FIRST OPERAND OF THE IN OPERATOR HAS AN ORDINAL TYPE. V41AC17 6 * ALLOW CONFORMANT ARRAYS AS PARAMETERS TO PACK AND UNPACK. V41AC16 11 * ENFORCE CORRECT TYPE AND BOUNDS CHECK OF THIRD PARAMETER TO UNPACK. V41AC16 12 * INSTALL PREDECLARED PROCEDURES GETFILE AND PUTFILE, AND FUNCTION EOI. V41AC15 7 * FIX ERROR IN FIXFIELDALLOCATION -- ADJUST ADDRESS OF TAG FIELDS. V41AC13 6 * ENSURE PACKED ARRAY [1..N] OF CHAR IS A STRING TYPE ONLY IF N > 1. V41AC11 7 * CONVERT AN IF-STATEMENT TO AN ASSIGNMENT-STATEMENT. V41AC11 8 * ELIMINATE UNNECESSARY SPECIAL CASE IN GOTO STATEMENT. V41AC10 5 * ELIMINATE UNNECESSARY RUN-TIME TEST. V41AC09 5 * AVOID UNNECESSARY SHIFT DURING STORE INTO PACKED VARIABLE. V41AC08 9 * RENAME "ROTATEX" TO "UNROTATEX"; ADD "GENROTATE" AND "ROTATEX". V41AC08 10 * INTRODUCE CONSTANT FOR EXTERNAL LABEL COUNT LIMIT. V41AC03 5 * ENFORCE EXTERNAL FILE COUNT LIMIT. V41AC02 6 *) HCOMP 4 (*$L'COMPILER OPTION SETTINGS.'*) COMP 60 COMP 61 COMP 62 (*$B2 USE 401B WORD BUFFERS *) COMP 63 (*$E- COMPILE WITH DEFAULT ENTRY POINTS. *) COMP 64 (*$MB6000B ALLOW ENOUGH SPACE TO COMPILE SMALL PROGRAMS *) COMP 65 (*$MD+ ALLOW MEMORY DECREASE *) COMP 66 (*$MD5000B MINIMUM MEMORY DECREASE IS 5000B WORDS *) COMP 67 (*$MF377777B MAXIMUM ALLOWABLE FIELD LENGTH IS 377777B WORDS *) COMP 68 (*$MI+ ALLOW MEMORY INCREASE *) COMP 69 (*$MI2000B MINIMUM MEMORY INCREASE IS 2000B WORDS *) COMP 70 (*$MR+ PERFORM INITIAL REDUCE TO (LOAD FL + INITIAL SPACE) *) COMP 71 (*$MS2000B INITIAL STACK CHUNK IS 2000B WORDS. *) COMP 72 (*$MX1000B MINIMUM STACK EXTENSION IS 1000B WORDS. *) COMP 73 (*$P0 COMPILE WITH ABSOLUTELY NO PMD INFO *) COMP 74 (*$PL0 SET OUTPUT PRINT LIMIT TO MAXINT. *) COMP 75 (*$T- COMPILE WITHOUT RUNTIME TESTS *) COMP 76 (*$X5 PASS UP TO FIVE PARAMETERS IN X-REGISTERS *) COMP 77 COMP 78 COMP 79 PROGRAM PASCALCOMPILER; V41DC05 192 COMP 81 (* COMP 82 * COPYRIGHT (C) E.T.H. ZUERICH AND UNIV. OF MINNESOTA. COMP 83 * 1974, 1975, 1976, 1977, 1978, 1979, 1980, 1981, 1982. COMP 84 *) COMP 85 COMP 86 COMP 87 LABEL 13; (*EXIT IF EOF ENCOUNTERED*) COMP 88 (*$L'GLOBAL CONSTANT DECLARATIONS.' *) COMP 89 COMP 90 COMP 91 CONST COMP 92 COPYRIGHT = 'COPYRIGHT (C) E.T.H. ZUERICH AND UNIV. OF MINNESOTA.'; COMP 93 COPYRIGHT2 = '1974,1975,1976,1977,1978,1979,1980,1981,1982.'; COMP 94 ERRMAX = 360; (* MAXIMUM ERROR MESSAGE *) COMP 95 MAXERRPERLINE = 10; (* MAX ERRORS REPORTED PER LINE *) COMP 96 DISPLIMIT = 20; COMP 97 MAXLEVEL = 10; COMP 98 MAXADDR = 377777B; COMP 99 ICMAX = 32768; (* MAX WORDS IN CODE SEGMENT FOR A BLOCK. *) COMP 100 (* LIMITS: FIELDS IN BLOCK & PMD HEADER WORDS *) COMP 101 MAXLABEL = 9999; COMP 102 MAXEXTLABCNT = 36; (* LIMIT: EXTERNAL NAMES "PASCL.A".."PASCL.9" *) V41AC03 6 MAXFILES = 50; (* LIMIT: MAX EXTERNAL FILES ALLOWED *) V41AC02 7 MAXCSPNAME = 14; (* MAX CONTROL STATEMENT NAME LIST *) V41DC05 193 MAXPARAMS = 1023; (* LIMIT: PARAMS FIELD OF BLOCK HEADER WORD *) COMP 103 MAXPARAMSINREGS = 5; (* MAXIMUM X OPTION *) COMP 104 SCOPEMAX = MAXADDR; COMP 105 RESWORDS = 38; COMP 106 TWOTO17 = 400000B; COMP 107 CODEMAX = 150; COMP 108 RCODEMAX = 10 (* CODEMAX DIV 15 *); COMP 109 IDNAMEEXTLEN = 7; COMP 110 MAXLINELEN = 150; COMP 111 MAXTITLE = 40; COMP 112 OSNAME = '*OS*NAME* '; COMP 113 SITENAME = '*** SITE NAME *** '; COMP 114 (* LOCAL SITE NAME (MAXTITLE CHARACTERS LONG) *) COMP 115 BLANKTITLE = ' '; COMP 116 COMP 117 COMP 118 COMP 119 COMP 120 (* CTEXT COMSPAS - PASCAL-6000 RUN TIME EQUIVALENCES. COMSPAS 2 BASE DECIMAL COMSPAS 3 *COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. COMSPAS 4 COMSPAS 5 COMSPAS 6 COMSPAS 7 COMSPAS 8 ** COMSPAS - PASCAL-6000 RUN TIME EQUIVALENCES. COMSPAS 9 * J. P. STRAIT. 77/08/24. COMSPAS 10 COMSPAS 11 COMSPAS 12 COMSPAS 13 HCOMSPA 1 ** PASCAL-6000 MODIFICATION HISTORY. HCOMSPA 2 * HCOMSPA 3 * PASCAL-6000 VERSION 4.1.0. V410C 1 * PASCAL-6000 VERSION 4.1.F. V41FC 1 * RENAME SYMBOL *ETERMINL* TO *ECONNECT*. V41EC01 1 * PASCAL-6000 VERSION 4.1.E. V41EC 1 * CHANGE VALUE OF CONSTANT *ERT*. V41DC09 1 * PASCAL-6000 VERSION 4.1.D. V41DC 1 * ADD ASCII AND DISPLAY CODE CHARACTER SET CONSTANTS. V41CC16 1 * RENAME EFET SYMBOLS: CHEFET -> TXTEFET; CHEFETSZ -> TXEFETSZ; V41CC02 1 * EFETSZ -> BNEFETSZ; CHEFITSZ -> TXEFITSZ; EFITSZ -> BNEFITSZ. V41CC02 2 * PASCAL-6000 VERSION 4.1.C. V41CC 1 * PASCAL-6000 VERSION 4.1.B. V41BC 1 * DEFINE SCOPE2 RECORD MANAGER ERROR ORDINALS. V41AC06 1 * KLUDGE: DEFINE SYMBOL *TXTEFET*. V41AC04 1 * INTRODUCE SYMBOLS *NOS1* AND *NOS2*; REMOVE SYMBOL *NOS*. V41AC01 1 * PASCAL-6000 VERSION 4.1.A. V41AC 1 * HCOMSPA 4 HCOMSPA 5 HCOMSPA 6 HCOMSPA 7 COMSPAS 14 ** COMSPAS DEFINES CONSTANTS USED THROUGHOUT THE COMSPAS 15 * PASCAL-6000 SYSTEM. THIS DECK IS CONSTRUCTED SO THAT IT COMSPAS 16 * MAY BE CALLED INTO EITHER A PASCAL OR COMPASS PROGRAM. COMSPAS 17 * *) COMSPAS 18 COMSPAS 19 COMSPAS 20 COMSPAS 21 (* COMSPAS 22 ** PASCAL-6000 RELEASE, VERSION, LEVEL. COMSPAS 23 * COMSPAS 24 * THE LEVEL NUMBER IS FOR USE BY LOCAL MAINTAINERS. COMSPAS 25 * *) COMSPAS 26 COMSPAS 27 COMSPAS 28 RELNUM = 37B ; (* RELEASE NUMBER = ORD('4') *) COMSPAS 29 VERNUM = 34B ; (* VERSION NUMBER = ORD('1') *) V41AC 2 LEVNUM = 33B ; (* VERSION NUMBER = ORD('F') *) V410C 2 ASCFLAG = 55B ; (* FULL-ASCII FLAG, OFF = ORD(' ') *) COMSPAS 32 LVERNUM = 33B ; (* LIBRARY VERSION NUMBER = ORD('0') *) COMSPAS 33 LLEVNUM = 33B ; (* LIBRARY LEVEL NUMBER = ORD('0') *) COMSPAS 34 COMSPAS 35 COMSPAS 36 COMSPAS 37 (* COMSPAS 38 ** DEFINE THE TARGET OPERATING SYSTEM. *) COMSPAS 39 COMSPAS 40 COMSPAS 41 KRONOS = 0 ; COMSPAS 42 NOS1 = 0 ; V41AC01 2 NOS2 = 0 ; V41AC01 3 NOSBE = 0 ; COMSPAS 44 SCOPE2 = 0 ; COMSPAS 45 SCOPE34 = 0 ; COMSPAS 46 COMSPAS 47 COMSPAS 48 COMSPAS 49 (* COMSPAS 50 ** DEFINE THE OPERATING SYSTEM ORDINALS. *) COMSPAS 51 COMSPAS 52 COMSPAS 53 XKRONOS = 1 ; COMSPAS 54 XNOS1 = 2 ; V41AC01 4 XNOS2 = 3 ; V41AC01 5 XNOSBE = 4 ; V41AC01 6 XSCOPE2 = 5 ; V41AC01 7 XSCOPE34 = 6 ; V41AC01 8 COMSPAS 59 COMSPAS 60 COMSPAS 61 (* COMSPAS 62 ** GENERAL CONSTANTS. *) COMSPAS 63 COMSPAS 64 COMSPAS 65 MARKLIM = 31 ; (* MAXIMUM MARK LEVEL *) COMSPAS 66 NILP = 377777B ; (* NIL POINTER *) COMSPAS 67 PFLC = 1 ; (* FIRST LOCATION IN ACTIVATION RECORDS *) COMSPAS 68 MPLC = PFLC ; (* FIRST LOCATION IN PROGRAM ACTIVATION *) COMSPAS 69 ARPS = 1 ; (* ACTIVATION-RECORD PREFIX SIZE *) COMSPAS 70 PMDSPACE = 120B ; (* SIZE OF STACK CHUNK FOR PMD *) COMSPAS 71 COMSPAS 72 COMSPAS 73 COMSPAS 74 (* COMSPAS 75 ** DATA SIZE CONSTANTS. *) COMSPAS 76 COMSPAS 77 COMSPAS 78 WORDSIZE = 60 ; (* NUMBER OF BITS IN ONE WORD *) COMSPAS 79 COMSPAS 82 (* V41CC16 2 * ASCII CHARACTER SET CONSTANTS. *) V41CC16 3 V41CC16 4 ASCHARSZ = 7 ; (* NUMBER OF BITS IN ASCII CHAR *) V41CC16 5 ASALFALN = 8 ; (* NUMBER OF ASCII CHARS IN WORD *) V41CC16 6 ASMINCH = 0 ; (* MINIMAL ORDINAL VALUE OF ASCII CHAR *) V41CC16 7 ASMAXCH = 127 ; (* MAXIMUM ORDINAL VALUE OF ASCII CHAR *) V41CC16 8 ASSPACE = 32 ; (* ASCII ORDINAL FOR ' ' *) V41CC16 9 ASONE = 49 ; (* ASCII ORDINAL FOR '1' *) V41CC16 10 V41CC16 11 (* V41CC16 12 * DISPLAY CODE CHARACTER SET CONSTANTS. *) V41CC16 13 V41CC16 14 DCCHARSZ = 6 ; (* NUMBER OF BITS IN DISPLAY CODE CHAR *) V41CC16 15 DCALFALN = 10 ; (* NUMBER OF DISPLAY CODE CHARS IN WORD *) V41CC16 16 DCMINCH = 0 ; (* MINIMUM VALUE OF DISPLAY CODE CHAR *) V41CC16 17 DCMAXCH = 63 ; (* MAXIMUM VALUE OF DISPLAY CODE CHAR *) V41CC16 18 DCSPACE = 45 ; (* DISPLAY CODE ORDINAL FOR ' ' *) V41CC16 19 DCONE = 28 ; (* DISPLAY CODE ORDINAL FOR '1' *) V41CC16 20 V41CC16 21 (* V41CC16 22 * CURRENT CHARACTER SET CONSTANTS. *) V41CC16 23 V41CC16 24 CHARSIZE = DCCHARSZ ; (* NUMBER OF BITS TO HOLD ONE CHAR *) V41CC16 25 ALFALENG = DCALFALN ; (* NUMBER OF CHARACTERS IN A WORD *) V41CC16 26 MINORDCH = DCMINCH ; (* MINIMUM ORDINAL VALUE OF A CHAR *) V41CC16 27 MAXORDCH = DCMAXCH ; (* MAXIMUM ORDINAL VALUE OF A CHAR *) V41CC16 28 CHSPACE = DCSPACE ; (* ORDINAL VALUE OF ' ' *) V41CC16 29 CHONE = DCONE ; (* ORDINAL VALUE OF '1' *) V41CC16 30 COMSPAS 85 COMSPAS 86 COMSPAS 87 (* COMSPAS 88 ** FET LENGTH CONSTANTS. *) COMSPAS 89 COMSPAS 90 COMSPAS 91 BINEFET = 1 ; (* RELATIVE ADDRESS OF WORD FILE EFET *) COMSPAS 92 TXTEFET = 13 ; (* RELATIVE ADDRESS OF TEXT FILE EFET *) V41CC02 3 TXEFETSZ = 28 ; (* TEXT EFET SIZE = TXTEFET + 1 + FETSZ *) V41CC02 4 BNEFETSZ = 16 ; (* WORD EFET SIZE = BINEFET + 1 + FETSZ *) V41CC02 5 FETSZ = 14 ; (* FET LENGTH *) COMSPAS 96 COMSPAS 97 COMSPAS 98 COMSPAS 99 (* COMSPAS 100 ** FIT LENGTH CONSTANTS. *) COMSPAS 101 COMSPAS 102 COMSPAS 103 TXEFITSZ = 32 ; (* TEXT EFET SIZE *) V41CC02 6 BNEFITSZ = 20 ; (* WORD EFET SIZE *) V41CC02 7 FITSZ = 16 ; (* FIT SIZE 7000 RM *) COMSPAS 106 COMSPAS 107 COMSPAS 108 COMSPAS 109 (* COMSPAS 110 ** EFET INDICES. COMSPAS 111 * COMSPAS 112 * THESE VALUES FORM OFFSETS FOR LOCATING THE VARIOUS COMSPAS 113 * FIELDS IN THE EFET. COMSPAS 114 * *) COMSPAS 115 COMSPAS 116 COMSPAS 117 EFETLCNT = -13 ; (* LINE COUNTER FOR TEXTFILES *) COMSPAS 118 EFETCBUF = -12 ; (* FWA OF 10-CHAR BUFFER *) COMSPAS 119 EFETSNTL = -2 ; (* END-OF-BUFFER SENTINEL *) COMSPAS 120 EFETPTR = -1 ; (* POINTER TO CURRENT ELEMENT *) COMSPAS 121 EFET = 0 ; (* ANCHOR FOR ALL OFFSETS *) COMSPAS 122 EFETFET = 1 ; (* FIRST WORD OF FET *) COMSPAS 123 EFETFRST = 2 ; (* FWA OF CIRCULAR BUFFER *) COMSPAS 124 EFETIN = 3 ; (* NEXT WORD TO PUT DATA INTO BUFFER *) COMSPAS 125 EFETOUT = 4 ; (* NEXT WORD TO GET DATA OUT OF BUFFER *) COMSPAS 126 EFETLIM = 5 ; (* LWA+1 OF CIRCULAR BUFFER *) COMSPAS 127 COMSPAS 128 COMSPAS 129 COMSPAS 130 (* COMSPAS 131 ** EFIT INDICES. *) COMSPAS 132 COMSPAS 133 COMSPAS 134 EFITBUF = 1 ; (* WSA BUFFER DESCRIPTOR *) COMSPAS 135 EFITOUT = 2 ; (* OUT POINTER *) COMSPAS 136 EFITIN = 2 ; (* IN POINTER *) COMSPAS 137 EFITFIT = 3 ; (* FIT *) COMSPAS 138 COMSPAS 139 COMSPAS 140 COMSPAS 141 (* COMSPAS 142 ** BIT-FIELD DEFINITIONS. COMSPAS 143 * COMSPAS 144 * THE VALUE OF EACH ENTRY IS THE BIT POSITION OF THAT FIELD COMSPAS 145 * IN THE WORD. FOR MULTIPLE-BIT FIELDS, THE COORDINATE OF COMSPAS 146 * THE RIGHTMOST BIT IS GIVEN. COMSPAS 147 * *) COMSPAS 148 COMSPAS 149 (* COMSPAS 150 * BIT-FIELDS IN EFET+EFETPTR. *) COMSPAS 151 COMSPAS 152 PEOLN = 59 ; (* EOLN FLAG FOR TEXTFILES *) COMSPAS 153 PREWRITE = 58 ; (* EQUIVALENT TO REWRITE IN EFET WORD *) COMSPAS 154 PPOINTER = 0 ; (* POINTER INTO CHARBUFF OR CIRC. BUFF *) COMSPAS 155 COMSPAS 156 (* COMSPAS 157 * BIT-FIELDS IN EFET. *) COMSPAS 158 COMSPAS 159 EEOSF = 59 ; (* EOS/EOF FLAG FOR SEG/NON-SEG. FILES *) COMSPAS 160 EEOF = 58 ; (* EOF FLAG *) COMSPAS 161 ESEGMENT = 57 ; (* SEGMENTED FILE *) COMSPAS 162 EREWRITE = 56 ; (* REWRITE FLAG FOR ALL FILES *) COMSPAS 163 ETEXT = 55 ; (* TEXT FILE *) COMSPAS 164 ETERMFIL = 54 ; (* TERMINAL FILE ('/' ON HEADER) *) COMSPAS 165 EPERSIST = 53 ; (* PERSISTENT FILE *) COMSPAS 166 ECONNECT = 52 ; (* FILE CONNECTED TO TERMINAL *) V41EC01 2 EPROGPAR = 51 ; (* PROGRAM PARAMETER *) COMSPAS 168 EDISPC = 51 ; (* DISPOSITION CODE (ALL OF ABOVE BITS) *) V41CC02 8 EDISPCW = 9 ; (* NUMBER OF BITS IN DISPOSITION CODE *) V41CC02 9 V41CC02 10 ELRL = 0 ; (* LOGICAL RECORD LENGTH *) COMSPAS 169 V41CC16 31 EDCCHS = 18 ; (* INDEX INTO DISPLAY CODE BUFFER (DCB) *) V41CC16 32 EDCCHSW = 18 ; (* WIDTH OF EDCCHS FIELD *) V41CC16 33 COMSPAS 170 EWSALEN = 18 ; (* ACTUAL LENGTH OF WSA *) COMSPAS 171 ERT = 36 ; (* RECORD TYPE *) V41DC09 2 ERTW = 6 ; (* NUMBER OF BITS IN RECORD TYPE *) V41CC02 11 COMSPAS 173 (* COMSPAS 174 * BIT-FIELDS IN EFET+EFITBUF. *) COMSPAS 175 COMSPAS 176 BUFEND = 0 ; (* LWA CURRENT RECORD *) COMSPAS 177 BUFADDR = 18 ; (* FWA WSA *) COMSPAS 178 BUFLEN = 36 ; (* USEABLE LENGTH OF WSA *) COMSPAS 179 COMSPAS 180 (* COMSPAS 181 * SCOPE2 RECORD MANAGER FIT VALUES. *) COMSPAS 182 COMSPAS 183 FPEOI = 64 ; (* END OF INFORMATION *) COMSPAS 184 FPEOP = 32 ; (* END OF PARTITION *) COMSPAS 185 FPEOS = 16 ; (* END OF SECTION *) COMSPAS 186 FPEOR = 8 ; (* END OF RECORD *) COMSPAS 187 FPBOI = 2 ; (* BEGIN OF INFORMATION *) COMSPAS 188 COMSPAS 189 (* COMSPAS 190 * SCOPE2 RECORD MANAGER RECORD TYPES. *) COMSPAS 191 COMSPAS 192 RTW = 0 ; (* CONTROL WORD *) COMSPAS 193 RTF = 1 ; (* FIXED LENGTH *) COMSPAS 194 RTZ = 3 ; (* ZERO BYTE TERMINATOR *) COMSPAS 195 RTU = 7 ; (* UNDEFINED RECORDS *) COMSPAS 196 RTS = 8 ; (* SYSTEM LOGICAL *) COMSPAS 197 COMSPAS 198 COMSPAS 199 COMSPAS 200 (* COMSPAS 201 ** P.GLOBL - TABLE OF GLOBAL VARIABLES. COMSPAS 202 * COMSPAS 203 * THIS TABLE INCLUDES RUN TIME SYSTEM VARIABLES THAT ARE COMSPAS 204 * MAINTAINED ACROSS THE ENTIRE EXECUTION OF A PASCAL PROGRAM. COMSPAS 205 * IN OTHER WORDS, THEY ARE GLOBAL WITH RESPECT TO THE USER COMSPAS 206 * PROGRAM. THESE VALUES ARE USED AS INDICES INTO THE COMSPAS 207 * TABLE NAMED *P.GLOBL*. COMSPAS 208 * *) COMSPAS 209 COMSPAS 210 COMSPAS 211 TGVRPMDS = 1 ; (* PMD STACK CHUNK; ZERO IF PMD DISABLED *) COMSPAS 212 (* 30/LWA+1, 30/FWA, IF PMD ENABLED *) COMSPAS 213 TGVRKEY = 2 ; (* KEY FOR POINTER CHECKS *) COMSPAS 214 TGVRFORT = 3 ; (* FORTRAN CALL FLAG *) COMSPAS 215 (* 1/FTNFLAG, 41/, 18/LINENUM *) COMSPAS 216 TGVRPTRS = 4 ; (* FOR SAVING GLOBAL POINTERS *) COMSPAS 217 (* 6/0, 18/B4, 18/B5, 18/B6 *) COMSPAS 218 COMSPAS 219 COMSPAS 220 COMSPAS 221 (* COMSPAS 222 ** P.PIT - PROGRAM INFORMATION TABLE. COMSPAS 223 * COMSPAS 224 * THIS TABLE, WHICH RESIDES IN THE CODE SPACE OF THE MAIN COMSPAS 225 * PROGRAM, IS USED TO PASS PARAMETERS FROM THE COMPILER TO THE COMSPAS 226 * RUN-TIME SYSTEM. THESE CONSTANTS ARE USED AS INDICES INTO COMSPAS 227 * THE TABLE NAMED "P.PIT". COMSPAS 228 * *) COMSPAS 229 COMSPAS 230 COMSPAS 231 PITVERS = 1 ; (* PASCAL-6000 VERSION INFORMATION *) COMSPAS 232 PITMAIN = 2 ; (* MAIN-PROGRAM BHW AND ACTIVATION *) COMSPAS 233 PITFLAG = 3 ; (* PROGRAM DESCRIPTION FLAGS *) COMSPAS 234 PITPMD = 4 ; (* ADDRESS OF PASCPMD *) COMSPAS 235 PITOUTP = 4 ; (* ADDRESS OF OUTPUT EFET *) COMSPAS 236 PITIDS = 5 ; (* INITIAL DYN. SPACE, INITIAL REDUCE *) COMSPAS 237 PITMFL = 5 ; (* MAXIMUM SIZE OF DYNAMIC MEMORY *) COMSPAS 238 PITSCS = 6 ; (* STACK-CHUNK CONTROLS *) COMSPAS 239 PITMCS = 7 ; (* MEMORY MANAGER CONTROLS *) COMSPAS 240 COMSPAS 241 COMSPAS 242 COMSPAS 243 (* COMSPAS 244 ** P.TERA - TABLE OF ERROR RECOVERY ADDRESSES. COMSPAS 245 * COMSPAS 246 * THESE VALUES ARE INDICES INTO P.TERA, THE TABLE OF ERROR COMSPAS 247 * RECOVERY ADDRESSES. COMSPAS 248 * *) COMSPAS 249 COMSPAS 250 COMSPAS 251 ASSERR = 0 ; (* VALUE OUT OF RANGE *) COMSPAS 252 INXERR = 1 ; (* INDEX OR CASE EXPR OUT OF RANGE *) COMSPAS 253 DIVERR = 2 ; (* DIVISION BY ZERO *) COMSPAS 254 ICNERR = 3 ; (* INCONSISTENT NODE REFERENCE *) COMSPAS 255 OVLERR = 4 ; (* INTEGER OVERFLOW *) COMSPAS 256 PTRERR = 5 ; (* INCORRECT POINTER REFERENCE *) COMSPAS 257 MODERR = 6 ; (* MOD BY NON-POSITIVE MODULO *) COMSPAS 258 EOLERR = 7 ; (* TRIED TO CHECK EOLN WHILE AT EOS/EOF *) COMSPAS 259 ISMERR = 8 ; (* MEMORY REQUIRED EXCEEDS SPECIFIED MFL *) COMSPAS 260 COMSPAS 261 COMSPAS 262 COMSPAS 263 (* COMSPAS 264 ** P.TMEM - TABLE OF MEMORY MANAGER VARIABLES. COMSPAS 265 * COMSPAS 266 * THIS TABLE CONTAINS THE VARIABLES USED BY THE PASCAL-6000 COMSPAS 267 * MEMORY MANAGER (PMM). THESE CONSTANTS ARE USED AS INDICES COMSPAS 268 * INTO THE TABLE NAMED "P.TMEM". COMSPAS 269 * *) COMSPAS 270 COMSPAS 271 COMSPAS 272 MEMFL = 1 ; (* CURRENT FIELD LENGTH *) COMSPAS 273 MEMFF = 2 ; (* ADDRESS OF FIRST FREE NODE *) COMSPAS 274 MEMLF = 3 ; (* ADDRESS OF LAST FREE NODE *) COMSPAS 275 MEMHLF = 4 ; (* HIGHEST ADDRESS OF LAST FREE NODE *) COMSPAS 276 MEMHFL = 5 ; (* HIGHEST FL USED BY MEMORY MANAGER *) COMSPAS 277 COMSPAS 278 COMSPAS 279 COMSPAS 280 (* COMSPAS 281 ** TIOE - TABLE OF INPUT/OUTPUT ERRORS. COMSPAS 282 * COMSPAS 283 * THESE VALUES ARE USED AS INDICES INTO THE TABLE NAMED COMSPAS 284 * *TIOE*. COMSPAS 285 * *) COMSPAS 286 COMSPAS 287 COMSPAS 288 IOEA = 0 ; (* LINELIMIT EXCEEDED ON XXXXXXX.*) COMSPAS 289 IOEB = 1 ; (* TRIED TO READ XXXXXXX PAST EOS/EOF.*) COMSPAS 290 IOEC = 2 ; (* TRIED TO WRITE XXXXXX WITHOUT REWRITE.*) COMSPAS 291 IOED = 3 ; (* BUFFER TOO SMALL ON XXXXXXX.*) COMSPAS 292 IOEE = 4 ; (* NON-DIGIT FOUND WHILE READING XXXXXXX.*) COMSPAS 293 IOEF = 5 ; (* VALUE TOO LARGE WHILE READING XXXXXXX.*) COMSPAS 294 IOEG = 6 ; (* TRIED TO READ XXXXXXX WITHOUT RESET.*) COMSPAS 295 IOEH = 7 ; (* UNDEFINED VALUE TO WRITE ON XXXXXXX. *) COMSPAS 296 V41AC06 2 (* V41AC06 3 ** SCOPE2 RECORD MANAGER ERRORS. *) V41AC06 4 V41AC06 5 RMIOEA = 0 ; (* RECORD MAN ERROR ON FILE XXXXXXX. *) V41AC06 6 RMIOEB = 1 ; (* BUFFER TOO SMALL ON XXXXXXX. *) V41AC06 7 RMIOEC = 2 ; (* FILE XXXXXXX MUST BE FO=SQ,RT=W,S,Z,U.*) V41AC06 8 RMIOED = 3 ; (* FILE CARD SPECIFIES MRL>PASCAL BUFFER.*) V41AC06 9 RMIOEE = 4 ; (* INVALID RT FOR SKIP ON XXXXXXX. *) V41AC06 10 RMIOEH = 5 ; (* ZERO SKIP COUNT ON XXXXXXX. *) V41AC06 11 COMSPAS 297 COMSPAS 298 COMSPAS 299 (* COMSPAS 300 ** TYPE CODES FOR POST-MORTEM DUMP. COMSPAS 301 *) COMSPAS 302 COMSPAS 303 PMDINT = 1 ; (* INTEGER *) COMSPAS 304 PMDREAL = 2 ; (* REAL *) COMSPAS 305 PMDCHAR = 3 ; (* CHAR *) COMSPAS 306 PMDBOOL = 4 ; (* BOOLEAN *) COMSPAS 307 PMDENUM = 5 ; (* ENUMERATED TYPE *) COMSPAS 308 PMDALFA = 6 ; (* ALFA *) COMSPAS 309 PMDUPTR = 7 ; (* UNCHECKED POINTER *) COMSPAS 310 PMDCPTR = 8 ; (* CHECKED POINTER *) COMSPAS 311 COMSPAS 312 COMSPAS 313 (* COMSPAS 314 BASE * COMSPAS 315 ENDX *) COMSPAS 316 (*$L'GLOBAL TYPE DECLARATIONS.' *) COMP 122 COMP 123 COMP 124 TYPE (*DESCRIBING:*) COMP 125 (*************) COMP 126 COMP 127 COMP 128 (*BASIC SYMBOLS*) COMP 129 (***************) COMP 130 COMP 131 SYMBOL = (IDENT,INTCONST,REALCONST,CHARCONST,STRINGCONST,NOTSY,NILSY, COMP 132 MULOP,ADDOP,RELOP,LPARENT,RPARENT,LBRACK,RBRACK,COMMA,SEMICOLON, COMP 133 PERIOD,ARROW,COLON,BECOMES,DOTDOT,LABELSY,CONSTSY,TYPESY,VARSY, COMP 134 FUNCTIONSY,PROCEDURESY,SETSY,PACKEDSY,ARRAYSY,RECORDSY,FILESY, COMP 135 BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,FORSY,WITHSY, COMP 136 GOTOSY,ENDSY,ELSESY,UNTILSY,OFSY,DOSY,TOSY,DOWNTOSY, COMP 137 THENSY,PROGRAMSY,SEGMENTEDSY,OTHERWISESY,VALUESY,OTHERSY); COMP 138 OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP,GEOP, COMP 139 GTOP,NEOP,EQOP,INOP,NOOP); COMP 140 SETOFSYS = SET OF SYMBOL; COMP 141 COMP 142 (*CONSTANTS*) COMP 143 (***********) COMP 144 COMP 145 CODERANGE = 0..CODEMAX; COMP 146 POSRANGE = 1..4; COMP 147 ADDRRANGE = 0..MAXADDR; COMP 148 ADDRFIELD = -377777B..777777B; COMP 149 SHRTINT = -377777B..377777B; COMP 150 CSTCLASS = (INT,BOOL,REEL,PSET,STRG); COMP 151 CSP = ^ CSTHEADREC; COMP 152 LOCOFREF = ^ LOCREC; COMP 153 CTAILP = ^ CSTTAILREC; COMP 154 CSTHEADREC = PACKED RECORD NXTCSP: CSP; COMP 155 CSTP: CTAILP; COMP 156 CREF: LOCOFREF COMP 157 END; COMP 158 CSTTAILREC = RECORD NXTCSP: CTAILP; CSVAL: INTEGER END; COMP 159 ERRINDEX = 1 .. ERRMAX; COMP 160 ERLISTT = PACKED ARRAY [ERRINDEX] OF BOOLEAN; COMP 161 COMP 162 VALU = RECORD CASE CSTCLASS OF COMP 163 INT: (IVAL: INTEGER); COMP 164 BOOL: (BVAL: BOOLEAN); COMP 165 REEL: (RVAL: REAL); COMP 166 PSET: (PVAL: SET OF 0..58); (*IMPL. DEPENDANT RANGE*) COMP 167 STRG: (VALP: CTAILP) COMP 168 END; COMP 169 COMP 170 (*DATA STRUCTURES*) COMP 171 (*****************) COMP 172 COMP 173 LEVRANGE = 0..MAXLEVEL; COMP 174 BITRANGE = 0..59 (*=WORDSIZE-1*); COMP 175 SHIFTRANGE = -59..59; V41AC08 11 EPWRANGE = 1..60 (*=WORDSIZE*); COMP 176 STRUCTFORM = (* BASIC STRUCTURE FORMS. ORDERING OF THESE CONSTANTS COMP 177 IS CRITICAL TO SEMANTIC ANALYSIS IN THE COMPILER. *) COMP 178 (SCALAR,SUBRANGE,REALS,POINTER,POWER,ARRAYS,RECORDS,FILES, COMP 179 FIELDLISTS,VARIANTPART,BOUNDDESC); V41CC07 20 DECLKIND = (PREDECLARED,USERDECLARED); COMP 181 WBSIZE = PACKED RECORD WORDS: ADDRRANGE; COMP 182 BITS: BITRANGE COMP 183 END; COMP 184 CCP = ^ CASECONSTREC; V41CC07 21 STP = ^ STRUCTREC; COMP 185 CTP = ^ IDENTREC; COMP 186 COMP 187 CASECONSTREC = PACKED RECORD V41CC07 22 CCMAX,CCMIN: INTEGER; V41CC07 23 NEXTCC,THREAD: CCP; V41CC07 24 CASE BOOLEAN OF V41CC07 25 TRUE: (CCVAR: STP); V41CC07 26 FALSE: (CCADDR: ADDRRANGE) V41CC07 27 END; V41CC07 28 V41CC07 29 STRUCTREC = PACKED RECORD COMP 188 FTYPE: BOOLEAN; COMP 189 SIZE: WBSIZE; COMP 190 CASE FORM: STRUCTFORM OF COMP 191 SCALAR: (CASE SCALKIND: DECLKIND OF COMP 192 PREDECLARED: (); COMP 193 USERDECLARED: (FCONST: CTP)); COMP 194 SUBRANGE: (RANGETYPE: STP; MIN,MAX: VALU); COMP 195 REALS: (); COMP 196 POINTER: (ELTYPE: STP; DBG: BOOLEAN); COMP 197 POWER: (PCKDSET: SET OF (UNPCKD, PCKD); ELSET: STP); COMP 198 ARRAYS: (AELTYPE,INXTYPE: STP; COMP 199 CONFORMANT: BOOLEAN; DESCADDR: ADDRRANGE; COMP 200 CASE PCKDARR: BOOLEAN OF COMP 201 FALSE: (); COMP 202 TRUE: (CASE PARTWORDELS: BOOLEAN OF COMP 203 FALSE: (); COMP 204 TRUE: (ELSPERWORD: 2..60))); COMP 205 RECORDS: (PCKDREC: BOOLEAN; FIELDIDTREE: CTP; V41CC07 30 FIELDLST: STP); V41CC07 31 FILES: (PCKDFIL,TEXTFILE,SEGFILE: BOOLEAN; COMP 208 BSIZE : ADDRRANGE; COMP 209 BASEFILE: STP; COMP 210 FILTYPE: STP); COMP 211 FIELDLISTS: (FIXEDPART: CTP; VARPART,NXTFLDLST: STP); V41CC07 32 VARIANTPART: (TAGFIELDID: CTP; TAGVALUELIST: CCP; V41CC07 33 TAGTYPE,VARIANTLIST,COMPLETER: STP); V41CC07 34 BOUNDDESC:(BOUNDTYPE: STP; LOWBOUND,HIGHBOUND: CTP) COMP 215 END; COMP 216 COMP 217 EXTIDP = ^ EXTID; COMP 218 EXTREFP = ^ EXTREF; COMP 219 EXTREF = PACKED RECORD LOC: 0..7777777777B; LINK: EXTREFP END; COMP 220 EXTID = PACKED RECORD COMP 221 EXID: ALFA; L,R: EXTIDP; REF: EXTREFP COMP 222 END; COMP 223 COMP 224 (*NAMES*) COMP 225 (*******) COMP 226 COMP 227 KEYWORD = (* STANDARD AND PRE-DEFINED IDENTIFIERS AND DIRECTIVES *) COMP 228 (* PROCEDURES: *) COMP 229 (GETKW,PUTKW,RESETKW,REWRITEKW,READKW,READLNKW,WRITEKW, COMP 230 WRITELNKW,PAGEKW,PACKKW,UNPACKKW,NEWKW,DISPOSEKW, COMP 231 (* FUNCTIONS: *) COMP 232 EOFKW,EOLNKW,ODDKW,ROUNDKW,TRUNCKW,ABSKW,SQRKW,ORDKW, COMP 233 CHRKW,PREDKW,SUCCKW,SINKW,COSKW,ARCTANKW,EXPKW,SQRTKW,LNKW, COMP 234 (* ADDITIONAL, PRE-DEFINED PROCEDURES: *) COMP 235 GETSEGKW,PUTSEGKW,GETFILEKW,PUTFILEKW, V41AC15 8 MNEWKW,MARKKW,RELEASEKW, COMP 237 MESSAGEKW,TIMEKW,DATEKW,HALTKW, COMP 238 (* ADDITIONAL, PRE-DEFINED FUNCTIONS: *) COMP 239 EOSKW,EOIKW, V41AC15 9 UNDEFINEDKW,EXPOKW,CARDKW,CLOCKKW, V41AC15 10 RELVALUEKW, V410C01 7 (* CONSTANTS: *) COMP 241 FALSEKW,TRUEKW,MAXINTKW, COMP 242 (* ADDITIONAL, PRE-DEFINED CONSTANTS: *) COMP 243 COLKW,PERKW, COMP 244 (* TYPES: *) COMP 245 INTEGERKW,REALKW,CHARKW,BOOLEANKW,TEXTKW, COMP 246 (* ADDITIONAL, PRE-DEFINED TYPES: *) COMP 247 ALFAKW,MARKERKW, COMP 248 (* VARIABLES: *) COMP 249 INPUTKW,OUTPUTKW, COMP 250 (* COMPILER DIRECTIVES: *) COMP 251 FORWARDKW,EXTERNALKW,FORTRANKW); COMP 252 IDCLASS = (TYPES,KONST,VARS,BOUNDID, COMP 253 FIELD,TAGFIELD,PROC,FUNC,UNKNOWNID); COMP 254 SETOFIDS = SET OF IDCLASS; COMP 255 IDKIND = (ACTUAL,FORMAL); COMP 256 ORDERING = (LESSTHAN,EQUALTO,GREATERTHAN); COMP 257 PFDECLCLASS = (DECL,FORWDECL,FORWDECLERR,EXTDECL,FTNDECL); V41CC20 11 ACCESSKIND = (DRCT,INDRCT,INXD); COMP 259 DRCTINDRCT = DRCT..INDRCT; COMP 260 SCOPERANGE = 0..SCOPEMAX; COMP 261 COMP 262 IDSEGMENT = ^ IDNAMEEXT; COMP 263 IDNAME = RECORD COMP 264 TEN: ALFA; COMP 265 EXT: IDSEGMENT COMP 266 END; COMP 267 IDNAMEEXT = PACKED RECORD COMP 268 SEVEN: PACKED ARRAY [1..IDNAMEEXTLEN] OF CHAR; COMP 269 EXTRA: IDSEGMENT COMP 270 END; COMP 271 IDENTREC = PACKED RECORD COMP 272 NAME: IDNAME; LLINK: CTP; RLINK: CTP; COMP 273 IDTYPE: STP; NEXT: CTP; COMP 274 LASTUSESCOPE: SCOPERANGE; COMP 275 CASE KLASS: IDCLASS OF COMP 276 KONST: (VALUES: VALU); COMP 277 TYPES: (); COMP 278 VARS: (VKIND: IDKIND; VARPARAM: BOOLEAN; COMP 279 VACCESS: DRCTINDRCT; VLEV: LEVRANGE; COMP 280 VADDR: ADDRRANGE; VINIT: BOOLEAN; COMP 281 FIRSTINPARMGROUP,CONFORMNT, COMP 282 THREAT,CONTROLVAR: BOOLEAN); COMP 283 BOUNDID:(BLEV: LEVRANGE; BADDR: ADDRRANGE); COMP 284 TAGFIELD, COMP 285 FIELD: (FLDADDR: ADDRRANGE; COMP 286 CASE PCKDFLD: BOOLEAN OF COMP 287 FALSE: (); COMP 288 TRUE: (BITADDR: BITRANGE)); COMP 289 PROC, COMP 290 FUNC: (CASE PFDECKIND: DECLKIND OF COMP 291 PREDECLARED: (KEY: KEYWORD); COMP 292 USERDECLARED: (PFLEV: LEVRANGE; COMP 293 PFXOPT: 0..MAXPARAMSINREGS; COMP 294 PARAMLIST: CTP; COMP 295 CASE PFKIND: IDKIND OF COMP 296 ACTUAL: (PFDECL: PFDECLCLASS; COMP 297 FIRSTVAR: ADDRRANGE; COMP 298 EPT: ALFA); COMP 299 FORMAL: (PFADDR: ADDRRANGE))); COMP 300 UNKNOWNID: () COMP 301 END; COMP 302 COMP 303 EXTFILEP = ^ FILEREC; COMP 304 FILEREC = PACKED RECORD COMP 305 FILENAME: ALFA; COMP 306 FILECP: CTP; COMP 307 NXTP: EXTFILEP; COMP 308 TERMINAL: BOOLEAN; COMP 309 SYSLOC: 1..63B V41DC06 11 END; COMP 311 COMP 312 DISPRANGE = -1 .. DISPLIMIT; COMP 313 WHERE = (BLCK,DREC,PFPAR,WREC); COMP 314 COMP 315 COMP 316 (*LABELS*) COMP 317 (********) COMP 318 COMP 319 LBP = ^LABREC; COMP 320 LABREC = PACKED RECORD COMP 321 LABVAL: INTEGER; EPT: ALFA; COMP 322 NEXTLAB: LBP; LABLEV: LEVRANGE; COMP 323 ACCESSIBLE: BOOLEAN; LABSTMTLEVEL: ADDRRANGE; COMP 324 CASE DEFINED: BOOLEAN OF COMP 325 TRUE: (LABADDR: ADDRRANGE); COMP 326 FALSE: (FSTOCC: LOCOFREF) COMP 327 END; COMP 328 COMP 329 COMP 330 (*FILES:*) COMP 331 (********) COMP 332 COMP 333 SEGTEXT = SEGMENTED TEXT; COMP 334 LGOFILE = SEGMENTED FILE OF INTEGER; COMP 335 COMP 336 COMP 337 (*FOR CODE GENERATION*) COMP 338 (*********************) COMP 339 COMP 340 OPCODE = (PS,RJ,JP,TESTX,EQ,NE,GE,LT,BXX,BXXTX,BXXPX,BXXMX,BXCX, COMP 341 BXXTCX,BXXPCX,BXXMCX,LXJK,AXJK,LXBX,AXBX,NXBX,ZXBX,UXBX,PXBX, COMP 342 FXXPX,FXXMX,DXXPX,DXXMX,RXXPX,RXXMX,IXXPX,IXXMX,FXXTX,RXXTX, COMP 343 DXXTX,MXJK,FXXDX,RXXDX,NO,CXX,SAAPK,SABPK,SAXPK,SAXPB,SAAPB, COMP 344 SAAMB,SABPB,SABMB,SBAPK,SBBPK,SBXPK,SBXPB,SBAPB,SBAMB,SBBPB, COMP 345 SBBMB,SXAPK,SXBPK,SXXPK,SXXPB,SXAPB,SXAMB,SXBPB,SXBMB); COMP 346 CONDITION = (ZR,NZ,PL,NG,XIR,XOR,XDF,XID); COMP 347 RELOCATION = (ABSR,UNUSEDR,PROGR,NEGPROGR,VARR,GLOBLR,TERAR,TMEMR); COMP 348 EXTERNALNAME = (* RUNTIME-SYSTEM PROCEDURE/FUNCTION EXTERNAL NAMES *) COMP 349 (GETBEX,PUTBEX,GETCEX,PUTCEX,GETCHEX,PUTCHEX,GETLNEX,PUTLNEX, COMP 350 RDIEX,RDREX,WRFEX,WRIEX,WREEX,WRCEX,WRCDEX,WRBEX,WRSEX,PAGEEX, COMP 351 RESETEX,REWRTEX,RWRTSEX,GETSEX,PUTSEX, COMP 352 GETFEX,PUTFEX,EOIEX, V41AC15 11 NEWEX,NEWDEX,DISPEX,DISPDEX,MNEWEX,MNEWDEX,MARKEX,RELEASEEX, COMP 353 CLOCKEX,TIMEEX,DATEEX,MSGEX,HALTEX, COMP 354 SINCOEX,EXPEX,SQRTEX,LNEX,ATANEX, COMP 355 (* OTHER RUNTIME-SYSTEM ENTRY POINTS *) COMP 356 PITEX, COMP 357 ACVEX,CPVEX,PEGEX,PENEX,PEXEX,SCOEX,VPEEX, COMP 358 CFVEX,DFVEX, COMP 359 ENDEX,GTOEX,INITEX,INVEX, COMP 360 EEREX, COMP 361 RPEEX,SPEEX, COMP 362 (* MEMORY MANAGER ENTRY POINTS *) COMP 363 ALMEX,LIMEX, COMP 364 (* PASCAL LIBRARY ENTRY POINTS *) COMP 365 PMDEX,MVEEX); COMP 366 COMP 367 BOOLCOL = ARRAY[BOOLEAN] OF OPCODE; COMP 368 BOOLROW = ARRAY[BOOLEAN] OF BOOLCOL; COMP 369 BOOLARRAY = ARRAY[BOOLEAN] OF BOOLROW; COMP 370 REGTYPE = (REGA,REGX); COMP 371 SETTYPE = (APK,BPK,XPK,XPB,APB,AMB,BPB,BMB); COMP 372 SETTABL = ARRAY[SETTYPE,REGTYPE] OF OPCODE; COMP 373 INCOPRANGE = SAAPK..SXBMB; COMP 374 COMP 375 COMP 376 (*TO DESCRIBE EXPRESSION CURRENTLY COMPILED*) COMP 377 (*******************************************) COMP 378 COMP 379 ATTRKIND = (CST,VARBL,COND,EXPR); COMP 380 REGKIND = (NONE,XREG); COMP 381 REGNR = 0..7; COMP 382 COMP 383 ATTR = RECORD TYPTR: STP; COMP 384 CASE KIND: ATTRKIND OF COMP 385 CST: (CVAL: VALU); COMP 386 VARBL: (WORDACC: ACCESSKIND; TAGF: BOOLEAN; COMP 387 VLEVEL: LEVRANGE; CWDISPL: SHRTINT; COMP 388 VWDISPL: REGNR; COMP 389 DCLPCKD: BOOLEAN; COMP 390 CASE PCKD: BOOLEAN OF COMP 391 FALSE: (); COMP 392 TRUE: (CBDISPL: SHRTINT; COMP 393 BITREG: REGKIND; VBDISPL: REGNR)); COMP 394 COND: (CDR: REGNR; CONDCD: ZR..NG); COMP 395 EXPR: (EXPREG: REGNR) COMP 396 END; COMP 397 COMP 398 COMP 399 (*TO DESCRIBE REGISTER STATUS*) COMP 400 (*****************************) COMP 401 COMP 402 ARGSTR = (SIMPADDR,INDADDR,UNSPECADDR); COMP 403 XRGSTR = (AVAIL,SHRTCST,LONGCST,SIMPVAR,INDVAR,OTHER); COMP 404 REMXRG = SHRTCST..INDVAR; COMP 405 COMP 406 ARGSTAT = COMP 407 PACKED RECORD CASE ACONT: ARGSTR OF COMP 408 UNSPECADDR: (); COMP 409 SIMPADDR, COMP 410 INDADDR: (ADISPL: ADDRRANGE; COMP 411 CASE ARGSTR OF COMP 412 UNSPECADDR: (); COMP 413 SIMPADDR: (ALEV: LEVRANGE); COMP 414 INDADDR: (AREG: REGNR)) COMP 415 END; COMP 416 COMP 417 XRGSTAT = COMP 418 PACKED RECORD COMP 419 CASE XCONT: XRGSTR OF COMP 420 AVAIL: (); COMP 421 SHRTCST,LONGCST, COMP 422 SIMPVAR,INDVAR, COMP 423 OTHER: COMP 424 (REFNR: 0..100; LASTREF: ADDRRANGE; COMP 425 CASE REMXRG OF COMP 426 SHRTCST: COMP 427 (CSTVAL: SHRTINT); COMP 428 LONGCST: COMP 429 (CPTR: CTAILP); COMP 430 SIMPVAR, COMP 431 INDVAR: COMP 432 (SHFTCNT: BITRANGE; COMP 433 CASE DRCTINDRCT OF COMP 434 DRCT: COMP 435 (XLEV: LEVRANGE; XADDR: ADDRRANGE; COMP 436 VPADDR: BOOLEAN); COMP 437 INDRCT: COMP 438 (XREG: REGNR; XDISPL: ADDRRANGE))) COMP 439 END; COMP 440 COMP 441 ARGSTATUS = ARRAY [REGNR] OF ARGSTAT; COMP 442 XRGSTATUS = ARRAY [REGNR] OF XRGSTAT; COMP 443 BRGSTATUS = SET OF REGNR; (* SET OF FREE B-REGISTERS *) COMP 444 COMP 445 REGMAP = RECORD COMP 446 XMAP: XRGSTATUS; AMAP: ARGSTATUS COMP 447 END; COMP 448 COMP 449 BASREGS = ARRAY [LEVRANGE] OF REGNR; COMP 450 COMP 451 COMP 452 PLACE = PACKED RECORD SIX: ADDRRANGE; COMP 453 CIX: CODERANGE; CP: POSRANGE COMP 454 END; COMP 455 COMP 456 LOCREC = PACKED RECORD NXTREF: LOCOFREF; LOC: PLACE END; COMP 457 V41DC05 194 V41DC05 195 (*CONTROL STATEMENT PROCESSING*) V41DC05 196 (******************************) V41DC05 197 V41DC05 198 DSKIND = (P6000,ANSI,ISO0,ISO1); V41DC05 199 SETOFA2Z = SET OF 'A'..'Z'; V41DC05 200 CH7 = PACKED ARRAY [1..7] OF CHAR; V41DC05 201 ARGUMENT = (* CONTROL STATEMENT ARGUMENT *) V41DC05 202 PACKED RECORD V41DC05 203 N : CH7; (* NAME *) V41DC05 204 D : 0..777777B; (* DELIMITER *) V41DC05 205 END; V41DC05 206 ARGLIST = ARRAY [1..MAXFILES] OF ARGUMENT; V41DC05 207 V41DC05 208 CSPARAMS = (IPM, LPM, BPM, EPM, DSPM, GOPM, V41DC05 209 PDPM, PSPM, PLPM, REWPM, NOPM); V41DC05 210 CSPINDEX = 0..MAXCSPNAME; V41DC05 211 CSPARAMREC = (* CONTROL STATEMENT PARAMETER RECORD *) V41DC05 212 PACKED RECORD V41DC05 213 PNAME : CH7; V41DC05 214 SETTING : CSPINDEX; (* PARAM DEFAULT AND SETTING *) V41DC05 215 ALTDEF : CSPINDEX; (* ALTERNATE DEFAULT *) V41DC05 216 ALLOWEQ : BOOLEAN; (* ALLOW EQUIVALENCED PARAM *) V41DC05 217 ALLOWNE : BOOLEAN; (* ALLOW KEYWORD ALONE *) V41DC05 218 USED : BOOLEAN; (* PARAMETER USAGE FLAG *) V41DC05 219 END; V41DC05 220 V41DC05 221 OPTIONBLOCK = V41DC05 222 RECORD V41DC05 223 SOURCEFN : CH7; (* SOURCE FILE NAME *) V41DC05 224 OUTPUTFN : CH7; (* OUTPUT (LISTING) FILE NAME *) V41DC05 225 BINARYFN : CH7; (* LGO (BINARY) FILE NAME *) V41DC05 226 ERRORFN : CH7; (* ERROR OUTPUT FILE NAME *) V41DC05 227 REWINDF : SETOFA2Z; (* FILES (ILBE) TO REWIND *) V41DC05 228 LOADANDGO : BOOLEAN; (* LOAD AND EXECUTE BINARY *) V41DC05 229 EIGHTLPI : BOOLEAN; (* EIGHT LPI PAGE DENSITY *) V41DC05 230 PAGESIZE : INTEGER; (* LISTING PAGE SIZE *) V41DC05 231 LINELIMIT : INTEGER; (* OUTPUT FILE LINE LIMIT *) V41DC05 232 DIALECT : DSKIND; (* DIALECT SELECTION *) V41DC05 233 END; V41DC05 234 V41DC05 235 PAGESIZEREC = V41DC05 236 RECORD V41DC05 237 PD : INTEGER; (* PAGE DENSITY *) V41DC05 238 PS : INTEGER; (* PAGE LENGTH *) V41DC05 239 PW : INTEGER; (* PAGE WIDTH *) V41DC05 240 END; V41DC05 241 COMP 458 COMP 459 (*MISCELLANEOUS*) COMP 460 (***************) COMP 461 COMP 462 DOUBLE = RECORD UPPER: REAL; LOWER: REAL END; COMP 463 PMDKIND = (PMDON,PMDOFF,PMDSUPPRESS,PMDNONE); COMP 464 LINEBUFFER = ARRAY[1..MAXLINELEN] OF CHAR; COMP 465 COMP 466 TITLEBUFFER = PACKED ARRAY[1..MAXTITLE] OF CHAR; COMP 467 COMP 468 LANGUAGEKIND = (ENGLISH, FRENCH, GERMAN, USERDL); COMP 469 (*$L'GLOBAL VARIABLE DECLARATIONS.' *) COMP 484 COMP 485 COMP 486 VAR COMP 487 (*RETURNED BY SOURCE PROGRAM SCANNER COMP 488 INSYMBOL: COMP 489 **********) COMP 490 COMP 491 SOURCE: SEGTEXT; (*SOURCE PROGRAM FILE*) COMP 492 SY: SYMBOL; (*LAST SYMBOL*) COMP 493 OP: OPERATOR; (*CLASSIFICATION OF LAST SYMBOL*) COMP 494 IVAL: INTEGER; (*VALUE OF LAST INTEGER CONSTANT*) COMP 495 RVAL: REAL; (*VALUE OF LAST REAL CONSTANT*) COMP 496 CONSTP: CTAILP; (*POINTER TO LAST STRING*) COMP 497 LGTH: INTEGER; (*LENGTH OF LAST STRING CONSTANT*) COMP 498 ID: IDNAME; (*LAST IDENTIFIER*) COMP 499 IDSTART,IDEND, COMP 500 IDBREAK: IDSEGMENT; (*POINTERS TO ID EXTENSION*) COMP 501 EMPTYID: IDNAME; (*USED TO INITIALIZE IDS*) COMP 502 CH: CHAR; (*LAST CHARACTER*) COMP 503 COMP 504 COMP 505 (*COUNTERS:*) COMP 506 (***********) COMP 507 COMP 508 LC,IC: INTEGER; (*DATA LOCATION AND INSTR CNTER*) COMP 509 LABCNT: 0..MAXEXTLABCNT; (*NUMBER OF EXTERNAL LABELS*) V41AC03 7 EXTFILS: 0..MAXFILES; (*NUMBER OF EXTERNAL FILES*) V41AC02 8 PCNT: INTEGER; (*NUMBER OF PROCEDURES/FUNCTIONS*) COMP 512 COMP 513 COMP 514 (*SWITCHES:*) COMP 515 (***********) COMP 516 COMP 517 DP, (*DECLARATION PART*) COMP 518 TOPEXPR: BOOLEAN; (*TOP LEVEL EXPRESSION FLAG*) COMP 519 INTYPEDEFINITION: BOOLEAN; (*PARSING A TYPE DEFINTION*) COMP 520 LINENUMBERS: BOOLEAN; COMP 521 COMP 522 COMP 523 (*POINTERS:*) COMP 524 (***********) COMP 525 COMP 526 MARKERPTR, COMP 527 INTPTR,REALPTR,CHARPTR,ALFAPTR,STEXTPTR, COMP 528 BOOLPTR,NILPTR,TEXTPTR: STP; (*POINTERS TO PREDECLARED TYPES*) COMP 529 UTYPPTR,UCSTPTR,UVARPTR, COMP 530 UFLDPTR,UPRCPTR,UFCTPTR, (*POINTERS TO ENTRIES FOR UNDECL IDS*) COMP 531 INPUTPTR,OUTPUTPTR, (*ENTRIES FOR INPUT AND OUTPUT*) COMP 532 PMDFILEPTR, (*ENTRY FOR ALTERNATE PMD FILE*) V41DC06 12 FWPTR: CTP; (*HEAD OF CHAIN OF FORW TYPE IDS*) COMP 533 FSTLABP: LBP; (*HEAD OF LABEL CHAIN*) COMP 534 FEXFILP: EXTFILEP; (*HEAD OF LIST OF EXTERNAL FILES*) COMP 535 FSTCSP: CSP; (*HEAD OF CONSTANT CHAIN*) COMP 536 COMP 537 COMP 538 (*BOOKKEEPING OF DECLARATION LEVELS:*) COMP 539 (************************************) COMP 540 COMP 541 LEVEL: LEVRANGE; (*CURRENT STATIC LEVEL*) COMP 542 DISX, (*LEVEL OF LAST ID SRCHD BY SEARCHID*) COMP 543 TOP: DISPRANGE; (*TOP OF DISPLAY*) COMP 544 COMP 545 THISSCOPE, (*CURRENT SCOPE FOR ENTERID*) COMP 546 HIGHSCOPE: SCOPERANGE; (*HIGHEST SCOPE NUMBER USED*) COMP 547 COMP 548 DISPLAY: (*WHERE: MEANS:*) COMP 549 ARRAY [DISPRANGE] OF COMP 550 PACKED RECORD COMP 551 FNAME: CTP; COMP 552 CASE REGION: WHERE OF (*=BLCK: VARIABLE ID*) COMP 553 BLCK: (ASSIGNED: BOOLEAN; COMP 554 PFCP: CTP (* PROC/FUNC NAME *) ); COMP 555 DREC: (FFWPTR: CTP); (*=DREC: RECORD TYPE*) COMP 556 PFPAR: (); (*=PFPAR: PARAMETER LIST*) COMP 557 WREC: (WACC: DRCTINDRCT; (*=WREC: FIELD ID IN WITH-REC*) COMP 558 LEV: LEVRANGE; CWDSPL: ADDRRANGE; COMP 559 DCLPKD: BOOLEAN; COMP 560 CASE PKD: BOOLEAN OF COMP 561 FALSE: (); COMP 562 TRUE: (BACC: DRCTINDRCT; BDSPL: SHRTINT)) COMP 563 END; COMP 564 COMP 565 COMP 566 (*ERROR MESSAGES:*) COMP 567 (*****************) COMP 568 COMP 569 ERRINX: 0..MAXERRPERLINE; (* NR OF ACTIVE ENTRIES IN ERRLIST *) COMP 570 ERRORS: BOOLEAN; COMP 571 ERRLIST: COMP 572 ARRAY [1..MAXERRPERLINE] OF COMP 573 PACKED RECORD POS: 1..1000000; COMP 574 NMR: ERRINDEX COMP 575 END; COMP 576 ERLIST : ERLISTT; COMP 577 LANGUAGE: LANGUAGEKIND; (* D - DIAGNOSTIC LANGUAGE *) COMP 578 LANG: ARRAY [LANGUAGEKIND] OF ALFA; COMP 579 COMP 580 COMP 581 (*LISTING:*) COMP 582 (**********) COMP 583 COMP 584 LISTING: SEGTEXT; (* LISTING FILE *) V41DC05 242 LISTINGOPEN: BOOLEAN; (* TRUE IF LISTING FILE OPEN *) V41DC05 243 ERRFILE: SEGTEXT; (* ERROR FILE *) V41DC05 244 ERRFILEOPEN: BOOLEAN; (* TRUE IF ERROR FILE OPEN *) V41DC05 245 LINELENGTH,SOURCELENGTH,CHCNT: INTEGER; COMP 585 LINELC: INTEGER; COMP 586 LINENUM,LINESZ : INTEGER; COMP 587 NEXTNUM : INTEGER; COMP 588 SETLINENUM : BOOLEAN; COMP 589 TITLE,SUBTITLE: TITLEBUFFER; COMP 590 PAGE,LINESLEFT: INTEGER; COMP 591 SETTITLE,FIRSTHEADING: BOOLEAN; COMP 592 LINE: LINEBUFFER; COMP 593 V41DC05 246 V41DC05 247 (*CONTROL STATEMENT PROCESSING:*) V41DC05 248 (*******************************) V41DC05 249 V41DC05 250 OPTS: OPTIONBLOCK; V41DC05 251 CSPL: ARRAY [CSPARAMS] OF CSPARAMREC; V41DC05 252 CSPN: ARRAY [1..MAXCSPNAME] OF CH7; V41DC05 253 COMP 595 COMP 596 (*CODE GENERATION:*) COMP 597 (******************) COMP 598 COMP 599 GATTR: ATTR; COMP 600 CATTR: ATTR; COMP 601 ARGS: ARGSTATUS; XRGS: XRGSTATUS; BRGS: BRGSTATUS; COMP 602 BRG: BASREGS; COMP 603 LEVELS: SET OF LEVRANGE; COMP 604 BONUS: ARRAY [SHRTCST..INDVAR] OF INTEGER; COMP 605 EXTNAMES: ARRAY[VARR..TMEMR] OF ALFA; (* SPECIAL ENTRY POINTS *) COMP 606 PC: PLACE; RBUF,CBUF: INTEGER; COMP 607 BOOLOPCD: BOOLARRAY; COMP 608 SETINST: SETTABL; COMP 609 GENINCOPS: PACKED ARRAY [INCOPRANGE] OF OPCODE; COMP 610 EX: ARRAY[EXTERNALNAME] OF ALFA; (* PROC/FUNC EXTERNAL NAMES *) COMP 611 NOI: ARRAY[BOOLEAN] OF INTEGER; (* TABLE OF NO-OP INSTRUCTIONS *) COMP 612 PARAMREGS: ARRAY [1..MAXPARAMSINREGS] OF REGNR; COMP 613 LOADROTATEFLAG: BOOLEAN; V41AC08 12 COMP 614 COMP 615 (*CODEFILE AND TABLES FOR EXT. REFERENCES*) COMP 616 (*****************************************) COMP 617 COMP 618 LGO : LGOFILE; (* BINARY FILE *) V41DC05 254 BINARYOPEN : BOOLEAN; (* TRUE IF BINARY FILE OPEN *) V41DC05 255 COMPILERNAME : ALFA; (* 'PASCAL R.V' *) COMP 620 VALUES : ^LGOFILE; COMP 621 PROGNAME: ALFA; COMP 622 PROGBLOCK: ALFA; COMP 623 EXT, EXTROOT: EXTIDP; EXTIDX, EXTRX: INTEGER; COMP 624 ALFINT: RECORD CASE BOOLEAN OF COMP 625 FALSE: (A: ALFA); COMP 626 TRUE: (I: INTEGER) COMP 627 END; COMP 628 COMP 629 COMP 630 (*COMPILER OPTIONS*) COMP 631 (******************) COMP 632 COMP 633 ASCII,OLDASCII : BOOLEAN; (* A - ASCII CHARACTER SET *) COMP 634 BUFFSZ,OLDBUFFSZ: INTEGER; (* B - BUFFER SIZE *) COMP 635 EXTON,OLDEXTON: BOOLEAN; (* E - ENTRY POINT NAME CONTROL *) COMP 636 EPT1,EPT2: ALFA; COMP 637 (* SEE *ALTERNATE INPUT FILE* I - ALTERNATE INPUT FILE *) COMP 638 LISTON,OLDLISTON: BOOLEAN; (* L - LISTING CONTROL *) COMP 639 LCHANGED: BOOLEAN; COMP 640 (* M - MEMORY CONTROL OPTIONS *) COMP 641 INITIALSPACE,OLDINITIALSPACE: INTEGER; (* MB *) COMP 642 ALLOWDECREASE,OLDALLOWDECREASE: BOOLEAN; (* MD *) COMP 643 MINDECREASE,OLDMINDECREASE: INTEGER; (* MD *) COMP 644 MAXFL,OLDMAXFL: INTEGER; (* MF *) COMP 645 ALLOWINCREASE,OLDALLOWINCREASE: BOOLEAN; (* MI *) COMP 646 MININCREASE,OLDMININCREASE: INTEGER; (* MI *) COMP 647 INITIALREDUCE,OLDINITIALREDUCE: BOOLEAN; (* MR *) COMP 648 MSOPTION,OLDMSOPTION: INTEGER; (* MS *) COMP 649 MVOPTION,OLDMVOPTION: INTEGER; (* MV *) COMP 650 MXOPTION,OLDMXOPTION: INTEGER; (* MX *) COMP 651 MZOPTION,OLDMZOPTION: BOOLEAN; (* MZ *) COMP 652 OPTALLOWED,OLDOPTALWD: BOOLEAN; (* O - OPTIONS ALLOWED *) COMP 653 PMDOPT,OLDPMDOPT: PMDKIND; (* P - POST-MORTEM DUMP *) COMP 654 PRNTLIMIT,OLDPRNTLIMIT: INTEGER;(* PL- SET OUTPUT PRINT LIMIT *) COMP 655 QUICKMODE,OLDQUICKMODE: BOOLEAN;(* Q - QUICK GENERATED CODE *) COMP 656 STDFLAG,OLDSTDFLAG: BOOLEAN; (* S - STANDARD USAGE *) COMP 657 DEBUG,OLDDEBUG: BOOLEAN; (* T - RUN TIME TESTS *) COMP 658 MAXSRCLEN,OLDMAXSL: INTEGER; (* U - LINE WIDTH *) COMP 659 XPARMAX,OLDXPARMAX: INTEGER; (* X - PARAMETER PASSING *) COMP 660 ISSUESTAT,OLDISSUSTAT: BOOLEAN; (* Z - ISSUE STATISTICS MESSAGE *) COMP 661 COMP 662 COMP 663 (*ALTERNATE INPUT FILE*) COMP 664 (**********************) COMP 665 COMP 666 ALTFILE : TEXT; COMP 667 ALTLINENUMBERS,ALTERNATEINPUT,ALTERINGINPUT : BOOLEAN; COMP 668 COMP 669 COMP 670 (*STRUCTURED CONSTANTS:*) COMP 671 (***********************) COMP 672 COMP 673 DIGITS: SET OF '0'..'9'; COMP 674 CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,BLOCKBEGSYS,SELECTSYS,FACBEGSYS, COMP 675 STATBEGSYS,TYPEDELS,VALSPECBEGSYS,NONSTANDSYS: SETOFSYS; V41AC20 12 TENBLANKS: ALFA; COMP 677 RW: ARRAY [1..RESWORDS] OF ALFA; COMP 678 LRW: ARRAY [0..ALFALENG] OF 0..RESWORDS; COMP 679 FLRW : ARRAY[1..ALFALENG] OF SET OF 'A'..'Z'; COMP 680 RSY: ARRAY [1..RESWORDS] OF SYMBOL; COMP 681 ROP: ARRAY [1..RESWORDS] OF OPERATOR; COMP 682 SSY: ARRAY [BOOLEAN,'+'..';'] OF SYMBOL; COMP 683 SOP: ARRAY ['+'..';'] OF OPERATOR; COMP 684 KW: ARRAY[KEYWORD] OF ALFA; COMP 685 PASCL,PNAME: ALFA; COMP 686 TODAY,NOW,COMPILEDATE: ALFA; COMP 687 EFETOFFSET: ARRAY [BOOLEAN] OF ADDRRANGE; V41CC04 8 (*$L'GLOBAL VARIABLE INITIALIZATIONS.' *) COMP 688 COMP 689 COMP 690 VALUE COMP 691 (* INITIALIZE TABLES *) COMP 692 (*********************) COMP 693 COMP 694 KW=('GET ','PUT ','RESET ','REWRITE ','READ ', COMP 695 'READLN ','WRITE ','WRITELN ','PAGE ','PACK ', COMP 696 'UNPACK ','NEW ','DISPOSE ', COMP 697 'EOF ','EOLN ','ODD ','ROUND ','TRUNC ', COMP 698 'ABS ','SQR ','ORD ','CHR ','PRED ', COMP 699 'SUCC ','SIN ','COS ','ARCTAN ','EXP ', COMP 700 'SQRT ','LN ', COMP 701 'GETSEG ','PUTSEG ','GETFILE ','PUTFILE ', V41AC15 12 'MNEW ','MARK ','RELEASE ', COMP 703 'MESSAGE ','TIME ','DATE ','HALT ', COMP 704 'EOS ','EOI ', V41AC15 13 'UNDEFINED ','EXPO ','CARD ','CLOCK ', V41AC15 14 'RELVALUE ', V410C01 8 'FALSE ','TRUE ','MAXINT ', COMP 706 'COL ','PER ', COMP 707 'INTEGER ','REAL ','CHAR ','BOOLEAN ','TEXT ', COMP 708 'ALFA ','MARKER ', COMP 709 'INPUT ','OUTPUT ', COMP 710 'FORWARD ','EXTERN ','FORTRAN '); COMP 711 COMP 712 RW=('IF ','DO ','OF ','TO ','IN ', COMP 713 'OR ','END ','FOR ','VAR ','DIV ', COMP 714 'MOD ','SET ','AND ','NOT ','NIL ', COMP 715 'THEN ','ELSE ','WITH ','GOTO ','CASE ', COMP 716 'TYPE ','FILE ','BEGIN ','UNTIL ','WHILE ', COMP 717 'ARRAY ','CONST ','LABEL ','VALUE ','REPEAT ', COMP 718 'RECORD ','DOWNTO ','PACKED ','PROGRAM ','FUNCTION ', COMP 719 'PROCEDURE ','OTHERWISE ','SEGMENTED '); COMP 720 COMP 721 LRW=(0,0,6,15,22,29,33,34,35,38,38); COMP 722 COMP 723 FLRW=([], COMP 724 ['D','I','O','T'], COMP 725 ['A','D','E','F','M','N','S','V'], COMP 726 ['C','E','F','G','T','W'], COMP 727 ['A','B','C','L','U','V','W'], COMP 728 ['D','P','R'], COMP 729 ['P'], COMP 730 ['F'], COMP 731 ['O','P','S'], COMP 732 []); COMP 733 COMP 734 RSY=(IFSY,DOSY,OFSY,TOSY,RELOP,ADDOP,ENDSY,FORSY,VARSY,MULOP,MULOP, COMP 735 SETSY,MULOP,NOTSY,NILSY,THENSY,ELSESY,WITHSY,GOTOSY,CASESY, COMP 736 TYPESY,FILESY,BEGINSY,UNTILSY,WHILESY,ARRAYSY,CONSTSY,LABELSY, COMP 737 VALUESY,REPEATSY,RECORDSY,DOWNTOSY,PACKEDSY,PROGRAMSY, COMP 738 FUNCTIONSY,PROCEDURESY,OTHERWISESY,SEGMENTEDSY); COMP 739 COMP 740 ROP=(4 OF NOOP,INOP,OROP,3 OF NOOP,IDIV,IMOD,NOOP,ANDOP,25 OF NOOP); COMP 741 COMP 742 SSY=((ADDOP,ADDOP,MULOP,MULOP,LPARENT,RPARENT,OTHERSY,RELOP,OTHERSY, COMP 743 COMMA,PERIOD,OTHERSY,LBRACK,RBRACK,COLON,4 OF OTHERSY,ARROW, COMP 744 OTHERSY,RELOP,RELOP,3 OF OTHERSY,SEMICOLON), COMP 745 (ADDOP,ADDOP,MULOP,MULOP,LPARENT,RPARENT,OTHERSY,RELOP,OTHERSY, COMP 746 COMMA,PERIOD,OTHERSY,LBRACK,RBRACK,COLON,6 OF OTHERSY,RELOP, COMP 747 RELOP,ARROW,OTHERSY,ARROW,SEMICOLON)); COMP 748 COMP 749 SOP=(PLUS,MINUS,MUL,RDIV,3 OF NOOP,EQOP,13 OF NOOP,LTOP,GTOP, COMP 750 4 OF NOOP); COMP 751 COMP 752 ERLIST=(ERRMAX OF FALSE); COMP 753 COMP 754 LANG = ('ENGLISH ','FRENCH ','GERMAN ',' '); COMP 755 V41DC05 256 CSPL = ( (* CONTROL STATEMENT PARAMETERS *) V41DC05 257 (* NAME DF AD EQ NE USED *) V41DC05 258 ('I ', 1,10,TRUE, TRUE, FALSE), V41DC05 259 ('L ', 2,11,TRUE, TRUE, FALSE), V41DC05 260 ('B ', 3, 0,TRUE, TRUE, FALSE), V41DC05 261 ('E ', 4,12,TRUE, TRUE, FALSE), V41DC05 262 ('DS ', 5, 0,TRUE, FALSE,FALSE), V41DC05 263 ('GO ', 0, 0,FALSE,TRUE, FALSE), V41DC05 264 ('PD ', 6, 0,TRUE, TRUE, FALSE), V41DC05 265 ('PS ', 7, 0,TRUE, FALSE,FALSE), V41DC05 266 ('PL ', 8,13,TRUE, TRUE, FALSE), V41DC05 267 ('REW ', 9,14,TRUE, TRUE, FALSE), V41DC05 268 (' ', 0, 0,FALSE,FALSE,TRUE )); V41DC05 269 CSPN = (* CONTROL STATEMENT PARAMETER NAMES *) V41DC05 270 ('INPUT ','OUTPUT ','LGO ','OUTPUT ','P6000 ', V41DC05 271 ' ',' ','2000 ',' ','COMPILE', V41DC05 272 'LIST ','ERRS ','0 ','IB '); V41DC05 273 COMP 756 BOOLOPCD=(((BXXPX,BXXPCX),(BXXPX,BXXTX)), COMP 757 ((BXXTX,BXXTCX),(BXXTX,BXXPX))); COMP 758 COMP 759 SETINST=((SAAPK,SXAPK),(SABPK,SXBPK),(SAXPK,SXXPK),(SAXPB,SXXPB), COMP 760 (SAAPB,SXAPB),(SAAMB,SXAMB),(SABPB,SXBPB),(SABMB,SXBMB)); COMP 761 COMP 762 GENINCOPS = (SAAPB,SABPB,SAXPB,5 OF PS, COMP 763 SBAPB,SBBPB,SBXPB,5 OF PS, COMP 764 SXAPB,SXBPB,SXXPB,5 OF PS); COMP 765 COMP 766 EXTNAMES=('P.MAIN; ','P.GLOBL ','P.TERA ','P.TMEM '); COMP 767 COMP 768 EX=('P.GETB ','P.PUTB ','P.GETC ','P.PUTC ','P.GETCH ', COMP 769 'P.PUTCH ','P.GETLN ','P.PUTLN ', COMP 770 'P.RDI ','P.RDR ','P.WRF ','P.WRI ','P.WRE ', COMP 771 'P.WRC ','P.WRCD ','P.WRB ','P.WRS ','P.PAGE ', COMP 772 'P.RESET ','P.REWRT ','P.RWRTS ','P.GETS ','P.PUTS ', COMP 773 'P.GETF ','P.PUTF ','P.EOI ', V41AC15 15 'P.ALM ','P.NEWD ','P.LIM ','P.DISPD ', COMP 774 'P.MNW ','P.MND ','P.MRK ','P.RLS ', COMP 775 'P.CLOCK ','P.TIME ','P.DATE ','P.MSG ','P.HALT ', COMP 776 'P.SINCO ','P.EXP ','P.SQRT ','P.LN ','P.ATAN ', COMP 777 'P.PIT ', COMP 778 'P.ACV ','P.CPV ','P.PEG ','P.PEN ','P.PEX ', COMP 779 'P.SCO ','P.VPE ', COMP 780 'P.CFV ','P.DFV ', COMP 781 'P.END ','P.GTO ','P.INIT ','P.INV ', COMP 782 'P.EER ', COMP 783 'P.RPE ','P.SPE ', COMP 784 'P.ALM ','P.LIM ', COMP 785 'P.PMD ','P.MVE '); COMP 786 COMP 787 NOI=(61000B,46000B); (* SB0 B0+K / NO *) COMP 788 COMP 789 BONUS = (20,10,4,3); COMP 790 COMP 791 PARAMREGS = (0,1,2,3,4); COMP 792 V41AC08 13 LOADROTATEFLAG = TRUE; V41AC08 14 COMP 793 COMP 794 (* INITIALIZE STRINGS *) COMP 795 (**********************) COMP 796 COMP 797 PASCL = ALFA('P','A','S','C','L','.',4 OF COL); COMP 798 PNAME = ALFA('P','R','C',7 OF COL); COMP 799 PROGNAME = 'P.MAIN '; COMP 800 PROGBLOCK = 'P.MAIN '; COMP 801 COMPILERNAME = 'PASCAL R.V'; COMP 802 LANGUAGE = ENGLISH; COMP 803 TENBLANKS = ' '; COMP 804 TITLE = SITENAME; COMP 805 SUBTITLE = BLANKTITLE; COMP 806 COMP 807 COMP 808 (* INITIALIZE MISCELLANEOUS *) COMP 809 (****************************) COMP 810 COMP 811 FWPTR = NIL; COMP 812 FSTLABP = NIL; COMP 813 FSTCSP = NIL; COMP 814 INPUTPTR = NIL; COMP 815 OUTPUTPTR = NIL; COMP 816 PMDFILEPTR = NIL; V41DC06 13 LABCNT = 0; COMP 817 ERRORS = FALSE; COMP 818 DP = TRUE; COMP 819 TOPEXPR = TRUE; COMP 820 INTYPEDEFINITION = FALSE; COMP 821 ERRINX = 0; COMP 822 IC = 0; COMP 823 PCNT = 0; COMP 824 LC = MPLC; COMP 825 CHCNT = 0; COMP 826 LINENUM = 0; COMP 827 NEXTNUM = 0; COMP 828 VALUES = NIL; COMP 829 LISTINGOPEN = TRUE; V41EC08 6 ERRFILEOPEN = FALSE; V41DC05 275 BINARYOPEN = FALSE; V41DC05 276 PAGE = 0; COMP 830 LINESLEFT = 0; COMP 831 SETTITLE = TRUE; COMP 832 FIRSTHEADING = TRUE; COMP 833 CATTR = ATTR(NIL,CST,VALU(INT,0)); COMP 834 DISPLAY = (22 OF (NIL,BLCK,FALSE,NIL)); COMP 835 EMPTYID = (' ',NIL); COMP 836 THISSCOPE = 1; COMP 837 HIGHSCOPE = 1; COMP 838 EFETOFFSET = (BINEFET,TXTEFET); V41CC04 9 COMP 839 COMP 840 (* DEFAULT COMPILER OPTIONS *) COMP 841 (****************************) COMP 842 COMP 843 ASCII = TRUE; OLDASCII = TRUE; (* A+ *) COMP 844 BUFFSZ = 400B; OLDBUFFSZ = 400B; (* B2 *) COMP 845 EXTON = FALSE; OLDEXTON = FALSE; (* E- *) COMP 846 ALTERNATEINPUT = FALSE; ALTERINGINPUT = FALSE; (* I *) COMP 847 LISTON = TRUE; OLDLISTON = TRUE; (* L+ *) COMP 848 LCHANGED = FALSE; COMP 849 OPTALLOWED = TRUE; OLDOPTALWD = TRUE; (* O+ *) COMP 850 PMDOPT = PMDON; OLDPMDOPT = PMDON; (* P+ *) COMP 851 QUICKMODE = FALSE; OLDQUICKMODE = FALSE; (* Q- *) COMP 852 STDFLAG = FALSE; OLDSTDFLAG = FALSE; (* S- *) COMP 853 DEBUG = TRUE; OLDDEBUG = TRUE; (* T+ *) COMP 854 MAXSRCLEN = MAXLINELEN; OLDMAXSL = MAXLINELEN; (* U- *) COMP 855 XPARMAX = 4; OLDXPARMAX = 4; (* X4 *) COMP 856 ISSUESTAT = TRUE; OLDISSUSTAT = TRUE; (* Z+ *) COMP 857 COMP 858 COMP 859 (* DEFAULT MEMORY CONTROL OPTIONS *) COMP 860 (**********************************) COMP 861 COMP 862 INITIALSPACE = 0; OLDINITIALSPACE = 0; (* MB0 *) COMP 863 ALLOWDECREASE = FALSE; OLDALLOWDECREASE = FALSE; (* MD- *) COMP 864 MINDECREASE = 3000B; OLDMINDECREASE = 3000B; (* MD3000B *) COMP 865 MAXFL = MAXADDR; OLDMAXFL = MAXADDR; (* MF377777B *) COMP 866 ALLOWINCREASE = TRUE; OLDALLOWINCREASE = TRUE; (* MI+ *) COMP 867 MININCREASE = 2000B; OLDMININCREASE = 2000B; (* MI2000B *) COMP 868 INITIALREDUCE = TRUE; OLDINITIALREDUCE = TRUE; (* MR+ *) COMP 869 MSOPTION = 1000B; OLDMSOPTION = 1000B; (* MS1000B *) COMP 870 MVOPTION = 100B; OLDMVOPTION = 100B; (* MV100B *) COMP 871 MXOPTION = 400B; OLDMXOPTION = 400B; (* MX400B *) COMP 872 MZOPTION = FALSE; OLDMZOPTION = FALSE; (* MZ- *) COMP 873 COMP 874 COMP 875 (* INITIALIZE SETS *) COMP 876 (*******************) COMP 877 COMP 878 DIGITS = ['0'..'9']; COMP 879 CONSTBEGSYS = [ADDOP,INTCONST,REALCONST,CHARCONST,STRINGCONST,IDENT]; COMP 880 SIMPTYPEBEGSYS = [LPARENT,ADDOP,INTCONST,REALCONST,CHARCONST, COMP 881 STRINGCONST,IDENT]; COMP 882 TYPEBEGSYS = [ARROW,PACKEDSY,SEGMENTEDSY,ARRAYSY,RECORDSY,SETSY, COMP 883 FILESY,LPARENT,ADDOP,INTCONST,REALCONST,CHARCONST, COMP 884 STRINGCONST,IDENT]; COMP 885 TYPEDELS = [ARRAYSY,RECORDSY,SETSY,FILESY]; COMP 886 BLOCKBEGSYS = [LABELSY,CONSTSY,TYPESY,VARSY,VALUESY,PROCEDURESY, COMP 887 FUNCTIONSY,BEGINSY]; COMP 888 VALSPECBEGSYS = [ADDOP,INTCONST,REALCONST,CHARCONST,STRINGCONST,IDENT, COMP 889 NILSY,LPARENT,LBRACK]; COMP 890 SELECTSYS = [ARROW,PERIOD,LBRACK]; COMP 891 FACBEGSYS = [INTCONST,REALCONST,CHARCONST,STRINGCONST,IDENT,LPARENT, COMP 892 LBRACK,NOTSY,NILSY]; COMP 893 STATBEGSYS = [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY, COMP 894 CASESY]; COMP 895 NONSTANDSYS = [VALUESY,OTHERWISESY,SEGMENTEDSY]; V41AC20 14 (*$L'EXTERNAL ROUTINES.' *) COMP 896 COMP 897 COMP 898 PROCEDURE BMSG(NAME : ALFA); EXTERN; V41DC05 277 PROCEDURE CDATE(VAR COMPILEDATE : ALFA); EXTERN; V41DC05 278 PROCEDURE (*$E'CLOSE'*) CLOSEB(VAR F : LGOFILE); EXTERN; V41DC05 279 PROCEDURE (*$E'CLOSE'*) CLOSET(VAR F : TEXT); EXTERN; V41DC05 280 PROCEDURE CSARG(VAR ARGL : ARGLIST; VAR ARGC : INTEGER); EXTERN; V41DC05 281 PROCEDURE CSABORT(ERR : INTEGER; KEY, VAL : CH7); EXTERN; V41DC05 282 PROCEDURE (*$E'P.DADD'*) DADD(VAR R : DOUBLE; A, B : DOUBLE); EXTERN; V41DC05 283 PROCEDURE (*$E'P.DDIV'*) DDIV(VAR R : DOUBLE; A, B : DOUBLE); EXTERN; V41DC05 284 PROCEDURE (*$E'P.DMUL'*) DMUL(VAR R : DOUBLE; A, B : DOUBLE); EXTERN; V41DC05 285 FUNCTION (*$E'P.EFD'*) EFD : INTEGER; EXTERN; V41DC05 286 PROCEDURE FIND(VAR F : TEXT; FN, RN : ALFA); EXTERN; V41DC05 287 PROCEDURE GETPAGE(VAR P : PAGESIZEREC); EXTERN; V41DC05 288 PROCEDURE LOADGO(VAR F : LGOFILE); EXTERN; V41DC05 289 PROCEDURE MAKESET(N : CH7; VAR S : SETOFA2Z); EXTERN; V41DC05 290 FUNCTION MASK(C : BITRANGE) : INTEGER; EXTERN; V41DC05 291 FUNCTION MERGE(A, B : VALU) : INTEGER; EXTERN; V41DC05 292 PROCEDURE NEXTCH; EXTERN; V41DC05 293 PROCEDURE NEXTCHSETUP(VAR LINE : LINEBUFFER; V41DC05 294 VAR CH : CHAR; VAR CHCNT, SOURCELENGTH : INTEGER); EXTERN; V41DC05 295 PROCEDURE (*$E'OPEN'*) OPENB(VAR F : LGOFILE; V41DC05 296 FN : CH7; OPENWRITE : BOOLEAN); EXTERN; V41DC05 297 PROCEDURE (*$E'OPEN'*) OPENT(VAR F : TEXT; V41DC05 298 FN : CH7; OPENWRITE : BOOLEAN); EXTERN; V41DC05 299 FUNCTION (*$E'P.OS'*) OS : INTEGER; EXTERN; V41DC05 300 FUNCTION PORTION(W : INTEGER; SB,EB : BITRANGE) : INTEGER; EXTERN; V41DC05 301 PROCEDURE RLIBNAME(VAR FN : ALFA); EXTERN; V41DC05 302 FUNCTION ROTATE(W : INTEGER; C : BITRANGE) : INTEGER; EXTERN; V41DC05 303 PROCEDURE (*$E'P.TEN'*) TEN(VAR R : DOUBLE; X : INTEGER); EXTERN; V41DC05 304 PROCEDURE UNPACKCS(VAR LINE : LINEBUFFER); EXTERN; V41DC05 305 PROCEDURE WRITEOCT(VAR F : TEXT; N, W : INTEGER); EXTERN; V41DC05 306 (*$L'INPUT/OUTPUT PROCESSORS.' *) COMP 922 COMP 923 V41DC05 307 PROCEDURE CLOSEFILES; V41DC05 308 BEGIN (* CLOSEFILES *) V41DC05 309 CLOSET(ALTFILE); V41DC05 310 IF VALUES <> NIL THEN CLOSEB(VALUES^); V41DC05 311 CLOSET(SOURCE); CLOSET(LISTING); V41DC05 312 CLOSEB(LGO); CLOSET(ERRFILE) V41DC05 313 END (* CLOSEFILES *); V41DC05 314 V41DC05 315 PROCEDURE ABORT(MSG: PACKED ARRAY [LO..HI:INTEGER] OF CHAR); V41DC05 316 BEGIN (* ABORT *) V41DC05 317 CLOSEFILES; HALT(MSG) V41DC05 318 END (* ABORT *); V41DC05 319 COMP 924 PROCEDURE HEADING; COMP 925 CONST T1 = 'PASCAL COMPILER - E.T.H. ZUERICH / UNIVERSITY OF '; V41DC05 320 T2 = 'MINNESOTA. PASCAL-6000 V'; V41DC05 321 VAR CH : CHAR; V41DC05 322 BEGIN (* HEADING *) COMP 926 PAGE := PAGE + 1; COMP 927 IF FIRSTHEADING THEN COMP 928 BEGIN FIRSTHEADING := FALSE; COMP 929 WRITELN(LISTING,'Q'); (* CLEAR AUTO-EJECT *) V41DC05 323 IF OPTS.EIGHTLPI THEN CH := 'T' ELSE CH := 'S'; V41DC05 324 WRITELN(LISTING,CH) V41DC05 325 END; COMP 932 WRITE(LISTING,'1'); V41DC05 326 IF OPTS.EIGHTLPI THEN V41DC05 327 BEGIN WRITELN(LISTING); WRITE(LISTING,' ') END; V41DC05 328 WRITE(LISTING,T1,T2,CHR(RELNUM),'.',CHR(VERNUM),'.',CHR(LEVNUM),'.'); V41DC05 329 WRITELN(LISTING,CHR(ASCFLAG),TODAY,NOW); V41DC05 330 WRITE(LISTING,TITLE:41,SUBTITLE:44,OSNAME:15,' ':10,COMPILEDATE); V41DC05 331 IF OPTS.PAGESIZE < MAXINT THEN WRITE(LISTING,' PAGE ',PAGE:1); V41DC05 332 WRITELN(LISTING); WRITELN(LISTING); V41DC05 333 LINESLEFT := OPTS.PAGESIZE - 3; COMP 942 IF OPTS.EIGHTLPI THEN COMP 943 BEGIN WRITELN(LISTING); LINESLEFT := LINESLEFT - 2 END V41DC05 334 END (* HEADING *); COMP 945 COMP 946 PROCEDURE FLAGERROR; COMP 947 V41DC05 335 PROCEDURE WRITEFLAG(VAR F : SEGTEXT); V41DC05 336 VAR K, S : INTEGER; V41DC05 337 BEGIN (* WRITEFLAG *) V41DC05 338 IF LINENUMBERS THEN S := LINESZ ELSE S := 5; V41DC05 339 WRITE(F,' '); V41DC05 340 FOR K := 1 TO S DO WRITE(F,'*'); V41DC05 341 IF NOT LINENUMBERS THEN WRITE(F,' ') V41DC05 342 END (* WRITEFLAG *); V41DC05 343 V41DC05 344 BEGIN (* FLAGERROR *) COMP 949 IF LISTINGOPEN THEN V41DC05 345 BEGIN V41DC05 346 IF LINESLEFT < 1 THEN HEADING; V41DC05 347 LINESLEFT := LINESLEFT - 1; V41DC05 348 IF LISTON OR LCHANGED THEN WRITE(LISTING,' ':7); V41DC05 349 WRITEFLAG(LISTING) V41DC05 350 END; V41DC05 351 IF ERRFILEOPEN THEN WRITEFLAG(ERRFILE) V41DC05 352 END (* FLAGERROR *); COMP 956 COMP 957 PROCEDURE WRITEERRORS; COMP 958 V41DC05 353 PROCEDURE PUTERRORS(VAR F : SEGTEXT); V41DC05 354 VAR LASTPOS,FREEPOS,CURRPOS,CURRNMR,W,K: INTEGER; V41DC05 355 BEGIN (* PUTERRORS *) V41DC05 356 LASTPOS := LINESZ + 1; FREEPOS := LASTPOS + 1; V41DC05 357 FOR K := 1 TO ERRINX DO V41DC05 358 BEGIN V41DC05 359 WITH ERRLIST[K] DO V41DC05 360 BEGIN CURRPOS := POS; CURRNMR := NMR END; V41DC05 361 IF CURRPOS = LASTPOS THEN WRITE(F,',') V41DC05 362 ELSE V41DC05 363 BEGIN V41DC05 364 WHILE FREEPOS < CURRPOS DO V41DC05 365 BEGIN WRITE(F,' '); FREEPOS := FREEPOS + 1 END; V41DC05 366 WRITE(F,''''); LASTPOS := CURRPOS V41DC05 367 END; V41DC05 368 IF CURRNMR < 10 THEN W := 1 V41DC05 369 ELSE IF CURRNMR < 100 THEN W := 2 V41DC05 370 ELSE W := 3; V41DC05 371 WRITE(F,CURRNMR:W); FREEPOS := FREEPOS + W + 1 V41DC05 372 END; V41DC05 373 WRITELN(F) V41DC05 374 END (* PUTERRORS *); V41DC05 375 V41DC05 376 BEGIN (* WRITEERRORS *) COMP 960 FLAGERROR; COMP 961 IF LISTINGOPEN THEN PUTERRORS(LISTING); V41DC05 377 IF ERRFILEOPEN THEN PUTERRORS(ERRFILE); V41DC05 378 ERRINX := 0 V41DC05 379 END (* WRITEERRORS *); V41DC05 380 V41DC05 381 PROCEDURE WRITELINE(VAR F : SEGTEXT); V41DC05 382 VAR J : INTEGER; V41DC05 383 BEGIN (* WRITELINE *) V41DC05 384 FOR J := 1 TO LINELENGTH DO WRITE(F,LINE[J]); V41DC05 385 WRITELN(F) V41DC05 386 END (* WRITELINE *); V41DC05 387 V41DC05 388 PROCEDURE PUTERRMSG(MSG: PACKED ARRAY [L..H:INTEGER] OF CHAR; V41DC05 389 WEOL: BOOLEAN); V41DC05 390 BEGIN (* PUTERRMSG *) V41DC05 391 IF LISTINGOPEN THEN V41DC05 392 BEGIN WRITE(LISTING,MSG); V41DC05 393 IF WEOL THEN WRITELN(LISTING) V41DC05 394 END; V41DC05 395 IF ERRFILEOPEN THEN V41DC05 396 BEGIN WRITE(ERRFILE,MSG); V41DC05 397 IF WEOL THEN WRITELN(ERRFILE) V41DC05 398 END V41DC05 399 END (* PUTERRMSG *); V41DC05 400 COMP 983 PROCEDURE (*$E'BEGINLI'*) BEGINLINE; COMP 984 COMP 985 PROCEDURE READLINE( VAR F : TEXT ); COMP 986 BEGIN (* READLINE *) COMP 987 IF DP THEN LINELC := LC ELSE LINELC := IC; COMP 988 LINELENGTH := 0; COMP 989 WHILE NOT EOLN(F) AND (LINELENGTH < MAXLINELEN) DO COMP 990 BEGIN LINELENGTH := LINELENGTH + 1; COMP 991 LINE[LINELENGTH] := F^; COMP 992 GET(F) COMP 993 END COMP 994 END (* READLINE *); COMP 995 COMP 996 BEGIN (* BEGINLINE *) COMP 997 LCHANGED := FALSE; COMP 998 IF ALTERNATEINPUT THEN READLINE(ALTFILE) COMP 999 ELSE IF EOS(SOURCE) THEN COMP 1000 BEGIN FLAGERROR; PUTERRMSG(' INCOMPLETE PROGRAM.',TRUE); V41DC05 401 ERRORS := TRUE; COMP 1003 GOTO 13 COMP 1004 END COMP 1005 ELSE READLINE(SOURCE); COMP 1006 IF LINELENGTH > MAXSRCLEN THEN SOURCELENGTH := MAXSRCLEN COMP 1007 ELSE SOURCELENGTH := LINELENGTH; COMP 1008 CHCNT := 0; COMP 1009 LINESZ := 0; COMP 1010 IF LINENUMBERS COMP 1011 THEN BEGIN NEXTNUM := 0; COMP 1012 WHILE LINE[CHCNT+1] IN DIGITS DO COMP 1013 BEGIN CHCNT := CHCNT + 1; COMP 1014 IF LINESZ < 5 THEN LINESZ := LINESZ + 1; COMP 1015 NEXTNUM := NEXTNUM * 10 MOD 100000 + ORD(LINE[CHCNT]) - ORD('0') COMP 1016 END COMP 1017 END COMP 1018 ELSE IF NOT ALTERNATEINPUT THEN NEXTNUM := SUCC(NEXTNUM) COMP 1019 END (* BEGINLINE *); COMP 1020 COMP 1021 PROCEDURE (*$E'ENDLINE'*) ENDLINE; COMP 1022 VAR I: INTEGER; COMP 1023 COMP 1024 PROCEDURE FLAGSWITCH( B : BOOLEAN ); COMP 1025 BEGIN (* FLAGSWITCH *) COMP 1026 IF LISTON THEN COMP 1027 BEGIN COMP 1028 IF LINESLEFT < 3 THEN HEADING; COMP 1029 LINESLEFT := LINESLEFT - 3; COMP 1030 WRITELN(LISTING); V41DC05 402 WRITE(LISTING,' ------ '); V41DC05 403 IF B THEN WRITE(LISTING,'BEGIN') ELSE WRITE(LISTING,'END'); V41DC05 404 WRITELN(LISTING,' INCLUDED TEXT.'); V41DC05 405 WRITELN(LISTING) V41DC05 406 END COMP 1036 END (* FLAGSWITCH *); COMP 1037 COMP 1038 BEGIN (* ENDLINE *) COMP 1039 IF LISTON OR LCHANGED OR (ERRINX > 0) THEN COMP 1040 BEGIN V41DC05 407 IF LISTINGOPEN THEN V41DC05 408 BEGIN I := 1 + ORD(NOT LISTON AND LCHANGED); V41DC05 409 IF LINESLEFT < I + ORD(ERRINX > 0) THEN HEADING; V41DC05 410 LINESLEFT := LINESLEFT - I; V41DC05 411 IF LISTON OR LCHANGED THEN V41DC05 412 BEGIN WRITE(LISTING,' '); WRITEOCT(LISTING,LINELC,6) END; V41DC05 413 IF NOT LINENUMBERS THEN WRITE(LISTING,' ',NEXTNUM:5); V41DC05 414 WRITE(LISTING,' '); WRITELINE(LISTING) V41DC05 415 END; V41DC05 416 IF ERRINX > 0 THEN V41DC05 417 BEGIN V41DC05 418 IF ERRFILEOPEN THEN V41DC05 419 BEGIN V41DC05 420 IF NOT LINENUMBERS THEN WRITE(ERRFILE,' ',NEXTNUM:5); V41DC05 421 WRITE(ERRFILE,' '); WRITELINE(ERRFILE) V41DC05 422 END; V41DC05 423 WRITEERRORS V41DC05 424 END; V41DC05 425 IF NOT LISTON AND LCHANGED AND LISTINGOPEN THEN V41DC05 426 WRITELN(LISTING) V41DC05 427 END; V41DC05 428 IF ALTERINGINPUT THEN V41DC05 429 BEGIN ALTERINGINPUT := FALSE; V41DC05 430 ALTERNATEINPUT := TRUE; V41DC05 431 ALTLINENUMBERS := LINENUMBERS; V41DC05 432 LINENUMBERS := ALTFILE^ IN DIGITS; V41DC05 433 IF LISTINGOPEN THEN FLAGSWITCH(TRUE) V41DC05 434 END V41DC05 435 ELSE V41DC05 436 IF ALTERNATEINPUT THEN V41DC05 437 BEGIN READLN(ALTFILE); V41DC05 438 IF EOF(ALTFILE) THEN V41DC05 439 BEGIN ALTERNATEINPUT := FALSE; V41DC05 440 LINENUMBERS := ALTLINENUMBERS; V41DC05 441 IF LISTINGOPEN THEN FLAGSWITCH(FALSE); V41DC05 442 READLN(SOURCE) V41DC05 443 END V41DC05 444 END V41DC05 445 ELSE READLN(SOURCE) V41DC05 446 END (* ENDLINE *); COMP 1071 COMP 1072 PROCEDURE ERROR(FERRNR: ERRINDEX); COMP 1073 BEGIN COMP 1074 ERRORS := TRUE; ERLIST[FERRNR] := TRUE; COMP 1075 IF ERRINX = MAXERRPERLINE THEN COMP 1076 BEGIN ERRLIST[ERRINX].NMR := 354; ERLIST[354] := TRUE END COMP 1077 ELSE COMP 1078 BEGIN ERRINX := ERRINX + 1; COMP 1079 ERRLIST[ERRINX].NMR := FERRNR COMP 1080 END; COMP 1081 ERRLIST[ERRINX].POS := CHCNT COMP 1082 END (*ERROR*) ; COMP 1083 COMP 1084 PROCEDURE EXTENSION(FWARNNR: ERRINDEX); COMP 1085 BEGIN COMP 1086 IF STDFLAG THEN ERROR(FWARNNR) COMP 1087 END (* EXTENSION *); COMP 1088 COMP 1089 PROCEDURE OPTIONS( PROCEDURE NEXTCH ); COMP 1090 VAR ENDOPTIONS: BOOLEAN; CH1: CHAR; COMP 1091 SAVELISTON : BOOLEAN; COMP 1092 FILNAME,RECNAME : ALFA; COMP 1093 LINESPRINTED: INTEGER; COMP 1094 DLNG: LANGUAGEKIND; COMP 1095 TEMP: TITLEBUFFER; COMP 1096 COMP 1097 PROCEDURE OPTERROR(FERRNR: ERRINDEX); COMP 1098 BEGIN CHCNT := CHCNT + 1; COMP 1099 ERROR(FERRNR); CHCNT := CHCNT - 1; ENDOPTIONS := TRUE COMP 1100 END (* OPTERROR *); COMP 1101 COMP 1102 PROCEDURE SWITCH( VAR S,OLDS : BOOLEAN ); COMP 1103 BEGIN (* SWITCH *) COMP 1104 IF CH IN ['+','-','='] THEN COMP 1105 BEGIN COMP 1106 IF CH = '=' THEN S := OLDS COMP 1107 ELSE BEGIN OLDS := S; S := CH = '+' END; COMP 1108 NEXTCH COMP 1109 END COMP 1110 ELSE OPTERROR(353) COMP 1111 END (* SWITCH *); COMP 1112 COMP 1113 PROCEDURE NUMBER( VAR N,OLDN : INTEGER; MIN,MAX : INTEGER ); COMP 1114 VAR DIGIT,DEC,OCT : INTEGER; COMP 1115 BEGIN (* NUMBER *) COMP 1116 IF CH IN DIGITS THEN COMP 1117 BEGIN OLDN := N; COMP 1118 DEC := 0; OCT := 0; COMP 1119 REPEAT DIGIT := ORD(CH) - ORD('0'); COMP 1120 NEXTCH; COMP 1121 IF DEC <= MAX THEN DEC := DEC * 10 + DIGIT; COMP 1122 IF (OCT <= MAX) AND (DIGIT <= 7) THEN OCT := OCT * 8 + DIGIT COMP 1123 ELSE OCT := MAX + 1 COMP 1124 UNTIL NOT (CH IN DIGITS); COMP 1125 IF CH = 'B' THEN BEGIN DEC := OCT; NEXTCH END; COMP 1126 IF DEC < MIN THEN N := MIN COMP 1127 ELSE IF DEC > MAX THEN N := MAX COMP 1128 ELSE N := DEC COMP 1129 END COMP 1130 ELSE COMP 1131 IF CH = '=' THEN BEGIN N := OLDN; NEXTCH END COMP 1132 ELSE OPTERROR(353) COMP 1133 END (* NUMBER *); COMP 1134 COMP 1135 PROCEDURE READSTRING(VAR S: PACKED ARRAY [L..H: INTEGER] OF CHAR; COMP 1136 SIZE: INTEGER); COMP 1137 VAR I: INTEGER; COMP 1138 Q: CHAR; COMP 1139 BEGIN (* READSTRING *) COMP 1140 IF ASCII THEN Q := '''' ELSE Q := '#'; COMP 1141 IF CH = Q THEN COMP 1142 BEGIN FOR I := 1 TO H DO S[I] := ' '; COMP 1143 I := 0; COMP 1144 REPEAT NEXTCH; COMP 1145 WHILE (CH <> Q) AND (CHCNT <= SOURCELENGTH) DO COMP 1146 BEGIN IF I < SIZE THEN BEGIN I := I + 1; S[I] := CH END; COMP 1147 NEXTCH COMP 1148 END; COMP 1149 IF CH = Q THEN COMP 1150 BEGIN NEXTCH; COMP 1151 IF (CH = Q) AND (I < SIZE) THEN COMP 1152 BEGIN I := I + 1; S[I] := Q END COMP 1153 END COMP 1154 UNTIL CH <> Q COMP 1155 END COMP 1156 ELSE OPTERROR(353) COMP 1157 END (* READSTRING *); COMP 1158 COMP 1159 PROCEDURE TWOWORDS(VAR W1,W2: ALFA); COMP 1160 BEGIN (* TWOWORDS *) COMP 1161 READSTRING(W1,7); COMP 1162 IF NOT ENDOPTIONS AND (CH = '/') THEN COMP 1163 BEGIN NEXTCH; READSTRING(W2,7) END COMP 1164 END (* TWOWORDS *); COMP 1165 COMP 1166 PROCEDURE MEMORYOPTION; COMP 1167 VAR LCH: CHAR; COMP 1168 BEGIN (* MEMORYOPTION *) COMP 1169 IF CH IN [ COMP 1170 'B', COMP 1171 'D', COMP 1172 'F', COMP 1173 'I', COMP 1174 'R', COMP 1175 'S', COMP 1176 'V', COMP 1177 'X', COMP 1178 'Z' COMP 1179 ] THEN COMP 1180 BEGIN LCH := CH; NEXTCH; COMP 1181 IF LCH = 'B' THEN NUMBER(INITIALSPACE,OLDINITIALSPACE,0,MAXADDR) COMP 1182 ELSE IF LCH = 'D' THEN COMP 1183 BEGIN COMP 1184 IF CH IN ['+','-','='] THEN COMP 1185 SWITCH(ALLOWDECREASE,OLDALLOWDECREASE) COMP 1186 ELSE NUMBER(MINDECREASE,OLDMINDECREASE,0,MAXADDR) COMP 1187 END COMP 1188 ELSE IF LCH = 'F' THEN NUMBER(MAXFL,OLDMAXFL,0,MAXADDR) COMP 1189 ELSE IF LCH = 'I' THEN COMP 1190 BEGIN COMP 1191 IF CH IN ['+','-','='] THEN COMP 1192 SWITCH(ALLOWINCREASE,OLDALLOWINCREASE) COMP 1193 ELSE NUMBER(MININCREASE,OLDMININCREASE,0,MAXADDR) COMP 1194 END COMP 1195 ELSE IF LCH = 'R' THEN SWITCH(INITIALREDUCE,OLDINITIALREDUCE) COMP 1196 ELSE IF LCH = 'S' THEN NUMBER(MSOPTION,OLDMSOPTION,0,MAXADDR) COMP 1197 ELSE IF LCH = 'V' THEN NUMBER(MVOPTION,OLDMVOPTION,2,MAXADDR) COMP 1198 ELSE IF LCH = 'X' THEN NUMBER(MXOPTION,OLDMXOPTION,0,MAXADDR) COMP 1199 ELSE IF LCH = 'Z' THEN SWITCH(MZOPTION,OLDMZOPTION) COMP 1200 END COMP 1201 ELSE OPTERROR(353) COMP 1202 END (* MEMORYOPTION *); COMP 1203 COMP 1204 BEGIN (* OPTIONS *) COMP 1205 ENDOPTIONS := FALSE; COMP 1206 REPEAT NEXTCH; COMP 1207 IF (CH IN [ COMP 1208 'A', COMP 1209 'B', COMP 1210 'D', COMP 1211 'E', COMP 1212 'I', COMP 1213 'L', COMP 1214 'M', COMP 1215 'O', COMP 1216 'P', COMP 1217 'Q', COMP 1218 'S', COMP 1219 'T', COMP 1220 'U', COMP 1221 'X', COMP 1222 'Z' COMP 1223 ]) THEN COMP 1224 BEGIN CH1 := CH; NEXTCH; COMP 1225 IF (CH1 IN ['A','E','I','O','U']) AND (LINENUM <> 0) THEN COMP 1226 EXTENSION(331); COMP 1227 CASE CH1 OF COMP 1228 'A' : SWITCH(ASCII,OLDASCII); COMP 1229 'B' : BEGIN NUMBER(BUFFSZ,OLDBUFFSZ,0,MAXADDR); COMP 1230 IF BUFFSZ < 64 THEN BUFFSZ := BUFFSZ * 128 COMP 1231 END; COMP 1232 'D' : BEGIN READSTRING(LANG[USERDL],10); DLNG := ENGLISH; COMP 1233 WHILE LANG[DLNG] <> LANG[USERDL] DO COMP 1234 DLNG := SUCC(DLNG); COMP 1235 IF DLNG = USERDL THEN ERROR(350) COMP 1236 ELSE LANGUAGE := DLNG COMP 1237 END; COMP 1238 'E' : IF CH IN ['+','-','='] THEN SWITCH(EXTON,OLDEXTON) COMP 1239 ELSE TWOWORDS(EPT1,EPT2); COMP 1240 'I' : BEGIN FILNAME := ' '; COMP 1241 TWOWORDS(RECNAME,FILNAME); COMP 1242 IF NOT ENDOPTIONS THEN COMP 1243 BEGIN COMP 1244 IF NOT EOF(ALTFILE) THEN ERROR(199) COMP 1245 ELSE COMP 1246 BEGIN FIND(ALTFILE,FILNAME,RECNAME); COMP 1247 IF EOF(ALTFILE) THEN ERROR(198) COMP 1248 ELSE ALTERINGINPUT := TRUE COMP 1249 END COMP 1250 END COMP 1251 END; COMP 1252 'L' : IF CH IN ['+','-','='] THEN COMP 1253 BEGIN SAVELISTON := LISTON; COMP 1254 SWITCH(LISTON,OLDLISTON); COMP 1255 LISTON := LISTON AND LISTINGOPEN; V41DC05 447 LCHANGED := LCHANGED OR (LISTON <> SAVELISTON) COMP 1256 END COMP 1257 ELSE COMP 1258 BEGIN COMP 1259 IF CH = 'T' THEN BEGIN CH1 := CH; NEXTCH END; COMP 1260 READSTRING(TEMP,MAXTITLE); COMP 1261 IF NOT ENDOPTIONS THEN (* TITLE PRESENT *) COMP 1262 BEGIN COMP 1263 IF SETTITLE OR (CH1 = 'T') THEN COMP 1264 BEGIN SETTITLE := FALSE; COMP 1265 TITLE := TEMP; SUBTITLE := BLANKTITLE COMP 1266 END COMP 1267 ELSE SUBTITLE := TEMP; COMP 1268 IF LISTON THEN LINESLEFT := 0 COMP 1269 END COMP 1270 END; COMP 1271 'M' : MEMORYOPTION; COMP 1272 'O' : SWITCH(OPTALLOWED,OLDOPTALWD); COMP 1273 'P' : IF CH IN ['+','-','0','='] THEN COMP 1274 BEGIN COMP 1275 IF PMDOPT <> PMDNONE THEN COMP 1276 IF CH = '=' THEN PMDOPT := OLDPMDOPT COMP 1277 ELSE COMP 1278 BEGIN OLDPMDOPT := PMDOPT; COMP 1279 IF CH = '+' THEN PMDOPT := PMDON COMP 1280 ELSE COMP 1281 IF CH = '-' THEN PMDOPT := PMDOFF COMP 1282 ELSE PMDOPT := PMDSUPPRESS COMP 1283 END; COMP 1284 NEXTCH COMP 1285 END COMP 1286 ELSE COMP 1287 IF CH = 'L' THEN COMP 1288 BEGIN NEXTCH; COMP 1289 NUMBER(PRNTLIMIT,OLDPRNTLIMIT,0,MAXINT); COMP 1290 END COMP 1291 ELSE OPTERROR(353); COMP 1292 'Q' : SWITCH(QUICKMODE,OLDQUICKMODE); COMP 1293 'S' : SWITCH(STDFLAG,OLDSTDFLAG); COMP 1294 'T' : SWITCH(DEBUG,OLDDEBUG); COMP 1295 'U' : BEGIN COMP 1296 IF CH IN ['+','-'] THEN COMP 1297 BEGIN OLDMAXSL := MAXSRCLEN; COMP 1298 IF CH = '+' THEN MAXSRCLEN := 72 COMP 1299 ELSE MAXSRCLEN := MAXLINELEN; COMP 1300 NEXTCH COMP 1301 END COMP 1302 ELSE NUMBER(MAXSRCLEN,OLDMAXSL,10,MAXLINELEN); COMP 1303 IF NOT ENDOPTIONS THEN COMP 1304 IF LINELENGTH > MAXSRCLEN THEN COMP 1305 SOURCELENGTH := MAXSRCLEN COMP 1306 ELSE SOURCELENGTH := LINELENGTH COMP 1307 END; COMP 1308 'X' : NUMBER(XPARMAX,OLDXPARMAX,0,MAXPARAMSINREGS); COMP 1309 'Z' : SWITCH(ISSUESTAT,OLDISSUSTAT); COMP 1310 END; COMP 1311 ENDOPTIONS := ENDOPTIONS OR (CH <> ',') COMP 1312 END COMP 1313 ELSE OPTERROR(352) COMP 1314 UNTIL ENDOPTIONS; COMP 1315 END (*OPTIONS*); COMP 1316 COMP 1317 PROCEDURE INSYMBOL; COMP 1318 (* READ NEXT BASIC SYMBOL OF SOURCE PROGRAM AND RETURN ITS DESCRIPTION COMP 1319 IN THE GLOBAL VARIABLES: SY, OP, ID, IVAL, RVAL, CONSTP, LGTH *) COMP 1320 LABEL 1,2; COMP 1321 CONST LIM1 = 322; (* MAXIMUM EXPONENT *) COMP 1322 LIM2 = -292; (* MINIMUM EXPONENT *) COMP 1323 T29 = 4000000000B; (* 2**29 *) COMP 1324 T30 = 10000000000B; (* 2**30 *) COMP 1325 SEVENBLANKS = ' '; COMP 1326 VAR D,DCOUNT,ECOUNT,I,K,SCALE,EXP,T: INTEGER; COMP 1327 UPPERD,LOWERD,UPPERB,LOWERB,UPPERR,LOWERR: INTEGER; COMP 1328 SIGN,BADB: BOOLEAN; COMP 1329 T1,T2,T3: DOUBLE; COMP 1330 APO,STRINGEND: BOOLEAN; NXTP,TAILP: CTAILP; Q: CHAR; COMP 1331 OA: RECORD COMP 1332 CASE BOOLEAN OF COMP 1333 FALSE: (A: ALFA); COMP 1334 TRUE: (I: INTEGER) COMP 1335 END; COMP 1336 DOT,STARTCMT,UL: BOOLEAN; V41CC18 11 LCH: CHAR; V41CC18 12 BEGIN (* INSYMBOL *) COMP 1339 SETLINENUM := SETLINENUM OR (LINENUM <> NEXTNUM); COMP 1340 LINENUM := NEXTNUM; COMP 1341 1: OP := NOOP; COMP 1342 CASE CH OF COMP 1343 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', COMP 1344 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z': COMP 1345 BEGIN K := 0; ID.TEN := TENBLANKS; SY := IDENT; COMP 1346 UL := FALSE; LCH := ' '; V41CC18 13 REPEAT K := K + 1; COMP 1347 ID.TEN[K] := CH; COMP 1348 IF CH = '_' THEN V41CC18 14 BEGIN UL := TRUE; V41CC18 15 IF (LCH = '_') AND (OPTS.DIALECT = P6000) THEN ERROR(23) V41DC05 448 END; V41CC18 17 LCH := CH; V41CC18 18 CHCNT := CHCNT + 1; COMP 1349 IF CHCNT > SOURCELENGTH THEN CH := ' ' COMP 1350 ELSE CH := LINE[CHCNT] COMP 1351 UNTIL (K = ALFALENG) OR NOT (CH IN ['A'..'Z','0'..'9','_']); V41CC18 19 IF CH IN ['A'..'Z','0'..'9','_'] THEN (*EXTRA IDSEGMENTS NEEDED*) V41CC18 20 BEGIN I := 0; ID.EXT := IDSTART; IDEND^.EXTRA := IDBREAK; COMP 1354 IDEND := IDSTART; IDEND^.SEVEN := SEVENBLANKS; COMP 1355 REPEAT COMP 1356 IF I = IDNAMEEXTLEN THEN (* NEXT IDSEGMENT *) COMP 1357 BEGIN IDEND := IDEND^.EXTRA; COMP 1358 I := 0; IDEND^.SEVEN := SEVENBLANKS; COMP 1359 END; COMP 1360 I := I + 1; IDEND^.SEVEN[I] := CH; COMP 1361 IF CH = '_' THEN V41CC18 21 BEGIN UL := TRUE; V41CC18 22 IF (LCH = '_') AND (OPTS.DIALECT = P6000) THEN ERROR(23) V41DC05 449 END; V41CC18 24 LCH := CH; V41CC18 25 CHCNT := CHCNT + 1; COMP 1362 IF CHCNT > SOURCELENGTH THEN CH := ' ' COMP 1363 ELSE CH := LINE[CHCNT] COMP 1364 UNTIL NOT (CH IN ['A'..'Z','0'..'9','_']); V41CC18 26 IDBREAK := IDEND^.EXTRA; IDEND^.EXTRA := NIL; COMP 1366 END COMP 1367 ELSE COMP 1368 BEGIN ID.EXT := NIL; COMP 1369 IF ID.TEN[1] IN FLRW[K] THEN COMP 1370 FOR I := LRW[K-1] + 1 TO LRW[K] DO COMP 1371 IF RW[I] = ID.TEN THEN COMP 1372 BEGIN SY := RSY[I]; V41AC20 15 IF (SY IN NONSTANDSYS) AND (OPTS.DIALECT <> P6000) THEN V41DC05 450 BEGIN SY := IDENT; OP := NOOP END V41AC20 17 ELSE OP := ROP[I]; V41AC20 18 GOTO 2 V41AC20 19 END V41AC20 20 END; COMP 1374 IF UL THEN V41CC18 27 IF OPTS.DIALECT IN [ISO0,ISO1,ANSI] THEN ERROR(24) V41DC05 451 ELSE V41CC18 29 BEGIN IF LCH = '_' THEN ERROR(23); V41CC18 30 EXTENSION(335) V41CC18 31 END; V41CC18 32 2: END; COMP 1375 '0', '1', '2', '3', '4', '5', '6', '7', '8', '9': COMP 1376 BEGIN SY := INTCONST; COMP 1377 DCOUNT := 0; COMP 1378 UPPERD := 0; LOWERD := 0; COMP 1379 UPPERB := 0; LOWERB := 0; COMP 1380 UPPERR := 0; LOWERR := 0; COMP 1381 SCALE := 0; COMP 1382 BADB := FALSE; COMP 1383 REPEAT D := ORD(CH) - ORD('0'); COMP 1384 BADB := BADB OR NOT (CH IN ['0'..'7']); COMP 1385 LOWERD := LOWERD * 10 + D; COMP 1386 T := LOWERD DIV T30; COMP 1387 LOWERD := LOWERD - T * T30; COMP 1388 IF UPPERD < T30 THEN UPPERD := UPPERD * 10 + T; COMP 1389 LOWERB := LOWERB * 8 + D; COMP 1390 T := LOWERB DIV T30; COMP 1391 LOWERB := LOWERB - T * T30; COMP 1392 IF UPPERB < T30 THEN UPPERB := UPPERB * 8 + T; COMP 1393 IF DCOUNT < 28 THEN COMP 1394 BEGIN COMP 1395 IF DCOUNT < 14 THEN UPPERR := UPPERR * 10 + D COMP 1396 ELSE LOWERR := LOWERR * 10 + D; COMP 1397 IF (D <> 0) OR (DCOUNT <> 0) THEN DCOUNT := DCOUNT + 1 COMP 1398 END COMP 1399 ELSE SCALE := SCALE + 1; COMP 1400 NEXTCH COMP 1401 UNTIL NOT (CH IN DIGITS); COMP 1402 IVAL := 0; COMP 1403 IF (CH = 'B') AND (OPTS.DIALECT = P6000) THEN (* OCTAL CONST *) V41DC05 452 BEGIN NEXTCH; COMP 1405 EXTENSION(321); COMP 1406 IF BADB THEN ERROR(204) COMP 1407 ELSE COMP 1408 IF UPPERB >= T30 THEN ERROR(203) COMP 1409 ELSE IVAL := UPPERB * T30 + LOWERB COMP 1410 END COMP 1411 ELSE (* DECIMAL INTEGER OR REAL *) COMP 1412 BEGIN COMP 1413 DOT := CH = '.'; COMP 1414 IF DOT AND (CHCNT < SOURCELENGTH) THEN COMP 1415 DOT := LINE[CHCNT+1] IN DIGITS; COMP 1416 IF DOT OR (CH = 'E') THEN (* REAL NUMBER *) COMP 1417 BEGIN SY := REALCONST; COMP 1418 IF CH = '.' THEN (* GATHER FRACTION *) COMP 1419 BEGIN NEXTCH; COMP 1420 IF NOT (CH IN DIGITS) THEN ERROR(201) COMP 1421 ELSE COMP 1422 REPEAT D := ORD(CH) - ORD('0'); COMP 1423 IF DCOUNT < 28 THEN COMP 1424 BEGIN SCALE := SCALE - 1; COMP 1425 IF DCOUNT < 14 THEN UPPERR := UPPERR * 10 + D COMP 1426 ELSE LOWERR := LOWERR * 10 + D; COMP 1427 IF (D <> 0) OR (DCOUNT <> 0) THEN DCOUNT := DCOUNT + 1 COMP 1428 END; COMP 1429 NEXTCH COMP 1430 UNTIL NOT (CH IN DIGITS) COMP 1431 END; COMP 1432 IF CH = 'E' THEN (* GATHER EXPONENT *) COMP 1433 BEGIN NEXTCH; COMP 1434 IF CH IN ['+','-'] THEN COMP 1435 BEGIN SIGN := CH = '-'; NEXTCH END COMP 1436 ELSE SIGN := FALSE; COMP 1437 EXP := 0; ECOUNT := 0; COMP 1438 IF NOT (CH IN DIGITS) THEN ERROR(201) COMP 1439 ELSE COMP 1440 REPEAT D := ORD(CH) - ORD('0'); COMP 1441 IF ECOUNT < 14 THEN COMP 1442 BEGIN EXP := EXP * 10 + D; COMP 1443 IF (D <> 0) OR (ECOUNT <> 0) THEN ECOUNT := ECOUNT + 1 COMP 1444 END; COMP 1445 NEXTCH COMP 1446 UNTIL NOT (CH IN DIGITS); COMP 1447 IF SIGN THEN SCALE := SCALE - EXP ELSE SCALE := SCALE + EXP COMP 1448 END; COMP 1449 T1.UPPER := UPPERR; T1.LOWER := 0.0; COMP 1450 IF DCOUNT > 14 THEN COMP 1451 BEGIN T2.UPPER := LOWERR; T2.LOWER := 0.0; COMP 1452 TEN(T3,DCOUNT - 14); COMP 1453 DMUL(T1,T3,T1); COMP 1454 DADD(T1,T1,T2) COMP 1455 END; COMP 1456 EXP := SCALE + DCOUNT; COMP 1457 IF (EXP < LIM2) OR (EXP > LIM1) THEN COMP 1458 BEGIN T1.UPPER := 0.0; T1.LOWER := 0.0; SCALE := 0; COMP 1459 IF EXP > LIM1 THEN ERROR(207) COMP 1460 END; COMP 1461 TEN(T2,ABS(SCALE)); COMP 1462 IF SCALE < 0 THEN DDIV(T1,T1,T2) COMP 1463 ELSE COMP 1464 IF SCALE <> 0 THEN DMUL(T1,T1,T2); COMP 1465 RVAL := T1.UPPER + T1.LOWER COMP 1466 END (* REAL NUMBER *) COMP 1467 ELSE (* INTEGER NUMBER *) COMP 1468 IF UPPERD >= T29 THEN ERROR(203) COMP 1469 ELSE COMP 1470 BEGIN IVAL := UPPERD * T30 + LOWERD; COMP 1471 IF UPPERD > (MAXINT DIV T30) THEN V41AC20 22 IF OPTS.DIALECT = P6000 THEN EXTENSION(322) V41DC05 453 ELSE ERROR(203) V41AC20 24 END COMP 1473 END; COMP 1474 IF CH IN ['A'..'Z'] THEN ERROR(50) COMP 1475 END; COMP 1476 COL, PER: (* CHR(00B) AND CHR(63B) *) COMP 1477 BEGIN NEXTCH; COMP 1478 IF CH = '=' THEN COMP 1479 BEGIN SY := BECOMES; NEXTCH END COMP 1480 ELSE SY := COLON COMP 1481 END; COMP 1482 ' ': COMP 1483 BEGIN COMP 1484 REPEAT CHCNT := CHCNT + 1; COMP 1485 IF CHCNT > SOURCELENGTH THEN COMP 1486 BEGIN ENDLINE; BEGINLINE; CH := ' ' END COMP 1487 ELSE CH := LINE[CHCNT] COMP 1488 UNTIL CH <> ' '; COMP 1489 GOTO 1 COMP 1490 END; COMP 1491 '#', '''': COMP 1492 IF ASCII = (CH = '''') THEN (* QUOTE CHARACTER *) COMP 1493 BEGIN Q := CH; COMP 1494 APO := FALSE; STRINGEND := FALSE; COMP 1495 LGTH := 0; I := 0; CONSTP := NIL; COMP 1496 OA.I := 0; (* GUARANTEE ZEROS IN UNUSED BITS *) COMP 1497 NEXTCH; COMP 1498 REPEAT COMP 1499 IF CHCNT > SOURCELENGTH THEN COMP 1500 BEGIN ERROR(202); STRINGEND := TRUE END COMP 1501 ELSE COMP 1502 IF (CH <> Q) OR APO THEN COMP 1503 BEGIN COMP 1504 IF I = ALFALENG THEN COMP 1505 BEGIN MNEW(TAILP); COMP 1506 WITH TAILP^ DO COMP 1507 BEGIN NXTCSP := CONSTP; CSVAL := OA.I END; COMP 1508 CONSTP := TAILP; I := 0; OA.I := 0 COMP 1509 END; COMP 1510 I := I + 1; LGTH := LGTH + 1; APO := FALSE; COMP 1511 OA.A[I] := CH; COMP 1512 NEXTCH COMP 1513 END COMP 1514 ELSE COMP 1515 BEGIN APO := TRUE; COMP 1516 NEXTCH; STRINGEND := CH <> Q COMP 1517 END COMP 1518 UNTIL STRINGEND; COMP 1519 SY := STRINGCONST; COMP 1520 IF LGTH = 0 THEN ERROR(205) COMP 1521 ELSE COMP 1522 IF LGTH = 1 THEN COMP 1523 BEGIN SY := CHARCONST; IVAL := ORD(OA.A[1]) END COMP 1524 ELSE COMP 1525 BEGIN MNEW(TAILP); COMP 1526 WITH TAILP^ DO COMP 1527 BEGIN NXTCSP := CONSTP; CSVAL := OA.I END; COMP 1528 (*REVERSE POINTERS:*) COMP 1529 CONSTP := NIL; COMP 1530 WHILE TAILP <> NIL DO COMP 1531 WITH TAILP^ DO COMP 1532 BEGIN NXTP := NXTCSP; NXTCSP := CONSTP; COMP 1533 CONSTP := TAILP; TAILP := NXTP COMP 1534 END; COMP 1535 END COMP 1536 END COMP 1537 ELSE COMP 1538 BEGIN COMP 1539 IF ASCII THEN (* '#' IS A BAD CHARACTER *) COMP 1540 SY := OTHERSY COMP 1541 ELSE (* '''' IS A ARROW *) COMP 1542 SY := ARROW; COMP 1543 NEXTCH COMP 1544 END; COMP 1545 '.': COMP 1546 BEGIN NEXTCH; COMP 1547 IF CH = '.' THEN COMP 1548 BEGIN SY := DOTDOT; NEXTCH END COMP 1549 ELSE IF CH = ')' THEN COMP 1550 BEGIN SY := RBRACK; NEXTCH END COMP 1551 ELSE SY := PERIOD COMP 1552 END; COMP 1553 '(': COMP 1554 BEGIN NEXTCH; COMP 1555 IF CH = '*' THEN COMP 1556 BEGIN NEXTCH; COMP 1557 IF (CH = '$') AND OPTALLOWED THEN OPTIONS(NEXTCH); COMP 1558 STARTCMT := FALSE; COMP 1559 REPEAT COMP 1560 IF STARTCMT THEN ERROR(351); COMP 1561 REPEAT COMP 1562 (*LOOP UNTIL CH IN ['*','(']:*) COMP 1563 WHILE NOT (CH IN ['*','(']) DO NEXTCH; COMP 1564 STARTCMT := CH = '('; COMP 1565 IF STARTCMT THEN NEXTCH COMP 1566 UNTIL CH = '*'; COMP 1567 NEXTCH COMP 1568 UNTIL CH = ')'; COMP 1569 NEXTCH; GOTO 1 COMP 1570 END; COMP 1571 IF CH = '.' THEN COMP 1572 BEGIN SY := LBRACK; NEXTCH END COMP 1573 ELSE SY := LPARENT; COMP 1574 END; COMP 1575 '<': COMP 1576 BEGIN NEXTCH; SY := RELOP; COMP 1577 IF CH = '=' THEN COMP 1578 BEGIN OP := LEOP; NEXTCH END COMP 1579 ELSE COMP 1580 IF CH = '>' THEN COMP 1581 BEGIN OP := NEOP; NEXTCH END COMP 1582 ELSE OP := LTOP COMP 1583 END; COMP 1584 '>': COMP 1585 BEGIN NEXTCH; SY := RELOP; COMP 1586 IF CH = '=' THEN COMP 1587 BEGIN OP := GEOP; NEXTCH END COMP 1588 ELSE OP := GTOP COMP 1589 END; COMP 1590 '+', '-', '*', '/', ')', '$', '=', ',', '[', COMP 1591 ']', '"', '_', '!', '&', '?', '@', '\', '^', ';': COMP 1592 BEGIN SY := SSY[ASCII,CH]; OP := SOP[CH]; NEXTCH END COMP 1593 END (* CASE *) COMP 1594 END (* INSYMBOL *); COMP 1595 (*$L'SYMBOL / STRUCTURE TABLE PROCESSORS.' *) COMP 1596 COMP 1597 COMP 1598 PROCEDURE WRITEID(NAME: IDNAME); COMP 1599 V41DC05 454 PROCEDURE PUTID(VAR F : SEGTEXT); V41DC05 455 VAR S : IDSEGMENT; V41DC05 456 BEGIN (* PUTID *) V41DC05 457 WRITE(F,NAME.TEN); S := NAME.EXT; V41DC05 458 WHILE S <> NIL DO V41DC05 459 BEGIN WRITE(F,S^.SEVEN); S := S^.EXTRA END; V41DC05 460 WRITELN(F) V41DC05 461 END (* PUTID *); V41DC05 462 V41DC05 463 BEGIN (* WRITEID *) V41DC05 464 IF LISTINGOPEN THEN PUTID(LISTING); V41DC05 465 IF ERRFILEOPEN THEN PUTID(ERRFILE) V41DC05 466 END (* WRITEID *); COMP 1606 COMP 1607 FUNCTION COMPAREEXTENSIONS(FXP1, FXP2: IDSEGMENT): ORDERING; COMP 1608 BEGIN COMP 1609 WHILE (FXP1 <> NIL) AND (FXP2 <> NIL) DO COMP 1610 IF FXP1^.SEVEN < FXP2^.SEVEN THEN FXP1 := NIL COMP 1611 ELSE COMP 1612 IF FXP1^.SEVEN > FXP2^.SEVEN THEN FXP2 := NIL COMP 1613 ELSE COMP 1614 BEGIN FXP1 := FXP1^.EXTRA; FXP2 := FXP2^.EXTRA END; COMP 1615 IF FXP1 = FXP2 THEN COMPAREEXTENSIONS := EQUALTO COMP 1616 ELSE COMP 1617 IF FXP1 = NIL THEN COMPAREEXTENSIONS := LESSTHAN COMP 1618 ELSE COMPAREEXTENSIONS := GREATERTHAN COMP 1619 END (* COMPAREEXTENSIONS *); COMP 1620 COMP 1621 FUNCTION COMPAREIDS(FID1,FID2: IDNAME): ORDERING; COMP 1622 BEGIN (* COMPAREIDS *) COMP 1623 IF FID1.TEN < FID2.TEN THEN COMPAREIDS := LESSTHAN COMP 1624 ELSE COMP 1625 IF FID1.TEN > FID2.TEN THEN COMPAREIDS := GREATERTHAN COMP 1626 ELSE COMPAREIDS := COMPAREEXTENSIONS(FID1.EXT,FID2.EXT) COMP 1627 END (* COMPAREIDS *); COMP 1628 COMP 1629 PROCEDURE COPYID(VAR FCP: CTP); COMP 1630 (*COPY (AND ALLOCATE DYNAMIC STORAGE IF NECESSARY) ID INTO THE LCP COMP 1631 WHICH WILL EVENTUALLY BE PLACED IN THE SYMBOL TABLE BY ENTERID. COMP 1632 UNFORTUNATELY THE COPY CANNOT BE MADE BY ENTERID INSTEAD. *) COMP 1633 VAR S1,S2: IDSEGMENT; COMP 1634 BEGIN FCP^.NAME := ID; COMP 1635 IF ID.EXT <> NIL THEN (* COPY SEGMENTS *) COMP 1636 BEGIN MNEW(S2); S1 := ID.EXT; FCP^.NAME.EXT := S2; COMP 1637 S2^.SEVEN := S1^.SEVEN; S1 := S1^.EXTRA; COMP 1638 WHILE S1 <> NIL DO COMP 1639 BEGIN MNEW(S2^.EXTRA); S2 := S2^.EXTRA; COMP 1640 S2^.SEVEN := S1^.SEVEN; S1 := S1^.EXTRA COMP 1641 END; COMP 1642 S2^.EXTRA := NIL COMP 1643 END COMP 1644 END (* COPYID *); COMP 1645 COMP 1646 PROCEDURE ENTERID(FCP: CTP; FREGION: WHERE); COMP 1647 (*ENTER ID POINTED AT BY FCP INTO THE NAME-TABLE, COMP 1648 WHICH ON EACH DECLARATION LEVEL IS ORGANISED AS COMP 1649 AN UNBALANCED BINARY TREE*) COMP 1650 VAR NAM: IDNAME; LCP, LCP1: CTP; LLEFT, CONFLICT: BOOLEAN; COMP 1651 LLEV, LLEV1: DISPRANGE; COMP 1652 COMP 1653 PROCEDURE CHECKFWPTR(FCP: CTP); COMP 1654 BEGIN COMP 1655 WHILE FCP <> NIL DO COMP 1656 BEGIN IF COMPAREIDS(FCP^.NAME,NAM) = EQUALTO THEN CONFLICT := TRUE; COMP 1657 FCP := FCP^.NEXT COMP 1658 END COMP 1659 END (* CHECKFWPTR *); COMP 1660 COMP 1661 PROCEDURE SEARCHNAM(FCP: CTP; VAR FCP1: CTP); COMP 1662 BEGIN COMP 1663 FCP1 := NIL; COMP 1664 WHILE FCP <> NIL DO COMP 1665 CASE COMPAREIDS(FCP^.NAME,NAM) OF COMP 1666 LESSTHAN : FCP := FCP^.RLINK; COMP 1667 EQUALTO : BEGIN FCP1 := FCP; FCP := NIL END; COMP 1668 GREATERTHAN: FCP := FCP^.LLINK COMP 1669 END COMP 1670 END (* SEARCHNAM *); COMP 1671 COMP 1672 BEGIN (* ENTERID *) COMP 1673 CONFLICT := FALSE; NAM := FCP^.NAME; COMP 1674 CHECKFWPTR(FWPTR); LLEV := TOP; COMP 1675 WHILE FREGION <> DISPLAY[LLEV].REGION DO COMP 1676 WITH DISPLAY[LLEV] DO COMP 1677 BEGIN IF REGION = DREC THEN CHECKFWPTR(FFWPTR); COMP 1678 SEARCHNAM(FNAME,LCP); COMP 1679 IF LCP <> NIL THEN CONFLICT := TRUE; COMP 1680 LLEV := LLEV - 1 COMP 1681 END; COMP 1682 LLEV1 := LLEV; COMP 1683 WHILE LLEV > 0 DO COMP 1684 BEGIN LLEV := LLEV - 1; COMP 1685 SEARCHNAM(DISPLAY[LLEV].FNAME,LCP); COMP 1686 IF LCP <> NIL THEN COMP 1687 BEGIN COMP 1688 IF LCP^.LASTUSESCOPE >= THISSCOPE THEN CONFLICT := TRUE; COMP 1689 LLEV := 0 COMP 1690 END COMP 1691 END; COMP 1692 LCP := DISPLAY[LLEV1].FNAME; COMP 1693 IF LCP = NIL THEN COMP 1694 DISPLAY[LLEV1].FNAME := FCP COMP 1695 ELSE COMP 1696 BEGIN COMP 1697 REPEAT LCP1 := LCP; COMP 1698 CASE COMPAREIDS(LCP^.NAME,NAM) OF COMP 1699 LESSTHAN: COMP 1700 BEGIN LCP := LCP^.RLINK; LLEFT := FALSE END; COMP 1701 EQUALTO: (* NAME CONFLICT--FOLLOW RIGHT LINK *) COMP 1702 BEGIN ERROR(101); LCP := LCP^.RLINK; LLEFT := FALSE END; COMP 1703 GREATERTHAN: COMP 1704 BEGIN LCP := LCP^.LLINK; LLEFT := TRUE END; COMP 1705 END COMP 1706 UNTIL LCP = NIL; COMP 1707 IF LLEFT THEN LCP1^.LLINK := FCP ELSE LCP1^.RLINK := FCP COMP 1708 END; COMP 1709 FCP^.LLINK := NIL; FCP^.RLINK := NIL; COMP 1710 FCP^.LASTUSESCOPE := 0; COMP 1711 IF CONFLICT THEN ERROR(190); COMP 1712 END (*ENTERID*) ; COMP 1713 COMP 1714 PROCEDURE SEARCHSECTION(FCP: CTP; VAR FCP1: CTP); COMP 1715 (*TO FIND RECORD FIELDS AND FORWARD DECLARED PROCEDURE ID'S' COMP 1716 --> PROCEDURE PROCEDUREDECLARATION COMP 1717 --> PROCEDURE SELECTOR*) COMP 1718 LABEL 1; COMP 1719 BEGIN COMP 1720 WHILE FCP <> NIL DO COMP 1721 CASE COMPAREIDS(FCP^.NAME,ID) OF COMP 1722 LESSTHAN : FCP := FCP^.RLINK; COMP 1723 EQUALTO : GOTO 1; COMP 1724 GREATERTHAN: FCP := FCP^.LLINK COMP 1725 END; COMP 1726 1: FCP1 := FCP COMP 1727 END (*SEARCHSECTION*) ; COMP 1728 COMP 1729 PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP); COMP 1730 LABEL 1; COMP 1731 VAR LCP: CTP; LDISX: DISPRANGE; COMP 1732 BEGIN COMP 1733 FOR LDISX := TOP DOWNTO -1 DO COMP 1734 BEGIN LCP := DISPLAY[LDISX].FNAME; COMP 1735 WHILE LCP <> NIL DO (* IN-LINE COMPAREIDS *) COMP 1736 IF LCP^.NAME.TEN < ID.TEN THEN LCP := LCP^.RLINK COMP 1737 ELSE COMP 1738 IF LCP^.NAME.TEN > ID.TEN THEN LCP := LCP^.LLINK COMP 1739 ELSE COMP 1740 CASE COMPAREEXTENSIONS(LCP^.NAME.EXT,ID.EXT) OF COMP 1741 LESSTHAN: COMP 1742 LCP := LCP^.RLINK; COMP 1743 EQUALTO: COMP 1744 IF LCP^.KLASS IN FIDCLS THEN COMP 1745 BEGIN IF LDISX = -1 THEN EXTENSION(320); COMP 1746 LCP^.LASTUSESCOPE := THISSCOPE; GOTO 1 COMP 1747 END COMP 1748 ELSE COMP 1749 BEGIN IF NOT (UNKNOWNID IN FIDCLS) THEN ERROR(103); COMP 1750 LCP := LCP^.RLINK COMP 1751 END; COMP 1752 GREATERTHAN: COMP 1753 LCP := LCP^.LLINK COMP 1754 END (* CASE *) COMP 1755 END; COMP 1756 LDISX := 0; COMP 1757 (*SEARCH NOT SUCCESSFUL; SUPPRESS ERROR MESSAGE IN CASE COMP 1758 OF FORWARD REFERENCED TYPE ID IN POINTER TYPE DEFINITION COMP 1759 OR VARIANTS WITHOUT TAGFIELDS COMP 1760 --> PROCEDURE FIELDLIST COMP 1761 --> PROCEDURE SIMPLETYPE*) COMP 1762 IF NOT (UNKNOWNID IN FIDCLS) THEN COMP 1763 BEGIN ERROR(104); COMP 1764 (*TO AVOID RETURNING NIL, REFERENCE AN ENTRY COMP 1765 FOR AN UNDECLARED ID OF APPROPRIATE CLASS COMP 1766 --> PROCEDURE ENTERUNDECL*) COMP 1767 IF TYPES IN FIDCLS THEN LCP := UTYPPTR COMP 1768 ELSE COMP 1769 IF VARS IN FIDCLS THEN LCP := UVARPTR COMP 1770 ELSE COMP 1771 IF FIELD IN FIDCLS THEN LCP := UFLDPTR COMP 1772 ELSE COMP 1773 IF KONST IN FIDCLS THEN LCP := UCSTPTR COMP 1774 ELSE COMP 1775 IF PROC IN FIDCLS THEN LCP := UPRCPTR COMP 1776 ELSE LCP := UFCTPTR; COMP 1777 END; COMP 1778 1: FCP := LCP; DISX := LDISX COMP 1779 END (*SEARCHID*) ; COMP 1780 V41CC07 35 PROCEDURE DISPOSEID(FCP: CTP); V41CC07 36 VAR LXP1, LXP2: IDSEGMENT; V41CC07 37 BEGIN (* DISPOSEID *) V41CC07 38 LXP1 := FCP^.NAME.EXT; V41CC07 39 WHILE LXP1 <> NIL DO V41CC07 40 BEGIN V41CC07 41 LXP2 := LXP1^.EXTRA; V41CC07 42 DISPOSE(LXP1); V41CC07 43 LXP1 := LXP2 V41CC07 44 END; V41CC07 45 DISPOSE(FCP) V41CC07 46 END (* DISPOSEID *) ; V41CC07 47 COMP 1781 PROCEDURE GETBOUNDS(FSP: STP; VAR FMIN,FMAX: INTEGER); COMP 1782 (* GET INTERNAL BOUNDS OF ORDINAL TYPE *) COMP 1783 (* ASSUME FSP <> REALPTR *) COMP 1784 BEGIN COMP 1785 IF FSP <> NIL THEN COMP 1786 WITH FSP^ DO COMP 1787 IF FORM = SUBRANGE THEN COMP 1788 BEGIN FMIN := MIN.IVAL; FMAX := MAX.IVAL END COMP 1789 ELSE COMP 1790 BEGIN FMIN := 0; FMAX := 0; COMP 1791 IF FORM = SCALAR THEN COMP 1792 BEGIN COMP 1793 IF SCALKIND = PREDECLARED THEN COMP 1794 BEGIN COMP 1795 IF FSP = CHARPTR THEN COMP 1796 BEGIN FMIN := MINORDCH; FMAX := MAXORDCH END COMP 1797 ELSE COMP 1798 IF FSP = INTPTR THEN COMP 1799 BEGIN FMIN := -MAXINT; FMAX := MAXINT END COMP 1800 END COMP 1801 ELSE COMP 1802 IF FSP^.FCONST <> NIL THEN COMP 1803 FMAX := FSP^.FCONST^.VALUES.IVAL COMP 1804 END COMP 1805 END COMP 1806 END (*GETBOUNDS*); COMP 1807 COMP 1808 FUNCTION NROFBITS(FVAL: INTEGER): INTEGER; COMP 1809 (*COMPUTE NUMBER OF BITS NECESSARY TO REPRESENT 0..FVAL*) COMP 1810 VAR B: INTEGER; COMP 1811 BEGIN B := 0; COMP 1812 REPEAT FVAL := FVAL DIV 2; B := B + 1 COMP 1813 UNTIL FVAL = 0; COMP 1814 NROFBITS := B COMP 1815 END (*NROFBITS*); COMP 1816 COMP 1817 PROCEDURE SKIP(FSYS: SETOFSYS); COMP 1818 (*SKIP INPUT STRING UNTIL RELEVANT SYMBOL FOUND*) COMP 1819 BEGIN WHILE NOT (SY IN FSYS) DO INSYMBOL COMP 1820 END (*SKIP*) ; COMP 1821 COMP 1822 PROCEDURE EXPECTSYMBOL(FSY: SYMBOL; FERR: ERRINDEX); COMP 1823 BEGIN IF SY = FSY THEN INSYMBOL ELSE ERROR(FERR) COMP 1824 END (* EXPECTSYMBOL *); COMP 1825 COMP 1826 PROCEDURE CHECKCONTEXT(FSYS1:SETOFSYS; FERR:ERRINDEX; FSYS2:SETOFSYS); COMP 1827 BEGIN COMP 1828 IF NOT (SY IN FSYS1) THEN COMP 1829 BEGIN ERROR(FERR); SKIP(FSYS1+FSYS2) END COMP 1830 END (* CHECKCONTEXT *); COMP 1831 (*$L'PROCEDURE / FUNCTION BLOCK PROCESSOR.' *) COMP 1832 COMP 1833 COMP 1834 PROCEDURE BLOCK(FSYS: SETOFSYS; FSY: SYMBOL; FPROCP: CTP); COMP 1835 VAR LSY: SYMBOL; FLABP: LBP; LFSTCSP: CSP; COMP 1836 LFORWCNT: INTEGER; COMP 1837 PMD: PMDKIND; COMP 1838 BLOCKSCOPE: SCOPERANGE; COMP 1839 INORDER,EXITLOOP: BOOLEAN; COMP 1840 COMP 1841 PROCEDURE CHECKFORW(FCP: CTP); V41CC20 12 (*PRINT ERROR MESSAGE FOR FORWARD DECLARED PROCEDURE*) V41CC20 13 BEGIN V41CC20 14 IF FCP <> NIL THEN V41CC20 15 WITH FCP^ DO V41CC20 16 BEGIN V41CC20 17 IF KLASS IN [PROC,FUNC] THEN V41CC20 18 IF PFKIND = ACTUAL THEN V41CC20 19 IF PFDECL = FORWDECL THEN V41CC20 20 BEGIN PFDECL := FORWDECLERR; ERROR(117); V41CC20 21 FLAGERROR; PUTERRMSG(' UNDECLARED PROCEDURE: ',FALSE); V41DC05 467 WRITEID(NAME) V41DC05 468 END; V41CC20 24 CHECKFORW(LLINK); CHECKFORW(RLINK) V41CC20 25 END V41CC20 26 END (*CHECKFORW*); V41CC20 27 COMP 1858 FUNCTION FULLWORDS(FSIZE: WBSIZE) : INTEGER; COMP 1859 BEGIN COMP 1860 WITH FSIZE DO FULLWORDS := WORDS + ORD(BITS <> 0) COMP 1861 END (*FULLWORDS*) ; COMP 1862 COMP 1863 FUNCTION CONFORMARRAY(FSP: STP): BOOLEAN; COMP 1864 (* DETERMINE IF STRUCTURE POINTED TO BY FSP IS CONFORMANT ARRAY. *) COMP 1865 BEGIN CONFORMARRAY := FALSE; COMP 1866 IF FSP <> NIL THEN COMP 1867 WITH FSP^ DO COMP 1868 IF FORM = ARRAYS THEN COMP 1869 IF CONFORMANT THEN CONFORMARRAY := TRUE COMP 1870 END (* CONFORMARRAY *); COMP 1871 COMP 1872 FUNCTION EMPTYCNF(FSP: STP): BOOLEAN; COMP 1873 (* DETERMINE IF STRUCTURE POINTED TO BY FSP HAS EMPTY ARRAY COMP 1874 ELEMENTS. ASSUMES FSP POINTS TO CONFORMANT ARRAY SCHEMA. *) COMP 1875 BEGIN EMPTYCNF := TRUE; COMP 1876 WHILE CONFORMARRAY(FSP) DO FSP := FSP^.AELTYPE; COMP 1877 IF FSP <> NIL THEN COMP 1878 EMPTYCNF := FULLWORDS(FSP^.SIZE) = 0 COMP 1879 END (* EMPTYCNF *); COMP 1880 COMP 1881 FUNCTION COMPTYPES(FSP1,FSP2: STP): BOOLEAN; FORWARD; COMP 1882 COMP 1883 FUNCTION STRING(FSP: STP): BOOLEAN; COMP 1884 (* DETERMINE IF FSP DESCRIBES A STRING TYPE *) COMP 1885 VAR LMIN,LMAX: INTEGER; COMP 1886 BEGIN (* STRING *) COMP 1887 STRING := FALSE; COMP 1888 IF FSP <> NIL THEN COMP 1889 WITH FSP^ DO COMP 1890 IF FORM = ARRAYS THEN COMP 1891 IF PCKDARR AND (AELTYPE = CHARPTR) THEN COMP 1892 IF CONFORMANT THEN COMP 1893 BEGIN COMP 1894 IF INXTYPE <> NIL THEN COMP 1895 STRING := COMPTYPES(INXTYPE^.BOUNDTYPE,INTPTR) V41AC11 9 END COMP 1897 ELSE COMP 1898 IF COMPTYPES(INXTYPE,INTPTR) AND (INXTYPE <> NIL) THEN COMP 1899 BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX); COMP 1900 STRING := (LMIN = 1) AND (LMAX > 1) V41AC11 10 END COMP 1902 END (* STRING *); COMP 1903 COMP 1904 FUNCTION COMPTYPES; COMP 1905 VAR LMIN1,LMAX1,LMIN2,LMAX2: INTEGER; COMP 1906 BEGIN (*COMPTYPES*) COMP 1907 IF FSP1 <> NIL THEN COMP 1908 IF FSP1^.FORM = SUBRANGE THEN COMP 1909 FSP1 := FSP1^.RANGETYPE; COMP 1910 IF FSP2 <> NIL THEN COMP 1911 IF FSP2^.FORM = SUBRANGE THEN COMP 1912 FSP2 := FSP2^.RANGETYPE; COMP 1913 IF FSP1 = FSP2 THEN COMPTYPES := TRUE COMP 1914 ELSE COMP 1915 IF (FSP1 <> NIL)AND (FSP2 <> NIL) THEN COMP 1916 IF FSP1^.FORM = FSP2^.FORM THEN COMP 1917 CASE FSP1^.FORM OF COMP 1918 POINTER: COMP 1919 COMPTYPES := (FSP1 = NILPTR) OR (FSP2 = NILPTR); COMP 1920 POWER: COMP 1921 COMPTYPES := (FSP1^.PCKDSET * FSP2^.PCKDSET <> []) COMP 1922 AND COMPTYPES(FSP1^.ELSET,FSP2^.ELSET); COMP 1923 ARRAYS: COMP 1924 BEGIN COMPTYPES := FALSE; COMP 1925 IF STRING(FSP1) THEN COMP 1926 IF STRING(FSP2) THEN COMP 1927 IF NOT CONFORMARRAY(FSP1) THEN COMP 1928 IF NOT CONFORMARRAY(FSP2) THEN COMP 1929 BEGIN GETBOUNDS(FSP1^.INXTYPE,LMIN1,LMAX1); COMP 1930 GETBOUNDS(FSP2^.INXTYPE,LMIN2,LMAX2); COMP 1931 COMPTYPES := LMAX1 = LMAX2 COMP 1932 END COMP 1933 END; COMP 1934 SCALAR, COMP 1935 REALS, COMP 1936 BOUNDDESC, COMP 1937 RECORDS, COMP 1938 FILES: COMP 1939 COMPTYPES := FALSE COMP 1940 END (*CASE*) COMP 1941 ELSE COMPTYPES := FALSE COMP 1942 ELSE COMPTYPES := TRUE COMP 1943 END (*COMPTYPES*) ; COMP 1944 COMP 1945 PROCEDURE STRINGTYPE(VAR FSP: STP); COMP 1946 (*ENTER TYPE OF STRINGCONST (PACKED ARRAY [1..LGTH] OF CHAR) INTO COMP 1947 STRUCTURE TABLE*) COMP 1948 VAR LSP,LSP1: STP; COMP 1949 BEGIN MNEW(LSP,SUBRANGE); COMP 1950 WITH LSP^ DO COMP 1951 BEGIN FORM := SUBRANGE; RANGETYPE := INTPTR; COMP 1952 MIN.IVAL := 1; MAX.IVAL := LGTH ; FTYPE := FALSE; COMP 1953 WITH SIZE DO COMP 1954 BEGIN WORDS := 0; BITS := NROFBITS(LGTH) END COMP 1955 END; COMP 1956 MNEW(LSP1,ARRAYS,TRUE,TRUE); COMP 1957 WITH LSP1^ DO COMP 1958 BEGIN FORM := ARRAYS; CONFORMANT := FALSE; COMP 1959 AELTYPE := CHARPTR; INXTYPE := LSP; COMP 1960 PCKDARR := TRUE; PARTWORDELS := TRUE; COMP 1961 ELSPERWORD := ALFALENG; FTYPE := FALSE; COMP 1962 WITH SIZE DO COMP 1963 BEGIN WORDS := LGTH DIV ALFALENG; COMP 1964 BITS := (LGTH MOD ALFALENG) * CHARSIZE COMP 1965 END COMP 1966 END; COMP 1967 FSP := LSP1 COMP 1968 END (*STRINGTYPE*) ; COMP 1969 (*$L'DECLARATIONS PROCESSORS.' *) COMP 1970 COMP 1971 COMP 1972 PROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU); COMP 1973 VAR LSP: STP; LCP: CTP; SIGN: (NONE,POS,NEG); LCSP: CSP; COMP 1974 BEGIN LSP := NIL; FVALU.IVAL := 0; COMP 1975 CHECKCONTEXT(CONSTBEGSYS,50,FSYS); COMP 1976 IF SY IN CONSTBEGSYS THEN COMP 1977 BEGIN COMP 1978 IF SY = CHARCONST THEN COMP 1979 BEGIN LSP := CHARPTR; FVALU.IVAL := IVAL; INSYMBOL END COMP 1980 ELSE COMP 1981 IF SY = STRINGCONST THEN COMP 1982 BEGIN STRINGTYPE(LSP); COMP 1983 FVALU.VALP := CONSTP; COMP 1984 INSYMBOL COMP 1985 END COMP 1986 ELSE COMP 1987 BEGIN COMP 1988 SIGN := NONE; COMP 1989 IF OP IN [PLUS,MINUS] THEN COMP 1990 BEGIN IF OP = PLUS THEN SIGN := POS ELSE SIGN := NEG; COMP 1991 INSYMBOL COMP 1992 END; COMP 1993 IF SY = IDENT THEN COMP 1994 BEGIN SEARCHID([KONST],LCP); COMP 1995 WITH LCP^ DO COMP 1996 BEGIN LSP := IDTYPE; FVALU := VALUES END; COMP 1997 IF SIGN <> NONE THEN COMP 1998 IF LSP = INTPTR THEN COMP 1999 BEGIN IF SIGN = NEG THEN FVALU.IVAL := -FVALU.IVAL END COMP 2000 ELSE COMP 2001 IF LSP = REALPTR THEN COMP 2002 BEGIN COMP 2003 IF SIGN = NEG THEN FVALU.RVAL := -FVALU.RVAL COMP 2004 END COMP 2005 ELSE ERROR(105); COMP 2006 INSYMBOL; COMP 2007 END COMP 2008 ELSE COMP 2009 IF SY = INTCONST THEN COMP 2010 BEGIN IF SIGN = NEG THEN IVAL := -IVAL; COMP 2011 LSP := INTPTR; FVALU.IVAL := IVAL; INSYMBOL COMP 2012 END COMP 2013 ELSE COMP 2014 IF SY = REALCONST THEN COMP 2015 BEGIN IF SIGN = NEG THEN RVAL := -RVAL; COMP 2016 LSP := REALPTR; FVALU.RVAL := RVAL; INSYMBOL COMP 2017 END COMP 2018 ELSE COMP 2019 BEGIN ERROR(106); SKIP(FSYS) END COMP 2020 END; COMP 2021 CHECKCONTEXT(FSYS,6,[]) COMP 2022 END; COMP 2023 FSP := LSP COMP 2024 END (*CONSTANT*) ; COMP 2025 COMP 2026 PROCEDURE CASECONSTANTLIST(FSYS: SETOFSYS; FSP: STP; V41CC07 48 FMIN,FMAX: INTEGER; FERROR: ERRINDEX; V41CC07 49 VAR FCC1,FCC2: CCP); V41CC07 50 (* PARSE A CASE CONSTANT LIST, PUTTING ENTRIES INTO THE ASCENDING V41CC07 51 LIST HEADED BY FCC1; ALL ENTRIES FOR THIS LIST ARE THREADED V41CC07 52 STARTING AT FCC2 (RETURNED). *) V41CC07 53 VAR V41CC07 54 LSP1,LSP2: STP; LCC1,LCC2,LCC3: CCP; DONE: BOOLEAN; V41CC07 55 LMIN,LMAX: INTEGER; V41CC07 56 V41CC07 57 PROCEDURE INSERT; V41CC07 58 BEGIN (* INSERT *) V41CC07 59 WITH LCC3^ DO V41CC07 60 BEGIN NEXTCC := LCC1; V41CC07 61 CCMAX := LMAX; CCMIN := LMIN; V41CC07 62 IF LCC2 <> NIL THEN LCC2^.NEXTCC := LCC3 V41CC07 63 ELSE FCC1 := LCC3; V41CC07 64 THREAD := FCC2; FCC2 := LCC3 V41CC07 65 END V41CC07 66 END (* INSERT *) ; V41CC07 67 V41CC07 68 PROCEDURE CASECONSTANT(FSYS: SETOFSYS; V41CC07 69 VAR FSP2: STP; VAR FVAL: INTEGER); V41CC07 70 VAR LVAL: VALU; V41CC07 71 BEGIN (* CASECONSTANT *) V41CC07 72 CONSTANT(FSYS,FSP2,LVAL); FVAL := LVAL.IVAL; V41CC07 73 IF (FSP2 <> NIL) AND (FSP <> NIL) THEN V41CC07 74 IF NOT COMPTYPES(FSP,FSP2) OR (FSP2^.FORM > SUBRANGE) THEN V41CC07 75 BEGIN ERROR(147); FSP2 := NIL END V41CC07 76 ELSE IF (LVAL.IVAL < FMIN) OR (LVAL.IVAL > FMAX) THEN V41CC07 77 BEGIN ERROR(FERROR); FSP2 := NIL END V41CC07 78 END (* CASECONSTANT *) ; V41CC07 79 V41CC07 80 BEGIN (* CASECONSTANTLIST *) ; V41CC07 81 FCC2 := NIL; V41CC07 82 REPEAT V41CC07 83 CASECONSTANT(FSYS+[COMMA,COLON,DOTDOT],LSP1,LMIN); V41CC07 84 LMAX := LMIN; LSP2 := LSP1; V41CC07 85 IF OPTS.DIALECT = P6000 THEN V41DC05 469 IF SY = DOTDOT THEN V41CC07 87 BEGIN EXTENSION(334); INSYMBOL; V41CC07 88 CASECONSTANT(FSYS+[COMMA,COLON],LSP2,LMAX) V41CC07 89 END; V41CC07 90 IF (FSP<>NIL) AND (LSP1<>NIL) AND (LSP2 <> NIL) THEN V41CC07 91 BEGIN V41CC07 92 LCC1 := FCC1; LCC2 := NIL; DONE := FALSE; V41CC07 93 IF LMIN <= LMAX THEN V41CC07 94 REPEAT V41CC07 95 IF LCC1 = NIL THEN V41CC07 96 BEGIN NEW(LCC3); INSERT; DONE := TRUE END V41CC07 97 ELSE V41CC07 98 WITH LCC1^ DO V41CC07 99 IF LMIN <= CCMAX THEN V41CC07 100 IF LMAX < CCMIN THEN V41CC07 101 BEGIN NEW(LCC3); INSERT; DONE := TRUE END V41CC07 102 ELSE V41CC07 103 BEGIN ERROR(156); FCC2 := NIL; V41CC07 104 IF CCMIN < LMIN THEN LMIN := CCMIN; V41CC07 105 REPEAT LCC3 := LCC1; V41CC07 106 LCC1 := LCC1^.NEXTCC; V41CC07 107 IF LCC1 = NIL THEN DONE := TRUE V41CC07 108 ELSE V41CC07 109 IF LMAX < LCC1^.CCMIN THEN DONE := TRUE V41CC07 110 ELSE DISPOSE(LCC3); V41CC07 111 UNTIL DONE; V41CC07 112 IF LCC3^.CCMAX > LMAX THEN LMAX := LCC3^.CCMAX; V41CC07 113 INSERT V41CC07 114 END V41CC07 115 ELSE V41CC07 116 BEGIN LCC2 := LCC1; LCC1 := NEXTCC END V41CC07 117 UNTIL DONE V41CC07 118 ELSE ERROR(102) V41CC07 119 END; V41CC07 120 DONE := SY <> COMMA; V41CC07 121 IF NOT DONE THEN INSYMBOL V41CC07 122 UNTIL DONE; V41CC07 123 EXPECTSYMBOL(COLON,5) V41CC07 124 END (* CASECONSTANTLIST *) ; V41CC07 125 V41CC07 126 FUNCTION FINDVARIANT(FSP: STP; FVAL: VALU): STP; V41CC07 127 (*LOOK UP CASE CONSTANT VALUE IN TAGVALUELIST OF FSP*) V41CC07 128 VAR FOUND: BOOLEAN; LCC: CCP; V41CC07 129 BEGIN V41CC07 130 LCC := FSP^.TAGVALUELIST; FOUND := FALSE; V41CC07 131 WHILE (LCC <> NIL) AND NOT FOUND DO V41CC07 132 WITH LCC^ DO V41CC07 133 IF FVAL.IVAL <= CCMAX THEN V41CC07 134 IF FVAL.IVAL >= CCMIN THEN V41CC07 135 FOUND := TRUE V41CC07 136 ELSE LCC := NIL V41CC07 137 ELSE LCC := NEXTCC; V41CC07 138 IF FOUND THEN FINDVARIANT := LCC^.CCVAR V41CC07 139 ELSE FINDVARIANT := FSP^.COMPLETER V41CC07 140 END (* FINDVARIANT *); V41CC07 141 V41CC07 142 PROCEDURE TYP(FSYS: SETOFSYS; VAR FSP: STP); COMP 2027 VAR LSP,LSP1,LSP2: STP; OLDTOP: DISPRANGE; LCP: CTP; COMP 2028 LSIZE,DISPL,FILEDISPL: WBSIZE; LMIN,LMAX,LRL: INTEGER; COMP 2029 T,T1,W,B: INTEGER; PACKFLAG,SEGFLAG,EXITLOOP: BOOLEAN; V41CC07 143 NROFELS: INTEGER; LSCOPE: SCOPERANGE; LLEV: DISPRANGE; COMP 2031 COMP 2032 PROCEDURE SIMPLETYPE(FSYS: SETOFSYS; VAR FSP: STP); COMP 2033 VAR LSP,LSP1: STP; LCP,LCP1: CTP; COMP 2034 LVAL: INTEGER; LVALU: VALU; COMP 2035 COMP 2036 PROCEDURE SUBRANGES(FSP: STP; FVALU: VALU); COMP 2037 (*PROCESS SUBRANGE TYPE*) COMP 2038 VAR LOW,HIGH: INTEGER; COMP 2039 BEGIN MNEW(LSP,SUBRANGE); COMP 2040 WITH LSP^ DO COMP 2041 BEGIN RANGETYPE := FSP; FORM := SUBRANGE; COMP 2042 MIN := FVALU; FTYPE := FALSE COMP 2043 END; COMP 2044 EXPECTSYMBOL(DOTDOT,21); COMP 2045 CONSTANT(FSYS,LSP1,LVALU); COMP 2046 WITH LSP^ DO COMP 2047 BEGIN MAX := LVALU; COMP 2048 WITH SIZE DO COMP 2049 BEGIN WORDS := 1; BITS := 0 END; COMP 2050 IF NOT COMPTYPES(FSP,LSP1) THEN ERROR(107) COMP 2051 ELSE COMP 2052 WITH SIZE DO COMP 2053 IF FSP <> NIL THEN COMP 2054 IF FSP^.FORM > SUBRANGE THEN COMP 2055 BEGIN ERROR(148); RANGETYPE := NIL COMP 2056 END COMP 2057 ELSE COMP 2058 BEGIN LOW := MIN.IVAL; HIGH := MAX.IVAL; COMP 2059 IF LOW > HIGH THEN ERROR(102); COMP 2060 WORDS := 0; COMP 2061 IF ABS(LOW) < ABS(HIGH) THEN COMP 2062 BITS := NROFBITS(ABS(HIGH)) COMP 2063 ELSE BITS := NROFBITS(ABS(LOW)); COMP 2064 IF LOW < 0 THEN BITS := BITS + 1 COMP 2065 END COMP 2066 END COMP 2067 END (*SUBRANGES*); COMP 2068 COMP 2069 BEGIN (*SIMPLETYPE*) COMP 2070 CHECKCONTEXT(SIMPTYPEBEGSYS,1,FSYS); COMP 2071 IF SY IN SIMPTYPEBEGSYS THEN COMP 2072 BEGIN COMP 2073 IF SY = LPARENT THEN COMP 2074 BEGIN MNEW(LSP,SCALAR,USERDECLARED); COMP 2075 WITH LSP^ DO COMP 2076 BEGIN FORM := SCALAR; SCALKIND := USERDECLARED; FTYPE := FALSE; COMP 2077 FCONST := NIL COMP 2078 END; COMP 2079 LCP1 := NIL; LVAL := -1; COMP 2080 REPEAT INSYMBOL; COMP 2081 IF SY = IDENT THEN COMP 2082 BEGIN MNEW(LCP,KONST); LVAL := LVAL + 1; COMP 2083 WITH LCP^ DO COMP 2084 BEGIN COPYID(LCP); IDTYPE := LSP; NEXT := LCP1; COMP 2085 VALUES.IVAL := LVAL; KLASS := KONST COMP 2086 END; COMP 2087 ENTERID(LCP,BLCK); COMP 2088 LCP1 := LCP; INSYMBOL COMP 2089 END COMP 2090 ELSE ERROR(2); COMP 2091 CHECKCONTEXT(FSYS+[COMMA,RPARENT],6,[]) COMP 2092 UNTIL SY <> COMMA; COMP 2093 WITH LSP^, SIZE DO COMP 2094 BEGIN FCONST := LCP1; COMP 2095 WORDS := 0; BITS := NROFBITS(LVAL) COMP 2096 END; COMP 2097 EXPECTSYMBOL(RPARENT,4) COMP 2098 END COMP 2099 ELSE COMP 2100 BEGIN COMP 2101 IF SY = IDENT THEN COMP 2102 BEGIN SEARCHID([TYPES,KONST],LCP); COMP 2103 INSYMBOL; COMP 2104 WITH LCP^ DO COMP 2105 IF KLASS = KONST THEN SUBRANGES(IDTYPE,VALUES) COMP 2106 ELSE COMP 2107 LSP := IDTYPE COMP 2108 END (*SY = IDENT*) COMP 2109 ELSE COMP 2110 BEGIN CONSTANT(FSYS+[DOTDOT],LSP1,LVALU); COMP 2111 SUBRANGES(LSP1,LVALU) COMP 2112 END; COMP 2113 END; COMP 2114 FSP := LSP; COMP 2115 CHECKCONTEXT(FSYS,6,[]) COMP 2116 END COMP 2117 ELSE FSP := NIL COMP 2118 END (*SIMPLETYPE*) ; COMP 2119 COMP 2120 FUNCTION INCRADDR(FA, FI: ADDRRANGE): ADDRRANGE; COMP 2121 BEGIN (* INCRADDR *) COMP 2122 IF FA + FI <= MAXADDR THEN INCRADDR := FA + FI COMP 2123 ELSE INCRADDR := MAXADDR COMP 2124 END (* INCRADDR *); COMP 2125 COMP 2126 PROCEDURE FIELDLIST(FSYS: SETOFSYS; VAR FSP: STP); V41CC07 144 VAR LASTFLD,LCP,LCP1,THIS,LLSTFLD: CTP; V41CC07 145 LSP,LSP1: STP; LCC1,LCC2: CCP; V41CC07 146 MINSIZE,MAXSIZE: WBSIZE; V41CC07 147 LFILTYP,EXITLOOP,DISCRIMINATED: BOOLEAN; V41CC07 148 TAGVALCOUNT: 0..MAXINT; TAGSP: STP; COMP 2133 TAGMIN, TAGMAX: INTEGER; COMP 2134 COMP 2135 PROCEDURE VARIANT(FSP: STP; VAR FSP2: STP); V41CC07 149 BEGIN (* VARIANT *) V41CC07 150 EXPECTSYMBOL(LPARENT,9); V41CC07 151 DISPL := MINSIZE; V41CC07 152 FIELDLIST(FSYS+[RPARENT,SEMICOLON],FSP2); V41CC07 153 FSP2^.NXTFLDLST := FSP^.VARIANTLIST; V41CC07 154 FSP^.VARIANTLIST := FSP2; V41CC07 155 LFILTYP := LFILTYP OR FSP2^.FTYPE; V41CC07 156 IF (DISPL.WORDS > MAXSIZE.WORDS) OR V41CC07 157 (DISPL.WORDS = MAXSIZE.WORDS) AND (DISPL.BITS > MAXSIZE.BITS) V41CC07 158 THEN MAXSIZE := DISPL V41CC07 159 END (* VARIANT *); V41CC07 160 V41CC07 161 PROCEDURE FIELDADDRESS(FCP: CTP; FSIZE: WBSIZE; COMP 2136 VAR FDISPL: WBSIZE; FLASTFLD: CTP); COMP 2137 (*COMPUTE ADDRESS OF FCP^ ACCORDING TO ITS SIZE *) COMP 2138 VAR W,B: INTEGER; COMP 2139 COMP 2140 PROCEDURE ADJUST; COMP 2141 (*ADJUST LASTFLD*) COMP 2142 BEGIN COMP 2143 IF FLASTFLD <> NIL THEN COMP 2144 WITH FLASTFLD^ DO COMP 2145 IF IDTYPE <> NIL THEN COMP 2146 IF IDTYPE^.FORM <= POWER THEN COMP 2147 IF BITADDR = 0 THEN PCKDFLD := FALSE COMP 2148 ELSE COMP 2149 BITADDR := WORDSIZE - IDTYPE^.SIZE.BITS; COMP 2150 W := INCRADDR(W,1); B := 0 COMP 2151 END (*ADJUST*); COMP 2152 COMP 2153 BEGIN (*FIELDADDRESS*) COMP 2154 WITH FDISPL, FCP^ DO COMP 2155 BEGIN COMP 2156 W := WORDS; B := BITS; COMP 2157 IF PACKFLAG AND (FSIZE.WORDS = 0) THEN COMP 2158 BEGIN IF B + FSIZE.BITS > WORDSIZE THEN ADJUST; COMP 2159 FLDADDR := W; PCKDFLD := TRUE; COMP 2160 BITADDR := B; COMP 2161 IF B + FSIZE.BITS = WORDSIZE THEN COMP 2162 BEGIN W := W + 1; B := 0 END COMP 2163 ELSE B := B + FSIZE.BITS COMP 2164 END COMP 2165 ELSE COMP 2166 BEGIN IF B <> 0 THEN ADJUST; COMP 2167 FLDADDR := W; PCKDFLD := FALSE; COMP 2168 W := W + FULLWORDS(FSIZE) COMP 2169 END; COMP 2170 IF W > MAXADDR THEN BEGIN W := MAXADDR; B := 0 END; COMP 2171 WORDS := W; BITS := B COMP 2172 END COMP 2173 END (*FIELDADDRESS*) ; COMP 2174 COMP 2175 BEGIN (* FIELDLIST *) V41CC07 162 LASTFLD := NIL; LSP := NIL; LFILTYP := FALSE; V41CC07 163 MNEW(FSP,FIELDLISTS); V41CC07 164 WITH FSP^ DO V41CC07 165 BEGIN FORM := FIELDLISTS; V41CC07 166 FIXEDPART := NIL; NXTFLDLST := NIL V41CC07 167 END; V41CC07 168 CHECKCONTEXT(FSYS+[IDENT,CASESY],19,[]); COMP 2179 WHILE SY = IDENT DO COMP 2180 BEGIN THIS := NIL; COMP 2181 (*LOOP UNTIL SY <> COMMA:*) COMP 2182 REPEAT COMP 2183 IF SY = IDENT THEN COMP 2184 BEGIN MNEW(LCP,FIELD); COMP 2185 WITH LCP^ DO COMP 2186 BEGIN COPYID(LCP); IDTYPE := NIL; COMP 2187 KLASS := FIELD COMP 2188 END; COMP 2189 IF FSP^.FIXEDPART = NIL THEN FSP^.FIXEDPART := LCP V41CC07 169 ELSE LLSTFLD^.NEXT := LCP; COMP 2191 LLSTFLD := LCP; COMP 2192 IF THIS = NIL THEN THIS := LCP; COMP 2193 ENTERID(LCP,DREC); COMP 2194 INSYMBOL COMP 2195 END COMP 2196 ELSE ERROR(2); COMP 2197 CHECKCONTEXT([COMMA,COLON],6,FSYS+[SEMICOLON,CASESY]); COMP 2198 EXITLOOP := SY <> COMMA; COMP 2199 IF NOT EXITLOOP THEN INSYMBOL COMP 2200 UNTIL EXITLOOP; COMP 2201 LLSTFLD^.NEXT := NIL; COMP 2202 EXPECTSYMBOL(COLON,5); COMP 2203 TYP(FSYS+[CASESY,SEMICOLON],LSP); COMP 2204 WHILE THIS <> NIL DO COMP 2205 WITH THIS^ DO COMP 2206 BEGIN IDTYPE := LSP; COMP 2207 IF LSP <> NIL THEN COMP 2208 IF LSP^.FTYPE THEN COMP 2209 BEGIN LFILTYP := TRUE; V41CC07 170 FIELDADDRESS(THIS,LSP^.SIZE,FILEDISPL,NIL) COMP 2211 END COMP 2212 ELSE COMP 2213 BEGIN FIELDADDRESS(THIS,LSP^.SIZE,DISPL,LASTFLD); COMP 2214 LASTFLD := THIS COMP 2215 END COMP 2216 ELSE COMP 2217 BEGIN FLDADDR := DISPL.WORDS; PCKDFLD := FALSE END; COMP 2218 THIS := NEXT COMP 2219 END; COMP 2220 IF SY = SEMICOLON THEN COMP 2221 BEGIN INSYMBOL; COMP 2222 CHECKCONTEXT(FSYS+[IDENT,CASESY],19,[]); COMP 2223 END COMP 2224 END (*WHILE*); COMP 2225 IF SY = CASESY THEN COMP 2226 BEGIN MNEW(LSP,VARIANTPART); COMP 2227 WITH LSP^ DO COMP 2228 BEGIN V41CC07 171 FORM := VARIANTPART; TAGFIELDID := NIL; V41CC07 172 FTYPE := FALSE; COMPLETER := NIL; VARIANTLIST := NIL; V41CC07 173 END; V41CC07 174 FSP^.VARPART := LSP; TAGSP := NIL; TAGVALCOUNT := 0; V41CC07 175 INSYMBOL; COMP 2231 IF SY = IDENT THEN COMP 2232 BEGIN MNEW(LCP,TAGFIELD); V41CC07 176 COPYID(LCP); (* SAVE ID UNTIL WE KNOW NEXT SYMBOL *) COMP 2234 WITH LCP^ DO COMP 2235 BEGIN IDTYPE := NIL; KLASS := TAGFIELD; NEXT := NIL END; COMP 2236 INSYMBOL; DISCRIMINATED := (SY = COLON); COMP 2237 IF DISCRIMINATED THEN COMP 2238 BEGIN ENTERID(LCP,DREC); INSYMBOL; COMP 2239 LSP^.TAGFIELDID := LCP; V41CC07 177 IF SY = IDENT THEN COMP 2240 BEGIN SEARCHID([TYPES],LCP1); INSYMBOL END COMP 2241 ELSE COMP 2242 BEGIN LCP1 := UTYPPTR; COMP 2243 ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) COMP 2244 END; V41CC07 178 LCP^.IDTYPE := LCP1^.IDTYPE V41CC07 179 END COMP 2246 ELSE COMP 2247 BEGIN ID := LCP^.NAME; V41CC07 180 SEARCHID([TYPES],LCP1); DISPOSEID(LCP) V41CC07 181 END; V41CC07 182 IF LCP1^.IDTYPE <> NIL THEN V41CC07 183 IF LCP1^.IDTYPE^.FORM <= SUBRANGE THEN V41CC07 184 BEGIN TAGSP := LCP1^.IDTYPE; V41CC07 185 GETBOUNDS(TAGSP,TAGMIN,TAGMAX); V41CC07 186 IF DISCRIMINATED THEN V41CC07 187 FIELDADDRESS(LCP,TAGSP^.SIZE,DISPL,LASTFLD) V41CC07 188 END V41CC07 189 ELSE ERROR(110) V41CC07 190 END COMP 2263 ELSE (* SY <> IDENT *) COMP 2264 BEGIN ERROR(2); SKIP(FSYS+[OFSY,LPARENT]) END; COMP 2265 LSP^.TAGTYPE := TAGSP; V41CC07 191 LSP^.SIZE := DISPL; COMP 2266 EXPECTSYMBOL(OFSY,8); COMP 2267 CHECKCONTEXT(CONSTBEGSYS,19,FSYS+[COLON,LPARENT]); COMP 2268 LCC1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL; V41CC07 192 REPEAT V41CC07 193 CASECONSTANTLIST(FSYS+[LPARENT],TAGSP,TAGMIN,TAGMAX, V41CC07 194 111,LCC1,LCC2); V41CC07 195 VARIANT(LSP,LSP1); V41CC07 196 WHILE LCC2 <> NIL DO V41CC07 197 WITH LCC2^ DO V41CC07 198 BEGIN CCVAR := LSP1; LCC2 := THREAD; V41CC07 199 TAGVALCOUNT := TAGVALCOUNT + (CCMAX - CCMIN + 1) V41CC07 200 END; COMP 2313 IF SY = RPARENT THEN COMP 2314 BEGIN INSYMBOL; COMP 2315 CHECKCONTEXT(FSYS+[SEMICOLON,OTHERWISESY],6,[]) V41CC07 201 END COMP 2317 ELSE ERROR(4); COMP 2318 IF SY = SEMICOLON THEN INSYMBOL COMP 2319 UNTIL SY IN (FSYS+[OTHERWISESY]); V41CC07 202 IF SY = OTHERWISESY THEN V41CC07 203 BEGIN EXTENSION(328); V41CC07 204 IF TAGMIN - 1 + TAGVALCOUNT = TAGMAX THEN ERROR(195); V41CC07 205 INSYMBOL; V41CC07 206 VARIANT(LSP,LSP1); V41CC07 207 LSP^.COMPLETER := LSP1; V41CC07 208 EXPECTSYMBOL(RPARENT,4); V41CC07 209 IF SY = SEMICOLON THEN INSYMBOL; V41CC07 210 CHECKCONTEXT(FSYS,6,[]) V41CC07 211 END; V41CC07 212 DISPL := MAXSIZE; V41CC07 213 WITH LSP^ DO V41CC07 214 BEGIN TAGVALUELIST := LCC1; V41CC07 215 FTYPE := LFILTYP; V41CC07 216 IF (COMPLETER = NIL) AND (TAGSP <> NIL) THEN V41CC07 217 IF TAGMIN - 1 + TAGVALCOUNT < TAGMAX THEN ERROR(186) V41CC07 218 END V41CC07 219 END V41CC07 220 ELSE (* SY <> CASESY *) V41CC07 221 FSP^.VARPART := NIL; V41CC07 222 WITH FSP^ DO V41CC07 223 BEGIN FTYPE := LFILTYP; SIZE := DISPL END V41CC07 224 END (* FIELDLIST *) ; V41CC07 225 V41CC07 226 PROCEDURE FIXFIELDALLOCATION(FSP: STP; FWORDS: ADDRRANGE); V41CC07 227 (* INCREASE NON-FILE FIELD OFFSETS IN FIELDLIST FSP BY FWORDS. *) V41CC07 228 VAR LCP: CTP; LSP: STP; V41CC07 229 BEGIN (* FIXFIELDALLOCATION *) V41CC07 230 WITH FSP^ DO V41CC07 231 BEGIN LCP := FIXEDPART; LSP := VARPART END; V41CC07 232 WHILE LCP <> NIL DO V41CC07 233 WITH LCP^ DO V41CC07 234 BEGIN COMP 2336 IF IDTYPE <> NIL THEN COMP 2337 IF NOT IDTYPE^.FTYPE THEN COMP 2338 FLDADDR := INCRADDR(FLDADDR,FWORDS); COMP 2339 LCP := NEXT V41CC07 235 END; V41CC07 236 IF LSP <> NIL THEN V41CC07 237 BEGIN V41CC07 238 IF LSP^.TAGFIELDID <> NIL THEN V41CC07 239 WITH LSP^.TAGFIELDID^ DO V41CC07 240 FLDADDR := INCRADDR(FLDADDR,FWORDS); V41CC07 241 LSP := LSP^.VARIANTLIST; V41CC07 242 WHILE LSP <> NIL DO V41CC07 243 WITH LSP^ DO (* FORM = FIELDLISTS *) V41CC07 244 BEGIN SIZE.WORDS := INCRADDR(SIZE.WORDS,FWORDS); V41CC07 245 FIXFIELDALLOCATION(LSP,FWORDS); V41CC07 246 LSP := NXTFLDLST V41CC07 247 END COMP 2349 END COMP 2350 END (* FIXFIELDALLOCATION *); COMP 2351 COMP 2352 BEGIN (*TYP*) LSP := NIL; COMP 2353 PACKFLAG := FALSE; SEGFLAG := FALSE; COMP 2354 CHECKCONTEXT(TYPEBEGSYS,10,FSYS); COMP 2355 IF SY IN TYPEBEGSYS THEN COMP 2356 BEGIN COMP 2357 IF SY IN SIMPTYPEBEGSYS THEN SIMPLETYPE(FSYS,LSP) COMP 2358 ELSE COMP 2359 (*^*) COMP 2360 IF SY = ARROW THEN COMP 2361 BEGIN MNEW(LSP,POINTER); COMP 2362 WITH LSP^ DO COMP 2363 BEGIN FORM := POINTER; FTYPE := FALSE; ELTYPE := NIL; COMP 2364 DBG := DEBUG; COMP 2365 WITH SIZE DO COMP 2366 BEGIN WORDS := 0; BITS := NROFBITS(MAXADDR); COMP 2367 IF DEBUG THEN BITS := 2 * (BITS + 1) COMP 2368 END COMP 2369 END; COMP 2370 INSYMBOL; COMP 2371 IF SY = IDENT THEN COMP 2372 BEGIN COMP 2373 IF INTYPEDEFINITION THEN COMP 2374 BEGIN LLEV := TOP; COMP 2375 REPEAT SEARCHSECTION(DISPLAY[LLEV].FNAME,LCP); COMP 2376 EXITLOOP := (LLEV = 0) OR (LCP <> NIL); COMP 2377 IF NOT EXITLOOP THEN LLEV := LLEV - 1 COMP 2378 UNTIL EXITLOOP; COMP 2379 IF LCP <> NIL THEN COMP 2380 IF (LCP^.LASTUSESCOPE < BLOCKSCOPE) AND (LLEV < LEVEL) COMP 2381 THEN LCP := NIL COMP 2382 ELSE COMP 2383 IF LCP^.KLASS <> TYPES THEN COMP 2384 BEGIN ERROR(191); LCP := NIL END COMP 2385 ELSE LCP^.LASTUSESCOPE := THISSCOPE COMP 2386 END COMP 2387 ELSE SEARCHID([TYPES],LCP); COMP 2388 IF LCP = NIL THEN (*FORWARD REFERENCED TYPE ID*) COMP 2389 BEGIN MNEW(LCP,TYPES); COMP 2390 WITH LCP^ DO COMP 2391 BEGIN COPYID(LCP); IDTYPE := LSP; KLASS := TYPES; COMP 2392 NEXT := FWPTR COMP 2393 END; COMP 2394 FWPTR := LCP COMP 2395 END COMP 2396 ELSE LSP^.ELTYPE := LCP^.IDTYPE; COMP 2397 INSYMBOL; COMP 2398 END COMP 2399 ELSE ERROR(2); COMP 2400 END COMP 2401 ELSE (* SY <> ARROW *) COMP 2402 BEGIN COMP 2403 IF SY = SEGMENTEDSY THEN COMP 2404 BEGIN SEGFLAG := TRUE; EXTENSION(323); INSYMBOL END; COMP 2405 IF SEGFLAG AND (SY = IDENT) THEN COMP 2406 BEGIN SEARCHID([TYPES],LCP); COMP 2407 WITH LCP^ DO COMP 2408 IF IDTYPE <> NIL THEN COMP 2409 WITH IDTYPE^ DO COMP 2410 IF FORM = FILES THEN COMP 2411 IF SEGFILE THEN COMP 2412 BEGIN ERROR(60); LSP := IDTYPE END COMP 2413 ELSE COMP 2414 BEGIN MNEW(LSP); (* DON'T DO MNEW(LSP,FILES) *) COMP 2415 (* BECAUSE LSP^ := IDTYPE^ WILL FAIL *) COMP 2416 LSP^ := IDTYPE^; COMP 2417 WITH LSP^ DO COMP 2418 BEGIN BASEFILE := IDTYPE; SEGFILE := TRUE END COMP 2419 END COMP 2420 ELSE ERROR(60); COMP 2421 INSYMBOL COMP 2422 END COMP 2423 ELSE COMP 2424 BEGIN COMP 2425 IF SY = PACKEDSY THEN COMP 2426 BEGIN PACKFLAG := TRUE; INSYMBOL END; COMP 2427 CHECKCONTEXT(TYPEDELS,10,FSYS); COMP 2428 IF (SY <> FILESY)AND SEGFLAG THEN ERROR(57); COMP 2429 (*ARRAY*) COMP 2430 IF SY = ARRAYSY THEN COMP 2431 BEGIN INSYMBOL; COMP 2432 EXPECTSYMBOL(LBRACK,11); COMP 2433 LSP1 := NIL; COMP 2434 (*LOOP UNTIL SY <> COMMA:*) COMP 2435 REPEAT MNEW(LSP,ARRAYS); COMP 2436 WITH LSP^ DO COMP 2437 BEGIN AELTYPE := LSP1; INXTYPE := NIL; COMP 2438 PCKDARR := PACKFLAG; FORM := ARRAYS; COMP 2439 FTYPE := FALSE; CONFORMANT := FALSE COMP 2440 END; COMP 2441 LSP1 := LSP; COMP 2442 SIMPLETYPE(FSYS+[COMMA,RBRACK,OFSY],LSP2); COMP 2443 IF LSP2 <> NIL THEN COMP 2444 IF LSP2^.FORM <= SUBRANGE THEN LSP^.INXTYPE := LSP2 COMP 2445 ELSE ERROR(113); COMP 2446 EXITLOOP := SY <> COMMA; COMP 2447 IF NOT EXITLOOP THEN INSYMBOL COMP 2448 UNTIL EXITLOOP; COMP 2449 EXPECTSYMBOL(RBRACK,12); COMP 2450 EXPECTSYMBOL(OFSY,8); COMP 2451 TYP(FSYS,LSP); COMP 2452 IF LSP <> NIL THEN (* REVERSE POINTERS, COMPUTE SIZE *) COMP 2453 BEGIN LSIZE := LSP^.SIZE; COMP 2454 REPEAT COMP 2455 WITH LSP1^ DO COMP 2456 BEGIN LSP2 := AELTYPE; AELTYPE := LSP; COMP 2457 FTYPE := LSP^.FTYPE; COMP 2458 IF INXTYPE <> NIL THEN COMP 2459 BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX); COMP 2460 NROFELS := LMAX - LMIN + 1; COMP 2461 IF (NROFELS <= 0) OR (NROFELS > MAXINT) THEN COMP 2462 NROFELS := MAXINT; COMP 2463 IF (LSIZE.WORDS > 0)OR NOT PACKFLAG THEN COMP 2464 BEGIN T := FULLWORDS(LSIZE); COMP 2465 IF (NROFELS >= MAXADDR) OR (T >= MAXADDR) THEN COMP 2466 LSIZE.WORDS := MAXADDR COMP 2467 ELSE V41CC08 7 BEGIN W := NROFELS * T; V41CC08 8 IF W >= MAXADDR THEN LSIZE.WORDS := MAXADDR V41CC08 9 ELSE LSIZE.WORDS := W V41CC08 10 END; V41CC08 11 LSIZE.BITS := 0; PARTWORDELS := FALSE COMP 2469 END COMP 2470 ELSE COMP 2471 BEGIN COMP 2472 IF LSIZE.BITS > 0 THEN COMP 2473 T := WORDSIZE DIV LSIZE.BITS COMP 2474 ELSE T := 1; COMP 2475 T1 := NROFELS MOD T; COMP 2476 IF (T1 = 0)AND(T*LSIZE.BITS < WORDSIZE) THEN T1 := T; COMP 2477 W := (NROFELS - T1) DIV T; COMP 2478 B := T1*LSIZE.BITS; COMP 2479 (* NOTE- ORD(TRUE)=1 AND ORD(FALSE)=0 *) COMP 2480 IF W + ORD(B <> 0) > MAXADDR THEN COMP 2481 BEGIN W := MAXADDR; B := 0 END; COMP 2482 LSIZE.WORDS := W; LSIZE.BITS := B; COMP 2483 IF T > 1 THEN COMP 2484 BEGIN PARTWORDELS := TRUE; COMP 2485 ELSPERWORD := T COMP 2486 END COMP 2487 ELSE PARTWORDELS := FALSE COMP 2488 END COMP 2489 END; COMP 2490 SIZE := LSIZE COMP 2491 END (*WITH LSP1^*) ; COMP 2492 LSP := LSP1; LSP1 := LSP2 COMP 2493 UNTIL LSP1 = NIL COMP 2494 END (*LSP <> NIL*) COMP 2495 END COMP 2496 ELSE COMP 2497 (*RECORD*) COMP 2498 IF SY = RECORDSY THEN COMP 2499 BEGIN INSYMBOL; COMP 2500 OLDTOP := TOP; LSCOPE := THISSCOPE; COMP 2501 IF HIGHSCOPE = SCOPEMAX THEN ERROR(252) COMP 2502 ELSE HIGHSCOPE := HIGHSCOPE + 1; COMP 2503 THISSCOPE := HIGHSCOPE; COMP 2504 IF TOP < DISPLIMIT THEN COMP 2505 BEGIN TOP := TOP + 1; COMP 2506 WITH DISPLAY[TOP] DO COMP 2507 BEGIN FNAME := NIL; REGION := DREC; FFWPTR := FWPTR END; COMP 2508 FWPTR := NIL COMP 2509 END COMP 2510 ELSE ERROR(250); COMP 2511 WITH DISPL DO COMP 2512 BEGIN WORDS := 0; BITS := 0 END; COMP 2513 FILEDISPL := DISPL; COMP 2514 FIELDLIST(FSYS-[SEMICOLON]+[ENDSY],LSP1); V41CC07 248 MNEW(LSP,RECORDS); COMP 2516 WITH LSP^ DO COMP 2517 BEGIN FORM := RECORDS; PCKDREC := PACKFLAG; COMP 2518 FIELDIDTREE := DISPLAY[TOP].FNAME; FTYPE := LSP1^.FTYPE; V41CC07 249 FIELDLST := LSP1; SIZE := DISPL; V41CC07 250 IF FTYPE THEN (* ALTER FIELD OFFSETS *) V41CC07 251 BEGIN SIZE.WORDS := INCRADDR(SIZE.WORDS,FILEDISPL.WORDS); V41CC07 252 FIXFIELDALLOCATION(LSP1,FILEDISPL.WORDS) V41CC07 253 END COMP 2524 END; COMP 2525 IF FWPTR = NIL THEN FWPTR := DISPLAY[TOP].FFWPTR COMP 2526 ELSE COMP 2527 IF TOP <> OLDTOP THEN COMP 2528 BEGIN LCP := FWPTR; COMP 2529 WHILE LCP^.NEXT <> NIL DO LCP := LCP^.NEXT; COMP 2530 LCP^.NEXT := DISPLAY[TOP].FFWPTR COMP 2531 END; COMP 2532 THISSCOPE := LSCOPE; COMP 2533 TOP := OLDTOP; COMP 2534 EXPECTSYMBOL(ENDSY,13) COMP 2535 END COMP 2536 ELSE COMP 2537 (*SET*) COMP 2538 IF SY = SETSY THEN COMP 2539 BEGIN INSYMBOL; COMP 2540 EXPECTSYMBOL(OFSY,8); COMP 2541 SIMPLETYPE(FSYS,LSP1); COMP 2542 IF LSP1 <> NIL THEN COMP 2543 IF LSP1^.FORM > SUBRANGE THEN COMP 2544 BEGIN ERROR(115); LSP1 := NIL END COMP 2545 ELSE COMP 2546 BEGIN GETBOUNDS(LSP1,LMIN,LMAX); COMP 2547 IF (LMIN < 0) OR (LMAX > 58) THEN ERROR(169); COMP 2548 (*IMPLEMENTATION RESTRICTION TO ONE-WORD SETS*) COMP 2549 IF LMAX < LMIN THEN COMP 2550 WITH LSP1^ DO MAX.IVAL := MIN.IVAL; COMP 2551 MNEW(LSP,POWER); COMP 2552 WITH LSP^, SIZE DO COMP 2553 BEGIN ELSET := LSP1; COMP 2554 IF PACKFLAG THEN PCKDSET := [PCKD] COMP 2555 ELSE PCKDSET := [UNPCKD]; COMP 2556 FORM := POWER; FTYPE := FALSE; COMP 2557 IF LMAX >= 58 THEN COMP 2558 BEGIN WORDS := 1; BITS := 0 END COMP 2559 ELSE COMP 2560 BEGIN WORDS := 0; BITS := LMAX + 1 END COMP 2561 END COMP 2562 END COMP 2563 END COMP 2564 ELSE COMP 2565 (*FILE*) IF SY = FILESY THEN COMP 2566 BEGIN INSYMBOL; COMP 2567 EXPECTSYMBOL(OFSY,8); COMP 2568 TYP(FSYS,LSP1); COMP 2569 IF LSP1 <> NIL THEN (* COMPUTE IMPL.-DEP. FILE SIZE *) COMP 2570 BEGIN LRL := FULLWORDS(LSP1^.SIZE); COMP 2571 IF LRL <= 1 THEN LRL := 1 COMP 2572 END COMP 2573 ELSE LRL := 1; COMP 2574 MNEW(LSP,FILES); COMP 2575 WITH LSP^ DO COMP 2576 BEGIN FILTYPE := LSP1; FORM := FILES; FTYPE := TRUE; COMP 2577 SEGFILE := SEGFLAG; COMP 2578 BASEFILE := LSP; COMP 2579 TEXTFILE := FALSE; COMP 2580 PCKDFIL := PACKFLAG; COMP 2581 T := ((BUFFSZ + LRL - 1) DIV LRL + 1) * LRL; COMP 2582 IF T > MAXADDR THEN BSIZE := MAXADDR ELSE BSIZE := T; COMP 2583 WITH SIZE DO COMP 2584 BEGIN COMP 2585 IF OS = XSCOPE2 THEN WORDS := BNEFITSZ V41CC04 10 ELSE WORDS := BNEFETSZ; V41CC04 11 BITS := 0 COMP 2588 END COMP 2589 END; COMP 2590 IF LSP1 <> NIL THEN COMP 2591 IF LSP1^.FTYPE THEN COMP 2592 BEGIN ERROR(108); LSP^.FILTYPE := NIL END; COMP 2593 END; COMP 2594 END COMP 2595 END; COMP 2596 CHECKCONTEXT(FSYS,6,[]) COMP 2597 END; COMP 2598 FSP := LSP COMP 2599 END (*TYP*) ; COMP 2600 COMP 2601 PROCEDURE LABELDECLARATION; COMP 2602 LABEL 1; COMP 2603 VAR LLP: LBP; EXITLOOP: BOOLEAN; COMP 2604 BEGIN COMP 2605 (*LOOP UNTIL SY <> COMMA:*) COMP 2606 REPEAT COMP 2607 IF SY = INTCONST THEN COMP 2608 BEGIN COMP 2609 IF IVAL > MAXLABEL THEN ERROR(163); COMP 2610 LLP := FSTLABP; COMP 2611 WHILE LLP <> FLABP DO COMP 2612 IF LLP^.LABVAL = IVAL THEN COMP 2613 BEGIN ERROR(166); GOTO 1 END COMP 2614 ELSE LLP := LLP^.NEXTLAB; COMP 2615 MNEW(LLP); COMP 2616 WITH LLP^ DO COMP 2617 BEGIN LABVAL := IVAL; EPT := EPT1; EPT1 := TENBLANKS; COMP 2618 NEXTLAB := FSTLABP; LABLEV := LEVEL; DEFINED := FALSE; COMP 2619 ACCESSIBLE := TRUE; LABSTMTLEVEL := 0; COMP 2620 FSTOCC := NIL COMP 2621 END; COMP 2622 FSTLABP := LLP; COMP 2623 1: INSYMBOL; COMP 2624 END COMP 2625 ELSE ERROR(15); COMP 2626 CHECKCONTEXT(FSYS+[COMMA,SEMICOLON],6,[]); COMP 2627 EXITLOOP := SY <> COMMA; COMP 2628 IF NOT EXITLOOP THEN INSYMBOL COMP 2629 UNTIL EXITLOOP; COMP 2630 EXPECTSYMBOL(SEMICOLON,14) COMP 2631 END (*LABELDECLARATION*) ; COMP 2632 COMP 2633 PROCEDURE CONSTDECLARATION; COMP 2634 VAR LCP: CTP; LSP: STP; LVALU: VALU; COMP 2635 BEGIN COMP 2636 IF SY <> IDENT THEN COMP 2637 BEGIN ERROR(2); SKIP(FSYS+[IDENT]) END; COMP 2638 WHILE SY = IDENT DO COMP 2639 BEGIN MNEW(LCP,KONST); COMP 2640 WITH LCP^ DO COMP 2641 BEGIN COPYID(LCP); IDTYPE := NIL; NEXT := NIL; COMP 2642 KLASS := KONST COMP 2643 END; COMP 2644 INSYMBOL; COMP 2645 IF OP = EQOP THEN INSYMBOL ELSE ERROR(16); COMP 2646 CONSTANT(FSYS+[SEMICOLON],LSP,LVALU); COMP 2647 ENTERID(LCP,BLCK); COMP 2648 LCP^.IDTYPE := LSP; LCP^.VALUES := LVALU; COMP 2649 IF SY = SEMICOLON THEN COMP 2650 BEGIN INSYMBOL; COMP 2651 CHECKCONTEXT(FSYS+[IDENT],6,[]) COMP 2652 END COMP 2653 ELSE ERROR(14) COMP 2654 END COMP 2655 END (*CONSTDECLARATION*) ; COMP 2656 COMP 2657 PROCEDURE TYPEDECLARATION; COMP 2658 VAR LCP,LCP1,LCP2: CTP; LSP: STP; LID: IDNAME; GOTONE: BOOLEAN; V41DC05 470 BEGIN COMP 2660 INTYPEDEFINITION := TRUE; COMP 2661 IF SY <> IDENT THEN COMP 2662 BEGIN ERROR(2); SKIP(FSYS+[IDENT]) END; COMP 2663 WHILE SY = IDENT DO COMP 2664 BEGIN MNEW(LCP,TYPES); COMP 2665 WITH LCP^ DO COMP 2666 BEGIN COPYID(LCP); IDTYPE := NIL; KLASS := TYPES END; COMP 2667 INSYMBOL; COMP 2668 IF OP = EQOP THEN INSYMBOL ELSE ERROR(16); COMP 2669 TYP(FSYS+[SEMICOLON],LSP); COMP 2670 LCP^.IDTYPE := LSP; COMP 2671 LCP1 := FWPTR; GOTONE := FALSE; COMP 2672 WHILE LCP1 <> NIL DO (*HAS ANY FORWARD REFERENCE BEEN SATISFIED?*) COMP 2673 BEGIN COMP 2674 IF COMPAREIDS(LCP1^.NAME,LCP^.NAME) = EQUALTO THEN COMP 2675 BEGIN COMP 2676 LCP1^.IDTYPE^.ELTYPE := LSP; GOTONE := TRUE; COMP 2677 IF LCP1 <> FWPTR THEN COMP 2678 LCP2^.NEXT := LCP1^.NEXT COMP 2679 ELSE FWPTR := LCP1^.NEXT; COMP 2680 END COMP 2681 ELSE LCP2 := LCP1; COMP 2682 LCP1 := LCP1^.NEXT COMP 2683 END; COMP 2684 ENTERID(LCP,BLCK); COMP 2685 IF GOTONE THEN LCP^.LASTUSESCOPE := THISSCOPE; COMP 2686 IF SY = SEMICOLON THEN COMP 2687 BEGIN INSYMBOL; COMP 2688 CHECKCONTEXT(FSYS+[IDENT],6,[]) COMP 2689 END COMP 2690 ELSE ERROR(14) COMP 2691 END; COMP 2692 LID := ID; LCP := NIL; COMP 2693 WHILE FWPTR <> NIL DO COMP 2694 BEGIN LCP1 := FWPTR; FWPTR := FWPTR^.NEXT; COMP 2695 ID := LCP1^.NAME; SEARCHID([TYPES,UNKNOWNID],LCP2); COMP 2696 IF LCP2 = NIL THEN (* UNDEFINED *) COMP 2697 BEGIN LCP1^.NEXT := LCP; LCP := LCP1 END COMP 2698 ELSE (* CAN RESOLVE *) COMP 2699 BEGIN LCP1^.IDTYPE^.ELTYPE := LCP2^.IDTYPE; COMP 2700 DISPOSE(LCP1,TYPES) COMP 2701 END COMP 2702 END; COMP 2703 IF LCP <> NIL THEN COMP 2704 BEGIN ERROR(117); COMP 2705 REPEAT FLAGERROR; V41DC05 471 PUTERRMSG(' UNDEFINED TYPE: ',FALSE); WRITEID(LCP^.NAME); V41DC05 472 LCP1 := LCP; LCP := LCP^.NEXT; COMP 2708 DISPOSE(LCP1,TYPES) COMP 2709 UNTIL LCP = NIL COMP 2710 END; COMP 2711 ID := LID; INTYPEDEFINITION := FALSE COMP 2712 END (*TYPEDECLARATION*) ; COMP 2713 COMP 2714 PROCEDURE VARDECLARATION; COMP 2715 VAR LCP,NXT: CTP; LSP: STP; EXITLOOP: BOOLEAN; COMP 2716 LEXFILP: EXTFILEP; LSIZE: ADDRRANGE; LACCESS: DRCTINDRCT; COMP 2717 BEGIN COMP 2718 NXT := NIL; COMP 2719 REPEAT COMP 2720 (*LOOP UNTIL SY <> COMMA:*) COMP 2721 REPEAT COMP 2722 IF SY = IDENT THEN COMP 2723 BEGIN MNEW(LCP,VARS); COMP 2724 WITH LCP^ DO COMP 2725 BEGIN COPYID(LCP); NEXT := NXT; KLASS := VARS; COMP 2726 IDTYPE := NIL; VINIT := FALSE; VACCESS := DRCT; COMP 2727 VKIND := ACTUAL; VARPARAM := FALSE; COMP 2728 VLEV := LEVEL; CONFORMNT := FALSE; COMP 2729 FIRSTINPARMGROUP := FALSE; COMP 2730 THREAT := FALSE; CONTROLVAR := FALSE; COMP 2731 END; COMP 2732 ENTERID(LCP,BLCK); COMP 2733 NXT := LCP; COMP 2734 INSYMBOL; COMP 2735 END COMP 2736 ELSE ERROR(2); COMP 2737 CHECKCONTEXT(FSYS+[COMMA,COLON]+TYPEDELS,6,[SEMICOLON]); COMP 2738 EXITLOOP := SY <> COMMA; COMP 2739 IF NOT EXITLOOP THEN INSYMBOL COMP 2740 UNTIL EXITLOOP; COMP 2741 EXPECTSYMBOL(COLON,5); COMP 2742 TYP(FSYS+[SEMICOLON]+TYPEDELS,LSP); COMP 2743 LACCESS := DRCT; LSIZE := 1; COMP 2744 IF LSP <> NIL THEN COMP 2745 BEGIN COMP 2746 LSIZE := FULLWORDS(LSP^.SIZE); COMP 2747 IF (LSIZE >= MVOPTION) AND (LEVEL <> 1) THEN COMP 2748 BEGIN LSIZE := 1; LACCESS := INDRCT END COMP 2749 END; COMP 2750 WHILE NXT <> NIL DO COMP 2751 WITH NXT^ DO COMP 2752 BEGIN IDTYPE := LSP; VADDR := LC; VACCESS := LACCESS; COMP 2753 LC := LC + LSIZE; COMP 2754 IF LC > MAXADDR THEN COMP 2755 BEGIN LC := 0; ERROR(261) END; COMP 2756 IF (LEVEL = 1) AND (LSP <> NIL) THEN COMP 2757 BEGIN LEXFILP := FEXFILP; COMP 2758 WHILE LEXFILP <> NIL DO COMP 2759 IF NAME.TEN = LEXFILP^.FILENAME THEN COMP 2760 BEGIN COMP 2761 LEXFILP^.FILECP := NXT; VKIND := FORMAL; COMP 2762 LEXFILP := NIL; COMP 2763 IF LSP <> NIL THEN COMP 2764 IF LSP^.FORM <> FILES THEN ERROR(171) COMP 2765 END COMP 2766 ELSE LEXFILP := LEXFILP^.NXTP COMP 2767 END; COMP 2768 NXT := NEXT COMP 2769 END; COMP 2770 IF SY = SEMICOLON THEN COMP 2771 BEGIN INSYMBOL; COMP 2772 CHECKCONTEXT(FSYS+[IDENT],6,[]) COMP 2773 END COMP 2774 ELSE ERROR(14) COMP 2775 UNTIL (SY <> IDENT)AND NOT (SY IN TYPEDELS); COMP 2776 END (*VARDECLARATION*) ; COMP 2777 COMP 2778 PROCEDURE VALUEDECLARATION; COMP 2779 VAR LASTADDR: INTEGER; COMP 2780 LSP: STP; COMP 2781 LCP: CTP; COMP 2782 TEXTTAB: ARRAY[0..15] OF VALU; COMP 2783 THIST: 0..15; COMP 2784 IDW: PACKED RECORD CASE BOOLEAN OF COMP 2785 FALSE: (I: INTEGER); COMP 2786 TRUE: (CN: 0..7777B; COMP 2787 WC: 0..7777B; COMP 2788 LR: 0..777777B; COMP 2789 L : 0..777777B) COMP 2790 END; COMP 2791 LMARK: MARKER; COMP 2792 COMP 2793 PROCEDURE PUTTEXTTAB; COMP 2794 VAR I: INTEGER; COMP 2795 BEGIN (* PUTTEXTTAB *) COMP 2796 IF THIST <> 0 THEN COMP 2797 BEGIN IDW.WC := THIST + 1; COMP 2798 VALUES^^ := IDW.I; PUT(VALUES^); COMP 2799 VALUES^^ := 0; PUT(VALUES^); COMP 2800 FOR I := 1 TO THIST DO COMP 2801 BEGIN VALUES^^ := TEXTTAB[I].IVAL; COMP 2802 PUT(VALUES^) COMP 2803 END; COMP 2804 THIST := 0 COMP 2805 END COMP 2806 END (* PUTTEXTTAB *); COMP 2807 COMP 2808 PROCEDURE VALUESPECIFICATION(FSYS: SETOFSYS; FSP: STP; COMP 2809 FWRD: ADDRRANGE; FBIT: BITRANGE; FPCKD: BOOLEAN); COMP 2810 VAR LCP: CTP; COMP 2811 LSP,LSP1: STP; COMP 2812 LVALU: VALU; COMP 2813 LSYS: SETOFSYS; COMP 2814 WRDS: ADDRRANGE; COMP 2815 BITS: BITRANGE; COMP 2816 RIGHTADJ: BOOLEAN; COMP 2817 COMP 2818 PROCEDURE EMITVALUE(FVALU: VALU); COMP 2819 VAR L,R: BITRANGE; COMP 2820 BEGIN (* EMITVALUE *) COMP 2821 IF FWRD <> LASTADDR THEN COMP 2822 BEGIN COMP 2823 IF (FWRD <> LASTADDR+1) OR (THIST = 15) THEN COMP 2824 BEGIN PUTTEXTTAB; IDW.L := ARPS + FWRD END; COMP 2825 THIST := THIST + 1; COMP 2826 TEXTTAB[THIST].IVAL := 0; COMP 2827 LASTADDR := FWRD COMP 2828 END; COMP 2829 IF FPCKD AND (WRDS = 0) THEN COMP 2830 BEGIN (* MASK AND ROTATE VALUE INTO ITS FIELD *) COMP 2831 IF RIGHTADJ THEN BEGIN L := BITS-1; R := 0 END COMP 2832 ELSE BEGIN L := WORDSIZE-1; R := WORDSIZE-BITS END; COMP 2833 FVALU.IVAL := PORTION(FVALU.IVAL,L,R); COMP 2834 FVALU.IVAL := ROTATE(FVALU.IVAL,WORDSIZE - FBIT - BITS) COMP 2835 END; COMP 2836 TEXTTAB[THIST].IVAL := MERGE(TEXTTAB[THIST],FVALU); COMP 2837 END (* EMITVALUE *); COMP 2838 COMP 2839 PROCEDURE EMITSTRING(FCSP: CTAILP); COMP 2840 VAR LVALU: VALU; COMP 2841 LRIGHTADJ: BOOLEAN; COMP 2842 BEGIN (* EMITSTRING *) COMP 2843 LRIGHTADJ := RIGHTADJ; COMP 2844 RIGHTADJ := FALSE; COMP 2845 WHILE FCSP <> NIL DO COMP 2846 BEGIN LVALU.IVAL := FCSP^.CSVAL; COMP 2847 EMITVALUE(LVALU); COMP 2848 IF NOT FPCKD THEN FWRD := FWRD + 1; COMP 2849 FCSP := FCSP^.NXTCSP COMP 2850 END; COMP 2851 RIGHTADJ := LRIGHTADJ COMP 2852 END (* EMITSTRING *); COMP 2853 COMP 2854 PROCEDURE CHECKRANGE(FSP1,FSP2: STP; FVALU: VALU); COMP 2855 VAR LMIN,LMAX: INTEGER; COMP 2856 BEGIN (* CHECKRANGE *) COMP 2857 IF (FSP1 <> NIL) AND (FSP2 <> NIL) THEN COMP 2858 IF COMPTYPES(FSP1,FSP2) THEN COMP 2859 BEGIN COMP 2860 IF FSP1^.FORM <= SUBRANGE THEN COMP 2861 BEGIN GETBOUNDS(FSP1,LMIN,LMAX); COMP 2862 IF (FVALU.IVAL < LMIN) OR (FVALU.IVAL > LMAX) THEN ERROR(303) COMP 2863 END COMP 2864 END COMP 2865 ELSE ERROR(145) COMP 2866 END (* CHECKRANGE *); COMP 2867 COMP 2868 PROCEDURE SKIPSTRUCTUREDVALUE( INSY : BOOLEAN ); COMP 2869 BEGIN (* SKIPSTRUCTUREDVALUE *) COMP 2870 IF INSY THEN INSYMBOL; COMP 2871 VALUESPECIFICATION(LSYS+[OFSY],NIL,0,0,FALSE); COMP 2872 WHILE SY IN [COMMA,OFSY] DO COMP 2873 BEGIN INSYMBOL; VALUESPECIFICATION(LSYS+[OFSY],NIL,0,0,FALSE) END COMP 2874 END (* SKIPSTRUCTUREDVALUE *); COMP 2875 COMP 2876 PROCEDURE RECORDVALUE; COMP 2877 VAR LCP: CTP; COMP 2878 LSP,LSP1: STP; COMP 2879 LVALU: VALU; COMP 2880 LWRD: ADDRRANGE; COMP 2882 LBIT,BIT: BITRANGE; COMP 2883 EXITLOOP: BOOLEAN; COMP 2884 BEGIN (* RECORDVALUE *) COMP 2885 IF FSP^.FIELDLST <> NIL THEN V41CC07 254 WITH FSP^.FIELDLST^ DO V41CC07 255 BEGIN LCP := FIXEDPART; LSP := VARPART END; V41CC07 256 LWRD := FWRD; LBIT := FBIT; COMP 2888 INSYMBOL; COMP 2889 IF SY <> RPARENT THEN COMP 2890 REPEAT COMP 2891 IF LCP = NIL THEN COMP 2892 IF LSP = NIL THEN COMP 2893 BEGIN ERROR(42); (* TOO MANY VALUES SPECIFIED *) COMP 2894 SKIPSTRUCTUREDVALUE(FALSE) COMP 2895 END COMP 2896 ELSE (* LSP <> NIL *) COMP 2897 BEGIN WITH LSP^ DO COMP 2898 IF TAGTYPE <> NIL THEN V41CC07 257 BEGIN CONSTANT(LSYS,LSP1,LVALU); V41CC07 258 CHECKRANGE(TAGTYPE,LSP1,LVALU); V41CC07 259 IF TAGFIELDID <> NIL THEN V41CC07 260 BEGIN V41CC07 261 WITH TAGTYPE^ DO V41CC07 262 BEGIN WRDS := SIZE.WORDS; BITS := SIZE.BITS END; V41CC07 263 WITH TAGFIELDID^ DO V41CC07 264 BEGIN FWRD := LWRD + FLDADDR; V41CC07 265 FPCKD := PCKDFLD; V41CC07 266 IF FPCKD THEN FBIT := LBIT + BITADDR; V41CC07 267 EMITVALUE(LVALU) V41CC07 268 END V41CC07 269 END; V41CC07 270 LSP1 := FINDVARIANT(LSP,LVALU); V41CC07 271 IF LSP1 <> NIL THEN V41CC07 272 WITH LSP1^ DO V41CC07 273 BEGIN LCP := FIXEDPART; LSP := VARPART END V41CC07 274 ELSE BEGIN ERROR(158); LSP := NIL END V41CC07 275 END (* TAGTYPE <> NIL *) V41CC07 276 ELSE SKIPSTRUCTUREDVALUE(FALSE) COMP 2924 END (* LSP <> NIL *) COMP 2925 ELSE (* LCP <> NIL *) COMP 2926 WITH LCP^ DO COMP 2927 BEGIN IF PCKDFLD THEN BIT := LBIT+BITADDR ELSE BIT := 0; COMP 2928 VALUESPECIFICATION(LSYS,IDTYPE,LWRD+FLDADDR,BIT,PCKDFLD); COMP 2929 LCP := NEXT COMP 2930 END; COMP 2931 EXITLOOP := SY <> COMMA; COMP 2932 IF NOT EXITLOOP THEN INSYMBOL COMP 2933 UNTIL EXITLOOP; COMP 2934 IF (LCP <> NIL) OR (LSP <> NIL) THEN ERROR(41) (*TOO FEW VALUES*) COMP 2935 END (* RECORDVALUE *); COMP 2936 COMP 2937 PROCEDURE ARRAYVALUE; COMP 2938 TYPE REPLKIND = 1..4; COMP 2939 VAR EL,TEMP,REPCNT,LMIN,LMAX: INTEGER; COMP 2940 LVALU: VALU; COMP 2941 LCP: CTP; COMP 2942 LSP: STP; COMP 2943 CONSTVALUE: BOOLEAN; COMP 2944 LWRD,NWRDS: ADDRRANGE; COMP 2945 REPL: PACKED RECORD CASE REPLKIND OF COMP 2946 1: (I : INTEGER); COMP 2947 2: (CN : 0..7777B; COMP 2948 WC : 0..7777B; COMP 2949 CR : 0..77777777B; COMP 2950 IM : 0..7777B); COMP 2951 3: (INC : 0..77777777777B; COMP 2952 SR : 0..777B; COMP 2953 SADDR: 0..777777B); COMP 2954 4: (REP : 0..777777B; COMP 2955 BSZ : 0..77777B; COMP 2956 DR : 0..777B; COMP 2957 DADDR: 0..777777B) COMP 2958 END; COMP 2959 BEGIN (* ARRAYVALUE *) COMP 2960 WITH FSP^ DO COMP 2961 BEGIN REPCNT := 0; COMP 2962 WITH AELTYPE^ DO COMP 2963 BEGIN WRDS := SIZE.WORDS; COMP 2964 BITS := SIZE.BITS; COMP 2965 NWRDS := FULLWORDS(SIZE) COMP 2966 END; COMP 2967 FPCKD := PCKDARR; COMP 2968 IF FPCKD THEN FPCKD := PARTWORDELS; COMP 2969 GETBOUNDS(INXTYPE,LMIN,LMAX); COMP 2970 EL := LMIN; COMP 2971 REPEAT COMP 2972 IF REPCNT = 0 THEN COMP 2973 BEGIN INSYMBOL; COMP 2974 IF SY = IDENT THEN COMP 2975 BEGIN SEARCHID([KONST,UNKNOWNID],LCP); COMP 2976 CONSTVALUE := LCP <> NIL COMP 2977 END COMP 2978 ELSE CONSTVALUE := SY IN CONSTBEGSYS; COMP 2979 IF CONSTVALUE THEN COMP 2980 BEGIN CONSTANT(LSYS+[OFSY],LSP,LVALU); COMP 2981 IF SY = OFSY THEN COMP 2982 BEGIN REPCNT := 1; COMP 2983 IF COMPTYPES(LSP,INTPTR) THEN COMP 2984 IF LVALU.IVAL > 0 THEN REPCNT := LVALU.IVAL COMP 2985 ELSE ERROR(45) (* REPETITION FACTOR MUST BE > 0 *) COMP 2986 ELSE ERROR(145); COMP 2987 INSYMBOL; COMP 2988 IF FPCKD THEN COMP 2989 BEGIN TEMP := TEXTTAB[THIST].IVAL; COMP 2990 TEXTTAB[THIST].IVAL := 0; COMP 2991 VALUESPECIFICATION(LSYS,AELTYPE,LASTADDR,0,TRUE); COMP 2992 LVALU.IVAL := ROTATE(TEXTTAB[THIST].IVAL,BITS); COMP 2993 TEXTTAB[THIST].IVAL := TEMP; COMP 2994 EMITVALUE(LVALU); COMP 2995 REPCNT := REPCNT - 1 COMP 2996 END COMP 2997 ELSE (* NOT FPCKD *) COMP 2998 BEGIN VALUESPECIFICATION(LSYS,AELTYPE,FWRD,0,FALSE); COMP 2999 IF REPCNT > 1 THEN COMP 3000 BEGIN PUTTEXTTAB; COMP 3001 WITH REPL DO COMP 3002 BEGIN CN := 4300B; (* REPL TABLE *) COMP 3003 WC := 2; CR := 0; IM := 1; COMP 3004 VALUES^^ := I; PUT(VALUES^); COMP 3005 INC := NWRDS; SR := 1; SADDR := ARPS + FWRD; COMP 3006 VALUES^^ := I; PUT(VALUES^); COMP 3007 REP := REPCNT - 1; BSZ := NWRDS; DR := 1; COMP 3008 DADDR := ARPS + FWRD + NWRDS; COMP 3009 VALUES^^ := I; PUT(VALUES^) COMP 3010 END; COMP 3011 FWRD := FWRD + (REPCNT-1) * NWRDS; COMP 3012 EL := EL + REPCNT - 1 COMP 3013 END (* REPCNT > 1 *); COMP 3014 REPCNT := 0 COMP 3015 END (* NOT FPCKD *) COMP 3016 END COMP 3017 ELSE (* SY <> OFSY *) COMP 3018 BEGIN CHECKRANGE(AELTYPE,LSP,LVALU); COMP 3019 IF STRING(LSP) THEN COMP 3020 BEGIN LWRD := FWRD; COMP 3021 EMITSTRING(LVALU.VALP); COMP 3022 FWRD := LWRD COMP 3023 END COMP 3024 ELSE EMITVALUE(LVALU) COMP 3025 END COMP 3026 END COMP 3027 ELSE (* NOT CONSTVALUE *) COMP 3028 VALUESPECIFICATION(LSYS,AELTYPE,FWRD,FBIT,FPCKD) COMP 3029 END COMP 3030 ELSE (* REPCNT <> 0 *) COMP 3031 BEGIN EMITVALUE(LVALU); COMP 3032 REPCNT := REPCNT - 1 COMP 3033 END; COMP 3034 IF FPCKD THEN COMP 3035 IF FBIT + BITS + BITS > WORDSIZE THEN COMP 3036 BEGIN FBIT := 0; FWRD := FWRD + 1 END COMP 3037 ELSE FBIT := FBIT + BITS COMP 3038 ELSE FWRD := FWRD + NWRDS; COMP 3039 IF EL > LMAX THEN COMP 3040 BEGIN ERROR(42); (* TOO MANY VALUES SPECIFIED *) COMP 3041 REPCNT := 0; COMP 3042 IF SY = COMMA THEN SKIPSTRUCTUREDVALUE(TRUE) COMP 3043 END; COMP 3044 EL := EL + 1 COMP 3045 UNTIL (SY <> COMMA) AND (REPCNT = 0); COMP 3046 IF EL <= LMAX THEN ERROR(41) (* TOO FEW VALUES SPECIFIED *) COMP 3047 END (* WITH FSP^ *) COMP 3048 END (* ARRAYVALUE *); COMP 3049 COMP 3050 PROCEDURE SETVALUE; COMP 3051 VAR LOELEMENT,HIELEMENT: INTEGER; COMP 3052 EXITLOOP: BOOLEAN; COMP 3053 LVALU: VALU; COMP 3054 LSP: STP; COMP 3055 COMP 3056 PROCEDURE SETELEMENT(FSYS: SETOFSYS; VAR ELEMENT: INTEGER); COMP 3057 VAR LSP1: STP; COMP 3058 LVALU: VALU; COMP 3059 BEGIN (* SETELEMENT *) COMP 3060 CONSTANT(FSYS,LSP1,LVALU); COMP 3061 ELEMENT := 0; COMP 3062 IF LSP1 <> NIL THEN COMP 3063 IF LSP1^.FORM <= SUBRANGE THEN COMP 3064 BEGIN ELEMENT := LVALU.IVAL; CHECKRANGE(LSP,LSP1,LVALU) END COMP 3065 ELSE ERROR(136) COMP 3066 END (* SETELEMENT *); COMP 3067 COMP 3068 BEGIN (* SETVALUE *) COMP 3069 LVALU.PVAL := []; COMP 3070 LSP := NIL; COMP 3071 IF FSP <> NIL THEN COMP 3072 WITH FSP^ DO COMP 3073 IF FORM <> POWER THEN ERROR(145) COMP 3074 ELSE LSP := ELSET; COMP 3075 INSYMBOL; COMP 3076 IF SY <> RBRACK THEN COMP 3077 REPEAT SETELEMENT(FSYS+[DOTDOT,COMMA,RBRACK],LOELEMENT); COMP 3078 IF SY = DOTDOT THEN COMP 3079 BEGIN INSYMBOL; COMP 3080 SETELEMENT(FSYS+[COMMA,RBRACK],HIELEMENT); COMP 3081 LVALU.PVAL := LVALU.PVAL + [LOELEMENT..HIELEMENT] COMP 3082 END COMP 3083 ELSE LVALU.PVAL := LVALU.PVAL + [LOELEMENT]; COMP 3084 EXITLOOP := SY <> COMMA; COMP 3085 IF NOT EXITLOOP THEN INSYMBOL COMP 3086 UNTIL EXITLOOP; COMP 3087 EMITVALUE(LVALU); COMP 3088 EXPECTSYMBOL(RBRACK,12) COMP 3089 END (* SETVALUE *); COMP 3090 COMP 3091 BEGIN (* VALUESPECIFICATION *) COMP 3092 IF FSP <> NIL THEN WITH FSP^ DO COMP 3093 BEGIN WRDS := SIZE.WORDS; BITS := SIZE.BITS END; COMP 3094 LSYS := FSYS+[COMMA,RPARENT]; COMP 3095 RIGHTADJ := TRUE; COMP 3096 CHECKCONTEXT(VALSPECBEGSYS,6,FSYS); COMP 3097 IF SY IN VALSPECBEGSYS THEN COMP 3098 BEGIN COMP 3099 IF SY = IDENT THEN COMP 3100 BEGIN SEARCHID([KONST,TYPES],LCP); COMP 3101 IF LCP^.KLASS = TYPES THEN COMP 3102 BEGIN COMP 3103 IF FSP <> NIL THEN COMP 3104 BEGIN COMP 3105 IF NOT COMPTYPES(FSP,LCP^.IDTYPE) THEN ERROR(145) COMP 3106 END COMP 3107 ELSE FSP := LCP^.IDTYPE; COMP 3108 INSYMBOL; COMP 3109 IF SY <> LPARENT THEN COMP 3110 BEGIN ERROR(9); IF SY = IDENT THEN SEARCHID([KONST],LCP) END COMP 3111 END COMP 3112 END (* SY = IDENT *); COMP 3113 IF SY = LPARENT THEN COMP 3114 BEGIN COMP 3115 IF FSP = NIL THEN SKIPSTRUCTUREDVALUE(TRUE) COMP 3116 ELSE COMP 3117 WITH FSP^ DO COMP 3118 IF FORM = RECORDS THEN RECORDVALUE COMP 3119 ELSE COMP 3120 IF FORM = ARRAYS THEN ARRAYVALUE COMP 3121 ELSE COMP 3122 BEGIN ERROR(44); (* TYPE IS NEITHER ARRAY NOR RECORD *) COMP 3123 SKIPSTRUCTUREDVALUE(TRUE) COMP 3124 END; COMP 3125 EXPECTSYMBOL(RPARENT,4) COMP 3126 END COMP 3127 ELSE (* SY <> LPARENT *) COMP 3128 IF SY = LBRACK THEN SETVALUE COMP 3129 ELSE COMP 3130 BEGIN COMP 3131 IF SY = NILSY THEN COMP 3132 BEGIN LSP := NILPTR; COMP 3133 LVALU.IVAL := NILP; INSYMBOL COMP 3134 END COMP 3135 ELSE CONSTANT(FSYS,LSP,LVALU); COMP 3136 IF LSP <> NIL THEN COMP 3137 BEGIN CHECKRANGE(FSP,LSP,LVALU); COMP 3138 IF STRING(LSP) THEN EMITSTRING(LVALU.VALP) COMP 3139 ELSE EMITVALUE(LVALU) COMP 3140 END COMP 3141 END; COMP 3142 CHECKCONTEXT(FSYS,6,[]) COMP 3143 END (* SY IN VALSPECBEGSYS *) ; COMP 3144 END (* VALUESPECIFICATION *); COMP 3145 COMP 3146 BEGIN (* VALUEDECLARATION *) COMP 3147 IF LEVEL = 1 THEN COMP 3148 BEGIN LASTADDR := MAXADDR+1; THIST := 0; COMP 3149 COMP 3150 IDW.I := 0; IDW.CN := 4000B; (* TEXT TABLE *); IDW.LR := 1; COMP 3151 CHECKCONTEXT([IDENT],2,FSYS); COMP 3152 IF VALUES = NIL THEN BEGIN NEW(VALUES); REWRITE(VALUES^) END; COMP 3153 WHILE SY = IDENT DO COMP 3154 BEGIN SEARCHID([VARS],LCP); COMP 3155 WITH LCP^ DO COMP 3156 BEGIN IF VINIT THEN ERROR(43); (* INITIALIZED TWICE *) COMP 3157 VINIT := TRUE; COMP 3158 LSP := IDTYPE; COMP 3159 IF LSP <> NIL THEN COMP 3160 IF LSP^.FORM = FILES THEN COMP 3161 BEGIN ERROR(108); LSP := NIL END; COMP 3162 INSYMBOL; COMP 3163 IF OP = EQOP THEN INSYMBOL ELSE ERROR(16); COMP 3164 MARK(LMARK); COMP 3165 VALUESPECIFICATION(FSYS+[SEMICOLON],LSP,VADDR,0,FALSE); COMP 3166 RELEASE(LMARK) COMP 3167 END; COMP 3168 IF SY = SEMICOLON THEN COMP 3169 BEGIN INSYMBOL; CHECKCONTEXT(FSYS+[IDENT],6,[]) END COMP 3170 ELSE ERROR(14) COMP 3171 END (* WHILE *); COMP 3172 PUTTEXTTAB COMP 3173 END (* LEVEL = 1 *) COMP 3174 ELSE COMP 3175 BEGIN ERROR(40); (* VALUE PART ALLOWED ONLY IN MAIN PROGRAM *) COMP 3176 SKIP(FSYS) COMP 3177 END COMP 3178 END (* VALUEDECLARATION *); COMP 3179 COMP 3180 PROCEDURE PROCEDUREDECLARATION(FSY: SYMBOL); COMP 3181 VAR OLDLEV: LEVRANGE; LSY: SYMBOL; LCP,LCP1: CTP; LSP: STP; COMP 3182 FORW: BOOLEAN; OLDTOP: DISPRANGE; COMP 3183 LLC: ADDRRANGE; LMARK: MARKER; COMP 3184 MULTIWORDVALUEPARAMETER: BOOLEAN; COMP 3185 COMP 3186 PROCEDURE PFHEADER(HSYS: SETOFSYS; FSY: SYMBOL; VAR FCP: CTP; COMP 3187 VAR FORW: BOOLEAN; FKIND: IDKIND); COMP 3188 (* GATHER PROCEDURE/FUNCTION HEADER. FSY SPECIFIES WHETHER IT IS COMP 3189 A PROCEDURE OR FUNCTION, FKIND SPECIFIES WHETHER IT IS AN ACTUAL COMP 3190 PROC/FUNC OR A FORMAL PARAMETER. THE PARAMETER LIST IS COMP 3191 RETURNED IN FCP, AND FORW INDICATES IF IT IS FORWARD DECLARED. *) COMP 3192 VAR LCP,LCP1,LCP2: CTP; LSP: STP; COMP 3193 LKLASS: IDCLASS; COMP 3194 COMP 3195 PROCEDURE PARAMETERLIST(PSYS: SETOFSYS; VAR FPAR: CTP); COMP 3196 (* GATHER A PARAMETER LIST, RETURNING IT IN FPAR. *) COMP 3197 VAR LCP,LCP1,LCP2,LCP3: CTP; LSP,LSP1,LSP2: STP; COMP 3198 LACCESS: DRCTINDRCT; LVARPARAM: BOOLEAN; COMP 3199 SZ: INTEGER; LSY: SYMBOL; LFORW: BOOLEAN; COMP 3200 OLDTOP: DISPRANGE; LLC: ADDRRANGE; LSCOPE: SCOPERANGE; COMP 3201 EXITLOOP,CONFORMFLAG: BOOLEAN; COMP 3202 COMP 3203 PROCEDURE CNFARRAYSCHEMA(VAR FSP: STP); COMP 3204 VAR LSP,LSP1,LSP2: STP; LSIZE: ADDRRANGE; COMP 3205 PACKFLAG,EXITLOOP: BOOLEAN; T: INTEGER; COMP 3206 COMP 3207 PROCEDURE INDEXTYPESPECIFICATION(VAR FSP: STP); COMP 3208 VAR LSP1,LSP2: STP; LCP1,LCP2,LCP3: CTP; COMP 3209 COMP 3210 PROCEDURE BOUNDDECLARATION(VAR FCP: CTP); COMP 3211 VAR LCP: CTP; COMP 3212 BEGIN (* BOUNDDECLARATION *) COMP 3213 IF SY = IDENT THEN COMP 3214 BEGIN MNEW(LCP,BOUNDID); COMP 3215 WITH LCP^ DO COMP 3216 BEGIN COPYID(LCP); IDTYPE := NIL; NEXT := NIL; COMP 3217 KLASS := BOUNDID; COMP 3218 BADDR := 0; BLEV := LEVEL + ORD(LEVEL < MAXLEVEL) COMP 3219 END; COMP 3220 ENTERID(LCP,PFPAR); INSYMBOL COMP 3221 END COMP 3222 ELSE COMP 3223 BEGIN ERROR(222); LCP := NIL; COMP 3224 SKIP(FSYS+[DOTDOT,IDENT,COLON,RBRACK]) COMP 3225 END; COMP 3226 FCP := LCP COMP 3227 END (* BOUNDDECLARATION *); COMP 3228 COMP 3229 BEGIN (* INDEXTYPESPECIFICATION *) COMP 3230 BOUNDDECLARATION(LCP1); COMP 3231 EXPECTSYMBOL(DOTDOT,21); COMP 3232 BOUNDDECLARATION(LCP2); COMP 3233 EXPECTSYMBOL(COLON,5); COMP 3234 IF SY = IDENT THEN COMP 3235 BEGIN SEARCHID([TYPES],LCP3); COMP 3236 LSP2 := LCP3^.IDTYPE; COMP 3237 IF LSP2 <> NIL THEN COMP 3238 IF LSP2^.FORM > SUBRANGE THEN COMP 3239 BEGIN LSP2 := NIL; ERROR(223) END; COMP 3240 INSYMBOL COMP 3241 END COMP 3242 ELSE BEGIN ERROR(2); LSP2 := NIL END; COMP 3243 IF LCP1 <> NIL THEN LCP1^.IDTYPE := LSP2; COMP 3244 IF LCP2 <> NIL THEN LCP2^.IDTYPE := LSP2; COMP 3245 MNEW(LSP1,BOUNDDESC); COMP 3246 WITH LSP1^ DO COMP 3247 BEGIN FORM := BOUNDDESC; FTYPE := FALSE; COMP 3248 SIZE.WORDS := 0; SIZE.BITS := 0; BOUNDTYPE := LSP2; COMP 3249 LOWBOUND := LCP1; HIGHBOUND := LCP2 COMP 3250 END; COMP 3251 FSP := LSP1 COMP 3252 END (* INDEXTYPESPECIFICATION *); COMP 3253 COMP 3254 BEGIN (* CNFARRAYSCHEMA *) COMP 3255 IF SY = PACKEDSY THEN COMP 3256 BEGIN PACKFLAG := TRUE; INSYMBOL END COMP 3257 ELSE PACKFLAG := FALSE; COMP 3258 IF SY = ARRAYSY THEN COMP 3259 BEGIN LSP1 := NIL; COMP 3260 INSYMBOL; EXPECTSYMBOL(LBRACK,11); COMP 3261 (*LOOP UNTIL SY <> SEMICOLON:*) COMP 3262 REPEAT INDEXTYPESPECIFICATION(LSP2); COMP 3263 MNEW(LSP,ARRAYS); COMP 3264 WITH LSP^ DO COMP 3265 BEGIN FORM := ARRAYS; COMP 3266 AELTYPE := LSP1; INXTYPE := LSP2; FTYPE := FALSE; COMP 3267 PCKDARR := PACKFLAG; CONFORMANT := TRUE COMP 3268 END; COMP 3269 LSP1 := LSP; COMP 3270 EXITLOOP := SY <> SEMICOLON; COMP 3271 IF NOT EXITLOOP THEN COMP 3272 BEGIN INSYMBOL; IF PACKFLAG THEN ERROR(220) END COMP 3273 UNTIL EXITLOOP; COMP 3274 EXPECTSYMBOL(RBRACK,12); EXPECTSYMBOL(OFSY,8); COMP 3275 IF SY = IDENT THEN COMP 3276 BEGIN SEARCHID([TYPES],LCP); COMP 3277 LSP := LCP^.IDTYPE; INSYMBOL COMP 3278 END COMP 3279 ELSE COMP 3280 BEGIN IF PACKFLAG THEN ERROR(220); COMP 3281 CNFARRAYSCHEMA(LSP) COMP 3282 END COMP 3283 END COMP 3284 ELSE BEGIN ERROR(221); LSP := NIL END; COMP 3285 (*REVERSE POINTERS, COMPUTE SIZE, SET PARTWORDELS+ELSPERWORD*) COMP 3286 IF LSP <> NIL THEN COMP 3287 BEGIN LSIZE := 0; COMP 3288 IF CONFORMARRAY(LSP) THEN LSIZE := LSP^.SIZE.WORDS; COMP 3289 REPEAT COMP 3290 WITH LSP1^ DO COMP 3291 BEGIN LSP2 := AELTYPE; AELTYPE := LSP; FTYPE := LSP^.FTYPE; COMP 3292 LSIZE := LSIZE + 3; SIZE.WORDS := LSIZE; SIZE.BITS := 0; COMP 3293 IF PCKDARR THEN COMP 3294 IF LSP^.SIZE.WORDS > 0 THEN PARTWORDELS := FALSE COMP 3295 ELSE COMP 3296 IF LSP^.SIZE.BITS > 0 THEN COMP 3297 BEGIN T := WORDSIZE DIV LSP^.SIZE.BITS; COMP 3298 IF T > 1 THEN COMP 3299 BEGIN PARTWORDELS := TRUE; ELSPERWORD := T END COMP 3300 ELSE PARTWORDELS := FALSE COMP 3301 END COMP 3302 ELSE PARTWORDELS := FALSE COMP 3303 END; COMP 3304 LSP := LSP1; LSP1 := LSP2 COMP 3305 UNTIL LSP1 = NIL COMP 3306 END; COMP 3307 FSP := LSP COMP 3308 END (* CNFARRAYSCHEMA *); COMP 3309 COMP 3310 BEGIN (* PARAMETERLIST *) LCP1 := NIL; COMP 3311 CHECKCONTEXT(PSYS+[LPARENT],7,FSYS); COMP 3312 IF SY = LPARENT THEN COMP 3313 BEGIN IF FORW THEN ERROR(119); COMP 3314 OLDTOP := TOP; COMP 3315 IF TOP < DISPLIMIT THEN COMP 3316 BEGIN TOP := TOP + 1; COMP 3317 WITH DISPLAY[TOP] DO COMP 3318 BEGIN FNAME := NIL; REGION := PFPAR END COMP 3319 END COMP 3320 ELSE ERROR(250); COMP 3321 LSCOPE := THISSCOPE; COMP 3322 IF HIGHSCOPE = SCOPEMAX THEN ERROR(252) COMP 3323 ELSE HIGHSCOPE := HIGHSCOPE + 1; COMP 3324 THISSCOPE := HIGHSCOPE; COMP 3325 INSYMBOL; COMP 3326 IF NOT (SY IN [IDENT,VARSY,PROCEDURESY,FUNCTIONSY]) THEN COMP 3327 BEGIN ERROR(7); SKIP(FSYS+[IDENT,RPARENT]) END; COMP 3328 WHILE SY IN [IDENT,VARSY,PROCEDURESY,FUNCTIONSY] DO COMP 3329 BEGIN COMP 3330 IF SY IN [PROCEDURESY,FUNCTIONSY] THEN COMP 3331 BEGIN COMP 3332 LSY := SY; INSYMBOL; LLC := LC; COMP 3333 PFHEADER(HSYS+[RPARENT],LSY,LCP,LFORW,FORMAL); COMP 3334 LCP^.PFADDR := LLC; LC := LLC + 1; COMP 3335 LCP^.NEXT := LCP1; LCP1 := LCP COMP 3336 END COMP 3337 ELSE COMP 3338 BEGIN LCP2 := LCP1; LSP := NIL; COMP 3339 IF SY = VARSY THEN COMP 3340 BEGIN LACCESS := INDRCT; LVARPARAM := TRUE; INSYMBOL END COMP 3341 ELSE BEGIN LACCESS := DRCT; LVARPARAM := FALSE END; COMP 3342 (*LOOP UNTIL SY <> COMMA:*) COMP 3343 REPEAT COMP 3344 IF SY = IDENT THEN COMP 3345 BEGIN MNEW(LCP,VARS); COMP 3346 WITH LCP^ DO COMP 3347 BEGIN COPYID(LCP); IDTYPE := NIL; KLASS := VARS; COMP 3348 VKIND := FORMAL; VARPARAM := LVARPARAM; COMP 3349 NEXT := LCP1; COMP 3350 VLEV := LEVEL + ORD(LEVEL < MAXLEVEL); COMP 3351 VADDR := LC; THREAT := FALSE; CONTROLVAR := FALSE; COMP 3352 FIRSTINPARMGROUP := (LCP1 = LCP2) COMP 3353 END; COMP 3354 ENTERID(LCP,PFPAR); COMP 3355 LCP1 := LCP; LC := LC + 1; COMP 3356 INSYMBOL; COMP 3357 END COMP 3358 ELSE ERROR(2); COMP 3359 IF NOT (SY IN [COMMA,COLON]) THEN COMP 3360 BEGIN ERROR(7); SKIP(FSYS+[COMMA,SEMICOLON,RPARENT]) COMP 3361 END; COMP 3362 EXITLOOP := SY <> COMMA; COMP 3363 IF NOT EXITLOOP THEN INSYMBOL COMP 3364 UNTIL EXITLOOP; COMP 3365 IF SY = COLON THEN COMP 3366 BEGIN INSYMBOL; COMP 3367 IF SY = IDENT THEN COMP 3368 BEGIN SEARCHID([TYPES],LCP); COMP 3369 LSP := LCP^.IDTYPE; INSYMBOL COMP 3370 END COMP 3371 ELSE V41AC20 25 IF NOT (OPTS.DIALECT IN [ANSI,ISO0]) THEN V41DC05 473 CNFARRAYSCHEMA(LSP) V41DC05 474 ELSE ERROR(191); V41AC20 27 IF LSP <> NIL THEN COMP 3373 IF NOT LVARPARAM THEN COMP 3374 BEGIN COMP 3375 IF LSP^.FTYPE THEN ERROR(121); COMP 3376 IF CONFORMARRAY(LSP) THEN LACCESS := INDRCT COMP 3377 ELSE COMP 3378 IF FULLWORDS(LSP^.SIZE) >= MVOPTION THEN COMP 3379 LACCESS := INDRCT; COMP 3380 MULTIWORDVALUEPARAMETER := MULTIWORDVALUEPARAMETER COMP 3381 OR (FULLWORDS(LSP^.SIZE) > 1) COMP 3382 END; COMP 3383 CHECKCONTEXT([SEMICOLON,RPARENT],7,FSYS) COMP 3384 END COMP 3385 ELSE ERROR(5); COMP 3386 LCP3 := LCP1; CONFORMFLAG := CONFORMARRAY(LSP); COMP 3387 WHILE LCP3 <> LCP2 DO COMP 3388 BEGIN LCP3^.IDTYPE := LSP; COMP 3389 LCP3^.VACCESS := LACCESS; COMP 3390 LCP3^.CONFORMNT := CONFORMFLAG; LCP3 := LCP3^.NEXT COMP 3391 END COMP 3392 END; COMP 3393 IF SY = SEMICOLON THEN COMP 3394 BEGIN INSYMBOL; COMP 3395 IF NOT (SY IN [IDENT,VARSY,PROCEDURESY,FUNCTIONSY]) THEN COMP 3396 BEGIN ERROR(7); SKIP(FSYS+[IDENT,RPARENT]) END COMP 3397 END COMP 3398 END (* WHILE *); COMP 3399 IF LC - PFLC > MAXPARAMS THEN ERROR(263); COMP 3400 IF SY = RPARENT THEN COMP 3401 BEGIN INSYMBOL; COMP 3402 CHECKCONTEXT(PSYS+FSYS,6,[]) COMP 3403 END COMP 3404 ELSE ERROR(4); COMP 3405 LCP3 := NIL; COMP 3406 (*REVERSE POINTERS AND RESERVE LOCAL CELLS FOR COPIES OF MULTI- COMP 3407 WORD NON-CONFORMANT VALUES AND CONFORMANT-ARRAY DESCRIPTORS*) COMP 3408 WHILE LCP1 <> NIL DO COMP 3409 WITH LCP1^ DO COMP 3410 BEGIN LCP2 := NEXT; NEXT := LCP3; COMP 3411 IF KLASS = VARS THEN COMP 3412 IF IDTYPE <> NIL THEN COMP 3413 IF CONFORMNT THEN COMP 3414 BEGIN COMP 3415 IF FIRSTINPARMGROUP THEN COMP 3416 BEGIN (* SET DESCADDR, BOUNDID ADDRESSES *) COMP 3417 LSP := IDTYPE; LLC := LC; COMP 3418 REPEAT COMP 3419 LSP1 := LSP^.INXTYPE; LSP^.DESCADDR := LLC; COMP 3420 IF LSP1 <> NIL THEN COMP 3421 WITH LSP1^ DO COMP 3422 BEGIN COMP 3423 IF LOWBOUND <> NIL THEN LOWBOUND^.BADDR := LLC+2; COMP 3424 IF HIGHBOUND <> NIL THEN HIGHBOUND^.BADDR := LLC+1 COMP 3425 END; COMP 3426 LLC := LLC+3; LSP := LSP^.AELTYPE; COMP 3427 EXITLOOP := TRUE; COMP 3428 IF LSP <> NIL THEN COMP 3429 IF LSP^.FORM = ARRAYS THEN COMP 3430 IF LSP^.CONFORMANT THEN EXITLOOP := FALSE COMP 3431 UNTIL EXITLOOP; COMP 3432 LC := LLC COMP 3433 END COMP 3434 END COMP 3435 ELSE COMP 3436 BEGIN SZ := FULLWORDS(IDTYPE^.SIZE); COMP 3437 IF (VACCESS = DRCT) AND (SZ <> 1) THEN COMP 3438 BEGIN VADDR := LC; LC := LC + SZ END COMP 3439 END; COMP 3440 LCP3 := LCP1; LCP1 := LCP2 COMP 3441 END; COMP 3442 TOP := OLDTOP; THISSCOPE := LSCOPE; COMP 3443 FPAR := LCP3 COMP 3444 END COMP 3445 ELSE FPAR := NIL COMP 3446 END (* PARAMETERLIST *); COMP 3447 COMP 3448 PROCEDURE PFNAME(FI: INTEGER); COMP 3449 (* CREATE INTERNAL NAME FOR PROC/FUNC FROM FI *) COMP 3450 VAR K,L: INTEGER; COMP 3451 BEGIN COMP 3452 FOR K := 7 DOWNTO 4 DO COMP 3453 BEGIN L := FI DIV 8; COMP 3454 PNAME[K] := CHR(ORD('0') + FI - 8 * L); COMP 3455 FI := L COMP 3456 END COMP 3457 END (* PFNAME *); COMP 3458 COMP 3459 BEGIN (* PFHEADER *) COMP 3460 LC := PFLC; COMP 3461 IF FSY = PROCEDURESY THEN LKLASS := PROC ELSE LKLASS := FUNC; COMP 3462 IF SY = IDENT THEN (* DECIDE WHETHER FORWARD *) COMP 3463 BEGIN SEARCHSECTION(DISPLAY[TOP].FNAME,LCP); COMP 3464 IF LCP <> NIL THEN COMP 3465 WITH LCP^ DO COMP 3466 BEGIN COMP 3467 FORW := (KLASS = LKLASS) AND (FKIND = ACTUAL); V41CC20 28 IF FORW THEN V41CC20 29 BEGIN FORW := PFKIND = ACTUAL; V41CC20 30 IF FORW THEN FORW := PFDECL IN [FORWDECL,FORWDECLERR] V41CC20 31 END; V41CC20 32 IF NOT FORW THEN ERROR(160) COMP 3471 END COMP 3472 ELSE FORW := FALSE; COMP 3473 IF NOT FORW THEN COMP 3474 BEGIN COMP 3475 IF FKIND = ACTUAL THEN MNEW(LCP,PROC,USERDECLARED,ACTUAL) COMP 3476 ELSE MNEW(LCP,PROC,USERDECLARED,FORMAL); COMP 3477 WITH LCP^ DO COMP 3478 BEGIN COPYID(LCP); IDTYPE := NIL; NEXT := NIL; COMP 3479 KLASS := LKLASS; PFDECKIND := USERDECLARED; PFKIND := FKIND; COMP 3480 PFLEV := LEVEL + ORD((FKIND=FORMAL) AND (LEVEL NIL THEN COMP 3510 IF LSP^.FORM > POINTER THEN COMP 3511 BEGIN ERROR(120); LCP^.IDTYPE := NIL END; COMP 3512 INSYMBOL COMP 3513 END COMP 3514 ELSE BEGIN ERROR(2); SKIP(FSYS+HSYS) END COMP 3515 END COMP 3516 ELSE (* SY <> COLON *) COMP 3517 IF NOT FORW THEN ERROR(123) COMP 3518 END; COMP 3519 IF NOT FORW THEN LCP^.PARAMLIST := LCP1; COMP 3520 FCP := LCP COMP 3521 END (* PFHEADER *); COMP 3522 COMP 3523 BEGIN (*PROCEDUREDECLARATION*) COMP 3524 LLC := LC; DP := TRUE; COMP 3525 MULTIWORDVALUEPARAMETER := FALSE; COMP 3526 PFHEADER([SEMICOLON],FSY,LCP,FORW,ACTUAL); COMP 3527 WITH LCP^ DO COMP 3528 BEGIN LC := LC + ORD(KLASS = FUNC); COMP 3529 FIRSTVAR := LC COMP 3530 END; COMP 3531 EXPECTSYMBOL(SEMICOLON,14); COMP 3532 IF SY = IDENT THEN COMP 3533 BEGIN IF FORW THEN ERROR(161); COMP 3534 WITH LCP^ DO COMP 3535 IF ID.TEN = KW[FORWARDKW] THEN COMP 3536 BEGIN PFDECL := FORWDECL; LFORWCNT := LFORWCNT + 1 END COMP 3537 ELSE COMP 3538 IF OPTS.DIALECT = P6000 THEN V41DC05 475 BEGIN V41AC20 29 IF ID.TEN = KW[EXTERNALKW] THEN V41AC20 30 BEGIN EXTENSION(325); PFDECL := EXTDECL END V41AC20 31 ELSE V41AC20 32 IF ID.TEN = KW[FORTRANKW] THEN V41AC20 33 BEGIN EXTENSION(325); PFDECL := FTNDECL; V41AC20 34 IF MULTIWORDVALUEPARAMETER THEN ERROR(240) V41AC20 35 END V41AC20 36 ELSE BEGIN ERROR(162); PFDECL := EXTDECL END; V41AC20 37 IF EPT1 = TENBLANKS THEN EPT := NAME.TEN V41AC20 38 END V41AC20 39 ELSE ERROR(162); V41AC20 40 INSYMBOL; COMP 3550 EXPECTSYMBOL(SEMICOLON,14); COMP 3551 CHECKCONTEXT(FSYS,6,[]) COMP 3552 END COMP 3553 ELSE COMP 3554 BEGIN V41CC20 33 IF FORW THEN LFORWCNT := LFORWCNT - ORD(LCP^.PFDECL = FORWDECL); V41CC20 34 LCP^.PFDECL := DECL; V41CC20 35 OLDLEV := LEVEL; OLDTOP := TOP; COMP 3557 IF LEVEL < MAXLEVEL THEN LEVEL := LEVEL + 1 ELSE ERROR(251); COMP 3558 IF TOP < DISPLIMIT THEN COMP 3559 BEGIN TOP := TOP + 1; COMP 3560 WITH DISPLAY[TOP] DO COMP 3561 BEGIN FNAME := LCP^.PARAMLIST; REGION := BLCK; COMP 3562 PFCP := LCP; ASSIGNED := FALSE COMP 3563 END COMP 3564 END COMP 3565 ELSE ERROR(250); COMP 3566 (* BLOCKSCOPE = THISSCOPE *) COMP 3567 IF HIGHSCOPE = SCOPEMAX THEN ERROR(252) COMP 3568 ELSE HIGHSCOPE := HIGHSCOPE + 1; COMP 3569 THISSCOPE := HIGHSCOPE; COMP 3570 MARK(LMARK); COMP 3571 BLOCK(FSYS,SEMICOLON,LCP); COMP 3572 IF (LCP^.KLASS = FUNC) AND NOT DISPLAY[TOP].ASSIGNED THEN COMP 3573 ERROR(185); COMP 3574 IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14); COMP 3575 IF TOP <> OLDTOP THEN RELEASE(LMARK); COMP 3576 LEVEL := OLDLEV; TOP := OLDTOP; COMP 3577 THISSCOPE := BLOCKSCOPE COMP 3578 END; COMP 3579 LC := LLC; COMP 3580 END (*PROCEDUREDECLARATION*) ; COMP 3581 (*$L'PROCEDURE / FUNCTION BODY PROCESSOR.' *) COMP 3582 COMP 3583 COMP 3584 PROCEDURE BODY(FSYS: SETOFSYS); COMP 3585 TYPE RCODERANGE = 0..RCODEMAX; COMP 3586 CODEP = ^CODESEGMENT; COMP 3587 CODESEGMENT = RECORD NXTSEG: CODEP; COMP 3588 RCODE: ARRAY [RCODERANGE] OF INTEGER; COMP 3589 CODE: ARRAY [CODERANGE] OF INTEGER COMP 3590 END; COMP 3591 COMP 3592 CSTKIND = (NOP,PUREP,POSP,NEGP); COMP 3593 CSTREC = PACKED RECORD COMP 3594 CASE CKIND : CSTKIND OF COMP 3595 NOP: (); COMP 3596 PUREP: (EXP: BITRANGE); COMP 3597 POSP, COMP 3598 NEGP: (EXP1,EXP2: BITRANGE) COMP 3599 END; COMP 3600 REGSET = SET OF REGNR; COMP 3601 COMP 3602 VAR COMP 3603 CSEGP: CODEP; COMP 3604 PMDCODE : INTEGER; COMP 3605 PARAMS: 0..MAXINT; PARAMSINREGS: 0..MAXPARAMSINREGS; COMP 3606 BHWFIXES, PMDFIXES: INTEGER; COMP 3607 BHWIC,EPTIC,PITIC: INTEGER; COMP 3608 BHWPC, PMDPC, INITARPC, ENTRYPC1, ENTRYPC2: PLACE; COMP 3609 QUICKENTRY, INITARFLAG, EPILOGUEFLAG: BOOLEAN; COMP 3610 LCP: CTP; LFSTOCC: LOCOFREF; COMP 3611 LP: CTAILP; COMP 3612 I,K: REGNR; COMP 3613 LPL,LPL1,LPL2 : PLACE; COMP 3614 LCMAX,LDISP,LSZ,LDESC,LINDEX : ADDRRANGE; COMP 3615 RCIX: RCODERANGE; RCP: 1..15; COMP 3616 LASTOP : OPCODE; COMP 3617 LASTI : REGNR; COMP 3618 LOCP: LOCOFREF; LCSP: CSP; COMP 3619 STMTLEVEL: ADDRRANGE; COMP 3620 PSMAX, (* MAX SIZE OF PARAM STACK FOR BODY. *) COMP 3621 PSSTORE, (* 1 + HIGHEST PARAM STACK OFFSET STORED INTO. *) COMP 3622 PSMARK: INTEGER;(* B6 = PSMARK + FWA(PARAM STACK). *) COMP 3623 COMP 3624 PROCEDURE NOOP; COMP 3625 BEGIN (* NOOP *) COMP 3626 WITH PC DO COMP 3627 WHILE CP < 4 DO COMP 3628 BEGIN CBUF := CBUF * 100000B + NOI[ODD(CP)]; COMP 3629 RBUF := 2 * RBUF; CP := CP + 1 COMP 3630 END; COMP 3631 LASTOP := NO COMP 3632 END (* NOOP *); COMP 3633 COMP 3634 PROCEDURE PUTREL(R: INTEGER); COMP 3635 VAR SEGP: CODEP; COMP 3636 BEGIN CSEGP^.RCODE[RCIX] := RBUF; RBUF := R; RCP := 1; COMP 3637 WITH PC DO COMP 3638 IF CIX = CODEMAX THEN COMP 3639 BEGIN MNEW(SEGP); SEGP^.NXTSEG := CSEGP; CSEGP := SEGP; COMP 3640 CIX := 0; SIX := SIX + 1; RCIX := 0 COMP 3641 END; COMP 3642 RCIX := RCIX + 1 COMP 3643 END (*PUTREL*) ; COMP 3644 COMP 3645 PROCEDURE SHORTNAME(FNAME: ALFA; VAR F1NAME: ALFA); COMP 3646 VAR I: 1..ALFALENG; COMP 3647 BEGIN I := ALFALENG; COMP 3648 IF FNAME <> TENBLANKS THEN COMP 3649 WHILE (FNAME[I] = ' ')OR (I > 7) DO COMP 3650 BEGIN FNAME[I] := CHR(0); I := I - 1 END; COMP 3651 F1NAME := FNAME COMP 3652 END (*SHORTNAME*); COMP 3653 COMP 3654 PROCEDURE SEARCHEXTID(FNAME: ALFA); COMP 3655 (* RETURNS POINTER TO FNAME-ENTRY IN EXT *) COMP 3656 COMP 3657 PROCEDURE ALLOCID; COMP 3658 BEGIN MNEW(EXT); COMP 3659 WITH EXT^ DO COMP 3660 BEGIN COMP 3661 L := NIL; R := NIL; REF := NIL; EXID := FNAME; COMP 3662 EXTIDX := EXTIDX + 1 COMP 3663 END COMP 3664 END; COMP 3665 COMP 3666 BEGIN SHORTNAME(FNAME,FNAME); COMP 3667 IF EXTROOT = NIL THEN COMP 3668 BEGIN ALLOCID; EXTROOT := EXT END COMP 3669 ELSE COMP 3670 BEGIN EXT := EXTROOT; COMP 3671 WHILE EXT^.EXID <> FNAME DO WITH EXT^ DO COMP 3672 IF EXID < FNAME THEN COMP 3673 IF R = NIL THEN BEGIN ALLOCID; R := EXT END ELSE EXT := R COMP 3674 ELSE COMP 3675 IF L = NIL THEN BEGIN ALLOCID; L:= EXT END ELSE EXT := L COMP 3676 END COMP 3677 END; COMP 3678 COMP 3679 PROCEDURE GEN30(FOP: OPCODE; FI,FJ: REGNR; FK: ADDRFIELD; COMP 3680 FR: RELOCATION); COMP 3681 FORWARD; COMP 3682 COMP 3683 PROCEDURE CHECKLINENUM; COMP 3684 (* ASSUMES PMD=PMDON *) COMP 3685 VAR EXTL : EXTIDP; COMP 3686 BEGIN IF SETLINENUM COMP 3687 THEN BEGIN SETLINENUM := FALSE; COMP 3688 EXTL := EXT; COMP 3689 EXT := NIL; COMP 3690 GEN30(SABPK,0,0,LINENUM,ABSR); COMP 3691 EXT := EXTL COMP 3692 END COMP 3693 END (* CHECKLINENUM *); COMP 3694 COMP 3695 PROCEDURE GEN15(FOP: OPCODE; FI,FJ: REGNR; FK: BITRANGE); COMP 3696 BEGIN (* GEN15 *) COMP 3697 IF PMD = PMDON THEN CHECKLINENUM; COMP 3698 LASTOP := FOP; LASTI := FI; COMP 3699 WITH PC DO COMP 3700 IF CP <> 4 THEN COMP 3701 BEGIN CP := CP + 1; COMP 3702 CBUF := CBUF * 100B + ORD(FOP); COMP 3703 RBUF := RBUF * 2 COMP 3704 END COMP 3705 ELSE COMP 3706 BEGIN CSEGP^.CODE[CIX] := CBUF; COMP 3707 CBUF := ORD(FOP); CP := 1; COMP 3708 IF RCP = 15 THEN PUTREL(0) COMP 3709 ELSE BEGIN RBUF := 2 * RBUF; RCP := RCP + 1 END; COMP 3710 IF IC = ICMAX THEN ERROR(253); COMP 3711 CIX := CIX + 1; IC := IC + 1 COMP 3712 END; COMP 3713 CBUF := ((10B * CBUF + FI) * 10B + FJ) * 10B + FK COMP 3714 END (* GEN15 *); COMP 3715 COMP 3716 PROCEDURE GEN30; COMP 3717 VAR EXTRP: EXTREFP; COMP 3718 BEGIN (* GEN30 *) COMP 3719 IF PMD = PMDON THEN CHECKLINENUM; COMP 3720 IF FR IN [VARR,GLOBLR,TERAR,TMEMR] THEN COMP 3721 BEGIN SEARCHEXTID(EXTNAMES[FR]); FR := ABSR END; COMP 3722 WITH PC DO COMP 3723 IF CP < 3 THEN COMP 3724 BEGIN CBUF := CBUF * 100B + ORD(FOP); COMP 3725 RBUF := RBUF * 4 + ORD(FR); COMP 3726 CP := CP + 2 COMP 3727 END COMP 3728 ELSE COMP 3729 BEGIN IF CP = 3 THEN NOOP; COMP 3730 CSEGP^.CODE[CIX] := CBUF; COMP 3731 CBUF := ORD(FOP); CP := 2; COMP 3732 IF RCP = 15 THEN PUTREL(ORD(FR)) COMP 3733 ELSE BEGIN RBUF := RBUF * 4 + ORD(FR); RCP := RCP + 1 END; COMP 3734 IF IC = ICMAX THEN ERROR(253); COMP 3735 CIX := CIX + 1; IC := IC + 1 COMP 3736 END; COMP 3737 LASTOP := FOP; LASTI := FI; COMP 3738 IF FK < 0 THEN FK := FK + 777777B; COMP 3739 CBUF := ((CBUF * 10B + FI) * 10B + FJ) * 1000000B + FK; COMP 3740 IF EXT <> NIL THEN COMP 3741 BEGIN MNEW(EXTRP); EXTRX := EXTRX + 1; COMP 3742 WITH EXTRP^,EXT^ DO COMP 3743 BEGIN LINK := REF; COMP 3744 REF := EXTRP; COMP 3745 LOC := ((8 - PC.CP) * 1000B + 1) * 1000000B + IC - 1; COMP 3746 EXT := NIL COMP 3747 END COMP 3748 END COMP 3749 END (* GEN30 *); COMP 3750 COMP 3751 PROCEDURE GENINC(FOP: INCOPRANGE; FI, FJ: REGNR; FK: ADDRFIELD); COMP 3752 (* GENERATE INCREMENT-UNIT INSTRUCTION. CHANGES 30-BIT *) COMP 3753 (* INSTRUCTIONS TO 15-BIT INSTRUCTIONS IF POSSIBLE BY *) COMP 3754 (* ASSUMING B1 = 1. THE ADDRESS FIELD MUST BE ABSOLUTE AND *) COMP 3755 (* NOT RELATIVE TO AN EXTERNAL SYMBOL. *) COMP 3756 VAR LOP: OPCODE; COMP 3757 BEGIN (* GENINC *) COMP 3758 LOP := GENINCOPS[FOP]; COMP 3759 IF LOP = PS THEN GEN15(FOP,FI,FJ,FK) COMP 3760 ELSE COMP 3761 IF FK IN [0,1] THEN GEN15(LOP,FI,FJ,FK) COMP 3762 ELSE COMP 3763 IF (FK = -1) AND (FOP IN [SAAPK,SABPK,SBAPK,SBBPK,SXAPK,SXBPK]) COMP 3764 THEN GEN15(SUCC(LOP),FI,FJ,1) COMP 3765 ELSE COMP 3766 IF (FK = 2) AND (FJ = 0) AND (FOP IN [SABPK,SBBPK,SXBPK]) COMP 3767 THEN GEN15(LOP,FI,1,1) COMP 3768 ELSE GEN30(FOP,FI,FJ,FK,ABSR) COMP 3769 END (* GENINC *) ; COMP 3770 COMP 3771 PROCEDURE INS(FIC: INTEGER; FPL: PLACE); COMP 3772 VAR SEGP: CODEP; I: INTEGER; COMP 3773 BEGIN IF FIC < 0 THEN FIC := 777777B + FIC; COMP 3774 WITH FPL DO COMP 3775 BEGIN IF (SIX=PC.SIX)AND(CIX=PC.CIX) THEN CP := 4 - PC.CP + CP; COMP 3776 CASE CP OF COMP 3777 1: FIC := FIC*1000000000000000B; COMP 3778 2: FIC := FIC*10000000000B; COMP 3779 3: FIC := FIC*100000B; COMP 3780 4: COMP 3781 END; COMP 3782 IF SIX = PC.SIX THEN COMP 3783 BEGIN IF CIX = PC.CIX THEN CBUF := CBUF + FIC COMP 3784 ELSE WITH CSEGP^ DO CODE[CIX] := CODE[CIX] + FIC COMP 3785 END COMP 3786 ELSE COMP 3787 BEGIN SEGP := CSEGP; COMP 3788 FOR I := PC.SIX - 1 DOWNTO SIX DO SEGP := SEGP^.NXTSEG; COMP 3789 WITH SEGP^ DO CODE[CIX] := CODE[CIX] + FIC COMP 3790 END COMP 3791 END COMP 3792 END (*INS*) ; COMP 3793 COMP 3794 PROCEDURE LINKOCC(VAR FPTR: LOCOFREF); COMP 3795 VAR LOCP: LOCOFREF; COMP 3796 BEGIN MNEW(LOCP); COMP 3797 WITH LOCP^, PC DO COMP 3798 BEGIN NXTREF := FPTR; FPTR := LOCP; COMP 3799 LOC := PC COMP 3800 END COMP 3801 END (*LINKOCC*) ; COMP 3802 COMP 3803 PROCEDURE GEN60(FC:INTEGER); COMP 3804 VAR I:SHRTINT; COMP 3805 BEGIN NOOP; COMP 3806 WITH PC DO COMP 3807 BEGIN COMP 3808 CSEGP^.CODE[CIX] := CBUF; CBUF := FC; COMP 3809 IF RCP = 15 THEN PUTREL(0) COMP 3810 ELSE BEGIN RBUF := RBUF*16; RCP := RCP + 1 END; COMP 3811 IF IC = ICMAX THEN ERROR(253); COMP 3812 CIX := CIX + 1; IC := IC + 1 COMP 3813 END COMP 3814 END (*GEN60*); COMP 3815 COMP 3816 PROCEDURE CLEARREGS; COMP 3817 VAR I: INTEGER; COMP 3818 BEGIN COMP 3819 FOR I := 0 TO 7 DO COMP 3820 BEGIN COMP 3821 XRGS[I].XCONT := AVAIL; ARGS[I].ACONT := UNSPECADDR COMP 3822 END; COMP 3823 BRGS := [0,2,3,7] (* B0 IS ALWAYS FREE *) COMP 3824 END (* CLEARREGS *) ; COMP 3825 COMP 3826 PROCEDURE SAVEREGMAP(VAR FREGMAP: REGMAP); COMP 3827 BEGIN COMP 3828 WITH FREGMAP DO COMP 3829 BEGIN XMAP := XRGS; AMAP := ARGS END COMP 3830 END (* SAVEREGMAP *) ; COMP 3831 COMP 3832 PROCEDURE RESTOREREGMAP(VAR FREGMAP: REGMAP); COMP 3833 BEGIN COMP 3834 WITH FREGMAP DO COMP 3835 BEGIN XRGS := XMAP; ARGS := AMAP END COMP 3836 END (* RESTOREREGMAP *) ; COMP 3837 COMP 3838 PROCEDURE MERGEREGMAP(VAR FREGMAP: REGMAP); COMP 3839 (* MERGE GLOBAL REGISTER MAP AND FREGMAP INTO FREGMAP *) COMP 3840 (* *) COMP 3841 (* PRESERVES INVARIANT ON FREGMAP: *) COMP 3842 (* XMAP[I].REFNR = *) COMP 3843 (* CARD( [ J : (XMAP[J].XCONT = INDVAR) AND *) COMP 3844 (* (XMAP[J].XREG = I) ] ) *) COMP 3845 COMP 3846 VAR I: REGNR; COMP 3847 COMP 3848 PROCEDURE MERGEX(VAR FX1, FX2: XRGSTAT); COMP 3849 VAR F: BOOLEAN; COMP 3850 BEGIN COMP 3851 IF FX1.XCONT = FX2.XCONT THEN COMP 3852 CASE FX1.XCONT OF COMP 3853 AVAIL: F := FALSE; COMP 3854 SHRTCST: F := FX1.CSTVAL <> FX2.CSTVAL; COMP 3855 LONGCST: F := FX1.CPTR <> FX2.CPTR; (* COULD COMPARE VALUES *) COMP 3856 SIMPVAR: F := (FX1.SHFTCNT <> FX2.SHFTCNT) OR COMP 3857 (FX1.XLEV <> FX2.XLEV) OR COMP 3858 (FX1.XADDR <> FX2.XADDR); COMP 3859 INDVAR: BEGIN COMP 3860 F := (FX1.SHFTCNT <> FX2.SHFTCNT) OR COMP 3861 (FX1.XREG <> FX2.XREG) OR COMP 3862 (FX1.XDISPL <> FX2.XDISPL); COMP 3863 IF NOT F THEN COMP 3864 BEGIN MERGEX(FREGMAP.XMAP[FX1.XREG],XRGS[FX1.XREG]); COMP 3865 F := FREGMAP.XMAP[FX1.XREG].XCONT = AVAIL COMP 3866 END COMP 3867 END; COMP 3868 OTHER: F := TRUE COMP 3869 END COMP 3870 ELSE F := TRUE; COMP 3871 IF F THEN COMP 3872 BEGIN COMP 3873 IF FX1.XCONT = INDVAR THEN COMP 3874 WITH FREGMAP.XMAP[FX1.XREG] DO COMP 3875 IF XCONT <> AVAIL THEN REFNR := REFNR - 1; COMP 3876 FX1.XCONT := AVAIL COMP 3877 END COMP 3878 END (* MERGEX *) ; COMP 3879 COMP 3880 PROCEDURE MERGEA(VAR FA1, FA2: ARGSTAT); COMP 3881 (* ASSUMES X-REGISTER MAPS ARE ALREADY MERGED. *) COMP 3882 BEGIN COMP 3883 IF FA1.ACONT <> UNSPECADDR THEN COMP 3884 IF (FA1.ACONT = FA2.ACONT) AND (FA1.ADISPL = FA2.ADISPL) THEN COMP 3885 CASE FA1.ACONT OF COMP 3886 SIMPADDR: IF FA1.ALEV <> FA2.ALEV THEN FA1.ACONT := UNSPECADDR; COMP 3887 INDADDR: IF (FA1.AREG <> FA2.AREG) OR COMP 3888 (FREGMAP.XMAP[FA1.AREG].XCONT = AVAIL) COMP 3889 THEN FA1.ACONT := UNSPECADDR COMP 3890 END COMP 3891 ELSE FA1.ACONT := UNSPECADDR COMP 3892 END (* MERGEA *) ; COMP 3893 COMP 3894 BEGIN (* MERGEREGMAP *) COMP 3895 FOR I := 7 DOWNTO 0 DO MERGEX(FREGMAP.XMAP[I],XRGS[I]); COMP 3896 FOR I := 7 DOWNTO 1 DO MERGEA(FREGMAP.AMAP[I],ARGS[I]) COMP 3897 END (* MERGEREGMAP *) ; COMP 3898 COMP 3899 PROCEDURE RJTOEXT(FNAME: ALFA); COMP 3900 BEGIN COMP 3901 SEARCHEXTID(FNAME); CLEARREGS; COMP 3902 GEN30(RJ,0,0,0,ABSR); NOOP COMP 3903 END; (* RJTOEXT *) COMP 3904 COMP 3905 PROCEDURE EQTOEXT(FNAME: ALFA); COMP 3906 BEGIN COMP 3907 SEARCHEXTID(FNAME); CLEARREGS; COMP 3908 GEN30(EQ,0,0,0,ABSR); NOOP COMP 3909 END; (* EQTOEXT *) COMP 3910 COMP 3911 COMP 3912 PROCEDURE ENTERCST(FCSTP: CTAILP); COMP 3913 (*ENTER CONST POINTED AT BY FCSTP INTO CONSTANT TABLE AND CHAIN COMP 3914 ACTUAL OCCURRENCE IN CODE (AT ) WITH EARLIER OCCURRENCES*) COMP 3915 LABEL 1,2; COMP 3916 VAR LCSP: CSP; P1,P2: CTAILP; LFSTOCC: LOCOFREF; COMP 3917 BEGIN LCSP := FSTCSP; COMP 3918 WHILE LCSP <> NIL DO COMP 3919 BEGIN P1 := LCSP^.CSTP; P2 := FCSTP; COMP 3920 WHILE (P1 <> NIL)AND (P2 <> NIL) DO COMP 3921 BEGIN IF P1^.CSVAL <> P2^.CSVAL THEN GOTO 1; COMP 3922 P1 := P1^.NXTCSP; P2 := P2^.NXTCSP COMP 3923 END; COMP 3924 IF P1 = P2 THEN GOTO 2; COMP 3925 1: LCSP := LCSP^.NXTCSP COMP 3926 END; COMP 3927 (*NEW ENTRY:*) COMP 3928 MNEW(LCSP); COMP 3929 WITH LCSP^ DO COMP 3930 BEGIN NXTCSP := FSTCSP; CSTP := FCSTP; CREF := NIL END; COMP 3931 FSTCSP := LCSP; COMP 3932 2: (* CHAIN OCCURRENCES: *) COMP 3933 LFSTOCC := LCSP^.CREF; LINKOCC(LFSTOCC); COMP 3934 LCSP^.CREF := LFSTOCC COMP 3935 END (*ENTERCST*) ; COMP 3936 COMP 3937 PROCEDURE SUBFILES(FSP : STP; FADDR : ADDRRANGE; COMP 3938 PROCEDURE PROCESSFILE(FSP : STP; FADDR : ADDRRANGE) ); COMP 3939 (* PROCESS (OPEN OR CLOSE) ALL FILES WHICH ARE PART OF A *) COMP 3940 (* VARIABLE WITH STRUCTURE FSP AND ADDRESS FADDR *) COMP 3941 VAR I,LMIN,LMAX : INTEGER; COMP 3942 COMP 3943 PROCEDURE RECFILES(FSP: STP); V41CC07 277 (* APPLY SUBFILES TO FIELDLIST FSP. *) V41CC07 278 VAR LSP: STP; LCP: CTP; V41CC07 279 BEGIN (* RECFILES *) V41CC07 280 IF FSP <> NIL THEN V41CC07 281 WITH FSP^ DO V41CC07 282 BEGIN LCP := FIXEDPART; LSP := VARPART END; V41CC07 283 WHILE LCP <> NIL DO V41CC07 284 WITH LCP^ DO (* KLASS = FIELD *) V41CC07 285 BEGIN SUBFILES(IDTYPE,FADDR+FLDADDR,PROCESSFILE); V41CC07 286 LCP := NEXT V41CC07 287 END; V41CC07 288 IF LSP <> NIL THEN V41CC07 289 BEGIN LSP := LSP^.VARIANTLIST; V41CC07 290 WHILE LSP <> NIL DO V41CC07 291 WITH LSP^ DO (* FORM = FIELDLISTS *) V41CC07 292 BEGIN V41CC07 293 IF FTYPE THEN RECFILES(LSP); V41CC07 294 LSP := NXTFLDLST V41CC07 295 END COMP 3959 END COMP 3960 END (* RECFILES *); COMP 3961 COMP 3962 BEGIN (* SUBFILES *) COMP 3963 IF FSP <> NIL THEN COMP 3964 WITH FSP^ DO COMP 3965 IF FTYPE THEN COMP 3966 CASE FORM OF COMP 3967 RECORDS : RECFILES(FIELDLST); V41CC07 296 ARRAYS : COMP 3969 IF INXTYPE <> NIL THEN COMP 3970 BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX); COMP 3971 FOR I := LMIN TO LMAX DO COMP 3972 BEGIN SUBFILES(AELTYPE,FADDR,PROCESSFILE); COMP 3973 IF AELTYPE <> NIL THEN COMP 3974 FADDR := FADDR + AELTYPE^.SIZE.WORDS COMP 3975 END COMP 3976 END; COMP 3977 FILES : COMP 3978 PROCESSFILE(FSP,FADDR) COMP 3979 END (* CASE *) COMP 3980 END (* SUBFILES *); COMP 3981 COMP 3982 PROCEDURE COMMISSIONFILES(FSP: STP; FDRCT: BOOLEAN; COMP 3983 FADDR: ADDRRANGE; FEX: EXTFILEP); COMP 3984 COMP 3985 PROCEDURE COMMISSIONFILEVAR(FSP: STP; FADDR: ADDRRANGE); COMP 3986 VAR LDISPCODE: INTEGER; LCSP: CTAILP; COMP 3987 LRL: ADDRRANGE; LBASE: REGNR; COMP 3988 BEGIN (* COMMISSIONFILEVAR *) COMP 3989 WITH FSP^ DO COMP 3990 BEGIN COMP 3991 LDISPCODE := ROTATE(ORD(TEXTFILE),ETEXT-EDISPC); V41CC04 12 LDISPCODE := ROTATE(ORD(SEGFILE),ESEGMENT-EDISPC) + LDISPCODE; V41CC04 13 IF FEX <> NIL THEN (* PROGRAM PARAMETER *) COMP 3993 WITH FEX^ DO COMP 3994 BEGIN COMP 3995 LDISPCODE := ROTATE(ORD(TERMINAL),ETERMFIL-EDISPC)+LDISPCODE; V41CC04 14 LDISPCODE := ROTATE(1,EPERSIST-EDISPC) + LDISPCODE; V41CC04 15 LDISPCODE := ROTATE(1,EPROGPAR-EDISPC) + LDISPCODE; V41CC04 16 SHORTNAME(FILENAME,ALFINT.A); COMP 3997 GEN30(SABPK,2,0,0,PROGR); (* FORMAL FILE NAME *) COMP 3998 MNEW(LCSP); COMP 3999 WITH LCSP^ DO COMP 4000 BEGIN NXTCSP := NIL; CSVAL := ALFINT.I END; COMP 4001 ENTERCST(LCSP); COMP 4002 GEN30(SABPK,5,0,SYSLOC,ABSR) (* ACTUAL FILE PARAM *) COMP 4003 END; COMP 4004 GEN30(SXBPK,1,0,LDISPCODE,ABSR); (* DISPOSITION CODE *) COMP 4005 FADDR := FADDR + EFETOFFSET[TEXTFILE]; V41CC04 17 IF FDRCT THEN LBASE := 5 ELSE LBASE := 2; COMP 4008 GENINC(SBBPK,3,LBASE,FADDR); (* EFET ADDRESS *) COMP 4009 GEN30(SBBPK,7,0,BSIZE,ABSR); (* BUFFER SIZE *) COMP 4010 IF FILTYPE <> NIL THEN COMP 4011 BEGIN COMP 4012 LRL := FULLWORDS(FILTYPE^.SIZE); COMP 4013 IF LRL = 0 THEN LRL := 1; COMP 4014 GENINC(SXBPK,6,0,LRL) COMP 4015 END; COMP 4016 RJTOEXT(EX[CFVEX]) COMP 4017 END COMP 4018 END (* COMMISSIONFILEVAR *) ; COMP 4019 COMP 4020 BEGIN (* COMMISSIONFILES *) COMP 4021 IF NOT FDRCT THEN GEN15(SBXPB,2,6,0); COMP 4022 SUBFILES(FSP,FADDR,COMMISSIONFILEVAR) COMP 4023 END (* COMMISSIONFILES *) ; COMP 4024 COMP 4025 PROCEDURE DECOMMISSIONFILES(FSP: STP; FDRCT: BOOLEAN; COMP 4026 FADDR: ADDRRANGE); COMP 4027 COMP 4028 PROCEDURE DECOMMISSIONFILEVAR(FSP: STP; FADDR: ADDRRANGE); COMP 4029 VAR LBASE: REGNR; COMP 4030 BEGIN (* DECOMMISSIONFILEVAR *) COMP 4031 FADDR := FADDR + EFETOFFSET[FSP^.TEXTFILE]; V41CC04 18 IF FDRCT THEN LBASE := 5 ELSE LBASE := 2; COMP 4035 GENINC(SABPK,1,LBASE,FADDR); COMP 4036 RJTOEXT(EX[DFVEX]) COMP 4037 END (* DECOMMISSIONFILEVAR *) ; COMP 4038 COMP 4039 BEGIN (* DECOMMISSIONFILES *) COMP 4040 SUBFILES(FSP,FADDR,DECOMMISSIONFILEVAR) COMP 4041 END (* DECOMMISSIONFILES *) ; COMP 4042 COMP 4043 PROCEDURE UNROTATEX(FI: REGNR); V41AC08 15 (*IF X-FI IS SHIFTED, SHIFT IT BACK*) COMP 4045 BEGIN COMP 4046 WITH XRGS[FI] DO COMP 4047 IF XCONT IN [SIMPVAR,INDVAR] THEN COMP 4048 IF SHFTCNT <> 0 THEN COMP 4049 BEGIN GEN15(LXJK,FI,0,WORDSIZE-SHFTCNT); SHFTCNT := 0 COMP 4050 END COMP 4051 END (*UNROTATEX*); V41AC08 16 COMP 4053 PROCEDURE DECREFX(FI: REGNR); COMP 4054 (*DECREASE NUMBER OF REFERENCES TO X-FI BY ONE*) COMP 4055 BEGIN COMP 4056 WITH XRGS[FI] DO COMP 4057 IF XCONT <> AVAIL THEN COMP 4058 IF REFNR > 0 THEN COMP 4059 BEGIN REFNR := REFNR - 1; COMP 4060 IF REFNR = 0 THEN COMP 4061 IF XCONT = OTHER THEN XCONT := AVAIL COMP 4062 ELSE LASTREF := IC COMP 4063 END COMP 4064 END (*DECREFX*) ; COMP 4065 COMP 4066 PROCEDURE CLEARINDVARREFS(FREGS: REGSET); COMP 4067 (* FIND EACH INDVAR IN XRGS THAT REFERS (VIA XREG) TO A COMP 4068 REGISTER IN FREGS, AND DEMOTE IT TO AVAIL OR OTHER. *) COMP 4069 VAR I: REGNR; COMP 4070 BEGIN (* CLEARINDVARREFS *) COMP 4071 FOR I := 7 DOWNTO 0 DO COMP 4072 WITH XRGS[I] DO COMP 4073 IF XCONT = INDVAR THEN COMP 4074 IF XREG IN FREGS THEN COMP 4075 BEGIN COMP 4076 DECREFX(XREG); COMP 4077 IF REFNR = 0 THEN XCONT := AVAIL COMP 4078 ELSE COMP 4079 BEGIN COMP 4080 IF SHFTCNT <> 0 THEN GEN15(LXJK,I,0,WORDSIZE-SHFTCNT); COMP 4081 XCONT := OTHER COMP 4082 END COMP 4083 END COMP 4084 END (* CLEARINDVARREFS *) ; COMP 4085 COMP 4086 PROCEDURE CLEARINDADDRREFS(FI: REGNR); COMP 4087 (* FIND EACH INDADDR IN ARGS THAT REFERS (VIA AREG) TO COMP 4088 REGISTER FI, AND DEMOTE IT TO UNSPECADDR. *) COMP 4089 VAR I: REGNR; COMP 4090 BEGIN (* CLEARINDADDRREFS *) COMP 4091 FOR I := 7 DOWNTO 1 DO COMP 4092 WITH ARGS[I] DO COMP 4093 IF ACONT = INDADDR THEN COMP 4094 IF AREG = FI THEN ACONT := UNSPECADDR COMP 4095 END (* CLEARINDADDRREFS *) ; COMP 4096 COMP 4097 PROCEDURE BXIXJ(FI,FJ: REGNR); COMP 4098 (*AVOID GENERATION OF B XI XJ INSTRUCTIONS WHENEVER APPROPRIATE BY COMP 4099 ALTERING PREVIOUSLY GENERATED INSTRUCTION*) COMP 4100 VAR I: REGNR; COMP 4101 BEGIN COMP 4102 IF FI <> FJ THEN COMP 4103 BEGIN COMP 4104 WITH XRGS[FI] DO COMP 4105 IF XCONT = INDVAR THEN DECREFX(XREG) COMP 4106 ELSE BEGIN CLEARINDVARREFS([FI]); CLEARINDADDRREFS(FI) END; COMP 4107 XRGS[FI] := XRGS[FJ]; COMP 4108 IF (LASTI = FJ) AND COMP 4109 ((LASTOP IN [BXX..BXXMCX,LXBX..RXXDX,CXX]) OR COMP 4110 (LASTOP >= SXAPK)) AND COMP 4111 (XRGS[FJ].REFNR <= 1) THEN COMP 4112 BEGIN COMP 4113 IF (LASTOP < SXAPK) OR (LASTOP >= SXXPB) THEN COMP 4114 CBUF := CBUF - (LASTI - FI)*100B COMP 4115 ELSE COMP 4116 CBUF := CBUF - (LASTI - FI)*10000B*1000B; COMP 4117 LASTI := FI; XRGS[FJ].XCONT := AVAIL COMP 4118 END COMP 4119 ELSE COMP 4120 BEGIN GEN15(BXX,FI,FJ,FJ); DECREFX(FJ); XRGS[FI].REFNR := 1; COMP 4121 WITH XRGS[FJ] DO COMP 4122 IF XCONT = INDVAR THEN COMP 4123 WITH XRGS[XREG] DO REFNR := REFNR + 1 COMP 4124 END COMP 4125 END COMP 4126 END (*BXIXJ*) ; COMP 4127 COMP 4128 PROCEDURE SAVEREFXRGS(VAR FXRGS: XRGSTATUS); COMP 4129 VAR I,J,K: REGNR; LXRGS: XRGSTATUS; COMP 4130 BEGIN LXRGS:=XRGS; CLEARREGS; COMP 4131 FOR I:=0 TO 7 DO COMP 4132 WITH LXRGS[I] DO COMP 4133 IF XCONT <> AVAIL THEN COMP 4134 IF XCONT = INDVAR THEN COMP 4135 BEGIN WITH LXRGS[XREG] DO COMP 4136 BEGIN REFNR:=REFNR - 1; COMP 4137 IF REFNR = 0 THEN XCONT:=AVAIL COMP 4138 END; COMP 4139 IF REFNR = 0 THEN XCONT:=AVAIL ELSE XCONT:=OTHER COMP 4140 END COMP 4141 ELSE IF REFNR = 0 THEN XCONT:=AVAIL; COMP 4142 K:=0; COMP 4143 FOR I:=6 TO 7 DO COMP 4144 WITH LXRGS[I] DO COMP 4145 IF XCONT <> AVAIL THEN COMP 4146 BEGIN COMP 4147 IF K=0 THEN GENINC(SABPK,I,5,LC) COMP 4148 ELSE GEN15(SAAPB,7,6,1); COMP 4149 K:=K+1; J:=I COMP 4150 END; COMP 4151 FOR I:=0 TO 5 DO COMP 4152 WITH LXRGS[I] DO COMP 4153 IF XCONT <> AVAIL THEN COMP 4154 BEGIN GEN15(BXX,7,I,I); COMP 4155 IF K=0 THEN GENINC(SABPK,7,5,LC) COMP 4156 ELSE GEN15(SAAPB,7,J,1); COMP 4157 K:=K+1; J:=7 COMP 4158 END; COMP 4159 LC := LC + K; COMP 4160 IF LC > LCMAX THEN LCMAX := LC; COMP 4161 FXRGS := LXRGS COMP 4162 END (*SAVEREFXRGS*) ; COMP 4163 COMP 4164 PROCEDURE RELOADREFXRGS(VAR FXRGS: XRGSTATUS); COMP 4165 VAR I,J,K,L,M: REGNR; LPL: PLACE; COMP 4166 BEGIN K := 0; M := 0; COMP 4167 FOR I := 0 TO 7 DO COMP 4168 BEGIN J := (I+6) MOD 8; COMP 4169 WITH FXRGS[J] DO COMP 4170 IF XCONT <> AVAIL THEN COMP 4171 IF REFNR <> 0 THEN COMP 4172 BEGIN IF I <= 2 THEN L := 5 ELSE L := J; COMP 4173 IF K = 0 THEN COMP 4174 BEGIN GEN30(SABPK,L,5,0,ABSR); LPL := PC; COMP 4175 END COMP 4176 ELSE GEN15(SAAPB,L,K,1); COMP 4177 IF I <= 2 THEN GEN15(BXX,J,5,5); COMP 4178 XRGS[J] := FXRGS[J]; COMP 4179 K := L; M := M + 1 COMP 4180 END COMP 4181 END; COMP 4182 IF M <> 0 THEN COMP 4183 BEGIN LC := LC - M; INS(LC,LPL) END; COMP 4184 END (*RELOADXRGS*) ; COMP 4185 COMP 4186 PROCEDURE NEEDB(VAR FI: REGNR); COMP 4187 (*RETURN INDEX OF AVAILABLE B-REGISTER*) COMP 4188 VAR I: REGNR; COMP 4189 BEGIN COMP 4190 I := 7; COMP 4191 WHILE NOT (I IN BRGS) DO I := PRED(I); COMP 4192 FI := I; COMP 4193 IF I = 0 THEN ERROR(259) ELSE BRGS := BRGS - [I] COMP 4194 END (*NEEDB*) ; COMP 4195 COMP 4196 PROCEDURE FREEB(FR: REGNR); COMP 4197 BEGIN COMP 4198 BRGS := BRGS + [FR] COMP 4199 END (* FREEB *) ; COMP 4200 COMP 4201 PROCEDURE NEEDX(FREGS: REGSET; VAR FI: REGNR); COMP 4202 (* RETURN INDEX FI (FI IN FREGS) OF AVAILABLE X-REGISTER; COMP 4203 DON'T TOUCH ANY X-REG. CONTENTS*) COMP 4204 (* IT IS ASSUMED THAT FREGS IS A SET OF THE FORM [FLOW..FHIGH]. COMP 4205 IF THIS IS NOT TRUE, THE FOLLOWING CODE DOES NOT WORK. *) COMP 4206 LABEL 1; COMP 4207 VAR I,NR: REGNR; PR,MAXPR: INTEGER; FIRSTTIME: BOOLEAN; COMP 4208 FLOW,FHIGH: REGNR; COMP 4209 BEGIN MAXPR := 0; FIRSTTIME := TRUE; COMP 4210 FLOW := 0; COMP 4211 WHILE NOT (FLOW IN FREGS) DO FLOW := FLOW + 1; COMP 4212 FHIGH := FLOW + CARD(FREGS) - 1; COMP 4213 NR := FHIGH; COMP 4214 REPEAT COMP 4215 FOR I := FLOW TO FHIGH DO COMP 4216 WITH XRGS[I] DO COMP 4217 IF XCONT = AVAIL THEN COMP 4218 BEGIN NR := I; GOTO 1 END COMP 4219 ELSE COMP 4220 IF XCONT <> OTHER THEN COMP 4221 IF REFNR = 0 THEN COMP 4222 BEGIN PR := IC - LASTREF + BONUS[XCONT]; COMP 4223 IF PR > MAXPR THEN COMP 4224 BEGIN MAXPR := PR; NR := I END COMP 4225 END; COMP 4226 IF MAXPR = 0 THEN COMP 4227 IF FIRSTTIME THEN COMP 4228 BEGIN CLEARINDVARREFS(FREGS); FIRSTTIME := FALSE END COMP 4229 ELSE COMP 4230 BEGIN IF FLOW <> FHIGH THEN ERROR(259); MAXPR := 1 END COMP 4231 UNTIL MAXPR > 0; COMP 4232 1:WITH XRGS[NR] DO COMP 4233 BEGIN COMP 4234 IF XCONT = INDVAR THEN DECREFX(XREG) COMP 4235 ELSE CLEARINDADDRREFS(NR); COMP 4236 XCONT := OTHER; REFNR := 1 COMP 4237 END; COMP 4238 FI := NR COMP 4239 END (*NEEDX*) ; COMP 4240 V41AC08 17 PROCEDURE GENROTATE(FX1, FX2: REGNR; SC: SHIFTRANGE); V41AC08 18 (* ROTATE LEFT (SC MOD 60) BITS FROM FX2 INTO FX1. *) V41AC08 19 BEGIN V41AC08 20 IF SC < 0 THEN SC := SC + WORDSIZE; V41AC08 21 IF SC <> 0 THEN V41AC08 22 IF SC <> 1 THEN V41AC08 23 BEGIN V41AC08 24 IF FX1 <> FX2 THEN GEN15(BXX,FX1,FX2,FX2); V41AC08 25 GEN15(LXJK,FX1,0,SC) V41AC08 26 END V41AC08 27 ELSE GEN15(LXBX,FX1,1,FX2) V41AC08 28 END (* GENROTATE *) ; V41AC08 29 V41AC08 30 PROCEDURE ROTATEX(VAR FX1: REGNR; FX2: REGNR; SC: SHIFTRANGE); V41AC08 31 (* ROTATE THE CONTENTS OF X.FX2 LEFT (SC MOD 60) BITS, *) V41AC08 32 (* PUTTING THE RESULT INTO FX1. *) V41AC08 33 BEGIN V41AC08 34 IF SC = 0 THEN FX1 := FX2 V41AC08 35 ELSE V41AC08 36 BEGIN DECREFX(FX2); NEEDX([0..7],FX1); V41AC08 37 GENROTATE(FX1,FX2,SC) V41AC08 38 END V41AC08 39 END (* ROTATEX *) ; V41AC08 40 COMP 4241 PROCEDURE MAKEVARBLATTR(VAR FATTR: ATTR; COMP 4242 FSP: STP; FLEV: LEVRANGE; FDISPL: ADDRRANGE); COMP 4243 VAR LATTR: ATTR; COMP 4244 BEGIN COMP 4245 WITH LATTR DO COMP 4246 BEGIN COMP 4247 TYPTR := FSP; KIND := VARBL; WORDACC := DRCT; TAGF := FALSE; COMP 4248 VLEVEL := FLEV; CWDISPL := FDISPL; VWDISPL := 0; COMP 4249 DCLPCKD := FALSE; PCKD := FALSE COMP 4250 END; COMP 4251 FATTR := LATTR COMP 4252 END (* MAKEVARBLATTR *) ; COMP 4253 COMP 4254 PROCEDURE MAKETEMP(VAR FATTR: ATTR; FSP: STP; FSIZE: ADDRRANGE); COMP 4255 BEGIN COMP 4256 MAKEVARBLATTR(FATTR,FSP,LEVEL,LC); COMP 4257 LC := LC + FSIZE; COMP 4258 IF LC > LCMAX THEN LCMAX := LC COMP 4259 END (* MAKETEMP *) ; COMP 4260 COMP 4261 PROCEDURE SETADDRESS( COMP 4262 VAR FATTR: ATTR; (* DESCRIBING THE ADDRESS *) COMP 4263 FSIMPIND: BOOLEAN; (* TRUE IF FATTR DESCRIBES AN INDIRECT VARIABLE COMP 4264 AND X.VWDISPL CONTAINS A SIMPLE VARIABLE AND COMP 4265 THIS CALL REPRESENTS A MEMORY REFERENCE *) COMP 4266 FR: REGTYPE; (* SELECTING A- OR X-REGISTER *) COMP 4267 FREGS: REGSET; (* SELECTING ACCEPTABLE REGISTER NUMBERS *) COMP 4268 VAR FI: REGNR); (* RESULT REGISTER NUMBER *) COMP 4269 (* SET ADDRESS OF FATTR INTO AN A-REGISTER OR X-REGISTER. COMP 4270 IF FREGS <> [], IT DEFINES THE SET OF ACCEPTABLE REGISTER COMP 4271 NUMBERS. IN THIS CASE, A NEEDX(FREGS,FI) IS DONE. COMP 4272 IF FREGS = [], WE ASSUME THAT THE REGISTER HAS ALREADY BEEN COMP 4273 ALLOCATED AND FI CONTAINS THE REGISTER NUMBER. COMP 4274 IF THE CALL TO SETADDRESS REPRESENTS A MEMORY REFERENCE COMP 4275 (FR = REGA), THE REGISTER MAP IS UPDATED TO REFLECT THE CHANGE COMP 4276 IN A-REGISTER VALUE. FOR REFERENCES TO AN COMP 4277 INDIRECT OR INDEXED VALUE (WORDACC IN [INDRCT,INXD]), THE COMP 4278 NUMBER OF REFERENCES TO THE X-REGISTER WHICH CONTAINS THE COMP 4279 BASE ADDRESS (VWDISPL) MAY BE DECREMENTED UNLESS IT IS COMP 4280 A STORING OPERATION (FI IN [6..7]). THE VALUE OF COMP 4281 FSIMPIND IS ONLY RELEVANT FOR A STORING OPERATION. IN ALL COMP 4282 CASES THE UPDATING OF FATTR AND THE X-REGISTER MAP IS LEFT COMP 4283 UP TO THE PROCEDURE WHICH CALLED SETADDRESS. COMP 4284 *) COMP 4285 LABEL 1; COMP 4286 VAR I,J,L,LAREG: REGNR; COMP 4287 LADDR: INTEGER; COMP 4288 NOTSTORING: BOOLEAN; COMP 4289 COMP 4290 PROCEDURE FINDAREG(FCONT: ARGSTR); COMP 4291 VAR I: REGNR; D: SHRTINT; COMP 4292 BEGIN (* FINDAREG *) COMP 4293 LAREG := 0; COMP 4294 LADDR := MAXADDR; COMP 4295 WITH FATTR DO COMP 4296 FOR I := 1 TO 7 DO COMP 4297 WITH ARGS[I] DO COMP 4298 IF ACONT = FCONT THEN COMP 4299 BEGIN COMP 4300 D := MAXADDR; COMP 4301 IF FCONT = SIMPADDR THEN COMP 4302 BEGIN COMP 4303 IF ALEV = VLEVEL THEN D := CWDISPL - ADISPL COMP 4304 END COMP 4305 ELSE COMP 4306 IF AREG = VWDISPL THEN D := CWDISPL - ADISPL; COMP 4307 IF ABS(D) < ABS(LADDR) THEN COMP 4308 BEGIN LADDR := D; LAREG := I END COMP 4309 END COMP 4310 END (* FINDAREG *); COMP 4311 COMP 4312 PROCEDURE SETBASEADDRESS(FLEV: LEVRANGE; VAR FI: REGNR); COMP 4313 VAR LATTR: ATTR; COMP 4314 BEGIN COMP 4315 MAKEVARBLATTR(LATTR,NILPTR,FLEV+1,0); COMP 4316 SETADDRESS(LATTR,FALSE,REGA,[1..5],FI); COMP 4317 DECREFX(FI) COMP 4318 END (* SETBASEADDRESS *); COMP 4319 COMP 4320 PROCEDURE NEED; COMP 4321 BEGIN (* NEED *) COMP 4322 IF FREGS <> [] THEN NEEDX(FREGS,I) COMP 4323 ELSE I := FI COMP 4324 END (* NEED *); COMP 4325 COMP 4326 BEGIN (* SETADDRESS *) COMP 4327 NOTSTORING := TRUE; COMP 4328 IF FR = REGA THEN COMP 4329 IF FREGS = [] THEN NOTSTORING := FI IN [0..5] COMP 4330 ELSE NOTSTORING := FREGS <= [0..5]; COMP 4331 LAREG := 0; COMP 4332 WITH FATTR DO COMP 4333 IF TYPTR <> NIL THEN COMP 4334 CASE KIND OF COMP 4335 CST: COMP 4336 (* MUST BE A STRING CONSTANT *) COMP 4337 BEGIN NEED; GEN30(SETINST[BPK,FR],I,0,0,PROGR); COMP 4338 IF FR = REGA THEN ARGS[I].ACONT := UNSPECADDR; COMP 4339 IF STRING(TYPTR) THEN ENTERCST(CVAL.VALP) COMP 4340 END; COMP 4341 VARBL: COMP 4342 CASE WORDACC OF COMP 4343 DRCT: COMP 4344 BEGIN COMP 4345 FINDAREG(SIMPADDR); COMP 4346 IF ABS(LADDR) <= 1 THEN COMP 4347 BEGIN NEED; COMP 4348 GENINC(SETINST[APK,FR],I,LAREG,LADDR) COMP 4349 END COMP 4350 ELSE COMP 4351 IF VLEVEL IN LEVELS THEN COMP 4352 BEGIN NEED; COMP 4353 GENINC(SETINST[BPK,FR],I,BRG[VLEVEL],CWDISPL) COMP 4354 END COMP 4355 ELSE COMP 4356 IF LAREG <> 0 THEN COMP 4357 BEGIN NEED; COMP 4358 GEN30(SETINST[APK,FR],I,LAREG,LADDR,ABSR) COMP 4359 END COMP 4360 ELSE COMP 4361 IF VLEVEL = 1 THEN COMP 4362 BEGIN NEED; COMP 4363 GEN30(SETINST[BPK,FR],I,0,CWDISPL,VARR) COMP 4364 END COMP 4365 ELSE COMP 4366 BEGIN COMP 4367 SETBASEADDRESS(VLEVEL,J); COMP 4368 NEED; COMP 4369 GENINC(SETINST[XPK,FR],I,J,CWDISPL) COMP 4370 END; COMP 4371 IF FR = REGA THEN COMP 4372 WITH ARGS[I] DO COMP 4373 BEGIN ACONT := SIMPADDR; ALEV := VLEVEL; COMP 4374 ADISPL := CWDISPL COMP 4375 END; COMP 4376 END (* DRCT *) ; COMP 4377 INDRCT: COMP 4378 BEGIN COMP 4379 IF NOTSTORING THEN COMP 4380 FSIMPIND := XRGS[VWDISPL].XCONT = SIMPVAR; COMP 4381 IF FSIMPIND THEN COMP 4382 BEGIN COMP 4383 IF FR = REGX THEN DECREFX(VWDISPL); COMP 4384 FINDAREG(INDADDR); COMP 4385 IF ABS(LADDR) <= 1 THEN COMP 4386 BEGIN NEED; COMP 4387 GENINC(SETINST[APK,FR],I,LAREG,LADDR); COMP 4388 GOTO 1 COMP 4389 END COMP 4390 END COMP 4391 ELSE COMP 4392 IF NOTSTORING THEN DECREFX(VWDISPL); COMP 4393 NEED; COMP 4394 GENINC(SETINST[XPK,FR],I,VWDISPL,CWDISPL); COMP 4395 1:IF FR = REGA THEN COMP 4396 IF FSIMPIND THEN COMP 4397 WITH ARGS[I] DO COMP 4398 BEGIN ACONT := INDADDR; COMP 4399 AREG := VWDISPL; ADISPL := CWDISPL COMP 4400 END COMP 4401 ELSE ARGS[I].ACONT := UNSPECADDR; COMP 4402 END (* INDRCT *) ; COMP 4403 INXD: COMP 4404 BEGIN COMP 4405 IF NOTSTORING THEN DECREFX(VWDISPL); COMP 4406 IF VLEVEL = 1 THEN COMP 4407 BEGIN NEED; COMP 4408 GEN30(SETINST[XPK,FR],I,VWDISPL,CWDISPL,VARR) COMP 4409 END COMP 4410 ELSE COMP 4411 IF VLEVEL IN LEVELS THEN COMP 4412 BEGIN NEEDX([0..7],J); DECREFX(J); NEED; COMP 4413 IF PC.CP = 3 THEN COMP 4414 BEGIN GEN15(SXXPB,J,VWDISPL,BRG[VLEVEL]); COMP 4415 GENINC(SETINST[XPK,FR],I,J,CWDISPL) COMP 4416 END COMP 4417 ELSE COMP 4418 BEGIN GENINC(SXXPK,J,VWDISPL,CWDISPL); COMP 4419 GEN15(SETINST[XPB,FR],I,J,BRG[VLEVEL]) COMP 4420 END COMP 4421 END COMP 4422 ELSE COMP 4423 BEGIN NEEDB(L); COMP 4424 FINDAREG(SIMPADDR); COMP 4425 IF LAREG <> 0 THEN COMP 4426 BEGIN NEED; COMP 4427 GENINC(SBAPK,L,LAREG,LADDR); COMP 4428 GEN15(SETINST[XPB,FR],I,VWDISPL,L) COMP 4429 END COMP 4430 ELSE COMP 4431 BEGIN GENINC(SBXPK,L,VWDISPL,CWDISPL); COMP 4432 SETBASEADDRESS(VLEVEL,J); NEED; COMP 4433 GEN15(SETINST[XPB,FR],I,J,L) COMP 4434 END; COMP 4435 FREEB(L) COMP 4436 END; COMP 4437 IF FR = REGA THEN ARGS[I].ACONT := UNSPECADDR COMP 4438 END (* INXD *) COMP 4439 END (* CASE WORDACC OF *) ; COMP 4440 COND,EXPR: COMP 4441 NEED COMP 4442 END (* CASE KIND OF *) COMP 4443 ELSE NEED; COMP 4444 FI := I COMP 4445 END (* SETADDRESS *); COMP 4446 COMP 4447 PROCEDURE LOADBASE(FLEV: LEVRANGE; VAR FI: REGNR); COMP 4448 VAR LATTR: ATTR; COMP 4449 BEGIN COMP 4450 MAKEVARBLATTR(LATTR,NILPTR,FLEV,0); COMP 4451 SETADDRESS(LATTR,FALSE,REGX,[1..5],FI) COMP 4452 END (* LOADBASE *); COMP 4453 COMP 4454 PROCEDURE LOADADDRESS(VAR FATTR: ATTR; VAR FI: REGNR); COMP 4455 (*LOAD WORD-ADDRESS OF FATTR INTO X-FI*) COMP 4456 BEGIN COMP 4457 WITH FATTR DO COMP 4458 IF KIND = VARBL THEN COMP 4459 IF (WORDACC = INDRCT) AND (CWDISPL = 0) THEN FI := VWDISPL COMP 4460 ELSE COMP 4461 BEGIN SETADDRESS(FATTR,FALSE,REGX,[0..7],FI); COMP 4462 WORDACC := INDRCT; VWDISPL := FI; CWDISPL := 0 COMP 4463 END COMP 4464 ELSE SETADDRESS(FATTR,FALSE,REGX,[0..7],FI) COMP 4465 END (*LOADADDRESS*) ; COMP 4466 COMP 4467 PROCEDURE LOAD(VAR FATTR: ATTR; VAR FI: REGNR); FORWARD; COMP 4468 COMP 4469 PROCEDURE LOADCST(FCST: INTEGER; VAR FI: REGNR); COMP 4470 (* LOAD FCST INTO X.FI *) COMP 4471 BEGIN (* LOADCST *) COMP 4472 WITH CATTR DO BEGIN KIND := CST; CVAL.IVAL := FCST END; COMP 4473 LOAD(CATTR,FI) COMP 4474 END (* LOADCST *); COMP 4475 COMP 4476 PROCEDURE LOADMSK(FBTS: BITRANGE; VAR FI: REGNR); COMP 4477 (* LOAD MASK OF FBTS BITS INTO X.FI *) COMP 4478 BEGIN LOADCST(MASK(FBTS),FI) END; COMP 4479 COMP 4480 PROCEDURE LOAD; COMP 4481 (*LOAD FATTR INTO X-FI*) COMP 4482 LABEL 1,4,6; COMP 4483 VAR I,J,K: REGNR; SHRT,SIMPIND: BOOLEAN; COMP 4484 BITSZ,SHIFT,MASK: BITRANGE; COMP 4485 SVAL: SHRTINT; CSHFT: INTEGER; LCSP: CTAILP; COMP 4486 LCST: INTEGER; LMODE: (USRADJ,SRADJ,USLADJ); COMP 4487 MSK,STR: BOOLEAN; MCST: INTEGER; COMP 4488 BEGIN COMP 4489 IF PMD = PMDON THEN CHECKLINENUM; COMP 4490 WITH FATTR DO COMP 4491 BEGIN COMP 4492 IF TYPTR <> NIL THEN COMP 4493 CASE KIND OF COMP 4494 CST: COMP 4495 BEGIN SHRT := FALSE; SVAL := 0; LCSP := NIL; COMP 4496 MSK := FALSE; COMP 4497 STR := STRING(TYPTR); COMP 4498 IF STR THEN LCSP := CVAL.VALP COMP 4499 ELSE COMP 4500 BEGIN LCST := CVAL.IVAL; (* INTERNAL VALUE OF CONSTANT *) COMP 4501 IF ABS(LCST) < TWOTO17 THEN COMP 4502 BEGIN SVAL := LCST; SHRT := TRUE END COMP 4503 ELSE COMP 4504 BEGIN MNEW(LCSP); COMP 4505 WITH LCSP^ DO COMP 4506 BEGIN NXTCSP := NIL; CSVAL := LCST END COMP 4507 END COMP 4508 END; COMP 4509 IF SHRT THEN COMP 4510 BEGIN COMP 4511 FOR I := 0 TO 7 DO COMP 4512 WITH XRGS[I] DO COMP 4513 IF XCONT = SHRTCST THEN COMP 4514 IF CSTVAL = SVAL THEN COMP 4515 BEGIN REFNR := REFNR + 1; GOTO 1 END COMP 4516 END COMP 4517 ELSE COMP 4518 FOR I := 0 TO 7 DO COMP 4519 WITH XRGS[I] DO COMP 4520 IF XCONT = LONGCST THEN COMP 4521 IF CPTR = LCSP THEN COMP 4522 BEGIN REFNR := REFNR + 1; GOTO 1 END; COMP 4523 IF NOT (STR OR (LCST IN [0,1,2])) THEN COMP 4524 BEGIN SHIFT := 0; MASK := 0; MCST := LCST; COMP 4525 WHILE NOT ODD(MCST) DO COMP 4526 BEGIN MCST := MCST DIV 2; SHIFT := SHIFT + 1 END; COMP 4527 REPEAT MCST := MCST DIV 2; SHIFT := SHIFT + 1; COMP 4528 MASK := MASK + 1 COMP 4529 UNTIL NOT ODD(MCST); COMP 4530 IF (MCST = 0) THEN (* MASK CONSTANT *) COMP 4531 BEGIN COMP 4532 IF LCST < 0 THEN COMP 4533 BEGIN SHIFT := SHIFT - MASK; MASK := WORDSIZE - MASK END; COMP 4534 (* DECIDE WHETHER TO USE MASK AND SHIFT *) COMP 4535 MSK := NOT SHRT OR (SHIFT = 0) OR (PC.CP = 3) COMP 4536 END COMP 4537 END; COMP 4538 IF MSK THEN COMP 4539 BEGIN NEEDX([0..7],I); COMP 4540 GEN15(MXJK,I,0,MASK); COMP 4541 IF SHIFT <> 0 THEN GEN15(LXJK,I,0,SHIFT) COMP 4542 END COMP 4543 ELSE COMP 4544 IF SHRT THEN COMP 4545 BEGIN NEEDX([0..7],I); COMP 4546 GENINC(SXBPK,I,0,SVAL) COMP 4547 END COMP 4548 ELSE COMP 4549 BEGIN NEEDX([1..5],I); COMP 4550 ARGS[I].ACONT := UNSPECADDR; COMP 4551 GEN30(SABPK,I,0,0,PROGR); COMP 4552 ENTERCST(LCSP) COMP 4553 END; COMP 4554 WITH XRGS[I] DO COMP 4555 BEGIN REFNR := 1; COMP 4556 IF SHRT THEN COMP 4557 BEGIN XCONT := SHRTCST; CSTVAL := SVAL END COMP 4558 ELSE BEGIN XCONT := LONGCST; CPTR := LCSP END COMP 4559 END; COMP 4560 1: END; COMP 4561 VARBL: COMP 4562 BEGIN COMP 4563 CASE WORDACC OF COMP 4564 DRCT: COMP 4565 BEGIN COMP 4566 FOR I := 0 TO 7 DO COMP 4567 WITH XRGS[I] DO COMP 4568 IF XCONT = SIMPVAR THEN COMP 4569 IF (XLEV = VLEVEL)AND (XADDR = CWDISPL) THEN COMP 4570 BEGIN REFNR := REFNR + 1; GOTO 4 END; COMP 4571 SETADDRESS(FATTR,FALSE,REGA,[1..5],I); COMP 4572 WITH XRGS[I] DO COMP 4573 BEGIN XCONT := SIMPVAR; REFNR := 1; VPADDR := FALSE; COMP 4574 SHFTCNT := 0; XLEV := VLEVEL; XADDR := CWDISPL COMP 4575 END; COMP 4576 4: END; COMP 4577 INDRCT: COMP 4578 BEGIN SIMPIND := XRGS[VWDISPL].XCONT = SIMPVAR; COMP 4579 IF SIMPIND THEN COMP 4580 FOR I := 0 TO 7 DO COMP 4581 WITH XRGS[I] DO COMP 4582 IF XCONT = INDVAR THEN COMP 4583 IF (XREG = VWDISPL) AND (XDISPL = CWDISPL) THEN COMP 4584 BEGIN REFNR := REFNR + 1; DECREFX(VWDISPL); COMP 4585 GOTO 6 COMP 4586 END; COMP 4587 SETADDRESS(FATTR,FALSE,REGA,[1..5],I); COMP 4588 IF SIMPIND THEN COMP 4589 WITH XRGS[I] DO COMP 4590 BEGIN XCONT := INDVAR; REFNR := 1; SHFTCNT := 0; COMP 4591 XREG := VWDISPL; XDISPL := CWDISPL COMP 4592 END; COMP 4593 6: END; COMP 4594 INXD: COMP 4595 SETADDRESS(FATTR,FALSE,REGA,[1..5],I) COMP 4596 END (*CASE*) ; COMP 4597 IF PCKD THEN COMP 4598 BEGIN COMP 4599 WITH TYPTR^ DO COMP 4600 BEGIN COMP 4601 IF FORM = SUBRANGE THEN COMP 4602 IF MIN.IVAL < 0 THEN LMODE := SRADJ COMP 4603 ELSE LMODE := USRADJ COMP 4604 ELSE COMP 4605 IF FORM IN [ARRAYS,RECORDS] THEN LMODE := USLADJ COMP 4606 ELSE LMODE := USRADJ; COMP 4607 BITSZ := SIZE.BITS COMP 4608 END; COMP 4609 WITH XRGS[I] DO COMP 4610 IF XCONT IN [SIMPVAR,INDVAR] THEN SHIFT := SHFTCNT COMP 4611 ELSE SHIFT := 0; COMP 4612 IF LMODE = USLADJ THEN MASK := BITSZ COMP 4613 ELSE MASK := WORDSIZE - BITSZ; COMP 4614 CSHFT := CBDISPL - SHIFT; COMP 4615 IF LMODE = USRADJ THEN CSHFT := CSHFT + BITSZ; COMP 4616 IF BITREG = XREG THEN COMP 4617 BEGIN COMP 4618 IF SHIFT <> 0 THEN (*TO GUARANTEE 0 <= B-K <= 60*) COMP 4619 BEGIN GEN15(LXJK,I,0,WORDSIZE-SHIFT); COMP 4620 XRGS[I].SHFTCNT := 0; CSHFT := CSHFT + SHIFT COMP 4621 END; COMP 4622 NEEDB(K); COMP 4623 GENINC(SBXPK,K,VBDISPL,CSHFT); COMP 4624 DECREFX(VBDISPL); DECREFX(I); COMP 4625 NEEDX([0..7],J); GEN15(LXBX,J,K,I); COMP 4626 FREEB(K); COMP 4627 IF LMODE = SRADJ THEN GEN15(AXJK,J,0,MASK) COMP 4628 ELSE COMP 4629 BEGIN LOADMSK(MASK,K); COMP 4630 IF LMODE = USRADJ THEN GEN15(BXXTCX,J,J,K) COMP 4631 ELSE GEN15(BXXTX,J,J,K); COMP 4632 DECREFX(K) COMP 4633 END; COMP 4634 I := J COMP 4635 END COMP 4636 ELSE COMP 4637 BEGIN IF CSHFT < 0 THEN CSHFT := CSHFT + WORDSIZE COMP 4638 ELSE COMP 4639 IF CSHFT = WORDSIZE THEN CSHFT := 0; COMP 4640 WITH XRGS[I] DO COMP 4641 IF XCONT IN [SIMPVAR,INDVAR] THEN COMP 4642 IF LMODE = SRADJ THEN COMP 4643 BEGIN NEEDX([0..7],J); DECREFX(I); COMP 4644 GEN15(BXX,J,I,I); I := J COMP 4645 END COMP 4646 ELSE COMP 4647 SHFTCNT := (SHFTCNT + CSHFT) MOD WORDSIZE; COMP 4648 IF CSHFT <> 0 THEN GEN15(LXJK,I,0,CSHFT); COMP 4649 IF LMODE = SRADJ THEN GEN15(AXJK,I,0,MASK) COMP 4650 ELSE COMP 4651 BEGIN LOADMSK(MASK,K); DECREFX(K); NEEDX([0..7],J); COMP 4652 IF LMODE = USRADJ THEN GEN15(BXXTCX,J,I,K) COMP 4653 ELSE GEN15(BXXTX,J,I,K); COMP 4654 DECREFX(I); I := J COMP 4655 END COMP 4656 END COMP 4657 END (*PCKD*) COMP 4658 ELSE IF LOADROTATEFLAG THEN UNROTATEX(I); V41AC08 41 END; COMP 4660 COND: COMP 4661 BEGIN NEEDX([0..7],I); COMP 4662 IF CONDCD IN [ZR,NZ] THEN COMP 4663 BEGIN LOADCST(0,K); GEN15(IXXMX,I,K,CDR); DECREFX(K); COMP 4664 IF CONDCD = ZR THEN GEN15(BXXMX,I,I,CDR) COMP 4665 ELSE GEN15(BXXMCX,I,I,CDR); COMP 4666 LOADMSK(59,K); GEN15(BXXTCX,I,I,K) COMP 4667 END COMP 4668 ELSE COMP 4669 BEGIN LOADMSK(1,K); COMP 4670 IF CONDCD = PL THEN GEN15(BXXTX,I,K,CDR) COMP 4671 ELSE GEN15(BXXTCX,I,K,CDR); COMP 4672 GEN15(LXJK,I,0,1) COMP 4673 END; COMP 4674 DECREFX(K); COMP 4675 DECREFX(CDR) COMP 4676 END; COMP 4677 EXPR: COMP 4678 I := EXPREG COMP 4679 END (*CASE*) COMP 4680 ELSE NEEDX([0..7],I); COMP 4681 KIND := EXPR; EXPREG := I COMP 4682 END (*WITH FATTR*) ; COMP 4683 FI := I COMP 4684 END (*LOAD*) ; COMP 4685 COMP 4686 PROCEDURE OPERATION(FOP: OPCODE; VAR FK: REGNR; FI,FJ: REGNR); COMP 4687 BEGIN DECREFX(FI); DECREFX(FJ); NEEDX([0..7],FK); GEN15(FOP,FK,FI,FJ) COMP 4688 END (* OPERATION *); COMP 4689 COMP 4690 PROCEDURE LOADDESC(VAR FATTR: ATTR; VAR FI: REGNR; FDISPL: SHRTINT); COMP 4691 (* LOAD THE DESCRIPTOR WORD FDISPL FOR NON-PARAMETRIC USE. *) COMP 4692 VAR LATTR: ATTR; COMP 4693 BEGIN COMP 4694 IF FATTR.TYPTR <> NIL THEN COMP 4695 MAKEVARBLATTR(LATTR,INTPTR,FATTR.VLEVEL, COMP 4696 FATTR.TYPTR^.DESCADDR+FDISPL) COMP 4697 ELSE LATTR.TYPTR := NIL; COMP 4698 LOAD(LATTR,FI) COMP 4699 END (*LOADDESC*) ; COMP 4700 COMP 4701 PROCEDURE STORE(VAR FATTR: ATTR; FI: REGNR); COMP 4702 (*STORE X-FI AT FATTR*) COMP 4703 (*ASSUMES FATTR.KIND = VARBL*) COMP 4704 VAR I,J,K,LNR: REGNR; LATTR: ATTR; LXRG: XRGSTAT; COMP 4705 L: REGNR; OP1,OP2: OPCODE; TRUNCATE: BOOLEAN; COMP 4706 BITSZ,SHIFT,MASK: BITRANGE; CSHFT: INTEGER; LCST: SHRTINT; COMP 4707 LCP: POSRANGE; LADDR: INTEGER; LFTADJ,LBX,LXFICST: BOOLEAN; COMP 4708 LCLEARED : BOOLEAN; COMP 4709 COMP 4710 BEGIN COMP 4711 IF PMD = PMDON THEN CHECKLINENUM; COMP 4712 WITH FATTR DO COMP 4713 IF TYPTR <> NIL THEN COMP 4714 BEGIN COMP 4715 IF PCKD THEN COMP 4716 BEGIN LATTR := FATTR; COMP 4717 IF WORDACC <> DRCT THEN COMP 4718 WITH XRGS[VWDISPL] DO REFNR := REFNR + 1; COMP 4719 LATTR.PCKD := FALSE; V41AC08 42 LOADROTATEFLAG := FALSE; LOAD(LATTR,I); V41AC08 43 LOADROTATEFLAG := TRUE; V41AC08 44 WITH TYPTR^ DO COMP 4721 BEGIN LFTADJ := FORM IN [ARRAYS,RECORDS]; COMP 4722 BITSZ := SIZE.BITS COMP 4723 END; COMP 4724 WITH XRGS[I] DO COMP 4725 IF XCONT IN [SIMPVAR,INDVAR] THEN SHIFT := SHFTCNT COMP 4726 ELSE SHIFT := 0; COMP 4727 IF LFTADJ THEN COMP 4728 BEGIN MASK := BITSZ; CSHFT := CBDISPL - SHIFT; COMP 4729 OP1 := BXXTCX; OP2 := BXXTX COMP 4730 END COMP 4731 ELSE COMP 4732 BEGIN MASK := WORDSIZE - BITSZ; COMP 4733 CSHFT := CBDISPL - SHIFT + BITSZ; COMP 4734 OP1 := BXXTX; OP2 := BXXTCX COMP 4735 END; COMP 4736 IF BITREG = XREG THEN COMP 4737 BEGIN COMP 4738 IF BITSZ < SHIFT THEN (*TO GUARANTEE 0 <= B-K <= 60*) COMP 4739 BEGIN GEN15(LXJK,I,0,WORDSIZE - SHIFT); COMP 4740 XRGS[I].SHFTCNT := 0; CSHFT := CSHFT + SHIFT COMP 4741 END; COMP 4742 NEEDB(K); COMP 4743 GENINC(SBXPK,K,VBDISPL,CSHFT); COMP 4744 DECREFX(VBDISPL); DECREFX(I); NEEDX([0..7],J); COMP 4745 GEN15(LXBX,J,K,I); COMP 4746 END COMP 4747 ELSE COMP 4748 BEGIN COMP 4749 IF CSHFT < 0 THEN CSHFT := CSHFT + WORDSIZE COMP 4750 ELSE IF CSHFT = WORDSIZE THEN CSHFT := 0; COMP 4751 IF CSHFT <> 0 THEN GEN15(LXJK,I,0,CSHFT); J := I; COMP 4752 WITH XRGS[I] DO COMP 4753 IF XCONT IN [SIMPVAR,INDVAR] THEN COMP 4754 BEGIN SHFTCNT := (SHFTCNT + CSHFT) MOD WORDSIZE; COMP 4755 CSHFT := 0 COMP 4756 END COMP 4757 END; COMP 4758 WITH TYPTR^ DO COMP 4759 IF FORM <= POINTER THEN COMP 4760 IF FORM = SUBRANGE THEN TRUNCATE := MIN.IVAL < 0 COMP 4761 ELSE TRUNCATE := FALSE COMP 4762 ELSE TRUNCATE := TRUE; COMP 4763 IF TRUNCATE THEN COMP 4764 WITH XRGS[FI] DO COMP 4765 IF XCONT = SHRTCST THEN TRUNCATE := CSTVAL < 0 COMP 4766 ELSE COMP 4767 IF XCONT = LONGCST THEN TRUNCATE := CPTR^.CSVAL < 0; COMP 4768 LOADMSK(MASK,L); DECREFX(L); COMP 4769 GEN15(OP1,J,J,L); COMP 4770 IF TRUNCATE THEN COMP 4771 BEGIN NEEDX([0..7],I); GEN15(OP2,I,FI,L); DECREFX(FI) END COMP 4772 ELSE I := FI; COMP 4773 GEN15(BXXPX,J,J,I); COMP 4774 IF BITREG = XREG THEN COMP 4775 BEGIN GEN30(SBBPK,K,K,-WORDSIZE,ABSR); GEN15(AXBX,J,K,J); COMP 4776 FREEB(K) COMP 4777 END COMP 4778 ELSE IF CSHFT <> 0 THEN GEN15(LXJK,J,0,WORDSIZE-CSHFT); COMP 4779 DECREFX(I); FI := J COMP 4780 END (*PCKD*) ; COMP 4781 LCP := PC.CP; LNR := FI; COMP 4782 IF NOT (FI IN [6,7]) THEN COMP 4783 BEGIN NEEDX([6,7],I); BXIXJ(I,FI); COMP 4784 FI := I COMP 4785 END; COMP 4786 LBX := LCP <> PC.CP; COMP 4787 WITH XRGS[FI] DO COMP 4788 BEGIN LXFICST := XCONT = SHRTCST; COMP 4789 IF LXFICST THEN LCST := CSTVAL COMP 4790 ELSE UNROTATEX(FI); V41AC08 45 END; COMP 4792 CASE WORDACC OF COMP 4793 DRCT: COMP 4794 BEGIN LCLEARED := FALSE; COMP 4795 FOR I := 0 TO 7 DO COMP 4796 IF I <> FI THEN COMP 4797 WITH XRGS[I] DO COMP 4798 IF XCONT = SIMPVAR THEN COMP 4799 IF (XLEV = VLEVEL)AND (XADDR = CWDISPL) THEN COMP 4800 BEGIN XCONT := AVAIL; LCLEARED := TRUE END; COMP 4801 IF LCLEARED THEN COMP 4802 BEGIN COMP 4803 FOR I := 0 TO 7 DO COMP 4804 WITH XRGS[I] DO COMP 4805 IF XCONT = INDVAR THEN COMP 4806 IF XRGS[XREG].XCONT = AVAIL THEN XCONT := AVAIL; COMP 4807 FOR I := 1 TO 7 DO COMP 4808 WITH ARGS[I] DO COMP 4809 IF ACONT = INDADDR THEN COMP 4810 IF XRGS[AREG].XCONT = AVAIL THEN COMP 4811 ACONT := UNSPECADDR COMP 4812 END; COMP 4813 WITH LXRG DO COMP 4814 BEGIN XCONT := SIMPVAR; REFNR := 1; VPADDR := FALSE; COMP 4815 XLEV := VLEVEL; XADDR := CWDISPL; SHFTCNT := 0 COMP 4816 END COMP 4817 END; COMP 4818 INDRCT: COMP 4819 BEGIN COMP 4820 FOR I := 0 TO 7 DO COMP 4821 IF I <> FI THEN COMP 4822 WITH XRGS[I] DO COMP 4823 IF XCONT = INDVAR THEN COMP 4824 IF (XREG = VWDISPL)AND (XDISPL = CWDISPL) THEN COMP 4825 BEGIN DECREFX(VWDISPL); XCONT := AVAIL END; COMP 4826 IF XRGS[VWDISPL].XCONT = SIMPVAR THEN COMP 4827 WITH LXRG DO COMP 4828 BEGIN XCONT := INDVAR; REFNR := 1; COMP 4829 XREG := VWDISPL; XDISPL := CWDISPL; SHFTCNT := 0 COMP 4830 END COMP 4831 ELSE COMP 4832 WITH LXRG DO COMP 4833 BEGIN XCONT := OTHER; REFNR := 1 END COMP 4834 END; COMP 4835 INXD: COMP 4836 WITH LXRG DO COMP 4837 BEGIN XCONT := OTHER; REFNR := 1 END COMP 4838 END (*CASE*); COMP 4839 IF WORDACC <> DRCT THEN DECREFX(VWDISPL); COMP 4840 IF LXRG.XCONT = OTHER THEN COMP 4841 BEGIN COMP 4842 IF NOT LXFICST AND LBX THEN COMP 4843 WITH XRGS[FI] DO COMP 4844 BEGIN IF XCONT = INDVAR THEN DECREFX(XREG); COMP 4845 XCONT := OTHER COMP 4846 END COMP 4847 END COMP 4848 ELSE COMP 4849 BEGIN IF LBX THEN K := LNR ELSE K := FI; COMP 4850 IF (LXRG.XCONT <> INDVAR) OR (LXRG.XREG <> K) THEN COMP 4851 BEGIN COMP 4852 WITH XRGS[K] DO COMP 4853 IF XCONT = INDVAR THEN DECREFX(XREG) COMP 4854 ELSE IF XCONT = SIMPVAR THEN COMP 4855 FOR I := 0 TO 7 DO COMP 4856 WITH XRGS[I] DO COMP 4857 IF XCONT = INDVAR THEN COMP 4858 IF XREG = K THEN COMP 4859 IF REFNR = 0 THEN XCONT := AVAIL COMP 4860 ELSE XCONT := OTHER; COMP 4861 IF K = LNR THEN COMP 4862 BEGIN LXRG.REFNR := XRGS[K].REFNR; COMP 4863 IF LXRG.REFNR = 0 THEN LXRG.LASTREF := IC COMP 4864 END; COMP 4865 XRGS[K] := LXRG; COMP 4866 IF LXRG.XCONT = INDVAR THEN COMP 4867 WITH XRGS[LXRG.XREG] DO REFNR := REFNR + 1; COMP 4868 END COMP 4869 END; COMP 4870 SETADDRESS(FATTR,LXRG.XCONT=INDVAR,REGA,[],FI); COMP 4871 IF VLEVEL > 0 THEN COMP 4872 (*UPDATE OF REGISTER CONTENTS:*) COMP 4873 IF WORDACC = DRCT THEN (*SIMPLE VAR HAS GOT NEW VALUE. DISPOSE*) COMP 4874 BEGIN (*X-REGS CONTAINING VAR PARAMS*) COMP 4875 FOR I := 0 TO 7 DO COMP 4876 IF I <> FI THEN COMP 4877 WITH XRGS[I] DO COMP 4878 IF XCONT = INDVAR THEN COMP 4879 IF XRGS[XREG].VPADDR THEN COMP 4880 IF XRGS[XREG].XLEV > VLEVEL THEN COMP 4881 BEGIN DECREFX(XREG); COMP 4882 IF REFNR > 0 THEN XCONT := OTHER ELSE XCONT := AVAIL COMP 4883 END COMP 4884 END COMP 4885 ELSE (*ASSUME COINCIDANCE. DISPOSE X-REGS NOT CONT. SIMPLE VARS*) COMP 4886 BEGIN COMP 4887 FOR I := 0 TO 7 DO COMP 4888 IF I <> FI THEN COMP 4889 WITH XRGS[I] DO COMP 4890 IF XCONT = INDVAR THEN COMP 4891 BEGIN DECREFX(XREG); COMP 4892 IF REFNR > 0 THEN XCONT := OTHER ELSE XCONT := AVAIL COMP 4893 END; COMP 4894 IF XRGS[VWDISPL].VPADDR THEN (*DISPOSE X-REGS CONTAINING*) COMP 4895 BEGIN (*SIMPLE VARS OF LEVEL < XLEV*) COMP 4896 FOR I := 0 TO 7 DO COMP 4897 IF I <> FI THEN COMP 4898 WITH XRGS[I] DO COMP 4899 IF XCONT = SIMPVAR THEN COMP 4900 IF XLEV < XRGS[VWDISPL].XLEV THEN COMP 4901 IF REFNR > 0 THEN XCONT := OTHER ELSE XCONT := AVAIL; COMP 4902 FOR I := 1 TO 7 DO COMP 4903 WITH ARGS[I] DO COMP 4904 IF ACONT = INDADDR THEN COMP 4905 IF XRGS[AREG].XCONT = AVAIL THEN COMP 4906 ACONT := UNSPECADDR COMP 4907 END COMP 4908 END; COMP 4909 END (*TYPTR <> NIL*); COMP 4910 DECREFX(FI) COMP 4911 END (*STORE*) ; COMP 4912 COMP 4913 PROCEDURE CHECKBNDS(FI: REGNR; FMIN,FMAX: INTEGER; FADDR: ADDRRANGE); COMP 4914 (*TEST X-FI AGAINST BOUNDS FMIN AND FMAX.IF OUT OF BOUNDS JUMP COMP 4915 TO FADDR*) COMP 4916 VAR I,J,K: REGNR; COMP 4917 BEGIN COMP 4918 IF FMIN <> 0 THEN COMP 4919 BEGIN LOADCST(FMIN,I); DECREFX(I); NEEDX([0..7],K); COMP 4920 GEN15(IXXMX,K,FI,I) COMP 4921 END; COMP 4922 LOADCST(FMAX,I); COMP 4923 DECREFX(I); NEEDX([0..7],J); GEN15(IXXMX,J,I,FI); COMP 4924 IF FMIN <> 0 THEN COMP 4925 BEGIN GEN15(BXXPX,J,J,K); DECREFX(K) END COMP 4926 ELSE GEN15(BXXPX,J,J,FI); COMP 4927 GEN30(TESTX,ORD(NG),J,FADDR,TERAR); DECREFX(J) COMP 4928 END (*CHECKBNDS*) ; COMP 4929 COMP 4930 PROCEDURE CHECKORDINAL(FSP: STP; VAR FI: REGNR; FERR: ERRINDEX); COMP 4931 VAR LMIN, LMAX: INTEGER; COMP 4932 BEGIN COMP 4933 GETBOUNDS(FSP,LMIN,LMAX); COMP 4934 IF GATTR.KIND = CST THEN COMP 4935 BEGIN COMP 4936 WITH GATTR.CVAL DO COMP 4937 IF (IVAL < LMIN) OR (IVAL > LMAX) THEN ERROR(FERR); COMP 4938 LOAD(GATTR,FI) COMP 4939 END COMP 4940 ELSE COMP 4941 BEGIN LOAD(GATTR,FI); COMP 4942 IF DEBUG THEN CHECKBNDS(FI,LMIN,LMAX,ASSERR) COMP 4943 END COMP 4944 END (* CHECKORDINAL *) ; COMP 4945 COMP 4946 PROCEDURE CHECKSET(FSP: STP; VAR FI: REGNR; FERR: ERRINDEX); COMP 4947 VAR LMIN, LMAX: INTEGER; J,K: REGNR; COMP 4948 BEGIN COMP 4949 GETBOUNDS(FSP^.ELSET,LMIN,LMAX); COMP 4950 IF (LMIN >= 0) AND (LMAX <= 58) THEN COMP 4951 IF GATTR.KIND = CST THEN COMP 4952 BEGIN COMP 4953 IF GATTR.CVAL.PVAL - [LMIN..LMAX] <> [] THEN ERROR(FERR); COMP 4954 LOAD(GATTR,FI) COMP 4955 END COMP 4956 ELSE COMP 4957 BEGIN LOAD(GATTR,FI); COMP 4958 IF DEBUG THEN COMP 4959 BEGIN LOADCST(ROTATE(MASK(59-LMAX-LMIN),LMIN),J); COMP 4960 DECREFX(J); NEEDX([0..7],K); GEN15(BXXTX,K,FI,J); COMP 4961 GEN30(TESTX,ORD(NZ),K,ASSERR,TERAR); DECREFX(K) COMP 4962 END COMP 4963 END COMP 4964 ELSE NEEDX([0..7],FI) COMP 4965 END (* CHECKSET *); COMP 4966 (*$L'STATEMENT PROCESSOR.' *) COMP 4967 COMP 4968 COMP 4969 PROCEDURE STATEMENT(FSYS: SETOFSYS; STMTSEQUENCE: BOOLEAN); COMP 4970 LABEL 1; COMP 4971 VAR LCP: CTP; LLP: LBP; LOCP: LOCOFREF; COMP 4972 LASTSY: SYMBOL; EXITLOOP: BOOLEAN; COMP 4973 COMP 4974 PROCEDURE THREATEN(FCP: CTP); COMP 4975 BEGIN COMP 4976 IF (FCP <> NIL) AND (FCP <> UVARPTR) THEN COMP 4977 IF FCP^.KLASS = VARS THEN COMP 4978 BEGIN IF FCP^.CONTROLVAR THEN ERROR(184); COMP 4979 IF FCP^.VLEV < LEVEL THEN COMP 4980 FCP^.THREAT := TRUE COMP 4981 END COMP 4982 END (* THREATEN *); COMP 4983 COMP 4984 PROCEDURE PACKOFL(FI: REGNR); COMP 4985 VAR K: REGNR; COMP 4986 BEGIN NEEDX([0..7],K); GEN15(BXX,K,FI,FI); COMP 4987 GEN15(AXJK,K,0,48); GEN30(TESTX,ORD(NZ),K,OVLERR,TERAR); DECREFX(K) COMP 4988 END (*PACKOFL*) ; COMP 4989 COMP 4990 PROCEDURE PACKANDNORM(VAR FI: REGNR); COMP 4991 VAR K: REGNR; COMP 4992 BEGIN IF DEBUG THEN PACKOFL(FI); DECREFX(FI); NEEDX([0..7],K); COMP 4993 GEN15(PXBX,K,0,FI); GEN15(NXBX,K,0,K); COMP 4994 FI := K COMP 4995 END (*PACKANDNORM*) ; COMP 4996 COMP 4997 PROCEDURE EXPREP(FVAL: INTEGER;VAR FREC: CSTREC); COMP 4998 (*RETURN EXPONENTIAL REPRESENTATION OF FVAL: COMP 4999 CKIND = PUREP IF FVAL = 2**EXP, COMP 5000 CKIND = POSP IF FVAL = 2**EXP1*(2**EXP2 + 1), COMP 5001 CKIND = NEGP IF FVAL = 2**EXP1*(2**EXP2 - 1), COMP 5002 CKIND = NOP ELSE.*) COMP 5003 VAR E1,E2: BITRANGE; COMP 5004 BEGIN COMP 5005 IF FVAL > 0 THEN COMP 5006 BEGIN E1 := 0; COMP 5007 WHILE NOT ODD(FVAL) DO COMP 5008 BEGIN FVAL := FVAL DIV 2; E1 := E1 + 1 END; COMP 5009 IF FVAL = 1 THEN COMP 5010 WITH FREC DO COMP 5011 BEGIN CKIND := PUREP; EXP := E1 END COMP 5012 ELSE COMP 5013 BEGIN FVAL := FVAL DIV 2; E2 := 1; COMP 5014 IF ODD(FVAL) THEN COMP 5015 BEGIN COMP 5016 REPEAT FVAL := FVAL DIV 2; E2 := E2 + 1 COMP 5017 UNTIL NOT ODD(FVAL); COMP 5018 IF FVAL > 0 THEN FREC.CKIND := NOP COMP 5019 ELSE COMP 5020 WITH FREC DO COMP 5021 BEGIN CKIND := NEGP; EXP1 := E1; EXP2 := E2 END COMP 5022 END COMP 5023 ELSE COMP 5024 BEGIN COMP 5025 REPEAT FVAL := FVAL DIV 2; E2 := E2 + 1 COMP 5026 UNTIL ODD(FVAL); COMP 5027 IF FVAL > 1 THEN FREC.CKIND := NOP COMP 5028 ELSE COMP 5029 WITH FREC DO COMP 5030 BEGIN CKIND := POSP; EXP1 := E1; EXP2 := E2 END COMP 5031 END COMP 5032 END COMP 5033 END COMP 5034 ELSE FREC.CKIND := NOP COMP 5035 END (*EXPREP*) ; COMP 5036 COMP 5037 PROCEDURE OPTMULT(FI: REGNR; FREC: CSTREC; FEQ: BOOLEAN; COMP 5038 VAR FK: REGNR); COMP 5039 (*GENERATE CODE FOR X-FK := X-FI*FREC. FEQ <=> FI=FK IS ALLOWED*) COMP 5040 VAR E: BITRANGE; I,K: REGNR; B: BOOLEAN; COMP 5041 BEGIN B := FALSE; COMP 5042 WITH FREC DO COMP 5043 BEGIN IF CKIND = PUREP THEN E := EXP ELSE E := EXP1; COMP 5044 IF E <> 0 THEN COMP 5045 IF E = 1 THEN COMP 5046 BEGIN NEEDX([0..7],K); GEN15(LXBX,K,1,FI); COMP 5047 IF FEQ OR (CKIND = PUREP) THEN DECREFX(FI) COMP 5048 ELSE COMP 5049 BEGIN B := TRUE; I := FI END; COMP 5050 FI := K COMP 5051 END COMP 5052 ELSE COMP 5053 IF FEQ AND (XRGS[FI].REFNR = 1) THEN (*DESTROY X-FI*) COMP 5054 BEGIN GEN15(LXJK,FI,0,E); COMP 5055 WITH XRGS[FI] DO COMP 5056 BEGIN IF XCONT = INDVAR THEN DECREFX(XREG); COMP 5057 XCONT := OTHER COMP 5058 END COMP 5059 END COMP 5060 ELSE (*COPY X-FI*) COMP 5061 BEGIN NEEDX([0..7],K); GEN15(BXX,K,FI,FI); COMP 5062 GEN15(LXJK,K,0,E); COMP 5063 IF FEQ OR (CKIND = PUREP) THEN DECREFX(FI) COMP 5064 ELSE COMP 5065 BEGIN B := TRUE; I := FI END; COMP 5066 FI := K COMP 5067 END; COMP 5068 IF CKIND <> PUREP THEN COMP 5069 BEGIN NEEDX([0..7],K); COMP 5070 IF B THEN DECREFX(I); COMP 5071 GEN15(BXX,K,FI,FI); GEN15(LXJK,K,0,EXP2); COMP 5072 IF CKIND = POSP THEN GEN15(IXXPX,K,K,FI) COMP 5073 ELSE GEN15(IXXMX,K,K,FI); COMP 5074 DECREFX(FI); FK := K COMP 5075 END COMP 5076 ELSE FK := FI COMP 5077 END COMP 5078 END (*OPTMULT*) ; COMP 5079 COMP 5080 PROCEDURE EXPRESSION(FSYS: SETOFSYS); FORWARD; COMP 5081 COMP 5082 PROCEDURE ASSIGNTO(VAR FATTR: ATTR); COMP 5083 VAR I,J,K,L,M: REGNR; FLOAT: BOOLEAN; COMP 5084 LWORDS: ADDRRANGE; COMP 5085 SIMPIND,LONG: BOOLEAN; COMP 5086 BEGIN COMP 5087 IF (FATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN COMP 5088 BEGIN COMP 5089 FLOAT := COMPTYPES(GATTR.TYPTR,INTPTR) AND COMP 5090 (FATTR.TYPTR = REALPTR); COMP 5091 IF COMPTYPES(FATTR.TYPTR,GATTR.TYPTR) OR FLOAT THEN COMP 5092 CASE FATTR.TYPTR^.FORM OF COMP 5093 SCALAR, COMP 5094 SUBRANGE, COMP 5095 REALS: COMP 5096 BEGIN COMP 5097 IF (FATTR.TYPTR = INTPTR) OR (FATTR.TYPTR = REALPTR) THEN COMP 5098 LOAD(GATTR,I) COMP 5099 ELSE CHECKORDINAL(FATTR.TYPTR,I,303); COMP 5100 IF FLOAT THEN PACKANDNORM(I); COMP 5101 STORE(FATTR,I) COMP 5102 END; COMP 5103 POINTER: COMP 5104 BEGIN LOAD(GATTR,I); COMP 5105 STORE(FATTR,I) COMP 5106 END; COMP 5107 POWER: COMP 5108 BEGIN COMP 5109 CHECKSET(FATTR.TYPTR,I,303); COMP 5110 STORE(FATTR,I) COMP 5111 END; COMP 5112 ARRAYS, COMP 5113 RECORDS: COMP 5114 IF FATTR.TYPTR^.FTYPE THEN ERROR(146) COMP 5115 ELSE COMP 5116 BEGIN COMP 5117 IF CONFORMARRAY(FATTR.TYPTR) THEN COMP 5118 BEGIN COMP 5119 IF NOT EMPTYCNF(FATTR.TYPTR) THEN COMP 5120 BEGIN LOADDESC(FATTR,I,0); COMP 5121 DECREFX(I); NEEDB(J); COMP 5122 GEN30(SBXPK,J,I,-1,ABSR); COMP 5123 LOADADDRESS(GATTR,I); COMP 5124 LOADADDRESS(FATTR,K); COMP 5125 NEEDX([1..5],L); NEEDX([6,7],M); COMP 5126 NOOP; COMP 5127 GEN15(SAXPB,L,I,J); GEN15(BXX,M,L,L); COMP 5128 GEN15(SAXPB,M,K,J); GEN15(SBBMB,J,J,1); COMP 5129 GEN30(GE,J,0,IC-1,PROGR); COMP 5130 (* TAKE THE EASY WAY OUT: *) COMP 5131 CLEARREGS COMP 5132 END COMP 5133 END COMP 5134 ELSE (* NOT CONFORMANT ARRAY PARAMETER *) COMP 5135 BEGIN LWORDS := FULLWORDS(FATTR.TYPTR^.SIZE); COMP 5136 IF LWORDS = 1 THEN COMP 5137 BEGIN LOAD(GATTR,I); STORE(FATTR,I) END COMP 5138 ELSE COMP 5139 IF LWORDS > 31 THEN COMP 5140 BEGIN BRGS := BRGS - [2]; (* RESERVE B2 *) COMP 5141 LOADADDRESS(FATTR,I); GEN15(SBXPB,2,I,0); COMP 5142 NEEDX([1],K); SETADDRESS(GATTR,FALSE,REGA,[],K); COMP 5143 GEN30(SBBPK,7,0,LWORDS,ABSR); RJTOEXT(EX[MVEEX]) COMP 5144 END COMP 5145 ELSE (* LWORDS <= 31 *) COMP 5146 IF LWORDS <> 0 THEN COMP 5147 BEGIN SETADDRESS(GATTR,FALSE,REGA,[1..5],I); COMP 5148 NEEDX([6,7],K); COMP 5149 GEN15(BXX,K,I,I); COMP 5150 LONG := LWORDS >= 4; COMP 5151 LWORDS := LWORDS - 1; (* COUNT FIRST WORD *) COMP 5152 IF LONG THEN COMP 5153 BEGIN NEEDX([0..7],J); GEN15(MXJK,J,0,LWORDS) END; COMP 5154 SIMPIND := FALSE; COMP 5155 IF FATTR.WORDACC = INDRCT THEN COMP 5156 SIMPIND := XRGS[FATTR.VWDISPL].XCONT = SIMPVAR; COMP 5157 SETADDRESS(FATTR,SIMPIND,REGA,[],K); COMP 5158 IF LONG THEN COMP 5159 BEGIN NOOP; COMP 5160 GEN15(SAAPB,I,I,1); GEN15(BXX,K,I,I); COMP 5161 GEN15(LXJK,J,0,1); GEN15(SAAPB,K,K,1); COMP 5162 GEN30(TESTX,ORD(NG),J,IC-1,PROGR); COMP 5163 DECREFX(J) COMP 5164 END COMP 5165 ELSE (* NOT LONG *) COMP 5166 FOR J := 1 TO LWORDS DO COMP 5167 BEGIN GEN15(SAAPB,I,I,1); GEN15(BXX,K,I,I); COMP 5168 GEN15(SAAPB,K,K,1) COMP 5169 END; COMP 5170 (* RATHER THAN ATTEMPTING TO DETERMINE WHICH REGISTER COMP 5171 DESCRIPTORS HAVE BEEN INVALIDATED BY THE STORE COMP 5172 OPERATION, WE SIMPLY CLEAR THE REGISTER MAP. *) COMP 5173 CLEARREGS COMP 5174 END (* LWORDS <= 31 *) COMP 5175 END COMP 5176 END; COMP 5177 FILES: ERROR(146) COMP 5178 END COMP 5179 ELSE ERROR(129) COMP 5180 END COMP 5181 END (* ASSIGNTO *); COMP 5182 COMP 5183 PROCEDURE CHECKPTRREF(FI: REGNR); COMP 5184 (* CHECK THAT THE EXTENDED ($T+) POINTER VALUE IN X.FI *) COMP 5185 (* IS VALID AND NON-NIL. *) COMP 5186 VAR J, K: REGNR; COMP 5187 BEGIN (* CHECKPTRREF *) COMP 5188 NEEDX([1..5],J); NEEDX([0..7],K); COMP 5189 GEN30(SABPK,J,0,MEMFL,TMEMR); COMP 5190 GEN30(SXXPK,K,FI,-1,ABSR); COMP 5191