IDENT P.SYSTM PSYSTM 2 SST FL PSYSTM 3 SYSCOM B1 PSYSTM 4 IPARAMS PSYSTM 5 LIST F PSYSTM 6 ENTRY P.ACV PSYSTM 7 ENTRY P.CAD PSYSTM 8 ENTRY P.CFD PSYSTM 9 ENTRY P.CFV PSYSTM 10 ENTRY P.CLOCK PSYSTM 11 ENTRY P.CLO PSYSTM 12 ENTRY P.CPV PSYSTM 13 ENTRY P.DATE PSYSTM 14 ENTRY P.DFV PSYSTM 15 ENTRY P.DISPD PSYSTM 16 ENTRY P.EFD PSYSTM 17 ENTRY P.END PSYSTM 18 ENTRY P.FCA PSYSTM 19 ENTRY P.FOB PSYSTM 20 ENTRY P.FXF V41CC14 6 ENTRY P.GETB PSYSTM 21 ENTRY P.GETC PSYSTM 22 ENTRY P.GETCH PSYSTM 23 ENTRY P.GETLN PSYSTM 24 ENTRY P.GETS PSYSTM 25 ENTRY P.GLOBL PSYSTM 26 ENTRY P.GTO PSYSTM 27 ENTRY P.HALT PSYSTM 28 ENTRY P.INIT PSYSTM 29 ENTRY P.INV PSYSTM 30 ENTRY P.IOE PSYSTM 31 ENTRY P.ISM PSYSTM 32 ENTRY P.MSG PSYSTM 33 ENTRY P.NEWD PSYSTM 34 ENTRY P.NFN PSYSTM 35 ENTRY P.OPE PSYSTM 36 ENTRY P.OS PSYSTM 37 ENTRY P.PAGE PSYSTM 38 ENTRY P.PEG PSYSTM 39 ENTRY P.PEN PSYSTM 40 ENTRY P.PEX PSYSTM 41 ENTRY P.PPF PSYSTM 42 ENTRY P.PUTB PSYSTM 43 ENTRY P.PUTC PSYSTM 44 ENTRY P.PUTCH PSYSTM 45 ENTRY P.PUTLN PSYSTM 46 ENTRY P.PUTS PSYSTM 47 ENTRY P.RESET PSYSTM 48 ENTRY P.REWRT PSYSTM 49 ENTRY P.RPE PSYSTM 50 ENTRY P.RPF PSYSTM 51 ENTRY P.RWR PSYSTM 52 ENTRY P.RWRTS PSYSTM 53 ENTRY P.SABRT PSYSTM 54 ENTRY P.SCO PSYSTM 55 ENTRY P.SCU PSYSTM 56 ENTRY P.SKP PSYSTM 57 ENTRY P.SNM PSYSTM 58 ENTRY P.SPE PSYSTM 59 ENTRY P.SPK PSYSTM 60 ENTRY P.SRS PSYSTM 61 ENTRY P.SWS PSYSTM 62 ENTRY P.TERA PSYSTM 63 ENTRY P.TIME PSYSTM 64 ENTRY P.TMS PSYSTM 65 ENTRY P.VPE PSYSTM 66 ENTRY P.WWR PSYSTM 67 PSYSTM SPACE 4,10 PSYSTM 68 PSYSTM TITLE PASCAL-6000 RUN TIME SYSTEM. PSYSTM 69 COMMENT PASCAL-6000 RUN TIME SYSTEM. PSYSTM 70 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1978. PSYSTM 71 PSYSTM SPACE 4,10 PSYSTM 72 *** PASCAL-6000 RUN TIME SYSTEM. PSYSTM 73 * J. P. STRAIT. 77/01/20. PSYSTM 74 * J. J. DRUMMOND. 77/01/20. PSYSTM 75 * PSYSTM 76 * ORIGINAL VERSION BY PSYSTM 77 * H. SANDMAYR CIRCA JUNE 1974. PSYSTM 78 * N. WIRTH CIRCA JUNE 1974. PSYSTM 79 * S. KNUDSEN CIRCA MARCH 1976. PSYSTM 80 * PSYSTM 81 * SCOPE VERSIONS BY PSYSTM 82 * H. JORAANDSTAD (CERN) OCTOBER 1975. RELEASE 1 PSYSTM 83 * A. P. HAYES (MNCH) OCTOBER 1976. RELEASE 2 PSYSTM 84 * A. G. HAY (MNCH) JANUARY 1980. RELEASE 3 PSYSTM 85 * D. J. LEGGE (MNCH) MARCH 1983. RELEASE 4 PSYSTM 86 HISTORY SPACE 4,10 HPSYSTM 1 ** PASCAL-6000 MODIFICATION HISTORY. HPSYSTM 2 * HPSYSTM 3 * FIX FAILURE TO USE SYMBOLIC CONSTANTS IN P.PTB. V41FC05 5 * KEEP PTB FROM ISSUING UNNECESSARY READ REQUESTS. V41FC04 5 * RESTORE BASHED REGISTER IN P.SABRT. V41FC03 6 * FLUSH NON-PERSISTENT CONNECTED FILES. V41EC07 8 * ALLOW CONTROL STATEMENT *PASCAL,/...*. V41EC06 7 * SYNCHRONIZE DAYFILE MESSAGES UNDER NOS/BE WITH RECALL. V41EC04 11 * FIX DOCUMENTATION OF P.NEWD AND P.PPF. V41EC04 12 * RENAME SYMBOL *ETERMINL* TO *ECONNECT*. V41EC01 7 * CORRECT CODE TO USE NEW VALUE OF *ERT* AND TO USE *ERTW*. V41DC09 8 * CHANGE *P.CFV* TO HANDLE SPECIAL PROGRAM PARAMS (SYSLOC = 1). V41DC06 48 * CHANGE *P.FXF* TO ENSURE I/O COMPLETE ON ACTUAL FILE *OUTPUT*. V41DC04 7 * FIX COMPASS CODING IN ROUTINE *P.SABRT*. V41DC03 5 * CORRECT ERRORS IN P.FCA CODE AND EXIT-CONDITION DOCUMENTATION. V41DC02 5 * FIX TYPOS IN ASCII CONDITIONAL ASSEMBLY. V41CC22 5 * CHANGE ROUTINE *P.TMS* TO REMOVE TRAILING BLANKS, HANDLE ASCII. V41CC17 5 * ADD ROUTINE *P.FXF*; CHANGE *P.SABRT* TO CALL *P.FXF*. V41CC14 7 * CHANGE "P.RWR" AND "P.WWR" TO USE "ENTER" INSTEAD OF "ROUTINE". V41CC13 7 * ADD ASCII CONDITIONAL ASSEMBLY. V41CC10 34 * USE SYMBOLIC EFET CONSTANTS. V41CC05 6 * SPEED UP P.ACV. V41CC01 5 * FIX ERROR IN REWRITE ON TAPE FILES UNDER NOS AND KRONOS. V41AC14 6 * ELIMINATE NESTED CONDITIONAL ASSEMBLY. V41AC14 7 * CORRECT SKIP COUNT IN P.SKP WHEN AT END OF INFORMATION. V41AC12 5 * CHANGE SYMBOL *NOS* TO *NOS1+NOS2*. V41AC01 18 * HPSYSTM 4 PRESET SPACE 4,10 PSYSTM 87 USE PRESET PSYSTM 88 SCRATCH SET * SCRATCH STORAGE PSYSTM 89 USE * PSYSTM 90 PSYSTM TITLE MACROS AND MICROS. PSYSTM 91 ** MACROS. PSYSTM 92 SCRATCH SPACE 4,10 PSYSTM 93 ** SCRATCH - DECLARE SCRATCH STORAGE. PSYSTM 94 * PSYSTM 95 * TAG SCRATCH N PSYSTM 96 * PSYSTM 97 * DECLARES N WORDS OF SCRATCH STORAGE OVERLAYED ON PSYSTM 98 * THE PRESET CODE. PSYSTM 99 PSYSTM 100 PSYSTM 101 PURGMAC SCRATCH PSYSTM 102 PSYSTM 103 MACRO SCRATCH,TAG,N PSYSTM 104 TAG EQU SCRATCH PSYSTM 105 SCRATCH SET SCRATCH+N PSYSTM 106 ERRNG PRSL-SCRATCH STORAGE EXCEEDS PRESET. PSYSTM 107 ENDM PSYSTM 108 PSYSTM TITLE TABLES. PSYSTM 109 ** TABLES. PSYSTM 110 TGVR SPACE 4,10 PSYSTM 111 ** TGVR - TABLE OF GLOBAL VARIABLES. PSYSTM 112 * PSYSTM 113 * THIS TABLE INCLUDES RUN TIME SYSTEM VARIABLES THAT ARE PSYSTM 114 * MAINTAINED ACROSS THE ENTIRE EXECUTION OF A PASCAL PROGRAM. PSYSTM 115 * IN OTHER WORDS, THEY ARE GLOBAL WITH RESPECT TO THE USER PSYSTM 116 * PROGRAM. PSYSTM 117 PSYSTM 118 PSYSTM 119 TGVR ENTER P.GLOBL PSYSTM 120 LOC 0 PSYSTM 121 PSYSTM 122 DATA L*P.GLOBL* PSYSTM 123 TGVRPMDS VFD 30/0,30/0 PMD STACK-CHUNK (30/LWA+1,30/FWA), PSYSTM 124 ZERO IF PMD NOT ENABLED PSYSTM 125 TGVRKEY DATA 1 KEY FOR POINTER CHECKS PSYSTM 126 TGVRFORT DATA 0 FORTRAN CALL FLAG PSYSTM 127 TGVRPTRS BSS 1 FOR SAVING GLOBAL POINTERS (B4,5,6) PSYSTM 128 PSYSTM 129 LOC *O PSYSTM 130 TERA SPACE 4,10 PSYSTM 131 ** TERA - TABLE OF ERROR RECOVERY ADDRESSES. PSYSTM 132 * PSYSTM 133 * THIS VECTOR IS JUMPED TO WHEN PASCAL DETECTS A RUN TIME PSYSTM 134 * ERROR. A0 WILL CONTAIN THE LINE NUMBER AT THIS TIME IF PSYSTM 135 * P+ IS ON. PSYSTM 136 PSYSTM 137 PSYSTM 138 TERA ENTER P.TERA TABLE OF ERROR RECOVERY ADDRESSES PSYSTM 139 LOC 0 PSYSTM 140 PSYSTM 141 ASSERR SX0 MSGD VALUE OUT OF RANGE PSYSTM 142 EQ ABT PSYSTM 143 PSYSTM 144 INXERR SX0 MSGE INDEX OR CASE VAR OUT OF RANGE PSYSTM 145 EQ ABT PSYSTM 146 PSYSTM 147 DIVERR SX0 MSGF DIVISION BY ZERO PSYSTM 148 EQ ABT PSYSTM 149 PSYSTM 150 ICNERR SX0 MSGAG INCONSISTENT NODE REFERENCE. PSYSTM 151 EQ ABT PSYSTM 152 PSYSTM 153 OVLERR SX0 MSGN INTEGER OVERFLOW PSYSTM 154 EQ ABT PSYSTM 155 PSYSTM 156 PTRERR SX0 MSGH INCORRECT POINTER REFERENCE PSYSTM 157 EQ ABT PSYSTM 158 PSYSTM 159 MODERR SX0 MSGAD MOD BY NON-POSITIVE MODULO PSYSTM 160 EQ ABT PSYSTM 161 PSYSTM 162 EOLERR SX0 MSGAE TRIED TO CHECK EOLN WHILE AT EOS/EOF PSYSTM 163 EQ ABT PSYSTM 164 PSYSTM 165 ISMERR SX0 MSGQ MEMORY REQUIRED EXCEEDS SPECIFIED MFL PSYSTM 166 EQ ABT PSYSTM 167 PSYSTM 168 LOC *O PSYSTM 169 TMSG SPACE 4,10 PSYSTM 170 ** TMSG - TABLE OF DAYFILE MESSAGES. PSYSTM 171 * PSYSTM 172 * NOTE THAT THE LENGTHS OF THE MESSAGES MUST BE EVEN. PSYSTM 173 PSYSTM 174 PSYSTM 175 MSGA DATA C* AT LINE +++++ IN --------- //////////.* PSYSTM 176 MSGB DATA C* IN --------- //////////.* PSYSTM 177 MSGD DATA C* VALUE OUT OF RANGE.* PSYSTM 178 MSGE DATA C* INDEX OR CASE EXPR OUT OF RANGE. * PSYSTM 179 MSGF DATA C* DIVISION BY ZERO.* PSYSTM 180 MSGH DATA C* INCORRECT POINTER REFERENCE. * PSYSTM 181 MSGI DATA C* TOO MANY PROGRAM PARAMETERS. * PSYSTM 182 MSGJ DATA C* HALT.* PSYSTM 183 MSGK DATA C* LINELIMIT EXCEEDED ON =======. * PSYSTM 184 MSGL DATA C* TRIED TO READ ======= PAST EOS/EOF.* PSYSTM 185 MSGM DATA C* TRIED TO WRITE ======= WITHOUT REWRITE.* PSYSTM 186 MSGN DATA C* INTEGER LARGER THAN MAXINT.* PSYSTM 187 MSGO DATA C* BUFFER TOO SMALL ON =======. * PSYSTM 188 MSGP DATA C* XXXXXXB LOAD FL, XXXXXXB START FL. * PSYSTM 189 MSGQ DATA C* MEMORY REQUIRED EXCEEDS SPECIFIED MFL. * PSYSTM 190 MSGR DATA C* PASCAL SYSTEM ERROR. * PSYSTM 191 MSGS DATA C* NON-DIGIT FOUND WHILE READING =======. * PSYSTM 192 MSGT DATA C* VALUE TOO LARGE WHILE READING =======. * PSYSTM 193 MSGU DATA C* INTERNAL FILE LIMIT EXCEEDED.* PSYSTM 194 MSGV DATA C* INCOMPATIBLE VERSION OF PASCLIB USED.* PSYSTM 195 MSGAA DATA C* AAAAA.BBB CP SECS, XXXXXXB MAX CM USED.* PSYSTM 196 MSGAB DATA C* TRIED TO READ ======= WITHOUT RESET. * PSYSTM 197 MSGAC DATA C* UNDEFINED VALUE TO WRITE ON =======. * PSYSTM 198 MSGAD DATA C* MOD BY NON-POSITIVE MODULO.* PSYSTM 199 MSGAE DATA C* TRIED TO CHECK EOLN WHILE AT EOS/EOF.* PSYSTM 200 MSGAF DATA C* XXXXXXB HIGHEST FIELD LENGTH.* PSYSTM 201 MSGAG DATA C* INCONSISTENT NODE REFERENCE. * PSYSTM 202 PSYSTM 203 SCOPE2 IFNE SCOPE2,0 PSYSTM 204 MSGRMA DATA C* RECORD MANAGER ERROR NNNNNN ON FILE =======. * PSYSTM 205 MSGRMB DATA C* FILE ======= MUST BE SEQUENTIAL, RT IN [W,S,Z,F,U].* PSYSTM 206 MSGRMC DATA C* MRL ON FILE CARD FOR ======= EXCEEDS BUFLEN. * PSYSTM 207 MSGRMD DATA C* INVALID RECORD TYPE FOR SKIP ON =======. * PSYSTM 208 MSGRMG DATA C* ATTEMPT TO SKIP ======= PAST EOF/EOI.* PSYSTM 209 SCOPE2 ENDIF PSYSTM 210 TIOE SPACE 4,10 PSYSTM 211 ** TIOE - TABLE OF INPUT/OUTPUT ERRORS. PSYSTM 212 PSYSTM 213 PSYSTM 214 TIOE BSS 0 PSYSTM 215 LOC 0 PSYSTM 216 PSYSTM 217 IOEA CON MSGK LINELIMIT EXCEEDED ON XXXXXXX. PSYSTM 218 IOEB CON MSGL TRIED TO READ XXXXXXX PAST EOS/EOF. PSYSTM 219 IOEC CON MSGM TRIED TO WRITE XXXXXXX WITHOUT REWRITE. PSYSTM 220 IOED CON MSGO BUFFER TOO SMALL ON XXXXXXX. PSYSTM 221 IOEE CON MSGS NON-DIGIT FOUND WHILE READING XXXXXXX. PSYSTM 222 IOEF CON MSGT VALUE TOO LARGE WHILE READING XXXXXXX. PSYSTM 223 IOEG CON MSGAB TRIED TO READ XXXXXXX WITHOUT RESET. PSYSTM 224 IOEH CON MSGAC UNDEFINED VALUE TO WRITE ON XXXXXXX. PSYSTM 225 PSYSTM 226 SCOPE2 IFNE SCOPE2,0 PSYSTM 227 RMIOEA CON MSGRMA RECORD MAN ERROR ON FILE XXXXXXX. PSYSTM 228 RMIOEB CON MSGO BUFFER TOO SMALL ON XXXXXXX. PSYSTM 229 RMIOEC CON MSGRMB FILE XXXXXXX MUST BE FO=SQ, RT=W,S,Z,U. PSYSTM 230 RMIOED CON MSGRMC FILE CARD SPECIFIES MRL>PASCAL BUFFER. PSYSTM 231 RMIOEE CON MSGRMD INVALID RT FOR SKIP ON XXXXXXX. PSYSTM 232 RMIOEH CON MSGRMG ZERO SKIP COUNT ON XXXXXXX. PSYSTM 233 SCOPE2 ENDIF PSYSTM 234 PSYSTM 235 LOC *O PSYSTM 236 PSYSTM TITLE RUN TIME ROUTINES. PSYSTM 237 P.ACV SPACE 4,15 PSYSTM 238 ** P.ACV - ALLOCATE AND COPY VALUE PARAMETER. PSYSTM 239 * PSYSTM 240 * ENTRY (X1) = SIZE OF VALUE. PSYSTM 241 * (X2) = SOURCE FWA. PSYSTM 242 * (B1) = 1. PSYSTM 243 * PSYSTM 244 * EXIT DESTINATION ALLOCATED. PSYSTM 245 * VALUE COPIED INTO DESTINATION. PSYSTM 246 * (X6) = DESTINATION FWA. PSYSTM 247 * PSYSTM 248 * USES X - ALL. PSYSTM 249 * A - 1, 2, 3, 4, 5, 6, 7. PSYSTM 250 * B - 2, 3, 7. PSYSTM 251 * PSYSTM 252 * CALLS P.ALM. PSYSTM 253 PSYSTM 254 PSYSTM 255 ACV ROUTINE P.ACV ENTRY/EXIT PSYSTM 256 LX2 18 PSYSTM 257 BX6 X1+X2 PSYSTM 258 SA6 ACVA SAVE SOURCE FWA AND VALUE SIZE PSYSTM 259 RJ =XP.ALM ALLOCATE MEMORY PSYSTM 260 SA1 ACVA PSYSTM 261 SB7 X1 SIZE PSYSTM 262 AX1 18 SOURCE FWA PSYSTM 263 ZR B7,ACVX IF SIZE = 0 PSYSTM 264 SX1 X1-1 V41CC01 6 ACV1 SA3 X1+B7 V41CC01 7 SB7 B7-B1 V41CC01 8 BX7 X3 PSYSTM 267 SA7 X6+B7 PSYSTM 268 NZ B7,ACV1 IF MORE TO COPY PSYSTM 269 EQ ACVX RETURN PSYSTM 270 PSYSTM 271 ACVA SCRATCH 1 PSYSTM 272 P.CFV SPACE 4,25 PSYSTM 273 ** P.CFV - COMMISSION FILE VARIABLE. PSYSTM 274 * PSYSTM 275 * ENTRY (X1) = 51/0, 9/DISPOSITION CODE FOR EFET. PSYSTM 276 * (X2) = FORMAL FILE NAME (1-7 CHARS, ZERO FILLED), IF PSYSTM 277 * PROGRAM-PARAMETER BIT (EPROGPAR) IS SET IN (X1). PSYSTM 278 * (A5) = SYSTEM PARAMETER LOCATION IN LOW CORE, IF PSYSTM 279 * PROGRAM-PARAMETER BIT (EPROGPAR) IS SET IN (X1). PSYSTM 280 * (A5) = 1, IF FORMAL NAME NOT TO BE SET IN LOW CORE. V41DC06 49 * (X5) = ((A5)), IF PROGRAM-PARAMETER BIT IS SET IN (X1). PSYSTM 281 * (X6) = LRL (FILE ELEMENT SIZE). PSYSTM 282 * (B1) = 1. PSYSTM 283 * (B3) = EFET ADDRESS. PSYSTM 284 * (B7) = BUFFER SIZE. PSYSTM 285 * PSYSTM 286 * EXIT EFET INITIALIZED. PSYSTM 287 * CIO BUFFER ALLOCATED. PSYSTM 288 * (B2) UNCHANGED. PSYSTM 289 * PSYSTM 290 * USES X - ALL. PSYSTM 291 * A - 1, 2, 3, 4, 5, 6, 7. PSYSTM 292 * B - 2, 3, 7. PSYSTM 293 * PSYSTM 294 * CALLS OPE, P.ALM, SRS, SWS. PSYSTM 295 PSYSTM 296 PSYSTM 297 * OPEN PERSISTENT FILE NOT BOUND TO *INPUT*. PSYSTM 298 PSYSTM 299 CFV3 RJ SWS SET WRITE STATUS PSYSTM 300 PSYSTM 301 CFV ROUTINE P.CFV ENTRY/EXIT PSYSTM 302 PSYSTM 303 * SAVE DISPOSITION CODE AND LRL IN EFET. PSYSTM 304 PSYSTM 305 LX1 EDISPC V41CC05 7 ERRNZ ELRL SHIFT X6 V41CC05 8 BX6 X6+X1 9/DISPOSITION CODE, 33/0, 18/LRL PSYSTM 307 PSYSTM 308 SCOPE2 IFNE SCOPE2,0 PSYSTM 309 SX7 B7 PSYSTM 310 LX7 EWSALEN PSYSTM 311 BX6 X6+X7 PSYSTM 312 SCOPE2 ENDIF PSYSTM 313 PSYSTM 314 ERRNZ EFET FIX NEXT LINE PSYSTM 315 SA6 B3 PSYSTM 316 LX1 59-EPROGPAR PSYSTM 317 BX7 X7-X7 ASSUME ZERO FILE NAME PSYSTM 318 PL X1,CFV1 IF NOT PROGRAM PARAMETER PSYSTM 319 BX7 X2 FILE NAME PSYSTM 320 SX0 A5-1 V41DC06 50 ZR X0,CFV1 IF FORMAL NAME NOT TO BE SUBSTITUTED V41DC06 51 PSYSTM 321 * SUBSTITUTE FORMAL NAME IN LOW CORE AND ACTUAL IN FET. PSYSTM 322 PSYSTM 323 SCOPE2 IFNE SCOPE2,1 PSYSTM 324 SX6 B3+EFETFET FET ADDRESS PSYSTM 325 SCOPE2 ELSE PSYSTM 326 SX6 B3+EFITFIT PSYSTM 327 SCOPE2 ENDIF PSYSTM 328 PSYSTM 329 BX6 X6+X7 42/FORMAL NAME, 18/FET ADDR PSYSTM 330 SA6 A5 PSYSTM 331 ZR X5,CFV1 IF NO ACTUAL NAME PSYSTM 332 MX0 7*6 PSYSTM 333 BX7 X0*X5 ACTUAL NAME FOR FET PSYSTM 334 PSYSTM 335 * ALLOCATE BUFFER. PSYSTM 336 V41DC06 52 CFV1 BSS 0 V41DC06 53 PSYSTM 337 SCOPE2 IFNE SCOPE2,1 PSYSTM 338 SA7 B3+B1 FET+0 V41DC06 54 ERRNZ EFETFET-1 FIX PREVIOUS LINE PSYSTM 340 SCOPE2 ELSE PSYSTM 341 SA7 B3+EFITFIT V41DC06 55 SCOPE2 ENDIF PSYSTM 343 PSYSTM 344 SX1 B7 PSYSTM 345 SX6 B3 PSYSTM 346 LX6 -18 PSYSTM 347 BX6 X6+X1 18/B3,18/0,6/0,18/B7 PSYSTM 348 SX7 B2 PSYSTM 349 LX6 2*18 PSYSTM 350 BX6 X6+X7 6/0,18/B7,18/B3,18/B2 PSYSTM 351 SA6 CFVA SAVE B-REGISTERS PSYSTM 352 RJ =XP.ALM ALLOCATE MEMORY ((X1) = SIZE) PSYSTM 353 PSYSTM 354 * INITIALIZE FET. PSYSTM 355 PSYSTM 356 SA1 CFVA RESTORE B-REGISTERS PSYSTM 357 SB2 X1 PSYSTM 358 AX1 18 PSYSTM 359 SB3 X1 PSYSTM 360 AX1 18 PSYSTM 361 PSYSTM 362 SCOPE2 IFNE SCOPE2,1 PSYSTM 363 SX2 FETSZ-5 PSYSTM 364 LX2 18 PSYSTM 365 BX7 X6+X2 42/FETSZ-5,18/FIRST PSYSTM 366 SA7 B3+EFETFRST PSYSTM 367 SA6 A7+B1 IN := FIRST PSYSTM 368 SA6 A6+B1 OUT := FIRST PSYSTM 369 IX7 X6+X1 FIRST + BUFFER LENGTH PSYSTM 370 SA7 A6+B1 LIMIT PSYSTM 371 SA2 B3+EFETFET FILE NAME PSYSTM 372 RJ OPE OPEN EFET PSYSTM 373 SA1 X2-EFETFET PSYSTM 374 SCOPE2 ELSE PSYSTM 375 SX7 X6 X6 IS ADDR BUFFER = WSA PSYSTM 376 LX6 BUFADDR PSYSTM 377 BX6 X6+X7 X6 = 24/0,18/WSA,18/WSA PSYSTM 378 SA7 B3+EFITIN SET IN/OUT POINTER TO WSA PSYSTM 379 SA6 B3+EFITBUF PSYSTM 380 SA2 B3+EFITFIT FILE NAME PSYSTM 381 RJ OPE OPEN EFET PSYSTM 382 SA1 X2-EFITFIT PSYSTM 383 SCOPE2 ENDIF PSYSTM 384 PSYSTM 385 LX1 59-EPERSIST PSYSTM 386 PL X1,CFV2 IF NON-PERSISTENT FILE PSYSTM 387 SA3 X2 FET+0 PSYSTM 388 MX0 42 PSYSTM 389 BX3 X0*X3 EXTRACT FILE NAME PSYSTM 390 SA4 =5LINPUT PSYSTM 391 BX4 X4-X3 PSYSTM 392 NZ X4,CFV3 IF FILE NAME <> *INPUT* PSYSTM 393 PSYSTM 394 * INITIALIZE EFET BOUND TO *INPUT*. PSYSTM 395 PSYSTM 396 LX1 EPERSIST-59 RESTORE X1 PSYSTM 397 MX6 1 PSYSTM 398 LX6 ESEGMENT-59 PSYSTM 399 BX6 X6+X1 SET SEGMENTED-FILE BIT PSYSTM 400 SA6 A1 PSYSTM 401 RJ SRS SET READ STATUS PSYSTM 402 EQ CFVX RETURN PSYSTM 403 PSYSTM 404 * INITIALIZE NON-PERSISTENT FILES. PSYSTM 405 PSYSTM 406 CFV2 RJ SRS SET READ STATUS PSYSTM 407 EQ CFVX RETURN PSYSTM 408 PSYSTM 409 CFVA SCRATCH 1 PSYSTM 410 P.CLOCK SPACE 4,10 PSYSTM 411 ** P.CLOCK - RETURN CP TIME IN MILLISECONDS. PSYSTM 412 * PSYSTM 413 * ENTRY (B1) = 1. PSYSTM 414 * PSYSTM 415 * EXIT (X6) = CP TIME IN MILLISECONDS. PSYSTM 416 * PSYSTM 417 * USES X - 1, 2, 3, 4, 6, 7. PSYSTM 418 * A - 1, 2, 6. PSYSTM 419 * PSYSTM 420 * MACROS TIME. PSYSTM 421 PSYSTM 422 PSYSTM 423 CLK ROUTINE P.CLOCK ENTRY/EXIT PSYSTM 424 TIME CLKA PSYSTM 425 MX1 -12 PSYSTM 426 SA2 CLKA PSYSTM 427 MX3 -24 PSYSTM 428 BX4 -X1*X2 0 <= MILLISECONDS < 1000D PSYSTM 429 AX2 12 PSYSTM 430 SX6 1000D PSYSTM 431 BX3 -X3*X2 SECONDS PSYSTM 432 IX7 X6*X3 PSYSTM 433 NO PSYSTM 434 IX6 X4+X7 TOTAL MILLISECONDS PSYSTM 435 EQ CLKX RETURN PSYSTM 436 PSYSTM 437 CLKA BSS 1 TEMPORARY PSYSTM 438 P.CLO SPACE 4,20 PSYSTM 439 ** P.CLO - CLOSE EFET. PSYSTM 440 * PSYSTM 441 * ENTRY (A1) = EFET ADDRESS. PSYSTM 442 * (X1) = ((A1)). PSYSTM 443 * PSYSTM 444 * EXIT (B2) UNCHANGED. PSYSTM 445 * IF PERSISTENT, THE BUFFER IS FLUSHED; PSYSTM 446 * IF NON-PERSISTENT, THE FILE IS RETURNED OR UNLOADED. PSYSTM 447 * FET MAY BE BUSY. PSYSTM 448 * PSYSTM 449 * USES X - ALL. PSYSTM 450 * A - 1, 2, 3, 4, 5, 6, 7. PSYSTM 451 * B - 3, 7. PSYSTM 452 * PSYSTM 453 * CALLS FOB. PSYSTM 454 * PSYSTM 455 * MACROS CLOSE, CLOSEM, FETCH, RETURN. PSYSTM 456 PSYSTM 457 PSYSTM 458 CLO1 LX1 EPERSIST-ECONNECT V41EC07 9 PL X1,CLO2 IF NOT CONNECTED V41EC07 10 RJ FOB FLUSH OUTPUT BUFFER V41EC07 11 CLO2 BSS 0 V41EC07 12 V41EC07 13 NOS IFNE KRONOS+NOS1+NOS2,0 V41AC01 19 RETURN X2,R RETURN FILE V41EC07 14 NOS ENDIF PSYSTM 461 PSYSTM 462 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 463 CLOSE X2,UNLOAD,R UNLOAD FILE V41EC07 15 NOSBE ENDIF PSYSTM 465 PSYSTM 466 SCOPE2 IFNE SCOPE2,0 PSYSTM 467 CLOSEM X2,U UNLOAD FILE V41EC07 16 SCOPE2 ENDIF PSYSTM 469 PSYSTM 470 CLO ROUTINE P.CLO ENTRY/EXIT PSYSTM 471 PSYSTM 472 SCOPE2 IFNE SCOPE2,1 PSYSTM 473 ERRNZ EFETFET-1 FIX NEXT LINE PSYSTM 474 SX2 A1+B1 PSYSTM 475 SCOPE2 ELSE PSYSTM 476 SX2 A1+EFITFIT X2 := ADDR(FIT[0]) PSYSTM 477 FETCH X2,OC,X5 X5 := 0-NEVER OPEN;1-OPEN;10-CLOSED PSYSTM 478 LX5 -1 PSYSTM 479 PL X5,CLOX IF FILE ALREADY CLOSED PSYSTM 480 SCOPE2 ENDIF PSYSTM 481 PSYSTM 482 LX1 59-EPERSIST PSYSTM 483 PL X1,CLO1 IF NON-PERSISTENT FILE PSYSTM 484 RJ FOB FLUSH OUTPUT BUFFER PSYSTM 485 PSYSTM 486 SCOPE2 IFNE SCOPE2,0 PSYSTM 487 SA3 =5LINPUT PSYSTM 488 SA4 X2 PSYSTM 489 MX0 42 PSYSTM 490 BX4 X0*X4 PSYSTM 491 BX3 X4-X3 PSYSTM 492 ZR X3,CLOX IF ACTUAL FILE *INPUT* PSYSTM 493 SA3 =6LOUTPUT PSYSTM 494 BX3 X4-X3 PSYSTM 495 ZR X3,CLOX IF ACTUAL FILE *OUTPUT* PSYSTM 496 CLOSEM X2,N CLOSE FILE WITH NO REWIND PSYSTM 497 SCOPE2 ENDIF PSYSTM 498 PSYSTM 499 EQ CLOX RETURN PSYSTM 500 P.CPV SPACE 4,15 PSYSTM 501 ** P.CPV - COPY PARAMETER VALUE. PSYSTM 502 * PSYSTM 503 * ENTRY (X1) = SIZE OF VALUE. PSYSTM 504 * (X2) = VALUE SOURCE FWA. PSYSTM 505 * (X3) = VALUE DESTINATION FWA. PSYSTM 506 * (B1) = 1. PSYSTM 507 * PSYSTM 508 * EXIT VALUE COPIED INTO DESTINATION. PSYSTM 509 * (X1) = FIRST WORD OF COPIED VALUE. PSYSTM 510 * PSYSTM 511 * USES X - 1, 7. PSYSTM 512 * A - 1, 7. PSYSTM 513 * B - 7. PSYSTM 514 PSYSTM 515 PSYSTM 516 CPV1 SB7 B7-B1 PSYSTM 517 SA1 X2+B7 PSYSTM 518 BX7 X1 PSYSTM 519 SA7 X3+B7 PSYSTM 520 NZ B7,CPV1 IF MORE TO COPY PSYSTM 521 PSYSTM 522 CPV ROUTINE P.CPV ENTRY/EXIT PSYSTM 523 SB7 X1+ PSYSTM 524 NZ X1,CPV1 IF SIZE <> 0 PSYSTM 525 EQ CPVX RETURN PSYSTM 526 P.DATE SPACE 4,15 V41CC10 35 ** P.DATE - RETURN SYSTEM DATE. PSYSTM 528 * PSYSTM 529 * ENTRY (X1) = ADDRESS TO RETURN SYSTEM DATE. PSYSTM 530 * PSYSTM 531 * EXIT ((X1)) = SYSTEM DATE. PSYSTM 532 * PSYSTM 533 * USES X - 1, 2, 3, 4, 5, 6. V41CC10 36 * A - 1, 4, 6. V41CC10 37 * V41CC10 38 * CALLS P.DWA. V41CC10 39 * PSYSTM 536 * MACROS DATE. PSYSTM 537 PSYSTM 538 PSYSTM 539 ASCII IFEQ ASCFLAG,1 V41CC22 6 DTEZ SET DCALFALN-ASALFALN V41CC22 7 ASCII ENDIF V41CC22 8 V41CC22 9 DTE ROUTINE P.DATE ENTRY/EXIT PSYSTM 540 PSYSTM 541 OS IFNE KRONOS+NOS1+NOS2+NOSBE+SCOPE34,0 V41CC10 40 ASCII IFNE ASCFLAG,1 V41CC10 41 DATE X1 V41CC10 42 ASCII ELSE V41CC10 43 BX5 X1 V41CC10 44 DATE DTEA V41CC10 45 SA1 DTEA V41CC10 46 SX2 ASALFALN V41CC10 47 RJ =XP.DWA CONVERT DISPLAY CODE WORD TO ASCII V41CC10 48 SA6 X5 STORE FIRST PART OF DATE V41CC10 49 SX2 DTEZ DCALFALN-ASALFALN V41CC22 10 RJ =XP.DWA CONVERT DISPLAY CODE WORD TO ASCII V41CC10 51 SA4 X5+B1 V41CC10 52 MX3 DTEZ*ASCHARSZ (DCALFALN-ASALFALN)*ASCHARSZ V41CC22 11 BX4 -X3*X4 V41CC10 54 BX6 X4+X6 V41CC10 55 SA6 A4 STORE REMAINDER OF DATE V41CC10 56 ASCII ENDIF V41CC10 57 OS ENDIF V41CC10 58 V41CC10 59 OS IFNE SCOPE2,0 V41CC10 60 BX6 X1 WE USE THE SAME REGISTERS JUST IN CASE PSYSTM 545 SA6 DTEA SAVE X1 PSYSTM 546 DATE DTEB PSYSTM 547 SA1 DTEB PSYSTM 548 BX6 X1 PSYSTM 549 SA1 DTEA PSYSTM 550 SA6 X1 PSYSTM 551 OS ENDIF V41CC10 61 PSYSTM 553 EQ DTEX RETURN PSYSTM 554 V41CC10 62 ASCII IFEQ ASCFLAG,1 V41CC10 63 DTEA SCRATCH 1 V41CC10 64 ASCII ENDIF V41CC10 65 PSYSTM 555 SCOPE2 IFNE SCOPE2,0 PSYSTM 556 DTEA SCRATCH 1 PSYSTM 557 DTEB SCRATCH 1 PSYSTM 558 SCOPE2 ENDIF PSYSTM 559 P.DFV SPACE 4,20 PSYSTM 560 ** P.DFV - DECOMMISSION FILE VARIABLE. PSYSTM 561 * PSYSTM 562 * ENTRY (A1) = EFET ADDRESS. PSYSTM 563 * (X1) = ((A1)). PSYSTM 564 * PSYSTM 565 * EXIT CIO BUFFER LIBERATED IF NON-PROGRAM PARAMETER. PSYSTM 566 * EFET AND FET DECOMMISSIONED. PSYSTM 567 * (B2) UNCHANGED. PSYSTM 568 * PSYSTM 569 * USES X - ALL. PSYSTM 570 * A - 1, 2, 3, 4, 5, 6, 7. PSYSTM 571 * B - 2, 3, 7. PSYSTM 572 * PSYSTM 573 * CALLS CLO, P.LIM. PSYSTM 574 * PSYSTM 575 * MACROS RECALL. PSYSTM 576 PSYSTM 577 PSYSTM 578 DFV ROUTINE P.DFV ENTRY/EXIT PSYSTM 579 RJ CLO CLOSE EFET PSYSTM 580 PSYSTM 581 SCOPE2 IFNE SCOPE2,1 PSYSTM 582 SA1 X2-EFETFET PSYSTM 583 SCOPE2 ELSE PSYSTM 584 SA1 X2-EFITFIT PSYSTM 585 SCOPE2 ENDIF PSYSTM 586 PSYSTM 587 LX1 59-EPROGPAR PSYSTM 588 NG X1,DFVX IF PROGRAM PARAMETER PSYSTM 589 PSYSTM 590 SCOPE2 IFNE SCOPE2,1 PSYSTM 591 RECALL X2 PSYSTM 592 ERRNZ EFETFRST-EFETFET-1 FIX NEXT LINE PSYSTM 593 SA1 X2+B1 PSYSTM 594 SCOPE2 ELSE PSYSTM 595 SA1 A1+EFITBUF PSYSTM 596 LX1 -BUFADDR PSYSTM 597 SCOPE2 ENDIF PSYSTM 598 PSYSTM 599 SX6 B2 PSYSTM 600 SX1 X1 ISOLATE FIRST (BUFFER FWA) PSYSTM 601 SA6 DFVA SAVE B2 PSYSTM 602 RJ =XP.LIM LIBERATE MEMORY PSYSTM 603 SA3 DFVA PSYSTM 604 SB2 X3 RESTORE B2 PSYSTM 605 EQ DFVX RETURN PSYSTM 606 PSYSTM 607 DFVA SCRATCH 1 PSYSTM 608 P.DISPD SPACE 4,10 PSYSTM 609 ** P.DISPD - TEST AND DEALLOCATE HEAP STORAGE. PSYSTM 610 * PSYSTM 611 * ENTRY (X1) = EXTENDED POINTER VALUE ($T+). PSYSTM 612 * PSYSTM 613 * EXIT NODE DEALLOCATED. PSYSTM 614 * PSYSTM 615 * USES X - 1, 2, 3, 4, 5, 6. PSYSTM 616 * A - 2, 4, 6. PSYSTM 617 * PSYSTM 618 * CALLS ABT, P.LIM. PSYSTM 619 PSYSTM 620 PSYSTM 621 TDS1 SA6 X1 ZERO FIRST WORD OF NODE PSYSTM 622 RJ =XP.LIM LIBERATE NODE PSYSTM 623 PSYSTM 624 TDS ROUTINE P.DISPD ENTRY/EXIT PSYSTM 625 SA2 =XP.TMEM+MEMFL CURRENT FIELD LENGTH PSYSTM 626 BX3 X1 SAVE ORIGINAL POINTER PSYSTM 627 SX1 X1-1 ADDRESS OF ACTUAL NODE. PSYSTM 628 IX5 X1-X2 PSYSTM 629 BX6 -X5+X1 PSYSTM 630 NG X6,TERA+PTRERR IF POINTER NOT IN FIELD LENGTH PSYSTM 631 SA4 X1 GET KEY FROM NODE PSYSTM 632 IX6 X4-X3 PSYSTM 633 ZR X6,TDS1 IF KEYS MATCH PSYSTM 634 EQ TERA+PTRERR INCORRECT POINTER REFERENCE PSYSTM 635 P.END SPACE 4,15 PSYSTM 636 ** P.END - RETURN CONTROL TO THE OPERATING SYSTEM. PSYSTM 637 * PSYSTM 638 * ENTRY (B1) = 1. PSYSTM 639 * PSYSTM 640 * EXIT TO OPERATING SYSTEM. PSYSTM 641 * PSYSTM 642 * USES ALL REGISTERS. PSYSTM 643 * PSYSTM 644 * CALLS ISM. PSYSTM 645 * PSYSTM 646 * MACROS ENDRUN. PSYSTM 647 PSYSTM 648 PSYSTM 649 END ENTER P.END ENTRY PSYSTM 650 SA1 =XP.PIT+PITFLAG PSYSTM 651 LX1 59-57 PSYSTM 652 PL X1,END1 IF NOT ISSUING STATISTICS PSYSTM 653 RJ ISM ISSUE STATISTICS MESSAGE PSYSTM 654 END1 ENDRUN PSYSTM 655 P.GETB SPACE 4,15 PSYSTM 656 ** P.GETB - GET BINARY. PSYSTM 657 * PSYSTM 658 * ENTRY (A1) = EFET ADDRESS. PSYSTM 659 * (X1) = ((A1)). PSYSTM 660 * PSYSTM 661 * EXIT (X2) = FET ADDRESS. PSYSTM 662 * (X3) = FILE POINTER, IF NOT EOS/EOF. PSYSTM 663 * (X5) = UNCHANGED. V41CC10 66 * (B2) = UNCHANGED. V41CC10 67 * PSYSTM 664 * USES X - 0, 1, 2, 3, 4, 6, 7. PSYSTM 665 * A - 1, 2, 3, 4, 6, 7. PSYSTM 666 * B - 3, 7. PSYSTM 667 * PSYSTM 668 * CALLS IOE, RWR. PSYSTM 669 * PSYSTM 670 * MACROS FETCH, GETW, GETWP, READ, RECALL. PSYSTM 671 PSYSTM 672 PSYSTM 673 SCOPE2 IFNE SCOPE2,1 PSYSTM 674 PSYSTM 675 GTB9 BX7 -X7+X6 PSYSTM 676 AX0 1 (LIMIT - FIRST) / 2 PSYSTM 677 NG X7,GTBX IF FET BUSY OR EOR/EOF/EOI PSYSTM 678 SB3 X0+ PSYSTM 679 GE B7,B3,GTBX IF BUFFER HALF FULL PSYSTM 680 PSYSTM 681 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 682 SA1 X2+B1 PSYSTM 683 AX1 54 DEVICE TYPE FROM FET PSYSTM 684 SX1 X1+77B-61B PSYSTM 685 ZR X1,GTBX IF FILE IS CONNECTED PSYSTM 686 NOSBE ENDIF PSYSTM 687 PSYSTM 688 READ X2 PSYSTM 689 PSYSTM 690 GTB ROUTINE P.GETB ENTRY/EXIT PSYSTM 691 SA3 A1+EFETFET+3 OUT V41CC05 9 LX1 59-EREWRITE V41CC05 10 ERRNZ EFETFET-1 FIX NEXT LINE V41CC05 11 SX2 A1+B1 FET PSYSTM 694 SA4 A3+B1 LIMIT PSYSTM 695 NG X1,RWR IF READ WITHOUT RESET V41CC13 8 LX1 EREWRITE-59 V41CC05 12 ERRNZ EEOSF-59 SHIFT X1 V41CC05 13 NG X1,GTB7 IF READ AT EOS/EOF PSYSTM 698 ERRNZ ELRL SHIFT X1 V41CC05 14 SB3 X1 LRL PSYSTM 699 SX7 X3+B3 OUT + LRL PSYSTM 700 SX4 X4 LIMIT PSYSTM 701 SA1 X2+B1 FIRST PSYSTM 702 IX3 X7-X4 (OUT + LRL) - LIMIT PSYSTM 703 SX6 X1 FIRST PSYSTM 704 IX0 X4-X6 LIMIT - FIRST PSYSTM 705 PL X3,GTB1 IF OUT = LIMIT PSYSTM 706 SX6 X7 OUT + LRL PSYSTM 707 GTB1 SA6 A3 ADVANCE OUT PSYSTM 708 BX3 X6 PSYSTM 709 SA6 X2-EFETFET+EFETPTR ADVANCE FILE POINTER V41CC05 15 GTB2 SA1 X2 FET PSYSTM 711 LX7 X1 SAVE FET PSYSTM 712 SA1 A3-B1 IN PSYSTM 713 IX6 X1-X3 IN - OUT PSYSTM 714 PL X6,GTB3 IF IN >= OUT PSYSTM 715 IX6 X6+X0 PSYSTM 716 GTB3 SB7 X6 FULL SPACE IN BUFFER PSYSTM 717 LX7 59-0 COMPLETE BIT PSYSTM 718 SX6 X7 PSYSTM 719 LX6 0-4 EOR BIT PSYSTM 720 GE B7,B3,GTB9 IF BUFFER NOT EMPTY PSYSTM 721 SX1 X2-EFETFET ADDRESS OF EFET V41CC05 16 NG X7,GTB4 IF FET NOT BUSY PSYSTM 723 RECALL PSYSTM 724 EQ GTB2 TRY AGAIN PSYSTM 725 PSYSTM 726 GTB4 PL X6,GTB6 IF NOT EOR PSYSTM 727 MX4 2 PSYSTM 728 BX4 X4*X6 EXTRACT EOR/EOF BITS PSYSTM 729 PSYSTM 730 NOS IFNE KRONOS+NOS1+NOS2,0 V41AC01 20 MX6 -4 PSYSTM 732 LX7 60-59+0-14 RIGHT ADJUST EOR LEVEL NUMBER PSYSTM 733 BX6 -X6*X7 EOR LEVEL PSYSTM 734 SB7 X6 PSYSTM 735 EQ B7,B1,GTB6 IF LEVEL 1 EOR (INTERACTIVE INPUT) PSYSTM 736 NOS ENDIF PSYSTM 737 PSYSTM 738 SA1 X1 EFET PSYSTM 739 LX1 59-ESEGMENT V41CC05 17 NG X1,GTB5 IF SEGMENTED FILE PSYSTM 741 LX7 X4,B1 PSYSTM 742 AX4 X7,B1 PSYSTM 743 GTB5 PL X4,GTB6 IF NOT EOS/EOF PSYSTM 744 SA1 X2-EFETFET EFET V41CC05 18 ERRNZ EEOSF-59 FIX X4 V41CC05 19 ERRNZ EEOF-58 FIX X4 V41CC05 20 BX6 X1+X4 PSYSTM 746 SA6 A1 SET EOS AND/OR EOF BITS PSYSTM 747 EQ GTBX RETURN PSYSTM 748 PSYSTM 749 GTB6 READ X2 FILL THE BUFFER PSYSTM 750 EQ GTB2 TRY AGAIN PSYSTM 751 PSYSTM 752 SCOPE2 ENDIF PSYSTM 753 PSYSTM 754 GTB7 SX1 IOEB READ AT EOS/EOF ON XXXXXXX. PSYSTM 755 EQ IOE1 ISSUE INPUT/OUTPUT ERROR PSYSTM 756 PSYSTM 757 SCOPE2 IFNE SCOPE2,0 PSYSTM 758 PSYSTM 759 GTB ROUTINE P.GETB ENTRY/EXIT PSYSTM 760 SX2 A1+EFITFIT PSYSTM 761 PSYSTM 762 * CHECK READ WITHOUT RESET, EOS/EOF BITS. PSYSTM 763 PSYSTM 764 LX1 59-EREWRITE FOR RESET V41CC05 21 NG X1,RWR IF READ WITHOUT RESET V41CC13 9 LX1 EREWRITE-59 V41CC05 22 ERRNZ EEOSF-59 SHIFT X1 V41CC05 23 NG X1,GTB7 IF READ AT EOS/EOF PSYSTM 768 PSYSTM 769 * INCREMENT BUFFER POINTERS. PSYSTM 770 PSYSTM 771 SA3 A1+EFETIN X3 := IN V41CC05 24 ERRNZ ELRL SHIFT X1 V41CC05 25 SX1 X1 X1 := LRL PSYSTM 773 IX7 X1+X3 PSYSTM 774 SA7 A3 IN := IN + LRL PSYSTM 775 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 26 SA7 A1-B1 EFET[-1] := IN (NON-TEXT FILES) PSYSTM 776 BX3 X7 FOR EXIT PSYSTM 777 PSYSTM 778 * CHECK IF INPUT BUFFER EXHAUSTED. PSYSTM 779 PSYSTM 780 ERRNZ EFITBUF-1 FIX NEXT LINE V41CC05 27 SA4 A1+B1 X4:=24/BUFLEN, 18/BUFADR, 18/EOR PSYSTM 781 SX4 X4 X4 := CURRENT EOR PSYSTM 782 IX7 X7+X1 IN + LRL PSYSTM 783 IX0 X4-X7 PSYSTM 784 PL X0,GTBX IF IN + LRL <= EOR PSYSTM 785 PSYSTM 786 * REFRESH INPUT BUFFER. FOR 7RM GET-MACROS SET:- PSYSTM 787 * X3 := BUFLEN (MAX RECORD LENGTH). PSYSTM 788 * X4 := BUFADR. PSYSTM 789 PSYSTM 790 ERRNZ EFITBUF-1 FIX NEXT LINE V41CC05 28 GTB0 SA3 A1+B1 PSYSTM 791 AX3 18 PSYSTM 792 SX4 X3 X4 := BUFADR PSYSTM 793 BX7 X4 PSYSTM 794 SA7 A1+EFITIN RESET IN := BUFADR V41CC05 29 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 30 SA7 A1-B1 EFET[-1] := IN (NON-TEXT FILES) PSYSTM 796 AX3 18 PSYSTM 797 SX3 X3 X3 := BUFLEN (MAX RECORD LENGTH) PSYSTM 798 SX2 A1+EFITFIT X2 := ADDR(FIT[0]) PSYSTM 799 PSYSTM 800 * CHECK RECORD TYPE FROM ERT FIELD IN EFET[0]. V41DC09 9 PSYSTM 802 SA1 A1 REFRESH X1 = EFET[0] V41DC09 10 MX0 -ERTW V41CC05 31 LX1 0-ERT RIGHT-JUSTIFY RT V41CC05 32 BX0 -X0*X1 V41CC05 33 SX5 X0-RTS PSYSTM 808 NZ X5,GTB2 IF NOT S-TYPE RECORDS PSYSTM 809 PSYSTM 810 * CHECK POSITIONING OF MULTI-BLOCKED S-TYPE RECORDS. PSYSTM 811 * MACRO FETCH DESTROYS X5, X6, X7, A5. PSYSTM 812 PSYSTM 813 FETCH X2,FP,X5 FETCH FILE POSITION PSYSTM 814 ZR X5,GTB1 IF FILE IN MID-RECORD PSYSTM 815 SX5 X5-FPEOP PSYSTM 816 PL X5,GTB6 IF NOT EOS/EOP/EOR PSYSTM 817 MX5 1 PSYSTM 818 SA1 X2-EFITFIT RETRIEVE DISP BITS PSYSTM 819 BX6 X1 PSYSTM 820 LX6 59-ESEGMENT V41CC05 34 PL X6,GTB1 IF NOT SEGMENTED PSYSTM 822 ERRNZ EEOSF-59 SHIFT X5 V41CC05 35 BX6 X5+X1 DISP[1] := EOS PSYSTM 823 SA6 A1 PSYSTM 824 EQ GTBX RETURN PSYSTM 825 PSYSTM 826 * GET PARTIAL S-TYPE RECORD. PSYSTM 827 PSYSTM 828 GTB1 GETWP X2,X4,X3,GTB6 *RJ GTB6* IF END OF DATA PSYSTM 829 EQ GTB5 PSYSTM 830 PSYSTM 831 * GET U, T, W, Z-TYPE RECORDS PSYSTM 832 PSYSTM 833 GTB2 GETW X2,X4,X3,GTB6.1 *RJ GTB6.1* IF END OF DATA PSYSTM 834 SA1 X2-EFITFIT A1 := ADDR(EFET[0]) PSYSTM 835 PSYSTM 836 * IGNORE EOL PROCESSING FOR U-TYPE RECORDS. PSYSTM 837 PSYSTM 838 SX5 X0-RTU PSYSTM 839 ZR X5,GTB5 IF U-TYPE RECORD PSYSTM 840 PSYSTM 841 * PROCESS ALL OTHER RECORD TYPES. PSYSTM 842 * GETW RETURNS X3 WITH 42/UNUSEDBITS, 18/WORDS TRANSFERRED. PSYSTM 843 PSYSTM 844 LX3 42 PSYSTM 845 SX6 X3 X6 := UNUSED BITS PSYSTM 846 LX3 18 PSYSTM 847 ZR X6,GTB3 NO UNUSED BITS PSYSTM 848 PSYSTM 849 * PROCESS PARTIALLY TRANSFERRED WORD. PSYSTM 850 * 1. MASK OUT UNUSED BITS IN BUFFER. PSYSTM 851 * IF TEXT-FILE THEN:- PSYSTM 852 * 2. IF <12 UNUSED FILL WITH 1 BLANK, APPEND 0-WORD PSYSTM 853 * IF =12 .. .. .. 2 BLANKS, APPEND 0-WORD. PSYSTM 854 * IF >12 .. AND LAST CHAR WAS COLON THEN PAD PSYSTM 855 * WITH SUFFICIENT BLANKS TO LEAVE 12 0-BITS PSYSTM 856 * AT THE END. PSYSTM 857 PSYSTM 858 SX3 X3 X3 := NO WORDS TRANSFERRED PSYSTM 859 SB3 X6-1 UNUSED BITS-1 PSYSTM 860 MX6 1 PSYSTM 861 AX6 X6,B3 FORM MASK FOR EACH UNUSED BIT PSYSTM 862 SB3 B3+B1 SAVE UNUSED BITS PSYSTM 863 LX6 X6,B3 PSYSTM 864 IX7 X4+X3 PSYSTM 865 SA2 X7-1 X2 := LAST WORD TRANSFERRED PSYSTM 866 BX7 -X6*X2 MASK OUT UNUSED PSYSTM 867 SA7 A2 RESTORE LAST WORD PSYSTM 868 LX1 59-ETEXT V41CC05 36 PL X1,GTB4.1 IF NOT A TEXT-FILE PSYSTM 870 PSYSTM 871 SB2 B3-60 PSYSTM 872 EQ B2,B0,GTB5 IF ALREADY ONE ZERO WORD PSYSTM 873 SB2 B3-12 PSYSTM 874 LT B2,B0,GTB2.2 IF LESS THEN 12 ZERO BITS PSYSTM 875 LX6 6 MASK TO UNCOVER LAST CHAR PSYSTM 876 BX5 X6*X7 X5 := LAST CHAR + ZERO BITS PSYSTM 877 NZ X5,GTB5 IF LASTCHAR<>COLON GO HOME PSYSTM 878 EQ B2,B0,GTB2.1 EXACTLY 12 ZERO BITS + COLON PSYSTM 879 SA5 =8L PSYSTM 880 AX6 6 PSYSTM 881 BX6 X6*X5 EXTRACT SUFFICIENT BLANKS LEAVING PSYSTM 882 BX7 X6+X7 12 0-BITS PSYSTM 883 SA7 A7 PAD WITH BLANKS PSYSTM 884 EQ GTB5 PSYSTM 885 PSYSTM 886 GTB2.1 SX6 2R PAD WITH TWO BLANKS PSYSTM 887 EQ GTB2.3 PSYSTM 888 PSYSTM 889 GTB2.2 SX6 1R PAD WITH ONE BLANK PSYSTM 890 GTB2.3 BX7 X7+X6 PSYSTM 891 SA7 A7 PSYSTM 892 EQ GTB4 APPEND 1 ZERO-WORD PSYSTM 893 PSYSTM 894 * PROCESS COMPLETE TRANSFER. PSYSTM 895 * IF TEXT-FILE THEN PSYSTM 896 * IF 12 0-BITS LEAVE ALONE PSYSTM 897 * ELSE APPEND 1 ZERO-WORD. PSYSTM 898 PSYSTM 899 GTB3 BSS 0 PSYSTM 900 LX1 59-ETEXT V41CC05 37 PL X1,GTB4.1 IF NOT A TEXT-FILE PSYSTM 902 PSYSTM 903 MX6 12 CHECK IF LAST 12 BITS ARE ALREADY 0 PSYSTM 904 IX7 X4+X3 PSYSTM 905 LX6 12 PSYSTM 906 SA2 X7-1 EXTRACT LAST WORD PSYSTM 907 BX5 X2*X6 PSYSTM 908 ZR X5,GTB5 IF LAST 12 BITS ARE ZERO PSYSTM 909 PSYSTM 910 GTB4 MX6 0 APPEND ONE WHOLE WORD OF ZEROES PSYSTM 911 SA6 A2+B1 PSYSTM 912 SX3 X3+B1 INCREMENT RECORD LENGTH PSYSTM 913 EQ GTB5 PSYSTM 914 PSYSTM 915 GTB4.1 SA1 A1 REFRESH X1 := EFET[0] PSYSTM 916 LX1 59-ESEGMENT V41CC05 38 PL X1,GTB5 IF NOT SEGMENTED PSYSTM 918 ZR X3,GTB0 IF SEGMENTED AND EMPTY RECORD PSYSTM 919 PSYSTM 920 * UPDATE BUFFER DESCRIPTOR. PSYSTM 921 PSYSTM 922 ERRNZ EFITBUF-1 FIX NEXT LINE V41CC05 39 GTB5 SA5 A1+B1 X5 := DESCRIPTOR PSYSTM 923 AX5 18 PSYSTM 924 IX6 X4+X3 EOR := BUFADR+RECORD LENGTH PSYSTM 925 LX5 18 PSYSTM 926 BX6 X6+X5 PSYSTM 927 SA6 A5 EFET[1]:=BUFLEN/BUFADR/EOR PSYSTM 928 SA1 A1 PSYSTM 929 ERRNZ EFITIN-2 FIX NEXT LINE V41CC05 40 SA3 A5+B1 X3 := IN PSYSTM 930 SX2 A1+EFITFIT X2 := ADDR(FIT[0]) PSYSTM 931 EQ GTBX RETURN PSYSTM 932 PSYSTM 933 * PROCESS END OF DATA FOR S-TYPE RECORDS. PSYSTM 934 PSYSTM 935 GTB6 PS ENTRY/EXIT PSYSTM 936 MX5 2 PSYSTM 937 SA1 A1 PSYSTM 938 ERRNZ EEOSF-59 FIX X5 V41CC05 41 ERRNZ EEOF-58 FIX X5 V41CC05 42 BX6 X5+X1 SET EOS/EOF FOR S-TYPE FILE PSYSTM 939 SA6 A1 IN DISP FIELD OF EFET[0] PSYSTM 940 BX1 X6 FOR EXIT PSYSTM 941 SX2 A1+EFITFIT X2 := ADDR(FIT[0]) PSYSTM 942 EQ GTBX RETURN PSYSTM 943 PSYSTM 944 * PROCESS END OF DATA FOR W,U-TYPE RECORDS. PSYSTM 945 PSYSTM 946 GTB6.1 PS ENTRY/EXIT PSYSTM 947 FETCH X2,FP,X5 FETCH FILE POSITION PSYSTM 948 MX3 2 PSYSTM 949 SA1 A1 X1 := EFET[0] PSYSTM 950 SX5 X5-FPEOP PSYSTM 951 PL X5,GTB6.2 IF EOI THEN SET EOS/EOF FLAG PSYSTM 952 BX5 X1 PSYSTM 953 LX5 59-ESEGMENT ELSE IF NOT SEGMENTED V41CC05 43 PL X5,GTB2 RE-READ NEXT SECTION/PARTITION PSYSTM 955 MX3 1 ELSE SET EOS FLAG PSYSTM 956 GTB6.2 BSS 0 V41CC05 44 ERRNZ EEOSF-59 FIX X3 V41CC05 45 ERRNZ EEOF-58 FIX X3 V41CC05 46 BX6 X3+X1 V41CC05 47 SA6 A1 UPDATE DISP FIELD OF EFET[0] PSYSTM 958 BX1 X6 PSYSTM 959 SX2 A1+EFITFIT X2 := ADDR(FIT[0]) PSYSTM 960 EQ GTBX RETURN PSYSTM 961 PSYSTM 962 SCOPE2 ENDIF PSYSTM 963 P.GETC SPACE 4,15 PSYSTM 964 ** P.GETC - GET CHARACTER. PSYSTM 965 * PSYSTM 966 * ENTRY (A1) = EFET ADDRESS + EFETPTR. V41CC05 48 * (X1) = ((A1)). PSYSTM 968 * PSYSTM 969 * EXIT (X2) = FET ADDRESS. PSYSTM 970 * PSYSTM 971 * USES X - 0, 1, 2, 3, 4, 6, 7. PSYSTM 972 * A - 1, 2, 3, 4, 6, 7. PSYSTM 973 * B - 2, 3, 7. V41CC10 68 * PSYSTM 975 * CALLS GCH. PSYSTM 976 PSYSTM 977 PSYSTM 978 GTC ROUTINE P.GETC ENTRY/EXIT PSYSTM 979 SA3 X1+B1 NEW CHARACTER OR END OF BUFFER PSYSTM 980 V41CC10 69 ASCII IFNE ASCFLAG,1 V41CC10 70 SX6 X1+B1 ADVANCE POINTER PSYSTM 981 SA6 A1+ UPDATE POINTER PSYSTM 982 ASCII ELSE V41CC10 71 SX4 B1 V41CC10 72 IX6 X4+X1 ADVANCE POINTER V41CC10 73 LX1 59-PREWRITE LEFT-ADJUST REWRITE BIT V41CC10 74 BX0 X1+X3 V41CC10 75 SA6 A1 UPDATE POINTER V41CC10 76 ASCII ENDIF V41CC10 77 PSYSTM 983 SCOPE2 IFNE SCOPE2,1 PSYSTM 984 SX2 A1+EFETFET-EFETPTR FET PSYSTM 985 SCOPE2 ELSE PSYSTM 986 SX2 A1+EFITFIT-EFETPTR FIT PSYSTM 987 SCOPE2 ENDIF PSYSTM 988 PSYSTM 989 ASCII IFNE ASCFLAG,1 V41CC10 78 PL X3,GTCX IF BUFFER NOT EMPTY V41CC10 79 ASCII ELSE V41CC10 80 PL X0,GTCX IF BUFFER NOT EMPTY V41CC10 81 ASCII ENDIF V41CC10 82 V41CC10 83 SX7 GTCX RETURN ADDRESS PSYSTM 991 V41CC10 84 ASCII IFNE ASCFLAG,1 V41CC10 85 EQ GCH CALL HELPER TO FILL BUFFER V41CC10 86 ASCII ELSE V41CC10 87 * EQ GCH FALL THROUGH TO HELPER TO FILL BUFFER V41CC10 88 ASCII ENDIF V41CC10 89 P.GETCH SPACE 4,20 PSYSTM 993 ** P.GETCH - GET CHARACTER HELPER. PSYSTM 994 * PSYSTM 995 * ENTRY (A1) = EFET ADDRESS + EFETPTR. V41CC05 49 * (A3) = LOWER 18 BITS OF ((A1)) IF EOLN TO BE SET. PSYSTM 997 * (X1) < 0 IF READ WITHOUT RESET ERROR. PSYSTM 998 * (X3) = 1/1, 59/0 IF EOLN TO BE SET. PSYSTM 999 * = 60/-0 IF BUFFER TO BE FILLED. PSYSTM 1000 * = 2/3,1/EOF,57/0 IF EOS/EOF TO BE SET (ASCII). V41CC10 90 * (X5) = UNCHANGED (RESTORED). V41CC10 91 * (X6) = ((A1)) ONLY NECESSARY IF EOLN TO BE SET. PSYSTM 1001 * (X7) = RETURN ADDRESS. PSYSTM 1002 * PSYSTM 1003 * EXIT (X2) = FET ADDRESS OR UNCHANGED. PSYSTM 1004 * PSYSTM 1005 * USES X - 0, 1, 2, 3, 4, 6, 7. PSYSTM 1006 * A - 1, 2, 3, 4, 6, 7. PSYSTM 1007 * B - 2, 3, 7. V41CC10 92 * PSYSTM 1009 * CALLS GTB, RWR. V41CC10 93 * PSYSTM 1011 * MACROS READ, RECALL. PSYSTM 1012 PSYSTM 1013 V41CC10 94 ASCII IFNE ASCFLAG,1 V41CC10 95 PSYSTM 1014 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 50 GCH8 SA1 A1+B1 EFET PSYSTM 1015 RJ GTB GET NEXT WORD PSYSTM 1016 PSYSTM 1017 SCOPE2 IFNE SCOPE2,1 PSYSTM 1018 SA1 X2-EFETFET PSYSTM 1019 SX6 X2-EFETFET+EFETCBUF PSYSTM 1020 SCOPE2 ELSE PSYSTM 1021 SA1 X2-EFITFIT PSYSTM 1022 SX6 X2-EFITFIT+EFETCBUF PSYSTM 1023 SCOPE2 ENDIF PSYSTM 1024 PSYSTM 1025 MX0 -6 PSYSTM 1026 ERRNZ EEOSF-59 SHIFT X1 V41CC05 51 NG X1,GCH7 IF EOS/EOF ENCOUNTERED PSYSTM 1027 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 52 SA6 A1-B1 SET FILE POINTER INTO CHARACTER BUFFER PSYSTM 1028 SA4 X3 GET CURRENT WORD PSYSTM 1029 SB3 X6 PSYSTM 1030 ZR X4,GCH6 IF ZERO (WILL RETURN IF -0) PSYSTM 1031 GCH9 LX4 6 PSYSTM 1032 BX6 -X0*X4 PSYSTM 1033 LX4 6 PSYSTM 1034 SA6 B3 STORE CHARACTER 1 PSYSTM 1035 BX7 -X0*X4 PSYSTM 1036 LX4 6 PSYSTM 1037 SA7 A6+B1 STORE CHARACTER 2 PSYSTM 1038 BX6 -X0*X4 PSYSTM 1039 LX4 6 PSYSTM 1040 SA6 A7+B1 STORE CHARACTER 3 PSYSTM 1041 BX7 -X0*X4 PSYSTM 1042 LX4 6 PSYSTM 1043 SA7 A6+B1 STORE CHARACTER 4 PSYSTM 1044 BX6 -X0*X4 PSYSTM 1045 LX4 6 PSYSTM 1046 SA6 A7+B1 STORE CHARACTER 5 PSYSTM 1047 BX7 -X0*X4 PSYSTM 1048 LX4 6 PSYSTM 1049 SA7 A6+B1 STORE CHARACTER 6 PSYSTM 1050 BX6 -X0*X4 PSYSTM 1051 LX4 6 PSYSTM 1052 SA6 A7+B1 STORE CHARACTER 7 PSYSTM 1053 BX7 -X0*X4 PSYSTM 1054 LX4 6 PSYSTM 1055 SA7 A6+B1 STORE CHARACTER 8 PSYSTM 1056 BX6 -X0*X4 PSYSTM 1057 LX4 6 PSYSTM 1058 SA6 A7+B1 STORE CHARACTER 9 PSYSTM 1059 BX7 -X0*X4 PSYSTM 1060 SA7 A6+B1 STORE CHARACTER 10 PSYSTM 1061 ZR X7,GCH1 IF POSSIBLE EOL IN THIS WORD PSYSTM 1062 GCH10 SA1 GCHB PSYSTM 1063 SB7 X1+ RETURN ADDRESS PSYSTM 1064 JP B7 PSYSTM 1065 PSYSTM 1066 GCH ENTER P.GETCH ENTRY PSYSTM 1067 SA7 GCHB SAVE RETURN ADDRESS PSYSTM 1068 ZR X3,GCH8 IF CHARACTER BUFFER TO BE FILLED PSYSTM 1069 BX6 X6+X3 PSYSTM 1070 MX7 60 PSYSTM 1071 NG X1,GCH8 IF READ WITHOUT RESET, LET GTB ISSUE ERROR PSYSTM 1072 SA6 A1+ SET EOLN FLAG PSYSTM 1073 SX6 1R PSYSTM 1074 SA7 A3+B1 SET END OF CHARACTER BUFFER SENTINAL PSYSTM 1075 SA6 A3 SET CURRENT CHARACTER TO BLANK PSYSTM 1076 EQ GCH10 PSYSTM 1077 PSYSTM 1078 GCH1 ZR X6,GCH5 IF EOL IN THIS WORD PSYSTM 1079 PSYSTM 1080 SCOPE2 IFNE SCOPE2,1 PSYSTM 1081 RECALL X2 WAIT I/O COMPLETE PSYSTM 1082 SA3 X2+4 LIMIT PSYSTM 1083 SA4 A3-B1 OUT PSYSTM 1084 SX0 X3 LIMIT PSYSTM 1085 GCH2 SX6 X4+B1 ADVANCE OUT PSYSTM 1086 SA3 A4-1 IN PSYSTM 1087 IX7 X0-X6 LIMIT - OUT PSYSTM 1088 NZ X7,GCH3 IF OUT <> LIMIT PSYSTM 1089 SA1 X2+B1 FIRST PSYSTM 1090 SX6 X1 OUT BECOMES FIRST PSYSTM 1091 GCH3 IX7 X6-X3 OUT - IN PSYSTM 1092 NZ X7,GCH4 IF BUFFER NOT EMPTY PSYSTM 1093 SA1 X2 FET PSYSTM 1094 NO PSYSTM 1095 LX1 59-4 PSYSTM 1096 NG X1,GCH10 IF EOR/EOF/EOI, THIS IS ZERO CHARACTER PSYSTM 1097 READ X2,R FILL THE BUFFER PSYSTM 1098 EQ GCH2 TRY AGAIN PSYSTM 1099 PSYSTM 1100 GCH4 SA1 X6 LOOK AHEAD ONE WORD PSYSTM 1101 CX3 X1 PSYSTM 1102 NZ X3,GCH10 IF NOT ZERO WORD, THIS IS ZERO CHARACTER PSYSTM 1103 SA1 X2-EFETFET EFET V41CC05 53 RJ GTB SKIP ZERO WORD PSYSTM 1105 SX6 X2-EFETFET+EFETCBUF FWA CHARACTER BUFFER V41CC05 54 MX7 1 PSYSTM 1107 NO PSYSTM 1108 SA6 X2-EFETFET+EFETPTR RESET FILE POINTER V41CC05 55 SA7 X2-EFETFET+EFETCBUF+9 SET EOL FLAG V41CC05 56 SCOPE2 ENDIF PSYSTM 1111 PSYSTM 1112 EQ GCH10 PSYSTM 1113 PSYSTM 1114 GCH5 SX7 B1 PSYSTM 1115 SA3 GCHA 40404040404040404040B PSYSTM 1116 IX7 X4-X7 PSYSTM 1117 BX1 -X7+X4 FORM MASK FOR UPPER NON-ZERO CHARACTERS PSYSTM 1118 MX6 1 PSYSTM 1119 BX3 X1*X3 PSYSTM 1120 CX7 X3 NUMBER OF NONZERO CHARACTERS PSYSTM 1121 SA6 B3+X7 SET EOL FLAG PSYSTM 1122 EQ GCH10 PSYSTM 1123 PSYSTM 1124 GCH6 NG X4,GCH9 IF TEN SEMI-COLONS FOOLED GCH PSYSTM 1125 GCH7 SX7 1R PSYSTM 1126 MX1 1 PSYSTM 1127 SA7 X6 SET CURRENT CHARACTER TO BLANK PSYSTM 1128 ERRNZ PEOLN-59 SHIFT X1 V41CC05 57 BX6 X6+X1 SET EOLN BIT PSYSTM 1129 MX7 60 PSYSTM 1130 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 58 SA6 A1-B1 SET FILE POINTER PSYSTM 1131 SA7 X6+B1 SET END OF BUFFER SENTINAL PSYSTM 1132 EQ GCH10 PSYSTM 1133 PSYSTM 1134 ASCII ELSE V41CC10 96 V41CC10 97 GCH ENTER P.GETCH ENTRY V41CC10 98 SX2 A1-EFETPTR+EFETFET V41CC10 99 NG X1,RWR IF READ WITHOUT RESET ERROR V41CC10 100 SA1 X2-EFETFET+EFET V41CC10 101 NZ X3,GCH8 IF EOLN OR EOS/EOF V41CC10 102 V41CC10 103 * END OF BUFFER - TRY TO REFILL IT. V41CC10 104 V41CC10 105 SA3 X2-EFETFET+EFETOUT V41CC10 106 SA7 GCHA RETURN ADDRESS V41CC10 107 SA6 GCHC SAVE EOLN FLAG V41CC10 108 BX7 X5 V41CC10 109 BX5 X5-X5 V41CC10 110 SA7 GCHB SAVE X5 - WE NEED TO USE IT V41CC10 111 SB2 X2-EFETFET+EFETCBUF V41CC10 112 BX0 X1 V41CC10 113 LX0 -EDCCHS RIGHT ADJUST DCCHS FIELD V41CC10 114 ERRNZ EDCCHSW-18 FIX NEXT LINE V41CC10 115 SB3 X0 DCCHS V41CC10 116 SA4 X3 GET DCB V41CC10 117 V41CC10 118 * EXTRACT 1 CHAR FROM DCB. V41CC10 119 V41CC10 120 GCH1 NZ B3,GCH2 IF DCB NOT EMPTY V41CC10 121 RJ GTB GET BINARY V41CC10 122 SA1 X2-EFETFET+EFET V41CC10 123 SA4 X3 DCB V41CC10 124 ERRNZ EEOSF-59 IF EOS/EOF BIT <> 59 V41CC10 125 MX0 1 SET EOS/EOF BIT V41CC10 126 SB3 DCALFALN DCCHS := DCALFALN V41CC10 127 PL X1,GCH2 IF NOT EOS/EOF, UNPACK CHAR V41CC10 128 SA4 GCHC EOLN FLAG V41CC10 129 BX6 X5 V41CC10 130 BX5 X5+X0 FLAG EOS/EOF V41CC10 131 NZ X6,GCH3 IF CHAR TO CONVERT V41CC10 132 SB7 A1-EFET+EFETCBUF V41CC10 133 SX6 B7-B2 IF (P <> FWA CHARBUFF) OR V41CC10 134 BX4 -X6*X4 (PREVIOUS CHAR <> EOL) V41CC10 135 PL X4,GCH5 THEN ADD IN EOL V41CC10 136 SB3 B0 DCCHS := 0 INDICATING EMPTY DCB V41CC10 137 BX6 X6-X6 RESET EOLN V41CC10 138 EQ GCH7 EXIT V41CC10 139 V41CC10 140 GCH2 MX6 -DCCHARSZ ONE DISPLAY CODE CHAR MASK V41CC10 141 SB3 B3-B1 DCCHS := DCCHS - 1 V41CC10 142 LX4 DCCHARSZ V41CC10 143 BX0 -X6*X4 EXTRACT DESIRED CHAR V41CC10 144 BX4 X6*X4 DCB[DCCHS] := 0 V41CC10 145 V41CC10 146 * CHECK FOR ZERO CHAR OR POSSIBLE EOLN. V41CC10 147 V41CC10 148 BX6 X0+X4 V41CC10 149 NZ X6,GCH3 IF CHAR <> CHR(0) OR NOT EOLN V41CC10 150 NZ B3,GCH5 IF AT LEAST TWO ZERO CHARS, EOLN V41CC10 151 RJ GTB ONLY DCB[0] = 0, SO FETCH NEXT WORD V41CC10 152 SA1 X2-EFETFET+EFET V41CC10 153 SA4 X3 GET DCB V41CC10 154 ERRNZ EEOSF-59 IF EOS/EOF BIT <> 59 V41CC10 155 MX6 1 SET EOS/EOF BIT V41CC10 156 SB3 DCALFALN DCCHS := DCALFALN V41CC10 157 BX0 X1*X6 X0 := 0 IF NOT EOS/EOF V41CC10 158 IX6 X0+X4 DCB V41CC10 159 BX5 X5+X0 IF EOS/EOF, FLAG FACT V41CC10 160 ZR X6,GCH5 IF NOT EOS/EOF AND DCB = 0, EOLN V41CC10 161 V41CC10 162 * CONVERT THE CHARACTER TO ASCII. V41CC10 163 V41CC10 164 GCH3 SA2 X0+=XP.TD2A V41CC10 165 NZ X5,GCH4 IF ALREADY KNOW ESCAPE CHAR OR EOS/EOF V41CC10 166 SX0 X0-76B ESCAPE CHAR 1 V41CC10 167 SX5 ASCHARSZ ELSE SEE IF CHAR IS ESCAPE CHAR V41CC10 168 ZR X0,GCH1 IF ESCAPE CHAR 1, GET REST OF 12-BIT CHAR V41CC10 169 SX0 X0+76B-74B ESCAPE CHAR 2 V41CC10 170 LX5 1 ASCHARSZ*2 V41CC10 171 ZR X0,GCH1 IF ESCAPE CHAR, GET REST OF 12-BIT CHAR V41CC10 172 BX5 X5-X5 ELSE MUST BE IN PRIMARY CHAR SET V41CC10 173 GCH4 SB7 X5 V41CC10 174 MX6 -ASCHARSZ V41CC10 175 AX2 B7 RIGHT ADJUST DESIRED CHAR V41CC10 176 BX6 -X6*X2 MASK OFF REMAINING CHARS V41CC10 177 V41CC10 178 * STORE ASCII CHAR IN CHARBUFF. V41CC10 179 V41CC10 180 SA6 B2 CHARBUFF[P] := CHAR V41CC10 181 SB2 B2+B1 V41CC10 182 NG X5,GCH5 IF HIT EOS/EOF V41CC10 183 SB7 A1-EFET+EFETSNTL V41CC10 184 BX5 X5-X5 RESET ALT CHAR SET FLAG V41CC10 185 BX6 X6-X6 RESET EOLN V41CC10 186 LT B2,B7,GCH1 IF NOT DCALFALN ASCII CHARS UNPACKED V41CC10 187 EQ GCH7 EXIT V41CC10 188 V41CC10 189 * EOLN - PUT EITHER (EOL CODE)/BLANK IN CHARBUFF, RE/SET EOLN. V41CC10 190 V41CC10 191 GCH5 SB7 A1-EFET+EFETCBUF ASSUME P = FWA CHARBUFF V41CC10 192 SX7 ASSPACE PUT BLANK INSTEAD OF EOL CODE IN CHARBUFF V41CC22 12 ERRNZ PEOLN-59 IF EOLN BIT <> 59 V41CC10 194 MX6 1 AND SET EOLN FLAG V41CC10 195 SA7 B2 CHARBUFF[P] := ' ' V41CC10 196 MX7 60 SENTINEL := -0 V41CC10 197 SA7 B2+B1 CHARBUFF[P + 1] := EOB V41CC10 198 EQ B2,B7,GCH6 IF ASSUMPTION CORRECT (CHARBUFF EMPTY) V41CC10 199 SA6 B2 ELSE CHARBUFF[P] := EOL CODE (1/1,59/0) V41CC10 200 BX6 X6-X6 RESET EOLN FLAG IN FILEPTR V41CC10 201 V41CC10 202 * CHECK AND HANDLE PREMATURE EOS/EOF. V41CC10 203 V41CC10 204 ERRNZ EEOSF-59 IF EOS/EOF BIT <> 59 V41CC10 205 ERRNZ EEOF-58 IF EOF BIT <> 58 V41CC10 206 GCH6 MX0 2 SET EOS/EOF,EOF BITS V41CC10 207 SB3 B0 DCCHS := 0, INDICATING DCB EMPTY V41CC10 208 BX7 X0*X1 EXTRACT EOS/EOF FLAGS FROM EFET V41CC10 209 AX7 1 2/3,1/EOF,57/0 V41CC10 210 PL X5,GCH7 IF DIDN'T HIT EOS/EOF, EXIT V41CC10 211 SA7 B2+B1 CHARBUFF[P + 1] := FLAG WORD V41CC10 212 BX1 -X0*X1 RESET EOS AND EOF FLAGS IN EFET V41CC10 213 V41CC10 214 * UPDATE P AND DCCHS, RETURN. V41CC10 215 V41CC10 216 GCH7 BX7 X4 V41CC10 217 SA4 GCHA RETURN ADDRESS V41CC10 218 SA7 X3 STORE DCB V41CC10 219 SA3 GCHB V41CC10 220 SX5 A1-EFET+EFETCBUF V41CC10 221 MX0 -EDCCHSW V41CC10 222 BX6 X6+X5 V41CC10 223 SA6 A1-EFET+EFETPTR 1/EOLN,1/REWRITE,40/,18/P V41CC10 224 LX1 -EDCCHS RIGHT ADJUST DCCHS FIELD V41CC10 225 BX6 X0*X1 MASK OFF OLD DCCHS V41CC10 226 SX0 B3 V41CC10 227 BX6 X6+X0 ADD IN NEW DCCHS V41CC10 228 LX6 EDCCHS V41CC10 229 SX2 A1-EFET+EFETFET V41CC10 230 SA6 A1 STORE NEW EFET V41CC10 231 SB7 X4 V41CC10 232 BX5 X3 RESTORE X5 V41CC10 233 JP B7 RETURN V41CC10 234 V41CC10 235 * EOLN OR EOS/EOF CODE FOUND IN CHARBUFF. V41CC10 236 V41CC10 237 GCH8 LX4 X3,B1 V41CC10 238 SB7 X7 RETURN ADDRESS V41CC10 239 NG X4,GCH9 IF PREMATURE EOS/EOF V41CC10 240 V41CC10 241 * EOLN - SET CHARBUFF[P] = ' ', EOLN TO TRUE, EXIT. V41CC10 242 V41CC10 243 SX7 ASSPACE ASCII SPACE V41CC22 13 BX6 X6+X3 1/1,1/0,40/,18/P V41CC10 245 SA7 A3 CHARBUFF[P] := ' ' V41CC10 246 SA6 X2-EFETFET+EFETPTR V41CC10 247 JP B7 RETURN V41CC10 248 V41CC10 249 * EOS/EOF - SET FLAGS IN EFET TO REFLECT FILE STATUS, EXIT. V41CC10 250 V41CC10 251 GCH9 SX6 X6 CLEAR EOLN FLAG V41CC10 252 ERRNZ EEOSF-59 IF EOS/EOF BIT <> 59 V41CC10 253 ERRNZ EEOF-58 IF EOF BIT <> 58 V41CC10 254 MX7 2 SET EOS/EOF,EOF BITS V41CC10 255 SA6 X2-EFETFET+EFETPTR UPDATE EFETPTR V41CC10 256 BX7 X7*X4 RETRIEVE EOS/EOF FLAGS V41CC10 257 MX6 60 V41CC10 258 BX7 X7+X1 INSERT INTO EFET V41CC10 259 SA6 A3 CHARBUFF[P] := ANY ILLEGAL CHAR VALUE V41CC10 260 SA7 A1 UPDATE EFET V41CC10 261 SA6 A3+B1 CHARBUFF[P + 1] := EOB V41CC10 262 JP B7 RETURN V41CC10 263 V41CC10 264 ASCII ENDIF V41CC10 265 V41CC10 266 ASCII IFNE ASCFLAG,1 V41CC10 267 GCHA DATA 40404040404040404040B PSYSTM 1135 GCHB SCRATCH 1 PSYSTM 1136 ASCII ELSE V41CC10 268 GCHA SCRATCH 1 RETURN ADDRESS V41CC10 269 GCHB SCRATCH 1 (X5) V41CC10 270 GCHC SCRATCH 1 EFET POINTER WORD V41CC10 271 ASCII ENDIF V41CC10 272 P.GETLN SPACE 4,15 PSYSTM 1137 ** P.GETLN - GET LINE. PSYSTM 1138 * PSYSTM 1139 * ENTRY (A1) = EFET ADDRESS + EFETPTR. V41CC05 59 * (X1) = ((A1)). PSYSTM 1141 * PSYSTM 1142 * EXIT (X2) = FET ADDRESS. PSYSTM 1143 * PSYSTM 1144 * USES X - 0, 1, 2, 3, 4, 6, 7. V41CC10 273 * A - 1, 2, 3, 4, 6, 7. V41CC10 274 * B - 2, 3, 7. V41CC10 275 * PSYSTM 1148 * CALLS GCH, GTB, GTC. V41CC10 276 PSYSTM 1150 PSYSTM 1151 GTL ROUTINE P.GETLN ENTRY/EXIT PSYSTM 1152 V41CC10 277 ASCII IFNE ASCFLAG,1 V41CC10 278 NG X1,GTL3 IF EOLN PSYSTM 1153 SB7 X1+1 PSYSTM 1154 GTL1 SA3 B7 ADVANCE TO NEXT CHARACTER PSYSTM 1155 SB7 B7+B1 PSYSTM 1156 PL X3,GTL1 IF NOT END OF CHARACTER BUFFER PSYSTM 1157 NZ X3,GTL3 IF EOLN FOUND PSYSTM 1158 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 60 GTL2 SA1 A1+B1 EFET PSYSTM 1159 RJ GTB GET BINARY PSYSTM 1160 PSYSTM 1161 SCOPE2 IFNE SCOPE2,1 PSYSTM 1162 SA1 X2-EFETFET+EFETPTR PSYSTM 1163 SCOPE2 ELSE PSYSTM 1164 SA1 X2-EFITFIT+EFETPTR PSYSTM 1165 SCOPE2 ENDIF PSYSTM 1166 PSYSTM 1167 MX5 48 PSYSTM 1168 SA3 X1 PSYSTM 1169 BX1 -X5*X3 PSYSTM 1170 NZ X1,GTL2 IF NOT EOLN PSYSTM 1171 GTL3 SA2 GTLX RETURN ADDRESS PSYSTM 1172 MX3 60 SET TO FILL CHARACTER BUFFER PSYSTM 1173 AX2 30 PSYSTM 1174 SX7 X2 RETURN ADDRESS PSYSTM 1175 EQ GCH CALL GETC HELPER PSYSTM 1176 ASCII ELSE V41CC10 279 NG X1,GTL4 IF EOLN V41CC10 280 SX3 A1-EFETPTR+EFETSNTL-1 V41CC10 281 IX3 X3-X1 V41CC10 282 SX2 A1-EFETPTR+EFETFET FET ADDRESS V41CC10 283 ZR X3,GTL2 IF P = LWA CHARBUFF V41CC10 284 GTL1 RJ GTC SEARCH CHARBUFF V41CC10 285 SA1 X2-EFETFET+EFETPTR V41CC10 286 SA3 X1+B1 CHARBUFF[P + 1] V41CC10 287 LX3 30 KLUDGY BUT FAST WAY TO CHECK FOR -0 (EOB) V41CC10 288 NG X1,GTL4 IF EOLN V41CC10 289 PL X3,GTL1 IF NOT (EOLN OR EOB) V41CC10 290 GTL2 SA4 A1+B1 EFET V41CC10 291 MX6 EDCCHSW V41CC10 292 LX6 EDCCHS+EDCCHSW V41CC10 293 BX3 X6*X4 EXTRACT DCCHS V41CC10 294 BX6 -X6*X4 DCCHS := 0 V41CC10 295 AX3 EDCCHS RIGHT ADJUST DCCHS V41CC10 296 SA6 A4 STORE NEW EFET V41CC10 297 SX6 X2-EFETFET+EFETCBUF V41CC10 298 MX7 60 V41CC10 299 SA6 A1 NEW EFETPTR V41CC10 300 SA7 X6 CHARBUFF[P] := ANY ILLEGAL CHAR VALUE V41CC10 301 SX4 X3-2 DCCHS - 2 V41CC10 302 SA7 X6+B1 CHARBUFF[P + 1] := EOB V41CC10 303 NG X4,GTL3 IF DCCHS < 2, IGNORE DCB V41CC10 304 SA4 X2-EFETFET+EFETOUT V41CC10 305 ERRNZ DCCHARSZ-6 FIX NEXT THREE LINES V41CC10 306 LX3 1 V41CC10 307 LX7 X3,B1 V41CC10 308 IX7 X3+X7 DCCHS * DCCHARSZ V41CC10 309 SA3 X4 DCB V41CC10 310 SB7 X7 V41CC10 311 MX6 -2*DCCHARSZ TWO DISPLAY CODE CHAR MASK V41CC10 312 LX3 B7 V41CC10 313 BX3 -X6*X3 LOOK AT LAST TWO CHARS V41CC10 314 ZR X3,GTL4 IF EOLN V41CC10 315 GTL3 SA1 X2-EFETFET+EFET V41CC10 316 RJ GTB ELSE SEARCH IN CIRCULAR BUFFER V41CC10 317 SA1 X2-EFETFET+EFET V41CC10 318 SA3 X3 OUT^ V41CC10 319 MX4 -2*DCCHARSZ TWO DISPLAY CODE CHAR MASK V41CC10 320 NG X1,GTLX IF EOS/EOF, RETURN V41CC10 321 ERRNZ PEOLN-59 IF EOLN BIT <> 59 V41CC10 322 MX7 1 SET EOLN BIT V41CC10 323 BX3 -X4*X3 LOOK AT LAST TWO DISPLAY CODE CHARS V41CC10 324 SX6 X2-EFETFET+EFETCBUF V41CC10 325 NZ X3,GTL3 IF NOT EOLN V41CC10 326 BX6 X7+X6 SET EOLN V41CC10 327 SA6 X2-EFETFET+EFETPTR V41CC10 328 SA1 A6 EFETPTR V41CC10 329 GTL4 RJ GTC SKIP EOLN CHAR V41CC10 330 EQ GTLX RETURN V41CC10 331 ASCII ENDIF V41CC10 332 P.GETS SPACE 4,15 PSYSTM 1177 ** P.GETS - GET SEGMENT. PSYSTM 1178 * PSYSTM 1179 * ENTRY (A1) = EFET ADDRESS. PSYSTM 1180 * (X1) = ((A1)). PSYSTM 1181 * (X2) = NUMBER OF SEGMENTS. PSYSTM 1182 * PSYSTM 1183 * EXIT (X2) = FET ADDRESS. PSYSTM 1184 * PSYSTM 1185 * USES X - ALL. PSYSTM 1186 * A - 1, 2, 3, 4, 6, 7. PSYSTM 1187 * B - 2, 3, 7. PSYSTM 1188 * PSYSTM 1189 * CALLS SKP, SRS. PSYSTM 1190 PSYSTM 1191 PSYSTM 1192 GTS ROUTINE P.GETS ENTRY/EXIT PSYSTM 1193 PSYSTM 1194 SCOPE IFNE SCOPE2,0 PSYSTM 1195 SB7 -FPEOS PSYSTM 1196 SCOPE ENDIF PSYSTM 1197 PSYSTM 1198 RJ SKP SKIP RECORDS PSYSTM 1199 PSYSTM 1200 SCOPE IFNE SCOPE2,0 PSYSTM 1201 EQ B7,B0,GTSX IF AT END OF PARTITION PSYSTM 1202 SCOPE ENDIF PSYSTM 1203 PSYSTM 1204 RJ SRS SET READ STATUS PSYSTM 1205 EQ GTSX RETURN PSYSTM 1206 P.GTO SPACE 4,20 PSYSTM 1207 ** P.GTO - GOTO EXTERNAL LABEL. PSYSTM 1208 * PSYSTM 1209 * POP ACTIVATION RECORDS FROM STACK UNTIL THE APPROPRIATE ONE PSYSTM 1210 * IS FOUND. THIS INCLUDES EXECUTING EPILOGUE CODE FOR EVERY PSYSTM 1211 * BLOCK THAT IS TERMINATED. PSYSTM 1212 * PSYSTM 1213 * ENTRY (X1) = DAR (DESTINATION ACTIVATION RECORD). PSYSTM 1214 * (X7) = DLA (DESTINATION LABEL ADDRESS). PSYSTM 1215 * (B4) = LWA+1 OF CURRENT STACK CHUNK. PSYSTM 1216 * (B5) = CURRENT ACTIVATION POINTER. PSYSTM 1217 * PSYSTM 1218 * EXIT (B4) = LWA+1 OF CURRENT STACK CHUNK. PSYSTM 1219 * (B5) = DAR. PSYSTM 1220 * (B6) = (B5) + LCMAX (LCMAX FOR DESTINATION BLOCK). PSYSTM 1221 * JUMPS TO DLA. PSYSTM 1222 * PSYSTM 1223 * USES ALL. PSYSTM 1224 * PSYSTM 1225 * CALLS PEX. PSYSTM 1226 PSYSTM 1227 PSYSTM 1228 GTO ENTER P.GTO ENTRY PSYSTM 1229 PSYSTM 1230 * SAVE DAR (X1) AND DLA (X7). PSYSTM 1231 PSYSTM 1232 LX7 18 PSYSTM 1233 BX7 X7+X1 24/0, 18/DLA, 18/DAR PSYSTM 1234 SA7 GTOA PSYSTM 1235 PSYSTM 1236 * TERMINATE CURRENT ACTIVATION. PSYSTM 1237 * FIX RETURN ADDRESS TO TRAP BLOCK EXIT. PSYSTM 1238 * HANDLE CROSS-CHUNK RETURNS AS SPECIAL CASE. PSYSTM 1239 PSYSTM 1240 GTO1 SA1 B5 (AR) = 30/BHW, 30/SL PSYSTM 1241 SA2 B5-B1 (AR-1) = 30/EQ RA, 30/DL PSYSTM 1242 LX1 30 30/SL, 30/BHW PSYSTM 1243 LX2 30 30/DL, 30/EQ RA PSYSTM 1244 SA3 X1 BLOCK HEADER WORD PSYSTM 1245 SX4 X2-SCU CHECK FOR CROSS-CHUNK RETURN PSYSTM 1246 MX6 42 PSYSTM 1247 SX7 GTO4 SUBSTITUTE FOR ACTUAL RA PSYSTM 1248 MX0 -15 PSYSTM 1249 LX3 30 PSYSTM 1250 NZ X4,GTO2 IF RA <> SCU (IF NOT CROSS-CHUNK RETURN) PSYSTM 1251 PSYSTM 1252 ERRNZ ARPS-1 FIX NEXT LINE PSYSTM 1253 SA5 A2-B1 CHUNK LINKAGE (RA = SCU) PSYSTM 1254 BX6 X6*X5 PSYSTM 1255 BX6 X6+X7 24/OLD B4, 18/OLD B6, 18/GTO4 PSYSTM 1256 SA6 A5 UPDATE CHUNK LINKAGE PSYSTM 1257 EQ GTO3 PSYSTM 1258 PSYSTM 1259 GTO2 BX6 X6*X2 PSYSTM 1260 BX6 X6+X7 30/DL, 30/EQ GTO4 PSYSTM 1261 LX6 30 30/EQ GTO4, 30/DL PSYSTM 1262 SA6 A2 AR-1 PSYSTM 1263 PSYSTM 1264 * EXECUTE EPILOGUE CODE, IF ANY; OTHERWISE JUST DO A BLOCK EXIT. PSYSTM 1265 PSYSTM 1266 GTO3 BX0 -X0*X3 EXTRACT XITIC FROM BLOCK HEADER WORD PSYSTM 1267 ZR X0,PEX JUST DO BLOCK-EXIT CODE IF NO EPILOGUE PSYSTM 1268 SB7 X0 XITIC (OFFSET FROM BHW) PSYSTM 1269 SB7 B7+A3 XIT (EPILOGUE CODE ADDRESS) PSYSTM 1270 JP B7 PSYSTM 1271 PSYSTM 1272 * ALL TRACKS LEAD TO JACK'S. PSYSTM 1273 * (APOLOGIES TO GARRISON KEILLOR.) PSYSTM 1274 PSYSTM 1275 GTO4 SA1 GTOA 24/0, 18/DLA, 18/DAR PSYSTM 1276 SB3 X1+ PSYSTM 1277 NE B5,B3,GTO1 IF CURRENT <> DESTINATION PSYSTM 1278 PSYSTM 1279 * B5 = DAR; RESET B6 = B5+LCMAX AND JUMP TO DLA. PSYSTM 1280 PSYSTM 1281 SA2 B5 30/BHW, 30/SL PSYSTM 1282 AX1 18 60/DLA PSYSTM 1283 LX2 30 30/SL, 30/BHW PSYSTM 1284 SB7 X1 DLA PSYSTM 1285 SA3 X2 BLOCK HEADER WORD PSYSTM 1286 SB6 B5+X3 AR+LCMAX+ARPS PSYSTM 1287 ERRNZ ARPS-1 FIX NEXT LINE PSYSTM 1288 SB6 B6-B1 AR+LCMAX PSYSTM 1289 JP B7 PSYSTM 1290 PSYSTM 1291 GTOA SCRATCH 1 PSYSTM 1292 P.HALT SPACE 4,15 PSYSTM 1293 ** P.HALT - HALT WITH A MESSAGE. PSYSTM 1294 * PSYSTM 1295 * ENTRY (A0) = LINE NUMBER IF PMD AVAILABLE. PSYSTM 1296 * (X1) = MESSAGE ADDRESS. PSYSTM 1297 * OR 0 FOR * HALT.*. PSYSTM 1298 * (X2) = MESSAGE LENGTH. PSYSTM 1299 * PSYSTM 1300 * EXIT TO ABT. PSYSTM 1301 * PSYSTM 1302 * USES X - 0, 1, 2, 6, 7. PSYSTM 1303 * A - 1, 2, 6, 7. PSYSTM 1304 * B - 7. PSYSTM 1305 * PSYSTM 1306 * CALLS ABT, TMS. PSYSTM 1307 PSYSTM 1308 PSYSTM 1309 HLT ROUTINE P.HALT ENTRY PSYSTM 1310 ZR X1,HLT1 IF NO MESSAGE PARAMETER PSYSTM 1311 RJ TMS TERMINATE MESSAGE STRING PSYSTM 1312 SX0 X1 PSYSTM 1313 EQ ABT EXIT TO COMMON ERROR ROUTINE PSYSTM 1314 PSYSTM 1315 HLT1 SX0 MSGJ HALT PSYSTM 1316 EQ ABT EXIT TO COMMON ERROR ROUTINE PSYSTM 1317 P.INIT SPACE 4,25 PSYSTM 1318 ** P.INIT - INITIALIZE THE PASCAL RUN TIME SYSTEM. PSYSTM 1319 * PSYSTM 1320 * ENTRY (LWPR) = LWA+1 LOADED. PSYSTM 1321 * (A0) = CURRENT FIELD LENGTH. PSYSTM 1322 * (B7) = NUMBER OF FORMAL CONTROL STATEMENT PARAMETERS. PSYSTM 1323 * PSYSTM 1324 * EXIT MEMORY MANAGER INITIALIZED. PSYSTM 1325 * CONTROL-STATEMENT PARAMETERS CLEANED UP. PSYSTM 1326 * OUTPUT FILE MARKED NOT OPENED. PSYSTM 1327 * BHW INSTALLED IN MAIN ACTIVATION RECORD. PSYSTM 1328 * MAIN BLOCK HEADER WORD KLUDGED AS NEEDED. PSYSTM 1329 * PMD ENABLED IF IT IS NOT ENTIRELY SUPPRESSED. PSYSTM 1330 * (B1) = 1. PSYSTM 1331 * (B4) = LWA+1 OF INITIAL STACK CHUNK. PSYSTM 1332 * (B5) = ADDRESS OF MAIN ACTIVATION RECORD. PSYSTM 1333 * (B6) = FWA OF INITIAL STACK CHUNK. PSYSTM 1334 * PSYSTM 1335 * USES ALL REGISTERS. PSYSTM 1336 * PSYSTM 1337 ** CALLS CAD, CLK, EFD, P.ALM, P.INM. PSYSTM 1338 * PSYSTM 1339 * MACROS ABORT, MESSAGE. PSYSTM 1340 PSYSTM 1341 PSYSTM 1342 USE PRESET PSYSTM 1343 PSYSTM 1344 PRS ROUTINE P.INIT PSYSTM 1345 SB1 1 PSYSTM 1346 SB2 =XP.PIT PROGRAM INFORMATION TABLE PSYSTM 1347 SX1 MSGV INCOMPATIBLE VERSION OF PASCLIB USED PSYSTM 1348 LE B2,B0,PRS7 IF NO PIT PSYSTM 1349 SA2 =XP.PIT+PITVERS GET RELEASE/VERSION OF BINARY PSYSTM 1350 SA3 PRSA GET RELEASE/VERSION OF LIBRARY PSYSTM 1351 SA5 PRSB GET RELEASE/VERSION MASK PSYSTM 1352 BX4 X2-X3 PSYSTM 1353 BX4 X5*X4 ZERO IF BINARY IS COMPATIBLE WITH LIBRARY PSYSTM 1354 NZ X4,PRS7 IF RELEASES/VERSIONS DO NOT MATCH PSYSTM 1355 SA5 =XP.PIT+PITMAIN PSYSTM 1356 MX6 30 PSYSTM 1357 BX6 X6*X5 30/MAIN BHW, 30/0 PSYSTM 1358 SB5 X5 ADDRESS OF MAIN ACTIVATION PSYSTM 1359 SA6 X5 PSYSTM 1360 SA4 ACTR PSYSTM 1361 MX0 42 PSYSTM 1362 SB3 X4 NUMBER OF ACTUAL PARAMETERS PSYSTM 1363 R= A4,ARGR-1 PRELOAD PSYSTM 1364 BX6 X6-X6 PSYSTM 1365 SA3 =XP.PIT+PITOUTP PSYSTM 1366 ZR B7,PRS6 IF NO FILES IN PROGRAM HEADING PSYSTM 1367 SX3 X3 PSYSTM 1368 ZR X3,PRS2 IF NO OUTPUT FILE PSYSTM 1369 SA6 X3 SET OUTPUT FILE NOT OPENED PSYSTM 1370 PSYSTM 1371 PRS2 RJ EFD EXAMINE FIRST DELIMITER PSYSTM 1372 ZR X6,PRS4 IF A SLASH, NO ACTUAL PARAMETERS PSYSTM 1373 PSYSTM 1374 PRS3 SX1 MSGI TOO MANY PROGRAM PARAMETERS PSYSTM 1375 ZR B3,PRS4 IF ALL ACTUALS PROCESSED PSYSTM 1376 SA4 A4+B1 GET NEXT ACTUAL PARAMETER PSYSTM 1377 SB3 B3-B1 COUNT IT PSYSTM 1378 BX7 X0*X4 STRIP THE DELIMITER PSYSTM 1379 SA7 A4 REPLACE FILE NAME PSYSTM 1380 SX2 X4-3 /=3 IN SCOPE PARAMETERS PSYSTM 1381 SX3 X4-1R/ PSYSTM 1382 ZR X2,PRS4 IF / (IN SCOPE PARAMETERS) PSYSTM 1383 NZ X3,PRS3 IF NOT / (IN KRONOS PARAMETERS) PSYSTM 1384 PRS4 SB3 A4-B1 NUMBER OF ACTUALS BEFORE / PSYSTM 1385 BX7 X7-X7 PSYSTM 1386 GT B3,B7,PRS7 IF TOO MANY ACTUAL PARAMS PSYSTM 1387 PRS5 SB3 B3+B1 PSYSTM 1388 SA7 B3+B1 ZERO THE REST OF FORMALS AND ONE MORE WORD PSYSTM 1389 LE B3,B7,PRS5 PSYSTM 1390 PSYSTM 1391 PRS6 SA1 LWPR PSYSTM 1392 SX6 X1 NEGATIVE IF CMM PRESENT PSYSTM 1393 SA6 PRSC SAVE LOAD FL PSYSTM 1394 RJ =XP.INM INITIALIZE MEMORY MANAGER PSYSTM 1395 NG X1,PRS6.9 IF PMM COULD NOT INITIALIZE PSYSTM 1396 NZ X1,PRS7 IF CMM PRESENT PSYSTM 1397 SA1 =XP.PIT+PITSCS GET STACK CONTROL WORD PSYSTM 1398 SX6 X1 GET RID OF ISC PSYSTM 1399 AX1 30 SIZE OF INITIAL STACK CHUNK PSYSTM 1400 SA6 A1+ PITSCS := MSC PSYSTM 1401 RJ =XP.ALM ALLOCATE INITIAL STACK CHUNK PSYSTM 1402 SB6 X6 FWA OF INITIAL STACK CHUNK PSYSTM 1403 SB4 X6+B7 LWA+1 OF INITIAL STACK CHUNK PSYSTM 1404 SA2 B5 PSYSTM 1405 AX2 30 60/MAIN BHW ADDRESS PSYSTM 1406 SA2 X2 PSYSTM 1407 SX3 B6-B5 PSYSTM 1408 SX3 X3+ARPS PSYSTM 1409 MX6 42 PSYSTM 1410 BX6 X6*X2 PSYSTM 1411 BX6 X6+X3 ALTER LCMAX+ARPS FIELD OF MAIN BHW PSYSTM 1412 SA6 A2 PSYSTM 1413 SA1 =XP.PIT+PITFLAG PSYSTM 1414 PL X1,PRS6.2 IF PMD SUPRESSED ENTIRELY PSYSTM 1415 SX1 PMDSPACE SIZE OF PMD STACK CHUNK PSYSTM 1416 RJ =XP.ALM ALLOCATE MEMORY PSYSTM 1417 SX7 X6+B7 LWA+1 OF PMD STACK CHUNK PSYSTM 1418 LX7 30 PSYSTM 1419 BX6 X6+X7 30/LWA+1,30/FWA PSYSTM 1420 SA6 TGVR+TGVRPMDS ENABLE PMD PSYSTM 1421 PRS6.2 SA1 =XP.PIT+PITFLAG PSYSTM 1422 LX1 59-57 PSYSTM 1423 PL X1,PRS6.5 IF NOT ISSUING STATISTICS PSYSTM 1424 MX0 6*6 PSYSTM 1425 LX0 -6 PSYSTM 1426 SA1 PRSC LOAD FL PSYSTM 1427 SA5 MSGP PSYSTM 1428 RJ CAD CONVERT ADDRESS TO DISPLAY PSYSTM 1429 LX6 3*6 PSYSTM 1430 BX2 -X0*X5 REMOVE XXXXXX PSYSTM 1431 SA1 =XP.TMEM+MEMFL START FL PSYSTM 1432 BX6 X0*X6 REMOVE BLANKS PSYSTM 1433 IX7 X6+X2 REPLACE XXXXXX WITH LOAD FL PSYSTM 1434 SA7 A5+ PSYSTM 1435 RJ CAD CONVERT ADDRESS TO DISPLAY PSYSTM 1436 LX0 6 PSYSTM 1437 SA1 MSGP+2 PSYSTM 1438 LX6 4*6 PSYSTM 1439 BX2 -X0*X1 REMOVE XXXXXX PSYSTM 1440 BX6 X0*X6 REMOVE BLANKS PSYSTM 1441 IX7 X6+X2 REPLACE XXXXXX WITH START FL PSYSTM 1442 SA7 A1 PSYSTM 1443 V41EC04 13 OS IFNE NOSBE,0 V41EC04 14 MESSAGE MSGP,"IMSG",R XXXXXXB LOAD FL, XXXXXXB START FL. V41EC04 15 OS ELSE V41EC04 16 MESSAGE MSGP,"IMSG" XXXXXXB LOAD FL, XXXXXXB START FL. PSYSTM 1444 OS ENDIF V41EC04 17 V41EC04 18 PRS6.5 BSS 0 PSYSTM 1445 RJ CLK GET MILLISECOND CLOCK PSYSTM 1446 SA6 ISMA SAVE MILLISECOND CLOCK READING PSYSTM 1447 EQ PRSX RETURN PSYSTM 1448 PSYSTM 1449 PRS6.9 SX1 MSGQ MEMORY REQUIRED EXCEEDS SPECIFIED MFL PSYSTM 1450 PRS7 MESSAGE X1,"EMSG" ISSUE ERROR MESSAGE PSYSTM 1451 PSYSTM 1452 SCOPE2 IFNE SCOPE2,1 PSYSTM 1453 ABORT PSYSTM 1454 SCOPE2 ELSE PSYSTM 1455 ABORT ,ND PSYSTM 1456 SCOPE2 ENDIF PSYSTM 1457 PSYSTM 1458 PRSA VFD 6/RELNUM,6/1R.,6/VERNUM,6/1R.,6/LEVNUM,6/ASCFLAG,6/LVER PSYSTM 1459 ,NUM,6/LLEVNUM,12/0 PSYSTM 1460 PRSB CON 77000000007777770000B RELEASE/VERSION MASK PSYSTM 1461 PRSC BSSZ 1 LOAD FL PSYSTM 1462 PSYSTM 1463 PRSL EQU * PSYSTM 1464 PSYSTM 1465 USE * PSYSTM 1466 P.INV SPACE 4,15 PSYSTM 1467 ** P.INV - INITIALIZE NEW VARIABLES. PSYSTM 1468 * PSYSTM 1469 * ENTRY (X6) = FWA OF VARIABLES. PSYSTM 1470 * (B7) = NUMBER OF WORDS IN VARIABLES. PSYSTM 1471 * (B1) = 1. PSYSTM 1472 * PSYSTM 1473 * EXIT EACH WORD OF VARIABLES SET TO PSYSTM 1474 * 6000 0000 0000 0037 7776 B. PSYSTM 1475 * (X6) UNCHANGED. PSYSTM 1476 * PSYSTM 1477 * USES X - 0, 7. PSYSTM 1478 * A - 7. PSYSTM 1479 * B - 7. PSYSTM 1480 PSYSTM 1481 PSYSTM 1482 INV1 SB7 B7-B1 PSYSTM 1483 SA7 X6+B7 PSYSTM 1484 NZ B7,INV1 IF MORE WORDS TO INITIALIZE PSYSTM 1485 PSYSTM 1486 INV ROUTINE P.INV ENTRY/EXIT PSYSTM 1487 MX7 2 PSYSTM 1488 SX0 377776B PSYSTM 1489 BX7 X7+X0 PSYSTM 1490 NZ B7,INV1 IF NUMBER OF WORDS <> 0 PSYSTM 1491 EQ INVX RETURN PSYSTM 1492 P.IOE SPACE 4,15 PSYSTM 1493 ** P.IOE - INPUT/OUTPUT ERROR. PSYSTM 1494 * PSYSTM 1495 * ISSUE AN INPUT/OUTPUT ERROR MESSAGE, INSERTING THE FILE PSYSTM 1496 * NAME INTO THE MESSAGE. THEN GO ABORT. PSYSTM 1497 * PSYSTM 1498 * ENTRY (A0) = LINE NUMBER (IF PMD INFO AVAILABLE). PSYSTM 1499 * (X0) = FET-14 (IF ENTERING AT P.IOE). PSYSTM 1500 * (X1) = INDEX INTO TABLE OF INPUT/OUTPUT ERRORS. PSYSTM 1501 * (X2) = FET (IF ENTERING AT IOE1). PSYSTM 1502 * PSYSTM 1503 * EXIT TO ABT. PSYSTM 1504 * PSYSTM 1505 * USES ALL REGISTERS. PSYSTM 1506 * PSYSTM 1507 * CALLS ABT, SNM. PSYSTM 1508 PSYSTM 1509 PSYSTM 1510 SCOPE2 IFNE SCOPE2,1 PSYSTM 1511 IOE1 SX0 X2-EFETFET+EFETLCNT PSYSTM 1512 SCOPE2 ELSE PSYSTM 1513 IOE1 SX0 X2-EFITFIT+EFETLCNT PSYSTM 1514 SCOPE2 ENDIF PSYSTM 1515 PSYSTM 1516 EQ IOE2 PSYSTM 1517 PSYSTM 1518 IOE ROUTINE P.IOE PSYSTM 1519 IOE2 SA2 TIOE+X1 FETCH I/O ERROR NAME PSYSTM 1520 PSYSTM 1521 * COPY OFF ERROR MESSAGE IN CASE OF SUBSEQUENT CALLS TO SNM. PSYSTM 1522 PSYSTM 1523 SB7 4 NUMBER OF WORDS TO TRANSFER PSYSTM 1524 IOE3 SA3 X2+B7 PSYSTM 1525 BX6 X3 PSYSTM 1526 SA6 IOEZ+B7 PSYSTM 1527 SB7 B7-B1 PSYSTM 1528 GE B7,B0,IOE3 IF MORE TO TRANSFER PSYSTM 1529 MX6 6*7 PSYSTM 1530 PSYSTM 1531 SCOPE2 IFNE SCOPE2,1 PSYSTM 1532 SA3 X0+EFETFET-EFETLCNT PSYSTM 1533 SCOPE2 ELSE PSYSTM 1534 SA3 X0+EFITFIT-EFETLCNT PSYSTM 1535 SCOPE2 ENDIF PSYSTM 1536 PSYSTM 1537 SB7 1R= SUBSTITUTION CHARACTER PSYSTM 1538 BX1 X6*X3 DISCARD LOWER BITS PSYSTM 1539 SA4 A6-B1 FWA - 1 OF MESSAGE PSYSTM 1540 SX5 A6+ FWA OF MESSAGE PSYSTM 1541 RJ SNM SET FILE NAME IN MESSAGE PSYSTM 1542 SX0 X5 ADDRESS OF ERROR MESSAGE PSYSTM 1543 EQ ABT GO ABORT PSYSTM 1544 PSYSTM 1545 IOEZ SCRATCH 5 TEMPORARY STORAGE FOR I/O ERROR MESSAGE PSYSTM 1546 P.MSG SPACE 4,15 PSYSTM 1547 ** P.MSG - DISPLAY MESSAGE TO USER DAYFILE. PSYSTM 1548 * PSYSTM 1549 * ENTRY (X1) = ADDRESS OF MESSAGE. PSYSTM 1550 * (X2) = LENGTH OF MESSAGE (IN CHARACTERS). PSYSTM 1551 * (X3) = MESSAGE ROUTING OPTION. PSYSTM 1552 * (X3) < 0 IF DEFAULT OPTION TO BE USED. PSYSTM 1553 * PSYSTM 1554 * EXIT MESSAGE DISPLAYED. PSYSTM 1555 * PSYSTM 1556 * USES X - 2, 3. PSYSTM 1557 * PSYSTM 1558 * CALLS TMS. PSYSTM 1559 * PSYSTM 1560 * MACROS MESSAGE. PSYSTM 1561 PSYSTM 1562 PSYSTM 1563 SCOPE2 IFNE SCOPE2,1 PSYSTM 1564 MSG1 MESSAGE X1,X3,R ISSUE MESSAGE PSYSTM 1565 SCOPE2 ELSE PSYSTM 1566 MSG1 MESSAGE X1 ISSUE MESSAGE PSYSTM 1567 SCOPE2 ENDIF PSYSTM 1568 PSYSTM 1569 MSG ROUTINE P.MSG ENTRY/EXIT PSYSTM 1570 RJ TMS TERMINATE MESSAGE STRING PSYSTM 1571 NG X3,MSG2 IF DEFAULT OPTION PSYSTM 1572 SX2 X3-8 PSYSTM 1573 NG X2,MSG1 IF VALID OPTION PSYSTM 1574 MSG2 SX3 "IMSG" USE DEFAULT ROUTING OPTION PSYSTM 1575 EQ MSG1 ISSUE MESSAGE PSYSTM 1576 P.NEWD SPACE 4,15 PSYSTM 1577 ** P.NEWD - ALLOCATE CHECKED HEAP STORAGE. PSYSTM 1578 * PSYSTM 1579 * ENTRY (X1) = SIZE OF NODE TO ALLOCATE. PSYSTM 1580 * (INCLUDES SPACE FOR POINTER KEY WORD.) PSYSTM 1581 * PSYSTM 1582 * EXIT (X6) = NEW POINTER VALUE. PSYSTM 1583 * STORAGE ALLOCATED. PSYSTM 1584 * PSYSTM 1589 * CALLS P.ALM, SPK. PSYSTM 1590 PSYSTM 1591 PSYSTM 1592 TNW ROUTINE P.NEWD ENTRY/EXIT PSYSTM 1593 RJ =XP.ALM ALLOCATE NODE PSYSTM 1594 RJ SPK SET POINTER KEY PSYSTM 1595 EQ TNWX RETURN PSYSTM 1596 P.NFN SPACE 4,15 PSYSTM 1597 ** P.NFN - GENERATE NEW FILE NAME. PSYSTM 1598 * PSYSTM 1599 * ENTRY (B1) = 1. PSYSTM 1600 * PSYSTM 1601 * EXIT (X2) = NEW FILE NAME OF FORM *SCRNNNN*. PSYSTM 1602 * (B2) UNCHANGED. PSYSTM 1603 * PSYSTM 1604 * USES X - ALL. PSYSTM 1605 * A - 1, 2, 3, 4, 6. PSYSTM 1606 * B - 2, 3. PSYSTM 1607 * PSYSTM 1608 * CALLS CDD=. PSYSTM 1609 PSYSTM 1610 PSYSTM 1611 NFN ROUTINE P.NFN PSYSTM 1612 SA1 NFNA COUNTER PSYSTM 1613 SX5 B4 SAVE TOP OF HEAP POINTER PSYSTM 1614 SX6 X1+B1 ADVANCE COUNTER PSYSTM 1615 SX4 X1-9999 PSYSTM 1616 SA6 A1+ PSYSTM 1617 SX0 MSGU INTERNAL FILE LIMIT EXCEEDED PSYSTM 1618 PL X4,ABT IF INTERNAL FILE LIMIT EXCEEDED PSYSTM 1619 SX0 B2 SAVE B2 PSYSTM 1620 BX1 X6 PSYSTM 1621 RJ =XCDD= CONVERT DECIMAL DIGITS PSYSTM 1622 MX1 1 PSYSTM 1623 SB2 B2-B1 PSYSTM 1624 SX2 3RSCR PSYSTM 1625 AX1 B2 CREATE MASK FOR DIGITS CONVERTED PSYSTM 1626 SB4 X5 RESTORE TOP OF HEAP POINTER PSYSTM 1627 BX4 X1*X4 REMOVE TRAILING BLANKS PSYSTM 1628 IX2 X2+X4 COMBINE *SCR* AND *NNNN* PSYSTM 1629 SB2 X0 RESTORE B2 PSYSTM 1630 LX2 -3*6 LEFT ADJUST PSYSTM 1631 EQ NFNX RETURN PSYSTM 1632 PSYSTM 1633 NFNA DATA 0 FILE NAME COUNTER PSYSTM 1634 P.OPE SPACE 4,30 PSYSTM 1635 ** P.OPE - OPEN EFET. PSYSTM 1636 * PSYSTM 1637 * ENTRY (B3) = EFET ADDRESS. PSYSTM 1638 * (X2) = FILE NAME (1-7 CHARS, ZERO FILLED), IF PSYSTM 1639 * PERSISTENT-FILE BIT (EPERSIST) IS SET IN (X1); PSYSTM 1640 * = 0, IF PERSISTENT-FILE BIT IS CLEARED IN (X1). PSYSTM 1641 * (EFET+0) = 9/DISPOSITION CODE, 33/0, 18/LRL. PSYSTM 1642 * FET+1 (FET SIZE, FIRST) SET. PSYSTM 1643 * FET+2 (IN), FET+3 (OUT) SET. PSYSTM 1644 * FET+4 (LIMIT) SET. PSYSTM 1645 * FET IS NOT BUSY. PSYSTM 1646 * PSYSTM 1647 * EXIT (B2) UNCHANGED. PSYSTM 1648 * (X2) = FET ADDRESS. PSYSTM 1649 * NON-PERSISTENT FILES ARE RETURNED OR UNLOADED. PSYSTM 1650 * CALLER MUST COMPLETE INITIALIZATION BY PSYSTM 1651 * CALLING EITHER P.SRS (SET READ STATUS) PSYSTM 1652 * OR P.SWS (SET WRITE STATUS). PSYSTM 1653 * PSYSTM 1654 * USES X - ALL. PSYSTM 1655 * A - 1, 2, 3, 4, 5, 6, 7. PSYSTM 1656 * B - 3, 7. PSYSTM 1657 * PSYSTM 1658 * CALLS CAD, CDD=, IOE, NFN. PSYSTM 1659 * PSYSTM 1660 * MACROS CLOSE, CLOSEM, MESSAGE, OPEN, OPENM, RETURN. PSYSTM 1661 PSYSTM 1662 PSYSTM 1663 SCOPE2 IFNE SCOPE2,1 PSYSTM 1664 PSYSTM 1665 * GENERATE SCRATCH FILE NAME FOR NON-PERSISTENT FILE. PSYSTM 1666 PSYSTM 1667 OPE4 SB7 X2 SAVE FET ADDRESS PSYSTM 1668 RJ NFN GENERATE NEW FILE NAME PSYSTM 1669 SA1 B7 FET+0 PSYSTM 1670 BX6 X2+X1 42/NEW FILE NAME, 16/0, 1/BINARY, 1/1 PSYSTM 1671 SA6 B7 PSYSTM 1672 SX2 B7 RESTORE X2 PSYSTM 1673 PSYSTM 1674 * RETURN OR UNLOAD NON-PERSISTENT FILE. PSYSTM 1675 PSYSTM 1676 NOS IFNE KRONOS+NOS1+NOS2,0 V41AC01 21 RETURN X2,R PSYSTM 1678 NOS ENDIF PSYSTM 1679 PSYSTM 1680 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 1681 CLOSE X2,UNLOAD,R PSYSTM 1682 NOSBE ENDIF PSYSTM 1683 PSYSTM 1684 OPE ROUTINE P.OPE ENTRY/EXIT PSYSTM 1685 PSYSTM 1686 * INITIALIZE FET+0. PSYSTM 1687 PSYSTM 1688 ERRNZ EFET FIX NEXT LINE PSYSTM 1689 SA1 B3 LOAD DISPOSITION CODE PSYSTM 1690 MX4 59 PSYSTM 1691 LX1 0-ETEXT RIGHT ADJUST TEXTFILE BIT PSYSTM 1692 BX3 X1+X4 SET ALL OTHER BITS PSYSTM 1693 LX3 1 PSYSTM 1694 BX4 X3-X4 COMBINE BINARY BIT AND COMPLETE BIT PSYSTM 1695 BX7 X2+X4 42/FILE NAME OR ZERO, 16/0, 1/BINARY, 1/1 PSYSTM 1696 ERRNZ EFETFET-1 FIX NEXT LINE PSYSTM 1697 SA7 B3+B1 FET FIRST WORD PSYSTM 1698 PSYSTM 1699 * ZERO OUT FET+5 .. FET+FETSZ-1. PSYSTM 1700 PSYSTM 1701 SB7 FETSZ-5-1 PSYSTM 1702 SX6 B0+ PSYSTM 1703 SA6 B3+EFETFET+5 PSYSTM 1704 OPE1 SB7 B7-B1 PSYSTM 1705 SA6 A6+B1 PSYSTM 1706 NZ B7,OPE1 PSYSTM 1707 PSYSTM 1708 * INITIALIZE CHARACTER BUFFER FOR TEXTFILE. PSYSTM 1709 PSYSTM 1710 LX1 59-0 LEFT ADJUST TEXTFILE BIT PSYSTM 1711 PL X1,OPE2 IF NOT A TEXTFILE PSYSTM 1712 SX7 -B1 PSYSTM 1713 MX6 60 PSYSTM 1714 SA7 B3+EFETLCNT LINE COUNT PSYSTM 1715 ERRPL EFETCBUF+1-EFETSNTL FIX FOLLOWING LOOP. PSYSTM 1716 MX2 EFETSNTL-EFETCBUF-1 PSYSTM 1717 SX7 1R FILL WITH SPACES PSYSTM 1718 SA7 B3+EFETCBUF PSYSTM 1719 OPE1.5 LX2 1 PSYSTM 1720 SA7 A7+B1 PSYSTM 1721 NG X2,OPE1.5 PSYSTM 1722 SA6 B3+EFETSNTL SENTINEL PSYSTM 1723 PSYSTM 1724 * CHECK BUFFER SIZE AND TERMINAL CONNECTION FOR PERSISTENT FILE. PSYSTM 1725 PSYSTM 1726 OPE2 LX1 ETEXT-59+59-EPERSIST PSYSTM 1727 ERRNZ EFETFET-1 FIX NEXT LINE PSYSTM 1728 SX2 B3+B1 PSYSTM 1729 PL X1,OPE4 IF NON-PERSISTENT PSYSTM 1730 OPEN X2,ALTERNR,R PSYSTM 1731 SA3 X2+4 FET+4 PSYSTM 1732 SA4 X2+B1 FET+1 PSYSTM 1733 SX5 X3 LIMIT PSYSTM 1734 SX7 X4 FIRST PSYSTM 1735 AX3 18 PSYSTM 1736 IX5 X5-X7 BUFFER LENGTH PSYSTM 1737 PSYSTM 1738 NOS IFNE KRONOS+NOS1+NOS2,0 V41AC01 22 SX3 X3 PRU SIZE PSYSTM 1740 NOS ENDIF PSYSTM 1741 PSYSTM 1742 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 1743 MX6 -15 PSYSTM 1744 BX3 -X6*X3 PRU SIZE PSYSTM 1745 NOSBE ENDIF PSYSTM 1746 PSYSTM 1747 IX6 X3-X5 PSYSTM 1748 SX1 IOED BUFFER TOO SMALL ON XXXXXXX PSYSTM 1749 PL X6,IOE1 IF BUFFER LENGTH <= PRU SIZE PSYSTM 1750 * WE SHOULD LIBERATE SHORT BUFFER AND PSYSTM 1751 * ALLOCATE A LONGER ONE INSTEAD OF PSYSTM 1752 * ABORTING. PSYSTM 1753 MX0 -12 PSYSTM 1754 LX4 -48 PSYSTM 1755 BX4 -X0*X4 DEVICE TYPE PSYSTM 1756 PSYSTM 1757 NOS IFNE KRONOS+NOS1+NOS2,0 V41AC01 23 SX6 X4-2RTT CHECK FOR DEVICE TYPE *TT* PSYSTM 1759 NOS ENDIF PSYSTM 1760 PSYSTM 1761 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 1762 AX4 6 PSYSTM 1763 SX6 X4-61B CHECK FOR DEVICE TYPE 61B PSYSTM 1764 NOSBE ENDIF PSYSTM 1765 PSYSTM 1766 SA1 X2-EFETFET EFET PSYSTM 1767 MX0 1 PSYSTM 1768 LX0 ECONNECT-59 V41EC01 8 BX7 -X0*X1 CLEAR TERMINAL BIT PSYSTM 1770 NZ X6,OPE3 IF NOT TERMINAL FILE PSYSTM 1771 BX7 X7+X0 SET TERMINAL BIT PSYSTM 1772 OPE3 SA7 A1 UPDATE EFET PSYSTM 1773 EQ OPEX RETURN PSYSTM 1774 PSYSTM 1775 SCOPE2 ELSE PSYSTM 1776 PSYSTM 1777 OPE ROUTINE P.OPE ENTRY/EXIT PSYSTM 1778 PSYSTM 1779 * SET FILE NAME INTO FIT PSYSTM 1780 PSYSTM 1781 SA1 B3 PSYSTM 1782 LX1 59-EPERSIST PSYSTM 1783 NG X1,OPE1 IF FILE PERSISTENT PSYSTM 1784 SB2 B3 PRESERVE B3 PSYSTM 1785 RJ NFN GENERATE NEW FILE NAME PSYSTM 1786 SB3 B2 RESTORE B3 PSYSTM 1787 OPE1 BX6 X2 PSYSTM 1788 SA6 B3+EFITFIT STORE FILE NAME PSYSTM 1789 PSYSTM 1790 * CLEAR 16 WORD FIT. PSYSTM 1791 PSYSTM 1792 MX6 0 PSYSTM 1793 SB7 FITSZ B7 := SIZE OF FIT PSYSTM 1794 OPE5 SB7 B7-B1 REPEAT B7 := B7-1 ; PSYSTM 1795 SA6 A6+B1 A6 := A6+1 ; FIT[A6] := 0 ; PSYSTM 1796 GT B7,B1,OPE5 UNTIL B7=1 ; PSYSTM 1797 SX2 B3+EFITFIT X2 IS FIT[0] PSYSTM 1798 PSYSTM 1799 * SET FILE PARAMETERS INTO FIT. PSYSTM 1800 PSYSTM 1801 SA4 B3+EFITBUF PSYSTM 1802 AX4 BUFADDR PSYSTM 1803 SX4 X4 PSYSTM 1804 STORE X2,WSA=X4 WORKSPACE ADDRESS=BUFADR PSYSTM 1805 STORE X2,RT=W DEFAULT TO W-RECORDS PSYSTM 1806 STORE X2,FO=SQ SEQUENTIAL ORGANIZATION PSYSTM 1807 STORE X2,EX=RMIOE PSYSTM 1808 STORE X2,EO=DD DISPLAY ERRONEOUS DATA PSYSTM 1809 STORE X2,CF=N SET CLOSE FLAG TO NO REWIND PSYSTM 1810 STORE X2,OF=N SET OPEN FLAG TO NO REWIND PSYSTM 1811 PSYSTM 1812 * SET EFET VALUES FOR A TEXT FILE. PSYSTM 1813 PSYSTM 1814 SA4 B3 X4 := EFET[0] PSYSTM 1815 BX3 X4 X3 := EFET[0] PSYSTM 1816 AX4 EWSALEN X4 := WSALEN PSYSTM 1817 LX3 59-ETEXT POSITION TEXT BIT PSYSTM 1818 PL X3,OPE6 IF NOT TEXTFILE PSYSTM 1819 SX7 -B1 X7 := -1 PSYSTM 1820 MX6 60 X6 := -0 PSYSTM 1821 SA7 B3+EFETLCNT LINECOUNT := -1 PSYSTM 1822 SA6 B3+EFETSNTL SENTINEL := -0 PSYSTM 1823 SX4 X4-1 RESERVE 1 WORD TO SIMULATE EOL PSYSTM 1824 PSYSTM 1825 * RETRIEVE FILE INFO FROM FDT. PSYSTM 1826 PSYSTM 1827 OPE6 SB7 X4 B7 = WSALEN PSYSTM 1828 STORE X2,MRLW=X4 MAXIMUM RECORD LENGTH (WORDS)=WSALEN PSYSTM 1829 SETFIT X2 PSYSTM 1830 FETCH X2,OC,X1 PSYSTM 1831 LX3 ETEXT-EPERSIST PSYSTM 1832 NG X3,OPE6.1 IF FILE PERSISTENT PSYSTM 1833 ZR X1,OPE6.2 IF FILE NONEXISTANT PSYSTM 1834 CLOSEM X2,U CLOSE AND UNLOAD PSYSTM 1835 EQ OPE6.2 PSYSTM 1836 PSYSTM 1837 OPE6.1 SX1 X1-1 PSYSTM 1838 ZR X1,OPE11 FILE ALREAY OPEN PSYSTM 1839 PSYSTM 1840 OPE6.2 SA3 X2 X3 := LFN PSYSTM 1841 SA4 =6LOUTPUT PSYSTM 1842 IX4 X3-X4 PSYSTM 1843 NZ X4,OPE7 IF FILE NOT OUTPUT PSYSTM 1844 PSYSTM 1845 * OPEN OUTPUT FILE. PSYSTM 1846 PSYSTM 1847 OPENM X2,OUTPUT,N OPEN FOR OUTPUT, NO REWIND PSYSTM 1848 EQ OPE11 PSYSTM 1849 PSYSTM 1850 OPE7 SA4 =5LINPUT PSYSTM 1851 IX4 X3-X4 PSYSTM 1852 NZ X4,OPE10 FILE NOT INPUT PSYSTM 1853 PSYSTM 1854 * OPEN INPUT FILE. PSYSTM 1855 PSYSTM 1856 OPENM X2,INPUT,N OPEN FOR INPUT PSYSTM 1857 EQ OPE11 PSYSTM 1858 PSYSTM 1859 * OPEN OTHER FILES. PSYSTM 1860 PSYSTM 1861 OPE10 BSS 0 PSYSTM 1862 OPENM X2,I-O,N INPUT-OUTPUT, NO REWIND PSYSTM 1863 PSYSTM 1864 * CHECK FDT FOR MRL AND RT. PSYSTM 1865 PSYSTM 1866 OPE11 FETCH X2,RT,X3 RECORD TYPE OF FILE PSYSTM 1867 FETCH X2,MRLW,X4 X4 = MRLW FROM FIT PSYSTM 1868 SX7 B7 X7:=WSALEN PSYSTM 1869 SX4 X4 DELETE UNUSED BIT COUNT PSYSTM 1870 SA5 B3 GET EFET[0] PSYSTM 1871 IX7 X7-X4 WSALEN-MRL PSYSTM 1872 LX5 0-ERT READY TO RECEIVE RT V41DC09 11 MX0 -ERTW V41DC09 12 BX6 X0*X5 ERASE PREVIOUS RT PSYSTM 1875 BX6 X6+X3 PUT IN NEW RT PSYSTM 1876 LX6 ERT V41DC09 13 SA6 A5 REPLACE EFET[0] PSYSTM 1878 PSYSTM 1879 * TEST FOR RECORD TYPES. PSYSTM 1880 PSYSTM 1881 SX0 X3-RTS PSYSTM 1882 ZR X0,OPE13 IF RT = S PSYSTM 1883 SX1 RMIOED PSYSTM 1884 NG X7,IOE1 IF MRL > BUFLEN PSYSTM 1885 PSYSTM 1886 * CALCULATE BUFLEN ACCORDING TO RECORD TYPE. PSYSTM 1887 PSYSTM 1888 SX0 X3-RTW PSYSTM 1889 ZR X0,OPE12 IF RT = W PSYSTM 1890 LX6 59-ETEXT PSYSTM 1891 NG X6,OPE12 IF TEXT FILE PSYSTM 1892 SX0 X3-RTZ PSYSTM 1893 ZR X0,OPE12.0 IF RT = Z PSYSTM 1894 SX0 X3-RTF PSYSTM 1895 ZR X0,OPE12.1 IF RT = F PSYSTM 1896 SX0 X3-RTU PSYSTM 1897 SX1 RMIOEC PSYSTM 1898 NZ X0,IOE1 IF UNSUPPORTED RECORD TYPE PSYSTM 1899 PSYSTM 1900 * RT = U OR F IF HERE. SET BUFLEN=LRL. PSYSTM 1901 PSYSTM 1902 OPE12.1 BSS 0 PSYSTM 1903 LX6 ETEXT-59 X1 := EFET[0] PSYSTM 1904 SB7 X6 B7 := LRL PSYSTM 1905 SX1 X6 X1 := LRL ONLY PSYSTM 1906 STORE X2,FLW=X1 PSYSTM 1907 PSYSTM 1908 * NOW INFORM USER. PSYSTM 1909 PSYSTM 1910 SX4 10D PSYSTM 1911 IX1 X1*X4 LRL IN CHARACTERS PSYSTM 1912 SA4 X2 X4:=42/LFN,18/RUBBISH PSYSTM 1913 MX3 42 PSYSTM 1914 BX6 X3*X4 X6:=42/LFN,18/0 PSYSTM 1915 SA6 OPEM.F2 PLACE IN MESSAGE PSYSTM 1916 SX5 B4 SAVE B4 PSYSTM 1917 SX0 B3 SAVE B3 PSYSTM 1918 RJ CDD= X4:= LEFT JUST DECIMAL DISPLAY(X1)-X1=LRL PSYSTM 1919 SB3 X0 RESTORE B3 PSYSTM 1920 SB4 X5 RESTORE B4 PSYSTM 1921 SX2 B3+EFITFIT PSYSTM 1922 BX6 X4 PSYSTM 1923 SA6 OPEM.N2 PLACE IN MESSAGE PSYSTM 1924 MESSAGE OPEM.2 PSYSTM 1925 EQ OPE13 PSYSTM 1926 PSYSTM 1927 * STORAGE FOR THE INFORMATIVE MESSAGE. PSYSTM 1928 PSYSTM 1929 OPEM.2 DIS 1, *** FL= PSYSTM 1930 OPEM.N2 DIS 1,NNNNN..... PSYSTM 1931 DIS 1, FOR FILE PSYSTM 1932 OPEM.F2 DIS 1,XXXXXXX... PSYSTM 1933 PSYSTM 1934 OPE12.0 BSS 0 PSYSTM 1935 LX6 ETEXT-59 PSYSTM 1936 SB7 X6 PSYSTM 1937 SX6 X6 X6 = LRL PSYSTM 1938 STORE X2,FLW=X6 PSYSTM 1939 PSYSTM 1940 * TEXT FILES JUMP STRAIGHT TO HERE. PSYSTM 1941 * RT= W,Z - HONOUR MRL ON FILE CARD. PSYSTM 1942 PSYSTM 1943 OPE12 BSS 0 PSYSTM 1944 SX0 X3-RTZ PSYSTM 1945 NZ X0,OPE13.2 PSYSTM 1946 STORE X2,BT=C PSYSTM 1947 CLOSEM X2,N PSYSTM 1948 OPENM X2,I-O,N REOPEN TO FORCE BT=C INTO FDT PSYSTM 1949 OPE13.2 BSS 0 PSYSTM 1950 SX0 X3-RTF PSYSTM 1951 NZ X0,OPE13.1 PSYSTM 1952 SX4 X4+B1 PSYSTM 1953 OPE13.1 BSS 0 PSYSTM 1954 SB7 X4 B7 := MRL PSYSTM 1955 PSYSTM 1956 * STORE USEABLE BUFFER LENGTH. PSYSTM 1957 PSYSTM 1958 OPE13 BSS 0 PSYSTM 1959 SX4 B7 PSYSTM 1960 SA5 B3+EFITBUF X5 = 24/RUBBISH,18/WSA,18/EOB PSYSTM 1961 LX4 BUFLEN PSYSTM 1962 MX6 60-BUFLEN PSYSTM 1963 BX6 -X6*X5 PSYSTM 1964 BX6 X6+X4 X6 := 24/B7,18/WSA,18/EOB PSYSTM 1965 SA6 A5 SET INTO EFET PSYSTM 1966 PSYSTM 1967 * CHECK FOR SEQUENTIAL FILE ORGANISATION. PSYSTM 1968 PSYSTM 1969 FETCH X2,FO,X3 X3:=FO PSYSTM 1970 SX1 RMIOEC FILE PARMS RESTRICTED TO FO=SQ PSYSTM 1971 NZ X3,IOE1 FLAG IO ERROR PSYSTM 1972 PSYSTM 1973 EQ OPEX RETURN PSYSTM 1974 PSYSTM 1975 RMIOE PS PSYSTM 1976 FETCH X2,ES,X1 X1 := ERROR NUMBER PSYSTM 1977 FETCH X2,RT,X0 PSYSTM 1978 SX0 X0-RTU PSYSTM 1979 NZ X0,RMIOE1 IF NOT RT=U ALLWAYS ABORT PSYSTM 1980 SX1 X1-143B ELSE IF INSUFFICIENT DATA PSYSTM 1981 ZR X1,RMIOE THEN RETURN; PSYSTM 1982 RMIOE1 BSS 0 PSYSTM 1983 SX0 X2-EFITFIT-13 FOR IOE. PSYSTM 1984 RJ CAD CONVERT ADDRESS TO DISPLAY PSYSTM 1985 MX4 6 PSYSTM 1986 SX3 1RR PSYSTM 1987 LX2 -12 PSYSTM 1988 LX3 -6 PSYSTM 1989 BX6 -X4*X2 PSYSTM 1990 BX6 X6+X3 X6 := !R NNNNNN ! PSYSTM 1991 SA6 MSGRMA+2 PSYSTM 1992 SX1 RMIOEA PSYSTM 1993 RJ IOE PSYSTM 1994 PSYSTM 1995 SCOPE2 ENDIF PSYSTM 1996 P.OS SPACE 4,10 PSYSTM 1997 ** P.OS - RETURN OPERATING SYSTEM ORDINAL. PSYSTM 1998 * PSYSTM 1999 * ENTRY (B1) = 1. PSYSTM 2000 * PSYSTM 2001 * EXIT (X6) = ORDINAL OF TARGET OPERATING SYSTEM. PSYSTM 2002 * PSYSTM 2003 * USES X - 6. PSYSTM 2004 PSYSTM 2005 PSYSTM 2006 OSO ROUTINE P.OS ENTRY/EXIT PSYSTM 2007 PSYSTM 2008 KRONOS IFNE KRONOS,0 PSYSTM 2009 SX6 XKRONOS SET KRONOS OPERATING SYSTEM PSYSTM 2010 KRONOS ENDIF PSYSTM 2011 PSYSTM 2012 NOS1 IFNE NOS1,0 V41AC01 24 SX6 XNOS1 SET NOS1 OPERATING SYSTEM V41AC01 25 NOS1 ENDIF V41AC01 26 V41AC01 27 NOS2 IFNE NOS2,0 V41AC01 28 SX6 XNOS2 SET NOS2 OPERATING SYSTEM V41AC01 29 NOS2 ENDIF V41AC01 30 PSYSTM 2016 NOSBE IFNE NOSBE,0 PSYSTM 2017 SX6 XNOSBE SET NOSBE OPERATING SYSTEM PSYSTM 2018 NOSBE ENDIF PSYSTM 2019 PSYSTM 2020 SCOPE2 IFNE SCOPE2,0 PSYSTM 2021 SX6 XSCOPE2 SET SCOPE2 OPERATING SYSTEM PSYSTM 2022 SCOPE2 ENDIF PSYSTM 2023 PSYSTM 2024 SCOPE34 IFNE SCOPE34,0 PSYSTM 2025 SX6 XSCOPE34 SET SCOPE34 OPERATING SYSTEM PSYSTM 2026 SCOPE34 ENDIF PSYSTM 2027 PSYSTM 2028 EQ OSOX RETURN PSYSTM 2029 P.PAGE SPACE 4,15 PSYSTM 2030 ** P.PAGE - START PAGE. PSYSTM 2031 * PSYSTM 2032 * ENTRY (A1) = EFET ADDRESS + EFETPTR. V41CC05 61 * (X1) = ((A1)). PSYSTM 2034 * PSYSTM 2035 * EXIT (X2) = FET ADDRESS. PSYSTM 2036 * PSYSTM 2037 * USES X - ALL. PSYSTM 2038 * A - 1, 3, 4, 6, 7. PSYSTM 2039 * B - 3, 7. PSYSTM 2040 * PSYSTM 2041 * CALLS PTC, PTL. PSYSTM 2042 PSYSTM 2043 PSYSTM 2044 PAG1 BSS 0 V41CC10 333 SX6 CHONE CARRIAGE CONTROL CHARACTER V41CC10 334 SA6 X1+ INTO CHAR BUFFER PSYSTM 2046 RJ PTC PUT CHARACTER PSYSTM 2047 PSYSTM 2048 PAG ROUTINE P.PAGE ENTRY/EXIT PSYSTM 2049 SX2 X1+ PSYSTM 2050 SX3 A1-EFETPTR+EFETCBUF FWA OF CHAR BUFFER V41CC05 62 IX3 X3-X2 NEGATIVE IF NON-EMPTY CHAR BUFFER PSYSTM 2052 ERRNZ PEOLN-59 SHIFT X1 V41CC05 63 BX3 -X3*X1 PSYSTM 2053 NG X3,PAG1 IF EMPTY CHAR BUFFER AND EOLN SET PSYSTM 2054 RJ PTL ELSE WRITELN PSYSTM 2055 V41CC05 64 OS IFNE SCOPE2,1 V41CC05 65 SA1 X2-EFETFET+EFETPTR UPDATE A1/X1 V41CC05 66 OS ELSE V41CC05 67 SA1 X2-EFITFIT+EFETPTR V41CC05 68 OS ENDIF V41CC05 69 V41CC05 70 EQ PAG1 PSYSTM 2057 P.PEG SPACE 4,20 PSYSTM 2058 ** P.PEG - ENTER GLOBAL BLOCK. PSYSTM 2059 * PSYSTM 2060 * ENTRY (B1) = 1. PSYSTM 2061 * (B3) = BHW FOR BLOCK BEING ENTERED. PSYSTM 2062 * (B4) = LWA+1 OF CURRENT STACK CHUNK PSYSTM 2063 * (B5) = CURRENT ACTIVATION RECORD (AR) PSYSTM 2064 * (B6) = TOP OF CURRENT PARAMETER STACK PSYSTM 2065 * X0..X4 MAY CONTAIN PARAMETERS PSYSTM 2066 * (CALL-1) = 30/EQ RA, 30/0 PSYSTM 2067 * PSYSTM 2068 * EXIT TO EPT+2. PSYSTM 2069 * (B4) = LWA+1 OF CURRENT STACK CHUNK. PSYSTM 2070 * (B5) = AR. PSYSTM 2071 * (B6) = AR+LCMAX. PSYSTM 2072 * PSYSTM 2073 * USES X - ALL. PSYSTM 2074 * A - 1, 2, 3, 4, 5, 6, 7. PSYSTM 2075 * B - 2, 3, 4, 5, 6, 7. PSYSTM 2076 * PSYSTM 2077 * CALLS SCO. PSYSTM 2078 PSYSTM 2079 PSYSTM 2080 PEG ROUTINE P.PEG ENTRY/EXIT PSYSTM 2081 PSYSTM 2082 * CREATE ACTIVATION LINKAGE. PSYSTM 2083 PSYSTM 2084 SA5 PEG 30/EQ EPT+2, 30/0 PSYSTM 2085 SX6 B3 60/BHW PSYSTM 2086 LX5 30 60/EQ EPT+2 PSYSTM 2087 SB2 X5 EPT+2 PSYSTM 2088 LX6 30 30/BHW, 30/0 PSYSTM 2089 SA5 X5-2 30/EQ RA, 30/0 PSYSTM 2090 ERRNZ ARPS-1 FIX NEXT LINE PSYSTM 2091 SA6 B6+B1 AR PSYSTM 2092 SX7 B5 60/DL PSYSTM 2093 BX7 X7+X5 30/EQ RA, 30/DL PSYSTM 2094 ERRNZ ARPS-1 FIX NEXT LINE PSYSTM 2095 SA7 B6 AR-1 PSYSTM 2096 PSYSTM 2097 * STORE PARAMETERS. PSYSTM 2098 * (B2 = EPT+2, B3 = BHW) PSYSTM 2099 PSYSTM 2100 PEG1 SA5 B3 BLOCK HEADER WORD PSYSTM 2101 MX6 -3 PSYSTM 2102 LX5 0-55 PSYSTM 2103 BX6 -X6*X5 PSYSTM 2104 SB7 X6 (5 - NUMBER OF REGISTERS TO SAVE) PSYSTM 2105 JP PEG2+B7 PSYSTM 2106 PSYSTM 2107 PEG2 BX6 X4 PSYSTM 2108 NO PSYSTM 2109 SA6 B6+ARPS+PFLC+4 PSYSTM 2110 + BX7 X3 PSYSTM 2111 NO PSYSTM 2112 SA7 B6+ARPS+PFLC+3 PSYSTM 2113 + BX6 X2 PSYSTM 2114 NO PSYSTM 2115 SA6 B6+ARPS+PFLC+2 PSYSTM 2116 + BX7 X1 PSYSTM 2117 NO PSYSTM 2118 SA7 B6+ARPS+PFLC+1 PSYSTM 2119 + BX6 X0 PSYSTM 2120 NO PSYSTM 2121 SA6 B6+ARPS+PFLC+0 PSYSTM 2122 PSYSTM 2123 * ALLOCATE ACTIVATION RECORD AND PARAMETER STACK PSYSTM 2124 PSYSTM 2125 + LX5 55-18 PSYSTM 2126 MX7 -12 PSYSTM 2127 BX7 -X7*X5 EXTRACT PSMAX PSYSTM 2128 LX5 18-0 PSYSTM 2129 SX6 X5 EXTRACT LCMAX+ARPS PSYSTM 2130 IX6 X6+X7 SPACE NEEDED PSYSTM 2131 SX7 B6 OLD TOP PSYSTM 2132 SX4 B4 LIMIT PSYSTM 2133 IX7 X7+X6 LWA+1 NEEDED PSYSTM 2134 IX4 X4-X7 PSYSTM 2135 PL X4,PEG3 IF NO OVERFLOW (LWA+1 <= LIMIT) PSYSTM 2136 SX7 B2+ PSYSTM 2137 SA7 PEGA SAVE B2 PSYSTM 2138 RJ SCO STACK CHUNK OVERFLOW PSYSTM 2139 SA4 PEGA PSYSTM 2140 SB2 X4 PSYSTM 2141 PSYSTM 2142 * SET STACK POINTERS AND GO. PSYSTM 2143 PSYSTM 2144 PEG3 SB5 B6+B1 NEW AR. *** PERFORM IN ONE WORD PSYSTM 2145 ERRNZ ARPS-1 FIX PREVIOUS LINE PSYSTM 2146 SB6 B6+X5 NEW AR+LCMAX. *** PERFORM IN ONE WORD PSYSTM 2147 JP B2 EPT+2 PSYSTM 2148 PSYSTM 2149 PEGA SCRATCH 1 TEMP PSYSTM 2150 P.PEN SPACE 4,25 PSYSTM 2151 ** P.PEN - ENTER NON-GLOBAL BLOCK. PSYSTM 2152 * PSYSTM 2153 * ENTRY (B1) = 1. PSYSTM 2154 * (B3) = BHW FOR BLOCK BEING ENTERED. PSYSTM 2155 * (B4) = LWA+1 OF CURRENT STACK CHUNK. PSYSTM 2156 * (B5) = CURRENT ACTIVATION RECORD (AR). PSYSTM 2157 * (B6) = TOP OF CURRENT PARAMETER STACK. PSYSTM 2158 * X0..X4 MAY CONTAIN PARAMETERS. PSYSTM 2159 * (X5) = STATIC LINK DESCRIPTOR. PSYSTM 2160 * (X5) < 0, A MASK GIVING RELATIVE LEVEL. PSYSTM 2161 * (X5) >= 0, 1/0, 41/, 18/SL. PSYSTM 2162 * (CALL-1) = 30/EQ RA, 30/0. PSYSTM 2163 * PSYSTM 2164 * EXIT TO PEG1. PSYSTM 2165 * (B2) = EPT+2. PSYSTM 2166 * (B3) = BHW FOR BLOCK BEING ENTERED. PSYSTM 2167 * (B4) = LWA+1 OF CURRENT STACK CHUNK. PSYSTM 2168 * (B5) = CURRENT ACTIVATION RECORD (AR). PSYSTM 2169 * (B6) = TOP OF CURRENT PARAMETER STACK. PSYSTM 2170 * X0..X4 MAY CONTAIN PARAMETERS. PSYSTM 2171 * PSYSTM 2172 * USES X - ALL. PSYSTM 2173 * A - 1, 2, 3, 4, 5, 6, 7. PSYSTM 2174 * B - 2, 3, 4, 5, 6, 7. PSYSTM 2175 PSYSTM 2176 PSYSTM 2177 PEN ROUTINE P.PEN ENTRY/EXIT PSYSTM 2178 PSYSTM 2179 * GET STATIC LINK. PSYSTM 2180 PSYSTM 2181 PL X5,PEN2 IF X5 = 1/0, 41/, 18/SL PSYSTM 2182 BX6 X5 ELSE X5 = MASK PSYSTM 2183 SA5 B5 PSYSTM 2184 PEN1 LX6 1 PSYSTM 2185 SA5 X5 PSYSTM 2186 NG X6,PEN1 IF LEVEL NOT REACHED PSYSTM 2187 PSYSTM 2188 * GENERATE ACTIVATION LINKAGE. PSYSTM 2189 PSYSTM 2190 PEN2 SX6 B3 60/BHW PSYSTM 2191 SX5 X5 60/SL PSYSTM 2192 LX6 30 30/BHW, 30/0 PSYSTM 2193 BX6 X6+X5 30/BHW, 30/SL PSYSTM 2194 SA5 PEN 30/EQ EPT+2, 30/0 PSYSTM 2195 ERRNZ ARPS-1 FIX NEXT LINE PSYSTM 2196 SA6 B6+B1 AR PSYSTM 2197 LX5 30 PSYSTM 2198 SB2 X5 EPT+2 PSYSTM 2199 SA5 X5-2 30/EQ RA, 30/0 PSYSTM 2200 SX7 B5 60/DL PSYSTM 2201 BX7 X7+X5 30/EQ RA, 30/DL PSYSTM 2202 ERRNZ ARPS-1 FIX NEXT LINE PSYSTM 2203 SA7 B6 AR-1 PSYSTM 2204 EQ PEG1 (B2 = EPT+2, B3 = BHW) PSYSTM 2205 P.PEX SPACE 4,20 PSYSTM 2206 ** P.PEX - BLOCK-EXIT CODE. PSYSTM 2207 * PSYSTM 2208 * ENTRY (X6) = FUNCTION-ACTIVATION RESULT, IF ANY. PSYSTM 2209 * (B4) = LWA+1 OF CURRENT STACK CHUNK. PSYSTM 2210 * (B5) = CURRENT ACTIVATION RECORD (AR). PSYSTM 2211 * (B6) = TOP OF CURRENT PARAMETER STACK. PSYSTM 2212 * PSYSTM 2213 * EXIT TO RA OF CALLING ROUTINE. PSYSTM 2214 * B4, B5, B6 RESTORED TO PRE-CALL STATE. PSYSTM 2215 * X6 UNCHANGED. PSYSTM 2216 * PSYSTM 2217 * USES X - ALL. PSYSTM 2218 * A - 1, 2, 3, 4, 5, 6, 7. PSYSTM 2219 * B - 2, 3, 4, 5, 6, 7. PSYSTM 2220 * PSYSTM 2221 * CALLS SCU. PSYSTM 2222 PSYSTM 2223 PSYSTM 2224 PEX ENTER P.PEX ENTRY PSYSTM 2225 SA1 B5-B1 30/EQ RA, 30/DL PSYSTM 2226 ERRNZ ARPS-1 FIX NEXT LINE PSYSTM 2227 SB6 B5-B1 *** PERFORM IN ONE WORD PSYSTM 2228 SB5 X1 *** PERFORM IN ONE WORD PSYSTM 2229 LX1 30 PSYSTM 2230 SB7 X1 PSYSTM 2231 JP B7 (B7 = RA) PSYSTM 2232 P.PUTB SPACE 4,15 PSYSTM 2233 ** P.PUTB - PUT BINARY. PSYSTM 2234 * PSYSTM 2235 * ENTRY (A1) = EFET ADDRESS. PSYSTM 2236 * (X1) = ((A1)). PSYSTM 2237 * PSYSTM 2238 * EXIT (X2) = FET ADDRESS. PSYSTM 2239 * (X4) = FILE BUFFER POINTER. V41CC10 335 * (X5) = UNCHANGED (ASCII). V41CC10 336 * (A2) = UNCHANGED (ASCII). V41CC10 337 * PSYSTM 2240 * USES X - 0, 1, 2, 3, 4, 6, 7. PSYSTM 2241 * A - 1, 3, 4, 6, 7. PSYSTM 2242 * B - 3, 7. PSYSTM 2243 * PSYSTM 2244 * CALLS IOE, RMP, WWR. PSYSTM 2245 * PSYSTM 2246 * MACROS RECALL, WRITE. PSYSTM 2247 PSYSTM 2248 PSYSTM 2249 PTB ROUTINE P.PUTB ENTRY/EXIT PSYSTM 2250 PSYSTM 2251 SCOPE2 IFNE SCOPE2,1 PSYSTM 2252 ERRNZ ELRL SHIFT X1 V41CC05 71 SB3 X1+ LRL PSYSTM 2253 SA3 A1+EFETFET+2 IN V41CC05 72 LX1 59-EREWRITE V41CC05 73 ERRNZ EFETFET-1 FIX NEXT LINE V41CC05 74 SX2 A1+B1 FET PSYSTM 2256 SA4 A1+EFETFET+4 LIMIT V41CC05 75 PL X1,WWR IF WRITE WITHOUT REWRITE V41CC13 10 SX4 X4 LIMIT PSYSTM 2259 SX6 X3+B3 IN + LRL PSYSTM 2260 IX7 X6-X4 PSYSTM 2261 SA1 X2+B1 FIRST PSYSTM 2262 SX6 X1+ FIRST PSYSTM 2263 IX0 X4-X6 LIMIT - FIRST PSYSTM 2264 PL X7,PTB1 IF IN = LIMIT PSYSTM 2265 SX6 X3+B3 IN + LRL PSYSTM 2266 PTB1 SA6 A3 ADVANCE IN PSYSTM 2267 BX4 X6 PSYSTM 2268 SA6 X2-EFETFET+EFETPTR ADVANCE FILE POINTER V41FC05 6 PTB2 SA1 X2 FET V41FC04 6 BX3 X1 V41FC04 7 LX3 59-0 V41FC04 8 SA1 A3+B1 OUT V41FC04 9 IX6 X1-X4 OUT - IN V41FC04 10 SX6 X6-1 EMPTY SPACE IN BUFFER V41FC04 11 AX7 X0,B1 PSYSTM 2273 PL X6,PTB3 IF OUT >= IN PSYSTM 2274 IX6 X0+X6 PSYSTM 2275 PTB3 IX1 X7-X6 PSYSTM 2276 SB7 X6 PSYSTM 2277 NG X1,PTBX IF BUFFER HALF EMPTY PSYSTM 2278 PL X3,PTB4 IF FET BUSY V41FC04 12 WRITE X2 PSYSTM 2282 PTB4 GE B7,B3,PTBX IF BUFFER NOT FULL PSYSTM 2283 RECALL PSYSTM 2284 EQ PTB2 PSYSTM 2285 PSYSTM 2286 SCOPE2 ELSE PSYSTM 2287 PSYSTM 2288 ERRNZ ELRL SHIFT X1 V41CC05 76 SB3 X1 B3 := LRL PSYSTM 2289 SA3 A1+EFITOUT X3 := OUT V41CC05 77 LX1 59-EREWRITE PSYSTM 2291 SX2 A1+EFITFIT X2 := FIT[0] PSYSTM 2292 PL X1,WWR IF WRITE WITHOUT REWRITE V41CC13 11 PSYSTM 2294 SX7 X3+B3 PSYSTM 2295 SA7 A3 OUT := OUT+LRL PSYSTM 2296 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 78 SA7 A1-B1 EFET[-1] := OUT (NON TEXT-FILES) PSYSTM 2297 ERRNZ EFITBUF-1 FIX NEXT LINE V41CC05 79 SA3 A1+B1 GET BUFFER DESCRIPTOR PSYSTM 2298 SX3 X3 X3 := EOR PSYSTM 2299 SX4 X7+B3 OUT+LRL PSYSTM 2300 IX0 X3-X4 EOR - END OF LAST RECORD PSYSTM 2301 PL X0,PTBX IF ROOM FOR MORE PSYSTM 2302 PSYSTM 2303 * WRITE OUT FULL BUFFER. PSYSTM 2304 PSYSTM 2305 ERRNZ EFITBUF-1 FIX NEXT LINE V41CC05 80 SA3 A1+B1 X3 := BUFFER DESCRIPTOR PSYSTM 2306 AX3 18 PSYSTM 2307 SX3 X3 X3 := BUFADR PSYSTM 2308 IX4 X7-X3 X4 := NO. OF WORDS FOR TRANSFER PSYSTM 2309 SA1 A1 REFRESH X1 PSYSTM 2310 LX1 59-ETEXT INSPECT TEXT-FILE BIT V41CC05 81 NG X1,PTB1 IF CURRENT TEXT LINE TOO LONG PSYSTM 2312 PSYSTM 2313 RJ RMP RECORD MANAGER PUT PSYSTM 2314 EQ PTBX RETURN PSYSTM 2315 PSYSTM 2316 PTB1 BSS 0 BUFFER TOO SMALL FOR LINE PSYSTM 2317 SX1 IOED BUFFER TOO SMALL ON XXXXXXX PSYSTM 2318 EQ IOE1 ISSUE INPUT/OUTPUT ERROR PSYSTM 2319 PSYSTM 2320 SCOPE2 ENDIF PSYSTM 2321 P.PUTC SPACE 4,15 PSYSTM 2322 ** P.PUTC - PUT CHARACTER. PSYSTM 2323 * PSYSTM 2324 * ENTRY (A1) = EFET ADDRESS + EFETPTR. V41CC05 82 * (X1) = ((A1)). PSYSTM 2326 * PSYSTM 2327 * EXIT (X2) = ADDRESS OF THE FET. PSYSTM 2328 * PSYSTM 2329 * USES X - 0, 1, 2, 3, 4, 6, 7. PSYSTM 2330 * A - 1, 2, 3, 4, 6, 7. V41CC10 338 * B - 3, 7. PSYSTM 2332 * PSYSTM 2333 * CALLS PCH. PSYSTM 2334 PSYSTM 2335 PSYSTM 2336 PTC ROUTINE P.PUTC ENTRY/EXIT PSYSTM 2337 SA3 X1+B1 LOOK AHEAD IN CHARACTER BUFFER PSYSTM 2338 SX4 B1 PSYSTM 2339 IX6 X1+X4 ADVANCE POINTER PSYSTM 2340 V41CC10 339 ASCII IFEQ ASCFLAG,1 V41CC10 340 ERRNZ PREWRITE-58 FIX NEXT LINE V41CC10 341 LX0 X1,B1 LEFT-ADJUST REWRITE BIT V41CC10 342 BX0 -X0+X3 V41CC10 343 ASCII ENDIF V41CC10 344 V41CC10 345 SA6 A1 UPDATE POINTER PSYSTM 2341 PSYSTM 2342 SCOPE2 IFNE SCOPE2,1 PSYSTM 2343 SX2 A1+EFETFET-EFETPTR FET PSYSTM 2344 SCOPE2 ELSE PSYSTM 2345 SX2 A1+EFITFIT-EFETPTR FIT PSYSTM 2346 SCOPE2 ENDIF PSYSTM 2347 PSYSTM 2348 ASCII IFNE ASCFLAG,1 V41CC10 346 PL X3,PTCX IF BUFFER NOT FULL V41CC10 347 ASCII ELSE V41CC10 348 PL X0,PTCX IF BUFFER NOT FULL V41CC10 349 ASCII ENDIF V41CC10 350 V41CC10 351 SX7 PTCX RETURN ADDRESS PSYSTM 2350 * EQ PCH FALL THROUGH TO HELPER TO EMPTY BUFFER PSYSTM 2351 P.PUTCH SPACE 4,15 PSYSTM 2352 ** P.PUTCH - PUT CHARACTER HELPER. PSYSTM 2353 * PSYSTM 2354 * ENTRY (A1) = EFET ADDRESS + EFETPTR. V41CC05 83 * (X1) = ((A1)). PSYSTM 2356 * (X7) = RETURN ADDRESS. PSYSTM 2357 * PSYSTM 2358 * EXIT (X2) = ADDRESS OF THE FET. PSYSTM 2359 * (X5) = UNCHANGED (ASCII). V41CC10 352 * (X6) = DISPLAY CODE BUFFER (ASCII). V41CC10 353 * (A6) = FILE BUFFER POINTER. V41CC10 354 * (B3) = DISPLAY CODE BUFFER INDEX (ASCII). V41CC10 355 * PSYSTM 2360 * USES X - 0, 1, 2, 3, 4, 6, 7. PSYSTM 2361 * A - 1, 2, 3, 4, 6, 7. V41CC10 356 * B - 3, 7. PSYSTM 2363 * PSYSTM 2364 * CALLS PTB, WWR. PSYSTM 2365 PSYSTM 2366 PSYSTM 2367 PCH ENTER P.PUTCH ENTRY PSYSTM 2368 V41CC10 357 ASCII IFNE ASCFLAG,1 V41CC10 358 SA7 PCHA SAVE RETURN ADDRESS PSYSTM 2369 PSYSTM 2370 SCOPE2 IFNE SCOPE2,1 PSYSTM 2371 SX2 A1+EFETFET-EFETPTR FET PSYSTM 2372 SCOPE2 ELSE PSYSTM 2373 SX2 A1+EFITFIT-EFETPTR FIT PSYSTM 2374 SCOPE2 ENDIF PSYSTM 2375 PSYSTM 2376 LX1 59-PREWRITE V41CC05 84 PSYSTM 2378 SCOPE2 IFNE SCOPE2,1 PSYSTM 2379 SA4 X2-EFETFET+EFETCBUF LOAD CHARACTER 1 PSYSTM 2380 SCOPE2 ELSE PSYSTM 2381 SA4 X2-EFITFIT+EFETCBUF LOAD CHARACTER 1 PSYSTM 2382 SCOPE2 ENDIF PSYSTM 2383 PSYSTM 2384 SA3 A4+B1 LOAD CHARACTER 2 PSYSTM 2385 PL X1,WWR IF WRITE WITHOUT REWRITE V41CC13 12 LX4 6 PSYSTM 2387 SA1 A3+B1 LOAD CHARACTER 3 PSYSTM 2388 BX7 X4+X3 PSYSTM 2389 SA3 A1+B1 LOAD CHARACTER 4 PSYSTM 2390 LX7 6 PSYSTM 2391 BX4 X7+X1 PSYSTM 2392 SA1 A3+B1 LOAD CHARACTER 5 PSYSTM 2393 LX4 6 PSYSTM 2394 BX7 X4+X3 PSYSTM 2395 SA3 A1+B1 LOAD CHARACTER 6 PSYSTM 2396 LX7 6 PSYSTM 2397 BX4 X7+X1 PSYSTM 2398 SA1 A3+B1 LOAD CHARACTER 7 PSYSTM 2399 LX4 6 PSYSTM 2400 BX7 X4+X3 PSYSTM 2401 SA3 A1+B1 LOAD CHARACTER 8 PSYSTM 2402 LX7 6 PSYSTM 2403 BX4 X7+X1 PSYSTM 2404 SA1 A3+B1 LOAD CHARACTER 9 PSYSTM 2405 LX4 6 PSYSTM 2406 BX7 X4+X3 PSYSTM 2407 SA3 A1+B1 LOAD CHARACTER 10 PSYSTM 2408 LX7 6 PSYSTM 2409 BX1 X7+X1 PSYSTM 2410 PSYSTM 2411 SCOPE2 IFNE SCOPE2,1 PSYSTM 2412 SA4 X2-EFETFET+EFETIN IN PSYSTM 2413 SCOPE2 ELSE PSYSTM 2414 SA4 X2-EFITFIT+EFITIN IN PSYSTM 2415 SCOPE2 ENDIF PSYSTM 2416 PSYSTM 2417 LX1 6 PSYSTM 2418 BX7 X1+X3 PACKED WORD PSYSTM 2419 SA7 X4+ STORE WORD IN BUFFER PSYSTM 2420 PSYSTM 2421 SCOPE2 IFNE SCOPE2,1 PSYSTM 2422 SA1 X2-EFETFET EFET PSYSTM 2423 SCOPE2 ELSE PSYSTM 2424 SA1 X2-EFITFIT EFIT PSYSTM 2425 SCOPE2 ENDIF PSYSTM 2426 PSYSTM 2427 RJ PTB PUT BINARY PSYSTM 2428 MX6 1 PSYSTM 2429 PSYSTM 2430 SCOPE2 IFNE SCOPE2,1 PSYSTM 2431 SX3 X2-EFETFET+EFETCBUF PSYSTM 2432 SCOPE2 ELSE PSYSTM 2433 SX3 X2-EFITFIT+EFETCBUF PSYSTM 2434 SCOPE2 ENDIF PSYSTM 2435 PSYSTM 2436 LX6 PREWRITE-59 V41CC05 85 SA1 PCHA PSYSTM 2438 BX6 X3+X6 FILE POINTER WITH REWRITE SET, EOLN CLEAR. PSYSTM 2439 SB7 X1 RETURN ADDRESS PSYSTM 2440 PSYSTM 2441 SCOPE2 IFNE SCOPE2,1 PSYSTM 2442 SA6 X2-EFETFET+EFETPTR PSYSTM 2443 SCOPE2 ELSE PSYSTM 2444 SA6 X2-EFITFIT+EFETPTR PSYSTM 2445 SCOPE2 ENDIF PSYSTM 2446 PSYSTM 2447 JP B7 RETURN PSYSTM 2448 ASCII ELSE V41CC10 359 SA4 A1-EFETPTR+EFETIN V41CC10 360 NO V41CC10 361 LX1 59-PREWRITE CHECK REWRITE BIT V41CC10 362 SX2 A1-EFETPTR+EFETFET V41CC10 363 PL X1,WWR IF WRITE WITHOUT REWRITE V41CC10 364 SA1 X2-EFETFET+EFET V41CC10 365 SA2 X2-EFETFET+EFETCBUF CHARBUFF[1] V41CC10 366 SA7 PCHA SAVE RETURN ADDRESS V41CC10 367 BX6 X5 V41CC10 368 SA6 PCHB SAVE X5 - WE NEED TO USE IT V41CC10 369 SA3 X4 FETCH DCB V41CC10 370 MX0 -DCCHARSZ V41CC10 371 LX1 -EDCCHS RIGHT ADJUST DCCHS FIELD V41CC10 372 SB3 X1 DCCHS V41CC10 373 LX1 EDCCHS REPOSITION EFET V41CC10 374 BX6 X3 DCB (DISPLAY CODE BUFFER) V41CC10 375 NG X2,PCH4 IF END-OF-BUFFER V41CC10 376 V41CC10 377 * CONVERT AND PACK CHARS FROM CHARBUFF INTO DCB. V41CC10 378 V41CC10 379 PCH1 SA3 X2+=XP.TA2D LOAD DISPLAY-CODE CHAR V41CC10 380 BX5 -X0*X3 TEMPCH V41CC10 381 AX3 DCCHARSZ CH V41CC10 382 V41CC10 383 * ADD DISPLAY CODE CHAR INTO DCB. V41CC10 384 V41CC10 385 PCH2 LX6 DCCHARSZ V41CC10 386 SB3 B3-B1 DCCHS := DCCHS - 1 V41CC10 387 BX6 X6+X3 ADD INTO DCB V41CC10 388 SA6 X4 PUT DCB IN CIRCULAR BUFFER V41CC10 389 NZ B3,PCH3 IF LESS THAN DCALFALN CHARS IN DCB V41CC10 390 V41CC10 391 * DCB FULL, PUT IT INTO CIRCULAR BUFFER, CALL PTB. V41CC10 392 V41CC10 393 RJ PTB PUT BINARY V41CC10 394 SA1 X2-EFETFET+EFET V41CC10 395 BX6 X6-X6 EMPTY BUFFER V41CC10 396 MX0 -DCCHARSZ V41CC10 397 SB3 DCALFALN DCCHS := DCALFALN V41CC10 398 V41CC10 399 * CHECK AND HANDLE EXTENDED DISPLAY CODE CHAR. V41CC10 400 V41CC10 401 PCH3 BX3 X5 CH := TEMPCH V41CC10 402 BX5 X5-X5 TEMPCH := 0 V41CC10 403 NZ X3,PCH2 IF EXTENDED DISPLAY CODE CHAR V41CC10 404 SA2 A2+B1 GET NEXT CHAR V41CC10 405 PL X2,PCH1 IF NOT END OF BUFFER V41CC10 406 V41CC10 407 * CHARACTERS CONVERTED AND PACKED, UPDATE P AND DCCHS, RETURN. V41CC10 408 V41CC10 409 PCH4 SA2 PCHA RETURN ADDRESS V41CC10 410 SA3 PCHB (X5) V41CC10 411 SX7 B3 DCCHS V41CC10 412 MX5 -EDCCHSW V41CC10 413 LX1 -EDCCHS RIGHT ADJUST DCCHS FIELD V41CC10 414 BX5 X1*X5 MASK OFF OLD DCCHS V41CC10 415 BX7 X7+X5 REPLACE IT WITH NEW DCCHS V41CC10 416 LX7 EDCCHS REPOSITION V41CC10 417 SA7 A1 9/DISP,15/,18/DCCHS,18/LRL V41CC10 418 MX1 1 V41CC10 419 LX1 PREWRITE+1 SET REWRITE BIT V41CC10 420 SX7 A1-EFET+EFETCBUF V41CC10 421 SA6 X4 SAVE DCB V41CC10 422 BX7 X1+X7 1/EOLN,1/REWRITE,40/,18/P (EOLN = 0) V41CC10 423 SA7 A1-EFET+EFETPTR V41CC10 424 SB7 X2 V41CC10 425 BX5 X3 RESTORE X5 V41CC10 426 SX2 A1-EFET+EFETFET V41CC10 427 JP B7 RETURN V41CC10 428 ASCII ENDIF V41CC10 429 PSYSTM 2449 ASCII IFNE ASCFLAG,1 V41CC10 430 PCHA SCRATCH 1 PSYSTM 2450 ASCII ELSE V41CC10 431 PCHA SCRATCH 1 RETURN ADDRESS V41CC10 432 PCHB SCRATCH 1 (X5) V41CC10 433 ASCII ENDIF V41CC10 434 P.PUTLN SPACE 4,15 PSYSTM 2451 ** P.PUTLN - WRITELN. PSYSTM 2452 * PSYSTM 2453 * ENTRY (A1) = EFET ADDRESS + EFETPTR. V41CC05 86 * (X1) = ((A1)). PSYSTM 2455 * PSYSTM 2456 * EXIT (X2) = FET ADDRESS. PSYSTM 2457 * PSYSTM 2458 * USES X - 0, 1, 2, 3, 4, 6, 7. V41CC10 435 * A - 1, 2, 3, 4, 6, 7. V41CC10 436 * B - 3, 7. PSYSTM 2461 * PSYSTM 2462 * CALLS IOE, PCH, PTB, RMP, WWR. V41CC10 437 * PSYSTM 2464 * MACROS WRITE. PSYSTM 2465 PSYSTM 2466 PSYSTM 2467 PTL ROUTINE P.PUTLN ENTRY/EXIT PSYSTM 2468 V41CC10 438 ASCII IFNE ASCFLAG,1 V41CC10 439 SB3 X1+ PSYSTM 2469 SB7 60-6 PSYSTM 2470 PSYSTM 2471 SCOPE2 IFNE SCOPE2,0 PSYSTM 2472 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 87 SA5 A1+B1 X5 := EFET[0] PSYSTM 2473 LX5 0-ERT-ERTW V41CC05 88 AX5 -ERTW V41CC05 89 SX5 X5-RTF PSYSTM 2476 NZ X5,PTL0.2 IF RT <> F PSYSTM 2477 PSYSTM 2478 * SPACE FILL TO END OF WORD. PSYSTM 2479 PSYSTM 2480 ERRNZ EFETPTR-EFETSNTL-1 FIX NEXT LINE V41CC05 90 SB7 A1-B1 B7 = SENTINEL PSYSTM 2481 SX6 1R PSYSTM 2482 EQ B3,B7,PTL0.2 IF REACHED SENTINEL PSYSTM 2483 PTL0.1 SA6 B3 PSYSTM 2484 SB3 B3+B1 PSYSTM 2485 NE B3,B7,PTL0.1 IF MORE CHARACTERS TO SPACE FILL PSYSTM 2486 SB7 60-6+1000B ONLY LOWER 6-BIT ARE SIGNIFICANT PSYSTM 2487 PTL0.2 BSS 0 PSYSTM 2488 SCOPE2 ENDIF PSYSTM 2489 PSYSTM 2490 SA4 A1-EFETPTR+EFETCBUF FWA CHARACTER BUFFER V41CC05 91 LX1 59-PREWRITE V41CC05 92 BX6 X6-X6 INITIALIZE PACKED WORD PSYSTM 2493 PSYSTM 2494 SCOPE2 IFNE SCOPE2,1 PSYSTM 2495 SX2 A1+EFETFET-EFETPTR PSYSTM 2496 SCOPE2 ELSE PSYSTM 2497 SX2 A1+EFITFIT-EFETPTR PSYSTM 2498 SCOPE2 ENDIF PSYSTM 2499 PSYSTM 2500 PL X1,WWR IF WRITE WITHOUT REWRITE V41CC13 13 SB3 A4-B3 CHARACTER COUNT PSYSTM 2502 SX7 B3 PSYSTM 2503 ZR B3,PTL5 IF CHARACTER BUFFER EMPTY PSYSTM 2504 SX1 -6 PSYSTM 2505 PTL1 LX3 B7,X4 PREPARE CHARACTER PSYSTM 2506 SB3 B3+B1 ADVANCE CHARACTER COUNT PSYSTM 2507 SB7 B7+X1 ADVANCE SHIFT COUNT PSYSTM 2508 BX6 X6+X3 INSERT CHARACTER PSYSTM 2509 SA4 A4+B1 FETCH NEXT CHARACTER PSYSTM 2510 NG B3,PTL1 IF MORE CHARACTERS LEFT PSYSTM 2511 LX7 59-0 PSYSTM 2512 NG X7,PTL2 IF EVEN NUMBER OF CHARACTERS PSYSTM 2513 SX4 1R PSYSTM 2514 NO PSYSTM 2515 LX3 B7,X4 PSYSTM 2516 SB7 B7+X1 PSYSTM 2517 BX6 X6+X3 APPEND A BLANK IF ODD NUMBER PSYSTM 2518 PTL2 NZ X3,PTL3 IF ORD(PREVIOUS CHAR) <> 00B PSYSTM 2519 SX4 2R PSYSTM 2520 SB7 B7+X1 PSYSTM 2521 LX3 B7,X4 PSYSTM 2522 SB7 B7+X1 PSYSTM 2523 BX6 X6+X3 APPEND 2 BLANKS TO PROTECT ZERO CHARACTER PSYSTM 2524 PSYSTM 2525 SCOPE2 IFNE SCOPE2,1 PSYSTM 2526 PTL3 SA3 X2-EFETFET+EFETIN IN PSYSTM 2527 SCOPE2 ELSE PSYSTM 2528 PTL3 SA3 X2-EFITFIT+EFITIN IN PSYSTM 2529 SCOPE2 ENDIF PSYSTM 2530 PSYSTM 2531 SX5 B7 SAVE SHIFT COUNT PSYSTM 2532 SA6 X3 STORE PACKED WORD IN BUFFER PSYSTM 2533 PSYSTM 2534 SCOPE2 IFNE SCOPE2,1 PSYSTM 2535 ERRNZ EFETPTR+1 PSYSTM 2536 SA1 A1+B1 EFET PSYSTM 2537 SCOPE2 ELSE PSYSTM 2538 SA1 X2-EFITFIT EFET PSYSTM 2539 SCOPE2 ENDIF PSYSTM 2540 PSYSTM 2541 RJ PTB PUT BINARY PSYSTM 2542 PSYSTM 2543 SCOPE2 IFNE SCOPE2,1 PSYSTM 2544 SA3 X2+2 IN PSYSTM 2545 PL X5,PTL4 IF WORD WAS NOT FULL PSYSTM 2546 BX6 X6-X6 PSYSTM 2547 SA1 X2-EFETFET EFET V41CC05 93 SA6 X3 STORE A ZERO WORD FOR END OF LINE PSYSTM 2549 RJ PTB PUT BINARY PSYSTM 2550 PTL4 SA4 X2-EFETFET+EFETLCNT LINE COUNT V41CC05 94 SCOPE2 ELSE PSYSTM 2552 NG X5,PTL5.1 APPEND ZERO WORD PSYSTM 2553 MX6 0 PSYSTM 2554 SA6 X2-EFITFIT+EFETCBUF+9 SET LAST CHAR WRITTEN = COLON V41CC05 95 SA1 X2-EFITFIT EFET[0] PSYSTM 2556 ERRNZ EFITBUF-1 FIX NEXT LINE V41CC05 96 SA3 A1+B1 X3 := 24/BUFLEN,18/BUFADR,18/EOR PSYSTM 2557 ERRNZ EFITOUT-EFITBUF-1 FIX NEXT LINE V41CC05 97 SA4 A3+B1 X4 := OUT PSYSTM 2558 AX3 18 PSYSTM 2559 SX5 X5+6 UNUSED BITS PSYSTM 2560 SX3 X3 X3 := BUFADR PSYSTM 2561 IX4 X4-X3 NUMBER WORDS TO TRANSFER PSYSTM 2562 LX5 18 PSYSTM 2563 BX4 X4+X5 X4:=42/UNUSED-BITS,18/TRANSFER-WORDS PSYSTM 2564 RJ RMP RECORD MANAGER PUT PSYSTM 2565 SA4 X2-EFITFIT+EFETLCNT V41CC05 98 SCOPE2 ENDIF PSYSTM 2567 PSYSTM 2568 MX3 2 PSYSTM 2569 SX6 A4+B1 FWA CHARACTER BUFFER PSYSTM 2570 SX1 IOEA BEYOND LINELIMIT ON XXXXXXX PSYSTM 2571 SX7 B1 PSYSTM 2572 IX7 X4-X7 COUNT THE LINE PSYSTM 2573 ERRNZ PEOLN-59 FIX X3 V41CC05 99 ERRNZ PREWRITE-58 FIX X3 V41CC05 100 BX6 X6+X3 FILE POINTER WITH EOLN AND REWRITE BITS SET PSYSTM 2574 SA7 A4 UPDATE LINECOUNT PSYSTM 2575 PSYSTM 2576 SCOPE2 IFNE SCOPE2,1 PSYSTM 2577 SA6 X2-EFETFET+EFETPTR PSYSTM 2578 SCOPE2 ELSE PSYSTM 2579 SA6 X2-EFITFIT+EFETPTR PSYSTM 2580 SCOPE2 ENDIF PSYSTM 2581 PSYSTM 2582 ZR X4,IOE1 IF BEYOND LINELIMIT PSYSTM 2583 PSYSTM 2584 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 2585 SA1 X2+B1 PSYSTM 2586 AX1 54 DEVICE TYPE FROM FET PSYSTM 2587 SX1 X1+77B-61B PSYSTM 2588 NZ X1,PTLX IF FILE IS NOT CONNECTED PSYSTM 2589 WRITE X2 FLUSH BUFFER PSYSTM 2590 NOSBE ENDIF PSYSTM 2591 PSYSTM 2592 EQ PTLX RETURN PSYSTM 2593 PSYSTM 2594 * WRITE END OF LINE. PSYSTM 2595 PSYSTM 2596 SCOPE2 IFNE SCOPE2,1 PSYSTM 2597 PTL5 SA3 X2-EFETFET+EFETCBUF+9 LAST CHARACTER OF PREVIOUS WORD V41CC05 101 NZ X3,PTL3 IF ORD(PREVOUS CHAR) <> 00B PSYSTM 2599 SX6 2R PSYSTM 2600 NO PSYSTM 2601 LX6 -12 APPEND 2 BLANKS TO PROTECT ZERO CHARACTER PSYSTM 2602 EQ PTL3 PSYSTM 2603 SCOPE2 ELSE PSYSTM 2604 PTL5 SA3 X2-EFITFIT+EFETCBUF+9 LAST CHARACTER V41CC05 102 ZR X3,PTL5.2 PSYSTM 2606 PTL5.1 BSS 0 PSYSTM 2607 MX6 0 PSYSTM 2608 SB7 60-6 60 UNUSED BITS PSYSTM 2609 EQ PTL3 PSYSTM 2610 PTL5.2 SB7 60-6-12 12 USED BITS (2 SPACES) PSYSTM 2611 SX6 2R PSYSTM 2612 LX6 -12 PSYSTM 2613 EQ PTL3 PSYSTM 2614 SCOPE2 ENDIF PSYSTM 2615 ASCII ELSE V41CC10 440 MX6 60 EFETSNTL := -0 V41CC10 441 SA6 X1 PUT SENTINEL AT P V41CC10 442 SX6 X1 P V41CC10 443 SA6 PTLA SAVE P V41CC10 444 SX7 PTL1 RETURN ADDRESS V41CC10 445 EQ PCH PUT CHARACTER HELPER V41CC10 446 PTL1 SA1 X2-EFETFET+EFET V41CC10 447 ERRNZ DCCHARSZ-6 FIX NEXT THREE LINES V41CC10 448 SB7 B3+B3 V41CC10 449 SB3 B7+B7 V41CC10 450 SB3 B3+B7 DCCHS * DCCHARSZ V41CC10 451 LX6 B3 LEFT-ADJUST DCB V41CC10 452 SA6 A6 STORE ADJUSTED DCB V41CC10 453 RJ PTB PUT BINARY V41CC10 454 SA3 PTLA GET P V41CC10 455 SA1 X2-EFETFET+EFET V41CC10 456 BX6 X6-X6 CLEAR SENTINEL WORD V41CC10 457 SA6 X4 PUT NL IN CIRCULAR BUFFER V41CC10 458 SA6 X3 V41CC10 459 LX1 -EDCCHS LOOK AT DCCHS V41CC10 460 ERRNZ EDCCHSW-18 FIX NEXT LINE V41CC10 461 SX7 X1-2 MUST BE AT LEAST 2 EMPTY POSITIONS V41CC10 462 LX1 EDCCHS MOVE IT BACK TO ITS CORRECT POSITION V41CC10 463 PL X7,PTL2 IF ENOUGH ROOM FOR NL V41CC10 464 RJ PTB PUT BINARY V41CC10 465 PTL2 SA1 X2-EFETFET+EFET V41CC10 466 SA3 X2-EFETFET+EFETLCNT V41CC10 467 SX0 X2-EFETFET+EFETCBUF V41CC10 468 ERRNZ PEOLN-59 FIX NEXT TWO LINES V41CC10 469 ERRNZ PREWRITE-58 FIX NEXT LINE V41CC10 470 MX6 2 SET EOLN AND REWRITE BITS V41CC10 471 BX6 X6+X0 1/EOLN,1/REWRITE,40/,18/P V41CC10 472 SA6 X2-EFETFET+EFETPTR V41CC10 473 BX7 X7-X7 V41CC10 474 MX6 -EDCCHSW V41CC10 475 LX6 EDCCHS ZERO DCCHS FIELD V41CC10 476 SA7 X4 DCB V41CC10 477 SX7 B1 V41CC10 478 BX6 X6*X1 MASK OFF OLD DCCHS V41CC10 479 SX4 DCALFALN DCCHS := DCALFALN V41CC10 480 LX4 EDCCHS V41CC10 481 BX6 X6+X4 V41CC10 482 SA6 A1 STORE NEW VALUE V41CC10 483 IX7 X3-X7 DECREMENT LINE COUNT V41CC10 484 SX1 IOEA BEYOND LINELIMIT ON XXXXXXX V41CC10 485 SA7 A3 STORE NEW LINECOUNT V41CC10 486 ZR X3,IOE1 IF BEYOND LINELIMIT V41CC10 487 EQ PTLX RETURN V41CC10 488 ASCII ENDIF V41CC10 489 V41CC10 490 ASCII IFEQ ASCFLAG,1 V41CC10 491 PTLA SCRATCH 1 V41CC10 492 ASCII ENDIF V41CC10 493 P.PUTS SPACE 4,15 PSYSTM 2616 ** P.PUTS - PUT SEGMENT. PSYSTM 2617 * PSYSTM 2618 * ENTRY (A1) = EFET ADDRESS. PSYSTM 2619 * (X1) = ((A1)). PSYSTM 2620 * PSYSTM 2621 * EXIT (X2) = FET ADDRESS. PSYSTM 2622 * PSYSTM 2623 * USES X - ALL. PSYSTM 2624 * A - 1, 3, 4, 6, 7. PSYSTM 2625 * B - 3, 7. PSYSTM 2626 * PSYSTM 2627 * CALLS FOB, SWS, WWR. PSYSTM 2628 * PSYSTM 2629 * MACROS RECALL, WEOR. PSYSTM 2630 PSYSTM 2631 PSYSTM 2632 PTS ROUTINE P.PUTS ENTRY/EXIT PSYSTM 2633 LX1 59-EREWRITE V41CC05 103 PSYSTM 2635 SCOPE2 IFNE SCOPE2,1 PSYSTM 2636 ERRNZ EFETFET-1 PSYSTM 2637 SX2 A1+B1 FET PSYSTM 2638 SCOPE2 ELSE PSYSTM 2639 SX2 A1+EFITFIT FIT PSYSTM 2640 SCOPE2 ENDIF PSYSTM 2641 PSYSTM 2642 PL X1,WWR IF WRITE WITHOUT REWRITE V41CC13 14 PSYSTM 2644 SCOPE2 IFNE SCOPE2,1 V41AC01 31 SX3 20B PSYSTM 2646 RECALL X2 WAIT I/O COMPLETE PSYSTM 2647 SA1 X2+ PSYSTM 2648 BX6 -X3*X1 DESTROY POSSIBLE WRITER CODE PSYSTM 2649 SA6 A1 PSYSTM 2650 SCOPE2 ENDIF V41AC01 32 PSYSTM 2652 RJ FOB FLUSH OUTPUT BUFFER PSYSTM 2653 PSYSTM 2654 SCOPE2 IFNE SCOPE2,0 PSYSTM 2655 WEOR X2 WRITE END-OF-RECORD FOR W, S, Z RECORDS PSYSTM 2656 SCOPE2 ENDIF PSYSTM 2657 PSYSTM 2658 RJ SWS SET WRITE STATUS PSYSTM 2659 EQ PTSX RETURN PSYSTM 2660 P.RESET SPACE 4,15 PSYSTM 2661 ** P.RESET - REWIND FILE AND PREPARE FOR READING. PSYSTM 2662 * PSYSTM 2663 * ENTRY (A1) = EFET ADDRESS. PSYSTM 2664 * (X1) = ((A1)). PSYSTM 2665 * PSYSTM 2666 * EXIT (X2) = FET ADDRESS. PSYSTM 2667 * PSYSTM 2668 * USES X - ALL. PSYSTM 2669 * A - 1, 2, 3, 4, 6, 7. PSYSTM 2670 * B - 3, 7. PSYSTM 2671 * PSYSTM 2672 * CALLS RPF, SRS. PSYSTM 2673 PSYSTM 2674 PSYSTM 2675 RST ROUTINE P.RESET ENTRY/EXIT PSYSTM 2676 PSYSTM 2677 SCOPE2 IFNE SCOPE2,1 PSYSTM 2678 ERRNZ EFETFET-1 PSYSTM 2679 SX2 A1+B1 FET PSYSTM 2680 SCOPE2 ELSE PSYSTM 2681 SX2 A1+EFITFIT FIT PSYSTM 2682 SCOPE2 ENDIF PSYSTM 2683 PSYSTM 2684 RJ RPF REWIND PASCAL FILE PSYSTM 2685 NG X0,RSTX IF ACTUAL FILE IS INPUT OR OUTPUT PSYSTM 2686 RJ SRS SET READ STATUS PSYSTM 2687 EQ RSTX RETURN PSYSTM 2688 P.REWRT SPACE 4,15 PSYSTM 2689 ** P.REWRT - REWIND FILE AND PREPARE FOR WRITING. PSYSTM 2690 * PSYSTM 2691 * ENTRY (A1) = EFET ADDRESS. PSYSTM 2692 * (X1) = ((A1)). PSYSTM 2693 * PSYSTM 2694 * EXIT (X2) = FET ADDRESS. PSYSTM 2695 * PSYSTM 2696 * USES X - ALL. PSYSTM 2697 * A - 1, 3, 4, 6, 7. PSYSTM 2698 * B - 3, 7. PSYSTM 2699 * PSYSTM 2700 * CALLS PPF, SWS. PSYSTM 2701 * PSYSTM 2702 * MACROS ENDFILE, REWIND, REWINDM, SKIPEI, WRITER. PSYSTM 2703 PSYSTM 2704 PSYSTM 2705 RWT ROUTINE P.REWRT ENTRY/EXIT PSYSTM 2706 PSYSTM 2707 SCOPE2 IFNE SCOPE2,1 PSYSTM 2708 ERRNZ EFETFET-1 PSYSTM 2709 SX2 A1+B1 FET PSYSTM 2710 SCOPE2 ELSE PSYSTM 2711 SX2 A1+EFITFIT FET PSYSTM 2712 SCOPE2 ENDIF PSYSTM 2713 PSYSTM 2714 RJ PPF PREPARE FOR POSITIONING FILE PSYSTM 2715 NG X0,RWTX IF ACTUAL FILE IS INPUT OR OUTPUT PSYSTM 2716 V41CC05 104 OS IFNE SCOPE2,1 V41CC05 105 SA3 X2-EFETFET EFET V41CC05 106 OS ELSE V41CC05 107 SA3 X2-EFITFIT V41CC05 108 OS ENDIF V41CC05 109 V41CC05 110 LX3 59-ECONNECT TERMINAL CONNECTION BIT V41EC01 9 NG X3,RWT1 IF TERMINAL FILE PSYSTM 2719 SA1 X2+2 PREVENT FLUSH OF READ FILE PSYSTM 2720 SX6 X1 PSYSTM 2721 SA6 A1+B1 OUT := IN PSYSTM 2722 PSYSTM 2723 NOS IFNE KRONOS+NOS1+NOS2,0 V41AC01 33 SA3 X2+B1 FET+1 V41AC14 8 SX1 B1 PSYSTM 2727 LX1 47-0 PSYSTM 2728 BX6 X3+X1 PSYSTM 2729 BX1 X3 CHECK DEVICE TYPE V41AC14 9 AX1 -6 V41AC14 10 SX1 X1-1RD V41AC14 11 NZ X1,RWT0 IF NOT RANDOMLY ACCESSIBLE V41AC14 12 SA6 A3 SET RANDOM PROCESSING V41AC14 13 SKIPEI X2,R DETERMINE FILE LENGTH PSYSTM 2731 SA1 X2+6 PSYSTM 2732 BX6 X3 RESTORE OLD FET+1 PSYSTM 2733 SA6 A3 PSYSTM 2734 AX1 31 PSYSTM 2735 ZR X1,RWT1 IF FILE IS EMPTY PSYSTM 2736 RWT0 BSS 0 V41AC14 14 NOS ENDIF PSYSTM 2737 V41AC14 15 SCOPE2 IFNE SCOPE2,1 V41AC14 16 REWIND X2 PSYSTM 2738 WRITER X2 RELEASE FILE SPACE PSYSTM 2739 REWIND X2,R POSITION TO BEGINNING OF FILE PSYSTM 2740 SCOPE2 ELSE PSYSTM 2741 REWINDM X2 PSYSTM 2742 ENDFILE X2 PSYSTM 2743 REWINDM X2 PSYSTM 2744 SCOPE2 ENDIF PSYSTM 2745 PSYSTM 2746 RWT1 RJ SWS SET WRITE STATUS PSYSTM 2747 EQ RWTX RETURN PSYSTM 2748 P.RPE SPACE 4,20 PSYSTM 2749 ** P.RPE - RESTORE PASCAL ENVIRONMENT. PSYSTM 2750 * PSYSTM 2751 * ENTRY (TGVR+TGVRPTRS) = GLOBAL STACK POINTERS. PSYSTM 2752 * (TGVR+TGVRFORT) = FORTRAN CALL FLAG AND LINE NUMBER. PSYSTM 2753 * PSYSTM 2754 * EXIT FORTRAN CALL FLAG IN (TGVR+TGVRFORT) CLEARED. PSYSTM 2755 * (A0) = LINE NUMBER IN PASCAL PROGRAM AT WHICH THE PSYSTM 2756 * FORTRAN ROUTINE WAS CALLED (IF PMD IS ON). PSYSTM 2757 * (B1) = 1. PSYSTM 2758 * (B4) = LWA+1 OF CURRENT STACK CHUNK. PSYSTM 2759 * (B5) = POINTER TO CURRENT ACTIVATION. PSYSTM 2760 * (B6) = TOP OF PARAMETER STACK. PSYSTM 2761 * PSYSTM 2762 * USES X - 4, 5, 7. PSYSTM 2763 * A - 0, 4, 5, 7. PSYSTM 2764 * B - 1, 4, 5, 6. PSYSTM 2765 PSYSTM 2766 PSYSTM 2767 RPE ROUTINE P.RPE ENTRY/EXIT PSYSTM 2768 SB1 1 RESTORE B1 PSYSTM 2769 SA4 TGVR+TGVRFORT PSYSTM 2770 SA5 TGVR+TGVRPTRS PSYSTM 2771 SA0 X4 RESTORE LINE NUMBER PSYSTM 2772 SB6 X5 RESTORE TOP OF PARAMETER STACK PSYSTM 2773 AX5 18 PSYSTM 2774 SB5 X5 RESTORE POINTER TO CURRENT ACTIVATION PSYSTM 2775 AX5 18 PSYSTM 2776 SB4 X5 RESTORE TOP OF CURRENT STACK CHUNK PSYSTM 2777 BX7 X2-X2 PSYSTM 2778 SA7 A4 CLEAR FORTRAN CALL FLAG PSYSTM 2779 EQ RPEX RETURN PSYSTM 2780 P.RWRTS SPACE 4,15 PSYSTM 2781 ** P.RWRTS - REWRITE SEGMENTED FILE. PSYSTM 2782 * PSYSTM 2783 * ENTRY (A1) = EFET ADDRESS. PSYSTM 2784 * (X1) = ((A1)). PSYSTM 2785 * (X2) = NUMBER OF SEGMENTS. PSYSTM 2786 * PSYSTM 2787 * EXIT (X2) = FET ADDRESS. PSYSTM 2788 * PSYSTM 2789 * USES X - ALL. PSYSTM 2790 * A - 1, 3, 4, 6, 7. PSYSTM 2791 * B - 2, 3, 7. PSYSTM 2792 * PSYSTM 2793 * CALLS SKP, SWS. PSYSTM 2794 * PSYSTM 2795 * MACROS SKIPB, WRITER. PSYSTM 2796 PSYSTM 2797 PSYSTM 2798 RWS ROUTINE P.RWRTS ENTRY/EXIT PSYSTM 2799 RJ SKP SKIP RECORDS PSYSTM 2800 V41CC05 112 OS IFNE SCOPE2,1 V41CC05 113 SA3 X2-EFETFET EFET V41CC05 114 OS ELSE V41CC05 115 SA3 X2-EFITFIT EFET V41CC05 116 OS ENDIF V41CC05 117 V41CC05 118 LX3 59-ECONNECT TERMINAL CONNECTION BIT V41EC01 10 NG X3,RWS1 IF TERMINAL FILE PSYSTM 2803 PSYSTM 2804 SCOPE2 IFNE SCOPE2,1 V41AC01 34 SA1 X2 DETERMINE FILE POSITION PSYSTM 2806 LX1 59-9 PSYSTM 2807 NG X1,RWS1 IF FILE AT EOI PSYSTM 2808 SCOPE2 ENDIF V41AC01 35 PSYSTM 2810 SA1 X2+2 PREVENT FLUSH OF READ FILE PSYSTM 2811 SX6 X1 PSYSTM 2812 SA6 A1+B1 OUT := IN PSYSTM 2813 PSYSTM 2814 SCOPE2 IFNE SCOPE2,1 V41AC01 36 WRITER X2 RELEASE REST OF FILE PSYSTM 2816 SKIPB X2,1,R BACKSPACE OVER EOR PSYSTM 2817 SCOPE2 ENDIF V41AC01 37 PSYSTM 2819 RWS1 RJ SWS SET WRITE STATUS PSYSTM 2820 EQ RWSX RETURN PSYSTM 2821 P.SABRT SPACE 4,25 PSYSTM 2822 ** P.SABRT - COMMON ERROR ROUTINE. PSYSTM 2823 * PSYSTM 2824 * 1. ISSUE 1 OR 2 ERROR MESSAGES TO THE USER DAYFILE, PSYSTM 2825 * THEN ISSUE A MESSAGE OF THE FORM PSYSTM 2826 * AT LINE 1 IN PROGRAM A. PSYSTM 2827 * OR AT LINE 99999 IN PROCEDURE PASCALCOMP. PSYSTM 2828 * OR AT LINE 123 IN FUNCTION SDEV. PSYSTM 2829 * OR IN PROCEDURE ERROR. (IF NO PMD INFORMATION) PSYSTM 2830 * 2. FLUSH ALL OUTPUT BUFFERS OF FILES ON THE PROGRAM HEADING. PSYSTM 2831 * 3. CALL PMD IF IT IS ENABLED. PSYSTM 2832 * PSYSTM 2833 * ENTRY (A0) = LINE NUMBER (IF PMD INFO AVAILABLE). PSYSTM 2834 * (B5) = CURRENT A.R. POINTER (IF PMD AVAILABLE). PSYSTM 2835 * (X0) = 30/0,30/MSG1 (MESSAGE AT MSG1) PSYSTM 2836 * = 30/MSG2,30/MSG1 (MESSAGES AT MSG1 AND MSG2) PSYSTM 2837 * MESSAGES ARE IN C FORMAT. PSYSTM 2838 * PSYSTM 2839 * EXIT TO PMD OR ABORT THE JOB. PSYSTM 2840 * PSYSTM 2841 * USES ALL REGISTERS. PSYSTM 2842 * PSYSTM 2843 * CALLS CDD=, FCA, FOB, SCU, SNM, VPE, ZFN=. PSYSTM 2844 * PSYSTM 2845 * MACROS MESSAGE, RECALL. PSYSTM 2846 PSYSTM 2847 PSYSTM 2848 ABT ENTER P.SABRT ENTRY PSYSTM 2849 EQ ABT1 THIS JUMP FOR NORMAL CASE PSYSTM 2850 - EQ ABT7 THIS JUMP AFTER ENTERING ONCE PSYSTM 2851 ABTA EQU *-1 PSYSTM 2852 ABT1 SA5 ABTA PREVENT RECURSIVE CALL TO ABT PSYSTM 2853 LX5 30 PSYSTM 2854 BX6 X5 PSYSTM 2855 SA6 A5 PSYSTM 2856 BX6 X0 PSYSTM 2857 SA6 ABTB SAVE MESSAGE ADDRESSES PSYSTM 2858 SX1 =YP.DER PSYSTM 2859 NG X1,ABT2 IF NO REPRIEVE V41DC03 6 RJ =YP.DER DISABLE ERROR REPRIEVE PSYSTM 2861 SA1 ABTB RESTORE MESSAGE ADDRESSES PSYSTM 2862 BX0 X1 PSYSTM 2863 ABT2 BSS 0 V41DC03 7 PSYSTM 2865 NOS IFNE KRONOS+NOS1+NOS2+SCOPE2,0 V41AC01 38 MESSAGE X0,"EMSG" ISSUE FIRST MESSAGE TO USER DAYFILE PSYSTM 2867 NOS ENDIF PSYSTM 2868 PSYSTM 2869 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 2870 MESSAGE X0,"EMSG",R ISSUE FIRST MESSAGE TO USER DAYFILE PSYSTM 2871 NOSBE ENDIF PSYSTM 2872 PSYSTM 2873 AX0 30 PSYSTM 2874 ZR X0,ABT3 IF NO SECOND MESSAGE V41DC03 8 MESSAGE X0,"EMSG" ISSUE SECOND MESSAGE TO USER DAYFILE PSYSTM 2876 ABT3 SA1 TGVR+TGVRPMDS V41DC03 9 ZR X1,ABT5 IF PMD NOT ENABLED V41DC03 10 SX0 MSGA-1 ASSUME PMD IS ON PSYSTM 2879 RJ FCA FIND CURRENT ACTIVATION PSYSTM 2880 NG X5,ABT4 IF PMD IS ON V41DC03 11 SX0 MSGB-1 ADDRESS - 1 OF PMD OFF MESSAGE PSYSTM 2882 ABT4 SA2 X2+2 (A2) = ADDRESS OF BLOCK NAME V41DC03 12 SB7 1R- SUBSTITUTION CHARACTER PSYSTM 2884 SA4 X0 FWA - 1 OF MESSAGE PSYSTM 2885 BX5 X0 SAVE ADDRESS PSYSTM 2886 RJ SNM SET BLOCK KIND IN MESSAGE PSYSTM 2887 SA1 A2 LOAD BLOCK NAME PSYSTM 2888 RJ =XZFN= ZERO FILL BLOCK NAME PSYSTM 2889 SA4 X5 FWA - 1 OF MESSAGE PSYSTM 2890 SB7 1R/ SUBSTITUTION CHARACTER PSYSTM 2891 BX1 X6 PSYSTM 2892 RJ SNM SET BLOCK NAME IN MESSAGE PSYSTM 2893 SX1 A0 LINE NUMBER PSYSTM 2894 SB7 B4 SAVE B4 V41CC05 120 RJ =XCDD= CONVERT LINE NUMBER TO DECIMAL DISPLAY CODE PSYSTM 2896 SB4 B7 RESTORE HEAP POINTER PSYSTM 2897 MX6 1 PSYSTM 2898 SB2 B2-B1 6 * NUMBER OF DIGITS CONVERTED - 1 PSYSTM 2899 AX7 X6,B2 PSYSTM 2900 BX1 X7*X4 ZERO FILL LINE NUMBER PSYSTM 2901 SB7 1R+ SUBSTITUTION CHARACTER PSYSTM 2902 SA4 X5 FWA - 1 OF MESSAGE PSYSTM 2903 RJ SNM SET LINE NUMBER IN MESSAGE PSYSTM 2904 SX5 X5+B1 PSYSTM 2905 MESSAGE X5,"EMSG" ISSUE ERROR MESSAGE PSYSTM 2906 PSYSTM 2907 * FLUSH OUTPUT BUFFERS. PSYSTM 2908 PSYSTM 2909 ABT5 RJ FXF FLUSH EXTERNAL FILE BUFFERS V41DC03 13 PSYSTM 2941 * SEE IF OUTPUT FILE IS READY FOR WRITING. PSYSTM 2942 PSYSTM 2943 SA2 =XP.PIT+PITOUTP PSYSTM 2944 SX4 X2 PSYSTM 2945 SA1 X2 OUTPUT EFET (IF OUTPUT EXISTS) PSYSTM 2946 ZR X4,ABT6 IF NO OUTPUT FILE V41DC03 14 SA5 TGVR+TGVRPMDS PSYSTM 2948 V41DC03 15 NOSBE IFNE NOSBE+SCOPE34,0 V41DC03 16 RECALL X4+EFETFET WAIT FOR OUTPUT FET TO COMPLETE V41DC03 17 SA2 A2+ RESTORE X2 V41FC03 7 NOSBE ENDIF V41DC03 18 PSYSTM 2949 ZR X5,ABT6 IF PMD NOT ENABLED V41DC03 19 PSYSTM 2957 SA3 A1+EFETPTR EFETPTR V41CC05 121 LX1 59-EREWRITE WORD FILE REWRITE (IN BIT 59) V41CC05 122 LX3 59-PREWRITE TEXT FILE REWRITE (IN BIT 59) V41CC05 123 MX6 59 PSYSTM 2961 BX5 X1*X3 PSYSTM 2962 SA6 A1+EFETLCNT SET LINELIMIT(OUTPUT,-1) PSYSTM 2963 LX2 30 PSYSTM 2964 ERRNZ PITOUTP-PITPMD FIX ABOVE LINE PSYSTM 2965 PL X5,ABT6 IF OUTPUT FILE NOT READY FOR WRITING V41DC03 20 SB7 X2 ADDRESS OF PMD IF AVAILABLE PSYSTM 2967 PSYSTM 2968 SCOPE2 IFNE SCOPE2,1 PSYSTM 2969 ERRNZ EFETFET-1 FIX NEXT LINE PSYSTM 2970 SX2 X4+B1 FET ADDRESS PSYSTM 2971 RECALL X2 WAIT I/O COMPLETE PSYSTM 2972 SCOPE2 ELSE PSYSTM 2973 SX2 X4+EFITFIT PSYSTM 2974 SCOPE2 ENDIF PSYSTM 2975 PSYSTM 2976 LE B7,ABT6 IF PMD NOT AVAILABLE V41DC03 21 PSYSTM 2978 * CALL PMD. PSYSTM 2979 PSYSTM 2980 SA1 TGVR+TGVRPMDS PSYSTM 2981 SB6 X1 USE PRE-ALLOCATED STACK CHUNK PSYSTM 2982 AX1 30 PSYSTM 2983 SB4 X1 PSYSTM 2984 PSYSTM 2985 SA5 =XP.PIT+PITOUTP PSYSTM 2986 BX6 X6-X6 PSYSTM 2987 SX7 A0 PSYSTM 2988 SA6 B6+ARPS+PFLC+0 VAR MEMORY PSYSTM 2989 SA7 A6+B1 VALUE A0 PSYSTM 2990 SX6 B5 PSYSTM 2991 SX7 X5+EFETLCNT PSYSTM 2992 SA6 A7+B1 VALUE B5 PSYSTM 2993 SA7 A6+B1 VAR F PSYSTM 2994 SA3 ABTB PSYSTM 2995 BX6 X3 PSYSTM 2996 SX7 B1 PSYSTM 2997 SA6 A7+B1 VALUE MSGADDRS PSYSTM 2998 SA7 A6+B1 VALUE ABORT PSYSTM 2999 SX6 -B1 PSYSTM 3000 SA6 A7+B1 VALUE ACTIVATIONS PSYSTM 3001 SX7 SCU PSYSTM 3002 SA7 A6+B1 VALUE SCU PSYSTM 3003 PSYSTM 3004 ERRNZ PITOUTP-PITPMD FIX NEXT LINE PSYSTM 3005 AX5 30 PSYSTM 3006 RJ VPE CALL POST-MORTEM DUMP ROUTINE PSYSTM 3007 SA2 =XP.PIT+PITOUTP PSYSTM 3008 PSYSTM 3009 SCOPE2 IFNE SCOPE2,1 PSYSTM 3010 SX2 X2+EFETFET OUTPUT FET ADDRESS PSYSTM 3011 SCOPE2 ELSE PSYSTM 3012 SX2 X2+EFITFIT PSYSTM 3013 SCOPE2 ENDIF PSYSTM 3014 PSYSTM 3015 RJ FOB FLUSH THE BUFFER PSYSTM 3016 PSYSTM 3017 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 3018 RECALL X2 WAIT FOR OUTPUT FET TO COMPLETE PSYSTM 3019 NOSBE ENDIF PSYSTM 3020 PSYSTM 3021 ABT6 BSS 0 V41DC03 22 PSYSTM 3026 SCOPE2 IFNE SCOPE2,1 PSYSTM 3027 ABORT V41DC03 23 SCOPE2 ELSE PSYSTM 3029 ABORT ,ND NO DUMP, PROCEED AT EXIT. V41DC03 24 SCOPE2 ENDIF PSYSTM 3031 PSYSTM 3032 ABT7 MESSAGE X0,"EMSG" ISSUE ERROR MESSAGE V41DC03 25 MESSAGE MSGR,"EMSG" PASCAL SYSTEM ERROR V41DC03 26 EQ ABT6 V41DC03 27 PSYSTM 3039 ABTB SCRATCH 1 MESSAGE ADDRESS PSYSTM 3040 P.SCO SPACE 4,20 PSYSTM 3045 ** P.SCO - STACK-CHUNK OVERFLOW. PSYSTM 3046 * PSYSTM 3047 * ENTRY (X5) = BLOCK HEADER WORD. PSYSTM 3048 * (X6) = SPACE NEEDED (LCMAX + ARPS + PSMAX). PSYSTM 3049 * (B4) = LWA+1 OF CURRENT STACK CHUNK. PSYSTM 3050 * (B5) = CURRENT ACTIVATION RECORD (AR). PSYSTM 3051 * (B6) = TOP OF CURRENT PARAMETER STACK. PSYSTM 3052 * PSYSTM 3053 * EXIT (X5) = BLOCK HEADER WORD. PSYSTM 3054 * (B4) = LWA+1 OF NEW STACK CHUNK. PSYSTM 3055 * (B6) = FWA+1 OF NEW STACK CHUNK. PSYSTM 3056 * CHUNK LINKAGE PLACED IN FWA OF NEW CHUNK. PSYSTM 3057 * ACTIVATION LINKAGE AND PARAMETERS (IF ANY) ARE PSYSTM 3058 * COPIED TO NEW STACK CHUNK STARTING AT B6. PSYSTM 3059 * PSYSTM 3060 * USES X - ALL. PSYSTM 3061 * A - 1, 2, 3, 4, 5, 6, 7. PSYSTM 3062 * B - 2, 3, 4, 5, 6, 7. PSYSTM 3063 * PSYSTM 3064 * CALLS P.ALM. PSYSTM 3065 PSYSTM 3066 PSYSTM 3067 * COPY PARAMETERS. PSYSTM 3068 PSYSTM 3069 ERRNZ PFLC-1 FIX A3 AND A6 INITIALIZATION PSYSTM 3070 SCO1 SA3 A3+B1 PSYSTM 3071 SX0 X0-1 PSYSTM 3072 BX6 X3 PSYSTM 3073 SA6 A6+B1 PSYSTM 3074 NZ X0,SCO1 IF MORE TO COPY PSYSTM 3075 PSYSTM 3076 SCO ROUTINE P.SCO ENTRY/EXIT PSYSTM 3077 PSYSTM 3078 * ALLOCATE A NEW CHUNK; SAVE B4, B6, AND BLOCK HEADER WORD. PSYSTM 3079 PSYSTM 3080 SA4 =XP.PIT+PITSCS MINIMUM STACK-CHUNK SIZE. PSYSTM 3081 SX7 B4 PSYSTM 3082 SX1 B6 PSYSTM 3083 LX7 18 PSYSTM 3084 SX6 X6+B1 ONE EXTRA WORD FOR THE CHUNK LINKAGE PSYSTM 3085 BX7 X7+X1 42/OLD B4, 18/OLD B6 PSYSTM 3086 IX3 X6-X4 PSYSTM 3087 LX7 18 24/OLD B4, 18/OLD B6, 18/0 PSYSTM 3088 BX2 X3 PSYSTM 3089 SA7 SCOA PSYSTM 3090 AX2 59 PSYSTM 3091 BX7 X5 PSYSTM 3092 BX0 -X2*X3 PSYSTM 3093 SA7 A7+B1 SAVE BLOCK HEADER WORD PSYSTM 3094 IX1 X0+X4 MAX(MIN,NEED) PSYSTM 3095 RJ =XP.ALM ALLOCATE MEMORY PSYSTM 3096 PSYSTM 3097 * GENERATE LINKAGES. PSYSTM 3098 PSYSTM 3099 SA1 SCOA 24/OLD B4, 18/OLD B6, 18/0 PSYSTM 3100 SA5 A1+B1 GET BLOCK HEADER WORD PSYSTM 3101 ERRNZ ARPS-1 FIX NEXT TWO LINES PSYSTM 3102 SA2 B6 (AR-1) = 30/EQ RA, 30/DL PSYSTM 3103 SA3 B6+B1 (AR) = 30/BHW, 30/SL PSYSTM 3104 LX2 30 30/DL, 30/EQ RA PSYSTM 3105 SX4 SCU (REENTRY ADDRESS TO DEALLOCATE CHUNK) PSYSTM 3106 SX7 X2 60/RA PSYSTM 3107 BX2 X2-X7 30/DL, 30/EQ 0 PSYSTM 3108 BX7 X7+X1 CHUNK LINKAGE: 24/OLD B4, 18/OLD B6, 18/RA PSYSTM 3109 SA7 X6 CHUNK FWA PSYSTM 3110 SB4 X6+B7 CHUNK LWA+1 PSYSTM 3111 MX0 -10 PSYSTM 3112 LX5 0-45 PSYSTM 3113 BX0 -X0*X5 EXTRACT PARAMS (NUMBER OF PARAMETERS) PSYSTM 3114 BX6 X3 PSYSTM 3115 SB6 A7+B1 CHUNK FWA+1 PSYSTM 3116 BX7 X2+X4 30/DL, 30/EQ SCO3 PSYSTM 3117 LX5 45-0 RESTORE BLOCK HEADER WORD PSYSTM 3118 LX7 30 30/EQ SCO3, 30/DL PSYSTM 3119 ERRNZ ARPS-1 FIX NEXT TWO LINES PSYSTM 3120 SA6 B6+B1 AR PSYSTM 3121 SA7 B6+ AR-1 PSYSTM 3122 ZR X0,SCOX RETURN TO BLOCK-ENTRY CODE IF NO PARAMETERS PSYSTM 3123 EQ SCO1 ELSE COPY PARAMETERS PSYSTM 3124 PSYSTM 3125 SCOA SCRATCH 2 PSYSTM 3126 P.SCU SPACE 4,20 PSYSTM 3127 ** P.SCU - STACK-CHUNK UNDERFLOW. PSYSTM 3128 * PSYSTM 3129 * RETURN HERE FROM ACTIVATIONS THAT CAUSED PSYSTM 3130 * STACK-CHUNK OVERFLOW. PSYSTM 3131 * PSYSTM 3132 * ENTRY (X6) MAY BE A FUNCTION RESULT. PSYSTM 3133 * (B4) = LWA+1 OF CURRENT STACK CHUNK. PSYSTM 3134 * (B5) = AR OF CALLER. PSYSTM 3135 * (B6) = FWA+1 OF CURRENT STACK CHUNK. PSYSTM 3136 * PSYSTM 3137 * EXIT CURRENT STACK CHUNK LIBERATED. PSYSTM 3138 * (B4) = LWA+1 OF CALLER-S STACK CHUNK. PSYSTM 3139 * (B5) UNCHANGED. PSYSTM 3140 * (B6) = TOP OF CALLER-S PARAMETER STACK. PSYSTM 3141 * PSYSTM 3142 * USES X - ALL. PSYSTM 3143 * A - 1, 2, 3, 4, 5, 6, 7. PSYSTM 3144 * B - 2, 3, 4, 5, 6, 7. PSYSTM 3145 * PSYSTM 3146 * CALLS P.LIM. PSYSTM 3147 PSYSTM 3148 PSYSTM 3149 SCU ENTER P.SCU ENTRY PSYSTM 3150 PSYSTM 3151 * GRAB CHUNK LINKAGE, SAVE FUNCTION RESULT, LIBERATE CHUNK. PSYSTM 3152 PSYSTM 3153 SA2 B6-B1 CHUNK LINKAGE PSYSTM 3154 SA6 SCUA+1 SAVE FUNCTION RESULT PSYSTM 3155 SX7 X2 60/RA PSYSTM 3156 AX2 18 PSYSTM 3157 SX1 A2 FWA OF CHUNK PSYSTM 3158 SB6 X2 OLD B6 PSYSTM 3159 AX2 18 PSYSTM 3160 SA7 A6-B1 SAVE RETURN ADDRESS PSYSTM 3161 SB4 X2 OLD B4 PSYSTM 3162 RJ =XP.LIM LIBERATE MEMORY PSYSTM 3163 PSYSTM 3164 * RESTORE FUNCTION RESULT AND RETURN. PSYSTM 3165 PSYSTM 3166 SA1 SCUA PSYSTM 3167 SA2 A1+B1 PSYSTM 3168 SB7 X1 PSYSTM 3169 BX6 X2 PSYSTM 3170 JP B7 RETURN PSYSTM 3171 PSYSTM 3172 SCUA SCRATCH 2 PSYSTM 3173 P.SPE SPACE 4,15 PSYSTM 3174 ** P.SPE - SAVE PASCAL ENVIRONMENT. PSYSTM 3175 * PSYSTM 3176 * ENTRY (A0) = LINE NUMBER IN PASCAL PROGRAM AT WHICH THE PSYSTM 3177 * FORTRAN ROUTINE WAS CALLED (IF PMD IS ON). PSYSTM 3178 * (B4) = LWA+1 OF CURRENT STACK CHUNK. PSYSTM 3179 * (B5) = POINTER TO CURRENT ACTIVATION. PSYSTM 3180 * (B6) = TOP OF PARAMETER STACK. PSYSTM 3181 * PSYSTM 3182 * EXIT GLOBAL STACK POINTERS SAVED IN (TGVR+TGVRPTRS). PSYSTM 3183 * FORTRAN CALL FLAG, LINE NUMBER SET IN (TGVR+TGVRFORT). PSYSTM 3184 * PSYSTM 3185 * USES X - 3, 6, 7. PSYSTM 3186 * A - 6, 7. PSYSTM 3187 PSYSTM 3188 PSYSTM 3189 SPE ROUTINE P.SPE ENTRY/EXIT PSYSTM 3190 SX6 B4 PSYSTM 3191 SX7 B5 PSYSTM 3192 SX3 B6 PSYSTM 3193 LX6 36 PSYSTM 3194 LX7 18 PSYSTM 3195 BX3 X6+X3 PSYSTM 3196 BX7 X3+X7 6/0,18/B4,18/B5,18/B6 PSYSTM 3197 SX6 A0 PSYSTM 3198 MX3 1 PSYSTM 3199 BX6 X3+X6 1/1,41/,18/LINENUM PSYSTM 3200 SA7 TGVR+TGVRPTRS SAVE GLOBAL STACK POINTERS PSYSTM 3201 SA6 TGVR+TGVRFORT SET FORTRAN CALL FLAG, LINE NUMBER PSYSTM 3202 EQ SPEX RETURN PSYSTM 3203 P.TIME SPACE 4,10 PSYSTM 3204 ** P.TIME - RETURN SYSTEM TIME. PSYSTM 3205 * PSYSTM 3206 * ENTRY (X1) = ADDRESS TO RETURN SYSTEM TIME. PSYSTM 3207 * PSYSTM 3208 * EXIT ((X1)) = SYSTEM TIME. PSYSTM 3209 * PSYSTM 3210 * USES X - 1, 2, 3, 4, 5, 6. V41CC10 494 * A - 1, 4, 6. V41CC10 495 * V41CC10 496 * CALLS P.DWA. V41CC10 497 * PSYSTM 3213 * MACROS CLOCK. PSYSTM 3214 PSYSTM 3215 PSYSTM 3216 ASCII IFEQ ASCFLAG,1 V41CC22 14 TIMZ SET DCALFALN-ASALFALN V41CC22 15 ASCII ENDIF V41CC22 16 V41CC22 17 TIM ROUTINE P.TIME ENTRY/EXIT PSYSTM 3217 PSYSTM 3218 OS IFNE KRONOS+NOS1+NOS2+NOSBE+SCOPE34,0 V41CC10 498 ASCII IFNE ASCFLAG,1 V41CC10 499 CLOCK X1 V41CC10 500 ASCII ELSE V41CC10 501 BX5 X1 V41CC10 502 CLOCK TIMA V41CC10 503 SA1 TIMA V41CC10 504 SX2 ASALFALN V41CC10 505 RJ =XP.DWA CONVERT DISPLAY CODE WORD TO ASCII V41CC10 506 SA6 X5 STORE FIRST PART OF TIME V41CC10 507 SX2 TIMZ DCALFALN-ASALFALN V41CC22 18 RJ =XP.DWA CONVERT DISPLAY CODE WORD TO ASCII V41CC10 509 SA4 X5+B1 V41CC10 510 MX3 TIMZ*ASCHARSZ (DCALFALN-ASALFALN)*ASCHARSZ V41CC22 19 BX4 -X3*X4 V41CC10 512 BX6 X4+X6 V41CC10 513 SA6 A4 V41CC10 514 ASCII ENDIF V41CC10 515 OS ENDIF V41CC10 516 V41CC10 517 OS IFNE SCOPE2,0 V41CC10 518 BX6 X1 WE USE THE SAME REGISTERS JUST IN CASE PSYSTM 3222 SA6 TIMA SAVE X1 PSYSTM 3223 CLOCK TIMB GET DISPLAY CODES FOR TIME OF DAY PSYSTM 3224 SA1 TIMB PSYSTM 3225 BX6 X1 PSYSTM 3226 SA1 TIMA PSYSTM 3227 SA6 X1 TRANSFER TO DESIRED LOCATION PSYSTM 3228 OS ENDIF V41CC10 519 PSYSTM 3230 EQ TIMX RETURN PSYSTM 3231 V41CC10 520 ASCII IFEQ ASCFLAG,1 V41CC10 521 TIMA SCRATCH 1 V41CC10 522 ASCII ENDIF V41CC10 523 PSYSTM 3232 SCOPE2 IFNE SCOPE2,0 PSYSTM 3233 TIMA SCRATCH 1 PSYSTM 3234 TIMB SCRATCH 1 PSYSTM 3235 SCOPE2 ENDIF PSYSTM 3236 P.VPE SPACE 4,15 PSYSTM 3237 ** P.VPE - VARIABLE PROCEDURE ENTRY. PSYSTM 3238 * PSYSTM 3239 * CALL A VARIABLE PROCEDURE BY DOING THE FOLLOWING: PSYSTM 3240 * 1. SIMULATE A RETURN JUMP TO THE ROUTINE. PSYSTM 3241 * 2. MOVE THE STATIC LINK TO THE LOWER 18 BITS OF X5. PSYSTM 3242 * PSYSTM 3243 * ENTRY (X5) = 42/STATIC LINK,18/ENTRY POINT PSYSTM 3244 * PSYSTM 3245 * EXIT TO ROUTINE ENTRY POINT + 1. PSYSTM 3246 * PSYSTM 3247 * USES X - 5, 6, 7. PSYSTM 3248 * A - 5, 7. PSYSTM 3249 * B - 7. PSYSTM 3250 PSYSTM 3251 PSYSTM 3252 VPE ROUTINE P.VPE ENTRY PSYSTM 3253 BX6 X5 PSYSTM 3254 SB7 X5+B1 PROCEDURE ENTRY + 1 PSYSTM 3255 SA5 VPE GET RETURN ADDRESS PSYSTM 3256 AX6 18 STATIC LINK PSYSTM 3257 BX7 X5 PSYSTM 3258 SX5 X6 STATIC LINK PSYSTM 3259 SA7 B7-B1 SIMULATE RJ TO PROCEDURE PSYSTM 3260 JP B7 ENTER THE PROCEDURE PSYSTM 3261 PSYSTM TITLE SUBROUTINES. PSYSTM 3262 P.CAD SPACE 4,15 PSYSTM 3263 ** P.CAD - CONVERT ADDRESS TO DISPLAY. PSYSTM 3264 * PSYSTM 3265 * ENTRY (X1) = 18 BIT ADDRESS. PSYSTM 3266 * PSYSTM 3267 * EXIT (B2) = 6 * COUNT OF DIGITS CONVERTED. PSYSTM 3268 * (X2) = DISPLAY CODE LEFT JUSTIFIED, BLANK FILLED WITH PSYSTM 3269 * LEADING ZERO SUPPRESSION. PSYSTM 3270 * (X6) = DISPLAY CODE RIGHT JUSTIFIED, BLANK FILLED WITH PSYSTM 3271 * LEADING ZERO SUPPRESSION. PSYSTM 3272 * PSYSTM 3273 * USES X - 1, 2, 3, 4, 6, 7. PSYSTM 3274 * A - 2. PSYSTM 3275 * B - 2, 3, 7. PSYSTM 3276 PSYSTM 3277 PSYSTM 3278 CAD ROUTINE P.CAD ENTRY PSYSTM 3279 SA2 CADA =10H PSYSTM 3280 SB3 6 (B3) = SHIFT INCREMENT PSYSTM 3281 MX4 -3 (X4) = DIGIT MASK PSYSTM 3282 SB2 B0 CLEAR JUSTIFY COUNT PSYSTM 3283 SB7 1R0-1R (B7) = CONVERSION COUNT PSYSTM 3284 CAD1 BX7 -X4*X1 EXTRACT DIGIT PSYSTM 3285 LX2 -6 SHIFT ASSEMBLY PSYSTM 3286 SB2 B2+B3 PSYSTM 3287 SX3 X7+B7 CONVERT DIGIT PSYSTM 3288 AX1 3 SHIFT OFF DIGIT PSYSTM 3289 IX2 X2+X3 ADD DIGIT TO ASSEMBLY PSYSTM 3290 NZ X1,CAD1 LOOP TO ZERO DIGIT PSYSTM 3291 LX2 -6 LEFT JUSTIFY ASSEMBLY PSYSTM 3292 LX6 X2,B2 RIGHT JUSTIFY ASSEMBLY PSYSTM 3293 EQ CADX RETURN PSYSTM 3294 PSYSTM 3295 CADA CON 10H PSYSTM 3296 P.CFD SPACE 4,15 PSYSTM 3297 ** P.CFD - CONVERT INTEGER TO PASCAL 10:3 FORM. PSYSTM 3298 * PSYSTM 3299 * ADAPTED FROM CDC COMMON DECK *COMCCFD*. PSYSTM 3300 * PSYSTM 3301 * ENTRY (B1) = 1. PSYSTM 3302 * (X1) = INTEGER TO BE CONVERTED (LESS THAN 2**30). PSYSTM 3303 * PSYSTM 3304 * EXIT (X6) = NUMBER CONVERTED TO DISPLAY CODE. PSYSTM 3305 * PSYSTM 3306 * USES X - ALL. PSYSTM 3307 * A - 1, 2, 3, 4, 6. PSYSTM 3308 * B - 2, 3. PSYSTM 3309 PSYSTM 3310 PSYSTM 3311 CFD ROUTINE P.CFD ENTRY/EXIT PSYSTM 3312 SA2 CFDA =.1P48+1 PSYSTM 3313 SX7 1000 PSYSTM 3314 SA3 A2+B1 =10.0P PSYSTM 3315 MX4 -29 PSYSTM 3316 SB3 -6 PSYSTM 3317 BX6 -X4*X1 DISCARD UPPER BITS PSYSTM 3318 SX5 6 PSYSTM 3319 IX7 X6-X7 PSYSTM 3320 SA4 A3+B1 (X4) = BACKGROUND PSYSTM 3321 SB2 1R0-1R (B2) = CONVERSION PSYSTM 3322 PX1 X6 FLOAT PSYSTM 3323 PL X7,CFD1 IF INTEGER PRESENT PSYSTM 3324 SB2 B0 PSYSTM 3325 SA4 A4+B1 SET LEADING ZEROS PSYSTM 3326 CFD1 DX6 X2*X1 EXTRACT REMAINDER PSYSTM 3327 FX1 X2*X1 PSYSTM 3328 LX4 -6 PSYSTM 3329 SB3 B3+X5 ADVANCE SHIFT COUNT PSYSTM 3330 UX7 X1 CHECK QUOTIENT PSYSTM 3331 FX0 X3*X6 EXTRACT DIGIT PSYSTM 3332 SX6 X0+B2 CONVERT DIGIT PSYSTM 3333 IX4 X6+X4 PSYSTM 3334 NZ X7,CFD1 LOOP TO ZERO QUOTIENT PSYSTM 3335 SX3 1R. INSERT DECIMAL POINT PSYSTM 3336 MX2 -18 FRACTION MASK PSYSTM 3337 LX6 X4,B3 RIGHT JUSTIFY ASSEMBLY PSYSTM 3338 BX1 -X2*X6 EXTRACT FRACTION PSYSTM 3339 LX3 18 PSYSTM 3340 IX7 X1+X3 ADD DECIMAL POINT PSYSTM 3341 BX4 X2*X6 EXTRACT INTEGER PSYSTM 3342 LX4 6 PSYSTM 3343 IX6 X4+X7 ADD INTEGER INTO RESULT PSYSTM 3344 EQ CFDX RETURN PSYSTM 3345 PSYSTM 3346 CFDA CON 0.1P48+1 PSYSTM 3347 CON 10.0P PSYSTM 3348 CON 9L PSYSTM 3349 CON 9L 0000 PSYSTM 3350 P.EFD SPACE 4,15 PSYSTM 3351 ** P.EFD - EXAMINE FIRST DELIMITER. PSYSTM 3352 * PSYSTM 3353 * EFD SCANS THE CONTROL STATEMENT FOR THE FIRST PSYSTM 3354 * DELIMITER AND DETERMINES IF IT IS A SLASH. PSYSTM 3355 * PSYSTM 3356 * ENTRY (B1) = 1. PSYSTM 3357 * PSYSTM 3358 * EXIT (X6) = 0 IF DELIMITER IS SLASH. PSYSTM 3359 * (X6) <> 0 OTHERWISE. PSYSTM 3360 * PSYSTM 3361 * USES X - 1, 2, 5, 6. PSYSTM 3362 * A - 1. PSYSTM 3363 * B - 2. PSYSTM 3364 PSYSTM 3365 PSYSTM 3366 EFD ROUTINE P.EFD ENTRY/EXIT PSYSTM 3367 MX2 -6 PSYSTM 3368 MX5 1 PSYSTM 3369 SB2 CCDR PSYSTM 3370 PSYSTM 3371 * SKIP BLANKS. PSYSTM 3372 PSYSTM 3373 EFD1 PL X5,EFD2 IF NOT END OF WORD PSYSTM 3374 SA1 B2 NEXT WORD PSYSTM 3375 SB2 B2+B1 PSYSTM 3376 EFD2 LX1 6 PSYSTM 3377 LX5 6 PSYSTM 3378 BX6 -X2*X1 PSYSTM 3379 SX6 X6-1R PSYSTM 3380 ZR X6,EFD1 IF A BLANK PSYSTM 3381 PSYSTM 3382 * SKIP NEXT CHAR, COMMAND NAME, AND EMBEDDED BLANKS. PSYSTM 3383 PSYSTM 3384 EFD3 PL X5,EFD4 IF NOT END OF WORD PSYSTM 3385 SA1 B2 NEXT WORD PSYSTM 3386 SB2 B2+B1 PSYSTM 3387 EFD4 LX1 6 PSYSTM 3388 LX5 6 PSYSTM 3389 BX6 -X2*X1 PSYSTM 3390 SX6 X6-1R9-1 PSYSTM 3391 NG X6,EFD3 IF ALPHABETIC OR NUMERIC PSYSTM 3392 SX6 X6-1R +1R9+1 PSYSTM 3393 ZR X6,EFD3 IF A BLANK PSYSTM 3394 PSYSTM 3395 * EXAMINE THE FIRST DELIMITER. PSYSTM 3396 PSYSTM 3397 SX6 X6-1R/+1R PSYSTM 3398 ZR X6,EFDX IF SLASH V41EC06 8 SX6 X6-1R,+1R/ V41EC06 9 NZ X6,EFDX IF NOT COMMA V41EC06 10 EFD5 PL X5,EFD6 IF NOT END OF WORD V41EC06 11 SA1 B2 V41EC06 12 SB2 B2+B1 V41EC06 13 EFD6 LX1 6 V41EC06 14 LX5 6 V41EC06 15 BX6 -X2*X1 V41EC06 16 SX6 X6-1R V41EC06 17 ZR X6,EFD5 IF A BLANK V41EC06 18 SX6 X6-1R/+1R V41EC06 19 EQ EFDX RETURN PSYSTM 3399 P.FCA SPACE 4,25 PSYSTM 3400 ** P.FCA - FIND CURRENT ACTIVATION. PSYSTM 3401 * PSYSTM 3402 * FCA SCANS DOWN THE ACTIVATION STACK FOR THE TOP-MOST PSYSTM 3403 * ACTIVATION OF A BLOCK IN WHICH PMD IS NOT SUPPRESSED, PSYSTM 3404 * OR FOR THE PROGRAM ACTIVATION, WHICHEVER COMES FIRST. PSYSTM 3405 * THIS ACTIVATION IS CALLED THE "CURRENT" ACTIVATION. V41DC02 6 * PSYSTM 3407 * NOTE THAT PMD IS CONSIDERED TO BE SUPPRESSED FOR A BLOCK PSYSTM 3408 * WHEN THE *P0* OPTION IS IN EFFECT; THERE IS NO PMD HEADER PSYSTM 3409 * WHEN PMD IS SUPPRESSED. PSYSTM 3410 * PSYSTM 3411 * ENTRY (B1) = 1. PSYSTM 3412 * (B5) = ADDRESS OF TOP-MOST ACTIVATION RECORD (AR). PSYSTM 3413 * PSYSTM 3414 * EXIT (X1) = CURRENT ACTIVATION KIND PSYSTM 3415 * (7LPROGRAM, 9LPROCEDURE, OR 8LFUNCTION). PSYSTM 3416 * (X2) = ADDRESS OF BLOCK HEADER WORD FOR THE CURRENT PSYSTM 3417 * BLOCK. PSYSTM 3418 * (X5) < 0 IFF PMD ON (P+) IN THE CURRENT BLOCK. V41DC02 7 * (B5) = ADDRESS OF CURRENT ACTIVATION RECORD (AR). PSYSTM 3421 * PSYSTM 3422 * USES X - 1, 2, 3, 5. PSYSTM 3423 * A - 1, 2, 3, 5. PSYSTM 3424 * B - 5. PSYSTM 3425 PSYSTM 3426 PSYSTM 3427 FCA1 SA1 =7LPROGRAM PSYSTM 3428 SA5 X2+1 PMD HEADER V41DC02 8 PSYSTM 3429 FCA ROUTINE P.FCA ENTRY/EXIT PSYSTM 3430 SA1 =9LPROCEDURE ASSUME PROCEDURE-BLOCK PSYSTM 3431 EQ FCA3 PSYSTM 3432 FCA2 SA2 B5-1 RETURN LINKAGE PSYSTM 3433 SB5 X2+ DYNAMIC LINK (DL) PSYSTM 3434 FCA3 SA2 B5 PSYSTM 3435 AX2 30 BHW PSYSTM 3436 ZR X2,FCA2 IF NO BLOCK HEADER WORD. PSYSTM 3437 SA3 X2 BLOCK HEADER WORD V41DC02 9 NG X3,FCA1 IF CURRENT BLOCK IS PROGRAM V41DC02 10 LX3 1 PSYSTM 3443 PL X3,FCA2 IF PMD IS SUPPRESSED V41DC02 11 SA5 X2+B1 PMD HEADER V41DC02 12 LX3 X5,B1 V41DC02 13 PL X3,FCAX RETURN IF PROCEDURE PSYSTM 3444 SA1 =8LFUNCTION PSYSTM 3445 EQ FCAX RETURN PSYSTM 3446 P.FOB SPACE 4,15 PSYSTM 3447 ** P.FOB - FLUSH OUTPUT BUFFER. PSYSTM 3448 * PSYSTM 3449 * IF AN OUTPUT FILE, FLUSH THE BUFFER. PSYSTM 3450 * PSYSTM 3451 * ENTRY (X2) = FET ADDRESS. PSYSTM 3452 * PSYSTM 3453 * EXIT (X2) = FET ADDRESS. PSYSTM 3454 * PSYSTM 3455 * USES X - ALL. PSYSTM 3456 * A - 1, 3, 4, 6, 7. PSYSTM 3457 * PSYSTM 3458 * CALLS PTL, RMP. PSYSTM 3459 * PSYSTM 3460 * MACROS RECALL, WRITER. PSYSTM 3461 PSYSTM 3462 PSYSTM 3463 FOB ROUTINE P.FOB ENTRY/EXIT PSYSTM 3464 PSYSTM 3465 SCOPE2 IFNE SCOPE2,1 PSYSTM 3466 SA1 X2 FET FIRST WORD PSYSTM 3467 LX1 59-2 PSYSTM 3468 PL X1,FOBX IF INPUT FILE (READ CODE) PSYSTM 3469 ERRNZ EFETFET-1 FIX NEXT LINE V41CC05 124 SA3 A1-B1 EFET PSYSTM 3470 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 125 SA1 A3-B1 FILE POINTER PSYSTM 3471 LX3 59-ETEXT V41CC05 126 SX6 X1 CHAR POINTER PSYSTM 3473 PL X3,FOB1 IF NOT CHARACTER FILE PSYSTM 3474 SX7 A3+EFETCBUF FWA OF CHAR BUFFER PSYSTM 3475 IX7 X7-X6 NEGATIVE IF NON-EMPTY BUFFER PSYSTM 3476 BX7 -X7*X1 PSYSTM 3477 V41CC10 524 ASCII IFEQ ASCFLAG,1 V41CC10 525 LX3 ETEXT-59-EDCCHS RIGHT-ADJUST DCCHS FIELD V41CC10 526 SX3 X3-DCALFALN V41CC10 527 BX7 -X3*X7 V41CC10 528 ASCII ENDIF V41CC10 529 V41CC10 530 NG X7,FOB1 IF EMPTY CHAR BUFFER AND EOLN SET PSYSTM 3478 RJ PTL WRITELN PSYSTM 3479 FOB1 SA3 X2+2 IN PSYSTM 3480 RECALL X2 WAIT I/O COMPLETE PSYSTM 3481 SA1 X2 FET FIRST WORD PSYSTM 3482 BX6 X1 COPY FIRST WORD OF FET PSYSTM 3483 MX7 -4 MASK FOR *AT* FIELD PSYSTM 3484 LX6 0-10 POSITION *AT* FIELD PSYSTM 3485 BX7 -X7*X6 EXTRACT *AT* PSYSTM 3486 NZ X7,FOBX IF *AT* SET PSYSTM 3487 SA4 A3+B1 OUT PSYSTM 3488 SX1 X1-24B WRITER CODE PSYSTM 3489 AX1 2 GET RID OF BINARY AND COMPLETE BITS PSYSTM 3490 IX6 X3-X4 PSYSTM 3491 NZ X1,FOB2 IF NOT WRITER CODE IN FET PSYSTM 3492 ZR X6,FOBX IF BUFFER EMPTY PSYSTM 3493 PSYSTM 3494 NOS IFNE KRONOS+NOS1+NOS2,0 V41AC01 40 FOB2 WRITER X2 FLUSH THE BUFFER PSYSTM 3496 NOS ENDIF PSYSTM 3497 PSYSTM 3498 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 3499 FOB2 WRITER X2,RCL FLUSH THE BUFFER PSYSTM 3500 NOSBE ENDIF PSYSTM 3501 PSYSTM 3502 SCOPE2 ELSE PSYSTM 3503 PSYSTM 3504 * CHECK FILE TYPE FOR INPUT OR OUTPUT. PSYSTM 3505 PSYSTM 3506 SA1 X2-EFITFIT X1 := [EFET] PSYSTM 3507 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 127 SA3 A1-B1 X3 := [EFET-1] PSYSTM 3508 LX1 59-EREWRITE FILE REWRITE BIT V41CC05 128 LX3 59-PREWRITE TEXT-FILE REWRITE BIT V41CC05 129 ERRNZ ETEXT-EREWRITE+1 FIX NEXT LINE V41CC05 130 LX4 B1,X1 TEXT-FILE BIT PSYSTM 3511 BX3 -X4+X3 WORD-FILE OR TEXT-FILE REWRITE PSYSTM 3512 BX4 X1*X3 FILE REWRITE AND (WORD-FILE OR TEXT REWRITE PSYSTM 3513 PL X4,FOBX IF NOT SET FOR OUTPUT PSYSTM 3514 SA1 X2-EFITFIT A1 := ADDR(EFET[0]) PSYSTM 3515 ERRNZ EFITBUF-1 FIX NEXT LINE V41CC05 131 SA3 A1+B1 X3:=24/BUFLEN, 18/BUFADR, 18/EOR PSYSTM 3516 ERRNZ EFITOUT-EFITBUF-1 FIX NEXT LINE V41CC05 132 SA4 A3+B1 X4 := OUT PSYSTM 3517 LX1 59-ETEXT INSPECT TEXT-FILE BIT V41CC05 133 AX3 18 PSYSTM 3519 SX3 X3 X3 := BUFADR PSYSTM 3520 IX4 X4-X3 NO. OF WORDS FOR TRANSFER PSYSTM 3521 NG X1,FOB1 IF TEXT FILE GOTO FOB1 PSYSTM 3522 PSYSTM 3523 * FLUSH BINARY FILE. PSYSTM 3524 PSYSTM 3525 ZR X4,FOBX RETURN IF BUFFER EMPTY PSYSTM 3526 RJ RMP RECORD MANAGER PUT ROUTINE PSYSTM 3527 JP FOBX RETURN PSYSTM 3528 PSYSTM 3529 * FLUSH TEXT-FILE. PSYSTM 3530 PSYSTM 3531 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 134 FOB1 SA3 A1-B1 X3 := PACK/UNPACK BUFFER POINTER PSYSTM 3532 NZ X4,FOB2 RM WORKSPACE BUFFER NOT EMPTY PSYSTM 3533 PSYSTM 3534 SX3 X3 CHECK CONTENTS OF EFET BUFFER PSYSTM 3535 SX0 A1+EFETCBUF FWA V41CC05 135 IX0 X3-X0 PSYSTM 3537 ZR X0,FOBX IF EFET BUFFER EMPTY THEN RETURN PSYSTM 3538 PSYSTM 3539 * CALL PUTL TO FLUSH TEXT BUFFERS. PSYSTM 3540 PSYSTM 3541 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 136 FOB2 SA1 A1-B1 A1 := ADDR(EFET[-1]) PSYSTM 3542 RJ PTL PSYSTM 3543 SCOPE2 ENDIF PSYSTM 3544 PSYSTM 3545 EQ FOBX RETURN PSYSTM 3546 P.FXF SPACE 4,15 V41CC14 10 ** P.FXF - FLUSH EXTERNAL FILE BUFFERS. V41CC14 11 * V41CC14 12 * ENTRY (B1) = 1. V41CC14 13 * V41CC14 14 * EXIT (X6) >= 0 IF NO EXTERNAL FILES. V41CC14 15 * (X6) < 0 IF EXTERNAL FILES EXIST. V41CC14 16 * EXTERNAL FILE BUFFERS FLUSHED. V41CC14 17 * V41CC14 18 * USES X - 1, 2, 3, 4, 5, 6. V41CC14 19 * A - 1, 3, 5. V41CC14 20 * B - 2. V41CC14 21 * V41CC14 22 * CALLS FOB. V41CC14 23 V41CC14 24 V41CC14 25 FXF ROUTINE P.FXF ENTRY/EXIT V41CC14 26 SA1 =XP.PIT+PITFLAG V41CC14 27 LX6 B1,X1 V41CC14 28 R= B2,ARGR-1 INITIALIZE LOWCORE FILE POINTER V41CC14 29 PL X6,FXFX IF NO EXTERNAL FILES V41CC14 30 FXF2 SA5 B2+B1 ADVANCE TO NEXT FILE POINTER V41CC14 31 SB2 B2+B1 V41CC14 32 SX2 X5 FET ADDRESS V41CC14 33 MX6 1 INDICATE EXTERNAL FILES EXIST V41CC14 34 ZR X5,FXFX IF NO MORE FILES LEFT V41CC14 35 ZR X2,FXF2 IF FILE NOT OPENED V41CC14 36 V41CC14 37 OS IFNE SCOPE2,1 V41CC14 38 SA1 X2-EFETFET EFET V41CC14 39 OS ELSE V41CC14 40 SA1 X2-EFITFIT EFET V41CC14 41 OS ENDIF V41CC14 42 V41CC14 43 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC14 44 SA3 A1-B1 EFET POINTER WORD V41CC14 45 LX1 59-EREWRITE WORD FILE REWRITE (IN BIT 59) V41CC14 46 LX3 59-PREWRITE TEXT FILE REWRITE (IN BIT 59) V41CC14 47 ERRNZ ETEXT-EREWRITE+1 FIX NEXT LINE V41CC14 48 LX4 B1,X1 TEXT FILE FLAG (IN BIT 59) V41CC14 49 BX3 -X4+X3 V41CC14 50 BX4 X1*X3 V41CC14 51 PL X4,FXF2 IF FILE NOT READY FOR WRITING V41CC14 52 RJ FOB FLUSH OUTPUT BUFFER V41CC14 53 SA1 X2 FET V41DC04 8 MX4 42 V41DC04 9 SA3 =6LOUTPUT V41DC04 10 BX6 X4*X1 V41DC04 11 BX4 X6-X3 V41DC04 12 NZ X4,FXF2 IF FILE NAME NOT *OUTPUT* V41DC04 13 RECALL X2 WAIT FOR I/O TO COMPLETE V41DC04 14 EQ FXF2 TRY NEXT FILE POINTER V41CC14 54 P.ISM SPACE 4,15 PSYSTM 3547 ** P.ISM - ISSUE STATISTICS MESSAGE TO DAYFILE. PSYSTM 3548 * PSYSTM 3549 * ENTRY (ISMA) = PRESET WITH INITIAL MILLISECOND CLOCK. PSYSTM 3550 * PSYSTM 3551 * EXIT CP/CM USED MESSAGE ISSUED TO DAYFILE. PSYSTM 3552 * PSYSTM 3553 * USES ALL REGISTERS. PSYSTM 3554 * PSYSTM 3555 * CALLS CAD, CFD, CLK. PSYSTM 3556 * PSYSTM 3557 * MACROS MESSAGE. PSYSTM 3558 PSYSTM 3559 PSYSTM 3560 ISM ROUTINE P.ISM ENTRY/EXIT PSYSTM 3561 SA1 =XP.TMEM+MEMHFL HIGHEST FL USED BY MEMORY MANAGER PSYSTM 3562 RJ CAD CONVERT TO DISPLAY CODE PSYSTM 3563 SA2 MSGAF PSYSTM 3564 MX0 7*6 PSYSTM 3565 LX6 3*6 PSYSTM 3566 BX2 -X0*X2 REMOVE XXXXXX PSYSTM 3567 BX6 X0*X6 REMOVE BLANKS PSYSTM 3568 BX6 X2+X6 PSYSTM 3569 SA6 A2 INSERT MAX CM USED INTO DAYFILE MESSAGE PSYSTM 3570 PSYSTM 3571 NOS IFNE KRONOS+NOS1+NOS2+SCOPE2,0 V41AC01 41 MESSAGE MSGAF,"IMSG" ISSUE MAX CM USED TO DAYFILE PSYSTM 3573 NOS ENDIF PSYSTM 3574 PSYSTM 3575 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 3576 MESSAGE MSGAF,"IMSG",R ISSUE MAX CM USED TO DAYFILE PSYSTM 3577 NOSBE ENDIF PSYSTM 3578 PSYSTM 3579 SA1 =XP.TMEM+MEMHLF HIGHEST ADDRESS OF LAST FREE NODE PSYSTM 3580 RJ CAD CONVERT TO DISPLAY CODE PSYSTM 3581 SA2 MSGAA+2 CM PORTION OF MESSAGE PSYSTM 3582 MX0 4*6 PSYSTM 3583 BX6 -X0*X6 REMOVE BLANKS PSYSTM 3584 LX0 4*6 POSITION MASK PSYSTM 3585 BX2 X0*X2 REMOVE XXXXXX PSYSTM 3586 LX6 4*6 POSITION DIGITS PSYSTM 3587 BX7 X2+X6 PSYSTM 3588 SA7 A2+ RESTORE WORD PSYSTM 3589 SA5 ISMA PSYSTM 3590 RJ CLK GET MILLISECOND CLOCK PSYSTM 3591 IX1 X6-X5 PSYSTM 3592 RJ CFD CONVERT CP SECONDS TO PASCAL 10:3 FORM PSYSTM 3593 SA6 MSGAA PSYSTM 3594 MESSAGE MSGAA,"IMSG" ISSUE CP TIME, MAX CM USED TO DAYFILE PSYSTM 3595 EQ ISMX RETURN PSYSTM 3596 PSYSTM 3597 ISMA BSS 1 INITIAL MILLISECOND CLOCK PSYSTM 3598 P.PPF SPACE 4,15 PSYSTM 3599 ** P.PPF - PREPARE FOR POSITIONING PASCAL FILE. PSYSTM 3600 * PSYSTM 3601 * IF THE ACTUAL FILE NAME IS NEITHER INPUT NOR OUTPUT, PSYSTM 3602 * FLUSH THE I/O BUFFER (FOR OUTPUT FILES). PSYSTM 3603 * PSYSTM 3604 * ENTRY (X2) = FET ADDRESS. PSYSTM 3605 * PSYSTM 3606 * EXIT (X2) = FET ADDRESS. PSYSTM 3607 * (X0) < 0 ONLY IF THE NAME IS INPUT OR OUTPUT. PSYSTM 3608 * OUTPUT BUFFER FLUSHED UNLESS (X0) < 0. V41EC04 19 * PSYSTM 3610 * USES X - ALL. PSYSTM 3611 * A - 1, 3, 4, 6, 7. PSYSTM 3612 * PSYSTM 3613 * CALLS FOB. PSYSTM 3614 PSYSTM 3615 PSYSTM 3616 PPF ROUTINE P.PPF ENTRY/EXIT PSYSTM 3617 SA1 X2 FET PSYSTM 3618 MX0 42 PSYSTM 3619 SA3 =5LINPUT PSYSTM 3620 BX6 X0*X1 PSYSTM 3621 SA4 =6LOUTPUT PSYSTM 3622 IX3 X6-X3 PSYSTM 3623 BX4 X6-X4 PSYSTM 3624 ZR X3,PPFX IF ACTUAL FILE NAME IS INPUT PSYSTM 3625 ZR X4,PPFX IF ACTUAL FILE NAME IS OUTPUT PSYSTM 3626 RJ FOB FLUSH OUTPUT BUFFER PSYSTM 3627 BX0 X0-X0 PSYSTM 3628 EQ PPFX RETURN PSYSTM 3629 P.RMP SPACE 4,20 PSYSTM 3630 ** P.RMP - 7000 RECORD MANAGER PUT ROUTINE. PSYSTM 3631 * PSYSTM 3632 * S-TYPE RECORDS ARE WRITTEN USING THE PUTWP MACRO. PSYSTM 3633 * ALL OTHERS ARE HANDLED BY PUTW. PSYSTM 3634 * PSYSTM 3635 * ENTRY (A1) = EFET. PSYSTM 3636 * (X1) = (EFET[0]). PSYSTM 3637 * (X2) = ADDR(FIT[0]). PSYSTM 3638 * (X3) = BUFFER ADDRESS. PSYSTM 3639 * (X4) = 42/UNUSED-BITS,18/WORDS-FOR-TRANSFER. PSYSTM 3640 * PSYSTM 3641 * EXIT (X6) = BUFFER ADDRESS. PSYSTM 3642 * PSYSTM 3643 * USES X - 0, 1, 4, 5, 6. PSYSTM 3644 * A - 1, 4, 5, 6. PSYSTM 3645 * B - 3, 7. PSYSTM 3646 * PSYSTM 3647 * MACROS PUTW, PUTWP, STORE. PSYSTM 3648 PSYSTM 3649 PSYSTM 3650 SCOPE2 IFNE SCOPE2,0 PSYSTM 3651 PSYSTM 3652 RMP ROUTINE P.RMP ENTRY/EXIT PSYSTM 3653 SA1 A1 REFRESH X1 PSYSTM 3654 MX0 -ERTW V41CC05 137 LX1 0-ERT FOR RECORD TYPE V41CC05 138 BX6 -X0*X1 EXTRACT RT V41CC05 139 SX0 X6-RTU PSYSTM 3659 NZ X0,RMP.02 IF RT <> U PSYSTM 3660 SX4 X4 PSYSTM 3661 RMP.02 BSS 0 PSYSTM 3662 SX0 X6-RTF PSYSTM 3663 NZ X0,RMP.0 IF RT <> F PSYSTM 3664 PSYSTM 3665 ERRNZ EFITBUF-1 FIX NEXT LINE V41CC05 140 SA5 A1+B1 X5 := EFET+1 PSYSTM 3666 AX5 18 X5 := BUFADDR PSYSTM 3667 SA4 A1+2 PSYSTM 3668 SB7 X5 PSYSTM 3669 AX5 18 X5 := BUFLEN PSYSTM 3670 SB3 X4 PSYSTM 3671 SB7 B7+X5 B7 := END OF WSA PSYSTM 3672 SA5 =10H PSYSTM 3673 BX6 X5 PSYSTM 3674 PSYSTM 3675 RMP.01 SA6 B3 PUT IN TEN SPACES PSYSTM 3676 SB3 B3+B1 PSYSTM 3677 GE B7,B3,RMP.01 IF MORE WORDS PSYSTM 3678 EQ RMP1 PSYSTM 3679 PSYSTM 3680 RMP.0 BSS 0 PSYSTM 3681 SX0 X6-RTZ PSYSTM 3682 ZR X0,RMP.1 IF RT = Z PSYSTM 3683 SX0 X6-RTS PSYSTM 3684 NZ X0,RMP1 IF RT <> S PSYSTM 3685 PSYSTM 3686 * PUT S-TYPE RECORDS. PSYSTM 3687 PSYSTM 3688 MX0 42 PSYSTM 3689 BX4 -X0*X4 CLEAR UNUSED BITS PSYSTM 3690 PUTWP X2,X3,X4,RMIOE PSYSTM 3691 EQ RMP2 PSYSTM 3692 PSYSTM 3693 * PUT OTHER RECORD TYPES. PSYSTM 3694 PSYSTM 3695 RMP.1 LX1 ERT-0+59-ETEXT POSITION TEXT BIT V41CC05 141 PL X1,RMP1 IF NOT TEXT PSYSTM 3697 STORE X2,FLW=X4 PSYSTM 3698 PSYSTM 3699 * PREVENT 60 UNUSED BITS. PSYSTM 3700 PSYSTM 3701 RMP1 BSS 0 PSYSTM 3702 BX5 X4 PSYSTM 3703 AX5 18 PSYSTM 3704 SX5 X5-60 PSYSTM 3705 NZ X5,RMP.2 PSYSTM 3706 SX4 X4-1 PSYSTM 3707 PSYSTM 3708 RMP.2 BSS 0 PSYSTM 3709 PUTW X2,X3,X4,RMIOE PSYSTM 3710 PSYSTM 3711 * RESET BUFFER POINTERS. PSYSTM 3712 PSYSTM 3713 RMP2 BSS 0 PSYSTM 3714 ERRNZ EFITBUF-1 FIX NEXT LINE V41CC05 142 SA3 A1+B1 X1 := BUFFER DESCRIPTOR PSYSTM 3715 AX3 18 PSYSTM 3716 SX6 X3 X6 := BUFADR PSYSTM 3717 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 143 SA6 A1-B1 EFET[-1] := BUFADR PSYSTM 3718 SA6 A1+EFITOUT OUT := BUFADR V41CC05 144 EQ RMPX RETURN PSYSTM 3720 PSYSTM 3721 SCOPE2 ENDIF PSYSTM 3722 P.RPF SPACE 4,20 PSYSTM 3723 ** P.RPF - REWIND PASCAL FILE. PSYSTM 3724 * PSYSTM 3725 * IF THE ACTUAL FILE NAME IS NEITHER INPUT NOR OUTPUT, PSYSTM 3726 * FLUSH THE I/O BUFFER (FOR OUTPUT FILES) AND, UNLESS PSYSTM 3727 * IT IS CONNECTED TO A TERMINAL FILE UNDER INTERCOM, PSYSTM 3728 * REWIND IT. PSYSTM 3729 * PSYSTM 3730 * ENTRY (X2) = FET ADDRESS. PSYSTM 3731 * PSYSTM 3732 * EXIT (X2) = FET ADDRESS. PSYSTM 3733 * (X0) < 0 ONLY IF THE NAME IS INPUT OR OUTPUT. PSYSTM 3734 * PSYSTM 3735 * USES X - ALL. PSYSTM 3736 * A - 1, 3, 4, 6, 7. PSYSTM 3737 * PSYSTM 3738 * CALLS FOB, PPF. PSYSTM 3739 * PSYSTM 3740 * MACROS REWIND, REWINDM. PSYSTM 3741 PSYSTM 3742 PSYSTM 3743 RPF ROUTINE P.RPF ENTRY/EXIT PSYSTM 3744 RJ PPF PREPARE FOR POSITIONING FILE PSYSTM 3745 NG X0,RPFX RETURN IF INPUT OR OUTPUT PSYSTM 3746 PSYSTM 3747 NOSBE IFNE NOSBE+SCOPE34,0 PSYSTM 3748 SA1 X2-EFETFET DISPOSITION CODES V41CC05 145 LX1 59-ECONNECT TERMINAL CONNECTION BIT V41EC01 11 BX0 X0-X0 PSYSTM 3751 NG X1,RPFX RETURN IF CONNECTED PSYSTM 3752 NOSBE ENDIF PSYSTM 3753 PSYSTM 3754 SCOPE2 IFNE SCOPE2,1 PSYSTM 3755 REWIND X2 PSYSTM 3756 SCOPE2 ELSE PSYSTM 3757 REWINDM X2 PSYSTM 3758 SCOPE2 ENDIF PSYSTM 3759 PSYSTM 3760 BX0 X0-X0 PSYSTM 3761 EQ RPFX RETURN PSYSTM 3762 P.RWR SPACE 4,10 PSYSTM 3763 ** P.RWR - READ WITHOUT RESET. PSYSTM 3764 * PSYSTM 3765 * ENTRY (X2) = FET ADDRESS. PSYSTM 3766 * PSYSTM 3767 * EXIT TO IOE1. PSYSTM 3768 * PSYSTM 3769 * USES X - 1. PSYSTM 3770 * PSYSTM 3771 * CALLS IOE. PSYSTM 3772 PSYSTM 3773 PSYSTM 3774 RWR ENTER P.RWR ENTRY V41CC13 15 SX1 IOEG TRIED TO READ XXXXXXX WITHOUT RESET V41CC13 16 EQ IOE1 ISSUE INPUT/OUTPUT ERROR PSYSTM 3777 P.SKP SPACE 4,20 PSYSTM 3778 ** P.SKP - SKIP RECORDS. PSYSTM 3779 * PSYSTM 3780 * ENTRY (A1) = EFET ADDRESS. PSYSTM 3781 * (X1) = ((A1)). PSYSTM 3782 * (X2) = SKIP COUNT. PSYSTM 3783 * (B7) = UNIT TO SKIP (SCOPE2 ONLY). V41CC05 146 * PSYSTM 3784 * EXIT (X2) = FET ADDRESS. PSYSTM 3785 * PSYSTM 3786 * USES X - ALL. PSYSTM 3787 * A - 1, 3, 4, 6, 7. PSYSTM 3788 * B - 2, 3, 7. PSYSTM 3789 * PSYSTM 3790 * CALLS FOB, IOE. PSYSTM 3791 * PSYSTM 3792 * MACROS FETCH, GETPOS, POSITION, RECALL, SKIPB, SKIPBL, SKIPF, PSYSTM 3793 * SKIPFL, STORE. PSYSTM 3794 PSYSTM 3795 PSYSTM 3796 SCOPE2 IFNE SCOPE2,1 PSYSTM 3797 SKP1 PL X7,SKP2 IF ABS(SKIP COUNT) > 777776B PSYSTM 3798 SA3 X2+ FET V41AC12 6 LX6 1 PSYSTM 3799 LX3 0-9 RIGHT ADJUST EOI BIT V41AC12 7 BX3 -X3*X6 EXTRACT AND COMPLEMENT EOI BIT V41AC12 8 IX1 X5+X3 ADD 1 TO COUNT IF NOT EOI V41AC12 9 ZR X1,SKPX RETURN IF ZERO ADJUSTED COUNT V41AC12 10 SKP2 SKIPB X2,X1,R SKIP BACKWARDS PSYSTM 3801 PSYSTM 3802 SKP ROUTINE P.SKP ENTRY/EXIT PSYSTM 3803 BX6 X2 SAVE SKIP COUNT PSYSTM 3804 SA6 SKPA PSYSTM 3805 ERRNZ EFETFET-1 FIX NEXT LINE V41CC05 147 SX2 A1+B1 FET PSYSTM 3806 RJ FOB FLUSH OUTPUT BUFFER PSYSTM 3807 SA4 X2-EFETFET EFET V41CC05 148 RECALL X2 WAIT I/O COMPLETE PSYSTM 3809 SA3 SKPA GET SKIP COUNT PSYSTM 3810 MX6 1 PSYSTM 3811 MX1 18 SET DEFAULT SKIP COUNT PSYSTM 3812 LX1 18 PSYSTM 3813 NO PSYSTM 3814 BX0 X3 PSYSTM 3815 AX0 59 PSYSTM 3816 BX5 X0-X3 ABS (SKIP COUNT) PSYSTM 3817 IX7 X5-X1 ABS (SKIP COUNT) - 777777B PSYSTM 3818 NG X3,SKP1 IF NEGATIVE SKIP COUNT PSYSTM 3819 ZR X3,SKP1 IF ZERO SKIP COUNT PSYSTM 3820 PL X7,SKP3 IF ABS(SKIP COUNT) > 777776B PSYSTM 3821 SA3 X2 FET PSYSTM 3822 LX3 59-4 EOR BIT TO POSITION 59 V41CC05 149 ERRNZ EEOSF-59 SHIFT X4 V41CC05 150 BX7 X3+X4 FET EOR + EFET EOS PSYSTM 3824 BX0 X6*X7 PSYSTM 3825 AX0 59-1 PSYSTM 3826 IX1 X5+X0 SUBTRACT ONE IF FET EOR OR EFET EOS PSYSTM 3827 ZR X1,SKPX IF FINAL SKIP COUNT ZERO PSYSTM 3828 SKP3 SKIPF X2,X1,R SKIP FORWARD PSYSTM 3829 EQ SKPX RETURN PSYSTM 3830 PSYSTM 3831 PSYSTM 3832 SKPA SCRATCH 1 SKIP COUNT PSYSTM 3833 PSYSTM 3834 SCOPE2 ELSE PSYSTM 3835 PSYSTM 3836 SKP.END MX6 2 PSYSTM 3837 SA1 A1 REFRESH X1 PSYSTM 3838 ERRNZ EEOSF-59 FIX X6 V41CC05 151 ERRNZ EEOF-58 FIX X6 V41CC05 152 BX6 X6+X1 SET EOF/EOS PSYSTM 3839 SA6 A1 PSYSTM 3840 SB7 B0 SET FLAG PSYSTM 3841 SKP.RET STORE X2,DX=0 PSYSTM 3842 NZ X0,SKPX PSYSTM 3843 STORE X2,RT=Z RESTORE RT=Z PSYSTM 3844 PSYSTM 3845 SKP ROUTINE P.SKP ENTRY/EXIT PSYSTM 3846 SB2 X2 PSYSTM 3847 SX2 A1+EFITFIT X2 := ADDR(FIT[0]) PSYSTM 3848 RJ FOB IF OUTPUT FILE, FLUSH IT PSYSTM 3849 SA1 X2-EFITFIT REFRESH X1 PSYSTM 3850 SX3 B2-1 SET COUNT PSYSTM 3851 FETCH X2,FP,X5 PSYSTM 3852 NG X3,SKP.00 PSYSTM 3853 SX6 X5-FPEOI PSYSTM 3854 ZR X6,SKP.END IF AT EOI PSYSTM 3855 PSYSTM 3856 SKP.00 BSS 0 PSYSTM 3857 SX5 X5+B7 X5=0 IF AT END OF UNIT PSYSTM 3858 LX1 0-ERT-ERTW V41CC05 153 AX1 -ERTW ISOLATE RT FIELD V41CC05 154 PSYSTM 3861 * SWITCH ON RECORD TYPE. PSYSTM 3862 PSYSTM 3863 ZR X1,SKP.W IF RT = W PSYSTM 3864 SX0 X1-RTS PSYSTM 3865 ZR X0,SKP.S IF RT = S PSYSTM 3866 SX0 X1-RTZ PSYSTM 3867 ZR X0,SKP.Z IF RT = Z PSYSTM 3868 SX0 B7+FPEOS PSYSTM 3869 ZR X0,SKP.ERR IF GETSEG AND NOT (RT IN [W,S,Z]) PSYSTM 3870 PSYSTM 3871 SKP.W SX0 1 PSYSTM 3872 NG X5,SKP.0 IF EOS PSYSTM 3873 ZR X3,SKP IF COUNT = 0 PSYSTM 3874 SX3 X3-1 PSYSTM 3875 SKP.0 BSS 0 PSYSTM 3876 SB3 X3 B3 := SIGN(X3) IN EFFECT PSYSTM 3877 PL X3,SKP.01 IF COUNT NOT NEGATIVE PSYSTM 3878 BX3 -X3 PSYSTM 3879 SX3 X3-1 PSYSTM 3880 SKP.01 BSS 0 PSYSTM 3881 STORE X2,DX=SKP.WDX PSYSTM 3882 NG B3,SKP.B IF NEGATIVE COUNT PSYSTM 3883 SKP.F SKIPFL X2,377777B PSYSTM 3884 EQ SKP.F KEEP SKIPPING UNTIL EOS/EOP PSYSTM 3885 SKP.B SKIPBL X2,377777B PSYSTM 3886 EQ SKP.B KEEP SKIPPING UNTIL EOS/BOI PSYSTM 3887 PSYSTM 3888 SKP.WDX PS PSYSTM 3889 FETCH X2,FP,X5 PSYSTM 3890 SX5 X5-FPBOI PSYSTM 3891 ZR X5,SKP.RET IF AT BOI PSYSTM 3892 SX5 X5-FPEOP PSYSTM 3893 PL X5,SKP.END IF AT EOP PSYSTM 3894 SX5 X5+FPEOP+FPBOI PSYSTM 3895 SX5 X5+B7 PSYSTM 3896 NZ X5,SKP.WDX IF AT END OF UNIT PSYSTM 3897 SX3 X3-1 PSYSTM 3898 PL X3,SKP.WDX IF NOT COUNTED OUT PSYSTM 3899 PL B3,SKP.RET IF FORWARD PSYSTM 3900 GETPOS X2,X5 PSYSTM 3901 POSITION X2,X5 PSYSTM 3902 STORE X2,DX=0 PSYSTM 3903 SKIPFL X2,1 PSYSTM 3904 EQ SKPX RETURN PSYSTM 3905 PSYSTM 3906 SKP.S SX0 1 PSYSTM 3907 SB3 B7+FPEOS PSYSTM 3908 NZ B3,SKP.S1 IF NOT EOS PSYSTM 3909 SX5 X5+FPEOS-FPEOR S-TYPE SECTION REPORTED AS RECORD PSYSTM 3910 SKP.S1 SB3 X3 PSYSTM 3911 NG X3,SKP.ZS NEGATIVE SKIPCOUNT OK. PSYSTM 3912 NG X5,SKP.ZS IF NOT MID RECORD PSYSTM 3913 ZR X3,SKP.RET PSYSTM 3914 SX3 X3-1 PSYSTM 3915 EQ SKP.ZS PSYSTM 3916 PSYSTM 3917 SKP.Z STORE X2,RT=S PSYSTM 3918 SB3 X3 PSYSTM 3919 NG X3,SKP.ZN NEGATIVE COUNT OK PSYSTM 3920 PL X5,SKP.ZZ PSYSTM 3921 SX3 X3+1 PSYSTM 3922 EQ SKP.ZS PSYSTM 3923 SKP.ZZ BSS 0 PSYSTM 3924 ZR X3,SKP.RET PSYSTM 3925 EQ SKP.ZS PSYSTM 3926 SKP.ZN PL X5,SKP.ZS PSYSTM 3927 SX3 X3+1 PSYSTM 3928 PSYSTM 3929 * FP EOS IS REPORTED AS PF=EOR FOR RT=S. PSYSTM 3930 PSYSTM 3931 SKP.ZS BSS 0 PSYSTM 3932 SB7 B7+FPEOS PSYSTM 3933 ZR B7,SKP.ZS1 PSYSTM 3934 SB7 -FPEOP FP=EOP NOT CHANGED PSYSTM 3935 EQ SKP.ZS2 PSYSTM 3936 SKP.ZS1 SB7 -FPEOR FP=EOS SET TO FP=EOR PSYSTM 3937 SKP.ZS2 BSS 0 PSYSTM 3938 STORE X2,DX=SKP.SDX PSYSTM 3939 NG B3,SKP.BB PSYSTM 3940 SKP.FS SKIPFL X2,1 PSYSTM 3941 RJ SKP.WDX PSYSTM 3942 EQ SKP.FS PSYSTM 3943 SKP.BB SX5 -B1 PSYSTM 3944 IX3 X5-X3 X3 := -(X3-1) ; PSYSTM 3945 SB3 B1 FOR SKP.WDX PSYSTM 3946 SKP.BS SKIPBL X2,1 PSYSTM 3947 RJ SKP.WDX PSYSTM 3948 EQ SKP.BS PSYSTM 3949 PSYSTM 3950 SKP.SDX DATA 0 PSYSTM 3951 RJ SKP.WDX PSYSTM 3952 NG B3,SKP.BS PSYSTM 3953 EQ SKP.FS PSYSTM 3954 PSYSTM 3955 SKP.ERR SX1 RMIOEE PSYSTM 3956 EQ IOE1 PSYSTM 3957 SCOPE2 ENDIF PSYSTM 3958 P.SNM SPACE 4,30 PSYSTM 3959 ** P.SNM - SET NAME IN MESSAGE. PSYSTM 3960 * PSYSTM 3961 * REPLACES OCCURRENCES OF THE SUBSTITUTION CHARACTER WITHIN PSYSTM 3962 * A MESSAGE WITH THE CHARACTERS OF THE GIVEN NAME OR NUMBER, PSYSTM 3963 * ELIMINATING ALL EXCESS OCCURRENCES OF THE SUBSTITUTION PSYSTM 3964 * CHARACTER, AND GUARANTEEING AN EOLN IN THE NEW MESSAGE. PSYSTM 3965 * THE ORIGINAL MESSAGE MUST CONTAIN A SUFFICIENT NUMBER OF PSYSTM 3966 * SUBSTITUTION CHARACTERS (USUALLY CONSECUTIVE) TO ALLOW FOR PSYSTM 3967 * REPLACEMENT BY THE NAME OR NUMBER (UP TO 10 CHARACTERS). PSYSTM 3968 * THE MESSAGE MUST NOT CONTAIN COLONS (00B) AS THEY WILL BE PSYSTM 3969 * INTERPRETED AS AN EOLN. ADAPTED FROM CDC COMMON DECK PSYSTM 3970 * *COMCSNM*. PSYSTM 3971 * PSYSTM 3972 * ENTRY (A4) = FWA - 1 OF MESSAGE. PSYSTM 3973 * (B1) = 1. PSYSTM 3974 * (B7) = DISPLAY CODE SUBSTITUTION CHARACTER, PSYSTM 3975 * RIGHT JUSTIFIED, BINARY ZERO FILLED. PSYSTM 3976 * (X1) = DISPLAY CODE NAME TO BE SET IN MESSAGE, PSYSTM 3977 * LEFT JUSTIFIED, BINARY ZERO FILLED. PSYSTM 3978 * (X4) = ((A4)). PSYSTM 3979 * PSYSTM 3980 * EXIT (B7) = UNCHANGED. PSYSTM 3981 * (X1) = UNCHANGED. PSYSTM 3982 * NAME ENTERED INTO MESSAGE IN PLACE OF SUBSTITUTION PSYSTM 3983 * CHARACTERS. PSYSTM 3984 * PSYSTM 3985 * USES X - 0, 1, 2, 3, 4, 6, 7. PSYSTM 3986 * A - 4, 7. PSYSTM 3987 * B - 2, 3. PSYSTM 3988 PSYSTM 3989 PSYSTM 3990 SNM4 SX2 B2 INSURE EVEN NUMBER OF CHARACTERS PSYSTM 3991 LX2 -1 PSYSTM 3992 PL X2,SNM6 IF NOT ODD NUMBER OF CHARACTERS PSYSTM 3993 SX3 1R PSYSTM 3994 BX2 -X6*X7 PSYSTM 3995 IX2 X2-X3 PSYSTM 3996 NZ X2,SNM5 IF LAST CHARACTER NOT BLANK PSYSTM 3997 AX7 6 REMOVE TRAILING BLANK PSYSTM 3998 SB2 B2+B1 PSYSTM 3999 EQ SNM6 LEFT JUSTIFY LAST WORD OF NEW MESSAGE PSYSTM 4000 PSYSTM 4001 SNM5 LX7 6 ADD TRAILING BLANK PSYSTM 4002 SB2 B2-1 PSYSTM 4003 BX7 X3+X7 PSYSTM 4004 SNM6 SB2 B2+B2 LEFT JUSTIFY LAST WORD OF NEW MESSAGE PSYSTM 4005 BX1 X0 RESTORE X1 PSYSTM 4006 SB3 B2+B2 CALCULATE SHIFT COUNT PSYSTM 4007 MX2 -12 PSYSTM 4008 SB2 B3+B2 PSYSTM 4009 LX7 X7,B2 PSYSTM 4010 SA7 A7+B1 PSYSTM 4011 BX2 -X2*X7 PSYSTM 4012 ZR X2,SNMX IF END OF LINE SET PSYSTM 4013 BX7 X7-X7 GUARANTEE END OF LINE PSYSTM 4014 SA7 A7+B1 PSYSTM 4015 PSYSTM 4016 SNM ROUTINE P.SNM ENTRY/EXIT PSYSTM 4017 SB2 10 INITIALIZE REGISTERS PSYSTM 4018 BX7 X4 PSYSTM 4019 LX0 X1 SAVE X1 PSYSTM 4020 SA7 A4 PSYSTM 4021 SB3 B0 PSYSTM 4022 MX6 -6 PSYSTM 4023 BX7 X7-X7 PSYSTM 4024 SNM1 SB3 B3-B1 DECREMENT OLD MESSAGE WORD CHARACTER COUNT PSYSTM 4025 SX3 B7 PSYSTM 4026 PL B3,SNM2 IF MORE CHARACTERS IN OLD MESSAGE WORD PSYSTM 4027 SA4 A4+1 GET NEXT WORD IN ORIGINAL MESSAGE PSYSTM 4028 SB3 9 RESET OLD MESSAGE WORD CHARACTER COUNT PSYSTM 4029 SNM2 LX4 6 GET NEXT CHARACTER FROM ORIGINAL MESSAGE PSYSTM 4030 BX2 -X6*X4 PSYSTM 4031 ZR X2,SNM4 IF END OF LINE PSYSTM 4032 IX3 X2-X3 PSYSTM 4033 NZ X3,SNM3 IF NOT SUBSTITUTION CHARACTER PSYSTM 4034 LX1 6 PSYSTM 4035 ZR X1,SNM1 IF REPLACEMENT ALREADY COMPLETED PSYSTM 4036 BX2 -X6*X1 GET NEXT CHARACTER FROM SPECIFIED NAME PSYSTM 4037 BX1 X6*X1 PSYSTM 4038 SNM3 LX7 6 ENTER NEXT CHARACTER INTO NEW MESSAGE WORD PSYSTM 4039 BX7 X7+X2 PSYSTM 4040 SB2 B2-1 DECREMENT NEW MESSAGE WORD CHARACTER COUNT PSYSTM 4041 GT B2,SNM1 IF NEW MESSAGE WORD NOT FULL PSYSTM 4042 SA7 A7+B1 SAVE NEW MESSAGE WORD PSYSTM 4043 BX7 X7-X7 PSYSTM 4044 SB2 10 RESET NEW MESSAGE WORD CHARACTER COUNT PSYSTM 4045 EQ SNM1 CONTINUE BUILDING NEW MESSAGE PSYSTM 4046 P.SPK SPACE 4,10 PSYSTM 4047 ** P.SPK - SET POINTER KEY. PSYSTM 4048 * PSYSTM 4049 * ENTRY (X6) = P = ADDRESS OF POINTER-KEY WORD IN NODE. PSYSTM 4050 * PSYSTM 4051 * EXIT (X6) = 24/0,18/KEY,18/P+1. PSYSTM 4052 * (P) = (X6). PSYSTM 4053 * (TGVR+TGVRKEY) UPDATED. PSYSTM 4054 * PSYSTM 4055 * USES X - 2, 3, 4, 6, 7. PSYSTM 4056 * A - 2, 6, 7. PSYSTM 4057 PSYSTM 4058 PSYSTM 4059 SPK ROUTINE P.SPK ENTRY/EXIT PSYSTM 4060 SA2 TGVR+TGVRKEY GET THE OLD KEY PSYSTM 4061 MX4 -18 PSYSTM 4062 SX3 X2+B1 FORM NEW KEY VALUE PSYSTM 4063 BX7 -X4*X3 MODULUS 2**18 PSYSTM 4064 NZ X3,SPK1 IF NEW KEY IS NONZERO PSYSTM 4065 SX7 B1 ENSURE NEW KEY IS NONZERO PSYSTM 4066 SPK1 SA7 A2 UPDATE TGVR+TGVRKEY PSYSTM 4067 SX6 X6+B1 POINT TO P+1 PSYSTM 4068 LX7 18 PSYSTM 4069 BX6 X7+X6 NEW POINTER PSYSTM 4070 SA6 X6-1 SET POINTER KEY IN NODE PSYSTM 4071 EQ SPKX RETURN PSYSTM 4072 P.SRS SPACE 4,15 PSYSTM 4073 ** P.SRS - SET READ STATUS. PSYSTM 4074 * PSYSTM 4075 * FILL BUFFER UNLESS FILE IS A TERMINAL FILE. PSYSTM 4076 * PSYSTM 4077 * ENTRY (X2) = FET ADDRESS. PSYSTM 4078 * PSYSTM 4079 * EXIT (X2) = FET ADDRESS. PSYSTM 4080 * PSYSTM 4081 * USES X - 0, 1, 3, 4, 6, 7. PSYSTM 4082 * A - 1, 2, 3, 4, 6, 7. PSYSTM 4083 * B - 3, 7. PSYSTM 4084 * PSYSTM 4085 * CALLS GTB, GTC. PSYSTM 4086 * PSYSTM 4087 * MACROS RECALL, STORE. PSYSTM 4088 PSYSTM 4089 PSYSTM 4090 SCOPE2 IFNE SCOPE2,1 PSYSTM 4091 SRS2 SX7 X2-EFETFET+EFETCBUF+9 END OF CHARACTER BUFFER V41CC05 155 SCOPE2 ELSE PSYSTM 4093 SRS2 SX7 X2-EFITFIT+EFETCBUF+9 V41CC05 156 SCOPE2 ENDIF PSYSTM 4095 PSYSTM 4096 SX6 CHSPACE ORDINAL FOR SPACE V41CC10 531 MX1 1 PSYSTM 4098 SA6 X7 SET BLANK AS NEXT CHARACTER PSYSTM 4099 ERRNZ PEOLN-59 SHIFT X1 V41CC05 157 BX7 X1+X7 SET EOLN PSYSTM 4100 SA7 X3 SET POINTER PSYSTM 4101 PSYSTM 4102 SRS3 BSS 0 PSYSTM 4103 PSYSTM 4104 SCOPE2 IFNE SCOPE2,1 V41AC01 42 MX3 42+2 PSYSTM 4106 SA1 X2 FET FIRST WORD PSYSTM 4107 LX3 2 PSYSTM 4108 BX6 X3*X1 REMOVE OLD FUNCTION CODE PSYSTM 4109 SX4 10B PSYSTM 4110 IX6 X6+X4 INSERT READ CODE PSYSTM 4111 SA6 A1 PSYSTM 4112 SCOPE2 ENDIF V41AC01 43 PSYSTM 4114 SRS ROUTINE P.SRS ENTRY/EXIT PSYSTM 4115 PSYSTM 4116 SCOPE2 IFNE SCOPE2,1 PSYSTM 4117 SA4 X2+B1 FIRST PSYSTM 4118 SX3 X4 PSYSTM 4119 RECALL X2 WAIT I/O COMPLETE PSYSTM 4120 SA1 X2 FET PSYSTM 4121 MX4 42+2 PSYSTM 4122 LX4 2 PSYSTM 4123 BX6 X4*X1 PSYSTM 4124 SA6 A1 CLEAR FUNCTION CODE PSYSTM 4125 ERRNZ EFETFET-1 FIX NEXT LINE V41CC05 158 SA1 A1-B1 EFET PSYSTM 4126 BX6 X3 FIRST PSYSTM 4127 IX4 X3+X1 PSYSTM 4128 SX7 X4 PSYSTM 4129 SA7 A4+B1 IN := FIRST + LRL PSYSTM 4130 SX3 64B PSYSTM 4131 SA6 A7+B1 OUT := FIRST PSYSTM 4132 SCOPE2 ELSE PSYSTM 4133 SA1 X2-EFITFIT A1 := ADDR(EFET[0]) PSYSTM 4134 ERRNZ EFITBUF-1 FIX NEXT LINE V41CC05 159 SA3 A1+B1 A3 := ADDR(EFET[1]) PSYSTM 4135 AX3 18 PSYSTM 4136 SX6 X3 X6 := BUFADR PSYSTM 4137 LX3 18+24 PSYSTM 4138 SA6 A1+EFITOUT EFET[2] := BUFADR V41CC05 160 SX7 X3 X7 := BUFLEN PSYSTM 4140 LX3 36 X3 := 24/BUFLEN,18/BUFADR,18/0 PSYSTM 4141 BX7 X3+X6 EOR:=BUFADR (EMPTY BUFFER) PSYSTM 4142 SA7 A3 EFET[1]:=24/BUFLEN,18/BUFADR,18/BUFEND PSYSTM 4143 STORE X2,FP=0 RESET FILE POSITION PSYSTM 4144 SX3 64B TO CLEAR EOS, EOF, REWRITE PSYSTM 4145 SCOPE2 ENDIF PSYSTM 4146 PSYSTM 4147 LX3 -6 PSYSTM 4148 ERRNZ EEOSF-59 FIX X3 V41CC05 161 ERRNZ EEOF-58 FIX X3 V41CC05 162 ERRNZ EREWRITE-56 FIX X3 V41CC05 163 BX6 -X3*X1 CLEAR EOS, EOF, AND REWRITE BITS PSYSTM 4149 V41CC10 532 ASCII IFEQ ASCFLAG,1 V41CC10 533 MX7 -EDCCHSW V41CC10 534 LX7 EDCCHS V41CC10 535 BX6 X6*X7 CLEAR DCCHS V41CC10 536 ASCII ENDIF V41CC10 537 V41CC10 538 SA6 A1 PSYSTM 4150 LX6 59-ETEXT V41CC05 164 ERRNZ ETERMFIL-ETEXT+1 FIX NEXT LINE V41CC05 165 LX1 X6,B1 PSYSTM 4152 PL X6,SRS1 IF BINARY FILE PSYSTM 4153 SX3 A1+EFETPTR ADDRESS OF POINTER V41CC05 166 NG X1,SRS2 IF TERMINAL FILE PSYSTM 4155 SX6 A1+EFETSNTL-1 ADDRESS OF SENTINEL - 1 V41CC05 167 V41CC10 539 ASCII IFEQ ASCFLAG,1 V41CC10 540 ERRNZ PEOLN-59 FIX NEXT LINE V41CC10 541 MX7 1 SET EOLN BIT V41CC10 542 BX6 X7+X6 V41CC10 543 ASCII ENDIF V41CC10 544 V41CC10 545 SA6 X3 SET POINTER AND CLEAR EOLN PSYSTM 4157 SA1 X3 EFETPTR V41CC05 168 RJ GTC FILL BUFFER PSYSTM 4159 EQ SRSX RETURN PSYSTM 4160 PSYSTM 4161 SRS1 NG X1,SRS3 IF TERMINAL FILE PSYSTM 4162 SA1 A1+ EFET PSYSTM 4163 RJ GTB FILL BUFFER PSYSTM 4164 EQ SRSX RETURN PSYSTM 4165 P.SWS SPACE 4,15 PSYSTM 4166 ** P.SWS - SET WRITE STATUS. PSYSTM 4167 * PSYSTM 4168 * ENTRY (X2) = FET ADDRESS. PSYSTM 4169 * PSYSTM 4170 * EXIT (X2) = FET ADDRESS. PSYSTM 4171 * PSYSTM 4172 * USES X - 1, 3, 6, 7. PSYSTM 4173 * A - 1, 3, 6, 7. PSYSTM 4174 * B - 7. PSYSTM 4175 * PSYSTM 4176 * MACROS RECALL. PSYSTM 4177 PSYSTM 4178 PSYSTM 4179 SWS ROUTINE P.SWS ENTRY/EXIT PSYSTM 4180 PSYSTM 4181 SCOPE2 IFNE SCOPE2,1 PSYSTM 4182 MX7 42+2 PSYSTM 4183 LX7 2 PSYSTM 4184 RECALL X2 WAIT I/O COMPLETE PSYSTM 4185 SA3 X2 FET PSYSTM 4186 BX6 X7*X3 REMOVE OLD FUNCTION CODE PSYSTM 4187 SX3 24B PSYSTM 4188 IX6 X6+X3 INSERT WRITER CODE PSYSTM 4189 SA6 A3 PSYSTM 4190 SA1 X2+B1 FIRST PSYSTM 4191 SX6 X1 PSYSTM 4192 SA6 A1+B1 IN = FIRST PSYSTM 4193 SA6 A6+B1 OUT = FIRST PSYSTM 4194 ERRNZ EFETFET-1 FIX NEXT LINE V41CC05 169 SA3 A3-B1 EFET PSYSTM 4195 SCOPE2 ELSE PSYSTM 4196 SA1 X2-EFITFIT+EFITBUF PSYSTM 4197 BX3 X1 PSYSTM 4198 AX1 BUFADDR PSYSTM 4199 AX3 BUFLEN PSYSTM 4200 SX6 X1 X6 = BUFFER ADDRESS PSYSTM 4201 SX3 X3 X3 = BUFFER LENGTH PSYSTM 4202 LX1 BUFADDR PSYSTM 4203 IX3 X3+X6 EOR:=BUFLEN+BUFADR PSYSTM 4204 BX7 X1+X3 PSYSTM 4205 SA3 X2-EFITFIT X3 := EFET[0] PSYSTM 4206 SA7 A1 PSYSTM 4207 SCOPE2 ENDIF PSYSTM 4208 PSYSTM 4209 SX1 X6 FIRST PSYSTM 4210 SX7 64B PSYSTM 4211 LX7 -6 PSYSTM 4212 ERRNZ EEOSF-59 FIX X7 V41CC05 170 ERRNZ EEOF-58 FIX X7 V41CC05 171 ERRNZ EREWRITE-56 FIX X7 V41CC05 172 V41CC10 546 ASCII IFEQ ASCFLAG,1 V41CC10 547 MX6 -EDCCHSW V41CC10 548 LX6 EDCCHS V41CC10 549 BX3 X6*X3 MASK OFF OLD DCCHS V41CC10 550 SX6 DCALFALN V41CC10 551 LX6 EDCCHS V41CC10 552 BX7 X7+X6 V41CC10 553 ASCII ENDIF V41CC10 554 V41CC10 555 BX6 X7+X3 SET EOS, EOF, AND REWRITE BITS PSYSTM 4213 SA6 A3+ PSYSTM 4214 LX6 59-ETEXT V41CC05 173 BX3 X3-X3 PSYSTM 4216 SX7 1R PSYSTM 4217 PL X6,SWS2 IF BINARY FILE PSYSTM 4218 SB7 10-1 PSYSTM 4219 SA7 A3+EFETCBUF CLEAR CHARACTER BUFFER V41CC05 174 V41CC10 556 ASCII IFEQ ASCFLAG,1 V41CC10 557 BX6 X6-X6 V41CC10 558 SA6 X1 ERASE DISPLAY CODE BUFFER V41CC10 559 ASCII ENDIF V41CC10 560 V41CC10 561 MX3 2 PSYSTM 4221 SX1 A7 FWA CHARACTER BUFFER PSYSTM 4222 SWS1 SA7 A7+B1 PSYSTM 4223 SB7 B7-B1 PSYSTM 4224 GT B7,B0,SWS1 LOOP PSYSTM 4225 SWS2 BX6 X1+X3 SET EOLN AND REWRITE BITS IF CHARACTER FILE PSYSTM 4226 ERRNZ EFETPTR+1 FIX NEXT LINE V41CC05 175 SA6 A3-B1 SET FILE POINTER PSYSTM 4227 EQ SWSX RETURN PSYSTM 4228 P.TMS SPACE 4,15 PSYSTM 4229 ** P.TMS - TERMINATE MESSAGE STRING. PSYSTM 4230 * PSYSTM 4231 * ENSURE END OF LINE TERMINATOR ON STRING, REMOVE V41CC17 6 * TRAILING BLANKS FROM STRING. V41CC17 7 * PSYSTM 4233 * ENTRY (X1) = ADDRESS OF PACKED STRING. PSYSTM 4234 * (X2) = LENGTH OF STRING IN CHARACTERS. PSYSTM 4235 * PSYSTM 4236 * EXIT (X1) = ADDRESS OF MESSAGE IN -C- FORMAT. PSYSTM 4237 * PSYSTM 4238 * USES X - 1, 2, 3, 6, 7. V41CC17 8 * A - 1, 2, 6, 7. PSYSTM 4240 * B - 2, 7. V41CC17 9 * V41CC17 10 * CALLS P.ASD. V41CC17 11 PSYSTM 4242 PSYSTM 4243 TMS6 BX6 X1 REPLACE WORD V41CC17 12 SA6 A1 V41CC17 13 SX1 TMSA MESSAGE ADDRESS PSYSTM 4258 PSYSTM 4259 TMS ROUTINE P.TMS ENTRY/EXIT PSYSTM 4260 V41CC17 14 ASCII IFNE ASCFLAG,1 V41CC17 15 SA1 X1 FIRST WORD V41CC17 16 SB2 TMSA V41CC17 17 BX2 -X2 PSYSTM 4262 LX6 X1 PSYSTM 4263 SX7 X2+80 PSYSTM 4264 SA6 B2 STORE FIRST WORD V41CC17 18 PL X7,TMS1 IF 80 CHARACTERS OR LESS PSYSTM 4266 SX2 -80 PSYSTM 4267 TMS1 SX2 X2+10 PSYSTM 4268 PL X2,TMS2 IF WORD CONTAINING END OF STRING FOUND PSYSTM 4269 SA1 A1+1 NEXT WORD PSYSTM 4270 BX6 X1 PSYSTM 4271 SA6 A6+B1 PSYSTM 4272 EQ TMS1 LOOP PSYSTM 4273 V41CC17 19 TMS2 ZR X2,TMS3 IF STRING ENDED ON WORD BOUNDARY V41CC17 20 ERRNZ DCCHARSZ-6 FIX NEXT THREE LINES V41CC17 21 LX7 X2,B1 V41CC17 22 LX2 X7,B1 V41CC17 23 IX7 X2+X7 MULTIPLY X2 BY DCCHARSZ V41CC17 24 MX1 1 V41CC17 25 SB7 X7-59 V41CC17 26 AX1 -B7 GENERATE CHARACTER MASK V41CC17 27 BX6 X1*X6 REMOVE CHARACTERS V41CC17 28 SA2 =10H V41CC17 29 BX1 -X1*X2 V41CC17 30 BX6 X1+X6 REPLACE REMOVED CHARACTERS WITH BLANKS V41CC17 31 SA6 A6+ REPLACE LAST WORD V41CC17 32 TMS3 BX7 X7-X7 V41CC17 33 SA7 A6+B1 ENSURE ZERO WORD V41CC17 34 ASCII ELSE V41CC17 35 SX3 X2 STRING LENGTH V41CC17 36 SB7 80/DCALFALN LIMIT DISPLAY CODE STRING TO 80 CHARS V41CC17 37 SX2 TMSA ADDRESS OF DISPLAY CODE ARRAY V41CC17 38 RJ =XP.ASD CONVERT ASCII STRING TO DISPLAY CODE V41CC17 39 EQ B2,B0,TMS1 IF CONVERTED STRING ENDS ON WORD BOUNDARY V41CC17 40 SB7 B2+59 V41CC17 41 SA1 A7 RELOAD LAST WORD V41CC17 42 MX6 1 V41CC17 43 SA2 =10H V41CC17 44 AX6 B7 GENERATE CHARACTER MASK V41CC17 45 BX6 -X6*X2 V41CC17 46 BX6 X6+X1 REPLACE ZEROES WITH BLANKS V41CC17 47 SA6 A1 REPLACE WORD V41CC17 48 TMS1 BX7 X7-X7 V41CC17 49 SA7 A7+B1 GUARANTEE ZERO WORD V41CC17 50 SB2 TMSA V41CC17 51 ASCII ENDIF V41CC17 52 V41CC17 53 * DELETE TRAILING BLANKS FROM MESSAGE. V41CC17 54 V41CC17 55 SA1 A6+ GET LAST WORD V41CC17 56 MX7 2*DCCHARSZ TWO CHARACTER MASK V41CC17 57 SX2 2R V41CC17 58 LX2 -2*DCCHARSZ V41CC17 59 TMS4 ZR X1,TMS5 IF WORD EXHAUSTED V41CC17 60 LX7 2*DCCHARSZ ROTATE FOR NEXT BYTE V41CC17 61 LX2 2*DCCHARSZ V41CC17 62 BX6 X7*X1 V41CC17 63 ZR X6,TMS4 IF 00 CHARACTERS V41CC17 64 BX6 X2-X6 V41CC17 65 NZ X6,TMS6 IF NOT SPACES V41CC17 66 BX1 -X7*X1 REMOVE SPACES V41CC17 67 EQ TMS4 PROCESS NEXT BYTE V41CC17 68 V41CC17 69 TMS5 SB7 A1 V41CC17 70 GE B2,B7,TMS6 IF REACHED BEGINNING OF STRING V41CC17 71 BX6 X1 V41CC17 72 SA6 A1 V41CC17 73 SA1 A1-B1 GET NEXT WORD DOWN V41CC17 74 EQ TMS4 PROCESS NEXT BYTE V41CC17 75 PSYSTM 4274 TMSA SCRATCH 9 PSYSTM 4275 P.WWR SPACE 4,10 PSYSTM 4276 ** P.WWR - WRITE WITHOUT REWRITE. PSYSTM 4277 * PSYSTM 4278 * ENTRY (X2) = FET ADDRESS. PSYSTM 4279 * PSYSTM 4280 * EXIT TO IOE1. PSYSTM 4281 * PSYSTM 4282 * USES X - 1. PSYSTM 4283 * PSYSTM 4284 * CALLS IOE. PSYSTM 4285 PSYSTM 4286 PSYSTM 4287 WWR ENTER P.WWR ENTRY V41CC13 17 SX1 IOEC TRIED TO WRITE XXXXXXX WITHOUT REWRITE V41CC13 18 EQ IOE1 ISSUE INPUT/OUTPUT ERROR PSYSTM 4290 PSYSTM SPACE 4 PSYSTM 4291 END PSYSTM 4292 IDENT P.PMM PMM 2 SST PMM 3 SYSCOM B1 PMM 4 LIST F PMM 5 ENTRY PASPMM V41DC01 7 ENTRY P.AFL PMM 6 ENTRY P.ALM PMM 7 ENTRY P.CMR PMM 8 ENTRY P.INM PMM 9 ENTRY P.LIM PMM 10 ENTRY P.TMEM PMM 11 TITLE PASCAL-6000 MEMORY MANAGER. PMM 12 COMMENT PASCAL-6000 MEMORY MANAGER. PMM 13 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1983. PMM 14 PMM SPACE 4,10 PMM 15 *** PASCAL-6000 MEMORY MANAGER. PMM 16 * J. F. MINER. 82/07/23. 83/04/01. PMM 17 * D. E. GERMANN. 82/10/15. 83/05/05. PMM 18 HISTORY SPACE 4,10 HPMM 1 ** PASCAL-6000 MODIFICATION HISTORY. HPMM 2 * HPMM 3 * INSTALL ENTRY POINT PASPMM, AND HAVE P.INM CHECK FOR PASCMM (P.CMM). V41DC01 8 * CHANGE SYMBOL *NOS* TO *NOS1+NOS2*. V41AC01 44 * HPMM 4 PMM TITLE CONSTANT DEFINITIONS. PMM 19 ** PROGRAM CONSTANTS. PMM 20 PMM 21 MINSIZE EQU 2 MINIMUM NODE SIZE PMM 22 QUANTUM EQU 100B MEMORY ALLOCATION UNIT: MUST BE POWER OF 2 PMM 23 PMM TITLE TABLES. PMM 24 ** TMEM - TABLE OF MEMORY MANAGER VARIABLES. PMM 25 * PMM 26 * THIS TABLE CONTAINS MEMORY MANAGER VARIABLES THAT ARE PMM 27 * MAINTAINED ACROSS THE ENTIRE EXECUTION OF A PASCAL PROGRAM. PMM 28 PMM 29 PMM 30 TMEM ENTER P.TMEM TABLE OF MEMORY MANAGER VARIABLES PMM 31 LOC 0 PMM 32 PMM 33 DATA L*P.TMEM* TABLE NAME PMM 34 MEMFL BSS 1 CURRENT FIELD LENGTH PMM 35 MEMFF BSS 1 ADDRESS OF FIRST FREE NODE PMM 36 MEMLF BSS 1 ADDRESS OF LAST FREE NODE PMM 37 MEMHLF BSS 1 HIGHEST ADDRESS OF LAST FREE NODE PMM 38 MEMHFL BSS 1 HIGHEST FIELD LENGTH USED BY MEMORY MANAGER PMM 39 PMM 40 LOC *O PMM 41 PMM TITLE MEMORY MANAGER ROUTINES. PMM 42 P.ALM SPACE 4,20 PMM 43 ** P.ALM - ALLOCATE MEMORY. PMM 44 * PMM 45 * ENTRY (X1) = MINIMUM SIZE OF CHUNK TO ALLOCATE. PMM 46 * NOTE: THE ACTUAL SIZE OF THE ALLOCATED CHUNK PMM 47 * MAY EXCEED THIS SIZE. PMM 48 * (B1) = 1. PMM 49 * PMM 50 * EXIT (X6) = ADDRESS OF ALLOCATED CHUNK. PMM 51 * = ADDRESS OF NODE + 1. PMM 52 * (B7) = ACTUAL SIZE OF ALLOCATED CHUNK. PMM 53 * *TMEM* UPDATED. PMM 54 * PMM 55 * USES X - ALL. PMM 56 * A - 1, 2, 3, 4, 5, 6, 7. PMM 57 * B - 2, 3, 7. PMM 58 * PMM 59 * CALLS AFL. PMM 60 PMM 61 PMM 62 * CHANGE LF TO REFLECT SPLITTING OF LAST FREE NODE. PMM 63 * UPDATE HLF TO REFLECT NEW HIGH VALUE OF LF. PMM 64 PMM 65 ALM3 SX6 A4+B7 LF := LF + S PMM 66 SA1 TMEM+MEMHLF PREVIOUS HIGHEST LF VALUE (PHLF) PMM 67 IX2 X1-X6 PMM 68 SA6 TMEM+MEMLF UPDATE LF VALUE PMM 69 BX7 X2 PMM 70 AX7 60 PMM 71 BX7 X7*X2 PMM 72 IX7 X1-X7 MAX(PHLF, LF) PMM 73 SA7 TMEM+MEMHLF HLF := MAX(PHLF, LF) PMM 74 PMM 75 * ALLOCATE A NODE. PMM 76 * (X0) = 42-BIT MASK. PMM 77 * (B2) = M[P1].SIZE. PMM 78 * (B7) = SIZE OF NODE TO ALLOCATE. PMM 79 * (A4) = P1. PMM 80 * (X4) = M[P1]. PMM 81 * (A3) = P1+1. PMM 82 * (X3) = M[P1+1]. PMM 83 PMM 84 ALM4 SX2 B2-B7 EXCESS PMM 85 SX5 X2-MINSIZE PMM 86 MX7 1 PMM 87 PL X5,ALM5 IF ENOUGH TO SPLIT PMM 88 PMM 89 * USE ALL OF NODE P1. PMM 90 PMM 91 SX6 X3 M[P1+1].NEXTFREE PMM 92 LX3 -18 PMM 93 SX7 X3 M[P1+1].PREVFREE PMM 94 LX3 18 PMM 95 EQ ALM6 PMM 96 PMM 97 * SPLIT NODE P1. PMM 98 PMM 99 ALM5 SB3 A4+B7 P3 := P1 + S PMM 100 SA5 A4+B2 M[NEXT(P1)] PMM 101 LX5 -18 PMM 102 BX5 X0*X5 PMM 103 SX6 B3 PMM 104 BX6 X5+X6 PMM 105 LX6 18 PMM 106 SA6 A5 M[NEXT(P1)].PREV := P3 PMM 107 BX7 X7+X2 PMM 108 SX2 A4 PMM 109 LX2 18 PMM 110 BX7 X7+X2 PMM 111 SA7 B3 M[P3] := (TRUE,0,P1,EXCESS) PMM 112 BX4 X0*X4 PMM 113 SX6 B7 PMM 114 BX4 X4+X6 M[P1].SIZE := S PMM 115 BX6 X3 PMM 116 SA6 B3+B1 M[P3+1] := M[P1+1] PMM 117 SX6 B3 PMM 118 SX7 B3 PMM 119 PMM 120 * FIX UP FREELIST. PMM 121 PMM 122 ALM6 SA2 X3+B1 M[M[P1+1].NEXTFREE+1] PMM 123 LX3 -18 PMM 124 LX2 -18 PMM 125 SA5 X3+B1 M[M[P1+1].PREVFREE+1] PMM 126 BX2 X0*X2 PMM 127 BX7 X2+X7 PMM 128 BX5 X0*X5 PMM 129 LX7 18 PMM 130 BX6 X5+X6 PMM 131 SA7 A2 M[M[P1+1].NEXTFREE+1].PREVFREE := P3 PMM 132 SA6 A5+ M[M[P1+1].PREVFREE+1].NEXTFREE := P3 PMM 133 MX0 -36 PMM 134 BX7 -X0*X4 FREE := FALSE; ML := 0; PMM 135 SA7 A4 SET HEADER WORD IN ALLOCATED NODE PMM 136 SX6 A4+B1 CHUNK FWA = NODE FWA + 1 PMM 137 SB7 X7-1 ACTUAL CHUNK SIZE = NODE SIZE - 1 PMM 138 PMM 139 ALM ROUTINE P.ALM ENTRY/EXIT PMM 140 PMM 141 * ENSURE MINIMAL NODE SIZE. PMM 142 PMM 143 SX1 X1+B1 NODE SIZE = CHUNK SIZE + 1 PMM 144 SX2 X1-MINSIZE PMM 145 BX3 X2+X1 PMM 146 AX3 60 PMM 147 BX2 -X3*X2 PMM 148 SB7 X2+MINSIZE MAX(REQUESTED SIZE, MINSIZE) PMM 149 PMM 150 * SEARCH FREELIST. PMM 151 PMM 152 SA3 TMEM+MEMFF PMM 153 SA5 A3+B1 LF PMM 154 ERRNZ MEMLF-MEMFF-1 FIX PREVIOUS LINE PMM 155 SA3 X3+B1 M[FF+1] PMM 156 SX7 B7 PMM 157 SA5 X5 M[LF] PMM 158 MX0 42 PMM 159 SA7 A5 M[LF] := DESIRED NODE SIZE PMM 160 ALM1 SA4 X3 M[P1] PMM 161 SA3 X3+1 PMM 162 SB2 X4 M[P1].SIZE PMM 163 LT B2,B7,ALM1 IF NODE IS TOO SMALL PMM 164 BX6 X5 PMM 165 SB3 A5 PMM 166 SA6 A5 RESTORE M[LF] PMM 167 SB3 A4-B3 P1-LF PMM 168 NZ B3,ALM4 IF P1 <> LF PMM 169 PMM 170 * ALLOCATE FROM LAST FREE NODE. PMM 171 PMM 172 SB3 X6-MINSIZE PMM 173 SB2 X6 M[LF].SIZE PMM 174 BX4 X6 FIX REGISTER COPY OF M[P1] PMM 175 GE B3,B7,ALM3 IF LAST FREE NODE IS LARGE ENOUGH PMM 176 PMM 177 * EXPAND LAST FREE NODE. PMM 178 PMM 179 SX0 B7-B3 NEED PMM 180 SB3 A4 P1 := LF PMM 181 SX7 QUANTUM-1 PMM 182 IX0 X0+X7 PMM 183 BX0 -X7*X0 MAKE NEED A MULTIPLE OF QUANTUM PMM 184 SA5 =XP.PIT+PITMFL PMM 185 SA2 TMEM+MEMFL PMM 186 IX5 X5-X2 PMM 187 IX3 X5-X0 PMM 188 NG X3,=XP.TERA+ISMERR IF MAXFL EXCEEDED (NEED > MAXFL-FL) PMM 189 SA4 =XP.PIT+PITMCS PMM 190 PL X4,=XP.TERA+ISMERR IF INCREASE NOT ALLOWED PMM 191 MX7 -18 PMM 192 BX4 -X7*X4 MINREQUEST PMM 193 IX3 X0-X4 PMM 194 IX7 X5-X4 PMM 195 PL X3,ALM2 IF NEED >= MINREQUEST PMM 196 AX7 60 PMM 197 BX5 X7*X5 PMM 198 BX4 -X7*X4 PMM 199 IX0 X5+X4 NEED := MIN(MAXFL-FL, MINREQUEST) PMM 200 ALM2 IX1 X2+X0 FL+NEED PMM 201 RJ AFL ALTER FIELD LENGTH PMM 202 NG X1,=XP.TERA+ISMERR IF REQUEST COULD NOT BE SATISFIED PMM 203 SX3 B3+B1 LF+1 PMM 204 IX3 X6-X3 FL-LF-1 PMM 205 SA2 X2-1 M[FL-NEED-1] PMM 206 BX7 X2 PMM 207 SA4 B3 M[LF] PMM 208 SA7 X6-1 M[FL-1] := M[FL-1-NEED] PMM 209 MX0 42 PMM 210 BX7 X0*X4 PMM 211 BX7 X7+X3 PMM 212 SA7 A4 M[LF].SIZE := FL-LF-1 PMM 213 SB2 X3 M[P1].SIZE PMM 214 SA3 A4+B1 M[P1+1] PMM 215 EQ ALM3 ALLOCATE NODE PMM 216 P.INM SPACE 4,25 PMM 217 ** P.INM - INITIALIZE MEMORY MANAGER. PMM 218 * PMM 219 * ENTRY (A0) = CURRENT FIELD LENGTH. PMM 220 * (B1) = 1. PMM 221 * (LWPR) = LAST WORD OF PROGRAM LOADED. PMM 222 * PMM 223 * EXIT (X1) = 0 IF NO ERRORS. PMM 224 * INITIAL DYNAMIC SPACE ALLOCATED. PMM 225 * *TMEM* INITIALIZED. PMM 226 * (X1) < 0 IF INSUFFICIENT FL FOR INITIAL DYNAMIC AREA. PMM 227 * (X1) > 0 IF CDC CMM IS PRESENT. (X1) WILL BE THE PMM 228 * ERROR MESSAGE ADDRESS. PMM 229 * (LWPR) UPDATED, BITS 0..17 = MFL. PMM 230 * PMM 231 * USES X - ALL. PMM 232 * A - 1, 2, 3, 4, 6, 7. PMM 233 * B - 3. PMM 234 * PMM 235 * CALLS AFL. PMM 236 * PMM 237 * MACROS GETFLC, MEMORY. PMM 238 PMM 239 PMM 240 * RETURN ERROR MESSAGE ADDRESS IF CMM PRESENT. PMM 241 PMM 242 INM2 SX1 INMC * PMM/CMM CONFLICT, CMM ACTIVE.* V41DC01 9 EQ INMX RETURN V41DC01 10 V41DC01 11 INM3 SX1 INMD * PMM/CMM CONFLICT, P.CMM ALSO LOADED. * V41DC01 12 PMM 244 INM ROUTINE P.INM ENTRY/EXIT PMM 245 SX6 =YPASCMM V41DC01 13 PL X6,INM3 IF P.CMM LOADED V41DC01 14 SA3 LWPR PMM 246 SA1 =XP.PIT+PITIDS PMM 247 MX4 -18 PMM 248 SX0 X3 PMM 249 AX1 30 PMM 250 BX6 X6-X6 PMM 251 BX1 -X4*X1 SIZE OF INITIAL DYNAMIC AREA PMM 252 NG X0,INM2 IF CMM PRESENT PMM 253 IX5 X0+X1 LWA+1 OF DYNAMIC MEMORY PMM 254 SA6 TMEM+MEMHFL HFL := 0 PMM 255 MEMORY CM,INMA,R GET MAXIMUM FIELD LENGTH (MFL) SETTING PMM 256 SA1 INMA PMM 257 SA2 =XP.PIT+PITMFL PMM 258 AX1 30 JOB MFL SETTING PMM 259 BX2 -X4*X2 USER-SELECTED MFL SETTING PMM 260 IX7 X1-X2 PMM 261 BX3 X7 PMM 262 AX7 60 PMM 263 BX4 X7*X3 PMM 264 IX6 X2+X4 MFL := MIN(USER MFL, JOB MFL) PMM 265 IX1 X6-X5 PMM 266 NG X1,INMX IF LAST ADDRESS > MFL PMM 267 SA1 =XP.PIT+PITIDS CHECK INITIAL REDUCE FLAG PMM 268 SA3 LWPR PMM 269 MX4 42 PMM 270 BX7 X4*X3 PMM 271 BX7 X6+X7 PMM 272 SA7 A3 UPDATE LWPR WITH MFL PMM 273 SA6 A2+ SET MFL IN PROGRAM INFORMATION TABLE PMM 274 NG X1,INM1 IF INITIAL REDUCE SELECTED PMM 275 PMM 276 * SET LAST ADDRESS OF MANAGED MEMORY TO MAX(RFL,LOADER-SET FL) PMM 277 * IF GREATER THAN REQUESTED LAST ADDRESS. IF THIS VALUE WILL PMM 278 * BE GREATER THAN THE MFL VALUE, SET LAST ADDRESS TO MFL PMM 279 * VALUE. PMM 280 PMM 281 NOS IFNE KRONOS+NOS1+NOS2,0 V41AC01 45 GETFLC INMB GET FIELD LENGTH CONTROL WORD PMM 283 SA1 INMB PMM 284 SX2 A0+ LOADER-SET FIELD LENGTH PMM 285 LX1 -36 PMM 286 MX7 -12 PMM 287 BX1 -X7*X1 *LCFL* FIELD OF FIELD LENGTH CONTROL WORD PMM 288 LX1 6 CURRENT RFL SETTING PMM 289 IX2 X1-X2 PMM 290 BX6 X2 PMM 291 AX6 60 PMM 292 BX6 X6*X2 PMM 293 IX6 X1-X6 MAX(RFL, LOAD FL) PMM 294 NOS ENDIF PMM 295 PMM 296 NOSBE IFNE NOSBE+SCOPE2+SCOPE34,0 PMM 297 SX6 A0 LOADER-SET FIELD LENGTH PMM 298 NOSBE ENDIF PMM 299 PMM 300 IX3 X5-X6 PMM 301 PL X3,INM1 IF LAST ADDRESS >= MAX(RFL, LOAD FL) PMM 302 SA4 =XP.PIT+PITMFL MAXIMUM FIELD LENGTH PMM 303 IX7 X6-X4 PMM 304 BX2 X7 PMM 305 AX7 60 PMM 306 BX3 X7*X2 PMM 307 IX5 X4+X3 LAST ADDR := MIN(MAX(RFL, LOAD FL), MFL) PMM 308 INM1 BX1 X5 PMM 309 RJ AFL ALTER FIELD LENGTH PMM 310 NG X1,INMX IF MEMORY COULD NOT BE ALLOCATED PMM 311 SX7 X0+3 PMM 312 BX5 X6 ACTUAL LWA+1 OF DYNAMIC MEMORY PMM 313 BX6 X0 PMM 314 SA7 TMEM+MEMLF LF := LOW+3 PMM 315 BX3 X7 PMM 316 SA6 A7-B1 FF := LOW PMM 317 ERRNZ MEMFF-MEMLF+1 FIX PREVIOUS LINE PMM 318 SB3 18 PMM 319 SA7 A7+B1 HLF := LF PMM 320 ERRNZ MEMHLF-MEMLF-1 FIX PREVIOUS LINE PMM 321 MX1 1 PMM 322 SX2 B1+B1 PMM 323 BX7 X1+X2 PMM 324 SA7 X6 M[FF] := (TRUE,0,0,2) PMM 325 BX0 X6 PMM 326 LX4 X3,B3 PMM 327 BX6 X3+X4 PMM 328 SA6 A7+B1 M[FF+1] := (LF,LF) PMM 329 SX2 B1 PMM 330 LX4 X0,B3 PMM 331 BX7 X4+X2 PMM 332 SA7 A6+B1 M[FF+2] := (FALSE,0,FF,1) PMM 333 IX6 X5-X3 FL-LF PMM 334 SX4 A7 FF+2 PMM 335 IX6 X6-X2 FL-LF-1 PMM 336 LX4 18 PMM 337 BX6 X1+X6 PMM 338 BX6 X6+X4 PMM 339 SA6 A7+B1 M[LF] := (TRUE,0,FF+2,FL-LF-1) PMM 340 LX7 X0,B3 PMM 341 BX7 X7+X0 PMM 342 LX6 X3,B3 PMM 343 SA7 A6+B1 M[LF+1] := (FF,FF) PMM 344 BX6 X6+X2 PMM 345 SA6 X5-1 M[FL-1] := (FALSE,0,LF,1) PMM 346 BX1 X1-X1 SET NORMAL EXIT CONDITION PMM 347 EQ INMX RETURN PMM 348 PMM 349 INMA VFD 30/-1,30/0 MEMORY REQUEST FOR MAXIMUM FIELD LENGTH PMM 350 PMM 351 NOS IFNE KRONOS+NOS1+NOS2,0 V41AC01 46 INMB BSS 1 FIELD LENGTH CONTROL WORD PMM 353 NOS ENDIF PMM 354 PMM 355 INMC DATA C* PMM/CMM CONFLICT, CMM ACTIVE.* V41DC01 15 INMD DATA C* PMM/CMM CONFLICT, P.CMM ALSO LOADED. * V41DC01 16 P.LIM SPACE 4,15 PMM 357 ** P.LIM - LIBERATE MEMORY. PMM 358 * PMM 359 * ENTRY (X1) = ADDRESS OF CHUNK TO LIBERATE. PMM 360 * = ADDRESS OF NODE + 1. PMM 361 * (B1) = 1. PMM 362 * PMM 363 * EXIT CHUNK LIBERATED. PMM 364 * ADJACENT FREE NODES ARE COMBINED. PMM 365 * FL REDUCED IF APPROPRIATE. PMM 366 * *TMEM* UPDATED. PMM 367 * PMM 368 * USES X - ALL. PMM 369 * A - 1, 2, 3, 4, 5, 6, 7. PMM 370 * B - 2, 3, 7. PMM 371 * PMM 372 * CALLS CMR. PMM 373 PMM 374 PMM 375 * NEITHER NEXT NOR PREVIOUS NODE IS FREE. PMM 376 * SEARCH FREELIST FOR PLACE TO INSERT. PMM 377 PMM 378 LIM4 SA2 TMEM+MEMFF PMM 379 SB3 X2+ P1 := FF PMM 380 LIM5 SA3 B3+B1 PMM 381 SB3 X3 P1 := M[P1+1].NEXTFREE PMM 382 LT B3,B2,LIM5 IF P1 < P PMM 383 SB7 A3-B1 P1 PMM 384 PMM 385 * B7 = P1, B3 = P2 = M[P1+1].NEXTFREE. PMM 386 PMM 387 SX6 B7 PMM 388 SX7 B3 PMM 389 LX6 18 PMM 390 BX7 X6+X7 PMM 391 SA7 B2+B1 M[P+1] := (P1,P2) PMM 392 SA2 B7+B1 PMM 393 BX2 X0*X2 PMM 394 BX6 X2+X1 PMM 395 SA6 A2 M[P1+1].NEXTFREE := P PMM 396 SA3 B3+B1 PMM 397 LX0 18 PMM 398 LX1 18 PMM 399 BX3 X0*X3 PMM 400 BX7 X3+X1 PMM 401 SA7 A3 M[P2+1].PREVFREE := P PMM 402 SA1 B2 PMM 403 MX0 1 PMM 404 BX6 X0+X1 PMM 405 SA6 A1 M[P].FREE := TRUE PMM 406 PMM 407 LIM ROUTINE P.LIM ENTRY/EXIT PMM 408 SX1 X1-1 NODE FWA = CHUNK FWA - 1 PMM 409 PMM 410 * CHECK POINTER FOR VALIDITY. PMM 411 PMM 412 SA2 TMEM+MEMFF ADDRESS OF FIRST FREE NODE PMM 413 SA3 A2+B1 ADDRESS OF LAST FREE NODE PMM 414 ERRNZ MEMLF-MEMFF-1 FIX PREVIOUS LINE PMM 415 IX4 X2-X1 PMM 416 IX5 X1-X3 PMM 417 BX4 X5*X4 PMM 418 PL X4,=XP.TERA+ICNERR IF NODE NOT IN MANAGED MEMORY PMM 419 SB2 X1 PMM 420 SA5 X1 M[P] PMM 421 SB3 X5 M[P].SIZE PMM 422 SB3 X1+B3 P2 := NEXT(P) PMM 423 AX5 18 PMM 424 SX7 B2-B3 P - P2 PMM 425 SB7 X5 P1 := M[P].PREV PMM 426 SX6 B7-B2 P1 - P PMM 427 SX0 B3 PMM 428 SX4 B7 PMM 429 BX7 X6*X7 P1 < P < P2 PMM 430 IX0 X3-X0 LF - P2 PMM 431 IX4 X2-X4 FF - P PMM 432 BX7 -X0*X7 P1 < P < P2 <= LF PMM 433 BX7 X4*X7 FF < P1 < P < P2 <= LF PMM 434 PL X7,=XP.TERA+ICNERR IF POINTERS NOT IN PROPER ORDER PMM 435 MX0 -18 PMM 436 SA3 B3 M[P2] PMM 437 LX3 -18 PMM 438 SA2 B7 M[P1] PMM 439 BX6 -X0*X3 M[P2].PREV PMM 440 SB2 X2+ M[P1].SIZE PMM 441 BX6 X1-X6 PMM 442 SX7 B7+B2 NEXT(P1) PMM 443 BX4 X1-X7 PMM 444 BX6 X6+X4 PMM 445 NZ X6,=XP.TERA+ICNERR IF NODE NOT CONSISTENT PMM 446 NG X5,=XP.TERA+ICNERR IF NODE ALREADY FREE PMM 447 PMM 448 * CHECK NEXT NODE FOR FREEDOM. PMM 449 PMM 450 SB2 X1 P PMM 451 LX3 18 PMM 452 PL X3,LIM3 IF NODE P2 NOT FREE PMM 453 PL X2,LIM1 IF NODE P1 NOT FREE PMM 454 SA4 B3+B1 M[P2+1] PMM 455 SA2 B7+B1 M[P1+1] PMM 456 BX4 -X0*X4 PMM 457 BX2 X0*X2 PMM 458 BX6 X2+X4 PMM 459 SA6 A2 M[P1+1].NEXTFREE := M[P2+1].NEXTFREE PMM 460 SB2 B7 P := P1 PMM 461 SX1 B7 P := P1 PMM 462 EQ LIM2 PMM 463 PMM 464 LIM1 SA2 B3+B1 M[P2+1] PMM 465 BX6 X2 PMM 466 SA6 B2+B1 M[P+1] := M[P2+1] PMM 467 AX2 18 M[P2+1].PREVFREE PMM 468 SA4 X2+B1 M[M[P2+1].PREVFREE+1] PMM 469 SX7 B2 PMM 470 BX4 X0*X4 PMM 471 BX7 X4+X7 PMM 472 SA7 A4+ M[M[P2+1].PREVFREE+1].NEXTFREE := P PMM 473 SA3 B2+ PMM 474 MX6 1 PMM 475 BX6 X6+X3 PMM 476 SA6 A3+ M[P].FREE := TRUE PMM 477 LIM2 SA2 B3 PMM 478 SX2 B3+X2 NEXT(P2) PMM 479 IX7 X2-X1 NEXT(P2) - P PMM 480 SA3 B2 M[P] PMM 481 BX3 X0*X3 PMM 482 BX7 X3+X7 PMM 483 SA7 A3 M[P].SIZE := NEXT(P2) - P PMM 484 SA4 B3+B1 M[P2+1] PMM 485 SA5 X4+B1 M[M[P2+1].NEXTFREE+1] PMM 486 LX5 -18 PMM 487 BX5 X0*X5 PMM 488 BX6 X5+X1 PMM 489 LX6 18 PMM 490 SA6 A5 M[M[P2+1].NEXTFREE+1].PREVFREE := P PMM 491 SA4 X2 M[NEXT(P2)] PMM 492 LX4 -18 PMM 493 BX4 X0*X4 PMM 494 BX7 X4+X1 PMM 495 LX7 18 PMM 496 SA7 A4 M[NEXT(P2)].PREV := P PMM 497 SA3 TMEM+MEMLF PMM 498 SB7 X3+ LF PMM 499 NE B3,B7,LIMX IF P2 <> LF PMM 500 BX7 X1 PMM 501 SA7 A3 LF := P PMM 502 RJ CMR CHECK FOR MEMORY REDUCTION PMM 503 EQ LIMX RETURN PMM 504 PMM 505 * CHECK PREVIOUS NODE FOR FREEDOM. PMM 506 PMM 507 LIM3 PL X2,LIM4 IF NODE P1 NOT FREE PMM 508 SX6 B3-B7 P2 - P1 PMM 509 BX1 X0*X2 PMM 510 BX6 X1+X6 PMM 511 SA6 A2 M[P1].SIZE := P2 - P1 PMM 512 LX3 -18 PMM 513 SX7 B7 PMM 514 BX2 X0*X3 PMM 515 BX7 X2+X7 PMM 516 LX7 18 PMM 517 SA7 A3 M[P2].PREV := P1 PMM 518 EQ LIMX RETURN PMM 519 PMM TITLE SUBROUTINES. PMM 520 P.AFL SPACE 4,15 PMM 521 ** P.AFL - ALTER FIELD LENGTH. PMM 522 * PMM 523 * ENTRY (X1) = DESIRED FIELD LENGTH. PMM 524 * (B1) = 1. PMM 525 * PMM 526 * EXIT (X1) < 0 IF REQUEST NOT SATISFIED. PMM 527 * (X2) = OLD FIELD LENGTH. PMM 528 * (X6) = NEW FIELD LENGTH. PMM 529 * (TMEM+MEMFL) = NEW FIELD LENGTH. PMM 530 * (TMEM+MEMHFL) UPDATED. PMM 531 * DAYFILE MESSAGE ISSUED IF MZ+ SET IN PMM 532 * P.PIT+PITFLAG. PMM 533 * PMM 534 * USES X - 1, 2, 6, 7. PMM 535 * A - 1, 2, 6. PMM 536 * PMM 537 * MACROS MEMORY. PMM 538 PMM 539 PMM 540 AFL ROUTINE P.AFL ENTRY/EXIT PMM 541 BX6 X1 PMM 542 SX7 X1+ PMM 543 LX6 30 PMM 544 SA6 AFLA FORM STATUS WORD PMM 545 SA1 =XP.PIT+PITFLAG PMM 546 LX1 59-56 POSITION MZ-OPTION BIT PMM 547 PL X1,AFL2 IF MZ- PMM 548 PMM 549 * ISSUE DAYFILE MESSAGE. PMM 550 PMM 551 MX2 6 DIGIT COUNT PMM 552 BX6 X6-X6 CLEAR ASSEMBLY PMM 553 AFL1 MX1 -3 PMM 554 LX2 1 PMM 555 BX1 -X1*X7 EXTRACT THREE BITS PMM 556 LX7 -3 PMM 557 SX1 X1+1R0 FORM OCTAL DIGIT PMM 558 BX6 X6+X1 INSERT DIGIT IN ASSEMBLY PMM 559 LX6 -6 ADJUST ASSEMBLY PMM 560 NG X2,AFL1 IF MORE DIGITS PMM 561 SA1 AFLB+3 PMM 562 MX2 -4*6 PMM 563 LX7 6*3 RESTORE X7 PMM 564 BX1 -X2*X1 REMOVE *XXXXXX* PMM 565 BX6 X6+X1 INSERT ASSEMBLY INTO MESSAGE PMM 566 SA6 A1 PMM 567 PMM 568 NOS IFNE KRONOS+NOS1+NOS2+SCOPE2,0 V41AC01 47 MESSAGE AFLB,"IMSG" PMM 570 NOS ENDIF PMM 571 PMM 572 NOSBE IFNE NOSBE+SCOPE34,0 PMM 573 MESSAGE AFLB,"IMSG",R PMM 574 NOSBE ENDIF PMM 575 PMM 576 AFL2 BSS PMM 577 PMM 578 * REQUEST MEMORY AND RETURN STATUS. PMM 579 PMM 580 MEMORY CM,AFLA,R,,NA REQUEST MEMORY PMM 581 SA1 AFLA CHECK STATUS WORD PMM 582 SA2 TMEM+MEMHFL PREVIOUS HIGH FIELD LENGTH (PHFL) PMM 583 AX1 30 FIELD LENGTH ALLOCATED (FL) PMM 584 IX2 X1-X2 PMM 585 BX6 X2 PMM 586 AX6 60 PMM 587 BX6 X6*X2 PMM 588 IX6 X1-X6 PMM 589 SA6 A2 HFL := MAX(PHFL, FL) PMM 590 BX6 X1 PMM 591 SA2 TMEM+MEMFL OLD FIELD LENGTH PMM 592 SA6 A2 UPDATE FIELD LENGTH PMM 593 IX1 X1-X7 NEGATIVE IF REQUEST COULD NOT BE SATISFIED PMM 594 EQ AFLX RETURN PMM 595 PMM 596 AFLA BSS 1 STATUS WORD FOR MEMORY REQUEST PMM 597 AFLB DATA C* REQUESTING FL CHANGE TO XXXXXXB.* PMM 598 P.CMR SPACE 4,15 PMM 599 ** P.CMR - CHECK FOR MEMORY REDUCTION. PMM 600 * PMM 601 * ENTRY (X0) = 42-BIT MASK. PMM 602 * (X7) = LF. PMM 603 * (B1) = 1. PMM 604 * PMM 605 * EXIT FL REDUCED IF APPROPRIATE. PMM 606 * (TMEM+MEMFL) = NEW FL. PMM 607 * PMM 608 * USES X - 1, 2, 3, 4, 6, 7. PMM 609 * A - 1, 3, 4, 6. PMM 610 * PMM 611 * CALLS AFL. PMM 612 PMM 613 PMM 614 CMR ROUTINE P.CMR ENTRY/EXIT PMM 615 SA3 =XP.PIT+PITMCS PMM 616 LX3 30 PMM 617 BX1 -X0*X3 MINREDUCE PMM 618 PL X3,CMRX IF REDUCE NOT ALLOWED PMM 619 SA4 TMEM+MEMFL PMM 620 SX6 X4-3 PMM 621 IX6 X6-X7 FL-LF-3 PMM 622 ERRNZ QUANTUM-100B FIX CODE BELOW TO MOD BY QUANTUM PMM 623 MX2 -6 PMM 624 BX3 -X2*X6 RESIDUE := (FL-LF-3) MOD QUANTUM PMM 625 IX2 X6-X3 REDUCTION := (FL-LF-3) - RESIDUE PMM 626 IX6 X2-X1 PMM 627 NG X6,CMRX IF REDUCTION < MINREDUCE PMM 628 SA1 X7 PMM 629 BX1 X0*X1 PMM 630 SX7 X3+2 PMM 631 BX7 X1+X7 PMM 632 SA7 A1 M[LF].SIZE := RESIDUE+2 PMM 633 IX1 X4-X2 FL-REDUCTION PMM 634 SA4 X4-1 PMM 635 BX6 X4 PMM 636 SA6 X1-1 M[FL-REDUCTION-1] := M[FL-1] PMM 637 RJ AFL ALTER FIELD LENGTH PMM 638 EQ CMRX RETURN PMM 639 PASPMM SPACE 4,10 V41DC01 17 ** PASPMM - DUMMY ENTRY POINT. V41DC01 18 V41DC01 19 V41DC01 20 PASPMM SUBR ENTRY/EXIT V41DC01 21 EQ PASPMMX RETURN V41DC01 22 PMM SPACE 4,10 PMM 640 END PMM 641 IDENT P.CMM CMM 2 SST CMM 3 SYSCOM B1 CMM 4 LIST F CMM 5 ENTRY PASCMM CMM 6 ENTRY P..ALM CMM 7 ENTRY P..INM CMM 8 ENTRY P..LIM CMM 9 ENTRY P..MND CMM 10 ENTRY P..MNW CMM 11 ENTRY P..MRK CMM 12 ENTRY P..RLS CMM 13 ENTRY P..TMEM CMM 14 TITLE PASCAL-6000 CMM INTERFACE. CMM 15 COMMENT PASCAL-6000 CMM INTERFACE. CMM 16 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1985. CMM 17 PASCMM SPACE 4,10 CMM 18 *** PASCAL-6000 PMM/CMM INTERFACE. CMM 19 * CMM 20 * J. F. MINER. 1985-02-19. CMM 21 HISTORY SPACE 4,10 HCMM 1 ** PASCAL-6000 MODIFICATION HISTORY. HCMM 2 * HCMM 3 * HCMM 4 PASCMM TITLE LOADER DIRECTIVES. CMM 22 ** LOADER DIRECTIVES. CMM 23 CMM 24 LDSET SUBST=P.ALM-P..ALM CMM 25 LDSET SUBST=P.INM-P..INM CMM 26 LDSET SUBST=P.LIM-P..LIM CMM 27 LDSET SUBST=P.MND-P..MND CMM 28 LDSET SUBST=P.MNW-P..MNW CMM 29 LDSET SUBST=P.MRK-P..MRK CMM 30 LDSET SUBST=P.RLS-P..RLS CMM 31 LDSET SUBST=P.TMEM-P..TMEM CMM 32 PASCMM TITLE DATA, CONSTANTS. CMM 33 ** PROGRAM VARIABLES. CMM 34 CMM 35 CMM 36 ML DATA 0 CURRENT MARK LEVEL CMM 37 CMM 38 DATA 0 ALWAYS ZERO; TOP OF STACK WHEN (ML) = 0 CMM 39 MS BSS MARKLIM STACK OF GROUP-ID VALUES CMM 40 P.TMEM SPACE 4,5 CMM 41 ** TMEM - TABLE OF MEMORY MANAGER VARIABLES. CMM 42 * CMM 43 * THIS TABLE CONTAINS MEMORY MANAGER VARIABLES THAT ARE CMM 44 * MAINTAINED ACROSS THE ENTIRE EXECUTION OF A PASCAL PROGRAM. CMM 45 CMM 46 CMM 47 TMEM ENTER P..TMEM TABLE OF MEMORY MANAGER VARIABLES CMM 48 LOC 0 CMM 49 CMM 50 DATA L*P.TMEM* TABLE NAME CMM 51 MEMFL BSSZ 1 CURRENT FIELD LENGTH CMM 52 MEMFF BSSZ 1 ADDRESS OF FIRST FREE NODE (NOT USED) CMM 53 MEMLF BSSZ 1 ADDRESS OF LAST FREE NODE (NOT USED) CMM 54 MEMHLF BSSZ 1 HIGHEST ADDRESS OF LAST FREE NODE CMM 55 MEMHFL BSSZ 1 HIGHEST FIELD LENGTH USED BY MEMORY MANAGER CMM 56 CMM 57 LOC *O CMM 58 PASCMM TITLE PMM ROUTINES. CMM 59 P..ALM SPACE 4,15 CMM 60 ** P..ALM - ALLOCATE MEMORY. CMM 61 * CMM 62 * ENTRY (X1) = MINIMUM SIZE OF CHUNK TO ALLOCATE. CMM 63 * CMM 64 * EXIT (X6) = ADDRESS OF ALLOCATED CHUNK. CMM 65 * (B7) = ACTUAL SIZE OF ALLOCATED CHUNK. CMM 66 * CMM 67 * USES X - 1, 2, 3, 5, 6. CMM 68 * B - 7. CMM 69 * CMM 70 * CALLS CFL, CMM.ALF, P.RPE, P.SPE. CMM 71 CMM 72 CMM 73 ALM ROUTINE P..ALM ENTRY/EXIT CMM 74 SX2 X1 CHUNK SIZE CMM 75 SX5 X1 SAVE CHUNK SIZE CMM 76 RJ =XP.SPE SAVE PASCAL ENVIRONMENT CMM 77 BX3 X3-X3 ZERO GROUP-ID AND SIZE-CODE CMM 78 RJ =XCMM.ALF ALLOCATE FIXED BLOCK CMM 79 SB7 X5 CHUNK SIZE CMM 80 RJ =XP.RPE RESTORE PASCAL ENVIRONMENT CMM 81 BX6 X1 CHUNK FWA CMM 82 RJ CFL CHECK CHANGE IN FL CMM 83 EQ ALMX RETURN CMM 84 P..INM SPACE 4,15 CMM 85 ** P..INM - INITIALIZE MEMORY MANAGER. CMM 86 * CMM 87 * ENTRY (A0) = CURRENT FIELD LENGTH. CMM 88 * (LWPR) = LAST WORD OF PROGRAM LOADED. CMM 89 * CMM 90 * EXIT (X1) = 0 IF NO CONFLICTS EXIST. CMM 91 * (X1) = ADDRESS OF ERROR MESSAGE IF CMM 92 * THERE IS A CONFLICT WITH PMM OR AHM. CMM 93 * *TMEM* UPDATED. CMM 94 * CMM 95 * USES X - 0, 1, 6. CMM 96 * A - 6. CMM 97 * CMM 98 * CALLS P.SABRT. CMM 99 CMM 100 CMM 101 INM ROUTINE P..INM ENTRY/EXIT CMM 102 SX6 A0+ FL CMM 103 SA6 TMEM+MEMFL FL CMM 104 SA6 TMEM+MEMHFL HIGHEST FL CMM 105 SA6 TMEM+MEMHLF HIGHEST LAST FREE NODE (DUMMY) CMM 106 SX1 INMA * PMM/CMM CONFLICT, P.PMM ALSO LOADED. * CMM 107 SX6 =YPASPMM CMM 108 PL X6,INMX IF P.PMM LOADED CMM 109 SX1 INMB * PMM/CMM CONFLICT, P.AHM ALSO LOADED. * CMM 110 SX6 =YPASAHM CMM 111 PL X6,INMX IF P.AHM LOADED CMM 112 BX1 X1-X1 ZERO ERROR CODE CMM 113 EQ INMX RETURN CMM 114 CMM 115 INMA DATA C* PMM/CMM CONFLICT, P.PMM ALSO LOADED. * CMM 116 INMB DATA C* PMM/CMM CONFLICT, P.AHM ALSO LOADED. * CMM 117 P..LIM SPACE 4,10 CMM 118 ** P..LIM - LIBERATE MEMORY. CMM 119 * CMM 120 * ENTRY (X1) = ADDRESS OF CHUNK TO LIBERATE. CMM 121 * CMM 122 * EXIT CHUNK LIBERATED. CMM 123 * CMM 124 * CALLS CFL, CMM.FRF, P.RPE, P.SPE. CMM 125 CMM 126 CMM 127 LIM ROUTINE P..LIM ENTRY/EXIT CMM 128 RJ =XP.SPE SAVE PASCAL ENVIRONMENT CMM 129 RJ =XCMM.FRF FREE FIXED-POSITION BLOCK CMM 130 RJ =XP.RPE RESTORE PASCAL ENVIRONMENT CMM 131 RJ CFL CHECK FOR CHANGE IN FL CMM 132 EQ LIMX RETURN CMM 133 PASCMM TITLE AHM ROUTINES. CMM 134 P..MND SPACE 4,10 CMM 135 ** P..MND - ALLOCATE CHECKED MARKED HEAP STORAGE. CMM 136 * CMM 137 * ENTRY (X1) = SIZE OF CHUNK TO ALLOCATE. CMM 138 * (INCLUDES SPACE FOR POINTER KEY WORD.) CMM 139 * CMM 140 * EXIT (X6) = KEY AND POINTER (SEE P.SPK). CMM 141 * CMM 142 * CALLS MNW, P.SPK. CMM 143 CMM 144 CMM 145 MND ROUTINE P..MND ENTRY/EXIT CMM 146 RJ MNW ALLOCATE MARKED HEAP STORAGE CMM 147 RJ =XP.SPK SET POINTER KEY CMM 148 EQ MNDX RETURN CMM 149 P..MNW SPACE 4,10 CMM 150 ** P..MNW - ALLOCATE MARKED HEAP STORAGE. CMM 151 * CMM 152 * ENTRY (X1) = SIZE OF CHUNK TO ALLOCATE. CMM 153 * CMM 154 * EXIT (X6) = ADDRESS OF ALLOCATED CHUNK. CMM 155 * CMM 156 * USES X - 2, 3, 5, 6. CMM 157 * A - 3. CMM 158 * CMM 159 * CALLS CFL, CMM.ALF, P.RPE, P.SPE. CMM 160 CMM 161 CMM 162 MNW ROUTINE P..MNW ENTRY/EXIT CMM 163 SX2 X1 CHUNK SIZE CMM 164 SX5 X1 SAVE CHUNK SIZE CMM 165 RJ =XP.SPE SAVE PASCAL ENVIRONMENT CMM 166 SA3 ML CMM 167 SA3 MS-1+X3 GROUP-ID FROM TOP OF STACK CMM 168 LX3 12-0 POSITION GROUP-ID FOR CMM CMM 169 RJ =XCMM.ALF ALLOCATE FIXED BLOCK CMM 170 RJ =XP.RPE RESTORE PASCAL ENVIRONMENT CMM 171 BX6 X1 FWA OF CHUNK CMM 172 RJ CFL CHECK FOR CHANGE IN FL CMM 173 EQ MNWX RETURN CMM 174 P..MRK SPACE 4,15 CMM 175 ** P..MRK - START NEW MARK LEVEL. CMM 176 * CMM 177 * ENTRY (X1) = ADDRESS OF MARKER VARIABLE. CMM 178 * (B1) = 1. CMM 179 * (ML) = CURRENT MARK LEVEL. CMM 180 * CMM 181 * EXIT OLD MARK LEVEL STORED INTO MARKER VARIABLE. CMM 182 * (ML) INCREASED BY ONE TO NEW MARK LEVEL. CMM 183 * CMM 184 * USES X - 1, 2, 3, 6, 7. CMM 185 * A - 1, 2, 6, 7. CMM 186 * CMM 187 * CALLS CFL, CMM.AGR, P.RPE, P.SABRT, P.SPE. CMM 188 CMM 189 CMM 190 MRK ROUTINE P..MRK ENTRY/EXIT CMM 191 SA2 ML CURRENT MARK LEVEL CMM 192 BX6 X2 CMM 193 SX7 X2+B1 ML := ML + 1 CMM 194 SX3 X2-MARKLIM CMM 195 ZR X3,MRK1 IF ALREADY AT MAXIMUM MARK LEVEL CMM 196 SA6 X1 STORE MARK LEVEL INTO MARKER VARIABLE CMM 197 SA7 A2 UPDATE MARK LEVEL TO NEW VALUE CMM 198 RJ =XP.SPE SAVE PASCAL ENVIRONMENT CMM 199 BX1 X1-X1 ZERO GROUP-TYPE CMM 200 RJ =XCMM.AGR ACTIVATE BLOCK GROUP CMM 201 SA1 ML MARK LEVEL CMM 202 BX6 X2 GROUP-ID CMM 203 SA6 MS-1+X1 PUSH GROUP-ID ONTO STACK CMM 204 RJ =XP.RPE RESTORE PASCAL ENVIRONMENT CMM 205 RJ CFL CHECK FOR CHANGE IN FL CMM 206 EQ MRKX RETURN CMM 207 CMM 208 MRK1 SX0 MRKA MAXIMUM MARK LEVEL EXCEEDED CMM 209 EQ =XP.SABRT ABORT CMM 210 CMM 211 MRKA DATA C* MAXIMUM MARK LEVEL EXCEEDED. * CMM 212 P..RLS SPACE 4,15 CMM 213 ** P..RLS - RELEASE MARKED NODES AND RESET MARK LEVEL. CMM 214 * CMM 215 * ENTRY (X1) = DML (DESTINATION MARK LEVEL). CMM 216 * CMM 217 * EXIT ALL NODES WITH MARK LEVEL GREATER THAN DML RELEASED. CMM 218 * MARK LEVEL SET TO DML. CMM 219 * CMM 220 * USES X - 0, 1, 2, 3, 5, 6. CMM 221 * A - 1, 2. CMM 222 * CMM 223 * CALLS CFL, CMM.FGR, P.RPE, P.SABRT, P.SPE. CMM 224 CMM 225 CMM 226 RLS ROUTINE P..RLS ENTRY/EXIT CMM 227 SA2 ML MARK LEVEL CMM 228 SX0 RLSA INCORRECT VALUE PASSED TO RELEASE CMM 229 BX5 X1 SAVE DML CMM 230 IX3 X1-X2 CMM 231 BX3 -X3+X1 CMM 232 NG X3,=XP.SABRT IF NOT DML IN [0..ML-1] CMM 233 RJ =XP.SPE SAVE PASCAL ENVIRONMENT CMM 234 RLS1 SA1 ML CMM 235 SX6 X1-1 CMM 236 IX2 X5-X1 CMM 237 PL X2,RLS2 IF ML = DML CMM 238 SA6 A1 ML := ML - 1 CMM 239 SA1 MS-1+X1 POP GROUP-ID FROM STACK CMM 240 RJ =XCMM.FGR FREE BLOCK GROUP CMM 241 EQ RLS1 CMM 242 CMM 243 RLS2 RJ =XP.RPE RESTORE PASCAL ENVIRONMENT CMM 244 RJ CFL CHECK FOR CHANGE IN FL CMM 245 EQ RLSX RETURN CMM 246 CMM 247 RLSA DATA C* INCORRECT VALUE PASSED TO RELEASE. * CMM 248 PASCMM TITLE SUBROUTINES. CMM 249 PASCMM SPACE 4,10 CMM 250 ** PASCMM - DUMMY ROUTINE FOR PASCMM ENTRY POINT. CMM 251 CMM 252 CMM 253 PASCMM SUBR ENTRY/EXIT CMM 254 EQ PASCMMX RETURN CMM 255 CFL SPACE 4,10 CMM 256 ** CFL - CHECK FIELD-LENGTH CHANGE. CMM 257 * CMM 258 * EXIT *TMEM* UPDATED. CMM 259 * (X6) PRESERVED. CMM 260 * (B7) PRESERVED. CMM 261 * CMM 262 * USES X - 1, 2, 7. CMM 263 * A - 1, 2, 7. CMM 264 * B - 2. CMM 265 CMM 266 CMM 267 CFL SUBR ENTRY/EXIT CMM 268 SA1 LWPR CMM 269 SA2 TMEM+MEMHFL HIGHEST FIELD LENGTH CMM 270 SB2 X1 DABA OR -DABA CMM 271 PL B2,CFLX IF CMM NOT ACTIVE CMM 272 SA1 -B2 CMM 273 SX7 X1 FL CMM 274 IX1 X2-X7 CMM 275 SA7 TMEM+MEMFL UPDATE CURRENT FL CMM 276 PL X1,CFLX IF FL <= HFL CMM 277 SA7 TMEM+MEMHFL UPDATE HIGHEST FL CMM 278 SA7 TMEM+MEMHLF UPDATE HIGHEST LAST FREE (DUMMY) CMM 279 EQ CFLX CMM 280 PASCMM SPACE 4 CMM 281 END CMM 282 IDENT P.REC REC 2 SST REC 3 SYSCOM B1 REC 4 LIST F REC 5 ENTRY P.DER REC 6 ENTRY P.EER REC 7 TITLE PASCAL-6000 REPRIEVE INTERFACE. REC 8 COMMENT PASCAL-6000 REPRIEVE INTERFACE. REC 9 COMMENT COPYRIGHT (C) UNIVERSITY OF MINNESOTA - 1983. REC 10 REC SPACE 4,10 REC 11 *** PASCAL-6000 REPRIEVE INTERFACE. REC 12 * ADAPTED FROM PSYSTM BY REC 13 * JIM MINER. 1983-12-15, 1984-01-23. REC 14 * DAVE BIANCHI. 1984-01-03, 1984-02-08. REC 15 HISTORY SPACE 4,10 HREC 1 ** PASCAL-6000 MODIFICATION HISTORY. HREC 2 * HREC 3 * FIX ERROR: INITIALIZE MESSAGE TERMINATOR USED AT REC.246. V41EC03 6 * CHANGE SYMBOL *NOS* TO *NOS1+NOS2*. V41AC01 48 * HREC 4 REC SPACE 4,10 REC 16 *** PASCAL-6000 REPRIEVE INTERFACE. REC 17 * REC 18 * THIS PACKAGE, WHEN INITIALIZED BY A CALL TO P.EER, REC 19 * PROCESSES ERRORS DETECTED BY THE SYSTEM AND TRANSFERS REC 20 * TO P.SABRT WITH AN APPROPRIATE ERROR MESSAGE. REC 21 * REC 22 * UNDER NOS 1, NOS 2, NOS/BE, AND SCOPE 3.4, THIS PACKAGE USES V41AC01 49 * THE *RECOVR* MACRO IN ORDER TO ALLOW ERROR RECOVERY BY OTHER V41AC01 50 * PACKAGES IN THE SAME PROGRAM. REC 25 REC TITLE MACROS AND MICROS. REC 26 ** MACROS. REC 27 ERRMSG SPACE 4,10 REC 28 ** ERRMSG - BUILD ERROR MESSAGE TABLE ENTRY. REC 29 * REC 30 * ENTER ERROR MESSAGE INTO ERROR MESSAGE TABLE (TERM). REC 31 * REC 32 * TAG ERRMSG NUMBER,TEXT REC 33 * REC 34 * ENTRY *TEXT* = ERROR MESSAGE TEXT. REC 35 * *NUMBER* = ERROR MESSAGE ORDINAL; REC 36 * THE FIRST ORDINAL IS 1. REC 37 * IF NOT PRESENT, THE TABLE IS REC 38 * TERMINATED. REC 39 * *TAG* = OPTIONAL LABEL, EQUIVALENCED REC 40 * TO LOCATION OF *TEXT*. REC 41 * REC 42 * EXIT ERROR MESSAGE ENTERED IN TABLE. REC 43 * ERRMSGMX = HIGHEST ORDINAL FOUND SO FAR. REC 44 * TERMMX = MAXIMUM ORDINAL AFTER TABLE REC 45 * HAS BEEN TERMINATED. REC 46 REC 47 REC 48 PURGMAC ERRMSG REC 49 REC 50 MACRO ERRMSG,L,N,T REC 51 .A IF -DEF,ERRMSGMX REC 52 ERRMSGMX SET 0 REC 53 .A ENDIF REC 54 .A IFC NE,/N// REC 55 .B IF DEF,N REC 56 .C IFLT ERRMSGMX,N REC 57 .D IFLT ERRMSGMX,N-1 REC 58 ORG TERM+2*ERRMSGMX REC 59 DUP N-ERRMSGMX-1 REC 60 ERRMSGMX SET ERRMSGMX+1 REC 61 .1 OCTMIC ERRMSGMX,2 REC 62 DATA 20H UNKNOWN ERROR (".1"B) REC 63 ENDD REC 64 .D ENDIF REC 65 ERRMSGMX SET N REC 66 .C ENDIF REC 67 ORG TERM+2*N-2 REC 68 .C IFC NE,/L// REC 69 L EQU * REC 70 .C ENDIF REC 71 LOC N REC 72 DATA 20H T. REC 73 LOC *O REC 74 .B ENDIF REC 75 .A ELSE REC 76 ORG TERM+2*ERRMSGMX REC 77 TERMMX EQU ERRMSGMX REC 78 .B IFC NE,/L// REC 79 L EQU * REC 80 .B ENDIF REC 81 .A ENDIF REC 82 ENDM REC 83 TERM TITLE ERROR MESSAGE TABLE. REC 84 TERM SPACE 2,5 REC 85 ** TERM - TABLE OF ERROR MESSAGES. REC 86 * REC 87 * TERM CONTAINS MESSAGES USED BY KRONOS, NOS 1, NOS 2, NOS/BE, V41AC01 51 * AND SCOPE 3.4. THE MESSAGES ARE IN ORDER OF THE ERROR CODE V41AC01 52 * ORDINALS. EACH MESSAGE IS TWO WORDS LONG, AND REQUIRES A V41AC01 53 * ZERO-WORD TERMINATOR TO BE ADDED BEFORE USE. V41AC01 54 REC 92 REC 93 TERM BSS 0 REC 94 REC 95 NOS IFNE NOS1+NOS2+NOSBE+SCOPE34,0 V41AC01 55 ERRMSG 01B,(TIME LIMIT) REC 97 TERMA ERRMSG 02B,(CPU ERROR EXIT 0) REC 98 ERRMSG 03B,(PP ABORT) REC 99 ERRMSG 04B,(CP ABORT) REC 100 ERRMSG 05B,(PP CALL ERROR) REC 101 ERRMSG 06B,(OPERATOR DROP) REC 102 ERRMSG 07B,(OPERATOR KILL) REC 103 ERRMSG 10B,(OPERATOR RERUN) REC 104 ERRMSG 11B,(CONTROL STMT ERR) REC 105 ERRMSG 12B,(ECS PARITY ERROR) REC 106 ERRMSG 15B,(AUTO-RECALL ERROR) REC 107 ERRMSG 16B,(HUNG IN AUTO-RCL) REC 108 ERRMSG 17B,(MS LIMIT) REC 109 ERRMSG 20B,(PP NAME ERROR) REC 110 ERRMSG 21B,(I/O TIME LIMIT) REC 111 NOS ENDIF REC 112 REC 113 KRONOS IFNE KRONOS,0 REC 114 TERMA ERRMSG ARET,(CPU ERROR EXIT 0) REC 115 ERRMSG PSET,(PROGRAM STOP) REC 116 ERRMSG PPET,(PPU ABORT) REC 117 ERRMSG ITET,(SCP INVALID TR-AD) REC 118 ERRMSG CPET,(CPU ABORT) REC 119 ERRMSG PCET,(PP CALL ERROR) REC 120 ERRMSG TLET,(TIME LIMIT) REC 121 ERRMSG FLET,(LOCAL FILE LIMIT) REC 122 ERRMSG TKET,(TRACK LIMIT) REC 123 ERRMSG SRET,(SRU LIMIT) REC 124 ERRMSG FSET,(FORCED ERROR) REC 125 ERRMSG ODET,(OPERATOR DROP) REC 126 ERRMSG RRET,(OPERATOR RERUN) REC 127 ERRMSG OKET,(OPERATOR KILL) REC 128 ERRMSG SSET,(SUBSYSTEM ABORT) REC 129 ERRMSG ECET,(ECS PARITY ERROR) REC 130 ERRMSG PEET,(CPU PARITY ERROR) REC 131 ERRMSG SYET,(SYSTEM ABORT) REC 132 ERRMSG ORET,(OPERATOR OVERRIDE) REC 133 KRONOS ENDIF REC 134 REC 135 ERRMSG END OF TABLE REC 136 REC TITLE ROUTINES. REC 137 P.DER SPACE 4,15 REC 138 ** P.DER - DISABLE ERROR RECOVERY. REC 139 * REC 140 * EXIT ERROR REPRIEVE (ENABLED BY P.EER) IS DISABLED. REC 141 * A0, B4, B5, AND B6 UNCHANGED. REC 142 * (B1) = 1. REC 143 * REC 144 * USES ALL REGISTERS. REC 145 * REC 146 * CALLS P.RPE, P.SPE. REC 147 * REC 148 * MACROS EREXIT, RECOVR, REPRIEVE. REC 149 REC 150 REC 151 DER ROUTINE P.DER ENTRY/EXIT REC 152 REC 153 NOS IFNE NOS1+NOS2+NOSBE+SCOPE34,0 V41AC01 56 RJ =XP.SPE SAVE PASCAL ENVIRONMENT REC 155 RECOVR HRE,0,0 REC 156 RJ =XP.RPE RESTORE PASCAL ENVIRONMENT REC 157 NOS ENDIF REC 158 REC 159 KRONOS IFNE KRONOS,0 REC 160 EREXIT 0 REC 161 KRONOS ENDIF REC 162 REC 163 SCOPE2 IFNE SCOPE2,0 REC 164 REPRIEVE DERA REC 165 SCOPE2 ENDIF REC 166 REC 167 EQ DERX RETURN REC 168 REC 169 SCOPE2 IFNE SCOPE2,0 REC 170 DERA CON 0 REC 171 SCOPE2 ENDIF REC 172 P.EER SPACE 4,15 REC 173 ** P.EER - ENABLE ERROR RECOVERY. REC 174 * REC 175 * EXIT REPRIEVE PROCESSING STARTED. REC 176 * A0, B4, B5, AND B6 UNCHANGED. REC 177 * (B1) = 1. REC 178 * REC 179 * USES ALL REGISTERS. REC 180 * REC 181 * CALLS P.RPE, P.SPE. REC 182 * REC 183 * MACROS EREXIT, RECOVR, REPRIEVE. REC 184 REC 185 REC 186 EER ROUTINE P.EER ENTRY/EXIT REC 187 REC 188 NOS IFNE NOS1+NOS2+NOSBE+SCOPE34,0 V41AC01 57 RJ =XP.SPE SAVE PASCAL ENVIRONMENT REC 190 RECOVR HRE,37B,HRELWA REC 191 RJ =XP.RPE RESTORE PASCAL ENVIRONMENT REC 192 NOS ENDIF REC 193 REC 194 KRONOS IFNE KRONOS,0 REC 195 EREXIT HRE REC 196 KRONOS ENDIF REC 197 REC 198 SCOPE2 IFNE SCOPE2,0 REC 199 REPRIEVE HRE REC 200 SCOPE2 ENDIF REC 201 REC 202 EQ EERX RETURN REC 203 HRE SPACE 4,20 REC 204 ** HRE - HANDLE REPRIEVED ERROR. REC 205 * REC 206 *(NOS) ENTRY (X1) = ADDRESS OF EXCHANGE PACKAGE. REC 207 * IF MODE ERROR (ERROR CODE = 2) THEN REC 208 * (0) = 6/, 6/M, 18/A, 6/E, 24/ REC 209 * E = ERROR FLAG. REC 210 * M = CPU ERROR EXIT MODE. REC 211 * A = ERROR ADDRESS. REC 212 * REC 213 * EXIT TO P.SABRT REC 214 * (X0) = MESSAGE ADDRESS. REC 215 * (A0) RESTORED FROM EXCHANGE PACKAGE. REC 216 * (B1) = 1. REC 217 * (B5) RESTORED FROM EXCHANGE PACKAGE. REC 218 * B4 AND B6 INDETERMINATE. REC 219 * REC 220 * USES ALL REGISTERS. REC 221 * REC 222 * CALLS P.CAD, P.END, P.SABRT, P.RPE. REC 223 REC 224 REC 225 NOS IFNE NOS1+NOS2+NOSBE+SCOPE34,0 V41AC01 58 HRE SUBR REC 227 SB1 1 RESTORE B1 REC 228 SA3 X1+5 REC 229 SA2 X1 GET ERROR CODE, A0, AND P-REGISTER REC 230 SB5 X3 RESTORE B5 REC 231 BX1 X2 REC 232 AX1 18 REC 233 SX0 B0+ REC 234 SA0 X1 RESTORE A0 REC 235 SX2 X2 ERROR CODE REC 236 AX1 18 POSITION P-REGISTER REC 237 SX4 TERMMX MAXIMUM VALID ERROR CODE REC 238 IX4 X4-X2 REC 239 BX4 X2+X4 REC 240 SX0 HREE SYSTEM ERROR, INVALID ERROR CODE REC 241 MX6 0 V41EC03 7 NG X4,HRE2 IF CODE LT 0 OR CODE GT MAX REC 242 LX0 B1,X2 REC 243 SX3 X2-2 REC 244 SX0 X0+TERM-2 MESSAGE ADDRESS REC 245 SA6 X0+2 MESSAGE TERMINATOR REC 246 ZR X2,HRE1 IF CPU ERROR EXIT REC 247 NZ X3,HRE2 IF NOT CPU ERROR EXIT REC 248 REC 249 HRE1 SA1 B0 FETCH RA REC 250 BX2 X1 REC 251 AX1 30 POSITION ERROR ADDRESS REC 252 LX2 59-50 POSITION INDEFINITE STATUS BIT REC 253 LX3 B1,X2 POSITION INFINITE STATUS BIT REC 254 LX4 B1,X3 POSITION ADDRESS OUT OF RANGE STATUS BIT REC 255 SX0 HREC EXPRESSION OVERFLOW/UNDERFLOW REC 256 NG X3,HRE2 REC 257 SX0 HREB UNDEFINED VALUE IN EXPRESSION REC 258 NG X2,HRE2 REC 259 SX0 HREA ADDRESS OUT OF RANGE REC 260 NG X4,HRE2 REC 261 SX0 TERMA CPU ERROR EXIT 0 REC 262 HRE2 BSS 0 REC 263 NOS ENDIF REC 264 REC 265 NOSBE IFNE NOSBE+SCOPE34,0 REC 266 SA3 =XP.PIT+PITFLAG REC 267 LX3 1 REC 268 SA5 B1+B1 FIRST LOW-CORE FILE POINTER REC 269 PL X3,HRE4 IF NO EXTERNAL FILES PRESENT REC 270 SX2 X5 FET ADDRESS REC 271 SX6 B1 COMPLETE BIT REC 272 HRE3 SA3 X2 FETCH FIRST WORD OF FET REC 273 SA5 A5+B1 FETCH NEXT LOW-CORE FILE POINTER REC 274 BX7 X3+X6 SET FET COMPLETE REC 275 SA7 A3 REC 276 SX2 X5 FET ADDRESS REC 277 NZ X5,HRE3 IF MORE FILES TO PROCESS REC 278 HRE4 BSS 0 REC 279 NOSBE ENDIF REC 280 REC 281 KRONOS IFNE KRONOS,0 REC 282 HRE SB1 1 RESTORE B1 REC 283 SA1 B0 FETCH RA REC 284 MX5 -6 REC 285 AX1 24 REC 286 BX2 -X5*X1 EXTRACT ERROR FLAG REC 287 BX6 X6-X6 REC 288 AX1 6 POSITION TO ERROR ADDRESS REC 289 SX4 TERMMX MAXIMUM VALID ERROR CODE REC 290 IX4 X4-X2 REC 291 BX4 X4+X2 REC 292 SX0 HREE SYSTEM ERROR, INVALID ERROR FLAG REC 293 NG X4,HRE2 IF CODE LT 0 OR CODE GT MAX REC 294 LX0 B1,X2 REC 295 SX3 X2-ARET CHECK CPU ERROR EXIT REC 296 SX0 X0+TERM-2 MESSAGE ADDRESS REC 297 SA6 X0+2 MESSAGE TERMINATOR REC 298 ZR X2,HRE1 IF CPU ERROR EXIT REC 299 NZ X3,HRE2 IF NOT CPU ERROR EXIT REC 300 HRE1 BX2 X1 REC 301 LX2 59-20 POSITION INDEFINITE STATUS BIT REC 302 LX3 B1,X2 POSITION INFINITE STATUS BIT REC 303 LX4 B1,X3 POSITION ADDRESS OUT OF RANGE STATUS BIT REC 304 SX0 HREC EXPRESSION OVERFLOW/UNDERFLOW REC 305 NG X3,HRE2 REC 306 SX0 HREB UNDEFINED VALUE IN EXPRESSION REC 307 NG X2,HRE2 REC 308 SX0 HREA ADDRESS OUT OF RANGE REC 309 NG X4,HRE2 REC 310 SX0 TERMA CPU ERROR EXIT 0 REC 311 HRE2 BSS 0 REC 312 KRONOS ENDIF REC 313 REC 314 SCOPE2 IFNE SCOPE2,0 REC 315 HRE VFD 30/HRELWA,30/77470054B REC 316 BSSZ 20B REST OF EXCHANGE PACKAGE REC 317 SB1 1 RESTORE B1 REC 318 SA2 HRE REC 319 SX2 X2 BPA FIELD REC 320 ZR X2,HRE2 PROCESS PSD CONDITION REC 321 SX1 B1 REC 322 SX2 X2-1 REC 323 ZR X2,HRE1 TIME LIMIT REC 324 SX1 X1+B1 REC 325 SX2 X2-4+1 REC 326 ZR X2,HRE1 JS/USER ABORT REC 327 SX1 X1+B1 REC 328 SX2 X2-6+4 REC 329 ZR X2,HRE1 OPERATOR DROP REC 330 SX1 X1+B1 REC 331 SX2 X2-10B+6 REC 332 ZR X2,HRE1 RERUN REC 333 SX1 X1+B1 REC 334 SX2 X2-11B+10B REC 335 ZR X2,HRE1 ABORT TO EXIT(S) REC 336 SX1 X1+B1 REC 337 SX2 X2-17B+11B REC 338 ZR X2,HRE1 MS LIMIT REC 339 SX1 X1+B1 REC 340 SX2 X2-21B+17B REC 341 ZR X2,HRE1 LCM LIMIT REC 342 SX0 HREE SYSTEM ERROR, INVALID ERROR CODE REC 343 EQ HRE6 UNKNOWN ERROR REC 344 HRE1 LX0 B1,X1 REC 345 SX0 X0+HREF-2 REC 346 EQ HRE6 REC 347 REC 348 HRE2 SA1 HRE+3 PROCESS PSD CONDITION REC 349 SX0 B1 REC 350 LX1 59-47 CONDITION FLAGS TO TOP REC 351 MX2 9 REC 352 BX4 X2*X1 REC 353 LX1 9 POSITION INDEFINITE PSD BIT REC 354 LX2 X1,B1 POSITION OVERFLOW PSD BIT REC 355 LX3 X2,B1 POSITION UNDERFLOW PSD BIT REC 356 ZR X4,HRE4 IF NOT PARITY,RANGE,BP, OR STEP REC 357 HRE3 NG X4,HRE5 IF BIT SET REC 358 SX0 X0+B1 REC 359 LX1 1 NEXT BIT REC 360 EQ HRE3 REC 361 REC 362 HRE4 SX0 HREB UNDEFINED VALUE IN EXPRESSION REC 363 NG X1,HRE6 REC 364 SX0 HREC EXPRESSION OVERFLOW/UNDERFLOW REC 365 NG X2,HRE6 REC 366 NG X3,HRE6 REC 367 EQ =XP.END NORMAL TERMINATION REC 368 REC 369 HRE5 LX0 B1,X0 REC 370 SX0 X0+HREG-2 REC 371 HRE6 SA1 HRE REC 372 LX1 24 REC 373 SX1 X1 ERROR ADDRESS REC 374 SCOPE2 ENDIF REC 375 REC 376 SA5 =XP.GLOBL+TGVRFORT CHECK FORTRAN CALL FLAG REC 377 PL X5,=XP.SABRT IF NOT FTN CALL REC 378 RJ =XP.RPE RESTORE PASCAL ENVIRONMENT REC 379 RJ =XP.CAD CONVERT ADDRESS TO DISPLAY REC 380 SX3 HRED * AT XXXXXXB IN FORTRAN PROC.* REC 381 MX2 -6*6 REC 382 SA4 X3 REC 383 LX3 30 REC 384 BX4 X2*X4 REMOVE XXXXXX REC 385 IX0 X0+X3 SET BOTH MESSAGES REC 386 BX6 -X2*X6 REMOVE BLANKS REC 387 IX7 X4+X6 REC 388 SA7 A4 REC 389 EQ =XP.SABRT EXIT TO COMMON ERROR ROUTINE REC 390 REC 391 REC 392 SCOPE2 IFNE SCOPE2,1 V41AC01 59 HREA DATA C* ADDRESS OUT OF RANGE.* REC 394 SCOPE2 ENDIF V41AC01 60 REC 396 HREB DATA C* UNDEFINED VALUE IN EXPRESSION. * REC 397 HREC DATA C* EXPRESSION OVERFLOW/UNDERFLOW. * REC 398 HRED DATA C* AT XXXXXXB IN FORTRAN PROC.* REC 399 REC 400 SCOPE2 IFNE SCOPE2,1 V41AC01 61 HREE DATA C* SYSTEM ERROR, INVALID ERROR CODE.* REC 402 SCOPE2 ENDIF V41AC01 62 REC 404 KRONOS IFNE KRONOS,0 REC 405 HREE DATA C* SYSTEM ERROR, INVALID ERROR FLAG.* REC 406 KRONOS ENDIF REC 407 REC 408 SCOPE2 IFNE SCOPE2,0 REC 409 HREF DATA C* TIME LIMIT. * REC 410 DATA C* JS/USER ABORT. * REC 411 DATA C* OPERATOR DROP. * REC 412 DATA C* RERUN. * REC 413 DATA C* ABORT TO EXIT(S).* REC 414 DATA C* MS LIMIT. * REC 415 DATA C* LCM LIMIT. * REC 416 REC 417 HREG DATA C* LCM PARITY. * REC 418 DATA C* SCM PARITY. * REC 419 DATA C* LCM BLOCK RANGE. * REC 420 DATA C* SCM BLOCK RANGE. * REC 421 DATA C* LCM ADDRESS ERROR* REC 422 DATA C* SCM ADDRESS ERROR* REC 423 DATA C* PROGRAM RANGE. * REC 424 DATA C* SYSTEM ERROR. * REC 425 DATA C* SYSTEM ERROR. * REC 426 SCOPE2 ENDIF REC 427 HRE SPACE 4 REC 428 ** HRELWA - END OF CHECKSUM AREA FOR REPRIEVE. REC 429 REC 430 REC 431 HRELWA EQU *-1 LWA OF ERROR HANDLER FOR CHECKSUM REC 432 REC 433 END REC 434