(*$A+,U+,L'PASCAL-6000 LIBRARY ROUTINES'*) PASCLIB 2 PASCLIB 3 PASCLIB 4 PASCLIB 5 PASCLIB 6 (* LIBRARY FOR PASCAL-6000. PASCLIB 7 * PASCLIB 8 * THIS DECK CONTAINS THOSE LIBRARY ROUTINES WHICH ARE WRITTEN PASCLIB 9 * IN PASCAL (AS OPPOSED TO COMPASS). PROGRAM PASCLIB IS A PASCLIB 10 * DUMMY USED TO COMPILE THESE ROUTINES TO RELOCATABLE BINARY. PASCLIB 11 * PASCLIB 12 * THESE ROUTINES MAY BE USED FROM A PASCAL PROGRAM BY DECLARING PASCLIB 13 * THEM TO BE EXTERNAL (EXPLICITLY OR WITH AN INCLUDE PACKAGE). PASCLIB 14 * PASCLIB 15 * PASCLIB 16 * THE FOLLOWING LIBRARY ROUTINES RESIDE IN THIS DECK. PASCLIB 17 * PASCLIB 18 * TEN - RETURN POWER OF TEN. PASCLIB 19 * RND - ROUND NUMBER AFTER SCALING. PASCLIB 20 * SCL - SCALE NUMBER AND DETERMINE SIGN. PASCLIB 21 * PASCLIB 22 * RDI - READ INTEGER IN FREE FORMAT. PASCLIB 23 * RDR - READ REAL NUMBER IN FREE FORMAT. PASCLIB 24 * WRB - WRITE BOOLEAN. PASCLIB 25 * WRC - WRITE CHARACTER. PASCLIB 26 * WRE - WRITE REAL NUMBER IN EXPONENTIAL FORM. PASCLIB 27 * WRF - WRITE REAL NUMBER IN FIXED-POINT FORM. PASCLIB 28 * WRI - WRITE INTEGER. PASCLIB 29 * PASCLIB 30 * WRITEHEX - WRITE INTEGER IN HEXADECIMAL DIGITS. PASCLIB 31 * WRITEOCT - WRITE INTEGER IN OCTAL DIGITS. PASCLIB 32 * PASCLIB 33 * PASCPMD - POST-MORTEM DUMP DISPLAY. PASCLIB 34 *) PASCLIB 35 PASCLIB 36 PASCLIB 37 PASCLIB 38 HPASCLI 1 (* PASCAL-6000 MODIFICATION HISTORY. HPASCLI 2 * HPASCLI 3 * AVOID USE OF UNDEFINED VARIABLE IN PMD. V41EC05 6 * GENERALIZE PASCPMD; PREPARE FOR FULL-ASCII VERSION. V41CC10 562 *) HPASCLI 4 HPASCLI 5 HPASCLI 6 HPASCLI 7 PASCLIB 39 PROGRAM PASCLIB; PASCLIB 40 PASCLIB 41 PASCLIB 42 PASCLIB 43 PASCLIB 44 (*--- DEFAULT OPTIONS FOR THE LIBRARY ---*) PASCLIB 45 (*$E+ MEANINGFUL ENTRYPOINT NAMES *) PASCLIB 46 (*$P0 NO POST-MORTEM DUMP INFORMATION *) PASCLIB 47 (*$T- NO RUN TIME TESTS *) PASCLIB 48 (*$X4 PASS 4 PARAMETERS IN X-REGS *) PASCLIB 49 PASCLIB 50 PASCLIB 51 PASCLIB 52 PASCLIB 53 CONST (* ANCHOR LINE FOR NEW CONSTANTS *) PASCLIB 54 T29 = 4000000000B; (* 2**29 *) PASCLIB 55 T30 = 10000000000B; (* 2**30 *) PASCLIB 56 PASCLIB 57 PASCLIB 58 PASCLIB 59 PASCLIB 60 (* 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 PASCLIB 62 PASCLIB 63 PASCLIB 64 PASCLIB 65 TYPE (* ANCHOR LINE FOR NEW TYPES *) PASCLIB 66 PASCLIB 67 PASCLIB 68 POSINT = 0..323; (* POSITIVE EXPONENT RANGE *) PASCLIB 69 EXPINT = -293..323;(* EXPONENT RANGE *) PASCLIB 70 DOUBLE = RECORD UPPER: REAL; LOWER: REAL END; PASCLIB 71 PASCLIB 72 PASCLIB 73 (* THE FOLLOWING TYPES BELONG TO PMD *) PASCLIB 74 PASCLIB 75 OPCODE = 0..77B; PASCLIB 76 REGISTER = 0..7B; PASCLIB 77 BYTEFIELD = 0..7777B; PASCLIB 78 PARCELFIELD = 0..77777B; PASCLIB 79 ADDRESSFIELD = 0..777777B; PASCLIB 80 DISPLAYCHAR = DCMINCH..DCMAXCH; V41CC10 563 PASCLIB 81 PWORD = ^WORD; PASCLIB 82 WORDFORMAT = 1..18; V41CC10 564 WORD = RECORD CASE WORDFORMAT OF PASCLIB 84 1 : (I : INTEGER); PASCLIB 85 2 : (R : REAL); PASCLIB 86 3 : (A : ALFA); PASCLIB 87 4 : (B : BOOLEAN); PASCLIB 88 5 : (C : CHAR); PASCLIB 89 6 : (P : PWORD); PASCLIB 90 7 : (BIT : PACKED ARRAY[-59..0] OF BOOLEAN); PASCLIB 91 8 : (BYTE : PACKED ARRAY[0..4] OF BYTEFIELD); PASCLIB 92 9 : (PARCEL : PACKED ARRAY[0..3] OF PARCELFIELD); PASCLIB 93 10 : (ADDRESS : PACKED RECORD PASCLIB 94 PAD : 0..77B; PASCLIB 95 UPPER : ADDRESSFIELD; PASCLIB 96 MIDDLE : ADDRESSFIELD; PASCLIB 97 LOWER : ADDRESSFIELD PASCLIB 98 END); PASCLIB 99 11 : (HALF : PACKED RECORD PASCLIB 100 OP : OPCODE; PASCLIB 101 I : REGISTER; PASCLIB 102 J : REGISTER; PASCLIB 103 K : ADDRESSFIELD PASCLIB 104 END); PASCLIB 105 12 : (QUARTER : PACKED RECORD PASCLIB 106 OP : OPCODE; PASCLIB 107 I : REGISTER; PASCLIB 108 J : REGISTER; PASCLIB 109 K : REGISTER PASCLIB 110 END); PASCLIB 111 13 : (BLOCKHEADERWORD : PACKED RECORD PASCLIB 112 PG : BOOLEAN; PASCLIB 113 PH : BOOLEAN; PASCLIB 114 OTHER : 0..17777777777777777777B PASCLIB 115 END); PASCLIB 116 14: (PMDHEADER: PACKED RECORD PASCLIB 117 PP : BOOLEAN; PASCLIB 118 FB : BOOLEAN; PASCLIB 119 ZERO : 0..177B; PASCLIB 120 COUNT : 0..77B; PASCLIB 121 EPTIC : PARCELFIELD; PASCLIB 122 CSTIC : PARCELFIELD; PASCLIB 123 PMDIC : PARCELFIELD PASCLIB 124 END); PASCLIB 125 15 : (PMDVARDESCRIPTOR : PACKED RECORD PASCLIB 126 ZERO : 0..7777777777B; PASCLIB 127 VTYPE : BYTEFIELD; PASCLIB 128 VADDR : ADDRESSFIELD PASCLIB 129 END); PASCLIB 130 16 : (HEX : PACKED ARRAY [1 .. 15] OF 0..17B); PASCLIB 131 17 : (OCT : PACKED ARRAY [1 .. 20] OF 0..7B); V41CC10 565 18 : (DC : PACKED ARRAY [1 .. 10] OF DISPLAYCHAR); V41CC10 566 END; PASCLIB 133 PASCLIB 134 MEMORYARRAY = ARRAY[ADDRESSFIELD] OF WORD; PASCLIB 135 PASCLIB 136 PASCLIB 137 PASCLIB 138 PASCLIB 139 PASCLIB 140 PASCLIB 141 PASCLIB 142 (* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *) PASCLIB 143 PASCLIB 144 PASCLIB 145 PASCLIB 146 PASCLIB 147 (* --- UTILITY ROUTINES FOR PASCLIB --- *) PASCLIB 148 PASCLIB 149 PASCLIB 150 PASCLIB 151 (* BPV - CHECK FOR BAD POINTER VALUE. PASCLIB 152 * PASCLIB 153 * PARAM P - POINTER TO CHECK. PASCLIB 154 *) PASCLIB 155 PASCLIB 156 FUNCTION (*$E'P.BPV'*) BPV(P : PWORD) : BOOLEAN; EXTERN; PASCLIB 157 PASCLIB 158 PASCLIB 159 PASCLIB 160 PASCLIB 161 (* DOUBLE PRECISION ROUTINES. PASCLIB 162 * PASCLIB 163 * DADD - DOUBLE PRECISION ADD. PASCLIB 164 * DMUL - DOUBLE PRECISION MULTIPLY. PASCLIB 165 * DDIV - DOUBLE PRECISION DIVIDE. PASCLIB 166 * PASCLIB 167 * PARAM R - RESULT. PASCLIB 168 * A - LEFT OPERAND. PASCLIB 169 * B - RIGHT OPERAND. PASCLIB 170 *) PASCLIB 171 PASCLIB 172 PROCEDURE (*$E'P.DADD'*) DADD(VAR R:DOUBLE; A,B:DOUBLE); EXTERN; PASCLIB 173 PROCEDURE (*$E'P.DMUL'*) DMUL(VAR R:DOUBLE; A,B:DOUBLE); EXTERN; PASCLIB 174 PROCEDURE (*$E'P.DDIV'*) DDIV(VAR R:DOUBLE; A,B:DOUBLE); EXTERN; PASCLIB 175 PASCLIB 176 PASCLIB 177 PASCLIB 178 PASCLIB 179 (* IOE - ISSUE AN INPUT/OUTPUT ERROR. PASCLIB 180 * PASCLIB 181 * PARAM F - FILE WITH THE ERROR. PASCLIB 182 * N - ERROR NUMBER (SEE COMSPAS). PASCLIB 183 *) PASCLIB 184 PASCLIB 185 PROCEDURE (*$E'P.IOE'*) IOE( VAR F : TEXT; N : INTEGER ); EXTERN; PASCLIB 186 PASCLIB 187 PASCLIB 188 PASCLIB 189 PASCLIB 190 (* TEN - RETURN POWER OF TEN. PASCLIB 191 * PASCLIB 192 * RETURN AN INTEGER POWER OF TEN, IN THE RANGE 1..321. PASCLIB 193 * PASCLIB 194 * PARAM R - RESULT. PASCLIB 195 * X - POWER OF TEN. PASCLIB 196 *) PASCLIB 197 PASCLIB 198 PROCEDURE (*$E'P.TEN'*) TEN(VAR R: DOUBLE; X: POSINT); PASCLIB 199 VAR T1,T2: DOUBLE; PASCLIB 200 BEGIN (* TEN *) PASCLIB 201 T1.UPPER := 1.0; T1.LOWER := 0.0; PASCLIB 202 T2.UPPER := 10.0; T2.LOWER := 0.0; PASCLIB 203 REPEAT PASCLIB 204 IF ODD(X) THEN DMUL(T1,T1,T2); PASCLIB 205 X := X DIV 2; PASCLIB 206 IF X <> 0 THEN DMUL(T2,T2,T2) PASCLIB 207 UNTIL X = 0; PASCLIB 208 R := T1 PASCLIB 209 END (* TEN *); PASCLIB 210 PASCLIB 211 PASCLIB 212 PASCLIB 213 PASCLIB 214 (* RND - ROUND NUMBER AFTER SCALING. PASCLIB 215 * PASCLIB 216 * PARAM X - NUMBER TO ROUND. PASCLIB 217 * DIGIT - DIGIT POSITION TO ROUND. PASCLIB 218 * EXP - EXPONENT (SCALE FACTOR) IF RESCALING REQUIRED. PASCLIB 219 *) PASCLIB 220 PASCLIB 221 PROCEDURE (*$E'P.RND'*) RND(VAR X: DOUBLE; DIGIT: INTEGER; PASCLIB 222 VAR EXP: EXPINT); PASCLIB 223 VAR T,S: DOUBLE; PASCLIB 224 BEGIN (* RND *) PASCLIB 225 IF DIGIT IN [0..28] THEN PASCLIB 226 BEGIN T.UPPER := 5.0; T.LOWER := 0.0; PASCLIB 227 TEN(S,DIGIT); PASCLIB 228 DDIV(T,T,S); PASCLIB 229 DADD(X,X,T) PASCLIB 230 END; PASCLIB 231 IF X.UPPER >= 10.0 THEN PASCLIB 232 BEGIN T.UPPER := 10.0; T.LOWER := 0.0; PASCLIB 233 DDIV(X,X,T); PASCLIB 234 EXP := EXP + 1 PASCLIB 235 END PASCLIB 236 END (* RND *); PASCLIB 237 PASCLIB 238 PASCLIB 239 PASCLIB 240 PASCLIB 241 (* SCL - SCALE NUMBER AND DETERMINE SIGN. PASCLIB 242 * PASCLIB 243 * DETERMINE THE SIGN OF X, AND SCALE IT INTO THE RANGE PASCLIB 244 * 1.0 <= X < 10.0. PASCLIB 245 * PASCLIB 246 * PARAM X - NUMBER TO BE SCALED. PASCLIB 247 * SIGN - SIGN (' ' OR '-') OF X. PASCLIB 248 * EXP - EXPONENT (SCALE FACTOR) OF X. PASCLIB 249 *) PASCLIB 250 PASCLIB 251 PROCEDURE (*$E'P.SCL'*) SCL(VAR X: DOUBLE; VAR SIGN: CHAR; PASCLIB 252 VAR EXP: EXPINT); PASCLIB 253 VAR T,S: DOUBLE; PASCLIB 254 EXP2: INTEGER; PASCLIB 255 BEGIN (* SCL *) PASCLIB 256 IF X.UPPER < 0.0 THEN PASCLIB 257 BEGIN SIGN := '-'; X.UPPER := -X.UPPER; X.LOWER := -X.LOWER END PASCLIB 258 ELSE SIGN := ' '; PASCLIB 259 EXP2 := EXPO(X.UPPER); PASCLIB 260 IF EXP2 >= 0 THEN PASCLIB 261 BEGIN EXP := EXP2 * 77 DIV 256; PASCLIB 262 TEN(T,EXP); PASCLIB 263 DDIV(S,X,T); PASCLIB 264 IF S.UPPER >= 10.0 THEN PASCLIB 265 BEGIN EXP := EXP + 1; PASCLIB 266 TEN(T,EXP); PASCLIB 267 DDIV(S,X,T) PASCLIB 268 END PASCLIB 269 END PASCLIB 270 ELSE PASCLIB 271 BEGIN EXP := (EXP2 + 1) * 77 DIV 256 - 1; PASCLIB 272 TEN(T,-EXP); PASCLIB 273 DMUL(S,T,X); PASCLIB 274 IF S.UPPER < 1.0 THEN PASCLIB 275 BEGIN EXP := EXP - 1; PASCLIB 276 TEN(T,-EXP); PASCLIB 277 DMUL(S,T,X) PASCLIB 278 END PASCLIB 279 END; PASCLIB 280 X := S PASCLIB 281 END (* SCL *); PASCLIB 282 PASCLIB 283 PASCLIB 284 PASCLIB 285 PASCLIB 286 (* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *) PASCLIB 287 PASCLIB 288 PASCLIB 289 PASCLIB 290 PASCLIB 291 (* --- INPUT/OUTPUT ROUTINES --- *) PASCLIB 292 PASCLIB 293 PASCLIB 294 PASCLIB 295 PASCLIB 296 (*$X0 NO PARAMETERS PASSED IN X-REGS *) PASCLIB 297 PASCLIB 298 PASCLIB 299 PASCLIB 300 PASCLIB 301 (* --- RDI - READ INTEGERS IN FREE FORMAT. --- *) PASCLIB 302 (* J. STRAIT. 78/10/17. *) PASCLIB 303 PASCLIB 304 FUNCTION (*$E'P.RDI'*) RDI(VAR F: TEXT): INTEGER; PASCLIB 305 (* READ INTEGER NUMBER IN FREE FORMAT *) PASCLIB 306 VAR S: BOOLEAN; PASCLIB 307 T,UPPER,LOWER: INTEGER; PASCLIB 308 CH: CHAR; PASCLIB 309 BEGIN (* RDI *) PASCLIB 310 WHILE (F^ = ' ') AND NOT EOF(F) DO GET(F); PASCLIB 311 IF NOT EOF(F) THEN PASCLIB 312 BEGIN CH := F^; PASCLIB 313 IF CH IN ['-','+'] THEN PASCLIB 314 BEGIN S := CH = '-'; GET(F); CH := F^ END PASCLIB 315 ELSE S := FALSE; PASCLIB 316 UPPER := 0; LOWER := 0; PASCLIB 317 IF NOT (CH IN ['0'..'9']) THEN IOE(F,IOEE); PASCLIB 318 REPEAT LOWER := LOWER * 10 + ORD(CH) - ORD('0'); PASCLIB 319 T := LOWER DIV T30; PASCLIB 320 LOWER := LOWER - T * T30; PASCLIB 321 IF UPPER < T30 THEN UPPER := UPPER * 10 + T; PASCLIB 322 GET(F); CH := F^ PASCLIB 323 UNTIL NOT (CH IN ['0'..'9']); PASCLIB 324 IF UPPER >= T29 THEN IOE(F,IOEF); PASCLIB 325 T := UPPER * T30 + LOWER; PASCLIB 326 IF S THEN RDI := -T ELSE RDI := T PASCLIB 327 END PASCLIB 328 ELSE IOE(F,IOEB) PASCLIB 329 END (* RDI *); PASCLIB 330 PASCLIB 331 PASCLIB 332 PASCLIB 333 PASCLIB 334 (* --- RDR - READ REAL NUMBERS IN FREE FORMAT. --- *) PASCLIB 335 (* N. WIRTH / K. JENSEN / J. P. STRAIT. *) PASCLIB 336 PASCLIB 337 FUNCTION (*$E'P.RDR'*) RDR(VAR F: TEXT): REAL; PASCLIB 338 (* READ REAL NUMBERS IN FREE FORMAT *) PASCLIB 339 CONST LIM1 = 322; (* MAXIMUM EXPONENT *) PASCLIB 340 LIM2 = -292; (* MINIMUM EXPONENT *) PASCLIB 341 VAR CH: CHAR; PASCLIB 342 C,E,I,DCOUNT,ECOUNT,UPPER,LOWER: INTEGER; PASCLIB 343 T1,T2,T3: DOUBLE; PASCLIB 344 S,SS: BOOLEAN; (* SIGNS *) PASCLIB 345 BEGIN (* RDR *) PASCLIB 346 (* SKIP LEADING BLANKS *) PASCLIB 347 WHILE (F^ = ' ') AND NOT EOF(F) DO GET(F); PASCLIB 348 IF NOT EOF(F) THEN PASCLIB 349 BEGIN CH := F^; PASCLIB 350 IF CH IN ['+','-'] THEN PASCLIB 351 BEGIN S := CH = '-'; GET(F); CH := F^ END PASCLIB 352 ELSE S := FALSE; PASCLIB 353 IF NOT (CH IN ['0'..'9']) THEN IOE(F,IOEE); PASCLIB 354 E := 0; PASCLIB 355 DCOUNT := 0; UPPER := 0; LOWER := 0; PASCLIB 356 REPEAT C := ORD(CH) - ORD('0'); PASCLIB 357 IF DCOUNT < 28 THEN PASCLIB 358 BEGIN PASCLIB 359 IF DCOUNT < 14 THEN UPPER := UPPER * 10 + C PASCLIB 360 ELSE LOWER := LOWER * 10 + C; PASCLIB 361 IF (C <> 0) OR (DCOUNT <> 0) THEN DCOUNT := DCOUNT + 1 PASCLIB 362 END PASCLIB 363 ELSE E := E + 1; PASCLIB 364 GET(F); CH := F^ PASCLIB 365 UNTIL NOT (CH IN ['0'..'9']); PASCLIB 366 IF CH = '.' THEN (* READ FRACTION *) PASCLIB 367 BEGIN GET(F); CH := F^; PASCLIB 368 WHILE CH IN ['0'..'9'] DO PASCLIB 369 BEGIN C := ORD(CH) - ORD('0'); PASCLIB 370 IF DCOUNT < 28 THEN PASCLIB 371 BEGIN E := E - 1; PASCLIB 372 IF DCOUNT < 14 THEN UPPER := UPPER * 10 + C PASCLIB 373 ELSE LOWER := LOWER * 10 + C; PASCLIB 374 IF (C <> 0) OR (DCOUNT <> 0) THEN DCOUNT := DCOUNT + 1 PASCLIB 375 END; PASCLIB 376 GET(F); CH := F^ PASCLIB 377 END PASCLIB 378 END; PASCLIB 379 IF CH = 'E' THEN (* READ SCALE FACTOR *) PASCLIB 380 BEGIN GET(F); CH := F^; PASCLIB 381 IF CH IN ['+','-'] THEN PASCLIB 382 BEGIN SS := CH = '-'; GET(F); CH := F^ END PASCLIB 383 ELSE SS := FALSE; PASCLIB 384 I := 0; ECOUNT := 0; PASCLIB 385 IF CH IN ['0'..'9'] THEN PASCLIB 386 REPEAT C := ORD(CH) - ORD('0'); PASCLIB 387 IF ECOUNT < 14 THEN PASCLIB 388 BEGIN I := I * 10 + C; PASCLIB 389 IF (C <> 0) OR (ECOUNT <> 0) THEN ECOUNT := ECOUNT + 1 PASCLIB 390 END; PASCLIB 391 GET(F); CH := F^ PASCLIB 392 UNTIL NOT (CH IN ['0'..'9']) PASCLIB 393 ELSE IOE(F,IOEE); PASCLIB 394 IF SS THEN E := E - I ELSE E := E + I PASCLIB 395 END; PASCLIB 396 T1.UPPER := UPPER; T1.LOWER := 0.0; PASCLIB 397 IF DCOUNT > 14 THEN PASCLIB 398 BEGIN T2.UPPER := LOWER; T2.LOWER := 0.0; PASCLIB 399 TEN(T3,DCOUNT - 14); PASCLIB 400 DMUL(T1,T3,T1); PASCLIB 401 DADD(T1,T1,T2) PASCLIB 402 END; PASCLIB 403 I := E + DCOUNT; PASCLIB 404 IF I < LIM2 THEN PASCLIB 405 BEGIN T1.UPPER := 0.0; T1.LOWER := 0.0; E := 0 END PASCLIB 406 ELSE PASCLIB 407 IF I > LIM1 THEN IOE(F,IOEF); PASCLIB 408 IF S THEN BEGIN T1.UPPER := -T1.UPPER; T1.LOWER := -T1.LOWER END; PASCLIB 409 TEN(T2,ABS(E)); PASCLIB 410 IF E < 0 THEN DDIV(T1,T1,T2) PASCLIB 411 ELSE PASCLIB 412 IF E <> 0 THEN DMUL(T1,T1,T2); PASCLIB 413 RDR := T1.UPPER + T1.LOWER PASCLIB 414 END PASCLIB 415 ELSE IOE(F,IOEB) PASCLIB 416 END (* RDR *); PASCLIB 417 PASCLIB 418 PASCLIB 419 PASCLIB 420 PASCLIB 421 (* --- WRB - WRITE BOOLEANS. --- *) PASCLIB 422 (* J. P. STRAIT. 78/10/17. *) PASCLIB 423 PASCLIB 424 PROCEDURE (*$E'P.WRB'*) WRB(VAR F: TEXT; B,N: INTEGER); PASCLIB 425 BEGIN (* WRB *) PASCLIB 426 IF B = 0 THEN WRITE(F, 'FALSE':N) PASCLIB 427 ELSE PASCLIB 428 IF B = 1 THEN WRITE(F, 'TRUE':N) PASCLIB 429 ELSE IOE(F,IOEH) PASCLIB 430 END (* WRB *); PASCLIB 431 PASCLIB 432 PASCLIB 433 PASCLIB 434 PASCLIB 435 (* --- WRC - WRITE CHARACTERS. --- *) PASCLIB 436 (* K. JENSEN. *) PASCLIB 437 PASCLIB 438 PROCEDURE (*$E'P.WRC'*) WRC(VAR F: TEXT; CH: CHAR; N: INTEGER); PASCLIB 439 BEGIN (* WRC *) PASCLIB 440 WHILE N > 1 DO BEGIN N := N - 1; WRITE(F, ' ') END; PASCLIB 441 WRITE(F, CH) PASCLIB 442 END (* WRC *); PASCLIB 443 PASCLIB 444 PROCEDURE (*$E'P.WRCD'*) WRCD(VAR F: TEXT; CH: CHAR; N: INTEGER); PASCLIB 445 BEGIN PASCLIB 446 IF (ORD(CH) < MINORDCH) OR (ORD(CH) > MAXORDCH) THEN IOE(F,IOEH) V41CC10 567 ELSE PASCLIB 448 BEGIN PASCLIB 449 WHILE N > 1 DO BEGIN N := N - 1; WRITE(F, ' ') END; PASCLIB 450 WRITE(F, CH) PASCLIB 451 END PASCLIB 452 END (* WRCD *); PASCLIB 453 PASCLIB 454 PASCLIB 455 PASCLIB 456 PASCLIB 457 (* --- WRE - WRITE REAL NUMBER IN EXPONENTIAL FORM. --- *) PASCLIB 458 (* N. WIRTH / K. JENSEN / J. P. STRAIT. *) PASCLIB 459 PASCLIB 460 PROCEDURE (*$E'P.WRE'*) WRE(VAR F:TEXT; X: REAL; N: INTEGER); PASCLIB 461 (* WRITE REAL NUMBER X IN N CHARACTERS *) PASCLIB 462 VAR E0,E1,E2,I: INTEGER; PASCLIB 463 E: EXPINT; PASCLIB 464 SIGN: CHAR; PASCLIB 465 DX: DOUBLE; PASCLIB 466 UPPER, LOWER: PACKED RECORD CASE BOOLEAN OF PASCLIB 467 FALSE: (I: INTEGER); PASCLIB 468 TRUE: (D: 0..7777B; PASCLIB 469 F: 0..7777777777777777B) PASCLIB 470 END; PASCLIB 471 BEGIN (* WRE *) PASCLIB 472 (* AT LEAST 9 CHARACTERS ARE NEEDED: "+9.9E+999" *) PASCLIB 473 IF N < 9 THEN N := 2 ELSE N := N - 7; (* TOTAL NUMBER OF DIGITS *) PASCLIB 474 IF UNDEFINED(X) THEN IOE(F,IOEH) PASCLIB 475 ELSE PASCLIB 476 IF X = 0.0 THEN PASCLIB 477 BEGIN WRITE(F, ' 0.'); PASCLIB 478 FOR I := 2 TO N DO WRITE(F, '0'); PASCLIB 479 WRITE(F, 'E+000') PASCLIB 480 END PASCLIB 481 ELSE PASCLIB 482 BEGIN PASCLIB 483 DX.UPPER := X; DX.LOWER := 0.0; PASCLIB 484 SCL(DX,SIGN,E); PASCLIB 485 RND(DX,N,E); PASCLIB 486 UPPER.I := TRUNC(DX.UPPER,48); PASCLIB 487 LOWER.I := TRUNC(DX.LOWER,96); PASCLIB 488 WRITE(F, SIGN); PASCLIB 489 FOR I := 1 TO N DO PASCLIB 490 BEGIN UPPER.I := UPPER.I + LOWER.D; PASCLIB 491 WRITE(F, CHR(UPPER.D + ORD('0'))); PASCLIB 492 UPPER.I := UPPER.F * 10; PASCLIB 493 LOWER.I := LOWER.F * 10; PASCLIB 494 IF I = 1 THEN WRITE(F, '.') PASCLIB 495 END; PASCLIB 496 WRITE(F, 'E'); PASCLIB 497 IF E < 0 THEN PASCLIB 498 BEGIN WRITE(F, '-'); E := -E END PASCLIB 499 ELSE WRITE(F, '+'); PASCLIB 500 E1 := E * 205 DIV 2048; PASCLIB 501 E2 := E - 10 * E1; PASCLIB 502 E0 := E1 * 205 DIV 2048; PASCLIB 503 E1 := E1 - 10 * E0; PASCLIB 504 WRITE(F, CHR(E0 + ORD('0')), PASCLIB 505 CHR(E1 + ORD('0')), PASCLIB 506 CHR(E2 + ORD('0'))) PASCLIB 507 END PASCLIB 508 END (* WRE *); PASCLIB 509 PASCLIB 510 PASCLIB 511 PASCLIB 512 PASCLIB 513 (* --- WRF - WRITE REAL NUMBERS IN FIXED POINT FORMAT. --- *) PASCLIB 514 (* N. WIRTH / K. JENSEN / J. P. STRAIT. *) PASCLIB 515 PASCLIB 516 PROCEDURE (*$E'P.WRF'*) WRF(VAR F: TEXT; X: REAL; M,N: INTEGER); PASCLIB 517 (* WRITE REAL NUMBER X IN M CHARACTERS, N AFTER THE DECIMAL POINT *) PASCLIB 518 VAR K2,K3,I: INTEGER; PASCLIB 519 E: EXPINT; PASCLIB 520 SIGN: CHAR; PASCLIB 521 DX: DOUBLE; PASCLIB 522 UPPER, LOWER: PACKED RECORD CASE BOOLEAN OF PASCLIB 523 FALSE: (I: INTEGER); PASCLIB 524 TRUE: (D: 0..7777B; PASCLIB 525 F: 0..7777777777777777B) PASCLIB 526 END; PASCLIB 527 BEGIN (* WRF *) PASCLIB 528 IF UNDEFINED(X) THEN IOE(F,IOEH) PASCLIB 529 ELSE PASCLIB 530 BEGIN DX.UPPER := X; DX.LOWER := 0.0; PASCLIB 531 IF N < 1 THEN N := 1; PASCLIB 532 SCL(DX,SIGN,E); PASCLIB 533 E := E + 1; PASCLIB 534 RND(DX,N + E,E); PASCLIB 535 IF N + E <= 0 THEN (* NUMBER WILL PRINT AS 0.0 *) PASCLIB 536 BEGIN I := M - N; PASCLIB 537 IF I < 2 THEN I := 2; PASCLIB 538 WRITE(F, '0.':I); PASCLIB 539 REPEAT WRITE(F, '0'); N := N - 1 UNTIL N = 0 PASCLIB 540 END PASCLIB 541 ELSE PASCLIB 542 BEGIN (* CALCULATE CHARACTER COUNTS: *) PASCLIB 543 IF E > 0 THEN PASCLIB 544 BEGIN M := M - N - E - 1; K2 := E; K3 := 0 END PASCLIB 545 ELSE PASCLIB 546 BEGIN M := M - N - 2; K2 := 0; K3 := -E; N := N - K3 END; PASCLIB 547 (* M-1 BLANKS, SIGN, K2 DIGITS, '.', K3 ZEROS, N DIGITS *) PASCLIB 548 WHILE M > 1 DO BEGIN M := M - 1; WRITE(F, ' ') END; PASCLIB 549 IF (SIGN = '-') OR (M = 1) THEN WRITE(F, SIGN); PASCLIB 550 UPPER.I := TRUNC(DX.UPPER,48); PASCLIB 551 LOWER.I := TRUNC(DX.LOWER,96); PASCLIB 552 IF K2 = 0 THEN WRITE(F, '0') PASCLIB 553 ELSE PASCLIB 554 REPEAT UPPER.I := UPPER.I + LOWER.D; PASCLIB 555 WRITE(F, CHR(UPPER.D + ORD('0'))); PASCLIB 556 UPPER.I := UPPER.F * 10; PASCLIB 557 LOWER.I := LOWER.F * 10; PASCLIB 558 K2 := K2 - 1 PASCLIB 559 UNTIL K2 = 0; PASCLIB 560 WRITE(F, '.'); PASCLIB 561 WHILE K3 <> 0 DO BEGIN K3 := K3 - 1; WRITE(F, '0') END; PASCLIB 562 WHILE N <> 0 DO PASCLIB 563 BEGIN N := N - 1; PASCLIB 564 UPPER.I := UPPER.I + LOWER.D; PASCLIB 565 WRITE(F, CHR(UPPER.D + ORD('0'))); PASCLIB 566 UPPER.I := UPPER.F * 10; PASCLIB 567 LOWER.I := LOWER.F * 10 PASCLIB 568 END PASCLIB 569 END PASCLIB 570 END PASCLIB 571 END (* WRF *); PASCLIB 572 PASCLIB 573 PASCLIB 574 PASCLIB 575 PASCLIB 576 (* --- WRI - WRITE INTEGERS. --- *) PASCLIB 577 (* J. P. STRAIT. 78/10/17. *) PASCLIB 578 PASCLIB 579 PROCEDURE (*$E'P.WRI'*) WRI(VAR F: TEXT; N,W: INTEGER); PASCLIB 580 (* WRITE INTEGER NUMBER N IN W CHARACTERS *) PASCLIB 581 VAR UPPER,LOWER,I,T1,T2: INTEGER; PASCLIB 582 D: ARRAY[1..20] OF CHAR; PASCLIB 583 S: BOOLEAN; PASCLIB 584 BEGIN (* WRI *) PASCLIB 585 IF N >= 0 THEN S := FALSE PASCLIB 586 ELSE BEGIN S := TRUE; N := -N END; PASCLIB 587 UPPER := N DIV T30; LOWER := N - UPPER * T30; PASCLIB 588 I := 0; PASCLIB 589 REPEAT I := I + 1; PASCLIB 590 T1 := UPPER DIV 10; PASCLIB 591 T2 := UPPER - T1 * 10; PASCLIB 592 UPPER := T1; PASCLIB 593 T1 := LOWER + T2 * T30; PASCLIB 594 T2 := T1 DIV 10; PASCLIB 595 D[I] := CHR(T1 - T2 * 10 + ORD('0')); PASCLIB 596 LOWER := T2 PASCLIB 597 UNTIL UPPER + LOWER = 0; PASCLIB 598 IF S THEN BEGIN I := I + 1; D[I] := '-' END; PASCLIB 599 WHILE W > I DO BEGIN W := W - 1; WRITE(F, ' ') END; PASCLIB 600 REPEAT WRITE(F, D[I]); I := I - 1 UNTIL I <= 0 PASCLIB 601 END (* WRI *); PASCLIB 602 PASCLIB 603 PASCLIB 604 PASCLIB 605 PASCLIB 606 (*$X= RESUME OLD X-OPTION *) PASCLIB 607 (* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *) PASCLIB 608 PASCLIB 609 PASCLIB 610 PASCLIB 611 PASCLIB 612 (*$X3 PASS THREE PARAMETERS IN X-REGS. *) PASCLIB 613 PASCLIB 614 PASCLIB 615 PASCLIB 616 PASCLIB 617 (* --- WRITEHEX - WRITE INTEGERS IN HEXADECIMAL FORMAT. --- *) PASCLIB 618 (* D. J. BIANCHI. 1982-11-26. *) PASCLIB 619 PASCLIB 620 PROCEDURE WRITEHEX(VAR F: TEXT; N,W: INTEGER); PASCLIB 621 (* WRITE (IN HEXADECIMAL) INTEGER NUMBER N IN W CHARACTERS *) PASCLIB 622 VAR NUM: WORD; I: INTEGER; PASCLIB 623 BEGIN (* WRITEHEX *) PASCLIB 624 IF W <= 0 THEN HALT(' ZERO OR NEGATIVE FIELD WIDTH.'); PASCLIB 625 WHILE W > 15 DO BEGIN WRITE(F,' '); W := W - 1 END; PASCLIB 626 NUM.I := N; PASCLIB 627 FOR I := 16 - W TO 15 DO PASCLIB 628 IF NUM.HEX[I] >= 10 THEN WRITE(F,CHR(NUM.HEX[I]-10+ORD('A'))) PASCLIB 629 ELSE WRITE(F,CHR(NUM.HEX[I]+ORD('0'))) PASCLIB 630 END (* WRITEHEX *); PASCLIB 631 PASCLIB 632 PASCLIB 633 PASCLIB 634 PASCLIB 635 PASCLIB 636 (* --- WRITEOCT - WRITE INTEGERS IN OCTAL FORMAT. --- *) PASCLIB 637 (* D. J. BIANCHI. 1982-11-26. *) PASCLIB 638 PASCLIB 639 PROCEDURE WRITEOCT(VAR F: TEXT; N,W: INTEGER); PASCLIB 640 (* WRITE (IN OCTAL) INTEGER NUMBER N IN W CHARACTERS *) PASCLIB 641 VAR NUM: WORD; I: INTEGER; PASCLIB 642 BEGIN (* WRITEOCT *) PASCLIB 643 IF W <= 0 THEN HALT(' ZERO OR NEGATIVE FIELD WIDTH.'); PASCLIB 644 WHILE W > 20 DO BEGIN WRITE(F,' '); W := W - 1 END; PASCLIB 645 NUM.I := N; PASCLIB 646 FOR I := 21 - W TO 20 DO WRITE(F,CHR(NUM.OCT[I]+ORD('0'))) PASCLIB 647 END (* WRITEOCT *); PASCLIB 648 PASCLIB 649 PASCLIB 650 PASCLIB 651 PASCLIB 652 (*$X= RESUME OLD X-OPTION. *) PASCLIB 653 (* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *) PASCLIB 654 PASCLIB 655 PASCLIB 656 PASCLIB 657 PASCLIB 658 (* PASCPMD - PASCAL POST-MORTEM DUMP. PASCLIB 659 * J. P. STRAIT 77/11/29. PASCLIB 660 * BASED ON THE ORIGINAL VERSION BY PASCLIB 661 * H.SANDMAYR CIRCA JUNE 1974. PASCLIB 662 *) PASCLIB 663 PASCLIB 664 (*$X0 NO PARAMETERS PASSED IN X-REGS *) PASCLIB 665 PASCLIB 666 PROCEDURE (*$E'P.PMD'*) PASCPMD( PASCLIB 667 VAR MEMORY : MEMORYARRAY;(* ARRAY BASED AT ADDRESS ZERO *) PASCLIB 668 A0 : INTEGER; (* LINE NUMBER WHERE ERROR OCCURRED *) PASCLIB 669 B5 : INTEGER; (* STACK POINTER OF CURRENT ACTIVATION *) PASCLIB 670 VAR F : TEXT; (* FILE TO RECEIVE THE POST-MORTEM DUMP *) PASCLIB 671 MSGADDRS : WORD; (* ERROR MESSAGE ADDRESSES. 30/M1, 30/M2 *) PASCLIB 672 (* M1 OR M2 ZERO IF NO MESSAGE *) PASCLIB 673 ABORT : BOOLEAN; (* ABNORMAL TERMINATION FLAG *) PASCLIB 674 ACTIVATIONS: INTEGER; (* MAXIMUM NUMBER OF ACTIVATIONS TO DUMP *) PASCLIB 675 SCU : INTEGER (* STACK-CHUNK UNDERFLOW RETURN ADDRESS *) PASCLIB 676 ); PASCLIB 677 PASCLIB 678 CONST PASCLIB 679 SABPKI = 51B; (* SAI BJ+K INSTRUCTION *) PASCLIB 680 PARCELSHIFT= 100000B; (* ENOUGH TO SHIFT 15 BITS *) PASCLIB 681 MAXCOUNT = 3; (* MAX NUMBER OF ACTIVATIONS TO LIST *) PASCLIB 682 MAXCWORD = 'THREE'; (* MAXCOUNT IN ENGLISH *) PASCLIB 683 PASCLIB 684 TYPE PASCLIB 685 NAMESTRING = PASCLIB 686 RECORD PASCLIB 687 IMAGE: PACKED ARRAY [1..10] OF CHAR; PASCLIB 688 LEN: 0..10; PASCLIB 689 END; PASCLIB 690 PASCLIB 691 VAR PASCLIB 692 BHWADDR : INTEGER; (* CURRENT BLOCK HEADER WORD ADDRESS *) PASCLIB 693 NAME : NAMESTRING; (* NAME OF CURRENT BLOCK *) PASCLIB 694 HALFWORDOPS : SET OF 0..58; (* OP CODES FOR HALF WORD INSTS. *) PASCLIB 695 OPCODE : INTEGER; (* OP CODE IN LINEWORD *) PASCLIB 696 PC : INTEGER; (* FOR TRACING LINE NUMBERS *) PASCLIB 697 LINEWORD : WORD; (* WORD WITH SA0 B0+LINE *) PASCLIB 698 VARDESCADDR : INTEGER; (* PMD VAR-DESCRIPTOR POINTER *) PASCLIB 699 PMDON : BOOLEAN; (* CURRENT -P- OPTION *) PASCLIB 700 LISTCOUNT : INTEGER; (* COUNT FROM PMD HEADER *) PASCLIB 701 CALLEDNAME : NAMESTRING; (* NAME OF PREVIOUS BLOCK *) PASCLIB 702 CALLEDLISTCOUNT: INTEGER; (* COUNT FROM PREVIOUS PMD HEADER *) PASCLIB 703 FIRSTACTIVATION: BOOLEAN; (* FIRST ACTIVATION LISTED *) PASCLIB 704 PROG : BOOLEAN; (* CURRENT BLOCK IS PROGRAM *) PASCLIB 705 FUNC : BOOLEAN; (* CURRENT BLOCK IS FUNCTION *) PASCLIB 706 EXITLOOP : BOOLEAN; PASCLIB 707 PASCLIB 708 PROCEDURE (*$E'P.PMD.1'*) DISPLAYVARIABLES; PASCLIB 709 VAR PASCLIB 710 VARNAME: NAMESTRING; PASCLIB 711 VARADDR: INTEGER; PASCLIB 712 VARTYPE: INTEGER; PASCLIB 713 RIGHT: BOOLEAN; PASCLIB 714 BLANKS: INTEGER; PASCLIB 715 VARWORD: WORD; PASCLIB 716 PASCLIB 717 PROCEDURE (*$E'P.PMD.2'*) WRITEUNDEFINED; PASCLIB 718 BEGIN PASCLIB 719 WRITE(F, 'UNDEFINED':11) PASCLIB 720 END (* WRITEUNDEFINED *) ; PASCLIB 721 PASCLIB 722 BEGIN (* DISPLAYVARIABLES *) PASCLIB 723 WRITELN(F); PASCLIB 724 WITH NAME DO PASCLIB 725 WRITELN(F, ' ':30-LEN DIV 2, '--- ', IMAGE:LEN, ' ---'); PASCLIB 726 RIGHT := FALSE; PASCLIB 727 REPEAT PASCLIB 728 WITH VARNAME DO PASCLIB 729 BEGIN PASCLIB 730 IMAGE := MEMORY[VARDESCADDR].A; LEN := 10; PASCLIB 731 WHILE IMAGE[LEN] = ' ' DO LEN := PRED(LEN); PASCLIB 732 WRITE(F, ' ':11 - LEN, IMAGE:LEN,' ='); PASCLIB 733 END; PASCLIB 734 WITH MEMORY[VARDESCADDR+1].PMDVARDESCRIPTOR DO PASCLIB 735 BEGIN VARTYPE := VTYPE; VARADDR := B5 + VADDR END; PASCLIB 736 IF ODD(VARTYPE) THEN VARADDR := MEMORY[VARADDR].I; PASCLIB 737 VARTYPE := VARTYPE DIV 2; PASCLIB 738 BLANKS := 0; PASCLIB 739 VARWORD := MEMORY[VARADDR]; PASCLIB 740 WITH VARWORD DO PASCLIB 741 CASE VARTYPE OF PASCLIB 742 PMDREAL: PASCLIB 743 IF UNDEFINED(R) THEN PASCLIB 744 BEGIN WRITEUNDEFINED; BLANKS := 11 END PASCLIB 745 ELSE WRITE(F, ' ', R:21); PASCLIB 746 PMDINT, PASCLIB 747 PMDENUM: PASCLIB 748 IF ABS(I) > MAXINT THEN PASCLIB 749 BEGIN WRITEUNDEFINED; BLANKS := 11 END PASCLIB 750 ELSE IF ABS(I) < 1000000000 THEN PASCLIB 751 BEGIN WRITE(F, I:11); BLANKS := 11 END PASCLIB 752 ELSE WRITE(F, I:22); PASCLIB 753 PMDCHAR: PASCLIB 754 IF ((ORD(C) > MINORDCH) AND (ORD(C) <= MAXORDCH)) OR PASCLIB 755 (ORD(C) = ORD(':')) THEN WRITE(F, ' ':10, C) PASCLIB 756 ELSE WRITEUNDEFINED; PASCLIB 757 PMDBOOL: PASCLIB 758 IF ORD(B) IN [0,1] THEN WRITE(F, B:11) ELSE WRITEUNDEFINED; PASCLIB 759 PMDALFA: PASCLIB 760 WRITE(F, A:11); PASCLIB 761 PMDUPTR: PASCLIB 762 IF P = NIL THEN WRITE(F, 'NIL':11) PASCLIB 763 ELSE IF (ORD(P)<0) OR (ORD(P)>377777B) THEN WRITEUNDEFINED PASCLIB 764 ELSE BEGIN WRITE(F,' ':5); WRITEOCT(F,ORD(P),6) END; PASCLIB 765 PMDCPTR: PASCLIB 766 IF P = NIL THEN WRITE(F, 'NIL':11) PASCLIB 767 ELSE IF BPV(P) THEN WRITEUNDEFINED PASCLIB 768 ELSE BEGIN WRITE(F,' ':5); WRITEOCT(F,ORD(P),6) END; PASCLIB 769 END; PASCLIB 770 IF RIGHT THEN WRITELN(F) PASCLIB 771 ELSE PASCLIB 772 BEGIN PASCLIB 773 BLANKS := BLANKS + 18 PASCLIB 774 - 11 * ORD(VARTYPE IN [PMDREAL,PMDINT,PMDENUM]); PASCLIB 775 WRITE(F, ' ':BLANKS) PASCLIB 776 END; PASCLIB 777 RIGHT := NOT RIGHT; PASCLIB 778 VARDESCADDR := VARDESCADDR + 2 PASCLIB 779 UNTIL MEMORY[VARDESCADDR].I = 0; PASCLIB 780 IF RIGHT THEN WRITELN(F); PASCLIB 781 WRITELN(F) PASCLIB 782 END (* DISPLAYVARIABLES *) ; PASCLIB 783 PASCLIB 784 PROCEDURE (*$E'P.PMD.3'*) WRITELNWHERE; PASCLIB 785 BEGIN (* WRITELNWHERE *) PASCLIB 786 IF PMDON THEN WRITE(F, ' AT LINE ', A0:1); PASCLIB 787 WRITE(F, ' IN '); PASCLIB 788 IF PROG THEN WRITE(F, 'PROGRAM ') PASCLIB 789 ELSE IF FUNC THEN WRITE(F, 'FUNCTION ') PASCLIB 790 ELSE WRITE(F, 'PROCEDURE '); PASCLIB 791 WRITELN(F, NAME.IMAGE:NAME.LEN, '.') PASCLIB 792 END (* WRITELNWHERE *) ; PASCLIB 793 PASCLIB 794 PROCEDURE (*$E'P.PMD.4'*) WRITELNMESSAGE(MESSADDR: ADDRESSFIELD); PASCLIB 795 VAR PASCLIB 796 C: 1..10; PASCLIB 797 A: WORD; PASCLIB 798 EXIT: BOOLEAN; PASCLIB 799 BEGIN (* WRITELNMESSAGE *) PASCLIB 800 IF MESSADDR <> 0 THEN PASCLIB 801 BEGIN PASCLIB 802 IF MEMORY[MESSADDR].A[1] <> ' ' THEN WRITE(F, ' '); PASCLIB 803 C := 10; PASCLIB 804 REPEAT PASCLIB 805 A := MEMORY[MESSADDR]; MESSADDR := MESSADDR + 1; PASCLIB 806 EXIT := A.BYTE[4] = 0; PASCLIB 807 IF A.I <> 0 THEN PASCLIB 808 BEGIN PASCLIB 809 IF EXIT THEN PASCLIB 810 WHILE A.A[C] = CHR(0) DO C := PRED(C); PASCLIB 811 WRITE(F, A.A:C) PASCLIB 812 END PASCLIB 813 UNTIL EXIT; PASCLIB 814 WRITELN(F) PASCLIB 815 END PASCLIB 816 END (* WRITELNMESS *) ; PASCLIB 817 PASCLIB 818 BEGIN (* PASCPMD *) PASCLIB 819 HALFWORDOPS := [0..7,50B,51B,52B,60B,61B,62B,70B,71B,72B]; PASCLIB 820 FIRSTACTIVATION := TRUE; PASCLIB 821 PROG := FALSE; LISTCOUNT := 0; PASCLIB 822 REPEAT PASCLIB 823 BHWADDR := MEMORY[B5].HALF.K; PASCLIB 824 PROG := MEMORY[BHWADDR].BLOCKHEADERWORD.PG; PASCLIB 825 IF MEMORY[BHWADDR].BLOCKHEADERWORD.PH THEN (* PMD NOT SUPPRESSED *) PASCLIB 826 BEGIN PASCLIB 827 WITH MEMORY[BHWADDR+1].PMDHEADER DO PASCLIB 828 BEGIN PASCLIB 829 FUNC := FB; PMDON := PP; PASCLIB 830 IF PMDON THEN VARDESCADDR := BHWADDR + PMDIC; PASCLIB 831 IF ABORT THEN PASCLIB 832 BEGIN PASCLIB 833 LISTCOUNT := COUNT; PASCLIB 834 IF LISTCOUNT <= MAXCOUNT THEN COUNT := LISTCOUNT + 1 PASCLIB 835 END PASCLIB 836 END; PASCLIB 837 NAME.IMAGE := MEMORY[BHWADDR+2].A; NAME.LEN := 10; PASCLIB 838 WITH NAME DO WHILE IMAGE[LEN] = ' ' DO LEN := PRED(LEN); PASCLIB 839 IF FIRSTACTIVATION THEN PASCLIB 840 BEGIN PASCLIB 841 FIRSTACTIVATION := FALSE; PASCLIB 842 WRITELN(F); WRITELN(F); PASCLIB 843 IF ABORT THEN WRITE(F, ' PROGRAM TERMINATED') PASCLIB 844 ELSE WRITE(F, ' SNAPSHOT DUMP'); PASCLIB 845 WRITELNWHERE; PASCLIB 846 WRITELNMESSAGE(MSGADDRS.ADDRESS.LOWER); PASCLIB 847 WRITELNMESSAGE(MSGADDRS.HALF.K); PASCLIB 848 END PASCLIB 849 ELSE (* NOT FIRSTACTIVATION *) PASCLIB 850 IF (CALLEDLISTCOUNT < MAXCOUNT) OR (LISTCOUNT < MAXCOUNT) THEN PASCLIB 851 BEGIN PASCLIB 852 WRITE(F, ' ', CALLEDNAME.IMAGE:CALLEDNAME.LEN, ' WAS CALLED'); PASCLIB 853 IF PMDON THEN (* FIND LINE NUMBER OF CALL *) PASCLIB 854 BEGIN PASCLIB 855 REPEAT PC := PC - 1; PASCLIB 856 LINEWORD := MEMORY[PC]; PASCLIB 857 OPCODE := LINEWORD.HALF.OP; PASCLIB 858 WHILE NOT (OPCODE IN [0,SABPKI]) OR (LINEWORD.HALF.I <> 0) DO PASCLIB 859 BEGIN PASCLIB 860 LINEWORD.HALF.OP := 0; PASCLIB 861 LINEWORD.HALF.I := 0; PASCLIB 862 LINEWORD.I := LINEWORD.I * PARCELSHIFT; PASCLIB 863 IF OPCODE IN HALFWORDOPS THEN PASCLIB 864 LINEWORD.I := LINEWORD.I * PARCELSHIFT; PASCLIB 865 OPCODE := LINEWORD.HALF.OP PASCLIB 866 END PASCLIB 867 UNTIL OPCODE <> 0; PASCLIB 868 A0 := LINEWORD.HALF.K PASCLIB 869 END; PASCLIB 870 WRITELNWHERE PASCLIB 871 END; PASCLIB 872 IF (LISTCOUNT < MAXCOUNT) AND (ACTIVATIONS <> 0) THEN PASCLIB 873 BEGIN PASCLIB 874 ACTIVATIONS := PRED(ACTIVATIONS); PASCLIB 875 IF PMDON THEN IF MEMORY[VARDESCADDR].I <> 0 THEN V41EC05 7 DISPLAYVARIABLES PASCLIB 877 END PASCLIB 878 ELSE PASCLIB 879 IF LISTCOUNT = MAXCOUNT THEN PASCLIB 880 BEGIN PASCLIB 881 WRITELN(F, ' BECAUSE OF RECURSION, MORE THAN ', MAXCWORD, PASCLIB 882 ' COPIES OF ', NAME.IMAGE:NAME.LEN); PASCLIB 883 WRITELN(F, ' WERE ACTIVE, BUT ONLY ', MAXCWORD, PASCLIB 884 ' HAVE BEEN LISTED.') PASCLIB 885 END PASCLIB 886 END PASCLIB 887 ELSE (* PMD SUPPRESSED IN THIS BLOCK *) ; PASCLIB 888 EXITLOOP := PROG OR (ACTIVATIONS = 0); PASCLIB 889 IF NOT EXITLOOP THEN (* TRACE BACK TO CALLER *) PASCLIB 890 BEGIN PASCLIB 891 PC := MEMORY[B5-1].HALF.K; (* RA *) PASCLIB 892 IF PC = SCU THEN (* CROSS STACK-CHUNK BOUNDARY *) PASCLIB 893 PC := MEMORY[B5-ARPS-1].ADDRESS.LOWER; PASCLIB 894 B5 := MEMORY[B5-1].ADDRESS.LOWER; (* DL *) PASCLIB 895 CALLEDNAME := NAME; CALLEDLISTCOUNT := LISTCOUNT; PASCLIB 896 END PASCLIB 897 UNTIL EXITLOOP PASCLIB 898 END (* PASCPMD *) ; PASCLIB 899 PASCLIB 900 (*$X= RESUME OLD X-OPTION *) PASCLIB 901 PASCLIB 902 PASCLIB 903 PASCLIB 904 PASCLIB 905 (* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *) PASCLIB 906 PASCLIB 907 PASCLIB 908 PASCLIB 909 PASCLIB 910 BEGIN (* PASCLIB *) END. PASCLIB 911