![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to spitv35.tok CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / spitbol|
Return to spitv35.tok CVS log | Up to [Research Unix] / researchv10dc / cmd / spitbol |
1.1 ! root 1: {{TTL{S{{{P I T B O L - REVISION HISTORY ! 2: {{EJC{{{{ ! 3: * R E V I S I O N H I S T O R Y ! 4: * ------------------------------- ! 5: * ! 6: * ! 7: * VERSION 3.5B (FEB 81... - SGD PATCHES) ! 8: * ----------------------------------- ! 9: * ! 10: * SGD03 - ADDITION OF .CNCI AND SYSCI (INT->STRING ! 11: * SYSTEM ROUTINE OPTION) ! 12: * SGD04 - (06-MAY-1981) MODIFIED INILN TO 132 ! 13: * SGD05 - (13-MAY-1981) INSERTED MISSING WTB AFTER SYSMM ! 14: * CALLS ! 15: * SGD06 - (25-MAY-1981) MERGED IN PROFILER PATCHES ! 16: * (NOT MARKED) ! 17: * SGD07 - (25-MAY-1981) MUCHO PATCHES TO PROFILER (MARKED, ! 18: * BUT BEST JUST TO EXTRACT ENMASSE) ! 19: * SGD08 - (25-MAY-1981) USE STRING LENGTH IN HASHS ! 20: * SGD09 - (25-MAY-1981) FIXED SERIOUS PARSER PROBLEM ! 21: * RELATING TO (X Y) ON LINE BEING VIEWED AS PATTERN ! 22: * MATCH. FIXED BY ADDITION OF NEW CMTYP VALUE ! 23: * C$CNP (CONCATENATION - NOT PATTERN MATCH) ! 24: * SGD10 - (01-AUG-1981) FIXED EXIT(N) RESPECIFICATION CODE ! 25: * TO PROPERLY OBSERVE HEADER SEMANTICS ON RETURN. ! 26: * SGD11 - (07-AUG-1981) BYPASS PRTPG CALL AT INITIALIZATION ! 27: * FOLLOWING COMPILATION IF NO OUTPUT GENERATED. ! 28: * THIS PREVENTS OUTPUT FILES CONSISTING OF THE ! 29: * HEADERS AND A FEW BLANK LINES WHEN THERE IS NO ! 30: * SOURCE LISTING AND NO COMPILATION STATS. ! 31: * ALSO FIX TIMSX INITIALIZATION IN SAME CODE. ! 32: * SGD12 - (17-AUG-1981) B$EFC CODE DID NOT CHECK FOR ! 33: * UNCONVERTED RESULT RETURNING NULL STRING. FIXED. ! 34: * SGDBF - ( NOV-1981) ADDED BUFFER TYPE AND SYMBOL CNBF ! 35: * SGD13 - (03-MAR-1982) LOAD PFVBL FIELD IN RETRN FOR ! 36: * RETURN TRACING. THIS WAS CAUSING BUG ON RETURN ! 37: * TRACES THAT TRIED TO ACCESS THE VARIABLE NAME ! 38: * SGD14 - ADDED CHAR FUNCTION. CHAR(N) RETURNS NTH ! 39: * CHARACTER OF HOST MACHINE CHARACTER SET. ! 40: * NOT CONDITIONALIZED OR MARKED. ! 41: * SGD15 - FIXED PROBLEM RELATING TO COMPILATION OF GOTO ! 42: * FIELDS CONTAINING SMALL INTEGERS (IN CONST SEC). ! 43: * ! 44: * REG01 - (XX-AUG-82) ! 45: * ADDED CFP$U TO EASE TRANSLATION ON SMALLER ! 46: * SYSTEMS - CONDITIONAL .CUCF ! 47: * ADDED LOWER CASE SUPPORT - CONDITIONAL .CULC ! 48: * ADDED SET I/O FUNCTION - CONDITIONAL .CUST ! 49: * ! 50: * REG02 - (XX-SEP-82) ! 51: * CHANGED INILN AND AND INILS TO 258 ! 52: * ! 53: * REG03 - (XX-OCT-82) ! 54: * CONDITIONALIZED THE PAGE EJECT AFTER CALL TO SYSBX ! 55: * AND ADDED ANOTHER BEFORE CALL TO SYSBX, SO THAT, ! 56: * IF DESIRED BY THE IMPLEMENTOR, STANDARD OUTPUT ! 57: * WILL REFLECT ASSIGNMENTS MADE BY EXECUTING PROGRAM ! 58: * ONLY. CONDITIONAL .CUEJ CONTROLS - IF DEFINED ! 59: * EJECT IS BEFORE CALL TO SYSBX. ! 60: * ! 61: * REG04 - (XX-NOV-82) ! 62: * FIXED DIFFICULTIES WITH LISTINGS DURING EXECUTION ! 63: * WHEN NO LISTING GENERATED DURING COMPILATION. ! 64: * ! 65: * -LIST TO CODE() CAUSED BOMB. FIX IS TO RESET ! 66: * R$TTL AND R$STL TO NULLS NOT 0 AFTER COMPILATION. ! 67: * (LISTR AND LISTT EXPECT NULLS) ! 68: * ! 69: * WHEN LISTING AND STATISTICS ROUTED TO DIFFERENT ! 70: * FILE THAN EXECUTION OUTPUT, ERROR MESSAGE IS SENT ! 71: * TO EXECUTION OUTPUT (AND GETS SEPARATED FROM ! 72: * ... IN STATEMENT ... MSG). LABO1 CALLS SYSAX AND ! 73: * STOPR DOES NOT CALL SYSAX IF ENTERED FROM LABO1. ! 74: * ! 75: * REG05 - (XX-NOV-82) ! 76: * PREVENT CLEAR() FROM CLOBBERING PROTECTED VARIABLES ! 77: * AT LABEL SCLR5. ! 78: * ! 79: * REG06 - (XX-NOV-82) ! 80: * FIXED GTEXP FROM ACCEPTING TRAILING SEMICOLON OR ! 81: * COLON. NOT LEGAL WAY TO END AN EXPRESSION. ! 82: * ! 83: * VERSION 3.5A (OCT 79 - SGD PATCHES) ! 84: * ----------------------------------- ! 85: * ! 86: * SGD01 - PATCH IN ASIGN TO FIX MULTIPLE TRAP BLOCK PROBLEM ! 87: * (ASG10+2) ! 88: * SGD02 - PATCH IN GTARR TO FIX NULL CONVERT (GTAR9+0) ! 89: * ! 90: {{TTL{S{{{P I T B O L -- BASIC INFORMATION ! 91: {{EJC{{{{ ! 92: * ! 93: * GENERAL STRUCTURE ! 94: * ----------------- ! 95: * ! 96: * THIS PROGRAM IS A TRANSLATOR FOR A VERSION OF THE SNOBOL4 ! 97: * PROGRAMMING LANGUAGE. LANGUAGE DETAILS ARE CONTAINED IN ! 98: * THE MANUAL MACRO SPITBOL BY DEWAR AND MCCANN, TECHNICAL ! 99: * REPORT 90, UNIVERSITY OF LEEDS 1976. THE LANGUAGE ! 100: * IS IDENTICAL TO THAT IMPLEMENTED BY THE BTL TRANSLATOR ! 101: * (R. E. GRISWOLD ET AL.) WITH THE FOLLOWING EXCEPTIONS. ! 102: * ! 103: * 1) REDEFINITION OF STANDARD SYSTEM FUNCTIONS AND ! 104: * OPERATORS IS NOT PERMITTED. ! 105: * ! 106: * 2) THE VALUE FUNCTION IS NOT PROVIDED. ! 107: * ! 108: * 3) ACCESS TRACING IS PROVIDED IN ADDITION TO THE ! 109: * OTHER STANDARD TRACE MODES. ! 110: * ! 111: * 4) THE KEYWORD STFCOUNT IS NOT PROVIDED. ! 112: * ! 113: * 5) THE KEYWORD FULLSCAN IS NOT PROVIDED AND ALL PATTERN ! 114: * MATCHING TAKES PLACE IN FULLSCAN MODE (I.E. WITH NO ! 115: * HEURISTICS APPLIED). ! 116: * ! 117: * 6) A SERIES OF EXPRESSIONS SEPARATED BY COMMAS MAY ! 118: * BE GROUPED WITHIN PARENTHESES TO PROVIDE A SELECTION ! 119: * CAPABILITY. THE SEMANTICS ARE THAT THE SELECTION ! 120: * ASSUMES THE VALUE OF THE FIRST EXPRESSION WITHIN IT ! 121: * WHICH SUCCEEDS AS THEY ARE EVALUATED FROM THE LEFT. ! 122: * IF NO EXPRESSION SUCCEEDS THE ENTIRE STATEMENT FAILS ! 123: * ! 124: * 7) AN EXPLICIT PATTERN MATCHING OPERATOR IS PROVIDED. ! 125: * THIS IS THE BINARY QUERY (SEE GIMPEL SIGPLAN OCT 74) ! 126: * ! 127: * 8) THE ASSIGNMENT OPERATOR IS INTRODUCED AS IN THE ! 128: * GIMPEL REFERENCE. ! 129: * ! 130: * 9) THE EXIT FUNCTION IS PROVIDED FOR GENERATING LOAD ! 131: * MODULES - CF. GIMPELS SITBOL. ! 132: * ! 133: * ! 134: * THE METHOD USED IN THIS PROGRAM IS TO TRANSLATE THE ! 135: * SOURCE CODE INTO AN INTERNAL PSEUDO-CODE (SEE FOLLOWING ! 136: * SECTION). AN INTERPRETOR IS THEN USED TO EXECUTE THIS ! 137: * GENERATED PSEUDO-CODE. THE NATURE OF THE SNOBOL4 LANGUAGE ! 138: * IS SUCH THAT THE LATTER TASK IS MUCH MORE COMPLEX THAN ! 139: * THE ACTUAL TRANSLATION PHASE. ACCORDINGLY, NEARLY ALL THE ! 140: * CODE IN THE PROGRAM SECTION IS CONCERNED WITH THE ACTUAL ! 141: * EXECUTION OF THE SNOBOL4 PROGRAM. ! 142: {{EJC{{{{ ! 143: * ! 144: * INTERPRETIVE CODE FORMAT ! 145: * ------------------------ ! 146: * ! 147: * THE INTERPRETIVE PSEUDO-CODE CONSISTS OF A SERIES OF ! 148: * ADDRESS POINTERS. THE EXACT FORMAT OF THE CODE IS ! 149: * DESCRIBED IN CONNECTION WITH THE CDBLK FORMAT. THE ! 150: * PURPOSE OF THIS SECTION IS TO GIVE GENERAL INSIGHT INTO ! 151: * THE INTERPRETIVE APPROACH INVOLVED. ! 152: * ! 153: * THE BASIC FORM OF THE CODE IS RELATED TO REVERSE POLISH. ! 154: * IN OTHER WORDS, THE OPERANDS PRECEDE THE OPERATORS WHICH ! 155: * ARE ZERO ADDRESS OPERATORS. THERE ARE SOME EXCEPTIONS TO ! 156: * THESE RULES, NOTABLY THE UNARY NOT OPERATOR AND THE ! 157: * SELECTION CONSTRUCTION WHICH CLEARLY REQUIRE ADVANCE ! 158: * KNOWLEDGE OF THE OPERATOR INVOLVED. ! 159: * ! 160: * THE OPERANDS ARE MOVED TO THE TOP OF THE MAIN STACK AND ! 161: * THE OPERATORS ARE APPLIED TO THE TOP STACK ENTRIES. LIKE ! 162: * OTHER VERSIONS OF SPITBOL, THIS PROCESSOR DEPENDS ON ! 163: * KNOWING WHETHER OPERANDS ARE REQUIRED BY NAME OR BY VALUE ! 164: * AND MOVES THE APPROPRIATE OBJECT TO THE STACK. THUS NO ! 165: * NAME/VALUE CHECKS ARE INCLUDED IN THE OPERATOR CIRCUITS. ! 166: * ! 167: * THE ACTUAL POINTERS IN THE CODE POINT TO A BLOCK WHOSE ! 168: * FIRST WORD IS THE ADDRESS OF THE INTERPRETOR ROUTINE ! 169: * TO BE EXECUTED FOR THE CODE WORD. ! 170: * ! 171: * IN THE CASE OF OPERATORS, THE POINTER IS TO A WORD WHICH ! 172: * CONTAINS THE ADDRESS OF THE OPERATOR TO BE EXECUTED. IN ! 173: * THE CASE OF OPERANDS SUCH AS CONSTANTS, THE POINTER IS TO ! 174: * THE OPERAND ITSELF. ACCORDINGLY, ALL OPERANDS CONTAIN ! 175: * A FIELD WHICH POINTS TO THE ROUTINE TO LOAD THE VALUE OF ! 176: * THE OPERAND ONTO THE STACK. IN THE CASE OF A VARIABLE, ! 177: * THERE ARE THREE SUCH POINTERS. ONE TO LOAD THE VALUE, ! 178: * ONE TO STORE THE VALUE AND A THIRD TO JUMP TO THE LABEL. ! 179: * ! 180: * THE HANDLING OF FAILURE RETURNS DESERVES SPECIAL COMMENT. ! 181: * THE LOCATION FLPTR CONTAINS THE POINTER TO THE LOCATION ! 182: * ON THE MAIN STACK WHICH CONTAINS THE FAILURE RETURN ! 183: * WHICH IS IN THE FORM OF A BYTE OFFSET IN THE CURRENT ! 184: * CODE BLOCK (CDBLK OR EXBLK). WHEN A FAILURE OCCURS, THE ! 185: * STACK IS POPPED AS INDICATED BY THE SETTING OF FLPTR AND ! 186: * CONTROL IS PASSED TO THE APPROPRIATE LOCATION IN THE ! 187: * CURRENT CODE BLOCK WITH THE STACK POINTER POINTING TO THE ! 188: * FAILURE OFFSET ON THE STACK AND FLPTR UNCHANGED. ! 189: {{EJC{{{{ ! 190: * ! 191: * INTERNAL DATA REPRESENTATIONS ! 192: * ----------------------------- ! 193: * ! 194: * REPRESENTATION OF VALUES ! 195: * ! 196: * A VALUE IS REPRESENTED BY A POINTER TO A BLOCK WHICH ! 197: * DESCRIBES THE TYPE AND PARTICULARS OF THE DATA VALUE. ! 198: * IN GENERAL, A VARIABLE IS A LOCATION CONTAINING SUCH A ! 199: * POINTER (ALTHOUGH IN THE CASE OF TRACE ASSOCIATIONS THIS ! 200: * IS MODIFIED, SEE DESCRIPTION OF TRBLK). ! 201: * ! 202: * THE FOLLOWING IS A LIST OF POSSIBLE DATATYPES SHOWING THE ! 203: * TYPE OF BLOCK USED TO HOLD THE VALUE. THE DETAILS OF ! 204: * EACH BLOCK FORMAT ARE GIVEN LATER. ! 205: * ! 206: * DATATYPE BLOCK TYPE ! 207: * -------- ---------- ! 208: * ! 209: * ! 210: * ARRAY ARBLK OR VCBLK ! 211: * ! 212: * CODE CDBLK ! 213: * ! 214: * EXPRESSION EXBLK OR SEBLK ! 215: * ! 216: * INTEGER ICBLK ! 217: * ! 218: * NAME NMBLK ! 219: * ! 220: * PATTERN P0BLK OR P1BLK OR P2BLK ! 221: * ! 222: * REAL RCBLK ! 223: * ! 224: * STRING SCBLK ! 225: * ! 226: * TABLE TBBLK ! 227: * ! 228: * PROGRAM DATATYPE PDBLK ! 229: {{EJC{{{{ ! 230: * ! 231: * REPRESENTATION OF VARIABLES ! 232: * --------------------------- ! 233: * ! 234: * DURING THE COURSE OF EVALUATING EXPRESSIONS, IT IS ! 235: * NECESSARY TO GENERATE NAMES OF VARIABLES (FOR EXAMPLE ! 236: * ON THE LEFT SIDE OF A BINARY EQUALS OPERATOR). THESE ARE ! 237: * NOT TO BE CONFUSED WITH OBJECTS OF DATATYPE NAME WHICH ! 238: * ARE IN FACT VALUES. ! 239: * ! 240: * FROM A LOGICAL POINT OF VIEW, SUCH NAMES COULD BE SIMPLY ! 241: * REPRESENTED BY A POINTER TO THE APPROPRIATE VALUE CELL. ! 242: * HOWEVER IN THE CASE OF ARRAYS AND PROGRAM DEFINED ! 243: * DATATYPES, THIS WOULD VIOLATE THE RULE THAT THERE MUST BE ! 244: * NO POINTERS INTO THE MIDDLE OF A BLOCK IN DYNAMIC STORE. ! 245: * ACCORDINGLY, A NAME IS ALWAYS REPRESENTED BY A BASE AND ! 246: * OFFSET. THE BASE POINTS TO THE START OF THE BLOCK ! 247: * CONTAINING THE VARIABLE VALUE AND THE OFFSET IS THE ! 248: * OFFSET WITHIN THIS BLOCK IN BYTES. THUS THE ADDRESS ! 249: * OF THE ACTUAL VARIABLE IS DETERMINED BY ADDING THE BASE ! 250: * AND OFFSET VALUES. ! 251: * ! 252: * THE FOLLOWING ARE THE INSTANCES OF VARIABLES REPRESENTED ! 253: * IN THIS MANNER. ! 254: * ! 255: * 1) NATURAL VARIABLE BASE IS PTR TO VRBLK ! 256: * OFFSET IS *VRVAL ! 257: * ! 258: * 2) TABLE ELEMENT BASE IS PTR TO TEBLK ! 259: * OFFSET IS *TEVAL ! 260: * ! 261: * 3) ARRAY ELEMENT BASE IS PTR TO ARBLK ! 262: * OFFSET IS OFFSET TO ELEMENT ! 263: * ! 264: * 4) VECTOR ELEMENT BASE IS PTR TO VCBLK ! 265: * OFFSET IS OFFSET TO ELEMENT ! 266: * ! 267: * 5) PROG DEF DTP BASE IS PTR TO PDBLK ! 268: * OFFSET IS OFFSET TO FIELD VALUE ! 269: * ! 270: * IN ADDITION THERE ARE TWO CASES OF OBJECTS WHICH ARE ! 271: * LIKE VARIABLES BUT CANNOT BE HANDLED IN THIS MANNER. ! 272: * THESE ARE CALLED PSEUDO-VARIABLES AND ARE REPRESENTED ! 273: * WITH A SPECIAL BASE POINTER AS FOLLOWS= ! 274: * ! 275: * EXPRESSION VARIABLE PTR TO EVBLK (SEE EVBLK) ! 276: * ! 277: * KEYWORD VARIABLE PTR TO KVBLK (SEE KVBLK) ! 278: * ! 279: * PSEUDO-VARIABLES ARE HANDLED AS SPECIAL CASES BY THE ! 280: * ACCESS PROCEDURE (ACESS) AND THE ASSIGNMENT PROCEDURE ! 281: * (ASIGN). SEE THESE TWO PROCEDURES FOR DETAILS. ! 282: {{EJC{{{{ ! 283: * ! 284: * ORGANIZATION OF DATA AREA ! 285: * ------------------------- ! 286: * ! 287: * ! 288: * THE DATA AREA IS DIVIDED INTO TWO REGIONS. ! 289: * ! 290: * STATIC AREA ! 291: * ! 292: * THE STATIC AREA BUILDS UP FROM THE BOTTOM AND CONTAINS ! 293: * DATA AREAS WHICH ARE ALLOCATED DYNAMICALLY BUT ARE NEVER ! 294: * DELETED OR MOVED AROUND. THE MACRO-PROGRAM ITSELF ! 295: * USES THE STATIC AREA FOR THE FOLLOWING. ! 296: * ! 297: * 1) ALL VARIABLE BLOCKS (VRBLK). ! 298: * ! 299: * 2) THE HASH TABLE FOR VARIABLE BLOCKS. ! 300: * ! 301: * 3) MISCELLANEOUS BUFFERS AND WORK AREAS (SEE PROGRAM ! 302: * INITIALIZATION SECTION). ! 303: * ! 304: * IN ADDITION, THE SYSTEM PROCEDURES MAY USE THIS AREA FOR ! 305: * INPUT/OUTPUT BUFFERS, EXTERNAL FUNCTIONS ETC. SPACE IN ! 306: * THE STATIC REGION IS ALLOCATED BY CALLING PROCEDURE ALOST ! 307: * ! 308: * THE FOLLOWING GLOBAL VARIABLES DEFINE THE CURRENT ! 309: * LOCATION AND SIZE OF THE STATIC AREA. ! 310: * ! 311: * STATB ADDRESS OF START OF STATIC AREA ! 312: * STATE ADDRESS+1 OF LAST WORD IN AREA. ! 313: * ! 314: * THE MINIMUM SIZE OF STATIC IS GIVEN APPROXIMATELY BY ! 315: * 12 + *E$HNB + *E$STS + SPACE FOR ALPHABET STRING ! 316: * AND STANDARD PRINT BUFFER. ! 317: {{EJC{{{{ ! 318: * ! 319: * DYNAMIC AREA ! 320: * ! 321: * THE DYNAMIC AREA IS BUILT UPWARDS IN MEMORY AFTER THE ! 322: * STATIC REGION. DATA IN THIS AREA MUST ALL BE IN STANDARD ! 323: * BLOCK FORMATS SO THAT IT CAN BE PROCESSED BY THE GARBAGE ! 324: * COLLECTOR (PROCEDURE GBCOL). GBCOL COMPACTS BLOCKS DOWN ! 325: * IN THIS REGION AS REQUIRED BY SPACE EXHAUSTION AND CAN ! 326: * ALSO MOVE ALL BLOCKS UP TO ALLOW FOR EXPANSION OF THE ! 327: * STATIC REGION. ! 328: * WITH THE EXCEPTION OF TABLES AND ARRAYS, NO SPITBOL ! 329: * OBJECT ONCE BUILT IN DYNAMIC MEMORY IS EVER SUBSEQUENTLY ! 330: * MODIFIED. OBSERVING THIS RULE NECESSITATES A COPYING ! 331: * ACTION DURING STRING AND PATTERN CONCATENATION. ! 332: * ! 333: * GARBAGE COLLECTION IS FUNDAMENTAL TO THE ALLOCATION OF ! 334: * SPACE FOR VALUES. SPITBOL USES A VERY EFFICIENT GARBAGE ! 335: * COLLECTOR WHICH INSISTS THAT POINTERS INTO DYNAMIC STORE ! 336: * SHOULD BE IDENTIFIABLE WITHOUT USE OF BIT TABLES, ! 337: * MARKER BITS ETC. TO SATISFY THIS REQUIREMENT, DYNAMIC ! 338: * MEMORY MUST NOT START AT TOO LOW AN ADDRESS AND LENGTHS ! 339: * OF ARRAYS, TABLES, STRINGS, CODE AND EXPRESSION BLOCKS ! 340: * MAY NOT EXCEED THE NUMERICAL VALUE OF THE LOWEST DYNAMIC ! 341: * ADDRESS. TO AVOID EITHER PENALIZING USERS WITH MODEST ! 342: * REQUIREMENTS OR RESTRICTING THOSE WITH GREATER NEEDS ON ! 343: * HOST SYSTEMS WHERE DYNAMIC MEMORY IS ALLOCATED IN LOW ! 344: * ADDRESSES, THE MINIMUM DYNAMIC ADDRESS MAY BE SPECIFIED ! 345: * SUFFICIENTLY HIGH TO PERMIT ARBITRARILY LARGE SPITBOL ! 346: * OBJECTS TO BE CREATED ( WITH THE POSSIBILITY IN EXTREME ! 347: * CASES OF WASTING LARGE AMOUNTS OF MEMORY BELOW THE ! 348: * START ADDRESS). THIS MINIMUM VALUE IS MADE AVAILABLE ! 349: * IN VARIABLE MXLEN BY A SYSTEM ROUTINE, SYSMX. ! 350: * ALTERNATIVELY SYSMX MAY INDICATE THAT A ! 351: * DEFAULT MAY BE USED IN WHICH DYNAMIC IS PLACED ! 352: * AT THE LOWEST POSSIBLE ADDRESS FOLLOWING STATIC. ! 353: * ! 354: * THE FOLLOWING GLOBAL WORK CELLS DEFINE THE LOCATION AND ! 355: * LENGTH OF THE DYNAMIC AREA. ! 356: * ! 357: * DNAMB START OF DYNAMIC AREA ! 358: * DNAMP NEXT AVAILABLE LOCATION ! 359: * DNAME LAST AVAILABLE LOCATION + 1 ! 360: * ! 361: * DNAMB IS ALWAYS HIGHER THAN STATE SINCE THE ALOST ! 362: * PROCEDURE MAINTAINS SOME EXPANSION SPACE ABOVE STATE. ! 363: * *** DNAMB MUST NEVER BE PERMITTED TO HAVE A VALUE LESS ! 364: * THAN THAT IN MXLEN *** ! 365: * ! 366: * SPACE IN THE DYNAMIC REGION IS ALLOCATED BY THE ALLOC ! 367: * PROCEDURE. THE DYNAMIC REGION MAY BE USED BY SYSTEM ! 368: * PROCEDURES PROVIDED THAT ALL THE RULES ARE OBEYED. ! 369: {{EJC{{{{ ! 370: * ! 371: * REGISTER USAGE ! 372: * -------------- ! 373: * ! 374: * (CP) CODE POINTER REGISTER. USED TO ! 375: * HOLD A POINTER TO THE CURRENT ! 376: * LOCATION IN THE INTERPRETIVE PSEUDO ! 377: * CODE (I.E. PTR INTO A CDBLK). ! 378: * ! 379: * (XL,XR) GENERAL INDEX REGISTERS. USUALLY ! 380: * USED TO HOLD POINTERS TO BLOCKS IN ! 381: * DYNAMIC STORAGE. AN IMPORTANT ! 382: * RESTRICTION IS THAT THE VALUE IN ! 383: * XL MUST BE COLLECTABLE FOR ! 384: * A GARBAGE COLLECT CALL. A VALUE ! 385: * IS COLLECTABLE IF IT EITHER POINTS ! 386: * OUTSIDE THE DYNAMIC AREA, OR IF IT ! 387: * POINTS TO THE START OF A BLOCK IN ! 388: * THE DYNAMIC AREA. ! 389: * ! 390: * (XS) STACK POINTER. USED TO POINT TO ! 391: * THE STACK FRONT. THE STACK MAY ! 392: * BUILD UP OR DOWN AND IS USED ! 393: * TO STACK SUBROUTINE RETURN POINTS ! 394: * AND OTHER RECURSIVELY SAVED DATA. ! 395: * ! 396: * (XT) AN ALTERNATIVE NAME FOR XL DURING ! 397: * ITS USE IN ACCESSING STACKED ITEMS. ! 398: * ! 399: * (WA,WB,WC) GENERAL WORK REGISTERS. CANNOT BE ! 400: * USED FOR INDEXING, BUT MAY HOLD ! 401: * VARIOUS TYPES OF DATA. ! 402: * ! 403: * (IA) USED FOR ALL SIGNED INTEGER ! 404: * ARITHMETIC, BOTH THAT USED BY THE ! 405: * TRANSLATOR AND THAT ARISING FROM ! 406: * USE OF SNOBOL4 ARITHMETIC OPERATORS ! 407: * ! 408: * (RA) REAL ACCUMULATOR. USED FOR ALL ! 409: * FLOATING POINT ARITHMETIC. ! 410: {{EJC{{{{ ! 411: * ! 412: * SPITBOL CONDITIONAL ASSEMBLY SYMBOLS ! 413: * ------------------------------------ ! 414: * ! 415: * IN THE SPITBOL TRANSLATOR, THE FOLLOWING CONDITIONAL ! 416: * ASSEMBLY SYMBOLS ARE REFERRED TO. TO INCORPORATE THE ! 417: * FEATURES REFERRED TO, THE MINIMAL SOURCE SHOULD BE ! 418: * PREFACED BY SUITABLE CONDITIONAL ASSEMBLY SYMBOL ! 419: * DEFINITIONS. ! 420: * IN ALL CASES IT IS PERMISSIBLE TO DEFAULT THE DEFINITIONS ! 421: * IN WHICH CASE THE ADDITIONAL FEATURES WILL BE OMITTED ! 422: * FROM THE TARGET CODE. ! 423: * ! 424: * .CASL DEFINE TO INCLUDE 26 SHIFTED LETTRS ! 425: * .CAHT DEFINE TO INCLUDE HORIZONTAL TAB ! 426: * .CAVT DEFINE TO INCLUDE VERTICAL TAB ! 427: * .CIOD IF DEFINED, DEFAULT DELIMITER IS ! 428: * NOT USED IN PROCESSING 3RD ARG OF ! 429: * INPUT() AND OUTPUT() ! 430: * .CNBT DEFINE TO OMIT BATCH INITIALISATION ! 431: * .CNCI DEFINE TO ENABLE SYSCI ROUTINE ! 432: * .CNEX DEFINE TO OMIT EXIT() CODE. ! 433: * .CNLD DEFINE TO OMIT LOAD() CODE. ! 434: * .CNPF DEFINE TO OMIT PROFILE STUFF ! 435: * .CNRA DEFINE TO OMIT ALL REAL ARITHMETIC ! 436: * .CNSR DEFINE TO OMIT SORT, RSORT ! 437: * .CSAX DEFINE IF SYSAX IS TO BE CALLED ! 438: * .CSN6 DEFINE TO PAD STMT NOS TO 6 CHARS ! 439: * .CSN8 DEFINE TO PAD STMT NOS TO 8 CHARS ! 440: * .CUCF DEFINE TO INCLUDE CFP$U ! 441: * .CULC DEFINE TO INCLUDE &CASE (LC NAMES) ! 442: * .CUST DEFINE TO INCLUDE SET() CODE ! 443: {{TTL{S{{{P I T B O L -- PROCEDURES SECTION ! 444: * ! 445: * THIS SECTION STARTS WITH DESCRIPTIONS OF THE OPERATING ! 446: * SYSTEM DEPENDENT PROCEDURES WHICH ARE USED BY THE SPITBOL ! 447: * TRANSLATOR. ALL SUCH PROCEDURES HAVE FIVE LETTER NAMES ! 448: * BEGINNING WITH SYS. THEY ARE LISTED IN ALPHABETICAL ! 449: * ORDER. ! 450: * ALL PROCEDURES HAVE A SPECIFICATION CONSISTING OF A ! 451: * MODEL CALL, PRECEDED BY A POSSIBLY EMPTY LIST OF REGISTER ! 452: * CONTENTS GIVING PARAMETERS AVAILABLE TO THE PROCEDURE AND ! 453: * FOLLOWED BY A POSSIBLY EMPTY LIST OF REGISTER CONTENTS ! 454: * REQUIRED ON RETURN FROM THE CALL OR WHICH MAY HAVE HAD ! 455: * THEIR CONTENTS DESTROYED. ONLY THOSE REGISTERS EXPLICITLY ! 456: * MENTIONED IN THE LIST AFTER THE CALL MAY HAVE THEIR ! 457: * VALUES CHANGED. ! 458: * THE SEGMENT OF CODE PROVIDING THE EXTERNAL PROCEDURES IS ! 459: * CONVENIENTLY REFERRED TO AS OSINT (OPERATING SYSTEM ! 460: * INTERFACE). THE SYSXX PROCEDURES IT CONTAINS PROVIDE ! 461: * FACILITIES NOT USUALLY AVAILABLE AS PRIMITIVES IN ! 462: * ASSEMBLY LANGUAGES. FOR PARTICULAR TARGET MACHINES, ! 463: * IMPLEMENTORS MAY CHOOSE FOR SOME MINIMAL OPCODES WHICH ! 464: * DO NOT HAVE REASONABLY DIRECT TRANSLATIONS, TO USE CALLS ! 465: * OF ADDITIONAL PROCEDURES WHICH THEY PROVIDE IN OSINT. ! 466: * E.G. MWB OR TRC MIGHT BE TRANSLATED AS JSR SYSMB, ! 467: * JSR SYSTC IN SOME IMPLEMENTATIONS. ! 468: * ! 469: * IN THE DESCRIPTIONS, REFERENCE IS MADE TO --BLK ! 470: * FORMATS (-- = A PAIR OF LETTERS). SEE THE SPITBOL ! 471: * DEFINITIONS SECTION FOR DETAILED DESCRIPTIONS OF ALL ! 472: * SUCH BLOCK FORMATS EXCEPT FCBLK FOR WHICH SYSFC SHOULD ! 473: * BE CONSULTED. ! 474: * ! 475: * SECTION 0 CONTAINS INP,INR SPECIFICATIONS OF INTERNAL ! 476: * PROCEDURES,ROUTINES. THIS GIVES A SINGLE PASS TRANSLATOR ! 477: * INFORMATION MAKING IT EASY TO GENERATE ALTERNATIVE CALLS ! 478: * IN THE TRANSLATION OF JSR-S FOR PROCEDURES OF DIFFERENT ! 479: * TYPES IF THIS PROVES NECESSARY. ! 480: * ! 481: {{SEC{{{{START OF PROCEDURES SECTION ! 482: {{EJC{{{{ ! 483: * ! 484: * SYSAX -- AFTER EXECUTION ! 485: * ! 486: {SYSAX{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 487: * ! 488: * IF THE CONDITIONAL ASSEMBLY SYMBOL .CSAX IS DEFINED, ! 489: * THIS ROUTINE IS CALLED IMMEDIATELY AFTER EXECUTION AND ! 490: * BEFORE PRINTING OF EXECUTION STATISTICS OR DUMP OUTPUT. ! 491: * PURPOSE OF CALL IS FOR IMPLEMENTOR TO DETERMINE AND ! 492: * IF THE CALL IS NOT REQUIRED IT WILL BE OMITTED IF .CSAX ! 493: * IS UNDEFINED. IN THIS CASE SYSAX NEED NOT BE CODED. ! 494: * ! 495: * JSR SYSAX CALL AFTER EXECUTION ! 496: {{EJC{{{{ ! 497: * ! 498: * SYSBX -- BEFORE EXECUTION ! 499: * ! 500: {SYSBX{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 501: * ! 502: * CALLED AFTER INITIAL SPITBOL COMPILATION AND BEFORE ! 503: * COMMENCING EXECUTION IN CASE OSINT NEEDS ! 504: * TO ASSIGN FILES OR PERFORM OTHER NECESSARY SERVICES. ! 505: * OSINT MAY ALSO CHOOSE TO SEND A MESSAGE TO ONLINE ! 506: * TERMINAL (IF ANY) INDICATING THAT EXECUTION IS STARTING. ! 507: * ! 508: * JSR SYSBX CALL BEFORE EXECUTION STARTS ! 509: {{EJC{{{{ ! 510: * ! 511: * SYSDC -- DATE CHECK ! 512: * ! 513: {SYSDC{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 514: * ! 515: * SYSDC IS CALLED TO CHECK THAT THE EXPIRY DATE FOR A TRIAL ! 516: * VERSION OF SPITBOL IS UNEXPIRED. ! 517: * ! 518: * JSR SYSDC CALL TO CHECK DATE ! 519: * RETURN ONLY IF DATE IS OK ! 520: {{EJC{{{{ ! 521: * ! 522: * SYSDM -- DUMP CORE ! 523: * ! 524: {SYSDM{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 525: * ! 526: * SYSDM IS CALLED BY A SPITBOL PROGRAM CALL OF DUMP(N) WITH ! 527: * N GE 3. ITS PURPOSE IS TO PROVIDE A CORE DUMP. ! 528: * N COULD HOLD AN ENCODING OF THE START ADRS FOR DUMP AND ! 529: * AMOUNT TO BE DUMPED E.G. N = 256*A + S , S = START ADRS ! 530: * IN KILOWORDS, A = KILOWORDS TO DUMP ! 531: * ! 532: * (XR) PARAMETER N OF CALL DUMP(N) ! 533: * JSR SYSDM CALL TO ENTER ROUTINE ! 534: {{EJC{{{{ ! 535: * ! 536: * SYSDT -- GET CURRENT DATE ! 537: * ! 538: {SYSDT{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 539: * ! 540: * SYSDT IS USED TO OBTAIN THE CURRENT DATE. THE DATE IS ! 541: * RETURNED AS A CHARACTER STRING IN ANY FORMAT APPROPRIATE ! 542: * TO THE OPERATING SYSTEM IN USE. IT MAY ALSO CONTAIN THE ! 543: * CURRENT TIME OF DAY. SYSDT IS USED TO IMPLEMENT THE ! 544: * SNOBOL4 FUNCTION DATE. ! 545: * ! 546: * JSR SYSDT CALL TO GET DATE ! 547: * (XL) POINTER TO BLOCK CONTAINING DATE ! 548: * ! 549: * THE FORMAT OF THE BLOCK IS LIKE AN SCBLK EXCEPT THAT ! 550: * THE FIRST WORD NEED NOT BE SET. THE RESULT IS COPIED ! 551: * INTO SPITBOL DYNAMIC MEMORY ON RETURN. ! 552: {{EJC{{{{ ! 553: * ! 554: * SYSEF -- EJECT FILE ! 555: * ! 556: {SYSEF{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 557: * ! 558: * SYSEF IS USED TO WRITE A PAGE EJECT TO A NAMED FILE. IT ! 559: * MAY ONLY BE USED FOR FILES WHERE THIS CONCEPT MAKES ! 560: * SENSE. NOTE THAT SYSEF IS NOT NORMALLY USED FOR THE ! 561: * STANDARD OUTPUT FILE (SEE SYSEP). ! 562: * ! 563: * (WA) PTR TO FCBLK OR ZERO ! 564: * (XR) EJECT ARGUMENT (SCBLK PTR) ! 565: * JSR SYSEF CALL TO EJECT FILE ! 566: * PPM LOC RETURN HERE IF FILE DOES NOT EXIST ! 567: * PPM LOC RETURN HERE IF INAPPROPRIATE FILE ! 568: * PPM LOC RETURN HERE IF I/O ERROR ! 569: {{EJC{{{{ ! 570: * ! 571: * SYSEJ -- END OF JOB ! 572: * ! 573: {SYSEJ{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 574: * ! 575: * SYSEJ IS CALLED ONCE AT THE END OF EXECUTION TO ! 576: * TERMINATE THE RUN. THE SIGNIFICANCE OF THE ABEND AND ! 577: * CODE VALUES IS SYSTEM DEPENDENT. IN GENERAL, THE CODE ! 578: * VALUE SHOULD BE MADE AVAILABLE FOR TESTING, AND THE ! 579: * ABEND VALUE SHOULD CAUSE SOME POST-MORTEM ACTION SUCH AS ! 580: * A DUMP. NOTE THAT SYSEJ DOES NOT RETURN TO ITS CALLER. ! 581: * SEE SYSXI FOR DETAILS OF FCBLK CHAIN ! 582: * ! 583: * (WA) VALUE OF ABEND KEYWORD ! 584: * (WB) VALUE OF CODE KEYWORD ! 585: * (XL) O OR PTR TO HEAD OF FCBLK CHAIN ! 586: * JSR SYSEJ CALL TO END JOB ! 587: * ! 588: * THE FOLLOWING SPECIAL VALUES ARE USED AS CODES IN (WB) ! 589: * 999 EXECUTION SUPPRESSED ! 590: * 998 STANDARD OUTPUT FILE FULL OR UNAVAILABLE IN A SYSXI ! 591: * LOAD MODULE. IN THESE CASES (WA) CONTAINS THE NUMBER ! 592: * OF THE STATEMENT CAUSING PREMATURE TERMINATION. ! 593: {{EJC{{{{ ! 594: * ! 595: * SYSEM -- GET ERROR MESSAGE TEXT ! 596: * ! 597: {SYSEM{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 598: * ! 599: * SYSEM IS USED TO OBTAIN THE TEXT OF ERR, ERB CALLS IN THE ! 600: * SOURCE PROGRAM GIVEN THE ERROR CODE NUMBER. IT IS ALLOWED ! 601: * TO RETURN A NULL STRING IF THIS FACILITY IS UNAVAILABLE. ! 602: * ! 603: * (WA) ERROR CODE NUMBER ! 604: * JSR SYSEM CALL TO GET TEXT ! 605: * (XR) TEXT OF MESSAGE ! 606: * ! 607: * THE RETURNED VALUE IS A POINTER TO A BLOCK IN SCBLK ! 608: * FORMAT EXCEPT THAT THE FIRST WORD NEED NOT BE SET. THE ! 609: * STRING IS COPIED INTO DYNAMIC MEMORY ON RETURN. ! 610: * IF THE NULL STRING IS RETURNED EITHER BECAUSE SYSEM DOES ! 611: * NOT PROVIDE ERROR MESSAGE TEXTS OR BECAUSE WA IS OUT OF ! 612: * RANGE, SPITBOL WILL PRINT THE STRING STORED IN ERRTEXT ! 613: * KEYWORD. ! 614: {{EJC{{{{ ! 615: * ! 616: * SYSEN -- ENDFILE ! 617: * ! 618: {SYSEN{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 619: * ! 620: * SYSEN IS USED TO IMPLEMENT THE SNOBOL4 FUNCTION ENDFILE. ! 621: * THE MEANING IS SYSTEM DEPENDENT. IN GENERAL, ENDFILE ! 622: * IMPLIES THAT NO FURTHER I/O OPERATIONS WILL BE PERFORMED, ! 623: * BUT DOES NOT GUARANTEE THIS TO BE THE CASE. THE FILE ! 624: * SHOULD BE CLOSED AFTER THE CALL, A SUBSEQUENT READ ! 625: * OR WRITE MAY REOPEN THE FILE AT THE START OR IT MAY BE ! 626: * NECESSARY TO REOPEN THE FILE VIA SYSIO. ! 627: * ! 628: * (WA) PTR TO FCBLK OR ZERO ! 629: * (XR) ENDFILE ARGUMENT (SCBLK PTR) ! 630: * JSR SYSEN CALL TO ENDFILE ! 631: * PPM LOC RETURN HERE IF FILE DOES NOT EXIST ! 632: * PPM LOC RETURN HERE IF ENDFILE NOT ALLOWED ! 633: * PPM LOC RETURN HERE IF I/O ERROR ! 634: * (WA,WB) DESTROYED ! 635: * ! 636: * THE SECOND ERROR RETURN IS USED FOR FILES FOR WHICH ! 637: * ENDFILE IS NOT PERMITTED. FOR EXAMPLE, IT MAY BE EXPECTED ! 638: * THAT THE STANDARD INPUT AND OUTPUT FILES ARE IN THIS ! 639: * CATEGORY. ! 640: {{EJC{{{{ ! 641: * ! 642: * SYSEP -- EJECT PRINTER PAGE ! 643: * ! 644: {SYSEP{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 645: * ! 646: * SYSEP IS CALLED TO PERFORM A PAGE EJECT ON THE STANDARD ! 647: * PRINTER OUTPUT FILE (CORRESPONDING TO SYSPR OUTPUT). ! 648: * ! 649: * JSR SYSEP CALL TO EJECT PRINTER OUTPUT ! 650: {{EJC{{{{ ! 651: * ! 652: * SYSEX -- CALL EXTERNAL FUNCTION ! 653: * ! 654: {SYSEX{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 655: * ! 656: * SYSEX IS CALLED TO PASS CONTROL TO AN EXTERNAL FUNCTION ! 657: * PREVIOUSLY LOADED WITH A CALL TO SYSLD. ! 658: * ! 659: * (XS) POINTER TO ARGUMENTS ON STACK ! 660: * (XL) POINTER TO CONTROL BLOCK (EFBLK) ! 661: * (WA) NUMBER OF ARGUMENTS ON STACK ! 662: * JSR SYSEX CALL TO PASS CONTROL TO FUNCTION ! 663: * PPM LOC RETURN HERE IF FUNCTION CALL FAILS ! 664: * (XS) POPPED PAST ARGUMENTS ! 665: * (XR) RESULT RETURNED ! 666: * ! 667: * THE ARGUMENTS ARE STORED ON THE STACK WITH ! 668: * THE LAST ARGUMENT AT 0(XS). ON RETURN, XS ! 669: * IS POPPED PAST THE ARGUMENTS. ! 670: * ! 671: * THE FORM OF THE ARGUMENTS AS PASSED IS THAT USED IN THE ! 672: * SPITBOL TRANSLATOR (SEE DEFINITIONS AND DATA STRUCTURES ! 673: * SECTION). THE CONTROL BLOCK FORMAT IS ALSO DESCRIBED ! 674: * (UNDER EFBLK) IN THIS SECTION. ! 675: * ! 676: * THERE ARE TWO WAYS OF RETURNING A RESULT. ! 677: * ! 678: * 1) RETURN A POINTER TO A BLOCK IN DYNAMIC STORAGE. THIS ! 679: * BLOCK MUST BE IN EXACTLY CORRECT FORMAT, INCLUDING ! 680: * THE FIRST WORD. ONLY FUNCTIONS WRITTEN WITH INTIMATE ! 681: * KNOWLEDGE OF THE SYSTEM WILL RETURN IN THIS WAY. ! 682: * ! 683: * 2) STRING, INTEGER AND REAL RESULTS MAY BE RETURNED BY ! 684: * POINTING TO A PSEUDO-BLOCK OUTSIDE DYNAMIC MEMORY. ! 685: * THIS BLOCK IS IN ICBLK, RCBLK OR SCBLK FORMAT EXCEPT ! 686: * THAT THE FIRST WORD WILL BE OVERWRITTEN ! 687: * BY A TYPE WORD ON RETURN AND SO NEED NOT ! 688: * BE CORRECTLY SET. SUCH A RESULT IS ! 689: * COPIED INTO MAIN STORAGE BEFORE PROCEEDING. ! 690: * UNCONVERTED RESULTS MAY SIMILARLY BE RETURNED IN A ! 691: * PSEUDO-BLOCK WHICH IS IN CORRECT FORMAT INCLUDING ! 692: * TYPE WORD RECOGNISABLE BY GARBAGE COLLECTOR SINCE ! 693: * BLOCK IS COPIED INTO DYNAMIC MEMORY. ! 694: {{EJC{{{{ ! 695: * ! 696: * SYSFC -- FILE CONTROL BLOCK ROUTINE ! 697: * ! 698: {SYSFC{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 699: * ! 700: * SEE ALSO SYSIO ! 701: * INPUT AND OUTPUT HAVE 3 ARGUMENTS REFERRED TO AS SHOWN ! 702: * INPUT(VARIABLE NAME,FILE ARG1,FILE ARG2) ! 703: * OUTPUT(VARIABLE NAME,FILE ARG1,FILE ARG2) ! 704: * FILE ARG1 MAY BE AN INTEGER OR STRING USED TO IDENTIFY ! 705: * AN I/O CHANNEL. IT IS CONVERTED TO A STRING FOR CHECKING. ! 706: * THE EXACT SIGNIFICANCE OF FILE ARG2 ! 707: * IS NOT RIGOROUSLY PRESCRIBED BUT TO IMPROVE PORTABILITY, ! 708: * THE SCHEME DESCRIBED IN THE SPITBOL USER MANUAL ! 709: * SHOULD BE ADOPTED WHEN POSSIBLE. THE PREFERRED FORM IS ! 710: * A STRING $F$,R$R$,C$C$,I$I$,...,Z$Z$ WHERE ! 711: * $F$ IS AN OPTIONAL FILE NAME WHICH IS PLACED FIRST. ! 712: * REMAINING ITEMS MAY BE OMITTED OR INCLUDED IN ANY ORDER. ! 713: * $R$ IS MAXIMUM RECORD LENGTH ! 714: * $C$ IS A CARRIAGE CONTROL CHARACTER OR CHARACTER STRING ! 715: * $I$ IS SOME FORM OF CHANNEL IDENTIFICATION USED IN THE ! 716: * ABSENCE OF $F$ TO ASSOCIATE THE VARIABLE ! 717: * WITH A FILE ALLOCATED DYNAMICALLY BY JCL COMMANDS AT ! 718: * SPITBOL LOAD TIME. ! 719: * ,...,Z$Z$ ARE ADDITIONAL FIELDS. ! 720: * IF , (COMMA) CANNOT BE USED AS A DELIMITER, .CIOD ! 721: * SHOULD BE DEFINED TO INTRODUCE BY CONDITIONAL ASSEMBLY ! 722: * ANOTHER DELIMITER (SEE ! 723: * IODEL EQU * ! 724: * EARLY IN DEFINITIONS SECTION). ! 725: * SYSFC IS CALLED WHEN A VARIABLE IS INPUT OR OUTPUT ! 726: * ASSOCIATED TO CHECK FILE ARG1 AND FILE ARG2 AND ! 727: * TO REPORT WHETHER AN FCBLK (FILE CONTROL ! 728: * BLOCK) IS NECESSARY AND IF SO WHAT SIZE IT SHOULD BE. ! 729: * THIS MAKES IT POSSIBLE FOR SPITBOL RATHER THAN OSINT TO ! 730: * ALLOCATE SUCH A BLOCK IN DYNAMIC MEMORY IF REQUIRED ! 731: * OR ALTERNATIVELY IN STATIC MEMORY. ! 732: * THE SIGNIFICANCE OF AN FCBLK , IF ONE IS REQUESTED, IS ! 733: * ENTIRELY UP TO THE SYSTEM INTERFACE. THE ONLY RESTRICTION ! 734: * IS THAT IF THE FCBLK SHOULD APPEAR TO LIE IN DYNAMIC ! 735: * MEMORY , POINTERS TO IT SHOULD BE PROPER POINTERS TO ! 736: * THE START OF A RECOGNISABLE AND GARBAGE COLLECTABLE ! 737: * BLOCK (THIS CONDITION WILL BE MET IF SYSFC REQUESTS ! 738: * SPITBOL TO PROVIDE AN FCBLK). ! 739: * AN OPTION IS PROVIDED FOR OSINT TO RETURN A POINTER IN ! 740: * XL TO AN FCBLK WHICH IT PRIVATELY ALLOCATED. THIS PTR ! 741: * WILL BE MADE AVAILABLE WHEN I/O OCCURS LATER. ! 742: * PRIVATE FCBLKS MAY HAVE ARBITRARY CONTENTS AND SPITBOL ! 743: * STORES NOTHING IN THEM. ! 744: {{EJC{{{{ ! 745: * THE REQUESTED SIZE FOR AN FCBLK IN DYNAMIC MEMORY ! 746: * SHOULD ALLOW A 2 WORD OVERHEAD FOR BLOCK TYPE AND ! 747: * LENGTH FIELDS. INFORMATION SUBSEQUENTLY STORED IN THE ! 748: * REMAINING WORDS MAY BE ARBITRARY IF AN XNBLK (EXTERNAL ! 749: * NON-RELOCATABLE BLOCK) IS REQUESTED. IF THE REQUEST IS ! 750: * FOR AN XRBLK (EXTERNAL RELOCATABLE BLOCK) THE ! 751: * CONTENTS OF WORDS SHOULD BE COLLECTABLE (I.E. ANY ! 752: * APPARENT POINTERS INTO DYNAMIC SHOULD BE GENUINE BLOCK ! 753: * POINTERS). THESE RESTRICTIONS DO NOT APPLY IF AN FCBLK ! 754: * IS ALLOCATED OUTSIDE DYNAMIC OR IS NOT ALLOCATED AT ALL. ! 755: * IF AN FCBLK IS REQUESTED, ITS FIELDS WILL BE INITIALISED ! 756: * TO ZERO BEFORE ENTRY TO SYSIO WITH THE EXCEPTION OF ! 757: * WORDS 0 AND 1 IN WHICH THE BLOCK TYPE AND LENGTH ! 758: * FIELDS ARE PLACED FOR FCBLKS IN DYNAMIC MEMORY ONLY. ! 759: * FOR THE POSSIBLE USE OF SYSEJ AND SYSXI, IF FCBLKS ! 760: * ARE USED, A CHAIN IS BUILT SO THAT THEY MAY ALL BE ! 761: * FOUND - SEE SYSXI FOR DETAILS. ! 762: * IF BOTH FILE ARG1 AND FILE ARG2 ARE NULL, CALLS OF SYSFC ! 763: * AND SYSIO ARE OMITTED. ! 764: * IF FILE ARG1 IS NULL (STANDARD INPUT/OUTPUT FILE), SYSFC ! 765: * IS CALLED TO CHECK NON-NULL FILE ARG2 BUT ANY REQUEST ! 766: * FOR AN FCBLK WILL BE IGNORED, SINCE SPITBOL HANDLES THE ! 767: * STANDARD FILES SPECIALLY AND CANNOT READILY KEEP FCBLK ! 768: * POINTERS FOR THEM. ! 769: * FILEARG1 IS TYPE CHECKED BY SPITBOL SO FURTHER CHECKING ! 770: * MAY BE UNNECCESSARY IN MANY IMPLEMENTATIONS. ! 771: * FILE ARG2 IS PASSED SO THAT SYSFC MAY ANALYSE AND ! 772: * CHECK IT. HOWEVER TO ASSIST IN THIS, SPITBOL ALSO PASSES ! 773: * ON THE STACK THE COMPONENTS OF THIS ARGUMENT WITH ! 774: * FILE NAME, $F$ (OTHERWISE NULL) EXTRACTED AND STACKED ! 775: * FIRST. ! 776: * THE OTHER FIELDS, IF ANY, ARE EXTRACTED AS SUBSTRINGS, ! 777: * POINTERS TO THEM ARE STACKED AND A COUNT OF ALL ITEMS ! 778: * STACKED IS PLACED IN WC. IF AN FCBLK WAS EARLIER ! 779: * ALLOCATED AND POINTED TO VIA FILE ARG1, SYSFC IS ALSO ! 780: * PASSED A POINTER TO THIS FCBLK. ! 781: * ! 782: * (XL) FILE ARG1 SCBLK PTR (2ND ARG) ! 783: * (XR) FILEARG2 (3RD ARG) OR NULL ! 784: * -(XS)...-(XS) SCBLKS FOR $F$,$R$,$C$,... ! 785: * (WC) NO. OF STACKED SCBLKS ABOVE ! 786: * (WA) EXISTING FILE ARG1 FCBLK PTR OR 0 ! 787: * (WB) 0/3 FOR INPUT/OUTPUT ASSOCN ! 788: * JSR SYSFC CALL TO CHECK NEED FOR FCBLK ! 789: * PPM LOC INVALID FILE ARGUMENT ! 790: * (XS) POPPED (WC) TIMES ! 791: * (WA NON ZERO) BYTE SIZE OF REQUESTED FCBLK ! 792: * (WA=0,XL NON ZERO) PRIVATE FCBLK PTR IN XL ! 793: * (WA=XL=0) NO FCBLK WANTED, NO PRIVATE FCBLK ! 794: * (WC) 0/1/2 REQUEST ALLOC OF XRBLK/XNBLK ! 795: * /STATIC BLOCK FOR USE AS FCBLK ! 796: * (WB) DESTROYED ! 797: {{EJC{{{{ ! 798: * ! 799: * SYSHS -- GIVE ACCESS TO HOST COMPUTER FEATURES ! 800: * ! 801: {SYSHS{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 802: * ! 803: * PROVIDES MEANS FOR IMPLEMENTING SPECIAL FEATURES ! 804: * ON DIFFERENT HOST COMPUTERS. THE ONLY DEFINED ENTRY IS ! 805: * THAT WHERE ALL ARGUMENTS ARE NULL IN WHICH CASE SYSHS ! 806: * RETURNS AN SCBLK CONTAINING NAME OF COMPUTER, ! 807: * NAME OF OPERATING SYSTEM AND NAME OF SITE SEPARATED BY ! 808: * COLONS. THE SCBLK NEED NOT HAVE A CORRECT FIRST FIELD ! 809: * AS THIS IS SUPPLIED ON COPYING STRING TO DYNAMIC MEMORY. ! 810: * SPITBOL DOES NO ARGUMENT CHECKING BUT DOES PROVIDE A ! 811: * SINGLE ERROR RETURN FOR ARGUMENTS CHECKED AS ERRONEOUS ! 812: * BY OSINT. IT ALSO PROVIDES A SINGLE EXECUTION ERROR ! 813: * RETURN. IF THESE ARE INADEQUATE, USE MAY BE MADE OF THE ! 814: * MINIMAL ERROR SECTION DIRECT AS DESCRIBED IN MINIMAL ! 815: * DOCUMENTATION, SECTION 10. ! 816: * SEVERAL NON-ERROR RETURNS ARE PROVIDED. THE FIRST ! 817: * CORRESPONDS TO THE DEFINED ENTRY OR, FOR IMPLEMENTATION ! 818: * DEFINED ENTRIES, ANY STRING MAY BE RETURNED. THE OTHERS ! 819: * PERMIT RESPECTIVELY, RETURN A NULL RESULT, RETURN WITH A ! 820: * RESULT TO BE STACKED WHICH IS POINTED AT BY XR, AND A ! 821: * RETURN CAUSING SPITBOL STATEMENT FAILURE. IF A RETURNED ! 822: * RESULT IS IN DYNAMIC MEMORY IT MUST OBEY GARBAGE ! 823: * COLLECTOR RULES. THE ONLY RESULTS COPIED ON RETURN ! 824: * ARE STRINGS RETURNED VIA PPM LOC3 RETURN. ! 825: * ! 826: * (WA) ARGUMENT 1 ! 827: * (XL) ARGUMENT 2 ! 828: * (XR) ARGUMENT 3 ! 829: * JSR SYSHS CALL TO GET HOST INFORMATION ! 830: * PPM LOC1 ERRONEOUS ARG ! 831: * PPM LOC2 EXECUTION ERROR ! 832: * PPM LOC3 SCBLK PTR IN XL OR 0 IF UNAVAILABLE ! 833: * PPM LOC4 RETURN A NULL RESULT ! 834: * PPM LOC5 RETURN RESULT IN XR ! 835: * PPM LOC6 CAUSE STATEMENT FAILURE ! 836: {{EJC{{{{ ! 837: * ! 838: * SYSID -- RETURN SYSTEM IDENTIFICATION ! 839: * ! 840: {SYSID{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 841: * ! 842: * THIS ROUTINE SHOULD RETURN STRINGS TO HEAD THE STANDARD ! 843: * PRINTER OUTPUT. THE FIRST STRING WILL BE APPENDED TO ! 844: * A HEADING LINE OF THE FORM ! 845: * MACRO SPITBOL VERSION V.V ! 846: * SUPPLIED BY SPITBOL ITSELF. V.V ARE DIGITS GIVING THE ! 847: * MAJOR VERSION NUMBER AND GENERALLY AT LEAST A MINOR ! 848: * VERSION NUMBER RELATING TO OSINT SHOULD BE SUPPLIED TO ! 849: * GIVE SAY ! 850: * MACRO SPITBOL VERSION V.V(M.M) ! 851: * THE SECOND STRING SHOULD IDENTIFY AT LEAST THE MACHINE ! 852: * AND OPERATING SYSTEM. PREFERABLY IT SHOULD INCLUDE ! 853: * THE DATE AND TIME OF THE RUN. ! 854: * OPTIONALLY THE STRINGS MAY INCLUDE SITE NAME OF THE ! 855: * THE IMPLEMENTOR AND/OR MACHINE ON WHICH RUN TAKES PLACE, ! 856: * UNIQUE SITE OR COPY NUMBER AND OTHER INFORMATION AS ! 857: * APPROPRIATE WITHOUT MAKING IT SO LONG AS TO BE A ! 858: * NUISANCE TO USERS. ! 859: * THE FIRST WORDS OF THE SCBLKS POINTED AT NEED NOT BE ! 860: * CORRECTLY SET. ! 861: * ! 862: * JSR SYSID CALL FOR SYSTEM IDENTIFICATION ! 863: * (XR) SCBLK PTR FOR ADDITION TO HEADER ! 864: * (XL) PTR TO SECOND HEADER SCBLK ! 865: {{EJC{{{{ ! 866: * ! 867: * SYSIL -- GET INPUT RECORD LENGTH ! 868: * ! 869: {SYSIL{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 870: * ! 871: * SYSIL IS USED TO GET THE LENGTH OF THE NEXT INPUT RECORD ! 872: * FROM A FILE PREVIOUSLY INPUT ASSOCIATED WITH A SYSIO ! 873: * CALL. THE LENGTH RETURNED IS USED TO ESTABLISH A BUFFER ! 874: * FOR A SUBSEQUENT SYSIN CALL. ! 875: * ! 876: * (WA) PTR TO FCBLK OR ZERO ! 877: * JSR SYSIL CALL TO GET RECORD LENGTH ! 878: * (WA) LENGTH OR ZERO IF FILE CLOSED ! 879: * ! 880: * NO HARM IS DONE IF THE VALUE RETURNED IS TOO LONG SINCE ! 881: * UNUSED SPACE WILL BE RECLAIMED AFTER THE SYSIN CALL. ! 882: * ! 883: * NOTE THAT IT IS THE SYSIL CALL (NOT THE SYSIO CALL) WHICH ! 884: * CAUSES THE FILE TO BE OPENED AS REQUIRED FOR THE FIRST ! 885: * RECORD INPUT FROM THE FILE. ! 886: {{EJC{{{{ ! 887: * ! 888: * SYSIN -- READ INPUT RECORD ! 889: * ! 890: {SYSIN{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 891: * ! 892: * SYSIN IS USED TO READ A RECORD FROM THE FILE WHICH WAS ! 893: * REFERENCED IN A PRIOR CALL TO SYSIL (I.E. THESE CALLS ! 894: * ALWAYS OCCUR IN PAIRS). THE BUFFER PROVIDED IS AN ! 895: * SCBLK FOR A STRING OF LENGTH SET FROM THE SYSIL CALL. ! 896: * IF THE ACTUAL LENGTH READ IS LESS THAN THIS, THE LENGTH ! 897: * FIELD OF THE SCBLK MUST BE MODIFIED BEFORE RETURNING ! 898: * UNLESS BUFFER IS RIGHT PADDED WITH ZEROES. ! 899: * IT IS ALSO PERMISSIBLE TO TAKE ANY OF THE ALTERNATIVE ! 900: * RETURNS AFTER SCBLK LENGTH HAS BEEN MODIFIED. ! 901: * ! 902: * (WA) PTR TO FCBLK OR ZERO ! 903: * (XR) POINTER TO BUFFER (SCBLK PTR) ! 904: * JSR SYSIN CALL TO READ RECORD ! 905: * PPM LOC ENDFILE OR NO I/P FILE AFTER SYSXI ! 906: * PPM LOC RETURN HERE IF I/O ERROR ! 907: * PPM LOC RETURN HERE IF RECORD FORMAT ERROR ! 908: * (WA,WB,WC) DESTROYED ! 909: {{EJC{{{{ ! 910: * ! 911: * SYSIO -- INPUT/OUTPUT FILE ASSOCIATION ! 912: * ! 913: {SYSIO{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 914: * ! 915: * SEE ALSO SYSFC. ! 916: * SYSIO IS CALLED IN RESPONSE TO A SNOBOL4 INPUT OR OUTPUT ! 917: * FUNCTION CALL EXCEPT WHEN FILE ARG1 AND FILE ARG2 ! 918: * ARE BOTH NULL. ! 919: * ITS CALL ALWAYS FOLLOWS IMMEDIATELY AFTER A CALL ! 920: * OF SYSFC. IF SYSFC REQUESTED ALLOCATION ! 921: * OF AN FCBLK, ITS ADDRESS WILL BE IN WA. ! 922: * FOR INPUT FILES, NON-ZERO VALUES OF $R$ SHOULD BE ! 923: * COPIED TO WC FOR USE IN ALLOCATING INPUT BUFFERS. IF $R$ ! 924: * IS DEFAULTED OR NOT IMPLEMENTED, WC SHOULD BE ZEROISED. ! 925: * ONCE A FILE HAS BEEN OPENED, SUBSEQUENT INPUT(),OUTPUT() ! 926: * CALLS IN WHICH THE SECOND ARGUMENT IS IDENTICAL WITH THAT ! 927: * IN A PREVIOUS CALL, MERELY ASSOCIATE THE ADDITIONAL ! 928: * VARIABLE NAME (FIRST ARGUMENT) TO THE FILE AND DO NOT ! 929: * RESULT IN RE-OPENING THE FILE. ! 930: * IN SUBSEQUENT ASSOCIATED ACCESSES TO THE FILE A POINTER ! 931: * TO ANY FCBLK ALLOCATED WILL BE MADE AVAILABLE. ! 932: * ! 933: * (XL) FILE ARG1 SCBLK PTR (2ND ARG) ! 934: * (XR) FILE ARG2 SCBLK PTR (3RD ARG) ! 935: * (WA) FCBLK PTR (0 IF NONE) ! 936: * (WB) 0 FOR INPUT, 3 FOR OUTPUT ! 937: * JSR SYSIO CALL TO ASSOCIATE FILE ! 938: * PPM LOC RETURN HERE IF FILE DOES NOT EXIST ! 939: * PPM LOC RETURN IF INPUT/OUTPUT NOT ALLOWED ! 940: * (XL) FCBLK POINTER (0 IF NONE) ! 941: * (WC) 0 (FOR DEFAULT) OR MAX RECORD LNGTH ! 942: * (WA,WB) DESTROYED ! 943: * ! 944: * THE SECOND ERROR RETURN IS USED IF THE FILE NAMED EXISTS ! 945: * BUT INPUT/OUTPUT FROM THE FILE IS NOT ALLOWED. FOR ! 946: * EXAMPLE, THE STANDARD OUTPUT FILE MAY BE IN THIS CATEGORY ! 947: * AS REGARDS INPUT ASSOCIATION. ! 948: {{EJC{{{{ ! 949: * ! 950: * SYSLD -- LOAD EXTERNAL FUNCTION ! 951: * ! 952: {SYSLD{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 953: * ! 954: * SYSLD IS CALLED IN RESPONSE TO THE USE OF THE SNOBOL4 ! 955: * LOAD FUNCTION. THE NAMED FUNCTION IS LOADED (WHATEVER ! 956: * THIS MEANS), AND A POINTER IS RETURNED. THE POINTER WILL ! 957: * BE USED ON SUBSEQUENT CALLS TO THE FUNCTION (SEE SYSEX). ! 958: * ! 959: * (XR) POINTER TO FUNCTION NAME (SCBLK) ! 960: * (XL) POINTER TO LIBRARY NAME (SCBLK) ! 961: * JSR SYSLD CALL TO LOAD FUNCTION ! 962: * PPM LOC RETURN HERE IF FUNC DOES NOT EXIST ! 963: * PPM LOC RETURN HERE IF I/O ERROR ! 964: * (XR) POINTER TO LOADED CODE ! 965: * ! 966: * THE SIGNIFICANCE OF THE POINTER RETURNED IS UP TO THE ! 967: * SYSTEM INTERFACE ROUTINE. THE ONLY RESTRICTION IS THAT ! 968: * IF THE POINTER IS WITHIN DYNAMIC STORAGE, IT MUST BE ! 969: * A PROPER BLOCK POINTER. ! 970: {{EJC{{{{ ! 971: * ! 972: * SYSMM -- GET MORE MEMORY ! 973: * ! 974: {SYSMM{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 975: * ! 976: * SYSMM IS CALLED IN AN ATTEMPT TO ALLOCATE MORE DYNAMIC ! 977: * MEMORY. THIS MEMORY MUST BE ALLOCATED CONTIGUOUSLY WITH ! 978: * THE CURRENT DYNAMIC DATA AREA. ! 979: * ! 980: * THE AMOUNT ALLOCATED IS UP TO THE SYSTEM TO DECIDE. ANY ! 981: * VALUE IS ACCEPTABLE INCLUDING ZERO IF ALLOCATION IS ! 982: * IMPOSSIBLE. ! 983: * ! 984: * JSR SYSMM CALL TO GET MORE MEMORY ! 985: * (XR) NUMBER OF ADDITIONAL WORDS OBTAINED ! 986: {{EJC{{{{ ! 987: * ! 988: * SYSMX -- SUPPLY MXLEN ! 989: * ! 990: {SYSMX{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 991: * ! 992: * BECAUSE OF THE METHOD OF GARBAGE COLLECTION, NO SPITBOL ! 993: * OBJECT IS ALLOWED TO OCCUPY MORE BYTES OF MEMORY THAN ! 994: * THE INTEGER GIVING THE LOWEST ADDRESS OF DYNAMIC ! 995: * (GARBAGE COLLECTABLE) MEMORY. MXLEN IS THE NAME USED TO ! 996: * REFER TO THIS MAXIMUM LENGTH OF AN OBJECT AND FOR MOST ! 997: * USERS OF MOST IMPLEMENTATIONS, PROVIDED DYNAMIC MEMORY ! 998: * STARTS AT AN ADDRESS OF AT LEAST A FEW THOUSAND WORDS, ! 999: * THERE IS NO PROBLEM. ! 1000: * IF THE DEFAULT STARTING ADDRESS IS LESS THAN SAY 10000 OR ! 1001: * 20000, THEN A LOAD TIME OPTION SHOULD BE PROVIDED WHERE A ! 1002: * USER CAN REQUEST THAT HE BE ABLE TO CREATE LARGER ! 1003: * OBJECTS. THIS ROUTINE INFORMS SPITBOL OF THIS REQUEST IF ! 1004: * ANY. THE VALUE RETURNED IS EITHER AN INTEGER ! 1005: * REPRESENTING THE DESIRED VALUE OF MXLEN (AND HENCE THE ! 1006: * MINIMUM DYNAMIC STORE ADDRESS WHICH MAY RESULT IN ! 1007: * NON-USE OF SOME STORE) OR ZERO IF A DEFAULT IS ACCEPTABLE ! 1008: * IN WHICH MXLEN IS SET TO THE LOWEST ADDRESS ALLOCATED ! 1009: * TO DYNAMIC STORE BEFORE COMPILATION STARTS. ! 1010: * IF A NON-ZERO VALUE IS RETURNED, THIS IS USED FOR KEYWORD ! 1011: * MAXLNGTH. OTHERWISE THE INITIAL LOW ADDRESS OF DYNAMIC ! 1012: * MEMORY IS USED FOR THIS KEYWORD. ! 1013: * ! 1014: * JSR SYSMX CALL TO GET MXLEN ! 1015: * (WA) EITHER MXLEN OR 0 FOR DEFAULT ! 1016: {{EJC{{{{ ! 1017: * ! 1018: * SYSOU -- OUTPUT RECORD ! 1019: * ! 1020: {SYSOU{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1021: * ! 1022: * SYSOU IS USED TO WRITE A RECORD TO A FILE PREVIOUSLY ! 1023: * ASSOCIATED WITH A SYSIO CALL. ! 1024: * ! 1025: * (WA) PTR TO FCBLK OR ZERO ! 1026: * (XR) RECORD TO BE WRITTEN (SCBLK) ! 1027: * JSR SYSOU CALL TO OUTPUT RECORD ! 1028: * PPM LOC FILE FULL OR NO FILE AFTER SYSXI ! 1029: * PPM LOC RETURN HERE IF I/O ERROR ! 1030: * (WA,WB,WC) DESTROYED ! 1031: * ! 1032: * NOTE THAT IT IS THE SYSOU CALL (NOT THE SYSIO CALL) WHICH ! 1033: * CAUSES THE FILE TO BE OPENED AS REQUIRED FOR THE FIRST ! 1034: * RECORD OUTPUT TO THE FILE. ! 1035: {{EJC{{{{ ! 1036: * ! 1037: * SYSPI -- PRINT ON INTERACTIVE CHANNEL ! 1038: * ! 1039: {SYSPI{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1040: * ! 1041: * IF SPITBOL IS RUN FROM AN ONLINE TERMINAL, OSINT CAN ! 1042: * REQUEST THAT MESSAGES SUCH AS COPIES OF COMPILATION ! 1043: * ERRORS BE SENT TO THE TERMINAL (SEE SYSPP). IF RELEVANT ! 1044: * REPLY WAS MADE BY SYSPP THEN SYSPI IS CALLED TO SEND SUCH ! 1045: * MESSAGES TO THE INTERACTIVE CHANNEL. ! 1046: * SYSPI IS ALSO USED FOR SENDING OUTPUT TO THE TERMINAL ! 1047: * THROUGH THE SPECIAL VARIABLE NAME, TERMINAL. ! 1048: * ! 1049: * (XR) PTR TO LINE BUFFER (SCBLK) ! 1050: * (WA) LINE LENGTH ! 1051: * JSR SYSPI CALL TO PRINT LINE ! 1052: * PPM LOC FAILURE RETURN ! 1053: * (WA,WB) DESTROYED ! 1054: {{EJC{{{{ ! 1055: * ! 1056: * SYSPP -- OBTAIN PRINT PARAMETERS ! 1057: * ! 1058: {SYSPP{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1059: * ! 1060: * SYSPP IS CALLED ONCE DURING COMPILATION TO OBTAIN ! 1061: * PARAMETERS REQUIRED FOR CORRECT PRINTED OUTPUT FORMAT ! 1062: * AND TO SELECT OTHER OPTIONS. IT MAY ALSO BE CALLED AGAIN ! 1063: * AFTER SYSXI WHEN A LOAD MODULE IS RESUMED. IN THIS ! 1064: * CASE THE VALUE RETURNED IN WA MAY BE LESS THAN OR EQUAL ! 1065: * TO THAT RETURNED IN INITIAL CALL BUT MAY NOT BE ! 1066: * GREATER. ! 1067: * THE INFORMATION RETURNED IS - ! 1068: * 1. LINE LENGTH IN CHARS FOR STANDARD PRINT FILE ! 1069: * 2. NO OF LINES/PAGE. 0 IS PREFERABLE FOR A NON-PAGED ! 1070: * DEVICE (E.G. ONLINE TERMINAL) IN WHICH CASE LISTING ! 1071: * PAGE THROWS ARE SUPPRESSED AND PAGE HEADERS ! 1072: * RESULTING FROM -TITLE,-STITL LINES ARE KEPT SHORT. ! 1073: * 3. AN INITIAL -NOLIST OPTION TO SUPPRESS LISTING UNLESS ! 1074: * THE PROGRAM CONTAINS AN EXPLICIT -LIST. ! 1075: * 4. OPTIONS TO SUPPRESS LISTING OF COMPILATION AND/OR ! 1076: * EXECUTION STATS (USEFUL FOR ESTABLISHED PROGRAMS) - ! 1077: * COMBINED WITH 3. GIVES POSSIBILITY OF LISTING ! 1078: * FILE NEVER BEING OPENED. ! 1079: * 5. OPTION TO HAVE COPIES OF ERRORS SENT TO AN ! 1080: * INTERACTIVE CHANNEL IN ADDITION TO STANDARD PRINTER. ! 1081: * 6. OPTION TO KEEP PAGE HEADERS SHORT (E.G. IF LISTING ! 1082: * TO AN ONLINE TERMINAL). ! 1083: * 7. AN OPTION TO CHOOSE EXTENDED OR COMPACT LISTING ! 1084: * FORMAT. IN THE FORMER A PAGE EJECT AND IN THE LATTER ! 1085: * A FEW LINE FEEDS PRECEDE THE PRINTING OF EACH ! 1086: * OF-- LISTING, COMPILATION STATISTICS, EXECUTION ! 1087: * OUTPUT AND EXECUTION STATISTICS. ! 1088: * 8. AN OPTION TO SUPPRESS EXECUTION AS THOUGH A ! 1089: * -NOEXECUTE CARD WERE SUPPLIED. ! 1090: * 9. AN OPTION TO REQUEST THAT NAME /TERMINAL/ BE PRE- ! 1091: * ASSOCIATED TO AN ONLINE TERMINAL VIA SYSPI AND SYSRI ! 1092: * 10. AN INTERMEDIATE (STANDARD) LISTING OPTION REQUIRING ! 1093: * THAT PAGE EJECTS OCCUR IN SOURCE LISTINGS. REDUNDANT ! 1094: * IF EXTENDED OPTION CHOSEN BUT PARTIALLY EXTENDS ! 1095: * COMPACT OPTION. ! 1096: * 11. OPTION TO SUPPRESS SYSID IDENTIFICATION. ! 1097: * ! 1098: * JSR SYSPP CALL TO GET PRINT PARAMETERS ! 1099: * (WA) PRINT LINE LENGTH IN CHARS ! 1100: * (WB) NUMBER OF LINES/PAGE ! 1101: * (WC) BITS VALUE ...JIHGFEDCBA WHERE ! 1102: * A = 1 TO SEND ERROR COPY TO INT.CH. ! 1103: * B = 1 MEANS STD PRINTER IS INT. CH. ! 1104: * C = 1 FOR -NOLIST OPTION ! 1105: * D = 1 TO SUPPRESS COMPILN. STATS ! 1106: * E = 1 TO SUPPRESS EXECN. STATS ! 1107: * F = 1/0 FOR EXTNDED/COMPACT LISTING ! 1108: * G = 1 FOR -NOEXECUTE ! 1109: * H = 1 PRE-ASSOCIATE /TERMINAL/ ! 1110: * I = 1 FOR STANDARD LISTING OPTION. ! 1111: * J = 1 SUPPRESSES LISTING HEADER ! 1112: {{EJC{{{{ ! 1113: * ! 1114: * SYSPR -- PRINT LINE ON STANDARD OUTPUT FILE ! 1115: * ! 1116: {SYSPR{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1117: * ! 1118: * SYSPR IS USED TO PRINT A SINGLE LINE ON THE STANDARD ! 1119: * OUTPUT FILE. ! 1120: * ! 1121: * (XR) POINTER TO LINE BUFFER (SCBLK) ! 1122: * (WA) LINE LENGTH ! 1123: * JSR SYSPR CALL TO PRINT LINE ! 1124: * PPM LOC TOO MUCH O/P OR NO FILE AFTER SYSXI ! 1125: * (WA,WB) DESTROYED ! 1126: * ! 1127: * THE BUFFER POINTED TO IS THE LENGTH OBTAINED FROM THE ! 1128: * SYSPP CALL AND IS FILLED OUT WITH TRAILING BLANKS. THE ! 1129: * VALUE IN WA IS THE ACTUAL LINE LENGTH WHICH MAY BE LESS ! 1130: * THAN THE MAXIMUM LINE LENGTH POSSIBLE. THERE IS NO SPACE ! 1131: * CONTROL ASSOCIATED WITH THE LINE, ALL LINES ARE PRINTED ! 1132: * SINGLE SPACED. NOTE THAT NULL LINES (WA=0) ARE POSSIBLE ! 1133: * IN WHICH CASE A BLANK LINE IS TO BE PRINTED. ! 1134: * ! 1135: * THE ERROR EXIT IS USED FOR SYSTEMS WHICH LIMIT THE AMOUNT ! 1136: * OF PRINTED OUTPUT. IF POSSIBLE, PRINTING SHOULD BE ! 1137: * PERMITTED AFTER THIS CONDITION HAS BEEN SIGNALLED ONCE TO ! 1138: * ALLOW FOR DUMP AND OTHER DIAGNOSTIC INFORMATION. ! 1139: * ASSUMING THIS TO BE POSSIBLE, SPITBOL MAY MAKE MORE SYSPR ! 1140: * CALLS. IF THE ERROR RETURN OCCURS ANOTHER TIME, EXECUTION ! 1141: * IS TERMINATED BY A CALL OF SYSEJ WITH ENDING CODE 998. ! 1142: {{EJC{{{{ ! 1143: * ! 1144: * SYSRD -- READ RECORD FROM STANDARD INPUT FILE ! 1145: * ! 1146: {SYSRD{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1147: * ! 1148: * SYSRD IS USED TO READ A RECORD FROM THE STANDARD INPUT ! 1149: * FILE. THE BUFFER PROVIDED IS AN SCBLK FOR A STRING THE ! 1150: * LENGTH OF WHICH IN CHARACTERS IS GIVEN IN WC, THIS ! 1151: * CORRESPONDING TO THE MAXIMUM LENGTH OF STRING WHICH ! 1152: * SPITBOL IS PREPARED TO RECEIVE. AT COMPILE TIME IT ! 1153: * CORRESPONDS TO XXX IN THE MOST RECENT -INXXX CARD ! 1154: * (DEFAULT 72) AND AT EXECUTION TIME TO THE MOST RECENT ! 1155: * ,R$R$ (RECORD LENGTH) IN THE THIRD ARG OF AN INPUT() ! 1156: * STATEMENT FOR THE STANDARD INPUT FILE (DEFAULT 80). ! 1157: * IF FEWER THAN (WC) CHARACTERS ARE READ, THE LENGTH ! 1158: * FIELD OF THE SCBLK MUST BE ADJUSTED BEFORE RETURNING ! 1159: * UNLESS THE BUFFER IS RIGHT PADDED WITH ZEROES. ! 1160: * IT IS ALSO PERMISSIBLE TO TAKE THE ALTERNATIVE RETURN ! 1161: * AFTER SUCH AN ADJUSTMENT HAS BEEN MADE. ! 1162: * SPITBOL MAY CONTINUE TO MAKE CALLS AFTER AN ENDFILE ! 1163: * RETURN SO THIS ROUTINE SHOULD BE PREPARED TO MAKE ! 1164: * REPEATED ENDFILE RETURNS. ! 1165: * ! 1166: * (XR) POINTER TO BUFFER (SCBLK PTR) ! 1167: * (WC) LENGTH OF BUFFER IN CHARACTERS ! 1168: * JSR SYSRD CALL TO READ LINE ! 1169: * PPM LOC ENDFILE OR NO I/P FILE AFTER SYSXI ! 1170: * (WA,WB,WC) DESTROYED ! 1171: {{EJC{{{{ ! 1172: * ! 1173: * SYSRI -- READ RECORD FROM INTERACTIVE CHANNEL ! 1174: * ! 1175: {SYSRI{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1176: * ! 1177: * READS A RECORD FROM ONLINE TERMINAL FOR SPITBOL VARIABLE, ! 1178: * TERMINAL. IF ONLINE TERMINAL IS UNAVAILABLE THEN CODE THE ! 1179: * ENDFILE RETURN ONLY. ! 1180: * THE BUFFER PROVIDED IS OF LENGTH 120 CHARACTERS. SYSRI ! 1181: * SHOULD REPLACE THE COUNT IN THE SECOND WORD OF THE SCBLK ! 1182: * BY THE ACTUAL CHARACTER COUNT UNLESS BUFFER IS RIGHT ! 1183: * PADDED WITH ZEROES. ! 1184: * IT IS ALSO PERMISSIBLE TO TAKE THE ALTERNATIVE ! 1185: * RETURN AFTER ADJUSTING THE COUNT. ! 1186: * THE END OF FILE RETURN MAY BE USED IF THIS MAKES ! 1187: * SENSE ON THE TARGET MACHINE (E.G. IF THERE IS AN ! 1188: * EOF CHARACTER.) ! 1189: * ! 1190: * (XR) PTR TO 120 CHAR BUFFER (SCBLK PTR) ! 1191: * JSR SYSRI CALL TO READ LINE FROM TERMINAL ! 1192: * PPM LOC END OF FILE RETURN ! 1193: * (WA,WB,WC) MAY BE DESTROYED ! 1194: {{EJC{{{{ ! 1195: * ! 1196: * SYSRW -- REWIND FILE ! 1197: * ! 1198: {SYSRW{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1199: * ! 1200: * SYSRW IS USED TO REWIND A FILE I.E. REPOSITION THE FILE ! 1201: * AT THE START BEFORE THE FIRST RECORD. THE FILE SHOULD BE ! 1202: * CLOSED AND THE NEXT READ OR WRITE CALL WILL OPEN THE ! 1203: * FILE AT THE START. ! 1204: * ! 1205: * (WA) PTR TO FCBLK OR ZERO ! 1206: * (XR) REWIND ARG (SCBLK PTR) ! 1207: * JSR SYSRW CALL TO REWIND FILE ! 1208: * PPM LOC RETURN HERE IF FILE DOES NOT EXIST ! 1209: * PPM LOC RETURN HERE IF REWIND NOT ALLOWED ! 1210: * PPM LOC RETURN HERE IF I/O ERROR ! 1211: {{EJC{{{{ ! 1212: * ! 1213: * SYSST -- SET FILE POINTER ! 1214: * ! 1215: {SYSST{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1216: * ! 1217: * SYSST IS CALLED TO CHANGE THE POSITION OF A FILE ! 1218: * POINTER. THIS IS ACCOMPLISHED IN A SYSTEM DEPENDENT ! 1219: * MANNER, AND THUS THE 2ND AND 3RD ARGUMENTS ARE PASSED ! 1220: * UNCONVERTED. ! 1221: * ! 1222: * (WA) FCBLK POINTER ! 1223: * (WB) 2ND ARGUMENT ! 1224: * (WC) 3RD ARGUMENT ! 1225: * JSR SYSST CALL TO SET FILE POINTER ! 1226: * PPM LOC RETURN HERE IF INVALID 2ND ARG ! 1227: * PPM LOC RETURN HERE IF INVALID 3RD ARG ! 1228: * PPM LOC RETURN HERE IF FILE DOES NOT EXIST ! 1229: * PPM LOC RETURN HERE IF SET NOT ALLOWED ! 1230: * PPM LOC RETURN HERE IF I/O ERROR ! 1231: * ! 1232: {{EJC{{{{ ! 1233: * ! 1234: * SYSTM -- GET EXECUTION TIME SO FAR ! 1235: * ! 1236: {SYSTM{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1237: * ! 1238: * SYSTM IS USED TO OBTAIN THE AMOUNT OF EXECUTION TIME ! 1239: * USED SO FAR SINCE SPITBOL WAS GIVEN CONTROL. THE UNITS ! 1240: * ARE DESCRIBED AS MILLISECONDS IN THE SPITBOL OUTPUT, BUT ! 1241: * THE EXACT MEANING IS SYSTEM DEPENDENT. WHERE APPROPRIATE, ! 1242: * THIS VALUE SHOULD RELATE TO PROCESSOR RATHER THAN CLOCK ! 1243: * TIMING VALUES. ! 1244: * ! 1245: * JSR SYSTM CALL TO GET TIMER VALUE ! 1246: * (IA) TIME SO FAR IN MILLISECONDS ! 1247: {{EJC{{{{ ! 1248: * ! 1249: * SYSTT -- TRACE TOGGLE ! 1250: * ! 1251: {SYSTT{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1252: * ! 1253: * CALLED BY SPITBOL FUNCTION TRACE() WITH NO ARGS TO ! 1254: * TOGGLE THE SYSTEM TRACE SWITCH. THIS PERMITS TRACING OF ! 1255: * LABELS IN SPITBOL CODE TO BE TURNED ON OR OFF. ! 1256: * ! 1257: * JSR SYSTT CALL TO TOGGLE TRACE SWITCH ! 1258: {{EJC{{{{ ! 1259: * ! 1260: * SYSUL -- UNLOAD EXTERNAL FUNCTION ! 1261: * ! 1262: {SYSUL{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1263: * ! 1264: * SYSUL IS USED TO UNLOAD A FUNCTION PREVIOUSLY ! 1265: * LOADED WITH A CALL TO SYSLD. ! 1266: * ! 1267: * (XR) PTR TO CONTROL BLOCK (EFBLK) ! 1268: * JSR SYSUL CALL TO UNLOAD FUNCTION ! 1269: * ! 1270: * THE FUNCTION CANNOT BE CALLED FOLLOWING A SYSUL CALL ! 1271: * UNTIL ANOTHER SYSLD CALL IS MADE FOR THE SAME FUNCTION. ! 1272: * ! 1273: * THE EFBLK CONTAINS THE FUNCTION CODE POINTER AND ALSO A ! 1274: * POINTER TO THE VRBLK CONTAINING THE FUNCTION NAME (SEE ! 1275: * DEFINITIONS AND DATA STRUCTURES SECTION). ! 1276: {{EJC{{{{ ! 1277: * ! 1278: * SYSXI -- EXIT TO PRODUCE LOAD MODULE ! 1279: * ! 1280: {SYSXI{EXP{{{{DEFINE EXTERNAL ENTRY POINT ! 1281: * ! 1282: * WHEN SYSXI IS CALLED, XL CONTAINS EITHER A STRING POINTER ! 1283: * OR ZERO. IN THE FORMER CASE, THE STRING GIVES THE ! 1284: * CHARACTER NAME OF A PROGRAM. THE INTENTION IS THAT ! 1285: * SPITBOL EXECUTION SHOULD BE TERMINATED FORTHWITH AND ! 1286: * THE NAMED PROGRAM LOADED AND EXECUTED. THIS TYPE OF CHAIN ! 1287: * EXECUTION IS VERY SYSTEM DEPENDENT AND IMPLEMENTORS MAY ! 1288: * CHOOSE TO OMIT IT OR FIND IT IMPOSSIBLE TO PROVIDE. ! 1289: * IF (XL) IS ZERO,IA CONTAINS ONE OF THE FOLLOWING INTEGERS ! 1290: * ! 1291: * -1, -2, -3 ! 1292: * CREATE IF POSSIBLE A LOAD MODULE CONTAINING ONLY THE ! 1293: * IMPURE AREA OF MEMORY WHICH NEEDS TO BE LOADED WITH ! 1294: * A COMPATIBLE PURE SEGMENT FOR SUBSEQUENT EXECUTIONS. ! 1295: * VERSION NUMBERS TO CHECK COMPATIBILITY SHOULD BE ! 1296: * KEPT IN BOTH SEGMENTS AND CHECKED ON LOADING. ! 1297: * TO ASSIST WITH THIS CHECK, (XR) ON ENTRY IS A ! 1298: * POINTER TO AN SCBLK CONTAINING THE SPITBOL MAJOR ! 1299: * VERSION NUMBER V.V (SEE SYSID). ! 1300: * ! 1301: * 0 IF POSSIBLE, RETURN CONTROL TO JOB CONTROL ! 1302: * COMMAND LEVEL. THE EFFECT IF AVAILABLE WILL BE ! 1303: * SYSTEM DEPENDENT. ! 1304: * ! 1305: * +1, +2, +3 ! 1306: * CREATE IF POSSIBLE A LOAD MODULE FROM ALL OF ! 1307: * MEMORY. IT SHOULD BE POSSIBLE TO LOAD AND EXECUTE ! 1308: * THIS MODULE DIRECTLY. ! 1309: * ! 1310: * IN THE CASE OF SAVED LOAD MODULES, THE STATUS OF OPEN ! 1311: * FILES IS NOT PRESERVED AND IMPLEMENTORS MAY CHOOSE TO ! 1312: * OFFER MEANS OF ATTACHING FILES BEFORE EXECUTION OF LOAD ! 1313: * MODULES STARTS OR LEAVE IT TO THE USER TO INCLUDE ! 1314: * SUITABLE INPUT(), OUTPUT() CALLS IN HIS PROGRAM. ! 1315: * SYSXI SHOULD MAKE A NOTE THAT NO I/O CHANNELS, ! 1316: * INCLUDING STANDARD FILES, HAVE FILES ATTACHED SO THAT ! 1317: * CALLS OF SYSIN, SYSOU, SYSPR, SYSRD SHOULD FAIL UNLESS ! 1318: * NEW ASSOCIATIONS ARE MADE FOR THE LOAD MODULE. ! 1319: * AT LEAST IN THE CASE OF THE STANDARD OUTPUT FILE, IT IS ! 1320: * RECOMMENDED THAT EITHER THE USER BE REQUIRED TO ATTACH ! 1321: * A FILE OR THAT A DEFAULT FILE IS ATTACHED, SINCE THE ! 1322: * PROBLEM OF ERROR MESSAGES GENERATED BY THE LOAD MODULE ! 1323: * IS OTHERWISE SEVERE. AS A LAST RESORT, IF SPITBOL ! 1324: * ATTEMPTS TO WRITE TO THE STANDARD OUTPUT FILE AND GETS A ! 1325: * REPLY INDICATING THAT SUCH OUPUT IS UNACCEPTABLE IT STOPS ! 1326: * BY USING AN ENTRY TO SYSEJ WITH ENDING CODE 998. ! 1327: * AS DESCRIBED BELOW, PASSING OF SOME ARGUMENTS MAKES IT ! 1328: * CLEAR THAT LOAD MODULE WILL USE A STANDARD OUTPUT FILE. ! 1329: * ! 1330: * IF USE IS MADE OF FCBLKS FOR I/O ASSOCIATION, SPITBOL ! 1331: * BUILDS A CHAIN SO THAT THOSE IN USE MAY BE FOUND IN SYSXI ! 1332: * AND SYSEJ. THE NODES ARE 4 WORDS LONG. THIRD WORD ! 1333: * CONTAINS LINK TO NEXT NODE OR 0, FOURTH WORD CONTAINS ! 1334: * FCBLK POINTER. ! 1335: {{EJC{{{{ ! 1336: * ! 1337: * SYSXI (CONTINUED) ! 1338: * ! 1339: * (XL) ZERO OR SCBLK PTR ! 1340: * (XR) PTR TO V.V SCBLK ! 1341: * (IA) SIGNED INTEGER ARGUMENT ! 1342: * (WB) 0 OR PTR TO HEAD OF FCBLK CHAIN ! 1343: * JSR SYSXI CALL TO EXIT ! 1344: * PPM LOC REQUESTED ACTION NOT POSSIBLE ! 1345: * PPM LOC ACTION CAUSED IRRECOVERABLE ERROR ! 1346: * (REGISTERS) SHOULD BE PRESERVED OVER CALL ! 1347: * ! 1348: * LOADING AND RUNNING THE LOAD MODULE OR RETURNING FROM ! 1349: * JCL COMMAND LEVEL CAUSES EXECUTION TO RESUME AT THE POINT ! 1350: * AFTER THE ERROR RETURNS WHICH FOLLOW THE CALL OF SYSXI. ! 1351: * THE VALUE PASSED AS EXIT ARGUMENT IS USED TO INDICATE ! 1352: * OPTIONS REQUIRED ON RESUMPTION OF LOAD MODULE. ! 1353: * +1 OR -1 REQUIRE THAT ON RESUMPTION, SYSID AND SYSPP BE ! 1354: * CALLED AND A HEADING PRINTED ON THE STANDARD OUTPUT FILE. ! 1355: * +2 OR -2 INDICATE THAT SYSPP WILL BE CALLED BUT NOT SYSID ! 1356: * AND NO HEADING WILL BE PUT ON STANDARD OUTPUT FILE. ! 1357: * ABOVE OPTIONS HAVE THE OBVIOUS IMPLICATION THAT A ! 1358: * STANDARD O/P FILE MUST BE PROVIDED FOR THE LOAD MODULE. ! 1359: * +3 OR -3 INDICATE CALLS OF NEITHER SYSID NOR SYSPP ! 1360: * AND NO HEADING WILL BE PLACED ON STANDARD OUTPUT FILE. ! 1361: * NO RETURN FROM SYSXI IS POSSIBLE IF ANOTHER PROGRAM ! 1362: * IS LOADED AND ENTERED. ! 1363: {{EJC{{{{ ! 1364: * ! 1365: * INTRODUCE THE INTERNAL PROCEDURES. ! 1366: * ! 1367: {ACESS{INP{R{1{{ ! 1368: {ACOMP{INP{N{5{{ ! 1369: {ALLOC{INP{E{0{{ ! 1370: {ALOBF{INP{E{0{{ ! 1371: {ALOCS{INP{E{0{{ ! 1372: {ALOST{INP{E{0{{ ! 1373: {APNDB{INP{E{2{{ ! 1374: {ARITH{INP{N{3{{ ! 1375: {ASIGN{INP{R{1{{ ! 1376: {ASINP{INP{R{1{{ ! 1377: {BLKLN{INP{E{0{{ ! 1378: {CDGCG{INP{E{0{{ ! 1379: {CDGEX{INP{R{0{{ ! 1380: {CDGNM{INP{R{0{{ ! 1381: {CDGVL{INP{R{0{{ ! 1382: {CDWRD{INP{E{0{{ ! 1383: {CMGEN{INP{R{0{{ ! 1384: {CMPIL{INP{E{0{{ ! 1385: {CNCRD{INP{E{0{{ ! 1386: {COPYB{INP{N{1{{ ! 1387: {DFFNC{INP{E{0{{ ! 1388: {DTACH{INP{E{0{{ ! 1389: {DTYPE{INP{E{0{{ ! 1390: {DUMPR{INP{E{0{{ ! 1391: {ERMSG{INP{E{0{{ ! 1392: {ERTEX{INP{E{0{{ ! 1393: {EVALI{INP{R{4{{ ! 1394: {EVALP{INP{R{1{{ ! 1395: {EVALS{INP{R{3{{ ! 1396: {EVALX{INP{R{1{{ ! 1397: {EXBLD{INP{E{0{{ ! 1398: {EXPAN{INP{E{0{{ ! 1399: {EXPAP{INP{E{1{{ ! 1400: {EXPDM{INP{N{0{{ ! 1401: {EXPOP{INP{N{0{{ ! 1402: {FLSTG{INP{R{0{{ ! 1403: {GBCOL{INP{E{0{{ ! 1404: {GBCPF{INP{E{0{{ ! 1405: {GTARR{INP{E{1{{ ! 1406: {{EJC{{{{ ! 1407: {GTCOD{INP{E{1{{ ! 1408: {GTEXP{INP{E{1{{ ! 1409: {GTINT{INP{E{1{{ ! 1410: {GTNUM{INP{E{1{{ ! 1411: {GTNVR{INP{E{1{{ ! 1412: {GTPAT{INP{E{1{{ ! 1413: {GTREA{INP{E{1{{ ! 1414: {GTSMI{INP{N{2{{ ! 1415: {GTSTG{INP{N{1{{ ! 1416: {GTVAR{INP{E{1{{ ! 1417: {HASHS{INP{E{0{{ ! 1418: {ICBLD{INP{E{0{{ ! 1419: {IDENT{INP{E{1{{ ! 1420: {INOUT{INP{E{0{{ ! 1421: {INSBF{INP{E{2{{ ! 1422: {IOFCB{INP{N{2{{ ! 1423: {IOPPF{INP{N{0{{ ! 1424: {IOPUT{INP{N{6{{ ! 1425: {KTREX{INP{R{0{{ ! 1426: {KWNAM{INP{N{0{{ ! 1427: {LCOMP{INP{N{5{{ ! 1428: {LISTR{INP{E{0{{ ! 1429: {LISTT{INP{E{0{{ ! 1430: {NEXTS{INP{E{0{{ ! 1431: {PATIN{INP{N{2{{ ! 1432: {PATST{INP{N{1{{ ! 1433: {PBILD{INP{E{0{{ ! 1434: {PCONC{INP{E{0{{ ! 1435: {PCOPY{INP{N{0{{ ! 1436: {PRFLR{INP{E{0{{ ! 1437: {PRFLU{INP{E{0{{ ! 1438: {PRPAR{INP{E{0{{ ! 1439: {PRTCH{INP{E{0{{ ! 1440: {PRTIC{INP{E{0{{ ! 1441: {PRTIS{INP{E{0{{ ! 1442: {PRTIN{INP{E{0{{ ! 1443: {PRTMI{INP{E{0{{ ! 1444: {PRTMX{INP{E{0{{ ! 1445: {PRTNL{INP{R{0{{ ! 1446: {PRTNM{INP{R{0{{ ! 1447: {PRTNV{INP{E{0{{ ! 1448: {PRTPG{INP{E{0{{ ! 1449: {PRTPS{INP{E{0{{ ! 1450: {PRTSN{INP{E{0{{ ! 1451: {PRTST{INP{R{0{{ ! 1452: {{EJC{{{{ ! 1453: {PRTTR{INP{E{0{{ ! 1454: {PRTVL{INP{R{0{{ ! 1455: {PRTVN{INP{E{0{{ ! 1456: {RCBLD{INP{E{0{{ ! 1457: {READR{INP{E{0{{ ! 1458: {SBSTR{INP{E{0{{ ! 1459: {SCANE{INP{E{0{{ ! 1460: {SCNGF{INP{E{0{{ ! 1461: {SETVR{INP{E{0{{ ! 1462: {SORTA{INP{N{0{{ ! 1463: {SORTC{INP{E{1{{ ! 1464: {SORTF{INP{E{0{{ ! 1465: {SORTH{INP{E{0{{ ! 1466: {TFIND{INP{E{1{{ ! 1467: {TRACE{INP{N{2{{ ! 1468: {TRBLD{INP{E{0{{ ! 1469: {TRIMR{INP{E{0{{ ! 1470: {TRXEQ{INP{R{0{{ ! 1471: {XSCAN{INP{E{0{{ ! 1472: {XSCNI{INP{N{2{{ ! 1473: * ! 1474: * INTRODUCE THE INTERNAL ROUTINES ! 1475: * ! 1476: {ARREF{INR{{{{ ! 1477: {CFUNC{INR{{{{ ! 1478: {EXFAL{INR{{{{ ! 1479: {EXINT{INR{{{{ ! 1480: {EXITS{INR{{{{ ! 1481: {EXIXR{INR{{{{ ! 1482: {EXNAM{INR{{{{ ! 1483: {EXNUL{INR{{{{ ! 1484: {EXREA{INR{{{{ ! 1485: {EXSID{INR{{{{ ! 1486: {EXVNM{INR{{{{ ! 1487: {FAILP{INR{{{{ ! 1488: {FLPOP{INR{{{{ ! 1489: {INDIR{INR{{{{ ! 1490: {MATCH{INR{{{{ ! 1491: {RETRN{INR{{{{ ! 1492: {STCOV{INR{{{{ ! 1493: {STMGO{INR{{{{ ! 1494: {STOPR{INR{{{{ ! 1495: {SUCCP{INR{{{{ ! 1496: {SYSAB{INR{{{{ ! 1497: {SYSTU{INR{{{{ ! 1498: {{TTL{S{{{P I T B O L -- DEFINITIONS AND DATA STRUCTURES ! 1499: {{SEC{{{{START OF DEFINITIONS SECTION ! 1500: * ! 1501: * DEFINITIONS OF MACHINE PARAMETERS ! 1502: * ! 1503: * THE MINIMAL TRANSLATOR SHOULD SUPPLY APPROPRIATE VALUES ! 1504: * FOR THE PARTICULAR TARGET MACHINE FOR ALL THE ! 1505: * EQU * ! 1506: * DEFINITIONS GIVEN AT THE START OF THIS SECTION. ! 1507: * ! 1508: {CFP$A{EQU{*{{{NUMBER OF CHARACTERS IN ALPHABET ! 1509: * ! 1510: {CFP$B{EQU{*{{{BYTES/WORD ADDRESSING FACTOR ! 1511: * ! 1512: {CFP$C{EQU{*{{{NUMBER OF CHARACTERS PER WORD ! 1513: * ! 1514: {CFP$F{EQU{*{{{OFFSET IN BYTES TO CHARS IN ! 1515: * SCBLK. SEE SCBLK FORMAT. ! 1516: * ! 1517: {CFP$I{EQU{*{{{NUMBER OF WORDS IN INTEGER CONSTANT ! 1518: * ! 1519: {CFP$M{EQU{*{{{MAX POSITIVE INTEGER IN ONE WORD ! 1520: * ! 1521: {CFP$N{EQU{*{{{NUMBER OF BITS IN ONE WORD ! 1522: * ! 1523: * THE FOLLOWING DEFINITIONS REQUIRE THE SUPPLY OF EITHER ! 1524: * A SINGLE PARAMETER IF REAL ARITHMETIC IS OMITTED OR ! 1525: * THREE PARAMETERS IF REAL ARITHMETIC IS INCLUDED. ! 1526: * ! 1527: * ! 1528: {CFP$R{EQU{*{{{NUMBER OF WORDS IN REAL CONSTANT ! 1529: * ! 1530: {CFP$S{EQU{*{{{NUMBER OF SIG DIGS FOR REAL OUTPUT ! 1531: * ! 1532: {CFP$X{EQU{*{{{MAX DIGITS IN REAL EXPONENT ! 1533: * ! 1534: {MXDGS{EQU{CFP$S+CFP$X{{{MAX DIGITS IN REAL NUMBER ! 1535: * ! 1536: {NSTMX{EQU{MXDGS+5{{{MAX SPACE FOR REAL (FOR +0.E+) ! 1537: * ! 1538: * THE FOLLOWING DEFINITION FOR CFP$U SUPPLIES A REALISTIC ! 1539: * UPPER BOUND ON THE SIZE OF THE ALPHABET. CFP$U IS USED ! 1540: * TO SAVE SPACE IN THE SCANE BSW-IFF-ESW TABLE AND TO EASE ! 1541: * TRANSLATION STORAGE REQUIREMENTS. ! 1542: * ! 1543: {CFP$U{EQU{*{{{REALISTIC UPPER BOUND ON ALPHABET ! 1544: {{EJC{{{{ ! 1545: * ! 1546: * ENVIRONMENT PARAMETERS ! 1547: * ! 1548: * THE SPITBOL PROGRAM IS ESSENTIALLY INDEPENDENT OF ! 1549: * THE DEFINITIONS OF THESE PARAMETERS. HOWEVER, THE ! 1550: * EFFICIENCY OF THE SYSTEM MAY BE AFFECTED. CONSEQUENTLY, ! 1551: * THESE PARAMETERS MAY REQUIRE TUNING FOR A GIVEN VERSION ! 1552: * THE VALUES GIVEN IN COMMENTS HAVE BEEN SUCCESSFULLY USED. ! 1553: * ! 1554: * E$SRS IS THE NUMBER OF WORDS TO RESERVE AT THE END OF ! 1555: * STORAGE FOR END OF RUN PROCESSING. IT SHOULD BE ! 1556: * SET AS SMALL AS POSSIBLE WITHOUT CAUSING MEMORY OVERFLOW ! 1557: * IN CRITICAL SITUATIONS (E.G. MEMORY OVERFLOW TERMINATION) ! 1558: * AND SHOULD THUS RESERVE SUFFICIENT SPACE AT LEAST FOR ! 1559: * AN SCBLK CONTAINING SAY 30 CHARACTERS. ! 1560: * ! 1561: {E$SRS{EQU{*{{{30 WORDS ! 1562: * ! 1563: * E$STS IS THE NUMBER OF WORDS GRABBED IN A CHUNK WHEN ! 1564: * STORAGE IS ALLOCATED IN THE STATIC REGION. THE MINIMUM ! 1565: * PERMITTED VALUE IS 256/CFP$B. LARGER VALUES WILL LEAD ! 1566: * TO INCREASED EFFICIENCY AT THE COST OF WASTING MEMORY. ! 1567: * ! 1568: {E$STS{EQU{*{{{500 WORDS ! 1569: * ! 1570: * E$CBS IS THE SIZE OF CODE BLOCK ALLOCATED INITIALLY AND ! 1571: * THE EXPANSION INCREMENT IF OVERFLOW OCCURS. IF THIS VALUE ! 1572: * IS TOO SMALL OR TOO LARGE, EXCESSIVE GARBAGE COLLECTIONS ! 1573: * WILL OCCUR DURING COMPILATION AND MEMORY MAY BE LOST ! 1574: * IN THE CASE OF A TOO LARGE VALUE. ! 1575: * ! 1576: {E$CBS{EQU{*{{{500 WORDS ! 1577: * ! 1578: * E$HNB IS THE NUMBER OF BUCKET HEADERS IN THE VARIABLE ! 1579: * HASH TABLE. IT SHOULD ALWAYS BE ODD. LARGER VALUES WILL ! 1580: * SPEED UP COMPILATION AND INDIRECT REFERENCES AT THE ! 1581: * EXPENSE OF ADDITIONAL STORAGE FOR THE HASH TABLE ITSELF. ! 1582: * ! 1583: {E$HNB{EQU{*{{{127 BUCKET HEADERS ! 1584: * ! 1585: * E$HNW IS THE MAXIMUM NUMBER OF WORDS OF A STRING ! 1586: * NAME WHICH PARTICIPATE IN THE STRING HASH ALGORITHM. ! 1587: * LARGER VALUES GIVE A BETTER HASH AT THE EXPENSE OF TAKING ! 1588: * LONGER TO COMPUTE THE HASH. THERE IS SOME OPTIMAL VALUE. ! 1589: * ! 1590: {E$HNW{EQU{*{{{6 WORDS ! 1591: * ! 1592: * E$FSP . IF THE AMOUNT OF FREE SPACE LEFT AFTER A GARBAGE ! 1593: * COLLECTION IS SMALL COMPARED TO THE TOTAL AMOUNT OF SPACE ! 1594: * IN USE GARBAGE COLLECTOR THRASHING IS LIKELY TO OCCUR AS ! 1595: * THIS SPACE IS USED UP. E$FSP IS A MEASURE OF THE ! 1596: * MINIMUM PERCENTAGE OF DYNAMIC MEMORY LEFT AS FREE SPACE ! 1597: * BEFORE THE SYSTEM ROUTINE SYSMM IS CALLED TO TRY TO ! 1598: * OBTAIN MORE MEMORY. ! 1599: * ! 1600: {E$FSP{EQU{*{{{15 PERCENT ! 1601: {{EJC{{{{ ! 1602: * ! 1603: * DEFINITIONS OF CODES FOR LETTERS ! 1604: * ! 1605: {CH$LA{EQU{*{{{LETTER A ! 1606: {CH$LB{EQU{*{{{LETTER B ! 1607: {CH$LC{EQU{*{{{LETTER C ! 1608: {CH$LD{EQU{*{{{LETTER D ! 1609: {CH$LE{EQU{*{{{LETTER E ! 1610: {CH$LF{EQU{*{{{LETTER F ! 1611: {CH$LG{EQU{*{{{LETTER G ! 1612: {CH$LH{EQU{*{{{LETTER H ! 1613: {CH$LI{EQU{*{{{LETTER I ! 1614: {CH$LJ{EQU{*{{{LETTER J ! 1615: {CH$LK{EQU{*{{{LETTER K ! 1616: {CH$LL{EQU{*{{{LETTER L ! 1617: {CH$LM{EQU{*{{{LETTER M ! 1618: {CH$LN{EQU{*{{{LETTER N ! 1619: {CH$LO{EQU{*{{{LETTER O ! 1620: {CH$LP{EQU{*{{{LETTER P ! 1621: {CH$LQ{EQU{*{{{LETTER Q ! 1622: {CH$LR{EQU{*{{{LETTER R ! 1623: {CH$LS{EQU{*{{{LETTER S ! 1624: {CH$LT{EQU{*{{{LETTER T ! 1625: {CH$LU{EQU{*{{{LETTER U ! 1626: {CH$LV{EQU{*{{{LETTER V ! 1627: {CH$LW{EQU{*{{{LETTER W ! 1628: {CH$LX{EQU{*{{{LETTER X ! 1629: {CH$LY{EQU{*{{{LETTER Y ! 1630: {CH$L${EQU{*{{{LETTER Z ! 1631: * ! 1632: * DEFINITIONS OF CODES FOR DIGITS ! 1633: * ! 1634: {CH$D0{EQU{*{{{DIGIT 0 ! 1635: {CH$D1{EQU{*{{{DIGIT 1 ! 1636: {CH$D2{EQU{*{{{DIGIT 2 ! 1637: {CH$D3{EQU{*{{{DIGIT 3 ! 1638: {CH$D4{EQU{*{{{DIGIT 4 ! 1639: {CH$D5{EQU{*{{{DIGIT 5 ! 1640: {CH$D6{EQU{*{{{DIGIT 6 ! 1641: {CH$D7{EQU{*{{{DIGIT 7 ! 1642: {CH$D8{EQU{*{{{DIGIT 8 ! 1643: {CH$D9{EQU{*{{{DIGIT 9 ! 1644: {{EJC{{{{ ! 1645: * ! 1646: * DEFINITIONS OF CODES FOR SPECIAL CHARACTERS ! 1647: * ! 1648: * THE NAMES OF THESE CHARACTERS ARE RELATED TO THEIR ! 1649: * ORIGINAL REPRESENTATION IN THE EBCDIC SET CORRESPONDING ! 1650: * TO THE DESCRIPTION IN STANDARD SNOBOL4 MANUALS AND TEXTS. ! 1651: * ! 1652: {CH$AM{EQU{*{{{KEYWORD OPERATOR (AMPERSAND) ! 1653: {CH$AS{EQU{*{{{MULTIPLICATION SYMBOL (ASTERISK) ! 1654: {CH$AT{EQU{*{{{CURSOR POSITION OPERATOR (AT) ! 1655: {CH$BB{EQU{*{{{LEFT ARRAY BRACKET (LESS THAN) ! 1656: {CH$BL{EQU{*{{{BLANK ! 1657: {CH$BR{EQU{*{{{ALTERNATION OPERATOR (VERTICAL BAR) ! 1658: {CH$CL{EQU{*{{{GOTO SYMBOL (COLON) ! 1659: {CH$CM{EQU{*{{{COMMA ! 1660: {CH$DL{EQU{*{{{INDIRECTION OPERATOR (DOLLAR) ! 1661: {CH$DT{EQU{*{{{NAME OPERATOR (DOT) ! 1662: {CH$DQ{EQU{*{{{DOUBLE QUOTE ! 1663: {CH$EQ{EQU{*{{{EQUAL SIGN ! 1664: {CH$EX{EQU{*{{{EXPONENTIATION OPERATOR (EXCLM) ! 1665: {CH$MN{EQU{*{{{MINUS SIGN ! 1666: {CH$NM{EQU{*{{{NUMBER SIGN ! 1667: {CH$NT{EQU{*{{{NEGATION OPERATOR (NOT) ! 1668: {CH$PC{EQU{*{{{PERCENT ! 1669: {CH$PL{EQU{*{{{PLUS SIGN ! 1670: {CH$PP{EQU{*{{{LEFT PARENTHESIS ! 1671: {CH$RB{EQU{*{{{RIGHT ARRAY BRACKET (GRTR THAN) ! 1672: {CH$RP{EQU{*{{{RIGHT PARENTHESIS ! 1673: {CH$QU{EQU{*{{{INTERROGATION OPERATOR (QUESTION) ! 1674: {CH$SL{EQU{*{{{SLASH ! 1675: {CH$SM{EQU{*{{{SEMICOLON ! 1676: {CH$SQ{EQU{*{{{SINGLE QUOTE ! 1677: {CH$UN{EQU{*{{{SPECIAL IDENTIFIER CHAR (UNDERLINE) ! 1678: {CH$OB{EQU{*{{{OPENING BRACKET ! 1679: {CH$CB{EQU{*{{{CLOSING BRACKET ! 1680: {{EJC{{{{ ! 1681: * ! 1682: * REMAINING CHARS ARE OPTIONAL ADDITIONS TO THE STANDARDS. ! 1683: * ! 1684: * TAB CHARACTERS - SYNTACTICALLY EQUIVALENT TO BLANK ! 1685: * ! 1686: {CH$HT{EQU{*{{{HORIZONTAL TAB ! 1687: * ! 1688: * LOWER CASE OR SHIFTED CASE ALPHABETIC CHARS ! 1689: * ! 1690: {CH$$A{EQU{*{{{SHIFTED A ! 1691: {CH$$B{EQU{*{{{SHIFTED B ! 1692: {CH$$C{EQU{*{{{SHIFTED C ! 1693: {CH$$D{EQU{*{{{SHIFTED D ! 1694: {CH$$E{EQU{*{{{SHIFTED E ! 1695: {CH$$F{EQU{*{{{SHIFTED F ! 1696: {CH$$G{EQU{*{{{SHIFTED G ! 1697: {CH$$H{EQU{*{{{SHIFTED H ! 1698: {CH$$I{EQU{*{{{SHIFTED I ! 1699: {CH$$J{EQU{*{{{SHIFTED J ! 1700: {CH$$K{EQU{*{{{SHIFTED K ! 1701: {CH$$L{EQU{*{{{SHIFTED L ! 1702: {CH$$M{EQU{*{{{SHIFTED M ! 1703: {CH$$N{EQU{*{{{SHIFTED N ! 1704: {CH$$O{EQU{*{{{SHIFTED O ! 1705: {CH$$P{EQU{*{{{SHIFTED P ! 1706: {CH$$Q{EQU{*{{{SHIFTED Q ! 1707: {CH$$R{EQU{*{{{SHIFTED R ! 1708: {CH$$S{EQU{*{{{SHIFTED S ! 1709: {CH$$T{EQU{*{{{SHIFTED T ! 1710: {CH$$U{EQU{*{{{SHIFTED U ! 1711: {CH$$V{EQU{*{{{SHIFTED V ! 1712: {CH$$W{EQU{*{{{SHIFTED W ! 1713: {CH$$X{EQU{*{{{SHIFTED X ! 1714: {CH$$Y{EQU{*{{{SHIFTED Y ! 1715: {CH$$${EQU{*{{{SHIFTED Z ! 1716: * IF A DELIMITER OTHER THAN CH$CM MUST BE USED IN ! 1717: * THE THIRD ARGUMENT OF INPUT(),OUTPUT() THEN .CIOD SHOULD ! 1718: * BE DEFINED AND A PARAMETER SUPPLIED FOR IODEL. ! 1719: * ! 1720: {IODEL{EQU{*{{{ ! 1721: {{EJC{{{{ ! 1722: * ! 1723: * DATA BLOCK FORMATS AND DEFINITIONS ! 1724: * ! 1725: * THE FOLLOWING SECTIONS DESCRIBE THE DETAILED FORMAT OF ! 1726: * ALL POSSIBLE DATA BLOCKS IN STATIC AND DYNAMIC MEMORY. ! 1727: * ! 1728: * EVERY BLOCK HAS A NAME OF THE FORM XXBLK WHERE XX IS A ! 1729: * UNIQUE TWO CHARACTER IDENTIFIER. THE FIRST WORD OF EVERY ! 1730: * BLOCK MUST CONTAIN A POINTER TO A PROGRAM LOCATION IN THE ! 1731: * INTERPRETOR WHICH IS IMMEDIATELY PRECEDED BY AN ADDRESS ! 1732: * CONSTANT CONTAINING THE VALUE BL$XX WHERE XX IS THE BLOCK ! 1733: * IDENTIFIER. THIS PROVIDES A UNIFORM MECHANISM FOR ! 1734: * DISTINGUISHING BETWEEN THE VARIOUS BLOCK TYPES. ! 1735: * ! 1736: * IN SOME CASES, THE CONTENTS OF THE FIRST WORD IS CONSTANT ! 1737: * FOR A GIVEN BLOCK TYPE AND MERELY SERVES AS A POINTER ! 1738: * TO THE IDENTIFYING ADDRESS CONSTANT. HOWEVER, IN OTHER ! 1739: * CASES THERE ARE SEVERAL POSSIBILITIES FOR THE FIRST ! 1740: * WORD IN WHICH CASE EACH OF THE SEVERAL PROGRAM ENTRY ! 1741: * POINTS MUST BE PRECEDED BY THE APPROPRIATE CONSTANT. ! 1742: * ! 1743: * IN EACH BLOCK, SOME OF THE FIELDS ARE RELOCATABLE. THIS ! 1744: * MEANS THAT THEY MAY CONTAIN A POINTER TO ANOTHER BLOCK ! 1745: * IN THE DYNAMIC AREA. (TO BE MORE PRECISE, IF THEY CONTAIN ! 1746: * A POINTER WITHIN THE DYNAMIC AREA, THEN IT IS A POINTER ! 1747: * TO A BLOCK). SUCH FIELDS MUST BE MODIFIED BY THE GARBAGE ! 1748: * COLLECTOR (PROCEDURE GBCOL) WHENEVER BLOCKS ARE COMPACTED ! 1749: * IN THE DYNAMIC REGION. THE GARBAGE COLLECTOR (ACTUALLY ! 1750: * PROCEDURE GBCPF) REQUIRES THAT ALL SUCH RELOCATABLE ! 1751: * FIELDS IN A BLOCK MUST BE CONTIGUOUS. ! 1752: {{EJC{{{{ ! 1753: * ! 1754: * THE DESCRIPTION FORMAT USES THE FOLLOWING SCHEME. ! 1755: * ! 1756: * 1) BLOCK TITLE AND TWO CHARACTER IDENTIFIER ! 1757: * ! 1758: * 2) DESCRIPTION OF BASIC USE OF BLOCK AND INDICATION ! 1759: * OF CIRCUMSTANCES UNDER WHICH IT IS CONSTRUCTED. ! 1760: * ! 1761: * 3) PICTURE OF THE BLOCK FORMAT. IN THESE PICTURES LOW ! 1762: * MEMORY ADDRESSES ARE AT THE TOP OF THE PAGE. FIXED ! 1763: * LENGTH FIELDS ARE SURROUNDED BY I (LETTER I). FIELDS ! 1764: * WHICH ARE FIXED LENGTH BUT WHOSE LENGTH IS DEPENDENT ! 1765: * ON A CONFIGURATION PARAMETER ARE SURROUNDED BY * ! 1766: * (ASTERISK). VARIABLE LENGTH FIELDS ARE SURROUNDED ! 1767: * BY / (SLASH). ! 1768: * ! 1769: * 4) DEFINITION OF SYMBOLIC OFFSETS TO FIELDS IN ! 1770: * BLOCK AND OF THE SIZE OF THE BLOCK IF FIXED LENGTH ! 1771: * OR OF THE SIZE OF THE FIXED LENGTH FIELDS IF THE ! 1772: * BLOCK IS VARIABLE LENGTH. ! 1773: * NOTE THAT SOME ROUTINES SUCH AS GBCPF ASSUME ! 1774: * CERTAIN OFFSETS ARE EQUAL. THE DEFINITIONS ! 1775: * GIVEN HERE ENFORCE THIS. MAKE CHANGES TO ! 1776: * THEM ONLY WITH DUE CARE. ! 1777: * ! 1778: * DEFINITIONS OF COMMON OFFSETS ! 1779: * ! 1780: {OFFS1{EQU{1{{{ ! 1781: {OFFS2{EQU{2{{{ ! 1782: {OFFS3{EQU{3{{{ ! 1783: * ! 1784: * 5) DETAILED COMMENTS ON THE SIGNIFICANCE AND FORMATS ! 1785: * OF THE VARIOUS FIELDS. ! 1786: * ! 1787: * THE ORDER IS ALPHABETICAL BY IDENTIFICATION CODE. ! 1788: {{EJC{{{{ ! 1789: * ! 1790: * DEFINITIONS OF BLOCK CODES ! 1791: * ! 1792: * THIS TABLE PROVIDES A UNIQUE IDENTIFICATION CODE FOR ! 1793: * EACH SEPARATE BLOCK TYPE. THE FIRST WORD OF A BLOCK IN ! 1794: * THE DYNAMIC AREA ALWAYS CONTAINS THE ADDRESS OF A PROGRAM ! 1795: * ENTRY POINT. THE BLOCK CODE IS USED AS THE ENTRY POINT ID ! 1796: * THE ORDER OF THESE CODES DICTATES THE ORDER OF THE TABLE ! 1797: * USED BY THE DATATYPE FUNCTION (SCNMT IN THE CONSTANT SEC) ! 1798: * ! 1799: * BLOCK CODES FOR ACCESSIBLE DATATYPES ! 1800: * ! 1801: {BL$AR{EQU{0{{{ARBLK ARRAY ! 1802: {BL$BC{EQU{BL$AR+1{{{BCBLK BUFFER ! 1803: {BL$CD{EQU{BL$BC+1{{{CDBLK CODE ! 1804: {BL$EX{EQU{BL$CD+1{{{EXBLK EXPRESSION ! 1805: {BL$IC{EQU{BL$EX+1{{{ICBLK INTEGER ! 1806: {BL$NM{EQU{BL$IC+1{{{NMBLK NAME ! 1807: {BL$P0{EQU{BL$NM+1{{{P0BLK PATTERN ! 1808: {BL$P1{EQU{BL$P0+1{{{P1BLK PATTERN ! 1809: {BL$P2{EQU{BL$P1+1{{{P2BLK PATTERN ! 1810: {BL$RC{EQU{BL$P2+1{{{RCBLK REAL ! 1811: {BL$SC{EQU{BL$RC+1{{{SCBLK STRING ! 1812: {BL$SE{EQU{BL$SC+1{{{SEBLK EXPRESSION ! 1813: {BL$TB{EQU{BL$SE+1{{{TBBLK TABLE ! 1814: {BL$VC{EQU{BL$TB+1{{{VCBLK ARRAY ! 1815: {BL$XN{EQU{BL$VC+1{{{XNBLK EXTERNAL ! 1816: {BL$XR{EQU{BL$XN+1{{{XRBLK EXTERNAL ! 1817: {BL$PD{EQU{BL$XR+1{{{PDBLK PROGRAM DEFINED DATATYPE ! 1818: * ! 1819: {BL$$D{EQU{BL$PD+1{{{NUMBER OF BLOCK CODES FOR DATA ! 1820: * ! 1821: * OTHER BLOCK CODES ! 1822: * ! 1823: {BL$TR{EQU{BL$PD+1{{{TRBLK ! 1824: {BL$BF{EQU{BL$TR+1{{{BFBLK ! 1825: {BL$CC{EQU{BL$BF+1{{{CCBLK ! 1826: {BL$CM{EQU{BL$CC+1{{{CMBLK ! 1827: {BL$CT{EQU{BL$CM+1{{{CTBLK ! 1828: {BL$DF{EQU{BL$CT+1{{{DFBLK ! 1829: {BL$EF{EQU{BL$DF+1{{{EFBLK ! 1830: {BL$EV{EQU{BL$EF+1{{{EVBLK ! 1831: {BL$FF{EQU{BL$EV+1{{{FFBLK ! 1832: {BL$KV{EQU{BL$FF+1{{{KVBLK ! 1833: {BL$PF{EQU{BL$KV+1{{{PFBLK ! 1834: {BL$TE{EQU{BL$PF+1{{{TEBLK ! 1835: * ! 1836: {BL$$I{EQU{0{{{DEFAULT IDENTIFICATION CODE ! 1837: {BL$$T{EQU{BL$TR+1{{{CODE FOR DATA OR TRACE BLOCK ! 1838: {BL$$${EQU{BL$TE+1{{{NUMBER OF BLOCK CODES ! 1839: {{EJC{{{{ ! 1840: * ! 1841: * FIELD REFERENCES ! 1842: * ! 1843: * REFERENCES TO THE FIELDS OF DATA BLOCKS ARE SYMBOLIC ! 1844: * (I.E. USE THE SYMBOLIC OFFSETS) WITH THE FOLLOWING ! 1845: * EXCEPTIONS. ! 1846: * ! 1847: * 1) REFERENCES TO THE FIRST WORD ARE USUALLY NOT ! 1848: * SYMBOLIC SINCE THEY USE THE (X) OPERAND FORMAT. ! 1849: * ! 1850: * 2) THE CODE WHICH CONSTRUCTS A BLOCK IS OFTEN NOT ! 1851: * SYMBOLIC AND SHOULD BE CHANGED IF THE CORRESPONDING ! 1852: * BLOCK FORMAT IS MODIFIED. ! 1853: * ! 1854: * 3) THE PLC AND PSC INSTRUCTIONS IMPLY AN OFFSET ! 1855: * CORRESPONDING TO THE DEFINITION OF CFP$F. ! 1856: * ! 1857: * 4) THERE ARE NON-SYMBOLIC REFERENCES (EASILY CHANGED) ! 1858: * IN THE GARBAGE COLLECTOR (PROCEDURES GBCPF, BLKLN). ! 1859: * ! 1860: * 5) THE FIELDS IDVAL, FARGS APPEAR IN SEVERAL BLOCKS ! 1861: * AND ANY CHANGES MUST BE MADE IN PARALLEL TO ALL ! 1862: * BLOCKS CONTAINING THE FIELDS. THE ACTUAL REFERENCES ! 1863: * TO THESE FIELDS ARE SYMBOLIC WITH THE ABOVE ! 1864: * LISTED EXCEPTIONS. ! 1865: * ! 1866: * 6) SEVERAL SPOTS IN THE CODE ASSUME THAT THE ! 1867: * DEFINITIONS OF THE FIELDS VRVAL, TEVAL, TRNXT ARE ! 1868: * THE SAME (THESE ARE SECTIONS OF CODE WHICH SEARCH ! 1869: * OUT ALONG A TRBLK CHAIN FROM A VARIABLE). ! 1870: * ! 1871: * 7) REFERENCES TO THE FIELDS OF AN ARRAY BLOCK IN THE ! 1872: * ARRAY REFERENCE ROUTINE ARREF ARE NON-SYMBOLIC. ! 1873: * ! 1874: * APART FROM THE EXCEPTIONS LISTED, REFERENCES ARE SYMBOLIC ! 1875: * AS FAR AS POSSIBLE AND MODIFYING THE ORDER OR NUMBER ! 1876: * OF FIELDS WILL NOT REQUIRE CHANGES. ! 1877: {{EJC{{{{ ! 1878: * ! 1879: * COMMON FIELDS FOR FUNCTION BLOCKS ! 1880: * ! 1881: * BLOCKS WHICH REPRESENT CALLABLE FUNCTIONS HAVE TWO ! 1882: * COMMON FIELDS AT THE START OF THE BLOCK AS FOLLOWS. ! 1883: * ! 1884: * +------------------------------------+ ! 1885: * I FCODE I ! 1886: * +------------------------------------+ ! 1887: * I FARGS I ! 1888: * +------------------------------------+ ! 1889: * / / ! 1890: * / REST OF FUNCTION BLOCK / ! 1891: * / / ! 1892: * +------------------------------------+ ! 1893: * ! 1894: {FCODE{EQU{0{{{POINTER TO CODE FOR FUNCTION ! 1895: {FARGS{EQU{1{{{NUMBER OF ARGUMENTS ! 1896: * ! 1897: * FCODE IS A POINTER TO THE LOCATION IN THE INTERPRETOR ! 1898: * PROGRAM WHICH PROCESSES THIS TYPE OF FUNCTION CALL. ! 1899: * ! 1900: * FARGS IS THE EXPECTED NUMBER OF ARGUMENTS. THE ACTUAL ! 1901: * NUMBER OF ARGUMENTS IS ADJUSTED TO THIS AMOUNT BY ! 1902: * DELETING EXTRA ARGUMENTS OR SUPPLYING TRAILING NULLS ! 1903: * FOR MISSING ONES BEFORE TRANSFERRING THOUGH FCODE. ! 1904: * A VALUE OF 999 MAY BE USED IN THIS FIELD TO INDICATE A ! 1905: * VARIABLE NUMBER OF ARGUMENTS (SEE SVBLK FIELD SVNAR). ! 1906: * ! 1907: * THE BLOCK TYPES WHICH FOLLOW THIS SCHEME ARE. ! 1908: * ! 1909: * FFBLK FIELD FUNCTION ! 1910: * DFBLK DATATYPE FUNCTION ! 1911: * PFBLK PROGRAM DEFINED FUNCTION ! 1912: * EFBLK EXTERNAL LOADED FUNCTION ! 1913: {{EJC{{{{ ! 1914: * ! 1915: * IDENTIFICATION FIELD ! 1916: * ! 1917: * ! 1918: * ID FIELD ! 1919: * ! 1920: * CERTAIN PROGRAM ACCESSIBLE OBJECTS (THOSE WHICH CONTAIN ! 1921: * OTHER DATA VALUES AND CAN BE COPIED) ARE GIVEN A UNIQUE ! 1922: * IDENTIFICATION NUMBER (SEE EXSID). THIS ID VALUE IS AN ! 1923: * ADDRESS INTEGER VALUE WHICH IS ALWAYS STORED IN WORD TWO. ! 1924: * ! 1925: {IDVAL{EQU{1{{{ID VALUE FIELD ! 1926: * ! 1927: * THE BLOCKS CONTAINING AN IDVAL FIELD ARE. ! 1928: * ! 1929: * ARBLK ARRAY ! 1930: * BCBLK BUFFER CONTROL BLOCK ! 1931: * PDBLK PROGRAM DEFINED DATATYPE ! 1932: * TBBLK TABLE ! 1933: * VCBLK VECTOR BLOCK (ARRAY) ! 1934: * ! 1935: * NOTE THAT A ZERO IDVAL MEANS THAT THE BLOCK IS ONLY ! 1936: * HALF BUILT AND SHOULD NOT BE DUMPED (SEE DUMPR). ! 1937: {{EJC{{{{ ! 1938: * ! 1939: * ARRAY BLOCK (ARBLK) ! 1940: * ! 1941: * AN ARRAY BLOCK REPRESENTS AN ARRAY VALUE OTHER THAN ONE ! 1942: * WITH ONE DIMENSION WHOSE LOWER BOUND IS ONE (SEE VCBLK). ! 1943: * AN ARBLK IS BUILT WITH A CALL TO THE FUNCTIONS CONVERT ! 1944: * (S$CNV) OR ARRAY (S$ARR). ! 1945: * ! 1946: * +------------------------------------+ ! 1947: * I ARTYP I ! 1948: * +------------------------------------+ ! 1949: * I IDVAL I ! 1950: * +------------------------------------+ ! 1951: * I ARLEN I ! 1952: * +------------------------------------+ ! 1953: * I AROFS I ! 1954: * +------------------------------------+ ! 1955: * I ARNDM I ! 1956: * +------------------------------------+ ! 1957: * * ARLBD * ! 1958: * +------------------------------------+ ! 1959: * * ARDIM * ! 1960: * +------------------------------------+ ! 1961: * * * ! 1962: * * ABOVE 2 FLDS REPEATED FOR EACH DIM * ! 1963: * * * ! 1964: * +------------------------------------+ ! 1965: * I ARPRO I ! 1966: * +------------------------------------+ ! 1967: * / / ! 1968: * / ARVLS / ! 1969: * / / ! 1970: * +------------------------------------+ ! 1971: {{EJC{{{{ ! 1972: * ! 1973: * ARRAY BLOCK (CONTINUED) ! 1974: * ! 1975: {ARTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$ART ! 1976: {ARLEN{EQU{IDVAL+1{{{LENGTH OF ARBLK IN BYTES ! 1977: {AROFS{EQU{ARLEN+1{{{OFFSET IN ARBLK TO ARPRO FIELD ! 1978: {ARNDM{EQU{AROFS+1{{{NUMBER OF DIMENSIONS ! 1979: {ARLBD{EQU{ARNDM+1{{{LOW BOUND (FIRST SUBSCRIPT) ! 1980: {ARDIM{EQU{ARLBD+CFP$I{{{DIMENSION (FIRST SUBSCRIPT) ! 1981: {ARLB2{EQU{ARDIM+CFP$I{{{LOW BOUND (SECOND SUBSCRIPT) ! 1982: {ARDM2{EQU{ARLB2+CFP$I{{{DIMENSION (SECOND SUBSCRIPT) ! 1983: {ARPRO{EQU{ARDIM+CFP$I{{{ARRAY PROTOTYPE (ONE DIMENSION) ! 1984: {ARVLS{EQU{ARPRO+1{{{START OF VALUES (ONE DIMENSION) ! 1985: {ARPR2{EQU{ARDM2+CFP$I{{{ARRAY PROTOTYPE (TWO DIMENSIONS) ! 1986: {ARVL2{EQU{ARPR2+1{{{START OF VALUES (TWO DIMENSIONS) ! 1987: {ARSI${EQU{ARLBD{{{NUMBER OF STANDARD FIELDS IN BLOCK ! 1988: {ARDMS{EQU{ARLB2-ARLBD{{{SIZE OF INFO FOR ONE SET OF BOUNDS ! 1989: * ! 1990: * THE BOUNDS AND DIMENSION FIELDS ARE SIGNED INTEGER ! 1991: * VALUES AND EACH OCCUPY CFP$I WORDS IN THE ARBLK. ! 1992: * ! 1993: * THE LENGTH OF AN ARBLK IN BYTES MAY NOT EXCEED MXLEN. ! 1994: * THIS IS REQUIRED TO KEEP NAME OFFSETS GARBAGE COLLECTABLE ! 1995: * ! 1996: * THE ACTUAL VALUES ARE ARRANGED IN ROW-WISE ORDER AND ! 1997: * CAN CONTAIN A DATA POINTER OR A POINTER TO A TRBLK. ! 1998: * ! 1999: * BUFFER CONTROL BLOCK (BCBLK) ! 2000: * ! 2001: * A BCBLK IS BUILT FOR EVERY BFBLK. ! 2002: * ! 2003: * +------------------------------------+ ! 2004: * I BCTYP I ! 2005: * +------------------------------------+ ! 2006: * I IDVAL I ! 2007: * +------------------------------------+ ! 2008: * I BCLEN I ! 2009: * +------------------------------------+ ! 2010: * I BCBUF I ! 2011: * +------------------------------------+ ! 2012: * ! 2013: {BCTYP{EQU{0{{{PTR TO DUMMY ROUTINE B$BCT ! 2014: {BCLEN{EQU{IDVAL+1{{{DEFINED BUFFER LENGTH ! 2015: {BCBUF{EQU{BCLEN+1{{{PTR TO BFBLK ! 2016: {BCSI${EQU{BCBUF+1{{{SIZE OF BCBLK ! 2017: * ! 2018: * A BCBLK IS AN INDIRECT CONTROL HEADER FOR BFBLK. ! 2019: * THE REASON FOR NOT STORING THIS DATA DIRECTLY ! 2020: * IN THE RELATED BFBLK IS SO THAT THE BFBLK CAN ! 2021: * MAINTAIN THE SAME SKELETAL STRUCTURE AS AN SCBLK ! 2022: * THUS FACILITATING TRANSPARENT STRING OPERATIONS ! 2023: * (FOR THE MOST PART). SPECIFICALLY, CFP$F IS THE ! 2024: * SAME FOR A BFBLK AS FOR AN SCBLK. BY CONVENTION, ! 2025: * WHEREEVER A BUFFER VALUE IS EMPLOYED, THE BCBLK ! 2026: * IS POINTED TO. ! 2027: * ! 2028: * THE CORRESPONDING BFBLK IS POINTED TO BY THE ! 2029: * BCBUF POINTER IN THE BCBLK. ! 2030: * ! 2031: * BCLEN IS THE CURRENT DEFINED SIZE OF THE CHARACTER ! 2032: * ARRAY IN THE BFBLK. CHARACTERS FOLLOWING THE OFFSET ! 2033: * OF BCLEN ARE UNDEFINED. ! 2034: * ! 2035: {{EJC{{{{ ! 2036: * ! 2037: * STRING BUFFER BLOCK (BFBLK) ! 2038: * ! 2039: * A BFBLK IS BUILT BY A CALL TO BUFFER(...) ! 2040: * ! 2041: * +------------------------------------+ ! 2042: * I BFTYP I ! 2043: * +------------------------------------+ ! 2044: * I BFALC I ! 2045: * +------------------------------------+ ! 2046: * / / ! 2047: * / BFCHR / ! 2048: * / / ! 2049: * +------------------------------------+ ! 2050: * ! 2051: {BFTYP{EQU{0{{{PTR TO DUMMY ROUTINE B$BFT ! 2052: {BFALC{EQU{BFTYP+1{{{ALLOCATED SIZE OF BUFFER ! 2053: {BFCHR{EQU{BFALC+1{{{CHARACTERS OF STRING ! 2054: {BFSI${EQU{BFCHR{{{SIZE OF STANDARD FIELDS IN BFBLK ! 2055: * ! 2056: * THE CHARACTERS IN THE BUFFER ARE STORED LEFT JUSTIFIED. ! 2057: * THE FINAL WORD OF DEFINED CHARACTERS IS ALWAYS ZERO ! 2058: * (CHARACTER) PADDED. ANY TRAILING ALLOCATION PAST THE ! 2059: * WORD CONTAINING THE LAST CHARACTER CONTAINS ! 2060: * UNPREDICTABLE CONTENTS AND IS NEVER REFERENCED. ! 2061: * ! 2062: * NOTE THAT THE OFFSET TO THE CHARACTERS OF THE STRING ! 2063: * IS GIVEN BY CFP$F, AS WITH AN SCBLK. HOWEVER, THE ! 2064: * OFFSET WHICH IS OCCUPIED BY THE LENGTH FOR AN SCBLK ! 2065: * IS THE TOTAL CHAR SPACE FOR BFBLKS, AND ROUTINES WHICH ! 2066: * DEAL WITH BOTH MUST ACCOUNT FOR THIS DIFFERENCE. ! 2067: * ! 2068: * THE VALUE OF BFALC MAY NOT EXCEED MXLEN. THE VALUE OF ! 2069: * BCLEN IS ALWAYS LESS THAN OR EQUAL TO BFALC. ! 2070: * ! 2071: {{EJC{{{{ ! 2072: * ! 2073: * CODE CONSTRUCTION BLOCK (CCBLK) ! 2074: * ! 2075: * AT ANY ONE MOMENT THERE IS AT MOST ONE CCBLK INTO ! 2076: * WHICH THE COMPILER IS CURRENTLY STORING CODE (CDWRD). ! 2077: * ! 2078: * +------------------------------------+ ! 2079: * I CCTYP I ! 2080: * +------------------------------------+ ! 2081: * I CCLEN I ! 2082: * +------------------------------------+ ! 2083: * I CCUSE I ! 2084: * +------------------------------------+ ! 2085: * / / ! 2086: * / CCCOD / ! 2087: * / / ! 2088: * +------------------------------------+ ! 2089: * ! 2090: {CCTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$CCT ! 2091: {CCLEN{EQU{CCTYP+1{{{LENGTH OF CCBLK IN BYTES ! 2092: {CCUSE{EQU{CCLEN+1{{{OFFSET PAST LAST USED WORD (BYTES) ! 2093: {CCCOD{EQU{CCUSE+1{{{START OF GENERATED CODE IN BLOCK ! 2094: * ! 2095: * THE REASON THAT THE CCBLK IS A SEPARATE BLOCK TYPE FROM ! 2096: * THE USUAL CDBLK IS THAT THE GARBAGE COLLECTOR MUST ! 2097: * ONLY PROCESS THOSE FIELDS WHICH HAVE BEEN SET (SEE GBCPF) ! 2098: {{EJC{{{{ ! 2099: * ! 2100: * CODE BLOCK (CDBLK) ! 2101: * ! 2102: * A CODE BLOCK IS BUILT FOR EACH STATEMENT COMPILED DURING ! 2103: * THE INITIAL COMPILATION OR BY SUBSEQUENT CALLS TO CODE. ! 2104: * ! 2105: * +------------------------------------+ ! 2106: * I CDJMP I ! 2107: * +------------------------------------+ ! 2108: * I CDSTM I ! 2109: * +------------------------------------+ ! 2110: * I CDLEN I ! 2111: * +------------------------------------+ ! 2112: * I CDFAL I ! 2113: * +------------------------------------+ ! 2114: * / / ! 2115: * / CDCOD / ! 2116: * / / ! 2117: * +------------------------------------+ ! 2118: * ! 2119: {CDJMP{EQU{0{{{PTR TO ROUTINE TO EXECUTE STATEMENT ! 2120: {CDSTM{EQU{CDJMP+1{{{STATEMENT NUMBER ! 2121: {CDLEN{EQU{OFFS2{{{LENGTH OF CDBLK IN BYTES ! 2122: {CDFAL{EQU{OFFS3{{{FAILURE EXIT (SEE BELOW) ! 2123: {CDCOD{EQU{CDFAL+1{{{EXECUTABLE PSEUDO-CODE ! 2124: {CDSI${EQU{CDCOD{{{NUMBER OF STANDARD FIELDS IN CDBLK ! 2125: * ! 2126: * CDSTM IS THE STATEMENT NUMBER OF THE CURRENT STATEMENT. ! 2127: * ! 2128: * CDJMP, CDFAL ARE SET AS FOLLOWS. ! 2129: * ! 2130: * 1) IF THE FAILURE EXIT IS THE NEXT STATEMENT ! 2131: * ! 2132: * CDJMP = B$CDS ! 2133: * CDFAL = PTR TO CDBLK FOR NEXT STATEMENT ! 2134: * ! 2135: * 2) IF THE FAILURE EXIT IS A SIMPLE LABEL NAME ! 2136: * ! 2137: * CDJMP = B$CDS ! 2138: * CDFAL IS A PTR TO THE VRTRA FIELD OF THE VRBLK ! 2139: * ! 2140: * 3) IF THERE IS NO FAILURE EXIT (-NOFAIL MODE) ! 2141: * ! 2142: * CDJMP = B$CDS ! 2143: * CDFAL = O$UNF ! 2144: * ! 2145: * 4) IF THE FAILURE EXIT IS COMPLEX OR DIRECT ! 2146: * ! 2147: * CDJMP = B$CDC ! 2148: * CDFAL IS THE OFFSET TO THE O$GOF WORD ! 2149: {{EJC{{{{ ! 2150: * ! 2151: * CODE BLOCK (CONTINUED) ! 2152: * ! 2153: * CDCOD IS THE START OF THE ACTUAL CODE. FIRST WE DESCRIBE ! 2154: * THE CODE GENERATED FOR AN EXPRESSION. IN AN EXPRESSION, ! 2155: * ELEMENTS ARE FETCHED BY NAME OR BY VALUE. FOR EXAMPLE, ! 2156: * THE BINARY EQUAL OPERATOR FETCHES ITS LEFT ARGUMENT ! 2157: * BY NAME AND ITS RIGHT ARGUMENT BY VALUE. THESE TWO ! 2158: * CASES GENERATE QUITE DIFFERENT CODE AND ARE DESCRIBED ! 2159: * SEPARATELY. FIRST WE CONSIDER THE CODE BY VALUE CASE. ! 2160: * ! 2161: * GENERATION OF CODE BY VALUE FOR EXPRESSIONS ELEMENTS. ! 2162: * ! 2163: * EXPRESSION POINTER TO EXBLK OR SEBLK ! 2164: * ! 2165: * INTEGER CONSTANT POINTER TO ICBLK ! 2166: * ! 2167: * NULL CONSTANT POINTER TO NULLS ! 2168: * ! 2169: * PATTERN (RESULTING FROM PREEVALUATION) ! 2170: * =O$LPT ! 2171: * POINTER TO P0BLK,P1BLK OR P2BLK ! 2172: * ! 2173: * REAL CONSTANT POINTER TO RCBLK ! 2174: * ! 2175: * STRING CONSTANT POINTER TO SCBLK ! 2176: * ! 2177: * VARIABLE POINTER TO VRGET FIELD OF VRBLK ! 2178: * ! 2179: * ADDITION VALUE CODE FOR LEFT OPERAND ! 2180: * VALUE CODE FOR RIGHT OPERAND ! 2181: * =O$ADD ! 2182: * ! 2183: * AFFIRMATION VALUE CODE FOR OPERAND ! 2184: * =O$AFF ! 2185: * ! 2186: * ALTERNATION VALUE CODE FOR LEFT OPERAND ! 2187: * VALUE CODE FOR RIGHT OPERAND ! 2188: * =O$ALT ! 2189: * ! 2190: * ARRAY REFERENCE (CASE OF ONE SUBSCRIPT) ! 2191: * VALUE CODE FOR ARRAY OPERAND ! 2192: * VALUE CODE FOR SUBSCRIPT OPERAND ! 2193: * =O$AOV ! 2194: * ! 2195: * (CASE OF MORE THAN ONE SUBSCRIPT) ! 2196: * VALUE CODE FOR ARRAY OPERAND ! 2197: * VALUE CODE FOR FIRST SUBSCRIPT ! 2198: * VALUE CODE FOR SECOND SUBSCRIPT ! 2199: * ... ! 2200: * VALUE CODE FOR LAST SUBSCRIPT ! 2201: * =O$AMV ! 2202: * NUMBER OF SUBSCRIPTS ! 2203: {{EJC{{{{ ! 2204: * ! 2205: * CODE BLOCK (CONTINUED) ! 2206: * ! 2207: * ASSIGNMENT (TO NATURAL VARIABLE) ! 2208: * VALUE CODE FOR RIGHT OPERAND ! 2209: * POINTER TO VRSTO FIELD OF VRBLK ! 2210: * ! 2211: * (TO ANY OTHER VARIABLE) ! 2212: * NAME CODE FOR LEFT OPERAND ! 2213: * VALUE CODE FOR RIGHT OPERAND ! 2214: * =O$ASS ! 2215: * ! 2216: * COMPILE ERROR =O$CER ! 2217: * ! 2218: * ! 2219: * COMPLEMENTATION VALUE CODE FOR OPERAND ! 2220: * =O$COM ! 2221: * ! 2222: * CONCATENATION (CASE OF PRED FUNC LEFT OPERAND) ! 2223: * VALUE CODE FOR LEFT OPERAND ! 2224: * =O$POP ! 2225: * VALUE CODE FOR RIGHT OPERAND ! 2226: * ! 2227: * (ALL OTHER CASES) ! 2228: * VALUE CODE FOR LEFT OPERAND ! 2229: * VALUE CODE FOR RIGHT OPERAND ! 2230: * =O$CNC ! 2231: * ! 2232: * CURSOR ASSIGNMENT NAME CODE FOR OPERAND ! 2233: * =O$CAS ! 2234: * ! 2235: * DIVISION VALUE CODE FOR LEFT OPERAND ! 2236: * VALUE CODE FOR RIGHT OPERAND ! 2237: * =O$DVD ! 2238: * ! 2239: * EXPONENTIATION VALUE CODE FOR LEFT OPERAND ! 2240: * VALUE CODE FOR RIGHT OPERAND ! 2241: * =O$EXP ! 2242: * ! 2243: * FUNCTION CALL (CASE OF CALL TO SYSTEM FUNCTION) ! 2244: * VALUE CODE FOR FIRST ARGUMENT ! 2245: * VALUE CODE FOR SECOND ARGUMENT ! 2246: * ... ! 2247: * VALUE CODE FOR LAST ARGUMENT ! 2248: * POINTER TO SVFNC FIELD OF SVBLK ! 2249: * ! 2250: {{EJC{{{{ ! 2251: * ! 2252: * CODE BLOCK (CONTINUED) ! 2253: * ! 2254: * FUNCTION CALL (CASE OF NON-SYSTEM FUNCTION 1 ARG) ! 2255: * VALUE CODE FOR ARGUMENT ! 2256: * =O$FNS ! 2257: * POINTER TO VRBLK FOR FUNCTION ! 2258: * ! 2259: * (NON-SYSTEM FUNCTION, GT 1 ARG) ! 2260: * VALUE CODE FOR FIRST ARGUMENT ! 2261: * VALUE CODE FOR SECOND ARGUMENT ! 2262: * ... ! 2263: * VALUE CODE FOR LAST ARGUMENT ! 2264: * =O$FNC ! 2265: * NUMBER OF ARGUMENTS ! 2266: * POINTER TO VRBLK FOR FUNCTION ! 2267: * ! 2268: * IMMEDIATE ASSIGNMENT VALUE CODE FOR LEFT OPERAND ! 2269: * NAME CODE FOR RIGHT OPERAND ! 2270: * =O$IMA ! 2271: * ! 2272: * INDIRECTION VALUE CODE FOR OPERAND ! 2273: * =O$INV ! 2274: * ! 2275: * INTERROGATION VALUE CODE FOR OPERAND ! 2276: * =O$INT ! 2277: * ! 2278: * KEYWORD REFERENCE NAME CODE FOR OPERAND ! 2279: * =O$KWV ! 2280: * ! 2281: * MULTIPLICATION VALUE CODE FOR LEFT OPERAND ! 2282: * VALUE CODE FOR RIGHT OPERAND ! 2283: * =O$MLT ! 2284: * ! 2285: * NAME REFERENCE (NATURAL VARIABLE CASE) ! 2286: * POINTER TO NMBLK FOR NAME ! 2287: * ! 2288: * (ALL OTHER CASES) ! 2289: * NAME CODE FOR OPERAND ! 2290: * =O$NAM ! 2291: * ! 2292: * NEGATION =O$NTA ! 2293: * CDBLK OFFSET OF O$NTC WORD ! 2294: * VALUE CODE FOR OPERAND ! 2295: * =O$NTB ! 2296: * =O$NTC ! 2297: {{EJC{{{{ ! 2298: * ! 2299: * CODE BLOCK (CONTINUED) ! 2300: * ! 2301: * PATTERN ASSIGNMENT VALUE CODE FOR LEFT OPERAND ! 2302: * NAME CODE FOR RIGHT OPERAND ! 2303: * =O$PAS ! 2304: * ! 2305: * PATTERN MATCH VALUE CODE FOR LEFT OPERAND ! 2306: * VALUE CODE FOR RIGHT OPERAND ! 2307: * =O$PMV ! 2308: * ! 2309: * PATTERN REPLACEMENT NAME CODE FOR SUBJECT ! 2310: * VALUE CODE FOR PATTERN ! 2311: * =O$PMN ! 2312: * VALUE CODE FOR REPLACEMENT ! 2313: * =O$RPL ! 2314: * ! 2315: * SELECTION (FOR FIRST ALTERNATIVE) ! 2316: * =O$SLA ! 2317: * CDBLK OFFSET TO NEXT O$SLC WORD ! 2318: * VALUE CODE FOR FIRST ALTERNATIVE ! 2319: * =O$SLB ! 2320: * CDBLK OFFSET PAST ALTERNATIVES ! 2321: * ! 2322: * (FOR SUBSEQUENT ALTERNATIVES) ! 2323: * =O$SLC ! 2324: * CDBLK OFFSET TO NEXT O$SLC,O$SLD ! 2325: * VALUE CODE FOR ALTERNATIVE ! 2326: * =O$SLB ! 2327: * OFFSET IN CDBLK PAST ALTERNATIVES ! 2328: * ! 2329: * (FOR LAST ALTERNATIVE) ! 2330: * =O$SLD ! 2331: * VALUE CODE FOR LAST ALTERNATIVE ! 2332: * ! 2333: * SUBTRACTION VALUE CODE FOR LEFT OPERAND ! 2334: * VALUE CODE FOR RIGHT OPERAND ! 2335: * =O$SUB ! 2336: {{EJC{{{{ ! 2337: * ! 2338: * CODE BLOCK (CONTINUED) ! 2339: * ! 2340: * GENERATION OF CODE BY NAME FOR EXPRESSION ELEMENTS. ! 2341: * ! 2342: * VARIABLE =O$LVN ! 2343: * POINTER TO VRBLK ! 2344: * ! 2345: * EXPRESSION (CASE OF *NATURAL VARIABLE) ! 2346: * =O$LVN ! 2347: * POINTER TO VRBLK ! 2348: * ! 2349: * (ALL OTHER CASES) ! 2350: * =O$LEX ! 2351: * POINTER TO EXBLK ! 2352: * ! 2353: * ! 2354: * ARRAY REFERENCE (CASE OF ONE SUBSCRIPT) ! 2355: * VALUE CODE FOR ARRAY OPERAND ! 2356: * VALUE CODE FOR SUBSCRIPT OPERAND ! 2357: * =O$AON ! 2358: * ! 2359: * (CASE OF MORE THAN ONE SUBSCRIPT) ! 2360: * VALUE CODE FOR ARRAY OPERAND ! 2361: * VALUE CODE FOR FIRST SUBSCRIPT ! 2362: * VALUE CODE FOR SECOND SUBSCRIPT ! 2363: * ... ! 2364: * VALUE CODE FOR LAST SUBSCRIPT ! 2365: * =O$AMN ! 2366: * NUMBER OF SUBSCRIPTS ! 2367: * ! 2368: * COMPILE ERROR =O$CER ! 2369: * ! 2370: * FUNCTION CALL (SAME CODE AS FOR VALUE CALL) ! 2371: * =O$FNE ! 2372: * ! 2373: * INDIRECTION VALUE CODE FOR OPERAND ! 2374: * =O$INN ! 2375: * ! 2376: * KEYWORD REFERENCE NAME CODE FOR OPERAND ! 2377: * =O$KWN ! 2378: * ! 2379: * ANY OTHER OPERAND IS AN ERROR IN A NAME POSITION ! 2380: * ! 2381: * NOTE THAT IN THIS DESCRIPTION, =O$XXX REFERS TO THE ! 2382: * GENERATION OF A WORD CONTAINING THE ADDRESS OF ANOTHER ! 2383: * WORD WHICH CONTAINS THE ENTRY POINT ADDRESS O$XXX. ! 2384: {{EJC{{{{ ! 2385: * ! 2386: * CODE BLOCK (CONTINUED) ! 2387: * ! 2388: * NOW WE CONSIDER THE OVERALL STRUCTURE OF THE CODE BLOCK ! 2389: * FOR A STATEMENT WITH POSSIBLE GOTO FIELDS. ! 2390: * ! 2391: * FIRST COMES THE CODE FOR THE STATEMENT BODY. ! 2392: * THE STATEMENT BODY IS AN EXPRESSION TO BE EVALUATED ! 2393: * BY VALUE ALTHOUGH THE VALUE IS NOT ACTUALLY REQUIRED. ! 2394: * NORMAL VALUE CODE IS GENERATED FOR THE BODY OF THE ! 2395: * STATEMENT EXCEPT IN THE CASE OF A PATTERN MATCH BY ! 2396: * VALUE, IN WHICH CASE THE FOLLOWING IS GENERATED. ! 2397: * ! 2398: * VALUE CODE FOR LEFT OPERAND ! 2399: * VALUE CODE FOR RIGHT OPERAND ! 2400: * =O$PMS ! 2401: * ! 2402: * NEXT WE HAVE THE CODE FOR THE SUCCESS GOTO. THERE ARE ! 2403: * SEVERAL CASES AS FOLLOWS. ! 2404: * ! 2405: * 1) NO SUCCESS GOTO PTR TO CDBLK FOR NEXT STATEMENT ! 2406: * ! 2407: * 2) SIMPLE LABEL PTR TO VRTRA FIELD OF VRBLK ! 2408: * ! 2409: * 3) COMPLEX GOTO (CODE BY NAME FOR GOTO OPERAND) ! 2410: * =O$GOC ! 2411: * ! 2412: * 4) DIRECT GOTO (CODE BY VALUE FOR GOTO OPERAND) ! 2413: * =O$GOD ! 2414: * ! 2415: * FOLLOWING THIS WE GENERATE CODE FOR THE FAILURE GOTO IF ! 2416: * IT IS DIRECT OR IF IT IS COMPLEX, SIMPLE FAILURE GOTOS ! 2417: * HAVING BEEN HANDLED BY AN APPROPRIATE SETTING OF THE ! 2418: * CDFAL FIELD OF THE CDBLK. THE GENERATED CODE IS ONE ! 2419: * OF THE FOLLOWING. ! 2420: * ! 2421: * 1) COMPLEX FGOTO =O$FIF ! 2422: * =O$GOF ! 2423: * NAME CODE FOR GOTO OPERAND ! 2424: * =O$GOC ! 2425: * ! 2426: * 2) DIRECT FGOTO =O$FIF ! 2427: * =O$GOF ! 2428: * VALUE CODE FOR GOTO OPERAND ! 2429: * =O$GOD ! 2430: * ! 2431: * AN OPTIMIZATION OCCURS IF THE SUCCESS AND FAILURE GOTOS ! 2432: * ARE IDENTICAL AND EITHER COMPLEX OR DIRECT. IN THIS CASE, ! 2433: * NO CODE IS GENERATED FOR THE SUCCESS GOTO AND CONTROL ! 2434: * IS ALLOWED TO FALL INTO THE FAILURE GOTO ON SUCCESS. ! 2435: {{EJC{{{{ ! 2436: * ! 2437: * COMPILER BLOCK (CMBLK) ! 2438: * ! 2439: * A COMPILER BLOCK (CMBLK) IS BUILT BY EXPAN TO REPRESENT ! 2440: * ONE NODE OF A TREE STRUCTURED EXPRESSION REPRESENTATION. ! 2441: * ! 2442: * +------------------------------------+ ! 2443: * I CMIDN I ! 2444: * +------------------------------------+ ! 2445: * I CMLEN I ! 2446: * +------------------------------------+ ! 2447: * I CMTYP I ! 2448: * +------------------------------------+ ! 2449: * I CMOPN I ! 2450: * +------------------------------------+ ! 2451: * / CMVLS OR CMROP / ! 2452: * / / ! 2453: * / CMLOP / ! 2454: * / / ! 2455: * +------------------------------------+ ! 2456: * ! 2457: {CMIDN{EQU{0{{{POINTER TO DUMMY ROUTINE B$CMT ! 2458: {CMLEN{EQU{CMIDN+1{{{LENGTH OF CMBLK IN BYTES ! 2459: {CMTYP{EQU{CMLEN+1{{{TYPE (C$XXX, SEE LIST BELOW) ! 2460: {CMOPN{EQU{CMTYP+1{{{OPERAND POINTER (SEE BELOW) ! 2461: {CMVLS{EQU{CMOPN+1{{{OPERAND VALUE POINTERS (SEE BELOW) ! 2462: {CMROP{EQU{CMVLS{{{RIGHT (ONLY) OPERATOR OPERAND ! 2463: {CMLOP{EQU{CMVLS+1{{{LEFT OPERATOR OPERAND ! 2464: {CMSI${EQU{CMVLS{{{NUMBER OF STANDARD FIELDS IN CMBLK ! 2465: {CMUS${EQU{CMSI$+1{{{SIZE OF UNARY OPERATOR CMBLK ! 2466: {CMBS${EQU{CMSI$+2{{{SIZE OF BINARY OPERATOR CMBLK ! 2467: {CMAR1{EQU{CMVLS+1{{{ARRAY SUBSCRIPT POINTERS ! 2468: * ! 2469: * THE CMOPN AND CMVLS FIELDS ARE SET AS FOLLOWS ! 2470: * ! 2471: * ARRAY REFERENCE CMOPN = PTR TO ARRAY OPERAND ! 2472: * CMVLS = PTRS TO SUBSCRIPT OPERANDS ! 2473: * ! 2474: * FUNCTION CALL CMOPN = PTR TO VRBLK FOR FUNCTION ! 2475: * CMVLS = PTRS TO ARGUMENT OPERANDS ! 2476: * ! 2477: * SELECTION CMOPN = ZERO ! 2478: * CMVLS = PTRS TO ALTERNATE OPERANDS ! 2479: * ! 2480: * UNARY OPERATOR CMOPN = PTR TO OPERATOR DVBLK ! 2481: * CMROP = PTR TO OPERAND ! 2482: * ! 2483: * BINARY OPERATOR CMOPN = PTR TO OPERATOR DVBLK ! 2484: * CMROP = PTR TO RIGHT OPERAND ! 2485: * CMLOP = PTR TO LEFT OPERAND ! 2486: {{EJC{{{{ ! 2487: * ! 2488: * CMTYP IS SET TO INDICATE THE TYPE OF EXPRESSION ELEMENT ! 2489: * AS SHOWN BY THE FOLLOWING TABLE OF DEFINITIONS. ! 2490: * ! 2491: {C$ARR{EQU{0{{{ARRAY REFERENCE ! 2492: {C$FNC{EQU{C$ARR+1{{{FUNCTION CALL ! 2493: {C$DEF{EQU{C$FNC+1{{{DEFERRED EXPRESSION (UNARY *) ! 2494: {C$IND{EQU{C$DEF+1{{{INDIRECTION (UNARY $) ! 2495: {C$KEY{EQU{C$IND+1{{{KEYWORD REFERENCE (UNARY AMPERSAND) ! 2496: {C$UBO{EQU{C$KEY+1{{{UNDEFINED BINARY OPERATOR ! 2497: {C$UUO{EQU{C$UBO+1{{{UNDEFINED UNARY OPERATOR ! 2498: {C$UO${EQU{C$UUO+1{{{TEST VALUE (=C$UUO+1=C$UBO+2) ! 2499: {C$$NM{EQU{C$UUO+1{{{NUMBER OF CODES FOR NAME OPERANDS ! 2500: * ! 2501: * THE REMAINING TYPES INDICATE EXPRESSION ELEMENTS WHICH ! 2502: * CAN ONLY BE EVALUATED BY VALUE (NOT BY NAME). ! 2503: * ! 2504: {C$BVL{EQU{C$UUO+1{{{BINARY OP WITH VALUE OPERANDS ! 2505: {C$UVL{EQU{C$BVL+1{{{UNARY OPERATOR WITH VALUE OPERAND ! 2506: {C$ALT{EQU{C$UVL+1{{{ALTERNATION (BINARY BAR) ! 2507: {C$CNC{EQU{C$ALT+1{{{CONCATENATION ! 2508: {C$CNP{EQU{C$CNC+1{{{CONCATENATION, NOT PATTERN MATCH ! 2509: {C$UNM{EQU{C$CNP+1{{{UNARY OP WITH NAME OPERAND ! 2510: {C$BVN{EQU{C$UNM+1{{{BINARY OP (OPERANDS BY VALUE, NAME) ! 2511: {C$ASS{EQU{C$BVN+1{{{ASSIGNMENT ! 2512: {C$INT{EQU{C$ASS+1{{{INTERROGATION ! 2513: {C$NEG{EQU{C$INT+1{{{NEGATION (UNARY NOT) ! 2514: {C$SEL{EQU{C$NEG+1{{{SELECTION ! 2515: {C$PMT{EQU{C$SEL+1{{{PATTERN MATCH ! 2516: * ! 2517: {C$PR${EQU{C$BVN{{{LAST PREEVALUABLE CODE ! 2518: {C$$NV{EQU{C$PMT+1{{{NUMBER OF DIFFERENT CMBLK TYPES ! 2519: {{EJC{{{{ ! 2520: * ! 2521: * CHARACTER TABLE BLOCK (CTBLK) ! 2522: * ! 2523: * A CHARACTER TABLE BLOCK IS USED TO HOLD LOGICAL CHARACTER ! 2524: * TABLES FOR USE WITH ANY,NOTANY,SPAN,BREAK,BREAKX ! 2525: * PATTERNS. EACH CHARACTER TABLE CAN BE USED TO STORE ! 2526: * CFP$N DISTINCT TABLES AS BIT COLUMNS. A BIT COLUMN ! 2527: * ALLOCATED FOR EACH ARGUMENT OF MORE THAN ONE CHARACTER ! 2528: * IN LENGTH TO ONE OF THE ABOVE LISTED PATTERN PRIMITIVES. ! 2529: * ! 2530: * +------------------------------------+ ! 2531: * I CTTYP I ! 2532: * +------------------------------------+ ! 2533: * * * ! 2534: * * * ! 2535: * * CTCHS * ! 2536: * * * ! 2537: * * * ! 2538: * +------------------------------------+ ! 2539: * ! 2540: {CTTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$CTT ! 2541: {CTCHS{EQU{CTTYP+1{{{START OF CHARACTER TABLE WORDS ! 2542: {CTSI${EQU{CTCHS+CFP$A{{{NUMBER OF WORDS IN CTBLK ! 2543: * ! 2544: * CTCHS IS CFP$A WORDS LONG AND CONSISTS OF A ONE WORD ! 2545: * BIT STRING VALUE FOR EACH POSSIBLE CHARACTER IN THE ! 2546: * INTERNAL ALPHABET. EACH OF THE CFP$N POSSIBLE BITS IN ! 2547: * A BITSTRING IS USED TO FORM A COLUMN OF BIT INDICATORS. ! 2548: * A BIT IS SET ON IF THE CHARACTER IS IN THE TABLE AND OFF ! 2549: * IF THE CHARACTER IS NOT PRESENT. ! 2550: {{EJC{{{{ ! 2551: * ! 2552: * DATATYPE FUNCTION BLOCK (DFBLK) ! 2553: * ! 2554: * A DATATYPE FUNCTION IS USED TO CONTROL THE CONSTRUCTION ! 2555: * OF A PROGRAM DEFINED DATATYPE OBJECT. A CALL TO THE ! 2556: * SYSTEM FUNCTION DATA BUILDS A DFBLK FOR THE DATATYPE NAME ! 2557: * ! 2558: * NOTE THAT THESE BLOCKS ARE BUILT IN STATIC BECAUSE PDBLK ! 2559: * LENGTH IS GOT FROM DFLEN FIELD. IF DFBLK WAS IN DYNAMIC ! 2560: * STORE THIS WOULD CAUSE TROUBLE DURING PASS TWO OF GARBAGE ! 2561: * COLLECTION. SCBLK REFERRED TO BY DFNAM FIELD IS ALSO PUT ! 2562: * IN STATIC SO THAT THERE ARE NO RELOC. FIELDS. THIS CUTS ! 2563: * GARBAGE COLLECTION TASK APPRECIABLY FOR PDBLKS WHICH ARE ! 2564: * LIKELY TO BE PRESENT IN LARGE NUMBERS. ! 2565: * ! 2566: * +------------------------------------+ ! 2567: * I FCODE I ! 2568: * +------------------------------------+ ! 2569: * I FARGS I ! 2570: * +------------------------------------+ ! 2571: * I DFLEN I ! 2572: * +------------------------------------+ ! 2573: * I DFPDL I ! 2574: * +------------------------------------+ ! 2575: * I DFNAM I ! 2576: * +------------------------------------+ ! 2577: * / / ! 2578: * / DFFLD / ! 2579: * / / ! 2580: * +------------------------------------+ ! 2581: * ! 2582: {DFLEN{EQU{FARGS+1{{{LENGTH OF DFBLK IN BYTES ! 2583: {DFPDL{EQU{DFLEN+1{{{LENGTH OF CORRESPONDING PDBLK ! 2584: {DFNAM{EQU{DFPDL+1{{{POINTER TO SCBLK FOR DATATYPE NAME ! 2585: {DFFLD{EQU{DFNAM+1{{{START OF VRBLK PTRS FOR FIELD NAMES ! 2586: {DFFLB{EQU{DFFLD-1{{{OFFSET BEHIND DFFLD FOR FIELD FUNC ! 2587: {DFSI${EQU{DFFLD{{{NUMBER OF STANDARD FIELDS IN DFBLK ! 2588: * ! 2589: * THE FCODE FIELD POINTS TO THE ROUTINE B$DFC ! 2590: * ! 2591: * FARGS (THE NUMBER OF ARGUMENTS) IS THE NUMBER OF FIELDS. ! 2592: {{EJC{{{{ ! 2593: * ! 2594: * DOPE VECTOR BLOCK (DVBLK) ! 2595: * ! 2596: * A DOPE VECTOR IS ASSEMBLED FOR EACH POSSIBLE OPERATOR IN ! 2597: * THE SNOBOL4 LANGUAGE AS PART OF THE CONSTANT SECTION. ! 2598: * ! 2599: * +------------------------------------+ ! 2600: * I DVOPN I ! 2601: * +------------------------------------+ ! 2602: * I DVTYP I ! 2603: * +------------------------------------+ ! 2604: * I DVLPR I ! 2605: * +------------------------------------+ ! 2606: * I DVRPR I ! 2607: * +------------------------------------+ ! 2608: * ! 2609: {DVOPN{EQU{0{{{ENTRY ADDRESS (PTR TO O$XXX) ! 2610: {DVTYP{EQU{DVOPN+1{{{TYPE CODE (C$XXX, SEE CMBLK) ! 2611: {DVLPR{EQU{DVTYP+1{{{LEFT PRECEDENCE (LLXXX, SEE BELOW) ! 2612: {DVRPR{EQU{DVLPR+1{{{RIGHT PRECEDENCE (RRXXX, SEE BELOW) ! 2613: {DVUS${EQU{DVLPR+1{{{SIZE OF UNARY OPERATOR DV ! 2614: {DVBS${EQU{DVRPR+1{{{SIZE OF BINARY OPERATOR DV ! 2615: {DVUBS{EQU{DVUS$+DVBS${{{SIZE OF UNOP + BINOP (SEE SCANE) ! 2616: * ! 2617: * THE CONTENTS OF THE DVTYP FIELD IS COPIED INTO THE CMTYP ! 2618: * FIELD OF THE CMBLK FOR THE OPERATOR IF IT IS USED. ! 2619: * ! 2620: * THE CMOPN FIELD OF AN OPERATOR CMBLK POINTS TO THE DVBLK ! 2621: * ITSELF, PROVIDING THE REQUIRED ENTRY ADDRESS POINTER PTR. ! 2622: * ! 2623: * FOR NORMALLY UNDEFINED OPERATORS, THE DVOPN (AND CMOPN) ! 2624: * FIELDS CONTAIN A WORD OFFSET FROM R$UBA OF THE FUNCTION ! 2625: * BLOCK POINTER FOR THE OPERATOR (INSTEAD OF O$XXX PTR). ! 2626: * FOR CERTAIN SPECIAL OPERATORS, THE DVOPN FIELD IS NOT ! 2627: * REQUIRED AT ALL AND IS ASSEMBLED AS ZERO. ! 2628: * ! 2629: * THE LEFT PRECEDENCE IS USED IN COMPARING AN OPERATOR TO ! 2630: * THE LEFT OF SOME OTHER OPERATOR. IT THEREFORE GOVERNS THE ! 2631: * PRECEDENCE OF THE OPERATOR TOWARDS ITS RIGHT OPERAND. ! 2632: * ! 2633: * THE RIGHT PRECEDENCE IS USED IN COMPARING AN OPERATOR TO ! 2634: * THE RIGHT OF SOME OTHER OPERATOR. IT THEREFORE GOVERNS ! 2635: * THE PRECEDENCE OF THE OPERATOR TOWARDS ITS LEFT OPERAND. ! 2636: * ! 2637: * HIGHER PRECEDENCE VALUES CORRESPOND TO A TIGHTER BINDING ! 2638: * CAPABILITY. THUS WE HAVE THE LEFT PRECEDENCE LOWER ! 2639: * (HIGHER) THAN THE RIGHT PRECEDENCE FOR RIGHT (LEFT) ! 2640: * ASSOCIATIVE BINARY OPERATORS. ! 2641: * ! 2642: * THE LEFT PRECEDENCE OF UNARY OPERATORS IS SET TO AN ! 2643: * ARBITRARY HIGH VALUE. THE RIGHT VALUE IS NOT REQUIRED AND ! 2644: * CONSEQUENTLY THE DVRPR FIELD IS OMITTED FOR UNARY OPS. ! 2645: {{EJC{{{{ ! 2646: * ! 2647: * TABLE OF OPERATOR PRECEDENCE VALUES ! 2648: * ! 2649: {RRASS{EQU{10{{{RIGHT EQUAL ! 2650: {LLASS{EQU{00{{{LEFT EQUAL ! 2651: {RRPMT{EQU{20{{{RIGHT QUESTION MARK ! 2652: {LLPMT{EQU{30{{{LEFT QUESTION MARK ! 2653: {RRAMP{EQU{40{{{RIGHT AMPERSAND ! 2654: {LLAMP{EQU{50{{{LEFT AMPERSAND ! 2655: {RRALT{EQU{70{{{RIGHT VERTICAL BAR ! 2656: {LLALT{EQU{60{{{LEFT VERTICAL BAR ! 2657: {RRCNC{EQU{90{{{RIGHT BLANK ! 2658: {LLCNC{EQU{80{{{LEFT BLANK ! 2659: {RRATS{EQU{110{{{RIGHT AT ! 2660: {LLATS{EQU{100{{{LEFT AT ! 2661: {RRPLM{EQU{120{{{RIGHT PLUS, MINUS ! 2662: {LLPLM{EQU{130{{{LEFT PLUS, MINUS ! 2663: {RRNUM{EQU{140{{{RIGHT NUMBER ! 2664: {LLNUM{EQU{150{{{LEFT NUMBER ! 2665: {RRDVD{EQU{160{{{RIGHT SLASH ! 2666: {LLDVD{EQU{170{{{LEFT SLASH ! 2667: {RRMLT{EQU{180{{{RIGHT ASTERISK ! 2668: {LLMLT{EQU{190{{{LEFT ASTERISK ! 2669: {RRPCT{EQU{200{{{RIGHT PERCENT ! 2670: {LLPCT{EQU{210{{{LEFT PERCENT ! 2671: {RREXP{EQU{230{{{RIGHT EXCLAMATION ! 2672: {LLEXP{EQU{220{{{LEFT EXCLAMATION ! 2673: {RRDLD{EQU{240{{{RIGHT DOLLAR, DOT ! 2674: {LLDLD{EQU{250{{{LEFT DOLLAR, DOT ! 2675: {RRNOT{EQU{270{{{RIGHT NOT ! 2676: {LLNOT{EQU{260{{{LEFT NOT ! 2677: {LLUNO{EQU{999{{{LEFT ALL UNARY OPERATORS ! 2678: * ! 2679: * PRECEDENCES ARE THE SAME AS IN BTL SNOBOL4 WITH THE ! 2680: * FOLLOWING EXCEPTIONS. ! 2681: * ! 2682: * 1) BINARY QUESTION MARK IS LOWERED AND MADE LEFT ASSOC- ! 2683: * IATIVE TO REFLECT ITS NEW USE FOR PATTERN MATCHING. ! 2684: * ! 2685: * 2) ALTERNATION AND CONCATENATION ARE MADE RIGHT ! 2686: * ASSOCIATIVE FOR GREATER EFFICIENCY IN PATTERN ! 2687: * CONSTRUCTION AND MATCHING RESPECTIVELY. THIS CHANGE ! 2688: * IS TRANSPARENT TO THE SNOBOL4 PROGRAMMER. ! 2689: * ! 2690: * 3) THE EQUAL SIGN HAS BEEN ADDED AS A LOW PRECEDENCE ! 2691: * OPERATOR WHICH IS RIGHT ASSOCIATIVE TO REFLECT ITS ! 2692: * MORE GENERAL USAGE IN THIS VERSION OF SNOBOL4. ! 2693: {{EJC{{{{ ! 2694: * ! 2695: * EXTERNAL FUNCTION BLOCK (EFBLK) ! 2696: * ! 2697: * AN EXTERNAL FUNCTION BLOCK IS USED TO CONTROL THE CALLING ! 2698: * OF AN EXTERNAL FUNCTION. IT IS BUILT BY A CALL TO LOAD. ! 2699: * ! 2700: * +------------------------------------+ ! 2701: * I FCODE I ! 2702: * +------------------------------------+ ! 2703: * I FARGS I ! 2704: * +------------------------------------+ ! 2705: * I EFLEN I ! 2706: * +------------------------------------+ ! 2707: * I EFUSE I ! 2708: * +------------------------------------+ ! 2709: * I EFCOD I ! 2710: * +------------------------------------+ ! 2711: * I EFVAR I ! 2712: * +------------------------------------+ ! 2713: * I EFRSL I ! 2714: * +------------------------------------+ ! 2715: * / / ! 2716: * / EFTAR / ! 2717: * / / ! 2718: * +------------------------------------+ ! 2719: * ! 2720: {EFLEN{EQU{FARGS+1{{{LENGTH OF EFBLK IN BYTES ! 2721: {EFUSE{EQU{EFLEN+1{{{USE COUNT (FOR OPSYN) ! 2722: {EFCOD{EQU{EFUSE+1{{{PTR TO CODE (FROM SYSLD) ! 2723: {EFVAR{EQU{EFCOD+1{{{PTR TO ASSOCIATED VRBLK ! 2724: {EFRSL{EQU{EFVAR+1{{{RESULT TYPE (SEE BELOW) ! 2725: {EFTAR{EQU{EFRSL+1{{{ARGUMENT TYPES (SEE BELOW) ! 2726: {EFSI${EQU{EFTAR{{{NUMBER OF STANDARD FIELDS IN EFBLK ! 2727: * ! 2728: * THE FCODE FIELD POINTS TO THE ROUTINE B$EFC. ! 2729: * ! 2730: * EFUSE IS USED TO KEEP TRACK OF MULTIPLE USE WHEN OPSYN ! 2731: * IS EMPLOYED. THE FUNCTION IS AUTOMATICALLY UNLOADED ! 2732: * WHEN THERE ARE NO MORE REFERENCES TO THE FUNCTION. ! 2733: * ! 2734: * EFRSL AND EFTAR ARE TYPE CODES AS FOLLOWS. ! 2735: * ! 2736: * 0 TYPE IS UNCONVERTED ! 2737: * 1 TYPE IS STRING ! 2738: * 2 TYPE IS INTEGER ! 2739: * 3 TYPE IS REAL ! 2740: {{EJC{{{{ ! 2741: * ! 2742: * EXPRESSION VARIABLE BLOCK (EVBLK) ! 2743: * ! 2744: * IN THIS VERSION OF SPITBOL, AN EXPRESSION CAN BE USED IN ! 2745: * ANY POSITION WHICH WOULD NORMALLY EXPECT A NAME (FOR ! 2746: * EXAMPLE ON THE LEFT SIDE OF EQUALS OR AS THE RIGHT ! 2747: * ARGUMENT OF BINARY DOT). THIS CORRESPONDS TO THE CREATION ! 2748: * OF A PSEUDO-VARIABLE WHICH IS REPRESENTED BY A POINTER TO ! 2749: * AN EXPRESSION VARIABLE BLOCK AS FOLLOWS. ! 2750: * ! 2751: * +------------------------------------+ ! 2752: * I EVTYP I ! 2753: * +------------------------------------+ ! 2754: * I EVEXP I ! 2755: * +------------------------------------+ ! 2756: * I EVVAR I ! 2757: * +------------------------------------+ ! 2758: * ! 2759: {EVTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$EVT ! 2760: {EVEXP{EQU{EVTYP+1{{{POINTER TO EXBLK FOR EXPRESSION ! 2761: {EVVAR{EQU{EVEXP+1{{{POINTER TO TRBEV DUMMY TRBLK ! 2762: {EVSI${EQU{EVVAR+1{{{SIZE OF EVBLK ! 2763: * ! 2764: * THE NAME OF AN EXPRESSION VARIABLE IS REPRESENTED BY A ! 2765: * BASE POINTER TO THE EVBLK AND AN OFFSET OF EVVAR. THIS ! 2766: * VALUE APPEARS TO BE TRAPPED BY THE DUMMY TRBEV BLOCK. ! 2767: * ! 2768: * NOTE THAT THERE IS NO NEED TO ALLOW FOR THE CASE OF AN ! 2769: * EXPRESSION VARIABLE WHICH REFERENCES AN SEBLK SINCE A ! 2770: * VARIABLE WHICH IS OF THE FORM *VAR IS EQUIVALENT TO VAR. ! 2771: {{EJC{{{{ ! 2772: * ! 2773: * EXPRESSION BLOCK (EXBLK) ! 2774: * ! 2775: * AN EXPRESSION BLOCK IS BUILT FOR EACH EXPRESSION ! 2776: * REFERENCED IN A PROGRAM OR CREATED BY EVAL OR CONVERT ! 2777: * DURING EXECUTION OF A PROGRAM. ! 2778: * ! 2779: * +------------------------------------+ ! 2780: * I EXTYP I ! 2781: * +------------------------------------+ ! 2782: * I EXSTM I ! 2783: * +------------------------------------+ ! 2784: * I EXLEN I ! 2785: * +------------------------------------+ ! 2786: * I EXFLC I ! 2787: * +------------------------------------+ ! 2788: * / / ! 2789: * / EXCOD / ! 2790: * / / ! 2791: * +------------------------------------+ ! 2792: * ! 2793: {EXTYP{EQU{0{{{PTR TO ROUTINE B$EXL TO LOAD EXPR ! 2794: {EXSTM{EQU{CDSTM{{{STORES STMNT NO. DURING EVALUATION ! 2795: {EXLEN{EQU{EXSTM+1{{{LENGTH OF EXBLK IN BYTES ! 2796: {EXFLC{EQU{EXLEN+1{{{FAILURE CODE (=O$FEX) ! 2797: {EXCOD{EQU{EXFLC+1{{{PSEUDO-CODE FOR EXPRESSION ! 2798: {EXSI${EQU{EXCOD{{{NUMBER OF STANDARD FIELDS IN EXBLK ! 2799: * ! 2800: * THERE ARE TWO CASES FOR EXCOD DEPENDING ON WHETHER THE ! 2801: * EXPRESSION CAN BE EVALUATED BY NAME (SEE DESCRIPTION ! 2802: * OF CDBLK FOR DETAILS OF CODE FOR EXPRESSIONS). ! 2803: * ! 2804: * IF THE EXPRESSION CAN BE EVALUATED BY NAME WE HAVE. ! 2805: * ! 2806: * (CODE FOR EXPR BY NAME) ! 2807: * =O$RNM ! 2808: * ! 2809: * IF THE EXPRESSION CAN ONLY BE EVALUATED BY VALUE. ! 2810: * ! 2811: * (CODE FOR EXPR BY VALUE) ! 2812: * =O$RVL ! 2813: {{EJC{{{{ ! 2814: * ! 2815: * FIELD FUNCTION BLOCK (FFBLK) ! 2816: * ! 2817: * A FIELD FUNCTION BLOCK IS USED TO CONTROL THE SELECTION ! 2818: * OF A FIELD FROM A PROGRAM DEFINED DATATYPE BLOCK. ! 2819: * A CALL TO DATA CREATES AN FFBLK FOR EACH FIELD. ! 2820: * ! 2821: * +------------------------------------+ ! 2822: * I FCODE I ! 2823: * +------------------------------------+ ! 2824: * I FARGS I ! 2825: * +------------------------------------+ ! 2826: * I FFDFP I ! 2827: * +------------------------------------+ ! 2828: * I FFNXT I ! 2829: * +------------------------------------+ ! 2830: * I FFOFS I ! 2831: * +------------------------------------+ ! 2832: * ! 2833: {FFDFP{EQU{FARGS+1{{{POINTER TO ASSOCIATED DFBLK ! 2834: {FFNXT{EQU{FFDFP+1{{{PTR TO NEXT FFBLK ON CHAIN OR ZERO ! 2835: {FFOFS{EQU{FFNXT+1{{{OFFSET (BYTES) TO FIELD IN PDBLK ! 2836: {FFSI${EQU{FFOFS+1{{{SIZE OF FFBLK IN WORDS ! 2837: * ! 2838: * THE FCODE FIELD POINTS TO THE ROUTINE B$FFC. ! 2839: * ! 2840: * FARGS ALWAYS CONTAINS ONE. ! 2841: * ! 2842: * FFDFP IS USED TO VERIFY THAT THE CORRECT PROGRAM DEFINED ! 2843: * DATATYPE IS BEING ACCESSED BY THIS CALL. ! 2844: * FFDFP IS NON-RELOC. BECAUSE DFBLK IS IN STATIC ! 2845: * ! 2846: * FFOFS IS USED TO SELECT THE APPROPRIATE FIELD. NOTE THAT ! 2847: * IT IS AN ACTUAL OFFSET (NOT A FIELD NUMBER) ! 2848: * ! 2849: * FFNXT IS USED TO POINT TO THE NEXT FFBLK OF THE SAME NAME ! 2850: * IN THE CASE WHERE THERE ARE SEVERAL FIELDS OF THE SAME ! 2851: * NAME FOR DIFFERENT DATATYPES. ZERO MARKS THE END OF CHAIN ! 2852: {{EJC{{{{ ! 2853: * ! 2854: * INTEGER CONSTANT BLOCK (ICBLK) ! 2855: * ! 2856: * AN ICBLK IS CREATED FOR EVERY INTEGER REFERENCED OR ! 2857: * CREATED BY A PROGRAM. NOTE HOWEVER THAT CERTAIN INTERNAL ! 2858: * INTEGER VALUES ARE STORED AS ADDRESSES (E.G. THE LENGTH ! 2859: * FIELD IN A STRING CONSTANT BLOCK) ! 2860: * ! 2861: * +------------------------------------+ ! 2862: * I ICGET I ! 2863: * +------------------------------------+ ! 2864: * * ICVAL * ! 2865: * +------------------------------------+ ! 2866: * ! 2867: {ICGET{EQU{0{{{PTR TO ROUTINE B$ICL TO LOAD INT ! 2868: {ICVAL{EQU{ICGET+1{{{INTEGER VALUE ! 2869: {ICSI${EQU{ICVAL+CFP$I{{{SIZE OF ICBLK ! 2870: * ! 2871: * THE LENGTH OF THE ICVAL FIELD IS CFP$I. ! 2872: {{EJC{{{{ ! 2873: * ! 2874: * KEYWORD VARIABLE BLOCK (KVBLK) ! 2875: * ! 2876: * A KVBLK IS USED TO REPRESENT A KEYWORD PSEUDO-VARIABLE. ! 2877: * A KVBLK IS BUILT FOR EACH KEYWORD REFERENCE (KWNAM). ! 2878: * ! 2879: * +------------------------------------+ ! 2880: * I KVTYP I ! 2881: * +------------------------------------+ ! 2882: * I KVVAR I ! 2883: * +------------------------------------+ ! 2884: * I KVNUM I ! 2885: * +------------------------------------+ ! 2886: * ! 2887: {KVTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$KVT ! 2888: {KVVAR{EQU{KVTYP+1{{{POINTER TO DUMMY BLOCK TRBKV ! 2889: {KVNUM{EQU{KVVAR+1{{{KEYWORD NUMBER ! 2890: {KVSI${EQU{KVNUM+1{{{SIZE OF KVBLK ! 2891: * ! 2892: * THE NAME OF A KEYWORD VARIABLE IS REPRESENTED BY A ! 2893: * BASE POINTER TO THE KVBLK AND AN OFFSET OF KVVAR. THE ! 2894: * VALUE APPEARS TO BE TRAPPED BY THE POINTER TO TRBKV. ! 2895: {{EJC{{{{ ! 2896: * ! 2897: * NAME BLOCK (NMBLK) ! 2898: * ! 2899: * A NAME BLOCK IS USED WHEREVER A NAME MUST BE STORED AS ! 2900: * A VALUE FOLLOWING USE OF THE UNARY DOT OPERATOR. ! 2901: * ! 2902: * +------------------------------------+ ! 2903: * I NMTYP I ! 2904: * +------------------------------------+ ! 2905: * I NMBAS I ! 2906: * +------------------------------------+ ! 2907: * I NMOFS I ! 2908: * +------------------------------------+ ! 2909: * ! 2910: {NMTYP{EQU{0{{{PTR TO ROUTINE B$NML TO LOAD NAME ! 2911: {NMBAS{EQU{NMTYP+1{{{BASE POINTER FOR VARIABLE ! 2912: {NMOFS{EQU{NMBAS+1{{{OFFSET FOR VARIABLE ! 2913: {NMSI${EQU{NMOFS+1{{{SIZE OF NMBLK ! 2914: * ! 2915: * THE ACTUAL FIELD REPRESENTING THE CONTENTS OF THE NAME ! 2916: * IS FOUND NMOFS BYTES PAST THE ADDRESS IN NMBAS. ! 2917: * ! 2918: * THE NAME IS SPLIT INTO BASE AND OFFSET FORM TO AVOID ! 2919: * CREATION OF A POINTER INTO THE MIDDLE OF A BLOCK WHICH ! 2920: * COULD NOT BE HANDLED PROPERLY BY THE GARBAGE COLLECTOR. ! 2921: * ! 2922: * A NAME MAY BE BUILT FOR ANY VARIABLE (SEE SECTION ON ! 2923: * REPRESENTATIONS OF VARIABLES) THIS INCLUDES THE ! 2924: * CASES OF PSEUDO-VARIABLES. ! 2925: {{EJC{{{{ ! 2926: * ! 2927: * PATTERN BLOCK, NO PARAMETERS (P0BLK) ! 2928: * ! 2929: * A P0BLK IS USED TO REPRESENT PATTERN NODES WHICH DO ! 2930: * NOT REQUIRE THE USE OF ANY PARAMETER VALUES. ! 2931: * ! 2932: * +------------------------------------+ ! 2933: * I PCODE I ! 2934: * +------------------------------------+ ! 2935: * I PTHEN I ! 2936: * +------------------------------------+ ! 2937: * ! 2938: {PCODE{EQU{0{{{PTR TO MATCH ROUTINE (P$XXX) ! 2939: {PTHEN{EQU{PCODE+1{{{POINTER TO SUBSEQUENT NODE ! 2940: {PASI${EQU{PTHEN+1{{{SIZE OF P0BLK ! 2941: * ! 2942: * PTHEN POINTS TO THE PATTERN BLOCK FOR THE SUBSEQUENT ! 2943: * NODE TO BE MATCHED. THIS IS A POINTER TO THE PATTERN ! 2944: * BLOCK NDNTH IF THERE IS NO SUBSEQUENT (END OF PATTERN) ! 2945: * ! 2946: * PCODE IS A POINTER TO THE MATCH ROUTINE FOR THE NODE. ! 2947: {{EJC{{{{ ! 2948: * ! 2949: * PATTERN BLOCK (ONE PARAMETER) ! 2950: * ! 2951: * A P1BLK IS USED TO REPRESENT PATTERN NODES WHICH ! 2952: * REQUIRE ONE PARAMETER VALUE. ! 2953: * ! 2954: * +------------------------------------+ ! 2955: * I PCODE I ! 2956: * +------------------------------------+ ! 2957: * I PTHEN I ! 2958: * +------------------------------------+ ! 2959: * I PARM1 I ! 2960: * +------------------------------------+ ! 2961: * ! 2962: {PARM1{EQU{PTHEN+1{{{FIRST PARAMETER VALUE ! 2963: {PBSI${EQU{PARM1+1{{{SIZE OF P1BLK IN WORDS ! 2964: * ! 2965: * SEE P0BLK FOR DEFINITIONS OF PCODE, PTHEN ! 2966: * ! 2967: * PARM1 CONTAINS A PARAMETER VALUE USED IN MATCHING THE ! 2968: * NODE. FOR EXAMPLE, IN A LEN PATTERN, IT IS THE INTEGER ! 2969: * ARGUMENT TO LEN. THE DETAILS OF THE USE OF THE PARAMETER ! 2970: * FIELD ARE INCLUDED IN THE DESCRIPTION OF THE INDIVIDUAL ! 2971: * MATCH ROUTINES. PARM1 IS ALWAYS AN ADDRESS POINTER WHICH ! 2972: * IS PROCESSED BY THE GARBAGE COLLECTOR. ! 2973: {{EJC{{{{ ! 2974: * ! 2975: * PATTERN BLOCK (TWO PARAMETERS) ! 2976: * ! 2977: * A P2BLK IS USED TO REPRESENT PATTERN NODES WHICH ! 2978: * REQUIRE TWO PARAMETER VALUES. ! 2979: * ! 2980: * +------------------------------------+ ! 2981: * I PCODE I ! 2982: * +------------------------------------+ ! 2983: * I PTHEN I ! 2984: * +------------------------------------+ ! 2985: * I PARM1 I ! 2986: * +------------------------------------+ ! 2987: * I PARM2 I ! 2988: * +------------------------------------+ ! 2989: * ! 2990: {PARM2{EQU{PARM1+1{{{SECOND PARAMETER VALUE ! 2991: {PCSI${EQU{PARM2+1{{{SIZE OF P2BLK IN WORDS ! 2992: * ! 2993: * SEE P1BLK FOR DEFINITIONS OF PCODE, PTHEN, PARM1 ! 2994: * ! 2995: * PARM2 IS A PARAMETER WHICH PERFORMS THE SAME SORT OF ! 2996: * FUNCTION AS PARM1 (SEE DESCRIPTION OF P1BLK). ! 2997: * ! 2998: * PARM2 IS A NON-RELOCATABLE FIELD AND IS NOT ! 2999: * PROCESSED BY THE GARBAGE COLLECTOR. ACCORDINGLY, IT MAY ! 3000: * NOT CONTAIN A POINTER TO A BLOCK IN DYNAMIC MEMORY. ! 3001: {{EJC{{{{ ! 3002: * ! 3003: * PROGRAM-DEFINED DATATYPE BLOCK ! 3004: * ! 3005: * A PDBLK REPRESENTS THE DATA ITEM FORMED BY A CALL TO A ! 3006: * DATATYPE FUNCTION AS DEFINED BY THE SYSTEM FUNCTION DATA. ! 3007: * ! 3008: * +------------------------------------+ ! 3009: * I PDTYP I ! 3010: * +------------------------------------+ ! 3011: * I IDVAL I ! 3012: * +------------------------------------+ ! 3013: * I PDDFP I ! 3014: * +------------------------------------+ ! 3015: * / / ! 3016: * / PDFLD / ! 3017: * / / ! 3018: * +------------------------------------+ ! 3019: * ! 3020: {PDTYP{EQU{0{{{PTR TO DUMMY ROUTINE B$PDT ! 3021: {PDDFP{EQU{IDVAL+1{{{PTR TO ASSOCIATED DFBLK ! 3022: {PDFLD{EQU{PDDFP+1{{{START OF FIELD VALUE POINTERS ! 3023: {PDFOF{EQU{DFFLD-PDFLD{{{DIFFERENCE IN OFFSET TO FIELD PTRS ! 3024: {PDSI${EQU{PDFLD{{{SIZE OF STANDARD FIELDS IN PDBLK ! 3025: {PDDFS{EQU{DFSI$-PDSI${{{DIFFERENCE IN DFBLK, PDBLK SIZES ! 3026: * ! 3027: * THE PDDFP POINTER MAY BE USED TO DETERMINE THE DATATYPE ! 3028: * AND THE NAMES OF THE FIELDS IF REQUIRED. THE DFBLK ALSO ! 3029: * CONTAINS THE LENGTH OF THE PDBLK IN BYTES (FIELD DFPDL). ! 3030: * PDDFP IS NON-RELOC. BECAUSE DFBLK IS IN STATIC ! 3031: * ! 3032: * PDFLD VALUES ARE STORED IN ORDER FROM LEFT TO RIGHT. ! 3033: * THEY CONTAIN VALUES OR POINTERS TO TRBLK CHAINS. ! 3034: {{EJC{{{{ ! 3035: * ! 3036: * PROGRAM DEFINED FUNCTION BLOCK (PFBLK) ! 3037: * ! 3038: * A PFBLK IS CREATED FOR EACH CALL TO THE DEFINE FUNCTION ! 3039: * AND A POINTER TO THE PFBLK PLACED IN THE PROPER VRBLK. ! 3040: * ! 3041: * +------------------------------------+ ! 3042: * I FCODE I ! 3043: * +------------------------------------+ ! 3044: * I FARGS I ! 3045: * +------------------------------------+ ! 3046: * I PFLEN I ! 3047: * +------------------------------------+ ! 3048: * I PFVBL I ! 3049: * +------------------------------------+ ! 3050: * I PFNLO I ! 3051: * +------------------------------------+ ! 3052: * I PFCOD I ! 3053: * +------------------------------------+ ! 3054: * I PFCTR I ! 3055: * +------------------------------------+ ! 3056: * I PFRTR I ! 3057: * +------------------------------------+ ! 3058: * / / ! 3059: * / PFARG / ! 3060: * / / ! 3061: * +------------------------------------+ ! 3062: * ! 3063: {PFLEN{EQU{FARGS+1{{{LENGTH OF PFBLK IN BYTES ! 3064: {PFVBL{EQU{PFLEN+1{{{POINTER TO VRBLK FOR FUNCTION NAME ! 3065: {PFNLO{EQU{PFVBL+1{{{NUMBER OF LOCALS ! 3066: {PFCOD{EQU{PFNLO+1{{{PTR TO CDBLK FOR FIRST STATEMENT ! 3067: {PFCTR{EQU{PFCOD+1{{{TRBLK PTR IF CALL TRACED ELSE 0 ! 3068: {PFRTR{EQU{PFCTR+1{{{TRBLK PTR IF RETURN TRACED ELSE 0 ! 3069: {PFARG{EQU{PFRTR+1{{{VRBLK PTRS FOR ARGUMENTS AND LOCALS ! 3070: {PFAGB{EQU{PFARG-1{{{OFFSET BEHIND PFARG FOR ARG, LOCAL ! 3071: {PFSI${EQU{PFARG{{{NUMBER OF STANDARD FIELDS IN PFBLK ! 3072: * ! 3073: * THE FCODE FIELD POINTS TO THE ROUTINE B$PFC. ! 3074: * ! 3075: * PFARG IS STORED IN THE FOLLOWING ORDER. ! 3076: * ! 3077: * ARGUMENTS (LEFT TO RIGHT) ! 3078: * LOCALS (LEFT TO RIGHT) ! 3079: {{EJC{{{{ ! 3080: * ! 3081: * REAL CONSTANT BLOCK (RCBLK) ! 3082: * ! 3083: * AN RCBLK IS CREATED FOR EVERY REAL REFERENCED OR ! 3084: * CREATED BY A PROGRAM. ! 3085: * ! 3086: * +------------------------------------+ ! 3087: * I RCGET I ! 3088: * +------------------------------------+ ! 3089: * * RCVAL * ! 3090: * +------------------------------------+ ! 3091: * ! 3092: {RCGET{EQU{0{{{PTR TO ROUTINE B$RCL TO LOAD REAL ! 3093: {RCVAL{EQU{RCGET+1{{{REAL VALUE ! 3094: {RCSI${EQU{RCVAL+CFP$R{{{SIZE OF RCBLK ! 3095: * ! 3096: * THE LENGTH OF THE RCVAL FIELD IS CFP$R. ! 3097: {{EJC{{{{ ! 3098: * ! 3099: * STRING CONSTANT BLOCK (SCBLK) ! 3100: * ! 3101: * AN SCBLK IS BUILT FOR EVERY STRING REFERENCED OR CREATED ! 3102: * BY A PROGRAM. ! 3103: * ! 3104: * +------------------------------------+ ! 3105: * I SCGET I ! 3106: * +------------------------------------+ ! 3107: * I SCLEN I ! 3108: * +------------------------------------+ ! 3109: * / / ! 3110: * / SCHAR / ! 3111: * / / ! 3112: * +------------------------------------+ ! 3113: * ! 3114: {SCGET{EQU{0{{{PTR TO ROUTINE B$SCL TO LOAD STRING ! 3115: {SCLEN{EQU{SCGET+1{{{LENGTH OF STRING IN CHARACTERS ! 3116: {SCHAR{EQU{SCLEN+1{{{CHARACTERS OF STRING ! 3117: {SCSI${EQU{SCHAR{{{SIZE OF STANDARD FIELDS IN SCBLK ! 3118: * ! 3119: * THE CHARACTERS OF THE STRING ARE STORED LEFT JUSTIFIED. ! 3120: * THE FINAL WORD IS PADDED ON THE RIGHT WITH ZEROS. ! 3121: * (I.E. THE CHARACTER WHOSE INTERNAL CODE IS ZERO). ! 3122: * ! 3123: * THE VALUE OF SCLEN MAY NOT EXCEED MXLEN. THIS ENSURES ! 3124: * THAT CHARACTER OFFSETS (E.G. THE PATTERN MATCH CURSOR) ! 3125: * CAN BE CORRECTLY PROCESSED BY THE GARBAGE COLLECTOR. ! 3126: * ! 3127: * NOTE THAT THE OFFSET TO THE CHARACTERS OF THE STRING ! 3128: * IS GIVEN IN BYTES BY CFP$F AND THAT THIS VALUE IS ! 3129: * AUTOMATICALLY ALLOWED FOR IN PLC, PSC. ! 3130: * NOTE THAT FOR A SPITBOL SCBLK, THE VALUE OF CFP$F ! 3131: * IS GIVEN BY CFP$B*SCHAR. ! 3132: {{EJC{{{{ ! 3133: * ! 3134: * SIMPLE EXPRESSION BLOCK (SEBLK) ! 3135: * ! 3136: * AN SEBLK IS USED TO REPRESENT AN EXPRESSION OF THE FORM ! 3137: * *(NATURAL VARIABLE). ALL OTHER EXPRESSIONS ARE EXBLKS. ! 3138: * ! 3139: * +------------------------------------+ ! 3140: * I SETYP I ! 3141: * +------------------------------------+ ! 3142: * I SEVAR I ! 3143: * +------------------------------------+ ! 3144: * ! 3145: {SETYP{EQU{0{{{PTR TO ROUTINE B$SEL TO LOAD EXPR ! 3146: {SEVAR{EQU{SETYP+1{{{PTR TO VRBLK FOR VARIABLE ! 3147: {SESI${EQU{SEVAR+1{{{LENGTH OF SEBLK IN WORDS ! 3148: {{EJC{{{{ ! 3149: * ! 3150: * STANDARD VARIABLE BLOCK (SVBLK) ! 3151: * ! 3152: * AN SVBLK IS ASSEMBLED IN THE CONSTANT SECTION FOR EACH ! 3153: * VARIABLE WHICH SATISFIES ONE OF THE FOLLOWING CONDITIONS. ! 3154: * ! 3155: * 1) IT IS THE NAME OF A SYSTEM FUNCTION ! 3156: * 2) IT HAS AN INITIAL VALUE ! 3157: * 3) IT HAS A KEYWORD ASSOCIATION ! 3158: * 4) IT HAS A STANDARD I/O ASSOCIATION ! 3159: * 6) IT HAS A STANDARD LABEL ASSOCIATION ! 3160: * ! 3161: * IF VRBLKS ARE CONSTRUCTED FOR ANY OF THESE VARIABLES, ! 3162: * THEN THE VRSVP FIELD POINTS TO THE SVBLK (SEE VRBLK) ! 3163: * ! 3164: * +------------------------------------+ ! 3165: * I SVBIT I ! 3166: * +------------------------------------+ ! 3167: * I SVLEN I ! 3168: * +------------------------------------+ ! 3169: * I SVCHS I ! 3170: * +------------------------------------+ ! 3171: * I SVKNM I ! 3172: * +------------------------------------+ ! 3173: * I SVFNC I ! 3174: * +------------------------------------+ ! 3175: * I SVNAR I ! 3176: * +------------------------------------+ ! 3177: * I SVLBL I ! 3178: * +------------------------------------+ ! 3179: * I SVVAL I ! 3180: * +------------------------------------+ ! 3181: {{EJC{{{{ ! 3182: * ! 3183: * STANDARD VARIABLE BLOCK (CONTINUED) ! 3184: * ! 3185: {SVBIT{EQU{0{{{BIT STRING INDICATING ATTRIBUTES ! 3186: {SVLEN{EQU{1{{{(=SCLEN) LENGTH OF NAME IN CHARS ! 3187: {SVCHS{EQU{2{{{(=SCHAR) CHARACTERS OF NAME ! 3188: {SVSI${EQU{2{{{NUMBER OF STANDARD FIELDS IN SVBLK ! 3189: {SVPRE{EQU{1{{{SET IF PREEVALUATION PERMITTED ! 3190: {SVFFC{EQU{SVPRE+SVPRE{{{SET ON IF FAST CALL PERMITTED ! 3191: {SVCKW{EQU{SVFFC+SVFFC{{{SET ON IF KEYWORD VALUE CONSTANT ! 3192: {SVPRD{EQU{SVCKW+SVCKW{{{SET ON IF PREDICATE FUNCTION ! 3193: {SVNBT{EQU{4{{{NUMBER OF BITS TO RIGHT OF SVKNM ! 3194: {SVKNM{EQU{SVPRD+SVPRD{{{SET ON IF KEYWORD ASSOCIATION ! 3195: {SVFNC{EQU{SVKNM+SVKNM{{{SET ON IF SYSTEM FUNCTION ! 3196: {SVNAR{EQU{SVFNC+SVFNC{{{SET ON IF SYSTEM FUNCTION ! 3197: {SVLBL{EQU{SVNAR+SVNAR{{{SET ON IF SYSTEM LABEL ! 3198: {SVVAL{EQU{SVLBL+SVLBL{{{SET ON IF PREDEFINED VALUE ! 3199: * ! 3200: * NOTE THAT THE LAST FIVE BITS CORRESPOND IN ORDER ! 3201: * TO THE FIELDS WHICH ARE PRESENT (SEE PROCEDURE GTNVR). ! 3202: * ! 3203: * THE FOLLOWING DEFINITIONS ARE USED IN THE SVBLK TABLE ! 3204: * ! 3205: {SVFNF{EQU{SVFNC+SVNAR{{{FUNCTION WITH NO FAST CALL ! 3206: {SVFNN{EQU{SVFNF+SVFFC{{{FUNCTION WITH FAST CALL, NO PREEVAL ! 3207: {SVFNP{EQU{SVFNN+SVPRE{{{FUNCTION ALLOWING PREEVALUATION ! 3208: {SVFPR{EQU{SVFNN+SVPRD{{{PREDICATE FUNCTION ! 3209: {SVFNK{EQU{SVFNN+SVKNM{{{NO PREEVAL FUNC + KEYWORD ! 3210: {SVKWV{EQU{SVKNM+SVVAL{{{KEYWORD + VALUE ! 3211: {SVKWC{EQU{SVCKW+SVKNM{{{KEYWORD WITH CONSTANT VALUE ! 3212: {SVKVC{EQU{SVKWV+SVCKW{{{CONSTANT KEYWORD + VALUE ! 3213: {SVKVL{EQU{SVKVC+SVLBL{{{CONSTANT KEYWORD + VALUE + LABEL ! 3214: {SVFPK{EQU{SVFNP+SVKVC{{{PREEVAL FCN + CONST KEYWD + VAL ! 3215: * ! 3216: * THE SVPRE BIT ALLOWS THE COMPILER TO PREEVALUATE A CALL ! 3217: * TO THE ASSOCIATED SYSTEM FUNCTION IF ALL THE ARGUMENTS ! 3218: * ARE THEMSELVES CONSTANTS. FUNCTIONS IN THIS CATEGORY ! 3219: * MUST HAVE NO SIDE EFFECTS AND MUST NEVER CAUSE FAILURE. ! 3220: * THE CALL MAY GENERATE AN ERROR CONDITION. ! 3221: * ! 3222: * THE SVFFC BIT ALLOWS THE COMPILER TO GENERATE THE SPECIAL ! 3223: * FAST CALL AFTER ADJUSTING THE NUMBER OF ARGUMENTS. ONLY ! 3224: * THE ITEM AND APPLY FUNCTIONS FALL OUTSIDE THIS CATEGORY. ! 3225: * ! 3226: * THE SVCKW BIT IS SET IF THE ASSOCIATED KEYWORD VALUE IS ! 3227: * A CONSTANT, THUS ALLOWING PREEVALUATION FOR A VALUE CALL. ! 3228: * ! 3229: * THE SVPRD BIT IS SET ON FOR ALL PREDICATE FUNCTIONS TO ! 3230: * ENABLE THE SPECIAL CONCATENATION CODE OPTIMIZATION. ! 3231: {{EJC{{{{ ! 3232: * ! 3233: * SVBLK (CONTINUED) ! 3234: * ! 3235: * SVKNM KEYWORD NUMBER ! 3236: * ! 3237: * SVKNM IS PRESENT ONLY FOR A STANDARD KEYWORD ASSOC. ! 3238: * IT CONTAINS A KEYWORD NUMBER AS DEFINED BY THE ! 3239: * KEYWORD NUMBER TABLE GIVEN LATER ON. ! 3240: * ! 3241: * SVFNC SYSTEM FUNCTION POINTER ! 3242: * ! 3243: * SVFNC IS PRESENT ONLY FOR A SYSTEM FUNCTION ASSOC. ! 3244: * IT IS A POINTER TO THE ACTUAL CODE FOR THE SYSTEM ! 3245: * FUNCTION. THE GENERATED CODE FOR A FAST CALL IS A ! 3246: * POINTER TO THE SVFNC FIELD OF THE SVBLK FOR THE ! 3247: * FUNCTION. THE VRFNC FIELD OF THE VRBLK POINTS TO ! 3248: * THIS SAME FIELD, IN WHICH CASE, IT SERVES AS THE ! 3249: * FCODE FIELD FOR THE FUNCTION CALL. ! 3250: * ! 3251: * SVNAR NUMBER OF FUNCTION ARGUMENTS ! 3252: * ! 3253: * SVNAR IS PRESENT ONLY FOR A SYSTEM FUNCTION ASSOC. ! 3254: * IT IS THE NUMBER OF ARGUMENTS REQUIRED FOR A CALL ! 3255: * TO THE SYSTEM FUNCTION. THE COMPILER USES THIS ! 3256: * VALUE TO ADJUST THE NUMBER OF ARGUMENTS IN A FAST ! 3257: * CALL AND IN THE CASE OF A FUNCTION CALLED THROUGH ! 3258: * THE VRFNC FIELD OF THE VRBLK, THE SVNAR FIELD ! 3259: * SERVES AS THE FARGS FIELD FOR O$FNC. A SPECIAL ! 3260: * CASE OCCURS IF THIS VALUE IS SET TO 999. THIS IS ! 3261: * USED TO INDICATE THAT THE FUNCTION HAS A VARIABLE ! 3262: * NUMBER OF ARGUMENTS AND CAUSES O$FNC TO PASS CONTROL ! 3263: * WITHOUT ADJUSTING THE ARGUMENT COUNT. THE ONLY ! 3264: * PREDEFINED FUNCTIONS USING THIS ARE APPLY AND ITEM. ! 3265: * ! 3266: * SVLBL SYSTEM LABEL POINTER ! 3267: * ! 3268: * SVLBL IS PRESENT ONLY FOR A STANDARD LABEL ASSOC. ! 3269: * IT IS A POINTER TO A SYSTEM LABEL ROUTINE (L$XXX). ! 3270: * THE VRLBL FIELD OF THE CORRESPONDING VRBLK POINTS TO ! 3271: * THE SVLBL FIELD OF THE SVBLK. ! 3272: * ! 3273: * SVVAL SYSTEM VALUE POINTER ! 3274: * ! 3275: * SVVAL IS PRESENT ONLY FOR A STANDARD VALUE. ! 3276: * IT IS A POINTER TO THE PATTERN NODE (NDXXX) WHICH ! 3277: * IS THE STANDARD INITIAL VALUE OF THE VARIABLE. ! 3278: * THIS VALUE IS COPIED TO THE VRVAL FIELD OF THE VRBLK ! 3279: {{EJC{{{{ ! 3280: * ! 3281: * SVBLK (CONTINUED) ! 3282: * ! 3283: * KEYWORD NUMBER TABLE ! 3284: * ! 3285: * THE FOLLOWING TABLE GIVES SYMBOLIC NAMES FOR KEYWORD ! 3286: * NUMBERS. THESE VALUES ARE STORED IN THE SVKNM FIELD OF ! 3287: * SVBLKS AND IN THE KVNUM FIELD OF KVBLKS. SEE ALSO ! 3288: * PROCEDURES ASIGN, ACESS AND KWNAM. ! 3289: * ! 3290: * UNPROTECTED KEYWORDS WITH ONE WORD INTEGER VALUES ! 3291: * ! 3292: {K$ABE{EQU{0{{{ABEND ! 3293: {K$ANC{EQU{K$ABE+CFP$B{{{ANCHOR ! 3294: {K$CAS{EQU{K$ANC+CFP$B{{{CASE ! 3295: {K$COD{EQU{K$CAS+CFP$B{{{CODE ! 3296: {K$DMP{EQU{K$COD+CFP$B{{{DUMP ! 3297: {K$ERL{EQU{K$DMP+CFP$B{{{ERRLIMIT ! 3298: {K$ERT{EQU{K$ERL+CFP$B{{{ERRTYPE ! 3299: {K$FTR{EQU{K$ERT+CFP$B{{{FTRACE ! 3300: {K$INP{EQU{K$FTR+CFP$B{{{INPUT ! 3301: {K$MXL{EQU{K$INP+CFP$B{{{MAXLENGTH ! 3302: {K$OUP{EQU{K$MXL+CFP$B{{{OUTPUT ! 3303: {K$PFL{EQU{K$OUP+CFP$B{{{PROFILE ! 3304: {K$TRA{EQU{K$PFL+CFP$B{{{TRACE ! 3305: {K$TRM{EQU{K$TRA+CFP$B{{{TRIM ! 3306: * ! 3307: * PROTECTED KEYWORDS WITH ONE WORD INTEGER VALUES ! 3308: * ! 3309: {K$FNC{EQU{K$TRM+CFP$B{{{FNCLEVEL ! 3310: {K$LST{EQU{K$FNC+CFP$B{{{LASTNO ! 3311: {K$STN{EQU{K$LST+CFP$B{{{STNO ! 3312: * ! 3313: * KEYWORDS WITH CONSTANT PATTERN VALUES ! 3314: * ! 3315: {K$ABO{EQU{K$STN+CFP$B{{{ABORT ! 3316: {K$ARB{EQU{K$ABO+PASI${{{ARB ! 3317: {K$BAL{EQU{K$ARB+PASI${{{BAL ! 3318: {K$FAL{EQU{K$BAL+PASI${{{FAIL ! 3319: {K$FEN{EQU{K$FAL+PASI${{{FENCE ! 3320: {K$REM{EQU{K$FEN+PASI${{{REM ! 3321: {K$SUC{EQU{K$REM+PASI${{{SUCCEED ! 3322: {{EJC{{{{ ! 3323: * ! 3324: * KEYWORD NUMBER TABLE (CONTINUED) ! 3325: * ! 3326: * SPECIAL KEYWORDS ! 3327: * ! 3328: {K$ALP{EQU{K$SUC+1{{{ALPHABET ! 3329: {K$RTN{EQU{K$ALP+1{{{RTNTYPE ! 3330: {K$STC{EQU{K$RTN+1{{{STCOUNT ! 3331: {K$ETX{EQU{K$STC+1{{{ERRTEXT ! 3332: {K$STL{EQU{K$ETX+1{{{STLIMIT ! 3333: * ! 3334: * RELATIVE OFFSETS OF SPECIAL KEYWORDS ! 3335: * ! 3336: {K$$AL{EQU{K$ALP-K$ALP{{{ALPHABET ! 3337: {K$$RT{EQU{K$RTN-K$ALP{{{RTNTYPE ! 3338: {K$$SC{EQU{K$STC-K$ALP{{{STCOUNT ! 3339: {K$$ET{EQU{K$ETX-K$ALP{{{ERRTEXT ! 3340: {K$$SL{EQU{K$STL-K$ALP{{{STLIMIT ! 3341: * ! 3342: * SYMBOLS USED IN ASIGN AND ACESS PROCEDURES ! 3343: * ! 3344: {K$P$${EQU{K$FNC{{{FIRST PROTECTED KEYWORD ! 3345: {K$V$${EQU{K$ABO{{{FIRST KEYWORD WITH CONSTANT VALUE ! 3346: {K$S$${EQU{K$ALP{{{FIRST KEYWORD WITH SPECIAL ACESS ! 3347: {{EJC{{{{ ! 3348: * ! 3349: * FORMAT OF A TABLE BLOCK (TBBLK) ! 3350: * ! 3351: * A TABLE BLOCK IS USED TO REPRESENT A TABLE VALUE. ! 3352: * IT IS BUILT BY A CALL TO THE TABLE OR CONVERT FUNCTIONS. ! 3353: * ! 3354: * +------------------------------------+ ! 3355: * I TBTYP I ! 3356: * +------------------------------------+ ! 3357: * I IDVAL I ! 3358: * +------------------------------------+ ! 3359: * I TBLEN I ! 3360: * +------------------------------------+ ! 3361: * +------------------------------------+ ! 3362: * I TBINV I ! 3363: * +------------------------------------+ ! 3364: * / / ! 3365: * / TBBUK / ! 3366: * / / ! 3367: * +------------------------------------+ ! 3368: * ! 3369: {TBTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$TBT ! 3370: {TBLEN{EQU{OFFS2{{{LENGTH OF TBBLK IN BYTES ! 3371: {TBINV{EQU{OFFS3{{{DEFAULT INITIAL LOOKUP VALUE ! 3372: {TBBUK{EQU{TBINV+1{{{START OF HASH BUCKET POINTERS ! 3373: {TBSI${EQU{TBBUK{{{SIZE OF STANDARD FIELDS IN TBBLK ! 3374: {TBNBK{EQU{11{{{DEFAULT NO. OF BUCKETS ! 3375: * ! 3376: * THE TABLE BLOCK IS A HASH TABLE WHICH POINTS TO CHAINS ! 3377: * OF TABLE ELEMENT BLOCKS REPRESENTING THE ELEMENTS ! 3378: * IN THE TABLE WHICH HASH INTO THE SAME BUCKET. ! 3379: * ! 3380: * TBBUK ENTRIES EITHER POINT TO THE FIRST TEBLK ON THE ! 3381: * CHAIN OR THEY POINT TO THE TBBLK ITSELF TO INDICATE THE ! 3382: * END OF THE CHAIN. ! 3383: {{EJC{{{{ ! 3384: * ! 3385: * TABLE ELEMENT BLOCK (TEBLK) ! 3386: * ! 3387: * A TABLE ELEMENT IS USED TO REPRESENT A SINGLE ENTRY IN ! 3388: * A TABLE (SEE DESCRIPTION OF TBBLK FORMAT FOR HASH TABLE) ! 3389: * ! 3390: * +------------------------------------+ ! 3391: * I TETYP I ! 3392: * +------------------------------------+ ! 3393: * I TESUB I ! 3394: * +------------------------------------+ ! 3395: * I TEVAL I ! 3396: * +------------------------------------+ ! 3397: * I TENXT I ! 3398: * +------------------------------------+ ! 3399: * ! 3400: {TETYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$TET ! 3401: {TESUB{EQU{TETYP+1{{{SUBSCRIPT VALUE ! 3402: {TEVAL{EQU{TESUB+1{{{(=VRVAL) TABLE ELEMENT VALUE ! 3403: {TENXT{EQU{TEVAL+1{{{LINK TO NEXT TEBLK ! 3404: * SEE S$CNV WHERE RELATION IS ASSUMED WITH TENXT AND TBBUK ! 3405: {TESI${EQU{TENXT+1{{{SIZE OF TEBLK IN WORDS ! 3406: * ! 3407: * TENXT POINTS TO THE NEXT TEBLK ON THE HASH CHAIN FROM THE ! 3408: * TBBUK CHAIN FOR THIS HASH INDEX. AT THE END OF THE CHAIN, ! 3409: * TENXT POINTS BACK TO THE START OF THE TBBLK. ! 3410: * ! 3411: * TEVAL CONTAINS A DATA POINTER OR A TRBLK POINTER. ! 3412: * ! 3413: * TESUB CONTAINS A DATA POINTER. ! 3414: {{EJC{{{{ ! 3415: * ! 3416: * TRAP BLOCK (TRBLK) ! 3417: * ! 3418: * A TRAP BLOCK IS USED TO REPRESENT A TRACE OR INPUT OR ! 3419: * OUTPUT ASSOCIATION IN RESPONSE TO A CALL TO THE TRACE ! 3420: * INPUT OR OUTPUT SYSTEM FUNCTIONS. SEE BELOW FOR DETAILS ! 3421: * ! 3422: * +------------------------------------+ ! 3423: * I TRIDN I ! 3424: * +------------------------------------+ ! 3425: * I TRTYP I ! 3426: * +------------------------------------+ ! 3427: * I TRVAL OR TRLBL OR TRNXT OR TRKVR I ! 3428: * +------------------------------------+ ! 3429: * I TRTAG OR TRTER OR TRTRF I ! 3430: * +------------------------------------+ ! 3431: * I TRFNC OR TRFPT I ! 3432: * +------------------------------------+ ! 3433: * ! 3434: {TRIDN{EQU{0{{{POINTER TO DUMMY ROUTINE B$TRT ! 3435: {TRTYP{EQU{TRIDN+1{{{TRAP TYPE CODE ! 3436: {TRVAL{EQU{TRTYP+1{{{VALUE OF TRAPPED VARIABLE (=VRVAL) ! 3437: {TRNXT{EQU{TRVAL{{{PTR TO NEXT TRBLK ON TRBLK CHAIN ! 3438: {TRLBL{EQU{TRVAL{{{PTR TO ACTUAL LABEL (TRACED LABEL) ! 3439: {TRKVR{EQU{TRVAL{{{VRBLK POINTER FOR KEYWORD TRACE ! 3440: {TRTAG{EQU{TRVAL+1{{{TRACE TAG ! 3441: {TRTER{EQU{TRTAG{{{PTR TO TERMINAL VRBLK OR NULL ! 3442: {TRTRF{EQU{TRTAG{{{PTR TO TRBLK HOLDING FCBLK PTR ! 3443: {TRFNC{EQU{TRTAG+1{{{TRACE FUNCTION VRBLK (ZERO IF NONE) ! 3444: {TRFPT{EQU{TRFNC{{{FCBLK PTR FOR SYSIO ! 3445: {TRSI${EQU{TRFNC+1{{{NUMBER OF WORDS IN TRBLK ! 3446: * ! 3447: {TRTIN{EQU{0{{{TRACE TYPE FOR INPUT ASSOCIATION ! 3448: {TRTAC{EQU{TRTIN+1{{{TRACE TYPE FOR ACCESS TRACE ! 3449: {TRTVL{EQU{TRTAC+1{{{TRACE TYPE FOR VALUE TRACE ! 3450: {TRTOU{EQU{TRTVL+1{{{TRACE TYPE FOR OUTPUT ASSOCIATION ! 3451: {TRTFC{EQU{TRTOU+1{{{TRACE TYPE FOR FCBLK IDENTIFICATION ! 3452: {{EJC{{{{ ! 3453: * ! 3454: * TRAP BLOCK (CONTINUED) ! 3455: * ! 3456: * VARIABLE INPUT ASSOCIATION ! 3457: * ! 3458: * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK ! 3459: * INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE ! 3460: * OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS ! 3461: * CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK. ! 3462: * ! 3463: * TRTYP IS SET TO TRTIN ! 3464: * TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL ! 3465: * TRTER IS A POINTER TO SVBLK IF ASSOCIATION IS ! 3466: * FOR INPUT, TERMINAL, ELSE IT IS NULL. ! 3467: * TRTRF POINTS TO THE TRAP BLOCK WHICH IN TURN POINTS ! 3468: * TO AN FCBLK USED FOR I/O ASSOCIATION. ! 3469: * TRFPT IS THE FCBLK PTR RETURNED BY SYSIO. ! 3470: * ! 3471: * VARIABLE ACCESS TRACE ASSOCIATION ! 3472: * ! 3473: * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK ! 3474: * INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE ! 3475: * OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS ! 3476: * CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK. ! 3477: * ! 3478: * TRTYP IS SET TO TRTAC ! 3479: * TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL ! 3480: * TRTAG IS THE TRACE TAG (0 IF NONE) ! 3481: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE) ! 3482: * ! 3483: * VARIABLE VALUE TRACE ASSOCIATION ! 3484: * ! 3485: * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK ! 3486: * INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE ! 3487: * OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS ! 3488: * CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK. ! 3489: * ! 3490: * TRTYP IS SET TO TRTVL ! 3491: * TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL ! 3492: * TRTAG IS THE TRACE TAG (0 IF NONE) ! 3493: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE) ! 3494: {{EJC{{{{ ! 3495: * TRAP BLOCK (CONTINUED) ! 3496: * ! 3497: * VARIABLE OUTPUT ASSOCIATION ! 3498: * ! 3499: * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK ! 3500: * INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE ! 3501: * OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS ! 3502: * CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK. ! 3503: * ! 3504: * TRTYP IS SET TO TRTOU ! 3505: * TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL ! 3506: * TRTER IS A POINTER TO SVBLK IF ASSOCIATION IS ! 3507: * FOR OUTPUT, TERMINAL, ELSE IT IS NULL. ! 3508: * TRTRF POINTS TO THE TRAP BLOCK WHICH IN TURN POINTS ! 3509: * TO AN FCBLK USED FOR I/O ASSOCIATION. ! 3510: * TRFPT IS THE FCBLK PTR RETURNED BY SYSIO. ! 3511: * ! 3512: * FUNCTION CALL TRACE ! 3513: * ! 3514: * THE PFCTR FIELD OF THE CORRESPONDING PFBLK IS SET ! 3515: * TO POINT TO A TRBLK. ! 3516: * ! 3517: * TRTYP IS SET TO TRTIN ! 3518: * TRNXT IS ZERO ! 3519: * TRTAG IS THE TRACE TAG (0 IF NONE) ! 3520: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE) ! 3521: * ! 3522: * FUNCTION RETURN TRACE ! 3523: * ! 3524: * THE PFRTR FIELD OF THE CORRESPONDING PFBLK IS SET ! 3525: * TO POINT TO A TRBLK ! 3526: * ! 3527: * TRTYP IS SET TO TRTIN ! 3528: * TRNXT IS ZERO ! 3529: * TRTAG IS THE TRACE TAG (0 IF NONE) ! 3530: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE) ! 3531: * ! 3532: * LABEL TRACE ! 3533: * ! 3534: * THE VRLBL OF THE VRBLK FOR THE LABEL IS ! 3535: * CHANGED TO POINT TO A TRBLK AND THE VRTRA FIELD IS ! 3536: * SET TO B$VRT TO ACTIVATE THE CHECK. ! 3537: * ! 3538: * TRTYP IS SET TO TRTIN ! 3539: * TRLBL POINTS TO THE ACTUAL LABEL (CDBLK) VALUE ! 3540: * TRTAG IS THE TRACE TAG (0 IF NONE) ! 3541: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE) ! 3542: {{EJC{{{{ ! 3543: * ! 3544: * TRAP BLOCK (CONTINUED) ! 3545: * ! 3546: * KEYWORD TRACE ! 3547: * ! 3548: * KEYWORDS WHICH CAN BE TRACED POSSESS A UNIQUE ! 3549: * LOCATION WHICH IS ZERO IF THERE IS NO TRACE AND ! 3550: * POINTS TO A TRBLK IF THERE IS A TRACE. THE LOCATIONS ! 3551: * ARE AS FOLLOWS. ! 3552: * ! 3553: * R$ERT ERRTYPE ! 3554: * R$FNC FNCLEVEL ! 3555: * R$STC STCOUNT ! 3556: * ! 3557: * THE FORMAT OF THE TRBLK IS AS FOLLOWS. ! 3558: * ! 3559: * TRTYP IS SET TO TRTIN ! 3560: * TRKVR IS A POINTER TO THE VRBLK FOR THE KEYWORD ! 3561: * TRTAG IS THE TRACE TAG (0 IF NONE) ! 3562: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE) ! 3563: * ! 3564: * INPUT/OUTPUT FILE ARG1 TRAP BLOCK ! 3565: * ! 3566: * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK ! 3567: * INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE OF ! 3568: * A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS ! 3569: * CONTAIN =B$VRA AND =B$VRV. THIS TRAP BLOCK IS USED ! 3570: * TO HOLD A POINTER TO THE FCBLK WHICH AN ! 3571: * IMPLEMENTATION MAY REQUEST TO HOLD INFORMATION ! 3572: * ABOUT A FILE. ! 3573: * ! 3574: * TRTYP IS SET TO TRTFC ! 3575: * TRNEXT POINTS TO NEXT TRBLK OR TRVAL IS VARIABLE VAL ! 3576: * TRFNM IS 0 ! 3577: * TRFPT IS THE FCBLK POINTER. ! 3578: * ! 3579: * NOTE THAT WHEN MULTIPLE TRAPS ARE SET ON A VARIABLE ! 3580: * THE ORDER IS IN ASCENDING VALUE OF TRTYP FIELD. ! 3581: * ! 3582: * INPUT ASSOCIATION (IF PRESENT) ! 3583: * ACCESS TRACE (IF PRESENT) ! 3584: * VALUE TRACE (IF PRESENT) ! 3585: * OUTPUT ASSOCIATION (IF PRESENT) ! 3586: * ! 3587: * THE ACTUAL VALUE OF THE VARIABLE IS STORED IN THE TRVAL ! 3588: * FIELD OF THE LAST TRBLK ON THE CHAIN. ! 3589: * ! 3590: * THIS IMPLEMENTATION DOES NOT PERMIT TRACE OR I/O ! 3591: * ASSOCIATIONS TO ANY OF THE PSEUDO-VARIABLES. ! 3592: {{EJC{{{{ ! 3593: * ! 3594: * VECTOR BLOCK (VCBLK) ! 3595: * ! 3596: * A VCBLK IS USED TO REPRESENT AN ARRAY VALUE WHICH HAS ! 3597: * ONE DIMENSION WHOSE LOWER BOUND IS ONE. ALL OTHER ARRAYS ! 3598: * ARE REPRESENTED BY ARBLKS. A VCBLK IS CREATED BY THE ! 3599: * SYSTEM FUNCTION ARRAY (S$ARR) WHEN PASSED AN INTEGER ARG. ! 3600: * ! 3601: * +------------------------------------+ ! 3602: * I VCTYP I ! 3603: * +------------------------------------+ ! 3604: * I IDVAL I ! 3605: * +------------------------------------+ ! 3606: * I VCLEN I ! 3607: * +------------------------------------+ ! 3608: * I VCVLS I ! 3609: * +------------------------------------+ ! 3610: * ! 3611: {VCTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$VCT ! 3612: {VCLEN{EQU{OFFS2{{{LENGTH OF VCBLK IN BYTES ! 3613: {VCVLS{EQU{OFFS3{{{START OF VECTOR VALUES ! 3614: {VCSI${EQU{VCVLS{{{SIZE OF STANDARD FIELDS IN VCBLK ! 3615: {VCVLB{EQU{VCVLS-1{{{OFFSET ONE WORD BEHIND VCVLS ! 3616: {VCTBD{EQU{TBSI$-VCSI${{{DIFFERENCE IN SIZES - SEE PRTVL ! 3617: * ! 3618: * VCVLS ARE EITHER DATA POINTERS OR TRBLK POINTERS ! 3619: * ! 3620: * THE DIMENSION CAN BE DEDUCED FROM VCLEN. ! 3621: {{EJC{{{{ ! 3622: * ! 3623: * VARIABLE BLOCK (VRBLK) ! 3624: * ! 3625: * A VARIABLE BLOCK IS BUILT IN THE STATIC MEMORY AREA ! 3626: * FOR EVERY VARIABLE REFERENCED OR CREATED BY A PROGRAM. ! 3627: * ! 3628: * NOTE THAT SINCE THESE BLOCKS ONLY OCCUR IN THE STATIC ! 3629: * REGION, IT IS PERMISSIBLE TO POINT TO ANY WORD IN ! 3630: * THE BLOCK AND THIS IS USED TO PROVIDE THREE DISTINCT ! 3631: * ACCESS POINTS FROM THE GENERATED CODE AS FOLLOWS. ! 3632: * ! 3633: * 1) POINT TO VRGET (FIRST WORD OF VRBLK) TO LOAD THE ! 3634: * VALUE OF THE VARIABLE ONTO THE MAIN STACK. ! 3635: * ! 3636: * 2) POINT TO VRSTO (SECOND WORD OF VRBLK) TO STORE THE ! 3637: * TOP STACK ELEMENT AS THE VALUE OF THE VARIABLE. ! 3638: * ! 3639: * 3) POINT TO VRTRA (FOURTH WORD OF VRBLK) TO JUMP TO ! 3640: * THE LABEL ASSOCIATED WITH THE VARIABLE NAME. ! 3641: * ! 3642: * +------------------------------------+ ! 3643: * I VRGET I ! 3644: * +------------------------------------+ ! 3645: * I VRSTO I ! 3646: * +------------------------------------+ ! 3647: * I VRVAL I ! 3648: * +------------------------------------+ ! 3649: * I VRTRA I ! 3650: * +------------------------------------+ ! 3651: * I VRLBL I ! 3652: * +------------------------------------+ ! 3653: * I VRFNC I ! 3654: * +------------------------------------+ ! 3655: * I VRNXT I ! 3656: * +------------------------------------+ ! 3657: * I VRLEN I ! 3658: * +------------------------------------+ ! 3659: * / / ! 3660: * / VRCHS = VRSVP / ! 3661: * / / ! 3662: * +------------------------------------+ ! 3663: {{EJC{{{{ ! 3664: * ! 3665: * VARIABLE BLOCK (CONTINUED) ! 3666: * ! 3667: {VRGET{EQU{0{{{POINTER TO ROUTINE TO LOAD VALUE ! 3668: {VRSTO{EQU{VRGET+1{{{POINTER TO ROUTINE TO STORE VALUE ! 3669: {VRVAL{EQU{VRSTO+1{{{VARIABLE VALUE ! 3670: {VRVLO{EQU{VRVAL-VRSTO{{{OFFSET TO VALUE FROM STORE FIELD ! 3671: {VRTRA{EQU{VRVAL+1{{{POINTER TO ROUTINE TO JUMP TO LABEL ! 3672: {VRLBL{EQU{VRTRA+1{{{POINTER TO CODE FOR LABEL ! 3673: {VRLBO{EQU{VRLBL-VRTRA{{{OFFSET TO LABEL FROM TRANSFER FIELD ! 3674: {VRFNC{EQU{VRLBL+1{{{POINTER TO FUNCTION BLOCK ! 3675: {VRNXT{EQU{VRFNC+1{{{POINTER TO NEXT VRBLK ON HASH CHAIN ! 3676: {VRLEN{EQU{VRNXT+1{{{LENGTH OF NAME (OR ZERO) ! 3677: {VRCHS{EQU{VRLEN+1{{{CHARACTERS OF NAME (VRLEN GT 0) ! 3678: {VRSVP{EQU{VRLEN+1{{{PTR TO SVBLK (VRLEN EQ 0) ! 3679: {VRSI${EQU{VRCHS+1{{{NUMBER OF STANDARD FIELDS IN VRBLK ! 3680: {VRSOF{EQU{VRLEN-SCLEN{{{OFFSET TO DUMMY SCBLK FOR NAME ! 3681: {VRSVO{EQU{VRSVP-VRSOF{{{PSEUDO-OFFSET TO VRSVP FIELD ! 3682: * ! 3683: * VRGET = B$VRL IF NOT INPUT ASSOCIATED OR ACCESS TRACED ! 3684: * VRGET = B$VRA IF INPUT ASSOCIATED OR ACCESS TRACED ! 3685: * ! 3686: * VRSTO = B$VRS IF NOT OUTPUT ASSOCIATED OR VALUE TRACED ! 3687: * VRSTO = B$VRV IF OUTPUT ASSOCIATED OR VALUE TRACED ! 3688: * VRSTO = B$VRE IF VALUE IS PROTECTED PATTERN VALUE ! 3689: * ! 3690: * VRVAL POINTS TO THE APPROPRIATE VALUE UNLESS THE ! 3691: * VARIABLE IS I/O/TRACE ASSOCIATED IN WHICH CASE, VRVAL ! 3692: * POINTS TO AN APPROPRIATE TRBLK (TRAP BLOCK) CHAIN. ! 3693: * ! 3694: * VRTRA = B$VRG IF THE LABEL IS NOT TRACED ! 3695: * VRTRA = B$VRT IF THE LABEL IS TRACED ! 3696: * ! 3697: * VRLBL POINTS TO A CDBLK IF THERE IS A LABEL ! 3698: * VRLBL POINTS TO THE SVBLK SVLBL FIELD FOR A SYSTEM LABEL ! 3699: * VRLBL POINTS TO STNDL FOR AN UNDEFINED LABEL ! 3700: * VRLBL POINTS TO A TRBLK IF THE LABEL IS TRACED ! 3701: * ! 3702: * VRFNC POINTS TO A FFBLK FOR A FIELD FUNCTION ! 3703: * VRFNC POINTS TO A DFBLK FOR A DATATYPE FUNCTION ! 3704: * VRFNC POINTS TO A PFBLK FOR A PROGRAM DEFINED FUNCTION ! 3705: * VRFNC POINTS TO A EFBLK FOR AN EXTERNAL LOADED FUNCTION ! 3706: * VRFNC POINTS TO SVFNC (SVBLK) FOR A SYSTEM FUNCTION ! 3707: * VRFNC POINTS TO STNDF IF THE FUNCTION IS UNDEFINED ! 3708: * ! 3709: * VRNXT POINTS TO THE NEXT VRBLK ON THIS CHAIN UNLESS ! 3710: * THIS IS THE END OF THE CHAIN IN WHICH CASE IT IS ZERO. ! 3711: * ! 3712: * VRLEN IS THE NAME LENGTH FOR A NON-SYSTEM VARIABLE. ! 3713: * VRLEN IS ZERO FOR A SYSTEM VARIABLE. ! 3714: * ! 3715: * VRCHS IS THE NAME (LJRZ) IF VRLEN IS NON-ZERO. ! 3716: * VRSVP IS A PTR TO THE SVBLK IF VRLEN IS ZERO. ! 3717: {{EJC{{{{ ! 3718: * ! 3719: * FORMAT OF A NON-RELOCATABLE EXTERNAL BLOCK (XNBLK) ! 3720: * ! 3721: * AN XNBLK IS A BLOCK REPRESENTING AN UNKNOWN (EXTERNAL) ! 3722: * DATA VALUE. THE BLOCK CONTAINS NO POINTERS TO OTHER ! 3723: * RELOCATABLE BLOCKS. AN XNBLK IS USED BY EXTERNAL FUNCTION ! 3724: * PROCESSING OR POSSIBLY FOR SYSTEM I/O ROUTINES ETC. ! 3725: * THE MACRO-SYSTEM ITSELF DOES NOT USE XNBLKS. ! 3726: * THIS TYPE OF BLOCK MAY BE USED AS A FILE CONTROL BLOCK. ! 3727: * SEE SYSFC,SYSIN,SYSOU,S$INP,S$OUP FOR DETAILS. ! 3728: * ! 3729: * +------------------------------------+ ! 3730: * I XNTYP I ! 3731: * +------------------------------------+ ! 3732: * I XNLEN I ! 3733: * +------------------------------------+ ! 3734: * / / ! 3735: * / XNDTA / ! 3736: * / / ! 3737: * +------------------------------------+ ! 3738: * ! 3739: {XNTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$XNT ! 3740: {XNLEN{EQU{XNTYP+1{{{LENGTH OF XNBLK IN BYTES ! 3741: {XNDTA{EQU{XNLEN+1{{{DATA WORDS ! 3742: {XNSI${EQU{XNDTA{{{SIZE OF STANDARD FIELDS IN XNBLK ! 3743: * ! 3744: * NOTE THAT THE TERM NON-RELOCATABLE REFERS TO THE CONTENTS ! 3745: * AND NOT THE BLOCK ITSELF. AN XNBLK CAN BE MOVED AROUND IF ! 3746: * IT IS BUILT IN THE DYNAMIC MEMORY AREA. ! 3747: {{EJC{{{{ ! 3748: * ! 3749: * RELOCATABLE EXTERNAL BLOCK (XRBLK) ! 3750: * ! 3751: * AN XRBLK IS A BLOCK REPRESENTING AN UNKNOWN (EXTERNAL) ! 3752: * DATA VALUE. THE DATA AREA IN THIS BLOCK CONSISTS ONLY ! 3753: * OF ADDRESS VALUES AND ANY ADDRESSES POINTING INTO THE ! 3754: * DYNAMIC MEMORY AREA MUST POINT TO THE START OF OTHER ! 3755: * DATA BLOCKS. SEE ALSO DESCRIPTION OF XNBLK. ! 3756: * THIS TYPE OF BLOCK MAY BE USED AS A FILE CONTROL BLOCK. ! 3757: * SEE SYSFC,SYSIN,SYSOU,S$INP,S$OUP FOR DETAILS. ! 3758: * ! 3759: * +------------------------------------+ ! 3760: * I XRTYP I ! 3761: * +------------------------------------+ ! 3762: * I XRLEN I ! 3763: * +------------------------------------+ ! 3764: * / / ! 3765: * / XRPTR / ! 3766: * / / ! 3767: * +------------------------------------+ ! 3768: * ! 3769: {XRTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$XRT ! 3770: {XRLEN{EQU{XRTYP+1{{{LENGTH OF XRBLK IN BYTES ! 3771: {XRPTR{EQU{XRLEN+1{{{START OF ADDRESS POINTERS ! 3772: {XRSI${EQU{XRPTR{{{SIZE OF STANDARD FIELDS IN XRBLK ! 3773: {{EJC{{{{ ! 3774: * ! 3775: * S$CNV (CONVERT) FUNCTION SWITCH CONSTANTS. THE VALUES ! 3776: * ARE TIED TO THE ORDER OF THE ENTRIES IN THE SVCTB TABLE ! 3777: * AND HENCE TO THE BRANCH TABLE IN S$CNV. ! 3778: * ! 3779: {CNVST{EQU{8{{{MAX STANDARD TYPE CODE FOR CONVERT ! 3780: {CNVRT{EQU{CNVST+1{{{CONVERT CODE FOR REALS ! 3781: {CNVBT{EQU{CNVRT+1{{{CONVERT CODE FOR BUFFER ! 3782: {CNVTT{EQU{CNVBT+1{{{BSW CODE FOR CONVERT ! 3783: * ! 3784: * INPUT IMAGE LENGTH ! 3785: * ! 3786: {INILN{EQU{132{{{DEFAULT IMAGE LENGTH FOR COMPILER ! 3787: {INILS{EQU{80{{{IMAGE LENGTH IF -SEQU IN EFFECT ! 3788: * ! 3789: {IONMB{EQU{2{{{NAME BASE USED FOR IOCHN IN SYSIO ! 3790: {IONMO{EQU{4{{{NAME OFFSET USED FOR IOCHN IN SYSIO ! 3791: * ! 3792: * IN GENERAL, MEANINGFUL MNEMONICS SHOULD BE USED FOR ! 3793: * OFFSETS. HOWEVER FOR SMALL INTEGERS USED OFTEN IN ! 3794: * LITERALS THE FOLLOWING GENERAL DEFINITIONS ARE PROVIDED. ! 3795: * ! 3796: {NUM01{EQU{1{{{ ! 3797: {NUM02{EQU{2{{{ ! 3798: {NUM03{EQU{3{{{ ! 3799: {NUM04{EQU{4{{{ ! 3800: {NUM05{EQU{5{{{ ! 3801: {NUM06{EQU{6{{{ ! 3802: {NUM07{EQU{7{{{ ! 3803: {NUM08{EQU{8{{{ ! 3804: {NUM09{EQU{9{{{ ! 3805: {NUM10{EQU{10{{{ ! 3806: {NINI8{EQU{998{{{ ! 3807: {NINI9{EQU{999{{{ ! 3808: {THSND{EQU{1000{{{ ! 3809: {{EJC{{{{ ! 3810: * ! 3811: * NUMBERS OF UNDEFINED SPITBOL OPERATORS ! 3812: * ! 3813: {OPBUN{EQU{5{{{NO. OF BINARY UNDEFINED OPS ! 3814: {OPUUN{EQU{6{{{NO OF UNARY UNDEFINED OPS ! 3815: * ! 3816: * OFFSETS USED IN PRTSN, PRTMI AND ACESS ! 3817: * ! 3818: {PRSNF{EQU{13{{{OFFSET USED IN PRTSN ! 3819: {PRTMF{EQU{15{{{OFFSET TO COL 15 (PRTMI) ! 3820: {RILEN{EQU{120{{{BUFFER LENGTH FOR SYSRI ! 3821: * ! 3822: * CODES FOR STAGES OF PROCESSING ! 3823: * ! 3824: {STGIC{EQU{0{{{INITIAL COMPILE ! 3825: {STGXC{EQU{STGIC+1{{{EXECUTION COMPILE (CODE) ! 3826: {STGEV{EQU{STGXC+1{{{EXPRESSION EVAL DURING EXECUTION ! 3827: {STGXT{EQU{STGEV+1{{{EXECUTION TIME ! 3828: {STGCE{EQU{STGXT+1{{{INITIAL COMPILE AFTER END LINE ! 3829: {STGXE{EQU{STGCE+1{{{EXEC. COMPILE AFTER END LINE ! 3830: {STGND{EQU{STGCE-STGIC{{{DIFFERENCE IN STAGE AFTER END ! 3831: {STGEE{EQU{STGXE+1{{{EVAL EVALUATING EXPRESSION ! 3832: {STGNO{EQU{STGEE+1{{{NUMBER OF CODES ! 3833: {{EJC{{{{ ! 3834: * ! 3835: * ! 3836: * STATEMENT NUMBER PAD COUNT FOR LISTR ! 3837: * ! 3838: {STNPD{EQU{8{{{STATEMENT NO. PAD COUNT ! 3839: * ! 3840: * SYNTAX TYPE CODES ! 3841: * ! 3842: * THESE CODES ARE RETURNED FROM THE SCANE PROCEDURE. ! 3843: * ! 3844: * THEY ARE SPACED 3 APART FOR THE BENEFIT OF EXPAN. ! 3845: * ! 3846: {T$UOP{EQU{0{{{UNARY OPERATOR ! 3847: {T$LPR{EQU{T$UOP+3{{{LEFT PAREN ! 3848: {T$LBR{EQU{T$LPR+3{{{LEFT BRACKET ! 3849: {T$CMA{EQU{T$LBR+3{{{COMMA ! 3850: {T$FNC{EQU{T$CMA+3{{{FUNCTION CALL ! 3851: {T$VAR{EQU{T$FNC+3{{{VARIABLE ! 3852: {T$CON{EQU{T$VAR+3{{{CONSTANT ! 3853: {T$BOP{EQU{T$CON+3{{{BINARY OPERATOR ! 3854: {T$RPR{EQU{T$BOP+3{{{RIGHT PAREN ! 3855: {T$RBR{EQU{T$RPR+3{{{RIGHT BRACKET ! 3856: {T$COL{EQU{T$RBR+3{{{COLON ! 3857: {T$SMC{EQU{T$COL+3{{{SEMI-COLON ! 3858: * ! 3859: * THE FOLLOWING DEFINITIONS ARE USED ONLY IN THE GOTO FIELD ! 3860: * ! 3861: {T$FGO{EQU{T$SMC+1{{{FAILURE GOTO ! 3862: {T$SGO{EQU{T$FGO+1{{{SUCCESS GOTO ! 3863: * ! 3864: * THE ABOVE CODES ARE GROUPED SO THAT CODES FOR ELEMENTS ! 3865: * WHICH CAN LEGITIMATELY IMMEDIATELY PRECEDE A UNARY ! 3866: * OPERATOR COME FIRST TO FACILITATE OPERATOR SYNTAX CHECK. ! 3867: * ! 3868: {T$UOK{EQU{T$FNC{{{LAST CODE OK BEFORE UNARY OPERATOR ! 3869: {{EJC{{{{ ! 3870: * ! 3871: * DEFINITIONS OF VALUES FOR EXPAN JUMP TABLE ! 3872: * ! 3873: {T$UO0{EQU{T$UOP+0{{{UNARY OPERATOR, STATE ZERO ! 3874: {T$UO1{EQU{T$UOP+1{{{UNARY OPERATOR, STATE ONE ! 3875: {T$UO2{EQU{T$UOP+2{{{UNARY OPERATOR, STATE TWO ! 3876: {T$LP0{EQU{T$LPR+0{{{LEFT PAREN, STATE ZERO ! 3877: {T$LP1{EQU{T$LPR+1{{{LEFT PAREN, STATE ONE ! 3878: {T$LP2{EQU{T$LPR+2{{{LEFT PAREN, STATE TWO ! 3879: {T$LB0{EQU{T$LBR+0{{{LEFT BRACKET, STATE ZERO ! 3880: {T$LB1{EQU{T$LBR+1{{{LEFT BRACKET, STATE ONE ! 3881: {T$LB2{EQU{T$LBR+2{{{LEFT BRACKET, STATE TWO ! 3882: {T$CM0{EQU{T$CMA+0{{{COMMA, STATE ZERO ! 3883: {T$CM1{EQU{T$CMA+1{{{COMMA, STATE ONE ! 3884: {T$CM2{EQU{T$CMA+2{{{COMMA, STATE TWO ! 3885: {T$FN0{EQU{T$FNC+0{{{FUNCTION CALL, STATE ZERO ! 3886: {T$FN1{EQU{T$FNC+1{{{FUNCTION CALL, STATE ONE ! 3887: {T$FN2{EQU{T$FNC+2{{{FUNCTION CALL, STATE TWO ! 3888: {T$VA0{EQU{T$VAR+0{{{VARIABLE, STATE ZERO ! 3889: {T$VA1{EQU{T$VAR+1{{{VARIABLE, STATE ONE ! 3890: {T$VA2{EQU{T$VAR+2{{{VARIABLE, STATE TWO ! 3891: {T$CO0{EQU{T$CON+0{{{CONSTANT, STATE ZERO ! 3892: {T$CO1{EQU{T$CON+1{{{CONSTANT, STATE ONE ! 3893: {T$CO2{EQU{T$CON+2{{{CONSTANT, STATE TWO ! 3894: {T$BO0{EQU{T$BOP+0{{{BINARY OPERATOR, STATE ZERO ! 3895: {T$BO1{EQU{T$BOP+1{{{BINARY OPERATOR, STATE ONE ! 3896: {T$BO2{EQU{T$BOP+2{{{BINARY OPERATOR, STATE TWO ! 3897: {T$RP0{EQU{T$RPR+0{{{RIGHT PAREN, STATE ZERO ! 3898: {T$RP1{EQU{T$RPR+1{{{RIGHT PAREN, STATE ONE ! 3899: {T$RP2{EQU{T$RPR+2{{{RIGHT PAREN, STATE TWO ! 3900: {T$RB0{EQU{T$RBR+0{{{RIGHT BRACKET, STATE ZERO ! 3901: {T$RB1{EQU{T$RBR+1{{{RIGHT BRACKET, STATE ONE ! 3902: {T$RB2{EQU{T$RBR+2{{{RIGHT BRACKET, STATE TWO ! 3903: {T$CL0{EQU{T$COL+0{{{COLON, STATE ZERO ! 3904: {T$CL1{EQU{T$COL+1{{{COLON, STATE ONE ! 3905: {T$CL2{EQU{T$COL+2{{{COLON, STATE TWO ! 3906: {T$SM0{EQU{T$SMC+0{{{SEMICOLON, STATE ZERO ! 3907: {T$SM1{EQU{T$SMC+1{{{SEMICOLON, STATE ONE ! 3908: {T$SM2{EQU{T$SMC+2{{{SEMICOLON, STATE TWO ! 3909: * ! 3910: {T$NES{EQU{T$SM2+1{{{NUMBER OF ENTRIES IN BRANCH TABLE ! 3911: {{EJC{{{{ ! 3912: * ! 3913: * DEFINITION OF OFFSETS USED IN CONTROL CARD PROCESSING ! 3914: * ! 3915: {CC$CA{EQU{0{{{-CASE ! 3916: {CC$DO{EQU{CC$CA+1{{{-DOUBLE ! 3917: {CC$DU{EQU{CC$DO+1{{{-DUMP ! 3918: {CC$EJ{EQU{CC$DU+1{{{-EJECT ! 3919: {CC$ER{EQU{CC$EJ+1{{{-ERRORS ! 3920: {CC$EX{EQU{CC$ER+1{{{-EXECUTE ! 3921: {CC$FA{EQU{CC$EX+1{{{-FAIL ! 3922: {CC$LI{EQU{CC$FA+1{{{-LIST ! 3923: {CC$NR{EQU{CC$LI+1{{{-NOERRORS ! 3924: {CC$NX{EQU{CC$NR+1{{{-NOEXECUTE ! 3925: {CC$NF{EQU{CC$NX+1{{{-NOFAIL ! 3926: {CC$NL{EQU{CC$NF+1{{{-NOLIST ! 3927: {CC$NO{EQU{CC$NL+1{{{-NOOPT ! 3928: {CC$NP{EQU{CC$NO+1{{{-NOPRINT ! 3929: {CC$OP{EQU{CC$NP+1{{{-OPTIMISE ! 3930: {CC$PR{EQU{CC$OP+1{{{-PRINT ! 3931: {CC$SI{EQU{CC$PR+1{{{-SINGLE ! 3932: {CC$SP{EQU{CC$SI+1{{{-SPACE ! 3933: {CC$ST{EQU{CC$SP+1{{{-STITL ! 3934: {CC$TI{EQU{CC$ST+1{{{-TITLE ! 3935: {CC$TR{EQU{CC$TI+1{{{-TRACE ! 3936: {CC$NC{EQU{CC$TR+1{{{NUMBER OF CONTROL CARDS ! 3937: {CCNOC{EQU{4{{{NO. OF CHARS INCLUDED IN MATCH ! 3938: {CCOFS{EQU{7{{{OFFSET TO START OF TITLE/SUBTITLE ! 3939: {{EJC{{{{ ! 3940: * ! 3941: * DEFINITIONS OF STACK OFFSETS USED IN CMPIL PROCEDURE ! 3942: * ! 3943: * SEE DESCRIPTION AT START OF CMPIL PROCEDURE FOR DETAILS ! 3944: * OF USE OF THESE LOCATIONS ON THE STACK. ! 3945: * ! 3946: {CMSTM{EQU{0{{{TREE FOR STATEMENT BODY ! 3947: {CMSGO{EQU{CMSTM+1{{{TREE FOR SUCCESS GOTO ! 3948: {CMFGO{EQU{CMSGO+1{{{TREE FOR FAIL GOTO ! 3949: {CMCGO{EQU{CMFGO+1{{{CONDITIONAL GOTO FLAG ! 3950: {CMPCD{EQU{CMCGO+1{{{PREVIOUS CDBLK POINTER ! 3951: {CMFFP{EQU{CMPCD+1{{{FAILURE FILL IN FLAG FOR PREVIOUS ! 3952: {CMFFC{EQU{CMFFP+1{{{FAILURE FILL IN FLAG FOR CURRENT ! 3953: {CMSOP{EQU{CMFFC+1{{{SUCCESS FILL IN OFFSET FOR PREVIOUS ! 3954: {CMSOC{EQU{CMSOP+1{{{SUCCESS FILL IN OFFSET FOR CURRENT ! 3955: {CMLBL{EQU{CMSOC+1{{{PTR TO VRBLK FOR CURRENT LABEL ! 3956: {CMTRA{EQU{CMLBL+1{{{PTR TO ENTRY CDBLK ! 3957: * ! 3958: {CMNEN{EQU{CMTRA+1{{{COUNT OF STACK ENTRIES FOR CMPIL ! 3959: * ! 3960: * A FEW CONSTANTS USED BY THE PROFILER ! 3961: {PFPD1{EQU{8{{{PAD POSITIONS ... ! 3962: {PFPD2{EQU{20{{{... FOR PROFILE ... ! 3963: {PFPD3{EQU{32{{{... PRINTOUT ! 3964: {PF$I2{EQU{CFP$I+CFP$I{{{SIZE OF TABLE ENTRY (2 INTS) ! 3965: * ! 3966: {{TTL{S{{{P I T B O L -- CONSTANT SECTION ! 3967: * ! 3968: * THIS SECTION CONSISTS ENTIRELY OF ASSEMBLED CONSTANTS. ! 3969: * ! 3970: * ALL LABEL NAMES ARE FIVE LETTERS. THE ORDER IS ! 3971: * APPROXIMATELY ALPHABETICAL, BUT IN SOME CASES (ALWAYS ! 3972: * DOCUMENTED), CONSTANTS MUST BE PLACED IN SOME SPECIAL ! 3973: * ORDER WHICH MUST NOT BE DISTURBED. ! 3974: * ! 3975: * IT MUST ALSO BE REMEMBERED THAT THERE IS A REQUIREMENT ! 3976: * FOR NO FORWARD REFERENCES WHICH ALSO DISTURBS THE ! 3977: * ALPHABETICAL ORDER IN SOME CASES. ! 3978: * ! 3979: {{SEC{{{{START OF CONSTANT SECTION ! 3980: * ! 3981: * FREE STORE PERCENTAGE (USED BY ALLOC) ! 3982: * ! 3983: {ALFSP{DAC{E$FSP{{{FREE STORE PERCENTAGE ! 3984: * ! 3985: * BIT CONSTANTS FOR GENERAL USE ! 3986: * ! 3987: {BITS0{DBC{0{{{ALL ZERO BITS ! 3988: {BITS1{DBC{1{{{ONE BIT IN LOW ORDER POSITION ! 3989: {BITS2{DBC{2{{{BIT IN POSITION 2 ! 3990: {BITS3{DBC{4{{{BIT IN POSITION 3 ! 3991: {BITS4{DBC{8{{{BIT IN POSITION 4 ! 3992: {BITS5{DBC{16{{{BIT IN POSITION 5 ! 3993: {BITS6{DBC{32{{{BIT IN POSITION 6 ! 3994: {BITS7{DBC{64{{{BIT IN POSITION 7 ! 3995: {BITS8{DBC{128{{{BIT IN POSITION 8 ! 3996: {BITS9{DBC{256{{{BIT IN POSITION 9 ! 3997: {BIT10{DBC{512{{{BIT IN POSITION 10 ! 3998: {BITSM{DBC{CFP$M{{{MASK FOR MAX INTEGER ! 3999: * ! 4000: * BIT CONSTANTS FOR SVBLK (SVBIT FIELD) TESTS ! 4001: * ! 4002: {BTFNC{DBC{SVFNC{{{BIT TO TEST FOR FUNCTION ! 4003: {BTKNM{DBC{SVKNM{{{BIT TO TEST FOR KEYWORD NUMBER ! 4004: {BTLBL{DBC{SVLBL{{{BIT TO TEST FOR LABEL ! 4005: {BTFFC{DBC{SVFFC{{{BIT TO TEST FOR FAST CALL ! 4006: {BTCKW{DBC{SVCKW{{{BIT TO TEST FOR CONSTANT KEYWORD ! 4007: {BTPRD{DBC{SVPRD{{{BIT TO TEST FOR PREDICATE FUNCTION ! 4008: {BTPRE{DBC{SVPRE{{{BIT TO TEST FOR PREEVALUATION ! 4009: {BTVAL{DBC{SVVAL{{{BIT TO TEST FOR VALUE ! 4010: {{EJC{{{{ ! 4011: * ! 4012: * LIST OF NAMES USED FOR CONTROL CARD PROCESSING ! 4013: * ! 4014: {CCNMS{DTC{/CASE/{{{ ! 4015: {{DTC{/DOUB/{{{ ! 4016: {{DTC{/DUMP/{{{ ! 4017: {{DTC{/EJEC/{{{ ! 4018: {{DTC{/ERRO/{{{ ! 4019: {{DTC{/EXEC/{{{ ! 4020: {{DTC{/FAIL/{{{ ! 4021: {{DTC{/LIST/{{{ ! 4022: {{DTC{/NOER/{{{ ! 4023: {{DTC{/NOEX/{{{ ! 4024: {{DTC{/NOFA/{{{ ! 4025: {{DTC{/NOLI/{{{ ! 4026: {{DTC{/NOOP/{{{ ! 4027: {{DTC{/NOPR/{{{ ! 4028: {{DTC{/OPTI/{{{ ! 4029: {{DTC{/PRIN/{{{ ! 4030: {{DTC{/SING/{{{ ! 4031: {{DTC{/SPAC/{{{ ! 4032: {{DTC{/STIT/{{{ ! 4033: {{DTC{/TITL/{{{ ! 4034: {{DTC{/TRAC/{{{ ! 4035: * ! 4036: * HEADER MESSAGES FOR DUMPR PROCEDURE (SCBLK FORMAT) ! 4037: * ! 4038: {DMHDK{DAC{B$SCL{{{DUMP OF KEYWORD VALUES ! 4039: {{DAC{22{{{ ! 4040: {{DTC{/DUMP OF KEYWORD VALUES/{{{ ! 4041: * ! 4042: {DMHDV{DAC{B$SCL{{{DUMP OF NATURAL VARIABLES ! 4043: {{DAC{25{{{ ! 4044: {{DTC{/DUMP OF NATURAL VARIABLES/{{{ ! 4045: {{EJC{{{{ ! 4046: * ! 4047: * MESSAGE TEXT FOR COMPILATION STATISTICS ! 4048: * ! 4049: {ENCM1{DAC{B$SCL{{{ ! 4050: {{DAC{10{{{ ! 4051: {{DTC{/STORE USED/{{{ ! 4052: * ! 4053: {ENCM2{DAC{B$SCL{{{ ! 4054: {{DAC{10{{{ ! 4055: {{DTC{/STORE LEFT/{{{ ! 4056: * ! 4057: {ENCM3{DAC{B$SCL{{{ ! 4058: {{DAC{11{{{ ! 4059: {{DTC{/COMP ERRORS/{{{ ! 4060: * ! 4061: {ENCM4{DAC{B$SCL{{{ ! 4062: {{DAC{14{{{ ! 4063: {{DTC{/COMP TIME-MSEC/{{{ ! 4064: * ! 4065: {ENCM5{DAC{B$SCL{{{EXECUTION SUPPRESSED ! 4066: {{DAC{20{{{ ! 4067: {{DTC{/EXECUTION SUPPRESSED/{{{ ! 4068: * ! 4069: * STRING CONSTANT FOR ABNORMAL END ! 4070: * ! 4071: {ENDAB{DAC{B$SCL{{{ ! 4072: {{DAC{12{{{ ! 4073: {{DTC{/ABNORMAL END/{{{ ! 4074: {{EJC{{{{ ! 4075: * ! 4076: * MEMORY OVERFLOW DURING INITIALISATION ! 4077: * ! 4078: {ENDMO{DAC{B$SCL{{{ ! 4079: {ENDML{DAC{15{{{ ! 4080: {{DTC{/MEMORY OVERFLOW/{{{ ! 4081: * ! 4082: * STRING CONSTANT FOR MESSAGE ISSUED BY L$END ! 4083: * ! 4084: {ENDMS{DAC{B$SCL{{{ ! 4085: {{DAC{10{{{ ! 4086: {{DTC{/NORMAL END/{{{ ! 4087: * ! 4088: * FAIL MESSAGE FOR STACK FAIL SECTION ! 4089: * ! 4090: {ENDSO{DAC{B$SCL{{{STACK OVERFLOW IN GARBAGE COLLECTOR ! 4091: {{DAC{36{{{ ! 4092: {{DTC{/STACK OVERFLOW IN GARBAGE COLLECTION/{{{ ! 4093: * ! 4094: * STRING CONSTANT FOR TIME UP ! 4095: * ! 4096: {ENDTU{DAC{B$SCL{{{ ! 4097: {{DAC{15{{{ ! 4098: {{DTC{/ERROR - TIME UP/{{{ ! 4099: {{EJC{{{{ ! 4100: * ! 4101: * STRING CONSTANT FOR ERROR MESSAGE (ERROR SECTION) ! 4102: * ! 4103: {ERMMS{DAC{B$SCL{{{ERROR ! 4104: {{DAC{5{{{ ! 4105: {{DTC{/ERROR/{{{ ! 4106: * ! 4107: {ERMNS{DAC{B$SCL{{{STRING / -- / ! 4108: {{DAC{4{{{ ! 4109: {{DTC{/ -- /{{{ ! 4110: * ! 4111: * STRING CONSTANT FOR PAGE NUMBERING ! 4112: * ! 4113: {LSTMS{DAC{B$SCL{{{PAGE ! 4114: {{DAC{5{{{ ! 4115: {{DTC{/PAGE /{{{ ! 4116: * ! 4117: * LISTING HEADER MESSAGE ! 4118: * ! 4119: {HEADR{DAC{B$SCL{{{ ! 4120: {{DAC{25{{{ ! 4121: {{DTC{/MACRO SPITBOL VERSION 3.5/{{{ ! 4122: * ! 4123: {HEADV{DAC{B$SCL{{{FOR EXIT() VERSION NO. CHECK ! 4124: {{DAC{3{{{ ! 4125: {{DTC{/3.5/{{{ ! 4126: * ! 4127: * INTEGER CONSTANTS FOR GENERAL USE ! 4128: * ICBLD OPTIMISATION USES THE FIRST THREE. ! 4129: * ! 4130: {INT$R{DAC{B$ICL{{{ ! 4131: {INTV0{DIC{+0{{{0 ! 4132: {INTON{DAC{B$ICL{{{ ! 4133: {INTV1{DIC{+1{{{1 ! 4134: {INTTW{DAC{B$ICL{{{ ! 4135: {INTV2{DIC{+2{{{2 ! 4136: {INTVT{DIC{+10{{{10 ! 4137: {INTVH{DIC{+100{{{100 ! 4138: {INTTH{DIC{+1000{{{1000 ! 4139: * ! 4140: * TABLE USED IN ICBLD OPTIMISATION ! 4141: * ! 4142: {INTAB{DAC{INT$R{{{POINTER TO 0 ! 4143: {{DAC{INTON{{{POINTER TO 1 ! 4144: {{DAC{INTTW{{{POINTER TO 2 ! 4145: {{EJC{{{{ ! 4146: * ! 4147: * SPECIAL PATTERN NODES. THE FOLLOWING PATTERN NODES ! 4148: * CONSIST SIMPLY OF A PCODE POINTER, SEE MATCH ROUTINES ! 4149: * (P$XXX) FOR FULL DETAILS OF THEIR USE AND FORMAT). ! 4150: * ! 4151: {NDABB{DAC{P$ABB{{{ARBNO ! 4152: {NDABD{DAC{P$ABD{{{ARBNO ! 4153: {NDARC{DAC{P$ARC{{{ARB ! 4154: {NDEXB{DAC{P$EXB{{{EXPRESSION ! 4155: {NDFNB{DAC{P$FNB{{{FENCE() ! 4156: {NDFND{DAC{P$FND{{{FENCE() ! 4157: {NDEXC{DAC{P$EXC{{{EXPRESSION ! 4158: {NDIMB{DAC{P$IMB{{{IMMEDIATE ASSIGNMENT ! 4159: {NDIMD{DAC{P$IMD{{{IMMEDIATE ASSIGNMENT ! 4160: {NDNTH{DAC{P$NTH{{{PATTERN END (NULL PATTERN) ! 4161: {NDPAB{DAC{P$PAB{{{PATTERN ASSIGNMENT ! 4162: {NDPAD{DAC{P$PAD{{{PATTERN ASSIGNMENT ! 4163: {NDUNA{DAC{P$UNA{{{ANCHOR POINT MOVEMENT ! 4164: * ! 4165: * KEYWORD CONSTANT PATTERN NODES. THE FOLLOWING NODES ARE ! 4166: * USED AS THE VALUES OF PATTERN KEYWORDS AND THE INITIAL ! 4167: * VALUES OF THE CORRESPONDING NATURAL VARIABLES. ALL ! 4168: * NODES ARE IN P0BLK FORMAT AND THE ORDER IS TIED TO THE ! 4169: * DEFINITIONS OF CORRESPONDING K$XXX SYMBOLS. ! 4170: * ! 4171: {NDABO{DAC{P$ABO{{{ABORT ! 4172: {{DAC{NDNTH{{{ ! 4173: {NDARB{DAC{P$ARB{{{ARB ! 4174: {{DAC{NDNTH{{{ ! 4175: {NDBAL{DAC{P$BAL{{{BAL ! 4176: {{DAC{NDNTH{{{ ! 4177: {NDFAL{DAC{P$FAL{{{FAIL ! 4178: {{DAC{NDNTH{{{ ! 4179: {NDFEN{DAC{P$FEN{{{FENCE ! 4180: {{DAC{NDNTH{{{ ! 4181: {NDREM{DAC{P$REM{{{REM ! 4182: {{DAC{NDNTH{{{ ! 4183: {NDSUC{DAC{P$SUC{{{SUCCEED ! 4184: {{DAC{NDNTH{{{ ! 4185: * ! 4186: * NULL STRING. ALL NULL VALUES POINT TO THIS STRING. THE ! 4187: * SVCHS FIELD CONTAINS A BLANK TO PROVIDE FOR EASY DEFAULT ! 4188: * PROCESSING IN TRACE, STOPTR, LPAD AND RPAD. ! 4189: * NULLW CONTAINS 10 BLANKS WHICH ENSURES AN ALL BLANK WORD ! 4190: * BUT FOR VERY EXCEPTIONAL MACHINES. ! 4191: * ! 4192: {NULLS{DAC{B$SCL{{{NULL STRING VALUE ! 4193: {{DAC{0{{{SCLEN = 0 ! 4194: {NULLW{DTC{/ /{{{ ! 4195: {{EJC{{{{ ! 4196: * ! 4197: * OPERATOR DOPE VECTORS (SEE DVBLK FORMAT) ! 4198: * ! 4199: {OPDVC{DAC{O$CNC{{{CONCATENATION ! 4200: {{DAC{C$CNC{{{ ! 4201: {{DAC{LLCNC{{{ ! 4202: {{DAC{RRCNC{{{ ! 4203: * ! 4204: * OPDVS IS USED WHEN SCANNING BELOW THE TOP LEVEL TO ! 4205: * INSURE THAT THE CONCATENATION WILL NOT BE LATER ! 4206: * MISTAKEN FOR PATTERN MATCHING ! 4207: * ! 4208: {OPDVP{DAC{O$CNC{{{CONCATENATION - NOT PATTERN MATCH ! 4209: {{DAC{C$CNP{{{ ! 4210: {{DAC{LLCNC{{{ ! 4211: {{DAC{RRCNC{{{ ! 4212: * ! 4213: * NOTE THAT THE ORDER OF THE REMAINING ENTRIES IS TIED TO ! 4214: * THE ORDER OF THE CODING IN THE SCANE PROCEDURE. ! 4215: * ! 4216: {OPDVS{DAC{O$ASS{{{ASSIGNMENT ! 4217: {{DAC{C$ASS{{{ ! 4218: {{DAC{LLASS{{{ ! 4219: {{DAC{RRASS{{{ ! 4220: * ! 4221: {{DAC{6{{{UNARY EQUAL ! 4222: {{DAC{C$UUO{{{ ! 4223: {{DAC{LLUNO{{{ ! 4224: * ! 4225: {{DAC{O$PMV{{{PATTERN MATCH ! 4226: {{DAC{C$PMT{{{ ! 4227: {{DAC{LLPMT{{{ ! 4228: {{DAC{RRPMT{{{ ! 4229: * ! 4230: {{DAC{O$INT{{{INTERROGATION ! 4231: {{DAC{C$UVL{{{ ! 4232: {{DAC{LLUNO{{{ ! 4233: * ! 4234: {{DAC{1{{{BINARY AMPERSAND ! 4235: {{DAC{C$UBO{{{ ! 4236: {{DAC{LLAMP{{{ ! 4237: {{DAC{RRAMP{{{ ! 4238: * ! 4239: {{DAC{O$KWV{{{KEYWORD REFERENCE ! 4240: {{DAC{C$KEY{{{ ! 4241: {{DAC{LLUNO{{{ ! 4242: * ! 4243: {{DAC{O$ALT{{{ALTERNATION ! 4244: {{DAC{C$ALT{{{ ! 4245: {{DAC{LLALT{{{ ! 4246: {{DAC{RRALT{{{ ! 4247: {{EJC{{{{ ! 4248: * ! 4249: * OPERATOR DOPE VECTORS (CONTINUED) ! 4250: * ! 4251: {{DAC{5{{{UNARY VERTICAL BAR ! 4252: {{DAC{C$UUO{{{ ! 4253: {{DAC{LLUNO{{{ ! 4254: * ! 4255: {{DAC{0{{{BINARY AT ! 4256: {{DAC{C$UBO{{{ ! 4257: {{DAC{LLATS{{{ ! 4258: {{DAC{RRATS{{{ ! 4259: * ! 4260: {{DAC{O$CAS{{{CURSOR ASSIGNMENT ! 4261: {{DAC{C$UNM{{{ ! 4262: {{DAC{LLUNO{{{ ! 4263: * ! 4264: {{DAC{2{{{BINARY NUMBER SIGN ! 4265: {{DAC{C$UBO{{{ ! 4266: {{DAC{LLNUM{{{ ! 4267: {{DAC{RRNUM{{{ ! 4268: * ! 4269: {{DAC{7{{{UNARY NUMBER SIGN ! 4270: {{DAC{C$UUO{{{ ! 4271: {{DAC{LLUNO{{{ ! 4272: * ! 4273: {{DAC{O$DVD{{{DIVISION ! 4274: {{DAC{C$BVL{{{ ! 4275: {{DAC{LLDVD{{{ ! 4276: {{DAC{RRDVD{{{ ! 4277: * ! 4278: {{DAC{9{{{UNARY SLASH ! 4279: {{DAC{C$UUO{{{ ! 4280: {{DAC{LLUNO{{{ ! 4281: * ! 4282: {{DAC{O$MLT{{{MULTIPLICATION ! 4283: {{DAC{C$BVL{{{ ! 4284: {{DAC{LLMLT{{{ ! 4285: {{DAC{RRMLT{{{ ! 4286: {{EJC{{{{ ! 4287: * ! 4288: * OPERATOR DOPE VECTORS (CONTINUED) ! 4289: * ! 4290: {{DAC{0{{{DEFERRED EXPRESSION ! 4291: {{DAC{C$DEF{{{ ! 4292: {{DAC{LLUNO{{{ ! 4293: * ! 4294: {{DAC{3{{{BINARY PERCENT ! 4295: {{DAC{C$UBO{{{ ! 4296: {{DAC{LLPCT{{{ ! 4297: {{DAC{RRPCT{{{ ! 4298: * ! 4299: {{DAC{8{{{UNARY PERCENT ! 4300: {{DAC{C$UUO{{{ ! 4301: {{DAC{LLUNO{{{ ! 4302: * ! 4303: {{DAC{O$EXP{{{EXPONENTIATION ! 4304: {{DAC{C$BVL{{{ ! 4305: {{DAC{LLEXP{{{ ! 4306: {{DAC{RREXP{{{ ! 4307: * ! 4308: {{DAC{10{{{UNARY EXCLAMATION ! 4309: {{DAC{C$UUO{{{ ! 4310: {{DAC{LLUNO{{{ ! 4311: * ! 4312: {{DAC{O$IMA{{{IMMEDIATE ASSIGNMENT ! 4313: {{DAC{C$BVN{{{ ! 4314: {{DAC{LLDLD{{{ ! 4315: {{DAC{RRDLD{{{ ! 4316: * ! 4317: {{DAC{O$INV{{{INDIRECTION ! 4318: {{DAC{C$IND{{{ ! 4319: {{DAC{LLUNO{{{ ! 4320: * ! 4321: {{DAC{4{{{BINARY NOT ! 4322: {{DAC{C$UBO{{{ ! 4323: {{DAC{LLNOT{{{ ! 4324: {{DAC{RRNOT{{{ ! 4325: * ! 4326: {{DAC{0{{{NEGATION ! 4327: {{DAC{C$NEG{{{ ! 4328: {{DAC{LLUNO{{{ ! 4329: {{EJC{{{{ ! 4330: * ! 4331: * OPERATOR DOPE VECTORS (CONTINUED) ! 4332: * ! 4333: {{DAC{O$SUB{{{SUBTRACTION ! 4334: {{DAC{C$BVL{{{ ! 4335: {{DAC{LLPLM{{{ ! 4336: {{DAC{RRPLM{{{ ! 4337: * ! 4338: {{DAC{O$COM{{{COMPLEMENTATION ! 4339: {{DAC{C$UVL{{{ ! 4340: {{DAC{LLUNO{{{ ! 4341: * ! 4342: {{DAC{O$ADD{{{ADDITION ! 4343: {{DAC{C$BVL{{{ ! 4344: {{DAC{LLPLM{{{ ! 4345: {{DAC{RRPLM{{{ ! 4346: * ! 4347: {{DAC{O$AFF{{{AFFIRMATION ! 4348: {{DAC{C$UVL{{{ ! 4349: {{DAC{LLUNO{{{ ! 4350: * ! 4351: {{DAC{O$PAS{{{PATTERN ASSIGNMENT ! 4352: {{DAC{C$BVN{{{ ! 4353: {{DAC{LLDLD{{{ ! 4354: {{DAC{RRDLD{{{ ! 4355: * ! 4356: {{DAC{O$NAM{{{NAME REFERENCE ! 4357: {{DAC{C$UNM{{{ ! 4358: {{DAC{LLUNO{{{ ! 4359: * ! 4360: * SPECIAL DVS FOR GOTO OPERATORS (SEE PROCEDURE SCNGF) ! 4361: * ! 4362: {OPDVD{DAC{O$GOD{{{DIRECT GOTO ! 4363: {{DAC{C$UVL{{{ ! 4364: {{DAC{LLUNO{{{ ! 4365: * ! 4366: {OPDVN{DAC{O$GOC{{{COMPLEX NORMAL GOTO ! 4367: {{DAC{C$UNM{{{ ! 4368: {{DAC{LLUNO{{{ ! 4369: {{EJC{{{{ ! 4370: * ! 4371: * OPERATOR ENTRY ADDRESS POINTERS, USED IN CODE ! 4372: * ! 4373: {OAMN${DAC{O$AMN{{{ARRAY REF (MULTI-SUBS BY VALUE) ! 4374: {OAMV${DAC{O$AMV{{{ARRAY REF (MULTI-SUBS BY VALUE) ! 4375: {OAON${DAC{O$AON{{{ARRAY REF (ONE SUB BY NAME) ! 4376: {OAOV${DAC{O$AOV{{{ARRAY REF (ONE SUB BY VALUE) ! 4377: {OCER${DAC{O$CER{{{COMPILATION ERROR ! 4378: {OFEX${DAC{O$FEX{{{FAILURE IN EXPRESSION EVALUATION ! 4379: {OFIF${DAC{O$FIF{{{FAILURE DURING GOTO EVALUATION ! 4380: {OFNC${DAC{O$FNC{{{FUNCTION CALL (MORE THAN ONE ARG) ! 4381: {OFNE${DAC{O$FNE{{{FUNCTION NAME ERROR ! 4382: {OFNS${DAC{O$FNS{{{FUNCTION CALL (SINGLE ARGUMENT) ! 4383: {OGOF${DAC{O$GOF{{{SET GOTO FAILURE TRAP ! 4384: {OINN${DAC{O$INN{{{INDIRECTION BY NAME ! 4385: {OKWN${DAC{O$KWN{{{KEYWORD REFERENCE BY NAME ! 4386: {OLEX${DAC{O$LEX{{{LOAD EXPRESSION BY NAME ! 4387: {OLPT${DAC{O$LPT{{{LOAD PATTERN ! 4388: {OLVN${DAC{O$LVN{{{LOAD VARIABLE NAME ! 4389: {ONTA${DAC{O$NTA{{{NEGATION, FIRST ENTRY ! 4390: {ONTB${DAC{O$NTB{{{NEGATION, SECOND ENTRY ! 4391: {ONTC${DAC{O$NTC{{{NEGATION, THIRD ENTRY ! 4392: {OPMN${DAC{O$PMN{{{PATTERN MATCH BY NAME ! 4393: {OPMS${DAC{O$PMS{{{PATTERN MATCH (STATEMENT) ! 4394: {OPOP${DAC{O$POP{{{POP TOP STACK ITEM ! 4395: {ORNM${DAC{O$RNM{{{RETURN NAME FROM EXPRESSION ! 4396: {ORPL${DAC{O$RPL{{{PATTERN REPLACEMENT ! 4397: {ORVL${DAC{O$RVL{{{RETURN VALUE FROM EXPRESSION ! 4398: {OSLA${DAC{O$SLA{{{SELECTION, FIRST ENTRY ! 4399: {OSLB${DAC{O$SLB{{{SELECTION, SECOND ENTRY ! 4400: {OSLC${DAC{O$SLC{{{SELECTION, THIRD ENTRY ! 4401: {OSLD${DAC{O$SLD{{{SELECTION, FOURTH ENTRY ! 4402: {OSTP${DAC{O$STP{{{STOP EXECUTION ! 4403: {OUNF${DAC{O$UNF{{{UNEXPECTED FAILURE ! 4404: {{EJC{{{{ ! 4405: * ! 4406: * TABLE OF NAMES OF UNDEFINED BINARY OPERATORS FOR OPSYN ! 4407: * ! 4408: {OPSNB{DAC{CH$AT{{{AT ! 4409: {{DAC{CH$AM{{{AMPERSAND ! 4410: {{DAC{CH$NM{{{NUMBER ! 4411: {{DAC{CH$PC{{{PERCENT ! 4412: {{DAC{CH$NT{{{NOT ! 4413: * ! 4414: * TABLE OF NAMES OF UNDEFINED UNARY OPERATORS FOR OPSYN ! 4415: * ! 4416: {OPNSU{DAC{CH$BR{{{VERTICAL BAR ! 4417: {{DAC{CH$EQ{{{EQUAL ! 4418: {{DAC{CH$NM{{{NUMBER ! 4419: {{DAC{CH$PC{{{PERCENT ! 4420: {{DAC{CH$SL{{{SLASH ! 4421: {{DAC{CH$EX{{{EXCLAMATION ! 4422: * ! 4423: * ADDRESS CONST CONTAINING PROFILE TABLE ENTRY SIZE ! 4424: * ! 4425: {PFI2A{DAC{PF$I2{{{ ! 4426: * ! 4427: * PROFILER MESSAGE STRINGS ! 4428: * ! 4429: {PFMS1{DAC{B$SCL{{{ ! 4430: {{DAC{15{{{ ! 4431: {{DTC{/PROGRAM PROFILE/{{{ ! 4432: {PFMS2{DAC{B$SCL{{{ ! 4433: {{DAC{42{{{ ! 4434: {{DTC{/STMT NUMBER OF -- EXECUTION TIME --/{{{ ! 4435: {PFMS3{DAC{B$SCL{{{ ! 4436: {{DAC{47{{{ ! 4437: {{DTC{/NUMBER EXECUTIONS TOTAL(MSEC) PER EXCN(MCSEC)/{{{ ! 4438: * ! 4439: * ! 4440: * REAL CONSTANTS FOR GENERAL USE. NOTE THAT THE CONSTANTS ! 4441: * STARTING AT REAV1 FORM A POWERS OF TEN TABLE (GTSTG) ! 4442: * ! 4443: {REAV0{DRC{+0.0{{{0.0 ! 4444: {REAP1{DRC{+0.1{{{0.1 ! 4445: {REAP5{DRC{+0.5{{{0.5 ! 4446: {REAV1{DRC{+1.0{{{10**0 ! 4447: {REAVT{DRC{+1.0E+1{{{10**1 ! 4448: {{DRC{+1.0E+2{{{10**2 ! 4449: {{DRC{+1.0E+3{{{10**3 ! 4450: {{DRC{+1.0E+4{{{10**4 ! 4451: {{DRC{+1.0E+5{{{10**5 ! 4452: {{DRC{+1.0E+6{{{10**6 ! 4453: {{DRC{+1.0E+7{{{10**7 ! 4454: {{DRC{+1.0E+8{{{10**8 ! 4455: {{DRC{+1.0E+9{{{10**9 ! 4456: {REATT{DRC{+1.0E+10{{{10**10 ! 4457: {{EJC{{{{ ! 4458: * ! 4459: * STRING CONSTANTS (SCBLK FORMAT) FOR DTYPE PROCEDURE ! 4460: * ! 4461: {SCARR{DAC{B$SCL{{{ARRAY ! 4462: {{DAC{5{{{ ! 4463: {{DTC{/ARRAY/{{{ ! 4464: * ! 4465: {SCBUF{DAC{B$SCL{{{BUFFER ! 4466: {{DAC{6{{{ ! 4467: {{DTC{/BUFFER/{{{ ! 4468: * ! 4469: {SCCOD{DAC{B$SCL{{{CODE ! 4470: {{DAC{4{{{ ! 4471: {{DTC{/CODE/{{{ ! 4472: * ! 4473: {SCEXP{DAC{B$SCL{{{EXPRESSION ! 4474: {{DAC{10{{{ ! 4475: {{DTC{/EXPRESSION/{{{ ! 4476: * ! 4477: {SCEXT{DAC{B$SCL{{{EXTERNAL ! 4478: {{DAC{8{{{ ! 4479: {{DTC{/EXTERNAL/{{{ ! 4480: * ! 4481: {SCINT{DAC{B$SCL{{{INTEGER ! 4482: {{DAC{7{{{ ! 4483: {{DTC{/INTEGER/{{{ ! 4484: * ! 4485: {SCNAM{DAC{B$SCL{{{NAME ! 4486: {{DAC{4{{{ ! 4487: {{DTC{/NAME/{{{ ! 4488: * ! 4489: {SCNUM{DAC{B$SCL{{{NUMERIC ! 4490: {{DAC{7{{{ ! 4491: {{DTC{/NUMERIC/{{{ ! 4492: * ! 4493: {SCPAT{DAC{B$SCL{{{PATTERN ! 4494: {{DAC{7{{{ ! 4495: {{DTC{/PATTERN/{{{ ! 4496: * ! 4497: {SCREA{DAC{B$SCL{{{REAL ! 4498: {{DAC{4{{{ ! 4499: {{DTC{/REAL/{{{ ! 4500: * ! 4501: {SCSTR{DAC{B$SCL{{{STRING ! 4502: {{DAC{6{{{ ! 4503: {{DTC{/STRING/{{{ ! 4504: * ! 4505: {SCTAB{DAC{B$SCL{{{TABLE ! 4506: {{DAC{5{{{ ! 4507: {{DTC{/TABLE/{{{ ! 4508: {{EJC{{{{ ! 4509: * ! 4510: * STRING CONSTANTS (SCBLK FORMAT) FOR KVRTN (SEE RETRN) ! 4511: * ! 4512: {SCFRT{DAC{B$SCL{{{FRETURN ! 4513: {{DAC{7{{{ ! 4514: {{DTC{/FRETURN/{{{ ! 4515: * ! 4516: {SCNRT{DAC{B$SCL{{{NRETURN ! 4517: {{DAC{7{{{ ! 4518: {{DTC{/NRETURN/{{{ ! 4519: * ! 4520: {SCRTN{DAC{B$SCL{{{RETURN ! 4521: {{DAC{6{{{ ! 4522: {{DTC{/RETURN/{{{ ! 4523: * ! 4524: * DATATYPE NAME TABLE FOR DTYPE PROCEDURE. THE ORDER OF ! 4525: * THESE ENTRIES IS TIED TO THE B$XXX DEFINITIONS FOR BLOCKS ! 4526: * ! 4527: {SCNMT{DAC{SCARR{{{ARBLK ARRAY ! 4528: {{DAC{SCBUF{{{BFBLK BUFFER ! 4529: {{DAC{SCCOD{{{CDBLK CODE ! 4530: {{DAC{SCEXP{{{EXBLK EXPRESSION ! 4531: {{DAC{SCINT{{{ICBLK INTEGER ! 4532: {{DAC{SCNAM{{{NMBLK NAME ! 4533: {{DAC{SCPAT{{{P0BLK PATTERN ! 4534: {{DAC{SCPAT{{{P1BLK PATTERN ! 4535: {{DAC{SCPAT{{{P2BLK PATTERN ! 4536: {{DAC{SCREA{{{RCBLK REAL ! 4537: {{DAC{SCSTR{{{SCBLK STRING ! 4538: {{DAC{SCEXP{{{SEBLK EXPRESSION ! 4539: {{DAC{SCTAB{{{TBBLK TABLE ! 4540: {{DAC{SCARR{{{VCBLK ARRAY ! 4541: {{DAC{SCEXT{{{XNBLK EXTERNAL ! 4542: {{DAC{SCEXT{{{XRBLK EXTERNAL ! 4543: * ! 4544: * STRING CONSTANT FOR REAL ZERO ! 4545: * ! 4546: {SCRE0{DAC{B$SCL{{{ ! 4547: {{DAC{2{{{ ! 4548: {{DTC{/0./{{{ ! 4549: {{EJC{{{{ ! 4550: * ! 4551: * USED TO RE-INITIALISE KVSTL ! 4552: * ! 4553: {STLIM{DIC{+50000{{{DEFAULT STATEMENT LIMIT ! 4554: * ! 4555: * DUMMY FUNCTION BLOCK USED FOR UNDEFINED FUNCTIONS ! 4556: * ! 4557: {STNDF{DAC{O$FUN{{{PTR TO UNDEFINED FUNCTION ERR CALL ! 4558: {{DAC{0{{{DUMMY FARGS COUNT FOR CALL CIRCUIT ! 4559: * ! 4560: * DUMMY CODE BLOCK USED FOR UNDEFINED LABELS ! 4561: * ! 4562: {STNDL{DAC{L$UND{{{CODE PTR POINTS TO UNDEFINED LBL ! 4563: * ! 4564: * DUMMY OPERATOR BLOCK USED FOR UNDEFINED OPERATORS ! 4565: * ! 4566: {STNDO{DAC{O$OUN{{{PTR TO UNDEFINED OPERATOR ERR CALL ! 4567: {{DAC{0{{{DUMMY FARGS COUNT FOR CALL CIRCUIT ! 4568: * ! 4569: * STANDARD VARIABLE BLOCK. THIS BLOCK IS USED TO INITIALIZE ! 4570: * THE FIRST SEVEN FIELDS OF A NEWLY CONSTRUCTED VRBLK. ! 4571: * ITS FORMAT IS TIED TO THE VRBLK DEFINITIONS (SEE GTNVR). ! 4572: * ! 4573: {STNVR{DAC{B$VRL{{{VRGET ! 4574: {{DAC{B$VRS{{{VRSTO ! 4575: {{DAC{NULLS{{{VRVAL ! 4576: {{DAC{B$VRG{{{VRTRA ! 4577: {{DAC{STNDL{{{VRLBL ! 4578: {{DAC{STNDF{{{VRFNC ! 4579: {{DAC{0{{{VRNXT ! 4580: {{EJC{{{{ ! 4581: * ! 4582: * MESSAGES USED IN END OF RUN PROCESSING (STOPR) ! 4583: * ! 4584: {STPM1{DAC{B$SCL{{{IN STATEMENT ! 4585: {{DAC{12{{{ ! 4586: {{DTC{/IN STATEMENT/{{{ ! 4587: * ! 4588: {STPM2{DAC{B$SCL{{{ ! 4589: {{DAC{14{{{ ! 4590: {{DTC{/STMTS EXECUTED/{{{ ! 4591: * ! 4592: {STPM3{DAC{B$SCL{{{ ! 4593: {{DAC{13{{{ ! 4594: {{DTC{/RUN TIME-MSEC/{{{ ! 4595: * ! 4596: {STPM4{DAC{B$SCL{{{ ! 4597: {{DAC{12{{{ ! 4598: {{DTC{$MCSEC / STMT${{{ ! 4599: * ! 4600: {STPM5{DAC{B$SCL{{{ ! 4601: {{DAC{13{{{ ! 4602: {{DTC{/REGENERATIONS/{{{ ! 4603: * ! 4604: * CHARS FOR /TU/ ENDING CODE ! 4605: * ! 4606: {STRTU{DTC{/TU/{{{ ! 4607: * ! 4608: * TABLE USED BY CONVERT FUNCTION TO CHECK DATATYPE NAME ! 4609: * THE ENTRIES ARE ORDERED TO CORRESPOND TO BRANCH TABLE ! 4610: * IN S$CNV ! 4611: * ! 4612: {SVCTB{DAC{SCSTR{{{STRING ! 4613: {{DAC{SCINT{{{INTEGER ! 4614: {{DAC{SCNAM{{{NAME ! 4615: {{DAC{SCPAT{{{PATTERN ! 4616: {{DAC{SCARR{{{ARRAY ! 4617: {{DAC{SCTAB{{{TABLE ! 4618: {{DAC{SCEXP{{{EXPRESSION ! 4619: {{DAC{SCCOD{{{CODE ! 4620: {{DAC{SCNUM{{{NUMERIC ! 4621: {{DAC{SCREA{{{REAL ! 4622: {{DAC{SCBUF{{{BUFFER ! 4623: {{DAC{0{{{ZERO MARKS END OF LIST ! 4624: {{EJC{{{{ ! 4625: * ! 4626: * MESSAGES (SCBLK FORMAT) USED BY TRACE PROCEDURES ! 4627: * ! 4628: * ! 4629: {TMASB{DAC{B$SCL{{{ASTERISKS FOR TRACE STATEMENT NO ! 4630: {{DAC{13{{{ ! 4631: {{DTC{/************ /{{{ ! 4632: * ! 4633: {TMBEB{DAC{B$SCL{{{BLANK-EQUAL-BLANK ! 4634: {{DAC{3{{{ ! 4635: {{DTC{/ = /{{{ ! 4636: * ! 4637: * DUMMY TRBLK FOR EXPRESSION VARIABLE ! 4638: * ! 4639: {TRBEV{DAC{B$TRT{{{DUMMY TRBLK ! 4640: * ! 4641: * DUMMY TRBLK FOR KEYWORD VARIABLE ! 4642: * ! 4643: {TRBKV{DAC{B$TRT{{{DUMMY TRBLK ! 4644: * ! 4645: * DUMMY CODE BLOCK TO RETURN CONTROL TO TRXEQ PROCEDURE ! 4646: * ! 4647: {TRXDR{DAC{O$TXR{{{BLOCK POINTS TO RETURN ROUTINE ! 4648: {TRXDC{DAC{TRXDR{{{POINTER TO BLOCK ! 4649: {{EJC{{{{ ! 4650: * ! 4651: * STANDARD VARIABLE BLOCKS ! 4652: * ! 4653: * SEE SVBLK FORMAT FOR FULL DETAILS OF THE FORMAT. THE ! 4654: * VRBLKS ARE ORDERED BY LENGTH AND WITHIN EACH LENGTH THE ! 4655: * ORDER IS ALPHABETICAL BY NAME OF THE VARIABLE. ! 4656: * ! 4657: {V$EQF{DBC{SVFPR{{{EQ ! 4658: {{DAC{2{{{ ! 4659: {{DTC{/EQ/{{{ ! 4660: {{DAC{S$EQF{{{ ! 4661: {{DAC{2{{{ ! 4662: * ! 4663: {V$GEF{DBC{SVFPR{{{GE ! 4664: {{DAC{2{{{ ! 4665: {{DTC{/GE/{{{ ! 4666: {{DAC{S$GEF{{{ ! 4667: {{DAC{2{{{ ! 4668: * ! 4669: {V$GTF{DBC{SVFPR{{{GT ! 4670: {{DAC{2{{{ ! 4671: {{DTC{/GT/{{{ ! 4672: {{DAC{S$GTF{{{ ! 4673: {{DAC{2{{{ ! 4674: * ! 4675: {V$LEF{DBC{SVFPR{{{LE ! 4676: {{DAC{2{{{ ! 4677: {{DTC{/LE/{{{ ! 4678: {{DAC{S$LEF{{{ ! 4679: {{DAC{2{{{ ! 4680: * ! 4681: {V$LTF{DBC{SVFPR{{{LT ! 4682: {{DAC{2{{{ ! 4683: {{DTC{/LT/{{{ ! 4684: {{DAC{S$LTF{{{ ! 4685: {{DAC{2{{{ ! 4686: * ! 4687: {V$NEF{DBC{SVFPR{{{NE ! 4688: {{DAC{2{{{ ! 4689: {{DTC{/NE/{{{ ! 4690: {{DAC{S$NEF{{{ ! 4691: {{DAC{2{{{ ! 4692: * ! 4693: {V$ANY{DBC{SVFNP{{{ANY ! 4694: {{DAC{3{{{ ! 4695: {{DTC{/ANY/{{{ ! 4696: {{DAC{S$ANY{{{ ! 4697: {{DAC{1{{{ ! 4698: * ! 4699: {V$ARB{DBC{SVKVC{{{ARB ! 4700: {{DAC{3{{{ ! 4701: {{DTC{/ARB/{{{ ! 4702: {{DAC{K$ARB{{{ ! 4703: {{DAC{NDARB{{{ ! 4704: {{EJC{{{{ ! 4705: * ! 4706: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 4707: * ! 4708: {V$ARG{DBC{SVFNN{{{ARG ! 4709: {{DAC{3{{{ ! 4710: {{DTC{/ARG/{{{ ! 4711: {{DAC{S$ARG{{{ ! 4712: {{DAC{2{{{ ! 4713: * ! 4714: {V$BAL{DBC{SVKVC{{{BAL ! 4715: {{DAC{3{{{ ! 4716: {{DTC{/BAL/{{{ ! 4717: {{DAC{K$BAL{{{ ! 4718: {{DAC{NDBAL{{{ ! 4719: * ! 4720: {V$END{DBC{SVLBL{{{END ! 4721: {{DAC{3{{{ ! 4722: {{DTC{/END/{{{ ! 4723: {{DAC{L$END{{{ ! 4724: * ! 4725: {V$LEN{DBC{SVFNP{{{LEN ! 4726: {{DAC{3{{{ ! 4727: {{DTC{/LEN/{{{ ! 4728: {{DAC{S$LEN{{{ ! 4729: {{DAC{1{{{ ! 4730: * ! 4731: {V$LEQ{DBC{SVFPR{{{LEQ ! 4732: {{DAC{3{{{ ! 4733: {{DTC{/LEQ/{{{ ! 4734: {{DAC{S$LEQ{{{ ! 4735: {{DAC{2{{{ ! 4736: * ! 4737: {V$LGE{DBC{SVFPR{{{LGE ! 4738: {{DAC{3{{{ ! 4739: {{DTC{/LGE/{{{ ! 4740: {{DAC{S$LGE{{{ ! 4741: {{DAC{2{{{ ! 4742: * ! 4743: {V$LGT{DBC{SVFPR{{{LGT ! 4744: {{DAC{3{{{ ! 4745: {{DTC{/LGT/{{{ ! 4746: {{DAC{S$LGT{{{ ! 4747: {{DAC{2{{{ ! 4748: * ! 4749: {V$LLE{DBC{SVFPR{{{LLE ! 4750: {{DAC{3{{{ ! 4751: {{DTC{/LLE/{{{ ! 4752: {{DAC{S$LLE{{{ ! 4753: {{DAC{2{{{ ! 4754: {{EJC{{{{ ! 4755: * ! 4756: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 4757: * ! 4758: {V$LLT{DBC{SVFPR{{{LLT ! 4759: {{DAC{3{{{ ! 4760: {{DTC{/LLT/{{{ ! 4761: {{DAC{S$LLT{{{ ! 4762: {{DAC{2{{{ ! 4763: * ! 4764: {V$LNE{DBC{SVFPR{{{LNE ! 4765: {{DAC{3{{{ ! 4766: {{DTC{/LNE/{{{ ! 4767: {{DAC{S$LNE{{{ ! 4768: {{DAC{2{{{ ! 4769: * ! 4770: {V$POS{DBC{SVFNP{{{POS ! 4771: {{DAC{3{{{ ! 4772: {{DTC{/POS/{{{ ! 4773: {{DAC{S$POS{{{ ! 4774: {{DAC{1{{{ ! 4775: * ! 4776: {V$REM{DBC{SVKVC{{{REM ! 4777: {{DAC{3{{{ ! 4778: {{DTC{/REM/{{{ ! 4779: {{DAC{K$REM{{{ ! 4780: {{DAC{NDREM{{{ ! 4781: * ! 4782: {V$SET{DBC{SVFNN{{{SET ! 4783: {{DAC{3{{{ ! 4784: {{DTC{/SET/{{{ ! 4785: {{DAC{S$SET{{{ ! 4786: {{DAC{3{{{ ! 4787: * ! 4788: {V$TAB{DBC{SVFNP{{{TAB ! 4789: {{DAC{3{{{ ! 4790: {{DTC{/TAB/{{{ ! 4791: {{DAC{S$TAB{{{ ! 4792: {{DAC{1{{{ ! 4793: * ! 4794: {V$CAS{DBC{SVKNM{{{CASE ! 4795: {{DAC{4{{{ ! 4796: {{DTC{/CASE/{{{ ! 4797: {{DAC{K$CAS{{{ ! 4798: * ! 4799: {V$CHR{DBC{SVFNP{{{CHAR ! 4800: {{DAC{4{{{ ! 4801: {{DTC{/CHAR/{{{ ! 4802: {{DAC{S$CHR{{{ ! 4803: {{DAC{1{{{ ! 4804: * ! 4805: {V$COD{DBC{SVFNK{{{CODE ! 4806: {{DAC{4{{{ ! 4807: {{DTC{/CODE/{{{ ! 4808: {{DAC{K$COD{{{ ! 4809: {{DAC{S$COD{{{ ! 4810: {{DAC{1{{{ ! 4811: * ! 4812: {V$COP{DBC{SVFNN{{{COPY ! 4813: {{DAC{4{{{ ! 4814: {{DTC{/COPY/{{{ ! 4815: {{DAC{S$COP{{{ ! 4816: {{DAC{1{{{ ! 4817: {{EJC{{{{ ! 4818: * ! 4819: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 4820: * ! 4821: {V$DAT{DBC{SVFNN{{{DATA ! 4822: {{DAC{4{{{ ! 4823: {{DTC{/DATA/{{{ ! 4824: {{DAC{S$DAT{{{ ! 4825: {{DAC{1{{{ ! 4826: * ! 4827: {V$DTE{DBC{SVFNN{{{DATE ! 4828: {{DAC{4{{{ ! 4829: {{DTC{/DATE/{{{ ! 4830: {{DAC{S$DTE{{{ ! 4831: {{DAC{0{{{ ! 4832: * ! 4833: {V$DMP{DBC{SVFNK{{{DUMP ! 4834: {{DAC{4{{{ ! 4835: {{DTC{/DUMP/{{{ ! 4836: {{DAC{K$DMP{{{ ! 4837: {{DAC{S$DMP{{{ ! 4838: {{DAC{1{{{ ! 4839: * ! 4840: {V$DUP{DBC{SVFNN{{{DUPL ! 4841: {{DAC{4{{{ ! 4842: {{DTC{/DUPL/{{{ ! 4843: {{DAC{S$DUP{{{ ! 4844: {{DAC{2{{{ ! 4845: * ! 4846: {V$EVL{DBC{SVFNN{{{EVAL ! 4847: {{DAC{4{{{ ! 4848: {{DTC{/EVAL/{{{ ! 4849: {{DAC{S$EVL{{{ ! 4850: {{DAC{1{{{ ! 4851: * ! 4852: {V$EXT{DBC{SVFNN{{{EXIT ! 4853: {{DAC{4{{{ ! 4854: {{DTC{/EXIT/{{{ ! 4855: {{DAC{S$EXT{{{ ! 4856: {{DAC{1{{{ ! 4857: * ! 4858: {V$FAL{DBC{SVKVC{{{FAIL ! 4859: {{DAC{4{{{ ! 4860: {{DTC{/FAIL/{{{ ! 4861: {{DAC{K$FAL{{{ ! 4862: {{DAC{NDFAL{{{ ! 4863: * ! 4864: {V$HST{DBC{SVFNN{{{HOST ! 4865: {{DAC{4{{{ ! 4866: {{DTC{/HOST/{{{ ! 4867: {{DAC{S$HST{{{ ! 4868: {{DAC{3{{{ ! 4869: {{EJC{{{{ ! 4870: * ! 4871: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 4872: * ! 4873: {V$ITM{DBC{SVFNF{{{ITEM ! 4874: {{DAC{4{{{ ! 4875: {{DTC{/ITEM/{{{ ! 4876: {{DAC{S$ITM{{{ ! 4877: {{DAC{999{{{ ! 4878: * ! 4879: {V$LOD{DBC{SVFNN{{{LOAD ! 4880: {{DAC{4{{{ ! 4881: {{DTC{/LOAD/{{{ ! 4882: {{DAC{S$LOD{{{ ! 4883: {{DAC{2{{{ ! 4884: * ! 4885: {V$LPD{DBC{SVFNP{{{LPAD ! 4886: {{DAC{4{{{ ! 4887: {{DTC{/LPAD/{{{ ! 4888: {{DAC{S$LPD{{{ ! 4889: {{DAC{3{{{ ! 4890: * ! 4891: {V$RPD{DBC{SVFNP{{{RPAD ! 4892: {{DAC{4{{{ ! 4893: {{DTC{/RPAD/{{{ ! 4894: {{DAC{S$RPD{{{ ! 4895: {{DAC{3{{{ ! 4896: * ! 4897: {V$RPS{DBC{SVFNP{{{RPOS ! 4898: {{DAC{4{{{ ! 4899: {{DTC{/RPOS/{{{ ! 4900: {{DAC{S$RPS{{{ ! 4901: {{DAC{1{{{ ! 4902: * ! 4903: {V$RTB{DBC{SVFNP{{{RTAB ! 4904: {{DAC{4{{{ ! 4905: {{DTC{/RTAB/{{{ ! 4906: {{DAC{S$RTB{{{ ! 4907: {{DAC{1{{{ ! 4908: * ! 4909: {V$SI${DBC{SVFNP{{{SIZE ! 4910: {{DAC{4{{{ ! 4911: {{DTC{/SIZE/{{{ ! 4912: {{DAC{S$SI${{{ ! 4913: {{DAC{1{{{ ! 4914: * ! 4915: * ! 4916: {V$SRT{DBC{SVFNN{{{SORT ! 4917: {{DAC{4{{{ ! 4918: {{DTC{/SORT/{{{ ! 4919: {{DAC{S$SRT{{{ ! 4920: {{DAC{2{{{ ! 4921: {V$SPN{DBC{SVFNP{{{SPAN ! 4922: {{DAC{4{{{ ! 4923: {{DTC{/SPAN/{{{ ! 4924: {{DAC{S$SPN{{{ ! 4925: {{DAC{1{{{ ! 4926: {{EJC{{{{ ! 4927: * ! 4928: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 4929: * ! 4930: {V$STN{DBC{SVKNM{{{STNO ! 4931: {{DAC{4{{{ ! 4932: {{DTC{/STNO/{{{ ! 4933: {{DAC{K$STN{{{ ! 4934: * ! 4935: {V$TIM{DBC{SVFNN{{{TIME ! 4936: {{DAC{4{{{ ! 4937: {{DTC{/TIME/{{{ ! 4938: {{DAC{S$TIM{{{ ! 4939: {{DAC{0{{{ ! 4940: * ! 4941: {V$TRM{DBC{SVFNK{{{TRIM ! 4942: {{DAC{4{{{ ! 4943: {{DTC{/TRIM/{{{ ! 4944: {{DAC{K$TRM{{{ ! 4945: {{DAC{S$TRM{{{ ! 4946: {{DAC{1{{{ ! 4947: * ! 4948: {V$ABE{DBC{SVKNM{{{ABEND ! 4949: {{DAC{5{{{ ! 4950: {{DTC{/ABEND/{{{ ! 4951: {{DAC{K$ABE{{{ ! 4952: * ! 4953: {V$ABO{DBC{SVKVL{{{ABORT ! 4954: {{DAC{5{{{ ! 4955: {{DTC{/ABORT/{{{ ! 4956: {{DAC{K$ABO{{{ ! 4957: {{DAC{L$ABO{{{ ! 4958: {{DAC{NDABO{{{ ! 4959: * ! 4960: {V$APP{DBC{SVFNF{{{APPLY ! 4961: {{DAC{5{{{ ! 4962: {{DTC{/APPLY/{{{ ! 4963: {{DAC{S$APP{{{ ! 4964: {{DAC{999{{{ ! 4965: * ! 4966: {V$ABN{DBC{SVFNP{{{ARBNO ! 4967: {{DAC{5{{{ ! 4968: {{DTC{/ARBNO/{{{ ! 4969: {{DAC{S$ABN{{{ ! 4970: {{DAC{1{{{ ! 4971: * ! 4972: {V$ARR{DBC{SVFNN{{{ARRAY ! 4973: {{DAC{5{{{ ! 4974: {{DTC{/ARRAY/{{{ ! 4975: {{DAC{S$ARR{{{ ! 4976: {{DAC{2{{{ ! 4977: {{EJC{{{{ ! 4978: * ! 4979: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 4980: * ! 4981: {V$BRK{DBC{SVFNP{{{BREAK ! 4982: {{DAC{5{{{ ! 4983: {{DTC{/BREAK/{{{ ! 4984: {{DAC{S$BRK{{{ ! 4985: {{DAC{1{{{ ! 4986: * ! 4987: {V$CLR{DBC{SVFNN{{{CLEAR ! 4988: {{DAC{5{{{ ! 4989: {{DTC{/CLEAR/{{{ ! 4990: {{DAC{S$CLR{{{ ! 4991: {{DAC{1{{{ ! 4992: * ! 4993: {V$EJC{DBC{SVFNN{{{EJECT ! 4994: {{DAC{5{{{ ! 4995: {{DTC{/EJECT/{{{ ! 4996: {{DAC{S$EJC{{{ ! 4997: {{DAC{1{{{ ! 4998: * ! 4999: {V$FEN{DBC{SVFPK{{{FENCE ! 5000: {{DAC{5{{{ ! 5001: {{DTC{/FENCE/{{{ ! 5002: {{DAC{K$FEN{{{ ! 5003: {{DAC{S$FNC{{{ ! 5004: {{DAC{1{{{ ! 5005: {{DAC{NDFEN{{{ ! 5006: * ! 5007: {V$FLD{DBC{SVFNN{{{FIELD ! 5008: {{DAC{5{{{ ! 5009: {{DTC{/FIELD/{{{ ! 5010: {{DAC{S$FLD{{{ ! 5011: {{DAC{2{{{ ! 5012: * ! 5013: {V$IDN{DBC{SVFPR{{{IDENT ! 5014: {{DAC{5{{{ ! 5015: {{DTC{/IDENT/{{{ ! 5016: {{DAC{S$IDN{{{ ! 5017: {{DAC{2{{{ ! 5018: * ! 5019: {V$INP{DBC{SVFNK{{{INPUT ! 5020: {{DAC{5{{{ ! 5021: {{DTC{/INPUT/{{{ ! 5022: {{DAC{K$INP{{{ ! 5023: {{DAC{S$INP{{{ ! 5024: {{DAC{3{{{ ! 5025: * ! 5026: {V$LOC{DBC{SVFNN{{{LOCAL ! 5027: {{DAC{5{{{ ! 5028: {{DTC{/LOCAL/{{{ ! 5029: {{DAC{S$LOC{{{ ! 5030: {{DAC{2{{{ ! 5031: {{EJC{{{{ ! 5032: * ! 5033: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 5034: * ! 5035: {V$OPS{DBC{SVFNN{{{OPSYN ! 5036: {{DAC{5{{{ ! 5037: {{DTC{/OPSYN/{{{ ! 5038: {{DAC{S$OPS{{{ ! 5039: {{DAC{3{{{ ! 5040: * ! 5041: {V$RMD{DBC{SVFNP{{{REMDR ! 5042: {{DAC{5{{{ ! 5043: {{DTC{/REMDR/{{{ ! 5044: {{DAC{S$RMD{{{ ! 5045: {{DAC{2{{{ ! 5046: * ! 5047: {V$RSR{DBC{SVFNN{{{RSORT ! 5048: {{DAC{5{{{ ! 5049: {{DTC{/RSORT/{{{ ! 5050: {{DAC{S$RSR{{{ ! 5051: {{DAC{2{{{ ! 5052: * ! 5053: {V$TBL{DBC{SVFNN{{{TABLE ! 5054: {{DAC{5{{{ ! 5055: {{DTC{/TABLE/{{{ ! 5056: {{DAC{S$TBL{{{ ! 5057: {{DAC{3{{{ ! 5058: * ! 5059: {V$TRA{DBC{SVFNK{{{TRACE ! 5060: {{DAC{5{{{ ! 5061: {{DTC{/TRACE/{{{ ! 5062: {{DAC{K$TRA{{{ ! 5063: {{DAC{S$TRA{{{ ! 5064: {{DAC{4{{{ ! 5065: * ! 5066: {V$ANC{DBC{SVKNM{{{ANCHOR ! 5067: {{DAC{6{{{ ! 5068: {{DTC{/ANCHOR/{{{ ! 5069: {{DAC{K$ANC{{{ ! 5070: * ! 5071: {V$APN{DBC{SVFNN{{{ ! 5072: {{DAC{6{{{ ! 5073: {{DTC{/APPEND/{{{ ! 5074: {{DAC{S$APN{{{ ! 5075: {{DAC{2{{{ ! 5076: * ! 5077: {V$BKX{DBC{SVFNP{{{BREAKX ! 5078: {{DAC{6{{{ ! 5079: {{DTC{/BREAKX/{{{ ! 5080: {{DAC{S$BKX{{{ ! 5081: {{DAC{1{{{ ! 5082: * ! 5083: {V$BUF{DBC{SVFNN{{{BUFFER ! 5084: {{DAC{6{{{ ! 5085: {{DTC{/BUFFER/{{{ ! 5086: {{DAC{S$BUF{{{ ! 5087: {{DAC{2{{{ ! 5088: * ! 5089: {V$DEF{DBC{SVFNN{{{DEFINE ! 5090: {{DAC{6{{{ ! 5091: {{DTC{/DEFINE/{{{ ! 5092: {{DAC{S$DEF{{{ ! 5093: {{DAC{2{{{ ! 5094: * ! 5095: {V$DET{DBC{SVFNN{{{DETACH ! 5096: {{DAC{6{{{ ! 5097: {{DTC{/DETACH/{{{ ! 5098: {{DAC{S$DET{{{ ! 5099: {{DAC{1{{{ ! 5100: {{EJC{{{{ ! 5101: * ! 5102: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 5103: * ! 5104: {V$DIF{DBC{SVFPR{{{DIFFER ! 5105: {{DAC{6{{{ ! 5106: {{DTC{/DIFFER/{{{ ! 5107: {{DAC{S$DIF{{{ ! 5108: {{DAC{2{{{ ! 5109: * ! 5110: {V$FTR{DBC{SVKNM{{{FTRACE ! 5111: {{DAC{6{{{ ! 5112: {{DTC{/FTRACE/{{{ ! 5113: {{DAC{K$FTR{{{ ! 5114: * ! 5115: {V$INS{DBC{SVFNN{{{INSERT ! 5116: {{DAC{6{{{ ! 5117: {{DTC{/INSERT/{{{ ! 5118: {{DAC{S$INS{{{ ! 5119: {{DAC{4{{{ ! 5120: * ! 5121: {V$LST{DBC{SVKNM{{{LASTNO ! 5122: {{DAC{6{{{ ! 5123: {{DTC{/LASTNO/{{{ ! 5124: {{DAC{K$LST{{{ ! 5125: * ! 5126: {V$NAY{DBC{SVFNP{{{NOTANY ! 5127: {{DAC{6{{{ ! 5128: {{DTC{/NOTANY/{{{ ! 5129: {{DAC{S$NAY{{{ ! 5130: {{DAC{1{{{ ! 5131: * ! 5132: {V$OUP{DBC{SVFNK{{{OUTPUT ! 5133: {{DAC{6{{{ ! 5134: {{DTC{/OUTPUT/{{{ ! 5135: {{DAC{K$OUP{{{ ! 5136: {{DAC{S$OUP{{{ ! 5137: {{DAC{3{{{ ! 5138: * ! 5139: {V$RET{DBC{SVLBL{{{RETURN ! 5140: {{DAC{6{{{ ! 5141: {{DTC{/RETURN/{{{ ! 5142: {{DAC{L$RTN{{{ ! 5143: * ! 5144: {V$REW{DBC{SVFNN{{{REWIND ! 5145: {{DAC{6{{{ ! 5146: {{DTC{/REWIND/{{{ ! 5147: {{DAC{S$REW{{{ ! 5148: {{DAC{1{{{ ! 5149: * ! 5150: {V$STT{DBC{SVFNN{{{STOPTR ! 5151: {{DAC{6{{{ ! 5152: {{DTC{/STOPTR/{{{ ! 5153: {{DAC{S$STT{{{ ! 5154: {{DAC{2{{{ ! 5155: {{EJC{{{{ ! 5156: * ! 5157: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 5158: * ! 5159: {V$SUB{DBC{SVFNN{{{SUBSTR ! 5160: {{DAC{6{{{ ! 5161: {{DTC{/SUBSTR/{{{ ! 5162: {{DAC{S$SUB{{{ ! 5163: {{DAC{3{{{ ! 5164: * ! 5165: {V$UNL{DBC{SVFNN{{{UNLOAD ! 5166: {{DAC{6{{{ ! 5167: {{DTC{/UNLOAD/{{{ ! 5168: {{DAC{S$UNL{{{ ! 5169: {{DAC{1{{{ ! 5170: * ! 5171: {V$COL{DBC{SVFNN{{{COLLECT ! 5172: {{DAC{7{{{ ! 5173: {{DTC{/COLLECT/{{{ ! 5174: {{DAC{S$COL{{{ ! 5175: {{DAC{1{{{ ! 5176: * ! 5177: {V$CNV{DBC{SVFNN{{{CONVERT ! 5178: {{DAC{7{{{ ! 5179: {{DTC{/CONVERT/{{{ ! 5180: {{DAC{S$CNV{{{ ! 5181: {{DAC{2{{{ ! 5182: * ! 5183: {V$ENF{DBC{SVFNN{{{ENDFILE ! 5184: {{DAC{7{{{ ! 5185: {{DTC{/ENDFILE/{{{ ! 5186: {{DAC{S$ENF{{{ ! 5187: {{DAC{1{{{ ! 5188: * ! 5189: {V$ETX{DBC{SVKNM{{{ERRTEXT ! 5190: {{DAC{7{{{ ! 5191: {{DTC{/ERRTEXT/{{{ ! 5192: {{DAC{K$ETX{{{ ! 5193: * ! 5194: {V$ERT{DBC{SVKNM{{{ERRTYPE ! 5195: {{DAC{7{{{ ! 5196: {{DTC{/ERRTYPE/{{{ ! 5197: {{DAC{K$ERT{{{ ! 5198: * ! 5199: {V$FRT{DBC{SVLBL{{{FRETURN ! 5200: {{DAC{7{{{ ! 5201: {{DTC{/FRETURN/{{{ ! 5202: {{DAC{L$FRT{{{ ! 5203: * ! 5204: {V$INT{DBC{SVFPR{{{INTEGER ! 5205: {{DAC{7{{{ ! 5206: {{DTC{/INTEGER/{{{ ! 5207: {{DAC{S$INT{{{ ! 5208: {{DAC{1{{{ ! 5209: * ! 5210: {V$NRT{DBC{SVLBL{{{NRETURN ! 5211: {{DAC{7{{{ ! 5212: {{DTC{/NRETURN/{{{ ! 5213: {{DAC{L$NRT{{{ ! 5214: {{EJC{{{{ ! 5215: * ! 5216: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 5217: * ! 5218: * ! 5219: {V$PFL{DBC{SVKNM{{{PROFILE ! 5220: {{DAC{7{{{ ! 5221: {{DTC{/PROFILE/{{{ ! 5222: {{DAC{K$PFL{{{ ! 5223: * ! 5224: {V$RPL{DBC{SVFNP{{{REPLACE ! 5225: {{DAC{7{{{ ! 5226: {{DTC{/REPLACE/{{{ ! 5227: {{DAC{S$RPL{{{ ! 5228: {{DAC{3{{{ ! 5229: * ! 5230: {V$RVS{DBC{SVFNP{{{REVERSE ! 5231: {{DAC{7{{{ ! 5232: {{DTC{/REVERSE/{{{ ! 5233: {{DAC{S$RVS{{{ ! 5234: {{DAC{1{{{ ! 5235: * ! 5236: {V$RTN{DBC{SVKNM{{{RTNTYPE ! 5237: {{DAC{7{{{ ! 5238: {{DTC{/RTNTYPE/{{{ ! 5239: {{DAC{K$RTN{{{ ! 5240: * ! 5241: {V$STX{DBC{SVFNN{{{SETEXIT ! 5242: {{DAC{7{{{ ! 5243: {{DTC{/SETEXIT/{{{ ! 5244: {{DAC{S$STX{{{ ! 5245: {{DAC{1{{{ ! 5246: * ! 5247: {V$STC{DBC{SVKNM{{{STCOUNT ! 5248: {{DAC{7{{{ ! 5249: {{DTC{/STCOUNT/{{{ ! 5250: {{DAC{K$STC{{{ ! 5251: * ! 5252: {V$STL{DBC{SVKNM{{{STLIMIT ! 5253: {{DAC{7{{{ ! 5254: {{DTC{/STLIMIT/{{{ ! 5255: {{DAC{K$STL{{{ ! 5256: * ! 5257: {V$SUC{DBC{SVKVC{{{SUCCEED ! 5258: {{DAC{7{{{ ! 5259: {{DTC{/SUCCEED/{{{ ! 5260: {{DAC{K$SUC{{{ ! 5261: {{DAC{NDSUC{{{ ! 5262: * ! 5263: {V$ALP{DBC{SVKWC{{{ALPHABET ! 5264: {{DAC{8{{{ ! 5265: {{DTC{/ALPHABET/{{{ ! 5266: {{DAC{K$ALP{{{ ! 5267: * ! 5268: {V$CNT{DBC{SVLBL{{{CONTINUE ! 5269: {{DAC{8{{{ ! 5270: {{DTC{/CONTINUE/{{{ ! 5271: {{DAC{L$CNT{{{ ! 5272: {{EJC{{{{ ! 5273: * ! 5274: * STANDARD VARIABLE BLOCKS (CONTINUED) ! 5275: * ! 5276: {V$DTP{DBC{SVFNP{{{DATATYPE ! 5277: {{DAC{8{{{ ! 5278: {{DTC{/DATATYPE/{{{ ! 5279: {{DAC{S$DTP{{{ ! 5280: {{DAC{1{{{ ! 5281: * ! 5282: {V$ERL{DBC{SVKNM{{{ERRLIMIT ! 5283: {{DAC{8{{{ ! 5284: {{DTC{/ERRLIMIT/{{{ ! 5285: {{DAC{K$ERL{{{ ! 5286: * ! 5287: {V$FNC{DBC{SVKNM{{{FNCLEVEL ! 5288: {{DAC{8{{{ ! 5289: {{DTC{/FNCLEVEL/{{{ ! 5290: {{DAC{K$FNC{{{ ! 5291: * ! 5292: {V$MXL{DBC{SVKNM{{{MAXLNGTH ! 5293: {{DAC{8{{{ ! 5294: {{DTC{/MAXLNGTH/{{{ ! 5295: {{DAC{K$MXL{{{ ! 5296: * ! 5297: {V$TER{DBC{0{{{TERMINAL ! 5298: {{DAC{8{{{ ! 5299: {{DTC{/TERMINAL/{{{ ! 5300: {{DAC{0{{{ ! 5301: * ! 5302: {V$PRO{DBC{SVFNN{{{PROTOTYPE ! 5303: {{DAC{9{{{ ! 5304: {{DTC{/PROTOTYPE/{{{ ! 5305: {{DAC{S$PRO{{{ ! 5306: {{DAC{1{{{ ! 5307: * ! 5308: {{DBC{0{{{DUMMY ENTRY TO END LIST ! 5309: {{DAC{10{{{LENGTH GT 9 (PROTOTYPE) ! 5310: {{EJC{{{{ ! 5311: * ! 5312: * LIST OF SVBLK POINTERS FOR KEYWORDS TO BE DUMPED. THE ! 5313: * LIST IS IN THE ORDER WHICH APPEARS ON THE DUMP OUTPUT. ! 5314: * ! 5315: {VDMKW{DAC{V$ANC{{{ANCHOR ! 5316: {{DAC{V$CAS{{{CCASE ! 5317: {{DAC{V$COD{{{CODE ! 5318: {{DAC{V$DMP{{{DUMP ! 5319: {{DAC{V$ERL{{{ERRLIMIT ! 5320: {{DAC{V$ETX{{{ERRTEXT ! 5321: {{DAC{V$ERT{{{ERRTYPE ! 5322: {{DAC{V$FNC{{{FNCLEVEL ! 5323: {{DAC{V$FTR{{{FTRACE ! 5324: {{DAC{V$INP{{{INPUT ! 5325: {{DAC{V$LST{{{LASTNO ! 5326: {{DAC{V$MXL{{{MAXLENGTH ! 5327: {{DAC{V$OUP{{{OUTPUT ! 5328: {{DAC{V$PFL{{{PROFILE ! 5329: {{DAC{V$RTN{{{RTNTYPE ! 5330: {{DAC{V$STC{{{STCOUNT ! 5331: {{DAC{V$STL{{{STLIMIT ! 5332: {{DAC{V$STN{{{STNO ! 5333: {{DAC{V$TRA{{{TRACE ! 5334: {{DAC{V$TRM{{{TRIM ! 5335: {{DAC{0{{{END OF LIST ! 5336: * ! 5337: * TABLE USED BY GTNVR TO SEARCH SVBLK LISTS ! 5338: * ! 5339: {VSRCH{DAC{0{{{DUMMY ENTRY TO GET PROPER INDEXING ! 5340: {{DAC{V$EQF{{{START OF 1 CHAR VARIABLES (NONE) ! 5341: {{DAC{V$EQF{{{START OF 2 CHAR VARIABLES ! 5342: {{DAC{V$ANY{{{START OF 3 CHAR VARIABLES ! 5343: {{DAC{V$CAS{{{START OF 4 CHAR VARIABLES ! 5344: {{DAC{V$ABE{{{START OF 5 CHAR VARIABLES ! 5345: {{DAC{V$ANC{{{START OF 6 CHAR VARIABLES ! 5346: {{DAC{V$COL{{{START OF 7 CHAR VARIABLES ! 5347: {{DAC{V$ALP{{{START OF 8 CHAR VARIABLES ! 5348: {{DAC{V$PRO{{{START OF 9 CHAR VARIABLES ! 5349: {{TTL{S{{{P I T B O L -- WORKING STORAGE SECTION ! 5350: * ! 5351: * THE WORKING STORAGE SECTION CONTAINS AREAS WHICH ARE ! 5352: * CHANGED DURING EXECUTION OF THE PROGRAM. THE VALUE ! 5353: * ASSEMBLED IS THE INITIAL VALUE BEFORE EXECUTION STARTS. ! 5354: * ! 5355: * ALL THESE AREAS ARE FIXED LENGTH AREAS. VARIABLE LENGTH ! 5356: * DATA IS STORED IN THE STATIC OR DYNAMIC REGIONS OF THE ! 5357: * ALLOCATED DATA AREAS. ! 5358: * ! 5359: * THE VALUES IN THIS AREA ARE DESCRIBED EITHER AS WORK ! 5360: * AREAS OR AS GLOBAL VALUES. A WORK AREA IS USED IN AN ! 5361: * EPHEMERAL MANNER AND THE VALUE IS NOT SAVED FROM ONE ! 5362: * ENTRY INTO A ROUTINE TO ANOTHER. A GLOBAL VALUE IS A ! 5363: * LESS TEMPORARY LOCATION WHOSE VALUE IS SAVED FROM ONE ! 5364: * CALL TO ANOTHER. ! 5365: * ! 5366: * A GENERAL PART OF THE APPROACH IN THIS PROGRAM IS NOT ! 5367: * TO OVERLAP WORK AREAS BETWEEN PROCEDURES EVEN THOUGH A ! 5368: * SMALL AMOUNT OF SPACE COULD BE SAVED. SUCH OVERLAP IS ! 5369: * CONSIDERED A SOURCE OF PROGRAM ERRORS AND DECREASES THE ! 5370: * INFORMATION LEFT BEHIND AFTER A SYSTEM CRASH OF ANY KIND. ! 5371: * ! 5372: * THE NAMES OF THESE LOCATIONS ARE LABELS WITH FIVE LETTER ! 5373: * (A-Y,$) NAMES. AS FAR AS POSSIBLE THE ORDER IS KEPT ! 5374: * ALPHABETICAL BY THESE NAMES BUT IN SOME CASES THERE ! 5375: * ARE SLIGHT DEPARTURES CAUSED BY OTHER ORDER REQUIREMENTS. ! 5376: * ! 5377: * UNLESS OTHERWISE DOCUMENTED, THE ORDER OF WORK AREAS ! 5378: * DOES NOT AFFECT THE EXECUTION OF THE SPITBOL PROGRAM. ! 5379: * ! 5380: {{SEC{{{{START OF WORKING STORAGE SECTION ! 5381: {{EJC{{{{ ! 5382: * ! 5383: * THIS AREA IS NOT CLEARED BY INITIAL CODE ! 5384: * ! 5385: {CMLAB{DAC{B$SCL{{{STRING USED TO CHECK LABEL LEGALITY ! 5386: {{DAC{2{{{ ! 5387: {{DTC{/ /{{{ ! 5388: * ! 5389: * LABEL TO MARK START OF WORK AREA ! 5390: * ! 5391: {AAAAA{DAC{0{{{ ! 5392: * ! 5393: * WORK AREAS FOR ALLOC PROCEDURE ! 5394: * ! 5395: {ALDYN{DAC{0{{{AMOUNT OF DYNAMIC STORE ! 5396: {ALFSF{DIC{+0{{{FACTOR IN FREE STORE PCNTAGE CHECK ! 5397: {ALLIA{DIC{+0{{{DUMP IA ! 5398: {ALLSV{DAC{0{{{SAVE WB IN ALLOC ! 5399: * ! 5400: * WORK AREAS FOR ALOST PROCEDURE ! 5401: * ! 5402: {ALSTA{DAC{0{{{SAVE WA IN ALOST ! 5403: * ! 5404: * SAVE AREAS FOR ARRAY FUNCTION (S$ARR) ! 5405: * ! 5406: {ARCDM{DAC{0{{{COUNT DIMENSIONS ! 5407: {ARNEL{DIC{+0{{{COUNT ELEMENTS ! 5408: {ARPTR{DAC{0{{{OFFSET PTR INTO ARBLK ! 5409: {ARSVL{DIC{+0{{{SAVE INTEGER LOW BOUND ! 5410: {{EJC{{{{ ! 5411: * WORK AREAS FOR ARREF ROUTINE ! 5412: * ! 5413: {ARFSI{DIC{+0{{{SAVE CURRENT EVOLVING SUBSCRIPT ! 5414: {ARFXS{DAC{0{{{SAVE BASE STACK POINTER ! 5415: * ! 5416: * WORK AREAS FOR B$EFC BLOCK ROUTINE ! 5417: * ! 5418: {BEFOF{DAC{0{{{SAVE OFFSET PTR INTO EFBLK ! 5419: * ! 5420: * WORK AREAS FOR B$PFC BLOCK ROUTINE ! 5421: * ! 5422: {BPFPF{DAC{0{{{SAVE PFBLK POINTER ! 5423: {BPFSV{DAC{0{{{SAVE OLD FUNCTION VALUE ! 5424: {BPFXT{DAC{0{{{POINTER TO STACKED ARGUMENTS ! 5425: * ! 5426: * SAVE AREAS FOR COLLECT FUNCTION (S$COL) ! 5427: * ! 5428: {CLSVI{DIC{+0{{{SAVE INTEGER ARGUMENT ! 5429: * ! 5430: * GLOBAL VALUES FOR CMPIL PROCEDURE ! 5431: * ! 5432: {CMERC{DAC{0{{{COUNT OF INITIAL COMPILE ERRORS ! 5433: {CMPXS{DAC{0{{{SAVE STACK PTR IN CASE OF ERRORS ! 5434: {CMPSN{DAC{1{{{NUMBER OF NEXT STATEMENT TO COMPILE ! 5435: {CMPSS{DAC{0{{{SAVE SUBROUTINE STACK PTR ! 5436: * ! 5437: * WORK AREA FOR CNCRD ! 5438: * ! 5439: {CNSCC{DAC{0{{{POINTER TO CONTROL CARD STRING ! 5440: {CNSWC{DAC{0{{{WORD COUNT ! 5441: {CNR$T{DAC{0{{{POINTER TO R$TTL OR R$STL ! 5442: {CNTTL{DAC{0{{{FLAG FOR -TITLE, -STITL ! 5443: * ! 5444: * WORK AREAS FOR CONVERT FUNCTION (S$CNV) ! 5445: * ! 5446: {CNVTP{DAC{0{{{SAVE PTR INTO SCVTB ! 5447: * ! 5448: * FLAG FOR SUPPRESSION OF COMPILATION STATISTICS. ! 5449: * ! 5450: {CPSTS{DAC{0{{{SUPPRESS COMP. STATS IF NON ZERO ! 5451: * ! 5452: * GLOBAL VALUES FOR CONTROL CARD SWITCHES ! 5453: * ! 5454: {CSWDB{DAC{0{{{0/1 FOR -SINGLE/-DOUBLE ! 5455: {CSWER{DAC{0{{{0/1 FOR -ERRORS/-NOERRORS ! 5456: {CSWEX{DAC{0{{{0/1 FOR -EXECUTE/-NOEXECUTE ! 5457: {CSWFL{DAC{1{{{0/1 FOR -NOFAIL/-FAIL ! 5458: {CSWIN{DAC{INILN{{{XXX FOR -INXXX ! 5459: {CSWLS{DAC{1{{{0/1 FOR -NOLIST/-LIST ! 5460: {CSWNO{DAC{0{{{0/1 FOR -OPTIMISE/-NOOPT ! 5461: {CSWPR{DAC{0{{{0/1 FOR -NOPRINT/-PRINT ! 5462: * ! 5463: * GLOBAL LOCATION USED BY PATST PROCEDURE ! 5464: * ! 5465: {CTMSK{DBC{0{{{LAST BIT POSITION USED IN R$CTP ! 5466: {CURID{DAC{0{{{CURRENT ID VALUE ! 5467: {{EJC{{{{ ! 5468: * ! 5469: * GLOBAL VALUE FOR CDWRD PROCEDURE ! 5470: * ! 5471: {CWCOF{DAC{0{{{NEXT WORD OFFSET IN CURRENT CCBLK ! 5472: * ! 5473: * WORK AREAS FOR DATA FUNCTION (S$DAT) ! 5474: * ! 5475: {DATDV{DAC{0{{{SAVE VRBLK PTR FOR DATATYPE NAME ! 5476: {DATXS{DAC{0{{{SAVE INITIAL STACK POINTER ! 5477: * ! 5478: * WORK AREAS FOR DEFINE FUNCTION (S$DEF) ! 5479: * ! 5480: {DEFLB{DAC{0{{{SAVE VRBLK PTR FOR LABEL ! 5481: {DEFNA{DAC{0{{{COUNT FUNCTION ARGUMENTS ! 5482: {DEFVR{DAC{0{{{SAVE VRBLK PTR FOR FUNCTION NAME ! 5483: {DEFXS{DAC{0{{{SAVE INITIAL STACK POINTER ! 5484: * ! 5485: * WORK AREAS FOR DUMPR PROCEDURE ! 5486: * ! 5487: {DMARG{DAC{0{{{DUMP ARGUMENT ! 5488: {DMPKB{DAC{B$KVT{{{DUMMY KVBLK FOR USE IN DUMPR ! 5489: {DMPKT{DAC{TRBKV{{{KVVAR TRBLK POINTER ! 5490: {DMPKN{DAC{0{{{KEYWORD NUMBER (MUST FOLLOW DMPKB) ! 5491: {DMPSA{DAC{0{{{PRESERVE WA OVER PRTVL CALL ! 5492: {DMPSV{DAC{0{{{GENERAL SCRATCH SAVE ! 5493: {DMVCH{DAC{0{{{CHAIN POINTER FOR VARIABLE BLOCKS ! 5494: {DMPCH{DAC{0{{{SAVE SORTED VRBLK CHAIN POINTER ! 5495: * ! 5496: * GLOBAL LOCATIONS FOR DYNAMIC STORAGE POINTERS ! 5497: * ! 5498: {DNAMB{DAC{0{{{START OF DYNAMIC AREA ! 5499: {DNAMP{DAC{0{{{NEXT AVAILABLE LOC IN DYNAMIC AREA ! 5500: {DNAME{DAC{0{{{END OF AVAILABLE DYNAMIC AREA ! 5501: * ! 5502: * WORK AREA FOR DTACH ! 5503: * ! 5504: {DTCNB{DAC{0{{{NAME BASE ! 5505: {DTCNM{DAC{0{{{NAME PTR ! 5506: * ! 5507: * WORK AREAS FOR DUPL FUNCTION (S$DUP) ! 5508: * ! 5509: {DUPSI{DIC{+0{{{STORE INTEGER STRING LENGTH ! 5510: * ! 5511: * WORK AREA FOR ENDFILE (S$ENF) ! 5512: * ! 5513: {ENFCH{DAC{0{{{FOR IOCHN CHAIN HEAD ! 5514: * ! 5515: * WORK AREA FOR ERROR PROCESSING. ! 5516: * ! 5517: {ERICH{DAC{0{{{COPY ERROR REPORTS TO INT.CHAN IF 1 ! 5518: {ERLST{DAC{0{{{FOR LISTR WHEN ERRORS GO TO INT.CH. ! 5519: {ERRFT{DAC{0{{{FATAL ERROR FLAG ! 5520: {ERRSP{DAC{0{{{ERROR SUPPRESSION FLAG ! 5521: {{EJC{{{{ ! 5522: * ! 5523: * DUMP AREA FOR ERTEX ! 5524: * ! 5525: {ERTWA{DAC{0{{{SAVE WA ! 5526: {ERTWB{DAC{0{{{SAVE WB ! 5527: * ! 5528: * GLOBAL VALUES FOR EVALI ! 5529: * ! 5530: {EVLIN{DAC{P$LEN{{{DUMMY PATTERN BLOCK PCODE ! 5531: {EVLIS{DAC{0{{{POINTER TO SUBSEQUENT NODE ! 5532: {EVLIV{DAC{0{{{VALUE OF PARAMETER ! 5533: * WORK AREA FOR EXPAN ! 5534: * ! 5535: {EXPSV{DAC{0{{{SAVE OP DOPE VECTOR POINTER ! 5536: * ! 5537: * FLAG FOR SUPPRESSION OF EXECUTION STATS ! 5538: * ! 5539: {EXSTS{DAC{0{{{SUPPRESS EXEC STATS IF SET ! 5540: * ! 5541: * GLOBAL VALUES FOR EXFAL AND RETURN ! 5542: * ! 5543: {FLPRT{DAC{0{{{LOCATION OF FAIL OFFSET FOR RETURN ! 5544: {FLPTR{DAC{0{{{LOCATION OF FAILURE OFFSET ON STACK ! 5545: * ! 5546: * WORK AREAS FOR GBCOL PROCEDURE ! 5547: * ! 5548: {GBCFL{DAC{0{{{GARBAGE COLLECTOR ACTIVE FLAG ! 5549: {GBCLM{DAC{0{{{POINTER TO LAST MOVE BLOCK (PASS 3) ! 5550: {GBCNM{DAC{0{{{DUMMY FIRST MOVE BLOCK ! 5551: {GBCNS{DAC{0{{{REST OF DUMMY BLOCK (FOLLOWS GBCNM) ! 5552: {GBSVA{DAC{0{{{SAVE WA ! 5553: {GBSVB{DAC{0{{{SAVE WB ! 5554: {GBSVC{DAC{0{{{SAVE WC ! 5555: * ! 5556: * GLOBAL LOCATION TO COUNT GARBAGE COLLECTIONS (GBCOL) ! 5557: * ! 5558: {GBCNT{DAC{0{{{COUNT OF GARBAGE COLLECTIONS ! 5559: * ! 5560: * WORK AREAS FOR GTNVR PROCEDURE ! 5561: * ! 5562: {GNVHE{DAC{0{{{PTR TO END OF HASH CHAIN ! 5563: {GNVNW{DAC{0{{{NUMBER OF WORDS IN STRING NAME ! 5564: {GNVSA{DAC{0{{{SAVE WA ! 5565: {GNVSB{DAC{0{{{SAVE WB ! 5566: {GNVSP{DAC{0{{{POINTER INTO VSRCH TABLE ! 5567: {GNVST{DAC{0{{{POINTER TO CHARS OF STRING ! 5568: * ! 5569: * GLOBAL VALUE FOR GTCOD AND GTEXP ! 5570: * ! 5571: {GTCEF{DAC{0{{{SAVE FAIL PTR IN CASE OF ERROR ! 5572: * ! 5573: * WORK AREAS FOR GTINT ! 5574: * ! 5575: {GTINA{DAC{0{{{SAVE WA ! 5576: {GTINB{DAC{0{{{SAVE WB ! 5577: {{EJC{{{{ ! 5578: * ! 5579: * WORK AREAS FOR GTNUM PROCEDURE ! 5580: * ! 5581: {GTNNF{DAC{0{{{ZERO/NONZERO FOR RESULT +/- ! 5582: {GTNSI{DIC{+0{{{GENERAL INTEGER SAVE ! 5583: {GTNDF{DAC{0{{{0/1 FOR DEC POINT SO FAR NO/YES ! 5584: {GTNES{DAC{0{{{ZERO/NONZERO EXPONENT +/- ! 5585: {GTNEX{DIC{+0{{{REAL EXPONENT ! 5586: {GTNSC{DAC{0{{{SCALE (PLACES AFTER POINT) ! 5587: {GTNSR{DRC{+0.0{{{GENERAL REAL SAVE ! 5588: {GTNRD{DAC{0{{{FLAG FOR OK REAL NUMBER ! 5589: * ! 5590: * WORK AREAS FOR GTPAT PROCEDURE ! 5591: * ! 5592: {GTPSB{DAC{0{{{SAVE WB ! 5593: * ! 5594: * WORK AREAS FOR GTSTG PROCEDURE ! 5595: * ! 5596: {GTSSF{DAC{0{{{0/1 FOR RESULT +/- ! 5597: {GTSVC{DAC{0{{{SAVE WC ! 5598: {GTSVB{DAC{0{{{SAVE WB ! 5599: {GTSWK{DAC{0{{{PTR TO WORK AREA FOR GTSTG ! 5600: {GTSES{DAC{0{{{CHAR + OR - FOR EXPONENT +/- ! 5601: {GTSRS{DRC{+0.0{{{GENERAL REAL SAVE ! 5602: * ! 5603: * GLOBAL LOCATIONS (CONSTANTS) FOR GTSTG PROCEDURE ! 5604: * ! 5605: {GTSRN{DRC{+0.0{{{ROUNDING FACTOR 0.5*10**-CFP$S ! 5606: {GTSSC{DRC{+0.0{{{SCALING VALUE 10**CFP$S ! 5607: * ! 5608: * WORK AREAS FOR GTVAR PROCEDURE ! 5609: * ! 5610: {GTVRC{DAC{0{{{SAVE WC ! 5611: * ! 5612: * FLAG FOR HEADER PRINTING ! 5613: * ! 5614: {HEADP{DAC{0{{{HEADER PRINTED FLAG ! 5615: * ! 5616: * GLOBAL VALUES FOR VARIABLE HASH TABLE ! 5617: * ! 5618: {HSHNB{DIC{+0{{{NUMBER OF HASH BUCKETS ! 5619: {HSHTB{DAC{0{{{POINTER TO START OF VRBLK HASH TABL ! 5620: {HSHTE{DAC{0{{{POINTER PAST END OF VRBLK HASH TABL ! 5621: * ! 5622: * WORK AREA FOR INIT ! 5623: * ! 5624: {INISS{DAC{0{{{SAVE SUBROUTINE STACK PTR ! 5625: {INITR{DAC{0{{{SAVE TERMINAL FLAG ! 5626: * ! 5627: * SAVE AREA FOR INSBF ! 5628: * ! 5629: {INSAB{DAC{0{{{ENTRY WA + ENTRY WB ! 5630: {INSSA{DAC{0{{{SAVE ENTRY WA ! 5631: {INSSB{DAC{0{{{SAVE ENTRY WB ! 5632: {INSSC{DAC{0{{{SAVE ENTRY WC ! 5633: * ! 5634: * WORK AREAS FOR IOPUT ! 5635: * ! 5636: {IOPTT{DAC{0{{{TYPE OF ASSOCIATION ! 5637: {{EJC{{{{ ! 5638: * ! 5639: * GLOBAL VALUES FOR KEYWORD VALUES WHICH ARE STORED AS ONE ! 5640: * WORD INTEGERS. THESE VALUES MUST BE ASSEMBLED IN THE ! 5641: * FOLLOWING ORDER (AS DICTATED BY K$XXX DEFINITION VALUES). ! 5642: * ! 5643: {KVABE{DAC{0{{{ABEND ! 5644: {KVANC{DAC{0{{{ANCHOR ! 5645: {KVCAS{DAC{0{{{CASE ! 5646: {KVCOD{DAC{0{{{CODE ! 5647: {KVDMP{DAC{0{{{DUMP ! 5648: {KVERL{DAC{0{{{ERRLIMIT ! 5649: {KVERT{DAC{0{{{ERRTYPE ! 5650: {KVFTR{DAC{0{{{FTRACE ! 5651: {KVINP{DAC{1{{{INPUT ! 5652: {KVMXL{DAC{5000{{{MAXLENGTH ! 5653: {KVOUP{DAC{1{{{OUTPUT ! 5654: {KVPFL{DAC{0{{{PROFILE ! 5655: {KVTRA{DAC{0{{{TRACE ! 5656: {KVTRM{DAC{0{{{TRIM ! 5657: {KVFNC{DAC{0{{{FNCLEVEL ! 5658: {KVLST{DAC{0{{{LASTNO ! 5659: {KVSTN{DAC{0{{{STNO ! 5660: * ! 5661: * GLOBAL VALUES FOR OTHER KEYWORDS ! 5662: * ! 5663: {KVALP{DAC{0{{{ALPHABET ! 5664: {KVRTN{DAC{NULLS{{{RTNTYPE (SCBLK POINTER) ! 5665: {KVSTL{DIC{+50000{{{STLIMIT ! 5666: {KVSTC{DIC{+50000{{{STCOUNT (COUNTS DOWN FROM STLIMIT) ! 5667: * ! 5668: * WORK AREAS FOR LOAD FUNCTION ! 5669: * ! 5670: {LODFN{DAC{0{{{POINTER TO VRBLK FOR FUNC NAME ! 5671: {LODNA{DAC{0{{{COUNT NUMBER OF ARGUMENTS ! 5672: * ! 5673: * GLOBAL VALUES FOR LISTR PROCEDURE ! 5674: * ! 5675: {LSTLC{DAC{0{{{COUNT LINES ON SOURCE LIST PAGE ! 5676: {LSTNP{DAC{0{{{MAX NUMBER OF LINES ON PAGE ! 5677: {LSTPF{DAC{1{{{SET NONZERO IF CURRENT IMAGE LISTED ! 5678: {LSTPG{DAC{0{{{CURRENT SOURCE LIST PAGE NUMBER ! 5679: {LSTPO{DAC{0{{{OFFSET TO PAGE NNN MESSAGE ! 5680: {LSTSN{DAC{0{{{REMEMBER LAST STMNUM LISTED ! 5681: * ! 5682: * MAXIMUM SIZE OF SPITBOL OBJECTS ! 5683: * ! 5684: {MXLEN{DAC{0{{{INITIALISED BY SYSMX CALL ! 5685: * ! 5686: * EXECUTION CONTROL VARIABLE ! 5687: * ! 5688: {NOXEQ{DAC{0{{{SET NON-ZERO TO INHIBIT EXECUTION ! 5689: * ! 5690: * PROFILER GLOBAL VALUES AND WORK LOCATIONS ! 5691: * ! 5692: {PFDMP{DAC{0{{{SET NON-0 IF &PROFILE SET NON-0 ! 5693: {PFFNC{DAC{0{{{SET NON-0 IF FUNCT JUST ENTERED ! 5694: {PFSTM{DIC{+0{{{TO STORE STARTING TIME OF STMT ! 5695: {PFETM{DIC{+0{{{TO STORE ENDING TIME OF STMT ! 5696: {PFSVW{DAC{0{{{TO SAVE A W-REG ! 5697: {PFTBL{DAC{0{{{GETS ADRS OF (IMAG) TABLE BASE ! 5698: {PFNTE{DAC{0{{{NR OF TABLE ENTRIES ! 5699: {PFSTE{DIC{+0{{{GETS INT REP OF TABLE ENTRY SIZE ! 5700: * ! 5701: {{EJC{{{{ ! 5702: * ! 5703: * GLOBAL VALUES USED IN PATTERN MATCH ROUTINES ! 5704: * ! 5705: {PMDFL{DAC{0{{{PATTERN ASSIGNMENT FLAG ! 5706: {PMHBS{DAC{0{{{HISTORY STACK BASE POINTER ! 5707: {PMSSL{DAC{0{{{LENGTH OF SUBJECT STRING IN CHARS ! 5708: * ! 5709: * FLAGS USED FOR STANDARD FILE LISTING OPTIONS ! 5710: * ! 5711: {PRICH{DAC{0{{{PRINTER ON INTERACTIVE CHANNEL ! 5712: {PRSTD{DAC{0{{{TESTED BY PRTPG ! 5713: {PRSTO{DAC{0{{{STANDARD LISTING OPTION FLAG ! 5714: * ! 5715: * GLOBAL VALUE FOR PRTNM PROCEDURE ! 5716: * ! 5717: {PRNMV{DAC{0{{{VRBLK PTR FROM LAST NAME SEARCH ! 5718: * ! 5719: * WORK AREAS FOR PRTNM PROCEDURE ! 5720: * ! 5721: {PRNSI{DIC{+0{{{SCRATCH INTEGER LOC ! 5722: * ! 5723: * WORK AREAS FOR PRTSN PROCEDURE ! 5724: * ! 5725: {PRSNA{DAC{0{{{SAVE WA ! 5726: * ! 5727: * GLOBAL VALUES FOR PRINT PROCEDURES ! 5728: * ! 5729: {PRBUF{DAC{0{{{PTR TO PRINT BFR IN STATIC ! 5730: {PRECL{DAC{0{{{EXTENDED/COMPACT LISTING FLAG ! 5731: {PRLEN{DAC{0{{{LENGTH OF PRINT BUFFER IN CHARS ! 5732: {PRLNW{DAC{0{{{LENGTH OF PRINT BUFFER IN WORDS ! 5733: {PROFS{DAC{0{{{OFFSET TO NEXT LOCATION IN PRBUF ! 5734: {PRTEF{DAC{0{{{ENDFILE FLAG ! 5735: * ! 5736: * WORK AREAS FOR PRTST PROCEDURE ! 5737: * ! 5738: {PRSVA{DAC{0{{{SAVE WA ! 5739: {PRSVB{DAC{0{{{SAVE WB ! 5740: {PRSVC{DAC{0{{{SAVE CHAR COUNTER ! 5741: * ! 5742: * WORK AREA FOR PRTNL ! 5743: * ! 5744: {PRTSA{DAC{0{{{SAVE WA ! 5745: {PRTSB{DAC{0{{{SAVE WB ! 5746: * ! 5747: * WORK AREA FOR PRTVL ! 5748: * ! 5749: {PRVSI{DAC{0{{{SAVE IDVAL ! 5750: * ! 5751: * WORK AREAS FOR PATTERN MATCH ROUTINES ! 5752: * ! 5753: {PSAVE{DAC{0{{{TEMPORARY SAVE FOR CURRENT NODE PTR ! 5754: {PSAVC{DAC{0{{{SAVE CURSOR IN P$SPN, P$STR ! 5755: {{EJC{{{{ ! 5756: * ! 5757: * AMOUNT OF MEMORY RESERVED FOR END OF EXECUTION ! 5758: * ! 5759: {RSMEM{DAC{0{{{RESERVE MEMORY ! 5760: * ! 5761: * WORK AREAS FOR RETRN ROUTINE ! 5762: * ! 5763: {RTNBP{DAC{0{{{TO SAVE A BLOCK POINTER ! 5764: {RTNFV{DAC{0{{{NEW FUNCTION VALUE (RESULT) ! 5765: {RTNSV{DAC{0{{{OLD FUNCTION VALUE (SAVED VALUE) ! 5766: * ! 5767: * RELOCATABLE GLOBAL VALUES ! 5768: * ! 5769: * ALL THE POINTERS IN THIS SECTION CAN POINT TO BLOCKS IN ! 5770: * THE DYNAMIC STORAGE AREA AND MUST BE RELOCATED BY THE ! 5771: * GARBAGE COLLECTOR. THEY ARE IDENTIFIED BY R$XXX NAMES. ! 5772: * ! 5773: {R$AAA{DAC{0{{{START OF RELOCATABLE VALUES ! 5774: {R$ARF{DAC{0{{{ARRAY BLOCK POINTER FOR ARREF ! 5775: {R$CCB{DAC{0{{{PTR TO CCBLK BEING BUILT (CDWRD) ! 5776: {R$CIM{DAC{0{{{PTR TO CURRENT COMPILER INPUT STR ! 5777: {R$CMP{DAC{0{{{COPY OF R$CIM USED IN CMPIL ! 5778: {R$CNI{DAC{0{{{PTR TO NEXT COMPILER INPUT STRING ! 5779: {R$CNT{DAC{0{{{CDBLK POINTER FOR SETEXIT CONTINUE ! 5780: {R$COD{DAC{0{{{POINTER TO CURRENT CDBLK OR EXBLK ! 5781: {R$CTP{DAC{0{{{PTR TO CURRENT CTBLK FOR PATST ! 5782: {R$ERT{DAC{0{{{TRBLK POINTER FOR ERRTYPE TRACE ! 5783: {R$ETX{DAC{NULLS{{{POINTER TO ERRTEXT STRING ! 5784: {R$EXS{DAC{0{{{= SAVE XL IN EXPDM ! 5785: {R$FCB{DAC{0{{{FCBLK CHAIN HEAD ! 5786: {R$FNC{DAC{0{{{TRBLK POINTER FOR FNCLEVEL TRACE ! 5787: {R$GTC{DAC{0{{{KEEP CODE PTR FOR GTCOD,GTEXP ! 5788: {R$IO1{DAC{0{{{FILE ARG1 FOR IOPUT ! 5789: {R$IO2{DAC{0{{{FILE ARG2 FOR IOPUT ! 5790: {R$IOF{DAC{0{{{FCBLK PTR OR 0 ! 5791: {R$ION{DAC{0{{{NAME BASE PTR ! 5792: {R$IOP{DAC{0{{{PREDECESSOR BLOCK PTR FOR IOPUT ! 5793: {R$IOT{DAC{0{{{TRBLK PTR FOR IOPUT ! 5794: {R$PMB{DAC{0{{{BUFFER PTR IN PATTERN MATCH ! 5795: {R$PMS{DAC{0{{{SUBJECT STRING PTR IN PATTERN MATCH ! 5796: {R$RA2{DAC{0{{{REPLACE SECOND ARGUMENT LAST TIME ! 5797: {R$RA3{DAC{0{{{REPLACE THIRD ARGUMENT LAST TIME ! 5798: {R$RPT{DAC{0{{{PTR TO CTBLK REPLACE TABLE LAST USD ! 5799: {R$SCP{DAC{0{{{SAVE POINTER FROM LAST SCANE CALL ! 5800: {R$SXL{DAC{0{{{PRESERVE XL IN SORTC ! 5801: {R$SXR{DAC{0{{{PRESERVE XR IN SORTA/SORTC ! 5802: {R$STC{DAC{0{{{TRBLK POINTER FOR STCOUNT TRACE ! 5803: {R$STL{DAC{0{{{SOURCE LISTING SUB-TITLE ! 5804: {R$SXC{DAC{0{{{CODE (CDBLK) PTR FOR SETEXIT TRAP ! 5805: {R$TTL{DAC{NULLS{{{SOURCE LISTING TITLE ! 5806: {R$XSC{DAC{0{{{STRING POINTER FOR XSCAN ! 5807: {{EJC{{{{ ! 5808: * ! 5809: * THE REMAINING POINTERS IN THIS LIST ARE USED TO POINT ! 5810: * TO FUNCTION BLOCKS FOR NORMALLY UNDEFINED OPERATORS. ! 5811: * ! 5812: {R$UBA{DAC{STNDO{{{BINARY AT ! 5813: {R$UBM{DAC{STNDO{{{BINARY AMPERSAND ! 5814: {R$UBN{DAC{STNDO{{{BINARY NUMBER SIGN ! 5815: {R$UBP{DAC{STNDO{{{BINARY PERCENT ! 5816: {R$UBT{DAC{STNDO{{{BINARY NOT ! 5817: {R$UUB{DAC{STNDO{{{UNARY VERTICAL BAR ! 5818: {R$UUE{DAC{STNDO{{{UNARY EQUAL ! 5819: {R$UUN{DAC{STNDO{{{UNARY NUMBER SIGN ! 5820: {R$UUP{DAC{STNDO{{{UNARY PERCENT ! 5821: {R$UUS{DAC{STNDO{{{UNARY SLASH ! 5822: {R$UUX{DAC{STNDO{{{UNARY EXCLAMATION ! 5823: {R$YYY{DAC{0{{{LAST RELOCATABLE LOCATION ! 5824: * ! 5825: * WORK AREAS FOR SUBSTR FUNCTION (S$SUB) ! 5826: * ! 5827: {SBSSV{DAC{0{{{SAVE THIRD ARGUMENT ! 5828: * ! 5829: * GLOBAL LOCATIONS USED IN SCAN PROCEDURE ! 5830: * ! 5831: {SCNBL{DAC{0{{{SET NON-ZERO IF SCANNED PAST BLANKS ! 5832: {SCNCC{DAC{0{{{NON-ZERO TO SCAN CONTROL CARD NAME ! 5833: {SCNGO{DAC{0{{{SET NON-ZERO TO SCAN GOTO FIELD ! 5834: {SCNIL{DAC{0{{{LENGTH OF CURRENT INPUT IMAGE ! 5835: {SCNPT{DAC{0{{{POINTER TO NEXT LOCATION IN R$CIM ! 5836: {SCNRS{DAC{0{{{SET NON-ZERO TO SIGNAL RESCAN ! 5837: {SCNTP{DAC{0{{{SAVE SYNTAX TYPE FROM LAST CALL ! 5838: * ! 5839: * WORK AREAS FOR SCAN PROCEDURE ! 5840: * ! 5841: {SCNSA{DAC{0{{{SAVE WA ! 5842: {SCNSB{DAC{0{{{SAVE WB ! 5843: {SCNSC{DAC{0{{{SAVE WC ! 5844: {SCNSE{DAC{0{{{START OF CURRENT ELEMENT ! 5845: {SCNOF{DAC{0{{{SAVE OFFSET ! 5846: {{EJC{{{{ ! 5847: * ! 5848: * WORK AREA USED BY SORTA, SORTC, SORTF, SORTH ! 5849: * ! 5850: {SRTDF{DAC{0{{{DATATYPE FIELD NAME ! 5851: {SRTFD{DAC{0{{{FOUND DFBLK ADDRESS ! 5852: {SRTFF{DAC{0{{{FOUND FIELD NAME ! 5853: {SRTFO{DAC{0{{{OFFSET TO FIELD NAME ! 5854: {SRTNR{DAC{0{{{NUMBER OF ROWS ! 5855: {SRTOF{DAC{0{{{OFFSET WITHIN ROW TO SORT KEY ! 5856: {SRTRT{DAC{0{{{ROOT OFFSET ! 5857: {SRTS1{DAC{0{{{SAVE OFFSET 1 ! 5858: {SRTS2{DAC{0{{{SAVE OFFSET 2 ! 5859: {SRTSC{DAC{0{{{SAVE WC ! 5860: {SRTSF{DAC{0{{{SORT ARRAY FIRST ROW OFFSET ! 5861: {SRTSN{DAC{0{{{SAVE N ! 5862: {SRTSO{DAC{0{{{OFFSET TO A(0) ! 5863: {SRTSR{DAC{0{{{0 , NON-ZERO FOR SORT, RSORT ! 5864: {SRTST{DAC{0{{{STRIDE FROM ONE ROW TO NEXT ! 5865: {SRTWC{DAC{0{{{DUMP WC ! 5866: * ! 5867: * GLOBAL VALUE FOR INDICATING STAGE (SEE ERROR SECTION) ! 5868: * ! 5869: {STAGE{DAC{0{{{INITIAL VALUE = INITIAL COMPILE ! 5870: * ! 5871: * GLOBAL VALUES DEFINING EXTENT OF STATIC AREA (ALOST) ! 5872: * ! 5873: {STATB{DAC{0{{{START OF STATIC AREA ! 5874: {STATE{DAC{0{{{END OF STATIC AREA ! 5875: {{EJC{{{{ ! 5876: * ! 5877: * GLOBAL STACK POINTER ! 5878: * ! 5879: {STBAS{DAC{0{{{POINTER PAST STACK BASE ! 5880: * ! 5881: * WORK AREAS FOR STOPR ROUTINE ! 5882: * ! 5883: {STPSI{DIC{+0{{{SAVE VALUE OF STCOUNT ! 5884: {STPTI{DIC{+0{{{SAVE TIME ELAPSED ! 5885: * ! 5886: * GLOBAL VALUES FOR SETEXIT FUNCTION (S$STX) ! 5887: * ! 5888: {STXOF{DAC{0{{{FAILURE OFFSET ! 5889: {STXVR{DAC{NULLS{{{VRBLK POINTER OR NULL ! 5890: * ! 5891: * WORK AREAS FOR TFIND PROCEDURE ! 5892: * ! 5893: {TFNSI{DIC{+0{{{NUMBER OF HEADERS ! 5894: * ! 5895: * GLOBAL VALUE FOR TIME KEEPING ! 5896: * ! 5897: {TIMSX{DIC{+0{{{TIME AT START OF EXECUTION ! 5898: {TIMUP{DAC{0{{{SET WHEN TIME UP OCCURS ! 5899: * ! 5900: * WORK AREAS FOR XSCAN PROCEDURE ! 5901: * ! 5902: {XSCRT{DAC{0{{{SAVE RETURN CODE ! 5903: {XSCWB{DAC{0{{{SAVE REGISTER WB ! 5904: * ! 5905: * GLOBAL VALUES FOR XSCAN AND XSCNI PROCEDURES ! 5906: * ! 5907: {XSOFS{DAC{0{{{OFFSET TO CURRENT LOCATION IN R$XSC ! 5908: * ! 5909: * LABEL TO MARK END OF WORK AREA ! 5910: * ! 5911: {YYYYY{DAC{0{{{ ! 5912: {{TTL{S{{{P I T B O L -- INITIALIZATION ! 5913: * ! 5914: * INITIALISATION ! 5915: * THE FOLLOWING SECTION RECEIVES CONTROL FROM THE SYSTEM ! 5916: * AT THE START OF A RUN WITH THE REGISTERS SET AS FOLLOWS. ! 5917: * ! 5918: * (XS) POINTS PAST STACK BASE ! 5919: * (XR) POINTS TO FIRST WORD OF DATA AREA ! 5920: * (XL) POINTS TO LAST WORD OF DATA AREA ! 5921: * ! 5922: {{SEC{{{{START OF PROGRAM SECTION ! 5923: {{JSR{SYSTM{{{INITIALISE TIMER ! 5924: * ! 5925: * INITIALISE WORK AREA (ESSENTIAL FOR BATCHED RUNS) ! 5926: * ! 5927: {{MOV{R9{R7{{PRESERVE XR ! 5928: {{MOV{#YYYYY{R6{{POINT TO END OF WORK AREA ! 5929: {{SUB{#AAAAA{R6{{GET LENGTH OF WORK AREA ! 5930: {{BTW{R6{{{CONVERT TO WORDS ! 5931: {{LCT{R6{R6{{COUNT FOR LOOP ! 5932: {{MOV{#AAAAA{R9{{SET UP INDEX REGISTER ! 5933: * ! 5934: * CLEAR WORK SPACE ! 5935: * ! 5936: {INI01{ZER{(R9)+{{{CLEAR A WORD ! 5937: {{BCT{R6{INI01{{LOOP TILL DONE ! 5938: {{MOV{#STNDO{R6{{UNDEFINED OPERATORS POINTER ! 5939: {{MOV{#R$YYY{R8{{POINT TO TABLE END ! 5940: {{SUB{#R$UBA{R8{{LENGTH OF UNDEF. OPERATORS TABLE ! 5941: {{BTW{R8{{{CONVERT TO WORDS ! 5942: {{LCT{R8{R8{{LOOP COUNTER ! 5943: {{MOV{#R$UBA{R9{{SET UP XR ! 5944: * ! 5945: * SET CORRECT VALUE INTO UNDEFINED OPERATORS TABLE ! 5946: * ! 5947: {INI02{MOV{R6{(R9)+{{STORE VALUE ! 5948: {{BCT{R8{INI02{{LOOP TILL ALL DONE ! 5949: {{MOV{#NUM01{R6{{GET A 1 ! 5950: {{MOV{R6{CMPSN{{STATEMENT NO ! 5951: {{MOV{R6{CSWFL{{NOFAIL ! 5952: {{MOV{R6{CSWLS{{LIST ! 5953: {{MOV{R6{KVINP{{INPUT ! 5954: {{MOV{R6{KVOUP{{OUTPUT ! 5955: {{MOV{R6{LSTPF{{NOTHING FOR LISTR YET ! 5956: {{MOV{#INILN{R6{{INPUT IMAGE LENGTH ! 5957: {{MOV{R6{CSWIN{{-IN72 ! 5958: {{MOV{#B$KVT{DMPKB{{DUMP ! 5959: {{MOV{#TRBKV{DMPKT{{DUMP ! 5960: {{MOV{#P$LEN{EVLIN{{EVAL ! 5961: {{EJC{{{{ ! 5962: {{MOV{#NULLS{R6{{GET NULLSTRING POINTER ! 5963: {{MOV{R6{KVRTN{{RETURN ! 5964: {{MOV{R6{R$ETX{{ERRTEXT ! 5965: {{MOV{R6{R$TTL{{TITLE FOR LISTING ! 5966: {{MOV{R6{STXVR{{SETEXIT ! 5967: {{STI{TIMSX{{{STORE TIME IN CORRECT PLACE ! 5968: {{LDI{STLIM{{{GET DEFAULT STLIMIT ! 5969: {{STI{KVSTL{{{STATEMENT LIMIT ! 5970: {{STI{KVSTC{{{STATEMENT COUNT ! 5971: {{MOV{R7{STATB{{STORE START ADRS OF STATIC ! 5972: {{MOV{#4*E$SRS{RSMEM{{RESERVE MEMORY ! 5973: {{MOV{SP{STBAS{{STORE STACK BASE ! 5974: {{SSS{INISS{{{SAVE S-R STACK PTR ! 5975: * ! 5976: * NOW CONVERT FREE STORE PERCENTAGE TO A SUITABLE FACTOR ! 5977: * FOR EASY TESTING IN ALLOC ROUTINE. ! 5978: * ! 5979: {{LDI{INTVH{{{GET 100 ! 5980: {{DVI{ALFSP{{{FORM 100 / ALFSP ! 5981: {{STI{ALFSF{{{STORE THE FACTOR ! 5982: * ! 5983: * INITIALIZE VALUES FOR REAL CONVERSION ROUTINE ! 5984: * ! 5985: {{LCT{R7{#CFP$S{{LOAD COUNTER FOR SIGNIFICANT DIGITS ! 5986: {{LDR{REAV1{{{LOAD 1.0 ! 5987: * ! 5988: * LOOP TO COMPUTE 10**(MAX NUMBER SIGNIFICANT DIGITS) ! 5989: * ! 5990: {INI03{MLR{REAVT{{{* 10.0 ! 5991: {{BCT{R7{INI03{{LOOP TILL DONE ! 5992: {{STR{GTSSC{{{STORE 10**(MAX SIG DIGITS) ! 5993: {{LDR{REAP5{{{LOAD 0.5 ! 5994: {{DVR{GTSSC{{{COMPUTE 0.5*10**(MAX SIG DIGITS) ! 5995: {{STR{GTSRN{{{STORE AS ROUNDING BIAS ! 5996: {{ZER{R8{{{SET TO READ PARAMETERS ! 5997: {{JSR{PRPAR{{{READ THEM ! 5998: {{EJC{{{{ ! 5999: * ! 6000: * NOW COMPUTE STARTING ADDRESS FOR DYNAMIC STORE AND IF ! 6001: * NECESSARY REQUEST MORE MEMORY. ! 6002: * ! 6003: {{SUB{#4*E$SRS{R10{{ALLOW FOR RESERVE MEMORY ! 6004: {{MOV{PRLEN{R6{{GET PRINT BUFFER LENGTH ! 6005: {{ADD{#CFP$A{R6{{ADD NO. OF CHARS IN ALPHABET ! 6006: {{ADD{#NSTMX{R6{{ADD CHARS FOR GTSTG BFR ! 6007: {{CTB{R6{8{{CONVERT TO BYTES, ALLOWING A MARGIN ! 6008: {{MOV{STATB{R9{{POINT TO STATIC BASE ! 6009: {{ADD{R6{R9{{INCREMENT FOR ABOVE BUFFERS ! 6010: {{ADD{#4*E$HNB{R9{{INCREMENT FOR HASH TABLE ! 6011: {{ADD{#4*E$STS{R9{{BUMP FOR INITIAL STATIC BLOCK ! 6012: {{JSR{SYSMX{{{GET MXLEN ! 6013: {{MOV{R6{KVMXL{{PROVISIONALLY STORE AS MAXLNGTH ! 6014: {{MOV{R6{MXLEN{{AND AS MXLEN ! 6015: {{BGT{R9{R6{INI06{SKIP IF STATIC HI EXCEEDS MXLEN ! 6016: {{MOV{R6{R9{{USE MXLEN INSTEAD ! 6017: {{ICA{R9{{{MAKE BIGGER THAN MXLEN ! 6018: * ! 6019: * HERE TO STORE VALUES WHICH MARK INITIAL DIVISION ! 6020: * OF DATA AREA INTO STATIC AND DYNAMIC ! 6021: * ! 6022: {INI06{MOV{R9{DNAMB{{DYNAMIC BASE ADRS ! 6023: {{MOV{R9{DNAMP{{DYNAMIC PTR ! 6024: {{BNZ{R6{INI07{{SKIP IF NON-ZERO MXLEN ! 6025: {{DCA{R9{{{POINT A WORD IN FRONT ! 6026: {{MOV{R9{KVMXL{{USE AS MAXLNGTH ! 6027: {{MOV{R9{MXLEN{{AND AS MXLEN ! 6028: {{EJC{{{{ ! 6029: * ! 6030: * LOOP HERE IF NECESSARY TILL ENOUGH MEMORY OBTAINED ! 6031: * SO THAT DNAME IS ABOVE DNAMB ! 6032: * ! 6033: {INI07{MOV{R10{DNAME{{STORE DYNAMIC END ADDRESS ! 6034: {{BLT{DNAMB{R10{INI09{SKIP IF HIGH ENOUGH ! 6035: {{JSR{SYSMM{{{REQUEST MORE MEMORY ! 6036: {{WTB{R9{{{GET AS BAUS (SGD05) ! 6037: {{ADD{R9{R10{{BUMP BY AMOUNT OBTAINED ! 6038: {{BNZ{R9{INI07{{TRY AGAIN ! 6039: {{MOV{#ENDMO{R9{{POINT TO FAILURE MESSAGE ! 6040: {{MOV{ENDML{R6{{MESSAGE LENGTH ! 6041: {{JSR{SYSPR{{{PRINT IT (PRTST NOT YET USABLE) ! 6042: {{PPM{{{{SHOULD NOT FAIL ! 6043: {{JSR{SYSEJ{{{PACK UP (STOPR NOT YET USABLE) ! 6044: * ! 6045: * INITIALISE PRINT BUFFER WITH BLANK WORDS ! 6046: * ! 6047: {INI09{MOV{PRLEN{R8{{NO. OF CHARS IN PRINT BFR ! 6048: {{MOV{STATB{R9{{POINT TO STATIC AGAIN ! 6049: {{MOV{R9{PRBUF{{PRINT BFR IS PUT AT STATIC START ! 6050: {{MOV{#B$SCL{(R9)+{{STORE STRING TYPE CODE ! 6051: {{MOV{R8{(R9)+{{AND STRING LENGTH ! 6052: {{CTW{R8{0{{GET NUMBER OF WORDS IN BUFFER ! 6053: {{MOV{R8{PRLNW{{STORE FOR BUFFER CLEAR ! 6054: {{LCT{R8{R8{{WORDS TO CLEAR ! 6055: * ! 6056: * LOOP TO CLEAR BUFFER ! 6057: * ! 6058: {INI10{MOV{NULLW{(R9)+{{STORE BLANK ! 6059: {{BCT{R8{INI10{{LOOP ! 6060: * ! 6061: * INITIALIZE NUMBER OF HASH HEADERS ! 6062: * ! 6063: {{MOV{#E$HNB{R6{{GET NUMBER OF HASH HEADERS ! 6064: {{MTI{R6{{{CONVERT TO INTEGER ! 6065: {{STI{HSHNB{{{STORE FOR USE BY GTNVR PROCEDURE ! 6066: {{LCT{R6{R6{{COUNTER FOR CLEARING HASH TABLE ! 6067: {{MOV{R9{HSHTB{{POINTER TO HASH TABLE ! 6068: * ! 6069: * LOOP TO CLEAR HASH TABLE ! 6070: * ! 6071: {INI11{ZER{(R9)+{{{BLANK A WORD ! 6072: {{BCT{R6{INI11{{LOOP ! 6073: {{MOV{R9{HSHTE{{END OF HASH TABLE ADRS IS KEPT ! 6074: * ! 6075: * ALLOCATE WORK AREA FOR GTSTG CONVERSION PROCEDURE ! 6076: * ! 6077: {{MOV{#NSTMX{R6{{GET MAX NUM CHARS IN OUTPUT NUMBER ! 6078: {{CTB{R6{SCSI${{NO OF BYTES NEEDED ! 6079: {{MOV{R9{GTSWK{{STORE BFR ADRS ! 6080: {{ADD{R6{R9{{BUMP FOR WORK BFR ! 6081: {{EJC{{{{ ! 6082: * ! 6083: * BUILD ALPHABET STRING FOR ALPHABET KEYWORD AND REPLACE ! 6084: * ! 6085: {{MOV{R9{KVALP{{SAVE ALPHABET POINTER ! 6086: {{MOV{#B$SCL{(R9){{STRING BLK TYPE ! 6087: {{MOV{#CFP$A{R8{{NO OF CHARS IN ALPHABET ! 6088: {{MOV{R8{4*SCLEN(R9){{STORE AS STRING LENGTH ! 6089: {{MOV{R8{R7{{COPY CHAR COUNT ! 6090: {{CTB{R7{SCSI${{NO. OF BYTES NEEDED ! 6091: {{ADD{R9{R7{{CURRENT END ADDRESS FOR STATIC ! 6092: {{MOV{R7{STATE{{STORE STATIC END ADRS ! 6093: {{LCT{R8{R8{{LOOP COUNTER ! 6094: {{PSC{R9{{{POINT TO CHARS OF STRING ! 6095: {{ZER{R7{{{SET INITIAL CHARACTER VALUE ! 6096: * ! 6097: * LOOP TO ENTER CHARACTER CODES IN ORDER ! 6098: * ! 6099: {INI12{SCH{R7{(R9)+{{STORE NEXT CODE ! 6100: {{ICV{R7{{{BUMP CODE VALUE ! 6101: {{BCT{R8{INI12{{LOOP TILL ALL STORED ! 6102: {{CSC{R9{{{COMPLETE STORE CHARACTERS ! 6103: * ! 6104: * INITIALIZE VARIABLE BLOCKS FOR INPUT AND OUTPUT ! 6105: * ! 6106: {{MOV{#V$INP{R10{{POINT TO STRING /INPUT/ ! 6107: {{MOV{#TRTIN{R7{{TRBLK TYPE FOR INPUT ! 6108: {{JSR{INOUT{{{PERFORM INPUT ASSOCIATION ! 6109: {{MOV{#V$OUP{R10{{POINT TO STRING /OUTPUT/ ! 6110: {{MOV{#TRTOU{R7{{TRBLK TYPE FOR OUTPUT ! 6111: {{JSR{INOUT{{{PERFORM OUTPUT ASSOCIATION ! 6112: {{MOV{INITR{R8{{TERMINAL FLAG ! 6113: {{BZE{R8{INI13{{SKIP IF NO TERMINAL ! 6114: {{JSR{PRPAR{{{ASSOCIATE TERMINAL ! 6115: {{EJC{{{{ ! 6116: * ! 6117: * CHECK FOR EXPIRY DATE ! 6118: * ! 6119: {INI13{JSR{SYSDC{{{CALL DATE CHECK ! 6120: {{MOV{SP{FLPTR{{IN CASE STACK OVERFLOWS IN COMPILER ! 6121: * ! 6122: * NOW COMPILE SOURCE INPUT CODE ! 6123: * ! 6124: {{JSR{CMPIL{{{CALL COMPILER ! 6125: {{MOV{R9{R$COD{{SET PTR TO FIRST CODE BLOCK ! 6126: {{MOV{#NULLS{R$TTL{{FORGET TITLE (REG04) ! 6127: {{MOV{#NULLS{R$STL{{FORGET SUB-TITLE (REG04) ! 6128: {{ZER{R$CIM{{{FORGET COMPILER INPUT IMAGE ! 6129: {{ZER{R10{{{CLEAR DUD VALUE ! 6130: {{ZER{R7{{{DONT SHIFT DYNAMIC STORE UP ! 6131: {{JSR{GBCOL{{{CLEAR GARBAGE LEFT FROM COMPILE ! 6132: {{BNZ{CPSTS{INIX0{{SKIP IF NO LISTING OF COMP STATS ! 6133: {{JSR{PRTPG{{{EJECT PAGE ! 6134: * ! 6135: * PRINT COMPILE STATISTICS ! 6136: * ! 6137: {{MOV{DNAMP{R6{{NEXT AVAILABLE LOC ! 6138: {{SUB{STATB{R6{{MINUS START ! 6139: {{BTW{R6{{{CONVERT TO WORDS ! 6140: {{MTI{R6{{{CONVERT TO INTEGER ! 6141: {{MOV{#ENCM1{R9{{POINT TO /MEMORY USED (WORDS)/ ! 6142: {{JSR{PRTMI{{{PRINT MESSAGE ! 6143: {{MOV{DNAME{R6{{END OF MEMORY ! 6144: {{SUB{DNAMP{R6{{MINUS NEXT AVAILABLE LOC ! 6145: {{BTW{R6{{{CONVERT TO WORDS ! 6146: {{MTI{R6{{{CONVERT TO INTEGER ! 6147: {{MOV{#ENCM2{R9{{POINT TO /MEMORY AVAILABLE (WORDS)/ ! 6148: {{JSR{PRTMI{{{PRINT LINE ! 6149: {{MTI{CMERC{{{GET COUNT OF ERRORS AS INTEGER ! 6150: {{MOV{#ENCM3{R9{{POINT TO /COMPILE ERRORS/ ! 6151: {{JSR{PRTMI{{{PRINT IT ! 6152: {{MTI{GBCNT{{{GARBAGE COLLECTION COUNT ! 6153: {{SBI{INTV1{{{ADJUST FOR UNAVOIDABLE COLLECT ! 6154: {{MOV{#STPM5{R9{{POINT TO /STORAGE REGENERATIONS/ ! 6155: {{JSR{PRTMI{{{PRINT GBCOL COUNT ! 6156: {{JSR{SYSTM{{{GET TIME ! 6157: {{SBI{TIMSX{{{GET COMPILATION TIME ! 6158: {{MOV{#ENCM4{R9{{POINT TO COMPILATION TIME (MSEC)/ ! 6159: {{JSR{PRTMI{{{PRINT MESSAGE ! 6160: {{ADD{#NUM05{LSTLC{{BUMP LINE COUNT ! 6161: {{BZE{HEADP{INIX0{{NO EJECT IF NOTHING PRINTED (SDG11) ! 6162: {{JSR{PRTPG{{{EJECT PRINTER ! 6163: {{EJC{{{{ ! 6164: * ! 6165: * PREPARE NOW TO START EXECUTION ! 6166: * ! 6167: * SET DEFAULT INPUT RECORD LENGTH ! 6168: * ! 6169: {INIX0{BGT{CSWIN{#INILN{INIX1{SKIP IF NOT DEFAULT -IN72 USED ! 6170: {{MOV{#INILS{CSWIN{{ELSE USE DEFAULT RECORD LENGTH ! 6171: * ! 6172: * RESET TIMER ! 6173: * ! 6174: {INIX1{JSR{SYSTM{{{GET TIME AGAIN ! 6175: {{STI{TIMSX{{{STORE FOR END RUN PROCESSING ! 6176: {{ADD{CSWEX{NOXEQ{{ADD -NOEXECUTE FLAG ! 6177: {{BNZ{NOXEQ{INIX2{{JUMP IF EXECUTION SUPPRESSED ! 6178: {{ZER{GBCNT{{{INITIALISE COLLECT COUNT ! 6179: {{JSR{SYSBX{{{CALL BEFORE STARTING EXECUTION ! 6180: * ! 6181: * MERGE WHEN LISTING FILE SET FOR EXECUTION ! 6182: * ! 6183: {INIY0{MNZ{HEADP{{{MARK HEADERS OUT REGARDLESS ! 6184: {{ZER{-(SP){{{SET FAILURE LOCATION ON STACK ! 6185: {{MOV{SP{FLPTR{{SAVE PTR TO FAILURE OFFSET WORD ! 6186: {{MOV{R$COD{R9{{LOAD PTR TO ENTRY CODE BLOCK ! 6187: {{MOV{#STGXT{STAGE{{SET STAGE FOR EXECUTE TIME ! 6188: {{MOV{CMPSN{PFNTE{{COPY STMTS COMPILED COUNT IN CASE ! 6189: {{JSR{SYSTM{{{TIME YET AGAIN ! 6190: {{STI{PFSTM{{{ ! 6191: {{BRI{(R9){{{START XEQ WITH FIRST STATEMENT ! 6192: * ! 6193: * HERE IF EXECUTION IS SUPPRESSED ! 6194: * ! 6195: {INIX2{JSR{PRTNL{{{PRINT A BLANK LINE ! 6196: {{MOV{#ENCM5{R9{{POINT TO /EXECUTION SUPPRESSED/ ! 6197: {{JSR{PRTST{{{PRINT STRING ! 6198: {{JSR{PRTNL{{{OUTPUT LINE ! 6199: {{ZER{R6{{{SET ABEND VALUE TO ZERO ! 6200: {{MOV{#NINI9{R7{{SET SPECIAL CODE VALUE ! 6201: {{JSR{SYSEJ{{{END OF JOB, EXIT TO SYSTEM ! 6202: {{TTL{S{{{P I T B O L -- SNOBOL4 OPERATOR ROUTINES ! 6203: * ! 6204: * THIS SECTION INCLUDES ALL ROUTINES WHICH CAN BE ACCESSED ! 6205: * DIRECTLY FROM THE GENERATED CODE EXCEPT SYSTEM FUNCTIONS. ! 6206: * ! 6207: * ALL ROUTINES IN THIS SECTION START WITH A LABEL OF THE ! 6208: * FORM O$XXX WHERE XXX IS THREE LETTERS. THE GENERATED CODE ! 6209: * CONTAINS A POINTER TO THE APPROPRIATE ENTRY LABEL. ! 6210: * ! 6211: * SINCE THE GENERAL FORM OF THE GENERATED CODE CONSISTS OF ! 6212: * POINTERS TO BLOCKS WHOSE FIRST WORD IS THE ADDRESS OF THE ! 6213: * ACTUAL ENTRY POINT LABEL (O$XXX). ! 6214: * ! 6215: * THESE ROUTINES ARE IN ALPHABETICAL ORDER BY THEIR ! 6216: * ENTRY LABEL NAMES (I.E. BY THE XXX OF THE O$XXX NAME) ! 6217: * ! 6218: * THESE ROUTINES RECEIVE CONTROL AS FOLLOWS ! 6219: * ! 6220: * (CP) POINTER TO NEXT CODE WORD ! 6221: * (XS) CURRENT STACK POINTER ! 6222: {{EJC{{{{ ! 6223: * ! 6224: * BINARY PLUS (ADDITION) ! 6225: * ! 6226: {O$ADD{ENT{{{{ENTRY POINT ! 6227: {{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS ! 6228: {{ERR{001{ADDITION{{LEFT OPERAND IS NOT NUMERIC ! 6229: {{ERR{002{ADDITION{{RIGHT OPERAND IS NOT NUMERIC ! 6230: {{PPM{OADD1{{{JUMP IF REAL OPERANDS ! 6231: * ! 6232: * HERE TO ADD TWO INTEGERS ! 6233: * ! 6234: {{ADI{4*ICVAL(R10){{{ADD RIGHT OPERAND TO LEFT ! 6235: {{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW ! 6236: {{ERB{003{ADDITION{{CAUSED INTEGER OVERFLOW ! 6237: * ! 6238: * HERE TO ADD TWO REALS ! 6239: * ! 6240: {OADD1{ADR{4*RCVAL(R10){{{ADD RIGHT OPERAND TO LEFT ! 6241: {{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW ! 6242: {{ERB{261{ADDITION{{CAUSED REAL OVERFLOW ! 6243: {{EJC{{{{ ! 6244: * ! 6245: * UNARY PLUS (AFFIRMATION) ! 6246: * ! 6247: {O$AFF{ENT{{{{ENTRY POINT ! 6248: {{MOV{(SP)+{R9{{LOAD OPERAND ! 6249: {{JSR{GTNUM{{{CONVERT TO NUMERIC ! 6250: {{ERR{004{AFFIRMATION{{OPERAND IS NOT NUMERIC ! 6251: {{BRN{EXIXR{{{RETURN IF CONVERTED TO NUMERIC ! 6252: {{EJC{{{{ ! 6253: * ! 6254: * BINARY BAR (ALTERNATION) ! 6255: * ! 6256: {O$ALT{ENT{{{{ENTRY POINT ! 6257: {{MOV{(SP)+{R9{{LOAD RIGHT OPERAND ! 6258: {{JSR{GTPAT{{{CONVERT TO PATTERN ! 6259: {{ERR{005{ALTERNATION{{RIGHT OPERAND IS NOT PATTERN ! 6260: * ! 6261: * MERGE HERE FROM SPECIAL (LEFT ALTERNATION) CASE ! 6262: * ! 6263: {OALT1{MOV{#P$ALT{R7{{SET PCODE FOR ALTERNATIVE NODE ! 6264: {{JSR{PBILD{{{BUILD ALTERNATIVE NODE ! 6265: {{MOV{R9{R10{{SAVE ADDRESS OF ALTERNATIVE NODE ! 6266: {{MOV{(SP)+{R9{{LOAD LEFT OPERAND ! 6267: {{JSR{GTPAT{{{CONVERT TO PATTERN ! 6268: {{ERR{006{ALTERNATION{{LEFT OPERAND IS NOT PATTERN ! 6269: {{BEQ{R9{#P$ALT{OALT2{JUMP IF LEFT ARG IS ALTERNATION ! 6270: {{MOV{R9{4*PTHEN(R10){{SET LEFT OPERAND AS SUCCESSOR ! 6271: {{MOV{R10{R9{{MOVE RESULT TO PROPER REGISTER ! 6272: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD ! 6273: * ! 6274: * COME HERE IF LEFT ARGUMENT IS ITSELF AN ALTERNATION ! 6275: * ! 6276: * THE RESULT IS MORE EFFICIENT IF WE MAKE THE REPLACEMENT ! 6277: * ! 6278: * (A / B) / C = A / (B / C) ! 6279: * ! 6280: {OALT2{MOV{4*PARM1(R9){4*PTHEN(R10){{BUILD THE (B / C) NODE ! 6281: {{MOV{4*PTHEN(R9){-(SP){{SET A AS NEW LEFT ARG ! 6282: {{MOV{R10{R9{{SET (B / C) AS NEW RIGHT ARG ! 6283: {{BRN{OALT1{{{MERGE BACK TO BUILD A / (B / C) ! 6284: {{EJC{{{{ ! 6285: * ! 6286: * ARRAY REFERENCE (MULTIPLE SUBSCRIPTS, BY NAME) ! 6287: * ! 6288: {O$AMN{ENT{{{{ENTRY POINT ! 6289: {{LCW{R9{{{LOAD NUMBER OF SUBSCRIPTS ! 6290: {{MOV{R9{R7{{SET FLAG FOR BY NAME ! 6291: {{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE ! 6292: {{EJC{{{{ ! 6293: * ! 6294: * ARRAY REFERENCE (MULTIPLE SUBSCRIPTS, BY VALUE) ! 6295: * ! 6296: {O$AMV{ENT{{{{ENTRY POINT ! 6297: {{LCW{R9{{{LOAD NUMBER OF SUBSCRIPTS ! 6298: {{ZER{R7{{{SET FLAG FOR BY VALUE ! 6299: {{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE ! 6300: {{EJC{{{{ ! 6301: * ! 6302: * ARRAY REFERENCE (ONE SUBSCRIPT, BY NAME) ! 6303: * ! 6304: {O$AON{ENT{{{{ENTRY POINT ! 6305: {{MOV{(SP){R9{{LOAD SUBSCRIPT VALUE ! 6306: {{MOV{4*1(SP){R10{{LOAD ARRAY VALUE ! 6307: {{MOV{(R10){R6{{LOAD FIRST WORD OF ARRAY OPERAND ! 6308: {{BEQ{R6{#B$VCT{OAON2{JUMP IF VECTOR REFERENCE ! 6309: {{BEQ{R6{#B$TBT{OAON3{JUMP IF TABLE REFERENCE ! 6310: * ! 6311: * HERE TO USE CENTRAL ARRAY REFERENCE ROUTINE ! 6312: * ! 6313: {OAON1{MOV{#NUM01{R9{{SET NUMBER OF SUBSCRIPTS TO ONE ! 6314: {{MOV{R9{R7{{SET FLAG FOR BY NAME ! 6315: {{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE ! 6316: * ! 6317: * HERE IF WE HAVE A VECTOR REFERENCE ! 6318: * ! 6319: {OAON2{BNE{(R9){#B$ICL{OAON1{USE LONG ROUTINE IF NOT INTEGER ! 6320: {{LDI{4*ICVAL(R9){{{LOAD INTEGER SUBSCRIPT VALUE ! 6321: {{MFI{R6{EXFAL{{COPY AS ADDRESS INT, FAIL IF OVFLO ! 6322: {{BZE{R6{EXFAL{{FAIL IF ZERO ! 6323: {{ADD{#VCVLB{R6{{COMPUTE OFFSET IN WORDS ! 6324: {{WTB{R6{{{CONVERT TO BYTES ! 6325: {{MOV{R6{(SP){{COMPLETE NAME ON STACK ! 6326: {{BLT{R6{4*VCLEN(R10){EXITS{EXIT IF SUBSCRIPT NOT TOO LARGE ! 6327: {{BRN{EXFAL{{{ELSE FAIL ! 6328: * ! 6329: * HERE FOR TABLE REFERENCE ! 6330: * ! 6331: {OAON3{MNZ{R7{{{SET FLAG FOR NAME REFERENCE ! 6332: {{JSR{TFIND{{{LOCATE/CREATE TABLE ELEMENT ! 6333: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS ! 6334: {{MOV{R10{4*1(SP){{STORE NAME BASE ON STACK ! 6335: {{MOV{R6{(SP){{STORE NAME OFFSET ON STACK ! 6336: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK ! 6337: {{EJC{{{{ ! 6338: * ! 6339: * ARRAY REFERENCE (ONE SUBSCRIPT, BY VALUE) ! 6340: * ! 6341: {O$AOV{ENT{{{{ENTRY POINT ! 6342: {{MOV{(SP)+{R9{{LOAD SUBSCRIPT VALUE ! 6343: {{MOV{(SP)+{R10{{LOAD ARRAY VALUE ! 6344: {{MOV{(R10){R6{{LOAD FIRST WORD OF ARRAY OPERAND ! 6345: {{BEQ{R6{#B$VCT{OAOV2{JUMP IF VECTOR REFERENCE ! 6346: {{BEQ{R6{#B$TBT{OAOV3{JUMP IF TABLE REFERENCE ! 6347: * ! 6348: * HERE TO USE CENTRAL ARRAY REFERENCE ROUTINE ! 6349: * ! 6350: {OAOV1{MOV{R10{-(SP){{RESTACK ARRAY VALUE ! 6351: {{MOV{R9{-(SP){{RESTACK SUBSCRIPT ! 6352: {{MOV{#NUM01{R9{{SET NUMBER OF SUBSCRIPTS TO ONE ! 6353: {{ZER{R7{{{SET FLAG FOR VALUE CALL ! 6354: {{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE ! 6355: * ! 6356: * HERE IF WE HAVE A VECTOR REFERENCE ! 6357: * ! 6358: {OAOV2{BNE{(R9){#B$ICL{OAOV1{USE LONG ROUTINE IF NOT INTEGER ! 6359: {{LDI{4*ICVAL(R9){{{LOAD INTEGER SUBSCRIPT VALUE ! 6360: {{MFI{R6{EXFAL{{MOVE AS ONE WORD INT, FAIL IF OVFLO ! 6361: {{BZE{R6{EXFAL{{FAIL IF ZERO ! 6362: {{ADD{#VCVLB{R6{{COMPUTE OFFSET IN WORDS ! 6363: {{WTB{R6{{{CONVERT TO BYTES ! 6364: {{BGE{R6{4*VCLEN(R10){EXFAL{FAIL IF SUBSCRIPT TOO LARGE ! 6365: {{JSR{ACESS{{{ACCESS VALUE ! 6366: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS ! 6367: {{BRN{EXIXR{{{ELSE RETURN VALUE TO CALLER ! 6368: * ! 6369: * HERE FOR TABLE REFERENCE BY VALUE ! 6370: * ! 6371: {OAOV3{ZER{R7{{{SET FLAG FOR VALUE REFERENCE ! 6372: {{JSR{TFIND{{{CALL TABLE SEARCH ROUTINE ! 6373: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS ! 6374: {{BRN{EXIXR{{{EXIT WITH RESULT IN XR ! 6375: {{EJC{{{{ ! 6376: * ! 6377: * ASSIGNMENT ! 6378: * ! 6379: {O$ASS{ENT{{{{ENTRY POINT ! 6380: * ! 6381: * O$RPL (PATTERN REPLACEMENT) MERGES HERE ! 6382: * ! 6383: {OASS0{MOV{(SP)+{R7{{LOAD VALUE TO BE ASSIGNED ! 6384: {{MOV{(SP)+{R6{{LOAD NAME OFFSET ! 6385: {{MOV{(SP){R10{{LOAD NAME BASE ! 6386: {{MOV{R7{(SP){{STORE ASSIGNED VALUE AS RESULT ! 6387: {{JSR{ASIGN{{{PERFORM ASSIGNMENT ! 6388: {{PPM{EXFAL{{{FAIL IF ASSIGNMENT FAILS ! 6389: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK ! 6390: {{EJC{{{{ ! 6391: * ! 6392: * COMPILATION ERROR ! 6393: * ! 6394: {O$CER{ENT{{{{ENTRY POINT ! 6395: {{ERB{007{COMPILATION{{ERROR ENCOUNTERED DURING EXECUTION ! 6396: {{EJC{{{{ ! 6397: * ! 6398: * UNARY AT (CURSOR ASSIGNMENT) ! 6399: * ! 6400: {O$CAS{ENT{{{{ENTRY POINT ! 6401: {{MOV{(SP)+{R8{{LOAD NAME OFFSET (PARM2) ! 6402: {{MOV{(SP)+{R9{{LOAD NAME BASE (PARM1) ! 6403: {{MOV{#P$CAS{R7{{SET PCODE FOR CURSOR ASSIGNMENT ! 6404: {{JSR{PBILD{{{BUILD NODE ! 6405: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD ! 6406: {{EJC{{{{ ! 6407: * ! 6408: * CONCATENATION ! 6409: * ! 6410: {O$CNC{ENT{{{{ENTRY POINT ! 6411: {{MOV{(SP){R9{{LOAD RIGHT ARGUMENT ! 6412: {{BEQ{R9{#NULLS{OCNC3{JUMP IF RIGHT ARG IS NULL ! 6413: {{MOV{4*1(SP){R10{{LOAD LEFT ARGUMENT ! 6414: {{BEQ{R10{#NULLS{OCNC4{JUMP IF LEFT ARGUMENT IS NULL ! 6415: {{MOV{#B$SCL{R6{{GET CONSTANT TO TEST FOR STRING ! 6416: {{BNE{R6{(R10){OCNC2{JUMP IF LEFT ARG NOT A STRING ! 6417: {{BNE{R6{(R9){OCNC2{JUMP IF RIGHT ARG NOT A STRING ! 6418: * ! 6419: * MERGE HERE TO CONCATENATE TWO STRINGS ! 6420: * ! 6421: {OCNC1{MOV{4*SCLEN(R10){R6{{LOAD LEFT ARGUMENT LENGTH ! 6422: {{ADD{4*SCLEN(R9){R6{{COMPUTE RESULT LENGTH ! 6423: {{JSR{ALOCS{{{ALLOCATE SCBLK FOR RESULT ! 6424: {{MOV{R9{4*1(SP){{STORE RESULT PTR OVER LEFT ARGUMENT ! 6425: {{PSC{R9{{{PREPARE TO STORE CHARS OF RESULT ! 6426: {{MOV{4*SCLEN(R10){R6{{GET NUMBER OF CHARS IN LEFT ARG ! 6427: {{PLC{R10{{{PREPARE TO LOAD LEFT ARG CHARS ! 6428: {{MVC{{{{MOVE CHARACTERS OF LEFT ARGUMENT ! 6429: {{MOV{(SP)+{R10{{LOAD RIGHT ARG POINTER, POP STACK ! 6430: {{MOV{4*SCLEN(R10){R6{{LOAD NUMBER OF CHARS IN RIGHT ARG ! 6431: {{PLC{R10{{{PREPARE TO LOAD RIGHT ARG CHARS ! 6432: {{MVC{{{{MOVE CHARACTERS OF RIGHT ARGUMENT ! 6433: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK ! 6434: * ! 6435: * COME HERE IF ARGUMENTS ARE NOT BOTH STRINGS ! 6436: * ! 6437: {OCNC2{JSR{GTSTG{{{CONVERT RIGHT ARG TO STRING ! 6438: {{PPM{OCNC5{{{JUMP IF RIGHT ARG IS NOT STRING ! 6439: {{MOV{R9{R10{{SAVE RIGHT ARG PTR ! 6440: {{JSR{GTSTG{{{CONVERT LEFT ARG TO STRING ! 6441: {{PPM{OCNC6{{{JUMP IF LEFT ARG IS NOT A STRING ! 6442: {{MOV{R9{-(SP){{STACK LEFT ARGUMENT ! 6443: {{MOV{R10{-(SP){{STACK RIGHT ARGUMENT ! 6444: {{MOV{R9{R10{{MOVE LEFT ARG TO PROPER REG ! 6445: {{MOV{(SP){R9{{MOVE RIGHT ARG TO PROPER REG ! 6446: {{BRN{OCNC1{{{MERGE BACK TO CONCATENATE STRINGS ! 6447: {{EJC{{{{ ! 6448: * ! 6449: * CONCATENATION (CONTINUED) ! 6450: * ! 6451: * COME HERE FOR NULL RIGHT ARGUMENT ! 6452: * ! 6453: {OCNC3{ICA{SP{{{REMOVE RIGHT ARG FROM STACK ! 6454: {{BRN{EXITS{{{RETURN WITH LEFT ARGUMENT ON STACK ! 6455: * ! 6456: * HERE FOR NULL LEFT ARGUMENT ! 6457: * ! 6458: {OCNC4{ICA{SP{{{UNSTACK ONE ARGUMENT ! 6459: {{MOV{R9{(SP){{STORE RIGHT ARGUMENT ! 6460: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK ! 6461: * ! 6462: * HERE IF RIGHT ARGUMENT IS NOT A STRING ! 6463: * ! 6464: {OCNC5{MOV{R9{R10{{MOVE RIGHT ARGUMENT PTR ! 6465: {{MOV{(SP)+{R9{{LOAD LEFT ARG POINTER ! 6466: * ! 6467: * MERGE HERE WHEN LEFT ARGUMENT IS NOT A STRING ! 6468: * ! 6469: {OCNC6{JSR{GTPAT{{{CONVERT LEFT ARG TO PATTERN ! 6470: {{ERR{008{CONCATENATION{{LEFT OPND IS NOT STRING OR PATTERN ! 6471: {{MOV{R9{-(SP){{SAVE RESULT ON STACK ! 6472: {{MOV{R10{R9{{POINT TO RIGHT OPERAND ! 6473: {{JSR{GTPAT{{{CONVERT TO PATTERN ! 6474: {{ERR{009{CONCATENATION{{RIGHT OPD IS NOT STRING OR PATTERN ! 6475: {{MOV{R9{R10{{MOVE FOR PCONC ! 6476: {{MOV{(SP)+{R9{{RELOAD LEFT OPERAND PTR ! 6477: {{JSR{PCONC{{{CONCATENATE PATTERNS ! 6478: {{BRN{EXIXR{{{EXIT WITH RESULT IN XR ! 6479: {{EJC{{{{ ! 6480: * ! 6481: * COMPLEMENTATION ! 6482: * ! 6483: {O$COM{ENT{{{{ENTRY POINT ! 6484: {{MOV{(SP)+{R9{{LOAD OPERAND ! 6485: {{MOV{(R9){R6{{LOAD TYPE WORD ! 6486: * ! 6487: * MERGE BACK HERE AFTER CONVERSION ! 6488: * ! 6489: {OCOM1{BEQ{R6{#B$ICL{OCOM2{JUMP IF INTEGER ! 6490: {{BEQ{R6{#B$RCL{OCOM3{JUMP IF REAL ! 6491: {{JSR{GTNUM{{{ELSE CONVERT TO NUMERIC ! 6492: {{ERR{010{COMPLEMENTATION{{OPERAND IS NOT NUMERIC ! 6493: {{BRN{OCOM1{{{BACK TO CHECK CASES ! 6494: * ! 6495: * HERE TO COMPLEMENT INTEGER ! 6496: * ! 6497: {OCOM2{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE ! 6498: {{NGI{{{{NEGATE ! 6499: {{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW ! 6500: {{ERB{011{COMPLEMENTATION{{CAUSED INTEGER OVERFLOW ! 6501: * ! 6502: * HERE TO COMPLEMENT REAL ! 6503: * ! 6504: {OCOM3{LDR{4*RCVAL(R9){{{LOAD REAL VALUE ! 6505: {{NGR{{{{NEGATE ! 6506: {{BRN{EXREA{{{RETURN REAL RESULT ! 6507: {{EJC{{{{ ! 6508: * ! 6509: * BINARY SLASH (DIVISION) ! 6510: * ! 6511: {O$DVD{ENT{{{{ENTRY POINT ! 6512: {{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS ! 6513: {{ERR{012{DIVISION{{LEFT OPERAND IS NOT NUMERIC ! 6514: {{ERR{013{DIVISION{{RIGHT OPERAND IS NOT NUMERIC ! 6515: {{PPM{ODVD2{{{JUMP IF REAL OPERANDS ! 6516: * ! 6517: * HERE TO DIVIDE TWO INTEGERS ! 6518: * ! 6519: {{DVI{4*ICVAL(R10){{{DIVIDE LEFT OPERAND BY RIGHT ! 6520: {{INO{EXINT{{{RESULT OK IF NO OVERFLOW ! 6521: {{ERB{014{DIVISION{{CAUSED INTEGER OVERFLOW ! 6522: * ! 6523: * HERE TO DIVIDE TWO REALS ! 6524: * ! 6525: {ODVD2{DVR{4*RCVAL(R10){{{DIVIDE LEFT OPERAND BY RIGHT ! 6526: {{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW ! 6527: {{ERB{262{DIVISION{{CAUSED REAL OVERFLOW ! 6528: {{EJC{{{{ ! 6529: * ! 6530: * EXPONENTIATION ! 6531: * ! 6532: {O$EXP{ENT{{{{ENTRY POINT ! 6533: {{MOV{(SP)+{R9{{LOAD EXPONENT ! 6534: {{JSR{GTNUM{{{CONVERT TO NUMBER ! 6535: {{ERR{015{EXPONENTIATION{{RIGHT OPERAND IS NOT NUMERIC ! 6536: {{BNE{R6{#B$ICL{OEXP7{JUMP IF REAL ! 6537: {{MOV{R9{R10{{MOVE EXPONENT ! 6538: {{MOV{(SP)+{R9{{LOAD BASE ! 6539: {{JSR{GTNUM{{{CONVERT TO NUMERIC ! 6540: {{ERR{016{EXPONENTIATION{{LEFT OPERAND IS NOT NUMERIC ! 6541: {{LDI{4*ICVAL(R10){{{LOAD EXPONENT ! 6542: {{ILT{OEXP8{{{ERROR IF NEGATIVE EXPONENT ! 6543: {{BEQ{R6{#B$RCL{OEXP3{JUMP IF BASE IS REAL ! 6544: * ! 6545: * HERE TO EXPONENTIATE AN INTEGER ! 6546: * ! 6547: {{MFI{R6{OEXP2{{CONVERT EXPONENT TO 1 WORD INTEGER ! 6548: {{LCT{R6{R6{{SET LOOP COUNTER ! 6549: {{LDI{INTV1{{{LOAD INITIAL VALUE OF 1 ! 6550: {{BNZ{R6{OEXP1{{JUMP IF NON-ZERO EXPONENT ! 6551: {{INE{EXINT{{{GIVE ZERO AS RESULT FOR NONZERO**0 ! 6552: {{BRN{OEXP4{{{ELSE ERROR OF 0**0 ! 6553: * ! 6554: * LOOP TO PERFORM EXPONENTIATION ! 6555: * ! 6556: {OEXP1{MLI{4*ICVAL(R9){{{MULTIPLY BY BASE ! 6557: {{IOV{OEXP2{{{JUMP IF OVERFLOW ! 6558: {{BCT{R6{OEXP1{{LOOP BACK TILL COMPUTATION COMPLETE ! 6559: {{BRN{EXINT{{{THEN RETURN INTEGER RESULT ! 6560: * ! 6561: * HERE IF INTEGER OVERFLOW ! 6562: * ! 6563: {OEXP2{ERB{017{EXPONENTIATION{{CAUSED INTEGER OVERFLOW ! 6564: {{EJC{{{{ ! 6565: * ! 6566: * EXPONENTIATION (CONTINUED) ! 6567: * ! 6568: * HERE TO EXPONENTIATE A REAL ! 6569: * ! 6570: {OEXP3{MFI{R6{OEXP6{{CONVERT EXPONENT TO ONE WORD ! 6571: {{LCT{R6{R6{{SET LOOP COUNTER ! 6572: {{LDR{REAV1{{{LOAD 1.0 AS INITIAL VALUE ! 6573: {{BNZ{R6{OEXP5{{JUMP IF NON-ZERO EXPONENT ! 6574: {{RNE{EXREA{{{RETURN 1.0 IF NONZERO**ZERO ! 6575: * ! 6576: * HERE FOR ERROR OF 0**0 OR 0.0**0 ! 6577: * ! 6578: {OEXP4{ERB{018{EXPONENTIATION{{RESULT IS UNDEFINED ! 6579: * ! 6580: * LOOP TO PERFORM EXPONENTIATION ! 6581: * ! 6582: {OEXP5{MLR{4*RCVAL(R9){{{MULTIPLY BY BASE ! 6583: {{ROV{OEXP6{{{JUMP IF OVERFLOW ! 6584: {{BCT{R6{OEXP5{{LOOP TILL COMPUTATION COMPLETE ! 6585: {{BRN{EXREA{{{THEN RETURN REAL RESULT ! 6586: * ! 6587: * HERE IF REAL OVERFLOW ! 6588: * ! 6589: {OEXP6{ERB{266{EXPONENTIATION{{CAUSED REAL OVERFLOW ! 6590: * ! 6591: * HERE IF REAL EXPONENT ! 6592: * ! 6593: {OEXP7{ERB{267{EXPONENTIATION{{RIGHT OPERAND IS REAL NOT INTEGER ! 6594: * ! 6595: * HERE FOR NEGATIVE EXPONENT ! 6596: * ! 6597: {OEXP8{ERB{019{EXPONENTIATION{{RIGHT OPERAND IS NEGATIVE ! 6598: {{EJC{{{{ ! 6599: * ! 6600: * FAILURE IN EXPRESSION EVALUATION ! 6601: * ! 6602: * THIS ENTRY POINT IS USED IF THE EVALUATION OF AN ! 6603: * EXPRESSION, INITIATED BY THE EVALX PROCEDURE, FAILS. ! 6604: * CONTROL IS RETURNED TO AN APPROPRIATE POINT IN EVALX. ! 6605: * ! 6606: {O$FEX{ENT{{{{ENTRY POINT ! 6607: {{BRN{EVLX6{{{JUMP TO FAILURE LOC IN EVALX ! 6608: {{EJC{{{{ ! 6609: * ! 6610: * FAILURE DURING EVALUATION OF A COMPLEX OR DIRECT GOTO ! 6611: * ! 6612: {O$FIF{ENT{{{{ENTRY POINT ! 6613: {{ERB{020{GOTO{{EVALUATION FAILURE ! 6614: {{EJC{{{{ ! 6615: * ! 6616: * FUNCTION CALL (MORE THAN ONE ARGUMENT) ! 6617: * ! 6618: {O$FNC{ENT{{{{ENTRY POINT ! 6619: {{LCW{R6{{{LOAD NUMBER OF ARGUMENTS ! 6620: {{LCW{R9{{{LOAD FUNCTION VRBLK POINTER ! 6621: {{MOV{4*VRFNC(R9){R10{{LOAD FUNCTION POINTER ! 6622: {{BNE{R6{4*FARGS(R10){CFUNC{USE CENTRAL ROUTINE IF WRONG NUM ! 6623: {{BRI{(R10){{{JUMP TO FUNCTION IF ARG COUNT OK ! 6624: {{EJC{{{{ ! 6625: * ! 6626: * FUNCTION NAME ERROR ! 6627: * ! 6628: {O$FNE{ENT{{{{ENTRY POINT ! 6629: {{LCW{R6{{{GET NEXT CODE WORD ! 6630: {{BNE{R6{#ORNM${OFNE1{FAIL IF NOT EVALUATING EXPRESSION ! 6631: {{BZE{4*2(SP){EVLX3{{OK IF EXPR. WAS WANTED BY VALUE ! 6632: * ! 6633: * HERE FOR ERROR ! 6634: * ! 6635: {OFNE1{ERB{021{FUNCTION{{CALLED BY NAME RETURNED A VALUE ! 6636: {{EJC{{{{ ! 6637: * ! 6638: * FUNCTION CALL (SINGLE ARGUMENT) ! 6639: * ! 6640: {O$FNS{ENT{{{{ENTRY POINT ! 6641: {{LCW{R9{{{LOAD FUNCTION VRBLK POINTER ! 6642: {{MOV{#NUM01{R6{{SET NUMBER OF ARGUMENTS TO ONE ! 6643: {{MOV{4*VRFNC(R9){R10{{LOAD FUNCTION POINTER ! 6644: {{BNE{R6{4*FARGS(R10){CFUNC{USE CENTRAL ROUTINE IF WRONG NUM ! 6645: {{BRI{(R10){{{JUMP TO FUNCTION IF ARG COUNT OK ! 6646: {{EJC{{{{ ! 6647: * CALL TO UNDEFINED FUNCTION ! 6648: * ! 6649: {O$FUN{ENT{{{{ENTRY POINT ! 6650: {{ERB{022{UNDEFINED{{FUNCTION CALLED ! 6651: {{EJC{{{{ ! 6652: * ! 6653: * EXECUTE COMPLEX GOTO ! 6654: * ! 6655: {O$GOC{ENT{{{{ENTRY POINT ! 6656: {{MOV{4*1(SP){R9{{LOAD NAME BASE POINTER ! 6657: {{BHI{R9{STATE{OGOC1{JUMP IF NOT NATURAL VARIABLE ! 6658: {{ADD{#4*VRTRA{R9{{ELSE POINT TO VRTRA FIELD ! 6659: {{BRI{(R9){{{AND JUMP THROUGH IT ! 6660: * ! 6661: * HERE IF GOTO OPERAND IS NOT NATURAL VARIABLE ! 6662: * ! 6663: {OGOC1{ERB{023{GOTO{{OPERAND IS NOT A NATURAL VARIABLE ! 6664: {{EJC{{{{ ! 6665: * ! 6666: * EXECUTE DIRECT GOTO ! 6667: * ! 6668: {O$GOD{ENT{{{{ENTRY POINT ! 6669: {{MOV{(SP){R9{{LOAD OPERAND ! 6670: {{MOV{(R9){R6{{LOAD FIRST WORD ! 6671: {{BEQ{R6{#B$CDS{BCDS0{JUMP IF CODE BLOCK TO CODE ROUTINE ! 6672: {{BEQ{R6{#B$CDC{BCDC0{JUMP IF CODE BLOCK TO CODE ROUTINE ! 6673: {{ERB{024{GOTO{{OPERAND IN DIRECT GOTO IS NOT CODE ! 6674: {{EJC{{{{ ! 6675: * ! 6676: * SET GOTO FAILURE TRAP ! 6677: * ! 6678: * THIS ROUTINE IS EXECUTED AT THE START OF A COMPLEX OR ! 6679: * DIRECT FAILURE GOTO TO TRAP A SUBSEQUENT FAIL (SEE EXFAL) ! 6680: * ! 6681: {O$GOF{ENT{{{{ENTRY POINT ! 6682: {{MOV{FLPTR{R9{{POINT TO FAIL OFFSET ON STACK ! 6683: {{ICA{(R9){{{POINT FAILURE TO O$FIF WORD ! 6684: {{ICP{{{{POINT TO NEXT CODE WORD ! 6685: {{BRN{EXITS{{{EXIT TO CONTINUE ! 6686: {{EJC{{{{ ! 6687: * ! 6688: * BINARY DOLLAR (IMMEDIATE ASSIGNMENT) ! 6689: * ! 6690: * THE PATTERN BUILT BY BINARY DOLLAR IS A COMPOUND PATTERN. ! 6691: * SEE DESCRIPTION AT START OF PATTERN MATCH SECTION FOR ! 6692: * DETAILS OF THE STRUCTURE WHICH IS CONSTRUCTED. ! 6693: * ! 6694: {O$IMA{ENT{{{{ENTRY POINT ! 6695: {{MOV{#P$IMC{R7{{SET PCODE FOR LAST NODE ! 6696: {{MOV{(SP)+{R8{{POP NAME OFFSET (PARM2) ! 6697: {{MOV{(SP)+{R9{{POP NAME BASE (PARM1) ! 6698: {{JSR{PBILD{{{BUILD P$IMC NODE ! 6699: {{MOV{R9{R10{{SAVE PTR TO NODE ! 6700: {{MOV{(SP){R9{{LOAD LEFT ARGUMENT ! 6701: {{JSR{GTPAT{{{CONVERT TO PATTERN ! 6702: {{ERR{025{IMMEDIATE{{ASSIGNMENT LEFT OPERAND IS NOT PATTERN ! 6703: {{MOV{R9{(SP){{SAVE PTR TO LEFT OPERAND PATTERN ! 6704: {{MOV{#P$IMA{R7{{SET PCODE FOR FIRST NODE ! 6705: {{JSR{PBILD{{{BUILD P$IMA NODE ! 6706: {{MOV{(SP)+{4*PTHEN(R9){{SET LEFT OPERAND AS P$IMA SUCCESSOR ! 6707: {{JSR{PCONC{{{CONCATENATE TO FORM FINAL PATTERN ! 6708: {{BRN{EXIXR{{{ALL DONE ! 6709: {{EJC{{{{ ! 6710: * ! 6711: * INDIRECTION (BY NAME) ! 6712: * ! 6713: {O$INN{ENT{{{{ENTRY POINT ! 6714: {{MNZ{R7{{{SET FLAG FOR RESULT BY NAME ! 6715: {{BRN{INDIR{{{JUMP TO COMMON ROUTINE ! 6716: {{EJC{{{{ ! 6717: * ! 6718: * INTERROGATION ! 6719: * ! 6720: {O$INT{ENT{{{{ENTRY POINT ! 6721: {{MOV{#NULLS{(SP){{REPLACE OPERAND WITH NULL ! 6722: {{BRN{EXITS{{{EXIT FOR NEXT CODE WORD ! 6723: {{EJC{{{{ ! 6724: * ! 6725: * INDIRECTION (BY VALUE) ! 6726: * ! 6727: {O$INV{ENT{{{{ENTRY POINT ! 6728: {{ZER{R7{{{SET FLAG FOR BY VALUE ! 6729: {{BRN{INDIR{{{JUMP TO COMMON ROUTINE ! 6730: {{EJC{{{{ ! 6731: * ! 6732: * KEYWORD REFERENCE (BY NAME) ! 6733: * ! 6734: {O$KWN{ENT{{{{ENTRY POINT ! 6735: {{JSR{KWNAM{{{GET KEYWORD NAME ! 6736: {{BRN{EXNAM{{{EXIT WITH RESULT NAME ! 6737: {{EJC{{{{ ! 6738: * ! 6739: * KEYWORD REFERENCE (BY VALUE) ! 6740: * ! 6741: {O$KWV{ENT{{{{ENTRY POINT ! 6742: {{JSR{KWNAM{{{GET KEYWORD NAME ! 6743: {{MOV{R9{DNAMP{{DELETE KVBLK ! 6744: {{JSR{ACESS{{{ACCESS VALUE ! 6745: {{PPM{EXNUL{{{DUMMY (UNUSED) FAILURE RETURN ! 6746: {{BRN{EXIXR{{{JUMP WITH VALUE IN XR ! 6747: {{EJC{{{{ ! 6748: * ! 6749: * LOAD EXPRESSION BY NAME ! 6750: * ! 6751: {O$LEX{ENT{{{{ENTRY POINT ! 6752: {{MOV{#4*EVSI${R6{{SET SIZE OF EVBLK ! 6753: {{JSR{ALLOC{{{ALLOCATE SPACE FOR EVBLK ! 6754: {{MOV{#B$EVT{(R9){{SET TYPE WORD ! 6755: {{MOV{#TRBEV{4*EVVAR(R9){{SET DUMMY TRBLK POINTER ! 6756: {{LCW{R6{{{LOAD EXBLK POINTER ! 6757: {{MOV{R6{4*EVEXP(R9){{SET EXBLK POINTER ! 6758: {{MOV{R9{R10{{MOVE NAME BASE TO PROPER REG ! 6759: {{MOV{#4*EVVAR{R6{{SET NAME OFFSET = ZERO ! 6760: {{BRN{EXNAM{{{EXIT WITH NAME IN (XL,WA) ! 6761: {{EJC{{{{ ! 6762: * ! 6763: * LOAD PATTERN VALUE ! 6764: * ! 6765: {O$LPT{ENT{{{{ENTRY POINT ! 6766: {{LCW{R9{{{LOAD PATTERN POINTER ! 6767: {{BRN{EXIXR{{{STACK PTR AND OBEY NEXT CODE WORD ! 6768: {{EJC{{{{ ! 6769: * ! 6770: * LOAD VARIABLE NAME ! 6771: * ! 6772: {O$LVN{ENT{{{{ENTRY POINT ! 6773: {{LCW{R6{{{LOAD VRBLK POINTER ! 6774: {{MOV{R6{-(SP){{STACK VRBLK PTR (NAME BASE) ! 6775: {{MOV{#4*VRVAL{-(SP){{STACK NAME OFFSET ! 6776: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK ! 6777: {{EJC{{{{ ! 6778: * ! 6779: * BINARY ASTERISK (MULTIPLICATION) ! 6780: * ! 6781: {O$MLT{ENT{{{{ENTRY POINT ! 6782: {{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS ! 6783: {{ERR{026{MULTIPLICATION{{LEFT OPERAND IS NOT NUMERIC ! 6784: {{ERR{027{MULTIPLICATION{{RIGHT OPERAND IS NOT NUMERIC ! 6785: {{PPM{OMLT1{{{JUMP IF REAL OPERANDS ! 6786: * ! 6787: * HERE TO MULTIPLY TWO INTEGERS ! 6788: * ! 6789: {{MLI{4*ICVAL(R10){{{MULTIPLY LEFT OPERAND BY RIGHT ! 6790: {{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW ! 6791: {{ERB{028{MULTIPLICATION{{CAUSED INTEGER OVERFLOW ! 6792: * ! 6793: * HERE TO MULTIPLY TWO REALS ! 6794: * ! 6795: {OMLT1{MLR{4*RCVAL(R10){{{MULTIPLY LEFT OPERAND BY RIGHT ! 6796: {{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW ! 6797: {{ERB{263{MULTIPLICATION{{CAUSED REAL OVERFLOW ! 6798: {{EJC{{{{ ! 6799: * ! 6800: * NAME REFERENCE ! 6801: * ! 6802: {O$NAM{ENT{{{{ENTRY POINT ! 6803: {{MOV{#4*NMSI${R6{{SET LENGTH OF NMBLK ! 6804: {{JSR{ALLOC{{{ALLOCATE NMBLK ! 6805: {{MOV{#B$NML{(R9){{SET NAME BLOCK CODE ! 6806: {{MOV{(SP)+{4*NMOFS(R9){{SET NAME OFFSET FROM OPERAND ! 6807: {{MOV{(SP)+{4*NMBAS(R9){{SET NAME BASE FROM OPERAND ! 6808: {{BRN{EXIXR{{{EXIT WITH RESULT IN XR ! 6809: {{EJC{{{{ ! 6810: * ! 6811: * NEGATION ! 6812: * ! 6813: * INITIAL ENTRY ! 6814: * ! 6815: {O$NTA{ENT{{{{ENTRY POINT ! 6816: {{LCW{R6{{{LOAD NEW FAILURE OFFSET ! 6817: {{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER ! 6818: {{MOV{R6{-(SP){{STACK NEW FAILURE OFFSET ! 6819: {{MOV{SP{FLPTR{{SET NEW FAILURE POINTER ! 6820: {{BRN{EXITS{{{JUMP TO CONTINUE EXECUTION ! 6821: * ! 6822: * ENTRY AFTER SUCCESSFUL EVALUATION OF OPERAND ! 6823: * ! 6824: {O$NTB{ENT{{{{ENTRY POINT ! 6825: {{MOV{4*2(SP){FLPTR{{RESTORE OLD FAILURE POINTER ! 6826: {{BRN{EXFAL{{{AND FAIL ! 6827: * ! 6828: * ENTRY FOR FAILURE DURING OPERAND EVALUATION ! 6829: * ! 6830: {O$NTC{ENT{{{{ENTRY POINT ! 6831: {{ICA{SP{{{POP FAILURE OFFSET ! 6832: {{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER ! 6833: {{BRN{EXNUL{{{EXIT GIVING NULL RESULT ! 6834: {{EJC{{{{ ! 6835: * ! 6836: * USE OF UNDEFINED OPERATOR ! 6837: * ! 6838: {O$OUN{ENT{{{{ENTRY POINT ! 6839: {{ERB{029{UNDEFINED{{OPERATOR REFERENCED ! 6840: {{EJC{{{{ ! 6841: * ! 6842: * BINARY DOT (PATTERN ASSIGNMENT) ! 6843: * ! 6844: * THE PATTERN BUILT BY BINARY DOT IS A COMPOUND PATTERN. ! 6845: * SEE DESCRIPTION AT START OF PATTERN MATCH SECTION FOR ! 6846: * DETAILS OF THE STRUCTURE WHICH IS CONSTRUCTED. ! 6847: * ! 6848: {O$PAS{ENT{{{{ENTRY POINT ! 6849: {{MOV{#P$PAC{R7{{LOAD PCODE FOR P$PAC NODE ! 6850: {{MOV{(SP)+{R8{{LOAD NAME OFFSET (PARM2) ! 6851: {{MOV{(SP)+{R9{{LOAD NAME BASE (PARM1) ! 6852: {{JSR{PBILD{{{BUILD P$PAC NODE ! 6853: {{MOV{R9{R10{{SAVE PTR TO NODE ! 6854: {{MOV{(SP){R9{{LOAD LEFT OPERAND ! 6855: {{JSR{GTPAT{{{CONVERT TO PATTERN ! 6856: {{ERR{030{PATTERN{{ASSIGNMENT LEFT OPERAND IS NOT PATTERN ! 6857: {{MOV{R9{(SP){{SAVE PTR TO LEFT OPERAND PATTERN ! 6858: {{MOV{#P$PAA{R7{{SET PCODE FOR P$PAA NODE ! 6859: {{JSR{PBILD{{{BUILD P$PAA NODE ! 6860: {{MOV{(SP)+{4*PTHEN(R9){{SET LEFT OPERAND AS P$PAA SUCCESSOR ! 6861: {{JSR{PCONC{{{CONCATENATE TO FORM FINAL PATTERN ! 6862: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD ! 6863: {{EJC{{{{ ! 6864: * ! 6865: * PATTERN MATCH (BY NAME, FOR REPLACEMENT) ! 6866: * ! 6867: {O$PMN{ENT{{{{ENTRY POINT ! 6868: {{ZER{R7{{{SET TYPE CODE FOR MATCH BY NAME ! 6869: {{BRN{MATCH{{{JUMP TO ROUTINE TO START MATCH ! 6870: {{EJC{{{{ ! 6871: * ! 6872: * PATTERN MATCH (STATEMENT) ! 6873: * ! 6874: * O$PMS IS USED IN PLACE OF O$PMV WHEN THE PATTERN MATCH ! 6875: * OCCURS AT THE OUTER (STATEMENT) LEVEL SINCE IN THIS ! 6876: * CASE THE SUBSTRING VALUE NEED NOT BE CONSTRUCTED. ! 6877: * ! 6878: {O$PMS{ENT{{{{ENTRY POINT ! 6879: {{MOV{#NUM02{R7{{SET FLAG FOR STATEMENT TO MATCH ! 6880: {{BRN{MATCH{{{JUMP TO ROUTINE TO START MATCH ! 6881: {{EJC{{{{ ! 6882: * ! 6883: * PATTERN MATCH (BY VALUE) ! 6884: * ! 6885: {O$PMV{ENT{{{{ENTRY POINT ! 6886: {{MOV{#NUM01{R7{{SET TYPE CODE FOR VALUE MATCH ! 6887: {{BRN{MATCH{{{JUMP TO ROUTINE TO START MATCH ! 6888: {{EJC{{{{ ! 6889: * ! 6890: * POP TOP ITEM ON STACK ! 6891: * ! 6892: {O$POP{ENT{{{{ENTRY POINT ! 6893: {{ICA{SP{{{POP TOP STACK ENTRY ! 6894: {{BRN{EXITS{{{OBEY NEXT CODE WORD ! 6895: {{EJC{{{{ ! 6896: * ! 6897: * TERMINATE EXECUTION (CODE COMPILED FOR END STATEMENT) ! 6898: * ! 6899: {O$STP{ENT{{{{ENTRY POINT ! 6900: {{BRN{LEND0{{{JUMP TO END CIRCUIT ! 6901: {{EJC{{{{ ! 6902: * ! 6903: * RETURN NAME FROM EXPRESSION ! 6904: * THIS ENTRY POINTS IS USED IF THE EVALUATION OF AN ! 6905: * EXPRESSION, INITIATED BY THE EVALX PROCEDURE, RETURNS ! 6906: * A NAME. CONTROL IS RETURNED TO THE PROPER POINT IN EVALX. ! 6907: * ! 6908: {O$RNM{ENT{{{{ENTRY POINT ! 6909: {{BRN{EVLX4{{{RETURN TO EVALX PROCEDURE ! 6910: {{EJC{{{{ ! 6911: * ! 6912: * PATTERN REPLACEMENT ! 6913: * ! 6914: * WHEN THIS ROUTINE GETS CONTROL, THE FOLLOWING STACK ! 6915: * ENTRIES HAVE BEEN MADE (SEE END OF MATCH ROUTINE P$NTH) ! 6916: * ! 6917: * SUBJECT NAME BASE ! 6918: * SUBJECT NAME OFFSET ! 6919: * INITIAL CURSOR VALUE ! 6920: * FINAL CURSOR VALUE ! 6921: * SUBJECT POINTER ! 6922: * (XS) ---------------- REPLACEMENT VALUE ! 6923: * ! 6924: {O$RPL{ENT{{{{ENTRY POINT ! 6925: {{JSR{GTSTG{{{CONVERT REPLACEMENT VAL TO STRING ! 6926: {{ERR{031{PATTERN{{REPLACEMENT RIGHT OPERAND IS NOT STRING ! 6927: * ! 6928: * GET RESULT LENGTH AND ALLOCATE RESULT SCBLK ! 6929: * ! 6930: {{MOV{(SP){R10{{LOAD SUBJECT STRING POINTER ! 6931: {{BEQ{(R10){#B$BCT{ORPL4{BRANCH IF BUFFER ASSIGNMENT ! 6932: {{ADD{4*SCLEN(R10){R6{{ADD SUBJECT STRING LENGTH ! 6933: {{ADD{4*2(SP){R6{{ADD STARTING CURSOR ! 6934: {{SUB{4*1(SP){R6{{MINUS FINAL CURSOR = TOTAL LENGTH ! 6935: {{BZE{R6{ORPL3{{JUMP IF RESULT IS NULL ! 6936: {{MOV{R9{-(SP){{RESTACK REPLACEMENT STRING ! 6937: {{JSR{ALOCS{{{ALLOCATE SCBLK FOR RESULT ! 6938: {{MOV{4*3(SP){R6{{GET INITIAL CURSOR (PART 1 LEN) ! 6939: {{MOV{R9{4*3(SP){{STACK RESULT POINTER ! 6940: {{PSC{R9{{{POINT TO CHARACTERS OF RESULT ! 6941: * ! 6942: * MOVE PART 1 (START OF SUBJECT) TO RESULT ! 6943: * ! 6944: {{BZE{R6{ORPL1{{JUMP IF FIRST PART IS NULL ! 6945: {{MOV{4*1(SP){R10{{ELSE POINT TO SUBJECT STRING ! 6946: {{PLC{R10{{{POINT TO SUBJECT STRING CHARS ! 6947: {{MVC{{{{MOVE FIRST PART TO RESULT ! 6948: {{EJC{{{{ ! 6949: * PATTERN REPLACEMENT (CONTINUED) ! 6950: * ! 6951: * NOW MOVE IN REPLACEMENT VALUE ! 6952: * ! 6953: {ORPL1{MOV{(SP)+{R10{{LOAD REPLACEMENT STRING, POP ! 6954: {{MOV{4*SCLEN(R10){R6{{LOAD LENGTH ! 6955: {{BZE{R6{ORPL2{{JUMP IF NULL REPLACEMENT ! 6956: {{PLC{R10{{{ELSE POINT TO CHARS OF REPLACEMENT ! 6957: {{MVC{{{{MOVE IN CHARS (PART 2) ! 6958: * ! 6959: * NOW MOVE IN REMAINDER OF STRING (PART 3) ! 6960: * ! 6961: {ORPL2{MOV{(SP)+{R10{{LOAD SUBJECT STRING POINTER, POP ! 6962: {{MOV{(SP)+{R8{{LOAD FINAL CURSOR, POP ! 6963: {{MOV{4*SCLEN(R10){R6{{LOAD SUBJECT STRING LENGTH ! 6964: {{SUB{R8{R6{{MINUS FINAL CURSOR = PART 3 LENGTH ! 6965: {{BZE{R6{OASS0{{JUMP TO ASSIGN IF PART 3 IS NULL ! 6966: {{PLC{R10{R8{{ELSE POINT TO LAST PART OF STRING ! 6967: {{MVC{{{{MOVE PART 3 TO RESULT ! 6968: {{BRN{OASS0{{{JUMP TO PERFORM ASSIGNMENT ! 6969: * ! 6970: * HERE IF RESULT IS NULL ! 6971: * ! 6972: {ORPL3{ADD{#4*NUM02{SP{{POP SUBJECT STR PTR, FINAL CURSOR ! 6973: {{MOV{#NULLS{(SP){{SET NULL RESULT ! 6974: {{BRN{OASS0{{{JUMP TO ASSIGN NULL VALUE ! 6975: * ! 6976: * HERE FOR BUFFER SUBSTRING ASSIGNMENT ! 6977: * ! 6978: {ORPL4{MOV{R9{R10{{COPY SCBLK REPLACEMENT PTR ! 6979: {{MOV{(SP)+{R9{{UNSTACK BCBLK PTR ! 6980: {{MOV{(SP)+{R7{{GET FINAL CURSOR VALUE ! 6981: {{MOV{(SP)+{R6{{GET INITIAL CURSOR ! 6982: {{SUB{R6{R7{{GET LENGTH IN WB ! 6983: {{ADD{#4*NUM02{SP{{GET RID OF NAME BASE/OFFSET ! 6984: {{JSR{INSBF{{{INSERT SUBSTRING ! 6985: {{PPM{{{{CONVERT FAIL IMPOSSIBLE ! 6986: {{PPM{EXFAL{{{FAIL IF INSERT FAILS ! 6987: {{BRN{EXNUL{{{ELSE NULL RESULT ! 6988: {{EJC{{{{ ! 6989: * ! 6990: * RETURN VALUE FROM EXPRESSION ! 6991: * ! 6992: * THIS ENTRY POINTS IS USED IF THE EVALUATION OF AN ! 6993: * EXPRESSION, INITIATED BY THE EVALX PROCEDURE, RETURNS ! 6994: * A VALUE. CONTROL IS RETURNED TO THE PROPER POINT IN EVALX ! 6995: * ! 6996: {O$RVL{ENT{{{{ENTRY POINT ! 6997: {{BRN{EVLX3{{{RETURN TO EVALX PROCEDURE ! 6998: {{EJC{{{{ ! 6999: * ! 7000: * SELECTION ! 7001: * ! 7002: * INITIAL ENTRY ! 7003: * ! 7004: {O$SLA{ENT{{{{ENTRY POINT ! 7005: {{LCW{R6{{{LOAD NEW FAILURE OFFSET ! 7006: {{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER ! 7007: {{MOV{R6{-(SP){{STACK NEW FAILURE OFFSET ! 7008: {{MOV{SP{FLPTR{{SET NEW FAILURE POINTER ! 7009: {{BRN{EXITS{{{JUMP TO EXECUTE FIRST ALTERNATIVE ! 7010: * ! 7011: * ENTRY AFTER SUCCESSFUL EVALUATION OF ALTERNATIVE ! 7012: * ! 7013: {O$SLB{ENT{{{{ENTRY POINT ! 7014: {{MOV{(SP)+{R9{{LOAD RESULT ! 7015: {{ICA{SP{{{POP FAIL OFFSET ! 7016: {{MOV{(SP){FLPTR{{RESTORE OLD FAILURE POINTER ! 7017: {{MOV{R9{(SP){{RESTACK RESULT ! 7018: {{LCW{R6{{{LOAD NEW CODE OFFSET ! 7019: {{ADD{R$COD{R6{{POINT TO ABSOLUTE CODE LOCATION ! 7020: {{LCP{R6{{{SET NEW CODE POINTER ! 7021: {{BRN{EXITS{{{JUMP TO CONTINUE PAST SELECTION ! 7022: * ! 7023: * ENTRY AT START OF SUBSEQUENT ALTERNATIVES ! 7024: * ! 7025: {O$SLC{ENT{{{{ENTRY POINT ! 7026: {{LCW{R6{{{LOAD NEW FAIL OFFSET ! 7027: {{MOV{R6{(SP){{STORE NEW FAIL OFFSET ! 7028: {{BRN{EXITS{{{JUMP TO EXECUTE NEXT ALTERNATIVE ! 7029: * ! 7030: * ENTRY AT START OF LAST ALTERNATIVE ! 7031: * ! 7032: {O$SLD{ENT{{{{ENTRY POINT ! 7033: {{ICA{SP{{{POP FAILURE OFFSET ! 7034: {{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER ! 7035: {{BRN{EXITS{{{JUMP TO EXECUTE LAST ALTERNATIVE ! 7036: {{EJC{{{{ ! 7037: * ! 7038: * BINARY MINUS (SUBTRACTION) ! 7039: * ! 7040: {O$SUB{ENT{{{{ENTRY POINT ! 7041: {{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS ! 7042: {{ERR{032{SUBTRACTION{{LEFT OPERAND IS NOT NUMERIC ! 7043: {{ERR{033{SUBTRACTION{{RIGHT OPERAND IS NOT NUMERIC ! 7044: {{PPM{OSUB1{{{JUMP IF REAL OPERANDS ! 7045: * ! 7046: * HERE TO SUBTRACT TWO INTEGERS ! 7047: * ! 7048: {{SBI{4*ICVAL(R10){{{SUBTRACT RIGHT OPERAND FROM LEFT ! 7049: {{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW ! 7050: {{ERB{034{SUBTRACTION{{CAUSED INTEGER OVERFLOW ! 7051: * ! 7052: * HERE TO SUBTRACT TWO REALS ! 7053: * ! 7054: {OSUB1{SBR{4*RCVAL(R10){{{SUBTRACT RIGHT OPERAND FROM LEFT ! 7055: {{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW ! 7056: {{ERB{264{SUBTRACTION{{CAUSED REAL OVERFLOW ! 7057: {{EJC{{{{ ! 7058: * ! 7059: * DUMMY OPERATOR TO RETURN CONTROL TO TRXEQ PROCEDURE ! 7060: * ! 7061: {O$TXR{ENT{{{{ENTRY POINT ! 7062: {{BRN{TRXQ1{{{JUMP INTO TRXEQ PROCEDURE ! 7063: {{EJC{{{{ ! 7064: * ! 7065: * UNEXPECTED FAILURE ! 7066: * ! 7067: * NOTE THAT IF A SETEXIT TRAP IS OPERATING THEN ! 7068: * TRANSFER TO SYSTEM LABEL CONTINUE ! 7069: * WILL RESULT IN LOOPING HERE. DIFFICULT TO AVOID EXCEPT ! 7070: * WITH A CONSIDERABLE OVERHEAD WHICH IS NOT WORTHWHILE OR ! 7071: * ELSE BY A TECHNIQUE SUCH AS SETTING KVERL TO ZERO. ! 7072: * ! 7073: {O$UNF{ENT{{{{ENTRY POINT ! 7074: {{ERB{035{UNEXPECTED{{FAILURE IN -NOFAIL MODE ! 7075: {{TTL{S{{{P I T B O L -- SNOBOL4 BUILTIN LABEL ROUTINES ! 7076: * ! 7077: * THE FOLLOWING SECTION CONTAINS THE ROUTINES FOR LABELS ! 7078: * WHICH HAVE A PREDEFINED MEANING IN SNOBOL4. ! 7079: * ! 7080: * CONTROL IS PASSED DIRECTLY TO THE LABEL NAME ENTRY POINT. ! 7081: * ! 7082: * ENTRY NAMES ARE OF THE FORM L$XXX WHERE XXX IS THE THREE ! 7083: * LETTER VARIABLE NAME IDENTIFIER. ! 7084: * ! 7085: * ENTRIES ARE IN ALPHABETICAL ORDER ! 7086: {{EJC{{{{ ! 7087: * ! 7088: * ABORT ! 7089: * ! 7090: {L$ABO{ENT{{{{ENTRY POINT ! 7091: * ! 7092: * MERGE HERE IF EXECUTION TERMINATES IN ERROR ! 7093: * ! 7094: {LABO1{MOV{KVERT{R6{{LOAD ERROR CODE ! 7095: {{BZE{R6{LABO2{{JUMP IF NO ERROR HAS OCCURED ! 7096: {{JSR{SYSAX{{{CALL AFTER EXECUTION PROC (REG04) ! 7097: {{JSR{PRTPG{{{ELSE EJECT PRINTER ! 7098: {{JSR{ERMSG{{{PRINT ERROR MESSAGE ! 7099: {{ZER{R9{{{INDICATE NO MESSAGE TO PRINT ! 7100: {{BRN{STOPR{{{JUMP TO ROUTINE TO STOP RUN ! 7101: * ! 7102: * HERE IF NO ERROR HAD OCCURED ! 7103: * ! 7104: {LABO2{ERB{036{GOTO{{ABORT WITH NO PRECEDING ERROR ! 7105: {{EJC{{{{ ! 7106: * ! 7107: * CONTINUE ! 7108: * ! 7109: {L$CNT{ENT{{{{ENTRY POINT ! 7110: * ! 7111: * MERGE HERE AFTER EXECUTION ERROR ! 7112: * ! 7113: {LCNT1{MOV{R$CNT{R9{{LOAD CONTINUATION CODE BLOCK PTR ! 7114: {{BZE{R9{LCNT2{{JUMP IF NO PREVIOUS ERROR ! 7115: {{ZER{R$CNT{{{CLEAR FLAG ! 7116: {{MOV{R9{R$COD{{ELSE STORE AS NEW CODE BLOCK PTR ! 7117: {{ADD{STXOF{R9{{ADD FAILURE OFFSET ! 7118: {{LCP{R9{{{LOAD CODE POINTER ! 7119: {{MOV{FLPTR{SP{{RESET STACK POINTER ! 7120: {{BRN{EXITS{{{JUMP TO TAKE INDICATED FAILURE ! 7121: * ! 7122: * HERE IF NO PREVIOUS ERROR ! 7123: * ! 7124: {LCNT2{ERB{037{GOTO{{CONTINUE WITH NO PRECEDING ERROR ! 7125: {{EJC{{{{ ! 7126: * ! 7127: * END ! 7128: * ! 7129: {L$END{ENT{{{{ENTRY POINT ! 7130: * ! 7131: * MERGE HERE FROM END CODE CIRCUIT ! 7132: * ! 7133: {LEND0{MOV{#ENDMS{R9{{POINT TO MESSAGE /NORMAL TERM../ ! 7134: {{BRN{STOPR{{{JUMP TO ROUTINE TO STOP RUN ! 7135: {{EJC{{{{ ! 7136: * ! 7137: * FRETURN ! 7138: * ! 7139: {L$FRT{ENT{{{{ENTRY POINT ! 7140: {{MOV{#SCFRT{R6{{POINT TO STRING /FRETURN/ ! 7141: {{BRN{RETRN{{{JUMP TO COMMON RETURN ROUTINE ! 7142: {{EJC{{{{ ! 7143: * ! 7144: * NRETURN ! 7145: * ! 7146: {L$NRT{ENT{{{{ENTRY POINT ! 7147: {{MOV{#SCNRT{R6{{POINT TO STRING /NRETURN/ ! 7148: {{BRN{RETRN{{{JUMP TO COMMON RETURN ROUTINE ! 7149: {{EJC{{{{ ! 7150: * ! 7151: * RETURN ! 7152: * ! 7153: {L$RTN{ENT{{{{ENTRY POINT ! 7154: {{MOV{#SCRTN{R6{{POINT TO STRING /RETURN/ ! 7155: {{BRN{RETRN{{{JUMP TO COMMON RETURN ROUTINE ! 7156: {{EJC{{{{ ! 7157: * ! 7158: * UNDEFINED LABEL ! 7159: * ! 7160: {L$UND{ENT{{{{ENTRY POINT ! 7161: {{ERB{038{GOTO{{UNDEFINED LABEL ! 7162: {{TTL{S{{{P I T B O L -- BLOCK ACTION ROUTINES ! 7163: * ! 7164: * THE FIRST WORD OF EVERY BLOCK IN DYNAMIC STORAGE AND THE ! 7165: * VRGET, VRSTO AND VRTRA FIELDS OF A VRBLK CONTAIN A ! 7166: * POINTER TO AN ENTRY POINT IN THE PROGRAM. ALL SUCH ENTRY ! 7167: * POINTS ARE IN THE FOLLOWING SECTION EXCEPT THOSE FOR ! 7168: * PATTERN BLOCKS WHICH ARE IN THE PATTERN MATCHING SEGMENT ! 7169: * LATER ON (LABELS OF THE FORM P$XXX), AND DOPE VECTORS ! 7170: * (D$XXX) WHICH ARE IN THE DOPE VECTOR SECTION FOLLOWING ! 7171: * THE PATTERN ROUTINES (DOPE VECTORS ARE USED FOR CMBLKS). ! 7172: * ! 7173: * THE ENTRY POINTS IN THIS SECTION HAVE LABELS OF THE ! 7174: * FORM B$XXY WHERE XX IS THE TWO CHARACTER BLOCK TYPE FOR ! 7175: * THE CORRESPONDING BLOCK AND Y IS ANY LETTER. ! 7176: * ! 7177: * IN SOME CASES, THE POINTERS SERVE NO OTHER PURPOSE THAN ! 7178: * TO IDENTIFY THE BLOCK TYPE. IN THIS CASE THE ROUTINE ! 7179: * IS NEVER EXECUTED AND THUS NO CODE IS ASSEMBLED. ! 7180: * ! 7181: * FOR EACH OF THESE ENTRY POINTS CORRESPONDING TO A BLOCK ! 7182: * AN ENTRY POINT IDENTIFICATION IS ASSEMBLED (BL$XX). ! 7183: * ! 7184: * THE EXACT ENTRY CONDITIONS DEPEND ON THE MANNER IN ! 7185: * WHICH THE ROUTINE IS ACCESSED AND ARE DOCUMENTED WITH ! 7186: * THE INDIVIDUAL ROUTINES AS REQUIRED. ! 7187: * ! 7188: * THE ORDER OF THESE ROUTINES IS ALPHABETICAL WITH THE ! 7189: * FOLLOWING EXCEPTIONS. ! 7190: * ! 7191: * THE ROUTINES FOR SEBLK AND EXBLK ENTRIES OCCUR FIRST SO ! 7192: * THAT EXPRESSIONS CAN BE QUICKLY IDENTIFIED FROM THE FACT ! 7193: * THAT THEIR ROUTINES LIE BEFORE THE SYMBOL B$E$$. ! 7194: * ! 7195: * THESE ARE IMMEDIATELY FOLLOWED BY THE ROUTINE FOR A TRBLK ! 7196: * SO THAT THE TEST AGAINST THE SYMBOL B$T$$ CHECKS FOR ! 7197: * TRAPPED VALUES OR EXPRESSION VALUES (SEE PROCEDURE EVALP) ! 7198: * ! 7199: * THE PATTERN ROUTINES LIE AFTER THIS SECTION SO THAT ! 7200: * PATTERNS ARE IDENTIFIED WITH ROUTINES STARTING AT OR ! 7201: * AFTER THE INITIAL INSTRUCTION IN THESE ROUTINES (P$AAA). ! 7202: * ! 7203: * THE SYMBOL B$AAA DEFINES THE FIRST LOCATION FOR BLOCK ! 7204: * ROUTINES AND THE SYMBOL P$YYY (AT THE END OF THE PATTERN ! 7205: * MATCH ROUTINES SECTION) DEFINES THE LAST SUCH ENTRY POINT ! 7206: * ! 7207: {B$AAA{ENT{BL$$I{{{ENTRY POINT OF FIRST BLOCK ROUTINE ! 7208: {{EJC{{{{ ! 7209: * ! 7210: * EXBLK ! 7211: * ! 7212: * THE ROUTINE FOR AN EXBLK LOADS THE EXPRESSION ONTO ! 7213: * THE STACK AS A VALUE. ! 7214: * ! 7215: * (XR) POINTER TO EXBLK ! 7216: * ! 7217: {B$EXL{ENT{BL$EX{{{ENTRY POINT (EXBLK) ! 7218: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD ! 7219: {{EJC{{{{ ! 7220: * ! 7221: * SEBLK ! 7222: * ! 7223: * THE ROUTINE FOR SEBLK IS ACCESSED FROM THE GENERATED ! 7224: * CODE TO LOAD THE EXPRESSION VALUE ONTO THE STACK. ! 7225: * ! 7226: {B$SEL{ENT{BL$SE{{{ENTRY POINT (SEBLK) ! 7227: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD ! 7228: * ! 7229: * DEFINE SYMBOL WHICH MARKS END OF ENTRIES FOR EXPRESSIONS ! 7230: * ! 7231: {B$E$${ENT{BL$$I{{{ENTRY POINT ! 7232: {{EJC{{{{ ! 7233: * ! 7234: * TRBLK ! 7235: * ! 7236: * THE ROUTINE FOR A TRBLK IS NEVER EXECUTED ! 7237: * ! 7238: {B$TRT{ENT{BL$TR{{{ENTRY POINT (TRBLK) ! 7239: * ! 7240: * DEFINE SYMBOL MARKING END OF TRAP AND EXPRESSION BLOCKS ! 7241: * ! 7242: {B$T$${ENT{BL$$I{{{END OF TRBLK,SEBLK,EXBLK ENTRIES ! 7243: {{EJC{{{{ ! 7244: * ! 7245: * ARBLK ! 7246: * ! 7247: * THE ROUTINE FOR ARBLK IS NEVER EXECUTED ! 7248: * ! 7249: {B$ART{ENT{BL$AR{{{ENTRY POINT (ARBLK) ! 7250: {{EJC{{{{ ! 7251: * ! 7252: * BCBLK ! 7253: * ! 7254: * THE ROUTINE FOR A BCBLK IS NEVER EXECUTED ! 7255: * ! 7256: * (XR) POINTER TO BCBLK ! 7257: * ! 7258: {B$BCT{ENT{BL$BC{{{ENTRY POINT (BCBLK) ! 7259: {{EJC{{{{ ! 7260: * ! 7261: * BFBLK ! 7262: * ! 7263: * THE ROUTINE FOR A BFBLK IS NEVER EXECUTED ! 7264: * ! 7265: * (XR) POINTER TO BFBLK ! 7266: * ! 7267: {B$BFT{ENT{BL$BF{{{ENTRY POINT (BFBLK) ! 7268: {{EJC{{{{ ! 7269: * ! 7270: * CCBLK ! 7271: * ! 7272: * THE ROUTINE FOR CCBLK IS NEVER ENTERED ! 7273: * ! 7274: {B$CCT{ENT{BL$CC{{{ENTRY POINT (CCBLK) ! 7275: {{EJC{{{{ ! 7276: * ! 7277: * CDBLK ! 7278: * ! 7279: * THE CDBLK ROUTINES ARE EXECUTED FROM THE GENERATED CODE. ! 7280: * THERE ARE TWO CASES DEPENDING ON THE FORM OF CDFAL. ! 7281: * ! 7282: * ENTRY FOR COMPLEX FAILURE CODE AT CDFAL ! 7283: * ! 7284: * (XR) POINTER TO CDBLK ! 7285: * ! 7286: {B$CDC{ENT{BL$CD{{{ENTRY POINT (CDBLK) ! 7287: {BCDC0{MOV{FLPTR{SP{{POP GARBAGE OFF STACK ! 7288: {{MOV{4*CDFAL(R9){(SP){{SET FAILURE OFFSET ! 7289: {{BRN{STMGO{{{ENTER STMT ! 7290: {{EJC{{{{ ! 7291: * ! 7292: * CDBLK (CONTINUED) ! 7293: * ! 7294: * ENTRY FOR SIMPLE FAILURE CODE AT CDFAL ! 7295: * ! 7296: * (XR) POINTER TO CDBLK ! 7297: * ! 7298: {B$CDS{ENT{BL$CD{{{ENTRY POINT (CDBLK) ! 7299: {BCDS0{MOV{FLPTR{SP{{POP GARBAGE OFF STACK ! 7300: {{MOV{#4*CDFAL{(SP){{SET FAILURE OFFSET ! 7301: {{BRN{STMGO{{{ENTER STMT ! 7302: {{EJC{{{{ ! 7303: * ! 7304: * CMBLK ! 7305: * ! 7306: * THE ROUTINE FOR A CMBLK IS NEVER EXECUTED ! 7307: * ! 7308: {B$CMT{ENT{BL$CM{{{ENTRY POINT (CMBLK) ! 7309: {{EJC{{{{ ! 7310: * ! 7311: * CTBLK ! 7312: * ! 7313: * THE ROUTINE FOR A CTBLK IS NEVER EXECUTED ! 7314: * ! 7315: {B$CTT{ENT{BL$CT{{{ENTRY POINT (CTBLK) ! 7316: {{EJC{{{{ ! 7317: * ! 7318: * DFBLK ! 7319: * ! 7320: * THE ROUTINE FOR A DFBLK IS ACCESSED FROM THE O$FNC ENTRY ! 7321: * TO CALL A DATATYPE FUNCTION AND BUILD A PDBLK. ! 7322: * ! 7323: * (XL) POINTER TO DFBLK ! 7324: * ! 7325: {B$DFC{ENT{BL$DF{{{ENTRY POINT ! 7326: {{MOV{4*DFPDL(R10){R6{{LOAD LENGTH OF PDBLK ! 7327: {{JSR{ALLOC{{{ALLOCATE PDBLK ! 7328: {{MOV{#B$PDT{(R9){{STORE TYPE WORD ! 7329: {{MOV{R10{4*PDDFP(R9){{STORE DFBLK POINTER ! 7330: {{MOV{R9{R8{{SAVE POINTER TO PDBLK ! 7331: {{ADD{R6{R9{{POINT PAST PDBLK ! 7332: {{LCT{R6{4*FARGS(R10){{SET TO COUNT FIELDS ! 7333: * ! 7334: * LOOP TO ACQUIRE FIELD VALUES FROM STACK ! 7335: * ! 7336: {BDFC1{MOV{(SP)+{-(R9){{MOVE A FIELD VALUE ! 7337: {{BCT{R6{BDFC1{{LOOP TILL ALL MOVED ! 7338: {{MOV{R8{R9{{RECALL POINTER TO PDBLK ! 7339: {{BRN{EXSID{{{EXIT SETTING ID FIELD ! 7340: {{EJC{{{{ ! 7341: * ! 7342: * EFBLK ! 7343: * ! 7344: * THE ROUTINE FOR AN EFBLK IS PASSED CONTROL FORM THE O$FNC ! 7345: * ENTRY TO CALL AN EXTERNAL FUNCTION. ! 7346: * ! 7347: * (XL) POINTER TO EFBLK ! 7348: * ! 7349: {B$EFC{ENT{BL$EF{{{ENTRY POINT (EFBLK) ! 7350: {{MOV{4*FARGS(R10){R8{{LOAD NUMBER OF ARGUMENTS ! 7351: {{WTB{R8{{{CONVERT TO OFFSET ! 7352: {{MOV{R10{-(SP){{SAVE POINTER TO EFBLK ! 7353: {{MOV{SP{R10{{COPY POINTER TO ARGUMENTS ! 7354: * ! 7355: * LOOP TO CONVERT ARGUMENTS ! 7356: * ! 7357: {BEFC1{ICA{R10{{{POINT TO NEXT ENTRY ! 7358: {{MOV{(SP){R9{{LOAD POINTER TO EFBLK ! 7359: {{DCA{R8{{{DECREMENT EFTAR OFFSET ! 7360: {{ADD{R8{R9{{POINT TO NEXT EFTAR ENTRY ! 7361: {{MOV{4*EFTAR(R9){R9{{LOAD EFTAR ENTRY ! 7362: {{BSW{R9{4{{SWITCH ON TYPE ! 7363: {{IFF{0{BEFC7{{NO CONVERSION NEEDED ! 7364: {{IFF{1{BEFC2{{STRING ! 7365: {{IFF{2{BEFC3{{INTEGER ! 7366: {{IFF{3{BEFC4{{REAL ! 7367: {{ESW{{{{END OF SWITCH ON TYPE ! 7368: * ! 7369: * HERE TO CONVERT TO STRING ! 7370: * ! 7371: {BEFC2{MOV{(R10){-(SP){{STACK ARG PTR ! 7372: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING ! 7373: {{ERR{039{EXTERNAL{{FUNCTION ARGUMENT IS NOT STRING ! 7374: {{BRN{BEFC6{{{JUMP TO MERGE ! 7375: {{EJC{{{{ ! 7376: * ! 7377: * EFBLK (CONTINUED) ! 7378: * ! 7379: * HERE TO CONVERT AN INTEGER ! 7380: * ! 7381: {BEFC3{MOV{(R10){R9{{LOAD NEXT ARGUMENT ! 7382: {{MOV{R8{BEFOF{{SAVE OFFSET ! 7383: {{JSR{GTINT{{{CONVERT TO INTEGER ! 7384: {{ERR{040{EXTERNAL{{FUNCTION ARGUMENT IS NOT INTEGER ! 7385: {{BRN{BEFC5{{{MERGE WITH REAL CASE ! 7386: * ! 7387: * HERE TO CONVERT A REAL ! 7388: * ! 7389: {BEFC4{MOV{(R10){R9{{LOAD NEXT ARGUMENT ! 7390: {{MOV{R8{BEFOF{{SAVE OFFSET ! 7391: {{JSR{GTREA{{{CONVERT TO REAL ! 7392: {{ERR{265{EXTERNAL{{FUNCTION ARGUMENT IS NOT REAL ! 7393: * ! 7394: * INTEGER CASE MERGES HERE ! 7395: * ! 7396: {BEFC5{MOV{BEFOF{R8{{RESTORE OFFSET ! 7397: * ! 7398: * STRING MERGES HERE ! 7399: * ! 7400: {BEFC6{MOV{R9{(R10){{STORE CONVERTED RESULT ! 7401: * ! 7402: * NO CONVERSION MERGES HERE ! 7403: * ! 7404: {BEFC7{BNZ{R8{BEFC1{{LOOP BACK IF MORE TO GO ! 7405: * ! 7406: * HERE AFTER CONVERTING ALL THE ARGUMENTS ! 7407: * ! 7408: {{MOV{(SP)+{R10{{RESTORE EFBLK POINTER ! 7409: {{MOV{4*FARGS(R10){R6{{GET NUMBER OF ARGS ! 7410: {{JSR{SYSEX{{{CALL ROUTINE TO CALL EXTERNAL FNC ! 7411: {{PPM{EXFAL{{{FAIL IF FAILURE ! 7412: {{EJC{{{{ ! 7413: * ! 7414: * EFBLK (CONTINUED) ! 7415: * ! 7416: * RETURN HERE WITH RESULT IN XR ! 7417: * ! 7418: * FIRST DEFEND AGAINST NON-STANDARD NULL STRING RETURNED ! 7419: * ! 7420: {{MOV{4*EFRSL(R10){R7{{GET RESULT TYPE ID ! 7421: {{BNZ{R7{BEFA8{{BRANCH IF NOT UNCONVERTED ! 7422: {{BNE{(R9){#B$SCL{BEFC8{JUMP IF NOT A STRING ! 7423: {{BZE{4*SCLEN(R9){EXNUL{{RETURN NULL IF NULL ! 7424: * ! 7425: * HERE IF CONVERTED RESULT TO CHECK FOR NULL STRING ! 7426: * ! 7427: {BEFA8{BNE{R7{#NUM01{BEFC8{JUMP IF NOT A STRING ! 7428: {{BZE{4*SCLEN(R9){EXNUL{{RETURN NULL IF NULL ! 7429: * ! 7430: * RETURN IF RESULT IS IN DYNAMIC STORAGE ! 7431: * ! 7432: {BEFC8{BLT{R9{DNAMB{BEFC9{JUMP IF NOT IN DYNAMIC STORAGE ! 7433: {{BLE{R9{DNAMP{EXIXR{RETURN RESULT IF ALREADY DYNAMIC ! 7434: * ! 7435: * HERE WE COPY A RESULT INTO THE DYNAMIC REGION ! 7436: * ! 7437: {BEFC9{MOV{(R9){R6{{GET POSSIBLE TYPE WORD ! 7438: {{BZE{R7{BEF11{{JUMP IF UNCONVERTED RESULT ! 7439: {{MOV{#B$SCL{R6{{STRING ! 7440: {{BEQ{R7{#NUM01{BEF10{YES JUMP ! 7441: {{MOV{#B$ICL{R6{{INTEGER ! 7442: {{BEQ{R7{#NUM02{BEF10{YES JUMP ! 7443: {{MOV{#B$RCL{R6{{REAL ! 7444: * ! 7445: * STORE TYPE WORD IN RESULT ! 7446: * ! 7447: {BEF10{MOV{R6{(R9){{STORED BEFORE COPYING TO DYNAMIC ! 7448: * ! 7449: * MERGE FOR UNCONVERTED RESULT ! 7450: * ! 7451: {BEF11{JSR{BLKLN{{{GET LENGTH OF BLOCK ! 7452: {{MOV{R9{R10{{COPY ADDRESS OF OLD BLOCK ! 7453: {{JSR{ALLOC{{{ALLOCATE DYNAMIC BLOCK SAME SIZE ! 7454: {{MOV{R9{-(SP){{SET POINTER TO NEW BLOCK AS RESULT ! 7455: {{MVW{{{{COPY OLD BLOCK TO DYNAMIC BLOCK ! 7456: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK ! 7457: {{EJC{{{{ ! 7458: * ! 7459: * EVBLK ! 7460: * ! 7461: * THE ROUTINE FOR AN EVBLK IS NEVER EXECUTED ! 7462: * ! 7463: {B$EVT{ENT{BL$EV{{{ENTRY POINT (EVBLK) ! 7464: {{EJC{{{{ ! 7465: * ! 7466: * FFBLK ! 7467: * ! 7468: * THE ROUTINE FOR AN FFBLK IS EXECUTED FROM THE O$FNC ENTRY ! 7469: * TO CALL A FIELD FUNCTION AND EXTRACT A FIELD VALUE/NAME. ! 7470: * ! 7471: * (XL) POINTER TO FFBLK ! 7472: * ! 7473: {B$FFC{ENT{BL$FF{{{ENTRY POINT (FFBLK) ! 7474: {{MOV{R10{R9{{COPY FFBLK POINTER ! 7475: {{LCW{R8{{{LOAD NEXT CODE WORD ! 7476: {{MOV{(SP){R10{{LOAD PDBLK POINTER ! 7477: {{BNE{(R10){#B$PDT{BFFC2{JUMP IF NOT PDBLK AT ALL ! 7478: {{MOV{4*PDDFP(R10){R6{{LOAD DFBLK POINTER FROM PDBLK ! 7479: * ! 7480: * LOOP TO FIND CORRECT FFBLK FOR THIS PDBLK ! 7481: * ! 7482: {BFFC1{BEQ{R6{4*FFDFP(R9){BFFC3{JUMP IF THIS IS THE CORRECT FFBLK ! 7483: {{MOV{4*FFNXT(R9){R9{{ELSE LINK TO NEXT FFBLK ON CHAIN ! 7484: {{BNZ{R9{BFFC1{{LOOP BACK IF ANOTHER ENTRY TO CHECK ! 7485: * ! 7486: * HERE FOR BAD ARGUMENT ! 7487: * ! 7488: {BFFC2{ERB{041{FIELD{{FUNCTION ARGUMENT IS WRONG DATATYPE ! 7489: {{EJC{{{{ ! 7490: * ! 7491: * FFBLK (CONTINUED) ! 7492: * ! 7493: * HERE AFTER LOCATING CORRECT FFBLK ! 7494: * ! 7495: {BFFC3{MOV{4*FFOFS(R9){R6{{LOAD FIELD OFFSET ! 7496: {{BEQ{R8{#OFNE${BFFC5{JUMP IF CALLED BY NAME ! 7497: {{ADD{R6{R10{{ELSE POINT TO VALUE FIELD ! 7498: {{MOV{(R10){R9{{LOAD VALUE ! 7499: {{BNE{(R9){#B$TRT{BFFC4{JUMP IF NOT TRAPPED ! 7500: {{SUB{R6{R10{{ELSE RESTORE NAME BASE,OFFSET ! 7501: {{MOV{R8{(SP){{SAVE NEXT CODE WORD OVER PDBLK PTR ! 7502: {{JSR{ACESS{{{ACCESS VALUE ! 7503: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS ! 7504: {{MOV{(SP){R8{{RESTORE NEXT CODE WORD ! 7505: * ! 7506: * HERE AFTER GETTING VALUE IN (XR) ! 7507: * ! 7508: {BFFC4{MOV{R9{(SP){{STORE VALUE ON STACK (OVER PDBLK) ! 7509: {{MOV{R8{R9{{COPY NEXT CODE WORD ! 7510: {{MOV{(R9){R10{{LOAD ENTRY ADDRESS ! 7511: {{BRI{R10{{{JUMP TO ROUTINE FOR NEXT CODE WORD ! 7512: * ! 7513: * HERE IF CALLED BY NAME ! 7514: * ! 7515: {BFFC5{MOV{R6{-(SP){{STORE NAME OFFSET (BASE IS SET) ! 7516: {{BRN{EXITS{{{EXIT WITH NAME ON STACK ! 7517: {{EJC{{{{ ! 7518: * ! 7519: * ICBLK ! 7520: * ! 7521: * THE ROUTINE FOR ICBLK IS EXECUTED FROM THE GENERATED ! 7522: * CODE TO LOAD AN INTEGER VALUE ONTO THE STACK. ! 7523: * ! 7524: * (XR) POINTER TO ICBLK ! 7525: * ! 7526: {B$ICL{ENT{BL$IC{{{ENTRY POINT (ICBLK) ! 7527: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD ! 7528: {{EJC{{{{ ! 7529: * ! 7530: * KVBLK ! 7531: * ! 7532: * THE ROUTINE FOR A KVBLK IS NEVER EXECUTED. ! 7533: * ! 7534: {B$KVT{ENT{BL$KV{{{ENTRY POINT (KVBLK) ! 7535: {{EJC{{{{ ! 7536: * ! 7537: * NMBLK ! 7538: * ! 7539: * THE ROUTINE FOR A NMBLK IS EXECUTED FROM THE GENERATED ! 7540: * CODE FOR THE CASE OF LOADING A NAME ONTO THE STACK ! 7541: * WHERE THE NAME IS THAT OF A NATURAL VARIABLE WHICH CAN ! 7542: * BE PREEVALUATED AT COMPILE TIME. ! 7543: * ! 7544: * (XR) POINTER TO NMBLK ! 7545: * ! 7546: {B$NML{ENT{BL$NM{{{ENTRY POINT (NMBLK) ! 7547: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD ! 7548: {{EJC{{{{ ! 7549: * ! 7550: * PDBLK ! 7551: * ! 7552: * THE ROUTINE FOR A PDBLK IS NEVER EXECUTED ! 7553: * ! 7554: {B$PDT{ENT{BL$PD{{{ENTRY POINT (PDBLK) ! 7555: {{EJC{{{{ ! 7556: * ! 7557: * PFBLK ! 7558: * ! 7559: * THE ROUTINE FOR A PFBLK IS EXECUTED FROM THE ENTRY O$FNC ! 7560: * TO CALL A PROGRAM DEFINED FUNCTION. ! 7561: * ! 7562: * (XL) POINTER TO PFBLK ! 7563: * ! 7564: * THE FOLLOWING STACK ENTRIES ARE MADE BEFORE PASSING ! 7565: * CONTROL TO THE PROGRAM DEFINED FUNCTION. ! 7566: * ! 7567: * SAVED VALUE OF FIRST ARGUMENT ! 7568: * . ! 7569: * SAVED VALUE OF LAST ARGUMENT ! 7570: * SAVED VALUE OF FIRST LOCAL ! 7571: * . ! 7572: * SAVED VALUE OF LAST LOCAL ! 7573: * SAVED VALUE OF FUNCTION NAME ! 7574: * SAVED CODE BLOCK PTR (R$COD) ! 7575: * SAVED CODE POINTER (-R$COD) ! 7576: * SAVED VALUE OF FLPRT ! 7577: * SAVED VALUE OF FLPTR ! 7578: * POINTER TO PFBLK ! 7579: * FLPTR --------------- ZERO (TO BE OVERWRITTEN WITH OFFS) ! 7580: * ! 7581: {B$PFC{ENT{BL$PF{{{ENTRY POINT (PFBLK) ! 7582: {{MOV{R10{BPFPF{{SAVE PFBLK PTR (NEED NOT BE RELOC) ! 7583: {{MOV{R10{R9{{COPY FOR THE MOMENT ! 7584: {{MOV{4*PFVBL(R9){R10{{POINT TO VRBLK FOR FUNCTION ! 7585: * ! 7586: * LOOP TO FIND OLD VALUE OF FUNCTION ! 7587: * ! 7588: {BPF01{MOV{R10{R7{{SAVE POINTER ! 7589: {{MOV{4*VRVAL(R10){R10{{LOAD VALUE ! 7590: {{BEQ{(R10){#B$TRT{BPF01{LOOP IF TRBLK ! 7591: * ! 7592: * SET VALUE TO NULL AND SAVE OLD FUNCTION VALUE ! 7593: * ! 7594: {{MOV{R10{BPFSV{{SAVE OLD VALUE ! 7595: {{MOV{R7{R10{{POINT BACK TO BLOCK WITH VALUE ! 7596: {{MOV{#NULLS{4*VRVAL(R10){{SET VALUE TO NULL ! 7597: {{MOV{4*FARGS(R9){R6{{LOAD NUMBER OF ARGUMENTS ! 7598: {{ADD{#4*PFARG{R9{{POINT TO PFARG ENTRIES ! 7599: {{BZE{R6{BPF04{{JUMP IF NO ARGUMENTS ! 7600: {{MOV{SP{R10{{PTR TO LAST ARG ! 7601: {{WTB{R6{{{CONVERT NO. OF ARGS TO BYTES OFFSET ! 7602: {{ADD{R6{R10{{POINT BEFORE FIRST ARG ! 7603: {{MOV{R10{BPFXT{{REMEMBER ARG POINTER ! 7604: {{EJC{{{{ ! 7605: * ! 7606: * PFBLK (CONTINUED) ! 7607: * ! 7608: * LOOP TO SAVE OLD ARGUMENT VALUES AND SET NEW ONES ! 7609: * ! 7610: {BPF02{MOV{(R9)+{R10{{LOAD VRBLK PTR FOR NEXT ARGUMENT ! 7611: * ! 7612: * LOOP THROUGH POSSIBLE TRBLK CHAIN TO FIND VALUE ! 7613: * ! 7614: {BPF03{MOV{R10{R8{{SAVE POINTER ! 7615: {{MOV{4*VRVAL(R10){R10{{LOAD NEXT VALUE ! 7616: {{BEQ{(R10){#B$TRT{BPF03{LOOP BACK IF TRBLK ! 7617: * ! 7618: * SAVE OLD VALUE AND GET NEW VALUE ! 7619: * ! 7620: {{MOV{R10{R6{{KEEP OLD VALUE ! 7621: {{MOV{BPFXT{R10{{POINT BEFORE NEXT STACKED ARG ! 7622: {{MOV{-(R10){R7{{LOAD ARGUMENT (NEW VALUE) ! 7623: {{MOV{R6{(R10){{SAVE OLD VALUE ! 7624: {{MOV{R10{BPFXT{{KEEP ARG PTR FOR NEXT TIME ! 7625: {{MOV{R8{R10{{POINT BACK TO BLOCK WITH VALUE ! 7626: {{MOV{R7{4*VRVAL(R10){{SET NEW VALUE ! 7627: {{BNE{SP{BPFXT{BPF02{LOOP IF NOT ALL DONE ! 7628: * ! 7629: * NOW PROCESS LOCALS ! 7630: * ! 7631: {BPF04{MOV{BPFPF{R10{{RESTORE PFBLK POINTER ! 7632: {{MOV{4*PFNLO(R10){R6{{LOAD NUMBER OF LOCALS ! 7633: {{BZE{R6{BPF07{{JUMP IF NO LOCALS ! 7634: {{MOV{#NULLS{R7{{GET NULL CONSTANT ! 7635: {{LCT{R6{R6{{SET LOCAL COUNTER ! 7636: * ! 7637: * LOOP TO PROCESS LOCALS ! 7638: * ! 7639: {BPF05{MOV{(R9)+{R10{{LOAD VRBLK PTR FOR NEXT LOCAL ! 7640: * ! 7641: * LOOP THROUGH POSSIBLE TRBLK CHAIN TO FIND VALUE ! 7642: * ! 7643: {BPF06{MOV{R10{R8{{SAVE POINTER ! 7644: {{MOV{4*VRVAL(R10){R10{{LOAD NEXT VALUE ! 7645: {{BEQ{(R10){#B$TRT{BPF06{LOOP BACK IF TRBLK ! 7646: * ! 7647: * SAVE OLD VALUE AND SET NULL AS NEW VALUE ! 7648: * ! 7649: {{MOV{R10{-(SP){{STACK OLD VALUE ! 7650: {{MOV{R8{R10{{POINT BACK TO BLOCK WITH VALUE ! 7651: {{MOV{R7{4*VRVAL(R10){{SET NULL AS NEW VALUE ! 7652: {{BCT{R6{BPF05{{LOOP TILL ALL LOCALS PROCESSED ! 7653: {{EJC{{{{ ! 7654: * ! 7655: * PFBLK (CONTINUED) ! 7656: * ! 7657: * HERE AFTER PROCESSING ARGUMENTS AND LOCALS ! 7658: * ! 7659: {BPF07{ZER{R9{{{ZERO REG XR IN CASE ! 7660: {{BZE{KVPFL{BPF7C{{SKIP IF PROFILING IS OFF ! 7661: {{BEQ{KVPFL{#NUM02{BPF7A{BRANCH ON TYPE OF PROFILE ! 7662: * ! 7663: * HERE IF &PROFILE = 1 ! 7664: * ! 7665: {{JSR{SYSTM{{{GET CURRENT TIME ! 7666: {{STI{PFETM{{{SAVE FOR A SEC ! 7667: {{SBI{PFSTM{{{FIND TIME USED BY CALLER ! 7668: {{JSR{ICBLD{{{BUILD INTO AN ICBLK ! 7669: {{LDI{PFETM{{{RELOAD CURRENT TIME ! 7670: {{BRN{BPF7B{{{MERGE ! 7671: * ! 7672: * HERE IF &PROFILE = 2 ! 7673: * ! 7674: {BPF7A{LDI{PFSTM{{{GET START TIME OF CALLING STMT ! 7675: {{JSR{ICBLD{{{ASSEMBLE AN ICBLK ROUND IT ! 7676: {{JSR{SYSTM{{{GET NOW TIME ! 7677: * ! 7678: * BOTH TYPES OF PROFILE MERGE HERE ! 7679: * ! 7680: {BPF7B{STI{PFSTM{{{SET START TIME OF 1ST FUNC STMT ! 7681: {{MNZ{PFFNC{{{FLAG FUNCTION ENTRY ! 7682: * ! 7683: * NO PROFILING MERGES HERE ! 7684: * ! 7685: {BPF7C{MOV{R9{-(SP){{STACK ICBLK PTR (OR ZERO) ! 7686: {{MOV{R$COD{R6{{LOAD OLD CODE BLOCK POINTER ! 7687: {{SCP{R7{{{GET CODE POINTER ! 7688: {{SUB{R6{R7{{MAKE CODE POINTER INTO OFFSET ! 7689: {{MOV{BPFPF{R10{{RECALL PFBLK POINTER ! 7690: {{MOV{BPFSV{-(SP){{STACK OLD VALUE OF FUNCTION NAME ! 7691: {{MOV{R6{-(SP){{STACK CODE BLOCK POINTER ! 7692: {{MOV{R7{-(SP){{STACK CODE OFFSET ! 7693: {{MOV{FLPRT{-(SP){{STACK OLD FLPRT ! 7694: {{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER ! 7695: {{MOV{R10{-(SP){{STACK POINTER TO PFBLK ! 7696: {{ZER{-(SP){{{DUMMY ZERO ENTRY FOR FAIL RETURN ! 7697: {{CHK{{{{CHECK FOR STACK OVERFLOW ! 7698: {{MOV{SP{FLPTR{{SET NEW FAIL RETURN VALUE ! 7699: {{MOV{SP{FLPRT{{SET NEW FLPRT ! 7700: {{MOV{KVTRA{R6{{LOAD TRACE VALUE ! 7701: {{ADD{KVFTR{R6{{ADD FTRACE VALUE ! 7702: {{BNZ{R6{BPF09{{JUMP IF TRACING POSSIBLE ! 7703: {{ICV{KVFNC{{{ELSE BUMP FNCLEVEL ! 7704: * ! 7705: * HERE TO ACTUALLY JUMP TO FUNCTION ! 7706: * ! 7707: {BPF08{MOV{4*PFCOD(R10){R9{{POINT TO CODE ! 7708: {{BRI{(R9){{{OFF TO EXECUTE FUNCTION ! 7709: * ! 7710: * HERE IF TRACING IS POSSIBLE ! 7711: * ! 7712: {BPF09{MOV{4*PFCTR(R10){R9{{LOAD POSSIBLE CALL TRACE TRBLK ! 7713: {{MOV{4*PFVBL(R10){R10{{LOAD VRBLK POINTER FOR FUNCTION ! 7714: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET FOR VARIABLE ! 7715: {{BZE{KVTRA{BPF10{{JUMP IF TRACE MODE IS OFF ! 7716: {{BZE{R9{BPF10{{OR IF THERE IS NO CALL TRACE ! 7717: * ! 7718: * HERE IF CALL TRACED ! 7719: * ! 7720: {{DCV{KVTRA{{{DECREMENT TRACE COUNT ! 7721: {{BZE{4*TRFNC(R9){BPF11{{JUMP IF PRINT TRACE ! 7722: {{JSR{TRXEQ{{{EXECUTE FUNCTION TYPE TRACE ! 7723: {{EJC{{{{ ! 7724: * ! 7725: * PFBLK (CONTINUED) ! 7726: * ! 7727: * HERE TO TEST FOR FTRACE TRACE ! 7728: * ! 7729: {BPF10{BZE{KVFTR{BPF16{{JUMP IF FTRACE IS OFF ! 7730: {{DCV{KVFTR{{{ELSE DECREMENT FTRACE ! 7731: * ! 7732: * HERE FOR PRINT TRACE ! 7733: * ! 7734: {BPF11{JSR{PRTSN{{{PRINT STATEMENT NUMBER ! 7735: {{JSR{PRTNM{{{PRINT FUNCTION NAME ! 7736: {{MOV{#CH$PP{R6{{LOAD LEFT PAREN ! 7737: {{JSR{PRTCH{{{PRINT LEFT PAREN ! 7738: {{MOV{4*1(SP){R10{{RECOVER PFBLK POINTER ! 7739: {{BZE{4*FARGS(R10){BPF15{{SKIP IF NO ARGUMENTS ! 7740: {{ZER{R7{{{ELSE SET ARGUMENT COUNTER ! 7741: {{BRN{BPF13{{{JUMP INTO LOOP ! 7742: * ! 7743: * LOOP TO PRINT ARGUMENT VALUES ! 7744: * ! 7745: {BPF12{MOV{#CH$CM{R6{{LOAD COMMA ! 7746: {{JSR{PRTCH{{{PRINT TO SEPARATE FROM LAST ARG ! 7747: * ! 7748: * MERGE HERE FIRST TIME (NO COMMA REQUIRED) ! 7749: * ! 7750: {BPF13{MOV{R7{(SP){{SAVE ARG CTR (OVER FAILOFFS IS OK) ! 7751: {{WTB{R7{{{CONVERT TO BYTE OFFSET ! 7752: {{ADD{R7{R10{{POINT TO NEXT ARGUMENT POINTER ! 7753: {{MOV{4*PFARG(R10){R9{{LOAD NEXT ARGUMENT VRBLK PTR ! 7754: {{SUB{R7{R10{{RESTORE PFBLK POINTER ! 7755: {{MOV{4*VRVAL(R9){R9{{LOAD NEXT VALUE ! 7756: {{JSR{PRTVL{{{PRINT ARGUMENT VALUE ! 7757: {{EJC{{{{ ! 7758: * ! 7759: * HERE AFTER DEALING WITH ONE ARGUMENT ! 7760: * ! 7761: {{MOV{(SP){R7{{RESTORE ARGUMENT COUNTER ! 7762: {{ICV{R7{{{INCREMENT ARGUMENT COUNTER ! 7763: {{BLT{R7{4*FARGS(R10){BPF12{LOOP IF MORE TO PRINT ! 7764: * ! 7765: * MERGE HERE IN NO ARGS CASE TO PRINT PAREN ! 7766: * ! 7767: {BPF15{MOV{#CH$RP{R6{{LOAD RIGHT PAREN ! 7768: {{JSR{PRTCH{{{PRINT TO TERMINATE OUTPUT ! 7769: {{JSR{PRTNL{{{TERMINATE PRINT LINE ! 7770: * ! 7771: * MERGE HERE TO EXIT WITH TEST FOR FNCLEVEL TRACE ! 7772: * ! 7773: {BPF16{ICV{KVFNC{{{INCREMENT FNCLEVEL ! 7774: {{MOV{R$FNC{R10{{LOAD PTR TO POSSIBLE TRBLK ! 7775: {{JSR{KTREX{{{CALL KEYWORD TRACE ROUTINE ! 7776: * ! 7777: * CALL FUNCTION AFTER TRACE TESTS COMPLETE ! 7778: * ! 7779: {{MOV{4*1(SP){R10{{RESTORE PFBLK POINTER ! 7780: {{BRN{BPF08{{{JUMP BACK TO EXECUTE FUNCTION ! 7781: {{EJC{{{{ ! 7782: * ! 7783: * RCBLK ! 7784: * ! 7785: * THE ROUTINE FOR AN RCBLK IS EXECUTED FROM THE GENERATED ! 7786: * CODE TO LOAD A REAL VALUE ONTO THE STACK. ! 7787: * ! 7788: * (XR) POINTER TO RCBLK ! 7789: * ! 7790: {B$RCL{ENT{BL$RC{{{ENTRY POINT (RCBLK) ! 7791: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD ! 7792: {{EJC{{{{ ! 7793: * ! 7794: * SCBLK ! 7795: * ! 7796: * THE ROUTINE FOR AN SCBLK IS EXECUTED FROM THE GENERATED ! 7797: * CODE TO LOAD A STRING VALUE ONTO THE STACK. ! 7798: * ! 7799: * (XR) POINTER TO SCBLK ! 7800: * ! 7801: {B$SCL{ENT{BL$SC{{{ENTRY POINT (SCBLK) ! 7802: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD ! 7803: {{EJC{{{{ ! 7804: * ! 7805: * TBBLK ! 7806: * ! 7807: * THE ROUTINE FOR A TBBLK IS NEVER EXECUTED ! 7808: * ! 7809: {B$TBT{ENT{BL$TB{{{ENTRY POINT (TBBLK) ! 7810: {{EJC{{{{ ! 7811: * ! 7812: * TEBLK ! 7813: * ! 7814: * THE ROUTINE FOR A TEBLK IS NEVER EXECUTED ! 7815: * ! 7816: {B$TET{ENT{BL$TE{{{ENTRY POINT (TEBLK) ! 7817: {{EJC{{{{ ! 7818: * ! 7819: * VCBLK ! 7820: * ! 7821: * THE ROUTINE FOR A VCBLK IS NEVER EXECUTED ! 7822: * ! 7823: {B$VCT{ENT{BL$VC{{{ENTRY POINT (VCBLK) ! 7824: {{EJC{{{{ ! 7825: * ! 7826: * VRBLK ! 7827: * ! 7828: * THE VRBLK ROUTINES ARE EXECUTED FROM THE GENERATED CODE. ! 7829: * THERE ARE SIX ENTRIES FOR VRBLK COVERING VARIOUS CASES ! 7830: * ! 7831: {B$VR${ENT{BL$$I{{{MARK START OF VRBLK ENTRY POINTS ! 7832: * ! 7833: * ENTRY FOR VRGET (TRAPPED CASE). THIS ROUTINE IS CALLED ! 7834: * FROM THE GENERATED CODE TO LOAD THE VALUE OF A VARIABLE. ! 7835: * THIS ENTRY POINT IS USED IF AN ACCESS TRACE OR INPUT ! 7836: * ASSOCIATION IS CURRENTLY ACTIVE. ! 7837: * ! 7838: * (XR) POINTER TO VRGET FIELD OF VRBLK ! 7839: * ! 7840: {B$VRA{ENT{BL$$I{{{ENTRY POINT ! 7841: {{MOV{R9{R10{{COPY NAME BASE (VRGET = 0) ! 7842: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET ! 7843: {{JSR{ACESS{{{ACCESS VALUE ! 7844: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS ! 7845: {{BRN{EXIXR{{{ELSE EXIT WITH RESULT IN XR ! 7846: {{EJC{{{{ ! 7847: * ! 7848: * VRBLK (CONTINUED) ! 7849: * ! 7850: * ENTRY FOR VRSTO (ERROR CASE. THIS ROUTINE IS CALLED FROM ! 7851: * THE EXECUTED CODE FOR AN ATTEMPT TO MODIFY THE VALUE ! 7852: * OF A PROTECTED (PATTERN VALUED) NATURAL VARIABLE. ! 7853: * ! 7854: {B$VRE{ENT{{{{ENTRY POINT ! 7855: {{ERB{042{ATTEMPT{{TO CHANGE VALUE OF PROTECTED VARIABLE ! 7856: {{EJC{{{{ ! 7857: * ! 7858: * VRBLK (CONTINUED) ! 7859: * ! 7860: * ENTRY FOR VRTRA (UNTRAPPED CASE). THIS ROUTINE IS CALLED ! 7861: * FROM THE EXECUTED CODE TO TRANSFER TO A LABEL. ! 7862: * ! 7863: * (XR) POINTER TO VRTRA FIELD OF VRBLK ! 7864: * ! 7865: {B$VRG{ENT{{{{ENTRY POINT ! 7866: {{MOV{4*VRLBO(R9){R9{{LOAD CODE POINTER ! 7867: {{MOV{(R9){R10{{LOAD ENTRY ADDRESS ! 7868: {{BRI{R10{{{JUMP TO ROUTINE FOR NEXT CODE WORD ! 7869: {{EJC{{{{ ! 7870: * ! 7871: * VRBLK (CONTINUED) ! 7872: * ! 7873: * ENTRY FOR VRGET (UNTRAPPED CASE). THIS ROUTINE IS CALLED ! 7874: * FROM THE GENERATED CODE TO LOAD THE VALUE OF A VARIABLE. ! 7875: * ! 7876: * (XR) POINTS TO VRGET FIELD OF VRBLK ! 7877: * ! 7878: {B$VRL{ENT{{{{ENTRY POINT ! 7879: {{MOV{4*VRVAL(R9){-(SP){{LOAD VALUE ONTO STACK (VRGET = 0) ! 7880: {{BRN{EXITS{{{OBEY NEXT CODE WORD ! 7881: {{EJC{{{{ ! 7882: * ! 7883: * VRBLK (CONTINUED) ! 7884: * ! 7885: * ENTRY FOR VRSTO (UNTRAPPED CASE). THIS ROUTINE IS CALLED ! 7886: * FROM THE GENERATED CODE TO STORE THE VALUE OF A VARIABLE. ! 7887: * ! 7888: * (XR) POINTER TO VRSTO FIELD OF VRBLK ! 7889: * ! 7890: {B$VRS{ENT{{{{ENTRY POINT ! 7891: {{MOV{(SP){4*VRVLO(R9){{STORE VALUE, LEAVE ON STACK ! 7892: {{BRN{EXITS{{{OBEY NEXT CODE WORD ! 7893: {{EJC{{{{ ! 7894: * ! 7895: * VRBLK (CONTINUED) ! 7896: * ! 7897: * VRTRA (TRAPPED CASE). THIS ROUTINE IS CALLED FROM THE ! 7898: * GENERATED CODE TO TRANSFER TO A LABEL WHEN A LABEL ! 7899: * TRACE IS CURRENTLY ACTIVE. ! 7900: * ! 7901: {B$VRT{ENT{{{{ENTRY POINT ! 7902: {{SUB{#4*VRTRA{R9{{POINT BACK TO START OF VRBLK ! 7903: {{MOV{R9{R10{{COPY VRBLK POINTER ! 7904: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET ! 7905: {{MOV{4*VRLBL(R10){R9{{LOAD POINTER TO TRBLK ! 7906: {{BZE{KVTRA{BVRT2{{JUMP IF TRACE IS OFF ! 7907: {{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT ! 7908: {{BZE{4*TRFNC(R9){BVRT1{{JUMP IF PRINT TRACE CASE ! 7909: {{JSR{TRXEQ{{{ELSE EXECUTE FULL TRACE ! 7910: {{BRN{BVRT2{{{MERGE TO JUMP TO LABEL ! 7911: * ! 7912: * HERE FOR PRINT TRACE -- PRINT COLON ( LABEL NAME ) ! 7913: * ! 7914: {BVRT1{JSR{PRTSN{{{PRINT STATEMENT NUMBER ! 7915: {{MOV{R10{R9{{COPY VRBLK POINTER ! 7916: {{MOV{#CH$CL{R6{{COLON ! 7917: {{JSR{PRTCH{{{PRINT IT ! 7918: {{MOV{#CH$PP{R6{{LEFT PAREN ! 7919: {{JSR{PRTCH{{{PRINT IT ! 7920: {{JSR{PRTVN{{{PRINT LABEL NAME ! 7921: {{MOV{#CH$RP{R6{{RIGHT PAREN ! 7922: {{JSR{PRTCH{{{PRINT IT ! 7923: {{JSR{PRTNL{{{TERMINATE LINE ! 7924: {{MOV{4*VRLBL(R10){R9{{POINT BACK TO TRBLK ! 7925: * ! 7926: * MERGE HERE TO JUMP TO LABEL ! 7927: * ! 7928: {BVRT2{MOV{4*TRLBL(R9){R9{{LOAD POINTER TO ACTUAL CODE ! 7929: {{BRI{(R9){{{EXECUTE STATEMENT AT LABEL ! 7930: {{EJC{{{{ ! 7931: * ! 7932: * VRBLK (CONTINUED) ! 7933: * ! 7934: * ENTRY FOR VRSTO (TRAPPED CASE). THIS ROUTINE IS CALLED ! 7935: * FROM THE GENERATED CODE TO STORE THE VALUE OF A VARIABLE. ! 7936: * THIS ENTRY IS USED WHEN A VALUE TRACE OR OUTPUT ! 7937: * ASSOCIATION IS CURRENTLY ACTIVE. ! 7938: * ! 7939: * (XR) POINTER TO VRSTO FIELD OF VRBLK ! 7940: * ! 7941: {B$VRV{ENT{{{{ENTRY POINT ! 7942: {{MOV{(SP){R7{{LOAD VALUE (LEAVE COPY ON STACK) ! 7943: {{SUB{#4*VRSTO{R9{{POINT TO VRBLK ! 7944: {{MOV{R9{R10{{COPY VRBLK POINTER ! 7945: {{MOV{#4*VRVAL{R6{{SET OFFSET ! 7946: {{JSR{ASIGN{{{CALL ASSIGNMENT ROUTINE ! 7947: {{PPM{EXFAL{{{FAIL IF ASSIGNMENT FAILS ! 7948: {{BRN{EXITS{{{ELSE RETURN WITH RESULT ON STACK ! 7949: {{EJC{{{{ ! 7950: * ! 7951: * XNBLK ! 7952: * ! 7953: * THE ROUTINE FOR AN XNBLK IS NEVER EXECUTED ! 7954: * ! 7955: {B$XNT{ENT{BL$XN{{{ENTRY POINT (XNBLK) ! 7956: {{EJC{{{{ ! 7957: * ! 7958: * XRBLK ! 7959: * ! 7960: * THE ROUTINE FOR AN XRBLK IS NEVER EXECUTED ! 7961: * ! 7962: {B$XRT{ENT{BL$XR{{{ENTRY POINT (XRBLK) ! 7963: * ! 7964: * MARK ENTRY ADDRESS PAST LAST BLOCK ACTION ROUTINE ! 7965: * ! 7966: {B$YYY{ENT{BL$$I{{{LAST BLOCK ROUTINE ENTRY POINT ! 7967: {{TTL{S{{{P I T B O L -- PATTERN MATCHING ROUTINES ! 7968: * ! 7969: * THE FOLLOWING SECTION CONSISTS OF THE PATTERN MATCHING ! 7970: * ROUTINES. ALL PATTERN NODES CONTAIN A POINTER (PCODE) ! 7971: * TO ONE OF THE ROUTINES IN THIS SECTION (P$XXX). ! 7972: * ! 7973: * NOTE THAT THIS SECTION FOLLOWS THE B$XXX ROUTINES TO ! 7974: * ENABLE A FAST TEST FOR THE PATTERN DATATYPE. ! 7975: * ! 7976: {P$AAA{ENT{BL$$I{{{ENTRY TO MARK FIRST PATTERN ! 7977: * ! 7978: * ! 7979: * THE ENTRY CONDITIONS TO THE MATCH ROUTINE ARE AS FOLLOWS ! 7980: * (SEE O$PMN, O$PMV, O$PMS AND PROCEDURE MATCH). ! 7981: * ! 7982: * STACK CONTENTS. ! 7983: * ! 7984: * NAME BASE (O$PMN ONLY) ! 7985: * NAME OFFSET (O$PMN ONLY) ! 7986: * TYPE (0-O$PMN, 1-O$PMV, 2-O$PMS) ! 7987: * PMHBS --------------- INITIAL CURSOR (ZERO) ! 7988: * INITIAL NODE POINTER ! 7989: * XS ------------------ =NDABO (ANCHORED), =NDUNA (UNANCH) ! 7990: * ! 7991: * REGISTER VALUES. ! 7992: * ! 7993: * (XS) SET AS SHOWN IN STACK DIAGRAM ! 7994: * (XR) POINTER TO INITIAL PATTERN NODE ! 7995: * (WB) INITIAL CURSOR (ZERO) ! 7996: * ! 7997: * GLOBAL PATTERN VALUES ! 7998: * ! 7999: * R$PMS POINTER TO SUBJECT STRING SCBLK ! 8000: * PMSSL LENGTH OF SUBJECT STRING IN CHARS ! 8001: * PMDFL DOT FLAG, INITIALLY ZERO ! 8002: * PMHBS SET AS SHOWN IN STACK DIAGRAM ! 8003: * ! 8004: * CONTROL IS PASSED BY BRANCHING THROUGH THE PCODE ! 8005: * FIELD OF THE INITIAL PATTERN NODE (BRI (XR)). ! 8006: {{EJC{{{{ ! 8007: * ! 8008: * DESCRIPTION OF ALGORITHM ! 8009: * ! 8010: * A PATTERN STRUCTURE IS REPRESENTED AS A LINKED GRAPH ! 8011: * OF NODES WITH THE FOLLOWING STRUCTURE. ! 8012: * ! 8013: * +------------------------------------+ ! 8014: * I PCODE I ! 8015: * +------------------------------------+ ! 8016: * I PTHEN I ! 8017: * +------------------------------------+ ! 8018: * I PARM1 I ! 8019: * +------------------------------------+ ! 8020: * I PARM2 I ! 8021: * +------------------------------------+ ! 8022: * ! 8023: * PCODE IS A POINTER TO THE ROUTINE WHICH WILL PERFORM ! 8024: * THE MATCH OF THIS PARTICULAR NODE TYPE. ! 8025: * ! 8026: * PTHEN IS A POINTER TO THE SUCCESSOR NODE. I.E. THE NODE ! 8027: * TO BE MATCHED IF THE ATTEMPT TO MATCH THIS NODE SUCCEEDS. ! 8028: * IF THIS IS THE LAST NODE OF THE PATTERN PTHEN POINTS ! 8029: * TO THE DUMMY NODE NDNTH WHICH INITIATES PATTERN EXIT. ! 8030: * ! 8031: * PARM1, PARM2 ARE PARAMETERS WHOSE USE VARIES WITH THE ! 8032: * PARTICULAR NODE. THEY ARE ONLY PRESENT IF REQUIRED. ! 8033: * ! 8034: * ALTERNATIVES ARE HANDLED WITH THE SPECIAL ALTERNATIVE ! 8035: * NODE WHOSE PARAMETER POINTS TO THE NODE TO BE MATCHED ! 8036: * IF THERE IS A FAILURE ON THE SUCCESSOR PATH. ! 8037: * ! 8038: * THE FOLLOWING EXAMPLE ILLUSTRATES THE MANNER IN WHICH ! 8039: * THE STRUCTURE IS BUILT UP. THE PATTERN IS ! 8040: * ! 8041: * (A / B / C) (D / E) WHERE / IS ALTERNATION ! 8042: * ! 8043: * IN THE DIAGRAM, THE NODE MARKED + REPRESENTS AN ! 8044: * ALTERNATIVE NODE AND THE DOTTED LINE FROM A + NODE ! 8045: * REPRESENTS THE PARAMETER POINTER TO THE ALTERNATIVE. ! 8046: * ! 8047: * +---+ +---+ +---+ +---+ ! 8048: * I + I-----I A I-----I + I-----I D I----- ! 8049: * +---+ +---+ I +---+ +---+ ! 8050: * . I . ! 8051: * . I . ! 8052: * +---+ +---+ I +---+ ! 8053: * I + I-----I B I--I I E I----- ! 8054: * +---+ +---+ I +---+ ! 8055: * . I ! 8056: * . I ! 8057: * +---+ I ! 8058: * I C I------------I ! 8059: * +---+ ! 8060: {{EJC{{{{ ! 8061: * ! 8062: * DURING THE MATCH, THE REGISTERS ARE USED AS FOLLOWS. ! 8063: * ! 8064: * (XR) POINTS TO THE CURRENT NODE ! 8065: * (XL) SCRATCH ! 8066: * (XS) MAIN STACK POINTER ! 8067: * (WB) CURSOR (NUMBER OF CHARS MATCHED) ! 8068: * (WA,WC) SCRATCH ! 8069: * ! 8070: * TO KEEP TRACK OF ALTERNATIVES, THE MAIN STACK IS USED AS ! 8071: * A HISTORY STACK AND CONTAINS TWO WORD ENTRIES. ! 8072: * ! 8073: * WORD 1 SAVED CURSOR VALUE ! 8074: * WORD 2 NODE TO MATCH ON FAILURE ! 8075: * ! 8076: * WHEN A FAILURE OCCURS, THE MOST RECENT ENTRY ON THIS ! 8077: * STACK IS POPPED OFF TO RESTORE THE CURSOR AND POINT ! 8078: * TO THE NODE TO BE MATCHED AS AN ALTERNATIVE. THE ENTRY ! 8079: * AT THE BOTTOM OF THE STACK POINTS TO THE FOLLOWING ! 8080: * SPECIAL NODES DEPENDING ON THE SCAN MODE. ! 8081: * ! 8082: * ANCHORED MODE THE BOTTOM ENTRY POINTS TO THE ! 8083: * SPECIAL NODE NDABO WHICH CAUSES AN ! 8084: * ABORT. THE CURSOR VALUE STORED ! 8085: * WITH THIS ENTRY IS ALWAYS ZERO. ! 8086: * ! 8087: * UNANCHORED MODE THE BOTTOM ENTRY POINTS TO THE ! 8088: * SPECIAL NODE NDUNA WHICH MOVES THE ! 8089: * ANCHOR POINT AND RESTARTS THE MATCH ! 8090: * THE CURSOR SAVED WITH THIS ENTRY ! 8091: * IS THE NUMBER OF CHARACTERS WHICH ! 8092: * LIE BEFORE THE INITIAL ANCHOR POINT ! 8093: * (I.E. THE NUMBER OF ANCHOR MOVES). ! 8094: * THIS ENTRY IS THREE WORDS LONG AND ! 8095: * ALSO CONTAINS THE INITIAL PATTERN. ! 8096: * ! 8097: * ENTRIES ARE MADE ON THIS HISTORY STACK BY ALTERNATIVE ! 8098: * NODES AND BY SOME SPECIAL COMPOUD PATTERNS AS DESCRIBED ! 8099: * LATER ON. THE FOLLOWING GLOBAL LOCATIONS ARE USED DURING ! 8100: * PATTERN MATCHING. ! 8101: * ! 8102: * R$PMS POINTER TO SUBJECT STRING ! 8103: * PMSSL LENGTH OF SUBJECT STRING ! 8104: * PMDFL FLAG SET NON-ZERO FOR DOT PATTERNS ! 8105: * PMHBS BASE PTR FOR CURRENT HISTORY STACK ! 8106: * ! 8107: * THE FOLLOWING EXIT POINTS ARE AVAILABLE TO MATCH ROUTINES ! 8108: * ! 8109: * SUCCP SUCCESS IN MATCHING CURRENT NODE ! 8110: * FAILP FAILURE IN MATCHING CURRENT NODE ! 8111: {{EJC{{{{ ! 8112: * ! 8113: * COMPOUND PATTERNS ! 8114: * ! 8115: * SOME PATTERNS HAVE IMPLICIT ALTERNATIVES AND THEIR ! 8116: * REPRESENTATION IN THE PATTERN STRUCTURE CONSISTS OF A ! 8117: * LINKED SET OF NODES AS INDICATED BY THESE DIAGRAMS. ! 8118: * ! 8119: * AS BEFORE, THE + REPRESENTS AN ALTERNATIVE NODE AND ! 8120: * THE DOTTED LINE FROM A + NODE IS THE PARAMETER POINTER ! 8121: * TO THE ALTERNATIVE PATTERN. ! 8122: * ! 8123: * ARB ! 8124: * --- ! 8125: * ! 8126: * +---+ THIS NODE (P$ARB) MATCHES NULL ! 8127: * I B I----- AND STACKS CURSOR, SUCCESSOR PTR, ! 8128: * +---+ CURSOR (COPY) AND A PTR TO NDARC. ! 8129: * ! 8130: * ! 8131: * ! 8132: * ! 8133: * BAL ! 8134: * --- ! 8135: * ! 8136: * +---+ THE P$BAL NODE SCANS A BALANCED ! 8137: * I B I----- STRING AND THEN STACKS A POINTER ! 8138: * +---+ TO ITSELF ON THE HISTORY STACK. ! 8139: {{EJC{{{{ ! 8140: * ! 8141: * COMPOUND PATTERN STRUCTURES (CONTINUED) ! 8142: * ! 8143: * ! 8144: * ARBNO ! 8145: * ----- ! 8146: * ! 8147: * +---+ THIS ALTERNATIVE NODE MATCHES NULL ! 8148: * +----I + I----- THE FIRST TIME AND STACKS A POINTER ! 8149: * I +---+ TO THE ARGUMENT PATTERN X. ! 8150: * I . ! 8151: * I . ! 8152: * I +---+ NODE (P$ABA) TO STACK CURSOR ! 8153: * I I A I AND HISTORY STACK BASE PTR. ! 8154: * I +---+ ! 8155: * I I ! 8156: * I I ! 8157: * I +---+ THIS IS THE ARGUMENT PATTERN. AS ! 8158: * I I X I INDICATED, THE SUCCESSOR OF THE ! 8159: * I +---+ PATTERN IS THE P$ABC NODE ! 8160: * I I ! 8161: * I I ! 8162: * I +---+ THIS NODE (P$ABC) POPS PMHBS, ! 8163: * +----I C I STACKS OLD PMHBS AND PTR TO NDABD ! 8164: * +---+ (UNLESS OPTIMISATION HAS OCCURRED) ! 8165: * ! 8166: * STRUCTURE AND EXECUTION OF THIS PATTERN RESEMBLE THOSE OF ! 8167: * RECURSIVE PATTERN MATCHING AND IMMEDIATE ASSIGNMENT. ! 8168: * THE ALTERNATIVE NODE AT THE HEAD OF THE STRUCTURE MATCHES ! 8169: * NULL INITIALLY BUT ON SUBSEQUENT FAILURE ENSURES ATTEMPT ! 8170: * TO MATCH THE ARGUMENT. BEFORE THE ARGUMENT IS MATCHED ! 8171: * P$ABA STACKS THE CURSOR,PMHBS AND A PTR TO P$ABB. IF ! 8172: * THE ARGUMENT CANT BE MATCHED , P$ABB REMOVES THIS SPECIAL ! 8173: * STACK ENTRY AND FAILS. ! 8174: * IF ARGUMENT IS MATCHED , P$ABC RESTORES THE OUTER PMHBS ! 8175: * VALUE (SAVED BY P$ABA) . THEN IF THE ARGUMENT HAS LEFT ! 8176: * ALTERNATIVES ON STACK IT STACKS THE INNER VALUE OF PMHBS ! 8177: * AND A PTR TO NDABD. IF ARGUMENT LEFT NOTHING ON THE STACK ! 8178: * IT OPTIMISES BY REMOVING ITEMS STACKED BY P$ABA. FINALLY ! 8179: * A CHECK IS MADE THAT ARGUMENT MATCHED MORE THAN THE NULL ! 8180: * STRING (CHECK IS INTENDED TO PREVENT USELESS LOOPING). ! 8181: * IF SO THE SUCCESSOR IS AGAIN THE ALTERNATIVE NODE AT THE ! 8182: * HEAD OF THE STRUCTURE , ENSURING A POSSIBLE EXTRA ATTEMPT ! 8183: * TO MATCH THE ARG IF NECESSARY. IF NOT , THE SUCCESSOR TO ! 8184: * ALTERNATIVE IS TAKEN SO AS TO TERMINATE THE LOOP. P$ABD ! 8185: * RESTORES INNER PMHBS PTR AND FAILS , THUS TRYING TO MATCH ! 8186: * ALTERNATIVES LEFT BY THE ARBNO ARGUMENT. ! 8187: {{EJC{{{{ ! 8188: * ! 8189: * COMPOUND PATTERN STRUCTURES (CONTINUED) ! 8190: * ! 8191: * BREAKX ! 8192: * ------ ! 8193: * ! 8194: * +---+ THIS NODE IS A BREAK NODE FOR ! 8195: * +----I B I THE ARGUMENT TO BREAKX, IDENTICAL ! 8196: * I +---+ TO AN ORDINARY BREAK NODE. ! 8197: * I I ! 8198: * I I ! 8199: * I +---+ THIS ALTERNATIVE NODE STACKS A ! 8200: * I I + I----- POINTER TO THE BREAKX NODE TO ! 8201: * I +---+ ALLOW FOR SUBSEQUENT FAILURE ! 8202: * I . ! 8203: * I . ! 8204: * I +---+ THIS IS THE BREAKX NODE ITSELF. IT ! 8205: * +----I X I MATCHES ONE CHARACTER AND THEN ! 8206: * +---+ PROCEEDS BACK TO THE BREAK NODE. ! 8207: * ! 8208: * ! 8209: * ! 8210: * ! 8211: * FENCE ! 8212: * ----- ! 8213: * ! 8214: * +---+ THE FENCE NODE MATCHES NULL AND ! 8215: * I F I----- STACKS A POINTER TO NODE NDABO TO ! 8216: * +---+ ABORT ON A SUBSEQUENT REMATCH ! 8217: * ! 8218: * ! 8219: * ! 8220: * ! 8221: * SUCCEED ! 8222: * ------- ! 8223: * ! 8224: * +---+ THE NODE FOR SUCCEED MATCHES NULL ! 8225: * I S I----- AND STACKS A POINTER TO ITSELF ! 8226: * +---+ TO REPEAT THE MATCH ON A FAILURE. ! 8227: {{EJC{{{{ ! 8228: * ! 8229: * COMPOUND PATTERNS (CONTINUED) ! 8230: * ! 8231: * BINARY DOT (PATTERN ASSIGNMENT) ! 8232: * ------------------------------- ! 8233: * ! 8234: * +---+ THIS NODE (P$PAA) SAVES THE CURRENT ! 8235: * I A I CURSOR AND A POINTER TO THE ! 8236: * +---+ SPECIAL NODE NDPAB ON THE STACK. ! 8237: * I ! 8238: * I ! 8239: * +---+ THIS IS THE STRUCTURE FOR THE ! 8240: * I X I PATTERN LEFT ARGUMENT OF THE ! 8241: * +---+ PATTERN ASSIGNMENT CALL. ! 8242: * I ! 8243: * I ! 8244: * +---+ THIS NODE (P$PAC) SAVES THE CURSOR, ! 8245: * I C I----- A PTR TO ITSELF, THE CURSOR (COPY) ! 8246: * +---+ AND A PTR TO NDPAD ON THE STACK. ! 8247: * ! 8248: * ! 8249: * THE FUNCTION OF THE MATCH ROUTINE FOR NDPAB (P$PAB) ! 8250: * IS SIMPLY TO UNSTACK ITSELF AND FAIL BACK ONTO THE STACK. ! 8251: * ! 8252: * THE MATCH ROUTINE FOR P$PAC ALSO SETS THE GLOBAL PATTERN ! 8253: * FLAG PMDFL NON-ZERO TO INDICATE THAT PATTERN ASSIGNMENTS ! 8254: * MAY HAVE OCCURED IN THE PATTERN MATCH ! 8255: * ! 8256: * IF PMDFL IS SET AT THE END OF THE MATCH (SEE P$NTH), THE ! 8257: * HISTORY STACK IS SCANNED FOR MATCHING NDPAB-NDPAD PAIRS ! 8258: * AND THE CORRESPONDING PATTERN ASSIGNMENTS ARE EXECUTED. ! 8259: * ! 8260: * THE FUNCTION OF THE MATCH ROUTINE FOR NDPAD (P$PAD) ! 8261: * IS SIMPLY TO REMOVE ITS ENTRY FROM THE STACK AND FAIL. ! 8262: * THIS INCLUDES REMOVING THE SPECIAL NODE POINTER STORED ! 8263: * IN ADDITION TO THE STANDARD TWO ENTRIES ON THE STACK. ! 8264: {{EJC{{{{ ! 8265: * ! 8266: * COMPOUNT PATTERN STRUCTURES (CONTINUED) ! 8267: * ! 8268: * FENCE (FUNCTION) ! 8269: * ---------------- ! 8270: * ! 8271: * +---+ THIS NODE (P$FNA) SAVES THE ! 8272: * I A I CURRENT HISTORY STACK AND A ! 8273: * +---+ POINTER TO NDFNB ON THE STACK. ! 8274: * I ! 8275: * I ! 8276: * +---+ THIS IS THE PATTERN STRUCTURE ! 8277: * I X I GIVEN AS THE ARGUMENT TO THE ! 8278: * +---+ FENCE FUNCTION. ! 8279: * I ! 8280: * I ! 8281: * +---+ THIS NODE P$FNC RESTORES THE OUTER ! 8282: * I C I HISTORY STACK PTR SAVED IN P$FNA, ! 8283: * +---+ AND STACKS THE INNER STACK BASE ! 8284: * PTR AND A POINTER TO NDFND ON THE ! 8285: * STACK. ! 8286: * ! 8287: * NDFNB (F$FNB) SIMPLY IS THE FAILURE EXIT FOR PATTERN ! 8288: * ARGUMENT FAILURE, AND IT POPS ITSELF AND FAILS ONTO THE ! 8289: * STACK. ! 8290: * ! 8291: * THE MATCH ROUTINE P$FNC ALLOWS FOR AN OPTIMIZATION WHEN ! 8292: * THE FENCE PATTERN LEAVES NO ALTERNATIVES. IN THIS CASE, ! 8293: * THE NDFNB ENTRY IS POPPED, AND THE MATCH CONTINUES. ! 8294: * ! 8295: * NDFND (P$FND) IS ENTERED WHEN THE PATTERN FAILS AFTER ! 8296: * GOING THROUGH A NON-OPTIMIZED P$FNC, AND IT POPS THE ! 8297: * STACK BACK PAST THE INNTER STACK BASE CREATED BY P$FNA ! 8298: {{EJC{{{{ ! 8299: * ! 8300: * COMPOUND PATTERNS (CONTINUED) ! 8301: * ! 8302: * EXPRESSION PATTERNS (RECURSIVE PATTERN MATCHES) ! 8303: * ----------------------------------------------- ! 8304: * ! 8305: * INITIAL ENTRY FOR A PATTERN NODE IS TO THE ROUTINE P$EXA. ! 8306: * IF THE EVALUATED RESULT OF THE EXPRESSION IS ITSELF A ! 8307: * PATTERN, THEN THE FOLLOWING STEPS ARE TAKEN TO ARRANGE ! 8308: * FOR PROPER RECURSIVE PROCESSING. ! 8309: * ! 8310: * 1) A POINTER TO THE CURRENT NODE (THE P$EXA NODE) IS ! 8311: * STORED ON THE HISTORY STACK WITH A DUMMY CURSOR. ! 8312: * ! 8313: * 2) A SPECIAL HISTORY STACK ENTRY IS MADE IN WHICH THE ! 8314: * NODE POINTER POINTS TO NDEXB, AND THE CURSOR VALUE ! 8315: * IS THE SAVED VALUE OF PMHBS ON ENTRY TO THIS NODE. ! 8316: * THE MATCH ROUTINE FOR NDEXB (P$EXB) RESTORES PMHBS ! 8317: * FROM THIS CURSOR ENTRY, POPS OFF THE P$EXA NODE ! 8318: * POINTER AND FAILS. ! 8319: * ! 8320: * 3) THE RESULTING HISTORY STACK POINTER IS SAVED IN ! 8321: * PMHBS TO ESTABLISH A NEW LEVEL OF HISTORY STACK. ! 8322: * ! 8323: * AFTER MATCHING A PATTERN, THE END OF MATCH ROUTINE GETS ! 8324: * CONTROL (P$NTH). THIS ROUTINE PROCEEDS AS FOLLOWS. ! 8325: * ! 8326: * 1) LOAD THE CURRENT VALUE OF PMHBS AND RECOGNIZE THE ! 8327: * OUTER LEVEL CASE BY THE FACT THAT THE ASSOCIATED ! 8328: * CURSOR IN THIS CASE IS THE PATTERN MATCH TYPE CODE ! 8329: * WHICH IS LESS THAN 3. TERMINATE THE MATCH IN THIS ! 8330: * CASE AND CONTINUE EXECUTION OF THE PROGRAM. ! 8331: * ! 8332: * 2) OTHERWISE MAKE A SPECIAL HISTORY STACK ENTRY IN ! 8333: * WHICH THE NODE POINTER POINTS TO THE SPECIAL NODE ! 8334: * NDEXC AND THE CURSOR IS THE CURRENT VALUE OF PMHBS. ! 8335: * THE MATCH ROUTINE FOR NDEXC (P$EXC) RESETS PMHBS TO ! 8336: * THIS (INNER) VALUE AND AND THEN FAILS. ! 8337: * ! 8338: * 3) USING THE HISTORY STACK ENTRY MADE ON STARTING THE ! 8339: * EXPRESSION (ACCESSIBLE WITH THE CURRENT VALUE OF ! 8340: * PMHBS), RESTORE THE P$EXA NODE POINTER AND THE OLD ! 8341: * PMHBS SETTING. TAKE THE SUCCESSOR AND CONTINUE. ! 8342: * ! 8343: * AN OPTIMIZATION IS POSSIBLE IF THE EXPRESSION PATTERN ! 8344: * MAKES NO ENTRIES ON THE HISTORY STACK. IN THIS CASE, ! 8345: * INSTEAD OF BUILDING THE P$EXC NODE IN STEP 2, IT IS MORE ! 8346: * EFFICIENT TO SIMPLY POP OFF THE P$EXB ENTRY AND ITS ! 8347: * ASSOCIATED NODE POINTER. THE EFFECT IS THE SAME. ! 8348: {{EJC{{{{ ! 8349: * ! 8350: * COMPOUND PATTERNS (CONTINUED) ! 8351: * ! 8352: * BINARY DOLLAR (IMMEDIATE ASSIGNMENT) ! 8353: * ------------------------------------ ! 8354: * ! 8355: * +---+ THIS NODE (P$IMA) STACKS THE CURSOR ! 8356: * I A I PMHBS AND A PTR TO NDIMB AND RESETS ! 8357: * +---+ THE STACK PTR PMHBS. ! 8358: * I ! 8359: * I ! 8360: * +---+ THIS IS THE LEFT STRUCTURE FOR THE ! 8361: * I X I PATTERN LEFT ARGUMENT OF THE ! 8362: * +---+ IMMEDIATE ASSIGNMENT CALL. ! 8363: * I ! 8364: * I ! 8365: * +---+ THIS NODE (P$IMC) PERFORMS THE ! 8366: * I C I----- ASSIGNMENT, POPS PMHBS AND STACKS ! 8367: * +---+ THE OLD PMHBS AND A PTR TO NDIMD. ! 8368: * ! 8369: * ! 8370: * THE STRUCTURE AND EXECUTION OF THIS PATTERN ARE SIMILAR ! 8371: * TO THOSE OF THE RECURSIVE EXPRESSION PATTERN MATCHING. ! 8372: * ! 8373: * THE MATCH ROUTINE FOR NDIMB (P$IMB) RESTORES THE OUTER ! 8374: * LEVEL VALUE OF PMHBS, UNSTACKS THE SAVED CURSOR AND FAILS ! 8375: * ! 8376: * THE MATCH ROUTINE P$IMC USES THE CURRENT VALUE OF PMHBS ! 8377: * TO LOCATE THE P$IMB ENTRY. THIS ENTRY IS USED TO MAKE ! 8378: * THE ASSIGNMENT AND RESTORE THE OUTER LEVEL VALUE OF ! 8379: * PMHBS. FINALLY, THE INNER LEVEL VALUE OF PMHBS AND A ! 8380: * POINTER TO THE SPECIAL NODE NDIMD ARE STACKED. ! 8381: * ! 8382: * THE MATCH ROUTINE FOR NDIMD (P$IMD) RESTORES THE INNER ! 8383: * LEVEL VALUE OF PMHBS AND FAILS BACK INTO THE STACK. ! 8384: * ! 8385: * AN OPTIMIZATION OCCURS IF THE INNER PATTERN MAKES NO ! 8386: * ENTRIES ON THE HISTORY STACK. IN THIS CASE, P$IMC POPS ! 8387: * THE P$IMB ENTRY INSTEAD OF MAKING A P$IMD ENTRY. ! 8388: {{EJC{{{{ ! 8389: * ! 8390: * ARBNO ! 8391: * ! 8392: * SEE COMPOUND PATTERNS SECTION FOR STUCTURE AND ! 8393: * ALGORITHM FOR MATCHING THIS NODE TYPE. ! 8394: * ! 8395: * NO PARAMETERS ! 8396: * ! 8397: {P$ABA{ENT{BL$P0{{{P0BLK ! 8398: {{MOV{R7{-(SP){{STACK CURSOR ! 8399: {{MOV{R9{-(SP){{STACK DUMMY NODE PTR ! 8400: {{MOV{PMHBS{-(SP){{STACK OLD STACK BASE PTR ! 8401: {{MOV{#NDABB{-(SP){{STACK PTR TO NODE NDABB ! 8402: {{MOV{SP{PMHBS{{STORE NEW STACK BASE PTR ! 8403: {{BRN{SUCCP{{{SUCCEED ! 8404: {{EJC{{{{ ! 8405: * ! 8406: * ARBNO (REMOVE P$ABA SPECIAL STACK ENTRY) ! 8407: * ! 8408: * NO PARAMETERS (DUMMY PATTERN) ! 8409: * ! 8410: {P$ABB{ENT{{{{ENTRY POINT ! 8411: {{MOV{R7{PMHBS{{RESTORE HISTORY STACK BASE PTR ! 8412: {{BRN{FLPOP{{{FAIL AND POP DUMMY NODE PTR ! 8413: {{EJC{{{{ ! 8414: * ! 8415: * ARBNO (CHECK IF ARG MATCHED NULL STRING) ! 8416: * ! 8417: * NO PARAMETERS (DUMMY PATTERN) ! 8418: * ! 8419: {P$ABC{ENT{BL$P0{{{P0BLK ! 8420: {{MOV{PMHBS{R10{{KEEP P$ABB STACK BASE ! 8421: {{MOV{4*3(R10){R6{{LOAD INITIAL CURSOR ! 8422: {{MOV{4*1(R10){PMHBS{{RESTORE OUTER STACK BASE PTR ! 8423: {{BEQ{R10{SP{PABC1{JUMP IF NO HISTORY STACK ENTRIES ! 8424: {{MOV{R10{-(SP){{ELSE SAVE INNER PMHBS ENTRY ! 8425: {{MOV{#NDABD{-(SP){{STACK PTR TO SPECIAL NODE NDABD ! 8426: {{BRN{PABC2{{{MERGE ! 8427: * ! 8428: * OPTIMISE CASE OF NO EXTRA ENTRIES ON STACK FROM ARBNO ARG ! 8429: * ! 8430: {PABC1{ADD{#4*NUM04{SP{{REMOVE NDABB ENTRY AND CURSOR ! 8431: * ! 8432: * MERGE TO CHECK FOR MATCHING OF NULL STRING ! 8433: * ! 8434: {PABC2{BNE{R6{R7{SUCCP{ALLOW FURTHER ATTEMPT IF NON-NULL ! 8435: {{MOV{4*PTHEN(R9){R9{{BYPASS ALTERNATIVE NODE SO AS TO .. ! 8436: {{BRN{SUCCP{{{... REFUSE FURTHER MATCH ATTEMPTS ! 8437: {{EJC{{{{ ! 8438: * ! 8439: * ARBNO (TRY FOR ALTERNATIVES IN ARBNO ARGUMENT) ! 8440: * ! 8441: * NO PARAMETERS (DUMMY PATTERN) ! 8442: * ! 8443: {P$ABD{ENT{{{{ENTRY POINT ! 8444: {{MOV{R7{PMHBS{{RESTORE INNER STACK BASE PTR ! 8445: {{BRN{FAILP{{{AND FAIL ! 8446: {{EJC{{{{ ! 8447: * ! 8448: * ABORT ! 8449: * ! 8450: * NO PARAMETERS ! 8451: * ! 8452: {P$ABO{ENT{BL$P0{{{P0BLK ! 8453: {{BRN{EXFAL{{{SIGNAL STATEMENT FAILURE ! 8454: {{EJC{{{{ ! 8455: * ! 8456: * ALTERNATION ! 8457: * ! 8458: * PARM1 ALTERNATIVE NODE ! 8459: * ! 8460: {P$ALT{ENT{BL$P1{{{P1BLK ! 8461: {{MOV{R7{-(SP){{STACK CURSOR ! 8462: {{MOV{4*PARM1(R9){-(SP){{STACK POINTER TO ALTERNATIVE ! 8463: {{CHK{{{{CHECK FOR STACK OVERFLOW ! 8464: {{BRN{SUCCP{{{IF ALL OK, THEN SUCCEED ! 8465: {{EJC{{{{ ! 8466: * ! 8467: * ANY (ONE CHARACTER ARGUMENT) (1-CHAR STRING ALSO) ! 8468: * ! 8469: * PARM1 CHARACTER ARGUMENT ! 8470: * ! 8471: {P$ANS{ENT{BL$P1{{{P1BLK ! 8472: {{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARS LEFT ! 8473: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING ! 8474: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER ! 8475: {{LCH{R6{(R10){{LOAD CURRENT CHARACTER ! 8476: {{BNE{R6{4*PARM1(R9){FAILP{FAIL IF NO MATCH ! 8477: {{ICV{R7{{{ELSE BUMP CURSOR ! 8478: {{BRN{SUCCP{{{AND SUCCEED ! 8479: {{EJC{{{{ ! 8480: * ! 8481: * ANY (MULTI-CHARACTER ARGUMENT CASE) ! 8482: * ! 8483: * PARM1 POINTER TO CTBLK ! 8484: * PARM2 BIT MASK TO SELECT BIT IN CTBLK ! 8485: * ! 8486: {P$ANY{ENT{BL$P2{{{P2BLK ! 8487: * ! 8488: * EXPRESSION ARGUMENT CASE MERGES HERE ! 8489: * ! 8490: {PANY1{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARACTERS LEFT ! 8491: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING ! 8492: {{PLC{R10{R7{{GET CHAR PTR TO CURRENT CHARACTER ! 8493: {{LCH{R6{(R10){{LOAD CURRENT CHARACTER ! 8494: {{MOV{4*PARM1(R9){R10{{POINT TO CTBLK ! 8495: {{WTB{R6{{{CHANGE TO BYTE OFFSET ! 8496: {{ADD{R6{R10{{POINT TO ENTRY IN CTBLK ! 8497: {{MOV{4*CTCHS(R10){R6{{LOAD WORD FROM CTBLK ! 8498: {{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT ! 8499: {{ZRB{R6{FAILP{{FAIL IF NO MATCH ! 8500: {{ICV{R7{{{ELSE BUMP CURSOR ! 8501: {{BRN{SUCCP{{{AND SUCCEED ! 8502: {{EJC{{{{ ! 8503: * ! 8504: * ANY (EXPRESSION ARGUMENT) ! 8505: * ! 8506: * PARM1 EXPRESSION POINTER ! 8507: * ! 8508: {P$AYD{ENT{BL$P1{{{P1BLK ! 8509: {{JSR{EVALS{{{EVALUATE STRING ARGUMENT ! 8510: {{ERR{043{ANY{{EVALUATED ARGUMENT IS NOT STRING ! 8511: {{PPM{FAILP{{{FAIL IF EVALUATION FAILURE ! 8512: {{PPM{PANY1{{{MERGE MULTI-CHAR CASE IF OK ! 8513: {{EJC{{{{ ! 8514: * ! 8515: * P$ARB INITIAL ARB MATCH ! 8516: * ! 8517: * NO PARAMETERS ! 8518: * ! 8519: * THE P$ARB NODE IS PART OF A COMPOUND PATTERN STRUCTURE ! 8520: * FOR AN ARB PATTERN (SEE DESCRIPTION OF COMPOUND PATTERNS) ! 8521: * ! 8522: {P$ARB{ENT{BL$P0{{{P0BLK ! 8523: {{MOV{4*PTHEN(R9){R9{{LOAD SUCCESSOR POINTER ! 8524: {{MOV{R7{-(SP){{STACK DUMMY CURSOR ! 8525: {{MOV{R9{-(SP){{STACK SUCCESSOR POINTER ! 8526: {{MOV{R7{-(SP){{STACK CURSOR ! 8527: {{MOV{#NDARC{-(SP){{STACK PTR TO SPECIAL NODE NDARC ! 8528: {{BRI{(R9){{{EXECUTE NEXT NODE MATCHING NULL ! 8529: {{EJC{{{{ ! 8530: * ! 8531: * P$ARC EXTEND ARB MATCH ! 8532: * ! 8533: * NO PARAMETERS (DUMMY PATTERN) ! 8534: * ! 8535: {P$ARC{ENT{{{{ENTRY POINT ! 8536: {{BEQ{R7{PMSSL{FLPOP{FAIL AND POP STACK TO SUCCESSOR ! 8537: {{ICV{R7{{{ELSE BUMP CURSOR ! 8538: {{MOV{R7{-(SP){{STACK UPDATED CURSOR ! 8539: {{MOV{R9{-(SP){{RESTACK POINTER TO NDARC NODE ! 8540: {{MOV{4*2(SP){R9{{LOAD SUCCESSOR POINTER ! 8541: {{BRI{(R9){{{OFF TO REEXECUTE SUCCESSOR NODE ! 8542: {{EJC{{{{ ! 8543: * ! 8544: * BAL ! 8545: * ! 8546: * NO PARAMETERS ! 8547: * ! 8548: * THE P$BAL NODE IS PART OF THE COMPOUND STRUCTURE BUILT ! 8549: * FOR BAL (SEE SECTION ON COMPOUND PATTERNS). ! 8550: * ! 8551: {P$BAL{ENT{BL$P0{{{P0BLK ! 8552: {{ZER{R8{{{ZERO PARENTHESES LEVEL COUNTER ! 8553: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING ! 8554: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER ! 8555: {{BRN{PBAL2{{{JUMP INTO SCAN LOOP ! 8556: * ! 8557: * LOOP TO SCAN OUT CHARACTERS ! 8558: * ! 8559: {PBAL1{LCH{R6{(R10)+{{LOAD NEXT CHARACTER, BUMP POINTER ! 8560: {{ICV{R7{{{PUSH CURSOR FOR CHARACTER ! 8561: {{BEQ{R6{#CH$PP{PBAL3{JUMP IF LEFT PAREN ! 8562: {{BEQ{R6{#CH$RP{PBAL4{JUMP IF RIGHT PAREN ! 8563: {{BZE{R8{PBAL5{{ELSE SUCCEED IF AT OUTER LEVEL ! 8564: * ! 8565: * HERE AFTER PROCESSING ONE CHARACTER ! 8566: * ! 8567: {PBAL2{BNE{R7{PMSSL{PBAL1{LOOP BACK UNLESS END OF STRING ! 8568: {{BRN{FAILP{{{IN WHICH CASE, FAIL ! 8569: * ! 8570: * HERE ON LEFT PAREN ! 8571: * ! 8572: {PBAL3{ICV{R8{{{BUMP PAREN LEVEL ! 8573: {{BRN{PBAL2{{{LOOP BACK TO CHECK END OF STRING ! 8574: * ! 8575: * HERE FOR RIGHT PAREN ! 8576: * ! 8577: {PBAL4{BZE{R8{FAILP{{FAIL IF NO MATCHING LEFT PAREN ! 8578: {{DCV{R8{{{ELSE DECREMENT LEVEL COUNTER ! 8579: {{BNZ{R8{PBAL2{{LOOP BACK IF NOT AT OUTER LEVEL ! 8580: * ! 8581: * HERE AFTER SUCCESSFULLY SCANNING A BALANCED STRING ! 8582: * ! 8583: {PBAL5{MOV{R7{-(SP){{STACK CURSOR ! 8584: {{MOV{R9{-(SP){{STACK PTR TO BAL NODE FOR EXTEND ! 8585: {{BRN{SUCCP{{{AND SUCCEED ! 8586: {{EJC{{{{ ! 8587: * ! 8588: * BREAK (EXPRESSION ARGUMENT) ! 8589: * ! 8590: * PARM1 EXPRESSION POINTER ! 8591: * ! 8592: {P$BKD{ENT{BL$P1{{{P1BLK ! 8593: {{JSR{EVALS{{{EVALUATE STRING EXPRESSION ! 8594: {{ERR{044{BREAK{{EVALUATED ARGUMENT IS NOT STRING ! 8595: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS ! 8596: {{PPM{PBRK1{{{MERGE WITH MULTI-CHAR CASE IF OK ! 8597: {{EJC{{{{ ! 8598: * ! 8599: * BREAK (ONE CHARACTER ARGUMENT) ! 8600: * ! 8601: * PARM1 CHARACTER ARGUMENT ! 8602: * ! 8603: {P$BKS{ENT{BL$P1{{{P1BLK ! 8604: {{MOV{PMSSL{R8{{GET SUBJECT STRING LENGTH ! 8605: {{SUB{R7{R8{{GET NUMBER OF CHARACTERS LEFT ! 8606: {{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT ! 8607: {{LCT{R8{R8{{SET COUNTER FOR CHARS LEFT ! 8608: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING ! 8609: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER ! 8610: * ! 8611: * LOOP TO SCAN TILL BREAK CHARACTER FOUND ! 8612: * ! 8613: {PBKS1{LCH{R6{(R10)+{{LOAD NEXT CHAR, BUMP POINTER ! 8614: {{BEQ{R6{4*PARM1(R9){SUCCP{SUCCEED IF BREAK CHARACTER FOUND ! 8615: {{ICV{R7{{{ELSE PUSH CURSOR ! 8616: {{BCT{R8{PBKS1{{LOOP BACK IF MORE TO GO ! 8617: {{BRN{FAILP{{{FAIL IF END OF STRING, NO BREAK CHR ! 8618: {{EJC{{{{ ! 8619: * ! 8620: * BREAK (MULTI-CHARACTER ARGUMENT) ! 8621: * ! 8622: * PARM1 POINTER TO CTBLK ! 8623: * PARM2 BIT MASK TO SELECT BIT COLUMN ! 8624: * ! 8625: {P$BRK{ENT{BL$P2{{{P2BLK ! 8626: * ! 8627: * EXPRESSION ARGUMENT MERGES HERE ! 8628: * ! 8629: {PBRK1{MOV{PMSSL{R8{{LOAD SUBJECT STRING LENGTH ! 8630: {{SUB{R7{R8{{GET NUMBER OF CHARACTERS LEFT ! 8631: {{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT ! 8632: {{LCT{R8{R8{{SET COUNTER FOR CHARACTERS LEFT ! 8633: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING ! 8634: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER ! 8635: {{MOV{R9{PSAVE{{SAVE NODE POINTER ! 8636: * ! 8637: * LOOP TO SEARCH FOR BREAK CHARACTER ! 8638: * ! 8639: {PBRK2{LCH{R6{(R10)+{{LOAD NEXT CHAR, BUMP POINTER ! 8640: {{MOV{4*PARM1(R9){R9{{LOAD POINTER TO CTBLK ! 8641: {{WTB{R6{{{CONVERT TO BYTE OFFSET ! 8642: {{ADD{R6{R9{{POINT TO CTBLK ENTRY ! 8643: {{MOV{4*CTCHS(R9){R6{{LOAD CTBLK WORD ! 8644: {{MOV{PSAVE{R9{{RESTORE NODE POINTER ! 8645: {{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT ! 8646: {{NZB{R6{SUCCP{{SUCCEED IF BREAK CHARACTER FOUND ! 8647: {{ICV{R7{{{ELSE PUSH CURSOR ! 8648: {{BCT{R8{PBRK2{{LOOP BACK UNLESS END OF STRING ! 8649: {{BRN{FAILP{{{FAIL IF END OF STRING, NO BREAK CHR ! 8650: {{EJC{{{{ ! 8651: * ! 8652: * BREAKX (EXTENSION) ! 8653: * ! 8654: * THIS IS THE ENTRY WHICH CAUSES AN EXTENSION OF A BREAKX ! 8655: * MATCH WHEN FAILURE OCCURS. SEE SECTION ON COMPOUND ! 8656: * PATTERNS FOR FULL DETAILS OF BREAKX MATCHING. ! 8657: * ! 8658: * NO PARAMETERS ! 8659: * ! 8660: {P$BKX{ENT{BL$P0{{{P0BLK ! 8661: {{ICV{R7{{{STEP CURSOR PAST PREVIOUS BREAK CHR ! 8662: {{BRN{SUCCP{{{SUCCEED TO REMATCH BREAK ! 8663: {{EJC{{{{ ! 8664: * ! 8665: * BREAKX (EXPRESSION ARGUMENT) ! 8666: * ! 8667: * SEE SECTION ON COMPOUND PATTERNS FOR FULL STRUCTURE OF ! 8668: * BREAKX PATTERN. THE ACTUAL CHARACTER MATCHING USES A ! 8669: * BREAK NODE. HOWEVER, THE ENTRY FOR THE EXPRESSION ! 8670: * ARGUMENT CASE IS SEPARATED TO GET PROPER ERROR MESSAGES. ! 8671: * ! 8672: * PARM1 EXPRESSION POINTER ! 8673: * ! 8674: {P$BXD{ENT{BL$P1{{{P1BLK ! 8675: {{JSR{EVALS{{{EVALUATE STRING ARGUMENT ! 8676: {{ERR{045{BREAKX{{EVALUATED ARGUMENT IS NOT STRING ! 8677: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS ! 8678: {{PPM{PBRK1{{{MERGE WITH BREAK IF ALL OK ! 8679: {{EJC{{{{ ! 8680: * ! 8681: * CURSOR ASSIGNMENT ! 8682: * ! 8683: * PARM1 NAME BASE ! 8684: * PARM2 NAME OFFSET ! 8685: * ! 8686: {P$CAS{ENT{BL$P2{{{P2BLK ! 8687: {{MOV{R9{-(SP){{SAVE NODE POINTER ! 8688: {{MOV{R7{-(SP){{SAVE CURSOR ! 8689: {{MOV{4*PARM1(R9){R10{{LOAD NAME BASE ! 8690: {{MTI{R7{{{LOAD CURSOR AS INTEGER ! 8691: {{MOV{4*PARM2(R9){R7{{LOAD NAME OFFSET ! 8692: {{JSR{ICBLD{{{GET ICBLK FOR CURSOR VALUE ! 8693: {{MOV{R7{R6{{MOVE NAME OFFSET ! 8694: {{MOV{R9{R7{{MOVE VALUE TO ASSIGN ! 8695: {{JSR{ASINP{{{PERFORM ASSIGNMENT ! 8696: {{PPM{FLPOP{{{FAIL ON ASSIGNMENT FAILURE ! 8697: {{MOV{(SP)+{R7{{ELSE RESTORE CURSOR ! 8698: {{MOV{(SP)+{R9{{RESTORE NODE POINTER ! 8699: {{BRN{SUCCP{{{AND SUCCEED MATCHING NULL ! 8700: {{EJC{{{{ ! 8701: * ! 8702: * EXPRESSION NODE (P$EXA, INITIAL ENTRY) ! 8703: * ! 8704: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND ! 8705: * ALGORITHMS FOR HANDLING EXPRESSION NODES. ! 8706: * ! 8707: * PARM1 EXPRESSION POINTER ! 8708: * ! 8709: {P$EXA{ENT{BL$P1{{{P1BLK ! 8710: {{JSR{EVALP{{{EVALUATE EXPRESSION ! 8711: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS ! 8712: {{BLO{R6{#P$AAA{PEXA1{JUMP IF RESULT IS NOT A PATTERN ! 8713: * ! 8714: * HERE IF RESULT OF EXPRESSION IS A PATTERN ! 8715: * ! 8716: {{MOV{R7{-(SP){{STACK DUMMY CURSOR ! 8717: {{MOV{R9{-(SP){{STACK PTR TO P$EXA NODE ! 8718: {{MOV{PMHBS{-(SP){{STACK HISTORY STACK BASE PTR ! 8719: {{MOV{#NDEXB{-(SP){{STACK PTR TO SPECIAL NODE NDEXB ! 8720: {{MOV{SP{PMHBS{{STORE NEW STACK BASE POINTER ! 8721: {{MOV{R10{R9{{COPY NODE POINTER ! 8722: {{BRI{(R9){{{MATCH FIRST NODE IN EXPRESSION PAT ! 8723: * ! 8724: * HERE IF RESULT OF EXPRESSION IS NOT A PATTERN ! 8725: * ! 8726: {PEXA1{BEQ{R6{#B$SCL{PEXA2{JUMP IF IT IS ALREADY A STRING ! 8727: {{MOV{R10{-(SP){{ELSE STACK RESULT ! 8728: {{MOV{R9{R10{{SAVE NODE POINTER ! 8729: {{JSR{GTSTG{{{CONVERT RESULT TO STRING ! 8730: {{ERR{046{EXPRESSION{{DOES NOT EVALUATE TO PATTERN ! 8731: {{MOV{R9{R8{{COPY STRING POINTER ! 8732: {{MOV{R10{R9{{RESTORE NODE POINTER ! 8733: {{MOV{R8{R10{{COPY STRING POINTER AGAIN ! 8734: * ! 8735: * MERGE HERE WITH STRING POINTER IN XL ! 8736: * ! 8737: {PEXA2{BZE{4*SCLEN(R10){SUCCP{{JUST SUCCEED IF NULL STRING ! 8738: {{BRN{PSTR1{{{ELSE MERGE WITH STRING CIRCUIT ! 8739: {{EJC{{{{ ! 8740: * ! 8741: * EXPRESSION NODE (P$EXB, REMOVE NDEXB ENTRY) ! 8742: * ! 8743: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND ! 8744: * ALGORITHMS FOR HANDLING EXPRESSION NODES. ! 8745: * ! 8746: * NO PARAMETERS (DUMMY PATTERN) ! 8747: * ! 8748: {P$EXB{ENT{{{{ENTRY POINT ! 8749: {{MOV{R7{PMHBS{{RESTORE OUTER LEVEL STACK POINTER ! 8750: {{BRN{FLPOP{{{FAIL AND POP P$EXA NODE PTR ! 8751: {{EJC{{{{ ! 8752: * ! 8753: * EXPRESSION NODE (P$EXC, REMOVE NDEXC ENTRY) ! 8754: * ! 8755: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND ! 8756: * ALGORITHMS FOR HANDLING EXPRESSION NODES. ! 8757: * ! 8758: * NO PARAMETERS (DUMMY PATTERN) ! 8759: * ! 8760: {P$EXC{ENT{{{{ENTRY POINT ! 8761: {{MOV{R7{PMHBS{{RESTORE INNER STACK BASE POINTER ! 8762: {{BRN{FAILP{{{AND FAIL INTO EXPR PATTERN ALTERNVS ! 8763: {{EJC{{{{ ! 8764: * ! 8765: * FAIL ! 8766: * ! 8767: * NO PARAMETERS ! 8768: * ! 8769: {P$FAL{ENT{BL$P0{{{P0BLK ! 8770: {{BRN{FAILP{{{JUST SIGNAL FAILURE ! 8771: {{EJC{{{{ ! 8772: * ! 8773: * FENCE ! 8774: * ! 8775: * SEE COMPOUND PATTERNS SECTION FOR THE STRUCTURE AND ! 8776: * ALGORITHM FOR MATCHING THIS NODE TYPE. ! 8777: * ! 8778: * NO PARAMETERS ! 8779: * ! 8780: {P$FEN{ENT{BL$P0{{{P0BLK ! 8781: {{MOV{R7{-(SP){{STACK DUMMY CURSOR ! 8782: {{MOV{#NDABO{-(SP){{STACK PTR TO ABORT NODE ! 8783: {{BRN{SUCCP{{{AND SUCCEED MATCHING NULL ! 8784: {{EJC{{{{ ! 8785: * ! 8786: * FENCE (FUNCTION) ! 8787: * ! 8788: * SEE COMPOUND PATTERNS COMMENTS AT START OF THIS SECTION ! 8789: * FOR DETAILS OF SCHEME ! 8790: * ! 8791: * NO PARAMETERS ! 8792: * ! 8793: {P$FNA{ENT{BL$P0{{{P0BLK ! 8794: {{MOV{PMHBS{-(SP){{STACK CURRENT HISTORY STACK BASE ! 8795: {{MOV{#NDFNB{-(SP){{STACK INDIR PTR TO P$FNB (FAILURE) ! 8796: {{MOV{SP{PMHBS{{BEGIN NEW HISTORY STACK ! 8797: {{BRN{SUCCP{{{SUCCEED ! 8798: {{EJC{{{{ ! 8799: * ! 8800: * FENCE (FUNCTION) (RESET HISTORY STACK AND FAIL) ! 8801: * ! 8802: * NO PARAMETERS (DUMMY PATTERN) ! 8803: * ! 8804: {P$FNB{ENT{BL$P0{{{P0BLK ! 8805: {{MOV{R7{PMHBS{{RESTORE OUTER PMHBS STACK BASE ! 8806: {{BRN{FAILP{{{...AND FAIL ! 8807: {{EJC{{{{ ! 8808: * ! 8809: * FENCE (FUNCTION) (MAKE FENCE TRAP ENTRY ON STACK) ! 8810: * ! 8811: * NO PARAMETERS (DUMMY PATTERN) ! 8812: * ! 8813: {P$FNC{ENT{BL$P0{{{P0BLK ! 8814: {{MOV{PMHBS{R10{{GET INNER STACK BASE PTR ! 8815: {{MOV{4*NUM01(R10){PMHBS{{RESTORE OUTER STACK BASE ! 8816: {{BEQ{R10{SP{PFNC1{OPTIMIZE IF NO ALTERNATIVES ! 8817: {{MOV{R10{-(SP){{ELSE STACK INNER STACK BASE ! 8818: {{MOV{#NDFND{-(SP){{STACK PTR TO NDFND ! 8819: {{BRN{SUCCP{{{SUCCEED ! 8820: * ! 8821: * HERE WHEN FENCE FUNCTION LEFT NOTHING ON THE STACK ! 8822: * ! 8823: {PFNC1{ADD{#4*NUM02{SP{{POP OFF P$FNB ENTRY ! 8824: {{BRN{SUCCP{{{SUCCEED ! 8825: {{EJC{{{{ ! 8826: * ! 8827: * FENCE (FUNCTION) (SKIP PAST ALTERNATIVES ON FAILURE) ! 8828: * ! 8829: * NO PARAMETERS (DUMMY PATTERN) ! 8830: * ! 8831: {P$FND{ENT{BL$P0{{{P0BLK ! 8832: {{MOV{R7{SP{{POP STACK TO FENCE() HISTORY BASE ! 8833: {{BRN{FLPOP{{{POP BASE ENTRY AND FAIL ! 8834: {{EJC{{{{ ! 8835: * ! 8836: * IMMEDIATE ASSIGNMENT (INITIAL ENTRY, SAVE CURRENT CURSOR) ! 8837: * ! 8838: * SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE ! 8839: * STRUCTURE AND ALGORITHM FOR MATCHING THIS NODE TYPE. ! 8840: * ! 8841: * NO PARAMETERS ! 8842: * ! 8843: {P$IMA{ENT{BL$P0{{{P0BLK ! 8844: {{MOV{R7{-(SP){{STACK CURSOR ! 8845: {{MOV{R9{-(SP){{STACK DUMMY NODE POINTER ! 8846: {{MOV{PMHBS{-(SP){{STACK OLD STACK BASE POINTER ! 8847: {{MOV{#NDIMB{-(SP){{STACK PTR TO SPECIAL NODE NDIMB ! 8848: {{MOV{SP{PMHBS{{STORE NEW STACK BASE POINTER ! 8849: {{BRN{SUCCP{{{AND SUCCEED ! 8850: {{EJC{{{{ ! 8851: * ! 8852: * IMMEDIATE ASSIGNMENT (REMOVE CURSOR MARK ENTRY) ! 8853: * ! 8854: * SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE ! 8855: * STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE. ! 8856: * ! 8857: * NO PARAMETERS (DUMMY PATTERN) ! 8858: * ! 8859: {P$IMB{ENT{{{{ENTRY POINT ! 8860: {{MOV{R7{PMHBS{{RESTORE HISTORY STACK BASE PTR ! 8861: {{BRN{FLPOP{{{FAIL AND POP DUMMY NODE PTR ! 8862: {{EJC{{{{ ! 8863: * ! 8864: * IMMEDIATE ASSIGNMENT (PERFORM ACTUAL ASSIGNMENT) ! 8865: * ! 8866: * SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE ! 8867: * STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE. ! 8868: * ! 8869: * PARM1 NAME BASE OF VARIABLE ! 8870: * PARM2 NAME OFFSET OF VARIABLE ! 8871: * ! 8872: {P$IMC{ENT{BL$P2{{{P2BLK ! 8873: {{MOV{PMHBS{R10{{LOAD POINTER TO P$IMB ENTRY ! 8874: {{MOV{R7{R6{{COPY FINAL CURSOR ! 8875: {{MOV{4*3(R10){R7{{LOAD INITIAL CURSOR ! 8876: {{MOV{4*1(R10){PMHBS{{RESTORE OUTER STACK BASE POINTER ! 8877: {{BEQ{R10{SP{PIMC1{JUMP IF NO HISTORY STACK ENTRIES ! 8878: {{MOV{R10{-(SP){{ELSE SAVE INNER PMHBS POINTER ! 8879: {{MOV{#NDIMD{-(SP){{AND A PTR TO SPECIAL NODE NDIMD ! 8880: {{BRN{PIMC2{{{MERGE ! 8881: * ! 8882: * HERE IF NO ENTRIES MADE ON HISTORY STACK ! 8883: * ! 8884: {PIMC1{ADD{#4*NUM04{SP{{REMOVE NDIMB ENTRY AND CURSOR ! 8885: * ! 8886: * MERGE HERE TO PERFORM ASSIGNMENT ! 8887: * ! 8888: {PIMC2{MOV{R6{-(SP){{SAVE CURRENT (FINAL) CURSOR ! 8889: {{MOV{R9{-(SP){{SAVE CURRENT NODE POINTER ! 8890: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING ! 8891: {{SUB{R7{R6{{COMPUTE SUBSTRING LENGTH ! 8892: {{JSR{SBSTR{{{BUILD SUBSTRING ! 8893: {{MOV{R9{R7{{MOVE RESULT ! 8894: {{MOV{(SP){R9{{RELOAD NODE POINTER ! 8895: {{MOV{4*PARM1(R9){R10{{LOAD NAME BASE ! 8896: {{MOV{4*PARM2(R9){R6{{LOAD NAME OFFSET ! 8897: {{JSR{ASINP{{{PERFORM ASSIGNMENT ! 8898: {{PPM{FLPOP{{{FAIL IF ASSIGNMENT FAILS ! 8899: {{MOV{(SP)+{R9{{ELSE RESTORE NODE POINTER ! 8900: {{MOV{(SP)+{R7{{RESTORE CURSOR ! 8901: {{BRN{SUCCP{{{AND SUCCEED ! 8902: {{EJC{{{{ ! 8903: * ! 8904: * IMMEDIATE ASSIGNMENT (REMOVE NDIMD ENTRY ON FAILURE) ! 8905: * ! 8906: * SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE ! 8907: * STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE. ! 8908: * ! 8909: * NO PARAMETERS (DUMMY PATTERN) ! 8910: * ! 8911: {P$IMD{ENT{{{{ENTRY POINT ! 8912: {{MOV{R7{PMHBS{{RESTORE INNER STACK BASE POINTER ! 8913: {{BRN{FAILP{{{AND FAIL ! 8914: {{EJC{{{{ ! 8915: * ! 8916: * LEN (INTEGER ARGUMENT) ! 8917: * ! 8918: * PARM1 INTEGER ARGUMENT ! 8919: * ! 8920: {P$LEN{ENT{BL$P1{{{P1BLK ! 8921: * ! 8922: * EXPRESSION ARGUMENT CASE MERGES HERE ! 8923: * ! 8924: {PLEN1{ADD{4*PARM1(R9){R7{{PUSH CURSOR INDICATED AMOUNT ! 8925: {{BLE{R7{PMSSL{SUCCP{SUCCEED IF NOT OFF END ! 8926: {{BRN{FAILP{{{ELSE FAIL ! 8927: {{EJC{{{{ ! 8928: * ! 8929: * LEN (EXPRESSION ARGUMENT) ! 8930: * ! 8931: * PARM1 EXPRESSION POINTER ! 8932: * ! 8933: {P$LND{ENT{BL$P1{{{P1BLK ! 8934: {{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT ! 8935: {{ERR{047{LEN{{EVALUATED ARGUMENT IS NOT INTEGER ! 8936: {{ERR{048{LEN{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 8937: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS ! 8938: {{PPM{PLEN1{{{MERGE WITH NORMAL CIRCUIT IF OK ! 8939: {{EJC{{{{ ! 8940: * ! 8941: * NOTANY (EXPRESSION ARGUMENT) ! 8942: * ! 8943: * PARM1 EXPRESSION POINTER ! 8944: * ! 8945: {P$NAD{ENT{BL$P1{{{P1BLK ! 8946: {{JSR{EVALS{{{EVALUATE STRING ARGUMENT ! 8947: {{ERR{049{NOTANY{{EVALUATED ARGUMENT IS NOT STRING ! 8948: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS ! 8949: {{PPM{PNAY1{{{MERGE WITH MULTI-CHAR CASE IF OK ! 8950: {{EJC{{{{ ! 8951: * ! 8952: * NOTANY (ONE CHARACTER ARGUMENT) ! 8953: * ! 8954: * PARM1 CHARACTER ARGUMENT ! 8955: * ! 8956: {P$NAS{ENT{BL$P1{{{ENTRY POINT ! 8957: {{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARS LEFT ! 8958: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING ! 8959: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER IN STRIN ! 8960: {{LCH{R6{(R10){{LOAD CURRENT CHARACTER ! 8961: {{BEQ{R6{4*PARM1(R9){FAILP{FAIL IF MATCH ! 8962: {{ICV{R7{{{ELSE BUMP CURSOR ! 8963: {{BRN{SUCCP{{{AND SUCCEED ! 8964: {{EJC{{{{ ! 8965: * ! 8966: * NOTANY (MULTI-CHARACTER STRING ARGUMENT) ! 8967: * ! 8968: * PARM1 POINTER TO CTBLK ! 8969: * PARM2 BIT MASK TO SELECT BIT COLUMN ! 8970: * ! 8971: {P$NAY{ENT{BL$P2{{{P2BLK ! 8972: * ! 8973: * EXPRESSION ARGUMENT CASE MERGES HERE ! 8974: * ! 8975: {PNAY1{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARACTERS LEFT ! 8976: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING ! 8977: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER ! 8978: {{LCH{R6{(R10){{LOAD CURRENT CHARACTER ! 8979: {{WTB{R6{{{CONVERT TO BYTE OFFSET ! 8980: {{MOV{4*PARM1(R9){R10{{LOAD POINTER TO CTBLK ! 8981: {{ADD{R6{R10{{POINT TO ENTRY IN CTBLK ! 8982: {{MOV{4*CTCHS(R10){R6{{LOAD ENTRY FROM CTBLK ! 8983: {{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT ! 8984: {{NZB{R6{FAILP{{FAIL IF CHARACTER IS MATCHED ! 8985: {{ICV{R7{{{ELSE BUMP CURSOR ! 8986: {{BRN{SUCCP{{{AND SUCCEED ! 8987: {{EJC{{{{ ! 8988: * ! 8989: * END OF PATTERN MATCH ! 8990: * ! 8991: * THIS ROUTINE IS ENTERED ON SUCCESSFUL COMPLETION. ! 8992: * SEE DESCRIPTION OF EXPRESSION PATTERNS IN COMPOUND ! 8993: * PATTERN SECTION FOR HANDLING OF RECURSION IN MATCHING. ! 8994: * ! 8995: * NO PARAMETERS (DUMMY PATTERN) ! 8996: * ! 8997: {P$NTH{ENT{{{{ENTRY POINT ! 8998: {{MOV{PMHBS{R10{{LOAD POINTER TO BASE OF STACK ! 8999: {{MOV{4*1(R10){R6{{LOAD SAVED PMHBS (OR PATTERN TYPE) ! 9000: {{BLE{R6{#NUM02{PNTH2{JUMP IF OUTER LEVEL (PATTERN TYPE) ! 9001: * ! 9002: * HERE WE ARE AT THE END OF MATCHING AN EXPRESSION PATTERN ! 9003: * ! 9004: {{MOV{R6{PMHBS{{RESTORE OUTER STACK BASE POINTER ! 9005: {{MOV{4*2(R10){R9{{RESTORE POINTER TO P$EXA NODE ! 9006: {{BEQ{R10{SP{PNTH1{JUMP IF NO HISTORY STACK ENTRIES ! 9007: {{MOV{R10{-(SP){{ELSE STACK INNER STACK BASE PTR ! 9008: {{MOV{#NDEXC{-(SP){{STACK PTR TO SPECIAL NODE NDEXC ! 9009: {{BRN{SUCCP{{{AND SUCCEED ! 9010: * ! 9011: * HERE IF NO HISTORY STACK ENTRIES DURING PATTERN ! 9012: * ! 9013: {PNTH1{ADD{#4*NUM04{SP{{REMOVE P$EXB ENTRY AND NODE PTR ! 9014: {{BRN{SUCCP{{{AND SUCCEED ! 9015: * ! 9016: * HERE IF END OF MATCH AT OUTER LEVEL ! 9017: * ! 9018: {PNTH2{MOV{R7{PMSSL{{SAVE FINAL CURSOR IN SAFE PLACE ! 9019: {{BZE{PMDFL{PNTH6{{JUMP IF NO PATTERN ASSIGNMENTS ! 9020: {{EJC{{{{ ! 9021: * ! 9022: * END OF PATTERN MATCH (CONTINUED) ! 9023: * ! 9024: * NOW WE MUST PERFORM PATTERN ASSIGNMENTS. THIS IS DONE BY ! 9025: * SCANNING THE HISTORY STACK FOR MATCHING NDPAB-NDPAD PAIRS ! 9026: * ! 9027: {PNTH3{DCA{R10{{{POINT PAST CURSOR ENTRY ! 9028: {{MOV{-(R10){R6{{LOAD NODE POINTER ! 9029: {{BEQ{R6{#NDPAD{PNTH4{JUMP IF NDPAD ENTRY ! 9030: {{BNE{R6{#NDPAB{PNTH5{JUMP IF NOT NDPAB ENTRY ! 9031: * ! 9032: * HERE FOR NDPAB ENTRY, STACK INITIAL CURSOR ! 9033: * NOTE THAT THERE MUST BE MORE ENTRIES ON THE STACK. ! 9034: * ! 9035: {{MOV{4*1(R10){-(SP){{STACK INITIAL CURSOR ! 9036: {{CHK{{{{CHECK FOR STACK OVERFLOW ! 9037: {{BRN{PNTH3{{{LOOP BACK IF OK ! 9038: * ! 9039: * HERE FOR NDPAD ENTRY. THE STARTING CURSOR FROM THE ! 9040: * MATCHING NDPAD ENTRY IS NOW THE TOP STACK ENTRY. ! 9041: * ! 9042: {PNTH4{MOV{4*1(R10){R6{{LOAD FINAL CURSOR ! 9043: {{MOV{(SP){R7{{LOAD INITIAL CURSOR FROM STACK ! 9044: {{MOV{R10{(SP){{SAVE HISTORY STACK SCAN PTR ! 9045: {{SUB{R7{R6{{COMPUTE LENGTH OF STRING ! 9046: * ! 9047: * BUILD SUBSTRING AND PERFORM ASSIGNMENT ! 9048: * ! 9049: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING ! 9050: {{JSR{SBSTR{{{CONSTRUCT SUBSTRING ! 9051: {{MOV{R9{R7{{COPY SUBSTRING POINTER ! 9052: {{MOV{(SP){R10{{RELOAD HISTORY STACK SCAN PTR ! 9053: {{MOV{4*2(R10){R10{{LOAD POINTER TO P$PAC NODE WITH NAM ! 9054: {{MOV{4*PARM2(R10){R6{{LOAD NAME OFFSET ! 9055: {{MOV{4*PARM1(R10){R10{{LOAD NAME BASE ! 9056: {{JSR{ASINP{{{PERFORM ASSIGNMENT ! 9057: {{PPM{EXFAL{{{MATCH FAILS IF NAME EVAL FAILS ! 9058: {{MOV{(SP)+{R10{{ELSE RESTORE HISTORY STACK PTR ! 9059: {{EJC{{{{ ! 9060: * ! 9061: * END OF PATTERN MATCH (CONTINUED) ! 9062: * ! 9063: * HERE CHECK FOR END OF ENTRIES ! 9064: * ! 9065: {PNTH5{BNE{R10{SP{PNTH3{LOOP IF MORE ENTRIES TO SCAN ! 9066: * ! 9067: * HERE AFTER DEALING WITH PATTERN ASSIGNMENTS ! 9068: * ! 9069: {PNTH6{MOV{PMHBS{SP{{WIPE OUT HISTORY STACK ! 9070: {{MOV{(SP)+{R7{{LOAD INITIAL CURSOR ! 9071: {{MOV{(SP)+{R8{{LOAD MATCH TYPE CODE ! 9072: {{MOV{PMSSL{R6{{LOAD FINAL CURSOR VALUE ! 9073: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING ! 9074: {{ZER{R$PMS{{{CLEAR SUBJECT STRING PTR FOR GBCOL ! 9075: {{BZE{R8{PNTH7{{JUMP IF CALL BY NAME ! 9076: {{BEQ{R8{#NUM02{EXITS{EXIT IF STATEMENT LEVEL CALL ! 9077: * ! 9078: * HERE WE HAVE A CALL BY VALUE, BUILD SUBSTRING ! 9079: * ! 9080: {{SUB{R7{R6{{COMPUTE LENGTH OF STRING ! 9081: {{JSR{SBSTR{{{BUILD SUBSTRING ! 9082: {{BRN{EXIXR{{{AND EXIT WITH SUBSTRING VALUE ! 9083: * ! 9084: * HERE FOR CALL BY NAME, MAKE STACK ENTRIES FOR O$RPL ! 9085: * ! 9086: {PNTH7{MOV{R7{-(SP){{STACK INITIAL CURSOR ! 9087: {{MOV{R6{-(SP){{STACK FINAL CURSOR ! 9088: {{BZE{R$PMB{PNTH8{{SKIP IF SUBJECT NOT BUFFER ! 9089: {{MOV{R$PMB{R10{{ELSE GET PTR TO BCBLK INSTEAD ! 9090: * ! 9091: * HERE WITH XL POINTING TO SCBLK OR BCBLK ! 9092: * ! 9093: {PNTH8{MOV{R10{-(SP){{STACK SUBJECT POINTER ! 9094: {{BRN{EXITS{{{EXIT WITH SPECIAL ENTRY ON STACK ! 9095: {{EJC{{{{ ! 9096: * ! 9097: * POS (INTEGER ARGUMENT) ! 9098: * ! 9099: * PARM1 INTEGER ARGUMENT ! 9100: * ! 9101: {P$POS{ENT{BL$P1{{{P1BLK ! 9102: * ! 9103: * EXPRESSION ARGUMENT CASE MERGES HERE ! 9104: * ! 9105: {PPOS1{BEQ{R7{4*PARM1(R9){SUCCP{SUCCEED IF AT RIGHT LOCATION ! 9106: {{BRN{FAILP{{{ELSE FAIL ! 9107: {{EJC{{{{ ! 9108: * ! 9109: * POS (EXPRESSION ARGUMENT) ! 9110: * ! 9111: * PARM1 EXPRESSION POINTER ! 9112: * ! 9113: {P$PSD{ENT{BL$P1{{{P1BLK ! 9114: {{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT ! 9115: {{ERR{050{POS{{EVALUATED ARGUMENT IS NOT INTEGER ! 9116: {{ERR{051{POS{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 9117: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS ! 9118: {{PPM{PPOS1{{{MERGE WITH NORMAL CASE IF OK ! 9119: {{EJC{{{{ ! 9120: * ! 9121: * PATTERN ASSIGNMENT (INITIAL ENTRY, SAVE CURSOR) ! 9122: * ! 9123: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND ! 9124: * ALGORITHMS FOR MATCHING THIS NODE TYPE. ! 9125: * ! 9126: * NO PARAMETERS ! 9127: * ! 9128: {P$PAA{ENT{BL$P0{{{P0BLK ! 9129: {{MOV{R7{-(SP){{STACK INITIAL CURSOR ! 9130: {{MOV{#NDPAB{-(SP){{STACK PTR TO NDPAB SPECIAL NODE ! 9131: {{BRN{SUCCP{{{AND SUCCEED MATCHING NULL ! 9132: {{EJC{{{{ ! 9133: * ! 9134: * PATTERN ASSIGNMENT (REMOVE SAVED CURSOR) ! 9135: * ! 9136: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND ! 9137: * ALGORITHMS FOR MATCHING THIS NODE TYPE. ! 9138: * ! 9139: * NO PARAMETERS (DUMMY PATTERN) ! 9140: * ! 9141: {P$PAB{ENT{{{{ENTRY POINT ! 9142: {{BRN{FAILP{{{JUST FAIL (ENTRY IS ALREADY POPPED) ! 9143: {{EJC{{{{ ! 9144: * ! 9145: * PATTERN ASSIGNMENT (END OF MATCH, MAKE ASSIGN ENTRY) ! 9146: * ! 9147: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND ! 9148: * ALGORITHMS FOR MATCHING THIS NODE TYPE. ! 9149: * ! 9150: * PARM1 NAME BASE OF VARIABLE ! 9151: * PARM2 NAME OFFSET OF VARIABLE ! 9152: * ! 9153: {P$PAC{ENT{BL$P2{{{P2BLK ! 9154: {{MOV{R7{-(SP){{STACK DUMMY CURSOR VALUE ! 9155: {{MOV{R9{-(SP){{STACK POINTER TO P$PAC NODE ! 9156: {{MOV{R7{-(SP){{STACK FINAL CURSOR ! 9157: {{MOV{#NDPAD{-(SP){{STACK PTR TO SPECIAL NDPAD NODE ! 9158: {{MNZ{PMDFL{{{SET DOT FLAG NON-ZERO ! 9159: {{BRN{SUCCP{{{AND SUCCEED ! 9160: {{EJC{{{{ ! 9161: * ! 9162: * PATTERN ASSIGNMENT (REMOVE ASSIGN ENTRY) ! 9163: * ! 9164: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND ! 9165: * ALGORITHMS FOR MATCHING THIS NODE TYPE. ! 9166: * ! 9167: * NO PARAMETERS (DUMMY NODE) ! 9168: * ! 9169: {P$PAD{ENT{{{{ENTRY POINT ! 9170: {{BRN{FLPOP{{{FAIL AND REMOVE P$PAC NODE ! 9171: {{EJC{{{{ ! 9172: * ! 9173: * REM ! 9174: * ! 9175: * NO PARAMETERS ! 9176: * ! 9177: {P$REM{ENT{BL$P0{{{P0BLK ! 9178: {{MOV{PMSSL{R7{{POINT CURSOR TO END OF STRING ! 9179: {{BRN{SUCCP{{{AND SUCCEED ! 9180: {{EJC{{{{ ! 9181: * ! 9182: * RPOS (EXPRESSION ARGUMENT) ! 9183: * ! 9184: * PARM1 EXPRESSION POINTER ! 9185: * ! 9186: {P$RPD{ENT{BL$P1{{{P1BLK ! 9187: {{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT ! 9188: {{ERR{052{RPOS{{EVALUATED ARGUMENT IS NOT INTEGER ! 9189: {{ERR{053{RPOS{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 9190: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS ! 9191: {{PPM{PRPS1{{{MERGE WITH NORMAL CASE IF OK ! 9192: {{EJC{{{{ ! 9193: * ! 9194: * RPOS (INTEGER ARGUMENT) ! 9195: * ! 9196: * PARM1 INTEGER ARGUMENT ! 9197: * ! 9198: {P$RPS{ENT{BL$P1{{{P1BLK ! 9199: * ! 9200: * EXPRESSION ARGUMENT CASE MERGES HERE ! 9201: * ! 9202: {PRPS1{MOV{PMSSL{R8{{GET LENGTH OF STRING ! 9203: {{SUB{R7{R8{{GET NUMBER OF CHARACTERS REMAINING ! 9204: {{BEQ{R8{4*PARM1(R9){SUCCP{SUCCEED IF AT RIGHT LOCATION ! 9205: {{BRN{FAILP{{{ELSE FAIL ! 9206: {{EJC{{{{ ! 9207: * ! 9208: * RTAB (INTEGER ARGUMENT) ! 9209: * ! 9210: * PARM1 INTEGER ARGUMENT ! 9211: * ! 9212: {P$RTB{ENT{BL$P1{{{P1BLK ! 9213: * ! 9214: * EXPRESSION ARGUMENT CASE MERGES HERE ! 9215: * ! 9216: {PRTB1{MOV{R7{R8{{SAVE INITIAL CURSOR ! 9217: {{MOV{PMSSL{R7{{POINT TO END OF STRING ! 9218: {{BLT{R7{4*PARM1(R9){FAILP{FAIL IF STRING NOT LONG ENOUGH ! 9219: {{SUB{4*PARM1(R9){R7{{ELSE SET NEW CURSOR ! 9220: {{BGE{R7{R8{SUCCP{AND SUCCEED IF NOT TOO FAR ALREADY ! 9221: {{BRN{FAILP{{{IN WHICH CASE, FAIL ! 9222: {{EJC{{{{ ! 9223: * ! 9224: * RTAB (EXPRESSION ARGUMENT) ! 9225: * ! 9226: * PARM1 EXPRESSION POINTER ! 9227: * ! 9228: {P$RTD{ENT{BL$P1{{{P1BLK ! 9229: {{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT ! 9230: {{ERR{054{RTAB{{EVALUATED ARGUMENT IS NOT INTEGER ! 9231: {{ERR{055{RTAB{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 9232: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS ! 9233: {{PPM{PRTB1{{{MERGE WITH NORMAL CASE IF SUCCESS ! 9234: {{EJC{{{{ ! 9235: * ! 9236: * SPAN (EXPRESSION ARGUMENT) ! 9237: * ! 9238: * PARM1 EXPRESSION POINTER ! 9239: * ! 9240: {P$SPD{ENT{BL$P1{{{P1BLK ! 9241: {{JSR{EVALS{{{EVALUATE STRING ARGUMENT ! 9242: {{ERR{056{SPAN{{EVALUATED ARGUMENT IS NOT STRING ! 9243: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS ! 9244: {{PPM{PSPN1{{{MERGE WITH MULTI-CHAR CASE IF OK ! 9245: {{EJC{{{{ ! 9246: * ! 9247: * SPAN (MULTI-CHARACTER ARGUMENT CASE) ! 9248: * ! 9249: * PARM1 POINTER TO CTBLK ! 9250: * PARM2 BIT MASK TO SELECT BIT COLUMN ! 9251: * ! 9252: {P$SPN{ENT{BL$P2{{{P2BLK ! 9253: * ! 9254: * EXPRESSION ARGUMENT CASE MERGES HERE ! 9255: * ! 9256: {PSPN1{MOV{PMSSL{R8{{COPY SUBJECT STRING LENGTH ! 9257: {{SUB{R7{R8{{CALCULATE NUMBER OF CHARACTERS LEFT ! 9258: {{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT ! 9259: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING ! 9260: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER ! 9261: {{MOV{R7{PSAVC{{SAVE INITIAL CURSOR ! 9262: {{MOV{R9{PSAVE{{SAVE NODE POINTER ! 9263: {{LCT{R8{R8{{SET COUNTER FOR CHARS LEFT ! 9264: * ! 9265: * LOOP TO SCAN MATCHING CHARACTERS ! 9266: * ! 9267: {PSPN2{LCH{R6{(R10)+{{LOAD NEXT CHARACTER, BUMP POINTER ! 9268: {{WTB{R6{{{CONVERT TO BYTE OFFSET ! 9269: {{MOV{4*PARM1(R9){R9{{POINT TO CTBLK ! 9270: {{ADD{R6{R9{{POINT TO CTBLK ENTRY ! 9271: {{MOV{4*CTCHS(R9){R6{{LOAD CTBLK ENTRY ! 9272: {{MOV{PSAVE{R9{{RESTORE NODE POINTER ! 9273: {{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT ! 9274: {{ZRB{R6{PSPN3{{JUMP IF NO MATCH ! 9275: {{ICV{R7{{{ELSE PUSH CURSOR ! 9276: {{BCT{R8{PSPN2{{LOOP BACK UNLESS END OF STRING ! 9277: * ! 9278: * HERE AFTER SCANNING MATCHING CHARACTERS ! 9279: * ! 9280: {PSPN3{BNE{R7{PSAVC{SUCCP{SUCCEED IF CHARS MATCHED ! 9281: {{BRN{FAILP{{{ELSE FAIL IF NULL STRING MATCHED ! 9282: {{EJC{{{{ ! 9283: * ! 9284: * SPAN (ONE CHARACTER ARGUMENT) ! 9285: * ! 9286: * PARM1 CHARACTER ARGUMENT ! 9287: * ! 9288: {P$SPS{ENT{BL$P1{{{P1BLK ! 9289: {{MOV{PMSSL{R8{{GET SUBJECT STRING LENGTH ! 9290: {{SUB{R7{R8{{CALCULATE NUMBER OF CHARACTERS LEFT ! 9291: {{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT ! 9292: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING ! 9293: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER ! 9294: {{MOV{R7{PSAVC{{SAVE INITIAL CURSOR ! 9295: {{LCT{R8{R8{{SET COUNTER FOR CHARACTERS LEFT ! 9296: * ! 9297: * LOOP TO SCAN MATCHING CHARACTERS ! 9298: * ! 9299: {PSPS1{LCH{R6{(R10)+{{LOAD NEXT CHARACTER, BUMP POINTER ! 9300: {{BNE{R6{4*PARM1(R9){PSPS2{JUMP IF NO MATCH ! 9301: {{ICV{R7{{{ELSE PUSH CURSOR ! 9302: {{BCT{R8{PSPS1{{AND LOOP UNLESS END OF STRING ! 9303: * ! 9304: * HERE AFTER SCANNING MATCHING CHARACTERS ! 9305: * ! 9306: {PSPS2{BNE{R7{PSAVC{SUCCP{SUCCEED IF CHARS MATCHED ! 9307: {{BRN{FAILP{{{FAIL IF NULL STRING MATCHED ! 9308: {{EJC{{{{ ! 9309: * ! 9310: * MULTI-CHARACTER STRING ! 9311: * ! 9312: * NOTE THAT ONE CHARACTER STRINGS USE THE CIRCUIT FOR ! 9313: * ONE CHARACTER ANY ARGUMENTS (P$AN1). ! 9314: * ! 9315: * PARM1 POINTER TO SCBLK FOR STRING ARG ! 9316: * ! 9317: {P$STR{ENT{BL$P1{{{P1BLK ! 9318: {{MOV{4*PARM1(R9){R10{{GET POINTER TO STRING ! 9319: * ! 9320: * MERGE HERE AFTER EVALUATING EXPRESSION WITH STRING VALUE ! 9321: * ! 9322: {PSTR1{MOV{R9{PSAVE{{SAVE NODE POINTER ! 9323: {{MOV{R$PMS{R9{{LOAD SUBJECT STRING POINTER ! 9324: {{PLC{R9{R7{{POINT TO CURRENT CHARACTER ! 9325: {{ADD{4*SCLEN(R10){R7{{COMPUTE NEW CURSOR POSITION ! 9326: {{BGT{R7{PMSSL{FAILP{FAIL IF PAST END OF STRING ! 9327: {{MOV{R7{PSAVC{{SAVE UPDATED CURSOR ! 9328: {{MOV{4*SCLEN(R10){R6{{GET NUMBER OF CHARS TO COMPARE ! 9329: {{PLC{R10{{{POINT TO CHARS OF TEST STRING ! 9330: {{CMC{FAILP{FAILP{{COMPARE, FAIL IF NOT EQUAL ! 9331: {{MOV{PSAVE{R9{{IF ALL MATCHED, RESTORE NODE PTR ! 9332: {{MOV{PSAVC{R7{{RESTORE UPDATED CURSOR ! 9333: {{BRN{SUCCP{{{AND SUCCEED ! 9334: {{EJC{{{{ ! 9335: * ! 9336: * SUCCEED ! 9337: * ! 9338: * SEE SECTION ON COMPOUND PATTERNS FOR DETAILS OF THE ! 9339: * STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE ! 9340: * ! 9341: * NO PARAMETERS ! 9342: * ! 9343: {P$SUC{ENT{BL$P0{{{P0BLK ! 9344: {{MOV{R7{-(SP){{STACK CURSOR ! 9345: {{MOV{R9{-(SP){{STACK POINTER TO THIS NODE ! 9346: {{BRN{SUCCP{{{SUCCEED MATCHING NULL ! 9347: {{EJC{{{{ ! 9348: * ! 9349: * TAB (INTEGER ARGUMENT) ! 9350: * ! 9351: * PARM1 INTEGER ARGUMENT ! 9352: * ! 9353: {P$TAB{ENT{BL$P1{{{P1BLK ! 9354: * ! 9355: * EXPRESSION ARGUMENT CASE MERGES HERE ! 9356: * ! 9357: {PTAB1{BGT{R7{4*PARM1(R9){FAILP{FAIL IF TOO FAR ALREADY ! 9358: {{MOV{4*PARM1(R9){R7{{ELSE SET NEW CURSOR POSITION ! 9359: {{BLE{R7{PMSSL{SUCCP{SUCCEED IF NOT OFF END ! 9360: {{BRN{FAILP{{{ELSE FAIL ! 9361: {{EJC{{{{ ! 9362: * ! 9363: * TAB (EXPRESSION ARGUMENT) ! 9364: * ! 9365: * PARM1 EXPRESSION POINTER ! 9366: * ! 9367: {P$TBD{ENT{BL$P1{{{P1BLK ! 9368: {{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT ! 9369: {{ERR{057{TAB{{EVALUATED ARGUMENT IS NOT INTEGER ! 9370: {{ERR{058{TAB{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 9371: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS ! 9372: {{PPM{PTAB1{{{MERGE WITH NORMAL CASE IF OK ! 9373: {{EJC{{{{ ! 9374: * ! 9375: * ANCHOR MOVEMENT ! 9376: * ! 9377: * NO PARAMETERS (DUMMY NODE) ! 9378: * ! 9379: {P$UNA{ENT{{{{ENTRY POINT ! 9380: {{MOV{R7{R9{{COPY INITIAL PATTERN NODE POINTER ! 9381: {{MOV{(SP){R7{{GET INITIAL CURSOR ! 9382: {{BEQ{R7{PMSSL{EXFAL{MATCH FAILS IF AT END OF STRING ! 9383: {{ICV{R7{{{ELSE INCREMENT CURSOR ! 9384: {{MOV{R7{(SP){{STORE INCREMENTED CURSOR ! 9385: {{MOV{R9{-(SP){{RESTACK INITIAL NODE PTR ! 9386: {{MOV{#NDUNA{-(SP){{RESTACK UNANCHORED NODE ! 9387: {{BRI{(R9){{{REMATCH FIRST NODE ! 9388: {{EJC{{{{ ! 9389: * ! 9390: * END OF PATTERN MATCH ROUTINES ! 9391: * ! 9392: * THE FOLLOWING ENTRY POINT MARKS THE END OF THE PATTERN ! 9393: * MATCHING ROUTINES AND ALSO THE END OF THE ENTRY POINTS ! 9394: * REFERENCED FROM THE FIRST WORD OF BLOCKS IN DYNAMIC STORE ! 9395: * ! 9396: {P$YYY{ENT{BL$$I{{{MARK LAST ENTRY IN PATTERN SECTION ! 9397: {{TTL{S{{{P I T B O L -- PREDEFINED SNOBOL4 FUNCTIONS ! 9398: * ! 9399: * THE FOLLOWING SECTION CONTAINS CODING FOR FUNCTIONS ! 9400: * WHICH ARE PREDEFINED AND AVAILABLE AT THE SNOBOL LEVEL. ! 9401: * ! 9402: * THESE ROUTINES RECEIVE CONTROL DIRECTLY FROM THE CODE OR ! 9403: * INDIRECTLY THROUGH THE O$FNC, O$FNS OR CFUNC ROUTINES. ! 9404: * IN BOTH CASES THE CONDITIONS ON ENTRY ARE AS FOLLOWS ! 9405: * ! 9406: * THE ARGUMENTS ARE ON THE STACK. THE NUMBER OF ARGUMENTS ! 9407: * HAS BEEN ADJUSTED TO CORRESPOND TO THE SVBLK SVNAR FIELD. ! 9408: * ! 9409: * IN CERTAIN FUNCTIONS THE DIRECT CALL IS NOT PERMITTED ! 9410: * AND IN THESE INSTANCES WE ALSO HAVE. ! 9411: * ! 9412: * (WA) ACTUAL NUMBER OF ARGUMENTS IN CALL ! 9413: * ! 9414: * CONTROL RETURNS BY PLACING THE FUNCTION RESULT VALUE ON ! 9415: * ON THE STACK AND CONTINUING EXECUTION WITH THE NEXT ! 9416: * WORD FROM THE GENERATED CODE. ! 9417: * ! 9418: * THE NAMES OF THE ENTRY POINTS OF THESE FUNCTIONS ARE OF ! 9419: * THE FORM S$XXX WHERE XXX IS THE THREE LETTER CODE FOR ! 9420: * THE SYSTEM VARIABLE NAME. THE FUNCTIONS ARE IN ORDER ! 9421: * ALPHABETICALLY BY THEIR ENTRY NAMES. ! 9422: {{EJC{{{{ ! 9423: * ! 9424: * ANY ! 9425: * ! 9426: {S$ANY{ENT{{{{ENTRY POINT ! 9427: {{MOV{#P$ANS{R7{{SET PCODE FOR SINGLE CHAR CASE ! 9428: {{MOV{#P$ANY{R10{{PCODE FOR MULTI-CHAR CASE ! 9429: {{MOV{#P$AYD{R8{{PCODE FOR EXPRESSION CASE ! 9430: {{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE ! 9431: {{ERR{059{ANY{{ARGUMENT IS NOT STRING OR EXPRESSION ! 9432: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD ! 9433: {{EJC{{{{ ! 9434: * ! 9435: * APPEND ! 9436: * ! 9437: {S$APN{ENT{{{{ENTRY POINT ! 9438: {{MOV{(SP)+{R10{{GET APPEND ARGUMENT ! 9439: {{MOV{(SP)+{R9{{GET BCBLK ! 9440: {{BEQ{(R9){#B$BCT{SAPN1{OK IF FIRST ARG IS BCBLK ! 9441: {{ERB{275{APPEND{{FIRST ARGUMENT IS NOT BUFFER ! 9442: * ! 9443: * HERE TO DO THE APPEND ! 9444: * ! 9445: {SAPN1{JSR{APNDB{{{DO THE APPEND ! 9446: {{ERR{276{APPEND{{SECOND ARGUMENT IS NOT STRING ! 9447: {{PPM{EXFAL{{{NO ROOM - FAIL ! 9448: {{BRN{EXNUL{{{EXIT WITH NULL RESULT ! 9449: {{EJC{{{{ ! 9450: * ! 9451: * APPLY ! 9452: * ! 9453: * APPLY DOES NOT PERMIT THE DIRECT (FAST) CALL SO THAT ! 9454: * WA CONTAINS THE ACTUAL NUMBER OF ARGUMENTS PASSED. ! 9455: * ! 9456: {S$APP{ENT{{{{ENTRY POINT ! 9457: {{BZE{R6{SAPP3{{JUMP IF NO ARGUMENTS ! 9458: {{DCV{R6{{{ELSE GET APPLIED FUNC ARG COUNT ! 9459: {{MOV{R6{R7{{COPY ! 9460: {{WTB{R7{{{CONVERT TO BYTES ! 9461: {{MOV{SP{R10{{COPY STACK POINTER ! 9462: {{ADD{R7{R10{{POINT TO FUNCTION ARGUMENT ON STACK ! 9463: {{MOV{(R10){R9{{LOAD FUNCTION PTR (APPLY 1ST ARG) ! 9464: {{BZE{R6{SAPP2{{JUMP IF NO ARGS FOR APPLIED FUNC ! 9465: {{LCT{R7{R6{{ELSE SET COUNTER FOR LOOP ! 9466: * ! 9467: * LOOP TO MOVE ARGUMENTS UP ON STACK ! 9468: * ! 9469: {SAPP1{DCA{R10{{{POINT TO NEXT ARGUMENT ! 9470: {{MOV{(R10){4*1(R10){{MOVE ARGUMENT UP ! 9471: {{BCT{R7{SAPP1{{LOOP TILL ALL MOVED ! 9472: * ! 9473: * MERGE HERE TO CALL FUNCTION (WA = NUMBER OF ARGUMENTS) ! 9474: * ! 9475: {SAPP2{ICA{SP{{{ADJUST STACK PTR FOR APPLY 1ST ARG ! 9476: {{JSR{GTNVR{{{GET VARIABLE BLOCK ADDR FOR FUNC ! 9477: {{PPM{SAPP3{{{JUMP IF NOT NATURAL VARIABLE ! 9478: {{MOV{4*VRFNC(R9){R10{{ELSE POINT TO FUNCTION BLOCK ! 9479: {{BRN{CFUNC{{{GO CALL APPLIED FUNCTION ! 9480: * ! 9481: * HERE FOR INVALID FIRST ARGUMENT ! 9482: * ! 9483: {SAPP3{ERB{060{APPLY{{FIRST ARG IS NOT NATURAL VARIABLE NAME ! 9484: {{EJC{{{{ ! 9485: * ! 9486: * ARBNO ! 9487: * ! 9488: * ARBNO BUILDS A COMPOUND PATTERN. SEE DESCRIPTION AT ! 9489: * START OF PATTERN MATCHING SECTION FOR STRUCTURE FORMED. ! 9490: * ! 9491: {S$ABN{ENT{{{{ENTRY POINT ! 9492: {{ZER{R9{{{SET PARM1 = 0 FOR THE MOMENT ! 9493: {{MOV{#P$ALT{R7{{SET PCODE FOR ALTERNATIVE NODE ! 9494: {{JSR{PBILD{{{BUILD ALTERNATIVE NODE ! 9495: {{MOV{R9{R10{{SAVE PTR TO ALTERNATIVE PATTERN ! 9496: {{MOV{#P$ABC{R7{{PCODE FOR P$ABC ! 9497: {{ZER{R9{{{P0BLK ! 9498: {{JSR{PBILD{{{BUILD P$ABC NODE ! 9499: {{MOV{R10{4*PTHEN(R9){{PUT ALTERNATIVE NODE AS SUCCESSOR ! 9500: {{MOV{R10{R6{{REMEMBER ALTERNATIVE NODE POINTER ! 9501: {{MOV{R9{R10{{COPY P$ABC NODE PTR ! 9502: {{MOV{(SP){R9{{LOAD ARBNO ARGUMENT ! 9503: {{MOV{R6{(SP){{STACK ALTERNATIVE NODE POINTER ! 9504: {{JSR{GTPAT{{{GET ARBNO ARGUMENT AS PATTERN ! 9505: {{ERR{061{ARBNO{{ARGUMENT IS NOT PATTERN ! 9506: {{JSR{PCONC{{{CONCAT ARG WITH P$ABC NODE ! 9507: {{MOV{R9{R10{{REMEMBER PTR TO CONCD PATTERNS ! 9508: {{MOV{#P$ABA{R7{{PCODE FOR P$ABA ! 9509: {{ZER{R9{{{P0BLK ! 9510: {{JSR{PBILD{{{BUILD P$ABA NODE ! 9511: {{MOV{R10{4*PTHEN(R9){{CONCATENATE NODES ! 9512: {{MOV{(SP){R10{{RECALL PTR TO ALTERNATIVE NODE ! 9513: {{MOV{R9{4*PARM1(R10){{POINT ALTERNATIVE BACK TO ARGUMENT ! 9514: {{BRN{EXITS{{{JUMP FOR NEXT CODE WORD ! 9515: {{EJC{{{{ ! 9516: * ! 9517: * ARG ! 9518: * ! 9519: {S$ARG{ENT{{{{ENTRY POINT ! 9520: {{JSR{GTSMI{{{GET SECOND ARG AS SMALL INTEGER ! 9521: {{ERR{062{ARG{{SECOND ARGUMENT IS NOT INTEGER ! 9522: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE OR NEGATIVE ! 9523: {{MOV{R9{R6{{SAVE ARGUMENT NUMBER ! 9524: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT ! 9525: {{JSR{GTNVR{{{LOCATE VRBLK ! 9526: {{PPM{SARG1{{{JUMP IF NOT NATURAL VARIABLE ! 9527: {{MOV{4*VRFNC(R9){R9{{ELSE LOAD FUNCTION BLOCK POINTER ! 9528: {{BNE{(R9){#B$PFC{SARG1{JUMP IF NOT PROGRAM DEFINED ! 9529: {{BZE{R6{EXFAL{{FAIL IF ARG NUMBER IS ZERO ! 9530: {{BGT{R6{4*FARGS(R9){EXFAL{FAIL IF ARG NUMBER IS TOO LARGE ! 9531: {{WTB{R6{{{ELSE CONVERT TO BYTE OFFSET ! 9532: {{ADD{R6{R9{{POINT TO ARGUMENT SELECTED ! 9533: {{MOV{4*PFAGB(R9){R9{{LOAD ARGUMENT VRBLK POINTER ! 9534: {{BRN{EXVNM{{{EXIT TO BUILD NMBLK ! 9535: * ! 9536: * HERE IF 1ST ARGUMENT IS BAD ! 9537: * ! 9538: {SARG1{ERB{063{ARG{{FIRST ARGUMENT IS NOT PROGRAM FUNCTION NAME ! 9539: {{EJC{{{{ ! 9540: * ! 9541: * ARRAY ! 9542: * ! 9543: {S$ARR{ENT{{{{ENTRY POINT ! 9544: {{MOV{(SP)+{R10{{LOAD INITIAL ELEMENT VALUE ! 9545: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT ! 9546: {{JSR{GTINT{{{CONVERT FIRST ARG TO INTEGER ! 9547: {{PPM{SAR02{{{JUMP IF NOT INTEGER ! 9548: * ! 9549: * HERE FOR INTEGER FIRST ARGUMENT, BUILD VCBLK ! 9550: * ! 9551: {{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE ! 9552: {{ILE{SAR10{{{JUMP IF ZERO OR NEG (BAD DIMENSION) ! 9553: {{MFI{R6{SAR11{{ELSE CONVERT TO ONE WORD, TEST OVFL ! 9554: {{LCT{R7{R6{{COPY ELEMENTS FOR LOOP LATER ON ! 9555: {{ADD{#VCSI${R6{{ADD SPACE FOR STANDARD FIELDS ! 9556: {{WTB{R6{{{CONVERT LENGTH TO BYTES ! 9557: {{BGE{R6{MXLEN{SAR11{FAIL IF TOO LARGE ! 9558: {{JSR{ALLOC{{{ALLOCATE SPACE FOR VCBLK ! 9559: {{MOV{#B$VCT{(R9){{STORE TYPE WORD ! 9560: {{MOV{R6{4*VCLEN(R9){{SET LENGTH ! 9561: {{MOV{R10{R8{{COPY DEFAULT VALUE ! 9562: {{MOV{R9{R10{{COPY VCBLK POINTER ! 9563: {{ADD{#4*VCVLS{R10{{POINT TO FIRST ELEMENT VALUE ! 9564: * ! 9565: * LOOP TO SET VECTOR ELEMENTS TO DEFAULT VALUE ! 9566: * ! 9567: {SAR01{MOV{R8{(R10)+{{STORE ONE VALUE ! 9568: {{BCT{R7{SAR01{{LOOP TILL ALL STORED ! 9569: {{BRN{EXSID{{{EXIT SETTING IDVAL ! 9570: {{EJC{{{{ ! 9571: * ! 9572: * ARRAY (CONTINUED) ! 9573: * ! 9574: * HERE IF FIRST ARGUMENT IS NOT AN INTEGER ! 9575: * ! 9576: {SAR02{MOV{R9{-(SP){{REPLACE ARGUMENT ON STACK ! 9577: {{JSR{XSCNI{{{INITIALIZE SCAN OF FIRST ARGUMENT ! 9578: {{ERR{064{ARRAY{{FIRST ARGUMENT IS NOT INTEGER OR STRING ! 9579: {{PPM{EXNUL{{{DUMMY (UNUSED) NULL STRING EXIT ! 9580: {{MOV{R$XSC{-(SP){{SAVE PROTOTYPE POINTER ! 9581: {{MOV{R10{-(SP){{SAVE DEFAULT VALUE ! 9582: {{ZER{ARCDM{{{ZERO COUNT OF DIMENSIONS ! 9583: {{ZER{ARPTR{{{ZERO OFFSET TO INDICATE PASS ONE ! 9584: {{LDI{INTV1{{{LOAD INTEGER ONE ! 9585: {{STI{ARNEL{{{INITIALIZE ELEMENT COUNT ! 9586: * ! 9587: * THE FOLLOWING CODE IS EXECUTED TWICE. THE FIRST TIME ! 9588: * (ARPTR EQ 0), IT IS USED TO COUNT THE NUMBER OF ELEMENTS ! 9589: * AND NUMBER OF DIMENSIONS. THE SECOND TIME (ARPTR GT 0) IS ! 9590: * USED TO ACTUALLY FILL IN THE DIM,LBD FIELDS OF THE ARBLK. ! 9591: * ! 9592: {SAR03{LDI{INTV1{{{LOAD ONE AS DEFAULT LOW BOUND ! 9593: {{STI{ARSVL{{{SAVE AS LOW BOUND ! 9594: {{MOV{#CH$CL{R8{{SET DELIMITER ONE = COLON ! 9595: {{MOV{#CH$CM{R10{{SET DELIMITER TWO = COMMA ! 9596: {{JSR{XSCAN{{{SCAN NEXT BOUND ! 9597: {{BNE{R6{#NUM01{SAR04{JUMP IF NOT COLON ! 9598: * ! 9599: * HERE WE HAVE A COLON ENDING A LOW BOUND ! 9600: * ! 9601: {{JSR{GTINT{{{CONVERT LOW BOUND ! 9602: {{ERR{065{ARRAY{{FIRST ARGUMENT LOWER BOUND IS NOT INTEGER ! 9603: {{LDI{4*ICVAL(R9){{{LOAD VALUE OF LOW BOUND ! 9604: {{STI{ARSVL{{{STORE LOW BOUND VALUE ! 9605: {{MOV{#CH$CM{R8{{SET DELIMITER ONE = COMMA ! 9606: {{MOV{R8{R10{{AND DELIMITER TWO = COMMA ! 9607: {{JSR{XSCAN{{{SCAN HIGH BOUND ! 9608: {{EJC{{{{ ! 9609: * ! 9610: * ARRAY (CONTINUED) ! 9611: * ! 9612: * MERGE HERE TO PROCESS UPPER BOUND ! 9613: * ! 9614: {SAR04{JSR{GTINT{{{CONVERT HIGH BOUND TO INTEGER ! 9615: {{ERR{066{ARRAY{{FIRST ARGUMENT UPPER BOUND IS NOT INTEGER ! 9616: {{LDI{4*ICVAL(R9){{{GET HIGH BOUND ! 9617: {{SBI{ARSVL{{{SUBTRACT LOWER BOUND ! 9618: {{IOV{SAR10{{{BAD DIMENSION IF OVERFLOW ! 9619: {{ILT{SAR10{{{BAD DIMENSION IF NEGATIVE ! 9620: {{ADI{INTV1{{{ADD 1 TO GET DIMENSION ! 9621: {{IOV{SAR10{{{BAD DIMENSION IF OVERFLOW ! 9622: {{MOV{ARPTR{R10{{LOAD OFFSET (ALSO PASS INDICATOR) ! 9623: {{BZE{R10{SAR05{{JUMP IF FIRST PASS ! 9624: * ! 9625: * HERE IN SECOND PASS TO STORE LBD AND DIM IN ARBLK ! 9626: * ! 9627: {{ADD{(SP){R10{{POINT TO CURRENT LOCATION IN ARBLK ! 9628: {{STI{4*CFP$I(R10){{{STORE DIMENSION ! 9629: {{LDI{ARSVL{{{LOAD LOW BOUND ! 9630: {{STI{(R10){{{STORE LOW BOUND ! 9631: {{ADD{#4*ARDMS{ARPTR{{BUMP OFFSET TO NEXT BOUNDS ! 9632: {{BRN{SAR06{{{JUMP TO CHECK FOR END OF BOUNDS ! 9633: * ! 9634: * HERE IN PASS 1 ! 9635: * ! 9636: {SAR05{ICV{ARCDM{{{BUMP DIMENSION COUNT ! 9637: {{MLI{ARNEL{{{MULTIPLY DIMENSION BY COUNT SO FAR ! 9638: {{IOV{SAR11{{{TOO LARGE IF OVERFLOW ! 9639: {{STI{ARNEL{{{ELSE STORE UPDATED ELEMENT COUNT ! 9640: * ! 9641: * MERGE HERE AFTER PROCESSING ONE SET OF BOUNDS ! 9642: * ! 9643: {SAR06{BNZ{R6{SAR03{{LOOP BACK UNLESS END OF BOUNDS ! 9644: {{BNZ{ARPTR{SAR09{{JUMP IF END OF PASS 2 ! 9645: {{EJC{{{{ ! 9646: * ! 9647: * ARRAY (CONTINUED) ! 9648: * ! 9649: * HERE AT END OF PASS ONE, BUILD ARBLK ! 9650: * ! 9651: {{LDI{ARNEL{{{GET NUMBER OF ELEMENTS ! 9652: {{MFI{R7{SAR11{{GET AS ADDR INTEGER, TEST OVFLO ! 9653: {{WTB{R7{{{ELSE CONVERT TO LENGTH IN BYTES ! 9654: {{MOV{#4*ARSI${R6{{SET SIZE OF STANDARD FIELDS ! 9655: {{LCT{R8{ARCDM{{SET DIMENSION COUNT TO CONTROL LOOP ! 9656: * ! 9657: * LOOP TO ALLOW SPACE FOR DIMENSIONS ! 9658: * ! 9659: {SAR07{ADD{#4*ARDMS{R6{{ALLOW SPACE FOR ONE SET OF BOUNDS ! 9660: {{BCT{R8{SAR07{{LOOP BACK TILL ALL ACCOUNTED FOR ! 9661: {{MOV{R6{R10{{SAVE SIZE (=AROFS) ! 9662: * ! 9663: * NOW ALLOCATE SPACE FOR ARBLK ! 9664: * ! 9665: {{ADD{R7{R6{{ADD SPACE FOR ELEMENTS ! 9666: {{ICA{R6{{{ALLOW FOR ARPRO PROTOTYPE FIELD ! 9667: {{BGE{R6{MXLEN{SAR11{FAIL IF TOO LARGE ! 9668: {{JSR{ALLOC{{{ELSE ALLOCATE ARBLK ! 9669: {{MOV{(SP){R7{{LOAD DEFAULT VALUE ! 9670: {{MOV{R9{(SP){{SAVE ARBLK POINTER ! 9671: {{MOV{R6{R8{{SAVE LENGTH IN BYTES ! 9672: {{BTW{R6{{{CONVERT LENGTH BACK TO WORDS ! 9673: {{LCT{R6{R6{{SET COUNTER TO CONTROL LOOP ! 9674: * ! 9675: * LOOP TO CLEAR ENTIRE ARBLK TO DEFAULT VALUE ! 9676: * ! 9677: {SAR08{MOV{R7{(R9)+{{SET ONE WORD ! 9678: {{BCT{R6{SAR08{{LOOP TILL ALL SET ! 9679: {{EJC{{{{ ! 9680: * ! 9681: * ARRAY (CONTINUED) ! 9682: * ! 9683: * NOW SET INITIAL FIELDS OF ARBLK ! 9684: * ! 9685: {{MOV{(SP)+{R9{{RELOAD ARBLK POINTER ! 9686: {{MOV{(SP){R7{{LOAD PROTOTYPE ! 9687: {{MOV{#B$ART{(R9){{SET TYPE WORD ! 9688: {{MOV{R8{4*ARLEN(R9){{STORE LENGTH IN BYTES ! 9689: {{ZER{4*IDVAL(R9){{{ZERO ID TILL WE GET IT BUILT ! 9690: {{MOV{R10{4*AROFS(R9){{SET PROTOTYPE FIELD PTR ! 9691: {{MOV{ARCDM{4*ARNDM(R9){{SET NUMBER OF DIMENSIONS ! 9692: {{MOV{R9{R8{{SAVE ARBLK POINTER ! 9693: {{ADD{R10{R9{{POINT TO PROTOTYPE FIELD ! 9694: {{MOV{R7{(R9){{STORE PROTOTYPE PTR IN ARBLK ! 9695: {{MOV{#4*ARLBD{ARPTR{{SET OFFSET FOR PASS 2 BOUNDS SCAN ! 9696: {{MOV{R7{R$XSC{{RESET STRING POINTER FOR XSCAN ! 9697: {{MOV{R8{(SP){{STORE ARBLK POINTER ON STACK ! 9698: {{ZER{XSOFS{{{RESET OFFSET PTR TO START OF STRING ! 9699: {{BRN{SAR03{{{JUMP BACK TO RESCAN BOUNDS ! 9700: * ! 9701: * HERE AFTER FILLING IN BOUNDS INFORMATION (END PASS TWO) ! 9702: * ! 9703: {SAR09{MOV{(SP)+{R9{{RELOAD POINTER TO ARBLK ! 9704: {{BRN{EXSID{{{EXIT SETTING IDVAL ! 9705: * ! 9706: * HERE FOR BAD DIMENSION ! 9707: * ! 9708: {SAR10{ERB{067{ARRAY{{DIMENSION IS ZERO,NEGATIVE OR OUT OF RANGE ! 9709: * ! 9710: * HERE IF ARRAY IS TOO LARGE ! 9711: * ! 9712: {SAR11{ERB{068{ARRAY{{SIZE EXCEEDS MAXIMUM PERMITTED ! 9713: {{EJC{{{{ ! 9714: * ! 9715: * BUFFER ! 9716: * ! 9717: {S$BUF{ENT{{{{ENTRY POINT ! 9718: {{MOV{(SP)+{R10{{GET INITIAL VALUE ! 9719: {{MOV{(SP)+{R9{{GET REQUESTED ALLOCATION ! 9720: {{JSR{GTINT{{{CONVERT TO INTEGER ! 9721: {{ERR{269{BUFFER{{FIRST ARGUMENT IS NOT INTEGER ! 9722: {{LDI{4*ICVAL(R9){{{GET VALUE ! 9723: {{ILE{SBF01{{{BRANCH IF NEGATIVE OR ZERO ! 9724: {{MFI{R6{SBF02{{MOVE WITH OVERFLOW CHECK ! 9725: {{JSR{ALOBF{{{ALLOCATE THE BUFFER ! 9726: {{JSR{APNDB{{{COPY IT IN ! 9727: {{ERR{270{BUFFER{{SECOND ARGUMENT IS NOT STRING OR BUFFER ! 9728: {{ERR{271{BUFFER{{INITIAL VALUE TOO BIG FOR ALLOCATION ! 9729: {{BRN{EXSID{{{EXIT SETTING IDVAL ! 9730: * ! 9731: * HERE FOR INVALID ALLOCATION SIZE ! 9732: * ! 9733: {SBF01{ERB{272{BUFFER{{FIRST ARGUMENT IS NOT POSITIVE ! 9734: * ! 9735: * HERE FOR ALLOCATION SIZE INTEGER OVERFLOW ! 9736: * ! 9737: {SBF02{ERB{273{BUFFER{{SIZE IS TOO BIG ! 9738: {{EJC{{{{ ! 9739: * ! 9740: * BREAK ! 9741: * ! 9742: {S$BRK{ENT{{{{ENTRY POINT ! 9743: {{MOV{#P$BKS{R7{{SET PCODE FOR SINGLE CHAR CASE ! 9744: {{MOV{#P$BRK{R10{{PCODE FOR MULTI-CHAR CASE ! 9745: {{MOV{#P$BKD{R8{{PCODE FOR EXPRESSION CASE ! 9746: {{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE ! 9747: {{ERR{069{BREAK{{ARGUMENT IS NOT STRING OR EXPRESSION ! 9748: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD ! 9749: {{EJC{{{{ ! 9750: * ! 9751: * BREAKX ! 9752: * ! 9753: * BREAKX IS A COMPOUND PATTERN. SEE DESCRIPTION AT START ! 9754: * OF PATTERN MATCHING SECTION FOR STRUCTURE FORMED. ! 9755: * ! 9756: {S$BKX{ENT{{{{ENTRY POINT ! 9757: {{MOV{#P$BKS{R7{{PCODE FOR SINGLE CHAR ARGUMENT ! 9758: {{MOV{#P$BRK{R10{{PCODE FOR MULTI-CHAR ARGUMENT ! 9759: {{MOV{#P$BXD{R8{{PCODE FOR EXPRESSION CASE ! 9760: {{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE ! 9761: {{ERR{070{BREAKX{{ARGUMENT IS NOT STRING OR EXPRESSION ! 9762: * ! 9763: * NOW HOOK BREAKX NODE ON AT FRONT END ! 9764: * ! 9765: {{MOV{R9{-(SP){{SAVE PTR TO BREAK NODE ! 9766: {{MOV{#P$BKX{R7{{SET PCODE FOR BREAKX NODE ! 9767: {{JSR{PBILD{{{BUILD IT ! 9768: {{MOV{(SP){4*PTHEN(R9){{SET BREAK NODE AS SUCCESSOR ! 9769: {{MOV{#P$ALT{R7{{SET PCODE FOR ALTERNATION NODE ! 9770: {{JSR{PBILD{{{BUILD (PARM1=ALT=BREAKX NODE) ! 9771: {{MOV{R9{R6{{SAVE PTR TO ALTERNATION NODE ! 9772: {{MOV{(SP){R9{{POINT TO BREAK NODE ! 9773: {{MOV{R6{4*PTHEN(R9){{SET ALTERNATE NODE AS SUCCESSOR ! 9774: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK ! 9775: {{EJC{{{{ ! 9776: * ! 9777: * CHAR ! 9778: * ! 9779: {S$CHR{ENT{{{{ENTRY POINT ! 9780: {{JSR{GTSMI{{{CONVERT ARG TO INTEGER ! 9781: {{ERR{281{CHAR{{ARGUMENT NOT INTEGER ! 9782: {{PPM{SCHR1{{{TOO BIG ERROR EXIT ! 9783: {{BGE{R8{#CFP$A{SCHR1{SEE IF OUT OF RANGE OF HOST SET ! 9784: {{MOV{#NUM01{R6{{IF NOT SET SCBLK ALLOCATION ! 9785: {{MOV{R8{R7{{SAVE CHAR CODE ! 9786: {{JSR{ALOCS{{{ALLOCATE 1 BAU SCBLK ! 9787: {{MOV{R9{R10{{COPY SCBLK POINTER ! 9788: {{PSC{R10{{{GET SET TO STUFF CHAR ! 9789: {{SCH{R7{(R10)+{{STUFF IT ! 9790: {{ZER{R10{{{CLEAR SLOP IN XL ! 9791: {{BRN{EXIXR{{{EXIT WITH SCBLK POINTER ! 9792: * ! 9793: * HERE IF CHAR ARGUMENT IS OUT OF RANGE ! 9794: * ! 9795: {SCHR1{ERB{282{CHAR{{ARGUMENT NOT IN RANGE ! 9796: {{EJC{{{{ ! 9797: * ! 9798: * CLEAR ! 9799: * ! 9800: {S$CLR{ENT{{{{ENTRY POINT ! 9801: {{JSR{XSCNI{{{INITIALIZE TO SCAN ARGUMENT ! 9802: {{ERR{071{CLEAR{{ARGUMENT IS NOT STRING ! 9803: {{PPM{SCLR2{{{JUMP IF NULL ! 9804: * ! 9805: * LOOP TO SCAN OUT NAMES IN FIRST ARGUMENT. VARIABLES IN ! 9806: * THE LIST ARE FALGGED BY SETTING VRGET OF VRBLK TO ZERO. ! 9807: * ! 9808: {SCLR1{MOV{#CH$CM{R8{{SET DELIMITER ONE = COMMA ! 9809: {{MOV{R8{R10{{DELIMITER TWO = COMMA ! 9810: {{JSR{XSCAN{{{SCAN NEXT VARIABLE NAME ! 9811: {{JSR{GTNVR{{{LOCATE VRBLK ! 9812: {{ERR{072{CLEAR{{ARGUMENT HAS NULL VARIABLE NAME ! 9813: {{ZER{4*VRGET(R9){{{ELSE FLAG BY ZEROING VRGET FIELD ! 9814: {{BNZ{R6{SCLR1{{LOOP BACK IF STOPPED BY COMMA ! 9815: * ! 9816: * HERE AFTER FLAGGING VARIABLES IN ARGUMENT LIST ! 9817: * ! 9818: {SCLR2{MOV{HSHTB{R7{{POINT TO START OF HASH TABLE ! 9819: * ! 9820: * LOOP THROUGH SLOTS IN HASH TABLE ! 9821: * ! 9822: {SCLR3{BEQ{R7{HSHTE{EXNUL{EXIT RETURNING NULL IF NONE LEFT ! 9823: {{MOV{R7{R9{{ELSE COPY SLOT POINTER ! 9824: {{ICA{R7{{{BUMP SLOT POINTER ! 9825: {{SUB{#4*VRNXT{R9{{SET OFFSET TO MERGE INTO LOOP ! 9826: * ! 9827: * LOOP THROUGH VRBLKS ON ONE HASH CHAIN ! 9828: * ! 9829: {SCLR4{MOV{4*VRNXT(R9){R9{{POINT TO NEXT VRBLK ON CHAIN ! 9830: {{BZE{R9{SCLR3{{JUMP FOR NEXT BUCKET IF CHAIN END ! 9831: {{BNZ{4*VRGET(R9){SCLR5{{JUMP IF NOT FLAGGED ! 9832: {{EJC{{{{ ! 9833: * ! 9834: * CLEAR (CONTINUED) ! 9835: * ! 9836: * HERE FOR FLAGGED VARIABLE, DO NOT SET VALUE TO NULL ! 9837: * ! 9838: {{JSR{SETVR{{{FOR FLAGGED VAR, RESTORE VRGET ! 9839: {{BRN{SCLR4{{{AND LOOP BACK FOR NEXT VRBLK ! 9840: * ! 9841: * HERE TO SET VALUE OF A VARIABLE TO NULL ! 9842: * PRROTECTED VARIABLES (ARB, ETC) ARE EXEMPT ! 9843: * ! 9844: {SCLR5{BEQ{4*VRSTO(R9){#B$VRE{SCLR4{CHECK FOR PROTECTED VARIABLE (REG05) ! 9845: {{MOV{R9{R10{{COPY VRBLK POINTER (REG05) ! 9846: * ! 9847: * LOOP TO LOCATE VALUE AT END OF POSSIBLE TRBLK CHAIN ! 9848: * ! 9849: {SCLR6{MOV{R10{R6{{SAVE BLOCK POINTER ! 9850: {{MOV{4*VRVAL(R10){R10{{LOAD NEXT VALUE FIELD ! 9851: {{BEQ{(R10){#B$TRT{SCLR6{LOOP BACK IF TRAPPED ! 9852: * ! 9853: * NOW STORE THE NULL VALUE ! 9854: * ! 9855: {{MOV{R6{R10{{RESTORE BLOCK POINTER ! 9856: {{MOV{#NULLS{4*VRVAL(R10){{STORE NULL CONSTANT VALUE ! 9857: {{BRN{SCLR4{{{LOOP BACK FOR NEXT VRBLK ! 9858: {{EJC{{{{ ! 9859: * ! 9860: * CODE ! 9861: * ! 9862: {S$COD{ENT{{{{ENTRY POINT ! 9863: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 9864: {{JSR{GTCOD{{{CONVERT TO CODE ! 9865: {{PPM{EXFAL{{{FAIL IF CONVERSION IS IMPOSSIBLE ! 9866: {{BRN{EXIXR{{{ELSE RETURN CODE AS RESULT ! 9867: {{EJC{{{{ ! 9868: * ! 9869: * COLLECT ! 9870: * ! 9871: {S$COL{ENT{{{{ENTRY POINT ! 9872: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 9873: {{JSR{GTINT{{{CONVERT TO INTEGER ! 9874: {{ERR{073{COLLECT{{ARGUMENT IS NOT INTEGER ! 9875: {{LDI{4*ICVAL(R9){{{LOAD COLLECT ARGUMENT ! 9876: {{STI{CLSVI{{{SAVE COLLECT ARGUMENT ! 9877: {{ZER{R7{{{SET NO MOVE UP ! 9878: {{JSR{GBCOL{{{PERFORM GARBAGE COLLECTION ! 9879: {{MOV{DNAME{R6{{POINT TO END OF MEMORY ! 9880: {{SUB{DNAMP{R6{{SUBTRACT NEXT LOCATION ! 9881: {{BTW{R6{{{CONVERT BYTES TO WORDS ! 9882: {{MTI{R6{{{CONVERT WORDS AVAILABLE AS INTEGER ! 9883: {{SBI{CLSVI{{{SUBTRACT ARGUMENT ! 9884: {{IOV{EXFAL{{{FAIL IF OVERFLOW ! 9885: {{ILT{EXFAL{{{FAIL IF NOT ENOUGH ! 9886: {{ADI{CLSVI{{{ELSE RECOMPUTE AVAILABLE ! 9887: {{BRN{EXINT{{{AND EXIT WITH INTEGER RESULT ! 9888: {{EJC{{{{ ! 9889: * ! 9890: * CONVERT ! 9891: * ! 9892: {S$CNV{ENT{{{{ENTRY POINT ! 9893: {{JSR{GTSTG{{{CONVERT SECOND ARGUMENT TO STRING ! 9894: {{ERR{074{CONVERT{{SECOND ARGUMENT IS NOT STRING ! 9895: {{JSR{FLSTG{{{FOLD LOWER CASE TO UPPER CASE ! 9896: {{MOV{(SP){R10{{LOAD FIRST ARGUMENT ! 9897: {{BNE{(R10){#B$PDT{SCV01{JUMP IF NOT PROGRAM DEFINED ! 9898: * ! 9899: * HERE FOR PROGRAM DEFINED DATATYPE ! 9900: * ! 9901: {{MOV{4*PDDFP(R10){R10{{POINT TO DFBLK ! 9902: {{MOV{4*DFNAM(R10){R10{{LOAD DATATYPE NAME ! 9903: {{JSR{IDENT{{{COMPARE WITH SECOND ARG ! 9904: {{PPM{EXITS{{{EXIT IF IDENT WITH ARG AS RESULT ! 9905: {{BRN{EXFAL{{{ELSE FAIL ! 9906: * ! 9907: * HERE IF NOT PROGRAM DEFINED DATATYPE ! 9908: * ! 9909: {SCV01{MOV{R9{-(SP){{SAVE STRING ARGUMENT ! 9910: {{MOV{#SVCTB{R10{{POINT TO TABLE OF NAMES TO COMPARE ! 9911: {{ZER{R7{{{INITIALIZE COUNTER ! 9912: {{MOV{R6{R8{{SAVE LENGTH OF ARGUMENT STRING ! 9913: * ! 9914: * LOOP THROUGH TABLE ENTRIES ! 9915: * ! 9916: {SCV02{MOV{(R10)+{R9{{LOAD NEXT TABLE ENTRY, BUMP POINTER ! 9917: {{BZE{R9{EXFAL{{FAIL IF ZERO MARKING END OF LIST ! 9918: {{BNE{R8{4*SCLEN(R9){SCV05{JUMP IF WRONG LENGTH ! 9919: {{MOV{R10{CNVTP{{ELSE STORE TABLE POINTER ! 9920: {{PLC{R9{{{POINT TO CHARS OF TABLE ENTRY ! 9921: {{MOV{(SP){R10{{LOAD POINTER TO STRING ARGUMENT ! 9922: {{PLC{R10{{{POINT TO CHARS OF STRING ARG ! 9923: {{MOV{R8{R6{{SET NUMBER OF CHARS TO COMPARE ! 9924: {{CMC{SCV04{SCV04{{COMPARE, JUMP IF NO MATCH ! 9925: {{EJC{{{{ ! 9926: * ! 9927: * CONVERT (CONTINUED) ! 9928: * ! 9929: * HERE WE HAVE A MATCH ! 9930: * ! 9931: {SCV03{MOV{R7{R10{{COPY ENTRY NUMBER ! 9932: {{ICA{SP{{{POP STRING ARG OFF STACK ! 9933: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT ! 9934: {{BSW{R10{CNVTT{{JUMP TO APPROPRIATE ROUTINE ! 9935: {{IFF{0{SCV06{{STRING ! 9936: {{IFF{1{SCV07{{INTEGER ! 9937: {{IFF{2{SCV09{{NAME ! 9938: {{IFF{3{SCV10{{PATTERN ! 9939: {{IFF{4{SCV11{{ARRAY ! 9940: {{IFF{5{SCV19{{TABLE ! 9941: {{IFF{6{SCV25{{EXPRESSION ! 9942: {{IFF{7{SCV26{{CODE ! 9943: {{IFF{8{SCV27{{NUMERIC ! 9944: {{IFF{CNVRT{SCV08{{REAL ! 9945: {{IFF{CNVBT{SCV28{{BUFFER ! 9946: {{ESW{{{{END OF SWITCH TABLE ! 9947: * ! 9948: * HERE IF NO MATCH WITH TABLE ENTRY ! 9949: * ! 9950: {SCV04{MOV{CNVTP{R10{{RESTORE TABLE POINTER, MERGE ! 9951: * ! 9952: * MERGE HERE IF LENGTHS DID NOT MATCH ! 9953: * ! 9954: {SCV05{ICV{R7{{{BUMP ENTRY NUMBER ! 9955: {{BRN{SCV02{{{LOOP BACK TO CHECK NEXT ENTRY ! 9956: * ! 9957: * HERE TO CONVERT TO STRING ! 9958: * ! 9959: {SCV06{MOV{R9{-(SP){{REPLACE STRING ARGUMENT ON STACK ! 9960: {{JSR{GTSTG{{{CONVERT TO STRING ! 9961: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE ! 9962: {{BRN{EXIXR{{{ELSE RETURN STRING ! 9963: {{EJC{{{{ ! 9964: * ! 9965: * CONVERT (CONTINUED) ! 9966: * ! 9967: * HERE TO CONVERT TO INTEGER ! 9968: * ! 9969: {SCV07{JSR{GTINT{{{CONVERT TO INTEGER ! 9970: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE ! 9971: {{BRN{EXIXR{{{ELSE RETURN INTEGER ! 9972: * ! 9973: * HERE TO CONVERT TO REAL ! 9974: * ! 9975: {SCV08{JSR{GTREA{{{CONVERT TO REAL ! 9976: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE ! 9977: {{BRN{EXIXR{{{ELSE RETURN REAL ! 9978: * ! 9979: * HERE TO CONVERT TO NAME ! 9980: * ! 9981: {SCV09{BEQ{(R9){#B$NML{EXIXR{RETURN IF ALREADY A NAME ! 9982: {{JSR{GTNVR{{{ELSE TRY STRING TO NAME CONVERT ! 9983: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE ! 9984: {{BRN{EXVNM{{{ELSE EXIT BUILDING NMBLK FOR VRBLK ! 9985: * ! 9986: * HERE TO CONVERT TO PATTERN ! 9987: * ! 9988: {SCV10{JSR{GTPAT{{{CONVERT TO PATTERN ! 9989: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE ! 9990: {{BRN{EXIXR{{{ELSE RETURN PATTERN ! 9991: * ! 9992: * CONVERT TO ARRAY ! 9993: * ! 9994: {SCV11{JSR{GTARR{{{GET AN ARRAY ! 9995: {{PPM{EXFAL{{{FAIL IF NOT CONVERTIBLE ! 9996: {{BRN{EXSID{{{EXIT SETTING ID FIELD ! 9997: * ! 9998: * CONVERT TO TABLE ! 9999: * ! 10000: {SCV19{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK ! 10001: {{MOV{R9{-(SP){{REPLACE ARBLK POINTER ON STACK ! 10002: {{BEQ{R6{#B$TBT{EXITS{RETURN ARG IF ALREADY A TABLE ! 10003: {{BNE{R6{#B$ART{EXFAL{ELSE FAIL IF NOT AN ARRAY ! 10004: {{EJC{{{{ ! 10005: * ! 10006: * CONVERT (CONTINUED) ! 10007: * ! 10008: * HERE TO CONVERT AN ARRAY TO TABLE ! 10009: * ! 10010: {{BNE{4*ARNDM(R9){#NUM02{EXFAL{FAIL IF NOT 2-DIM ARRAY ! 10011: {{LDI{4*ARDM2(R9){{{LOAD DIM 2 ! 10012: {{SBI{INTV2{{{SUBTRACT 2 TO COMPARE ! 10013: {{INE{EXFAL{{{FAIL IF DIM2 NOT 2 ! 10014: * ! 10015: * HERE WE HAVE AN ARBLK OF THE RIGHT SHAPE ! 10016: * ! 10017: {{LDI{4*ARDIM(R9){{{LOAD DIM 1 (NUMBER OF ELEMENTS) ! 10018: {{MFI{R6{{{GET AS ONE WORD INTEGER ! 10019: {{LCT{R7{R6{{COPY TO CONTROL LOOP ! 10020: {{ADD{#TBSI${R6{{ADD SPACE FOR STANDARD FIELDS ! 10021: {{WTB{R6{{{CONVERT LENGTH TO BYTES ! 10022: {{JSR{ALLOC{{{ALLOCATE SPACE FOR TBBLK ! 10023: {{MOV{R9{R8{{COPY TBBLK POINTER ! 10024: {{MOV{R9{-(SP){{SAVE TBBLK POINTER ! 10025: {{MOV{#B$TBT{(R9)+{{STORE TYPE WORD ! 10026: {{ZER{(R9)+{{{STORE ZERO FOR IDVAL FOR NOW ! 10027: {{MOV{R6{(R9)+{{STORE LENGTH ! 10028: {{MOV{#NULLS{(R9)+{{NULL INITIAL LOOKUP VALUE ! 10029: * ! 10030: * LOOP TO INITIALIZE BUCKET PTRS TO POINT TO TABLE ! 10031: * ! 10032: {SCV20{MOV{R8{(R9)+{{SET BUCKET PTR TO POINT TO TBBLK ! 10033: {{BCT{R7{SCV20{{LOOP TILL ALL INITIALIZED ! 10034: {{MOV{#4*ARVL2{R7{{SET OFFSET TO FIRST ARBLK ELEMENT ! 10035: * ! 10036: * LOOP TO COPY ELEMENTS FROM ARRAY TO TABLE ! 10037: * ! 10038: {SCV21{MOV{4*1(SP){R10{{POINT TO ARBLK ! 10039: {{BEQ{R7{4*ARLEN(R10){SCV24{JUMP IF ALL MOVED ! 10040: {{ADD{R7{R10{{ELSE POINT TO CURRENT LOCATION ! 10041: {{ADD{#4*NUM02{R7{{BUMP OFFSET ! 10042: {{MOV{(R10){R9{{LOAD SUBSCRIPT NAME ! 10043: {{DCA{R10{{{ADJUST PTR TO MERGE (TRVAL=1+1) ! 10044: {{EJC{{{{ ! 10045: * ! 10046: * CONVERT (CONTINUED) ! 10047: * ! 10048: * LOOP TO CHASE DOWN TRBLK CHAIN FOR VALUE ! 10049: * ! 10050: {SCV22{MOV{4*TRVAL(R10){R10{{POINT TO NEXT VALUE ! 10051: {{BEQ{(R10){#B$TRT{SCV22{LOOP BACK IF TRAPPED ! 10052: * ! 10053: * HERE WITH NAME IN XR, VALUE IN XL ! 10054: * ! 10055: {SCV23{MOV{R10{-(SP){{STACK VALUE ! 10056: {{MOV{4*1(SP){R10{{LOAD TBBLK POINTER ! 10057: {{JSR{TFIND{{{BUILD TEBLK (NOTE WB GT 0 BY NAME) ! 10058: {{PPM{EXFAL{{{FAIL IF ACESS FAILS ! 10059: {{MOV{(SP)+{4*TEVAL(R10){{STORE VALUE IN TEBLK ! 10060: {{BRN{SCV21{{{LOOP BACK FOR NEXT ELEMENT ! 10061: * ! 10062: * HERE AFTER MOVING ALL ELEMENTS TO TBBLK ! 10063: * ! 10064: {SCV24{MOV{(SP)+{R9{{LOAD TBBLK POINTER ! 10065: {{ICA{SP{{{POP ARBLK POINTER ! 10066: {{BRN{EXSID{{{EXIT SETTING IDVAL ! 10067: * ! 10068: * CONVERT TO EXPRESSION ! 10069: * ! 10070: {SCV25{JSR{GTEXP{{{CONVERT TO EXPRESSION ! 10071: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE ! 10072: {{BRN{EXIXR{{{ELSE RETURN EXPRESSION ! 10073: * ! 10074: * CONVERT TO CODE ! 10075: * ! 10076: {SCV26{JSR{GTCOD{{{CONVERT TO CODE ! 10077: {{PPM{EXFAL{{{FAIL IF CONVERSION IS NOT POSSIBLE ! 10078: {{BRN{EXIXR{{{ELSE RETURN CODE ! 10079: * ! 10080: * CONVERT TO NUMERIC ! 10081: * ! 10082: {SCV27{JSR{GTNUM{{{CONVERT TO NUMERIC ! 10083: {{PPM{EXFAL{{{FAIL IF UNCONVERTIBLE ! 10084: {{BRN{EXIXR{{{RETURN NUMBER ! 10085: {{EJC{{{{ ! 10086: * ! 10087: * CONVERT TO BUFFER ! 10088: * ! 10089: {SCV28{MOV{R9{-(SP){{STACK STRING FOR PROCEDURE ! 10090: {{JSR{GTSTG{{{CONVERT TO STRING ! 10091: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE ! 10092: {{MOV{R9{R10{{SAVE STRING POINTER ! 10093: {{JSR{ALOBF{{{ALLOCATE BUFFER OF SAME SIZE ! 10094: {{JSR{APNDB{{{COPY IN THE STRING ! 10095: {{PPM{{{{ALREADY STRING - CANT FAIL TO CNV ! 10096: {{PPM{{{{MUST BE ENOUGH ROOM ! 10097: {{BRN{EXSID{{{EXIT SETTING IDVAL FIELD ! 10098: {{EJC{{{{ ! 10099: * ! 10100: * COPY ! 10101: * ! 10102: {S$COP{ENT{{{{ENTRY POINT ! 10103: {{JSR{COPYB{{{COPY THE BLOCK ! 10104: {{PPM{EXITS{{{RETURN IF NO IDVAL FIELD ! 10105: {{BRN{EXSID{{{EXIT SETTING ID VALUE ! 10106: {{EJC{{{{ ! 10107: * ! 10108: * DATA ! 10109: * ! 10110: {S$DAT{ENT{{{{ENTRY POINT ! 10111: {{JSR{XSCNI{{{PREPARE TO SCAN ARGUMENT ! 10112: {{ERR{075{DATA{{ARGUMENT IS NOT STRING ! 10113: {{ERR{076{DATA{{ARGUMENT IS NULL ! 10114: * ! 10115: * SCAN OUT DATATYPE NAME ! 10116: * ! 10117: {{MOV{#CH$PP{R8{{DELIMITER ONE = LEFT PAREN ! 10118: {{MOV{R8{R10{{DELIMITER TWO = LEFT PAREN ! 10119: {{JSR{XSCAN{{{SCAN DATATYPE NAME ! 10120: {{BNZ{R6{SDAT1{{SKIP IF LEFT PAREN FOUND ! 10121: {{ERB{077{DATA{{ARGUMENT IS MISSING A LEFT PAREN ! 10122: * ! 10123: * HERE AFTER SCANNING DATATYPE NAME ! 10124: * ! 10125: {SDAT1{MOV{4*SCLEN(R9){R6{{GET LENGTH ! 10126: {{JSR{FLSTG{{{FOLD LOWER CASE TO UPPER CASE ! 10127: {{MOV{R9{R10{{SAVE NAME PTR ! 10128: {{MOV{4*SCLEN(R9){R6{{GET LENGTH ! 10129: {{CTB{R6{SCSI${{COMPUTE SPACE NEEDED ! 10130: {{JSR{ALOST{{{REQUEST STATIC STORE FOR NAME ! 10131: {{MOV{R9{-(SP){{SAVE DATATYPE NAME ! 10132: {{MVW{{{{COPY NAME TO STATIC ! 10133: {{MOV{(SP){R9{{GET NAME PTR ! 10134: {{ZER{R10{{{SCRUB DUD REGISTER ! 10135: {{JSR{GTNVR{{{LOCATE VRBLK FOR DATATYPE NAME ! 10136: {{ERR{078{DATA{{ARGUMENT HAS NULL DATATYPE NAME ! 10137: {{MOV{R9{DATDV{{SAVE VRBLK POINTER FOR DATATYPE ! 10138: {{MOV{SP{DATXS{{STORE STARTING STACK VALUE ! 10139: {{ZER{R7{{{ZERO COUNT OF FIELD NAMES ! 10140: * ! 10141: * LOOP TO SCAN FIELD NAMES AND STACK VRBLK POINTERS ! 10142: * ! 10143: {SDAT2{MOV{#CH$RP{R8{{DELIMITER ONE = RIGHT PAREN ! 10144: {{MOV{#CH$CM{R10{{DELIMITER TWO = COMMA ! 10145: {{JSR{XSCAN{{{SCAN NEXT FIELD NAME ! 10146: {{BNZ{R6{SDAT3{{JUMP IF DELIMITER FOUND ! 10147: {{ERB{079{DATA{{ARGUMENT IS MISSING A RIGHT PAREN ! 10148: * ! 10149: * HERE AFTER SCANNING OUT ONE FIELD NAME ! 10150: * ! 10151: {SDAT3{JSR{GTNVR{{{LOCATE VRBLK FOR FIELD NAME ! 10152: {{ERR{080{DATA{{ARGUMENT HAS NULL FIELD NAME ! 10153: {{MOV{R9{-(SP){{STACK VRBLK POINTER ! 10154: {{ICV{R7{{{INCREMENT COUNTER ! 10155: {{BEQ{R6{#NUM02{SDAT2{LOOP BACK IF STOPPED BY COMMA ! 10156: {{EJC{{{{ ! 10157: * ! 10158: * DATA (CONTINUED) ! 10159: * ! 10160: * NOW BUILD THE DFBLK ! 10161: * ! 10162: {{MOV{#DFSI${R6{{SET SIZE OF DFBLK STANDARD FIELDS ! 10163: {{ADD{R7{R6{{ADD NUMBER OF FIELDS ! 10164: {{WTB{R6{{{CONVERT LENGTH TO BYTES ! 10165: {{MOV{R7{R8{{PRESERVE NO. OF FIELDS ! 10166: {{JSR{ALOST{{{ALLOCATE SPACE FOR DFBLK ! 10167: {{MOV{R8{R7{{GET NO OF FIELDS ! 10168: {{MOV{DATXS{R10{{POINT TO START OF STACK ! 10169: {{MOV{(R10){R8{{LOAD DATATYPE NAME ! 10170: {{MOV{R9{(R10){{SAVE DFBLK POINTER ON STACK ! 10171: {{MOV{#B$DFC{(R9)+{{STORE TYPE WORD ! 10172: {{MOV{R7{(R9)+{{STORE NUMBER OF FIELDS (FARGS) ! 10173: {{MOV{R6{(R9)+{{STORE LENGTH (DFLEN) ! 10174: {{SUB{#4*PDDFS{R6{{COMPUTE PDBLK LENGTH (FOR DFPDL) ! 10175: {{MOV{R6{(R9)+{{STORE PDBLK LENGTH (DFPDL) ! 10176: {{MOV{R8{(R9)+{{STORE DATATYPE NAME (DFNAM) ! 10177: {{LCT{R8{R7{{COPY NUMBER OF FIELDS ! 10178: * ! 10179: * LOOP TO MOVE FIELD NAME VRBLK POINTERS TO DFBLK ! 10180: * ! 10181: {SDAT4{MOV{-(R10){(R9)+{{MOVE ONE FIELD NAME VRBLK POINTER ! 10182: {{BCT{R8{SDAT4{{LOOP TILL ALL MOVED ! 10183: * ! 10184: * NOW DEFINE THE DATATYPE FUNCTION ! 10185: * ! 10186: {{MOV{R6{R8{{COPY LENGTH OF PDBLK FOR LATER LOOP ! 10187: {{MOV{DATDV{R9{{POINT TO VRBLK ! 10188: {{MOV{DATXS{R10{{POINT BACK ON STACK ! 10189: {{MOV{(R10){R10{{LOAD DFBLK POINTER ! 10190: {{JSR{DFFNC{{{DEFINE FUNCTION ! 10191: {{EJC{{{{ ! 10192: * ! 10193: * DATA (CONTINUED) ! 10194: * ! 10195: * LOOP TO BUILD FFBLKS ! 10196: * ! 10197: * ! 10198: * NOTICE THAT THE FFBLKS ARE CONSTRUCTED IN REVERSE ORDER ! 10199: * SO THAT THE REQUIRED OFFSETS CAN BE OBTAINED FROM ! 10200: * SUCCESSIVE DECREMENTATION OF THE PDBLK LENGTH (IN WC). ! 10201: * ! 10202: {SDAT5{MOV{#4*FFSI${R6{{SET LENGTH OF FFBLK ! 10203: {{JSR{ALLOC{{{ALLOCATE SPACE FOR FFBLK ! 10204: {{MOV{#B$FFC{(R9){{SET TYPE WORD ! 10205: {{MOV{#NUM01{4*FARGS(R9){{STORE FARGS (ALWAYS ONE) ! 10206: {{MOV{DATXS{R10{{POINT BACK ON STACK ! 10207: {{MOV{(R10){4*FFDFP(R9){{COPY DFBLK PTR TO FFBLK ! 10208: {{DCA{R8{{{DECREMENT OLD DFPDL TO GET NEXT OFS ! 10209: {{MOV{R8{4*FFOFS(R9){{SET OFFSET TO THIS FIELD ! 10210: {{ZER{4*FFNXT(R9){{{TENTATIVELY SET ZERO FORWARD PTR ! 10211: {{MOV{R9{R10{{COPY FFBLK POINTER FOR DFFNC ! 10212: {{MOV{(SP){R9{{LOAD VRBLK POINTER FOR FIELD ! 10213: {{MOV{4*VRFNC(R9){R9{{LOAD CURRENT FUNCTION POINTER ! 10214: {{BNE{(R9){#B$FFC{SDAT6{SKIP IF NOT CURRENTLY A FIELD FUNC ! 10215: * ! 10216: * HERE WE MUST CHAIN AN OLD FFBLK PTR TO PRESERVE IT IN THE ! 10217: * CASE OF MULTIPLE FIELD FUNCTIONS WITH THE SAME NAME ! 10218: * ! 10219: {{MOV{R9{4*FFNXT(R10){{LINK NEW FFBLK TO PREVIOUS CHAIN ! 10220: * ! 10221: * MERGE HERE TO DEFINE FIELD FUNCTION ! 10222: * ! 10223: {SDAT6{MOV{(SP)+{R9{{LOAD VRBLK POINTER ! 10224: {{JSR{DFFNC{{{DEFINE FIELD FUNCTION ! 10225: {{BNE{SP{DATXS{SDAT5{LOOP BACK TILL ALL DONE ! 10226: {{ICA{SP{{{POP DFBLK POINTER ! 10227: {{BRN{EXNUL{{{RETURN WITH NULL RESULT ! 10228: {{EJC{{{{ ! 10229: * ! 10230: * DATATYPE ! 10231: * ! 10232: {S$DTP{ENT{{{{ENTRY POINT ! 10233: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 10234: {{JSR{DTYPE{{{GET DATATYPE ! 10235: {{BRN{EXIXR{{{AND RETURN IT AS RESULT ! 10236: {{EJC{{{{ ! 10237: * ! 10238: * DATE ! 10239: * ! 10240: {S$DTE{ENT{{{{ENTRY POINT ! 10241: {{JSR{SYSDT{{{CALL SYSTEM DATE ROUTINE ! 10242: {{MOV{4*1(R10){R6{{LOAD LENGTH FOR SBSTR ! 10243: {{BZE{R6{EXNUL{{RETURN NULL IF LENGTH IS ZERO ! 10244: {{ZER{R7{{{SET ZERO OFFSET ! 10245: {{JSR{SBSTR{{{USE SBSTR TO BUILD SCBLK ! 10246: {{BRN{EXIXR{{{RETURN DATE STRING ! 10247: {{EJC{{{{ ! 10248: * ! 10249: * DEFINE ! 10250: * ! 10251: {S$DEF{ENT{{{{ENTRY POINT ! 10252: {{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT ! 10253: {{ZER{DEFLB{{{ZERO LABEL POINTER IN CASE NULL ! 10254: {{BEQ{R9{#NULLS{SDF01{JUMP IF NULL SECOND ARGUMENT ! 10255: {{JSR{GTNVR{{{ELSE FIND VRBLK FOR LABEL ! 10256: {{PPM{SDF13{{{JUMP IF NOT A VARIABLE NAME ! 10257: {{MOV{R9{DEFLB{{ELSE SET SPECIFIED ENTRY ! 10258: * ! 10259: * SCAN FUNCTION NAME ! 10260: * ! 10261: {SDF01{JSR{XSCNI{{{PREPARE TO SCAN FIRST ARGUMENT ! 10262: {{ERR{081{DEFINE{{FIRST ARGUMENT IS NOT STRING ! 10263: {{ERR{082{DEFINE{{FIRST ARGUMENT IS NULL ! 10264: {{MOV{#CH$PP{R8{{DELIMITER ONE = LEFT PAREN ! 10265: {{MOV{R8{R10{{DELIMITER TWO = LEFT PAREN ! 10266: {{JSR{XSCAN{{{SCAN OUT FUNCTION NAME ! 10267: {{BNZ{R6{SDF02{{JUMP IF LEFT PAREN FOUND ! 10268: {{ERB{083{DEFINE{{FIRST ARGUMENT IS MISSING A LEFT PAREN ! 10269: * ! 10270: * HERE AFTER SCANNING OUT FUNCTION NAME ! 10271: * ! 10272: {SDF02{JSR{GTNVR{{{GET VARIABLE NAME ! 10273: {{ERR{084{DEFINE{{FIRST ARGUMENT HAS NULL FUNCTION NAME ! 10274: {{MOV{R9{DEFVR{{SAVE VRBLK POINTER FOR FUNCTION NAM ! 10275: {{ZER{R7{{{ZERO COUNT OF ARGUMENTS ! 10276: {{MOV{SP{DEFXS{{SAVE INITIAL STACK POINTER ! 10277: {{BNZ{DEFLB{SDF03{{JUMP IF SECOND ARGUMENT GIVEN ! 10278: {{MOV{R9{DEFLB{{ELSE DEFAULT IS FUNCTION NAME ! 10279: * ! 10280: * LOOP TO SCAN ARGUMENT NAMES AND STACK VRBLK POINTERS ! 10281: * ! 10282: {SDF03{MOV{#CH$RP{R8{{DELIMITER ONE = RIGHT PAREN ! 10283: {{MOV{#CH$CM{R10{{DELIMITER TWO = COMMA ! 10284: {{JSR{XSCAN{{{SCAN OUT NEXT ARGUMENT NAME ! 10285: {{BNZ{R6{SDF04{{SKIP IF DELIMITER FOUND ! 10286: {{ERB{085{NULL{{ARG NAME OR MISSING ) IN DEFINE FIRST ARG. ! 10287: {{EJC{{{{ ! 10288: * ! 10289: * DEFINE (CONTINUED) ! 10290: * ! 10291: * HERE AFTER SCANNING AN ARGUMENT NAME ! 10292: * ! 10293: {SDF04{BNE{R9{#NULLS{SDF05{SKIP IF NON-NULL ! 10294: {{BZE{R7{SDF06{{IGNORE NULL IF CASE OF NO ARGUMENTS ! 10295: * ! 10296: * HERE AFTER DEALING WITH THE CASE OF NO ARGUMENTS ! 10297: * ! 10298: {SDF05{JSR{GTNVR{{{GET VRBLK POINTER ! 10299: {{PPM{SDF03{{{LOOP BACK TO IGNORE NULL NAME ! 10300: {{MOV{R9{-(SP){{STACK ARGUMENT VRBLK POINTER ! 10301: {{ICV{R7{{{INCREMENT COUNTER ! 10302: {{BEQ{R6{#NUM02{SDF03{LOOP BACK IF STOPPED BY A COMMA ! 10303: * ! 10304: * HERE AFTER SCANNING OUT FUNCTION ARGUMENT NAMES ! 10305: * ! 10306: {SDF06{MOV{R7{DEFNA{{SAVE NUMBER OF ARGUMENTS ! 10307: {{ZER{R7{{{ZERO COUNT OF LOCALS ! 10308: * ! 10309: * LOOP TO SCAN LOCAL NAMES AND STACK VRBLK POINTERS ! 10310: * ! 10311: {SDF07{MOV{#CH$CM{R8{{SET DELIMITER ONE = COMMA ! 10312: {{MOV{R8{R10{{SET DELIMITER TWO = COMMA ! 10313: {{JSR{XSCAN{{{SCAN OUT NEXT LOCAL NAME ! 10314: {{BNE{R9{#NULLS{SDF08{SKIP IF NON-NULL ! 10315: {{BZE{R7{SDF09{{IGNORE NULL IF CASE OF NO LOCALS ! 10316: * ! 10317: * HERE AFTER SCANNING OUT A LOCAL NAME ! 10318: * ! 10319: {SDF08{JSR{GTNVR{{{GET VRBLK POINTER ! 10320: {{PPM{SDF07{{{LOOP BACK TO IGNORE NULL NAME ! 10321: {{ICV{R7{{{IF OK, INCREMENT COUNT ! 10322: {{MOV{R9{-(SP){{STACK VRBLK POINTER ! 10323: {{BNZ{R6{SDF07{{LOOP BACK IF STOPPED BY A COMMA ! 10324: {{EJC{{{{ ! 10325: * ! 10326: * DEFINE (CONTINUED) ! 10327: * ! 10328: * HERE AFTER SCANNING LOCALS, BUILD PFBLK ! 10329: * ! 10330: {SDF09{MOV{R7{R6{{COPY COUNT OF LOCALS ! 10331: {{ADD{DEFNA{R6{{ADD NUMBER OF ARGUMENTS ! 10332: {{MOV{R6{R8{{SET SUM ARGS+LOCALS AS LOOP COUNT ! 10333: {{ADD{#PFSI${R6{{ADD SPACE FOR STANDARD FIELDS ! 10334: {{WTB{R6{{{CONVERT LENGTH TO BYTES ! 10335: {{JSR{ALLOC{{{ALLOCATE SPACE FOR PFBLK ! 10336: {{MOV{R9{R10{{SAVE POINTER TO PFBLK ! 10337: {{MOV{#B$PFC{(R9)+{{STORE FIRST WORD ! 10338: {{MOV{DEFNA{(R9)+{{STORE NUMBER OF ARGUMENTS ! 10339: {{MOV{R6{(R9)+{{STORE LENGTH (PFLEN) ! 10340: {{MOV{DEFVR{(R9)+{{STORE VRBLK PTR FOR FUNCTION NAME ! 10341: {{MOV{R7{(R9)+{{STORE NUMBER OF LOCALS ! 10342: {{ZER{(R9)+{{{DEAL WITH LABEL LATER ! 10343: {{ZER{(R9)+{{{ZERO PFCTR ! 10344: {{ZER{(R9)+{{{ZERO PFRTR ! 10345: {{BZE{R8{SDF11{{SKIP IF NO ARGS OR LOCALS ! 10346: {{MOV{R10{R6{{KEEP PFBLK POINTER ! 10347: {{MOV{DEFXS{R10{{POINT BEFORE ARGUMENTS ! 10348: {{LCT{R8{R8{{GET COUNT OF ARGS+LOCALS FOR LOOP ! 10349: * ! 10350: * LOOP TO MOVE LOCALS AND ARGS TO PFBLK ! 10351: * ! 10352: {SDF10{MOV{-(R10){(R9)+{{STORE ONE ENTRY AND BUMP POINTERS ! 10353: {{BCT{R8{SDF10{{LOOP TILL ALL STORED ! 10354: {{MOV{R6{R10{{RECOVER PFBLK POINTER ! 10355: {{EJC{{{{ ! 10356: * ! 10357: * DEFINE (CONTINUED) ! 10358: * ! 10359: * NOW DEAL WITH LABEL ! 10360: * ! 10361: {SDF11{MOV{DEFXS{SP{{POP STACK ! 10362: {{MOV{DEFLB{R9{{POINT TO VRBLK FOR LABEL ! 10363: {{MOV{4*VRLBL(R9){R9{{LOAD LABEL POINTER ! 10364: {{BNE{(R9){#B$TRT{SDF12{SKIP IF NOT TRAPPED ! 10365: {{MOV{4*TRLBL(R9){R9{{ELSE POINT TO REAL LABEL ! 10366: * ! 10367: * HERE AFTER LOCATING REAL LABEL POINTER ! 10368: * ! 10369: {SDF12{BEQ{R9{#STNDL{SDF13{JUMP IF LABEL IS NOT DEFINED ! 10370: {{MOV{R9{4*PFCOD(R10){{ELSE STORE LABEL POINTER ! 10371: {{MOV{DEFVR{R9{{POINT BACK TO VRBLK FOR FUNCTION ! 10372: {{JSR{DFFNC{{{DEFINE FUNCTION ! 10373: {{BRN{EXNUL{{{AND EXIT RETURNING NULL ! 10374: * ! 10375: * HERE FOR ERRONEOUS LABEL ! 10376: * ! 10377: {SDF13{ERB{086{DEFINE{{FUNCTION ENTRY POINT IS NOT DEFINED LABEL ! 10378: {{EJC{{{{ ! 10379: * ! 10380: * DETACH ! 10381: * ! 10382: {S$DET{ENT{{{{ENTRY POINT ! 10383: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 10384: {{JSR{GTVAR{{{LOCATE VARIABLE ! 10385: {{ERR{087{DETACH{{ARGUMENT IS NOT APPROPRIATE NAME ! 10386: {{JSR{DTACH{{{DETACH I/O ASSOCIATION FROM NAME ! 10387: {{BRN{EXNUL{{{RETURN NULL RESULT ! 10388: {{EJC{{{{ ! 10389: * ! 10390: * DIFFER ! 10391: * ! 10392: {S$DIF{ENT{{{{ENTRY POINT ! 10393: {{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT ! 10394: {{MOV{(SP)+{R10{{LOAD FIRST ARGUMENT ! 10395: {{JSR{IDENT{{{CALL IDENT COMPARISON ROUTINE ! 10396: {{PPM{EXFAL{{{FAIL IF IDENT ! 10397: {{BRN{EXNUL{{{RETURN NULL IF DIFFER ! 10398: {{EJC{{{{ ! 10399: * ! 10400: * DUMP ! 10401: * ! 10402: {S$DMP{ENT{{{{ENTRY POINT ! 10403: {{JSR{GTSMI{{{LOAD DUMP ARG AS SMALL INTEGER ! 10404: {{ERR{088{DUMP{{ARGUMENT IS NOT INTEGER ! 10405: {{ERR{089{DUMP{{ARGUMENT IS NEGATIVE OR TOO LARGE ! 10406: {{JSR{DUMPR{{{ELSE CALL DUMP ROUTINE ! 10407: {{BRN{EXNUL{{{AND RETURN NULL AS RESULT ! 10408: {{EJC{{{{ ! 10409: * ! 10410: * DUPL ! 10411: * ! 10412: {S$DUP{ENT{{{{ENTRY POINT ! 10413: {{JSR{GTSMI{{{GET SECOND ARGUMENT AS SMALL INTEGE ! 10414: {{ERR{090{DUPL{{SECOND ARGUMENT IS NOT INTEGER ! 10415: {{PPM{SDUP7{{{JUMP IF NEGATIVE OT TOO BIG ! 10416: {{MOV{R9{R7{{SAVE DUPLICATION FACTOR ! 10417: {{JSR{GTSTG{{{GET FIRST ARG AS STRING ! 10418: {{PPM{SDUP4{{{JUMP IF NOT A STRING ! 10419: * ! 10420: * HERE FOR CASE OF DUPLICATION OF A STRING ! 10421: * ! 10422: {{MTI{R6{{{ACQUIRE LENGTH AS INTEGER ! 10423: {{STI{DUPSI{{{SAVE FOR THE MOMENT ! 10424: {{MTI{R7{{{GET DUPLICATION FACTOR AS INTEGER ! 10425: {{MLI{DUPSI{{{FORM PRODUCT ! 10426: {{IOV{SDUP3{{{JUMP IF OVERFLOW ! 10427: {{IEQ{EXNUL{{{RETURN NULL IF RESULT LENGTH = 0 ! 10428: {{MFI{R6{SDUP3{{GET AS ADDR INTEGER, CHECK OVFLO ! 10429: * ! 10430: * MERGE HERE WITH RESULT LENGTH IN WA ! 10431: * ! 10432: {SDUP1{MOV{R9{R10{{SAVE STRING POINTER ! 10433: {{JSR{ALOCS{{{ALLOCATE SPACE FOR STRING ! 10434: {{MOV{R9{-(SP){{SAVE AS RESULT POINTER ! 10435: {{MOV{R10{R8{{SAVE POINTER TO ARGUMENT STRING ! 10436: {{PSC{R9{{{PREPARE TO STORE CHARS OF RESULT ! 10437: {{LCT{R7{R7{{SET COUNTER TO CONTROL LOOP ! 10438: * ! 10439: * LOOP THROUGH DUPLICATIONS ! 10440: * ! 10441: {SDUP2{MOV{R8{R10{{POINT BACK TO ARGUMENT STRING ! 10442: {{MOV{4*SCLEN(R10){R6{{GET NUMBER OF CHARACTERS ! 10443: {{PLC{R10{{{POINT TO CHARS IN ARGUMENT STRING ! 10444: {{MVC{{{{MOVE CHARACTERS TO RESULT STRING ! 10445: {{BCT{R7{SDUP2{{LOOP TILL ALL DUPLICATIONS DONE ! 10446: {{BRN{EXITS{{{THEN EXIT FOR NEXT CODE WORD ! 10447: {{EJC{{{{ ! 10448: * ! 10449: * DUPL (CONTINUED) ! 10450: * ! 10451: * HERE IF TOO LARGE, SET MAX LENGTH AND LET ALOCS CATCH IT ! 10452: * ! 10453: {SDUP3{MOV{DNAME{R6{{SET IMPOSSIBLE LENGTH FOR ALOCS ! 10454: {{BRN{SDUP1{{{MERGE BACK ! 10455: * ! 10456: * HERE IF NOT A STRING ! 10457: * ! 10458: {SDUP4{JSR{GTPAT{{{CONVERT ARGUMENT TO PATTERN ! 10459: {{ERR{091{DUPL{{FIRST ARGUMENT IS NOT STRING OR PATTERN ! 10460: * ! 10461: * HERE TO DUPLICATE A PATTERN ARGUMENT ! 10462: * ! 10463: {{MOV{R9{-(SP){{STORE PATTERN ON STACK ! 10464: {{MOV{#NDNTH{R9{{START OFF WITH NULL PATTERN ! 10465: {{BZE{R7{SDUP6{{NULL PATTERN IS RESULT IF DUPFAC=0 ! 10466: {{MOV{R7{-(SP){{PRESERVE LOOP COUNT ! 10467: * ! 10468: * LOOP TO DUPLICATE BY SUCCESSIVE CONCATENATION ! 10469: * ! 10470: {SDUP5{MOV{R9{R10{{COPY CURRENT VALUE AS RIGHT ARGUMNT ! 10471: {{MOV{4*1(SP){R9{{GET A NEW COPY OF LEFT ! 10472: {{JSR{PCONC{{{CONCATENATE ! 10473: {{DCV{(SP){{{COUNT DOWN ! 10474: {{BNZ{(SP){SDUP5{{LOOP ! 10475: {{ICA{SP{{{POP LOOP COUNT ! 10476: * ! 10477: * HERE TO EXIT AFTER CONSTRUCTING PATTERN ! 10478: * ! 10479: {SDUP6{MOV{R9{(SP){{STORE RESULT ON STACK ! 10480: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK ! 10481: * ! 10482: * FAIL IF SECOND ARG IS OUT OF RANGE ! 10483: * ! 10484: {SDUP7{ICA{SP{{{POP FIRST ARGUMENT ! 10485: {{BRN{EXFAL{{{FAIL ! 10486: {{EJC{{{{ ! 10487: * ! 10488: * EJECT ! 10489: * ! 10490: {S$EJC{ENT{{{{ENTRY POINT ! 10491: {{JSR{IOFCB{{{CALL FCBLK ROUTINE ! 10492: {{ERR{092{EJECT{{ARGUMENT IS NOT A SUITABLE NAME ! 10493: {{PPM{SEJC1{{{NULL ARGUMENT ! 10494: {{JSR{SYSEF{{{CALL EJECT FILE FUNCTION ! 10495: {{ERR{093{EJECT{{FILE DOES NOT EXIST ! 10496: {{ERR{094{EJECT{{FILE DOES NOT PERMIT PAGE EJECT ! 10497: {{ERR{095{EJECT{{CAUSED NON-RECOVERABLE OUTPUT ERROR ! 10498: {{BRN{EXNUL{{{RETURN NULL AS RESULT ! 10499: * ! 10500: * HERE TO EJECT STANDARD OUTPUT FILE ! 10501: * ! 10502: {SEJC1{JSR{SYSEP{{{CALL ROUTINE TO EJECT PRINTER ! 10503: {{BRN{EXNUL{{{EXIT WITH NULL RESULT ! 10504: {{EJC{{{{ ! 10505: * ! 10506: * ENDFILE ! 10507: * ! 10508: {S$ENF{ENT{{{{ENTRY POINT ! 10509: {{JSR{IOFCB{{{CALL FCBLK ROUTINE ! 10510: {{ERR{096{ENDFILE{{ARGUMENT IS NOT A SUITABLE NAME ! 10511: {{ERR{097{ENDFILE{{ARGUMENT IS NULL ! 10512: {{JSR{SYSEN{{{CALL ENDFILE ROUTINE ! 10513: {{ERR{098{ENDFILE{{FILE DOES NOT EXIST ! 10514: {{ERR{099{ENDFILE{{FILE DOES NOT PERMIT ENDFILE ! 10515: {{ERR{100{ENDFILE{{CAUSED NON-RECOVERABLE OUTPUT ERROR ! 10516: {{MOV{R10{R7{{REMEMBER VRBLK PTR FROM IOFCB CALL ! 10517: * ! 10518: * LOOP TO FIND TRTRF BLOCK ! 10519: * ! 10520: {SENF1{MOV{R10{R9{{COPY POINTER ! 10521: {{MOV{4*TRVAL(R9){R9{{CHAIN ALONG ! 10522: {{BNE{(R9){#B$TRT{EXNUL{SKIP OUT IF CHAIN END ! 10523: {{BNE{4*TRTYP(R9){#TRTFC{SENF1{LOOP IF NOT FOUND ! 10524: {{MOV{4*TRVAL(R9){4*TRVAL(R10){{REMOVE TRTRF ! 10525: {{MOV{4*TRTRF(R9){ENFCH{{POINT TO HEAD OF IOCHN ! 10526: {{MOV{4*TRFPT(R9){R8{{POINT TO FCBLK ! 10527: {{MOV{R7{R9{{FILEARG1 VRBLK FROM IOFCB ! 10528: {{JSR{SETVR{{{RESET IT ! 10529: {{MOV{#R$FCB{R10{{PTR TO HEAD OF FCBLK CHAIN ! 10530: {{SUB{#4*NUM02{R10{{ADJUST READY TO ENTER LOOP ! 10531: * ! 10532: * FIND FCBLK ! 10533: * ! 10534: {SENF2{MOV{R10{R9{{COPY PTR ! 10535: {{MOV{4*2(R10){R10{{GET NEXT LINK ! 10536: {{BZE{R10{SENF4{{STOP IF CHAIN END ! 10537: {{BEQ{4*3(R10){R8{SENF3{JUMP IF FCBLK FOUND ! 10538: {{BRN{SENF2{{{LOOP ! 10539: * ! 10540: * REMOVE FCBLK ! 10541: * ! 10542: {SENF3{MOV{4*2(R10){4*2(R9){{DELETE FCBLK FROM CHAIN ! 10543: * ! 10544: * LOOP WHICH DETACHES ALL VBLS ON IOCHN CHAIN ! 10545: * ! 10546: {SENF4{MOV{ENFCH{R10{{GET CHAIN HEAD ! 10547: {{BZE{R10{EXNUL{{FINISHED IF CHAIN END ! 10548: {{MOV{4*TRTRF(R10){ENFCH{{CHAIN ALONG ! 10549: {{MOV{4*IONMO(R10){R6{{NAME OFFSET ! 10550: {{MOV{4*IONMB(R10){R10{{NAME BASE ! 10551: {{JSR{DTACH{{{DETACH NAME ! 10552: {{BRN{SENF4{{{LOOP TILL DONE ! 10553: {{EJC{{{{ ! 10554: * ! 10555: * EQ ! 10556: * ! 10557: {S$EQF{ENT{{{{ENTRY POINT ! 10558: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE ! 10559: {{ERR{101{EQ{{FIRST ARGUMENT IS NOT NUMERIC ! 10560: {{ERR{102{EQ{{SECOND ARGUMENT IS NOT NUMERIC ! 10561: {{PPM{EXFAL{{{FAIL IF LT ! 10562: {{PPM{EXNUL{{{RETURN NULL IF EQ ! 10563: {{PPM{EXFAL{{{FAIL IF GT ! 10564: {{EJC{{{{ ! 10565: * ! 10566: * EVAL ! 10567: * ! 10568: {S$EVL{ENT{{{{ENTRY POINT ! 10569: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 10570: {{JSR{GTEXP{{{CONVERT TO EXPRESSION ! 10571: {{ERR{103{EVAL{{ARGUMENT IS NOT EXPRESSION ! 10572: {{LCW{R8{{{LOAD NEXT CODE WORD ! 10573: {{BNE{R8{#OFNE${SEVL1{JUMP IF CALLED BY VALUE ! 10574: {{SCP{R10{{{COPY CODE POINTER ! 10575: {{MOV{(R10){R6{{GET NEXT CODE WORD ! 10576: {{BNE{R6{#ORNM${SEVL2{BY NAME UNLESS EXPRESSION ! 10577: {{BNZ{4*1(SP){SEVL2{{JUMP IF BY NAME ! 10578: * ! 10579: * HERE IF CALLED BY VALUE ! 10580: * ! 10581: {SEVL1{ZER{R7{{{SET FLAG FOR BY VALUE ! 10582: {{MOV{R8{-(SP){{SAVE CODE WORD ! 10583: {{JSR{EVALX{{{EVALUATE EXPRESSION BY VALUE ! 10584: {{PPM{EXFAL{{{FAIL IF EVALUATION FAILS ! 10585: {{MOV{R9{R10{{COPY RESULT ! 10586: {{MOV{(SP){R9{{RELOAD NEXT CODE WORD ! 10587: {{MOV{R10{(SP){{STACK RESULT ! 10588: {{BRI{(R9){{{JUMP TO EXECUTE NEXT CODE WORD ! 10589: * ! 10590: * HERE IF CALLED BY NAME ! 10591: * ! 10592: {SEVL2{MOV{#NUM01{R7{{SET FLAG FOR BY NAME ! 10593: {{JSR{EVALX{{{EVALUATE EXPRESSION BY NAME ! 10594: {{PPM{EXFAL{{{FAIL IF EVALUATION FAILS ! 10595: {{BRN{EXNAM{{{EXIT WITH NAME ! 10596: {{EJC{{{{ ! 10597: * ! 10598: * EXIT ! 10599: * ! 10600: {S$EXT{ENT{{{{ENTRY POINT ! 10601: {{ZER{R7{{{CLEAR AMOUNT OF STATIC SHIFT ! 10602: {{JSR{GBCOL{{{COMPACT MEMORY BY COLLECTING ! 10603: {{JSR{GTSTG{{{CONVERT ARG TO STRING ! 10604: {{ERR{104{EXIT{{ARGUMENT IS NOT SUITABLE INTEGER OR STRING ! 10605: {{MOV{R9{R10{{COPY STRING PTR ! 10606: {{JSR{GTINT{{{CHECK IT IS INTEGER ! 10607: {{PPM{SEXT1{{{SKIP IF UNCONVERTIBLE ! 10608: {{ZER{R10{{{NOTE IT IS INTEGER ! 10609: {{LDI{4*ICVAL(R9){{{GET INTEGER ARG ! 10610: {{MOV{R$FCB{R7{{GET FCBLK CHAIN HEADER ! 10611: * ! 10612: * MERGE TO CALL OSINT EXIT ROUTINE ! 10613: * ! 10614: {SEXT1{MOV{#HEADV{R9{{POINT TO V.V STRING ! 10615: {{JSR{SYSXI{{{CALL EXTERNAL ROUTINE ! 10616: {{ERR{105{EXIT{{ACTION NOT AVAILABLE IN THIS IMPLEMENTATION ! 10617: {{ERR{106{EXIT{{ACTION CAUSED IRRECOVERABLE ERROR ! 10618: {{IEQ{EXNUL{{{RETURN IF ARGUMENT 0 ! 10619: {{ZER{GBCNT{{{RESUMING EXECUTION SO RESET ! 10620: {{IGT{SEXT2{{{SKIP IF POSITIVE ! 10621: {{NGI{{{{MAKE POSITIVE ! 10622: * ! 10623: * CHECK FOR OPTION RESPECIFICATION ! 10624: * ! 10625: {SEXT2{MFI{R8{{{GET VALUE IN WORK REG ! 10626: {{BEQ{R8{#NUM03{SEXT3{SKIP IF WAS 3 ! 10627: {{MOV{R8{-(SP){{SAVE VALUE ! 10628: {{ZER{R8{{{SET TO READ OPTIONS ! 10629: {{JSR{PRPAR{{{READ SYSPP OPTIONS ! 10630: {{MOV{(SP)+{R8{{RESTORE VALUE ! 10631: * ! 10632: * DEAL WITH HEADER OPTION (FIDDLED BY PRPAR) ! 10633: * ! 10634: {SEXT3{MNZ{HEADP{{{ASSUME NO HEADERS ! 10635: {{BNE{R8{#NUM01{SEXT4{SKIP IF NOT 1 ! 10636: {{ZER{HEADP{{{REQUEST HEADER PRINTING ! 10637: * ! 10638: * ALMOST READY TO RESUME RUNNING ! 10639: * ! 10640: {SEXT4{JSR{SYSTM{{{GET EXECUTION TIME START (SGD11) ! 10641: {{STI{TIMSX{{{SAVE AS INITIAL TIME ! 10642: {{LDI{KVSTC{{{RESET TO ENSURE ... ! 10643: {{STI{KVSTL{{{... CORRECT EXECUTION STATS ! 10644: {{BRN{EXNUL{{{RESUME EXECUTION ! 10645: {{EJC{{{{ ! 10646: * ! 10647: * FIELD ! 10648: * ! 10649: {S$FLD{ENT{{{{ENTRY POINT ! 10650: {{JSR{GTSMI{{{GET SECOND ARGUMENT (FIELD NUMBER) ! 10651: {{ERR{107{FIELD{{SECOND ARGUMENT IS NOT INTEGER ! 10652: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE ! 10653: {{MOV{R9{R7{{ELSE SAVE INTEGER VALUE ! 10654: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT ! 10655: {{JSR{GTNVR{{{POINT TO VRBLK ! 10656: {{PPM{SFLD1{{{JUMP (ERROR) IF NOT VARIABLE NAME ! 10657: {{MOV{4*VRFNC(R9){R9{{ELSE POINT TO FUNCTION BLOCK ! 10658: {{BNE{(R9){#B$DFC{SFLD1{ERROR IF NOT DATATYPE FUNCTION ! 10659: * ! 10660: * HERE IF FIRST ARGUMENT IS A DATATYPE FUNCTION NAME ! 10661: * ! 10662: {{BZE{R7{EXFAL{{FAIL IF ARGUMENT NUMBER IS ZERO ! 10663: {{BGT{R7{4*FARGS(R9){EXFAL{FAIL IF TOO LARGE ! 10664: {{WTB{R7{{{ELSE CONVERT TO BYTE OFFSET ! 10665: {{ADD{R7{R9{{POINT TO FIELD NAME ! 10666: {{MOV{4*DFFLB(R9){R9{{LOAD VRBLK POINTER ! 10667: {{BRN{EXVNM{{{EXIT TO BUILD NMBLK ! 10668: * ! 10669: * HERE FOR BAD FIRST ARGUMENT ! 10670: * ! 10671: {SFLD1{ERB{108{FIELD{{FIRST ARGUMENT IS NOT DATATYPE NAME ! 10672: {{EJC{{{{ ! 10673: * ! 10674: * FENCE ! 10675: * ! 10676: {S$FNC{ENT{{{{ENTRY POINT ! 10677: {{MOV{#P$FNC{R7{{SET PCODE FOR P$FNC ! 10678: {{ZER{R9{{{P0BLK ! 10679: {{JSR{PBILD{{{BUILD P$FNC NODE ! 10680: {{MOV{R9{R10{{SAVE POINTER TO IT ! 10681: {{MOV{(SP)+{R9{{GET ARGUMENT ! 10682: {{JSR{GTPAT{{{CONVERT TO PATTERN ! 10683: {{ERR{259{FENCE{{ARGUMENT IS NOT PATTERN ! 10684: {{JSR{PCONC{{{CONCATENATE TO P$FNC NODE ! 10685: {{MOV{R9{R10{{SAVE PTR TO CONCATENATED PATTERN ! 10686: {{MOV{#P$FNA{R7{{SET FOR P$FNA PCODE ! 10687: {{ZER{R9{{{P0BLK ! 10688: {{JSR{PBILD{{{CONSTRUCT P$FNA NODE ! 10689: {{MOV{R10{4*PTHEN(R9){{SET PATTERN AS PTHEN ! 10690: {{MOV{R9{-(SP){{SET AS RESULT ! 10691: {{BRN{EXITS{{{DO NEXT CODE WORD ! 10692: {{EJC{{{{ ! 10693: * ! 10694: * GE ! 10695: * ! 10696: {S$GEF{ENT{{{{ENTRY POINT ! 10697: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE ! 10698: {{ERR{109{GE{{FIRST ARGUMENT IS NOT NUMERIC ! 10699: {{ERR{110{GE{{SECOND ARGUMENT IS NOT NUMERIC ! 10700: {{PPM{EXFAL{{{FAIL IF LT ! 10701: {{PPM{EXNUL{{{RETURN NULL IF EQ ! 10702: {{PPM{EXNUL{{{RETURN NULL IF GT ! 10703: {{EJC{{{{ ! 10704: * ! 10705: * GT ! 10706: * ! 10707: {S$GTF{ENT{{{{ENTRY POINT ! 10708: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE ! 10709: {{ERR{111{GT{{FIRST ARGUMENT IS NOT NUMERIC ! 10710: {{ERR{112{GT{{SECOND ARGUMENT IS NOT NUMERIC ! 10711: {{PPM{EXFAL{{{FAIL IF LT ! 10712: {{PPM{EXFAL{{{FAIL IF EQ ! 10713: {{PPM{EXNUL{{{RETURN NULL IF GT ! 10714: {{EJC{{{{ ! 10715: * ! 10716: * HOST ! 10717: * ! 10718: {S$HST{ENT{{{{ENTRY POINT ! 10719: {{MOV{(SP)+{R9{{GET THIRD ARG ! 10720: {{MOV{(SP)+{R10{{GET SECOND ARG ! 10721: {{MOV{(SP)+{R6{{GET FIRST ARG ! 10722: {{JSR{SYSHS{{{ENTER SYSHS ROUTINE ! 10723: {{ERR{254{ERRONEOUS{{ARGUMENT FOR HOST ! 10724: {{ERR{255{ERROR{{DURING EXECUTION OF HOST ! 10725: {{PPM{SHST1{{{STORE HOST STRING ! 10726: {{PPM{EXNUL{{{RETURN NULL RESULT ! 10727: {{PPM{EXIXR{{{RETURN XR ! 10728: {{PPM{EXFAL{{{FAIL RETURN ! 10729: * ! 10730: * RETURN HOST STRING ! 10731: * ! 10732: {SHST1{BZE{R10{EXNUL{{NULL STRING IF SYSHS UNCOOPERATIVE ! 10733: {{MOV{4*SCLEN(R10){R6{{LENGTH ! 10734: {{ZER{R7{{{ZERO OFFSET ! 10735: {{JSR{SBSTR{{{BUILD COPY OF STRING ! 10736: {{MOV{R9{-(SP){{STACK THE RESULT ! 10737: {{BRN{EXITS{{{RETURN RESULT ON STACK ! 10738: {{EJC{{{{ ! 10739: * ! 10740: * IDENT ! 10741: * ! 10742: {S$IDN{ENT{{{{ENTRY POINT ! 10743: {{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT ! 10744: {{MOV{(SP)+{R10{{LOAD FIRST ARGUMENT ! 10745: {{JSR{IDENT{{{CALL IDENT COMPARISON ROUTINE ! 10746: {{PPM{EXNUL{{{RETURN NULL IF IDENT ! 10747: {{BRN{EXFAL{{{FAIL IF DIFFER ! 10748: {{EJC{{{{ ! 10749: * ! 10750: * INPUT ! 10751: * ! 10752: {S$INP{ENT{{{{ENTRY POINT ! 10753: {{ZER{R7{{{INPUT FLAG ! 10754: {{JSR{IOPUT{{{CALL INPUT/OUTPUT ASSOC. ROUTINE ! 10755: {{ERR{113{INPUT{{THIRD ARGUMENT IS NOT A STRING ! 10756: {{ERR{114{INAPPROPRIATE{{SECOND ARGUMENT FOR INPUT ! 10757: {{ERR{115{INAPPROPRIATE{{FIRST ARGUMENT FOR INPUT ! 10758: {{ERR{116{INAPPROPRIATE{{FILE SPECIFICATION FOR INPUT ! 10759: {{PPM{EXFAL{{{FAIL IF FILE DOES NOT EXIST ! 10760: {{ERR{117{INPUT{{FILE CANNOT BE READ ! 10761: {{BRN{EXNUL{{{RETURN NULL STRING ! 10762: {{EJC{{{{ ! 10763: * ! 10764: * INSERT ! 10765: * ! 10766: {S$INS{ENT{{{{ENTRY POINT ! 10767: {{MOV{(SP)+{R10{{GET STRING ARG ! 10768: {{JSR{GTSMI{{{GET REPLACE LENGTH ! 10769: {{ERR{277{INSERT{{THIRD ARGUMENT NOT INTEGER ! 10770: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE ! 10771: {{MOV{R8{R7{{COPY TO PROPER REG ! 10772: {{JSR{GTSMI{{{GET REPLACE POSITION ! 10773: {{ERR{278{INSERT{{SECOND ARGUMENT NOT INTEGER ! 10774: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE ! 10775: {{BZE{R8{EXFAL{{FAIL IF ZERO ! 10776: {{DCV{R8{{{DECREMENT TO GET OFFSET ! 10777: {{MOV{R8{R6{{PUT IN PROPER REGISTER ! 10778: {{MOV{(SP)+{R9{{GET BUFFER ! 10779: {{BEQ{(R9){#B$BCT{SINS1{PRESS ON IF TYPE OK ! 10780: {{ERB{279{INSERT{{FIRST ARGUMENT NOT BUFFER ! 10781: * ! 10782: * HERE WHEN EVERYTHING LOADED UP ! 10783: * ! 10784: {SINS1{JSR{INSBF{{{CALL TO INSERT ! 10785: {{ERR{280{INSERT{{FOURTH ARGUMENT NOT A STRING ! 10786: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE ! 10787: {{BRN{EXNUL{{{ELSE OK - EXIT WITH NULL ! 10788: {{EJC{{{{ ! 10789: * ! 10790: * INTEGER ! 10791: * ! 10792: {S$INT{ENT{{{{ENTRY POINT ! 10793: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 10794: {{JSR{GTNUM{{{CONVERT TO NUMERIC ! 10795: {{PPM{EXFAL{{{FAIL IF NON-NUMERIC ! 10796: {{BEQ{R6{#B$ICL{EXNUL{RETURN NULL IF INTEGER ! 10797: {{BRN{EXFAL{{{FAIL IF REAL ! 10798: {{EJC{{{{ ! 10799: * ! 10800: * ITEM ! 10801: * ! 10802: * ITEM DOES NOT PERMIT THE DIRECT (FAST) CALL SO THAT ! 10803: * WA CONTAINS THE ACTUAL NUMBER OF ARGUMENTS PASSED. ! 10804: * ! 10805: {S$ITM{ENT{{{{ENTRY POINT ! 10806: * ! 10807: * DEAL WITH CASE OF NO ARGS ! 10808: * ! 10809: {{BNZ{R6{SITM1{{JUMP IF AT LEAST ONE ARG ! 10810: {{MOV{#NULLS{-(SP){{ELSE SUPPLY GARBAGE NULL ARG ! 10811: {{MOV{#NUM01{R6{{AND FIX ARGUMENT COUNT ! 10812: * ! 10813: * CHECK FOR NAME/VALUE CASES ! 10814: * ! 10815: {SITM1{SCP{R9{{{GET CURRENT CODE POINTER ! 10816: {{MOV{(R9){R10{{LOAD NEXT CODE WORD ! 10817: {{DCV{R6{{{GET NUMBER OF SUBSCRIPTS ! 10818: {{MOV{R6{R9{{COPY FOR ARREF ! 10819: {{BEQ{R10{#OFNE${SITM2{JUMP IF CALLED BY NAME ! 10820: * ! 10821: * HERE IF CALLED BY VALUE ! 10822: * ! 10823: {{ZER{R7{{{SET CODE FOR CALL BY VALUE ! 10824: {{BRN{ARREF{{{OFF TO ARRAY REFERENCE ROUTINE ! 10825: * ! 10826: * HERE FOR CALL BY NAME ! 10827: * ! 10828: {SITM2{MNZ{R7{{{SET CODE FOR CALL BY NAME ! 10829: {{LCW{R6{{{LOAD AND IGNORE OFNE$ CALL ! 10830: {{BRN{ARREF{{{OFF TO ARRAY REFERENCE ROUTINE ! 10831: {{EJC{{{{ ! 10832: * ! 10833: * LE ! 10834: * ! 10835: {S$LEF{ENT{{{{ENTRY POINT ! 10836: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE ! 10837: {{ERR{118{LE{{FIRST ARGUMENT IS NOT NUMERIC ! 10838: {{ERR{119{LE{{SECOND ARGUMENT IS NOT NUMERIC ! 10839: {{PPM{EXNUL{{{RETURN NULL IF LT ! 10840: {{PPM{EXNUL{{{RETURN NULL IF EQ ! 10841: {{PPM{EXFAL{{{FAIL IF GT ! 10842: {{EJC{{{{ ! 10843: * ! 10844: * LEN ! 10845: * ! 10846: {S$LEN{ENT{{{{ENTRY POINT ! 10847: {{MOV{#P$LEN{R7{{SET PCODE FOR INTEGER ARG CASE ! 10848: {{MOV{#P$LND{R6{{SET PCODE FOR EXPR ARG CASE ! 10849: {{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE ! 10850: {{ERR{120{LEN{{ARGUMENT IS NOT INTEGER OR EXPRESSION ! 10851: {{ERR{121{LEN{{ARGUMENT IS NEGATIVE OR TOO LARGE ! 10852: {{BRN{EXIXR{{{RETURN PATTERN NODE ! 10853: {{EJC{{{{ ! 10854: * ! 10855: * LEQ ! 10856: * ! 10857: {S$LEQ{ENT{{{{ENTRY POINT ! 10858: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE ! 10859: {{ERR{122{LEQ{{FIRST ARGUMENT IS NOT STRING ! 10860: {{ERR{123{LEQ{{SECOND ARGUMENT IS NOT STRING ! 10861: {{PPM{EXFAL{{{FAIL IF LLT ! 10862: {{PPM{EXNUL{{{RETURN NULL IF LEQ ! 10863: {{PPM{EXFAL{{{FAIL IF LGT ! 10864: {{EJC{{{{ ! 10865: * ! 10866: * LGE ! 10867: * ! 10868: {S$LGE{ENT{{{{ENTRY POINT ! 10869: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE ! 10870: {{ERR{124{LGE{{FIRST ARGUMENT IS NOT STRING ! 10871: {{ERR{125{LGE{{SECOND ARGUMENT IS NOT STRING ! 10872: {{PPM{EXFAL{{{FAIL IF LLT ! 10873: {{PPM{EXNUL{{{RETURN NULL IF LEQ ! 10874: {{PPM{EXNUL{{{RETURN NULL IF LGT ! 10875: {{EJC{{{{ ! 10876: * ! 10877: * LGT ! 10878: * ! 10879: {S$LGT{ENT{{{{ENTRY POINT ! 10880: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE ! 10881: {{ERR{126{LGT{{FIRST ARGUMENT IS NOT STRING ! 10882: {{ERR{127{LGT{{SECOND ARGUMENT IS NOT STRING ! 10883: {{PPM{EXFAL{{{FAIL IF LLT ! 10884: {{PPM{EXFAL{{{FAIL IF LEQ ! 10885: {{PPM{EXNUL{{{RETURN NULL IF LGT ! 10886: {{EJC{{{{ ! 10887: * ! 10888: * LLE ! 10889: * ! 10890: {S$LLE{ENT{{{{ENTRY POINT ! 10891: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE ! 10892: {{ERR{128{LLE{{FIRST ARGUMENT IS NOT STRING ! 10893: {{ERR{129{LLE{{SECOND ARGUMENT IS NOT STRING ! 10894: {{PPM{EXNUL{{{RETURN NULL IF LLT ! 10895: {{PPM{EXNUL{{{RETURN NULL IF LEQ ! 10896: {{PPM{EXFAL{{{FAIL IF LGT ! 10897: {{EJC{{{{ ! 10898: * ! 10899: * LLT ! 10900: * ! 10901: {S$LLT{ENT{{{{ENTRY POINT ! 10902: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE ! 10903: {{ERR{130{LLT{{FIRST ARGUMENT IS NOT STRING ! 10904: {{ERR{131{LLT{{SECOND ARGUMENT IS NOT STRING ! 10905: {{PPM{EXNUL{{{RETURN NULL IF LLT ! 10906: {{PPM{EXFAL{{{FAIL IF LEQ ! 10907: {{PPM{EXFAL{{{FAIL IF LGT ! 10908: {{EJC{{{{ ! 10909: * ! 10910: * LNE ! 10911: * ! 10912: {S$LNE{ENT{{{{ENTRY POINT ! 10913: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE ! 10914: {{ERR{132{LNE{{FIRST ARGUMENT IS NOT STRING ! 10915: {{ERR{133{LNE{{SECOND ARGUMENT IS NOT STRING ! 10916: {{PPM{EXNUL{{{RETURN NULL IF LLT ! 10917: {{PPM{EXFAL{{{FAIL IF LEQ ! 10918: {{PPM{EXNUL{{{RETURN NULL IF LGT ! 10919: {{EJC{{{{ ! 10920: * ! 10921: * LOCAL ! 10922: * ! 10923: {S$LOC{ENT{{{{ENTRY POINT ! 10924: {{JSR{GTSMI{{{GET SECOND ARGUMENT (LOCAL NUMBER) ! 10925: {{ERR{134{LOCAL{{SECOND ARGUMENT IS NOT INTEGER ! 10926: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE ! 10927: {{MOV{R9{R7{{SAVE LOCAL NUMBER ! 10928: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT ! 10929: {{JSR{GTNVR{{{POINT TO VRBLK ! 10930: {{PPM{SLOC1{{{JUMP IF NOT VARIABLE NAME ! 10931: {{MOV{4*VRFNC(R9){R9{{ELSE LOAD FUNCTION POINTER ! 10932: {{BNE{(R9){#B$PFC{SLOC1{JUMP IF NOT PROGRAM DEFINED ! 10933: * ! 10934: * HERE IF WE HAVE A PROGRAM DEFINED FUNCTION NAME ! 10935: * ! 10936: {{BZE{R7{EXFAL{{FAIL IF SECOND ARG IS ZERO ! 10937: {{BGT{R7{4*PFNLO(R9){EXFAL{OR TOO LARGE ! 10938: {{ADD{4*FARGS(R9){R7{{ELSE ADJUST OFFSET TO INCLUDE ARGS ! 10939: {{WTB{R7{{{CONVERT TO BYTES ! 10940: {{ADD{R7{R9{{POINT TO LOCAL POINTER ! 10941: {{MOV{4*PFAGB(R9){R9{{LOAD VRBLK POINTER ! 10942: {{BRN{EXVNM{{{EXIT BUILDING NMBLK ! 10943: * ! 10944: * HERE IF FIRST ARGUMENT IS NO GOOD ! 10945: * ! 10946: {SLOC1{ERB{135{LOCAL{{FIRST ARG IS NOT A PROGRAM FUNCTION NAME ! 10947: {{EJC{{{{ ! 10948: * ! 10949: * LOAD ! 10950: * ! 10951: {S$LOD{ENT{{{{ENTRY POINT ! 10952: {{JSR{GTSTG{{{LOAD LIBRARY NAME ! 10953: {{ERR{136{LOAD{{SECOND ARGUMENT IS NOT STRING ! 10954: {{MOV{R9{R10{{SAVE LIBRARY NAME ! 10955: {{JSR{XSCNI{{{PREPARE TO SCAN FIRST ARGUMENT ! 10956: {{ERR{137{LOAD{{FIRST ARGUMENT IS NOT STRING ! 10957: {{ERR{138{LOAD{{FIRST ARGUMENT IS NULL ! 10958: {{MOV{R10{-(SP){{STACK LIBRARY NAME ! 10959: {{MOV{#CH$PP{R8{{SET DELIMITER ONE = LEFT PAREN ! 10960: {{MOV{R8{R10{{SET DELIMITER TWO = LEFT PAREN ! 10961: {{JSR{XSCAN{{{SCAN FUNCTION NAME ! 10962: {{MOV{R9{-(SP){{SAVE PTR TO FUNCTION NAME ! 10963: {{BNZ{R6{SLOD1{{JUMP IF LEFT PAREN FOUND ! 10964: {{ERB{139{LOAD{{FIRST ARGUMENT IS MISSING A LEFT PAREN ! 10965: * ! 10966: * HERE AFTER SUCCESSFULLY SCANNING FUNCTION NAME ! 10967: * ! 10968: {SLOD1{JSR{GTNVR{{{LOCATE VRBLK ! 10969: {{ERR{140{LOAD{{FIRST ARGUMENT HAS NULL FUNCTION NAME ! 10970: {{MOV{R9{LODFN{{SAVE VRBLK POINTER ! 10971: {{ZER{LODNA{{{ZERO COUNT OF ARGUMENTS ! 10972: * ! 10973: * LOOP TO SCAN ARGUMENT DATATYPE NAMES ! 10974: * ! 10975: {SLOD2{MOV{#CH$RP{R8{{DELIMITER ONE IS RIGHT PAREN ! 10976: {{MOV{#CH$CM{R10{{DELIMITER TWO IS COMMA ! 10977: {{JSR{XSCAN{{{SCAN NEXT ARGUMENT NAME ! 10978: {{ICV{LODNA{{{BUMP ARGUMENT COUNT ! 10979: {{BNZ{R6{SLOD3{{JUMP IF OK DELIMITER WAS FOUND ! 10980: {{ERB{141{LOAD{{FIRST ARGUMENT IS MISSING A RIGHT PAREN ! 10981: {{EJC{{{{ ! 10982: * ! 10983: * LOAD (CONTINUED) ! 10984: * ! 10985: * COME HERE TO ANALYZE THE DATATYPE POINTER IN (XR). THIS ! 10986: * CODE IS USED BOTH FOR ARGUMENTS (WA=1,2) AND FOR THE ! 10987: * RESULT DATATYPE (WITH WA SET TO ZERO). ! 10988: * ! 10989: {SLOD3{MOV{R9{-(SP){{STACK DATATYPE NAME POINTER ! 10990: {{MOV{#NUM01{R7{{SET STRING CODE IN CASE ! 10991: {{MOV{#SCSTR{R10{{POINT TO /STRING/ ! 10992: {{JSR{IDENT{{{CHECK FOR MATCH ! 10993: {{PPM{SLOD4{{{JUMP IF MATCH ! 10994: {{MOV{(SP){R9{{ELSE RELOAD NAME ! 10995: {{ADD{R7{R7{{SET CODE FOR INTEGER (2) ! 10996: {{MOV{#SCINT{R10{{POINT TO /INTEGER/ ! 10997: {{JSR{IDENT{{{CHECK FOR MATCH ! 10998: {{PPM{SLOD4{{{JUMP IF MATCH ! 10999: {{MOV{(SP){R9{{ELSE RELOAD STRING POINTER ! 11000: {{ICV{R7{{{SET CODE FOR REAL (3) ! 11001: {{MOV{#SCREA{R10{{POINT TO /REAL/ ! 11002: {{JSR{IDENT{{{CHECK FOR MATCH ! 11003: {{PPM{SLOD4{{{JUMP IF MATCH ! 11004: {{ZER{R7{{{ELSE GET CODE FOR NO CONVERT ! 11005: * ! 11006: * MERGE HERE WITH PROPER DATATYPE CODE IN WB ! 11007: * ! 11008: {SLOD4{MOV{R7{(SP){{STORE CODE ON STACK ! 11009: {{BEQ{R6{#NUM02{SLOD2{LOOP BACK IF ARG STOPPED BY COMMA ! 11010: {{BZE{R6{SLOD5{{JUMP IF THAT WAS THE RESULT TYPE ! 11011: * ! 11012: * HERE WE SCAN OUT THE RESULT TYPE (ARG STOPPED BY ) ) ! 11013: * ! 11014: {{MOV{MXLEN{R8{{SET DUMMY (IMPOSSIBLE) DELIMITER 1 ! 11015: {{MOV{R8{R10{{AND DELIMITER TWO ! 11016: {{JSR{XSCAN{{{SCAN RESULT NAME ! 11017: {{ZER{R6{{{SET CODE FOR PROCESSING RESULT ! 11018: {{BRN{SLOD3{{{JUMP BACK TO PROCESS RESULT NAME ! 11019: {{EJC{{{{ ! 11020: * ! 11021: * LOAD (CONTINUED) ! 11022: * ! 11023: * HERE AFTER PROCESSING ALL ARGS AND RESULT ! 11024: * ! 11025: {SLOD5{MOV{LODNA{R6{{GET NUMBER OF ARGUMENTS ! 11026: {{MOV{R6{R8{{COPY FOR LATER ! 11027: {{WTB{R6{{{CONVERT LENGTH TO BYTES ! 11028: {{ADD{#4*EFSI${R6{{ADD SPACE FOR STANDARD FIELDS ! 11029: {{JSR{ALLOC{{{ALLOCATE EFBLK ! 11030: {{MOV{#B$EFC{(R9){{SET TYPE WORD ! 11031: {{MOV{R8{4*FARGS(R9){{SET NUMBER OF ARGUMENTS ! 11032: {{ZER{4*EFUSE(R9){{{SET USE COUNT (DFFNC WILL SET TO 1) ! 11033: {{ZER{4*EFCOD(R9){{{ZERO CODE POINTER FOR NOW ! 11034: {{MOV{(SP)+{4*EFRSL(R9){{STORE RESULT TYPE CODE ! 11035: {{MOV{LODFN{4*EFVAR(R9){{STORE FUNCTION VRBLK POINTER ! 11036: {{MOV{R6{4*EFLEN(R9){{STORE EFBLK LENGTH ! 11037: {{MOV{R9{R7{{SAVE EFBLK POINTER ! 11038: {{ADD{R6{R9{{POINT PAST END OF EFBLK ! 11039: {{LCT{R8{R8{{SET NUMBER OF ARGUMENTS FOR LOOP ! 11040: * ! 11041: * LOOP TO SET ARGUMENT TYPE CODES FROM STACK ! 11042: * ! 11043: {SLOD6{MOV{(SP)+{-(R9){{STORE ONE TYPE CODE FROM STACK ! 11044: {{BCT{R8{SLOD6{{LOOP TILL ALL STORED ! 11045: * ! 11046: * NOW LOAD THE EXTERNAL FUNCTION AND PERFORM DEFINITION ! 11047: * ! 11048: {{MOV{(SP)+{R9{{LOAD FUNCTION STRING NAME ! 11049: {{MOV{(SP){R10{{LOAD LIBRARY NAME ! 11050: {{MOV{R7{(SP){{STORE EFBLK POINTER ! 11051: {{JSR{SYSLD{{{CALL FUNCTION TO LOAD EXTERNAL FUNC ! 11052: {{ERR{142{LOAD{{FUNCTION DOES NOT EXIST ! 11053: {{ERR{143{LOAD{{FUNCTION CAUSED INPUT ERROR DURING LOAD ! 11054: {{MOV{(SP)+{R10{{RECALL EFBLK POINTER ! 11055: {{MOV{R9{4*EFCOD(R10){{STORE CODE POINTER ! 11056: {{MOV{LODFN{R9{{POINT TO VRBLK FOR FUNCTION ! 11057: {{JSR{DFFNC{{{PERFORM FUNCTION DEFINITION ! 11058: {{BRN{EXNUL{{{RETURN NULL RESULT ! 11059: {{EJC{{{{ ! 11060: * ! 11061: * LPAD ! 11062: * ! 11063: {S$LPD{ENT{{{{ENTRY POINT ! 11064: {{JSR{GTSTG{{{GET PAD CHARACTER ! 11065: {{ERR{144{LPAD{{THIRD ARGUMENT NOT A STRING ! 11066: {{PLC{R9{{{POINT TO CHARACTER (NULL IS BLANK) ! 11067: {{LCH{R7{(R9){{LOAD PAD CHARACTER ! 11068: {{JSR{GTSMI{{{GET PAD LENGTH ! 11069: {{ERR{145{LPAD{{SECOND ARGUMENT IS NOT INTEGER ! 11070: {{PPM{SLPD3{{{SKIP IF NEGATIVE OR LARGE ! 11071: * ! 11072: * MERGE TO CHECK FIRST ARG ! 11073: * ! 11074: {SLPD1{JSR{GTSTG{{{GET FIRST ARGUMENT (STRING TO PAD) ! 11075: {{ERR{146{LPAD{{FIRST ARGUMENT IS NOT STRING ! 11076: {{BGE{R6{R8{EXIXR{RETURN 1ST ARG IF TOO LONG TO PAD ! 11077: {{MOV{R9{R10{{ELSE MOVE PTR TO STRING TO PAD ! 11078: * ! 11079: * NOW WE ARE READY FOR THE PAD ! 11080: * ! 11081: * (XL) POINTER TO STRING TO PAD ! 11082: * (WB) PAD CHARACTER ! 11083: * (WC) LENGTH TO PAD STRING TO ! 11084: * ! 11085: {{MOV{R8{R6{{COPY LENGTH ! 11086: {{JSR{ALOCS{{{ALLOCATE SCBLK FOR NEW STRING ! 11087: {{MOV{R9{-(SP){{SAVE AS RESULT ! 11088: {{MOV{4*SCLEN(R10){R6{{LOAD LENGTH OF ARGUMENT ! 11089: {{SUB{R6{R8{{CALCULATE NUMBER OF PAD CHARACTERS ! 11090: {{PSC{R9{{{POINT TO CHARS IN RESULT STRING ! 11091: {{LCT{R8{R8{{SET COUNTER FOR PAD LOOP ! 11092: * ! 11093: * LOOP TO PERFORM PAD ! 11094: * ! 11095: {SLPD2{SCH{R7{(R9)+{{STORE PAD CHARACTER, BUMP PTR ! 11096: {{BCT{R8{SLPD2{{LOOP TILL ALL PAD CHARS STORED ! 11097: {{CSC{R9{{{COMPLETE STORE CHARACTERS ! 11098: * ! 11099: * NOW COPY STRING ! 11100: * ! 11101: {{BZE{R6{EXITS{{EXIT IF NULL STRING ! 11102: {{PLC{R10{{{ELSE POINT TO CHARS IN ARGUMENT ! 11103: {{MVC{{{{MOVE CHARACTERS TO RESULT STRING ! 11104: {{BRN{EXITS{{{JUMP FOR NEXT CODE WORD ! 11105: * ! 11106: * HERE IF 2ND ARG IS NEGATIVE OR LARGE ! 11107: * ! 11108: {SLPD3{ZER{R8{{{ZERO PAD COUNT ! 11109: {{BRN{SLPD1{{{MERGE ! 11110: {{EJC{{{{ ! 11111: * ! 11112: * LT ! 11113: * ! 11114: {S$LTF{ENT{{{{ENTRY POINT ! 11115: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE ! 11116: {{ERR{147{LT{{FIRST ARGUMENT IS NOT NUMERIC ! 11117: {{ERR{148{LT{{SECOND ARGUMENT IS NOT NUMERIC ! 11118: {{PPM{EXNUL{{{RETURN NULL IF LT ! 11119: {{PPM{EXFAL{{{FAIL IF EQ ! 11120: {{PPM{EXFAL{{{FAIL IF GT ! 11121: {{EJC{{{{ ! 11122: * ! 11123: * NE ! 11124: * ! 11125: {S$NEF{ENT{{{{ENTRY POINT ! 11126: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE ! 11127: {{ERR{149{NE{{FIRST ARGUMENT IS NOT NUMERIC ! 11128: {{ERR{150{NE{{SECOND ARGUMENT IS NOT NUMERIC ! 11129: {{PPM{EXNUL{{{RETURN NULL IF LT ! 11130: {{PPM{EXFAL{{{FAIL IF EQ ! 11131: {{PPM{EXNUL{{{RETURN NULL IF GT ! 11132: {{EJC{{{{ ! 11133: * ! 11134: * NOTANY ! 11135: * ! 11136: {S$NAY{ENT{{{{ENTRY POINT ! 11137: {{MOV{#P$NAS{R7{{SET PCODE FOR SINGLE CHAR ARG ! 11138: {{MOV{#P$NAY{R10{{PCODE FOR MULTI-CHAR ARG ! 11139: {{MOV{#P$NAD{R8{{SET PCODE FOR EXPR ARG ! 11140: {{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE ! 11141: {{ERR{151{NOTANY{{ARGUMENT IS NOT STRING OR EXPRESSION ! 11142: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD ! 11143: {{EJC{{{{ ! 11144: * ! 11145: * OPSYN ! 11146: * ! 11147: {S$OPS{ENT{{{{ENTRY POINT ! 11148: {{JSR{GTSMI{{{LOAD THIRD ARGUMENT ! 11149: {{ERR{152{OPSYN{{THIRD ARGUMENT IS NOT INTEGER ! 11150: {{ERR{153{OPSYN{{THIRD ARGUMENT IS NEGATIVE OR TOO LARGE ! 11151: {{MOV{R8{R7{{IF OK, SAVE THIRD ARGUMNET ! 11152: {{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT ! 11153: {{JSR{GTNVR{{{LOCATE VARIABLE BLOCK ! 11154: {{ERR{154{OPSYN{{SECOND ARG IS NOT NATURAL VARIABLE NAME ! 11155: {{MOV{4*VRFNC(R9){R10{{IF OK, LOAD FUNCTION BLOCK POINTER ! 11156: {{BNZ{R7{SOPS2{{JUMP IF OPERATOR OPSYN CASE ! 11157: * ! 11158: * HERE FOR FUNCTION OPSYN (THIRD ARG ZERO) ! 11159: * ! 11160: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT ! 11161: {{JSR{GTNVR{{{GET VRBLK POINTER ! 11162: {{ERR{155{OPSYN{{FIRST ARG IS NOT NATURAL VARIABLE NAME ! 11163: * ! 11164: * MERGE HERE TO PERFORM FUNCTION DEFINITION ! 11165: * ! 11166: {SOPS1{JSR{DFFNC{{{CALL FUNCTION DEFINER ! 11167: {{BRN{EXNUL{{{EXIT WITH NULL RESULT ! 11168: * ! 11169: * HERE FOR OPERATOR OPSYN (THIRD ARG NON-ZERO) ! 11170: * ! 11171: {SOPS2{JSR{GTSTG{{{GET OPERATOR NAME ! 11172: {{PPM{SOPS5{{{JUMP IF NOT STRING ! 11173: {{BNE{R6{#NUM01{SOPS5{ERROR IF NOT ONE CHAR LONG ! 11174: {{PLC{R9{{{ELSE POINT TO CHARACTER ! 11175: {{LCH{R8{(R9){{LOAD CHARACTER NAME ! 11176: {{EJC{{{{ ! 11177: * ! 11178: * OPSYN (CONTINUED) ! 11179: * ! 11180: * NOW SET TO SEARCH FOR MATCHING UNARY OR BINARY OPERATOR ! 11181: * NAME AS APPROPRIATE. NOTE THAT THERE ARE =OPBUN UNDEFINED ! 11182: * BINARY OPERATORS AND =OPUUN UNDEFINED UNARY OPERATORS. ! 11183: * ! 11184: {{MOV{#R$UUB{R6{{POINT TO UNOP POINTERS IN CASE ! 11185: {{MOV{#OPNSU{R9{{POINT TO NAMES OF UNARY OPERATORS ! 11186: {{ADD{#OPBUN{R7{{ADD NO. OF UNDEFINED BINARY OPS ! 11187: {{BEQ{R7{#OPUUN{SOPS3{JUMP IF UNOP (THIRD ARG WAS 1) ! 11188: {{MOV{#R$UBA{R6{{ELSE POINT TO BINARY OPERATOR PTRS ! 11189: {{MOV{#OPSNB{R9{{POINT TO NAMES OF BINARY OPERATORS ! 11190: {{MOV{#OPBUN{R7{{SET NUMBER OF UNDEFINED BINOPS ! 11191: * ! 11192: * MERGE HERE TO CHECK LIST (WB = NUMBER TO CHECK) ! 11193: * ! 11194: {SOPS3{LCT{R7{R7{{SET COUNTER TO CONTROL LOOP ! 11195: * ! 11196: * LOOP TO SEARCH FOR NAME MATCH ! 11197: * ! 11198: {SOPS4{BEQ{R8{(R9){SOPS6{JUMP IF NAMES MATCH ! 11199: {{ICA{R6{{{ELSE PUSH POINTER TO FUNCTION PTR ! 11200: {{ICA{R9{{{BUMP POINTER ! 11201: {{BCT{R7{SOPS4{{LOOP BACK TILL ALL CHECKED ! 11202: * ! 11203: * HERE IF BAD OPERATOR NAME ! 11204: * ! 11205: {SOPS5{ERB{156{OPSYN{{FIRST ARG IS NOT CORRECT OPERATOR NAME ! 11206: * ! 11207: * COME HERE ON FINDING A MATCH IN THE OPERATOR NAME TABLE ! 11208: * ! 11209: {SOPS6{MOV{R6{R9{{COPY POINTER TO FUNCTION BLOCK PTR ! 11210: {{SUB{#4*VRFNC{R9{{MAKE IT LOOK LIKE DUMMY VRBLK ! 11211: {{BRN{SOPS1{{{MERGE BACK TO DEFINE OPERATOR ! 11212: {{EJC{{{{ ! 11213: * ! 11214: * OUTPUT ! 11215: * ! 11216: {S$OUP{ENT{{{{ENTRY POINT ! 11217: {{MOV{#NUM03{R7{{OUTPUT FLAG ! 11218: {{JSR{IOPUT{{{CALL INPUT/OUTPUT ASSOC. ROUTINE ! 11219: {{ERR{157{OUTPUT{{THIRD ARGUMENT IS NOT A STRING ! 11220: {{ERR{158{INAPPROPRIATE{{SECOND ARGUMENT FOR OUTPUT ! 11221: {{ERR{159{INAPPROPRIATE{{FIRST ARGUMENT FOR OUTPUT ! 11222: {{ERR{160{INAPPROPRIATE{{FILE SPECIFICATION FOR OUTPUT ! 11223: {{PPM{EXFAL{{{FAIL IF FILE DOES NOT EXIST ! 11224: {{ERR{161{OUTPUT{{FILE CANNOT BE WRITTEN TO ! 11225: {{BRN{EXNUL{{{RETURN NULL STRING ! 11226: {{EJC{{{{ ! 11227: * ! 11228: * POS ! 11229: * ! 11230: {S$POS{ENT{{{{ENTRY POINT ! 11231: {{MOV{#P$POS{R7{{SET PCODE FOR INTEGER ARG CASE ! 11232: {{MOV{#P$PSD{R6{{SET PCODE FOR EXPRESSION ARG CASE ! 11233: {{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE ! 11234: {{ERR{162{POS{{ARGUMENT IS NOT INTEGER OR EXPRESSION ! 11235: {{ERR{163{POS{{ARGUMENT IS NEGATIVE OR TOO LARGE ! 11236: {{BRN{EXIXR{{{RETURN PATTERN NODE ! 11237: {{EJC{{{{ ! 11238: * ! 11239: * PROTOTYPE ! 11240: * ! 11241: {S$PRO{ENT{{{{ENTRY POINT ! 11242: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 11243: {{MOV{4*TBLEN(R9){R7{{LENGTH IF TABLE, VECTOR (=VCLEN) ! 11244: {{BTW{R7{{{CONVERT TO WORDS ! 11245: {{MOV{(R9){R6{{LOAD TYPE WORD OF ARGUMENT BLOCK ! 11246: {{BEQ{R6{#B$ART{SPRO4{JUMP IF ARRAY ! 11247: {{BEQ{R6{#B$TBT{SPRO1{JUMP IF TABLE ! 11248: {{BEQ{R6{#B$VCT{SPRO3{JUMP IF VECTOR ! 11249: {{BEQ{R6{#B$BCT{SPR05{JUMP IF BUFFER ! 11250: {{ERB{164{PROTOTYPE{{ARGUMENT IS NOT VALID OBJECT ! 11251: * ! 11252: * HERE FOR TABLE ! 11253: * ! 11254: {SPRO1{SUB{#TBSI${R7{{SUBTRACT STANDARD FIELDS ! 11255: * ! 11256: * MERGE FOR VECTOR ! 11257: * ! 11258: {SPRO2{MTI{R7{{{CONVERT TO INTEGER ! 11259: {{BRN{EXINT{{{EXIT WITH INTEGER RESULT ! 11260: * ! 11261: * HERE FOR VECTOR ! 11262: * ! 11263: {SPRO3{SUB{#VCSI${R7{{SUBTRACT STANDARD FIELDS ! 11264: {{BRN{SPRO2{{{MERGE ! 11265: * ! 11266: * HERE FOR ARRAY ! 11267: * ! 11268: {SPRO4{ADD{4*AROFS(R9){R9{{POINT TO PROTOTYPE FIELD ! 11269: {{MOV{(R9){R9{{LOAD PROTOTYPE ! 11270: {{BRN{EXIXR{{{RETURN PROTOTYPE AS RESULT ! 11271: * ! 11272: * HERE FOR BUFFER ! 11273: * ! 11274: {SPR05{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK ! 11275: {{MTI{4*BFALC(R9){{{LOAD ALLOCATED LENGTH ! 11276: {{BRN{EXINT{{{EXIT WITH INTEGER ALLOCATION ! 11277: {{EJC{{{{ ! 11278: * ! 11279: * REMDR ! 11280: * ! 11281: {S$RMD{ENT{{{{ENTRY POINT ! 11282: {{ZER{R7{{{SET POSITIVE FLAG ! 11283: {{MOV{(SP){R9{{LOAD SECOND ARGUMENT ! 11284: {{JSR{GTINT{{{CONVERT TO INTEGER ! 11285: {{ERR{165{REMDR{{SECOND ARGUMENT IS NOT INTEGER ! 11286: {{JSR{ARITH{{{CONVERT ARGS ! 11287: {{PPM{SRM01{{{FIRST ARG NOT INTEGER ! 11288: {{PPM{{{{SECOND ARG CHECKED ABOVE ! 11289: {{PPM{SRM01{{{FIRST ARG REAL ! 11290: {{LDI{4*ICVAL(R9){{{LOAD LEFT ARGUMENT VALUE ! 11291: {{RMI{4*ICVAL(R10){{{GET REMAINDER ! 11292: {{INO{EXINT{{{JUMP IF NO OVERFLOW ! 11293: {{ERB{167{REMDR{{CAUSED INTEGER OVERFLOW ! 11294: * ! 11295: * FAIL FIRST ARGUMENT ! 11296: * ! 11297: {SRM01{ERB{166{REMDR{{FIRST ARGUMENT IS NOT INTEGER ! 11298: {{EJC{{{{ ! 11299: * ! 11300: * REPLACE ! 11301: * ! 11302: * THE ACTUAL REPLACE OPERATION USES AN SCBLK WHOSE CFP$A ! 11303: * CHARS CONTAIN THE TRANSLATED VERSIONS OF ALL THE CHARS. ! 11304: * THE TABLE POINTER IS REMEMBERED FROM CALL TO CALL AND ! 11305: * THE TABLE IS ONLY BUILT WHEN THE ARGUMENTS CHANGE. ! 11306: * ! 11307: {S$RPL{ENT{{{{ENTRY POINT ! 11308: {{JSR{GTSTG{{{LOAD THIRD ARGUMENT AS STRING ! 11309: {{ERR{168{REPLACE{{THIRD ARGUMENT IS NOT STRING ! 11310: {{MOV{R9{R10{{SAVE THIRD ARG PTR ! 11311: {{JSR{GTSTG{{{GET SECOND ARGUMENT ! 11312: {{ERR{169{REPLACE{{SECOND ARGUMENT IS NOT STRING ! 11313: * ! 11314: * CHECK TO SEE IF THIS IS THE SAME TABLE AS LAST TIME ! 11315: * ! 11316: {{BNE{R9{R$RA2{SRPL1{JUMP IF 2ND ARGUMENT DIFFERENT ! 11317: {{BEQ{R10{R$RA3{SRPL4{JUMP IF ARGS SAME AS LAST TIME ! 11318: * ! 11319: * HERE WE BUILD A NEW REPLACE TABLE (NOTE WA = 2ND ARG LEN) ! 11320: * ! 11321: {SRPL1{MOV{4*SCLEN(R10){R7{{LOAD 3RD ARGUMENT LENGTH ! 11322: {{BNE{R6{R7{SRPL5{JUMP IF ARGUMENTS NOT SAME LENGTH ! 11323: {{BZE{R7{SRPL5{{JUMP IF NULL 2ND ARGUMENT ! 11324: {{MOV{R10{R$RA3{{SAVE THIRD ARG FOR NEXT TIME IN ! 11325: {{MOV{R9{R$RA2{{SAVE SECOND ARG FOR NEXT TIME IN ! 11326: {{MOV{KVALP{R10{{POINT TO ALPHABET STRING ! 11327: {{MOV{4*SCLEN(R10){R6{{LOAD ALPHABET SCBLK LENGTH ! 11328: {{MOV{R$RPT{R9{{POINT TO CURRENT TABLE (IF ANY) ! 11329: {{BNZ{R9{SRPL2{{JUMP IF WE ALREADY HAVE A TABLE ! 11330: * ! 11331: * HERE WE ALLOCATE A NEW TABLE ! 11332: * ! 11333: {{JSR{ALOCS{{{ALLOCATE NEW TABLE ! 11334: {{MOV{R8{R6{{KEEP SCBLK LENGTH ! 11335: {{MOV{R9{R$RPT{{SAVE TABLE POINTER FOR NEXT TIME ! 11336: * ! 11337: * MERGE HERE WITH POINTER TO NEW TABLE BLOCK IN (XR) ! 11338: * ! 11339: {SRPL2{CTB{R6{SCSI${{COMPUTE LENGTH OF SCBLK ! 11340: {{MVW{{{{COPY TO GET INITIAL TABLE VALUES ! 11341: {{EJC{{{{ ! 11342: * ! 11343: * REPLACE (CONTINUED) ! 11344: * ! 11345: * NOW WE MUST PLUG SELECTED ENTRIES AS REQUIRED. NOTE THAT ! 11346: * WE ARE SHORT OF INDEX REGISTERS FOR THE FOLLOWING LOOP. ! 11347: * HENCE THE NEED TO REPEATEDLY RE-INITIALISE CHAR PTR XL ! 11348: * ! 11349: {{MOV{R$RA2{R10{{POINT TO SECOND ARGUMENT ! 11350: {{LCT{R7{R7{{NUMBER OF CHARS TO PLUG ! 11351: {{ZER{R8{{{ZERO CHAR OFFSET ! 11352: {{MOV{R$RA3{R9{{POINT TO 3RD ARG ! 11353: {{PLC{R9{{{GET CHAR PTR FOR 3RD ARG ! 11354: * ! 11355: * LOOP TO PLUG CHARS ! 11356: * ! 11357: {SRPL3{MOV{R$RA2{R10{{POINT TO 2ND ARG ! 11358: {{PLC{R10{R8{{POINT TO NEXT CHAR ! 11359: {{ICV{R8{{{INCREMENT OFFSET ! 11360: {{LCH{R6{(R10){{GET NEXT CHAR ! 11361: {{MOV{R$RPT{R10{{POINT TO TRANSLATE TABLE ! 11362: {{PSC{R10{R6{{CONVERT CHAR TO OFFSET INTO TABLE ! 11363: {{LCH{R6{(R9)+{{GET TRANSLATED CHAR ! 11364: {{SCH{R6{(R10){{STORE IN TABLE ! 11365: {{CSC{R10{{{COMPLETE STORE CHARACTERS ! 11366: {{BCT{R7{SRPL3{{LOOP TILL DONE ! 11367: {{EJC{{{{ ! 11368: * ! 11369: * REPLACE (CONTINUED) ! 11370: * ! 11371: * HERE TO PERFORM TRANSLATE ! 11372: * ! 11373: {SRPL4{JSR{GTSTG{{{GET FIRST ARGUMENT ! 11374: {{ERR{170{REPLACE{{FIRST ARGUMENT IS NOT STRING ! 11375: {{BZE{R6{EXNUL{{RETURN NULL IF NULL ARGUMENT ! 11376: {{MOV{R9{R10{{COPY POINTER ! 11377: {{MOV{R6{R8{{SAVE LENGTH ! 11378: {{CTB{R6{SCHAR{{GET SCBLK LENGTH ! 11379: {{JSR{ALLOC{{{ALLOCATE SPACE FOR COPY ! 11380: {{MOV{R9{R7{{SAVE ADDRESS OF COPY ! 11381: {{MVW{{{{MOVE SCBLK CONTENTS TO COPY ! 11382: {{MOV{R$RPT{R9{{POINT TO REPLACE TABLE ! 11383: {{PLC{R9{{{POINT TO CHARS OF TABLE ! 11384: {{MOV{R7{R10{{POINT TO STRING TO TRANSLATE ! 11385: {{PLC{R10{{{POINT TO CHARS OF STRING ! 11386: {{MOV{R8{R6{{SET NUMBER OF CHARS TO TRANSLATE ! 11387: {{TRC{{{{PERFORM TRANSLATION ! 11388: {{MOV{R7{-(SP){{STACK NEW STRING AS RESULT ! 11389: {{BRN{EXITS{{{RETURN WITH RESULT ON STACK ! 11390: * ! 11391: * ERROR POINT ! 11392: * ! 11393: {SRPL5{ERB{171{NULL{{OR UNEQUALLY LONG 2ND, 3RD ARGS TO REPLACE ! 11394: {{EJC{{{{ ! 11395: * ! 11396: * REWIND ! 11397: * ! 11398: {S$REW{ENT{{{{ENTRY POINT ! 11399: {{JSR{IOFCB{{{CALL FCBLK ROUTINE ! 11400: {{ERR{172{REWIND{{ARGUMENT IS NOT A SUITABLE NAME ! 11401: {{ERR{173{REWIND{{ARGUMENT IS NULL ! 11402: {{JSR{SYSRW{{{CALL SYSTEM REWIND FUNCTION ! 11403: {{ERR{174{REWIND{{FILE DOES NOT EXIST ! 11404: {{ERR{175{REWIND{{FILE DOES NOT PERMIT REWIND ! 11405: {{ERR{176{REWIND{{CAUSED NON-RECOVERABLE ERROR ! 11406: {{BRN{EXNUL{{{EXIT WITH NULL RESULT IF NO ERROR ! 11407: {{EJC{{{{ ! 11408: * ! 11409: * REVERSE ! 11410: * ! 11411: {S$RVS{ENT{{{{ENTRY POINT ! 11412: {{JSR{GTSTG{{{LOAD STRING ARGUMENT ! 11413: {{ERR{177{REVERSE{{ARGUMENT IS NOT STRING ! 11414: {{BZE{R6{EXIXR{{RETURN ARGUMENT IF NULL ! 11415: {{MOV{R9{R10{{ELSE SAVE POINTER TO STRING ARG ! 11416: {{JSR{ALOCS{{{ALLOCATE SPACE FOR NEW SCBLK ! 11417: {{MOV{R9{-(SP){{STORE SCBLK PTR ON STACK AS RESULT ! 11418: {{PSC{R9{{{PREPARE TO STORE IN NEW SCBLK ! 11419: {{PLC{R10{R8{{POINT PAST LAST CHAR IN ARGUMENT ! 11420: {{LCT{R8{R8{{SET LOOP COUNTER ! 11421: * ! 11422: * LOOP TO MOVE CHARS IN REVERSE ORDER ! 11423: * ! 11424: {SRVS1{LCH{R7{-(R10){{LOAD NEXT CHAR FROM ARGUMENT ! 11425: {{SCH{R7{(R9)+{{STORE IN RESULT ! 11426: {{BCT{R8{SRVS1{{LOOP TILL ALL MOVED ! 11427: {{CSC{R9{{{COMPLETE STORE CHARACTERS ! 11428: {{BRN{EXITS{{{AND THEN JUMP FOR NEXT CODE WORD ! 11429: {{EJC{{{{ ! 11430: * ! 11431: * RPAD ! 11432: * ! 11433: {S$RPD{ENT{{{{ENTRY POINT ! 11434: {{JSR{GTSTG{{{GET PAD CHARACTER ! 11435: {{ERR{178{RPAD{{THIRD ARGUMENT IS NOT STRING ! 11436: {{PLC{R9{{{POINT TO CHARACTER (NULL IS BLANK) ! 11437: {{LCH{R7{(R9){{LOAD PAD CHARACTER ! 11438: {{JSR{GTSMI{{{GET PAD LENGTH ! 11439: {{ERR{179{RPAD{{SECOND ARGUMENT IS NOT INTEGER ! 11440: {{PPM{SRPD3{{{SKIP IF NEGATIVE OR LARGE ! 11441: * ! 11442: * MERGE TO CHECK FIRST ARG. ! 11443: * ! 11444: {SRPD1{JSR{GTSTG{{{GET FIRST ARGUMENT (STRING TO PAD) ! 11445: {{ERR{180{RPAD{{FIRST ARGUMENT IS NOT STRING ! 11446: {{BGE{R6{R8{EXIXR{RETURN 1ST ARG IF TOO LONG TO PAD ! 11447: {{MOV{R9{R10{{ELSE MOVE PTR TO STRING TO PAD ! 11448: * ! 11449: * NOW WE ARE READY FOR THE PAD ! 11450: * ! 11451: * (XL) POINTER TO STRING TO PAD ! 11452: * (WB) PAD CHARACTER ! 11453: * (WC) LENGTH TO PAD STRING TO ! 11454: * ! 11455: {{MOV{R8{R6{{COPY LENGTH ! 11456: {{JSR{ALOCS{{{ALLOCATE SCBLK FOR NEW STRING ! 11457: {{MOV{R9{-(SP){{SAVE AS RESULT ! 11458: {{MOV{4*SCLEN(R10){R6{{LOAD LENGTH OF ARGUMENT ! 11459: {{SUB{R6{R8{{CALCULATE NUMBER OF PAD CHARACTERS ! 11460: {{PSC{R9{{{POINT TO CHARS IN RESULT STRING ! 11461: {{LCT{R8{R8{{SET COUNTER FOR PAD LOOP ! 11462: * ! 11463: * COPY ARGUMENT STRING ! 11464: * ! 11465: {{BZE{R6{SRPD2{{JUMP IF ARGUMENT IS NULL ! 11466: {{PLC{R10{{{ELSE POINT TO ARGUMENT CHARS ! 11467: {{MVC{{{{MOVE CHARACTERS TO RESULT STRING ! 11468: * ! 11469: * LOOP TO SUPPLY PAD CHARACTERS ! 11470: * ! 11471: {SRPD2{SCH{R7{(R9)+{{STORE PAD CHARACTER, BUMP PTR ! 11472: {{BCT{R8{SRPD2{{LOOP TILL ALL PAD CHARS STORED ! 11473: {{CSC{R9{{{COMPLETE CHARACTER STORING ! 11474: {{BRN{EXITS{{{AND EXIT FOR NEXT WORD ! 11475: * ! 11476: * HERE IF 2ND ARG IS NEGATIVE OR LARGE ! 11477: * ! 11478: {SRPD3{ZER{R8{{{ZERO PAD COUNT ! 11479: {{BRN{SRPD1{{{MERGE ! 11480: {{EJC{{{{ ! 11481: * ! 11482: * RTAB ! 11483: * ! 11484: {S$RTB{ENT{{{{ENTRY POINT ! 11485: {{MOV{#P$RTB{R7{{SET PCODE FOR INTEGER ARG CASE ! 11486: {{MOV{#P$RTD{R6{{SET PCODE FOR EXPRESSION ARG CASE ! 11487: {{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE ! 11488: {{ERR{181{RTAB{{ARGUMENT IS NOT INTEGER OR EXPRESSION ! 11489: {{ERR{182{RTAB{{ARGUMENT IS NEGATIVE OR TOO LARGE ! 11490: {{BRN{EXIXR{{{RETURN PATTERN NODE ! 11491: {{EJC{{{{ ! 11492: * ! 11493: * SET ! 11494: * ! 11495: {S$SET{ENT{{{{ENTRY POINT ! 11496: {{MOV{(SP)+{R$IO2{{SAVE THIRD ARG ! 11497: {{MOV{(SP)+{R$IO1{{SAVE SECOND ARG ! 11498: {{JSR{IOFCB{{{CALL FCBLK ROUTINE ! 11499: {{ERR{291{SET{{FIRST ARGUMENT IS NOT A SUITABLE NAME ! 11500: {{ERR{292{SET{{FIRST ARGUMENT IS NULL ! 11501: {{MOV{R$IO1{R7{{LOAD SECOND ARG ! 11502: {{MOV{R$IO2{R8{{LOAD THIRD ARG ! 11503: {{JSR{SYSST{{{CALL SYSTEM SET ROUTINE ! 11504: {{ERR{293{INAPPROPRIATE{{SECOND ARGUMENT TO SET ! 11505: {{ERR{294{INAPPROPRIATE{{THIRD ARGUMENT TO SET ! 11506: {{ERR{295{SET{{FILE DOES NOT EXIST ! 11507: {{ERR{296{SET{{FILE DOES NOT PERMIT SETTING FILE POINTER ! 11508: {{ERR{297{SET{{CAUSED NON-RECOVERABLE I/O ERROR ! 11509: {{BRN{EXNUL{{{OTHERWISEW RETURN NULL ! 11510: {{EJC{{{{ ! 11511: * ! 11512: * TAB ! 11513: * ! 11514: {S$TAB{ENT{{{{ENTRY POINT ! 11515: {{MOV{#P$TAB{R7{{SET PCODE FOR INTEGER ARG CASE ! 11516: {{MOV{#P$TBD{R6{{SET PCODE FOR EXPRESSION ARG CASE ! 11517: {{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE ! 11518: {{ERR{183{TAB{{ARGUMENT IS NOT INTEGER OR EXPRESSION ! 11519: {{ERR{184{TAB{{ARGUMENT IS NEGATIVE OR TOO LARGE ! 11520: {{BRN{EXIXR{{{RETURN PATTERN NODE ! 11521: {{EJC{{{{ ! 11522: * ! 11523: * RPOS ! 11524: * ! 11525: {S$RPS{ENT{{{{ENTRY POINT ! 11526: {{MOV{#P$RPS{R7{{SET PCODE FOR INTEGER ARG CASE ! 11527: {{MOV{#P$RPD{R6{{SET PCODE FOR EXPRESSION ARG CASE ! 11528: {{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE ! 11529: {{ERR{185{RPOS{{ARGUMENT IS NOT INTEGER OR EXPRESSION ! 11530: {{ERR{186{RPOS{{ARGUMENT IS NEGATIVE OR TOO LARGE ! 11531: {{BRN{EXIXR{{{RETURN PATTERN NODE ! 11532: {{EJC{{{{ ! 11533: * ! 11534: * RSORT ! 11535: * ! 11536: {S$RSR{ENT{{{{ENTRY POINT ! 11537: {{MNZ{R6{{{MARK AS RSORT ! 11538: {{JSR{SORTA{{{CALL SORT ROUTINE ! 11539: {{BRN{EXSID{{{RETURN, SETTING IDVAL ! 11540: {{EJC{{{{ ! 11541: * ! 11542: * SETEXIT ! 11543: * ! 11544: {S$STX{ENT{{{{ENTRY POINT ! 11545: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 11546: {{MOV{STXVR{R6{{LOAD OLD VRBLK POINTER ! 11547: {{ZER{R10{{{LOAD ZERO IN CASE NULL ARG ! 11548: {{BEQ{R9{#NULLS{SSTX1{JUMP IF NULL ARGUMENT (RESET CALL) ! 11549: {{JSR{GTNVR{{{ELSE GET SPECIFIED VRBLK ! 11550: {{PPM{SSTX2{{{JUMP IF NOT NATURAL VARIABLE ! 11551: {{MOV{4*VRLBL(R9){R10{{ELSE LOAD LABEL ! 11552: {{BEQ{R10{#STNDL{SSTX2{JUMP IF LABEL IS NOT DEFINED ! 11553: {{BNE{(R10){#B$TRT{SSTX1{JUMP IF NOT TRAPPED ! 11554: {{MOV{4*TRLBL(R10){R10{{ELSE LOAD PTR TO REAL LABEL CODE ! 11555: * ! 11556: * HERE TO SET/RESET SETEXIT TRAP ! 11557: * ! 11558: {SSTX1{MOV{R9{STXVR{{STORE NEW VRBLK POINTER (OR NULL) ! 11559: {{MOV{R10{R$SXC{{STORE NEW CODE PTR (OR ZERO) ! 11560: {{BEQ{R6{#NULLS{EXNUL{RETURN NULL IF NULL RESULT ! 11561: {{MOV{R6{R9{{ELSE COPY VRBLK POINTER ! 11562: {{BRN{EXVNM{{{AND RETURN BUILDING NMBLK ! 11563: * ! 11564: * HERE IF BAD ARGUMENT ! 11565: * ! 11566: {SSTX2{ERB{187{SETEXIT{{ARGUMENT IS NOT LABEL NAME OR NULL ! 11567: {{EJC{{{{ ! 11568: * ! 11569: * SORT ! 11570: * ! 11571: {S$SRT{ENT{{{{ENTRY POINT ! 11572: {{ZER{R6{{{MARK AS SORT ! 11573: {{JSR{SORTA{{{CALL SORT ROUTINE ! 11574: {{BRN{EXSID{{{RETURN, SETTING IDVAL ! 11575: {{EJC{{{{ ! 11576: * ! 11577: * SPAN ! 11578: * ! 11579: {S$SPN{ENT{{{{ENTRY POINT ! 11580: {{MOV{#P$SPS{R7{{SET PCODE FOR SINGLE CHAR ARG ! 11581: {{MOV{#P$SPN{R10{{SET PCODE FOR MULTI-CHAR ARG ! 11582: {{MOV{#P$SPD{R8{{SET PCODE FOR EXPRESSION ARG ! 11583: {{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE ! 11584: {{ERR{188{SPAN{{ARGUMENT IS NOT STRING OR EXPRESSION ! 11585: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD ! 11586: {{EJC{{{{ ! 11587: * ! 11588: * SIZE ! 11589: * ! 11590: {S$SI${ENT{{{{ENTRY POINT ! 11591: {{MOV{(SP){R9{{LOAD ARGUMENT ! 11592: {{BNE{(R9){#B$BCT{SSI$1{BRANCH IF NOT BUFFER ! 11593: {{ICA{SP{{{ELSE POP ARGUMENT ! 11594: {{MTI{4*BCLEN(R9){{{LOAD DEFINED LENGTH ! 11595: {{BRN{EXINT{{{EXIT WITH INTEGER ! 11596: * ! 11597: * HERE IF NOT BUFFER ! 11598: * ! 11599: {SSI$1{JSR{GTSTG{{{LOAD STRING ARGUMENT ! 11600: {{ERR{189{SIZE{{ARGUMENT IS NOT STRING ! 11601: {{MTI{R6{{{LOAD LENGTH AS INTEGER ! 11602: {{BRN{EXINT{{{EXIT WITH INTEGER RESULT ! 11603: {{EJC{{{{ ! 11604: * ! 11605: * STOPTR ! 11606: * ! 11607: {S$STT{ENT{{{{ENTRY POINT ! 11608: {{ZER{R10{{{INDICATE STOPTR CASE ! 11609: {{JSR{TRACE{{{CALL TRACE PROCEDURE ! 11610: {{ERR{190{STOPTR{{FIRST ARGUMENT IS NOT APPROPRIATE NAME ! 11611: {{ERR{191{STOPTR{{SECOND ARGUMENT IS NOT TRACE TYPE ! 11612: {{BRN{EXNUL{{{RETURN NULL ! 11613: {{EJC{{{{ ! 11614: * ! 11615: * SUBSTR ! 11616: * ! 11617: {S$SUB{ENT{{{{ENTRY POINT ! 11618: {{JSR{GTSMI{{{LOAD THIRD ARGUMENT ! 11619: {{ERR{192{SUBSTR{{THIRD ARGUMENT IS NOT INTEGER ! 11620: {{PPM{EXFAL{{{JUMP IF NEGATIVE OR TOO LARGE ! 11621: {{MOV{R9{SBSSV{{SAVE THIRD ARGUMENT ! 11622: {{JSR{GTSMI{{{LOAD SECOND ARGUMENT ! 11623: {{ERR{193{SUBSTR{{SECOND ARGUMENT IS NOT INTEGER ! 11624: {{PPM{EXFAL{{{JUMP IF OUT OF RANGE ! 11625: {{MOV{R9{R7{{SAVE SECOND ARGUMENT ! 11626: {{BZE{R7{EXFAL{{JUMP IF SECOND ARGUMENT ZERO ! 11627: {{DCV{R7{{{ELSE DECREMENT FOR ONES ORIGIN ! 11628: {{MOV{(SP){R10{{GET FIRST ARG PTR ! 11629: {{BNE{(R10){#B$BCT{SSUBA{BRANCH IF NOT BUFFER ! 11630: {{MOV{4*BCBUF(R10){R9{{GET BFBLK PTR ! 11631: {{MOV{4*BCLEN(R10){R6{{GET LENGTH ! 11632: {{BRN{SSUBB{{{MERGE ! 11633: * ! 11634: * HERE IF NOT BUFFER TO GET STRING ! 11635: * ! 11636: {SSUBA{JSR{GTSTG{{{LOAD FIRST ARGUMENT ! 11637: {{ERR{194{SUBSTR{{FIRST ARGUMENT IS NOT STRING ! 11638: * ! 11639: * MERGE WITH BFBLK OR SCBLK PTR IN XR. WA HAS LENGTH ! 11640: * ! 11641: {SSUBB{MOV{SBSSV{R8{{RELOAD THIRD ARGUMENT ! 11642: {{BNZ{R8{SSUB1{{SKIP IF THIRD ARG GIVEN ! 11643: {{MOV{R6{R8{{ELSE GET STRING LENGTH ! 11644: {{BGT{R7{R8{EXFAL{FAIL IF IMPROPER ! 11645: {{SUB{R7{R8{{REDUCE BY OFFSET TO START ! 11646: * ! 11647: * MERGE ! 11648: * ! 11649: {SSUB1{MOV{R6{R10{{SAVE STRING LENGTH ! 11650: {{MOV{R8{R6{{SET LENGTH OF SUBSTRING ! 11651: {{ADD{R7{R8{{ADD 2ND ARG TO 3RD ARG ! 11652: {{BGT{R8{R10{EXFAL{JUMP IF IMPROPER SUBSTRING ! 11653: {{MOV{R9{R10{{COPY POINTER TO FIRST ARG ! 11654: {{JSR{SBSTR{{{BUILD SUBSTRING ! 11655: {{BRN{EXIXR{{{AND JUMP FOR NEXT CODE WORD ! 11656: {{EJC{{{{ ! 11657: * ! 11658: * TABLE ! 11659: * ! 11660: {S$TBL{ENT{{{{ENTRY POINT ! 11661: {{MOV{(SP)+{R10{{GET INITIAL LOOKUP VALUE ! 11662: {{ICA{SP{{{POP SECOND ARGUMENT ! 11663: {{JSR{GTSMI{{{LOAD ARGUMENT ! 11664: {{ERR{195{TABLE{{ARGUMENT IS NOT INTEGER ! 11665: {{ERR{196{TABLE{{ARGUMENT IS OUT OF RANGE ! 11666: {{BNZ{R8{STBL1{{JUMP IF NON-ZERO ! 11667: {{MOV{#TBNBK{R8{{ELSE SUPPLY DEFAULT VALUE ! 11668: * ! 11669: * MERGE HERE WITH NUMBER OF HEADERS IN WA ! 11670: * ! 11671: {STBL1{MOV{R8{R6{{COPY NUMBER OF HEADERS ! 11672: {{ADD{#TBSI${R6{{ADJUST FOR STANDARD FIELDS ! 11673: {{WTB{R6{{{CONVERT LENGTH TO BYTES ! 11674: {{JSR{ALLOC{{{ALLOCATE SPACE FOR TBBLK ! 11675: {{MOV{R9{R7{{COPY POINTER TO TBBLK ! 11676: {{MOV{#B$TBT{(R9)+{{STORE TYPE WORD ! 11677: {{ZER{(R9)+{{{ZERO ID FOR THE MOMENT ! 11678: {{MOV{R6{(R9)+{{STORE LENGTH (TBLEN) ! 11679: {{MOV{R10{(R9)+{{STORE INITIAL LOOKUP VALUE ! 11680: {{LCT{R8{R8{{SET LOOP COUNTER (NUM HEADERS) ! 11681: * ! 11682: * LOOP TO INITIALIZE ALL BUCKET POINTERS ! 11683: * ! 11684: {STBL2{MOV{R7{(R9)+{{STORE TBBLK PTR IN BUCKET HEADER ! 11685: {{BCT{R8{STBL2{{LOOP TILL ALL STORED ! 11686: {{MOV{R7{R9{{RECALL POINTER TO TBBLK ! 11687: {{BRN{EXSID{{{EXIT SETTING IDVAL ! 11688: {{EJC{{{{ ! 11689: * ! 11690: * TIME ! 11691: * ! 11692: {S$TIM{ENT{{{{ENTRY POINT ! 11693: {{JSR{SYSTM{{{GET TIMER VALUE ! 11694: {{SBI{TIMSX{{{SUBTRACT STARTING TIME ! 11695: {{BRN{EXINT{{{EXIT WITH INTEGER VALUE ! 11696: {{EJC{{{{ ! 11697: * ! 11698: * TRACE ! 11699: * ! 11700: {S$TRA{ENT{{{{ENTRY POINT ! 11701: {{BEQ{4*3(SP){#NULLS{STR03{JUMP IF FIRST ARGUMENT IS NULL ! 11702: {{MOV{(SP)+{R9{{LOAD FOURTH ARGUMENT ! 11703: {{ZER{R10{{{TENTATIVELY SET ZERO POINTER ! 11704: {{BEQ{R9{#NULLS{STR02{JUMP IF 4TH ARGUMENT IS NULL ! 11705: {{JSR{GTNVR{{{ELSE POINT TO VRBLK ! 11706: {{PPM{STR01{{{JUMP IF NOT VARIABLE NAME ! 11707: {{MOV{4*VRFNC(R9){R10{{ELSE LOAD FUNCTION POINTER ! 11708: {{BNE{R10{#STNDF{STR02{JUMP IF FUNCTION IS DEFINED ! 11709: * ! 11710: * HERE FOR BAD FOURTH ARGUMENT ! 11711: * ! 11712: {STR01{ERB{197{TRACE{{FOURTH ARG IS NOT FUNCTION NAME OR NULL ! 11713: * ! 11714: * HERE WITH FUNCTION POINTER IN XL ! 11715: * ! 11716: {STR02{MOV{(SP)+{R9{{LOAD THIRD ARGUMENT (TAG) ! 11717: {{ZER{R7{{{SET ZERO AS TRTYP VALUE FOR NOW ! 11718: {{JSR{TRBLD{{{BUILD TRBLK FOR TRACE CALL ! 11719: {{MOV{R9{R10{{MOVE TRBLK POINTER FOR TRACE ! 11720: {{JSR{TRACE{{{CALL TRACE PROCEDURE ! 11721: {{ERR{198{TRACE{{FIRST ARGUMENT IS NOT APPROPRIATE NAME ! 11722: {{ERR{199{TRACE{{SECOND ARGUMENT IS NOT TRACE TYPE ! 11723: {{BRN{EXNUL{{{RETURN NULL ! 11724: * ! 11725: * HERE TO CALL SYSTEM TRACE TOGGLE ROUTINE ! 11726: * ! 11727: {STR03{JSR{SYSTT{{{CALL IT ! 11728: {{ADD{#4*NUM04{SP{{POP TRACE ARGUMENTS ! 11729: {{BRN{EXNUL{{{RETURN ! 11730: {{EJC{{{{ ! 11731: * ! 11732: * TRIM ! 11733: * ! 11734: {S$TRM{ENT{{{{ENTRY POINT ! 11735: {{JSR{GTSTG{{{LOAD ARGUMENT AS STRING ! 11736: {{ERR{200{TRIM{{ARGUMENT IS NOT STRING ! 11737: {{BZE{R6{EXNUL{{RETURN NULL IF ARGUMENT IS NULL ! 11738: {{MOV{R9{R10{{COPY STRING POINTER ! 11739: {{CTB{R6{SCHAR{{GET BLOCK LENGTH ! 11740: {{JSR{ALLOC{{{ALLOCATE COPY SAME SIZE ! 11741: {{MOV{R9{R7{{SAVE POINTER TO COPY ! 11742: {{MVW{{{{COPY OLD STRING BLOCK TO NEW ! 11743: {{MOV{R7{R9{{RESTORE PTR TO NEW BLOCK ! 11744: {{JSR{TRIMR{{{TRIM BLANKS (WB IS NON-ZERO) ! 11745: {{BRN{EXIXR{{{EXIT WITH RESULT IN XR ! 11746: {{EJC{{{{ ! 11747: * ! 11748: * UNLOAD ! 11749: * ! 11750: {S$UNL{ENT{{{{ENTRY POINT ! 11751: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 11752: {{JSR{GTNVR{{{POINT TO VRBLK ! 11753: {{ERR{201{UNLOAD{{ARGUMENT IS NOT NATURAL VARIABLE NAME ! 11754: {{MOV{#STNDF{R10{{GET PTR TO UNDEFINED FUNCTION ! 11755: {{JSR{DFFNC{{{UNDEFINE NAMED FUNCTION ! 11756: {{BRN{EXNUL{{{RETURN NULL AS RESULT ! 11757: {{TTL{S{{{P I T B O L -- UTILITY PROCEDURES ! 11758: * ! 11759: * THE FOLLOWING SECTION CONTAINS PROCEDURES WHICH ARE ! 11760: * USED FOR VARIOUS PURPOSES THROUGHOUT THE SYSTEM. ! 11761: * ! 11762: * EACH PROCEDURE IS PRECEDED BY A DESCRIPTION OF THE ! 11763: * CALLING SEQUENCE. USUALLY THE ARGUMENTS ARE IN REGISTERS ! 11764: * BUT ARGUMENTS CAN ALSO OCCUR ON THE STACK AND AS ! 11765: * PARAMETERS ASSEMBLED AFTER THE JSR INSTRUCTION. ! 11766: * ! 11767: * THE FOLLOWING CONSIDERATIONS APPLY TO THESE DESCRIPTIONS. ! 11768: * ! 11769: * 1) THE STACK POINTER (XS) IS NOT CHANGED UNLESS THE ! 11770: * CHANGE IS EXPLICITLY DOCUMENTED IN THE CALL. ! 11771: * ! 11772: * 2) REGISTERS WHOSE ENTRY VALUES ARE NOT MENTIONED ! 11773: * MAY CONTAIN ANY VALUE EXCEPT THAT XL,XR MAY ONLY ! 11774: * CONTAIN PROPER (COLLECTABLE) POINTER VALUES. ! 11775: * THIS CONDITION ON XR MEANS THAT THE CALLED ROUTINE ! 11776: * MAY IF IT CHOOSES PRESERVE XR BY STACKING. ! 11777: * ! 11778: * 3) REGISTERS NOT MENTIONED ON EXIT CONTAIN THE SAME ! 11779: * VALUES AS THEY DID ON ENTRY EXCEPT THAT VALUES IN ! 11780: * XR,XL MAY HAVE BEEN RELOCATED BY THE COLLECTOR. ! 11781: * ! 11782: * 4) REGISTERS WHICH ARE DESTROYED ON EXIT MAY CONTAIN ! 11783: * ANY VALUE EXCEPT THAT VALUES IN XL,XR ARE PROPER ! 11784: * (COLLECTABLE) POINTERS. ! 11785: * ! 11786: * 5) THE CODE POINTER REGISTER POINTS TO THE CURRENT ! 11787: * CODE LOCATION ON ENTRY AND IS UNCHANGED ON EXIT. ! 11788: * ! 11789: * IN THE ABOVE DESCRIPTION, A COLLECTABLE POINTER IS ONE ! 11790: * WHICH EITHER POINTS OUTSIDE THE DYNAMIC REGION OR ! 11791: * POINTS TO THE START OF A BLOCK IN THE DYNAMIC REGION. ! 11792: * ! 11793: * IN THOSE CASES WHERE THE CALLING SEQUENCE CONTAINS ! 11794: * PARAMETERS WHICH ARE USED AS ALTERNATE RETURN POINTS, ! 11795: * THESE PARAMETERS MAY BE REPLACED BY ERROR CODES ! 11796: * ASSEMBLED WITH THE ERR INSTRUCTION. THIS WILL RESULT ! 11797: * IN THE POSTING OF THE ERROR IF THE RETURN IS TAKEN. ! 11798: * ! 11799: * THE PROCEDURES ALL HAVE NAMES CONSISTING OF FIVE LETTERS ! 11800: * AND ARE IN ALPHABETICAL ORDER BY THEIR NAMES. ! 11801: {{EJC{{{{ ! 11802: * ! 11803: * ACESS - ACCESS VARIABLE VALUE WITH TRACE/INPUT CHECKS ! 11804: * ! 11805: * ACESS LOADS THE VALUE OF A VARIABLE. TRACE AND INPUT ! 11806: * ASSOCIATIONS ARE TESTED FOR AND EXECUTED AS REQUIRED. ! 11807: * ACESS ALSO HANDLES THE SPECIAL CASES OF PSEUDO-VARIABLES. ! 11808: * ! 11809: * (XL) VARIABLE NAME BASE ! 11810: * (WA) VARIABLE NAME OFFSET ! 11811: * JSR ACESS CALL TO ACCESS VALUE ! 11812: * PPM LOC TRANSFER LOC IF ACCESS FAILURE ! 11813: * (XR) VARIABLE VALUE ! 11814: * (WA,WB,WC) DESTROYED ! 11815: * (XL,RA) DESTROYED ! 11816: * ! 11817: * FAILURE CAN OCCUR IF AN INPUT ASSOCIATION CAUSES AN END ! 11818: * OF FILE CONDITION OR IF THE EVALUATION OF AN EXPRESSION ! 11819: * ASSOCIATED WITH AN EXPRESSION VARIABLE FAILS. ! 11820: * ! 11821: {ACESS{PRC{R{1{{ENTRY POINT (RECURSIVE) ! 11822: {{MOV{R10{R9{{COPY NAME BASE ! 11823: {{ADD{R6{R9{{POINT TO VARIABLE LOCATION ! 11824: {{MOV{(R9){R9{{LOAD VARIABLE VALUE ! 11825: * ! 11826: * LOOP HERE TO CHECK FOR SUCCESSIVE TRBLKS ! 11827: * ! 11828: {ACS02{BNE{(R9){#B$TRT{ACS18{JUMP IF NOT TRAPPED ! 11829: * ! 11830: * HERE IF TRAPPED ! 11831: * ! 11832: {{BEQ{R9{#TRBKV{ACS12{JUMP IF KEYWORD VARIABLE ! 11833: {{BNE{R9{#TRBEV{ACS05{JUMP IF NOT EXPRESSION VARIABLE ! 11834: * ! 11835: * HERE FOR EXPRESSION VARIABLE, EVALUATE VARIABLE ! 11836: * ! 11837: {{MOV{4*EVEXP(R10){R9{{LOAD EXPRESSION POINTER ! 11838: {{ZER{R7{{{EVALUATE BY VALUE ! 11839: {{JSR{EVALX{{{EVALUATE EXPRESSION ! 11840: {{PPM{ACS04{{{JUMP IF EVALUATION FAILURE ! 11841: {{BRN{ACS02{{{CHECK VALUE FOR MORE TRBLKS ! 11842: {{EJC{{{{ ! 11843: * ! 11844: * ACESS (CONTINUED) ! 11845: * ! 11846: * HERE ON READING END OF FILE ! 11847: * ! 11848: {ACS03{ADD{#4*NUM03{SP{{POP TRBLK PTR, NAME BASE AND OFFSET ! 11849: {{MOV{R9{DNAMP{{POP UNUSED SCBLK ! 11850: * ! 11851: * MERGE HERE WHEN EVALUATION OF EXPRESSION FAILS ! 11852: * ! 11853: {ACS04{EXI{1{{{TAKE ALTERNATE (FAILURE) RETURN ! 11854: * ! 11855: * HERE IF NOT KEYWORD OR EXPRESSION VARIABLE ! 11856: * ! 11857: {ACS05{MOV{4*TRTYP(R9){R7{{LOAD TRAP TYPE CODE ! 11858: {{BNZ{R7{ACS10{{JUMP IF NOT INPUT ASSOCIATION ! 11859: {{BZE{KVINP{ACS09{{IGNORE INPUT ASSOC IF INPUT IS OFF ! 11860: * ! 11861: * HERE FOR INPUT ASSOCIATION ! 11862: * ! 11863: {{MOV{R10{-(SP){{STACK NAME BASE ! 11864: {{MOV{R6{-(SP){{STACK NAME OFFSET ! 11865: {{MOV{R9{-(SP){{STACK TRBLK POINTER ! 11866: {{MOV{4*TRFPT(R9){R10{{GET FILE CTRL BLK PTR OR ZERO ! 11867: {{BNZ{R10{ACS06{{JUMP IF NOT STANDARD INPUT FILE ! 11868: {{BEQ{4*TRTER(R9){#V$TER{ACS21{JUMP IF TERMINAL ! 11869: * ! 11870: * HERE TO READ FROM STANDARD INPUT FILE ! 11871: * ! 11872: {{MOV{CSWIN{R6{{LENGTH FOR READ BUFFER ! 11873: {{JSR{ALOCS{{{BUILD STRING OF APPROPRIATE LENGTH ! 11874: {{JSR{SYSRD{{{READ NEXT STANDARD INPUT IMAGE ! 11875: {{PPM{ACS03{{{JUMP TO FAIL EXIT IF END OF FILE ! 11876: {{BRN{ACS07{{{ELSE MERGE WITH OTHER FILE CASE ! 11877: * ! 11878: * HERE FOR INPUT FROM OTHER THAN STANDARD INPUT FILE ! 11879: * ! 11880: {ACS06{MOV{R10{R6{{FCBLK PTR ! 11881: {{JSR{SYSIL{{{GET INPUT RECORD MAX LENGTH (TO WA) ! 11882: {{JSR{ALOCS{{{ALLOCATE STRING OF CORRECT SIZE ! 11883: {{MOV{R10{R6{{FCBLK PTR ! 11884: {{JSR{SYSIN{{{CALL SYSTEM INPUT ROUTINE ! 11885: {{PPM{ACS03{{{JUMP TO FAIL EXIT IF END OF FILE ! 11886: {{PPM{ACS22{{{ERROR ! 11887: {{PPM{ACS23{{{ERROR ! 11888: {{EJC{{{{ ! 11889: * ! 11890: * ACESS (CONTINUED) ! 11891: * ! 11892: * MERGE HERE AFTER OBTAINING INPUT RECORD ! 11893: * ! 11894: {ACS07{MOV{KVTRM{R7{{LOAD TRIM INDICATOR ! 11895: {{JSR{TRIMR{{{TRIM RECORD AS REQUIRED ! 11896: {{MOV{R9{R7{{COPY RESULT POINTER ! 11897: {{MOV{(SP){R9{{RELOAD POINTER TO TRBLK ! 11898: * ! 11899: * LOOP TO CHASE TO END OF TRBLK CHAIN AND STORE VALUE ! 11900: * ! 11901: {ACS08{MOV{R9{R10{{SAVE POINTER TO THIS TRBLK ! 11902: {{MOV{4*TRNXT(R9){R9{{LOAD FORWARD POINTER ! 11903: {{BEQ{(R9){#B$TRT{ACS08{LOOP IF THIS IS ANOTHER TRBLK ! 11904: {{MOV{R7{4*TRNXT(R10){{ELSE STORE RESULT AT END OF CHAIN ! 11905: {{MOV{(SP)+{R9{{RESTORE INITIAL TRBLK POINTER ! 11906: {{MOV{(SP)+{R6{{RESTORE NAME OFFSET ! 11907: {{MOV{(SP)+{R10{{RESTORE NAME BASE POINTER ! 11908: * ! 11909: * COME HERE TO MOVE TO NEXT TRBLK ! 11910: * ! 11911: {ACS09{MOV{4*TRNXT(R9){R9{{LOAD FORWARD PTR TO NEXT VALUE ! 11912: {{BRN{ACS02{{{BACK TO CHECK IF TRAPPED ! 11913: * ! 11914: * HERE TO CHECK FOR ACCESS TRACE TRBLK ! 11915: * ! 11916: {ACS10{BNE{R7{#TRTAC{ACS09{LOOP BACK IF NOT ACCESS TRACE ! 11917: {{BZE{KVTRA{ACS09{{IGNORE ACCESS TRACE IF TRACE OFF ! 11918: {{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT ! 11919: {{BZE{4*TRFNC(R9){ACS11{{JUMP IF PRINT TRACE ! 11920: {{EJC{{{{ ! 11921: * ! 11922: * ACESS (CONTINUED) ! 11923: * ! 11924: * HERE FOR FULL FUNCTION TRACE ! 11925: * ! 11926: {{JSR{TRXEQ{{{CALL ROUTINE TO EXECUTE TRACE ! 11927: {{BRN{ACS09{{{JUMP FOR NEXT TRBLK ! 11928: * ! 11929: * HERE FOR CASE OF PRINT TRACE ! 11930: * ! 11931: {ACS11{JSR{PRTSN{{{PRINT STATEMENT NUMBER ! 11932: {{JSR{PRTNV{{{PRINT NAME = VALUE ! 11933: {{BRN{ACS09{{{JUMP BACK FOR NEXT TRBLK ! 11934: * ! 11935: * HERE FOR KEYWORD VARIABLE ! 11936: * ! 11937: {ACS12{MOV{4*KVNUM(R10){R9{{LOAD KEYWORD NUMBER ! 11938: {{BGE{R9{#K$V$${ACS14{JUMP IF NOT ONE WORD VALUE ! 11939: {{MTI{L^KVABE(R9){{{ELSE LOAD VALUE AS INTEGER ! 11940: * ! 11941: * COMMON EXIT WITH KEYWORD VALUE AS INTEGER IN (IA) ! 11942: * ! 11943: {ACS13{JSR{ICBLD{{{BUILD ICBLK ! 11944: {{BRN{ACS18{{{JUMP TO EXIT ! 11945: * ! 11946: * HERE IF NOT ONE WORD KEYWORD VALUE ! 11947: * ! 11948: {ACS14{BGE{R9{#K$S$${ACS15{JUMP IF SPECIAL CASE ! 11949: {{SUB{#K$V$${R9{{ELSE GET OFFSET ! 11950: {{ADD{#NDABO{R9{{POINT TO PATTERN VALUE ! 11951: {{BRN{ACS18{{{JUMP TO EXIT ! 11952: * ! 11953: * HERE IF SPECIAL KEYWORD CASE ! 11954: * ! 11955: {ACS15{MOV{KVRTN{R10{{LOAD RTNTYPE IN CASE ! 11956: {{LDI{KVSTL{{{LOAD STLIMIT IN CASE ! 11957: {{SUB{#K$S$${R9{{GET CASE NUMBER ! 11958: {{BSW{R9{5{{SWITCH ON KEYWORD NUMBER ! 11959: {{IFF{K$$AL{ACS16{{JUMP IF ALPHABET ! 11960: {{IFF{K$$RT{ACS17{{RTNTYPE ! 11961: {{IFF{K$$SC{ACS19{{STCOUNT ! 11962: {{IFF{K$$ET{ACS20{{ERRTEXT ! 11963: {{IFF{K$$SL{ACS13{{STLIMIT ! 11964: {{ESW{{{{END SWITCH ON KEYWORD NUMBER ! 11965: {{EJC{{{{ ! 11966: * ! 11967: * ACESS (CONTINUED) ! 11968: * ! 11969: * ALPHABET ! 11970: * ! 11971: {ACS16{MOV{KVALP{R10{{LOAD POINTER TO ALPHABET STRING ! 11972: * ! 11973: * RTNTYPE MERGES HERE ! 11974: * ! 11975: {ACS17{MOV{R10{R9{{COPY STRING PTR TO PROPER REG ! 11976: * ! 11977: * COMMON RETURN POINT ! 11978: * ! 11979: {ACS18{EXI{{{{RETURN TO ACESS CALLER ! 11980: * ! 11981: * HERE FOR STCOUNT (IA HAS STLIMIT) ! 11982: * ! 11983: {ACS19{SBI{KVSTC{{{STCOUNT = LIMIT - LEFT ! 11984: {{BRN{ACS13{{{MERGE BACK WITH INTEGER RESULT ! 11985: * ! 11986: * ERRTEXT ! 11987: * ! 11988: {ACS20{MOV{R$ETX{R9{{GET ERRTEXT STRING ! 11989: {{BRN{ACS18{{{MERGE WITH RESULT ! 11990: * ! 11991: * HERE TO READ A RECORD FROM TERMINAL ! 11992: * ! 11993: {ACS21{MOV{#RILEN{R6{{BUFFER LENGTH ! 11994: {{JSR{ALOCS{{{ALLOCATE BUFFER ! 11995: {{JSR{SYSRI{{{READ RECORD ! 11996: {{PPM{ACS03{{{ENDFILE ! 11997: {{BRN{ACS07{{{MERGE WITH RECORD READ ! 11998: * ! 11999: * ERROR RETURNS ! 12000: * ! 12001: {ACS22{MOV{R9{DNAMP{{POP UNUSED SCBLK ! 12002: {{ERB{202{INPUT{{FROM FILE CAUSED NON-RECOVERABLE ERROR ! 12003: * ! 12004: {ACS23{MOV{R9{DNAMP{{POP UNUSED SCBLK ! 12005: {{ERB{203{INPUT{{FILE RECORD HAS INCORRECT FORMAT ! 12006: {{ENP{{{{END PROCEDURE ACESS ! 12007: {{EJC{{{{ ! 12008: * ! 12009: * ACOMP -- COMPARE TWO ARITHMETIC VALUES ! 12010: * ! 12011: * 1(XS) FIRST ARGUMENT ! 12012: * 0(XS) SECOND ARGUMENT ! 12013: * JSR ACOMP CALL TO COMPARE VALUES ! 12014: * PPM LOC TRANSFER LOC IF ARG1 IS NON-NUMERIC ! 12015: * PPM LOC TRANSFER LOC IF ARG2 IS NON-NUMERIC ! 12016: * PPM LOC TRANSFER LOC FOR ARG1 LT ARG2 ! 12017: * PPM LOC TRANSFER LOC FOR ARG1 EQ ARG2 ! 12018: * PPM LOC TRANSFER LOC FOR ARG1 GT ARG2 ! 12019: * (NORMAL RETURN IS NEVER GIVEN) ! 12020: * (WA,WB,WC,IA,RA) DESTROYED ! 12021: * (XL,XR) DESTROYED ! 12022: * ! 12023: {ACOMP{PRC{N{5{{ENTRY POINT ! 12024: {{JSR{ARITH{{{LOAD ARITHMETIC OPERANDS ! 12025: {{PPM{ACMP7{{{JUMP IF FIRST ARG NON-NUMERIC ! 12026: {{PPM{ACMP8{{{JUMP IF SECOND ARG NON-NUMERIC ! 12027: {{PPM{ACMP4{{{JUMP IF REAL ARGUMENTS ! 12028: * ! 12029: * HERE FOR INTEGER ARGUMENTS ! 12030: * ! 12031: {{SBI{4*ICVAL(R10){{{SUBTRACT TO COMPARE ! 12032: {{IOV{ACMP3{{{JUMP IF OVERFLOW ! 12033: {{ILT{ACMP5{{{ELSE JUMP IF ARG1 LT ARG2 ! 12034: {{IEQ{ACMP2{{{JUMP IF ARG1 EQ ARG2 ! 12035: * ! 12036: * HERE IF ARG1 GT ARG2 ! 12037: * ! 12038: {ACMP1{EXI{5{{{TAKE GT EXIT ! 12039: * ! 12040: * HERE IF ARG1 EQ ARG2 ! 12041: * ! 12042: {ACMP2{EXI{4{{{TAKE EQ EXIT ! 12043: {{EJC{{{{ ! 12044: * ! 12045: * ACOMP (CONTINUED) ! 12046: * ! 12047: * HERE FOR INTEGER OVERFLOW ON SUBTRACT ! 12048: * ! 12049: {ACMP3{LDI{4*ICVAL(R10){{{LOAD SECOND ARGUMENT ! 12050: {{ILT{ACMP1{{{GT IF NEGATIVE ! 12051: {{BRN{ACMP5{{{ELSE LT ! 12052: * ! 12053: * HERE FOR REAL OPERANDS ! 12054: * ! 12055: {ACMP4{SBR{4*RCVAL(R10){{{SUBTRACT TO COMPARE ! 12056: {{ROV{ACMP6{{{JUMP IF OVERFLOW ! 12057: {{RGT{ACMP1{{{ELSE JUMP IF ARG1 GT ! 12058: {{REQ{ACMP2{{{JUMP IF ARG1 EQ ARG2 ! 12059: * ! 12060: * HERE IF ARG1 LT ARG2 ! 12061: * ! 12062: {ACMP5{EXI{3{{{TAKE LT EXIT ! 12063: * ! 12064: * HERE IF OVERFLOW ON REAL SUBTRACTION ! 12065: * ! 12066: {ACMP6{LDR{4*RCVAL(R10){{{RELOAD ARG2 ! 12067: {{RLT{ACMP1{{{GT IF NEGATIVE ! 12068: {{BRN{ACMP5{{{ELSE LT ! 12069: * ! 12070: * HERE IF ARG1 NON-NUMERIC ! 12071: * ! 12072: {ACMP7{EXI{1{{{TAKE ERROR EXIT ! 12073: * ! 12074: * HERE IF ARG2 NON-NUMERIC ! 12075: * ! 12076: {ACMP8{EXI{2{{{TAKE ERROR EXIT ! 12077: {{ENP{{{{END PROCEDURE ACOMP ! 12078: {{EJC{{{{ ! 12079: * ! 12080: * ALLOC ALLOCATE BLOCK OF DYNAMIC STORAGE ! 12081: * ! 12082: * (WA) LENGTH REQUIRED IN BYTES ! 12083: * JSR ALLOC CALL TO ALLOCATE BLOCK ! 12084: * (XR) POINTER TO ALLOCATED BLOCK ! 12085: * ! 12086: * A POSSIBLE ALTERNATIVE TO AOV .. AND FOLLOWING STMT IS - ! 12087: * MOV DNAME,XR . SUB WA,XR . BLO XR,DNAMP,ALOC2 . ! 12088: * MOV DNAMP,XR . ADD WA,XR ! 12089: * ! 12090: {ALLOC{PRC{E{0{{ENTRY POINT ! 12091: * ! 12092: * COMMON EXIT POINT ! 12093: * ! 12094: {ALOC1{MOV{DNAMP{R9{{POINT TO NEXT AVAILABLE LOC ! 12095: {{AOV{R6{R9{ALOC2{POINT PAST ALLOCATED BLOCK ! 12096: {{BGT{R9{DNAME{ALOC2{JUMP IF NOT ENOUGH ROOM ! 12097: {{MOV{R9{DNAMP{{STORE NEW POINTER ! 12098: {{SUB{R6{R9{{POINT BACK TO START OF ALLOCATED BK ! 12099: {{EXI{{{{RETURN TO CALLER ! 12100: * ! 12101: * HERE IF INSUFFICIENT ROOM, TRY A GARBAGE COLLECTION ! 12102: * ! 12103: {ALOC2{MOV{R7{ALLSV{{SAVE WB ! 12104: {{ZER{R7{{{SET NO UPWARD MOVE FOR GBCOL ! 12105: {{JSR{GBCOL{{{GARBAGE COLLECT ! 12106: * ! 12107: * SEE IF ROOM AFTER GBCOL OR SYSMM CALL ! 12108: * ! 12109: {ALOC3{MOV{DNAMP{R9{{POINT TO FIRST AVAILABLE LOC ! 12110: {{AOV{R6{R9{ALC3A{POINT PAST NEW BLOCK ! 12111: {{BLO{R9{DNAME{ALOC4{JUMP IF THERE IS ROOM NOW ! 12112: * ! 12113: * FAILED AGAIN, SEE IF WE CAN GET MORE CORE ! 12114: * ! 12115: {ALC3A{JSR{SYSMM{{{TRY TO GET MORE MEMORY ! 12116: {{WTB{R9{{{CONVERT TO BAUS (SGD05) ! 12117: {{ADD{R9{DNAME{{BUMP PTR BY AMOUNT OBTAINED ! 12118: {{BNZ{R9{ALOC3{{JUMP IF GOT MORE CORE ! 12119: {{ADD{RSMEM{DNAME{{GET THE RESERVE MEMORY ! 12120: {{ZER{RSMEM{{{ONLY PERMISSIBLE ONCE ! 12121: {{ICV{ERRFT{{{FATAL ERROR ! 12122: {{ERB{204{MEMORY{{OVERFLOW ! 12123: {{EJC{{{{ ! 12124: * ! 12125: * HERE AFTER SUCCESSFUL GARBAGE COLLECTION ! 12126: * ! 12127: {ALOC4{STI{ALLIA{{{SAVE IA ! 12128: {{MOV{DNAME{R7{{GET DYNAMIC END ADRS ! 12129: {{SUB{DNAMP{R7{{COMPUTE FREE STORE ! 12130: {{BTW{R7{{{CONVERT BYTES TO WORDS ! 12131: {{MTI{R7{{{PUT FREE STORE IN IA ! 12132: {{MLI{ALFSF{{{MULTIPLY BY FREE STORE FACTOR ! 12133: {{IOV{ALOC5{{{JUMP IF OVERFLOWED ! 12134: {{MOV{DNAME{R7{{DYNAMIC END ADRS ! 12135: {{SUB{DNAMB{R7{{COMPUTE TOTAL AMOUNT OF DYNAMIC ! 12136: {{BTW{R7{{{CONVERT TO WORDS ! 12137: {{MOV{R7{ALDYN{{STORE IT ! 12138: {{SBI{ALDYN{{{SUBTRACT FROM SCALED UP FREE STORE ! 12139: {{IGT{ALOC5{{{JUMP IF SUFFICIENT FREE STORE ! 12140: {{JSR{SYSMM{{{TRY TO GET MORE STORE ! 12141: {{WTB{R9{{{CONVERT TO BAUS (SGD05) ! 12142: {{ADD{R9{DNAME{{ADJUST DYNAMIC END ADRS ! 12143: * ! 12144: * MERGE TO RESTORE IA AND WB ! 12145: * ! 12146: {ALOC5{LDI{ALLIA{{{RECOVER IA ! 12147: {{MOV{ALLSV{R7{{RESTORE WB ! 12148: {{BRN{ALOC1{{{JUMP BACK TO EXIT ! 12149: {{ENP{{{{END PROCEDURE ALLOC ! 12150: {{EJC{{{{ ! 12151: * ! 12152: * ALOBF -- ALLOCATE BUFFER ! 12153: * ! 12154: * THIS ROUTINES ALLOCATES A NEW BUFFER. AS THE BFBLK ! 12155: * AND BCBLK COME IN PAIRS, BOTH ARE ALLOCATED HERE, ! 12156: * AND XR POINTS TO THE BCBLK ON RETURN. THE BFBLK ! 12157: * AND BCBLK ARE SET TO THE NULL BUFFER, AND THE IDVAL ! 12158: * IS ZERO ON RETURN. ! 12159: * ! 12160: * (WA) BUFFER SIZE IN CHARACTERS ! 12161: * JSR ALOBF CALL TO CREATE BUFFER ! 12162: * (XR) BCBLK PTR ! 12163: * (WA,WB) DESTROYED ! 12164: * ! 12165: {ALOBF{PRC{E{0{{ENTRY POINT ! 12166: {{MOV{R6{R7{{HANG ONTO ALLOCATION SIZE ! 12167: {{CTB{R6{BFSI${{GET TOTAL BLOCK SIZE ! 12168: {{BGE{R6{MXLEN{ALB01{CHECK FOR MAXLEN EXCEEDED ! 12169: {{ADD{#4*BCSI${R6{{ADD IN ALLOCATION FOR BCBLK ! 12170: {{JSR{ALLOC{{{ALLOCATE FRAME ! 12171: {{MOV{#B$BCT{(R9){{SET TYPE ! 12172: {{ZER{4*IDVAL(R9){{{NO ID YET ! 12173: {{ZER{4*BCLEN(R9){{{NO DEFINED LENGTH ! 12174: {{MOV{R10{R6{{SAVE XL ! 12175: {{MOV{R9{R10{{COPY BCBLK PTR ! 12176: {{ADD{#4*BCSI${R10{{BIAS PAST PARTIALLY BUILT BCBLK ! 12177: {{MOV{#B$BFT{(R10){{SET BFBLK TYPE WORD ! 12178: {{MOV{R7{4*BFALC(R10){{SET ALLOCATED SIZE ! 12179: {{MOV{R10{4*BCBUF(R9){{SET POINTER IN BCBLK ! 12180: {{ZER{4*BFCHR(R10){{{CLEAR FIRST WORD (NULL PAD) ! 12181: {{MOV{R6{R10{{RESTORE ENTRY XL ! 12182: {{EXI{{{{RETURN TO CALLER ! 12183: * ! 12184: * HERE FOR MXLEN EXCEEDED ! 12185: * ! 12186: {ALB01{ERB{274{REQUESTED{{BUFFER ALLOCATION EXCEEDS MXLEN ! 12187: {{ENP{{{{END PROCEDURE ALOBF ! 12188: {{EJC{{{{ ! 12189: * ! 12190: * ALOCS -- ALLOCATE STRING BLOCK ! 12191: * ! 12192: * ALOCS IS USED TO BUILD A FRAME FOR A STRING BLOCK INTO ! 12193: * WHICH THE ACTUAL CHARACTERS ARE PLACED BY THE CALLER. ! 12194: * ALL STRINGS ARE CREATED WITH A CALL TO ALOCS (THE ! 12195: * EXCEPTIONS OCCUR IN TRIMR AND S$RPL PROCEDURES). ! 12196: * ! 12197: * (WA) LENGTH OF STRING TO BE ALLOCATED ! 12198: * JSR ALOCS CALL TO ALLOCATE SCBLK ! 12199: * (XR) POINTER TO RESULTING SCBLK ! 12200: * (WA) DESTROYED ! 12201: * (WC) CHARACTER COUNT (ENTRY VALUE OF WA) ! 12202: * ! 12203: * THE RESULTING SCBLK HAS THE TYPE WORD AND THE LENGTH ! 12204: * FILLED IN AND THE LAST WORD IS CLEARED TO ZERO CHARACTERS ! 12205: * TO ENSURE CORRECT RIGHT PADDING OF THE FINAL WORD. ! 12206: * ! 12207: {ALOCS{PRC{E{0{{ENTRY POINT ! 12208: {{BGT{R6{KVMXL{ALCS2{JUMP IF LENGTH EXCEEEDS MAXLENGTH ! 12209: {{MOV{R6{R8{{ELSE COPY LENGTH ! 12210: {{CTB{R6{SCSI${{COMPUTE LENGTH OF SCBLK IN BYTES ! 12211: {{MOV{DNAMP{R9{{POINT TO NEXT AVAILABLE LOCATION ! 12212: {{AOV{R6{R9{ALCS0{POINT PAST BLOCK ! 12213: {{BLO{R9{DNAME{ALCS1{JUMP IF THERE IS ROOM ! 12214: * ! 12215: * INSUFFICIENT MEMORY ! 12216: * ! 12217: {ALCS0{ZER{R9{{{ELSE CLEAR GARBAGE XR VALUE ! 12218: {{JSR{ALLOC{{{AND USE STANDARD ALLOCATOR ! 12219: {{ADD{R6{R9{{POINT PAST END OF BLOCK TO MERGE ! 12220: * ! 12221: * MERGE HERE WITH XR POINTING BEYOND NEW BLOCK ! 12222: * ! 12223: {ALCS1{MOV{R9{DNAMP{{SET UPDATED STORAGE POINTER ! 12224: {{ZER{-(R9){{{STORE ZERO CHARS IN LAST WORD ! 12225: {{DCA{R6{{{DECREMENT LENGTH ! 12226: {{SUB{R6{R9{{POINT BACK TO START OF BLOCK ! 12227: {{MOV{#B$SCL{(R9){{SET TYPE WORD ! 12228: {{MOV{R8{4*SCLEN(R9){{STORE LENGTH IN CHARS ! 12229: {{EXI{{{{RETURN TO ALOCS CALLER ! 12230: * ! 12231: * COME HERE IF STRING IS TOO LONG ! 12232: * ! 12233: {ALCS2{ERB{205{STRING{{LENGTH EXCEEDS VALUE OF MAXLNGTH KEYWORD ! 12234: {{ENP{{{{END PROCEDURE ALOCS ! 12235: {{EJC{{{{ ! 12236: * ! 12237: * ALOST -- ALLOCATE SPACE IN STATIC REGION ! 12238: * ! 12239: * (WA) LENGTH REQUIRED IN BYTES ! 12240: * JSR ALOST CALL TO ALLOCATE SPACE ! 12241: * (XR) POINTER TO ALLOCATED BLOCK ! 12242: * (WB) DESTROYED ! 12243: * ! 12244: * NOTE THAT THE CODING ENSURES THAT THE RESULTING VALUE ! 12245: * OF STATE IS ALWAYS LESS THAN DNAMB. THIS FACT IS USED ! 12246: * IN TESTING A VARIABLE NAME FOR BEING IN THE STATIC REGION ! 12247: * ! 12248: {ALOST{PRC{E{0{{ENTRY POINT ! 12249: * ! 12250: * MERGE BACK HERE AFTER ALLOCATING NEW CHUNK ! 12251: * ! 12252: {ALST1{MOV{STATE{R9{{POINT TO CURRENT END OF AREA ! 12253: {{AOV{R6{R9{ALST2{POINT BEYOND PROPOSED BLOCK ! 12254: {{BGE{R9{DNAMB{ALST2{JUMP IF OVERLAP WITH DYNAMIC AREA ! 12255: {{MOV{R9{STATE{{ELSE STORE NEW POINTER ! 12256: {{SUB{R6{R9{{POINT BACK TO START OF BLOCK ! 12257: {{EXI{{{{RETURN TO ALOST CALLER ! 12258: * ! 12259: * HERE IF NO ROOM, PREPARE TO MOVE DYNAMIC STORAGE UP ! 12260: * ! 12261: {ALST2{MOV{R6{ALSTA{{SAVE WA ! 12262: {{BGE{R6{#4*E$STS{ALST3{SKIP IF REQUESTED CHUNK IS LARGE ! 12263: {{MOV{#4*E$STS{R6{{ELSE SET TO GET LARGE ENOUGH CHUNK ! 12264: * ! 12265: * HERE WITH AMOUNT TO MOVE UP IN WA ! 12266: * ! 12267: {ALST3{JSR{ALLOC{{{ALLOCATE BLOCK TO ENSURE ROOM ! 12268: {{MOV{R9{DNAMP{{AND DELETE IT ! 12269: {{MOV{R6{R7{{COPY MOVE UP AMOUNT ! 12270: {{JSR{GBCOL{{{CALL GBCOL TO MOVE DYNAMIC AREA UP ! 12271: {{MOV{ALSTA{R6{{RESTORE WA ! 12272: {{BRN{ALST1{{{LOOP BACK TO TRY AGAIN ! 12273: {{ENP{{{{END PROCEDURE ALOST ! 12274: {{EJC{{{{ ! 12275: * ! 12276: * APNDB -- APPEND STRING TO BUFFER ! 12277: * ! 12278: * THIS ROUTINE IS USED BY BUFFER HANDLING ROUTINES TO ! 12279: * APPEND DATA TO AN EXISTING BFBLK. ! 12280: * ! 12281: * (XR) EXISTING BCBLK TO BE APPENDED ! 12282: * (XL) CONVERTABLE TO STRING ! 12283: * JSR APNDB CALL TO APPEND TO BUFFER ! 12284: * PPM LOC THREAD IF (XL) CANT BE CONVERTED ! 12285: * PPM LOC IF NOT ENOUGH ROOM ! 12286: * (WA,WB) DESTROYED ! 12287: * ! 12288: * IF MORE CHARACTERS ARE SPECIFIED THAN CAN BE INSERTED, ! 12289: * THEN NO ACTION IS TAKEN AND THE SECOND RETURN IS TAKEN. ! 12290: * ! 12291: {APNDB{PRC{E{2{{ENTRY POINT ! 12292: {{MOV{4*BCLEN(R9){R6{{LOAD OFFSET TO INSERT ! 12293: {{ZER{R7{{{REPLACE SECTION IS NULL ! 12294: {{JSR{INSBF{{{CALL TO INSERT AT END ! 12295: {{PPM{APN01{{{CONVERT ERROR ! 12296: {{PPM{APN02{{{NO ROOM ! 12297: {{EXI{{{{RETURN TO CALLER ! 12298: * ! 12299: * HERE TO TAKE CONVERT FAILURE EXIT ! 12300: * ! 12301: {APN01{EXI{1{{{RETURN TO CALLER ALTERNATE ! 12302: * ! 12303: * HERE FOR NO FIT EXIT ! 12304: * ! 12305: {APN02{EXI{2{{{ALTERNATE EXIT TO CALLER ! 12306: {{ENP{{{{END PROCEDURE APNDB ! 12307: {{EJC{{{{ ! 12308: * ! 12309: * ARITH -- FETCH ARITHMETIC OPERANDS ! 12310: * ! 12311: * ARITH IS USED BY FUNCTIONS AND OPERATORS WHICH EXPECT ! 12312: * TWO NUMERIC ARGUMENTS (OPERANDS) WHICH MUST BOTH BE ! 12313: * INTEGER OR BOTH BE REAL. ARITH FETCHES TWO ARGUMENTS FROM ! 12314: * THE STACK AND PERFORMS ANY NECESSARY CONVERSIONS. ! 12315: * ! 12316: * 1(XS) FIRST ARGUMENT (LEFT OPERAND) ! 12317: * 0(XS) SECOND ARGUMENT (RIGHT OPERAND) ! 12318: * JSR ARITH CALL TO FETCH NUMERIC ARGUMENTS ! 12319: * PPM LOC TRANSFER LOC FOR OPND 1 NON-NUMERIC ! 12320: * PPM LOC TRANSFER LOC FOR OPND 2 NON-NUMERIC ! 12321: * PPM LOC TRANSFER LOC FOR REAL OPERANDS ! 12322: * ! 12323: * FOR INTEGER ARGS, CONTROL RETURNS PAST THE PARAMETERS ! 12324: * ! 12325: * (IA) LEFT OPERAND VALUE ! 12326: * (XR) PTR TO ICBLK FOR LEFT OPERAND ! 12327: * (XL) PTR TO ICBLK FOR RIGHT OPERAND ! 12328: * (XS) POPPED TWICE ! 12329: * (WA,WB,RA) DESTROYED ! 12330: * ! 12331: * FOR REAL ARGUMENTS, CONTROL RETURNS TO THE LOCATION ! 12332: * SPECIFIED BY THE THIRD PARAMETER. ! 12333: * ! 12334: * (RA) LEFT OPERAND VALUE ! 12335: * (XR) PTR TO RCBLK FOR LEFT OPERAND ! 12336: * (XL) PTR TO RCBLK FOR RIGHT OPERAND ! 12337: * (WA,WB,WC) DESTROYED ! 12338: * (XS) POPPED TWICE ! 12339: {{EJC{{{{ ! 12340: * ! 12341: * ARITH (CONTINUED) ! 12342: * ! 12343: * ENTRY POINT ! 12344: * ! 12345: {ARITH{PRC{N{3{{ENTRY POINT ! 12346: {{MOV{(SP)+{R10{{LOAD RIGHT OPERAND ! 12347: {{MOV{(SP)+{R9{{LOAD LEFT OPERAND ! 12348: {{MOV{(R10){R6{{GET RIGHT OPERAND TYPE WORD ! 12349: {{BEQ{R6{#B$ICL{ARTH1{JUMP IF INTEGER ! 12350: {{BEQ{R6{#B$RCL{ARTH4{JUMP IF REAL ! 12351: {{MOV{R9{-(SP){{ELSE REPLACE LEFT ARG ON STACK ! 12352: {{MOV{R10{R9{{COPY LEFT ARG POINTER ! 12353: {{JSR{GTNUM{{{CONVERT TO NUMERIC ! 12354: {{PPM{ARTH6{{{JUMP IF UNCONVERTIBLE ! 12355: {{MOV{R9{R10{{ELSE COPY CONVERTED RESULT ! 12356: {{MOV{(R10){R6{{GET RIGHT OPERAND TYPE WORD ! 12357: {{MOV{(SP)+{R9{{RELOAD LEFT ARGUMENT ! 12358: {{BEQ{R6{#B$RCL{ARTH4{JUMP IF RIGHT ARG IS REAL ! 12359: * ! 12360: * HERE IF RIGHT ARG IS AN INTEGER ! 12361: * ! 12362: {ARTH1{BNE{(R9){#B$ICL{ARTH3{JUMP IF LEFT ARG NOT INTEGER ! 12363: * ! 12364: * EXIT FOR INTEGER CASE ! 12365: * ! 12366: {ARTH2{LDI{4*ICVAL(R9){{{LOAD LEFT OPERAND VALUE ! 12367: {{EXI{{{{RETURN TO ARITH CALLER ! 12368: * ! 12369: * HERE FOR RIGHT OPERAND INTEGER, LEFT OPERAND NOT ! 12370: * ! 12371: {ARTH3{JSR{GTNUM{{{CONVERT LEFT ARG TO NUMERIC ! 12372: {{PPM{ARTH7{{{JUMP IF NOT CONVERTIBLE ! 12373: {{BEQ{R6{#B$ICL{ARTH2{JUMP BACK IF INTEGER-INTEGER ! 12374: * ! 12375: * HERE WE MUST CONVERT REAL-INTEGER TO REAL-REAL ! 12376: * ! 12377: {{MOV{R9{-(SP){{PUT LEFT ARG BACK ON STACK ! 12378: {{LDI{4*ICVAL(R10){{{LOAD RIGHT ARGUMENT VALUE ! 12379: {{ITR{{{{CONVERT TO REAL ! 12380: {{JSR{RCBLD{{{GET REAL BLOCK FOR RIGHT ARG, MERGE ! 12381: {{MOV{R9{R10{{COPY RIGHT ARG PTR ! 12382: {{MOV{(SP)+{R9{{LOAD LEFT ARGUMENT ! 12383: {{BRN{ARTH5{{{MERGE FOR REAL-REAL CASE ! 12384: {{EJC{{{{ ! 12385: * ! 12386: * ARITH (CONTINUED) ! 12387: * ! 12388: * HERE IF RIGHT ARGUMENT IS REAL ! 12389: * ! 12390: {ARTH4{BEQ{(R9){#B$RCL{ARTH5{JUMP IF LEFT ARG REAL ! 12391: {{JSR{GTREA{{{ELSE CONVERT TO REAL ! 12392: {{PPM{ARTH7{{{ERROR IF UNCONVERTIBLE ! 12393: * ! 12394: * HERE FOR REAL-REAL ! 12395: * ! 12396: {ARTH5{LDR{4*RCVAL(R9){{{LOAD LEFT OPERAND VALUE ! 12397: {{EXI{3{{{TAKE REAL-REAL EXIT ! 12398: * ! 12399: * HERE FOR ERROR CONVERTING RIGHT ARGUMENT ! 12400: * ! 12401: {ARTH6{ICA{SP{{{POP UNWANTED LEFT ARG ! 12402: {{EXI{2{{{TAKE APPROPRIATE ERROR EXIT ! 12403: * ! 12404: * HERE FOR ERROR CONVERTING LEFT OPERAND ! 12405: * ! 12406: {ARTH7{EXI{1{{{TAKE APPROPRIATE ERROR RETURN ! 12407: {{ENP{{{{END PROCEDURE ARITH ! 12408: {{EJC{{{{ ! 12409: * ! 12410: * ASIGN -- PERFORM ASSIGNMENT ! 12411: * ! 12412: * ASIGN PERFORMS THE ASSIGNMENT OF A VALUE TO A VARIABLE ! 12413: * WITH APPROPRIATE CHECKS FOR OUTPUT ASSOCIATIONS AND ! 12414: * VALUE TRACE ASSOCIATIONS WHICH ARE EXECUTED AS REQUIRED. ! 12415: * ASIGN ALSO HANDLES THE SPECIAL CASES OF ASSIGNMENT TO ! 12416: * PATTERN AND EXPRESSION VARIABLES. ! 12417: * ! 12418: * (WB) VALUE TO BE ASSIGNED ! 12419: * (XL) BASE POINTER FOR VARIABLE ! 12420: * (WA) OFFSET FOR VARIABLE ! 12421: * JSR ASIGN CALL TO ASSIGN VALUE TO VARIABLE ! 12422: * PPM LOC TRANSFER LOC FOR FAILURE ! 12423: * (XR,XL,WA,WB,WC) DESTROYED ! 12424: * (RA) DESTROYED ! 12425: * ! 12426: * FAILURE OCCURS IF THE EVALUATION OF AN EXPRESSION ! 12427: * ASSOCIATED WITH AN EXPRESSION VARIABLE FAILS. ! 12428: * ! 12429: {ASIGN{PRC{R{1{{ENTRY POINT (RECURSIVE) ! 12430: * ! 12431: * MERGE BACK HERE TO ASSIGN RESULT TO EXPRESSION VARIABLE. ! 12432: * ! 12433: {ASG01{ADD{R6{R10{{POINT TO VARIABLE VALUE ! 12434: {{MOV{(R10){R9{{LOAD VARIABLE VALUE ! 12435: {{BEQ{(R9){#B$TRT{ASG02{JUMP IF TRAPPED ! 12436: {{MOV{R7{(R10){{ELSE PERFORM ASSIGNMENT ! 12437: {{ZER{R10{{{CLEAR GARBAGE VALUE IN XL ! 12438: {{EXI{{{{AND RETURN TO ASIGN CALLER ! 12439: * ! 12440: * HERE IF VALUE IS TRAPPED ! 12441: * ! 12442: {ASG02{SUB{R6{R10{{RESTORE NAME BASE ! 12443: {{BEQ{R9{#TRBKV{ASG14{JUMP IF KEYWORD VARIABLE ! 12444: {{BNE{R9{#TRBEV{ASG04{JUMP IF NOT EXPRESSION VARIABLE ! 12445: * ! 12446: * HERE FOR ASSIGNMENT TO EXPRESSION VARIABLE ! 12447: * ! 12448: {{MOV{4*EVEXP(R10){R9{{POINT TO EXPRESSION ! 12449: {{MOV{R7{-(SP){{STORE VALUE TO ASSIGN ON STACK ! 12450: {{MOV{#NUM01{R7{{SET FOR EVALUATION BY NAME ! 12451: {{JSR{EVALX{{{EVALUATE EXPRESSION BY NAME ! 12452: {{PPM{ASG03{{{JUMP IF EVALUATION FAILS ! 12453: {{MOV{(SP)+{R7{{ELSE RELOAD VALUE TO ASSIGN ! 12454: {{BRN{ASG01{{{LOOP BACK TO PERFORM ASSIGNMENT ! 12455: {{EJC{{{{ ! 12456: * ! 12457: * ASIGN (CONTINUED) ! 12458: * ! 12459: * HERE FOR FAILURE DURING EXPRESSION EVALUATION ! 12460: * ! 12461: {ASG03{ICA{SP{{{REMOVE STACKED VALUE ENTRY ! 12462: {{EXI{1{{{TAKE FAILURE EXIT ! 12463: * ! 12464: * HERE IF NOT KEYWORD OR EXPRESSION VARIABLE ! 12465: * ! 12466: {ASG04{MOV{R9{-(SP){{SAVE PTR TO FIRST TRBLK ! 12467: * ! 12468: * LOOP TO CHASE DOWN TRBLK CHAIN AND ASSIGN VALUE AT END ! 12469: * ! 12470: {ASG05{MOV{R9{R8{{SAVE PTR TO THIS TRBLK ! 12471: {{MOV{4*TRNXT(R9){R9{{POINT TO NEXT TRBLK ! 12472: {{BEQ{(R9){#B$TRT{ASG05{LOOP BACK IF ANOTHER TRBLK ! 12473: {{MOV{R8{R9{{ELSE POINT BACK TO LAST TRBLK ! 12474: {{MOV{R7{4*TRVAL(R9){{STORE VALUE AT END OF CHAIN ! 12475: {{MOV{(SP)+{R9{{RESTORE PTR TO FIRST TRBLK ! 12476: * ! 12477: * LOOP TO PROCESS TRBLK ENTRIES ON CHAIN ! 12478: * ! 12479: {ASG06{MOV{4*TRTYP(R9){R7{{LOAD TYPE CODE OF TRBLK ! 12480: {{BEQ{R7{#TRTVL{ASG08{JUMP IF VALUE TRACE ! 12481: {{BEQ{R7{#TRTOU{ASG10{JUMP IF OUTPUT ASSOCIATION ! 12482: * ! 12483: * HERE TO MOVE TO NEXT TRBLK ON CHAIN ! 12484: * ! 12485: {ASG07{MOV{4*TRNXT(R9){R9{{POINT TO NEXT TRBLK ON CHAIN ! 12486: {{BEQ{(R9){#B$TRT{ASG06{LOOP BACK IF ANOTHER TRBLK ! 12487: {{EXI{{{{ELSE END OF CHAIN, RETURN TO CALLER ! 12488: * ! 12489: * HERE TO PROCESS VALUE TRACE ! 12490: * ! 12491: {ASG08{BZE{KVTRA{ASG07{{IGNORE VALUE TRACE IF TRACE OFF ! 12492: {{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT ! 12493: {{BZE{4*TRFNC(R9){ASG09{{JUMP IF PRINT TRACE ! 12494: {{JSR{TRXEQ{{{ELSE EXECUTE FUNCTION TRACE ! 12495: {{BRN{ASG07{{{AND LOOP BACK ! 12496: {{EJC{{{{ ! 12497: * ! 12498: * ASIGN (CONTINUED) ! 12499: * ! 12500: * HERE FOR PRINT TRACE ! 12501: * ! 12502: {ASG09{JSR{PRTSN{{{PRINT STATEMENT NUMBER ! 12503: {{JSR{PRTNV{{{PRINT NAME = VALUE ! 12504: {{BRN{ASG07{{{LOOP BACK FOR NEXT TRBLK ! 12505: * ! 12506: * HERE FOR OUTPUT ASSOCIATION ! 12507: * ! 12508: {ASG10{BZE{KVOUP{ASG07{{IGNORE OUTPUT ASSOC IF OUTPUT OFF ! 12509: {{MOV{R9{R10{{ELSE COPY TRBLK POINTER ! 12510: {{MOV{4*TRVAL(R8){-(SP){{STACK VALUE TO OUTPUT (SGD01) ! 12511: {{JSR{GTSTG{{{CONVERT TO STRING ! 12512: {{PPM{ASG12{{{GET DATATYPE NAME IF UNCONVERTIBLE ! 12513: * ! 12514: * MERGE WITH STRING FOR OUTPUT ! 12515: * ! 12516: {ASG11{MOV{4*TRFPT(R10){R6{{FCBLK PTR ! 12517: {{BZE{R6{ASG13{{JUMP IF STANDARD OUTPUT FILE ! 12518: * ! 12519: * HERE FOR OUTPUT TO NON-STANDARD OUTPUT FILE ! 12520: * ! 12521: {{JSR{SYSOU{{{CALL SYSTEM OUTPUT ROUTINE ! 12522: {{ERR{206{OUTPUT{{CAUSED FILE OVERFLOW ! 12523: {{ERR{207{OUTPUT{{CAUSED NON-RECOVERABLE ERROR ! 12524: {{EXI{{{{ELSE ALL DONE, RETURN TO CALLER ! 12525: * ! 12526: * IF NOT PRINTABLE, GET DATATYPE NAME INSTEAD ! 12527: * ! 12528: {ASG12{JSR{DTYPE{{{CALL DATATYPE ROUTINE ! 12529: {{BRN{ASG11{{{MERGE ! 12530: * ! 12531: * HERE TO PRINT A STRING ON THE PRINTER ! 12532: * ! 12533: {ASG13{JSR{PRTST{{{PRINT STRING VALUE ! 12534: {{BEQ{4*TRTER(R10){#V$TER{ASG20{JUMP IF TERMINAL OUTPUT ! 12535: {{JSR{PRTNL{{{END OF LINE ! 12536: {{EXI{{{{RETURN TO CALLER ! 12537: {{EJC{{{{ ! 12538: * ! 12539: * ASIGN (CONTINUED) ! 12540: * ! 12541: * HERE FOR KEYWORD ASSIGNMENT ! 12542: * ! 12543: {ASG14{MOV{4*KVNUM(R10){R10{{LOAD KEYWORD NUMBER ! 12544: {{BEQ{R10{#K$ETX{ASG19{JUMP IF ERRTEXT ! 12545: {{MOV{R7{R9{{COPY VALUE TO BE ASSIGNED ! 12546: {{JSR{GTINT{{{CONVERT TO INTEGER ! 12547: {{ERR{208{KEYWORD{{VALUE ASSIGNED IS NOT INTEGER ! 12548: {{LDI{4*ICVAL(R9){{{ELSE LOAD VALUE ! 12549: {{BEQ{R10{#K$STL{ASG16{JUMP IF SPECIAL CASE OF STLIMIT ! 12550: {{MFI{R6{ASG18{{ELSE GET ADDR INTEGER, TEST OVFLOW ! 12551: {{BGE{R6{MXLEN{ASG18{FAIL IF TOO LARGE ! 12552: {{BEQ{R10{#K$ERT{ASG17{JUMP IF SPECIAL CASE OF ERRTYPE ! 12553: {{BEQ{R10{#K$PFL{ASG21{JUMP IF SPECIAL CASE OF PROFILE ! 12554: {{BLT{R10{#K$P$${ASG15{JUMP UNLESS PROTECTED ! 12555: {{ERB{209{KEYWORD{{IN ASSIGNMENT IS PROTECTED ! 12556: * ! 12557: * HERE TO DO ASSIGNMENT IF NOT PROTECTED ! 12558: * ! 12559: {ASG15{MOV{R6{L^KVABE(R10){{STORE NEW VALUE ! 12560: {{EXI{{{{RETURN TO ASIGN CALLER ! 12561: * ! 12562: * HERE FOR SPECIAL CASE OF STLIMIT ! 12563: * ! 12564: * SINCE STCOUNT IS MAINTAINED AS (STLIMIT-STCOUNT) ! 12565: * IT IS ALSO NECESSARY TO MODIFY STCOUNT APPROPRIATELY. ! 12566: * ! 12567: {ASG16{SBI{KVSTL{{{SUBTRACT OLD LIMIT ! 12568: {{ADI{KVSTC{{{ADD OLD COUNTER ! 12569: {{STI{KVSTC{{{STORE NEW COUNTER VALUE ! 12570: {{LDI{4*ICVAL(R9){{{RELOAD NEW LIMIT VALUE ! 12571: {{STI{KVSTL{{{STORE NEW LIMIT VALUE ! 12572: {{EXI{{{{RETURN TO ASIGN CALLER ! 12573: * ! 12574: * HERE FOR SPECIAL CASE OF ERRTYPE ! 12575: * ! 12576: {ASG17{BLE{R6{#NINI9{ERROR{OK TO SIGNAL IF IN RANGE ! 12577: * ! 12578: * HERE IF VALUE ASSIGNED IS OUT OF RANGE ! 12579: * ! 12580: {ASG18{ERB{210{KEYWORD{{VALUE ASSIGNED IS NEGATIVE OR TOO LARGE ! 12581: * ! 12582: * HERE FOR SPECIAL CASE OF ERRTEXT ! 12583: * ! 12584: {ASG19{MOV{R7{-(SP){{STACK VALUE ! 12585: {{JSR{GTSTG{{{CONVERT TO STRING ! 12586: {{ERR{211{VALUE{{ASSIGNED TO KEYWORD ERRTEXT NOT A STRING ! 12587: {{MOV{R9{R$ETX{{MAKE ASSIGNMENT ! 12588: {{EXI{{{{RETURN TO CALLER ! 12589: * ! 12590: * PRINT STRING TO TERMINAL ! 12591: * ! 12592: {ASG20{JSR{PRTTR{{{PRINT ! 12593: {{EXI{{{{RETURN ! 12594: * ! 12595: * HERE FOR KEYWORD PROFILE ! 12596: * ! 12597: {ASG21{BGT{R6{#NUM02{ASG18{MOAN IF NOT 0,1, OR 2 ! 12598: {{BZE{R6{ASG15{{JUST ASSIGN IF ZERO ! 12599: {{BZE{PFDMP{ASG22{{BRANCH IF FIRST ASSIGNMENT ! 12600: {{BEQ{R6{PFDMP{ASG23{ALSO IF SAME VALUE AS BEFORE ! 12601: {{ERB{268{INCONSISTENT{{VALUE ASSIGNED TO KEYWORD PROFILE ! 12602: * ! 12603: {ASG22{MOV{R6{PFDMP{{NOTE VALUE ON FIRST ASSIGNMENT ! 12604: {ASG23{JSR{SYSTM{{{GET THE TIME ! 12605: {{STI{PFSTM{{{FUDGE SOME KIND OF START TIME ! 12606: {{BRN{ASG15{{{AND GO ASSIGN ! 12607: {{ENP{{{{END PROCEDURE ASIGN ! 12608: {{EJC{{{{ ! 12609: * ! 12610: * ASINP -- ASSIGN DURING PATTERN MATCH ! 12611: * ! 12612: * ASINP IS LIKE ASIGN AND HAS A SIMILAR CALLING SEQUENCE ! 12613: * AND EFFECT. THE DIFFERENCE IS THAT THE GLOBAL PATTERN ! 12614: * VARIABLES ARE SAVED AND RESTORED IF REQUIRED. ! 12615: * ! 12616: * (XL) BASE POINTER FOR VARIABLE ! 12617: * (WA) OFFSET FOR VARIABLE ! 12618: * (WB) VALUE TO BE ASSIGNED ! 12619: * JSR ASINP CALL TO ASSIGN VALUE TO VARIABLE ! 12620: * PPM LOC TRANSFER LOC IF FAILURE ! 12621: * (XR,XL) DESTROYED ! 12622: * (WA,WB,WC,RA) DESTROYED ! 12623: * ! 12624: {ASINP{PRC{R{1{{ENTRY POINT, RECURSIVE ! 12625: {{ADD{R6{R10{{POINT TO VARIABLE ! 12626: {{MOV{(R10){R9{{LOAD CURRENT CONTENTS ! 12627: {{BEQ{(R9){#B$TRT{ASNP1{JUMP IF TRAPPED ! 12628: {{MOV{R7{(R10){{ELSE PERFORM ASSIGNMENT ! 12629: {{ZER{R10{{{CLEAR GARBAGE VALUE IN XL ! 12630: {{EXI{{{{RETURN TO ASINP CALLER ! 12631: * ! 12632: * HERE IF VARIABLE IS TRAPPED ! 12633: * ! 12634: {ASNP1{SUB{R6{R10{{RESTORE BASE POINTER ! 12635: {{MOV{PMSSL{-(SP){{STACK SUBJECT STRING LENGTH ! 12636: {{MOV{PMHBS{-(SP){{STACK HISTORY STACK BASE PTR ! 12637: {{MOV{R$PMS{-(SP){{STACK SUBJECT STRING POINTER ! 12638: {{MOV{PMDFL{-(SP){{STACK DOT FLAG ! 12639: {{JSR{ASIGN{{{CALL FULL-BLOWN ASSIGNMENT ROUTINE ! 12640: {{PPM{ASNP2{{{JUMP IF FAILURE ! 12641: {{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG ! 12642: {{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER ! 12643: {{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER ! 12644: {{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH ! 12645: {{EXI{{{{RETURN TO ASINP CALLER ! 12646: * ! 12647: * HERE IF FAILURE IN ASIGN CALL ! 12648: * ! 12649: {ASNP2{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG ! 12650: {{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER ! 12651: {{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER ! 12652: {{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH ! 12653: {{EXI{1{{{TAKE FAILURE EXIT ! 12654: {{ENP{{{{END PROCEDURE ASINP ! 12655: {{EJC{{{{ ! 12656: * ! 12657: * BLKLN -- DETERMINE LENGTH OF BLOCK ! 12658: * ! 12659: * BLKLN DETERMINES THE LENGTH OF A BLOCK IN DYNAMIC STORE. ! 12660: * ! 12661: * (WA) FIRST WORD OF BLOCK ! 12662: * (XR) POINTER TO BLOCK ! 12663: * JSR BLKLN CALL TO GET BLOCK LENGTH ! 12664: * (WA) LENGTH OF BLOCK IN BYTES ! 12665: * (XL) DESTROYED ! 12666: * ! 12667: * BLKLN IS USED BY THE GARBAGE COLLECTOR AND IS NOT ! 12668: * PERMITTED TO CALL GBCOL DIRECTLY OR INDIRECTLY. ! 12669: * ! 12670: * THE FIRST WORD STORED IN THE BLOCK (I.E. AT XR) MAY ! 12671: * BE ANYTHING, BUT THE CONTENTS OF WA MUST BE CORRECT. ! 12672: * ! 12673: {BLKLN{PRC{E{0{{ENTRY POINT ! 12674: {{MOV{R6{R10{{COPY FIRST WORD ! 12675: {{LEI{R10{{{GET ENTRY ID (BL$XX) ! 12676: {{BSW{R10{BL$$${BLN00{SWITCH ON BLOCK TYPE ! 12677: {{IFF{BL$AR{BLN01{{ARBLK ! 12678: {{IFF{BL$BC{BLN04{{BCBLK ! 12679: {{IFF{BL$CD{BLN01{{CDBLK ! 12680: {{IFF{BL$EX{BLN01{{EXBLK ! 12681: {{IFF{BL$IC{BLN07{{ICBLK ! 12682: {{IFF{BL$NM{BLN03{{NMBLK ! 12683: {{IFF{BL$P0{BLN02{{P0BLK ! 12684: {{IFF{BL$P1{BLN03{{P1BLK ! 12685: {{IFF{BL$P2{BLN04{{P2BLK ! 12686: {{IFF{BL$RC{BLN09{{RCBLK ! 12687: {{IFF{BL$SC{BLN10{{SCBLK ! 12688: {{IFF{BL$SE{BLN02{{SEBLK ! 12689: {{IFF{BL$TB{BLN01{{TBBLK ! 12690: {{IFF{BL$VC{BLN01{{VCBLK ! 12691: {{IFF{DUMMY{BLN00{{ ! 12692: {{IFF{DUMMY{BLN00{{ ! 12693: {{IFF{BL$PD{BLN08{{PDBLK ! 12694: {{IFF{BL$TR{BLN05{{TRBLK ! 12695: {{IFF{BL$BF{BLN11{{BFBLK ! 12696: {{IFF{DUMMY{BLN00{{ ! 12697: {{IFF{DUMMY{BLN00{{ ! 12698: {{IFF{BL$CT{BLN06{{CTBLK ! 12699: {{IFF{BL$DF{BLN01{{DFBLK ! 12700: {{IFF{BL$EF{BLN01{{EFBLK ! 12701: {{IFF{BL$EV{BLN03{{EVBLK ! 12702: {{IFF{BL$FF{BLN05{{FFBLK ! 12703: {{IFF{BL$KV{BLN03{{KVBLK ! 12704: {{IFF{BL$PF{BLN01{{PFBLK ! 12705: {{IFF{BL$TE{BLN04{{TEBLK ! 12706: {{ESW{{{{END OF JUMP TABLE ON BLOCK TYPE ! 12707: {{EJC{{{{ ! 12708: * ! 12709: * BLKLN (CONTINUED) ! 12710: * ! 12711: * HERE FOR BLOCKS WITH LENGTH IN SECOND WORD ! 12712: * ! 12713: {BLN00{MOV{4*1(R9){R6{{LOAD LENGTH ! 12714: {{EXI{{{{RETURN TO BLKLN CALLER ! 12715: * ! 12716: * HERE FOR LENGTH IN THIRD WORD (AR,CD,DF,EF,EX,PF,TB,VC) ! 12717: * ! 12718: {BLN01{MOV{4*2(R9){R6{{LOAD LENGTH FROM THIRD WORD ! 12719: {{EXI{{{{RETURN TO BLKLN CALLER ! 12720: * ! 12721: * HERE FOR TWO WORD BLOCKS (P0,SE) ! 12722: * ! 12723: {BLN02{MOV{#4*NUM02{R6{{LOAD LENGTH (TWO WORDS) ! 12724: {{EXI{{{{RETURN TO BLKLN CALLER ! 12725: * ! 12726: * HERE FOR THREE WORD BLOCKS (NM,P1,EV,KV) ! 12727: * ! 12728: {BLN03{MOV{#4*NUM03{R6{{LOAD LENGTH (THREE WORDS) ! 12729: {{EXI{{{{RETURN TO BLKLN CALLER ! 12730: * ! 12731: * HERE FOR FOUR WORD BLOCKS (P2,TE,BC) ! 12732: * ! 12733: {BLN04{MOV{#4*NUM04{R6{{LOAD LENGTH (FOUR WORDS) ! 12734: {{EXI{{{{RETURN TO BLKLN CALLER ! 12735: * ! 12736: * HERE FOR FIVE WORD BLOCKS (FF,TR) ! 12737: * ! 12738: {BLN05{MOV{#4*NUM05{R6{{LOAD LENGTH ! 12739: {{EXI{{{{RETURN TO BLKLN CALLER ! 12740: {{EJC{{{{ ! 12741: * ! 12742: * BLKLN (CONTINUED) ! 12743: * ! 12744: * HERE FOR CTBLK ! 12745: * ! 12746: {BLN06{MOV{#4*CTSI${R6{{SET SIZE OF CTBLK ! 12747: {{EXI{{{{RETURN TO BLKLN CALLER ! 12748: * ! 12749: * HERE FOR ICBLK ! 12750: * ! 12751: {BLN07{MOV{#4*ICSI${R6{{SET SIZE OF ICBLK ! 12752: {{EXI{{{{RETURN TO BLKLN CALLER ! 12753: * ! 12754: * HERE FOR PDBLK ! 12755: * ! 12756: {BLN08{MOV{4*PDDFP(R9){R10{{POINT TO DFBLK ! 12757: {{MOV{4*DFPDL(R10){R6{{LOAD PDBLK LENGTH FROM DFBLK ! 12758: {{EXI{{{{RETURN TO BLKLN CALLER ! 12759: * ! 12760: * HERE FOR RCBLK ! 12761: * ! 12762: {BLN09{MOV{#4*RCSI${R6{{SET SIZE OF RCBLK ! 12763: {{EXI{{{{RETURN TO BLKLN CALLER ! 12764: * ! 12765: * HERE FOR SCBLK ! 12766: * ! 12767: {BLN10{MOV{4*SCLEN(R9){R6{{LOAD LENGTH IN CHARACTERS ! 12768: {{CTB{R6{SCSI${{CALCULATE LENGTH IN BYTES ! 12769: {{EXI{{{{RETURN TO BLKLN CALLER ! 12770: * ! 12771: * HERE FOR BFBLK ! 12772: * ! 12773: {BLN11{MOV{4*BFALC(R9){R6{{GET ALLOCATION IN BYTES ! 12774: {{CTB{R6{BFSI${{CALCULATE LENGTH IN BYTES ! 12775: {{EXI{{{{RETURN TO BLKLN CALLER ! 12776: {{ENP{{{{END PROCEDURE BLKLN ! 12777: {{EJC{{{{ ! 12778: * ! 12779: * COPYB -- COPY A BLOCK ! 12780: * ! 12781: * (XS) BLOCK TO BE COPIED ! 12782: * JSR COPYB CALL TO COPY BLOCK ! 12783: * PPM LOC RETURN IF BLOCK HAS NO IDVAL FIELD ! 12784: * NORMAL RETURN IF IDVAL FIELD ! 12785: * (XR) COPY OF BLOCK ! 12786: * (XS) POPPED ! 12787: * (XL,WA,WB,WC) DESTROYED ! 12788: * ! 12789: {COPYB{PRC{N{1{{ENTRY POINT ! 12790: {{MOV{(SP){R9{{LOAD ARGUMENT ! 12791: {{BEQ{R9{#NULLS{COP10{RETURN ARGUMENT IF IT IS NULL ! 12792: {{MOV{(R9){R6{{ELSE LOAD TYPE WORD ! 12793: {{MOV{R6{R7{{COPY TYPE WORD ! 12794: {{JSR{BLKLN{{{GET LENGTH OF ARGUMENT BLOCK ! 12795: {{MOV{R9{R10{{COPY POINTER ! 12796: {{JSR{ALLOC{{{ALLOCATE BLOCK OF SAME SIZE ! 12797: {{MOV{R9{(SP){{STORE POINTER TO COPY ! 12798: {{MVW{{{{COPY CONTENTS OF OLD BLOCK TO NEW ! 12799: {{MOV{(SP){R9{{RELOAD POINTER TO START OF COPY ! 12800: {{BEQ{R7{#B$TBT{COP05{JUMP IF TABLE ! 12801: {{BEQ{R7{#B$VCT{COP01{JUMP IF VECTOR ! 12802: {{BEQ{R7{#B$PDT{COP01{JUMP IF PROGRAM DEFINED ! 12803: {{BEQ{R7{#B$BCT{COP11{JUMP IF BUFFER ! 12804: {{BNE{R7{#B$ART{COP10{RETURN COPY IF NOT ARRAY ! 12805: * ! 12806: * HERE FOR ARRAY (ARBLK) ! 12807: * ! 12808: {{ADD{4*AROFS(R9){R9{{POINT TO PROTOTYPE FIELD ! 12809: {{BRN{COP02{{{JUMP TO MERGE ! 12810: * ! 12811: * HERE FOR VECTOR, PROGRAM DEFINED ! 12812: * ! 12813: {COP01{ADD{#4*PDFLD{R9{{POINT TO PDFLD = VCVLS ! 12814: * ! 12815: * MERGE HERE FOR ARBLK, VCBLK, PDBLK TO DELETE TRAP ! 12816: * BLOCKS FROM ALL VALUE FIELDS (THE COPY IS UNTRAPPED) ! 12817: * ! 12818: {COP02{MOV{(R9){R10{{LOAD NEXT POINTER ! 12819: * ! 12820: * LOOP TO GET VALUE AT END OF TRBLK CHAIN ! 12821: * ! 12822: {COP03{BNE{(R10){#B$TRT{COP04{JUMP IF NOT TRAPPED ! 12823: {{MOV{4*TRVAL(R10){R10{{ELSE POINT TO NEXT VALUE ! 12824: {{BRN{COP03{{{AND LOOP BACK ! 12825: {{EJC{{{{ ! 12826: * ! 12827: * COPYB (CONTINUED) ! 12828: * ! 12829: * HERE WITH UNTRAPPED VALUE IN XL ! 12830: * ! 12831: {COP04{MOV{R10{(R9)+{{STORE REAL VALUE, BUMP POINTER ! 12832: {{BNE{R9{DNAMP{COP02{LOOP BACK IF MORE TO GO ! 12833: {{BRN{COP09{{{ELSE JUMP TO EXIT ! 12834: * ! 12835: * HERE TO COPY A TABLE ! 12836: * ! 12837: {COP05{ZER{4*IDVAL(R9){{{ZERO ID TO STOP DUMP BLOWING UP ! 12838: {{MOV{#4*TESI${R6{{SET SIZE OF TEBLK ! 12839: {{MOV{#4*TBBUK{R8{{SET INITIAL OFFSET ! 12840: * ! 12841: * LOOP THROUGH BUCKETS IN TABLE ! 12842: * ! 12843: {COP06{MOV{(SP){R9{{LOAD TABLE POINTER ! 12844: {{BEQ{R8{4*TBLEN(R9){COP09{JUMP TO EXIT IF ALL DONE ! 12845: {{ADD{R8{R9{{ELSE POINT TO NEXT BUCKET HEADER ! 12846: {{ICA{R8{{{BUMP OFFSET ! 12847: {{SUB{#4*TENXT{R9{{SUBTRACT LINK OFFSET TO MERGE ! 12848: * ! 12849: * LOOP THROUGH TEBLKS ON ONE CHAIN ! 12850: * ! 12851: {COP07{MOV{4*TENXT(R9){R10{{LOAD POINTER TO NEXT TEBLK ! 12852: {{MOV{(SP){4*TENXT(R9){{SET END OF CHAIN POINTER IN CASE ! 12853: {{BEQ{(R10){#B$TBT{COP06{BACK FOR NEXT BUCKET IF CHAIN END ! 12854: {{MOV{R9{-(SP){{ELSE STACK PTR TO PREVIOUS BLOCK ! 12855: {{MOV{#4*TESI${R6{{SET SIZE OF TEBLK ! 12856: {{JSR{ALLOC{{{ALLOCATE NEW TEBLK ! 12857: {{MOV{R9{R7{{SAVE PTR TO NEW TEBLK ! 12858: {{MVW{{{{COPY OLD TEBLK TO NEW TEBLK ! 12859: {{MOV{R7{R9{{RESTORE POINTER TO NEW TEBLK ! 12860: {{MOV{(SP)+{R10{{RESTORE POINTER TO PREVIOUS BLOCK ! 12861: {{MOV{R9{4*TENXT(R10){{LINK NEW BLOCK TO PREVIOUS ! 12862: {{MOV{R9{R10{{COPY POINTER TO NEW BLOCK ! 12863: * ! 12864: * LOOP TO SET REAL VALUE AFTER REMOVING TRAP CHAIN ! 12865: * ! 12866: {COP08{MOV{4*TEVAL(R10){R10{{LOAD VALUE ! 12867: {{BEQ{(R10){#B$TRT{COP08{LOOP BACK IF TRAPPED ! 12868: {{MOV{R10{4*TEVAL(R9){{STORE UNTRAPPED VALUE IN TEBLK ! 12869: {{BRN{COP07{{{BACK FOR NEXT TEBLK ! 12870: * ! 12871: * COMMON EXIT POINT ! 12872: * ! 12873: {COP09{MOV{(SP)+{R9{{LOAD POINTER TO BLOCK ! 12874: {{EXI{{{{RETURN ! 12875: * ! 12876: * ALTERNATIVE RETURN ! 12877: * ! 12878: {COP10{EXI{1{{{RETURN ! 12879: {{EJC{{{{ ! 12880: * ! 12881: * HERE TO COPY BUFFER ! 12882: * ! 12883: {COP11{MOV{4*BCBUF(R9){R10{{GET BFBLK PTR ! 12884: {{MOV{4*BFALC(R10){R6{{GET ALLOCATION ! 12885: {{CTB{R6{BFSI${{SET TOTAL SIZE ! 12886: {{MOV{R9{R10{{SAVE BCBLK PTR ! 12887: {{JSR{ALLOC{{{ALLOCATE BFBLK ! 12888: {{MOV{4*BCBUF(R10){R7{{GET OLD BFBLK ! 12889: {{MOV{R9{4*BCBUF(R10){{SET POINTER TO NEW BFBLK ! 12890: {{MOV{R7{R10{{POINT TO OLD BFBLK ! 12891: {{MVW{{{{COPY BFBLK TOO ! 12892: {{ZER{R10{{{CLEAR RUBBISH PTR ! 12893: {{BRN{COP09{{{BRANCH TO EXIT ! 12894: {{ENP{{{{END PROCEDURE COPYB ! 12895: * ! 12896: * CDGCG -- GENERATE CODE FOR COMPLEX GOTO ! 12897: * ! 12898: * USED BY CMPIL TO PROCESS COMPLEX GOTO TREE ! 12899: * ! 12900: * (WB) MUST BE COLLECTABLE ! 12901: * (XR) EXPRESSION POINTER ! 12902: * JSR CDGCG CALL TO GENERATE COMPLEX GOTO ! 12903: * (XL,XR,WA) DESTROYED ! 12904: * ! 12905: {CDGCG{PRC{E{0{{ENTRY POINT ! 12906: {{MOV{4*CMOPN(R9){R10{{GET UNARY GOTO OPERATOR ! 12907: {{MOV{4*CMROP(R9){R9{{POINT TO GOTO OPERAND ! 12908: {{BEQ{R10{#OPDVD{CDGC2{JUMP IF DIRECT GOTO ! 12909: {{JSR{CDGNM{{{GENERATE OPND BY NAME IF NOT DIRECT ! 12910: * ! 12911: * RETURN POINT ! 12912: * ! 12913: {CDGC1{MOV{R10{R6{{GOTO OPERATOR ! 12914: {{JSR{CDWRD{{{GENERATE IT ! 12915: {{EXI{{{{RETURN TO CALLER ! 12916: * ! 12917: * DIRECT GOTO ! 12918: * ! 12919: {CDGC2{JSR{CDGVL{{{GENERATE OPERAND BY VALUE ! 12920: {{BRN{CDGC1{{{MERGE TO RETURN ! 12921: {{ENP{{{{END PROCEDURE CDGCG ! 12922: {{EJC{{{{ ! 12923: * ! 12924: * CDGEX -- BUILD EXPRESSION BLOCK ! 12925: * ! 12926: * CDGEX IS PASSED A POINTER TO AN EXPRESSION TREE (SEE ! 12927: * EXPAN) AND RETURNS AN EXPRESSION (SEBLK OR EXBLK). ! 12928: * ! 12929: * (WC) SOME COLLECTABLE VALUE ! 12930: * (WB) INTEGER IN RANGE 0 LE X LE MXLEN ! 12931: * (XL) PTR TO EXPRESSION TREE ! 12932: * JSR CDGEX CALL TO BUILD EXPRESSION ! 12933: * (XR) PTR TO SEBLK OR EXBLK ! 12934: * (XL,WA,WB) DESTROYED ! 12935: * ! 12936: {CDGEX{PRC{R{0{{ENTRY POINT, RECURSIVE ! 12937: {{BLO{(R10){#B$VR${CDGX1{JUMP IF NOT VARIABLE ! 12938: * ! 12939: * HERE FOR NATURAL VARIABLE, BUILD SEBLK ! 12940: * ! 12941: {{MOV{#4*SESI${R6{{SET SIZE OF SEBLK ! 12942: {{JSR{ALLOC{{{ALLOCATE SPACE FOR SEBLK ! 12943: {{MOV{#B$SEL{(R9){{SET TYPE WORD ! 12944: {{MOV{R10{4*SEVAR(R9){{STORE VRBLK POINTER ! 12945: {{EXI{{{{RETURN TO CDGEX CALLER ! 12946: * ! 12947: * HERE IF NOT VARIABLE, BUILD EXBLK ! 12948: * ! 12949: {CDGX1{MOV{R10{R9{{COPY TREE POINTER ! 12950: {{MOV{R8{-(SP){{SAVE WC ! 12951: {{MOV{CWCOF{R10{{SAVE CURRENT OFFSET ! 12952: {{MOV{(R9){R6{{GET TYPE WORD ! 12953: {{BNE{R6{#B$CMT{CDGX2{CALL BY VALUE IF NOT CMBLK ! 12954: {{BGE{4*CMTYP(R9){#C$$NM{CDGX2{JUMP IF CMBLK ONLY BY VALUE ! 12955: {{EJC{{{{ ! 12956: * ! 12957: * CDGEX (CONTINUED) ! 12958: * ! 12959: * HERE IF EXPRESSION CAN BE EVALUATED BY NAME ! 12960: * ! 12961: {{JSR{CDGNM{{{GENERATE CODE BY NAME ! 12962: {{MOV{#ORNM${R6{{LOAD RETURN BY NAME WORD ! 12963: {{BRN{CDGX3{{{MERGE WITH VALUE CASE ! 12964: * ! 12965: * HERE IF EXPRESSION CAN ONLY BE EVALUATED BY VALUE ! 12966: * ! 12967: {CDGX2{JSR{CDGVL{{{GENERATE CODE BY VALUE ! 12968: {{MOV{#ORVL${R6{{LOAD RETURN BY VALUE WORD ! 12969: * ! 12970: * MERGE HERE TO CONSTRUCT EXBLK ! 12971: * ! 12972: {CDGX3{JSR{CDWRD{{{GENERATE RETURN WORD ! 12973: {{JSR{EXBLD{{{BUILD EXBLK ! 12974: {{MOV{(SP)+{R8{{RESTORE WC ! 12975: {{EXI{{{{RETURN TO CDGEX CALLER ! 12976: {{ENP{{{{END PROCEDURE CDGEX ! 12977: {{EJC{{{{ ! 12978: * ! 12979: * CDGNM -- GENERATE CODE BY NAME ! 12980: * ! 12981: * CDGNM IS CALLED DURING THE COMPILATION PROCESS TO ! 12982: * GENERATE CODE BY NAME FOR AN EXPRESSION. SEE CDBLK ! 12983: * DESCRIPTION FOR DETAILS OF CODE GENERATED. THE INPUT ! 12984: * TO CDGNM IS AN EXPRESSION TREE AS GENERATED BY EXPAN. ! 12985: * ! 12986: * CDGNM IS A RECURSIVE PROCEDURE WHICH PROCEEDS BY MAKING ! 12987: * RECURSIVE CALLS TO GENERATE CODE FOR OPERANDS. ! 12988: * ! 12989: * (WB) INTEGER IN RANGE 0 LE N LE DNAMB ! 12990: * (XR) PTR TO TREE GENERATED BY EXPAN ! 12991: * (WC) CONSTANT FLAG (SEE BELOW) ! 12992: * JSR CDGNM CALL TO GENERATE CODE BY NAME ! 12993: * (XR,WA) DESTROYED ! 12994: * (WC) SET NON-ZERO IF NON-CONSTANT ! 12995: * ! 12996: * WC IS SET TO A NON-ZERO (COLLECTABLE) VALUE IF THE ! 12997: * EXPRESSION FOR WHICH CODE IS GENERATED CANNOT BE ! 12998: * EVALUATED AT COMPILE TIME, OTHERWISE WC IS UNCHANGED. ! 12999: * ! 13000: * THE CODE IS GENERATED IN THE CURRENT CCBLK (SEE CDWRD). ! 13001: * ! 13002: {CDGNM{PRC{R{0{{ENTRY POINT, RECURSIVE ! 13003: {{MOV{R10{-(SP){{SAVE ENTRY XL ! 13004: {{MOV{R7{-(SP){{SAVE ENTRY WB ! 13005: {{CHK{{{{CHECK FOR STACK OVERFLOW ! 13006: {{MOV{(R9){R6{{LOAD TYPE WORD ! 13007: {{BEQ{R6{#B$CMT{CGN04{JUMP IF CMBLK ! 13008: {{BHI{R6{#B$VR${CGN02{JUMP IF SIMPLE VARIABLE ! 13009: * ! 13010: * MERGE HERE FOR OPERAND YIELDING VALUE (E.G. CONSTANT) ! 13011: * ! 13012: {CGN01{ERB{212{SYNTAX{{ERROR. VALUE USED WHERE NAME IS REQUIRED ! 13013: * ! 13014: * HERE FOR NATURAL VARIABLE REFERENCE ! 13015: * ! 13016: {CGN02{MOV{#OLVN${R6{{LOAD VARIABLE LOAD CALL ! 13017: {{JSR{CDWRD{{{GENERATE IT ! 13018: {{MOV{R9{R6{{COPY VRBLK POINTER ! 13019: {{JSR{CDWRD{{{GENERATE VRBLK POINTER ! 13020: {{EJC{{{{ ! 13021: * ! 13022: * CDGNM (CONTINUED) ! 13023: * ! 13024: * HERE TO EXIT WITH WC SET CORRECTLY ! 13025: * ! 13026: {CGN03{MOV{(SP)+{R7{{RESTORE ENTRY WB ! 13027: {{MOV{(SP)+{R10{{RESTORE ENTRY XL ! 13028: {{EXI{{{{RETURN TO CDGNM CALLER ! 13029: * ! 13030: * HERE FOR CMBLK ! 13031: * ! 13032: {CGN04{MOV{R9{R10{{COPY CMBLK POINTER ! 13033: {{MOV{4*CMTYP(R9){R9{{LOAD CMBLK TYPE ! 13034: {{BGE{R9{#C$$NM{CGN01{ERROR IF NOT NAME OPERAND ! 13035: {{BSW{R9{C$$NM{{ELSE SWITCH ON TYPE ! 13036: {{IFF{C$ARR{CGN05{{ARRAY REFERENCE ! 13037: {{IFF{C$FNC{CGN08{{FUNCTION CALL ! 13038: {{IFF{C$DEF{CGN09{{DEFERRED EXPRESSION ! 13039: {{IFF{C$IND{CGN10{{INDIRECT REFERENCE ! 13040: {{IFF{C$KEY{CGN11{{KEYWORD REFERENCE ! 13041: {{IFF{C$UBO{CGN08{{UNDEFINED BINARY OP ! 13042: {{IFF{C$UUO{CGN08{{UNDEFINED UNARY OP ! 13043: {{ESW{{{{END SWITCH ON CMBLK TYPE ! 13044: * ! 13045: * HERE TO GENERATE CODE FOR ARRAY REFERENCE ! 13046: * ! 13047: {CGN05{MOV{#4*CMOPN{R7{{POINT TO ARRAY OPERAND ! 13048: * ! 13049: * LOOP TO GENERATE CODE FOR ARRAY OPERAND AND SUBSCRIPTS ! 13050: * ! 13051: {CGN06{JSR{CMGEN{{{GENERATE CODE FOR NEXT OPERAND ! 13052: {{MOV{4*CMLEN(R10){R8{{LOAD LENGTH OF CMBLK ! 13053: {{BLT{R7{R8{CGN06{LOOP TILL ALL GENERATED ! 13054: * ! 13055: * GENERATE APPROPRIATE ARRAY CALL ! 13056: * ! 13057: {{MOV{#OAON${R6{{LOAD ONE-SUBSCRIPT CASE CALL ! 13058: {{BEQ{R8{#4*CMAR1{CGN07{JUMP TO EXIT IF ONE SUBSCRIPT CASE ! 13059: {{MOV{#OAMN${R6{{ELSE LOAD MULTI-SUBSCRIPT CASE CALL ! 13060: {{JSR{CDWRD{{{GENERATE CALL ! 13061: {{MOV{R8{R6{{COPY CMBLK LENGTH ! 13062: {{BTW{R6{{{CONVERT TO WORDS ! 13063: {{SUB{#CMVLS{R6{{CALCULATE NUMBER OF SUBSCRIPTS ! 13064: {{EJC{{{{ ! 13065: * ! 13066: * CDGNM (CONTINUED) ! 13067: * ! 13068: * HERE TO EXIT GENERATING WORD (NON-CONSTANT) ! 13069: * ! 13070: {CGN07{MNZ{R8{{{SET RESULT NON-CONSTANT ! 13071: {{JSR{CDWRD{{{GENERATE WORD ! 13072: {{BRN{CGN03{{{BACK TO EXIT ! 13073: * ! 13074: * HERE TO GENERATE CODE FOR FUNCTIONS AND UNDEFINED OPRS ! 13075: * ! 13076: {CGN08{MOV{R10{R9{{COPY CMBLK POINTER ! 13077: {{JSR{CDGVL{{{GEN CODE BY VALUE FOR CALL ! 13078: {{MOV{#OFNE${R6{{GET EXTRA CALL FOR BY NAME ! 13079: {{BRN{CGN07{{{BACK TO GENERATE AND EXIT ! 13080: * ! 13081: * HERE TO GENERATE CODE FOR DEFERED EXPRESSION ! 13082: * ! 13083: {CGN09{MOV{4*CMROP(R10){R9{{CHECK IF VARIABLE ! 13084: {{BHI{(R9){#B$VR${CGN02{TREAT *VARIABLE AS SIMPLE VAR ! 13085: {{MOV{R9{R10{{COPY PTR TO EXPRESSION TREE ! 13086: {{JSR{CDGEX{{{ELSE BUILD EXBLK ! 13087: {{MOV{#OLEX${R6{{SET CALL TO LOAD EXPR BY NAME ! 13088: {{JSR{CDWRD{{{GENERATE IT ! 13089: {{MOV{R9{R6{{COPY EXBLK POINTER ! 13090: {{JSR{CDWRD{{{GENERATE EXBLK POINTER ! 13091: {{BRN{CGN03{{{BACK TO EXIT ! 13092: * ! 13093: * HERE TO GENERATE CODE FOR INDIRECT REFERENCE ! 13094: * ! 13095: {CGN10{MOV{4*CMROP(R10){R9{{GET OPERAND ! 13096: {{JSR{CDGVL{{{GENERATE CODE BY VALUE FOR IT ! 13097: {{MOV{#OINN${R6{{LOAD CALL FOR INDIRECT BY NAME ! 13098: {{BRN{CGN12{{{MERGE ! 13099: * ! 13100: * HERE TO GENERATE CODE FOR KEYWORD REFERENCE ! 13101: * ! 13102: {CGN11{MOV{4*CMROP(R10){R9{{GET OPERAND ! 13103: {{JSR{CDGNM{{{GENERATE CODE BY NAME FOR IT ! 13104: {{MOV{#OKWN${R6{{LOAD CALL FOR KEYWORD BY NAME ! 13105: * ! 13106: * KEYWORD, INDIRECT MERGE HERE ! 13107: * ! 13108: {CGN12{JSR{CDWRD{{{GENERATE CODE FOR OPERATOR ! 13109: {{BRN{CGN03{{{EXIT ! 13110: {{ENP{{{{END PROCEDURE CDGNM ! 13111: {{EJC{{{{ ! 13112: * ! 13113: * CDGVL -- GENERATE CODE BY VALUE ! 13114: * ! 13115: * CDGVL IS CALLED DURING THE COMPILATION PROCESS TO ! 13116: * GENERATE CODE BY VALUE FOR AN EXPRESSION. SEE CDBLK ! 13117: * DESCRIPTION FOR DETAILS OF THE CODE GENERATED. THE INPUT ! 13118: * TO CDGVL IS AN EXPRESSION TREE AS GENERATED BY EXPAN. ! 13119: * ! 13120: * CDGVL IS A RECURSIVE PROCEDURE WHICH PROCEEDS BY MAKING ! 13121: * RECURSIVE CALLS TO GENERATE CODE FOR OPERANDS. ! 13122: * ! 13123: * (WB) INTEGER IN RANGE 0 LE N LE DNAMB ! 13124: * (XR) PTR TO TREE GENERATED BY EXPAN ! 13125: * (WC) CONSTANT FLAG (SEE BELOW) ! 13126: * JSR CDGVL CALL TO GENERATE CODE BY VALUE ! 13127: * (XR,WA) DESTROYED ! 13128: * (WC) SET NON-ZERO IF NON-CONSTANT ! 13129: * ! 13130: * WC IS SET TO A NON-ZERO (COLLECTABLE) VALUE IF THE ! 13131: * EXPRESSION FOR WHICH CODE IS GENERATED CANNOT BE ! 13132: * EVALUATED AT COMPILE TIME, OTHERWISE WC IS UNCHANGED. ! 13133: * ! 13134: * IF WC IS NON-ZERO ON ENTRY, THEN PREEVALUATION IS NOT ! 13135: * ALLOWED REGARDLESS OF THE NATURE OF THE OPERAND. ! 13136: * ! 13137: * THE CODE IS GENERATED IN THE CURRENT CCBLK (SEE CDWRD). ! 13138: * ! 13139: {CDGVL{PRC{R{0{{ENTRY POINT, RECURSIVE ! 13140: {{MOV{(R9){R6{{LOAD TYPE WORD ! 13141: {{BEQ{R6{#B$CMT{CGV01{JUMP IF CMBLK ! 13142: {{BLT{R6{#B$VRA{CGV00{JUMP IF ICBLK, RCBLK, SCBLK ! 13143: {{BNZ{4*VRLEN(R9){CGVL0{{JUMP IF NOT SYSTEM VARIABLE ! 13144: {{MOV{R9{-(SP){{STACK XR ! 13145: {{MOV{4*VRSVP(R9){R9{{POINT TO SVBLK ! 13146: {{MOV{4*SVBIT(R9){R6{{GET SVBLK PROPERTY BITS ! 13147: {{MOV{(SP)+{R9{{RECOVER XR ! 13148: {{ANB{BTCKW{R6{{CHECK IF CONSTANT KEYWORD ! 13149: {{NZB{R6{CGV00{{JUMP IF CONSTANT KEYWORD ! 13150: * ! 13151: * HERE FOR VARIABLE VALUE REFERENCE ! 13152: * ! 13153: {CGVL0{MNZ{R8{{{INDICATE NON-CONSTANT VALUE ! 13154: * ! 13155: * MERGE HERE FOR SIMPLE CONSTANT (ICBLK,RCBLK,SCBLK) ! 13156: * AND FOR VARIABLES CORRESPONDING TO CONSTANT KEYWORDS. ! 13157: * ! 13158: {CGV00{MOV{R9{R6{{COPY PTR TO VAR OR CONSTANT ! 13159: {{JSR{CDWRD{{{GENERATE AS CODE WORD ! 13160: {{EXI{{{{RETURN TO CALLER ! 13161: {{EJC{{{{ ! 13162: * ! 13163: * CDGVL (CONTINUED) ! 13164: * ! 13165: * HERE FOR TREE NODE (CMBLK) ! 13166: * ! 13167: {CGV01{MOV{R7{-(SP){{SAVE ENTRY WB ! 13168: {{MOV{R10{-(SP){{SAVE ENTRY XL ! 13169: {{MOV{R8{-(SP){{SAVE ENTRY CONSTANT FLAG ! 13170: {{MOV{CWCOF{-(SP){{SAVE INITIAL CODE OFFSET ! 13171: {{CHK{{{{CHECK FOR STACK OVERFLOW ! 13172: * ! 13173: * PREPARE TO GENERATE CODE FOR CMBLK. WC IS SET TO THE ! 13174: * VALUE OF CSWNO (ZERO IF -OPTIMISE, 1 IF -NOOPT) TO ! 13175: * START WITH AND IS RESET NON-ZERO FOR ANY NON-CONSTANT ! 13176: * CODE GENERATED. IF IT IS STILL ZERO AFTER GENERATING ALL ! 13177: * THE CMBLK CODE, THEN ITS VALUE IS COMPUTED AS THE RESULT. ! 13178: * ! 13179: {{MOV{R9{R10{{COPY CMBLK POINTER ! 13180: {{MOV{4*CMTYP(R9){R9{{LOAD CMBLK TYPE ! 13181: {{MOV{CSWNO{R8{{RESET CONSTANT FLAG ! 13182: {{BLE{R9{#C$PR${CGV02{JUMP IF NOT PREDICATE VALUE ! 13183: {{MNZ{R8{{{ELSE FORCE NON-CONSTANT CASE ! 13184: * ! 13185: * HERE WITH WC SET APPROPRIATELY ! 13186: * ! 13187: {CGV02{BSW{R9{C$$NV{{SWITCH TO APPROPRIATE GENERATOR ! 13188: {{IFF{C$ARR{CGV03{{ARRAY REFERENCE ! 13189: {{IFF{C$FNC{CGV05{{FUNCTION CALL ! 13190: {{IFF{C$DEF{CGV14{{DEFERRED EXPRESSION ! 13191: {{IFF{C$IND{CGV31{{INDIRECT REFERENCE ! 13192: {{IFF{C$KEY{CGV27{{KEYWORD REFERENCE ! 13193: {{IFF{C$UBO{CGV29{{UNDEFINED BINOP ! 13194: {{IFF{C$UUO{CGV30{{UNDEFINED UNOP ! 13195: {{IFF{C$BVL{CGV18{{BINOPS WITH VAL OPDS ! 13196: {{IFF{C$UVL{CGV19{{UNOPS WITH VALU OPND ! 13197: {{IFF{C$ALT{CGV18{{ALTERNATION ! 13198: {{IFF{C$CNC{CGV24{{CONCATENATION ! 13199: {{IFF{C$CNP{CGV24{{CONCATENATION (NOT PATTERN MATCH) ! 13200: {{IFF{C$UNM{CGV27{{UNOPS WITH NAME OPND ! 13201: {{IFF{C$BVN{CGV26{{BINARY $ AND . ! 13202: {{IFF{C$ASS{CGV21{{ASSIGNMENT ! 13203: {{IFF{C$INT{CGV31{{INTERROGATION ! 13204: {{IFF{C$NEG{CGV28{{NEGATION ! 13205: {{IFF{C$SEL{CGV15{{SELECTION ! 13206: {{IFF{C$PMT{CGV18{{PATTERN MATCH ! 13207: {{ESW{{{{END SWITCH ON CMBLK TYPE ! 13208: {{EJC{{{{ ! 13209: * ! 13210: * CDGVL (CONTINUED) ! 13211: * ! 13212: * HERE TO GENERATE CODE FOR ARRAY REFERENCE ! 13213: * ! 13214: {CGV03{MOV{#4*CMOPN{R7{{SET OFFSET TO ARRAY OPERAND ! 13215: * ! 13216: * LOOP TO GENERATE CODE FOR ARRAY OPERAND AND SUBSCRIPTS ! 13217: * ! 13218: {CGV04{JSR{CMGEN{{{GEN VALUE CODE FOR NEXT OPERAND ! 13219: {{MOV{4*CMLEN(R10){R8{{LOAD CMBLK LENGTH ! 13220: {{BLT{R7{R8{CGV04{LOOP BACK IF MORE TO GO ! 13221: * ! 13222: * GENERATE CALL TO APPROPRIATE ARRAY REFERENCE ROUTINE ! 13223: * ! 13224: {{MOV{#OAOV${R6{{SET ONE SUBSCRIPT CALL IN CASE ! 13225: {{BEQ{R8{#4*CMAR1{CGV32{JUMP TO EXIT IF 1-SUB CASE ! 13226: {{MOV{#OAMV${R6{{ELSE SET CALL FOR MULTI-SUBSCRIPTS ! 13227: {{JSR{CDWRD{{{GENERATE CALL ! 13228: {{MOV{R8{R6{{COPY LENGTH OF CMBLK ! 13229: {{SUB{#4*CMVLS{R6{{SUBTRACT STANDARD LENGTH ! 13230: {{BTW{R6{{{GET NUMBER OF WORDS ! 13231: {{BRN{CGV32{{{JUMP TO GENERATE SUBSCRIPT COUNT ! 13232: * ! 13233: * HERE TO GENERATE CODE FOR FUNCTION CALL ! 13234: * ! 13235: {CGV05{MOV{#4*CMVLS{R7{{SET OFFSET TO FIRST ARGUMENT ! 13236: * ! 13237: * LOOP TO GENERATE CODE FOR ARGUMENTS ! 13238: * ! 13239: {CGV06{BEQ{R7{4*CMLEN(R10){CGV07{JUMP IF ALL GENERATED ! 13240: {{JSR{CMGEN{{{ELSE GEN VALUE CODE FOR NEXT ARG ! 13241: {{BRN{CGV06{{{BACK TO GENERATE NEXT ARGUMENT ! 13242: * ! 13243: * HERE TO GENERATE ACTUAL FUNCTION CALL ! 13244: * ! 13245: {CGV07{SUB{#4*CMVLS{R7{{GET NUMBER OF ARG PTRS (BYTES) ! 13246: {{BTW{R7{{{CONVERT BYTES TO WORDS ! 13247: {{MOV{4*CMOPN(R10){R9{{LOAD FUNCTION VRBLK POINTER ! 13248: {{BNZ{4*VRLEN(R9){CGV12{{JUMP IF NOT SYSTEM FUNCTION ! 13249: {{MOV{4*VRSVP(R9){R10{{LOAD SVBLK PTR IF SYSTEM VAR ! 13250: {{MOV{4*SVBIT(R10){R6{{LOAD BIT MASK ! 13251: {{ANB{BTFFC{R6{{TEST FOR FAST FUNCTION CALL ALLOWED ! 13252: {{ZRB{R6{CGV12{{JUMP IF NOT ! 13253: {{EJC{{{{ ! 13254: * ! 13255: * CDGVL (CONTINUED) ! 13256: * ! 13257: * HERE IF FAST FUNCTION CALL IS ALLOWED ! 13258: * ! 13259: {{MOV{4*SVBIT(R10){R6{{RELOAD BIT INDICATORS ! 13260: {{ANB{BTPRE{R6{{TEST FOR PREEVALUATION OK ! 13261: {{NZB{R6{CGV08{{JUMP IF PREEVALUATION PERMITTED ! 13262: {{MNZ{R8{{{ELSE SET RESULT NON-CONSTANT ! 13263: * ! 13264: * TEST FOR CORRECT NUMBER OF ARGS FOR FAST CALL ! 13265: * ! 13266: {CGV08{MOV{4*VRFNC(R9){R10{{LOAD PTR TO SVFNC FIELD ! 13267: {{MOV{4*FARGS(R10){R6{{LOAD SVNAR FIELD VALUE ! 13268: {{BEQ{R6{R7{CGV11{JUMP IF ARGUMENT COUNT IS CORRECT ! 13269: {{BHI{R6{R7{CGV09{JUMP IF TOO FEW ARGUMENTS GIVEN ! 13270: * ! 13271: * HERE IF TOO MANY ARGUMENTS, PREPARE TO GENERATE O$POPS ! 13272: * ! 13273: {{SUB{R6{R7{{GET NUMBER OF EXTRA ARGS ! 13274: {{LCT{R7{R7{{SET AS COUNT TO CONTROL LOOP ! 13275: {{MOV{#OPOP${R6{{SET POP CALL ! 13276: {{BRN{CGV10{{{JUMP TO COMMON LOOP ! 13277: * ! 13278: * HERE IF TOO FEW ARGUMENTS, PREPARE TO GENERATE NULLS ! 13279: * ! 13280: {CGV09{SUB{R7{R6{{GET NUMBER OF MISSING ARGUMENTS ! 13281: {{LCT{R7{R6{{LOAD AS COUNT TO CONTROL LOOP ! 13282: {{MOV{#NULLS{R6{{LOAD PTR TO NULL CONSTANT ! 13283: * ! 13284: * LOOP TO GENERATE CALLS TO FIX ARGUMENT COUNT ! 13285: * ! 13286: {CGV10{JSR{CDWRD{{{GENERATE ONE CALL ! 13287: {{BCT{R7{CGV10{{LOOP TILL ALL GENERATED ! 13288: * ! 13289: * HERE AFTER ADJUSTING ARG COUNT AS REQUIRED ! 13290: * ! 13291: {CGV11{MOV{R10{R6{{COPY POINTER TO SVFNC FIELD ! 13292: {{BRN{CGV36{{{JUMP TO GENERATE CALL ! 13293: {{EJC{{{{ ! 13294: * ! 13295: * CDGVL (CONTINUED) ! 13296: * ! 13297: * COME HERE IF FAST CALL IS NOT PERMITTED ! 13298: * ! 13299: {CGV12{MOV{#OFNS${R6{{SET ONE ARG CALL IN CASE ! 13300: {{BEQ{R7{#NUM01{CGV13{JUMP IF ONE ARG CASE ! 13301: {{MOV{#OFNC${R6{{ELSE LOAD CALL FOR MORE THAN 1 ARG ! 13302: {{JSR{CDWRD{{{GENERATE IT ! 13303: {{MOV{R7{R6{{COPY ARGUMENT COUNT ! 13304: * ! 13305: * ONE ARG CASE MERGES HERE ! 13306: * ! 13307: {CGV13{JSR{CDWRD{{{GENERATE =O$FNS OR ARG COUNT ! 13308: {{MOV{R9{R6{{COPY VRBLK POINTER ! 13309: {{BRN{CGV32{{{JUMP TO GENERATE VRBLK PTR ! 13310: * ! 13311: * HERE FOR DEFERRED EXPRESSION ! 13312: * ! 13313: {CGV14{MOV{4*CMROP(R10){R10{{POINT TO EXPRESSION TREE ! 13314: {{JSR{CDGEX{{{BUILD EXBLK OR SEBLK ! 13315: {{MOV{R9{R6{{COPY BLOCK PTR ! 13316: {{JSR{CDWRD{{{GENERATE PTR TO EXBLK OR SEBLK ! 13317: {{BRN{CGV34{{{JUMP TO EXIT, CONSTANT TEST ! 13318: * ! 13319: * HERE TO GENERATE CODE FOR SELECTION ! 13320: * ! 13321: {CGV15{ZER{-(SP){{{ZERO PTR TO CHAIN OF FORWARD JUMPS ! 13322: {{ZER{-(SP){{{ZERO PTR TO PREV O$SLC FORWARD PTR ! 13323: {{MOV{#4*CMVLS{R7{{POINT TO FIRST ALTERNATIVE ! 13324: {{MOV{#OSLA${R6{{SET INITIAL CODE WORD ! 13325: * ! 13326: * 0(XS) IS THE OFFSET TO THE PREVIOUS WORD ! 13327: * WHICH REQUIRES FILLING IN WITH AN ! 13328: * OFFSET TO THE FOLLOWING O$SLC,O$SLD ! 13329: * ! 13330: * 1(XS) IS THE HEAD OF A CHAIN OF OFFSET ! 13331: * POINTERS INDICATING THOSE LOCATIONS ! 13332: * TO BE FILLED WITH OFFSETS PAST ! 13333: * THE END OF ALL THE ALTERNATIVES ! 13334: * ! 13335: {CGV16{JSR{CDWRD{{{GENERATE O$SLC (O$SLA FIRST TIME) ! 13336: {{MOV{CWCOF{(SP){{SET CURRENT LOC AS PTR TO FILL IN ! 13337: {{JSR{CDWRD{{{GENERATE GARBAGE WORD THERE FOR NOW ! 13338: {{JSR{CMGEN{{{GEN VALUE CODE FOR ALTERNATIVE ! 13339: {{MOV{#OSLB${R6{{LOAD O$SLB POINTER ! 13340: {{JSR{CDWRD{{{GENERATE O$SLB CALL ! 13341: {{MOV{4*1(SP){R6{{LOAD OLD CHAIN PTR ! 13342: {{MOV{CWCOF{4*1(SP){{SET CURRENT LOC AS NEW CHAIN HEAD ! 13343: {{JSR{CDWRD{{{GENERATE FORWARD CHAIN LINK ! 13344: {{EJC{{{{ ! 13345: * ! 13346: * CDGVL (CONTINUED) ! 13347: * ! 13348: * NOW TO FILL IN THE SKIP OFFSET TO O$SLC,O$SLD ! 13349: * ! 13350: {{MOV{(SP){R9{{LOAD OFFSET TO WORD TO PLUG ! 13351: {{ADD{R$CCB{R9{{POINT TO ACTUAL LOCATION TO PLUG ! 13352: {{MOV{CWCOF{(R9){{PLUG PROPER OFFSET IN ! 13353: {{MOV{#OSLC${R6{{LOAD O$SLC PTR FOR NEXT ALTERNATIVE ! 13354: {{MOV{R7{R9{{COPY OFFSET (DESTROY GARBAGE XR) ! 13355: {{ICA{R9{{{BUMP EXTRA TIME FOR TEST ! 13356: {{BLT{R9{4*CMLEN(R10){CGV16{LOOP BACK IF NOT LAST ALTERNATIVE ! 13357: * ! 13358: * HERE TO GENERATE CODE FOR LAST ALTERNATIVE ! 13359: * ! 13360: {{MOV{#OSLD${R6{{GET HEADER CALL ! 13361: {{JSR{CDWRD{{{GENERATE O$SLD CALL ! 13362: {{JSR{CMGEN{{{GENERATE CODE FOR LAST ALTERNATIVE ! 13363: {{ICA{SP{{{POP OFFSET PTR ! 13364: {{MOV{(SP)+{R9{{LOAD CHAIN PTR ! 13365: * ! 13366: * LOOP TO PLUG OFFSETS PAST STRUCTURE ! 13367: * ! 13368: {CGV17{ADD{R$CCB{R9{{MAKE NEXT PTR ABSOLUTE ! 13369: {{MOV{(R9){R6{{LOAD FORWARD PTR ! 13370: {{MOV{CWCOF{(R9){{PLUG REQUIRED OFFSET ! 13371: {{MOV{R6{R9{{COPY FORWARD PTR ! 13372: {{BNZ{R6{CGV17{{LOOP BACK IF MORE TO GO ! 13373: {{BRN{CGV33{{{ELSE JUMP TO EXIT (NOT CONSTANT) ! 13374: * ! 13375: * HERE FOR BINARY OPS WITH VALUE OPERANDS ! 13376: * ! 13377: {CGV18{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND POINTER ! 13378: {{JSR{CDGVL{{{GEN VALUE CODE FOR LEFT OPERAND ! 13379: * ! 13380: * HERE FOR UNARY OPS WITH VALUE OPERAND (BINOPS MERGE) ! 13381: * ! 13382: {CGV19{MOV{4*CMROP(R10){R9{{LOAD RIGHT (ONLY) OPERAND PTR ! 13383: {{JSR{CDGVL{{{GEN CODE BY VALUE ! 13384: {{EJC{{{{ ! 13385: * ! 13386: * CDGVL (CONTINUED) ! 13387: * ! 13388: * MERGE HERE TO GENERATE OPERATOR CALL FROM CMOPN FIELD ! 13389: * ! 13390: {CGV20{MOV{4*CMOPN(R10){R6{{LOAD OPERATOR CALL POINTER ! 13391: {{BRN{CGV36{{{JUMP TO GENERATE IT WITH CONS TEST ! 13392: * ! 13393: * HERE FOR ASSIGNMENT ! 13394: * ! 13395: {CGV21{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND POINTER ! 13396: {{BLO{(R9){#B$VR${CGV22{JUMP IF NOT VARIABLE ! 13397: * ! 13398: * HERE FOR ASSIGNMENT TO SIMPLE VARIABLE ! 13399: * ! 13400: {{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND PTR ! 13401: {{JSR{CDGVL{{{GENERATE CODE BY VALUE ! 13402: {{MOV{4*CMLOP(R10){R6{{RELOAD LEFT OPERAND VRBLK PTR ! 13403: {{ADD{#4*VRSTO{R6{{POINT TO VRSTO FIELD ! 13404: {{BRN{CGV32{{{JUMP TO GENERATE STORE PTR ! 13405: * ! 13406: * HERE IF NOT SIMPLE VARIABLE ASSIGNMENT ! 13407: * ! 13408: {CGV22{JSR{EXPAP{{{TEST FOR PATTERN MATCH ON LEFT SIDE ! 13409: {{PPM{CGV23{{{JUMP IF NOT PATTERN MATCH ! 13410: * ! 13411: * HERE FOR PATTERN REPLACEMENT ! 13412: * ! 13413: {{MOV{4*CMROP(R9){4*CMLOP(R10){{SAVE PATTERN PTR IN SAFE PLACE ! 13414: {{MOV{4*CMLOP(R9){R9{{LOAD SUBJECT PTR ! 13415: {{JSR{CDGNM{{{GEN CODE BY NAME FOR SUBJECT ! 13416: {{MOV{4*CMLOP(R10){R9{{LOAD PATTERN PTR ! 13417: {{JSR{CDGVL{{{GEN CODE BY VALUE FOR PATTERN ! 13418: {{MOV{#OPMN${R6{{LOAD MATCH BY NAME CALL ! 13419: {{JSR{CDWRD{{{GENERATE IT ! 13420: {{MOV{4*CMROP(R10){R9{{LOAD REPLACEMENT VALUE PTR ! 13421: {{JSR{CDGVL{{{GEN CODE BY VALUE ! 13422: {{MOV{#ORPL${R6{{LOAD REPLACE CALL ! 13423: {{BRN{CGV32{{{JUMP TO GEN AND EXIT (NOT CONSTANT) ! 13424: * ! 13425: * HERE FOR ASSIGNMENT TO COMPLEX VARIABLE ! 13426: * ! 13427: {CGV23{MNZ{R8{{{INHIBIT PRE-EVALUATION ! 13428: {{JSR{CDGNM{{{GEN CODE BY NAME FOR LEFT SIDE ! 13429: {{BRN{CGV31{{{MERGE WITH UNOP CIRCUIT ! 13430: {{EJC{{{{ ! 13431: * ! 13432: * CDGVL (CONTINUED) ! 13433: * ! 13434: * HERE FOR CONCATENATION ! 13435: * ! 13436: {CGV24{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND PTR ! 13437: {{BNE{(R9){#B$CMT{CGV18{ORDINARY BINOP IF NOT CMBLK ! 13438: {{MOV{4*CMTYP(R9){R7{{LOAD CMBLK TYPE CODE ! 13439: {{BEQ{R7{#C$INT{CGV25{SPECIAL CASE IF INTERROGATION ! 13440: {{BEQ{R7{#C$NEG{CGV25{OR NEGATION ! 13441: {{BNE{R7{#C$FNC{CGV18{ELSE ORDINARY BINOP IF NOT FUNCTION ! 13442: {{MOV{4*CMOPN(R9){R9{{ELSE LOAD FUNCTION VRBLK PTR ! 13443: {{BNZ{4*VRLEN(R9){CGV18{{ORDINARY BINOP IF NOT SYSTEM VAR ! 13444: {{MOV{4*VRSVP(R9){R9{{ELSE POINT TO SVBLK ! 13445: {{MOV{4*SVBIT(R9){R6{{LOAD BIT INDICATORS ! 13446: {{ANB{BTPRD{R6{{TEST FOR PREDICATE FUNCTION ! 13447: {{ZRB{R6{CGV18{{ORDINARY BINOP IF NOT ! 13448: * ! 13449: * HERE IF LEFT ARG OF CONCATENATION IS PREDICATE FUNCTION ! 13450: * ! 13451: {CGV25{MOV{4*CMLOP(R10){R9{{RELOAD LEFT ARG ! 13452: {{JSR{CDGVL{{{GEN CODE BY VALUE ! 13453: {{MOV{#OPOP${R6{{LOAD POP CALL ! 13454: {{JSR{CDWRD{{{GENERATE IT ! 13455: {{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND ! 13456: {{JSR{CDGVL{{{GEN CODE BY VALUE AS RESULT CODE ! 13457: {{BRN{CGV33{{{EXIT (NOT CONSTANT) ! 13458: * ! 13459: * HERE TO GENERATE CODE FOR PATTERN, IMMEDIATE ASSIGNMENT ! 13460: * ! 13461: {CGV26{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND ! 13462: {{JSR{CDGVL{{{GEN CODE BY VALUE, MERGE ! 13463: * ! 13464: * HERE FOR UNOPS WITH ARG BY NAME (BINARY $ . MERGE) ! 13465: * ! 13466: {CGV27{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND PTR ! 13467: {{JSR{CDGNM{{{GEN CODE BY NAME FOR RIGHT ARG ! 13468: {{MOV{4*CMOPN(R10){R9{{GET OPERATOR CODE WORD ! 13469: {{BNE{(R9){#O$KWV{CGV20{GEN CALL UNLESS KEYWORD VALUE ! 13470: {{EJC{{{{ ! 13471: * ! 13472: * CDGVL (CONTINUED) ! 13473: * ! 13474: * HERE FOR KEYWORD BY VALUE. THIS IS CONSTANT ONLY IF ! 13475: * THE OPERAND IS ONE OF THE SPECIAL SYSTEM VARIABLES WITH ! 13476: * THE SVCKW BIT SET TO INDICATE A CONSTANT KEYWORD VALUE. ! 13477: * NOTE THAT THE ONLY CONSTANT OPERAND BY NAME IS A VARIABLE ! 13478: * ! 13479: {{BNZ{R8{CGV20{{GEN CALL IF NON-CONSTANT (NOT VAR) ! 13480: {{MNZ{R8{{{ELSE SET NON-CONSTANT IN CASE ! 13481: {{MOV{4*CMROP(R10){R9{{LOAD PTR TO OPERAND VRBLK ! 13482: {{BNZ{4*VRLEN(R9){CGV20{{GEN (NON-CONSTANT) IF NOT SYS VAR ! 13483: {{MOV{4*VRSVP(R9){R9{{ELSE LOAD PTR TO SVBLK ! 13484: {{MOV{4*SVBIT(R9){R6{{LOAD BIT MASK ! 13485: {{ANB{BTCKW{R6{{TEST FOR CONSTANT KEYWORD ! 13486: {{ZRB{R6{CGV20{{GO GEN IF NOT CONSTANT ! 13487: {{ZER{R8{{{ELSE SET RESULT CONSTANT ! 13488: {{BRN{CGV20{{{AND JUMP BACK TO GENERATE CALL ! 13489: * ! 13490: * HERE TO GENERATE CODE FOR NEGATION ! 13491: * ! 13492: {CGV28{MOV{#ONTA${R6{{GET INITIAL WORD ! 13493: {{JSR{CDWRD{{{GENERATE IT ! 13494: {{MOV{CWCOF{R7{{SAVE NEXT OFFSET ! 13495: {{JSR{CDWRD{{{GENERATE GUNK WORD FOR NOW ! 13496: {{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND PTR ! 13497: {{JSR{CDGVL{{{GEN CODE BY VALUE ! 13498: {{MOV{#ONTB${R6{{LOAD END OF EVALUATION CALL ! 13499: {{JSR{CDWRD{{{GENERATE IT ! 13500: {{MOV{R7{R9{{COPY OFFSET TO WORD TO PLUG ! 13501: {{ADD{R$CCB{R9{{POINT TO ACTUAL WORD TO PLUG ! 13502: {{MOV{CWCOF{(R9){{PLUG WORD WITH CURRENT OFFSET ! 13503: {{MOV{#ONTC${R6{{LOAD FINAL CALL ! 13504: {{BRN{CGV32{{{JUMP TO GENERATE IT (NOT CONSTANT) ! 13505: * ! 13506: * HERE TO GENERATE CODE FOR UNDEFINED BINARY OPERATOR ! 13507: * ! 13508: {CGV29{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND PTR ! 13509: {{JSR{CDGVL{{{GENERATE CODE BY VALUE ! 13510: {{EJC{{{{ ! 13511: * ! 13512: * CDGVL (CONTINUED) ! 13513: * ! 13514: * HERE TO GENERATE CODE FOR UNDEFINED UNARY OPERATOR ! 13515: * ! 13516: {CGV30{MOV{#C$UO${R7{{SET UNOP CODE + 1 ! 13517: {{SUB{4*CMTYP(R10){R7{{SET NUMBER OF ARGS (1 OR 2) ! 13518: * ! 13519: * MERGE HERE FOR UNDEFINED OPERATORS ! 13520: * ! 13521: {{MOV{4*CMROP(R10){R9{{LOAD RIGHT (ONLY) OPERAND POINTER ! 13522: {{JSR{CDGVL{{{GEN VALUE CODE FOR RIGHT OPERAND ! 13523: {{MOV{4*CMOPN(R10){R9{{LOAD POINTER TO OPERATOR DV ! 13524: {{MOV{4*DVOPN(R9){R9{{LOAD POINTER OFFSET ! 13525: {{WTB{R9{{{CONVERT WORD OFFSET TO BYTES ! 13526: {{ADD{#R$UBA{R9{{POINT TO PROPER FUNCTION PTR ! 13527: {{SUB{#4*VRFNC{R9{{SET STANDARD FUNCTION OFFSET ! 13528: {{BRN{CGV12{{{MERGE WITH FUNCTION CALL CIRCUIT ! 13529: * ! 13530: * HERE TO GENERATE CODE FOR INTERROGATION, INDIRECTION ! 13531: * ! 13532: {CGV31{MNZ{R8{{{SET NON CONSTANT ! 13533: {{BRN{CGV19{{{MERGE ! 13534: * ! 13535: * HERE TO EXIT GENERATING A WORD, RESULT NOT CONSTANT ! 13536: * ! 13537: {CGV32{JSR{CDWRD{{{GENERATE WORD, MERGE ! 13538: * ! 13539: * HERE TO EXIT WITH NO WORD GENERATED, NOT CONSTANT ! 13540: * ! 13541: {CGV33{MNZ{R8{{{INDICATE RESULT IS NOT CONSTANT ! 13542: * ! 13543: * COMMON EXIT POINT ! 13544: * ! 13545: {CGV34{ICA{SP{{{POP INITIAL CODE OFFSET ! 13546: {{MOV{(SP)+{R6{{RESTORE OLD CONSTANT FLAG ! 13547: {{MOV{(SP)+{R10{{RESTORE ENTRY XL ! 13548: {{MOV{(SP)+{R7{{RESTORE ENTRY WB ! 13549: {{BNZ{R8{CGV35{{JUMP IF NOT CONSTANT ! 13550: {{MOV{R6{R8{{ELSE RESTORE ENTRY CONSTANT FLAG ! 13551: * ! 13552: * HERE TO RETURN AFTER DEALING WITH WC SETTING ! 13553: * ! 13554: {CGV35{EXI{{{{RETURN TO CDGVL CALLER ! 13555: * ! 13556: * EXIT HERE TO GENERATE WORD AND TEST FOR CONSTANT ! 13557: * ! 13558: {CGV36{JSR{CDWRD{{{GENERATE WORD ! 13559: {{BNZ{R8{CGV34{{JUMP TO EXIT IF NOT CONSTANT ! 13560: {{EJC{{{{ ! 13561: * ! 13562: * CDGVL (CONTINUED) ! 13563: * ! 13564: * HERE TO PREEVALUATE CONSTANT SUB-EXPRESSION ! 13565: * ! 13566: {{MOV{#ORVL${R6{{LOAD CALL TO RETURN VALUE ! 13567: {{JSR{CDWRD{{{GENERATE IT ! 13568: {{MOV{(SP){R10{{LOAD INITIAL CODE OFFSET ! 13569: {{JSR{EXBLD{{{BUILD EXBLK FOR EXPRESSION ! 13570: {{ZER{R7{{{SET TO EVALUATE BY VALUE ! 13571: {{JSR{EVALX{{{EVALUATE EXPRESSION ! 13572: {{PPM{{{{SHOULD NOT FAIL ! 13573: {{MOV{(R9){R6{{LOAD TYPE WORD OF RESULT ! 13574: {{BLO{R6{#P$AAA{CGV37{JUMP IF NOT PATTERN ! 13575: {{MOV{#OLPT${R6{{ELSE LOAD SPECIAL PATTERN LOAD CALL ! 13576: {{JSR{CDWRD{{{GENERATE IT ! 13577: * ! 13578: * MERGE HERE TO GENERATE POINTER TO RESULTING CONSTANT ! 13579: * ! 13580: {CGV37{MOV{R9{R6{{COPY CONSTANT POINTER ! 13581: {{JSR{CDWRD{{{GENERATE PTR ! 13582: {{ZER{R8{{{SET RESULT CONSTANT ! 13583: {{BRN{CGV34{{{JUMP BACK TO EXIT ! 13584: {{ENP{{{{END PROCEDURE CDGVL ! 13585: {{EJC{{{{ ! 13586: * ! 13587: * CDWRD -- GENERATE ONE WORD OF CODE ! 13588: * ! 13589: * CDWRD WRITES ONE WORD INTO THE CURRENT CODE BLOCK UNDER ! 13590: * CONSTRUCTION. A NEW, LARGER, BLOCK IS ALLOCATED IF THERE ! 13591: * IS INSUFFICIENT ROOM IN THE CURRENT BLOCK. CDWRD ENSURES ! 13592: * THAT THERE ARE AT LEAST THREE WORDS LEFT IN THE BLOCK ! 13593: * AFTER ENTERING THE NEW WORD. THIS GUARANTEES THAT ANY ! 13594: * EXTRA SPACE AT THE END CAN BE SPLIT OFF AS A CCBLK. ! 13595: * ! 13596: * (WA) WORD TO BE GENERATED ! 13597: * JSR CDWRD CALL TO GENERATE WORD ! 13598: * ! 13599: {CDWRD{PRC{E{0{{ENTRY POINT ! 13600: {{MOV{R9{-(SP){{SAVE ENTRY XR ! 13601: {{MOV{R6{-(SP){{SAVE CODE WORD TO BE GENERATED ! 13602: * ! 13603: * MERGE BACK HERE AFTER ALLOCATING LARGER BLOCK ! 13604: * ! 13605: {CDWD1{MOV{R$CCB{R9{{LOAD PTR TO CCBLK BEING BUILT ! 13606: {{BNZ{R9{CDWD2{{JUMP IF BLOCK ALLOCATED ! 13607: * ! 13608: * HERE WE ALLOCATE AN ENTIRELY FRESH BLOCK ! 13609: * ! 13610: {{MOV{#4*E$CBS{R6{{LOAD INITIAL LENGTH ! 13611: {{JSR{ALLOC{{{ALLOCATE CCBLK ! 13612: {{MOV{#B$CCT{(R9){{STORE TYPE WORD ! 13613: {{MOV{#4*CCCOD{CWCOF{{SET INITIAL OFFSET ! 13614: {{MOV{R6{4*CCLEN(R9){{STORE BLOCK LENGTH ! 13615: {{MOV{R9{R$CCB{{STORE PTR TO NEW BLOCK ! 13616: * ! 13617: * HERE WE HAVE A BLOCK WE CAN USE ! 13618: * ! 13619: {CDWD2{MOV{CWCOF{R6{{LOAD CURRENT OFFSET ! 13620: {{ADD{#4*NUM04{R6{{ADJUST FOR TEST (FOUR WORDS) ! 13621: {{BLO{R6{4*CCLEN(R9){CDWD4{JUMP IF ROOM IN THIS BLOCK ! 13622: * ! 13623: * HERE IF NO ROOM IN CURRENT BLOCK ! 13624: * ! 13625: {{BGE{R6{MXLEN{CDWD5{JUMP IF ALREADY AT MAX SIZE ! 13626: {{ADD{#4*E$CBS{R6{{ELSE GET NEW SIZE ! 13627: {{MOV{R10{-(SP){{SAVE ENTRY XL ! 13628: {{MOV{R9{R10{{COPY POINTER ! 13629: {{BLT{R6{MXLEN{CDWD3{JUMP IF NOT TOO LARGE ! 13630: {{MOV{MXLEN{R6{{ELSE RESET TO MAX ALLOWED SIZE ! 13631: {{EJC{{{{ ! 13632: * ! 13633: * CDWRD (CONTINUED) ! 13634: * ! 13635: * HERE WITH NEW BLOCK SIZE IN WA ! 13636: * ! 13637: {CDWD3{JSR{ALLOC{{{ALLOCATE NEW BLOCK ! 13638: {{MOV{R9{R$CCB{{STORE POINTER TO NEW BLOCK ! 13639: {{MOV{#B$CCT{(R9)+{{STORE TYPE WORD IN NEW BLOCK ! 13640: {{MOV{R6{(R9)+{{STORE BLOCK LENGTH ! 13641: {{ADD{#4*CCUSE{R10{{POINT TO CCUSE,CCCOD FIELDS IN OLD ! 13642: {{MOV{(R10){R6{{LOAD CCUSE VALUE ! 13643: {{MVW{{{{COPY USEFUL WORDS FROM OLD BLOCK ! 13644: {{MOV{(SP)+{R10{{RESTORE XL ! 13645: {{BRN{CDWD1{{{MERGE BACK TO TRY AGAIN ! 13646: * ! 13647: * HERE WITH ROOM IN CURRENT BLOCK ! 13648: * ! 13649: {CDWD4{MOV{CWCOF{R6{{LOAD CURRENT OFFSET ! 13650: {{ICA{R6{{{GET NEW OFFSET ! 13651: {{MOV{R6{CWCOF{{STORE NEW OFFSET ! 13652: {{MOV{R6{4*CCUSE(R9){{STORE IN CCBLK FOR GBCOL ! 13653: {{DCA{R6{{{RESTORE PTR TO THIS WORD ! 13654: {{ADD{R6{R9{{POINT TO CURRENT ENTRY ! 13655: {{MOV{(SP)+{R6{{RELOAD WORD TO GENERATE ! 13656: {{MOV{R6{(R9){{STORE WORD IN BLOCK ! 13657: {{MOV{(SP)+{R9{{RESTORE ENTRY XR ! 13658: {{EXI{{{{RETURN TO CALLER ! 13659: * ! 13660: * HERE IF COMPILED CODE IS TOO LONG FOR CDBLK ! 13661: * ! 13662: {CDWD5{ERB{213{SYNTAX{{ERROR. STATEMENT IS TOO COMPLICATED. ! 13663: {{ENP{{{{END PROCEDURE CDWRD ! 13664: {{EJC{{{{ ! 13665: * ! 13666: * CMGEN -- GENERATE CODE FOR CMBLK PTR ! 13667: * ! 13668: * CMGEN IS A SUBSIDIARY PROCEDURE USED TO GENERATE VALUE ! 13669: * CODE FOR A CMBLK PTR FROM THE MAIN CODE GENERATORS. ! 13670: * ! 13671: * (XL) CMBLK POINTER ! 13672: * (WB) OFFSET TO POINTER IN CMBLK ! 13673: * JSR CMGEN CALL TO GENERATE CODE ! 13674: * (XR,WA) DESTROYED ! 13675: * (WB) BUMPED BY ONE WORD ! 13676: * ! 13677: {CMGEN{PRC{R{0{{ENTRY POINT, RECURSIVE ! 13678: {{MOV{R10{R9{{COPY CMBLK POINTER ! 13679: {{ADD{R7{R9{{POINT TO CMBLK POINTER ! 13680: {{MOV{(R9){R9{{LOAD CMBLK POINTER ! 13681: {{JSR{CDGVL{{{GENERATE CODE BY VALUE ! 13682: {{ICA{R7{{{BUMP OFFSET ! 13683: {{EXI{{{{RETURN TO CALLER ! 13684: {{ENP{{{{END PROCEDURE CMGEN ! 13685: {{EJC{{{{ ! 13686: * ! 13687: * CMPIL (COMPILE SOURCE CODE) ! 13688: * ! 13689: * CMPIL IS USED TO CONVERT SNOBOL4 SOURCE CODE TO INTERNAL ! 13690: * FORM (SEE CDBLK FORMAT). IT IS USED BOTH FOR THE INITIAL ! 13691: * COMPILE AND AT RUN TIME BY THE CODE AND CONVERT FUNCTIONS ! 13692: * THIS PROCEDURE HAS CONTROL FOR THE ENTIRE DURATION OF ! 13693: * INITIAL COMPILATION. AN ERROR IN ANY PROCEDURE CALLED ! 13694: * DURING COMPILATION WILL LEAD FIRST TO THE ERROR SECTION ! 13695: * AND ULTIMATELY BACK HERE FOR RESUMED COMPILATION. THE ! 13696: * RE-ENTRY POINTS AFTER AN ERROR ARE SPECIALLY LABELLED - ! 13697: * ! 13698: * CMPCE RESUME AFTER CONTROL CARD ERROR ! 13699: * CMPLE RESUME AFTER LABEL ERROR ! 13700: * CMPSE RESUME AFTER STATEMENT ERROR ! 13701: * ! 13702: * JSR CMPIL CALL TO COMPILE CODE ! 13703: * (XR) PTR TO CDBLK FOR ENTRY STATEMENT ! 13704: * (XL,WA,WB,WC,RA) DESTROYED ! 13705: * ! 13706: * THE FOLLOWING GLOBAL VARIABLES ARE REFERENCED ! 13707: * ! 13708: * CMPSN NUMBER OF NEXT STATEMENT ! 13709: * TO BE COMPILED. ! 13710: * ! 13711: * CSWXX CONTROL CARD SWITCH VALUES ARE ! 13712: * CHANGED WHEN RELEVANT CONTROL ! 13713: * CARDS ARE MET. ! 13714: * ! 13715: * CWCOF OFFSET TO NEXT WORD IN CODE BLOCK ! 13716: * BEING BUILT (SEE CDWRD). ! 13717: * ! 13718: * LSTSN NUMBER OF STATEMENT MOST RECENTLY ! 13719: * COMPILED (INITIALLY SET TO ZERO). ! 13720: * ! 13721: * R$CIM CURRENT (INITIAL) COMPILER IMAGE ! 13722: * (ZERO FOR INITIAL COMPILE CALL) ! 13723: * ! 13724: * R$CNI USED TO POINT TO FOLLOWING IMAGE. ! 13725: * (SEE READR PROCEDURE). ! 13726: * ! 13727: * SCNGO GOTO SWITCH FOR SCANE PROCEDURE ! 13728: * ! 13729: * SCNIL LENGTH OF CURRENT IMAGE EXCLUDING ! 13730: * CHARACTERS REMOVED BY -INPUT. ! 13731: * ! 13732: * SCNPT CURRENT SCAN OFFSET, SEE SCANE. ! 13733: * ! 13734: * SCNRS RESCAN SWITCH FOR SCANE PROCEDURE. ! 13735: * ! 13736: * SCNSE OFFSET (IN R$CIM) OF MOST RECENTLY ! 13737: * SCANNED ELEMENT. SET ZERO IF NOT ! 13738: * CURRENTLY SCANNING ITEMS ! 13739: {{EJC{{{{ ! 13740: * ! 13741: * CMPIL (CONTINUED) ! 13742: * ! 13743: * STAGE STGIC INITIAL COMPILE IN PROGRESS ! 13744: * STGXC CODE/CONVERT COMPILE ! 13745: * STGEV BUILDING EXBLK FOR EVAL ! 13746: * STGXT EXECUTE TIME (OUTSIDE COMPILE) ! 13747: * STGCE INITIAL COMPILE AFTER END LINE ! 13748: * STGXE EXECUTE COMPILE AFTER END LINE ! 13749: * ! 13750: * CMPIL ALSO USES A FIXED NUMBER OF LOCATIONS ON THE ! 13751: * MAIN STACK AS FOLLOWS. (THE DEFINITIONS OF THE ACTUAL ! 13752: * OFFSETS ARE IN THE DEFINITIONS SECTION). ! 13753: * ! 13754: * CMSTM(XS) POINTER TO EXPAN TREE FOR BODY OF ! 13755: * STATEMENT (SEE EXPAN PROCEDURE). ! 13756: * ! 13757: * CMSGO(XS) POINTER TO TREE REPRESENTATION OF ! 13758: * SUCCESS GOTO (SEE PROCEDURE SCNGO)9 ! 13759: * ZERO IF NO SUCCESS GOTO IS GIVEN ! 13760: * ! 13761: * CMFGO(XS) LIKE CMSGO FOR FAILURE GOTO. ! 13762: * ! 13763: * CMCGO(XS) SET NON-ZERO ONLY IF THERE IS A ! 13764: * CONDITIONAL GOTO. USED FOR -FAIL, ! 13765: * -NOFAIL CODE GENERATION. ! 13766: * ! 13767: * CMPCD(XS) POINTER TO CDBLK FOR PREVIOUS ! 13768: * STATEMENT. ZERO FOR 1ST STATEMENT. ! 13769: * ! 13770: * CMFFP(XS) SET NON-ZERO IF CDFAL IN PREVIOUS ! 13771: * CDBLK NEEDS FILLING WITH FORWARD ! 13772: * POINTER, ELSE SET TO ZERO. ! 13773: * ! 13774: * CMFFC(XS) SAME AS CMFFP FOR CURRENT CDBLK ! 13775: * ! 13776: * CMSOP(XS) OFFSET TO WORD IN PREVIOUS CDBLK ! 13777: * TO BE FILLED IN WITH FORWARD PTR ! 13778: * TO NEXT CDBLK FOR SUCCESS GOTO. ! 13779: * ZERO IF NO FILL IN IS REQUIRED. ! 13780: * ! 13781: * CMSOC(XS) SAME AS CMSOP FOR CURRENT CDBLK. ! 13782: * ! 13783: * CMLBL(XS) POINTER TO VRBLK FOR LABEL OF ! 13784: * CURRENT STATEMENT. ZERO IF NO LABEL ! 13785: * ! 13786: * CMTRA(XS) POINTER TO CDBLK FOR ENTRY STMNT. ! 13787: {{EJC{{{{ ! 13788: * ! 13789: * CMPIL (CONTINUED) ! 13790: * ! 13791: * ENTRY POINT ! 13792: * ! 13793: {CMPIL{PRC{E{0{{ENTRY POINT ! 13794: {{LCT{R7{#CMNEN{{SET NUMBER OF STACK WORK LOCATIONS ! 13795: * ! 13796: * LOOP TO INITIALIZE STACK WORKING LOCATIONS ! 13797: * ! 13798: {CMP00{ZER{-(SP){{{STORE A ZERO, MAKE ONE ENTRY ! 13799: {{BCT{R7{CMP00{{LOOP BACK UNTIL ALL SET ! 13800: {{MOV{SP{CMPXS{{SAVE STACK POINTER FOR ERROR SEC ! 13801: {{SSS{CMPSS{{{SAVE S-R STACK POINTER IF ANY ! 13802: * ! 13803: * LOOP THROUGH STATEMENTS ! 13804: * ! 13805: {CMP01{MOV{SCNPT{R7{{SET SCAN POINTER OFFSET ! 13806: {{MOV{R7{SCNSE{{SET START OF ELEMENT LOCATION ! 13807: {{MOV{#OCER${R6{{POINT TO COMPILE ERROR CALL ! 13808: {{JSR{CDWRD{{{GENERATE AS TEMPORARY CDFAL ! 13809: {{BLT{R7{SCNIL{CMP04{JUMP IF CHARS LEFT ON THIS IMAGE ! 13810: * ! 13811: * LOOP HERE AFTER COMMENT OR CONTROL CARD ! 13812: * ALSO SPECIAL ENTRY AFTER CONTROL CARD ERROR ! 13813: * ! 13814: {CMPCE{ZER{R9{{{CLEAR POSSIBLE GARBAGE XR VALUE ! 13815: {{BNE{STAGE{#STGIC{CMP02{SKIP UNLESS INITIAL COMPILE ! 13816: {{JSR{READR{{{READ NEXT INPUT IMAGE ! 13817: {{BZE{R9{CMP09{{JUMP IF NO INPUT AVAILABLE ! 13818: {{JSR{NEXTS{{{ACQUIRE NEXT SOURCE IMAGE ! 13819: {{MOV{CMPSN{LSTSN{{STORE STMT NO FOR USE BY LISTR ! 13820: {{ZER{SCNPT{{{RESET SCAN POINTER ! 13821: {{BRN{CMP04{{{GO PROCESS IMAGE ! 13822: * ! 13823: * FOR EXECUTE TIME COMPILE, PERMIT EMBEDDED CONTROL CARDS ! 13824: * AND COMMENTS (BY SKIPPING TO NEXT SEMI-COLON) ! 13825: * ! 13826: {CMP02{MOV{R$CIM{R9{{GET CURRENT IMAGE ! 13827: {{MOV{SCNPT{R7{{GET CURRENT OFFSET ! 13828: {{PLC{R9{R7{{PREPARE TO GET CHARS ! 13829: * ! 13830: * SKIP TO SEMI-COLON ! 13831: * ! 13832: {CMP03{LCH{R8{(R9)+{{GET CHAR ! 13833: {{ICV{SCNPT{{{ADVANCE OFFSET ! 13834: {{BEQ{R8{#CH$SM{CMP04{SKIP IF SEMI-COLON FOUND ! 13835: {{BLT{SCNPT{SCNIL{CMP03{LOOP IF MORE CHARS ! 13836: {{ZER{R9{{{CLEAR GARBAGE XR VALUE ! 13837: {{BRN{CMP09{{{END OF IMAGE ! 13838: {{EJC{{{{ ! 13839: * ! 13840: * CMPIL (CONTINUED) ! 13841: * ! 13842: * HERE WITH IMAGE AVAILABLE TO SCAN. NOTE THAT IF THE INPUT ! 13843: * STRING IS NULL, THEN EVERYTHING IS OK SINCE NULL IS ! 13844: * ACTUALLY ASSEMBLED AS A WORD OF BLANKS. ! 13845: * ! 13846: {CMP04{MOV{R$CIM{R9{{POINT TO CURRENT IMAGE ! 13847: {{MOV{SCNPT{R7{{LOAD CURRENT OFFSET ! 13848: {{MOV{R7{R6{{COPY FOR LABEL SCAN ! 13849: {{PLC{R9{R7{{POINT TO FIRST CHARACTER ! 13850: {{LCH{R8{(R9)+{{LOAD FIRST CHARACTER ! 13851: {{BEQ{R8{#CH$SM{CMP12{NO LABEL IF SEMICOLON ! 13852: {{BEQ{R8{#CH$AS{CMPCE{LOOP BACK IF COMMENT CARD ! 13853: {{BEQ{R8{#CH$MN{CMP32{JUMP IF CONTROL CARD ! 13854: {{MOV{R$CIM{R$CMP{{ABOUT TO DESTROY R$CIM ! 13855: {{MOV{#CMLAB{R10{{POINT TO LABEL WORK STRING ! 13856: {{MOV{R10{R$CIM{{SCANE IS TO SCAN WORK STRING ! 13857: {{PSC{R10{{{POINT TO FIRST CHARACTER POSITION ! 13858: {{SCH{R8{(R10)+{{STORE CHAR JUST LOADED ! 13859: {{MOV{#CH$SM{R8{{GET A SEMICOLON ! 13860: {{SCH{R8{(R10){{STORE AFTER FIRST CHAR ! 13861: {{CSC{R10{{{FINISHED CHARACTER STORING ! 13862: {{ZER{R10{{{CLEAR POINTER ! 13863: {{ZER{SCNPT{{{START AT FIRST CHARACTER ! 13864: {{MOV{SCNIL{-(SP){{PRESERVE IMAGE LENGTH ! 13865: {{MOV{#NUM02{SCNIL{{READ 2 CHARS AT MOST ! 13866: {{JSR{SCANE{{{SCAN FIRST CHAR FOR TYPE ! 13867: {{MOV{(SP)+{SCNIL{{RESTORE IMAGE LENGTH ! 13868: {{MOV{R10{R8{{NOTE RETURN CODE ! 13869: {{MOV{R$CMP{R10{{GET OLD R$CIM ! 13870: {{MOV{R10{R$CIM{{PUT IT BACK ! 13871: {{MOV{R7{SCNPT{{REINSTATE OFFSET ! 13872: {{BNZ{SCNBL{CMP12{{BLANK SEEN - CANT BE LABEL ! 13873: {{MOV{R10{R9{{POINT TO CURRENT IMAGE ! 13874: {{PLC{R9{R7{{POINT TO FIRST CHAR AGAIN ! 13875: {{BEQ{R8{#T$VAR{CMP06{OK IF LETTER ! 13876: {{BEQ{R8{#T$CON{CMP06{OK IF DIGIT ! 13877: * ! 13878: * DROP IN OR JUMP FROM ERROR SECTION IF SCANE FAILED ! 13879: * ! 13880: {CMPLE{MOV{R$CMP{R$CIM{{POINT TO BAD LINE ! 13881: {{ERB{214{BAD{{LABEL OR MISPLACED CONTINUATION LINE ! 13882: * ! 13883: * LOOP TO SCAN LABEL ! 13884: * ! 13885: {CMP05{BEQ{R8{#CH$SM{CMP07{SKIP IF SEMICOLON ! 13886: {{ICV{R6{{{BUMP OFFSET ! 13887: {{BEQ{R6{SCNIL{CMP07{JUMP IF END OF IMAGE (LABEL END) ! 13888: {{EJC{{{{ ! 13889: * ! 13890: * CMPIL (CONTINUED) ! 13891: * ! 13892: * ENTER LOOP AT THIS POINT ! 13893: * ! 13894: {CMP06{LCH{R8{(R9)+{{ELSE LOAD NEXT CHARACTER ! 13895: {{BEQ{R8{#CH$HT{CMP07{JUMP IF HORIZONTAL TAB ! 13896: {{BNE{R8{#CH$BL{CMP05{LOOP BACK IF NON-BLANK ! 13897: * ! 13898: * HERE AFTER SCANNING OUT LABEL ! 13899: * ! 13900: {CMP07{MOV{R6{SCNPT{{SAVE UPDATED SCAN OFFSET ! 13901: {{SUB{R7{R6{{GET LENGTH OF LABEL ! 13902: {{BZE{R6{CMP12{{SKIP IF LABEL LENGTH ZERO ! 13903: {{ZER{R9{{{CLEAR GARBAGE XR VALUE ! 13904: {{JSR{SBSTR{{{BUILD SCBLK FOR LABEL NAME ! 13905: {{JSR{GTNVR{{{LOCATE/CONTRUCT VRBLK ! 13906: {{PPM{{{{DUMMY (IMPOSSIBLE) ERROR RETURN ! 13907: {{MOV{R9{4*CMLBL(SP){{STORE LABEL POINTER ! 13908: {{BNZ{4*VRLEN(R9){CMP11{{JUMP IF NOT SYSTEM LABEL ! 13909: {{BNE{4*VRSVP(R9){#V$END{CMP11{JUMP IF NOT END LABEL ! 13910: * ! 13911: * HERE FOR END LABEL SCANNED OUT ! 13912: * ! 13913: {{ADD{#STGND{STAGE{{ADJUST STAGE APPROPRIATELY ! 13914: {{JSR{SCANE{{{SCAN OUT NEXT ELEMENT ! 13915: {{BEQ{R10{#T$SMC{CMP10{JUMP IF END OF IMAGE ! 13916: {{BNE{R10{#T$VAR{CMP08{ELSE ERROR IF NOT VARIABLE ! 13917: * ! 13918: * HERE CHECK FOR VALID INITIAL TRANSFER ! 13919: * ! 13920: {{BEQ{4*VRLBL(R9){#STNDL{CMP08{JUMP IF NOT DEFINED (ERROR) ! 13921: {{MOV{4*VRLBL(R9){4*CMTRA(SP){{ELSE SET INITIAL ENTRY POINTER ! 13922: {{JSR{SCANE{{{SCAN NEXT ELEMENT ! 13923: {{BEQ{R10{#T$SMC{CMP10{JUMP IF OK (END OF IMAGE) ! 13924: * ! 13925: * HERE FOR BAD TRANSFER LABEL ! 13926: * ! 13927: {CMP08{ERB{215{SYNTAX{{ERROR. UNDEFINED OR ERRONEOUS ENTRY LABEL ! 13928: * ! 13929: * HERE FOR END OF INPUT (NO END LABEL DETECTED) ! 13930: * ! 13931: {CMP09{ADD{#STGND{STAGE{{ADJUST STAGE APPROPRIATELY ! 13932: {{BEQ{STAGE{#STGXE{CMP10{JUMP IF CODE CALL (OK) ! 13933: {{ERB{216{SYNTAX{{ERROR. MISSING END LINE ! 13934: * ! 13935: * HERE AFTER PROCESSING END LINE (MERGE HERE ON END ERROR) ! 13936: * ! 13937: {CMP10{MOV{#OSTP${R6{{SET STOP CALL POINTER ! 13938: {{JSR{CDWRD{{{GENERATE AS STATEMENT CALL ! 13939: {{BRN{CMPSE{{{JUMP TO GENERATE AS FAILURE ! 13940: {{EJC{{{{ ! 13941: * ! 13942: * CMPIL (CONTINUED) ! 13943: * ! 13944: * HERE AFTER PROCESSING LABEL OTHER THAN END ! 13945: * ! 13946: {CMP11{BNE{STAGE{#STGIC{CMP12{JUMP IF CODE CALL - REDEF. OK ! 13947: {{BEQ{4*VRLBL(R9){#STNDL{CMP12{ELSE CHECK FOR REDEFINITION ! 13948: {{ZER{4*CMLBL(SP){{{LEAVE FIRST LABEL DECLN UNDISTURBED ! 13949: {{ERB{217{SYNTAX{{ERROR. DUPLICATE LABEL ! 13950: * ! 13951: * HERE AFTER DEALING WITH LABEL ! 13952: * ! 13953: {CMP12{ZER{R7{{{SET FLAG FOR STATEMENT BODY ! 13954: {{JSR{EXPAN{{{GET TREE FOR STATEMENT BODY ! 13955: {{MOV{R9{4*CMSTM(SP){{STORE FOR LATER USE ! 13956: {{ZER{4*CMSGO(SP){{{CLEAR SUCCESS GOTO POINTER ! 13957: {{ZER{4*CMFGO(SP){{{CLEAR FAILURE GOTO POINTER ! 13958: {{ZER{4*CMCGO(SP){{{CLEAR CONDITIONAL GOTO FLAG ! 13959: {{JSR{SCANE{{{SCAN NEXT ELEMENT ! 13960: {{BNE{R10{#T$COL{CMP18{JUMP IT NOT COLON (NO GOTO) ! 13961: * ! 13962: * LOOP TO PROCESS GOTO FIELDS ! 13963: * ! 13964: {CMP13{MNZ{SCNGO{{{SET GOTO FLAG ! 13965: {{JSR{SCANE{{{SCAN NEXT ELEMENT ! 13966: {{BEQ{R10{#T$SMC{CMP31{JUMP IF NO FIELDS LEFT ! 13967: {{BEQ{R10{#T$SGO{CMP14{JUMP IF S FOR SUCCESS GOTO ! 13968: {{BEQ{R10{#T$FGO{CMP16{JUMP IF F FOR FAILURE GOTO ! 13969: * ! 13970: * HERE FOR UNCONDITIONAL GOTO (I.E. NOT F OR S) ! 13971: * ! 13972: {{MNZ{SCNRS{{{SET TO RESCAN ELEMENT NOT F,S ! 13973: {{JSR{SCNGF{{{SCAN OUT GOTO FIELD ! 13974: {{BNZ{4*CMFGO(SP){CMP17{{ERROR IF FGOTO ALREADY ! 13975: {{MOV{R9{4*CMFGO(SP){{ELSE SET AS FGOTO ! 13976: {{BRN{CMP15{{{MERGE WITH SGOTO CIRCUIT ! 13977: * ! 13978: * HERE FOR SUCCESS GOTO ! 13979: * ! 13980: {CMP14{JSR{SCNGF{{{SCAN SUCCESS GOTO FIELD ! 13981: {{MOV{#NUM01{4*CMCGO(SP){{SET CONDITIONAL GOTO FLAG ! 13982: * ! 13983: * UNCONTIONAL GOTO MERGES HERE ! 13984: * ! 13985: {CMP15{BNZ{4*CMSGO(SP){CMP17{{ERROR IF SGOTO ALREADY GIVEN ! 13986: {{MOV{R9{4*CMSGO(SP){{ELSE SET SGOTO ! 13987: {{BRN{CMP13{{{LOOP BACK FOR NEXT GOTO FIELD ! 13988: * ! 13989: * HERE FOR FAILURE GOTO ! 13990: * ! 13991: {CMP16{JSR{SCNGF{{{SCAN GOTO FIELD ! 13992: {{MOV{#NUM01{4*CMCGO(SP){{SET CONDITONAL GOTO FLAG ! 13993: {{BNZ{4*CMFGO(SP){CMP17{{ERROR IF FGOTO ALREADY GIVEN ! 13994: {{MOV{R9{4*CMFGO(SP){{ELSE STORE FGOTO POINTER ! 13995: {{BRN{CMP13{{{LOOP BACK FOR NEXT FIELD ! 13996: {{EJC{{{{ ! 13997: * ! 13998: * CMPIL (CONTINUED) ! 13999: * ! 14000: * HERE FOR DUPLICATED GOTO FIELD ! 14001: * ! 14002: {CMP17{ERB{218{SYNTAX{{ERROR. DUPLICATED GOTO FIELD ! 14003: * ! 14004: * HERE TO GENERATE CODE ! 14005: * ! 14006: {CMP18{ZER{SCNSE{{{STOP POSITIONAL ERROR FLAGS ! 14007: {{MOV{4*CMSTM(SP){R9{{LOAD TREE PTR FOR STATEMENT BODY ! 14008: {{ZER{R7{{{COLLECTABLE VALUE FOR WB FOR CDGVL ! 14009: {{ZER{R8{{{RESET CONSTANT FLAG FOR CDGVL ! 14010: {{JSR{EXPAP{{{TEST FOR PATTERN MATCH ! 14011: {{PPM{CMP19{{{JUMP IF NOT PATTERN MATCH ! 14012: {{MOV{#OPMS${4*CMOPN(R9){{ELSE SET PATTERN MATCH POINTER ! 14013: {{MOV{#C$PMT{4*CMTYP(R9){{ ! 14014: * ! 14015: * HERE AFTER DEALING WITH SPECIAL PATTERN MATCH CASE ! 14016: * ! 14017: {CMP19{JSR{CDGVL{{{GENERATE CODE FOR BODY OF STATEMENT ! 14018: {{MOV{4*CMSGO(SP){R9{{LOAD SGOTO POINTER ! 14019: {{MOV{R9{R6{{COPY IT ! 14020: {{BZE{R9{CMP21{{JUMP IF NO SUCCESS GOTO ! 14021: {{ZER{4*CMSOC(SP){{{CLEAR SUCCESS OFFSET FILLIN PTR ! 14022: {{BHI{R9{STATE{CMP20{JUMP IF COMPLEX GOTO ! 14023: * ! 14024: * HERE FOR SIMPLE SUCCESS GOTO (LABEL) ! 14025: * ! 14026: {{ADD{#4*VRTRA{R6{{POINT TO VRTRA FIELD AS REQUIRED ! 14027: {{JSR{CDWRD{{{GENERATE SUCCESS GOTO ! 14028: {{BRN{CMP22{{{JUMP TO DEAL WITH FGOTO ! 14029: * ! 14030: * HERE FOR COMPLEX SUCCESS GOTO ! 14031: * ! 14032: {CMP20{BEQ{R9{4*CMFGO(SP){CMP22{NO CODE IF SAME AS FGOTO ! 14033: {{ZER{R7{{{ELSE SET OK VALUE FOR CDGVL IN WB ! 14034: {{JSR{CDGCG{{{GENERATE CODE FOR SUCCESS GOTO ! 14035: {{BRN{CMP22{{{JUMP TO DEAL WITH FGOTO ! 14036: * ! 14037: * HERE FOR NO SUCCESS GOTO ! 14038: * ! 14039: {CMP21{MOV{CWCOF{4*CMSOC(SP){{SET SUCCESS FILL IN OFFSET ! 14040: {{MOV{#OCER${R6{{POINT TO COMPILE ERROR CALL ! 14041: {{JSR{CDWRD{{{GENERATE AS TEMPORARY VALUE ! 14042: {{EJC{{{{ ! 14043: * ! 14044: * CMPIL (CONTINUED) ! 14045: * ! 14046: * HERE TO DEAL WITH FAILURE GOTO ! 14047: * ! 14048: {CMP22{MOV{4*CMFGO(SP){R9{{LOAD FAILURE GOTO POINTER ! 14049: {{MOV{R9{R6{{COPY IT ! 14050: {{ZER{4*CMFFC(SP){{{SET NO FILL IN REQUIRED YET ! 14051: {{BZE{R9{CMP23{{JUMP IF NO FAILURE GOTO GIVEN ! 14052: {{ADD{#4*VRTRA{R6{{POINT TO VRTRA FIELD IN CASE ! 14053: {{BLO{R9{STATE{CMPSE{JUMP TO GEN IF SIMPLE FGOTO ! 14054: * ! 14055: * HERE FOR COMPLEX FAILURE GOTO ! 14056: * ! 14057: {{MOV{CWCOF{R7{{SAVE OFFSET TO O$GOF CALL ! 14058: {{MOV{#OGOF${R6{{POINT TO FAILURE GOTO CALL ! 14059: {{JSR{CDWRD{{{GENERATE ! 14060: {{MOV{#OFIF${R6{{POINT TO FAIL IN FAIL WORD ! 14061: {{JSR{CDWRD{{{GENERATE ! 14062: {{JSR{CDGCG{{{GENERATE CODE FOR FAILURE GOTO ! 14063: {{MOV{R7{R6{{COPY OFFSET TO O$GOF FOR CDFAL ! 14064: {{MOV{#B$CDC{R7{{SET COMPLEX CASE CDTYP ! 14065: {{BRN{CMP25{{{JUMP TO BUILD CDBLK ! 14066: * ! 14067: * HERE IF NO FAILURE GOTO GIVEN ! 14068: * ! 14069: {CMP23{MOV{#OUNF${R6{{LOAD UNEXPECTED FAILURE CALL IN CAS ! 14070: {{MOV{CSWFL{R8{{GET -NOFAIL FLAG ! 14071: {{ORB{4*CMCGO(SP){R8{{CHECK IF CONDITIONAL GOTO ! 14072: {{ZRB{R8{CMPSE{{JUMP IF -NOFAIL AND NO COND. GOTO ! 14073: {{MNZ{4*CMFFC(SP){{{ELSE SET FILL IN FLAG ! 14074: {{MOV{#OCER${R6{{AND SET COMPILE ERROR FOR TEMPORARY ! 14075: * ! 14076: * MERGE HERE WITH CDFAL VALUE IN WA, SIMPLE CDBLK ! 14077: * ALSO SPECIAL ENTRY AFTER STATEMENT ERROR ! 14078: * ! 14079: {CMPSE{MOV{#B$CDS{R7{{SET CDTYP FOR SIMPLE CASE ! 14080: {{EJC{{{{ ! 14081: * ! 14082: * CMPIL (CONTINUED) ! 14083: * ! 14084: * MERGE HERE TO BUILD CDBLK ! 14085: * ! 14086: * (WA) CDFAL VALUE TO BE GENERATED ! 14087: * (WB) CDTYP VALUE TO BE GENERATED ! 14088: * ! 14089: * AT THIS STAGE, WE CHOP OFF AN APPROPRIATE CHUNK OF THE ! 14090: * CURRENT CCBLK AND CONVERT IT INTO A CDBLK. THE REMAINDER ! 14091: * OF THE CCBLK IS REFORMATTED TO BE THE NEW CCBLK. ! 14092: * ! 14093: {CMP25{MOV{R$CCB{R9{{POINT TO CCBLK ! 14094: {{MOV{4*CMLBL(SP){R10{{GET POSSIBLE LABEL POINTER ! 14095: {{BZE{R10{CMP26{{SKIP IF NO LABEL ! 14096: {{ZER{4*CMLBL(SP){{{CLEAR FLAG FOR NEXT STATEMENT ! 14097: {{MOV{R9{4*VRLBL(R10){{PUT CDBLK PTR IN VRBLK LABEL FIELD ! 14098: * ! 14099: * MERGE AFTER DOING LABEL ! 14100: * ! 14101: {CMP26{MOV{R7{(R9){{SET TYPE WORD FOR NEW CDBLK ! 14102: {{MOV{R6{4*CDFAL(R9){{SET FAILURE WORD ! 14103: {{MOV{R9{R10{{COPY POINTER TO CCBLK ! 14104: {{MOV{4*CCUSE(R9){R7{{LOAD LENGTH GEN (= NEW CDLEN) ! 14105: {{MOV{4*CCLEN(R9){R8{{LOAD TOTAL CCBLK LENGTH ! 14106: {{ADD{R7{R10{{POINT PAST CDBLK ! 14107: {{SUB{R7{R8{{GET LENGTH LEFT FOR CHOP OFF ! 14108: {{MOV{#B$CCT{(R10){{SET TYPE CODE FOR NEW CCBLK AT END ! 14109: {{MOV{#4*CCCOD{4*CCUSE(R10){{SET INITIAL CODE OFFSET ! 14110: {{MOV{#4*CCCOD{CWCOF{{REINITIALISE CWCOF ! 14111: {{MOV{R8{4*CCLEN(R10){{SET NEW LENGTH ! 14112: {{MOV{R10{R$CCB{{SET NEW CCBLK POINTER ! 14113: {{MOV{CMPSN{4*CDSTM(R9){{SET STATEMENT NUMBER ! 14114: {{ICV{CMPSN{{{BUMP STATEMENT NUMBER ! 14115: * ! 14116: * SET POINTERS IN PREVIOUS CODE BLOCK AS REQUIRED ! 14117: * ! 14118: {{MOV{4*CMPCD(SP){R10{{LOAD PTR TO PREVIOUS CDBLK ! 14119: {{BZE{4*CMFFP(SP){CMP27{{JUMP IF NO FAILURE FILL IN REQUIRED ! 14120: {{MOV{R9{4*CDFAL(R10){{ELSE SET FAILURE PTR IN PREVIOUS ! 14121: * ! 14122: * HERE TO DEAL WITH SUCCESS FORWARD POINTER ! 14123: * ! 14124: {CMP27{MOV{4*CMSOP(SP){R6{{LOAD SUCCESS OFFSET ! 14125: {{BZE{R6{CMP28{{JUMP IF NO FILL IN REQUIRED ! 14126: {{ADD{R6{R10{{ELSE POINT TO FILL IN LOCATION ! 14127: {{MOV{R9{(R10){{STORE FORWARD POINTER ! 14128: {{ZER{R10{{{CLEAR GARBAGE XL VALUE ! 14129: {{EJC{{{{ ! 14130: * ! 14131: * CMPIL (CONTINUED) ! 14132: * ! 14133: * NOW SET FILL IN POINTERS FOR THIS STATEMENT ! 14134: * ! 14135: {CMP28{MOV{4*CMFFC(SP){4*CMFFP(SP){{COPY FAILURE FILL IN FLAG ! 14136: {{MOV{4*CMSOC(SP){4*CMSOP(SP){{COPY SUCCESS FILL IN OFFSET ! 14137: {{MOV{R9{4*CMPCD(SP){{SAVE PTR TO THIS CDBLK ! 14138: {{BNZ{4*CMTRA(SP){CMP29{{JUMP IF INITIAL ENTRY ALREADY SET ! 14139: {{MOV{R9{4*CMTRA(SP){{ELSE SET PTR HERE AS DEFAULT ! 14140: * ! 14141: * HERE AFTER COMPILING ONE STATEMENT ! 14142: * ! 14143: {CMP29{BLT{STAGE{#STGCE{CMP01{JUMP IF NOT END LINE JUST DONE ! 14144: {{BZE{CSWLS{CMP30{{SKIP IF -NOLIST ! 14145: {{JSR{LISTR{{{LIST LAST LINE ! 14146: * ! 14147: * RETURN ! 14148: * ! 14149: {CMP30{MOV{4*CMTRA(SP){R9{{LOAD INITIAL ENTRY CDBLK POINTER ! 14150: {{ADD{#4*CMNEN{SP{{POP WORK LOCATIONS OFF STACK ! 14151: {{EXI{{{{AND RETURN TO CMPIL CALLER ! 14152: * ! 14153: * HERE AT END OF GOTO FIELD ! 14154: * ! 14155: {CMP31{MOV{4*CMFGO(SP){R7{{GET FAIL GOTO ! 14156: {{ORB{4*CMSGO(SP){R7{{OR IN SUCCESS GOTO ! 14157: {{BNZ{R7{CMP18{{OK IF NON-NULL FIELD ! 14158: {{ERB{219{SYNTAX{{ERROR. EMPTY GOTO FIELD ! 14159: * ! 14160: * CONTROL CARD FOUND ! 14161: * ! 14162: {CMP32{ICV{R7{{{POINT PAST CH$MN ! 14163: {{JSR{CNCRD{{{PROCESS CONTROL CARD ! 14164: {{ZER{SCNSE{{{CLEAR START OF ELEMENT LOC. ! 14165: {{BRN{CMPCE{{{LOOP FOR NEXT STATEMENT ! 14166: {{ENP{{{{END PROCEDURE CMPIL ! 14167: {{EJC{{{{ ! 14168: * ! 14169: * CNCRD -- CONTROL CARD PROCESSOR ! 14170: * ! 14171: * CALLED TO DEAL WITH CONTROL CARDS ! 14172: * ! 14173: * R$CIM POINTS TO CURRENT IMAGE ! 14174: * (WB) OFFSET TO 1ST CHAR OF CONTROL CARD ! 14175: * JSR CNCRD CALL TO PROCESS CONTROL CARDS ! 14176: * (XL,XR,WA,WB,WC,IA) DESTROYED ! 14177: * ! 14178: {CNCRD{PRC{E{0{{ENTRY POINT ! 14179: {{MOV{R7{SCNPT{{OFFSET FOR CONTROL CARD SCAN ! 14180: {{MOV{#CCNOC{R6{{NUMBER OF CHARS FOR COMPARISON ! 14181: {{CTW{R6{0{{CONVERT TO WORD COUNT ! 14182: {{MOV{R6{CNSWC{{SAVE WORD COUNT ! 14183: * ! 14184: * LOOP HERE IF MORE THAN ONE CONTROL CARD ! 14185: * ! 14186: {CNC01{BGE{SCNPT{SCNIL{CNC09{RETURN IF END OF IMAGE ! 14187: {{MOV{R$CIM{R9{{POINT TO IMAGE ! 14188: {{PLC{R9{SCNPT{{CHAR PTR FOR FIRST CHAR ! 14189: {{LCH{R6{(R9)+{{GET FIRST CHAR ! 14190: {{FLC{R6{{{FOLD TO UPPER CASE ! 14191: {{BEQ{R6{#CH$LI{CNC07{SPECIAL CASE OF -INXXX ! 14192: {{MNZ{SCNCC{{{SET FLAG FOR SCANE ! 14193: {{JSR{SCANE{{{SCAN CARD NAME ! 14194: {{ZER{SCNCC{{{CLEAR SCANE FLAG ! 14195: {{BNZ{R10{CNC06{{FAIL UNLESS CONTROL CARD NAME ! 14196: {{MOV{#CCNOC{R6{{NO. OF CHARS TO BE COMPARED ! 14197: {{BLT{4*SCLEN(R9){R6{CNC06{FAIL IF TOO FEW CHARS ! 14198: {{MOV{R9{R10{{POINT TO CONTROL CARD NAME ! 14199: {{ZER{R7{{{ZERO OFFSET FOR SUBSTRING ! 14200: {{JSR{SBSTR{{{EXTRACT SUBSTRING FOR COMPARISON ! 14201: {{MOV{4*SCLEN(R9){R6{{RELOAD LENGTH ! 14202: {{JSR{FLSTG{{{FOLD TO UPPER CASE ! 14203: {{MOV{R9{CNSCC{{KEEP CONTROL CARD SUBSTRING PTR ! 14204: {{MOV{#CCNMS{R9{{POINT TO LIST OF STANDARD NAMES ! 14205: {{ZER{R7{{{INITIALISE NAME OFFSET ! 14206: {{LCT{R8{#CC$NC{{NUMBER OF STANDARD NAMES ! 14207: * ! 14208: * TRY TO MATCH NAME ! 14209: * ! 14210: {CNC02{MOV{CNSCC{R10{{POINT TO NAME ! 14211: {{LCT{R6{CNSWC{{COUNTER FOR INNER LOOP ! 14212: {{BRN{CNC04{{{JUMP INTO LOOP ! 14213: * ! 14214: * INNER LOOP TO MATCH CARD NAME CHARS ! 14215: * ! 14216: {CNC03{ICA{R9{{{BUMP STANDARD NAMES PTR ! 14217: {{ICA{R10{{{BUMP NAME POINTER ! 14218: * ! 14219: * HERE TO INITIATE THE LOOP ! 14220: * ! 14221: {CNC04{CNE{4*SCHAR(R10){(R9){CNC05{COMP. UP TO CFP$C CHARS AT ONCE ! 14222: {{BCT{R6{CNC03{{LOOP IF MORE WORDS TO COMPARE ! 14223: {{EJC{{{{ ! 14224: * ! 14225: * CNCRD (CONTINUED) ! 14226: * ! 14227: * MATCHED - BRANCH ON CARD OFFSET ! 14228: * ! 14229: {{MOV{R7{R10{{GET NAME OFFSET ! 14230: {{BSW{R10{CC$NC{{SWITCH ! 14231: {{IFF{CC$CA{CNC37{{-CASE ! 14232: {{IFF{CC$DO{CNC10{{-DOUBLE ! 14233: {{IFF{CC$DU{CNC11{{-DUMP ! 14234: {{IFF{CC$EJ{CNC12{{-EJECT ! 14235: {{IFF{CC$ER{CNC13{{-ERRORS ! 14236: {{IFF{CC$EX{CNC14{{-EXECUTE ! 14237: {{IFF{CC$FA{CNC15{{-FAIL ! 14238: {{IFF{CC$LI{CNC16{{-LIST ! 14239: {{IFF{CC$NR{CNC17{{-NOERRORS ! 14240: {{IFF{CC$NX{CNC18{{-NOEXECUTE ! 14241: {{IFF{CC$NF{CNC19{{-NOFAIL ! 14242: {{IFF{CC$NL{CNC20{{-NOLIST ! 14243: {{IFF{CC$NO{CNC21{{-NOOPT ! 14244: {{IFF{CC$NP{CNC22{{-NOPRINT ! 14245: {{IFF{CC$OP{CNC24{{-OPTIMISE ! 14246: {{IFF{CC$PR{CNC25{{-PRINT ! 14247: {{IFF{CC$SI{CNC27{{-SINGLE ! 14248: {{IFF{CC$SP{CNC28{{-SPACE ! 14249: {{IFF{CC$ST{CNC31{{-STITLE ! 14250: {{IFF{CC$TI{CNC32{{-TITLE ! 14251: {{IFF{CC$TR{CNC36{{-TRACE ! 14252: {{ESW{{{{END SWITCH ! 14253: * ! 14254: * NOT MATCHED YET. ALIGN STD NAMES PTR AND TRY AGAIN ! 14255: * ! 14256: {CNC05{ICA{R9{{{BUMP STANDARD NAMES PTR ! 14257: {{BCT{R6{CNC05{{LOOP ! 14258: {{ICV{R7{{{BUMP NAMES OFFSET ! 14259: {{BCT{R8{CNC02{{CONTINUE IF MORE NAMES ! 14260: * ! 14261: * INVALID CONTROL CARD NAME ! 14262: * ! 14263: {CNC06{ERB{247{INVALID{{CONTROL CARD ! 14264: * ! 14265: * SPECIAL PROCESSING FOR -INXXX ! 14266: * ! 14267: {CNC07{LCH{R6{(R9){{GET NEXT CHAR ! 14268: {{FLC{R6{{{FOLD TO UPPER CASE ! 14269: {{BNE{R6{#CH$LN{CNC06{FAIL IF NOT LETTER N ! 14270: {{ADD{#NUM02{SCNPT{{BUMP OFFSET PAST -IN ! 14271: {{JSR{SCANE{{{SCAN INTEGER AFTER -IN ! 14272: {{MOV{R9{-(SP){{STACK SCANNED ITEM ! 14273: {{JSR{GTSMI{{{CHECK IF INTEGER ! 14274: {{PPM{CNC06{{{FAIL IF NOT INTEGER ! 14275: {{PPM{CNC06{{{FAIL IF NEGATIVE OR LARGE ! 14276: {{MOV{R9{CSWIN{{KEEP INTEGER ! 14277: {{EJC{{{{ ! 14278: * ! 14279: * CNCRD (CONTINUED) ! 14280: * ! 14281: * CHECK FOR MORE CONTROL CARDS BEFORE RETURNING ! 14282: * ! 14283: {CNC08{MOV{SCNPT{R6{{PRESERVE IN CASE XEQ TIME COMPILE ! 14284: {{JSR{SCANE{{{LOOK FOR COMMA ! 14285: {{BEQ{R10{#T$CMA{CNC01{LOOP IF COMMA FOUND ! 14286: {{MOV{R6{SCNPT{{RESTORE SCNPT IN CASE XEQ TIME ! 14287: * ! 14288: * RETURN POINT ! 14289: * ! 14290: {CNC09{EXI{{{{RETURN ! 14291: * ! 14292: * -DOUBLE ! 14293: * ! 14294: {CNC10{MNZ{CSWDB{{{SET SWITCH ! 14295: {{BRN{CNC08{{{MERGE ! 14296: * ! 14297: * -DUMP ! 14298: * THIS IS USED FOR SYSTEM DEBUGGING . IT HAS THE EFFECT OF ! 14299: * PRODUCING A CORE DUMP AT COMPILATION TIME ! 14300: * ! 14301: {CNC11{JSR{SYSDM{{{CALL DUMPER ! 14302: {{BRN{CNC09{{{FINISHED ! 14303: * ! 14304: * -EJECT ! 14305: * ! 14306: {CNC12{BZE{CSWLS{CNC09{{RETURN IF -NOLIST ! 14307: {{JSR{PRTPS{{{EJECT ! 14308: {{JSR{LISTT{{{LIST TITLE ! 14309: {{BRN{CNC09{{{FINISHED ! 14310: * ! 14311: * -ERRORS ! 14312: * ! 14313: {CNC13{ZER{CSWER{{{CLEAR SWITCH ! 14314: {{BRN{CNC08{{{MERGE ! 14315: * ! 14316: * -EXECUTE ! 14317: * ! 14318: {CNC14{ZER{CSWEX{{{CLEAR SWITCH ! 14319: {{BRN{CNC08{{{MERGE ! 14320: * ! 14321: * -FAIL ! 14322: * ! 14323: {CNC15{MNZ{CSWFL{{{SET SWITCH ! 14324: {{BRN{CNC08{{{MERGE ! 14325: * ! 14326: * -LIST ! 14327: * ! 14328: {CNC16{MNZ{CSWLS{{{SET SWITCH ! 14329: {{BEQ{STAGE{#STGIC{CNC08{DONE IF COMPILE TIME ! 14330: * ! 14331: * LIST CODE LINE IF EXECUTE TIME COMPILE ! 14332: * ! 14333: {{ZER{LSTPF{{{PERMIT LISTING ! 14334: {{JSR{LISTR{{{LIST LINE ! 14335: {{BRN{CNC08{{{MERGE ! 14336: {{EJC{{{{ ! 14337: * ! 14338: * CNCRD (CONTINUED) ! 14339: * ! 14340: * -NOERRORS ! 14341: * ! 14342: {CNC17{MNZ{CSWER{{{SET SWITCH ! 14343: {{BRN{CNC08{{{MERGE ! 14344: * ! 14345: * -NOEXECUTE ! 14346: * ! 14347: {CNC18{MNZ{CSWEX{{{SET SWITCH ! 14348: {{BRN{CNC08{{{MERGE ! 14349: * ! 14350: * -NOFAIL ! 14351: * ! 14352: {CNC19{ZER{CSWFL{{{CLEAR SWITCH ! 14353: {{BRN{CNC08{{{MERGE ! 14354: * ! 14355: * -NOLIST ! 14356: * ! 14357: {CNC20{ZER{CSWLS{{{CLEAR SWITCH ! 14358: {{BRN{CNC08{{{MERGE ! 14359: * ! 14360: * -NOOPTIMISE ! 14361: * ! 14362: {CNC21{MNZ{CSWNO{{{SET SWITCH ! 14363: {{BRN{CNC08{{{MERGE ! 14364: * ! 14365: * -NOPRINT ! 14366: * ! 14367: {CNC22{ZER{CSWPR{{{CLEAR SWITCH ! 14368: {{BRN{CNC08{{{MERGE ! 14369: * ! 14370: * -OPTIMISE ! 14371: * ! 14372: {CNC24{ZER{CSWNO{{{CLEAR SWITCH ! 14373: {{BRN{CNC08{{{MERGE ! 14374: * ! 14375: * -PRINT ! 14376: * ! 14377: {CNC25{MNZ{CSWPR{{{SET SWITCH ! 14378: {{BRN{CNC08{{{MERGE ! 14379: {{EJC{{{{ ! 14380: * ! 14381: * CNCRD (CONTINUED) ! 14382: * ! 14383: * -SINGLE ! 14384: * ! 14385: {CNC27{ZER{CSWDB{{{CLEAR SWITCH ! 14386: {{BRN{CNC08{{{MERGE ! 14387: * ! 14388: * -SPACE ! 14389: * ! 14390: {CNC28{BZE{CSWLS{CNC09{{RETURN IF -NOLIST ! 14391: {{JSR{SCANE{{{SCAN INTEGER AFTER -SPACE ! 14392: {{MOV{#NUM01{R8{{1 SPACE IN CASE ! 14393: {{BEQ{R9{#T$SMC{CNC29{JUMP IF NO INTEGER ! 14394: {{MOV{R9{-(SP){{STACK IT ! 14395: {{JSR{GTSMI{{{CHECK INTEGER ! 14396: {{PPM{CNC06{{{FAIL IF NOT INTEGER ! 14397: {{PPM{CNC06{{{FAIL IF NEGATIVE OR LARGE ! 14398: {{BNZ{R8{CNC29{{JUMP IF NON ZERO ! 14399: {{MOV{#NUM01{R8{{ELSE 1 SPACE ! 14400: * ! 14401: * MERGE WITH COUNT OF LINES TO SKIP ! 14402: * ! 14403: {CNC29{ADD{R8{LSTLC{{BUMP LINE COUNT ! 14404: {{LCT{R8{R8{{CONVERT TO LOOP COUNTER ! 14405: {{BLT{LSTLC{LSTNP{CNC30{JUMP IF FITS ON PAGE ! 14406: {{JSR{PRTPS{{{EJECT ! 14407: {{JSR{LISTT{{{LIST TITLE ! 14408: {{BRN{CNC09{{{MERGE ! 14409: * ! 14410: * SKIP LINES ! 14411: * ! 14412: {CNC30{JSR{PRTNL{{{PRINT A BLANK ! 14413: {{BCT{R8{CNC30{{LOOP ! 14414: {{BRN{CNC09{{{MERGE ! 14415: {{EJC{{{{ ! 14416: * ! 14417: * CNCRD (CONTINUED) ! 14418: * ! 14419: * -STITL ! 14420: * ! 14421: {CNC31{MOV{#R$STL{CNR$T{{PTR TO R$STL ! 14422: {{BRN{CNC33{{{MERGE ! 14423: * ! 14424: * -TITLE ! 14425: * ! 14426: {CNC32{MOV{#NULLS{R$STL{{CLEAR SUBTITLE ! 14427: {{MOV{#R$TTL{CNR$T{{PTR TO R$TTL ! 14428: * ! 14429: * COMMON PROCESSING FOR -TITLE, -STITL ! 14430: * ! 14431: {CNC33{MOV{#NULLS{R9{{NULL IN CASE NEEDED ! 14432: {{MNZ{CNTTL{{{SET FLAG FOR NEXT LISTR CALL ! 14433: {{MOV{#CCOFS{R7{{OFFSET TO TITLE/SUBTITLE ! 14434: {{MOV{SCNIL{R6{{INPUT IMAGE LENGTH ! 14435: {{BLO{R6{R7{CNC34{JUMP IF NO CHARS LEFT ! 14436: {{SUB{R7{R6{{NO OF CHARS TO EXTRACT ! 14437: {{MOV{R$CIM{R10{{POINT TO IMAGE ! 14438: {{JSR{SBSTR{{{GET TITLE/SUBTITLE ! 14439: * ! 14440: * STORE TITLE/SUBTITLE ! 14441: * ! 14442: {CNC34{MOV{CNR$T{R10{{POINT TO STORAGE LOCATION ! 14443: {{MOV{R9{(R10){{STORE TITLE/SUBTITLE ! 14444: {{BEQ{R10{#R$STL{CNC09{RETURN IF STITL ! 14445: {{BNZ{PRECL{CNC09{{RETURN IF EXTENDED LISTING ! 14446: {{BZE{PRICH{CNC09{{RETURN IF REGULAR PRINTER ! 14447: {{MOV{4*SCLEN(R9){R10{{GET LENGTH OF TITLE ! 14448: {{MOV{R10{R6{{COPY IT ! 14449: {{BZE{R10{CNC35{{JUMP IF NULL ! 14450: {{ADD{#NUM10{R10{{INCREMENT ! 14451: {{BHI{R10{PRLEN{CNC09{USE DEFAULT LSTP0 VAL IF TOO LONG ! 14452: {{ADD{#NUM04{R6{{POINT JUST PAST TITLE ! 14453: * ! 14454: * STORE OFFSET TO PAGE NN MESSAGE FOR SHORT TITLE ! 14455: * ! 14456: {CNC35{MOV{R6{LSTPO{{STORE OFFSET ! 14457: {{BRN{CNC09{{{RETURN ! 14458: * ! 14459: * -TRACE ! 14460: * PROVIDED FOR SYSTEM DEBUGGING. TOGGLES THE SYSTEM LABEL ! 14461: * TRACE SWITCH AT COMPILE TIME ! 14462: * ! 14463: {CNC36{JSR{SYSTT{{{TOGGLE SWITCH ! 14464: {{BRN{CNC08{{{MERGE ! 14465: * ! 14466: * -CASE ! 14467: * SETS VALUE OF KVCAS SO THAT NAMES ARE FOLDED OR NOT ! 14468: * DURING COMPILATION. ! 14469: * ! 14470: {CNC37{JSR{SCANE{{{SCAN INTEGER AFTER -CASE ! 14471: {{ZER{R8{{{GET 0 IN CASE NONE THERE ! 14472: {{BEQ{R10{#T$SMC{CNC38{SKIP IF NO INTEGER ! 14473: {{MOV{R9{-(SP){{STACK IT ! 14474: {{JSR{GTSMI{{{CHECK INTEGER ! 14475: {{PPM{CNC06{{{FAIL IF NOT INTEGER ! 14476: {{PPM{CNC06{{{FAIL IF NEGATIVE OR TOO LARGE ! 14477: {CNC38{MOV{R8{KVCAS{{STORE NEW CASE VALUE ! 14478: {{BRN{CNC09{{{MERGE ! 14479: {{ENP{{{{END PROCEDURE CNCRD ! 14480: {{EJC{{{{ ! 14481: * ! 14482: * DFFNC -- DEFINE FUNCTION ! 14483: * ! 14484: * DFFNC IS CALLED WHENEVER A NEW FUNCTION IS ASSIGNED TO ! 14485: * A VARIABLE. IT DEALS WITH EXTERNAL FUNCTION USE COUNTS. ! 14486: * ! 14487: * (XR) POINTER TO VRBLK ! 14488: * (XL) POINTER TO NEW FUNCTION BLOCK ! 14489: * JSR DFFNC CALL TO DEFINE FUNCTION ! 14490: * (WA,WB) DESTROYED ! 14491: * ! 14492: {DFFNC{PRC{E{0{{ENTRY POINT ! 14493: {{BNE{(R10){#B$EFC{DFFN1{SKIP IF NEW FUNCTION NOT EXTERNAL ! 14494: {{ICV{4*EFUSE(R10){{{ELSE INCREMENT ITS USE COUNT ! 14495: * ! 14496: * HERE AFTER DEALING WITH NEW FUNCTION USE COUNT ! 14497: * ! 14498: {DFFN1{MOV{R9{R6{{SAVE VRBLK POINTER ! 14499: {{MOV{4*VRFNC(R9){R9{{LOAD OLD FUNCTION POINTER ! 14500: {{BNE{(R9){#B$EFC{DFFN2{JUMP IF OLD FUNCTION NOT EXTERNAL ! 14501: {{MOV{4*EFUSE(R9){R7{{ELSE GET USE COUNT ! 14502: {{DCV{R7{{{DECREMENT ! 14503: {{MOV{R7{4*EFUSE(R9){{STORE DECREMENTED VALUE ! 14504: {{BNZ{R7{DFFN2{{JUMP IF USE COUNT STILL NON-ZERO ! 14505: {{JSR{SYSUL{{{ELSE CALL SYSTEM UNLOAD FUNCTION ! 14506: * ! 14507: * HERE AFTER DEALING WITH OLD FUNCTION USE COUNT ! 14508: * ! 14509: {DFFN2{MOV{R6{R9{{RESTORE VRBLK POINTER ! 14510: {{MOV{R10{R6{{COPY FUNCTION BLOCK PTR ! 14511: {{BLT{R9{#R$YYY{DFFN3{SKIP CHECKS IF OPSYN OP DEFINITION ! 14512: {{BNZ{4*VRLEN(R9){DFFN3{{JUMP IF NOT SYSTEM VARIABLE ! 14513: * ! 14514: * FOR SYSTEM VARIABLE, CHECK FOR ILLEGAL REDEFINITION ! 14515: * ! 14516: {{MOV{4*VRSVP(R9){R10{{POINT TO SVBLK ! 14517: {{MOV{4*SVBIT(R10){R7{{LOAD BIT INDICATORS ! 14518: {{ANB{BTFNC{R7{{IS IT A SYSTEM FUNCTION ! 14519: {{ZRB{R7{DFFN3{{REDEF OK IF NOT ! 14520: {{ERB{248{ATTEMPTED{{REDEFINITION OF SYSTEM FUNCTION ! 14521: * ! 14522: * HERE IF REDEFINITION IS PERMITTED ! 14523: * ! 14524: {DFFN3{MOV{R6{4*VRFNC(R9){{STORE NEW FUNCTION POINTER ! 14525: {{MOV{R6{R10{{RESTORE FUNCTION BLOCK POINTER ! 14526: {{EXI{{{{RETURN TO DFFNC CALLER ! 14527: {{ENP{{{{END PROCEDURE DFFNC ! 14528: {{EJC{{{{ ! 14529: * ! 14530: * DTACH -- DETACH I/O ASSOCIATED NAMES ! 14531: * ! 14532: * DETACHES TRBLKS FROM I/O ASSOCIATED VARIABLES, REMOVES ! 14533: * ENTRY FROM IOCHN CHAIN ATTACHED TO FILEARG1 VRBLK AND MAY ! 14534: * REMOVE VRBLK ACCESS AND STORE TRAPS. ! 14535: * INPUT, OUTPUT, TERMINAL ARE HANDLED SPECIALLY. ! 14536: * ! 14537: * (XL) I/O ASSOC. VBL NAME BASE PTR ! 14538: * (WA) OFFSET TO NAME ! 14539: * JSR DTACH CALL FOR DETACH OPERATION ! 14540: * (XL,XR,WA,WB,WC) DESTROYED ! 14541: * ! 14542: {DTACH{PRC{E{0{{ENTRY POINT ! 14543: {{MOV{R10{DTCNB{{STORE NAME BASE (GBCOL NOT CALLED) ! 14544: {{ADD{R6{R10{{POINT TO NAME LOCATION ! 14545: {{MOV{R10{DTCNM{{STORE IT ! 14546: * ! 14547: * LOOP TO SEARCH FOR I/O TRBLK ! 14548: * ! 14549: {DTCH1{MOV{R10{R9{{COPY NAME POINTER ! 14550: * ! 14551: * CONTINUE AFTER BLOCK DELETION ! 14552: * ! 14553: {DTCH2{MOV{(R10){R10{{POINT TO NEXT VALUE ! 14554: {{BNE{(R10){#B$TRT{DTCH6{JUMP AT CHAIN END ! 14555: {{MOV{4*TRTYP(R10){R6{{GET TRAP BLOCK TYPE ! 14556: {{BEQ{R6{#TRTIN{DTCH3{JUMP IF INPUT ! 14557: {{BEQ{R6{#TRTOU{DTCH3{JUMP IF OUTPUT ! 14558: {{ADD{#4*TRNXT{R10{{POINT TO NEXT LINK ! 14559: {{BRN{DTCH1{{{LOOP ! 14560: * ! 14561: * DELETE AN OLD ASSOCIATION ! 14562: * ! 14563: {DTCH3{MOV{4*TRVAL(R10){(R9){{DELETE TRBLK ! 14564: {{MOV{R10{R6{{DUMP XL ... ! 14565: {{MOV{R9{R7{{... AND XR ! 14566: {{MOV{4*TRTRF(R10){R10{{POINT TO TRTRF TRAP BLOCK ! 14567: {{BZE{R10{DTCH5{{JUMP IF NO IOCHN ! 14568: {{BNE{(R10){#B$TRT{DTCH5{JUMP IF INPUT, OUTPUT, TERMINAL ! 14569: * ! 14570: * LOOP TO SEARCH IOCHN CHAIN FOR NAME PTR ! 14571: * ! 14572: {DTCH4{MOV{R10{R9{{REMEMBER LINK PTR ! 14573: {{MOV{4*TRTRF(R10){R10{{POINT TO NEXT LINK ! 14574: {{BZE{R10{DTCH5{{JUMP IF END OF CHAIN ! 14575: {{MOV{4*IONMB(R10){R8{{GET NAME BASE ! 14576: {{ADD{4*IONMO(R10){R8{{ADD OFFSET ! 14577: {{BNE{R8{DTCNM{DTCH4{LOOP IF NO MATCH ! 14578: {{MOV{4*TRTRF(R10){4*TRTRF(R9){{REMOVE NAME FROM CHAIN ! 14579: {{EJC{{{{ ! 14580: * ! 14581: * DTACH (CONTINUED) ! 14582: * ! 14583: * PREPARE TO RESUME I/O TRBLK SCAN ! 14584: * ! 14585: {DTCH5{MOV{R6{R10{{RECOVER XL ... ! 14586: {{MOV{R7{R9{{... AND XR ! 14587: {{ADD{#4*TRVAL{R10{{POINT TO VALUE FIELD ! 14588: {{BRN{DTCH2{{{CONTINUE ! 14589: * ! 14590: * EXIT POINT ! 14591: * ! 14592: {DTCH6{MOV{DTCNB{R9{{POSSIBLE VRBLK PTR ! 14593: {{JSR{SETVR{{{RESET VRBLK IF NECESSARY ! 14594: {{EXI{{{{RETURN ! 14595: {{ENP{{{{END PROCEDURE DTACH ! 14596: {{EJC{{{{ ! 14597: * ! 14598: * DTYPE -- GET DATATYPE NAME ! 14599: * ! 14600: * (XR) OBJECT WHOSE DATATYPE IS REQUIRED ! 14601: * JSR DTYPE CALL TO GET DATATYPE ! 14602: * (XR) RESULT DATATYPE ! 14603: * ! 14604: {DTYPE{PRC{E{0{{ENTRY POINT ! 14605: {{BEQ{(R9){#B$PDT{DTYP1{JUMP IF PROG.DEFINED ! 14606: {{MOV{(R9){R9{{LOAD TYPE WORD ! 14607: {{LEI{R9{{{GET ENTRY POINT ID (BLOCK CODE) ! 14608: {{WTB{R9{{{CONVERT TO BYTE OFFSET ! 14609: {{MOV{L^SCNMT(R9){R9{{LOAD TABLE ENTRY ! 14610: {{EXI{{{{EXIT TO DTYPE CALLER ! 14611: * ! 14612: * HERE IF PROGRAM DEFINED ! 14613: * ! 14614: {DTYP1{MOV{4*PDDFP(R9){R9{{POINT TO DFBLK ! 14615: {{MOV{4*DFNAM(R9){R9{{GET DATATYPE NAME FROM DFBLK ! 14616: {{EXI{{{{RETURN TO DTYPE CALLER ! 14617: {{ENP{{{{END PROCEDURE DTYPE ! 14618: {{EJC{{{{ ! 14619: * ! 14620: * DUMPR -- PRINT DUMP OF STORAGE ! 14621: * ! 14622: * (XR) DUMP ARGUMENT (SEE BELOW) ! 14623: * JSR DUMPR CALL TO PRINT DUMP ! 14624: * (XR,XL) DESTROYED ! 14625: * (WA,WB,WC,RA) DESTROYED ! 14626: * ! 14627: * THE DUMP ARGUMENT HAS THE FOLLOWING SIGNIFICANCE ! 14628: * ! 14629: * DMARG = 0 NO DUMP PRINTED ! 14630: * DMARG = 1 PARTIAL DUMP (NAT VARS, KEYWORDS) ! 14631: * DMARG EQ 2 FULL DUMP (INCL ARRAYS ETC.) ! 14632: * DMARG GE 3 CORE DUMP ! 14633: * ! 14634: * SINCE DUMPR SCRAMBLES STORE, IT IS NOT PERMISSIBLE TO ! 14635: * COLLECT IN MID-DUMP. HENCE A COLLECT IS DONE INITIALLY ! 14636: * AND THEN IF STORE RUNS OUT AN ERROR MESSAGE IS PRODUCED. ! 14637: * ! 14638: {DUMPR{PRC{E{0{{ENTRY POINT ! 14639: {{BZE{R9{DMP28{{SKIP DUMP IF ARGUMENT IS ZERO ! 14640: {{BGT{R9{#NUM02{DMP29{JUMP IF CORE DUMP REQUIRED ! 14641: {{ZER{R10{{{CLEAR XL ! 14642: {{ZER{R7{{{ZERO MOVE OFFSET ! 14643: {{MOV{R9{DMARG{{SAVE DUMP ARGUMENT ! 14644: {{JSR{GBCOL{{{COLLECT GARBAGE ! 14645: {{JSR{PRTPG{{{EJECT PRINTER ! 14646: {{MOV{#DMHDV{R9{{POINT TO HEADING FOR VARIABLES ! 14647: {{JSR{PRTST{{{PRINT IT ! 14648: {{JSR{PRTNL{{{TERMINATE PRINT LINE ! 14649: {{JSR{PRTNL{{{AND PRINT A BLANK LINE ! 14650: * ! 14651: * FIRST ALL NATURAL VARIABLE BLOCKS (VRBLK) WHOSE VALUES ! 14652: * ARE NON-NULL ARE LINKED IN LEXICAL ORDER USING DMVCH AS ! 14653: * THE CHAIN HEAD AND CHAINING THROUGH THE VRGET FIELDS. ! 14654: * NOTE THAT THIS SCRAMBLES STORE IF THE PROCESS IS ! 14655: * INTERRUPTED BEFORE COMPLETION E.G. BY EXCEEDING TIME OR ! 14656: * PRINT LIMITS. SINCE THE SUBSEQUENT CORE DUMPS AND ! 14657: * FAILURES IF EXECUTION IS RESUMED ARE VERY CONFUSING, THE ! 14658: * EXECUTION TIME ERROR ROUTINE CHECKS FOR THIS EVENT AND ! 14659: * ATTEMPTS AN UNSCRAMBLE. SIMILAR PRECAUTIONS SHOULD BE ! 14660: * OBSERVED IF TRANSLATE TIME DUMPING IS IMPLEMENTED. ! 14661: * ! 14662: {{ZER{DMVCH{{{SET NULL CHAIN TO START ! 14663: {{MOV{HSHTB{R6{{POINT TO HASH TABLE ! 14664: * ! 14665: * LOOP THROUGH HEADERS IN HASH TABLE ! 14666: * ! 14667: {DMP00{MOV{R6{R9{{COPY HASH BUCKET POINTER ! 14668: {{ICA{R6{{{BUMP POINTER ! 14669: {{SUB{#4*VRNXT{R9{{SET OFFSET TO MERGE ! 14670: * ! 14671: * LOOP THROUGH VRBLKS ON ONE CHAIN ! 14672: * ! 14673: {DMP01{MOV{4*VRNXT(R9){R9{{POINT TO NEXT VRBLK ON CHAIN ! 14674: {{BZE{R9{DMP09{{JUMP IF END OF THIS HASH CHAIN ! 14675: {{MOV{R9{R10{{ELSE COPY VRBLK POINTER ! 14676: {{EJC{{{{ ! 14677: * ! 14678: * DUMPR (CONTINUED) ! 14679: * ! 14680: * LOOP TO FIND VALUE AND SKIP IF NULL ! 14681: * ! 14682: {DMP02{MOV{4*VRVAL(R10){R10{{LOAD VALUE ! 14683: {{BEQ{R10{#NULLS{DMP01{LOOP FOR NEXT VRBLK IF NULL VALUE ! 14684: {{BEQ{(R10){#B$TRT{DMP02{LOOP BACK IF VALUE IS TRAPPED ! 14685: * ! 14686: * NON-NULL VALUE, PREPARE TO SEARCH CHAIN ! 14687: * ! 14688: {{MOV{R9{R8{{SAVE VRBLK POINTER ! 14689: {{ADD{#4*VRSOF{R9{{ADJUST PTR TO BE LIKE SCBLK PTR ! 14690: {{BNZ{4*SCLEN(R9){DMP03{{JUMP IF NON-SYSTEM VARIABLE ! 14691: {{MOV{4*VRSVO(R9){R9{{ELSE LOAD PTR TO NAME IN SVBLK ! 14692: * ! 14693: * HERE WITH NAME POINTER FOR NEW BLOCK IN XR ! 14694: * ! 14695: {DMP03{MOV{R9{R7{{SAVE POINTER TO CHARS ! 14696: {{MOV{R6{DMPSV{{SAVE HASH BUCKET POINTER ! 14697: {{MOV{#DMVCH{R6{{POINT TO CHAIN HEAD ! 14698: * ! 14699: * LOOP TO SEARCH CHAIN FOR CORRECT INSERTION POINT ! 14700: * ! 14701: {DMP04{MOV{R6{DMPCH{{SAVE CHAIN POINTER ! 14702: {{MOV{R6{R10{{COPY IT ! 14703: {{MOV{(R10){R9{{LOAD POINTER TO NEXT ENTRY ! 14704: {{BZE{R9{DMP08{{JUMP IF END OF CHAIN TO INSERT ! 14705: {{ADD{#4*VRSOF{R9{{ELSE GET NAME PTR FOR CHAINED VRBLK ! 14706: {{BNZ{4*SCLEN(R9){DMP05{{JUMP IF NOT SYSTEM VARIABLE ! 14707: {{MOV{4*VRSVO(R9){R9{{ELSE POINT TO NAME IN SVBLK ! 14708: * ! 14709: * HERE PREPARE TO COMPARE THE NAMES ! 14710: * ! 14711: * (WA) SCRATCH ! 14712: * (WB) POINTER TO STRING OF ENTERING VRBLK ! 14713: * (WC) POINTER TO ENTERING VRBLK ! 14714: * (XR) POINTER TO STRING OF CURRENT BLOCK ! 14715: * (XL) SCRATCH ! 14716: * ! 14717: {DMP05{MOV{R7{R10{{POINT TO ENTERING VRBLK STRING ! 14718: {{MOV{4*SCLEN(R10){R6{{LOAD ITS LENGTH ! 14719: {{PLC{R10{{{POINT TO CHARS OF ENTERING STRING ! 14720: {{BHI{R6{4*SCLEN(R9){DMP06{JUMP IF ENTERING LENGTH HIGH ! 14721: {{PLC{R9{{{ELSE POINT TO CHARS OF OLD STRING ! 14722: {{CMC{DMP08{DMP07{{COMPARE, INSERT IF NEW IS LLT OLD ! 14723: {{BRN{DMP08{{{OR IF LEQ (WE HAD SHORTER LENGTH) ! 14724: * ! 14725: * HERE WHEN NEW LENGTH IS LONGER THAN OLD LENGTH ! 14726: * ! 14727: {DMP06{MOV{4*SCLEN(R9){R6{{LOAD SHORTER LENGTH ! 14728: {{PLC{R9{{{POINT TO CHARS OF OLD STRING ! 14729: {{CMC{DMP08{DMP07{{COMPARE, INSERT IF NEW ONE LOW ! 14730: {{EJC{{{{ ! 14731: * ! 14732: * DUMPR (CONTINUED) ! 14733: * ! 14734: * HERE WE MOVE OUT ON THE CHAIN ! 14735: * ! 14736: {DMP07{MOV{DMPCH{R10{{COPY CHAIN POINTER ! 14737: {{MOV{(R10){R6{{MOVE TO NEXT ENTRY ON CHAIN ! 14738: {{BRN{DMP04{{{LOOP BACK ! 14739: * ! 14740: * HERE AFTER LOCATING THE PROPER INSERTION POINT ! 14741: * ! 14742: {DMP08{MOV{DMPCH{R10{{COPY CHAIN POINTER ! 14743: {{MOV{DMPSV{R6{{RESTORE HASH BUCKET POINTER ! 14744: {{MOV{R8{R9{{RESTORE VRBLK POINTER ! 14745: {{MOV{(R10){4*VRGET(R9){{LINK VRBLK TO REST OF CHAIN ! 14746: {{MOV{R9{(R10){{LINK VRBLK INTO CURRENT CHAIN LOC ! 14747: {{BRN{DMP01{{{LOOP BACK FOR NEXT VRBLK ! 14748: * ! 14749: * HERE AFTER PROCESSING ALL VRBLKS ON ONE CHAIN ! 14750: * ! 14751: {DMP09{BNE{R6{HSHTE{DMP00{LOOP BACK IF MORE BUCKETS TO GO ! 14752: * ! 14753: * LOOP TO GENERATE DUMP OF NATURAL VARIABLE VALUES ! 14754: * ! 14755: {DMP10{MOV{DMVCH{R9{{LOAD POINTER TO NEXT ENTRY ON CHAIN ! 14756: {{BZE{R9{DMP11{{JUMP IF END OF CHAIN ! 14757: {{MOV{(R9){DMVCH{{ELSE UPDATE CHAIN PTR TO NEXT ENTRY ! 14758: {{JSR{SETVR{{{RESTORE VRGET FIELD ! 14759: {{MOV{R9{R10{{COPY VRBLK POINTER (NAME BASE) ! 14760: {{MOV{#4*VRVAL{R6{{SET OFFSET FOR VRBLK NAME ! 14761: {{JSR{PRTNV{{{PRINT NAME = VALUE ! 14762: {{BRN{DMP10{{{LOOP BACK TILL ALL PRINTED ! 14763: * ! 14764: * PREPARE TO PRINT KEYWORDS ! 14765: * ! 14766: {DMP11{JSR{PRTNL{{{PRINT BLANK LINE ! 14767: {{JSR{PRTNL{{{AND ANOTHER ! 14768: {{MOV{#DMHDK{R9{{POINT TO KEYWORD HEADING ! 14769: {{JSR{PRTST{{{PRINT HEADING ! 14770: {{JSR{PRTNL{{{END LINE ! 14771: {{JSR{PRTNL{{{PRINT ONE BLANK LINE ! 14772: {{MOV{#VDMKW{R10{{POINT TO LIST OF KEYWORD SVBLK PTRS ! 14773: {{EJC{{{{ ! 14774: * ! 14775: * DUMPR (CONTINUED) ! 14776: * ! 14777: * LOOP TO DUMP KEYWORD VALUES ! 14778: * ! 14779: {DMP12{MOV{(R10)+{R9{{LOAD NEXT SVBLK PTR FROM TABLE ! 14780: {{BZE{R9{DMP13{{JUMP IF END OF LIST ! 14781: {{MOV{#CH$AM{R6{{LOAD AMPERSAND ! 14782: {{JSR{PRTCH{{{PRINT AMPERSAND ! 14783: {{JSR{PRTST{{{PRINT KEYWORD NAME ! 14784: {{MOV{4*SVLEN(R9){R6{{LOAD NAME LENGTH FROM SVBLK ! 14785: {{CTB{R6{SVCHS{{GET LENGTH OF NAME ! 14786: {{ADD{R6{R9{{POINT TO SVKNM FIELD ! 14787: {{MOV{(R9){DMPKN{{STORE IN DUMMY KVBLK ! 14788: {{MOV{#TMBEB{R9{{POINT TO BLANK-EQUAL-BLANK ! 14789: {{JSR{PRTST{{{PRINT IT ! 14790: {{MOV{R10{DMPSV{{SAVE TABLE POINTER ! 14791: {{MOV{#DMPKB{R10{{POINT TO DUMMY KVBLK ! 14792: {{MOV{#4*KVVAR{R6{{SET ZERO OFFSET ! 14793: {{JSR{ACESS{{{GET KEYWORD VALUE ! 14794: {{PPM{{{{FAILURE IS IMPOSSIBLE ! 14795: {{JSR{PRTVL{{{PRINT KEYWORD VALUE ! 14796: {{JSR{PRTNL{{{TERMINATE PRINT LINE ! 14797: {{MOV{DMPSV{R10{{RESTORE TABLE POINTER ! 14798: {{BRN{DMP12{{{LOOP BACK TILL ALL PRINTED ! 14799: * ! 14800: * HERE AFTER COMPLETING PARTIAL DUMP ! 14801: * ! 14802: {DMP13{BEQ{DMARG{#NUM01{DMP27{EXIT IF PARTIAL DUMP COMPLETE ! 14803: {{MOV{DNAMB{R9{{ELSE POINT TO FIRST DYNAMIC BLOCK ! 14804: * ! 14805: * LOOP THROUGH BLOCKS IN DYNAMIC STORAGE ! 14806: * ! 14807: {DMP14{BEQ{R9{DNAMP{DMP27{JUMP IF END OF USED REGION ! 14808: {{MOV{(R9){R6{{ELSE LOAD FIRST WORD OF BLOCK ! 14809: {{BEQ{R6{#B$VCT{DMP16{JUMP IF VECTOR ! 14810: {{BEQ{R6{#B$ART{DMP17{JUMP IF ARRAY ! 14811: {{BEQ{R6{#B$PDT{DMP18{JUMP IF PROGRAM DEFINED ! 14812: {{BEQ{R6{#B$TBT{DMP19{JUMP IF TABLE ! 14813: {{BEQ{R6{#B$BCT{DMP30{JUMP IF BUFFER ! 14814: * ! 14815: * MERGE HERE TO MOVE TO NEXT BLOCK ! 14816: * ! 14817: {DMP15{JSR{BLKLN{{{GET LENGTH OF BLOCK ! 14818: {{ADD{R6{R9{{POINT PAST THIS BLOCK ! 14819: {{BRN{DMP14{{{LOOP BACK FOR NEXT BLOCK ! 14820: {{EJC{{{{ ! 14821: * ! 14822: * DUMPR (CONTINUED) ! 14823: * ! 14824: * HERE FOR VECTOR ! 14825: * ! 14826: {DMP16{MOV{#4*VCVLS{R7{{SET OFFSET TO FIRST VALUE ! 14827: {{BRN{DMP19{{{JUMP TO MERGE ! 14828: * ! 14829: * HERE FOR ARRAY ! 14830: * ! 14831: {DMP17{MOV{4*AROFS(R9){R7{{SET OFFSET TO ARPRO FIELD ! 14832: {{ICA{R7{{{BUMP TO GET OFFSET TO VALUES ! 14833: {{BRN{DMP19{{{JUMP TO MERGE ! 14834: * ! 14835: * HERE FOR PROGRAM DEFINED ! 14836: * ! 14837: {DMP18{MOV{#4*PDFLD{R7{{POINT TO VALUES, MERGE ! 14838: * ! 14839: * HERE FOR TABLE (OTHERS MERGE) ! 14840: * ! 14841: {DMP19{BZE{4*IDVAL(R9){DMP15{{IGNORE BLOCK IF ZERO ID VALUE ! 14842: {{JSR{BLKLN{{{ELSE GET BLOCK LENGTH ! 14843: {{MOV{R9{R10{{COPY BLOCK POINTER ! 14844: {{MOV{R6{DMPSV{{SAVE LENGTH ! 14845: {{MOV{R7{R6{{COPY OFFSET TO FIRST VALUE ! 14846: {{JSR{PRTNL{{{PRINT BLANK LINE ! 14847: {{MOV{R6{DMPSA{{PRESERVE OFFSET ! 14848: {{JSR{PRTVL{{{PRINT BLOCK VALUE (FOR TITLE) ! 14849: {{MOV{DMPSA{R6{{RECOVER OFFSET ! 14850: {{JSR{PRTNL{{{END PRINT LINE ! 14851: {{BEQ{(R9){#B$TBT{DMP22{JUMP IF TABLE ! 14852: {{DCA{R6{{{POINT BEFORE FIRST WORD ! 14853: * ! 14854: * LOOP TO PRINT CONTENTS OF ARRAY, VECTOR, OR PROGRAM DEF ! 14855: * ! 14856: {DMP20{MOV{R10{R9{{COPY BLOCK POINTER ! 14857: {{ICA{R6{{{BUMP OFFSET ! 14858: {{ADD{R6{R9{{POINT TO NEXT VALUE ! 14859: {{BEQ{R6{DMPSV{DMP14{EXIT IF END (XR PAST BLOCK) ! 14860: {{SUB{#4*VRVAL{R9{{SUBTRACT OFFSET TO MERGE INTO LOOP ! 14861: * ! 14862: * LOOP TO FIND VALUE AND IGNORE NULLS ! 14863: * ! 14864: {DMP21{MOV{4*VRVAL(R9){R9{{LOAD NEXT VALUE ! 14865: {{BEQ{R9{#NULLS{DMP20{LOOP BACK IF NULL VALUE ! 14866: {{BEQ{(R9){#B$TRT{DMP21{LOOP BACK IF TRAPPED ! 14867: {{JSR{PRTNV{{{ELSE PRINT NAME = VALUE ! 14868: {{BRN{DMP20{{{LOOP BACK FOR NEXT FIELD ! 14869: {{EJC{{{{ ! 14870: * ! 14871: * DUMPR (CONTINUED) ! 14872: * ! 14873: * HERE TO DUMP A TABLE ! 14874: * ! 14875: {DMP22{MOV{#4*TBBUK{R8{{SET OFFSET TO FIRST BUCKET ! 14876: {{MOV{#4*TEVAL{R6{{SET NAME OFFSET FOR ALL TEBLKS ! 14877: * ! 14878: * LOOP THROUGH TABLE BUCKETS ! 14879: * ! 14880: {DMP23{MOV{R10{-(SP){{SAVE TBBLK POINTER ! 14881: {{ADD{R8{R10{{POINT TO NEXT BUCKET HEADER ! 14882: {{ICA{R8{{{BUMP BUCKET OFFSET ! 14883: {{SUB{#4*TENXT{R10{{SUBTRACT OFFSET TO MERGE INTO LOOP ! 14884: * ! 14885: * LOOP TO PROCESS TEBLKS ON ONE CHAIN ! 14886: * ! 14887: {DMP24{MOV{4*TENXT(R10){R10{{POINT TO NEXT TEBLK ! 14888: {{BEQ{R10{(SP){DMP26{JUMP IF END OF CHAIN ! 14889: {{MOV{R10{R9{{ELSE COPY TEBLK POINTER ! 14890: * ! 14891: * LOOP TO FIND VALUE AND IGNORE IF NULL ! 14892: * ! 14893: {DMP25{MOV{4*TEVAL(R9){R9{{LOAD NEXT VALUE ! 14894: {{BEQ{R9{#NULLS{DMP24{IGNORE IF NULL VALUE ! 14895: {{BEQ{(R9){#B$TRT{DMP25{LOOP BACK IF TRAPPED ! 14896: {{MOV{R8{DMPSV{{ELSE SAVE OFFSET POINTER ! 14897: {{JSR{PRTNV{{{PRINT NAME = VALUE ! 14898: {{MOV{DMPSV{R8{{RELOAD OFFSET ! 14899: {{BRN{DMP24{{{LOOP BACK FOR NEXT TEBLK ! 14900: * ! 14901: * HERE TO MOVE TO NEXT HASH CHAIN ! 14902: * ! 14903: {DMP26{MOV{(SP)+{R10{{RESTORE TBBLK POINTER ! 14904: {{BNE{R8{4*TBLEN(R10){DMP23{LOOP BACK IF MORE BUCKETS TO GO ! 14905: {{MOV{R10{R9{{ELSE COPY TABLE POINTER ! 14906: {{ADD{R8{R9{{POINT TO FOLLOWING BLOCK ! 14907: {{BRN{DMP14{{{LOOP BACK TO PROCESS NEXT BLOCK ! 14908: * ! 14909: * HERE AFTER COMPLETING DUMP ! 14910: * ! 14911: {DMP27{JSR{PRTPG{{{EJECT PRINTER ! 14912: * ! 14913: * MERGE HERE IF NO DUMP GIVEN (DMARG=0) ! 14914: * ! 14915: {DMP28{EXI{{{{RETURN TO DUMP CALLER ! 14916: * ! 14917: * CALL SYSTEM CORE DUMP ROUTINE ! 14918: * ! 14919: {DMP29{JSR{SYSDM{{{CALL IT ! 14920: {{BRN{DMP28{{{RETURN ! 14921: {{EJC{{{{ ! 14922: * ! 14923: * DUMPR (CONTINUED) ! 14924: * ! 14925: * HERE TO DUMP BUFFER BLOCK ! 14926: * ! 14927: {DMP30{JSR{PRTNL{{{PRINT BLANK LINE ! 14928: {{JSR{PRTVL{{{PRINT VALUE ID FOR TITLE ! 14929: {{JSR{PRTNL{{{FORCE NEW LINE ! 14930: {{MOV{#CH$DQ{R6{{LOAD DOUBLE QUOTE ! 14931: {{JSR{PRTCH{{{PRINT IT ! 14932: {{MOV{4*BCLEN(R9){R8{{LOAD DEFINED LENGTH ! 14933: {{BZE{R8{DMP32{{SKIP CHARACTERS IF NONE ! 14934: {{LCT{R8{R8{{LOAD COUNT FOR LOOP ! 14935: {{MOV{R9{R7{{SAVE BCBLK PTR ! 14936: {{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK ! 14937: {{PLC{R9{{{GET SET TO LOAD CHARACTERS ! 14938: * ! 14939: * LOOP HERE STUFFING CHARACTERS IN OUTPUT STREAM ! 14940: * ! 14941: {DMP31{LCH{R6{(R9)+{{GET NEXT CHARACTER ! 14942: {{JSR{PRTCH{{{STUFF IT ! 14943: {{BCT{R8{DMP31{{BRANCH FOR NEXT ONE ! 14944: {{MOV{R7{R9{{RESTORE BCBLK POINTER ! 14945: * ! 14946: * MERGE TO STUFF CLOSING QUOTE MARK ! 14947: * ! 14948: {DMP32{MOV{#CH$DQ{R6{{STUFF QUOTE ! 14949: {{JSR{PRTCH{{{PRINT IT ! 14950: {{JSR{PRTNL{{{PRINT NEW LINE ! 14951: {{MOV{(R9){R6{{GET FIRST WD FOR BLKLN ! 14952: {{BRN{DMP15{{{MERGE TO GET NEXT BLOCK ! 14953: {{ENP{{{{END PROCEDURE DUMPR ! 14954: {{EJC{{{{ ! 14955: * ! 14956: * ERMSG -- PRINT ERROR CODE AND ERROR MESSAGE ! 14957: * ! 14958: * KVERT ERROR CODE ! 14959: * JSR ERMSG CALL TO PRINT MESSAGE ! 14960: * (XR,XL,WA,WB,WC,IA) DESTROYED ! 14961: * ! 14962: {ERMSG{PRC{E{0{{ENTRY POINT ! 14963: {{JSR{PRTIS{{{PRINT ERROR PTR OR BLANK LINE ! 14964: {{MOV{KVERT{R6{{LOAD ERROR CODE ! 14965: {{MOV{#ERMMS{R9{{POINT TO ERROR MESSAGE /ERROR/ ! 14966: {{JSR{PRTST{{{PRINT IT ! 14967: {{JSR{ERTEX{{{GET ERROR MESSAGE TEXT ! 14968: {{ADD{#THSND{R6{{BUMP ERROR CODE FOR PRINT ! 14969: {{MTI{R6{{{FAIL CODE IN INT ACC ! 14970: {{JSR{PRTIN{{{PRINT CODE (NOW HAVE ERROR1XXX) ! 14971: {{MOV{PRBUF{R10{{POINT TO PRINT BUFFER ! 14972: {{PSC{R10{#NUM05{{POINT TO THE 1 ! 14973: {{MOV{#CH$BL{R6{{LOAD A BLANK ! 14974: {{SCH{R6{(R10){{STORE BLANK OVER 1 (ERROR XXX) ! 14975: {{CSC{R10{{{COMPLETE STORE CHARACTERS ! 14976: {{ZER{R10{{{CLEAR GARBAGE POINTER IN XL ! 14977: {{MOV{R9{R6{{KEEP ERROR TEXT ! 14978: {{MOV{#ERMNS{R9{{POINT TO / -- / ! 14979: {{JSR{PRTST{{{PRINT IT ! 14980: {{MOV{R6{R9{{GET ERROR TEXT AGAIN ! 14981: {{JSR{PRTST{{{PRINT ERROR MESSAGE TEXT ! 14982: {{JSR{PRTIS{{{PRINT LINE ! 14983: {{JSR{PRTIS{{{PRINT BLANK LINE ! 14984: {{EXI{{{{RETURN TO ERMSG CALLER ! 14985: {{ENP{{{{END PROCEDURE ERMSG ! 14986: {{EJC{{{{ ! 14987: * ! 14988: * ERTEX -- GET ERROR MESSAGE TEXT ! 14989: * ! 14990: * (WA) ERROR CODE ! 14991: * JSR ERTEX CALL TO GET ERROR TEXT ! 14992: * (XR) PTR TO ERROR TEXT IN DYNAMIC ! 14993: * (R$ETX) COPY OF PTR TO ERROR TEXT ! 14994: * (XL,WC,IA) DESTROYED ! 14995: * ! 14996: {ERTEX{PRC{E{0{{ENTRY POINT ! 14997: {{MOV{R6{ERTWA{{SAVE WA ! 14998: {{MOV{R7{ERTWB{{SAVE WB ! 14999: {{JSR{SYSEM{{{GET FAILURE MESSAGE TEXT ! 15000: {{MOV{R9{R10{{COPY POINTER TO IT ! 15001: {{MOV{4*SCLEN(R9){R6{{GET LENGTH OF STRING ! 15002: {{BZE{R6{ERT02{{JUMP IF NULL ! 15003: {{ZER{R7{{{OFFSET OF ZERO ! 15004: {{JSR{SBSTR{{{COPY INTO DYNAMIC STORE ! 15005: {{MOV{R9{R$ETX{{STORE FOR RELOCATION ! 15006: * ! 15007: * RETURN ! 15008: * ! 15009: {ERT01{MOV{ERTWB{R7{{RESTORE WB ! 15010: {{MOV{ERTWA{R6{{RESTORE WA ! 15011: {{EXI{{{{RETURN TO CALLER ! 15012: * ! 15013: * RETURN ERRTEXT CONTENTS INSTEAD OF NULL ! 15014: * ! 15015: {ERT02{MOV{R$ETX{R9{{GET ERRTEXT ! 15016: {{BRN{ERT01{{{RETURN ! 15017: {{ENP{{{{ ! 15018: {{EJC{{{{ ! 15019: * ! 15020: * EVALI -- EVALUATE INTEGER ARGUMENT ! 15021: * ! 15022: * EVALI IS USED BY PATTERN PRIMITIVES LEN,TAB,RTAB,POS,RPOS ! 15023: * WHEN THEIR ARGUMENT IS AN EXPRESSION VALUE. ! 15024: * ! 15025: * (XR) NODE POINTER ! 15026: * (WB) CURSOR ! 15027: * JSR EVALI CALL TO EVALUATE INTEGER ! 15028: * PPM LOC TRANSFER LOC FOR NON-INTEGER ARG ! 15029: * PPM LOC TRANSFER LOC FOR OUT OF RANGE ARG ! 15030: * PPM LOC TRANSFER LOC FOR EVALUATION FAILURE ! 15031: * PPM LOC TRANSFER LOC FOR SUCCESSFUL EVAL ! 15032: * (THE NORMAL RETURN IS NEVER TAKEN) ! 15033: * (XR) PTR TO NODE WITH INTEGER ARGUMENT ! 15034: * (WC,XL,RA) DESTROYED ! 15035: * ! 15036: * ON RETURN, THE NODE POINTED TO HAS THE INTEGER ARGUMENT ! 15037: * IN PARM1 AND THE PROPER SUCCESSOR POINTER IN PTHEN. ! 15038: * THIS ALLOWS MERGING WITH THE NORMAL (INTEGER ARG) CASE. ! 15039: * ! 15040: {EVALI{PRC{R{4{{ENTRY POINT (RECURSIVE) ! 15041: {{JSR{EVALP{{{EVALUATE EXPRESSION ! 15042: {{PPM{EVLI1{{{JUMP ON FAILURE ! 15043: {{MOV{R10{-(SP){{STACK RESULT FOR GTSMI ! 15044: {{MOV{4*PTHEN(R9){R10{{LOAD SUCCESSOR POINTER ! 15045: {{JSR{GTSMI{{{CONVERT ARG TO SMALL INTEGER ! 15046: {{PPM{EVLI2{{{JUMP IF NOT INTEGER ! 15047: {{PPM{EVLI3{{{JUMP IF OUT OF RANGE ! 15048: {{MOV{R9{EVLIV{{STORE RESULT IN SPECIAL DUMMY NODE ! 15049: {{MOV{R10{EVLIS{{STORE SUCCESSOR POINTER ! 15050: {{MOV{#EVLIN{R9{{POINT TO DUMMY NODE WITH RESULT ! 15051: {{EXI{4{{{TAKE SUCCESSFUL EXIT ! 15052: * ! 15053: * HERE IF EVALUATION FAILS ! 15054: * ! 15055: {EVLI1{EXI{3{{{TAKE FAILURE RETURN ! 15056: * ! 15057: * HERE IF ARGUMENT IS NOT INTEGER ! 15058: * ! 15059: {EVLI2{EXI{1{{{TAKE NON-INTEGER ERROR EXIT ! 15060: * ! 15061: * HERE IF ARGUMENT IS OUT OF RANGE ! 15062: * ! 15063: {EVLI3{EXI{2{{{TAKE OUT-OF-RANGE ERROR EXIT ! 15064: {{ENP{{{{END PROCEDURE EVALI ! 15065: {{EJC{{{{ ! 15066: * ! 15067: * EVALP -- EVALUATE EXPRESSION DURING PATTERN MATCH ! 15068: * ! 15069: * EVALP IS USED TO EVALUATE AN EXPRESSION (BY VALUE) DURING ! 15070: * A PATTERN MATCH. THE EFFECT IS LIKE EVALX, BUT PATTERN ! 15071: * VARIABLES ARE STACKED AND RESTORED IF NECESSARY. ! 15072: * ! 15073: * EVALP ALSO DIFFERS FROM EVALX IN THAT IF THE RESULT IS ! 15074: * AN EXPRESSION IT IS REEVALUATED. THIS OCCURS REPEATEDLY. ! 15075: * ! 15076: * (XR) NODE POINTER ! 15077: * (WB) PATTERN MATCH CURSOR ! 15078: * JSR EVALP CALL TO EVALUATE EXPRESSION ! 15079: * PPM LOC TRANSFER LOC IF EVALUATION FAILS ! 15080: * (XL) RESULT ! 15081: * (WA) FIRST WORD OF RESULT BLOCK ! 15082: * (XR,WB) DESTROYED (FAILURE CASE ONLY) ! 15083: * (WC,RA) DESTROYED ! 15084: * ! 15085: * THE EXPRESSION POINTER IS STORED IN PARM1 OF THE NODE ! 15086: * ! 15087: * CONTROL RETURNS TO FAILP ON FAILURE OF EVALUATION ! 15088: * ! 15089: {EVALP{PRC{R{1{{ENTRY POINT (RECURSIVE) ! 15090: {{MOV{4*PARM1(R9){R10{{LOAD EXPRESSION POINTER ! 15091: {{BEQ{(R10){#B$EXL{EVLP1{JUMP IF EXBLK CASE ! 15092: * ! 15093: * HERE FOR CASE OF SEBLK ! 15094: * ! 15095: * WE CAN GIVE A FAST RETURN IF THE VALUE OF THE VRBLK IS ! 15096: * NOT AN EXPRESSION AND IS NOT TRAPPED. ! 15097: * ! 15098: {{MOV{4*SEVAR(R10){R10{{LOAD VRBLK POINTER ! 15099: {{MOV{4*VRVAL(R10){R10{{LOAD VALUE OF VRBLK ! 15100: {{MOV{(R10){R6{{LOAD FIRST WORD OF VALUE ! 15101: {{BHI{R6{#B$T$${EVLP3{JUMP IF NOT SEBLK, TRBLK OR EXBLK ! 15102: * ! 15103: * HERE FOR EXBLK OR SEBLK WITH EXPR VALUE OR TRAPPED VALUE ! 15104: * ! 15105: {EVLP1{MOV{R9{-(SP){{STACK NODE POINTER ! 15106: {{MOV{R7{-(SP){{STACK CURSOR ! 15107: {{MOV{R$PMS{-(SP){{STACK SUBJECT STRING POINTER ! 15108: {{MOV{PMSSL{-(SP){{STACK SUBJECT STRING LENGTH ! 15109: {{MOV{PMDFL{-(SP){{STACK DOT FLAG ! 15110: {{MOV{PMHBS{-(SP){{STACK HISTORY STACK BASE POINTER ! 15111: {{MOV{4*PARM1(R9){R9{{LOAD EXPRESSION POINTER ! 15112: {{EJC{{{{ ! 15113: * ! 15114: * EVALP (CONTINUED) ! 15115: * ! 15116: * LOOP BACK HERE TO REEVALUATE EXPRESSION RESULT ! 15117: * ! 15118: {EVLP2{ZER{R7{{{SET FLAG FOR BY VALUE ! 15119: {{JSR{EVALX{{{EVALUATE EXPRESSION ! 15120: {{PPM{EVLP4{{{JUMP ON FAILURE ! 15121: {{MOV{(R9){R6{{ELSE LOAD FIRST WORD OF VALUE ! 15122: {{BLO{R6{#B$E$${EVLP2{LOOP BACK TO REEVALUATE EXPRESSION ! 15123: * ! 15124: * HERE TO RESTORE PATTERN VALUES AFTER SUCCESSFUL EVAL ! 15125: * ! 15126: {{MOV{R9{R10{{COPY RESULT POINTER ! 15127: {{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER ! 15128: {{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG ! 15129: {{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH ! 15130: {{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER ! 15131: {{MOV{(SP)+{R7{{RESTORE CURSOR ! 15132: {{MOV{(SP)+{R9{{RESTORE NODE POINTER ! 15133: * ! 15134: * COMMON EXIT POINT ! 15135: * ! 15136: {EVLP3{EXI{{{{RETURN TO EVALP CALLER ! 15137: * ! 15138: * HERE FOR FAILURE DURING EVALUATION ! 15139: * ! 15140: {EVLP4{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER ! 15141: {{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG ! 15142: {{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH ! 15143: {{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER ! 15144: {{ADD{#4*NUM02{SP{{REMOVE NODE PTR, CURSOR ! 15145: {{EXI{1{{{TAKE FAILURE EXIT ! 15146: {{ENP{{{{END PROCEDURE EVALP ! 15147: {{EJC{{{{ ! 15148: * ! 15149: * EVALS -- EVALUATE STRING ARGUMENT ! 15150: * ! 15151: * EVALS IS USED BY SPAN, ANY, NOTANY, BREAK, BREAKX WHEN ! 15152: * THEY ARE PASSED AN EXPRESSION ARGUMENT. ! 15153: * ! 15154: * (XR) NODE POINTER ! 15155: * (WB) CURSOR ! 15156: * JSR EVALS CALL TO EVALUATE STRING ! 15157: * PPM LOC TRANSFER LOC FOR NON-STRING ARG ! 15158: * PPM LOC TRANSFER LOC FOR EVALUATION FAILURE ! 15159: * PPM LOC TRANSFER LOC FOR SUCCESSFUL EVAL ! 15160: * (THE NORMAL RETURN IS NEVER TAKEN) ! 15161: * (XR) PTR TO NODE WITH PARMS SET ! 15162: * (XL,WC,RA) DESTROYED ! 15163: * ! 15164: * ON RETURN, THE NODE POINTED TO HAS A CHARACTER TABLE ! 15165: * POINTER IN PARM1 AND A BIT MASK IN PARM2. THE PROPER ! 15166: * SUCCESSOR IS STORED IN PTHEN OF THIS NODE. THUS IT IS ! 15167: * OK FOR MERGING WITH THE NORMAL (MULTI-CHAR STRING) CASE. ! 15168: * ! 15169: {EVALS{PRC{R{3{{ENTRY POINT (RECURSIVE) ! 15170: {{JSR{EVALP{{{EVALUATE EXPRESSION ! 15171: {{PPM{EVLS1{{{JUMP IF EVALUATION FAILS ! 15172: {{MOV{4*PTHEN(R9){-(SP){{SAVE SUCCESSOR POINTER ! 15173: {{MOV{R7{-(SP){{SAVE CURSOR ! 15174: {{MOV{R10{-(SP){{STACK RESULT PTR FOR PATST ! 15175: {{ZER{R7{{{DUMMY PCODE FOR ONE CHAR STRING ! 15176: {{ZER{R8{{{DUMMY PCODE FOR EXPRESSION ARG ! 15177: {{MOV{#P$BRK{R10{{APPROPRIATE PCODE FOR OUR USE ! 15178: {{JSR{PATST{{{CALL ROUTINE TO BUILD NODE ! 15179: {{PPM{EVLS2{{{JUMP IF NOT STRING ! 15180: {{MOV{(SP)+{R7{{RESTORE CURSOR ! 15181: {{MOV{(SP)+{4*PTHEN(R9){{STORE SUCCESSOR POINTER ! 15182: {{EXI{3{{{TAKE SUCCESS RETURN ! 15183: * ! 15184: * HERE IF EVALUATION FAILS ! 15185: * ! 15186: {EVLS1{EXI{2{{{TAKE FAILURE RETURN ! 15187: * ! 15188: * HERE IF ARGUMENT IS NOT STRING ! 15189: * ! 15190: {EVLS2{ADD{#4*NUM02{SP{{POP SUCCESSOR AND CURSOR ! 15191: {{EXI{1{{{TAKE NON-STRING ERROR EXIT ! 15192: {{ENP{{{{END PROCEDURE EVALS ! 15193: {{EJC{{{{ ! 15194: * ! 15195: * EVALX -- EVALUATE EXPRESSION ! 15196: * ! 15197: * EVALX IS CALLED TO EVALUATE AN EXPRESSION ! 15198: * ! 15199: * (XR) POINTER TO EXBLK OR SEBLK ! 15200: * (WB) 0 IF BY VALUE, 1 IF BY NAME ! 15201: * JSR EVALX CALL TO EVALUATE EXPRESSION ! 15202: * PPM LOC TRANSFER LOC IF EVALUATION FAILS ! 15203: * (XR) RESULT IF CALLED BY VALUE ! 15204: * (XL,WA) RESULT NAME BASE,OFFSET IF BY NAME ! 15205: * (XR) DESTROYED (NAME CASE ONLY) ! 15206: * (XL,WA) DESTROYED (VALUE CASE ONLY) ! 15207: * (WB,WC,RA) DESTROYED ! 15208: * ! 15209: {EVALX{PRC{R{1{{ENTRY POINT, RECURSIVE ! 15210: {{BEQ{(R9){#B$EXL{EVLX2{JUMP IF EXBLK CASE ! 15211: * ! 15212: * HERE FOR SEBLK ! 15213: * ! 15214: {{MOV{4*SEVAR(R9){R10{{LOAD VRBLK POINTER (NAME BASE) ! 15215: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET ! 15216: {{BNZ{R7{EVLX1{{JUMP IF CALLED BY NAME ! 15217: {{JSR{ACESS{{{CALL ROUTINE TO ACCESS VALUE ! 15218: {{PPM{EVLX9{{{JUMP IF FAILURE ON ACCESS ! 15219: * ! 15220: * MERGE HERE TO EXIT FOR SEBLK CASE ! 15221: * ! 15222: {EVLX1{EXI{{{{RETURN TO EVALX CALLER ! 15223: {{EJC{{{{ ! 15224: * ! 15225: * EVALX (CONTINUED) ! 15226: * ! 15227: * HERE FOR FULL EXPRESSION (EXBLK) CASE ! 15228: * ! 15229: * IF AN ERROR OCCURS IN THE EXPRESSION CODE AT EXECUTION ! 15230: * TIME, CONTROL IS PASSED VIA ERROR SECTION TO EXFAL ! 15231: * WITHOUT RETURNING TO THIS ROUTINE. ! 15232: * THE FOLLOWING ENTRIES ARE MADE ON THE STACK BEFORE ! 15233: * GIVING CONTROL TO THE EXPRESSION CODE ! 15234: * ! 15235: * EVALX RETURN POINT ! 15236: * SAVED VALUE OF R$COD ! 15237: * CODE POINTER (-R$COD) ! 15238: * SAVED VALUE OF FLPTR ! 15239: * 0 IF BY VALUE, 1 IF BY NAME ! 15240: * FLPTR --------------- *EXFLC, FAIL OFFSET IN EXBLK ! 15241: * ! 15242: {EVLX2{SCP{R8{{{GET CODE POINTER ! 15243: {{MOV{R$COD{R6{{LOAD CODE BLOCK POINTER ! 15244: {{SUB{R6{R8{{GET CODE POINTER AS OFFSET ! 15245: {{MOV{R6{-(SP){{STACK OLD CODE BLOCK POINTER ! 15246: {{MOV{R8{-(SP){{STACK RELATIVE CODE OFFSET ! 15247: {{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER ! 15248: {{MOV{R7{-(SP){{STACK NAME/VALUE INDICATOR ! 15249: {{MOV{#4*EXFLC{-(SP){{STACK NEW FAIL OFFSET ! 15250: {{MOV{FLPTR{GTCEF{{KEEP IN CASE OF ERROR ! 15251: {{MOV{R$COD{R$GTC{{KEEP CODE BLOCK POINTER SIMILARLY ! 15252: {{MOV{SP{FLPTR{{SET NEW FAILURE POINTER ! 15253: {{MOV{R9{R$COD{{SET NEW CODE BLOCK POINTER ! 15254: {{MOV{KVSTN{4*EXSTM(R9){{REMEMBER STMNT NUMBER ! 15255: {{ADD{#4*EXCOD{R9{{POINT TO FIRST CODE WORD ! 15256: {{LCP{R9{{{SET CODE POINTER ! 15257: {{BNE{STAGE{#STGXT{EXITS{JUMP IF NOT EXECUTION TIME ! 15258: {{MOV{#STGEE{STAGE{{EVALUATING EXPRESSION ! 15259: {{BRN{EXITS{{{JUMP TO EXECUTE FIRST CODE WORD ! 15260: {{EJC{{{{ ! 15261: * ! 15262: * EVALX (CONTINUED) ! 15263: * ! 15264: * COME HERE IF SUCCESSFUL RETURN BY VALUE (SEE O$RVL) ! 15265: * ! 15266: {EVLX3{MOV{(SP)+{R9{{LOAD VALUE ! 15267: {{BZE{4*1(SP){EVLX5{{JUMP IF CALLED BY VALUE ! 15268: {{ERB{249{EXPRESSION{{EVALUATED BY NAME RETURNED VALUE ! 15269: * ! 15270: * HERE FOR EXPRESSION RETURNING BY NAME (SEE O$RNM) ! 15271: * ! 15272: {EVLX4{MOV{(SP)+{R6{{LOAD NAME OFFSET ! 15273: {{MOV{(SP)+{R10{{LOAD NAME BASE ! 15274: {{BNZ{4*1(SP){EVLX5{{JUMP IF CALLED BY NAME ! 15275: {{JSR{ACESS{{{ELSE ACCESS VALUE FIRST ! 15276: {{PPM{EVLX6{{{JUMP IF FAILURE DURING ACCESS ! 15277: * ! 15278: * HERE AFTER LOADING CORRECT RESULT INTO XR OR XL,WA ! 15279: * ! 15280: {EVLX5{ZER{R7{{{NOTE SUCCESSFUL ! 15281: {{BRN{EVLX7{{{MERGE ! 15282: * ! 15283: * HERE FOR FAILURE IN EXPRESSION EVALUATION (SEE O$FEX) ! 15284: * ! 15285: {EVLX6{MNZ{R7{{{NOTE UNSUCCESSFUL ! 15286: * ! 15287: * RESTORE ENVIRONMENT ! 15288: * ! 15289: {EVLX7{BNE{STAGE{#STGEE{EVLX8{SKIP IF WAS NOT PREVIOUSLY XT ! 15290: {{MOV{#STGXT{STAGE{{EXECUTE TIME ! 15291: * ! 15292: * MERGE WITH STAGE SET UP ! 15293: * ! 15294: {EVLX8{ADD{#4*NUM02{SP{{POP NAME/VALUE INDICATOR, *EXFAL ! 15295: {{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER ! 15296: {{MOV{(SP)+{R8{{LOAD CODE OFFSET ! 15297: {{ADD{(SP){R8{{MAKE CODE POINTER ABSOLUTE ! 15298: {{MOV{(SP)+{R$COD{{RESTORE OLD CODE BLOCK POINTER ! 15299: {{LCP{R8{{{RESTORE OLD CODE POINTER ! 15300: {{BZE{R7{EVLX1{{JUMP FOR SUCCESSFUL RETURN ! 15301: * ! 15302: * MERGE HERE FOR FAILURE IN SEBLK CASE ! 15303: * ! 15304: {EVLX9{EXI{1{{{TAKE FAILURE EXIT ! 15305: {{ENP{{{{END OF PROCEDURE EVALX ! 15306: {{EJC{{{{ ! 15307: * ! 15308: * EXBLD -- BUILD EXBLK ! 15309: * ! 15310: * EXBLD IS USED TO BUILD AN EXPRESSION BLOCK FROM THE ! 15311: * CODE COMPILED MOST RECENTLY IN THE CURRENT CCBLK. ! 15312: * ! 15313: * (XL) OFFSET IN CCBLK TO START OF CODE ! 15314: * (WB) INTEGER IN RANGE 0 LE N LE MXLEN ! 15315: * JSR EXBLD CALL TO BUILD EXBLK ! 15316: * (XR) PTR TO CONSTRUCTED EXBLK ! 15317: * (WA,WB,XL) DESTROYED ! 15318: * ! 15319: {EXBLD{PRC{E{0{{ENTRY POINT ! 15320: {{MOV{R10{R6{{COPY OFFSET TO START OF CODE ! 15321: {{SUB{#4*EXCOD{R6{{CALC REDUCTION IN OFFSET IN EXBLK ! 15322: {{MOV{R6{-(SP){{STACK FOR LATER ! 15323: {{MOV{CWCOF{R6{{LOAD FINAL OFFSET ! 15324: {{SUB{R10{R6{{COMPUTE LENGTH OF CODE ! 15325: {{ADD{#4*EXSI${R6{{ADD SPACE FOR STANDARD FIELDS ! 15326: {{JSR{ALLOC{{{ALLOCATE SPACE FOR EXBLK ! 15327: {{MOV{R9{-(SP){{SAVE POINTER TO EXBLK ! 15328: {{MOV{#B$EXL{4*EXTYP(R9){{STORE TYPE WORD ! 15329: {{ZER{4*EXSTM(R9){{{ZEROISE STMNT NUMBER FIELD ! 15330: {{MOV{R6{4*EXLEN(R9){{STORE LENGTH ! 15331: {{MOV{#OFEX${4*EXFLC(R9){{STORE FAILURE WORD ! 15332: {{ADD{#4*EXSI${R9{{SET XR FOR SYSMW ! 15333: {{MOV{R10{CWCOF{{RESET OFFSET TO START OF CODE ! 15334: {{ADD{R$CCB{R10{{POINT TO START OF CODE ! 15335: {{SUB{#4*EXSI${R6{{LENGTH OF CODE TO MOVE ! 15336: {{MOV{R6{-(SP){{STACK LENGTH OF CODE ! 15337: {{MVW{{{{MOVE CODE TO EXBLK ! 15338: {{MOV{(SP)+{R6{{GET LENGTH OF CODE ! 15339: {{BTW{R6{{{CONVERT BYTE COUNT TO WORD COUNT ! 15340: {{LCT{R6{R6{{PREPARE COUNTER FOR LOOP ! 15341: {{MOV{(SP){R10{{COPY EXBLK PTR, DONT UNSTACK ! 15342: {{ADD{#4*EXCOD{R10{{POINT TO CODE ITSELF ! 15343: {{MOV{4*1(SP){R7{{GET REDUCTION IN OFFSET ! 15344: * ! 15345: * THIS LOOP SEARCHES FOR NEGATION AND SELECTION CODE SO ! 15346: * THAT THE OFFSETS COMPUTED WHILST CODE WAS IN CODE BLOCK ! 15347: * CAN BE TRANSFORMED TO REDUCED VALUES APPLICABLE IN AN ! 15348: * EXBLK. ! 15349: * ! 15350: {EXBL1{MOV{(R10)+{R9{{GET NEXT CODE WORD ! 15351: {{BEQ{R9{#OSLA${EXBL3{JUMP IF SELECTION FOUND ! 15352: {{BEQ{R9{#ONTA${EXBL3{JUMP IF NEGATION FOUND ! 15353: {{BCT{R6{EXBL1{{LOOP TO END OF CODE ! 15354: * ! 15355: * NO SELECTION FOUND OR MERGE TO EXIT ON TERMINATION ! 15356: * ! 15357: {EXBL2{MOV{(SP)+{R9{{POP EXBLK PTR INTO XR ! 15358: {{MOV{(SP)+{R10{{POP REDUCTION CONSTANT ! 15359: {{EXI{{{{RETURN TO CALLER ! 15360: {{EJC{{{{ ! 15361: * ! 15362: * EXBLD (CONTINUED) ! 15363: * ! 15364: * SELECTION OR NEGATION FOUND ! 15365: * REDUCE THE OFFSETS AS NEEDED. OFFSETS OCCUR IN WORDS ! 15366: * FOLLOWING CODE WORDS - ! 15367: * =ONTA$, =OSLA$, =OSLB$, =OSLC$ ! 15368: * ! 15369: {EXBL3{SUB{R7{(R10)+{{ADJUST OFFSET ! 15370: {{BCT{R6{EXBL4{{DECREMENT COUNT ! 15371: * ! 15372: {EXBL4{BCT{R6{EXBL5{{DECREMENT COUNT ! 15373: * ! 15374: * CONTINUE SEARCH FOR MORE OFFSETS ! 15375: * ! 15376: {EXBL5{MOV{(R10)+{R9{{GET NEXT CODE WORD ! 15377: {{BEQ{R9{#OSLA${EXBL3{JUMP IF OFFSET FOUND ! 15378: {{BEQ{R9{#OSLB${EXBL3{JUMP IF OFFSET FOUND ! 15379: {{BEQ{R9{#OSLC${EXBL3{JUMP IF OFFSET FOUND ! 15380: {{BEQ{R9{#ONTA${EXBL3{JUMP IF OFFSET FOUND ! 15381: {{BCT{R6{EXBL5{{LOOP ! 15382: {{BRN{EXBL2{{{MERGE TO RETURN ! 15383: {{ENP{{{{END PROCEDURE EXBLD ! 15384: {{EJC{{{{ ! 15385: * ! 15386: * EXPAN -- ANALYZE EXPRESSION ! 15387: * ! 15388: * THE EXPRESSION ANALYZER (EXPAN) PROCEDURE IS USED TO SCAN ! 15389: * AN EXPRESSION AND CONVERT IT INTO A TREE REPRESENTATION. ! 15390: * SEE DESCRIPTIONS OF CMBLK, CUBLK, CBBLK IN THE STRUCTURES ! 15391: * SECTION FOR DETAILED FORMAT OF TREE BLOCKS. ! 15392: * ! 15393: * THE ANALYZER USES A SIMPLE PRECEDENCE SCHEME IN WHICH ! 15394: * OPERANDS AND OPERATORS ARE PLACED ON A SINGLE STACK ! 15395: * AND CONDENSATIONS ARE MADE WHEN LOW PRECEDENCE OPERATORS ! 15396: * ARE STACKED AFTER A HIGHER PRECEDENCE OPERATOR. A GLOBAL ! 15397: * VARIABLE (IN WB) KEEPS TRACK OF THE LEVEL AS FOLLOWS. ! 15398: * ! 15399: * 0 SCANNING OUTER LEVEL OF STATEMENT OR EXPRESSION ! 15400: * 1 SCANNING OUTER LEVEL OF NORMAL GOTO ! 15401: * 2 SCANNING OUTER LEVEL OF DIRECT GOTO ! 15402: * 3 SCANNING INSIDE ARRAY BRACKETS ! 15403: * 4 SCANNING INSIDE GROUPING PARENTHESES ! 15404: * 5 SCANNING INSIDE FUNCTION PARENTHESES ! 15405: * ! 15406: * THIS VARIABLE IS SAVED ON THE STACK ON ENCOUNTERING A ! 15407: * GROUPING AND RESTORED AT THE END OF THE GROUPING. ! 15408: * ! 15409: * ANOTHER GLOBAL VARIABLE (IN WC) COUNTS THE NUMBER OF ! 15410: * ITEMS AT ONE GROUPING LEVEL AND IS INCREMENTED FOR EACH ! 15411: * COMMA ENCOUNTERED. IT IS STACKED WITH THE LEVEL INDICATOR ! 15412: * ! 15413: * THE SCAN IS CONTROLLED BY A THREE STATE FINITE MACHINE. ! 15414: * A GLOBAL VARIABLE STORED IN WA IS THE CURRENT STATE. ! 15415: * ! 15416: * WA=0 NOTHING SCANNED AT THIS LEVEL ! 15417: * WA=1 OPERAND EXPECTED ! 15418: * WA=2 OPERATOR EXPECTED ! 15419: * ! 15420: * (WB) CALL TYPE (SEE BELOW) ! 15421: * JSR EXPAN CALL TO ANALYZE EXPRESSION ! 15422: * (XR) POINTER TO RESULTING TREE ! 15423: * (XL,WA,WB,WC,RA) DESTROYED ! 15424: * ! 15425: * THE ENTRY VALUE OF WB INDICATES THE CALL TYPE AS FOLLOWS. ! 15426: * ! 15427: * 0 SCANNING EITHER THE MAIN BODY OF A STATEMENT OR THE ! 15428: * TEXT OF AN EXPRESSION (FROM EVAL CALL). VALID ! 15429: * TERMINATORS ARE COLON, SEMICOLON. THE RESCAN FLAG IS ! 15430: * SET TO RETURN THE TERMINATOR ON THE NEXT SCANE CALL. ! 15431: * ! 15432: * 1 SCANNING A NORMAL GOTO. THE ONLY VALID ! 15433: * TERMINATOR IS A RIGHT PAREN. ! 15434: * ! 15435: * 2 SCANNING A DIRECT GOTO. THE ONLY VALID ! 15436: * TERMINATOR IS A RIGHT BRACKET. ! 15437: {{EJC{{{{ ! 15438: * ! 15439: * EXPAN (CONTINUED) ! 15440: * ! 15441: * ENTRY POINT ! 15442: * ! 15443: {EXPAN{PRC{E{0{{ENTRY POINT ! 15444: {{ZER{-(SP){{{SET TOP OF STACK INDICATOR ! 15445: {{ZER{R6{{{SET INITIAL STATE TO ZERO ! 15446: {{ZER{R8{{{ZERO COUNTER VALUE ! 15447: * ! 15448: * LOOP HERE FOR SUCCESSIVE ENTRIES ! 15449: * ! 15450: {EXP01{JSR{SCANE{{{SCAN NEXT ELEMENT ! 15451: {{ADD{R6{R10{{ADD STATE TO SYNTAX CODE ! 15452: {{BSW{R10{T$NES{{SWITCH ON ELEMENT TYPE/STATE ! 15453: {{IFF{T$UO0{EXP27{{UNOP, S=0 ! 15454: {{IFF{T$UO1{EXP27{{UNOP, S=1 ! 15455: {{IFF{T$UO2{EXP04{{UNOP, S=2 ! 15456: {{IFF{T$LP0{EXP06{{LEFT PAREN, S=0 ! 15457: {{IFF{T$LP1{EXP06{{LEFT PAREN, S=1 ! 15458: {{IFF{T$LP2{EXP04{{LEFT PAREN, S=2 ! 15459: {{IFF{T$LB0{EXP08{{LEFT BRKT, S=0 ! 15460: {{IFF{T$LB1{EXP08{{LEFT BRKT, S=1 ! 15461: {{IFF{T$LB2{EXP09{{LEFT BRKT, S=2 ! 15462: {{IFF{T$CM0{EXP02{{COMMA, S=0 ! 15463: {{IFF{T$CM1{EXP05{{COMMA, S=1 ! 15464: {{IFF{T$CM2{EXP11{{COMMA, S=2 ! 15465: {{IFF{T$FN0{EXP10{{FUNCTION, S=0 ! 15466: {{IFF{T$FN1{EXP10{{FUNCTION, S=1 ! 15467: {{IFF{T$FN2{EXP04{{FUNCTION, S=2 ! 15468: {{IFF{T$VA0{EXP03{{VARIABLE, S=0 ! 15469: {{IFF{T$VA1{EXP03{{VARIABLE, STATE ONE ! 15470: {{IFF{T$VA2{EXP04{{VARIABLE, S=2 ! 15471: {{IFF{T$CO0{EXP03{{CONSTANT, S=0 ! 15472: {{IFF{T$CO1{EXP03{{CONSTANT, S=1 ! 15473: {{IFF{T$CO2{EXP04{{CONSTANT, S=2 ! 15474: {{IFF{T$BO0{EXP05{{BINOP, S=0 ! 15475: {{IFF{T$BO1{EXP05{{BINOP, S=1 ! 15476: {{IFF{T$BO2{EXP26{{BINOP, S=2 ! 15477: {{IFF{T$RP0{EXP02{{RIGHT PAREN, S=0 ! 15478: {{IFF{T$RP1{EXP05{{RIGHT PAREN, S=1 ! 15479: {{IFF{T$RP2{EXP12{{RIGHT PAREN, S=2 ! 15480: {{IFF{T$RB0{EXP02{{RIGHT BRKT, S=0 ! 15481: {{IFF{T$RB1{EXP05{{RIGHT BRKT, S=1 ! 15482: {{IFF{T$RB2{EXP18{{RIGHT BRKT, S=2 ! 15483: {{IFF{T$CL0{EXP02{{COLON, S=0 ! 15484: {{IFF{T$CL1{EXP05{{COLON, S=1 ! 15485: {{IFF{T$CL2{EXP19{{COLON, S=2 ! 15486: {{IFF{T$SM0{EXP02{{SEMICOLON, S=0 ! 15487: {{IFF{T$SM1{EXP05{{SEMICOLON, S=1 ! 15488: {{IFF{T$SM2{EXP19{{SEMICOLON, S=2 ! 15489: {{ESW{{{{END SWITCH ON ELEMENT TYPE/STATE ! 15490: {{EJC{{{{ ! 15491: * ! 15492: * EXPAN (CONTINUED) ! 15493: * ! 15494: * HERE FOR RBR,RPR,COL,SMC,CMA IN STATE 0 ! 15495: * ! 15496: * SET TO RESCAN THE TERMINATOR ENCOUNTERED AND CREATE ! 15497: * A NULL CONSTANT (CASE OF OMITTED NULL) ! 15498: * ! 15499: {EXP02{MNZ{SCNRS{{{SET TO RESCAN ELEMENT ! 15500: {{MOV{#NULLS{R9{{POINT TO NULL, MERGE ! 15501: * ! 15502: * HERE FOR VAR OR CON IN STATES 0,1 ! 15503: * ! 15504: * STACK THE VARIABLE/CONSTANT AND SET STATE=2 ! 15505: * ! 15506: {EXP03{MOV{R9{-(SP){{STACK POINTER TO OPERAND ! 15507: {{MOV{#NUM02{R6{{SET STATE 2 ! 15508: {{BRN{EXP01{{{JUMP FOR NEXT ELEMENT ! 15509: * ! 15510: * HERE FOR VAR,CON,LPR,FNC,UOP IN STATE 2 ! 15511: * ! 15512: * WE RESCAN THE ELEMENT AND CREATE A CONCATENATION OPERATOR ! 15513: * THIS IS THE CASE OF THE BLANK CONCATENATION OPERATOR. ! 15514: * ! 15515: {EXP04{MNZ{SCNRS{{{SET TO RESCAN ELEMENT ! 15516: {{MOV{#OPDVC{R9{{POINT TO CONCAT OPERATOR DV ! 15517: {{BZE{R7{EXP4A{{OK IF AT TOP LEVEL ! 15518: {{MOV{#OPDVP{R9{{ELSE POINT TO UNMISTAKABLE CONCAT. ! 15519: * ! 15520: * MERGE HERE WHEN XR SET UP WITH PROPER CONCATENATION DVBLK ! 15521: * ! 15522: {EXP4A{BNZ{SCNBL{EXP26{{MERGE BOP IF BLANKS, ELSE ERROR ! 15523: {{DCV{SCNSE{{{ADJUST START OF ELEMENT LOCATION ! 15524: {{ERB{220{SYNTAX{{ERROR. MISSING OPERATOR ! 15525: * ! 15526: * HERE FOR CMA,RPR,RBR,COL,SMC,BOP(S=1) BOP(S=0) ! 15527: * ! 15528: * THIS IS AN ERRONOUS CONTRUCTION ! 15529: * ! 15530: {EXP05{DCV{SCNSE{{{ADJUST START OF ELEMENT LOCATION ! 15531: {{ERB{221{SYNTAX{{ERROR. MISSING OPERAND ! 15532: * ! 15533: * HERE FOR LPR (S=0,1) ! 15534: * ! 15535: {EXP06{MOV{#NUM04{R10{{SET NEW LEVEL INDICATOR ! 15536: {{ZER{R9{{{SET ZERO VALUE FOR CMOPN ! 15537: {{EJC{{{{ ! 15538: * ! 15539: * EXPAN (CONTINUED) ! 15540: * ! 15541: * MERGE HERE TO STORE OLD LEVEL ON STACK AND START NEW ONE ! 15542: * ! 15543: {EXP07{MOV{R9{-(SP){{STACK CMOPN VALUE ! 15544: {{MOV{R8{-(SP){{STACK OLD COUNTER ! 15545: {{MOV{R7{-(SP){{STACK OLD LEVEL INDICATOR ! 15546: {{CHK{{{{CHECK FOR STACK OVERFLOW ! 15547: {{ZER{R6{{{SET NEW STATE TO ZERO ! 15548: {{MOV{R10{R7{{SET NEW LEVEL INDICATOR ! 15549: {{MOV{#NUM01{R8{{INITIALIZE NEW COUNTER ! 15550: {{BRN{EXP01{{{JUMP TO SCAN NEXT ELEMENT ! 15551: * ! 15552: * HERE FOR LBR (S=0,1) ! 15553: * ! 15554: * THIS IS AN ILLEGAL USE OF LEFT BRACKET ! 15555: * ! 15556: {EXP08{ERB{222{SYNTAX{{ERROR. INVALID USE OF LEFT BRACKET ! 15557: * ! 15558: * HERE FOR LBR (S=2) ! 15559: * ! 15560: * SET NEW LEVEL AND START TO SCAN SUBSCRIPTS ! 15561: * ! 15562: {EXP09{MOV{(SP)+{R9{{LOAD ARRAY PTR FOR CMOPN ! 15563: {{MOV{#NUM03{R10{{SET NEW LEVEL INDICATOR ! 15564: {{BRN{EXP07{{{JUMP TO STACK OLD AND START NEW ! 15565: * ! 15566: * HERE FOR FNC (S=0,1) ! 15567: * ! 15568: * STACK OLD LEVEL AND START TO SCAN ARGUMENTS ! 15569: * ! 15570: {EXP10{MOV{#NUM05{R10{{SET NEW LEV INDIC (XR=VRBLK=CMOPN) ! 15571: {{BRN{EXP07{{{JUMP TO STACK OLD AND START NEW ! 15572: * ! 15573: * HERE FOR CMA (S=2) ! 15574: * ! 15575: * INCREMENT ARGUMENT COUNT AND CONTINUE ! 15576: * ! 15577: {EXP11{ICV{R8{{{INCREMENT COUNTER ! 15578: {{JSR{EXPDM{{{DUMP OPERATORS AT THIS LEVEL ! 15579: {{ZER{-(SP){{{SET NEW LEVEL FOR PARAMETER ! 15580: {{ZER{R6{{{SET NEW STATE ! 15581: {{BGT{R7{#NUM02{EXP01{LOOP BACK UNLESS OUTER LEVEL ! 15582: {{ERB{223{SYNTAX{{ERROR. INVALID USE OF COMMA ! 15583: {{EJC{{{{ ! 15584: * ! 15585: * EXPAN (CONTINUED) ! 15586: * ! 15587: * HERE FOR RPR (S=2) ! 15588: * ! 15589: * AT OUTER LEVEL IN A NORMAL GOTO THIS IS A TERMINATOR ! 15590: * OTHERWISE IT MUST TERMINATE A FUNCTION OR GROUPING ! 15591: * ! 15592: {EXP12{BEQ{R7{#NUM01{EXP20{END OF NORMAL GOTO ! 15593: {{BEQ{R7{#NUM05{EXP13{END OF FUNCTION ARGUMENTS ! 15594: {{BEQ{R7{#NUM04{EXP14{END OF GROUPING / SELECTION ! 15595: {{ERB{224{SYNTAX{{ERROR. UNBALANCED RIGHT PARENTHESIS ! 15596: * ! 15597: * HERE AT END OF FUNCTION ARGUMENTS ! 15598: * ! 15599: {EXP13{MOV{#C$FNC{R10{{SET CMTYP VALUE FOR FUNCTION ! 15600: {{BRN{EXP15{{{JUMP TO BUILD CMBLK ! 15601: * ! 15602: * HERE FOR END OF GROUPING ! 15603: * ! 15604: {EXP14{BEQ{R8{#NUM01{EXP17{JUMP IF END OF GROUPING ! 15605: {{MOV{#C$SEL{R10{{ELSE SET CMTYP FOR SELECTION ! 15606: * ! 15607: * MERGE HERE TO BUILD CMBLK FOR LEVEL JUST SCANNED AND ! 15608: * TO POP UP TO THE PREVIOUS SCAN LEVEL BEFORE CONTINUING. ! 15609: * ! 15610: {EXP15{JSR{EXPDM{{{DUMP OPERATORS AT THIS LEVEL ! 15611: {{MOV{R8{R6{{COPY COUNT ! 15612: {{ADD{#CMVLS{R6{{ADD FOR STANDARD FIELDS AT START ! 15613: {{WTB{R6{{{CONVERT LENGTH TO BYTES ! 15614: {{JSR{ALLOC{{{ALLOCATE SPACE FOR CMBLK ! 15615: {{MOV{#B$CMT{(R9){{STORE TYPE CODE FOR CMBLK ! 15616: {{MOV{R10{4*CMTYP(R9){{STORE CMBLK NODE TYPE INDICATOR ! 15617: {{MOV{R6{4*CMLEN(R9){{STORE LENGTH ! 15618: {{ADD{R6{R9{{POINT PAST END OF BLOCK ! 15619: {{LCT{R8{R8{{SET LOOP COUNTER ! 15620: * ! 15621: * LOOP TO MOVE REMAINING WORDS TO CMBLK ! 15622: * ! 15623: {EXP16{MOV{(SP)+{-(R9){{MOVE ONE OPERAND PTR FROM STACK ! 15624: {{MOV{(SP)+{R7{{POP TO OLD LEVEL INDICATOR ! 15625: {{BCT{R8{EXP16{{LOOP TILL ALL MOVED ! 15626: {{EJC{{{{ ! 15627: * ! 15628: * EXPAN (CONTINUED) ! 15629: * ! 15630: * COMPLETE CMBLK AND STACK POINTER TO IT ON STACK ! 15631: * ! 15632: {{SUB{#4*CMVLS{R9{{POINT BACK TO START OF BLOCK ! 15633: {{MOV{(SP)+{R8{{RESTORE OLD COUNTER ! 15634: {{MOV{(SP){4*CMOPN(R9){{STORE OPERAND PTR IN CMBLK ! 15635: {{MOV{R9{(SP){{STACK CMBLK POINTER ! 15636: {{MOV{#NUM02{R6{{SET NEW STATE ! 15637: {{BRN{EXP01{{{BACK FOR NEXT ELEMENT ! 15638: * ! 15639: * HERE AT END OF A PARENTHESIZED EXPRESSION ! 15640: * ! 15641: {EXP17{JSR{EXPDM{{{DUMP OPERATORS AT THIS LEVEL ! 15642: {{MOV{(SP)+{R9{{RESTORE XR ! 15643: {{MOV{(SP)+{R7{{RESTORE OUTER LEVEL ! 15644: {{MOV{(SP)+{R8{{RESTORE OUTER COUNT ! 15645: {{MOV{R9{(SP){{STORE OPND OVER UNUSED CMOPN VAL ! 15646: {{MOV{#NUM02{R6{{SET NEW STATE ! 15647: {{BRN{EXP01{{{BACK FOR NEXT ELE8ENT ! 15648: * ! 15649: * HERE FOR RBR (S=2) ! 15650: * ! 15651: * AT OUTER LEVEL IN A DIRECT GOTO, THIS IS A TERMINATOR. ! 15652: * OTHERWISE IT MUST TERMINATE A SUBSCRIPT LIST. ! 15653: * ! 15654: {EXP18{MOV{#C$ARR{R10{{SET CMTYP FOR ARRAY REFERENCE ! 15655: {{BEQ{R7{#NUM03{EXP15{JUMP TO BUILD CMBLK IF END ARRAYREF ! 15656: {{BEQ{R7{#NUM02{EXP20{JUMP IF END OF DIRECT GOTO ! 15657: {{ERB{225{SYNTAX{{ERROR. UNBALANCED RIGHT BRACKET ! 15658: {{EJC{{{{ ! 15659: * ! 15660: * EXPAN (CONTINUED) ! 15661: * ! 15662: * HERE FOR COL,SMC (S=2) ! 15663: * ! 15664: * ERROR UNLESS TERMINATING STATEMENT BODY AT OUTER LEVEL ! 15665: * ! 15666: {EXP19{MNZ{SCNRS{{{RESCAN TERMINATOR ! 15667: {{MOV{R7{R10{{COPY LEVEL INDICATOR ! 15668: {{BSW{R10{6{{SWITCH ON LEVEL INDICATOR ! 15669: {{IFF{0{EXP20{{NORMAL OUTER LEVEL ! 15670: {{IFF{1{EXP22{{FAIL IF NORMAL GOTO ! 15671: {{IFF{2{EXP23{{FAIL IF DIRECT GOTO ! 15672: {{IFF{3{EXP24{{FAIL ARRAY BRACKETS ! 15673: {{IFF{4{EXP21{{FAIL IF IN GROUPING ! 15674: {{IFF{5{EXP21{{FAIL FUNCTION ARGS ! 15675: {{ESW{{{{END SWITCH ON LEVEL ! 15676: * ! 15677: * HERE AT NORMAL END OF EXPRESSION ! 15678: * ! 15679: {EXP20{JSR{EXPDM{{{DUMP REMAINING OPERATORS ! 15680: {{MOV{(SP)+{R9{{LOAD TREE POINTER ! 15681: {{ICA{SP{{{POP OFF BOTTOM OF STACK MARKER ! 15682: {{EXI{{{{RETURN TO EXPAN CALLER ! 15683: * ! 15684: * MISSING RIGHT PAREN ! 15685: * ! 15686: {EXP21{ERB{226{SYNTAX{{ERROR. MISSING RIGHT PAREN ! 15687: * ! 15688: * MISSING RIGHT PAREN IN GOTO FIELD ! 15689: * ! 15690: {EXP22{ERB{227{SYNTAX{{ERROR. RIGHT PAREN MISSING FROM GOTO ! 15691: * ! 15692: * MISSING BRACKET IN GOTO ! 15693: * ! 15694: {EXP23{ERB{228{SYNTAX{{ERROR. RIGHT BRACKET MISSING FROM GOTO ! 15695: * ! 15696: * MISSING ARRAY BRACKET ! 15697: * ! 15698: {EXP24{ERB{229{SYNTAX{{ERROR. MISSING RIGHT ARRAY BRACKET ! 15699: {{EJC{{{{ ! 15700: * ! 15701: * EXPAN (CONTINUED) ! 15702: * ! 15703: * LOOP HERE WHEN AN OPERATOR CAUSES AN OPERATOR DUMP ! 15704: * ! 15705: {EXP25{MOV{R9{EXPSV{{ ! 15706: {{JSR{EXPOP{{{POP ONE OPERATOR ! 15707: {{MOV{EXPSV{R9{{RESTORE OP DV POINTER AND MERGE ! 15708: * ! 15709: * HERE FOR BOP (S=2) ! 15710: * ! 15711: * REMOVE OPERATORS (CONDENSE) FROM STACK UNTIL NO MORE ! 15712: * LEFT AT THIS LEVEL OR TOP ONE HAS LOWER PRECEDENCE. ! 15713: * LOOP HERE TILL THIS CONDITION IS MET. ! 15714: * ! 15715: {EXP26{MOV{4*1(SP){R10{{LOAD OPERATOR DVPTR FROM STACK ! 15716: {{BLE{R10{#NUM05{EXP27{JUMP IF BOTTOM OF STACK LEVEL ! 15717: {{BLT{4*DVRPR(R9){4*DVLPR(R10){EXP25{ELSE POP IF NEW PREC IS LO ! 15718: * ! 15719: * HERE FOR UOP (S=0,1) ! 15720: * ! 15721: * BINARY OPERATOR MERGES AFTER PRECEDENCE CHECK ! 15722: * ! 15723: * THE OPERATOR DV IS STORED ON THE STACK AND THE SCAN ! 15724: * CONTINUES AFTER SETTING THE SCAN STATE TO ONE. ! 15725: * ! 15726: {EXP27{MOV{R9{-(SP){{STACK OPERATOR DVPTR ON STACK ! 15727: {{CHK{{{{CHECK FOR STACK OVERFLOW ! 15728: {{MOV{#NUM01{R6{{SET NEW STATE ! 15729: {{BNE{R9{#OPDVS{EXP01{BACK FOR NEXT ELEMENT UNLESS = ! 15730: * ! 15731: * HERE FOR SPECIAL CASE OF BINARY =. THE SYNTAX ALLOWS A ! 15732: * NULL RIGHT ARGUMENT FOR THIS OPERATOR TO BE LEFT ! 15733: * OUT. ACCORDINGLY WE RESET TO STATE ZERO TO GET PROPER ! 15734: * ACTION ON A TERMINATOR (SUPPLY A NULL CONSTANT). ! 15735: * ! 15736: {{ZER{R6{{{SET STATE ZERO ! 15737: {{BRN{EXP01{{{JUMP FOR NEXT ELEMENT ! 15738: {{ENP{{{{END PROCEDURE EXPAN ! 15739: {{EJC{{{{ ! 15740: * ! 15741: * EXPAP -- TEST FOR PATTERN MATCH TREE ! 15742: * ! 15743: * EXPAP IS PASSED AN EXPRESSION TREE TO DETERMINE IF IT ! 15744: * IS A PATTERN MATCH. THE FOLLOWING ARE RECOGIZED AS ! 15745: * MATCHES IN THE CONTEXT OF THIS CALL. ! 15746: * ! 15747: * 1) AN EXPLICIT USE OF BINARY QUESTION MARK ! 15748: * 2) A CONCATENATION ! 15749: * 3) AN ALTERNATION WHOSE LEFT OPERAND IS A CONCATENATION ! 15750: * ! 15751: * (XR) PTR TO EXPAN TREE ! 15752: * JSR EXPAP CALL TO TEST FOR PATTERN MATCH ! 15753: * PPM LOC TRANSFER LOC IF NOT A PATTERN MATCH ! 15754: * (WA) DESTROYED ! 15755: * (XR) UNCHANGED (IF NOT MATCH) ! 15756: * (XR) PTR TO BINARY OPERATOR BLK IF MATCH ! 15757: * ! 15758: {EXPAP{PRC{E{1{{ENTRY POINT ! 15759: {{MOV{R10{-(SP){{SAVE XL ! 15760: {{BNE{(R9){#B$CMT{EXPP2{NO MATCH IF NOT COMPLEX ! 15761: {{MOV{4*CMTYP(R9){R6{{ELSE LOAD TYPE CODE ! 15762: {{BEQ{R6{#C$CNC{EXPP1{CONCATENATION IS A MATCH ! 15763: {{BEQ{R6{#C$PMT{EXPP1{BINARY QUESTION MARK IS A MATCH ! 15764: {{BNE{R6{#C$ALT{EXPP2{ELSE NOT MATCH UNLESS ALTERNATION ! 15765: * ! 15766: * HERE FOR ALTERNATION. CHANGE (A B) / C TO A QM (B / C) ! 15767: * ! 15768: {{MOV{4*CMLOP(R9){R10{{LOAD LEFT OPERAND POINTER ! 15769: {{BNE{(R10){#B$CMT{EXPP2{NOT MATCH IF LEFT OPND NOT COMPLEX ! 15770: {{BNE{4*CMTYP(R10){#C$CNC{EXPP2{NOT MATCH IF LEFT OP NOT CONC ! 15771: {{MOV{4*CMROP(R10){4*CMLOP(R9){{XR POINTS TO (B / C) ! 15772: {{MOV{R9{4*CMROP(R10){{SET XL OPNDS TO A, (B / C) ! 15773: {{MOV{R10{R9{{POINT TO THIS ALTERED NODE ! 15774: * ! 15775: * EXIT HERE FOR PATTERN MATCH ! 15776: * ! 15777: {EXPP1{MOV{(SP)+{R10{{RESTORE ENTRY XL ! 15778: {{EXI{{{{GIVE PATTERN MATCH RETURN ! 15779: * ! 15780: * EXIT HERE IF NOT PATTERN MATCH ! 15781: * ! 15782: {EXPP2{MOV{(SP)+{R10{{RESTORE ENTRY XL ! 15783: {{EXI{1{{{GIVE NON-MATCH RETURN ! 15784: {{ENP{{{{END PROCEDURE EXPAP ! 15785: {{EJC{{{{ ! 15786: * ! 15787: * EXPDM -- DUMP OPERATORS AT CURRENT LEVEL (FOR EXPAN) ! 15788: * ! 15789: * EXPDM USES EXPOP TO CONDENSE ALL OPERATORS AT THIS SYNTAX ! 15790: * LEVEL. THE STACK BOTTOM IS RECOGNIZED FROM THE LEVEL ! 15791: * VALUE WHICH IS SAVED ON THE TOP OF THE STACK. ! 15792: * ! 15793: * JSR EXPDM CALL TO DUMP OPERATORS ! 15794: * (XS) POPPED AS REQUIRED ! 15795: * (XR,WA) DESTROYED ! 15796: * ! 15797: {EXPDM{PRC{N{0{{ENTRY POINT ! 15798: {{MOV{R10{R$EXS{{SAVE XL VALUE ! 15799: * ! 15800: * LOOP TO DUMP OPERATORS ! 15801: * ! 15802: {EXDM1{BLE{4*1(SP){#NUM05{EXDM2{JUMP IF STACK BOTTOM (SAVED LEVEL ! 15803: {{JSR{EXPOP{{{ELSE POP ONE OPERATOR ! 15804: {{BRN{EXDM1{{{AND LOOP BACK ! 15805: * ! 15806: * HERE AFTER POPPING ALL OPERATORS ! 15807: * ! 15808: {EXDM2{MOV{R$EXS{R10{{RESTORE XL ! 15809: {{ZER{R$EXS{{{RELEASE SAVE LOCATION ! 15810: {{EXI{{{{RETURN TO EXPDM CALLER ! 15811: {{ENP{{{{END PROCEDURE EXPDM ! 15812: {{EJC{{{{ ! 15813: * ! 15814: * EXPOP-- POP OPERATOR (FOR EXPAN) ! 15815: * ! 15816: * EXPOP IS USED BY THE EXPAN ROUTINE TO CONDENSE ONE ! 15817: * OPERATOR FROM THE TOP OF THE SYNTAX STACK. AN APPROPRIATE ! 15818: * CMBLK IS BUILT FOR THE OPERATOR (UNARY OR BINARY) AND A ! 15819: * POINTER TO THIS CMBLK IS STACKED. ! 15820: * ! 15821: * EXPOP IS ALSO USED BY SCNGF (GOTO FIELD SCAN) PROCEDURE ! 15822: * ! 15823: * JSR EXPOP CALL TO POP OPERATOR ! 15824: * (XS) POPPED APPROPRIATELY ! 15825: * (XR,XL,WA) DESTROYED ! 15826: * ! 15827: {EXPOP{PRC{N{0{{ENTRY POINT ! 15828: {{MOV{4*1(SP){R9{{LOAD OPERATOR DV POINTER ! 15829: {{BEQ{4*DVLPR(R9){#LLUNO{EXPO2{JUMP IF UNARY ! 15830: * ! 15831: * HERE FOR BINARY OPERATOR ! 15832: * ! 15833: {{MOV{#4*CMBS${R6{{SET SIZE OF BINARY OPERATOR CMBLK ! 15834: {{JSR{ALLOC{{{ALLOCATE SPACE FOR CMBLK ! 15835: {{MOV{(SP)+{4*CMROP(R9){{POP AND STORE RIGHT OPERAND PTR ! 15836: {{MOV{(SP)+{R10{{POP AND LOAD OPERATOR DV PTR ! 15837: {{MOV{(SP){4*CMLOP(R9){{STORE LEFT OPERAND POINTER ! 15838: * ! 15839: * COMMON EXIT POINT ! 15840: * ! 15841: {EXPO1{MOV{#B$CMT{(R9){{STORE TYPE CODE FOR CMBLK ! 15842: {{MOV{4*DVTYP(R10){4*CMTYP(R9){{STORE CMBLK NODE TYPE CODE ! 15843: {{MOV{R10{4*CMOPN(R9){{STORE DVPTR (=PTR TO DAC O$XXX) ! 15844: {{MOV{R6{4*CMLEN(R9){{STORE CMBLK LENGTH ! 15845: {{MOV{R9{(SP){{STORE RESULTING NODE PTR ON STACK ! 15846: {{EXI{{{{RETURN TO EXPOP CALLER ! 15847: * ! 15848: * HERE FOR UNARY OPERATOR ! 15849: * ! 15850: {EXPO2{MOV{#4*CMUS${R6{{SET SIZE OF UNARY OPERATOR CMBLK ! 15851: {{JSR{ALLOC{{{ALLOCATE SPACE FOR CMBLK ! 15852: {{MOV{(SP)+{4*CMROP(R9){{POP AND STORE OPERAND POINTER ! 15853: {{MOV{(SP){R10{{LOAD OPERATOR DV POINTER ! 15854: {{BRN{EXPO1{{{MERGE BACK TO EXIT ! 15855: {{ENP{{{{END PROCEDURE EXPOP ! 15856: {{EJC{{{{ ! 15857: * ! 15858: * FLSTG -- FOLD STRING TO UPPER CASE ! 15859: * ! 15860: * FLSTG FOLDS A CHARACTER STRING CONTAINING LOWER CASE ! 15861: * CHARACCTERS TO ONE CONTAINING UPPER CASE CHARACTERS. ! 15862: * FOLDING IS ONLY DONE IF &CASE (KVCAS) IS NOT ZERO. ! 15863: * ! 15864: * (XR) STRING ARGUMENT ! 15865: * (WA) LENGTH OF STRING ! 15866: * JSR FLSTG CALL TO FOLD STRING ! 15867: * (XR) RESULT STRING (POSSIBLY ORIGINAL) ! 15868: * (WC) DESTROYED ! 15869: * ! 15870: {FLSTG{PRC{R{0{{ENTRY POINT ! 15871: {{BZE{KVCAS{FST99{{SKIP IF &CASE IS 0 ! 15872: {{MOV{R10{-(SP){{SAVE XL ACROSS CALL ! 15873: {{MOV{R9{-(SP){{SAVE ORIGINAL SCBLK PTR ! 15874: {{JSR{ALOCS{{{ALLOCATE NEW STRING BLOCK ! 15875: {{MOV{(SP){R10{{POINT TO ORIGINAL SCBLK ! 15876: {{MOV{R9{-(SP){{SAVE POINTER TO NEW SCBLK ! 15877: {{PLC{R10{{{POINT TO ORIGINAL CHARS ! 15878: {{PLC{R9{{{POINT TO NEW CHARS ! 15879: {{ZER{-(SP){{{INIT DID FOLD FLAG ! 15880: {{LCT{R8{R8{{LOAD LOOP COUNTER ! 15881: {FST01{LCH{R6{(R10)+{{LOAD CHARACTER ! 15882: {{BGT{#CH$$A{R6{FST02{SKIP IF LESS THAN LC A ! 15883: {{BGT{R6{#CH$$${FST02{SKIP IF GREATER THAN LC Z ! 15884: {{FLC{R6{{{FOLD CHARACTER TO UPPER CASE ! 15885: {{MNZ{(SP){{{SET DID FOLD CHARACTER FLAG ! 15886: {FST02{SCH{R6{(R9)+{{STORE (POSSIBLY FOLDED) CHARACTER ! 15887: {{BCT{R8{FST01{{LOOP THRU ENTIRE STRING ! 15888: {{CSC{R9{{{COMPLETE STORE CHARACTERS ! 15889: {{BNZ{(SP)+{FST10{{SKIP IF FOLDING DONE ! 15890: {{MOV{(SP)+{DNAMP{{DO NOT NEED NEW SCBLK ! 15891: {{MOV{(SP)+{R9{{RETURN ORIGINAL SCBLK ! 15892: {{BRN{FST20{{{MERGE BELOW ! 15893: {FST10{MOV{(SP)+{R9{{RETURN NEW SCBLK ! 15894: {{ICA{SP{{{THROW AWAY ORIGINAL SCBLK POINTER ! 15895: {FST20{MOV{4*SCLEN(R9){R6{{RELOAD STRING LENGTH ! 15896: {{MOV{(SP)+{R10{{RESTORE XL ! 15897: {FST99{EXI{{{{RETURN ! 15898: {{ENP{{{{ ! 15899: {{EJC{{{{ ! 15900: * ! 15901: * GBCOL -- PERFORM GARBAGE COLLECTION ! 15902: * ! 15903: * GBCOL PERFORMS A GARBAGE COLLECTION ON THE DYNAMIC REGION ! 15904: * ALL BLOCKS WHICH ARE NO LONGER IN USE ARE ELIMINATED ! 15905: * BY MOVING BLOCKS WHICH ARE IN USE DOWN AND RESETTING ! 15906: * DNAMP, THE POINTER TO THE NEXT AVAILABLE LOCATION. ! 15907: * ! 15908: * (WB) MOVE OFFSET (SEE BELOW) ! 15909: * JSR GBCOL CALL TO COLLECT GARBAGE ! 15910: * (XR) DESTROYED ! 15911: * ! 15912: * THE FOLLOWING CONDITIONS MUST BE MET AT THE TIME WHEN ! 15913: * GBCOL IS CALLED. ! 15914: * ! 15915: * 1) ALL POINTERS TO BLOCKS IN THE DYNAMIC AREA MUST BE ! 15916: * ACCESSIBLE TO THE GARBAGE COLLECTOR. THIS MEANS ! 15917: * THAT THEY MUST OCCUR IN ONE OF THE FOLLOWING. ! 15918: * ! 15919: * A) MAIN STACK, WITH CURRENT TOP ! 15920: * ELEMENT BEING INDICATED BY XS ! 15921: * ! 15922: * B) IN RELOCATABLE FIELDS OF VRBLKS. ! 15923: * ! 15924: * C) IN REGISTER XL AT THE TIME OF CALL ! 15925: * ! 15926: * E) IN THE SPECIAL REGION OF WORKING ! 15927: * STORAGE WHERE NAMES BEGIN WITH R$. ! 15928: * ! 15929: * 2) ALL POINTERS MUST POINT TO THE START OF BLOCKS WITH ! 15930: * THE SOLE EXCEPTION OF THE CONTENTS OF THE CODE ! 15931: * POINTER REGISTER WHICH POINTS INTO THE R$COD BLOCK. ! 15932: * ! 15933: * 3) NO LOCATION WHICH APPEARS TO CONTAIN A POINTER ! 15934: * INTO THE DYNAMIC REGION MAY OCCUR UNLESS IT IS IN ! 15935: * FACT A POINTER TO THE START OF THE BLOCK. HOWEVER ! 15936: * POINTERS OUTSIDE THIS AREA MAY OCCUR AND WILL ! 15937: * NOT BE CHANGED BY THE GARBAGE COLLECTOR. ! 15938: * IT IS ESPECIALLY IMPORTANT TO MAKE SURE THAT XL ! 15939: * DOES NOT CONTAIN A GARBAGE VALUE FROM SOME PROCESS ! 15940: * CARRIED OUT BEFORE THE CALL TO THE COLLECTOR. ! 15941: * ! 15942: * GBCOL HAS THE CAPABILITY OF MOVING THE FINAL COMPACTED ! 15943: * RESULT UP IN MEMORY (WITH ADDRESSES ADJUSTED ACCORDINGLY) ! 15944: * THIS IS USED TO ADD SPACE TO THE STATIC REGION. THE ! 15945: * ENTRY VALUE OF WB IS THE NUMBER OF BYTES TO MOVE UP. ! 15946: * THE CALLER MUST GUARANTEE THAT THERE IS ENOUGH ROOM. ! 15947: * FURTHERMORE THE VALUE IN WB IF IT IS NON-ZERO, MUST BE AT ! 15948: * LEAST 256 SO THAT THE MWB INSTRUCTION CONDITIONS ARE MET. ! 15949: {{EJC{{{{ ! 15950: * ! 15951: * GBCOL (CONTINUED) ! 15952: * ! 15953: * THE ALGORITHM, WHICH IS A MODIFICATION OF THE LISP-2 ! 15954: * GARBAGE COLLECTOR DEVISED BY R.DEWAR AND K.BELCHER ! 15955: * TAKES THREE PASSES AS FOLLOWS. ! 15956: * ! 15957: * 1) ALL POINTERS IN MEMORY ARE SCANNED AND BLOCKS IN USE ! 15958: * DETERMINED FROM THIS SCAN. NOTE THAT THIS PROCEDURE ! 15959: * IS RECURSIVE AND USES THE MAIN STACK FOR LINKAGE. ! 15960: * THE MARKING PROCESS IS THUS SIMILAR TO THAT USED IN ! 15961: * A STANDARD LISP COLLECTOR. HOWEVER THE METHOD OF ! 15962: * ACTUALLY MARKING THE BLOCKS IS DIFFERENT. ! 15963: * ! 15964: * THE FIRST FIELD OF A BLOCK NORMALLY CONTAINS A ! 15965: * CODE ENTRY POINT POINTER. SUCH AN ENTRY POINTER ! 15966: * CAN BE DISTINGUISHED FROM THE ADDRESS OF ANY POINTER ! 15967: * TO BE PROCESSED BY THE COLLECTOR. DURING GARBAGE ! 15968: * COLLECTION, THIS WORD IS USED TO BUILD A BACK CHAIN ! 15969: * OF POINTERS THROUGH FIELDS WHICH POINT TO THE BLOCK. ! 15970: * THE END OF THE CHAIN IS MARKED BY THE OCCURENCE ! 15971: * OF THE WORD WHICH USED TO BE IN THE FIRST WORD OF ! 15972: * THE BLOCK. THIS BACKCHAIN SERVES BOTH AS A MARK ! 15973: * INDICATING THAT THE BLOCK IS IN USE AND AS A LIST OF ! 15974: * REFERENCES FOR THE RELOCATION PHASE. ! 15975: * ! 15976: * 2) STORAGE IS SCANNED SEQUENTIALLY TO DISCOVER WHICH ! 15977: * BLOCKS ARE CURRENTLY IN USE AS INDICATED BY THE ! 15978: * PRESENCE OF A BACKCHAIN. TWO POINTERS ARE MAINTAINED ! 15979: * ONE SCANS THROUGH LOOKING AT EACH BLOCK. THE OTHER ! 15980: * IS INCREMENTED ONLY FOR BLOCKS FOUND TO BE IN USE. ! 15981: * IN THIS WAY, THE EVENTUAL LOCATION OF EACH BLOCK CAN ! 15982: * BE DETERMINED WITHOUT ACTUALLY MOVING ANY BLOCKS. ! 15983: * AS EACH BLOCK WHICH IS IN USE IS PROCESSED, THE BACK ! 15984: * CHAIN IS USED TO RESET ALL POINTERS WHICH POINT TO ! 15985: * THIS BLOCK TO CONTAIN ITS NEW ADDRESS, I.E. THE ! 15986: * ADDRESS IT WILL OCCUPY AFTER THE BLOCKS ARE MOVED. ! 15987: * THE FIRST WORD OF THE BLOCK, TAKEN FROM THE END OF ! 15988: * THE CHAIN IS RESTORED AT THIS POINT. ! 15989: * ! 15990: * DURING PASS 2, THE COLLECTOR BUILDS BLOCKS WHICH ! 15991: * DESCRIBE THE REGIONS OF STORAGE WHICH ARE TO BE ! 15992: * MOVED IN THE THIRD PASS. THERE IS ONE DESCRIPTOR FOR ! 15993: * EACH CONTIGUOUS SET OF GOOD BLOCKS. THE DESCRIPTOR ! 15994: * IS BUILT JUST BEHIND THE BLOCK TO BE MOVED AND ! 15995: * CONTAINS A POINTER TO THE NEXT BLOCK AND THE NUMBER ! 15996: * OF WORDS TO BE MOVED. ! 15997: * ! 15998: * 3) IN THE THIRD AND FINAL PASS, THE MOVE DESCRIPTOR ! 15999: * BLOCKS BUILT IN PASS TWO ARE USED TO ACTUALLY MOVE ! 16000: * THE BLOCKS DOWN TO THE BOTTOM OF THE DYNAMIC REGION. ! 16001: * THE COLLECTION IS THEN COMPLETE AND THE NEXT ! 16002: * AVAILABLE LOCATION POINTER IS RESET. ! 16003: {{EJC{{{{ ! 16004: * ! 16005: * GBCOL (CONTINUED) ! 16006: * ! 16007: {GBCOL{PRC{E{0{{ENTRY POINT ! 16008: {{BNZ{DMVCH{GBC14{{FAIL IF IN MID-DUMP ! 16009: {{MNZ{GBCFL{{{NOTE GBCOL ENTERED ! 16010: {{MOV{R6{GBSVA{{SAVE ENTRY WA ! 16011: {{MOV{R7{GBSVB{{SAVE ENTRY WB ! 16012: {{MOV{R8{GBSVC{{SAVE ENTRY WC ! 16013: {{MOV{R10{-(SP){{SAVE ENTRY XL ! 16014: {{SCP{R6{{{GET CODE POINTER VALUE ! 16015: {{SUB{R$COD{R6{{MAKE RELATIVE ! 16016: {{LCP{R6{{{AND RESTORE ! 16017: * ! 16018: * PROCESS STACK ENTRIES ! 16019: * ! 16020: {{MOV{SP{R9{{POINT TO STACK FRONT ! 16021: {{MOV{STBAS{R10{{POINT PAST END OF STACK ! 16022: {{BGE{R10{R9{GBC00{OK IF D-STACK ! 16023: {{MOV{R10{R9{{REVERSE IF ... ! 16024: {{MOV{SP{R10{{... U-STACK ! 16025: * ! 16026: * PROCESS THE STACK ! 16027: * ! 16028: {GBC00{JSR{GBCPF{{{PROCESS POINTERS ON STACK ! 16029: * ! 16030: * PROCESS SPECIAL WORK LOCATIONS ! 16031: * ! 16032: {{MOV{#R$AAA{R9{{POINT TO START OF RELOCATABLE LOCS ! 16033: {{MOV{#R$YYY{R10{{POINT PAST END OF RELOCATABLE LOCS ! 16034: {{JSR{GBCPF{{{PROCESS WORK FIELDS ! 16035: * ! 16036: * PREPARE TO PROCESS VARIABLE BLOCKS ! 16037: * ! 16038: {{MOV{HSHTB{R6{{POINT TO FIRST HASH SLOT POINTER ! 16039: * ! 16040: * LOOP THROUGH HASH SLOTS ! 16041: * ! 16042: {GBC01{MOV{R6{R10{{POINT TO NEXT SLOT ! 16043: {{ICA{R6{{{BUMP BUCKET POINTER ! 16044: {{MOV{R6{GBCNM{{SAVE BUCKET POINTER ! 16045: {{EJC{{{{ ! 16046: * ! 16047: * GBCOL (CONTINUED) ! 16048: * ! 16049: * LOOP THROUGH VARIABLES ON ONE HASH CHAIN ! 16050: * ! 16051: {GBC02{MOV{(R10){R9{{LOAD PTR TO NEXT VRBLK ! 16052: {{BZE{R9{GBC03{{JUMP IF END OF CHAIN ! 16053: {{MOV{R9{R10{{ELSE COPY VRBLK POINTER ! 16054: {{ADD{#4*VRVAL{R9{{POINT TO FIRST RELOC FLD ! 16055: {{ADD{#4*VRNXT{R10{{POINT PAST LAST (AND TO LINK PTR) ! 16056: {{JSR{GBCPF{{{PROCESS RELOC FIELDS IN VRBLK ! 16057: {{BRN{GBC02{{{LOOP BACK FOR NEXT BLOCK ! 16058: * ! 16059: * HERE AT END OF ONE HASH CHAIN ! 16060: * ! 16061: {GBC03{MOV{GBCNM{R6{{RESTORE BUCKET POINTER ! 16062: {{BNE{R6{HSHTE{GBC01{LOOP BACK IF MORE BUCKETS TO GO ! 16063: {{EJC{{{{ ! 16064: * ! 16065: * GBCOL (CONTINUED) ! 16066: * ! 16067: * NOW WE ARE READY TO START PASS TWO. REGISTERS ARE USED ! 16068: * AS FOLLOWS IN PASS TWO. ! 16069: * ! 16070: * (XR) SCANS THROUGH ALL BLOCKS ! 16071: * (WC) POINTER TO EVENTUAL LOCATION ! 16072: * ! 16073: * THE MOVE DESCRIPTION BLOCKS BUILT IN THIS PASS HAVE ! 16074: * THE FOLLOWING FORMAT. ! 16075: * ! 16076: * WORD 1 POINTER TO NEXT MOVE BLOCK, ! 16077: * ZERO IF END OF CHAIN OF BLOCKS ! 16078: * ! 16079: * WORD 2 LENGTH OF BLOCKS TO BE MOVED IN ! 16080: * BYTES. SET TO THE ADDRESS OF THE ! 16081: * FIRST BYTE WHILE ACTUALLY SCANNING ! 16082: * THE BLOCKS. ! 16083: * ! 16084: * THE FIRST ENTRY ON THIS CHAIN IS A SPECIAL ENTRY ! 16085: * CONSISTING OF THE TWO WORDS GBCNM AND GBCNS. AFTER ! 16086: * BUILDING THE CHAIN OF MOVE DESCRIPTORS, GBCNM POINTS TO ! 16087: * THE FIRST REAL MOVE BLOCK, AND GBCNS IS THE LENGTH OF ! 16088: * BLOCKS IN USE AT THE START OF STORAGE WHICH NEED NOT ! 16089: * BE MOVED SINCE THEY ARE IN THE CORRECT POSITION. ! 16090: * ! 16091: {GBC04{MOV{DNAMB{R9{{POINT TO FIRST BLOCK ! 16092: {{MOV{R9{R8{{SET AS FIRST EVENTUAL LOCATION ! 16093: {{ADD{GBSVB{R8{{ADD OFFSET FOR EVENTUAL MOVE UP ! 16094: {{ZER{GBCNM{{{CLEAR INITIAL FORWARD POINTER ! 16095: {{MOV{#GBCNM{GBCLM{{INITIALIZE PTR TO LAST MOVE BLOCK ! 16096: {{MOV{R9{GBCNS{{INITIALIZE FIRST ADDRESS ! 16097: * ! 16098: * LOOP THROUGH A SERIES OF BLOCKS IN USE ! 16099: * ! 16100: {GBC05{BEQ{R9{DNAMP{GBC07{JUMP IF END OF USED REGION ! 16101: {{MOV{(R9){R6{{ELSE GET FIRST WORD ! 16102: {{BHI{R6{#P$YYY{GBC06{SKIP IF NOT ENTRY PTR (IN USE) ! 16103: {{BHI{R6{#B$AAA{GBC07{JUMP IF ENTRY POINTER (UNUSED) ! 16104: * ! 16105: * HERE FOR BLOCK IN USE, LOOP TO RELOCATE REFERENCES ! 16106: * ! 16107: {GBC06{MOV{R6{R10{{COPY POINTER ! 16108: {{MOV{(R10){R6{{LOAD FORWARD POINTER ! 16109: {{MOV{R8{(R10){{RELOCATE REFERENCE ! 16110: {{BHI{R6{#P$YYY{GBC06{LOOP BACK IF NOT END OF CHAIN ! 16111: {{BLO{R6{#B$AAA{GBC06{LOOP BACK IF NOT END OF CHAIN ! 16112: {{EJC{{{{ ! 16113: * ! 16114: * GBCOL (CONTINUED) ! 16115: * ! 16116: * AT END OF CHAIN, RESTORE FIRST WORD AND BUMP PAST ! 16117: * ! 16118: {{MOV{R6{(R9){{RESTORE FIRST WORD ! 16119: {{JSR{BLKLN{{{GET LENGTH OF THIS BLOCK ! 16120: {{ADD{R6{R9{{BUMP ACTUAL POINTER ! 16121: {{ADD{R6{R8{{BUMP EVENTUAL POINTER ! 16122: {{BRN{GBC05{{{LOOP BACK FOR NEXT BLOCK ! 16123: * ! 16124: * HERE AT END OF A SERIES OF BLOCKS IN USE ! 16125: * ! 16126: {GBC07{MOV{R9{R6{{COPY POINTER PAST LAST BLOCK ! 16127: {{MOV{GBCLM{R10{{POINT TO PREVIOUS MOVE BLOCK ! 16128: {{SUB{4*1(R10){R6{{SUBTRACT STARTING ADDRESS ! 16129: {{MOV{R6{4*1(R10){{STORE LENGTH OF BLOCK TO BE MOVED ! 16130: * ! 16131: * LOOP THROUGH A SERIES OF BLOCKS NOT IN USE ! 16132: * ! 16133: {GBC08{BEQ{R9{DNAMP{GBC10{JUMP IF END OF USED REGION ! 16134: {{MOV{(R9){R6{{ELSE LOAD FIRST WORD OF NEXT BLOCK ! 16135: {{BHI{R6{#P$YYY{GBC09{JUMP IF IN USE ! 16136: {{BLO{R6{#B$AAA{GBC09{JUMP IF IN USE ! 16137: {{JSR{BLKLN{{{ELSE GET LENGTH OF NEXT BLOCK ! 16138: {{ADD{R6{R9{{PUSH POINTER ! 16139: {{BRN{GBC08{{{AND LOOP BACK ! 16140: * ! 16141: * HERE FOR A BLOCK IN USE AFTER PROCESSING A SERIES OF ! 16142: * BLOCKS WHICH WERE NOT IN USE, BUILD NEW MOVE BLOCK. ! 16143: * ! 16144: {GBC09{SUB{#4*NUM02{R9{{POINT 2 WORDS BEHIND FOR MOVE BLOCK ! 16145: {{MOV{GBCLM{R10{{POINT TO PREVIOUS MOVE BLOCK ! 16146: {{MOV{R9{(R10){{SET FORWARD PTR IN PREVIOUS BLOCK ! 16147: {{ZER{(R9){{{ZERO FORWARD PTR OF NEW BLOCK ! 16148: {{MOV{R9{GBCLM{{REMEMBER ADDRESS OF THIS BLOCK ! 16149: {{MOV{R9{R10{{COPY PTR TO MOVE BLOCK ! 16150: {{ADD{#4*NUM02{R9{{POINT BACK TO BLOCK IN USE ! 16151: {{MOV{R9{4*1(R10){{STORE STARTING ADDRESS ! 16152: {{BRN{GBC06{{{JUMP TO PROCESS BLOCK IN USE ! 16153: {{EJC{{{{ ! 16154: * ! 16155: * GBCOL (CONTINUED) ! 16156: * ! 16157: * HERE FOR PASS THREE -- ACTUALLY MOVE THE BLOCKS DOWN ! 16158: * ! 16159: * (XL) POINTER TO OLD LOCATION ! 16160: * (XR) POINTER TO NEW LOCATION ! 16161: * ! 16162: {GBC10{MOV{DNAMB{R9{{POINT TO START OF STORAGE ! 16163: {{ADD{GBCNS{R9{{BUMP PAST UNMOVED BLOCKS AT START ! 16164: * ! 16165: * LOOP THROUGH MOVE DESCRIPTORS ! 16166: * ! 16167: {GBC11{MOV{GBCNM{R10{{POINT TO NEXT MOVE BLOCK ! 16168: {{BZE{R10{GBC12{{JUMP IF END OF CHAIN ! 16169: {{MOV{(R10)+{GBCNM{{MOVE POINTER DOWN CHAIN ! 16170: {{MOV{(R10)+{R6{{GET LENGTH TO MOVE ! 16171: {{MVW{{{{PERFORM MOVE ! 16172: {{BRN{GBC11{{{LOOP BACK ! 16173: * ! 16174: * NOW TEST FOR MOVE UP ! 16175: * ! 16176: {GBC12{MOV{R9{DNAMP{{SET NEXT AVAILABLE LOC PTR ! 16177: {{MOV{GBSVB{R7{{RELOAD MOVE OFFSET ! 16178: {{BZE{R7{GBC13{{JUMP IF NO MOVE REQUIRED ! 16179: {{MOV{R9{R10{{ELSE COPY OLD TOP OF CORE ! 16180: {{ADD{R7{R9{{POINT TO NEW TOP OF CORE ! 16181: {{MOV{R9{DNAMP{{SAVE NEW TOP OF CORE POINTER ! 16182: {{MOV{R10{R6{{COPY OLD TOP ! 16183: {{SUB{DNAMB{R6{{MINUS OLD BOTTOM = LENGTH ! 16184: {{ADD{R7{DNAMB{{BUMP BOTTOM TO GET NEW VALUE ! 16185: {{MWB{{{{PERFORM MOVE (BACKWARDS) ! 16186: * ! 16187: * MERGE HERE TO EXIT ! 16188: * ! 16189: {GBC13{MOV{GBSVA{R6{{RESTORE WA ! 16190: {{SCP{R8{{{GET CODE POINTER ! 16191: {{ADD{R$COD{R8{{MAKE ABSOLUTE AGAIN ! 16192: {{LCP{R8{{{AND REPLACE ABSOLUTE VALUE ! 16193: {{MOV{GBSVC{R8{{RESTORE WC ! 16194: {{MOV{(SP)+{R10{{RESTORE ENTRY XL ! 16195: {{ICV{GBCNT{{{INCREMENT COUNT OF COLLECTIONS ! 16196: {{ZER{R9{{{CLEAR GARBAGE VALUE IN XR ! 16197: {{ZER{GBCFL{{{NOTE EXIT FROM GBCOL ! 16198: {{EXI{{{{EXIT TO GBCOL CALLER ! 16199: * ! 16200: * GARBAGE COLLECTION NOT ALLOWED WHILST DUMPING ! 16201: * ! 16202: {GBC14{ICV{ERRFT{{{FATAL ERROR ! 16203: {{ERB{250{INSUFFICIENT{{MEMORY TO COMPLETE DUMP ! 16204: {{ENP{{{{END PROCEDURE GBCOL ! 16205: {{EJC{{{{ ! 16206: * ! 16207: * GBCPF -- PROCESS FIELDS FOR GARBAGE COLLECTOR ! 16208: * ! 16209: * THIS PROCEDURE IS USED BY THE GARBAGE COLLECTOR TO ! 16210: * PROCESS FIELDS IN PASS ONE. SEE GBCOL FOR FULL DETAILS. ! 16211: * ! 16212: * (XR) PTR TO FIRST LOCATION TO PROCESS ! 16213: * (XL) PTR PAST LAST LOCATION TO PROCESS ! 16214: * JSR GBCPF CALL TO PROCESS FIELDS ! 16215: * (XR,WA,WB,WC,IA) DESTROYED ! 16216: * ! 16217: * NOTE THAT ALTHOUGH THIS PROCEDURE USES A RECURSIVE ! 16218: * APPROACH, IT CONTROLS ITS OWN STACK AND IS NOT RECURSIVE. ! 16219: * ! 16220: {GBCPF{PRC{E{0{{ENTRY POINT ! 16221: {{ZER{-(SP){{{SET ZERO TO MARK BOTTOM OF STACK ! 16222: {{MOV{R10{-(SP){{SAVE END POINTER ! 16223: * ! 16224: * MERGE HERE TO GO DOWN A LEVEL AND START A NEW LOOP ! 16225: * ! 16226: * 1(XS) NEXT LVL FIELD PTR (0 AT OUTER LVL) ! 16227: * 0(XS) PTR PAST LAST FIELD TO PROCESS ! 16228: * (XR) PTR TO FIRST FIELD TO PROCESS ! 16229: * ! 16230: * LOOP TO PROCESS SUCCESSIVE FIELDS ! 16231: * ! 16232: {GPF01{MOV{(R9){R10{{LOAD FIELD CONTENTS ! 16233: {{MOV{R9{R8{{SAVE FIELD POINTER ! 16234: {{BLT{R10{DNAMB{GPF02{JUMP IF NOT PTR INTO DYNAMIC AREA ! 16235: {{BGE{R10{DNAMP{GPF02{JUMP IF NOT PTR INTO DYNAMIC AREA ! 16236: * ! 16237: * HERE WE HAVE A PTR TO A BLOCK IN THE DYNAMIC AREA. ! 16238: * LINK THIS FIELD ONTO THE REFERENCE BACKCHAIN. ! 16239: * ! 16240: {{MOV{(R10){R6{{LOAD PTR TO CHAIN (OR ENTRY PTR) ! 16241: {{MOV{R9{(R10){{SET THIS FIELD AS NEW HEAD OF CHAIN ! 16242: {{MOV{R6{(R9){{SET FORWARD POINTER ! 16243: * ! 16244: * NOW SEE IF THIS BLOCK HAS BEEN PROCESSED BEFORE ! 16245: * ! 16246: {{BHI{R6{#P$YYY{GPF02{JUMP IF ALREADY PROCESSED ! 16247: {{BHI{R6{#B$AAA{GPF03{JUMP IF NOT ALREADY PROCESSED ! 16248: * ! 16249: * HERE TO MOVE TO NEXT FIELD ! 16250: * ! 16251: {GPF02{MOV{R8{R9{{RESTORE FIELD POINTER ! 16252: {{ICA{R9{{{BUMP TO NEXT FIELD ! 16253: {{BNE{R9{(SP){GPF01{LOOP BACK IF MORE TO GO ! 16254: {{EJC{{{{ ! 16255: * ! 16256: * GBCPF (CONTINUED) ! 16257: * ! 16258: * HERE WE POP UP A LEVEL AFTER FINISHING A BLOCK ! 16259: * ! 16260: {{MOV{(SP)+{R10{{RESTORE POINTER PAST END ! 16261: {{MOV{(SP)+{R8{{RESTORE BLOCK POINTER ! 16262: {{BNZ{R8{GPF02{{CONTINUE LOOP UNLESS OUTER LEVL ! 16263: {{EXI{{{{RETURN TO CALLER IF OUTER LEVEL ! 16264: * ! 16265: * HERE TO PROCESS AN ACTIVE BLOCK WHICH HAS NOT BEEN DONE ! 16266: * ! 16267: {GPF03{MOV{R10{R9{{COPY BLOCK POINTER ! 16268: {{MOV{R6{R10{{COPY FIRST WORD OF BLOCK ! 16269: {{LEI{R10{{{LOAD ENTRY POINT ID (BL$XX) ! 16270: * ! 16271: * BLOCK TYPE SWITCH. NOTE THAT BLOCKS WITH NO RELOCATABLE ! 16272: * FIELDS JUST RETURN TO GPF02 HERE TO CONTINE TO NEXT FLD. ! 16273: * ! 16274: {{BSW{R10{BL$$${{SWITCH ON BLOCK TYPE ! 16275: {{IFF{BL$AR{GPF06{{ARBLK ! 16276: {{IFF{BL$BC{GPF18{{BCBLK ! 16277: {{IFF{BL$CD{GPF08{{CDBLK ! 16278: {{IFF{BL$EX{GPF17{{EXBLK ! 16279: {{IFF{BL$IC{GPF02{{ICBLK ! 16280: {{IFF{BL$NM{GPF10{{NMBLK ! 16281: {{IFF{BL$P0{GPF10{{P0BLK ! 16282: {{IFF{BL$P1{GPF12{{P1BLK ! 16283: {{IFF{BL$P2{GPF12{{P2BLK ! 16284: {{IFF{BL$RC{GPF02{{RCBLK ! 16285: {{IFF{BL$SC{GPF02{{SCBLK ! 16286: {{IFF{BL$SE{GPF02{{SEBLK ! 16287: {{IFF{BL$TB{GPF08{{TBBLK ! 16288: {{IFF{BL$VC{GPF08{{VCBLK ! 16289: {{IFF{BL$XN{GPF02{{XNBLK ! 16290: {{IFF{BL$XR{GPF09{{XRBLK ! 16291: {{IFF{BL$PD{GPF13{{PDBLK ! 16292: {{IFF{BL$TR{GPF16{{TRBLK ! 16293: {{IFF{BL$BF{GPF02{{BFBLK ! 16294: {{IFF{BL$CC{GPF07{{CCBLK ! 16295: {{IFF{BL$CM{GPF04{{CMBLK ! 16296: {{IFF{BL$CT{GPF02{{CTBLK ! 16297: {{IFF{BL$DF{GPF02{{DFBLK ! 16298: {{IFF{BL$EF{GPF02{{EFBLK ! 16299: {{IFF{BL$EV{GPF10{{EVBLK ! 16300: {{IFF{BL$FF{GPF11{{FFBLK ! 16301: {{IFF{BL$KV{GPF02{{KVBLK ! 16302: {{IFF{BL$PF{GPF14{{PFBLK ! 16303: {{IFF{BL$TE{GPF15{{TEBLK ! 16304: {{ESW{{{{END OF JUMP TABLE ! 16305: {{EJC{{{{ ! 16306: * ! 16307: * GBCPF (CONTINUED) ! 16308: * ! 16309: * CMBLK ! 16310: * ! 16311: {GPF04{MOV{4*CMLEN(R9){R6{{LOAD LENGTH ! 16312: {{MOV{#4*CMTYP{R7{{SET OFFSET ! 16313: * ! 16314: * HERE TO PUSH DOWN TO NEW LEVEL ! 16315: * ! 16316: * (WC) FIELD PTR AT PREVIOUS LEVEL ! 16317: * (XR) PTR TO NEW BLOCK ! 16318: * (WA) LENGTH (RELOC FLDS + FLDS AT START) ! 16319: * (WB) OFFSET TO FIRST RELOC FIELD ! 16320: * ! 16321: {GPF05{ADD{R9{R6{{POINT PAST LAST RELOC FIELD ! 16322: {{ADD{R7{R9{{POINT TO FIRST RELOC FIELD ! 16323: {{MOV{R8{-(SP){{STACK OLD FIELD POINTER ! 16324: {{MOV{R6{-(SP){{STACK NEW LIMIT POINTER ! 16325: {{CHK{{{{CHECK FOR STACK OVERFLOW ! 16326: {{BRN{GPF01{{{IF OK, BACK TO PROCESS ! 16327: * ! 16328: * ARBLK ! 16329: * ! 16330: {GPF06{MOV{4*ARLEN(R9){R6{{LOAD LENGTH ! 16331: {{MOV{4*AROFS(R9){R7{{SET OFFSET TO 1ST RELOC FLD (ARPRO) ! 16332: {{BRN{GPF05{{{ALL SET ! 16333: * ! 16334: * CCBLK ! 16335: * ! 16336: {GPF07{MOV{4*CCUSE(R9){R6{{SET LENGTH IN USE ! 16337: {{MOV{#4*CCUSE{R7{{1ST WORD (MAKE SURE AT LEAST ONE) ! 16338: {{BRN{GPF05{{{ALL SET ! 16339: {{EJC{{{{ ! 16340: * ! 16341: * GBCPF (CONTINUED) ! 16342: * ! 16343: * CDBLK, TBBLK, VCBLK ! 16344: * ! 16345: {GPF08{MOV{4*OFFS2(R9){R6{{LOAD LENGTH ! 16346: {{MOV{#4*OFFS3{R7{{SET OFFSET ! 16347: {{BRN{GPF05{{{JUMP BACK ! 16348: * ! 16349: * XRBLK ! 16350: * ! 16351: {GPF09{MOV{4*XRLEN(R9){R6{{LOAD LENGTH ! 16352: {{MOV{#4*XRPTR{R7{{SET OFFSET ! 16353: {{BRN{GPF05{{{JUMP BACK ! 16354: * ! 16355: * EVBLK, NMBLK, P0BLK ! 16356: * ! 16357: {GPF10{MOV{#4*OFFS2{R6{{POINT PAST SECOND FIELD ! 16358: {{MOV{#4*OFFS1{R7{{OFFSET IS ONE (ONLY RELOC FLD IS 2) ! 16359: {{BRN{GPF05{{{ALL SET ! 16360: * ! 16361: * FFBLK ! 16362: * ! 16363: {GPF11{MOV{#4*FFOFS{R6{{SET LENGTH ! 16364: {{MOV{#4*FFNXT{R7{{SET OFFSET ! 16365: {{BRN{GPF05{{{ALL SET ! 16366: * ! 16367: * P1BLK, P2BLK ! 16368: * ! 16369: {GPF12{MOV{#4*PARM2{R6{{LENGTH (PARM2 IS NON-RELOCATABLE) ! 16370: {{MOV{#4*PTHEN{R7{{SET OFFSET ! 16371: {{BRN{GPF05{{{ALL SET ! 16372: {{EJC{{{{ ! 16373: * ! 16374: * GBCPF (CONTINUED) ! 16375: * ! 16376: * PDBLK ! 16377: * ! 16378: {GPF13{MOV{4*PDDFP(R9){R10{{LOAD PTR TO DFBLK ! 16379: {{MOV{4*DFPDL(R10){R6{{GET PDBLK LENGTH ! 16380: {{MOV{#4*PDFLD{R7{{SET OFFSET ! 16381: {{BRN{GPF05{{{ALL SET ! 16382: * ! 16383: * PFBLK ! 16384: * ! 16385: {GPF14{MOV{#4*PFARG{R6{{LENGTH PAST LAST RELOC ! 16386: {{MOV{#4*PFCOD{R7{{OFFSET TO FIRST RELOC ! 16387: {{BRN{GPF05{{{ALL SET ! 16388: * ! 16389: * TEBLK ! 16390: * ! 16391: {GPF15{MOV{#4*TESI${R6{{SET LENGTH ! 16392: {{MOV{#4*TESUB{R7{{AND OFFSET ! 16393: {{BRN{GPF05{{{ALL SET ! 16394: * ! 16395: * TRBLK ! 16396: * ! 16397: {GPF16{MOV{#4*TRSI${R6{{SET LENGTH ! 16398: {{MOV{#4*TRVAL{R7{{AND OFFSET ! 16399: {{BRN{GPF05{{{ALL SET ! 16400: * ! 16401: * EXBLK ! 16402: * ! 16403: {GPF17{MOV{4*EXLEN(R9){R6{{LOAD LENGTH ! 16404: {{MOV{#4*EXFLC{R7{{SET OFFSET ! 16405: {{BRN{GPF05{{{JUMP BACK ! 16406: * ! 16407: * BCBLK ! 16408: * ! 16409: {GPF18{MOV{#4*BCSI${R6{{SET LENGTH ! 16410: {{MOV{#4*BCBUF{R7{{AND OFFSET ! 16411: {{BRN{GPF05{{{ALL SET ! 16412: {{ENP{{{{END PROCEDURE GBCPF ! 16413: {{EJC{{{{ ! 16414: * ! 16415: * GTARR -- GET ARRAY ! 16416: * ! 16417: * GTARR IS PASSED AN OBJECT AND RETURNS AN ARRAY IF POSSIBL ! 16418: * ! 16419: * (XR) VALUE TO BE CONVERTED ! 16420: * JSR GTARR CALL TO GET ARRAY ! 16421: * PPM LOC TRANSFER LOC FOR CONVERT IMPOSSIBLE ! 16422: * (XR) RESULTING ARRAY ! 16423: * (XL,WA,WB,WC) DESTROYED ! 16424: * ! 16425: {GTARR{PRC{E{1{{ENTRY POINT ! 16426: {{MOV{(R9){R6{{LOAD TYPE WORD ! 16427: {{BEQ{R6{#B$ART{GTAR8{EXIT IF ALREADY AN ARRAY ! 16428: {{BEQ{R6{#B$VCT{GTAR8{EXIT IF ALREADY AN ARRAY ! 16429: {{BNE{R6{#B$TBT{GTA9A{ELSE FAIL IF NOT A TABLE (SGD02) ! 16430: * ! 16431: * HERE WE CONVERT A TABLE TO AN ARRAY ! 16432: * ! 16433: {{MOV{R9{-(SP){{REPLACE TBBLK POINTER ON STACK ! 16434: {{ZER{R9{{{SIGNAL FIRST PASS ! 16435: {{ZER{R7{{{ZERO NON-NULL ELEMENT COUNT ! 16436: * ! 16437: * THE FOLLOWING CODE IS EXECUTED TWICE. ON THE FIRST PASS, ! 16438: * SIGNALLED BY XR=0, THE NUMBER OF NON-NULL ELEMENTS IN ! 16439: * THE TABLE IS COUNTED IN WB. IN THE SECOND PASS, WHERE ! 16440: * XR IS A POINTER INTO THE ARBLK, THE NAME AND VALUE ARE ! 16441: * ENTERED INTO THE CURRENT ARBLK LOCATION. ! 16442: * ! 16443: {GTAR1{MOV{(SP){R10{{POINT TO TABLE ! 16444: {{ADD{4*TBLEN(R10){R10{{POINT PAST LAST BUCKET ! 16445: {{SUB{#4*TBBUK{R10{{SET FIRST BUCKET OFFSET ! 16446: {{MOV{R10{R6{{COPY ADJUSTED POINTER ! 16447: * ! 16448: * LOOP THROUGH BUCKETS IN TABLE BLOCK ! 16449: * NEXT THREE LINES OF CODE RELY ON TENXT HAVING A VALUE ! 16450: * 1 LESS THAN TBBUK. ! 16451: * ! 16452: {GTAR2{MOV{R6{R10{{COPY BUCKET POINTER ! 16453: {{DCA{R6{{{DECREMENT BUCKET POINTER ! 16454: * ! 16455: * LOOP THROUGH TEBLKS ON ONE BUCKET CHAIN ! 16456: * ! 16457: {GTAR3{MOV{4*TENXT(R10){R10{{POINT TO NEXT TEBLK ! 16458: {{BEQ{R10{(SP){GTAR6{JUMP IF CHAIN END (TBBLK PTR) ! 16459: {{MOV{R10{CNVTP{{ELSE SAVE TEBLK POINTER ! 16460: * ! 16461: * LOOP TO FIND VALUE DOWN TRBLK CHAIN ! 16462: * ! 16463: {GTAR4{MOV{4*TEVAL(R10){R10{{LOAD VALUE ! 16464: {{BEQ{(R10){#B$TRT{GTAR4{LOOP TILL VALUE FOUND ! 16465: {{MOV{R10{R8{{COPY VALUE ! 16466: {{MOV{CNVTP{R10{{RESTORE TEBLK POINTER ! 16467: {{EJC{{{{ ! 16468: * ! 16469: * GTARR (CONTINUED) ! 16470: * ! 16471: * NOW CHECK FOR NULL AND TEST CASES ! 16472: * ! 16473: {{BEQ{R8{#NULLS{GTAR3{LOOP BACK TO IGNORE NULL VALUE ! 16474: {{BNZ{R9{GTAR5{{JUMP IF SECOND PASS ! 16475: {{ICV{R7{{{FOR THE FIRST PASS, BUMP COUNT ! 16476: {{BRN{GTAR3{{{AND LOOP BACK FOR NEXT TEBLK ! 16477: * ! 16478: * HERE IN SECOND PASS ! 16479: * ! 16480: {GTAR5{MOV{4*TESUB(R10){(R9)+{{STORE SUBSCRIPT NAME ! 16481: {{MOV{R8{(R9)+{{STORE VALUE IN ARBLK ! 16482: {{BRN{GTAR3{{{LOOP BACK FOR NEXT TEBLK ! 16483: * ! 16484: * HERE AFTER SCANNING TEBLKS ON ONE CHAIN ! 16485: * ! 16486: {GTAR6{BNE{R6{(SP){GTAR2{LOOP BACK IF MORE BUCKETS TO GO ! 16487: {{BNZ{R9{GTAR7{{ELSE JUMP IF SECOND PASS ! 16488: * ! 16489: * HERE AFTER COUNTING NON-NULL ELEMENTS ! 16490: * ! 16491: {{BZE{R7{GTAR9{{FAIL IF NO NON-NULL ELEMENTS ! 16492: {{MOV{R7{R6{{ELSE COPY COUNT ! 16493: {{ADD{R7{R6{{DOUBLE (TWO WORDS/ELEMENT) ! 16494: {{ADD{#ARVL2{R6{{ADD SPACE FOR STANDARD FIELDS ! 16495: {{WTB{R6{{{CONVERT LENGTH TO BYTES ! 16496: {{BGE{R6{MXLEN{GTAR9{FAIL IF TOO LONG FOR ARRAY ! 16497: {{JSR{ALLOC{{{ELSE ALLOCATE SPACE FOR ARBLK ! 16498: {{MOV{#B$ART{(R9){{STORE TYPE WORD ! 16499: {{ZER{4*IDVAL(R9){{{ZERO ID FOR THE MOMENT ! 16500: {{MOV{R6{4*ARLEN(R9){{STORE LENGTH ! 16501: {{MOV{#NUM02{4*ARNDM(R9){{SET DIMENSIONS = 2 ! 16502: {{LDI{INTV1{{{GET INTEGER ONE ! 16503: {{STI{4*ARLBD(R9){{{STORE AS LBD 1 ! 16504: {{STI{4*ARLB2(R9){{{STORE AS LBD 2 ! 16505: {{LDI{INTV2{{{LOAD INTEGER TWO ! 16506: {{STI{4*ARDM2(R9){{{STORE AS DIM 2 ! 16507: {{MTI{R7{{{GET ELEMENT COUNT AS INTEGER ! 16508: {{STI{4*ARDIM(R9){{{STORE AS DIM 1 ! 16509: {{ZER{4*ARPR2(R9){{{ZERO PROTOTYPE FIELD FOR NOW ! 16510: {{MOV{#4*ARPR2{4*AROFS(R9){{SET OFFSET FIELD (SIGNAL PASS 2) ! 16511: {{MOV{R9{R7{{SAVE ARBLK POINTER ! 16512: {{ADD{#4*ARVL2{R9{{POINT TO FIRST ELEMENT LOCATION ! 16513: {{BRN{GTAR1{{{JUMP BACK TO FILL IN ELEMENTS ! 16514: {{EJC{{{{ ! 16515: * ! 16516: * GTARR (CONTINUED) ! 16517: * ! 16518: * HERE AFTER FILLING IN ELEMENT VALUES ! 16519: * ! 16520: {GTAR7{MOV{R7{R9{{RESTORE ARBLK POINTER ! 16521: {{MOV{R7{(SP){{STORE AS RESULT ! 16522: * ! 16523: * NOW WE NEED THE ARRAY PROTOTYPE WHICH IS OF THE FORM NN,2 ! 16524: * THIS IS OBTAINED BY BUILDING THE STRING FOR NN02 AND ! 16525: * CHANGING THE ZERO TO A COMMA BEFORE STORING IT. ! 16526: * ! 16527: {{LDI{4*ARDIM(R9){{{GET NUMBER OF ELEMENTS (NN) ! 16528: {{MLI{INTVH{{{MULTIPLY BY 100 ! 16529: {{ADI{INTV2{{{ADD 2 (NN02) ! 16530: {{JSR{ICBLD{{{BUILD INTEGER ! 16531: {{MOV{R9{-(SP){{STORE PTR FOR GTSTG ! 16532: {{JSR{GTSTG{{{CONVERT TO STRING ! 16533: {{PPM{{{{CONVERT FAIL IS IMPOSSIBLE ! 16534: {{MOV{R9{R10{{COPY STRING POINTER ! 16535: {{MOV{(SP)+{R9{{RELOAD ARBLK POINTER ! 16536: {{MOV{R10{4*ARPR2(R9){{STORE PROTOTYPE PTR (NN02) ! 16537: {{SUB{#NUM02{R6{{ADJUST LENGTH TO POINT TO ZERO ! 16538: {{PSC{R10{R6{{POINT TO ZERO ! 16539: {{MOV{#CH$CM{R7{{LOAD A COMMA ! 16540: {{SCH{R7{(R10){{STORE A COMMA OVER THE ZERO ! 16541: {{CSC{R10{{{COMPLETE STORE CHARACTERS ! 16542: * ! 16543: * NORMAL RETURN ! 16544: * ! 16545: {GTAR8{EXI{{{{RETURN TO CALLER ! 16546: * ! 16547: * NON-CONVERSION RETURN ! 16548: * ! 16549: {GTAR9{MOV{(SP)+{R9{{RESTORE STACK FOR CONV ERR (SGD02) ! 16550: * ! 16551: * MERGE TO TAKE CONVERT ERROR WHEN STACK ADJUSTED OK ! 16552: * ! 16553: {GTA9A{EXI{1{{{RETURN ! 16554: {{ENP{{{{PROCEDURE GTARR ! 16555: {{EJC{{{{ ! 16556: * ! 16557: * GTCOD -- CONVERT TO CODE ! 16558: * ! 16559: * (XR) OBJECT TO BE CONVERTED ! 16560: * JSR GTCOD CALL TO CONVERT TO CODE ! 16561: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE ! 16562: * (XR) POINTER TO RESULTING CDBLK ! 16563: * (XL,WA,WB,WC,RA) DESTROYED ! 16564: * ! 16565: * IF A SPITBOL ERROR OCCURS DURING COMPILATION OR PRE- ! 16566: * EVALUATION, CONTROL IS PASSED VIA ERROR SECTION TO EXFAL ! 16567: * WITHOUT RETURNING TO THIS ROUTINE. ! 16568: * ! 16569: {GTCOD{PRC{E{1{{ENTRY POINT ! 16570: {{BEQ{(R9){#B$CDS{GTCD1{JUMP IF ALREADY CODE ! 16571: {{BEQ{(R9){#B$CDC{GTCD1{JUMP IF ALREADY CODE ! 16572: * ! 16573: * HERE WE MUST GENERATE A CDBLK BY COMPILATION ! 16574: * ! 16575: {{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG ! 16576: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING ! 16577: {{PPM{GTCD2{{{JUMP IF NON-CONVERTIBLE ! 16578: {{MOV{FLPTR{GTCEF{{SAVE FAIL PTR IN CASE OF ERROR ! 16579: {{MOV{R$COD{R$GTC{{ALSO SAVE CODE PTR ! 16580: {{MOV{R9{R$CIM{{ELSE SET IMAGE POINTER ! 16581: {{MOV{R6{SCNIL{{SET IMAGE LENGTH ! 16582: {{ZER{SCNPT{{{SET SCAN POINTER ! 16583: {{MOV{#STGXC{STAGE{{SET STAGE FOR EXECUTE COMPILE ! 16584: {{MOV{CMPSN{LSTSN{{IN CASE LISTR CALLED ! 16585: {{JSR{CMPIL{{{COMPILE STRING ! 16586: {{MOV{#STGXT{STAGE{{RESET STAGE FOR EXECUTE TIME ! 16587: {{ZER{R$CIM{{{CLEAR IMAGE ! 16588: * ! 16589: * MERGE HERE IF NO CONVERT REQUIRED ! 16590: * ! 16591: {GTCD1{EXI{{{{GIVE NORMAL GTCOD RETURN ! 16592: * ! 16593: * HERE IF UNCONVERTIBLE ! 16594: * ! 16595: {GTCD2{EXI{1{{{GIVE ERROR RETURN ! 16596: {{ENP{{{{END PROCEDURE GTCOD ! 16597: {{EJC{{{{ ! 16598: * ! 16599: * GTEXP -- CONVERT TO EXPRESSION ! 16600: * ! 16601: * (XR) INPUT VALUE TO BE CONVERTED ! 16602: * JSR GTEXP CALL TO CONVERT TO EXPRESSION ! 16603: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE ! 16604: * (XR) POINTER TO RESULT EXBLK OR SEBLK ! 16605: * (XL,WA,WB,WC,RA) DESTROYED ! 16606: * ! 16607: * IF A SPITBOL ERROR OCCURS DURING COMPILATION OR PRE- ! 16608: * EVALUATION, CONTROL IS PASSED VIA ERROR SECTION TO EXFAL ! 16609: * WITHOUT RETURNING TO THIS ROUTINE. ! 16610: * ! 16611: {GTEXP{PRC{E{1{{ENTRY POINT ! 16612: {{BLO{(R9){#B$E$${GTEX1{JUMP IF ALREADY AN EXPRESSION ! 16613: {{MOV{R9{-(SP){{STORE ARGUMENT FOR GTSTG ! 16614: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING ! 16615: {{PPM{GTEX2{{{JUMP IF UNCONVERTIBLE ! 16616: * ! 16617: * CHECK THE LAST CHARACTER OF THE STRING FOR COLON OR ! 16618: * SEMICOLON. THESE CHARACTERS CAN LEGITIMATELY END AN ! 16619: * EXPRESSION IN OPEN CODE, SO EXPAN WILL NOT DETECT THEM ! 16620: * AS ERRORS, BUT THEY ARE INVALID AS TERMINATORS FOR A ! 16621: * STRING THAT IS BEING CONVERTED TO EXPRESSION FORM. ! 16622: * ! 16623: {{MOV{R9{R10{{COPY INPUT STRING POINTER (REG06) ! 16624: {{PLC{R10{R6{{POINT ONE PAST THE STRING END (REG06) ! 16625: {{LCH{R10{-(R10){{FETCH THE LAST CHARACTER (REG06) ! 16626: {{BEQ{R10{#CH$CL{GTEX2{ERROR IF IT IS A SEMICOLON (REG06) ! 16627: {{BEQ{R10{#CH$SM{GTEX2{OR IF IT IS A COLON (REG06) ! 16628: * ! 16629: * HERE WE CONVERT A STRING BY COMPILATION ! 16630: * ! 16631: {{MOV{R9{R$CIM{{SET INPUT IMAGE POINTER ! 16632: {{ZER{SCNPT{{{SET SCAN POINTER ! 16633: {{MOV{R6{SCNIL{{SET INPUT IMAGE LENGTH ! 16634: {{ZER{R7{{{SET CODE FOR NORMAL SCAN ! 16635: {{MOV{FLPTR{GTCEF{{SAVE FAIL PTR IN CASE OF ERROR ! 16636: {{MOV{R$COD{R$GTC{{ALSO SAVE CODE PTR ! 16637: {{MOV{#STGEV{STAGE{{ADJUST STAGE FOR COMPILE ! 16638: {{MOV{#T$UOK{SCNTP{{INDICATE UNARY OPERATOR ACCEPTABLE ! 16639: {{JSR{EXPAN{{{BUILD TREE FOR EXPRESSION ! 16640: {{ZER{SCNRS{{{RESET RESCAN FLAG ! 16641: {{BNE{SCNPT{SCNIL{GTEX2{ERROR IF NOT END OF IMAGE ! 16642: {{ZER{R7{{{SET OK VALUE FOR CDGEX CALL ! 16643: {{MOV{R9{R10{{COPY TREE POINTER ! 16644: {{JSR{CDGEX{{{BUILD EXPRESSION BLOCK ! 16645: {{ZER{R$CIM{{{CLEAR POINTER ! 16646: {{MOV{#STGXT{STAGE{{RESTORE STAGE FOR EXECUTE TIME ! 16647: * ! 16648: * MERGE HERE IF NO CONVERSION REQUIRED ! 16649: * ! 16650: {GTEX1{EXI{{{{RETURN TO GTEXP CALLER ! 16651: * ! 16652: * HERE IF UNCONVERTIBLE ! 16653: * ! 16654: {GTEX2{EXI{1{{{TAKE ERROR EXIT ! 16655: {{ENP{{{{END PROCEDURE GTEXP ! 16656: {{EJC{{{{ ! 16657: * ! 16658: * GTINT -- GET INTEGER VALUE ! 16659: * ! 16660: * GTINT IS PASSED AN OBJECT AND RETURNS AN INTEGER AFTER ! 16661: * PERFORMING ANY NECESSARY CONVERSIONS. ! 16662: * ! 16663: * (XR) VALUE TO BE CONVERTED ! 16664: * JSR GTINT CALL TO CONVERT TO INTEGER ! 16665: * PPM LOC TRANSFER LOC FOR CONVERT IMPOSSIBLE ! 16666: * (XR) RESULTING INTEGER ! 16667: * (WC,RA) DESTROYED ! 16668: * (WA,WB) DESTROYED (ONLY ON CONVERSION ERR) ! 16669: * (XR) UNCHANGED (ON CONVERT ERROR) ! 16670: * ! 16671: {GTINT{PRC{E{1{{ENTRY POINT ! 16672: {{BEQ{(R9){#B$ICL{GTIN2{JUMP IF ALREADY AN INTEGER ! 16673: {{MOV{R6{GTINA{{ELSE SAVE WA ! 16674: {{MOV{R7{GTINB{{SAVE WB ! 16675: {{JSR{GTNUM{{{CONVERT TO NUMERIC ! 16676: {{PPM{GTIN3{{{JUMP IF UNCONVERTIBLE ! 16677: {{BEQ{R6{#B$ICL{GTIN1{JUMP IF INTEGER ! 16678: * ! 16679: * HERE WE CONVERT A REAL TO INTEGER ! 16680: * ! 16681: {{LDR{4*RCVAL(R9){{{LOAD REAL VALUE ! 16682: {{RTI{GTIN3{{{CONVERT TO INTEGER (ERR IF OVFLOW) ! 16683: {{JSR{ICBLD{{{IF OK BUILD ICBLK ! 16684: * ! 16685: * HERE AFTER SUCCESSFUL CONVERSION TO INTEGER ! 16686: * ! 16687: {GTIN1{MOV{GTINA{R6{{RESTORE WA ! 16688: {{MOV{GTINB{R7{{RESTORE WB ! 16689: * ! 16690: * COMMON EXIT POINT ! 16691: * ! 16692: {GTIN2{EXI{{{{RETURN TO GTINT CALLER ! 16693: * ! 16694: * HERE ON CONVERSION ERROR ! 16695: * ! 16696: {GTIN3{EXI{1{{{TAKE CONVERT ERROR EXIT ! 16697: {{ENP{{{{END PROCEDURE GTINT ! 16698: {{EJC{{{{ ! 16699: * ! 16700: * GTNUM -- GET NUMERIC VALUE ! 16701: * ! 16702: * GTNUM IS GIVEN AN OBJECT AND RETURNS EITHER AN INTEGER ! 16703: * OR A REAL, PERFORMING ANY NECESSARY CONVERSIONS. ! 16704: * ! 16705: * (XR) OBJECT TO BE CONVERTED ! 16706: * JSR GTNUM CALL TO CONVERT TO NUMERIC ! 16707: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE ! 16708: * (XR) POINTER TO RESULT (INT OR REAL) ! 16709: * (WA) FIRST WORD OF RESULT BLOCK ! 16710: * (WB,WC,RA) DESTROYED ! 16711: * (XR) UNCHANGED (ON CONVERT ERROR) ! 16712: * ! 16713: {GTNUM{PRC{E{1{{ENTRY POINT ! 16714: {{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK ! 16715: {{BEQ{R6{#B$ICL{GTN34{JUMP IF INTEGER (NO CONVERSION) ! 16716: {{BEQ{R6{#B$RCL{GTN34{JUMP IF REAL (NO CONVERSION) ! 16717: * ! 16718: * AT THIS POINT THE ONLY POSSIBILITY IS TO CONVERT A STRING ! 16719: * TO AN INTEGER OR REAL AS APPROPRIATE. ! 16720: * ! 16721: {{MOV{R9{-(SP){{STACK ARGUMENT IN CASE CONVERT ERR ! 16722: {{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG ! 16723: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING ! 16724: {{PPM{GTN36{{{JUMP IF UNCONVERTIBLE ! 16725: * ! 16726: * INITIALIZE NUMERIC CONVERSION ! 16727: * ! 16728: {{LDI{INTV0{{{INITIALIZE INTEGER RESULT TO ZERO ! 16729: {{BZE{R6{GTN32{{JUMP TO EXIT WITH ZERO IF NULL ! 16730: {{LCT{R6{R6{{SET BCT COUNTER FOR FOLLOWING LOOPS ! 16731: {{ZER{GTNNF{{{TENTATIVELY INDICATE RESULT + ! 16732: {{STI{GTNEX{{{INITIALISE EXPONENT TO ZERO ! 16733: {{ZER{GTNSC{{{ZERO SCALE IN CASE REAL ! 16734: {{ZER{GTNDF{{{RESET FLAG FOR DEC POINT FOUND ! 16735: {{ZER{GTNRD{{{RESET FLAG FOR DIGITS FOUND ! 16736: {{LDR{REAV0{{{ZERO REAL ACCUM IN CASE REAL ! 16737: {{PLC{R9{{{POINT TO ARGUMENT CHARACTERS ! 16738: * ! 16739: * MERGE BACK HERE AFTER IGNORING LEADING BLANK ! 16740: * ! 16741: {GTN01{LCH{R7{(R9)+{{LOAD FIRST CHARACTER ! 16742: {{BLT{R7{#CH$D0{GTN02{JUMP IF NOT DIGIT ! 16743: {{BLE{R7{#CH$D9{GTN06{JUMP IF FIRST CHAR IS A DIGIT ! 16744: {{EJC{{{{ ! 16745: * ! 16746: * GTNUM (CONTINUED) ! 16747: * ! 16748: * HERE IF FIRST DIGIT IS NON-DIGIT ! 16749: * ! 16750: {GTN02{BNE{R7{#CH$BL{GTN03{JUMP IF NON-BLANK ! 16751: {GTNA2{BCT{R6{GTN01{{ELSE DECR COUNT AND LOOP BACK ! 16752: {{BRN{GTN07{{{JUMP TO RETURN ZERO IF ALL BLANKS ! 16753: * ! 16754: * HERE FOR FIRST CHARACTER NON-BLANK, NON-DIGIT ! 16755: * ! 16756: {GTN03{BEQ{R7{#CH$PL{GTN04{JUMP IF PLUS SIGN ! 16757: {{BEQ{R7{#CH$HT{GTNA2{HORIZONTAL TAB EQUIV TO BLANK ! 16758: {{BNE{R7{#CH$MN{GTN12{JUMP IF NOT MINUS (MAY BE REAL) ! 16759: {{MNZ{GTNNF{{{IF MINUS SIGN, SET NEGATIVE FLAG ! 16760: * ! 16761: * MERGE HERE AFTER PROCESSING SIGN ! 16762: * ! 16763: {GTN04{BCT{R6{GTN05{{JUMP IF CHARS LEFT ! 16764: {{BRN{GTN36{{{ELSE ERROR ! 16765: * ! 16766: * LOOP TO FETCH CHARACTERS OF AN INTEGER ! 16767: * ! 16768: {GTN05{LCH{R7{(R9)+{{LOAD NEXT CHARACTER ! 16769: {{BLT{R7{#CH$D0{GTN08{JUMP IF NOT A DIGIT ! 16770: {{BGT{R7{#CH$D9{GTN08{JUMP IF NOT A DIGIT ! 16771: * ! 16772: * MERGE HERE FOR FIRST DIGIT ! 16773: * ! 16774: {GTN06{STI{GTNSI{{{SAVE CURRENT VALUE ! 16775: {{CVM{GTN35{{{CURRENT*10-(NEW DIG) JUMP IF OVFLOW ! 16776: {{MNZ{GTNRD{{{SET DIGIT READ FLAG ! 16777: {{BCT{R6{GTN05{{ELSE LOOP BACK IF MORE CHARS ! 16778: * ! 16779: * HERE TO EXIT WITH CONVERTED INTEGER VALUE ! 16780: * ! 16781: {GTN07{BNZ{GTNNF{GTN32{{JUMP IF NEGATIVE (ALL SET) ! 16782: {{NGI{{{{ELSE NEGATE ! 16783: {{INO{GTN32{{{JUMP IF NO OVERFLOW ! 16784: {{BRN{GTN36{{{ELSE SIGNAL ERROR ! 16785: {{EJC{{{{ ! 16786: * ! 16787: * GTNUM (CONTINUED) ! 16788: * ! 16789: * HERE FOR A NON-DIGIT CHARACTER WHILE ATTEMPTING TO ! 16790: * CONVERT AN INTEGER, CHECK FOR TRAILING BLANKS OR REAL. ! 16791: * ! 16792: {GTN08{BEQ{R7{#CH$BL{GTNA9{JUMP IF A BLANK ! 16793: {{BEQ{R7{#CH$HT{GTNA9{JUMP IF HORIZONTAL TAB ! 16794: {{ITR{{{{ELSE CONVERT INTEGER TO REAL ! 16795: {{NGR{{{{NEGATE TO GET POSITIVE VALUE ! 16796: {{BRN{GTN12{{{JUMP TO TRY FOR REAL ! 16797: * ! 16798: * HERE WE SCAN OUT BLANKS TO END OF STRING ! 16799: * ! 16800: {GTN09{LCH{R7{(R9)+{{GET NEXT CHAR ! 16801: {{BEQ{R7{#CH$HT{GTNA9{JUMP IF HORIZONTAL TAB ! 16802: {{BNE{R7{#CH$BL{GTN36{ERROR IF NON-BLANK ! 16803: {GTNA9{BCT{R6{GTN09{{LOOP BACK IF MORE CHARS TO CHECK ! 16804: {{BRN{GTN07{{{RETURN INTEGER IF ALL BLANKS ! 16805: * ! 16806: * LOOP TO COLLECT MANTISSA OF REAL ! 16807: * ! 16808: {GTN10{LCH{R7{(R9)+{{LOAD NEXT CHARACTER ! 16809: {{BLT{R7{#CH$D0{GTN12{JUMP IF NON-NUMERIC ! 16810: {{BGT{R7{#CH$D9{GTN12{JUMP IF NON-NUMERIC ! 16811: * ! 16812: * MERGE HERE TO COLLECT FIRST REAL DIGIT ! 16813: * ! 16814: {GTN11{SUB{#CH$D0{R7{{CONVERT DIGIT TO NUMBER ! 16815: {{MLR{REAVT{{{MULTIPLY REAL BY 10.0 ! 16816: {{ROV{GTN36{{{CONVERT ERROR IF OVERFLOW ! 16817: {{STR{GTNSR{{{SAVE RESULT ! 16818: {{MTI{R7{{{GET NEW DIGIT AS INTEGER ! 16819: {{ITR{{{{CONVERT NEW DIGIT TO REAL ! 16820: {{ADR{GTNSR{{{ADD TO GET NEW TOTAL ! 16821: {{ADD{GTNDF{GTNSC{{INCREMENT SCALE IF AFTER DEC POINT ! 16822: {{MNZ{GTNRD{{{SET DIGIT FOUND FLAG ! 16823: {{BCT{R6{GTN10{{LOOP BACK IF MORE CHARS ! 16824: {{BRN{GTN22{{{ELSE JUMP TO SCALE ! 16825: {{EJC{{{{ ! 16826: * ! 16827: * GTNUM (CONTINUED) ! 16828: * ! 16829: * HERE IF NON-DIGIT FOUND WHILE COLLECTING A REAL ! 16830: * ! 16831: {GTN12{BNE{R7{#CH$DT{GTN13{JUMP IF NOT DEC POINT ! 16832: {{BNZ{GTNDF{GTN36{{IF DEC POINT, ERROR IF ONE ALREADY ! 16833: {{MOV{#NUM01{GTNDF{{ELSE SET FLAG FOR DEC POINT ! 16834: {{BCT{R6{GTN10{{LOOP BACK IF MORE CHARS ! 16835: {{BRN{GTN22{{{ELSE JUMP TO SCALE ! 16836: * ! 16837: * HERE IF NOT DECIMAL POINT ! 16838: * ! 16839: {GTN13{BEQ{R7{#CH$LE{GTN15{JUMP IF E FOR EXPONENT ! 16840: {{BEQ{R7{#CH$LD{GTN15{JUMP IF D FOR EXPONENT ! 16841: {{BEQ{R7{#CH$$E{GTN15{JUMP IF E FOR EXPONENT ! 16842: {{BEQ{R7{#CH$$D{GTN15{JUMP IF D FOR EXPONENT ! 16843: * ! 16844: * HERE CHECK FOR TRAILING BLANKS ! 16845: * ! 16846: {GTN14{BEQ{R7{#CH$BL{GTNB4{JUMP IF BLANK ! 16847: {{BEQ{R7{#CH$HT{GTNB4{JUMP IF HORIZONTAL TAB ! 16848: {{BRN{GTN36{{{ERROR IF NON-BLANK ! 16849: * ! 16850: {GTNB4{LCH{R7{(R9)+{{GET NEXT CHARACTER ! 16851: {{BCT{R6{GTN14{{LOOP BACK TO CHECK IF MORE ! 16852: {{BRN{GTN22{{{ELSE JUMP TO SCALE ! 16853: * ! 16854: * HERE TO READ AND PROCESS AN EXPONENT ! 16855: * ! 16856: {GTN15{ZER{GTNES{{{SET EXPONENT SIGN POSITIVE ! 16857: {{LDI{INTV0{{{INITIALIZE EXPONENT TO ZERO ! 16858: {{MNZ{GTNDF{{{RESET NO DEC POINT INDICATION ! 16859: {{BCT{R6{GTN16{{JUMP SKIPPING PAST E OR D ! 16860: {{BRN{GTN36{{{ERROR IF NULL EXPONENT ! 16861: * ! 16862: * CHECK FOR EXPONENT SIGN ! 16863: * ! 16864: {GTN16{LCH{R7{(R9)+{{LOAD FIRST EXPONENT CHARACTER ! 16865: {{BEQ{R7{#CH$PL{GTN17{JUMP IF PLUS SIGN ! 16866: {{BNE{R7{#CH$MN{GTN19{ELSE JUMP IF NOT MINUS SIGN ! 16867: {{MNZ{GTNES{{{SET SIGN NEGATIVE IF MINUS SIGN ! 16868: * ! 16869: * MERGE HERE AFTER PROCESSING EXPONENT SIGN ! 16870: * ! 16871: {GTN17{BCT{R6{GTN18{{JUMP IF CHARS LEFT ! 16872: {{BRN{GTN36{{{ELSE ERROR ! 16873: * ! 16874: * LOOP TO CONVERT EXPONENT DIGITS ! 16875: * ! 16876: {GTN18{LCH{R7{(R9)+{{LOAD NEXT CHARACTER ! 16877: {{EJC{{{{ ! 16878: * ! 16879: * GTNUM (CONTINUED) ! 16880: * ! 16881: * MERGE HERE FOR FIRST EXPONENT DIGIT ! 16882: * ! 16883: {GTN19{BLT{R7{#CH$D0{GTN20{JUMP IF NOT DIGIT ! 16884: {{BGT{R7{#CH$D9{GTN20{JUMP IF NOT DIGIT ! 16885: {{CVM{GTN36{{{ELSE CURRENT*10, SUBTRACT NEW DIGIT ! 16886: {{BCT{R6{GTN18{{LOOP BACK IF MORE CHARS ! 16887: {{BRN{GTN21{{{JUMP IF EXPONENT FIELD IS EXHAUSTED ! 16888: * ! 16889: * HERE TO CHECK FOR TRAILING BLANKS AFTER EXPONENT ! 16890: * ! 16891: {GTN20{BEQ{R7{#CH$BL{GTNC0{JUMP IF BLANK ! 16892: {{BEQ{R7{#CH$HT{GTNC0{JUMP IF HORIZONTAL TAB ! 16893: {{BRN{GTN36{{{ERROR IF NON-BLANK ! 16894: * ! 16895: {GTNC0{LCH{R7{(R9)+{{GET NEXT CHARACTER ! 16896: {{BCT{R6{GTN20{{LOOP BACK TILL ALL BLANKS SCANNED ! 16897: * ! 16898: * MERGE HERE AFTER COLLECTING EXPONENT ! 16899: * ! 16900: {GTN21{STI{GTNEX{{{SAVE COLLECTED EXPONENT ! 16901: {{BNZ{GTNES{GTN22{{JUMP IF IT WAS NEGATIVE ! 16902: {{NGI{{{{ELSE COMPLEMENT ! 16903: {{IOV{GTN36{{{ERROR IF OVERFLOW ! 16904: {{STI{GTNEX{{{AND STORE POSITIVE EXPONENT ! 16905: * ! 16906: * MERGE HERE WITH EXPONENT (0 IF NONE GIVEN) ! 16907: * ! 16908: {GTN22{BZE{GTNRD{GTN36{{ERROR IF NOT DIGITS COLLECTED ! 16909: {{BZE{GTNDF{GTN36{{ERROR IF NO EXPONENT OR DEC POINT ! 16910: {{MTI{GTNSC{{{ELSE LOAD SCALE AS INTEGER ! 16911: {{SBI{GTNEX{{{SUBTRACT EXPONENT ! 16912: {{IOV{GTN36{{{ERROR IF OVERFLOW ! 16913: {{ILT{GTN26{{{JUMP IF WE MUST SCALE UP ! 16914: * ! 16915: * HERE WE HAVE A NEGATIVE EXPONENT, SO SCALE DOWN ! 16916: * ! 16917: {{MFI{R6{GTN36{{LOAD SCALE FACTOR, ERR IF OVFLOW ! 16918: * ! 16919: * LOOP TO SCALE DOWN IN STEPS OF 10**10 ! 16920: * ! 16921: {GTN23{BLE{R6{#NUM10{GTN24{JUMP IF 10 OR LESS TO GO ! 16922: {{DVR{REATT{{{ELSE DIVIDE BY 10**10 ! 16923: {{SUB{#NUM10{R6{{DECREMENT SCALE ! 16924: {{BRN{GTN23{{{AND LOOP BACK ! 16925: {{EJC{{{{ ! 16926: * ! 16927: * GTNUM (CONTINUED) ! 16928: * ! 16929: * HERE SCALE REST OF WAY FROM POWERS OF TEN TABLE ! 16930: * ! 16931: {GTN24{BZE{R6{GTN30{{JUMP IF SCALED ! 16932: {{LCT{R7{#CFP$R{{ELSE GET INDEXING FACTOR ! 16933: {{MOV{#REAV1{R9{{POINT TO POWERS OF TEN TABLE ! 16934: {{WTB{R6{{{CONVERT REMAINING SCALE TO BYTE OFS ! 16935: * ! 16936: * LOOP TO POINT TO POWERS OF TEN TABLE ENTRY ! 16937: * ! 16938: {GTN25{ADD{R6{R9{{BUMP POINTER ! 16939: {{BCT{R7{GTN25{{ONCE FOR EACH VALUE WORD ! 16940: {{DVR{(R9){{{SCALE DOWN AS REQUIRED ! 16941: {{BRN{GTN30{{{AND JUMP ! 16942: * ! 16943: * COME HERE TO SCALE RESULT UP (POSITIVE EXPONENT) ! 16944: * ! 16945: {GTN26{NGI{{{{GET ABSOLUTE VALUE OF EXPONENT ! 16946: {{IOV{GTN36{{{ERROR IF OVERFLOW ! 16947: {{MFI{R6{GTN36{{ACQUIRE SCALE, ERROR IF OVFLOW ! 16948: * ! 16949: * LOOP TO SCALE UP IN STEPS OF 10**10 ! 16950: * ! 16951: {GTN27{BLE{R6{#NUM10{GTN28{JUMP IF 10 OR LESS TO GO ! 16952: {{MLR{REATT{{{ELSE MULTIPLY BY 10**10 ! 16953: {{ROV{GTN36{{{ERROR IF OVERFLOW ! 16954: {{SUB{#NUM10{R6{{ELSE DECREMENT SCALE ! 16955: {{BRN{GTN27{{{AND LOOP BACK ! 16956: * ! 16957: * HERE TO SCALE UP REST OF WAY WITH TABLE ! 16958: * ! 16959: {GTN28{BZE{R6{GTN30{{JUMP IF SCALED ! 16960: {{LCT{R7{#CFP$R{{ELSE GET INDEXING FACTOR ! 16961: {{MOV{#REAV1{R9{{POINT TO POWERS OF TEN TABLE ! 16962: {{WTB{R6{{{CONVERT REMAINING SCALE TO BYTE OFS ! 16963: * ! 16964: * LOOP TO POINT TO PROPER ENTRY IN POWERS OF TEN TABLE ! 16965: * ! 16966: {GTN29{ADD{R6{R9{{BUMP POINTER ! 16967: {{BCT{R7{GTN29{{ONCE FOR EACH WORD IN VALUE ! 16968: {{MLR{(R9){{{SCALE UP ! 16969: {{ROV{GTN36{{{ERROR IF OVERFLOW ! 16970: {{EJC{{{{ ! 16971: * ! 16972: * GTNUM (CONTINUED) ! 16973: * ! 16974: * HERE WITH REAL VALUE SCALED AND READY EXCEPT FOR SIGN ! 16975: * ! 16976: {GTN30{BZE{GTNNF{GTN31{{JUMP IF POSITIVE ! 16977: {{NGR{{{{ELSE NEGATE ! 16978: * ! 16979: * HERE WITH PROPERLY SIGNED REAL VALUE IN (RA) ! 16980: * ! 16981: {GTN31{JSR{RCBLD{{{BUILD REAL BLOCK ! 16982: {{BRN{GTN33{{{MERGE TO EXIT ! 16983: * ! 16984: * HERE WITH PROPERLY SIGNED INTEGER VALUE IN (IA) ! 16985: * ! 16986: {GTN32{JSR{ICBLD{{{BUILD ICBLK ! 16987: * ! 16988: * REAL MERGES HERE ! 16989: * ! 16990: {GTN33{MOV{(R9){R6{{LOAD FIRST WORD OF RESULT BLOCK ! 16991: {{ICA{SP{{{POP ARGUMENT OFF STACK ! 16992: * ! 16993: * COMMON EXIT POINT ! 16994: * ! 16995: {GTN34{EXI{{{{RETURN TO GTNUM CALLER ! 16996: * ! 16997: * COME HERE IF OVERFLOW OCCURS DURING COLLECTION OF INTEGER ! 16998: * ! 16999: {GTN35{LDI{GTNSI{{{RELOAD INTEGER SO FAR ! 17000: {{ITR{{{{CONVERT TO REAL ! 17001: {{NGR{{{{MAKE VALUE POSITIVE ! 17002: {{BRN{GTN11{{{MERGE WITH REAL CIRCUIT ! 17003: * ! 17004: * HERE FOR UNCONVERTIBLE TO STRING OR CONVERSION ERROR ! 17005: * ! 17006: {GTN36{MOV{(SP)+{R9{{RELOAD ORIGINAL ARGUMENT ! 17007: {{EXI{1{{{TAKE CONVERT-ERROR EXIT ! 17008: {{ENP{{{{END PROCEDURE GTNUM ! 17009: {{EJC{{{{ ! 17010: * ! 17011: * GTNVR -- CONVERT TO NATURAL VARIABLE ! 17012: * ! 17013: * GTNVR LOCATES A VARIABLE BLOCK (VRBLK) GIVEN EITHER AN ! 17014: * APPROPRIATE NAME (NMBLK) OR A NON-NULL STRING (SCBLK). ! 17015: * ! 17016: * (XR) ARGUMENT ! 17017: * JSR GTNVR CALL TO CONVERT TO NATURAL VARIABLE ! 17018: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE ! 17019: * (XR) POINTER TO VRBLK ! 17020: * (WA,WB) DESTROYED (CONVERSION ERROR ONLY) ! 17021: * (WC) DESTROYED ! 17022: * ! 17023: {GTNVR{PRC{E{1{{ENTRY POINT ! 17024: {{BNE{(R9){#B$NML{GNV02{JUMP IF NOT NAME ! 17025: {{MOV{4*NMBAS(R9){R9{{ELSE LOAD NAME BASE IF NAME ! 17026: {{BLO{R9{STATE{GNV07{SKIP IF VRBLK (IN STATIC REGION) ! 17027: * ! 17028: * COMMON ERROR EXIT ! 17029: * ! 17030: {GNV01{EXI{1{{{TAKE CONVERT-ERROR EXIT ! 17031: * ! 17032: * HERE IF NOT NAME ! 17033: * ! 17034: {GNV02{MOV{R6{GNVSA{{SAVE WA ! 17035: {{MOV{R7{GNVSB{{SAVE WB ! 17036: {{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG ! 17037: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING ! 17038: {{PPM{GNV01{{{JUMP IF CONVERSION ERROR ! 17039: {{BZE{R6{GNV01{{NULL STRING IS AN ERROR ! 17040: {{JSR{FLSTG{{{FOLD LOWER CASE TO UPPER CASE ! 17041: {{MOV{R10{-(SP){{SAVE XL ! 17042: {{MOV{R9{-(SP){{STACK STRING PTR FOR LATER ! 17043: {{MOV{R9{R7{{COPY STRING POINTER ! 17044: {{ADD{#4*SCHAR{R7{{POINT TO CHARACTERS OF STRING ! 17045: {{MOV{R7{GNVST{{SAVE POINTER TO CHARACTERS ! 17046: {{MOV{R6{R7{{COPY LENGTH ! 17047: {{CTW{R7{0{{GET NUMBER OF WORDS IN NAME ! 17048: {{MOV{R7{GNVNW{{SAVE FOR LATER ! 17049: {{JSR{HASHS{{{COMPUTE HASH INDEX FOR STRING ! 17050: {{RMI{HSHNB{{{COMPUTE HASH OFFSET BY TAKING MOD ! 17051: {{MFI{R8{{{GET AS OFFSET ! 17052: {{WTB{R8{{{CONVERT OFFSET TO BYTES ! 17053: {{ADD{HSHTB{R8{{POINT TO PROPER HASH CHAIN ! 17054: {{SUB{#4*VRNXT{R8{{SUBTRACT OFFSET TO MERGE INTO LOOP ! 17055: {{EJC{{{{ ! 17056: * ! 17057: * GTNVR (CONTINUED) ! 17058: * ! 17059: * LOOP TO SEARCH HASH CHAIN ! 17060: * ! 17061: {GNV03{MOV{R8{R10{{COPY HASH CHAIN POINTER ! 17062: {{MOV{4*VRNXT(R10){R10{{POINT TO NEXT VRBLK ON CHAIN ! 17063: {{BZE{R10{GNV08{{JUMP IF END OF CHAIN ! 17064: {{MOV{R10{R8{{SAVE POINTER TO THIS VRBLK ! 17065: {{BNZ{4*VRLEN(R10){GNV04{{JUMP IF NOT SYSTEM VARIABLE ! 17066: {{MOV{4*VRSVP(R10){R10{{ELSE POINT TO SVBLK ! 17067: {{SUB{#4*VRSOF{R10{{ADJUST OFFSET FOR MERGE ! 17068: * ! 17069: * MERGE HERE WITH STRING PTR (LIKE VRBLK) IN XL ! 17070: * ! 17071: {GNV04{BNE{R6{4*VRLEN(R10){GNV03{BACK FOR NEXT VRBLK IF LENGTHS NE ! 17072: {{ADD{#4*VRCHS{R10{{ELSE POINT TO CHARS OF CHAIN ENTRY ! 17073: {{LCT{R7{GNVNW{{GET WORD COUNTER TO CONTROL LOOP ! 17074: {{MOV{GNVST{R9{{POINT TO CHARS OF NEW NAME ! 17075: * ! 17076: * LOOP TO COMPARE CHARACTERS OF THE TWO NAMES ! 17077: * ! 17078: {GNV05{CNE{(R9){(R10){GNV03{JUMP IF NO MATCH FOR NEXT VRBLK ! 17079: {{ICA{R9{{{BUMP NEW NAME POINTER ! 17080: {{ICA{R10{{{BUMP VRBLK IN CHAIN NAME POINTER ! 17081: {{BCT{R7{GNV05{{ELSE LOOP TILL ALL COMPARED ! 17082: {{MOV{R8{R9{{WE HAVE FOUND A MATCH, GET VRBLK ! 17083: * ! 17084: * EXIT POINT AFTER FINDING VRBLK OR BUILDING NEW ONE ! 17085: * ! 17086: {GNV06{MOV{GNVSA{R6{{RESTORE WA ! 17087: {{MOV{GNVSB{R7{{RESTORE WB ! 17088: {{ICA{SP{{{POP STRING POINTER ! 17089: {{MOV{(SP)+{R10{{RESTORE XL ! 17090: * ! 17091: * COMMON EXIT POINT ! 17092: * ! 17093: {GNV07{EXI{{{{RETURN TO GTNVR CALLER ! 17094: * ! 17095: * NOT FOUND, PREPARE TO SEARCH SYSTEM VARIABLE TABLE ! 17096: * ! 17097: {GNV08{ZER{R9{{{CLEAR GARBAGE XR POINTER ! 17098: {{MOV{R8{GNVHE{{SAVE PTR TO END OF HASH CHAIN ! 17099: {{BGT{R6{#NUM09{GNV14{CANNOT BE SYSTEM VAR IF LENGTH GT 9 ! 17100: {{MOV{R6{R10{{ELSE COPY LENGTH ! 17101: {{WTB{R10{{{CONVERT TO BYTE OFFSET ! 17102: {{MOV{L^VSRCH(R10){R10{{POINT TO FIRST SVBLK OF THIS LENGTH ! 17103: {{EJC{{{{ ! 17104: * ! 17105: * GTNVR (CONTINUED) ! 17106: * ! 17107: * LOOP TO SEARCH ENTRIES IN STANDARD VARIABLE TABLE ! 17108: * ! 17109: {GNV09{MOV{R10{GNVSP{{SAVE TABLE POINTER ! 17110: {{MOV{(R10)+{R8{{LOAD SVBIT BIT STRING ! 17111: {{MOV{(R10)+{R7{{LOAD LENGTH FROM TABLE ENTRY ! 17112: {{BNE{R6{R7{GNV14{JUMP IF END OF RIGHT LENGTH ENTIRES ! 17113: {{LCT{R7{GNVNW{{GET WORD COUNTER TO CONTROL LOOP ! 17114: {{MOV{GNVST{R9{{POINT TO CHARS OF NEW NAME ! 17115: * ! 17116: * LOOP TO CHECK FOR MATCHING NAMES ! 17117: * ! 17118: {GNV10{CNE{(R9){(R10){GNV11{JUMP IF NAME MISMATCH ! 17119: {{ICA{R9{{{ELSE BUMP NEW NAME POINTER ! 17120: {{ICA{R10{{{BUMP SVBLK POINTER ! 17121: {{BCT{R7{GNV10{{ELSE LOOP UNTIL ALL CHECKED ! 17122: * ! 17123: * HERE WE HAVE A MATCH IN THE STANDARD VARIABLE TABLE ! 17124: * ! 17125: {{ZER{R8{{{SET VRLEN VALUE ZERO ! 17126: {{MOV{#4*VRSI${R6{{SET STANDARD SIZE ! 17127: {{BRN{GNV15{{{JUMP TO BUILD VRBLK ! 17128: * ! 17129: * HERE IF NO MATCH WITH TABLE ENTRY IN SVBLKS TABLE ! 17130: * ! 17131: {GNV11{ICA{R10{{{BUMP PAST WORD OF CHARS ! 17132: {{BCT{R7{GNV11{{LOOP BACK IF MORE TO GO ! 17133: {{RSH{R8{SVNBT{{REMOVE UNINTERESTING BITS ! 17134: * ! 17135: * LOOP TO BUMP TABLE PTR FOR EACH FLAGGED WORD ! 17136: * ! 17137: {GNV12{MOV{BITS1{R7{{LOAD BIT TO TEST ! 17138: {{ANB{R8{R7{{TEST FOR WORD PRESENT ! 17139: {{ZRB{R7{GNV13{{JUMP IF NOT PRESENT ! 17140: {{ICA{R10{{{ELSE BUMP TABLE POINTER ! 17141: * ! 17142: * HERE AFTER DEALING WITH ONE WORD (ONE BIT) ! 17143: * ! 17144: {GNV13{RSH{R8{1{{REMOVE BIT ALREADY PROCESSED ! 17145: {{NZB{R8{GNV12{{LOOP BACK IF MORE BITS TO TEST ! 17146: {{BRN{GNV09{{{ELSE LOOP BACK FOR NEXT SVBLK ! 17147: * ! 17148: * HERE IF NOT SYSTEM VARIABLE ! 17149: * ! 17150: {GNV14{MOV{R6{R8{{COPY VRLEN VALUE ! 17151: {{MOV{#VRCHS{R6{{LOAD STANDARD SIZE -CHARS ! 17152: {{ADD{GNVNW{R6{{ADJUST FOR CHARS OF NAME ! 17153: {{WTB{R6{{{CONVERT LENGTH TO BYTES ! 17154: {{EJC{{{{ ! 17155: * ! 17156: * GTNVR (CONTINUED) ! 17157: * ! 17158: * MERGE HERE TO BUILD VRBLK ! 17159: * ! 17160: {GNV15{JSR{ALOST{{{ALLOCATE SPACE FOR VRBLK (STATIC) ! 17161: {{MOV{R9{R7{{SAVE VRBLK POINTER ! 17162: {{MOV{#STNVR{R10{{POINT TO MODEL VARIABLE BLOCK ! 17163: {{MOV{#4*VRLEN{R6{{SET LENGTH OF STANDARD FIELDS ! 17164: {{MVW{{{{SET INITIAL FIELDS OF NEW BLOCK ! 17165: {{MOV{GNVHE{R10{{LOAD POINTER TO END OF HASH CHAIN ! 17166: {{MOV{R7{4*VRNXT(R10){{ADD NEW BLOCK TO END OF CHAIN ! 17167: {{MOV{R8{(R9)+{{SET VRLEN FIELD, BUMP PTR ! 17168: {{MOV{GNVNW{R6{{GET LENGTH IN WORDS ! 17169: {{WTB{R6{{{CONVERT TO LENGTH IN BYTES ! 17170: {{BZE{R8{GNV16{{JUMP IF SYSTEM VARIABLE ! 17171: * ! 17172: * HERE FOR NON-SYSTEM VARIABLE -- SET CHARS OF NAME ! 17173: * ! 17174: {{MOV{(SP){R10{{POINT BACK TO STRING NAME ! 17175: {{ADD{#4*SCHAR{R10{{POINT TO CHARS OF NAME ! 17176: {{MVW{{{{MOVE CHARACTERS INTO PLACE ! 17177: {{MOV{R7{R9{{RESTORE VRBLK POINTER ! 17178: {{BRN{GNV06{{{JUMP BACK TO EXIT ! 17179: * ! 17180: * HERE FOR SYSTEM VARIABLE CASE TO FILL IN FIELDS WHERE ! 17181: * NECESSARY FROM THE FIELDS PRESENT IN THE SVBLK. ! 17182: * ! 17183: {GNV16{MOV{GNVSP{R10{{LOAD POINTER TO SVBLK ! 17184: {{MOV{R10{(R9){{SET SVBLK PTR IN VRBLK ! 17185: {{MOV{R7{R9{{RESTORE VRBLK POINTER ! 17186: {{MOV{4*SVBIT(R10){R7{{LOAD BIT INDICATORS ! 17187: {{ADD{#4*SVCHS{R10{{POINT TO CHARACTERS OF NAME ! 17188: {{ADD{R6{R10{{POINT PAST CHARACTERS ! 17189: * ! 17190: * SKIP PAST KEYWORD NUMBER (SVKNM) IF PRESENT ! 17191: * ! 17192: {{MOV{BTKNM{R8{{LOAD TEST BIT ! 17193: {{ANB{R7{R8{{AND TO TEST ! 17194: {{ZRB{R8{GNV17{{JUMP IF NO KEYWORD NUMBER ! 17195: {{ICA{R10{{{ELSE BUMP POINTER ! 17196: {{EJC{{{{ ! 17197: * ! 17198: * GTNVR (CONTINUED) ! 17199: * ! 17200: * HERE TEST FOR FUNCTION (SVFNC AND SVNAR) ! 17201: * ! 17202: {GNV17{MOV{BTFNC{R8{{GET TEST BIT ! 17203: {{ANB{R7{R8{{AND TO TEST ! 17204: {{ZRB{R8{GNV18{{SKIP IF NO SYSTEM FUNCTION ! 17205: {{MOV{R10{4*VRFNC(R9){{ELSE POINT VRFNC TO SVFNC FIELD ! 17206: {{ADD{#4*NUM02{R10{{AND BUMP PAST SVFNC, SVNAR FIELDS ! 17207: * ! 17208: * NOW TEST FOR LABEL (SVLBL) ! 17209: * ! 17210: {GNV18{MOV{BTLBL{R8{{GET TEST BIT ! 17211: {{ANB{R7{R8{{AND TO TEST ! 17212: {{ZRB{R8{GNV19{{JUMP IF BIT IS OFF (NO SYSTEM LABL) ! 17213: {{MOV{R10{4*VRLBL(R9){{ELSE POINT VRLBL TO SVLBL FIELD ! 17214: {{ICA{R10{{{BUMP PAST SVLBL FIELD ! 17215: * ! 17216: * NOW TEST FOR VALUE (SVVAL) ! 17217: * ! 17218: {GNV19{MOV{BTVAL{R8{{LOAD TEST BIT ! 17219: {{ANB{R7{R8{{AND TO TEST ! 17220: {{ZRB{R8{GNV06{{ALL DONE IF NO VALUE ! 17221: {{MOV{(R10){4*VRVAL(R9){{ELSE SET INITIAL VALUE ! 17222: {{MOV{#B$VRE{4*VRSTO(R9){{SET ERROR STORE ACCESS ! 17223: {{BRN{GNV06{{{MERGE BACK TO EXIT TO CALLER ! 17224: {{ENP{{{{END PROCEDURE GTNVR ! 17225: {{EJC{{{{ ! 17226: * ! 17227: * GTPAT -- GET PATTERN ! 17228: * ! 17229: * GTPAT IS PASSED AN OBJECT IN (XR) AND RETURNS A ! 17230: * PATTERN AFTER PERFORMING ANY NECESSARY CONVERSIONS ! 17231: * ! 17232: * (XR) INPUT ARGUMENT ! 17233: * JSR GTPAT CALL TO CONVERT TO PATTERN ! 17234: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE ! 17235: * (XR) RESULTING PATTERN ! 17236: * (WA) DESTROYED ! 17237: * (WB) DESTROYED (ONLY ON CONVERT ERROR) ! 17238: * (XR) UNCHANGED (ONLY ON CONVERT ERROR) ! 17239: * ! 17240: {GTPAT{PRC{E{1{{ENTRY POINT ! 17241: {{BHI{(R9){#P$AAA{GTPT5{JUMP IF PATTERN ALREADY ! 17242: * ! 17243: * HERE IF NOT PATTERN, TRY FOR STRING ! 17244: * ! 17245: {{MOV{R7{GTPSB{{SAVE WB ! 17246: {{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG ! 17247: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING ! 17248: {{PPM{GTPT2{{{JUMP IF IMPOSSIBLE ! 17249: * ! 17250: * HERE WE HAVE A STRING ! 17251: * ! 17252: {{BNZ{R6{GTPT1{{JUMP IF NON-NULL ! 17253: * ! 17254: * HERE FOR NULL STRING. GENERATE POINTER TO NULL PATTERN. ! 17255: * ! 17256: {{MOV{#NDNTH{R9{{POINT TO NOTHEN NODE ! 17257: {{BRN{GTPT4{{{JUMP TO EXIT ! 17258: {{EJC{{{{ ! 17259: * ! 17260: * GTPAT (CONTINUED) ! 17261: * ! 17262: * HERE FOR NON-NULL STRING ! 17263: * ! 17264: {GTPT1{MOV{#P$STR{R7{{LOAD PCODE FOR MULTI-CHAR STRING ! 17265: {{BNE{R6{#NUM01{GTPT3{JUMP IF MULTI-CHAR STRING ! 17266: * ! 17267: * HERE FOR ONE CHARACTER STRING, SHARE ONE CHARACTER ANY ! 17268: * ! 17269: {{PLC{R9{{{POINT TO CHARACTER ! 17270: {{LCH{R6{(R9){{LOAD CHARACTER ! 17271: {{MOV{R6{R9{{SET AS PARM1 ! 17272: {{MOV{#P$ANS{R7{{POINT TO PCODE FOR 1-CHAR ANY ! 17273: {{BRN{GTPT3{{{JUMP TO BUILD NODE ! 17274: * ! 17275: * HERE IF ARGUMENT IS NOT CONVERTIBLE TO STRING ! 17276: * ! 17277: {GTPT2{MOV{#P$EXA{R7{{SET PCODE FOR EXPRESSION IN CASE ! 17278: {{BLO{(R9){#B$E$${GTPT3{JUMP TO BUILD NODE IF EXPRESSION ! 17279: * ! 17280: * HERE WE HAVE AN ERROR (CONVERSION IMPOSSIBLE) ! 17281: * ! 17282: {{EXI{1{{{TAKE CONVERT ERROR EXIT ! 17283: * ! 17284: * MERGE HERE TO BUILD NODE FOR STRING OR EXPRESSION ! 17285: * ! 17286: {GTPT3{JSR{PBILD{{{CALL ROUTINE TO BUILD PATTERN NODE ! 17287: * ! 17288: * COMMON EXIT AFTER SUCCESSFUL CONVERSION ! 17289: * ! 17290: {GTPT4{MOV{GTPSB{R7{{RESTORE WB ! 17291: * ! 17292: * MERGE HERE TO EXIT OF NO CONVERSION REQUIRED ! 17293: * ! 17294: {GTPT5{EXI{{{{RETURN TO GTPAT CALLER ! 17295: {{ENP{{{{END PROCEDURE GTPAT ! 17296: {{EJC{{{{ ! 17297: * ! 17298: * GTREA -- GET REAL VALUE ! 17299: * ! 17300: * GTREA IS PASSED AN OBJECT AND RETURNS A REAL VALUE ! 17301: * PERFORMING ANY NECESSARY CONVERSIONS. ! 17302: * ! 17303: * (XR) OBJECT TO BE CONVERTED ! 17304: * JSR GTREA CALL TO CONVERT OBJECT TO REAL ! 17305: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE ! 17306: * (XR) POINTER TO RESULTING REAL ! 17307: * (WA,WB,WC,RA) DESTROYED ! 17308: * (XR) UNCHANGED (CONVERT ERROR ONLY) ! 17309: * ! 17310: {GTREA{PRC{E{1{{ENTRY POINT ! 17311: {{MOV{(R9){R6{{GET FIRST WORD OF BLOCK ! 17312: {{BEQ{R6{#B$RCL{GTRE2{JUMP IF REAL ! 17313: {{JSR{GTNUM{{{ELSE CONVERT ARGUMENT TO NUMERIC ! 17314: {{PPM{GTRE3{{{JUMP IF UNCONVERTIBLE ! 17315: {{BEQ{R6{#B$RCL{GTRE2{JUMP IF REAL WAS RETURNED ! 17316: * ! 17317: * HERE FOR CASE OF AN INTEGER TO CONVERT TO REAL ! 17318: * ! 17319: {GTRE1{LDI{4*ICVAL(R9){{{LOAD INTEGER ! 17320: {{ITR{{{{CONVERT TO REAL ! 17321: {{JSR{RCBLD{{{BUILD RCBLK ! 17322: * ! 17323: * EXIT WITH REAL ! 17324: * ! 17325: {GTRE2{EXI{{{{RETURN TO GTREA CALLER ! 17326: * ! 17327: * HERE ON CONVERSION ERROR ! 17328: * ! 17329: {GTRE3{EXI{1{{{TAKE CONVERT ERROR EXIT ! 17330: {{ENP{{{{END PROCEDURE GTREA ! 17331: {{EJC{{{{ ! 17332: * ! 17333: * GTSMI -- GET SMALL INTEGER ! 17334: * ! 17335: * GTSMI IS PASSED A SNOBOL OBJECT AND RETURNS AN ADDRESS ! 17336: * INTEGER IN THE RANGE (0 LE N LE DNAMB). SUCH A VALUE CAN ! 17337: * ONLY BE DERIVED FROM AN INTEGER IN THE APPROPRIATE RANGE. ! 17338: * SMALL INTEGERS NEVER APPEAR AS SNOBOL VALUES. HOWEVER, ! 17339: * THEY ARE USED INTERNALLY FOR A VARIETY OF PURPOSES. ! 17340: * ! 17341: * -(XS) ARGUMENT TO CONVERT (ON STACK) ! 17342: * JSR GTSMI CALL TO CONVERT TO SMALL INTEGER ! 17343: * PPM LOC TRANSFER LOC FOR NOT INTEGER ! 17344: * PPM LOC TRANSFER LOC FOR LT 0, GT DNAMB ! 17345: * (XR,WC) RESULTING SMALL INT (TWO COPIES) ! 17346: * (XS) POPPED ! 17347: * (RA) DESTROYED ! 17348: * (WA,WB) DESTROYED (ON CONVERT ERROR ONLY) ! 17349: * (XR) INPUT ARG (CONVERT ERROR ONLY) ! 17350: * ! 17351: {GTSMI{PRC{N{2{{ENTRY POINT ! 17352: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 17353: {{BEQ{(R9){#B$ICL{GTSM1{SKIP IF ALREADY AN INTEGER ! 17354: * ! 17355: * HERE IF NOT AN INTEGER ! 17356: * ! 17357: {{JSR{GTINT{{{CONVERT ARGUMENT TO INTEGER ! 17358: {{PPM{GTSM2{{{JUMP IF CONVERT IS IMPOSSIBLE ! 17359: * ! 17360: * MERGE HERE WITH INTEGER ! 17361: * ! 17362: {GTSM1{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE ! 17363: {{MFI{R8{GTSM3{{MOVE AS ONE WORD, JUMP IF OVFLOW ! 17364: {{BGT{R8{MXLEN{GTSM3{OR IF TOO SMALL ! 17365: {{MOV{R8{R9{{COPY RESULT TO XR ! 17366: {{EXI{{{{RETURN TO GTSMI CALLER ! 17367: * ! 17368: * HERE IF UNCONVERTIBLE TO INTEGER ! 17369: * ! 17370: {GTSM2{EXI{1{{{TAKE NON-INTEGER ERROR EXIT ! 17371: * ! 17372: * HERE IF OUT OF RANGE ! 17373: * ! 17374: {GTSM3{EXI{2{{{TAKE OUT-OF-RANGE ERROR EXIT ! 17375: {{ENP{{{{END PROCEDURE GTSMI ! 17376: {{EJC{{{{ ! 17377: * ! 17378: * GTSTG -- GET STRING ! 17379: * ! 17380: * GTSTG IS PASSED AN OBJECT AND RETURNS A STRING WITH ! 17381: * ANY NECESSARY CONVERSIONS PERFORMED. ! 17382: * ! 17383: * -(XS) INPUT ARGUMENT (ON STACK) ! 17384: * JSR GTSTG CALL TO CONVERT TO STRING ! 17385: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE ! 17386: * (XR) POINTER TO RESULTING STRING ! 17387: * (WA) LENGTH OF STRING IN CHARACTERS ! 17388: * (XS) POPPED ! 17389: * (RA) DESTROYED ! 17390: * (XR) INPUT ARG (CONVERT ERROR ONLY) ! 17391: * ! 17392: {GTSTG{PRC{N{1{{ENTRY POINT ! 17393: {{MOV{(SP)+{R9{{LOAD ARGUMENT, POP STACK ! 17394: {{BEQ{(R9){#B$SCL{GTS30{JUMP IF ALREADY A STRING ! 17395: * ! 17396: * HERE IF NOT A STRING ALREADY ! 17397: * ! 17398: {GTS01{MOV{R9{-(SP){{RESTACK ARGUMENT IN CASE ERROR ! 17399: {{MOV{R10{-(SP){{SAVE XL ! 17400: {{MOV{R7{GTSVB{{SAVE WB ! 17401: {{MOV{R8{GTSVC{{SAVE WC ! 17402: {{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK ! 17403: {{BEQ{R6{#B$ICL{GTS05{JUMP TO CONVERT INTEGER ! 17404: {{BEQ{R6{#B$RCL{GTS10{JUMP TO CONVERT REAL ! 17405: {{BEQ{R6{#B$NML{GTS03{JUMP TO CONVERT NAME ! 17406: {{BEQ{R6{#B$BCT{GTS32{JUMP TO CONVERT BUFFER ! 17407: * ! 17408: * HERE ON CONVERSION ERROR ! 17409: * ! 17410: {GTS02{MOV{(SP)+{R10{{RESTORE XL ! 17411: {{MOV{(SP)+{R9{{RELOAD INPUT ARGUMENT ! 17412: {{EXI{1{{{TAKE CONVERT ERROR EXIT ! 17413: {{EJC{{{{ ! 17414: * ! 17415: * GTSTG (CONTINUED) ! 17416: * ! 17417: * HERE TO CONVERT A NAME (ONLY POSSIBLE IF NATURAL VAR) ! 17418: * ! 17419: {GTS03{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE ! 17420: {{BHI{R10{STATE{GTS02{ERROR IF NOT NATURAL VAR (STATIC) ! 17421: {{ADD{#4*VRSOF{R10{{ELSE POINT TO POSSIBLE STRING NAME ! 17422: {{MOV{4*SCLEN(R10){R6{{LOAD LENGTH ! 17423: {{BNZ{R6{GTS04{{JUMP IF NOT SYSTEM VARIABLE ! 17424: {{MOV{4*VRSVO(R10){R10{{ELSE POINT TO SVBLK ! 17425: {{MOV{4*SVLEN(R10){R6{{AND LOAD NAME LENGTH ! 17426: * ! 17427: * MERGE HERE WITH STRING IN XR, LENGTH IN WA ! 17428: * ! 17429: {GTS04{ZER{R7{{{SET OFFSET TO ZERO ! 17430: {{JSR{SBSTR{{{USE SBSTR TO COPY STRING ! 17431: {{BRN{GTS29{{{JUMP TO EXIT ! 17432: * ! 17433: * COME HERE TO CONVERT AN INTEGER ! 17434: * ! 17435: {GTS05{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE ! 17436: {{MOV{#NUM01{GTSSF{{SET SIGN FLAG NEGATIVE ! 17437: {{ILT{GTS06{{{SKIP IF INTEGER IS NEGATIVE ! 17438: {{NGI{{{{ELSE NEGATE INTEGER ! 17439: {{ZER{GTSSF{{{AND RESET NEGATIVE FLAG ! 17440: {{EJC{{{{ ! 17441: * ! 17442: * GTSTG (CONTINUED) ! 17443: * ! 17444: * HERE WITH SIGN FLAG SET AND SIGN FORCED NEGATIVE AS ! 17445: * REQUIRED BY THE CVD INSTRUCTION. ! 17446: * ! 17447: {GTS06{MOV{GTSWK{R9{{POINT TO RESULT WORK AREA ! 17448: {{MOV{#NSTMX{R7{{INITIALIZE COUNTER TO MAX LENGTH ! 17449: {{PSC{R9{R7{{PREPARE TO STORE (RIGHT-LEFT) ! 17450: * ! 17451: * LOOP TO CONVERT DIGITS INTO WORK AREA ! 17452: * ! 17453: {GTS07{CVD{{{{CONVERT ONE DIGIT INTO WA ! 17454: {{SCH{R6{-(R9){{STORE IN WORK AREA ! 17455: {{DCV{R7{{{DECREMENT COUNTER ! 17456: {{INE{GTS07{{{LOOP IF MORE DIGITS TO GO ! 17457: {{CSC{R9{{{COMPLETE STORE CHARACTERS ! 17458: * ! 17459: * MERGE HERE AFTER CONVERTING INTEGER OR REAL INTO WORK ! 17460: * AREA. WB IS SET TO NSTMX - (NUMBER OF CHARS IN RESULT). ! 17461: * ! 17462: {GTS08{MOV{#NSTMX{R6{{GET MAX NUMBER OF CHARACTERS ! 17463: {{SUB{R7{R6{{COMPUTE LENGTH OF RESULT ! 17464: {{MOV{R6{R10{{REMEMBER LENGTH FOR MOVE LATER ON ! 17465: {{ADD{GTSSF{R6{{ADD ONE FOR NEGATIVE SIGN IF NEEDED ! 17466: {{JSR{ALOCS{{{ALLOCATE STRING FOR RESULT ! 17467: {{MOV{R9{R8{{SAVE RESULT POINTER FOR THE MOMENT ! 17468: {{PSC{R9{{{POINT TO CHARS OF RESULT BLOCK ! 17469: {{BZE{GTSSF{GTS09{{SKIP IF POSITIVE ! 17470: {{MOV{#CH$MN{R6{{ELSE LOAD NEGATIVE SIGN ! 17471: {{SCH{R6{(R9)+{{AND STORE IT ! 17472: {{CSC{R9{{{COMPLETE STORE CHARACTERS ! 17473: * ! 17474: * HERE AFTER DEALING WITH SIGN ! 17475: * ! 17476: {GTS09{MOV{R10{R6{{RECALL LENGTH TO MOVE ! 17477: {{MOV{GTSWK{R10{{POINT TO RESULT WORK AREA ! 17478: {{PLC{R10{R7{{POINT TO FIRST RESULT CHARACTER ! 17479: {{MVC{{{{MOVE CHARS TO RESULT STRING ! 17480: {{MOV{R8{R9{{RESTORE RESULT POINTER ! 17481: {{BRN{GTS29{{{JUMP TO EXIT ! 17482: {{EJC{{{{ ! 17483: * ! 17484: * GTSTG (CONTINUED) ! 17485: * ! 17486: * HERE TO CONVERT A REAL ! 17487: * ! 17488: {GTS10{LDR{4*RCVAL(R9){{{LOAD REAL ! 17489: {{ZER{GTSSF{{{RESET NEGATIVE FLAG ! 17490: {{REQ{GTS31{{{SKIP IF ZERO ! 17491: {{RGE{GTS11{{{JUMP IF REAL IS POSITIVE ! 17492: {{MOV{#NUM01{GTSSF{{ELSE SET NEGATIVE FLAG ! 17493: {{NGR{{{{AND GET ABSOLUTE VALUE OF REAL ! 17494: * ! 17495: * NOW SCALE THE REAL TO THE RANGE (0.1 LE X LT 1.0) ! 17496: * ! 17497: {GTS11{LDI{INTV0{{{INITIALIZE EXPONENT TO ZERO ! 17498: * ! 17499: * LOOP TO SCALE UP IN STEPS OF 10**10 ! 17500: * ! 17501: {GTS12{STR{GTSRS{{{SAVE REAL VALUE ! 17502: {{SBR{REAP1{{{SUBTRACT 0.1 TO COMPARE ! 17503: {{RGE{GTS13{{{JUMP IF SCALE UP NOT REQUIRED ! 17504: {{LDR{GTSRS{{{ELSE RELOAD VALUE ! 17505: {{MLR{REATT{{{MULTIPLY BY 10**10 ! 17506: {{SBI{INTVT{{{DECREMENT EXPONENT BY 10 ! 17507: {{BRN{GTS12{{{LOOP BACK TO TEST AGAIN ! 17508: * ! 17509: * TEST FOR SCALE DOWN REQUIRED ! 17510: * ! 17511: {GTS13{LDR{GTSRS{{{RELOAD VALUE ! 17512: {{SBR{REAV1{{{SUBTRACT 1.0 ! 17513: {{RLT{GTS17{{{JUMP IF NO SCALE DOWN REQUIRED ! 17514: {{LDR{GTSRS{{{ELSE RELOAD VALUE ! 17515: * ! 17516: * LOOP TO SCALE DOWN IN STEPS OF 10**10 ! 17517: * ! 17518: {GTS14{SBR{REATT{{{SUBTRACT 10**10 TO COMPARE ! 17519: {{RLT{GTS15{{{JUMP IF LARGE STEP NOT REQUIRED ! 17520: {{LDR{GTSRS{{{ELSE RESTORE VALUE ! 17521: {{DVR{REATT{{{DIVIDE BY 10**10 ! 17522: {{STR{GTSRS{{{STORE NEW VALUE ! 17523: {{ADI{INTVT{{{INCREMENT EXPONENT BY 10 ! 17524: {{BRN{GTS14{{{LOOP BACK ! 17525: {{EJC{{{{ ! 17526: * ! 17527: * GTSTG (CONTINUED) ! 17528: * ! 17529: * AT THIS POINT WE HAVE (1.0 LE X LT 10**10) ! 17530: * COMPLETE SCALING WITH POWERS OF TEN TABLE ! 17531: * ! 17532: {GTS15{MOV{#REAV1{R9{{POINT TO POWERS OF TEN TABLE ! 17533: * ! 17534: * LOOP TO LOCATE CORRECT ENTRY IN TABLE ! 17535: * ! 17536: {GTS16{LDR{GTSRS{{{RELOAD VALUE ! 17537: {{ADI{INTV1{{{INCREMENT EXPONENT ! 17538: {{ADD{#4*CFP$R{R9{{POINT TO NEXT ENTRY IN TABLE ! 17539: {{SBR{(R9){{{SUBTRACT IT TO COMPARE ! 17540: {{RGE{GTS16{{{LOOP TILL WE FIND A LARGER ENTRY ! 17541: {{LDR{GTSRS{{{THEN RELOAD THE VALUE ! 17542: {{DVR{(R9){{{AND COMPLETE SCALING ! 17543: {{STR{GTSRS{{{STORE VALUE ! 17544: * ! 17545: * WE ARE NOW SCALED, SO ROUND BY ADDING 0.5 * 10**(-CFP$S) ! 17546: * ! 17547: {GTS17{LDR{GTSRS{{{GET VALUE AGAIN ! 17548: {{ADR{GTSRN{{{ADD ROUNDING FACTOR ! 17549: {{STR{GTSRS{{{STORE RESULT ! 17550: * ! 17551: * THE ROUNDING OPERATION MAY HAVE PUSHED US UP PAST ! 17552: * 1.0 AGAIN, SO CHECK ONE MORE TIME. ! 17553: * ! 17554: {{SBR{REAV1{{{SUBTRACT 1.0 TO COMPARE ! 17555: {{RLT{GTS18{{{SKIP IF OK ! 17556: {{ADI{INTV1{{{ELSE INCREMENT EXPONENT ! 17557: {{LDR{GTSRS{{{RELOAD VALUE ! 17558: {{DVR{REAVT{{{DIVIDE BY 10.0 TO RESCALE ! 17559: {{BRN{GTS19{{{JUMP TO MERGE ! 17560: * ! 17561: * HERE IF ROUNDING DID NOT MUCK UP SCALING ! 17562: * ! 17563: {GTS18{LDR{GTSRS{{{RELOAD ROUNDED VALUE ! 17564: {{EJC{{{{ ! 17565: * ! 17566: * GTSTG (CONTINUED) ! 17567: * ! 17568: * NOW WE HAVE COMPLETED THE SCALING AS FOLLOWS ! 17569: * ! 17570: * (IA) SIGNED EXPONENT ! 17571: * (RA) SCALED REAL (ABSOLUTE VALUE) ! 17572: * ! 17573: * IF THE EXPONENT IS NEGATIVE OR GREATER THAN CFP$S, THEN ! 17574: * WE CONVERT THE NUMBER IN THE FORM. ! 17575: * ! 17576: * (NEG SIGN) 0 . (CPF$S DIGITS) E (EXP SIGN) (EXP DIGITS) ! 17577: * ! 17578: * IF THE EXPONENT IS POSITIVE AND LESS THAN OR EQUAL TO ! 17579: * CFP$S, THE NUMBER IS CONVERTED IN THE FORM. ! 17580: * ! 17581: * (NEG SIGN) (EXPONENT DIGITS) . (CFP$S-EXPONENT DIGITS) ! 17582: * ! 17583: * IN BOTH CASES, THE FORMATS OBTAINED FROM THE ABOVE ! 17584: * RULES ARE MODIFIED BY DELETING TRAILING ZEROS AFTER THE ! 17585: * DECIMAL POINT. THERE ARE NO LEADING ZEROS IN THE EXPONENT ! 17586: * AND THE EXPONENT SIGN IS ALWAYS PRESENT. ! 17587: * ! 17588: {GTS19{MOV{#CFP$S{R10{{SET NUM DEC DIGITS = CFP$S ! 17589: {{MOV{#CH$MN{GTSES{{SET EXPONENT SIGN NEGATIVE ! 17590: {{ILT{GTS21{{{ALL SET IF EXPONENT IS NEGATIVE ! 17591: {{MFI{R6{{{ELSE FETCH EXPONENT ! 17592: {{BLE{R6{#CFP$S{GTS20{SKIP IF WE CAN USE SPECIAL FORMAT ! 17593: {{MTI{R6{{{ELSE RESTORE EXPONENT ! 17594: {{NGI{{{{SET NEGATIVE FOR CVD ! 17595: {{MOV{#CH$PL{GTSES{{SET PLUS SIGN FOR EXPONENT SIGN ! 17596: {{BRN{GTS21{{{JUMP TO GENERATE EXPONENT ! 17597: * ! 17598: * HERE IF WE CAN USE THE FORMAT WITHOUT AN EXPONENT ! 17599: * ! 17600: {GTS20{SUB{R6{R10{{COMPUTE DIGITS AFTER DECIMAL POINT ! 17601: {{LDI{INTV0{{{RESET EXPONENT TO ZERO ! 17602: {{EJC{{{{ ! 17603: * ! 17604: * GTSTG (CONTINUED) ! 17605: * ! 17606: * MERGE HERE AS FOLLOWS ! 17607: * ! 17608: * (IA) EXPONENT ABSOLUTE VALUE ! 17609: * GTSES CHARACTER FOR EXPONENT SIGN ! 17610: * (RA) POSITIVE FRACTION ! 17611: * (XL) NUMBER OF DIGITS AFTER DEC POINT ! 17612: * ! 17613: {GTS21{MOV{GTSWK{R9{{POINT TO WORK AREA ! 17614: {{MOV{#NSTMX{R7{{SET CHARACTER CTR TO MAX LENGTH ! 17615: {{PSC{R9{R7{{PREPARE TO STORE (RIGHT TO LEFT) ! 17616: {{IEQ{GTS23{{{SKIP EXPONENT IF IT IS ZERO ! 17617: * ! 17618: * LOOP TO GENERATE DIGITS OF EXPONENT ! 17619: * ! 17620: {GTS22{CVD{{{{CONVERT A DIGIT INTO WA ! 17621: {{SCH{R6{-(R9){{STORE IN WORK AREA ! 17622: {{DCV{R7{{{DECREMENT COUNTER ! 17623: {{INE{GTS22{{{LOOP BACK IF MORE DIGITS TO GO ! 17624: * ! 17625: * HERE GENERATE EXPONENT SIGN AND E ! 17626: * ! 17627: {{MOV{GTSES{R6{{LOAD EXPONENT SIGN ! 17628: {{SCH{R6{-(R9){{STORE IN WORK AREA ! 17629: {{MOV{#CH$LE{R6{{GET CHARACTER LETTER E ! 17630: {{SCH{R6{-(R9){{STORE IN WORK AREA ! 17631: {{SUB{#NUM02{R7{{DECREMENT COUNTER FOR SIGN AND E ! 17632: * ! 17633: * HERE TO GENERATE THE FRACTION ! 17634: * ! 17635: {GTS23{MLR{GTSSC{{{CONVERT REAL TO INTEGER (10**CFP$S) ! 17636: {{RTI{{{{GET INTEGER (OVERFLOW IMPOSSIBLE) ! 17637: {{NGI{{{{NEGATE AS REQUIRED BY CVD ! 17638: * ! 17639: * LOOP TO SUPPRESS TRAILING ZEROS ! 17640: * ! 17641: {GTS24{BZE{R10{GTS27{{JUMP IF NO DIGITS LEFT TO DO ! 17642: {{CVD{{{{ELSE CONVERT ONE DIGIT ! 17643: {{BNE{R6{#CH$D0{GTS26{JUMP IF NOT A ZERO ! 17644: {{DCV{R10{{{DECREMENT COUNTER ! 17645: {{BRN{GTS24{{{LOOP BACK FOR NEXT DIGIT ! 17646: {{EJC{{{{ ! 17647: * ! 17648: * GTSTG (CONTINUED) ! 17649: * ! 17650: * LOOP TO GENERATE DIGITS AFTER DECIMAL POINT ! 17651: * ! 17652: {GTS25{CVD{{{{CONVERT A DIGIT INTO WA ! 17653: * ! 17654: * MERGE HERE FIRST TIME ! 17655: * ! 17656: {GTS26{SCH{R6{-(R9){{STORE DIGIT ! 17657: {{DCV{R7{{{DECREMENT COUNTER ! 17658: {{DCV{R10{{{DECREMENT COUNTER ! 17659: {{BNZ{R10{GTS25{{LOOP BACK IF MORE TO GO ! 17660: * ! 17661: * HERE GENERATE THE DECIMAL POINT ! 17662: * ! 17663: {GTS27{MOV{#CH$DT{R6{{LOAD DECIMAL POINT ! 17664: {{SCH{R6{-(R9){{STORE IN WORK AREA ! 17665: {{DCV{R7{{{DECREMENT COUNTER ! 17666: * ! 17667: * HERE GENERATE THE DIGITS BEFORE THE DECIMAL POINT ! 17668: * ! 17669: {GTS28{CVD{{{{CONVERT A DIGIT INTO WA ! 17670: {{SCH{R6{-(R9){{STORE IN WORK AREA ! 17671: {{DCV{R7{{{DECREMENT COUNTER ! 17672: {{INE{GTS28{{{LOOP BACK IF MORE TO GO ! 17673: {{CSC{R9{{{COMPLETE STORE CHARACTERS ! 17674: {{BRN{GTS08{{{ELSE JUMP BACK TO EXIT ! 17675: * ! 17676: * EXIT POINT AFTER SUCCESSFUL CONVERSION ! 17677: * ! 17678: {GTS29{MOV{(SP)+{R10{{RESTORE XL ! 17679: {{ICA{SP{{{POP ARGUMENT ! 17680: {{MOV{GTSVB{R7{{RESTORE WB ! 17681: {{MOV{GTSVC{R8{{RESTORE WC ! 17682: * ! 17683: * MERGE HERE IF NO CONVERSION REQUIRED ! 17684: * ! 17685: {GTS30{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH ! 17686: {{EXI{{{{RETURN TO CALLER ! 17687: * ! 17688: * HERE TO RETURN STRING FOR REAL ZERO ! 17689: * ! 17690: {GTS31{MOV{#SCRE0{R10{{POINT TO STRING ! 17691: {{MOV{#NUM02{R6{{2 CHARS ! 17692: {{ZER{R7{{{ZERO OFFSET ! 17693: {{JSR{SBSTR{{{COPY STRING ! 17694: {{BRN{GTS29{{{RETURN ! 17695: {{EJC{{{{ ! 17696: * ! 17697: * HERE TO CONVERT A BUFFER BLOCK ! 17698: * ! 17699: {GTS32{MOV{R9{R10{{COPY ARG PTR ! 17700: {{MOV{4*BCLEN(R10){R6{{GET SIZE TO ALLOCATE ! 17701: {{BZE{R6{GTS33{{IF NULL THEN RETURN NULL ! 17702: {{JSR{ALOCS{{{ALLOCATE STRING FRAME ! 17703: {{MOV{R9{R7{{SAVE STRING PTR ! 17704: {{MOV{4*SCLEN(R9){R6{{GET LENGTH TO MOVE ! 17705: {{CTB{R6{0{{GET AS MULTIPLE OF WORD SIZE ! 17706: {{MOV{4*BCBUF(R10){R10{{POINT TO BFBLK ! 17707: {{ADD{#4*SCSI${R9{{POINT TO START OF CHARACTER AREA ! 17708: {{ADD{#4*BFSI${R10{{POINT TO START OF BUFFER CHARS ! 17709: {{MVW{{{{COPY WORDS ! 17710: {{MOV{R7{R9{{RESTORE SCBLK PTR ! 17711: {{BRN{GTS29{{{EXIT WITH SCBLK ! 17712: * ! 17713: * HERE WHEN NULL BUFFER IS BEING CONVERTED ! 17714: * ! 17715: {GTS33{MOV{#NULLS{R9{{POINT TO NULL ! 17716: {{BRN{GTS29{{{EXIT WITH NULL ! 17717: {{ENP{{{{END PROCEDURE GTSTG ! 17718: {{EJC{{{{ ! 17719: * ! 17720: * GTVAR -- GET VARIABLE FOR I/O/TRACE ASSOCIATION ! 17721: * ! 17722: * GTVAR IS USED TO POINT TO AN ACTUAL VARIABLE LOCATION ! 17723: * FOR THE DETACH,INPUT,OUTPUT,TRACE,STOPTR SYSTEM FUNCTIONS ! 17724: * ! 17725: * (XR) ARGUMENT TO FUNCTION ! 17726: * JSR GTVAR CALL TO LOCATE VARIABLE POINTER ! 17727: * PPM LOC TRANSFER LOC IF NOT OK VARIABLE ! 17728: * (XL,WA) NAME BASE,OFFSET OF VARIABLE ! 17729: * (XR,RA) DESTROYED ! 17730: * (WB,WC) DESTROYED (CONVERT ERROR ONLY) ! 17731: * (XR) INPUT ARG (CONVERT ERROR ONLY) ! 17732: * ! 17733: {GTVAR{PRC{E{1{{ENTRY POINT ! 17734: {{BNE{(R9){#B$NML{GTVR2{JUMP IF NOT A NAME ! 17735: {{MOV{4*NMOFS(R9){R6{{ELSE LOAD NAME OFFSET ! 17736: {{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE ! 17737: {{BEQ{(R10){#B$EVT{GTVR1{ERROR IF EXPRESSION VARIABLE ! 17738: {{BNE{(R10){#B$KVT{GTVR3{ALL OK IF NOT KEYWORD VARIABLE ! 17739: * ! 17740: * HERE ON CONVERSION ERROR ! 17741: * ! 17742: {GTVR1{EXI{1{{{TAKE CONVERT ERROR EXIT ! 17743: * ! 17744: * HERE IF NOT A NAME, TRY CONVERT TO NATURAL VARIABLE ! 17745: * ! 17746: {GTVR2{MOV{R8{GTVRC{{SAVE WC ! 17747: {{JSR{GTNVR{{{LOCATE VRBLK IF POSSIBLE ! 17748: {{PPM{GTVR1{{{JUMP IF CONVERT ERROR ! 17749: {{MOV{R9{R10{{ELSE COPY VRBLK NAME BASE ! 17750: {{MOV{#4*VRVAL{R6{{AND SET OFFSET ! 17751: {{MOV{GTVRC{R8{{RESTORE WC ! 17752: * ! 17753: * HERE FOR NAME OBTAINED ! 17754: * ! 17755: {GTVR3{BHI{R10{STATE{GTVR4{ALL OK IF NOT NATURAL VARIABLE ! 17756: {{BEQ{4*VRSTO(R10){#B$VRE{GTVR1{ERROR IF PROTECTED VARIABLE ! 17757: * ! 17758: * COMMON EXIT POINT ! 17759: * ! 17760: {GTVR4{EXI{{{{RETURN TO CALLER ! 17761: {{ENP{{{{END PROCEDURE GTVAR ! 17762: {{EJC{{{{ ! 17763: * ! 17764: * HASHS -- COMPUTE HASH INDEX FOR STRING ! 17765: * ! 17766: * HASHS IS USED TO CONVERT A STRING TO A UNIQUE INTEGER ! 17767: * VALUE. THE RESULTING HASH VALUE IS A POSITIVE INTEGER ! 17768: * IN THE RANGE 0 TO CFP$M ! 17769: * ! 17770: * (XR) STRING TO BE HASHED ! 17771: * JSR HASHS CALL TO HASH STRING ! 17772: * (IA) HASH VALUE ! 17773: * (XR,WB,WC) DESTROYED ! 17774: * ! 17775: * THE HASH FUNCTION USED IS AS FOLLOWS. ! 17776: * ! 17777: * START WITH THE LENGTH OF THE STRING (SGD07) ! 17778: * ! 17779: * TAKE THE FIRST E$HNW WORDS OF THE CHARACTERS FROM ! 17780: * THE STRING OR ALL THE WORDS IF FEWER THAN E$HNW. ! 17781: * ! 17782: * COMPUTE THE EXCLUSIVE OR OF ALL THESE WORDS TREATING ! 17783: * THEM AS ONE WORD BIT STRING VALUES. ! 17784: * ! 17785: * MOVE THE RESULT AS AN INTEGER WITH THE MTI INSTRUCTION. ! 17786: * ! 17787: {HASHS{PRC{E{0{{ENTRY POINT ! 17788: {{MOV{4*SCLEN(R9){R8{{LOAD STRING LENGTH IN CHARACTERS ! 17789: {{MOV{R8{R7{{INITIALIZE WITH LENGTH ! 17790: {{BZE{R8{HSHS3{{JUMP IF NULL STRING ! 17791: {{CTW{R8{0{{ELSE GET NUMBER OF WORDS OF CHARS ! 17792: {{ADD{#4*SCHAR{R9{{POINT TO CHARACTERS OF STRING ! 17793: {{BLO{R8{#E$HNW{HSHS1{USE WHOLE STRING IF SHORT ! 17794: {{MOV{#E$HNW{R8{{ELSE SET TO INVOLVE FIRST E$HNW WDS ! 17795: * ! 17796: * HERE WITH COUNT OF WORDS TO CHECK IN WC ! 17797: * ! 17798: {HSHS1{LCT{R8{R8{{SET COUNTER TO CONTROL LOOP ! 17799: * ! 17800: * LOOP TO COMPUTE EXCLUSIVE OR ! 17801: * ! 17802: {HSHS2{XOB{(R9)+{R7{{EXCLUSIVE OR NEXT WORD OF CHARS ! 17803: {{BCT{R8{HSHS2{{LOOP TILL ALL PROCESSED ! 17804: * ! 17805: * MERGE HERE WITH EXCLUSIVE OR IN WB ! 17806: * ! 17807: {HSHS3{ZGB{R7{{{ZEROISE UNDEFINED BITS ! 17808: {{ANB{BITSM{R7{{ENSURE IN RANGE 0 TO CFP$M ! 17809: {{MTI{R7{{{MOVE RESULT AS INTEGER ! 17810: {{ZER{R9{{{CLEAR GARBAGE VALUE IN XR ! 17811: {{EXI{{{{RETURN TO HASHS CALLER ! 17812: {{ENP{{{{END PROCEDURE HASHS ! 17813: {{EJC{{{{ ! 17814: * ! 17815: * ICBLD -- BUILD INTEGER BLOCK ! 17816: * ! 17817: * (IA) INTEGER VALUE FOR ICBLK ! 17818: * JSR ICBLD CALL TO BUILD INTEGER BLOCK ! 17819: * (XR) POINTER TO RESULT ICBLK ! 17820: * (WA) DESTROYED ! 17821: * ! 17822: {ICBLD{PRC{E{0{{ENTRY POINT ! 17823: {{MFI{R9{ICBL1{{COPY SMALL INTEGERS ! 17824: {{BLE{R9{#NUM02{ICBL3{JUMP IF 0,1 OR 2 ! 17825: * ! 17826: * CONSTRUCT ICBLK ! 17827: * ! 17828: {ICBL1{MOV{DNAMP{R9{{LOAD POINTER TO NEXT AVAILABLE LOC ! 17829: {{ADD{#4*ICSI${R9{{POINT PAST NEW ICBLK ! 17830: {{BLO{R9{DNAME{ICBL2{JUMP IF THERE IS ROOM ! 17831: {{MOV{#4*ICSI${R6{{ELSE LOAD LENGTH OF ICBLK ! 17832: {{JSR{ALLOC{{{USE STANDARD ALLOCATOR TO GET BLOCK ! 17833: {{ADD{R6{R9{{POINT PAST BLOCK TO MERGE ! 17834: * ! 17835: * MERGE HERE WITH XR POINTING PAST THE BLOCK OBTAINED ! 17836: * ! 17837: {ICBL2{MOV{R9{DNAMP{{SET NEW POINTER ! 17838: {{SUB{#4*ICSI${R9{{POINT BACK TO START OF BLOCK ! 17839: {{MOV{#B$ICL{(R9){{STORE TYPE WORD ! 17840: {{STI{4*ICVAL(R9){{{STORE INTEGER VALUE IN ICBLK ! 17841: {{EXI{{{{RETURN TO ICBLD CALLER ! 17842: * ! 17843: * OPTIMISE BY NOT BUILDING ICBLKS FOR SMALL INTEGERS ! 17844: * ! 17845: {ICBL3{WTB{R9{{{CONVERT INTEGER TO OFFSET ! 17846: {{MOV{L^INTAB(R9){R9{{POINT TO PRE-BUILT ICBLK ! 17847: {{EXI{{{{RETURN ! 17848: {{ENP{{{{END PROCEDURE ICBLD ! 17849: {{EJC{{{{ ! 17850: * ! 17851: * IDENT -- COMPARE TWO VALUES ! 17852: * ! 17853: * IDENT COMPARES TWO VALUES IN THE SENSE OF THE IDENT ! 17854: * DIFFER FUNCTIONS AVAILABLE AT THE SNOBOL LEVEL. ! 17855: * ! 17856: * (XR) FIRST ARGUMENT ! 17857: * (XL) SECOND ARGUMENT ! 17858: * JSR IDENT CALL TO COMPARE ARGUMENTS ! 17859: * PPM LOC TRANSFER LOC IF IDENT ! 17860: * (NORMAL RETURN IF DIFFER) ! 17861: * (XR,XL,WC,RA) DESTROYED ! 17862: * ! 17863: {IDENT{PRC{E{1{{ENTRY POINT ! 17864: {{BEQ{R9{R10{IDEN7{JUMP IF SAME POINTER (IDENT) ! 17865: {{MOV{(R9){R8{{ELSE LOAD ARG 1 TYPE WORD ! 17866: {{BNE{R8{(R10){IDEN1{DIFFER IF ARG 2 TYPE WORD DIFFER ! 17867: {{BEQ{R8{#B$SCL{IDEN2{JUMP IF STRINGS ! 17868: {{BEQ{R8{#B$ICL{IDEN4{JUMP IF INTEGERS ! 17869: {{BEQ{R8{#B$RCL{IDEN5{JUMP IF REALS ! 17870: {{BEQ{R8{#B$NML{IDEN6{JUMP IF NAMES ! 17871: * ! 17872: * FOR ALL OTHER DATATYPES, MUST BE DIFFER IF XR NE XL ! 17873: * ! 17874: * MERGE HERE FOR DIFFER ! 17875: * ! 17876: {IDEN1{EXI{{{{TAKE DIFFER EXIT ! 17877: * ! 17878: * HERE FOR STRINGS, IDENT ONLY IF LENGTHS AND CHARS SAME ! 17879: * ! 17880: {IDEN2{MOV{4*SCLEN(R9){R8{{LOAD ARG 1 LENGTH ! 17881: {{BNE{R8{4*SCLEN(R10){IDEN1{DIFFER IF LENGTHS DIFFER ! 17882: {{CTW{R8{0{{GET NUMBER OF WORDS IN STRINGS ! 17883: {{ADD{#4*SCHAR{R9{{POINT TO CHARS OF ARG 1 ! 17884: {{ADD{#4*SCHAR{R10{{POINT TO CHARS OF ARG 2 ! 17885: {{LCT{R8{R8{{SET LOOP COUNTER ! 17886: * ! 17887: * LOOP TO COMPARE CHARACTERS. NOTE THAT WA CANNOT BE ZERO ! 17888: * SINCE ALL NULL STRINGS POINT TO NULLS AND GIVE XL=XR. ! 17889: * ! 17890: {IDEN3{CNE{(R9){(R10){IDEN8{DIFFER IF CHARS DO NOT MATCH ! 17891: {{ICA{R9{{{ELSE BUMP ARG ONE POINTER ! 17892: {{ICA{R10{{{BUMP ARG TWO POINTER ! 17893: {{BCT{R8{IDEN3{{LOOP BACK TILL ALL CHECKED ! 17894: {{EJC{{{{ ! 17895: * ! 17896: * IDENT (CONTINUED) ! 17897: * ! 17898: * HERE TO EXIT FOR CASE OF TWO IDENT STRINGS ! 17899: * ! 17900: {{ZER{R10{{{CLEAR GARBAGE VALUE IN XL ! 17901: {{ZER{R9{{{CLEAR GARBAGE VALUE IN XR ! 17902: {{EXI{1{{{TAKE IDENT EXIT ! 17903: * ! 17904: * HERE FOR INTEGERS, IDENT IF SAME VALUES ! 17905: * ! 17906: {IDEN4{LDI{4*ICVAL(R9){{{LOAD ARG 1 ! 17907: {{SBI{4*ICVAL(R10){{{SUBTRACT ARG 2 TO COMPARE ! 17908: {{IOV{IDEN1{{{DIFFER IF OVERFLOW ! 17909: {{INE{IDEN1{{{DIFFER IF RESULT IS NOT ZERO ! 17910: {{EXI{1{{{TAKE IDENT EXIT ! 17911: * ! 17912: * HERE FOR REALS, IDENT IF SAME VALUES ! 17913: * ! 17914: {IDEN5{LDR{4*RCVAL(R9){{{LOAD ARG 1 ! 17915: {{SBR{4*RCVAL(R10){{{SUBTRACT ARG 2 TO COMPARE ! 17916: {{ROV{IDEN1{{{DIFFER IF OVERFLOW ! 17917: {{RNE{IDEN1{{{DIFFER IF RESULT IS NOT ZERO ! 17918: {{EXI{1{{{TAKE IDENT EXIT ! 17919: * ! 17920: * HERE FOR NAMES, IDENT IF BASES AND OFFSETS SAME ! 17921: * ! 17922: {IDEN6{BNE{4*NMOFS(R9){4*NMOFS(R10){IDEN1{DIFFER IF DIFFERENT OFFSET ! 17923: {{BNE{4*NMBAS(R9){4*NMBAS(R10){IDEN1{DIFFER IF DIFFERENT BASE ! 17924: * ! 17925: * MERGE HERE TO SIGNAL IDENT FOR IDENTICAL POINTERS ! 17926: * ! 17927: {IDEN7{EXI{1{{{TAKE IDENT EXIT ! 17928: * ! 17929: * HERE FOR DIFFER STRINGS ! 17930: * ! 17931: {IDEN8{ZER{R9{{{CLEAR GARBAGE PTR IN XR ! 17932: {{ZER{R10{{{CLEAR GARBAGE PTR IN XL ! 17933: {{EXI{{{{RETURN TO CALLER (DIFFER) ! 17934: {{ENP{{{{END PROCEDURE IDENT ! 17935: {{EJC{{{{ ! 17936: * ! 17937: * INOUT - USED TO INITIALISE INPUT AND OUTPUT VARIABLES ! 17938: * ! 17939: * (XL) POINTER TO VBL NAME STRING ! 17940: * (WB) TRBLK TYPE ! 17941: * JSR INOUT CALL TO PERFORM INITIALISATION ! 17942: * (XL) VRBLK PTR ! 17943: * (XR) TRBLK PTR ! 17944: * (WA,WC) DESTROYED ! 17945: * ! 17946: * NOTE THAT TRTER (= TRTRF) FIELD OF STANDARD I/O VARIABLES ! 17947: * POINTS TO CORRESPONDING SVBLK NOT TO A TRBLK AS IS THE ! 17948: * CASE FOR ORDINARY VARIABLES. ! 17949: * ! 17950: {INOUT{PRC{E{0{{ENTRY POINT ! 17951: {{MOV{R7{-(SP){{STACK TRBLK TYPE ! 17952: {{MOV{4*SCLEN(R10){R6{{GET NAME LENGTH ! 17953: {{ZER{R7{{{POINT TO START OF NAME ! 17954: {{JSR{SBSTR{{{BUILD A PROPER SCBLK ! 17955: {{JSR{GTNVR{{{BUILD VRBLK ! 17956: {{PPM{{{{NO ERROR RETURN ! 17957: {{MOV{R9{R8{{SAVE VRBLK POINTER ! 17958: {{MOV{(SP)+{R7{{GET TRTER FIELD ! 17959: {{ZER{R10{{{ZERO TRFPT ! 17960: {{JSR{TRBLD{{{BUILD TRBLK ! 17961: {{MOV{R8{R10{{RECALL VRBLK POINTER ! 17962: {{MOV{4*VRSVP(R10){4*TRTER(R9){{STORE SVBLK POINTER ! 17963: {{MOV{R9{4*VRVAL(R10){{STORE TRBLK PTR IN VRBLK ! 17964: {{MOV{#B$VRA{4*VRGET(R10){{SET TRAPPED ACCESS ! 17965: {{MOV{#B$VRV{4*VRSTO(R10){{SET TRAPPED STORE ! 17966: {{EXI{{{{RETURN TO CALLER ! 17967: {{ENP{{{{END PROCEDURE INOUT ! 17968: {{EJC{{{{ ! 17969: * ! 17970: * INSBF -- INSERT STRING IN BUFFER ! 17971: * ! 17972: * THIS ROUTINE WILL REPLACE A SECTION OF A BUFFER WITH THE ! 17973: * CONTENTS OF A GIVEN STRING. IF THE LENGTH OF THE ! 17974: * SECTION TO BE REPLACED IS DIFFERENT THAN THE LENGTH OF ! 17975: * THE GIVEN STRING, AND THE REPLACEMENT IS NOT AN APPEND, ! 17976: * THEN THE UPPER SECTION OF THE BUFFER IS SHIFTED UP OR ! 17977: * DOWN TO CREATE THE PROPER SPACE FOR THE INSERT. ! 17978: * ! 17979: * (XR) POINTER TO BFBLK ! 17980: * (XL) OBJECT WHICH IS STRING CONVERTABLE ! 17981: * (WA) OFFSET OF START OF INSERT IN (XR) ! 17982: * (WB) LENGTH OF SECTION IN (XR) REPLACED ! 17983: * JSR INSBF CALL TO INSERT CHARACTERS IN BUFFER ! 17984: * PPM LOC THREAD IF (XR) NOT CONVERTABLE ! 17985: * PPM LOC THREAD IF INSERT NOT POSSIBLE ! 17986: * ! 17987: * THE SECOND ALTERNATE EXIT IS TAKEN IF THE INSERT WOULD ! 17988: * OVERFLOW THE BUFFER, OR IF THE INSERT IS OUT PAST THE ! 17989: * DEFINED END OF THE BUFFER AS GIVEN. ! 17990: * ! 17991: {INSBF{PRC{E{2{{ENTRY POINT ! 17992: {{MOV{R6{INSSA{{SAVE ENTRY WA ! 17993: {{MOV{R7{INSSB{{SAVE ENTRY WB ! 17994: {{MOV{R8{INSSC{{SAVE ENTRY WC ! 17995: {{ADD{R7{R6{{ADD TO GET OFFSET PAST REPLACE PART ! 17996: {{MOV{R6{INSAB{{SAVE WA+WB ! 17997: {{MOV{4*BCLEN(R9){R8{{GET CURRENT DEFINED LENGTH ! 17998: {{BGT{INSSA{R8{INS07{FAIL IF START OFFSET TOO BIG ! 17999: {{BGT{R6{R8{INS07{FAIL IF FINAL OFFSET TOO BIG ! 18000: {{MOV{R10{-(SP){{SAVE ENTRY XL ! 18001: {{MOV{R9{-(SP){{SAVE BCBLK PTR ! 18002: {{MOV{R10{-(SP){{STACK AGAIN FOR GTSTG ! 18003: {{JSR{GTSTG{{{CALL TO CONVERT TO STRING ! 18004: {{PPM{INS05{{{TAKE STRING CONVERT ERR EXIT ! 18005: {{MOV{R9{R10{{SAVE STRING PTR ! 18006: {{MOV{(SP){R9{{RESTORE BCBLK PTR ! 18007: {{ADD{R8{R6{{ADD BUFFER LEN TO STRING LEN ! 18008: {{SUB{INSSB{R6{{BIAS OUT COMPONENT BEING REPLACED ! 18009: {{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK ! 18010: {{BGT{R6{4*BFALC(R9){INS06{FAIL IF RESULT EXCEEDS ALLOCATION ! 18011: {{MOV{(SP){R9{{RESTORE BCBLK PTR ! 18012: {{MOV{R8{R6{{GET BUFFER LENGTH ! 18013: {{SUB{INSAB{R6{{SUBTRACT TO GET SHIFT LENGTH ! 18014: {{ADD{4*SCLEN(R10){R8{{ADD LENGTH OF NEW ! 18015: {{SUB{INSSB{R8{{SUBTRACT OLD TO GET TOTAL NEW LEN ! 18016: {{MOV{4*BCLEN(R9){R7{{GET OLD BCLEN ! 18017: {{MOV{R8{4*BCLEN(R9){{STUFF NEW LENGTH ! 18018: {{BZE{R6{INS04{{SKIP SHIFT IF NOTHING TO DO ! 18019: {{BEQ{INSSB{4*SCLEN(R10){INS04{SKIP SHIFT IF LENGTHS MATCH ! 18020: {{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK ! 18021: {{MOV{R10{-(SP){{SAVE SCBLK PTR ! 18022: {{BLO{INSSB{4*SCLEN(R10){INS01{BRN IF SHFT IS FOR MORE ROOM ! 18023: {{EJC{{{{ ! 18024: * ! 18025: * INSBF (CONTINUED) ! 18026: * ! 18027: * WE ARE SHIFTING THE UPPER SEGMENT DOWN TO COMPACT ! 18028: * THE BUFFER. (THE STRING LENGTH IS SMALLER THAN THE ! 18029: * SEGMENT BEING REPLACED.) REGISTERS ARE SET AS: ! 18030: * ! 18031: * (WA) MOVE (SHIFT DOWN) LENGTH ! 18032: * (WB) OLD BCLEN ! 18033: * (WC) NEW BCLEN ! 18034: * (XR) BFBLK PTR ! 18035: * (XL),(XS) SCBLK PTR ! 18036: * ! 18037: {{MOV{INSSA{R7{{GET OFFSET TO INSERT ! 18038: {{ADD{4*SCLEN(R10){R7{{ADD INSERT LENGTH TO GET DEST OFF ! 18039: {{MOV{R9{R10{{MAKE COPY ! 18040: {{PLC{R10{INSAB{{PREPARE SOURCE FOR MOVE ! 18041: {{PSC{R9{R7{{PREPARE DESTINATION REG FOR MOVE ! 18042: {{MVC{{{{MOVE EM OUT ! 18043: {{BRN{INS02{{{BRANCH TO PAD ! 18044: * ! 18045: * WE ARE SHIFTING THE UPPER SEGMENT UP TO EXPAND ! 18046: * THE BUFFER. (THE STRING LENGTH IS LARGER THAN THE ! 18047: * SEGMENT BEING REPLACED.) ! 18048: * ! 18049: {INS01{MOV{R9{R10{{COPY BFBLK PTR ! 18050: {{PLC{R10{R7{{SET SOURCE REG FOR MOVE BACKWARDS ! 18051: {{PSC{R9{R8{{SET DESTINATION PTR FOR MOVE ! 18052: {{MCB{{{{MOVE BACKWARDS (POSSIBLE OVERLAP) ! 18053: * ! 18054: * MERGE HERE AFTER MOVE TO ADJUST PADDING AT NEW BUFFER END ! 18055: * ! 18056: {INS02{MOV{(SP)+{R10{{RESTORE SCBLK PTR ! 18057: {{MOV{R8{R6{{COPY NEW BUFFER END ! 18058: {{CTB{R6{0{{ROUND OUT ! 18059: {{SUB{R8{R6{{SUBTRACT TO GET REMAINDER ! 18060: {{BZE{R6{INS04{{NO PAD IF ALREADY EVEN BOUNDARY ! 18061: {{MOV{(SP){R9{{GET BCBLK PTR ! 18062: {{MOV{4*BCBUF(R9){R9{{GET BFBLK PTR ! 18063: {{PSC{R9{R8{{PREPARE TO PAD ! 18064: {{ZER{R7{{{CLEAR WB ! 18065: {{LCT{R6{R6{{LOAD LOOP COUNT ! 18066: * ! 18067: * LOOP HERE TO STUFF PAD CHARACTERS ! 18068: * ! 18069: {INS03{SCH{R7{(R9)+{{STUFF ZERO PAD ! 18070: {{BCT{R6{INS03{{BRANCH FOR MORE ! 18071: {{EJC{{{{ ! 18072: * ! 18073: * INSBF (CONTINUED) ! 18074: * ! 18075: * MERGE HERE WHEN PADDING OK. NOW COPY IN THE INSERT ! 18076: * STRING TO THE HOLE. ! 18077: * ! 18078: {INS04{MOV{(SP){R9{{GET BCBLK PTR ! 18079: {{MOV{4*BCBUF(R9){R9{{GET BFBLK PTR ! 18080: {{MOV{4*SCLEN(R10){R6{{GET MOVE LENGTH ! 18081: {{PLC{R10{{{PREPARE TO COPY FROM FIRST CHAR ! 18082: {{PSC{R9{INSSA{{PREPARE TO STORE IN HOLE ! 18083: {{MVC{{{{COPY THE CHARACTERS ! 18084: {{MOV{(SP)+{R9{{RESTORE ENTRY XR ! 18085: {{MOV{(SP)+{R10{{RESTORE ENTRY XL ! 18086: {{MOV{INSSA{R6{{RESTORE ENTRY WA ! 18087: {{MOV{INSSB{R7{{RESTORE ENTRY WB ! 18088: {{MOV{INSSC{R8{{RESTORE ENTRY WC ! 18089: {{EXI{{{{RETURN TO CALLER ! 18090: * ! 18091: * HERE TO TAKE STRING CONVERT ERROR EXIT ! 18092: * ! 18093: {INS05{MOV{(SP)+{R9{{RESTORE ENTRY XR ! 18094: {{MOV{(SP)+{R10{{RESTORE ENTRY XL ! 18095: {{MOV{INSSA{R6{{RESTORE ENTRY WA ! 18096: {{MOV{INSSB{R7{{RESTORE ENTRY WB ! 18097: {{MOV{INSSC{R8{{RESTORE ENTRY WC ! 18098: {{EXI{1{{{ALTERNATE EXIT ! 18099: * ! 18100: * HERE FOR INVALID OFFSET OR LENGTH ! 18101: * ! 18102: {INS06{MOV{(SP)+{R9{{RESTORE ENTRY XR ! 18103: {{MOV{(SP)+{R10{{RESTORE ENTRY XL ! 18104: * ! 18105: * MERGE FOR LENGTH FAILURE EXIT WITH STACK SET ! 18106: * ! 18107: {INS07{MOV{INSSA{R6{{RESTORE ENTRY WA ! 18108: {{MOV{INSSB{R7{{RESTORE ENTRY WB ! 18109: {{MOV{INSSC{R8{{RESTORE ENTRY WC ! 18110: {{EXI{2{{{ALTERNATE EXIT ! 18111: {{ENP{{{{END PROCEDURE INSBF ! 18112: {{EJC{{{{ ! 18113: * ! 18114: * IOFCB -- GET INPUT/OUTPUT FCBLK POINTER ! 18115: * ! 18116: * USED BY ENDFILE, EJECT AND REWIND TO FIND THE FCBLK ! 18117: * (IF ANY) CORRESPONDING TO THEIR ARGUMENT. ! 18118: * ! 18119: * -(XS) ARGUMENT ! 18120: * JSR IOFCB CALL TO FIND FCBLK ! 18121: * PPM LOC ARG IS AN UNSUITABLE NAME ! 18122: * PPM LOC ARG IS NULL STRING ! 18123: * (XS) POPPED ! 18124: * (XL) PTR TO FILEARG1 VRBLK ! 18125: * (XR) ARGUMENT ! 18126: * (WA) FCBLK PTR OR 0 ! 18127: * (WB) DESTROYED ! 18128: * ! 18129: {IOFCB{PRC{N{2{{ENTRY POINT ! 18130: {{JSR{GTSTG{{{GET ARG AS STRING ! 18131: {{PPM{IOFC2{{{FAIL ! 18132: {{MOV{R9{R10{{COPY STRING PTR ! 18133: {{JSR{GTNVR{{{GET AS NATURAL VARIABLE ! 18134: {{PPM{IOFC3{{{FAIL IF NULL ! 18135: {{MOV{R10{R7{{COPY STRING POINTER AGAIN ! 18136: {{MOV{R9{R10{{COPY VRBLK PTR FOR RETURN ! 18137: {{ZER{R6{{{IN CASE NO TRBLK FOUND ! 18138: * ! 18139: * LOOP TO FIND FILE ARG1 TRBLK ! 18140: * ! 18141: {IOFC1{MOV{4*VRVAL(R9){R9{{GET POSSIBLE TRBLK PTR ! 18142: {{BNE{(R9){#B$TRT{IOFC2{FAIL IF END OF CHAIN ! 18143: {{BNE{4*TRTYP(R9){#TRTFC{IOFC1{LOOP IF NOT FILE ARG TRBLK ! 18144: {{MOV{4*TRFPT(R9){R6{{GET FCBLK PTR ! 18145: {{MOV{R7{R9{{COPY ARG ! 18146: {{EXI{{{{RETURN ! 18147: * ! 18148: * FAIL RETURN ! 18149: * ! 18150: {IOFC2{EXI{1{{{FAIL ! 18151: * ! 18152: * NULL ARG ! 18153: * ! 18154: {IOFC3{EXI{2{{{NULL ARG RETURN ! 18155: {{ENP{{{{END PROCEDURE IOFCB ! 18156: {{EJC{{{{ ! 18157: * ! 18158: * IOPPF -- PROCESS FILEARG2 FOR IOPUT ! 18159: * ! 18160: * (R$XSC) FILEARG2 PTR ! 18161: * JSR IOPPF CALL TO PROCESS FILEARG2 ! 18162: * (XL) FILEARG1 PTR ! 18163: * (XR) FILE ARG2 PTR ! 18164: * -(XS)..-(XS) FIELDS EXTRACTED FROM FILEARG2 ! 18165: * (WC) NO. OF FIELDS EXTRACTED ! 18166: * (WB) INPUT/OUTPUT FLAG ! 18167: * (WA) FCBLK PTR OR 0 ! 18168: * ! 18169: {IOPPF{PRC{N{0{{ENTRY POINT ! 18170: {{ZER{R7{{{TO COUNT FIELDS EXTRACTED ! 18171: * ! 18172: * LOOP TO EXTRACT FIELDS ! 18173: * ! 18174: {IOPP1{MOV{#IODEL{R10{{GET DELIMITER ! 18175: {{MOV{R10{R8{{COPY IT ! 18176: {{JSR{XSCAN{{{GET NEXT FIELD ! 18177: {{MOV{R9{-(SP){{STACK IT ! 18178: {{ICV{R7{{{INCREMENT COUNT ! 18179: {{BNZ{R6{IOPP1{{LOOP ! 18180: {{MOV{R7{R8{{COUNT OF FIELDS ! 18181: {{MOV{IOPTT{R7{{I/O MARKER ! 18182: {{MOV{R$IOF{R6{{FCBLK PTR OR 0 ! 18183: {{MOV{R$IO2{R9{{FILE ARG2 PTR ! 18184: {{MOV{R$IO1{R10{{FILEARG1 ! 18185: {{EXI{{{{RETURN ! 18186: {{ENP{{{{END PROCEDURE IOPPF ! 18187: {{EJC{{{{ ! 18188: * ! 18189: * IOPUT -- ROUTINE USED BY INPUT AND OUTPUT ! 18190: * ! 18191: * IOPUT SETS UP INPUT/OUTPUT ASSOCIATIONS. IT BUILDS ! 18192: * SUCH TRACE AND FILE CONTROL BLOCKS AS ARE NECESSARY AND ! 18193: * CALLS SYSFC,SYSIO TO PERFORM CHECKS ON THE ! 18194: * ARGUMENTS AND TO OPEN THE FILES. ! 18195: * ! 18196: * +-----------+ +---------------+ +-----------+ ! 18197: * +-.I I I I------.I =B$XRT I ! 18198: * I +-----------+ +---------------+ +-----------+ ! 18199: * I / / (R$FCB) I *4 I ! 18200: * I / / +-----------+ ! 18201: * I +-----------+ +---------------+ I I- ! 18202: * I I NAME +--.I =B$TRT I +-----------+ ! 18203: * I / / +---------------+ I I ! 18204: * I (FIRST ARG) I =TRTIN/=TRTOU I +-----------+ ! 18205: * I +---------------+ I ! 18206: * I I VALUE I I ! 18207: * I +---------------+ I ! 18208: * I I(TRTRF) 0 OR I--+ I ! 18209: * I +---------------+ I I ! 18210: * I I(TRFPT) 0 OR I----+ I ! 18211: * I +---------------+ I I I ! 18212: * I (I/O TRBLK) I I I ! 18213: * I +-----------+ I I I ! 18214: * I I I I I I ! 18215: * I +-----------+ I I I ! 18216: * I I I I I I ! 18217: * I +-----------+ +---------------+ I I I ! 18218: * I I +--.I =B$TRT I.-+ I I ! 18219: * I +-----------+ +---------------+ I I ! 18220: * I / / I =TRTFC I I I ! 18221: * I / / +---------------+ I I ! 18222: * I (FILEARG1 I VALUE I I I ! 18223: * I VRBLK) +---------------+ I I ! 18224: * I I(TRTRF) 0 OR I--+ I . ! 18225: * I +---------------+ I . +-----------+ ! 18226: * I I(TRFPT) 0 OR I------./ FCBLK / ! 18227: * I +---------------+ I +-----------+ ! 18228: * I (TRTRF) I ! 18229: * I I ! 18230: * I I ! 18231: * I +---------------+ I ! 18232: * I I =B$XRT I.-+ ! 18233: * I +---------------+ ! 18234: * I I *5 I ! 18235: * I +---------------+ ! 18236: * +------------------I I ! 18237: * +---------------+ +-----------+ ! 18238: * I(TRTRF) O OR I------.I =B$XRT I ! 18239: * +---------------+ +-----------+ ! 18240: * I NAME OFFSET I I ETC I ! 18241: * +---------------+ ! 18242: * (IOCHN - CHAIN OF NAME POINTERS) ! 18243: {{EJC{{{{ ! 18244: * ! 18245: * IOPUT (CONTINUED) ! 18246: * ! 18247: * NO ADDITIONAL TRAP BLOCKS ARE USED FOR STANDARD INPUT/OUT ! 18248: * FILES. OTHERWISE AN I/O TRAP BLOCK IS ATTACHED TO SECOND ! 18249: * ARG (FILEARG1) VRBLK. SEE DIAGRAM ABOVE FOR DETAILS OF ! 18250: * THE STRUCTURE BUILT. ! 18251: * ! 18252: * -(XS) 1ST ARG (VBL TO BE ASSOCIATED) ! 18253: * -(XS) 2ND ARG (FILE ARG1) ! 18254: * -(XS) 3RD ARG (FILE ARG2) ! 18255: * (WB) 0 FOR INPUT, 3 FOR OUTPUT ASSOC. ! 18256: * JSR IOPUT CALL FOR INPUT/OUTPUT ASSOCIATION ! 18257: * PPM LOC 3RD ARG NOT A STRING ! 18258: * PPM LOC 2ND ARG NOT A SUITABLE NAME ! 18259: * PPM LOC 1ST ARG NOT A SUITABLE NAME ! 18260: * PPM LOC INAPPROPRIATE FILE SPEC FOR I/O ! 18261: * PPM LOC I/O FILE DOES NOT EXIST ! 18262: * PPM LOC I/O FILE CANNOT BE READ/WRITTEN ! 18263: * (XS) POPPED ! 18264: * (XL,XR,WA,WB,WC) DESTROYED ! 18265: * ! 18266: {IOPUT{PRC{N{6{{ENTRY POINT ! 18267: {{ZER{R$IOT{{{IN CASE NO TRTRF BLOCK USED ! 18268: {{ZER{R$IOF{{{IN CASE NO FCBLK ALOCATED ! 18269: {{MOV{R7{IOPTT{{STORE I/O TRACE TYPE ! 18270: {{JSR{XSCNI{{{PREPARE TO SCAN FILEARG2 ! 18271: {{PPM{IOP13{{{FAIL ! 18272: {{PPM{IOPA0{{{NULL FILE ARG2 ! 18273: * ! 18274: {IOPA0{MOV{R9{R$IO2{{KEEP FILE ARG2 ! 18275: {{MOV{R6{R10{{COPY LENGTH ! 18276: {{JSR{GTSTG{{{CONVERT FILEARG1 TO STRING ! 18277: {{PPM{IOP14{{{FAIL ! 18278: {{MOV{R9{R$IO1{{KEEP FILEARG1 PTR ! 18279: {{JSR{GTNVR{{{CONVERT TO NATURAL VARIABLE ! 18280: {{PPM{IOP00{{{JUMP IF NULL ! 18281: {{BRN{IOP04{{{JUMP TO PROCESS NON-NULL ARGS ! 18282: * ! 18283: * NULL FILEARG1 ! 18284: * ! 18285: {IOP00{BZE{R10{IOP01{{SKIP IF BOTH ARGS NULL ! 18286: {{JSR{IOPPF{{{PROCESS FILEARG2 ! 18287: {{JSR{SYSFC{{{CALL FOR FILEARG2 CHECK ! 18288: {{PPM{IOP16{{{FAIL ! 18289: {{BRN{IOP11{{{COMPLETE FILE ASSOCIATION ! 18290: {{EJC{{{{ ! 18291: * ! 18292: * IOPUT (CONTINUED) ! 18293: * ! 18294: * HERE WITH 0 OR FCBLK PTR IN (XL) ! 18295: * ! 18296: {IOP01{MOV{IOPTT{R7{{GET TRACE TYPE ! 18297: {{MOV{R$IOT{R9{{GET 0 OR TRTRF PTR ! 18298: {{JSR{TRBLD{{{BUILD TRBLK ! 18299: {{MOV{R9{R8{{COPY TRBLK POINTER ! 18300: {{MOV{(SP)+{R9{{GET VARIABLE FROM STACK ! 18301: {{JSR{GTVAR{{{POINT TO VARIABLE ! 18302: {{PPM{IOP15{{{FAIL ! 18303: {{MOV{R10{R$ION{{SAVE NAME POINTER ! 18304: {{MOV{R10{R9{{COPY NAME POINTER ! 18305: {{ADD{R6{R9{{POINT TO VARIABLE ! 18306: {{SUB{#4*VRVAL{R9{{SUBTRACT OFFSET,MERGE INTO LOOP ! 18307: * ! 18308: * LOOP TO END OF TRBLK CHAIN IF ANY ! 18309: * ! 18310: {IOP02{MOV{R9{R10{{COPY BLK PTR ! 18311: {{MOV{4*VRVAL(R9){R9{{LOAD PTR TO NEXT TRBLK ! 18312: {{BNE{(R9){#B$TRT{IOP03{JUMP IF NOT TRAPPED ! 18313: {{BNE{4*TRTYP(R9){IOPTT{IOP02{LOOP IF NOT SAME ASSOCN ! 18314: {{MOV{4*TRNXT(R9){R9{{GET VALUE AND DELETE OLD TRBLK ! 18315: * ! 18316: * IOPUT (CONTINUED) ! 18317: * ! 18318: * STORE NEW ASSOCIATION ! 18319: * ! 18320: {IOP03{MOV{R8{4*VRVAL(R10){{LINK TO THIS TRBLK ! 18321: {{MOV{R8{R10{{COPY POINTER ! 18322: {{MOV{R9{4*TRNXT(R10){{STORE VALUE IN TRBLK ! 18323: {{MOV{R$ION{R9{{RESTORE POSSIBLE VRBLK POINTER ! 18324: {{MOV{R6{R7{{KEEP OFFSET TO NAME ! 18325: {{JSR{SETVR{{{IF VRBLK, SET VRGET,VRSTO ! 18326: {{MOV{R$IOT{R9{{GET 0 OR TRTRF PTR ! 18327: {{BNZ{R9{IOP19{{JUMP IF TRTRF BLOCK EXISTS ! 18328: {{EXI{{{{RETURN TO CALLER ! 18329: * ! 18330: * NON STANDARD FILE ! 18331: * SEE IF AN FCBLK HAS ALREADY BEEN ALLOCATED. ! 18332: * ! 18333: {IOP04{ZER{R6{{{IN CASE NO FCBLK FOUND ! 18334: {{EJC{{{{ ! 18335: * ! 18336: * IOPUT (CONTINUED) ! 18337: * ! 18338: * SEARCH POSSIBLE TRBLK CHAIN TO PICK UP THE FCBLK ! 18339: * ! 18340: {IOP05{MOV{R9{R7{{REMEMBER BLK PTR ! 18341: {{MOV{4*VRVAL(R9){R9{{CHAIN ALONG ! 18342: {{BNE{(R9){#B$TRT{IOP06{JUMP IF END OF TRBLK CHAIN ! 18343: {{BNE{4*TRTYP(R9){#TRTFC{IOP05{LOOP IF MORE TO GO ! 18344: {{MOV{R9{R$IOT{{POINT TO FILE ARG1 TRBLK ! 18345: {{MOV{4*TRFPT(R9){R6{{GET FCBLK PTR FROM TRBLK ! 18346: * ! 18347: * WA = 0 OR FCBLK PTR ! 18348: * WB = PTR TO PRECEDING BLK TO WHICH ANY TRTRF BLOCK ! 18349: * FOR FILE ARG1 MUST BE CHAINED. ! 18350: * ! 18351: {IOP06{MOV{R6{R$IOF{{KEEP POSSIBLE FCBLK PTR ! 18352: {{MOV{R7{R$IOP{{KEEP PRECEDING BLK PTR ! 18353: {{JSR{IOPPF{{{PROCESS FILEARG2 ! 18354: {{JSR{SYSFC{{{SEE IF FCBLK REQUIRED ! 18355: {{PPM{IOP16{{{FAIL ! 18356: {{BZE{R6{IOP12{{SKIP IF NO NEW FCBLK WANTED ! 18357: {{BLT{R8{#NUM02{IOP6A{JUMP IF FCBLK IN DYNAMIC ! 18358: {{JSR{ALOST{{{GET IT IN STATIC ! 18359: {{BRN{IOP6B{{{SKIP ! 18360: * ! 18361: * OBTAIN FCBLK IN DYNAMIC ! 18362: * ! 18363: {IOP6A{JSR{ALLOC{{{GET SPACE FOR FCBLK ! 18364: * ! 18365: * MERGE ! 18366: * ! 18367: {IOP6B{MOV{R9{R10{{POINT TO FCBLK ! 18368: {{MOV{R6{R7{{COPY ITS LENGTH ! 18369: {{BTW{R7{{{GET COUNT AS WORDS (SGD APR80) ! 18370: {{LCT{R7{R7{{LOOP COUNTER ! 18371: * ! 18372: * CLEAR FCBLK ! 18373: * ! 18374: {IOP07{ZER{(R9)+{{{CLEAR A WORD ! 18375: {{BCT{R7{IOP07{{LOOP ! 18376: {{BEQ{R8{#NUM02{IOP09{SKIP IF IN STATIC - DONT SET FIELDS ! 18377: {{MOV{#B$XNT{(R10){{STORE XNBLK CODE IN CASE ! 18378: {{MOV{R6{4*1(R10){{STORE LENGTH ! 18379: {{BNZ{R8{IOP09{{JUMP IF XNBLK WANTED ! 18380: {{MOV{#B$XRT{(R10){{XRBLK CODE REQUESTED ! 18381: * ! 18382: {{EJC{{{{ ! 18383: * IOPUT (CONTINUED) ! 18384: * ! 18385: * COMPLETE FCBLK INITIALISATION ! 18386: * ! 18387: {IOP09{MOV{R$IOT{R9{{GET POSSIBLE TRBLK PTR ! 18388: {{MOV{R10{R$IOF{{STORE FCBLK PTR ! 18389: {{BNZ{R9{IOP10{{JUMP IF TRBLK ALREADY FOUND ! 18390: * ! 18391: * A NEW TRBLK IS NEEDED ! 18392: * ! 18393: {{MOV{#TRTFC{R7{{TRTYP FOR FCBLK TRAP BLK ! 18394: {{JSR{TRBLD{{{MAKE THE BLOCK ! 18395: {{MOV{R9{R$IOT{{COPY TRTRF PTR ! 18396: {{MOV{R$IOP{R10{{POINT TO PRECEDING BLK ! 18397: {{MOV{4*VRVAL(R10){4*VRVAL(R9){{COPY VALUE FIELD TO TRBLK ! 18398: {{MOV{R9{4*VRVAL(R10){{LINK NEW TRBLK INTO CHAIN ! 18399: {{MOV{R10{R9{{POINT TO PREDECESSOR BLK ! 18400: {{JSR{SETVR{{{SET TRACE INTERCEPTS ! 18401: {{MOV{4*VRVAL(R9){R9{{RECOVER TRBLK PTR ! 18402: * ! 18403: * XR IS PTR TO TRBLK, XL IS FCBLK PTR OR 0 ! 18404: * ! 18405: {IOP10{MOV{R$IOF{4*TRFPT(R9){{STORE FCBLK PTR ! 18406: * ! 18407: * CALL SYSIO TO COMPLETE FILE ACCESSING ! 18408: * ! 18409: {IOP11{MOV{R$IOF{R6{{COPY FCBLK PTR OR 0 ! 18410: {{MOV{IOPTT{R7{{GET INPUT/OUTPUT FLAG ! 18411: {{MOV{R$IO2{R9{{GET FILE ARG2 ! 18412: {{MOV{R$IO1{R10{{GET FILE ARG1 ! 18413: {{JSR{SYSIO{{{ASSOCIATE TO THE FILE ! 18414: {{PPM{IOP17{{{FAIL ! 18415: {{PPM{IOP18{{{FAIL ! 18416: {{BNZ{R$IOT{IOP01{{NOT STD INPUT IF NON-NULL TRTRF BLK ! 18417: {{BNZ{IOPTT{IOP01{{JUMP IF OUTPUT ! 18418: {{BZE{R8{IOP01{{NO CHANGE TO STANDARD READ LENGTH ! 18419: {{MOV{R8{CSWIN{{STORE NEW READ LENGTH FOR STD FILE ! 18420: {{BRN{IOP01{{{MERGE TO FINISH THE TASK ! 18421: * ! 18422: * SYSFC MAY HAVE RETURNED A POINTER TO A PRIVATE FCBLK ! 18423: * ! 18424: {IOP12{BNZ{R10{IOP09{{JUMP IF PRIVATE FCBLK ! 18425: {{BRN{IOP11{{{FINISH THE ASSOCIATION ! 18426: * ! 18427: * FAILURE RETURNS ! 18428: * ! 18429: {IOP13{EXI{1{{{3RD ARG NOT A STRING ! 18430: {IOP14{EXI{2{{{2ND ARG UNSUITABLE ! 18431: {IOP15{EXI{3{{{1ST ARG UNSUITABLE ! 18432: {IOP16{EXI{4{{{FILE SPEC WRONG ! 18433: {IOP17{EXI{5{{{I/O FILE DOES NOT EXIST ! 18434: {IOP18{EXI{6{{{I/O FILE CANNOT BE READ/WRITTEN ! 18435: {{EJC{{{{ ! 18436: * ! 18437: * IOPUT (CONTINUED) ! 18438: * ! 18439: * ADD TO IOCHN CHAIN OF ASSSOCIATED VARIABLES UNLESS ALREAD ! 18440: * PRESENT. ! 18441: * ! 18442: {IOP19{MOV{R$ION{R8{{WC = NAME BASE, WB = NAME OFFSET ! 18443: * ! 18444: * SEARCH LOOP ! 18445: * ! 18446: {IOP20{MOV{4*TRTRF(R9){R9{{NEXT LINK OF CHAIN ! 18447: {{BZE{R9{IOP21{{NOT FOUND ! 18448: {{BNE{R8{4*IONMB(R9){IOP20{NO MATCH ! 18449: {{BEQ{R7{4*IONMO(R9){IOP22{EXIT IF MATCHED ! 18450: {{BRN{IOP20{{{LOOP ! 18451: * ! 18452: * NOT FOUND ! 18453: * ! 18454: {IOP21{MOV{#4*NUM05{R6{{SPACE NEEDED ! 18455: {{JSR{ALLOC{{{GET IT ! 18456: {{MOV{#B$XRT{(R9){{STORE XRBLK CODE ! 18457: {{MOV{R6{4*1(R9){{STORE LENGTH ! 18458: {{MOV{R8{4*IONMB(R9){{STORE NAME BASE ! 18459: {{MOV{R7{4*IONMO(R9){{STORE NAME OFFSET ! 18460: {{MOV{R$IOT{R10{{POINT TO TRTRF BLK ! 18461: {{MOV{4*TRTRF(R10){R6{{GET PTR FIELD CONTENTS ! 18462: {{MOV{R9{4*TRTRF(R10){{STORE PTR TO NEW BLOCK ! 18463: {{MOV{R6{4*TRTRF(R9){{COMPLETE THE LINKING ! 18464: * ! 18465: * INSERT FCBLK ON FCBLK CHAIN FOR SYSEJ, SYSXI ! 18466: * ! 18467: {IOP22{BZE{R$IOF{IOP25{{SKIP IF NO FCBLK ! 18468: {{MOV{R$FCB{R10{{PTR TO HEAD OF EXISTING CHAIN ! 18469: * ! 18470: * SEE IF FCBLK ALREADY ON CHAIN ! 18471: * ! 18472: {IOP23{BZE{R10{IOP24{{NOT ON IF END OF CHAIN ! 18473: {{BEQ{4*3(R10){R$IOF{IOP25{DONT DUPLICATE IF FIND IT ! 18474: {{MOV{4*2(R10){R10{{GET NEXT LINK ! 18475: {{BRN{IOP23{{{LOOP ! 18476: * ! 18477: * NOT FOUND SO ADD AN ENTRY FOR THIS FCBLK ! 18478: * ! 18479: {IOP24{MOV{#4*NUM04{R6{{SPACE NEEDED ! 18480: {{JSR{ALLOC{{{GET IT ! 18481: {{MOV{#B$XRT{(R9){{STORE BLOCK CODE ! 18482: {{MOV{R6{4*1(R9){{STORE LENGTH ! 18483: {{MOV{R$FCB{4*2(R9){{STORE PREVIOUS LINK IN THIS NODE ! 18484: {{MOV{R$IOF{4*3(R9){{STORE FCBLK PTR ! 18485: {{MOV{R9{R$FCB{{INSERT NODE INTO FCBLK CHAIN ! 18486: * ! 18487: * RETURN ! 18488: * ! 18489: {IOP25{EXI{{{{RETURN TO CALLER ! 18490: {{ENP{{{{END PROCEDURE IOPUT ! 18491: {{EJC{{{{ ! 18492: * ! 18493: * KTREX -- EXECUTE KEYWORD TRACE ! 18494: * ! 18495: * KTREX IS USED TO EXECUTE A POSSIBLE KEYWORD TRACE. IT ! 18496: * INCLUDES THE TEST ON TRACE AND TESTS FOR TRACE ACTIVE. ! 18497: * ! 18498: * (XL) PTR TO TRBLK (OR 0 IF UNTRACED) ! 18499: * JSR KTREX CALL TO EXECUTE KEYWORD TRACE ! 18500: * (XL,WA,WB,WC) DESTROYED ! 18501: * (RA) DESTROYED ! 18502: * ! 18503: {KTREX{PRC{R{0{{ENTRY POINT (RECURSIVE) ! 18504: {{BZE{R10{KTRX3{{IMMEDIATE EXIT IF KEYWORD UNTRACED ! 18505: {{BZE{KVTRA{KTRX3{{IMMEDIATE EXIT IF TRACE = 0 ! 18506: {{DCV{KVTRA{{{ELSE DECREMENT TRACE ! 18507: {{MOV{R9{-(SP){{SAVE XR ! 18508: {{MOV{R10{R9{{COPY TRBLK POINTER ! 18509: {{MOV{4*TRKVR(R9){R10{{LOAD VRBLK POINTER (NMBAS) ! 18510: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET ! 18511: {{BZE{4*TRFNC(R9){KTRX1{{JUMP IF PRINT TRACE ! 18512: {{JSR{TRXEQ{{{ELSE EXECUTE FULL TRACE ! 18513: {{BRN{KTRX2{{{AND JUMP TO EXIT ! 18514: * ! 18515: * HERE FOR PRINT TRACE ! 18516: * ! 18517: {KTRX1{MOV{R10{-(SP){{STACK VRBLK PTR FOR KWNAM ! 18518: {{MOV{R6{-(SP){{STACK OFFSET FOR KWNAM ! 18519: {{JSR{PRTSN{{{PRINT STATEMENT NUMBER ! 18520: {{MOV{#CH$AM{R6{{LOAD AMPERSAND ! 18521: {{JSR{PRTCH{{{PRINT AMPERSAND ! 18522: {{JSR{PRTNM{{{PRINT KEYWORD NAME ! 18523: {{MOV{#TMBEB{R9{{POINT TO BLANK-EQUAL-BLANK ! 18524: {{JSR{PRTST{{{PRINT BLANK-EQUAL-BLANK ! 18525: {{JSR{KWNAM{{{GET KEYWORD PSEUDO-VARIABLE NAME ! 18526: {{MOV{R9{DNAMP{{RESET PTR TO DELETE KVBLK ! 18527: {{JSR{ACESS{{{GET KEYWORD VALUE ! 18528: {{PPM{{{{FAILURE IS IMPOSSIBLE ! 18529: {{JSR{PRTVL{{{PRINT KEYWORD VALUE ! 18530: {{JSR{PRTNL{{{TERMINATE PRINT LINE ! 18531: * ! 18532: * HERE TO EXIT AFTER COMPLETING TRACE ! 18533: * ! 18534: {KTRX2{MOV{(SP)+{R9{{RESTORE ENTRY XR ! 18535: * ! 18536: * MERGE HERE TO EXIT IF NO TRACE REQUIRED ! 18537: * ! 18538: {KTRX3{EXI{{{{RETURN TO KTREX CALLER ! 18539: {{ENP{{{{END PROCEDURE KTREX ! 18540: {{EJC{{{{ ! 18541: * ! 18542: * KWNAM -- GET PSEUDO-VARIABLE NAME FOR KEYWORD ! 18543: * ! 18544: * 1(XS) NAME BASE FOR VRBLK ! 18545: * 0(XS) OFFSET (SHOULD BE *VRVAL) ! 18546: * JSR KWNAM CALL TO GET PSEUDO-VARIABLE NAME ! 18547: * (XS) POPPED TWICE ! 18548: * (XL,WA) RESULTING PSEUDO-VARIABLE NAME ! 18549: * (XR,WA,WB) DESTROYED ! 18550: * ! 18551: {KWNAM{PRC{N{0{{ENTRY POINT ! 18552: {{ICA{SP{{{IGNORE NAME OFFSET ! 18553: {{MOV{(SP)+{R9{{LOAD NAME BASE ! 18554: {{BGE{R9{STATE{KWNM1{JUMP IF NOT NATURAL VARIABLE NAME ! 18555: {{BNZ{4*VRLEN(R9){KWNM1{{ERROR IF NOT SYSTEM VARIABLE ! 18556: {{MOV{4*VRSVP(R9){R9{{ELSE POINT TO SVBLK ! 18557: {{MOV{4*SVBIT(R9){R6{{LOAD BIT MASK ! 18558: {{ANB{BTKNM{R6{{AND WITH KEYWORD BIT ! 18559: {{ZRB{R6{KWNM1{{ERROR IF NO KEYWORD ASSOCIATION ! 18560: {{MOV{4*SVLEN(R9){R6{{ELSE LOAD NAME LENGTH IN CHARACTERS ! 18561: {{CTB{R6{SVCHS{{COMPUTE OFFSET TO FIELD WE WANT ! 18562: {{ADD{R6{R9{{POINT TO SVKNM FIELD ! 18563: {{MOV{(R9){R7{{LOAD SVKNM VALUE ! 18564: {{MOV{#4*KVSI${R6{{SET SIZE OF KVBLK ! 18565: {{JSR{ALLOC{{{ALLOCATE KVBLK ! 18566: {{MOV{#B$KVT{(R9){{STORE TYPE WORD ! 18567: {{MOV{R7{4*KVNUM(R9){{STORE KEYWORD NUMBER ! 18568: {{MOV{#TRBKV{4*KVVAR(R9){{SET DUMMY TRBLK POINTER ! 18569: {{MOV{R9{R10{{COPY KVBLK POINTER ! 18570: {{MOV{#4*KVVAR{R6{{SET PROPER OFFSET ! 18571: {{EXI{{{{RETURN TO KVNAM CALLER ! 18572: * ! 18573: * HERE IF NOT KEYWORD NAME ! 18574: * ! 18575: {KWNM1{ERB{251{KEYWORD{{OPERAND IS NOT NAME OF DEFINED KEYWORD ! 18576: {{ENP{{{{END PROCEDURE KWNAM ! 18577: {{EJC{{{{ ! 18578: * ! 18579: * LCOMP-- COMPARE TWO STRINGS LEXICALLY ! 18580: * ! 18581: * 1(XS) FIRST ARGUMENT ! 18582: * 0(XS) SECOND ARGUMENT ! 18583: * JSR LCOMP CALL TO COMPARE ARUMENTS ! 18584: * PPM LOC TRANSFER LOC FOR ARG1 NOT STRING ! 18585: * PPM LOC TRANSFER LOC FOR ARG2 NOT STRING ! 18586: * PPM LOC TRANSFER LOC IF ARG1 LLT ARG2 ! 18587: * PPM LOC TRANSFER LOC IF ARG1 LEQ ARG2 ! 18588: * PPM LOC TRANSFER LOC IF ARG1 LGT ARG2 ! 18589: * (THE NORMAL RETURN IS NEVER TAKEN) ! 18590: * (XS) POPPED TWICE ! 18591: * (XR,XL) DESTROYED ! 18592: * (WA,WB,WC,RA) DESTROYED ! 18593: * ! 18594: {LCOMP{PRC{N{5{{ENTRY POINT ! 18595: {{JSR{GTSTG{{{CONVERT SECOND ARG TO STRING ! 18596: {{PPM{LCMP6{{{JUMP IF SECOND ARG NOT STRING ! 18597: {{MOV{R9{R10{{ELSE SAVE POINTER ! 18598: {{MOV{R6{R7{{AND LENGTH ! 18599: {{JSR{GTSTG{{{CONVERT FIRST ARGUMENT TO STRING ! 18600: {{PPM{LCMP5{{{JUMP IF NOT STRING ! 18601: {{MOV{R6{R8{{SAVE ARG 1 LENGTH ! 18602: {{PLC{R9{{{POINT TO CHARS OF ARG 1 ! 18603: {{PLC{R10{{{POINT TO CHARS OF ARG 2 ! 18604: {{BLO{R6{R7{LCMP1{JUMP IF ARG 1 LENGTH IS SMALLER ! 18605: {{MOV{R7{R6{{ELSE SET ARG 2 LENGTH AS SMALLER ! 18606: * ! 18607: * HERE WITH SMALLER LENGTH IN (WA) ! 18608: * ! 18609: {LCMP1{CMC{LCMP4{LCMP3{{COMPARE STRINGS, JUMP IF UNEQUAL ! 18610: {{BNE{R7{R8{LCMP2{IF EQUAL, JUMP IF LENGTHS UNEQUAL ! 18611: {{EXI{4{{{ELSE IDENTICAL STRINGS, LEQ EXIT ! 18612: {{EJC{{{{ ! 18613: * ! 18614: * LCOMP (CONTINUED) ! 18615: * ! 18616: * HERE IF INITIAL STRINGS IDENTICAL, BUT LENGTHS UNEQUAL ! 18617: * ! 18618: {LCMP2{BHI{R8{R7{LCMP4{JUMP IF ARG 1 LENGTH GT ARG 2 LENG ! 18619: * ! 18620: * HERE IF FIRST ARG LLT SECOND ARG ! 18621: * ! 18622: {LCMP3{EXI{3{{{TAKE LLT EXIT ! 18623: * ! 18624: * HERE IF FIRST ARG LGT SECOND ARG ! 18625: * ! 18626: {LCMP4{EXI{5{{{TAKE LGT EXIT ! 18627: * ! 18628: * HERE IF FIRST ARG IS NOT A STRING ! 18629: * ! 18630: {LCMP5{EXI{1{{{TAKE BAD FIRST ARG EXIT ! 18631: * ! 18632: * HERE FOR SECOND ARG NOT A STRING ! 18633: * ! 18634: {LCMP6{EXI{2{{{TAKE BAD SECOND ARG ERROR EXIT ! 18635: {{ENP{{{{END PROCEDURE LCOMP ! 18636: {{EJC{{{{ ! 18637: * ! 18638: * LISTR -- LIST SOURCE LINE ! 18639: * ! 18640: * LISTR IS USED TO LIST A SOURCE LINE DURING THE INITIAL ! 18641: * COMPILATION. IT IS CALLED FROM SCANE AND SCANL. ! 18642: * ! 18643: * JSR LISTR CALL TO LIST LINE ! 18644: * (XR,XL,WA,WB,WC) DESTROYED ! 18645: * ! 18646: * GLOBAL LOCATIONS USED BY LISTR ! 18647: * ! 18648: * ERLST IF LISTING ON ACCOUNT OF AN ERROR ! 18649: * ! 18650: * LSTLC COUNT LINES ON CURRENT PAGE ! 18651: * ! 18652: * LSTNP MAX NUMBER OF LINES/PAGE ! 18653: * ! 18654: * LSTPF SET NON-ZERO IF THE CURRENT SOURCE ! 18655: * LINE HAS BEEN LISTED, ELSE ZERO. ! 18656: * ! 18657: * LSTPG COMPILER LISTING PAGE NUMBER ! 18658: * ! 18659: * LSTSN SET IF STMNT NUM TO BE LISTED ! 18660: * ! 18661: * R$CIM POINTER TO CURRENT INPUT LINE. ! 18662: * ! 18663: * R$TTL TITLE FOR SOURCE LISTING ! 18664: * ! 18665: * R$STL PTR TO SUB-TITLE STRING ! 18666: * ! 18667: * ENTRY POINT ! 18668: * ! 18669: {LISTR{PRC{E{0{{ENTRY POINT ! 18670: {{BNZ{CNTTL{LIST5{{JUMP IF -TITLE OR -STITL ! 18671: {{BNZ{LSTPF{LIST4{{IMMEDIATE EXIT IF ALREADY LISTED ! 18672: {{BGE{LSTLC{LSTNP{LIST6{JUMP IF NO ROOM ! 18673: * ! 18674: * HERE AFTER PRINTING TITLE (IF NEEDED) ! 18675: * ! 18676: {LIST0{MOV{R$CIM{R9{{LOAD POINTER TO CURRENT IMAGE ! 18677: {{PLC{R9{{{POINT TO CHARACTERS ! 18678: {{LCH{R6{(R9){{LOAD FIRST CHARACTER ! 18679: {{MOV{LSTSN{R9{{LOAD STATEMENT NUMBER ! 18680: {{BZE{R9{LIST2{{JUMP IF NO STATEMENT NUMBER ! 18681: {{MTI{R9{{{ELSE GET STMNT NUMBER AS INTEGER ! 18682: {{BNE{STAGE{#STGIC{LIST1{SKIP IF EXECUTE TIME ! 18683: {{BEQ{R6{#CH$AS{LIST2{NO STMNT NUMBER LIST IF COMMENT ! 18684: {{BEQ{R6{#CH$MN{LIST2{NO STMNT NO. IF CONTROL CARD ! 18685: * ! 18686: * PRINT STATEMENT NUMBER ! 18687: * ! 18688: {LIST1{JSR{PRTIN{{{ELSE PRINT STATEMENT NUMBER ! 18689: {{ZER{LSTSN{{{AND CLEAR FOR NEXT TIME IN ! 18690: {{EJC{{{{ ! 18691: * ! 18692: * LISTR (CONTINUED) ! 18693: * ! 18694: * MERGE HERE AFTER PRINTING STATEMENT NUMBER (IF REQUIRED) ! 18695: * ! 18696: {LIST2{MOV{#STNPD{PROFS{{POINT PAST STATEMENT NUMBER ! 18697: {{MOV{R$CIM{R9{{LOAD POINTER TO CURRENT IMAGE ! 18698: {{JSR{PRTST{{{PRINT IT ! 18699: {{ICV{LSTLC{{{BUMP LINE COUNTER ! 18700: {{BNZ{ERLST{LIST3{{JUMP IF ERROR COPY TO INT.CH. ! 18701: {{JSR{PRTNL{{{TERMINATE LINE ! 18702: {{BZE{CSWDB{LIST3{{JUMP IF -SINGLE MODE ! 18703: {{JSR{PRTNL{{{ELSE ADD A BLANK LINE ! 18704: {{ICV{LSTLC{{{AND BUMP LINE COUNTER ! 18705: * ! 18706: * HERE AFTER PRINTING SOURCE IMAGE ! 18707: * ! 18708: {LIST3{MNZ{LSTPF{{{SET FLAG FOR LINE PRINTED ! 18709: * ! 18710: * MERGE HERE TO EXIT ! 18711: * ! 18712: {LIST4{EXI{{{{RETURN TO LISTR CALLER ! 18713: * ! 18714: * PRINT TITLE AFTER -TITLE OR -STITL CARD ! 18715: * ! 18716: {LIST5{ZER{CNTTL{{{CLEAR FLAG ! 18717: * ! 18718: * EJECT TO NEW PAGE AND LIST TITLE ! 18719: * ! 18720: {LIST6{JSR{PRTPS{{{EJECT ! 18721: {{BZE{PRICH{LIST7{{SKIP IF LISTING TO REGULAR PRINTER ! 18722: {{BEQ{R$TTL{#NULLS{LIST0{TERMINAL LISTING OMITS NULL TITLE ! 18723: * ! 18724: * LIST TITLE ! 18725: * ! 18726: {LIST7{JSR{LISTT{{{LIST TITLE ! 18727: {{BRN{LIST0{{{MERGE ! 18728: {{ENP{{{{END PROCEDURE LISTR ! 18729: {{EJC{{{{ ! 18730: * ! 18731: * LISTT -- LIST TITLE AND SUBTITLE ! 18732: * ! 18733: * USED DURING COMPILATION TO PRINT PAGE HEADING ! 18734: * ! 18735: * JSR LISTT CALL TO LIST TITLE ! 18736: * (XR,WA) DESTROYED ! 18737: * ! 18738: {LISTT{PRC{E{0{{ENTRY POINT ! 18739: {{MOV{R$TTL{R9{{POINT TO SOURCE LISTING TITLE ! 18740: {{JSR{PRTST{{{PRINT TITLE ! 18741: {{MOV{LSTPO{PROFS{{SET OFFSET ! 18742: {{MOV{#LSTMS{R9{{SET PAGE MESSAGE ! 18743: {{JSR{PRTST{{{PRINT PAGE MESSAGE ! 18744: {{ICV{LSTPG{{{BUMP PAGE NUMBER ! 18745: {{MTI{LSTPG{{{LOAD PAGE NUMBER AS INTEGER ! 18746: {{JSR{PRTIN{{{PRINT PAGE NUMBER ! 18747: {{JSR{PRTNL{{{TERMINATE TITLE LINE ! 18748: {{ADD{#NUM02{LSTLC{{COUNT TITLE LINE AND BLANK LINE ! 18749: * ! 18750: * PRINT SUB-TITLE (IF ANY) ! 18751: * ! 18752: {{MOV{R$STL{R9{{LOAD POINTER TO SUB-TITLE ! 18753: {{BZE{R9{LSTT1{{JUMP IF NO SUB-TITLE ! 18754: {{JSR{PRTST{{{ELSE PRINT SUB-TITLE ! 18755: {{JSR{PRTNL{{{TERMINATE LINE ! 18756: {{ICV{LSTLC{{{BUMP LINE COUNT ! 18757: * ! 18758: * RETURN POINT ! 18759: * ! 18760: {LSTT1{JSR{PRTNL{{{PRINT A BLANK LINE ! 18761: {{EXI{{{{RETURN TO CALLER ! 18762: {{ENP{{{{END PROCEDURE LISTT ! 18763: {{EJC{{{{ ! 18764: * ! 18765: * NEXTS -- ACQUIRE NEXT SOURCE IMAGE ! 18766: * ! 18767: * NEXTS IS USED TO ACQUIRE THE NEXT SOURCE IMAGE AT COMPILE ! 18768: * TIME. IT ASSUMES THAT A PRIOR CALL TO READR HAS INPUT ! 18769: * A LINE IMAGE (SEE PROCEDURE READR). BEFORE THE CURRENT ! 18770: * IMAGE IS FINALLY LOST IT MAY BE LISTED HERE. ! 18771: * ! 18772: * JSR NEXTS CALL TO ACQUIRE NEXT INPUT LINE ! 18773: * (XR,XL,WA,WB,WC) DESTROYED ! 18774: * ! 18775: * GLOBAL VALUES AFFECTED ! 18776: * ! 18777: * R$CNI ON INPUT, NEXT IMAGE. ON ! 18778: * EXIT RESET TO ZERO ! 18779: * ! 18780: * R$CIM ON EXIT, SET TO POINT TO IMAGE ! 18781: * ! 18782: * SCNIL INPUT IMAGE LENGTH ON EXIT ! 18783: * ! 18784: * SCNSE RESET TO ZERO ON EXIT ! 18785: * ! 18786: * LSTPF SET ON EXIT IF LINE IS LISTED ! 18787: * ! 18788: {NEXTS{PRC{E{0{{ENTRY POINT ! 18789: {{BZE{CSWLS{NXTS2{{JUMP IF -NOLIST ! 18790: {{MOV{R$CIM{R9{{POINT TO IMAGE ! 18791: {{BZE{R9{NXTS2{{JUMP IF NO IMAGE ! 18792: {{PLC{R9{{{GET CHAR PTR ! 18793: {{LCH{R6{(R9){{GET FIRST CHAR ! 18794: {{BNE{R6{#CH$MN{NXTS1{JUMP IF NOT CTRL CARD ! 18795: {{BZE{CSWPR{NXTS2{{JUMP IF -NOPRINT ! 18796: * ! 18797: * HERE TO CALL LISTER ! 18798: * ! 18799: {NXTS1{JSR{LISTR{{{LIST LINE ! 18800: * ! 18801: * HERE AFTER POSSIBLE LISTING ! 18802: * ! 18803: {NXTS2{MOV{R$CNI{R9{{POINT TO NEXT IMAGE ! 18804: {{MOV{R9{R$CIM{{SET AS NEXT IMAGE ! 18805: {{ZER{R$CNI{{{CLEAR NEXT IMAGE POINTER ! 18806: {{MOV{4*SCLEN(R9){R6{{GET INPUT IMAGE LENGTH ! 18807: {{MOV{CSWIN{R7{{GET MAX ALLOWABLE LENGTH ! 18808: {{BLO{R6{R7{NXTS3{SKIP IF NOT TOO LONG ! 18809: {{MOV{R7{R6{{ELSE TRUNCATE ! 18810: * ! 18811: * HERE WITH LENGTH IN (WA) ! 18812: * ! 18813: {NXTS3{MOV{R6{SCNIL{{USE AS RECORD LENGTH ! 18814: {{ZER{SCNSE{{{RESET SCNSE ! 18815: {{ZER{LSTPF{{{SET LINE NOT LISTED YET ! 18816: {{EXI{{{{RETURN TO NEXTS CALLER ! 18817: {{ENP{{{{END PROCEDURE NEXTS ! 18818: {{EJC{{{{ ! 18819: * ! 18820: * PATIN -- PATTERN CONSTRUCTION FOR LEN,POS,RPOS,TAB,RTAB ! 18821: * ! 18822: * THESE PATTERN TYPES ALL GENERATE A SIMILAR NODE TYPE. SO ! 18823: * THE CONSTRUCTION CODE IS SHARED. SEE FUNCTIONS SECTION ! 18824: * FOR ACTUAL ENTRY POINTS FOR THESE FIVE FUNCTIONS. ! 18825: * ! 18826: * (WA) PCODE FOR EXPRESSION ARG CASE ! 18827: * (WB) PCODE FOR INTEGER ARG CASE ! 18828: * JSR PATIN CALL TO BUILD PATTERN NODE ! 18829: * PPM LOC TRANSFER LOC FOR NOT INTEGER OR EXP ! 18830: * PPM LOC TRANSFER LOC FOR INT OUT OF RANGE ! 18831: * (XR) POINTER TO CONSTRUCTED NODE ! 18832: * (XL,WA,WB,WC,IA) DESTROYED ! 18833: * ! 18834: {PATIN{PRC{N{2{{ENTRY POINT ! 18835: {{MOV{R6{R10{{PRESERVE EXPRESSION ARG PCODE ! 18836: {{JSR{GTSMI{{{TRY TO CONVERT ARG AS SMALL INTEGER ! 18837: {{PPM{PTIN2{{{JUMP IF NOT INTEGER ! 18838: {{PPM{PTIN3{{{JUMP IF OUT OF RANGE ! 18839: * ! 18840: * COMMON SUCCESSFUL EXIT POINT ! 18841: * ! 18842: {PTIN1{JSR{PBILD{{{BUILD PATTERN NODE ! 18843: {{EXI{{{{RETURN TO CALLER ! 18844: * ! 18845: * HERE IF ARGUMENT IS NOT AN INTEGER ! 18846: * ! 18847: {PTIN2{MOV{R10{R7{{COPY EXPR ARG CASE PCODE ! 18848: {{BLO{(R9){#B$E$${PTIN1{ALL OK IF EXPRESSION ARG ! 18849: {{EXI{1{{{ELSE TAKE ERROR EXIT FOR WRONG TYPE ! 18850: * ! 18851: * HERE FOR ERROR OF OUT OF RANGE INTEGER ARGUMENT ! 18852: * ! 18853: {PTIN3{EXI{2{{{TAKE OUT-OF-RANGE ERROR EXIT ! 18854: {{ENP{{{{END PROCEDURE PATIN ! 18855: {{EJC{{{{ ! 18856: * ! 18857: * PATST -- PATTERN CONSTRUCTION FOR ANY,NOTANY, ! 18858: * BREAK,SPAN AND BREAKX PATTERN FUNCTIONS. ! 18859: * ! 18860: * THESE PATTERN FUNCTIONS BUILD SIMILAR TYPES OF NODES AND ! 18861: * THE CONSTRUCTION CODE IS SHARED. SEE FUNCTIONS SECTION ! 18862: * FOR ACTUAL ENTRY POINTS FOR THESE FIVE PATTERN FUNCTIONS. ! 18863: * ! 18864: * 0(XS) STRING ARGUMENT ! 18865: * (WB) PCODE FOR ONE CHAR ARGUMENT ! 18866: * (XL) PCODE FOR MULTI-CHAR ARGUMENT ! 18867: * (WC) PCODE FOR EXPRESSION ARGUMENT ! 18868: * JSR PATST CALL TO BUILD NODE ! 18869: * PPM LOC TRANSFER LOC IF NOT STRING OR EXPR ! 18870: * (XS) POPPED PAST STRING ARGUMENT ! 18871: * (XR) POINTER TO CONSTRUCTED NODE ! 18872: * (XL) DESTROYED ! 18873: * (WA,WB,WC,RA) DESTROYED ! 18874: * ! 18875: * NOTE THAT THERE IS A SPECIAL CALL TO PATST IN THE EVALS ! 18876: * PROCEDURE WITH A SLIGHTLY DIFFERENT FORM. SEE EVALS ! 18877: * FOR DETAILS OF THE FORM OF THIS CALL. ! 18878: * ! 18879: {PATST{PRC{N{1{{ENTRY POINT ! 18880: {{JSR{GTSTG{{{CONVERT ARGUMENT AS STRING ! 18881: {{PPM{PATS7{{{JUMP IF NOT STRING ! 18882: {{BNE{R6{#NUM01{PATS2{JUMP IF NOT ONE CHAR STRING ! 18883: * ! 18884: * HERE FOR ONE CHAR STRING CASE ! 18885: * ! 18886: {{BZE{R7{PATS2{{TREAT AS MULTI-CHAR IF EVALS CALL ! 18887: {{PLC{R9{{{POINT TO CHARACTER ! 18888: {{LCH{R9{(R9){{LOAD CHARACTER ! 18889: * ! 18890: * COMMON EXIT POINT AFTER SUCCESSFUL CONSTRUCTION ! 18891: * ! 18892: {PATS1{JSR{PBILD{{{CALL ROUTINE TO BUILD NODE ! 18893: {{EXI{{{{RETURN TO PATST CALLER ! 18894: {{EJC{{{{ ! 18895: * ! 18896: * PATST (CONTINUED) ! 18897: * ! 18898: * HERE FOR MULTI-CHARACTER STRING CASE ! 18899: * ! 18900: {PATS2{MOV{R10{-(SP){{SAVE MULTI-CHAR PCODE ! 18901: {{MOV{R9{-(SP){{SAVE STRING POINTER ! 18902: {{MOV{CTMSK{R8{{LOAD CURRENT MASK BIT ! 18903: {{LSH{R8{1{{SHIFT TO NEXT POSITION ! 18904: {{NZB{R8{PATS4{{SKIP IF POSITION LEFT IN THIS TBL ! 18905: * ! 18906: * HERE WE MUST ALLOCATE A NEW CHARACTER TABLE ! 18907: * ! 18908: {{MOV{#4*CTSI${R6{{SET SIZE OF CTBLK ! 18909: {{JSR{ALLOC{{{ALLOCATE CTBLK ! 18910: {{MOV{R9{R$CTP{{STORE PTR TO NEW CTBLK ! 18911: {{MOV{#B$CTT{(R9)+{{STORE TYPE CODE, BUMP PTR ! 18912: {{LCT{R7{#CFP$A{{SET NUMBER OF WORDS TO CLEAR ! 18913: {{MOV{BITS0{R8{{LOAD ALL ZERO BITS ! 18914: * ! 18915: * LOOP TO CLEAR ALL BITS IN TABLE TO ZEROS ! 18916: * ! 18917: {PATS3{MOV{R8{(R9)+{{MOVE WORD OF ZERO BITS ! 18918: {{BCT{R7{PATS3{{LOOP TILL ALL CLEARED ! 18919: {{MOV{BITS1{R8{{SET INITIAL BIT POSITION ! 18920: * ! 18921: * MERGE HERE WITH BIT POSITION AVAILABLE ! 18922: * ! 18923: {PATS4{MOV{R8{CTMSK{{SAVE PARM2 (NEW BIT POSITION) ! 18924: {{MOV{(SP)+{R10{{RESTORE POINTER TO ARGUMENT STRING ! 18925: {{MOV{4*SCLEN(R10){R7{{LOAD STRING LENGTH ! 18926: {{BZE{R7{PATS6{{JUMP IF NULL STRING CASE ! 18927: {{LCT{R7{R7{{ELSE SET LOOP COUNTER ! 18928: {{PLC{R10{{{POINT TO CHARACTERS IN ARGUMENT ! 18929: {{EJC{{{{ ! 18930: * ! 18931: * PATST (CONTINUED) ! 18932: * ! 18933: * LOOP TO SET BITS IN COLUMN OF TABLE ! 18934: * ! 18935: {PATS5{LCH{R6{(R10)+{{LOAD NEXT CHARACTER ! 18936: {{WTB{R6{{{CONVERT TO BYTE OFFSET ! 18937: {{MOV{R$CTP{R9{{POINT TO CTBLK ! 18938: {{ADD{R6{R9{{POINT TO CTBLK ENTRY ! 18939: {{MOV{R8{R6{{COPY BIT MASK ! 18940: {{ORB{4*CTCHS(R9){R6{{OR IN BITS ALREADY SET ! 18941: {{MOV{R6{4*CTCHS(R9){{STORE RESULTING BIT STRING ! 18942: {{BCT{R7{PATS5{{LOOP TILL ALL BITS SET ! 18943: * ! 18944: * COMPLETE PROCESSING FOR MUTI-CHAR STRING CASE ! 18945: * ! 18946: {PATS6{MOV{R$CTP{R9{{LOAD CTBLK PTR AS PARM1 FOR PBILD ! 18947: {{ZER{R10{{{CLEAR GARBAGE PTR IN XL ! 18948: {{MOV{(SP)+{R7{{LOAD PCODE FOR MULTI-CHAR STR CASE ! 18949: {{BRN{PATS1{{{BACK TO EXIT (WC=BITSTRING=PARM2) ! 18950: * ! 18951: * HERE IF ARGUMENT IS NOT A STRING ! 18952: * ! 18953: * NOTE THAT THE CALL FROM EVALS CANNOT PASS AN EXPRESSION ! 18954: * SINCE EVALP ALWAYS REEVALUATES EXPRESSIONS. ! 18955: * ! 18956: {PATS7{MOV{R8{R7{{SET PCODE FOR EXPRESSION ARGUMENT ! 18957: {{BLO{(R9){#B$E$${PATS1{JUMP TO EXIT IF EXPRESSION ARG ! 18958: {{EXI{1{{{ELSE TAKE WRONG TYPE ERROR EXIT ! 18959: {{ENP{{{{END PROCEDURE PATST ! 18960: {{EJC{{{{ ! 18961: * ! 18962: * PBILD -- BUILD PATTERN NODE ! 18963: * ! 18964: * (XR) PARM1 (ONLY IF REQUIRED) ! 18965: * (WB) PCODE FOR NODE ! 18966: * (WC) PARM2 (ONLY IF REQUIRED) ! 18967: * JSR PBILD CALL TO BUILD NODE ! 18968: * (XR) POINTER TO CONSTRUCTED NODE ! 18969: * (WA) DESTROYED ! 18970: * ! 18971: {PBILD{PRC{E{0{{ENTRY POINT ! 18972: {{MOV{R9{-(SP){{STACK POSSIBLE PARM1 ! 18973: {{MOV{R7{R9{{COPY PCODE ! 18974: {{LEI{R9{{{LOAD ENTRY POINT ID (BL$PX) ! 18975: {{BEQ{R9{#BL$P1{PBLD1{JUMP IF ONE PARAMETER ! 18976: {{BEQ{R9{#BL$P0{PBLD3{JUMP IF NO PARAMETERS ! 18977: * ! 18978: * HERE FOR TWO PARAMETER CASE ! 18979: * ! 18980: {{MOV{#4*PCSI${R6{{SET SIZE OF P2BLK ! 18981: {{JSR{ALLOC{{{ALLOCATE BLOCK ! 18982: {{MOV{R8{4*PARM2(R9){{STORE SECOND PARAMETER ! 18983: {{BRN{PBLD2{{{MERGE WITH ONE PARM CASE ! 18984: * ! 18985: * HERE FOR ONE PARAMETER CASE ! 18986: * ! 18987: {PBLD1{MOV{#4*PBSI${R6{{SET SIZE OF P1BLK ! 18988: {{JSR{ALLOC{{{ALLOCATE NODE ! 18989: * ! 18990: * MERGE HERE FROM TWO PARM CASE ! 18991: * ! 18992: {PBLD2{MOV{(SP){4*PARM1(R9){{STORE FIRST PARAMETER ! 18993: {{BRN{PBLD4{{{MERGE WITH NO PARAMETER CASE ! 18994: * ! 18995: * HERE FOR CASE OF NO PARAMETERS ! 18996: * ! 18997: {PBLD3{MOV{#4*PASI${R6{{SET SIZE OF P0BLK ! 18998: {{JSR{ALLOC{{{ALLOCATE NODE ! 18999: * ! 19000: * MERGE HERE FROM OTHER CASES ! 19001: * ! 19002: {PBLD4{MOV{R7{(R9){{STORE PCODE ! 19003: {{ICA{SP{{{POP FIRST PARAMETER ! 19004: {{MOV{#NDNTH{4*PTHEN(R9){{SET NOTHEN SUCCESSOR POINTER ! 19005: {{EXI{{{{RETURN TO PBILD CALLER ! 19006: {{ENP{{{{END PROCEDURE PBILD ! 19007: {{EJC{{{{ ! 19008: * ! 19009: * PCONC -- CONCATENATE TWO PATTERNS ! 19010: * ! 19011: * (XL) PTR TO RIGHT PATTERN ! 19012: * (XR) PTR TO LEFT PATTERN ! 19013: * JSR PCONC CALL TO CONCATENATE PATTERNS ! 19014: * (XR) PTR TO CONCATENATED PATTERN ! 19015: * (XL,WA,WB,WC) DESTROYED ! 19016: * ! 19017: * ! 19018: * TO CONCATENATE TWO PATTERNS, ALL SUCCESSORS IN THE LEFT ! 19019: * PATTERN WHICH POINT TO THE NOTHEN NODE MUST BE CHANGED TO ! 19020: * POINT TO THE RIGHT PATTERN. HOWEVER, THIS MODIFICATION ! 19021: * MUST BE PERFORMED ON A COPY OF THE LEFT ARGUMENT RATHER ! 19022: * THAN THE LEFT ARGUMENT ITSELF, SINCE THE LEFT ARGUMENT ! 19023: * MAY BE POINTED TO BY SOME OTHER VARIABLE VALUE. ! 19024: * ! 19025: * ACCORDINGLY, IT IS NECESSARY TO COPY THE LEFT ARGUMENT. ! 19026: * THIS IS NOT A TRIVIAL PROCESS SINCE WE MUST AVOID COPYING ! 19027: * NODES MORE THAN ONCE AND THE PATTERN IS A GRAPH STRUCTURE ! 19028: * THE FOLLOWING ALGORITHM IS EMPLOYED. ! 19029: * ! 19030: * THE STACK IS USED TO STORE A LIST OF NODES WHICH ! 19031: * HAVE ALREADY BEEN COPIED. THE FORMAT OF THE ENTRIES ON ! 19032: * THIS LIST CONSISTS OF A TWO WORD BLOCK. THE FIRST WORD ! 19033: * IS THE OLD ADDRESS AND THE SECOND WORD IS THE ADDRESS ! 19034: * OF THE COPY. THIS LIST IS SEARCHED BY THE PCOPY ! 19035: * ROUTINE TO AVOID MAKING DUPLICATE COPIES. A TRICK IS ! 19036: * USED TO ACCOMPLISH THE CONCATENATION AT THE SAME TIME. ! 19037: * A SPECIAL ENTRY IS MADE TO START WITH ON THE STACK. THIS ! 19038: * ENTRY RECORDS THAT THE NOTHEN NODE HAS BEEN COPIED ! 19039: * ALREADY AND THE ADDRESS OF ITS COPY IS THE RIGHT PATTERN. ! 19040: * THIS AUTOMATICALLY PERFORMS THE CORRECT REPLACEMENTS. ! 19041: * ! 19042: {PCONC{PRC{E{0{{ENTRY POINT ! 19043: {{ZER{-(SP){{{MAKE ROOM FOR ONE ENTRY AT BOTTOM ! 19044: {{MOV{SP{R8{{STORE POINTER TO START OF LIST ! 19045: {{MOV{#NDNTH{-(SP){{STACK NOTHEN NODE AS OLD NODE ! 19046: {{MOV{R10{-(SP){{STORE RIGHT ARG AS COPY OF NOTHEN ! 19047: {{MOV{SP{R10{{INITIALIZE POINTER TO STACK ENTRIES ! 19048: {{JSR{PCOPY{{{COPY FIRST NODE OF LEFT ARG ! 19049: {{MOV{R6{4*2(R10){{STORE AS RESULT UNDER LIST ! 19050: {{EJC{{{{ ! 19051: * ! 19052: * PCONC (CONTINUED) ! 19053: * ! 19054: * THE FOLLOWING LOOP SCANS ENTRIES IN THE LIST AND MAKES ! 19055: * SURE THAT THEIR SUCCESSORS HAVE BEEN COPIED. ! 19056: * ! 19057: {PCNC1{BEQ{R10{SP{PCNC2{JUMP IF ALL ENTRIES PROCESSED ! 19058: {{MOV{-(R10){R9{{ELSE LOAD NEXT OLD ADDRESS ! 19059: {{MOV{4*PTHEN(R9){R9{{LOAD POINTER TO SUCCESSOR ! 19060: {{JSR{PCOPY{{{COPY SUCCESSOR NODE ! 19061: {{MOV{-(R10){R9{{LOAD POINTER TO NEW NODE (COPY) ! 19062: {{MOV{R6{4*PTHEN(R9){{STORE PTR TO NEW SUCCESSOR ! 19063: * ! 19064: * NOW CHECK FOR SPECIAL CASE OF ALTERNATION NODE WHERE ! 19065: * PARM1 POINTS TO A NODE AND MUST BE COPIED LIKE PTHEN. ! 19066: * ! 19067: {{BNE{(R9){#P$ALT{PCNC1{LOOP BACK IF NOT ! 19068: {{MOV{4*PARM1(R9){R9{{ELSE LOAD POINTER TO ALTERNATIVE ! 19069: {{JSR{PCOPY{{{COPY IT ! 19070: {{MOV{(R10){R9{{RESTORE PTR TO NEW NODE ! 19071: {{MOV{R6{4*PARM1(R9){{STORE PTR TO COPIED ALTERNATIVE ! 19072: {{BRN{PCNC1{{{LOOP BACK FOR NEXT ENTRY ! 19073: * ! 19074: * HERE AT END OF COPY PROCESS ! 19075: * ! 19076: {PCNC2{MOV{R8{SP{{RESTORE STACK POINTER ! 19077: {{MOV{(SP)+{R9{{LOAD POINTER TO COPY ! 19078: {{EXI{{{{RETURN TO PCONC CALLER ! 19079: {{ENP{{{{END PROCEDURE PCONC ! 19080: {{EJC{{{{ ! 19081: * ! 19082: * PCOPY -- COPY A PATTERN NODE ! 19083: * ! 19084: * PCOPY IS CALLED FROM THE PCONC PROCEDURE TO COPY A SINGLE ! 19085: * PATTERN NODE. THE COPY IS ONLY CARRIED OUT IF THE NODE ! 19086: * HAS NOT BEEN COPIED ALREADY. ! 19087: * ! 19088: * (XR) POINTER TO NODE TO BE COPIED ! 19089: * (XT) PTR TO CURRENT LOC IN COPY LIST ! 19090: * (WC) POINTER TO LIST OF COPIED NODES ! 19091: * JSR PCOPY CALL TO COPY A NODE ! 19092: * (WA) POINTER TO COPY ! 19093: * (WB,XR) DESTROYED ! 19094: * ! 19095: {PCOPY{PRC{N{0{{ENTRY POINT ! 19096: {{MOV{R10{R7{{SAVE XT ! 19097: {{MOV{R8{R10{{POINT TO START OF LIST ! 19098: * ! 19099: * LOOP TO SEARCH LIST OF NODES COPIED ALREADY ! 19100: * ! 19101: {PCOP1{DCA{R10{{{POINT TO NEXT ENTRY ON LIST ! 19102: {{BEQ{R9{(R10){PCOP2{JUMP IF MATCH ! 19103: {{DCA{R10{{{ELSE SKIP OVER COPIED ADDRESS ! 19104: {{BNE{R10{SP{PCOP1{LOOP BACK IF MORE TO TEST ! 19105: * ! 19106: * HERE IF NOT IN LIST, PERFORM COPY ! 19107: * ! 19108: {{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK ! 19109: {{JSR{BLKLN{{{GET LENGTH OF BLOCK ! 19110: {{MOV{R9{R10{{SAVE POINTER TO OLD NODE ! 19111: {{JSR{ALLOC{{{ALLOCATE SPACE FOR COPY ! 19112: {{MOV{R10{-(SP){{STORE OLD ADDRESS ON LIST ! 19113: {{MOV{R9{-(SP){{STORE NEW ADDRESS ON LIST ! 19114: {{CHK{{{{CHECK FOR STACK OVERFLOW ! 19115: {{MVW{{{{MOVE WORDS FROM OLD BLOCK TO COPY ! 19116: {{MOV{(SP){R6{{LOAD POINTER TO COPY ! 19117: {{BRN{PCOP3{{{JUMP TO EXIT ! 19118: * ! 19119: * HERE IF WE FIND ENTRY IN LIST ! 19120: * ! 19121: {PCOP2{MOV{-(R10){R6{{LOAD ADDRESS OF COPY FROM LIST ! 19122: * ! 19123: * COMMON EXIT POINT ! 19124: * ! 19125: {PCOP3{MOV{R7{R10{{RESTORE XT ! 19126: {{EXI{{{{RETURN TO PCOPY CALLER ! 19127: {{ENP{{{{END PROCEDURE PCOPY ! 19128: {{EJC{{{{ ! 19129: * ! 19130: * PRFLR -- PRINT PROFILE ! 19131: * PRFLR IS CALLED TO PRINT THE CONTENTS OF THE PROFILE ! 19132: * TABLE IN A FAIRLY READABLE TABULAR FORMAT. ! 19133: * ! 19134: * JSR PRFLR CALL TO PRINT PROFILE ! 19135: * (WA,IA) DESTROYED ! 19136: * ! 19137: {PRFLR{PRC{E{0{{ ! 19138: {{BZE{PFDMP{PRFL4{{NO PRINTING IF NO PROFILING DONE ! 19139: {{MOV{R9{-(SP){{PRESERVE ENTRY XR ! 19140: {{MOV{R7{PFSVW{{AND ALSO WB ! 19141: {{JSR{PRTPG{{{EJECT ! 19142: {{MOV{#PFMS1{R9{{LOAD MSG /PROGRAM PROFILE/ ! 19143: {{JSR{PRTST{{{AND PRINT IT ! 19144: {{JSR{PRTNL{{{FOLLOWED BY NEWLINE ! 19145: {{JSR{PRTNL{{{AND ANOTHER ! 19146: {{MOV{#PFMS2{R9{{POINT TO FIRST HDR ! 19147: {{JSR{PRTST{{{PRINT IT ! 19148: {{JSR{PRTNL{{{NEW LINE ! 19149: {{MOV{#PFMS3{R9{{SECOND HDR ! 19150: {{JSR{PRTST{{{PRINT IT ! 19151: {{JSR{PRTNL{{{NEW LINE ! 19152: {{JSR{PRTNL{{{AND ANOTHER BLANK LINE ! 19153: {{ZER{R7{{{INITIAL STMT COUNT ! 19154: {{MOV{PFTBL{R9{{POINT TO TABLE ORIGIN ! 19155: {{ADD{#4*NUM02{R9{{BIAS PAST XNBLK HEADER (SGD07) ! 19156: * ! 19157: * LOOP HERE TO PRINT SUCCESSIVE ENTRIES ! 19158: * ! 19159: {PRFL1{ICV{R7{{{BUMP STMT NR ! 19160: {{LDI{(R9){{{LOAD NR OF EXECUTIONS ! 19161: {{IEQ{PRFL3{{{NO PRINTING IF ZERO ! 19162: {{MOV{#PFPD1{PROFS{{POINT WHERE TO PRINT ! 19163: {{JSR{PRTIN{{{AND PRINT IT ! 19164: {{ZER{PROFS{{{BACK TO START OF LINE ! 19165: {{MTI{R7{{{LOAD STMT NR ! 19166: {{JSR{PRTIN{{{PRINT IT THERE ! 19167: {{MOV{#PFPD2{PROFS{{AND PAD PAST COUNT ! 19168: {{LDI{4*CFP$I(R9){{{LOAD TOTAL EXEC TIME ! 19169: {{JSR{PRTIN{{{PRINT THAT TOO ! 19170: {{LDI{4*CFP$I(R9){{{RELOAD TIME ! 19171: {{MLI{INTTH{{{CONVERT TO MICROSEC ! 19172: {{IOV{PRFL2{{{OMIT NEXT BIT IF OVERFLOW ! 19173: {{DVI{(R9){{{DIVIDE BY EXECUTIONS ! 19174: {{MOV{#PFPD3{PROFS{{PAD LAST PRINT ! 19175: {{JSR{PRTIN{{{AND PRINT MCSEC/EXECN ! 19176: * ! 19177: * MERGE AFTER PRINTING TIME ! 19178: * ! 19179: {PRFL2{JSR{PRTNL{{{THATS ANOTHER LINE ! 19180: * ! 19181: * HERE TO GO TO NEXT ENTRY ! 19182: * ! 19183: {PRFL3{ADD{#4*PF$I2{R9{{BUMP INDEX PTR (SGD07) ! 19184: {{BLT{R7{PFNTE{PRFL1{LOOP IF MORE STMTS ! 19185: {{MOV{(SP)+{R9{{RESTORE CALLERS XR ! 19186: {{MOV{PFSVW{R7{{AND WB TOO ! 19187: * ! 19188: * HERE TO EXIT ! 19189: * ! 19190: {PRFL4{EXI{{{{RETURN ! 19191: {{ENP{{{{END OF PRFLR ! 19192: {{EJC{{{{ ! 19193: * ! 19194: * PRFLU -- UPDATE AN ENTRY IN THE PROFILE TABLE ! 19195: * ! 19196: * ON ENTRY, KVSTN CONTAINS NR OF STMT TO PROFILE ! 19197: * ! 19198: * JSR PRFLU CALL TO UPDATE ENTRY ! 19199: * (IA) DESTROYED ! 19200: * ! 19201: {PRFLU{PRC{E{0{{ ! 19202: {{BNZ{PFFNC{PFLU4{{SKIP IF JUST ENTERED FUNCTION ! 19203: {{MOV{R9{-(SP){{PRESERVE ENTRY XR ! 19204: {{MOV{R6{PFSVW{{SAVE WA (SGD07) ! 19205: {{BNZ{PFTBL{PFLU2{{BRANCH IF TABLE ALLOCATED ! 19206: * ! 19207: * HERE IF SPACE FOR PROFILE TABLE NOT YET ALLOCATED. ! 19208: * CALCULATE SIZE NEEDED, ALLOCATE A STATIC XNBLK, AND ! 19209: * INITIALIZE IT ALL TO ZERO. ! 19210: * THE TIME TAKEN FOR THIS WILL BE ATTRIBUTED TO THE CURRENT ! 19211: * STATEMENT (ASSIGNMENT TO KEYWD PROFILE), BUT SINCE THE ! 19212: * TIMING FOR THIS STATEMENT IS UP THE POLE ANYWAY, THIS ! 19213: * DOESNT REALLY MATTER... ! 19214: * ! 19215: {{SUB{#NUM01{PFNTE{{ADJUST FOR EXTRA COUNT (SGD07) ! 19216: {{MTI{PFI2A{{{CONVRT ENTRY SIZE TO INT ! 19217: {{STI{PFSTE{{{AND STORE SAFELY FOR LATER ! 19218: {{MTI{PFNTE{{{LOAD TABLE LENGTH AS INTEGER ! 19219: {{MLI{PFSTE{{{MULTIPLY BY ENTRY SIZE ! 19220: {{MFI{R6{{{GET BACK ADDRESS-STYLE ! 19221: {{ADD{#NUM02{R6{{ADD ON 2 WORD OVERHEAD ! 19222: {{WTB{R6{{{CONVERT THE WHOLE LOT TO BYTES ! 19223: {{JSR{ALOST{{{GIMME THE SPACE ! 19224: {{MOV{R9{PFTBL{{SAVE BLOCK POINTER ! 19225: {{MOV{#B$XNT{(R9)+{{PUT BLOCK TYPE AND ... ! 19226: {{MOV{R6{(R9)+{{... LENGTH INTO HEADER ! 19227: {{MFI{R6{{{GET BACK NR OF WDS IN DATA AREA ! 19228: {{LCT{R6{R6{{LOAD THE COUNTER ! 19229: * ! 19230: * LOOP HERE TO ZERO THE BLOCK DATA ! 19231: * ! 19232: {PFLU1{ZER{(R9)+{{{BLANK A WORD ! 19233: {{BCT{R6{PFLU1{{AND ALLLLLLL THE REST ! 19234: * ! 19235: * END OF ALLOCATION. MERGE BACK INTO ROUTINE ! 19236: * ! 19237: {PFLU2{MTI{KVSTN{{{LOAD NR OF STMT JUST ENDED ! 19238: {{SBI{INTV1{{{MAKE INTO INDEX OFFSET ! 19239: {{MLI{PFSTE{{{MAKE OFFSET OF TABLE ENTRY ! 19240: {{MFI{R6{{{CONVERT TO ADDRESS ! 19241: {{WTB{R6{{{GET AS BAUS ! 19242: {{ADD{#4*NUM02{R6{{OFFSET INCLUDES TABLE HEADER ! 19243: {{MOV{PFTBL{R9{{GET TABLE START ! 19244: {{BGE{R6{4*NUM01(R9){PFLU3{IF OUT OF TABLE, SKIP IT ! 19245: {{ADD{R6{R9{{ELSE POINT TO ENTRY ! 19246: {{LDI{(R9){{{GET NR OF EXECUTIONS SO FAR ! 19247: {{ADI{INTV1{{{NUDGE UP ONE ! 19248: {{STI{(R9){{{AND PUT BACK ! 19249: {{JSR{SYSTM{{{GET TIME NOW ! 19250: {{STI{PFETM{{{STASH ENDING TIME ! 19251: {{SBI{PFSTM{{{SUBTRACT START TIME ! 19252: {{ADI{4*CFP$I(R9){{{ADD CUMULATIVE TIME SO FAR ! 19253: {{STI{4*CFP$I(R9){{{AND PUT BACK NEW TOTAL ! 19254: {{LDI{PFETM{{{LOAD END TIME OF THIS STMT ... ! 19255: {{STI{PFSTM{{{... WHICH IS START TIME OF NEXT ! 19256: * ! 19257: * MERGE HERE TO EXIT ! 19258: * ! 19259: {PFLU3{MOV{(SP)+{R9{{RESTORE CALLERS XR ! 19260: {{MOV{PFSVW{R6{{RESTORE SAVED REG ! 19261: {{EXI{{{{AND RETURN ! 19262: * ! 19263: * HERE IF PROFILE IS SUPPRESSED BECAUSE A PROGRAM DEFINED ! 19264: * FUNCTION IS ABOUT TO BE ENTERED, AND SO THE CURRENT STMT ! 19265: * HAS NOT YET FINISHED ! 19266: * ! 19267: {PFLU4{ZER{PFFNC{{{RESET THE CONDITION FLAG ! 19268: {{EXI{{{{AND IMMEDIATE RETURN ! 19269: {{ENP{{{{END OF PROCEDURE PRFLU ! 19270: {{EJC{{{{ ! 19271: * ! 19272: * PRPAR - PROCESS PRINT PARAMETERS ! 19273: * ! 19274: * (WC) IF NONZERO ASSOCIATE TERMINAL ONLY ! 19275: * JSR PRPAR CALL TO PROCESS PRINT PARAMETERS ! 19276: * (XL,XR,WA,WB,WC) DESTROYED ! 19277: * ! 19278: * SINCE MEMORY ALLOCATION IS UNDECIDED ON INITIAL CALL, ! 19279: * TERMINAL CANNOT BE ASSOCIATED. THE ENTRY WITH WC NON-ZERO ! 19280: * IS PROVIDED SO A LATER CALL CAN BE MADE TO COMPLETE THIS. ! 19281: * ! 19282: {PRPAR{PRC{E{0{{ENTRY POINT ! 19283: {{BNZ{R8{PRPA7{{JUMP TO ASSOCIATE TERMINAL ! 19284: {{JSR{SYSPP{{{GET PRINT PARAMETERS ! 19285: {{BNZ{R7{PRPA1{{JUMP IF LINES/PAGE SPECIFIED ! 19286: {{MOV{#CFP$M{R7{{ELSE USE A LARGE VALUE ! 19287: {{RSH{R7{1{{BUT NOT TOO LARGE ! 19288: * ! 19289: * STORE LINE COUNT/PAGE ! 19290: * ! 19291: {PRPA1{MOV{R7{LSTNP{{STORE NUMBER OF LINES/PAGE ! 19292: {{MOV{R7{LSTLC{{PRETEND PAGE IS FULL INITIALLY ! 19293: {{ZER{LSTPG{{{CLEAR PAGE NUMBER ! 19294: {{MOV{PRLEN{R7{{GET PRIOR LENGTH IF ANY ! 19295: {{BZE{R7{PRPA2{{SKIP IF NO LENGTH ! 19296: {{BGT{R6{R7{PRPA3{SKIP STORING IF TOO BIG ! 19297: * ! 19298: * STORE PRINT BUFFER LENGTH ! 19299: * ! 19300: {PRPA2{MOV{R6{PRLEN{{STORE VALUE ! 19301: * ! 19302: * PROCESS BITS OPTIONS ! 19303: * ! 19304: {PRPA3{MOV{BITS3{R7{{BIT 3 MASK ! 19305: {{ANB{R8{R7{{GET -NOLIST BIT ! 19306: {{ZRB{R7{PRPA4{{SKIP IF CLEAR ! 19307: {{ZER{CSWLS{{{SET -NOLIST ! 19308: * ! 19309: * CHECK IF FAIL REPORTS GOTO INTERACTIVE CHANNEL ! 19310: * ! 19311: {PRPA4{MOV{BITS1{R7{{BIT 1 MASK ! 19312: {{ANB{R8{R7{{GET BIT ! 19313: {{MOV{R7{ERICH{{STORE INT. CHAN. ERROR FLAG ! 19314: {{MOV{BITS2{R7{{BIT 2 MASK ! 19315: {{ANB{R8{R7{{GET BIT ! 19316: {{MOV{R7{PRICH{{FLAG FOR STD PRINTER ON INT. CHAN. ! 19317: {{MOV{BITS4{R7{{BIT 4 MASK ! 19318: {{ANB{R8{R7{{GET BIT ! 19319: {{MOV{R7{CPSTS{{FLAG FOR COMPILE STATS SUPPRESSN. ! 19320: {{MOV{BITS5{R7{{BIT 5 MASK ! 19321: {{ANB{R8{R7{{GET BIT ! 19322: {{MOV{R7{EXSTS{{FLAG FOR EXEC STATS SUPPRESSION ! 19323: {{EJC{{{{ ! 19324: * ! 19325: * PRPAR (CONTINUED) ! 19326: * ! 19327: {{MOV{BITS6{R7{{BIT 6 MASK ! 19328: {{ANB{R8{R7{{GET BIT ! 19329: {{MOV{R7{PRECL{{EXTENDED/COMPACT LISTING FLAG ! 19330: {{SUB{#NUM08{R6{{POINT 8 CHARS FROM LINE END ! 19331: {{ZRB{R7{PRPA5{{JUMP IF NOT EXTENDED ! 19332: {{MOV{R6{LSTPO{{STORE FOR LISTING PAGE HEADINGS ! 19333: * ! 19334: * CONTINUE OPTION PROCESSING ! 19335: * ! 19336: {PRPA5{MOV{BITS7{R7{{BIT 7 MASK ! 19337: {{ANB{R8{R7{{GET BIT 7 ! 19338: {{MOV{R7{CSWEX{{SET -NOEXECUTE IF NON-ZERO ! 19339: {{MOV{BIT10{R7{{BIT 10 MASK ! 19340: {{ANB{R8{R7{{GET BIT 10 ! 19341: {{MOV{R7{HEADP{{PRETEND PRINTED TO OMIT HEADERS ! 19342: {{MOV{BITS9{R7{{BIT 9 MASK ! 19343: {{ANB{R8{R7{{GET BIT 9 ! 19344: {{MOV{R7{PRSTO{{KEEP IT AS STD LISTING OPTION ! 19345: {{ZRB{R7{PRPA6{{SKIP IF CLEAR ! 19346: {{MOV{PRLEN{R6{{GET PRINT BUFFER LENGTH ! 19347: {{SUB{#NUM08{R6{{POINT 8 CHARS FROM LINE END ! 19348: {{MOV{R6{LSTPO{{STORE PAGE OFFSET ! 19349: * ! 19350: * CHECK FOR TERMINAL ! 19351: * ! 19352: {PRPA6{ANB{BITS8{R8{{SEE IF TERMINAL TO BE ACTIVATED ! 19353: {{BNZ{R8{PRPA7{{JUMP IF TERMINAL REQUIRED ! 19354: {{BZE{INITR{PRPA8{{JUMP IF NO TERMINAL TO DETACH ! 19355: {{MOV{#V$TER{R10{{PTR TO /TERMINAL/ ! 19356: {{JSR{GTNVR{{{GET VRBLK POINTER ! 19357: {{PPM{{{{CANT FAIL ! 19358: {{MOV{#NULLS{4*VRVAL(R9){{CLEAR VALUE OF TERMINAL ! 19359: {{JSR{SETVR{{{REMOVE ASSOCIATION ! 19360: {{BRN{PRPA8{{{RETURN ! 19361: * ! 19362: * ASSOCIATE TERMINAL ! 19363: * ! 19364: {PRPA7{MNZ{INITR{{{NOTE TERMINAL ASSOCIATED ! 19365: {{BZE{DNAMB{PRPA8{{CANT IF MEMORY NOT ORGANISED ! 19366: {{MOV{#V$TER{R10{{POINT TO TERMINAL STRING ! 19367: {{MOV{#TRTOU{R7{{OUTPUT TRACE TYPE ! 19368: {{JSR{INOUT{{{ATTACH OUTPUT TRBLK TO VRBLK ! 19369: {{MOV{R9{-(SP){{STACK TRBLK PTR ! 19370: {{MOV{#V$TER{R10{{POINT TO TERMINAL STRING ! 19371: {{MOV{#TRTIN{R7{{INPUT TRACE TYPE ! 19372: {{JSR{INOUT{{{ATTACH INPUT TRACE BLK ! 19373: {{MOV{(SP)+{4*VRVAL(R9){{ADD OUTPUT TRBLK TO CHAIN ! 19374: * ! 19375: * RETURN POINT ! 19376: * ! 19377: {PRPA8{EXI{{{{RETURN ! 19378: {{ENP{{{{END PROCEDURE PRPAR ! 19379: {{EJC{{{{ ! 19380: * ! 19381: * PRTCH -- PRINT A CHARACTER ! 19382: * ! 19383: * PRTCH IS USED TO PRINT A SINGLE CHARACTER ! 19384: * ! 19385: * (WA) CHARACTER TO BE PRINTED ! 19386: * JSR PRTCH CALL TO PRINT CHARACTER ! 19387: * ! 19388: {PRTCH{PRC{E{0{{ENTRY POINT ! 19389: {{MOV{R9{-(SP){{SAVE XR ! 19390: {{BNE{PROFS{PRLEN{PRCH1{JUMP IF ROOM IN BUFFER ! 19391: {{JSR{PRTNL{{{ELSE PRINT THIS LINE ! 19392: * ! 19393: * HERE AFTER MAKING SURE WE HAVE ROOM ! 19394: * ! 19395: {PRCH1{MOV{PRBUF{R9{{POINT TO PRINT BUFFER ! 19396: {{PSC{R9{PROFS{{POINT TO NEXT CHARACTER LOCATION ! 19397: {{SCH{R6{(R9){{STORE NEW CHARACTER ! 19398: {{CSC{R9{{{COMPLETE STORE CHARACTERS ! 19399: {{ICV{PROFS{{{BUMP POINTER ! 19400: {{MOV{(SP)+{R9{{RESTORE ENTRY XR ! 19401: {{EXI{{{{RETURN TO PRTCH CALLER ! 19402: {{ENP{{{{END PROCEDURE PRTCH ! 19403: {{EJC{{{{ ! 19404: * ! 19405: * PRTIC -- PRINT TO INTERACTIVE CHANNEL ! 19406: * ! 19407: * PRTIC IS CALLED TO PRINT THE CONTENTS OF THE STANDARD ! 19408: * PRINT BUFFER TO THE INTERACTIVE CHANNEL. IT IS ONLY ! 19409: * CALLED AFTER PRTST HAS SET UP THE STRING FOR PRINTING. ! 19410: * IT DOES NOT CLEAR THE BUFFER. ! 19411: * ! 19412: * JSR PRTIC CALL FOR PRINT ! 19413: * (WA,WB) DESTROYED ! 19414: * ! 19415: {PRTIC{PRC{E{0{{ENTRY POINT ! 19416: {{MOV{R9{-(SP){{SAVE XR ! 19417: {{MOV{PRBUF{R9{{POINT TO BUFFER ! 19418: {{MOV{PROFS{R6{{NO OF CHARS ! 19419: {{JSR{SYSPI{{{PRINT ! 19420: {{PPM{PRTC2{{{FAIL RETURN ! 19421: * ! 19422: * RETURN ! 19423: * ! 19424: {PRTC1{MOV{(SP)+{R9{{RESTORE XR ! 19425: {{EXI{{{{RETURN ! 19426: * ! 19427: * ERROR OCCURED ! 19428: * ! 19429: {PRTC2{ZER{ERICH{{{PREVENT LOOPING ! 19430: {{ERB{252{ERROR{{ON PRINTING TO INTERACTIVE CHANNEL ! 19431: {{BRN{PRTC1{{{RETURN ! 19432: {{ENP{{{{PROCEDURE PRTIC ! 19433: {{EJC{{{{ ! 19434: * ! 19435: * PRTIS -- PRINT TO INTERACTIVE AND STANDARD PRINTER ! 19436: * ! 19437: * PRTIS PUTS A LINE FROM THE PRINT BUFFER ONTO THE ! 19438: * INTERACTIVE CHANNEL (IF ANY) AND THE STANDARD PRINTER. ! 19439: * IT ALWAYS PRINTS TO THE STANDARD PRINTER BUT DOES ! 19440: * NOT DUPLICATE LINES IF THE STANDARD PRINTER IS ! 19441: * INTERACTIVE. IT CLEARS DOWN THE PRINT BUFFER. ! 19442: * ! 19443: * JSR PRTIS CALL FOR PRINTING ! 19444: * (WA,WB) DESTROYED ! 19445: * ! 19446: {PRTIS{PRC{E{0{{ENTRY POINT ! 19447: {{BNZ{PRICH{PRTS1{{JUMP IF STANDARD PRINTER IS INT.CH. ! 19448: {{BZE{ERICH{PRTS1{{SKIP IF NOT DOING INT. ERROR REPS. ! 19449: {{JSR{PRTIC{{{PRINT TO INTERACTIVE CHANNEL ! 19450: * ! 19451: * MERGE AND EXIT ! 19452: * ! 19453: {PRTS1{JSR{PRTNL{{{PRINT TO STANDARD PRINTER ! 19454: {{EXI{{{{RETURN ! 19455: {{ENP{{{{END PROCEDURE PRTIS ! 19456: {{EJC{{{{ ! 19457: * ! 19458: * PRTIN -- PRINT AN INTEGER ! 19459: * ! 19460: * PRTIN PRINTS THE INTEGER VALUE WHICH IS IN THE INTEGER ! 19461: * ACCUMULATOR. BLOCKS BUILT IN DYNAMIC STORAGE ! 19462: * DURING THIS PROCESS ARE IMMEDIATELY DELETED. ! 19463: * ! 19464: * (IA) INTEGER VALUE TO BE PRINTED ! 19465: * JSR PRTIN CALL TO PRINT INTEGER ! 19466: * (IA,RA) DESTROYED ! 19467: * ! 19468: {PRTIN{PRC{E{0{{ENTRY POINT ! 19469: {{MOV{R9{-(SP){{SAVE XR ! 19470: {{JSR{ICBLD{{{BUILD INTEGER BLOCK ! 19471: {{BLO{R9{DNAMB{PRTI1{JUMP IF ICBLK BELOW DYNAMIC ! 19472: {{BHI{R9{DNAMP{PRTI1{JUMP IF ABOVE DYNAMIC ! 19473: {{MOV{R9{DNAMP{{IMMEDIATELY DELETE IT ! 19474: * ! 19475: * DELETE ICBLK FROM DYNAMIC STORE ! 19476: * ! 19477: {PRTI1{MOV{R9{-(SP){{STACK PTR FOR GTSTG ! 19478: {{JSR{GTSTG{{{CONVERT TO STRING ! 19479: {{PPM{{{{CONVERT ERROR IS IMPOSSIBLE ! 19480: {{MOV{R9{DNAMP{{RESET POINTER TO DELETE SCBLK ! 19481: {{JSR{PRTST{{{PRINT INTEGER STRING ! 19482: {{MOV{(SP)+{R9{{RESTORE ENTRY XR ! 19483: {{EXI{{{{RETURN TO PRTIN CALLER ! 19484: {{ENP{{{{END PROCEDURE PRTIN ! 19485: {{EJC{{{{ ! 19486: * ! 19487: * PRTMI -- PRINT MESSAGE AND INTEGER ! 19488: * ! 19489: * PRTMI IS USED TO PRINT MESSAGES TOGETHER WITH AN INTEGER ! 19490: * VALUE STARTING IN COLUMN 15 (USED BY THE ROUTINES AT ! 19491: * THE END OF COMPILATION). ! 19492: * ! 19493: * JSR PRTMI CALL TO PRINT MESSAGE AND INTEGER ! 19494: * ! 19495: {PRTMI{PRC{E{0{{ENTRY POINT ! 19496: {{JSR{PRTST{{{PRINT STRING MESSAGE ! 19497: {{MOV{#PRTMF{PROFS{{SET OFFSET TO COL 15 ! 19498: {{JSR{PRTIN{{{PRINT INTEGER ! 19499: {{JSR{PRTNL{{{PRINT LINE ! 19500: {{EXI{{{{RETURN TO PRTMI CALLER ! 19501: {{ENP{{{{END PROCEDURE PRTMI ! 19502: {{EJC{{{{ ! 19503: * ! 19504: * PRTMX -- AS PRTMI WITH EXTRA COPY TO INTERACTIVE CHAN. ! 19505: * ! 19506: * JSR PRTMX CALL FOR PRINTING ! 19507: * (WA,WB) DESTROYED ! 19508: * ! 19509: {PRTMX{PRC{E{0{{ENTRY POINT ! 19510: {{JSR{PRTST{{{PRINT STRING MESSAGE ! 19511: {{MOV{#PRTMF{PROFS{{SET PTR TO COLUMN 15 ! 19512: {{JSR{PRTIN{{{PRINT INTEGER ! 19513: {{JSR{PRTIS{{{PRINT LINE ! 19514: {{EXI{{{{RETURN ! 19515: {{ENP{{{{END PROCEDURE PRTMX ! 19516: {{EJC{{{{ ! 19517: * ! 19518: * PRTNL -- PRINT NEW LINE (END PRINT LINE) ! 19519: * ! 19520: * PRTNL PRINTS THE CONTENTS OF THE PRINT BUFFER, RESETS ! 19521: * THE BUFFER TO ALL BLANKS AND RESETS THE PRINT POINTER. ! 19522: * ! 19523: * JSR PRTNL CALL TO PRINT LINE ! 19524: * ! 19525: {PRTNL{PRC{R{0{{ENTRY POINT ! 19526: {{BNZ{HEADP{PRNL0{{WERE HEADERS PRINTED ! 19527: {{JSR{PRTPS{{{NO - PRINT THEM ! 19528: * ! 19529: * CALL SYSPR ! 19530: * ! 19531: {PRNL0{MOV{R9{-(SP){{SAVE ENTRY XR ! 19532: {{MOV{R6{PRTSA{{SAVE WA ! 19533: {{MOV{R7{PRTSB{{SAVE WB ! 19534: {{MOV{PRBUF{R9{{LOAD POINTER TO BUFFER ! 19535: {{MOV{PROFS{R6{{LOAD NUMBER OF CHARS IN BUFFER ! 19536: {{JSR{SYSPR{{{CALL SYSTEM PRINT ROUTINE ! 19537: {{PPM{PRNL2{{{JUMP IF FAILED ! 19538: {{LCT{R6{PRLNW{{LOAD LENGTH OF BUFFER IN WORDS ! 19539: {{ADD{#4*SCHAR{R9{{POINT TO CHARS OF BUFFER ! 19540: {{MOV{NULLW{R7{{GET WORD OF BLANKS ! 19541: * ! 19542: * LOOP TO BLANK BUFFER ! 19543: * ! 19544: {PRNL1{MOV{R7{(R9)+{{STORE WORD OF BLANKS, BUMP PTR ! 19545: {{BCT{R6{PRNL1{{LOOP TILL ALL BLANKED ! 19546: * ! 19547: * EXIT POINT ! 19548: * ! 19549: {{MOV{PRTSB{R7{{RESTORE WB ! 19550: {{MOV{PRTSA{R6{{RESTORE WA ! 19551: {{MOV{(SP)+{R9{{RESTORE ENTRY XR ! 19552: {{ZER{PROFS{{{RESET PRINT BUFFER POINTER ! 19553: {{EXI{{{{RETURN TO PRTNL CALLER ! 19554: * ! 19555: * FILE FULL OR NO OUTPUT FILE FOR LOAD MODULE ! 19556: * ! 19557: {PRNL2{BNZ{PRTEF{PRNL3{{JUMP IF NOT FIRST TIME ! 19558: {{MNZ{PRTEF{{{MARK FIRST OCCURRENCE ! 19559: {{ERB{253{PRINT{{LIMIT EXCEEDED ON STANDARD OUTPUT CHANNEL ! 19560: * ! 19561: * STOP AT ONCE ! 19562: * ! 19563: {PRNL3{MOV{#NINI8{R7{{ENDING CODE ! 19564: {{MOV{KVSTN{R6{{STATEMENT NUMBER ! 19565: {{JSR{SYSEJ{{{STOP ! 19566: {{ENP{{{{END PROCEDURE PRTNL ! 19567: {{EJC{{{{ ! 19568: * ! 19569: * PRTNM -- PRINT VARIABLE NAME ! 19570: * ! 19571: * PRTNM IS USED TO PRINT A CHARACTER REPRESENTATION OF THE ! 19572: * NAME OF A VARIABLE (NOT A VALUE OF DATATYPE NAME) ! 19573: * NAMES OF PSEUDO-VARIABLES MAY NOT BE PASSED TO PRTNM. ! 19574: * ! 19575: * (XL) NAME BASE ! 19576: * (WA) NAME OFFSET ! 19577: * JSR PRTNM CALL TO PRINT NAME ! 19578: * (WB,WC,RA) DESTROYED ! 19579: * ! 19580: {PRTNM{PRC{R{0{{ENTRY POINT (RECURSIVE, SEE PRTVL) ! 19581: {{MOV{R6{-(SP){{SAVE WA (OFFSET IS COLLECTABLE) ! 19582: {{MOV{R9{-(SP){{SAVE ENTRY XR ! 19583: {{MOV{R10{-(SP){{SAVE NAME BASE ! 19584: {{BHI{R10{STATE{PRN02{JUMP IF NOT NATURAL VARIABLE ! 19585: * ! 19586: * HERE FOR NATURAL VARIABLE NAME, RECOGNIZED BY THE FACT ! 19587: * THAT THE NAME BASE POINTS INTO THE STATIC AREA. ! 19588: * ! 19589: {{MOV{R10{R9{{POINT TO VRBLK ! 19590: {{JSR{PRTVN{{{PRINT NAME OF VARIABLE ! 19591: * ! 19592: * COMMON EXIT POINT ! 19593: * ! 19594: {PRN01{MOV{(SP)+{R10{{RESTORE NAME BASE ! 19595: {{MOV{(SP)+{R9{{RESTORE ENTRY VALUE OF XR ! 19596: {{MOV{(SP)+{R6{{RESTORE WA ! 19597: {{EXI{{{{RETURN TO PRTNM CALLER ! 19598: * ! 19599: * HERE FOR CASE OF NON-NATURAL VARIABLE ! 19600: * ! 19601: {PRN02{MOV{R6{R7{{COPY NAME OFFSET ! 19602: {{BNE{(R10){#B$PDT{PRN03{JUMP IF ARRAY OR TABLE ! 19603: * ! 19604: * FOR PROGRAM DEFINED DATATYPE, PRT FLD NAME, LEFT PAREN ! 19605: * ! 19606: {{MOV{4*PDDFP(R10){R9{{LOAD POINTER TO DFBLK ! 19607: {{ADD{R6{R9{{ADD NAME OFFSET ! 19608: {{MOV{4*PDFOF(R9){R9{{LOAD VRBLK POINTER FOR FIELD ! 19609: {{JSR{PRTVN{{{PRINT FIELD NAME ! 19610: {{MOV{#CH$PP{R6{{LOAD LEFT PAREN ! 19611: {{JSR{PRTCH{{{PRINT CHARACTER ! 19612: {{EJC{{{{ ! 19613: * ! 19614: * PRTNM (CONTINUED) ! 19615: * ! 19616: * NOW WE PRINT AN IDENTIFYING NAME FOR THE OBJECT IF ONE ! 19617: * CAN BE FOUND. THE FOLLOWING CODE SEARCHES FOR A NATURAL ! 19618: * VARIABLE WHICH CONTAINS THIS OBJECT AS VALUE. IF SUCH A ! 19619: * VARIABLE IS FOUND, ITS NAME IS PRINTED, ELSE THE VALUE ! 19620: * OF THE OBJECT (AS PRINTED BY PRTVL) IS USED INSTEAD. ! 19621: * ! 19622: * FIRST WE POINT TO THE PARENT TBBLK IF THIS IS THE CASE OF ! 19623: * A TABLE ELEMENT. TO DO THIS, CHASE DOWN THE TRNXT CHAIN. ! 19624: * ! 19625: {PRN03{BNE{(R10){#B$TET{PRN04{JUMP IF WE GOT THERE (OR NOT TE) ! 19626: {{MOV{4*TENXT(R10){R10{{ELSE MOVE OUT ON CHAIN ! 19627: {{BRN{PRN03{{{AND LOOP BACK ! 19628: * ! 19629: * NOW WE ARE READY FOR THE SEARCH. TO SPEED THINGS UP IN ! 19630: * THE CASE OF CALLS FROM DUMP WHERE THE SAME NAME BASE ! 19631: * WILL OCCUR REPEATEDLY WHILE DUMPING AN ARRAY OR TABLE, ! 19632: * WE REMEMBER THE LAST VRBLK POINTER FOUND IN PRNMV. SO ! 19633: * FIRST CHECK TO SEE IF WE HAVE THIS ONE AGAIN. ! 19634: * ! 19635: {PRN04{MOV{PRNMV{R9{{POINT TO VRBLK WE FOUND LAST TIME ! 19636: {{MOV{HSHTB{R6{{POINT TO HASH TABLE IN CASE NOT ! 19637: {{BRN{PRN07{{{JUMP INTO SEARCH FOR SPECIAL CHECK ! 19638: * ! 19639: * LOOP THROUGH HASH SLOTS ! 19640: * ! 19641: {PRN05{MOV{R6{R9{{COPY SLOT POINTER ! 19642: {{ICA{R6{{{BUMP SLOT POINTER ! 19643: {{SUB{#4*VRNXT{R9{{INTRODUCE STANDARD VRBLK OFFSET ! 19644: * ! 19645: * LOOP THROUGH VRBLKS ON ONE HASH CHAIN ! 19646: * ! 19647: {PRN06{MOV{4*VRNXT(R9){R9{{POINT TO NEXT VRBLK ON HASH CHAIN ! 19648: * ! 19649: * MERGE HERE FIRST TIME TO CHECK BLOCK WE FOUND LAST TIME ! 19650: * ! 19651: {PRN07{MOV{R9{R8{{COPY VRBLK POINTER ! 19652: {{BZE{R8{PRN09{{JUMP IF CHAIN END (OR PRNMV ZERO) ! 19653: {{EJC{{{{ ! 19654: * ! 19655: * PRTNM (CONTINUED) ! 19656: * ! 19657: * LOOP TO FIND VALUE (CHASE DOWN POSSIBLE TRBLK CHAIN) ! 19658: * ! 19659: {PRN08{MOV{4*VRVAL(R9){R9{{LOAD VALUE ! 19660: {{BEQ{(R9){#B$TRT{PRN08{LOOP IF THAT WAS A TRBLK ! 19661: * ! 19662: * NOW WE HAVE THE VALUE, IS THIS THE BLOCK WE WANT ! 19663: * ! 19664: {{BEQ{R9{R10{PRN10{JUMP IF THIS MATCHES THE NAME BASE ! 19665: {{MOV{R8{R9{{ELSE POINT BACK TO THAT VRBLK ! 19666: {{BRN{PRN06{{{AND LOOP BACK ! 19667: * ! 19668: * HERE TO MOVE TO NEXT HASH SLOT ! 19669: * ! 19670: {PRN09{BLT{R6{HSHTE{PRN05{LOOP BACK IF MORE TO GO ! 19671: {{MOV{R10{R9{{ELSE NOT FOUND, COPY VALUE POINTER ! 19672: {{JSR{PRTVL{{{PRINT VALUE ! 19673: {{BRN{PRN11{{{AND MERGE AHEAD ! 19674: * ! 19675: * HERE WHEN WE FIND A MATCHING ENTRY ! 19676: * ! 19677: {PRN10{MOV{R8{R9{{COPY VRBLK POINTER ! 19678: {{MOV{R9{PRNMV{{SAVE FOR NEXT TIME IN ! 19679: {{JSR{PRTVN{{{PRINT VARIABLE NAME ! 19680: * ! 19681: * MERGE HERE IF NO ENTRY FOUND ! 19682: * ! 19683: {PRN11{MOV{(R10){R8{{LOAD FIRST WORD OF NAME BASE ! 19684: {{BNE{R8{#B$PDT{PRN13{JUMP IF NOT PROGRAM DEFINED ! 19685: * ! 19686: * FOR PROGRAM DEFINED DATATYPE, ADD RIGHT PAREN AND EXIT ! 19687: * ! 19688: {{MOV{#CH$RP{R6{{LOAD RIGHT PAREN, MERGE ! 19689: * ! 19690: * MERGE HERE TO PRINT FINAL RIGHT PAREN OR BRACKET ! 19691: * ! 19692: {PRN12{JSR{PRTCH{{{PRINT FINAL CHARACTER ! 19693: {{MOV{R7{R6{{RESTORE NAME OFFSET ! 19694: {{BRN{PRN01{{{MERGE BACK TO EXIT ! 19695: {{EJC{{{{ ! 19696: * ! 19697: * PRTNM (CONTINUED) ! 19698: * ! 19699: * HERE FOR ARRAY OR TABLE ! 19700: * ! 19701: {PRN13{MOV{#CH$BB{R6{{LOAD LEFT BRACKET ! 19702: {{JSR{PRTCH{{{AND PRINT IT ! 19703: {{MOV{(SP){R10{{RESTORE BLOCK POINTER ! 19704: {{MOV{(R10){R8{{LOAD TYPE WORD AGAIN ! 19705: {{BNE{R8{#B$TET{PRN15{JUMP IF NOT TABLE ! 19706: * ! 19707: * HERE FOR TABLE, PRINT SUBSCRIPT VALUE ! 19708: * ! 19709: {{MOV{4*TESUB(R10){R9{{LOAD SUBSCRIPT VALUE ! 19710: {{MOV{R7{R10{{SAVE NAME OFFSET ! 19711: {{JSR{PRTVL{{{PRINT SUBSCRIPT VALUE ! 19712: {{MOV{R10{R7{{RESTORE NAME OFFSET ! 19713: * ! 19714: * MERGE HERE FROM ARRAY CASE TO PRINT RIGHT BRACKET ! 19715: * ! 19716: {PRN14{MOV{#CH$RB{R6{{LOAD RIGHT BRACKET ! 19717: {{BRN{PRN12{{{MERGE BACK TO PRINT IT ! 19718: * ! 19719: * HERE FOR ARRAY OR VECTOR, TO PRINT SUBSCRIPT(S) ! 19720: * ! 19721: {PRN15{MOV{R7{R6{{COPY NAME OFFSET ! 19722: {{BTW{R6{{{CONVERT TO WORDS ! 19723: {{BEQ{R8{#B$ART{PRN16{JUMP IF ARBLK ! 19724: * ! 19725: * HERE FOR VECTOR ! 19726: * ! 19727: {{SUB{#VCVLB{R6{{ADJUST FOR STANDARD FIELDS ! 19728: {{MTI{R6{{{MOVE TO INTEGER ACCUM ! 19729: {{JSR{PRTIN{{{PRINT LINEAR SUBSCRIPT ! 19730: {{BRN{PRN14{{{MERGE BACK FOR RIGHT BRACKET ! 19731: {{EJC{{{{ ! 19732: * ! 19733: * PRTNM (CONTINUED) ! 19734: * ! 19735: * HERE FOR ARRAY. FIRST CALCULATE ABSOLUTE SUBSCRIPT ! 19736: * OFFSETS BY SUCCESSIVE DIVISIONS BY THE DIMENSION VALUES. ! 19737: * THIS MUST BE DONE RIGHT TO LEFT SINCE THE ELEMENTS ARE ! 19738: * STORED ROW-WISE. THE SUBSCRIPTS ARE STACKED AS INTEGERS. ! 19739: * ! 19740: {PRN16{MOV{4*AROFS(R10){R8{{LOAD LENGTH OF BOUNDS INFO ! 19741: {{ICA{R8{{{ADJUST FOR ARPRO FIELD ! 19742: {{BTW{R8{{{CONVERT TO WORDS ! 19743: {{SUB{R8{R6{{GET LINEAR ZERO-ORIGIN SUBSCRIPT ! 19744: {{MTI{R6{{{GET INTEGER VALUE ! 19745: {{LCT{R6{4*ARNDM(R10){{SET NUM OF DIMENSIONS AS LOOP COUNT ! 19746: {{ADD{4*AROFS(R10){R10{{POINT PAST BOUNDS INFORMATION ! 19747: {{SUB{#4*ARLBD{R10{{SET OK OFFSET FOR PROPER PTR LATER ! 19748: * ! 19749: * LOOP TO STACK SUBSCRIPT OFFSETS ! 19750: * ! 19751: {PRN17{SUB{#4*ARDMS{R10{{POINT TO NEXT SET OF BOUNDS ! 19752: {{STI{PRNSI{{{SAVE CURRENT OFFSET ! 19753: {{RMI{4*ARDIM(R10){{{GET REMAINDER ON DIVIDING BY DIMENS ! 19754: {{MFI{-(SP){{{STORE ON STACK (ONE WORD) ! 19755: {{LDI{PRNSI{{{RELOAD ARGUMENT ! 19756: {{DVI{4*ARDIM(R10){{{DIVIDE TO GET QUOTIENT ! 19757: {{BCT{R6{PRN17{{LOOP TILL ALL STACKED ! 19758: {{ZER{R9{{{SET OFFSET TO FIRST SET OF BOUNDS ! 19759: {{LCT{R7{4*ARNDM(R10){{LOAD COUNT OF DIMS TO CONTROL LOOP ! 19760: {{BRN{PRN19{{{JUMP INTO PRINT LOOP ! 19761: * ! 19762: * LOOP TO PRINT SUBSCRIPTS FROM STACK ADJUSTING BY ADDING ! 19763: * THE APPROPRIATE LOW BOUND VALUE FROM THE ARBLK ! 19764: * ! 19765: {PRN18{MOV{#CH$CM{R6{{LOAD A COMMA ! 19766: {{JSR{PRTCH{{{PRINT IT ! 19767: * ! 19768: * MERGE HERE FIRST TIME IN (NO COMMA REQUIRED) ! 19769: * ! 19770: {PRN19{MTI{(SP)+{{{LOAD SUBSCRIPT OFFSET AS INTEGER ! 19771: {{ADD{R9{R10{{POINT TO CURRENT LBD ! 19772: {{ADI{4*ARLBD(R10){{{ADD LBD TO GET SIGNED SUBSCRIPT ! 19773: {{SUB{R9{R10{{POINT BACK TO START OF ARBLK ! 19774: {{JSR{PRTIN{{{PRINT SUBSCRIPT ! 19775: {{ADD{#4*ARDMS{R9{{BUMP OFFSET TO NEXT BOUNDS ! 19776: {{BCT{R7{PRN18{{LOOP BACK TILL ALL PRINTED ! 19777: {{BRN{PRN14{{{MERGE BACK TO PRINT RIGHT BRACKET ! 19778: {{ENP{{{{END PROCEDURE PRTNM ! 19779: {{EJC{{{{ ! 19780: * ! 19781: * PRTNV -- PRINT NAME VALUE ! 19782: * ! 19783: * PRTNV IS USED BY THE TRACE AND DUMP ROUTINES TO PRINT ! 19784: * A LINE OF THE FORM ! 19785: * ! 19786: * NAME = VALUE ! 19787: * ! 19788: * NOTE THAT THE NAME INVOLVED CAN NEVER BE A PSEUDO-VAR ! 19789: * ! 19790: * (XL) NAME BASE ! 19791: * (WA) NAME OFFSET ! 19792: * JSR PRTNV CALL TO PRINT NAME = VALUE ! 19793: * (WB,WC,RA) DESTROYED ! 19794: * ! 19795: {PRTNV{PRC{E{0{{ENTRY POINT ! 19796: {{JSR{PRTNM{{{PRINT ARGUMENT NAME ! 19797: {{MOV{R9{-(SP){{SAVE ENTRY XR ! 19798: {{MOV{R6{-(SP){{SAVE NAME OFFSET (COLLECTABLE) ! 19799: {{MOV{#TMBEB{R9{{POINT TO BLANK EQUAL BLANK ! 19800: {{JSR{PRTST{{{PRINT IT ! 19801: {{MOV{R10{R9{{COPY NAME BASE ! 19802: {{ADD{R6{R9{{POINT TO VALUE ! 19803: {{MOV{(R9){R9{{LOAD VALUE POINTER ! 19804: {{JSR{PRTVL{{{PRINT VALUE ! 19805: {{JSR{PRTNL{{{TERMINATE LINE ! 19806: {{MOV{(SP)+{R6{{RESTORE NAME OFFSET ! 19807: {{MOV{(SP)+{R9{{RESTORE ENTRY XR ! 19808: {{EXI{{{{RETURN TO CALLER ! 19809: {{ENP{{{{END PROCEDURE PRTNV ! 19810: {{EJC{{{{ ! 19811: * ! 19812: * PRTPG -- PRINT A PAGE THROW ! 19813: * ! 19814: * PRINTS A PAGE THROW OR A FEW BLANK LINES ON THE STANDARD ! 19815: * LISTING CHANNEL DEPENDING ON THE LISTING OPTIONS CHOSEN. ! 19816: * ! 19817: * JSR PRTPG CALL FOR PAGE EJECT ! 19818: * ! 19819: {PRTPG{PRC{E{0{{ENTRY POINT ! 19820: {{BEQ{STAGE{#STGXT{PRP01{JUMP IF EXECUTION TIME ! 19821: {{BZE{LSTLC{PRP06{{RETURN IF TOP OF PAGE ALREADY ! 19822: {{ZER{LSTLC{{{CLEAR LINE COUNT ! 19823: * ! 19824: * CHECK TYPE OF LISTING ! 19825: * ! 19826: {PRP01{MOV{R9{-(SP){{PRESERVE XR ! 19827: {{BNZ{PRSTD{PRP02{{EJECT IF FLAG SET ! 19828: {{BNZ{PRICH{PRP03{{JUMP IF INTERACTIVE LISTING CHANNEL ! 19829: {{BZE{PRECL{PRP03{{JUMP IF COMPACT LISTING ! 19830: * ! 19831: * PERFORM AN EJECT ! 19832: * ! 19833: {PRP02{JSR{SYSEP{{{EJECT ! 19834: {{BRN{PRP04{{{MERGE ! 19835: * ! 19836: * COMPACT OR INTERACTIVE CHANNEL LISTING. CANT PRINT ! 19837: * BLANKS UNTIL CHECK MADE FOR HEADERS PRINTED AND FLAG SET. ! 19838: * ! 19839: * ! 19840: {PRP03{MOV{HEADP{R9{{REMEMBER HEADP ! 19841: {{MNZ{HEADP{{{SET TO AVOID REPEATED PRTPG CALLS ! 19842: {{JSR{PRTNL{{{PRINT BLANK LINE ! 19843: {{JSR{PRTNL{{{PRINT BLANK LINE ! 19844: {{JSR{PRTNL{{{PRINT BLANK LINE ! 19845: {{MOV{#NUM03{LSTLC{{COUNT BLANK LINES ! 19846: {{MOV{R9{HEADP{{RESTORE HEADER FLAG ! 19847: {{EJC{{{{ ! 19848: * ! 19849: * PRPTG (CONTINUED) ! 19850: * ! 19851: * PRINT THE HEADING ! 19852: * ! 19853: {PRP04{BNZ{HEADP{PRP05{{JUMP IF HEADER LISTED ! 19854: {{MNZ{HEADP{{{MARK HEADERS PRINTED ! 19855: {{MOV{R10{-(SP){{KEEP XL ! 19856: {{MOV{#HEADR{R9{{POINT TO LISTING HEADER ! 19857: {{JSR{PRTST{{{PLACE IT ! 19858: {{JSR{SYSID{{{GET SYSTEM IDENTIFICATION ! 19859: {{JSR{PRTST{{{APPEND EXTRA CHARS ! 19860: {{JSR{PRTNL{{{PRINT IT ! 19861: {{MOV{R10{R9{{EXTRA HEADER LINE ! 19862: {{JSR{PRTST{{{PLACE IT ! 19863: {{JSR{PRTNL{{{PRINT IT ! 19864: {{JSR{PRTNL{{{PRINT A BLANK ! 19865: {{JSR{PRTNL{{{AND ANOTHER ! 19866: {{ADD{#NUM04{LSTLC{{FOUR HEADER LINES PRINTED ! 19867: {{MOV{(SP)+{R10{{RESTORE XL ! 19868: * ! 19869: * MERGE IF HEADER NOT PRINTED ! 19870: * ! 19871: {PRP05{MOV{(SP)+{R9{{RESTORE XR ! 19872: * ! 19873: * RETURN ! 19874: * ! 19875: {PRP06{EXI{{{{RETURN ! 19876: {{ENP{{{{END PROCEDURE PRTPG ! 19877: {{EJC{{{{ ! 19878: * ! 19879: * PRTPS - PRINT PAGE WITH TEST FOR STANDARD LISTING OPTION ! 19880: * ! 19881: * IF THE STANDARD LISTING OPTION IS SELECTED, INSIST THAT ! 19882: * AN EJECT BE DONE ! 19883: * ! 19884: * JSR PRTPS CALL FOR EJECT ! 19885: * ! 19886: {PRTPS{PRC{E{0{{ENTRY POINT ! 19887: {{MOV{PRSTO{PRSTD{{COPY OPTION FLAG ! 19888: {{JSR{PRTPG{{{PRINT PAGE ! 19889: {{ZER{PRSTD{{{CLEAR FLAG ! 19890: {{EXI{{{{RETURN ! 19891: {{ENP{{{{END PROCEDURE PRTPS ! 19892: {{EJC{{{{ ! 19893: * ! 19894: * PRTSN -- PRINT STATEMENT NUMBER ! 19895: * ! 19896: * PRTSN IS USED TO INITIATE A PRINT TRACE LINE BY PRINTING ! 19897: * ASTERISKS AND THE CURRENT STATEMENT NUMBER. THE ACTUAL ! 19898: * FORMAT OF THE OUTPUT GENERATED IS. ! 19899: * ! 19900: * ***NNNNN**** III.....IIII ! 19901: * ! 19902: * NNNNN IS THE STATEMENT NUMBER WITH LEADING ZEROS REPLACED ! 19903: * BY ASTERISKS (E.G. *******9****) ! 19904: * ! 19905: * III...III REPRESENTS A VARIABLE LENGTH OUTPUT CONSISTING ! 19906: * OF A NUMBER OF LETTER I CHARACTERS EQUAL TO FNCLEVEL. ! 19907: * ! 19908: * JSR PRTSN CALL TO PRINT STATEMENT NUMBER ! 19909: * (WC) DESTROYED ! 19910: * ! 19911: {PRTSN{PRC{E{0{{ENTRY POINT ! 19912: {{MOV{R9{-(SP){{SAVE ENTRY XR ! 19913: {{MOV{R6{PRSNA{{SAVE ENTRY WA ! 19914: {{MOV{#TMASB{R9{{POINT TO ASTERISKS ! 19915: {{JSR{PRTST{{{PRINT ASTERISKS ! 19916: {{MOV{#NUM04{PROFS{{POINT INTO MIDDLE OF ASTERISKS ! 19917: {{MTI{KVSTN{{{LOAD STATEMENT NUMBER AS INTEGER ! 19918: {{JSR{PRTIN{{{PRINT INTEGER STATEMENT NUMBER ! 19919: {{MOV{#PRSNF{PROFS{{POINT PAST ASTERISKS PLUS BLANK ! 19920: {{MOV{KVFNC{R9{{GET FNCLEVEL ! 19921: {{MOV{#CH$LI{R6{{SET LETTER I ! 19922: * ! 19923: * LOOP TO GENERATE LETTER I FNCLEVEL TIMES ! 19924: * ! 19925: {PRSN1{BZE{R9{PRSN2{{JUMP IF ALL SET ! 19926: {{JSR{PRTCH{{{ELSE PRINT AN I ! 19927: {{DCV{R9{{{DECREMENT COUNTER ! 19928: {{BRN{PRSN1{{{LOOP BACK ! 19929: * ! 19930: * MERRE WITH ALL LETTER I CHARACTERS GENERATED ! 19931: * ! 19932: {PRSN2{MOV{#CH$BL{R6{{GET BLANK ! 19933: {{JSR{PRTCH{{{PRINT BLANK ! 19934: {{MOV{PRSNA{R6{{RESTORE ENTRY WA ! 19935: {{MOV{(SP)+{R9{{RESTORE ENTRY XR ! 19936: {{EXI{{{{RETURN TO PRTSN CALLER ! 19937: {{ENP{{{{END PROCEDURE PRTSN ! 19938: {{EJC{{{{ ! 19939: * ! 19940: * PRTST -- PRINT STRING ! 19941: * ! 19942: * PRTST PLACES A STRING OF CHARACTERS IN THE PRINT BUFFER ! 19943: * ! 19944: * SEE PRTNL FOR GLOBAL LOCATIONS USED ! 19945: * ! 19946: * NOTE THAT THE FIRST WORD OF THE BLOCK (NORMALLY B$SCL) ! 19947: * IS NOT USED AND NEED NOT BE SET CORRECTLY (SEE PRTVN) ! 19948: * ! 19949: * (XR) STRING TO BE PRINTED ! 19950: * JSR PRTST CALL TO PRINT STRING ! 19951: * (PROFS) UPDATED PAST CHARS PLACED ! 19952: * ! 19953: {PRTST{PRC{R{0{{ENTRY POINT ! 19954: {{BNZ{HEADP{PRST0{{WERE HEADERS PRINTED ! 19955: {{JSR{PRTPS{{{NO - PRINT THEM ! 19956: * ! 19957: * CALL SYSPR ! 19958: * ! 19959: {PRST0{MOV{R6{PRSVA{{SAVE WA ! 19960: {{MOV{R7{PRSVB{{SAVE WB ! 19961: {{ZER{R7{{{SET CHARS PRINTED COUNT TO ZERO ! 19962: * ! 19963: * LOOP TO PRINT SUCCESSIVE LINES FOR LONG STRING ! 19964: * ! 19965: {PRST1{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH ! 19966: {{SUB{R7{R6{{SUBTRACT COUNT OF CHARS ALREADY OUT ! 19967: {{BZE{R6{PRST4{{JUMP TO EXIT IF NONE LEFT ! 19968: {{MOV{R10{-(SP){{ELSE STACK ENTRY XL ! 19969: {{MOV{R9{-(SP){{SAVE ARGUMENT ! 19970: {{MOV{R9{R10{{COPY FOR EVENTUAL MOVE ! 19971: {{MOV{PRLEN{R9{{LOAD PRINT BUFFER LENGTH ! 19972: {{SUB{PROFS{R9{{GET CHARS LEFT IN PRINT BUFFER ! 19973: {{BNZ{R9{PRST2{{SKIP IF ROOM LEFT ON THIS LINE ! 19974: {{JSR{PRTNL{{{ELSE PRINT THIS LINE ! 19975: {{MOV{PRLEN{R9{{AND SET FULL WIDTH AVAILABLE ! 19976: {{EJC{{{{ ! 19977: * ! 19978: * PRTST (CONTINUED) ! 19979: * ! 19980: * HERE WITH CHARS TO PRINT AND SOME ROOM IN BUFFER ! 19981: * ! 19982: {PRST2{BLO{R6{R9{PRST3{JUMP IF ROOM FOR REST OF STRING ! 19983: {{MOV{R9{R6{{ELSE SET TO FILL LINE ! 19984: * ! 19985: * MERGE HERE WITH CHARACTER COUNT IN WA ! 19986: * ! 19987: {PRST3{MOV{PRBUF{R9{{POINT TO PRINT BUFFER ! 19988: {{PLC{R10{R7{{POINT TO LOCATION IN STRING ! 19989: {{PSC{R9{PROFS{{POINT TO LOCATION IN BUFFER ! 19990: {{ADD{R6{R7{{BUMP STRING CHARS COUNT ! 19991: {{ADD{R6{PROFS{{BUMP BUFFER POINTER ! 19992: {{MOV{R7{PRSVC{{PRESERVE CHAR COUNTER ! 19993: {{MVC{{{{MOVE CHARACTERS TO BUFFER ! 19994: {{MOV{PRSVC{R7{{RECOVER CHAR COUNTER ! 19995: {{MOV{(SP)+{R9{{RESTORE ARGUMENT POINTER ! 19996: {{MOV{(SP)+{R10{{RESTORE ENTRY XL ! 19997: {{BRN{PRST1{{{LOOP BACK TO TEST FOR MORE ! 19998: * ! 19999: * HERE TO EXIT AFTER PRINTING STRING ! 20000: * ! 20001: {PRST4{MOV{PRSVB{R7{{RESTORE ENTRY WB ! 20002: {{MOV{PRSVA{R6{{RESTORE ENTRY WA ! 20003: {{EXI{{{{RETURN TO PRTST CALLER ! 20004: {{ENP{{{{END PROCEDURE PRTST ! 20005: {{EJC{{{{ ! 20006: * ! 20007: * PRTTR -- PRINT TO TERMINAL ! 20008: * ! 20009: * CALLED TO PRINT CONTENTS OF STANDARD PRINT BUFFER TO ! 20010: * ONLINE TERMINAL. CLEARS BUFFER DOWN AND RESETS PROFS. ! 20011: * ! 20012: * JSR PRTTR CALL FOR PRINT ! 20013: * (WA,WB) DESTROYED ! 20014: * ! 20015: {PRTTR{PRC{E{0{{ENTRY POINT ! 20016: {{MOV{R9{-(SP){{SAVE XR ! 20017: {{JSR{PRTIC{{{PRINT BUFFER CONTENTS ! 20018: {{MOV{PRBUF{R9{{POINT TO PRINT BFR TO CLEAR IT ! 20019: {{LCT{R6{PRLNW{{GET BUFFER LENGTH ! 20020: {{ADD{#4*SCHAR{R9{{POINT PAST SCBLK HEADER ! 20021: {{MOV{NULLW{R7{{GET BLANKS ! 20022: * ! 20023: * LOOP TO CLEAR BUFFER ! 20024: * ! 20025: {PRTT1{MOV{R7{(R9)+{{CLEAR A WORD ! 20026: {{BCT{R6{PRTT1{{LOOP ! 20027: {{ZER{PROFS{{{RESET PROFS ! 20028: {{MOV{(SP)+{R9{{RESTORE XR ! 20029: {{EXI{{{{RETURN ! 20030: {{ENP{{{{END PROCEDURE PRTTR ! 20031: {{EJC{{{{ ! 20032: * ! 20033: * PRTVL -- PRINT A VALUE ! 20034: * ! 20035: * PRTVL PLACES AN APPROPRIATE CHARACTER REPRESENTATION OF ! 20036: * A DATA VALUE IN THE PRINT BUFFER FOR DUMP/TRACE USE. ! 20037: * ! 20038: * (XR) VALUE TO BE PRINTED ! 20039: * JSR PRTVL CALL TO PRINT VALUE ! 20040: * (WA,WB,WC,RA) DESTROYED ! 20041: * ! 20042: {PRTVL{PRC{R{0{{ENTRY POINT, RECURSIVE ! 20043: {{MOV{R10{-(SP){{SAVE ENTRY XL ! 20044: {{MOV{R9{-(SP){{SAVE ARGUMENT ! 20045: {{CHK{{{{CHECK FOR STACK OVERFLOW ! 20046: * ! 20047: * LOOP BACK HERE AFTER FINDING A TRAP BLOCK (TRBLK) ! 20048: * ! 20049: {PRV01{MOV{4*IDVAL(R9){PRVSI{{COPY IDVAL (IF ANY) ! 20050: {{MOV{(R9){R10{{LOAD FIRST WORD OF BLOCK ! 20051: {{LEI{R10{{{LOAD ENTRY POINT ID ! 20052: {{BSW{R10{BL$$T{PRV02{SWITCH ON BLOCK TYPE ! 20053: {{IFF{BL$AR{PRV05{{ARBLK ! 20054: {{IFF{BL$BC{PRV15{{BCBLK ! 20055: {{IFF{DUMMY{PRV02{{ ! 20056: {{IFF{DUMMY{PRV02{{ ! 20057: {{IFF{BL$IC{PRV08{{ICBLK ! 20058: {{IFF{BL$NM{PRV09{{NMBLK ! 20059: {{IFF{DUMMY{PRV02{{ ! 20060: {{IFF{DUMMY{PRV02{{ ! 20061: {{IFF{DUMMY{PRV02{{ ! 20062: {{IFF{BL$RC{PRV08{{RCBLK ! 20063: {{IFF{BL$SC{PRV11{{SCBLK ! 20064: {{IFF{BL$SE{PRV12{{SEBLK ! 20065: {{IFF{BL$TB{PRV13{{TBBLK ! 20066: {{IFF{BL$VC{PRV13{{VCBLK ! 20067: {{IFF{DUMMY{PRV02{{ ! 20068: {{IFF{DUMMY{PRV02{{ ! 20069: {{IFF{BL$PD{PRV10{{PDBLK ! 20070: {{IFF{BL$TR{PRV04{{TRBLK ! 20071: {{ESW{{{{END OF SWITCH ON BLOCK TYPE ! 20072: * ! 20073: * HERE FOR BLOCKS FOR WHICH WE JUST PRINT DATATYPE NAME ! 20074: * ! 20075: {PRV02{JSR{DTYPE{{{GET DATATYPE NAME ! 20076: {{JSR{PRTST{{{PRINT DATATYPE NAME ! 20077: * ! 20078: * COMMON EXIT POINT ! 20079: * ! 20080: {PRV03{MOV{(SP)+{R9{{RELOAD ARGUMENT ! 20081: {{MOV{(SP)+{R10{{RESTORE XL ! 20082: {{EXI{{{{RETURN TO PRTVL CALLER ! 20083: * ! 20084: * HERE FOR TRBLK ! 20085: * ! 20086: {PRV04{MOV{4*TRVAL(R9){R9{{LOAD REAL VALUE ! 20087: {{BRN{PRV01{{{AND LOOP BACK ! 20088: {{EJC{{{{ ! 20089: * ! 20090: * PRTVL (CONTINUED) ! 20091: * ! 20092: * HERE FOR ARRAY (ARBLK) ! 20093: * ! 20094: * PRINT ARRAY ( PROTOTYPE ) BLANK NUMBER IDVAL ! 20095: * ! 20096: {PRV05{MOV{R9{R10{{PRESERVE ARGUMENT ! 20097: {{MOV{#SCARR{R9{{POINT TO DATATYPE NAME (ARRAY) ! 20098: {{JSR{PRTST{{{PRINT IT ! 20099: {{MOV{#CH$PP{R6{{LOAD LEFT PAREN ! 20100: {{JSR{PRTCH{{{PRINT LEFT PAREN ! 20101: {{ADD{4*AROFS(R10){R10{{POINT TO PROTOTYPE ! 20102: {{MOV{(R10){R9{{LOAD PROTOTYPE ! 20103: {{JSR{PRTST{{{PRINT PROTOTYPE ! 20104: * ! 20105: * VCBLK, TBBLK, BCBLK MERGE HERE FOR ) BLANK NUMBER IDVAL ! 20106: * ! 20107: {PRV06{MOV{#CH$RP{R6{{LOAD RIGHT PAREN ! 20108: {{JSR{PRTCH{{{PRINT RIGHT PAREN ! 20109: * ! 20110: * PDBLK MERGES HERE TO PRINT BLANK NUMBER IDVAL ! 20111: * ! 20112: {PRV07{MOV{#CH$BL{R6{{LOAD BLANK ! 20113: {{JSR{PRTCH{{{PRINT IT ! 20114: {{MOV{#CH$NM{R6{{LOAD NUMBER SIGN ! 20115: {{JSR{PRTCH{{{PRINT IT ! 20116: {{MTI{PRVSI{{{GET IDVAL ! 20117: {{JSR{PRTIN{{{PRINT ID NUMBER ! 20118: {{BRN{PRV03{{{BACK TO EXIT ! 20119: * ! 20120: * HERE FOR INTEGER (ICBLK), REAL (RCBLK) ! 20121: * ! 20122: * PRINT CHARACTER REPRESENTATION OF VALUE ! 20123: * ! 20124: {PRV08{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG ! 20125: {{JSR{GTSTG{{{CONVERT TO STRING ! 20126: {{PPM{{{{ERROR RETURN IS IMPOSSIBLE ! 20127: {{JSR{PRTST{{{PRINT THE STRING ! 20128: {{MOV{R9{DNAMP{{DELETE GARBAGE STRING FROM STORAGE ! 20129: {{BRN{PRV03{{{BACK TO EXIT ! 20130: {{EJC{{{{ ! 20131: * ! 20132: * PRTVL (CONTINUED) ! 20133: * ! 20134: * NAME (NMBLK) ! 20135: * ! 20136: * FOR PSEUDO-VARIABLE, JUST PRINT DATATYPE NAME (NAME) ! 20137: * FOR ALL OTHER NAMES, PRINT DOT FOLLOWED BY NAME REP ! 20138: * ! 20139: {PRV09{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE ! 20140: {{MOV{(R10){R6{{LOAD FIRST WORD OF BLOCK ! 20141: {{BEQ{R6{#B$KVT{PRV02{JUST PRINT NAME IF KEYWORD ! 20142: {{BEQ{R6{#B$EVT{PRV02{JUST PRINT NAME IF EXPRESSION VAR ! 20143: {{MOV{#CH$DT{R6{{ELSE GET DOT ! 20144: {{JSR{PRTCH{{{AND PRINT IT ! 20145: {{MOV{4*NMOFS(R9){R6{{LOAD NAME OFFSET ! 20146: {{JSR{PRTNM{{{PRINT NAME ! 20147: {{BRN{PRV03{{{BACK TO EXIT ! 20148: * ! 20149: * PROGRAM DATATYPE (PDBLK) ! 20150: * ! 20151: * PRINT DATATYPE NAME CH$BL CH$NM IDVAL ! 20152: * ! 20153: {PRV10{JSR{DTYPE{{{GET DATATYPE NAME ! 20154: {{JSR{PRTST{{{PRINT DATATYPE NAME ! 20155: {{BRN{PRV07{{{MERGE BACK TO PRINT ID ! 20156: * ! 20157: * HERE FOR STRING (SCBLK) ! 20158: * ! 20159: * PRINT QUOTE STRING-CHARACTERS QUOTE ! 20160: * ! 20161: {PRV11{MOV{#CH$SQ{R6{{LOAD SINGLE QUOTE ! 20162: {{JSR{PRTCH{{{PRINT QUOTE ! 20163: {{JSR{PRTST{{{PRINT STRING VALUE ! 20164: {{JSR{PRTCH{{{PRINT ANOTHER QUOTE ! 20165: {{BRN{PRV03{{{BACK TO EXIT ! 20166: {{EJC{{{{ ! 20167: * ! 20168: * PRTVL (CONTINUED) ! 20169: * ! 20170: * HERE FOR SIMPLE EXPRESSION (SEBLK) ! 20171: * ! 20172: * PRINT ASTERISK VARIABLE-NAME ! 20173: * ! 20174: {PRV12{MOV{#CH$AS{R6{{LOAD ASTERISK ! 20175: {{JSR{PRTCH{{{PRINT ASTERISK ! 20176: {{MOV{4*SEVAR(R9){R9{{LOAD VARIABLE POINTER ! 20177: {{JSR{PRTVN{{{PRINT VARIABLE NAME ! 20178: {{BRN{PRV03{{{JUMP BACK TO EXIT ! 20179: * ! 20180: * HERE FOR TABLE (TBBLK) AND ARRAY (VCBLK) ! 20181: * ! 20182: * PRINT DATATYPE ( PROTOTYPE ) BLANK NUMBER IDVAL ! 20183: * ! 20184: {PRV13{MOV{R9{R10{{PRESERVE ARGUMENT ! 20185: {{JSR{DTYPE{{{GET DATATYPE NAME ! 20186: {{JSR{PRTST{{{PRINT DATATYPE NAME ! 20187: {{MOV{#CH$PP{R6{{LOAD LEFT PAREN ! 20188: {{JSR{PRTCH{{{PRINT LEFT PAREN ! 20189: {{MOV{4*TBLEN(R10){R6{{LOAD LENGTH OF BLOCK (=VCLEN) ! 20190: {{BTW{R6{{{CONVERT TO WORD COUNT ! 20191: {{SUB{#TBSI${R6{{ALLOW FOR STANDARD FIELDS ! 20192: {{BEQ{(R10){#B$TBT{PRV14{JUMP IF TABLE ! 20193: {{ADD{#VCTBD{R6{{FOR VCBLK, ADJUST SIZE ! 20194: * ! 20195: * PRINT PROTOTYPE ! 20196: * ! 20197: {PRV14{MTI{R6{{{MOVE AS INTEGER ! 20198: {{JSR{PRTIN{{{PRINT INTEGER PROTOTYPE ! 20199: {{BRN{PRV06{{{MERGE BACK FOR REST ! 20200: {{EJC{{{{ ! 20201: * ! 20202: * PRTVL (CONTINUED) ! 20203: * ! 20204: * HERE FOR BUFFER (BCBLK) ! 20205: * ! 20206: {PRV15{MOV{R9{R10{{PRESERVE ARGUMENT ! 20207: {{MOV{#SCBUF{R9{{POINT TO DATATYPE NAME (BUFFER) ! 20208: {{JSR{PRTST{{{PRINT IT ! 20209: {{MOV{#CH$PP{R6{{LOAD LEFT PAREN ! 20210: {{JSR{PRTCH{{{PRINT LEFT PAREN ! 20211: {{MOV{4*BCBUF(R10){R9{{POINT TO BFBLK ! 20212: {{MTI{4*BFALC(R9){{{LOAD ALLOCATION SIZE ! 20213: {{JSR{PRTIN{{{PRINT IT ! 20214: {{MOV{#CH$CM{R6{{LOAD COMMA ! 20215: {{JSR{PRTCH{{{PRINT IT ! 20216: {{MTI{4*BCLEN(R10){{{LOAD DEFINED LENGTH ! 20217: {{JSR{PRTIN{{{PRINT IT ! 20218: {{BRN{PRV06{{{MERGE TO FINISH UP ! 20219: {{ENP{{{{END PROCEDURE PRTVL ! 20220: {{EJC{{{{ ! 20221: * ! 20222: * PRTVN -- PRINT NATURAL VARIABLE NAME ! 20223: * ! 20224: * PRTVN PRINTS THE NAME OF A NATURAL VARIABLE ! 20225: * ! 20226: * (XR) POINTER TO VRBLK ! 20227: * JSR PRTVN CALL TO PRINT VARIABLE NAME ! 20228: * ! 20229: {PRTVN{PRC{E{0{{ENTRY POINT ! 20230: {{MOV{R9{-(SP){{STACK VRBLK POINTER ! 20231: {{ADD{#4*VRSOF{R9{{POINT TO POSSIBLE STRING NAME ! 20232: {{BNZ{4*SCLEN(R9){PRVN1{{JUMP IF NOT SYSTEM VARIABLE ! 20233: {{MOV{4*VRSVO(R9){R9{{POINT TO SVBLK WITH NAME ! 20234: * ! 20235: * MERGE HERE WITH DUMMY SCBLK POINTER IN XR ! 20236: * ! 20237: {PRVN1{JSR{PRTST{{{PRINT STRING NAME OF VARIABLE ! 20238: {{MOV{(SP)+{R9{{RESTORE VRBLK POINTER ! 20239: {{EXI{{{{RETURN TO PRTVN CALLER ! 20240: {{ENP{{{{END PROCEDURE PRTVN ! 20241: {{EJC{{{{ ! 20242: * ! 20243: * RCBLD -- BUILD A REAL BLOCK ! 20244: * ! 20245: * (RA) REAL VALUE FOR RCBLK ! 20246: * JSR RCBLD CALL TO BUILD REAL BLOCK ! 20247: * (XR) POINTER TO RESULT RCBLK ! 20248: * (WA) DESTROYED ! 20249: * ! 20250: {RCBLD{PRC{E{0{{ENTRY POINT ! 20251: {{MOV{DNAMP{R9{{LOAD POINTER TO NEXT AVAILABLE LOC ! 20252: {{ADD{#4*RCSI${R9{{POINT PAST NEW RCBLK ! 20253: {{BLO{R9{DNAME{RCBL1{JUMP IF THERE IS ROOM ! 20254: {{MOV{#4*RCSI${R6{{ELSE LOAD RCBLK LENGTH ! 20255: {{JSR{ALLOC{{{USE STANDARD ALLOCATOR TO GET BLOCK ! 20256: {{ADD{R6{R9{{POINT PAST BLOCK TO MERGE ! 20257: * ! 20258: * MERGE HERE WITH XR POINTING PAST THE BLOCK OBTAINED ! 20259: * ! 20260: {RCBL1{MOV{R9{DNAMP{{SET NEW POINTER ! 20261: {{SUB{#4*RCSI${R9{{POINT BACK TO START OF BLOCK ! 20262: {{MOV{#B$RCL{(R9){{STORE TYPE WORD ! 20263: {{STR{4*RCVAL(R9){{{STORE REAL VALUE IN RCBLK ! 20264: {{EXI{{{{RETURN TO RCBLD CALLER ! 20265: {{ENP{{{{END PROCEDURE RCBLD ! 20266: {{EJC{{{{ ! 20267: * ! 20268: * READR -- READ NEXT SOURCE IMAGE AT COMPILE TIME ! 20269: * ! 20270: * READR IS USED TO READ THE NEXT SOURCE IMAGE. TO PROCESS ! 20271: * CONTINUATION CARDS PROPERLY, THE COMPILER MUST READ ONE ! 20272: * LINE AHEAD. THUS READR DOES NOT DESTROY THE CURRENT IMAGE ! 20273: * SEE ALSO THE NEXTS ROUTINE WHICH ACTUALLY GETS THE IMAGE. ! 20274: * ! 20275: * JSR READR CALL TO READ NEXT IMAGE ! 20276: * (XR) PTR TO NEXT IMAGE (0 IF NONE) ! 20277: * (R$CNI) COPY OF POINTER ! 20278: * (WA,WB,WC,XL) DESTROYED ! 20279: * ! 20280: {READR{PRC{E{0{{ENTRY POINT ! 20281: {{MOV{R$CNI{R9{{GET PTR TO NEXT IMAGE ! 20282: {{BNZ{R9{READ3{{EXIT IF ALREADY READ ! 20283: {{BNE{STAGE{#STGIC{READ3{EXIT IF NOT INITIAL COMPILE ! 20284: {{MOV{CSWIN{R6{{MAX READ LENGTH ! 20285: {{JSR{ALOCS{{{ALLOCATE BUFFER ! 20286: {{JSR{SYSRD{{{READ INPUT IMAGE ! 20287: {{PPM{READ4{{{JUMP IF END OF FILE ! 20288: {{MNZ{R7{{{SET TRIMR TO PERFORM TRIM ! 20289: {{BLE{4*SCLEN(R9){CSWIN{READ1{USE SMALLER OF STRING LNTH .. ! 20290: {{MOV{CSWIN{4*SCLEN(R9){{... AND XXX OF -INXXX ! 20291: * ! 20292: * PERFORM THE TRIM ! 20293: * ! 20294: {READ1{JSR{TRIMR{{{TRIM TRAILING BLANKS ! 20295: * ! 20296: * MERGE HERE AFTER READ ! 20297: * ! 20298: {READ2{MOV{R9{R$CNI{{STORE COPY OF POINTER ! 20299: * ! 20300: * MERGE HERE IF NO READ ATTEMPTED ! 20301: * ! 20302: {READ3{EXI{{{{RETURN TO READR CALLER ! 20303: * ! 20304: * HERE ON END OF FILE ! 20305: * ! 20306: {READ4{MOV{R9{DNAMP{{POP UNUSED SCBLK ! 20307: {{ZER{R9{{{ZERO PTR AS RESULT ! 20308: {{BRN{READ2{{{MERGE ! 20309: {{ENP{{{{END PROCEDURE READR ! 20310: {{EJC{{{{ ! 20311: * ! 20312: * SBSTR -- BUILD A SUBSTRING ! 20313: * ! 20314: * (XL) PTR TO SCBLK/BFBLK WITH CHARS ! 20315: * (WA) NUMBER OF CHARS IN SUBSTRING ! 20316: * (WB) OFFSET TO FIRST CHAR IN SCBLK ! 20317: * JSR SBSTR CALL TO BUILD SUBSTRING ! 20318: * (XR) PTR TO NEW SCBLK WITH SUBSTRING ! 20319: * (XL) ZERO ! 20320: * (WA,WB,WC,XL,IA) DESTROYED ! 20321: * ! 20322: * NOTE THAT SBSTR IS CALLED WITH A DUMMY STRING POINTER ! 20323: * (POINTING INTO A VRBLK OR SVBLK) TO COPY THE NAME OF A ! 20324: * VARIABLE AS A STANDARD STRING VALUE. ! 20325: * ! 20326: {SBSTR{PRC{E{0{{ENTRY POINT ! 20327: {{BZE{R6{SBST2{{JUMP IF NULL SUBSTRING ! 20328: {{JSR{ALOCS{{{ELSE ALLOCATE SCBLK ! 20329: {{MOV{R8{R6{{MOVE NUMBER OF CHARACTERS ! 20330: {{MOV{R9{R8{{SAVE PTR TO NEW SCBLK ! 20331: {{PLC{R10{R7{{PREPARE TO LOAD CHARS FROM OLD BLK ! 20332: {{PSC{R9{{{PREPARE TO STORE CHARS IN NEW BLK ! 20333: {{MVC{{{{MOVE CHARACTERS TO NEW STRING ! 20334: {{MOV{R8{R9{{THEN RESTORE SCBLK POINTER ! 20335: * ! 20336: * RETURN POINT ! 20337: * ! 20338: {SBST1{ZER{R10{{{CLEAR GARBAGE POINTER IN XL ! 20339: {{EXI{{{{RETURN TO SBSTR CALLER ! 20340: * ! 20341: * HERE FOR NULL SUBSTRING ! 20342: * ! 20343: {SBST2{MOV{#NULLS{R9{{SET NULL STRING AS RESULT ! 20344: {{BRN{SBST1{{{RETURN ! 20345: {{ENP{{{{END PROCEDURE SBSTR ! 20346: {{EJC{{{{ ! 20347: * ! 20348: * SCANE -- SCAN AN ELEMENT ! 20349: * ! 20350: * SCANE IS CALLED AT COMPILE TIME (BY EXPAN ,CMPIL,CNCRD) ! 20351: * TO SCAN ONE ELEMENT FROM THE INPUT IMAGE. ! 20352: * ! 20353: * (SCNCC) NON-ZERO IF CALLED FROM CNCRD ! 20354: * JSR SCANE CALL TO SCAN ELEMENT ! 20355: * (XR) RESULT POINTER (SEE BELOW) ! 20356: * (XL) SYNTAX TYPE CODE (T$XXX) ! 20357: * ! 20358: * THE FOLLOWING GLOBAL LOCATIONS ARE USED. ! 20359: * ! 20360: * R$CIM POINTER TO STRING BLOCK (SCBLK) ! 20361: * FOR CURRENT INPUT IMAGE. ! 20362: * ! 20363: * R$CNI POINTER TO NEXT INPUT IMAGE STRING ! 20364: * POINTER (ZERO IF NONE). ! 20365: * ! 20366: * R$SCP SAVE POINTER (EXIT XR) FROM LAST ! 20367: * CALL IN CASE RESCAN IS SET. ! 20368: * ! 20369: * SCNBL THIS LOCATION IS SET NON-ZERO ON ! 20370: * EXIT IF SCANE SCANNED PAST BLANKS ! 20371: * BEFORE LOCATING THE CURRENT ELEMENT ! 20372: * THE END OF A LINE COUNTS AS BLANKS. ! 20373: * ! 20374: * SCNCC CNCRD SETS THIS NON-ZERO TO SCAN ! 20375: * CONTROL CARD NAMES AND CLEARS IT ! 20376: * ON RETURN ! 20377: * ! 20378: * SCNIL LENGTH OF CURRENT INPUT IMAGE ! 20379: * ! 20380: * SCNGO IF SET NON-ZERO ON ENTRY, F AND S ! 20381: * ARE RETURNED AS SEPARATE SYNTAX ! 20382: * TYPES (NOT LETTERS) (GOTO PRO- ! 20383: * CESSING). SCNGO IS RESET ON EXIT. ! 20384: * ! 20385: * SCNPT OFFSET TO CURRENT LOC IN R$CIM ! 20386: * ! 20387: * SCNRS IF SET NON-ZERO ON ENTRY, SCANE ! 20388: * RETURNS THE SAME RESULT AS ON THE ! 20389: * LAST CALL (RESCAN). SCNRS IS RESET ! 20390: * ON EXIT FROM ANY CALL TO SCANE. ! 20391: * ! 20392: * SCNTP SAVE SYNTAX TYPE FROM LAST ! 20393: * CALL (IN CASE RESCAN IS SET). ! 20394: {{EJC{{{{ ! 20395: * ! 20396: * SCANE (CONTINUED) ! 20397: * ! 20398: * ! 20399: * ! 20400: * ELEMENT SCANNED XL XR ! 20401: * --------------- -- -- ! 20402: * ! 20403: * CONTROL CARD NAME 0 POINTER TO SCBLK FOR NAME ! 20404: * ! 20405: * UNARY OPERATOR T$UOP PTR TO OPERATOR DVBLK ! 20406: * ! 20407: * LEFT PAREN T$LPR T$LPR ! 20408: * ! 20409: * LEFT BRACKET T$LBR T$LBR ! 20410: * ! 20411: * COMMA T$CMA T$CMA ! 20412: * ! 20413: * FUNCTION CALL T$FNC PTR TO FUNCTION VRBLK ! 20414: * ! 20415: * VARIABLE T$VAR PTR TO VRBLK ! 20416: * ! 20417: * STRING CONSTANT T$CON PTR TO SCBLK ! 20418: * ! 20419: * INTEGER CONSTANT T$CON PTR TO ICBLK ! 20420: * ! 20421: * REAL CONSTANT T$CON PTR TO RCBLK ! 20422: * ! 20423: * BINARY OPERATOR T$BOP PTR TO OPERATOR DVBLK ! 20424: * ! 20425: * RIGHT PAREN T$RPR T$RPR ! 20426: * ! 20427: * RIGHT BRACKET T$RBR T$RBR ! 20428: * ! 20429: * COLON T$COL T$COL ! 20430: * ! 20431: * SEMI-COLON T$SMC T$SMC ! 20432: * ! 20433: * F (SCNGO NE 0) T$FGO T$FGO ! 20434: * ! 20435: * S (SCNGO NE 0) T$SGO T$SGO ! 20436: {{EJC{{{{ ! 20437: * ! 20438: * SCANE (CONTINUED) ! 20439: * ! 20440: * ENTRY POINT ! 20441: * ! 20442: {SCANE{PRC{E{0{{ENTRY POINT ! 20443: {{ZER{SCNBL{{{RESET BLANKS FLAG ! 20444: {{MOV{R6{SCNSA{{SAVE WA ! 20445: {{MOV{R7{SCNSB{{SAVE WB ! 20446: {{MOV{R8{SCNSC{{SAVE WC ! 20447: {{BZE{SCNRS{SCN03{{JUMP IF NO RESCAN ! 20448: * ! 20449: * HERE FOR RESCAN REQUEST ! 20450: * ! 20451: {{MOV{SCNTP{R10{{SET PREVIOUS RETURNED SCAN TYPE ! 20452: {{MOV{R$SCP{R9{{SET PREVIOUS RETURNED POINTER ! 20453: {{ZER{SCNRS{{{RESET RESCAN SWITCH ! 20454: {{BRN{SCN13{{{JUMP TO EXIT ! 20455: * ! 20456: * COME HERE TO READ NEW IMAGE TO TEST FOR CONTINUATION ! 20457: * ! 20458: {SCN01{JSR{READR{{{READ NEXT IMAGE ! 20459: {{MOV{#4*DVUBS{R7{{SET WB FOR NOT READING NAME ! 20460: {{BZE{R9{SCN30{{TREAT AS SEMI-COLON IF NONE ! 20461: {{PLC{R9{{{ELSE POINT TO FIRST CHARACTER ! 20462: {{LCH{R8{(R9){{LOAD FIRST CHARACTER ! 20463: {{BEQ{R8{#CH$DT{SCN02{JUMP IF DOT FOR CONTINUATION ! 20464: {{BNE{R8{#CH$PL{SCN30{ELSE TREAT AS SEMICOLON UNLESS PLUS ! 20465: * ! 20466: * HERE FOR CONTINUATION LINE ! 20467: * ! 20468: {SCN02{JSR{NEXTS{{{ACQUIRE NEXT SOURCE IMAGE ! 20469: {{MOV{#NUM01{SCNPT{{SET SCAN POINTER PAST CONTINUATION ! 20470: {{MNZ{SCNBL{{{SET BLANKS FLAG ! 20471: {{EJC{{{{ ! 20472: * ! 20473: * SCANE (CONTINUED) ! 20474: * ! 20475: * MERGE HERE TO SCAN NEXT ELEMENT ON CURRENT LINE ! 20476: * ! 20477: {SCN03{MOV{SCNPT{R6{{LOAD CURRENT OFFSET ! 20478: {{BEQ{R6{SCNIL{SCN01{CHECK CONTINUATION IF END ! 20479: {{MOV{R$CIM{R10{{POINT TO CURRENT LINE ! 20480: {{PLC{R10{R6{{POINT TO CURRENT CHARACTER ! 20481: {{MOV{R6{SCNSE{{SET START OF ELEMENT LOCATION ! 20482: {{MOV{#OPDVS{R8{{POINT TO OPERATOR DV LIST ! 20483: {{MOV{#4*DVUBS{R7{{SET CONSTANT FOR OPERATOR CIRCUIT ! 20484: {{BRN{SCN06{{{START SCANNING ! 20485: * ! 20486: * LOOP HERE TO IGNORE LEADING BLANKS AND TABS ! 20487: * ! 20488: {SCN05{BZE{R7{SCN10{{JUMP IF TRAILING ! 20489: {{ICV{SCNSE{{{INCREMENT START OF ELEMENT ! 20490: {{BEQ{R6{SCNIL{SCN01{JUMP IF END OF IMAGE ! 20491: {{MNZ{SCNBL{{{NOTE BLANKS SEEN ! 20492: * ! 20493: * THE FOLLOWING JUMP IS USED REPEATEDLY FOR SCANNING OUT ! 20494: * THE CHARACTERS OF A NUMERIC CONSTANT OR VARIABLE NAME. ! 20495: * THE REGISTERS ARE USED AS FOLLOWS. ! 20496: * ! 20497: * (XR) SCRATCH ! 20498: * (XL) PTR TO NEXT CHARACTER ! 20499: * (WA) CURRENT SCAN OFFSET ! 20500: * (WB) *DVUBS (0 IF SCANNING NAME,CONST) ! 20501: * (WC) =OPDVS (0 IF SCANNING CONSTANT) ! 20502: * ! 20503: {SCN06{LCH{R9{(R10)+{{GET NEXT CHARACTER ! 20504: {{ICV{R6{{{BUMP SCAN OFFSET ! 20505: {{MOV{R6{SCNPT{{STORE OFFSET PAST CHAR SCANNED ! 20506: {{BLO{#CFP$U{R9{SCN07{QUICK CHECK FOR OTHER CHAR ! 20507: {{BSW{R9{CFP$U{SCN07{SWITCH ON SCANNED CHARACTER ! 20508: * ! 20509: * SWITCH TABLE FOR SWITCH ON CHARACTER ! 20510: * ! 20511: {{EJC{{{{ ! 20512: * ! 20513: * SCANE (CONTINUED) ! 20514: * ! 20515: {{EJC{{{{ ! 20516: * ! 20517: * SCANE (CONTINUED) ! 20518: * ! 20519: {{IFF{DUMMY{SCN07{{ ! 20520: {{IFF{DUMMY{SCN07{{ ! 20521: {{IFF{DUMMY{SCN07{{ ! 20522: {{IFF{DUMMY{SCN07{{ ! 20523: {{IFF{DUMMY{SCN07{{ ! 20524: {{IFF{DUMMY{SCN07{{ ! 20525: {{IFF{DUMMY{SCN07{{ ! 20526: {{IFF{DUMMY{SCN07{{ ! 20527: {{IFF{DUMMY{SCN07{{ ! 20528: {{IFF{CH$HT{SCN05{{HORIZONTAL TAB ! 20529: {{IFF{DUMMY{SCN07{{ ! 20530: {{IFF{DUMMY{SCN07{{ ! 20531: {{IFF{DUMMY{SCN07{{ ! 20532: {{IFF{DUMMY{SCN07{{ ! 20533: {{IFF{DUMMY{SCN07{{ ! 20534: {{IFF{DUMMY{SCN07{{ ! 20535: {{IFF{DUMMY{SCN07{{ ! 20536: {{IFF{DUMMY{SCN07{{ ! 20537: {{IFF{DUMMY{SCN07{{ ! 20538: {{IFF{DUMMY{SCN07{{ ! 20539: {{IFF{DUMMY{SCN07{{ ! 20540: {{IFF{DUMMY{SCN07{{ ! 20541: {{IFF{DUMMY{SCN07{{ ! 20542: {{IFF{DUMMY{SCN07{{ ! 20543: {{IFF{DUMMY{SCN07{{ ! 20544: {{IFF{DUMMY{SCN07{{ ! 20545: {{IFF{DUMMY{SCN07{{ ! 20546: {{IFF{DUMMY{SCN07{{ ! 20547: {{IFF{DUMMY{SCN07{{ ! 20548: {{IFF{DUMMY{SCN07{{ ! 20549: {{IFF{DUMMY{SCN07{{ ! 20550: {{IFF{DUMMY{SCN07{{ ! 20551: {{IFF{CH$BL{SCN05{{BLANK ! 20552: {{IFF{CH$EX{SCN37{{EXCLAMATION MARK ! 20553: {{IFF{CH$DQ{SCN17{{DOUBLE QUOTE ! 20554: {{IFF{CH$NM{SCN41{{NUMBER SIGN ! 20555: {{IFF{CH$DL{SCN36{{DOLLAR ! 20556: {{IFF{CH$PC{SCN38{{PERCENT ! 20557: {{IFF{CH$AM{SCN44{{AMPERSAND ! 20558: {{IFF{CH$SQ{SCN16{{SINGLE QUOTE ! 20559: {{IFF{CH$PP{SCN25{{LEFT PAREN ! 20560: {{IFF{CH$RP{SCN26{{RIGHT PAREN ! 20561: {{IFF{CH$AS{SCN49{{ASTERISK ! 20562: {{IFF{CH$PL{SCN33{{PLUS ! 20563: {{IFF{CH$CM{SCN31{{COMMA ! 20564: {{IFF{CH$MN{SCN34{{MINUS ! 20565: {{IFF{CH$DT{SCN32{{DOT ! 20566: {{IFF{CH$SL{SCN40{{SLASH ! 20567: {{IFF{CH$D0{SCN08{{DIGIT 0 ! 20568: {{IFF{CH$D1{SCN08{{DIGIT 1 ! 20569: {{IFF{CH$D2{SCN08{{DIGIT 2 ! 20570: {{IFF{CH$D3{SCN08{{DIGIT 3 ! 20571: {{IFF{CH$D4{SCN08{{DIGIT 4 ! 20572: {{IFF{CH$D5{SCN08{{DIGIT 5 ! 20573: {{IFF{CH$D6{SCN08{{DIGIT 6 ! 20574: {{IFF{CH$D7{SCN08{{DIGIT 7 ! 20575: {{IFF{CH$D8{SCN08{{DIGIT 8 ! 20576: {{IFF{CH$D9{SCN08{{DIGIT 9 ! 20577: {{IFF{CH$CL{SCN29{{COLON ! 20578: {{IFF{CH$SM{SCN30{{SEMI-COLON ! 20579: {{IFF{CH$BB{SCN28{{LEFT BRACKET ! 20580: {{IFF{CH$EQ{SCN46{{EQUAL ! 20581: {{IFF{CH$RB{SCN27{{RIGHT BRACKET ! 20582: {{IFF{CH$QU{SCN45{{QUESTION MARK ! 20583: {{IFF{CH$AT{SCN42{{AT ! 20584: {{IFF{CH$LA{SCN09{{LETTER A ! 20585: {{IFF{CH$LB{SCN09{{LETTER B ! 20586: {{IFF{CH$LC{SCN09{{LETTER C ! 20587: {{IFF{CH$LD{SCN09{{LETTER D ! 20588: {{IFF{CH$LE{SCN09{{LETTER E ! 20589: {{IFF{CH$LF{SCN20{{LETTER F ! 20590: {{IFF{CH$LG{SCN09{{LETTER G ! 20591: {{IFF{CH$LH{SCN09{{LETTER H ! 20592: {{IFF{CH$LI{SCN09{{LETTER I ! 20593: {{IFF{CH$LJ{SCN09{{LETTER J ! 20594: {{IFF{CH$LK{SCN09{{LETTER K ! 20595: {{IFF{CH$LL{SCN09{{LETTER L ! 20596: {{IFF{CH$LM{SCN09{{LETTER M ! 20597: {{IFF{CH$LN{SCN09{{LETTER N ! 20598: {{IFF{CH$LO{SCN09{{LETTER O ! 20599: {{IFF{CH$LP{SCN09{{LETTER P ! 20600: {{IFF{CH$LQ{SCN09{{LETTER Q ! 20601: {{IFF{CH$LR{SCN09{{LETTER R ! 20602: {{IFF{CH$LS{SCN21{{LETTER S ! 20603: {{IFF{CH$LT{SCN09{{LETTER T ! 20604: {{IFF{CH$LU{SCN09{{LETTER U ! 20605: {{IFF{CH$LV{SCN09{{LETTER V ! 20606: {{IFF{CH$LW{SCN09{{LETTER W ! 20607: {{IFF{CH$LX{SCN09{{LETTER X ! 20608: {{IFF{CH$LY{SCN09{{LETTER Y ! 20609: {{IFF{CH$L${SCN09{{LETTER Z ! 20610: {{IFF{CH$OB{SCN28{{LEFT BRACKET ! 20611: {{IFF{DUMMY{SCN07{{ ! 20612: {{IFF{CH$CB{SCN27{{RIGHT BRACKET ! 20613: {{IFF{DUMMY{SCN07{{ ! 20614: {{IFF{CH$UN{SCN24{{UNDERLINE ! 20615: {{IFF{DUMMY{SCN07{{ ! 20616: {{IFF{CH$$A{SCN09{{SHIFTED A ! 20617: {{IFF{CH$$B{SCN09{{SHIFTED B ! 20618: {{IFF{CH$$C{SCN09{{SHIFTED C ! 20619: {{IFF{CH$$D{SCN09{{SHIFTED D ! 20620: {{IFF{CH$$E{SCN09{{SHIFTED E ! 20621: {{IFF{CH$$F{SCN20{{SHIFTED F ! 20622: {{IFF{CH$$G{SCN09{{SHIFTED G ! 20623: {{IFF{CH$$H{SCN09{{SHIFTED H ! 20624: {{IFF{CH$$I{SCN09{{SHIFTED I ! 20625: {{IFF{CH$$J{SCN09{{SHIFTED J ! 20626: {{IFF{CH$$K{SCN09{{SHIFTED K ! 20627: {{IFF{CH$$L{SCN09{{SHIFTED L ! 20628: {{IFF{CH$$M{SCN09{{SHIFTED M ! 20629: {{IFF{CH$$N{SCN09{{SHIFTED N ! 20630: {{IFF{CH$$O{SCN09{{SHIFTED O ! 20631: {{IFF{CH$$P{SCN09{{SHIFTED P ! 20632: {{IFF{CH$$Q{SCN09{{SHIFTED Q ! 20633: {{IFF{CH$$R{SCN09{{SHIFTED R ! 20634: {{IFF{CH$$S{SCN21{{SHIFTED S ! 20635: {{IFF{CH$$T{SCN09{{SHIFTED T ! 20636: {{IFF{CH$$U{SCN09{{SHIFTED U ! 20637: {{IFF{CH$$V{SCN09{{SHIFTED V ! 20638: {{IFF{CH$$W{SCN09{{SHIFTED W ! 20639: {{IFF{CH$$X{SCN09{{SHIFTED X ! 20640: {{IFF{CH$$Y{SCN09{{SHIFTED Y ! 20641: {{IFF{CH$$${SCN09{{SHIFTED Z ! 20642: {{IFF{DUMMY{SCN07{{ ! 20643: {{IFF{CH$BR{SCN43{{VERTICAL BAR ! 20644: {{IFF{DUMMY{SCN07{{ ! 20645: {{IFF{CH$NT{SCN35{{NOT ! 20646: {{IFF{DUMMY{SCN07{{ ! 20647: {{ESW{{{{END SWITCH ON CHARACTER ! 20648: * ! 20649: * HERE FOR ILLEGAL CHARACTER (UNDERLINE MERGES) ! 20650: * ! 20651: {SCN07{BZE{R7{SCN10{{JUMP IF SCANNING NAME OR CONSTANT ! 20652: {{ERB{230{SYNTAX{{ERROR. ILLEGAL CHARACTER ! 20653: {{EJC{{{{ ! 20654: * ! 20655: * SCANE (CONTINUED) ! 20656: * ! 20657: * HERE FOR DIGITS 0-9 ! 20658: * ! 20659: {SCN08{BZE{R7{SCN09{{KEEP SCANNING IF NAME/CONSTANT ! 20660: {{ZER{R8{{{ELSE SET FLAG FOR SCANNING CONSTANT ! 20661: * ! 20662: * HERE FOR LETTER. LOOP HERE WHEN SCANNING NAME/CONSTANT ! 20663: * ! 20664: {SCN09{BEQ{R6{SCNIL{SCN11{JUMP IF END OF IMAGE ! 20665: {{ZER{R7{{{SET FLAG FOR SCANNING NAME/CONST ! 20666: {{BRN{SCN06{{{MERGE BACK TO CONTINUE SCAN ! 20667: * ! 20668: * COME HERE FOR DELIMITER ENDING NAME OR CONSTANT ! 20669: * ! 20670: {SCN10{DCV{R6{{{RESET OFFSET TO POINT TO DELIMITER ! 20671: * ! 20672: * COME HERE AFTER FINISHING SCAN OF NAME OR CONSTANT ! 20673: * ! 20674: {SCN11{MOV{R6{SCNPT{{STORE UPDATED SCAN OFFSET ! 20675: {{MOV{SCNSE{R7{{POINT TO START OF ELEMENT ! 20676: {{SUB{R7{R6{{GET NUMBER OF CHARACTERS ! 20677: {{MOV{R$CIM{R10{{POINT TO LINE IMAGE ! 20678: {{BNZ{R8{SCN15{{JUMP IF NAME ! 20679: * ! 20680: * HERE AFTER SCANNING OUT NUMERIC CONSTANT ! 20681: * ! 20682: {{JSR{SBSTR{{{GET STRING FOR CONSTANT ! 20683: {{MOV{R9{DNAMP{{DELETE FROM STORAGE (NOT NEEDED) ! 20684: {{JSR{GTNUM{{{CONVERT TO NUMERIC ! 20685: {{PPM{SCN14{{{JUMP IF CONVERSION FAILURE ! 20686: * ! 20687: * MERGE HERE TO EXIT WITH CONSTANT ! 20688: * ! 20689: {SCN12{MOV{#T$CON{R10{{SET RESULT TYPE OF CONSTANT ! 20690: {{EJC{{{{ ! 20691: * ! 20692: * SCANE (CONTINUED) ! 20693: * ! 20694: * COMMON EXIT POINT (XR,XL) SET ! 20695: * ! 20696: {SCN13{MOV{SCNSA{R6{{RESTORE WA ! 20697: {{MOV{SCNSB{R7{{RESTORE WB ! 20698: {{MOV{SCNSC{R8{{RESTORE WC ! 20699: {{MOV{R9{R$SCP{{SAVE XR IN CASE RESCAN ! 20700: {{MOV{R10{SCNTP{{SAVE XL IN CASE RESCAN ! 20701: {{ZER{SCNGO{{{RESET POSSIBLE GOTO FLAG ! 20702: {{EXI{{{{RETURN TO SCANE CALLER ! 20703: * ! 20704: * HERE IF CONVERSION ERROR ON NUMERIC ITEM ! 20705: * ! 20706: {SCN14{ERB{231{SYNTAX{{ERROR. INVALID NUMERIC ITEM ! 20707: * ! 20708: * HERE AFTER SCANNING OUT VARIABLE NAME ! 20709: * ! 20710: {SCN15{JSR{SBSTR{{{BUILD STRING NAME OF VARIABLE ! 20711: {{BNZ{SCNCC{SCN13{{RETURN IF CNCRD CALL ! 20712: {{JSR{GTNVR{{{LOCATE/BUILD VRBLK ! 20713: {{PPM{{{{DUMMY (UNUSED) ERROR RETURN ! 20714: {{MOV{#T$VAR{R10{{SET TYPE AS VARIABLE ! 20715: {{BRN{SCN13{{{BACK TO EXIT ! 20716: * ! 20717: * HERE FOR SINGLE QUOTE (START OF STRING CONSTANT) ! 20718: * ! 20719: {SCN16{BZE{R7{SCN10{{TERMINATOR IF SCANNING NAME OR CNST ! 20720: {{MOV{#CH$SQ{R7{{SET TERMINATOR AS SINGLE QUOTE ! 20721: {{BRN{SCN18{{{MERGE ! 20722: * ! 20723: * HERE FOR DOUBLE QUOTE (START OF STRING CONSTANT) ! 20724: * ! 20725: {SCN17{BZE{R7{SCN10{{TERMINATOR IF SCANNING NAME OR CNST ! 20726: {{MOV{#CH$DQ{R7{{SET DOUBLE QUOTE TERMINATOR, MERGE ! 20727: * ! 20728: * LOOP TO SCAN OUT STRING CONSTANT ! 20729: * ! 20730: {SCN18{BEQ{R6{SCNIL{SCN19{ERROR IF END OF IMAGE ! 20731: {{LCH{R8{(R10)+{{ELSE LOAD NEXT CHARACTER ! 20732: {{ICV{R6{{{BUMP OFFSET ! 20733: {{BNE{R8{R7{SCN18{LOOP BACK IF NOT TERMINATOR ! 20734: {{EJC{{{{ ! 20735: * ! 20736: * SCANE (CONTINUED) ! 20737: * ! 20738: * HERE AFTER SCANNING OUT STRING CONSTANT ! 20739: * ! 20740: {{MOV{SCNPT{R7{{POINT TO FIRST CHARACTER ! 20741: {{MOV{R6{SCNPT{{SAVE OFFSET PAST FINAL QUOTE ! 20742: {{DCV{R6{{{POINT BACK PAST LAST CHARACTER ! 20743: {{SUB{R7{R6{{GET NUMBER OF CHARACTERS ! 20744: {{MOV{R$CIM{R10{{POINT TO INPUT IMAGE ! 20745: {{JSR{SBSTR{{{BUILD SUBSTRING VALUE ! 20746: {{BRN{SCN12{{{BACK TO EXIT WITH CONSTANT RESULT ! 20747: * ! 20748: * HERE IF NO MATCHING QUOTE FOUND ! 20749: * ! 20750: {SCN19{MOV{R6{SCNPT{{SET UPDATED SCAN POINTER ! 20751: {{ERB{232{SYNTAX{{ERROR. UNMATCHED STRING QUOTE ! 20752: * ! 20753: * HERE FOR F (POSSIBLE FAILURE GOTO) ! 20754: * ! 20755: {SCN20{MOV{#T$FGO{R9{{SET RETURN CODE FOR FAIL GOTO ! 20756: {{BRN{SCN22{{{JUMP TO MERGE ! 20757: * ! 20758: * HERE FOR S (POSSIBLE SUCCESS GOTO) ! 20759: * ! 20760: {SCN21{MOV{#T$SGO{R9{{SET SUCCESS GOTO AS RETURN CODE ! 20761: * ! 20762: * SPECIAL GOTO CASES MERGE HERE ! 20763: * ! 20764: {SCN22{BZE{SCNGO{SCN09{{TREAT AS NORMAL LETTER IF NOT GOTO ! 20765: * ! 20766: * MERGE HERE FOR SPECIAL CHARACTER EXIT ! 20767: * ! 20768: {SCN23{BZE{R7{SCN10{{JUMP IF END OF NAME/CONSTANT ! 20769: {{MOV{R9{R10{{ELSE COPY CODE ! 20770: {{BRN{SCN13{{{AND JUMP TO EXIT ! 20771: * ! 20772: * HERE FOR UNDERLINE ! 20773: * ! 20774: {SCN24{BZE{R7{SCN09{{PART OF NAME IF SCANNING NAME ! 20775: {{BRN{SCN07{{{ELSE ILLEGAL ! 20776: {{EJC{{{{ ! 20777: * ! 20778: * SCANE (CONTINUED) ! 20779: * ! 20780: * HERE FOR LEFT PAREN ! 20781: * ! 20782: {SCN25{MOV{#T$LPR{R9{{SET LEFT PAREN RETURN CODE ! 20783: {{BNZ{R7{SCN23{{RETURN LEFT PAREN UNLESS NAME ! 20784: {{BZE{R8{SCN10{{DELIMITER IF SCANNING CONSTANT ! 20785: * ! 20786: * HERE FOR LEFT PAREN AFTER NAME (FUNCTION CALL) ! 20787: * ! 20788: {{MOV{SCNSE{R7{{POINT TO START OF NAME ! 20789: {{MOV{R6{SCNPT{{SET POINTER PAST LEFT PAREN ! 20790: {{DCV{R6{{{POINT BACK PAST LAST CHAR OF NAME ! 20791: {{SUB{R7{R6{{GET NAME LENGTH ! 20792: {{MOV{R$CIM{R10{{POINT TO INPUT IMAGE ! 20793: {{JSR{SBSTR{{{GET STRING NAME FOR FUNCTION ! 20794: {{JSR{GTNVR{{{LOCATE/BUILD VRBLK ! 20795: {{PPM{{{{DUMMY (UNUSED) ERROR RETURN ! 20796: {{MOV{#T$FNC{R10{{SET CODE FOR FUNCTION CALL ! 20797: {{BRN{SCN13{{{BACK TO EXIT ! 20798: * ! 20799: * PROCESSING FOR SPECIAL CHARACTERS ! 20800: * ! 20801: {SCN26{MOV{#T$RPR{R9{{RIGHT PAREN, SET CODE ! 20802: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT ! 20803: * ! 20804: {SCN27{MOV{#T$RBR{R9{{RIGHT BRACKET, SET CODE ! 20805: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT ! 20806: * ! 20807: {SCN28{MOV{#T$LBR{R9{{LEFT BRACKET, SET CODE ! 20808: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT ! 20809: * ! 20810: {SCN29{MOV{#T$COL{R9{{COLON, SET CODE ! 20811: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT ! 20812: * ! 20813: {SCN30{MOV{#T$SMC{R9{{SEMI-COLON, SET CODE ! 20814: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT ! 20815: * ! 20816: {SCN31{MOV{#T$CMA{R9{{COMMA, SET CODE ! 20817: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT ! 20818: {{EJC{{{{ ! 20819: * ! 20820: * SCANE (CONTINUED) ! 20821: * ! 20822: * HERE FOR OPERATORS. ON ENTRY, WC POINTS TO THE TABLE OF ! 20823: * OPERATOR DOPE VECTORS AND WB IS THE INCREMENT TO STEP ! 20824: * TO THE NEXT PAIR (BINARY/UNARY) OF DOPE VECTORS IN THE ! 20825: * LIST. ON REACHING SCN46, THE POINTER HAS BEEN ADJUSTED TO ! 20826: * POINT TO THE APPROPRIATE PAIR OF DOPE VECTORS. ! 20827: * THE FIRST THREE ENTRIES ARE SPECIAL SINCE THEY CAN OCCUR ! 20828: * AS PART OF A VARIABLE NAME (.) OR CONSTANT (.+-). ! 20829: * ! 20830: {SCN32{BZE{R7{SCN09{{DOT CAN BE PART OF NAME OR CONSTANT ! 20831: {{ADD{R7{R8{{ELSE BUMP POINTER ! 20832: * ! 20833: {SCN33{BZE{R8{SCN09{{PLUS CAN BE PART OF CONSTANT ! 20834: {{BZE{R7{SCN48{{PLUS CANNOT BE PART OF NAME ! 20835: {{ADD{R7{R8{{ELSE BUMP POINTER ! 20836: * ! 20837: {SCN34{BZE{R8{SCN09{{MINUS CAN BE PART OF CONSTANT ! 20838: {{BZE{R7{SCN48{{MINUS CANNOT BE PART OF NAME ! 20839: {{ADD{R7{R8{{ELSE BUMP POINTER ! 20840: * ! 20841: {SCN35{ADD{R7{R8{{NOT ! 20842: {SCN36{ADD{R7{R8{{DOLLAR ! 20843: {SCN37{ADD{R7{R8{{EXCLAMATION ! 20844: {SCN38{ADD{R7{R8{{PERCENT ! 20845: {SCN39{ADD{R7{R8{{ASTERISK ! 20846: {SCN40{ADD{R7{R8{{SLASH ! 20847: {SCN41{ADD{R7{R8{{NUMBER SIGN ! 20848: {SCN42{ADD{R7{R8{{AT SIGN ! 20849: {SCN43{ADD{R7{R8{{VERTICAL BAR ! 20850: {SCN44{ADD{R7{R8{{AMPERSAND ! 20851: {SCN45{ADD{R7{R8{{QUESTION MARK ! 20852: * ! 20853: * ALL OPERATORS COME HERE (EQUAL MERGES DIRECTLY) ! 20854: * (WC) POINTS TO THE BINARY/UNARY PAIR OF OPERATOR DVBLKS. ! 20855: * ! 20856: {SCN46{BZE{R7{SCN10{{OPERATOR TERMINATES NAME/CONSTANT ! 20857: {{MOV{R8{R9{{ELSE COPY DV POINTER ! 20858: {{LCH{R8{(R10){{LOAD NEXT CHARACTER ! 20859: {{MOV{#T$BOP{R10{{SET BINARY OP IN CASE ! 20860: {{BEQ{R6{SCNIL{SCN47{SHOULD BE BINARY IF IMAGE END ! 20861: {{BEQ{R8{#CH$BL{SCN47{SHOULD BE BINARY IF FOLLOWED BY BLK ! 20862: {{BEQ{R8{#CH$HT{SCN47{JUMP IF HORIZONTAL TAB ! 20863: {{BEQ{R8{#CH$SM{SCN47{SEMICOLON CAN IMMEDIATELY FOLLOW = ! 20864: * ! 20865: * HERE FOR UNARY OPERATOR ! 20866: * ! 20867: {{ADD{#4*DVBS${R9{{POINT TO DV FOR UNARY OP ! 20868: {{MOV{#T$UOP{R10{{SET TYPE FOR UNARY OPERATOR ! 20869: {{BLE{SCNTP{#T$UOK{SCN13{OK UNARY IF OK PRECEDING ELEMENT ! 20870: {{EJC{{{{ ! 20871: * ! 20872: * SCANE (CONTINUED) ! 20873: * ! 20874: * MERGE HERE TO REQUIRE PRECEDING BLANKS ! 20875: * ! 20876: {SCN47{BNZ{SCNBL{SCN13{{ALL OK IF PRECEDING BLANKS, EXIT ! 20877: * ! 20878: * FAIL OPERATOR IN THIS POSITION ! 20879: * ! 20880: {SCN48{ERB{233{SYNTAX{{ERROR. INVALID USE OF OPERATOR ! 20881: * ! 20882: * HERE FOR ASTERISK, COULD BE ** SUBSTITUTE FOR EXCLAMATION ! 20883: * ! 20884: {SCN49{BZE{R7{SCN10{{END OF NAME IF SCANNING NAME ! 20885: {{BEQ{R6{SCNIL{SCN39{NOT ** IF * AT IMAGE END ! 20886: {{MOV{R6{R9{{ELSE SAVE OFFSET PAST FIRST * ! 20887: {{MOV{R6{SCNOF{{SAVE ANOTHER COPY ! 20888: {{LCH{R6{(R10)+{{LOAD NEXT CHARACTER ! 20889: {{BNE{R6{#CH$AS{SCN50{NOT ** IF NEXT CHAR NOT * ! 20890: {{ICV{R9{{{ELSE STEP OFFSET PAST SECOND * ! 20891: {{BEQ{R9{SCNIL{SCN51{OK EXCLAM IF END OF IMAGE ! 20892: {{LCH{R6{(R10){{ELSE LOAD NEXT CHARACTER ! 20893: {{BEQ{R6{#CH$BL{SCN51{EXCLAMATION IF BLANK ! 20894: {{BEQ{R6{#CH$HT{SCN51{EXCLAMATION IF HORIZONTAL TAB ! 20895: * ! 20896: * UNARY * ! 20897: * ! 20898: {SCN50{MOV{SCNOF{R6{{RECOVER STORED OFFSET ! 20899: {{MOV{R$CIM{R10{{POINT TO LINE AGAIN ! 20900: {{PLC{R10{R6{{POINT TO CURRENT CHAR ! 20901: {{BRN{SCN39{{{MERGE WITH UNARY * ! 20902: * ! 20903: * HERE FOR ** AS SUBSTITUTE FOR EXCLAMATION ! 20904: * ! 20905: {SCN51{MOV{R9{SCNPT{{SAVE SCAN POINTER PAST 2ND * ! 20906: {{MOV{R9{R6{{COPY SCAN POINTER ! 20907: {{BRN{SCN37{{{MERGE WITH EXCLAMATION ! 20908: {{ENP{{{{END PROCEDURE SCANE ! 20909: {{EJC{{{{ ! 20910: * ! 20911: * SCNGF -- SCAN GOTO FIELD ! 20912: * ! 20913: * SCNGF IS CALLED FROM CMPIL TO SCAN AND ANALYZE A GOTO ! 20914: * FIELD INCLUDING THE SURROUNDING BRACKETS OR PARENTHESES. ! 20915: * FOR A NORMAL GOTO, THE RESULT RETURNED IS EITHER A VRBLK ! 20916: * POINTER FOR A SIMPLE LABEL OPERAND, OR A POINTER TO AN ! 20917: * EXPRESSION TREE WITH A SPECIAL OUTER UNARY OPERATOR ! 20918: * (O$GOC). FOR A DIRECT GOTO, THE RESULT RETURNED IS A ! 20919: * POINTER TO AN EXPRESSION TREE WITH THE SPECIAL OUTER ! 20920: * UNARY OPERATOR O$GOD. ! 20921: * ! 20922: * JSR SCNGF CALL TO SCAN GOTO FIELD ! 20923: * (XR) RESULT (SEE ABOVE) ! 20924: * (XL,WA,WB,WC) DESTROYED ! 20925: * ! 20926: {SCNGF{PRC{E{0{{ENTRY POINT ! 20927: {{JSR{SCANE{{{SCAN INITIAL ELEMENT ! 20928: {{BEQ{R10{#T$LPR{SCNG1{SKIP IF LEFT PAREN (NORMAL GOTO) ! 20929: {{BEQ{R10{#T$LBR{SCNG2{SKIP IF LEFT BRACKET (DIRECT GOTO) ! 20930: {{ERB{234{SYNTAX{{ERROR. GOTO FIELD INCORRECT ! 20931: * ! 20932: * HERE FOR LEFT PAREN (NORMAL GOTO) ! 20933: * ! 20934: {SCNG1{MOV{#NUM01{R7{{SET EXPAN FLAG FOR NORMAL GOTO ! 20935: {{JSR{EXPAN{{{ANALYZE GOTO FIELD ! 20936: {{MOV{#OPDVN{R6{{POINT TO OPDV FOR COMPLEX GOTO ! 20937: {{BLE{R9{STATB{SCNG3{JUMP IF NOT IN STATIC (SGD15) ! 20938: {{BLO{R9{STATE{SCNG4{JUMP TO EXIT IF SIMPLE LABEL NAME ! 20939: {{BRN{SCNG3{{{COMPLEX GOTO - MERGE ! 20940: * ! 20941: * HERE FOR LEFT BRACKET (DIRECT GOTO) ! 20942: * ! 20943: {SCNG2{MOV{#NUM02{R7{{SET EXPAN FLAG FOR DIRECT GOTO ! 20944: {{JSR{EXPAN{{{SCAN GOTO FIELD ! 20945: {{MOV{#OPDVD{R6{{SET OPDV POINTER FOR DIRECT GOTO ! 20946: {{EJC{{{{ ! 20947: * ! 20948: * SCNGF (CONTINUED) ! 20949: * ! 20950: * MERGE HERE TO BUILD OUTER UNARY OPERATOR BLOCK ! 20951: * ! 20952: {SCNG3{MOV{R6{-(SP){{STACK OPERATOR DV POINTER ! 20953: {{MOV{R9{-(SP){{STACK POINTER TO EXPRESSION TREE ! 20954: {{JSR{EXPOP{{{POP OPERATOR OFF ! 20955: {{MOV{(SP)+{R9{{RELOAD NEW EXPRESSION TREE POINTER ! 20956: * ! 20957: * COMMON EXIT POINT ! 20958: * ! 20959: {SCNG4{EXI{{{{RETURN TO CALLER ! 20960: {{ENP{{{{END PROCEDURE SCNGF ! 20961: {{EJC{{{{ ! 20962: * ! 20963: * SETVR -- SET VRGET,VRSTO FIELDS OF VRBLK ! 20964: * ! 20965: * SETVR SETS THE PROPER VALUES IN THE VRGET AND VRSTO ! 20966: * FIELDS OF A VRBLK. IT IS CALLED WHENEVER TRBLKS ARE ! 20967: * ADDED OR SUBTRACTED (TRACE,STOPTR,INPUT,OUTPUT,DETACH) ! 20968: * ! 20969: * (XR) POINTER TO VRBLK ! 20970: * JSR SETVR CALL TO SET FIELDS ! 20971: * (XL,WA) DESTROYED ! 20972: * ! 20973: * NOTE THAT SETVR IGNORES THE CALL IF XR DOES NOT POINT ! 20974: * INTO THE STATIC REGION (I.E. IS SOME OTHER NAME BASE) ! 20975: * ! 20976: {SETVR{PRC{E{0{{ENTRY POINT ! 20977: {{BHI{R9{STATE{SETV1{EXIT IF NOT NATURAL VARIABLE ! 20978: * ! 20979: * HERE IF WE HAVE A VRBLK ! 20980: * ! 20981: {{MOV{R9{R10{{COPY VRBLK POINTER ! 20982: {{MOV{#B$VRL{4*VRGET(R9){{STORE NORMAL GET VALUE ! 20983: {{BEQ{4*VRSTO(R9){#B$VRE{SETV1{SKIP IF PROTECTED VARIABLE ! 20984: {{MOV{#B$VRS{4*VRSTO(R9){{STORE NORMAL STORE VALUE ! 20985: {{MOV{4*VRVAL(R10){R10{{POINT TO NEXT ENTRY ON CHAIN ! 20986: {{BNE{(R10){#B$TRT{SETV1{JUMP IF END OF TRBLK CHAIN ! 20987: {{MOV{#B$VRA{4*VRGET(R9){{STORE TRAPPED ROUTINE ADDRESS ! 20988: {{MOV{#B$VRV{4*VRSTO(R9){{SET TRAPPED ROUTINE ADDRESS ! 20989: * ! 20990: * MERGE HERE TO EXIT TO CALLER ! 20991: * ! 20992: {SETV1{EXI{{{{RETURN TO SETVR CALLER ! 20993: {{ENP{{{{END PROCEDURE SETVR ! 20994: {{EJC{{{{ ! 20995: * ! 20996: * SORTA -- SORT ARRAY ! 20997: * ! 20998: * ROUTINE TO SORT AN ARRAY OR TABLE ON SAME BASIS AS IN ! 20999: * SITBOL. A TABLE IS CONVERTED TO AN ARRAY, LEAVING TWO ! 21000: * DIMENSIONAL ARRAYS AND VECTORS AS CASES TO BE CONSIDERED. ! 21001: * WHOLE ROWS OF ARRAYS ARE PERMUTED ACCORDING TO THE ! 21002: * ORDERING OF THE KEYS THEY CONTAIN, AND THE STRIDE ! 21003: * REFERRED TO, IS THE THE LENGTH OF A ROW. IT IS ONE ! 21004: * FOR A VECTOR. ! 21005: * THE SORT USED IS HEAPSORT, FUNDAMENTALS OF DATA STRUCTURE ! 21006: * HOROWITZ AND SAHNI, PITMAN 1977, PAGE 347. ! 21007: * IT IS AN ORDER N*LOG(N) ALGORITHM. IN ORDER ! 21008: * TO MAKE IT STABLE, COMPARANDS MAY NOT COMPARE EQUAL. THIS ! 21009: * IS ACHIEVED BY SORTING A COPY ARRAY (REFERRED TO AS THE ! 21010: * SORT ARRAY) CONTAINING AT ITS HIGH ADDRESS END, BYTE ! 21011: * OFFSETS TO THE ROWS TO BE SORTED HELD IN THE ORIGINAL ! 21012: * ARRAY (REFERRED TO AS THE KEY ARRAY). SORTC, THE ! 21013: * COMPARISON ROUTINE, ACCESSES THE KEYS THROUGH THESE ! 21014: * OFFSETS AND IN THE CASE OF EQUALITY, RESOLVES IT BY ! 21015: * COMPARING THE OFFSETS THEMSELVES. THE SORT PERMUTES THE ! 21016: * OFFSETS WHICH ARE THEN USED IN A FINAL OPERATION TO COPY ! 21017: * THE ACTUAL ITEMS INTO THE NEW ARRAY IN SORTED ORDER. ! 21018: * REFERENCES TO ZEROTH ITEM ARE TO NOTIONAL ITEM ! 21019: * PRECEDING FIRST ACTUAL ITEM. ! 21020: * REVERSE SORTING FOR RSORT IS DONE BY HAVING THE LESS THAN ! 21021: * TEST FOR KEYS EFFECTIVELY BE REPLACED BY A ! 21022: * GREATER THAN TEST. ! 21023: * ! 21024: * 1(XS) FIRST ARG - ARRAY OR TABLE ! 21025: * 0(XS) 2ND ARG - INDEX OR PDTYPE NAME ! 21026: * (WA) 0 , NON-ZERO FOR SORT , RSORT ! 21027: * JSR SORTA CALL TO SORT ARRAY ! 21028: * (XR) SORTED ARRAY ! 21029: * (XL,WA,WB,WC) DESTROYED ! 21030: {{EJC{{{{ ! 21031: * ! 21032: * SORTA (CONTINUED) ! 21033: * ! 21034: {SORTA{PRC{N{0{{ENTRY POINT ! 21035: {{MOV{R6{SRTSR{{SORT/RSORT INDICATOR ! 21036: {{MOV{#4*NUM01{SRTST{{DEFAULT STRIDE OF 1 ! 21037: {{ZER{SRTOF{{{DEFAULT ZERO OFFSET TO SORT KEY ! 21038: {{MOV{#NULLS{SRTDF{{CLEAR DATATYPE FIELD NAME ! 21039: {{MOV{(SP)+{R$SXR{{UNSTACK ARGUMENT 2 ! 21040: {{MOV{(SP)+{R9{{GET FIRST ARGUMENT ! 21041: {{JSR{GTARR{{{CONVERT TO ARRAY ! 21042: {{PPM{SRT16{{{FAIL ! 21043: {{MOV{R9{-(SP){{STACK PTR TO RESULTING KEY ARRAY ! 21044: {{MOV{R9{-(SP){{ANOTHER COPY FOR COPYB ! 21045: {{JSR{COPYB{{{GET COPY ARRAY FOR SORTING INTO ! 21046: {{PPM{{{{CANT FAIL ! 21047: {{MOV{R9{-(SP){{STACK POINTER TO SORT ARRAY ! 21048: {{MOV{R$SXR{R9{{GET SECOND ARG ! 21049: {{MOV{4*1(SP){R10{{GET PTR TO KEY ARRAY ! 21050: {{BNE{(R10){#B$VCT{SRT02{JUMP IF ARBLK ! 21051: {{BEQ{R9{#NULLS{SRT01{JUMP IF NULL SECOND ARG ! 21052: {{JSR{GTNVR{{{GET VRBLK PTR FOR IT ! 21053: {{ERR{257{ERRONEOUS{{2ND ARG IN SORT/RSORT OF VECTOR ! 21054: {{MOV{R9{SRTDF{{STORE DATATYPE FIELD NAME VRBLK ! 21055: * ! 21056: * COMPUTE N AND OFFSET TO ITEM A(0) IN VECTOR CASE ! 21057: * ! 21058: {SRT01{MOV{#4*VCLEN{R8{{OFFSET TO A(0) ! 21059: {{MOV{#4*VCVLS{R7{{OFFSET TO FIRST ITEM ! 21060: {{MOV{4*VCLEN(R10){R6{{GET BLOCK LENGTH ! 21061: {{SUB{#4*VCSI${R6{{GET NO. OF ENTRIES, N (IN BYTES) ! 21062: {{BRN{SRT04{{{MERGE ! 21063: * ! 21064: * HERE FOR ARRAY ! 21065: * ! 21066: {SRT02{LDI{4*ARDIM(R10){{{GET POSSIBLE DIMENSION ! 21067: {{MFI{R6{{{CONVERT TO SHORT INTEGER ! 21068: {{WTB{R6{{{FURTHER CONVERT TO BAUS ! 21069: {{MOV{#4*ARVLS{R7{{OFFSET TO FIRST VALUE IF ONE ! 21070: {{MOV{#4*ARPRO{R8{{OFFSET BEFORE VALUES IF ONE DIM. ! 21071: {{BEQ{4*ARNDM(R10){#NUM01{SRT04{JUMP IN FACT IF ONE DIM. ! 21072: {{BNE{4*ARNDM(R10){#NUM02{SRT16{FAIL UNLESS TWO DIMENS ! 21073: {{LDI{4*ARLB2(R10){{{GET LOWER BOUND 2 AS DEFAULT ! 21074: {{BEQ{R9{#NULLS{SRT03{JUMP IF DEFAULT SECOND ARG ! 21075: {{JSR{GTINT{{{CONVERT TO INTEGER ! 21076: {{PPM{SRT17{{{FAIL ! 21077: {{LDI{4*ICVAL(R9){{{GET ACTUAL INTEGER VALUE ! 21078: {{EJC{{{{ ! 21079: * ! 21080: * SORTA (CONTINUED) ! 21081: * ! 21082: * HERE WITH SORT COLUMN INDEX IN IA IN ARRAY CASE ! 21083: * ! 21084: {SRT03{SBI{4*ARLB2(R10){{{SUBTRACT LOW BOUND ! 21085: {{IOV{SRT17{{{FAIL IF OVERFLOW ! 21086: {{ILT{SRT17{{{FAIL IF BELOW LOW BOUND ! 21087: {{SBI{4*ARDM2(R10){{{CHECK AGAINST DIMENSION ! 21088: {{IGE{SRT17{{{FAIL IF TOO LARGE ! 21089: {{ADI{4*ARDM2(R10){{{RESTORE VALUE ! 21090: {{MFI{R6{{{GET AS SMALL INTEGER ! 21091: {{WTB{R6{{{OFFSET WITHIN ROW TO KEY ! 21092: {{MOV{R6{SRTOF{{KEEP OFFSET ! 21093: {{LDI{4*ARDM2(R10){{{SECOND DIMENSION IS ROW LENGTH ! 21094: {{MFI{R6{{{CONVERT TO SHORT INTEGER ! 21095: {{MOV{R6{R9{{COPY ROW LENGTH ! 21096: {{WTB{R6{{{CONVERT TO BYTES ! 21097: {{MOV{R6{SRTST{{STORE AS STRIDE ! 21098: {{LDI{4*ARDIM(R10){{{GET NUMBER OF ROWS ! 21099: {{MFI{R6{{{AS A SHORT INTEGER ! 21100: {{WTB{R6{{{CONVERT N TO BAUS ! 21101: {{MOV{4*ARLEN(R10){R8{{OFFSET PAST ARRAY END ! 21102: {{SUB{R6{R8{{ADJUST, GIVING SPACE FOR N OFFSETS ! 21103: {{DCA{R8{{{POINT TO A(0) ! 21104: {{MOV{4*AROFS(R10){R7{{OFFSET TO WORD BEFORE FIRST ITEM ! 21105: {{ICA{R7{{{OFFSET TO FIRST ITEM ! 21106: * ! 21107: * SEPARATE PRE-PROCESSING FOR ARRAYS AND VECTORS DONE. ! 21108: * TO SIMPLIFY LATER KEY COMPARISONS, REMOVAL OF ANY TRBLK ! 21109: * TRAP BLOCKS FROM ENTRIES IN KEY ARRAY IS EFFECTED. ! 21110: * ! 21111: * (XL) = 1(XS) = POINTER TO KEY ARRAY ! 21112: * (XS) = POINTER TO SORT ARRAY ! 21113: * WA = NUMBER OF ITEMS, N (CONVERTED TO BYTES). ! 21114: * WB = OFFSET TO FIRST ITEM OF ARRAYS. ! 21115: * WC = OFFSET TO A(0) ! 21116: * ! 21117: {SRT04{BLE{R6{#4*NUM01{SRT15{RETURN IF ONLY A SINGLE ITEM ! 21118: {{MOV{R6{SRTSN{{STORE NUMBER OF ITEMS (IN BAUS) ! 21119: {{MOV{R8{SRTSO{{STORE OFFSET TO A(0) ! 21120: {{MOV{4*ARLEN(R10){R8{{LENGTH OF ARRAY OR VEC (=VCLEN) ! 21121: {{ADD{R10{R8{{POINT PAST END OF ARRAY OR VECTOR ! 21122: {{MOV{R7{SRTSF{{STORE OFFSET TO FIRST ROW ! 21123: {{ADD{R7{R10{{POINT TO FIRST ITEM IN KEY ARRAY ! 21124: * ! 21125: * LOOP THROUGH ARRAY ! 21126: * ! 21127: {SRT05{MOV{(R10){R9{{GET AN ENTRY ! 21128: * ! 21129: * HUNT ALONG TRBLK CHAIN ! 21130: * ! 21131: {SRT06{BNE{(R9){#B$TRT{SRT07{JUMP OUT IF NOT TRBLK ! 21132: {{MOV{4*TRVAL(R9){R9{{GET VALUE FIELD ! 21133: {{BRN{SRT06{{{LOOP ! 21134: {{EJC{{{{ ! 21135: * ! 21136: * SORTA (CONTINUED) ! 21137: * ! 21138: * XR IS VALUE FROM END OF CHAIN ! 21139: * ! 21140: {SRT07{MOV{R9{(R10)+{{STORE AS ARRAY ENTRY ! 21141: {{BLT{R10{R8{SRT05{LOOP IF NOT DONE ! 21142: {{MOV{(SP){R10{{GET ADRS OF SORT ARRAY ! 21143: {{MOV{SRTSF{R9{{INITIAL OFFSET TO FIRST KEY ! 21144: {{MOV{SRTST{R7{{GET STRIDE ! 21145: {{ADD{SRTSO{R10{{OFFSET TO A(0) ! 21146: {{ICA{R10{{{POINT TO A(1) ! 21147: {{MOV{SRTSN{R8{{GET N ! 21148: {{BTW{R8{{{CONVERT FROM BYTES ! 21149: {{MOV{R8{SRTNR{{STORE AS ROW COUNT ! 21150: {{LCT{R8{R8{{LOOP COUNTER ! 21151: * ! 21152: * STORE KEY OFFSETS AT TOP OF SORT ARRAY ! 21153: * ! 21154: {SRT08{MOV{R9{(R10)+{{STORE AN OFFSET ! 21155: {{ADD{R7{R9{{BUMP OFFSET BY STRIDE ! 21156: {{BCT{R8{SRT08{{LOOP THROUGH ROWS ! 21157: * ! 21158: * PERFORM THE SORT ON OFFSETS IN SORT ARRAY. ! 21159: * ! 21160: * (SRTSN) NUMBER OF ITEMS TO SORT, N (BYTES) ! 21161: * (SRTSO) OFFSET TO A(0) ! 21162: * ! 21163: {SRT09{MOV{SRTSN{R6{{GET N ! 21164: {{MOV{SRTNR{R8{{GET NUMBER OF ROWS ! 21165: {{RSH{R8{1{{I = N / 2 (WC=I, INDEX INTO ARRAY) ! 21166: {{WTB{R8{{{CONVERT BACK TO BYTES ! 21167: * ! 21168: * LOOP TO FORM INITIAL HEAP ! 21169: * ! 21170: {SRT10{JSR{SORTH{{{SORTH(I,N) ! 21171: {{DCA{R8{{{I = I - 1 ! 21172: {{BNZ{R8{SRT10{{LOOP IF I GT 0 ! 21173: {{MOV{R6{R8{{I = N ! 21174: * ! 21175: * SORTING LOOP. AT THIS POINT, A(1) IS THE LARGEST ! 21176: * ITEM, SINCE ALGORITHM INITIALISES IT AS, AND THEN MAINTAI ! 21177: * IT AS, ROOT OF TREE. ! 21178: * ! 21179: {SRT11{DCA{R8{{{I = I - 1 (N - 1 INITIALLY) ! 21180: {{BZE{R8{SRT12{{JUMP IF DONE ! 21181: {{MOV{(SP){R9{{GET SORT ARRAY ADDRESS ! 21182: {{ADD{SRTSO{R9{{POINT TO A(0) ! 21183: {{MOV{R9{R10{{A(0) ADDRESS ! 21184: {{ADD{R8{R10{{A(I) ADDRESS ! 21185: {{MOV{4*1(R10){R7{{COPY A(I+1) ! 21186: {{MOV{4*1(R9){4*1(R10){{MOVE A(1) TO A(I+1) ! 21187: {{MOV{R7{4*1(R9){{COMPLETE EXCHANGE OF A(1), A(I+1) ! 21188: {{MOV{R8{R6{{N = I FOR SORTH ! 21189: {{MOV{#4*NUM01{R8{{I = 1 FOR SORTH ! 21190: {{JSR{SORTH{{{SORTH(1,N) ! 21191: {{MOV{R6{R8{{RESTORE WC ! 21192: {{BRN{SRT11{{{LOOP ! 21193: {{EJC{{{{ ! 21194: * ! 21195: * SORTA (CONTINUED) ! 21196: * ! 21197: * OFFSETS HAVE BEEN PERMUTED INTO REQUIRED ORDER BY SORT. ! 21198: * COPY ARRAY ELEMENTS OVER THEM. ! 21199: * ! 21200: {SRT12{MOV{(SP){R10{{BASE ADRS OF KEY ARRAY ! 21201: {{MOV{R10{R8{{COPY IT ! 21202: {{ADD{SRTSO{R8{{OFFSET OF A(0) ! 21203: {{ADD{SRTSF{R10{{ADRS OF FIRST ROW OF SORT ARRAY ! 21204: {{MOV{SRTST{R7{{GET STRIDE ! 21205: {{BTW{R7{{{CONVERT TO WORDS ! 21206: * ! 21207: * COPYING LOOP FOR SUCCESSIVE ITEMS. SORTED OFFSETS ARE ! 21208: * HELD AT END OF SORT ARRAY. ! 21209: * ! 21210: {SRT13{ICA{R8{{{ADRS OF NEXT OF SORTED OFFSETS ! 21211: {{MOV{R8{R9{{COPY IT FOR ACCESS ! 21212: {{MOV{(R9){R9{{GET OFFSET ! 21213: {{ADD{4*1(SP){R9{{ADD KEY ARRAY BASE ADRS ! 21214: {{LCT{R6{R7{{GET COUNT OF WORDS IN ROW ! 21215: * ! 21216: * COPY A COMPLETE ROW ! 21217: * ! 21218: {SRT14{MOV{(R9)+{(R10)+{{MOVE A WORD ! 21219: {{BCT{R6{SRT14{{LOOP ! 21220: {{DCV{SRTNR{{{DECREMENT ROW COUNT ! 21221: {{BNZ{SRTNR{SRT13{{REPEAT TILL ALL ROWS DONE ! 21222: * ! 21223: * RETURN POINT ! 21224: * ! 21225: {SRT15{MOV{(SP)+{R9{{POP RESULT ARRAY PTR ! 21226: {{ICA{SP{{{POP KEY ARRAY PTR ! 21227: {{ZER{R$SXL{{{CLEAR JUNK ! 21228: {{ZER{R$SXR{{{CLEAR JUNK ! 21229: {{EXI{{{{RETURN ! 21230: * ! 21231: * ERROR POINT ! 21232: * ! 21233: {SRT16{ERB{256{SORT/RSORT{{1ST ARG NOT SUITABLE ARRAY OR TABLE ! 21234: {SRT17{ERB{258{SORT/RSORT{{2ND ARG OUT OF RANGE OR NON-INTEGER ! 21235: {{ENP{{{{END PROCUDURE SORTA ! 21236: {{EJC{{{{ ! 21237: * ! 21238: * SORTC -- COMPARE SORT KEYS ! 21239: * ! 21240: * COMPARE TWO SORT KEYS GIVEN THEIR OFFSETS. IF ! 21241: * EQUAL, COMPARE KEY OFFSETS TO GIVE STABLE SORT. ! 21242: * NOTE THAT IF SRTSR IS NON-ZERO (REQUEST FOR REVERSE ! 21243: * SORT), THE QUOTED RETURNS ARE INVERTED. ! 21244: * FOR OBJECTS OF DIFFERING DATATYPES, THE ENTRY POINT ! 21245: * IDENTIFICATIONS ARE COMPARED. ! 21246: * ! 21247: * (XL) BASE ADRS FOR KEYS ! 21248: * (WA) OFFSET TO KEY 1 ITEM ! 21249: * (WB) OFFSET TO KEY 2 ITEM ! 21250: * (SRTSR) ZERO/NON-ZERO FOR SORT/RSORT ! 21251: * (SRTOF) OFFSET WITHIN ROW TO COMPARANDS ! 21252: * JSR SORTC CALL TO COMPARE KEYS ! 21253: * PPM LOC KEY1 LESS THAN KEY2 ! 21254: * NORMAL RETURN, KEY1 GT THAN KEY2 ! 21255: * (XL,XR,WA,WB) DESTROYED ! 21256: * ! 21257: {SORTC{PRC{E{1{{ENTRY POINT ! 21258: {{MOV{R6{SRTS1{{SAVE OFFSET 1 ! 21259: {{MOV{R7{SRTS2{{SAVE OFFSET 2 ! 21260: {{MOV{R8{SRTSC{{SAVE WC ! 21261: {{ADD{SRTOF{R10{{ADD OFFSET TO COMPARAND FIELD ! 21262: {{MOV{R10{R9{{COPY BASE + OFFSET ! 21263: {{ADD{R6{R10{{ADD KEY1 OFFSET ! 21264: {{ADD{R7{R9{{ADD KEY2 OFFSET ! 21265: {{MOV{(R10){R10{{GET KEY1 ! 21266: {{MOV{(R9){R9{{GET KEY2 ! 21267: {{BNE{SRTDF{#NULLS{SRC11{JUMP IF DATATYPE FIELD NAME USED ! 21268: {{EJC{{{{ ! 21269: * ! 21270: * SORTC (CONTINUED) ! 21271: * ! 21272: * MERGE AFTER DEALING WITH FIELD NAME. TRY FOR STRINGS. ! 21273: * ! 21274: {SRC01{MOV{(R10){R8{{GET TYPE CODE ! 21275: {{BNE{R8{(R9){SRC02{SKIP IF NOT SAME DATATYPE ! 21276: {{BEQ{R8{#B$SCL{SRC09{JUMP IF BOTH STRINGS ! 21277: * ! 21278: * NOW TRY FOR NUMERIC ! 21279: * ! 21280: {SRC02{MOV{R10{R$SXL{{KEEP ARG1 ! 21281: {{MOV{R9{R$SXR{{KEEP ARG2 ! 21282: {{MOV{R10{-(SP){{STACK ! 21283: {{MOV{R9{-(SP){{ARGS ! 21284: {{JSR{ACOMP{{{COMPARE OBJECTS ! 21285: {{PPM{SRC10{{{NOT NUMERIC ! 21286: {{PPM{SRC10{{{NOT NUMERIC ! 21287: {{PPM{SRC03{{{KEY1 LESS ! 21288: {{PPM{SRC08{{{KEYS EQUAL ! 21289: {{PPM{SRC05{{{KEY1 GREATER ! 21290: * ! 21291: * RETURN IF KEY1 SMALLER (SORT), GREATER (RSORT) ! 21292: * ! 21293: {SRC03{BNZ{SRTSR{SRC06{{JUMP IF RSORT ! 21294: * ! 21295: {SRC04{MOV{SRTSC{R8{{RESTORE WC ! 21296: {{EXI{1{{{RETURN ! 21297: * ! 21298: * RETURN IF KEY1 GREATER (SORT), SMALLER (RSORT) ! 21299: * ! 21300: {SRC05{BNZ{SRTSR{SRC04{{JUMP IF RSORT ! 21301: * ! 21302: {SRC06{MOV{SRTSC{R8{{RESTORE WC ! 21303: {{EXI{{{{RETURN ! 21304: * ! 21305: * KEYS ARE OF SAME DATATYPE ! 21306: * ! 21307: {SRC07{BLT{R10{R9{SRC03{ITEM FIRST CREATED IS LESS ! 21308: {{BGT{R10{R9{SRC05{ADDRESSES RISE IN ORDER OF CREATION ! 21309: * ! 21310: * DROP THROUGH OR MERGE FOR IDENTICAL OR EQUAL OBJECTS ! 21311: * ! 21312: {SRC08{BLT{SRTS1{SRTS2{SRC04{TEST OFFSETS OR KEY ADDRSS INSTEAD ! 21313: {{BRN{SRC06{{{OFFSET 1 GREATER ! 21314: {{EJC{{{{ ! 21315: * ! 21316: * SORTC (CONTINUED) ! 21317: * ! 21318: * STRINGS ! 21319: * ! 21320: {SRC09{MOV{R10{-(SP){{STACK ! 21321: {{MOV{R9{-(SP){{ARGS ! 21322: {{JSR{LCOMP{{{COMPARE OBJECTS ! 21323: {{PPM{{{{CANT ! 21324: {{PPM{{{{FAIL ! 21325: {{PPM{SRC03{{{KEY1 LESS ! 21326: {{PPM{SRC08{{{KEYS EQUAL ! 21327: {{PPM{SRC05{{{KEY1 GREATER ! 21328: * ! 21329: * ARITHMETIC COMPARISON FAILED - RECOVER ARGS ! 21330: * ! 21331: {SRC10{MOV{R$SXL{R10{{GET ARG1 ! 21332: {{MOV{R$SXR{R9{{GET ARG2 ! 21333: {{MOV{(R10){R8{{GET TYPE OF KEY1 ! 21334: {{BEQ{R8{(R9){SRC07{JUMP IF KEYS OF SAME TYPE ! 21335: {{MOV{R8{R10{{GET BLOCK TYPE WORD ! 21336: {{MOV{(R9){R9{{GET BLOCK TYPE WORD ! 21337: {{LEI{R10{{{ENTRY POINT ID FOR KEY1 ! 21338: {{LEI{R9{{{ENTRY POINT ID FOR KEY2 ! 21339: {{BGT{R10{R9{SRC05{JUMP IF KEY1 GT KEY2 ! 21340: {{BRN{SRC03{{{KEY1 LT KEY2 ! 21341: * ! 21342: * DATATYPE FIELD NAME USED ! 21343: * ! 21344: {SRC11{JSR{SORTF{{{CALL ROUTINE TO FIND FIELD 1 ! 21345: {{MOV{R10{-(SP){{STACK ITEM POINTER ! 21346: {{MOV{R9{R10{{GET KEY2 ! 21347: {{JSR{SORTF{{{FIND FIELD 2 ! 21348: {{MOV{R10{R9{{PLACE AS KEY2 ! 21349: {{MOV{(SP)+{R10{{RECOVER KEY1 ! 21350: {{BRN{SRC01{{{MERGE ! 21351: {{ENP{{{{PROCEDURE SORTC ! 21352: {{EJC{{{{ ! 21353: * ! 21354: * SORTF -- FIND FIELD FOR SORTC ! 21355: * ! 21356: * ROUTINE USED BY SORTC TO OBTAIN ITEM CORRESPONDING ! 21357: * TO A GIVEN FIELD NAME, IF THIS EXISTS, IN A PROGRAMMER ! 21358: * DEFINED OBJECT PASSED AS ARGUMENT. ! 21359: * IF SUCH A MATCH OCCURS, RECORD IS KEPT OF DATATYPE ! 21360: * NAME, FIELD NAME AND OFFSET TO FIELD IN ORDER TO ! 21361: * SHORT-CIRCUIT LATER SEARCHES ON SAME TYPE. NOTE THAT ! 21362: * DFBLKS ARE STORED IN STATIC AND HENCE CANNOT BE MOVED. ! 21363: * ! 21364: * (SRTDF) VRBLK POINTER OF FIELD NAME ! 21365: * (XL) POSSIBLE PDBLK POINTER ! 21366: * JSR SORTF CALL TO SEARCH FOR FIELD NAME ! 21367: * (XL) ITEM FOUND OR ORIGINAL PDBLK PTR ! 21368: * (WC) DESTROYED ! 21369: * ! 21370: {SORTF{PRC{E{0{{ENTRY POINT ! 21371: {{BNE{(R10){#B$PDT{SRTF3{RETURN IF NOT PDBLK ! 21372: {{MOV{R9{-(SP){{KEEP XR ! 21373: {{MOV{SRTFD{R9{{GET POSSIBLE FORMER DFBLK PTR ! 21374: {{BZE{R9{SRTF4{{JUMP IF NOT ! 21375: {{BNE{R9{4*PDDFP(R10){SRTF4{JUMP IF NOT RIGHT DATATYPE ! 21376: {{BNE{SRTDF{SRTFF{SRTF4{JUMP IF NOT RIGHT FIELD NAME ! 21377: {{ADD{SRTFO{R10{{ADD OFFSET TO REQUIRED FIELD ! 21378: * ! 21379: * HERE WITH XL POINTING TO FOUND FIELD ! 21380: * ! 21381: {SRTF1{MOV{(R10){R10{{GET ITEM FROM FIELD ! 21382: * ! 21383: * RETURN POINT ! 21384: * ! 21385: {SRTF2{MOV{(SP)+{R9{{RESTORE XR ! 21386: * ! 21387: {SRTF3{EXI{{{{RETURN ! 21388: {{EJC{{{{ ! 21389: * ! 21390: * SORTF (CONTINUED) ! 21391: * ! 21392: * CONDUCT A SEARCH ! 21393: * ! 21394: {SRTF4{MOV{R10{R9{{COPY ORIGINAL POINTER ! 21395: {{MOV{4*PDDFP(R9){R9{{POINT TO DFBLK ! 21396: {{MOV{R9{SRTFD{{KEEP A COPY ! 21397: {{MOV{4*FARGS(R9){R8{{GET NUMBER OF FIELDS ! 21398: {{WTB{R8{{{CONVERT TO BYTES ! 21399: {{ADD{4*DFLEN(R9){R9{{POINT PAST LAST FIELD ! 21400: * ! 21401: * LOOP TO FIND NAME IN PDFBLK ! 21402: * ! 21403: {SRTF5{DCA{R8{{{COUNT DOWN ! 21404: {{DCA{R9{{{POINT IN FRONT ! 21405: {{BEQ{(R9){SRTDF{SRTF6{SKIP OUT IF FOUND ! 21406: {{BNZ{R8{SRTF5{{LOOP ! 21407: {{BRN{SRTF2{{{RETURN - NOT FOUND ! 21408: * ! 21409: * FOUND ! 21410: * ! 21411: {SRTF6{MOV{(R9){SRTFF{{KEEP FIELD NAME PTR ! 21412: {{ADD{#4*PDFLD{R8{{ADD OFFSET TO FIRST FIELD ! 21413: {{MOV{R8{SRTFO{{STORE AS FIELD OFFSET ! 21414: {{ADD{R8{R10{{POINT TO FIELD ! 21415: {{BRN{SRTF1{{{RETURN ! 21416: {{ENP{{{{PROCEDURE SORTF ! 21417: {{EJC{{{{ ! 21418: * ! 21419: * SORTH -- HEAP ROUTINE FOR SORTA ! 21420: * ! 21421: * THIS ROUTINE CONSTRUCTS A HEAP FROM ELEMENTS OF ARRAY, A. ! 21422: * IN THIS APPLICATION, THE ELEMENTS ARE OFFSETS TO KEYS IN ! 21423: * A KEY ARRAY. ! 21424: * ! 21425: * (XS) POINTER TO SORT ARRAY BASE ! 21426: * 1(XS) POINTER TO KEY ARRAY BASE ! 21427: * (WA) MAX ARRAY INDEX, N (IN BYTES) ! 21428: * (WC) OFFSET J IN A TO ROOT (IN *1 TO *N) ! 21429: * JSR SORTH CALL SORTH(J,N) TO MAKE HEAP ! 21430: * (XL,XR,WB) DESTROYED ! 21431: * ! 21432: {SORTH{PRC{N{0{{ENTRY POINT ! 21433: {{MOV{R6{SRTSN{{SAVE N ! 21434: {{MOV{R8{SRTWC{{KEEP WC ! 21435: {{MOV{(SP){R10{{SORT ARRAY BASE ADRS ! 21436: {{ADD{SRTSO{R10{{ADD OFFSET TO A(0) ! 21437: {{ADD{R8{R10{{POINT TO A(J) ! 21438: {{MOV{(R10){SRTRT{{GET OFFSET TO ROOT ! 21439: {{ADD{R8{R8{{DOUBLE J - CANT EXCEED N ! 21440: * ! 21441: * LOOP TO MOVE DOWN TREE USING DOUBLED INDEX J ! 21442: * ! 21443: {SRH01{BGT{R8{SRTSN{SRH03{DONE IF J GT N ! 21444: {{BEQ{R8{SRTSN{SRH02{SKIP IF J EQUALS N ! 21445: {{MOV{(SP){R9{{SORT ARRAY BASE ADRS ! 21446: {{MOV{4*1(SP){R10{{KEY ARRAY BASE ADRS ! 21447: {{ADD{SRTSO{R9{{POINT TO A(0) ! 21448: {{ADD{R8{R9{{ADRS OF A(J) ! 21449: {{MOV{4*1(R9){R6{{GET A(J+1) ! 21450: {{MOV{(R9){R7{{GET A(J) ! 21451: * ! 21452: * COMPARE SONS. (WA) RIGHT SON, (WB) LEFT SON ! 21453: * ! 21454: {{JSR{SORTC{{{COMPARE KEYS - LT(A(J+1),A(J)) ! 21455: {{PPM{SRH02{{{A(J+1) LT A(J) ! 21456: {{ICA{R8{{{POINT TO GREATER SON, A(J+1) ! 21457: {{EJC{{{{ ! 21458: * ! 21459: * SORTH (CONTINUED) ! 21460: * ! 21461: * COMPARE ROOT WITH GREATER SON ! 21462: * ! 21463: {SRH02{MOV{4*1(SP){R10{{KEY ARRAY BASE ADRS ! 21464: {{MOV{(SP){R9{{GET SORT ARRAY ADDRESS ! 21465: {{ADD{SRTSO{R9{{ADRS OF A(0) ! 21466: {{MOV{R9{R7{{COPY THIS ADRS ! 21467: {{ADD{R8{R9{{ADRS OF GREATER SON, A(J) ! 21468: {{MOV{(R9){R6{{GET A(J) ! 21469: {{MOV{R7{R9{{POINT BACK TO A(0) ! 21470: {{MOV{SRTRT{R7{{GET ROOT ! 21471: {{JSR{SORTC{{{COMPARE THEM - LT(A(J),ROOT) ! 21472: {{PPM{SRH03{{{FATHER EXCEEDS SONS - DONE ! 21473: {{MOV{(SP){R9{{GET SORT ARRAY ADRS ! 21474: {{ADD{SRTSO{R9{{POINT TO A(0) ! 21475: {{MOV{R9{R10{{COPY IT ! 21476: {{MOV{R8{R6{{COPY J ! 21477: {{BTW{R8{{{CONVERT TO WORDS ! 21478: {{RSH{R8{1{{GET J/2 ! 21479: {{WTB{R8{{{CONVERT BACK TO BYTES ! 21480: {{ADD{R6{R10{{POINT TO A(J) ! 21481: {{ADD{R8{R9{{ADRS OF A(J/2) ! 21482: {{MOV{(R10){(R9){{A(J/2) = A(J) ! 21483: {{MOV{R6{R8{{RECOVER J ! 21484: {{AOV{R8{R8{SRH03{J = J*2. DONE IF TOO BIG ! 21485: {{BRN{SRH01{{{LOOP ! 21486: * ! 21487: * FINISH BY COPYING ROOT OFFSET BACK INTO ARRAY ! 21488: * ! 21489: {SRH03{BTW{R8{{{CONVERT TO WORDS ! 21490: {{RSH{R8{1{{J = J/2 ! 21491: {{WTB{R8{{{CONVERT BACK TO BYTES ! 21492: {{MOV{(SP){R9{{SORT ARRAY ADRS ! 21493: {{ADD{SRTSO{R9{{ADRS OF A(0) ! 21494: {{ADD{R8{R9{{ADRS OF A(J/2) ! 21495: {{MOV{SRTRT{(R9){{A(J/2) = ROOT ! 21496: {{MOV{SRTSN{R6{{RESTORE WA ! 21497: {{MOV{SRTWC{R8{{RESTORE WC ! 21498: {{EXI{{{{RETURN ! 21499: {{ENP{{{{END PROCEDURE SORTH ! 21500: {{EJC{{{{ ! 21501: {{EJC{{{{ ! 21502: * ! 21503: * TFIND -- LOCATE TABLE ELEMENT ! 21504: * ! 21505: * (XR) SUBSCRIPT VALUE FOR ELEMENT ! 21506: * (XL) POINTER TO TABLE ! 21507: * (WB) ZERO BY VALUE, NON-ZERO BY NAME ! 21508: * JSR TFIND CALL TO LOCATE ELEMENT ! 21509: * PPM LOC TRANSFER LOCATION IF ACCESS FAILS ! 21510: * (XR) ELEMENT VALUE (IF BY VALUE) ! 21511: * (XR) DESTROYED (IF BY NAME) ! 21512: * (XL,WA) TEBLK NAME (IF BY NAME) ! 21513: * (XL,WA) DESTROYED (IF BY VALUE) ! 21514: * (WC,RA) DESTROYED ! 21515: * ! 21516: * NOTE THAT IF A CALL BY VALUE SPECIFIES A NON-EXISTENT ! 21517: * SUBSCRIPT, NULL IS RETURNED WITHOUT BUILDING A NEW TEBLK. ! 21518: * ! 21519: {TFIND{PRC{E{1{{ENTRY POINT ! 21520: {{MOV{R7{-(SP){{SAVE NAME/VALUE INDICATOR ! 21521: {{MOV{R9{-(SP){{SAVE SUBSCRIPT VALUE ! 21522: {{MOV{R10{-(SP){{SAVE TABLE POINTER ! 21523: {{MOV{4*TBLEN(R10){R6{{LOAD LENGTH OF TBBLK ! 21524: {{BTW{R6{{{CONVERT TO WORD COUNT ! 21525: {{SUB{#TBBUK{R6{{GET NUMBER OF BUCKETS ! 21526: {{MTI{R6{{{CONVERT TO INTEGER VALUE ! 21527: {{STI{TFNSI{{{SAVE FOR LATER ! 21528: {{MOV{(R9){R10{{LOAD FIRST WORD OF SUBSCRIPT ! 21529: {{LEI{R10{{{LOAD BLOCK ENTRY ID (BL$XX) ! 21530: {{BSW{R10{BL$$D{TFN00{SWITCH ON BLOCK TYPE ! 21531: {{IFF{DUMMY{TFN00{{ ! 21532: {{IFF{DUMMY{TFN00{{ ! 21533: {{IFF{DUMMY{TFN00{{ ! 21534: {{IFF{DUMMY{TFN00{{ ! 21535: {{IFF{BL$IC{TFN02{{JUMP IF INTEGER ! 21536: {{IFF{BL$NM{TFN04{{JUMP IF NAME ! 21537: {{IFF{BL$P0{TFN03{{JUMP IF PATTERN ! 21538: {{IFF{BL$P1{TFN03{{JUMP IF PATTERN ! 21539: {{IFF{BL$P2{TFN03{{JUMP IF PATTERN ! 21540: {{IFF{BL$RC{TFN02{{REAL ! 21541: {{IFF{BL$SC{TFN05{{JUMP IF STRING ! 21542: {{IFF{DUMMY{TFN00{{ ! 21543: {{IFF{DUMMY{TFN00{{ ! 21544: {{IFF{DUMMY{TFN00{{ ! 21545: {{IFF{DUMMY{TFN00{{ ! 21546: {{IFF{DUMMY{TFN00{{ ! 21547: {{IFF{DUMMY{TFN00{{ ! 21548: {{ESW{{{{END SWITCH ON BLOCK TYPE ! 21549: * ! 21550: * HERE FOR BLOCKS FOR WHICH WE USE THE SECOND WORD OF THE ! 21551: * BLOCK AS THE HASH SOURCE (SEE BLOCK FORMATS FOR DETAILS). ! 21552: * ! 21553: {TFN00{MOV{4*1(R9){R6{{LOAD SECOND WORD ! 21554: * ! 21555: * MERGE HERE WITH ONE WORD HASH SOURCE IN WA ! 21556: * ! 21557: {TFN01{MTI{R6{{{CONVERT TO INTEGER ! 21558: {{BRN{TFN06{{{JUMP TO MERGE ! 21559: {{EJC{{{{ ! 21560: * ! 21561: * TFIND (CONTINUED) ! 21562: * ! 21563: * HERE FOR INTEGER OR REAL ! 21564: * ! 21565: {TFN02{LDI{4*1(R9){{{LOAD VALUE AS HASH SOURCE ! 21566: {{IGE{TFN06{{{OK IF POSITIVE OR ZERO ! 21567: {{NGI{{{{MAKE POSITIVE ! 21568: {{IOV{TFN06{{{CLEAR POSSIBLE OVERFLOW ! 21569: {{BRN{TFN06{{{MERGE ! 21570: * ! 21571: * FOR PATTERN, USE FIRST WORD (PCODE) AS SOURCE ! 21572: * ! 21573: {TFN03{MOV{(R9){R6{{LOAD FIRST WORD AS HASH SOURCE ! 21574: {{BRN{TFN01{{{MERGE BACK ! 21575: * ! 21576: * FOR NAME, USE OFFSET AS HASH SOURCE ! 21577: * ! 21578: {TFN04{MOV{4*NMOFS(R9){R6{{LOAD OFFSET AS HASH SOURCE ! 21579: {{BRN{TFN01{{{MERGE BACK ! 21580: * ! 21581: * HERE FOR STRING ! 21582: * ! 21583: {TFN05{JSR{HASHS{{{CALL ROUTINE TO COMPUTE HASH ! 21584: * ! 21585: * MERGE HERE WITH HASH SOURCE IN (IA) ! 21586: * ! 21587: {TFN06{RMI{TFNSI{{{COMPUTE HASH INDEX BY REMAINDERING ! 21588: {{MFI{R8{{{GET AS ONE WORD INTEGER ! 21589: {{WTB{R8{{{CONVERT TO BYTE OFFSET ! 21590: {{MOV{(SP){R10{{GET TABLE PTR AGAIN ! 21591: {{ADD{R8{R10{{POINT TO PROPER BUCKET ! 21592: {{MOV{4*TBBUK(R10){R9{{LOAD FIRST TEBLK POINTER ! 21593: {{BEQ{R9{(SP){TFN10{JUMP IF NO TEBLKS ON CHAIN ! 21594: * ! 21595: * LOOP THROUGH TEBLKS ON HASH CHAIN ! 21596: * ! 21597: {TFN07{MOV{R9{R7{{SAVE TEBLK POINTER ! 21598: {{MOV{4*TESUB(R9){R9{{LOAD SUBSCRIPT VALUE ! 21599: {{MOV{4*1(SP){R10{{LOAD INPUT ARGUMENT SUBSCRIPT VAL ! 21600: {{JSR{IDENT{{{COMPARE THEM ! 21601: {{PPM{TFN08{{{JUMP IF EQUAL (IDENT) ! 21602: * ! 21603: * HERE IF NO MATCH WITH THAT TEBLK ! 21604: * ! 21605: {{MOV{R7{R10{{RESTORE TEBLK POINTER ! 21606: {{MOV{4*TENXT(R10){R9{{POINT TO NEXT TEBLK ON CHAIN ! 21607: {{BNE{R9{(SP){TFN07{JUMP IF THERE IS ONE ! 21608: * ! 21609: * HERE IF NO MATCH WITH ANY TEBLK ON CHAIN ! 21610: * ! 21611: {{MOV{#4*TENXT{R8{{SET OFFSET TO LINK FIELD (XL BASE) ! 21612: {{BRN{TFN11{{{JUMP TO MERGE ! 21613: {{EJC{{{{ ! 21614: * ! 21615: * TFIND (CONTINUED) ! 21616: * ! 21617: * HERE WE HAVE FOUND A MATCHING ELEMENT ! 21618: * ! 21619: {TFN08{MOV{R7{R10{{RESTORE TEBLK POINTER ! 21620: {{MOV{#4*TEVAL{R6{{SET TEBLK NAME OFFSET ! 21621: {{MOV{4*2(SP){R7{{RESTORE NAME/VALUE INDICATOR ! 21622: {{BNZ{R7{TFN09{{JUMP IF CALLED BY NAME ! 21623: {{JSR{ACESS{{{ELSE GET VALUE ! 21624: {{PPM{TFN12{{{JUMP IF REFERENCE FAILS ! 21625: {{ZER{R7{{{RESTORE NAME/VALUE INDICATOR ! 21626: * ! 21627: * COMMON EXIT FOR ENTRY FOUND ! 21628: * ! 21629: {TFN09{ADD{#4*NUM03{SP{{POP STACK ENTRIES ! 21630: {{EXI{{{{RETURN TO TFIND CALLER ! 21631: * ! 21632: * HERE IF NO TEBLKS ON THE HASH CHAIN ! 21633: * ! 21634: {TFN10{ADD{#4*TBBUK{R8{{GET OFFSET TO BUCKET PTR ! 21635: {{MOV{(SP){R10{{SET TBBLK PTR AS BASE ! 21636: * ! 21637: * MERGE HERE WITH (XL,WC) BASE,OFFSET OF FINAL LINK ! 21638: * ! 21639: {TFN11{MOV{(SP){R9{{TBBLK POINTER ! 21640: {{MOV{4*TBINV(R9){R9{{LOAD DEFAULT VALUE IN CASE ! 21641: {{MOV{4*2(SP){R7{{LOAD NAME/VALUE INDICATOR ! 21642: {{BZE{R7{TFN09{{EXIT WITH DEFAULT IF VALUE CALL ! 21643: * ! 21644: * HERE WE MUST BUILD A NEW TEBLK ! 21645: * ! 21646: {{MOV{#4*TESI${R6{{SET SIZE OF TEBLK ! 21647: {{JSR{ALLOC{{{ALLOCATE TEBLK ! 21648: {{ADD{R8{R10{{POINT TO HASH LINK ! 21649: {{MOV{R9{(R10){{LINK NEW TEBLK AT END OF CHAIN ! 21650: {{MOV{#B$TET{(R9){{STORE TYPE WORD ! 21651: {{MOV{#NULLS{4*TEVAL(R9){{SET NULL AS INITIAL VALUE ! 21652: {{MOV{(SP)+{4*TENXT(R9){{SET TBBLK PTR TO MARK END OF CHAIN ! 21653: {{MOV{(SP)+{4*TESUB(R9){{STORE SUBSCRIPT VALUE ! 21654: {{ICA{SP{{{POP PAST NAME/VALUE INDICATOR ! 21655: {{MOV{R9{R10{{COPY TEBLK POINTER (NAME BASE) ! 21656: {{MOV{#4*TEVAL{R6{{SET OFFSET ! 21657: {{EXI{{{{RETURN TO CALLER WITH NEW TEBLK ! 21658: * ! 21659: * ACESS FAIL RETURN ! 21660: * ! 21661: {TFN12{EXI{1{{{ALTERNATIVE RETURN ! 21662: {{ENP{{{{END PROCEDURE TFIND ! 21663: {{EJC{{{{ ! 21664: * ! 21665: * TRACE -- SET/RESET A TRACE ASSOCIATION ! 21666: * ! 21667: * THIS PROCEDURE IS SHARED BY TRACE AND STOPTR TO ! 21668: * EITHER INITIATE OR STOP A TRACE RESPECTIVELY. ! 21669: * ! 21670: * (XL) TRBLK PTR (TRACE) OR ZERO (STOPTR) ! 21671: * 1(XS) FIRST ARGUMENT (NAME) ! 21672: * 0(XS) SECOND ARGUMENT (TRACE TYPE) ! 21673: * JSR TRACE CALL TO SET/RESET TRACE ! 21674: * PPM LOC TRANSFER LOC IF 1ST ARG IS BAD NAME ! 21675: * PPM LOC TRANSFER LOC IF 2ND ARG IS BAD TYPE ! 21676: * (XS) POPPED ! 21677: * (XL,XR,WA,WB,WC,IA) DESTROYED ! 21678: * ! 21679: {TRACE{PRC{N{2{{ENTRY POINT ! 21680: {{JSR{GTSTG{{{GET TRACE TYPE STRING ! 21681: {{PPM{TRC15{{{JUMP IF NOT STRING ! 21682: {{PLC{R9{{{ELSE POINT TO STRING ! 21683: {{LCH{R6{(R9){{LOAD FIRST CHARACTER ! 21684: {{FLC{R6{{{FOLD TO UPPER CASE ! 21685: {{MOV{(SP){R9{{LOAD NAME ARGUMENT ! 21686: {{MOV{R10{(SP){{STACK TRBLK PTR OR ZERO ! 21687: {{MOV{#TRTAC{R8{{SET TRTYP FOR ACCESS TRACE ! 21688: {{BEQ{R6{#CH$LA{TRC10{JUMP IF A (ACCESS) ! 21689: {{MOV{#TRTVL{R8{{SET TRTYP FOR VALUE TRACE ! 21690: {{BEQ{R6{#CH$LV{TRC10{JUMP IF V (VALUE) ! 21691: {{BZE{R6{TRC10{{JUMP IF BLANK (VALUE) ! 21692: * ! 21693: * HERE FOR L,K,F,C,R ! 21694: * ! 21695: {{BEQ{R6{#CH$LF{TRC01{JUMP IF F (FUNCTION) ! 21696: {{BEQ{R6{#CH$LR{TRC01{JUMP IF R (RETURN) ! 21697: {{BEQ{R6{#CH$LL{TRC03{JUMP IF L (LABEL) ! 21698: {{BEQ{R6{#CH$LK{TRC06{JUMP IF K (KEYWORD) ! 21699: {{BNE{R6{#CH$LC{TRC15{ELSE ERROR IF NOT C (CALL) ! 21700: * ! 21701: * HERE FOR F,C,R ! 21702: * ! 21703: {TRC01{JSR{GTNVR{{{POINT TO VRBLK FOR NAME ! 21704: {{PPM{TRC16{{{JUMP IF BAD NAME ! 21705: {{ICA{SP{{{POP STACK ! 21706: {{MOV{4*VRFNC(R9){R9{{POINT TO FUNCTION BLOCK ! 21707: {{BNE{(R9){#B$PFC{TRC17{ERROR IF NOT PROGRAM FUNCTION ! 21708: {{BEQ{R6{#CH$LR{TRC02{JUMP IF R (RETURN) ! 21709: {{EJC{{{{ ! 21710: * ! 21711: * TRACE (CONTINUED) ! 21712: * ! 21713: * HERE FOR F,C TO SET/RESET CALL TRACE ! 21714: * ! 21715: {{MOV{R10{4*PFCTR(R9){{SET/RESET CALL TRACE ! 21716: {{BEQ{R6{#CH$LC{EXNUL{EXIT WITH NULL IF C (CALL) ! 21717: * ! 21718: * HERE FOR F,R TO SET/RESET RETURN TRACE ! 21719: * ! 21720: {TRC02{MOV{R10{4*PFRTR(R9){{SET/RESET RETURN TRACE ! 21721: {{EXI{{{{RETURN ! 21722: * ! 21723: * HERE FOR L TO SET/RESET LABEL TRACE ! 21724: * ! 21725: {TRC03{JSR{GTNVR{{{POINT TO VRBLK ! 21726: {{PPM{TRC16{{{JUMP IF BAD NAME ! 21727: {{MOV{4*VRLBL(R9){R10{{LOAD LABEL POINTER ! 21728: {{BNE{(R10){#B$TRT{TRC04{JUMP IF NO OLD TRACE ! 21729: {{MOV{4*TRLBL(R10){R10{{ELSE DELETE OLD TRACE ASSOCIATION ! 21730: * ! 21731: * HERE WITH OLD LABEL TRACE ASSOCIATION DELETED ! 21732: * ! 21733: {TRC04{BEQ{R10{#STNDL{TRC16{ERROR IF UNDEFINED LABEL ! 21734: {{MOV{(SP)+{R7{{GET TRBLK PTR AGAIN ! 21735: {{BZE{R7{TRC05{{JUMP IF STOPTR CASE ! 21736: {{MOV{R7{4*VRLBL(R9){{ELSE SET NEW TRBLK POINTER ! 21737: {{MOV{#B$VRT{4*VRTRA(R9){{SET LABEL TRACE ROUTINE ADDRESS ! 21738: {{MOV{R7{R9{{COPY TRBLK POINTER ! 21739: {{MOV{R10{4*TRLBL(R9){{STORE REAL LABEL IN TRBLK ! 21740: {{EXI{{{{RETURN ! 21741: * ! 21742: * HERE FOR STOPTR CASE FOR LABEL ! 21743: * ! 21744: {TRC05{MOV{R10{4*VRLBL(R9){{STORE LABEL PTR BACK IN VRBLK ! 21745: {{MOV{#B$VRG{4*VRTRA(R9){{STORE NORMAL TRANSFER ADDRESS ! 21746: {{EXI{{{{RETURN ! 21747: {{EJC{{{{ ! 21748: * ! 21749: * TRACE (CONTINUED) ! 21750: * ! 21751: * HERE FOR K (KEYWORD) ! 21752: * ! 21753: {TRC06{JSR{GTNVR{{{POINT TO VRBLK ! 21754: {{PPM{TRC16{{{ERROR IF NOT NATURAL VAR ! 21755: {{BNZ{4*VRLEN(R9){TRC16{{ERROR IF NOT SYSTEM VAR ! 21756: {{ICA{SP{{{POP STACK ! 21757: {{BZE{R10{TRC07{{JUMP IF STOPTR CASE ! 21758: {{MOV{R9{4*TRKVR(R10){{STORE VRBLK PTR IN TRBLK FOR KTREX ! 21759: * ! 21760: * MERGE HERE WITH TRBLK SET UP IN WB (OR ZERO) ! 21761: * ! 21762: {TRC07{MOV{4*VRSVP(R9){R9{{POINT TO SVBLK ! 21763: {{BEQ{R9{#V$ERT{TRC08{JUMP IF ERRTYPE ! 21764: {{BEQ{R9{#V$STC{TRC09{JUMP IF STCOUNT ! 21765: {{BNE{R9{#V$FNC{TRC17{ELSE ERROR IF NOT FNCLEVEL ! 21766: * ! 21767: * FNCLEVEL ! 21768: * ! 21769: {{MOV{R10{R$FNC{{SET/RESET FNCLEVEL TRACE ! 21770: {{EXI{{{{RETURN ! 21771: * ! 21772: * ERRTYPE ! 21773: * ! 21774: {TRC08{MOV{R10{R$ERT{{SET/RESET ERRTYPE TRACE ! 21775: {{EXI{{{{RETURN ! 21776: * ! 21777: * STCOUNT ! 21778: * ! 21779: {TRC09{MOV{R10{R$STC{{SET/RESET STCOUNT TRACE ! 21780: {{EXI{{{{RETURN ! 21781: {{EJC{{{{ ! 21782: * ! 21783: * TRACE (CONTINUED) ! 21784: * ! 21785: * A,V MERGE HERE WITH TRTYP VALUE IN WC ! 21786: * ! 21787: {TRC10{JSR{GTVAR{{{LOCATE VARIABLE ! 21788: {{PPM{TRC16{{{ERROR IF NOT APPROPRIATE NAME ! 21789: {{MOV{(SP)+{R7{{GET NEW TRBLK PTR AGAIN ! 21790: {{ADD{R10{R6{{POINT TO VARIABLE LOCATION ! 21791: {{MOV{R6{R9{{COPY VARIABLE POINTER ! 21792: * ! 21793: * LOOP TO SEARCH TRBLK CHAIN ! 21794: * ! 21795: {TRC11{MOV{(R9){R10{{POINT TO NEXT ENTRY ! 21796: {{BNE{(R10){#B$TRT{TRC13{JUMP IF NOT TRBLK ! 21797: {{BLT{R8{4*TRTYP(R10){TRC13{JUMP IF TOO FAR OUT ON CHAIN ! 21798: {{BEQ{R8{4*TRTYP(R10){TRC12{JUMP IF THIS MATCHES OUR TYPE ! 21799: {{ADD{#4*TRNXT{R10{{ELSE POINT TO LINK FIELD ! 21800: {{MOV{R10{R9{{COPY POINTER ! 21801: {{BRN{TRC11{{{AND LOOP BACK ! 21802: * ! 21803: * HERE TO DELETE AN OLD TRBLK OF THE TYPE WE WERE GIVEN ! 21804: * ! 21805: {TRC12{MOV{4*TRNXT(R10){R10{{GET PTR TO NEXT BLOCK OR VALUE ! 21806: {{MOV{R10{(R9){{STORE TO DELETE THIS TRBLK ! 21807: * ! 21808: * HERE AFTER DELETING ANY OLD ASSOCIATION OF THIS TYPE ! 21809: * ! 21810: {TRC13{BZE{R7{TRC14{{JUMP IF STOPTR CASE ! 21811: {{MOV{R7{(R9){{ELSE LINK NEW TRBLK IN ! 21812: {{MOV{R7{R9{{COPY TRBLK POINTER ! 21813: {{MOV{R10{4*TRNXT(R9){{STORE FORWARD POINTER ! 21814: {{MOV{R8{4*TRTYP(R9){{STORE APPROPRIATE TRAP TYPE CODE ! 21815: * ! 21816: * HERE TO MAKE SURE VRGET,VRSTO ARE SET PROPERLY ! 21817: * ! 21818: {TRC14{MOV{R6{R9{{RECALL POSSIBLE VRBLK POINTER ! 21819: {{SUB{#4*VRVAL{R9{{POINT BACK TO VRBLK ! 21820: {{JSR{SETVR{{{SET FIELDS IF VRBLK ! 21821: {{EXI{{{{RETURN ! 21822: * ! 21823: * HERE FOR BAD TRACE TYPE ! 21824: * ! 21825: {TRC15{EXI{2{{{TAKE BAD TRACE TYPE ERROR EXIT ! 21826: * ! 21827: * POP STACK BEFORE FAILING ! 21828: * ! 21829: {TRC16{ICA{SP{{{POP STACK ! 21830: * ! 21831: * HERE FOR BAD NAME ARGUMENT ! 21832: * ! 21833: {TRC17{EXI{1{{{TAKE BAD NAME ERROR EXIT ! 21834: {{ENP{{{{END PROCEDURE TRACE ! 21835: {{EJC{{{{ ! 21836: * ! 21837: * TRBLD -- BUILD TRBLK ! 21838: * ! 21839: * TRBLK IS USED BY THE INPUT, OUTPUT AND TRACE FUNCTIONS ! 21840: * TO CONSTRUCT A TRBLK (TRAP BLOCK) ! 21841: * ! 21842: * (XR) TRTAG OR TRTER ! 21843: * (XL) TRFNC OR TRFPT ! 21844: * (WB) TRTYP ! 21845: * JSR TRBLD CALL TO BUILD TRBLK ! 21846: * (XR) POINTER TO TRBLK ! 21847: * (WA) DESTROYED ! 21848: * ! 21849: {TRBLD{PRC{E{0{{ENTRY POINT ! 21850: {{MOV{R9{-(SP){{STACK TRTAG (OR TRFNM) ! 21851: {{MOV{#4*TRSI${R6{{SET SIZE OF TRBLK ! 21852: {{JSR{ALLOC{{{ALLOCATE TRBLK ! 21853: {{MOV{#B$TRT{(R9){{STORE FIRST WORD ! 21854: {{MOV{R10{4*TRFNC(R9){{STORE TRFNC (OR TRFPT) ! 21855: {{MOV{(SP)+{4*TRTAG(R9){{STORE TRTAG (OR TRFNM) ! 21856: {{MOV{R7{4*TRTYP(R9){{STORE TYPE ! 21857: {{MOV{#NULLS{4*TRVAL(R9){{FOR NOW, A NULL VALUE ! 21858: {{EXI{{{{RETURN TO CALLER ! 21859: {{ENP{{{{END PROCEDURE TRBLD ! 21860: {{EJC{{{{ ! 21861: * ! 21862: * TRIMR -- TRIM TRAILING BLANKS ! 21863: * ! 21864: * TRIMR IS PASSED A POINTER TO AN SCBLK WHICH MUST BE THE ! 21865: * LAST BLOCK IN DYNAMIC STORAGE. TRAILING BLANKS ARE ! 21866: * TRIMMED OFF AND THE DYNAMIC STORAGE POINTER RESET TO ! 21867: * THE END OF THE (POSSIBLY) SHORTENED BLOCK. ! 21868: * ! 21869: * (WB) NON-ZERO TO TRIM TRAILING BLANKS ! 21870: * (XR) POINTER TO STRING TO TRIM ! 21871: * JSR TRIMR CALL TO TRIM STRING ! 21872: * (XR) POINTER TO TRIMMED STRING ! 21873: * (XL,WA,WB,WC) DESTROYED ! 21874: * ! 21875: * THE CALL WITH WB ZERO STILL PERFORMS THE END ZERO PAD ! 21876: * AND DNAMP READJUSTMENT. IT IS USED FROM ACESS IF KVTRM=0. ! 21877: * ! 21878: {TRIMR{PRC{E{0{{ENTRY POINT ! 21879: {{MOV{R9{R10{{COPY STRING POINTER ! 21880: {{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH ! 21881: {{BZE{R6{TRIM2{{JUMP IF NULL INPUT ! 21882: {{PLC{R10{R6{{ELSE POINT PAST LAST CHARACTER ! 21883: {{BZE{R7{TRIM3{{JUMP IF NO TRIM ! 21884: {{MOV{#CH$BL{R8{{LOAD BLANK CHARACTER ! 21885: * ! 21886: * LOOP THROUGH CHARACTERS FROM RIGHT TO LEFT ! 21887: * ! 21888: {TRIM0{LCH{R7{-(R10){{LOAD NEXT CHARACTER ! 21889: {{BEQ{R7{#CH$HT{TRIM1{JUMP IF HORIZONTAL TAB ! 21890: {{BNE{R7{R8{TRIM3{JUMP IF NON-BLANK FOUND ! 21891: {TRIM1{DCV{R6{{{ELSE DECREMENT CHARACTER COUNT ! 21892: {{BNZ{R6{TRIM0{{LOOP BACK IF MORE TO CHECK ! 21893: * ! 21894: * HERE IF RESULT IS NULL (NULL OR ALL-BLANK INPUT) ! 21895: * ! 21896: {TRIM2{MOV{R9{DNAMP{{WIPE OUT INPUT STRING BLOCK ! 21897: {{MOV{#NULLS{R9{{LOAD NULL RESULT ! 21898: {{BRN{TRIM5{{{MERGE TO EXIT ! 21899: {{EJC{{{{ ! 21900: * ! 21901: * TRIMR (CONTINUED) ! 21902: * ! 21903: * HERE WITH NON-BLANK FOUND (MERGE FOR NO TRIM) ! 21904: * ! 21905: {TRIM3{MOV{R6{4*SCLEN(R9){{SET NEW LENGTH ! 21906: {{MOV{R9{R10{{COPY STRING POINTER ! 21907: {{PSC{R10{R6{{READY FOR STORING BLANKS ! 21908: {{CTB{R6{SCHAR{{GET LENGTH OF BLOCK IN BYTES ! 21909: {{ADD{R9{R6{{POINT PAST NEW BLOCK ! 21910: {{MOV{R6{DNAMP{{SET NEW TOP OF STORAGE POINTER ! 21911: {{LCT{R6{#CFP$C{{GET COUNT OF CHARS IN WORD ! 21912: {{ZER{R8{{{SET BLANK CHAR ! 21913: * ! 21914: * LOOP TO ZERO PAD LAST WORD OF CHARACTERS ! 21915: * ! 21916: {TRIM4{SCH{R8{(R10)+{{STORE ZERO CHARACTER ! 21917: {{BCT{R6{TRIM4{{LOOP BACK TILL ALL STORED ! 21918: {{CSC{R10{{{COMPLETE STORE CHARACTERS ! 21919: * ! 21920: * COMMON EXIT POINT ! 21921: * ! 21922: {TRIM5{ZER{R10{{{CLEAR GARBAGE XL POINTER ! 21923: {{EXI{{{{RETURN TO CALLER ! 21924: {{ENP{{{{END PROCEDURE TRIMR ! 21925: {{EJC{{{{ ! 21926: * ! 21927: * TRXEQ -- EXECUTE FUNCTION TYPE TRACE ! 21928: * ! 21929: * TRXEQ IS USED TO EXECUTE A TRACE WHEN A FOURTH ARGUMENT ! 21930: * HAS BEEN SUPPLIED. TRACE HAS ALREADY BEEN DECREMENTED. ! 21931: * ! 21932: * (XR) POINTER TO TRBLK ! 21933: * (XL,WA) NAME BASE,OFFSET FOR VARIABLE ! 21934: * JSR TRXEQ CALL TO EXECUTE TRACE ! 21935: * (WB,WC,RA) DESTROYED ! 21936: * ! 21937: * THE FOLLOWING STACK ENTRIES ARE MADE BEFORE PASSING ! 21938: * CONTROL TO THE TRACE FUNCTION USING THE CFUNC ROUTINE. ! 21939: * ! 21940: * TRXEQ RETURN POINT WORD(S) ! 21941: * SAVED VALUE OF TRACE KEYWORD ! 21942: * TRBLK POINTER ! 21943: * NAME BASE ! 21944: * NAME OFFSET ! 21945: * SAVED VALUE OF R$COD ! 21946: * SAVED CODE PTR (-R$COD) ! 21947: * SAVED VALUE OF FLPTR ! 21948: * FLPTR --------------- ZERO (DUMMY FAIL OFFSET) ! 21949: * NMBLK FOR VARIABLE NAME ! 21950: * XS ------------------ TRACE TAG ! 21951: * ! 21952: * R$COD AND THE CODE PTR ARE SET TO DUMMY VALUES WHICH ! 21953: * CAUSE CONTROL TO RETURN TO THE TRXEQ PROCEDURE ON SUCCESS ! 21954: * OR FAILURE (TRXEQ IGNORES A FAILURE CONDITION). ! 21955: * ! 21956: {TRXEQ{PRC{R{0{{ENTRY POINT (RECURSIVE) ! 21957: {{MOV{R$COD{R8{{LOAD CODE BLOCK POINTER ! 21958: {{SCP{R7{{{GET CURRENT CODE POINTER ! 21959: {{SUB{R8{R7{{MAKE CODE POINTER INTO OFFSET ! 21960: {{MOV{KVTRA{-(SP){{STACK TRACE KEYWORD VALUE ! 21961: {{MOV{R9{-(SP){{STACK TRBLK POINTER ! 21962: {{MOV{R10{-(SP){{STACK NAME BASE ! 21963: {{MOV{R6{-(SP){{STACK NAME OFFSET ! 21964: {{MOV{R8{-(SP){{STACK CODE BLOCK POINTER ! 21965: {{MOV{R7{-(SP){{STACK CODE POINTER OFFSET ! 21966: {{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER ! 21967: {{ZER{-(SP){{{SET DUMMY FAIL OFFSET ! 21968: {{MOV{SP{FLPTR{{SET NEW FAILURE POINTER ! 21969: {{ZER{KVTRA{{{RESET TRACE KEYWORD TO ZERO ! 21970: {{MOV{#TRXDC{R8{{LOAD NEW (DUMMY) CODE BLK POINTER ! 21971: {{MOV{R8{R$COD{{SET AS CODE BLOCK POINTER ! 21972: {{LCP{R8{{{AND NEW CODE POINTER ! 21973: {{EJC{{{{ ! 21974: * ! 21975: * TRXEQ (CONTINUED) ! 21976: * ! 21977: * NOW PREPARE ARGUMENTS FOR FUNCTION ! 21978: * ! 21979: {{MOV{R6{R7{{SAVE NAME OFFSET ! 21980: {{MOV{#4*NMSI${R6{{LOAD NMBLK SIZE ! 21981: {{JSR{ALLOC{{{ALLOCATE SPACE FOR NMBLK ! 21982: {{MOV{#B$NML{(R9){{SET TYPE WORD ! 21983: {{MOV{R10{4*NMBAS(R9){{STORE NAME BASE ! 21984: {{MOV{R7{4*NMOFS(R9){{STORE NAME OFFSET ! 21985: {{MOV{4*6(SP){R10{{RELOAD POINTER TO TRBLK ! 21986: {{MOV{R9{-(SP){{STACK NMBLK POINTER (1ST ARGUMENT) ! 21987: {{MOV{4*TRTAG(R10){-(SP){{STACK TRACE TAG (2ND ARGUMENT) ! 21988: {{MOV{4*TRFNC(R10){R10{{LOAD TRACE FUNCTION POINTER ! 21989: {{MOV{#NUM02{R6{{SET NUMBER OF ARGUMENTS TO TWO ! 21990: {{BRN{CFUNC{{{JUMP TO CALL FUNCTION ! 21991: * ! 21992: * SEE O$TXR FOR DETAILS OF RETURN TO THIS POINT ! 21993: * ! 21994: {TRXQ1{MOV{FLPTR{SP{{POINT BACK TO OUR STACK ENTRIES ! 21995: {{ICA{SP{{{POP OFF GARBAGE FAIL OFFSET ! 21996: {{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER ! 21997: {{MOV{(SP)+{R7{{RELOAD CODE OFFSET ! 21998: {{MOV{(SP)+{R8{{LOAD OLD CODE BASE POINTER ! 21999: {{MOV{R8{R9{{COPY CDBLK POINTER ! 22000: {{MOV{4*CDSTM(R9){KVSTN{{RESTORE STMNT NO ! 22001: {{MOV{(SP)+{R6{{RELOAD NAME OFFSET ! 22002: {{MOV{(SP)+{R10{{RELOAD NAME BASE ! 22003: {{MOV{(SP)+{R9{{RELOAD TRBLK POINTER ! 22004: {{MOV{(SP)+{KVTRA{{RESTORE TRACE KEYWORD VALUE ! 22005: {{ADD{R8{R7{{RECOMPUTE ABSOLUTE CODE POINTER ! 22006: {{LCP{R7{{{RESTORE CODE POINTER ! 22007: {{MOV{R8{R$COD{{AND CODE BLOCK POINTER ! 22008: {{EXI{{{{RETURN TO TRXEQ CALLER ! 22009: {{ENP{{{{END PROCEDURE TRXEQ ! 22010: {{EJC{{{{ ! 22011: * ! 22012: * XSCAN -- EXECUTION FUNCTION ARGUMENT SCAN ! 22013: * ! 22014: * XSCAN SCANS OUT ONE TOKEN IN A PROTOTYPE ARGUMENT IN ! 22015: * ARRAY,CLEAR,DATA,DEFINE,LOAD FUNCTION CALLS. XSCAN ! 22016: * CALLS MUST BE PRECEDED BY A CALL TO THE INITIALIZATION ! 22017: * PROCEDURE XSCNI. THE FOLLOWING VARIABLES ARE USED. ! 22018: * ! 22019: * R$XSC POINTER TO SCBLK FOR FUNCTION ARG ! 22020: * XSOFS OFFSET (NUM CHARS SCANNED SO FAR) ! 22021: * ! 22022: * (WC) DELIMITER ONE (CH$XX) ! 22023: * (XL) DELIMITER TWO (CH$XX) ! 22024: * JSR XSCAN CALL TO SCAN NEXT ITEM ! 22025: * (XR) POINTER TO SCBLK FOR TOKEN SCANNED ! 22026: * (WA) COMPLETION CODE (SEE BELOW) ! 22027: * (WC,XL) DESTROYED ! 22028: * ! 22029: * THE SCAN STARTS FROM THE CURRENT POSITION AND CONTINUES ! 22030: * UNTIL ONE OF THE FOLLOWING THREE CONDITIONS OCCURS. ! 22031: * ! 22032: * 1) DELIMITER ONE IS ENCOUNTERED (WA SET TO 1) ! 22033: * ! 22034: * 2) DELIMITER TWO ENCOUNTERED (WA SET TO 2) ! 22035: * ! 22036: * 3) END OF STRING ENCOUNTERED (WA SET TO 0) ! 22037: * ! 22038: * THE RESULT IS A STRING CONTAINING ALL CHARACTERS SCANNED ! 22039: * UP TO BUT NOT INCLUDING ANY DELIMITER CHARACTER. ! 22040: * THE POINTER IS LEFT POINTING PAST THE DELIMITER. ! 22041: * ! 22042: * IF ONLY ONE DELIMITER IS TO BE DETECTED, DELIMITER ONE ! 22043: * AND DELIMITER TWO SHOULD BE SET TO THE SAME VALUE. ! 22044: * ! 22045: * IN THE CASE WHERE THE END OF STRING IS ENCOUNTERED, THE ! 22046: * STRING INCLUDES ALL THE CHARACTERS TO THE END OF THE ! 22047: * STRING. NO FURTHER CALLS CAN BE MADE TO XSCAN UNTIL ! 22048: * XSCNI IS CALLED TO INITIALIZE A NEW ARGUMENT SCAN ! 22049: {{EJC{{{{ ! 22050: * ! 22051: * XSCAN (CONTINUED) ! 22052: * ! 22053: {XSCAN{PRC{E{0{{ENTRY POINT ! 22054: {{MOV{R7{XSCWB{{PRESERVE WB ! 22055: {{MOV{R$XSC{R9{{POINT TO ARGUMENT STRING ! 22056: {{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH ! 22057: {{MOV{XSOFS{R7{{LOAD CURRENT OFFSET ! 22058: {{SUB{R7{R6{{GET NUMBER OF REMAINING CHARACTERS ! 22059: {{BZE{R6{XSCN2{{JUMP IF NO CHARACTERS LEFT ! 22060: {{PLC{R9{R7{{POINT TO CURRENT CHARACTER ! 22061: * ! 22062: * LOOP TO SEARCH FOR DELIMITER ! 22063: * ! 22064: {XSCN1{LCH{R7{(R9)+{{LOAD NEXT CHARACTER ! 22065: {{BEQ{R7{R8{XSCN3{JUMP IF DELIMITER ONE FOUND ! 22066: {{BEQ{R7{R10{XSCN4{JUMP IF DELIMITER TWO FOUND ! 22067: {{DCV{R6{{{DECREMENT COUNT OF CHARS LEFT ! 22068: {{BNZ{R6{XSCN1{{LOOP BACK IF MORE CHARS TO GO ! 22069: * ! 22070: * HERE FOR RUNOUT ! 22071: * ! 22072: {XSCN2{MOV{R$XSC{R10{{POINT TO STRING BLOCK ! 22073: {{MOV{4*SCLEN(R10){R6{{GET STRING LENGTH ! 22074: {{MOV{XSOFS{R7{{LOAD OFFSET ! 22075: {{SUB{R7{R6{{GET SUBSTRING LENGTH ! 22076: {{ZER{R$XSC{{{CLEAR STRING PTR FOR COLLECTOR ! 22077: {{ZER{XSCRT{{{SET ZERO (RUNOUT) RETURN CODE ! 22078: {{BRN{XSCN6{{{JUMP TO EXIT ! 22079: {{EJC{{{{ ! 22080: * ! 22081: * XSCAN (CONTINUED) ! 22082: * ! 22083: * HERE IF DELIMITER ONE FOUND ! 22084: * ! 22085: {XSCN3{MOV{#NUM01{XSCRT{{SET RETURN CODE ! 22086: {{BRN{XSCN5{{{JUMP TO MERGE ! 22087: * ! 22088: * HERE IF DELIMITER TWO FOUND ! 22089: * ! 22090: {XSCN4{MOV{#NUM02{XSCRT{{SET RETURN CODE ! 22091: * ! 22092: * MERGE HERE AFTER DETECTING A DELIMITER ! 22093: * ! 22094: {XSCN5{MOV{R$XSC{R10{{RELOAD POINTER TO STRING ! 22095: {{MOV{4*SCLEN(R10){R8{{GET ORIGINAL LENGTH OF STRING ! 22096: {{SUB{R6{R8{{MINUS CHARS LEFT = CHARS SCANNED ! 22097: {{MOV{R8{R6{{MOVE TO REG FOR SBSTR ! 22098: {{MOV{XSOFS{R7{{SET OFFSET ! 22099: {{SUB{R7{R6{{COMPUTE LENGTH FOR SBSTR ! 22100: {{ICV{R8{{{ADJUST NEW CURSOR PAST DELIMITER ! 22101: {{MOV{R8{XSOFS{{STORE NEW OFFSET ! 22102: * ! 22103: * COMMON EXIT POINT ! 22104: * ! 22105: {XSCN6{ZER{R9{{{CLEAR GARBAGE CHARACTER PTR IN XR ! 22106: {{JSR{SBSTR{{{BUILD SUB-STRING ! 22107: {{MOV{XSCRT{R6{{LOAD RETURN CODE ! 22108: {{MOV{XSCWB{R7{{RESTORE WB ! 22109: {{EXI{{{{RETURN TO XSCAN CALLER ! 22110: {{ENP{{{{END PROCEDURE XSCAN ! 22111: {{EJC{{{{ ! 22112: * ! 22113: * XSCNI -- EXECUTION FUNCTION ARGUMENT SCAN ! 22114: * ! 22115: * XSCNI INITIALIZES THE SCAN USED FOR PROTOTYPE ARGUMENTS ! 22116: * IN THE CLEAR, DEFINE, LOAD, DATA, ARRAY FUNCTIONS. SEE ! 22117: * XSCAN FOR THE PROCEDURE WHICH IS USED AFTER THIS CALL. ! 22118: * ! 22119: * -(XS) ARGUMENT TO BE SCANNED (ON STACK) ! 22120: * JSR XSCNI CALL TO SCAN ARGUMENT ! 22121: * PPM LOC TRANSFER LOC IF ARG IS NOT STRING ! 22122: * PPM LOC TRANSFER LOC IF ARGUMENT IS NULL ! 22123: * (XS) POPPED ! 22124: * (XR,R$XSC) ARGUMENT (SCBLK PTR) ! 22125: * (WA) ARGUMENT LENGTH ! 22126: * (IA,RA) DESTROYED ! 22127: * ! 22128: {XSCNI{PRC{N{2{{ENTRY POINT ! 22129: {{JSR{GTSTG{{{FETCH ARGUMENT AS STRING ! 22130: {{PPM{XSCI1{{{JUMP IF NOT CONVERTIBLE ! 22131: {{MOV{R9{R$XSC{{ELSE STORE SCBLK PTR FOR XSCAN ! 22132: {{ZER{XSOFS{{{SET OFFSET TO ZERO ! 22133: {{BZE{R6{XSCI2{{JUMP IF NULL STRING ! 22134: {{EXI{{{{RETURN TO XSCNI CALLER ! 22135: * ! 22136: * HERE IF ARGUMENT IS NOT A STRING ! 22137: * ! 22138: {XSCI1{EXI{1{{{TAKE NOT-STRING ERROR EXIT ! 22139: * ! 22140: * HERE FOR NULL STRING ! 22141: * ! 22142: {XSCI2{EXI{2{{{TAKE NULL-STRING ERROR EXIT ! 22143: {{ENP{{{{END PROCEDURE XSCNI ! 22144: {{TTL{S{{{P I T B O L -- UTILITY ROUTINES ! 22145: * ! 22146: * THE FOLLOWING SECTION CONTAINS UTILITY ROUTINES USED FOR ! 22147: * VARIOUS PURPOSES THROUGHOUT THE SYSTEM. THESE DIFFER ! 22148: * FROM THE PROCEDURES IN THE UTILITY PROCEDURES SECTION IN ! 22149: * THEY ARE NOT IN PROCEDURE FORM AND THEY DO NOT RETURN ! 22150: * TO THEIR CALLERS. THEY ARE ACCESSED WITH A BRANCH TYPE ! 22151: * INSTRUCTION AFTER SETTING THE REGISTERS TO APPROPRIATE ! 22152: * PARAMETER VALUES. ! 22153: * ! 22154: * THE REGISTER VALUES REQUIRED FOR EACH ROUTINE ARE ! 22155: * DOCUMENTED AT THE START OF EACH ROUTINE. REGISTERS NOT ! 22156: * MENTIONED MAY CONTAIN ANY VALUES EXCEPT THAT XR,XL ! 22157: * CAN ONLY CONTAIN PROPER COLLECTABLE POINTERS. ! 22158: * ! 22159: * SOME OF THESE ROUTINES WILL TOLERATE GARBAGE POINTERS ! 22160: * IN XL,XR ON ENTRY. THIS IS ALWAYS DOCUMENTED AND IN ! 22161: * EACH CASE, THE ROUTINE CLEARS THESE GARBAGE VALUES BEFORE ! 22162: * EXITING AFTER COMPLETING ITS TASK. ! 22163: * ! 22164: * THE ROUTINES HAVE NAMES CONSISTING OF FIVE LETTERS ! 22165: * AND ARE ASSEMBLED IN ALPHABETICAL ORDER. ! 22166: {{EJC{{{{ ! 22167: * ARREF -- ARRAY REFERENCE ! 22168: * ! 22169: * (XL) MAY BE NON-COLLECTABLE ! 22170: * (XR) NUMBER OF SUBSCRIPTS ! 22171: * (WB) SET ZERO/NONZERO FOR VALUE/NAME ! 22172: * THE VALUE IN WB MUST BE COLLECTABLE ! 22173: * STACK SUBSCRIPTS AND ARRAY OPERAND ! 22174: * BRN ARREF JUMP TO CALL FUNCTION ! 22175: * ! 22176: * ARREF CONTINUES BY EXECUTING THE NEXT CODE WORD WITH ! 22177: * THE RESULT NAME OR VALUE PLACED ON TOP OF THE STACK. ! 22178: * TO DEAL WITH THE PROBLEM OF ACCESSING SUBSCRIPTS IN THE ! 22179: * ORDER OF STACKING, XL IS USED AS A SUBSCRIPT POINTER ! 22180: * WORKING BELOW THE STACK POINTER. ! 22181: * ! 22182: {ARREF{RTN{{{{ ! 22183: {{MOV{R9{R6{{COPY NUMBER OF SUBSCRIPTS ! 22184: {{MOV{SP{R10{{POINT TO STACK FRONT ! 22185: {{WTB{R9{{{CONVERT TO BYTE OFFSET ! 22186: {{ADD{R9{R10{{POINT TO ARRAY OPERAND ON STACK ! 22187: {{ICA{R10{{{FINAL VALUE FOR STACK POPPING ! 22188: {{MOV{R10{ARFXS{{KEEP FOR LATER ! 22189: {{MOV{-(R10){R9{{LOAD ARRAY OPERAND POINTER ! 22190: {{MOV{R9{R$ARF{{KEEP ARRAY POINTER ! 22191: {{MOV{R10{R9{{SAVE POINTER TO SUBSCRIPTS ! 22192: {{MOV{R$ARF{R10{{POINT XL TO POSSIBLE VCBLK OR TBBLK ! 22193: {{MOV{(R10){R8{{LOAD FIRST WORD ! 22194: {{BEQ{R8{#B$ART{ARF01{JUMP IF ARBLK ! 22195: {{BEQ{R8{#B$VCT{ARF07{JUMP IF VCBLK ! 22196: {{BEQ{R8{#B$TBT{ARF10{JUMP IF TBBLK ! 22197: {{ERB{235{SUBSCRIPTED{{OPERAND IS NOT TABLE OR ARRAY ! 22198: * ! 22199: * HERE FOR ARRAY (ARBLK) ! 22200: * ! 22201: {ARF01{BNE{R6{4*ARNDM(R10){ARF09{JUMP IF WRONG NUMBER OF DIMS ! 22202: {{LDI{INTV0{{{GET INITIAL SUBSCRIPT OF ZERO ! 22203: {{MOV{R9{R10{{POINT BEFORE SUBSCRIPTS ! 22204: {{ZER{R6{{{INITIAL OFFSET TO BOUNDS ! 22205: {{BRN{ARF03{{{JUMP INTO LOOP ! 22206: * ! 22207: * LOOP TO COMPUTE SUBSCRIPTS BY MULTIPLICATIONS ! 22208: * ! 22209: {ARF02{MLI{4*ARDM2(R9){{{MULTIPLY TOTAL BY NEXT DIMENSION ! 22210: * ! 22211: * MERGE HERE FIRST TIME ! 22212: * ! 22213: {ARF03{MOV{-(R10){R9{{LOAD NEXT SUBSCRIPT ! 22214: {{STI{ARFSI{{{SAVE CURRENT SUBSCRIPT ! 22215: {{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE IN CASE ! 22216: {{BEQ{(R9){#B$ICL{ARF04{JUMP IF IT WAS AN INTEGER ! 22217: {{EJC{{{{ ! 22218: * ! 22219: * ARREF (CONTINUED) ! 22220: * ! 22221: * ! 22222: {{JSR{GTINT{{{CONVERT TO INTEGER ! 22223: {{PPM{ARF12{{{JUMP IF NOT INTEGER ! 22224: {{LDI{4*ICVAL(R9){{{IF OK, LOAD INTEGER VALUE ! 22225: * ! 22226: * HERE WITH INTEGER SUBSCRIPT IN (IA) ! 22227: * ! 22228: {ARF04{MOV{R$ARF{R9{{POINT TO ARRAY ! 22229: {{ADD{R6{R9{{OFFSET TO NEXT BOUNDS ! 22230: {{SBI{4*ARLBD(R9){{{SUBTRACT LOW BOUND TO COMPARE ! 22231: {{IOV{ARF13{{{OUT OF RANGE FAIL IF OVERFLOW ! 22232: {{ILT{ARF13{{{OUT OF RANGE FAIL IF TOO SMALL ! 22233: {{SBI{4*ARDIM(R9){{{SUBTRACT DIMENSION ! 22234: {{IGE{ARF13{{{OUT OF RANGE FAIL IF TOO LARGE ! 22235: {{ADI{4*ARDIM(R9){{{ELSE RESTORE SUBSCRIPT OFFSET ! 22236: {{ADI{ARFSI{{{ADD TO CURRENT TOTAL ! 22237: {{ADD{#4*ARDMS{R6{{POINT TO NEXT BOUNDS ! 22238: {{BNE{R10{SP{ARF02{LOOP BACK IF MORE TO GO ! 22239: * ! 22240: * HERE WITH INTEGER SUBSCRIPT COMPUTED ! 22241: * ! 22242: {{MFI{R6{{{GET AS ONE WORD INTEGER ! 22243: {{WTB{R6{{{CONVERT TO OFFSET ! 22244: {{MOV{R$ARF{R10{{POINT TO ARBLK ! 22245: {{ADD{4*AROFS(R10){R6{{ADD OFFSET PAST BOUNDS ! 22246: {{ICA{R6{{{ADJUST FOR ARPRO FIELD ! 22247: {{BNZ{R7{ARF08{{EXIT WITH NAME IF NAME CALL ! 22248: * ! 22249: * MERGE HERE TO GET VALUE FOR VALUE CALL ! 22250: * ! 22251: {ARF05{JSR{ACESS{{{GET VALUE ! 22252: {{PPM{ARF13{{{FAIL IF ACESS FAILS ! 22253: * ! 22254: * RETURN VALUE ! 22255: * ! 22256: {ARF06{MOV{ARFXS{SP{{POP STACK ENTRIES ! 22257: {{ZER{R$ARF{{{FINISHED WITH ARRAY POINTER ! 22258: {{BRN{EXIXR{{{EXIT WITH VALUE IN XR ! 22259: {{EJC{{{{ ! 22260: * ! 22261: * ARREF (CONTINUED) ! 22262: * ! 22263: * HERE FOR VECTOR ! 22264: * ! 22265: {ARF07{BNE{R6{#NUM01{ARF09{ERROR IF MORE THAN 1 SUBSCRIPT ! 22266: {{MOV{(SP){R9{{ELSE LOAD SUBSCRIPT ! 22267: {{JSR{GTINT{{{CONVERT TO INTEGER ! 22268: {{PPM{ARF12{{{ERROR IF NOT INTEGER ! 22269: {{LDI{4*ICVAL(R9){{{ELSE LOAD INTEGER VALUE ! 22270: {{SBI{INTV1{{{SUBTRACT FOR ONES OFFSET ! 22271: {{MFI{R6{ARF13{{GET SUBSCRIPT AS ONE WORD ! 22272: {{ADD{#VCVLS{R6{{ADD OFFSET FOR STANDARD FIELDS ! 22273: {{WTB{R6{{{CONVERT OFFSET TO BYTES ! 22274: {{BGE{R6{4*VCLEN(R10){ARF13{FAIL IF OUT OF RANGE SUBSCRIPT ! 22275: {{BZE{R7{ARF05{{BACK TO GET VALUE IF VALUE CALL ! 22276: * ! 22277: * RETURN NAME ! 22278: * ! 22279: {ARF08{MOV{ARFXS{SP{{POP STACK ENTRIES ! 22280: {{ZER{R$ARF{{{FINISHED WITH ARRAY POINTER ! 22281: {{BRN{EXNAM{{{ELSE EXIT WITH NAME ! 22282: * ! 22283: * HERE IF SUBSCRIPT COUNT IS WRONG ! 22284: * ! 22285: {ARF09{ERB{236{ARRAY{{REFERENCED WITH WRONG NUMBER OF SUBSCRIPTS ! 22286: * ! 22287: * TABLE ! 22288: * ! 22289: {ARF10{BNE{R6{#NUM01{ARF11{ERROR IF MORE THAN 1 SUBSCRIPT ! 22290: {{MOV{(SP){R9{{ELSE LOAD SUBSCRIPT ! 22291: {{JSR{TFIND{{{CALL TABLE SEARCH ROUTINE ! 22292: {{PPM{ARF13{{{FAIL IF FAILED ! 22293: {{BNZ{R7{ARF08{{EXIT WITH NAME IF NAME CALL ! 22294: {{BRN{ARF06{{{ELSE EXIT WITH VALUE ! 22295: * ! 22296: * HERE FOR BAD TABLE REFERENCE ! 22297: * ! 22298: {ARF11{ERB{237{TABLE{{REFERENCED WITH MORE THAN ONE SUBSCRIPT ! 22299: * ! 22300: * HERE FOR BAD SUBSCRIPT ! 22301: * ! 22302: {ARF12{ERB{238{ARRAY{{SUBSCRIPT IS NOT INTEGER ! 22303: * ! 22304: * HERE TO SIGNAL FAILURE ! 22305: * ! 22306: {ARF13{ZER{R$ARF{{{FINISHED WITH ARRAY POINTER ! 22307: {{BRN{EXFAL{{{FAIL ! 22308: {{EJC{{{{ ! 22309: * ! 22310: * CFUNC -- CALL A FUNCTION ! 22311: * ! 22312: * CFUNC IS USED TO CALL A SNOBOL LEVEL FUNCTION. IT IS ! 22313: * USED BY THE APPLY FUNCTION (S$APP), THE FUNCTION ! 22314: * TRACE ROUTINE (TRXEQ) AND THE MAIN FUNCTION CALL ENTRY ! 22315: * (O$FNC, O$FNS). IN THE LATTER CASES, CFUNC IS USED ONLY ! 22316: * IF THE NUMBER OF ARGUMENTS IS INCORRECT. ! 22317: * ! 22318: * (XL) POINTER TO FUNCTION BLOCK ! 22319: * (WA) ACTUAL NUMBER OF ARGUMENTS ! 22320: * (XS) POINTS TO STACKED ARGUMENTS ! 22321: * BRN CFUNC JUMP TO CALL FUNCTION ! 22322: * ! 22323: * CFUNC CONTINUES BY EXECUTING THE FUNCTION ! 22324: * ! 22325: {CFUNC{RTN{{{{ ! 22326: {{BLT{R6{4*FARGS(R10){CFNC1{JUMP IF TOO FEW ARGUMENTS ! 22327: {{BEQ{R6{4*FARGS(R10){CFNC3{JUMP IF CORRECT NUMBER OF ARGS ! 22328: * ! 22329: * HERE IF TOO MANY ARGUMENTS SUPPLIED, POP THEM OFF ! 22330: * ! 22331: {{MOV{R6{R7{{COPY ACTUAL NUMBER ! 22332: {{SUB{4*FARGS(R10){R7{{GET NUMBER OF EXTRA ARGS ! 22333: {{WTB{R7{{{CONVERT TO BYTES ! 22334: {{ADD{R7{SP{{POP OFF UNWANTED ARGUMENTS ! 22335: {{BRN{CFNC3{{{JUMP TO GO OFF TO FUNCTION ! 22336: * ! 22337: * HERE IF TOO FEW ARGUMENTS ! 22338: * ! 22339: {CFNC1{MOV{4*FARGS(R10){R7{{LOAD REQUIRED NUMBER OF ARGUMENTS ! 22340: {{BEQ{R7{#NINI9{CFNC3{JUMP IF CASE OF VAR NUM OF ARGS ! 22341: {{SUB{R6{R7{{CALCULATE NUMBER MISSING ! 22342: {{LCT{R7{R7{{SET COUNTER TO CONTROL LOOP ! 22343: * ! 22344: * LOOP TO SUPPLY EXTRA NULL ARGUMENTS ! 22345: * ! 22346: {CFNC2{MOV{#NULLS{-(SP){{STACK A NULL ARGUMENT ! 22347: {{BCT{R7{CFNC2{{LOOP TILL PROPER NUMBER STACKED ! 22348: * ! 22349: * MERGE HERE TO JUMP TO FUNCTION ! 22350: * ! 22351: {CFNC3{BRI{(R10){{{JUMP THROUGH FCODE FIELD ! 22352: {{EJC{{{{ ! 22353: * ! 22354: * EXFAL -- EXIT SIGNALLING SNOBOL FAILURE ! 22355: * ! 22356: * (XL,XR) MAY BE NON-COLLECTABLE ! 22357: * BRN EXFAL JUMP TO FAIL ! 22358: * ! 22359: * EXFAL CONTINUES BY EXECUTING THE APPROPRIATE FAIL GOTO ! 22360: * ! 22361: {EXFAL{RTN{{{{ ! 22362: {{MOV{FLPTR{SP{{POP STACK ! 22363: {{MOV{(SP){R9{{LOAD FAILURE OFFSET ! 22364: {{ADD{R$COD{R9{{POINT TO FAILURE CODE LOCATION ! 22365: {{LCP{R9{{{SET CODE POINTER ! 22366: {{BRN{EXITS{{{DO NEXT CODE WORD ! 22367: {{EJC{{{{ ! 22368: * ! 22369: * EXINT -- EXIT WITH INTEGER RESULT ! 22370: * ! 22371: * (XL,XR) MAY BE NONCOLLECTABLE ! 22372: * (IA) INTEGER VALUE ! 22373: * BRN EXINT JUMP TO EXIT WITH INTEGER ! 22374: * ! 22375: * EXINT CONTINUES BY EXECUTING THE NEXT CODE WORD ! 22376: * WHICH IT DOES BY FALLING THROUGH TO EXIXR ! 22377: * ! 22378: {EXINT{RTN{{{{ ! 22379: {{JSR{ICBLD{{{BUILD ICBLK ! 22380: {{EJC{{{{ ! 22381: * EXIXR -- EXIT WITH RESULT IN (XR) ! 22382: * ! 22383: * (XR) RESULT ! 22384: * (XL) MAY BE NON-COLLECTABLE ! 22385: * BRN EXIXR JUMP TO EXIT WITH RESULT IN (XR) ! 22386: * ! 22387: * EXIXR CONTINUES BY EXECUTING THE NEXT CODE WORD ! 22388: * WHICH IT DOES BY FALLING THROUGH TO EXITS. ! 22389: {EXIXR{RTN{{{{ ! 22390: * ! 22391: {{MOV{R9{-(SP){{STACK RESULT ! 22392: * ! 22393: * ! 22394: * EXITS -- EXIT WITH RESULT IF ANY STACKED ! 22395: * ! 22396: * (XR,XL) MAY BE NON-COLLECTABLE ! 22397: * ! 22398: * BRN EXITS ENTER EXITS ROUTINE ! 22399: * ! 22400: {EXITS{RTN{{{{ ! 22401: {{LCW{R9{{{LOAD NEXT CODE WORD ! 22402: {{MOV{(R9){R10{{LOAD ENTRY ADDRESS ! 22403: {{BRI{R10{{{JUMP TO EXECUTE NEXT CODE WORD ! 22404: {{EJC{{{{ ! 22405: * ! 22406: * EXNAM -- EXIT WITH NAME IN (XL,WA) ! 22407: * ! 22408: * (XL) NAME BASE ! 22409: * (WA) NAME OFFSET ! 22410: * (XR) MAY BE NON-COLLECTABLE ! 22411: * BRN EXNAM JUMP TO EXIT WITH NAME IN (XL,WA) ! 22412: * ! 22413: * EXNAM CONTINUES BY EXECUTING THE NEXT CODE WORD ! 22414: * ! 22415: {EXNAM{RTN{{{{ ! 22416: {{MOV{R10{-(SP){{STACK NAME BASE ! 22417: {{MOV{R6{-(SP){{STACK NAME OFFSET ! 22418: {{BRN{EXITS{{{DO NEXT CODE WORD ! 22419: {{EJC{{{{ ! 22420: * ! 22421: * EXNUL -- EXIT WITH NULL RESULT ! 22422: * ! 22423: * (XL,XR) MAY BE NON-COLLECTABLE ! 22424: * BRN EXNUL JUMP TO EXIT WITH NULL VALUE ! 22425: * ! 22426: * EXNUL CONTINUES BY EXECUTING THE NEXT CODE WORD ! 22427: * ! 22428: {EXNUL{RTN{{{{ ! 22429: {{MOV{#NULLS{-(SP){{STACK NULL VALUE ! 22430: {{BRN{EXITS{{{DO NEXT CODE WORD ! 22431: {{EJC{{{{ ! 22432: * ! 22433: * EXREA -- EXIT WITH REAL RESULT ! 22434: * ! 22435: * (XL,XR) MAY BE NON-COLLECTABLE ! 22436: * (RA) REAL VALUE ! 22437: * BRN EXREA JUMP TO EXIT WITH REAL VALUE ! 22438: * ! 22439: * EXREA CONTINUES BY EXECUTING THE NEXT CODE WORD ! 22440: * ! 22441: {EXREA{RTN{{{{ ! 22442: {{JSR{RCBLD{{{BUILD RCBLK ! 22443: {{BRN{EXIXR{{{JUMP TO EXIT WITH RESULT IN XR ! 22444: {{EJC{{{{ ! 22445: * ! 22446: * EXSID -- EXIT SETTING ID FIELD ! 22447: * ! 22448: * EXSID IS USED TO EXIT AFTER BUILDING ANY OF THE FOLLOWING ! 22449: * BLOCKS (ARBLK, TBBLK, PDBLK, VCBLK). IT SETS THE IDVAL. ! 22450: * ! 22451: * (XR) PTR TO BLOCK WITH IDVAL FIELD ! 22452: * (XL) MAY BE NON-COLLECTABLE ! 22453: * BRN EXSID JUMP TO EXIT AFTER SETTING ID FIELD ! 22454: * ! 22455: * EXSID CONTINUES BY EXECUTING THE NEXT CODE WORD ! 22456: * ! 22457: {EXSID{RTN{{{{ ! 22458: {{MOV{CURID{R6{{LOAD CURRENT ID VALUE ! 22459: {{BNE{R6{#CFP$M{EXSI1{JUMP IF NO OVERFLOW ! 22460: {{ZER{R6{{{ELSE RESET FOR WRAPAROUND ! 22461: * ! 22462: * HERE WITH OLD IDVAL IN WA ! 22463: * ! 22464: {EXSI1{ICV{R6{{{BUMP ID VALUE ! 22465: {{MOV{R6{CURID{{STORE FOR NEXT TIME ! 22466: {{MOV{R6{4*IDVAL(R9){{STORE ID VALUE ! 22467: {{BRN{EXIXR{{{EXIT WITH RESULT IN (XR) ! 22468: {{EJC{{{{ ! 22469: * ! 22470: * EXVNM -- EXIT WITH NAME OF VARIABLE ! 22471: * ! 22472: * EXVNM EXITS AFTER STACKING A VALUE WHICH IS A NMBLK ! 22473: * REFERENCING THE NAME OF A GIVEN NATURAL VARIABLE. ! 22474: * ! 22475: * (XR) VRBLK POINTER ! 22476: * (XL) MAY BE NON-COLLECTABLE ! 22477: * BRN EXVNM EXIT WITH VRBLK POINTER IN XR ! 22478: * ! 22479: {EXVNM{RTN{{{{ ! 22480: {{MOV{R9{R10{{COPY NAME BASE POINTER ! 22481: {{MOV{#4*NMSI${R6{{SET SIZE OF NMBLK ! 22482: {{JSR{ALLOC{{{ALLOCATE NMBLK ! 22483: {{MOV{#B$NML{(R9){{STORE TYPE WORD ! 22484: {{MOV{R10{4*NMBAS(R9){{STORE NAME BASE ! 22485: {{MOV{#4*VRVAL{4*NMOFS(R9){{STORE NAME OFFSET ! 22486: {{BRN{EXIXR{{{EXIT WITH RESULT IN XR ! 22487: {{EJC{{{{ ! 22488: * ! 22489: * FLPOP -- FAIL AND POP IN PATTERN MATCHING ! 22490: * ! 22491: * FLPOP POPS THE NODE AND CURSOR ON THE STACK AND THEN ! 22492: * DROPS THROUGH INTO FAILP TO CAUSE PATTERN FAILURE ! 22493: * ! 22494: * (XL,XR) MAY BE NON-COLLECTABLE ! 22495: * BRN FLPOP JUMP TO FAIL AND POP STACK ! 22496: * ! 22497: {FLPOP{RTN{{{{ ! 22498: {{ADD{#4*NUM02{SP{{POP TWO ENTRIES OFF STACK ! 22499: {{EJC{{{{ ! 22500: * ! 22501: * FAILP -- FAILURE IN MATCHING PATTERN NODE ! 22502: * ! 22503: * FAILP IS USED AFTER FAILING TO MATCH A PATTERN NODE. ! 22504: * SEE PATTERN MATCH ROUTINES FOR DETAILS OF USE. ! 22505: * ! 22506: * (XL,XR) MAY BE NON-COLLECTABLE ! 22507: * BRN FAILP SIGNAL FAILURE TO MATCH ! 22508: * ! 22509: * FAILP CONTINUES BY MATCHING AN ALTERNATIVE FROM THE STACK ! 22510: * ! 22511: {FAILP{RTN{{{{ ! 22512: {{MOV{(SP)+{R9{{LOAD ALTERNATIVE NODE POINTER ! 22513: {{MOV{(SP)+{R7{{RESTORE OLD CURSOR ! 22514: {{MOV{(R9){R10{{LOAD PCODE ENTRY POINTER ! 22515: {{BRI{R10{{{JUMP TO EXECUTE CODE FOR NODE ! 22516: {{EJC{{{{ ! 22517: * ! 22518: * INDIR -- COMPUTE INDIRECT REFERENCE ! 22519: * ! 22520: * (WB) NONZERO/ZERO FOR BY NAME/VALUE ! 22521: * BRN INDIR JUMP TO GET INDIRECT REF ON STACK ! 22522: * ! 22523: * INDIR CONTINUES BY EXECUTING THE NEXT CODE WORD ! 22524: * ! 22525: {INDIR{RTN{{{{ ! 22526: {{MOV{(SP)+{R9{{LOAD ARGUMENT ! 22527: {{BEQ{(R9){#B$NML{INDR2{JUMP IF A NAME ! 22528: {{JSR{GTNVR{{{ELSE CONVERT TO VARIABLE ! 22529: {{ERR{239{INDIRECTION{{OPERAND IS NOT NAME ! 22530: {{BZE{R7{INDR1{{SKIP IF BY VALUE ! 22531: {{MOV{R9{-(SP){{ELSE STACK VRBLK PTR ! 22532: {{MOV{#4*VRVAL{-(SP){{STACK NAME OFFSET ! 22533: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK ! 22534: * ! 22535: * HERE TO GET VALUE OF NATURAL VARIABLE ! 22536: * ! 22537: {INDR1{BRI{(R9){{{JUMP THROUGH VRGET FIELD OF VRBLK ! 22538: * ! 22539: * HERE IF OPERAND IS A NAME ! 22540: * ! 22541: {INDR2{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE ! 22542: {{MOV{4*NMOFS(R9){R6{{LOAD NAME OFFSET ! 22543: {{BNZ{R7{EXNAM{{EXIT IF CALLED BY NAME ! 22544: {{JSR{ACESS{{{ELSE GET VALUE FIRST ! 22545: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS ! 22546: {{BRN{EXIXR{{{ELSE RETURN WITH VALUE IN XR ! 22547: {{EJC{{{{ ! 22548: * ! 22549: * MATCH -- INITIATE PATTERN MATCH ! 22550: * ! 22551: * (WB) MATCH TYPE CODE ! 22552: * BRN MATCH JUMP TO INITIATE PATTERN MATCH ! 22553: * ! 22554: * MATCH CONTINUES BY EXECUTING THE PATTERN MATCH. SEE ! 22555: * PATTERN MATCH ROUTINES (P$XXX) FOR FULL DETAILS. ! 22556: * ! 22557: {MATCH{RTN{{{{ ! 22558: {{MOV{(SP)+{R9{{LOAD PATTERN OPERAND ! 22559: {{JSR{GTPAT{{{CONVERT TO PATTERN ! 22560: {{ERR{240{PATTERN{{MATCH RIGHT OPERAND IS NOT PATTERN ! 22561: {{MOV{R9{R10{{IF OK, SAVE PATTERN POINTER ! 22562: {{BNZ{R7{MTCH1{{JUMP IF NOT MATCH BY NAME ! 22563: {{MOV{(SP){R6{{ELSE LOAD NAME OFFSET ! 22564: {{MOV{R10{-(SP){{SAVE PATTERN POINTER ! 22565: {{MOV{4*2(SP){R10{{LOAD NAME BASE ! 22566: {{JSR{ACESS{{{ACCESS SUBJECT VALUE ! 22567: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS ! 22568: {{MOV{(SP){R10{{RESTORE PATTERN POINTER ! 22569: {{MOV{R9{(SP){{STACK SUBJECT STRING VAL FOR MERGE ! 22570: {{ZER{R7{{{RESTORE TYPE CODE ! 22571: * ! 22572: * MERGE HERE WITH SUBJECT VALUE ON STACK ! 22573: * ! 22574: {MTCH1{MOV{(SP){R9{{LOAD SUBJECT VALUE ! 22575: {{ZER{R$PMB{{{ASSUME NOT A BUFFER ! 22576: {{BNE{(R9){#B$BCT{MTCHA{BRANCH IF NOT ! 22577: {{ICA{SP{{{ELSE POP VALUE ! 22578: {{MOV{R9{R$PMB{{SAVE POINTER ! 22579: {{MOV{4*BCLEN(R9){R6{{GET DEFINED LENGTH ! 22580: {{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK ! 22581: {{BRN{MTCHB{{{ ! 22582: * ! 22583: * HERE IF NOT BUFFER TO CONVERT TO STRING ! 22584: * ! 22585: {MTCHA{JSR{GTSTG{{{NOT BUFFER - CONVERT TO STRING ! 22586: {{ERR{241{PATTERN{{MATCH LEFT OPERAND IS NOT STRING ! 22587: * ! 22588: * MERGE WITH BUFFER OR STRING ! 22589: * ! 22590: {MTCHB{MOV{R9{R$PMS{{IF OK, STORE SUBJECT STRING POINTER ! 22591: {{MOV{R6{PMSSL{{AND LENGTH ! 22592: {{MOV{R7{-(SP){{STACK MATCH TYPE CODE ! 22593: {{ZER{-(SP){{{STACK INITIAL CURSOR (ZERO) ! 22594: {{ZER{R7{{{SET INITIAL CURSOR ! 22595: {{MOV{SP{PMHBS{{SET HISTORY STACK BASE PTR ! 22596: {{ZER{PMDFL{{{RESET PATTERN ASSIGNMENT FLAG ! 22597: {{MOV{R10{R9{{SET INITIAL NODE POINTER ! 22598: {{BNZ{KVANC{MTCH2{{JUMP IF ANCHORED ! 22599: * ! 22600: * HERE FOR UNANCHORED ! 22601: * ! 22602: {{MOV{R9{-(SP){{STACK INITIAL NODE POINTER ! 22603: {{MOV{#NDUNA{-(SP){{STACK POINTER TO ANCHOR MOVE NODE ! 22604: {{BRI{(R9){{{START MATCH OF FIRST NODE ! 22605: * ! 22606: * HERE IN ANCHORED MODE ! 22607: * ! 22608: {MTCH2{ZER{-(SP){{{DUMMY CURSOR VALUE ! 22609: {{MOV{#NDABO{-(SP){{STACK POINTER TO ABORT NODE ! 22610: {{BRI{(R9){{{START MATCH OF FIRST NODE ! 22611: {{EJC{{{{ ! 22612: * ! 22613: * RETRN -- RETURN FROM FUNCTION ! 22614: * ! 22615: * (WA) STRING POINTER FOR RETURN TYPE ! 22616: * BRN RETRN JUMP TO RETURN FROM (SNOBOL) FUNC ! 22617: * ! 22618: * RETRN CONTINUES BY EXECUTING THE CODE AT THE RETURN POINT ! 22619: * THE STACK IS CLEANED OF ANY GARBAGE LEFT BY OTHER ! 22620: * ROUTINES WHICH MAY HAVE ALTERED FLPTR SINCE FUNCTION ! 22621: * ENTRY BY USING FLPRT, RESERVED FOR USE ONLY BY ! 22622: * FUNCTION CALL AND RETURN. ! 22623: * ! 22624: {RETRN{RTN{{{{ ! 22625: {{BNZ{KVFNC{RTN01{{JUMP IF NOT LEVEL ZERO ! 22626: {{ERB{242{FUNCTION{{RETURN FROM LEVEL ZERO ! 22627: * ! 22628: * HERE IF NOT LEVEL ZERO RETURN ! 22629: * ! 22630: {RTN01{MOV{FLPRT{SP{{POP STACK ! 22631: {{ICA{SP{{{REMOVE FAILURE OFFSET ! 22632: {{MOV{(SP)+{R9{{POP PFBLK POINTER ! 22633: {{MOV{(SP)+{FLPTR{{POP FAILURE POINTER ! 22634: {{MOV{(SP)+{FLPRT{{POP OLD FLPRT ! 22635: {{MOV{(SP)+{R7{{POP CODE POINTER OFFSET ! 22636: {{MOV{(SP)+{R8{{POP OLD CODE BLOCK POINTER ! 22637: {{ADD{R8{R7{{MAKE OLD CODE POINTER ABSOLUTE ! 22638: {{LCP{R7{{{RESTORE OLD CODE POINTER ! 22639: {{MOV{R8{R$COD{{RESTORE OLD CODE BLOCK POINTER ! 22640: {{DCV{KVFNC{{{DECREMENT FUNCTION LEVEL ! 22641: {{MOV{KVTRA{R7{{LOAD TRACE ! 22642: {{ADD{KVFTR{R7{{ADD FTRACE ! 22643: {{BZE{R7{RTN06{{JUMP IF NO TRACING POSSIBLE ! 22644: * ! 22645: * HERE IF THERE MAY BE A TRACE ! 22646: * ! 22647: {{MOV{R6{-(SP){{SAVE FUNCTION RETURN TYPE ! 22648: {{MOV{R9{-(SP){{SAVE PFBLK POINTER ! 22649: {{MOV{R6{KVRTN{{SET RTNTYPE FOR TRACE FUNCTION ! 22650: {{MOV{R$FNC{R10{{LOAD FNCLEVEL TRBLK PTR (IF ANY) ! 22651: {{JSR{KTREX{{{EXECUTE POSSIBLE FNCLEVEL TRACE ! 22652: {{MOV{4*PFVBL(R9){R10{{LOAD VRBLK PTR (SGD13) ! 22653: {{BZE{KVTRA{RTN02{{JUMP IF TRACE IS OFF ! 22654: {{MOV{4*PFRTR(R9){R9{{ELSE LOAD RETURN TRACE TRBLK PTR ! 22655: {{BZE{R9{RTN02{{JUMP IF NOT RETURN TRACED ! 22656: {{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT ! 22657: {{BZE{4*TRFNC(R9){RTN03{{JUMP IF PRINT TRACE ! 22658: {{MOV{#4*VRVAL{R6{{ELSE SET NAME OFFSET ! 22659: {{MOV{4*1(SP){KVRTN{{MAKE SURE RTNTYPE IS SET RIGHT ! 22660: {{JSR{TRXEQ{{{EXECUTE FULL TRACE ! 22661: {{EJC{{{{ ! 22662: * ! 22663: * RETRN (CONTINUED) ! 22664: * ! 22665: * HERE TO TEST FOR FTRACE ! 22666: * ! 22667: {RTN02{BZE{KVFTR{RTN05{{JUMP IF FTRACE IS OFF ! 22668: {{DCV{KVFTR{{{ELSE DECREMENT FTRACE ! 22669: * ! 22670: * HERE FOR PRINT TRACE OF FUNCTION RETURN ! 22671: * ! 22672: {RTN03{JSR{PRTSN{{{PRINT STATEMENT NUMBER ! 22673: {{MOV{4*1(SP){R9{{LOAD RETURN TYPE ! 22674: {{JSR{PRTST{{{PRINT IT ! 22675: {{MOV{#CH$BL{R6{{LOAD BLANK ! 22676: {{JSR{PRTCH{{{PRINT IT ! 22677: {{MOV{(SP){R10{{LOAD PFBLK PTR ! 22678: {{MOV{4*PFVBL(R10){R10{{LOAD FUNCTION VRBLK PTR ! 22679: {{MOV{#4*VRVAL{R6{{SET VRBLK NAME OFFSET ! 22680: {{BNE{R9{#SCFRT{RTN04{JUMP IF NOT FRETURN CASE ! 22681: * ! 22682: * FOR FRETURN, JUST PRINT FUNCTION NAME ! 22683: * ! 22684: {{JSR{PRTNM{{{PRINT NAME ! 22685: {{JSR{PRTNL{{{TERMINATE PRINT LINE ! 22686: {{BRN{RTN05{{{MERGE ! 22687: * ! 22688: * HERE FOR RETURN OR NRETURN, PRINT FUNCTION NAME = VALUE ! 22689: * ! 22690: {RTN04{JSR{PRTNV{{{PRINT NAME = VALUE ! 22691: * ! 22692: * HERE AFTER COMPLETING TRACE ! 22693: * ! 22694: {RTN05{MOV{(SP)+{R9{{POP PFBLK POINTER ! 22695: {{MOV{(SP)+{R6{{POP RETURN TYPE STRING ! 22696: * ! 22697: * MERGE HERE IF NO TRACE REQUIRED ! 22698: * ! 22699: {RTN06{MOV{R6{KVRTN{{SET RTNTYPE KEYWORD ! 22700: {{MOV{4*PFVBL(R9){R10{{LOAD POINTER TO FN VRBLK ! 22701: {{EJC{{{{ ! 22702: * RETRN (CONTINUED) ! 22703: * ! 22704: * GET VALUE OF FUNCTION ! 22705: * ! 22706: {RTN07{MOV{R10{RTNBP{{SAVE BLOCK POINTER ! 22707: {{MOV{4*VRVAL(R10){R10{{LOAD VALUE ! 22708: {{BEQ{(R10){#B$TRT{RTN07{LOOP BACK IF TRAPPED ! 22709: {{MOV{R10{RTNFV{{ELSE SAVE FUNCTION RESULT VALUE ! 22710: {{MOV{(SP)+{RTNSV{{SAVE ORIGINAL FUNCTION VALUE ! 22711: {{MOV{(SP)+{R10{{POP SAVED POINTER ! 22712: {{BZE{R10{RTN7C{{NO ACTION IF NONE ! 22713: {{BZE{KVPFL{RTN7C{{JUMP IF NO PROFILING ! 22714: {{JSR{PRFLU{{{ELSE PROFILE LAST FUNC STMT ! 22715: {{BEQ{KVPFL{#NUM02{RTN7A{BRANCH ON VALUE OF PROFILE KEYWD ! 22716: * ! 22717: * HERE IF &PROFILE = 1. START TIME MUST BE FRIGGED TO ! 22718: * APPEAR EARLIER THAN IT ACTUALLY IS, BY AMOUNT USED BEFORE ! 22719: * THE CALL. ! 22720: * ! 22721: {{LDI{PFSTM{{{LOAD CURRENT TIME ! 22722: {{SBI{4*ICVAL(R10){{{FRIG BY SUBTRACTING SAVED AMOUNT ! 22723: {{BRN{RTN7B{{{AND MERGE ! 22724: * ! 22725: * HERE IF &PROFILE = 2 ! 22726: * ! 22727: {RTN7A{LDI{4*ICVAL(R10){{{LOAD SAVED TIME ! 22728: * ! 22729: * BOTH PROFILE TYPES MERGE HERE ! 22730: * ! 22731: {RTN7B{STI{PFSTM{{{STORE BACK CORRECT START TIME ! 22732: * ! 22733: * MERGE HERE IF NO PROFILING ! 22734: * ! 22735: {RTN7C{MOV{4*FARGS(R9){R7{{GET NUMBER OF ARGS ! 22736: {{ADD{4*PFNLO(R9){R7{{ADD NUMBER OF LOCALS ! 22737: {{BZE{R7{RTN10{{JUMP IF NO ARGS/LOCALS ! 22738: {{LCT{R7{R7{{ELSE SET LOOP COUNTER ! 22739: {{ADD{4*PFLEN(R9){R9{{AND POINT TO END OF PFBLK ! 22740: * ! 22741: * LOOP TO RESTORE FUNCTIONS AND LOCALS ! 22742: * ! 22743: {RTN08{MOV{-(R9){R10{{LOAD NEXT VRBLK POINTER ! 22744: * ! 22745: * LOOP TO FIND VALUE BLOCK ! 22746: * ! 22747: {RTN09{MOV{R10{R6{{SAVE BLOCK POINTER ! 22748: {{MOV{4*VRVAL(R10){R10{{LOAD POINTER TO NEXT VALUE ! 22749: {{BEQ{(R10){#B$TRT{RTN09{LOOP BACK IF TRAPPED ! 22750: {{MOV{R6{R10{{ELSE RESTORE LAST BLOCK POINTER ! 22751: {{MOV{(SP)+{4*VRVAL(R10){{RESTORE OLD VARIABLE VALUE ! 22752: {{BCT{R7{RTN08{{LOOP TILL ALL PROCESSED ! 22753: * ! 22754: * NOW RESTORE FUNCTION VALUE AND EXIT ! 22755: * ! 22756: {RTN10{MOV{RTNBP{R10{{RESTORE PTR TO LAST FUNCTION BLOCK ! 22757: {{MOV{RTNSV{4*VRVAL(R10){{RESTORE OLD FUNCTION VALUE ! 22758: {{MOV{RTNFV{R9{{RELOAD FUNCTION RESULT ! 22759: {{MOV{R$COD{R10{{POINT TO NEW CODE BLOCK ! 22760: {{MOV{KVSTN{KVLST{{SET LASTNO FROM STNO ! 22761: {{MOV{4*CDSTM(R10){KVSTN{{RESET PROPER STNO VALUE ! 22762: {{MOV{KVRTN{R6{{LOAD RETURN TYPE ! 22763: {{BEQ{R6{#SCRTN{EXIXR{EXIT WITH RESULT IN XR IF RETURN ! 22764: {{BEQ{R6{#SCFRT{EXFAL{FAIL IF FRETURN ! 22765: {{EJC{{{{ ! 22766: * ! 22767: * RETRN (CONTINUED) ! 22768: * ! 22769: * HERE FOR NRETURN ! 22770: * ! 22771: {{BEQ{(R9){#B$NML{RTN11{JUMP IF IS A NAME ! 22772: {{JSR{GTNVR{{{ELSE TRY CONVERT TO VARIABLE NAME ! 22773: {{ERR{243{FUNCTION{{RESULT IN NRETURN IS NOT NAME ! 22774: {{MOV{R9{R10{{IF OK, COPY VRBLK (NAME BASE) PTR ! 22775: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET ! 22776: {{BRN{RTN12{{{AND MERGE ! 22777: * ! 22778: * HERE IF RETURNED RESULT IS A NAME ! 22779: * ! 22780: {RTN11{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE ! 22781: {{MOV{4*NMOFS(R9){R6{{LOAD NAME OFFSET ! 22782: * ! 22783: * MERGE HERE WITH RETURNED NAME IN (XL,WA) ! 22784: * ! 22785: {RTN12{MOV{R10{R9{{PRESERVE XL ! 22786: {{LCW{R7{{{LOAD NEXT WORD ! 22787: {{MOV{R9{R10{{RESTORE XL ! 22788: {{BEQ{R7{#OFNE${EXNAM{EXIT IF CALLED BY NAME ! 22789: {{MOV{R7{-(SP){{ELSE SAVE CODE WORD ! 22790: {{JSR{ACESS{{{GET VALUE ! 22791: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS ! 22792: {{MOV{R9{R10{{IF OK, COPY RESULT ! 22793: {{MOV{(SP){R9{{RELOAD NEXT CODE WORD ! 22794: {{MOV{R10{(SP){{STORE RESULT ON STACK ! 22795: {{MOV{(R9){R10{{LOAD ROUTINE ADDRESS ! 22796: {{BRI{R10{{{JUMP TO EXECUTE NEXT CODE WORD ! 22797: {{EJC{{{{ ! 22798: * ! 22799: * STCOV -- SIGNAL STATEMENT COUNTER OVERFLOW ! 22800: * ! 22801: * BRN STCOV JUMP TO SIGNAL STATEMENT COUNT OFLO ! 22802: * ! 22803: * PERMIT UP TO 10 MORE STATEMENTS TO BE OBEYED SO THAT ! 22804: * SETEXIT TRAP CAN REGAIN CONTROL. ! 22805: * STCOV CONTINUES BY ISSUING THE ERROR MESSAGE ! 22806: * ! 22807: {STCOV{RTN{{{{ ! 22808: {{ICV{ERRFT{{{FATAL ERROR ! 22809: {{LDI{INTVT{{{GET 10 ! 22810: {{ADI{KVSTL{{{ADD TO FORMER LIMIT ! 22811: {{STI{KVSTL{{{STORE AS NEW STLIMIT ! 22812: {{LDI{INTVT{{{GET 10 ! 22813: {{STI{KVSTC{{{SET AS NEW COUNT ! 22814: {{ERB{244{STATEMENT{{COUNT EXCEEDS VALUE OF STLIMIT KEYWORD ! 22815: {{EJC{{{{ ! 22816: * ! 22817: * STMGO -- START EXECUTION OF NEW STATEMENT ! 22818: * ! 22819: * (XR) POINTER TO CDBLK FOR NEW STATEMENT ! 22820: * BRN STMGO JUMP TO EXECUTE NEW STATEMENT ! 22821: * ! 22822: * STMGO CONTINUES BY EXECUTING THE NEXT STATEMENT ! 22823: * ! 22824: {STMGO{RTN{{{{ ! 22825: {{MOV{R9{R$COD{{SET NEW CODE BLOCK POINTER ! 22826: {{BZE{KVPFL{STGO1{{SKIP IF NO PROFILING ! 22827: {{JSR{PRFLU{{{ELSE PROFILE THE STATEMENT ! 22828: {STGO1{MOV{KVSTN{KVLST{{SET LASTNO ! 22829: {{MOV{4*CDSTM(R9){KVSTN{{SET STNO ! 22830: {{ADD{#4*CDCOD{R9{{POINT TO FIRST CODE WORD ! 22831: {{LCP{R9{{{SET CODE POINTER ! 22832: {{LDI{KVSTC{{{GET STMT COUNT ! 22833: {{ILT{EXITS{{{OMIT COUNTING IF NEGATIVE ! 22834: {{IEQ{STCOV{{{FAIL IF STLIMIT REACHED ! 22835: {{SBI{INTV1{{{DECREMENT ! 22836: {{STI{KVSTC{{{REPLACE IT ! 22837: {{BZE{R$STC{EXITS{{EXIT IF NO STCOUNT TRACE ! 22838: * ! 22839: * HERE FOR STCOUNT TRACE ! 22840: * ! 22841: {{ZER{R9{{{CLEAR GARBAGE VALUE IN XR ! 22842: {{MOV{R$STC{R10{{LOAD POINTER TO STCOUNT TRBLK ! 22843: {{JSR{KTREX{{{EXECUTE KEYWORD TRACE ! 22844: {{BRN{EXITS{{{AND THEN EXIT FOR NEXT CODE WORD ! 22845: {{EJC{{{{ ! 22846: * ! 22847: * STOPR -- TERMINATE RUN ! 22848: * ! 22849: * (XR) POINTS TO ENDING MESSAGE ! 22850: * BRN STOPR JUMP TO TERMINATE RUN ! 22851: * ! 22852: * TERMINATE RUN AND PRINT STATISTICS. ON ENTRY XR POINTS ! 22853: * TO ENDING MESSAGE OR IS ZERO IF MESSAGE PRINTED ALREADY. ! 22854: * ! 22855: {STOPR{RTN{{{{ ! 22856: {{BZE{R9{STPRA{{SKIP IF SYSAX ALREADY CALLED (REG04) ! 22857: {{JSR{SYSAX{{{CALL AFTER EXECUTION PROC ! 22858: {STPRA{ADD{RSMEM{DNAME{{USE THE RESERVE MEMORY ! 22859: {{BNE{R9{#ENDMS{STPR0{SKIP IF NOT NORMAL END MESSAGE ! 22860: {{BNZ{EXSTS{STPR3{{SKIP IF EXEC STATS SUPPRESSED ! 22861: {{ZER{ERICH{{{CLEAR ERRORS TO INT.CH. FLAG ! 22862: * ! 22863: * LOOK TO SEE IF AN ENDING MESSAGE IS SUPPLIED ! 22864: * ! 22865: {STPR0{JSR{PRTPG{{{EJECT PRINTER ! 22866: {{BZE{R9{STPR1{{SKIP IF NO MESSAGE ! 22867: {{JSR{PRTST{{{PRINT MESSAGE ! 22868: * ! 22869: * MERGE HERE IF NO MESSAGE TO PRINT ! 22870: * ! 22871: {STPR1{JSR{PRTIS{{{PRINT BLANK LINE ! 22872: {{MTI{KVSTN{{{GET STATEMENT NUMBER ! 22873: {{MOV{#STPM1{R9{{POINT TO MESSAGE /IN STATEMENT XXX/ ! 22874: {{JSR{PRTMX{{{PRINT IT ! 22875: {{JSR{SYSTM{{{GET CURRENT TIME ! 22876: {{SBI{TIMSX{{{MINUS START TIME = ELAPSED EXEC TIM ! 22877: {{STI{STPTI{{{SAVE FOR LATER ! 22878: {{MOV{#STPM3{R9{{POINT TO MSG /EXECUTION TIME MSEC / ! 22879: {{JSR{PRTMX{{{PRINT IT ! 22880: {{LDI{KVSTL{{{GET STATEMENT LIMIT ! 22881: {{ILT{STPR2{{{SKIP IF NEGATIVE ! 22882: {{SBI{KVSTC{{{MINUS COUNTER = COUNT ! 22883: {{STI{STPSI{{{SAVE ! 22884: {{MOV{#STPM2{R9{{POINT TO MESSAGE /STMTS EXECUTED/ ! 22885: {{JSR{PRTMX{{{PRINT IT ! 22886: {{LDI{STPTI{{{RELOAD ELAPSED TIME ! 22887: {{MLI{INTTH{{{*1000 (MICROSECS) ! 22888: {{IOV{STPR2{{{JUMP IF WE CANNOT COMPUTE ! 22889: {{DVI{STPSI{{{DIVIDE BY STATEMENT COUNT ! 22890: {{IOV{STPR2{{{JUMP IF OVERFLOW ! 22891: {{MOV{#STPM4{R9{{POINT TO MSG (MCSEC PER STATEMENT / ! 22892: {{JSR{PRTMX{{{PRINT IT ! 22893: {{EJC{{{{ ! 22894: * ! 22895: * STOPR (CONTINUED) ! 22896: * ! 22897: * MERGE TO SKIP MESSAGE (OVERFLOW OR NEGATIVE STLIMIT) ! 22898: * ! 22899: {STPR2{MTI{GBCNT{{{LOAD COUNT OF COLLECTIONS ! 22900: {{MOV{#STPM5{R9{{POINT TO MESSAGE /REGENERATIONS / ! 22901: {{JSR{PRTMX{{{PRINT IT ! 22902: {{JSR{PRTIS{{{ONE MORE BLANK FOR LUCK ! 22903: * ! 22904: * CHECK IF DUMP REQUESTED ! 22905: * ! 22906: {STPR3{JSR{PRFLR{{{PRINT PROFILE IF WANTED ! 22907: * ! 22908: {{MOV{KVDMP{R9{{LOAD DUMP KEYWORD ! 22909: {{JSR{DUMPR{{{EXECUTE DUMP IF REQUESTED ! 22910: {{MOV{R$FCB{R10{{GET FCBLK CHAIN HEAD ! 22911: {{MOV{KVABE{R6{{LOAD ABEND VALUE ! 22912: {{MOV{KVCOD{R7{{LOAD CODE VALUE ! 22913: {{JSR{SYSEJ{{{EXIT TO SYSTEM ! 22914: {{EJC{{{{ ! 22915: * ! 22916: * SUCCP -- SIGNAL SUCCESSFUL MATCH OF A PATTERN NODE ! 22917: * ! 22918: * SEE PATTERN MATCH ROUTINES FOR DETAILS ! 22919: * ! 22920: * (XR) CURRENT NODE ! 22921: * (WB) CURRENT CURSOR ! 22922: * (XL) MAY BE NON-COLLECTABLE ! 22923: * BRN SUCCP SIGNAL SUCCESSFUL PATTERN MATCH ! 22924: * ! 22925: * SUCCP CONTINUES BY MATCHING THE SUCCESSOR NODE ! 22926: * ! 22927: {SUCCP{RTN{{{{ ! 22928: {{MOV{4*PTHEN(R9){R9{{LOAD SUCCESSOR NODE ! 22929: {{MOV{(R9){R10{{LOAD NODE CODE ENTRY ADDRESS ! 22930: {{BRI{R10{{{JUMP TO MATCH SUCCESSOR NODE ! 22931: {{EJC{{{{ ! 22932: * ! 22933: * SYSAB -- PRINT /ABNORMAL END/ AND TERMINATE ! 22934: * ! 22935: {SYSAB{RTN{{{{ ! 22936: {{MOV{#ENDAB{R9{{POINT TO MESSAGE ! 22937: {{MOV{#NUM01{KVABE{{SET ABEND FLAG ! 22938: {{JSR{PRTNL{{{SKIP TO NEW LINE ! 22939: {{BRN{STOPR{{{JUMP TO PACK UP ! 22940: {{EJC{{{{ ! 22941: * ! 22942: * SYSTU -- PRINT /TIME UP/ AND TERMINATE ! 22943: * ! 22944: {SYSTU{RTN{{{{ ! 22945: {{MOV{#ENDTU{R9{{POINT TO MESSAGE ! 22946: {{MOV{STRTU{R6{{GET CHARS /TU/ ! 22947: {{MOV{R6{KVCOD{{PUT IN KVCOD ! 22948: {{MOV{TIMUP{R6{{CHECK STATE OF TIMEUP SWITCH ! 22949: {{MNZ{TIMUP{{{SET SWITCH ! 22950: {{BNZ{R6{STOPR{{STOP RUN IF ALREADY SET ! 22951: {{ERB{245{TRANSLATION/EXECUTION{{TIME EXPIRED ! 22952: {{TTL{S{{{P I T B O L -- STACK OVERFLOW SECTION ! 22953: * ! 22954: * CONTROL COMES HERE IF THE MAIN STACK OVERFLOWS ! 22955: * ! 22956: {{SEC{{{{START OF STACK OVERFLOW SECTION ! 22957: * ! 22958: {{ICV{ERRFT{{{FATAL ERROR ! 22959: {{MOV{FLPTR{SP{{POP STACK TO AVOID MORE FAILS ! 22960: {{BNZ{GBCFL{STAK1{{JUMP IF GARBAGE COLLECTING ! 22961: {{ERB{246{STACK{{OVERFLOW ! 22962: * ! 22963: * NO CHANCE OF RECOVERY IN MID GARBAGE COLLECTION ! 22964: * ! 22965: {STAK1{MOV{#ENDSO{R9{{POINT TO MESSAGE ! 22966: {{ZER{KVDMP{{{MEMORY IS UNDUMPABLE ! 22967: {{BRN{STOPR{{{GIVE UP ! 22968: {{TTL{S{{{P I T B O L -- ERROR SECTION ! 22969: * ! 22970: * THIS SECTION OF CODE IS ENTERED WHENEVER A PROCEDURE ! 22971: * RETURN VIA AN ERR PARAMETER OR AN ERB OPCODE IS OBEYED. ! 22972: * ! 22973: * (WA) IS THE ERROR CODE ! 22974: * ! 22975: * THE GLOBAL VARIABLE STAGE INDICATES THE POINT AT WHICH ! 22976: * THE ERROR OCCURED AS FOLLOWS. ! 22977: * ! 22978: * STAGE=STGIC ERROR DURING INITIAL COMPILE ! 22979: * ! 22980: * STAGE=STGXC ERROR DURING COMPILE AT EXECUTE ! 22981: * TIME (CODE, CONVERT FUNCTION CALLS) ! 22982: * ! 22983: * STAGE=STGEV ERROR DURING COMPILATION OF ! 22984: * EXPRESSION AT EXECUTION TIME ! 22985: * (EVAL, CONVERT FUNCTION CALL). ! 22986: * ! 22987: * STAGE=STGXT ERROR AT EXECUTE TIME. COMPILER ! 22988: * NOT ACTIVE. ! 22989: * ! 22990: * STAGE=STGCE ERROR DURING INITIAL COMPILE AFTER ! 22991: * SCANNING OUT THE END LINE. ! 22992: * ! 22993: * STAGE=STGXE ERROR DURING COMPILE AT EXECUTE ! 22994: * TIME AFTER SCANNING END LINE. ! 22995: * ! 22996: * STAGE=STGEE ERROR DURING EXPRESSION EVALUATION ! 22997: * ! 22998: {{SEC{{{{START OF ERROR SECTION ! 22999: * ! 23000: {ERROR{BEQ{R$CIM{#CMLAB{CMPLE{JUMP IF ERROR IN SCANNING LABEL ! 23001: {{MOV{R6{KVERT{{SAVE ERROR CODE ! 23002: {{ZER{SCNRS{{{RESET RESCAN SWITCH FOR SCANE ! 23003: {{ZER{SCNGO{{{RESET GOTO SWITCH FOR SCANE ! 23004: {{MOV{STAGE{R9{{LOAD CURRENT STAGE ! 23005: {{BSW{R9{STGNO{{JUMP TO APPROPRIATE ERROR CIRCUIT ! 23006: {{IFF{STGIC{ERR01{{INITIAL COMPILE ! 23007: {{IFF{STGXC{ERR04{{EXECUTE TIME COMPILE ! 23008: {{IFF{STGEV{ERR04{{EVAL COMPILING EXPR. ! 23009: {{IFF{STGXT{ERR05{{EXECUTE TIME ! 23010: {{IFF{STGCE{ERR01{{COMPILE - AFTER END ! 23011: {{IFF{STGXE{ERR04{{XEQ COMPILE-PAST END ! 23012: {{IFF{STGEE{ERR04{{EVAL EVALUATING EXPR ! 23013: {{ESW{{{{END SWITCH ON ERROR TYPE ! 23014: {{EJC{{{{ ! 23015: * ! 23016: * ERROR DURING INITIAL COMPILE ! 23017: * ! 23018: * THE ERROR MESSAGE IS PRINTED AS PART OF THE COMPILER ! 23019: * OUTPUT. THIS PRINTOUT INCLUDES THE OFFENDING LINE (IF NOT ! 23020: * PRINTED ALREADY) AND AN ERROR FLAG UNDER THE APPROPRIATE ! 23021: * COLUMN AS INDICATED BY SCNSE UNLESS SCNSE IS SET TO ZERO. ! 23022: * ! 23023: * AFTER PRINTING THE MESSAGE, THE GENERATED CODE IS ! 23024: * MODIFIED TO AN ERROR CALL AND CONTROL IS RETURNED TO ! 23025: * THE CMPIL PROCEDURE AFTER RESETTING THE STACK POINTER. ! 23026: * ! 23027: * IF THE ERROR OCCURS AFTER THE END LINE, CONTROL RETURNS ! 23028: * IN A SLIGHTLY DIFFERENT MANNER TO ENSURE PROPER CLEANUP. ! 23029: * ! 23030: {ERR01{MOV{CMPXS{SP{{RESET STACK POINTER ! 23031: {{SSL{CMPSS{{{RESTORE S-R STACK PTR FOR CMPIL ! 23032: {{BNZ{ERRSP{ERR03{{JUMP IF ERROR SUPPRESS FLAG SET ! 23033: {{MOV{ERICH{ERLST{{SET FLAG FOR LISTR ! 23034: {{JSR{LISTR{{{LIST LINE ! 23035: {{JSR{PRTIS{{{TERMINATE LISTING ! 23036: {{ZER{ERLST{{{CLEAR LISTR FLAG ! 23037: {{MOV{SCNSE{R6{{LOAD SCAN ELEMENT OFFSET ! 23038: {{BZE{R6{ERR02{{SKIP IF NOT SET ! 23039: {{LCT{R7{R6{{LOOP COUNTER ! 23040: {{ICV{R6{{{INCREASE FOR CH$EX ! 23041: {{JSR{ALOCS{{{STRING BLOCK FOR ERROR FLAG ! 23042: {{MOV{R9{R6{{REMEMBER STRING PTR ! 23043: {{PSC{R9{{{READY FOR CHARACTER STORING ! 23044: {{MOV{R$CIM{R10{{POINT TO BAD STATEMENT ! 23045: {{PLC{R10{{{READY TO GET CHARS ! 23046: * ! 23047: * LOOP TO REPLACE ALL CHARS BUT TABS BY BLANKS ! 23048: * ! 23049: {ERRA1{LCH{R8{(R10)+{{GET NEXT CHAR ! 23050: {{BEQ{R8{#CH$HT{ERRA2{SKIP IF TAB ! 23051: {{MOV{#CH$BL{R8{{GET A BLANK ! 23052: {{EJC{{{{ ! 23053: * ! 23054: * MERGE TO STORE BLANK OR TAB IN ERROR LINE ! 23055: * ! 23056: {ERRA2{SCH{R8{(R9)+{{STORE CHAR ! 23057: {{BCT{R7{ERRA1{{LOOP ! 23058: {{MOV{#CH$EX{R10{{EXCLAMATION MARK ! 23059: {{SCH{R10{(R9){{STORE AT END OF ERROR LINE ! 23060: {{CSC{R9{{{END OF SCH LOOP ! 23061: {{MOV{#STNPD{PROFS{{ALLOW FOR STATEMENT NUMBER ! 23062: {{MOV{R6{R9{{POINT TO ERROR LINE ! 23063: {{JSR{PRTST{{{PRINT ERROR LINE ! 23064: * ! 23065: * HERE AFTER PLACING ERROR FLAG AS REQUIRED ! 23066: * ! 23067: {ERR02{JSR{ERMSG{{{GENERATE FLAG AND ERROR MESSAGE ! 23068: {{ADD{#NUM03{LSTLC{{BUMP PAGE CTR FOR BLANK, ERROR, BLK ! 23069: {{ZER{R9{{{IN CASE OF FATAL ERROR ! 23070: {{BHI{ERRFT{#NUM03{STOPR{PACK UP IF SEVERAL FATALS ! 23071: * ! 23072: * COUNT ERROR, INHIBIT EXECUTION IF REQUIRED ! 23073: * ! 23074: {{ICV{CMERC{{{BUMP ERROR COUNT ! 23075: {{ADD{CSWER{NOXEQ{{INHIBIT XEQ IF -NOERRORS ! 23076: {{BNE{STAGE{#STGIC{CMP10{SPECIAL RETURN IF AFTER END LINE ! 23077: {{EJC{{{{ ! 23078: * ! 23079: * LOOP TO SCAN TO END OF STATEMENT ! 23080: * ! 23081: {ERR03{MOV{R$CIM{R9{{POINT TO START OF IMAGE ! 23082: {{PLC{R9{{{POINT TO FIRST CHAR ! 23083: {{LCH{R9{(R9){{GET FIRST CHAR ! 23084: {{BEQ{R9{#CH$MN{CMPCE{JUMP IF ERROR IN CONTROL CARD ! 23085: {{ZER{SCNRS{{{CLEAR RESCAN FLAG ! 23086: {{MNZ{ERRSP{{{SET ERROR SUPPRESS FLAG ! 23087: {{JSR{SCANE{{{SCAN NEXT ELEMENT ! 23088: {{BNE{R10{#T$SMC{ERR03{LOOP BACK IF NOT STATEMENT END ! 23089: {{ZER{ERRSP{{{CLEAR ERROR SUPPRESS FLAG ! 23090: * ! 23091: * GENERATE ERROR CALL IN CODE AND RETURN TO CMPIL ! 23092: * ! 23093: {{MOV{#4*CDCOD{CWCOF{{RESET OFFSET IN CCBLK ! 23094: {{MOV{#OCER${R6{{LOAD COMPILE ERROR CALL ! 23095: {{JSR{CDWRD{{{GENERATE IT ! 23096: {{MOV{CWCOF{4*CMSOC(SP){{SET SUCCESS FILL IN OFFSET ! 23097: {{MNZ{4*CMFFC(SP){{{SET FAILURE FILL IN FLAG ! 23098: {{JSR{CDWRD{{{GENERATE SUCC. FILL IN WORD ! 23099: {{BRN{CMPSE{{{MERGE TO GENERATE ERROR AS CDFAL ! 23100: * ! 23101: * ERROR DURING EXECUTE TIME COMPILE OR EXPRESSION EVALUATIO ! 23102: * ! 23103: * EXECUTE TIME COMPILATION IS INITIATED THROUGH GTCOD OR ! 23104: * GTEXP WHICH ARE CALLED BY COMPILE, CODE OR EVAL. ! 23105: * BEFORE CAUSING STATEMENT FAILURE THROUGH EXFAL IT IS ! 23106: * HELPFUL TO SET KEYWORD ERRTEXT AND FOR GENERALITY ! 23107: * THESE ERRORS MAY BE HANDLED BY THE SETEXIT MECHANISM. ! 23108: * ! 23109: {ERR04{ZER{R$CCB{{{FORGET GARBAGE CODE BLOCK ! 23110: {{SSL{INISS{{{RESTORE MAIN PROG S-R STACK PTR ! 23111: {{JSR{ERTEX{{{GET FAIL MESSAGE TEXT ! 23112: {{DCA{SP{{{ENSURE STACK OK ON LOOP START ! 23113: * ! 23114: * POP STACK UNTIL FIND FLPTR FOR MOST DEEPLY NESTED PROG. ! 23115: * DEFINED FUNCTION CALL OR CALL OF EVAL / CODE. ! 23116: * ! 23117: {ERRA4{ICA{SP{{{POP STACK ! 23118: {{BEQ{SP{FLPRT{ERRC4{JUMP IF PROG DEFINED FN CALL FOUND ! 23119: {{BNE{SP{GTCEF{ERRA4{LOOP IF NOT EVAL OR CODE CALL YET ! 23120: {{MOV{#STGXT{STAGE{{RE-SET STAGE FOR EXECUTE ! 23121: {{MOV{R$GTC{R$COD{{RECOVER CODE PTR ! 23122: {{MOV{SP{FLPTR{{RESTORE FAIL POINTER ! 23123: {{ZER{R$CIM{{{FORGET POSSIBLE IMAGE ! 23124: * ! 23125: * TEST ERRLIMIT ! 23126: * ! 23127: {ERRB4{BNZ{KVERL{ERR07{{JUMP IF ERRLIMIT NON-ZERO ! 23128: {{BRN{EXFAL{{{FAIL ! 23129: * ! 23130: * RETURN FROM PROG. DEFINED FUNCTION IS OUTSTANDING ! 23131: * ! 23132: {ERRC4{MOV{FLPTR{SP{{RESTORE STACK FROM FLPTR ! 23133: {{BRN{ERRB4{{{MERGE ! 23134: {{EJC{{{{ ! 23135: * ! 23136: * ERROR AT EXECUTE TIME. ! 23137: * ! 23138: * THE ACTION TAKEN ON AN ERROR IS AS FOLLOWS. ! 23139: * ! 23140: * IF ERRLIMIT KEYWORD IS ZERO, AN ABORT IS SIGNALLED, ! 23141: * SEE CODING FOR SYSTEM LABEL ABORT AT L$ABO. ! 23142: * ! 23143: * OTHERWISE, ERRLIMIT IS DECREMENTED AND AN ERRTYPE TRACE ! 23144: * GENERATED IF REQUIRED. CONTROL RETURNS EITHER VIA A JUMP ! 23145: * TO CONTINUE (TO TAKE THE FAILURE EXIT) OR A SPECIFIED ! 23146: * SETEXIT TRAP IS EXECUTED AND CONTROL PASSES TO THE TRAP. ! 23147: * IF 3 OR MORE FATAL ERRORS OCCUR AN ABORT IS SIGNALLED ! 23148: * REGARDLESS OF ERRLIMIT AND SETEXIT - LOOPING IS ALL TOO ! 23149: * PROBABLE OTHERWISE. FATAL ERRORS INCLUDE STACK OVERFLOW ! 23150: * AND EXCEEDING STLIMIT. ! 23151: * ! 23152: {ERR05{SSL{INISS{{{RESTORE MAIN PROG S-R STACK PTR ! 23153: {{BNZ{DMVCH{ERR08{{JUMP IF IN MID-DUMP ! 23154: * ! 23155: * MERGE HERE FROM ERR08 ! 23156: * ! 23157: {ERR06{BZE{KVERL{LABO1{{ABORT IF ERRLIMIT IS ZERO ! 23158: {{JSR{ERTEX{{{GET FAIL MESSAGE TEXT ! 23159: * ! 23160: * MERGE FROM ERR04 ! 23161: * ! 23162: {ERR07{BGE{ERRFT{#NUM03{LABO1{ABORT IF TOO MANY FATAL ERRORS ! 23163: {{DCV{KVERL{{{DECREMENT ERRLIMIT ! 23164: {{MOV{R$ERT{R10{{LOAD ERRTYPE TRACE POINTER ! 23165: {{JSR{KTREX{{{GENERATE ERRTYPE TRACE IF REQUIRED ! 23166: {{MOV{R$COD{R$CNT{{SET CDBLK PTR FOR CONTINUATION ! 23167: {{MOV{FLPTR{R9{{SET PTR TO FAILURE OFFSET ! 23168: {{MOV{(R9){STXOF{{SAVE FAILURE OFFSET FOR CONTINUE ! 23169: {{MOV{R$SXC{R9{{LOAD SETEXIT CDBLK POINTER ! 23170: {{BZE{R9{LCNT1{{CONTINUE IF NO SETEXIT TRAP ! 23171: {{ZER{R$SXC{{{ELSE RESET TRAP ! 23172: {{MOV{#NULLS{STXVR{{RESET SETEXIT ARG TO NULL ! 23173: {{MOV{(R9){R10{{LOAD PTR TO CODE BLOCK ROUTINE ! 23174: {{BRI{R10{{{EXECUTE FIRST TRAP STATEMENT ! 23175: * ! 23176: * INTERRUPTED PARTLY THROUGH A DUMP WHILST STORE IS IN A ! 23177: * MESS SO DO A TIDY UP OPERATION. SEE DUMPR FOR DETAILS. ! 23178: * ! 23179: {ERR08{MOV{DMVCH{R9{{CHAIN HEAD FOR AFFECTED VRBLKS ! 23180: {{BZE{R9{ERR06{{DONE IF ZERO ! 23181: {{MOV{(R9){DMVCH{{SET NEXT LINK AS CHAIN HEAD ! 23182: {{JSR{SETVR{{{RESTORE VRGET FIELD ! 23183: {{BRN{ERR08{{{LOOP THROUGH CHAIN ! 23184: {{TTL{S{{{P I T B O L -- HERE ENDETH THE CODE ! 23185: * ! 23186: * END OF ASSEMBLY ! 23187: * ! 23188: {{END{{{{END MACRO-SPITBOL ASSEMBLY
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.