![[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.