![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to diff.out CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / spitbol / 4.3|
Return to diff.out CVS log | Up to [Research Unix] / researchv10no / cmd / spitbol / 4.3 |
1.1 ! root 1: 1,4c1,6 ! 2: < TTL S P I T B O L - REVISION HISTORY ! 3: < EJC ! 4: < * R E V I S I O N H I S T O R Y ! 5: < * ------------------------------- ! 6: --- ! 7: > * CHANGES [SGD] ! 8: > * ------------- ! 9: > * 1. COMMENTED OUT DEFAULT .DEF, .UNDEF AS THESE MACHINE- ! 10: > * DEPENDENT. I SUGGEST AGAIN THAT THESE DO NOT BELONG ! 11: > * IN MINIMAL SOURCE, UNLESS SOMETHING OF THE FORM .*DEF ! 12: > * IS TO BE INCORPORTATED INTO MINIMAL LANGUAGE DEFN. ! 13: 5a8,11 ! 14: > * 2. NOTED THAT DESCRIPTION OF BEV, BOD MISSING FROM ! 15: > * SBL42.CMT MINIMAL DESCRIPTION, AND DISCUSSION OF ! 16: > * "ODD"/"EVEN" AND REQUIREMENTS PERTAINING THERETO ! 17: > * SEEMS INSUFFICIENT. ! 18: 7,8c13,21 ! 19: < * VERSION 3.5B (FEB 81... - SGD PATCHES) ! 20: < * ----------------------------------- ! 21: --- ! 22: > * 3. PERMIT CODE KEYWORD TO CONTAIN ANY INTEGER VALUE. ! 23: > * THIS CONSISTS OF REMOVING THE ENFORCED RESTRICTION ! 24: > * IN ASIGN (SEE ASG24), SINCE CODE CONTAINS NO RELOC. ! 25: > * USE OF KEYWORD VALUE (AS IT SHOULDNT). SBL DOC. ! 26: > * MUST BE UPDATED. ADDRESS OF CODE VALUE NOW PASSED TO ! 27: > * OSINT (KVCOD), INSTEAD OF VALUE ITSELF. HENCE OSINT ! 28: > * DOCUMENTATION MUST LIKEWISE BE REVISED. CHANGES ! 29: > * MADE IN KEYWORD DEFINITION TABLES, PROCEDURES ACESS ! 30: > * AND ASIGN SINCE CODE NOW SPECIAL KEYWORD. ! 31: 10,42c23,24 ! 32: < * SGD03 - ADDITION OF .CNCI AND SYSCI (INT->STRING ! 33: < * SYSTEM ROUTINE OPTION) ! 34: < * SGD04 - (06-MAY-1981) MODIFIED INILN TO 132 ! 35: < * SGD05 - (13-MAY-1981) INSERTED MISSING WTB AFTER SYSMM ! 36: < * CALLS ! 37: < * SGD06 - (25-MAY-1981) MERGED IN PROFILER PATCHES ! 38: < * (NOT MARKED) ! 39: < * SGD07 - (25-MAY-1981) MUCHO PATCHES TO PROFILER (MARKED, ! 40: < * BUT BEST JUST TO EXTRACT ENMASSE) ! 41: < * SGD08 - (25-MAY-1981) USE STRING LENGTH IN HASHS ! 42: < * SGD09 - (25-MAY-1981) FIXED SERIOUS PARSER PROBLEM ! 43: < * RELATING TO (X Y) ON LINE BEING VIEWED AS PATTERN ! 44: < * MATCH. FIXED BY ADDITION OF NEW CMTYP VALUE ! 45: < * C$CNP (CONCATENATION - NOT PATTERN MATCH) ! 46: < * SGD10 - (01-AUG-1981) FIXED EXIT(N) RESPECIFICATION CODE ! 47: < * TO PROPERLY OBSERVE HEADER SEMANTICS ON RETURN. ! 48: < * SGD11 - (07-AUG-1981) BYPASS PRTPG CALL AT INITIALIZATION ! 49: < * FOLLOWING COMPILATION IF NO OUTPUT GENERATED. ! 50: < * THIS PREVENTS OUTPUT FILES CONSISTING OF THE ! 51: < * HEADERS AND A FEW BLANK LINES WHEN THERE IS NO ! 52: < * SOURCE LISTING AND NO COMPILATION STATS. ! 53: < * ALSO FIX TIMSX INITIALIZATION IN SAME CODE. ! 54: < * SGD12 - (17-AUG-1981) B$EFC CODE DID NOT CHECK FOR ! 55: < * UNCONVERTED RESULT RETURNING NULL STRING. FIXED. ! 56: < * SGDBF - ( NOV-1981) ADDED BUFFER TYPE AND SYMBOL CNBF ! 57: < * SGD13 - (03-MAR-1982) LOAD PFVBL FIELD IN RETRN FOR ! 58: < * RETURN TRACING. THIS WAS CAUSING BUG ON RETURN ! 59: < * TRACES THAT TRIED TO ACCESS THE VARIABLE NAME ! 60: < * SGD14 - ADDED CHAR FUNCTION. CHAR(N) RETURNS NTH ! 61: < * CHARACTER OF HOST MACHINE CHARACTER SET. ! 62: < * NOT CONDITIONALIZED OR MARKED. ! 63: < * SGD15 - FIXED PROBLEM RELATING TO COMPILATION OF GOTO ! 64: < * FIELDS CONTAINING SMALL INTEGERS (IN CONST SEC). ! 65: --- ! 66: > * EROSI RETURNS NOW CONTAIN NEW CODE KEYWORD VALUE IN ! 67: > * IA. OSINT DOCUMENTATION MUST BE REVISED. ! 68: 44,48c26,29 ! 69: < * REG01 - (XX-AUG-82) ! 70: < * ADDED CFP$U TO EASE TRANSLATION ON SMALLER ! 71: < * SYSTEMS - CONDITIONAL .CUCF ! 72: < * ADDED LOWER CASE SUPPORT - CONDITIONAL .CULC ! 73: < * ADDED SET I/O FUNCTION - CONDITIONAL .CUST ! 74: --- ! 75: > * INTERESTINGLY, THIS SHOULD PERMIT THE SPITBOL PROGRAM ! 76: > * TO INTERROGATE THE CODE KEYWORD AT THE START OF ! 77: > * EXECUTION TO DETERMINE IF COMPILATION ERRORS ! 78: > * OCCURRED. ! 79: 50,51c31,46 ! 80: < * REG02 - (XX-SEP-82) ! 81: < * CHANGED INILN AND AND INILS TO 258 ! 82: --- ! 83: > * 4. ADD -COPY "FILETAG" CONTROL CARD. -COPY PERMITTED IN ! 84: > * CODE STRINGS. NESTING IS PERMITTED TO ANY LEVEL, ! 85: > * THOUGH OSINT IS FREE TO RESTRICT THE MAXIMUM LEVEL. ! 86: > * NOTE REQUIREMENT FOR FILETAG SPECIFIED AS ! 87: > * STRING CONSTANT SINCE FILETAGS MAY CONTAIN SEMICOLONS. ! 88: > * I HAVE TRIED TO MAKE THIS ENHANCEMENT WITH MINIMUM ! 89: > * (MINIMAL?) AMOUNT OF NEW CODE, SO THE FEATURE IS ! 90: > * NOT CONDITIONALIZED. THE SOLUTION ! 91: > * REQUIRED THE ADDITION OF A NEW BLOCK TYPE (COBLK) TO ! 92: > * BUILD THE INPUT CONTEXT SAVE STACK AS A CHAIN OF ! 93: > * COBLKS. A RECUSIVE SOLUTION ON CMPIL/READR/NEXTS ! 94: > * WOULD HAVE REQUIRED EXTENSIVE MODIFICATIONS AND ! 95: > * SUBSTANTIAL NEW CODE. NOTE THAT FORMS SUCH AS ! 96: > * CODE('-COPY "FILE.SBL"') ARE ACCEPTABLE, WHICH IS ! 97: > * VIEWED AS SIGNIFICANT ENHANCEMENT IN ADDITION TO ! 98: > * COMPILE-TIME INCLUDE. ! 99: 53,59c48,50 ! 100: < * REG03 - (XX-OCT-82) ! 101: < * CONDITIONALIZED THE PAGE EJECT AFTER CALL TO SYSBX ! 102: < * AND ADDED ANOTHER BEFORE CALL TO SYSBX, SO THAT, ! 103: < * IF DESIRED BY THE IMPLEMENTOR, STANDARD OUTPUT ! 104: < * WILL REFLECT ASSIGNMENTS MADE BY EXECUTING PROGRAM ! 105: < * ONLY. CONDITIONAL .CUEJ CONTROLS - IF DEFINED ! 106: < * EJECT IS BEFORE CALL TO SYSBX. ! 107: --- ! 108: > * TO SUPPORT THIS FEATURE, TWO NEW OSINT ROUTINES ARE ! 109: > * DEFINED, SYSSC (START COPY) AND SYSEC (END COPY) WITH ! 110: > * LOGICS DESCRIBED IN THE .CMT FILE. ! 111: 61,63c52,57 ! 112: < * REG04 - (XX-NOV-82) ! 113: < * FIXED DIFFICULTIES WITH LISTINGS DURING EXECUTION ! 114: < * WHEN NO LISTING GENERATED DURING COMPILATION. ! 115: --- ! 116: > * BECAUSE OF ANNOYANCE FACTOR, SOURCE LISTING OF ! 117: > * CODE() INFO VIA -LIST, INCLUDING -COPY INPUT, IS ! 118: > * NO LONGER POSSIBLE. IF THIS IS PERMITTED, THEN ! 119: > * ONE FINDS -COPY INPUT BEING PRINTED ON STD. ! 120: > * OUTPUT CHANNEL (DEPENDING ON STATE OF -LIST), ! 121: > * UNLESS EXPLICIT -NOLIST IS GIVEN. ! 122: 65,67c59,63 ! 123: < * -LIST TO CODE() CAUSED BOMB. FIX IS TO RESET ! 124: < * R$TTL AND R$STL TO NULLS NOT 0 AFTER COMPILATION. ! 125: < * (LISTR AND LISTT EXPECT NULLS) ! 126: --- ! 127: > * 5. THE DOCUMENTATION FOR SYSIO IS INCONSISTENT. IT ! 128: > * SHOWS 0,1,2,3 BEING POSSIBLE INPUTS DEPENDING ON ! 129: > * INPUT/OUTPUT, STD/NONSTD. HOWEVER, IT ALSO APPEARS ! 130: > * (AND IS STATED) THAT SYSIO IS NOT CALLED FOR STD ! 131: > * INPUT/OUTPUT. ! 132: 69,224c65,67 ! 133: < * WHEN LISTING AND STATISTICS ROUTED TO DIFFERENT ! 134: < * FILE THAN EXECUTION OUTPUT, ERROR MESSAGE IS SENT ! 135: < * TO EXECUTION OUTPUT (AND GETS SEPARATED FROM ! 136: < * ... IN STATEMENT ... MSG). LABO1 CALLS SYSAX AND ! 137: < * STOPR DOES NOT CALL SYSAX IF ENTERED FROM LABO1. ! 138: < * ! 139: < * REG05 - (XX-NOV-82) ! 140: < * PREVENT CLEAR() FROM CLOBBERING PROTECTED VARIABLES ! 141: < * AT LABEL SCLR5. ! 142: < * ! 143: < * REG06 - (XX-NOV-82) ! 144: < * FIXED GTEXP FROM ACCEPTING TRAILING SEMICOLON OR ! 145: < * COLON. NOT LEGAL WAY TO END AN EXPRESSION. ! 146: < * ! 147: < * VERSION 3.5A (OCT 79 - SGD PATCHES) ! 148: < * ----------------------------------- ! 149: < * ! 150: < * SGD01 - PATCH IN ASIGN TO FIX MULTIPLE TRAP BLOCK PROBLEM ! 151: < * (ASG10+2) ! 152: < * SGD02 - PATCH IN GTARR TO FIX NULL CONVERT (GTAR9+0) ! 153: < * ! 154: < TTL S P I T B O L -- BASIC INFORMATION ! 155: < EJC ! 156: < * ! 157: < * GENERAL STRUCTURE ! 158: < * ----------------- ! 159: < * ! 160: < * THIS PROGRAM IS A TRANSLATOR FOR A VERSION OF THE SNOBOL4 ! 161: < * PROGRAMMING LANGUAGE. LANGUAGE DETAILS ARE CONTAINED IN ! 162: < * THE MANUAL MACRO SPITBOL BY DEWAR AND MCCANN, TECHNICAL ! 163: < * REPORT 90, UNIVERSITY OF LEEDS 1976. THE LANGUAGE ! 164: < * IS IDENTICAL TO THAT IMPLEMENTED BY THE BTL TRANSLATOR ! 165: < * (R. E. GRISWOLD ET AL.) WITH THE FOLLOWING EXCEPTIONS. ! 166: < * ! 167: < * 1) REDEFINITION OF STANDARD SYSTEM FUNCTIONS AND ! 168: < * OPERATORS IS NOT PERMITTED. ! 169: < * ! 170: < * 2) THE VALUE FUNCTION IS NOT PROVIDED. ! 171: < * ! 172: < * 3) ACCESS TRACING IS PROVIDED IN ADDITION TO THE ! 173: < * OTHER STANDARD TRACE MODES. ! 174: < * ! 175: < * 4) THE KEYWORD STFCOUNT IS NOT PROVIDED. ! 176: < * ! 177: < * 5) THE KEYWORD FULLSCAN IS NOT PROVIDED AND ALL PATTERN ! 178: < * MATCHING TAKES PLACE IN FULLSCAN MODE (I.E. WITH NO ! 179: < * HEURISTICS APPLIED). ! 180: < * ! 181: < * 6) A SERIES OF EXPRESSIONS SEPARATED BY COMMAS MAY ! 182: < * BE GROUPED WITHIN PARENTHESES TO PROVIDE A SELECTION ! 183: < * CAPABILITY. THE SEMANTICS ARE THAT THE SELECTION ! 184: < * ASSUMES THE VALUE OF THE FIRST EXPRESSION WITHIN IT ! 185: < * WHICH SUCCEEDS AS THEY ARE EVALUATED FROM THE LEFT. ! 186: < * IF NO EXPRESSION SUCCEEDS THE ENTIRE STATEMENT FAILS ! 187: < * ! 188: < * 7) AN EXPLICIT PATTERN MATCHING OPERATOR IS PROVIDED. ! 189: < * THIS IS THE BINARY QUERY (SEE GIMPEL SIGPLAN OCT 74) ! 190: < * ! 191: < * 8) THE ASSIGNMENT OPERATOR IS INTRODUCED AS IN THE ! 192: < * GIMPEL REFERENCE. ! 193: < * ! 194: < * 9) THE EXIT FUNCTION IS PROVIDED FOR GENERATING LOAD ! 195: < * MODULES - CF. GIMPELS SITBOL. ! 196: < * ! 197: < * ! 198: < * THE METHOD USED IN THIS PROGRAM IS TO TRANSLATE THE ! 199: < * SOURCE CODE INTO AN INTERNAL PSEUDO-CODE (SEE FOLLOWING ! 200: < * SECTION). AN INTERPRETOR IS THEN USED TO EXECUTE THIS ! 201: < * GENERATED PSEUDO-CODE. THE NATURE OF THE SNOBOL4 LANGUAGE ! 202: < * IS SUCH THAT THE LATTER TASK IS MUCH MORE COMPLEX THAN ! 203: < * THE ACTUAL TRANSLATION PHASE. ACCORDINGLY, NEARLY ALL THE ! 204: < * CODE IN THE PROGRAM SECTION IS CONCERNED WITH THE ACTUAL ! 205: < * EXECUTION OF THE SNOBOL4 PROGRAM. ! 206: < EJC ! 207: < * ! 208: < * INTERPRETIVE CODE FORMAT ! 209: < * ------------------------ ! 210: < * ! 211: < * THE INTERPRETIVE PSEUDO-CODE CONSISTS OF A SERIES OF ! 212: < * ADDRESS POINTERS. THE EXACT FORMAT OF THE CODE IS ! 213: < * DESCRIBED IN CONNECTION WITH THE CDBLK FORMAT. THE ! 214: < * PURPOSE OF THIS SECTION IS TO GIVE GENERAL INSIGHT INTO ! 215: < * THE INTERPRETIVE APPROACH INVOLVED. ! 216: < * ! 217: < * THE BASIC FORM OF THE CODE IS RELATED TO REVERSE POLISH. ! 218: < * IN OTHER WORDS, THE OPERANDS PRECEDE THE OPERATORS WHICH ! 219: < * ARE ZERO ADDRESS OPERATORS. THERE ARE SOME EXCEPTIONS TO ! 220: < * THESE RULES, NOTABLY THE UNARY NOT OPERATOR AND THE ! 221: < * SELECTION CONSTRUCTION WHICH CLEARLY REQUIRE ADVANCE ! 222: < * KNOWLEDGE OF THE OPERATOR INVOLVED. ! 223: < * ! 224: < * THE OPERANDS ARE MOVED TO THE TOP OF THE MAIN STACK AND ! 225: < * THE OPERATORS ARE APPLIED TO THE TOP STACK ENTRIES. LIKE ! 226: < * OTHER VERSIONS OF SPITBOL, THIS PROCESSOR DEPENDS ON ! 227: < * KNOWING WHETHER OPERANDS ARE REQUIRED BY NAME OR BY VALUE ! 228: < * AND MOVES THE APPROPRIATE OBJECT TO THE STACK. THUS NO ! 229: < * NAME/VALUE CHECKS ARE INCLUDED IN THE OPERATOR CIRCUITS. ! 230: < * ! 231: < * THE ACTUAL POINTERS IN THE CODE POINT TO A BLOCK WHOSE ! 232: < * FIRST WORD IS THE ADDRESS OF THE INTERPRETOR ROUTINE ! 233: < * TO BE EXECUTED FOR THE CODE WORD. ! 234: < * ! 235: < * IN THE CASE OF OPERATORS, THE POINTER IS TO A WORD WHICH ! 236: < * CONTAINS THE ADDRESS OF THE OPERATOR TO BE EXECUTED. IN ! 237: < * THE CASE OF OPERANDS SUCH AS CONSTANTS, THE POINTER IS TO ! 238: < * THE OPERAND ITSELF. ACCORDINGLY, ALL OPERANDS CONTAIN ! 239: < * A FIELD WHICH POINTS TO THE ROUTINE TO LOAD THE VALUE OF ! 240: < * THE OPERAND ONTO THE STACK. IN THE CASE OF A VARIABLE, ! 241: < * THERE ARE THREE SUCH POINTERS. ONE TO LOAD THE VALUE, ! 242: < * ONE TO STORE THE VALUE AND A THIRD TO JUMP TO THE LABEL. ! 243: < * ! 244: < * THE HANDLING OF FAILURE RETURNS DESERVES SPECIAL COMMENT. ! 245: < * THE LOCATION FLPTR CONTAINS THE POINTER TO THE LOCATION ! 246: < * ON THE MAIN STACK WHICH CONTAINS THE FAILURE RETURN ! 247: < * WHICH IS IN THE FORM OF A BYTE OFFSET IN THE CURRENT ! 248: < * CODE BLOCK (CDBLK OR EXBLK). WHEN A FAILURE OCCURS, THE ! 249: < * STACK IS POPPED AS INDICATED BY THE SETTING OF FLPTR AND ! 250: < * CONTROL IS PASSED TO THE APPROPRIATE LOCATION IN THE ! 251: < * CURRENT CODE BLOCK WITH THE STACK POINTER POINTING TO THE ! 252: < * FAILURE OFFSET ON THE STACK AND FLPTR UNCHANGED. ! 253: < EJC ! 254: < * ! 255: < * INTERNAL DATA REPRESENTATIONS ! 256: < * ----------------------------- ! 257: < * ! 258: < * REPRESENTATION OF VALUES ! 259: < * ! 260: < * A VALUE IS REPRESENTED BY A POINTER TO A BLOCK WHICH ! 261: < * DESCRIBES THE TYPE AND PARTICULARS OF THE DATA VALUE. ! 262: < * IN GENERAL, A VARIABLE IS A LOCATION CONTAINING SUCH A ! 263: < * POINTER (ALTHOUGH IN THE CASE OF TRACE ASSOCIATIONS THIS ! 264: < * IS MODIFIED, SEE DESCRIPTION OF TRBLK). ! 265: < * ! 266: < * THE FOLLOWING IS A LIST OF POSSIBLE DATATYPES SHOWING THE ! 267: < * TYPE OF BLOCK USED TO HOLD THE VALUE. THE DETAILS OF ! 268: < * EACH BLOCK FORMAT ARE GIVEN LATER. ! 269: < * ! 270: < * DATATYPE BLOCK TYPE ! 271: < * -------- ---------- ! 272: < * ! 273: < * ! 274: < * ARRAY ARBLK OR VCBLK ! 275: < * ! 276: < * CODE CDBLK ! 277: < * ! 278: < * EXPRESSION EXBLK OR SEBLK ! 279: < * ! 280: < * INTEGER ICBLK ! 281: < * ! 282: < * NAME NMBLK ! 283: < * ! 284: < * PATTERN P0BLK OR P1BLK OR P2BLK ! 285: < * ! 286: < * REAL RCBLK ! 287: < * ! 288: < * STRING SCBLK ! 289: --- ! 290: > * 6. SINCE -PRINT,-NOPRINT REMOVED IN V4, I HAVE ! 291: > * REINSTATED THE CIRCUIT IN NEXTS TO AVOID LISTING ! 292: > * CONTROL CARDS (-COPY FORCES LIST IN CNCRD THOUGH). ! 293: 226c69,70 ! 294: < * TABLE TBBLK ! 295: --- ! 296: > * 7. WA NOW CONTAINS THE INITIAL VALUE OF &CODE ON ENTRY ! 297: > * TO SPITBOL. ! 298: 228,229c72,77 ! 299: < * PROGRAM DATATYPE PDBLK ! 300: < EJC ! 301: --- ! 302: > * 8. ADDED DDC (DEFINE DISPLAY CONSTANT). IS IDENTICAL ! 303: > * TO DTC EXCEPT THAT ON SYSTEMS SUPPORTING LOWER CASE, ! 304: > * THE DISPLAY TEXT CAN BE TRANSLATED WITH A ! 305: > * CASE MIX. FOR EXAMPLE, CAPITALIZE ONLY THE FIRST ! 306: > * LETTER, OR THE FIRST LETTER OF EVERY WORD, OR NO ! 307: > * UPPER CASE (FOR EUNICHS), ETC. ! 308: 231,232c79,81 ! 309: < * REPRESENTATION OF VARIABLES ! 310: < * --------------------------- ! 311: --- ! 312: > * 9. FIX MINOR OVERSIGHT IN FAILING TO CLEAR R$PMB AT ! 313: > * END OF PATTERN MATCH, THUS LEAVING PTR TO BCBLK ! 314: > * THAT CANNOT BE COLLECTED. ! 315: 234,238c83,92 ! 316: < * DURING THE COURSE OF EVALUATING EXPRESSIONS, IT IS ! 317: < * NECESSARY TO GENERATE NAMES OF VARIABLES (FOR EXAMPLE ! 318: < * ON THE LEFT SIDE OF A BINARY EQUALS OPERATOR). THESE ARE ! 319: < * NOT TO BE CONFUSED WITH OBJECTS OF DATATYPE NAME WHICH ! 320: < * ARE IN FACT VALUES. ! 321: --- ! 322: > * 10. AFTER CONSULTATION WITH DAVE SHIELDS, IT WAS AGREED ! 323: > * TO REINSTATE ARG,FIELD,ITEM AND LOCAL FUNCTIONS. ! 324: > * COMMENTS WERE RECEIVED THAT REMOVING THEM BREAKS ! 325: > * EXISTING CODE IN DIFFICULT-TO-FIX WAYS, INCLUDING ! 326: > * A NUMBER OF THE UTILITY ROUTINES IN GIMPELS BOOK. ! 327: > * IN ANY EVENT, THESE ARE SNOBOL4 COMPATIBILITY ! 328: > * FUNCTIONS THAT TAKE LITTLE CODE SPACE. AS A ! 329: > * RESULT OF THIS, AND -COPY, ERROR NUMBERS HAVE ! 330: > * BEEN PUSHED BACK OVER THE 255 THRESHOLD, WHICH ! 331: > * SEEMS UNAVOIDABLE UNLESS MAJOR SURGERY IS DONE. ! 332: 240,250c94,95 ! 333: < * FROM A LOGICAL POINT OF VIEW, SUCH NAMES COULD BE SIMPLY ! 334: < * REPRESENTED BY A POINTER TO THE APPROPRIATE VALUE CELL. ! 335: < * HOWEVER IN THE CASE OF ARRAYS AND PROGRAM DEFINED ! 336: < * DATATYPES, THIS WOULD VIOLATE THE RULE THAT THERE MUST BE ! 337: < * NO POINTERS INTO THE MIDDLE OF A BLOCK IN DYNAMIC STORE. ! 338: < * ACCORDINGLY, A NAME IS ALWAYS REPRESENTED BY A BASE AND ! 339: < * OFFSET. THE BASE POINTS TO THE START OF THE BLOCK ! 340: < * CONTAINING THE VARIABLE VALUE AND THE OFFSET IS THE ! 341: < * OFFSET WITHIN THIS BLOCK IN BYTES. THUS THE ADDRESS ! 342: < * OF THE ACTUAL VARIABLE IS DETERMINED BY ADDING THE BASE ! 343: < * AND OFFSET VALUES. ! 344: --- ! 345: > * 11. VERSION ID CHANGED TO V4.3 DUE TO SUBSTANTIAL ! 346: > * CHANGES. ! 347: 252,253c97,98 ! 348: < * THE FOLLOWING ARE THE INSTANCES OF VARIABLES REPRESENTED ! 349: < * IN THIS MANNER. ! 350: --- ! 351: > * 12. PERMIT DOLLAR SIGN IN VARIABLE NAMES. MINOR ! 352: > * CHANGE TO OPERATOR TABLE AND SCANE. ! 353: 255,256c100,103 ! 354: < * 1) NATURAL VARIABLE BASE IS PTR TO VRBLK ! 355: < * OFFSET IS *VRVAL ! 356: --- ! 357: > * 13. PERMIT BUFFER TYPE FOR LOAD SPECIFICATION. AS ! 358: > * A SIDE-EFFECT, THE CODE FOR BUFFER CONVERSION HAS ! 359: > * BEEN CENTRALIZED IN GTBUF. ALSO FIXED PADDING ! 360: > * BUG IN INSBF RELATED TO ZERO PADDING. ! 361: 258,259c105,108 ! 362: < * 2) TABLE ELEMENT BASE IS PTR TO TEBLK ! 363: < * OFFSET IS *TEVAL ! 364: --- ! 365: > * 14. DOCUMENT THAT SYSIL MUST NEVER REQUEST ZERO BYTES. ! 366: > * DOING SO CAUSES ACESS TO POTENTIALLY CREATE ! 367: > * INVALID MEMORY CAUSING LATER GARBAGE COLLECTOR ! 368: > * PROBLEMS OR MISADJUSTMENTS OF DNAMP, ETC. ! 369: 261,262c110,112 ! 370: < * 3) ARRAY ELEMENT BASE IS PTR TO ARBLK ! 371: < * OFFSET IS OFFSET TO ELEMENT ! 372: --- ! 373: > * 15. VDIFFER FUNCTION ADDED. VDIFFER(X,Y) RETURNS X ! 374: > * IF DIFFERENT FROM Y. IN MOST CASES IT IS EXPECTED ! 375: > * THAT Y WOULD BE NULL. ! 376: 264,281c114 ! 377: < * 4) VECTOR ELEMENT BASE IS PTR TO VCBLK ! 378: < * OFFSET IS OFFSET TO ELEMENT ! 379: < * ! 380: < * 5) PROG DEF DTP BASE IS PTR TO PDBLK ! 381: < * OFFSET IS OFFSET TO FIELD VALUE ! 382: < * ! 383: < * IN ADDITION THERE ARE TWO CASES OF OBJECTS WHICH ARE ! 384: < * LIKE VARIABLES BUT CANNOT BE HANDLED IN THIS MANNER. ! 385: < * THESE ARE CALLED PSEUDO-VARIABLES AND ARE REPRESENTED ! 386: < * WITH A SPECIAL BASE POINTER AS FOLLOWS= ! 387: < * ! 388: < * EXPRESSION VARIABLE PTR TO EVBLK (SEE EVBLK) ! 389: < * ! 390: < * KEYWORD VARIABLE PTR TO KVBLK (SEE KVBLK) ! 391: < * ! 392: < * PSEUDO-VARIABLES ARE HANDLED AS SPECIAL CASES BY THE ! 393: < * ACCESS PROCEDURE (ACESS) AND THE ASSIGNMENT PROCEDURE ! 394: < * (ASIGN). SEE THESE TWO PROCEDURES FOR DETAILS. ! 395: --- ! 396: > SEC FORMAL START OF PROCEDURES SECTION ! 397: 284,411d116 ! 398: < * ORGANIZATION OF DATA AREA ! 399: < * ------------------------- ! 400: < * ! 401: < * ! 402: < * THE DATA AREA IS DIVIDED INTO TWO REGIONS. ! 403: < * ! 404: < * STATIC AREA ! 405: < * ! 406: < * THE STATIC AREA BUILDS UP FROM THE BOTTOM AND CONTAINS ! 407: < * DATA AREAS WHICH ARE ALLOCATED DYNAMICALLY BUT ARE NEVER ! 408: < * DELETED OR MOVED AROUND. THE MACRO-PROGRAM ITSELF ! 409: < * USES THE STATIC AREA FOR THE FOLLOWING. ! 410: < * ! 411: < * 1) ALL VARIABLE BLOCKS (VRBLK). ! 412: < * ! 413: < * 2) THE HASH TABLE FOR VARIABLE BLOCKS. ! 414: < * ! 415: < * 3) MISCELLANEOUS BUFFERS AND WORK AREAS (SEE PROGRAM ! 416: < * INITIALIZATION SECTION). ! 417: < * ! 418: < * IN ADDITION, THE SYSTEM PROCEDURES MAY USE THIS AREA FOR ! 419: < * INPUT/OUTPUT BUFFERS, EXTERNAL FUNCTIONS ETC. SPACE IN ! 420: < * THE STATIC REGION IS ALLOCATED BY CALLING PROCEDURE ALOST ! 421: < * ! 422: < * THE FOLLOWING GLOBAL VARIABLES DEFINE THE CURRENT ! 423: < * LOCATION AND SIZE OF THE STATIC AREA. ! 424: < * ! 425: < * STATB ADDRESS OF START OF STATIC AREA ! 426: < * STATE ADDRESS+1 OF LAST WORD IN AREA. ! 427: < * ! 428: < * THE MINIMUM SIZE OF STATIC IS GIVEN APPROXIMATELY BY ! 429: < * 12 + *E$HNB + *E$STS + SPACE FOR ALPHABET STRING ! 430: < * AND STANDARD PRINT BUFFER. ! 431: < EJC ! 432: < * ! 433: < * DYNAMIC AREA ! 434: < * ! 435: < * THE DYNAMIC AREA IS BUILT UPWARDS IN MEMORY AFTER THE ! 436: < * STATIC REGION. DATA IN THIS AREA MUST ALL BE IN STANDARD ! 437: < * BLOCK FORMATS SO THAT IT CAN BE PROCESSED BY THE GARBAGE ! 438: < * COLLECTOR (PROCEDURE GBCOL). GBCOL COMPACTS BLOCKS DOWN ! 439: < * IN THIS REGION AS REQUIRED BY SPACE EXHAUSTION AND CAN ! 440: < * ALSO MOVE ALL BLOCKS UP TO ALLOW FOR EXPANSION OF THE ! 441: < * STATIC REGION. ! 442: < * WITH THE EXCEPTION OF TABLES AND ARRAYS, NO SPITBOL ! 443: < * OBJECT ONCE BUILT IN DYNAMIC MEMORY IS EVER SUBSEQUENTLY ! 444: < * MODIFIED. OBSERVING THIS RULE NECESSITATES A COPYING ! 445: < * ACTION DURING STRING AND PATTERN CONCATENATION. ! 446: < * ! 447: < * GARBAGE COLLECTION IS FUNDAMENTAL TO THE ALLOCATION OF ! 448: < * SPACE FOR VALUES. SPITBOL USES A VERY EFFICIENT GARBAGE ! 449: < * COLLECTOR WHICH INSISTS THAT POINTERS INTO DYNAMIC STORE ! 450: < * SHOULD BE IDENTIFIABLE WITHOUT USE OF BIT TABLES, ! 451: < * MARKER BITS ETC. TO SATISFY THIS REQUIREMENT, DYNAMIC ! 452: < * MEMORY MUST NOT START AT TOO LOW AN ADDRESS AND LENGTHS ! 453: < * OF ARRAYS, TABLES, STRINGS, CODE AND EXPRESSION BLOCKS ! 454: < * MAY NOT EXCEED THE NUMERICAL VALUE OF THE LOWEST DYNAMIC ! 455: < * ADDRESS. TO AVOID EITHER PENALIZING USERS WITH MODEST ! 456: < * REQUIREMENTS OR RESTRICTING THOSE WITH GREATER NEEDS ON ! 457: < * HOST SYSTEMS WHERE DYNAMIC MEMORY IS ALLOCATED IN LOW ! 458: < * ADDRESSES, THE MINIMUM DYNAMIC ADDRESS MAY BE SPECIFIED ! 459: < * SUFFICIENTLY HIGH TO PERMIT ARBITRARILY LARGE SPITBOL ! 460: < * OBJECTS TO BE CREATED ( WITH THE POSSIBILITY IN EXTREME ! 461: < * CASES OF WASTING LARGE AMOUNTS OF MEMORY BELOW THE ! 462: < * START ADDRESS). THIS MINIMUM VALUE IS MADE AVAILABLE ! 463: < * IN VARIABLE MXLEN BY A SYSTEM ROUTINE, SYSMX. ! 464: < * ALTERNATIVELY SYSMX MAY INDICATE THAT A ! 465: < * DEFAULT MAY BE USED IN WHICH DYNAMIC IS PLACED ! 466: < * AT THE LOWEST POSSIBLE ADDRESS FOLLOWING STATIC. ! 467: < * ! 468: < * THE FOLLOWING GLOBAL WORK CELLS DEFINE THE LOCATION AND ! 469: < * LENGTH OF THE DYNAMIC AREA. ! 470: < * ! 471: < * DNAMB START OF DYNAMIC AREA ! 472: < * DNAMP NEXT AVAILABLE LOCATION ! 473: < * DNAME LAST AVAILABLE LOCATION + 1 ! 474: < * ! 475: < * DNAMB IS ALWAYS HIGHER THAN STATE SINCE THE ALOST ! 476: < * PROCEDURE MAINTAINS SOME EXPANSION SPACE ABOVE STATE. ! 477: < * *** DNAMB MUST NEVER BE PERMITTED TO HAVE A VALUE LESS ! 478: < * THAN THAT IN MXLEN *** ! 479: < * ! 480: < * SPACE IN THE DYNAMIC REGION IS ALLOCATED BY THE ALLOC ! 481: < * PROCEDURE. THE DYNAMIC REGION MAY BE USED BY SYSTEM ! 482: < * PROCEDURES PROVIDED THAT ALL THE RULES ARE OBEYED. ! 483: < EJC ! 484: < * ! 485: < * REGISTER USAGE ! 486: < * -------------- ! 487: < * ! 488: < * (CP) CODE POINTER REGISTER. USED TO ! 489: < * HOLD A POINTER TO THE CURRENT ! 490: < * LOCATION IN THE INTERPRETIVE PSEUDO ! 491: < * CODE (I.E. PTR INTO A CDBLK). ! 492: < * ! 493: < * (XL,XR) GENERAL INDEX REGISTERS. USUALLY ! 494: < * USED TO HOLD POINTERS TO BLOCKS IN ! 495: < * DYNAMIC STORAGE. AN IMPORTANT ! 496: < * RESTRICTION IS THAT THE VALUE IN ! 497: < * XL MUST BE COLLECTABLE FOR ! 498: < * A GARBAGE COLLECT CALL. A VALUE ! 499: < * IS COLLECTABLE IF IT EITHER POINTS ! 500: < * OUTSIDE THE DYNAMIC AREA, OR IF IT ! 501: < * POINTS TO THE START OF A BLOCK IN ! 502: < * THE DYNAMIC AREA. ! 503: < * ! 504: < * (XS) STACK POINTER. USED TO POINT TO ! 505: < * THE STACK FRONT. THE STACK MAY ! 506: < * BUILD UP OR DOWN AND IS USED ! 507: < * TO STACK SUBROUTINE RETURN POINTS ! 508: < * AND OTHER RECURSIVELY SAVED DATA. ! 509: < * ! 510: < * (XT) AN ALTERNATIVE NAME FOR XL DURING ! 511: < * ITS USE IN ACCESSING STACKED ITEMS. ! 512: < * ! 513: < * (WA,WB,WC) GENERAL WORK REGISTERS. CANNOT BE ! 514: < * USED FOR INDEXING, BUT MAY HOLD ! 515: < * VARIOUS TYPES OF DATA. ! 516: < * ! 517: < * (IA) USED FOR ALL SIGNED INTEGER ! 518: < * ARITHMETIC, BOTH THAT USED BY THE ! 519: < * TRANSLATOR AND THAT ARISING FROM ! 520: < * USE OF SNOBOL4 ARITHMETIC OPERATORS ! 521: < * ! 522: < * (RA) REAL ACCUMULATOR. USED FOR ALL ! 523: < * FLOATING POINT ARITHMETIC. ! 524: < EJC ! 525: < * ! 526: 416,422c121,134 ! 527: < * ASSEMBLY SYMBOLS ARE REFERRED TO. TO INCORPORATE THE ! 528: < * FEATURES REFERRED TO, THE MINIMAL SOURCE SHOULD BE ! 529: < * PREFACED BY SUITABLE CONDITIONAL ASSEMBLY SYMBOL ! 530: < * DEFINITIONS. ! 531: < * IN ALL CASES IT IS PERMISSIBLE TO DEFAULT THE DEFINITIONS ! 532: < * IN WHICH CASE THE ADDITIONAL FEATURES WILL BE OMITTED ! 533: < * FROM THE TARGET CODE. ! 534: --- ! 535: > * ASSEMBLY SYMBOLS ARE REFERRED TO. ! 536: > * A PARTICULAR SET OF DEFAULT SETTINGS IS GIVEN IN THIS ! 537: > * SOURCE BY USE OF .DEF AND .UNDEF PSEUDO OPS. ! 538: > * A DIFFERENT SELECTION MAY BE MADE BY VARYING THE ! 539: > * DEFINITIONS. AS AN ALTERNATIVE, THIS SECTION MAY BE ! 540: > * COMMENTED OUT AND THE MINIMAL TRANSLATOR PRELOADED WITH ! 541: > * THE SELECTED DEFINITIONS, THUS ALLOWING A MORE DYNAMIC ! 542: > * CHOICE TO BE MADE. ! 543: > * SOME OF THE CONDITIONAL FEATURES CHOOSE AMONGST A VARIETY ! 544: > * OF OPTIONS. OTHERS ARE DEFINED PRINCIPALLY TO ALLOW ! 545: > * OMISSION OF A FEATURE WHICH IS NOT WANTED IN ORDER TO ! 546: > * SAVE MEMORY OR BECAUSE IT CANNOT BE SUPPORTED. ! 547: > * NOTE THAT IF .CPLC OPTION IS CHOSEN, TRANSLATION OF DTC, ! 548: > * ERR, ERB ARGUMENTS SHOULD BE TO LOWER CASE. ! 549: 424,505c136,158 ! 550: < * .CASL DEFINE TO INCLUDE 26 SHIFTED LETTRS ! 551: < * .CAHT DEFINE TO INCLUDE HORIZONTAL TAB ! 552: < * .CAVT DEFINE TO INCLUDE VERTICAL TAB ! 553: < * .CIOD IF DEFINED, DEFAULT DELIMITER IS ! 554: < * NOT USED IN PROCESSING 3RD ARG OF ! 555: < * INPUT() AND OUTPUT() ! 556: < * .CNBT DEFINE TO OMIT BATCH INITIALISATION ! 557: < * .CNCI DEFINE TO ENABLE SYSCI ROUTINE ! 558: < * .CNEX DEFINE TO OMIT EXIT() CODE. ! 559: < * .CNLD DEFINE TO OMIT LOAD() CODE. ! 560: < * .CNPF DEFINE TO OMIT PROFILE STUFF ! 561: < * .CNRA DEFINE TO OMIT ALL REAL ARITHMETIC ! 562: < * .CNSR DEFINE TO OMIT SORT, RSORT ! 563: < * .CSAX DEFINE IF SYSAX IS TO BE CALLED ! 564: < * .CSN6 DEFINE TO PAD STMT NOS TO 6 CHARS ! 565: < * .CSN8 DEFINE TO PAD STMT NOS TO 8 CHARS ! 566: < * .CUCF DEFINE TO INCLUDE CFP$U ! 567: < * .CULC DEFINE TO INCLUDE &CASE (LC NAMES) ! 568: < * .CUST DEFINE TO INCLUDE SET() CODE ! 569: < .DEF .CASL ! 570: < .DEF .CAHT ! 571: < .DEF .CIOD ! 572: < .DEF .CSAX ! 573: < .DEF .CSN8 ! 574: < .DEF .CUCF ! 575: < .DEF .CUEJ ! 576: < .DEF .CULC ! 577: < .DEF .CUST ! 578: < TTL S P I T B O L -- PROCEDURES SECTION ! 579: < * ! 580: < * THIS SECTION STARTS WITH DESCRIPTIONS OF THE OPERATING ! 581: < * SYSTEM DEPENDENT PROCEDURES WHICH ARE USED BY THE SPITBOL ! 582: < * TRANSLATOR. ALL SUCH PROCEDURES HAVE FIVE LETTER NAMES ! 583: < * BEGINNING WITH SYS. THEY ARE LISTED IN ALPHABETICAL ! 584: < * ORDER. ! 585: < * ALL PROCEDURES HAVE A SPECIFICATION CONSISTING OF A ! 586: < * MODEL CALL, PRECEDED BY A POSSIBLY EMPTY LIST OF REGISTER ! 587: < * CONTENTS GIVING PARAMETERS AVAILABLE TO THE PROCEDURE AND ! 588: < * FOLLOWED BY A POSSIBLY EMPTY LIST OF REGISTER CONTENTS ! 589: < * REQUIRED ON RETURN FROM THE CALL OR WHICH MAY HAVE HAD ! 590: < * THEIR CONTENTS DESTROYED. ONLY THOSE REGISTERS EXPLICITLY ! 591: < * MENTIONED IN THE LIST AFTER THE CALL MAY HAVE THEIR ! 592: < * VALUES CHANGED. ! 593: < * THE SEGMENT OF CODE PROVIDING THE EXTERNAL PROCEDURES IS ! 594: < * CONVENIENTLY REFERRED TO AS OSINT (OPERATING SYSTEM ! 595: < * INTERFACE). THE SYSXX PROCEDURES IT CONTAINS PROVIDE ! 596: < * FACILITIES NOT USUALLY AVAILABLE AS PRIMITIVES IN ! 597: < * ASSEMBLY LANGUAGES. FOR PARTICULAR TARGET MACHINES, ! 598: < * IMPLEMENTORS MAY CHOOSE FOR SOME MINIMAL OPCODES WHICH ! 599: < * DO NOT HAVE REASONABLY DIRECT TRANSLATIONS, TO USE CALLS ! 600: < * OF ADDITIONAL PROCEDURES WHICH THEY PROVIDE IN OSINT. ! 601: < * E.G. MWB OR TRC MIGHT BE TRANSLATED AS JSR SYSMB, ! 602: < * JSR SYSTC IN SOME IMPLEMENTATIONS. ! 603: < * ! 604: < * IN THE DESCRIPTIONS, REFERENCE IS MADE TO --BLK ! 605: < * FORMATS (-- = A PAIR OF LETTERS). SEE THE SPITBOL ! 606: < * DEFINITIONS SECTION FOR DETAILED DESCRIPTIONS OF ALL ! 607: < * SUCH BLOCK FORMATS EXCEPT FCBLK FOR WHICH SYSFC SHOULD ! 608: < * BE CONSULTED. ! 609: < * ! 610: < * SECTION 0 CONTAINS INP,INR SPECIFICATIONS OF INTERNAL ! 611: < * PROCEDURES,ROUTINES. THIS GIVES A SINGLE PASS TRANSLATOR ! 612: < * INFORMATION MAKING IT EASY TO GENERATE ALTERNATIVE CALLS ! 613: < * IN THE TRANSLATION OF JSR-S FOR PROCEDURES OF DIFFERENT ! 614: < * TYPES IF THIS PROVES NECESSARY. ! 615: < * ! 616: < SEC START OF PROCEDURES SECTION ! 617: < .IF .CSAX ! 618: < EJC ! 619: < * ! 620: < * SYSAX -- AFTER EXECUTION ! 621: < * ! 622: < SYSAX EXP DEFINE EXTERNAL ENTRY POINT ! 623: < * ! 624: < * IF THE CONDITIONAL ASSEMBLY SYMBOL .CSAX IS DEFINED, ! 625: < * THIS ROUTINE IS CALLED IMMEDIATELY AFTER EXECUTION AND ! 626: < * BEFORE PRINTING OF EXECUTION STATISTICS OR DUMP OUTPUT. ! 627: < * PURPOSE OF CALL IS FOR IMPLEMENTOR TO DETERMINE AND ! 628: < * IF THE CALL IS NOT REQUIRED IT WILL BE OMITTED IF .CSAX ! 629: < * IS UNDEFINED. IN THIS CASE SYSAX NEED NOT BE CODED. ! 630: < * ! 631: < * JSR SYSAX CALL AFTER EXECUTION ! 632: --- ! 633: > *.DEF .CAHT DEFINE TO INCLUDE HORIZONTAL TAB ! 634: > *.DEF .CASL DEFINE TO INCLUDE 26 SHIFTED LETTRS ! 635: > *.DEF .CAVT DEFINE TO INCLUDE VERTICAL TAB ! 636: > *.UNDEF .CEPP DEFINE FOR ODD PARITY ENTRY POINTS ! 637: > *.UNDEF .CNBF DEFINE TO OMIT BUFFER EXTENSION ! 638: > *.UNDEF .CNBT DEFINE TO OMIT BATCH INITIALISATION ! 639: > *.UNDEF .CNEX DEFINE TO OMIT EXIT() CODE ! 640: > *.UNDEF .CNFN DEFINE TO OMIT FENCE() CODE ! 641: > *.UNDEF .CNLD DEFINE TO OMIT LOAD() CODE ! 642: > *.UNDEF .CNPF DEFINE TO OMIT PROFILE CODE ! 643: > *.UNDEF .CNRA DEFINE TO OMIT ALL REAL ARITHMETIC ! 644: > *.UNDEF .CNSR DEFINE TO OMIT SORT, RSORT CODE ! 645: > *.DEF .CPLC DEFINE IF HOST PREFERS LOWER CASE ! 646: > *.UNDEF .CRPP DEFINE FOR ODD PARITY RETURN POINTS ! 647: > *.UNDEF .CS16 DEFINE TO INITIALIZE STLIM TO 32767 ! 648: > *.UNDEF .CSAX DEFINE IF SYSAX IS TO BE CALLED ! 649: > *.UNDEF .CSCI DEFINE TO ENABLE SYSCI ROUTINE ! 650: > *.UNDEF .CSCV DEFINE FOR CLU, CUL CASE CONVERSION ! 651: > *.DEF .CSIG DEFINE TO IGNORE CASE OF LETTERS ! 652: > *.UNDEF .CSN6 DEFINE TO PAD STMT NOS TO 6 CHARS ! 653: > *.DEF .CSN8 DEFINE TO PAD STMT NOS TO 8 CHARS ! 654: > *.UNDEF .CTMD DEFINE IF SYSTM UNIT IS DECISECOND ! 655: > .IF .CASL ! 656: 506a160,161 ! 657: > .UNDEF .CSIG .CSIG USELESS WITHOUT LC LETTERS ! 658: > .UNDEF .CPLC .CPLC ERRONEOUS WITHOUT LC LETTERS ! 659: 510c165 ! 660: < * SYSBX -- BEFORE EXECUTION ! 661: --- ! 662: > * ACTUAL PROCESSABLE EXP PROCEDURE DEFINITIONS ! 663: 512,547c167,169 ! 664: < SYSBX EXP DEFINE EXTERNAL ENTRY POINT ! 665: < * ! 666: < * CALLED AFTER INITIAL SPITBOL COMPILATION AND BEFORE ! 667: < * COMMENCING EXECUTION IN CASE OSINT NEEDS ! 668: < * TO ASSIGN FILES OR PERFORM OTHER NECESSARY SERVICES. ! 669: < * OSINT MAY ALSO CHOOSE TO SEND A MESSAGE TO ONLINE ! 670: < * TERMINAL (IF ANY) INDICATING THAT EXECUTION IS STARTING. ! 671: < * ! 672: < * JSR SYSBX CALL BEFORE EXECUTION STARTS ! 673: < EJC ! 674: < .IF .CNCI ! 675: < * ! 676: < * SYSCI -- CONVERT INTEGER ! 677: < * ! 678: < SYSCI EXP ! 679: < * ! 680: < * SYSCI IS AN OPTIONAL OSINT ROUTINE THAT CAUSES SPITBOL TO ! 681: < * CALL SYSCI TO CONVERT INTEGER VALUES TO STRINGS, RATHER ! 682: < * THAN USING SPITBOL'S OWN INTERNAL CONVERSION CODE. THIS ! 683: < * CODE MAY BE LESS EFFICIENT ON MACHINES WITH HARDWARE ! 684: < * CONVERSION INSTRUCTIONS AND IN SUCH CASES, IT MAY BE AN ! 685: < * ADVANTAGE TO INCLUDE SYSCI. THE SYMBOL .CNCI MUST BE ! 686: < * DEFINED IF THIS ROUTINE IS TO BE USED. ! 687: < * ! 688: < * THE RULES FOR CONVERTING INTEGERS TO STRINGS ARE THAT ! 689: < * POSITIVE VALUES ARE REPRESENTED WITHOUT ANY SIGN, AND ! 690: < * THERE ARE NEVER ANY LEADING BLANKS OR ZEROS, EXCEPT IN ! 691: < * THE CASE OF ZERO ITSELF WHICH IS REPRESENTED AS A SINGLE ! 692: < * ZERO DIGIT. NEGATIVE NUMBERS ARE REPRESENTED WITH A ! 693: < * PRECEEDING MINUS SIGN. THERE ARE NEVER ANY TRAILING ! 694: < * BLANKS, AND CONVERSION CANNOT FAIL. ! 695: < * ! 696: < * (IA) VALUE TO BE CONVERTED ! 697: < * JSR SYSCI CALL TO CONVERT INTEGER VALUE ! 698: < * (XL) POINTER TO PSEUDO-SCBLK WITH STRING ! 699: < EJC ! 700: --- ! 701: > .IF .CSAX ! 702: > SYSAX EXP E,0 ! 703: > .ELSE ! 704: 549,1250c171,203 ! 705: < * ! 706: < * SYSDC -- DATE CHECK ! 707: < * ! 708: < SYSDC EXP DEFINE EXTERNAL ENTRY POINT ! 709: < * ! 710: < * SYSDC IS CALLED TO CHECK THAT THE EXPIRY DATE FOR A TRIAL ! 711: < * VERSION OF SPITBOL IS UNEXPIRED. ! 712: < * ! 713: < * JSR SYSDC CALL TO CHECK DATE ! 714: < * RETURN ONLY IF DATE IS OK ! 715: < EJC ! 716: < * ! 717: < * SYSDM -- DUMP CORE ! 718: < * ! 719: < SYSDM EXP DEFINE EXTERNAL ENTRY POINT ! 720: < * ! 721: < * SYSDM IS CALLED BY A SPITBOL PROGRAM CALL OF DUMP(N) WITH ! 722: < * N GE 3. ITS PURPOSE IS TO PROVIDE A CORE DUMP. ! 723: < * N COULD HOLD AN ENCODING OF THE START ADRS FOR DUMP AND ! 724: < * AMOUNT TO BE DUMPED E.G. N = 256*A + S , S = START ADRS ! 725: < * IN KILOWORDS, A = KILOWORDS TO DUMP ! 726: < * ! 727: < * (XR) PARAMETER N OF CALL DUMP(N) ! 728: < * JSR SYSDM CALL TO ENTER ROUTINE ! 729: < EJC ! 730: < * ! 731: < * SYSDT -- GET CURRENT DATE ! 732: < * ! 733: < SYSDT EXP DEFINE EXTERNAL ENTRY POINT ! 734: < * ! 735: < * SYSDT IS USED TO OBTAIN THE CURRENT DATE. THE DATE IS ! 736: < * RETURNED AS A CHARACTER STRING IN ANY FORMAT APPROPRIATE ! 737: < * TO THE OPERATING SYSTEM IN USE. IT MAY ALSO CONTAIN THE ! 738: < * CURRENT TIME OF DAY. SYSDT IS USED TO IMPLEMENT THE ! 739: < * SNOBOL4 FUNCTION DATE. ! 740: < * ! 741: < * JSR SYSDT CALL TO GET DATE ! 742: < * (XL) POINTER TO BLOCK CONTAINING DATE ! 743: < * ! 744: < * THE FORMAT OF THE BLOCK IS LIKE AN SCBLK EXCEPT THAT ! 745: < * THE FIRST WORD NEED NOT BE SET. THE RESULT IS COPIED ! 746: < * INTO SPITBOL DYNAMIC MEMORY ON RETURN. ! 747: < EJC ! 748: < * ! 749: < * SYSEF -- EJECT FILE ! 750: < * ! 751: < SYSEF EXP DEFINE EXTERNAL ENTRY POINT ! 752: < * ! 753: < * SYSEF IS USED TO WRITE A PAGE EJECT TO A NAMED FILE. IT ! 754: < * MAY ONLY BE USED FOR FILES WHERE THIS CONCEPT MAKES ! 755: < * SENSE. NOTE THAT SYSEF IS NOT NORMALLY USED FOR THE ! 756: < * STANDARD OUTPUT FILE (SEE SYSEP). ! 757: < * ! 758: < * (WA) PTR TO FCBLK OR ZERO ! 759: < * (XR) EJECT ARGUMENT (SCBLK PTR) ! 760: < * JSR SYSEF CALL TO EJECT FILE ! 761: < * PPM LOC RETURN HERE IF FILE DOES NOT EXIST ! 762: < * PPM LOC RETURN HERE IF INAPPROPRIATE FILE ! 763: < * PPM LOC RETURN HERE IF I/O ERROR ! 764: < EJC ! 765: < * ! 766: < * SYSEJ -- END OF JOB ! 767: < * ! 768: < SYSEJ EXP DEFINE EXTERNAL ENTRY POINT ! 769: < * ! 770: < * SYSEJ IS CALLED ONCE AT THE END OF EXECUTION TO ! 771: < * TERMINATE THE RUN. THE SIGNIFICANCE OF THE ABEND AND ! 772: < * CODE VALUES IS SYSTEM DEPENDENT. IN GENERAL, THE CODE ! 773: < * VALUE SHOULD BE MADE AVAILABLE FOR TESTING, AND THE ! 774: < * ABEND VALUE SHOULD CAUSE SOME POST-MORTEM ACTION SUCH AS ! 775: < * A DUMP. NOTE THAT SYSEJ DOES NOT RETURN TO ITS CALLER. ! 776: < * SEE SYSXI FOR DETAILS OF FCBLK CHAIN ! 777: < * ! 778: < * (WA) VALUE OF ABEND KEYWORD ! 779: < * (WB) VALUE OF CODE KEYWORD ! 780: < * (XL) O OR PTR TO HEAD OF FCBLK CHAIN ! 781: < * JSR SYSEJ CALL TO END JOB ! 782: < * ! 783: < * THE FOLLOWING SPECIAL VALUES ARE USED AS CODES IN (WB) ! 784: < * 999 EXECUTION SUPPRESSED ! 785: < * 998 STANDARD OUTPUT FILE FULL OR UNAVAILABLE IN A SYSXI ! 786: < * LOAD MODULE. IN THESE CASES (WA) CONTAINS THE NUMBER ! 787: < * OF THE STATEMENT CAUSING PREMATURE TERMINATION. ! 788: < EJC ! 789: < * ! 790: < * SYSEM -- GET ERROR MESSAGE TEXT ! 791: < * ! 792: < SYSEM EXP DEFINE EXTERNAL ENTRY POINT ! 793: < * ! 794: < * SYSEM IS USED TO OBTAIN THE TEXT OF ERR, ERB CALLS IN THE ! 795: < * SOURCE PROGRAM GIVEN THE ERROR CODE NUMBER. IT IS ALLOWED ! 796: < * TO RETURN A NULL STRING IF THIS FACILITY IS UNAVAILABLE. ! 797: < * ! 798: < * (WA) ERROR CODE NUMBER ! 799: < * JSR SYSEM CALL TO GET TEXT ! 800: < * (XR) TEXT OF MESSAGE ! 801: < * ! 802: < * THE RETURNED VALUE IS A POINTER TO A BLOCK IN SCBLK ! 803: < * FORMAT EXCEPT THAT THE FIRST WORD NEED NOT BE SET. THE ! 804: < * STRING IS COPIED INTO DYNAMIC MEMORY ON RETURN. ! 805: < * IF THE NULL STRING IS RETURNED EITHER BECAUSE SYSEM DOES ! 806: < * NOT PROVIDE ERROR MESSAGE TEXTS OR BECAUSE WA IS OUT OF ! 807: < * RANGE, SPITBOL WILL PRINT THE STRING STORED IN ERRTEXT ! 808: < * KEYWORD. ! 809: < EJC ! 810: < * ! 811: < * SYSEN -- ENDFILE ! 812: < * ! 813: < SYSEN EXP DEFINE EXTERNAL ENTRY POINT ! 814: < * ! 815: < * SYSEN IS USED TO IMPLEMENT THE SNOBOL4 FUNCTION ENDFILE. ! 816: < * THE MEANING IS SYSTEM DEPENDENT. IN GENERAL, ENDFILE ! 817: < * IMPLIES THAT NO FURTHER I/O OPERATIONS WILL BE PERFORMED, ! 818: < * BUT DOES NOT GUARANTEE THIS TO BE THE CASE. THE FILE ! 819: < * SHOULD BE CLOSED AFTER THE CALL, A SUBSEQUENT READ ! 820: < * OR WRITE MAY REOPEN THE FILE AT THE START OR IT MAY BE ! 821: < * NECESSARY TO REOPEN THE FILE VIA SYSIO. ! 822: < * ! 823: < * (WA) PTR TO FCBLK OR ZERO ! 824: < * (XR) ENDFILE ARGUMENT (SCBLK PTR) ! 825: < * JSR SYSEN CALL TO ENDFILE ! 826: < * PPM LOC RETURN HERE IF FILE DOES NOT EXIST ! 827: < * PPM LOC RETURN HERE IF ENDFILE NOT ALLOWED ! 828: < * PPM LOC RETURN HERE IF I/O ERROR ! 829: < * (WA,WB) DESTROYED ! 830: < * ! 831: < * THE SECOND ERROR RETURN IS USED FOR FILES FOR WHICH ! 832: < * ENDFILE IS NOT PERMITTED. FOR EXAMPLE, IT MAY BE EXPECTED ! 833: < * THAT THE STANDARD INPUT AND OUTPUT FILES ARE IN THIS ! 834: < * CATEGORY. ! 835: < EJC ! 836: < * ! 837: < * SYSEP -- EJECT PRINTER PAGE ! 838: < * ! 839: < SYSEP EXP DEFINE EXTERNAL ENTRY POINT ! 840: < * ! 841: < * SYSEP IS CALLED TO PERFORM A PAGE EJECT ON THE STANDARD ! 842: < * PRINTER OUTPUT FILE (CORRESPONDING TO SYSPR OUTPUT). ! 843: < * ! 844: < * JSR SYSEP CALL TO EJECT PRINTER OUTPUT ! 845: < EJC ! 846: < * ! 847: < * SYSEX -- CALL EXTERNAL FUNCTION ! 848: < * ! 849: < SYSEX EXP DEFINE EXTERNAL ENTRY POINT ! 850: < * ! 851: < * SYSEX IS CALLED TO PASS CONTROL TO AN EXTERNAL FUNCTION ! 852: < * PREVIOUSLY LOADED WITH A CALL TO SYSLD. ! 853: < * ! 854: < * (XS) POINTER TO ARGUMENTS ON STACK ! 855: < * (XL) POINTER TO CONTROL BLOCK (EFBLK) ! 856: < * (WA) NUMBER OF ARGUMENTS ON STACK ! 857: < * JSR SYSEX CALL TO PASS CONTROL TO FUNCTION ! 858: < * PPM LOC RETURN HERE IF FUNCTION CALL FAILS ! 859: < * (XS) POPPED PAST ARGUMENTS ! 860: < * (XR) RESULT RETURNED ! 861: < * ! 862: < * THE ARGUMENTS ARE STORED ON THE STACK WITH ! 863: < * THE LAST ARGUMENT AT 0(XS). ON RETURN, XS ! 864: < * IS POPPED PAST THE ARGUMENTS. ! 865: < * ! 866: < * THE FORM OF THE ARGUMENTS AS PASSED IS THAT USED IN THE ! 867: < * SPITBOL TRANSLATOR (SEE DEFINITIONS AND DATA STRUCTURES ! 868: < * SECTION). THE CONTROL BLOCK FORMAT IS ALSO DESCRIBED ! 869: < * (UNDER EFBLK) IN THIS SECTION. ! 870: < * ! 871: < * THERE ARE TWO WAYS OF RETURNING A RESULT. ! 872: < * ! 873: < * 1) RETURN A POINTER TO A BLOCK IN DYNAMIC STORAGE. THIS ! 874: < * BLOCK MUST BE IN EXACTLY CORRECT FORMAT, INCLUDING ! 875: < * THE FIRST WORD. ONLY FUNCTIONS WRITTEN WITH INTIMATE ! 876: < * KNOWLEDGE OF THE SYSTEM WILL RETURN IN THIS WAY. ! 877: < * ! 878: < * 2) STRING, INTEGER AND REAL RESULTS MAY BE RETURNED BY ! 879: < * POINTING TO A PSEUDO-BLOCK OUTSIDE DYNAMIC MEMORY. ! 880: < * THIS BLOCK IS IN ICBLK, RCBLK OR SCBLK FORMAT EXCEPT ! 881: < * THAT THE FIRST WORD WILL BE OVERWRITTEN ! 882: < * BY A TYPE WORD ON RETURN AND SO NEED NOT ! 883: < * BE CORRECTLY SET. SUCH A RESULT IS ! 884: < * COPIED INTO MAIN STORAGE BEFORE PROCEEDING. ! 885: < * UNCONVERTED RESULTS MAY SIMILARLY BE RETURNED IN A ! 886: < * PSEUDO-BLOCK WHICH IS IN CORRECT FORMAT INCLUDING ! 887: < * TYPE WORD RECOGNISABLE BY GARBAGE COLLECTOR SINCE ! 888: < * BLOCK IS COPIED INTO DYNAMIC MEMORY. ! 889: < EJC ! 890: < * ! 891: < * SYSFC -- FILE CONTROL BLOCK ROUTINE ! 892: < * ! 893: < SYSFC EXP DEFINE EXTERNAL ENTRY POINT ! 894: < * ! 895: < * SEE ALSO SYSIO ! 896: < * INPUT AND OUTPUT HAVE 3 ARGUMENTS REFERRED TO AS SHOWN ! 897: < * INPUT(VARIABLE NAME,FILE ARG1,FILE ARG2) ! 898: < * OUTPUT(VARIABLE NAME,FILE ARG1,FILE ARG2) ! 899: < * FILE ARG1 MAY BE AN INTEGER OR STRING USED TO IDENTIFY ! 900: < * AN I/O CHANNEL. IT IS CONVERTED TO A STRING FOR CHECKING. ! 901: < * THE EXACT SIGNIFICANCE OF FILE ARG2 ! 902: < * IS NOT RIGOROUSLY PRESCRIBED BUT TO IMPROVE PORTABILITY, ! 903: < * THE SCHEME DESCRIBED IN THE SPITBOL USER MANUAL ! 904: < * SHOULD BE ADOPTED WHEN POSSIBLE. THE PREFERRED FORM IS ! 905: < * A STRING $F$,R$R$,C$C$,I$I$,...,Z$Z$ WHERE ! 906: < * $F$ IS AN OPTIONAL FILE NAME WHICH IS PLACED FIRST. ! 907: < * REMAINING ITEMS MAY BE OMITTED OR INCLUDED IN ANY ORDER. ! 908: < * $R$ IS MAXIMUM RECORD LENGTH ! 909: < * $C$ IS A CARRIAGE CONTROL CHARACTER OR CHARACTER STRING ! 910: < * $I$ IS SOME FORM OF CHANNEL IDENTIFICATION USED IN THE ! 911: < * ABSENCE OF $F$ TO ASSOCIATE THE VARIABLE ! 912: < * WITH A FILE ALLOCATED DYNAMICALLY BY JCL COMMANDS AT ! 913: < * SPITBOL LOAD TIME. ! 914: < * ,...,Z$Z$ ARE ADDITIONAL FIELDS. ! 915: < * IF , (COMMA) CANNOT BE USED AS A DELIMITER, .CIOD ! 916: < * SHOULD BE DEFINED TO INTRODUCE BY CONDITIONAL ASSEMBLY ! 917: < * ANOTHER DELIMITER (SEE ! 918: < * IODEL EQU * ! 919: < * EARLY IN DEFINITIONS SECTION). ! 920: < * SYSFC IS CALLED WHEN A VARIABLE IS INPUT OR OUTPUT ! 921: < * ASSOCIATED TO CHECK FILE ARG1 AND FILE ARG2 AND ! 922: < * TO REPORT WHETHER AN FCBLK (FILE CONTROL ! 923: < * BLOCK) IS NECESSARY AND IF SO WHAT SIZE IT SHOULD BE. ! 924: < * THIS MAKES IT POSSIBLE FOR SPITBOL RATHER THAN OSINT TO ! 925: < * ALLOCATE SUCH A BLOCK IN DYNAMIC MEMORY IF REQUIRED ! 926: < * OR ALTERNATIVELY IN STATIC MEMORY. ! 927: < * THE SIGNIFICANCE OF AN FCBLK , IF ONE IS REQUESTED, IS ! 928: < * ENTIRELY UP TO THE SYSTEM INTERFACE. THE ONLY RESTRICTION ! 929: < * IS THAT IF THE FCBLK SHOULD APPEAR TO LIE IN DYNAMIC ! 930: < * MEMORY , POINTERS TO IT SHOULD BE PROPER POINTERS TO ! 931: < * THE START OF A RECOGNISABLE AND GARBAGE COLLECTABLE ! 932: < * BLOCK (THIS CONDITION WILL BE MET IF SYSFC REQUESTS ! 933: < * SPITBOL TO PROVIDE AN FCBLK). ! 934: < * AN OPTION IS PROVIDED FOR OSINT TO RETURN A POINTER IN ! 935: < * XL TO AN FCBLK WHICH IT PRIVATELY ALLOCATED. THIS PTR ! 936: < * WILL BE MADE AVAILABLE WHEN I/O OCCURS LATER. ! 937: < * PRIVATE FCBLKS MAY HAVE ARBITRARY CONTENTS AND SPITBOL ! 938: < * STORES NOTHING IN THEM. ! 939: < EJC ! 940: < * THE REQUESTED SIZE FOR AN FCBLK IN DYNAMIC MEMORY ! 941: < * SHOULD ALLOW A 2 WORD OVERHEAD FOR BLOCK TYPE AND ! 942: < * LENGTH FIELDS. INFORMATION SUBSEQUENTLY STORED IN THE ! 943: < * REMAINING WORDS MAY BE ARBITRARY IF AN XNBLK (EXTERNAL ! 944: < * NON-RELOCATABLE BLOCK) IS REQUESTED. IF THE REQUEST IS ! 945: < * FOR AN XRBLK (EXTERNAL RELOCATABLE BLOCK) THE ! 946: < * CONTENTS OF WORDS SHOULD BE COLLECTABLE (I.E. ANY ! 947: < * APPARENT POINTERS INTO DYNAMIC SHOULD BE GENUINE BLOCK ! 948: < * POINTERS). THESE RESTRICTIONS DO NOT APPLY IF AN FCBLK ! 949: < * IS ALLOCATED OUTSIDE DYNAMIC OR IS NOT ALLOCATED AT ALL. ! 950: < * IF AN FCBLK IS REQUESTED, ITS FIELDS WILL BE INITIALISED ! 951: < * TO ZERO BEFORE ENTRY TO SYSIO WITH THE EXCEPTION OF ! 952: < * WORDS 0 AND 1 IN WHICH THE BLOCK TYPE AND LENGTH ! 953: < * FIELDS ARE PLACED FOR FCBLKS IN DYNAMIC MEMORY ONLY. ! 954: < * FOR THE POSSIBLE USE OF SYSEJ AND SYSXI, IF FCBLKS ! 955: < * ARE USED, A CHAIN IS BUILT SO THAT THEY MAY ALL BE ! 956: < * FOUND - SEE SYSXI FOR DETAILS. ! 957: < * IF BOTH FILE ARG1 AND FILE ARG2 ARE NULL, CALLS OF SYSFC ! 958: < * AND SYSIO ARE OMITTED. ! 959: < * IF FILE ARG1 IS NULL (STANDARD INPUT/OUTPUT FILE), SYSFC ! 960: < * IS CALLED TO CHECK NON-NULL FILE ARG2 BUT ANY REQUEST ! 961: < * FOR AN FCBLK WILL BE IGNORED, SINCE SPITBOL HANDLES THE ! 962: < * STANDARD FILES SPECIALLY AND CANNOT READILY KEEP FCBLK ! 963: < * POINTERS FOR THEM. ! 964: < * FILEARG1 IS TYPE CHECKED BY SPITBOL SO FURTHER CHECKING ! 965: < * MAY BE UNNECCESSARY IN MANY IMPLEMENTATIONS. ! 966: < * FILE ARG2 IS PASSED SO THAT SYSFC MAY ANALYSE AND ! 967: < * CHECK IT. HOWEVER TO ASSIST IN THIS, SPITBOL ALSO PASSES ! 968: < * ON THE STACK THE COMPONENTS OF THIS ARGUMENT WITH ! 969: < * FILE NAME, $F$ (OTHERWISE NULL) EXTRACTED AND STACKED ! 970: < * FIRST. ! 971: < * THE OTHER FIELDS, IF ANY, ARE EXTRACTED AS SUBSTRINGS, ! 972: < * POINTERS TO THEM ARE STACKED AND A COUNT OF ALL ITEMS ! 973: < * STACKED IS PLACED IN WC. IF AN FCBLK WAS EARLIER ! 974: < * ALLOCATED AND POINTED TO VIA FILE ARG1, SYSFC IS ALSO ! 975: < * PASSED A POINTER TO THIS FCBLK. ! 976: < * ! 977: < * (XL) FILE ARG1 SCBLK PTR (2ND ARG) ! 978: < * (XR) FILEARG2 (3RD ARG) OR NULL ! 979: < * -(XS)...-(XS) SCBLKS FOR $F$,$R$,$C$,... ! 980: < * (WC) NO. OF STACKED SCBLKS ABOVE ! 981: < * (WA) EXISTING FILE ARG1 FCBLK PTR OR 0 ! 982: < * (WB) 0/3 FOR INPUT/OUTPUT ASSOCN ! 983: < * JSR SYSFC CALL TO CHECK NEED FOR FCBLK ! 984: < * PPM LOC INVALID FILE ARGUMENT ! 985: < * (XS) POPPED (WC) TIMES ! 986: < * (WA NON ZERO) BYTE SIZE OF REQUESTED FCBLK ! 987: < * (WA=0,XL NON ZERO) PRIVATE FCBLK PTR IN XL ! 988: < * (WA=XL=0) NO FCBLK WANTED, NO PRIVATE FCBLK ! 989: < * (WC) 0/1/2 REQUEST ALLOC OF XRBLK/XNBLK ! 990: < * /STATIC BLOCK FOR USE AS FCBLK ! 991: < * (WB) DESTROYED ! 992: < EJC ! 993: < * ! 994: < * SYSHS -- GIVE ACCESS TO HOST COMPUTER FEATURES ! 995: < * ! 996: < SYSHS EXP DEFINE EXTERNAL ENTRY POINT ! 997: < * ! 998: < * PROVIDES MEANS FOR IMPLEMENTING SPECIAL FEATURES ! 999: < * ON DIFFERENT HOST COMPUTERS. THE ONLY DEFINED ENTRY IS ! 1000: < * THAT WHERE ALL ARGUMENTS ARE NULL IN WHICH CASE SYSHS ! 1001: < * RETURNS AN SCBLK CONTAINING NAME OF COMPUTER, ! 1002: < * NAME OF OPERATING SYSTEM AND NAME OF SITE SEPARATED BY ! 1003: < * COLONS. THE SCBLK NEED NOT HAVE A CORRECT FIRST FIELD ! 1004: < * AS THIS IS SUPPLIED ON COPYING STRING TO DYNAMIC MEMORY. ! 1005: < * SPITBOL DOES NO ARGUMENT CHECKING BUT DOES PROVIDE A ! 1006: < * SINGLE ERROR RETURN FOR ARGUMENTS CHECKED AS ERRONEOUS ! 1007: < * BY OSINT. IT ALSO PROVIDES A SINGLE EXECUTION ERROR ! 1008: < * RETURN. IF THESE ARE INADEQUATE, USE MAY BE MADE OF THE ! 1009: < * MINIMAL ERROR SECTION DIRECT AS DESCRIBED IN MINIMAL ! 1010: < * DOCUMENTATION, SECTION 10. ! 1011: < * SEVERAL NON-ERROR RETURNS ARE PROVIDED. THE FIRST ! 1012: < * CORRESPONDS TO THE DEFINED ENTRY OR, FOR IMPLEMENTATION ! 1013: < * DEFINED ENTRIES, ANY STRING MAY BE RETURNED. THE OTHERS ! 1014: < * PERMIT RESPECTIVELY, RETURN A NULL RESULT, RETURN WITH A ! 1015: < * RESULT TO BE STACKED WHICH IS POINTED AT BY XR, AND A ! 1016: < * RETURN CAUSING SPITBOL STATEMENT FAILURE. IF A RETURNED ! 1017: < * RESULT IS IN DYNAMIC MEMORY IT MUST OBEY GARBAGE ! 1018: < * COLLECTOR RULES. THE ONLY RESULTS COPIED ON RETURN ! 1019: < * ARE STRINGS RETURNED VIA PPM LOC3 RETURN. ! 1020: < * ! 1021: < * (WA) ARGUMENT 1 ! 1022: < * (XL) ARGUMENT 2 ! 1023: < * (XR) ARGUMENT 3 ! 1024: < * JSR SYSHS CALL TO GET HOST INFORMATION ! 1025: < * PPM LOC1 ERRONEOUS ARG ! 1026: < * PPM LOC2 EXECUTION ERROR ! 1027: < * PPM LOC3 SCBLK PTR IN XL OR 0 IF UNAVAILABLE ! 1028: < * PPM LOC4 RETURN A NULL RESULT ! 1029: < * PPM LOC5 RETURN RESULT IN XR ! 1030: < * PPM LOC6 CAUSE STATEMENT FAILURE ! 1031: < EJC ! 1032: < * ! 1033: < * SYSID -- RETURN SYSTEM IDENTIFICATION ! 1034: < * ! 1035: < SYSID EXP DEFINE EXTERNAL ENTRY POINT ! 1036: < * ! 1037: < * THIS ROUTINE SHOULD RETURN STRINGS TO HEAD THE STANDARD ! 1038: < * PRINTER OUTPUT. THE FIRST STRING WILL BE APPENDED TO ! 1039: < * A HEADING LINE OF THE FORM ! 1040: < * MACRO SPITBOL VERSION V.V ! 1041: < * SUPPLIED BY SPITBOL ITSELF. V.V ARE DIGITS GIVING THE ! 1042: < * MAJOR VERSION NUMBER AND GENERALLY AT LEAST A MINOR ! 1043: < * VERSION NUMBER RELATING TO OSINT SHOULD BE SUPPLIED TO ! 1044: < * GIVE SAY ! 1045: < * MACRO SPITBOL VERSION V.V(M.M) ! 1046: < * THE SECOND STRING SHOULD IDENTIFY AT LEAST THE MACHINE ! 1047: < * AND OPERATING SYSTEM. PREFERABLY IT SHOULD INCLUDE ! 1048: < * THE DATE AND TIME OF THE RUN. ! 1049: < * OPTIONALLY THE STRINGS MAY INCLUDE SITE NAME OF THE ! 1050: < * THE IMPLEMENTOR AND/OR MACHINE ON WHICH RUN TAKES PLACE, ! 1051: < * UNIQUE SITE OR COPY NUMBER AND OTHER INFORMATION AS ! 1052: < * APPROPRIATE WITHOUT MAKING IT SO LONG AS TO BE A ! 1053: < * NUISANCE TO USERS. ! 1054: < * THE FIRST WORDS OF THE SCBLKS POINTED AT NEED NOT BE ! 1055: < * CORRECTLY SET. ! 1056: < * ! 1057: < * JSR SYSID CALL FOR SYSTEM IDENTIFICATION ! 1058: < * (XR) SCBLK PTR FOR ADDITION TO HEADER ! 1059: < * (XL) PTR TO SECOND HEADER SCBLK ! 1060: < EJC ! 1061: < * ! 1062: < * SYSIL -- GET INPUT RECORD LENGTH ! 1063: < * ! 1064: < SYSIL EXP DEFINE EXTERNAL ENTRY POINT ! 1065: < * ! 1066: < * SYSIL IS USED TO GET THE LENGTH OF THE NEXT INPUT RECORD ! 1067: < * FROM A FILE PREVIOUSLY INPUT ASSOCIATED WITH A SYSIO ! 1068: < * CALL. THE LENGTH RETURNED IS USED TO ESTABLISH A BUFFER ! 1069: < * FOR A SUBSEQUENT SYSIN CALL. ! 1070: < * ! 1071: < * (WA) PTR TO FCBLK OR ZERO ! 1072: < * JSR SYSIL CALL TO GET RECORD LENGTH ! 1073: < * (WA) LENGTH OR ZERO IF FILE CLOSED ! 1074: < * ! 1075: < * NO HARM IS DONE IF THE VALUE RETURNED IS TOO LONG SINCE ! 1076: < * UNUSED SPACE WILL BE RECLAIMED AFTER THE SYSIN CALL. ! 1077: < * ! 1078: < * NOTE THAT IT IS THE SYSIL CALL (NOT THE SYSIO CALL) WHICH ! 1079: < * CAUSES THE FILE TO BE OPENED AS REQUIRED FOR THE FIRST ! 1080: < * RECORD INPUT FROM THE FILE. ! 1081: < EJC ! 1082: < * ! 1083: < * SYSIN -- READ INPUT RECORD ! 1084: < * ! 1085: < SYSIN EXP DEFINE EXTERNAL ENTRY POINT ! 1086: < * ! 1087: < * SYSIN IS USED TO READ A RECORD FROM THE FILE WHICH WAS ! 1088: < * REFERENCED IN A PRIOR CALL TO SYSIL (I.E. THESE CALLS ! 1089: < * ALWAYS OCCUR IN PAIRS). THE BUFFER PROVIDED IS AN ! 1090: < * SCBLK FOR A STRING OF LENGTH SET FROM THE SYSIL CALL. ! 1091: < * IF THE ACTUAL LENGTH READ IS LESS THAN THIS, THE LENGTH ! 1092: < * FIELD OF THE SCBLK MUST BE MODIFIED BEFORE RETURNING ! 1093: < * UNLESS BUFFER IS RIGHT PADDED WITH ZEROES. ! 1094: < * IT IS ALSO PERMISSIBLE TO TAKE ANY OF THE ALTERNATIVE ! 1095: < * RETURNS AFTER SCBLK LENGTH HAS BEEN MODIFIED. ! 1096: < * ! 1097: < * (WA) PTR TO FCBLK OR ZERO ! 1098: < * (XR) POINTER TO BUFFER (SCBLK PTR) ! 1099: < * JSR SYSIN CALL TO READ RECORD ! 1100: < * PPM LOC ENDFILE OR NO I/P FILE AFTER SYSXI ! 1101: < * PPM LOC RETURN HERE IF I/O ERROR ! 1102: < * PPM LOC RETURN HERE IF RECORD FORMAT ERROR ! 1103: < * (WA,WB,WC) DESTROYED ! 1104: < EJC ! 1105: < * ! 1106: < * SYSIO -- INPUT/OUTPUT FILE ASSOCIATION ! 1107: < * ! 1108: < SYSIO EXP DEFINE EXTERNAL ENTRY POINT ! 1109: < * ! 1110: < * SEE ALSO SYSFC. ! 1111: < * SYSIO IS CALLED IN RESPONSE TO A SNOBOL4 INPUT OR OUTPUT ! 1112: < * FUNCTION CALL EXCEPT WHEN FILE ARG1 AND FILE ARG2 ! 1113: < * ARE BOTH NULL. ! 1114: < * ITS CALL ALWAYS FOLLOWS IMMEDIATELY AFTER A CALL ! 1115: < * OF SYSFC. IF SYSFC REQUESTED ALLOCATION ! 1116: < * OF AN FCBLK, ITS ADDRESS WILL BE IN WA. ! 1117: < * FOR INPUT FILES, NON-ZERO VALUES OF $R$ SHOULD BE ! 1118: < * COPIED TO WC FOR USE IN ALLOCATING INPUT BUFFERS. IF $R$ ! 1119: < * IS DEFAULTED OR NOT IMPLEMENTED, WC SHOULD BE ZEROISED. ! 1120: < * ONCE A FILE HAS BEEN OPENED, SUBSEQUENT INPUT(),OUTPUT() ! 1121: < * CALLS IN WHICH THE SECOND ARGUMENT IS IDENTICAL WITH THAT ! 1122: < * IN A PREVIOUS CALL, MERELY ASSOCIATE THE ADDITIONAL ! 1123: < * VARIABLE NAME (FIRST ARGUMENT) TO THE FILE AND DO NOT ! 1124: < * RESULT IN RE-OPENING THE FILE. ! 1125: < * IN SUBSEQUENT ASSOCIATED ACCESSES TO THE FILE A POINTER ! 1126: < * TO ANY FCBLK ALLOCATED WILL BE MADE AVAILABLE. ! 1127: < * ! 1128: < * (XL) FILE ARG1 SCBLK PTR (2ND ARG) ! 1129: < * (XR) FILE ARG2 SCBLK PTR (3RD ARG) ! 1130: < * (WA) FCBLK PTR (0 IF NONE) ! 1131: < * (WB) 0 FOR INPUT, 3 FOR OUTPUT ! 1132: < * JSR SYSIO CALL TO ASSOCIATE FILE ! 1133: < * PPM LOC RETURN HERE IF FILE DOES NOT EXIST ! 1134: < * PPM LOC RETURN IF INPUT/OUTPUT NOT ALLOWED ! 1135: < * (XL) FCBLK POINTER (0 IF NONE) ! 1136: < * (WC) 0 (FOR DEFAULT) OR MAX RECORD LNGTH ! 1137: < * (WA,WB) DESTROYED ! 1138: < * ! 1139: < * THE SECOND ERROR RETURN IS USED IF THE FILE NAMED EXISTS ! 1140: < * BUT INPUT/OUTPUT FROM THE FILE IS NOT ALLOWED. FOR ! 1141: < * EXAMPLE, THE STANDARD OUTPUT FILE MAY BE IN THIS CATEGORY ! 1142: < * AS REGARDS INPUT ASSOCIATION. ! 1143: < EJC ! 1144: < * ! 1145: < * SYSLD -- LOAD EXTERNAL FUNCTION ! 1146: < * ! 1147: < SYSLD EXP DEFINE EXTERNAL ENTRY POINT ! 1148: < * ! 1149: < * SYSLD IS CALLED IN RESPONSE TO THE USE OF THE SNOBOL4 ! 1150: < * LOAD FUNCTION. THE NAMED FUNCTION IS LOADED (WHATEVER ! 1151: < * THIS MEANS), AND A POINTER IS RETURNED. THE POINTER WILL ! 1152: < * BE USED ON SUBSEQUENT CALLS TO THE FUNCTION (SEE SYSEX). ! 1153: < * ! 1154: < * (XR) POINTER TO FUNCTION NAME (SCBLK) ! 1155: < * (XL) POINTER TO LIBRARY NAME (SCBLK) ! 1156: < * JSR SYSLD CALL TO LOAD FUNCTION ! 1157: < * PPM LOC RETURN HERE IF FUNC DOES NOT EXIST ! 1158: < * PPM LOC RETURN HERE IF I/O ERROR ! 1159: < * (XR) POINTER TO LOADED CODE ! 1160: < * ! 1161: < * THE SIGNIFICANCE OF THE POINTER RETURNED IS UP TO THE ! 1162: < * SYSTEM INTERFACE ROUTINE. THE ONLY RESTRICTION IS THAT ! 1163: < * IF THE POINTER IS WITHIN DYNAMIC STORAGE, IT MUST BE ! 1164: < * A PROPER BLOCK POINTER. ! 1165: < EJC ! 1166: < * ! 1167: < * SYSMM -- GET MORE MEMORY ! 1168: < * ! 1169: < SYSMM EXP DEFINE EXTERNAL ENTRY POINT ! 1170: < * ! 1171: < * SYSMM IS CALLED IN AN ATTEMPT TO ALLOCATE MORE DYNAMIC ! 1172: < * MEMORY. THIS MEMORY MUST BE ALLOCATED CONTIGUOUSLY WITH ! 1173: < * THE CURRENT DYNAMIC DATA AREA. ! 1174: < * ! 1175: < * THE AMOUNT ALLOCATED IS UP TO THE SYSTEM TO DECIDE. ANY ! 1176: < * VALUE IS ACCEPTABLE INCLUDING ZERO IF ALLOCATION IS ! 1177: < * IMPOSSIBLE. ! 1178: < * ! 1179: < * JSR SYSMM CALL TO GET MORE MEMORY ! 1180: < * (XR) NUMBER OF ADDITIONAL WORDS OBTAINED ! 1181: < EJC ! 1182: < * ! 1183: < * SYSMX -- SUPPLY MXLEN ! 1184: < * ! 1185: < SYSMX EXP DEFINE EXTERNAL ENTRY POINT ! 1186: < * ! 1187: < * BECAUSE OF THE METHOD OF GARBAGE COLLECTION, NO SPITBOL ! 1188: < * OBJECT IS ALLOWED TO OCCUPY MORE BYTES OF MEMORY THAN ! 1189: < * THE INTEGER GIVING THE LOWEST ADDRESS OF DYNAMIC ! 1190: < * (GARBAGE COLLECTABLE) MEMORY. MXLEN IS THE NAME USED TO ! 1191: < * REFER TO THIS MAXIMUM LENGTH OF AN OBJECT AND FOR MOST ! 1192: < * USERS OF MOST IMPLEMENTATIONS, PROVIDED DYNAMIC MEMORY ! 1193: < * STARTS AT AN ADDRESS OF AT LEAST A FEW THOUSAND WORDS, ! 1194: < * THERE IS NO PROBLEM. ! 1195: < * IF THE DEFAULT STARTING ADDRESS IS LESS THAN SAY 10000 OR ! 1196: < * 20000, THEN A LOAD TIME OPTION SHOULD BE PROVIDED WHERE A ! 1197: < * USER CAN REQUEST THAT HE BE ABLE TO CREATE LARGER ! 1198: < * OBJECTS. THIS ROUTINE INFORMS SPITBOL OF THIS REQUEST IF ! 1199: < * ANY. THE VALUE RETURNED IS EITHER AN INTEGER ! 1200: < * REPRESENTING THE DESIRED VALUE OF MXLEN (AND HENCE THE ! 1201: < * MINIMUM DYNAMIC STORE ADDRESS WHICH MAY RESULT IN ! 1202: < * NON-USE OF SOME STORE) OR ZERO IF A DEFAULT IS ACCEPTABLE ! 1203: < * IN WHICH MXLEN IS SET TO THE LOWEST ADDRESS ALLOCATED ! 1204: < * TO DYNAMIC STORE BEFORE COMPILATION STARTS. ! 1205: < * IF A NON-ZERO VALUE IS RETURNED, THIS IS USED FOR KEYWORD ! 1206: < * MAXLNGTH. OTHERWISE THE INITIAL LOW ADDRESS OF DYNAMIC ! 1207: < * MEMORY IS USED FOR THIS KEYWORD. ! 1208: < * ! 1209: < * JSR SYSMX CALL TO GET MXLEN ! 1210: < * (WA) EITHER MXLEN OR 0 FOR DEFAULT ! 1211: < EJC ! 1212: < * ! 1213: < * SYSOU -- OUTPUT RECORD ! 1214: < * ! 1215: < SYSOU EXP DEFINE EXTERNAL ENTRY POINT ! 1216: < * ! 1217: < * SYSOU IS USED TO WRITE A RECORD TO A FILE PREVIOUSLY ! 1218: < * ASSOCIATED WITH A SYSIO CALL. ! 1219: < * ! 1220: < * (WA) PTR TO FCBLK OR ZERO ! 1221: < * (XR) RECORD TO BE WRITTEN (SCBLK) ! 1222: < * JSR SYSOU CALL TO OUTPUT RECORD ! 1223: < * PPM LOC FILE FULL OR NO FILE AFTER SYSXI ! 1224: < * PPM LOC RETURN HERE IF I/O ERROR ! 1225: < * (WA,WB,WC) DESTROYED ! 1226: < * ! 1227: < * NOTE THAT IT IS THE SYSOU CALL (NOT THE SYSIO CALL) WHICH ! 1228: < * CAUSES THE FILE TO BE OPENED AS REQUIRED FOR THE FIRST ! 1229: < * RECORD OUTPUT TO THE FILE. ! 1230: < EJC ! 1231: < * ! 1232: < * SYSPI -- PRINT ON INTERACTIVE CHANNEL ! 1233: < * ! 1234: < SYSPI EXP DEFINE EXTERNAL ENTRY POINT ! 1235: < * ! 1236: < * IF SPITBOL IS RUN FROM AN ONLINE TERMINAL, OSINT CAN ! 1237: < * REQUEST THAT MESSAGES SUCH AS COPIES OF COMPILATION ! 1238: < * ERRORS BE SENT TO THE TERMINAL (SEE SYSPP). IF RELEVANT ! 1239: < * REPLY WAS MADE BY SYSPP THEN SYSPI IS CALLED TO SEND SUCH ! 1240: < * MESSAGES TO THE INTERACTIVE CHANNEL. ! 1241: < * SYSPI IS ALSO USED FOR SENDING OUTPUT TO THE TERMINAL ! 1242: < * THROUGH THE SPECIAL VARIABLE NAME, TERMINAL. ! 1243: < * ! 1244: < * (XR) PTR TO LINE BUFFER (SCBLK) ! 1245: < * (WA) LINE LENGTH ! 1246: < * JSR SYSPI CALL TO PRINT LINE ! 1247: < * PPM LOC FAILURE RETURN ! 1248: < * (WA,WB) DESTROYED ! 1249: < EJC ! 1250: < * ! 1251: < * SYSPP -- OBTAIN PRINT PARAMETERS ! 1252: < * ! 1253: < SYSPP EXP DEFINE EXTERNAL ENTRY POINT ! 1254: < * ! 1255: < * SYSPP IS CALLED ONCE DURING COMPILATION TO OBTAIN ! 1256: < * PARAMETERS REQUIRED FOR CORRECT PRINTED OUTPUT FORMAT ! 1257: < * AND TO SELECT OTHER OPTIONS. IT MAY ALSO BE CALLED AGAIN ! 1258: < * AFTER SYSXI WHEN A LOAD MODULE IS RESUMED. IN THIS ! 1259: < * CASE THE VALUE RETURNED IN WA MAY BE LESS THAN OR EQUAL ! 1260: < * TO THAT RETURNED IN INITIAL CALL BUT MAY NOT BE ! 1261: < * GREATER. ! 1262: < * THE INFORMATION RETURNED IS - ! 1263: < * 1. LINE LENGTH IN CHARS FOR STANDARD PRINT FILE ! 1264: < * 2. NO OF LINES/PAGE. 0 IS PREFERABLE FOR A NON-PAGED ! 1265: < * DEVICE (E.G. ONLINE TERMINAL) IN WHICH CASE LISTING ! 1266: < * PAGE THROWS ARE SUPPRESSED AND PAGE HEADERS ! 1267: < * RESULTING FROM -TITLE,-STITL LINES ARE KEPT SHORT. ! 1268: < * 3. AN INITIAL -NOLIST OPTION TO SUPPRESS LISTING UNLESS ! 1269: < * THE PROGRAM CONTAINS AN EXPLICIT -LIST. ! 1270: < * 4. OPTIONS TO SUPPRESS LISTING OF COMPILATION AND/OR ! 1271: < * EXECUTION STATS (USEFUL FOR ESTABLISHED PROGRAMS) - ! 1272: < * COMBINED WITH 3. GIVES POSSIBILITY OF LISTING ! 1273: < * FILE NEVER BEING OPENED. ! 1274: < * 5. OPTION TO HAVE COPIES OF ERRORS SENT TO AN ! 1275: < * INTERACTIVE CHANNEL IN ADDITION TO STANDARD PRINTER. ! 1276: < * 6. OPTION TO KEEP PAGE HEADERS SHORT (E.G. IF LISTING ! 1277: < * TO AN ONLINE TERMINAL). ! 1278: < * 7. AN OPTION TO CHOOSE EXTENDED OR COMPACT LISTING ! 1279: < * FORMAT. IN THE FORMER A PAGE EJECT AND IN THE LATTER ! 1280: < * A FEW LINE FEEDS PRECEDE THE PRINTING OF EACH ! 1281: < * OF-- LISTING, COMPILATION STATISTICS, EXECUTION ! 1282: < * OUTPUT AND EXECUTION STATISTICS. ! 1283: < * 8. AN OPTION TO SUPPRESS EXECUTION AS THOUGH A ! 1284: < * -NOEXECUTE CARD WERE SUPPLIED. ! 1285: < * 9. AN OPTION TO REQUEST THAT NAME /TERMINAL/ BE PRE- ! 1286: < * ASSOCIATED TO AN ONLINE TERMINAL VIA SYSPI AND SYSRI ! 1287: < * 10. AN INTERMEDIATE (STANDARD) LISTING OPTION REQUIRING ! 1288: < * THAT PAGE EJECTS OCCUR IN SOURCE LISTINGS. REDUNDANT ! 1289: < * IF EXTENDED OPTION CHOSEN BUT PARTIALLY EXTENDS ! 1290: < * COMPACT OPTION. ! 1291: < * 11. OPTION TO SUPPRESS SYSID IDENTIFICATION. ! 1292: < * ! 1293: < * JSR SYSPP CALL TO GET PRINT PARAMETERS ! 1294: < * (WA) PRINT LINE LENGTH IN CHARS ! 1295: < * (WB) NUMBER OF LINES/PAGE ! 1296: < * (WC) BITS VALUE ...JIHGFEDCBA WHERE ! 1297: < * A = 1 TO SEND ERROR COPY TO INT.CH. ! 1298: < * B = 1 MEANS STD PRINTER IS INT. CH. ! 1299: < * C = 1 FOR -NOLIST OPTION ! 1300: < * D = 1 TO SUPPRESS COMPILN. STATS ! 1301: < * E = 1 TO SUPPRESS EXECN. STATS ! 1302: < * F = 1/0 FOR EXTNDED/COMPACT LISTING ! 1303: < * G = 1 FOR -NOEXECUTE ! 1304: < * H = 1 PRE-ASSOCIATE /TERMINAL/ ! 1305: < * I = 1 FOR STANDARD LISTING OPTION. ! 1306: < * J = 1 SUPPRESSES LISTING HEADER ! 1307: < EJC ! 1308: < * ! 1309: < * SYSPR -- PRINT LINE ON STANDARD OUTPUT FILE ! 1310: < * ! 1311: < SYSPR EXP DEFINE EXTERNAL ENTRY POINT ! 1312: < * ! 1313: < * SYSPR IS USED TO PRINT A SINGLE LINE ON THE STANDARD ! 1314: < * OUTPUT FILE. ! 1315: < * ! 1316: < * (XR) POINTER TO LINE BUFFER (SCBLK) ! 1317: < * (WA) LINE LENGTH ! 1318: < * JSR SYSPR CALL TO PRINT LINE ! 1319: < * PPM LOC TOO MUCH O/P OR NO FILE AFTER SYSXI ! 1320: < * (WA,WB) DESTROYED ! 1321: < * ! 1322: < * THE BUFFER POINTED TO IS THE LENGTH OBTAINED FROM THE ! 1323: < * SYSPP CALL AND IS FILLED OUT WITH TRAILING BLANKS. THE ! 1324: < * VALUE IN WA IS THE ACTUAL LINE LENGTH WHICH MAY BE LESS ! 1325: < * THAN THE MAXIMUM LINE LENGTH POSSIBLE. THERE IS NO SPACE ! 1326: < * CONTROL ASSOCIATED WITH THE LINE, ALL LINES ARE PRINTED ! 1327: < * SINGLE SPACED. NOTE THAT NULL LINES (WA=0) ARE POSSIBLE ! 1328: < * IN WHICH CASE A BLANK LINE IS TO BE PRINTED. ! 1329: < * ! 1330: < * THE ERROR EXIT IS USED FOR SYSTEMS WHICH LIMIT THE AMOUNT ! 1331: < * OF PRINTED OUTPUT. IF POSSIBLE, PRINTING SHOULD BE ! 1332: < * PERMITTED AFTER THIS CONDITION HAS BEEN SIGNALLED ONCE TO ! 1333: < * ALLOW FOR DUMP AND OTHER DIAGNOSTIC INFORMATION. ! 1334: < * ASSUMING THIS TO BE POSSIBLE, SPITBOL MAY MAKE MORE SYSPR ! 1335: < * CALLS. IF THE ERROR RETURN OCCURS ANOTHER TIME, EXECUTION ! 1336: < * IS TERMINATED BY A CALL OF SYSEJ WITH ENDING CODE 998. ! 1337: < EJC ! 1338: < * ! 1339: < * SYSRD -- READ RECORD FROM STANDARD INPUT FILE ! 1340: < * ! 1341: < SYSRD EXP DEFINE EXTERNAL ENTRY POINT ! 1342: < * ! 1343: < * SYSRD IS USED TO READ A RECORD FROM THE STANDARD INPUT ! 1344: < * FILE. THE BUFFER PROVIDED IS AN SCBLK FOR A STRING THE ! 1345: < * LENGTH OF WHICH IN CHARACTERS IS GIVEN IN WC, THIS ! 1346: < * CORRESPONDING TO THE MAXIMUM LENGTH OF STRING WHICH ! 1347: < * SPITBOL IS PREPARED TO RECEIVE. AT COMPILE TIME IT ! 1348: < * CORRESPONDS TO XXX IN THE MOST RECENT -INXXX CARD ! 1349: < * (DEFAULT 72) AND AT EXECUTION TIME TO THE MOST RECENT ! 1350: < * ,R$R$ (RECORD LENGTH) IN THE THIRD ARG OF AN INPUT() ! 1351: < * STATEMENT FOR THE STANDARD INPUT FILE (DEFAULT 80). ! 1352: < * IF FEWER THAN (WC) CHARACTERS ARE READ, THE LENGTH ! 1353: < * FIELD OF THE SCBLK MUST BE ADJUSTED BEFORE RETURNING ! 1354: < * UNLESS THE BUFFER IS RIGHT PADDED WITH ZEROES. ! 1355: < * IT IS ALSO PERMISSIBLE TO TAKE THE ALTERNATIVE RETURN ! 1356: < * AFTER SUCH AN ADJUSTMENT HAS BEEN MADE. ! 1357: < * SPITBOL MAY CONTINUE TO MAKE CALLS AFTER AN ENDFILE ! 1358: < * RETURN SO THIS ROUTINE SHOULD BE PREPARED TO MAKE ! 1359: < * REPEATED ENDFILE RETURNS. ! 1360: < * ! 1361: < * (XR) POINTER TO BUFFER (SCBLK PTR) ! 1362: < * (WC) LENGTH OF BUFFER IN CHARACTERS ! 1363: < * JSR SYSRD CALL TO READ LINE ! 1364: < * PPM LOC ENDFILE OR NO I/P FILE AFTER SYSXI ! 1365: < * (WA,WB,WC) DESTROYED ! 1366: < EJC ! 1367: < * ! 1368: < * SYSRI -- READ RECORD FROM INTERACTIVE CHANNEL ! 1369: < * ! 1370: < SYSRI EXP DEFINE EXTERNAL ENTRY POINT ! 1371: < * ! 1372: < * READS A RECORD FROM ONLINE TERMINAL FOR SPITBOL VARIABLE, ! 1373: < * TERMINAL. IF ONLINE TERMINAL IS UNAVAILABLE THEN CODE THE ! 1374: < * ENDFILE RETURN ONLY. ! 1375: < * THE BUFFER PROVIDED IS OF LENGTH 120 CHARACTERS. SYSRI ! 1376: < * SHOULD REPLACE THE COUNT IN THE SECOND WORD OF THE SCBLK ! 1377: < * BY THE ACTUAL CHARACTER COUNT UNLESS BUFFER IS RIGHT ! 1378: < * PADDED WITH ZEROES. ! 1379: < * IT IS ALSO PERMISSIBLE TO TAKE THE ALTERNATIVE ! 1380: < * RETURN AFTER ADJUSTING THE COUNT. ! 1381: < * THE END OF FILE RETURN MAY BE USED IF THIS MAKES ! 1382: < * SENSE ON THE TARGET MACHINE (E.G. IF THERE IS AN ! 1383: < * EOF CHARACTER.) ! 1384: < * ! 1385: < * (XR) PTR TO 120 CHAR BUFFER (SCBLK PTR) ! 1386: < * JSR SYSRI CALL TO READ LINE FROM TERMINAL ! 1387: < * PPM LOC END OF FILE RETURN ! 1388: < * (WA,WB,WC) MAY BE DESTROYED ! 1389: < EJC ! 1390: < * ! 1391: < * SYSRW -- REWIND FILE ! 1392: < * ! 1393: < SYSRW EXP DEFINE EXTERNAL ENTRY POINT ! 1394: < * ! 1395: < * SYSRW IS USED TO REWIND A FILE I.E. REPOSITION THE FILE ! 1396: < * AT THE START BEFORE THE FIRST RECORD. THE FILE SHOULD BE ! 1397: < * CLOSED AND THE NEXT READ OR WRITE CALL WILL OPEN THE ! 1398: < * FILE AT THE START. ! 1399: < * ! 1400: < * (WA) PTR TO FCBLK OR ZERO ! 1401: < * (XR) REWIND ARG (SCBLK PTR) ! 1402: < * JSR SYSRW CALL TO REWIND FILE ! 1403: < * PPM LOC RETURN HERE IF FILE DOES NOT EXIST ! 1404: < * PPM LOC RETURN HERE IF REWIND NOT ALLOWED ! 1405: < * PPM LOC RETURN HERE IF I/O ERROR ! 1406: < EJC ! 1407: --- ! 1408: > SYSBX EXP E,0 ! 1409: > .IF .CSCI ! 1410: > SYSCI EXP E,0 ! 1411: > .FI ! 1412: > SYSDT EXP E,0 ! 1413: > SYSEC EXP E,2 ! 1414: > SYSEF EXP E,2 ! 1415: > SYSEJ EXP E,0 ! 1416: > SYSEM EXP E,0 ! 1417: > SYSEN EXP E,2 ! 1418: > SYSEP EXP E,2 ! 1419: > .IF .CNLD ! 1420: > .ELSE ! 1421: > SYSEX EXP E,1 ! 1422: > .FI ! 1423: > SYSHS EXP E,2 ! 1424: > SYSID EXP E,0 ! 1425: > SYSIL EXP E,0 ! 1426: > SYSIN EXP E,2 ! 1427: > SYSIO EXP E,2 ! 1428: > .IF .CNLD ! 1429: > .ELSE ! 1430: > SYSLD EXP E,2 ! 1431: > .FI ! 1432: > SYSMM EXP E,0 ! 1433: > SYSMX EXP E,0 ! 1434: > SYSOU EXP E,2 ! 1435: > SYSPI EXP E,2 ! 1436: > SYSPP EXP E,0 ! 1437: > SYSPR EXP E,2 ! 1438: > SYSRD EXP E,2 ! 1439: > SYSRI EXP E,2 ! 1440: > SYSSC EXP E,2 ! 1441: 1252,1272c205 ! 1442: < * ! 1443: < * SYSST -- SET FILE POINTER ! 1444: < * ! 1445: < SYSST EXP DEFINE EXTERNAL ENTRY POINT ! 1446: < * ! 1447: < * SYSST IS CALLED TO CHANGE THE POSITION OF A FILE ! 1448: < * POINTER. THIS IS ACCOMPLISHED IN A SYSTEM DEPENDENT ! 1449: < * MANNER, AND THUS THE 2ND AND 3RD ARGUMENTS ARE PASSED ! 1450: < * UNCONVERTED. ! 1451: < * ! 1452: < * (WA) FCBLK POINTER ! 1453: < * (WB) 2ND ARGUMENT ! 1454: < * (WC) 3RD ARGUMENT ! 1455: < * JSR SYSST CALL TO SET FILE POINTER ! 1456: < * PPM LOC RETURN HERE IF INVALID 2ND ARG ! 1457: < * PPM LOC RETURN HERE IF INVALID 3RD ARG ! 1458: < * PPM LOC RETURN HERE IF FILE DOES NOT EXIST ! 1459: < * PPM LOC RETURN HERE IF SET NOT ALLOWED ! 1460: < * PPM LOC RETURN HERE IF I/O ERROR ! 1461: < * ! 1462: < EJC ! 1463: --- ! 1464: > SYSST EXP E,2 ! 1465: 1274,1316c207,212 ! 1466: < * ! 1467: < * SYSTM -- GET EXECUTION TIME SO FAR ! 1468: < * ! 1469: < SYSTM EXP DEFINE EXTERNAL ENTRY POINT ! 1470: < * ! 1471: < * SYSTM IS USED TO OBTAIN THE AMOUNT OF EXECUTION TIME ! 1472: < * USED SO FAR SINCE SPITBOL WAS GIVEN CONTROL. THE UNITS ! 1473: < * ARE DESCRIBED AS MILLISECONDS IN THE SPITBOL OUTPUT, BUT ! 1474: < * THE EXACT MEANING IS SYSTEM DEPENDENT. WHERE APPROPRIATE, ! 1475: < * THIS VALUE SHOULD RELATE TO PROCESSOR RATHER THAN CLOCK ! 1476: < * TIMING VALUES. ! 1477: < * ! 1478: < * JSR SYSTM CALL TO GET TIMER VALUE ! 1479: < * (IA) TIME SO FAR IN MILLISECONDS ! 1480: < EJC ! 1481: < * ! 1482: < * SYSTT -- TRACE TOGGLE ! 1483: < * ! 1484: < SYSTT EXP DEFINE EXTERNAL ENTRY POINT ! 1485: < * ! 1486: < * CALLED BY SPITBOL FUNCTION TRACE() WITH NO ARGS TO ! 1487: < * TOGGLE THE SYSTEM TRACE SWITCH. THIS PERMITS TRACING OF ! 1488: < * LABELS IN SPITBOL CODE TO BE TURNED ON OR OFF. ! 1489: < * ! 1490: < * JSR SYSTT CALL TO TOGGLE TRACE SWITCH ! 1491: < EJC ! 1492: < * ! 1493: < * SYSUL -- UNLOAD EXTERNAL FUNCTION ! 1494: < * ! 1495: < SYSUL EXP DEFINE EXTERNAL ENTRY POINT ! 1496: < * ! 1497: < * SYSUL IS USED TO UNLOAD A FUNCTION PREVIOUSLY ! 1498: < * LOADED WITH A CALL TO SYSLD. ! 1499: < * ! 1500: < * (XR) PTR TO CONTROL BLOCK (EFBLK) ! 1501: < * JSR SYSUL CALL TO UNLOAD FUNCTION ! 1502: < * ! 1503: < * THE FUNCTION CANNOT BE CALLED FOLLOWING A SYSUL CALL ! 1504: < * UNTIL ANOTHER SYSLD CALL IS MADE FOR THE SAME FUNCTION. ! 1505: < * ! 1506: < * THE EFBLK CONTAINS THE FUNCTION CODE POINTER AND ALSO A ! 1507: < * POINTER TO THE VRBLK CONTAINING THE FUNCTION NAME (SEE ! 1508: < * DEFINITIONS AND DATA STRUCTURES SECTION). ! 1509: --- ! 1510: > SYSTM EXP E,0 ! 1511: > SYSTT EXP E,0 ! 1512: > .IF .CNLD ! 1513: > .ELSE ! 1514: > SYSUL EXP E,0 ! 1515: > .FI ! 1516: 1319,1405c215 ! 1517: < EJC ! 1518: < * ! 1519: < * SYSXI -- EXIT TO PRODUCE LOAD MODULE ! 1520: < * ! 1521: < SYSXI EXP DEFINE EXTERNAL ENTRY POINT ! 1522: < * ! 1523: < * WHEN SYSXI IS CALLED, XL CONTAINS EITHER A STRING POINTER ! 1524: < * OR ZERO. IN THE FORMER CASE, THE STRING GIVES THE ! 1525: < * CHARACTER NAME OF A PROGRAM. THE INTENTION IS THAT ! 1526: < * SPITBOL EXECUTION SHOULD BE TERMINATED FORTHWITH AND ! 1527: < * THE NAMED PROGRAM LOADED AND EXECUTED. THIS TYPE OF CHAIN ! 1528: < * EXECUTION IS VERY SYSTEM DEPENDENT AND IMPLEMENTORS MAY ! 1529: < * CHOOSE TO OMIT IT OR FIND IT IMPOSSIBLE TO PROVIDE. ! 1530: < * IF (XL) IS ZERO,IA CONTAINS ONE OF THE FOLLOWING INTEGERS ! 1531: < * ! 1532: < * -1, -2, -3 ! 1533: < * CREATE IF POSSIBLE A LOAD MODULE CONTAINING ONLY THE ! 1534: < * IMPURE AREA OF MEMORY WHICH NEEDS TO BE LOADED WITH ! 1535: < * A COMPATIBLE PURE SEGMENT FOR SUBSEQUENT EXECUTIONS. ! 1536: < * VERSION NUMBERS TO CHECK COMPATIBILITY SHOULD BE ! 1537: < * KEPT IN BOTH SEGMENTS AND CHECKED ON LOADING. ! 1538: < * TO ASSIST WITH THIS CHECK, (XR) ON ENTRY IS A ! 1539: < * POINTER TO AN SCBLK CONTAINING THE SPITBOL MAJOR ! 1540: < * VERSION NUMBER V.V (SEE SYSID). ! 1541: < * ! 1542: < * 0 IF POSSIBLE, RETURN CONTROL TO JOB CONTROL ! 1543: < * COMMAND LEVEL. THE EFFECT IF AVAILABLE WILL BE ! 1544: < * SYSTEM DEPENDENT. ! 1545: < * ! 1546: < * +1, +2, +3 ! 1547: < * CREATE IF POSSIBLE A LOAD MODULE FROM ALL OF ! 1548: < * MEMORY. IT SHOULD BE POSSIBLE TO LOAD AND EXECUTE ! 1549: < * THIS MODULE DIRECTLY. ! 1550: < * ! 1551: < * IN THE CASE OF SAVED LOAD MODULES, THE STATUS OF OPEN ! 1552: < * FILES IS NOT PRESERVED AND IMPLEMENTORS MAY CHOOSE TO ! 1553: < * OFFER MEANS OF ATTACHING FILES BEFORE EXECUTION OF LOAD ! 1554: < * MODULES STARTS OR LEAVE IT TO THE USER TO INCLUDE ! 1555: < * SUITABLE INPUT(), OUTPUT() CALLS IN HIS PROGRAM. ! 1556: < * SYSXI SHOULD MAKE A NOTE THAT NO I/O CHANNELS, ! 1557: < * INCLUDING STANDARD FILES, HAVE FILES ATTACHED SO THAT ! 1558: < * CALLS OF SYSIN, SYSOU, SYSPR, SYSRD SHOULD FAIL UNLESS ! 1559: < * NEW ASSOCIATIONS ARE MADE FOR THE LOAD MODULE. ! 1560: < * AT LEAST IN THE CASE OF THE STANDARD OUTPUT FILE, IT IS ! 1561: < * RECOMMENDED THAT EITHER THE USER BE REQUIRED TO ATTACH ! 1562: < * A FILE OR THAT A DEFAULT FILE IS ATTACHED, SINCE THE ! 1563: < * PROBLEM OF ERROR MESSAGES GENERATED BY THE LOAD MODULE ! 1564: < * IS OTHERWISE SEVERE. AS A LAST RESORT, IF SPITBOL ! 1565: < * ATTEMPTS TO WRITE TO THE STANDARD OUTPUT FILE AND GETS A ! 1566: < * REPLY INDICATING THAT SUCH OUPUT IS UNACCEPTABLE IT STOPS ! 1567: < * BY USING AN ENTRY TO SYSEJ WITH ENDING CODE 998. ! 1568: < * AS DESCRIBED BELOW, PASSING OF SOME ARGUMENTS MAKES IT ! 1569: < * CLEAR THAT LOAD MODULE WILL USE A STANDARD OUTPUT FILE. ! 1570: < * ! 1571: < * IF USE IS MADE OF FCBLKS FOR I/O ASSOCIATION, SPITBOL ! 1572: < * BUILDS A CHAIN SO THAT THOSE IN USE MAY BE FOUND IN SYSXI ! 1573: < * AND SYSEJ. THE NODES ARE 4 WORDS LONG. THIRD WORD ! 1574: < * CONTAINS LINK TO NEXT NODE OR 0, FOURTH WORD CONTAINS ! 1575: < * FCBLK POINTER. ! 1576: < EJC ! 1577: < * ! 1578: < * SYSXI (CONTINUED) ! 1579: < * ! 1580: < * (XL) ZERO OR SCBLK PTR ! 1581: < * (XR) PTR TO V.V SCBLK ! 1582: < * (IA) SIGNED INTEGER ARGUMENT ! 1583: < * (WB) 0 OR PTR TO HEAD OF FCBLK CHAIN ! 1584: < * JSR SYSXI CALL TO EXIT ! 1585: < * PPM LOC REQUESTED ACTION NOT POSSIBLE ! 1586: < * PPM LOC ACTION CAUSED IRRECOVERABLE ERROR ! 1587: < * (REGISTERS) SHOULD BE PRESERVED OVER CALL ! 1588: < * ! 1589: < * LOADING AND RUNNING THE LOAD MODULE OR RETURNING FROM ! 1590: < * JCL COMMAND LEVEL CAUSES EXECUTION TO RESUME AT THE POINT ! 1591: < * AFTER THE ERROR RETURNS WHICH FOLLOW THE CALL OF SYSXI. ! 1592: < * THE VALUE PASSED AS EXIT ARGUMENT IS USED TO INDICATE ! 1593: < * OPTIONS REQUIRED ON RESUMPTION OF LOAD MODULE. ! 1594: < * +1 OR -1 REQUIRE THAT ON RESUMPTION, SYSID AND SYSPP BE ! 1595: < * CALLED AND A HEADING PRINTED ON THE STANDARD OUTPUT FILE. ! 1596: < * +2 OR -2 INDICATE THAT SYSPP WILL BE CALLED BUT NOT SYSID ! 1597: < * AND NO HEADING WILL BE PUT ON STANDARD OUTPUT FILE. ! 1598: < * ABOVE OPTIONS HAVE THE OBVIOUS IMPLICATION THAT A ! 1599: < * STANDARD O/P FILE MUST BE PROVIDED FOR THE LOAD MODULE. ! 1600: < * +3 OR -3 INDICATE CALLS OF NEITHER SYSID NOR SYSPP ! 1601: < * AND NO HEADING WILL BE PLACED ON STANDARD OUTPUT FILE. ! 1602: < * NO RETURN FROM SYSXI IS POSSIBLE IF ANOTHER PROGRAM ! 1603: < * IS LOADED AND ENTERED. ! 1604: --- ! 1605: > SYSXI EXP E,2 ! 1606: 1407a218 ! 1607: > * NAME GLOBAL LABELS, INTERNAL PROCEDURES AND ROUTINES. ! 1608: 1409,1410c220,228 ! 1609: < * INTRODUCE THE INTERNAL PROCEDURES. ! 1610: < * ! 1611: --- ! 1612: > CMPCE GLB ! 1613: > CMPEL GLB ! 1614: > CMPLE GLB ! 1615: > CMPSE GLB ! 1616: > EVLXF GLB ! 1617: > EVLXN GLB ! 1618: > EVLXV GLB ! 1619: > LCNXE GLB ! 1620: > TRXQR GLB ! 1621: 1420d237 ! 1622: < APNDB INP E,2 ! 1623: 1428a246 ! 1624: > CBLCK INP N,1 ! 1625: 1437c255 ! 1626: < COPYB INP N,1 ! 1627: --- ! 1628: > COPND INP E,0 ! 1629: 1439d256 ! 1630: < DTACH INP E,0 ! 1631: 1444c261 ! 1632: < EVALI INP R,4 ! 1633: --- ! 1634: > EVALI INP R,3 ! 1635: 1446c263 ! 1636: < EVALS INP R,3 ! 1637: --- ! 1638: > EVALS INP R,2 ! 1639: 1453,1455d269 ! 1640: < .IF .CULC ! 1641: < FLSTG INP R,0 ! 1642: < .FI ! 1643: 1458a273,276 ! 1644: > .IF .CNBF ! 1645: > .ELSE ! 1646: > GTBUF INP E,1 ! 1647: > .FI ! 1648: 1481,1483c299,300 ! 1649: < IOFCB INP N,2 ! 1650: < IOPPF INP N,0 ! 1651: < IOPUT INP N,6 ! 1652: --- ! 1653: > IOFTG INP N,1 ! 1654: > IOPUT INP N,4 ! 1655: 1500a318 ! 1656: > PRTCF INP E,0 ! 1657: 1502,1503c320,321 ! 1658: < PRTIC INP E,0 ! 1659: < PRTIS INP E,0 ! 1660: --- ! 1661: > PRTFB INP E,0 ! 1662: > PRTFH INP R,0 ! 1663: 1506,1507d323 ! 1664: < PRTMX INP E,0 ! 1665: < PRTNL INP R,0 ! 1666: 1511a328 ! 1667: > PRTSF INP E,0 ! 1668: 1515c332 ! 1669: < PRTTR INP E,0 ! 1670: --- ! 1671: > PRTVF INP E,0 ! 1672: 1517a335,336 ! 1673: > PTTFH INP E,0 ! 1674: > PTTST INP E,0 ! 1675: 1522a342,345 ! 1676: > .IF .CASL ! 1677: > SBSCC INP E,0 ! 1678: > SBSTG INP E,0 ! 1679: > .FI ! 1680: 1529c352 ! 1681: < SORTA INP N,0 ! 1682: --- ! 1683: > SORTA INP N,1 ! 1684: 1532c355 ! 1685: < SORTH INP E,0 ! 1686: --- ! 1687: > SORTH INP N,0 ! 1688: 1535c358 ! 1689: < TRACE INP N,2 ! 1690: --- ! 1691: > TRACE INP N,3 ! 1692: 1536a360 ! 1693: > TRCHN INP E,1 ! 1694: 1541,1543d364 ! 1695: < * ! 1696: < * INTRODUCE THE INTERNAL ROUTINES ! 1697: < * ! 1698: 1545a367,368 ! 1699: > EROSI INR ! 1700: > ERROR INR ! 1701: 1560a384 ! 1702: > INITL INR ! 1703: 1562a387 ! 1704: > STAKV INR ! 1705: 1567,1568d391 ! 1706: < SYSAB INR ! 1707: < SYSTU INR ! 1708: 1569a393,395 ! 1709: > * THIS SECTION CONTAINS ALL SYMBOL DEFINITIONS AND ALSO ! 1710: > * PICTURES OF ALL DATA STRUCTURES USED IN THE SYSTEM. ! 1711: > * ! 1712: 1577a404,407 ! 1713: > * NOTE THAT EVEN IF CONDITIONAL ASSEMBLY IS USED TO OMIT ! 1714: > * SOME FEATURE (E.G. REAL ARITHMETIC) A FULL SET OF CFP$- ! 1715: > * VALUES MUST BE SUPPLIED. USE DUMMY VALUES IF GENUINE ! 1716: > * ONES ARE NOT NEEDED. ! 1717: 1581c411 ! 1718: < CFP$B EQU * BYTES/WORD ADDRESSING FACTOR ! 1719: --- ! 1720: > CFP$B EQU * BAUS/WORD ADDRESSING FACTOR ! 1721: 1585c415 ! 1722: < CFP$F EQU * OFFSET IN BYTES TO CHARS IN ! 1723: --- ! 1724: > CFP$F EQU * OFFSET IN BAUS TO CHARS IN ! 1725: 1594,1601d423 ! 1726: < * THE FOLLOWING DEFINITIONS REQUIRE THE SUPPLY OF EITHER ! 1727: < * A SINGLE PARAMETER IF REAL ARITHMETIC IS OMITTED OR ! 1728: < * THREE PARAMETERS IF REAL ARITHMETIC IS INCLUDED. ! 1729: < * ! 1730: < .IF .CNRA ! 1731: < NSTMX EQU * NO. OF DECIMAL DIGITS IN CFP$M ! 1732: < .ELSE ! 1733: < * ! 1734: 1606,1613d427 ! 1735: < CFP$X EQU * MAX DIGITS IN REAL EXPONENT ! 1736: < * ! 1737: < MXDGS EQU CFP$S+CFP$X MAX DIGITS IN REAL NUMBER ! 1738: < * ! 1739: < NSTMX EQU MXDGS+5 MAX SPACE FOR REAL (FOR +0.E+) ! 1740: < .FI ! 1741: < .IF .CUCF ! 1742: < * ! 1743: 1620c434,439 ! 1744: < .FI ! 1745: --- ! 1746: > * ! 1747: > CFP$X EQU * MAX DIGITS IN REAL EXPONENT ! 1748: > * ! 1749: > MXDGS EQU CFP$S+CFP$X MAX DIGITS IN REAL NUMBER ! 1750: > * ! 1751: > NSTMX EQU MXDGS+5 MAX SPACE FOR REAL (FOR +0.E+) ! 1752: 1759a579 ! 1753: > * THEY ARE ALL UNDER CONDITIONAL ASSEMBLY. ! 1754: 1798a619,620 ! 1755: > .IF .CASL ! 1756: > DFA$A EQU CH$$A-CH$LA DIFF BETWEEN LC AND UC LETTERS ! 1757: 1800,1807d621 ! 1758: < * IF A DELIMITER OTHER THAN CH$CM MUST BE USED IN ! 1759: < * THE THIRD ARGUMENT OF INPUT(),OUTPUT() THEN .CIOD SHOULD ! 1760: < * BE DEFINED AND A PARAMETER SUPPLIED FOR IODEL. ! 1761: < * ! 1762: < .IF .CIOD ! 1763: < IODEL EQU * ! 1764: < .ELSE ! 1765: < IODEL EQU CH$CM ! 1766: 1927c741,742 ! 1767: < BL$CT EQU BL$CM+1 CTBLK ! 1768: --- ! 1769: > BL$CO EQU BL$CM+1 COBLK ! 1770: > BL$CT EQU BL$CO+1 CTBLK ! 1771: 2030,2033d844 ! 1772: < .IF .CNBF ! 1773: < .ELSE ! 1774: < * BCBLK BUFFER CONTROL BLOCK ! 1775: < .FI ! 1776: 2079c890 ! 1777: < ARLEN EQU IDVAL+1 LENGTH OF ARBLK IN BYTES ! 1778: --- ! 1779: > ARLEN EQU IDVAL+1 LENGTH OF ARBLK IN BAUS ! 1780: 2096c907 ! 1781: < * THE LENGTH OF AN ARBLK IN BYTES MAY NOT EXCEED MXLEN. ! 1782: --- ! 1783: > * THE LENGTH OF AN ARBLK IN BAUS MAY NOT EXCEED MXLEN. ! 1784: 2103c914 ! 1785: < * ! 1786: --- ! 1787: > EJC ! 1788: 2197,2198c1008,1009 ! 1789: < CCLEN EQU CCTYP+1 LENGTH OF CCBLK IN BYTES ! 1790: < CCUSE EQU CCLEN+1 OFFSET PAST LAST USED WORD (BYTES) ! 1791: --- ! 1792: > CCLEN EQU CCTYP+1 LENGTH OF CCBLK IN BAUS ! 1793: > CCUSE EQU CCLEN+1 OFFSET PAST LAST USED WORD (BAUS) ! 1794: 2227c1038 ! 1795: < CDLEN EQU OFFS2 LENGTH OF CDBLK IN BYTES ! 1796: --- ! 1797: > CDLEN EQU OFFS2 LENGTH OF CDBLK IN BAUS ! 1798: 2564c1375 ! 1799: < CMLEN EQU CMIDN+1 LENGTH OF CMBLK IN BYTES ! 1800: --- ! 1801: > CMLEN EQU CMIDN+1 LENGTH OF CMBLK IN BAUS ! 1802: 2626a1438,1477 ! 1803: > * COPY FILE BLOCK (COBLK) ! 1804: > * ! 1805: > * A CHAIN STACK OF COPY BLOCKS IS BUILT FOR EVERY NESTED ! 1806: > * -COPY CONTROL CARD. THE CONTROL BLOCK IS USED TO PRESERVE ! 1807: > * THE INPUT CONTEXT OF THE FILE CONTAINING THE -COPY. ! 1808: > * AS -COPYS ARE ENDED, THESE BLOCKS ARE POPPED OFF THE CHAIN ! 1809: > * AND THE STATE RESTORED. SEE ROUTINES CNCRD, COPND. ! 1810: > * ! 1811: > * +------------------------------------+ ! 1812: > * I COTYP I ! 1813: > * +------------------------------------+ ! 1814: > * I CONXT I ! 1815: > * +------------------------------------+ ! 1816: > * I COIOT I ! 1817: > * +------------------------------------+ ! 1818: > * I COTTI I ! 1819: > * +------------------------------------+ ! 1820: > * I COCIM I ! 1821: > * +------------------------------------+ ! 1822: > * I COSPT I ! 1823: > * +------------------------------------+ ! 1824: > * I COSLS I ! 1825: > * +------------------------------------+ ! 1826: > * I COSIN I ! 1827: > * +------------------------------------+ ! 1828: > * I COSTL I ! 1829: > * +------------------------------------+ ! 1830: > * ! 1831: > COTYP EQU 0 POINTER TO DUMMY ROUTINE B$COP ! 1832: > CONXT EQU COTYP+1 POINT TO NEXT (OUTER -COPY) COBLK ! 1833: > COIOT EQU CONXT+1 RECORD IOTAG FOR OSINT ! 1834: > COTTI EQU COIOT+1 RECORD TTINS FLAG ! 1835: > COCIM EQU COTTI+1 RECORD R$CIM COMPILER IMAGE ! 1836: > COSPT EQU COCIM+1 RECORD SCNPT SCAN POINTER ! 1837: > COSLS EQU COSPT+1 RECORD CSWLS LISTING FLAG ! 1838: > COSIN EQU COSLS+1 RECORD CSWIN -INXXX VALUE ! 1839: > COSTL EQU COSIN+1 RECORD R$STL -STITL STRING PTR ! 1840: > COSI$ EQU COSTL+1 SIZE OF COBLK ! 1841: > EJC ! 1842: > * ! 1843: 2688c1539 ! 1844: < DFLEN EQU FARGS+1 LENGTH OF DFBLK IN BYTES ! 1845: --- ! 1846: > DFLEN EQU FARGS+1 LENGTH OF DFBLK IN BAUS ! 1847: 2798a1650,1651 ! 1848: > .IF .CNLD ! 1849: > .ELSE ! 1850: 2826c1679 ! 1851: < EFLEN EQU FARGS+1 LENGTH OF EFBLK IN BYTES ! 1852: --- ! 1853: > EFLEN EQU FARGS+1 LENGTH OF EFBLK IN BAUS ! 1854: 2845a1699,1700 ! 1855: > * 4 TYPE IS BUFFER ! 1856: > .FI ! 1857: 2901c1756 ! 1858: < EXLEN EQU EXSTM+1 LENGTH OF EXBLK IN BYTES ! 1859: --- ! 1860: > EXLEN EQU EXSTM+1 LENGTH OF EXBLK IN BAUS ! 1861: 2941c1796 ! 1862: < FFOFS EQU FFNXT+1 OFFSET (BYTES) TO FIELD IN PDBLK ! 1863: --- ! 1864: > FFOFS EQU FFNXT+1 OFFSET (BAUS) TO FIELD IN PDBLK ! 1865: 3022c1877 ! 1866: < * IS FOUND NMOFS BYTES PAST THE ADDRESS IN NMBAS. ! 1867: --- ! 1868: > * IS FOUND NMOFS BAUS PAST THE ADDRESS IN NMBAS. ! 1869: 3135c1990 ! 1870: < * CONTAINS THE LENGTH OF THE PDBLK IN BYTES (FIELD DFPDL). ! 1871: --- ! 1872: > * CONTAINS THE LENGTH OF THE PDBLK IN BAUS (FIELD DFPDL). ! 1873: 3169c2024 ! 1874: < PFLEN EQU FARGS+1 LENGTH OF PFBLK IN BYTES ! 1875: --- ! 1876: > PFLEN EQU FARGS+1 LENGTH OF PFBLK IN BAUS ! 1877: 3176c2031 ! 1878: < PFAGB EQU PFARG-1 OFFSET BEHIND PFARG FOR ARG, LOCAL ! 1879: --- ! 1880: > PFAGB EQU PFARG-1 OFFSET BEHIND PFARG FOR ARG,LOCAL ! 1881: 3237c2092 ! 1882: < * IS GIVEN IN BYTES BY CFP$F AND THAT THIS VALUE IS ! 1883: --- ! 1884: > * IS GIVEN IN BAUS BY CFP$F AND THAT THIS VALUE IS ! 1885: 3278c2133 ! 1886: < * I SVCHS I ! 1887: --- ! 1888: > * / SVCHS / ! 1889: 3323c2178,2181 ! 1890: < SVFPK EQU SVFNP+SVKVC PREEVAL FCN + CONST KEYWD + VAL ! 1891: --- ! 1892: > .IF .CNFN ! 1893: > .ELSE ! 1894: > SVFPK EQU SVFNP+SVKVC PREEVAL FUNC + CONST KEYWD+VAL ! 1895: > .FI ! 1896: 3333c2191 ! 1897: < * THE ITEM AND APPLY FUNCTIONS FALL OUTSIDE THIS CATEGORY. ! 1898: --- ! 1899: > * THE APPLY FUNCTION FALLS OUTSIDE THIS CATEGORY. ! 1900: 3373c2231 ! 1901: < * PREDEFINED FUNCTIONS USING THIS ARE APPLY AND ITEM. ! 1902: --- ! 1903: > * PREDEFINED FUNCTION USING THIS IS APPLY. ! 1904: 3401,3409c2259,2260 ! 1905: < K$ABE EQU 0 ABEND ! 1906: < K$ANC EQU K$ABE+CFP$B ANCHOR ! 1907: < .IF .CULC ! 1908: < K$CAS EQU K$ANC+CFP$B CASE ! 1909: < K$COD EQU K$CAS+CFP$B CODE ! 1910: < .ELSE ! 1911: < K$COD EQU K$ANC+CFP$B CODE ! 1912: < .FI ! 1913: < K$DMP EQU K$COD+CFP$B DUMP ! 1914: --- ! 1915: > K$ANC EQU 0 ANCHOR ! 1916: > K$DMP EQU K$ANC+CFP$B DUMP ! 1917: 3447c2298,2299 ! 1918: < K$STC EQU K$RTN+1 STCOUNT ! 1919: --- ! 1920: > K$COD EQU K$RTN+1 CODE ! 1921: > K$STC EQU K$COD+1 STCOUNT ! 1922: 3454a2307 ! 1923: > K$$CD EQU K$COD-K$ALP CODE ! 1924: 3478d2330 ! 1925: < * +------------------------------------+ ! 1926: 3487c2339 ! 1927: < TBLEN EQU OFFS2 LENGTH OF TBBLK IN BYTES ! 1928: --- ! 1929: > TBLEN EQU OFFS2 LENGTH OF TBBLK IN BAUS ! 1930: 3546c2398 ! 1931: < * I TRTAG OR TRTER OR TRTRF I ! 1932: --- ! 1933: > * I TRTAG OR TRTER I ! 1934: 3548c2400 ! 1935: < * I TRFNC OR TRFPT I ! 1936: --- ! 1937: > * I TRFNC OR TRTRI I ! 1938: 3557c2409 ! 1939: < TRTAG EQU TRVAL+1 TRACE TAG ! 1940: --- ! 1941: > TRTAG EQU TRVAL+1 TRACE TAG OR IOTAG ! 1942: 3559d2410 ! 1943: < TRTRF EQU TRTAG PTR TO TRBLK HOLDING FCBLK PTR ! 1944: 3561c2412 ! 1945: < TRFPT EQU TRFNC FCBLK PTR FOR SYSIO ! 1946: --- ! 1947: > TRTRI EQU TRFNC PTR TO TRACE BLOCK HOLDING IOTAG ! 1948: 3567,3568c2418,2419 ! 1949: < TRTOU EQU TRTVL+1 TRACE TYPE FOR OUTPUT ASSOCIATION ! 1950: < TRTFC EQU TRTOU+1 TRACE TYPE FOR FCBLK IDENTIFICATION ! 1951: --- ! 1952: > TRTIO EQU TRTVL+1 TRACE TYPE FOR IOTAG TRACE BLOCK ! 1953: > TRTOU EQU TRTIO+1 TRACE TYPE FOR OUTPUT ASSOCIATION ! 1954: 3584,3586c2435 ! 1955: < * TRTRF POINTS TO THE TRAP BLOCK WHICH IN TURN POINTS ! 1956: < * TO AN FCBLK USED FOR I/O ASSOCIATION. ! 1957: < * TRFPT IS THE FCBLK PTR RETURNED BY SYSIO. ! 1958: --- ! 1959: > * TRTRI IS A PTR TO IOTAG TRBLK FROM SYSIO OR ZERO. ! 1960: 3625,3627c2474 ! 1961: < * TRTRF POINTS TO THE TRAP BLOCK WHICH IN TURN POINTS ! 1962: < * TO AN FCBLK USED FOR I/O ASSOCIATION. ! 1963: < * TRFPT IS THE FCBLK PTR RETURNED BY SYSIO. ! 1964: --- ! 1965: > * TRTRI IS A PTR TO IOTAG TRBLK FROM SYSIO OR ZERO. ! 1966: 3681c2528 ! 1967: < * INPUT/OUTPUT FILE ARG1 TRAP BLOCK ! 1968: --- ! 1969: > * INPUT/OUTPUT FILETAG TRAP BLOCK (TRTIO) ! 1970: 3683c2530 ! 1971: < * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK ! 1972: --- ! 1973: > * THE VALUE FIELD OF THE FILETAG VBL POINTS TO A TRBLK ! 1974: 3687,3689c2534 ! 1975: < * TO HOLD A POINTER TO THE FCBLK WHICH AN ! 1976: < * IMPLEMENTATION MAY REQUEST TO HOLD INFORMATION ! 1977: < * ABOUT A FILE. ! 1978: --- ! 1979: > * TO HOLD THE IOTAG RETURNED BY A SYSIO CALL ! 1980: 3691,3694c2536,2538 ! 1981: < * TRTYP IS SET TO TRTFC ! 1982: < * TRNEXT POINTS TO NEXT TRBLK OR TRVAL IS VARIABLE VAL ! 1983: < * TRFNM IS 0 ! 1984: < * TRFPT IS THE FCBLK POINTER. ! 1985: --- ! 1986: > * TRTYP IS SET TO TRTIO ! 1987: > * TRNXT POINTS TO NEXT TRBLK OR TRVAL IS VARIABLE VAL ! 1988: > * TRTAG HOLDS THE IOTAG. ! 1989: 3701a2546 ! 1990: > * FILETAG ASSOCIATION (IF PRESENT) ! 1991: 3729c2574 ! 1992: < VCLEN EQU OFFS2 LENGTH OF VCBLK IN BYTES ! 1993: --- ! 1994: > VCLEN EQU OFFS2 LENGTH OF VCBLK IN BAUS ! 1995: 3832c2677 ! 1996: < * VRCHS IS THE NAME (LJRZ) IF VRLEN IS NON-ZERO. ! 1997: --- ! 1998: > * VRCHS IS THE NAME IF VRLEN IS NON-ZERO. ! 1999: 3843,3844d2687 ! 2000: < * THIS TYPE OF BLOCK MAY BE USED AS A FILE CONTROL BLOCK. ! 2001: < * SEE SYSFC,SYSIN,SYSOU,S$INP,S$OUP FOR DETAILS. ! 2002: 3857c2700 ! 2003: < XNLEN EQU XNTYP+1 LENGTH OF XNBLK IN BYTES ! 2004: --- ! 2005: > XNLEN EQU XNTYP+1 LENGTH OF XNBLK IN BAUS ! 2006: 3873,3874d2715 ! 2007: < * THIS TYPE OF BLOCK MAY BE USED AS A FILE CONTROL BLOCK. ! 2008: < * SEE SYSFC,SYSIN,SYSOU,S$INP,S$OUP FOR DETAILS. ! 2009: 3887c2728 ! 2010: < XRLEN EQU XRTYP+1 LENGTH OF XRBLK IN BYTES ! 2011: --- ! 2012: > XRLEN EQU XRTYP+1 LENGTH OF XRBLK IN BAUS ! 2013: 3911,3912c2752 ! 2014: < INILN EQU 132 DEFAULT IMAGE LENGTH FOR COMPILER ! 2015: < INILS EQU 80 IMAGE LENGTH IF -SEQU IN EFFECT ! 2016: --- ! 2017: > INILN EQU 160 DEFAULT IMAGE LENGTH FOR COMPILER ! 2018: 3914,3916d2753 ! 2019: < IONMB EQU 2 NAME BASE USED FOR IOCHN IN SYSIO ! 2020: < IONMO EQU 4 NAME OFFSET USED FOR IOCHN IN SYSIO ! 2021: < * ! 2022: 3931d2767 ! 2023: < NINI8 EQU 998 ! 2024: 3934d2769 ! 2025: < EJC ! 2026: 3945c2780 ! 2027: < RILEN EQU 120 BUFFER LENGTH FOR SYSRI ! 2028: --- ! 2029: > RILEN EQU 160 BUFFER LENGTH FOR SYSRI ! 2030: 4051,4053c2886,2888 ! 2031: < .IF .CULC ! 2032: < CC$CA EQU 0 -CASE ! 2033: < CC$DO EQU CC$CA+1 -DOUBLE ! 2034: --- ! 2035: > .IF .CASL ! 2036: > CC$CI EQU 0 -CASEIG ! 2037: > CC$CO EQU CC$CI+1 -COPY ! 2038: 4055c2890 ! 2039: < CC$DO EQU 0 -DOUBLE ! 2040: --- ! 2041: > CC$CO EQU 0 -COPY ! 2042: 4057,4061c2892,2893 ! 2043: < CC$DU EQU CC$DO+1 -DUMP ! 2044: < CC$EJ EQU CC$DU+1 -EJECT ! 2045: < CC$ER EQU CC$EJ+1 -ERRORS ! 2046: < CC$EX EQU CC$ER+1 -EXECUTE ! 2047: < CC$FA EQU CC$EX+1 -FAIL ! 2048: --- ! 2049: > CC$EJ EQU CC$CO+1 -EJECT ! 2050: > CC$FA EQU CC$EJ+1 -FAIL ! 2051: 4063,4065c2895,2900 ! 2052: < CC$NR EQU CC$LI+1 -NOERRORS ! 2053: < CC$NX EQU CC$NR+1 -NOEXECUTE ! 2054: < CC$NF EQU CC$NX+1 -NOFAIL ! 2055: --- ! 2056: > .IF .CASL ! 2057: > CC$NC EQU CC$LI+1 -NOCASEIG ! 2058: > CC$NF EQU CC$NC+1 -NOFAIL ! 2059: > .ELSE ! 2060: > CC$NF EQU CC$LI+1 -NOFAIL ! 2061: > .FI ! 2062: 4067,4073c2902 ! 2063: < CC$NO EQU CC$NL+1 -NOOPT ! 2064: < CC$NP EQU CC$NO+1 -NOPRINT ! 2065: < CC$OP EQU CC$NP+1 -OPTIMISE ! 2066: < CC$PR EQU CC$OP+1 -PRINT ! 2067: < CC$SI EQU CC$PR+1 -SINGLE ! 2068: < CC$SP EQU CC$SI+1 -SPACE ! 2069: < CC$ST EQU CC$SP+1 -STITL ! 2070: --- ! 2071: > CC$ST EQU CC$NL+1 -STITL ! 2072: 4076c2905 ! 2073: < CC$NC EQU CC$TR+1 NUMBER OF CONTROL CARDS ! 2074: --- ! 2075: > CC$CT EQU CC$TR+1 NUMBER OF CONTROL CARDS ! 2076: 4079d2907 ! 2077: < EJC ! 2078: 4108d2935 ! 2079: < * ! 2080: 4157c2984 ! 2081: < .IF .CULC ! 2082: --- ! 2083: > .IF .CASL ! 2084: 4159c2986 ! 2085: < DTC /DOUB/ ! 2086: --- ! 2087: > DTC /COPY/ ! 2088: 4161c2988 ! 2089: < CCNMS DTC /DOUB/ ! 2090: --- ! 2091: > CCNMS DTC /COPY/ ! 2092: 4163d2989 ! 2093: < DTC /DUMP/ ! 2094: 4165,4166d2990 ! 2095: < DTC /ERRO/ ! 2096: < DTC /EXEC/ ! 2097: 4169,4170c2993,2995 ! 2098: < DTC /NOER/ ! 2099: < DTC /NOEX/ ! 2100: --- ! 2101: > .IF .CASL ! 2102: > DTC /NOCA/ ! 2103: > .FI ! 2104: 4173,4178d2997 ! 2105: < DTC /NOOP/ ! 2106: < DTC /NOPR/ ! 2107: < DTC /OPTI/ ! 2108: < DTC /PRIN/ ! 2109: < DTC /SING/ ! 2110: < DTC /SPAC/ ! 2111: 4185c3004 ! 2112: < DMHDK DAC B$SCL DUMP OF KEYWORD VALUES ! 2113: --- ! 2114: > DMHDK DAC B$SCL ! 2115: 4187c3006 ! 2116: < DTC /DUMP OF KEYWORD VALUES/ ! 2117: --- ! 2118: > DDC /DUMP OF KEYWORD VALUES/ ! 2119: 4189c3008 ! 2120: < DMHDV DAC B$SCL DUMP OF NATURAL VARIABLES ! 2121: --- ! 2122: > DMHDV DAC B$SCL ! 2123: 4191,4192c3010 ! 2124: < DTC /DUMP OF NATURAL VARIABLES/ ! 2125: < EJC ! 2126: --- ! 2127: > DDC /DUMP OF NATURAL VARIABLES/ ! 2128: 4198c3016 ! 2129: < DTC /STORE USED/ ! 2130: --- ! 2131: > DDC /STORE USED/ ! 2132: 4202c3020 ! 2133: < DTC /STORE LEFT/ ! 2134: --- ! 2135: > DDC /STORE LEFT/ ! 2136: 4206c3024 ! 2137: < DTC /COMP ERRORS/ ! 2138: --- ! 2139: > DDC /COMP ERRORS/ ! 2140: 4210c3028,3032 ! 2141: < DTC /COMP TIME-MSEC/ ! 2142: --- ! 2143: > .IF .CTMD ! 2144: > DDC /COMP TIME-DSEC/ ! 2145: > .ELSE ! 2146: > DDC /COMP TIME-MSEC/ ! 2147: > .FI ! 2148: 4212c3034 ! 2149: < ENCM5 DAC B$SCL EXECUTION SUPPRESSED ! 2150: --- ! 2151: > ENCM5 DAC B$SCL ! 2152: 4214c3036,3037 ! 2153: < DTC /EXECUTION SUPPRESSED/ ! 2154: --- ! 2155: > DDC /EXECUTION SUPPRESSED/ ! 2156: > EJC ! 2157: 4216c3039 ! 2158: < * STRING CONSTANT FOR ABNORMAL END ! 2159: --- ! 2160: > * FOR TERMINATION IN COMPILATION ! 2161: 4218,4221c3041,3043 ! 2162: < ENDAB DAC B$SCL ! 2163: < DAC 12 ! 2164: < DTC /ABNORMAL END/ ! 2165: < EJC ! 2166: --- ! 2167: > ENDIC DAC B$SCL ! 2168: > DAC 14 ! 2169: > DDC /IN COMPILATION/ ! 2170: 4227c3049 ! 2171: < DTC /MEMORY OVERFLOW/ ! 2172: --- ! 2173: > DDC /MEMORY OVERFLOW/ ! 2174: 4233c3055 ! 2175: < DTC /NORMAL END/ ! 2176: --- ! 2177: > DDC /NORMAL END/ ! 2178: 4237c3059 ! 2179: < ENDSO DAC B$SCL STACK OVERFLOW IN GARBAGE COLLECTOR ! 2180: --- ! 2181: > ENDSO DAC B$SCL ! 2182: 4239,4245c3061 ! 2183: < DTC /STACK OVERFLOW IN GARBAGE COLLECTION/ ! 2184: < * ! 2185: < * STRING CONSTANT FOR TIME UP ! 2186: < * ! 2187: < ENDTU DAC B$SCL ! 2188: < DAC 15 ! 2189: < DTC /ERROR - TIME UP/ ! 2190: --- ! 2191: > DDC /STACK OVERFLOW IN GARBAGE COLLECTION/ ! 2192: 4250c3066 ! 2193: < ERMMS DAC B$SCL ERROR ! 2194: --- ! 2195: > ERMMS DAC B$SCL ! 2196: 4252c3068 ! 2197: < DTC /ERROR/ ! 2198: --- ! 2199: > DDC /ERROR/ ! 2200: 4254c3070 ! 2201: < ERMNS DAC B$SCL STRING / -- / ! 2202: --- ! 2203: > ERMNS DAC B$SCL ! 2204: 4257a3074,3076 ! 2205: > * ! 2206: > ERRTF DAC 251 FATAL ERROR CODE - SEE LABEL ERRAF ! 2207: > * ! 2208: 4260c3079 ! 2209: < LSTMS DAC B$SCL PAGE ! 2210: --- ! 2211: > LSTMS DAC B$SCL ! 2212: 4262c3081 ! 2213: < DTC /PAGE / ! 2214: --- ! 2215: > DDC /PAGE / ! 2216: 4268c3087 ! 2217: < DTC /MACRO SPITBOL VERSION 3.5/ ! 2218: --- ! 2219: > DDC /MACRO SPITBOL VERSION 4.3/ ! 2220: 4272c3091 ! 2221: < DTC /3.5/ ! 2222: --- ! 2223: > DTC /4.3/ ! 2224: 4301a3121,3123 ! 2225: > NDEXC DAC P$EXC EXPRESSION ! 2226: > .IF .CNFN ! 2227: > .ELSE ! 2228: 4304c3126 ! 2229: < NDEXC DAC P$EXC EXPRESSION ! 2230: --- ! 2231: > .FI ! 2232: 4351,4353c3173,3175 ! 2233: < * OPDVS IS USED WHEN SCANNING BELOW THE TOP LEVEL TO ! 2234: < * INSURE THAT THE CONCATENATION WILL NOT BE LATER ! 2235: < * MISTAKEN FOR PATTERN MATCHING ! 2236: --- ! 2237: > * OPDVP IS USED WHEN SCANNING BELOW TOP LEVEL TO ENSURE ! 2238: > * THE CONCATENATION WILL NOT LATER BE MISTAKEN FOR ! 2239: > * PATTERN MATCHING ! 2240: 4355c3177 ! 2241: < OPDVP DAC O$CNC CONCATENATION - NOT PATTERN MATCH ! 2242: --- ! 2243: > OPDVP DAC O$CNC PROVEN CONCATENATION ! 2244: 4459,4467d3280 ! 2245: < DAC O$IMA IMMEDIATE ASSIGNMENT ! 2246: < DAC C$BVN ! 2247: < DAC LLDLD ! 2248: < DAC RRDLD ! 2249: < * ! 2250: < DAC O$INV INDIRECTION ! 2251: < DAC C$IND ! 2252: < DAC LLUNO ! 2253: < * ! 2254: 4497a3311,3319 ! 2255: > DAC O$IMA IMMEDIATE ASSIGNMENT ! 2256: > DAC C$BVN ! 2257: > DAC LLDLD ! 2258: > DAC RRDLD ! 2259: > * ! 2260: > DAC O$INV INDIRECTION ! 2261: > DAC C$IND ! 2262: > DAC LLUNO ! 2263: > * ! 2264: 4580c3402 ! 2265: < DTC /PROGRAM PROFILE/ ! 2266: --- ! 2267: > DDC /PROGRAM PROFILE/ ! 2268: 4583c3405 ! 2269: < DTC /STMT NUMBER OF -- EXECUTION TIME --/ ! 2270: --- ! 2271: > DDC /STMT NUMBER OF -- EXECUTION TIME --/ ! 2272: 4586c3408 ! 2273: < DTC /NUMBER EXECUTIONS TOTAL(MSEC) PER EXCN(MCSEC)/ ! 2274: --- ! 2275: > DDC /NUMBER EXECUTIONS TOTAL(MSEC) PER EXCN(MCSEC)/ ! 2276: 4588d3409 ! 2277: < * ! 2278: 4616a3438,3439 ! 2279: > .IF .CNBF ! 2280: > .ELSE ! 2281: 4618c3441 ! 2282: < SCBUF DAC B$SCL BUFFER ! 2283: --- ! 2284: > SCBUF DAC B$SCL ! 2285: 4620a3444 ! 2286: > .FI ! 2287: 4717a3542,3544 ! 2288: > .IF .CS16 ! 2289: > STLIM DIC +32767 DEFAULT STATEMENT LIMIT ! 2290: > .ELSE ! 2291: 4718a3546 ! 2292: > .FI ! 2293: 4749c3577 ! 2294: < STPM1 DAC B$SCL IN STATEMENT ! 2295: --- ! 2296: > STPM1 DAC B$SCL ! 2297: 4751c3579 ! 2298: < DTC /IN STATEMENT/ ! 2299: --- ! 2300: > DDC /IN STATEMENT/ ! 2301: 4755c3583 ! 2302: < DTC /STMTS EXECUTED/ ! 2303: --- ! 2304: > DDC /STMTS EXECUTED/ ! 2305: 4759c3587,3591 ! 2306: < DTC /RUN TIME-MSEC/ ! 2307: --- ! 2308: > .IF .CTMD ! 2309: > DDC /RUN TIME-DSEC/ ! 2310: > .ELSE ! 2311: > DDC /RUN TIME-MSEC/ ! 2312: > .FI ! 2313: 4763c3595 ! 2314: < DTC $MCSEC / STMT$ ! 2315: --- ! 2316: > DDC $MCSEC / STMT$ ! 2317: 4767c3599 ! 2318: < DTC /REGENERATIONS/ ! 2319: --- ! 2320: > DDC /REGENERATIONS/ ! 2321: 4769,4772d3600 ! 2322: < * CHARS FOR /TU/ ENDING CODE ! 2323: < * ! 2324: < STRTU DTC /TU/ ! 2325: < * ! 2326: 4800c3628 ! 2327: < TMASB DAC B$SCL ASTERISKS FOR TRACE STATEMENT NO ! 2328: --- ! 2329: > TMASB DAC B$SCL ! 2330: 4803d3630 ! 2331: < ! 2332: 4805c3632 ! 2333: < TMBEB DAC B$SCL BLANK-EQUAL-BLANK ! 2334: --- ! 2335: > TMBEB DAC B$SCL ! 2336: 4891a3719,3724 ! 2337: > V$CTI DBC SVFNP CTI ! 2338: > DAC 3 ! 2339: > DTC /CTI/ ! 2340: > DAC S$CTI ! 2341: > DAC 1 ! 2342: > * ! 2343: 4896a3730,3735 ! 2344: > V$ITC DBC SVFNN ITC ! 2345: > DAC 3 ! 2346: > DTC /ITC/ ! 2347: > DAC S$ITC ! 2348: > DAC 1 ! 2349: > * ! 2350: 4967d3805 ! 2351: < .IF .CULC ! 2352: 4969,4980d3806 ! 2353: < V$CAS DBC SVKNM CASE ! 2354: < DAC 4 ! 2355: < DTC /CASE/ ! 2356: < DAC K$CAS ! 2357: < .FI ! 2358: < * ! 2359: < V$CHR DBC SVFNP CHAR ! 2360: < DAC 4 ! 2361: < DTC /CHAR/ ! 2362: < DAC S$CHR ! 2363: < DAC 1 ! 2364: < * ! 2365: 5077a3904 ! 2366: > EJC ! 2367: 5078a3906,3908 ! 2368: > * STANDARD VARIABLE BLOCKS (CONTINUED) ! 2369: > * ! 2370: > * ! 2371: 5133,5137d3962 ! 2372: < V$ABE DBC SVKNM ABEND ! 2373: < DAC 5 ! 2374: < DTC /ABEND/ ! 2375: < DAC K$ABE ! 2376: < * ! 2377: 5183a4009,4011 ! 2378: > .IF .CNFN ! 2379: > V$FEN DBC SVKVC FENCE ! 2380: > .ELSE ! 2381: 5184a4013 ! 2382: > .FI ! 2383: 5187a4017,4018 ! 2384: > .IF .CNFN ! 2385: > .ELSE ! 2386: 5189a4021 ! 2387: > .FI ! 2388: 5217d4048 ! 2389: < * ! 2390: 5257a4089,4092 ! 2391: > EJC ! 2392: > * ! 2393: > * STANDARD VARIABLE BLOCKS (CONTINUED) ! 2394: > * ! 2395: 5260,5261c4095 ! 2396: < * ! 2397: < V$APN DBC SVFNN ! 2398: --- ! 2399: > V$APN DBC SVFNN APPEND ! 2400: 5273d4106 ! 2401: < * ! 2402: 5286c4119 ! 2403: < DAC S$DEF ! 2404: --- ! 2405: > DAC S$DFN ! 2406: 5294d4126 ! 2407: < EJC ! 2408: 5296,5297d4127 ! 2409: < * STANDARD VARIABLE BLOCKS (CONTINUED) ! 2410: < * ! 2411: 5308c4138 ! 2412: < * ! 2413: --- ! 2414: > EJC ! 2415: 5310a4141 ! 2416: > * ! 2417: 5316d4146 ! 2418: < * ! 2419: 5317a4148 ! 2420: > * ! 2421: 5341,5346d4171 ! 2422: < V$REW DBC SVFNN REWIND ! 2423: < DAC 6 ! 2424: < DTC /REWIND/ ! 2425: < DAC S$REW ! 2426: < DAC 1 ! 2427: < * ! 2428: 5377c4202 ! 2429: < DAC S$CNV ! 2430: --- ! 2431: > DAC S$CVT ! 2432: 5384c4209 ! 2433: < DAC 1 ! 2434: --- ! 2435: > DAC 2 ! 2436: 5414d4238 ! 2437: < * ! 2438: 5423a4248 ! 2439: > * ! 2440: 5462a4288,4293 ! 2441: > V$VDF DBC SVFPR VDIFFER ! 2442: > DAC 7 ! 2443: > DTC /VDIFFER/ ! 2444: > DAC S$VDF ! 2445: > DAC 2 ! 2446: > * ! 2447: 5466a4298 ! 2448: > EJC ! 2449: 5467a4300,4301 ! 2450: > * STANDARD VARIABLE BLOCKS (CONTINUED) ! 2451: > * ! 2452: 5472d4305 ! 2453: < EJC ! 2454: 5474,5475d4306 ! 2455: < * STANDARD VARIABLE BLOCKS (CONTINUED) ! 2456: < * ! 2457: 5516,5518d4346 ! 2458: < .IF .CULC ! 2459: < DAC V$CAS CCASE ! 2460: < .FI ! 2461: 5548,5553c4376,4377 ! 2462: < .IF .CULC ! 2463: < DAC V$CAS START OF 4 CHAR VARIABLES ! 2464: < .ELSE ! 2465: < DAC V$CHR START OF 4 CHAR VARIABLES ! 2466: < .FI ! 2467: < DAC V$ABE START OF 5 CHAR VARIABLES ! 2468: --- ! 2469: > DAC V$COD START OF 4 CHAR VARIABLES ! 2470: > DAC V$ABO START OF 5 CHAR VARIABLES ! 2471: 5598c4422 ! 2472: < * LABEL TO MARK START OF WORK AREA ! 2473: --- ! 2474: > * LABEL TO MARK START OF WORK AREA WHICH IS CLEARED ! 2475: 5663,5665c4487,4489 ! 2476: < CSWDB DAC 0 0/1 FOR -SINGLE/-DOUBLE ! 2477: < CSWER DAC 0 0/1 FOR -ERRORS/-NOERRORS ! 2478: < CSWEX DAC 0 0/1 FOR -EXECUTE/-NOEXECUTE ! 2479: --- ! 2480: > .IF .CASL ! 2481: > CSWCI DAC 0 0/1 FOR -NOCASEIG/CASEIG ! 2482: > .FI ! 2483: 5669,5670c4493 ! 2484: < CSWNO DAC 0 0/1 FOR -OPTIMISE/-NOOPT ! 2485: < CSWPR DAC 0 0/1 FOR -NOPRINT/-PRINT ! 2486: --- ! 2487: > EJC ! 2488: 5676d4498 ! 2489: < EJC ! 2490: 5711,5715d4532 ! 2491: < * WORK AREA FOR DTACH ! 2492: < * ! 2493: < DTCNB DAC 0 NAME BASE ! 2494: < DTCNM DAC 0 NAME PTR ! 2495: < * ! 2496: 5726,5727c4543 ! 2497: < ERICH DAC 0 COPY ERROR REPORTS TO INT.CHAN IF 1 ! 2498: < ERLST DAC 0 FOR LISTR WHEN ERRORS GO TO INT.CH. ! 2499: --- ! 2500: > EROSN DAC 0 FLAG FOR SPECIAL EROSI RETURN ! 2501: 5741a4558 ! 2502: > * ! 2503: 5798a4616 ! 2504: > GTNSV DIC +0 SAVE IA ! 2505: 5821a4640 ! 2506: > EJC ! 2507: 5827c4646 ! 2508: < * FLAG FOR HEADER PRINTING ! 2509: --- ! 2510: > * FLAGS FOR HEADER PRINTING ! 2511: 5828a4648 ! 2512: > HEADN DAC 0 NON-ZERO IF HDRS NOT TO BE PRINTED ! 2513: 5838a4659 ! 2514: > INICD DIC +0 CODE KWD VAL (NEEDED FOR BATCH) ! 2515: 5846c4667,4669 ! 2516: < INSAB DAC 0 ENTRY WA + ENTRY WB ! 2517: --- ! 2518: > INSAB DAC 0 ENTRY WA PLUS ENTRY WB ! 2519: > INSBB DAC 0 BFBLK POINTER ! 2520: > INSBC DAC 0 BCBLK POINTER ! 2521: 5849d4671 ! 2522: < INSSC DAC 0 SAVE ENTRY WC ! 2523: 5854c4676,4680 ! 2524: < IOPTT DAC 0 TYPE OF ASSOCIATION ! 2525: --- ! 2526: > IOPNF DAC 0 NAME OFFSET ! 2527: > IOPVR DAC 0 FILETAG VRBLK ! 2528: > IOPWA DAC 0 KEEP WA ! 2529: > IOPWB DAC 0 KEEP WB ! 2530: > IOPWC DAC 0 KEEP WC ! 2531: 5861d4686 ! 2532: < KVABE DAC 0 ABEND ! 2533: 5863,5866d4687 ! 2534: < .IF .CULC ! 2535: < KVCAS DAC 0 CASE ! 2536: < .FI ! 2537: < KVCOD DAC 0 CODE ! 2538: 5887a4709,4713 ! 2539: > KVCOD DIC 0 CODE ! 2540: > .IF .CS16 ! 2541: > KVSTL DIC +32767 STLIMIT ! 2542: > KVSTC DIC +32767 STCOUNT (COUNTS DOWN FROM STLIMIT) ! 2543: > .ELSE ! 2544: 5889a4716 ! 2545: > .FI ! 2546: 5897a4725 ! 2547: > EJC ! 2548: 5920c4748 ! 2549: < PFDMP DAC 0 SET NON-0 IF &PROFILE SET NON-0 ! 2550: --- ! 2551: > PFDMP DAC 0 SET NON-0 IF PROFILE SET NON-0 ! 2552: 5927c4755 ! 2553: < PFSTE DIC +0 GETS INT REP OF TABLE ENTRY SIZE ! 2554: --- ! 2555: > PFSTE DIC +0 TABLE ENTRY SIZE IN BAUS ! 2556: 5929d4756 ! 2557: < * ! 2558: 5938,5943d4764 ! 2559: < * FLAGS USED FOR STANDARD FILE LISTING OPTIONS ! 2560: < * ! 2561: < PRICH DAC 0 PRINTER ON INTERACTIVE CHANNEL ! 2562: < PRSTD DAC 0 TESTED BY PRTPG ! 2563: < PRSTO DAC 0 STANDARD LISTING OPTION FLAG ! 2564: < * ! 2565: 5957a4779,4780 ! 2566: > PRAVL DAC 0 SET IF PRINT FILE AVAILABLE ! 2567: > PRBLK DAC 0 ADDRESS OF BUFFER BLANKING STRING ! 2568: 5958a4782,4783 ! 2569: > PRCHS DAC 0 ADDRESS OF CHARS IN PRINT BUFFER ! 2570: > PRCMV DAC 0 NO. OF BAUS TO MOVE IN BFR CLEARING ! 2571: 5961d4785 ! 2572: < PRLNW DAC 0 LENGTH OF PRINT BUFFER IN WORDS ! 2573: 5962a4787,4789 ! 2574: > PRPUT DAC 0 SET IF CHARS TO BE PUT IN BFR ! 2575: > PRSTD DAC 0 TESTED BY PRTPG ! 2576: > PRSTO DAC 0 STANDARD LISTING OPTION FLAG ! 2577: 5965c4792 ! 2578: < * WORK AREAS FOR PRTST PROCEDURE ! 2579: --- ! 2580: > * WORK AREAS FOR PRTST, PTTST PROCEDURES ! 2581: 5969c4796,4797 ! 2582: < PRSVC DAC 0 SAVE CHAR COUNTER ! 2583: --- ! 2584: > PRTVA DAC 0 SAVE WA ! 2585: > PRTVB DAC 0 SAVE WB ! 2586: 5971,5975d4798 ! 2587: < * WORK AREA FOR PRTNL ! 2588: < * ! 2589: < PRTSA DAC 0 SAVE WA ! 2590: < PRTSB DAC 0 SAVE WB ! 2591: < * ! 2592: 5985a4809,4812 ! 2593: > * FLAG TO TELL ERROR THAT WE ARE READING SOURCE LINE ! 2594: > * ! 2595: > RDRER DAC 0 READ-SOURCE-LINE IN PROGRESS FLAG ! 2596: > * ! 2597: 6009a4837 ! 2598: > R$COP DAC 0 PTR TO -COPY CHAIN STACK ! 2599: 6014d4841 ! 2600: < R$FCB DAC 0 FCBLK CHAIN HEAD ! 2601: 6017,6022c4844,4847 ! 2602: < R$IO1 DAC 0 FILE ARG1 FOR IOPUT ! 2603: < R$IO2 DAC 0 FILE ARG2 FOR IOPUT ! 2604: < R$IOF DAC 0 FCBLK PTR OR 0 ! 2605: < R$ION DAC 0 NAME BASE PTR ! 2606: < R$IOP DAC 0 PREDECESSOR BLOCK PTR FOR IOPUT ! 2607: < R$IOT DAC 0 TRBLK PTR FOR IOPUT ! 2608: --- ! 2609: > R$IO1 DAC 0 FIRST ARGUMENT ! 2610: > R$IOL DAC 0 SECOND ARGUMENT (FILETAG) SCBLK PTR ! 2611: > R$IOR DAC 0 FILEPROPS SCBLK PTR ! 2612: > R$IOT DAC 0 TRTIO TRACE BLK PTR ! 2613: 6077a4903,4910 ! 2614: > * ! 2615: > * WORK AREA FOR DETACH PROCEDURE ! 2616: > * ! 2617: > SDETF DAC 0 TRACE BLOCK FLAG ! 2618: > * ! 2619: > * WORK AREA FOR ENDFILE PROCEDURE ! 2620: > * ! 2621: > SENFR DAC 0 SAVE XR ! 2622: 6102c4935 ! 2623: < * GLOBAL VALUE FOR INDICATING STAGE (SEE ERROR SECTION) ! 2624: --- ! 2625: > * VALUES FOR INDICATING COMPILATION/EXECUTION STAGE ! 2626: 6104a4938 ! 2627: > STAGX DAC 0 NON-ZERO IF EXECUTING ! 2628: 6119a4954 ! 2629: > STPXR DAC 0 SAVE XR ! 2630: 6133d4967 ! 2631: < TIMUP DAC 0 SET WHEN TIME UP OCCURS ! 2632: 6134a4969,4981 ! 2633: > * TERMINAL BUFFER ADDRESSES, FLAGS ETC ! 2634: > * ! 2635: > TTBLK DAC 0 BLANKING STRING ADRS ! 2636: > TTBUF DAC 0 BUFFER ADRS ! 2637: > TTCHS DAC 0 START OF BUFFER CHARACTERS ! 2638: > TTCMV DAC 0 COUNT OF BLANKING CHARS TO MOVE ! 2639: > TTERL DAC 0 ERROR FLAG ! 2640: > TTINS DAC 0 NON-ZERO IF STD INPUT FROM TERML ! 2641: > TTLEN DAC 0 LENGTH OF TERMINAL BUFFER ! 2642: > TTLST DAC 0 COPY STD O/P TO TERML IF SET ! 2643: > TTOFS DAC 0 OFFSET TO POSITION IN TERML BFR ! 2644: > TTOUS DAC 0 SET IF STD OUTPUT TO TERMINAL ! 2645: > * ! 2646: 6136a4984,4985 ! 2647: > XSCBL DAC 0 COUNT OF TRAILING BLANKS ! 2648: > XSCNB DAC 0 NON-ZERO IF NON-BLANKS SEEN ! 2649: 6155a5005 ! 2650: > * (WA) INITIAL &CODE VALUE ! 2651: 6158c5008,5010 ! 2652: < JSR SYSTM INITIALISE TIMER ! 2653: --- ! 2654: > * ! 2655: > INITL RTN INITIALISATION CODE ! 2656: > MOV WA,INICD SAVE INITIAL CODE KYWD VALUE ! 2657: 6160d5011 ! 2658: < STI TIMSX STORE TIME ! 2659: 6196c5047 ! 2660: < MOV WA,CSWIN -IN72 ! 2661: --- ! 2662: > MOV WA,CSWIN STORE FOR LATER USE ! 2663: 6206d5056 ! 2664: < STI TIMSX STORE TIME IN CORRECT PLACE ! 2665: 6211a5062,5068 ! 2666: > .IF .CSIG ! 2667: > MNZ CSWCI -CASEIG ! 2668: > .FI ! 2669: > JSR SYSTM INITIALISE TIMER ! 2670: > STI TIMSX STORE TIME ! 2671: > LDI INICD LOAD INITIAL CODE KWD VALUE ! 2672: > STI KVCOD STORE ! 2673: 6247a5105,5106 ! 2674: > ADD TTLEN,WA ADD TERMINAL BUFFER LENGTH ! 2675: > ADD WA,WA ALLOW FOR EQUALLY BIG BLANK STRINGS ! 2676: 6250c5109 ! 2677: < CTB WA,8 CONVERT TO BYTES, ALLOWING A MARGIN ! 2678: --- ! 2679: > CTB WA,8 CONVERT TO BAUS, ALLOWING A MARGIN ! 2680: 6258c5117 ! 2681: < BGT XR,WA,INI06 SKIP IF STATIC HI EXCEEDS MXLEN ! 2682: --- ! 2683: > BGT XR,WA,INI05 SKIP IF STATIC HI EXCEEDS MXLEN ! 2684: 6265c5124 ! 2685: < INI06 MOV XR,DNAMB DYNAMIC BASE ADRS ! 2686: --- ! 2687: > INI05 MOV XR,DNAMB DYNAMIC BASE ADRS ! 2688: 6267c5126 ! 2689: < BNZ WA,INI07 SKIP IF NON-ZERO MXLEN ! 2690: --- ! 2691: > BNZ WA,INI06 SKIP IF NON-ZERO MXLEN ! 2692: 6271d5129 ! 2693: < EJC ! 2694: 6276,6277c5134,5135 ! 2695: < INI07 MOV XL,DNAME STORE DYNAMIC END ADDRESS ! 2696: < BLT DNAMB,XL,INI09 SKIP IF HIGH ENOUGH ! 2697: --- ! 2698: > INI06 MOV XL,DNAME STORE DYNAMIC END ADDRESS ! 2699: > BLT DNAMB,XL,INI08 SKIP IF HIGH ENOUGH ! 2700: 6279c5137 ! 2701: < WTB XR GET AS BAUS (SGD05) ! 2702: --- ! 2703: > WTB XR CONVERT TO BAUS ! 2704: 6281c5139 ! 2705: < BNZ XR,INI07 TRY AGAIN ! 2706: --- ! 2707: > BNZ XR,INI06 TRY AGAIN ! 2708: 6283c5141 ! 2709: < MOV ENDML,WA MESSAGE LENGTH ! 2710: --- ! 2711: > MOV ENDML,WC MESSAGE LENGTH ! 2712: 6285c5143,5148 ! 2713: < PPM SHOULD NOT FAIL ! 2714: --- ! 2715: > PPM INI07 ! 2716: > PPM INI07 ! 2717: > * ! 2718: > * EMERGENCY SHUTDOWN ! 2719: > * ! 2720: > INI07 MOV =KVCOD,WA CODE KEYWORD ! 2721: 6286a5150 ! 2722: > EJC ! 2723: 6290c5154 ! 2724: < INI09 MOV PRLEN,WC NO. OF CHARS IN PRINT BFR ! 2725: --- ! 2726: > INI08 MOV PRLEN,WA NO. OF CHARS IN PRINT BFR ! 2727: 6294,6297c5158,5169 ! 2728: < MOV WC,(XR)+ AND STRING LENGTH ! 2729: < CTW WC,0 GET NUMBER OF WORDS IN BUFFER ! 2730: < MOV WC,PRLNW STORE FOR BUFFER CLEAR ! 2731: < LCT WC,WC WORDS TO CLEAR ! 2732: --- ! 2733: > MOV WA,(XR)+ AND STRING LENGTH ! 2734: > MOV XR,PRCHS KEEP ADRS OF BUFFER PROPER ! 2735: > MOV XR,XL COPY IT ! 2736: > CTB WA,0 WORDS NEEDED EXPRESSED IN BAUS ! 2737: > MOV WA,PRCMV KEEP FOR CLEARING BUFFER ! 2738: > MOV XR,PRBLK CONSTRUCT ADRS OF BLANKING STRING ! 2739: > ADD WA,PRBLK ADD OFFSET TO BLANKING STRING ! 2740: > ADD WA,WA CLEAR BOTH BFR AND BLANKING STRING ! 2741: > MOV NULLW,(XR)+ CLEAR FIRST WORD ! 2742: > BZE WA,INI09 SKIP IF NO PRINT BUFFER ! 2743: > DCA WA ADJUST FOR FIRST WORD ! 2744: > MVW PERFORM BLANKING ! 2745: 6299c5171 ! 2746: < * LOOP TO CLEAR BUFFER ! 2747: --- ! 2748: > * SET UP TERMINAL BUFFER ! 2749: 6301,6302c5173,5187 ! 2750: < INI10 MOV NULLW,(XR)+ STORE BLANK ! 2751: < BCT WC,INI10 LOOP ! 2752: --- ! 2753: > INI09 MOV TTLEN,WA LENGTH OF TERMINAL BUFFER ! 2754: > MOV XR,TTBUF ADRS OF TERMINAL STRING BUFFER ! 2755: > MOV =B$SCL,(XR)+ STRING TYPE CODE ! 2756: > MOV WA,(XR)+ STRING LENGTH ! 2757: > MOV XR,TTCHS KEEP ADRS OF BUFFER PROPER ! 2758: > MOV XR,XL COPY IT ! 2759: > CTB WA,0 WORDS NEEDED EXPRESSED IN BAUS ! 2760: > MOV WA,TTCMV KEEP FOR CLEARING BUFFER ! 2761: > MOV XR,TTBLK CONSTRUCT ADRS OF BLANKING STRING ! 2762: > ADD WA,TTBLK ADD OFFSET TO BLANKING STRING ! 2763: > ADD WA,WA CLEAR BOTH BFR AND BLANKING STRING ! 2764: > MOV NULLW,(XR)+ CLEAR FIRST WORD ! 2765: > BZE WA,INI10 SKIP IF NO PRINT BUFFER ! 2766: > DCA WA ADJUST FOR FIRST WORD ! 2767: > MVW PERFORM BLANKING ! 2768: 6306c5191 ! 2769: < MOV =E$HNB,WA GET NUMBER OF HASH HEADERS ! 2770: --- ! 2771: > INI10 MOV =E$HNB,WA GET NUMBER OF HASH HEADERS ! 2772: 6321c5206 ! 2773: < CTB WA,SCSI$ NO OF BYTES NEEDED ! 2774: --- ! 2775: > CTB WA,SCSI$ NO OF BAUS NEEDED ! 2776: 6333c5218 ! 2777: < CTB WB,SCSI$ NO. OF BYTES NEEDED ! 2778: --- ! 2779: > CTB WB,SCSI$ NO. OF BAUS NEEDED ! 2780: 6347c5232 ! 2781: < * INITIALIZE VARIABLE BLOCKS FOR INPUT AND OUTPUT ! 2782: --- ! 2783: > * INITIALIZE VARIABLE BLOCKS FOR INPUT OUTPUT TERMINAL ! 2784: 6355,6357c5240,5246 ! 2785: < MOV INITR,WC TERMINAL FLAG ! 2786: < BZE WC,INI13 SKIP IF NO TERMINAL ! 2787: < JSR PRPAR ASSOCIATE TERMINAL ! 2788: --- ! 2789: > BZE TTLEN,INI13 SKIP IF NO TERMINAL I/O ! 2790: > MOV =V$TER,XL POINT TO STRING /TERMINAL/ ! 2791: > MOV =TRTOU,WB TRTYP FOR OUTPUT ! 2792: > JSR INOUT PERFORM ASSOCIATION ! 2793: > MOV =V$TER,XL ! 2794: > MOV =TRTIN,WB TRTYP FOR INPUT ! 2795: > JSR INOUT PERFORM ASSOCIATION ! 2796: 6360d5248 ! 2797: < * CHECK FOR EXPIRY DATE ! 2798: 6362,6363c5250 ! 2799: < INI13 JSR SYSDC CALL DATE CHECK ! 2800: < MOV XS,FLPTR IN CASE STACK OVERFLOWS IN COMPILER ! 2801: --- ! 2802: > * PREPARE FOR COMPILATION ! 2803: 6364a5252,5253 ! 2804: > INI13 MOV XS,FLPTR IN CASE STACK OVERFLOWS IN COMPILER ! 2805: > * ! 2806: 6369,6370c5258,5259 ! 2807: < MOV =NULLS,R$TTL FORGET TITLE (REG04) ! 2808: < MOV =NULLS,R$STL FORGET SUB-TITLE (REG04) ! 2809: --- ! 2810: > MOV =NULLS,R$TTL FORGET TITLE ! 2811: > MOV =NULLS,R$STL FORGET SUB-TITLE ! 2812: 6375c5264 ! 2813: < BNZ CPSTS,INIX0 SKIP IF NO LISTING OF COMP STATS ! 2814: --- ! 2815: > BNZ CPSTS,INIX1 SKIP IF NO LISTING OF COMP STATS ! 2816: 6404,6407d5292 ! 2817: < .IF .CUEJ ! 2818: < BZE HEADP,INIX0 NO EJECT IF NOTHING PRINTED (SDG11) ! 2819: < JSR PRTPG EJECT PRINTER ! 2820: < .FI ! 2821: 6412d5296 ! 2822: < * SET DEFAULT INPUT RECORD LENGTH ! 2823: 6414,6415c5298 ! 2824: < INIX0 BGT CSWIN,=INILN,INIX1 SKIP IF NOT DEFAULT -IN72 USED ! 2825: < MOV =INILS,CSWIN ELSE USE DEFAULT RECORD LENGTH ! 2826: --- ! 2827: > * CHECK FOR NOEXECUTE ! 2828: 6417,6422c5300 ! 2829: < * RESET TIMER ! 2830: < * ! 2831: < INIX1 JSR SYSTM GET TIME AGAIN ! 2832: < STI TIMSX STORE FOR END RUN PROCESSING ! 2833: < ADD CSWEX,NOXEQ ADD -NOEXECUTE FLAG ! 2834: < BNZ NOXEQ,INIX2 JUMP IF EXECUTION SUPPRESSED ! 2835: --- ! 2836: > INIX1 BNZ NOXEQ,INIX3 JUMP IF EXECUTION SUPPRESSED ! 2837: 6424,6429c5302,5303 ! 2838: < JSR SYSBX CALL BEFORE STARTING EXECUTION ! 2839: < .IF .CUEJ ! 2840: < .ELSE ! 2841: < BZE HEADP,INIY0 NO EJECT IF NOTHING PRINTED (SGD11) ! 2842: < JSR PRTPG EJECT PRINTER ! 2843: < .FI ! 2844: --- ! 2845: > BZE HEADP,INIX2 SKIP IF NO PRTPG CALLS IN COMPILN ! 2846: > JSR PRTPG EJECT STANDARD PRINTER FILE ! 2847: 6431c5305 ! 2848: < * MERGE WHEN LISTING FILE SET FOR EXECUTION ! 2849: --- ! 2850: > * INFORM OSINT OF STAGE ! 2851: 6433c5307 ! 2852: < INIY0 MNZ HEADP MARK HEADERS OUT REGARDLESS ! 2853: --- ! 2854: > INIX2 JSR SYSBX CALL BEFORE STARTING EXECUTION ! 2855: 6437a5312,5313 ! 2856: > JSR SYSTM GET TIME ! 2857: > STI TIMSX STORE FOR END RUN PROCESSING ! 2858: 6440,6442c5316,5317 ! 2859: < MOV CMPSN,PFNTE COPY STMTS COMPILED COUNT IN CASE ! 2860: < JSR SYSTM TIME YET AGAIN ! 2861: < STI PFSTM ! 2862: --- ! 2863: > STI PFSTM STORE TIME FOR PROFILER ! 2864: > MOV CMPSN,PFNTE COPY STATEMENTS COMPILED COUNT ! 2865: 6448c5323 ! 2866: < INIX2 JSR PRTNL PRINT A BLANK LINE ! 2867: --- ! 2868: > INIX3 JSR PRTFH PRINT A BLANK LINE ! 2869: 6450,6453c5325,5327 ! 2870: < JSR PRTST PRINT STRING ! 2871: < JSR PRTNL OUTPUT LINE ! 2872: < ZER WA SET ABEND VALUE TO ZERO ! 2873: < MOV =NINI9,WB SET SPECIAL CODE VALUE ! 2874: --- ! 2875: > MOV TTERL,TTLST TO FORCE MSG TO TERMINAL ! 2876: > JSR PRTSF PRINT NOEXECUTE MESSAGE ! 2877: > MOV =KVCOD,WA ENDING CODE ! 2878: 6500c5374 ! 2879: < ERB 261,ADDITION CAUSED REAL OVERFLOW ! 2880: --- ! 2881: > ERB 004,ADDITION CAUSED REAL OVERFLOW ! 2882: 6509c5383 ! 2883: < ERR 004,AFFIRMATION OPERAND IS NOT NUMERIC ! 2884: --- ! 2885: > ERR 005,AFFIRMATION OPERAND IS NOT NUMERIC ! 2886: 6518c5392 ! 2887: < ERR 005,ALTERNATION RIGHT OPERAND IS NOT PATTERN ! 2888: --- ! 2889: > ERR 006,ALTERNATION RIGHT OPERAND IS NOT PATTERN ! 2890: 6527c5401 ! 2891: < ERR 006,ALTERNATION LEFT OPERAND IS NOT PATTERN ! 2892: --- ! 2893: > ERR 007,ALTERNATION LEFT OPERAND IS NOT PATTERN ! 2894: 6551d5424 ! 2895: < EJC ! 2896: 6559d5431 ! 2897: < EJC ! 2898: 6583c5455 ! 2899: < WTB WA CONVERT TO BYTES ! 2900: --- ! 2901: > WTB WA CONVERT TO BAUS ! 2902: 6622c5494 ! 2903: < WTB WA CONVERT TO BYTES ! 2904: --- ! 2905: > WTB WA CONVERT TO BAUS ! 2906: 6636c5508 ! 2907: < * ASSIGNMENT ! 2908: --- ! 2909: > * ASSIGNMENT (O$RPL MERGES) ! 2910: 6639,6642c5511 ! 2911: < * ! 2912: < * O$RPL (PATTERN REPLACEMENT) MERGES HERE ! 2913: < * ! 2914: < OASS0 MOV (XS)+,WB LOAD VALUE TO BE ASSIGNED ! 2915: --- ! 2916: > MOV (XS)+,WB LOAD VALUE TO BE ASSIGNED ! 2917: 6649d5517 ! 2918: < EJC ! 2919: 6654,6655c5522 ! 2920: < ERB 007,COMPILATION ERROR ENCOUNTERED DURING EXECUTION ! 2921: < EJC ! 2922: --- ! 2923: > ERB 008,COMPILATION ERROR ENCOUNTERED DURING EXECUTION ! 2924: 6729c5596 ! 2925: < ERR 008,CONCATENATION LEFT OPND IS NOT STRING OR PATTERN ! 2926: --- ! 2927: > ERR 009,CONCATENATION LEFT OPND IS NOT STRING OR PATTERN ! 2928: 6733c5600 ! 2929: < ERR 009,CONCATENATION RIGHT OPD IS NOT STRING OR PATTERN ! 2930: --- ! 2931: > ERR 010,CONCATENATION RIGHT OPD IS NOT STRING OR PATTERN ! 2932: 6754c5621 ! 2933: < ERR 010,COMPLEMENTATION OPERAND IS NOT NUMERIC ! 2934: --- ! 2935: > ERR 011,COMPLEMENTATION OPERAND IS NOT NUMERIC ! 2936: 6762c5629 ! 2937: < ERB 011,COMPLEMENTATION CAUSED INTEGER OVERFLOW ! 2938: --- ! 2939: > ERB 012,COMPLEMENTATION CAUSED INTEGER OVERFLOW ! 2940: 6778,6779c5645,5646 ! 2941: < ERR 012,DIVISION LEFT OPERAND IS NOT NUMERIC ! 2942: < ERR 013,DIVISION RIGHT OPERAND IS NOT NUMERIC ! 2943: --- ! 2944: > ERR 013,DIVISION LEFT OPERAND IS NOT NUMERIC ! 2945: > ERR 014,DIVISION RIGHT OPERAND IS NOT NUMERIC ! 2946: 6789c5656 ! 2947: < ERB 014,DIVISION CAUSED INTEGER OVERFLOW ! 2948: --- ! 2949: > ERB 015,DIVISION CAUSED INTEGER OVERFLOW ! 2950: 6797c5664 ! 2951: < ERB 262,DIVISION CAUSED REAL OVERFLOW ! 2952: --- ! 2953: > ERB 016,DIVISION CAUSED REAL OVERFLOW ! 2954: 6806c5673 ! 2955: < ERR 015,EXPONENTIATION RIGHT OPERAND IS NOT NUMERIC ! 2956: --- ! 2957: > ERR 017,EXPONENTIATION RIGHT OPERAND IS NOT NUMERIC ! 2958: 6814c5681 ! 2959: < ERR 016,EXPONENTIATION LEFT OPERAND IS NOT NUMERIC ! 2960: --- ! 2961: > ERR 018,EXPONENTIATION LEFT OPERAND IS NOT NUMERIC ! 2962: 6840c5707 ! 2963: < OEXP2 ERB 017,EXPONENTIATION CAUSED INTEGER OVERFLOW ! 2964: --- ! 2965: > OEXP2 ERB 019,EXPONENTIATION CAUSED INTEGER OVERFLOW ! 2966: 6858c5725 ! 2967: < OEXP4 ERB 018,EXPONENTIATION RESULT IS UNDEFINED ! 2968: --- ! 2969: > OEXP4 ERB 020,EXPONENTIATION RESULT IS UNDEFINED ! 2970: 6871c5738 ! 2971: < OEXP6 ERB 266,EXPONENTIATION CAUSED REAL OVERFLOW ! 2972: --- ! 2973: > OEXP6 ERB 021,EXPONENTIATION CAUSED REAL OVERFLOW ! 2974: 6875c5742 ! 2975: < OEXP7 ERB 267,EXPONENTIATION RIGHT OPERAND IS REAL NOT INTEGER ! 2976: --- ! 2977: > OEXP7 ERB 022,EXPONENTIATION RIGHT OPERAND IS REAL NOT INTEGER ! 2978: 6880c5747 ! 2979: < OEXP8 ERB 019,EXPONENTIATION RIGHT OPERAND IS NEGATIVE ! 2980: --- ! 2981: > OEXP8 ERB 023,EXPONENTIATION RIGHT OPERAND IS NEGATIVE ! 2982: 6890,6891c5757 ! 2983: < BRN EVLX6 JUMP TO FAILURE LOC IN EVALX ! 2984: < EJC ! 2985: --- ! 2986: > JMG EVLXF JUMP TO FAILURE LOC IN EVALX ! 2987: 6896,6897c5762 ! 2988: < ERB 020,GOTO EVALUATION FAILURE ! 2989: < EJC ! 2990: --- ! 2991: > ERB 024,GOTO EVALUATION FAILURE ! 2992: 6907d5771 ! 2993: < EJC ! 2994: 6914c5778,5779 ! 2995: < BZE 2(XS),EVLX3 OK IF EXPR. WAS WANTED BY VALUE ! 2996: --- ! 2997: > BNZ 2(XS),OFNE1 FAIL UNLESS EXPRN WANTED BY VALUE ! 2998: > JMG EVLXV JOIN EXPRESSION BY VALUE CODE ! 2999: 6918,6919c5783 ! 3000: < OFNE1 ERB 021,FUNCTION CALLED BY NAME RETURNED A VALUE ! 3001: < EJC ! 3002: --- ! 3003: > OFNE1 ERB 025,FUNCTION CALLED BY NAME RETURNED A VALUE ! 3004: 6933,6934c5797 ! 3005: < ERB 022,UNDEFINED FUNCTION CALLED ! 3006: < EJC ! 3007: --- ! 3008: > ERB 026,UNDEFINED FUNCTION CALLED ! 3009: 6946,6947c5809 ! 3010: < OGOC1 ERB 023,GOTO OPERAND IS NOT A NATURAL VARIABLE ! 3011: < EJC ! 3012: --- ! 3013: > OGOC1 ERB 027,GOTO OPERAND IS NOT A NATURAL VARIABLE ! 3014: 6954,6957c5816,5818 ! 3015: < BEQ WA,=B$CDS,BCDS0 JUMP IF CODE BLOCK TO CODE ROUTINE ! 3016: < BEQ WA,=B$CDC,BCDC0 JUMP IF CODE BLOCK TO CODE ROUTINE ! 3017: < ERB 024,GOTO OPERAND IN DIRECT GOTO IS NOT CODE ! 3018: < EJC ! 3019: --- ! 3020: > BEQ WA,=B$CDC,OGOD1 JUMP IF CODE BLOCK ! 3021: > BEQ WA,=B$CDS,OGOD2 JUMP IF CODE BLOCK ! 3022: > ERB 028,GOTO OPERAND IN DIRECT GOTO IS NOT CODE ! 3023: 6958a5820,5831 ! 3024: > * CASE OF COMPLEX FAILURE CODE ! 3025: > * ! 3026: > OGOD1 MOV FLPTR,XS POP GARBAGE OFF STACK ! 3027: > MOV CDFAL(XR),(XS) SET NEW FAILURE OFFSET ! 3028: > BRN STMGO JUMP TO EXECUTE CODE ! 3029: > * ! 3030: > * CASE OF SIMPLE FAILURE CODE ! 3031: > * ! 3032: > OGOD2 MOV FLPTR,XS POP GARBAGE OFF STACK ! 3033: > MOV *CDFAL,(XS) SET NEW FAILURE OFFSET ! 3034: > BRN STMGO JUMP TO EXECUTE CODE ! 3035: > * ! 3036: 6985c5858 ! 3037: < ERR 025,IMMEDIATE ASSIGNMENT LEFT OPERAND IS NOT PATTERN ! 3038: --- ! 3039: > ERR 029,IMMEDIATE ASSIGNMENT LEFT OPERAND IS NOT PATTERN ! 3040: 6992d5864 ! 3041: < EJC ! 3042: 6999d5870 ! 3043: < EJC ! 3044: 7006d5876 ! 3045: < EJC ! 3046: 7020d5889 ! 3047: < EJC ! 3048: 7030d5898 ! 3049: < EJC ! 3050: 7044d5911 ! 3051: < EJC ! 3052: 7060d5926 ! 3053: < EJC ! 3054: 7066,7067c5932,5933 ! 3055: < ERR 026,MULTIPLICATION LEFT OPERAND IS NOT NUMERIC ! 3056: < ERR 027,MULTIPLICATION RIGHT OPERAND IS NOT NUMERIC ! 3057: --- ! 3058: > ERR 030,MULTIPLICATION LEFT OPERAND IS NOT NUMERIC ! 3059: > ERR 031,MULTIPLICATION RIGHT OPERAND IS NOT NUMERIC ! 3060: 7077c5943 ! 3061: < ERB 028,MULTIPLICATION CAUSED INTEGER OVERFLOW ! 3062: --- ! 3063: > ERB 032,MULTIPLICATION CAUSED INTEGER OVERFLOW ! 3064: 7085c5951 ! 3065: < ERB 263,MULTIPLICATION CAUSED REAL OVERFLOW ! 3066: --- ! 3067: > ERB 033,MULTIPLICATION CAUSED REAL OVERFLOW ! 3068: 7087d5952 ! 3069: < EJC ! 3070: 7123d5987 ! 3071: < EJC ! 3072: 7128,7129c5992 ! 3073: < ERB 029,UNDEFINED OPERATOR REFERENCED ! 3074: < EJC ! 3075: --- ! 3076: > ERB 034,UNDEFINED OPERATOR REFERENCED ! 3077: 7145c6008 ! 3078: < ERR 030,PATTERN ASSIGNMENT LEFT OPERAND IS NOT PATTERN ! 3079: --- ! 3080: > ERR 035,PATTERN ASSIGNMENT LEFT OPERAND IS NOT PATTERN ! 3081: 7159d6021 ! 3082: < EJC ! 3083: 7170d6031 ! 3084: < EJC ! 3085: 7177d6037 ! 3086: < EJC ! 3087: 7184d6043 ! 3088: < EJC ! 3089: 7189,7190c6048,6050 ! 3090: < BRN LEND0 JUMP TO END CIRCUIT ! 3091: < EJC ! 3092: --- ! 3093: > MOV =ENDMS,XR ENDING MESSAGE ! 3094: > ZER WA NO ERROR CODE ! 3095: > BRN STOPR STOP THE RUN ! 3096: 7198c6058 ! 3097: < BRN EVLX4 RETURN TO EVALX PROCEDURE ! 3098: --- ! 3099: > JMG EVLXN RETURN TO EVALX PROCEDURE ! 3100: 7210c6070 ! 3101: < * SUBJECT POINTER ! 3102: --- ! 3103: > * SUBJECT STRING POINTER ! 3104: 7215c6075 ! 3105: < ERR 031,PATTERN REPLACEMENT RIGHT OPERAND IS NOT STRING ! 3106: --- ! 3107: > ERR 036,PATTERN REPLACEMENT RIGHT OPERAND IS NOT STRING ! 3108: 7222c6082 ! 3109: < BEQ (XL),=B$BCT,ORPL4 BRANCH IF BUFFER ASSIGNMENT ! 3110: --- ! 3111: > BEQ (XL),=B$BCT,ORPL5 BRANCH IF BUFFER ASSIGNMENT ! 3112: 7257c6117 ! 3113: < BZE WA,OASS0 JUMP TO ASSIGN IF PART 3 IS NULL ! 3114: --- ! 3115: > BZE WA,ORPL4 JUMP TO ASSIGN IF PART 3 IS NULL ! 3116: 7260c6120 ! 3117: < BRN OASS0 JUMP TO PERFORM ASSIGNMENT ! 3118: --- ! 3119: > BRN ORPL4 JUMP TO PERFORM ASSIGNMENT ! 3120: 7266c6126,6130 ! 3121: < BRN OASS0 JUMP TO ASSIGN NULL VALUE ! 3122: --- ! 3123: > * ! 3124: > * MERGE WITH ASSIGNMENT ROUTINE ! 3125: > * ! 3126: > ORPL4 MOV =O$ASS,XL CONTINUATION ROUTINE ! 3127: > BRI XL ENTER ROUTINE ! 3128: 7272c6136 ! 3129: < ORPL4 MOV XR,XL COPY SCBLK REPLACEMENT PTR ! 3130: --- ! 3131: > ORPL5 MOV XR,XL COPY SCBLK REPLACEMENT PTR ! 3132: 7292c6156 ! 3133: < BRN EVLX3 RETURN TO EVALX PROCEDURE ! 3134: --- ! 3135: > BRN EVLXV RETURN TO EVALX PROCEDURE ! 3136: 7337,7338c6201,6202 ! 3137: < ERR 032,SUBTRACTION LEFT OPERAND IS NOT NUMERIC ! 3138: < ERR 033,SUBTRACTION RIGHT OPERAND IS NOT NUMERIC ! 3139: --- ! 3140: > ERR 037,SUBTRACTION LEFT OPERAND IS NOT NUMERIC ! 3141: > ERR 038,SUBTRACTION RIGHT OPERAND IS NOT NUMERIC ! 3142: 7348c6212 ! 3143: < ERB 034,SUBTRACTION CAUSED INTEGER OVERFLOW ! 3144: --- ! 3145: > ERB 039,SUBTRACTION CAUSED INTEGER OVERFLOW ! 3146: 7356c6220 ! 3147: < ERB 264,SUBTRACTION CAUSED REAL OVERFLOW ! 3148: --- ! 3149: > ERB 040,SUBTRACTION CAUSED REAL OVERFLOW ! 3150: 7358d6221 ! 3151: < EJC ! 3152: 7363,7364c6226 ! 3153: < BRN TRXQ1 JUMP INTO TRXEQ PROCEDURE ! 3154: < EJC ! 3155: --- ! 3156: > JMG TRXQR JUMP INTO TRXEQ PROCEDURE ! 3157: 7375c6237 ! 3158: < ERB 035,UNEXPECTED FAILURE IN -NOFAIL MODE ! 3159: --- ! 3160: > ERB 041,UNEXPECTED FAILURE IN -NOFAIL MODE ! 3161: 7387d6248 ! 3162: < EJC ! 3163: 7391a6253,6255 ! 3164: > MOV KVERT,WA LOAD ERROR CODE ! 3165: > ZER XR INDICATE NO ENDING MESSAGE ! 3166: > BNZ WA,STOPR STOP RUN ! 3167: 7393d6256 ! 3168: < * MERGE HERE IF EXECUTION TERMINATES IN ERROR ! 3169: 7395,7404c6258 ! 3170: < LABO1 MOV KVERT,WA LOAD ERROR CODE ! 3171: < BZE WA,LABO2 JUMP IF NO ERROR HAS OCCURED ! 3172: < .IF .CSAX ! 3173: < JSR SYSAX CALL AFTER EXECUTION PROC (REG04) ! 3174: < .ELSE ! 3175: < .FI ! 3176: < JSR PRTPG ELSE EJECT PRINTER ! 3177: < JSR ERMSG PRINT ERROR MESSAGE ! 3178: < ZER XR INDICATE NO MESSAGE TO PRINT ! 3179: < BRN STOPR JUMP TO ROUTINE TO STOP RUN ! 3180: --- ! 3181: > * FAIL IF NO ERROR HAD OCCURED ! 3182: 7406c6260 ! 3183: < * HERE IF NO ERROR HAD OCCURED ! 3184: --- ! 3185: > ERB 042,GOTO ABORT WITH NO PRECEDING ERROR ! 3186: 7408,7410d6261 ! 3187: < LABO2 ERB 036,GOTO ABORT WITH NO PRECEDING ERROR ! 3188: < EJC ! 3189: < * ! 3190: 7417,7418c6268,6269 ! 3191: < LCNT1 MOV R$CNT,XR LOAD CONTINUATION CODE BLOCK PTR ! 3192: < BZE XR,LCNT2 JUMP IF NO PREVIOUS ERROR ! 3193: --- ! 3194: > LCNXE MOV R$CNT,XR LOAD CONTINUATION CODE BLOCK PTR ! 3195: > BZE XR,LCNT1 JUMP IF NO PREVIOUS ERROR ! 3196: 7428c6279 ! 3197: < LCNT2 ERB 037,GOTO CONTINUE WITH NO PRECEDING ERROR ! 3198: --- ! 3199: > LCNT1 ERB 043,GOTO CONTINUE WITH NO PRECEDING ERROR ! 3200: 7434,7437c6285,6286 ! 3201: < * ! 3202: < * MERGE HERE FROM END CODE CIRCUIT ! 3203: < * ! 3204: < LEND0 MOV =ENDMS,XR POINT TO MESSAGE /NORMAL TERM../ ! 3205: --- ! 3206: > MOV =ENDMS,XR POINT TO MESSAGE /NORMAL TERM../ ! 3207: > ZER WA NO ERROR CODE ! 3208: 7439d6287 ! 3209: < EJC ! 3210: 7446d6293 ! 3211: < EJC ! 3212: 7453d6299 ! 3213: < EJC ! 3214: 7460d6305 ! 3215: < EJC ! 3216: 7465c6310 ! 3217: < ERB 038,GOTO UNDEFINED LABEL ! 3218: --- ! 3219: > ERB 044,GOTO UNDEFINED LABEL ! 3220: 7523d6367 ! 3221: < EJC ! 3222: 7536d6379 ! 3223: < EJC ! 3224: 7547d6389 ! 3225: < EJC ! 3226: 7565d6406 ! 3227: < EJC ! 3228: 7582d6422 ! 3229: < EJC ! 3230: 7594c6434 ! 3231: < BCDC0 MOV FLPTR,XS POP GARBAGE OFF STACK ! 3232: --- ! 3233: > MOV FLPTR,XS POP GARBAGE OFF STACK ! 3234: 7597d6436 ! 3235: < EJC ! 3236: 7599,7600d6437 ! 3237: < * CDBLK (CONTINUED) ! 3238: < * ! 3239: 7606c6443 ! 3240: < BCDS0 MOV FLPTR,XS POP GARBAGE OFF STACK ! 3241: --- ! 3242: > MOV FLPTR,XS POP GARBAGE OFF STACK ! 3243: 7609d6445 ! 3244: < EJC ! 3245: 7616d6451 ! 3246: < EJC ! 3247: 7617a6453,6458 ! 3248: > * COBLK ! 3249: > * ! 3250: > * THE ROUTINE FOR A COBLK IS NEVER EXECUTED ! 3251: > * ! 3252: > B$COP ENT BL$CO ENTRY POINT (COBLK) ! 3253: > * ! 3254: 7646a6488,6489 ! 3255: > .IF .CNLD ! 3256: > .ELSE ! 3257: 7657,7658d6499 ! 3258: < .IF .CNLD ! 3259: < .ELSE ! 3260: 7671,7676c6512 ! 3261: < .IF .CNRA ! 3262: < BSW XR,3 SWITCH ON TYPE ! 3263: < .ELSE ! 3264: < BSW XR,4 SWITCH ON TYPE ! 3265: < .FI ! 3266: < IFF 0,BEFC7 NO CONVERSION NEEDED ! 3267: --- ! 3268: > BSW XR,5,BEFC7 SWITCH ON EFTAR TYPE ! 3269: 7682a6519,6522 ! 3270: > .IF .CNBF ! 3271: > .ELSE ! 3272: > IFF 4,BEFCA BUFFER ! 3273: > .FI ! 3274: 7689c6529 ! 3275: < ERR 039,EXTERNAL FUNCTION ARGUMENT IS NOT STRING ! 3276: --- ! 3277: > ERR 045,EXTERNAL FUNCTION ARGUMENT IS NOT STRING ! 3278: 7700c6540 ! 3279: < ERR 040,EXTERNAL FUNCTION ARGUMENT IS NOT INTEGER ! 3280: --- ! 3281: > ERR 046,EXTERNAL FUNCTION ARGUMENT IS NOT INTEGER ! 3282: 7710,7711c6550 ! 3283: < ERR 265,EXTERNAL FUNCTION ARGUMENT IS NOT REAL ! 3284: < .FI ! 3285: --- ! 3286: > ERR 047,EXTERNAL FUNCTION ARGUMENT IS NOT REAL ! 3287: 7714a6554,6570 ! 3288: > .FI ! 3289: > .IF .CNBF ! 3290: > .ELSE ! 3291: > BRN BEFC5 MERGE ! 3292: > * ! 3293: > * HERE TO CONVERT BUFFER ! 3294: > * ! 3295: > BEFCA MOV (XT),XR LOAD ARGUMENT ! 3296: > MOV WC,BEFOF SAVE OFFSET ! 3297: > MOV XL,-(XS) SAVE EFBLK PTR ! 3298: > JSR GTBUF GET A BUFFER ! 3299: > ERR 259,EXTERNAL FUNCTION ARGUMENT IS NOT BUFFER ! 3300: > MOV (XS)+,XL RESTORE EFBLK PTR ! 3301: > * ! 3302: > * INTEGER AND REAL CASE MERGES HERE ! 3303: > * ! 3304: > .FI ! 3305: 7739c6595 ! 3306: < MOV EFRSL(XL),WB GET RESULT TYPE ID ! 3307: --- ! 3308: > MOV EFRSL(XL),WB GET RESULT TYPE ! 3309: 7764a6621 ! 3310: > BEQ WB,=NUM03,BEF10 YES JUMP ! 3311: 7765a6623,6627 ! 3312: > .IF .CNBF ! 3313: > .ELSE ! 3314: > MOV =B$BCT,WA BUFFER ! 3315: > BEQ WB,=NUM04,BEF10 YES JUMP ! 3316: > .FI ! 3317: 7780d6641 ! 3318: < EJC ! 3319: 7811,7812c6672 ! 3320: < BFFC2 ERB 041,FIELD FUNCTION ARGUMENT IS WRONG DATATYPE ! 3321: < EJC ! 3322: --- ! 3323: > BFFC2 ERB 048,FIELD FUNCTION ARGUMENT IS WRONG DATATYPE ! 3324: 7814,7815d6673 ! 3325: < * FFBLK (CONTINUED) ! 3326: < * ! 3327: 7851d6708 ! 3328: < EJC ! 3329: 7858d6714 ! 3330: < EJC ! 3331: 7871d6726 ! 3332: < EJC ! 3333: 7924c6779 ! 3334: < WTB WA CONVERT NO. OF ARGS TO BYTES OFFSET ! 3335: --- ! 3336: > WTB WA CONVERT NO. OF ARGS TO BAUS OFFSET ! 3337: 7989c6844 ! 3338: < * HERE IF &PROFILE = 1 ! 3339: --- ! 3340: > * HERE IF PROFILE = 1 ! 3341: 7998c6853 ! 3342: < * HERE IF &PROFILE = 2 ! 3343: --- ! 3344: > * HERE IF PROFILE = 2 ! 3345: 8007a6863 ! 3346: > EJC ! 3347: 8008a6865,6866 ! 3348: > * PFBLK (CONTINUED) ! 3349: > * ! 3350: 8078c6936 ! 3351: < WTB WB CONVERT TO BYTE OFFSET ! 3352: --- ! 3353: > WTB WB CONVERT TO BAU OFFSET ! 3354: 8095,8096c6953 ! 3355: < JSR PRTCH PRINT TO TERMINATE OUTPUT ! 3356: < JSR PRTNL TERMINATE PRINT LINE ! 3357: --- ! 3358: > JSR PRTCF PRINT TO TERMINATE OUTPUT ! 3359: 8122d6978 ! 3360: < EJC ! 3361: 8133d6988 ! 3362: < EJC ! 3363: 8140d6994 ! 3364: < EJC ! 3365: 8147d7000 ! 3366: < EJC ! 3367: 8176d7028 ! 3368: < EJC ! 3369: 8178,8179d7029 ! 3370: < * VRBLK (CONTINUED) ! 3371: < * ! 3372: 8185,8186c7035 ! 3373: < ERB 042,ATTEMPT TO CHANGE VALUE OF PROTECTED VARIABLE ! 3374: < EJC ! 3375: --- ! 3376: > ERB 049,ATTEMPT TO CHANGE VALUE OF PROTECTED VARIABLE ! 3377: 8188,8189d7036 ! 3378: < * VRBLK (CONTINUED) ! 3379: < * ! 3380: 8199d7045 ! 3381: < EJC ! 3382: 8201,8202d7046 ! 3383: < * VRBLK (CONTINUED) ! 3384: < * ! 3385: 8223d7066 ! 3386: < EJC ! 3387: 8225,8226d7067 ! 3388: < * VRBLK (CONTINUED) ! 3389: < * ! 3390: 8252,8253c7093 ! 3391: < JSR PRTCH PRINT IT ! 3392: < JSR PRTNL TERMINATE LINE ! 3393: --- ! 3394: > JSR PRTCF PRINT IT ! 3395: 8286d7125 ! 3396: < EJC ! 3397: 8593a7433,7434 ! 3398: > .IF .CNFN ! 3399: > .ELSE ! 3400: 8596,8597d7436 ! 3401: < * COMPOUNT PATTERN STRUCTURES (CONTINUED) ! 3402: < * ! 3403: 8627c7466,7467 ! 3404: < * STACK BACK PAST THE INNTER STACK BASE CREATED BY P$FNA ! 3405: --- ! 3406: > * STACK BACK PAST THE INNER STACK BASE CREATED BY P$FNA ! 3407: > .FI ! 3408: 8734d7573 ! 3409: < EJC ! 3410: 8743d7581 ! 3411: < EJC ! 3412: 8767d7604 ! 3413: < EJC ! 3414: 8784d7620 ! 3415: < EJC ! 3416: 8809d7644 ! 3417: < EJC ! 3418: 8811a7647 ! 3419: > * EXPRESSION ARGUMENT CASE MERGES ! 3420: 8817,8820c7653 ! 3421: < * ! 3422: < * EXPRESSION ARGUMENT CASE MERGES HERE ! 3423: < * ! 3424: < PANY1 BEQ WB,PMSSL,FAILP FAIL IF NO CHARACTERS LEFT ! 3425: --- ! 3426: > BEQ WB,PMSSL,FAILP FAIL IF NO CHARACTERS LEFT ! 3427: 8825c7658 ! 3428: < WTB WA CHANGE TO BYTE OFFSET ! 3429: --- ! 3430: > WTB WA CHANGE TO BAU OFFSET ! 3431: 8832d7664 ! 3432: < EJC ! 3433: 8838a7671 ! 3434: > MOV =P$ANY,WA PCODE FOR NEW NODE ! 3435: 8840c7673 ! 3436: < ERR 043,ANY EVALUATED ARGUMENT IS NOT STRING ! 3437: --- ! 3438: > ERR 050,ANY EVALUATED ARGUMENT IS NOT STRING ! 3439: 8842c7675 ! 3440: < PPM PANY1 MERGE MULTI-CHAR CASE IF OK ! 3441: --- ! 3442: > BRI XL MERGE MULTI-CHAR CASE IF OK ! 3443: 8859d7691 ! 3444: < EJC ! 3445: 8922a7755 ! 3446: > MOV =P$BRK,WA PCODE FOR NEW NODE ! 3447: 8924c7757 ! 3448: < ERR 044,BREAK EVALUATED ARGUMENT IS NOT STRING ! 3449: --- ! 3450: > ERR 051,BREAK EVALUATED ARGUMENT IS NOT STRING ! 3451: 8926,8927c7759 ! 3452: < PPM PBRK1 MERGE WITH MULTI-CHAR CASE IF OK ! 3453: < EJC ! 3454: --- ! 3455: > BRI XL MERGE WITH MULTI-CHAR CASE IF OK ! 3456: 8950a7783 ! 3457: > * EXPRESSION ARGUMENT CASE MERGES ! 3458: 8956,8959c7789 ! 3459: < * ! 3460: < * EXPRESSION ARGUMENT MERGES HERE ! 3461: < * ! 3462: < PBRK1 MOV PMSSL,WC LOAD SUBJECT STRING LENGTH ! 3463: --- ! 3464: > MOV PMSSL,WC LOAD SUBJECT STRING LENGTH ! 3465: 8971c7801 ! 3466: < WTB WA CONVERT TO BYTE OFFSET ! 3467: --- ! 3468: > WTB WA CONVERT TO BAU OFFSET ! 3469: 8993d7822 ! 3470: < EJC ! 3471: 9004a7834 ! 3472: > MOV =P$BRK,WA PCODE FOR NEW NODE ! 3473: 9006c7836 ! 3474: < ERR 045,BREAKX EVALUATED ARGUMENT IS NOT STRING ! 3475: --- ! 3476: > ERR 052,BREAKX EVALUATED ARGUMENT IS NOT STRING ! 3477: 9008,9009c7838 ! 3478: < PPM PBRK1 MERGE WITH BREAK IF ALL OK ! 3479: < EJC ! 3480: --- ! 3481: > BRI XL MERGE WITH BREAK IF ALL OK ! 3482: 9060c7889 ! 3483: < ERR 046,EXPRESSION DOES NOT EVALUATE TO PATTERN ! 3484: --- ! 3485: > ERR 053,EXPRESSION DOES NOT EVALUATE TO PATTERN ! 3486: 9068c7897,7908 ! 3487: < BRN PSTR1 ELSE MERGE WITH STRING CIRCUIT ! 3488: --- ! 3489: > MOV XR,PSAVE SAVE NODE PTR ! 3490: > MOV R$PMS,XR LOAD SUBJECT STRING PTR ! 3491: > PLC XR,WB POINT TO CURRENT CHAR ! 3492: > ADD SCLEN(XL),WB COMPUTE NEW CURSOR POSITION ! 3493: > BGT WB,PMSSL,FAILP FAIL IF PAST END OF STRING ! 3494: > MOV WB,PSAVC SAVE UPDATED CURSOR ! 3495: > MOV SCLEN(XL),WA NUMBER OF CHARS TO COMPARE ! 3496: > PLC XL POINT TO TEST STRING CHARS ! 3497: > CMC FAILP,FAILP COMPARE, FAIL IF UNEQUAL ! 3498: > MOV PSAVE,XR IF ALL MATCHED, RESTORE NODE PTR ! 3499: > MOV PSAVC,WB RESTORE UPDATED CURSOR ! 3500: > BRN SUCCP AND SUCCEED ! 3501: 9093d7932 ! 3502: < EJC ! 3503: 9102d7940 ! 3504: < * ! 3505: 9114c7952,7953 ! 3506: < EJC ! 3507: --- ! 3508: > .IF .CNFN ! 3509: > .ELSE ! 3510: 9128d7966 ! 3511: < EJC ! 3512: 9137d7974 ! 3513: < EJC ! 3514: 9155d7991 ! 3515: < EJC ! 3516: 9163a8000 ! 3517: > .FI ! 3518: 9180d8016 ! 3519: < EJC ! 3520: 9232d8067 ! 3521: < EJC ! 3522: 9251,9254c8086 ! 3523: < * ! 3524: < * EXPRESSION ARGUMENT CASE MERGES HERE ! 3525: < * ! 3526: < PLEN1 ADD PARM1(XR),WB PUSH CURSOR INDICATED AMOUNT ! 3527: --- ! 3528: > ADD PARM1(XR),WB PUSH CURSOR INDICATED AMOUNT ! 3529: 9257d8088 ! 3530: < EJC ! 3531: 9265,9266c8096,8097 ! 3532: < ERR 047,LEN EVALUATED ARGUMENT IS NOT INTEGER ! 3533: < ERR 048,LEN EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 3534: --- ! 3535: > ERR 054,LEN EVALUATED ARGUMENT IS NOT INTEGER ! 3536: > ERR 055,LEN EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 3537: 9268c8099,8101 ! 3538: < PPM PLEN1 MERGE WITH NORMAL CIRCUIT IF OK ! 3539: --- ! 3540: > ADD PARM1(XR),WB PUSH CURSOR INDICATED AMOUNT ! 3541: > BLE WB,PMSSL,SUCCP SUCCEED IF NOT OFF END ! 3542: > BRN FAILP ELSE FAIL ! 3543: 9275a8109 ! 3544: > MOV =P$NAY,WA PCODE FOR NEW NODE ! 3545: 9277c8111 ! 3546: < ERR 049,NOTANY EVALUATED ARGUMENT IS NOT STRING ! 3547: --- ! 3548: > ERR 056,NOTANY EVALUATED ARGUMENT IS NOT STRING ! 3549: 9279c8113 ! 3550: < PPM PNAY1 MERGE WITH MULTI-CHAR CASE IF OK ! 3551: --- ! 3552: > BRI XL MERGE WITH MULTI-CHAR CASE IF OK ! 3553: 9296a8131 ! 3554: > * EXPRESSION ARGUMENT CASE MERGES ! 3555: 9302,9305c8137 ! 3556: < * ! 3557: < * EXPRESSION ARGUMENT CASE MERGES HERE ! 3558: < * ! 3559: < PNAY1 BEQ WB,PMSSL,FAILP FAIL IF NO CHARACTERS LEFT ! 3560: --- ! 3561: > BEQ WB,PMSSL,FAILP FAIL IF NO CHARACTERS LEFT ! 3562: 9309c8141 ! 3563: < WTB WA CONVERT TO BYTE OFFSET ! 3564: --- ! 3565: > WTB WA CONVERT TO BAU OFFSET ! 3566: 9405a8238 ! 3567: > ZER R$PMB CLEAR POSSIBLE BCBLK PTR FOR GBCOL ! 3568: 9418a8252 ! 3569: > MOV XL,-(XS) STACK SUBJECT STRING POINTER ! 3570: 9422c8256 ! 3571: < .FI ! 3572: --- ! 3573: > ZER R$PMB CLEAR BCBLK PTR FOR GBCOL ! 3574: 9426a8261 ! 3575: > .FI ! 3576: 9435,9438c8270 ! 3577: < * ! 3578: < * EXPRESSION ARGUMENT CASE MERGES HERE ! 3579: < * ! 3580: < PPOS1 BEQ WB,PARM1(XR),SUCCP SUCCEED IF AT RIGHT LOCATION ! 3581: --- ! 3582: > BEQ WB,PARM1(XR),SUCCP SUCCEED IF AT RIGHT LOCATION ! 3583: 9440d8271 ! 3584: < EJC ! 3585: 9448,9449c8279,8280 ! 3586: < ERR 050,POS EVALUATED ARGUMENT IS NOT INTEGER ! 3587: < ERR 051,POS EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 3588: --- ! 3589: > ERR 057,POS EVALUATED ARGUMENT IS NOT INTEGER ! 3590: > ERR 058,POS EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 3591: 9451c8282,8283 ! 3592: < PPM PPOS1 MERGE WITH NORMAL CASE IF OK ! 3593: --- ! 3594: > BEQ WB,PARM1(XR),SUCCP SUCCEED IF AT RIGHT LOCATION ! 3595: > BRN FAILP ELSE FAIL ! 3596: 9465d8296 ! 3597: < EJC ! 3598: 9476d8306 ! 3599: < EJC ! 3600: 9493d8322 ! 3601: < EJC ! 3602: 9513d8341 ! 3603: < EJC ! 3604: 9521,9522c8349,8350 ! 3605: < ERR 052,RPOS EVALUATED ARGUMENT IS NOT INTEGER ! 3606: < ERR 053,RPOS EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 3607: --- ! 3608: > ERR 059,RPOS EVALUATED ARGUMENT IS NOT INTEGER ! 3609: > ERR 060,RPOS EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 3610: 9524,9525c8352,8353 ! 3611: < PPM PRPS1 MERGE WITH NORMAL CASE IF OK ! 3612: < EJC ! 3613: --- ! 3614: > MOV =P$RPS,XL CONTINUATION ROUTINE ! 3615: > BRI XL ENTER ROUTINE ! 3616: 9527a8356 ! 3617: > * EXPRESSION ARGUMENT CASE MERGES ! 3618: 9532,9535c8361 ! 3619: < * ! 3620: < * EXPRESSION ARGUMENT CASE MERGES HERE ! 3621: < * ! 3622: < PRPS1 MOV PMSSL,WC GET LENGTH OF STRING ! 3623: --- ! 3624: > MOV PMSSL,WC GET LENGTH OF STRING ! 3625: 9541a8368 ! 3626: > * EXPRESSION ARGUMENT CASE MERGES ! 3627: 9546,9549c8373 ! 3628: < * ! 3629: < * EXPRESSION ARGUMENT CASE MERGES HERE ! 3630: < * ! 3631: < PRTB1 MOV WB,WC SAVE INITIAL CURSOR ! 3632: --- ! 3633: > MOV WB,WC SAVE INITIAL CURSOR ! 3634: 9555d8378 ! 3635: < EJC ! 3636: 9563,9564c8386,8387 ! 3637: < ERR 054,RTAB EVALUATED ARGUMENT IS NOT INTEGER ! 3638: < ERR 055,RTAB EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 3639: --- ! 3640: > ERR 061,RTAB EVALUATED ARGUMENT IS NOT INTEGER ! 3641: > ERR 062,RTAB EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 3642: 9566c8389,8390 ! 3643: < PPM PRTB1 MERGE WITH NORMAL CASE IF SUCCESS ! 3644: --- ! 3645: > MOV =P$RTB,XL CONTINUATION ROUTINE ! 3646: > BRI XL ENTER ROUTINE ! 3647: 9573a8398 ! 3648: > MOV =P$SPN,WA PCODE FOR NEW NODE ! 3649: 9575c8400 ! 3650: < ERR 056,SPAN EVALUATED ARGUMENT IS NOT STRING ! 3651: --- ! 3652: > ERR 063,SPAN EVALUATED ARGUMENT IS NOT STRING ! 3653: 9577,9578c8402 ! 3654: < PPM PSPN1 MERGE WITH MULTI-CHAR CASE IF OK ! 3655: < EJC ! 3656: --- ! 3657: > BRI XL MERGE WITH MULTI-CHAR CASE IF OK ! 3658: 9580a8405 ! 3659: > * EXPRESSION ARGUMENT CASE MERGES ! 3660: 9586,9589c8411 ! 3661: < * ! 3662: < * EXPRESSION ARGUMENT CASE MERGES HERE ! 3663: < * ! 3664: < PSPN1 MOV PMSSL,WC COPY SUBJECT STRING LENGTH ! 3665: --- ! 3666: > MOV PMSSL,WC COPY SUBJECT STRING LENGTH ! 3667: 9601c8423 ! 3668: < WTB WA CONVERT TO BYTE OFFSET ! 3669: --- ! 3670: > WTB WA CONVERT TO BAU OFFSET ! 3671: 9641d8462 ! 3672: < EJC ! 3673: 9643c8464 ! 3674: < * MULTI-CHARACTER STRING ! 3675: --- ! 3676: > * MULTI-CHARACTER STRING (MERGE FROM P$EXA) ! 3677: 9652,9655c8473 ! 3678: < * ! 3679: < * MERGE HERE AFTER EVALUATING EXPRESSION WITH STRING VALUE ! 3680: < * ! 3681: < PSTR1 MOV XR,PSAVE SAVE NODE POINTER ! 3682: --- ! 3683: > MOV XR,PSAVE SAVE NODE POINTER ! 3684: 9682a8501 ! 3685: > * EXPRESSION CASE MERGES ! 3686: 9687,9690c8506 ! 3687: < * ! 3688: < * EXPRESSION ARGUMENT CASE MERGES HERE ! 3689: < * ! 3690: < PTAB1 BGT WB,PARM1(XR),FAILP FAIL IF TOO FAR ALREADY ! 3691: --- ! 3692: > BGT WB,PARM1(XR),FAILP FAIL IF TOO FAR ALREADY ! 3693: 9694d8509 ! 3694: < EJC ! 3695: 9702,9703c8517,8518 ! 3696: < ERR 057,TAB EVALUATED ARGUMENT IS NOT INTEGER ! 3697: < ERR 058,TAB EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 3698: --- ! 3699: > ERR 064,TAB EVALUATED ARGUMENT IS NOT INTEGER ! 3700: > ERR 065,TAB EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE ! 3701: 9705,9706c8520,8521 ! 3702: < PPM PTAB1 MERGE WITH NORMAL CASE IF OK ! 3703: < EJC ! 3704: --- ! 3705: > MOV =P$TAB,XL CONTINUATION ROUTINE ! 3706: > BRI XL ENTER ROUTINE ! 3707: 9721d8535 ! 3708: < EJC ! 3709: 9764c8578 ! 3710: < ERR 059,ANY ARGUMENT IS NOT STRING OR EXPRESSION ! 3711: --- ! 3712: > ERR 066,ANY ARGUMENT IS NOT STRING OR EXPRESSION ! 3713: 9766d8579 ! 3714: < EJC ! 3715: 9768a8582 ! 3716: > EJC ! 3717: 9776c8590 ! 3718: < ERB 275,APPEND FIRST ARGUMENT IS NOT BUFFER ! 3719: --- ! 3720: > ERB 067,APPEND FIRST ARGUMENT IS NOT BUFFER ! 3721: 9780,9781c8594,8597 ! 3722: < SAPN1 JSR APNDB DO THE APPEND ! 3723: < ERR 276,APPEND SECOND ARGUMENT IS NOT STRING ! 3724: --- ! 3725: > SAPN1 MOV BCLEN(XR),WA OFFSET TO BUFFER END ! 3726: > ZER WB NO CHARS TO BE REPLACED ! 3727: > JSR INSBF DO THE APPEND ! 3728: > ERR 068,APPEND SECOND ARGUMENT IS NOT STRING ! 3729: 9784d8599 ! 3730: < EJC ! 3731: 9785a8601 ! 3732: > EJC ! 3733: 9796c8612 ! 3734: < WTB WB CONVERT TO BYTES ! 3735: --- ! 3736: > WTB WB CONVERT TO BAUS ! 3737: 9819c8635 ! 3738: < SAPP3 ERB 060,APPLY FIRST ARG IS NOT NATURAL VARIABLE NAME ! 3739: --- ! 3740: > SAPP3 ERB 069,APPLY FIRST ARG IS NOT NATURAL VARIABLE NAME ! 3741: 9841c8657 ! 3742: < ERR 061,ARBNO ARGUMENT IS NOT PATTERN ! 3743: --- ! 3744: > ERR 070,ARBNO ARGUMENT IS NOT PATTERN ! 3745: 9857c8673 ! 3746: < ERR 062,ARG SECOND ARGUMENT IS NOT INTEGER ! 3747: --- ! 3748: > ERR 253,ARG SECOND ARGUMENT IS NOT INTEGER ! 3749: 9874c8690 ! 3750: < SARG1 ERB 063,ARG FIRST ARGUMENT IS NOT PROGRAM FUNCTION NAME ! 3751: --- ! 3752: > SARG1 ERB 252,ARG FIRST ARGUMENT IS NOT PROGRAM FUNCTION NAME ! 3753: 9892c8708 ! 3754: < WTB WA CONVERT LENGTH TO BYTES ! 3755: --- ! 3756: > WTB WA CONVERT LENGTH TO BAUS ! 3757: 9914c8730 ! 3758: < ERR 064,ARRAY FIRST ARGUMENT IS NOT INTEGER OR STRING ! 3759: --- ! 3760: > ERR 071,ARRAY FIRST ARGUMENT IS NOT INTEGER OR STRING ! 3761: 9938c8754 ! 3762: < ERR 065,ARRAY FIRST ARGUMENT LOWER BOUND IS NOT INTEGER ! 3763: --- ! 3764: > ERR 072,ARRAY FIRST ARGUMENT LOWER BOUND IS NOT INTEGER ! 3765: 9950,9951c8766,8772 ! 3766: < SAR04 JSR GTINT CONVERT HIGH BOUND TO INTEGER ! 3767: < ERR 066,ARRAY FIRST ARGUMENT UPPER BOUND IS NOT INTEGER ! 3768: --- ! 3769: > SAR04 BNZ WA,SAR4A SKIP IF DELIMITER 1 OR 2 ! 3770: > BNZ XSCNB,SAR10 JUMP IF ILLEGALLY PLACED BLANK ! 3771: > * ! 3772: > * CHECK FOR INTEGER BOUND ! 3773: > * ! 3774: > SAR4A JSR GTINT CONVERT HIGH BOUND TO INTEGER ! 3775: > ERR 073,ARRAY FIRST ARGUMENT UPPER BOUND IS NOT INTEGER ! 3776: 9989c8810 ! 3777: < WTB WB ELSE CONVERT TO LENGTH IN BYTES ! 3778: --- ! 3779: > WTB WB ELSE CONVERT TO LENGTH IN BAUS ! 3780: 10007c8828 ! 3781: < MOV WA,WC SAVE LENGTH IN BYTES ! 3782: --- ! 3783: > MOV WA,WC SAVE LENGTH IN BAUS ! 3784: 10024c8845 ! 3785: < MOV WC,ARLEN(XR) STORE LENGTH IN BYTES ! 3786: --- ! 3787: > MOV WC,ARLEN(XR) STORE LENGTH IN BAUS ! 3788: 10044c8865 ! 3789: < SAR10 ERB 067,ARRAY DIMENSION IS ZERO,NEGATIVE OR OUT OF RANGE ! 3790: --- ! 3791: > SAR10 ERB 074,BAD DIMENSION, ZERO, NEGATIVE OR OUT OF RANGE ! 3792: 10048c8869 ! 3793: < SAR11 ERB 068,ARRAY SIZE EXCEEDS MAXIMUM PERMITTED ! 3794: --- ! 3795: > SAR11 ERB 075,ARRAY SIZE EXCEEDS MAXIMUM PERMITTED ! 3796: 10050,10051d8870 ! 3797: < .IF .CNBF ! 3798: < .ELSE ! 3799: 10053,10078d8871 ! 3800: < * BUFFER ! 3801: < * ! 3802: < S$BUF ENT ENTRY POINT ! 3803: < MOV (XS)+,XL GET INITIAL VALUE ! 3804: < MOV (XS)+,XR GET REQUESTED ALLOCATION ! 3805: < JSR GTINT CONVERT TO INTEGER ! 3806: < ERR 269,BUFFER FIRST ARGUMENT IS NOT INTEGER ! 3807: < LDI ICVAL(XR) GET VALUE ! 3808: < ILE SBF01 BRANCH IF NEGATIVE OR ZERO ! 3809: < MFI WA,SBF02 MOVE WITH OVERFLOW CHECK ! 3810: < JSR ALOBF ALLOCATE THE BUFFER ! 3811: < JSR APNDB COPY IT IN ! 3812: < ERR 270,BUFFER SECOND ARGUMENT IS NOT STRING OR BUFFER ! 3813: < ERR 271,BUFFER INITIAL VALUE TOO BIG FOR ALLOCATION ! 3814: < BRN EXSID EXIT SETTING IDVAL ! 3815: < * ! 3816: < * HERE FOR INVALID ALLOCATION SIZE ! 3817: < * ! 3818: < SBF01 ERB 272,BUFFER FIRST ARGUMENT IS NOT POSITIVE ! 3819: < * ! 3820: < * HERE FOR ALLOCATION SIZE INTEGER OVERFLOW ! 3821: < * ! 3822: < SBF02 ERB 273,BUFFER SIZE IS TOO BIG ! 3823: < EJC ! 3824: < .FI ! 3825: < * ! 3826: 10086c8879 ! 3827: < ERR 069,BREAK ARGUMENT IS NOT STRING OR EXPRESSION ! 3828: --- ! 3829: > ERR 076,BREAK ARGUMENT IS NOT STRING OR EXPRESSION ! 3830: 10100c8893 ! 3831: < ERR 070,BREAKX ARGUMENT IS NOT STRING OR EXPRESSION ! 3832: --- ! 3833: > ERR 077,BREAKX ARGUMENT IS NOT STRING OR EXPRESSION ! 3834: 10113a8907,8908 ! 3835: > .IF .CNBF ! 3836: > .ELSE ! 3837: 10116c8911 ! 3838: < * CHAR ! 3839: --- ! 3840: > * BUFFER ! 3841: 10118,10130c8913,8923 ! 3842: < S$CHR ENT ENTRY POINT ! 3843: < JSR GTSMI CONVERT ARG TO INTEGER ! 3844: < ERR 281,CHAR ARGUMENT NOT INTEGER ! 3845: < PPM SCHR1 TOO BIG ERROR EXIT ! 3846: < BGE WC,=CFP$A,SCHR1 SEE IF OUT OF RANGE OF HOST SET ! 3847: < MOV =NUM01,WA IF NOT SET SCBLK ALLOCATION ! 3848: < MOV WC,WB SAVE CHAR CODE ! 3849: < JSR ALOCS ALLOCATE 1 BAU SCBLK ! 3850: < MOV XR,XL COPY SCBLK POINTER ! 3851: < PSC XL GET SET TO STUFF CHAR ! 3852: < SCH WB,(XL)+ STUFF IT ! 3853: < ZER XL CLEAR SLOP IN XL ! 3854: < BRN EXIXR EXIT WITH SCBLK POINTER ! 3855: --- ! 3856: > S$BUF ENT ENTRY POINT ! 3857: > MOV (XS)+,XL GET INITIAL STRING ! 3858: > JSR GTSMI CONVERT MEMORY REQUEST TO INTEGER ! 3859: > ERR 078,BUFFER FIRST ARGUMENT IS NOT INTEGER ! 3860: > PPM SBF01 FAIL IF OUT OF RANGE ! 3861: > MOV WC,WA MOVE LENGTH TO CORRECT REGISTER ! 3862: > JSR ALOBF ALLOCATE THE BUFFER ! 3863: > JSR INSBF COPY INITIAL ARG IN ! 3864: > ERR 079,BUFFER SECOND ARGUMENT IS NOT STRING OR BUFFER ! 3865: > ERR 080,BUFFER INITIAL VALUE TOO BIG FOR ALLOCATION ! 3866: > BRN EXSID EXIT SETTING IDVAL ! 3867: 10132c8925 ! 3868: < * HERE IF CHAR ARGUMENT IS OUT OF RANGE ! 3869: --- ! 3870: > * HERE FOR INVALID ALLOCATION SIZE ! 3871: 10134c8927,8928 ! 3872: < SCHR1 ERB 282,CHAR ARGUMENT NOT IN RANGE ! 3873: --- ! 3874: > SBF01 ERB 081,BUFFER FIRST ARGUMENT IS OUT OF RANGE ! 3875: > .FI ! 3876: 10141c8935 ! 3877: < ERR 071,CLEAR ARGUMENT IS NOT STRING ! 3878: --- ! 3879: > ERR 082,CLEAR ARGUMENT IS NOT STRING ! 3880: 10145c8939 ! 3881: < * THE LIST ARE FALGGED BY SETTING VRGET OF VRBLK TO ZERO. ! 3882: --- ! 3883: > * THE LIST ARE FLAGGED BY SETTING VRGET OF VRBLK TO ZERO. ! 3884: 10151c8945 ! 3885: < ERR 072,CLEAR ARGUMENT HAS NULL VARIABLE NAME ! 3886: --- ! 3887: > PPM SCLR7 ERRONEOUS NAME ! 3888: 10153a8948 ! 3889: > BNZ XSCNB,SCLR7 BADLY PLACED BLANK ! 3890: 10181c8976 ! 3891: < * PRROTECTED VARIABLES (ARB, ETC) ARE EXEMPT ! 3892: --- ! 3893: > * PROTECTED VARIABLES (ARB ETC) ARE EXEMPT ! 3894: 10183,10184c8978,8979 ! 3895: < SCLR5 BEQ VRSTO(XR),=B$VRE,SCLR4 CHECK FOR PROTECTED VARIABLE (REG05) ! 3896: < MOV XR,XL COPY VRBLK POINTER (REG05) ! 3897: --- ! 3898: > SCLR5 BEQ VRSTO(XR),=B$VRE,SCLR4 CHECK FOR PROTECTED VARIABLE ! 3899: > MOV XR,XL COPY VRBLK POINTER ! 3900: 10196a8992,8995 ! 3901: > * ! 3902: > * ERROR POINT ! 3903: > * ! 3904: > SCLR7 ERB 083,NULL VARIABLE NAME OR ILLEGAL BLANK IN CLEAR ARG ! 3905: 10213c9012 ! 3906: < ERR 073,COLLECT ARGUMENT IS NOT INTEGER ! 3907: --- ! 3908: > ERR 084,COLLECT ARGUMENT IS NOT INTEGER ! 3909: 10220c9019 ! 3910: < BTW WA CONVERT BYTES TO WORDS ! 3911: --- ! 3912: > BTW WA CONVERT BAUS TO WORDS ! 3913: 10231c9030 ! 3914: < S$CNV ENT ENTRY POINT ! 3915: --- ! 3916: > S$CVT ENT ENTRY POINT ! 3917: 10233,10235c9032,9036 ! 3918: < ERR 074,CONVERT SECOND ARGUMENT IS NOT STRING ! 3919: < .IF .CULC ! 3920: < JSR FLSTG FOLD LOWER CASE TO UPPER CASE ! 3921: --- ! 3922: > ERR 085,CONVERT SECOND ARGUMENT IS NOT STRING ! 3923: > .IF .CASL ! 3924: > MOV XR,XL COPY STRING PTR TO XL ! 3925: > ZER WB ZERO OFFSET ! 3926: > JSR SBSTG CONVERT CASE OF ARG IF NECESSARY ! 3927: 10253c9054 ! 3928: < MOV WA,WC SAVE LENGTH OF ARGUMENT STRING ! 3929: --- ! 3930: > MOV SCLEN(XR),WC SAVE LENGTH OF ARGUMENT STRING ! 3931: 10287c9088 ! 3932: < IFF CNVRT,SCV08 REAL ! 3933: --- ! 3934: > IFF 9,SCV08 REAL ! 3935: 10371c9172 ! 3936: < WTB WA CONVERT LENGTH TO BYTES ! 3937: --- ! 3938: > WTB WA CONVERT LENGTH TO BAUS ! 3939: 10441,10442c9242 ! 3940: < SCV28 MOV XR,-(XS) STACK STRING FOR PROCEDURE ! 3941: < JSR GTSTG CONVERT TO STRING ! 3942: --- ! 3943: > SCV28 JSR GTBUF CONVERT TO BUFFER ! 3944: 10444,10448d9243 ! 3945: < MOV XR,XL SAVE STRING POINTER ! 3946: < JSR ALOBF ALLOCATE BUFFER OF SAME SIZE ! 3947: < JSR APNDB COPY IN THE STRING ! 3948: < PPM ALREADY STRING - CANT FAIL TO CNV ! 3949: < PPM MUST BE ENOUGH ROOM ! 3950: 10450d9244 ! 3951: < EJC ! 3952: 10451a9246 ! 3953: > EJC ! 3954: 10456c9251 ! 3955: < JSR COPYB COPY THE BLOCK ! 3956: --- ! 3957: > JSR CBLCK COPY THE BLOCK ! 3958: 10458a9254,9270 ! 3959: > * ! 3960: > * CTI ! 3961: > * ! 3962: > S$CTI ENT ! 3963: > LDI INTV0 ZERO IN CASE NULL STRING ! 3964: > JSR GTSTG GET ARG AS A STRING ! 3965: > ERR 086,CTI ARGUMENT IS NOT A STRING ! 3966: > BZE WA,SCT01 SKIP IF NULL ! 3967: > PLC XR PREPARE TO READ THE CHARACTER ! 3968: > LCH WB,(XR) GET THE CHARACTER ! 3969: > MTI WB CONVERT TO INTEGER ! 3970: > ZER XR CLEAR GARBAGE ! 3971: > * ! 3972: > * MAKE ICBLK AND RETURN ! 3973: > * ! 3974: > SCT01 JSR ICBLD BUILD ICBLK ! 3975: > BRN EXIXR RETURN INTEGER RESULT ! 3976: 10465,10466c9277,9278 ! 3977: < ERR 075,DATA ARGUMENT IS NOT STRING ! 3978: < ERR 076,DATA ARGUMENT IS NULL ! 3979: --- ! 3980: > ERR 087,DATA ARGUMENT IS NOT STRING ! 3981: > ERR 088,DATA ARGUMENT IS NULL ! 3982: 10474c9286 ! 3983: < ERB 077,DATA ARGUMENT IS MISSING A LEFT PAREN ! 3984: --- ! 3985: > ERB 089,DATA ARGUMENT IS MISSING A LEFT PAREN ! 3986: 10478,10482d9289 ! 3987: < .IF .CULC ! 3988: < SDAT1 MOV SCLEN(XR),WA GET LENGTH ! 3989: < JSR FLSTG FOLD LOWER CASE TO UPPER CASE ! 3990: < MOV XR,XL SAVE NAME PTR ! 3991: < .ELSE ! 3992: 10484d9290 ! 3993: < .FI ! 3994: 10493c9299 ! 3995: < ERR 078,DATA ARGUMENT HAS NULL DATATYPE NAME ! 3996: --- ! 3997: > ERR 090,DATA ARGUMENT HAS NULL DATATYPE NAME ! 3998: 10504c9310 ! 3999: < ERB 079,DATA ARGUMENT IS MISSING A RIGHT PAREN ! 4000: --- ! 4001: > ERB 091,BAD BLANK OR MISSING RIGHT PAREN IN DATA ARG ! 4002: 10509c9315 ! 4003: < ERR 080,DATA ARGUMENT HAS NULL FIELD NAME ! 4004: --- ! 4005: > ERR 092,DATA ARGUMENT HAS NULL FIELD NAME ! 4006: 10521c9327 ! 4007: < WTB WA CONVERT LENGTH TO BYTES ! 4008: --- ! 4009: > WTB WA CONVERT LENGTH TO BAUS ! 4010: 10608c9414 ! 4011: < S$DEF ENT ENTRY POINT ! 4012: --- ! 4013: > S$DFN ENT ENTRY POINT ! 4014: 10619,10620c9425,9426 ! 4015: < ERR 081,DEFINE FIRST ARGUMENT IS NOT STRING ! 4016: < ERR 082,DEFINE FIRST ARGUMENT IS NULL ! 4017: --- ! 4018: > ERR 093,DEFINE FIRST ARGUMENT IS NOT STRING ! 4019: > ERR 094,DEFINE FIRST ARGUMENT IS NULL ! 4020: 10625c9431 ! 4021: < ERB 083,DEFINE FIRST ARGUMENT IS MISSING A LEFT PAREN ! 4022: --- ! 4023: > ERB 095,DEFINE FIRST ARGUMENT IS MISSING A LEFT PAREN ! 4024: 10630c9436 ! 4025: < ERR 084,DEFINE FIRST ARGUMENT HAS NULL FUNCTION NAME ! 4026: --- ! 4027: > ERR 096,DEFINE FIRST ARGUMENT HAS NULL FUNCTION NAME ! 4028: 10642,10643c9448,9454 ! 4029: < BNZ WA,SDF04 SKIP IF DELIMITER FOUND ! 4030: < ERB 085,NULL ARG NAME OR MISSING ) IN DEFINE FIRST ARG. ! 4031: --- ! 4032: > BZE WA,SDF14 FAIL IF RUNOUT ! 4033: > JSR GTNVR GET VRBLK POINTER ! 4034: > PPM SDF04 IGNORE NULL NAME ! 4035: > MOV XR,-(XS) STACK ARGUMENT VRBLK POINTER ! 4036: > ICV WB INCREMENT COUNTER ! 4037: > BEQ WA,=NUM02,SDF03 LOOP BACK IF STOPPED BY A COMMA ! 4038: > BRN SDF05 JUMP FOR RIGHT PAREN ! 4039: 10648c9459 ! 4040: < * HERE AFTER SCANNING AN ARGUMENT NAME ! 4041: --- ! 4042: > * NULL ARG FOUND. CONTINUE IF STOPPED BY COMMA ! 4043: 10650,10651c9461 ! 4044: < SDF04 BNE XR,=NULLS,SDF05 SKIP IF NON-NULL ! 4045: < BZE WB,SDF06 IGNORE NULL IF CASE OF NO ARGUMENTS ! 4046: --- ! 4047: > SDF04 BEQ WA,=NUM02,SDF03 LOOP IF COMMA ! 4048: 10653,10660d9462 ! 4049: < * HERE AFTER DEALING WITH THE CASE OF NO ARGUMENTS ! 4050: < * ! 4051: < SDF05 JSR GTNVR GET VRBLK POINTER ! 4052: < PPM SDF03 LOOP BACK TO IGNORE NULL NAME ! 4053: < MOV XR,-(XS) STACK ARGUMENT VRBLK POINTER ! 4054: < ICV WB INCREMENT COUNTER ! 4055: < BEQ WA,=NUM02,SDF03 LOOP BACK IF STOPPED BY A COMMA ! 4056: < * ! 4057: 10663c9465 ! 4058: < SDF06 MOV WB,DEFNA SAVE NUMBER OF ARGUMENTS ! 4059: --- ! 4060: > SDF05 MOV WB,DEFNA SAVE NUMBER OF ARGUMENTS ! 4061: 10668c9470 ! 4062: < SDF07 MOV =CH$CM,WC SET DELIMITER ONE = COMMA ! 4063: --- ! 4064: > SDF06 MOV =CH$CM,WC SET DELIMITER ONE = COMMA ! 4065: 10671,10672c9473,9474 ! 4066: < BNE XR,=NULLS,SDF08 SKIP IF NON-NULL ! 4067: < BZE WB,SDF09 IGNORE NULL IF CASE OF NO LOCALS ! 4068: --- ! 4069: > BNZ WA,SDF07 SKIP IF COMMA FOUND ! 4070: > BNZ XSCNB,SDF14 FAIL IF BAD BLANK, OK IF LAST LOC ! 4071: 10676,10677c9478,9479 ! 4072: < SDF08 JSR GTNVR GET VRBLK POINTER ! 4073: < PPM SDF07 LOOP BACK TO IGNORE NULL NAME ! 4074: --- ! 4075: > SDF07 JSR GTNVR GET VRBLK POINTER ! 4076: > PPM SDF08 IGNORE NULL NAME ! 4077: 10680c9482,9487 ! 4078: < BNZ WA,SDF07 LOOP BACK IF STOPPED BY A COMMA ! 4079: --- ! 4080: > BNZ WA,SDF06 LOOP BACK IF STOPPED BY A COMMA ! 4081: > BRN SDF09 JUMP FOR END OF STRING ! 4082: > * ! 4083: > * NULL LOCAL ! 4084: > * ! 4085: > SDF08 BNZ WA,SDF06 LOOP IF COMMA AFTER NULL LOCAL ! 4086: 10691c9498 ! 4087: < WTB WA CONVERT LENGTH TO BYTES ! 4088: --- ! 4089: > WTB WA CONVERT LENGTH TO BAUS ! 4090: 10734c9541,9545 ! 4091: < SDF13 ERB 086,DEFINE FUNCTION ENTRY POINT IS NOT DEFINED LABEL ! 4092: --- ! 4093: > SDF13 ERB 097,DEFINE FUNCTION ENTRY POINT IS NOT DEFINED LABEL ! 4094: > * ! 4095: > * ERRONEOUS ARG OR LOCAL ! 4096: > * ! 4097: > SDF14 ERB 098,BAD BLANK OR MISSING RIGHT PAREN IN DEFINE ARG ! 4098: 10742,10744c9553,9573 ! 4099: < ERR 087,DETACH ARGUMENT IS NOT APPROPRIATE NAME ! 4100: < JSR DTACH DETACH I/O ASSOCIATION FROM NAME ! 4101: < BRN EXNUL RETURN NULL RESULT ! 4102: --- ! 4103: > ERR 099,DETACH ARGUMENT IS NOT APPROPRIATE NAME ! 4104: > MOV WA,-(XS) KEEP OFFSET ! 4105: > ZER SDETF CLEAR FAIL FLAG ! 4106: > MOV =TRTIN,WB TRACE TYPE ! 4107: > ZER XR REMOVE TRBLK ! 4108: > JSR TRCHN REMOVE ANY INPUT ASSOCIATION ! 4109: > PPM SDET1 SKIP IF NO INPUT TRBLK ! 4110: > MNZ SDETF NOTE TRBLK REMOVED ! 4111: > * ! 4112: > * REPEAT FOR OUTPUT TRBLK ! 4113: > * ! 4114: > SDET1 MOV (XS)+,WA RECOVER OFFSET ! 4115: > MOV =TRTOU,WB TRTYP ! 4116: > JSR TRCHN REMOVE ANY OUTPUT ASSOCIATION ! 4117: > PPM SDET2 SKIP IF NO TRBLK ! 4118: > BRN EXNUL SUCCEED ! 4119: > * ! 4120: > * CHECK AT LEAST ONE TRBLK REMOVED ! 4121: > * ! 4122: > SDET2 BNZ SDETF,EXNUL SUCCEED IF SO ! 4123: > BRN EXFAL ELSE FAIL ! 4124: 10761,10762c9590,9591 ! 4125: < ERR 088,DUMP ARGUMENT IS NOT INTEGER ! 4126: < ERR 089,DUMP ARGUMENT IS NEGATIVE OR TOO LARGE ! 4127: --- ! 4128: > ERR 100,DUMP ARGUMENT IS NOT INTEGER ! 4129: > ERR 101,DUMP ARGUMENT IS NEGATIVE OR TOO LARGE ! 4130: 10771c9600 ! 4131: < ERR 090,DUPL SECOND ARGUMENT IS NOT INTEGER ! 4132: --- ! 4133: > ERR 102,DUPL SECOND ARGUMENT IS NOT INTEGER ! 4134: 10816c9645 ! 4135: < ERR 091,DUPL FIRST ARGUMENT IS NOT STRING OR PATTERN ! 4136: --- ! 4137: > ERR 103,DUPL FIRST ARGUMENT IS NOT STRING OR PATTERN ! 4138: 10848,10850c9677,9685 ! 4139: < JSR IOFCB CALL FCBLK ROUTINE ! 4140: < ERR 092,EJECT ARGUMENT IS NOT A SUITABLE NAME ! 4141: < PPM SEJC1 NULL ARGUMENT ! 4142: --- ! 4143: > MOV (XS)+,WB GET ARGUMENT ! 4144: > MOV WB,-(XS) RESTACK IT ! 4145: > JSR GTSTG CONVERT TO STRING ! 4146: > PPM SEJC2 FAIL IF CANT ! 4147: > BZE WA,SEJC1 SKIP IF NULL STRING ! 4148: > MOV WB,-(XS) RESTACK ORIGINAL ARG ! 4149: > JSR IOFTG CALL FILETAG ROUTINE ! 4150: > PPM SEJC2 FAIL ! 4151: > BZE WA,EXFAL FAIL IF NOT ASSOCIATED ! 4152: 10852,10854c9687,9688 ! 4153: < ERR 093,EJECT FILE DOES NOT EXIST ! 4154: < ERR 094,EJECT FILE DOES NOT PERMIT PAGE EJECT ! 4155: < ERR 095,EJECT CAUSED NON-RECOVERABLE OUTPUT ERROR ! 4156: --- ! 4157: > PPM EXFAL FAIL RETURN ! 4158: > PPM EROSI ERROR RETURN ! 4159: 10859a9694,9695 ! 4160: > PPM EXFAL FAIL RETURN ! 4161: > PPM EROSI ERROR RETURN ! 4162: 10860a9697,9700 ! 4163: > * ! 4164: > * ERROR POINT ! 4165: > * ! 4166: > SEJC2 ERB 104,EJECT ARGUMENT IS NOT A SUITABLE FILETAG ! 4167: 10866,10873c9706,9709 ! 4168: < JSR IOFCB CALL FCBLK ROUTINE ! 4169: < ERR 096,ENDFILE ARGUMENT IS NOT A SUITABLE NAME ! 4170: < ERR 097,ENDFILE ARGUMENT IS NULL ! 4171: < JSR SYSEN CALL ENDFILE ROUTINE ! 4172: < ERR 098,ENDFILE FILE DOES NOT EXIST ! 4173: < ERR 099,ENDFILE FILE DOES NOT PERMIT ENDFILE ! 4174: < ERR 100,ENDFILE CAUSED NON-RECOVERABLE OUTPUT ERROR ! 4175: < MOV XL,WB REMEMBER VRBLK PTR FROM IOFCB CALL ! 4176: --- ! 4177: > JSR GTSTG CONVERT SECOND ARG TO STRING ! 4178: > ERR 105,ENDFILE SECOND ARGUMENT IS NOT A STRING ! 4179: > BNZ WA,SENF1 SKIP IF NON NULL SECOND ARG ! 4180: > ZER XR 0 IF NULL ! 4181: 10875c9711 ! 4182: < * LOOP TO FIND TRTRF BLOCK ! 4183: --- ! 4184: > * NOW PROCESS FILETAG ! 4185: 10877,10909c9713,9728 ! 4186: < SENF1 MOV XL,XR COPY POINTER ! 4187: < MOV TRVAL(XR),XR CHAIN ALONG ! 4188: < BNE (XR),=B$TRT,EXNUL SKIP OUT IF CHAIN END ! 4189: < BNE TRTYP(XR),=TRTFC,SENF1 LOOP IF NOT FOUND ! 4190: < MOV TRVAL(XR),TRVAL(XL) REMOVE TRTRF ! 4191: < MOV TRTRF(XR),ENFCH POINT TO HEAD OF IOCHN ! 4192: < MOV TRFPT(XR),WC POINT TO FCBLK ! 4193: < MOV WB,XR FILEARG1 VRBLK FROM IOFCB ! 4194: < JSR SETVR RESET IT ! 4195: < MOV =R$FCB,XL PTR TO HEAD OF FCBLK CHAIN ! 4196: < SUB *NUM02,XL ADJUST READY TO ENTER LOOP ! 4197: < * ! 4198: < * FIND FCBLK ! 4199: < * ! 4200: < SENF2 MOV XL,XR COPY PTR ! 4201: < MOV 2(XL),XL GET NEXT LINK ! 4202: < BZE XL,SENF4 STOP IF CHAIN END ! 4203: < BEQ 3(XL),WC,SENF3 JUMP IF FCBLK FOUND ! 4204: < BRN SENF2 LOOP ! 4205: < * ! 4206: < * REMOVE FCBLK ! 4207: < * ! 4208: < SENF3 MOV 2(XL),2(XR) DELETE FCBLK FROM CHAIN ! 4209: < * ! 4210: < * LOOP WHICH DETACHES ALL VBLS ON IOCHN CHAIN ! 4211: < * ! 4212: < SENF4 MOV ENFCH,XL GET CHAIN HEAD ! 4213: < BZE XL,EXNUL FINISHED IF CHAIN END ! 4214: < MOV TRTRF(XL),ENFCH CHAIN ALONG ! 4215: < MOV IONMO(XL),WA NAME OFFSET ! 4216: < MOV IONMB(XL),XL NAME BASE ! 4217: < JSR DTACH DETACH NAME ! 4218: < BRN SENF4 LOOP TILL DONE ! 4219: --- ! 4220: > SENF1 MOV XR,SENFR KEEP SECOND ARG ! 4221: > JSR IOFTG CALL FILETAG PROC (WB = VRBLK PTR) ! 4222: > ERR 106,ENDFILE FIRST ARGUMENT IS NOT A SUITABLE FILETAG ! 4223: > BZE WA,EXFAL FAIL IF NO IOTAG ! 4224: > MOV SENFR,XR RECOVER SECOND ARG ! 4225: > JSR SYSEN CALL ENDFILE ROUTINE ! 4226: > PPM EXFAL FAIL RETURN ! 4227: > PPM EROSI ERROR RETURN ! 4228: > BNZ WA,EXNUL RETURN NULL IF NO FILE CLOSURE ! 4229: > MOV WB,XL POINT TO FILETAG VRBLK ! 4230: > MOV *VRVAL,WA OFFSET TO VALUE FIELD ! 4231: > ZER XR FOR TRBLK REMOVAL ! 4232: > MOV =TRTIO,WB TRTYP ! 4233: > JSR TRCHN REMOVE TRBLK ! 4234: > PPM EXFAL (CANT FAIL HERE) ! 4235: > BRN EXNUL RETURN NULL ! 4236: 10916,10917c9735,9736 ! 4237: < ERR 101,EQ FIRST ARGUMENT IS NOT NUMERIC ! 4238: < ERR 102,EQ SECOND ARGUMENT IS NOT NUMERIC ! 4239: --- ! 4240: > ERR 107,EQ FIRST ARGUMENT IS NOT NUMERIC ! 4241: > ERR 108,EQ SECOND ARGUMENT IS NOT NUMERIC ! 4242: 10928c9747 ! 4243: < ERR 103,EVAL ARGUMENT IS NOT EXPRESSION ! 4244: --- ! 4245: > ERR 109,EVAL ARGUMENT IS NOT EXPRESSION ! 4246: 10963c9782 ! 4247: < ERR 104,EXIT ARGUMENT IS NOT SUITABLE INTEGER OR STRING ! 4248: --- ! 4249: > ERR 110,EXIT ARGUMENT IS NOT SUITABLE INTEGER OR STRING ! 4250: 10969d9787 ! 4251: < MOV R$FCB,WB GET FCBLK CHAIN HEADER ! 4252: 10973a9792 ! 4253: > MOV =KVCOD,WA VALUE OF CODE KEYWORD ! 4254: 10975,10976c9794,9795 ! 4255: < ERR 105,EXIT ACTION NOT AVAILABLE IN THIS IMPLEMENTATION ! 4256: < ERR 106,EXIT ACTION CAUSED IRRECOVERABLE ERROR ! 4257: --- ! 4258: > PPM EXFAL FAIL RETURN ! 4259: > PPM EROSI ERROR RETURN ! 4260: 10978c9797 ! 4261: < ZER GBCNT RESUMING EXECUTION SO RESET ! 4262: --- ! 4263: > ZER GBCNT RESUMING EXECUTION SO. ! 4264: 10984c9803 ! 4265: < SEXT2 MFI WC GET VALUE IN WORK REG ! 4266: --- ! 4267: > SEXT2 MFI WC GET VALUE IN WORK REGISTER ! 4268: 10989c9808 ! 4269: < MOV (XS)+,WC RESTORE VALUE ! 4270: --- ! 4271: > MOV (XS)+,WA RESTORE VALUE ! 4272: 10991c9810 ! 4273: < * DEAL WITH HEADER OPTION (FIDDLED BY PRPAR) ! 4274: --- ! 4275: > * DEAL WITH HEADER OPTIONS (FIDDLED BY PRPAR) ! 4276: 10999c9818 ! 4277: < SEXT4 JSR SYSTM GET EXECUTION TIME START (SGD11) ! 4278: --- ! 4279: > SEXT4 JSR SYSTM GET RECOMMENCEMENT TIME ! 4280: 11004a9824,9825 ! 4281: > .IF .CNFN ! 4282: > .ELSE ! 4283: 11006a9828,9848 ! 4284: > * FENCE ! 4285: > * ! 4286: > S$FNC ENT ENTRY POINT ! 4287: > MOV =P$FNC,WB SET PCODE FOR P$FNC ! 4288: > ZER XR P0BLK ! 4289: > JSR PBILD BUILD P$FNC NODE ! 4290: > MOV XR,XL SAVE POINTER TO IT ! 4291: > MOV (XS)+,XR GET ARGUMENT ! 4292: > JSR GTPAT CONVERT TO PATTERN ! 4293: > ERR 180,FENCE ARGUMENT IS NOT PATTERN ! 4294: > JSR PCONC CONCATENATE TO P$FNC NODE ! 4295: > MOV XR,XL SAVE PTR TO CONCATENATED PATTERN ! 4296: > MOV =P$FNA,WB SET FOR P$FNA PCODE ! 4297: > ZER XR P0BLK ! 4298: > JSR PBILD CONSTRUCT P$FNA NODE ! 4299: > MOV XL,PTHEN(XR) SET PATTERN AS PTHEN ! 4300: > MOV XR,-(XS) SET AS RESULT ! 4301: > BRN EXITS DO NEXT CODE WORD ! 4302: > EJC ! 4303: > .FI ! 4304: > * ! 4305: 11011c9853 ! 4306: < ERR 107,FIELD SECOND ARGUMENT IS NOT INTEGER ! 4307: --- ! 4308: > ERR 255,FIELD SECOND ARGUMENT IS NOT INTEGER ! 4309: 11031c9873 ! 4310: < SFLD1 ERB 108,FIELD FIRST ARGUMENT IS NOT DATATYPE NAME ! 4311: --- ! 4312: > SFLD1 ERB 254,FIELD FIRST ARGUMENT IS NOT DATATYPE NAME ! 4313: 11034,11053d9875 ! 4314: < * FENCE ! 4315: < * ! 4316: < S$FNC ENT ENTRY POINT ! 4317: < MOV =P$FNC,WB SET PCODE FOR P$FNC ! 4318: < ZER XR P0BLK ! 4319: < JSR PBILD BUILD P$FNC NODE ! 4320: < MOV XR,XL SAVE POINTER TO IT ! 4321: < MOV (XS)+,XR GET ARGUMENT ! 4322: < JSR GTPAT CONVERT TO PATTERN ! 4323: < ERR 259,FENCE ARGUMENT IS NOT PATTERN ! 4324: < JSR PCONC CONCATENATE TO P$FNC NODE ! 4325: < MOV XR,XL SAVE PTR TO CONCATENATED PATTERN ! 4326: < MOV =P$FNA,WB SET FOR P$FNA PCODE ! 4327: < ZER XR P0BLK ! 4328: < JSR PBILD CONSTRUCT P$FNA NODE ! 4329: < MOV XL,PTHEN(XR) SET PATTERN AS PTHEN ! 4330: < MOV XR,-(XS) SET AS RESULT ! 4331: < BRN EXITS DO NEXT CODE WORD ! 4332: < EJC ! 4333: < * ! 4334: 11058,11059c9880,9881 ! 4335: < ERR 109,GE FIRST ARGUMENT IS NOT NUMERIC ! 4336: < ERR 110,GE SECOND ARGUMENT IS NOT NUMERIC ! 4337: --- ! 4338: > ERR 111,GE FIRST ARGUMENT IS NOT NUMERIC ! 4339: > ERR 112,GE SECOND ARGUMENT IS NOT NUMERIC ! 4340: 11063d9884 ! 4341: < EJC ! 4342: 11069,11070c9890,9891 ! 4343: < ERR 111,GT FIRST ARGUMENT IS NOT NUMERIC ! 4344: < ERR 112,GT SECOND ARGUMENT IS NOT NUMERIC ! 4345: --- ! 4346: > ERR 113,GT FIRST ARGUMENT IS NOT NUMERIC ! 4347: > ERR 114,GT SECOND ARGUMENT IS NOT NUMERIC ! 4348: 11079,11087c9900,9913 ! 4349: < MOV (XS)+,XR GET THIRD ARG ! 4350: < MOV (XS)+,XL GET SECOND ARG ! 4351: < MOV (XS)+,WA GET FIRST ARG ! 4352: < JSR SYSHS ENTER SYSHS ROUTINE ! 4353: < ERR 254,ERRONEOUS ARGUMENT FOR HOST ! 4354: < ERR 255,ERROR DURING EXECUTION OF HOST ! 4355: < PPM SHST1 STORE HOST STRING ! 4356: < PPM EXNUL RETURN NULL RESULT ! 4357: < PPM EXIXR RETURN XR ! 4358: --- ! 4359: > JSR GTSTG CONVERT ARG TO STRING ! 4360: > ERR 115,ERRONEOUS THIRD ARGUMENT FOR HOST ! 4361: > MOV WA,WB KEEP LENGTH ! 4362: > MOV XR,WC KEEP THIRD ARG ! 4363: > JSR GTSTG CONVERT ARG TO STRING ! 4364: > ERR 116,ERRONEOUS SECOND ARGUMENT FOR HOST ! 4365: > ORB WA,WB NON ZERO UNLESS TWO ARGS NULL ! 4366: > MOV XR,XL KEEP SECOND ARG ! 4367: > JSR GTSTG CONVERT ARG TO STRING ! 4368: > ERR 117,ERRONEOUS FIRST ARGUMENT FOR HOST ! 4369: > ORB WA,WB NON ZERO UNLESS ALL ARGS NULL ! 4370: > MOV XR,WA KEEP FIRST ARG ! 4371: > MOV WC,XR GET THIRD ARG ! 4372: > JSR SYSHS CALL SYSHS ROUTINE ! 4373: 11089,11093c9915,9916 ! 4374: < * ! 4375: < * RETURN HOST STRING ! 4376: < * ! 4377: < SHST1 BZE XL,EXNUL NULL STRING IF SYSHS UNCOOPERATIVE ! 4378: < MOV SCLEN(XL),WA LENGTH ! 4379: --- ! 4380: > PPM EROSI ERROR RETURN ! 4381: > MOV SCLEN(XL),WA LENGTH OF RETURNED STRING ! 4382: 11115,11120c9938,9941 ! 4383: < ERR 113,INPUT THIRD ARGUMENT IS NOT A STRING ! 4384: < ERR 114,INAPPROPRIATE SECOND ARGUMENT FOR INPUT ! 4385: < ERR 115,INAPPROPRIATE FIRST ARGUMENT FOR INPUT ! 4386: < ERR 116,INAPPROPRIATE FILE SPECIFICATION FOR INPUT ! 4387: < PPM EXFAL FAIL IF FILE DOES NOT EXIST ! 4388: < ERR 117,INPUT FILE CANNOT BE READ ! 4389: --- ! 4390: > ERR 118,INPUT THIRD ARGUMENT (FILEPROPS) IS NOT A STRING ! 4391: > ERR 119,INAPPROPRIATE SECOND ARGUMENT (FILETAG) FOR INPUT ! 4392: > ERR 120,INAPPROPRIATE FIRST ARGUMENT FOR INPUT ! 4393: > PPM EXFAL FAIL RETURN ! 4394: 11122d9942 ! 4395: < EJC ! 4396: 11124a9945 ! 4397: > EJC ! 4398: 11131c9952 ! 4399: < ERR 277,INSERT THIRD ARGUMENT NOT INTEGER ! 4400: --- ! 4401: > ERR 121,INSERT THIRD ARGUMENT NOT INTEGER ! 4402: 11135c9956 ! 4403: < ERR 278,INSERT SECOND ARGUMENT NOT INTEGER ! 4404: --- ! 4405: > ERR 122,INSERT SECOND ARGUMENT NOT INTEGER ! 4406: 11142c9963 ! 4407: < ERB 279,INSERT FIRST ARGUMENT NOT BUFFER ! 4408: --- ! 4409: > ERB 123,INSERT FIRST ARGUMENT NOT BUFFER ! 4410: 11147c9968 ! 4411: < ERR 280,INSERT FOURTH ARGUMENT NOT A STRING ! 4412: --- ! 4413: > ERR 124,INSERT FOURTH ARGUMENT NOT A STRING ! 4414: 11150d9970 ! 4415: < EJC ! 4416: 11151a9972 ! 4417: > EJC ! 4418: 11162a9984,10000 ! 4419: > * ITC ! 4420: > * ! 4421: > S$ITC ENT ! 4422: > JSR GTSMI OBTAIN ARG AS AN INTEGER ! 4423: > ERR 125,ITC ARGUMENT IS NOT A SMALL INTEGER ! 4424: > PPM EXFAL FAIL IF OUT OF RANGE ! 4425: > BGE WC,=CFP$A,EXFAL FURTHER RANGE CHECK ! 4426: > MOV WC,WB PRESERVE WC ! 4427: > MOV =NUM01,WA FOR SCBLK REQUEST ! 4428: > JSR ALOCS BUILD STRING BLOCK ! 4429: > MOV XR,XL COPY STRING PTR ! 4430: > PSC XL READY TO STORE CHAR ! 4431: > SCH WB,(XL) STORE IT ! 4432: > ZER XL CLEAR GARBAGE ! 4433: > BRN EXIXR RETURN STRING RESULT ! 4434: > EJC ! 4435: > * ! 4436: 11200,11201c10038,10039 ! 4437: < ERR 118,LE FIRST ARGUMENT IS NOT NUMERIC ! 4438: < ERR 119,LE SECOND ARGUMENT IS NOT NUMERIC ! 4439: --- ! 4440: > ERR 126,LE FIRST ARGUMENT IS NOT NUMERIC ! 4441: > ERR 127,LE SECOND ARGUMENT IS NOT NUMERIC ! 4442: 11213,11214c10051,10052 ! 4443: < ERR 120,LEN ARGUMENT IS NOT INTEGER OR EXPRESSION ! 4444: < ERR 121,LEN ARGUMENT IS NEGATIVE OR TOO LARGE ! 4445: --- ! 4446: > ERR 128,LEN ARGUMENT IS NOT INTEGER OR EXPRESSION ! 4447: > ERR 129,LEN ARGUMENT IS NEGATIVE OR TOO LARGE ! 4448: 11222,11223c10060,10061 ! 4449: < ERR 122,LEQ FIRST ARGUMENT IS NOT STRING ! 4450: < ERR 123,LEQ SECOND ARGUMENT IS NOT STRING ! 4451: --- ! 4452: > ERR 130,LEQ FIRST ARGUMENT IS NOT STRING ! 4453: > ERR 131,LEQ SECOND ARGUMENT IS NOT STRING ! 4454: 11233,11234c10071,10072 ! 4455: < ERR 124,LGE FIRST ARGUMENT IS NOT STRING ! 4456: < ERR 125,LGE SECOND ARGUMENT IS NOT STRING ! 4457: --- ! 4458: > ERR 132,LGE FIRST ARGUMENT IS NOT STRING ! 4459: > ERR 133,LGE SECOND ARGUMENT IS NOT STRING ! 4460: 11244,11245c10082,10083 ! 4461: < ERR 126,LGT FIRST ARGUMENT IS NOT STRING ! 4462: < ERR 127,LGT SECOND ARGUMENT IS NOT STRING ! 4463: --- ! 4464: > ERR 134,LGT FIRST ARGUMENT IS NOT STRING ! 4465: > ERR 135,LGT SECOND ARGUMENT IS NOT STRING ! 4466: 11255,11256c10093,10094 ! 4467: < ERR 128,LLE FIRST ARGUMENT IS NOT STRING ! 4468: < ERR 129,LLE SECOND ARGUMENT IS NOT STRING ! 4469: --- ! 4470: > ERR 136,LLE FIRST ARGUMENT IS NOT STRING ! 4471: > ERR 137,LLE SECOND ARGUMENT IS NOT STRING ! 4472: 11266,11267c10104,10105 ! 4473: < ERR 130,LLT FIRST ARGUMENT IS NOT STRING ! 4474: < ERR 131,LLT SECOND ARGUMENT IS NOT STRING ! 4475: --- ! 4476: > ERR 138,LLT FIRST ARGUMENT IS NOT STRING ! 4477: > ERR 139,LLT SECOND ARGUMENT IS NOT STRING ! 4478: 11277,11278c10115,10116 ! 4479: < ERR 132,LNE FIRST ARGUMENT IS NOT STRING ! 4480: < ERR 133,LNE SECOND ARGUMENT IS NOT STRING ! 4481: --- ! 4482: > ERR 140,LNE FIRST ARGUMENT IS NOT STRING ! 4483: > ERR 141,LNE SECOND ARGUMENT IS NOT STRING ! 4484: 11282,11309d10119 ! 4485: < EJC ! 4486: < * ! 4487: < * LOCAL ! 4488: < * ! 4489: < S$LOC ENT ENTRY POINT ! 4490: < JSR GTSMI GET SECOND ARGUMENT (LOCAL NUMBER) ! 4491: < ERR 134,LOCAL SECOND ARGUMENT IS NOT INTEGER ! 4492: < PPM EXFAL FAIL IF OUT OF RANGE ! 4493: < MOV XR,WB SAVE LOCAL NUMBER ! 4494: < MOV (XS)+,XR LOAD FIRST ARGUMENT ! 4495: < JSR GTNVR POINT TO VRBLK ! 4496: < PPM SLOC1 JUMP IF NOT VARIABLE NAME ! 4497: < MOV VRFNC(XR),XR ELSE LOAD FUNCTION POINTER ! 4498: < BNE (XR),=B$PFC,SLOC1 JUMP IF NOT PROGRAM DEFINED ! 4499: < * ! 4500: < * HERE IF WE HAVE A PROGRAM DEFINED FUNCTION NAME ! 4501: < * ! 4502: < BZE WB,EXFAL FAIL IF SECOND ARG IS ZERO ! 4503: < BGT WB,PFNLO(XR),EXFAL OR TOO LARGE ! 4504: < ADD FARGS(XR),WB ELSE ADJUST OFFSET TO INCLUDE ARGS ! 4505: < WTB WB CONVERT TO BYTES ! 4506: < ADD WB,XR POINT TO LOCAL POINTER ! 4507: < MOV PFAGB(XR),XR LOAD VRBLK POINTER ! 4508: < BRN EXVNM EXIT BUILDING NMBLK ! 4509: < * ! 4510: < * HERE IF FIRST ARGUMENT IS NO GOOD ! 4511: < * ! 4512: < SLOC1 ERB 135,LOCAL FIRST ARG IS NOT A PROGRAM FUNCTION NAME ! 4513: 11318c10128 ! 4514: < ERR 136,LOAD SECOND ARGUMENT IS NOT STRING ! 4515: --- ! 4516: > ERR 142,LOAD SECOND ARGUMENT IS NOT STRING ! 4517: 11321,11322c10131,10132 ! 4518: < ERR 137,LOAD FIRST ARGUMENT IS NOT STRING ! 4519: < ERR 138,LOAD FIRST ARGUMENT IS NULL ! 4520: --- ! 4521: > ERR 143,LOAD FIRST ARGUMENT IS NOT STRING ! 4522: > ERR 144,LOAD FIRST ARGUMENT IS NULL ! 4523: 11329c10139 ! 4524: < ERB 139,LOAD FIRST ARGUMENT IS MISSING A LEFT PAREN ! 4525: --- ! 4526: > ERB 145,LOAD FIRST ARGUMENT IS MISSING A LEFT PAREN ! 4527: 11334c10144 ! 4528: < ERR 140,LOAD FIRST ARGUMENT HAS NULL FUNCTION NAME ! 4529: --- ! 4530: > ERR 146,LOAD FIRST ARGUMENT HAS NULL FUNCTION NAME ! 4531: 11345c10155 ! 4532: < ERB 141,LOAD FIRST ARGUMENT IS MISSING A RIGHT PAREN ! 4533: --- ! 4534: > ERB 147,BAD BLANK OR MISSING RIGHT PAREN IN LOAD ARG ! 4535: 11355c10165 ! 4536: < MOV =NUM01,WB SET STRING CODE IN CASE ! 4537: --- ! 4538: > MOV =NUM01,WB SET STRING CODE IN CASE (1) ! 4539: 11363a10174 ! 4540: > ICV WB ELSE SET CODE FOR REAL (3) ! 4541: 11366,11367c10177 ! 4542: < MOV (XS),XR ELSE RELOAD STRING POINTER ! 4543: < ICV WB SET CODE FOR REAL (3) ! 4544: --- ! 4545: > MOV (XS),XR RELOAD STRING POINTER ! 4546: 11371a10182,10189 ! 4547: > ICV WB SET CODE FOR BUFFER (4) ! 4548: > .IF .CNBF ! 4549: > .ELSE ! 4550: > MOV (XS),XR RELOAD STRING POINTER ! 4551: > MOV =SCBUF,XL POINT TO /BUFFER/ ! 4552: > JSR IDENT CHECK FOR MATCH ! 4553: > PPM SLOD4 JUMP IF MATCH ! 4554: > .FI ! 4555: 11395c10213 ! 4556: < WTB WA CONVERT LENGTH TO BYTES ! 4557: --- ! 4558: > WTB WA CONVERT LENGTH TO BAUS ! 4559: 11420,11421c10238,10239 ! 4560: < ERR 142,LOAD FUNCTION DOES NOT EXIST ! 4561: < ERR 143,LOAD FUNCTION CAUSED INPUT ERROR DURING LOAD ! 4562: --- ! 4563: > PPM EXFAL FAIL RETURN ! 4564: > PPM EROSI ERROR RETURN ! 4565: 11429a10248,10275 ! 4566: > * LOCAL ! 4567: > * ! 4568: > S$LOC ENT ENTRY POINT ! 4569: > JSR GTSMI GET SECOND ARGUMENT (LOCAL NUMBER) ! 4570: > ERR 256,LOCAL SECOND ARGUMENT IS NOT INTEGER ! 4571: > PPM EXFAL FAIL IF OUT OF RANGE ! 4572: > MOV XR,WB SAVE LOCAL NUMBER ! 4573: > MOV (XS)+,XR LOAD FIRST ARGUMENT ! 4574: > JSR GTNVR POINT TO VRBLK ! 4575: > PPM SLOC1 JUMP IF NOT VARIABLE NAME ! 4576: > MOV VRFNC(XR),XR ELSE LOAD FUNCTION POINTER ! 4577: > BNE (XR),=B$PFC,SLOC1 JUMP IF NOT PROGRAM DEFINED ! 4578: > * ! 4579: > * HERE IF WE HAVE A PROGRAM DEFINED FUNCTION NAME ! 4580: > * ! 4581: > BZE WB,EXFAL FAIL IF SECOND ARG IS ZERO ! 4582: > BGT WB,PFNLO(XR),EXFAL OR TOO LARGE ! 4583: > ADD FARGS(XR),WB ELSE ADJUST OFFSET TO INCLUDE ARGS ! 4584: > WTB WB CONVERT TO BYTES ! 4585: > ADD WB,XR POINT TO LOCAL POINTER ! 4586: > MOV PFAGB(XR),XR LOAD VRBLK POINTER ! 4587: > BRN EXVNM EXIT BUILDING NMBLK ! 4588: > * ! 4589: > * HERE IF FIRST ARGUMENT IS NO GOOD ! 4590: > * ! 4591: > SLOC1 ERB 257,LOCAL FIRST ARG IS NOT A PROGRAM FUNCTION NAME ! 4592: > EJC ! 4593: > * ! 4594: 11434c10280 ! 4595: < ERR 144,LPAD THIRD ARGUMENT NOT A STRING ! 4596: --- ! 4597: > ERR 148,LPAD THIRD ARGUMENT NOT A STRING ! 4598: 11438c10284 ! 4599: < ERR 145,LPAD SECOND ARGUMENT IS NOT INTEGER ! 4600: --- ! 4601: > ERR 149,LPAD SECOND ARGUMENT IS NOT INTEGER ! 4602: 11444c10290 ! 4603: < ERR 146,LPAD FIRST ARGUMENT IS NOT STRING ! 4604: --- ! 4605: > ERR 150,LPAD FIRST ARGUMENT IS NOT STRING ! 4606: 11485,11486c10331,10332 ! 4607: < ERR 147,LT FIRST ARGUMENT IS NOT NUMERIC ! 4608: < ERR 148,LT SECOND ARGUMENT IS NOT NUMERIC ! 4609: --- ! 4610: > ERR 151,LT FIRST ARGUMENT IS NOT NUMERIC ! 4611: > ERR 152,LT SECOND ARGUMENT IS NOT NUMERIC ! 4612: 11496,11497c10342,10343 ! 4613: < ERR 149,NE FIRST ARGUMENT IS NOT NUMERIC ! 4614: < ERR 150,NE SECOND ARGUMENT IS NOT NUMERIC ! 4615: --- ! 4616: > ERR 153,NE FIRST ARGUMENT IS NOT NUMERIC ! 4617: > ERR 154,NE SECOND ARGUMENT IS NOT NUMERIC ! 4618: 11510c10356 ! 4619: < ERR 151,NOTANY ARGUMENT IS NOT STRING OR EXPRESSION ! 4620: --- ! 4621: > ERR 155,NOTANY ARGUMENT IS NOT STRING OR EXPRESSION ! 4622: 11518,11519c10364,10365 ! 4623: < ERR 152,OPSYN THIRD ARGUMENT IS NOT INTEGER ! 4624: < ERR 153,OPSYN THIRD ARGUMENT IS NEGATIVE OR TOO LARGE ! 4625: --- ! 4626: > ERR 156,OPSYN THIRD ARGUMENT IS NOT INTEGER ! 4627: > ERR 157,OPSYN THIRD ARGUMENT IS NEGATIVE OR TOO LARGE ! 4628: 11523c10369 ! 4629: < ERR 154,OPSYN SECOND ARG IS NOT NATURAL VARIABLE NAME ! 4630: --- ! 4631: > ERR 158,OPSYN SECOND ARG IS NOT NATURAL VARIABLE NAME ! 4632: 11531c10377 ! 4633: < ERR 155,OPSYN FIRST ARG IS NOT NATURAL VARIABLE NAME ! 4634: --- ! 4635: > ERR 159,OPSYN FIRST ARG IS NOT NATURAL VARIABLE NAME ! 4636: 11574c10420 ! 4637: < SOPS5 ERB 156,OPSYN FIRST ARG IS NOT CORRECT OPERATOR NAME ! 4638: --- ! 4639: > SOPS5 ERB 160,OPSYN FIRST ARG IS NOT CORRECT OPERATOR NAME ! 4640: 11586c10432 ! 4641: < MOV =NUM03,WB OUTPUT FLAG ! 4642: --- ! 4643: > MOV =NUM02,WB OUTPUT FLAG ! 4644: 11588,11593c10434,10437 ! 4645: < ERR 157,OUTPUT THIRD ARGUMENT IS NOT A STRING ! 4646: < ERR 158,INAPPROPRIATE SECOND ARGUMENT FOR OUTPUT ! 4647: < ERR 159,INAPPROPRIATE FIRST ARGUMENT FOR OUTPUT ! 4648: < ERR 160,INAPPROPRIATE FILE SPECIFICATION FOR OUTPUT ! 4649: < PPM EXFAL FAIL IF FILE DOES NOT EXIST ! 4650: < ERR 161,OUTPUT FILE CANNOT BE WRITTEN TO ! 4651: --- ! 4652: > ERR 161,OUTPUT THIRD ARGUMENT (FILEPROPS) IS NOT A STRING ! 4653: > ERR 162,INAPPROPRIATE SECOND ARGUMENT (FILETAG) FOR OUTPUT ! 4654: > ERR 163,INAPPROPRIATE FIRST ARGUMENT FOR OUTPUT ! 4655: > PPM EXFAL FAIL RETURN ! 4656: 11603,11604c10447,10448 ! 4657: < ERR 162,POS ARGUMENT IS NOT INTEGER OR EXPRESSION ! 4658: < ERR 163,POS ARGUMENT IS NEGATIVE OR TOO LARGE ! 4659: --- ! 4660: > ERR 164,POS ARGUMENT IS NOT INTEGER OR EXPRESSION ! 4661: > ERR 165,POS ARGUMENT IS NEGATIVE OR TOO LARGE ! 4662: 11617a10462,10463 ! 4663: > .IF .CNBF ! 4664: > .ELSE ! 4665: 11619c10465,10466 ! 4666: < ERB 164,PROTOTYPE ARGUMENT IS NOT VALID OBJECT ! 4667: --- ! 4668: > .FI ! 4669: > ERB 166,PROTOTYPE ARGUMENT IS NOT TABLE OR ARRAY ! 4670: 11657c10504 ! 4671: < ERR 165,REMDR SECOND ARGUMENT IS NOT INTEGER ! 4672: --- ! 4673: > ERR 167,REMDR SECOND ARGUMENT IS NOT INTEGER ! 4674: 11668c10515 ! 4675: < ERB 167,REMDR CAUSED INTEGER OVERFLOW ! 4676: --- ! 4677: > ERB 168,REMDR CAUSED INTEGER OVERFLOW ! 4678: 11672c10519 ! 4679: < SRM01 ERB 166,REMDR FIRST ARGUMENT IS NOT INTEGER ! 4680: --- ! 4681: > SRM01 ERB 169,REMDR FIRST ARGUMENT IS NOT INTEGER ! 4682: 11684c10531 ! 4683: < ERR 168,REPLACE THIRD ARGUMENT IS NOT STRING ! 4684: --- ! 4685: > ERR 170,REPLACE THIRD ARGUMENT IS NOT STRING ! 4686: 11687c10534 ! 4687: < ERR 169,REPLACE SECOND ARGUMENT IS NOT STRING ! 4688: --- ! 4689: > ERR 171,REPLACE SECOND ARGUMENT IS NOT STRING ! 4690: 11749c10596 ! 4691: < ERR 170,REPLACE FIRST ARGUMENT IS NOT STRING ! 4692: --- ! 4693: > ERR 172,REPLACE FIRST ARGUMENT IS NOT STRING ! 4694: 11768c10615 ! 4695: < SRPL5 ERB 171,NULL OR UNEQUALLY LONG 2ND, 3RD ARGS TO REPLACE ! 4696: --- ! 4697: > SRPL5 ERB 173,NULL OR UNEQUALLY LONG 2ND, 3RD ARGS TO REPLACE ! 4698: 11771,11783d10617 ! 4699: < * REWIND ! 4700: < * ! 4701: < S$REW ENT ENTRY POINT ! 4702: < JSR IOFCB CALL FCBLK ROUTINE ! 4703: < ERR 172,REWIND ARGUMENT IS NOT A SUITABLE NAME ! 4704: < ERR 173,REWIND ARGUMENT IS NULL ! 4705: < JSR SYSRW CALL SYSTEM REWIND FUNCTION ! 4706: < ERR 174,REWIND FILE DOES NOT EXIST ! 4707: < ERR 175,REWIND FILE DOES NOT PERMIT REWIND ! 4708: < ERR 176,REWIND CAUSED NON-RECOVERABLE ERROR ! 4709: < BRN EXNUL EXIT WITH NULL RESULT IF NO ERROR ! 4710: < EJC ! 4711: < * ! 4712: 11788c10622 ! 4713: < ERR 177,REVERSE ARGUMENT IS NOT STRING ! 4714: --- ! 4715: > ERR 174,REVERSE ARGUMENT IS NOT STRING ! 4716: 11810c10644 ! 4717: < ERR 178,RPAD THIRD ARGUMENT IS NOT STRING ! 4718: --- ! 4719: > ERR 175,RPAD THIRD ARGUMENT IS NOT STRING ! 4720: 11814c10648 ! 4721: < ERR 179,RPAD SECOND ARGUMENT IS NOT INTEGER ! 4722: --- ! 4723: > ERR 176,RPAD SECOND ARGUMENT IS NOT INTEGER ! 4724: 11820c10654 ! 4725: < ERR 180,RPAD FIRST ARGUMENT IS NOT STRING ! 4726: --- ! 4727: > ERR 177,RPAD FIRST ARGUMENT IS NOT STRING ! 4728: 11863,11864c10697,10698 ! 4729: < ERR 181,RTAB ARGUMENT IS NOT INTEGER OR EXPRESSION ! 4730: < ERR 182,RTAB ARGUMENT IS NEGATIVE OR TOO LARGE ! 4731: --- ! 4732: > ERR 178,RTAB ARGUMENT IS NOT INTEGER OR EXPRESSION ! 4733: > ERR 179,RTAB ARGUMENT IS NEGATIVE OR TOO LARGE ! 4734: 11872c10706 ! 4735: < MOV (XS)+,R$IO2 SAVE THIRD ARG ! 4736: --- ! 4737: > MOV (XS)+,R$IOL SAVE THIRD ARG ! 4738: 11874,11876c10708,10710 ! 4739: < JSR IOFCB CALL FCBLK ROUTINE ! 4740: < ERR 291,SET FIRST ARGUMENT IS NOT A SUITABLE NAME ! 4741: < ERR 292,SET FIRST ARGUMENT IS NULL ! 4742: --- ! 4743: > JSR IOFTG CALL IOTAG ROUTINE ! 4744: > ERR 180,SET FIRST ARGUMENT IS NOT A SUITABLE NAME ! 4745: > BZE WA,EXFAL FAIL IF NO IOTAG ! 4746: 11878c10712 ! 4747: < MOV R$IO2,WC LOAD THIRD ARG ! 4748: --- ! 4749: > MOV R$IOL,WC LOAD THIRD ARG ! 4750: 11880,11885c10714,10716 ! 4751: < ERR 293,INAPPROPRIATE SECOND ARGUMENT TO SET ! 4752: < ERR 294,INAPPROPRIATE THIRD ARGUMENT TO SET ! 4753: < ERR 295,SET FILE DOES NOT EXIST ! 4754: < ERR 296,SET FILE DOES NOT PERMIT SETTING FILE POINTER ! 4755: < ERR 297,SET CAUSED NON-RECOVERABLE I/O ERROR ! 4756: < BRN EXNUL OTHERWISEW RETURN NULL ! 4757: --- ! 4758: > PPM EXFAL FAILURE RETURN ! 4759: > PPM EROSI ERROR RETURN ! 4760: > BRN EXNUL OTHERWISE RETURN NULL ! 4761: 11889,11899d10719 ! 4762: < * TAB ! 4763: < * ! 4764: < S$TAB ENT ENTRY POINT ! 4765: < MOV =P$TAB,WB SET PCODE FOR INTEGER ARG CASE ! 4766: < MOV =P$TBD,WA SET PCODE FOR EXPRESSION ARG CASE ! 4767: < JSR PATIN CALL COMMON ROUTINE TO BUILD NODE ! 4768: < ERR 183,TAB ARGUMENT IS NOT INTEGER OR EXPRESSION ! 4769: < ERR 184,TAB ARGUMENT IS NEGATIVE OR TOO LARGE ! 4770: < BRN EXIXR RETURN PATTERN NODE ! 4771: < EJC ! 4772: < * ! 4773: 11906,11907c10726,10727 ! 4774: < ERR 185,RPOS ARGUMENT IS NOT INTEGER OR EXPRESSION ! 4775: < ERR 186,RPOS ARGUMENT IS NEGATIVE OR TOO LARGE ! 4776: --- ! 4777: > ERR 181,RPOS ARGUMENT IS NOT INTEGER OR EXPRESSION ! 4778: > ERR 182,RPOS ARGUMENT IS NEGATIVE OR TOO LARGE ! 4779: 11917a10738 ! 4780: > PPM EXFAL FAIL EMPTY TABLE ! 4781: 11946c10767 ! 4782: < SSTX2 ERB 187,SETEXIT ARGUMENT IS NOT LABEL NAME OR NULL ! 4783: --- ! 4784: > SSTX2 ERB 183,SETEXIT ARGUMENT IS NOT LABEL NAME OR NULL ! 4785: 11955a10777 ! 4786: > PPM EXFAL FAIL EMPTY TABLE ! 4787: 11967c10789 ! 4788: < ERR 188,SPAN ARGUMENT IS NOT STRING OR EXPRESSION ! 4789: --- ! 4790: > ERR 184,SPAN ARGUMENT IS NOT STRING OR EXPRESSION ! 4791: 11974a10797 ! 4792: > JSR GTSTG LOAD STRING ARGUMENT ! 4793: 11981d10803 ! 4794: < .FI ! 4795: 11986c10808,10809 ! 4796: < ERR 189,SIZE ARGUMENT IS NOT STRING ! 4797: --- ! 4798: > .FI ! 4799: > ERR 185,SIZE ARGUMENT IS NOT STRING ! 4800: 11996,11997c10819,10821 ! 4801: < ERR 190,STOPTR FIRST ARGUMENT IS NOT APPROPRIATE NAME ! 4802: < ERR 191,STOPTR SECOND ARGUMENT IS NOT TRACE TYPE ! 4803: --- ! 4804: > ERR 186,STOPTR FIRST ARGUMENT IS NOT APPROPRIATE NAME ! 4805: > ERR 187,STOPTR SECOND ARGUMENT IS NOT TRACE TYPE ! 4806: > PPM EXFAL FAIL RETURN ! 4807: 12005c10829 ! 4808: < ERR 192,SUBSTR THIRD ARGUMENT IS NOT INTEGER ! 4809: --- ! 4810: > ERR 188,SUBSTR THIRD ARGUMENT IS NOT INTEGER ! 4811: 12009c10833 ! 4812: < ERR 193,SUBSTR SECOND ARGUMENT IS NOT INTEGER ! 4813: --- ! 4814: > ERR 189,SUBSTR SECOND ARGUMENT IS NOT INTEGER ! 4815: 12014a10839 ! 4816: > JSR GTSTG LOAD FIRST ARGUMENT ! 4817: 12024d10848 ! 4818: < .FI ! 4819: 12026c10850,10855 ! 4820: < ERR 194,SUBSTR FIRST ARGUMENT IS NOT STRING ! 4821: --- ! 4822: > .FI ! 4823: > ERR 190,SUBSTR FIRST ARGUMENT IS NOT STRING ! 4824: > MOV XR,XL COPY POINTER TO FIRST ARG ! 4825: > .IF .CNBF ! 4826: > MOV SBSSV,WC RELOAD THIRD ARGUMENT ! 4827: > .ELSE ! 4828: 12028c10857 ! 4829: < * MERGE WITH BFBLK OR SCBLK PTR IN XR. WA HAS LENGTH ! 4830: --- ! 4831: > * MERGE WITH BFBLK OR SCBLK IN XR, LENGTH IN WA ! 4832: 12030a10860 ! 4833: > .FI ! 4834: 12032c10862 ! 4835: < MOV WA,WC ELSE GET STRING LENGTH ! 4836: --- ! 4837: > MOV SCLEN(XL),WC ELSE GET STRING LENGTH ! 4838: 12038,12039c10868 ! 4839: < SSUB1 MOV WA,XL SAVE STRING LENGTH ! 4840: < MOV WC,WA SET LENGTH OF SUBSTRING ! 4841: --- ! 4842: > SSUB1 MOV WC,WA SET LENGTH OF SUBSTRING ! 4843: 12041,12042c10870 ! 4844: < BGT WC,XL,EXFAL JUMP IF IMPROPER SUBSTRING ! 4845: < MOV XR,XL COPY POINTER TO FIRST ARG ! 4846: --- ! 4847: > BGT WC,SCLEN(XL),EXFAL JUMP IF IMPROPER SUBSTRING ! 4848: 12046a10875,10885 ! 4849: > * TAB ! 4850: > * ! 4851: > S$TAB ENT ENTRY POINT ! 4852: > MOV =P$TAB,WB SET PCODE FOR INTEGER ARG CASE ! 4853: > MOV =P$TBD,WA SET PCODE FOR EXPRESSION ARG CASE ! 4854: > JSR PATIN CALL COMMON ROUTINE TO BUILD NODE ! 4855: > ERR 191,TAB ARGUMENT IS NOT INTEGER OR EXPRESSION ! 4856: > ERR 192,TAB ARGUMENT IS NEGATIVE OR TOO LARGE ! 4857: > BRN EXIXR RETURN PATTERN NODE ! 4858: > EJC ! 4859: > * ! 4860: 12053,12054c10892,10893 ! 4861: < ERR 195,TABLE ARGUMENT IS NOT INTEGER ! 4862: < ERR 196,TABLE ARGUMENT IS OUT OF RANGE ! 4863: --- ! 4864: > ERR 193,TABLE ARGUMENT IS NOT INTEGER ! 4865: > ERR 194,TABLE ARGUMENT IS OUT OF RANGE ! 4866: 12062c10901 ! 4867: < WTB WA CONVERT LENGTH TO BYTES ! 4868: --- ! 4869: > WTB WA CONVERT LENGTH TO BAUS ! 4870: 12101c10940 ! 4871: < STR01 ERB 197,TRACE FOURTH ARG IS NOT FUNCTION NAME OR NULL ! 4872: --- ! 4873: > STR01 ERB 195,TRACE FOURTH ARG IS NOT FUNCTION NAME OR NULL ! 4874: 12110,12111c10949,10951 ! 4875: < ERR 198,TRACE FIRST ARGUMENT IS NOT APPROPRIATE NAME ! 4876: < ERR 199,TRACE SECOND ARGUMENT IS NOT TRACE TYPE ! 4877: --- ! 4878: > ERR 196,TRACE FIRST ARGUMENT IS NOT APPROPRIATE NAME ! 4879: > ERR 197,TRACE SECOND ARGUMENT IS NOT TRACE TYPE ! 4880: > PPM UNUSED RETURN ! 4881: 12125c10965 ! 4882: < ERR 200,TRIM ARGUMENT IS NOT STRING ! 4883: --- ! 4884: > ERR 198,TRIM ARGUMENT IS NOT STRING ! 4885: 12142c10982 ! 4886: < ERR 201,UNLOAD ARGUMENT IS NOT NATURAL VARIABLE NAME ! 4887: --- ! 4888: > ERR 199,UNLOAD ARGUMENT IS NOT NATURAL VARIABLE NAME ! 4889: 12145a10986,10995 ! 4890: > EJC ! 4891: > * ! 4892: > * VDIFFER ! 4893: > * ! 4894: > S$VDF ENT ENTRY POINT ! 4895: > MOV (XS)+,XR LOAD SECOND ARGUMENT ! 4896: > MOV (XS),XL LOAD FIRST ARGUMENT ! 4897: > JSR IDENT CALL IDENT COMPARISON ROUTINE ! 4898: > PPM EXFAL FAIL IF IDENT ! 4899: > BRN EXITS RETURN FIRST ARG IF DIFFER ! 4900: 12255c11105 ! 4901: < MOV TRFPT(XR),XL GET FILE CTRL BLK PTR OR ZERO ! 4902: --- ! 4903: > MOV TRTRI(XR),XL GET TRTIO BLOCK PTR OR 0 ! 4904: 12263c11113,11121 ! 4905: < JSR SYSRD READ NEXT STANDARD INPUT IMAGE ! 4906: --- ! 4907: > BZE TTINS,ACSA5 SKIP IF NOT TERML STD INPUT ! 4908: > JSR SYSRI READ FROM TERMINAL ! 4909: > PPM ACS03 END FILE ! 4910: > PPM EROSI ERROR ! 4911: > BRN ACS07 MERGE ! 4912: > * ! 4913: > * GENUINE STD INPUT FILE ! 4914: > * ! 4915: > ACSA5 JSR SYSRD READ NEXT STANDARD INPUT IMAGE ! 4916: 12264a11123 ! 4917: > PPM EROSI ERROR RETURN ! 4918: 12269c11128,11129 ! 4919: < ACS06 MOV XL,WA FCBLK PTR ! 4920: --- ! 4921: > ACS06 MOV TRTAG(XL),WA OBTAIN IOTAG ! 4922: > BZE WA,ACS03 FAIL IF ENDFILE DONE ! 4923: 12272c11132 ! 4924: < MOV XL,WA FCBLK PTR ! 4925: --- ! 4926: > MOV TRTAG(XL),WA GET IOTAG ! 4927: 12275,12276c11135 ! 4928: < PPM ACS22 ERROR ! 4929: < PPM ACS23 ERROR ! 4930: --- ! 4931: > PPM ACS22 ERROR RETURN ! 4932: 12328c11187 ! 4933: < MTI KVABE(XR) ELSE LOAD VALUE AS INTEGER ! 4934: --- ! 4935: > MTI KVANC(XR) ELSE LOAD VALUE AS INTEGER ! 4936: 12338a11198 ! 4937: > WTB XR CONVERT TO OFFSET IN BAUS ! 4938: 12347c11207 ! 4939: < BSW XR,5 SWITCH ON KEYWORD NUMBER ! 4940: --- ! 4941: > BSW XR,6 SWITCH ON KEYWORD NUMBER ! 4942: 12349a11210 ! 4943: > IFF K$$CD,ACS23 CODE ! 4944: 12385a11247 ! 4945: > PPM EROSI ERROR RETURN ! 4946: 12388c11250 ! 4947: < * ERROR RETURNS ! 4948: --- ! 4949: > * ERROR RETURN ! 4950: 12391c11253 ! 4951: < ERB 202,INPUT FROM FILE CAUSED NON-RECOVERABLE ERROR ! 4952: --- ! 4953: > BRN EROSI GENERATE ERROR MESSAGE ! 4954: 12393,12394c11255,11258 ! 4955: < ACS23 MOV XR,DNAMP POP UNUSED SCBLK ! 4956: < ERB 203,INPUT FILE RECORD HAS INCORRECT FORMAT ! 4957: --- ! 4958: > * ACCESS CODE KEYWORD ! 4959: > * ! 4960: > ACS23 LDI KVCOD GET CODE VALUE ! 4961: > BRN ACS13 EXIT ! 4962: 12480c11344 ! 4963: < * (WA) LENGTH REQUIRED IN BYTES ! 4964: --- ! 4965: > * (WA) LENGTH REQUIRED IN BAUS ! 4966: 12514c11378 ! 4967: < WTB XR CONVERT TO BAUS (SGD05) ! 4968: --- ! 4969: > WTB XR CONVERT TO BAUS ! 4970: 12520c11384 ! 4971: < ERB 204,MEMORY OVERFLOW ! 4972: --- ! 4973: > ERB 200,MEMORY OVERFLOW ! 4974: 12528c11392 ! 4975: < BTW WB CONVERT BYTES TO WORDS ! 4976: --- ! 4977: > BTW WB CONVERT BAUS TO WORDS ! 4978: 12539c11403 ! 4979: < WTB XR CONVERT TO BAUS (SGD05) ! 4980: --- ! 4981: > WTB XR CONVERT TO BAUS ! 4982: 12561a11426,11427 ! 4983: > * (WA) 0 (INITIAL OFFSET TO BFBLK CHARS) ! 4984: > * (WB) 0 (INITIAL BCLEN) ! 4985: 12563d11428 ! 4986: < * (WA,WB) DESTROYED ! 4987: 12580c11445,11446 ! 4988: < ZER BFCHR(XL) CLEAR FIRST WORD (NULL PAD) ! 4989: --- ! 4990: > ZER WB CLEAR FOR RETURN ! 4991: > MOV WB,BFCHR(XL) CLEAR FIRST WORD (NULL PAD) ! 4992: 12581a11448 ! 4993: > ZER WA CLEAR FOR RETURN ! 4994: 12586c11453 ! 4995: < ALB01 ERB 274,REQUESTED BUFFER ALLOCATION EXCEEDS MXLEN ! 4996: --- ! 4997: > ALB01 ERB 201,REQUESTED BUFFER ALLOCATION EXCEEDS MAXLNGTH ! 4998: 12611c11478 ! 4999: < CTB WA,SCSI$ COMPUTE LENGTH OF SCBLK IN BYTES ! 5000: --- ! 5001: > CTB WA,SCSI$ COMPUTE LENGTH OF SCBLK IN BAUS ! 5002: 12634c11501 ! 5003: < ALCS2 ERB 205,STRING LENGTH EXCEEDS VALUE OF MAXLNGTH KEYWORD ! 5004: --- ! 5005: > ALCS2 ERB 202,STRING LENGTH EXCEEDS VALUE OF MAXLNGTH KEYWORD ! 5006: 12640c11507 ! 5007: < * (WA) LENGTH REQUIRED IN BYTES ! 5008: --- ! 5009: > * (WA) LENGTH REQUIRED IN BAUS ! 5010: 12676,12677d11542 ! 5011: < .IF .CNBF ! 5012: < .ELSE ! 5013: 12679,12712d11543 ! 5014: < * APNDB -- APPEND STRING TO BUFFER ! 5015: < * ! 5016: < * THIS ROUTINE IS USED BY BUFFER HANDLING ROUTINES TO ! 5017: < * APPEND DATA TO AN EXISTING BFBLK. ! 5018: < * ! 5019: < * (XR) EXISTING BCBLK TO BE APPENDED ! 5020: < * (XL) CONVERTABLE TO STRING ! 5021: < * JSR APNDB CALL TO APPEND TO BUFFER ! 5022: < * PPM LOC THREAD IF (XL) CANT BE CONVERTED ! 5023: < * PPM LOC IF NOT ENOUGH ROOM ! 5024: < * (WA,WB) DESTROYED ! 5025: < * ! 5026: < * IF MORE CHARACTERS ARE SPECIFIED THAN CAN BE INSERTED, ! 5027: < * THEN NO ACTION IS TAKEN AND THE SECOND RETURN IS TAKEN. ! 5028: < * ! 5029: < APNDB PRC E,2 ENTRY POINT ! 5030: < MOV BCLEN(XR),WA LOAD OFFSET TO INSERT ! 5031: < ZER WB REPLACE SECTION IS NULL ! 5032: < JSR INSBF CALL TO INSERT AT END ! 5033: < PPM APN01 CONVERT ERROR ! 5034: < PPM APN02 NO ROOM ! 5035: < EXI RETURN TO CALLER ! 5036: < * ! 5037: < * HERE TO TAKE CONVERT FAILURE EXIT ! 5038: < * ! 5039: < APN01 EXI 1 RETURN TO CALLER ALTERNATE ! 5040: < * ! 5041: < * HERE FOR NO FIT EXIT ! 5042: < * ! 5043: < APN02 EXI 2 ALTERNATE EXIT TO CALLER ! 5044: < ENP END PROCEDURE APNDB ! 5045: < EJC ! 5046: < .FI ! 5047: < * ! 5048: 12882c11713 ! 5049: < * HERE FOR FAILURE DURING EXPRESSION EVALUATION ! 5050: --- ! 5051: > * HERE FOR FAILURE RETURNS ! 5052: 12885d11715 ! 5053: < EXI 1 TAKE FAILURE EXIT ! 5054: 12886a11717,11718 ! 5055: > ASG3A EXI 1 TAKE FAILURE EXIT ! 5056: > * ! 5057: 12933c11765 ! 5058: < MOV TRVAL(WC),-(XS) STACK VALUE TO OUTPUT (SGD01) ! 5059: --- ! 5060: > MOV TRVAL(XR),-(XS) STACK VALUE TO OUTPUT ! 5061: 12939c11771 ! 5062: < ASG11 MOV TRFPT(XL),WA FCBLK PTR ! 5063: --- ! 5064: > ASG11 MOV TRTRI(XL),WA TRTIO BLK PTR ! 5065: 12943a11776,11779 ! 5066: > MOV WA,XL COPY TRTIO BLOCK PTR TO XL ! 5067: > MOV TRTAG(XL),WA GET IOTAG ! 5068: > BZE WA,ASG3A FAIL IF ENDFILE DONE ! 5069: > MOV SCLEN(XR),WC STRING LENGTH ! 5070: 12945,12946c11781,11782 ! 5071: < ERR 206,OUTPUT CAUSED FILE OVERFLOW ! 5072: < ERR 207,OUTPUT CAUSED NON-RECOVERABLE ERROR ! 5073: --- ! 5074: > PPM ASG3A FAIL RETURN ! 5075: > PPM EROSI ERROR RETURN ! 5076: 12954c11790 ! 5077: < * HERE TO PRINT A STRING ON THE PRINTER ! 5078: --- ! 5079: > * HERE TO PRINT A STRING ! 5080: 12956,12958c11792,11793 ! 5081: < ASG13 JSR PRTST PRINT STRING VALUE ! 5082: < BEQ TRTER(XL),=V$TER,ASG20 JUMP IF TERMINAL OUTPUT ! 5083: < JSR PRTNL END OF LINE ! 5084: --- ! 5085: > ASG13 BEQ TRTER(XL),=V$TER,ASG20 JUMP IF TERMINAL OUTPUT ! 5086: > JSR PRTSF PRINT STRING AND FLUSH BUFFER ! 5087: 12970c11805 ! 5088: < ERR 208,KEYWORD VALUE ASSIGNED IS NOT INTEGER ! 5089: --- ! 5090: > ERR 203,KEYWORD VALUE ASSIGNED IS NOT INTEGER ! 5091: 12972a11808 ! 5092: > BEQ XL,=K$COD,ASG24 JUMP IF SPECIAL CASE OF CODE ! 5093: 12981c11817 ! 5094: < ERB 209,KEYWORD IN ASSIGNMENT IS PROTECTED ! 5095: --- ! 5096: > ERB 204,KEYWORD IN ASSIGNMENT IS PROTECTED ! 5097: 12985c11821 ! 5098: < ASG15 MOV WA,KVABE(XL) STORE NEW VALUE ! 5099: --- ! 5100: > ASG15 MOV WA,KVANC(XL) STORE NEW VALUE ! 5101: 12998a11835 ! 5102: > EJC ! 5103: 12999a11837,11838 ! 5104: > * ASIGN (CONTINUED) ! 5105: > * ! 5106: 13006c11845 ! 5107: < ASG18 ERB 210,KEYWORD VALUE ASSIGNED IS NEGATIVE OR TOO LARGE ! 5108: --- ! 5109: > ASG18 ERB 205,KEYWORD VALUE ASSIGNED IS NEGATIVE OR TOO LARGE ! 5110: 13012c11851 ! 5111: < ERR 211,VALUE ASSIGNED TO KEYWORD ERRTEXT NOT A STRING ! 5112: --- ! 5113: > ERR 206,VALUE ASSIGNED TO KEYWORD ERRTEXT NOT A STRING ! 5114: 13018c11857,11858 ! 5115: < ASG20 JSR PRTTR PRINT ! 5116: --- ! 5117: > ASG20 JSR PTTST PRINT STRING TO TERMINAL ! 5118: > JSR PTTFH FLUSH TERMINAL BUFFER ! 5119: 13020d11859 ! 5120: < * ! 5121: 13029c11868 ! 5122: < ERB 268,INCONSISTENT VALUE ASSIGNED TO KEYWORD PROFILE ! 5123: --- ! 5124: > ERB 207,INCONSISTENT VALUE ASSIGNED TO KEYWORD PROFILE ! 5125: 13031c11870 ! 5126: < ASG22 MOV WA,PFDMP NOTE VALUE ON FIRST ASSIGNMENT ! 5127: --- ! 5128: > ASG22 MOV WA,PFDMP NOTE VALUE ON FIRST ASSIGNMENT ! 5129: 13035a11875,11879 ! 5130: > * ! 5131: > * HERE FOR KEYWORD ASSIGNMENT TO CODE ! 5132: > * ! 5133: > ASG24 STI KVCOD STORE VALUE ! 5134: > EXI RETURN TO CALLER ! 5135: 13093c11937 ! 5136: < * (WA) LENGTH OF BLOCK IN BYTES ! 5137: --- ! 5138: > * (WA) LENGTH OF BLOCK IN BAUS ! 5139: 13107,13111d11950 ! 5140: < .IF .CNBF ! 5141: < .ELSE ! 5142: < IFF BL$BC,BLN04 BCBLK ! 5143: < IFF BL$BF,BLN11 BFBLK ! 5144: < .FI ! 5145: 13112a11952 ! 5146: > IFF BL$CO,BLN12 COBLK ! 5147: 13131a11972,11976 ! 5148: > .IF .CNBF ! 5149: > .ELSE ! 5150: > IFF BL$BC,BLN04 BCBLK ! 5151: > IFF BL$BF,BLN11 BFBLK ! 5152: > .FI ! 5153: 13162c12007 ! 5154: < * HERE FOR FOUR WORD BLOCKS (P2,TE,BC) ! 5155: --- ! 5156: > * HERE FOR FOUR WORD BLOCKS (P2,TE) ! 5157: 13202c12047 ! 5158: < CTB WA,SCSI$ CALCULATE LENGTH IN BYTES ! 5159: --- ! 5160: > CTB WA,SCSI$ CALCULATE LENGTH IN BAUS ! 5161: 13209,13210c12054,12055 ! 5162: < BLN11 MOV BFALC(XR),WA GET ALLOCATION IN BYTES ! 5163: < CTB WA,BFSI$ CALCULATE LENGTH IN BYTES ! 5164: --- ! 5165: > BLN11 MOV BFALC(XR),WA GET ALLOCATION IN BAUS ! 5166: > CTB WA,BFSI$ CALCULATE LENGTH IN BAUS ! 5167: 13212a12058,12062 ! 5168: > * ! 5169: > * HERE FOR COBLK ! 5170: > * ! 5171: > BLN12 MOV *COSI$,WA GET SIZE IN BAUS ! 5172: > EXI RETURN TO BLKLN CALLER ! 5173: 13216c12066 ! 5174: < * COPYB -- COPY A BLOCK ! 5175: --- ! 5176: > * CBLCK -- COPY A BLOCK ! 5177: 13219c12069 ! 5178: < * JSR COPYB CALL TO COPY BLOCK ! 5179: --- ! 5180: > * JSR CBLCK CALL TO COPY BLOCK ! 5181: 13226c12076 ! 5182: < COPYB PRC N,1 ENTRY POINT ! 5183: --- ! 5184: > CBLCK PRC N,1 ENTRY POINT ! 5185: 13228c12078 ! 5186: < BEQ XR,=NULLS,COP10 RETURN ARGUMENT IF IT IS NULL ! 5187: --- ! 5188: > BEQ XR,=NULLS,CBL10 RETURN ARGUMENT IF IT IS NULL ! 5189: 13237,13239c12087,12089 ! 5190: < BEQ WB,=B$TBT,COP05 JUMP IF TABLE ! 5191: < BEQ WB,=B$VCT,COP01 JUMP IF VECTOR ! 5192: < BEQ WB,=B$PDT,COP01 JUMP IF PROGRAM DEFINED ! 5193: --- ! 5194: > BEQ WB,=B$TBT,CBL05 JUMP IF TABLE ! 5195: > BEQ WB,=B$VCT,CBL01 JUMP IF VECTOR ! 5196: > BEQ WB,=B$PDT,CBL01 JUMP IF PROGRAM DEFINED ! 5197: 13242c12092 ! 5198: < BEQ WB,=B$BCT,COP11 JUMP IF BUFFER ! 5199: --- ! 5200: > BEQ WB,=B$BCT,CBL11 JUMP IF BUFFER ! 5201: 13244c12094 ! 5202: < BNE WB,=B$ART,COP10 RETURN COPY IF NOT ARRAY ! 5203: --- ! 5204: > BNE WB,=B$ART,CBL10 RETURN COPY IF NOT ARRAY ! 5205: 13249c12099 ! 5206: < BRN COP02 JUMP TO MERGE ! 5207: --- ! 5208: > BRN CBL02 JUMP TO MERGE ! 5209: 13253c12103 ! 5210: < COP01 ADD *PDFLD,XR POINT TO PDFLD = VCVLS ! 5211: --- ! 5212: > CBL01 ADD *PDFLD,XR POINT TO PDFLD = VCVLS ! 5213: 13258c12108 ! 5214: < COP02 MOV (XR),XL LOAD NEXT POINTER ! 5215: --- ! 5216: > CBL02 MOV (XR),XL LOAD NEXT POINTER ! 5217: 13262c12112 ! 5218: < COP03 BNE (XL),=B$TRT,COP04 JUMP IF NOT TRAPPED ! 5219: --- ! 5220: > CBL03 BNE (XL),=B$TRT,CBL04 JUMP IF NOT TRAPPED ! 5221: 13264c12114 ! 5222: < BRN COP03 AND LOOP BACK ! 5223: --- ! 5224: > BRN CBL03 AND LOOP BACK ! 5225: 13267c12117 ! 5226: < * COPYB (CONTINUED) ! 5227: --- ! 5228: > * CBLCK (CONTINUED) ! 5229: 13271,13273c12121,12123 ! 5230: < COP04 MOV XL,(XR)+ STORE REAL VALUE, BUMP POINTER ! 5231: < BNE XR,DNAMP,COP02 LOOP BACK IF MORE TO GO ! 5232: < BRN COP09 ELSE JUMP TO EXIT ! 5233: --- ! 5234: > CBL04 MOV XL,(XR)+ STORE REAL VALUE, BUMP POINTER ! 5235: > BNE XR,DNAMP,CBL02 LOOP BACK IF MORE TO GO ! 5236: > BRN CBL09 ELSE JUMP TO EXIT ! 5237: 13277c12127 ! 5238: < COP05 ZER IDVAL(XR) ZERO ID TO STOP DUMP BLOWING UP ! 5239: --- ! 5240: > CBL05 ZER IDVAL(XR) ZERO ID TO STOP DUMP BLOWING UP ! 5241: 13283,13284c12133,12134 ! 5242: < COP06 MOV (XS),XR LOAD TABLE POINTER ! 5243: < BEQ WC,TBLEN(XR),COP09 JUMP TO EXIT IF ALL DONE ! 5244: --- ! 5245: > CBL06 MOV (XS),XR LOAD TABLE POINTER ! 5246: > BEQ WC,TBLEN(XR),CBL09 JUMP TO EXIT IF ALL DONE ! 5247: 13291c12141 ! 5248: < COP07 MOV TENXT(XR),XL LOAD POINTER TO NEXT TEBLK ! 5249: --- ! 5250: > CBL07 MOV TENXT(XR),XL LOAD POINTER TO NEXT TEBLK ! 5251: 13293c12143 ! 5252: < BEQ (XL),=B$TBT,COP06 BACK FOR NEXT BUCKET IF CHAIN END ! 5253: --- ! 5254: > BEQ (XL),=B$TBT,CBL06 BACK FOR NEXT BUCKET IF CHAIN END ! 5255: 13306,13307c12156,12157 ! 5256: < COP08 MOV TEVAL(XL),XL LOAD VALUE ! 5257: < BEQ (XL),=B$TRT,COP08 LOOP BACK IF TRAPPED ! 5258: --- ! 5259: > CBL08 MOV TEVAL(XL),XL LOAD VALUE ! 5260: > BEQ (XL),=B$TRT,CBL08 LOOP BACK IF TRAPPED ! 5261: 13309c12159 ! 5262: < BRN COP07 BACK FOR NEXT TEBLK ! 5263: --- ! 5264: > BRN CBL07 BACK FOR NEXT TEBLK ! 5265: 13313c12163 ! 5266: < COP09 MOV (XS)+,XR LOAD POINTER TO BLOCK ! 5267: --- ! 5268: > CBL09 MOV (XS)+,XR LOAD POINTER TO BLOCK ! 5269: 13318,13319c12168 ! 5270: < COP10 EXI 1 RETURN ! 5271: < EJC ! 5272: --- ! 5273: > CBL10 EXI 1 RETURN ! 5274: 13321a12171 ! 5275: > EJC ! 5276: 13325c12175 ! 5277: < COP11 MOV BCBUF(XR),XL GET BFBLK PTR ! 5278: --- ! 5279: > CBL11 MOV BCBUF(XR),XL GET BFBLK PTR ! 5280: 13335c12185 ! 5281: < BRN COP09 BRANCH TO EXIT ! 5282: --- ! 5283: > BRN CBL09 BRANCH TO EXIT ! 5284: 13337c12187,12188 ! 5285: < ENP END PROCEDURE COPYB ! 5286: --- ! 5287: > ENP END PROCEDURE CBLCK ! 5288: > EJC ! 5289: 13455c12306 ! 5290: < CGN01 ERB 212,SYNTAX ERROR. VALUE USED WHERE NAME IS REQUIRED ! 5291: --- ! 5292: > CGN01 ERB 208,SYNTAX ERROR. VALUE USED WHERE NAME IS REQUIRED ! 5293: 13586,13592d12436 ! 5294: < BNZ VRLEN(XR),CGVL0 JUMP IF NOT SYSTEM VARIABLE ! 5295: < MOV XR,-(XS) STACK XR ! 5296: < MOV VRSVP(XR),XR POINT TO SVBLK ! 5297: < MOV SVBIT(XR),WA GET SVBLK PROPERTY BITS ! 5298: < MOV (XS)+,XR RECOVER XR ! 5299: < ANB BTCKW,WA CHECK IF CONSTANT KEYWORD ! 5300: < NZB WA,CGV00 JUMP IF CONSTANT KEYWORD ! 5301: 13616,13617c12460 ! 5302: < * PREPARE TO GENERATE CODE FOR CMBLK. WC IS SET TO THE ! 5303: < * VALUE OF CSWNO (ZERO IF -OPTIMISE, 1 IF -NOOPT) TO ! 5304: --- ! 5305: > * PREPARE TO GENERATE CODE FOR CMBLK. WC IS CLEARED TO ! 5306: 13624c12467 ! 5307: < MOV CSWNO,WC RESET CONSTANT FLAG ! 5308: --- ! 5309: > ZER WC CLEAR OPTIMISE FLAG ! 5310: 13644d12486 ! 5311: < IFF C$CNP,CGV24 CONCATENATION (NOT PATTERN MATCH) ! 5312: 13645a12488 ! 5313: > IFF C$CNP,CGV24 CONCAT. NOT PATTERN ! 5314: 13688,13689c12531,12532 ! 5315: < CGV07 SUB *CMVLS,WB GET NUMBER OF ARG PTRS (BYTES) ! 5316: < BTW WB CONVERT BYTES TO WORDS ! 5317: --- ! 5318: > CGV07 SUB *CMVLS,WB GET NUMBER OF ARG PTRS (BAUS) ! 5319: > BTW WB CONVERT BAUS TO WORDS ! 5320: 13968c12811 ! 5321: < WTB XR CONVERT WORD OFFSET TO BYTES ! 5322: --- ! 5323: > WTB XR CONVERT WORD OFFSET TO BAUS ! 5324: 14105c12948 ! 5325: < CDWD5 ERB 213,SYNTAX ERROR. STATEMENT IS TOO COMPLICATED. ! 5326: --- ! 5327: > CDWD5 ERB 209,SYNTAX ERROR. STATEMENT IS TOO COMPLICATED. ! 5328: 14258,14260c13101,13107 ! 5329: < BNE STAGE,=STGIC,CMP02 SKIP UNLESS INITIAL COMPILE ! 5330: < JSR READR READ NEXT INPUT IMAGE ! 5331: < BZE XR,CMP09 JUMP IF NO INPUT AVAILABLE ! 5332: --- ! 5333: > BEQ STAGE,=STGIC,CMPC1 READ IF INITIAL COMPILE ! 5334: > BZE R$COP,CMP02 ELSE SKIP IF NO -COPY IN FORCE ! 5335: > * ! 5336: > * HERE TO ATTEMPT READ (STGIC OR -COPY) ! 5337: > * ! 5338: > CMPC1 JSR READR READ NEXT INPUT IMAGE ! 5339: > BZE XR,CMPC2 JUMP IF NO INPUT AVAILABLE ! 5340: 14265a13113,13119 ! 5341: > * HERE IF READR HAD NOTHING TO RETURN. IF NOT DURING ! 5342: > * INITIAL COMPILE, THEN MUST BE AT OUTER LEVEL OF -COPY ! 5343: > * IN CODE(). R$CIM HAS BEEN RESTORED TO CODE STRING ! 5344: > * BY COPND SO WE CONTINUE FROM THE -COPY STMT. ! 5345: > * ! 5346: > CMPC2 BEQ STAGE,=STGIC,CMP09 JUMP IF INITIAL COMPILE ! 5347: > * ! 5348: 14296c13150 ! 5349: < BEQ WC,=CH$MN,CMP32 JUMP IF CONTROL CARD ! 5350: --- ! 5351: > BEQ WC,=CH$MN,CMP33 JUMP IF CONTROL CARD ! 5352: 14324c13178 ! 5353: < ERB 214,BAD LABEL OR MISPLACED CONTINUATION LINE ! 5354: --- ! 5355: > ERB 210,BAD LABEL OR MISPLACED CONTINUATION LINE ! 5356: 14363c13217 ! 5357: < BEQ XL,=T$SMC,CMP10 JUMP IF END OF IMAGE ! 5358: --- ! 5359: > BEQ XL,=T$SMC,CMPEE JUMP IF END OF IMAGE ! 5360: 14371c13225 ! 5361: < BEQ XL,=T$SMC,CMP10 JUMP IF OK (END OF IMAGE) ! 5362: --- ! 5363: > BEQ XL,=T$SMC,CMPEE JUMP IF OK (END OF IMAGE) ! 5364: 14375c13229 ! 5365: < CMP08 ERB 215,SYNTAX ERROR. UNDEFINED OR ERRONEOUS ENTRY LABEL ! 5366: --- ! 5367: > CMP08 ERB 211,SYNTAX ERROR. UNDEFINED OR ERRONEOUS ENTRY LABEL ! 5368: 14380,14381c13234,13235 ! 5369: < BEQ STAGE,=STGXE,CMP10 JUMP IF CODE CALL (OK) ! 5370: < ERB 216,SYNTAX ERROR. MISSING END LINE ! 5371: --- ! 5372: > BEQ STAGE,=STGXE,CMPEE JUMP IF CODE CALL (OK) ! 5373: > ERB 212,SYNTAX ERROR. MISSING END LINE ! 5374: 14385c13239 ! 5375: < CMP10 MOV =OSTP$,WA SET STOP CALL POINTER ! 5376: --- ! 5377: > CMPEE MOV =OSTP$,WA SET STOP CALL POINTER ! 5378: 14397c13251 ! 5379: < ERB 217,SYNTAX ERROR. DUPLICATE LABEL ! 5380: --- ! 5381: > ERB 213,SYNTAX ERROR. DUPLICATE LABEL ! 5382: 14414c13268 ! 5383: < BEQ XL,=T$SMC,CMP31 JUMP IF NO FIELDS LEFT ! 5384: --- ! 5385: > BEQ XL,=T$SMC,CMP32 JUMP IF NO FIELDS LEFT ! 5386: 14450c13304 ! 5387: < CMP17 ERB 218,SYNTAX ERROR. DUPLICATED GOTO FIELD ! 5388: --- ! 5389: > CMP17 ERB 214,SYNTAX ERROR. DUPLICATED GOTO FIELD ! 5390: 14599d13452 ! 5391: < EXI AND RETURN TO CMPIL CALLER ! 5392: 14600a13454,13459 ! 5393: > * LOOP TO UNNEST ANY OUTSTANDING -COPY LEVELS ! 5394: > * ! 5395: > CMP31 JSR COPND CALL TO UNNEST -COPY ! 5396: > BNZ R$COP,CMP31 LOOP IF NOT ALL -COPYS CLOSED ! 5397: > EXI RETURN TO CMPIL CALLER ! 5398: > * ! 5399: 14603c13462 ! 5400: < CMP31 MOV CMFGO(XS),WB GET FAIL GOTO ! 5401: --- ! 5402: > CMP32 MOV CMFGO(XS),WB GET FAIL GOTO ! 5403: 14606c13465 ! 5404: < ERB 219,SYNTAX ERROR. EMPTY GOTO FIELD ! 5405: --- ! 5406: > ERB 215,SYNTAX ERROR. EMPTY GOTO FIELD ! 5407: 14610c13469 ! 5408: < CMP32 ICV WB POINT PAST CH$MN ! 5409: --- ! 5410: > CMP33 ICV WB POINT PAST CH$MN ! 5411: 14634c13493 ! 5412: < CNC01 BGE SCNPT,SCNIL,CNC09 RETURN IF END OF IMAGE ! 5413: --- ! 5414: > CNC01 BGE SCNPT,SCNIL,CNC10 RETURN IF END OF IMAGE ! 5415: 14638,14640d13496 ! 5416: < .IF .CULC ! 5417: < FLC WA FOLD TO UPPER CASE ! 5418: < .FI ! 5419: 14641a13498,13500 ! 5420: > .IF .CASL ! 5421: > BEQ WA,=CH$$I,CNC07 DITTO (LC) ! 5422: > .FI ! 5423: 14649a13509,13511 ! 5424: > .IF .CASL ! 5425: > JSR SBSCC CONVERT CASE BEFORE COMPARISON ! 5426: > .ELSE ! 5427: 14651,14653d13512 ! 5428: < .IF .CULC ! 5429: < MOV SCLEN(XR),WA RELOAD LENGTH ! 5430: < JSR FLSTG FOLD TO UPPER CASE ! 5431: 14658c13517 ! 5432: < LCT WC,=CC$NC NUMBER OF STANDARD NAMES ! 5433: --- ! 5434: > LCT WC,=CC$CT NUMBER OF STANDARD NAMES ! 5435: 14682,14684c13541,13543 ! 5436: < BSW XL,CC$NC SWITCH ! 5437: < .IF .CULC ! 5438: < IFF CC$CA,CNC37 -CASE ! 5439: --- ! 5440: > BSW XL,CC$CT SWITCH ! 5441: > .IF .CASL ! 5442: > IFF CC$CI,CNC11 -CASEIG ! 5443: 14686,14687c13545 ! 5444: < IFF CC$DO,CNC10 -DOUBLE ! 5445: < IFF CC$DU,CNC11 -DUMP ! 5446: --- ! 5447: > IFF CC$CO,CNC23 -COPY ! 5448: 14689,14705c13547,13556 ! 5449: < IFF CC$ER,CNC13 -ERRORS ! 5450: < IFF CC$EX,CNC14 -EXECUTE ! 5451: < IFF CC$FA,CNC15 -FAIL ! 5452: < IFF CC$LI,CNC16 -LIST ! 5453: < IFF CC$NR,CNC17 -NOERRORS ! 5454: < IFF CC$NX,CNC18 -NOEXECUTE ! 5455: < IFF CC$NF,CNC19 -NOFAIL ! 5456: < IFF CC$NL,CNC20 -NOLIST ! 5457: < IFF CC$NO,CNC21 -NOOPT ! 5458: < IFF CC$NP,CNC22 -NOPRINT ! 5459: < IFF CC$OP,CNC24 -OPTIMISE ! 5460: < IFF CC$PR,CNC25 -PRINT ! 5461: < IFF CC$SI,CNC27 -SINGLE ! 5462: < IFF CC$SP,CNC28 -SPACE ! 5463: < IFF CC$ST,CNC31 -STITLE ! 5464: < IFF CC$TI,CNC32 -TITLE ! 5465: < IFF CC$TR,CNC36 -TRACE ! 5466: --- ! 5467: > IFF CC$FA,CNC13 -FAIL ! 5468: > IFF CC$LI,CNC14 -LIST ! 5469: > .IF .CASL ! 5470: > IFF CC$NC,CNC15 -NOCASEIG ! 5471: > .FI ! 5472: > IFF CC$NF,CNC16 -NOFAIL ! 5473: > IFF CC$NL,CNC17 -NOLIST ! 5474: > IFF CC$ST,CNC18 -STITLE ! 5475: > IFF CC$TI,CNC19 -TITLE ! 5476: > IFF CC$TR,CNC22 -TRACE ! 5477: 14717c13568 ! 5478: < CNC06 ERB 247,INVALID CONTROL CARD ! 5479: --- ! 5480: > CNC06 ERB 216,INVALID CONTROL CARD ! 5481: 14722,14723c13573,13574 ! 5482: < .IF .CULC ! 5483: < FLC WA FOLD TO UPPER CASE ! 5484: --- ! 5485: > .IF .CASL ! 5486: > BEQ WA,=CH$$N,CNC08 SKIP IF LC N ! 5487: 14725a13577,13579 ! 5488: > .IF .CASL ! 5489: > CNC08 ADD =NUM02,SCNPT BUMP OFFSET PAST -IN ! 5490: > .ELSE ! 5491: 14726a13581 ! 5492: > .FI ! 5493: 14739c13594 ! 5494: < CNC08 MOV SCNPT,WA PRESERVE IN CASE XEQ TIME COMPILE ! 5495: --- ! 5496: > CNC09 MOV SCNPT,WA PRESERVE IN CASE XEQ TIME COMPILE ! 5497: 14746c13601,13602 ! 5498: < CNC09 EXI RETURN ! 5499: --- ! 5500: > CNC10 EXI RETURN ! 5501: > .IF .CASL ! 5502: 14748c13604 ! 5503: < * -DOUBLE ! 5504: --- ! 5505: > * -CASEIG ! 5506: 14750,14751c13606,13608 ! 5507: < CNC10 MNZ CSWDB SET SWITCH ! 5508: < BRN CNC08 MERGE ! 5509: --- ! 5510: > CNC11 MNZ CSWCI SET SWITCH ! 5511: > BRN CNC09 MERGE ! 5512: > .FI ! 5513: 14753,14759d13609 ! 5514: < * -DUMP ! 5515: < * THIS IS USED FOR SYSTEM DEBUGGING . IT HAS THE EFFECT OF ! 5516: < * PRODUCING A CORE DUMP AT COMPILATION TIME ! 5517: < * ! 5518: < CNC11 JSR SYSDM CALL DUMPER ! 5519: < BRN CNC09 FINISHED ! 5520: < * ! 5521: 14762c13612 ! 5522: < CNC12 BZE CSWLS,CNC09 RETURN IF -NOLIST ! 5523: --- ! 5524: > CNC12 BZE CSWLS,CNC10 RETURN IF -NOLIST ! 5525: 14765c13615 ! 5526: < BRN CNC09 FINISHED ! 5527: --- ! 5528: > BRN CNC10 FINISHED ! 5529: 14767,14776d13616 ! 5530: < * -ERRORS ! 5531: < * ! 5532: < CNC13 ZER CSWER CLEAR SWITCH ! 5533: < BRN CNC08 MERGE ! 5534: < * ! 5535: < * -EXECUTE ! 5536: < * ! 5537: < CNC14 ZER CSWEX CLEAR SWITCH ! 5538: < BRN CNC08 MERGE ! 5539: < * ! 5540: 14779,14780c13619,13620 ! 5541: < CNC15 MNZ CSWFL SET SWITCH ! 5542: < BRN CNC08 MERGE ! 5543: --- ! 5544: > CNC13 MNZ CSWFL SET SWITCH ! 5545: > BRN CNC09 MERGE ! 5546: 14784,14785c13624,13626 ! 5547: < CNC16 MNZ CSWLS SET SWITCH ! 5548: < BEQ STAGE,=STGIC,CNC08 DONE IF COMPILE TIME ! 5549: --- ! 5550: > CNC14 MNZ CSWLS SET SWITCH ! 5551: > BRN CNC09 MERGE ! 5552: > .IF .CASL ! 5553: 14787c13628 ! 5554: < * LIST CODE LINE IF EXECUTE TIME COMPILE ! 5555: --- ! 5556: > * -NOCASEIG ! 5557: 14789,14792c13630,13632 ! 5558: < ZER LSTPF PERMIT LISTING ! 5559: < JSR LISTR LIST LINE ! 5560: < BRN CNC08 MERGE ! 5561: < EJC ! 5562: --- ! 5563: > CNC15 ZER CSWCI CLEAR SWITCH ! 5564: > BRN CNC09 MERGE ! 5565: > .FI ! 5566: 14794,14805d13633 ! 5567: < * CNCRD (CONTINUED) ! 5568: < * ! 5569: < * -NOERRORS ! 5570: < * ! 5571: < CNC17 MNZ CSWER SET SWITCH ! 5572: < BRN CNC08 MERGE ! 5573: < * ! 5574: < * -NOEXECUTE ! 5575: < * ! 5576: < CNC18 MNZ CSWEX SET SWITCH ! 5577: < BRN CNC08 MERGE ! 5578: < * ! 5579: 14808,14834c13636,13637 ! 5580: < CNC19 ZER CSWFL CLEAR SWITCH ! 5581: < BRN CNC08 MERGE ! 5582: < * ! 5583: < * -NOLIST ! 5584: < * ! 5585: < CNC20 ZER CSWLS CLEAR SWITCH ! 5586: < BRN CNC08 MERGE ! 5587: < * ! 5588: < * -NOOPTIMISE ! 5589: < * ! 5590: < CNC21 MNZ CSWNO SET SWITCH ! 5591: < BRN CNC08 MERGE ! 5592: < * ! 5593: < * -NOPRINT ! 5594: < * ! 5595: < CNC22 ZER CSWPR CLEAR SWITCH ! 5596: < BRN CNC08 MERGE ! 5597: < * ! 5598: < * -OPTIMISE ! 5599: < * ! 5600: < CNC24 ZER CSWNO CLEAR SWITCH ! 5601: < BRN CNC08 MERGE ! 5602: < * ! 5603: < * -PRINT ! 5604: < * ! 5605: < CNC25 MNZ CSWPR SET SWITCH ! 5606: < BRN CNC08 MERGE ! 5607: --- ! 5608: > CNC16 ZER CSWFL CLEAR SWITCH ! 5609: > BRN CNC09 MERGE ! 5610: 14839c13642 ! 5611: < * -SINGLE ! 5612: --- ! 5613: > * -NOLIST ! 5614: 14841,14863c13644 ! 5615: < CNC27 ZER CSWDB CLEAR SWITCH ! 5616: < BRN CNC08 MERGE ! 5617: < * ! 5618: < * -SPACE ! 5619: < * ! 5620: < CNC28 BZE CSWLS,CNC09 RETURN IF -NOLIST ! 5621: < JSR SCANE SCAN INTEGER AFTER -SPACE ! 5622: < MOV =NUM01,WC 1 SPACE IN CASE ! 5623: < BEQ XR,=T$SMC,CNC29 JUMP IF NO INTEGER ! 5624: < MOV XR,-(XS) STACK IT ! 5625: < JSR GTSMI CHECK INTEGER ! 5626: < PPM CNC06 FAIL IF NOT INTEGER ! 5627: < PPM CNC06 FAIL IF NEGATIVE OR LARGE ! 5628: < BNZ WC,CNC29 JUMP IF NON ZERO ! 5629: < MOV =NUM01,WC ELSE 1 SPACE ! 5630: < * ! 5631: < * MERGE WITH COUNT OF LINES TO SKIP ! 5632: < * ! 5633: < CNC29 ADD WC,LSTLC BUMP LINE COUNT ! 5634: < LCT WC,WC CONVERT TO LOOP COUNTER ! 5635: < BLT LSTLC,LSTNP,CNC30 JUMP IF FITS ON PAGE ! 5636: < JSR PRTPS EJECT ! 5637: < JSR LISTT LIST TITLE ! 5638: --- ! 5639: > CNC17 ZER CSWLS CLEAR SWITCH ! 5640: 14866,14874d13646 ! 5641: < * SKIP LINES ! 5642: < * ! 5643: < CNC30 JSR PRTNL PRINT A BLANK ! 5644: < BCT WC,CNC30 LOOP ! 5645: < BRN CNC09 MERGE ! 5646: < EJC ! 5647: < * ! 5648: < * CNCRD (CONTINUED) ! 5649: < * ! 5650: 14877,14878c13649,13650 ! 5651: < CNC31 MOV =R$STL,CNR$T PTR TO R$STL ! 5652: < BRN CNC33 MERGE ! 5653: --- ! 5654: > CNC18 MOV =R$STL,CNR$T PTR TO R$STL ! 5655: > BRN CNC20 MERGE ! 5656: 14882c13654 ! 5657: < CNC32 MOV =NULLS,R$STL CLEAR SUBTITLE ! 5658: --- ! 5659: > CNC19 MOV =NULLS,R$STL CLEAR SUBTITLE ! 5660: 14887c13659 ! 5661: < CNC33 MOV =NULLS,XR NULL IN CASE NEEDED ! 5662: --- ! 5663: > CNC20 MOV =NULLS,XR NULL IN CASE NEEDED ! 5664: 14891c13663 ! 5665: < BLO WA,WB,CNC34 JUMP IF NO CHARS LEFT ! 5666: --- ! 5667: > BLO WA,WB,CNC21 JUMP IF NO CHARS LEFT ! 5668: 14898c13670 ! 5669: < CNC34 MOV CNR$T,XL POINT TO STORAGE LOCATION ! 5670: --- ! 5671: > CNC21 MOV CNR$T,XL POINT TO STORAGE LOCATION ! 5672: 14900,14908c13672 ! 5673: < BEQ XL,=R$STL,CNC09 RETURN IF STITL ! 5674: < BNZ PRECL,CNC09 RETURN IF EXTENDED LISTING ! 5675: < BZE PRICH,CNC09 RETURN IF REGULAR PRINTER ! 5676: < MOV SCLEN(XR),XL GET LENGTH OF TITLE ! 5677: < MOV XL,WA COPY IT ! 5678: < BZE XL,CNC35 JUMP IF NULL ! 5679: < ADD =NUM10,XL INCREMENT ! 5680: < BHI XL,PRLEN,CNC09 USE DEFAULT LSTP0 VAL IF TOO LONG ! 5681: < ADD =NUM04,WA POINT JUST PAST TITLE ! 5682: --- ! 5683: > BRN CNC10 RETURN ! 5684: 14910,14914d13673 ! 5685: < * STORE OFFSET TO PAGE NN MESSAGE FOR SHORT TITLE ! 5686: < * ! 5687: < CNC35 MOV WA,LSTPO STORE OFFSET ! 5688: < BRN CNC09 RETURN ! 5689: < * ! 5690: 14915a13675 ! 5691: > * ! 5692: 14919,14921c13679,13680 ! 5693: < CNC36 JSR SYSTT TOGGLE SWITCH ! 5694: < BRN CNC08 MERGE ! 5695: < .IF .CULC ! 5696: --- ! 5697: > CNC22 JSR SYSTT TOGGLE SWITCH ! 5698: > BRN CNC09 MERGE ! 5699: 14923,14925c13682 ! 5700: < * -CASE ! 5701: < * SETS VALUE OF KVCAS SO THAT NAMES ARE FOLDED OR NOT ! 5702: < * DURING COMPILATION. ! 5703: --- ! 5704: > * -COPY ! 5705: 14927,14936c13684,13708 ! 5706: < CNC37 JSR SCANE SCAN INTEGER AFTER -CASE ! 5707: < ZER WC GET 0 IN CASE NONE THERE ! 5708: < BEQ XL,=T$SMC,CNC38 SKIP IF NO INTEGER ! 5709: < MOV XR,-(XS) STACK IT ! 5710: < JSR GTSMI CHECK INTEGER ! 5711: < PPM CNC06 FAIL IF NOT INTEGER ! 5712: < PPM CNC06 FAIL IF NEGATIVE OR TOO LARGE ! 5713: < CNC38 MOV WC,KVCAS STORE NEW CASE VALUE ! 5714: < BRN CNC09 MERGE ! 5715: < .FI ! 5716: --- ! 5717: > * GET FILETAG AND NOTIFY OSINT THAT WE ARE NESTING ! 5718: > * ! 5719: > CNC23 JSR SCANE GET FILETAG ! 5720: > BNE =T$CON,XL,CNC06 ERR IF NOT CONSTANT ! 5721: > BNE =B$SCL,(XR),CNC06 ERR IF NOT SCBLK ! 5722: > JSR SYSSC CALL TO START COPY ! 5723: > ERR 258,COPY FILE DOES NOT EXIST ! 5724: > PPM EROSI ERROR RETURN (ALWAYS) ! 5725: > MOV WA,WB SAVE IOTAG FROM OSINT ! 5726: > MOV *COSI$,WA GET SIZE OF COPY BLOCK ! 5727: > JSR ALLOC ALLOCATE ! 5728: > MOV =B$COP,COTYP(XR) SET TYPE ! 5729: > MOV R$COP,CONXT(XR) PLACE AT FRONT OF STACK CHN ! 5730: > MOV XR,R$COP SPLICE IT IN ! 5731: > MOV WB,COIOT(XR) SAVE OSINT IOTAG ! 5732: > MOV TTINS,COTTI(XR) SAVE TTINS ! 5733: > ZER TTINS INPUT NOT FROM TERMINAL NOW ! 5734: > MOV R$CIM,COCIM(XR) SAVE R$CIM IN CASE EXEC TIME ! 5735: > MOV SCNPT,COSPT(XR) SAVE SCNPT IN CASE EXEC TIME ! 5736: > MOV CSWLS,COSLS(XR) SAVE LIST FLAG ! 5737: > MOV CSWIN,COSIN(XR) SAVE -INXXX VALUE ! 5738: > MOV R$STL,COSTL(XR) SAVE SUBTITLE ! 5739: > BZE CSWLS,CNC10 NO LIST -COPY IF -NOLIST ! 5740: > JSR LISTR LIST -COPY CARD ! 5741: > BRN CNC10 EXIT ! 5742: 14939a13712,13750 ! 5743: > * COPND -- END -COPY NESTING ! 5744: > * ! 5745: > * COPND IS CALLED FROM CMPIL AND READR IN ORDER TO ! 5746: > * UNNEST ONE LEVEL OF -COPY AND RESTORE THE PREVIOUS ! 5747: > * INPUT COMPILE STRING. THE COPY BLOCK IS REMOVED ! 5748: > * FROM THE CHAIN AND THE STATE RESTORED FROM IT. ! 5749: > * ! 5750: > * JSR COPND CALL TO END -COPY AT CUR. LEVEL ! 5751: > * (XL,WA,WB,WC) DESTROYED ! 5752: > * ! 5753: > COPND PRC E,0 ENTRY POINT ! 5754: > MOV R$COP,XL GET POINTER TO CURRENT COBLK ! 5755: > BZE XL,COP02 EXIT IF NONE ! 5756: > MOV CONXT(XL),R$COP TAKE OFF CHAIN ! 5757: > MOV COIOT(XL),WA GET IOTAG FOR OSINT ! 5758: > JSR SYSEC CALL TO END COPY ! 5759: > PPM DO NOT USE ! 5760: > PPM EROSI ERROR EXIT ! 5761: > BZE CSWLS,COP01 SKIP LISTING IF -NOLIST ! 5762: > JSR LISTR LIST CURRENT IMAGE ! 5763: > * ! 5764: > * MERGE AFTER POSSIBLE LISTING OF CURRENT IMAGE ! 5765: > * ! 5766: > COP01 MOV COTTI(XL),TTINS RESTORE TERMINAL INPUT FLAG ! 5767: > MOV COSLS(XL),CSWLS RESTORE LISTING STATE ! 5768: > MOV COSPT(XL),SCNPT GET OLD SCAN POINTER ! 5769: > MOV COSIN(XL),CSWIN OLD INPUT IMAGE LENGTH ! 5770: > MOV COSTL(XL),R$STL RESTORE SUBTITLE STRING ! 5771: > MNZ LSTPF THIS IMAGE LISTED IN CNCRD ! 5772: > MOV COCIM(XL),XL GET OLD COMPILER IMAGE SCBLK ! 5773: > MOV XL,R$CIM RESTORE IT ! 5774: > MOV SCLEN(XL),SCNIL SET INPUT IMAGE LENGTH TOO ! 5775: > * ! 5776: > * MERGE TO EXIT ! 5777: > * ! 5778: > COP02 EXI RETURN TO CALLER ! 5779: > ENP END PROCEDURE COPND ! 5780: > EJC ! 5781: > * ! 5782: 14950a13762,13763 ! 5783: > .IF .CNLD ! 5784: > .ELSE ! 5785: 14957,14958d13769 ! 5786: < .IF .CNLD ! 5787: < .ELSE ! 5788: 14966d13776 ! 5789: < .FI ! 5790: 14970a13781 ! 5791: > .FI ! 5792: 14981c13792 ! 5793: < ERB 248,ATTEMPTED REDEFINITION OF SYSTEM FUNCTION ! 5794: --- ! 5795: > ERB 217,ATTEMPTED REDEFINITION OF SYSTEM FUNCTION ! 5796: 14991,15058d13801 ! 5797: < * DTACH -- DETACH I/O ASSOCIATED NAMES ! 5798: < * ! 5799: < * DETACHES TRBLKS FROM I/O ASSOCIATED VARIABLES, REMOVES ! 5800: < * ENTRY FROM IOCHN CHAIN ATTACHED TO FILEARG1 VRBLK AND MAY ! 5801: < * REMOVE VRBLK ACCESS AND STORE TRAPS. ! 5802: < * INPUT, OUTPUT, TERMINAL ARE HANDLED SPECIALLY. ! 5803: < * ! 5804: < * (XL) I/O ASSOC. VBL NAME BASE PTR ! 5805: < * (WA) OFFSET TO NAME ! 5806: < * JSR DTACH CALL FOR DETACH OPERATION ! 5807: < * (XL,XR,WA,WB,WC) DESTROYED ! 5808: < * ! 5809: < DTACH PRC E,0 ENTRY POINT ! 5810: < MOV XL,DTCNB STORE NAME BASE (GBCOL NOT CALLED) ! 5811: < ADD WA,XL POINT TO NAME LOCATION ! 5812: < MOV XL,DTCNM STORE IT ! 5813: < * ! 5814: < * LOOP TO SEARCH FOR I/O TRBLK ! 5815: < * ! 5816: < DTCH1 MOV XL,XR COPY NAME POINTER ! 5817: < * ! 5818: < * CONTINUE AFTER BLOCK DELETION ! 5819: < * ! 5820: < DTCH2 MOV (XL),XL POINT TO NEXT VALUE ! 5821: < BNE (XL),=B$TRT,DTCH6 JUMP AT CHAIN END ! 5822: < MOV TRTYP(XL),WA GET TRAP BLOCK TYPE ! 5823: < BEQ WA,=TRTIN,DTCH3 JUMP IF INPUT ! 5824: < BEQ WA,=TRTOU,DTCH3 JUMP IF OUTPUT ! 5825: < ADD *TRNXT,XL POINT TO NEXT LINK ! 5826: < BRN DTCH1 LOOP ! 5827: < * ! 5828: < * DELETE AN OLD ASSOCIATION ! 5829: < * ! 5830: < DTCH3 MOV TRVAL(XL),(XR) DELETE TRBLK ! 5831: < MOV XL,WA DUMP XL ... ! 5832: < MOV XR,WB ... AND XR ! 5833: < MOV TRTRF(XL),XL POINT TO TRTRF TRAP BLOCK ! 5834: < BZE XL,DTCH5 JUMP IF NO IOCHN ! 5835: < BNE (XL),=B$TRT,DTCH5 JUMP IF INPUT, OUTPUT, TERMINAL ! 5836: < * ! 5837: < * LOOP TO SEARCH IOCHN CHAIN FOR NAME PTR ! 5838: < * ! 5839: < DTCH4 MOV XL,XR REMEMBER LINK PTR ! 5840: < MOV TRTRF(XL),XL POINT TO NEXT LINK ! 5841: < BZE XL,DTCH5 JUMP IF END OF CHAIN ! 5842: < MOV IONMB(XL),WC GET NAME BASE ! 5843: < ADD IONMO(XL),WC ADD OFFSET ! 5844: < BNE WC,DTCNM,DTCH4 LOOP IF NO MATCH ! 5845: < MOV TRTRF(XL),TRTRF(XR) REMOVE NAME FROM CHAIN ! 5846: < EJC ! 5847: < * ! 5848: < * DTACH (CONTINUED) ! 5849: < * ! 5850: < * PREPARE TO RESUME I/O TRBLK SCAN ! 5851: < * ! 5852: < DTCH5 MOV WA,XL RECOVER XL ... ! 5853: < MOV WB,XR ... AND XR ! 5854: < ADD *TRVAL,XL POINT TO VALUE FIELD ! 5855: < BRN DTCH2 CONTINUE ! 5856: < * ! 5857: < * EXIT POINT ! 5858: < * ! 5859: < DTCH6 MOV DTCNB,XR POSSIBLE VRBLK PTR ! 5860: < JSR SETVR RESET VRBLK IF NECESSARY ! 5861: < EXI RETURN ! 5862: < ENP END PROCEDURE DTACH ! 5863: < EJC ! 5864: < * ! 5865: 15069c13812 ! 5866: < WTB XR CONVERT TO BYTE OFFSET ! 5867: --- ! 5868: > WTB XR CONVERT TO BAU OFFSET ! 5869: 15092,15093c13835 ! 5870: < * DMARG EQ 2 FULL DUMP (INCL ARRAYS ETC.) ! 5871: < * DMARG GE 3 CORE DUMP ! 5872: --- ! 5873: > * DMARG GE 2 FULL DUMP (INCL ARRAYS ETC.) ! 5874: 15101d13842 ! 5875: < BGT XR,=NUM02,DMP29 JUMP IF CORE DUMP REQUIRED ! 5876: 15108,15110c13849 ! 5877: < JSR PRTST PRINT IT ! 5878: < JSR PRTNL TERMINATE PRINT LINE ! 5879: < JSR PRTNL AND PRINT A BLANK LINE ! 5880: --- ! 5881: > JSR PRTFB PRINT IT ! 5882: 15227,15228c13966,13967 ! 5883: < DMP11 JSR PRTNL PRINT BLANK LINE ! 5884: < JSR PRTNL AND ANOTHER ! 5885: --- ! 5886: > DMP11 JSR PRTFH PRINT BLANK LINE ! 5887: > JSR PRTFH AND ANOTHER ! 5888: 15230,15232c13969 ! 5889: < JSR PRTST PRINT HEADING ! 5890: < JSR PRTNL END LINE ! 5891: < JSR PRTNL PRINT ONE BLANK LINE ! 5892: --- ! 5893: > JSR PRTFB PRINT HEADING ! 5894: 15256,15257c13993 ! 5895: < JSR PRTVL PRINT KEYWORD VALUE ! 5896: < JSR PRTNL TERMINATE PRINT LINE ! 5897: --- ! 5898: > JSR PRTVF PRINT KEYWORD VALUE ! 5899: 15276c14012 ! 5900: < BEQ WA,=B$BCT,DMP30 JUMP IF BUFFER ! 5901: --- ! 5902: > BEQ WA,=B$BCT,DMP29 JUMP IF BUFFER ! 5903: 15310c14046 ! 5904: < JSR PRTNL PRINT BLANK LINE ! 5905: --- ! 5906: > JSR PRTFH PRINT BLANK LINE ! 5907: 15312c14048 ! 5908: < JSR PRTVL PRINT BLOCK VALUE (FOR TITLE) ! 5909: --- ! 5910: > JSR PRTVF PRINT BLOCK VALUE (FOR TITLE) ! 5911: 15314d14049 ! 5912: < JSR PRTNL END PRINT LINE ! 5913: 15380,15384d14114 ! 5914: < * ! 5915: < * CALL SYSTEM CORE DUMP ROUTINE ! 5916: < * ! 5917: < DMP29 JSR SYSDM CALL IT ! 5918: < BRN DMP28 RETURN ! 5919: 15393,15395c14123,14124 ! 5920: < DMP30 JSR PRTNL PRINT BLANK LINE ! 5921: < JSR PRTVL PRINT VALUE ID FOR TITLE ! 5922: < JSR PRTNL FORCE NEW LINE ! 5923: --- ! 5924: > DMP29 JSR PRTFH PRINT BLANK LINE ! 5925: > JSR PRTVF PRINT VALUE ID FOR TITLE ! 5926: 15415,15416c14144 ! 5927: < JSR PRTCH PRINT IT ! 5928: < JSR PRTNL PRINT NEW LINE ! 5929: --- ! 5930: > JSR PRTCF PRINT IT ! 5931: 15430c14158 ! 5932: < JSR PRTIS PRINT ERROR PTR OR BLANK LINE ! 5933: --- ! 5934: > JSR PRTFH PRINT ERROR PTR OR BLANK LINE ! 5935: 15448,15450c14176 ! 5936: < JSR PRTST PRINT ERROR MESSAGE TEXT ! 5937: < JSR PRTIS PRINT LINE ! 5938: < JSR PRTIS PRINT BLANK LINE ! 5939: --- ! 5940: > JSR PRTFB PRINT ERROR MESSAGE TEXT ! 5941: 15465a14192 ! 5942: > BNZ EROSN,ERT03 SKIP IF SPECIAL EROSI RETURN ! 5943: 15483a14211,14216 ! 5944: > * ! 5945: > * SPECIAL CASE SET UP BY EROSI RETURN TO AVOID SYSEM CALL ! 5946: > * ! 5947: > ERT03 ZER EROSN CLEAR FLAG ! 5948: > MOV R$ETX,XR GET ERROR MESSAGE TEXT ! 5949: > BRN ERT01 RETURN WITHOUT MAKING SYSEM CALL ! 5950: 15498,15499d14230 ! 5951: < * PPM LOC TRANSFER LOC FOR SUCCESSFUL EVAL ! 5952: < * (THE NORMAL RETURN IS NEVER TAKEN) ! 5953: 15507c14238 ! 5954: < EVALI PRC R,4 ENTRY POINT (RECURSIVE) ! 5955: --- ! 5956: > EVALI PRC R,3 ENTRY POINT (RECURSIVE) ! 5957: 15518c14249 ! 5958: < EXI 4 TAKE SUCCESSFUL EXIT ! 5959: --- ! 5960: > EXI SUCCESSFUL RETURN ! 5961: 15621a14353 ! 5962: > * (WA) APPROPRIATE MULTI CHARACTER PCODE ! 5963: 15626,15627c14358 ! 5964: < * PPM LOC TRANSFER LOC FOR SUCCESSFUL EVAL ! 5965: < * (THE NORMAL RETURN IS NEVER TAKEN) ! 5966: --- ! 5967: > * (XL) PCODE OF NEW NODE (ENTRY WA) ! 5968: 15629c14360 ! 5969: < * (XL,WC,RA) DESTROYED ! 5970: --- ! 5971: > * (WA,WC,RA) DESTROYED ! 5972: 15634a14366,14367 ! 5973: > * THIS IS DONE BY THE USUAL INDIRECT BRANCH THROUGH THE ! 5974: > * PCODE PASSED IN WA. ! 5975: 15636c14369,14370 ! 5976: < EVALS PRC R,3 ENTRY POINT (RECURSIVE) ! 5977: --- ! 5978: > EVALS PRC R,2 ENTRY POINT (RECURSIVE) ! 5979: > MOV WA,-(XS) KEEP PCODE ! 5980: 15638a14373 ! 5981: > MOV (XS)+,WA RECOVER PCODE ! 5982: 15644c14379 ! 5983: < MOV =P$BRK,XL APPROPRIATE PCODE FOR OUR USE ! 5984: --- ! 5985: > MOV WA,XL APPROPRIATE PCODE FOR OUR USE ! 5986: 15649c14384,14385 ! 5987: < EXI 3 TAKE SUCCESS RETURN ! 5988: --- ! 5989: > MOV (XR),XL GET PCODE ! 5990: > EXI TAKE SUCCESS RETURN ! 5991: 15653c14389,14390 ! 5992: < EVLS1 EXI 2 TAKE FAILURE RETURN ! 5993: --- ! 5994: > EVLS1 MOV (XS)+,WA POP STACK ! 5995: > EXI 2 TAKE FAILURE RETURN ! 5996: 15733c14470 ! 5997: < EVLX3 MOV (XS)+,XR LOAD VALUE ! 5998: --- ! 5999: > EVLXV MOV (XS)+,XR LOAD VALUE ! 6000: 15735c14472 ! 6001: < ERB 249,EXPRESSION EVALUATED BY NAME RETURNED VALUE ! 6002: --- ! 6003: > ERB 218,EXPRESSION EVALUATED BY NAME RETURNED VALUE ! 6004: 15739c14476 ! 6005: < EVLX4 MOV (XS)+,WA LOAD NAME OFFSET ! 6006: --- ! 6007: > EVLXN MOV (XS)+,WA LOAD NAME OFFSET ! 6008: 15743c14480 ! 6009: < PPM EVLX6 JUMP IF FAILURE DURING ACCESS ! 6010: --- ! 6011: > PPM EVLXF JUMP IF FAILURE DURING ACCESS ! 6012: 15752c14489 ! 6013: < EVLX6 MNZ WB NOTE UNSUCCESSFUL ! 6014: --- ! 6015: > EVLXF MNZ WB NOTE UNSUCCESSFUL ! 6016: 15806c14543 ! 6017: < BTW WA CONVERT BYTE COUNT TO WORD COUNT ! 6018: --- ! 6019: > BTW WA CONVERT BAU COUNT TO WORD COUNT ! 6020: 15985c14722 ! 6021: < MOV =OPDVP,XR ELSE POINT TO UNMISTAKABLE CONCAT. ! 6022: --- ! 6023: > MOV =OPDVP,XR ELSE POINT TO UNMISTAKEABLE CONCAT ! 6024: 15987c14724 ! 6025: < * MERGE HERE WHEN XR SET UP WITH PROPER CONCATENATION DVBLK ! 6026: --- ! 6027: > * MERGE WITH CORRECT CONCATENATION DVBLK IN XR ! 6028: 15991c14728 ! 6029: < ERB 220,SYNTAX ERROR. MISSING OPERATOR ! 6030: --- ! 6031: > ERB 219,SYNTAX ERROR. MISSING OPERATOR ! 6032: 15998c14735 ! 6033: < ERB 221,SYNTAX ERROR. MISSING OPERAND ! 6034: --- ! 6035: > ERB 220,SYNTAX ERROR. MISSING OPERAND ! 6036: 16023c14760 ! 6037: < EXP08 ERB 222,SYNTAX ERROR. INVALID USE OF LEFT BRACKET ! 6038: --- ! 6039: > EXP08 ERB 221,SYNTAX ERROR. INVALID USE OF LEFT BRACKET ! 6040: 16049c14786 ! 6041: < ERB 223,SYNTAX ERROR. INVALID USE OF COMMA ! 6042: --- ! 6043: > ERB 222,SYNTAX ERROR. INVALID USE OF COMMA ! 6044: 16062c14799 ! 6045: < ERB 224,SYNTAX ERROR. UNBALANCED RIGHT PARENTHESIS ! 6046: --- ! 6047: > ERB 223,SYNTAX ERROR. UNBALANCED RIGHT PARENTHESIS ! 6048: 16080c14817 ! 6049: < WTB WA CONVERT LENGTH TO BYTES ! 6050: --- ! 6051: > WTB WA CONVERT LENGTH TO BAUS ! 6052: 16124c14861 ! 6053: < ERB 225,SYNTAX ERROR. UNBALANCED RIGHT BRACKET ! 6054: --- ! 6055: > ERB 224,SYNTAX ERROR. UNBALANCED RIGHT BRACKET ! 6056: 16153c14890 ! 6057: < EXP21 ERB 226,SYNTAX ERROR. MISSING RIGHT PAREN ! 6058: --- ! 6059: > EXP21 ERB 225,SYNTAX ERROR. MISSING RIGHT PAREN ! 6060: 16157c14894 ! 6061: < EXP22 ERB 227,SYNTAX ERROR. RIGHT PAREN MISSING FROM GOTO ! 6062: --- ! 6063: > EXP22 ERB 226,SYNTAX ERROR. RIGHT PAREN MISSING FROM GOTO ! 6064: 16161c14898 ! 6065: < EXP23 ERB 228,SYNTAX ERROR. RIGHT BRACKET MISSING FROM GOTO ! 6066: --- ! 6067: > EXP23 ERB 227,SYNTAX ERROR. RIGHT BRACKET MISSING FROM GOTO ! 6068: 16165c14902 ! 6069: < EXP24 ERB 229,SYNTAX ERROR. MISSING RIGHT ARRAY BRACKET ! 6070: --- ! 6071: > EXP24 ERB 228,SYNTAX ERROR. MISSING RIGHT ARRAY BRACKET ! 6072: 16269c15006 ! 6073: < EXDM1 BLE 1(XS),=NUM05,EXDM2 JUMP IF STACK BOTTOM (SAVED LEVEL ! 6074: --- ! 6075: > EXDM1 BLE 1(XS),=NUM05,EXDM2 JUMP IF STACK BOTTOM (SAVED LEVEL) ! 6076: 16324d15060 ! 6077: < .IF .CULC ! 6078: 16326,16369d15061 ! 6079: < * FLSTG -- FOLD STRING TO UPPER CASE ! 6080: < * ! 6081: < * FLSTG FOLDS A CHARACTER STRING CONTAINING LOWER CASE ! 6082: < * CHARACCTERS TO ONE CONTAINING UPPER CASE CHARACTERS. ! 6083: < * FOLDING IS ONLY DONE IF &CASE (KVCAS) IS NOT ZERO. ! 6084: < * ! 6085: < * (XR) STRING ARGUMENT ! 6086: < * (WA) LENGTH OF STRING ! 6087: < * JSR FLSTG CALL TO FOLD STRING ! 6088: < * (XR) RESULT STRING (POSSIBLY ORIGINAL) ! 6089: < * (WC) DESTROYED ! 6090: < * ! 6091: < FLSTG PRC R,0 ENTRY POINT ! 6092: < BZE KVCAS,FST99 SKIP IF &CASE IS 0 ! 6093: < MOV XL,-(XS) SAVE XL ACROSS CALL ! 6094: < MOV XR,-(XS) SAVE ORIGINAL SCBLK PTR ! 6095: < JSR ALOCS ALLOCATE NEW STRING BLOCK ! 6096: < MOV (XS),XL POINT TO ORIGINAL SCBLK ! 6097: < MOV XR,-(XS) SAVE POINTER TO NEW SCBLK ! 6098: < PLC XL POINT TO ORIGINAL CHARS ! 6099: < PLC XR POINT TO NEW CHARS ! 6100: < ZER -(XS) INIT DID FOLD FLAG ! 6101: < LCT WC,WC LOAD LOOP COUNTER ! 6102: < FST01 LCH WA,(XL)+ LOAD CHARACTER ! 6103: < BGT =CH$$A,WA,FST02 SKIP IF LESS THAN LC A ! 6104: < BGT WA,=CH$$$,FST02 SKIP IF GREATER THAN LC Z ! 6105: < FLC WA FOLD CHARACTER TO UPPER CASE ! 6106: < MNZ (XS) SET DID FOLD CHARACTER FLAG ! 6107: < FST02 SCH WA,(XR)+ STORE (POSSIBLY FOLDED) CHARACTER ! 6108: < BCT WC,FST01 LOOP THRU ENTIRE STRING ! 6109: < CSC XR COMPLETE STORE CHARACTERS ! 6110: < BNZ (XS)+,FST10 SKIP IF FOLDING DONE ! 6111: < MOV (XS)+,DNAMP DO NOT NEED NEW SCBLK ! 6112: < MOV (XS)+,XR RETURN ORIGINAL SCBLK ! 6113: < BRN FST20 MERGE BELOW ! 6114: < FST10 MOV (XS)+,XR RETURN NEW SCBLK ! 6115: < ICA XS THROW AWAY ORIGINAL SCBLK POINTER ! 6116: < FST20 MOV SCLEN(XR),WA RELOAD STRING LENGTH ! 6117: < MOV (XS)+,XL RESTORE XL ! 6118: < FST99 EXI RETURN ! 6119: < ENP ! 6120: < EJC ! 6121: < .FI ! 6122: < * ! 6123: 16414c15106 ! 6124: < * ENTRY VALUE OF WB IS THE NUMBER OF BYTES TO MOVE UP. ! 6125: --- ! 6126: > * ENTRY VALUE OF WB IS THE NUMBER OF BAUS TO MOVE UP. ! 6127: 16549,16550c15241,15242 ! 6128: < * BYTES. SET TO THE ADDRESS OF THE ! 6129: < * FIRST BYTE WHILE ACTUALLY SCANNING ! 6130: --- ! 6131: > * BAUS. SET TO THE ADDRESS OF THE ! 6132: > * FIRST BAU WHILE ACTUALLY SCANNING ! 6133: 16570a15263,15265 ! 6134: > .IF .CEPP ! 6135: > BOD WA,GBC07 JUMP IF ENTRY POINTER (UNUSED) ! 6136: > .ELSE ! 6137: 16572a15268 ! 6138: > .FI ! 6139: 16578a15275,15277 ! 6140: > .IF .CEPP ! 6141: > BEV WA,GBC06 LOOP BACK IF NOT END OF CHAIN ! 6142: > .ELSE ! 6143: 16580a15280 ! 6144: > .FI ! 6145: 16603a15304,15306 ! 6146: > .IF .CEPP ! 6147: > BEV WA,GBC09 JUMP IF IN USE ! 6148: > .ELSE ! 6149: 16605a15309 ! 6150: > .FI ! 6151: 16672c15376 ! 6152: < ERB 250,INSUFFICIENT MEMORY TO COMPLETE DUMP ! 6153: --- ! 6154: > ERB 229,INSUFFICIENT MEMORY TO COMPLETE DUMP ! 6155: 16702a15407,15410 ! 6156: > .IF .CRPP ! 6157: > BOD XL,GPF02 JUMP IF NOT PTR INTO DYNAMIC AREA ! 6158: > .ELSE ! 6159: > .FI ! 6160: 16714a15423,15425 ! 6161: > .IF .CEPP ! 6162: > BOD WA,GPF03 JUMP IF NOT ALREADY PROCESSED ! 6163: > .ELSE ! 6164: 16716a15428 ! 6165: > .FI ! 6166: 16752a15465 ! 6167: > IFF BL$CO,GPF19 COBLK ! 6168: 16889a15603,15608 ! 6169: > * ! 6170: > * COBLK ! 6171: > * ! 6172: > GPF19 MOV *COSI$,WA SET LENGTH ! 6173: > MOV *CONXT,WB AND OFFSET ! 6174: > BRN GPF05 ALL SET ! 6175: 16890a15610,15611 ! 6176: > .IF .CNBF ! 6177: > .ELSE ! 6178: 16892a15614,15648 ! 6179: > * GTBUF -- GET BUFFER ! 6180: > * ! 6181: > * GTBUF IS PASSED AN OBJECT AND RETURNS A BUFFER IF ! 6182: > * POSSIBLE. UNLESS THE OBJECT IS ALREADY A BUFFER, ! 6183: > * THIS INVOLVES A CONVERSION TO STRING AND THEN ! 6184: > * STRING TO BUFFER. ! 6185: > * ! 6186: > * (XR) OBJECT TO BE CONVERTED ! 6187: > * JSR GTBUF CALL TO GET BUFFER ! 6188: > * PPM LOC TRANSFER LOC FOR CONVERT IMPOSSIBLE ! 6189: > * (XR) RESULTING BUFFER ! 6190: > * (XL,WA,WB,WC) DESTROYED ! 6191: > * ! 6192: > GTBUF PRC E,1 ENTRY POINT ! 6193: > BEQ (XR),=B$BCT,GTB01 EXIT IF ALREADY BUFFER ! 6194: > MOV XR,-(XS) STACK TO CONVERT TO STRING ! 6195: > JSR GTSTG CONVERT TO STRING ! 6196: > PPM GTB02 CONVERSION ERROR ! 6197: > MOV XR,XL SAVE STRING POINTER ! 6198: > JSR ALOBF ALLOCATE BUFFER OF SAME SIZE ! 6199: > JSR INSBF COPY IN THE STRING ! 6200: > PPM ALREADY STRING - CANT FAIL TO CNV ! 6201: > PPM MUST BE ENOUGH ROOM ! 6202: > * ! 6203: > * MERGE TO EXIT WITH BUFFER CONTROL BLK IN (XR) ! 6204: > * ! 6205: > GTB01 EXI RETURN TO CALLER ! 6206: > * ! 6207: > * HERE ON CONVERSION FAILURE ! 6208: > * ! 6209: > GTB02 EXI 1 TAKE FAILURE EXIT ! 6210: > ENP ! 6211: > .FI ! 6212: > EJC ! 6213: > * ! 6214: 16895c15651 ! 6215: < * GTARR IS PASSED AN OBJECT AND RETURNS AN ARRAY IF POSSIBL ! 6216: --- ! 6217: > * GTARR IS PASSED AN OBJECT AND RETURNS AN ARRAY IF POSSIBLE ! 6218: 16907c15663,15664 ! 6219: < BNE WA,=B$TBT,GTA9A ELSE FAIL IF NOT A TABLE (SGD02) ! 6220: --- ! 6221: > MOV XR,-(XS) PLACE POSSIBLE TBBLK PTR ON STACK ! 6222: > BNE WA,=B$TBT,GTAR9 ELSE FAIL IF NOT A TABLE ! 6223: 16911d15667 ! 6224: < MOV XR,-(XS) REPLACE TBBLK POINTER ON STACK ! 6225: 16973c15729 ! 6226: < WTB WA CONVERT LENGTH TO BYTES ! 6227: --- ! 6228: > WTB WA CONVERT LENGTH TO BAUS ! 6229: 17027,17031c15783,15784 ! 6230: < GTAR9 MOV (XS)+,XR RESTORE STACK FOR CONV ERR (SGD02) ! 6231: < * ! 6232: < * MERGE TO TAKE CONVERT ERROR WHEN STACK ADJUSTED OK ! 6233: < * ! 6234: < GTA9A EXI 1 RETURN ! 6235: --- ! 6236: > GTAR9 MOV (XS)+,XR CLEAR UP STACK ! 6237: > EXI 1 RETURN ! 6238: 17095,17099c15848,15852 ! 6239: < * CHECK THE LAST CHARACTER OF THE STRING FOR COLON OR ! 6240: < * SEMICOLON. THESE CHARACTERS CAN LEGITIMATELY END AN ! 6241: < * EXPRESSION IN OPEN CODE, SO EXPAN WILL NOT DETECT THEM ! 6242: < * AS ERRORS, BUT THEY ARE INVALID AS TERMINATORS FOR A ! 6243: < * STRING THAT IS BEING CONVERTED TO EXPRESSION FORM. ! 6244: --- ! 6245: > * CHECK THE LAST CHAR OF STRING FOR COLON OR ! 6246: > * SEMICOLON. THEY CAN LEGITIMATELY END AN EXPRESSION ! 6247: > * IN OPEN CODE, SO EXPAN WILL NOT FAIL THEM BUT THEY ARE ! 6248: > * INVALID AS TERMINATORS FOR A STRING WHICH IS TO BE ! 6249: > * CONVERTED TO EXPRESSION FORM. ! 6250: 17101,17105c15854,15858 ! 6251: < MOV XR,XL COPY INPUT STRING POINTER (REG06) ! 6252: < PLC XL,WA POINT ONE PAST THE STRING END (REG06) ! 6253: < LCH XL,-(XL) FETCH THE LAST CHARACTER (REG06) ! 6254: < BEQ XL,=CH$CL,GTEX2 ERROR IF IT IS A SEMICOLON (REG06) ! 6255: < BEQ XL,=CH$SM,GTEX2 OR IF IT IS A COLON (REG06) ! 6256: --- ! 6257: > MOV XR,XL COPY ARGUMENT STRING ! 6258: > PLC XL,WA POINT PAST STRING END ! 6259: > LCH XL,-(XL) GET LAST CHAR ! 6260: > BEQ XL,=CH$CL,GTEX2 FAIL IF COLON ! 6261: > BEQ XL,=CH$SM,GTEX2 FAIL IF SEMICOLON ! 6262: 17196c15949 ! 6263: < BEQ WA,=B$ICL,GTN34 JUMP IF INTEGER (NO CONVERSION) ! 6264: --- ! 6265: > BEQ WA,=B$ICL,GTN3A JUMP IF INTEGER (NO CONVERSION) ! 6266: 17199c15952 ! 6267: < BEQ WA,=B$RCL,GTN34 JUMP IF REAL (NO CONVERSION) ! 6268: --- ! 6269: > BEQ WA,=B$RCL,GTN3A JUMP IF REAL (NO CONVERSION) ! 6270: 17204a15958 ! 6271: > STI GTNSV SAVE IA ! 6272: 17357,17359c16111,16113 ! 6273: < .IF .CULC ! 6274: < BEQ WB,=CH$$E,GTN15 JUMP IF E FOR EXPONENT ! 6275: < BEQ WB,=CH$$D,GTN15 JUMP IF D FOR EXPONENT ! 6276: --- ! 6277: > .IF .CASL ! 6278: > BEQ WB,=CH$$E,GTN15 JUMP FOR EXPT ! 6279: > BEQ WB,=CH$$D,GTN15 JUMP FOR EXPT ! 6280: 17462c16216 ! 6281: < WTB WA CONVERT REMAINING SCALE TO BYTE OFS ! 6282: --- ! 6283: > WTB WA CONVERT REMAINING SCALE TO BAU OFS ! 6284: 17490c16244 ! 6285: < WTB WA CONVERT REMAINING SCALE TO BYTE OFS ! 6286: --- ! 6287: > WTB WA CONVERT REMAINING SCALE TO BAU OFS ! 6288: 17524c16278,16279 ! 6289: < GTN34 EXI RETURN TO GTNUM CALLER ! 6290: --- ! 6291: > GTN34 LDI GTNSV RECOVER IA ! 6292: > GTN3A EXI RETURN TO GTNUM CALLER ! 6293: 17538a16294 ! 6294: > LDI GTNSV RECOVER IA ! 6295: 17552d16307 ! 6296: < * (WA,WB) DESTROYED (CONVERSION ERROR ONLY) ! 6297: 17558a16314 ! 6298: > BRN GNV01 FAIL ! 6299: 17559a16316,16320 ! 6300: > * RESTORE REGS AND FAIL ! 6301: > * ! 6302: > GNV00 MOV GNVSA,WA RESTORE REGS ! 6303: > MOV GNVSB,WB ! 6304: > * ! 6305: 17570,17574c16331,16332 ! 6306: < PPM GNV01 JUMP IF CONVERSION ERROR ! 6307: < BZE WA,GNV01 NULL STRING IS AN ERROR ! 6308: < .IF .CULC ! 6309: < JSR FLSTG FOLD LOWER CASE TO UPPER CASE ! 6310: < .FI ! 6311: --- ! 6312: > PPM GNV00 JUMP IF CONVERSION ERROR ! 6313: > BZE WA,GNV00 NULL STRING IS AN ERROR ! 6314: 17575a16334,16339 ! 6315: > .IF .CASL ! 6316: > MOV XR,XL COPY STRING POINTER ! 6317: > ZER WB ZERO OFFSET ! 6318: > JSR SBSTG CONVERT TO PREFERRED CASE ! 6319: > MOV SCLEN(XR),WA RECOVER STRING LENGTH ! 6320: > .FI ! 6321: 17586c16350 ! 6322: < WTB WC CONVERT OFFSET TO BYTES ! 6323: --- ! 6324: > WTB WC CONVERT OFFSET TO BAUS ! 6325: 17635c16399 ! 6326: < WTB XL CONVERT TO BYTE OFFSET ! 6327: --- ! 6328: > WTB XL CONVERT TO BAU OFFSET ! 6329: 17687c16451 ! 6330: < WTB WA CONVERT LENGTH TO BYTES ! 6331: --- ! 6332: > WTB WA CONVERT LENGTH TO BAUS ! 6333: 17703c16467 ! 6334: < WTB WA CONVERT TO LENGTH IN BYTES ! 6335: --- ! 6336: > WTB WA CONVERT TO LENGTH IN BAUS ! 6337: 17826c16590 ! 6338: < * MERGE HERE TO EXIT OF NO CONVERSION REQUIRED ! 6339: --- ! 6340: > * MERGE HERE TO EXIT IF NO CONVERSION REQUIRED ! 6341: 17901c16665 ! 6342: < BGT WC,MXLEN,GTSM3 OR IF TOO SMALL ! 6343: --- ! 6344: > BGT WC,MXLEN,GTSM3 OR IF TOO LARGE ! 6345: 17979c16743 ! 6346: < .IF .CNCI ! 6347: --- ! 6348: > .IF .CSCI ! 6349: 18008d16771 ! 6350: < .FI ! 6351: 18023a16787 ! 6352: > .FI ! 6353: 18181a16946,16948 ! 6354: > .IF .CPLC ! 6355: > MOV =CH$$E,WA GET CHAR LETTER E ! 6356: > .ELSE ! 6357: 18182a16950 ! 6358: > .FI ! 6359: 18265c17033 ! 6360: < MOV BCBUF(XL),XL POINT TO BFBLK ! 6361: --- ! 6362: > MOV BCBUF(XL),XL POINT TOBFBLK ! 6363: 18326c17094 ! 6364: < * HASHS IS USED TO CONVERT A STRING TO A UNIQUE INTEGER ! 6365: --- ! 6366: > * HASHS REPRODUCIBLY MAPS A STRING TO AN INTEGER ! 6367: 18337c17105 ! 6368: < * START WITH THE LENGTH OF THE STRING (SGD07) ! 6369: --- ! 6370: > * START WITH THE LENGTH OF THE STRING ! 6371: 18383,18384c17151,17154 ! 6372: < MFI XR,ICBL1 COPY SMALL INTEGERS ! 6373: < BLE XR,=NUM02,ICBL3 JUMP IF 0,1 OR 2 ! 6374: --- ! 6375: > ILT ICBL1 SKIP IF NEGATIVE ! 6376: > SBI INTV2 REDUCE BY TWO ! 6377: > ILE ICBL3 JUMP IF 0 , 1 OR 2 ! 6378: > ADI INTV2 RESTORE VALUE ! 6379: 18405c17175,17177 ! 6380: < ICBL3 WTB XR CONVERT INTEGER TO OFFSET ! 6381: --- ! 6382: > ICBL3 ADI INTV2 RESTORE VALUE ! 6383: > MFI XR CONVERT TO SHORT INTEGER ! 6384: > WTB XR CONVERT INTEGER TO OFFSET ! 6385: 18503c17275 ! 6386: < * INOUT - USED TO INITIALISE INPUT AND OUTPUT VARIABLES ! 6387: --- ! 6388: > * INOUT - USED TO INITIALISE .INPUT .OUTPUT .TERMINAL ! 6389: 18506c17278 ! 6390: < * (WB) TRBLK TYPE ! 6391: --- ! 6392: > * (WB) TRBLK TYPE (TRTYP FIELD) ! 6393: 18508,18509d17279 ! 6394: < * (XL) VRBLK PTR ! 6395: < * (XR) TRBLK PTR ! 6396: 18521c17291 ! 6397: < JSR GTNVR BUILD VRBLK ! 6398: --- ! 6399: > JSR GTNVR FIND OR BUILD VRBLK ! 6400: 18524,18525c17294,17296 ! 6401: < MOV (XS)+,WB GET TRTER FIELD ! 6402: < ZER XL ZERO TRFPT ! 6403: --- ! 6404: > MOV (XS)+,WB GET TRTYP FIELD ! 6405: > ZER XL ZERO TRTRI ! 6406: > MOV VRSVP(XR),XR GET SVBLK POINTER ! 6407: 18528,18531c17299,17301 ! 6408: < MOV VRSVP(XL),TRTER(XR) STORE SVBLK POINTER ! 6409: < MOV XR,VRVAL(XL) STORE TRBLK PTR IN VRBLK ! 6410: < MOV =B$VRA,VRGET(XL) SET TRAPPED ACCESS ! 6411: < MOV =B$VRV,VRSTO(XL) SET TRAPPED STORE ! 6412: --- ! 6413: > MOV *VRVAL,WA OFFSET TO VALUE FIELD ! 6414: > JSR TRCHN PUT TRBLK IN TRACE CHAIN ! 6415: > PPM CANT FAIL ! 6416: 18542,18543c17312,17313 ! 6417: < * SECTION TO BE REPLACED IS DIFFERENT THAN THE LENGTH OF ! 6418: < * THE GIVEN STRING, AND THE REPLACEMENT IS NOT AN APPEND, ! 6419: --- ! 6420: > * SECTION TO BE REPLACED DIFFERS FROM THAT OF THE ! 6421: > * GIVEN STRING, AND THE REPLACEMENT IS NOT AN APPEND, ! 6422: 18547,18548c17317,17318 ! 6423: < * (XR) POINTER TO BFBLK ! 6424: < * (XL) OBJECT WHICH IS STRING CONVERTABLE ! 6425: --- ! 6426: > * (XR) POINTER TO BCBLK ! 6427: > * (XL) OBJECT WHICH IS STRING CONVERTIBLE ! 6428: 18552,18553c17322,17324 ! 6429: < * PPM LOC THREAD IF (XR) NOT CONVERTABLE ! 6430: < * PPM LOC THREAD IF INSERT NOT POSSIBLE ! 6431: --- ! 6432: > * PPM LOC ERROR IF (XR) NOT CONVERTIBLE ! 6433: > * PPM LOC FAIL IF INSERT NOT POSSIBLE ! 6434: > * (XL,WA,WB,WC) DESTROYED ! 6435: 18562d17332 ! 6436: < MOV WC,INSSC SAVE ENTRY WC ! 6437: 18568d17337 ! 6438: < MOV XL,-(XS) SAVE ENTRY XL ! 6439: 18570c17339 ! 6440: < MOV XL,-(XS) STACK AGAIN FOR GTSTG ! 6441: --- ! 6442: > MOV XL,-(XS) STACK STRING POINTER FOR GTSTG ! 6443: 18572c17341 ! 6444: < PPM INS05 TAKE STRING CONVERT ERR EXIT ! 6445: --- ! 6446: > PPM INS06 TAKE STRING CONVERT ERR EXIT ! 6447: 18574c17343,17346 ! 6448: < MOV (XS),XR RESTORE BCBLK PTR ! 6449: --- ! 6450: > MOV (XS)+,XR RESTORE BCBLK PTR ! 6451: > MOV XR,INSBC BCBLK PTR - NO DANGER OF GARB COLLN ! 6452: > MOV BCBUF(XR),XR POINT TO BFBLK ! 6453: > MOV XR,INSBB BFBLK PTR - NO DANGER OF GARB COLLN ! 6454: 18577,18579c17349,17350 ! 6455: < MOV BCBUF(XR),XR POINT TO BFBLK ! 6456: < BGT WA,BFALC(XR),INS06 FAIL IF RESULT EXCEEDS ALLOCATION ! 6457: < MOV (XS),XR RESTORE BCBLK PTR ! 6458: --- ! 6459: > BGT WA,BFALC(XR),INS07 FAIL IF RESULT EXCEEDS ALLOCATION ! 6460: > MOV INSBC,XR RESTORE BCBLK PTR ! 6461: 18586,18588c17357 ! 6462: < BZE WA,INS04 SKIP SHIFT IF NOTHING TO DO ! 6463: < BEQ INSSB,SCLEN(XL),INS04 SKIP SHIFT IF LENGTHS MATCH ! 6464: < MOV BCBUF(XR),XR POINT TO BFBLK ! 6465: --- ! 6466: > MOV INSBB,XR POINT TO BFBLK ! 6467: 18590c17359,17361 ! 6468: < BLO INSSB,SCLEN(XL),INS01 BRN IF SHFT IS FOR MORE ROOM ! 6469: --- ! 6470: > BZE WA,INS02 SKIP SHIFT IF NOTHING TO DO ! 6471: > BEQ INSSB,SCLEN(XL),INS02 SKIP SHIFT IF LENGTHS MATCH ! 6472: > BLO INSSB,SCLEN(XL),INS01 BRN IF SHIFT IS FOR MORE ROOM ! 6473: 18597c17368 ! 6474: < * SEGMENT BEING REPLACED.) REGISTERS ARE SET AS: ! 6475: --- ! 6476: > * SEGMENT BEING REPLACED). REGISTERS ARE SET AS - ! 6477: 18622c17393 ! 6478: < * MERGE HERE AFTER MOVE TO ADJUST PADDING AT NEW BUFFER END ! 6479: --- ! 6480: > * MERGE HERE AFTER POSSIBLE MOVE TO ADJUST ZERO FILL AT END ! 6481: 18626a17398 ! 6482: > BTC WA CONVERT TO CHAR COUNT ! 6483: 18629,18630c17401 ! 6484: < MOV (XS),XR GET BCBLK PTR ! 6485: < MOV BCBUF(XR),XR GET BFBLK PTR ! 6486: --- ! 6487: > MOV INSBB,XR POINT TO BFBLK ! 6488: 18633a17405 ! 6489: > EJC ! 6490: 18634a17407,17408 ! 6491: > * INSBF (CONTINUED) ! 6492: > * ! 6493: 18639d17412 ! 6494: < EJC ! 6495: 18641,18642d17413 ! 6496: < * INSBF (CONTINUED) ! 6497: < * ! 6498: 18646,18647c17417 ! 6499: < INS04 MOV (XS),XR GET BCBLK PTR ! 6500: < MOV BCBUF(XR),XR GET BFBLK PTR ! 6501: --- ! 6502: > INS04 MOV INSBB,XR POINT TO BFBLK ! 6503: 18648a17419 ! 6504: > BZE WA,INS05 SKIP IF NO CHARS TO INSERT ! 6505: 18652,18656c17423,17427 ! 6506: < MOV (XS)+,XR RESTORE ENTRY XR ! 6507: < MOV (XS)+,XL RESTORE ENTRY XL ! 6508: < MOV INSSA,WA RESTORE ENTRY WA ! 6509: < MOV INSSB,WB RESTORE ENTRY WB ! 6510: < MOV INSSC,WC RESTORE ENTRY WC ! 6511: --- ! 6512: > * ! 6513: > * SUCCESSFUL RETURN ! 6514: > * ! 6515: > INS05 MOV INSBC,XR RESTORE ENTRY XR ! 6516: > ZER XL CLEAR GARBAGE CHAR POINTER ! 6517: 18661,18665c17432 ! 6518: < INS05 MOV (XS)+,XR RESTORE ENTRY XR ! 6519: < MOV (XS)+,XL RESTORE ENTRY XL ! 6520: < MOV INSSA,WA RESTORE ENTRY WA ! 6521: < MOV INSSB,WB RESTORE ENTRY WB ! 6522: < MOV INSSC,WC RESTORE ENTRY WC ! 6523: --- ! 6524: > INS06 ICA XS DISCARD UNWANTED STACK TOP ! 6525: 18670,18678c17437 ! 6526: < INS06 MOV (XS)+,XR RESTORE ENTRY XR ! 6527: < MOV (XS)+,XL RESTORE ENTRY XL ! 6528: < * ! 6529: < * MERGE FOR LENGTH FAILURE EXIT WITH STACK SET ! 6530: < * ! 6531: < INS07 MOV INSSA,WA RESTORE ENTRY WA ! 6532: < MOV INSSB,WB RESTORE ENTRY WB ! 6533: < MOV INSSC,WC RESTORE ENTRY WC ! 6534: < EXI 2 ALTERNATE EXIT ! 6535: --- ! 6536: > INS07 EXI 2 ALTERNATE EXIT ! 6537: 18681a17441 ! 6538: > * IOFTG -- GET IOTAG ! 6539: 18683c17443,17444 ! 6540: < * IOFCB -- GET INPUT/OUTPUT FCBLK POINTER ! 6541: --- ! 6542: > * USED TO FIND THE IOTAG (IF ANY) CORRESPONDING TO THE ! 6543: > * FILETAG ARGUMENT. ! 6544: 18685,18691c17446,17448 ! 6545: < * USED BY ENDFILE, EJECT AND REWIND TO FIND THE FCBLK ! 6546: < * (IF ANY) CORRESPONDING TO THEIR ARGUMENT. ! 6547: < * ! 6548: < * -(XS) ARGUMENT ! 6549: < * JSR IOFCB CALL TO FIND FCBLK ! 6550: < * PPM LOC ARG IS AN UNSUITABLE NAME ! 6551: < * PPM LOC ARG IS NULL STRING ! 6552: --- ! 6553: > * -(XS) FILETAG ARGUMENT ! 6554: > * JSR IOFTG CALL TO FIND IOTAG ! 6555: > * PPM LOC ARG IS AN UNSUITABLE FILETAG ! 6556: 18693,18696c17450,17454 ! 6557: < * (XL) PTR TO FILEARG1 VRBLK ! 6558: < * (XR) ARGUMENT ! 6559: < * (WA) FCBLK PTR OR 0 ! 6560: < * (WB) DESTROYED ! 6561: --- ! 6562: > * (XL) PTR TO FILETAG SCBLK ! 6563: > * (XR) PTR TO TRTIO TRACE BLK OR ZERO ! 6564: > * (WA) IOTAG OR ZERO ! 6565: > * (WB) PTR TO FILETAG VRBLK ! 6566: > * (WC) VALUE/0 FOR INTEGER/STRING FILETAG ! 6567: 18698c17456 ! 6568: < IOFCB PRC N,2 ENTRY POINT ! 6569: --- ! 6570: > IOFTG PRC N,1 ENTRY POINT ! 6571: 18700c17458 ! 6572: < PPM IOFC2 FAIL ! 6573: --- ! 6574: > PPM IOFT4 FAIL ! 6575: 18702,18705c17460,17474 ! 6576: < JSR GTNVR GET AS NATURAL VARIABLE ! 6577: < PPM IOFC3 FAIL IF NULL ! 6578: < MOV XL,WB COPY STRING POINTER AGAIN ! 6579: < MOV XR,XL COPY VRBLK PTR FOR RETURN ! 6580: --- ! 6581: > MOV XR,-(XS) STACK STRING ! 6582: > JSR GTSMI TRY CONVERSION TO INTEGER ! 6583: > PPM IOFT5 SKIP IF CANT ! 6584: > PPM IOFT5 SKIP IF CANT ! 6585: > * ! 6586: > * MERGE WITH WC SET UP ! 6587: > * ! 6588: > IOFT1 MOV WC,WB KEEP INTEGER OR ZERO ! 6589: > MOV XL,XR FILETAG STRING TO XR FOR GTNVR CALL ! 6590: > JSR GTNVR FIND VRBLK ! 6591: > PPM IOFT4 SKIP IF NULL STRING ! 6592: > MOV XL,-(XS) KEEP SCBLK PTR ! 6593: > ZER XL IN CASE NO TRTIO BLK FOUND ! 6594: > MOV WB,WC KEEP INTEGER OR ZERO ! 6595: > MOV XR,WB COPY VRBLK PTR FOR RETURN ! 6596: 18710,18715c17479,17483 ! 6597: < IOFC1 MOV VRVAL(XR),XR GET POSSIBLE TRBLK PTR ! 6598: < BNE (XR),=B$TRT,IOFC2 FAIL IF END OF CHAIN ! 6599: < BNE TRTYP(XR),=TRTFC,IOFC1 LOOP IF NOT FILE ARG TRBLK ! 6600: < MOV TRFPT(XR),WA GET FCBLK PTR ! 6601: < MOV WB,XR COPY ARG ! 6602: < EXI RETURN ! 6603: --- ! 6604: > IOFT2 MOV VRVAL(XR),XR GET POSSIBLE TRBLK PTR ! 6605: > BNE (XR),=B$TRT,IOFT3 SKIP IF END OF CHAIN ! 6606: > BNE TRTYP(XR),=TRTIO,IOFT2 LOOP IF NOT FILETAG TRBLK ! 6607: > MOV TRTAG(XR),WA GET IOTAG OR 0 ! 6608: > MOV XR,XL TRTIO BLK PTR ! 6609: 18717c17485 ! 6610: < * FAIL RETURN ! 6611: --- ! 6612: > * RETURN POINT ! 6613: 18719c17487,17489 ! 6614: < IOFC2 EXI 1 FAIL ! 6615: --- ! 6616: > IOFT3 MOV XL,XR TRTIO BLK PTR OR 0 ! 6617: > MOV (XS)+,XL RECOVER SCBLK PTR ! 6618: > EXI SUCCESSFUL RETURN ! 6619: 18721c17491 ! 6620: < * NULL ARG ! 6621: --- ! 6622: > * FAIL RETURN ! 6623: 18723,18724c17493 ! 6624: < IOFC3 EXI 2 NULL ARG RETURN ! 6625: < ENP END PROCEDURE IOFCB ! 6626: --- ! 6627: > IOFT4 EXI 1 FAIL ! 6628: 18727c17496 ! 6629: < * IOPPF -- PROCESS FILEARG2 FOR IOPUT ! 6630: --- ! 6631: > * NON NUMERIC FILETAG ! 6632: 18729,18755c17498,17500 ! 6633: < * (R$XSC) FILEARG2 PTR ! 6634: < * JSR IOPPF CALL TO PROCESS FILEARG2 ! 6635: < * (XL) FILEARG1 PTR ! 6636: < * (XR) FILE ARG2 PTR ! 6637: < * -(XS)..-(XS) FIELDS EXTRACTED FROM FILEARG2 ! 6638: < * (WC) NO. OF FIELDS EXTRACTED ! 6639: < * (WB) INPUT/OUTPUT FLAG ! 6640: < * (WA) FCBLK PTR OR 0 ! 6641: < * ! 6642: < IOPPF PRC N,0 ENTRY POINT ! 6643: < ZER WB TO COUNT FIELDS EXTRACTED ! 6644: < * ! 6645: < * LOOP TO EXTRACT FIELDS ! 6646: < * ! 6647: < IOPP1 MOV =IODEL,XL GET DELIMITER ! 6648: < MOV XL,WC COPY IT ! 6649: < JSR XSCAN GET NEXT FIELD ! 6650: < MOV XR,-(XS) STACK IT ! 6651: < ICV WB INCREMENT COUNT ! 6652: < BNZ WA,IOPP1 LOOP ! 6653: < MOV WB,WC COUNT OF FIELDS ! 6654: < MOV IOPTT,WB I/O MARKER ! 6655: < MOV R$IOF,WA FCBLK PTR OR 0 ! 6656: < MOV R$IO2,XR FILE ARG2 PTR ! 6657: < MOV R$IO1,XL FILEARG1 ! 6658: < EXI RETURN ! 6659: < ENP END PROCEDURE IOPPF ! 6660: --- ! 6661: > IOFT5 ZER WC NOTE NON NUMERIC ! 6662: > BRN IOFT1 MERGE ! 6663: > ENP END PROCEDURE IOFTG ! 6664: 18758c17503 ! 6665: < * IOPUT -- ROUTINE USED BY INPUT AND OUTPUT ! 6666: --- ! 6667: > * IOPUT -- PROCESS INPUT AND OUTPUT ARGUMENTS ! 6668: 18760,18763c17505,17507 ! 6669: < * IOPUT SETS UP INPUT/OUTPUT ASSOCIATIONS. IT BUILDS ! 6670: < * SUCH TRACE AND FILE CONTROL BLOCKS AS ARE NECESSARY AND ! 6671: < * CALLS SYSFC,SYSIO TO PERFORM CHECKS ON THE ! 6672: < * ARGUMENTS AND TO OPEN THE FILES. ! 6673: --- ! 6674: > * IOPUT CHECKS THE ARGUMENTS OF INPUT AND OUTPUT CALLS, ! 6675: > * SETS UP THE REQUIRED ASSOCIATIONS AND CALLS SYSIO TO ! 6676: > * OPEN THE REQUESTED FILES. ! 6677: 18765,18820d17508 ! 6678: < * +-----------+ +---------------+ +-----------+ ! 6679: < * +-.I I I I------.I =B$XRT I ! 6680: < * I +-----------+ +---------------+ +-----------+ ! 6681: < * I / / (R$FCB) I *4 I ! 6682: < * I / / +-----------+ ! 6683: < * I +-----------+ +---------------+ I I- ! 6684: < * I I NAME +--.I =B$TRT I +-----------+ ! 6685: < * I / / +---------------+ I I ! 6686: < * I (FIRST ARG) I =TRTIN/=TRTOU I +-----------+ ! 6687: < * I +---------------+ I ! 6688: < * I I VALUE I I ! 6689: < * I +---------------+ I ! 6690: < * I I(TRTRF) 0 OR I--+ I ! 6691: < * I +---------------+ I I ! 6692: < * I I(TRFPT) 0 OR I----+ I ! 6693: < * I +---------------+ I I I ! 6694: < * I (I/O TRBLK) I I I ! 6695: < * I +-----------+ I I I ! 6696: < * I I I I I I ! 6697: < * I +-----------+ I I I ! 6698: < * I I I I I I ! 6699: < * I +-----------+ +---------------+ I I I ! 6700: < * I I +--.I =B$TRT I.-+ I I ! 6701: < * I +-----------+ +---------------+ I I ! 6702: < * I / / I =TRTFC I I I ! 6703: < * I / / +---------------+ I I ! 6704: < * I (FILEARG1 I VALUE I I I ! 6705: < * I VRBLK) +---------------+ I I ! 6706: < * I I(TRTRF) 0 OR I--+ I . ! 6707: < * I +---------------+ I . +-----------+ ! 6708: < * I I(TRFPT) 0 OR I------./ FCBLK / ! 6709: < * I +---------------+ I +-----------+ ! 6710: < * I (TRTRF) I ! 6711: < * I I ! 6712: < * I I ! 6713: < * I +---------------+ I ! 6714: < * I I =B$XRT I.-+ ! 6715: < * I +---------------+ ! 6716: < * I I *5 I ! 6717: < * I +---------------+ ! 6718: < * +------------------I I ! 6719: < * +---------------+ +-----------+ ! 6720: < * I(TRTRF) O OR I------.I =B$XRT I ! 6721: < * +---------------+ +-----------+ ! 6722: < * I NAME OFFSET I I ETC I ! 6723: < * +---------------+ ! 6724: < * (IOCHN - CHAIN OF NAME POINTERS) ! 6725: < EJC ! 6726: < * ! 6727: < * IOPUT (CONTINUED) ! 6728: < * ! 6729: < * NO ADDITIONAL TRAP BLOCKS ARE USED FOR STANDARD INPUT/OUT ! 6730: < * FILES. OTHERWISE AN I/O TRAP BLOCK IS ATTACHED TO SECOND ! 6731: < * ARG (FILEARG1) VRBLK. SEE DIAGRAM ABOVE FOR DETAILS OF ! 6732: < * THE STRUCTURE BUILT. ! 6733: < * ! 6734: 18822,18824c17510,17512 ! 6735: < * -(XS) 2ND ARG (FILE ARG1) ! 6736: < * -(XS) 3RD ARG (FILE ARG2) ! 6737: < * (WB) 0 FOR INPUT, 3 FOR OUTPUT ASSOC. ! 6738: --- ! 6739: > * -(XS) 2ND ARG (FILETAG) ! 6740: > * -(XS) 3RD ARG (FILEPROPS) ! 6741: > * (WB) 0 FOR INPUT, 2 FOR OUTPUT ASSOC. ! 6742: 18827c17515 ! 6743: < * PPM LOC 2ND ARG NOT A SUITABLE NAME ! 6744: --- ! 6745: > * PPM LOC 2ND ARG NOT A SUITABLE FILETAG ! 6746: 18829,18831c17517 ! 6747: < * PPM LOC INAPPROPRIATE FILE SPEC FOR I/O ! 6748: < * PPM LOC I/O FILE DOES NOT EXIST ! 6749: < * PPM LOC I/O FILE CANNOT BE READ/WRITTEN ! 6750: --- ! 6751: > * PPM LOC FAIL RETURN ! 6752: 18835,18858d17520 ! 6753: < IOPUT PRC N,6 ENTRY POINT ! 6754: < ZER R$IOT IN CASE NO TRTRF BLOCK USED ! 6755: < ZER R$IOF IN CASE NO FCBLK ALOCATED ! 6756: < MOV WB,IOPTT STORE I/O TRACE TYPE ! 6757: < JSR XSCNI PREPARE TO SCAN FILEARG2 ! 6758: < PPM IOP13 FAIL ! 6759: < PPM IOPA0 NULL FILE ARG2 ! 6760: < * ! 6761: < IOPA0 MOV XR,R$IO2 KEEP FILE ARG2 ! 6762: < MOV WA,XL COPY LENGTH ! 6763: < JSR GTSTG CONVERT FILEARG1 TO STRING ! 6764: < PPM IOP14 FAIL ! 6765: < MOV XR,R$IO1 KEEP FILEARG1 PTR ! 6766: < JSR GTNVR CONVERT TO NATURAL VARIABLE ! 6767: < PPM IOP00 JUMP IF NULL ! 6768: < BRN IOP04 JUMP TO PROCESS NON-NULL ARGS ! 6769: < * ! 6770: < * NULL FILEARG1 ! 6771: < * ! 6772: < IOP00 BZE XL,IOP01 SKIP IF BOTH ARGS NULL ! 6773: < JSR IOPPF PROCESS FILEARG2 ! 6774: < JSR SYSFC CALL FOR FILEARG2 CHECK ! 6775: < PPM IOP16 FAIL ! 6776: < BRN IOP11 COMPLETE FILE ASSOCIATION ! 6777: 18859a17522,17538 ! 6778: > * FIRST ARG NAME ! 6779: > * I I ! 6780: > * +------+ ! 6781: > * I I-----+ ! 6782: > * +------+ V ! 6783: > * I I +----------------+ ! 6784: > * I =B$TRT I ! 6785: > * +----------------+ ! 6786: > * I =TRTIN/=TRTOU I ! 6787: > * +----------------+ ! 6788: > * I VALUE OR TRCHN + ! 6789: > * +----------------+ ! 6790: > * TRTER I I-----+ ! 6791: > * +----------------+ V ! 6792: > * TRTRI I 0 I +------+ ! 6793: > * +----------------+ I I SVBLK ! 6794: > * I/O TRACE BLOCK +------+ ! 6795: 18861c17540 ! 6796: < * IOPUT (CONTINUED) ! 6797: --- ! 6798: > * 1. ASSOCIATION TO STANDARD FILES. ! 6799: 18863c17542,17558 ! 6800: < * HERE WITH 0 OR FCBLK PTR IN (XL) ! 6801: --- ! 6802: > * FIRST ARG NAME FILETAG VRBLK ! 6803: > * I I I I ! 6804: > * +------+ LK1 +------+ LK2 ! 6805: > * I I---+ +---+ I I---+ ! 6806: > * +------+ V I V +------+ V ! 6807: > * I I +----------------+ I +----------------+ ! 6808: > * I =B$TRT I I I =B$TRT I ! 6809: > * +----------------+ I +----------------+ ! 6810: > * I =TRTIN/=TRTOU I I I =TRTIO I ! 6811: > * +----------------+ I +----------------+ ! 6812: > * I VALUE OR TRCHN I I I VALUE OR TRCHN I ! 6813: > * +----------------+ I +----------------+ ! 6814: > * TRTER I 0 I I I 0 OR IOTAG I TRTAG ! 6815: > * +----------------+ I +----------------+ ! 6816: > * TRTRI I I--+ I 0 I TRTRI ! 6817: > * +----------------+ +----------------+ ! 6818: > * I/O TRACE BLOCK TRTIO BLOCK ! 6819: 18865,18875c17560 ! 6820: < IOP01 MOV IOPTT,WB GET TRACE TYPE ! 6821: < MOV R$IOT,XR GET 0 OR TRTRF PTR ! 6822: < JSR TRBLD BUILD TRBLK ! 6823: < MOV XR,WC COPY TRBLK POINTER ! 6824: < MOV (XS)+,XR GET VARIABLE FROM STACK ! 6825: < JSR GTVAR POINT TO VARIABLE ! 6826: < PPM IOP15 FAIL ! 6827: < MOV XL,R$ION SAVE NAME POINTER ! 6828: < MOV XL,XR COPY NAME POINTER ! 6829: < ADD WA,XR POINT TO VARIABLE ! 6830: < SUB *VRVAL,XR SUBTRACT OFFSET,MERGE INTO LOOP ! 6831: --- ! 6832: > * 2. REGULAR CASE. ! 6833: 18877,18902c17562,17579 ! 6834: < * LOOP TO END OF TRBLK CHAIN IF ANY ! 6835: < * ! 6836: < IOP02 MOV XR,XL COPY BLK PTR ! 6837: < MOV VRVAL(XR),XR LOAD PTR TO NEXT TRBLK ! 6838: < BNE (XR),=B$TRT,IOP03 JUMP IF NOT TRAPPED ! 6839: < BNE TRTYP(XR),IOPTT,IOP02 LOOP IF NOT SAME ASSOCN ! 6840: < MOV TRNXT(XR),XR GET VALUE AND DELETE OLD TRBLK ! 6841: < * ! 6842: < * IOPUT (CONTINUED) ! 6843: < * ! 6844: < * STORE NEW ASSOCIATION ! 6845: < * ! 6846: < IOP03 MOV WC,VRVAL(XL) LINK TO THIS TRBLK ! 6847: < MOV WC,XL COPY POINTER ! 6848: < MOV XR,TRNXT(XL) STORE VALUE IN TRBLK ! 6849: < MOV R$ION,XR RESTORE POSSIBLE VRBLK POINTER ! 6850: < MOV WA,WB KEEP OFFSET TO NAME ! 6851: < JSR SETVR IF VRBLK, SET VRGET,VRSTO ! 6852: < MOV R$IOT,XR GET 0 OR TRTRF PTR ! 6853: < BNZ XR,IOP19 JUMP IF TRTRF BLOCK EXISTS ! 6854: < EXI RETURN TO CALLER ! 6855: < * ! 6856: < * NON STANDARD FILE ! 6857: < * SEE IF AN FCBLK HAS ALREADY BEEN ALLOCATED. ! 6858: < * ! 6859: < IOP04 ZER WA IN CASE NO FCBLK FOUND ! 6860: --- ! 6861: > * THE STRUCTURES BUILT FOR I/O ASSOCIATIONS ARE AS SHOWN ! 6862: > * ABOVE. A TRACE BLOCK CHAIN (TRCHN) MAY HOLD ANY OR ALL ! 6863: > * OF THE TYPES, =TRTIN, =TRTOU, =TRTIO, BUT NOT MORE THAN ! 6864: > * ONE BLOCK OF ANY GIVEN TYPE. CASES ARE - ! 6865: > * 1. NO FILETAG OR IOTAG IS USED FOR ASSOCIATING STANDARD ! 6866: > * FILES (SYSRD, SYSPR, TERMINAL). THE I/O TRACE BLOCK ! 6867: > * IS DISTINGUISHED BY A NON-NULL TRTER FIELD POINTING ! 6868: > * TO THE RELEVANT SVBLK (V$INP, V$OUP, V$TER) AND A ! 6869: > * ZERO TRTRI FIELD. FOR TERMINAL, TRBLKS OF BOTH ! 6870: > * INPUT AND OUTPUT TYPE ARE CHAINED FROM THE FIRST ARG ! 6871: > * VIA THE TRCHN FIELD. ! 6872: > * 2. THE I/O TRACE BLOCK FOR THE REGULAR CASE HAS A ZERO ! 6873: > * TRTER FIELD AND A POINTER TO A TRTIO BLOCK IS IN ! 6874: > * THE TRTRI FIELD. THE FILETAG MUST BE A NATURAL ! 6875: > * VARIABLE AND THE TRTIO TRACE BLOCK ATTACHED TO IT ! 6876: > * HOLDS THE IOTAG. ! 6877: > * THE EFFECT OF ENDFILE() IS TO CLEAR IOTAG AND BREAK LK2. ! 6878: > * THE EFFECT OF DETACH() IS TO BREAK LK1. ! 6879: 18903a17581,17586 ! 6880: > IOPUT PRC N,4 ENTRY POINT ! 6881: > MOV WB,IOPWB KEEP ASSOCIATION TYPE FLAG ! 6882: > JSR GTSTG CONVERT THIRD ARG TO STRING ! 6883: > PPM IOP12 FAIL THIRD ARG ! 6884: > BNZ WA,IOP01 SKIP IF NON NULL ! 6885: > ZER XR NOTE NULL ARG ! 6886: 18905c17588 ! 6887: < * IOPUT (CONTINUED) ! 6888: --- ! 6889: > * PROCESS SECOND ARG ! 6890: 18907,18950c17590,17610 ! 6891: < * SEARCH POSSIBLE TRBLK CHAIN TO PICK UP THE FCBLK ! 6892: < * ! 6893: < IOP05 MOV XR,WB REMEMBER BLK PTR ! 6894: < MOV VRVAL(XR),XR CHAIN ALONG ! 6895: < BNE (XR),=B$TRT,IOP06 JUMP IF END OF TRBLK CHAIN ! 6896: < BNE TRTYP(XR),=TRTFC,IOP05 LOOP IF MORE TO GO ! 6897: < MOV XR,R$IOT POINT TO FILE ARG1 TRBLK ! 6898: < MOV TRFPT(XR),WA GET FCBLK PTR FROM TRBLK ! 6899: < * ! 6900: < * WA = 0 OR FCBLK PTR ! 6901: < * WB = PTR TO PRECEDING BLK TO WHICH ANY TRTRF BLOCK ! 6902: < * FOR FILE ARG1 MUST BE CHAINED. ! 6903: < * ! 6904: < IOP06 MOV WA,R$IOF KEEP POSSIBLE FCBLK PTR ! 6905: < MOV WB,R$IOP KEEP PRECEDING BLK PTR ! 6906: < JSR IOPPF PROCESS FILEARG2 ! 6907: < JSR SYSFC SEE IF FCBLK REQUIRED ! 6908: < PPM IOP16 FAIL ! 6909: < BZE WA,IOP12 SKIP IF NO NEW FCBLK WANTED ! 6910: < BLT WC,=NUM02,IOP6A JUMP IF FCBLK IN DYNAMIC ! 6911: < JSR ALOST GET IT IN STATIC ! 6912: < BRN IOP6B SKIP ! 6913: < * ! 6914: < * OBTAIN FCBLK IN DYNAMIC ! 6915: < * ! 6916: < IOP6A JSR ALLOC GET SPACE FOR FCBLK ! 6917: < * ! 6918: < * MERGE ! 6919: < * ! 6920: < IOP6B MOV XR,XL POINT TO FCBLK ! 6921: < MOV WA,WB COPY ITS LENGTH ! 6922: < BTW WB GET COUNT AS WORDS (SGD APR80) ! 6923: < LCT WB,WB LOOP COUNTER ! 6924: < * ! 6925: < * CLEAR FCBLK ! 6926: < * ! 6927: < IOP07 ZER (XR)+ CLEAR A WORD ! 6928: < BCT WB,IOP07 LOOP ! 6929: < BEQ WC,=NUM02,IOP09 SKIP IF IN STATIC - DONT SET FIELDS ! 6930: < MOV =B$XNT,(XL) STORE XNBLK CODE IN CASE ! 6931: < MOV WA,1(XL) STORE LENGTH ! 6932: < BNZ WC,IOP09 JUMP IF XNBLK WANTED ! 6933: < MOV =B$XRT,(XL) XRBLK CODE REQUESTED ! 6934: < * ! 6935: --- ! 6936: > IOP01 MOV XR,R$IOR KEEP FILEPROPS STRING PTR ! 6937: > JSR IOFTG CHECK SECOND ARG ! 6938: > PPM IOP07 FAIL SECOND ARG ! 6939: > MOV XL,R$IOL KEEP SCBLK FOR FILETAG ! 6940: > MOV XR,R$IOT KEEP TRTIO BLK PTR ! 6941: > MOV WA,IOPWA KEEP IOTAG ! 6942: > MOV WB,IOPVR KEEP FILETAG VRBLK PTR ! 6943: > MOV WC,IOPWC KEEP FILETAG VALUE ! 6944: > MOV (XS)+,XR GET FIRST ARG OFF STACK ! 6945: > JSR GTVAR CONVERT TO NAME ! 6946: > PPM IOP13 FAIL FIRST ARG ! 6947: > MOV XL,R$IO1 SAVE FIRST ARG NAME BASE ADRS ! 6948: > MOV WA,IOPNF SAVE FIRST ARG NAME OFFSET ! 6949: > MOV WB,XR FILETAG VRBLK PTR ! 6950: > BNZ VRLEN(XR),IOP02 NOT SPECIAL CASE IF NOT SYS NAME ! 6951: > MOV VRSVP(XR),WC GET SVBLK PTR ! 6952: > MOV =TRTIN,WB IN CASE .INPUT ! 6953: > BEQ WC,=V$INP,IOP06 JUMP IF .INPUT ! 6954: > MOV =TRTOU,WB IN CASE .OUTPUT OR .TERMINAL ! 6955: > BEQ WC,=V$OUP,IOP08 JUMP IF .OUTPUT ! 6956: > BEQ WC,=V$TER,IOP09 JUMP IF .TERMINAL ! 6957: 18952d17611 ! 6958: < * IOPUT (CONTINUED) ! 6959: 18954c17613 ! 6960: < * COMPLETE FCBLK INITIALISATION ! 6961: --- ! 6962: > * NORMAL CASE ! 6963: 18956,18958c17615,17624 ! 6964: < IOP09 MOV R$IOT,XR GET POSSIBLE TRBLK PTR ! 6965: < MOV XL,R$IOF STORE FCBLK PTR ! 6966: < BNZ XR,IOP10 JUMP IF TRBLK ALREADY FOUND ! 6967: --- ! 6968: > IOP02 BNZ R$IOT,IOP03 SKIP IF TRTIO BLK EXISTS ALREADY ! 6969: > MOV =TRTIO,WB TRACE BLOCK TYPE WORD ! 6970: > ZER XR ZERO IOTAG WORD ! 6971: > ZER XL ZERO TRTRI FIELD ! 6972: > JSR TRBLD BUILD TRTIO TRBLK ! 6973: > MOV XR,R$IOT SAVE TRTIO BLK PTR ! 6974: > MOV IOPVR,XL GET FILETAG VRBLK ! 6975: > MOV *VRVAL,WA OFFSET TO VALUE FIELD ! 6976: > JSR TRCHN PLACE IN TRBLK CHAIN FOR FILETAG ! 6977: > PPM UNUSED RETURN ! 6978: 18960c17626 ! 6979: < * A NEW TRBLK IS NEEDED ! 6980: --- ! 6981: > * MERGE TO BUILD TRBLK FOR FIRST ARG ! 6982: 18962,18970c17628,17630 ! 6983: < MOV =TRTFC,WB TRTYP FOR FCBLK TRAP BLK ! 6984: < JSR TRBLD MAKE THE BLOCK ! 6985: < MOV XR,R$IOT COPY TRTRF PTR ! 6986: < MOV R$IOP,XL POINT TO PRECEDING BLK ! 6987: < MOV VRVAL(XL),VRVAL(XR) COPY VALUE FIELD TO TRBLK ! 6988: < MOV XR,VRVAL(XL) LINK NEW TRBLK INTO CHAIN ! 6989: < MOV XL,XR POINT TO PREDECESSOR BLK ! 6990: < JSR SETVR SET TRACE INTERCEPTS ! 6991: < MOV VRVAL(XR),XR RECOVER TRBLK PTR ! 6992: --- ! 6993: > IOP03 MOV =TRTIN,WB IN CASE INPUT ! 6994: > BZE IOPWB,IOP04 SKIP IF SO ! 6995: > MOV =TRTOU,WB IN CASE OUTPUT ! 6996: 18972c17632 ! 6997: < * XR IS PTR TO TRBLK, XL IS FCBLK PTR OR 0 ! 6998: --- ! 6999: > * BUILD TRACE BLOCK ! 7000: 18974c17634,17641 ! 7001: < IOP10 MOV R$IOF,TRFPT(XR) STORE FCBLK PTR ! 7002: --- ! 7003: > IOP04 ICV IOPWB NOTE NOT STANDARD I/O FILE ! 7004: > MOV R$IOT,XL TRTIO BLK PTR TO TRTRI FIELD ! 7005: > ZER XR ZERO TRTER FIELD ! 7006: > JSR TRBLD BUILD I/O TRACE BLOCK ! 7007: > MOV R$IO1,XL ASSOCIATED VBL NAME BASE ! 7008: > MOV IOPNF,WA NAME OFFSET ! 7009: > JSR TRCHN UPDATE TRACE CHAIN FOR FIRST ARG ! 7010: > PPM UNUSED RETURN ! 7011: 18976c17643 ! 7012: < * CALL SYSIO TO COMPLETE FILE ACCESSING ! 7013: --- ! 7014: > * PREPARE FOR AND MAKE SYSIO CALL ! 7015: 18978,19003c17645,17656 ! 7016: < IOP11 MOV R$IOF,WA COPY FCBLK PTR OR 0 ! 7017: < MOV IOPTT,WB GET INPUT/OUTPUT FLAG ! 7018: < MOV R$IO2,XR GET FILE ARG2 ! 7019: < MOV R$IO1,XL GET FILE ARG1 ! 7020: < JSR SYSIO ASSOCIATE TO THE FILE ! 7021: < PPM IOP17 FAIL ! 7022: < PPM IOP18 FAIL ! 7023: < BNZ R$IOT,IOP01 NOT STD INPUT IF NON-NULL TRTRF BLK ! 7024: < BNZ IOPTT,IOP01 JUMP IF OUTPUT ! 7025: < BZE WC,IOP01 NO CHANGE TO STANDARD READ LENGTH ! 7026: < MOV WC,CSWIN STORE NEW READ LENGTH FOR STD FILE ! 7027: < BRN IOP01 MERGE TO FINISH THE TASK ! 7028: < * ! 7029: < * SYSFC MAY HAVE RETURNED A POINTER TO A PRIVATE FCBLK ! 7030: < * ! 7031: < IOP12 BNZ XL,IOP09 JUMP IF PRIVATE FCBLK ! 7032: < BRN IOP11 FINISH THE ASSOCIATION ! 7033: < * ! 7034: < * FAILURE RETURNS ! 7035: < * ! 7036: < IOP13 EXI 1 3RD ARG NOT A STRING ! 7037: < IOP14 EXI 2 2ND ARG UNSUITABLE ! 7038: < IOP15 EXI 3 1ST ARG UNSUITABLE ! 7039: < IOP16 EXI 4 FILE SPEC WRONG ! 7040: < IOP17 EXI 5 I/O FILE DOES NOT EXIST ! 7041: < IOP18 EXI 6 I/O FILE CANNOT BE READ/WRITTEN ! 7042: --- ! 7043: > IOP05 MOV R$IOL,XL FILETAG SCBLK PTR ! 7044: > MOV R$IOR,XR FILEPROPS SCBLK PTR ! 7045: > MOV IOPWA,WA IOTAG OR ZERO ! 7046: > MOV IOPWB,WB ASSOCIATION TYPE NUMBER ! 7047: > MOV IOPWC,WC POSSIBLE FILETAG VALUE ! 7048: > JSR SYSIO CALL SYSTEM ROUTINE TO OPEN FILE ! 7049: > PPM IOP14 FAIL RETURN ! 7050: > PPM EROSI ERROR RETURN ! 7051: > MOV R$IOT,XL TRTIO POINTER ! 7052: > BZE XL,IOP11 DONE IF ZERO ! 7053: > MOV WA,TRTAG(XL) STORE RETURNED IOTAG ! 7054: > BRN IOP11 SUCCEED ! 7055: 19006c17659 ! 7056: < * IOPUT (CONTINUED) ! 7057: --- ! 7058: > * SPECIAL CASE OF .INPUT ! 7059: 19008,19009c17661 ! 7060: < * ADD TO IOCHN CHAIN OF ASSSOCIATED VARIABLES UNLESS ALREAD ! 7061: < * PRESENT. ! 7062: --- ! 7063: > IOP06 BZE IOPWB,IOP09 FAIL OUTPUT(.X,.INPUT) ! 7064: 19011c17663 ! 7065: < IOP19 MOV R$ION,WC WC = NAME BASE, WB = NAME OFFSET ! 7066: --- ! 7067: > * BAD FILETAG ! 7068: 19013c17665 ! 7069: < * SEARCH LOOP ! 7070: --- ! 7071: > IOP07 EXI 2 ERRONEOUS SECOND ARG ! 7072: 19015,19019c17667 ! 7073: < IOP20 MOV TRTRF(XR),XR NEXT LINK OF CHAIN ! 7074: < BZE XR,IOP21 NOT FOUND ! 7075: < BNE WC,IONMB(XR),IOP20 NO MATCH ! 7076: < BEQ WB,IONMO(XR),IOP22 EXIT IF MATCHED ! 7077: < BRN IOP20 LOOP ! 7078: --- ! 7079: > * SPECIAL CASE OF .OUTPUT ! 7080: 19021c17669 ! 7081: < * NOT FOUND ! 7082: --- ! 7083: > IOP08 BZE IOPWB,IOP07 FAIL INPUT(.X,.OUTPUT) ! 7084: 19023,19032c17671 ! 7085: < IOP21 MOV *NUM05,WA SPACE NEEDED ! 7086: < JSR ALLOC GET IT ! 7087: < MOV =B$XRT,(XR) STORE XRBLK CODE ! 7088: < MOV WA,1(XR) STORE LENGTH ! 7089: < MOV WC,IONMB(XR) STORE NAME BASE ! 7090: < MOV WB,IONMO(XR) STORE NAME OFFSET ! 7091: < MOV R$IOT,XL POINT TO TRTRF BLK ! 7092: < MOV TRTRF(XL),WA GET PTR FIELD CONTENTS ! 7093: < MOV XR,TRTRF(XL) STORE PTR TO NEW BLOCK ! 7094: < MOV WA,TRTRF(XR) COMPLETE THE LINKING ! 7095: --- ! 7096: > * SPECIAL CASE OF .TERMINAL AND MERGE FOR OTHERS ! 7097: 19034c17673,17685 ! 7098: < * INSERT FCBLK ON FCBLK CHAIN FOR SYSEJ, SYSXI ! 7099: --- ! 7100: > IOP09 ZER R$IOT NOTE NO TRTIO BLOCK ! 7101: > MOV WC,XR SVBLK PTR FOR TRTER FIELD ! 7102: > ZER XL ZERO TRTRI FIELD ! 7103: > JSR TRBLD BUILD TRBLK ! 7104: > MOV R$IO1,XL ASSOCIATED VBL NAME BASE ! 7105: > MOV IOPNF,WA NAME OFFSET ! 7106: > JSR TRCHN UPDATE TRACE CHAIN FOR ARG 1 ! 7107: > PPM UNUSED RETURN ! 7108: > BNE TRTER(XR),=V$TER,IOP10 DONE UNLESS TERMINAL ! 7109: > BNE TRTYP(XR),=TRTOU,IOP10 DONE IF TERM. 2ND TIME ROUND ! 7110: > MOV =V$TER,WC TRTER FIELD ! 7111: > MOV =TRTIN,WB TRTYP FIELD ! 7112: > BRN IOP09 REPEAT LOOP FOR TERMINAL ! 7113: 19036,19037c17687 ! 7114: < IOP22 BZE R$IOF,IOP25 SKIP IF NO FCBLK ! 7115: < MOV R$FCB,XL PTR TO HEAD OF EXISTING CHAIN ! 7116: --- ! 7117: > * CHECK SPECIAL CASES FOR NON-NULL THIRD ARGS ! 7118: 19039c17689,17690 ! 7119: < * SEE IF FCBLK ALREADY ON CHAIN ! 7120: --- ! 7121: > IOP10 ZER IOPWA NO IOTAG ! 7122: > BNZ R$IOR,IOP05 MERGE ONLY IF FILEPROPS NON-NULL ! 7123: 19041,19044c17692 ! 7124: < IOP23 BZE XL,IOP24 NOT ON IF END OF CHAIN ! 7125: < BEQ 3(XL),R$IOF,IOP25 DONT DUPLICATE IF FIND IT ! 7126: < MOV 2(XL),XL GET NEXT LINK ! 7127: < BRN IOP23 LOOP ! 7128: --- ! 7129: > * SUCCESS RETURN ! 7130: 19046c17694,17698 ! 7131: < * NOT FOUND SO ADD AN ENTRY FOR THIS FCBLK ! 7132: --- ! 7133: > IOP11 ZER R$IO1 CLEAR GARBAGE ! 7134: > ZER R$IOL ! 7135: > ZER R$IOR ! 7136: > ZER R$IOT ! 7137: > EXI RETURN TO CALLER ! 7138: 19048,19054c17700 ! 7139: < IOP24 MOV *NUM04,WA SPACE NEEDED ! 7140: < JSR ALLOC GET IT ! 7141: < MOV =B$XRT,(XR) STORE BLOCK CODE ! 7142: < MOV WA,1(XR) STORE LENGTH ! 7143: < MOV R$FCB,2(XR) STORE PREVIOUS LINK IN THIS NODE ! 7144: < MOV R$IOF,3(XR) STORE FCBLK PTR ! 7145: < MOV XR,R$FCB INSERT NODE INTO FCBLK CHAIN ! 7146: --- ! 7147: > * ERROR RETURNS ! 7148: 19056c17702 ! 7149: < * RETURN ! 7150: --- ! 7151: > IOP12 EXI 1 ERRONEOUS THIRD ARG ! 7152: 19058c17704,17706 ! 7153: < IOP25 EXI RETURN TO CALLER ! 7154: --- ! 7155: > IOP13 EXI 3 ERRONEOUS FIRST ARG ! 7156: > * ! 7157: > IOP14 EXI 4 FAIL RETURN FROM SYSIO ! 7158: 19098,19099c17746 ! 7159: < JSR PRTVL PRINT KEYWORD VALUE ! 7160: < JSR PRTNL TERMINATE PRINT LINE ! 7161: --- ! 7162: > JSR PRTVF PRINT KEYWORD VALUE ! 7163: 19144c17791 ! 7164: < KWNM1 ERB 251,KEYWORD OPERAND IS NOT NAME OF DEFINED KEYWORD ! 7165: --- ! 7166: > KWNM1 ERB 230,KEYWORD OPERAND IS NOT NAME OF DEFINED KEYWORD ! 7167: 19173c17820 ! 7168: < BLO WA,WB,LCMP1 JUMP IF ARG 1 LENGTH IS SMALLER ! 7169: --- ! 7170: > BLO WA,WB,LCMP0 JUMP IF ARG 1 LENGTH IS SMALLER ! 7171: 19178,19179c17825,17830 ! 7172: < LCMP1 CMC LCMP4,LCMP3 COMPARE STRINGS, JUMP IF UNEQUAL ! 7173: < BNE WB,WC,LCMP2 IF EQUAL, JUMP IF LENGTHS UNEQUAL ! 7174: --- ! 7175: > LCMP0 BZE WA,LCMP1 SKIP IF A NULL ARG ! 7176: > CMC LCMP4,LCMP3 COMPARE STRINGS, JUMP IF UNEQUAL ! 7177: > * ! 7178: > * EQUAL STRINGS OR AT LEAST ONE NULL ARG ! 7179: > * ! 7180: > LCMP1 BNE WB,WC,LCMP2 IF EQUAL, JUMP IF LENGTHS UNEQUAL ! 7181: 19239c17890,17897 ! 7182: < BNZ CNTTL,LIST5 JUMP IF -TITLE OR -STITL ! 7183: --- ! 7184: > MOV STAGE,WA GET COMPILER STAGE ! 7185: > BEQ WA,=STGIC,LIST0 LIST OK IF INITIAL COMPILE ! 7186: > BEQ WA,=STGCE,LIST0 LIST OK IF END LINE ! 7187: > BRN LIST4 ELSE NO LISTING OF SOURCE ! 7188: > * ! 7189: > * HERE WHEN STAGE IS OK TO LIST ! 7190: > * ! 7191: > LIST0 BNZ CNTTL,LIST5 JUMP IF -TITLE OR -STITL ! 7192: 19245c17903 ! 7193: < LIST0 MOV R$CIM,XR LOAD POINTER TO CURRENT IMAGE ! 7194: --- ! 7195: > LIST1 MOV R$CIM,XR LOAD POINTER TO CURRENT IMAGE ! 7196: 19251d17908 ! 7197: < BNE STAGE,=STGIC,LIST1 SKIP IF EXECUTE TIME ! 7198: 19254,19257c17911 ! 7199: < * ! 7200: < * PRINT STATEMENT NUMBER ! 7201: < * ! 7202: < LIST1 JSR PRTIN ELSE PRINT STATEMENT NUMBER ! 7203: --- ! 7204: > JSR PRTIN ELSE PRINT STATEMENT NUMBER ! 7205: 19267c17921 ! 7206: < JSR PRTST PRINT IT ! 7207: --- ! 7208: > JSR PRTSF PRINT IT ! 7209: 19269,19273c17923 ! 7210: < BNZ ERLST,LIST3 JUMP IF ERROR COPY TO INT.CH. ! 7211: < JSR PRTNL TERMINATE LINE ! 7212: < BZE CSWDB,LIST3 JUMP IF -SINGLE MODE ! 7213: < JSR PRTNL ELSE ADD A BLANK LINE ! 7214: < ICV LSTLC AND BUMP LINE COUNTER ! 7215: --- ! 7216: > MNZ LSTPF SET FLAG FOR LINE PRINTED ! 7217: 19275,19278d17924 ! 7218: < * HERE AFTER PRINTING SOURCE IMAGE ! 7219: < * ! 7220: < LIST3 MNZ LSTPF SET FLAG FOR LINE PRINTED ! 7221: < * ! 7222: 19290,19291c17936,17937 ! 7223: < BZE PRICH,LIST7 SKIP IF LISTING TO REGULAR PRINTER ! 7224: < BEQ R$TTL,=NULLS,LIST0 TERMINAL LISTING OMITS NULL TITLE ! 7225: --- ! 7226: > BNZ PRLEN,LIST7 SKIP IF LISTING TO REGULAR PRINTER ! 7227: > BEQ R$TTL,=NULLS,LIST1 TERMINAL LISTING OMITS NULL TITLE ! 7228: 19296c17942 ! 7229: < BRN LIST0 MERGE ! 7230: --- ! 7231: > BRN LIST1 MERGE ! 7232: 19316c17962 ! 7233: < JSR PRTNL TERMINATE TITLE LINE ! 7234: --- ! 7235: > JSR PRTFH TERMINATE TITLE LINE ! 7236: 19323,19324c17969 ! 7237: < JSR PRTST ELSE PRINT SUB-TITLE ! 7238: < JSR PRTNL TERMINATE LINE ! 7239: --- ! 7240: > JSR PRTSF ELSE PRINT SUB-TITLE ! 7241: 19329c17974 ! 7242: < LSTT1 JSR PRTNL PRINT A BLANK LINE ! 7243: --- ! 7244: > LSTT1 JSR PRTFH PRINT A BLANK LINE ! 7245: 19358c18003 ! 7246: < BZE CSWLS,NXTS2 JUMP IF -NOLIST ! 7247: --- ! 7248: > BZE CSWLS,NXTS1 JUMP IF -NOLIST ! 7249: 19360c18005 ! 7250: < BZE XR,NXTS2 JUMP IF NO IMAGE ! 7251: --- ! 7252: > BZE XR,NXTS1 JUMP IF NO IMAGE ! 7253: 19363,19364c18008,18009 ! 7254: < BNE WA,=CH$MN,NXTS1 JUMP IF NOT CTRL CARD ! 7255: < BZE CSWPR,NXTS2 JUMP IF -NOPRINT ! 7256: --- ! 7257: > BEQ WA,=CH$MN,NXTS1 SKIP LISTING IF CONTROL CARD ! 7258: > JSR LISTR LIST LINE ! 7259: 19366,19369d18010 ! 7260: < * HERE TO CALL LISTER ! 7261: < * ! 7262: < NXTS1 JSR LISTR LIST LINE ! 7263: < * ! 7264: 19372c18013 ! 7265: < NXTS2 MOV R$CNI,XR POINT TO NEXT IMAGE ! 7266: --- ! 7267: > NXTS1 MOV R$CNI,XR POINT TO NEXT IMAGE ! 7268: 19377c18018 ! 7269: < BLO WA,WB,NXTS3 SKIP IF NOT TOO LONG ! 7270: --- ! 7271: > BLO WA,WB,NXTS2 SKIP IF NOT TOO LONG ! 7272: 19382c18023 ! 7273: < NXTS3 MOV WA,SCNIL USE AS RECORD LENGTH ! 7274: --- ! 7275: > NXTS2 MOV WA,SCNIL USE AS RECORD LENGTH ! 7276: 19505c18146 ! 7277: < WTB WA CONVERT TO BYTE OFFSET ! 7278: --- ! 7279: > WTB WA CONVERT TO BAU OFFSET ! 7280: 19697d18337 ! 7281: < EJC ! 7282: 19699a18340 ! 7283: > EJC ! 7284: 19714,19716c18355 ! 7285: < JSR PRTST AND PRINT IT ! 7286: < JSR PRTNL FOLLOWED BY NEWLINE ! 7287: < JSR PRTNL AND ANOTHER ! 7288: --- ! 7289: > JSR PRTFB AND PRINT IT ! 7290: 19718,19719c18357 ! 7291: < JSR PRTST PRINT IT ! 7292: < JSR PRTNL NEW LINE ! 7293: --- ! 7294: > JSR PRTSF PRINT IT ! 7295: 19721,19723c18359 ! 7296: < JSR PRTST PRINT IT ! 7297: < JSR PRTNL NEW LINE ! 7298: < JSR PRTNL AND ANOTHER BLANK LINE ! 7299: --- ! 7300: > JSR PRTFB ! 7301: 19726c18362,18363 ! 7302: < ADD *NUM02,XR BIAS PAST XNBLK HEADER (SGD07) ! 7303: --- ! 7304: > ADD *NUM02,XR BIASS PAST XNBLK HEADER ! 7305: > EJC ! 7306: 19728c18365 ! 7307: < * LOOP HERE TO PRINT SUCCESSIVE ENTRIES ! 7308: --- ! 7309: > * PRFLR (CONTINUED) ! 7310: 19729a18367,18368 ! 7311: > * LOOP FOR PRINTING TABLE ENTRIES ! 7312: > * ! 7313: 19748c18387 ! 7314: < * MERGE AFTER PRINTING TIME ! 7315: --- ! 7316: > * PRINT A BLANK ! 7317: 19750c18389 ! 7318: < PRFL2 JSR PRTNL THATS ANOTHER LINE ! 7319: --- ! 7320: > PRFL2 JSR PRTFH THATS ANOTHER LINE ! 7321: 19752c18391 ! 7322: < * HERE TO GO TO NEXT ENTRY ! 7323: --- ! 7324: > * TEST TO SEE IF LOOP FINISHED ! 7325: 19754c18393 ! 7326: < PRFL3 ADD *PF$I2,XR BUMP INDEX PTR (SGD07) ! 7327: --- ! 7328: > PRFL3 ADD *PF$I2,XR BUMP INDEX POINTER ! 7329: 19759c18398 ! 7330: < * HERE TO EXIT ! 7331: --- ! 7332: > * RETURN POINT ! 7333: 19775c18414 ! 7334: < MOV WA,PFSVW SAVE WA (SGD07) ! 7335: --- ! 7336: > MOV WA,PFSVW SAVE WA ! 7337: 19786c18425 ! 7338: < SUB =NUM01,PFNTE ADJUST FOR EXTRA COUNT (SGD07) ! 7339: --- ! 7340: > SUB =NUM01,PFNTE ADJUST FOR EXTRA COUNT ! 7341: 19804c18443,18444 ! 7342: < BCT WA,PFLU1 AND ALLLLLLL THE REST ! 7343: --- ! 7344: > BCT WA,PFLU1 AND ALL THE REST ! 7345: > EJC ! 7346: 19805a18446,18447 ! 7347: > * PRFLU (CONTINUED) ! 7348: > * ! 7349: 19828c18470 ! 7350: < * MERGE HERE TO EXIT ! 7351: --- ! 7352: > * RETURN POINT ! 7353: 19831c18473 ! 7354: < MOV PFSVW,WA RESTORE SAVED REG ! 7355: --- ! 7356: > MOV PFSVW,WA RESTORE WA ! 7357: 19841d18482 ! 7358: < EJC ! 7359: 19842a18484 ! 7360: > EJC ! 7361: 19844c18486 ! 7362: < * PRPAR - PROCESS PRINT PARAMETERS ! 7363: --- ! 7364: > * PRPAR -- PROCESS PRINT PARAMETERS ! 7365: 19846d18487 ! 7366: < * (WC) IF NONZERO ASSOCIATE TERMINAL ONLY ! 7367: 19848c18489 ! 7368: < * (XL,XR,WA,WB,WC) DESTROYED ! 7369: --- ! 7370: > * (XR,WA,WB,WC) DESTROYED ! 7371: 19850,19853d18490 ! 7372: < * SINCE MEMORY ALLOCATION IS UNDECIDED ON INITIAL CALL, ! 7373: < * TERMINAL CANNOT BE ASSOCIATED. THE ENTRY WITH WC NON-ZERO ! 7374: < * IS PROVIDED SO A LATER CALL CAN BE MADE TO COMPLETE THIS. ! 7375: < * ! 7376: 19855c18492 ! 7377: < BNZ WC,PRPA7 JUMP TO ASSOCIATE TERMINAL ! 7378: --- ! 7379: > MOV XL,-(XS) SAVE XL ! 7380: 19866,19868c18503,18504 ! 7381: < MOV PRLEN,WB GET PRIOR LENGTH IF ANY ! 7382: < BZE WB,PRPA2 SKIP IF NO LENGTH ! 7383: < BGT WA,WB,PRPA3 SKIP STORING IF TOO BIG ! 7384: --- ! 7385: > BZE PRLEN,PRPA2 SKIP IF NOT SYSXI RESUMPTION ! 7386: > BHI WA,PRLEN,PRPA3 SKIP IF BIGGER THAN PRIOR BFRS ! 7387: 19874c18510 ! 7388: < * PROCESS BITS OPTIONS ! 7389: --- ! 7390: > * CHECK TERMINAL BUFFER SIZE ! 7391: 19876,19879c18512,18513 ! 7392: < PRPA3 MOV BITS3,WB BIT 3 MASK ! 7393: < ANB WC,WB GET -NOLIST BIT ! 7394: < ZRB WB,PRPA4 SKIP IF CLEAR ! 7395: < ZER CSWLS SET -NOLIST ! 7396: --- ! 7397: > PRPA3 BZE TTLEN,PRPA4 SKIP IF NOT SYSXI RESUMPTION ! 7398: > BHI XL,TTLEN,PRPA5 SKIP IF TOO BIG ! 7399: 19881c18515 ! 7400: < * CHECK IF FAIL REPORTS GOTO INTERACTIVE CHANNEL ! 7401: --- ! 7402: > * STORE TERMINAL BUFFER LENGTH ! 7403: 19883c18517,18521 ! 7404: < PRPA4 MOV BITS1,WB BIT 1 MASK ! 7405: --- ! 7406: > PRPA4 MOV XL,TTLEN BFR LENGTH ! 7407: > * ! 7408: > * PROCESS BITS OPTIONS ! 7409: > * ! 7410: > PRPA5 MOV BITS1,WB BIT 1 MASK ! 7411: 19885c18523 ! 7412: < MOV WB,ERICH STORE INT. CHAN. ERROR FLAG ! 7413: --- ! 7414: > MOV WB,TTINS INPUT FROM TERMINAL FLAG ! 7415: 19888,19894c18526,18533 ! 7416: < MOV WB,PRICH FLAG FOR STD PRINTER ON INT. CHAN. ! 7417: < MOV BITS4,WB BIT 4 MASK ! 7418: < ANB WC,WB GET BIT ! 7419: < MOV WB,CPSTS FLAG FOR COMPILE STATS SUPPRESSN. ! 7420: < MOV BITS5,WB BIT 5 MASK ! 7421: < ANB WC,WB GET BIT ! 7422: < MOV WB,EXSTS FLAG FOR EXEC STATS SUPPRESSION ! 7423: --- ! 7424: > MOV WB,TTOUS STD OUTPUT TO TERMINAL FLAG ! 7425: > MOV TTLEN,TTERL ERRORS TO TERML IF AVAILABLE ! 7426: > MOV PRLEN,PRAVL NOTE IF A PRINT FILE IS AVAILABLE ! 7427: > ZRB WB,PRPA6 IF FLAG SET, CLEAR TTERL SINCE ... ! 7428: > ZER TTERL ... TERML GETS ALL OUTPUT ALREADY ! 7429: > MOV TTLEN,TTOUS REGULAR O/P TO TERML IF AVAILABLE ! 7430: > MOV TTLEN,PRLEN REVISED PRINT BUFFER LENGTH ! 7431: > ZER TTLEN DONT NEED SEPARATE TERML BUFFER ! 7432: 19899,19904c18538 ! 7433: < MOV BITS6,WB BIT 6 MASK ! 7434: < ANB WC,WB GET BIT ! 7435: < MOV WB,PRECL EXTENDED/COMPACT LISTING FLAG ! 7436: < SUB =NUM08,WA POINT 8 CHARS FROM LINE END ! 7437: < ZRB WB,PRPA5 JUMP IF NOT EXTENDED ! 7438: < MOV WA,LSTPO STORE FOR LISTING PAGE HEADINGS ! 7439: --- ! 7440: > * GET OFFSET TO /PAGE NN/ PART OF HEADER ! 7441: 19906c18540,18543 ! 7442: < * CONTINUE OPTION PROCESSING ! 7443: --- ! 7444: > PRPA6 MOV PRLEN,WA STD BFR LENGTH ! 7445: > BNZ WA,PRPA7 USE IF NON-ZERO ! 7446: > MOV TTLEN,WA ELSE TRY TERMINAL ! 7447: > BZE WA,PRPA8 GIVE UP IF ZERO ALSO ! 7448: 19908,19920c18545 ! 7449: < PRPA5 MOV BITS7,WB BIT 7 MASK ! 7450: < ANB WC,WB GET BIT 7 ! 7451: < MOV WB,CSWEX SET -NOEXECUTE IF NON-ZERO ! 7452: < MOV BIT10,WB BIT 10 MASK ! 7453: < ANB WC,WB GET BIT 10 ! 7454: < MOV WB,HEADP PRETEND PRINTED TO OMIT HEADERS ! 7455: < MOV BITS9,WB BIT 9 MASK ! 7456: < ANB WC,WB GET BIT 9 ! 7457: < MOV WB,PRSTO KEEP IT AS STD LISTING OPTION ! 7458: < ZRB WB,PRPA6 SKIP IF CLEAR ! 7459: < MOV PRLEN,WA GET PRINT BUFFER LENGTH ! 7460: < SUB =NUM08,WA POINT 8 CHARS FROM LINE END ! 7461: < MOV WA,LSTPO STORE PAGE OFFSET ! 7462: --- ! 7463: > * GET OFFSET ! 7464: 19922c18547,18552 ! 7465: < * CHECK FOR TERMINAL ! 7466: --- ! 7467: > PRPA7 MOV WA,PRLEN STORE AS BUFFER LENGTH ! 7468: > SUB =NUM08,WA JUST BEFORE END OF LINE ! 7469: > MOV WA,LSTPO KEEP IT ! 7470: > MOV TTOUS,WB CONSTRUCT VALUE FOR ... ! 7471: > ORB PRAVL,WB ... USE IN DECIDING WHETHER TO ... ! 7472: > MOV WB,PRPUT ... PUT STRINGS IN OUTPUT BUFFER ! 7473: 19924,19932c18554 ! 7474: < PRPA6 ANB BITS8,WC SEE IF TERMINAL TO BE ACTIVATED ! 7475: < BNZ WC,PRPA7 JUMP IF TERMINAL REQUIRED ! 7476: < BZE INITR,PRPA8 JUMP IF NO TERMINAL TO DETACH ! 7477: < MOV =V$TER,XL PTR TO /TERMINAL/ ! 7478: < JSR GTNVR GET VRBLK POINTER ! 7479: < PPM CANT FAIL ! 7480: < MOV =NULLS,VRVAL(XR) CLEAR VALUE OF TERMINAL ! 7481: < JSR SETVR REMOVE ASSOCIATION ! 7482: < BRN PRPA8 RETURN ! 7483: --- ! 7484: > * MORE BITS ! 7485: 19934c18556,18559 ! 7486: < * ASSOCIATE TERMINAL ! 7487: --- ! 7488: > PRPA8 MOV BITS3,WB BIT 3 MASK ! 7489: > ANB WC,WB GET -NOLIST BIT ! 7490: > ZRB WB,PRPA9 SKIP IF CLEAR ! 7491: > ZER CSWLS SET -NOLIST ! 7492: 19936,19945c18561 ! 7493: < PRPA7 MNZ INITR NOTE TERMINAL ASSOCIATED ! 7494: < BZE DNAMB,PRPA8 CANT IF MEMORY NOT ORGANISED ! 7495: < MOV =V$TER,XL POINT TO TERMINAL STRING ! 7496: < MOV =TRTOU,WB OUTPUT TRACE TYPE ! 7497: < JSR INOUT ATTACH OUTPUT TRBLK TO VRBLK ! 7498: < MOV XR,-(XS) STACK TRBLK PTR ! 7499: < MOV =V$TER,XL POINT TO TERMINAL STRING ! 7500: < MOV =TRTIN,WB INPUT TRACE TYPE ! 7501: < JSR INOUT ATTACH INPUT TRACE BLK ! 7502: < MOV (XS)+,VRVAL(XR) ADD OUTPUT TRBLK TO CHAIN ! 7503: --- ! 7504: > * MORE BITS ! 7505: 19947c18563,18575 ! 7506: < * RETURN POINT ! 7507: --- ! 7508: > PRPA9 MOV BITS4,WB BIT 4 MASK ! 7509: > ANB WC,WB GET BIT ! 7510: > MOV WB,CPSTS FLAG FOR COMPILE STATS SUPPRESSN. ! 7511: > MOV BITS5,WB BIT 5 MASK ! 7512: > ANB WC,WB GET BIT ! 7513: > MOV WB,EXSTS FLAG FOR EXEC STATS SUPPRESSION ! 7514: > MOV BITS6,WB BIT 6 MASK ! 7515: > ANB WC,WB GET BIT ! 7516: > MOV WB,NOXEQ SET NOEXECUTE IF NON-ZERO ! 7517: > MOV BITS7,WB BIT 7 MASK ! 7518: > ANB WC,WB GET BIT ! 7519: > ZRB WB,PRP10 SKIP IF NOT SET ! 7520: > ZER TTERL CLEAR ERRORS TO TERML IF SET ! 7521: 19949c18577,18589 ! 7522: < PRPA8 EXI RETURN ! 7523: --- ! 7524: > * MORE BITS ! 7525: > * ! 7526: > PRP10 MOV BITS8,WB BIT 8 MASK ! 7527: > ANB WC,WB GET BIT ! 7528: > MOV WB,HEADN SYSID HEADERS INCLUDE/OMIT FLAG ! 7529: > MOV BITS9,WB BIT 9 MASK ! 7530: > ANB WC,WB GET BIT ! 7531: > MOV WB,PRSTO STANDARD LISTING FLAG ! 7532: > MOV BIT10,WB BIT 10 MASK ! 7533: > ANB WC,WB GET BIT ! 7534: > MOV WB,PRECL EXTENDED LISTING OPTION ! 7535: > MOV (XS)+,XL RESTORE XL ! 7536: > EXI RETURN ! 7537: 19953c18593 ! 7538: < * PRTCH -- PRINT A CHARACTER ! 7539: --- ! 7540: > * PRTCF -- PRINT CHAR TO STD PRINTER AND FLUSH BFR ! 7541: 19954a18595,18605 ! 7542: > * (WA) CHAR TO PRINT ! 7543: > * JSR PRTCF CALL TO PRINT AND FLUSH ! 7544: > * ! 7545: > PRTCF PRC E,0 ENTRY POINT ! 7546: > JSR PRTCH PRINT CHARACTER ! 7547: > JSR PRTFH FLUSH BUFFER ! 7548: > EXI RETURN TO CALLER ! 7549: > ENP END PROCEDURE PRTCF ! 7550: > * ! 7551: > * PRTCH -- PRINT A CHARACTER ON STANDARD PRINTER ! 7552: > * ! 7553: 19960a18612 ! 7554: > BZE PRLEN,PTCH2 SKIP IF NO PRINT FILE ! 7555: 19962,19963c18614,18615 ! 7556: < BNE PROFS,PRLEN,PRCH1 JUMP IF ROOM IN BUFFER ! 7557: < JSR PRTNL ELSE PRINT THIS LINE ! 7558: --- ! 7559: > BNE PROFS,PRLEN,PTCH1 JUMP IF ROOM IN BUFFER ! 7560: > JSR PRTFH ELSE PRINT THIS LINE ! 7561: 19967c18619 ! 7562: < PRCH1 MOV PRBUF,XR POINT TO PRINT BUFFER ! 7563: --- ! 7564: > PTCH1 MOV PRBUF,XR POINT TO PRINT BUFFER ! 7565: 19973c18625,18628 ! 7566: < EXI RETURN TO PRTCH CALLER ! 7567: --- ! 7568: > * ! 7569: > * RETURN POINT ! 7570: > * ! 7571: > PTCH2 EXI RETURN TO PRTCH CALLER ! 7572: 19974a18630,18640 ! 7573: > * ! 7574: > * PRTFB -- PRINT STRING, FLUSH BFR AND PRINT BLANK LINE ! 7575: > * ! 7576: > * (XR) STRING TO PRINT ! 7577: > * JSR PRTFB CALL FOR PRINT FLUSH AND BLANK ! 7578: > * ! 7579: > PRTFB PRC E,0 ENTRY POINT ! 7580: > JSR PRTSF PRINT AND FLUSH ! 7581: > JSR PRTFH PRINT BLANK ! 7582: > EXI RETURN TO CALLER ! 7583: > ENP END PROCEDURE PRTFB ! 7584: 19977c18643 ! 7585: < * PRTIC -- PRINT TO INTERACTIVE CHANNEL ! 7586: --- ! 7587: > * PRTFH -- FLUSH STANDARD PRINT BUFFER ! 7588: 19979,19982c18645,18649 ! 7589: < * PRTIC IS CALLED TO PRINT THE CONTENTS OF THE STANDARD ! 7590: < * PRINT BUFFER TO THE INTERACTIVE CHANNEL. IT IS ONLY ! 7591: < * CALLED AFTER PRTST HAS SET UP THE STRING FOR PRINTING. ! 7592: < * IT DOES NOT CLEAR THE BUFFER. ! 7593: --- ! 7594: > * PRTFH PRINTS THE CONTENTS OF THE PRINT BUFFER, RESETS ! 7595: > * THE BUFFER TO ALL BLANKS AND RESETS THE PRINT POINTER. ! 7596: > * ON ITS FIRST CALL IT MAY PRINT LISTING HEADERS. ! 7597: > * IF TTLST IS NON-ZERO, IT COPIES PRINT BUFFER TO ! 7598: > * TERMINAL AND FLUSHES THIS ALSO. ! 7599: 19984,19985c18651 ! 7600: < * JSR PRTIC CALL FOR PRINT ! 7601: < * (WA,WB) DESTROYED ! 7602: --- ! 7603: > * JSR PRTFH CALL TO FLUSH BUFFER ! 7604: 19987,19992c18653,18655 ! 7605: < PRTIC PRC E,0 ENTRY POINT ! 7606: < MOV XR,-(XS) SAVE XR ! 7607: < MOV PRBUF,XR POINT TO BUFFER ! 7608: < MOV PROFS,WA NO OF CHARS ! 7609: < JSR SYSPI PRINT ! 7610: < PPM PRTC2 FAIL RETURN ! 7611: --- ! 7612: > PRTFH PRC R,0 ENTRY POINT ! 7613: > BNZ HEADP,PTFH1 WERE HEADERS PRINTED ! 7614: > JSR PRTPS NO - PRINT THEM ! 7615: 19994c18657 ! 7616: < * RETURN ! 7617: --- ! 7618: > * HEADERS DONE ! 7619: 19996,19997c18659,18668 ! 7620: < PRTC1 MOV (XS)+,XR RESTORE XR ! 7621: < EXI RETURN ! 7622: --- ! 7623: > PTFH1 BZE PRLEN,PTFH4 SKIP IF NO OUTPUT POSSIBLE ! 7624: > MOV XL,-(XS) SAVE XL ! 7625: > MOV XR,-(XS) SAVE XR ! 7626: > MOV WA,-(XS) SAVE WA ! 7627: > MOV WC,-(XS) SAVE WC ! 7628: > MOV PRBUF,XR LOAD POINTER TO BUFFER ! 7629: > MOV PROFS,WC LOAD NUMBER OF CHARS IN BUFFER ! 7630: > BNZ PRAVL,PTFH5 SKIP IF PRINT FILE AVAILABLE ! 7631: > BNZ TTOUS,PTFH2 SKIP IF STD OUTPUT TO TERML ! 7632: > BZE TTLST,PTFH3 LAST POSSIBILITY IS ERROR TO TERML ! 7633: 19999c18670 ! 7634: < * ERROR OCCURED ! 7635: --- ! 7636: > * SEND TO TERMINAL ! 7637: 20001,20004c18672,18674 ! 7638: < PRTC2 ZER ERICH PREVENT LOOPING ! 7639: < ERB 252,ERROR ON PRINTING TO INTERACTIVE CHANNEL ! 7640: < BRN PRTC1 RETURN ! 7641: < ENP PROCEDURE PRTIC ! 7642: --- ! 7643: > PTFH2 JSR SYSPI PRINT TO TERMINAL ! 7644: > PPM PTFH6 FAIL ! 7645: > PPM EROSI ERROR ! 7646: 20005a18676 ! 7647: > * PRTFH (CONTINUED) ! 7648: 20007c18678 ! 7649: < * PRTIS -- PRINT TO INTERACTIVE AND STANDARD PRINTER ! 7650: --- ! 7651: > * BLANK BUFFER ! 7652: 20009,20013c18680,18688 ! 7653: < * PRTIS PUTS A LINE FROM THE PRINT BUFFER ONTO THE ! 7654: < * INTERACTIVE CHANNEL (IF ANY) AND THE STANDARD PRINTER. ! 7655: < * IT ALWAYS PRINTS TO THE STANDARD PRINTER BUT DOES ! 7656: < * NOT DUPLICATE LINES IF THE STANDARD PRINTER IS ! 7657: < * INTERACTIVE. IT CLEARS DOWN THE PRINT BUFFER. ! 7658: --- ! 7659: > PTFH3 MOV PRBLK,XL POINT TO BLANKING STRING ! 7660: > MOV PRCHS,XR POINT TO BUFFER ! 7661: > MOV PRCMV,WA COUNT OF BAUS TO MOVE ! 7662: > MVW MOVE BLANKS INTO BUFFER ! 7663: > ZER PROFS RESET OFFSET ! 7664: > MOV (XS)+,WC RESTORE WC ! 7665: > MOV (XS)+,WA RECOVER WA ! 7666: > MOV (XS)+,XR RESTORE XR ! 7667: > MOV (XS)+,XL RESTORE XL ! 7668: 20015,20016c18690 ! 7669: < * JSR PRTIS CALL FOR PRINTING ! 7670: < * (WA,WB) DESTROYED ! 7671: --- ! 7672: > * RETURN POINT ! 7673: 20018,20021c18692 ! 7674: < PRTIS PRC E,0 ENTRY POINT ! 7675: < BNZ PRICH,PRTS1 JUMP IF STANDARD PRINTER IS INT.CH. ! 7676: < BZE ERICH,PRTS1 SKIP IF NOT DOING INT. ERROR REPS. ! 7677: < JSR PRTIC PRINT TO INTERACTIVE CHANNEL ! 7678: --- ! 7679: > PTFH4 EXI RETURN TO CALLER ! 7680: 20023c18694 ! 7681: < * MERGE AND EXIT ! 7682: --- ! 7683: > * HERE FOR REGULAR PRINT FILE ! 7684: 20025,20027c18696,18710 ! 7685: < PRTS1 JSR PRTNL PRINT TO STANDARD PRINTER ! 7686: < EXI RETURN ! 7687: < ENP END PROCEDURE PRTIS ! 7688: --- ! 7689: > PTFH5 JSR SYSPR CALL SYSTEM PRINT ROUTINE ! 7690: > PPM PTFH6 JUMP IF FAILED ! 7691: > PPM EROSI STOP IF ERROR ! 7692: > BZE TTLST,PTFH3 SKIP IF NO COPY TO TERMINAL ! 7693: > MOV PROFS,SCLEN(XR) SET STRING LENGTH FOR PTTST ! 7694: > JSR PTTST COPY STD BUFFER TO TERML BFR ! 7695: > JSR PTTFH FLUSH IT ! 7696: > MOV PRLEN,SCLEN(XR) RESTORE BUFFER LENGTH ! 7697: > BRN PTFH3 MERGE ! 7698: > * ! 7699: > * A FAILURE SUCH AS FILE OVERFILLED OCCURRED ! 7700: > * ! 7701: > PTFH6 BZE STAGX,PTFH3 IGNORE IF COMPILE TIME ! 7702: > BRN EXFAL ELSE CAUSE STMT FAILURE ! 7703: > ENP END PROCEDURE PRTFH ! 7704: 20057d18739 ! 7705: < EJC ! 7706: 20071c18753 ! 7707: < JSR PRTNL PRINT LINE ! 7708: --- ! 7709: > JSR PRTFH PRINT LINE ! 7710: 20076,20140d18757 ! 7711: < * PRTMX -- AS PRTMI WITH EXTRA COPY TO INTERACTIVE CHAN. ! 7712: < * ! 7713: < * JSR PRTMX CALL FOR PRINTING ! 7714: < * (WA,WB) DESTROYED ! 7715: < * ! 7716: < PRTMX PRC E,0 ENTRY POINT ! 7717: < JSR PRTST PRINT STRING MESSAGE ! 7718: < MOV =PRTMF,PROFS SET PTR TO COLUMN 15 ! 7719: < JSR PRTIN PRINT INTEGER ! 7720: < JSR PRTIS PRINT LINE ! 7721: < EXI RETURN ! 7722: < ENP END PROCEDURE PRTMX ! 7723: < EJC ! 7724: < * ! 7725: < * PRTNL -- PRINT NEW LINE (END PRINT LINE) ! 7726: < * ! 7727: < * PRTNL PRINTS THE CONTENTS OF THE PRINT BUFFER, RESETS ! 7728: < * THE BUFFER TO ALL BLANKS AND RESETS THE PRINT POINTER. ! 7729: < * ! 7730: < * JSR PRTNL CALL TO PRINT LINE ! 7731: < * ! 7732: < PRTNL PRC R,0 ENTRY POINT ! 7733: < BNZ HEADP,PRNL0 WERE HEADERS PRINTED ! 7734: < JSR PRTPS NO - PRINT THEM ! 7735: < * ! 7736: < * CALL SYSPR ! 7737: < * ! 7738: < PRNL0 MOV XR,-(XS) SAVE ENTRY XR ! 7739: < MOV WA,PRTSA SAVE WA ! 7740: < MOV WB,PRTSB SAVE WB ! 7741: < MOV PRBUF,XR LOAD POINTER TO BUFFER ! 7742: < MOV PROFS,WA LOAD NUMBER OF CHARS IN BUFFER ! 7743: < JSR SYSPR CALL SYSTEM PRINT ROUTINE ! 7744: < PPM PRNL2 JUMP IF FAILED ! 7745: < LCT WA,PRLNW LOAD LENGTH OF BUFFER IN WORDS ! 7746: < ADD *SCHAR,XR POINT TO CHARS OF BUFFER ! 7747: < MOV NULLW,WB GET WORD OF BLANKS ! 7748: < * ! 7749: < * LOOP TO BLANK BUFFER ! 7750: < * ! 7751: < PRNL1 MOV WB,(XR)+ STORE WORD OF BLANKS, BUMP PTR ! 7752: < BCT WA,PRNL1 LOOP TILL ALL BLANKED ! 7753: < * ! 7754: < * EXIT POINT ! 7755: < * ! 7756: < MOV PRTSB,WB RESTORE WB ! 7757: < MOV PRTSA,WA RESTORE WA ! 7758: < MOV (XS)+,XR RESTORE ENTRY XR ! 7759: < ZER PROFS RESET PRINT BUFFER POINTER ! 7760: < EXI RETURN TO PRTNL CALLER ! 7761: < * ! 7762: < * FILE FULL OR NO OUTPUT FILE FOR LOAD MODULE ! 7763: < * ! 7764: < PRNL2 BNZ PRTEF,PRNL3 JUMP IF NOT FIRST TIME ! 7765: < MNZ PRTEF MARK FIRST OCCURRENCE ! 7766: < ERB 253,PRINT LIMIT EXCEEDED ON STANDARD OUTPUT CHANNEL ! 7767: < * ! 7768: < * STOP AT ONCE ! 7769: < * ! 7770: < PRNL3 MOV =NINI8,WB ENDING CODE ! 7771: < MOV KVSTN,WA STATEMENT NUMBER ! 7772: < JSR SYSEJ STOP ! 7773: < ENP END PROCEDURE PRTNL ! 7774: < EJC ! 7775: < * ! 7776: 20376,20377c18993 ! 7777: < JSR PRTVL PRINT VALUE ! 7778: < JSR PRTNL TERMINATE LINE ! 7779: --- ! 7780: > JSR PRTVF PRINT VALUE ! 7781: 20384c19000 ! 7782: < * PRTPG -- PRINT A PAGE THROW ! 7783: --- ! 7784: > * PRTPG -- PRINT A PAGE THROW ! 7785: 20387c19003 ! 7786: < * LISTING CHANNEL DEPENDING ON THE LISTING OPTIONS CHOSEN. ! 7787: --- ! 7788: > * LISTING FILE DEPENDING ON THE LISTING OPTIONS CHOSEN. ! 7789: 20392,20393c19008,19009 ! 7790: < BEQ STAGE,=STGXT,PRP01 JUMP IF EXECUTION TIME ! 7791: < BZE LSTLC,PRP06 RETURN IF TOP OF PAGE ALREADY ! 7792: --- ! 7793: > BNZ STAGX,PTPG1 SKIP IF EXECUTION TIME ! 7794: > BZE LSTLC,PTPG6 RETURN IF TOP OF PAGE ALREADY ! 7795: 20398,20401c19014,19017 ! 7796: < PRP01 MOV XR,-(XS) PRESERVE XR ! 7797: < BNZ PRSTD,PRP02 EJECT IF FLAG SET ! 7798: < BNZ PRICH,PRP03 JUMP IF INTERACTIVE LISTING CHANNEL ! 7799: < BZE PRECL,PRP03 JUMP IF COMPACT LISTING ! 7800: --- ! 7801: > PTPG1 MOV XR,-(XS) PRESERVE XR ! 7802: > BNZ PRECL,PTPG2 EJECT IF EXTENDED LISTING ! 7803: > BZE PRSTD,PTPG3 SKIP IF COMPACT LISTING ! 7804: > BNZ TTOUS,PTPG3 SKIP IF LISTING TO TERMINAL ! 7805: 20405,20406c19021,19024 ! 7806: < PRP02 JSR SYSEP EJECT ! 7807: < BRN PRP04 MERGE ! 7808: --- ! 7809: > PTPG2 JSR SYSEP EJECT ! 7810: > PPM PTPG4 IGNORE FAILURE ! 7811: > PPM EROSI ERROR ! 7812: > BRN PTPG4 MERGE ! 7813: 20408,20409c19026 ! 7814: < * COMPACT OR INTERACTIVE CHANNEL LISTING. CANT PRINT ! 7815: < * BLANKS UNTIL CHECK MADE FOR HEADERS PRINTED AND FLAG SET. ! 7816: --- ! 7817: > * COMPACT LISTING. ! 7818: 20411,20416c19028,19033 ! 7819: < * ! 7820: < PRP03 MOV HEADP,XR REMEMBER HEADP ! 7821: < MNZ HEADP SET TO AVOID REPEATED PRTPG CALLS ! 7822: < JSR PRTNL PRINT BLANK LINE ! 7823: < JSR PRTNL PRINT BLANK LINE ! 7824: < JSR PRTNL PRINT BLANK LINE ! 7825: --- ! 7826: > PTPG3 BNZ HEADN,PTPG4 SKIP IF HEADERS OMITTED ! 7827: > MOV HEADP,XR REMEMBER HEADP ! 7828: > MNZ HEADP SET TO AVOID RECURSIVE PRTPG CALLS ! 7829: > JSR PRTFH PRINT BLANK LINE ! 7830: > JSR PRTFH PRINT BLANK LINE ! 7831: > JSR PRTFH PRINT BLANK LINE ! 7832: 20425c19042 ! 7833: < PRP04 BNZ HEADP,PRP05 JUMP IF HEADER LISTED ! 7834: --- ! 7835: > PTPG4 BNZ HEADP,PTPG5 JUMP IF HEADER LISTED ! 7836: 20426a19044 ! 7837: > BNZ HEADN,PTPG5 SKIP IF HEADERS OMITTED ! 7838: 20431,20432c19049 ! 7839: < JSR PRTST APPEND EXTRA CHARS ! 7840: < JSR PRTNL PRINT IT ! 7841: --- ! 7842: > JSR PRTSF APPEND EXTRA CHARS AND PRINT ! 7843: 20434,20437c19051,19052 ! 7844: < JSR PRTST PLACE IT ! 7845: < JSR PRTNL PRINT IT ! 7846: < JSR PRTNL PRINT A BLANK ! 7847: < JSR PRTNL AND ANOTHER ! 7848: --- ! 7849: > JSR PRTFB PLACE IT AND A BLANK ! 7850: > JSR PRTFH AND ANOTHER ! 7851: 20443c19058 ! 7852: < PRP05 MOV (XS)+,XR RESTORE XR ! 7853: --- ! 7854: > PTPG5 MOV (XS)+,XR RESTORE XR ! 7855: 20447c19062 ! 7856: < PRP06 EXI RETURN ! 7857: --- ! 7858: > PTPG6 EXI RETURN ! 7859: 20451c19066 ! 7860: < * PRTPS - PRINT PAGE WITH TEST FOR STANDARD LISTING OPTION ! 7861: --- ! 7862: > * PRTPS -- PRINT PAGE WITH TEST FOR STANDARD LISTING OPTION ! 7863: 20463a19079,19089 ! 7864: > * ! 7865: > * PRTSF -- PRINT STRING TO STD PRINTER AND FLUSH BFR ! 7866: > * ! 7867: > * (XR) STRING TO PRINT ! 7868: > * JSR PRTSF CALL TO PRINT AND FLUSH ! 7869: > * ! 7870: > PRTSF PRC E,0 ENTRY POINT ! 7871: > JSR PRTST PRINT STRING ! 7872: > JSR PRTFH FLUSH BUFFER ! 7873: > EXI RETURN TO CALLER ! 7874: > ENP END PROCEDURE PRTSF ! 7875: 20512c19138 ! 7876: < * PRTST -- PRINT STRING ! 7877: --- ! 7878: > * PRTST -- PRINT STRING TO STANDARD FILE ! 7879: 20514c19140 ! 7880: < * PRTST PLACES A STRING OF CHARACTERS IN THE PRINT BUFFER ! 7881: --- ! 7882: > * PLACE A STRING OF CHARACTERS IN THE STANDARD PRINT BUFFER ! 7883: 20516,20517d19141 ! 7884: < * SEE PRTNL FOR GLOBAL LOCATIONS USED ! 7885: < * ! 7886: 20519a19144,19147 ! 7887: > * IF GLOBAL TTOUS IS NON-ZERO, STRING IS SENT TO TERMINAL ! 7888: > * INSTEAD OF STANDARD OUTPUT FILE. ! 7889: > * IF GLOBAL TTLST IS NON-ZERO, STRING IS SENT TO ! 7890: > * TERMINAL AS WELL AS STANDARD OUTPUT FILE ! 7891: 20526c19154 ! 7892: < BNZ HEADP,PRST0 WERE HEADERS PRINTED ! 7893: --- ! 7894: > BNZ HEADP,PTST1 WERE HEADERS PRINTED ! 7895: 20529c19157 ! 7896: < * CALL SYSPR ! 7897: --- ! 7898: > * HEADERS DEALT WITH ! 7899: 20531c19159,19165 ! 7900: < PRST0 MOV WA,PRSVA SAVE WA ! 7901: --- ! 7902: > PTST1 BZE PRLEN,PTST7 SKIP IF NO O/P POSSIBLE ! 7903: > BNZ PRPUT,PTST2 SKIP IF PUTTING IS OK ! 7904: > BZE TTLST,PTST7 SKIP OUT IF NOT ERROR TO TERML ! 7905: > * ! 7906: > * KEEP REGISTERS ! 7907: > * ! 7908: > PTST2 MOV WA,PRSVA SAVE WA ! 7909: 20537c19171 ! 7910: < PRST1 MOV SCLEN(XR),WA LOAD STRING LENGTH ! 7911: --- ! 7912: > PTST3 MOV SCLEN(XR),WA LOAD STRING LENGTH ! 7913: 20539c19173 ! 7914: < BZE WA,PRST4 JUMP TO EXIT IF NONE LEFT ! 7915: --- ! 7916: > BZE WA,PTST6 JUMP TO EXIT IF NONE LEFT ! 7917: 20545,20546c19179,19180 ! 7918: < BNZ XR,PRST2 SKIP IF ROOM LEFT ON THIS LINE ! 7919: < JSR PRTNL ELSE PRINT THIS LINE ! 7920: --- ! 7921: > BNZ XR,PTST4 SKIP IF ROOM LEFT ON THIS LINE ! 7922: > JSR PRTFH PRINT THIS LINE ! 7923: 20554c19188 ! 7924: < PRST2 BLO WA,XR,PRST3 JUMP IF ROOM FOR REST OF STRING ! 7925: --- ! 7926: > PTST4 BLO WA,XR,PTST5 JUMP IF ROOM FOR REST OF STRING ! 7927: 20559c19193 ! 7928: < PRST3 MOV PRBUF,XR POINT TO PRINT BUFFER ! 7929: --- ! 7930: > PTST5 MOV PRBUF,XR POINT TO PRINT BUFFER ! 7931: 20564d19197 ! 7932: < MOV WB,PRSVC PRESERVE CHAR COUNTER ! 7933: 20566d19198 ! 7934: < MOV PRSVC,WB RECOVER CHAR COUNTER ! 7935: 20569c19201 ! 7936: < BRN PRST1 LOOP BACK TO TEST FOR MORE ! 7937: --- ! 7938: > BRN PTST3 LOOP BACK TO TEST FOR MORE ! 7939: 20573c19205 ! 7940: < PRST4 MOV PRSVB,WB RESTORE ENTRY WB ! 7941: --- ! 7942: > PTST6 MOV PRSVB,WB RESTORE ENTRY WB ! 7943: 20575,20577d19206 ! 7944: < EXI RETURN TO PRTST CALLER ! 7945: < ENP END PROCEDURE PRTST ! 7946: < EJC ! 7947: 20579c19208 ! 7948: < * PRTTR -- PRINT TO TERMINAL ! 7949: --- ! 7950: > * RETURN POINT ! 7951: 20581,20582c19210,19211 ! 7952: < * CALLED TO PRINT CONTENTS OF STANDARD PRINT BUFFER TO ! 7953: < * ONLINE TERMINAL. CLEARS BUFFER DOWN AND RESETS PROFS. ! 7954: --- ! 7955: > PTST7 EXI RETURN TO PRTST CALLER ! 7956: > ENP END PROCEDURE PRTST ! 7957: 20584,20585c19213 ! 7958: < * JSR PRTTR CALL FOR PRINT ! 7959: < * (WA,WB) DESTROYED ! 7960: --- ! 7961: > * PRTVF -- PLACE A VALUE AND FLUSH STANDARD BUFFER ! 7962: 20587,20593c19215,19216 ! 7963: < PRTTR PRC E,0 ENTRY POINT ! 7964: < MOV XR,-(XS) SAVE XR ! 7965: < JSR PRTIC PRINT BUFFER CONTENTS ! 7966: < MOV PRBUF,XR POINT TO PRINT BFR TO CLEAR IT ! 7967: < LCT WA,PRLNW GET BUFFER LENGTH ! 7968: < ADD *SCHAR,XR POINT PAST SCBLK HEADER ! 7969: < MOV NULLW,WB GET BLANKS ! 7970: --- ! 7971: > * (XR) VALUE TO PRINT ! 7972: > * JSR PRTVF CALL TO PRINT AND FLUSH ! 7973: 20595,20602c19218,19222 ! 7974: < * LOOP TO CLEAR BUFFER ! 7975: < * ! 7976: < PRTT1 MOV WB,(XR)+ CLEAR A WORD ! 7977: < BCT WA,PRTT1 LOOP ! 7978: < ZER PROFS RESET PROFS ! 7979: < MOV (XS)+,XR RESTORE XR ! 7980: < EXI RETURN ! 7981: < ENP END PROCEDURE PRTTR ! 7982: --- ! 7983: > PRTVF PRC E,0 ENTRY POINT ! 7984: > JSR PRTVL PLACE VALUE ! 7985: > JSR PRTFH FLUSH BUFFER ! 7986: > EXI RETURN TO CALLER ! 7987: > ENP END PROCEDURE PRTVF ! 7988: 20676c19296 ! 7989: < * VCBLK, TBBLK, BCBLK MERGE HERE FOR ) BLANK NUMBER IDVAL ! 7990: --- ! 7991: > * VCBLK, TBBLK MERGE HERE FOR ) BLANK NUMBER IDVAL ! 7992: 20814a19435,19536 ! 7993: > EJC ! 7994: > * ! 7995: > * PTTFH -- FLUSH TERMINAL BUFFER ! 7996: > * ! 7997: > * PRINTS THE CONTENTS OF THE TTY BUFFER, RESETS ! 7998: > * THE BUFFER TO ALL BLANKS AND RESETS THE POINTER. ! 7999: > * ! 8000: > * JSR PTTFH CALL TO FLUSH BUFFER ! 8001: > * ! 8002: > PTTFH PRC E,0 ENTRY POINT ! 8003: > BZE TTLEN,PTTF2 SKIP IF NO TERMINAL ! 8004: > MOV XL,-(XS) SAVE XL ! 8005: > MOV XR,-(XS) SAVE XR ! 8006: > MOV WA,-(XS) SAVE WA ! 8007: > MOV WC,-(XS) SAVE WC ! 8008: > MOV TTBUF,XR LOAD POINTER TO BUFFER ! 8009: > MOV TTOFS,WC LOAD NUMBER OF CHARS IN BUFFER ! 8010: > JSR SYSPI CALL SYSTEM PRINT ROUTINE ! 8011: > PPM PTTF3 JUMP IF FAILED ! 8012: > PPM EROSI STOP IF ERROR ! 8013: > * ! 8014: > * BLANK BUFFER ! 8015: > * ! 8016: > PTTF1 MOV TTBLK,XL POINT TO BLANKING STRING ! 8017: > MOV TTCHS,XR POINT TO BUFFER ! 8018: > MOV TTCMV,WA COUNT OF BAUS TO MOVE ! 8019: > MVW MOVE BLANKS INTO BUFFER ! 8020: > ZER TTOFS RESET OFFSET ! 8021: > MOV (XS)+,WC RESTORE WC ! 8022: > MOV (XS)+,WA RECOVER WA ! 8023: > MOV (XS)+,XR RESTORE XR ! 8024: > MOV (XS)+,XL RESTORE XL ! 8025: > * ! 8026: > * RETURN POINT ! 8027: > * ! 8028: > PTTF2 EXI RETURN TO CALLER ! 8029: > * ! 8030: > * A FAILURE SUCH AS FILE OVERFILLED OCCURRED ! 8031: > * ! 8032: > PTTF3 BZE STAGX,PTTF1 IGNORE IF COMPILE TIME ! 8033: > BRN EXFAL ELSE CAUSE STMT FAILURE ! 8034: > ENP END PROCEDURE ! 8035: > EJC ! 8036: > * ! 8037: > * PTTST -- PRINT STRING TO TERMINAL ! 8038: > * ! 8039: > * PLACE A STRING OF CHARACTERS IN THE TERMINAL BUFFER ! 8040: > * ! 8041: > * NOTE THAT THE FIRST WORD OF THE BLOCK (NORMALLY B$SCL) ! 8042: > * IS NOT USED AND NEED NOT BE SET CORRECTLY (SEE PRTVN) ! 8043: > * ! 8044: > * (XR) STRING TO BE PRINTED ! 8045: > * JSR PTTST CALL TO PRINT STRING ! 8046: > * (TTOFS) UPDATED PAST CHARS PLACED ! 8047: > * ! 8048: > PTTST PRC E,0 ENTRY POINT ! 8049: > BZE TTLEN,PTTS5 SKIP IF NO TERMINAL ! 8050: > MOV WA,PRTVA SAVE WA ! 8051: > MOV WB,PRTVB SAVE WB ! 8052: > ZER WB SET CHARS PRINTED COUNT TO ZERO ! 8053: > * ! 8054: > * LOOP TO PRINT SUCCESSIVE LINES FOR LONG STRING ! 8055: > * ! 8056: > PTTS1 MOV SCLEN(XR),WA LOAD STRING LENGTH ! 8057: > SUB WB,WA SUBTRACT COUNT OF CHARS ALREADY OUT ! 8058: > BZE WA,PTTS4 JUMP TO EXIT IF NONE LEFT ! 8059: > MOV XL,-(XS) ELSE STACK ENTRY XL ! 8060: > MOV XR,-(XS) SAVE ARGUMENT ! 8061: > MOV XR,XL COPY FOR EVENTUAL MOVE ! 8062: > MOV TTLEN,XR LOAD BUFFER LENGTH ! 8063: > SUB TTOFS,XR GET CHARS LEFT IN BUFFER ! 8064: > BNZ XR,PTTS2 SKIP IF ROOM LEFT ON THIS LINE ! 8065: > JSR PTTFH ELSE PRINT THIS LINE ! 8066: > MOV TTLEN,XR AND SET FULL WIDTH AVAILABLE ! 8067: > * ! 8068: > * HERE WITH CHARS TO PRINT AND SOME ROOM IN BUFFER ! 8069: > * ! 8070: > PTTS2 BLO WA,XR,PTTS3 JUMP IF ROOM FOR REST OF STRING ! 8071: > MOV XR,WA ELSE SET TO FILL LINE ! 8072: > * ! 8073: > * MERGE HERE WITH CHARACTER COUNT IN WA ! 8074: > * ! 8075: > PTTS3 MOV TTBUF,XR POINT TO PRINT BUFFER ! 8076: > PLC XL,WB POINT TO LOCATION IN STRING ! 8077: > PSC XR,TTOFS POINT TO LOCATION IN BUFFER ! 8078: > ADD WA,WB BUMP STRING CHARS COUNT ! 8079: > ADD WA,TTOFS BUMP BUFFER POINTER ! 8080: > MVC MOVE CHARACTERS TO BUFFER ! 8081: > MOV (XS)+,XR RESTORE ARGUMENT POINTER ! 8082: > MOV (XS)+,XL RESTORE ENTRY XL ! 8083: > BRN PTTS1 LOOP BACK TO TEST FOR MORE ! 8084: > EJC ! 8085: > * ! 8086: > * HERE TO EXIT AFTER PRINTING STRING ! 8087: > * ! 8088: > PTTS4 MOV PRTVB,WB RESTORE ENTRY WB ! 8089: > MOV PRTVA,WA RESTORE ENTRY WA ! 8090: > * ! 8091: > * RETURN POINT ! 8092: > * ! 8093: > PTTS5 EXI RETURN TO PTTST CALLER ! 8094: > ENP END PROCEDURE PTTST ! 8095: 20851a19574,19578 ! 8096: > * THE GLOBAL FLAG RDRER IS SET JUST BEFORE THE READ, AND ! 8097: > * CLEARED AFTER IT. THIS IS SO THAT IN THE EVENT SYSRD ! 8098: > * OR SYSRI TAKE AN EROSI EXIT, THE ERROR APPENDAGE CAN ! 8099: > * RECOGNIZE THE SITUATION AND TAKE APPROPRIATE ACTION. ! 8100: > * ! 8101: 20859,20861c19586,19596 ! 8102: < BNZ XR,READ3 EXIT IF ALREADY READ ! 8103: < BNE STAGE,=STGIC,READ3 EXIT IF NOT INITIAL COMPILE ! 8104: < MOV CSWIN,WA MAX READ LENGTH ! 8105: --- ! 8106: > BNZ XR,READ5 EXIT IF ALREADY READ ! 8107: > * ! 8108: > * MERGE FROM -COPY EOF TO TRY READ ! 8109: > * ! 8110: > READ0 BEQ STAGE,=STGIC,READ1 READ IF INITIAL COMPILE ! 8111: > BZE R$COP,READ6 ELSE EXIT IF NO -COPY IN FORCE ! 8112: > * ! 8113: > * ATTEMPT READ ! 8114: > * ! 8115: > READ1 MOV CSWIN,WA MAX READ LENGTH ! 8116: > MNZ RDRER NOTE IN-READR IN CASE EROSI ! 8117: 20863,20864c19598,19612 ! 8118: < JSR SYSRD READ INPUT IMAGE ! 8119: < PPM READ4 JUMP IF END OF FILE ! 8120: --- ! 8121: > BZE TTINS,READ2 SKIP IF STANDARD INPUT FILE ! 8122: > JSR SYSRI READ FROM TERMINAL ! 8123: > PPM READ7 FAIL ! 8124: > PPM EROSI ERROR ! 8125: > BRN READ3 MERGE ! 8126: > * ! 8127: > * READ FROM STANDARD FILE ! 8128: > * ! 8129: > READ2 JSR SYSRD READ INPUT IMAGE ! 8130: > PPM READ7 JUMP IF END OF FILE ! 8131: > PPM EROSI ERROR RETURN ! 8132: > * ! 8133: > * MERGE ! 8134: > * ! 8135: > READ3 ZER RDRER NOTE NOT-IN-READR FOR ERROR RTN ! 8136: 20866c19614 ! 8137: < BLE SCLEN(XR),CSWIN,READ1 USE SMALLER OF STRING LNTH .. ! 8138: --- ! 8139: > BLE SCLEN(XR),CSWIN,READ4 USE SMALLER OF STRING LNTH.. ! 8140: 20871c19619 ! 8141: < READ1 JSR TRIMR TRIM TRAILING BLANKS ! 8142: --- ! 8143: > READ4 JSR TRIMR TRIM TRAILING BLANKS ! 8144: 20875c19623 ! 8145: < READ2 MOV XR,R$CNI STORE COPY OF POINTER ! 8146: --- ! 8147: > READ5 MOV XR,R$CNI STORE COPY OF POINTER ! 8148: 20879c19627 ! 8149: < READ3 EXI RETURN TO READR CALLER ! 8150: --- ! 8151: > READ6 EXI RETURN TO READR CALLER ! 8152: 20883c19631,19632 ! 8153: < READ4 MOV XR,DNAMP POP UNUSED SCBLK ! 8154: --- ! 8155: > READ7 ZER RDRER NOTE NOT-IN-READR FOR ERR ! 8156: > MOV XR,DNAMP POP UNUSED SCBLK ! 8157: 20885c19634,19636 ! 8158: < BRN READ2 MERGE ! 8159: --- ! 8160: > BZE R$COP,READ5 SKIP IF NO -COPY IN FORCE ! 8161: > JSR COPND CALL TO END THIS -COPY (EOF) ! 8162: > BRN READ0 TRY AGAIN ! 8163: 20886a19638 ! 8164: > .IF .CASL ! 8165: 20888a19641,19724 ! 8166: > * SBSCC -- BUILD SUBSTRING WITH CASE CONVERSION ! 8167: > * ! 8168: > * (XL) PTR TO SCBLK CONTAINING CHARS ! 8169: > * (WA) CHAR COUNT ! 8170: > * (WB) OFFSET TO FIRST CHAR IN SCBLK ! 8171: > * JSR SBSCC CALL TO BUILD SUBSTRING ! 8172: > * (XR) PTR TO NEW SCBLK WITH SUBSTRING ! 8173: > * (WA,WB,WC,XL,IA) DESTROYED ! 8174: > * ! 8175: > * IF OPTION .CPLC IS SELECTED (PREFER LOWER CASE), TARGET ! 8176: > * CASE IS LOWER CASE, OTHERWISE IT IS UPPER CASE. ! 8177: > * ! 8178: > SBSCC PRC E,0 ENTRY POINT ! 8179: > BZE WA,SBSC4 JUMP IF NULL SUBSTRING ! 8180: > JSR ALOCS ELSE ALLOCATE SCBLK ! 8181: > MOV WC,WA MOVE NUMBER OF CHARACTERS ! 8182: > MOV XR,WC SAVE PTR TO NEW SCBLK ! 8183: > PLC XL,WB PREPARE TO LOAD CHARS FROM OLD BLK ! 8184: > PSC XR PREPARE TO STORE CHARS IN NEW BLK ! 8185: > LCT WA,WA TO COUNT ROUND LOOP ! 8186: > * ! 8187: > * LOOP TO COPY AND TRANSLATE CHARS ! 8188: > * ! 8189: > SBSC1 LCH WB,(XL)+ GET CHAR ! 8190: > .IF .CPLC ! 8191: > BGT WB,=CH$L$,SBSC2 SKIP IF NOT UC LETTER ! 8192: > BLT WB,=CH$LA,SBSC2 SKIP IF NOT UC LETTER ! 8193: > .IF .CSCV ! 8194: > CUL WB CONVERT FROM UC TO LC ! 8195: > .ELSE ! 8196: > ADD =DFA$A,WB CONVERT FROM UC TO LC ! 8197: > .FI ! 8198: > .ELSE ! 8199: > BGT WB,=CH$$$,SBSC2 SKIP IF NOT A LC LETTER ! 8200: > BLT WB,=CH$$A,SBSC2 SKIP IF NOT A LC LETTER ! 8201: > .IF .CSCV ! 8202: > CLU WB CONVERT FROM LC TO UC ! 8203: > .ELSE ! 8204: > SUB =DFA$A,WB CONVERT FROM LC TO UC ! 8205: > .FI ! 8206: > .FI ! 8207: > * ! 8208: > * STORE CHAR IN NEW SUBSTRING ! 8209: > * ! 8210: > SBSC2 SCH WB,(XR)+ STORE CHAR ! 8211: > BCT WA,SBSC1 LOOP ! 8212: > MOV WC,XR RESTORE SCBLK POINTER ! 8213: > * ! 8214: > * RETURN POINT ! 8215: > * ! 8216: > SBSC3 ZER XL CLEAR GARBAGE POINTER IN XL ! 8217: > EXI RETURN TO SBSCC CALLER ! 8218: > * ! 8219: > * HERE FOR NULL SUBSTRING ! 8220: > * ! 8221: > SBSC4 MOV =NULLS,XR SET NULL STRING AS RESULT ! 8222: > BRN SBSC3 RETURN ! 8223: > ENP END PROCEDURE SBSCC ! 8224: > EJC ! 8225: > * ! 8226: > * SBSTG -- BUILD SUBSTRING POSSIBLY CONVERTING CASE ! 8227: > * ! 8228: > * (XL) PTR TO SCBLK CONTAINING CHARS ! 8229: > * (WA) CHAR COUNT ! 8230: > * (WB) OFFSET TO FIRST CHAR IN SCBLK ! 8231: > * JSR SBSTG CALL TO BUILD SUBSTRING ! 8232: > * (XR) PTR TO NEW SCBLK WITH SUBSTRING ! 8233: > * (WA,WB,WC,XL,IA) DESTROYED ! 8234: > * ! 8235: > * IF CASE IS TO BE IGNORED (-CASEIG OR .CSIG), SUBSTRING ! 8236: > * IS CONVERTED TO PREFERRED CASE (DEFAULT UPPER), ! 8237: > * OTHERWISE CASE IS LEFT ALONE. ! 8238: > * ! 8239: > SBSTG PRC E,0 ENTRY POINT ! 8240: > BZE CSWCI,SBSG1 SKIP IF CASE NOT IGNORED ! 8241: > JSR SBSCC CONVERT TO IGNORE CASE ! 8242: > EXI RETURN TO CALLER ! 8243: > * ! 8244: > SBSG1 JSR SBSTR READ SUBSTRING IN MIXED CASE ! 8245: > EXI RETURN TO CALLER ! 8246: > ENP END PROCEDURE SBSTG ! 8247: > .FI ! 8248: > EJC ! 8249: > * ! 8250: 20891c19727 ! 8251: < * (XL) PTR TO SCBLK/BFBLK WITH CHARS ! 8252: --- ! 8253: > * (XL) PTR TO SCBLK CONTAINING CHARS ! 8254: 20896d19731 ! 8255: < * (XL) ZERO ! 8256: 21086,21087c19921 ! 8257: < .IF .CUCF ! 8258: < BLO =CFP$U,XR,SCN07 QUICK CHECK FOR OTHER CHAR ! 8259: --- ! 8260: > BGE XR,=CFP$U,SCN07 QUICK CHECK FOR OTHER CHAR ! 8261: 21089,21091d19922 ! 8262: < .ELSE ! 8263: < BSW XR,CFP$A,SCN07 SWITCH ON SCANNED CHARACTER ! 8264: < .FI ! 8265: 21187,21190c20018,20021 ! 8266: < IFF CH$PL,SCN33 PLUS ! 8267: < IFF CH$MN,SCN34 MINUS ! 8268: < IFF CH$NT,SCN35 NOT ! 8269: < IFF CH$DL,SCN36 DOLLAR ! 8270: --- ! 8271: > IFF CH$PL,SCN34 PLUS ! 8272: > IFF CH$MN,SCN35 MINUS ! 8273: > IFF CH$NT,SCN36 NOT ! 8274: > IFF CH$DL,SCN33 DOLLAR ! 8275: 21206c20037 ! 8276: < ERB 230,SYNTAX ERROR. ILLEGAL CHARACTER ! 8277: --- ! 8278: > ERB 232,SYNTAX ERROR. ILLEGAL CHARACTER ! 8279: 21260c20091 ! 8280: < SCN14 ERB 231,SYNTAX ERROR. INVALID NUMERIC ITEM ! 8281: --- ! 8282: > SCN14 ERB 233,SYNTAX ERROR. INVALID NUMERIC ITEM ! 8283: 21263a20095,20097 ! 8284: > .IF .CASL ! 8285: > SCN15 JSR SBSTG BUILD STRING NAME OF VARIABLE ! 8286: > .ELSE ! 8287: 21264a20099 ! 8288: > .FI ! 8289: 21305c20140 ! 8290: < ERB 232,SYNTAX ERROR. UNMATCHED STRING QUOTE ! 8291: --- ! 8292: > ERB 234,SYNTAX ERROR. UNMATCHED STRING QUOTE ! 8293: 21381,21382c20216,20217 ! 8294: < * THE FIRST THREE ENTRIES ARE SPECIAL SINCE THEY CAN OCCUR ! 8295: < * AS PART OF A VARIABLE NAME (.) OR CONSTANT (.+-). ! 8296: --- ! 8297: > * THE FIRST FOUR ENTRIES ARE SPECIAL SINCE THEY CAN OCCUR ! 8298: > * AS PART OF A VARIABLE NAME (.$) OR CONSTANT (.+-). ! 8299: 21387c20222,20225 ! 8300: < SCN33 BZE WC,SCN09 PLUS CAN BE PART OF CONSTANT ! 8301: --- ! 8302: > SCN33 BZE WB,SCN09 DOLLAR CAN BE PART OF NAME ! 8303: > ADD WB,WC ELSE BUMP POINTER ! 8304: > * ! 8305: > SCN34 BZE WC,SCN09 PLUS CAN BE PART OF CONSTANT ! 8306: 21391c20229 ! 8307: < SCN34 BZE WC,SCN09 MINUS CAN BE PART OF CONSTANT ! 8308: --- ! 8309: > SCN35 BZE WC,SCN09 MINUS CAN BE PART OF CONSTANT ! 8310: 21393a20232,20234 ! 8311: > LCH XR,(XL) GET NEXT CHARACTER ! 8312: > BLT XR,=CH$D0,SCN36 SKIP IF NOT DIGIT ! 8313: > BLE XR,=CH$D9,SCN08 JUMP IF DIGIT ! 8314: 21395,21396c20236 ! 8315: < SCN35 ADD WB,WC NOT ! 8316: < SCN36 ADD WB,WC DOLLAR ! 8317: --- ! 8318: > SCN36 ADD WB,WC NOT ! 8319: 21405a20246 ! 8320: > EJC ! 8321: 21406a20248,20249 ! 8322: > * SCANE (CONTINUED) ! 8323: > * ! 8324: 21439c20282 ! 8325: < SCN48 ERB 233,SYNTAX ERROR. INVALID USE OF OPERATOR ! 8326: --- ! 8327: > SCN48 ERB 235,SYNTAX ERROR. INVALID USE OF OPERATOR ! 8328: 21494c20337 ! 8329: < ERB 234,SYNTAX ERROR. GOTO FIELD INCORRECT ! 8330: --- ! 8331: > ERB 236,SYNTAX ERROR. GOTO FIELD INCORRECT ! 8332: 21500,21501c20343,20344 ! 8333: < MOV =OPDVN,WA POINT TO OPDV FOR COMPLEX GOTO ! 8334: < BLE XR,STATB,SCNG3 JUMP IF NOT IN STATIC (SGD15) ! 8335: --- ! 8336: > MOV =OPDVN,WA ELSE POINT TO OPDV FOR COMPLEX GOTO ! 8337: > BLE XR,STATB,SCNG3 JUMP IF NOT IN STATIC ! 8338: 21503c20346 ! 8339: < BRN SCNG3 COMPLEX GOTO - MERGE ! 8340: --- ! 8341: > BRN SCNG3 AND MERGE ! 8342: 21571c20414 ! 8343: < * THE SORT USED IS HEAPSORT, FUNDAMENTALS OF DATA STRUCTURE ! 8344: --- ! 8345: > * THE SORT USED IS HEAPSORT, FUNDAMENTALS OF DATA STRUCTURES, ! 8346: 21576c20419 ! 8347: < * SORT ARRAY) CONTAINING AT ITS HIGH ADDRESS END, BYTE ! 8348: --- ! 8349: > * SORT ARRAY) CONTAINING AT ITS HIGH ADDRESS END, BAU ! 8350: 21588a20432,20433 ! 8351: > * GIVES ERROR MESSAGES FOR INCORRECT ARGS, RETURNS EXI 1 ! 8352: > * FOR EMPTY TABLE. ! 8353: 21593a20439 ! 8354: > * PPM LOC FAIL RETURN FOR EMPTY TABLE ! 8355: 21600c20446 ! 8356: < SORTA PRC N,0 ENTRY POINT ! 8357: --- ! 8358: > SORTA PRC N,1 ENTRY POINT ! 8359: 21606a20453,20455 ! 8360: > MOV (XR),WA GET ARG TYPE ! 8361: > BEQ WA,=B$ART,SRT00 SKIP IF ARRAY ! 8362: > BNE WA,=B$TBT,SRT16 ERROR IF NOT TABLE ! 8363: 21608,21611c20457,20463 ! 8364: < PPM SRT16 FAIL ! 8365: < MOV XR,-(XS) STACK PTR TO RESULTING KEY ARRAY ! 8366: < MOV XR,-(XS) ANOTHER COPY FOR COPYB ! 8367: < JSR COPYB GET COPY ARRAY FOR SORTING INTO ! 8368: --- ! 8369: > PPM SRT18 FAIL ! 8370: > * ! 8371: > * MAKE COPY OF ARRAY ! 8372: > * ! 8373: > SRT00 MOV XR,-(XS) STACK PTR TO RESULTING KEY ARRAY ! 8374: > MOV XR,-(XS) ANOTHER COPY FOR CBLCK ! 8375: > JSR CBLCK GET COPY ARRAY FOR SORTING INTO ! 8376: 21619c20471 ! 8377: < ERR 257,ERRONEOUS 2ND ARG IN SORT/RSORT OF VECTOR ! 8378: --- ! 8379: > ERR 237,ERRONEOUS 2ND ARG IN SORT/RSORT OF VECTOR ! 8380: 21627c20479 ! 8381: < SUB *VCSI$,WA GET NO. OF ENTRIES, N (IN BYTES) ! 8382: --- ! 8383: > SUB *VCSI$,WA GET NO. OF ENTRIES, N (IN BAUS) ! 8384: 21635c20487 ! 8385: < MOV *ARVLS,WB OFFSET TO FIRST VALUE IF ONE ! 8386: --- ! 8387: > MOV *ARVLS,WB OFFSET TO FIRST VALUE IF ONE DIM. ! 8388: 21637,21639c20489,20491 ! 8389: < BEQ ARNDM(XL),=NUM01,SRT04 JUMP IN FACT IF ONE DIM. ! 8390: < BNE ARNDM(XL),=NUM02,SRT16 FAIL UNLESS TWO DIMENS ! 8391: < LDI ARLB2(XL) GET LOWER BOUND 2 AS DEFAULT ! 8392: --- ! 8393: > BEQ ARNDM(XL),=NUM01,SRT04 JUMP IF IN FACT ONE DIMENSION ! 8394: > BNE ARNDM(XL),=NUM02,SRT16 FAIL UNLESS TWO DIMENSIONAL ! 8395: > LDI ARLB2(XL) GET LOWER BOUND 2 AS DEFAULT COLUMN ! 8396: 21662c20514 ! 8397: < WTB WA CONVERT TO BYTES ! 8398: --- ! 8399: > WTB WA CONVERT TO BAUS ! 8400: 21679c20531 ! 8401: < * WA = NUMBER OF ITEMS, N (CONVERTED TO BYTES). ! 8402: --- ! 8403: > * WA = NUMBER OF ITEMS, N (CONVERTED TO BAUS). ! 8404: 21714c20566 ! 8405: < BTW WC CONVERT FROM BYTES ! 8406: --- ! 8407: > BTW WC CONVERT FROM BAUS ! 8408: 21726c20578 ! 8409: < * (SRTSN) NUMBER OF ITEMS TO SORT, N (BYTES) ! 8410: --- ! 8411: > * (SRTSN) NUMBER OF ITEMS TO SORT, N (BAUS) ! 8412: 21732c20584 ! 8413: < WTB WC CONVERT BACK TO BYTES ! 8414: --- ! 8415: > WTB WC CONVERT BACK TO BAUS ! 8416: 21742c20594 ! 8417: < * ITEM, SINCE ALGORITHM INITIALISES IT AS, AND THEN MAINTAI ! 8418: --- ! 8419: > * ITEM, SINCE ALGORITHM INITIALISES IT AS, AND THEN MAINTAINS ! 8420: 21799,21800c20651,20656 ! 8421: < SRT16 ERB 256,SORT/RSORT 1ST ARG NOT SUITABLE ARRAY OR TABLE ! 8422: < SRT17 ERB 258,SORT/RSORT 2ND ARG OUT OF RANGE OR NON-INTEGER ! 8423: --- ! 8424: > SRT16 ERB 238,SORT/RSORT 1ST ARG NOT SUITABLE ARRAY OR TABLE ! 8425: > SRT17 ERB 239,SORT/RSORT 2ND ARG OUT OF RANGE OR NON-INTEGER ! 8426: > * ! 8427: > * SOFT FAIL RETURN ! 8428: > * ! 8429: > SRT18 EXI 1 RETURN ! 8430: 21964c20820 ! 8431: < WTB WC CONVERT TO BYTES ! 8432: --- ! 8433: > WTB WC CONVERT TO BAUS ! 8434: 21993c20849 ! 8435: < * (WA) MAX ARRAY INDEX, N (IN BYTES) ! 8436: --- ! 8437: > * (WA) MAX ARRAY INDEX, N (IN BAUS) ! 8438: 22045c20901 ! 8439: < WTB WC CONVERT BACK TO BYTES ! 8440: --- ! 8441: > WTB WC CONVERT BACK TO BAUS ! 8442: 22057c20913 ! 8443: < WTB WC CONVERT BACK TO BYTES ! 8444: --- ! 8445: > WTB WC CONVERT BACK TO BAUS ! 8446: 22123a20980,20982 ! 8447: > * POSSIBILITY OF OVERFLOW EXIST ON TWOS COMPLEMENT ! 8448: > * MACHINE IF HASH SOURCE IS MOST NEGATIVE INTEGER OR IS ! 8449: > * A REAL HAVING THE SAME BIT PATTERN. ! 8450: 22149c21008 ! 8451: < WTB WC CONVERT TO BYTE OFFSET ! 8452: --- ! 8453: > WTB WC CONVERT TO BAU OFFSET ! 8454: 22202a21062 ! 8455: > MOV XR,WB COPY DEFAULT VALUE ! 8456: 22211c21071 ! 8457: < MOV =NULLS,TEVAL(XR) SET NULL AS INITIAL VALUE ! 8458: --- ! 8459: > MOV WB,TEVAL(XR) SET DEFAULT AS INITIAL VALUE ! 8460: 22214c21074 ! 8461: < ICA XS POP PAST NAME/VALUE INDICATOR ! 8462: --- ! 8463: > MOV (XS)+,WB RESTORE NAME/VALUE INDICATOR ! 8464: 22235a21096 ! 8465: > * PPM LOC FAIL STOPTR IF NON-EXISTENT TRACE ! 8466: 22239c21100 ! 8467: < TRACE PRC N,2 ENTRY POINT ! 8468: --- ! 8469: > TRACE PRC N,3 ENTRY POINT ! 8470: 22244,22246c21105,21112 ! 8471: < .IF .CULC ! 8472: < FLC WA FOLD TO UPPER CASE ! 8473: < .FI ! 8474: --- ! 8475: > .IF .CASL ! 8476: > BLT WA,=CH$$A,TRC00 SKIP IF NOT LOWER CASE ! 8477: > SUB =DFA$A,WA CONVERT LOWER TO UPPER CASE ! 8478: > * ! 8479: > * HERE WITH UPPER CASE TRACE TYPE CODE ! 8480: > * ! 8481: > TRC00 MOV (XS),XR LOAD NAME ARGUMENT ! 8482: > .ELSE ! 8483: 22247a21114 ! 8484: > .FI ! 8485: 22253,22255d21119 ! 8486: < .IF .CULC ! 8487: < BZE WA,TRC10 JUMP IF BLANK (VALUE) ! 8488: < .ELSE ! 8489: 22257d21120 ! 8490: < .FI ! 8491: 22273a21137 ! 8492: > MOV XL,WB COPY TRBLK PTR OR 0 ! 8493: 22280a21145 ! 8494: > ORB PFCTR(XR),WB STOPTR FAIL CHECK ! 8495: 22282c21147 ! 8496: < BEQ WA,=CH$LC,EXNUL EXIT WITH NULL IF C (CALL) ! 8497: --- ! 8498: > BEQ WA,=CH$LC,TRC11 RETURN IF LETTER C ! 8499: 22286,22287c21151,21153 ! 8500: < TRC02 MOV XL,PFRTR(XR) SET/RESET RETURN TRACE ! 8501: < EXI RETURN ! 8502: --- ! 8503: > TRC02 ORB PFRTR(XR),WB STOPTR FAIL CHECK ! 8504: > MOV XL,PFRTR(XR) SET/RESET RETURN TRACE ! 8505: > BRN TRC11 RETURN ! 8506: 22292a21159 ! 8507: > MOV (XS)+,WB GET TRBLK OR ZERO ! 8508: 22295a21163 ! 8509: > BRN TRCA4 MERGE ! 8510: 22299,22300c21167,21171 ! 8511: < TRC04 BEQ XL,=STNDL,TRC16 ERROR IF UNDEFINED LABEL ! 8512: < MOV (XS)+,WB GET TRBLK PTR AGAIN ! 8513: --- ! 8514: > TRC04 BZE WB,TRC12 FAIL IF STOPTR OF UNTRACED LABEL ! 8515: > * ! 8516: > * TEST FOR UNDEFINED LABEL ! 8517: > * ! 8518: > TRCA4 BEQ XL,=STNDL,TRC17 ERROR IF UNDEFINED LABEL ! 8519: 22326c21197 ! 8520: < * MERGE HERE WITH TRBLK SET UP IN WB (OR ZERO) ! 8521: --- ! 8522: > * MERGE HERE WITH TRBLK SET UP IN XL (OR ZERO) ! 8523: 22328a21200 ! 8524: > MOV XL,WB COPY TRBLK PR OR 0 ! 8525: 22334a21207 ! 8526: > ORB R$FNC,WB STOPTR FAIL CHECK ! 8527: 22336c21209 ! 8528: < EXI RETURN ! 8529: --- ! 8530: > BRN TRC11 RETURN ! 8531: 22340,22341c21213,21215 ! 8532: < TRC08 MOV XL,R$ERT SET/RESET ERRTYPE TRACE ! 8533: < EXI RETURN ! 8534: --- ! 8535: > TRC08 ORB R$ERT,WB STOPTR FAIL CHECK ! 8536: > MOV XL,R$ERT SET/RESET ERRTYPE TRACE ! 8537: > BRN TRC11 RETURN ! 8538: 22345,22346c21219,21221 ! 8539: < TRC09 MOV XL,R$STC SET/RESET STCOUNT TRACE ! 8540: < EXI RETURN ! 8541: --- ! 8542: > TRC09 ORB R$STC,WB STOPTR FAIL CHECK ! 8543: > MOV XL,R$STC SET/RESET STCOUNT TRACE ! 8544: > BRN TRC11 RETURN ! 8545: 22355,22357c21230,21234 ! 8546: < MOV (XS)+,WB GET NEW TRBLK PTR AGAIN ! 8547: < ADD XL,WA POINT TO VARIABLE LOCATION ! 8548: < MOV WA,XR COPY VARIABLE POINTER ! 8549: --- ! 8550: > MOV (XS)+,XR GET NEW TRBLK PTR AGAIN ! 8551: > MOV WC,WB COPY TRACE TYPE ! 8552: > JSR TRCHN UPDATE TRACE CHAIN ! 8553: > PPM TRC12 FAIL ! 8554: > EXI RETURN ! 8555: 22359c21236 ! 8556: < * LOOP TO SEARCH TRBLK CHAIN ! 8557: --- ! 8558: > * RETURN AFTER CHECKING STOPTR FAIL CONDITION (WB = 0) ! 8559: 22361,22367c21238,21239 ! 8560: < TRC11 MOV (XR),XL POINT TO NEXT ENTRY ! 8561: < BNE (XL),=B$TRT,TRC13 JUMP IF NOT TRBLK ! 8562: < BLT WC,TRTYP(XL),TRC13 JUMP IF TOO FAR OUT ON CHAIN ! 8563: < BEQ WC,TRTYP(XL),TRC12 JUMP IF THIS MATCHES OUR TYPE ! 8564: < ADD *TRNXT,XL ELSE POINT TO LINK FIELD ! 8565: < MOV XL,XR COPY POINTER ! 8566: < BRN TRC11 AND LOOP BACK ! 8567: --- ! 8568: > TRC11 ZRB WB,TRC12 FAIL IF NECESSARY ! 8569: > EXI ELSE RETURN ! 8570: 22369c21241 ! 8571: < * HERE TO DELETE AN OLD TRBLK OF THE TYPE WE WERE GIVEN ! 8572: --- ! 8573: > * FAIL STOPTR ! 8574: 22371,22372c21243 ! 8575: < TRC12 MOV TRNXT(XL),XL GET PTR TO NEXT BLOCK OR VALUE ! 8576: < MOV XL,(XR) STORE TO DELETE THIS TRBLK ! 8577: --- ! 8578: > TRC12 EXI 3 FAIL RETURN ! 8579: 22374,22388d21244 ! 8580: < * HERE AFTER DELETING ANY OLD ASSOCIATION OF THIS TYPE ! 8581: < * ! 8582: < TRC13 BZE WB,TRC14 JUMP IF STOPTR CASE ! 8583: < MOV WB,(XR) ELSE LINK NEW TRBLK IN ! 8584: < MOV WB,XR COPY TRBLK POINTER ! 8585: < MOV XL,TRNXT(XR) STORE FORWARD POINTER ! 8586: < MOV WC,TRTYP(XR) STORE APPROPRIATE TRAP TYPE CODE ! 8587: < * ! 8588: < * HERE TO MAKE SURE VRGET,VRSTO ARE SET PROPERLY ! 8589: < * ! 8590: < TRC14 MOV WA,XR RECALL POSSIBLE VRBLK POINTER ! 8591: < SUB *VRVAL,XR POINT BACK TO VRBLK ! 8592: < JSR SETVR SET FIELDS IF VRBLK ! 8593: < EXI RETURN ! 8594: < * ! 8595: 22409c21265 ! 8596: < * (XL) TRFNC OR TRFPT ! 8597: --- ! 8598: > * (XL) TRFNC OR TRTRI ! 8599: 22420,22421c21276,21277 ! 8600: < MOV XL,TRFNC(XR) STORE TRFNC (OR TRFPT) ! 8601: < MOV (XS)+,TRTAG(XR) STORE TRTAG (OR TRFNM) ! 8602: --- ! 8603: > MOV XL,TRFNC(XR) STORE TRFNC (OR TRTRI) ! 8604: > MOV (XS)+,TRTAG(XR) STORE TRTAG (OR TRTER) ! 8605: 22427a21284,21340 ! 8606: > * TRCHN -- UPDATE TRACE BLOCK CHAIN ! 8607: > * ! 8608: > * CALLED WHEN A TRACE BLOCK CHAIN IS TO BE UPDATED BY ! 8609: > * ADDITION OR REMOVAL OF A TRBLK. ! 8610: > * IF A TRBLK OF THE SAME TYPE AS AN ADDITION IS ALREADY ! 8611: > * PRESENT IT IS DELETED. THE TRTAG FIELD OF ANY DELETED ! 8612: > * TRBLK IS CLEARED AS REQUIRED BY S$ENF. ! 8613: > * ! 8614: > * (XL,WA) POINTER, OFFSET TO TRACED VARIABLE ! 8615: > * (XR) PTR TO NEW TRBLK OR 0 FOR REMOVAL ! 8616: > * (WB) TRACE TYPE (TRTYP) ! 8617: > * JSR TRCHN CALL TO UPDATE TRACE CHAIN ! 8618: > * PPM LOC NO TRACE BLK OF REQD DELETION TYPE ! 8619: > * (WA,WC) DESTROYED ! 8620: > * ! 8621: > TRCHN PRC E,1 ENTRY POINT ! 8622: > ADD XL,WA KEEP POINTER TO TRACED LOCATION ! 8623: > MOV WA,XL COPY POINTER ! 8624: > SUB *TRNXT,XL ADJUST OFFSET BEFORE ENTERING LOOP ! 8625: > MOV XR,WC COPY TRBLK PTR ! 8626: > * ! 8627: > * LOOP TO FIND TRACE BLOCK ! 8628: > * ! 8629: > TRCH1 MOV XL,XR COPY SO XR POINTS TO PREDECESSOR ! 8630: > MOV TRNXT(XL),XL POINT TO POSSIBLE TRACE BLOCK ! 8631: > BNE (XL),=B$TRT,TRCH2 SKIP OUT AT CHAIN END ! 8632: > BLT WB,TRTYP(XL),TRCH2 SKIP IF TOO FAR OUT ON CHAIN ! 8633: > BNE WB,TRTYP(XL),TRCH1 LOOP UNLESS TYPE MATCHES ! 8634: > MOV TRNXT(XL),TRNXT(XR) REMOVE LINK TO OLD TRBLK ! 8635: > ZER TRTAG(XL) CLEAR IOTAG FIELD OF DELETED BLOCK ! 8636: > BZE WC,TRCH3 DONE IF NO NEW TRBLK ! 8637: > * ! 8638: > * OLD TRBLK REMOVED AND/OR END OF CHAIN REACHED ! 8639: > * ! 8640: > TRCH2 BZE WC,TRCH4 FAIL IF REQD BLOCK TYPE NOT FOUND ! 8641: > MOV WC,XL POINT TO NEW TRBLK ! 8642: > MOV TRNXT(XR),TRNXT(XL) ATTACH TAIL OF CHAIN TO IT ! 8643: > MOV WC,TRNXT(XR) LINK NEW BLOCK IN ! 8644: > MOV WB,TRTYP(XL) ENSURE TRTYP FIELD SET UP ! 8645: > * ! 8646: > * UPDATE ACCESS FIELDS OF NAME IF IT IS A VRBLK ! 8647: > * ! 8648: > TRCH3 MOV WA,XR POINT TO VBL ! 8649: > SUB *VRVAL,XR ADJUST TO POSSIBLE VRBLK NAME BASE ! 8650: > JSR SETVR UPDATE ACCESS FIELDS ! 8651: > MOV WA,XL RECOVER XL ! 8652: > MOV WC,XR RECOVER XR ! 8653: > EXI RETURN TO CALLER ! 8654: > * ! 8655: > * FAIL RETURN ! 8656: > * ! 8657: > TRCH4 MOV WA,XL RECOVER XL ! 8658: > MOV WC,XR RECOVER XR ! 8659: > EXI 1 FAIL ! 8660: > ENP END PROCEDURE TRCHN ! 8661: > EJC ! 8662: > * ! 8663: 22475,22476c21388,21389 ! 8664: < PSC XL,WA READY FOR STORING BLANKS ! 8665: < CTB WA,SCHAR GET LENGTH OF BLOCK IN BYTES ! 8666: --- ! 8667: > PSC XL,WA READY FOR STORING ZEROES ! 8668: > CTB WA,SCHAR GET LENGTH OF BLOCK IN BAUS ! 8669: 22480c21393 ! 8670: < ZER WC SET BLANK CHAR ! 8671: --- ! 8672: > ZER WC SET ZERO CHAR ! 8673: 22562c21475 ! 8674: < TRXQ1 MOV FLPTR,XS POINT BACK TO OUR STACK ENTRIES ! 8675: --- ! 8676: > TRXQR MOV FLPTR,XS POINT BACK TO OUR STACK ENTRIES ! 8677: 22595a21509 ! 8678: > * (XSCNB) ERROR INDICATOR - SEE 4) BELOW ! 8679: 22596a21511,21513 ! 8680: > * LEADING BLANKS AND TRAILING BLANKS POSITIONED BEFORE A ! 8681: > * DELIMITER OR AT THE END OF THE ARGUMENT STRING ARE ! 8682: > * IGNORED. OTHER BLANKS ARE ILLEGAL. ! 8683: 22598c21515 ! 8684: < * UNTIL ONE OF THE FOLLOWING THREE CONDITIONS OCCURS. ! 8685: --- ! 8686: > * UNTIL ONE OF THE FOLLOWING CONDITIONS OCCURS. ! 8687: 22604c21521 ! 8688: < * 3) END OF STRING ENCOUNTERED (WA SET TO 0) ! 8689: --- ! 8690: > * 3) END OF STRING ENCOUNTERED (WA AND XSCNB SET TO 0) ! 8691: 22605a21523,21524 ! 8692: > * 4) ILLEGAL BLANK (WA 0, XSCNB NON-ZERO) ! 8693: > * ! 8694: 22622a21542,21543 ! 8695: > ZER XSCBL CLEAR COUNT OF TRAILING BLANKS ! 8696: > ZER XSCNB CLEAR NON-BLANK SEEN FLAG ! 8697: 22632c21553 ! 8698: < XSCN1 LCH WB,(XR)+ LOAD NEXT CHARACTER ! 8699: --- ! 8700: > XSCN0 LCH WB,(XR)+ LOAD NEXT CHARACTER ! 8701: 22635,22636c21556,21561 ! 8702: < DCV WA DECREMENT COUNT OF CHARS LEFT ! 8703: < BNZ WA,XSCN1 LOOP BACK IF MORE CHARS TO GO ! 8704: --- ! 8705: > BEQ WB,=CH$BL,XSCN7 SKIP IF IT IS A BLANK ! 8706: > .IF .CAHT ! 8707: > BEQ WB,=CH$HT,XSCN7 SKIP IF IT IS A TAB ! 8708: > .FI ! 8709: > BNZ XSCBL,XSCN2 FAIL CHAR AFTER TRAILING BLANK ! 8710: > MNZ XSCNB NOTE A NON-BLANK SEEN ! 8711: 22637a21563,21568 ! 8712: > * COUNT CHARS DONE ! 8713: > * ! 8714: > XSCN1 DCV WA DECREMENT COUNT OF CHARS LEFT ! 8715: > BNZ WA,XSCN0 LOOP BACK IF MORE CHARS TO GO ! 8716: > ZER XSCNB CLEAR ERRONEOUS BLANKS FLAG ! 8717: > * ! 8718: 22643a21575 ! 8719: > SUB XSCBL,WA ADJUST FOR TRAILING BLANKS ! 8720: 22665a21598 ! 8721: > SUB XSCBL,WA ADJUST FOR TRAILING BLANKS ! 8722: 22673a21607,21609 ! 8723: > .IF .CASL ! 8724: > JSR SBSTG BUILD SUBSTRING ! 8725: > .ELSE ! 8726: 22674a21611 ! 8727: > .FI ! 8728: 22677a21615,21625 ! 8729: > * ! 8730: > * DEAL WITH BLANK ! 8731: > * ! 8732: > XSCN7 BZE XSCNB,XSCN8 SKIP IF LEADING BLANK ! 8733: > ICV XSCBL ELSE COUNT TRAILING BLANK ! 8734: > BRN XSCN1 LOOP ! 8735: > * ! 8736: > * LEADING BLANK ! 8737: > * ! 8738: > XSCN8 ICV XSOFS PUSH OFFSET PAST BLANK ! 8739: > BRN XSCN1 LOOP ! 8740: 22753c21701 ! 8741: < WTB XR CONVERT TO BYTE OFFSET ! 8742: --- ! 8743: > WTB XR CONVERT TO BAU OFFSET ! 8744: 22765c21713 ! 8745: < ERB 235,SUBSCRIPTED OPERAND IS NOT TABLE OR ARRAY ! 8746: --- ! 8747: > ERB 240,SUBSCRIPTED OPERAND IS NOT TABLE OR ARRAY ! 8748: 22841c21789 ! 8749: < WTB WA CONVERT OFFSET TO BYTES ! 8750: --- ! 8751: > WTB WA CONVERT OFFSET TO BAUS ! 8752: 22853c21801 ! 8753: < ARF09 ERB 236,ARRAY REFERENCED WITH WRONG NUMBER OF SUBSCRIPTS ! 8754: --- ! 8755: > ARF09 ERB 241,ARRAY REFERENCED WITH WRONG NUMBER OF SUBSCRIPTS ! 8756: 22866c21814 ! 8757: < ARF11 ERB 237,TABLE REFERENCED WITH MORE THAN ONE SUBSCRIPT ! 8758: --- ! 8759: > ARF11 ERB 242,TABLE REFERENCED WITH MORE THAN ONE SUBSCRIPT ! 8760: 22870c21818 ! 8761: < ARF12 ERB 238,ARRAY SUBSCRIPT IS NOT INTEGER ! 8762: --- ! 8763: > ARF12 ERB 243,ARRAY SUBSCRIPT IS NOT INTEGER ! 8764: 22901c21849 ! 8765: < WTB WB CONVERT TO BYTES ! 8766: --- ! 8767: > WTB WB CONVERT TO BAUS ! 8768: 22921a21870,21888 ! 8769: > * EROSI -- PROCESS ERROR RETURN FROM OSINT ! 8770: > * ! 8771: > * (WA) 0 OR ERROR CODE IN 256 TO 998 ! 8772: > * (XL) 0 OR PSEUDO SCBLK FOR ERROR MESSAGE ! 8773: > * (IA) NEW VALUE FOR CODE KEYWORD ! 8774: > * BRN EROSI JUMP TO PROCESS ERROR ! 8775: > * ! 8776: > EROSI RTN ! 8777: > STI KVCOD STORE NEW CODE KEYWORD VALUE ! 8778: > MOV WA,KVERT STORE ERROR CODE ! 8779: > BZE XL,ERROR FAIL AT ONCE IF NO ERROR MSG TEXT ! 8780: > MOV SCLEN(XL),WA STRING LENGTH ! 8781: > ZER WB ZERO OFFSET ! 8782: > JSR SBSTR COPY ERROR MESSAGE STRING ! 8783: > MOV XR,R$ETX AND STORE IT ! 8784: > MNZ EROSN NOTE NO CALL OF SYSEM ! 8785: > MOV KVERT,WA RECALL ERROR CODE ! 8786: > BRN ERROR ENTER ERROR SECTION ! 8787: > * ! 8788: 22935d21901 ! 8789: < EJC ! 8790: 22972d21937 ! 8791: < EJC ! 8792: 22999d21963 ! 8793: < EJC ! 8794: 23015d21978 ! 8795: < EJC ! 8796: 23058d22020 ! 8797: < EJC ! 8798: 23070d22031 ! 8799: < EJC ! 8800: 23100c22061 ! 8801: < ERR 239,INDIRECTION OPERAND IS NOT NAME ! 8802: --- ! 8803: > ERR 244,INDIRECTION OPERAND IS NOT NAME ! 8804: 23131c22092 ! 8805: < ERR 240,PATTERN MATCH RIGHT OPERAND IS NOT PATTERN ! 8806: --- ! 8807: > ERR 245,PATTERN MATCH RIGHT OPERAND IS NOT PATTERN ! 8808: 23161c22122,22125 ! 8809: < ERR 241,PATTERN MATCH LEFT OPERAND IS NOT STRING ! 8810: --- ! 8811: > ERR 246,PATTERN MATCH LEFT OPERAND IS NOT STRING ! 8812: > .IF .CNBF ! 8813: > MOV XR,R$PMS IF OK, STORE SUBJECT STRING POINTER ! 8814: > .ELSE ! 8815: 23163c22127 ! 8816: < * MERGE WITH BUFFER OR STRING ! 8817: --- ! 8818: > * MERGE WITH NULL STRING OR BUFFER ! 8819: 23165a22130 ! 8820: > .FI ! 8821: 23173a22139 ! 8822: > EJC ! 8823: 23174a22141,22142 ! 8824: > * MATCH (CONTINUED) ! 8825: > * ! 8826: 23201c22169 ! 8827: < ERB 242,FUNCTION RETURN FROM LEVEL ZERO ! 8828: --- ! 8829: > ERB 247,FUNCTION RETURN FROM LEVEL ZERO ! 8830: 23227c22195 ! 8831: < MOV PFVBL(XR),XL LOAD VRBLK PTR (SGD13) ! 8832: --- ! 8833: > MOV PFVBL(XR),XL LOAD VRBLK POINTER ! 8834: 23260c22228 ! 8835: < JSR PRTNL TERMINATE PRINT LINE ! 8836: --- ! 8837: > JSR PRTFH TERMINATE PRINT LINE ! 8838: 23295c22263 ! 8839: < * HERE IF &PROFILE = 1. START TIME MUST BE FRIGGED TO ! 8840: --- ! 8841: > * HERE IF PROFILE = 1. START TIME MUST BE FRIGGED TO ! 8842: 23303c22271 ! 8843: < * HERE IF &PROFILE = 2 ! 8844: --- ! 8845: > * HERE IF PROFILE = 2 ! 8846: 23331a22300 ! 8847: > EJC ! 8848: 23332a22302,22303 ! 8849: > * RETRN (CONTINUED) ! 8850: > * ! 8851: 23344d22314 ! 8852: < EJC ! 8853: 23346,23347d22315 ! 8854: < * RETRN (CONTINUED) ! 8855: < * ! 8856: 23352c22320 ! 8857: < ERR 243,FUNCTION RESULT IN NRETURN IS NOT NAME ! 8858: --- ! 8859: > ERR 248,FUNCTION RESULT IN NRETURN IS NOT NAME ! 8860: 23393c22361 ! 8861: < ERB 244,STATEMENT COUNT EXCEEDS VALUE OF STLIMIT KEYWORD ! 8862: --- ! 8863: > ERB 249,STATEMENT COUNT EXCEEDS VALUE OF STLIMIT KEYWORD ! 8864: 23409a22378,22380 ! 8865: > * ! 8866: > * MERGE PROFILE, NO-PROFILE CASES ! 8867: > * ! 8868: 23432c22403,22404 ! 8869: < * (XR) POINTS TO ENDING MESSAGE ! 8870: --- ! 8871: > * (WA) 0 OR ERROR MESSAGE CODE ! 8872: > * (XR) 0 OR ENDING MESSAGE POINTER ! 8873: 23436c22408,22410 ! 8874: < * TO ENDING MESSAGE OR IS ZERO IF MESSAGE PRINTED ALREADY. ! 8875: --- ! 8876: > * TO ENDING MESSAGE OR IS ZERO IF MESSAGE PRINTED ALREADY. ! 8877: > * (WA) AND (XR) ARE BOTH NON-ZERO ONLY IN THE CASE OF FATAL ! 8878: > * ERRORS DURING INITIAL COMPILE. ! 8879: 23440d22413 ! 8880: < BZE XR,STPRA SKIP IF SYSAX ALREADY CALLED (REG04) ! 8881: 23442d22414 ! 8882: < STPRA ADD RSMEM,DNAME USE THE RESERVE MEMORY ! 8883: 23444d22415 ! 8884: < ADD RSMEM,DNAME USE THE RESERVE MEMORY ! 8885: 23446,23448c22417,22424 ! 8886: < BNE XR,=ENDMS,STPR0 SKIP IF NOT NORMAL END MESSAGE ! 8887: < BNZ EXSTS,STPR3 SKIP IF EXEC STATS SUPPRESSED ! 8888: < ZER ERICH CLEAR ERRORS TO INT.CH. FLAG ! 8889: --- ! 8890: > ADD RSMEM,DNAME USE THE RESERVE MEMORY ! 8891: > BZE WA,STPR1 SKIP IF NO ERROR MESSAGE ! 8892: > MOV XR,STPXR KEEP 0 OR ENDING MESSAGE ! 8893: > MOV TTERL,TTLST SEND ERROR AND STATS TO TERML ! 8894: > JSR PRTPG PAGE THROW ! 8895: > JSR ERMSG PRINT ERROR MESSAGE ! 8896: > MOV STPXR,XR RECOVER 0 OR ENDING MESSAGE ! 8897: > ZER EXSTS TO FORCE ENDING STATS OUT FOR ERROR ! 8898: 23450c22426 ! 8899: < * LOOK TO SEE IF AN ENDING MESSAGE IS SUPPLIED ! 8900: --- ! 8901: > * PROCESS ENDING STATISTICS ! 8902: 23452,23454c22428,22433 ! 8903: < STPR0 JSR PRTPG EJECT PRINTER ! 8904: < BZE XR,STPR1 SKIP IF NO MESSAGE ! 8905: < JSR PRTST PRINT MESSAGE ! 8906: --- ! 8907: > STPR1 MTI KVSTN GET STATEMENT NUMBER ! 8908: > IEQ STPR6 SKIP IF COMPILE TIME ! 8909: > BNZ EXSTS,STPR4 SKIP IF NO STATS TO BE PRINTED ! 8910: > JSR PRTPG EJECT PRINTER ! 8911: > BZE XR,STPR2 SKIP IF NO MESSAGE ! 8912: > JSR PRTFB PRINT MESSAGE ! 8913: 23458,23459c22437 ! 8914: < STPR1 JSR PRTIS PRINT BLANK LINE ! 8915: < MTI KVSTN GET STATEMENT NUMBER ! 8916: --- ! 8917: > STPR2 JSR PRTFH PRINT BLANK LINE ! 8918: 23461c22439 ! 8919: < JSR PRTMX PRINT IT ! 8920: --- ! 8921: > JSR PRTMI PRINT IT ! 8922: 23466c22444 ! 8923: < JSR PRTMX PRINT IT ! 8924: --- ! 8925: > JSR PRTMI PRINT IT ! 8926: 23468c22446 ! 8927: < ILT STPR2 SKIP IF NEGATIVE ! 8928: --- ! 8929: > ILT STPR3 SKIP IF NEGATIVE ! 8930: 23472c22450,22452 ! 8931: < JSR PRTMX PRINT IT ! 8932: --- ! 8933: > JSR PRTMI PRINT IT ! 8934: > .IF .CTMD ! 8935: > .ELSE ! 8936: 23475c22455 ! 8937: < IOV STPR2 JUMP IF WE CANNOT COMPUTE ! 8938: --- ! 8939: > IOV STPR3 JUMP IF WE CANNOT COMPUTE ! 8940: 23477c22457 ! 8941: < IOV STPR2 JUMP IF OVERFLOW ! 8942: --- ! 8943: > IOV STPR3 JUMP IF OVERFLOW ! 8944: 23479c22459,22460 ! 8945: < JSR PRTMX PRINT IT ! 8946: --- ! 8947: > JSR PRTMI PRINT IT ! 8948: > .FI ! 8949: 23486c22467 ! 8950: < STPR2 MTI GBCNT LOAD COUNT OF COLLECTIONS ! 8951: --- ! 8952: > STPR3 MTI GBCNT LOAD COUNT OF COLLECTIONS ! 8953: 23488,23489c22469,22470 ! 8954: < JSR PRTMX PRINT IT ! 8955: < JSR PRTIS ONE MORE BLANK FOR LUCK ! 8956: --- ! 8957: > JSR PRTMI PRINT IT ! 8958: > JSR PRTFH ONE MORE BLANK FOR LUCK ! 8959: 23494c22475 ! 8960: < STPR3 MOV KVDMP,XR LOAD DUMP KEYWORD ! 8961: --- ! 8962: > STPR4 MOV KVDMP,XR LOAD DUMP KEYWORD ! 8963: 23496,23497c22477 ! 8964: < STPR3 JSR PRFLR PRINT PROFILE IF WANTED ! 8965: < * ! 8966: --- ! 8967: > STPR4 JSR PRFLR PRINT PROFILE IF WANTED ! 8968: 23501,23503c22481,22484 ! 8969: < MOV R$FCB,XL GET FCBLK CHAIN HEAD ! 8970: < MOV KVABE,WA LOAD ABEND VALUE ! 8971: < MOV KVCOD,WB LOAD CODE VALUE ! 8972: --- ! 8973: > * ! 8974: > * MERGE TO END RUN FOR SEVERE COMPILATION ERRORS ! 8975: > * ! 8976: > STPR5 MOV =KVCOD,WA LOAD CODE VALUE ! 8977: 23504a22486,22496 ! 8978: > * ! 8979: > * TERMINATION DURING COMPILE ! 8980: > * ! 8981: > STPR6 BZE XR,STPR7 SKIP IF NO MESSAGE ! 8982: > JSR PRTSF ELSE PRINT IT ! 8983: > * ! 8984: > * NOTIFICATION THAT IT IS COMPILE TIME ! 8985: > * ! 8986: > STPR7 MOV =ENDIC,XR NOTIFY USER ! 8987: > JSR PRTSF SEND IT ! 8988: > BRN STPR5 END ! 8989: 23522,23542d22513 ! 8990: < EJC ! 8991: < * ! 8992: < * SYSAB -- PRINT /ABNORMAL END/ AND TERMINATE ! 8993: < * ! 8994: < SYSAB RTN ! 8995: < MOV =ENDAB,XR POINT TO MESSAGE ! 8996: < MOV =NUM01,KVABE SET ABEND FLAG ! 8997: < JSR PRTNL SKIP TO NEW LINE ! 8998: < BRN STOPR JUMP TO PACK UP ! 8999: < EJC ! 9000: < * ! 9001: < * SYSTU -- PRINT /TIME UP/ AND TERMINATE ! 9002: < * ! 9003: < SYSTU RTN ! 9004: < MOV =ENDTU,XR POINT TO MESSAGE ! 9005: < MOV STRTU,WA GET CHARS /TU/ ! 9006: < MOV WA,KVCOD PUT IN KVCOD ! 9007: < MOV TIMUP,WA CHECK STATE OF TIMEUP SWITCH ! 9008: < MNZ TIMUP SET SWITCH ! 9009: < BNZ WA,STOPR STOP RUN IF ALREADY SET ! 9010: < ERB 245,TRANSLATION/EXECUTION TIME EXPIRED ! 9011: 23548a22520 ! 9012: > STAKV RTN ENTRY POINT FOR STACK OVERFLOW ! 9013: 23552c22524 ! 9014: < ERB 246,STACK OVERFLOW ! 9015: --- ! 9016: > ERB 250,STACK OVERFLOW ! 9017: 23557a22530,22531 ! 9018: > ZER WA NO ERROR MESSAGE ! 9019: > MOV TTERL,TTLST SEND MESSAGE TO TERML IF POSSIBLE ! 9020: 23591c22565,22567 ! 9021: < ERROR BEQ R$CIM,=CMLAB,CMPLE JUMP IF ERROR IN SCANNING LABEL ! 9022: --- ! 9023: > ERROR RTN ERROR CODE ENTRY POINT ! 9024: > BGE ERRFT,=NUM03,ERR16 SKIP IF TOO MANY FATALS ! 9025: > BEQ R$CIM,=CMLAB,ERRG1 JUMP IF ERROR IN LABEL SCAN ! 9026: 23598,23601c22574,22577 ! 9027: < IFF STGXC,ERR04 EXECUTE TIME COMPILE ! 9028: < IFF STGEV,ERR04 EVAL COMPILING EXPR. ! 9029: < IFF STGEE,ERR04 EVAL EVALUATING EXPR ! 9030: < IFF STGXT,ERR05 EXECUTE TIME ! 9031: --- ! 9032: > IFF STGXC,ERR08 EXECUTE TIME COMPILE ! 9033: > IFF STGEV,ERR08 EVAL COMPILING EXPR. ! 9034: > IFF STGEE,ERR08 EVAL EVALUATING EXPR ! 9035: > IFF STGXT,ERR12 EXECUTE TIME ! 9036: 23603c22579 ! 9037: < IFF STGXE,ERR04 XEQ COMPILE-PAST END ! 9038: --- ! 9039: > IFF STGXE,ERR08 XEQ COMPILE-PAST END ! 9040: 23605d22580 ! 9041: < EJC ! 9042: 23608d22582 ! 9043: < * ! 9044: 23613d22586 ! 9045: < * ! 9046: 23617d22589 ! 9047: < * ! 9048: 23619a22592 ! 9049: > EJC ! 9050: 23623,23624c22596,22600 ! 9051: < BNZ ERRSP,ERR03 JUMP IF ERROR SUPPRESS FLAG SET ! 9052: < MOV ERICH,ERLST SET FLAG FOR LISTR ! 9053: --- ! 9054: > BNZ ERRSP,ERR06 JUMP IF ERROR SUPPRESS FLAG SET ! 9055: > JSR PRTFH PRINT A BLANK ! 9056: > MOV TTERL,TTLST SET FLAG FOR LISTR ! 9057: > ADD =NUM03,LSTLC CAUSE EJECT IF BELOW 4 LINES LEFT ! 9058: > MOV LSTLC,-(XS) KEEP LINE COUNT ! 9059: 23626,23629c22602,22609 ! 9060: < JSR PRTIS TERMINATE LISTING ! 9061: < ZER ERLST CLEAR LISTR FLAG ! 9062: < MOV SCNSE,WA LOAD SCAN ELEMENT OFFSET ! 9063: < BZE WA,ERR02 SKIP IF NOT SET ! 9064: --- ! 9065: > JSR PRTFH TERMINATE LISTING ! 9066: > MOV (XS)+,WA RECOVER LINE COUNT ! 9067: > BGT LSTLC,WA,ERR02 SKIP IF NOT NEW PAGE ! 9068: > ADD =NUM04,LSTLC BUMP FOR LINES PRINTED ! 9069: > * ! 9070: > * PRINT FLAG UNDER BAD ELEMENT ! 9071: > * ! 9072: > ERR02 MOV SCNSE,WA LOAD SCAN ELEMENT OFFSET ! 9073: 23631c22611 ! 9074: < LCT WB,WA LOOP COUNTER ! 9075: --- ! 9076: > MOV WA,WB COPY OFFSET ! 9077: 23635a22616 ! 9078: > BZE WB,ERR05 SKIP IF NO BLANKS BEFORE ERROR FLAG ! 9079: 23637a22619 ! 9080: > LCT WB,WB LOOP COUNTER ! 9081: 23641,23642c22623,22624 ! 9082: < ERRA1 LCH WC,(XL)+ GET NEXT CHAR ! 9083: < BEQ WC,=CH$HT,ERRA2 SKIP IF TAB ! 9084: --- ! 9085: > ERR03 LCH WC,(XL)+ GET NEXT CHAR ! 9086: > BEQ WC,=CH$HT,ERR04 SKIP IF TAB ! 9087: 23648,23650c22630,22636 ! 9088: < ERRA2 SCH WC,(XR)+ STORE CHAR ! 9089: < BCT WB,ERRA1 LOOP ! 9090: < MOV =CH$EX,XL EXCLAMATION MARK ! 9091: --- ! 9092: > ERR04 SCH WC,(XR)+ STORE CHAR ! 9093: > BCT WB,ERR03 LOOP ! 9094: > EJC ! 9095: > * ! 9096: > * MERGE IN CASE OF NO PRECEDING BLANKS ! 9097: > * ! 9098: > ERR05 MOV =CH$EX,XL EXCLAMATION MARK ! 9099: 23658c22644 ! 9100: < MFI GTNSI STORE AS SIGNED INTEGER ! 9101: --- ! 9102: > STI GTNSI STORE AS SIGNED INTEGER ! 9103: 23662c22648 ! 9104: < STI PROFS USE AS CHARACTER OFFSET ! 9105: --- ! 9106: > MFI PROFS USE AS CHARACTER OFFSET ! 9107: 23669,23670c22655,22656 ! 9108: < ERR02 JSR ERMSG GENERATE FLAG AND ERROR MESSAGE ! 9109: < ADD =NUM03,LSTLC BUMP PAGE CTR FOR BLANK, ERROR, BLK ! 9110: --- ! 9111: > JSR ERMSG GENERATE FLAG AND ERROR MESSAGE ! 9112: > ZER TTLST REVERT TO REGULAR LISTING ! 9113: 23672c22658,22659 ! 9114: < BHI ERRFT,=NUM03,STOPR PACK UP IF SEVERAL FATALS ! 9115: --- ! 9116: > ICV CMERC BUMP ERROR COUNT ! 9117: > BNE STAGE,=STGIC,ERRG2 SPECIAL RETURN IF AFTER END LINE ! 9118: 23674c22661,22662 ! 9119: < * COUNT ERROR, INHIBIT EXECUTION IF REQUIRED ! 9120: --- ! 9121: > * IF ERROR IN READR THEN EITHER CLOSE OUT ! 9122: > * CURRENT -COPY LEVEL, OR IF AT TOP THEN ABORT ! 9123: 23676,23679c22664,22667 ! 9124: < ICV CMERC BUMP ERROR COUNT ! 9125: < ADD CSWER,NOXEQ INHIBIT XEQ IF -NOERRORS ! 9126: < BNE STAGE,=STGIC,CMP10 SPECIAL RETURN IF AFTER END LINE ! 9127: < EJC ! 9128: --- ! 9129: > BZE RDRER,ERR06 SKIP IF NOT ERROR WHILE READING ! 9130: > BZE R$COP,ERR16 ABORT IF AT TOP LEVEL INPUT FILE ! 9131: > ZER RDRER ELSE CLEAR READR ERROR FLAG ! 9132: > JSR COPND AND CLOSE OUT THIS COPY LEVEL ! 9133: 23683c22671,22672 ! 9134: < ERR03 MOV R$CIM,XR POINT TO START OF IMAGE ! 9135: --- ! 9136: > ERR06 MOV R$CIM,XR POINT TO START OF IMAGE ! 9137: > BZE XR,ERR07 SKIP IF NO INPUT IMAGE ! 9138: 23686c22675 ! 9139: < BEQ XR,=CH$MN,CMPCE JUMP IF ERROR IN CONTROL CARD ! 9140: --- ! 9141: > BEQ XR,=CH$MN,ERRG3 JUMP IF ERROR IN CONTROL CARD ! 9142: 23690c22679 ! 9143: < BNE XL,=T$SMC,ERR03 LOOP BACK IF NOT STATEMENT END ! 9144: --- ! 9145: > BNE XL,=T$SMC,ERR06 LOOP BACK IF NOT STATEMENT END ! 9146: 23691a22681 ! 9147: > EJC ! 9148: 23695c22685 ! 9149: < MOV *CDCOD,CWCOF RESET OFFSET IN CCBLK ! 9150: --- ! 9151: > ERR07 MOV *CDCOD,CWCOF RESET OFFSET IN CCBLK ! 9152: 23701c22691,22692 ! 9153: < BRN CMPSE MERGE TO GENERATE ERROR AS CDFAL ! 9154: --- ! 9155: > JMG CMPSE MERGE TO GENERATE ERROR AS CDFAL ! 9156: > EJC ! 9157: 23703c22694 ! 9158: < * ERROR DURING EXECUTE TIME COMPILE OR EXPRESSION EVALUATIO ! 9159: --- ! 9160: > * ERROR DURING EXECUTE TIME COMPILE OR EXPRESSION EVALUATION. ! 9161: 23711c22702,22704 ! 9162: < ERR04 ZER R$CCB FORGET GARBAGE CODE BLOCK ! 9163: --- ! 9164: > ERR08 JSR COPND CALL TO CLOSE OFF THIS LEVEL ! 9165: > BNZ R$COP,ERR08 LOOP IF NOT ALL -COPYS CLOSED ! 9166: > ZER R$CCB FORGET GARBAGE CODE BLOCK ! 9167: 23719,23721c22712,22714 ! 9168: < ERRA4 ICA XS POP STACK ! 9169: < BEQ XS,FLPRT,ERRC4 JUMP IF PROG DEFINED FN CALL FOUND ! 9170: < BNE XS,GTCEF,ERRA4 LOOP IF NOT EVAL OR CODE CALL YET ! 9171: --- ! 9172: > ERR09 ICA XS POP STACK ! 9173: > BEQ XS,FLPRT,ERR11 JUMP IF PROG DEFINED FN CALL FOUND ! 9174: > BNE XS,GTCEF,ERR09 LOOP IF NOT EVAL OR CODE CALL YET ! 9175: 23729c22722 ! 9176: < ERRB4 BNZ KVERL,ERR07 JUMP IF ERRLIMIT NON-ZERO ! 9177: --- ! 9178: > ERR10 BNZ KVERL,ERR14 JUMP IF ERRLIMIT NON-ZERO ! 9179: 23734,23736c22727,22728 ! 9180: < ERRC4 MOV FLPTR,XS RESTORE STACK FROM FLPTR ! 9181: < BRN ERRB4 MERGE ! 9182: < EJC ! 9183: --- ! 9184: > ERR11 MOV FLPTR,XS RESTORE STACK FROM FLPTR ! 9185: > BRN ERR10 MERGE ! 9186: 23742,23744c22734 ! 9187: < * IF ERRLIMIT KEYWORD IS ZERO, AN ABORT IS SIGNALLED, ! 9188: < * SEE CODING FOR SYSTEM LABEL ABORT AT L$ABO. ! 9189: < * ! 9190: --- ! 9191: > * IF ERRLIMIT KEYWORD IS ZERO, THE RUN IS ABORTED. ! 9192: 23749c22739 ! 9193: < * IF 3 OR MORE FATAL ERRORS OCCUR AN ABORT IS SIGNALLED ! 9194: --- ! 9195: > * IF 3 OR MORE FATAL ERRORS OCCUR AN ABORT OCCURS ! 9196: 23752a22743 ! 9197: > EJC ! 9198: 23754,23755c22745,22746 ! 9199: < ERR05 SSL INISS RESTORE MAIN PROG S-R STACK PTR ! 9200: < BNZ DMVCH,ERR08 JUMP IF IN MID-DUMP ! 9201: --- ! 9202: > ERR12 SSL INISS RESTORE MAIN PROG S-R STACK PTR ! 9203: > BNZ DMVCH,ERR15 JUMP IF IN MID-DUMP ! 9204: 23757c22748 ! 9205: < * MERGE HERE FROM ERR08 ! 9206: --- ! 9207: > * MERGE HERE AFTER DUMP TIDY UP ! 9208: 23759c22750,22751 ! 9209: < ERR06 BZE KVERL,LABO1 ABORT IF ERRLIMIT IS ZERO ! 9210: --- ! 9211: > ERR13 ZER XR CLEAR XR FLAG ! 9212: > BZE KVERL,STOPR ABORT IF ERRLIMIT IS ZERO ! 9213: 23762c22754 ! 9214: < * MERGE FROM ERR04 ! 9215: --- ! 9216: > * MERGE AFTER ERRLIMIT TEST ! 9217: 23764,23765c22756 ! 9218: < ERR07 BGE ERRFT,=NUM03,LABO1 ABORT IF TOO MANY FATAL ERRORS ! 9219: < DCV KVERL DECREMENT ERRLIMIT ! 9220: --- ! 9221: > ERR14 DCV KVERL DECREMENT ERRLIMIT ! 9222: 23772c22763 ! 9223: < BZE XR,LCNT1 CONTINUE IF NO SETEXIT TRAP ! 9224: --- ! 9225: > BZE XR,ERRG4 CONTINUE IF NO SETEXIT TRAP ! 9226: 23781,23782c22772,22773 ! 9227: < ERR08 MOV DMVCH,XR CHAIN HEAD FOR AFFECTED VRBLKS ! 9228: < BZE XR,ERR06 DONE IF ZERO ! 9229: --- ! 9230: > ERR15 MOV DMVCH,XR CHAIN HEAD FOR AFFECTED VRBLKS ! 9231: > BZE XR,ERR13 DONE IF ZERO ! 9232: 23785c22776,22795 ! 9233: < BRN ERR08 LOOP THROUGH CHAIN ! 9234: --- ! 9235: > BRN ERR15 LOOP THROUGH CHAIN ! 9236: > * ! 9237: > * TAKE DRACONIAN STEPS FOR REPEATED FATAL ERRORS ! 9238: > * ! 9239: > ERR16 MOV ERRTF,WA ERROR CODE ! 9240: > MOV WA,KVERT PLACE ERROR CODE FOR ERMSG ! 9241: > MNZ XR IN CASE COMPILE TIME ! 9242: > BEQ STAGE,=STGIC,STOPR JUMP IF SO ! 9243: > BEQ STAGE,=STGCE,STOPR ALSO COMPILE TIME ! 9244: > ZER XR INDICATE EXECUTION ! 9245: > BRN STOPR TERMINATE RUN ! 9246: > * ! 9247: > ERRAF ERB 251,TOO MANY FATAL ERRORS ! 9248: > * ! 9249: > * HERE FOR GLOBAL ERROR JUMPS ! 9250: > * ! 9251: > ERRG1 JMG CMPLE ! 9252: > ERRG2 JMG CMPEE ! 9253: > ERRG3 JMG CMPCE ! 9254: > ERRG4 JMG LCNXE ! 9255: 23791,23801d22800 ! 9256: < ! 9257: < ! 9258: < ! 9259: < ! 9260: < ! 9261: < ! 9262: < ! 9263: < ! 9264: < ! 9265: < ! 9266: <
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.