![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to spitv35.tok CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / spitbol|
Return to spitv35.tok CVS log | Up to [Research Unix] / researchv10dc / cmd / spitbol |
1.1 root 1: {{TTL{S{{{P I T B O L - REVISION HISTORY
2: {{EJC{{{{
3: * R E V I S I O N H I S T O R Y
4: * -------------------------------
5: *
6: *
7: * VERSION 3.5B (FEB 81... - SGD PATCHES)
8: * -----------------------------------
9: *
10: * SGD03 - ADDITION OF .CNCI AND SYSCI (INT->STRING
11: * SYSTEM ROUTINE OPTION)
12: * SGD04 - (06-MAY-1981) MODIFIED INILN TO 132
13: * SGD05 - (13-MAY-1981) INSERTED MISSING WTB AFTER SYSMM
14: * CALLS
15: * SGD06 - (25-MAY-1981) MERGED IN PROFILER PATCHES
16: * (NOT MARKED)
17: * SGD07 - (25-MAY-1981) MUCHO PATCHES TO PROFILER (MARKED,
18: * BUT BEST JUST TO EXTRACT ENMASSE)
19: * SGD08 - (25-MAY-1981) USE STRING LENGTH IN HASHS
20: * SGD09 - (25-MAY-1981) FIXED SERIOUS PARSER PROBLEM
21: * RELATING TO (X Y) ON LINE BEING VIEWED AS PATTERN
22: * MATCH. FIXED BY ADDITION OF NEW CMTYP VALUE
23: * C$CNP (CONCATENATION - NOT PATTERN MATCH)
24: * SGD10 - (01-AUG-1981) FIXED EXIT(N) RESPECIFICATION CODE
25: * TO PROPERLY OBSERVE HEADER SEMANTICS ON RETURN.
26: * SGD11 - (07-AUG-1981) BYPASS PRTPG CALL AT INITIALIZATION
27: * FOLLOWING COMPILATION IF NO OUTPUT GENERATED.
28: * THIS PREVENTS OUTPUT FILES CONSISTING OF THE
29: * HEADERS AND A FEW BLANK LINES WHEN THERE IS NO
30: * SOURCE LISTING AND NO COMPILATION STATS.
31: * ALSO FIX TIMSX INITIALIZATION IN SAME CODE.
32: * SGD12 - (17-AUG-1981) B$EFC CODE DID NOT CHECK FOR
33: * UNCONVERTED RESULT RETURNING NULL STRING. FIXED.
34: * SGDBF - ( NOV-1981) ADDED BUFFER TYPE AND SYMBOL CNBF
35: * SGD13 - (03-MAR-1982) LOAD PFVBL FIELD IN RETRN FOR
36: * RETURN TRACING. THIS WAS CAUSING BUG ON RETURN
37: * TRACES THAT TRIED TO ACCESS THE VARIABLE NAME
38: * SGD14 - ADDED CHAR FUNCTION. CHAR(N) RETURNS NTH
39: * CHARACTER OF HOST MACHINE CHARACTER SET.
40: * NOT CONDITIONALIZED OR MARKED.
41: * SGD15 - FIXED PROBLEM RELATING TO COMPILATION OF GOTO
42: * FIELDS CONTAINING SMALL INTEGERS (IN CONST SEC).
43: *
44: * REG01 - (XX-AUG-82)
45: * ADDED CFP$U TO EASE TRANSLATION ON SMALLER
46: * SYSTEMS - CONDITIONAL .CUCF
47: * ADDED LOWER CASE SUPPORT - CONDITIONAL .CULC
48: * ADDED SET I/O FUNCTION - CONDITIONAL .CUST
49: *
50: * REG02 - (XX-SEP-82)
51: * CHANGED INILN AND AND INILS TO 258
52: *
53: * REG03 - (XX-OCT-82)
54: * CONDITIONALIZED THE PAGE EJECT AFTER CALL TO SYSBX
55: * AND ADDED ANOTHER BEFORE CALL TO SYSBX, SO THAT,
56: * IF DESIRED BY THE IMPLEMENTOR, STANDARD OUTPUT
57: * WILL REFLECT ASSIGNMENTS MADE BY EXECUTING PROGRAM
58: * ONLY. CONDITIONAL .CUEJ CONTROLS - IF DEFINED
59: * EJECT IS BEFORE CALL TO SYSBX.
60: *
61: * REG04 - (XX-NOV-82)
62: * FIXED DIFFICULTIES WITH LISTINGS DURING EXECUTION
63: * WHEN NO LISTING GENERATED DURING COMPILATION.
64: *
65: * -LIST TO CODE() CAUSED BOMB. FIX IS TO RESET
66: * R$TTL AND R$STL TO NULLS NOT 0 AFTER COMPILATION.
67: * (LISTR AND LISTT EXPECT NULLS)
68: *
69: * WHEN LISTING AND STATISTICS ROUTED TO DIFFERENT
70: * FILE THAN EXECUTION OUTPUT, ERROR MESSAGE IS SENT
71: * TO EXECUTION OUTPUT (AND GETS SEPARATED FROM
72: * ... IN STATEMENT ... MSG). LABO1 CALLS SYSAX AND
73: * STOPR DOES NOT CALL SYSAX IF ENTERED FROM LABO1.
74: *
75: * REG05 - (XX-NOV-82)
76: * PREVENT CLEAR() FROM CLOBBERING PROTECTED VARIABLES
77: * AT LABEL SCLR5.
78: *
79: * REG06 - (XX-NOV-82)
80: * FIXED GTEXP FROM ACCEPTING TRAILING SEMICOLON OR
81: * COLON. NOT LEGAL WAY TO END AN EXPRESSION.
82: *
83: * VERSION 3.5A (OCT 79 - SGD PATCHES)
84: * -----------------------------------
85: *
86: * SGD01 - PATCH IN ASIGN TO FIX MULTIPLE TRAP BLOCK PROBLEM
87: * (ASG10+2)
88: * SGD02 - PATCH IN GTARR TO FIX NULL CONVERT (GTAR9+0)
89: *
90: {{TTL{S{{{P I T B O L -- BASIC INFORMATION
91: {{EJC{{{{
92: *
93: * GENERAL STRUCTURE
94: * -----------------
95: *
96: * THIS PROGRAM IS A TRANSLATOR FOR A VERSION OF THE SNOBOL4
97: * PROGRAMMING LANGUAGE. LANGUAGE DETAILS ARE CONTAINED IN
98: * THE MANUAL MACRO SPITBOL BY DEWAR AND MCCANN, TECHNICAL
99: * REPORT 90, UNIVERSITY OF LEEDS 1976. THE LANGUAGE
100: * IS IDENTICAL TO THAT IMPLEMENTED BY THE BTL TRANSLATOR
101: * (R. E. GRISWOLD ET AL.) WITH THE FOLLOWING EXCEPTIONS.
102: *
103: * 1) REDEFINITION OF STANDARD SYSTEM FUNCTIONS AND
104: * OPERATORS IS NOT PERMITTED.
105: *
106: * 2) THE VALUE FUNCTION IS NOT PROVIDED.
107: *
108: * 3) ACCESS TRACING IS PROVIDED IN ADDITION TO THE
109: * OTHER STANDARD TRACE MODES.
110: *
111: * 4) THE KEYWORD STFCOUNT IS NOT PROVIDED.
112: *
113: * 5) THE KEYWORD FULLSCAN IS NOT PROVIDED AND ALL PATTERN
114: * MATCHING TAKES PLACE IN FULLSCAN MODE (I.E. WITH NO
115: * HEURISTICS APPLIED).
116: *
117: * 6) A SERIES OF EXPRESSIONS SEPARATED BY COMMAS MAY
118: * BE GROUPED WITHIN PARENTHESES TO PROVIDE A SELECTION
119: * CAPABILITY. THE SEMANTICS ARE THAT THE SELECTION
120: * ASSUMES THE VALUE OF THE FIRST EXPRESSION WITHIN IT
121: * WHICH SUCCEEDS AS THEY ARE EVALUATED FROM THE LEFT.
122: * IF NO EXPRESSION SUCCEEDS THE ENTIRE STATEMENT FAILS
123: *
124: * 7) AN EXPLICIT PATTERN MATCHING OPERATOR IS PROVIDED.
125: * THIS IS THE BINARY QUERY (SEE GIMPEL SIGPLAN OCT 74)
126: *
127: * 8) THE ASSIGNMENT OPERATOR IS INTRODUCED AS IN THE
128: * GIMPEL REFERENCE.
129: *
130: * 9) THE EXIT FUNCTION IS PROVIDED FOR GENERATING LOAD
131: * MODULES - CF. GIMPELS SITBOL.
132: *
133: *
134: * THE METHOD USED IN THIS PROGRAM IS TO TRANSLATE THE
135: * SOURCE CODE INTO AN INTERNAL PSEUDO-CODE (SEE FOLLOWING
136: * SECTION). AN INTERPRETOR IS THEN USED TO EXECUTE THIS
137: * GENERATED PSEUDO-CODE. THE NATURE OF THE SNOBOL4 LANGUAGE
138: * IS SUCH THAT THE LATTER TASK IS MUCH MORE COMPLEX THAN
139: * THE ACTUAL TRANSLATION PHASE. ACCORDINGLY, NEARLY ALL THE
140: * CODE IN THE PROGRAM SECTION IS CONCERNED WITH THE ACTUAL
141: * EXECUTION OF THE SNOBOL4 PROGRAM.
142: {{EJC{{{{
143: *
144: * INTERPRETIVE CODE FORMAT
145: * ------------------------
146: *
147: * THE INTERPRETIVE PSEUDO-CODE CONSISTS OF A SERIES OF
148: * ADDRESS POINTERS. THE EXACT FORMAT OF THE CODE IS
149: * DESCRIBED IN CONNECTION WITH THE CDBLK FORMAT. THE
150: * PURPOSE OF THIS SECTION IS TO GIVE GENERAL INSIGHT INTO
151: * THE INTERPRETIVE APPROACH INVOLVED.
152: *
153: * THE BASIC FORM OF THE CODE IS RELATED TO REVERSE POLISH.
154: * IN OTHER WORDS, THE OPERANDS PRECEDE THE OPERATORS WHICH
155: * ARE ZERO ADDRESS OPERATORS. THERE ARE SOME EXCEPTIONS TO
156: * THESE RULES, NOTABLY THE UNARY NOT OPERATOR AND THE
157: * SELECTION CONSTRUCTION WHICH CLEARLY REQUIRE ADVANCE
158: * KNOWLEDGE OF THE OPERATOR INVOLVED.
159: *
160: * THE OPERANDS ARE MOVED TO THE TOP OF THE MAIN STACK AND
161: * THE OPERATORS ARE APPLIED TO THE TOP STACK ENTRIES. LIKE
162: * OTHER VERSIONS OF SPITBOL, THIS PROCESSOR DEPENDS ON
163: * KNOWING WHETHER OPERANDS ARE REQUIRED BY NAME OR BY VALUE
164: * AND MOVES THE APPROPRIATE OBJECT TO THE STACK. THUS NO
165: * NAME/VALUE CHECKS ARE INCLUDED IN THE OPERATOR CIRCUITS.
166: *
167: * THE ACTUAL POINTERS IN THE CODE POINT TO A BLOCK WHOSE
168: * FIRST WORD IS THE ADDRESS OF THE INTERPRETOR ROUTINE
169: * TO BE EXECUTED FOR THE CODE WORD.
170: *
171: * IN THE CASE OF OPERATORS, THE POINTER IS TO A WORD WHICH
172: * CONTAINS THE ADDRESS OF THE OPERATOR TO BE EXECUTED. IN
173: * THE CASE OF OPERANDS SUCH AS CONSTANTS, THE POINTER IS TO
174: * THE OPERAND ITSELF. ACCORDINGLY, ALL OPERANDS CONTAIN
175: * A FIELD WHICH POINTS TO THE ROUTINE TO LOAD THE VALUE OF
176: * THE OPERAND ONTO THE STACK. IN THE CASE OF A VARIABLE,
177: * THERE ARE THREE SUCH POINTERS. ONE TO LOAD THE VALUE,
178: * ONE TO STORE THE VALUE AND A THIRD TO JUMP TO THE LABEL.
179: *
180: * THE HANDLING OF FAILURE RETURNS DESERVES SPECIAL COMMENT.
181: * THE LOCATION FLPTR CONTAINS THE POINTER TO THE LOCATION
182: * ON THE MAIN STACK WHICH CONTAINS THE FAILURE RETURN
183: * WHICH IS IN THE FORM OF A BYTE OFFSET IN THE CURRENT
184: * CODE BLOCK (CDBLK OR EXBLK). WHEN A FAILURE OCCURS, THE
185: * STACK IS POPPED AS INDICATED BY THE SETTING OF FLPTR AND
186: * CONTROL IS PASSED TO THE APPROPRIATE LOCATION IN THE
187: * CURRENT CODE BLOCK WITH THE STACK POINTER POINTING TO THE
188: * FAILURE OFFSET ON THE STACK AND FLPTR UNCHANGED.
189: {{EJC{{{{
190: *
191: * INTERNAL DATA REPRESENTATIONS
192: * -----------------------------
193: *
194: * REPRESENTATION OF VALUES
195: *
196: * A VALUE IS REPRESENTED BY A POINTER TO A BLOCK WHICH
197: * DESCRIBES THE TYPE AND PARTICULARS OF THE DATA VALUE.
198: * IN GENERAL, A VARIABLE IS A LOCATION CONTAINING SUCH A
199: * POINTER (ALTHOUGH IN THE CASE OF TRACE ASSOCIATIONS THIS
200: * IS MODIFIED, SEE DESCRIPTION OF TRBLK).
201: *
202: * THE FOLLOWING IS A LIST OF POSSIBLE DATATYPES SHOWING THE
203: * TYPE OF BLOCK USED TO HOLD THE VALUE. THE DETAILS OF
204: * EACH BLOCK FORMAT ARE GIVEN LATER.
205: *
206: * DATATYPE BLOCK TYPE
207: * -------- ----------
208: *
209: *
210: * ARRAY ARBLK OR VCBLK
211: *
212: * CODE CDBLK
213: *
214: * EXPRESSION EXBLK OR SEBLK
215: *
216: * INTEGER ICBLK
217: *
218: * NAME NMBLK
219: *
220: * PATTERN P0BLK OR P1BLK OR P2BLK
221: *
222: * REAL RCBLK
223: *
224: * STRING SCBLK
225: *
226: * TABLE TBBLK
227: *
228: * PROGRAM DATATYPE PDBLK
229: {{EJC{{{{
230: *
231: * REPRESENTATION OF VARIABLES
232: * ---------------------------
233: *
234: * DURING THE COURSE OF EVALUATING EXPRESSIONS, IT IS
235: * NECESSARY TO GENERATE NAMES OF VARIABLES (FOR EXAMPLE
236: * ON THE LEFT SIDE OF A BINARY EQUALS OPERATOR). THESE ARE
237: * NOT TO BE CONFUSED WITH OBJECTS OF DATATYPE NAME WHICH
238: * ARE IN FACT VALUES.
239: *
240: * FROM A LOGICAL POINT OF VIEW, SUCH NAMES COULD BE SIMPLY
241: * REPRESENTED BY A POINTER TO THE APPROPRIATE VALUE CELL.
242: * HOWEVER IN THE CASE OF ARRAYS AND PROGRAM DEFINED
243: * DATATYPES, THIS WOULD VIOLATE THE RULE THAT THERE MUST BE
244: * NO POINTERS INTO THE MIDDLE OF A BLOCK IN DYNAMIC STORE.
245: * ACCORDINGLY, A NAME IS ALWAYS REPRESENTED BY A BASE AND
246: * OFFSET. THE BASE POINTS TO THE START OF THE BLOCK
247: * CONTAINING THE VARIABLE VALUE AND THE OFFSET IS THE
248: * OFFSET WITHIN THIS BLOCK IN BYTES. THUS THE ADDRESS
249: * OF THE ACTUAL VARIABLE IS DETERMINED BY ADDING THE BASE
250: * AND OFFSET VALUES.
251: *
252: * THE FOLLOWING ARE THE INSTANCES OF VARIABLES REPRESENTED
253: * IN THIS MANNER.
254: *
255: * 1) NATURAL VARIABLE BASE IS PTR TO VRBLK
256: * OFFSET IS *VRVAL
257: *
258: * 2) TABLE ELEMENT BASE IS PTR TO TEBLK
259: * OFFSET IS *TEVAL
260: *
261: * 3) ARRAY ELEMENT BASE IS PTR TO ARBLK
262: * OFFSET IS OFFSET TO ELEMENT
263: *
264: * 4) VECTOR ELEMENT BASE IS PTR TO VCBLK
265: * OFFSET IS OFFSET TO ELEMENT
266: *
267: * 5) PROG DEF DTP BASE IS PTR TO PDBLK
268: * OFFSET IS OFFSET TO FIELD VALUE
269: *
270: * IN ADDITION THERE ARE TWO CASES OF OBJECTS WHICH ARE
271: * LIKE VARIABLES BUT CANNOT BE HANDLED IN THIS MANNER.
272: * THESE ARE CALLED PSEUDO-VARIABLES AND ARE REPRESENTED
273: * WITH A SPECIAL BASE POINTER AS FOLLOWS=
274: *
275: * EXPRESSION VARIABLE PTR TO EVBLK (SEE EVBLK)
276: *
277: * KEYWORD VARIABLE PTR TO KVBLK (SEE KVBLK)
278: *
279: * PSEUDO-VARIABLES ARE HANDLED AS SPECIAL CASES BY THE
280: * ACCESS PROCEDURE (ACESS) AND THE ASSIGNMENT PROCEDURE
281: * (ASIGN). SEE THESE TWO PROCEDURES FOR DETAILS.
282: {{EJC{{{{
283: *
284: * ORGANIZATION OF DATA AREA
285: * -------------------------
286: *
287: *
288: * THE DATA AREA IS DIVIDED INTO TWO REGIONS.
289: *
290: * STATIC AREA
291: *
292: * THE STATIC AREA BUILDS UP FROM THE BOTTOM AND CONTAINS
293: * DATA AREAS WHICH ARE ALLOCATED DYNAMICALLY BUT ARE NEVER
294: * DELETED OR MOVED AROUND. THE MACRO-PROGRAM ITSELF
295: * USES THE STATIC AREA FOR THE FOLLOWING.
296: *
297: * 1) ALL VARIABLE BLOCKS (VRBLK).
298: *
299: * 2) THE HASH TABLE FOR VARIABLE BLOCKS.
300: *
301: * 3) MISCELLANEOUS BUFFERS AND WORK AREAS (SEE PROGRAM
302: * INITIALIZATION SECTION).
303: *
304: * IN ADDITION, THE SYSTEM PROCEDURES MAY USE THIS AREA FOR
305: * INPUT/OUTPUT BUFFERS, EXTERNAL FUNCTIONS ETC. SPACE IN
306: * THE STATIC REGION IS ALLOCATED BY CALLING PROCEDURE ALOST
307: *
308: * THE FOLLOWING GLOBAL VARIABLES DEFINE THE CURRENT
309: * LOCATION AND SIZE OF THE STATIC AREA.
310: *
311: * STATB ADDRESS OF START OF STATIC AREA
312: * STATE ADDRESS+1 OF LAST WORD IN AREA.
313: *
314: * THE MINIMUM SIZE OF STATIC IS GIVEN APPROXIMATELY BY
315: * 12 + *E$HNB + *E$STS + SPACE FOR ALPHABET STRING
316: * AND STANDARD PRINT BUFFER.
317: {{EJC{{{{
318: *
319: * DYNAMIC AREA
320: *
321: * THE DYNAMIC AREA IS BUILT UPWARDS IN MEMORY AFTER THE
322: * STATIC REGION. DATA IN THIS AREA MUST ALL BE IN STANDARD
323: * BLOCK FORMATS SO THAT IT CAN BE PROCESSED BY THE GARBAGE
324: * COLLECTOR (PROCEDURE GBCOL). GBCOL COMPACTS BLOCKS DOWN
325: * IN THIS REGION AS REQUIRED BY SPACE EXHAUSTION AND CAN
326: * ALSO MOVE ALL BLOCKS UP TO ALLOW FOR EXPANSION OF THE
327: * STATIC REGION.
328: * WITH THE EXCEPTION OF TABLES AND ARRAYS, NO SPITBOL
329: * OBJECT ONCE BUILT IN DYNAMIC MEMORY IS EVER SUBSEQUENTLY
330: * MODIFIED. OBSERVING THIS RULE NECESSITATES A COPYING
331: * ACTION DURING STRING AND PATTERN CONCATENATION.
332: *
333: * GARBAGE COLLECTION IS FUNDAMENTAL TO THE ALLOCATION OF
334: * SPACE FOR VALUES. SPITBOL USES A VERY EFFICIENT GARBAGE
335: * COLLECTOR WHICH INSISTS THAT POINTERS INTO DYNAMIC STORE
336: * SHOULD BE IDENTIFIABLE WITHOUT USE OF BIT TABLES,
337: * MARKER BITS ETC. TO SATISFY THIS REQUIREMENT, DYNAMIC
338: * MEMORY MUST NOT START AT TOO LOW AN ADDRESS AND LENGTHS
339: * OF ARRAYS, TABLES, STRINGS, CODE AND EXPRESSION BLOCKS
340: * MAY NOT EXCEED THE NUMERICAL VALUE OF THE LOWEST DYNAMIC
341: * ADDRESS. TO AVOID EITHER PENALIZING USERS WITH MODEST
342: * REQUIREMENTS OR RESTRICTING THOSE WITH GREATER NEEDS ON
343: * HOST SYSTEMS WHERE DYNAMIC MEMORY IS ALLOCATED IN LOW
344: * ADDRESSES, THE MINIMUM DYNAMIC ADDRESS MAY BE SPECIFIED
345: * SUFFICIENTLY HIGH TO PERMIT ARBITRARILY LARGE SPITBOL
346: * OBJECTS TO BE CREATED ( WITH THE POSSIBILITY IN EXTREME
347: * CASES OF WASTING LARGE AMOUNTS OF MEMORY BELOW THE
348: * START ADDRESS). THIS MINIMUM VALUE IS MADE AVAILABLE
349: * IN VARIABLE MXLEN BY A SYSTEM ROUTINE, SYSMX.
350: * ALTERNATIVELY SYSMX MAY INDICATE THAT A
351: * DEFAULT MAY BE USED IN WHICH DYNAMIC IS PLACED
352: * AT THE LOWEST POSSIBLE ADDRESS FOLLOWING STATIC.
353: *
354: * THE FOLLOWING GLOBAL WORK CELLS DEFINE THE LOCATION AND
355: * LENGTH OF THE DYNAMIC AREA.
356: *
357: * DNAMB START OF DYNAMIC AREA
358: * DNAMP NEXT AVAILABLE LOCATION
359: * DNAME LAST AVAILABLE LOCATION + 1
360: *
361: * DNAMB IS ALWAYS HIGHER THAN STATE SINCE THE ALOST
362: * PROCEDURE MAINTAINS SOME EXPANSION SPACE ABOVE STATE.
363: * *** DNAMB MUST NEVER BE PERMITTED TO HAVE A VALUE LESS
364: * THAN THAT IN MXLEN ***
365: *
366: * SPACE IN THE DYNAMIC REGION IS ALLOCATED BY THE ALLOC
367: * PROCEDURE. THE DYNAMIC REGION MAY BE USED BY SYSTEM
368: * PROCEDURES PROVIDED THAT ALL THE RULES ARE OBEYED.
369: {{EJC{{{{
370: *
371: * REGISTER USAGE
372: * --------------
373: *
374: * (CP) CODE POINTER REGISTER. USED TO
375: * HOLD A POINTER TO THE CURRENT
376: * LOCATION IN THE INTERPRETIVE PSEUDO
377: * CODE (I.E. PTR INTO A CDBLK).
378: *
379: * (XL,XR) GENERAL INDEX REGISTERS. USUALLY
380: * USED TO HOLD POINTERS TO BLOCKS IN
381: * DYNAMIC STORAGE. AN IMPORTANT
382: * RESTRICTION IS THAT THE VALUE IN
383: * XL MUST BE COLLECTABLE FOR
384: * A GARBAGE COLLECT CALL. A VALUE
385: * IS COLLECTABLE IF IT EITHER POINTS
386: * OUTSIDE THE DYNAMIC AREA, OR IF IT
387: * POINTS TO THE START OF A BLOCK IN
388: * THE DYNAMIC AREA.
389: *
390: * (XS) STACK POINTER. USED TO POINT TO
391: * THE STACK FRONT. THE STACK MAY
392: * BUILD UP OR DOWN AND IS USED
393: * TO STACK SUBROUTINE RETURN POINTS
394: * AND OTHER RECURSIVELY SAVED DATA.
395: *
396: * (XT) AN ALTERNATIVE NAME FOR XL DURING
397: * ITS USE IN ACCESSING STACKED ITEMS.
398: *
399: * (WA,WB,WC) GENERAL WORK REGISTERS. CANNOT BE
400: * USED FOR INDEXING, BUT MAY HOLD
401: * VARIOUS TYPES OF DATA.
402: *
403: * (IA) USED FOR ALL SIGNED INTEGER
404: * ARITHMETIC, BOTH THAT USED BY THE
405: * TRANSLATOR AND THAT ARISING FROM
406: * USE OF SNOBOL4 ARITHMETIC OPERATORS
407: *
408: * (RA) REAL ACCUMULATOR. USED FOR ALL
409: * FLOATING POINT ARITHMETIC.
410: {{EJC{{{{
411: *
412: * SPITBOL CONDITIONAL ASSEMBLY SYMBOLS
413: * ------------------------------------
414: *
415: * IN THE SPITBOL TRANSLATOR, THE FOLLOWING CONDITIONAL
416: * ASSEMBLY SYMBOLS ARE REFERRED TO. TO INCORPORATE THE
417: * FEATURES REFERRED TO, THE MINIMAL SOURCE SHOULD BE
418: * PREFACED BY SUITABLE CONDITIONAL ASSEMBLY SYMBOL
419: * DEFINITIONS.
420: * IN ALL CASES IT IS PERMISSIBLE TO DEFAULT THE DEFINITIONS
421: * IN WHICH CASE THE ADDITIONAL FEATURES WILL BE OMITTED
422: * FROM THE TARGET CODE.
423: *
424: * .CASL DEFINE TO INCLUDE 26 SHIFTED LETTRS
425: * .CAHT DEFINE TO INCLUDE HORIZONTAL TAB
426: * .CAVT DEFINE TO INCLUDE VERTICAL TAB
427: * .CIOD IF DEFINED, DEFAULT DELIMITER IS
428: * NOT USED IN PROCESSING 3RD ARG OF
429: * INPUT() AND OUTPUT()
430: * .CNBT DEFINE TO OMIT BATCH INITIALISATION
431: * .CNCI DEFINE TO ENABLE SYSCI ROUTINE
432: * .CNEX DEFINE TO OMIT EXIT() CODE.
433: * .CNLD DEFINE TO OMIT LOAD() CODE.
434: * .CNPF DEFINE TO OMIT PROFILE STUFF
435: * .CNRA DEFINE TO OMIT ALL REAL ARITHMETIC
436: * .CNSR DEFINE TO OMIT SORT, RSORT
437: * .CSAX DEFINE IF SYSAX IS TO BE CALLED
438: * .CSN6 DEFINE TO PAD STMT NOS TO 6 CHARS
439: * .CSN8 DEFINE TO PAD STMT NOS TO 8 CHARS
440: * .CUCF DEFINE TO INCLUDE CFP$U
441: * .CULC DEFINE TO INCLUDE &CASE (LC NAMES)
442: * .CUST DEFINE TO INCLUDE SET() CODE
443: {{TTL{S{{{P I T B O L -- PROCEDURES SECTION
444: *
445: * THIS SECTION STARTS WITH DESCRIPTIONS OF THE OPERATING
446: * SYSTEM DEPENDENT PROCEDURES WHICH ARE USED BY THE SPITBOL
447: * TRANSLATOR. ALL SUCH PROCEDURES HAVE FIVE LETTER NAMES
448: * BEGINNING WITH SYS. THEY ARE LISTED IN ALPHABETICAL
449: * ORDER.
450: * ALL PROCEDURES HAVE A SPECIFICATION CONSISTING OF A
451: * MODEL CALL, PRECEDED BY A POSSIBLY EMPTY LIST OF REGISTER
452: * CONTENTS GIVING PARAMETERS AVAILABLE TO THE PROCEDURE AND
453: * FOLLOWED BY A POSSIBLY EMPTY LIST OF REGISTER CONTENTS
454: * REQUIRED ON RETURN FROM THE CALL OR WHICH MAY HAVE HAD
455: * THEIR CONTENTS DESTROYED. ONLY THOSE REGISTERS EXPLICITLY
456: * MENTIONED IN THE LIST AFTER THE CALL MAY HAVE THEIR
457: * VALUES CHANGED.
458: * THE SEGMENT OF CODE PROVIDING THE EXTERNAL PROCEDURES IS
459: * CONVENIENTLY REFERRED TO AS OSINT (OPERATING SYSTEM
460: * INTERFACE). THE SYSXX PROCEDURES IT CONTAINS PROVIDE
461: * FACILITIES NOT USUALLY AVAILABLE AS PRIMITIVES IN
462: * ASSEMBLY LANGUAGES. FOR PARTICULAR TARGET MACHINES,
463: * IMPLEMENTORS MAY CHOOSE FOR SOME MINIMAL OPCODES WHICH
464: * DO NOT HAVE REASONABLY DIRECT TRANSLATIONS, TO USE CALLS
465: * OF ADDITIONAL PROCEDURES WHICH THEY PROVIDE IN OSINT.
466: * E.G. MWB OR TRC MIGHT BE TRANSLATED AS JSR SYSMB,
467: * JSR SYSTC IN SOME IMPLEMENTATIONS.
468: *
469: * IN THE DESCRIPTIONS, REFERENCE IS MADE TO --BLK
470: * FORMATS (-- = A PAIR OF LETTERS). SEE THE SPITBOL
471: * DEFINITIONS SECTION FOR DETAILED DESCRIPTIONS OF ALL
472: * SUCH BLOCK FORMATS EXCEPT FCBLK FOR WHICH SYSFC SHOULD
473: * BE CONSULTED.
474: *
475: * SECTION 0 CONTAINS INP,INR SPECIFICATIONS OF INTERNAL
476: * PROCEDURES,ROUTINES. THIS GIVES A SINGLE PASS TRANSLATOR
477: * INFORMATION MAKING IT EASY TO GENERATE ALTERNATIVE CALLS
478: * IN THE TRANSLATION OF JSR-S FOR PROCEDURES OF DIFFERENT
479: * TYPES IF THIS PROVES NECESSARY.
480: *
481: {{SEC{{{{START OF PROCEDURES SECTION
482: {{EJC{{{{
483: *
484: * SYSAX -- AFTER EXECUTION
485: *
486: {SYSAX{EXP{{{{DEFINE EXTERNAL ENTRY POINT
487: *
488: * IF THE CONDITIONAL ASSEMBLY SYMBOL .CSAX IS DEFINED,
489: * THIS ROUTINE IS CALLED IMMEDIATELY AFTER EXECUTION AND
490: * BEFORE PRINTING OF EXECUTION STATISTICS OR DUMP OUTPUT.
491: * PURPOSE OF CALL IS FOR IMPLEMENTOR TO DETERMINE AND
492: * IF THE CALL IS NOT REQUIRED IT WILL BE OMITTED IF .CSAX
493: * IS UNDEFINED. IN THIS CASE SYSAX NEED NOT BE CODED.
494: *
495: * JSR SYSAX CALL AFTER EXECUTION
496: {{EJC{{{{
497: *
498: * SYSBX -- BEFORE EXECUTION
499: *
500: {SYSBX{EXP{{{{DEFINE EXTERNAL ENTRY POINT
501: *
502: * CALLED AFTER INITIAL SPITBOL COMPILATION AND BEFORE
503: * COMMENCING EXECUTION IN CASE OSINT NEEDS
504: * TO ASSIGN FILES OR PERFORM OTHER NECESSARY SERVICES.
505: * OSINT MAY ALSO CHOOSE TO SEND A MESSAGE TO ONLINE
506: * TERMINAL (IF ANY) INDICATING THAT EXECUTION IS STARTING.
507: *
508: * JSR SYSBX CALL BEFORE EXECUTION STARTS
509: {{EJC{{{{
510: *
511: * SYSDC -- DATE CHECK
512: *
513: {SYSDC{EXP{{{{DEFINE EXTERNAL ENTRY POINT
514: *
515: * SYSDC IS CALLED TO CHECK THAT THE EXPIRY DATE FOR A TRIAL
516: * VERSION OF SPITBOL IS UNEXPIRED.
517: *
518: * JSR SYSDC CALL TO CHECK DATE
519: * RETURN ONLY IF DATE IS OK
520: {{EJC{{{{
521: *
522: * SYSDM -- DUMP CORE
523: *
524: {SYSDM{EXP{{{{DEFINE EXTERNAL ENTRY POINT
525: *
526: * SYSDM IS CALLED BY A SPITBOL PROGRAM CALL OF DUMP(N) WITH
527: * N GE 3. ITS PURPOSE IS TO PROVIDE A CORE DUMP.
528: * N COULD HOLD AN ENCODING OF THE START ADRS FOR DUMP AND
529: * AMOUNT TO BE DUMPED E.G. N = 256*A + S , S = START ADRS
530: * IN KILOWORDS, A = KILOWORDS TO DUMP
531: *
532: * (XR) PARAMETER N OF CALL DUMP(N)
533: * JSR SYSDM CALL TO ENTER ROUTINE
534: {{EJC{{{{
535: *
536: * SYSDT -- GET CURRENT DATE
537: *
538: {SYSDT{EXP{{{{DEFINE EXTERNAL ENTRY POINT
539: *
540: * SYSDT IS USED TO OBTAIN THE CURRENT DATE. THE DATE IS
541: * RETURNED AS A CHARACTER STRING IN ANY FORMAT APPROPRIATE
542: * TO THE OPERATING SYSTEM IN USE. IT MAY ALSO CONTAIN THE
543: * CURRENT TIME OF DAY. SYSDT IS USED TO IMPLEMENT THE
544: * SNOBOL4 FUNCTION DATE.
545: *
546: * JSR SYSDT CALL TO GET DATE
547: * (XL) POINTER TO BLOCK CONTAINING DATE
548: *
549: * THE FORMAT OF THE BLOCK IS LIKE AN SCBLK EXCEPT THAT
550: * THE FIRST WORD NEED NOT BE SET. THE RESULT IS COPIED
551: * INTO SPITBOL DYNAMIC MEMORY ON RETURN.
552: {{EJC{{{{
553: *
554: * SYSEF -- EJECT FILE
555: *
556: {SYSEF{EXP{{{{DEFINE EXTERNAL ENTRY POINT
557: *
558: * SYSEF IS USED TO WRITE A PAGE EJECT TO A NAMED FILE. IT
559: * MAY ONLY BE USED FOR FILES WHERE THIS CONCEPT MAKES
560: * SENSE. NOTE THAT SYSEF IS NOT NORMALLY USED FOR THE
561: * STANDARD OUTPUT FILE (SEE SYSEP).
562: *
563: * (WA) PTR TO FCBLK OR ZERO
564: * (XR) EJECT ARGUMENT (SCBLK PTR)
565: * JSR SYSEF CALL TO EJECT FILE
566: * PPM LOC RETURN HERE IF FILE DOES NOT EXIST
567: * PPM LOC RETURN HERE IF INAPPROPRIATE FILE
568: * PPM LOC RETURN HERE IF I/O ERROR
569: {{EJC{{{{
570: *
571: * SYSEJ -- END OF JOB
572: *
573: {SYSEJ{EXP{{{{DEFINE EXTERNAL ENTRY POINT
574: *
575: * SYSEJ IS CALLED ONCE AT THE END OF EXECUTION TO
576: * TERMINATE THE RUN. THE SIGNIFICANCE OF THE ABEND AND
577: * CODE VALUES IS SYSTEM DEPENDENT. IN GENERAL, THE CODE
578: * VALUE SHOULD BE MADE AVAILABLE FOR TESTING, AND THE
579: * ABEND VALUE SHOULD CAUSE SOME POST-MORTEM ACTION SUCH AS
580: * A DUMP. NOTE THAT SYSEJ DOES NOT RETURN TO ITS CALLER.
581: * SEE SYSXI FOR DETAILS OF FCBLK CHAIN
582: *
583: * (WA) VALUE OF ABEND KEYWORD
584: * (WB) VALUE OF CODE KEYWORD
585: * (XL) O OR PTR TO HEAD OF FCBLK CHAIN
586: * JSR SYSEJ CALL TO END JOB
587: *
588: * THE FOLLOWING SPECIAL VALUES ARE USED AS CODES IN (WB)
589: * 999 EXECUTION SUPPRESSED
590: * 998 STANDARD OUTPUT FILE FULL OR UNAVAILABLE IN A SYSXI
591: * LOAD MODULE. IN THESE CASES (WA) CONTAINS THE NUMBER
592: * OF THE STATEMENT CAUSING PREMATURE TERMINATION.
593: {{EJC{{{{
594: *
595: * SYSEM -- GET ERROR MESSAGE TEXT
596: *
597: {SYSEM{EXP{{{{DEFINE EXTERNAL ENTRY POINT
598: *
599: * SYSEM IS USED TO OBTAIN THE TEXT OF ERR, ERB CALLS IN THE
600: * SOURCE PROGRAM GIVEN THE ERROR CODE NUMBER. IT IS ALLOWED
601: * TO RETURN A NULL STRING IF THIS FACILITY IS UNAVAILABLE.
602: *
603: * (WA) ERROR CODE NUMBER
604: * JSR SYSEM CALL TO GET TEXT
605: * (XR) TEXT OF MESSAGE
606: *
607: * THE RETURNED VALUE IS A POINTER TO A BLOCK IN SCBLK
608: * FORMAT EXCEPT THAT THE FIRST WORD NEED NOT BE SET. THE
609: * STRING IS COPIED INTO DYNAMIC MEMORY ON RETURN.
610: * IF THE NULL STRING IS RETURNED EITHER BECAUSE SYSEM DOES
611: * NOT PROVIDE ERROR MESSAGE TEXTS OR BECAUSE WA IS OUT OF
612: * RANGE, SPITBOL WILL PRINT THE STRING STORED IN ERRTEXT
613: * KEYWORD.
614: {{EJC{{{{
615: *
616: * SYSEN -- ENDFILE
617: *
618: {SYSEN{EXP{{{{DEFINE EXTERNAL ENTRY POINT
619: *
620: * SYSEN IS USED TO IMPLEMENT THE SNOBOL4 FUNCTION ENDFILE.
621: * THE MEANING IS SYSTEM DEPENDENT. IN GENERAL, ENDFILE
622: * IMPLIES THAT NO FURTHER I/O OPERATIONS WILL BE PERFORMED,
623: * BUT DOES NOT GUARANTEE THIS TO BE THE CASE. THE FILE
624: * SHOULD BE CLOSED AFTER THE CALL, A SUBSEQUENT READ
625: * OR WRITE MAY REOPEN THE FILE AT THE START OR IT MAY BE
626: * NECESSARY TO REOPEN THE FILE VIA SYSIO.
627: *
628: * (WA) PTR TO FCBLK OR ZERO
629: * (XR) ENDFILE ARGUMENT (SCBLK PTR)
630: * JSR SYSEN CALL TO ENDFILE
631: * PPM LOC RETURN HERE IF FILE DOES NOT EXIST
632: * PPM LOC RETURN HERE IF ENDFILE NOT ALLOWED
633: * PPM LOC RETURN HERE IF I/O ERROR
634: * (WA,WB) DESTROYED
635: *
636: * THE SECOND ERROR RETURN IS USED FOR FILES FOR WHICH
637: * ENDFILE IS NOT PERMITTED. FOR EXAMPLE, IT MAY BE EXPECTED
638: * THAT THE STANDARD INPUT AND OUTPUT FILES ARE IN THIS
639: * CATEGORY.
640: {{EJC{{{{
641: *
642: * SYSEP -- EJECT PRINTER PAGE
643: *
644: {SYSEP{EXP{{{{DEFINE EXTERNAL ENTRY POINT
645: *
646: * SYSEP IS CALLED TO PERFORM A PAGE EJECT ON THE STANDARD
647: * PRINTER OUTPUT FILE (CORRESPONDING TO SYSPR OUTPUT).
648: *
649: * JSR SYSEP CALL TO EJECT PRINTER OUTPUT
650: {{EJC{{{{
651: *
652: * SYSEX -- CALL EXTERNAL FUNCTION
653: *
654: {SYSEX{EXP{{{{DEFINE EXTERNAL ENTRY POINT
655: *
656: * SYSEX IS CALLED TO PASS CONTROL TO AN EXTERNAL FUNCTION
657: * PREVIOUSLY LOADED WITH A CALL TO SYSLD.
658: *
659: * (XS) POINTER TO ARGUMENTS ON STACK
660: * (XL) POINTER TO CONTROL BLOCK (EFBLK)
661: * (WA) NUMBER OF ARGUMENTS ON STACK
662: * JSR SYSEX CALL TO PASS CONTROL TO FUNCTION
663: * PPM LOC RETURN HERE IF FUNCTION CALL FAILS
664: * (XS) POPPED PAST ARGUMENTS
665: * (XR) RESULT RETURNED
666: *
667: * THE ARGUMENTS ARE STORED ON THE STACK WITH
668: * THE LAST ARGUMENT AT 0(XS). ON RETURN, XS
669: * IS POPPED PAST THE ARGUMENTS.
670: *
671: * THE FORM OF THE ARGUMENTS AS PASSED IS THAT USED IN THE
672: * SPITBOL TRANSLATOR (SEE DEFINITIONS AND DATA STRUCTURES
673: * SECTION). THE CONTROL BLOCK FORMAT IS ALSO DESCRIBED
674: * (UNDER EFBLK) IN THIS SECTION.
675: *
676: * THERE ARE TWO WAYS OF RETURNING A RESULT.
677: *
678: * 1) RETURN A POINTER TO A BLOCK IN DYNAMIC STORAGE. THIS
679: * BLOCK MUST BE IN EXACTLY CORRECT FORMAT, INCLUDING
680: * THE FIRST WORD. ONLY FUNCTIONS WRITTEN WITH INTIMATE
681: * KNOWLEDGE OF THE SYSTEM WILL RETURN IN THIS WAY.
682: *
683: * 2) STRING, INTEGER AND REAL RESULTS MAY BE RETURNED BY
684: * POINTING TO A PSEUDO-BLOCK OUTSIDE DYNAMIC MEMORY.
685: * THIS BLOCK IS IN ICBLK, RCBLK OR SCBLK FORMAT EXCEPT
686: * THAT THE FIRST WORD WILL BE OVERWRITTEN
687: * BY A TYPE WORD ON RETURN AND SO NEED NOT
688: * BE CORRECTLY SET. SUCH A RESULT IS
689: * COPIED INTO MAIN STORAGE BEFORE PROCEEDING.
690: * UNCONVERTED RESULTS MAY SIMILARLY BE RETURNED IN A
691: * PSEUDO-BLOCK WHICH IS IN CORRECT FORMAT INCLUDING
692: * TYPE WORD RECOGNISABLE BY GARBAGE COLLECTOR SINCE
693: * BLOCK IS COPIED INTO DYNAMIC MEMORY.
694: {{EJC{{{{
695: *
696: * SYSFC -- FILE CONTROL BLOCK ROUTINE
697: *
698: {SYSFC{EXP{{{{DEFINE EXTERNAL ENTRY POINT
699: *
700: * SEE ALSO SYSIO
701: * INPUT AND OUTPUT HAVE 3 ARGUMENTS REFERRED TO AS SHOWN
702: * INPUT(VARIABLE NAME,FILE ARG1,FILE ARG2)
703: * OUTPUT(VARIABLE NAME,FILE ARG1,FILE ARG2)
704: * FILE ARG1 MAY BE AN INTEGER OR STRING USED TO IDENTIFY
705: * AN I/O CHANNEL. IT IS CONVERTED TO A STRING FOR CHECKING.
706: * THE EXACT SIGNIFICANCE OF FILE ARG2
707: * IS NOT RIGOROUSLY PRESCRIBED BUT TO IMPROVE PORTABILITY,
708: * THE SCHEME DESCRIBED IN THE SPITBOL USER MANUAL
709: * SHOULD BE ADOPTED WHEN POSSIBLE. THE PREFERRED FORM IS
710: * A STRING $F$,R$R$,C$C$,I$I$,...,Z$Z$ WHERE
711: * $F$ IS AN OPTIONAL FILE NAME WHICH IS PLACED FIRST.
712: * REMAINING ITEMS MAY BE OMITTED OR INCLUDED IN ANY ORDER.
713: * $R$ IS MAXIMUM RECORD LENGTH
714: * $C$ IS A CARRIAGE CONTROL CHARACTER OR CHARACTER STRING
715: * $I$ IS SOME FORM OF CHANNEL IDENTIFICATION USED IN THE
716: * ABSENCE OF $F$ TO ASSOCIATE THE VARIABLE
717: * WITH A FILE ALLOCATED DYNAMICALLY BY JCL COMMANDS AT
718: * SPITBOL LOAD TIME.
719: * ,...,Z$Z$ ARE ADDITIONAL FIELDS.
720: * IF , (COMMA) CANNOT BE USED AS A DELIMITER, .CIOD
721: * SHOULD BE DEFINED TO INTRODUCE BY CONDITIONAL ASSEMBLY
722: * ANOTHER DELIMITER (SEE
723: * IODEL EQU *
724: * EARLY IN DEFINITIONS SECTION).
725: * SYSFC IS CALLED WHEN A VARIABLE IS INPUT OR OUTPUT
726: * ASSOCIATED TO CHECK FILE ARG1 AND FILE ARG2 AND
727: * TO REPORT WHETHER AN FCBLK (FILE CONTROL
728: * BLOCK) IS NECESSARY AND IF SO WHAT SIZE IT SHOULD BE.
729: * THIS MAKES IT POSSIBLE FOR SPITBOL RATHER THAN OSINT TO
730: * ALLOCATE SUCH A BLOCK IN DYNAMIC MEMORY IF REQUIRED
731: * OR ALTERNATIVELY IN STATIC MEMORY.
732: * THE SIGNIFICANCE OF AN FCBLK , IF ONE IS REQUESTED, IS
733: * ENTIRELY UP TO THE SYSTEM INTERFACE. THE ONLY RESTRICTION
734: * IS THAT IF THE FCBLK SHOULD APPEAR TO LIE IN DYNAMIC
735: * MEMORY , POINTERS TO IT SHOULD BE PROPER POINTERS TO
736: * THE START OF A RECOGNISABLE AND GARBAGE COLLECTABLE
737: * BLOCK (THIS CONDITION WILL BE MET IF SYSFC REQUESTS
738: * SPITBOL TO PROVIDE AN FCBLK).
739: * AN OPTION IS PROVIDED FOR OSINT TO RETURN A POINTER IN
740: * XL TO AN FCBLK WHICH IT PRIVATELY ALLOCATED. THIS PTR
741: * WILL BE MADE AVAILABLE WHEN I/O OCCURS LATER.
742: * PRIVATE FCBLKS MAY HAVE ARBITRARY CONTENTS AND SPITBOL
743: * STORES NOTHING IN THEM.
744: {{EJC{{{{
745: * THE REQUESTED SIZE FOR AN FCBLK IN DYNAMIC MEMORY
746: * SHOULD ALLOW A 2 WORD OVERHEAD FOR BLOCK TYPE AND
747: * LENGTH FIELDS. INFORMATION SUBSEQUENTLY STORED IN THE
748: * REMAINING WORDS MAY BE ARBITRARY IF AN XNBLK (EXTERNAL
749: * NON-RELOCATABLE BLOCK) IS REQUESTED. IF THE REQUEST IS
750: * FOR AN XRBLK (EXTERNAL RELOCATABLE BLOCK) THE
751: * CONTENTS OF WORDS SHOULD BE COLLECTABLE (I.E. ANY
752: * APPARENT POINTERS INTO DYNAMIC SHOULD BE GENUINE BLOCK
753: * POINTERS). THESE RESTRICTIONS DO NOT APPLY IF AN FCBLK
754: * IS ALLOCATED OUTSIDE DYNAMIC OR IS NOT ALLOCATED AT ALL.
755: * IF AN FCBLK IS REQUESTED, ITS FIELDS WILL BE INITIALISED
756: * TO ZERO BEFORE ENTRY TO SYSIO WITH THE EXCEPTION OF
757: * WORDS 0 AND 1 IN WHICH THE BLOCK TYPE AND LENGTH
758: * FIELDS ARE PLACED FOR FCBLKS IN DYNAMIC MEMORY ONLY.
759: * FOR THE POSSIBLE USE OF SYSEJ AND SYSXI, IF FCBLKS
760: * ARE USED, A CHAIN IS BUILT SO THAT THEY MAY ALL BE
761: * FOUND - SEE SYSXI FOR DETAILS.
762: * IF BOTH FILE ARG1 AND FILE ARG2 ARE NULL, CALLS OF SYSFC
763: * AND SYSIO ARE OMITTED.
764: * IF FILE ARG1 IS NULL (STANDARD INPUT/OUTPUT FILE), SYSFC
765: * IS CALLED TO CHECK NON-NULL FILE ARG2 BUT ANY REQUEST
766: * FOR AN FCBLK WILL BE IGNORED, SINCE SPITBOL HANDLES THE
767: * STANDARD FILES SPECIALLY AND CANNOT READILY KEEP FCBLK
768: * POINTERS FOR THEM.
769: * FILEARG1 IS TYPE CHECKED BY SPITBOL SO FURTHER CHECKING
770: * MAY BE UNNECCESSARY IN MANY IMPLEMENTATIONS.
771: * FILE ARG2 IS PASSED SO THAT SYSFC MAY ANALYSE AND
772: * CHECK IT. HOWEVER TO ASSIST IN THIS, SPITBOL ALSO PASSES
773: * ON THE STACK THE COMPONENTS OF THIS ARGUMENT WITH
774: * FILE NAME, $F$ (OTHERWISE NULL) EXTRACTED AND STACKED
775: * FIRST.
776: * THE OTHER FIELDS, IF ANY, ARE EXTRACTED AS SUBSTRINGS,
777: * POINTERS TO THEM ARE STACKED AND A COUNT OF ALL ITEMS
778: * STACKED IS PLACED IN WC. IF AN FCBLK WAS EARLIER
779: * ALLOCATED AND POINTED TO VIA FILE ARG1, SYSFC IS ALSO
780: * PASSED A POINTER TO THIS FCBLK.
781: *
782: * (XL) FILE ARG1 SCBLK PTR (2ND ARG)
783: * (XR) FILEARG2 (3RD ARG) OR NULL
784: * -(XS)...-(XS) SCBLKS FOR $F$,$R$,$C$,...
785: * (WC) NO. OF STACKED SCBLKS ABOVE
786: * (WA) EXISTING FILE ARG1 FCBLK PTR OR 0
787: * (WB) 0/3 FOR INPUT/OUTPUT ASSOCN
788: * JSR SYSFC CALL TO CHECK NEED FOR FCBLK
789: * PPM LOC INVALID FILE ARGUMENT
790: * (XS) POPPED (WC) TIMES
791: * (WA NON ZERO) BYTE SIZE OF REQUESTED FCBLK
792: * (WA=0,XL NON ZERO) PRIVATE FCBLK PTR IN XL
793: * (WA=XL=0) NO FCBLK WANTED, NO PRIVATE FCBLK
794: * (WC) 0/1/2 REQUEST ALLOC OF XRBLK/XNBLK
795: * /STATIC BLOCK FOR USE AS FCBLK
796: * (WB) DESTROYED
797: {{EJC{{{{
798: *
799: * SYSHS -- GIVE ACCESS TO HOST COMPUTER FEATURES
800: *
801: {SYSHS{EXP{{{{DEFINE EXTERNAL ENTRY POINT
802: *
803: * PROVIDES MEANS FOR IMPLEMENTING SPECIAL FEATURES
804: * ON DIFFERENT HOST COMPUTERS. THE ONLY DEFINED ENTRY IS
805: * THAT WHERE ALL ARGUMENTS ARE NULL IN WHICH CASE SYSHS
806: * RETURNS AN SCBLK CONTAINING NAME OF COMPUTER,
807: * NAME OF OPERATING SYSTEM AND NAME OF SITE SEPARATED BY
808: * COLONS. THE SCBLK NEED NOT HAVE A CORRECT FIRST FIELD
809: * AS THIS IS SUPPLIED ON COPYING STRING TO DYNAMIC MEMORY.
810: * SPITBOL DOES NO ARGUMENT CHECKING BUT DOES PROVIDE A
811: * SINGLE ERROR RETURN FOR ARGUMENTS CHECKED AS ERRONEOUS
812: * BY OSINT. IT ALSO PROVIDES A SINGLE EXECUTION ERROR
813: * RETURN. IF THESE ARE INADEQUATE, USE MAY BE MADE OF THE
814: * MINIMAL ERROR SECTION DIRECT AS DESCRIBED IN MINIMAL
815: * DOCUMENTATION, SECTION 10.
816: * SEVERAL NON-ERROR RETURNS ARE PROVIDED. THE FIRST
817: * CORRESPONDS TO THE DEFINED ENTRY OR, FOR IMPLEMENTATION
818: * DEFINED ENTRIES, ANY STRING MAY BE RETURNED. THE OTHERS
819: * PERMIT RESPECTIVELY, RETURN A NULL RESULT, RETURN WITH A
820: * RESULT TO BE STACKED WHICH IS POINTED AT BY XR, AND A
821: * RETURN CAUSING SPITBOL STATEMENT FAILURE. IF A RETURNED
822: * RESULT IS IN DYNAMIC MEMORY IT MUST OBEY GARBAGE
823: * COLLECTOR RULES. THE ONLY RESULTS COPIED ON RETURN
824: * ARE STRINGS RETURNED VIA PPM LOC3 RETURN.
825: *
826: * (WA) ARGUMENT 1
827: * (XL) ARGUMENT 2
828: * (XR) ARGUMENT 3
829: * JSR SYSHS CALL TO GET HOST INFORMATION
830: * PPM LOC1 ERRONEOUS ARG
831: * PPM LOC2 EXECUTION ERROR
832: * PPM LOC3 SCBLK PTR IN XL OR 0 IF UNAVAILABLE
833: * PPM LOC4 RETURN A NULL RESULT
834: * PPM LOC5 RETURN RESULT IN XR
835: * PPM LOC6 CAUSE STATEMENT FAILURE
836: {{EJC{{{{
837: *
838: * SYSID -- RETURN SYSTEM IDENTIFICATION
839: *
840: {SYSID{EXP{{{{DEFINE EXTERNAL ENTRY POINT
841: *
842: * THIS ROUTINE SHOULD RETURN STRINGS TO HEAD THE STANDARD
843: * PRINTER OUTPUT. THE FIRST STRING WILL BE APPENDED TO
844: * A HEADING LINE OF THE FORM
845: * MACRO SPITBOL VERSION V.V
846: * SUPPLIED BY SPITBOL ITSELF. V.V ARE DIGITS GIVING THE
847: * MAJOR VERSION NUMBER AND GENERALLY AT LEAST A MINOR
848: * VERSION NUMBER RELATING TO OSINT SHOULD BE SUPPLIED TO
849: * GIVE SAY
850: * MACRO SPITBOL VERSION V.V(M.M)
851: * THE SECOND STRING SHOULD IDENTIFY AT LEAST THE MACHINE
852: * AND OPERATING SYSTEM. PREFERABLY IT SHOULD INCLUDE
853: * THE DATE AND TIME OF THE RUN.
854: * OPTIONALLY THE STRINGS MAY INCLUDE SITE NAME OF THE
855: * THE IMPLEMENTOR AND/OR MACHINE ON WHICH RUN TAKES PLACE,
856: * UNIQUE SITE OR COPY NUMBER AND OTHER INFORMATION AS
857: * APPROPRIATE WITHOUT MAKING IT SO LONG AS TO BE A
858: * NUISANCE TO USERS.
859: * THE FIRST WORDS OF THE SCBLKS POINTED AT NEED NOT BE
860: * CORRECTLY SET.
861: *
862: * JSR SYSID CALL FOR SYSTEM IDENTIFICATION
863: * (XR) SCBLK PTR FOR ADDITION TO HEADER
864: * (XL) PTR TO SECOND HEADER SCBLK
865: {{EJC{{{{
866: *
867: * SYSIL -- GET INPUT RECORD LENGTH
868: *
869: {SYSIL{EXP{{{{DEFINE EXTERNAL ENTRY POINT
870: *
871: * SYSIL IS USED TO GET THE LENGTH OF THE NEXT INPUT RECORD
872: * FROM A FILE PREVIOUSLY INPUT ASSOCIATED WITH A SYSIO
873: * CALL. THE LENGTH RETURNED IS USED TO ESTABLISH A BUFFER
874: * FOR A SUBSEQUENT SYSIN CALL.
875: *
876: * (WA) PTR TO FCBLK OR ZERO
877: * JSR SYSIL CALL TO GET RECORD LENGTH
878: * (WA) LENGTH OR ZERO IF FILE CLOSED
879: *
880: * NO HARM IS DONE IF THE VALUE RETURNED IS TOO LONG SINCE
881: * UNUSED SPACE WILL BE RECLAIMED AFTER THE SYSIN CALL.
882: *
883: * NOTE THAT IT IS THE SYSIL CALL (NOT THE SYSIO CALL) WHICH
884: * CAUSES THE FILE TO BE OPENED AS REQUIRED FOR THE FIRST
885: * RECORD INPUT FROM THE FILE.
886: {{EJC{{{{
887: *
888: * SYSIN -- READ INPUT RECORD
889: *
890: {SYSIN{EXP{{{{DEFINE EXTERNAL ENTRY POINT
891: *
892: * SYSIN IS USED TO READ A RECORD FROM THE FILE WHICH WAS
893: * REFERENCED IN A PRIOR CALL TO SYSIL (I.E. THESE CALLS
894: * ALWAYS OCCUR IN PAIRS). THE BUFFER PROVIDED IS AN
895: * SCBLK FOR A STRING OF LENGTH SET FROM THE SYSIL CALL.
896: * IF THE ACTUAL LENGTH READ IS LESS THAN THIS, THE LENGTH
897: * FIELD OF THE SCBLK MUST BE MODIFIED BEFORE RETURNING
898: * UNLESS BUFFER IS RIGHT PADDED WITH ZEROES.
899: * IT IS ALSO PERMISSIBLE TO TAKE ANY OF THE ALTERNATIVE
900: * RETURNS AFTER SCBLK LENGTH HAS BEEN MODIFIED.
901: *
902: * (WA) PTR TO FCBLK OR ZERO
903: * (XR) POINTER TO BUFFER (SCBLK PTR)
904: * JSR SYSIN CALL TO READ RECORD
905: * PPM LOC ENDFILE OR NO I/P FILE AFTER SYSXI
906: * PPM LOC RETURN HERE IF I/O ERROR
907: * PPM LOC RETURN HERE IF RECORD FORMAT ERROR
908: * (WA,WB,WC) DESTROYED
909: {{EJC{{{{
910: *
911: * SYSIO -- INPUT/OUTPUT FILE ASSOCIATION
912: *
913: {SYSIO{EXP{{{{DEFINE EXTERNAL ENTRY POINT
914: *
915: * SEE ALSO SYSFC.
916: * SYSIO IS CALLED IN RESPONSE TO A SNOBOL4 INPUT OR OUTPUT
917: * FUNCTION CALL EXCEPT WHEN FILE ARG1 AND FILE ARG2
918: * ARE BOTH NULL.
919: * ITS CALL ALWAYS FOLLOWS IMMEDIATELY AFTER A CALL
920: * OF SYSFC. IF SYSFC REQUESTED ALLOCATION
921: * OF AN FCBLK, ITS ADDRESS WILL BE IN WA.
922: * FOR INPUT FILES, NON-ZERO VALUES OF $R$ SHOULD BE
923: * COPIED TO WC FOR USE IN ALLOCATING INPUT BUFFERS. IF $R$
924: * IS DEFAULTED OR NOT IMPLEMENTED, WC SHOULD BE ZEROISED.
925: * ONCE A FILE HAS BEEN OPENED, SUBSEQUENT INPUT(),OUTPUT()
926: * CALLS IN WHICH THE SECOND ARGUMENT IS IDENTICAL WITH THAT
927: * IN A PREVIOUS CALL, MERELY ASSOCIATE THE ADDITIONAL
928: * VARIABLE NAME (FIRST ARGUMENT) TO THE FILE AND DO NOT
929: * RESULT IN RE-OPENING THE FILE.
930: * IN SUBSEQUENT ASSOCIATED ACCESSES TO THE FILE A POINTER
931: * TO ANY FCBLK ALLOCATED WILL BE MADE AVAILABLE.
932: *
933: * (XL) FILE ARG1 SCBLK PTR (2ND ARG)
934: * (XR) FILE ARG2 SCBLK PTR (3RD ARG)
935: * (WA) FCBLK PTR (0 IF NONE)
936: * (WB) 0 FOR INPUT, 3 FOR OUTPUT
937: * JSR SYSIO CALL TO ASSOCIATE FILE
938: * PPM LOC RETURN HERE IF FILE DOES NOT EXIST
939: * PPM LOC RETURN IF INPUT/OUTPUT NOT ALLOWED
940: * (XL) FCBLK POINTER (0 IF NONE)
941: * (WC) 0 (FOR DEFAULT) OR MAX RECORD LNGTH
942: * (WA,WB) DESTROYED
943: *
944: * THE SECOND ERROR RETURN IS USED IF THE FILE NAMED EXISTS
945: * BUT INPUT/OUTPUT FROM THE FILE IS NOT ALLOWED. FOR
946: * EXAMPLE, THE STANDARD OUTPUT FILE MAY BE IN THIS CATEGORY
947: * AS REGARDS INPUT ASSOCIATION.
948: {{EJC{{{{
949: *
950: * SYSLD -- LOAD EXTERNAL FUNCTION
951: *
952: {SYSLD{EXP{{{{DEFINE EXTERNAL ENTRY POINT
953: *
954: * SYSLD IS CALLED IN RESPONSE TO THE USE OF THE SNOBOL4
955: * LOAD FUNCTION. THE NAMED FUNCTION IS LOADED (WHATEVER
956: * THIS MEANS), AND A POINTER IS RETURNED. THE POINTER WILL
957: * BE USED ON SUBSEQUENT CALLS TO THE FUNCTION (SEE SYSEX).
958: *
959: * (XR) POINTER TO FUNCTION NAME (SCBLK)
960: * (XL) POINTER TO LIBRARY NAME (SCBLK)
961: * JSR SYSLD CALL TO LOAD FUNCTION
962: * PPM LOC RETURN HERE IF FUNC DOES NOT EXIST
963: * PPM LOC RETURN HERE IF I/O ERROR
964: * (XR) POINTER TO LOADED CODE
965: *
966: * THE SIGNIFICANCE OF THE POINTER RETURNED IS UP TO THE
967: * SYSTEM INTERFACE ROUTINE. THE ONLY RESTRICTION IS THAT
968: * IF THE POINTER IS WITHIN DYNAMIC STORAGE, IT MUST BE
969: * A PROPER BLOCK POINTER.
970: {{EJC{{{{
971: *
972: * SYSMM -- GET MORE MEMORY
973: *
974: {SYSMM{EXP{{{{DEFINE EXTERNAL ENTRY POINT
975: *
976: * SYSMM IS CALLED IN AN ATTEMPT TO ALLOCATE MORE DYNAMIC
977: * MEMORY. THIS MEMORY MUST BE ALLOCATED CONTIGUOUSLY WITH
978: * THE CURRENT DYNAMIC DATA AREA.
979: *
980: * THE AMOUNT ALLOCATED IS UP TO THE SYSTEM TO DECIDE. ANY
981: * VALUE IS ACCEPTABLE INCLUDING ZERO IF ALLOCATION IS
982: * IMPOSSIBLE.
983: *
984: * JSR SYSMM CALL TO GET MORE MEMORY
985: * (XR) NUMBER OF ADDITIONAL WORDS OBTAINED
986: {{EJC{{{{
987: *
988: * SYSMX -- SUPPLY MXLEN
989: *
990: {SYSMX{EXP{{{{DEFINE EXTERNAL ENTRY POINT
991: *
992: * BECAUSE OF THE METHOD OF GARBAGE COLLECTION, NO SPITBOL
993: * OBJECT IS ALLOWED TO OCCUPY MORE BYTES OF MEMORY THAN
994: * THE INTEGER GIVING THE LOWEST ADDRESS OF DYNAMIC
995: * (GARBAGE COLLECTABLE) MEMORY. MXLEN IS THE NAME USED TO
996: * REFER TO THIS MAXIMUM LENGTH OF AN OBJECT AND FOR MOST
997: * USERS OF MOST IMPLEMENTATIONS, PROVIDED DYNAMIC MEMORY
998: * STARTS AT AN ADDRESS OF AT LEAST A FEW THOUSAND WORDS,
999: * THERE IS NO PROBLEM.
1000: * IF THE DEFAULT STARTING ADDRESS IS LESS THAN SAY 10000 OR
1001: * 20000, THEN A LOAD TIME OPTION SHOULD BE PROVIDED WHERE A
1002: * USER CAN REQUEST THAT HE BE ABLE TO CREATE LARGER
1003: * OBJECTS. THIS ROUTINE INFORMS SPITBOL OF THIS REQUEST IF
1004: * ANY. THE VALUE RETURNED IS EITHER AN INTEGER
1005: * REPRESENTING THE DESIRED VALUE OF MXLEN (AND HENCE THE
1006: * MINIMUM DYNAMIC STORE ADDRESS WHICH MAY RESULT IN
1007: * NON-USE OF SOME STORE) OR ZERO IF A DEFAULT IS ACCEPTABLE
1008: * IN WHICH MXLEN IS SET TO THE LOWEST ADDRESS ALLOCATED
1009: * TO DYNAMIC STORE BEFORE COMPILATION STARTS.
1010: * IF A NON-ZERO VALUE IS RETURNED, THIS IS USED FOR KEYWORD
1011: * MAXLNGTH. OTHERWISE THE INITIAL LOW ADDRESS OF DYNAMIC
1012: * MEMORY IS USED FOR THIS KEYWORD.
1013: *
1014: * JSR SYSMX CALL TO GET MXLEN
1015: * (WA) EITHER MXLEN OR 0 FOR DEFAULT
1016: {{EJC{{{{
1017: *
1018: * SYSOU -- OUTPUT RECORD
1019: *
1020: {SYSOU{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1021: *
1022: * SYSOU IS USED TO WRITE A RECORD TO A FILE PREVIOUSLY
1023: * ASSOCIATED WITH A SYSIO CALL.
1024: *
1025: * (WA) PTR TO FCBLK OR ZERO
1026: * (XR) RECORD TO BE WRITTEN (SCBLK)
1027: * JSR SYSOU CALL TO OUTPUT RECORD
1028: * PPM LOC FILE FULL OR NO FILE AFTER SYSXI
1029: * PPM LOC RETURN HERE IF I/O ERROR
1030: * (WA,WB,WC) DESTROYED
1031: *
1032: * NOTE THAT IT IS THE SYSOU CALL (NOT THE SYSIO CALL) WHICH
1033: * CAUSES THE FILE TO BE OPENED AS REQUIRED FOR THE FIRST
1034: * RECORD OUTPUT TO THE FILE.
1035: {{EJC{{{{
1036: *
1037: * SYSPI -- PRINT ON INTERACTIVE CHANNEL
1038: *
1039: {SYSPI{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1040: *
1041: * IF SPITBOL IS RUN FROM AN ONLINE TERMINAL, OSINT CAN
1042: * REQUEST THAT MESSAGES SUCH AS COPIES OF COMPILATION
1043: * ERRORS BE SENT TO THE TERMINAL (SEE SYSPP). IF RELEVANT
1044: * REPLY WAS MADE BY SYSPP THEN SYSPI IS CALLED TO SEND SUCH
1045: * MESSAGES TO THE INTERACTIVE CHANNEL.
1046: * SYSPI IS ALSO USED FOR SENDING OUTPUT TO THE TERMINAL
1047: * THROUGH THE SPECIAL VARIABLE NAME, TERMINAL.
1048: *
1049: * (XR) PTR TO LINE BUFFER (SCBLK)
1050: * (WA) LINE LENGTH
1051: * JSR SYSPI CALL TO PRINT LINE
1052: * PPM LOC FAILURE RETURN
1053: * (WA,WB) DESTROYED
1054: {{EJC{{{{
1055: *
1056: * SYSPP -- OBTAIN PRINT PARAMETERS
1057: *
1058: {SYSPP{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1059: *
1060: * SYSPP IS CALLED ONCE DURING COMPILATION TO OBTAIN
1061: * PARAMETERS REQUIRED FOR CORRECT PRINTED OUTPUT FORMAT
1062: * AND TO SELECT OTHER OPTIONS. IT MAY ALSO BE CALLED AGAIN
1063: * AFTER SYSXI WHEN A LOAD MODULE IS RESUMED. IN THIS
1064: * CASE THE VALUE RETURNED IN WA MAY BE LESS THAN OR EQUAL
1065: * TO THAT RETURNED IN INITIAL CALL BUT MAY NOT BE
1066: * GREATER.
1067: * THE INFORMATION RETURNED IS -
1068: * 1. LINE LENGTH IN CHARS FOR STANDARD PRINT FILE
1069: * 2. NO OF LINES/PAGE. 0 IS PREFERABLE FOR A NON-PAGED
1070: * DEVICE (E.G. ONLINE TERMINAL) IN WHICH CASE LISTING
1071: * PAGE THROWS ARE SUPPRESSED AND PAGE HEADERS
1072: * RESULTING FROM -TITLE,-STITL LINES ARE KEPT SHORT.
1073: * 3. AN INITIAL -NOLIST OPTION TO SUPPRESS LISTING UNLESS
1074: * THE PROGRAM CONTAINS AN EXPLICIT -LIST.
1075: * 4. OPTIONS TO SUPPRESS LISTING OF COMPILATION AND/OR
1076: * EXECUTION STATS (USEFUL FOR ESTABLISHED PROGRAMS) -
1077: * COMBINED WITH 3. GIVES POSSIBILITY OF LISTING
1078: * FILE NEVER BEING OPENED.
1079: * 5. OPTION TO HAVE COPIES OF ERRORS SENT TO AN
1080: * INTERACTIVE CHANNEL IN ADDITION TO STANDARD PRINTER.
1081: * 6. OPTION TO KEEP PAGE HEADERS SHORT (E.G. IF LISTING
1082: * TO AN ONLINE TERMINAL).
1083: * 7. AN OPTION TO CHOOSE EXTENDED OR COMPACT LISTING
1084: * FORMAT. IN THE FORMER A PAGE EJECT AND IN THE LATTER
1085: * A FEW LINE FEEDS PRECEDE THE PRINTING OF EACH
1086: * OF-- LISTING, COMPILATION STATISTICS, EXECUTION
1087: * OUTPUT AND EXECUTION STATISTICS.
1088: * 8. AN OPTION TO SUPPRESS EXECUTION AS THOUGH A
1089: * -NOEXECUTE CARD WERE SUPPLIED.
1090: * 9. AN OPTION TO REQUEST THAT NAME /TERMINAL/ BE PRE-
1091: * ASSOCIATED TO AN ONLINE TERMINAL VIA SYSPI AND SYSRI
1092: * 10. AN INTERMEDIATE (STANDARD) LISTING OPTION REQUIRING
1093: * THAT PAGE EJECTS OCCUR IN SOURCE LISTINGS. REDUNDANT
1094: * IF EXTENDED OPTION CHOSEN BUT PARTIALLY EXTENDS
1095: * COMPACT OPTION.
1096: * 11. OPTION TO SUPPRESS SYSID IDENTIFICATION.
1097: *
1098: * JSR SYSPP CALL TO GET PRINT PARAMETERS
1099: * (WA) PRINT LINE LENGTH IN CHARS
1100: * (WB) NUMBER OF LINES/PAGE
1101: * (WC) BITS VALUE ...JIHGFEDCBA WHERE
1102: * A = 1 TO SEND ERROR COPY TO INT.CH.
1103: * B = 1 MEANS STD PRINTER IS INT. CH.
1104: * C = 1 FOR -NOLIST OPTION
1105: * D = 1 TO SUPPRESS COMPILN. STATS
1106: * E = 1 TO SUPPRESS EXECN. STATS
1107: * F = 1/0 FOR EXTNDED/COMPACT LISTING
1108: * G = 1 FOR -NOEXECUTE
1109: * H = 1 PRE-ASSOCIATE /TERMINAL/
1110: * I = 1 FOR STANDARD LISTING OPTION.
1111: * J = 1 SUPPRESSES LISTING HEADER
1112: {{EJC{{{{
1113: *
1114: * SYSPR -- PRINT LINE ON STANDARD OUTPUT FILE
1115: *
1116: {SYSPR{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1117: *
1118: * SYSPR IS USED TO PRINT A SINGLE LINE ON THE STANDARD
1119: * OUTPUT FILE.
1120: *
1121: * (XR) POINTER TO LINE BUFFER (SCBLK)
1122: * (WA) LINE LENGTH
1123: * JSR SYSPR CALL TO PRINT LINE
1124: * PPM LOC TOO MUCH O/P OR NO FILE AFTER SYSXI
1125: * (WA,WB) DESTROYED
1126: *
1127: * THE BUFFER POINTED TO IS THE LENGTH OBTAINED FROM THE
1128: * SYSPP CALL AND IS FILLED OUT WITH TRAILING BLANKS. THE
1129: * VALUE IN WA IS THE ACTUAL LINE LENGTH WHICH MAY BE LESS
1130: * THAN THE MAXIMUM LINE LENGTH POSSIBLE. THERE IS NO SPACE
1131: * CONTROL ASSOCIATED WITH THE LINE, ALL LINES ARE PRINTED
1132: * SINGLE SPACED. NOTE THAT NULL LINES (WA=0) ARE POSSIBLE
1133: * IN WHICH CASE A BLANK LINE IS TO BE PRINTED.
1134: *
1135: * THE ERROR EXIT IS USED FOR SYSTEMS WHICH LIMIT THE AMOUNT
1136: * OF PRINTED OUTPUT. IF POSSIBLE, PRINTING SHOULD BE
1137: * PERMITTED AFTER THIS CONDITION HAS BEEN SIGNALLED ONCE TO
1138: * ALLOW FOR DUMP AND OTHER DIAGNOSTIC INFORMATION.
1139: * ASSUMING THIS TO BE POSSIBLE, SPITBOL MAY MAKE MORE SYSPR
1140: * CALLS. IF THE ERROR RETURN OCCURS ANOTHER TIME, EXECUTION
1141: * IS TERMINATED BY A CALL OF SYSEJ WITH ENDING CODE 998.
1142: {{EJC{{{{
1143: *
1144: * SYSRD -- READ RECORD FROM STANDARD INPUT FILE
1145: *
1146: {SYSRD{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1147: *
1148: * SYSRD IS USED TO READ A RECORD FROM THE STANDARD INPUT
1149: * FILE. THE BUFFER PROVIDED IS AN SCBLK FOR A STRING THE
1150: * LENGTH OF WHICH IN CHARACTERS IS GIVEN IN WC, THIS
1151: * CORRESPONDING TO THE MAXIMUM LENGTH OF STRING WHICH
1152: * SPITBOL IS PREPARED TO RECEIVE. AT COMPILE TIME IT
1153: * CORRESPONDS TO XXX IN THE MOST RECENT -INXXX CARD
1154: * (DEFAULT 72) AND AT EXECUTION TIME TO THE MOST RECENT
1155: * ,R$R$ (RECORD LENGTH) IN THE THIRD ARG OF AN INPUT()
1156: * STATEMENT FOR THE STANDARD INPUT FILE (DEFAULT 80).
1157: * IF FEWER THAN (WC) CHARACTERS ARE READ, THE LENGTH
1158: * FIELD OF THE SCBLK MUST BE ADJUSTED BEFORE RETURNING
1159: * UNLESS THE BUFFER IS RIGHT PADDED WITH ZEROES.
1160: * IT IS ALSO PERMISSIBLE TO TAKE THE ALTERNATIVE RETURN
1161: * AFTER SUCH AN ADJUSTMENT HAS BEEN MADE.
1162: * SPITBOL MAY CONTINUE TO MAKE CALLS AFTER AN ENDFILE
1163: * RETURN SO THIS ROUTINE SHOULD BE PREPARED TO MAKE
1164: * REPEATED ENDFILE RETURNS.
1165: *
1166: * (XR) POINTER TO BUFFER (SCBLK PTR)
1167: * (WC) LENGTH OF BUFFER IN CHARACTERS
1168: * JSR SYSRD CALL TO READ LINE
1169: * PPM LOC ENDFILE OR NO I/P FILE AFTER SYSXI
1170: * (WA,WB,WC) DESTROYED
1171: {{EJC{{{{
1172: *
1173: * SYSRI -- READ RECORD FROM INTERACTIVE CHANNEL
1174: *
1175: {SYSRI{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1176: *
1177: * READS A RECORD FROM ONLINE TERMINAL FOR SPITBOL VARIABLE,
1178: * TERMINAL. IF ONLINE TERMINAL IS UNAVAILABLE THEN CODE THE
1179: * ENDFILE RETURN ONLY.
1180: * THE BUFFER PROVIDED IS OF LENGTH 120 CHARACTERS. SYSRI
1181: * SHOULD REPLACE THE COUNT IN THE SECOND WORD OF THE SCBLK
1182: * BY THE ACTUAL CHARACTER COUNT UNLESS BUFFER IS RIGHT
1183: * PADDED WITH ZEROES.
1184: * IT IS ALSO PERMISSIBLE TO TAKE THE ALTERNATIVE
1185: * RETURN AFTER ADJUSTING THE COUNT.
1186: * THE END OF FILE RETURN MAY BE USED IF THIS MAKES
1187: * SENSE ON THE TARGET MACHINE (E.G. IF THERE IS AN
1188: * EOF CHARACTER.)
1189: *
1190: * (XR) PTR TO 120 CHAR BUFFER (SCBLK PTR)
1191: * JSR SYSRI CALL TO READ LINE FROM TERMINAL
1192: * PPM LOC END OF FILE RETURN
1193: * (WA,WB,WC) MAY BE DESTROYED
1194: {{EJC{{{{
1195: *
1196: * SYSRW -- REWIND FILE
1197: *
1198: {SYSRW{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1199: *
1200: * SYSRW IS USED TO REWIND A FILE I.E. REPOSITION THE FILE
1201: * AT THE START BEFORE THE FIRST RECORD. THE FILE SHOULD BE
1202: * CLOSED AND THE NEXT READ OR WRITE CALL WILL OPEN THE
1203: * FILE AT THE START.
1204: *
1205: * (WA) PTR TO FCBLK OR ZERO
1206: * (XR) REWIND ARG (SCBLK PTR)
1207: * JSR SYSRW CALL TO REWIND FILE
1208: * PPM LOC RETURN HERE IF FILE DOES NOT EXIST
1209: * PPM LOC RETURN HERE IF REWIND NOT ALLOWED
1210: * PPM LOC RETURN HERE IF I/O ERROR
1211: {{EJC{{{{
1212: *
1213: * SYSST -- SET FILE POINTER
1214: *
1215: {SYSST{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1216: *
1217: * SYSST IS CALLED TO CHANGE THE POSITION OF A FILE
1218: * POINTER. THIS IS ACCOMPLISHED IN A SYSTEM DEPENDENT
1219: * MANNER, AND THUS THE 2ND AND 3RD ARGUMENTS ARE PASSED
1220: * UNCONVERTED.
1221: *
1222: * (WA) FCBLK POINTER
1223: * (WB) 2ND ARGUMENT
1224: * (WC) 3RD ARGUMENT
1225: * JSR SYSST CALL TO SET FILE POINTER
1226: * PPM LOC RETURN HERE IF INVALID 2ND ARG
1227: * PPM LOC RETURN HERE IF INVALID 3RD ARG
1228: * PPM LOC RETURN HERE IF FILE DOES NOT EXIST
1229: * PPM LOC RETURN HERE IF SET NOT ALLOWED
1230: * PPM LOC RETURN HERE IF I/O ERROR
1231: *
1232: {{EJC{{{{
1233: *
1234: * SYSTM -- GET EXECUTION TIME SO FAR
1235: *
1236: {SYSTM{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1237: *
1238: * SYSTM IS USED TO OBTAIN THE AMOUNT OF EXECUTION TIME
1239: * USED SO FAR SINCE SPITBOL WAS GIVEN CONTROL. THE UNITS
1240: * ARE DESCRIBED AS MILLISECONDS IN THE SPITBOL OUTPUT, BUT
1241: * THE EXACT MEANING IS SYSTEM DEPENDENT. WHERE APPROPRIATE,
1242: * THIS VALUE SHOULD RELATE TO PROCESSOR RATHER THAN CLOCK
1243: * TIMING VALUES.
1244: *
1245: * JSR SYSTM CALL TO GET TIMER VALUE
1246: * (IA) TIME SO FAR IN MILLISECONDS
1247: {{EJC{{{{
1248: *
1249: * SYSTT -- TRACE TOGGLE
1250: *
1251: {SYSTT{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1252: *
1253: * CALLED BY SPITBOL FUNCTION TRACE() WITH NO ARGS TO
1254: * TOGGLE THE SYSTEM TRACE SWITCH. THIS PERMITS TRACING OF
1255: * LABELS IN SPITBOL CODE TO BE TURNED ON OR OFF.
1256: *
1257: * JSR SYSTT CALL TO TOGGLE TRACE SWITCH
1258: {{EJC{{{{
1259: *
1260: * SYSUL -- UNLOAD EXTERNAL FUNCTION
1261: *
1262: {SYSUL{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1263: *
1264: * SYSUL IS USED TO UNLOAD A FUNCTION PREVIOUSLY
1265: * LOADED WITH A CALL TO SYSLD.
1266: *
1267: * (XR) PTR TO CONTROL BLOCK (EFBLK)
1268: * JSR SYSUL CALL TO UNLOAD FUNCTION
1269: *
1270: * THE FUNCTION CANNOT BE CALLED FOLLOWING A SYSUL CALL
1271: * UNTIL ANOTHER SYSLD CALL IS MADE FOR THE SAME FUNCTION.
1272: *
1273: * THE EFBLK CONTAINS THE FUNCTION CODE POINTER AND ALSO A
1274: * POINTER TO THE VRBLK CONTAINING THE FUNCTION NAME (SEE
1275: * DEFINITIONS AND DATA STRUCTURES SECTION).
1276: {{EJC{{{{
1277: *
1278: * SYSXI -- EXIT TO PRODUCE LOAD MODULE
1279: *
1280: {SYSXI{EXP{{{{DEFINE EXTERNAL ENTRY POINT
1281: *
1282: * WHEN SYSXI IS CALLED, XL CONTAINS EITHER A STRING POINTER
1283: * OR ZERO. IN THE FORMER CASE, THE STRING GIVES THE
1284: * CHARACTER NAME OF A PROGRAM. THE INTENTION IS THAT
1285: * SPITBOL EXECUTION SHOULD BE TERMINATED FORTHWITH AND
1286: * THE NAMED PROGRAM LOADED AND EXECUTED. THIS TYPE OF CHAIN
1287: * EXECUTION IS VERY SYSTEM DEPENDENT AND IMPLEMENTORS MAY
1288: * CHOOSE TO OMIT IT OR FIND IT IMPOSSIBLE TO PROVIDE.
1289: * IF (XL) IS ZERO,IA CONTAINS ONE OF THE FOLLOWING INTEGERS
1290: *
1291: * -1, -2, -3
1292: * CREATE IF POSSIBLE A LOAD MODULE CONTAINING ONLY THE
1293: * IMPURE AREA OF MEMORY WHICH NEEDS TO BE LOADED WITH
1294: * A COMPATIBLE PURE SEGMENT FOR SUBSEQUENT EXECUTIONS.
1295: * VERSION NUMBERS TO CHECK COMPATIBILITY SHOULD BE
1296: * KEPT IN BOTH SEGMENTS AND CHECKED ON LOADING.
1297: * TO ASSIST WITH THIS CHECK, (XR) ON ENTRY IS A
1298: * POINTER TO AN SCBLK CONTAINING THE SPITBOL MAJOR
1299: * VERSION NUMBER V.V (SEE SYSID).
1300: *
1301: * 0 IF POSSIBLE, RETURN CONTROL TO JOB CONTROL
1302: * COMMAND LEVEL. THE EFFECT IF AVAILABLE WILL BE
1303: * SYSTEM DEPENDENT.
1304: *
1305: * +1, +2, +3
1306: * CREATE IF POSSIBLE A LOAD MODULE FROM ALL OF
1307: * MEMORY. IT SHOULD BE POSSIBLE TO LOAD AND EXECUTE
1308: * THIS MODULE DIRECTLY.
1309: *
1310: * IN THE CASE OF SAVED LOAD MODULES, THE STATUS OF OPEN
1311: * FILES IS NOT PRESERVED AND IMPLEMENTORS MAY CHOOSE TO
1312: * OFFER MEANS OF ATTACHING FILES BEFORE EXECUTION OF LOAD
1313: * MODULES STARTS OR LEAVE IT TO THE USER TO INCLUDE
1314: * SUITABLE INPUT(), OUTPUT() CALLS IN HIS PROGRAM.
1315: * SYSXI SHOULD MAKE A NOTE THAT NO I/O CHANNELS,
1316: * INCLUDING STANDARD FILES, HAVE FILES ATTACHED SO THAT
1317: * CALLS OF SYSIN, SYSOU, SYSPR, SYSRD SHOULD FAIL UNLESS
1318: * NEW ASSOCIATIONS ARE MADE FOR THE LOAD MODULE.
1319: * AT LEAST IN THE CASE OF THE STANDARD OUTPUT FILE, IT IS
1320: * RECOMMENDED THAT EITHER THE USER BE REQUIRED TO ATTACH
1321: * A FILE OR THAT A DEFAULT FILE IS ATTACHED, SINCE THE
1322: * PROBLEM OF ERROR MESSAGES GENERATED BY THE LOAD MODULE
1323: * IS OTHERWISE SEVERE. AS A LAST RESORT, IF SPITBOL
1324: * ATTEMPTS TO WRITE TO THE STANDARD OUTPUT FILE AND GETS A
1325: * REPLY INDICATING THAT SUCH OUPUT IS UNACCEPTABLE IT STOPS
1326: * BY USING AN ENTRY TO SYSEJ WITH ENDING CODE 998.
1327: * AS DESCRIBED BELOW, PASSING OF SOME ARGUMENTS MAKES IT
1328: * CLEAR THAT LOAD MODULE WILL USE A STANDARD OUTPUT FILE.
1329: *
1330: * IF USE IS MADE OF FCBLKS FOR I/O ASSOCIATION, SPITBOL
1331: * BUILDS A CHAIN SO THAT THOSE IN USE MAY BE FOUND IN SYSXI
1332: * AND SYSEJ. THE NODES ARE 4 WORDS LONG. THIRD WORD
1333: * CONTAINS LINK TO NEXT NODE OR 0, FOURTH WORD CONTAINS
1334: * FCBLK POINTER.
1335: {{EJC{{{{
1336: *
1337: * SYSXI (CONTINUED)
1338: *
1339: * (XL) ZERO OR SCBLK PTR
1340: * (XR) PTR TO V.V SCBLK
1341: * (IA) SIGNED INTEGER ARGUMENT
1342: * (WB) 0 OR PTR TO HEAD OF FCBLK CHAIN
1343: * JSR SYSXI CALL TO EXIT
1344: * PPM LOC REQUESTED ACTION NOT POSSIBLE
1345: * PPM LOC ACTION CAUSED IRRECOVERABLE ERROR
1346: * (REGISTERS) SHOULD BE PRESERVED OVER CALL
1347: *
1348: * LOADING AND RUNNING THE LOAD MODULE OR RETURNING FROM
1349: * JCL COMMAND LEVEL CAUSES EXECUTION TO RESUME AT THE POINT
1350: * AFTER THE ERROR RETURNS WHICH FOLLOW THE CALL OF SYSXI.
1351: * THE VALUE PASSED AS EXIT ARGUMENT IS USED TO INDICATE
1352: * OPTIONS REQUIRED ON RESUMPTION OF LOAD MODULE.
1353: * +1 OR -1 REQUIRE THAT ON RESUMPTION, SYSID AND SYSPP BE
1354: * CALLED AND A HEADING PRINTED ON THE STANDARD OUTPUT FILE.
1355: * +2 OR -2 INDICATE THAT SYSPP WILL BE CALLED BUT NOT SYSID
1356: * AND NO HEADING WILL BE PUT ON STANDARD OUTPUT FILE.
1357: * ABOVE OPTIONS HAVE THE OBVIOUS IMPLICATION THAT A
1358: * STANDARD O/P FILE MUST BE PROVIDED FOR THE LOAD MODULE.
1359: * +3 OR -3 INDICATE CALLS OF NEITHER SYSID NOR SYSPP
1360: * AND NO HEADING WILL BE PLACED ON STANDARD OUTPUT FILE.
1361: * NO RETURN FROM SYSXI IS POSSIBLE IF ANOTHER PROGRAM
1362: * IS LOADED AND ENTERED.
1363: {{EJC{{{{
1364: *
1365: * INTRODUCE THE INTERNAL PROCEDURES.
1366: *
1367: {ACESS{INP{R{1{{
1368: {ACOMP{INP{N{5{{
1369: {ALLOC{INP{E{0{{
1370: {ALOBF{INP{E{0{{
1371: {ALOCS{INP{E{0{{
1372: {ALOST{INP{E{0{{
1373: {APNDB{INP{E{2{{
1374: {ARITH{INP{N{3{{
1375: {ASIGN{INP{R{1{{
1376: {ASINP{INP{R{1{{
1377: {BLKLN{INP{E{0{{
1378: {CDGCG{INP{E{0{{
1379: {CDGEX{INP{R{0{{
1380: {CDGNM{INP{R{0{{
1381: {CDGVL{INP{R{0{{
1382: {CDWRD{INP{E{0{{
1383: {CMGEN{INP{R{0{{
1384: {CMPIL{INP{E{0{{
1385: {CNCRD{INP{E{0{{
1386: {COPYB{INP{N{1{{
1387: {DFFNC{INP{E{0{{
1388: {DTACH{INP{E{0{{
1389: {DTYPE{INP{E{0{{
1390: {DUMPR{INP{E{0{{
1391: {ERMSG{INP{E{0{{
1392: {ERTEX{INP{E{0{{
1393: {EVALI{INP{R{4{{
1394: {EVALP{INP{R{1{{
1395: {EVALS{INP{R{3{{
1396: {EVALX{INP{R{1{{
1397: {EXBLD{INP{E{0{{
1398: {EXPAN{INP{E{0{{
1399: {EXPAP{INP{E{1{{
1400: {EXPDM{INP{N{0{{
1401: {EXPOP{INP{N{0{{
1402: {FLSTG{INP{R{0{{
1403: {GBCOL{INP{E{0{{
1404: {GBCPF{INP{E{0{{
1405: {GTARR{INP{E{1{{
1406: {{EJC{{{{
1407: {GTCOD{INP{E{1{{
1408: {GTEXP{INP{E{1{{
1409: {GTINT{INP{E{1{{
1410: {GTNUM{INP{E{1{{
1411: {GTNVR{INP{E{1{{
1412: {GTPAT{INP{E{1{{
1413: {GTREA{INP{E{1{{
1414: {GTSMI{INP{N{2{{
1415: {GTSTG{INP{N{1{{
1416: {GTVAR{INP{E{1{{
1417: {HASHS{INP{E{0{{
1418: {ICBLD{INP{E{0{{
1419: {IDENT{INP{E{1{{
1420: {INOUT{INP{E{0{{
1421: {INSBF{INP{E{2{{
1422: {IOFCB{INP{N{2{{
1423: {IOPPF{INP{N{0{{
1424: {IOPUT{INP{N{6{{
1425: {KTREX{INP{R{0{{
1426: {KWNAM{INP{N{0{{
1427: {LCOMP{INP{N{5{{
1428: {LISTR{INP{E{0{{
1429: {LISTT{INP{E{0{{
1430: {NEXTS{INP{E{0{{
1431: {PATIN{INP{N{2{{
1432: {PATST{INP{N{1{{
1433: {PBILD{INP{E{0{{
1434: {PCONC{INP{E{0{{
1435: {PCOPY{INP{N{0{{
1436: {PRFLR{INP{E{0{{
1437: {PRFLU{INP{E{0{{
1438: {PRPAR{INP{E{0{{
1439: {PRTCH{INP{E{0{{
1440: {PRTIC{INP{E{0{{
1441: {PRTIS{INP{E{0{{
1442: {PRTIN{INP{E{0{{
1443: {PRTMI{INP{E{0{{
1444: {PRTMX{INP{E{0{{
1445: {PRTNL{INP{R{0{{
1446: {PRTNM{INP{R{0{{
1447: {PRTNV{INP{E{0{{
1448: {PRTPG{INP{E{0{{
1449: {PRTPS{INP{E{0{{
1450: {PRTSN{INP{E{0{{
1451: {PRTST{INP{R{0{{
1452: {{EJC{{{{
1453: {PRTTR{INP{E{0{{
1454: {PRTVL{INP{R{0{{
1455: {PRTVN{INP{E{0{{
1456: {RCBLD{INP{E{0{{
1457: {READR{INP{E{0{{
1458: {SBSTR{INP{E{0{{
1459: {SCANE{INP{E{0{{
1460: {SCNGF{INP{E{0{{
1461: {SETVR{INP{E{0{{
1462: {SORTA{INP{N{0{{
1463: {SORTC{INP{E{1{{
1464: {SORTF{INP{E{0{{
1465: {SORTH{INP{E{0{{
1466: {TFIND{INP{E{1{{
1467: {TRACE{INP{N{2{{
1468: {TRBLD{INP{E{0{{
1469: {TRIMR{INP{E{0{{
1470: {TRXEQ{INP{R{0{{
1471: {XSCAN{INP{E{0{{
1472: {XSCNI{INP{N{2{{
1473: *
1474: * INTRODUCE THE INTERNAL ROUTINES
1475: *
1476: {ARREF{INR{{{{
1477: {CFUNC{INR{{{{
1478: {EXFAL{INR{{{{
1479: {EXINT{INR{{{{
1480: {EXITS{INR{{{{
1481: {EXIXR{INR{{{{
1482: {EXNAM{INR{{{{
1483: {EXNUL{INR{{{{
1484: {EXREA{INR{{{{
1485: {EXSID{INR{{{{
1486: {EXVNM{INR{{{{
1487: {FAILP{INR{{{{
1488: {FLPOP{INR{{{{
1489: {INDIR{INR{{{{
1490: {MATCH{INR{{{{
1491: {RETRN{INR{{{{
1492: {STCOV{INR{{{{
1493: {STMGO{INR{{{{
1494: {STOPR{INR{{{{
1495: {SUCCP{INR{{{{
1496: {SYSAB{INR{{{{
1497: {SYSTU{INR{{{{
1498: {{TTL{S{{{P I T B O L -- DEFINITIONS AND DATA STRUCTURES
1499: {{SEC{{{{START OF DEFINITIONS SECTION
1500: *
1501: * DEFINITIONS OF MACHINE PARAMETERS
1502: *
1503: * THE MINIMAL TRANSLATOR SHOULD SUPPLY APPROPRIATE VALUES
1504: * FOR THE PARTICULAR TARGET MACHINE FOR ALL THE
1505: * EQU *
1506: * DEFINITIONS GIVEN AT THE START OF THIS SECTION.
1507: *
1508: {CFP$A{EQU{*{{{NUMBER OF CHARACTERS IN ALPHABET
1509: *
1510: {CFP$B{EQU{*{{{BYTES/WORD ADDRESSING FACTOR
1511: *
1512: {CFP$C{EQU{*{{{NUMBER OF CHARACTERS PER WORD
1513: *
1514: {CFP$F{EQU{*{{{OFFSET IN BYTES TO CHARS IN
1515: * SCBLK. SEE SCBLK FORMAT.
1516: *
1517: {CFP$I{EQU{*{{{NUMBER OF WORDS IN INTEGER CONSTANT
1518: *
1519: {CFP$M{EQU{*{{{MAX POSITIVE INTEGER IN ONE WORD
1520: *
1521: {CFP$N{EQU{*{{{NUMBER OF BITS IN ONE WORD
1522: *
1523: * THE FOLLOWING DEFINITIONS REQUIRE THE SUPPLY OF EITHER
1524: * A SINGLE PARAMETER IF REAL ARITHMETIC IS OMITTED OR
1525: * THREE PARAMETERS IF REAL ARITHMETIC IS INCLUDED.
1526: *
1527: *
1528: {CFP$R{EQU{*{{{NUMBER OF WORDS IN REAL CONSTANT
1529: *
1530: {CFP$S{EQU{*{{{NUMBER OF SIG DIGS FOR REAL OUTPUT
1531: *
1532: {CFP$X{EQU{*{{{MAX DIGITS IN REAL EXPONENT
1533: *
1534: {MXDGS{EQU{CFP$S+CFP$X{{{MAX DIGITS IN REAL NUMBER
1535: *
1536: {NSTMX{EQU{MXDGS+5{{{MAX SPACE FOR REAL (FOR +0.E+)
1537: *
1538: * THE FOLLOWING DEFINITION FOR CFP$U SUPPLIES A REALISTIC
1539: * UPPER BOUND ON THE SIZE OF THE ALPHABET. CFP$U IS USED
1540: * TO SAVE SPACE IN THE SCANE BSW-IFF-ESW TABLE AND TO EASE
1541: * TRANSLATION STORAGE REQUIREMENTS.
1542: *
1543: {CFP$U{EQU{*{{{REALISTIC UPPER BOUND ON ALPHABET
1544: {{EJC{{{{
1545: *
1546: * ENVIRONMENT PARAMETERS
1547: *
1548: * THE SPITBOL PROGRAM IS ESSENTIALLY INDEPENDENT OF
1549: * THE DEFINITIONS OF THESE PARAMETERS. HOWEVER, THE
1550: * EFFICIENCY OF THE SYSTEM MAY BE AFFECTED. CONSEQUENTLY,
1551: * THESE PARAMETERS MAY REQUIRE TUNING FOR A GIVEN VERSION
1552: * THE VALUES GIVEN IN COMMENTS HAVE BEEN SUCCESSFULLY USED.
1553: *
1554: * E$SRS IS THE NUMBER OF WORDS TO RESERVE AT THE END OF
1555: * STORAGE FOR END OF RUN PROCESSING. IT SHOULD BE
1556: * SET AS SMALL AS POSSIBLE WITHOUT CAUSING MEMORY OVERFLOW
1557: * IN CRITICAL SITUATIONS (E.G. MEMORY OVERFLOW TERMINATION)
1558: * AND SHOULD THUS RESERVE SUFFICIENT SPACE AT LEAST FOR
1559: * AN SCBLK CONTAINING SAY 30 CHARACTERS.
1560: *
1561: {E$SRS{EQU{*{{{30 WORDS
1562: *
1563: * E$STS IS THE NUMBER OF WORDS GRABBED IN A CHUNK WHEN
1564: * STORAGE IS ALLOCATED IN THE STATIC REGION. THE MINIMUM
1565: * PERMITTED VALUE IS 256/CFP$B. LARGER VALUES WILL LEAD
1566: * TO INCREASED EFFICIENCY AT THE COST OF WASTING MEMORY.
1567: *
1568: {E$STS{EQU{*{{{500 WORDS
1569: *
1570: * E$CBS IS THE SIZE OF CODE BLOCK ALLOCATED INITIALLY AND
1571: * THE EXPANSION INCREMENT IF OVERFLOW OCCURS. IF THIS VALUE
1572: * IS TOO SMALL OR TOO LARGE, EXCESSIVE GARBAGE COLLECTIONS
1573: * WILL OCCUR DURING COMPILATION AND MEMORY MAY BE LOST
1574: * IN THE CASE OF A TOO LARGE VALUE.
1575: *
1576: {E$CBS{EQU{*{{{500 WORDS
1577: *
1578: * E$HNB IS THE NUMBER OF BUCKET HEADERS IN THE VARIABLE
1579: * HASH TABLE. IT SHOULD ALWAYS BE ODD. LARGER VALUES WILL
1580: * SPEED UP COMPILATION AND INDIRECT REFERENCES AT THE
1581: * EXPENSE OF ADDITIONAL STORAGE FOR THE HASH TABLE ITSELF.
1582: *
1583: {E$HNB{EQU{*{{{127 BUCKET HEADERS
1584: *
1585: * E$HNW IS THE MAXIMUM NUMBER OF WORDS OF A STRING
1586: * NAME WHICH PARTICIPATE IN THE STRING HASH ALGORITHM.
1587: * LARGER VALUES GIVE A BETTER HASH AT THE EXPENSE OF TAKING
1588: * LONGER TO COMPUTE THE HASH. THERE IS SOME OPTIMAL VALUE.
1589: *
1590: {E$HNW{EQU{*{{{6 WORDS
1591: *
1592: * E$FSP . IF THE AMOUNT OF FREE SPACE LEFT AFTER A GARBAGE
1593: * COLLECTION IS SMALL COMPARED TO THE TOTAL AMOUNT OF SPACE
1594: * IN USE GARBAGE COLLECTOR THRASHING IS LIKELY TO OCCUR AS
1595: * THIS SPACE IS USED UP. E$FSP IS A MEASURE OF THE
1596: * MINIMUM PERCENTAGE OF DYNAMIC MEMORY LEFT AS FREE SPACE
1597: * BEFORE THE SYSTEM ROUTINE SYSMM IS CALLED TO TRY TO
1598: * OBTAIN MORE MEMORY.
1599: *
1600: {E$FSP{EQU{*{{{15 PERCENT
1601: {{EJC{{{{
1602: *
1603: * DEFINITIONS OF CODES FOR LETTERS
1604: *
1605: {CH$LA{EQU{*{{{LETTER A
1606: {CH$LB{EQU{*{{{LETTER B
1607: {CH$LC{EQU{*{{{LETTER C
1608: {CH$LD{EQU{*{{{LETTER D
1609: {CH$LE{EQU{*{{{LETTER E
1610: {CH$LF{EQU{*{{{LETTER F
1611: {CH$LG{EQU{*{{{LETTER G
1612: {CH$LH{EQU{*{{{LETTER H
1613: {CH$LI{EQU{*{{{LETTER I
1614: {CH$LJ{EQU{*{{{LETTER J
1615: {CH$LK{EQU{*{{{LETTER K
1616: {CH$LL{EQU{*{{{LETTER L
1617: {CH$LM{EQU{*{{{LETTER M
1618: {CH$LN{EQU{*{{{LETTER N
1619: {CH$LO{EQU{*{{{LETTER O
1620: {CH$LP{EQU{*{{{LETTER P
1621: {CH$LQ{EQU{*{{{LETTER Q
1622: {CH$LR{EQU{*{{{LETTER R
1623: {CH$LS{EQU{*{{{LETTER S
1624: {CH$LT{EQU{*{{{LETTER T
1625: {CH$LU{EQU{*{{{LETTER U
1626: {CH$LV{EQU{*{{{LETTER V
1627: {CH$LW{EQU{*{{{LETTER W
1628: {CH$LX{EQU{*{{{LETTER X
1629: {CH$LY{EQU{*{{{LETTER Y
1630: {CH$L${EQU{*{{{LETTER Z
1631: *
1632: * DEFINITIONS OF CODES FOR DIGITS
1633: *
1634: {CH$D0{EQU{*{{{DIGIT 0
1635: {CH$D1{EQU{*{{{DIGIT 1
1636: {CH$D2{EQU{*{{{DIGIT 2
1637: {CH$D3{EQU{*{{{DIGIT 3
1638: {CH$D4{EQU{*{{{DIGIT 4
1639: {CH$D5{EQU{*{{{DIGIT 5
1640: {CH$D6{EQU{*{{{DIGIT 6
1641: {CH$D7{EQU{*{{{DIGIT 7
1642: {CH$D8{EQU{*{{{DIGIT 8
1643: {CH$D9{EQU{*{{{DIGIT 9
1644: {{EJC{{{{
1645: *
1646: * DEFINITIONS OF CODES FOR SPECIAL CHARACTERS
1647: *
1648: * THE NAMES OF THESE CHARACTERS ARE RELATED TO THEIR
1649: * ORIGINAL REPRESENTATION IN THE EBCDIC SET CORRESPONDING
1650: * TO THE DESCRIPTION IN STANDARD SNOBOL4 MANUALS AND TEXTS.
1651: *
1652: {CH$AM{EQU{*{{{KEYWORD OPERATOR (AMPERSAND)
1653: {CH$AS{EQU{*{{{MULTIPLICATION SYMBOL (ASTERISK)
1654: {CH$AT{EQU{*{{{CURSOR POSITION OPERATOR (AT)
1655: {CH$BB{EQU{*{{{LEFT ARRAY BRACKET (LESS THAN)
1656: {CH$BL{EQU{*{{{BLANK
1657: {CH$BR{EQU{*{{{ALTERNATION OPERATOR (VERTICAL BAR)
1658: {CH$CL{EQU{*{{{GOTO SYMBOL (COLON)
1659: {CH$CM{EQU{*{{{COMMA
1660: {CH$DL{EQU{*{{{INDIRECTION OPERATOR (DOLLAR)
1661: {CH$DT{EQU{*{{{NAME OPERATOR (DOT)
1662: {CH$DQ{EQU{*{{{DOUBLE QUOTE
1663: {CH$EQ{EQU{*{{{EQUAL SIGN
1664: {CH$EX{EQU{*{{{EXPONENTIATION OPERATOR (EXCLM)
1665: {CH$MN{EQU{*{{{MINUS SIGN
1666: {CH$NM{EQU{*{{{NUMBER SIGN
1667: {CH$NT{EQU{*{{{NEGATION OPERATOR (NOT)
1668: {CH$PC{EQU{*{{{PERCENT
1669: {CH$PL{EQU{*{{{PLUS SIGN
1670: {CH$PP{EQU{*{{{LEFT PARENTHESIS
1671: {CH$RB{EQU{*{{{RIGHT ARRAY BRACKET (GRTR THAN)
1672: {CH$RP{EQU{*{{{RIGHT PARENTHESIS
1673: {CH$QU{EQU{*{{{INTERROGATION OPERATOR (QUESTION)
1674: {CH$SL{EQU{*{{{SLASH
1675: {CH$SM{EQU{*{{{SEMICOLON
1676: {CH$SQ{EQU{*{{{SINGLE QUOTE
1677: {CH$UN{EQU{*{{{SPECIAL IDENTIFIER CHAR (UNDERLINE)
1678: {CH$OB{EQU{*{{{OPENING BRACKET
1679: {CH$CB{EQU{*{{{CLOSING BRACKET
1680: {{EJC{{{{
1681: *
1682: * REMAINING CHARS ARE OPTIONAL ADDITIONS TO THE STANDARDS.
1683: *
1684: * TAB CHARACTERS - SYNTACTICALLY EQUIVALENT TO BLANK
1685: *
1686: {CH$HT{EQU{*{{{HORIZONTAL TAB
1687: *
1688: * LOWER CASE OR SHIFTED CASE ALPHABETIC CHARS
1689: *
1690: {CH$$A{EQU{*{{{SHIFTED A
1691: {CH$$B{EQU{*{{{SHIFTED B
1692: {CH$$C{EQU{*{{{SHIFTED C
1693: {CH$$D{EQU{*{{{SHIFTED D
1694: {CH$$E{EQU{*{{{SHIFTED E
1695: {CH$$F{EQU{*{{{SHIFTED F
1696: {CH$$G{EQU{*{{{SHIFTED G
1697: {CH$$H{EQU{*{{{SHIFTED H
1698: {CH$$I{EQU{*{{{SHIFTED I
1699: {CH$$J{EQU{*{{{SHIFTED J
1700: {CH$$K{EQU{*{{{SHIFTED K
1701: {CH$$L{EQU{*{{{SHIFTED L
1702: {CH$$M{EQU{*{{{SHIFTED M
1703: {CH$$N{EQU{*{{{SHIFTED N
1704: {CH$$O{EQU{*{{{SHIFTED O
1705: {CH$$P{EQU{*{{{SHIFTED P
1706: {CH$$Q{EQU{*{{{SHIFTED Q
1707: {CH$$R{EQU{*{{{SHIFTED R
1708: {CH$$S{EQU{*{{{SHIFTED S
1709: {CH$$T{EQU{*{{{SHIFTED T
1710: {CH$$U{EQU{*{{{SHIFTED U
1711: {CH$$V{EQU{*{{{SHIFTED V
1712: {CH$$W{EQU{*{{{SHIFTED W
1713: {CH$$X{EQU{*{{{SHIFTED X
1714: {CH$$Y{EQU{*{{{SHIFTED Y
1715: {CH$$${EQU{*{{{SHIFTED Z
1716: * IF A DELIMITER OTHER THAN CH$CM MUST BE USED IN
1717: * THE THIRD ARGUMENT OF INPUT(),OUTPUT() THEN .CIOD SHOULD
1718: * BE DEFINED AND A PARAMETER SUPPLIED FOR IODEL.
1719: *
1720: {IODEL{EQU{*{{{
1721: {{EJC{{{{
1722: *
1723: * DATA BLOCK FORMATS AND DEFINITIONS
1724: *
1725: * THE FOLLOWING SECTIONS DESCRIBE THE DETAILED FORMAT OF
1726: * ALL POSSIBLE DATA BLOCKS IN STATIC AND DYNAMIC MEMORY.
1727: *
1728: * EVERY BLOCK HAS A NAME OF THE FORM XXBLK WHERE XX IS A
1729: * UNIQUE TWO CHARACTER IDENTIFIER. THE FIRST WORD OF EVERY
1730: * BLOCK MUST CONTAIN A POINTER TO A PROGRAM LOCATION IN THE
1731: * INTERPRETOR WHICH IS IMMEDIATELY PRECEDED BY AN ADDRESS
1732: * CONSTANT CONTAINING THE VALUE BL$XX WHERE XX IS THE BLOCK
1733: * IDENTIFIER. THIS PROVIDES A UNIFORM MECHANISM FOR
1734: * DISTINGUISHING BETWEEN THE VARIOUS BLOCK TYPES.
1735: *
1736: * IN SOME CASES, THE CONTENTS OF THE FIRST WORD IS CONSTANT
1737: * FOR A GIVEN BLOCK TYPE AND MERELY SERVES AS A POINTER
1738: * TO THE IDENTIFYING ADDRESS CONSTANT. HOWEVER, IN OTHER
1739: * CASES THERE ARE SEVERAL POSSIBILITIES FOR THE FIRST
1740: * WORD IN WHICH CASE EACH OF THE SEVERAL PROGRAM ENTRY
1741: * POINTS MUST BE PRECEDED BY THE APPROPRIATE CONSTANT.
1742: *
1743: * IN EACH BLOCK, SOME OF THE FIELDS ARE RELOCATABLE. THIS
1744: * MEANS THAT THEY MAY CONTAIN A POINTER TO ANOTHER BLOCK
1745: * IN THE DYNAMIC AREA. (TO BE MORE PRECISE, IF THEY CONTAIN
1746: * A POINTER WITHIN THE DYNAMIC AREA, THEN IT IS A POINTER
1747: * TO A BLOCK). SUCH FIELDS MUST BE MODIFIED BY THE GARBAGE
1748: * COLLECTOR (PROCEDURE GBCOL) WHENEVER BLOCKS ARE COMPACTED
1749: * IN THE DYNAMIC REGION. THE GARBAGE COLLECTOR (ACTUALLY
1750: * PROCEDURE GBCPF) REQUIRES THAT ALL SUCH RELOCATABLE
1751: * FIELDS IN A BLOCK MUST BE CONTIGUOUS.
1752: {{EJC{{{{
1753: *
1754: * THE DESCRIPTION FORMAT USES THE FOLLOWING SCHEME.
1755: *
1756: * 1) BLOCK TITLE AND TWO CHARACTER IDENTIFIER
1757: *
1758: * 2) DESCRIPTION OF BASIC USE OF BLOCK AND INDICATION
1759: * OF CIRCUMSTANCES UNDER WHICH IT IS CONSTRUCTED.
1760: *
1761: * 3) PICTURE OF THE BLOCK FORMAT. IN THESE PICTURES LOW
1762: * MEMORY ADDRESSES ARE AT THE TOP OF THE PAGE. FIXED
1763: * LENGTH FIELDS ARE SURROUNDED BY I (LETTER I). FIELDS
1764: * WHICH ARE FIXED LENGTH BUT WHOSE LENGTH IS DEPENDENT
1765: * ON A CONFIGURATION PARAMETER ARE SURROUNDED BY *
1766: * (ASTERISK). VARIABLE LENGTH FIELDS ARE SURROUNDED
1767: * BY / (SLASH).
1768: *
1769: * 4) DEFINITION OF SYMBOLIC OFFSETS TO FIELDS IN
1770: * BLOCK AND OF THE SIZE OF THE BLOCK IF FIXED LENGTH
1771: * OR OF THE SIZE OF THE FIXED LENGTH FIELDS IF THE
1772: * BLOCK IS VARIABLE LENGTH.
1773: * NOTE THAT SOME ROUTINES SUCH AS GBCPF ASSUME
1774: * CERTAIN OFFSETS ARE EQUAL. THE DEFINITIONS
1775: * GIVEN HERE ENFORCE THIS. MAKE CHANGES TO
1776: * THEM ONLY WITH DUE CARE.
1777: *
1778: * DEFINITIONS OF COMMON OFFSETS
1779: *
1780: {OFFS1{EQU{1{{{
1781: {OFFS2{EQU{2{{{
1782: {OFFS3{EQU{3{{{
1783: *
1784: * 5) DETAILED COMMENTS ON THE SIGNIFICANCE AND FORMATS
1785: * OF THE VARIOUS FIELDS.
1786: *
1787: * THE ORDER IS ALPHABETICAL BY IDENTIFICATION CODE.
1788: {{EJC{{{{
1789: *
1790: * DEFINITIONS OF BLOCK CODES
1791: *
1792: * THIS TABLE PROVIDES A UNIQUE IDENTIFICATION CODE FOR
1793: * EACH SEPARATE BLOCK TYPE. THE FIRST WORD OF A BLOCK IN
1794: * THE DYNAMIC AREA ALWAYS CONTAINS THE ADDRESS OF A PROGRAM
1795: * ENTRY POINT. THE BLOCK CODE IS USED AS THE ENTRY POINT ID
1796: * THE ORDER OF THESE CODES DICTATES THE ORDER OF THE TABLE
1797: * USED BY THE DATATYPE FUNCTION (SCNMT IN THE CONSTANT SEC)
1798: *
1799: * BLOCK CODES FOR ACCESSIBLE DATATYPES
1800: *
1801: {BL$AR{EQU{0{{{ARBLK ARRAY
1802: {BL$BC{EQU{BL$AR+1{{{BCBLK BUFFER
1803: {BL$CD{EQU{BL$BC+1{{{CDBLK CODE
1804: {BL$EX{EQU{BL$CD+1{{{EXBLK EXPRESSION
1805: {BL$IC{EQU{BL$EX+1{{{ICBLK INTEGER
1806: {BL$NM{EQU{BL$IC+1{{{NMBLK NAME
1807: {BL$P0{EQU{BL$NM+1{{{P0BLK PATTERN
1808: {BL$P1{EQU{BL$P0+1{{{P1BLK PATTERN
1809: {BL$P2{EQU{BL$P1+1{{{P2BLK PATTERN
1810: {BL$RC{EQU{BL$P2+1{{{RCBLK REAL
1811: {BL$SC{EQU{BL$RC+1{{{SCBLK STRING
1812: {BL$SE{EQU{BL$SC+1{{{SEBLK EXPRESSION
1813: {BL$TB{EQU{BL$SE+1{{{TBBLK TABLE
1814: {BL$VC{EQU{BL$TB+1{{{VCBLK ARRAY
1815: {BL$XN{EQU{BL$VC+1{{{XNBLK EXTERNAL
1816: {BL$XR{EQU{BL$XN+1{{{XRBLK EXTERNAL
1817: {BL$PD{EQU{BL$XR+1{{{PDBLK PROGRAM DEFINED DATATYPE
1818: *
1819: {BL$$D{EQU{BL$PD+1{{{NUMBER OF BLOCK CODES FOR DATA
1820: *
1821: * OTHER BLOCK CODES
1822: *
1823: {BL$TR{EQU{BL$PD+1{{{TRBLK
1824: {BL$BF{EQU{BL$TR+1{{{BFBLK
1825: {BL$CC{EQU{BL$BF+1{{{CCBLK
1826: {BL$CM{EQU{BL$CC+1{{{CMBLK
1827: {BL$CT{EQU{BL$CM+1{{{CTBLK
1828: {BL$DF{EQU{BL$CT+1{{{DFBLK
1829: {BL$EF{EQU{BL$DF+1{{{EFBLK
1830: {BL$EV{EQU{BL$EF+1{{{EVBLK
1831: {BL$FF{EQU{BL$EV+1{{{FFBLK
1832: {BL$KV{EQU{BL$FF+1{{{KVBLK
1833: {BL$PF{EQU{BL$KV+1{{{PFBLK
1834: {BL$TE{EQU{BL$PF+1{{{TEBLK
1835: *
1836: {BL$$I{EQU{0{{{DEFAULT IDENTIFICATION CODE
1837: {BL$$T{EQU{BL$TR+1{{{CODE FOR DATA OR TRACE BLOCK
1838: {BL$$${EQU{BL$TE+1{{{NUMBER OF BLOCK CODES
1839: {{EJC{{{{
1840: *
1841: * FIELD REFERENCES
1842: *
1843: * REFERENCES TO THE FIELDS OF DATA BLOCKS ARE SYMBOLIC
1844: * (I.E. USE THE SYMBOLIC OFFSETS) WITH THE FOLLOWING
1845: * EXCEPTIONS.
1846: *
1847: * 1) REFERENCES TO THE FIRST WORD ARE USUALLY NOT
1848: * SYMBOLIC SINCE THEY USE THE (X) OPERAND FORMAT.
1849: *
1850: * 2) THE CODE WHICH CONSTRUCTS A BLOCK IS OFTEN NOT
1851: * SYMBOLIC AND SHOULD BE CHANGED IF THE CORRESPONDING
1852: * BLOCK FORMAT IS MODIFIED.
1853: *
1854: * 3) THE PLC AND PSC INSTRUCTIONS IMPLY AN OFFSET
1855: * CORRESPONDING TO THE DEFINITION OF CFP$F.
1856: *
1857: * 4) THERE ARE NON-SYMBOLIC REFERENCES (EASILY CHANGED)
1858: * IN THE GARBAGE COLLECTOR (PROCEDURES GBCPF, BLKLN).
1859: *
1860: * 5) THE FIELDS IDVAL, FARGS APPEAR IN SEVERAL BLOCKS
1861: * AND ANY CHANGES MUST BE MADE IN PARALLEL TO ALL
1862: * BLOCKS CONTAINING THE FIELDS. THE ACTUAL REFERENCES
1863: * TO THESE FIELDS ARE SYMBOLIC WITH THE ABOVE
1864: * LISTED EXCEPTIONS.
1865: *
1866: * 6) SEVERAL SPOTS IN THE CODE ASSUME THAT THE
1867: * DEFINITIONS OF THE FIELDS VRVAL, TEVAL, TRNXT ARE
1868: * THE SAME (THESE ARE SECTIONS OF CODE WHICH SEARCH
1869: * OUT ALONG A TRBLK CHAIN FROM A VARIABLE).
1870: *
1871: * 7) REFERENCES TO THE FIELDS OF AN ARRAY BLOCK IN THE
1872: * ARRAY REFERENCE ROUTINE ARREF ARE NON-SYMBOLIC.
1873: *
1874: * APART FROM THE EXCEPTIONS LISTED, REFERENCES ARE SYMBOLIC
1875: * AS FAR AS POSSIBLE AND MODIFYING THE ORDER OR NUMBER
1876: * OF FIELDS WILL NOT REQUIRE CHANGES.
1877: {{EJC{{{{
1878: *
1879: * COMMON FIELDS FOR FUNCTION BLOCKS
1880: *
1881: * BLOCKS WHICH REPRESENT CALLABLE FUNCTIONS HAVE TWO
1882: * COMMON FIELDS AT THE START OF THE BLOCK AS FOLLOWS.
1883: *
1884: * +------------------------------------+
1885: * I FCODE I
1886: * +------------------------------------+
1887: * I FARGS I
1888: * +------------------------------------+
1889: * / /
1890: * / REST OF FUNCTION BLOCK /
1891: * / /
1892: * +------------------------------------+
1893: *
1894: {FCODE{EQU{0{{{POINTER TO CODE FOR FUNCTION
1895: {FARGS{EQU{1{{{NUMBER OF ARGUMENTS
1896: *
1897: * FCODE IS A POINTER TO THE LOCATION IN THE INTERPRETOR
1898: * PROGRAM WHICH PROCESSES THIS TYPE OF FUNCTION CALL.
1899: *
1900: * FARGS IS THE EXPECTED NUMBER OF ARGUMENTS. THE ACTUAL
1901: * NUMBER OF ARGUMENTS IS ADJUSTED TO THIS AMOUNT BY
1902: * DELETING EXTRA ARGUMENTS OR SUPPLYING TRAILING NULLS
1903: * FOR MISSING ONES BEFORE TRANSFERRING THOUGH FCODE.
1904: * A VALUE OF 999 MAY BE USED IN THIS FIELD TO INDICATE A
1905: * VARIABLE NUMBER OF ARGUMENTS (SEE SVBLK FIELD SVNAR).
1906: *
1907: * THE BLOCK TYPES WHICH FOLLOW THIS SCHEME ARE.
1908: *
1909: * FFBLK FIELD FUNCTION
1910: * DFBLK DATATYPE FUNCTION
1911: * PFBLK PROGRAM DEFINED FUNCTION
1912: * EFBLK EXTERNAL LOADED FUNCTION
1913: {{EJC{{{{
1914: *
1915: * IDENTIFICATION FIELD
1916: *
1917: *
1918: * ID FIELD
1919: *
1920: * CERTAIN PROGRAM ACCESSIBLE OBJECTS (THOSE WHICH CONTAIN
1921: * OTHER DATA VALUES AND CAN BE COPIED) ARE GIVEN A UNIQUE
1922: * IDENTIFICATION NUMBER (SEE EXSID). THIS ID VALUE IS AN
1923: * ADDRESS INTEGER VALUE WHICH IS ALWAYS STORED IN WORD TWO.
1924: *
1925: {IDVAL{EQU{1{{{ID VALUE FIELD
1926: *
1927: * THE BLOCKS CONTAINING AN IDVAL FIELD ARE.
1928: *
1929: * ARBLK ARRAY
1930: * BCBLK BUFFER CONTROL BLOCK
1931: * PDBLK PROGRAM DEFINED DATATYPE
1932: * TBBLK TABLE
1933: * VCBLK VECTOR BLOCK (ARRAY)
1934: *
1935: * NOTE THAT A ZERO IDVAL MEANS THAT THE BLOCK IS ONLY
1936: * HALF BUILT AND SHOULD NOT BE DUMPED (SEE DUMPR).
1937: {{EJC{{{{
1938: *
1939: * ARRAY BLOCK (ARBLK)
1940: *
1941: * AN ARRAY BLOCK REPRESENTS AN ARRAY VALUE OTHER THAN ONE
1942: * WITH ONE DIMENSION WHOSE LOWER BOUND IS ONE (SEE VCBLK).
1943: * AN ARBLK IS BUILT WITH A CALL TO THE FUNCTIONS CONVERT
1944: * (S$CNV) OR ARRAY (S$ARR).
1945: *
1946: * +------------------------------------+
1947: * I ARTYP I
1948: * +------------------------------------+
1949: * I IDVAL I
1950: * +------------------------------------+
1951: * I ARLEN I
1952: * +------------------------------------+
1953: * I AROFS I
1954: * +------------------------------------+
1955: * I ARNDM I
1956: * +------------------------------------+
1957: * * ARLBD *
1958: * +------------------------------------+
1959: * * ARDIM *
1960: * +------------------------------------+
1961: * * *
1962: * * ABOVE 2 FLDS REPEATED FOR EACH DIM *
1963: * * *
1964: * +------------------------------------+
1965: * I ARPRO I
1966: * +------------------------------------+
1967: * / /
1968: * / ARVLS /
1969: * / /
1970: * +------------------------------------+
1971: {{EJC{{{{
1972: *
1973: * ARRAY BLOCK (CONTINUED)
1974: *
1975: {ARTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$ART
1976: {ARLEN{EQU{IDVAL+1{{{LENGTH OF ARBLK IN BYTES
1977: {AROFS{EQU{ARLEN+1{{{OFFSET IN ARBLK TO ARPRO FIELD
1978: {ARNDM{EQU{AROFS+1{{{NUMBER OF DIMENSIONS
1979: {ARLBD{EQU{ARNDM+1{{{LOW BOUND (FIRST SUBSCRIPT)
1980: {ARDIM{EQU{ARLBD+CFP$I{{{DIMENSION (FIRST SUBSCRIPT)
1981: {ARLB2{EQU{ARDIM+CFP$I{{{LOW BOUND (SECOND SUBSCRIPT)
1982: {ARDM2{EQU{ARLB2+CFP$I{{{DIMENSION (SECOND SUBSCRIPT)
1983: {ARPRO{EQU{ARDIM+CFP$I{{{ARRAY PROTOTYPE (ONE DIMENSION)
1984: {ARVLS{EQU{ARPRO+1{{{START OF VALUES (ONE DIMENSION)
1985: {ARPR2{EQU{ARDM2+CFP$I{{{ARRAY PROTOTYPE (TWO DIMENSIONS)
1986: {ARVL2{EQU{ARPR2+1{{{START OF VALUES (TWO DIMENSIONS)
1987: {ARSI${EQU{ARLBD{{{NUMBER OF STANDARD FIELDS IN BLOCK
1988: {ARDMS{EQU{ARLB2-ARLBD{{{SIZE OF INFO FOR ONE SET OF BOUNDS
1989: *
1990: * THE BOUNDS AND DIMENSION FIELDS ARE SIGNED INTEGER
1991: * VALUES AND EACH OCCUPY CFP$I WORDS IN THE ARBLK.
1992: *
1993: * THE LENGTH OF AN ARBLK IN BYTES MAY NOT EXCEED MXLEN.
1994: * THIS IS REQUIRED TO KEEP NAME OFFSETS GARBAGE COLLECTABLE
1995: *
1996: * THE ACTUAL VALUES ARE ARRANGED IN ROW-WISE ORDER AND
1997: * CAN CONTAIN A DATA POINTER OR A POINTER TO A TRBLK.
1998: *
1999: * BUFFER CONTROL BLOCK (BCBLK)
2000: *
2001: * A BCBLK IS BUILT FOR EVERY BFBLK.
2002: *
2003: * +------------------------------------+
2004: * I BCTYP I
2005: * +------------------------------------+
2006: * I IDVAL I
2007: * +------------------------------------+
2008: * I BCLEN I
2009: * +------------------------------------+
2010: * I BCBUF I
2011: * +------------------------------------+
2012: *
2013: {BCTYP{EQU{0{{{PTR TO DUMMY ROUTINE B$BCT
2014: {BCLEN{EQU{IDVAL+1{{{DEFINED BUFFER LENGTH
2015: {BCBUF{EQU{BCLEN+1{{{PTR TO BFBLK
2016: {BCSI${EQU{BCBUF+1{{{SIZE OF BCBLK
2017: *
2018: * A BCBLK IS AN INDIRECT CONTROL HEADER FOR BFBLK.
2019: * THE REASON FOR NOT STORING THIS DATA DIRECTLY
2020: * IN THE RELATED BFBLK IS SO THAT THE BFBLK CAN
2021: * MAINTAIN THE SAME SKELETAL STRUCTURE AS AN SCBLK
2022: * THUS FACILITATING TRANSPARENT STRING OPERATIONS
2023: * (FOR THE MOST PART). SPECIFICALLY, CFP$F IS THE
2024: * SAME FOR A BFBLK AS FOR AN SCBLK. BY CONVENTION,
2025: * WHEREEVER A BUFFER VALUE IS EMPLOYED, THE BCBLK
2026: * IS POINTED TO.
2027: *
2028: * THE CORRESPONDING BFBLK IS POINTED TO BY THE
2029: * BCBUF POINTER IN THE BCBLK.
2030: *
2031: * BCLEN IS THE CURRENT DEFINED SIZE OF THE CHARACTER
2032: * ARRAY IN THE BFBLK. CHARACTERS FOLLOWING THE OFFSET
2033: * OF BCLEN ARE UNDEFINED.
2034: *
2035: {{EJC{{{{
2036: *
2037: * STRING BUFFER BLOCK (BFBLK)
2038: *
2039: * A BFBLK IS BUILT BY A CALL TO BUFFER(...)
2040: *
2041: * +------------------------------------+
2042: * I BFTYP I
2043: * +------------------------------------+
2044: * I BFALC I
2045: * +------------------------------------+
2046: * / /
2047: * / BFCHR /
2048: * / /
2049: * +------------------------------------+
2050: *
2051: {BFTYP{EQU{0{{{PTR TO DUMMY ROUTINE B$BFT
2052: {BFALC{EQU{BFTYP+1{{{ALLOCATED SIZE OF BUFFER
2053: {BFCHR{EQU{BFALC+1{{{CHARACTERS OF STRING
2054: {BFSI${EQU{BFCHR{{{SIZE OF STANDARD FIELDS IN BFBLK
2055: *
2056: * THE CHARACTERS IN THE BUFFER ARE STORED LEFT JUSTIFIED.
2057: * THE FINAL WORD OF DEFINED CHARACTERS IS ALWAYS ZERO
2058: * (CHARACTER) PADDED. ANY TRAILING ALLOCATION PAST THE
2059: * WORD CONTAINING THE LAST CHARACTER CONTAINS
2060: * UNPREDICTABLE CONTENTS AND IS NEVER REFERENCED.
2061: *
2062: * NOTE THAT THE OFFSET TO THE CHARACTERS OF THE STRING
2063: * IS GIVEN BY CFP$F, AS WITH AN SCBLK. HOWEVER, THE
2064: * OFFSET WHICH IS OCCUPIED BY THE LENGTH FOR AN SCBLK
2065: * IS THE TOTAL CHAR SPACE FOR BFBLKS, AND ROUTINES WHICH
2066: * DEAL WITH BOTH MUST ACCOUNT FOR THIS DIFFERENCE.
2067: *
2068: * THE VALUE OF BFALC MAY NOT EXCEED MXLEN. THE VALUE OF
2069: * BCLEN IS ALWAYS LESS THAN OR EQUAL TO BFALC.
2070: *
2071: {{EJC{{{{
2072: *
2073: * CODE CONSTRUCTION BLOCK (CCBLK)
2074: *
2075: * AT ANY ONE MOMENT THERE IS AT MOST ONE CCBLK INTO
2076: * WHICH THE COMPILER IS CURRENTLY STORING CODE (CDWRD).
2077: *
2078: * +------------------------------------+
2079: * I CCTYP I
2080: * +------------------------------------+
2081: * I CCLEN I
2082: * +------------------------------------+
2083: * I CCUSE I
2084: * +------------------------------------+
2085: * / /
2086: * / CCCOD /
2087: * / /
2088: * +------------------------------------+
2089: *
2090: {CCTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$CCT
2091: {CCLEN{EQU{CCTYP+1{{{LENGTH OF CCBLK IN BYTES
2092: {CCUSE{EQU{CCLEN+1{{{OFFSET PAST LAST USED WORD (BYTES)
2093: {CCCOD{EQU{CCUSE+1{{{START OF GENERATED CODE IN BLOCK
2094: *
2095: * THE REASON THAT THE CCBLK IS A SEPARATE BLOCK TYPE FROM
2096: * THE USUAL CDBLK IS THAT THE GARBAGE COLLECTOR MUST
2097: * ONLY PROCESS THOSE FIELDS WHICH HAVE BEEN SET (SEE GBCPF)
2098: {{EJC{{{{
2099: *
2100: * CODE BLOCK (CDBLK)
2101: *
2102: * A CODE BLOCK IS BUILT FOR EACH STATEMENT COMPILED DURING
2103: * THE INITIAL COMPILATION OR BY SUBSEQUENT CALLS TO CODE.
2104: *
2105: * +------------------------------------+
2106: * I CDJMP I
2107: * +------------------------------------+
2108: * I CDSTM I
2109: * +------------------------------------+
2110: * I CDLEN I
2111: * +------------------------------------+
2112: * I CDFAL I
2113: * +------------------------------------+
2114: * / /
2115: * / CDCOD /
2116: * / /
2117: * +------------------------------------+
2118: *
2119: {CDJMP{EQU{0{{{PTR TO ROUTINE TO EXECUTE STATEMENT
2120: {CDSTM{EQU{CDJMP+1{{{STATEMENT NUMBER
2121: {CDLEN{EQU{OFFS2{{{LENGTH OF CDBLK IN BYTES
2122: {CDFAL{EQU{OFFS3{{{FAILURE EXIT (SEE BELOW)
2123: {CDCOD{EQU{CDFAL+1{{{EXECUTABLE PSEUDO-CODE
2124: {CDSI${EQU{CDCOD{{{NUMBER OF STANDARD FIELDS IN CDBLK
2125: *
2126: * CDSTM IS THE STATEMENT NUMBER OF THE CURRENT STATEMENT.
2127: *
2128: * CDJMP, CDFAL ARE SET AS FOLLOWS.
2129: *
2130: * 1) IF THE FAILURE EXIT IS THE NEXT STATEMENT
2131: *
2132: * CDJMP = B$CDS
2133: * CDFAL = PTR TO CDBLK FOR NEXT STATEMENT
2134: *
2135: * 2) IF THE FAILURE EXIT IS A SIMPLE LABEL NAME
2136: *
2137: * CDJMP = B$CDS
2138: * CDFAL IS A PTR TO THE VRTRA FIELD OF THE VRBLK
2139: *
2140: * 3) IF THERE IS NO FAILURE EXIT (-NOFAIL MODE)
2141: *
2142: * CDJMP = B$CDS
2143: * CDFAL = O$UNF
2144: *
2145: * 4) IF THE FAILURE EXIT IS COMPLEX OR DIRECT
2146: *
2147: * CDJMP = B$CDC
2148: * CDFAL IS THE OFFSET TO THE O$GOF WORD
2149: {{EJC{{{{
2150: *
2151: * CODE BLOCK (CONTINUED)
2152: *
2153: * CDCOD IS THE START OF THE ACTUAL CODE. FIRST WE DESCRIBE
2154: * THE CODE GENERATED FOR AN EXPRESSION. IN AN EXPRESSION,
2155: * ELEMENTS ARE FETCHED BY NAME OR BY VALUE. FOR EXAMPLE,
2156: * THE BINARY EQUAL OPERATOR FETCHES ITS LEFT ARGUMENT
2157: * BY NAME AND ITS RIGHT ARGUMENT BY VALUE. THESE TWO
2158: * CASES GENERATE QUITE DIFFERENT CODE AND ARE DESCRIBED
2159: * SEPARATELY. FIRST WE CONSIDER THE CODE BY VALUE CASE.
2160: *
2161: * GENERATION OF CODE BY VALUE FOR EXPRESSIONS ELEMENTS.
2162: *
2163: * EXPRESSION POINTER TO EXBLK OR SEBLK
2164: *
2165: * INTEGER CONSTANT POINTER TO ICBLK
2166: *
2167: * NULL CONSTANT POINTER TO NULLS
2168: *
2169: * PATTERN (RESULTING FROM PREEVALUATION)
2170: * =O$LPT
2171: * POINTER TO P0BLK,P1BLK OR P2BLK
2172: *
2173: * REAL CONSTANT POINTER TO RCBLK
2174: *
2175: * STRING CONSTANT POINTER TO SCBLK
2176: *
2177: * VARIABLE POINTER TO VRGET FIELD OF VRBLK
2178: *
2179: * ADDITION VALUE CODE FOR LEFT OPERAND
2180: * VALUE CODE FOR RIGHT OPERAND
2181: * =O$ADD
2182: *
2183: * AFFIRMATION VALUE CODE FOR OPERAND
2184: * =O$AFF
2185: *
2186: * ALTERNATION VALUE CODE FOR LEFT OPERAND
2187: * VALUE CODE FOR RIGHT OPERAND
2188: * =O$ALT
2189: *
2190: * ARRAY REFERENCE (CASE OF ONE SUBSCRIPT)
2191: * VALUE CODE FOR ARRAY OPERAND
2192: * VALUE CODE FOR SUBSCRIPT OPERAND
2193: * =O$AOV
2194: *
2195: * (CASE OF MORE THAN ONE SUBSCRIPT)
2196: * VALUE CODE FOR ARRAY OPERAND
2197: * VALUE CODE FOR FIRST SUBSCRIPT
2198: * VALUE CODE FOR SECOND SUBSCRIPT
2199: * ...
2200: * VALUE CODE FOR LAST SUBSCRIPT
2201: * =O$AMV
2202: * NUMBER OF SUBSCRIPTS
2203: {{EJC{{{{
2204: *
2205: * CODE BLOCK (CONTINUED)
2206: *
2207: * ASSIGNMENT (TO NATURAL VARIABLE)
2208: * VALUE CODE FOR RIGHT OPERAND
2209: * POINTER TO VRSTO FIELD OF VRBLK
2210: *
2211: * (TO ANY OTHER VARIABLE)
2212: * NAME CODE FOR LEFT OPERAND
2213: * VALUE CODE FOR RIGHT OPERAND
2214: * =O$ASS
2215: *
2216: * COMPILE ERROR =O$CER
2217: *
2218: *
2219: * COMPLEMENTATION VALUE CODE FOR OPERAND
2220: * =O$COM
2221: *
2222: * CONCATENATION (CASE OF PRED FUNC LEFT OPERAND)
2223: * VALUE CODE FOR LEFT OPERAND
2224: * =O$POP
2225: * VALUE CODE FOR RIGHT OPERAND
2226: *
2227: * (ALL OTHER CASES)
2228: * VALUE CODE FOR LEFT OPERAND
2229: * VALUE CODE FOR RIGHT OPERAND
2230: * =O$CNC
2231: *
2232: * CURSOR ASSIGNMENT NAME CODE FOR OPERAND
2233: * =O$CAS
2234: *
2235: * DIVISION VALUE CODE FOR LEFT OPERAND
2236: * VALUE CODE FOR RIGHT OPERAND
2237: * =O$DVD
2238: *
2239: * EXPONENTIATION VALUE CODE FOR LEFT OPERAND
2240: * VALUE CODE FOR RIGHT OPERAND
2241: * =O$EXP
2242: *
2243: * FUNCTION CALL (CASE OF CALL TO SYSTEM FUNCTION)
2244: * VALUE CODE FOR FIRST ARGUMENT
2245: * VALUE CODE FOR SECOND ARGUMENT
2246: * ...
2247: * VALUE CODE FOR LAST ARGUMENT
2248: * POINTER TO SVFNC FIELD OF SVBLK
2249: *
2250: {{EJC{{{{
2251: *
2252: * CODE BLOCK (CONTINUED)
2253: *
2254: * FUNCTION CALL (CASE OF NON-SYSTEM FUNCTION 1 ARG)
2255: * VALUE CODE FOR ARGUMENT
2256: * =O$FNS
2257: * POINTER TO VRBLK FOR FUNCTION
2258: *
2259: * (NON-SYSTEM FUNCTION, GT 1 ARG)
2260: * VALUE CODE FOR FIRST ARGUMENT
2261: * VALUE CODE FOR SECOND ARGUMENT
2262: * ...
2263: * VALUE CODE FOR LAST ARGUMENT
2264: * =O$FNC
2265: * NUMBER OF ARGUMENTS
2266: * POINTER TO VRBLK FOR FUNCTION
2267: *
2268: * IMMEDIATE ASSIGNMENT VALUE CODE FOR LEFT OPERAND
2269: * NAME CODE FOR RIGHT OPERAND
2270: * =O$IMA
2271: *
2272: * INDIRECTION VALUE CODE FOR OPERAND
2273: * =O$INV
2274: *
2275: * INTERROGATION VALUE CODE FOR OPERAND
2276: * =O$INT
2277: *
2278: * KEYWORD REFERENCE NAME CODE FOR OPERAND
2279: * =O$KWV
2280: *
2281: * MULTIPLICATION VALUE CODE FOR LEFT OPERAND
2282: * VALUE CODE FOR RIGHT OPERAND
2283: * =O$MLT
2284: *
2285: * NAME REFERENCE (NATURAL VARIABLE CASE)
2286: * POINTER TO NMBLK FOR NAME
2287: *
2288: * (ALL OTHER CASES)
2289: * NAME CODE FOR OPERAND
2290: * =O$NAM
2291: *
2292: * NEGATION =O$NTA
2293: * CDBLK OFFSET OF O$NTC WORD
2294: * VALUE CODE FOR OPERAND
2295: * =O$NTB
2296: * =O$NTC
2297: {{EJC{{{{
2298: *
2299: * CODE BLOCK (CONTINUED)
2300: *
2301: * PATTERN ASSIGNMENT VALUE CODE FOR LEFT OPERAND
2302: * NAME CODE FOR RIGHT OPERAND
2303: * =O$PAS
2304: *
2305: * PATTERN MATCH VALUE CODE FOR LEFT OPERAND
2306: * VALUE CODE FOR RIGHT OPERAND
2307: * =O$PMV
2308: *
2309: * PATTERN REPLACEMENT NAME CODE FOR SUBJECT
2310: * VALUE CODE FOR PATTERN
2311: * =O$PMN
2312: * VALUE CODE FOR REPLACEMENT
2313: * =O$RPL
2314: *
2315: * SELECTION (FOR FIRST ALTERNATIVE)
2316: * =O$SLA
2317: * CDBLK OFFSET TO NEXT O$SLC WORD
2318: * VALUE CODE FOR FIRST ALTERNATIVE
2319: * =O$SLB
2320: * CDBLK OFFSET PAST ALTERNATIVES
2321: *
2322: * (FOR SUBSEQUENT ALTERNATIVES)
2323: * =O$SLC
2324: * CDBLK OFFSET TO NEXT O$SLC,O$SLD
2325: * VALUE CODE FOR ALTERNATIVE
2326: * =O$SLB
2327: * OFFSET IN CDBLK PAST ALTERNATIVES
2328: *
2329: * (FOR LAST ALTERNATIVE)
2330: * =O$SLD
2331: * VALUE CODE FOR LAST ALTERNATIVE
2332: *
2333: * SUBTRACTION VALUE CODE FOR LEFT OPERAND
2334: * VALUE CODE FOR RIGHT OPERAND
2335: * =O$SUB
2336: {{EJC{{{{
2337: *
2338: * CODE BLOCK (CONTINUED)
2339: *
2340: * GENERATION OF CODE BY NAME FOR EXPRESSION ELEMENTS.
2341: *
2342: * VARIABLE =O$LVN
2343: * POINTER TO VRBLK
2344: *
2345: * EXPRESSION (CASE OF *NATURAL VARIABLE)
2346: * =O$LVN
2347: * POINTER TO VRBLK
2348: *
2349: * (ALL OTHER CASES)
2350: * =O$LEX
2351: * POINTER TO EXBLK
2352: *
2353: *
2354: * ARRAY REFERENCE (CASE OF ONE SUBSCRIPT)
2355: * VALUE CODE FOR ARRAY OPERAND
2356: * VALUE CODE FOR SUBSCRIPT OPERAND
2357: * =O$AON
2358: *
2359: * (CASE OF MORE THAN ONE SUBSCRIPT)
2360: * VALUE CODE FOR ARRAY OPERAND
2361: * VALUE CODE FOR FIRST SUBSCRIPT
2362: * VALUE CODE FOR SECOND SUBSCRIPT
2363: * ...
2364: * VALUE CODE FOR LAST SUBSCRIPT
2365: * =O$AMN
2366: * NUMBER OF SUBSCRIPTS
2367: *
2368: * COMPILE ERROR =O$CER
2369: *
2370: * FUNCTION CALL (SAME CODE AS FOR VALUE CALL)
2371: * =O$FNE
2372: *
2373: * INDIRECTION VALUE CODE FOR OPERAND
2374: * =O$INN
2375: *
2376: * KEYWORD REFERENCE NAME CODE FOR OPERAND
2377: * =O$KWN
2378: *
2379: * ANY OTHER OPERAND IS AN ERROR IN A NAME POSITION
2380: *
2381: * NOTE THAT IN THIS DESCRIPTION, =O$XXX REFERS TO THE
2382: * GENERATION OF A WORD CONTAINING THE ADDRESS OF ANOTHER
2383: * WORD WHICH CONTAINS THE ENTRY POINT ADDRESS O$XXX.
2384: {{EJC{{{{
2385: *
2386: * CODE BLOCK (CONTINUED)
2387: *
2388: * NOW WE CONSIDER THE OVERALL STRUCTURE OF THE CODE BLOCK
2389: * FOR A STATEMENT WITH POSSIBLE GOTO FIELDS.
2390: *
2391: * FIRST COMES THE CODE FOR THE STATEMENT BODY.
2392: * THE STATEMENT BODY IS AN EXPRESSION TO BE EVALUATED
2393: * BY VALUE ALTHOUGH THE VALUE IS NOT ACTUALLY REQUIRED.
2394: * NORMAL VALUE CODE IS GENERATED FOR THE BODY OF THE
2395: * STATEMENT EXCEPT IN THE CASE OF A PATTERN MATCH BY
2396: * VALUE, IN WHICH CASE THE FOLLOWING IS GENERATED.
2397: *
2398: * VALUE CODE FOR LEFT OPERAND
2399: * VALUE CODE FOR RIGHT OPERAND
2400: * =O$PMS
2401: *
2402: * NEXT WE HAVE THE CODE FOR THE SUCCESS GOTO. THERE ARE
2403: * SEVERAL CASES AS FOLLOWS.
2404: *
2405: * 1) NO SUCCESS GOTO PTR TO CDBLK FOR NEXT STATEMENT
2406: *
2407: * 2) SIMPLE LABEL PTR TO VRTRA FIELD OF VRBLK
2408: *
2409: * 3) COMPLEX GOTO (CODE BY NAME FOR GOTO OPERAND)
2410: * =O$GOC
2411: *
2412: * 4) DIRECT GOTO (CODE BY VALUE FOR GOTO OPERAND)
2413: * =O$GOD
2414: *
2415: * FOLLOWING THIS WE GENERATE CODE FOR THE FAILURE GOTO IF
2416: * IT IS DIRECT OR IF IT IS COMPLEX, SIMPLE FAILURE GOTOS
2417: * HAVING BEEN HANDLED BY AN APPROPRIATE SETTING OF THE
2418: * CDFAL FIELD OF THE CDBLK. THE GENERATED CODE IS ONE
2419: * OF THE FOLLOWING.
2420: *
2421: * 1) COMPLEX FGOTO =O$FIF
2422: * =O$GOF
2423: * NAME CODE FOR GOTO OPERAND
2424: * =O$GOC
2425: *
2426: * 2) DIRECT FGOTO =O$FIF
2427: * =O$GOF
2428: * VALUE CODE FOR GOTO OPERAND
2429: * =O$GOD
2430: *
2431: * AN OPTIMIZATION OCCURS IF THE SUCCESS AND FAILURE GOTOS
2432: * ARE IDENTICAL AND EITHER COMPLEX OR DIRECT. IN THIS CASE,
2433: * NO CODE IS GENERATED FOR THE SUCCESS GOTO AND CONTROL
2434: * IS ALLOWED TO FALL INTO THE FAILURE GOTO ON SUCCESS.
2435: {{EJC{{{{
2436: *
2437: * COMPILER BLOCK (CMBLK)
2438: *
2439: * A COMPILER BLOCK (CMBLK) IS BUILT BY EXPAN TO REPRESENT
2440: * ONE NODE OF A TREE STRUCTURED EXPRESSION REPRESENTATION.
2441: *
2442: * +------------------------------------+
2443: * I CMIDN I
2444: * +------------------------------------+
2445: * I CMLEN I
2446: * +------------------------------------+
2447: * I CMTYP I
2448: * +------------------------------------+
2449: * I CMOPN I
2450: * +------------------------------------+
2451: * / CMVLS OR CMROP /
2452: * / /
2453: * / CMLOP /
2454: * / /
2455: * +------------------------------------+
2456: *
2457: {CMIDN{EQU{0{{{POINTER TO DUMMY ROUTINE B$CMT
2458: {CMLEN{EQU{CMIDN+1{{{LENGTH OF CMBLK IN BYTES
2459: {CMTYP{EQU{CMLEN+1{{{TYPE (C$XXX, SEE LIST BELOW)
2460: {CMOPN{EQU{CMTYP+1{{{OPERAND POINTER (SEE BELOW)
2461: {CMVLS{EQU{CMOPN+1{{{OPERAND VALUE POINTERS (SEE BELOW)
2462: {CMROP{EQU{CMVLS{{{RIGHT (ONLY) OPERATOR OPERAND
2463: {CMLOP{EQU{CMVLS+1{{{LEFT OPERATOR OPERAND
2464: {CMSI${EQU{CMVLS{{{NUMBER OF STANDARD FIELDS IN CMBLK
2465: {CMUS${EQU{CMSI$+1{{{SIZE OF UNARY OPERATOR CMBLK
2466: {CMBS${EQU{CMSI$+2{{{SIZE OF BINARY OPERATOR CMBLK
2467: {CMAR1{EQU{CMVLS+1{{{ARRAY SUBSCRIPT POINTERS
2468: *
2469: * THE CMOPN AND CMVLS FIELDS ARE SET AS FOLLOWS
2470: *
2471: * ARRAY REFERENCE CMOPN = PTR TO ARRAY OPERAND
2472: * CMVLS = PTRS TO SUBSCRIPT OPERANDS
2473: *
2474: * FUNCTION CALL CMOPN = PTR TO VRBLK FOR FUNCTION
2475: * CMVLS = PTRS TO ARGUMENT OPERANDS
2476: *
2477: * SELECTION CMOPN = ZERO
2478: * CMVLS = PTRS TO ALTERNATE OPERANDS
2479: *
2480: * UNARY OPERATOR CMOPN = PTR TO OPERATOR DVBLK
2481: * CMROP = PTR TO OPERAND
2482: *
2483: * BINARY OPERATOR CMOPN = PTR TO OPERATOR DVBLK
2484: * CMROP = PTR TO RIGHT OPERAND
2485: * CMLOP = PTR TO LEFT OPERAND
2486: {{EJC{{{{
2487: *
2488: * CMTYP IS SET TO INDICATE THE TYPE OF EXPRESSION ELEMENT
2489: * AS SHOWN BY THE FOLLOWING TABLE OF DEFINITIONS.
2490: *
2491: {C$ARR{EQU{0{{{ARRAY REFERENCE
2492: {C$FNC{EQU{C$ARR+1{{{FUNCTION CALL
2493: {C$DEF{EQU{C$FNC+1{{{DEFERRED EXPRESSION (UNARY *)
2494: {C$IND{EQU{C$DEF+1{{{INDIRECTION (UNARY $)
2495: {C$KEY{EQU{C$IND+1{{{KEYWORD REFERENCE (UNARY AMPERSAND)
2496: {C$UBO{EQU{C$KEY+1{{{UNDEFINED BINARY OPERATOR
2497: {C$UUO{EQU{C$UBO+1{{{UNDEFINED UNARY OPERATOR
2498: {C$UO${EQU{C$UUO+1{{{TEST VALUE (=C$UUO+1=C$UBO+2)
2499: {C$$NM{EQU{C$UUO+1{{{NUMBER OF CODES FOR NAME OPERANDS
2500: *
2501: * THE REMAINING TYPES INDICATE EXPRESSION ELEMENTS WHICH
2502: * CAN ONLY BE EVALUATED BY VALUE (NOT BY NAME).
2503: *
2504: {C$BVL{EQU{C$UUO+1{{{BINARY OP WITH VALUE OPERANDS
2505: {C$UVL{EQU{C$BVL+1{{{UNARY OPERATOR WITH VALUE OPERAND
2506: {C$ALT{EQU{C$UVL+1{{{ALTERNATION (BINARY BAR)
2507: {C$CNC{EQU{C$ALT+1{{{CONCATENATION
2508: {C$CNP{EQU{C$CNC+1{{{CONCATENATION, NOT PATTERN MATCH
2509: {C$UNM{EQU{C$CNP+1{{{UNARY OP WITH NAME OPERAND
2510: {C$BVN{EQU{C$UNM+1{{{BINARY OP (OPERANDS BY VALUE, NAME)
2511: {C$ASS{EQU{C$BVN+1{{{ASSIGNMENT
2512: {C$INT{EQU{C$ASS+1{{{INTERROGATION
2513: {C$NEG{EQU{C$INT+1{{{NEGATION (UNARY NOT)
2514: {C$SEL{EQU{C$NEG+1{{{SELECTION
2515: {C$PMT{EQU{C$SEL+1{{{PATTERN MATCH
2516: *
2517: {C$PR${EQU{C$BVN{{{LAST PREEVALUABLE CODE
2518: {C$$NV{EQU{C$PMT+1{{{NUMBER OF DIFFERENT CMBLK TYPES
2519: {{EJC{{{{
2520: *
2521: * CHARACTER TABLE BLOCK (CTBLK)
2522: *
2523: * A CHARACTER TABLE BLOCK IS USED TO HOLD LOGICAL CHARACTER
2524: * TABLES FOR USE WITH ANY,NOTANY,SPAN,BREAK,BREAKX
2525: * PATTERNS. EACH CHARACTER TABLE CAN BE USED TO STORE
2526: * CFP$N DISTINCT TABLES AS BIT COLUMNS. A BIT COLUMN
2527: * ALLOCATED FOR EACH ARGUMENT OF MORE THAN ONE CHARACTER
2528: * IN LENGTH TO ONE OF THE ABOVE LISTED PATTERN PRIMITIVES.
2529: *
2530: * +------------------------------------+
2531: * I CTTYP I
2532: * +------------------------------------+
2533: * * *
2534: * * *
2535: * * CTCHS *
2536: * * *
2537: * * *
2538: * +------------------------------------+
2539: *
2540: {CTTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$CTT
2541: {CTCHS{EQU{CTTYP+1{{{START OF CHARACTER TABLE WORDS
2542: {CTSI${EQU{CTCHS+CFP$A{{{NUMBER OF WORDS IN CTBLK
2543: *
2544: * CTCHS IS CFP$A WORDS LONG AND CONSISTS OF A ONE WORD
2545: * BIT STRING VALUE FOR EACH POSSIBLE CHARACTER IN THE
2546: * INTERNAL ALPHABET. EACH OF THE CFP$N POSSIBLE BITS IN
2547: * A BITSTRING IS USED TO FORM A COLUMN OF BIT INDICATORS.
2548: * A BIT IS SET ON IF THE CHARACTER IS IN THE TABLE AND OFF
2549: * IF THE CHARACTER IS NOT PRESENT.
2550: {{EJC{{{{
2551: *
2552: * DATATYPE FUNCTION BLOCK (DFBLK)
2553: *
2554: * A DATATYPE FUNCTION IS USED TO CONTROL THE CONSTRUCTION
2555: * OF A PROGRAM DEFINED DATATYPE OBJECT. A CALL TO THE
2556: * SYSTEM FUNCTION DATA BUILDS A DFBLK FOR THE DATATYPE NAME
2557: *
2558: * NOTE THAT THESE BLOCKS ARE BUILT IN STATIC BECAUSE PDBLK
2559: * LENGTH IS GOT FROM DFLEN FIELD. IF DFBLK WAS IN DYNAMIC
2560: * STORE THIS WOULD CAUSE TROUBLE DURING PASS TWO OF GARBAGE
2561: * COLLECTION. SCBLK REFERRED TO BY DFNAM FIELD IS ALSO PUT
2562: * IN STATIC SO THAT THERE ARE NO RELOC. FIELDS. THIS CUTS
2563: * GARBAGE COLLECTION TASK APPRECIABLY FOR PDBLKS WHICH ARE
2564: * LIKELY TO BE PRESENT IN LARGE NUMBERS.
2565: *
2566: * +------------------------------------+
2567: * I FCODE I
2568: * +------------------------------------+
2569: * I FARGS I
2570: * +------------------------------------+
2571: * I DFLEN I
2572: * +------------------------------------+
2573: * I DFPDL I
2574: * +------------------------------------+
2575: * I DFNAM I
2576: * +------------------------------------+
2577: * / /
2578: * / DFFLD /
2579: * / /
2580: * +------------------------------------+
2581: *
2582: {DFLEN{EQU{FARGS+1{{{LENGTH OF DFBLK IN BYTES
2583: {DFPDL{EQU{DFLEN+1{{{LENGTH OF CORRESPONDING PDBLK
2584: {DFNAM{EQU{DFPDL+1{{{POINTER TO SCBLK FOR DATATYPE NAME
2585: {DFFLD{EQU{DFNAM+1{{{START OF VRBLK PTRS FOR FIELD NAMES
2586: {DFFLB{EQU{DFFLD-1{{{OFFSET BEHIND DFFLD FOR FIELD FUNC
2587: {DFSI${EQU{DFFLD{{{NUMBER OF STANDARD FIELDS IN DFBLK
2588: *
2589: * THE FCODE FIELD POINTS TO THE ROUTINE B$DFC
2590: *
2591: * FARGS (THE NUMBER OF ARGUMENTS) IS THE NUMBER OF FIELDS.
2592: {{EJC{{{{
2593: *
2594: * DOPE VECTOR BLOCK (DVBLK)
2595: *
2596: * A DOPE VECTOR IS ASSEMBLED FOR EACH POSSIBLE OPERATOR IN
2597: * THE SNOBOL4 LANGUAGE AS PART OF THE CONSTANT SECTION.
2598: *
2599: * +------------------------------------+
2600: * I DVOPN I
2601: * +------------------------------------+
2602: * I DVTYP I
2603: * +------------------------------------+
2604: * I DVLPR I
2605: * +------------------------------------+
2606: * I DVRPR I
2607: * +------------------------------------+
2608: *
2609: {DVOPN{EQU{0{{{ENTRY ADDRESS (PTR TO O$XXX)
2610: {DVTYP{EQU{DVOPN+1{{{TYPE CODE (C$XXX, SEE CMBLK)
2611: {DVLPR{EQU{DVTYP+1{{{LEFT PRECEDENCE (LLXXX, SEE BELOW)
2612: {DVRPR{EQU{DVLPR+1{{{RIGHT PRECEDENCE (RRXXX, SEE BELOW)
2613: {DVUS${EQU{DVLPR+1{{{SIZE OF UNARY OPERATOR DV
2614: {DVBS${EQU{DVRPR+1{{{SIZE OF BINARY OPERATOR DV
2615: {DVUBS{EQU{DVUS$+DVBS${{{SIZE OF UNOP + BINOP (SEE SCANE)
2616: *
2617: * THE CONTENTS OF THE DVTYP FIELD IS COPIED INTO THE CMTYP
2618: * FIELD OF THE CMBLK FOR THE OPERATOR IF IT IS USED.
2619: *
2620: * THE CMOPN FIELD OF AN OPERATOR CMBLK POINTS TO THE DVBLK
2621: * ITSELF, PROVIDING THE REQUIRED ENTRY ADDRESS POINTER PTR.
2622: *
2623: * FOR NORMALLY UNDEFINED OPERATORS, THE DVOPN (AND CMOPN)
2624: * FIELDS CONTAIN A WORD OFFSET FROM R$UBA OF THE FUNCTION
2625: * BLOCK POINTER FOR THE OPERATOR (INSTEAD OF O$XXX PTR).
2626: * FOR CERTAIN SPECIAL OPERATORS, THE DVOPN FIELD IS NOT
2627: * REQUIRED AT ALL AND IS ASSEMBLED AS ZERO.
2628: *
2629: * THE LEFT PRECEDENCE IS USED IN COMPARING AN OPERATOR TO
2630: * THE LEFT OF SOME OTHER OPERATOR. IT THEREFORE GOVERNS THE
2631: * PRECEDENCE OF THE OPERATOR TOWARDS ITS RIGHT OPERAND.
2632: *
2633: * THE RIGHT PRECEDENCE IS USED IN COMPARING AN OPERATOR TO
2634: * THE RIGHT OF SOME OTHER OPERATOR. IT THEREFORE GOVERNS
2635: * THE PRECEDENCE OF THE OPERATOR TOWARDS ITS LEFT OPERAND.
2636: *
2637: * HIGHER PRECEDENCE VALUES CORRESPOND TO A TIGHTER BINDING
2638: * CAPABILITY. THUS WE HAVE THE LEFT PRECEDENCE LOWER
2639: * (HIGHER) THAN THE RIGHT PRECEDENCE FOR RIGHT (LEFT)
2640: * ASSOCIATIVE BINARY OPERATORS.
2641: *
2642: * THE LEFT PRECEDENCE OF UNARY OPERATORS IS SET TO AN
2643: * ARBITRARY HIGH VALUE. THE RIGHT VALUE IS NOT REQUIRED AND
2644: * CONSEQUENTLY THE DVRPR FIELD IS OMITTED FOR UNARY OPS.
2645: {{EJC{{{{
2646: *
2647: * TABLE OF OPERATOR PRECEDENCE VALUES
2648: *
2649: {RRASS{EQU{10{{{RIGHT EQUAL
2650: {LLASS{EQU{00{{{LEFT EQUAL
2651: {RRPMT{EQU{20{{{RIGHT QUESTION MARK
2652: {LLPMT{EQU{30{{{LEFT QUESTION MARK
2653: {RRAMP{EQU{40{{{RIGHT AMPERSAND
2654: {LLAMP{EQU{50{{{LEFT AMPERSAND
2655: {RRALT{EQU{70{{{RIGHT VERTICAL BAR
2656: {LLALT{EQU{60{{{LEFT VERTICAL BAR
2657: {RRCNC{EQU{90{{{RIGHT BLANK
2658: {LLCNC{EQU{80{{{LEFT BLANK
2659: {RRATS{EQU{110{{{RIGHT AT
2660: {LLATS{EQU{100{{{LEFT AT
2661: {RRPLM{EQU{120{{{RIGHT PLUS, MINUS
2662: {LLPLM{EQU{130{{{LEFT PLUS, MINUS
2663: {RRNUM{EQU{140{{{RIGHT NUMBER
2664: {LLNUM{EQU{150{{{LEFT NUMBER
2665: {RRDVD{EQU{160{{{RIGHT SLASH
2666: {LLDVD{EQU{170{{{LEFT SLASH
2667: {RRMLT{EQU{180{{{RIGHT ASTERISK
2668: {LLMLT{EQU{190{{{LEFT ASTERISK
2669: {RRPCT{EQU{200{{{RIGHT PERCENT
2670: {LLPCT{EQU{210{{{LEFT PERCENT
2671: {RREXP{EQU{230{{{RIGHT EXCLAMATION
2672: {LLEXP{EQU{220{{{LEFT EXCLAMATION
2673: {RRDLD{EQU{240{{{RIGHT DOLLAR, DOT
2674: {LLDLD{EQU{250{{{LEFT DOLLAR, DOT
2675: {RRNOT{EQU{270{{{RIGHT NOT
2676: {LLNOT{EQU{260{{{LEFT NOT
2677: {LLUNO{EQU{999{{{LEFT ALL UNARY OPERATORS
2678: *
2679: * PRECEDENCES ARE THE SAME AS IN BTL SNOBOL4 WITH THE
2680: * FOLLOWING EXCEPTIONS.
2681: *
2682: * 1) BINARY QUESTION MARK IS LOWERED AND MADE LEFT ASSOC-
2683: * IATIVE TO REFLECT ITS NEW USE FOR PATTERN MATCHING.
2684: *
2685: * 2) ALTERNATION AND CONCATENATION ARE MADE RIGHT
2686: * ASSOCIATIVE FOR GREATER EFFICIENCY IN PATTERN
2687: * CONSTRUCTION AND MATCHING RESPECTIVELY. THIS CHANGE
2688: * IS TRANSPARENT TO THE SNOBOL4 PROGRAMMER.
2689: *
2690: * 3) THE EQUAL SIGN HAS BEEN ADDED AS A LOW PRECEDENCE
2691: * OPERATOR WHICH IS RIGHT ASSOCIATIVE TO REFLECT ITS
2692: * MORE GENERAL USAGE IN THIS VERSION OF SNOBOL4.
2693: {{EJC{{{{
2694: *
2695: * EXTERNAL FUNCTION BLOCK (EFBLK)
2696: *
2697: * AN EXTERNAL FUNCTION BLOCK IS USED TO CONTROL THE CALLING
2698: * OF AN EXTERNAL FUNCTION. IT IS BUILT BY A CALL TO LOAD.
2699: *
2700: * +------------------------------------+
2701: * I FCODE I
2702: * +------------------------------------+
2703: * I FARGS I
2704: * +------------------------------------+
2705: * I EFLEN I
2706: * +------------------------------------+
2707: * I EFUSE I
2708: * +------------------------------------+
2709: * I EFCOD I
2710: * +------------------------------------+
2711: * I EFVAR I
2712: * +------------------------------------+
2713: * I EFRSL I
2714: * +------------------------------------+
2715: * / /
2716: * / EFTAR /
2717: * / /
2718: * +------------------------------------+
2719: *
2720: {EFLEN{EQU{FARGS+1{{{LENGTH OF EFBLK IN BYTES
2721: {EFUSE{EQU{EFLEN+1{{{USE COUNT (FOR OPSYN)
2722: {EFCOD{EQU{EFUSE+1{{{PTR TO CODE (FROM SYSLD)
2723: {EFVAR{EQU{EFCOD+1{{{PTR TO ASSOCIATED VRBLK
2724: {EFRSL{EQU{EFVAR+1{{{RESULT TYPE (SEE BELOW)
2725: {EFTAR{EQU{EFRSL+1{{{ARGUMENT TYPES (SEE BELOW)
2726: {EFSI${EQU{EFTAR{{{NUMBER OF STANDARD FIELDS IN EFBLK
2727: *
2728: * THE FCODE FIELD POINTS TO THE ROUTINE B$EFC.
2729: *
2730: * EFUSE IS USED TO KEEP TRACK OF MULTIPLE USE WHEN OPSYN
2731: * IS EMPLOYED. THE FUNCTION IS AUTOMATICALLY UNLOADED
2732: * WHEN THERE ARE NO MORE REFERENCES TO THE FUNCTION.
2733: *
2734: * EFRSL AND EFTAR ARE TYPE CODES AS FOLLOWS.
2735: *
2736: * 0 TYPE IS UNCONVERTED
2737: * 1 TYPE IS STRING
2738: * 2 TYPE IS INTEGER
2739: * 3 TYPE IS REAL
2740: {{EJC{{{{
2741: *
2742: * EXPRESSION VARIABLE BLOCK (EVBLK)
2743: *
2744: * IN THIS VERSION OF SPITBOL, AN EXPRESSION CAN BE USED IN
2745: * ANY POSITION WHICH WOULD NORMALLY EXPECT A NAME (FOR
2746: * EXAMPLE ON THE LEFT SIDE OF EQUALS OR AS THE RIGHT
2747: * ARGUMENT OF BINARY DOT). THIS CORRESPONDS TO THE CREATION
2748: * OF A PSEUDO-VARIABLE WHICH IS REPRESENTED BY A POINTER TO
2749: * AN EXPRESSION VARIABLE BLOCK AS FOLLOWS.
2750: *
2751: * +------------------------------------+
2752: * I EVTYP I
2753: * +------------------------------------+
2754: * I EVEXP I
2755: * +------------------------------------+
2756: * I EVVAR I
2757: * +------------------------------------+
2758: *
2759: {EVTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$EVT
2760: {EVEXP{EQU{EVTYP+1{{{POINTER TO EXBLK FOR EXPRESSION
2761: {EVVAR{EQU{EVEXP+1{{{POINTER TO TRBEV DUMMY TRBLK
2762: {EVSI${EQU{EVVAR+1{{{SIZE OF EVBLK
2763: *
2764: * THE NAME OF AN EXPRESSION VARIABLE IS REPRESENTED BY A
2765: * BASE POINTER TO THE EVBLK AND AN OFFSET OF EVVAR. THIS
2766: * VALUE APPEARS TO BE TRAPPED BY THE DUMMY TRBEV BLOCK.
2767: *
2768: * NOTE THAT THERE IS NO NEED TO ALLOW FOR THE CASE OF AN
2769: * EXPRESSION VARIABLE WHICH REFERENCES AN SEBLK SINCE A
2770: * VARIABLE WHICH IS OF THE FORM *VAR IS EQUIVALENT TO VAR.
2771: {{EJC{{{{
2772: *
2773: * EXPRESSION BLOCK (EXBLK)
2774: *
2775: * AN EXPRESSION BLOCK IS BUILT FOR EACH EXPRESSION
2776: * REFERENCED IN A PROGRAM OR CREATED BY EVAL OR CONVERT
2777: * DURING EXECUTION OF A PROGRAM.
2778: *
2779: * +------------------------------------+
2780: * I EXTYP I
2781: * +------------------------------------+
2782: * I EXSTM I
2783: * +------------------------------------+
2784: * I EXLEN I
2785: * +------------------------------------+
2786: * I EXFLC I
2787: * +------------------------------------+
2788: * / /
2789: * / EXCOD /
2790: * / /
2791: * +------------------------------------+
2792: *
2793: {EXTYP{EQU{0{{{PTR TO ROUTINE B$EXL TO LOAD EXPR
2794: {EXSTM{EQU{CDSTM{{{STORES STMNT NO. DURING EVALUATION
2795: {EXLEN{EQU{EXSTM+1{{{LENGTH OF EXBLK IN BYTES
2796: {EXFLC{EQU{EXLEN+1{{{FAILURE CODE (=O$FEX)
2797: {EXCOD{EQU{EXFLC+1{{{PSEUDO-CODE FOR EXPRESSION
2798: {EXSI${EQU{EXCOD{{{NUMBER OF STANDARD FIELDS IN EXBLK
2799: *
2800: * THERE ARE TWO CASES FOR EXCOD DEPENDING ON WHETHER THE
2801: * EXPRESSION CAN BE EVALUATED BY NAME (SEE DESCRIPTION
2802: * OF CDBLK FOR DETAILS OF CODE FOR EXPRESSIONS).
2803: *
2804: * IF THE EXPRESSION CAN BE EVALUATED BY NAME WE HAVE.
2805: *
2806: * (CODE FOR EXPR BY NAME)
2807: * =O$RNM
2808: *
2809: * IF THE EXPRESSION CAN ONLY BE EVALUATED BY VALUE.
2810: *
2811: * (CODE FOR EXPR BY VALUE)
2812: * =O$RVL
2813: {{EJC{{{{
2814: *
2815: * FIELD FUNCTION BLOCK (FFBLK)
2816: *
2817: * A FIELD FUNCTION BLOCK IS USED TO CONTROL THE SELECTION
2818: * OF A FIELD FROM A PROGRAM DEFINED DATATYPE BLOCK.
2819: * A CALL TO DATA CREATES AN FFBLK FOR EACH FIELD.
2820: *
2821: * +------------------------------------+
2822: * I FCODE I
2823: * +------------------------------------+
2824: * I FARGS I
2825: * +------------------------------------+
2826: * I FFDFP I
2827: * +------------------------------------+
2828: * I FFNXT I
2829: * +------------------------------------+
2830: * I FFOFS I
2831: * +------------------------------------+
2832: *
2833: {FFDFP{EQU{FARGS+1{{{POINTER TO ASSOCIATED DFBLK
2834: {FFNXT{EQU{FFDFP+1{{{PTR TO NEXT FFBLK ON CHAIN OR ZERO
2835: {FFOFS{EQU{FFNXT+1{{{OFFSET (BYTES) TO FIELD IN PDBLK
2836: {FFSI${EQU{FFOFS+1{{{SIZE OF FFBLK IN WORDS
2837: *
2838: * THE FCODE FIELD POINTS TO THE ROUTINE B$FFC.
2839: *
2840: * FARGS ALWAYS CONTAINS ONE.
2841: *
2842: * FFDFP IS USED TO VERIFY THAT THE CORRECT PROGRAM DEFINED
2843: * DATATYPE IS BEING ACCESSED BY THIS CALL.
2844: * FFDFP IS NON-RELOC. BECAUSE DFBLK IS IN STATIC
2845: *
2846: * FFOFS IS USED TO SELECT THE APPROPRIATE FIELD. NOTE THAT
2847: * IT IS AN ACTUAL OFFSET (NOT A FIELD NUMBER)
2848: *
2849: * FFNXT IS USED TO POINT TO THE NEXT FFBLK OF THE SAME NAME
2850: * IN THE CASE WHERE THERE ARE SEVERAL FIELDS OF THE SAME
2851: * NAME FOR DIFFERENT DATATYPES. ZERO MARKS THE END OF CHAIN
2852: {{EJC{{{{
2853: *
2854: * INTEGER CONSTANT BLOCK (ICBLK)
2855: *
2856: * AN ICBLK IS CREATED FOR EVERY INTEGER REFERENCED OR
2857: * CREATED BY A PROGRAM. NOTE HOWEVER THAT CERTAIN INTERNAL
2858: * INTEGER VALUES ARE STORED AS ADDRESSES (E.G. THE LENGTH
2859: * FIELD IN A STRING CONSTANT BLOCK)
2860: *
2861: * +------------------------------------+
2862: * I ICGET I
2863: * +------------------------------------+
2864: * * ICVAL *
2865: * +------------------------------------+
2866: *
2867: {ICGET{EQU{0{{{PTR TO ROUTINE B$ICL TO LOAD INT
2868: {ICVAL{EQU{ICGET+1{{{INTEGER VALUE
2869: {ICSI${EQU{ICVAL+CFP$I{{{SIZE OF ICBLK
2870: *
2871: * THE LENGTH OF THE ICVAL FIELD IS CFP$I.
2872: {{EJC{{{{
2873: *
2874: * KEYWORD VARIABLE BLOCK (KVBLK)
2875: *
2876: * A KVBLK IS USED TO REPRESENT A KEYWORD PSEUDO-VARIABLE.
2877: * A KVBLK IS BUILT FOR EACH KEYWORD REFERENCE (KWNAM).
2878: *
2879: * +------------------------------------+
2880: * I KVTYP I
2881: * +------------------------------------+
2882: * I KVVAR I
2883: * +------------------------------------+
2884: * I KVNUM I
2885: * +------------------------------------+
2886: *
2887: {KVTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$KVT
2888: {KVVAR{EQU{KVTYP+1{{{POINTER TO DUMMY BLOCK TRBKV
2889: {KVNUM{EQU{KVVAR+1{{{KEYWORD NUMBER
2890: {KVSI${EQU{KVNUM+1{{{SIZE OF KVBLK
2891: *
2892: * THE NAME OF A KEYWORD VARIABLE IS REPRESENTED BY A
2893: * BASE POINTER TO THE KVBLK AND AN OFFSET OF KVVAR. THE
2894: * VALUE APPEARS TO BE TRAPPED BY THE POINTER TO TRBKV.
2895: {{EJC{{{{
2896: *
2897: * NAME BLOCK (NMBLK)
2898: *
2899: * A NAME BLOCK IS USED WHEREVER A NAME MUST BE STORED AS
2900: * A VALUE FOLLOWING USE OF THE UNARY DOT OPERATOR.
2901: *
2902: * +------------------------------------+
2903: * I NMTYP I
2904: * +------------------------------------+
2905: * I NMBAS I
2906: * +------------------------------------+
2907: * I NMOFS I
2908: * +------------------------------------+
2909: *
2910: {NMTYP{EQU{0{{{PTR TO ROUTINE B$NML TO LOAD NAME
2911: {NMBAS{EQU{NMTYP+1{{{BASE POINTER FOR VARIABLE
2912: {NMOFS{EQU{NMBAS+1{{{OFFSET FOR VARIABLE
2913: {NMSI${EQU{NMOFS+1{{{SIZE OF NMBLK
2914: *
2915: * THE ACTUAL FIELD REPRESENTING THE CONTENTS OF THE NAME
2916: * IS FOUND NMOFS BYTES PAST THE ADDRESS IN NMBAS.
2917: *
2918: * THE NAME IS SPLIT INTO BASE AND OFFSET FORM TO AVOID
2919: * CREATION OF A POINTER INTO THE MIDDLE OF A BLOCK WHICH
2920: * COULD NOT BE HANDLED PROPERLY BY THE GARBAGE COLLECTOR.
2921: *
2922: * A NAME MAY BE BUILT FOR ANY VARIABLE (SEE SECTION ON
2923: * REPRESENTATIONS OF VARIABLES) THIS INCLUDES THE
2924: * CASES OF PSEUDO-VARIABLES.
2925: {{EJC{{{{
2926: *
2927: * PATTERN BLOCK, NO PARAMETERS (P0BLK)
2928: *
2929: * A P0BLK IS USED TO REPRESENT PATTERN NODES WHICH DO
2930: * NOT REQUIRE THE USE OF ANY PARAMETER VALUES.
2931: *
2932: * +------------------------------------+
2933: * I PCODE I
2934: * +------------------------------------+
2935: * I PTHEN I
2936: * +------------------------------------+
2937: *
2938: {PCODE{EQU{0{{{PTR TO MATCH ROUTINE (P$XXX)
2939: {PTHEN{EQU{PCODE+1{{{POINTER TO SUBSEQUENT NODE
2940: {PASI${EQU{PTHEN+1{{{SIZE OF P0BLK
2941: *
2942: * PTHEN POINTS TO THE PATTERN BLOCK FOR THE SUBSEQUENT
2943: * NODE TO BE MATCHED. THIS IS A POINTER TO THE PATTERN
2944: * BLOCK NDNTH IF THERE IS NO SUBSEQUENT (END OF PATTERN)
2945: *
2946: * PCODE IS A POINTER TO THE MATCH ROUTINE FOR THE NODE.
2947: {{EJC{{{{
2948: *
2949: * PATTERN BLOCK (ONE PARAMETER)
2950: *
2951: * A P1BLK IS USED TO REPRESENT PATTERN NODES WHICH
2952: * REQUIRE ONE PARAMETER VALUE.
2953: *
2954: * +------------------------------------+
2955: * I PCODE I
2956: * +------------------------------------+
2957: * I PTHEN I
2958: * +------------------------------------+
2959: * I PARM1 I
2960: * +------------------------------------+
2961: *
2962: {PARM1{EQU{PTHEN+1{{{FIRST PARAMETER VALUE
2963: {PBSI${EQU{PARM1+1{{{SIZE OF P1BLK IN WORDS
2964: *
2965: * SEE P0BLK FOR DEFINITIONS OF PCODE, PTHEN
2966: *
2967: * PARM1 CONTAINS A PARAMETER VALUE USED IN MATCHING THE
2968: * NODE. FOR EXAMPLE, IN A LEN PATTERN, IT IS THE INTEGER
2969: * ARGUMENT TO LEN. THE DETAILS OF THE USE OF THE PARAMETER
2970: * FIELD ARE INCLUDED IN THE DESCRIPTION OF THE INDIVIDUAL
2971: * MATCH ROUTINES. PARM1 IS ALWAYS AN ADDRESS POINTER WHICH
2972: * IS PROCESSED BY THE GARBAGE COLLECTOR.
2973: {{EJC{{{{
2974: *
2975: * PATTERN BLOCK (TWO PARAMETERS)
2976: *
2977: * A P2BLK IS USED TO REPRESENT PATTERN NODES WHICH
2978: * REQUIRE TWO PARAMETER VALUES.
2979: *
2980: * +------------------------------------+
2981: * I PCODE I
2982: * +------------------------------------+
2983: * I PTHEN I
2984: * +------------------------------------+
2985: * I PARM1 I
2986: * +------------------------------------+
2987: * I PARM2 I
2988: * +------------------------------------+
2989: *
2990: {PARM2{EQU{PARM1+1{{{SECOND PARAMETER VALUE
2991: {PCSI${EQU{PARM2+1{{{SIZE OF P2BLK IN WORDS
2992: *
2993: * SEE P1BLK FOR DEFINITIONS OF PCODE, PTHEN, PARM1
2994: *
2995: * PARM2 IS A PARAMETER WHICH PERFORMS THE SAME SORT OF
2996: * FUNCTION AS PARM1 (SEE DESCRIPTION OF P1BLK).
2997: *
2998: * PARM2 IS A NON-RELOCATABLE FIELD AND IS NOT
2999: * PROCESSED BY THE GARBAGE COLLECTOR. ACCORDINGLY, IT MAY
3000: * NOT CONTAIN A POINTER TO A BLOCK IN DYNAMIC MEMORY.
3001: {{EJC{{{{
3002: *
3003: * PROGRAM-DEFINED DATATYPE BLOCK
3004: *
3005: * A PDBLK REPRESENTS THE DATA ITEM FORMED BY A CALL TO A
3006: * DATATYPE FUNCTION AS DEFINED BY THE SYSTEM FUNCTION DATA.
3007: *
3008: * +------------------------------------+
3009: * I PDTYP I
3010: * +------------------------------------+
3011: * I IDVAL I
3012: * +------------------------------------+
3013: * I PDDFP I
3014: * +------------------------------------+
3015: * / /
3016: * / PDFLD /
3017: * / /
3018: * +------------------------------------+
3019: *
3020: {PDTYP{EQU{0{{{PTR TO DUMMY ROUTINE B$PDT
3021: {PDDFP{EQU{IDVAL+1{{{PTR TO ASSOCIATED DFBLK
3022: {PDFLD{EQU{PDDFP+1{{{START OF FIELD VALUE POINTERS
3023: {PDFOF{EQU{DFFLD-PDFLD{{{DIFFERENCE IN OFFSET TO FIELD PTRS
3024: {PDSI${EQU{PDFLD{{{SIZE OF STANDARD FIELDS IN PDBLK
3025: {PDDFS{EQU{DFSI$-PDSI${{{DIFFERENCE IN DFBLK, PDBLK SIZES
3026: *
3027: * THE PDDFP POINTER MAY BE USED TO DETERMINE THE DATATYPE
3028: * AND THE NAMES OF THE FIELDS IF REQUIRED. THE DFBLK ALSO
3029: * CONTAINS THE LENGTH OF THE PDBLK IN BYTES (FIELD DFPDL).
3030: * PDDFP IS NON-RELOC. BECAUSE DFBLK IS IN STATIC
3031: *
3032: * PDFLD VALUES ARE STORED IN ORDER FROM LEFT TO RIGHT.
3033: * THEY CONTAIN VALUES OR POINTERS TO TRBLK CHAINS.
3034: {{EJC{{{{
3035: *
3036: * PROGRAM DEFINED FUNCTION BLOCK (PFBLK)
3037: *
3038: * A PFBLK IS CREATED FOR EACH CALL TO THE DEFINE FUNCTION
3039: * AND A POINTER TO THE PFBLK PLACED IN THE PROPER VRBLK.
3040: *
3041: * +------------------------------------+
3042: * I FCODE I
3043: * +------------------------------------+
3044: * I FARGS I
3045: * +------------------------------------+
3046: * I PFLEN I
3047: * +------------------------------------+
3048: * I PFVBL I
3049: * +------------------------------------+
3050: * I PFNLO I
3051: * +------------------------------------+
3052: * I PFCOD I
3053: * +------------------------------------+
3054: * I PFCTR I
3055: * +------------------------------------+
3056: * I PFRTR I
3057: * +------------------------------------+
3058: * / /
3059: * / PFARG /
3060: * / /
3061: * +------------------------------------+
3062: *
3063: {PFLEN{EQU{FARGS+1{{{LENGTH OF PFBLK IN BYTES
3064: {PFVBL{EQU{PFLEN+1{{{POINTER TO VRBLK FOR FUNCTION NAME
3065: {PFNLO{EQU{PFVBL+1{{{NUMBER OF LOCALS
3066: {PFCOD{EQU{PFNLO+1{{{PTR TO CDBLK FOR FIRST STATEMENT
3067: {PFCTR{EQU{PFCOD+1{{{TRBLK PTR IF CALL TRACED ELSE 0
3068: {PFRTR{EQU{PFCTR+1{{{TRBLK PTR IF RETURN TRACED ELSE 0
3069: {PFARG{EQU{PFRTR+1{{{VRBLK PTRS FOR ARGUMENTS AND LOCALS
3070: {PFAGB{EQU{PFARG-1{{{OFFSET BEHIND PFARG FOR ARG, LOCAL
3071: {PFSI${EQU{PFARG{{{NUMBER OF STANDARD FIELDS IN PFBLK
3072: *
3073: * THE FCODE FIELD POINTS TO THE ROUTINE B$PFC.
3074: *
3075: * PFARG IS STORED IN THE FOLLOWING ORDER.
3076: *
3077: * ARGUMENTS (LEFT TO RIGHT)
3078: * LOCALS (LEFT TO RIGHT)
3079: {{EJC{{{{
3080: *
3081: * REAL CONSTANT BLOCK (RCBLK)
3082: *
3083: * AN RCBLK IS CREATED FOR EVERY REAL REFERENCED OR
3084: * CREATED BY A PROGRAM.
3085: *
3086: * +------------------------------------+
3087: * I RCGET I
3088: * +------------------------------------+
3089: * * RCVAL *
3090: * +------------------------------------+
3091: *
3092: {RCGET{EQU{0{{{PTR TO ROUTINE B$RCL TO LOAD REAL
3093: {RCVAL{EQU{RCGET+1{{{REAL VALUE
3094: {RCSI${EQU{RCVAL+CFP$R{{{SIZE OF RCBLK
3095: *
3096: * THE LENGTH OF THE RCVAL FIELD IS CFP$R.
3097: {{EJC{{{{
3098: *
3099: * STRING CONSTANT BLOCK (SCBLK)
3100: *
3101: * AN SCBLK IS BUILT FOR EVERY STRING REFERENCED OR CREATED
3102: * BY A PROGRAM.
3103: *
3104: * +------------------------------------+
3105: * I SCGET I
3106: * +------------------------------------+
3107: * I SCLEN I
3108: * +------------------------------------+
3109: * / /
3110: * / SCHAR /
3111: * / /
3112: * +------------------------------------+
3113: *
3114: {SCGET{EQU{0{{{PTR TO ROUTINE B$SCL TO LOAD STRING
3115: {SCLEN{EQU{SCGET+1{{{LENGTH OF STRING IN CHARACTERS
3116: {SCHAR{EQU{SCLEN+1{{{CHARACTERS OF STRING
3117: {SCSI${EQU{SCHAR{{{SIZE OF STANDARD FIELDS IN SCBLK
3118: *
3119: * THE CHARACTERS OF THE STRING ARE STORED LEFT JUSTIFIED.
3120: * THE FINAL WORD IS PADDED ON THE RIGHT WITH ZEROS.
3121: * (I.E. THE CHARACTER WHOSE INTERNAL CODE IS ZERO).
3122: *
3123: * THE VALUE OF SCLEN MAY NOT EXCEED MXLEN. THIS ENSURES
3124: * THAT CHARACTER OFFSETS (E.G. THE PATTERN MATCH CURSOR)
3125: * CAN BE CORRECTLY PROCESSED BY THE GARBAGE COLLECTOR.
3126: *
3127: * NOTE THAT THE OFFSET TO THE CHARACTERS OF THE STRING
3128: * IS GIVEN IN BYTES BY CFP$F AND THAT THIS VALUE IS
3129: * AUTOMATICALLY ALLOWED FOR IN PLC, PSC.
3130: * NOTE THAT FOR A SPITBOL SCBLK, THE VALUE OF CFP$F
3131: * IS GIVEN BY CFP$B*SCHAR.
3132: {{EJC{{{{
3133: *
3134: * SIMPLE EXPRESSION BLOCK (SEBLK)
3135: *
3136: * AN SEBLK IS USED TO REPRESENT AN EXPRESSION OF THE FORM
3137: * *(NATURAL VARIABLE). ALL OTHER EXPRESSIONS ARE EXBLKS.
3138: *
3139: * +------------------------------------+
3140: * I SETYP I
3141: * +------------------------------------+
3142: * I SEVAR I
3143: * +------------------------------------+
3144: *
3145: {SETYP{EQU{0{{{PTR TO ROUTINE B$SEL TO LOAD EXPR
3146: {SEVAR{EQU{SETYP+1{{{PTR TO VRBLK FOR VARIABLE
3147: {SESI${EQU{SEVAR+1{{{LENGTH OF SEBLK IN WORDS
3148: {{EJC{{{{
3149: *
3150: * STANDARD VARIABLE BLOCK (SVBLK)
3151: *
3152: * AN SVBLK IS ASSEMBLED IN THE CONSTANT SECTION FOR EACH
3153: * VARIABLE WHICH SATISFIES ONE OF THE FOLLOWING CONDITIONS.
3154: *
3155: * 1) IT IS THE NAME OF A SYSTEM FUNCTION
3156: * 2) IT HAS AN INITIAL VALUE
3157: * 3) IT HAS A KEYWORD ASSOCIATION
3158: * 4) IT HAS A STANDARD I/O ASSOCIATION
3159: * 6) IT HAS A STANDARD LABEL ASSOCIATION
3160: *
3161: * IF VRBLKS ARE CONSTRUCTED FOR ANY OF THESE VARIABLES,
3162: * THEN THE VRSVP FIELD POINTS TO THE SVBLK (SEE VRBLK)
3163: *
3164: * +------------------------------------+
3165: * I SVBIT I
3166: * +------------------------------------+
3167: * I SVLEN I
3168: * +------------------------------------+
3169: * I SVCHS I
3170: * +------------------------------------+
3171: * I SVKNM I
3172: * +------------------------------------+
3173: * I SVFNC I
3174: * +------------------------------------+
3175: * I SVNAR I
3176: * +------------------------------------+
3177: * I SVLBL I
3178: * +------------------------------------+
3179: * I SVVAL I
3180: * +------------------------------------+
3181: {{EJC{{{{
3182: *
3183: * STANDARD VARIABLE BLOCK (CONTINUED)
3184: *
3185: {SVBIT{EQU{0{{{BIT STRING INDICATING ATTRIBUTES
3186: {SVLEN{EQU{1{{{(=SCLEN) LENGTH OF NAME IN CHARS
3187: {SVCHS{EQU{2{{{(=SCHAR) CHARACTERS OF NAME
3188: {SVSI${EQU{2{{{NUMBER OF STANDARD FIELDS IN SVBLK
3189: {SVPRE{EQU{1{{{SET IF PREEVALUATION PERMITTED
3190: {SVFFC{EQU{SVPRE+SVPRE{{{SET ON IF FAST CALL PERMITTED
3191: {SVCKW{EQU{SVFFC+SVFFC{{{SET ON IF KEYWORD VALUE CONSTANT
3192: {SVPRD{EQU{SVCKW+SVCKW{{{SET ON IF PREDICATE FUNCTION
3193: {SVNBT{EQU{4{{{NUMBER OF BITS TO RIGHT OF SVKNM
3194: {SVKNM{EQU{SVPRD+SVPRD{{{SET ON IF KEYWORD ASSOCIATION
3195: {SVFNC{EQU{SVKNM+SVKNM{{{SET ON IF SYSTEM FUNCTION
3196: {SVNAR{EQU{SVFNC+SVFNC{{{SET ON IF SYSTEM FUNCTION
3197: {SVLBL{EQU{SVNAR+SVNAR{{{SET ON IF SYSTEM LABEL
3198: {SVVAL{EQU{SVLBL+SVLBL{{{SET ON IF PREDEFINED VALUE
3199: *
3200: * NOTE THAT THE LAST FIVE BITS CORRESPOND IN ORDER
3201: * TO THE FIELDS WHICH ARE PRESENT (SEE PROCEDURE GTNVR).
3202: *
3203: * THE FOLLOWING DEFINITIONS ARE USED IN THE SVBLK TABLE
3204: *
3205: {SVFNF{EQU{SVFNC+SVNAR{{{FUNCTION WITH NO FAST CALL
3206: {SVFNN{EQU{SVFNF+SVFFC{{{FUNCTION WITH FAST CALL, NO PREEVAL
3207: {SVFNP{EQU{SVFNN+SVPRE{{{FUNCTION ALLOWING PREEVALUATION
3208: {SVFPR{EQU{SVFNN+SVPRD{{{PREDICATE FUNCTION
3209: {SVFNK{EQU{SVFNN+SVKNM{{{NO PREEVAL FUNC + KEYWORD
3210: {SVKWV{EQU{SVKNM+SVVAL{{{KEYWORD + VALUE
3211: {SVKWC{EQU{SVCKW+SVKNM{{{KEYWORD WITH CONSTANT VALUE
3212: {SVKVC{EQU{SVKWV+SVCKW{{{CONSTANT KEYWORD + VALUE
3213: {SVKVL{EQU{SVKVC+SVLBL{{{CONSTANT KEYWORD + VALUE + LABEL
3214: {SVFPK{EQU{SVFNP+SVKVC{{{PREEVAL FCN + CONST KEYWD + VAL
3215: *
3216: * THE SVPRE BIT ALLOWS THE COMPILER TO PREEVALUATE A CALL
3217: * TO THE ASSOCIATED SYSTEM FUNCTION IF ALL THE ARGUMENTS
3218: * ARE THEMSELVES CONSTANTS. FUNCTIONS IN THIS CATEGORY
3219: * MUST HAVE NO SIDE EFFECTS AND MUST NEVER CAUSE FAILURE.
3220: * THE CALL MAY GENERATE AN ERROR CONDITION.
3221: *
3222: * THE SVFFC BIT ALLOWS THE COMPILER TO GENERATE THE SPECIAL
3223: * FAST CALL AFTER ADJUSTING THE NUMBER OF ARGUMENTS. ONLY
3224: * THE ITEM AND APPLY FUNCTIONS FALL OUTSIDE THIS CATEGORY.
3225: *
3226: * THE SVCKW BIT IS SET IF THE ASSOCIATED KEYWORD VALUE IS
3227: * A CONSTANT, THUS ALLOWING PREEVALUATION FOR A VALUE CALL.
3228: *
3229: * THE SVPRD BIT IS SET ON FOR ALL PREDICATE FUNCTIONS TO
3230: * ENABLE THE SPECIAL CONCATENATION CODE OPTIMIZATION.
3231: {{EJC{{{{
3232: *
3233: * SVBLK (CONTINUED)
3234: *
3235: * SVKNM KEYWORD NUMBER
3236: *
3237: * SVKNM IS PRESENT ONLY FOR A STANDARD KEYWORD ASSOC.
3238: * IT CONTAINS A KEYWORD NUMBER AS DEFINED BY THE
3239: * KEYWORD NUMBER TABLE GIVEN LATER ON.
3240: *
3241: * SVFNC SYSTEM FUNCTION POINTER
3242: *
3243: * SVFNC IS PRESENT ONLY FOR A SYSTEM FUNCTION ASSOC.
3244: * IT IS A POINTER TO THE ACTUAL CODE FOR THE SYSTEM
3245: * FUNCTION. THE GENERATED CODE FOR A FAST CALL IS A
3246: * POINTER TO THE SVFNC FIELD OF THE SVBLK FOR THE
3247: * FUNCTION. THE VRFNC FIELD OF THE VRBLK POINTS TO
3248: * THIS SAME FIELD, IN WHICH CASE, IT SERVES AS THE
3249: * FCODE FIELD FOR THE FUNCTION CALL.
3250: *
3251: * SVNAR NUMBER OF FUNCTION ARGUMENTS
3252: *
3253: * SVNAR IS PRESENT ONLY FOR A SYSTEM FUNCTION ASSOC.
3254: * IT IS THE NUMBER OF ARGUMENTS REQUIRED FOR A CALL
3255: * TO THE SYSTEM FUNCTION. THE COMPILER USES THIS
3256: * VALUE TO ADJUST THE NUMBER OF ARGUMENTS IN A FAST
3257: * CALL AND IN THE CASE OF A FUNCTION CALLED THROUGH
3258: * THE VRFNC FIELD OF THE VRBLK, THE SVNAR FIELD
3259: * SERVES AS THE FARGS FIELD FOR O$FNC. A SPECIAL
3260: * CASE OCCURS IF THIS VALUE IS SET TO 999. THIS IS
3261: * USED TO INDICATE THAT THE FUNCTION HAS A VARIABLE
3262: * NUMBER OF ARGUMENTS AND CAUSES O$FNC TO PASS CONTROL
3263: * WITHOUT ADJUSTING THE ARGUMENT COUNT. THE ONLY
3264: * PREDEFINED FUNCTIONS USING THIS ARE APPLY AND ITEM.
3265: *
3266: * SVLBL SYSTEM LABEL POINTER
3267: *
3268: * SVLBL IS PRESENT ONLY FOR A STANDARD LABEL ASSOC.
3269: * IT IS A POINTER TO A SYSTEM LABEL ROUTINE (L$XXX).
3270: * THE VRLBL FIELD OF THE CORRESPONDING VRBLK POINTS TO
3271: * THE SVLBL FIELD OF THE SVBLK.
3272: *
3273: * SVVAL SYSTEM VALUE POINTER
3274: *
3275: * SVVAL IS PRESENT ONLY FOR A STANDARD VALUE.
3276: * IT IS A POINTER TO THE PATTERN NODE (NDXXX) WHICH
3277: * IS THE STANDARD INITIAL VALUE OF THE VARIABLE.
3278: * THIS VALUE IS COPIED TO THE VRVAL FIELD OF THE VRBLK
3279: {{EJC{{{{
3280: *
3281: * SVBLK (CONTINUED)
3282: *
3283: * KEYWORD NUMBER TABLE
3284: *
3285: * THE FOLLOWING TABLE GIVES SYMBOLIC NAMES FOR KEYWORD
3286: * NUMBERS. THESE VALUES ARE STORED IN THE SVKNM FIELD OF
3287: * SVBLKS AND IN THE KVNUM FIELD OF KVBLKS. SEE ALSO
3288: * PROCEDURES ASIGN, ACESS AND KWNAM.
3289: *
3290: * UNPROTECTED KEYWORDS WITH ONE WORD INTEGER VALUES
3291: *
3292: {K$ABE{EQU{0{{{ABEND
3293: {K$ANC{EQU{K$ABE+CFP$B{{{ANCHOR
3294: {K$CAS{EQU{K$ANC+CFP$B{{{CASE
3295: {K$COD{EQU{K$CAS+CFP$B{{{CODE
3296: {K$DMP{EQU{K$COD+CFP$B{{{DUMP
3297: {K$ERL{EQU{K$DMP+CFP$B{{{ERRLIMIT
3298: {K$ERT{EQU{K$ERL+CFP$B{{{ERRTYPE
3299: {K$FTR{EQU{K$ERT+CFP$B{{{FTRACE
3300: {K$INP{EQU{K$FTR+CFP$B{{{INPUT
3301: {K$MXL{EQU{K$INP+CFP$B{{{MAXLENGTH
3302: {K$OUP{EQU{K$MXL+CFP$B{{{OUTPUT
3303: {K$PFL{EQU{K$OUP+CFP$B{{{PROFILE
3304: {K$TRA{EQU{K$PFL+CFP$B{{{TRACE
3305: {K$TRM{EQU{K$TRA+CFP$B{{{TRIM
3306: *
3307: * PROTECTED KEYWORDS WITH ONE WORD INTEGER VALUES
3308: *
3309: {K$FNC{EQU{K$TRM+CFP$B{{{FNCLEVEL
3310: {K$LST{EQU{K$FNC+CFP$B{{{LASTNO
3311: {K$STN{EQU{K$LST+CFP$B{{{STNO
3312: *
3313: * KEYWORDS WITH CONSTANT PATTERN VALUES
3314: *
3315: {K$ABO{EQU{K$STN+CFP$B{{{ABORT
3316: {K$ARB{EQU{K$ABO+PASI${{{ARB
3317: {K$BAL{EQU{K$ARB+PASI${{{BAL
3318: {K$FAL{EQU{K$BAL+PASI${{{FAIL
3319: {K$FEN{EQU{K$FAL+PASI${{{FENCE
3320: {K$REM{EQU{K$FEN+PASI${{{REM
3321: {K$SUC{EQU{K$REM+PASI${{{SUCCEED
3322: {{EJC{{{{
3323: *
3324: * KEYWORD NUMBER TABLE (CONTINUED)
3325: *
3326: * SPECIAL KEYWORDS
3327: *
3328: {K$ALP{EQU{K$SUC+1{{{ALPHABET
3329: {K$RTN{EQU{K$ALP+1{{{RTNTYPE
3330: {K$STC{EQU{K$RTN+1{{{STCOUNT
3331: {K$ETX{EQU{K$STC+1{{{ERRTEXT
3332: {K$STL{EQU{K$ETX+1{{{STLIMIT
3333: *
3334: * RELATIVE OFFSETS OF SPECIAL KEYWORDS
3335: *
3336: {K$$AL{EQU{K$ALP-K$ALP{{{ALPHABET
3337: {K$$RT{EQU{K$RTN-K$ALP{{{RTNTYPE
3338: {K$$SC{EQU{K$STC-K$ALP{{{STCOUNT
3339: {K$$ET{EQU{K$ETX-K$ALP{{{ERRTEXT
3340: {K$$SL{EQU{K$STL-K$ALP{{{STLIMIT
3341: *
3342: * SYMBOLS USED IN ASIGN AND ACESS PROCEDURES
3343: *
3344: {K$P$${EQU{K$FNC{{{FIRST PROTECTED KEYWORD
3345: {K$V$${EQU{K$ABO{{{FIRST KEYWORD WITH CONSTANT VALUE
3346: {K$S$${EQU{K$ALP{{{FIRST KEYWORD WITH SPECIAL ACESS
3347: {{EJC{{{{
3348: *
3349: * FORMAT OF A TABLE BLOCK (TBBLK)
3350: *
3351: * A TABLE BLOCK IS USED TO REPRESENT A TABLE VALUE.
3352: * IT IS BUILT BY A CALL TO THE TABLE OR CONVERT FUNCTIONS.
3353: *
3354: * +------------------------------------+
3355: * I TBTYP I
3356: * +------------------------------------+
3357: * I IDVAL I
3358: * +------------------------------------+
3359: * I TBLEN I
3360: * +------------------------------------+
3361: * +------------------------------------+
3362: * I TBINV I
3363: * +------------------------------------+
3364: * / /
3365: * / TBBUK /
3366: * / /
3367: * +------------------------------------+
3368: *
3369: {TBTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$TBT
3370: {TBLEN{EQU{OFFS2{{{LENGTH OF TBBLK IN BYTES
3371: {TBINV{EQU{OFFS3{{{DEFAULT INITIAL LOOKUP VALUE
3372: {TBBUK{EQU{TBINV+1{{{START OF HASH BUCKET POINTERS
3373: {TBSI${EQU{TBBUK{{{SIZE OF STANDARD FIELDS IN TBBLK
3374: {TBNBK{EQU{11{{{DEFAULT NO. OF BUCKETS
3375: *
3376: * THE TABLE BLOCK IS A HASH TABLE WHICH POINTS TO CHAINS
3377: * OF TABLE ELEMENT BLOCKS REPRESENTING THE ELEMENTS
3378: * IN THE TABLE WHICH HASH INTO THE SAME BUCKET.
3379: *
3380: * TBBUK ENTRIES EITHER POINT TO THE FIRST TEBLK ON THE
3381: * CHAIN OR THEY POINT TO THE TBBLK ITSELF TO INDICATE THE
3382: * END OF THE CHAIN.
3383: {{EJC{{{{
3384: *
3385: * TABLE ELEMENT BLOCK (TEBLK)
3386: *
3387: * A TABLE ELEMENT IS USED TO REPRESENT A SINGLE ENTRY IN
3388: * A TABLE (SEE DESCRIPTION OF TBBLK FORMAT FOR HASH TABLE)
3389: *
3390: * +------------------------------------+
3391: * I TETYP I
3392: * +------------------------------------+
3393: * I TESUB I
3394: * +------------------------------------+
3395: * I TEVAL I
3396: * +------------------------------------+
3397: * I TENXT I
3398: * +------------------------------------+
3399: *
3400: {TETYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$TET
3401: {TESUB{EQU{TETYP+1{{{SUBSCRIPT VALUE
3402: {TEVAL{EQU{TESUB+1{{{(=VRVAL) TABLE ELEMENT VALUE
3403: {TENXT{EQU{TEVAL+1{{{LINK TO NEXT TEBLK
3404: * SEE S$CNV WHERE RELATION IS ASSUMED WITH TENXT AND TBBUK
3405: {TESI${EQU{TENXT+1{{{SIZE OF TEBLK IN WORDS
3406: *
3407: * TENXT POINTS TO THE NEXT TEBLK ON THE HASH CHAIN FROM THE
3408: * TBBUK CHAIN FOR THIS HASH INDEX. AT THE END OF THE CHAIN,
3409: * TENXT POINTS BACK TO THE START OF THE TBBLK.
3410: *
3411: * TEVAL CONTAINS A DATA POINTER OR A TRBLK POINTER.
3412: *
3413: * TESUB CONTAINS A DATA POINTER.
3414: {{EJC{{{{
3415: *
3416: * TRAP BLOCK (TRBLK)
3417: *
3418: * A TRAP BLOCK IS USED TO REPRESENT A TRACE OR INPUT OR
3419: * OUTPUT ASSOCIATION IN RESPONSE TO A CALL TO THE TRACE
3420: * INPUT OR OUTPUT SYSTEM FUNCTIONS. SEE BELOW FOR DETAILS
3421: *
3422: * +------------------------------------+
3423: * I TRIDN I
3424: * +------------------------------------+
3425: * I TRTYP I
3426: * +------------------------------------+
3427: * I TRVAL OR TRLBL OR TRNXT OR TRKVR I
3428: * +------------------------------------+
3429: * I TRTAG OR TRTER OR TRTRF I
3430: * +------------------------------------+
3431: * I TRFNC OR TRFPT I
3432: * +------------------------------------+
3433: *
3434: {TRIDN{EQU{0{{{POINTER TO DUMMY ROUTINE B$TRT
3435: {TRTYP{EQU{TRIDN+1{{{TRAP TYPE CODE
3436: {TRVAL{EQU{TRTYP+1{{{VALUE OF TRAPPED VARIABLE (=VRVAL)
3437: {TRNXT{EQU{TRVAL{{{PTR TO NEXT TRBLK ON TRBLK CHAIN
3438: {TRLBL{EQU{TRVAL{{{PTR TO ACTUAL LABEL (TRACED LABEL)
3439: {TRKVR{EQU{TRVAL{{{VRBLK POINTER FOR KEYWORD TRACE
3440: {TRTAG{EQU{TRVAL+1{{{TRACE TAG
3441: {TRTER{EQU{TRTAG{{{PTR TO TERMINAL VRBLK OR NULL
3442: {TRTRF{EQU{TRTAG{{{PTR TO TRBLK HOLDING FCBLK PTR
3443: {TRFNC{EQU{TRTAG+1{{{TRACE FUNCTION VRBLK (ZERO IF NONE)
3444: {TRFPT{EQU{TRFNC{{{FCBLK PTR FOR SYSIO
3445: {TRSI${EQU{TRFNC+1{{{NUMBER OF WORDS IN TRBLK
3446: *
3447: {TRTIN{EQU{0{{{TRACE TYPE FOR INPUT ASSOCIATION
3448: {TRTAC{EQU{TRTIN+1{{{TRACE TYPE FOR ACCESS TRACE
3449: {TRTVL{EQU{TRTAC+1{{{TRACE TYPE FOR VALUE TRACE
3450: {TRTOU{EQU{TRTVL+1{{{TRACE TYPE FOR OUTPUT ASSOCIATION
3451: {TRTFC{EQU{TRTOU+1{{{TRACE TYPE FOR FCBLK IDENTIFICATION
3452: {{EJC{{{{
3453: *
3454: * TRAP BLOCK (CONTINUED)
3455: *
3456: * VARIABLE INPUT ASSOCIATION
3457: *
3458: * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
3459: * INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE
3460: * OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS
3461: * CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK.
3462: *
3463: * TRTYP IS SET TO TRTIN
3464: * TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL
3465: * TRTER IS A POINTER TO SVBLK IF ASSOCIATION IS
3466: * FOR INPUT, TERMINAL, ELSE IT IS NULL.
3467: * TRTRF POINTS TO THE TRAP BLOCK WHICH IN TURN POINTS
3468: * TO AN FCBLK USED FOR I/O ASSOCIATION.
3469: * TRFPT IS THE FCBLK PTR RETURNED BY SYSIO.
3470: *
3471: * VARIABLE ACCESS TRACE ASSOCIATION
3472: *
3473: * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
3474: * INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE
3475: * OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS
3476: * CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK.
3477: *
3478: * TRTYP IS SET TO TRTAC
3479: * TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL
3480: * TRTAG IS THE TRACE TAG (0 IF NONE)
3481: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
3482: *
3483: * VARIABLE VALUE TRACE ASSOCIATION
3484: *
3485: * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
3486: * INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE
3487: * OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS
3488: * CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK.
3489: *
3490: * TRTYP IS SET TO TRTVL
3491: * TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL
3492: * TRTAG IS THE TRACE TAG (0 IF NONE)
3493: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
3494: {{EJC{{{{
3495: * TRAP BLOCK (CONTINUED)
3496: *
3497: * VARIABLE OUTPUT ASSOCIATION
3498: *
3499: * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
3500: * INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE
3501: * OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS
3502: * CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK.
3503: *
3504: * TRTYP IS SET TO TRTOU
3505: * TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL
3506: * TRTER IS A POINTER TO SVBLK IF ASSOCIATION IS
3507: * FOR OUTPUT, TERMINAL, ELSE IT IS NULL.
3508: * TRTRF POINTS TO THE TRAP BLOCK WHICH IN TURN POINTS
3509: * TO AN FCBLK USED FOR I/O ASSOCIATION.
3510: * TRFPT IS THE FCBLK PTR RETURNED BY SYSIO.
3511: *
3512: * FUNCTION CALL TRACE
3513: *
3514: * THE PFCTR FIELD OF THE CORRESPONDING PFBLK IS SET
3515: * TO POINT TO A TRBLK.
3516: *
3517: * TRTYP IS SET TO TRTIN
3518: * TRNXT IS ZERO
3519: * TRTAG IS THE TRACE TAG (0 IF NONE)
3520: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
3521: *
3522: * FUNCTION RETURN TRACE
3523: *
3524: * THE PFRTR FIELD OF THE CORRESPONDING PFBLK IS SET
3525: * TO POINT TO A TRBLK
3526: *
3527: * TRTYP IS SET TO TRTIN
3528: * TRNXT IS ZERO
3529: * TRTAG IS THE TRACE TAG (0 IF NONE)
3530: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
3531: *
3532: * LABEL TRACE
3533: *
3534: * THE VRLBL OF THE VRBLK FOR THE LABEL IS
3535: * CHANGED TO POINT TO A TRBLK AND THE VRTRA FIELD IS
3536: * SET TO B$VRT TO ACTIVATE THE CHECK.
3537: *
3538: * TRTYP IS SET TO TRTIN
3539: * TRLBL POINTS TO THE ACTUAL LABEL (CDBLK) VALUE
3540: * TRTAG IS THE TRACE TAG (0 IF NONE)
3541: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
3542: {{EJC{{{{
3543: *
3544: * TRAP BLOCK (CONTINUED)
3545: *
3546: * KEYWORD TRACE
3547: *
3548: * KEYWORDS WHICH CAN BE TRACED POSSESS A UNIQUE
3549: * LOCATION WHICH IS ZERO IF THERE IS NO TRACE AND
3550: * POINTS TO A TRBLK IF THERE IS A TRACE. THE LOCATIONS
3551: * ARE AS FOLLOWS.
3552: *
3553: * R$ERT ERRTYPE
3554: * R$FNC FNCLEVEL
3555: * R$STC STCOUNT
3556: *
3557: * THE FORMAT OF THE TRBLK IS AS FOLLOWS.
3558: *
3559: * TRTYP IS SET TO TRTIN
3560: * TRKVR IS A POINTER TO THE VRBLK FOR THE KEYWORD
3561: * TRTAG IS THE TRACE TAG (0 IF NONE)
3562: * TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
3563: *
3564: * INPUT/OUTPUT FILE ARG1 TRAP BLOCK
3565: *
3566: * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
3567: * INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE OF
3568: * A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS
3569: * CONTAIN =B$VRA AND =B$VRV. THIS TRAP BLOCK IS USED
3570: * TO HOLD A POINTER TO THE FCBLK WHICH AN
3571: * IMPLEMENTATION MAY REQUEST TO HOLD INFORMATION
3572: * ABOUT A FILE.
3573: *
3574: * TRTYP IS SET TO TRTFC
3575: * TRNEXT POINTS TO NEXT TRBLK OR TRVAL IS VARIABLE VAL
3576: * TRFNM IS 0
3577: * TRFPT IS THE FCBLK POINTER.
3578: *
3579: * NOTE THAT WHEN MULTIPLE TRAPS ARE SET ON A VARIABLE
3580: * THE ORDER IS IN ASCENDING VALUE OF TRTYP FIELD.
3581: *
3582: * INPUT ASSOCIATION (IF PRESENT)
3583: * ACCESS TRACE (IF PRESENT)
3584: * VALUE TRACE (IF PRESENT)
3585: * OUTPUT ASSOCIATION (IF PRESENT)
3586: *
3587: * THE ACTUAL VALUE OF THE VARIABLE IS STORED IN THE TRVAL
3588: * FIELD OF THE LAST TRBLK ON THE CHAIN.
3589: *
3590: * THIS IMPLEMENTATION DOES NOT PERMIT TRACE OR I/O
3591: * ASSOCIATIONS TO ANY OF THE PSEUDO-VARIABLES.
3592: {{EJC{{{{
3593: *
3594: * VECTOR BLOCK (VCBLK)
3595: *
3596: * A VCBLK IS USED TO REPRESENT AN ARRAY VALUE WHICH HAS
3597: * ONE DIMENSION WHOSE LOWER BOUND IS ONE. ALL OTHER ARRAYS
3598: * ARE REPRESENTED BY ARBLKS. A VCBLK IS CREATED BY THE
3599: * SYSTEM FUNCTION ARRAY (S$ARR) WHEN PASSED AN INTEGER ARG.
3600: *
3601: * +------------------------------------+
3602: * I VCTYP I
3603: * +------------------------------------+
3604: * I IDVAL I
3605: * +------------------------------------+
3606: * I VCLEN I
3607: * +------------------------------------+
3608: * I VCVLS I
3609: * +------------------------------------+
3610: *
3611: {VCTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$VCT
3612: {VCLEN{EQU{OFFS2{{{LENGTH OF VCBLK IN BYTES
3613: {VCVLS{EQU{OFFS3{{{START OF VECTOR VALUES
3614: {VCSI${EQU{VCVLS{{{SIZE OF STANDARD FIELDS IN VCBLK
3615: {VCVLB{EQU{VCVLS-1{{{OFFSET ONE WORD BEHIND VCVLS
3616: {VCTBD{EQU{TBSI$-VCSI${{{DIFFERENCE IN SIZES - SEE PRTVL
3617: *
3618: * VCVLS ARE EITHER DATA POINTERS OR TRBLK POINTERS
3619: *
3620: * THE DIMENSION CAN BE DEDUCED FROM VCLEN.
3621: {{EJC{{{{
3622: *
3623: * VARIABLE BLOCK (VRBLK)
3624: *
3625: * A VARIABLE BLOCK IS BUILT IN THE STATIC MEMORY AREA
3626: * FOR EVERY VARIABLE REFERENCED OR CREATED BY A PROGRAM.
3627: *
3628: * NOTE THAT SINCE THESE BLOCKS ONLY OCCUR IN THE STATIC
3629: * REGION, IT IS PERMISSIBLE TO POINT TO ANY WORD IN
3630: * THE BLOCK AND THIS IS USED TO PROVIDE THREE DISTINCT
3631: * ACCESS POINTS FROM THE GENERATED CODE AS FOLLOWS.
3632: *
3633: * 1) POINT TO VRGET (FIRST WORD OF VRBLK) TO LOAD THE
3634: * VALUE OF THE VARIABLE ONTO THE MAIN STACK.
3635: *
3636: * 2) POINT TO VRSTO (SECOND WORD OF VRBLK) TO STORE THE
3637: * TOP STACK ELEMENT AS THE VALUE OF THE VARIABLE.
3638: *
3639: * 3) POINT TO VRTRA (FOURTH WORD OF VRBLK) TO JUMP TO
3640: * THE LABEL ASSOCIATED WITH THE VARIABLE NAME.
3641: *
3642: * +------------------------------------+
3643: * I VRGET I
3644: * +------------------------------------+
3645: * I VRSTO I
3646: * +------------------------------------+
3647: * I VRVAL I
3648: * +------------------------------------+
3649: * I VRTRA I
3650: * +------------------------------------+
3651: * I VRLBL I
3652: * +------------------------------------+
3653: * I VRFNC I
3654: * +------------------------------------+
3655: * I VRNXT I
3656: * +------------------------------------+
3657: * I VRLEN I
3658: * +------------------------------------+
3659: * / /
3660: * / VRCHS = VRSVP /
3661: * / /
3662: * +------------------------------------+
3663: {{EJC{{{{
3664: *
3665: * VARIABLE BLOCK (CONTINUED)
3666: *
3667: {VRGET{EQU{0{{{POINTER TO ROUTINE TO LOAD VALUE
3668: {VRSTO{EQU{VRGET+1{{{POINTER TO ROUTINE TO STORE VALUE
3669: {VRVAL{EQU{VRSTO+1{{{VARIABLE VALUE
3670: {VRVLO{EQU{VRVAL-VRSTO{{{OFFSET TO VALUE FROM STORE FIELD
3671: {VRTRA{EQU{VRVAL+1{{{POINTER TO ROUTINE TO JUMP TO LABEL
3672: {VRLBL{EQU{VRTRA+1{{{POINTER TO CODE FOR LABEL
3673: {VRLBO{EQU{VRLBL-VRTRA{{{OFFSET TO LABEL FROM TRANSFER FIELD
3674: {VRFNC{EQU{VRLBL+1{{{POINTER TO FUNCTION BLOCK
3675: {VRNXT{EQU{VRFNC+1{{{POINTER TO NEXT VRBLK ON HASH CHAIN
3676: {VRLEN{EQU{VRNXT+1{{{LENGTH OF NAME (OR ZERO)
3677: {VRCHS{EQU{VRLEN+1{{{CHARACTERS OF NAME (VRLEN GT 0)
3678: {VRSVP{EQU{VRLEN+1{{{PTR TO SVBLK (VRLEN EQ 0)
3679: {VRSI${EQU{VRCHS+1{{{NUMBER OF STANDARD FIELDS IN VRBLK
3680: {VRSOF{EQU{VRLEN-SCLEN{{{OFFSET TO DUMMY SCBLK FOR NAME
3681: {VRSVO{EQU{VRSVP-VRSOF{{{PSEUDO-OFFSET TO VRSVP FIELD
3682: *
3683: * VRGET = B$VRL IF NOT INPUT ASSOCIATED OR ACCESS TRACED
3684: * VRGET = B$VRA IF INPUT ASSOCIATED OR ACCESS TRACED
3685: *
3686: * VRSTO = B$VRS IF NOT OUTPUT ASSOCIATED OR VALUE TRACED
3687: * VRSTO = B$VRV IF OUTPUT ASSOCIATED OR VALUE TRACED
3688: * VRSTO = B$VRE IF VALUE IS PROTECTED PATTERN VALUE
3689: *
3690: * VRVAL POINTS TO THE APPROPRIATE VALUE UNLESS THE
3691: * VARIABLE IS I/O/TRACE ASSOCIATED IN WHICH CASE, VRVAL
3692: * POINTS TO AN APPROPRIATE TRBLK (TRAP BLOCK) CHAIN.
3693: *
3694: * VRTRA = B$VRG IF THE LABEL IS NOT TRACED
3695: * VRTRA = B$VRT IF THE LABEL IS TRACED
3696: *
3697: * VRLBL POINTS TO A CDBLK IF THERE IS A LABEL
3698: * VRLBL POINTS TO THE SVBLK SVLBL FIELD FOR A SYSTEM LABEL
3699: * VRLBL POINTS TO STNDL FOR AN UNDEFINED LABEL
3700: * VRLBL POINTS TO A TRBLK IF THE LABEL IS TRACED
3701: *
3702: * VRFNC POINTS TO A FFBLK FOR A FIELD FUNCTION
3703: * VRFNC POINTS TO A DFBLK FOR A DATATYPE FUNCTION
3704: * VRFNC POINTS TO A PFBLK FOR A PROGRAM DEFINED FUNCTION
3705: * VRFNC POINTS TO A EFBLK FOR AN EXTERNAL LOADED FUNCTION
3706: * VRFNC POINTS TO SVFNC (SVBLK) FOR A SYSTEM FUNCTION
3707: * VRFNC POINTS TO STNDF IF THE FUNCTION IS UNDEFINED
3708: *
3709: * VRNXT POINTS TO THE NEXT VRBLK ON THIS CHAIN UNLESS
3710: * THIS IS THE END OF THE CHAIN IN WHICH CASE IT IS ZERO.
3711: *
3712: * VRLEN IS THE NAME LENGTH FOR A NON-SYSTEM VARIABLE.
3713: * VRLEN IS ZERO FOR A SYSTEM VARIABLE.
3714: *
3715: * VRCHS IS THE NAME (LJRZ) IF VRLEN IS NON-ZERO.
3716: * VRSVP IS A PTR TO THE SVBLK IF VRLEN IS ZERO.
3717: {{EJC{{{{
3718: *
3719: * FORMAT OF A NON-RELOCATABLE EXTERNAL BLOCK (XNBLK)
3720: *
3721: * AN XNBLK IS A BLOCK REPRESENTING AN UNKNOWN (EXTERNAL)
3722: * DATA VALUE. THE BLOCK CONTAINS NO POINTERS TO OTHER
3723: * RELOCATABLE BLOCKS. AN XNBLK IS USED BY EXTERNAL FUNCTION
3724: * PROCESSING OR POSSIBLY FOR SYSTEM I/O ROUTINES ETC.
3725: * THE MACRO-SYSTEM ITSELF DOES NOT USE XNBLKS.
3726: * THIS TYPE OF BLOCK MAY BE USED AS A FILE CONTROL BLOCK.
3727: * SEE SYSFC,SYSIN,SYSOU,S$INP,S$OUP FOR DETAILS.
3728: *
3729: * +------------------------------------+
3730: * I XNTYP I
3731: * +------------------------------------+
3732: * I XNLEN I
3733: * +------------------------------------+
3734: * / /
3735: * / XNDTA /
3736: * / /
3737: * +------------------------------------+
3738: *
3739: {XNTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$XNT
3740: {XNLEN{EQU{XNTYP+1{{{LENGTH OF XNBLK IN BYTES
3741: {XNDTA{EQU{XNLEN+1{{{DATA WORDS
3742: {XNSI${EQU{XNDTA{{{SIZE OF STANDARD FIELDS IN XNBLK
3743: *
3744: * NOTE THAT THE TERM NON-RELOCATABLE REFERS TO THE CONTENTS
3745: * AND NOT THE BLOCK ITSELF. AN XNBLK CAN BE MOVED AROUND IF
3746: * IT IS BUILT IN THE DYNAMIC MEMORY AREA.
3747: {{EJC{{{{
3748: *
3749: * RELOCATABLE EXTERNAL BLOCK (XRBLK)
3750: *
3751: * AN XRBLK IS A BLOCK REPRESENTING AN UNKNOWN (EXTERNAL)
3752: * DATA VALUE. THE DATA AREA IN THIS BLOCK CONSISTS ONLY
3753: * OF ADDRESS VALUES AND ANY ADDRESSES POINTING INTO THE
3754: * DYNAMIC MEMORY AREA MUST POINT TO THE START OF OTHER
3755: * DATA BLOCKS. SEE ALSO DESCRIPTION OF XNBLK.
3756: * THIS TYPE OF BLOCK MAY BE USED AS A FILE CONTROL BLOCK.
3757: * SEE SYSFC,SYSIN,SYSOU,S$INP,S$OUP FOR DETAILS.
3758: *
3759: * +------------------------------------+
3760: * I XRTYP I
3761: * +------------------------------------+
3762: * I XRLEN I
3763: * +------------------------------------+
3764: * / /
3765: * / XRPTR /
3766: * / /
3767: * +------------------------------------+
3768: *
3769: {XRTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$XRT
3770: {XRLEN{EQU{XRTYP+1{{{LENGTH OF XRBLK IN BYTES
3771: {XRPTR{EQU{XRLEN+1{{{START OF ADDRESS POINTERS
3772: {XRSI${EQU{XRPTR{{{SIZE OF STANDARD FIELDS IN XRBLK
3773: {{EJC{{{{
3774: *
3775: * S$CNV (CONVERT) FUNCTION SWITCH CONSTANTS. THE VALUES
3776: * ARE TIED TO THE ORDER OF THE ENTRIES IN THE SVCTB TABLE
3777: * AND HENCE TO THE BRANCH TABLE IN S$CNV.
3778: *
3779: {CNVST{EQU{8{{{MAX STANDARD TYPE CODE FOR CONVERT
3780: {CNVRT{EQU{CNVST+1{{{CONVERT CODE FOR REALS
3781: {CNVBT{EQU{CNVRT+1{{{CONVERT CODE FOR BUFFER
3782: {CNVTT{EQU{CNVBT+1{{{BSW CODE FOR CONVERT
3783: *
3784: * INPUT IMAGE LENGTH
3785: *
3786: {INILN{EQU{132{{{DEFAULT IMAGE LENGTH FOR COMPILER
3787: {INILS{EQU{80{{{IMAGE LENGTH IF -SEQU IN EFFECT
3788: *
3789: {IONMB{EQU{2{{{NAME BASE USED FOR IOCHN IN SYSIO
3790: {IONMO{EQU{4{{{NAME OFFSET USED FOR IOCHN IN SYSIO
3791: *
3792: * IN GENERAL, MEANINGFUL MNEMONICS SHOULD BE USED FOR
3793: * OFFSETS. HOWEVER FOR SMALL INTEGERS USED OFTEN IN
3794: * LITERALS THE FOLLOWING GENERAL DEFINITIONS ARE PROVIDED.
3795: *
3796: {NUM01{EQU{1{{{
3797: {NUM02{EQU{2{{{
3798: {NUM03{EQU{3{{{
3799: {NUM04{EQU{4{{{
3800: {NUM05{EQU{5{{{
3801: {NUM06{EQU{6{{{
3802: {NUM07{EQU{7{{{
3803: {NUM08{EQU{8{{{
3804: {NUM09{EQU{9{{{
3805: {NUM10{EQU{10{{{
3806: {NINI8{EQU{998{{{
3807: {NINI9{EQU{999{{{
3808: {THSND{EQU{1000{{{
3809: {{EJC{{{{
3810: *
3811: * NUMBERS OF UNDEFINED SPITBOL OPERATORS
3812: *
3813: {OPBUN{EQU{5{{{NO. OF BINARY UNDEFINED OPS
3814: {OPUUN{EQU{6{{{NO OF UNARY UNDEFINED OPS
3815: *
3816: * OFFSETS USED IN PRTSN, PRTMI AND ACESS
3817: *
3818: {PRSNF{EQU{13{{{OFFSET USED IN PRTSN
3819: {PRTMF{EQU{15{{{OFFSET TO COL 15 (PRTMI)
3820: {RILEN{EQU{120{{{BUFFER LENGTH FOR SYSRI
3821: *
3822: * CODES FOR STAGES OF PROCESSING
3823: *
3824: {STGIC{EQU{0{{{INITIAL COMPILE
3825: {STGXC{EQU{STGIC+1{{{EXECUTION COMPILE (CODE)
3826: {STGEV{EQU{STGXC+1{{{EXPRESSION EVAL DURING EXECUTION
3827: {STGXT{EQU{STGEV+1{{{EXECUTION TIME
3828: {STGCE{EQU{STGXT+1{{{INITIAL COMPILE AFTER END LINE
3829: {STGXE{EQU{STGCE+1{{{EXEC. COMPILE AFTER END LINE
3830: {STGND{EQU{STGCE-STGIC{{{DIFFERENCE IN STAGE AFTER END
3831: {STGEE{EQU{STGXE+1{{{EVAL EVALUATING EXPRESSION
3832: {STGNO{EQU{STGEE+1{{{NUMBER OF CODES
3833: {{EJC{{{{
3834: *
3835: *
3836: * STATEMENT NUMBER PAD COUNT FOR LISTR
3837: *
3838: {STNPD{EQU{8{{{STATEMENT NO. PAD COUNT
3839: *
3840: * SYNTAX TYPE CODES
3841: *
3842: * THESE CODES ARE RETURNED FROM THE SCANE PROCEDURE.
3843: *
3844: * THEY ARE SPACED 3 APART FOR THE BENEFIT OF EXPAN.
3845: *
3846: {T$UOP{EQU{0{{{UNARY OPERATOR
3847: {T$LPR{EQU{T$UOP+3{{{LEFT PAREN
3848: {T$LBR{EQU{T$LPR+3{{{LEFT BRACKET
3849: {T$CMA{EQU{T$LBR+3{{{COMMA
3850: {T$FNC{EQU{T$CMA+3{{{FUNCTION CALL
3851: {T$VAR{EQU{T$FNC+3{{{VARIABLE
3852: {T$CON{EQU{T$VAR+3{{{CONSTANT
3853: {T$BOP{EQU{T$CON+3{{{BINARY OPERATOR
3854: {T$RPR{EQU{T$BOP+3{{{RIGHT PAREN
3855: {T$RBR{EQU{T$RPR+3{{{RIGHT BRACKET
3856: {T$COL{EQU{T$RBR+3{{{COLON
3857: {T$SMC{EQU{T$COL+3{{{SEMI-COLON
3858: *
3859: * THE FOLLOWING DEFINITIONS ARE USED ONLY IN THE GOTO FIELD
3860: *
3861: {T$FGO{EQU{T$SMC+1{{{FAILURE GOTO
3862: {T$SGO{EQU{T$FGO+1{{{SUCCESS GOTO
3863: *
3864: * THE ABOVE CODES ARE GROUPED SO THAT CODES FOR ELEMENTS
3865: * WHICH CAN LEGITIMATELY IMMEDIATELY PRECEDE A UNARY
3866: * OPERATOR COME FIRST TO FACILITATE OPERATOR SYNTAX CHECK.
3867: *
3868: {T$UOK{EQU{T$FNC{{{LAST CODE OK BEFORE UNARY OPERATOR
3869: {{EJC{{{{
3870: *
3871: * DEFINITIONS OF VALUES FOR EXPAN JUMP TABLE
3872: *
3873: {T$UO0{EQU{T$UOP+0{{{UNARY OPERATOR, STATE ZERO
3874: {T$UO1{EQU{T$UOP+1{{{UNARY OPERATOR, STATE ONE
3875: {T$UO2{EQU{T$UOP+2{{{UNARY OPERATOR, STATE TWO
3876: {T$LP0{EQU{T$LPR+0{{{LEFT PAREN, STATE ZERO
3877: {T$LP1{EQU{T$LPR+1{{{LEFT PAREN, STATE ONE
3878: {T$LP2{EQU{T$LPR+2{{{LEFT PAREN, STATE TWO
3879: {T$LB0{EQU{T$LBR+0{{{LEFT BRACKET, STATE ZERO
3880: {T$LB1{EQU{T$LBR+1{{{LEFT BRACKET, STATE ONE
3881: {T$LB2{EQU{T$LBR+2{{{LEFT BRACKET, STATE TWO
3882: {T$CM0{EQU{T$CMA+0{{{COMMA, STATE ZERO
3883: {T$CM1{EQU{T$CMA+1{{{COMMA, STATE ONE
3884: {T$CM2{EQU{T$CMA+2{{{COMMA, STATE TWO
3885: {T$FN0{EQU{T$FNC+0{{{FUNCTION CALL, STATE ZERO
3886: {T$FN1{EQU{T$FNC+1{{{FUNCTION CALL, STATE ONE
3887: {T$FN2{EQU{T$FNC+2{{{FUNCTION CALL, STATE TWO
3888: {T$VA0{EQU{T$VAR+0{{{VARIABLE, STATE ZERO
3889: {T$VA1{EQU{T$VAR+1{{{VARIABLE, STATE ONE
3890: {T$VA2{EQU{T$VAR+2{{{VARIABLE, STATE TWO
3891: {T$CO0{EQU{T$CON+0{{{CONSTANT, STATE ZERO
3892: {T$CO1{EQU{T$CON+1{{{CONSTANT, STATE ONE
3893: {T$CO2{EQU{T$CON+2{{{CONSTANT, STATE TWO
3894: {T$BO0{EQU{T$BOP+0{{{BINARY OPERATOR, STATE ZERO
3895: {T$BO1{EQU{T$BOP+1{{{BINARY OPERATOR, STATE ONE
3896: {T$BO2{EQU{T$BOP+2{{{BINARY OPERATOR, STATE TWO
3897: {T$RP0{EQU{T$RPR+0{{{RIGHT PAREN, STATE ZERO
3898: {T$RP1{EQU{T$RPR+1{{{RIGHT PAREN, STATE ONE
3899: {T$RP2{EQU{T$RPR+2{{{RIGHT PAREN, STATE TWO
3900: {T$RB0{EQU{T$RBR+0{{{RIGHT BRACKET, STATE ZERO
3901: {T$RB1{EQU{T$RBR+1{{{RIGHT BRACKET, STATE ONE
3902: {T$RB2{EQU{T$RBR+2{{{RIGHT BRACKET, STATE TWO
3903: {T$CL0{EQU{T$COL+0{{{COLON, STATE ZERO
3904: {T$CL1{EQU{T$COL+1{{{COLON, STATE ONE
3905: {T$CL2{EQU{T$COL+2{{{COLON, STATE TWO
3906: {T$SM0{EQU{T$SMC+0{{{SEMICOLON, STATE ZERO
3907: {T$SM1{EQU{T$SMC+1{{{SEMICOLON, STATE ONE
3908: {T$SM2{EQU{T$SMC+2{{{SEMICOLON, STATE TWO
3909: *
3910: {T$NES{EQU{T$SM2+1{{{NUMBER OF ENTRIES IN BRANCH TABLE
3911: {{EJC{{{{
3912: *
3913: * DEFINITION OF OFFSETS USED IN CONTROL CARD PROCESSING
3914: *
3915: {CC$CA{EQU{0{{{-CASE
3916: {CC$DO{EQU{CC$CA+1{{{-DOUBLE
3917: {CC$DU{EQU{CC$DO+1{{{-DUMP
3918: {CC$EJ{EQU{CC$DU+1{{{-EJECT
3919: {CC$ER{EQU{CC$EJ+1{{{-ERRORS
3920: {CC$EX{EQU{CC$ER+1{{{-EXECUTE
3921: {CC$FA{EQU{CC$EX+1{{{-FAIL
3922: {CC$LI{EQU{CC$FA+1{{{-LIST
3923: {CC$NR{EQU{CC$LI+1{{{-NOERRORS
3924: {CC$NX{EQU{CC$NR+1{{{-NOEXECUTE
3925: {CC$NF{EQU{CC$NX+1{{{-NOFAIL
3926: {CC$NL{EQU{CC$NF+1{{{-NOLIST
3927: {CC$NO{EQU{CC$NL+1{{{-NOOPT
3928: {CC$NP{EQU{CC$NO+1{{{-NOPRINT
3929: {CC$OP{EQU{CC$NP+1{{{-OPTIMISE
3930: {CC$PR{EQU{CC$OP+1{{{-PRINT
3931: {CC$SI{EQU{CC$PR+1{{{-SINGLE
3932: {CC$SP{EQU{CC$SI+1{{{-SPACE
3933: {CC$ST{EQU{CC$SP+1{{{-STITL
3934: {CC$TI{EQU{CC$ST+1{{{-TITLE
3935: {CC$TR{EQU{CC$TI+1{{{-TRACE
3936: {CC$NC{EQU{CC$TR+1{{{NUMBER OF CONTROL CARDS
3937: {CCNOC{EQU{4{{{NO. OF CHARS INCLUDED IN MATCH
3938: {CCOFS{EQU{7{{{OFFSET TO START OF TITLE/SUBTITLE
3939: {{EJC{{{{
3940: *
3941: * DEFINITIONS OF STACK OFFSETS USED IN CMPIL PROCEDURE
3942: *
3943: * SEE DESCRIPTION AT START OF CMPIL PROCEDURE FOR DETAILS
3944: * OF USE OF THESE LOCATIONS ON THE STACK.
3945: *
3946: {CMSTM{EQU{0{{{TREE FOR STATEMENT BODY
3947: {CMSGO{EQU{CMSTM+1{{{TREE FOR SUCCESS GOTO
3948: {CMFGO{EQU{CMSGO+1{{{TREE FOR FAIL GOTO
3949: {CMCGO{EQU{CMFGO+1{{{CONDITIONAL GOTO FLAG
3950: {CMPCD{EQU{CMCGO+1{{{PREVIOUS CDBLK POINTER
3951: {CMFFP{EQU{CMPCD+1{{{FAILURE FILL IN FLAG FOR PREVIOUS
3952: {CMFFC{EQU{CMFFP+1{{{FAILURE FILL IN FLAG FOR CURRENT
3953: {CMSOP{EQU{CMFFC+1{{{SUCCESS FILL IN OFFSET FOR PREVIOUS
3954: {CMSOC{EQU{CMSOP+1{{{SUCCESS FILL IN OFFSET FOR CURRENT
3955: {CMLBL{EQU{CMSOC+1{{{PTR TO VRBLK FOR CURRENT LABEL
3956: {CMTRA{EQU{CMLBL+1{{{PTR TO ENTRY CDBLK
3957: *
3958: {CMNEN{EQU{CMTRA+1{{{COUNT OF STACK ENTRIES FOR CMPIL
3959: *
3960: * A FEW CONSTANTS USED BY THE PROFILER
3961: {PFPD1{EQU{8{{{PAD POSITIONS ...
3962: {PFPD2{EQU{20{{{... FOR PROFILE ...
3963: {PFPD3{EQU{32{{{... PRINTOUT
3964: {PF$I2{EQU{CFP$I+CFP$I{{{SIZE OF TABLE ENTRY (2 INTS)
3965: *
3966: {{TTL{S{{{P I T B O L -- CONSTANT SECTION
3967: *
3968: * THIS SECTION CONSISTS ENTIRELY OF ASSEMBLED CONSTANTS.
3969: *
3970: * ALL LABEL NAMES ARE FIVE LETTERS. THE ORDER IS
3971: * APPROXIMATELY ALPHABETICAL, BUT IN SOME CASES (ALWAYS
3972: * DOCUMENTED), CONSTANTS MUST BE PLACED IN SOME SPECIAL
3973: * ORDER WHICH MUST NOT BE DISTURBED.
3974: *
3975: * IT MUST ALSO BE REMEMBERED THAT THERE IS A REQUIREMENT
3976: * FOR NO FORWARD REFERENCES WHICH ALSO DISTURBS THE
3977: * ALPHABETICAL ORDER IN SOME CASES.
3978: *
3979: {{SEC{{{{START OF CONSTANT SECTION
3980: *
3981: * FREE STORE PERCENTAGE (USED BY ALLOC)
3982: *
3983: {ALFSP{DAC{E$FSP{{{FREE STORE PERCENTAGE
3984: *
3985: * BIT CONSTANTS FOR GENERAL USE
3986: *
3987: {BITS0{DBC{0{{{ALL ZERO BITS
3988: {BITS1{DBC{1{{{ONE BIT IN LOW ORDER POSITION
3989: {BITS2{DBC{2{{{BIT IN POSITION 2
3990: {BITS3{DBC{4{{{BIT IN POSITION 3
3991: {BITS4{DBC{8{{{BIT IN POSITION 4
3992: {BITS5{DBC{16{{{BIT IN POSITION 5
3993: {BITS6{DBC{32{{{BIT IN POSITION 6
3994: {BITS7{DBC{64{{{BIT IN POSITION 7
3995: {BITS8{DBC{128{{{BIT IN POSITION 8
3996: {BITS9{DBC{256{{{BIT IN POSITION 9
3997: {BIT10{DBC{512{{{BIT IN POSITION 10
3998: {BITSM{DBC{CFP$M{{{MASK FOR MAX INTEGER
3999: *
4000: * BIT CONSTANTS FOR SVBLK (SVBIT FIELD) TESTS
4001: *
4002: {BTFNC{DBC{SVFNC{{{BIT TO TEST FOR FUNCTION
4003: {BTKNM{DBC{SVKNM{{{BIT TO TEST FOR KEYWORD NUMBER
4004: {BTLBL{DBC{SVLBL{{{BIT TO TEST FOR LABEL
4005: {BTFFC{DBC{SVFFC{{{BIT TO TEST FOR FAST CALL
4006: {BTCKW{DBC{SVCKW{{{BIT TO TEST FOR CONSTANT KEYWORD
4007: {BTPRD{DBC{SVPRD{{{BIT TO TEST FOR PREDICATE FUNCTION
4008: {BTPRE{DBC{SVPRE{{{BIT TO TEST FOR PREEVALUATION
4009: {BTVAL{DBC{SVVAL{{{BIT TO TEST FOR VALUE
4010: {{EJC{{{{
4011: *
4012: * LIST OF NAMES USED FOR CONTROL CARD PROCESSING
4013: *
4014: {CCNMS{DTC{/CASE/{{{
4015: {{DTC{/DOUB/{{{
4016: {{DTC{/DUMP/{{{
4017: {{DTC{/EJEC/{{{
4018: {{DTC{/ERRO/{{{
4019: {{DTC{/EXEC/{{{
4020: {{DTC{/FAIL/{{{
4021: {{DTC{/LIST/{{{
4022: {{DTC{/NOER/{{{
4023: {{DTC{/NOEX/{{{
4024: {{DTC{/NOFA/{{{
4025: {{DTC{/NOLI/{{{
4026: {{DTC{/NOOP/{{{
4027: {{DTC{/NOPR/{{{
4028: {{DTC{/OPTI/{{{
4029: {{DTC{/PRIN/{{{
4030: {{DTC{/SING/{{{
4031: {{DTC{/SPAC/{{{
4032: {{DTC{/STIT/{{{
4033: {{DTC{/TITL/{{{
4034: {{DTC{/TRAC/{{{
4035: *
4036: * HEADER MESSAGES FOR DUMPR PROCEDURE (SCBLK FORMAT)
4037: *
4038: {DMHDK{DAC{B$SCL{{{DUMP OF KEYWORD VALUES
4039: {{DAC{22{{{
4040: {{DTC{/DUMP OF KEYWORD VALUES/{{{
4041: *
4042: {DMHDV{DAC{B$SCL{{{DUMP OF NATURAL VARIABLES
4043: {{DAC{25{{{
4044: {{DTC{/DUMP OF NATURAL VARIABLES/{{{
4045: {{EJC{{{{
4046: *
4047: * MESSAGE TEXT FOR COMPILATION STATISTICS
4048: *
4049: {ENCM1{DAC{B$SCL{{{
4050: {{DAC{10{{{
4051: {{DTC{/STORE USED/{{{
4052: *
4053: {ENCM2{DAC{B$SCL{{{
4054: {{DAC{10{{{
4055: {{DTC{/STORE LEFT/{{{
4056: *
4057: {ENCM3{DAC{B$SCL{{{
4058: {{DAC{11{{{
4059: {{DTC{/COMP ERRORS/{{{
4060: *
4061: {ENCM4{DAC{B$SCL{{{
4062: {{DAC{14{{{
4063: {{DTC{/COMP TIME-MSEC/{{{
4064: *
4065: {ENCM5{DAC{B$SCL{{{EXECUTION SUPPRESSED
4066: {{DAC{20{{{
4067: {{DTC{/EXECUTION SUPPRESSED/{{{
4068: *
4069: * STRING CONSTANT FOR ABNORMAL END
4070: *
4071: {ENDAB{DAC{B$SCL{{{
4072: {{DAC{12{{{
4073: {{DTC{/ABNORMAL END/{{{
4074: {{EJC{{{{
4075: *
4076: * MEMORY OVERFLOW DURING INITIALISATION
4077: *
4078: {ENDMO{DAC{B$SCL{{{
4079: {ENDML{DAC{15{{{
4080: {{DTC{/MEMORY OVERFLOW/{{{
4081: *
4082: * STRING CONSTANT FOR MESSAGE ISSUED BY L$END
4083: *
4084: {ENDMS{DAC{B$SCL{{{
4085: {{DAC{10{{{
4086: {{DTC{/NORMAL END/{{{
4087: *
4088: * FAIL MESSAGE FOR STACK FAIL SECTION
4089: *
4090: {ENDSO{DAC{B$SCL{{{STACK OVERFLOW IN GARBAGE COLLECTOR
4091: {{DAC{36{{{
4092: {{DTC{/STACK OVERFLOW IN GARBAGE COLLECTION/{{{
4093: *
4094: * STRING CONSTANT FOR TIME UP
4095: *
4096: {ENDTU{DAC{B$SCL{{{
4097: {{DAC{15{{{
4098: {{DTC{/ERROR - TIME UP/{{{
4099: {{EJC{{{{
4100: *
4101: * STRING CONSTANT FOR ERROR MESSAGE (ERROR SECTION)
4102: *
4103: {ERMMS{DAC{B$SCL{{{ERROR
4104: {{DAC{5{{{
4105: {{DTC{/ERROR/{{{
4106: *
4107: {ERMNS{DAC{B$SCL{{{STRING / -- /
4108: {{DAC{4{{{
4109: {{DTC{/ -- /{{{
4110: *
4111: * STRING CONSTANT FOR PAGE NUMBERING
4112: *
4113: {LSTMS{DAC{B$SCL{{{PAGE
4114: {{DAC{5{{{
4115: {{DTC{/PAGE /{{{
4116: *
4117: * LISTING HEADER MESSAGE
4118: *
4119: {HEADR{DAC{B$SCL{{{
4120: {{DAC{25{{{
4121: {{DTC{/MACRO SPITBOL VERSION 3.5/{{{
4122: *
4123: {HEADV{DAC{B$SCL{{{FOR EXIT() VERSION NO. CHECK
4124: {{DAC{3{{{
4125: {{DTC{/3.5/{{{
4126: *
4127: * INTEGER CONSTANTS FOR GENERAL USE
4128: * ICBLD OPTIMISATION USES THE FIRST THREE.
4129: *
4130: {INT$R{DAC{B$ICL{{{
4131: {INTV0{DIC{+0{{{0
4132: {INTON{DAC{B$ICL{{{
4133: {INTV1{DIC{+1{{{1
4134: {INTTW{DAC{B$ICL{{{
4135: {INTV2{DIC{+2{{{2
4136: {INTVT{DIC{+10{{{10
4137: {INTVH{DIC{+100{{{100
4138: {INTTH{DIC{+1000{{{1000
4139: *
4140: * TABLE USED IN ICBLD OPTIMISATION
4141: *
4142: {INTAB{DAC{INT$R{{{POINTER TO 0
4143: {{DAC{INTON{{{POINTER TO 1
4144: {{DAC{INTTW{{{POINTER TO 2
4145: {{EJC{{{{
4146: *
4147: * SPECIAL PATTERN NODES. THE FOLLOWING PATTERN NODES
4148: * CONSIST SIMPLY OF A PCODE POINTER, SEE MATCH ROUTINES
4149: * (P$XXX) FOR FULL DETAILS OF THEIR USE AND FORMAT).
4150: *
4151: {NDABB{DAC{P$ABB{{{ARBNO
4152: {NDABD{DAC{P$ABD{{{ARBNO
4153: {NDARC{DAC{P$ARC{{{ARB
4154: {NDEXB{DAC{P$EXB{{{EXPRESSION
4155: {NDFNB{DAC{P$FNB{{{FENCE()
4156: {NDFND{DAC{P$FND{{{FENCE()
4157: {NDEXC{DAC{P$EXC{{{EXPRESSION
4158: {NDIMB{DAC{P$IMB{{{IMMEDIATE ASSIGNMENT
4159: {NDIMD{DAC{P$IMD{{{IMMEDIATE ASSIGNMENT
4160: {NDNTH{DAC{P$NTH{{{PATTERN END (NULL PATTERN)
4161: {NDPAB{DAC{P$PAB{{{PATTERN ASSIGNMENT
4162: {NDPAD{DAC{P$PAD{{{PATTERN ASSIGNMENT
4163: {NDUNA{DAC{P$UNA{{{ANCHOR POINT MOVEMENT
4164: *
4165: * KEYWORD CONSTANT PATTERN NODES. THE FOLLOWING NODES ARE
4166: * USED AS THE VALUES OF PATTERN KEYWORDS AND THE INITIAL
4167: * VALUES OF THE CORRESPONDING NATURAL VARIABLES. ALL
4168: * NODES ARE IN P0BLK FORMAT AND THE ORDER IS TIED TO THE
4169: * DEFINITIONS OF CORRESPONDING K$XXX SYMBOLS.
4170: *
4171: {NDABO{DAC{P$ABO{{{ABORT
4172: {{DAC{NDNTH{{{
4173: {NDARB{DAC{P$ARB{{{ARB
4174: {{DAC{NDNTH{{{
4175: {NDBAL{DAC{P$BAL{{{BAL
4176: {{DAC{NDNTH{{{
4177: {NDFAL{DAC{P$FAL{{{FAIL
4178: {{DAC{NDNTH{{{
4179: {NDFEN{DAC{P$FEN{{{FENCE
4180: {{DAC{NDNTH{{{
4181: {NDREM{DAC{P$REM{{{REM
4182: {{DAC{NDNTH{{{
4183: {NDSUC{DAC{P$SUC{{{SUCCEED
4184: {{DAC{NDNTH{{{
4185: *
4186: * NULL STRING. ALL NULL VALUES POINT TO THIS STRING. THE
4187: * SVCHS FIELD CONTAINS A BLANK TO PROVIDE FOR EASY DEFAULT
4188: * PROCESSING IN TRACE, STOPTR, LPAD AND RPAD.
4189: * NULLW CONTAINS 10 BLANKS WHICH ENSURES AN ALL BLANK WORD
4190: * BUT FOR VERY EXCEPTIONAL MACHINES.
4191: *
4192: {NULLS{DAC{B$SCL{{{NULL STRING VALUE
4193: {{DAC{0{{{SCLEN = 0
4194: {NULLW{DTC{/ /{{{
4195: {{EJC{{{{
4196: *
4197: * OPERATOR DOPE VECTORS (SEE DVBLK FORMAT)
4198: *
4199: {OPDVC{DAC{O$CNC{{{CONCATENATION
4200: {{DAC{C$CNC{{{
4201: {{DAC{LLCNC{{{
4202: {{DAC{RRCNC{{{
4203: *
4204: * OPDVS IS USED WHEN SCANNING BELOW THE TOP LEVEL TO
4205: * INSURE THAT THE CONCATENATION WILL NOT BE LATER
4206: * MISTAKEN FOR PATTERN MATCHING
4207: *
4208: {OPDVP{DAC{O$CNC{{{CONCATENATION - NOT PATTERN MATCH
4209: {{DAC{C$CNP{{{
4210: {{DAC{LLCNC{{{
4211: {{DAC{RRCNC{{{
4212: *
4213: * NOTE THAT THE ORDER OF THE REMAINING ENTRIES IS TIED TO
4214: * THE ORDER OF THE CODING IN THE SCANE PROCEDURE.
4215: *
4216: {OPDVS{DAC{O$ASS{{{ASSIGNMENT
4217: {{DAC{C$ASS{{{
4218: {{DAC{LLASS{{{
4219: {{DAC{RRASS{{{
4220: *
4221: {{DAC{6{{{UNARY EQUAL
4222: {{DAC{C$UUO{{{
4223: {{DAC{LLUNO{{{
4224: *
4225: {{DAC{O$PMV{{{PATTERN MATCH
4226: {{DAC{C$PMT{{{
4227: {{DAC{LLPMT{{{
4228: {{DAC{RRPMT{{{
4229: *
4230: {{DAC{O$INT{{{INTERROGATION
4231: {{DAC{C$UVL{{{
4232: {{DAC{LLUNO{{{
4233: *
4234: {{DAC{1{{{BINARY AMPERSAND
4235: {{DAC{C$UBO{{{
4236: {{DAC{LLAMP{{{
4237: {{DAC{RRAMP{{{
4238: *
4239: {{DAC{O$KWV{{{KEYWORD REFERENCE
4240: {{DAC{C$KEY{{{
4241: {{DAC{LLUNO{{{
4242: *
4243: {{DAC{O$ALT{{{ALTERNATION
4244: {{DAC{C$ALT{{{
4245: {{DAC{LLALT{{{
4246: {{DAC{RRALT{{{
4247: {{EJC{{{{
4248: *
4249: * OPERATOR DOPE VECTORS (CONTINUED)
4250: *
4251: {{DAC{5{{{UNARY VERTICAL BAR
4252: {{DAC{C$UUO{{{
4253: {{DAC{LLUNO{{{
4254: *
4255: {{DAC{0{{{BINARY AT
4256: {{DAC{C$UBO{{{
4257: {{DAC{LLATS{{{
4258: {{DAC{RRATS{{{
4259: *
4260: {{DAC{O$CAS{{{CURSOR ASSIGNMENT
4261: {{DAC{C$UNM{{{
4262: {{DAC{LLUNO{{{
4263: *
4264: {{DAC{2{{{BINARY NUMBER SIGN
4265: {{DAC{C$UBO{{{
4266: {{DAC{LLNUM{{{
4267: {{DAC{RRNUM{{{
4268: *
4269: {{DAC{7{{{UNARY NUMBER SIGN
4270: {{DAC{C$UUO{{{
4271: {{DAC{LLUNO{{{
4272: *
4273: {{DAC{O$DVD{{{DIVISION
4274: {{DAC{C$BVL{{{
4275: {{DAC{LLDVD{{{
4276: {{DAC{RRDVD{{{
4277: *
4278: {{DAC{9{{{UNARY SLASH
4279: {{DAC{C$UUO{{{
4280: {{DAC{LLUNO{{{
4281: *
4282: {{DAC{O$MLT{{{MULTIPLICATION
4283: {{DAC{C$BVL{{{
4284: {{DAC{LLMLT{{{
4285: {{DAC{RRMLT{{{
4286: {{EJC{{{{
4287: *
4288: * OPERATOR DOPE VECTORS (CONTINUED)
4289: *
4290: {{DAC{0{{{DEFERRED EXPRESSION
4291: {{DAC{C$DEF{{{
4292: {{DAC{LLUNO{{{
4293: *
4294: {{DAC{3{{{BINARY PERCENT
4295: {{DAC{C$UBO{{{
4296: {{DAC{LLPCT{{{
4297: {{DAC{RRPCT{{{
4298: *
4299: {{DAC{8{{{UNARY PERCENT
4300: {{DAC{C$UUO{{{
4301: {{DAC{LLUNO{{{
4302: *
4303: {{DAC{O$EXP{{{EXPONENTIATION
4304: {{DAC{C$BVL{{{
4305: {{DAC{LLEXP{{{
4306: {{DAC{RREXP{{{
4307: *
4308: {{DAC{10{{{UNARY EXCLAMATION
4309: {{DAC{C$UUO{{{
4310: {{DAC{LLUNO{{{
4311: *
4312: {{DAC{O$IMA{{{IMMEDIATE ASSIGNMENT
4313: {{DAC{C$BVN{{{
4314: {{DAC{LLDLD{{{
4315: {{DAC{RRDLD{{{
4316: *
4317: {{DAC{O$INV{{{INDIRECTION
4318: {{DAC{C$IND{{{
4319: {{DAC{LLUNO{{{
4320: *
4321: {{DAC{4{{{BINARY NOT
4322: {{DAC{C$UBO{{{
4323: {{DAC{LLNOT{{{
4324: {{DAC{RRNOT{{{
4325: *
4326: {{DAC{0{{{NEGATION
4327: {{DAC{C$NEG{{{
4328: {{DAC{LLUNO{{{
4329: {{EJC{{{{
4330: *
4331: * OPERATOR DOPE VECTORS (CONTINUED)
4332: *
4333: {{DAC{O$SUB{{{SUBTRACTION
4334: {{DAC{C$BVL{{{
4335: {{DAC{LLPLM{{{
4336: {{DAC{RRPLM{{{
4337: *
4338: {{DAC{O$COM{{{COMPLEMENTATION
4339: {{DAC{C$UVL{{{
4340: {{DAC{LLUNO{{{
4341: *
4342: {{DAC{O$ADD{{{ADDITION
4343: {{DAC{C$BVL{{{
4344: {{DAC{LLPLM{{{
4345: {{DAC{RRPLM{{{
4346: *
4347: {{DAC{O$AFF{{{AFFIRMATION
4348: {{DAC{C$UVL{{{
4349: {{DAC{LLUNO{{{
4350: *
4351: {{DAC{O$PAS{{{PATTERN ASSIGNMENT
4352: {{DAC{C$BVN{{{
4353: {{DAC{LLDLD{{{
4354: {{DAC{RRDLD{{{
4355: *
4356: {{DAC{O$NAM{{{NAME REFERENCE
4357: {{DAC{C$UNM{{{
4358: {{DAC{LLUNO{{{
4359: *
4360: * SPECIAL DVS FOR GOTO OPERATORS (SEE PROCEDURE SCNGF)
4361: *
4362: {OPDVD{DAC{O$GOD{{{DIRECT GOTO
4363: {{DAC{C$UVL{{{
4364: {{DAC{LLUNO{{{
4365: *
4366: {OPDVN{DAC{O$GOC{{{COMPLEX NORMAL GOTO
4367: {{DAC{C$UNM{{{
4368: {{DAC{LLUNO{{{
4369: {{EJC{{{{
4370: *
4371: * OPERATOR ENTRY ADDRESS POINTERS, USED IN CODE
4372: *
4373: {OAMN${DAC{O$AMN{{{ARRAY REF (MULTI-SUBS BY VALUE)
4374: {OAMV${DAC{O$AMV{{{ARRAY REF (MULTI-SUBS BY VALUE)
4375: {OAON${DAC{O$AON{{{ARRAY REF (ONE SUB BY NAME)
4376: {OAOV${DAC{O$AOV{{{ARRAY REF (ONE SUB BY VALUE)
4377: {OCER${DAC{O$CER{{{COMPILATION ERROR
4378: {OFEX${DAC{O$FEX{{{FAILURE IN EXPRESSION EVALUATION
4379: {OFIF${DAC{O$FIF{{{FAILURE DURING GOTO EVALUATION
4380: {OFNC${DAC{O$FNC{{{FUNCTION CALL (MORE THAN ONE ARG)
4381: {OFNE${DAC{O$FNE{{{FUNCTION NAME ERROR
4382: {OFNS${DAC{O$FNS{{{FUNCTION CALL (SINGLE ARGUMENT)
4383: {OGOF${DAC{O$GOF{{{SET GOTO FAILURE TRAP
4384: {OINN${DAC{O$INN{{{INDIRECTION BY NAME
4385: {OKWN${DAC{O$KWN{{{KEYWORD REFERENCE BY NAME
4386: {OLEX${DAC{O$LEX{{{LOAD EXPRESSION BY NAME
4387: {OLPT${DAC{O$LPT{{{LOAD PATTERN
4388: {OLVN${DAC{O$LVN{{{LOAD VARIABLE NAME
4389: {ONTA${DAC{O$NTA{{{NEGATION, FIRST ENTRY
4390: {ONTB${DAC{O$NTB{{{NEGATION, SECOND ENTRY
4391: {ONTC${DAC{O$NTC{{{NEGATION, THIRD ENTRY
4392: {OPMN${DAC{O$PMN{{{PATTERN MATCH BY NAME
4393: {OPMS${DAC{O$PMS{{{PATTERN MATCH (STATEMENT)
4394: {OPOP${DAC{O$POP{{{POP TOP STACK ITEM
4395: {ORNM${DAC{O$RNM{{{RETURN NAME FROM EXPRESSION
4396: {ORPL${DAC{O$RPL{{{PATTERN REPLACEMENT
4397: {ORVL${DAC{O$RVL{{{RETURN VALUE FROM EXPRESSION
4398: {OSLA${DAC{O$SLA{{{SELECTION, FIRST ENTRY
4399: {OSLB${DAC{O$SLB{{{SELECTION, SECOND ENTRY
4400: {OSLC${DAC{O$SLC{{{SELECTION, THIRD ENTRY
4401: {OSLD${DAC{O$SLD{{{SELECTION, FOURTH ENTRY
4402: {OSTP${DAC{O$STP{{{STOP EXECUTION
4403: {OUNF${DAC{O$UNF{{{UNEXPECTED FAILURE
4404: {{EJC{{{{
4405: *
4406: * TABLE OF NAMES OF UNDEFINED BINARY OPERATORS FOR OPSYN
4407: *
4408: {OPSNB{DAC{CH$AT{{{AT
4409: {{DAC{CH$AM{{{AMPERSAND
4410: {{DAC{CH$NM{{{NUMBER
4411: {{DAC{CH$PC{{{PERCENT
4412: {{DAC{CH$NT{{{NOT
4413: *
4414: * TABLE OF NAMES OF UNDEFINED UNARY OPERATORS FOR OPSYN
4415: *
4416: {OPNSU{DAC{CH$BR{{{VERTICAL BAR
4417: {{DAC{CH$EQ{{{EQUAL
4418: {{DAC{CH$NM{{{NUMBER
4419: {{DAC{CH$PC{{{PERCENT
4420: {{DAC{CH$SL{{{SLASH
4421: {{DAC{CH$EX{{{EXCLAMATION
4422: *
4423: * ADDRESS CONST CONTAINING PROFILE TABLE ENTRY SIZE
4424: *
4425: {PFI2A{DAC{PF$I2{{{
4426: *
4427: * PROFILER MESSAGE STRINGS
4428: *
4429: {PFMS1{DAC{B$SCL{{{
4430: {{DAC{15{{{
4431: {{DTC{/PROGRAM PROFILE/{{{
4432: {PFMS2{DAC{B$SCL{{{
4433: {{DAC{42{{{
4434: {{DTC{/STMT NUMBER OF -- EXECUTION TIME --/{{{
4435: {PFMS3{DAC{B$SCL{{{
4436: {{DAC{47{{{
4437: {{DTC{/NUMBER EXECUTIONS TOTAL(MSEC) PER EXCN(MCSEC)/{{{
4438: *
4439: *
4440: * REAL CONSTANTS FOR GENERAL USE. NOTE THAT THE CONSTANTS
4441: * STARTING AT REAV1 FORM A POWERS OF TEN TABLE (GTSTG)
4442: *
4443: {REAV0{DRC{+0.0{{{0.0
4444: {REAP1{DRC{+0.1{{{0.1
4445: {REAP5{DRC{+0.5{{{0.5
4446: {REAV1{DRC{+1.0{{{10**0
4447: {REAVT{DRC{+1.0E+1{{{10**1
4448: {{DRC{+1.0E+2{{{10**2
4449: {{DRC{+1.0E+3{{{10**3
4450: {{DRC{+1.0E+4{{{10**4
4451: {{DRC{+1.0E+5{{{10**5
4452: {{DRC{+1.0E+6{{{10**6
4453: {{DRC{+1.0E+7{{{10**7
4454: {{DRC{+1.0E+8{{{10**8
4455: {{DRC{+1.0E+9{{{10**9
4456: {REATT{DRC{+1.0E+10{{{10**10
4457: {{EJC{{{{
4458: *
4459: * STRING CONSTANTS (SCBLK FORMAT) FOR DTYPE PROCEDURE
4460: *
4461: {SCARR{DAC{B$SCL{{{ARRAY
4462: {{DAC{5{{{
4463: {{DTC{/ARRAY/{{{
4464: *
4465: {SCBUF{DAC{B$SCL{{{BUFFER
4466: {{DAC{6{{{
4467: {{DTC{/BUFFER/{{{
4468: *
4469: {SCCOD{DAC{B$SCL{{{CODE
4470: {{DAC{4{{{
4471: {{DTC{/CODE/{{{
4472: *
4473: {SCEXP{DAC{B$SCL{{{EXPRESSION
4474: {{DAC{10{{{
4475: {{DTC{/EXPRESSION/{{{
4476: *
4477: {SCEXT{DAC{B$SCL{{{EXTERNAL
4478: {{DAC{8{{{
4479: {{DTC{/EXTERNAL/{{{
4480: *
4481: {SCINT{DAC{B$SCL{{{INTEGER
4482: {{DAC{7{{{
4483: {{DTC{/INTEGER/{{{
4484: *
4485: {SCNAM{DAC{B$SCL{{{NAME
4486: {{DAC{4{{{
4487: {{DTC{/NAME/{{{
4488: *
4489: {SCNUM{DAC{B$SCL{{{NUMERIC
4490: {{DAC{7{{{
4491: {{DTC{/NUMERIC/{{{
4492: *
4493: {SCPAT{DAC{B$SCL{{{PATTERN
4494: {{DAC{7{{{
4495: {{DTC{/PATTERN/{{{
4496: *
4497: {SCREA{DAC{B$SCL{{{REAL
4498: {{DAC{4{{{
4499: {{DTC{/REAL/{{{
4500: *
4501: {SCSTR{DAC{B$SCL{{{STRING
4502: {{DAC{6{{{
4503: {{DTC{/STRING/{{{
4504: *
4505: {SCTAB{DAC{B$SCL{{{TABLE
4506: {{DAC{5{{{
4507: {{DTC{/TABLE/{{{
4508: {{EJC{{{{
4509: *
4510: * STRING CONSTANTS (SCBLK FORMAT) FOR KVRTN (SEE RETRN)
4511: *
4512: {SCFRT{DAC{B$SCL{{{FRETURN
4513: {{DAC{7{{{
4514: {{DTC{/FRETURN/{{{
4515: *
4516: {SCNRT{DAC{B$SCL{{{NRETURN
4517: {{DAC{7{{{
4518: {{DTC{/NRETURN/{{{
4519: *
4520: {SCRTN{DAC{B$SCL{{{RETURN
4521: {{DAC{6{{{
4522: {{DTC{/RETURN/{{{
4523: *
4524: * DATATYPE NAME TABLE FOR DTYPE PROCEDURE. THE ORDER OF
4525: * THESE ENTRIES IS TIED TO THE B$XXX DEFINITIONS FOR BLOCKS
4526: *
4527: {SCNMT{DAC{SCARR{{{ARBLK ARRAY
4528: {{DAC{SCBUF{{{BFBLK BUFFER
4529: {{DAC{SCCOD{{{CDBLK CODE
4530: {{DAC{SCEXP{{{EXBLK EXPRESSION
4531: {{DAC{SCINT{{{ICBLK INTEGER
4532: {{DAC{SCNAM{{{NMBLK NAME
4533: {{DAC{SCPAT{{{P0BLK PATTERN
4534: {{DAC{SCPAT{{{P1BLK PATTERN
4535: {{DAC{SCPAT{{{P2BLK PATTERN
4536: {{DAC{SCREA{{{RCBLK REAL
4537: {{DAC{SCSTR{{{SCBLK STRING
4538: {{DAC{SCEXP{{{SEBLK EXPRESSION
4539: {{DAC{SCTAB{{{TBBLK TABLE
4540: {{DAC{SCARR{{{VCBLK ARRAY
4541: {{DAC{SCEXT{{{XNBLK EXTERNAL
4542: {{DAC{SCEXT{{{XRBLK EXTERNAL
4543: *
4544: * STRING CONSTANT FOR REAL ZERO
4545: *
4546: {SCRE0{DAC{B$SCL{{{
4547: {{DAC{2{{{
4548: {{DTC{/0./{{{
4549: {{EJC{{{{
4550: *
4551: * USED TO RE-INITIALISE KVSTL
4552: *
4553: {STLIM{DIC{+50000{{{DEFAULT STATEMENT LIMIT
4554: *
4555: * DUMMY FUNCTION BLOCK USED FOR UNDEFINED FUNCTIONS
4556: *
4557: {STNDF{DAC{O$FUN{{{PTR TO UNDEFINED FUNCTION ERR CALL
4558: {{DAC{0{{{DUMMY FARGS COUNT FOR CALL CIRCUIT
4559: *
4560: * DUMMY CODE BLOCK USED FOR UNDEFINED LABELS
4561: *
4562: {STNDL{DAC{L$UND{{{CODE PTR POINTS TO UNDEFINED LBL
4563: *
4564: * DUMMY OPERATOR BLOCK USED FOR UNDEFINED OPERATORS
4565: *
4566: {STNDO{DAC{O$OUN{{{PTR TO UNDEFINED OPERATOR ERR CALL
4567: {{DAC{0{{{DUMMY FARGS COUNT FOR CALL CIRCUIT
4568: *
4569: * STANDARD VARIABLE BLOCK. THIS BLOCK IS USED TO INITIALIZE
4570: * THE FIRST SEVEN FIELDS OF A NEWLY CONSTRUCTED VRBLK.
4571: * ITS FORMAT IS TIED TO THE VRBLK DEFINITIONS (SEE GTNVR).
4572: *
4573: {STNVR{DAC{B$VRL{{{VRGET
4574: {{DAC{B$VRS{{{VRSTO
4575: {{DAC{NULLS{{{VRVAL
4576: {{DAC{B$VRG{{{VRTRA
4577: {{DAC{STNDL{{{VRLBL
4578: {{DAC{STNDF{{{VRFNC
4579: {{DAC{0{{{VRNXT
4580: {{EJC{{{{
4581: *
4582: * MESSAGES USED IN END OF RUN PROCESSING (STOPR)
4583: *
4584: {STPM1{DAC{B$SCL{{{IN STATEMENT
4585: {{DAC{12{{{
4586: {{DTC{/IN STATEMENT/{{{
4587: *
4588: {STPM2{DAC{B$SCL{{{
4589: {{DAC{14{{{
4590: {{DTC{/STMTS EXECUTED/{{{
4591: *
4592: {STPM3{DAC{B$SCL{{{
4593: {{DAC{13{{{
4594: {{DTC{/RUN TIME-MSEC/{{{
4595: *
4596: {STPM4{DAC{B$SCL{{{
4597: {{DAC{12{{{
4598: {{DTC{$MCSEC / STMT${{{
4599: *
4600: {STPM5{DAC{B$SCL{{{
4601: {{DAC{13{{{
4602: {{DTC{/REGENERATIONS/{{{
4603: *
4604: * CHARS FOR /TU/ ENDING CODE
4605: *
4606: {STRTU{DTC{/TU/{{{
4607: *
4608: * TABLE USED BY CONVERT FUNCTION TO CHECK DATATYPE NAME
4609: * THE ENTRIES ARE ORDERED TO CORRESPOND TO BRANCH TABLE
4610: * IN S$CNV
4611: *
4612: {SVCTB{DAC{SCSTR{{{STRING
4613: {{DAC{SCINT{{{INTEGER
4614: {{DAC{SCNAM{{{NAME
4615: {{DAC{SCPAT{{{PATTERN
4616: {{DAC{SCARR{{{ARRAY
4617: {{DAC{SCTAB{{{TABLE
4618: {{DAC{SCEXP{{{EXPRESSION
4619: {{DAC{SCCOD{{{CODE
4620: {{DAC{SCNUM{{{NUMERIC
4621: {{DAC{SCREA{{{REAL
4622: {{DAC{SCBUF{{{BUFFER
4623: {{DAC{0{{{ZERO MARKS END OF LIST
4624: {{EJC{{{{
4625: *
4626: * MESSAGES (SCBLK FORMAT) USED BY TRACE PROCEDURES
4627: *
4628: *
4629: {TMASB{DAC{B$SCL{{{ASTERISKS FOR TRACE STATEMENT NO
4630: {{DAC{13{{{
4631: {{DTC{/************ /{{{
4632: *
4633: {TMBEB{DAC{B$SCL{{{BLANK-EQUAL-BLANK
4634: {{DAC{3{{{
4635: {{DTC{/ = /{{{
4636: *
4637: * DUMMY TRBLK FOR EXPRESSION VARIABLE
4638: *
4639: {TRBEV{DAC{B$TRT{{{DUMMY TRBLK
4640: *
4641: * DUMMY TRBLK FOR KEYWORD VARIABLE
4642: *
4643: {TRBKV{DAC{B$TRT{{{DUMMY TRBLK
4644: *
4645: * DUMMY CODE BLOCK TO RETURN CONTROL TO TRXEQ PROCEDURE
4646: *
4647: {TRXDR{DAC{O$TXR{{{BLOCK POINTS TO RETURN ROUTINE
4648: {TRXDC{DAC{TRXDR{{{POINTER TO BLOCK
4649: {{EJC{{{{
4650: *
4651: * STANDARD VARIABLE BLOCKS
4652: *
4653: * SEE SVBLK FORMAT FOR FULL DETAILS OF THE FORMAT. THE
4654: * VRBLKS ARE ORDERED BY LENGTH AND WITHIN EACH LENGTH THE
4655: * ORDER IS ALPHABETICAL BY NAME OF THE VARIABLE.
4656: *
4657: {V$EQF{DBC{SVFPR{{{EQ
4658: {{DAC{2{{{
4659: {{DTC{/EQ/{{{
4660: {{DAC{S$EQF{{{
4661: {{DAC{2{{{
4662: *
4663: {V$GEF{DBC{SVFPR{{{GE
4664: {{DAC{2{{{
4665: {{DTC{/GE/{{{
4666: {{DAC{S$GEF{{{
4667: {{DAC{2{{{
4668: *
4669: {V$GTF{DBC{SVFPR{{{GT
4670: {{DAC{2{{{
4671: {{DTC{/GT/{{{
4672: {{DAC{S$GTF{{{
4673: {{DAC{2{{{
4674: *
4675: {V$LEF{DBC{SVFPR{{{LE
4676: {{DAC{2{{{
4677: {{DTC{/LE/{{{
4678: {{DAC{S$LEF{{{
4679: {{DAC{2{{{
4680: *
4681: {V$LTF{DBC{SVFPR{{{LT
4682: {{DAC{2{{{
4683: {{DTC{/LT/{{{
4684: {{DAC{S$LTF{{{
4685: {{DAC{2{{{
4686: *
4687: {V$NEF{DBC{SVFPR{{{NE
4688: {{DAC{2{{{
4689: {{DTC{/NE/{{{
4690: {{DAC{S$NEF{{{
4691: {{DAC{2{{{
4692: *
4693: {V$ANY{DBC{SVFNP{{{ANY
4694: {{DAC{3{{{
4695: {{DTC{/ANY/{{{
4696: {{DAC{S$ANY{{{
4697: {{DAC{1{{{
4698: *
4699: {V$ARB{DBC{SVKVC{{{ARB
4700: {{DAC{3{{{
4701: {{DTC{/ARB/{{{
4702: {{DAC{K$ARB{{{
4703: {{DAC{NDARB{{{
4704: {{EJC{{{{
4705: *
4706: * STANDARD VARIABLE BLOCKS (CONTINUED)
4707: *
4708: {V$ARG{DBC{SVFNN{{{ARG
4709: {{DAC{3{{{
4710: {{DTC{/ARG/{{{
4711: {{DAC{S$ARG{{{
4712: {{DAC{2{{{
4713: *
4714: {V$BAL{DBC{SVKVC{{{BAL
4715: {{DAC{3{{{
4716: {{DTC{/BAL/{{{
4717: {{DAC{K$BAL{{{
4718: {{DAC{NDBAL{{{
4719: *
4720: {V$END{DBC{SVLBL{{{END
4721: {{DAC{3{{{
4722: {{DTC{/END/{{{
4723: {{DAC{L$END{{{
4724: *
4725: {V$LEN{DBC{SVFNP{{{LEN
4726: {{DAC{3{{{
4727: {{DTC{/LEN/{{{
4728: {{DAC{S$LEN{{{
4729: {{DAC{1{{{
4730: *
4731: {V$LEQ{DBC{SVFPR{{{LEQ
4732: {{DAC{3{{{
4733: {{DTC{/LEQ/{{{
4734: {{DAC{S$LEQ{{{
4735: {{DAC{2{{{
4736: *
4737: {V$LGE{DBC{SVFPR{{{LGE
4738: {{DAC{3{{{
4739: {{DTC{/LGE/{{{
4740: {{DAC{S$LGE{{{
4741: {{DAC{2{{{
4742: *
4743: {V$LGT{DBC{SVFPR{{{LGT
4744: {{DAC{3{{{
4745: {{DTC{/LGT/{{{
4746: {{DAC{S$LGT{{{
4747: {{DAC{2{{{
4748: *
4749: {V$LLE{DBC{SVFPR{{{LLE
4750: {{DAC{3{{{
4751: {{DTC{/LLE/{{{
4752: {{DAC{S$LLE{{{
4753: {{DAC{2{{{
4754: {{EJC{{{{
4755: *
4756: * STANDARD VARIABLE BLOCKS (CONTINUED)
4757: *
4758: {V$LLT{DBC{SVFPR{{{LLT
4759: {{DAC{3{{{
4760: {{DTC{/LLT/{{{
4761: {{DAC{S$LLT{{{
4762: {{DAC{2{{{
4763: *
4764: {V$LNE{DBC{SVFPR{{{LNE
4765: {{DAC{3{{{
4766: {{DTC{/LNE/{{{
4767: {{DAC{S$LNE{{{
4768: {{DAC{2{{{
4769: *
4770: {V$POS{DBC{SVFNP{{{POS
4771: {{DAC{3{{{
4772: {{DTC{/POS/{{{
4773: {{DAC{S$POS{{{
4774: {{DAC{1{{{
4775: *
4776: {V$REM{DBC{SVKVC{{{REM
4777: {{DAC{3{{{
4778: {{DTC{/REM/{{{
4779: {{DAC{K$REM{{{
4780: {{DAC{NDREM{{{
4781: *
4782: {V$SET{DBC{SVFNN{{{SET
4783: {{DAC{3{{{
4784: {{DTC{/SET/{{{
4785: {{DAC{S$SET{{{
4786: {{DAC{3{{{
4787: *
4788: {V$TAB{DBC{SVFNP{{{TAB
4789: {{DAC{3{{{
4790: {{DTC{/TAB/{{{
4791: {{DAC{S$TAB{{{
4792: {{DAC{1{{{
4793: *
4794: {V$CAS{DBC{SVKNM{{{CASE
4795: {{DAC{4{{{
4796: {{DTC{/CASE/{{{
4797: {{DAC{K$CAS{{{
4798: *
4799: {V$CHR{DBC{SVFNP{{{CHAR
4800: {{DAC{4{{{
4801: {{DTC{/CHAR/{{{
4802: {{DAC{S$CHR{{{
4803: {{DAC{1{{{
4804: *
4805: {V$COD{DBC{SVFNK{{{CODE
4806: {{DAC{4{{{
4807: {{DTC{/CODE/{{{
4808: {{DAC{K$COD{{{
4809: {{DAC{S$COD{{{
4810: {{DAC{1{{{
4811: *
4812: {V$COP{DBC{SVFNN{{{COPY
4813: {{DAC{4{{{
4814: {{DTC{/COPY/{{{
4815: {{DAC{S$COP{{{
4816: {{DAC{1{{{
4817: {{EJC{{{{
4818: *
4819: * STANDARD VARIABLE BLOCKS (CONTINUED)
4820: *
4821: {V$DAT{DBC{SVFNN{{{DATA
4822: {{DAC{4{{{
4823: {{DTC{/DATA/{{{
4824: {{DAC{S$DAT{{{
4825: {{DAC{1{{{
4826: *
4827: {V$DTE{DBC{SVFNN{{{DATE
4828: {{DAC{4{{{
4829: {{DTC{/DATE/{{{
4830: {{DAC{S$DTE{{{
4831: {{DAC{0{{{
4832: *
4833: {V$DMP{DBC{SVFNK{{{DUMP
4834: {{DAC{4{{{
4835: {{DTC{/DUMP/{{{
4836: {{DAC{K$DMP{{{
4837: {{DAC{S$DMP{{{
4838: {{DAC{1{{{
4839: *
4840: {V$DUP{DBC{SVFNN{{{DUPL
4841: {{DAC{4{{{
4842: {{DTC{/DUPL/{{{
4843: {{DAC{S$DUP{{{
4844: {{DAC{2{{{
4845: *
4846: {V$EVL{DBC{SVFNN{{{EVAL
4847: {{DAC{4{{{
4848: {{DTC{/EVAL/{{{
4849: {{DAC{S$EVL{{{
4850: {{DAC{1{{{
4851: *
4852: {V$EXT{DBC{SVFNN{{{EXIT
4853: {{DAC{4{{{
4854: {{DTC{/EXIT/{{{
4855: {{DAC{S$EXT{{{
4856: {{DAC{1{{{
4857: *
4858: {V$FAL{DBC{SVKVC{{{FAIL
4859: {{DAC{4{{{
4860: {{DTC{/FAIL/{{{
4861: {{DAC{K$FAL{{{
4862: {{DAC{NDFAL{{{
4863: *
4864: {V$HST{DBC{SVFNN{{{HOST
4865: {{DAC{4{{{
4866: {{DTC{/HOST/{{{
4867: {{DAC{S$HST{{{
4868: {{DAC{3{{{
4869: {{EJC{{{{
4870: *
4871: * STANDARD VARIABLE BLOCKS (CONTINUED)
4872: *
4873: {V$ITM{DBC{SVFNF{{{ITEM
4874: {{DAC{4{{{
4875: {{DTC{/ITEM/{{{
4876: {{DAC{S$ITM{{{
4877: {{DAC{999{{{
4878: *
4879: {V$LOD{DBC{SVFNN{{{LOAD
4880: {{DAC{4{{{
4881: {{DTC{/LOAD/{{{
4882: {{DAC{S$LOD{{{
4883: {{DAC{2{{{
4884: *
4885: {V$LPD{DBC{SVFNP{{{LPAD
4886: {{DAC{4{{{
4887: {{DTC{/LPAD/{{{
4888: {{DAC{S$LPD{{{
4889: {{DAC{3{{{
4890: *
4891: {V$RPD{DBC{SVFNP{{{RPAD
4892: {{DAC{4{{{
4893: {{DTC{/RPAD/{{{
4894: {{DAC{S$RPD{{{
4895: {{DAC{3{{{
4896: *
4897: {V$RPS{DBC{SVFNP{{{RPOS
4898: {{DAC{4{{{
4899: {{DTC{/RPOS/{{{
4900: {{DAC{S$RPS{{{
4901: {{DAC{1{{{
4902: *
4903: {V$RTB{DBC{SVFNP{{{RTAB
4904: {{DAC{4{{{
4905: {{DTC{/RTAB/{{{
4906: {{DAC{S$RTB{{{
4907: {{DAC{1{{{
4908: *
4909: {V$SI${DBC{SVFNP{{{SIZE
4910: {{DAC{4{{{
4911: {{DTC{/SIZE/{{{
4912: {{DAC{S$SI${{{
4913: {{DAC{1{{{
4914: *
4915: *
4916: {V$SRT{DBC{SVFNN{{{SORT
4917: {{DAC{4{{{
4918: {{DTC{/SORT/{{{
4919: {{DAC{S$SRT{{{
4920: {{DAC{2{{{
4921: {V$SPN{DBC{SVFNP{{{SPAN
4922: {{DAC{4{{{
4923: {{DTC{/SPAN/{{{
4924: {{DAC{S$SPN{{{
4925: {{DAC{1{{{
4926: {{EJC{{{{
4927: *
4928: * STANDARD VARIABLE BLOCKS (CONTINUED)
4929: *
4930: {V$STN{DBC{SVKNM{{{STNO
4931: {{DAC{4{{{
4932: {{DTC{/STNO/{{{
4933: {{DAC{K$STN{{{
4934: *
4935: {V$TIM{DBC{SVFNN{{{TIME
4936: {{DAC{4{{{
4937: {{DTC{/TIME/{{{
4938: {{DAC{S$TIM{{{
4939: {{DAC{0{{{
4940: *
4941: {V$TRM{DBC{SVFNK{{{TRIM
4942: {{DAC{4{{{
4943: {{DTC{/TRIM/{{{
4944: {{DAC{K$TRM{{{
4945: {{DAC{S$TRM{{{
4946: {{DAC{1{{{
4947: *
4948: {V$ABE{DBC{SVKNM{{{ABEND
4949: {{DAC{5{{{
4950: {{DTC{/ABEND/{{{
4951: {{DAC{K$ABE{{{
4952: *
4953: {V$ABO{DBC{SVKVL{{{ABORT
4954: {{DAC{5{{{
4955: {{DTC{/ABORT/{{{
4956: {{DAC{K$ABO{{{
4957: {{DAC{L$ABO{{{
4958: {{DAC{NDABO{{{
4959: *
4960: {V$APP{DBC{SVFNF{{{APPLY
4961: {{DAC{5{{{
4962: {{DTC{/APPLY/{{{
4963: {{DAC{S$APP{{{
4964: {{DAC{999{{{
4965: *
4966: {V$ABN{DBC{SVFNP{{{ARBNO
4967: {{DAC{5{{{
4968: {{DTC{/ARBNO/{{{
4969: {{DAC{S$ABN{{{
4970: {{DAC{1{{{
4971: *
4972: {V$ARR{DBC{SVFNN{{{ARRAY
4973: {{DAC{5{{{
4974: {{DTC{/ARRAY/{{{
4975: {{DAC{S$ARR{{{
4976: {{DAC{2{{{
4977: {{EJC{{{{
4978: *
4979: * STANDARD VARIABLE BLOCKS (CONTINUED)
4980: *
4981: {V$BRK{DBC{SVFNP{{{BREAK
4982: {{DAC{5{{{
4983: {{DTC{/BREAK/{{{
4984: {{DAC{S$BRK{{{
4985: {{DAC{1{{{
4986: *
4987: {V$CLR{DBC{SVFNN{{{CLEAR
4988: {{DAC{5{{{
4989: {{DTC{/CLEAR/{{{
4990: {{DAC{S$CLR{{{
4991: {{DAC{1{{{
4992: *
4993: {V$EJC{DBC{SVFNN{{{EJECT
4994: {{DAC{5{{{
4995: {{DTC{/EJECT/{{{
4996: {{DAC{S$EJC{{{
4997: {{DAC{1{{{
4998: *
4999: {V$FEN{DBC{SVFPK{{{FENCE
5000: {{DAC{5{{{
5001: {{DTC{/FENCE/{{{
5002: {{DAC{K$FEN{{{
5003: {{DAC{S$FNC{{{
5004: {{DAC{1{{{
5005: {{DAC{NDFEN{{{
5006: *
5007: {V$FLD{DBC{SVFNN{{{FIELD
5008: {{DAC{5{{{
5009: {{DTC{/FIELD/{{{
5010: {{DAC{S$FLD{{{
5011: {{DAC{2{{{
5012: *
5013: {V$IDN{DBC{SVFPR{{{IDENT
5014: {{DAC{5{{{
5015: {{DTC{/IDENT/{{{
5016: {{DAC{S$IDN{{{
5017: {{DAC{2{{{
5018: *
5019: {V$INP{DBC{SVFNK{{{INPUT
5020: {{DAC{5{{{
5021: {{DTC{/INPUT/{{{
5022: {{DAC{K$INP{{{
5023: {{DAC{S$INP{{{
5024: {{DAC{3{{{
5025: *
5026: {V$LOC{DBC{SVFNN{{{LOCAL
5027: {{DAC{5{{{
5028: {{DTC{/LOCAL/{{{
5029: {{DAC{S$LOC{{{
5030: {{DAC{2{{{
5031: {{EJC{{{{
5032: *
5033: * STANDARD VARIABLE BLOCKS (CONTINUED)
5034: *
5035: {V$OPS{DBC{SVFNN{{{OPSYN
5036: {{DAC{5{{{
5037: {{DTC{/OPSYN/{{{
5038: {{DAC{S$OPS{{{
5039: {{DAC{3{{{
5040: *
5041: {V$RMD{DBC{SVFNP{{{REMDR
5042: {{DAC{5{{{
5043: {{DTC{/REMDR/{{{
5044: {{DAC{S$RMD{{{
5045: {{DAC{2{{{
5046: *
5047: {V$RSR{DBC{SVFNN{{{RSORT
5048: {{DAC{5{{{
5049: {{DTC{/RSORT/{{{
5050: {{DAC{S$RSR{{{
5051: {{DAC{2{{{
5052: *
5053: {V$TBL{DBC{SVFNN{{{TABLE
5054: {{DAC{5{{{
5055: {{DTC{/TABLE/{{{
5056: {{DAC{S$TBL{{{
5057: {{DAC{3{{{
5058: *
5059: {V$TRA{DBC{SVFNK{{{TRACE
5060: {{DAC{5{{{
5061: {{DTC{/TRACE/{{{
5062: {{DAC{K$TRA{{{
5063: {{DAC{S$TRA{{{
5064: {{DAC{4{{{
5065: *
5066: {V$ANC{DBC{SVKNM{{{ANCHOR
5067: {{DAC{6{{{
5068: {{DTC{/ANCHOR/{{{
5069: {{DAC{K$ANC{{{
5070: *
5071: {V$APN{DBC{SVFNN{{{
5072: {{DAC{6{{{
5073: {{DTC{/APPEND/{{{
5074: {{DAC{S$APN{{{
5075: {{DAC{2{{{
5076: *
5077: {V$BKX{DBC{SVFNP{{{BREAKX
5078: {{DAC{6{{{
5079: {{DTC{/BREAKX/{{{
5080: {{DAC{S$BKX{{{
5081: {{DAC{1{{{
5082: *
5083: {V$BUF{DBC{SVFNN{{{BUFFER
5084: {{DAC{6{{{
5085: {{DTC{/BUFFER/{{{
5086: {{DAC{S$BUF{{{
5087: {{DAC{2{{{
5088: *
5089: {V$DEF{DBC{SVFNN{{{DEFINE
5090: {{DAC{6{{{
5091: {{DTC{/DEFINE/{{{
5092: {{DAC{S$DEF{{{
5093: {{DAC{2{{{
5094: *
5095: {V$DET{DBC{SVFNN{{{DETACH
5096: {{DAC{6{{{
5097: {{DTC{/DETACH/{{{
5098: {{DAC{S$DET{{{
5099: {{DAC{1{{{
5100: {{EJC{{{{
5101: *
5102: * STANDARD VARIABLE BLOCKS (CONTINUED)
5103: *
5104: {V$DIF{DBC{SVFPR{{{DIFFER
5105: {{DAC{6{{{
5106: {{DTC{/DIFFER/{{{
5107: {{DAC{S$DIF{{{
5108: {{DAC{2{{{
5109: *
5110: {V$FTR{DBC{SVKNM{{{FTRACE
5111: {{DAC{6{{{
5112: {{DTC{/FTRACE/{{{
5113: {{DAC{K$FTR{{{
5114: *
5115: {V$INS{DBC{SVFNN{{{INSERT
5116: {{DAC{6{{{
5117: {{DTC{/INSERT/{{{
5118: {{DAC{S$INS{{{
5119: {{DAC{4{{{
5120: *
5121: {V$LST{DBC{SVKNM{{{LASTNO
5122: {{DAC{6{{{
5123: {{DTC{/LASTNO/{{{
5124: {{DAC{K$LST{{{
5125: *
5126: {V$NAY{DBC{SVFNP{{{NOTANY
5127: {{DAC{6{{{
5128: {{DTC{/NOTANY/{{{
5129: {{DAC{S$NAY{{{
5130: {{DAC{1{{{
5131: *
5132: {V$OUP{DBC{SVFNK{{{OUTPUT
5133: {{DAC{6{{{
5134: {{DTC{/OUTPUT/{{{
5135: {{DAC{K$OUP{{{
5136: {{DAC{S$OUP{{{
5137: {{DAC{3{{{
5138: *
5139: {V$RET{DBC{SVLBL{{{RETURN
5140: {{DAC{6{{{
5141: {{DTC{/RETURN/{{{
5142: {{DAC{L$RTN{{{
5143: *
5144: {V$REW{DBC{SVFNN{{{REWIND
5145: {{DAC{6{{{
5146: {{DTC{/REWIND/{{{
5147: {{DAC{S$REW{{{
5148: {{DAC{1{{{
5149: *
5150: {V$STT{DBC{SVFNN{{{STOPTR
5151: {{DAC{6{{{
5152: {{DTC{/STOPTR/{{{
5153: {{DAC{S$STT{{{
5154: {{DAC{2{{{
5155: {{EJC{{{{
5156: *
5157: * STANDARD VARIABLE BLOCKS (CONTINUED)
5158: *
5159: {V$SUB{DBC{SVFNN{{{SUBSTR
5160: {{DAC{6{{{
5161: {{DTC{/SUBSTR/{{{
5162: {{DAC{S$SUB{{{
5163: {{DAC{3{{{
5164: *
5165: {V$UNL{DBC{SVFNN{{{UNLOAD
5166: {{DAC{6{{{
5167: {{DTC{/UNLOAD/{{{
5168: {{DAC{S$UNL{{{
5169: {{DAC{1{{{
5170: *
5171: {V$COL{DBC{SVFNN{{{COLLECT
5172: {{DAC{7{{{
5173: {{DTC{/COLLECT/{{{
5174: {{DAC{S$COL{{{
5175: {{DAC{1{{{
5176: *
5177: {V$CNV{DBC{SVFNN{{{CONVERT
5178: {{DAC{7{{{
5179: {{DTC{/CONVERT/{{{
5180: {{DAC{S$CNV{{{
5181: {{DAC{2{{{
5182: *
5183: {V$ENF{DBC{SVFNN{{{ENDFILE
5184: {{DAC{7{{{
5185: {{DTC{/ENDFILE/{{{
5186: {{DAC{S$ENF{{{
5187: {{DAC{1{{{
5188: *
5189: {V$ETX{DBC{SVKNM{{{ERRTEXT
5190: {{DAC{7{{{
5191: {{DTC{/ERRTEXT/{{{
5192: {{DAC{K$ETX{{{
5193: *
5194: {V$ERT{DBC{SVKNM{{{ERRTYPE
5195: {{DAC{7{{{
5196: {{DTC{/ERRTYPE/{{{
5197: {{DAC{K$ERT{{{
5198: *
5199: {V$FRT{DBC{SVLBL{{{FRETURN
5200: {{DAC{7{{{
5201: {{DTC{/FRETURN/{{{
5202: {{DAC{L$FRT{{{
5203: *
5204: {V$INT{DBC{SVFPR{{{INTEGER
5205: {{DAC{7{{{
5206: {{DTC{/INTEGER/{{{
5207: {{DAC{S$INT{{{
5208: {{DAC{1{{{
5209: *
5210: {V$NRT{DBC{SVLBL{{{NRETURN
5211: {{DAC{7{{{
5212: {{DTC{/NRETURN/{{{
5213: {{DAC{L$NRT{{{
5214: {{EJC{{{{
5215: *
5216: * STANDARD VARIABLE BLOCKS (CONTINUED)
5217: *
5218: *
5219: {V$PFL{DBC{SVKNM{{{PROFILE
5220: {{DAC{7{{{
5221: {{DTC{/PROFILE/{{{
5222: {{DAC{K$PFL{{{
5223: *
5224: {V$RPL{DBC{SVFNP{{{REPLACE
5225: {{DAC{7{{{
5226: {{DTC{/REPLACE/{{{
5227: {{DAC{S$RPL{{{
5228: {{DAC{3{{{
5229: *
5230: {V$RVS{DBC{SVFNP{{{REVERSE
5231: {{DAC{7{{{
5232: {{DTC{/REVERSE/{{{
5233: {{DAC{S$RVS{{{
5234: {{DAC{1{{{
5235: *
5236: {V$RTN{DBC{SVKNM{{{RTNTYPE
5237: {{DAC{7{{{
5238: {{DTC{/RTNTYPE/{{{
5239: {{DAC{K$RTN{{{
5240: *
5241: {V$STX{DBC{SVFNN{{{SETEXIT
5242: {{DAC{7{{{
5243: {{DTC{/SETEXIT/{{{
5244: {{DAC{S$STX{{{
5245: {{DAC{1{{{
5246: *
5247: {V$STC{DBC{SVKNM{{{STCOUNT
5248: {{DAC{7{{{
5249: {{DTC{/STCOUNT/{{{
5250: {{DAC{K$STC{{{
5251: *
5252: {V$STL{DBC{SVKNM{{{STLIMIT
5253: {{DAC{7{{{
5254: {{DTC{/STLIMIT/{{{
5255: {{DAC{K$STL{{{
5256: *
5257: {V$SUC{DBC{SVKVC{{{SUCCEED
5258: {{DAC{7{{{
5259: {{DTC{/SUCCEED/{{{
5260: {{DAC{K$SUC{{{
5261: {{DAC{NDSUC{{{
5262: *
5263: {V$ALP{DBC{SVKWC{{{ALPHABET
5264: {{DAC{8{{{
5265: {{DTC{/ALPHABET/{{{
5266: {{DAC{K$ALP{{{
5267: *
5268: {V$CNT{DBC{SVLBL{{{CONTINUE
5269: {{DAC{8{{{
5270: {{DTC{/CONTINUE/{{{
5271: {{DAC{L$CNT{{{
5272: {{EJC{{{{
5273: *
5274: * STANDARD VARIABLE BLOCKS (CONTINUED)
5275: *
5276: {V$DTP{DBC{SVFNP{{{DATATYPE
5277: {{DAC{8{{{
5278: {{DTC{/DATATYPE/{{{
5279: {{DAC{S$DTP{{{
5280: {{DAC{1{{{
5281: *
5282: {V$ERL{DBC{SVKNM{{{ERRLIMIT
5283: {{DAC{8{{{
5284: {{DTC{/ERRLIMIT/{{{
5285: {{DAC{K$ERL{{{
5286: *
5287: {V$FNC{DBC{SVKNM{{{FNCLEVEL
5288: {{DAC{8{{{
5289: {{DTC{/FNCLEVEL/{{{
5290: {{DAC{K$FNC{{{
5291: *
5292: {V$MXL{DBC{SVKNM{{{MAXLNGTH
5293: {{DAC{8{{{
5294: {{DTC{/MAXLNGTH/{{{
5295: {{DAC{K$MXL{{{
5296: *
5297: {V$TER{DBC{0{{{TERMINAL
5298: {{DAC{8{{{
5299: {{DTC{/TERMINAL/{{{
5300: {{DAC{0{{{
5301: *
5302: {V$PRO{DBC{SVFNN{{{PROTOTYPE
5303: {{DAC{9{{{
5304: {{DTC{/PROTOTYPE/{{{
5305: {{DAC{S$PRO{{{
5306: {{DAC{1{{{
5307: *
5308: {{DBC{0{{{DUMMY ENTRY TO END LIST
5309: {{DAC{10{{{LENGTH GT 9 (PROTOTYPE)
5310: {{EJC{{{{
5311: *
5312: * LIST OF SVBLK POINTERS FOR KEYWORDS TO BE DUMPED. THE
5313: * LIST IS IN THE ORDER WHICH APPEARS ON THE DUMP OUTPUT.
5314: *
5315: {VDMKW{DAC{V$ANC{{{ANCHOR
5316: {{DAC{V$CAS{{{CCASE
5317: {{DAC{V$COD{{{CODE
5318: {{DAC{V$DMP{{{DUMP
5319: {{DAC{V$ERL{{{ERRLIMIT
5320: {{DAC{V$ETX{{{ERRTEXT
5321: {{DAC{V$ERT{{{ERRTYPE
5322: {{DAC{V$FNC{{{FNCLEVEL
5323: {{DAC{V$FTR{{{FTRACE
5324: {{DAC{V$INP{{{INPUT
5325: {{DAC{V$LST{{{LASTNO
5326: {{DAC{V$MXL{{{MAXLENGTH
5327: {{DAC{V$OUP{{{OUTPUT
5328: {{DAC{V$PFL{{{PROFILE
5329: {{DAC{V$RTN{{{RTNTYPE
5330: {{DAC{V$STC{{{STCOUNT
5331: {{DAC{V$STL{{{STLIMIT
5332: {{DAC{V$STN{{{STNO
5333: {{DAC{V$TRA{{{TRACE
5334: {{DAC{V$TRM{{{TRIM
5335: {{DAC{0{{{END OF LIST
5336: *
5337: * TABLE USED BY GTNVR TO SEARCH SVBLK LISTS
5338: *
5339: {VSRCH{DAC{0{{{DUMMY ENTRY TO GET PROPER INDEXING
5340: {{DAC{V$EQF{{{START OF 1 CHAR VARIABLES (NONE)
5341: {{DAC{V$EQF{{{START OF 2 CHAR VARIABLES
5342: {{DAC{V$ANY{{{START OF 3 CHAR VARIABLES
5343: {{DAC{V$CAS{{{START OF 4 CHAR VARIABLES
5344: {{DAC{V$ABE{{{START OF 5 CHAR VARIABLES
5345: {{DAC{V$ANC{{{START OF 6 CHAR VARIABLES
5346: {{DAC{V$COL{{{START OF 7 CHAR VARIABLES
5347: {{DAC{V$ALP{{{START OF 8 CHAR VARIABLES
5348: {{DAC{V$PRO{{{START OF 9 CHAR VARIABLES
5349: {{TTL{S{{{P I T B O L -- WORKING STORAGE SECTION
5350: *
5351: * THE WORKING STORAGE SECTION CONTAINS AREAS WHICH ARE
5352: * CHANGED DURING EXECUTION OF THE PROGRAM. THE VALUE
5353: * ASSEMBLED IS THE INITIAL VALUE BEFORE EXECUTION STARTS.
5354: *
5355: * ALL THESE AREAS ARE FIXED LENGTH AREAS. VARIABLE LENGTH
5356: * DATA IS STORED IN THE STATIC OR DYNAMIC REGIONS OF THE
5357: * ALLOCATED DATA AREAS.
5358: *
5359: * THE VALUES IN THIS AREA ARE DESCRIBED EITHER AS WORK
5360: * AREAS OR AS GLOBAL VALUES. A WORK AREA IS USED IN AN
5361: * EPHEMERAL MANNER AND THE VALUE IS NOT SAVED FROM ONE
5362: * ENTRY INTO A ROUTINE TO ANOTHER. A GLOBAL VALUE IS A
5363: * LESS TEMPORARY LOCATION WHOSE VALUE IS SAVED FROM ONE
5364: * CALL TO ANOTHER.
5365: *
5366: * A GENERAL PART OF THE APPROACH IN THIS PROGRAM IS NOT
5367: * TO OVERLAP WORK AREAS BETWEEN PROCEDURES EVEN THOUGH A
5368: * SMALL AMOUNT OF SPACE COULD BE SAVED. SUCH OVERLAP IS
5369: * CONSIDERED A SOURCE OF PROGRAM ERRORS AND DECREASES THE
5370: * INFORMATION LEFT BEHIND AFTER A SYSTEM CRASH OF ANY KIND.
5371: *
5372: * THE NAMES OF THESE LOCATIONS ARE LABELS WITH FIVE LETTER
5373: * (A-Y,$) NAMES. AS FAR AS POSSIBLE THE ORDER IS KEPT
5374: * ALPHABETICAL BY THESE NAMES BUT IN SOME CASES THERE
5375: * ARE SLIGHT DEPARTURES CAUSED BY OTHER ORDER REQUIREMENTS.
5376: *
5377: * UNLESS OTHERWISE DOCUMENTED, THE ORDER OF WORK AREAS
5378: * DOES NOT AFFECT THE EXECUTION OF THE SPITBOL PROGRAM.
5379: *
5380: {{SEC{{{{START OF WORKING STORAGE SECTION
5381: {{EJC{{{{
5382: *
5383: * THIS AREA IS NOT CLEARED BY INITIAL CODE
5384: *
5385: {CMLAB{DAC{B$SCL{{{STRING USED TO CHECK LABEL LEGALITY
5386: {{DAC{2{{{
5387: {{DTC{/ /{{{
5388: *
5389: * LABEL TO MARK START OF WORK AREA
5390: *
5391: {AAAAA{DAC{0{{{
5392: *
5393: * WORK AREAS FOR ALLOC PROCEDURE
5394: *
5395: {ALDYN{DAC{0{{{AMOUNT OF DYNAMIC STORE
5396: {ALFSF{DIC{+0{{{FACTOR IN FREE STORE PCNTAGE CHECK
5397: {ALLIA{DIC{+0{{{DUMP IA
5398: {ALLSV{DAC{0{{{SAVE WB IN ALLOC
5399: *
5400: * WORK AREAS FOR ALOST PROCEDURE
5401: *
5402: {ALSTA{DAC{0{{{SAVE WA IN ALOST
5403: *
5404: * SAVE AREAS FOR ARRAY FUNCTION (S$ARR)
5405: *
5406: {ARCDM{DAC{0{{{COUNT DIMENSIONS
5407: {ARNEL{DIC{+0{{{COUNT ELEMENTS
5408: {ARPTR{DAC{0{{{OFFSET PTR INTO ARBLK
5409: {ARSVL{DIC{+0{{{SAVE INTEGER LOW BOUND
5410: {{EJC{{{{
5411: * WORK AREAS FOR ARREF ROUTINE
5412: *
5413: {ARFSI{DIC{+0{{{SAVE CURRENT EVOLVING SUBSCRIPT
5414: {ARFXS{DAC{0{{{SAVE BASE STACK POINTER
5415: *
5416: * WORK AREAS FOR B$EFC BLOCK ROUTINE
5417: *
5418: {BEFOF{DAC{0{{{SAVE OFFSET PTR INTO EFBLK
5419: *
5420: * WORK AREAS FOR B$PFC BLOCK ROUTINE
5421: *
5422: {BPFPF{DAC{0{{{SAVE PFBLK POINTER
5423: {BPFSV{DAC{0{{{SAVE OLD FUNCTION VALUE
5424: {BPFXT{DAC{0{{{POINTER TO STACKED ARGUMENTS
5425: *
5426: * SAVE AREAS FOR COLLECT FUNCTION (S$COL)
5427: *
5428: {CLSVI{DIC{+0{{{SAVE INTEGER ARGUMENT
5429: *
5430: * GLOBAL VALUES FOR CMPIL PROCEDURE
5431: *
5432: {CMERC{DAC{0{{{COUNT OF INITIAL COMPILE ERRORS
5433: {CMPXS{DAC{0{{{SAVE STACK PTR IN CASE OF ERRORS
5434: {CMPSN{DAC{1{{{NUMBER OF NEXT STATEMENT TO COMPILE
5435: {CMPSS{DAC{0{{{SAVE SUBROUTINE STACK PTR
5436: *
5437: * WORK AREA FOR CNCRD
5438: *
5439: {CNSCC{DAC{0{{{POINTER TO CONTROL CARD STRING
5440: {CNSWC{DAC{0{{{WORD COUNT
5441: {CNR$T{DAC{0{{{POINTER TO R$TTL OR R$STL
5442: {CNTTL{DAC{0{{{FLAG FOR -TITLE, -STITL
5443: *
5444: * WORK AREAS FOR CONVERT FUNCTION (S$CNV)
5445: *
5446: {CNVTP{DAC{0{{{SAVE PTR INTO SCVTB
5447: *
5448: * FLAG FOR SUPPRESSION OF COMPILATION STATISTICS.
5449: *
5450: {CPSTS{DAC{0{{{SUPPRESS COMP. STATS IF NON ZERO
5451: *
5452: * GLOBAL VALUES FOR CONTROL CARD SWITCHES
5453: *
5454: {CSWDB{DAC{0{{{0/1 FOR -SINGLE/-DOUBLE
5455: {CSWER{DAC{0{{{0/1 FOR -ERRORS/-NOERRORS
5456: {CSWEX{DAC{0{{{0/1 FOR -EXECUTE/-NOEXECUTE
5457: {CSWFL{DAC{1{{{0/1 FOR -NOFAIL/-FAIL
5458: {CSWIN{DAC{INILN{{{XXX FOR -INXXX
5459: {CSWLS{DAC{1{{{0/1 FOR -NOLIST/-LIST
5460: {CSWNO{DAC{0{{{0/1 FOR -OPTIMISE/-NOOPT
5461: {CSWPR{DAC{0{{{0/1 FOR -NOPRINT/-PRINT
5462: *
5463: * GLOBAL LOCATION USED BY PATST PROCEDURE
5464: *
5465: {CTMSK{DBC{0{{{LAST BIT POSITION USED IN R$CTP
5466: {CURID{DAC{0{{{CURRENT ID VALUE
5467: {{EJC{{{{
5468: *
5469: * GLOBAL VALUE FOR CDWRD PROCEDURE
5470: *
5471: {CWCOF{DAC{0{{{NEXT WORD OFFSET IN CURRENT CCBLK
5472: *
5473: * WORK AREAS FOR DATA FUNCTION (S$DAT)
5474: *
5475: {DATDV{DAC{0{{{SAVE VRBLK PTR FOR DATATYPE NAME
5476: {DATXS{DAC{0{{{SAVE INITIAL STACK POINTER
5477: *
5478: * WORK AREAS FOR DEFINE FUNCTION (S$DEF)
5479: *
5480: {DEFLB{DAC{0{{{SAVE VRBLK PTR FOR LABEL
5481: {DEFNA{DAC{0{{{COUNT FUNCTION ARGUMENTS
5482: {DEFVR{DAC{0{{{SAVE VRBLK PTR FOR FUNCTION NAME
5483: {DEFXS{DAC{0{{{SAVE INITIAL STACK POINTER
5484: *
5485: * WORK AREAS FOR DUMPR PROCEDURE
5486: *
5487: {DMARG{DAC{0{{{DUMP ARGUMENT
5488: {DMPKB{DAC{B$KVT{{{DUMMY KVBLK FOR USE IN DUMPR
5489: {DMPKT{DAC{TRBKV{{{KVVAR TRBLK POINTER
5490: {DMPKN{DAC{0{{{KEYWORD NUMBER (MUST FOLLOW DMPKB)
5491: {DMPSA{DAC{0{{{PRESERVE WA OVER PRTVL CALL
5492: {DMPSV{DAC{0{{{GENERAL SCRATCH SAVE
5493: {DMVCH{DAC{0{{{CHAIN POINTER FOR VARIABLE BLOCKS
5494: {DMPCH{DAC{0{{{SAVE SORTED VRBLK CHAIN POINTER
5495: *
5496: * GLOBAL LOCATIONS FOR DYNAMIC STORAGE POINTERS
5497: *
5498: {DNAMB{DAC{0{{{START OF DYNAMIC AREA
5499: {DNAMP{DAC{0{{{NEXT AVAILABLE LOC IN DYNAMIC AREA
5500: {DNAME{DAC{0{{{END OF AVAILABLE DYNAMIC AREA
5501: *
5502: * WORK AREA FOR DTACH
5503: *
5504: {DTCNB{DAC{0{{{NAME BASE
5505: {DTCNM{DAC{0{{{NAME PTR
5506: *
5507: * WORK AREAS FOR DUPL FUNCTION (S$DUP)
5508: *
5509: {DUPSI{DIC{+0{{{STORE INTEGER STRING LENGTH
5510: *
5511: * WORK AREA FOR ENDFILE (S$ENF)
5512: *
5513: {ENFCH{DAC{0{{{FOR IOCHN CHAIN HEAD
5514: *
5515: * WORK AREA FOR ERROR PROCESSING.
5516: *
5517: {ERICH{DAC{0{{{COPY ERROR REPORTS TO INT.CHAN IF 1
5518: {ERLST{DAC{0{{{FOR LISTR WHEN ERRORS GO TO INT.CH.
5519: {ERRFT{DAC{0{{{FATAL ERROR FLAG
5520: {ERRSP{DAC{0{{{ERROR SUPPRESSION FLAG
5521: {{EJC{{{{
5522: *
5523: * DUMP AREA FOR ERTEX
5524: *
5525: {ERTWA{DAC{0{{{SAVE WA
5526: {ERTWB{DAC{0{{{SAVE WB
5527: *
5528: * GLOBAL VALUES FOR EVALI
5529: *
5530: {EVLIN{DAC{P$LEN{{{DUMMY PATTERN BLOCK PCODE
5531: {EVLIS{DAC{0{{{POINTER TO SUBSEQUENT NODE
5532: {EVLIV{DAC{0{{{VALUE OF PARAMETER
5533: * WORK AREA FOR EXPAN
5534: *
5535: {EXPSV{DAC{0{{{SAVE OP DOPE VECTOR POINTER
5536: *
5537: * FLAG FOR SUPPRESSION OF EXECUTION STATS
5538: *
5539: {EXSTS{DAC{0{{{SUPPRESS EXEC STATS IF SET
5540: *
5541: * GLOBAL VALUES FOR EXFAL AND RETURN
5542: *
5543: {FLPRT{DAC{0{{{LOCATION OF FAIL OFFSET FOR RETURN
5544: {FLPTR{DAC{0{{{LOCATION OF FAILURE OFFSET ON STACK
5545: *
5546: * WORK AREAS FOR GBCOL PROCEDURE
5547: *
5548: {GBCFL{DAC{0{{{GARBAGE COLLECTOR ACTIVE FLAG
5549: {GBCLM{DAC{0{{{POINTER TO LAST MOVE BLOCK (PASS 3)
5550: {GBCNM{DAC{0{{{DUMMY FIRST MOVE BLOCK
5551: {GBCNS{DAC{0{{{REST OF DUMMY BLOCK (FOLLOWS GBCNM)
5552: {GBSVA{DAC{0{{{SAVE WA
5553: {GBSVB{DAC{0{{{SAVE WB
5554: {GBSVC{DAC{0{{{SAVE WC
5555: *
5556: * GLOBAL LOCATION TO COUNT GARBAGE COLLECTIONS (GBCOL)
5557: *
5558: {GBCNT{DAC{0{{{COUNT OF GARBAGE COLLECTIONS
5559: *
5560: * WORK AREAS FOR GTNVR PROCEDURE
5561: *
5562: {GNVHE{DAC{0{{{PTR TO END OF HASH CHAIN
5563: {GNVNW{DAC{0{{{NUMBER OF WORDS IN STRING NAME
5564: {GNVSA{DAC{0{{{SAVE WA
5565: {GNVSB{DAC{0{{{SAVE WB
5566: {GNVSP{DAC{0{{{POINTER INTO VSRCH TABLE
5567: {GNVST{DAC{0{{{POINTER TO CHARS OF STRING
5568: *
5569: * GLOBAL VALUE FOR GTCOD AND GTEXP
5570: *
5571: {GTCEF{DAC{0{{{SAVE FAIL PTR IN CASE OF ERROR
5572: *
5573: * WORK AREAS FOR GTINT
5574: *
5575: {GTINA{DAC{0{{{SAVE WA
5576: {GTINB{DAC{0{{{SAVE WB
5577: {{EJC{{{{
5578: *
5579: * WORK AREAS FOR GTNUM PROCEDURE
5580: *
5581: {GTNNF{DAC{0{{{ZERO/NONZERO FOR RESULT +/-
5582: {GTNSI{DIC{+0{{{GENERAL INTEGER SAVE
5583: {GTNDF{DAC{0{{{0/1 FOR DEC POINT SO FAR NO/YES
5584: {GTNES{DAC{0{{{ZERO/NONZERO EXPONENT +/-
5585: {GTNEX{DIC{+0{{{REAL EXPONENT
5586: {GTNSC{DAC{0{{{SCALE (PLACES AFTER POINT)
5587: {GTNSR{DRC{+0.0{{{GENERAL REAL SAVE
5588: {GTNRD{DAC{0{{{FLAG FOR OK REAL NUMBER
5589: *
5590: * WORK AREAS FOR GTPAT PROCEDURE
5591: *
5592: {GTPSB{DAC{0{{{SAVE WB
5593: *
5594: * WORK AREAS FOR GTSTG PROCEDURE
5595: *
5596: {GTSSF{DAC{0{{{0/1 FOR RESULT +/-
5597: {GTSVC{DAC{0{{{SAVE WC
5598: {GTSVB{DAC{0{{{SAVE WB
5599: {GTSWK{DAC{0{{{PTR TO WORK AREA FOR GTSTG
5600: {GTSES{DAC{0{{{CHAR + OR - FOR EXPONENT +/-
5601: {GTSRS{DRC{+0.0{{{GENERAL REAL SAVE
5602: *
5603: * GLOBAL LOCATIONS (CONSTANTS) FOR GTSTG PROCEDURE
5604: *
5605: {GTSRN{DRC{+0.0{{{ROUNDING FACTOR 0.5*10**-CFP$S
5606: {GTSSC{DRC{+0.0{{{SCALING VALUE 10**CFP$S
5607: *
5608: * WORK AREAS FOR GTVAR PROCEDURE
5609: *
5610: {GTVRC{DAC{0{{{SAVE WC
5611: *
5612: * FLAG FOR HEADER PRINTING
5613: *
5614: {HEADP{DAC{0{{{HEADER PRINTED FLAG
5615: *
5616: * GLOBAL VALUES FOR VARIABLE HASH TABLE
5617: *
5618: {HSHNB{DIC{+0{{{NUMBER OF HASH BUCKETS
5619: {HSHTB{DAC{0{{{POINTER TO START OF VRBLK HASH TABL
5620: {HSHTE{DAC{0{{{POINTER PAST END OF VRBLK HASH TABL
5621: *
5622: * WORK AREA FOR INIT
5623: *
5624: {INISS{DAC{0{{{SAVE SUBROUTINE STACK PTR
5625: {INITR{DAC{0{{{SAVE TERMINAL FLAG
5626: *
5627: * SAVE AREA FOR INSBF
5628: *
5629: {INSAB{DAC{0{{{ENTRY WA + ENTRY WB
5630: {INSSA{DAC{0{{{SAVE ENTRY WA
5631: {INSSB{DAC{0{{{SAVE ENTRY WB
5632: {INSSC{DAC{0{{{SAVE ENTRY WC
5633: *
5634: * WORK AREAS FOR IOPUT
5635: *
5636: {IOPTT{DAC{0{{{TYPE OF ASSOCIATION
5637: {{EJC{{{{
5638: *
5639: * GLOBAL VALUES FOR KEYWORD VALUES WHICH ARE STORED AS ONE
5640: * WORD INTEGERS. THESE VALUES MUST BE ASSEMBLED IN THE
5641: * FOLLOWING ORDER (AS DICTATED BY K$XXX DEFINITION VALUES).
5642: *
5643: {KVABE{DAC{0{{{ABEND
5644: {KVANC{DAC{0{{{ANCHOR
5645: {KVCAS{DAC{0{{{CASE
5646: {KVCOD{DAC{0{{{CODE
5647: {KVDMP{DAC{0{{{DUMP
5648: {KVERL{DAC{0{{{ERRLIMIT
5649: {KVERT{DAC{0{{{ERRTYPE
5650: {KVFTR{DAC{0{{{FTRACE
5651: {KVINP{DAC{1{{{INPUT
5652: {KVMXL{DAC{5000{{{MAXLENGTH
5653: {KVOUP{DAC{1{{{OUTPUT
5654: {KVPFL{DAC{0{{{PROFILE
5655: {KVTRA{DAC{0{{{TRACE
5656: {KVTRM{DAC{0{{{TRIM
5657: {KVFNC{DAC{0{{{FNCLEVEL
5658: {KVLST{DAC{0{{{LASTNO
5659: {KVSTN{DAC{0{{{STNO
5660: *
5661: * GLOBAL VALUES FOR OTHER KEYWORDS
5662: *
5663: {KVALP{DAC{0{{{ALPHABET
5664: {KVRTN{DAC{NULLS{{{RTNTYPE (SCBLK POINTER)
5665: {KVSTL{DIC{+50000{{{STLIMIT
5666: {KVSTC{DIC{+50000{{{STCOUNT (COUNTS DOWN FROM STLIMIT)
5667: *
5668: * WORK AREAS FOR LOAD FUNCTION
5669: *
5670: {LODFN{DAC{0{{{POINTER TO VRBLK FOR FUNC NAME
5671: {LODNA{DAC{0{{{COUNT NUMBER OF ARGUMENTS
5672: *
5673: * GLOBAL VALUES FOR LISTR PROCEDURE
5674: *
5675: {LSTLC{DAC{0{{{COUNT LINES ON SOURCE LIST PAGE
5676: {LSTNP{DAC{0{{{MAX NUMBER OF LINES ON PAGE
5677: {LSTPF{DAC{1{{{SET NONZERO IF CURRENT IMAGE LISTED
5678: {LSTPG{DAC{0{{{CURRENT SOURCE LIST PAGE NUMBER
5679: {LSTPO{DAC{0{{{OFFSET TO PAGE NNN MESSAGE
5680: {LSTSN{DAC{0{{{REMEMBER LAST STMNUM LISTED
5681: *
5682: * MAXIMUM SIZE OF SPITBOL OBJECTS
5683: *
5684: {MXLEN{DAC{0{{{INITIALISED BY SYSMX CALL
5685: *
5686: * EXECUTION CONTROL VARIABLE
5687: *
5688: {NOXEQ{DAC{0{{{SET NON-ZERO TO INHIBIT EXECUTION
5689: *
5690: * PROFILER GLOBAL VALUES AND WORK LOCATIONS
5691: *
5692: {PFDMP{DAC{0{{{SET NON-0 IF &PROFILE SET NON-0
5693: {PFFNC{DAC{0{{{SET NON-0 IF FUNCT JUST ENTERED
5694: {PFSTM{DIC{+0{{{TO STORE STARTING TIME OF STMT
5695: {PFETM{DIC{+0{{{TO STORE ENDING TIME OF STMT
5696: {PFSVW{DAC{0{{{TO SAVE A W-REG
5697: {PFTBL{DAC{0{{{GETS ADRS OF (IMAG) TABLE BASE
5698: {PFNTE{DAC{0{{{NR OF TABLE ENTRIES
5699: {PFSTE{DIC{+0{{{GETS INT REP OF TABLE ENTRY SIZE
5700: *
5701: {{EJC{{{{
5702: *
5703: * GLOBAL VALUES USED IN PATTERN MATCH ROUTINES
5704: *
5705: {PMDFL{DAC{0{{{PATTERN ASSIGNMENT FLAG
5706: {PMHBS{DAC{0{{{HISTORY STACK BASE POINTER
5707: {PMSSL{DAC{0{{{LENGTH OF SUBJECT STRING IN CHARS
5708: *
5709: * FLAGS USED FOR STANDARD FILE LISTING OPTIONS
5710: *
5711: {PRICH{DAC{0{{{PRINTER ON INTERACTIVE CHANNEL
5712: {PRSTD{DAC{0{{{TESTED BY PRTPG
5713: {PRSTO{DAC{0{{{STANDARD LISTING OPTION FLAG
5714: *
5715: * GLOBAL VALUE FOR PRTNM PROCEDURE
5716: *
5717: {PRNMV{DAC{0{{{VRBLK PTR FROM LAST NAME SEARCH
5718: *
5719: * WORK AREAS FOR PRTNM PROCEDURE
5720: *
5721: {PRNSI{DIC{+0{{{SCRATCH INTEGER LOC
5722: *
5723: * WORK AREAS FOR PRTSN PROCEDURE
5724: *
5725: {PRSNA{DAC{0{{{SAVE WA
5726: *
5727: * GLOBAL VALUES FOR PRINT PROCEDURES
5728: *
5729: {PRBUF{DAC{0{{{PTR TO PRINT BFR IN STATIC
5730: {PRECL{DAC{0{{{EXTENDED/COMPACT LISTING FLAG
5731: {PRLEN{DAC{0{{{LENGTH OF PRINT BUFFER IN CHARS
5732: {PRLNW{DAC{0{{{LENGTH OF PRINT BUFFER IN WORDS
5733: {PROFS{DAC{0{{{OFFSET TO NEXT LOCATION IN PRBUF
5734: {PRTEF{DAC{0{{{ENDFILE FLAG
5735: *
5736: * WORK AREAS FOR PRTST PROCEDURE
5737: *
5738: {PRSVA{DAC{0{{{SAVE WA
5739: {PRSVB{DAC{0{{{SAVE WB
5740: {PRSVC{DAC{0{{{SAVE CHAR COUNTER
5741: *
5742: * WORK AREA FOR PRTNL
5743: *
5744: {PRTSA{DAC{0{{{SAVE WA
5745: {PRTSB{DAC{0{{{SAVE WB
5746: *
5747: * WORK AREA FOR PRTVL
5748: *
5749: {PRVSI{DAC{0{{{SAVE IDVAL
5750: *
5751: * WORK AREAS FOR PATTERN MATCH ROUTINES
5752: *
5753: {PSAVE{DAC{0{{{TEMPORARY SAVE FOR CURRENT NODE PTR
5754: {PSAVC{DAC{0{{{SAVE CURSOR IN P$SPN, P$STR
5755: {{EJC{{{{
5756: *
5757: * AMOUNT OF MEMORY RESERVED FOR END OF EXECUTION
5758: *
5759: {RSMEM{DAC{0{{{RESERVE MEMORY
5760: *
5761: * WORK AREAS FOR RETRN ROUTINE
5762: *
5763: {RTNBP{DAC{0{{{TO SAVE A BLOCK POINTER
5764: {RTNFV{DAC{0{{{NEW FUNCTION VALUE (RESULT)
5765: {RTNSV{DAC{0{{{OLD FUNCTION VALUE (SAVED VALUE)
5766: *
5767: * RELOCATABLE GLOBAL VALUES
5768: *
5769: * ALL THE POINTERS IN THIS SECTION CAN POINT TO BLOCKS IN
5770: * THE DYNAMIC STORAGE AREA AND MUST BE RELOCATED BY THE
5771: * GARBAGE COLLECTOR. THEY ARE IDENTIFIED BY R$XXX NAMES.
5772: *
5773: {R$AAA{DAC{0{{{START OF RELOCATABLE VALUES
5774: {R$ARF{DAC{0{{{ARRAY BLOCK POINTER FOR ARREF
5775: {R$CCB{DAC{0{{{PTR TO CCBLK BEING BUILT (CDWRD)
5776: {R$CIM{DAC{0{{{PTR TO CURRENT COMPILER INPUT STR
5777: {R$CMP{DAC{0{{{COPY OF R$CIM USED IN CMPIL
5778: {R$CNI{DAC{0{{{PTR TO NEXT COMPILER INPUT STRING
5779: {R$CNT{DAC{0{{{CDBLK POINTER FOR SETEXIT CONTINUE
5780: {R$COD{DAC{0{{{POINTER TO CURRENT CDBLK OR EXBLK
5781: {R$CTP{DAC{0{{{PTR TO CURRENT CTBLK FOR PATST
5782: {R$ERT{DAC{0{{{TRBLK POINTER FOR ERRTYPE TRACE
5783: {R$ETX{DAC{NULLS{{{POINTER TO ERRTEXT STRING
5784: {R$EXS{DAC{0{{{= SAVE XL IN EXPDM
5785: {R$FCB{DAC{0{{{FCBLK CHAIN HEAD
5786: {R$FNC{DAC{0{{{TRBLK POINTER FOR FNCLEVEL TRACE
5787: {R$GTC{DAC{0{{{KEEP CODE PTR FOR GTCOD,GTEXP
5788: {R$IO1{DAC{0{{{FILE ARG1 FOR IOPUT
5789: {R$IO2{DAC{0{{{FILE ARG2 FOR IOPUT
5790: {R$IOF{DAC{0{{{FCBLK PTR OR 0
5791: {R$ION{DAC{0{{{NAME BASE PTR
5792: {R$IOP{DAC{0{{{PREDECESSOR BLOCK PTR FOR IOPUT
5793: {R$IOT{DAC{0{{{TRBLK PTR FOR IOPUT
5794: {R$PMB{DAC{0{{{BUFFER PTR IN PATTERN MATCH
5795: {R$PMS{DAC{0{{{SUBJECT STRING PTR IN PATTERN MATCH
5796: {R$RA2{DAC{0{{{REPLACE SECOND ARGUMENT LAST TIME
5797: {R$RA3{DAC{0{{{REPLACE THIRD ARGUMENT LAST TIME
5798: {R$RPT{DAC{0{{{PTR TO CTBLK REPLACE TABLE LAST USD
5799: {R$SCP{DAC{0{{{SAVE POINTER FROM LAST SCANE CALL
5800: {R$SXL{DAC{0{{{PRESERVE XL IN SORTC
5801: {R$SXR{DAC{0{{{PRESERVE XR IN SORTA/SORTC
5802: {R$STC{DAC{0{{{TRBLK POINTER FOR STCOUNT TRACE
5803: {R$STL{DAC{0{{{SOURCE LISTING SUB-TITLE
5804: {R$SXC{DAC{0{{{CODE (CDBLK) PTR FOR SETEXIT TRAP
5805: {R$TTL{DAC{NULLS{{{SOURCE LISTING TITLE
5806: {R$XSC{DAC{0{{{STRING POINTER FOR XSCAN
5807: {{EJC{{{{
5808: *
5809: * THE REMAINING POINTERS IN THIS LIST ARE USED TO POINT
5810: * TO FUNCTION BLOCKS FOR NORMALLY UNDEFINED OPERATORS.
5811: *
5812: {R$UBA{DAC{STNDO{{{BINARY AT
5813: {R$UBM{DAC{STNDO{{{BINARY AMPERSAND
5814: {R$UBN{DAC{STNDO{{{BINARY NUMBER SIGN
5815: {R$UBP{DAC{STNDO{{{BINARY PERCENT
5816: {R$UBT{DAC{STNDO{{{BINARY NOT
5817: {R$UUB{DAC{STNDO{{{UNARY VERTICAL BAR
5818: {R$UUE{DAC{STNDO{{{UNARY EQUAL
5819: {R$UUN{DAC{STNDO{{{UNARY NUMBER SIGN
5820: {R$UUP{DAC{STNDO{{{UNARY PERCENT
5821: {R$UUS{DAC{STNDO{{{UNARY SLASH
5822: {R$UUX{DAC{STNDO{{{UNARY EXCLAMATION
5823: {R$YYY{DAC{0{{{LAST RELOCATABLE LOCATION
5824: *
5825: * WORK AREAS FOR SUBSTR FUNCTION (S$SUB)
5826: *
5827: {SBSSV{DAC{0{{{SAVE THIRD ARGUMENT
5828: *
5829: * GLOBAL LOCATIONS USED IN SCAN PROCEDURE
5830: *
5831: {SCNBL{DAC{0{{{SET NON-ZERO IF SCANNED PAST BLANKS
5832: {SCNCC{DAC{0{{{NON-ZERO TO SCAN CONTROL CARD NAME
5833: {SCNGO{DAC{0{{{SET NON-ZERO TO SCAN GOTO FIELD
5834: {SCNIL{DAC{0{{{LENGTH OF CURRENT INPUT IMAGE
5835: {SCNPT{DAC{0{{{POINTER TO NEXT LOCATION IN R$CIM
5836: {SCNRS{DAC{0{{{SET NON-ZERO TO SIGNAL RESCAN
5837: {SCNTP{DAC{0{{{SAVE SYNTAX TYPE FROM LAST CALL
5838: *
5839: * WORK AREAS FOR SCAN PROCEDURE
5840: *
5841: {SCNSA{DAC{0{{{SAVE WA
5842: {SCNSB{DAC{0{{{SAVE WB
5843: {SCNSC{DAC{0{{{SAVE WC
5844: {SCNSE{DAC{0{{{START OF CURRENT ELEMENT
5845: {SCNOF{DAC{0{{{SAVE OFFSET
5846: {{EJC{{{{
5847: *
5848: * WORK AREA USED BY SORTA, SORTC, SORTF, SORTH
5849: *
5850: {SRTDF{DAC{0{{{DATATYPE FIELD NAME
5851: {SRTFD{DAC{0{{{FOUND DFBLK ADDRESS
5852: {SRTFF{DAC{0{{{FOUND FIELD NAME
5853: {SRTFO{DAC{0{{{OFFSET TO FIELD NAME
5854: {SRTNR{DAC{0{{{NUMBER OF ROWS
5855: {SRTOF{DAC{0{{{OFFSET WITHIN ROW TO SORT KEY
5856: {SRTRT{DAC{0{{{ROOT OFFSET
5857: {SRTS1{DAC{0{{{SAVE OFFSET 1
5858: {SRTS2{DAC{0{{{SAVE OFFSET 2
5859: {SRTSC{DAC{0{{{SAVE WC
5860: {SRTSF{DAC{0{{{SORT ARRAY FIRST ROW OFFSET
5861: {SRTSN{DAC{0{{{SAVE N
5862: {SRTSO{DAC{0{{{OFFSET TO A(0)
5863: {SRTSR{DAC{0{{{0 , NON-ZERO FOR SORT, RSORT
5864: {SRTST{DAC{0{{{STRIDE FROM ONE ROW TO NEXT
5865: {SRTWC{DAC{0{{{DUMP WC
5866: *
5867: * GLOBAL VALUE FOR INDICATING STAGE (SEE ERROR SECTION)
5868: *
5869: {STAGE{DAC{0{{{INITIAL VALUE = INITIAL COMPILE
5870: *
5871: * GLOBAL VALUES DEFINING EXTENT OF STATIC AREA (ALOST)
5872: *
5873: {STATB{DAC{0{{{START OF STATIC AREA
5874: {STATE{DAC{0{{{END OF STATIC AREA
5875: {{EJC{{{{
5876: *
5877: * GLOBAL STACK POINTER
5878: *
5879: {STBAS{DAC{0{{{POINTER PAST STACK BASE
5880: *
5881: * WORK AREAS FOR STOPR ROUTINE
5882: *
5883: {STPSI{DIC{+0{{{SAVE VALUE OF STCOUNT
5884: {STPTI{DIC{+0{{{SAVE TIME ELAPSED
5885: *
5886: * GLOBAL VALUES FOR SETEXIT FUNCTION (S$STX)
5887: *
5888: {STXOF{DAC{0{{{FAILURE OFFSET
5889: {STXVR{DAC{NULLS{{{VRBLK POINTER OR NULL
5890: *
5891: * WORK AREAS FOR TFIND PROCEDURE
5892: *
5893: {TFNSI{DIC{+0{{{NUMBER OF HEADERS
5894: *
5895: * GLOBAL VALUE FOR TIME KEEPING
5896: *
5897: {TIMSX{DIC{+0{{{TIME AT START OF EXECUTION
5898: {TIMUP{DAC{0{{{SET WHEN TIME UP OCCURS
5899: *
5900: * WORK AREAS FOR XSCAN PROCEDURE
5901: *
5902: {XSCRT{DAC{0{{{SAVE RETURN CODE
5903: {XSCWB{DAC{0{{{SAVE REGISTER WB
5904: *
5905: * GLOBAL VALUES FOR XSCAN AND XSCNI PROCEDURES
5906: *
5907: {XSOFS{DAC{0{{{OFFSET TO CURRENT LOCATION IN R$XSC
5908: *
5909: * LABEL TO MARK END OF WORK AREA
5910: *
5911: {YYYYY{DAC{0{{{
5912: {{TTL{S{{{P I T B O L -- INITIALIZATION
5913: *
5914: * INITIALISATION
5915: * THE FOLLOWING SECTION RECEIVES CONTROL FROM THE SYSTEM
5916: * AT THE START OF A RUN WITH THE REGISTERS SET AS FOLLOWS.
5917: *
5918: * (XS) POINTS PAST STACK BASE
5919: * (XR) POINTS TO FIRST WORD OF DATA AREA
5920: * (XL) POINTS TO LAST WORD OF DATA AREA
5921: *
5922: {{SEC{{{{START OF PROGRAM SECTION
5923: {{JSR{SYSTM{{{INITIALISE TIMER
5924: *
5925: * INITIALISE WORK AREA (ESSENTIAL FOR BATCHED RUNS)
5926: *
5927: {{MOV{R9{R7{{PRESERVE XR
5928: {{MOV{#YYYYY{R6{{POINT TO END OF WORK AREA
5929: {{SUB{#AAAAA{R6{{GET LENGTH OF WORK AREA
5930: {{BTW{R6{{{CONVERT TO WORDS
5931: {{LCT{R6{R6{{COUNT FOR LOOP
5932: {{MOV{#AAAAA{R9{{SET UP INDEX REGISTER
5933: *
5934: * CLEAR WORK SPACE
5935: *
5936: {INI01{ZER{(R9)+{{{CLEAR A WORD
5937: {{BCT{R6{INI01{{LOOP TILL DONE
5938: {{MOV{#STNDO{R6{{UNDEFINED OPERATORS POINTER
5939: {{MOV{#R$YYY{R8{{POINT TO TABLE END
5940: {{SUB{#R$UBA{R8{{LENGTH OF UNDEF. OPERATORS TABLE
5941: {{BTW{R8{{{CONVERT TO WORDS
5942: {{LCT{R8{R8{{LOOP COUNTER
5943: {{MOV{#R$UBA{R9{{SET UP XR
5944: *
5945: * SET CORRECT VALUE INTO UNDEFINED OPERATORS TABLE
5946: *
5947: {INI02{MOV{R6{(R9)+{{STORE VALUE
5948: {{BCT{R8{INI02{{LOOP TILL ALL DONE
5949: {{MOV{#NUM01{R6{{GET A 1
5950: {{MOV{R6{CMPSN{{STATEMENT NO
5951: {{MOV{R6{CSWFL{{NOFAIL
5952: {{MOV{R6{CSWLS{{LIST
5953: {{MOV{R6{KVINP{{INPUT
5954: {{MOV{R6{KVOUP{{OUTPUT
5955: {{MOV{R6{LSTPF{{NOTHING FOR LISTR YET
5956: {{MOV{#INILN{R6{{INPUT IMAGE LENGTH
5957: {{MOV{R6{CSWIN{{-IN72
5958: {{MOV{#B$KVT{DMPKB{{DUMP
5959: {{MOV{#TRBKV{DMPKT{{DUMP
5960: {{MOV{#P$LEN{EVLIN{{EVAL
5961: {{EJC{{{{
5962: {{MOV{#NULLS{R6{{GET NULLSTRING POINTER
5963: {{MOV{R6{KVRTN{{RETURN
5964: {{MOV{R6{R$ETX{{ERRTEXT
5965: {{MOV{R6{R$TTL{{TITLE FOR LISTING
5966: {{MOV{R6{STXVR{{SETEXIT
5967: {{STI{TIMSX{{{STORE TIME IN CORRECT PLACE
5968: {{LDI{STLIM{{{GET DEFAULT STLIMIT
5969: {{STI{KVSTL{{{STATEMENT LIMIT
5970: {{STI{KVSTC{{{STATEMENT COUNT
5971: {{MOV{R7{STATB{{STORE START ADRS OF STATIC
5972: {{MOV{#4*E$SRS{RSMEM{{RESERVE MEMORY
5973: {{MOV{SP{STBAS{{STORE STACK BASE
5974: {{SSS{INISS{{{SAVE S-R STACK PTR
5975: *
5976: * NOW CONVERT FREE STORE PERCENTAGE TO A SUITABLE FACTOR
5977: * FOR EASY TESTING IN ALLOC ROUTINE.
5978: *
5979: {{LDI{INTVH{{{GET 100
5980: {{DVI{ALFSP{{{FORM 100 / ALFSP
5981: {{STI{ALFSF{{{STORE THE FACTOR
5982: *
5983: * INITIALIZE VALUES FOR REAL CONVERSION ROUTINE
5984: *
5985: {{LCT{R7{#CFP$S{{LOAD COUNTER FOR SIGNIFICANT DIGITS
5986: {{LDR{REAV1{{{LOAD 1.0
5987: *
5988: * LOOP TO COMPUTE 10**(MAX NUMBER SIGNIFICANT DIGITS)
5989: *
5990: {INI03{MLR{REAVT{{{* 10.0
5991: {{BCT{R7{INI03{{LOOP TILL DONE
5992: {{STR{GTSSC{{{STORE 10**(MAX SIG DIGITS)
5993: {{LDR{REAP5{{{LOAD 0.5
5994: {{DVR{GTSSC{{{COMPUTE 0.5*10**(MAX SIG DIGITS)
5995: {{STR{GTSRN{{{STORE AS ROUNDING BIAS
5996: {{ZER{R8{{{SET TO READ PARAMETERS
5997: {{JSR{PRPAR{{{READ THEM
5998: {{EJC{{{{
5999: *
6000: * NOW COMPUTE STARTING ADDRESS FOR DYNAMIC STORE AND IF
6001: * NECESSARY REQUEST MORE MEMORY.
6002: *
6003: {{SUB{#4*E$SRS{R10{{ALLOW FOR RESERVE MEMORY
6004: {{MOV{PRLEN{R6{{GET PRINT BUFFER LENGTH
6005: {{ADD{#CFP$A{R6{{ADD NO. OF CHARS IN ALPHABET
6006: {{ADD{#NSTMX{R6{{ADD CHARS FOR GTSTG BFR
6007: {{CTB{R6{8{{CONVERT TO BYTES, ALLOWING A MARGIN
6008: {{MOV{STATB{R9{{POINT TO STATIC BASE
6009: {{ADD{R6{R9{{INCREMENT FOR ABOVE BUFFERS
6010: {{ADD{#4*E$HNB{R9{{INCREMENT FOR HASH TABLE
6011: {{ADD{#4*E$STS{R9{{BUMP FOR INITIAL STATIC BLOCK
6012: {{JSR{SYSMX{{{GET MXLEN
6013: {{MOV{R6{KVMXL{{PROVISIONALLY STORE AS MAXLNGTH
6014: {{MOV{R6{MXLEN{{AND AS MXLEN
6015: {{BGT{R9{R6{INI06{SKIP IF STATIC HI EXCEEDS MXLEN
6016: {{MOV{R6{R9{{USE MXLEN INSTEAD
6017: {{ICA{R9{{{MAKE BIGGER THAN MXLEN
6018: *
6019: * HERE TO STORE VALUES WHICH MARK INITIAL DIVISION
6020: * OF DATA AREA INTO STATIC AND DYNAMIC
6021: *
6022: {INI06{MOV{R9{DNAMB{{DYNAMIC BASE ADRS
6023: {{MOV{R9{DNAMP{{DYNAMIC PTR
6024: {{BNZ{R6{INI07{{SKIP IF NON-ZERO MXLEN
6025: {{DCA{R9{{{POINT A WORD IN FRONT
6026: {{MOV{R9{KVMXL{{USE AS MAXLNGTH
6027: {{MOV{R9{MXLEN{{AND AS MXLEN
6028: {{EJC{{{{
6029: *
6030: * LOOP HERE IF NECESSARY TILL ENOUGH MEMORY OBTAINED
6031: * SO THAT DNAME IS ABOVE DNAMB
6032: *
6033: {INI07{MOV{R10{DNAME{{STORE DYNAMIC END ADDRESS
6034: {{BLT{DNAMB{R10{INI09{SKIP IF HIGH ENOUGH
6035: {{JSR{SYSMM{{{REQUEST MORE MEMORY
6036: {{WTB{R9{{{GET AS BAUS (SGD05)
6037: {{ADD{R9{R10{{BUMP BY AMOUNT OBTAINED
6038: {{BNZ{R9{INI07{{TRY AGAIN
6039: {{MOV{#ENDMO{R9{{POINT TO FAILURE MESSAGE
6040: {{MOV{ENDML{R6{{MESSAGE LENGTH
6041: {{JSR{SYSPR{{{PRINT IT (PRTST NOT YET USABLE)
6042: {{PPM{{{{SHOULD NOT FAIL
6043: {{JSR{SYSEJ{{{PACK UP (STOPR NOT YET USABLE)
6044: *
6045: * INITIALISE PRINT BUFFER WITH BLANK WORDS
6046: *
6047: {INI09{MOV{PRLEN{R8{{NO. OF CHARS IN PRINT BFR
6048: {{MOV{STATB{R9{{POINT TO STATIC AGAIN
6049: {{MOV{R9{PRBUF{{PRINT BFR IS PUT AT STATIC START
6050: {{MOV{#B$SCL{(R9)+{{STORE STRING TYPE CODE
6051: {{MOV{R8{(R9)+{{AND STRING LENGTH
6052: {{CTW{R8{0{{GET NUMBER OF WORDS IN BUFFER
6053: {{MOV{R8{PRLNW{{STORE FOR BUFFER CLEAR
6054: {{LCT{R8{R8{{WORDS TO CLEAR
6055: *
6056: * LOOP TO CLEAR BUFFER
6057: *
6058: {INI10{MOV{NULLW{(R9)+{{STORE BLANK
6059: {{BCT{R8{INI10{{LOOP
6060: *
6061: * INITIALIZE NUMBER OF HASH HEADERS
6062: *
6063: {{MOV{#E$HNB{R6{{GET NUMBER OF HASH HEADERS
6064: {{MTI{R6{{{CONVERT TO INTEGER
6065: {{STI{HSHNB{{{STORE FOR USE BY GTNVR PROCEDURE
6066: {{LCT{R6{R6{{COUNTER FOR CLEARING HASH TABLE
6067: {{MOV{R9{HSHTB{{POINTER TO HASH TABLE
6068: *
6069: * LOOP TO CLEAR HASH TABLE
6070: *
6071: {INI11{ZER{(R9)+{{{BLANK A WORD
6072: {{BCT{R6{INI11{{LOOP
6073: {{MOV{R9{HSHTE{{END OF HASH TABLE ADRS IS KEPT
6074: *
6075: * ALLOCATE WORK AREA FOR GTSTG CONVERSION PROCEDURE
6076: *
6077: {{MOV{#NSTMX{R6{{GET MAX NUM CHARS IN OUTPUT NUMBER
6078: {{CTB{R6{SCSI${{NO OF BYTES NEEDED
6079: {{MOV{R9{GTSWK{{STORE BFR ADRS
6080: {{ADD{R6{R9{{BUMP FOR WORK BFR
6081: {{EJC{{{{
6082: *
6083: * BUILD ALPHABET STRING FOR ALPHABET KEYWORD AND REPLACE
6084: *
6085: {{MOV{R9{KVALP{{SAVE ALPHABET POINTER
6086: {{MOV{#B$SCL{(R9){{STRING BLK TYPE
6087: {{MOV{#CFP$A{R8{{NO OF CHARS IN ALPHABET
6088: {{MOV{R8{4*SCLEN(R9){{STORE AS STRING LENGTH
6089: {{MOV{R8{R7{{COPY CHAR COUNT
6090: {{CTB{R7{SCSI${{NO. OF BYTES NEEDED
6091: {{ADD{R9{R7{{CURRENT END ADDRESS FOR STATIC
6092: {{MOV{R7{STATE{{STORE STATIC END ADRS
6093: {{LCT{R8{R8{{LOOP COUNTER
6094: {{PSC{R9{{{POINT TO CHARS OF STRING
6095: {{ZER{R7{{{SET INITIAL CHARACTER VALUE
6096: *
6097: * LOOP TO ENTER CHARACTER CODES IN ORDER
6098: *
6099: {INI12{SCH{R7{(R9)+{{STORE NEXT CODE
6100: {{ICV{R7{{{BUMP CODE VALUE
6101: {{BCT{R8{INI12{{LOOP TILL ALL STORED
6102: {{CSC{R9{{{COMPLETE STORE CHARACTERS
6103: *
6104: * INITIALIZE VARIABLE BLOCKS FOR INPUT AND OUTPUT
6105: *
6106: {{MOV{#V$INP{R10{{POINT TO STRING /INPUT/
6107: {{MOV{#TRTIN{R7{{TRBLK TYPE FOR INPUT
6108: {{JSR{INOUT{{{PERFORM INPUT ASSOCIATION
6109: {{MOV{#V$OUP{R10{{POINT TO STRING /OUTPUT/
6110: {{MOV{#TRTOU{R7{{TRBLK TYPE FOR OUTPUT
6111: {{JSR{INOUT{{{PERFORM OUTPUT ASSOCIATION
6112: {{MOV{INITR{R8{{TERMINAL FLAG
6113: {{BZE{R8{INI13{{SKIP IF NO TERMINAL
6114: {{JSR{PRPAR{{{ASSOCIATE TERMINAL
6115: {{EJC{{{{
6116: *
6117: * CHECK FOR EXPIRY DATE
6118: *
6119: {INI13{JSR{SYSDC{{{CALL DATE CHECK
6120: {{MOV{SP{FLPTR{{IN CASE STACK OVERFLOWS IN COMPILER
6121: *
6122: * NOW COMPILE SOURCE INPUT CODE
6123: *
6124: {{JSR{CMPIL{{{CALL COMPILER
6125: {{MOV{R9{R$COD{{SET PTR TO FIRST CODE BLOCK
6126: {{MOV{#NULLS{R$TTL{{FORGET TITLE (REG04)
6127: {{MOV{#NULLS{R$STL{{FORGET SUB-TITLE (REG04)
6128: {{ZER{R$CIM{{{FORGET COMPILER INPUT IMAGE
6129: {{ZER{R10{{{CLEAR DUD VALUE
6130: {{ZER{R7{{{DONT SHIFT DYNAMIC STORE UP
6131: {{JSR{GBCOL{{{CLEAR GARBAGE LEFT FROM COMPILE
6132: {{BNZ{CPSTS{INIX0{{SKIP IF NO LISTING OF COMP STATS
6133: {{JSR{PRTPG{{{EJECT PAGE
6134: *
6135: * PRINT COMPILE STATISTICS
6136: *
6137: {{MOV{DNAMP{R6{{NEXT AVAILABLE LOC
6138: {{SUB{STATB{R6{{MINUS START
6139: {{BTW{R6{{{CONVERT TO WORDS
6140: {{MTI{R6{{{CONVERT TO INTEGER
6141: {{MOV{#ENCM1{R9{{POINT TO /MEMORY USED (WORDS)/
6142: {{JSR{PRTMI{{{PRINT MESSAGE
6143: {{MOV{DNAME{R6{{END OF MEMORY
6144: {{SUB{DNAMP{R6{{MINUS NEXT AVAILABLE LOC
6145: {{BTW{R6{{{CONVERT TO WORDS
6146: {{MTI{R6{{{CONVERT TO INTEGER
6147: {{MOV{#ENCM2{R9{{POINT TO /MEMORY AVAILABLE (WORDS)/
6148: {{JSR{PRTMI{{{PRINT LINE
6149: {{MTI{CMERC{{{GET COUNT OF ERRORS AS INTEGER
6150: {{MOV{#ENCM3{R9{{POINT TO /COMPILE ERRORS/
6151: {{JSR{PRTMI{{{PRINT IT
6152: {{MTI{GBCNT{{{GARBAGE COLLECTION COUNT
6153: {{SBI{INTV1{{{ADJUST FOR UNAVOIDABLE COLLECT
6154: {{MOV{#STPM5{R9{{POINT TO /STORAGE REGENERATIONS/
6155: {{JSR{PRTMI{{{PRINT GBCOL COUNT
6156: {{JSR{SYSTM{{{GET TIME
6157: {{SBI{TIMSX{{{GET COMPILATION TIME
6158: {{MOV{#ENCM4{R9{{POINT TO COMPILATION TIME (MSEC)/
6159: {{JSR{PRTMI{{{PRINT MESSAGE
6160: {{ADD{#NUM05{LSTLC{{BUMP LINE COUNT
6161: {{BZE{HEADP{INIX0{{NO EJECT IF NOTHING PRINTED (SDG11)
6162: {{JSR{PRTPG{{{EJECT PRINTER
6163: {{EJC{{{{
6164: *
6165: * PREPARE NOW TO START EXECUTION
6166: *
6167: * SET DEFAULT INPUT RECORD LENGTH
6168: *
6169: {INIX0{BGT{CSWIN{#INILN{INIX1{SKIP IF NOT DEFAULT -IN72 USED
6170: {{MOV{#INILS{CSWIN{{ELSE USE DEFAULT RECORD LENGTH
6171: *
6172: * RESET TIMER
6173: *
6174: {INIX1{JSR{SYSTM{{{GET TIME AGAIN
6175: {{STI{TIMSX{{{STORE FOR END RUN PROCESSING
6176: {{ADD{CSWEX{NOXEQ{{ADD -NOEXECUTE FLAG
6177: {{BNZ{NOXEQ{INIX2{{JUMP IF EXECUTION SUPPRESSED
6178: {{ZER{GBCNT{{{INITIALISE COLLECT COUNT
6179: {{JSR{SYSBX{{{CALL BEFORE STARTING EXECUTION
6180: *
6181: * MERGE WHEN LISTING FILE SET FOR EXECUTION
6182: *
6183: {INIY0{MNZ{HEADP{{{MARK HEADERS OUT REGARDLESS
6184: {{ZER{-(SP){{{SET FAILURE LOCATION ON STACK
6185: {{MOV{SP{FLPTR{{SAVE PTR TO FAILURE OFFSET WORD
6186: {{MOV{R$COD{R9{{LOAD PTR TO ENTRY CODE BLOCK
6187: {{MOV{#STGXT{STAGE{{SET STAGE FOR EXECUTE TIME
6188: {{MOV{CMPSN{PFNTE{{COPY STMTS COMPILED COUNT IN CASE
6189: {{JSR{SYSTM{{{TIME YET AGAIN
6190: {{STI{PFSTM{{{
6191: {{BRI{(R9){{{START XEQ WITH FIRST STATEMENT
6192: *
6193: * HERE IF EXECUTION IS SUPPRESSED
6194: *
6195: {INIX2{JSR{PRTNL{{{PRINT A BLANK LINE
6196: {{MOV{#ENCM5{R9{{POINT TO /EXECUTION SUPPRESSED/
6197: {{JSR{PRTST{{{PRINT STRING
6198: {{JSR{PRTNL{{{OUTPUT LINE
6199: {{ZER{R6{{{SET ABEND VALUE TO ZERO
6200: {{MOV{#NINI9{R7{{SET SPECIAL CODE VALUE
6201: {{JSR{SYSEJ{{{END OF JOB, EXIT TO SYSTEM
6202: {{TTL{S{{{P I T B O L -- SNOBOL4 OPERATOR ROUTINES
6203: *
6204: * THIS SECTION INCLUDES ALL ROUTINES WHICH CAN BE ACCESSED
6205: * DIRECTLY FROM THE GENERATED CODE EXCEPT SYSTEM FUNCTIONS.
6206: *
6207: * ALL ROUTINES IN THIS SECTION START WITH A LABEL OF THE
6208: * FORM O$XXX WHERE XXX IS THREE LETTERS. THE GENERATED CODE
6209: * CONTAINS A POINTER TO THE APPROPRIATE ENTRY LABEL.
6210: *
6211: * SINCE THE GENERAL FORM OF THE GENERATED CODE CONSISTS OF
6212: * POINTERS TO BLOCKS WHOSE FIRST WORD IS THE ADDRESS OF THE
6213: * ACTUAL ENTRY POINT LABEL (O$XXX).
6214: *
6215: * THESE ROUTINES ARE IN ALPHABETICAL ORDER BY THEIR
6216: * ENTRY LABEL NAMES (I.E. BY THE XXX OF THE O$XXX NAME)
6217: *
6218: * THESE ROUTINES RECEIVE CONTROL AS FOLLOWS
6219: *
6220: * (CP) POINTER TO NEXT CODE WORD
6221: * (XS) CURRENT STACK POINTER
6222: {{EJC{{{{
6223: *
6224: * BINARY PLUS (ADDITION)
6225: *
6226: {O$ADD{ENT{{{{ENTRY POINT
6227: {{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS
6228: {{ERR{001{ADDITION{{LEFT OPERAND IS NOT NUMERIC
6229: {{ERR{002{ADDITION{{RIGHT OPERAND IS NOT NUMERIC
6230: {{PPM{OADD1{{{JUMP IF REAL OPERANDS
6231: *
6232: * HERE TO ADD TWO INTEGERS
6233: *
6234: {{ADI{4*ICVAL(R10){{{ADD RIGHT OPERAND TO LEFT
6235: {{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW
6236: {{ERB{003{ADDITION{{CAUSED INTEGER OVERFLOW
6237: *
6238: * HERE TO ADD TWO REALS
6239: *
6240: {OADD1{ADR{4*RCVAL(R10){{{ADD RIGHT OPERAND TO LEFT
6241: {{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW
6242: {{ERB{261{ADDITION{{CAUSED REAL OVERFLOW
6243: {{EJC{{{{
6244: *
6245: * UNARY PLUS (AFFIRMATION)
6246: *
6247: {O$AFF{ENT{{{{ENTRY POINT
6248: {{MOV{(SP)+{R9{{LOAD OPERAND
6249: {{JSR{GTNUM{{{CONVERT TO NUMERIC
6250: {{ERR{004{AFFIRMATION{{OPERAND IS NOT NUMERIC
6251: {{BRN{EXIXR{{{RETURN IF CONVERTED TO NUMERIC
6252: {{EJC{{{{
6253: *
6254: * BINARY BAR (ALTERNATION)
6255: *
6256: {O$ALT{ENT{{{{ENTRY POINT
6257: {{MOV{(SP)+{R9{{LOAD RIGHT OPERAND
6258: {{JSR{GTPAT{{{CONVERT TO PATTERN
6259: {{ERR{005{ALTERNATION{{RIGHT OPERAND IS NOT PATTERN
6260: *
6261: * MERGE HERE FROM SPECIAL (LEFT ALTERNATION) CASE
6262: *
6263: {OALT1{MOV{#P$ALT{R7{{SET PCODE FOR ALTERNATIVE NODE
6264: {{JSR{PBILD{{{BUILD ALTERNATIVE NODE
6265: {{MOV{R9{R10{{SAVE ADDRESS OF ALTERNATIVE NODE
6266: {{MOV{(SP)+{R9{{LOAD LEFT OPERAND
6267: {{JSR{GTPAT{{{CONVERT TO PATTERN
6268: {{ERR{006{ALTERNATION{{LEFT OPERAND IS NOT PATTERN
6269: {{BEQ{R9{#P$ALT{OALT2{JUMP IF LEFT ARG IS ALTERNATION
6270: {{MOV{R9{4*PTHEN(R10){{SET LEFT OPERAND AS SUCCESSOR
6271: {{MOV{R10{R9{{MOVE RESULT TO PROPER REGISTER
6272: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
6273: *
6274: * COME HERE IF LEFT ARGUMENT IS ITSELF AN ALTERNATION
6275: *
6276: * THE RESULT IS MORE EFFICIENT IF WE MAKE THE REPLACEMENT
6277: *
6278: * (A / B) / C = A / (B / C)
6279: *
6280: {OALT2{MOV{4*PARM1(R9){4*PTHEN(R10){{BUILD THE (B / C) NODE
6281: {{MOV{4*PTHEN(R9){-(SP){{SET A AS NEW LEFT ARG
6282: {{MOV{R10{R9{{SET (B / C) AS NEW RIGHT ARG
6283: {{BRN{OALT1{{{MERGE BACK TO BUILD A / (B / C)
6284: {{EJC{{{{
6285: *
6286: * ARRAY REFERENCE (MULTIPLE SUBSCRIPTS, BY NAME)
6287: *
6288: {O$AMN{ENT{{{{ENTRY POINT
6289: {{LCW{R9{{{LOAD NUMBER OF SUBSCRIPTS
6290: {{MOV{R9{R7{{SET FLAG FOR BY NAME
6291: {{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE
6292: {{EJC{{{{
6293: *
6294: * ARRAY REFERENCE (MULTIPLE SUBSCRIPTS, BY VALUE)
6295: *
6296: {O$AMV{ENT{{{{ENTRY POINT
6297: {{LCW{R9{{{LOAD NUMBER OF SUBSCRIPTS
6298: {{ZER{R7{{{SET FLAG FOR BY VALUE
6299: {{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE
6300: {{EJC{{{{
6301: *
6302: * ARRAY REFERENCE (ONE SUBSCRIPT, BY NAME)
6303: *
6304: {O$AON{ENT{{{{ENTRY POINT
6305: {{MOV{(SP){R9{{LOAD SUBSCRIPT VALUE
6306: {{MOV{4*1(SP){R10{{LOAD ARRAY VALUE
6307: {{MOV{(R10){R6{{LOAD FIRST WORD OF ARRAY OPERAND
6308: {{BEQ{R6{#B$VCT{OAON2{JUMP IF VECTOR REFERENCE
6309: {{BEQ{R6{#B$TBT{OAON3{JUMP IF TABLE REFERENCE
6310: *
6311: * HERE TO USE CENTRAL ARRAY REFERENCE ROUTINE
6312: *
6313: {OAON1{MOV{#NUM01{R9{{SET NUMBER OF SUBSCRIPTS TO ONE
6314: {{MOV{R9{R7{{SET FLAG FOR BY NAME
6315: {{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE
6316: *
6317: * HERE IF WE HAVE A VECTOR REFERENCE
6318: *
6319: {OAON2{BNE{(R9){#B$ICL{OAON1{USE LONG ROUTINE IF NOT INTEGER
6320: {{LDI{4*ICVAL(R9){{{LOAD INTEGER SUBSCRIPT VALUE
6321: {{MFI{R6{EXFAL{{COPY AS ADDRESS INT, FAIL IF OVFLO
6322: {{BZE{R6{EXFAL{{FAIL IF ZERO
6323: {{ADD{#VCVLB{R6{{COMPUTE OFFSET IN WORDS
6324: {{WTB{R6{{{CONVERT TO BYTES
6325: {{MOV{R6{(SP){{COMPLETE NAME ON STACK
6326: {{BLT{R6{4*VCLEN(R10){EXITS{EXIT IF SUBSCRIPT NOT TOO LARGE
6327: {{BRN{EXFAL{{{ELSE FAIL
6328: *
6329: * HERE FOR TABLE REFERENCE
6330: *
6331: {OAON3{MNZ{R7{{{SET FLAG FOR NAME REFERENCE
6332: {{JSR{TFIND{{{LOCATE/CREATE TABLE ELEMENT
6333: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS
6334: {{MOV{R10{4*1(SP){{STORE NAME BASE ON STACK
6335: {{MOV{R6{(SP){{STORE NAME OFFSET ON STACK
6336: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK
6337: {{EJC{{{{
6338: *
6339: * ARRAY REFERENCE (ONE SUBSCRIPT, BY VALUE)
6340: *
6341: {O$AOV{ENT{{{{ENTRY POINT
6342: {{MOV{(SP)+{R9{{LOAD SUBSCRIPT VALUE
6343: {{MOV{(SP)+{R10{{LOAD ARRAY VALUE
6344: {{MOV{(R10){R6{{LOAD FIRST WORD OF ARRAY OPERAND
6345: {{BEQ{R6{#B$VCT{OAOV2{JUMP IF VECTOR REFERENCE
6346: {{BEQ{R6{#B$TBT{OAOV3{JUMP IF TABLE REFERENCE
6347: *
6348: * HERE TO USE CENTRAL ARRAY REFERENCE ROUTINE
6349: *
6350: {OAOV1{MOV{R10{-(SP){{RESTACK ARRAY VALUE
6351: {{MOV{R9{-(SP){{RESTACK SUBSCRIPT
6352: {{MOV{#NUM01{R9{{SET NUMBER OF SUBSCRIPTS TO ONE
6353: {{ZER{R7{{{SET FLAG FOR VALUE CALL
6354: {{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE
6355: *
6356: * HERE IF WE HAVE A VECTOR REFERENCE
6357: *
6358: {OAOV2{BNE{(R9){#B$ICL{OAOV1{USE LONG ROUTINE IF NOT INTEGER
6359: {{LDI{4*ICVAL(R9){{{LOAD INTEGER SUBSCRIPT VALUE
6360: {{MFI{R6{EXFAL{{MOVE AS ONE WORD INT, FAIL IF OVFLO
6361: {{BZE{R6{EXFAL{{FAIL IF ZERO
6362: {{ADD{#VCVLB{R6{{COMPUTE OFFSET IN WORDS
6363: {{WTB{R6{{{CONVERT TO BYTES
6364: {{BGE{R6{4*VCLEN(R10){EXFAL{FAIL IF SUBSCRIPT TOO LARGE
6365: {{JSR{ACESS{{{ACCESS VALUE
6366: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS
6367: {{BRN{EXIXR{{{ELSE RETURN VALUE TO CALLER
6368: *
6369: * HERE FOR TABLE REFERENCE BY VALUE
6370: *
6371: {OAOV3{ZER{R7{{{SET FLAG FOR VALUE REFERENCE
6372: {{JSR{TFIND{{{CALL TABLE SEARCH ROUTINE
6373: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS
6374: {{BRN{EXIXR{{{EXIT WITH RESULT IN XR
6375: {{EJC{{{{
6376: *
6377: * ASSIGNMENT
6378: *
6379: {O$ASS{ENT{{{{ENTRY POINT
6380: *
6381: * O$RPL (PATTERN REPLACEMENT) MERGES HERE
6382: *
6383: {OASS0{MOV{(SP)+{R7{{LOAD VALUE TO BE ASSIGNED
6384: {{MOV{(SP)+{R6{{LOAD NAME OFFSET
6385: {{MOV{(SP){R10{{LOAD NAME BASE
6386: {{MOV{R7{(SP){{STORE ASSIGNED VALUE AS RESULT
6387: {{JSR{ASIGN{{{PERFORM ASSIGNMENT
6388: {{PPM{EXFAL{{{FAIL IF ASSIGNMENT FAILS
6389: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK
6390: {{EJC{{{{
6391: *
6392: * COMPILATION ERROR
6393: *
6394: {O$CER{ENT{{{{ENTRY POINT
6395: {{ERB{007{COMPILATION{{ERROR ENCOUNTERED DURING EXECUTION
6396: {{EJC{{{{
6397: *
6398: * UNARY AT (CURSOR ASSIGNMENT)
6399: *
6400: {O$CAS{ENT{{{{ENTRY POINT
6401: {{MOV{(SP)+{R8{{LOAD NAME OFFSET (PARM2)
6402: {{MOV{(SP)+{R9{{LOAD NAME BASE (PARM1)
6403: {{MOV{#P$CAS{R7{{SET PCODE FOR CURSOR ASSIGNMENT
6404: {{JSR{PBILD{{{BUILD NODE
6405: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
6406: {{EJC{{{{
6407: *
6408: * CONCATENATION
6409: *
6410: {O$CNC{ENT{{{{ENTRY POINT
6411: {{MOV{(SP){R9{{LOAD RIGHT ARGUMENT
6412: {{BEQ{R9{#NULLS{OCNC3{JUMP IF RIGHT ARG IS NULL
6413: {{MOV{4*1(SP){R10{{LOAD LEFT ARGUMENT
6414: {{BEQ{R10{#NULLS{OCNC4{JUMP IF LEFT ARGUMENT IS NULL
6415: {{MOV{#B$SCL{R6{{GET CONSTANT TO TEST FOR STRING
6416: {{BNE{R6{(R10){OCNC2{JUMP IF LEFT ARG NOT A STRING
6417: {{BNE{R6{(R9){OCNC2{JUMP IF RIGHT ARG NOT A STRING
6418: *
6419: * MERGE HERE TO CONCATENATE TWO STRINGS
6420: *
6421: {OCNC1{MOV{4*SCLEN(R10){R6{{LOAD LEFT ARGUMENT LENGTH
6422: {{ADD{4*SCLEN(R9){R6{{COMPUTE RESULT LENGTH
6423: {{JSR{ALOCS{{{ALLOCATE SCBLK FOR RESULT
6424: {{MOV{R9{4*1(SP){{STORE RESULT PTR OVER LEFT ARGUMENT
6425: {{PSC{R9{{{PREPARE TO STORE CHARS OF RESULT
6426: {{MOV{4*SCLEN(R10){R6{{GET NUMBER OF CHARS IN LEFT ARG
6427: {{PLC{R10{{{PREPARE TO LOAD LEFT ARG CHARS
6428: {{MVC{{{{MOVE CHARACTERS OF LEFT ARGUMENT
6429: {{MOV{(SP)+{R10{{LOAD RIGHT ARG POINTER, POP STACK
6430: {{MOV{4*SCLEN(R10){R6{{LOAD NUMBER OF CHARS IN RIGHT ARG
6431: {{PLC{R10{{{PREPARE TO LOAD RIGHT ARG CHARS
6432: {{MVC{{{{MOVE CHARACTERS OF RIGHT ARGUMENT
6433: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK
6434: *
6435: * COME HERE IF ARGUMENTS ARE NOT BOTH STRINGS
6436: *
6437: {OCNC2{JSR{GTSTG{{{CONVERT RIGHT ARG TO STRING
6438: {{PPM{OCNC5{{{JUMP IF RIGHT ARG IS NOT STRING
6439: {{MOV{R9{R10{{SAVE RIGHT ARG PTR
6440: {{JSR{GTSTG{{{CONVERT LEFT ARG TO STRING
6441: {{PPM{OCNC6{{{JUMP IF LEFT ARG IS NOT A STRING
6442: {{MOV{R9{-(SP){{STACK LEFT ARGUMENT
6443: {{MOV{R10{-(SP){{STACK RIGHT ARGUMENT
6444: {{MOV{R9{R10{{MOVE LEFT ARG TO PROPER REG
6445: {{MOV{(SP){R9{{MOVE RIGHT ARG TO PROPER REG
6446: {{BRN{OCNC1{{{MERGE BACK TO CONCATENATE STRINGS
6447: {{EJC{{{{
6448: *
6449: * CONCATENATION (CONTINUED)
6450: *
6451: * COME HERE FOR NULL RIGHT ARGUMENT
6452: *
6453: {OCNC3{ICA{SP{{{REMOVE RIGHT ARG FROM STACK
6454: {{BRN{EXITS{{{RETURN WITH LEFT ARGUMENT ON STACK
6455: *
6456: * HERE FOR NULL LEFT ARGUMENT
6457: *
6458: {OCNC4{ICA{SP{{{UNSTACK ONE ARGUMENT
6459: {{MOV{R9{(SP){{STORE RIGHT ARGUMENT
6460: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK
6461: *
6462: * HERE IF RIGHT ARGUMENT IS NOT A STRING
6463: *
6464: {OCNC5{MOV{R9{R10{{MOVE RIGHT ARGUMENT PTR
6465: {{MOV{(SP)+{R9{{LOAD LEFT ARG POINTER
6466: *
6467: * MERGE HERE WHEN LEFT ARGUMENT IS NOT A STRING
6468: *
6469: {OCNC6{JSR{GTPAT{{{CONVERT LEFT ARG TO PATTERN
6470: {{ERR{008{CONCATENATION{{LEFT OPND IS NOT STRING OR PATTERN
6471: {{MOV{R9{-(SP){{SAVE RESULT ON STACK
6472: {{MOV{R10{R9{{POINT TO RIGHT OPERAND
6473: {{JSR{GTPAT{{{CONVERT TO PATTERN
6474: {{ERR{009{CONCATENATION{{RIGHT OPD IS NOT STRING OR PATTERN
6475: {{MOV{R9{R10{{MOVE FOR PCONC
6476: {{MOV{(SP)+{R9{{RELOAD LEFT OPERAND PTR
6477: {{JSR{PCONC{{{CONCATENATE PATTERNS
6478: {{BRN{EXIXR{{{EXIT WITH RESULT IN XR
6479: {{EJC{{{{
6480: *
6481: * COMPLEMENTATION
6482: *
6483: {O$COM{ENT{{{{ENTRY POINT
6484: {{MOV{(SP)+{R9{{LOAD OPERAND
6485: {{MOV{(R9){R6{{LOAD TYPE WORD
6486: *
6487: * MERGE BACK HERE AFTER CONVERSION
6488: *
6489: {OCOM1{BEQ{R6{#B$ICL{OCOM2{JUMP IF INTEGER
6490: {{BEQ{R6{#B$RCL{OCOM3{JUMP IF REAL
6491: {{JSR{GTNUM{{{ELSE CONVERT TO NUMERIC
6492: {{ERR{010{COMPLEMENTATION{{OPERAND IS NOT NUMERIC
6493: {{BRN{OCOM1{{{BACK TO CHECK CASES
6494: *
6495: * HERE TO COMPLEMENT INTEGER
6496: *
6497: {OCOM2{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE
6498: {{NGI{{{{NEGATE
6499: {{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW
6500: {{ERB{011{COMPLEMENTATION{{CAUSED INTEGER OVERFLOW
6501: *
6502: * HERE TO COMPLEMENT REAL
6503: *
6504: {OCOM3{LDR{4*RCVAL(R9){{{LOAD REAL VALUE
6505: {{NGR{{{{NEGATE
6506: {{BRN{EXREA{{{RETURN REAL RESULT
6507: {{EJC{{{{
6508: *
6509: * BINARY SLASH (DIVISION)
6510: *
6511: {O$DVD{ENT{{{{ENTRY POINT
6512: {{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS
6513: {{ERR{012{DIVISION{{LEFT OPERAND IS NOT NUMERIC
6514: {{ERR{013{DIVISION{{RIGHT OPERAND IS NOT NUMERIC
6515: {{PPM{ODVD2{{{JUMP IF REAL OPERANDS
6516: *
6517: * HERE TO DIVIDE TWO INTEGERS
6518: *
6519: {{DVI{4*ICVAL(R10){{{DIVIDE LEFT OPERAND BY RIGHT
6520: {{INO{EXINT{{{RESULT OK IF NO OVERFLOW
6521: {{ERB{014{DIVISION{{CAUSED INTEGER OVERFLOW
6522: *
6523: * HERE TO DIVIDE TWO REALS
6524: *
6525: {ODVD2{DVR{4*RCVAL(R10){{{DIVIDE LEFT OPERAND BY RIGHT
6526: {{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW
6527: {{ERB{262{DIVISION{{CAUSED REAL OVERFLOW
6528: {{EJC{{{{
6529: *
6530: * EXPONENTIATION
6531: *
6532: {O$EXP{ENT{{{{ENTRY POINT
6533: {{MOV{(SP)+{R9{{LOAD EXPONENT
6534: {{JSR{GTNUM{{{CONVERT TO NUMBER
6535: {{ERR{015{EXPONENTIATION{{RIGHT OPERAND IS NOT NUMERIC
6536: {{BNE{R6{#B$ICL{OEXP7{JUMP IF REAL
6537: {{MOV{R9{R10{{MOVE EXPONENT
6538: {{MOV{(SP)+{R9{{LOAD BASE
6539: {{JSR{GTNUM{{{CONVERT TO NUMERIC
6540: {{ERR{016{EXPONENTIATION{{LEFT OPERAND IS NOT NUMERIC
6541: {{LDI{4*ICVAL(R10){{{LOAD EXPONENT
6542: {{ILT{OEXP8{{{ERROR IF NEGATIVE EXPONENT
6543: {{BEQ{R6{#B$RCL{OEXP3{JUMP IF BASE IS REAL
6544: *
6545: * HERE TO EXPONENTIATE AN INTEGER
6546: *
6547: {{MFI{R6{OEXP2{{CONVERT EXPONENT TO 1 WORD INTEGER
6548: {{LCT{R6{R6{{SET LOOP COUNTER
6549: {{LDI{INTV1{{{LOAD INITIAL VALUE OF 1
6550: {{BNZ{R6{OEXP1{{JUMP IF NON-ZERO EXPONENT
6551: {{INE{EXINT{{{GIVE ZERO AS RESULT FOR NONZERO**0
6552: {{BRN{OEXP4{{{ELSE ERROR OF 0**0
6553: *
6554: * LOOP TO PERFORM EXPONENTIATION
6555: *
6556: {OEXP1{MLI{4*ICVAL(R9){{{MULTIPLY BY BASE
6557: {{IOV{OEXP2{{{JUMP IF OVERFLOW
6558: {{BCT{R6{OEXP1{{LOOP BACK TILL COMPUTATION COMPLETE
6559: {{BRN{EXINT{{{THEN RETURN INTEGER RESULT
6560: *
6561: * HERE IF INTEGER OVERFLOW
6562: *
6563: {OEXP2{ERB{017{EXPONENTIATION{{CAUSED INTEGER OVERFLOW
6564: {{EJC{{{{
6565: *
6566: * EXPONENTIATION (CONTINUED)
6567: *
6568: * HERE TO EXPONENTIATE A REAL
6569: *
6570: {OEXP3{MFI{R6{OEXP6{{CONVERT EXPONENT TO ONE WORD
6571: {{LCT{R6{R6{{SET LOOP COUNTER
6572: {{LDR{REAV1{{{LOAD 1.0 AS INITIAL VALUE
6573: {{BNZ{R6{OEXP5{{JUMP IF NON-ZERO EXPONENT
6574: {{RNE{EXREA{{{RETURN 1.0 IF NONZERO**ZERO
6575: *
6576: * HERE FOR ERROR OF 0**0 OR 0.0**0
6577: *
6578: {OEXP4{ERB{018{EXPONENTIATION{{RESULT IS UNDEFINED
6579: *
6580: * LOOP TO PERFORM EXPONENTIATION
6581: *
6582: {OEXP5{MLR{4*RCVAL(R9){{{MULTIPLY BY BASE
6583: {{ROV{OEXP6{{{JUMP IF OVERFLOW
6584: {{BCT{R6{OEXP5{{LOOP TILL COMPUTATION COMPLETE
6585: {{BRN{EXREA{{{THEN RETURN REAL RESULT
6586: *
6587: * HERE IF REAL OVERFLOW
6588: *
6589: {OEXP6{ERB{266{EXPONENTIATION{{CAUSED REAL OVERFLOW
6590: *
6591: * HERE IF REAL EXPONENT
6592: *
6593: {OEXP7{ERB{267{EXPONENTIATION{{RIGHT OPERAND IS REAL NOT INTEGER
6594: *
6595: * HERE FOR NEGATIVE EXPONENT
6596: *
6597: {OEXP8{ERB{019{EXPONENTIATION{{RIGHT OPERAND IS NEGATIVE
6598: {{EJC{{{{
6599: *
6600: * FAILURE IN EXPRESSION EVALUATION
6601: *
6602: * THIS ENTRY POINT IS USED IF THE EVALUATION OF AN
6603: * EXPRESSION, INITIATED BY THE EVALX PROCEDURE, FAILS.
6604: * CONTROL IS RETURNED TO AN APPROPRIATE POINT IN EVALX.
6605: *
6606: {O$FEX{ENT{{{{ENTRY POINT
6607: {{BRN{EVLX6{{{JUMP TO FAILURE LOC IN EVALX
6608: {{EJC{{{{
6609: *
6610: * FAILURE DURING EVALUATION OF A COMPLEX OR DIRECT GOTO
6611: *
6612: {O$FIF{ENT{{{{ENTRY POINT
6613: {{ERB{020{GOTO{{EVALUATION FAILURE
6614: {{EJC{{{{
6615: *
6616: * FUNCTION CALL (MORE THAN ONE ARGUMENT)
6617: *
6618: {O$FNC{ENT{{{{ENTRY POINT
6619: {{LCW{R6{{{LOAD NUMBER OF ARGUMENTS
6620: {{LCW{R9{{{LOAD FUNCTION VRBLK POINTER
6621: {{MOV{4*VRFNC(R9){R10{{LOAD FUNCTION POINTER
6622: {{BNE{R6{4*FARGS(R10){CFUNC{USE CENTRAL ROUTINE IF WRONG NUM
6623: {{BRI{(R10){{{JUMP TO FUNCTION IF ARG COUNT OK
6624: {{EJC{{{{
6625: *
6626: * FUNCTION NAME ERROR
6627: *
6628: {O$FNE{ENT{{{{ENTRY POINT
6629: {{LCW{R6{{{GET NEXT CODE WORD
6630: {{BNE{R6{#ORNM${OFNE1{FAIL IF NOT EVALUATING EXPRESSION
6631: {{BZE{4*2(SP){EVLX3{{OK IF EXPR. WAS WANTED BY VALUE
6632: *
6633: * HERE FOR ERROR
6634: *
6635: {OFNE1{ERB{021{FUNCTION{{CALLED BY NAME RETURNED A VALUE
6636: {{EJC{{{{
6637: *
6638: * FUNCTION CALL (SINGLE ARGUMENT)
6639: *
6640: {O$FNS{ENT{{{{ENTRY POINT
6641: {{LCW{R9{{{LOAD FUNCTION VRBLK POINTER
6642: {{MOV{#NUM01{R6{{SET NUMBER OF ARGUMENTS TO ONE
6643: {{MOV{4*VRFNC(R9){R10{{LOAD FUNCTION POINTER
6644: {{BNE{R6{4*FARGS(R10){CFUNC{USE CENTRAL ROUTINE IF WRONG NUM
6645: {{BRI{(R10){{{JUMP TO FUNCTION IF ARG COUNT OK
6646: {{EJC{{{{
6647: * CALL TO UNDEFINED FUNCTION
6648: *
6649: {O$FUN{ENT{{{{ENTRY POINT
6650: {{ERB{022{UNDEFINED{{FUNCTION CALLED
6651: {{EJC{{{{
6652: *
6653: * EXECUTE COMPLEX GOTO
6654: *
6655: {O$GOC{ENT{{{{ENTRY POINT
6656: {{MOV{4*1(SP){R9{{LOAD NAME BASE POINTER
6657: {{BHI{R9{STATE{OGOC1{JUMP IF NOT NATURAL VARIABLE
6658: {{ADD{#4*VRTRA{R9{{ELSE POINT TO VRTRA FIELD
6659: {{BRI{(R9){{{AND JUMP THROUGH IT
6660: *
6661: * HERE IF GOTO OPERAND IS NOT NATURAL VARIABLE
6662: *
6663: {OGOC1{ERB{023{GOTO{{OPERAND IS NOT A NATURAL VARIABLE
6664: {{EJC{{{{
6665: *
6666: * EXECUTE DIRECT GOTO
6667: *
6668: {O$GOD{ENT{{{{ENTRY POINT
6669: {{MOV{(SP){R9{{LOAD OPERAND
6670: {{MOV{(R9){R6{{LOAD FIRST WORD
6671: {{BEQ{R6{#B$CDS{BCDS0{JUMP IF CODE BLOCK TO CODE ROUTINE
6672: {{BEQ{R6{#B$CDC{BCDC0{JUMP IF CODE BLOCK TO CODE ROUTINE
6673: {{ERB{024{GOTO{{OPERAND IN DIRECT GOTO IS NOT CODE
6674: {{EJC{{{{
6675: *
6676: * SET GOTO FAILURE TRAP
6677: *
6678: * THIS ROUTINE IS EXECUTED AT THE START OF A COMPLEX OR
6679: * DIRECT FAILURE GOTO TO TRAP A SUBSEQUENT FAIL (SEE EXFAL)
6680: *
6681: {O$GOF{ENT{{{{ENTRY POINT
6682: {{MOV{FLPTR{R9{{POINT TO FAIL OFFSET ON STACK
6683: {{ICA{(R9){{{POINT FAILURE TO O$FIF WORD
6684: {{ICP{{{{POINT TO NEXT CODE WORD
6685: {{BRN{EXITS{{{EXIT TO CONTINUE
6686: {{EJC{{{{
6687: *
6688: * BINARY DOLLAR (IMMEDIATE ASSIGNMENT)
6689: *
6690: * THE PATTERN BUILT BY BINARY DOLLAR IS A COMPOUND PATTERN.
6691: * SEE DESCRIPTION AT START OF PATTERN MATCH SECTION FOR
6692: * DETAILS OF THE STRUCTURE WHICH IS CONSTRUCTED.
6693: *
6694: {O$IMA{ENT{{{{ENTRY POINT
6695: {{MOV{#P$IMC{R7{{SET PCODE FOR LAST NODE
6696: {{MOV{(SP)+{R8{{POP NAME OFFSET (PARM2)
6697: {{MOV{(SP)+{R9{{POP NAME BASE (PARM1)
6698: {{JSR{PBILD{{{BUILD P$IMC NODE
6699: {{MOV{R9{R10{{SAVE PTR TO NODE
6700: {{MOV{(SP){R9{{LOAD LEFT ARGUMENT
6701: {{JSR{GTPAT{{{CONVERT TO PATTERN
6702: {{ERR{025{IMMEDIATE{{ASSIGNMENT LEFT OPERAND IS NOT PATTERN
6703: {{MOV{R9{(SP){{SAVE PTR TO LEFT OPERAND PATTERN
6704: {{MOV{#P$IMA{R7{{SET PCODE FOR FIRST NODE
6705: {{JSR{PBILD{{{BUILD P$IMA NODE
6706: {{MOV{(SP)+{4*PTHEN(R9){{SET LEFT OPERAND AS P$IMA SUCCESSOR
6707: {{JSR{PCONC{{{CONCATENATE TO FORM FINAL PATTERN
6708: {{BRN{EXIXR{{{ALL DONE
6709: {{EJC{{{{
6710: *
6711: * INDIRECTION (BY NAME)
6712: *
6713: {O$INN{ENT{{{{ENTRY POINT
6714: {{MNZ{R7{{{SET FLAG FOR RESULT BY NAME
6715: {{BRN{INDIR{{{JUMP TO COMMON ROUTINE
6716: {{EJC{{{{
6717: *
6718: * INTERROGATION
6719: *
6720: {O$INT{ENT{{{{ENTRY POINT
6721: {{MOV{#NULLS{(SP){{REPLACE OPERAND WITH NULL
6722: {{BRN{EXITS{{{EXIT FOR NEXT CODE WORD
6723: {{EJC{{{{
6724: *
6725: * INDIRECTION (BY VALUE)
6726: *
6727: {O$INV{ENT{{{{ENTRY POINT
6728: {{ZER{R7{{{SET FLAG FOR BY VALUE
6729: {{BRN{INDIR{{{JUMP TO COMMON ROUTINE
6730: {{EJC{{{{
6731: *
6732: * KEYWORD REFERENCE (BY NAME)
6733: *
6734: {O$KWN{ENT{{{{ENTRY POINT
6735: {{JSR{KWNAM{{{GET KEYWORD NAME
6736: {{BRN{EXNAM{{{EXIT WITH RESULT NAME
6737: {{EJC{{{{
6738: *
6739: * KEYWORD REFERENCE (BY VALUE)
6740: *
6741: {O$KWV{ENT{{{{ENTRY POINT
6742: {{JSR{KWNAM{{{GET KEYWORD NAME
6743: {{MOV{R9{DNAMP{{DELETE KVBLK
6744: {{JSR{ACESS{{{ACCESS VALUE
6745: {{PPM{EXNUL{{{DUMMY (UNUSED) FAILURE RETURN
6746: {{BRN{EXIXR{{{JUMP WITH VALUE IN XR
6747: {{EJC{{{{
6748: *
6749: * LOAD EXPRESSION BY NAME
6750: *
6751: {O$LEX{ENT{{{{ENTRY POINT
6752: {{MOV{#4*EVSI${R6{{SET SIZE OF EVBLK
6753: {{JSR{ALLOC{{{ALLOCATE SPACE FOR EVBLK
6754: {{MOV{#B$EVT{(R9){{SET TYPE WORD
6755: {{MOV{#TRBEV{4*EVVAR(R9){{SET DUMMY TRBLK POINTER
6756: {{LCW{R6{{{LOAD EXBLK POINTER
6757: {{MOV{R6{4*EVEXP(R9){{SET EXBLK POINTER
6758: {{MOV{R9{R10{{MOVE NAME BASE TO PROPER REG
6759: {{MOV{#4*EVVAR{R6{{SET NAME OFFSET = ZERO
6760: {{BRN{EXNAM{{{EXIT WITH NAME IN (XL,WA)
6761: {{EJC{{{{
6762: *
6763: * LOAD PATTERN VALUE
6764: *
6765: {O$LPT{ENT{{{{ENTRY POINT
6766: {{LCW{R9{{{LOAD PATTERN POINTER
6767: {{BRN{EXIXR{{{STACK PTR AND OBEY NEXT CODE WORD
6768: {{EJC{{{{
6769: *
6770: * LOAD VARIABLE NAME
6771: *
6772: {O$LVN{ENT{{{{ENTRY POINT
6773: {{LCW{R6{{{LOAD VRBLK POINTER
6774: {{MOV{R6{-(SP){{STACK VRBLK PTR (NAME BASE)
6775: {{MOV{#4*VRVAL{-(SP){{STACK NAME OFFSET
6776: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK
6777: {{EJC{{{{
6778: *
6779: * BINARY ASTERISK (MULTIPLICATION)
6780: *
6781: {O$MLT{ENT{{{{ENTRY POINT
6782: {{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS
6783: {{ERR{026{MULTIPLICATION{{LEFT OPERAND IS NOT NUMERIC
6784: {{ERR{027{MULTIPLICATION{{RIGHT OPERAND IS NOT NUMERIC
6785: {{PPM{OMLT1{{{JUMP IF REAL OPERANDS
6786: *
6787: * HERE TO MULTIPLY TWO INTEGERS
6788: *
6789: {{MLI{4*ICVAL(R10){{{MULTIPLY LEFT OPERAND BY RIGHT
6790: {{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW
6791: {{ERB{028{MULTIPLICATION{{CAUSED INTEGER OVERFLOW
6792: *
6793: * HERE TO MULTIPLY TWO REALS
6794: *
6795: {OMLT1{MLR{4*RCVAL(R10){{{MULTIPLY LEFT OPERAND BY RIGHT
6796: {{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW
6797: {{ERB{263{MULTIPLICATION{{CAUSED REAL OVERFLOW
6798: {{EJC{{{{
6799: *
6800: * NAME REFERENCE
6801: *
6802: {O$NAM{ENT{{{{ENTRY POINT
6803: {{MOV{#4*NMSI${R6{{SET LENGTH OF NMBLK
6804: {{JSR{ALLOC{{{ALLOCATE NMBLK
6805: {{MOV{#B$NML{(R9){{SET NAME BLOCK CODE
6806: {{MOV{(SP)+{4*NMOFS(R9){{SET NAME OFFSET FROM OPERAND
6807: {{MOV{(SP)+{4*NMBAS(R9){{SET NAME BASE FROM OPERAND
6808: {{BRN{EXIXR{{{EXIT WITH RESULT IN XR
6809: {{EJC{{{{
6810: *
6811: * NEGATION
6812: *
6813: * INITIAL ENTRY
6814: *
6815: {O$NTA{ENT{{{{ENTRY POINT
6816: {{LCW{R6{{{LOAD NEW FAILURE OFFSET
6817: {{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER
6818: {{MOV{R6{-(SP){{STACK NEW FAILURE OFFSET
6819: {{MOV{SP{FLPTR{{SET NEW FAILURE POINTER
6820: {{BRN{EXITS{{{JUMP TO CONTINUE EXECUTION
6821: *
6822: * ENTRY AFTER SUCCESSFUL EVALUATION OF OPERAND
6823: *
6824: {O$NTB{ENT{{{{ENTRY POINT
6825: {{MOV{4*2(SP){FLPTR{{RESTORE OLD FAILURE POINTER
6826: {{BRN{EXFAL{{{AND FAIL
6827: *
6828: * ENTRY FOR FAILURE DURING OPERAND EVALUATION
6829: *
6830: {O$NTC{ENT{{{{ENTRY POINT
6831: {{ICA{SP{{{POP FAILURE OFFSET
6832: {{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER
6833: {{BRN{EXNUL{{{EXIT GIVING NULL RESULT
6834: {{EJC{{{{
6835: *
6836: * USE OF UNDEFINED OPERATOR
6837: *
6838: {O$OUN{ENT{{{{ENTRY POINT
6839: {{ERB{029{UNDEFINED{{OPERATOR REFERENCED
6840: {{EJC{{{{
6841: *
6842: * BINARY DOT (PATTERN ASSIGNMENT)
6843: *
6844: * THE PATTERN BUILT BY BINARY DOT IS A COMPOUND PATTERN.
6845: * SEE DESCRIPTION AT START OF PATTERN MATCH SECTION FOR
6846: * DETAILS OF THE STRUCTURE WHICH IS CONSTRUCTED.
6847: *
6848: {O$PAS{ENT{{{{ENTRY POINT
6849: {{MOV{#P$PAC{R7{{LOAD PCODE FOR P$PAC NODE
6850: {{MOV{(SP)+{R8{{LOAD NAME OFFSET (PARM2)
6851: {{MOV{(SP)+{R9{{LOAD NAME BASE (PARM1)
6852: {{JSR{PBILD{{{BUILD P$PAC NODE
6853: {{MOV{R9{R10{{SAVE PTR TO NODE
6854: {{MOV{(SP){R9{{LOAD LEFT OPERAND
6855: {{JSR{GTPAT{{{CONVERT TO PATTERN
6856: {{ERR{030{PATTERN{{ASSIGNMENT LEFT OPERAND IS NOT PATTERN
6857: {{MOV{R9{(SP){{SAVE PTR TO LEFT OPERAND PATTERN
6858: {{MOV{#P$PAA{R7{{SET PCODE FOR P$PAA NODE
6859: {{JSR{PBILD{{{BUILD P$PAA NODE
6860: {{MOV{(SP)+{4*PTHEN(R9){{SET LEFT OPERAND AS P$PAA SUCCESSOR
6861: {{JSR{PCONC{{{CONCATENATE TO FORM FINAL PATTERN
6862: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
6863: {{EJC{{{{
6864: *
6865: * PATTERN MATCH (BY NAME, FOR REPLACEMENT)
6866: *
6867: {O$PMN{ENT{{{{ENTRY POINT
6868: {{ZER{R7{{{SET TYPE CODE FOR MATCH BY NAME
6869: {{BRN{MATCH{{{JUMP TO ROUTINE TO START MATCH
6870: {{EJC{{{{
6871: *
6872: * PATTERN MATCH (STATEMENT)
6873: *
6874: * O$PMS IS USED IN PLACE OF O$PMV WHEN THE PATTERN MATCH
6875: * OCCURS AT THE OUTER (STATEMENT) LEVEL SINCE IN THIS
6876: * CASE THE SUBSTRING VALUE NEED NOT BE CONSTRUCTED.
6877: *
6878: {O$PMS{ENT{{{{ENTRY POINT
6879: {{MOV{#NUM02{R7{{SET FLAG FOR STATEMENT TO MATCH
6880: {{BRN{MATCH{{{JUMP TO ROUTINE TO START MATCH
6881: {{EJC{{{{
6882: *
6883: * PATTERN MATCH (BY VALUE)
6884: *
6885: {O$PMV{ENT{{{{ENTRY POINT
6886: {{MOV{#NUM01{R7{{SET TYPE CODE FOR VALUE MATCH
6887: {{BRN{MATCH{{{JUMP TO ROUTINE TO START MATCH
6888: {{EJC{{{{
6889: *
6890: * POP TOP ITEM ON STACK
6891: *
6892: {O$POP{ENT{{{{ENTRY POINT
6893: {{ICA{SP{{{POP TOP STACK ENTRY
6894: {{BRN{EXITS{{{OBEY NEXT CODE WORD
6895: {{EJC{{{{
6896: *
6897: * TERMINATE EXECUTION (CODE COMPILED FOR END STATEMENT)
6898: *
6899: {O$STP{ENT{{{{ENTRY POINT
6900: {{BRN{LEND0{{{JUMP TO END CIRCUIT
6901: {{EJC{{{{
6902: *
6903: * RETURN NAME FROM EXPRESSION
6904: * THIS ENTRY POINTS IS USED IF THE EVALUATION OF AN
6905: * EXPRESSION, INITIATED BY THE EVALX PROCEDURE, RETURNS
6906: * A NAME. CONTROL IS RETURNED TO THE PROPER POINT IN EVALX.
6907: *
6908: {O$RNM{ENT{{{{ENTRY POINT
6909: {{BRN{EVLX4{{{RETURN TO EVALX PROCEDURE
6910: {{EJC{{{{
6911: *
6912: * PATTERN REPLACEMENT
6913: *
6914: * WHEN THIS ROUTINE GETS CONTROL, THE FOLLOWING STACK
6915: * ENTRIES HAVE BEEN MADE (SEE END OF MATCH ROUTINE P$NTH)
6916: *
6917: * SUBJECT NAME BASE
6918: * SUBJECT NAME OFFSET
6919: * INITIAL CURSOR VALUE
6920: * FINAL CURSOR VALUE
6921: * SUBJECT POINTER
6922: * (XS) ---------------- REPLACEMENT VALUE
6923: *
6924: {O$RPL{ENT{{{{ENTRY POINT
6925: {{JSR{GTSTG{{{CONVERT REPLACEMENT VAL TO STRING
6926: {{ERR{031{PATTERN{{REPLACEMENT RIGHT OPERAND IS NOT STRING
6927: *
6928: * GET RESULT LENGTH AND ALLOCATE RESULT SCBLK
6929: *
6930: {{MOV{(SP){R10{{LOAD SUBJECT STRING POINTER
6931: {{BEQ{(R10){#B$BCT{ORPL4{BRANCH IF BUFFER ASSIGNMENT
6932: {{ADD{4*SCLEN(R10){R6{{ADD SUBJECT STRING LENGTH
6933: {{ADD{4*2(SP){R6{{ADD STARTING CURSOR
6934: {{SUB{4*1(SP){R6{{MINUS FINAL CURSOR = TOTAL LENGTH
6935: {{BZE{R6{ORPL3{{JUMP IF RESULT IS NULL
6936: {{MOV{R9{-(SP){{RESTACK REPLACEMENT STRING
6937: {{JSR{ALOCS{{{ALLOCATE SCBLK FOR RESULT
6938: {{MOV{4*3(SP){R6{{GET INITIAL CURSOR (PART 1 LEN)
6939: {{MOV{R9{4*3(SP){{STACK RESULT POINTER
6940: {{PSC{R9{{{POINT TO CHARACTERS OF RESULT
6941: *
6942: * MOVE PART 1 (START OF SUBJECT) TO RESULT
6943: *
6944: {{BZE{R6{ORPL1{{JUMP IF FIRST PART IS NULL
6945: {{MOV{4*1(SP){R10{{ELSE POINT TO SUBJECT STRING
6946: {{PLC{R10{{{POINT TO SUBJECT STRING CHARS
6947: {{MVC{{{{MOVE FIRST PART TO RESULT
6948: {{EJC{{{{
6949: * PATTERN REPLACEMENT (CONTINUED)
6950: *
6951: * NOW MOVE IN REPLACEMENT VALUE
6952: *
6953: {ORPL1{MOV{(SP)+{R10{{LOAD REPLACEMENT STRING, POP
6954: {{MOV{4*SCLEN(R10){R6{{LOAD LENGTH
6955: {{BZE{R6{ORPL2{{JUMP IF NULL REPLACEMENT
6956: {{PLC{R10{{{ELSE POINT TO CHARS OF REPLACEMENT
6957: {{MVC{{{{MOVE IN CHARS (PART 2)
6958: *
6959: * NOW MOVE IN REMAINDER OF STRING (PART 3)
6960: *
6961: {ORPL2{MOV{(SP)+{R10{{LOAD SUBJECT STRING POINTER, POP
6962: {{MOV{(SP)+{R8{{LOAD FINAL CURSOR, POP
6963: {{MOV{4*SCLEN(R10){R6{{LOAD SUBJECT STRING LENGTH
6964: {{SUB{R8{R6{{MINUS FINAL CURSOR = PART 3 LENGTH
6965: {{BZE{R6{OASS0{{JUMP TO ASSIGN IF PART 3 IS NULL
6966: {{PLC{R10{R8{{ELSE POINT TO LAST PART OF STRING
6967: {{MVC{{{{MOVE PART 3 TO RESULT
6968: {{BRN{OASS0{{{JUMP TO PERFORM ASSIGNMENT
6969: *
6970: * HERE IF RESULT IS NULL
6971: *
6972: {ORPL3{ADD{#4*NUM02{SP{{POP SUBJECT STR PTR, FINAL CURSOR
6973: {{MOV{#NULLS{(SP){{SET NULL RESULT
6974: {{BRN{OASS0{{{JUMP TO ASSIGN NULL VALUE
6975: *
6976: * HERE FOR BUFFER SUBSTRING ASSIGNMENT
6977: *
6978: {ORPL4{MOV{R9{R10{{COPY SCBLK REPLACEMENT PTR
6979: {{MOV{(SP)+{R9{{UNSTACK BCBLK PTR
6980: {{MOV{(SP)+{R7{{GET FINAL CURSOR VALUE
6981: {{MOV{(SP)+{R6{{GET INITIAL CURSOR
6982: {{SUB{R6{R7{{GET LENGTH IN WB
6983: {{ADD{#4*NUM02{SP{{GET RID OF NAME BASE/OFFSET
6984: {{JSR{INSBF{{{INSERT SUBSTRING
6985: {{PPM{{{{CONVERT FAIL IMPOSSIBLE
6986: {{PPM{EXFAL{{{FAIL IF INSERT FAILS
6987: {{BRN{EXNUL{{{ELSE NULL RESULT
6988: {{EJC{{{{
6989: *
6990: * RETURN VALUE FROM EXPRESSION
6991: *
6992: * THIS ENTRY POINTS IS USED IF THE EVALUATION OF AN
6993: * EXPRESSION, INITIATED BY THE EVALX PROCEDURE, RETURNS
6994: * A VALUE. CONTROL IS RETURNED TO THE PROPER POINT IN EVALX
6995: *
6996: {O$RVL{ENT{{{{ENTRY POINT
6997: {{BRN{EVLX3{{{RETURN TO EVALX PROCEDURE
6998: {{EJC{{{{
6999: *
7000: * SELECTION
7001: *
7002: * INITIAL ENTRY
7003: *
7004: {O$SLA{ENT{{{{ENTRY POINT
7005: {{LCW{R6{{{LOAD NEW FAILURE OFFSET
7006: {{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER
7007: {{MOV{R6{-(SP){{STACK NEW FAILURE OFFSET
7008: {{MOV{SP{FLPTR{{SET NEW FAILURE POINTER
7009: {{BRN{EXITS{{{JUMP TO EXECUTE FIRST ALTERNATIVE
7010: *
7011: * ENTRY AFTER SUCCESSFUL EVALUATION OF ALTERNATIVE
7012: *
7013: {O$SLB{ENT{{{{ENTRY POINT
7014: {{MOV{(SP)+{R9{{LOAD RESULT
7015: {{ICA{SP{{{POP FAIL OFFSET
7016: {{MOV{(SP){FLPTR{{RESTORE OLD FAILURE POINTER
7017: {{MOV{R9{(SP){{RESTACK RESULT
7018: {{LCW{R6{{{LOAD NEW CODE OFFSET
7019: {{ADD{R$COD{R6{{POINT TO ABSOLUTE CODE LOCATION
7020: {{LCP{R6{{{SET NEW CODE POINTER
7021: {{BRN{EXITS{{{JUMP TO CONTINUE PAST SELECTION
7022: *
7023: * ENTRY AT START OF SUBSEQUENT ALTERNATIVES
7024: *
7025: {O$SLC{ENT{{{{ENTRY POINT
7026: {{LCW{R6{{{LOAD NEW FAIL OFFSET
7027: {{MOV{R6{(SP){{STORE NEW FAIL OFFSET
7028: {{BRN{EXITS{{{JUMP TO EXECUTE NEXT ALTERNATIVE
7029: *
7030: * ENTRY AT START OF LAST ALTERNATIVE
7031: *
7032: {O$SLD{ENT{{{{ENTRY POINT
7033: {{ICA{SP{{{POP FAILURE OFFSET
7034: {{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER
7035: {{BRN{EXITS{{{JUMP TO EXECUTE LAST ALTERNATIVE
7036: {{EJC{{{{
7037: *
7038: * BINARY MINUS (SUBTRACTION)
7039: *
7040: {O$SUB{ENT{{{{ENTRY POINT
7041: {{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS
7042: {{ERR{032{SUBTRACTION{{LEFT OPERAND IS NOT NUMERIC
7043: {{ERR{033{SUBTRACTION{{RIGHT OPERAND IS NOT NUMERIC
7044: {{PPM{OSUB1{{{JUMP IF REAL OPERANDS
7045: *
7046: * HERE TO SUBTRACT TWO INTEGERS
7047: *
7048: {{SBI{4*ICVAL(R10){{{SUBTRACT RIGHT OPERAND FROM LEFT
7049: {{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW
7050: {{ERB{034{SUBTRACTION{{CAUSED INTEGER OVERFLOW
7051: *
7052: * HERE TO SUBTRACT TWO REALS
7053: *
7054: {OSUB1{SBR{4*RCVAL(R10){{{SUBTRACT RIGHT OPERAND FROM LEFT
7055: {{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW
7056: {{ERB{264{SUBTRACTION{{CAUSED REAL OVERFLOW
7057: {{EJC{{{{
7058: *
7059: * DUMMY OPERATOR TO RETURN CONTROL TO TRXEQ PROCEDURE
7060: *
7061: {O$TXR{ENT{{{{ENTRY POINT
7062: {{BRN{TRXQ1{{{JUMP INTO TRXEQ PROCEDURE
7063: {{EJC{{{{
7064: *
7065: * UNEXPECTED FAILURE
7066: *
7067: * NOTE THAT IF A SETEXIT TRAP IS OPERATING THEN
7068: * TRANSFER TO SYSTEM LABEL CONTINUE
7069: * WILL RESULT IN LOOPING HERE. DIFFICULT TO AVOID EXCEPT
7070: * WITH A CONSIDERABLE OVERHEAD WHICH IS NOT WORTHWHILE OR
7071: * ELSE BY A TECHNIQUE SUCH AS SETTING KVERL TO ZERO.
7072: *
7073: {O$UNF{ENT{{{{ENTRY POINT
7074: {{ERB{035{UNEXPECTED{{FAILURE IN -NOFAIL MODE
7075: {{TTL{S{{{P I T B O L -- SNOBOL4 BUILTIN LABEL ROUTINES
7076: *
7077: * THE FOLLOWING SECTION CONTAINS THE ROUTINES FOR LABELS
7078: * WHICH HAVE A PREDEFINED MEANING IN SNOBOL4.
7079: *
7080: * CONTROL IS PASSED DIRECTLY TO THE LABEL NAME ENTRY POINT.
7081: *
7082: * ENTRY NAMES ARE OF THE FORM L$XXX WHERE XXX IS THE THREE
7083: * LETTER VARIABLE NAME IDENTIFIER.
7084: *
7085: * ENTRIES ARE IN ALPHABETICAL ORDER
7086: {{EJC{{{{
7087: *
7088: * ABORT
7089: *
7090: {L$ABO{ENT{{{{ENTRY POINT
7091: *
7092: * MERGE HERE IF EXECUTION TERMINATES IN ERROR
7093: *
7094: {LABO1{MOV{KVERT{R6{{LOAD ERROR CODE
7095: {{BZE{R6{LABO2{{JUMP IF NO ERROR HAS OCCURED
7096: {{JSR{SYSAX{{{CALL AFTER EXECUTION PROC (REG04)
7097: {{JSR{PRTPG{{{ELSE EJECT PRINTER
7098: {{JSR{ERMSG{{{PRINT ERROR MESSAGE
7099: {{ZER{R9{{{INDICATE NO MESSAGE TO PRINT
7100: {{BRN{STOPR{{{JUMP TO ROUTINE TO STOP RUN
7101: *
7102: * HERE IF NO ERROR HAD OCCURED
7103: *
7104: {LABO2{ERB{036{GOTO{{ABORT WITH NO PRECEDING ERROR
7105: {{EJC{{{{
7106: *
7107: * CONTINUE
7108: *
7109: {L$CNT{ENT{{{{ENTRY POINT
7110: *
7111: * MERGE HERE AFTER EXECUTION ERROR
7112: *
7113: {LCNT1{MOV{R$CNT{R9{{LOAD CONTINUATION CODE BLOCK PTR
7114: {{BZE{R9{LCNT2{{JUMP IF NO PREVIOUS ERROR
7115: {{ZER{R$CNT{{{CLEAR FLAG
7116: {{MOV{R9{R$COD{{ELSE STORE AS NEW CODE BLOCK PTR
7117: {{ADD{STXOF{R9{{ADD FAILURE OFFSET
7118: {{LCP{R9{{{LOAD CODE POINTER
7119: {{MOV{FLPTR{SP{{RESET STACK POINTER
7120: {{BRN{EXITS{{{JUMP TO TAKE INDICATED FAILURE
7121: *
7122: * HERE IF NO PREVIOUS ERROR
7123: *
7124: {LCNT2{ERB{037{GOTO{{CONTINUE WITH NO PRECEDING ERROR
7125: {{EJC{{{{
7126: *
7127: * END
7128: *
7129: {L$END{ENT{{{{ENTRY POINT
7130: *
7131: * MERGE HERE FROM END CODE CIRCUIT
7132: *
7133: {LEND0{MOV{#ENDMS{R9{{POINT TO MESSAGE /NORMAL TERM../
7134: {{BRN{STOPR{{{JUMP TO ROUTINE TO STOP RUN
7135: {{EJC{{{{
7136: *
7137: * FRETURN
7138: *
7139: {L$FRT{ENT{{{{ENTRY POINT
7140: {{MOV{#SCFRT{R6{{POINT TO STRING /FRETURN/
7141: {{BRN{RETRN{{{JUMP TO COMMON RETURN ROUTINE
7142: {{EJC{{{{
7143: *
7144: * NRETURN
7145: *
7146: {L$NRT{ENT{{{{ENTRY POINT
7147: {{MOV{#SCNRT{R6{{POINT TO STRING /NRETURN/
7148: {{BRN{RETRN{{{JUMP TO COMMON RETURN ROUTINE
7149: {{EJC{{{{
7150: *
7151: * RETURN
7152: *
7153: {L$RTN{ENT{{{{ENTRY POINT
7154: {{MOV{#SCRTN{R6{{POINT TO STRING /RETURN/
7155: {{BRN{RETRN{{{JUMP TO COMMON RETURN ROUTINE
7156: {{EJC{{{{
7157: *
7158: * UNDEFINED LABEL
7159: *
7160: {L$UND{ENT{{{{ENTRY POINT
7161: {{ERB{038{GOTO{{UNDEFINED LABEL
7162: {{TTL{S{{{P I T B O L -- BLOCK ACTION ROUTINES
7163: *
7164: * THE FIRST WORD OF EVERY BLOCK IN DYNAMIC STORAGE AND THE
7165: * VRGET, VRSTO AND VRTRA FIELDS OF A VRBLK CONTAIN A
7166: * POINTER TO AN ENTRY POINT IN THE PROGRAM. ALL SUCH ENTRY
7167: * POINTS ARE IN THE FOLLOWING SECTION EXCEPT THOSE FOR
7168: * PATTERN BLOCKS WHICH ARE IN THE PATTERN MATCHING SEGMENT
7169: * LATER ON (LABELS OF THE FORM P$XXX), AND DOPE VECTORS
7170: * (D$XXX) WHICH ARE IN THE DOPE VECTOR SECTION FOLLOWING
7171: * THE PATTERN ROUTINES (DOPE VECTORS ARE USED FOR CMBLKS).
7172: *
7173: * THE ENTRY POINTS IN THIS SECTION HAVE LABELS OF THE
7174: * FORM B$XXY WHERE XX IS THE TWO CHARACTER BLOCK TYPE FOR
7175: * THE CORRESPONDING BLOCK AND Y IS ANY LETTER.
7176: *
7177: * IN SOME CASES, THE POINTERS SERVE NO OTHER PURPOSE THAN
7178: * TO IDENTIFY THE BLOCK TYPE. IN THIS CASE THE ROUTINE
7179: * IS NEVER EXECUTED AND THUS NO CODE IS ASSEMBLED.
7180: *
7181: * FOR EACH OF THESE ENTRY POINTS CORRESPONDING TO A BLOCK
7182: * AN ENTRY POINT IDENTIFICATION IS ASSEMBLED (BL$XX).
7183: *
7184: * THE EXACT ENTRY CONDITIONS DEPEND ON THE MANNER IN
7185: * WHICH THE ROUTINE IS ACCESSED AND ARE DOCUMENTED WITH
7186: * THE INDIVIDUAL ROUTINES AS REQUIRED.
7187: *
7188: * THE ORDER OF THESE ROUTINES IS ALPHABETICAL WITH THE
7189: * FOLLOWING EXCEPTIONS.
7190: *
7191: * THE ROUTINES FOR SEBLK AND EXBLK ENTRIES OCCUR FIRST SO
7192: * THAT EXPRESSIONS CAN BE QUICKLY IDENTIFIED FROM THE FACT
7193: * THAT THEIR ROUTINES LIE BEFORE THE SYMBOL B$E$$.
7194: *
7195: * THESE ARE IMMEDIATELY FOLLOWED BY THE ROUTINE FOR A TRBLK
7196: * SO THAT THE TEST AGAINST THE SYMBOL B$T$$ CHECKS FOR
7197: * TRAPPED VALUES OR EXPRESSION VALUES (SEE PROCEDURE EVALP)
7198: *
7199: * THE PATTERN ROUTINES LIE AFTER THIS SECTION SO THAT
7200: * PATTERNS ARE IDENTIFIED WITH ROUTINES STARTING AT OR
7201: * AFTER THE INITIAL INSTRUCTION IN THESE ROUTINES (P$AAA).
7202: *
7203: * THE SYMBOL B$AAA DEFINES THE FIRST LOCATION FOR BLOCK
7204: * ROUTINES AND THE SYMBOL P$YYY (AT THE END OF THE PATTERN
7205: * MATCH ROUTINES SECTION) DEFINES THE LAST SUCH ENTRY POINT
7206: *
7207: {B$AAA{ENT{BL$$I{{{ENTRY POINT OF FIRST BLOCK ROUTINE
7208: {{EJC{{{{
7209: *
7210: * EXBLK
7211: *
7212: * THE ROUTINE FOR AN EXBLK LOADS THE EXPRESSION ONTO
7213: * THE STACK AS A VALUE.
7214: *
7215: * (XR) POINTER TO EXBLK
7216: *
7217: {B$EXL{ENT{BL$EX{{{ENTRY POINT (EXBLK)
7218: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
7219: {{EJC{{{{
7220: *
7221: * SEBLK
7222: *
7223: * THE ROUTINE FOR SEBLK IS ACCESSED FROM THE GENERATED
7224: * CODE TO LOAD THE EXPRESSION VALUE ONTO THE STACK.
7225: *
7226: {B$SEL{ENT{BL$SE{{{ENTRY POINT (SEBLK)
7227: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
7228: *
7229: * DEFINE SYMBOL WHICH MARKS END OF ENTRIES FOR EXPRESSIONS
7230: *
7231: {B$E$${ENT{BL$$I{{{ENTRY POINT
7232: {{EJC{{{{
7233: *
7234: * TRBLK
7235: *
7236: * THE ROUTINE FOR A TRBLK IS NEVER EXECUTED
7237: *
7238: {B$TRT{ENT{BL$TR{{{ENTRY POINT (TRBLK)
7239: *
7240: * DEFINE SYMBOL MARKING END OF TRAP AND EXPRESSION BLOCKS
7241: *
7242: {B$T$${ENT{BL$$I{{{END OF TRBLK,SEBLK,EXBLK ENTRIES
7243: {{EJC{{{{
7244: *
7245: * ARBLK
7246: *
7247: * THE ROUTINE FOR ARBLK IS NEVER EXECUTED
7248: *
7249: {B$ART{ENT{BL$AR{{{ENTRY POINT (ARBLK)
7250: {{EJC{{{{
7251: *
7252: * BCBLK
7253: *
7254: * THE ROUTINE FOR A BCBLK IS NEVER EXECUTED
7255: *
7256: * (XR) POINTER TO BCBLK
7257: *
7258: {B$BCT{ENT{BL$BC{{{ENTRY POINT (BCBLK)
7259: {{EJC{{{{
7260: *
7261: * BFBLK
7262: *
7263: * THE ROUTINE FOR A BFBLK IS NEVER EXECUTED
7264: *
7265: * (XR) POINTER TO BFBLK
7266: *
7267: {B$BFT{ENT{BL$BF{{{ENTRY POINT (BFBLK)
7268: {{EJC{{{{
7269: *
7270: * CCBLK
7271: *
7272: * THE ROUTINE FOR CCBLK IS NEVER ENTERED
7273: *
7274: {B$CCT{ENT{BL$CC{{{ENTRY POINT (CCBLK)
7275: {{EJC{{{{
7276: *
7277: * CDBLK
7278: *
7279: * THE CDBLK ROUTINES ARE EXECUTED FROM THE GENERATED CODE.
7280: * THERE ARE TWO CASES DEPENDING ON THE FORM OF CDFAL.
7281: *
7282: * ENTRY FOR COMPLEX FAILURE CODE AT CDFAL
7283: *
7284: * (XR) POINTER TO CDBLK
7285: *
7286: {B$CDC{ENT{BL$CD{{{ENTRY POINT (CDBLK)
7287: {BCDC0{MOV{FLPTR{SP{{POP GARBAGE OFF STACK
7288: {{MOV{4*CDFAL(R9){(SP){{SET FAILURE OFFSET
7289: {{BRN{STMGO{{{ENTER STMT
7290: {{EJC{{{{
7291: *
7292: * CDBLK (CONTINUED)
7293: *
7294: * ENTRY FOR SIMPLE FAILURE CODE AT CDFAL
7295: *
7296: * (XR) POINTER TO CDBLK
7297: *
7298: {B$CDS{ENT{BL$CD{{{ENTRY POINT (CDBLK)
7299: {BCDS0{MOV{FLPTR{SP{{POP GARBAGE OFF STACK
7300: {{MOV{#4*CDFAL{(SP){{SET FAILURE OFFSET
7301: {{BRN{STMGO{{{ENTER STMT
7302: {{EJC{{{{
7303: *
7304: * CMBLK
7305: *
7306: * THE ROUTINE FOR A CMBLK IS NEVER EXECUTED
7307: *
7308: {B$CMT{ENT{BL$CM{{{ENTRY POINT (CMBLK)
7309: {{EJC{{{{
7310: *
7311: * CTBLK
7312: *
7313: * THE ROUTINE FOR A CTBLK IS NEVER EXECUTED
7314: *
7315: {B$CTT{ENT{BL$CT{{{ENTRY POINT (CTBLK)
7316: {{EJC{{{{
7317: *
7318: * DFBLK
7319: *
7320: * THE ROUTINE FOR A DFBLK IS ACCESSED FROM THE O$FNC ENTRY
7321: * TO CALL A DATATYPE FUNCTION AND BUILD A PDBLK.
7322: *
7323: * (XL) POINTER TO DFBLK
7324: *
7325: {B$DFC{ENT{BL$DF{{{ENTRY POINT
7326: {{MOV{4*DFPDL(R10){R6{{LOAD LENGTH OF PDBLK
7327: {{JSR{ALLOC{{{ALLOCATE PDBLK
7328: {{MOV{#B$PDT{(R9){{STORE TYPE WORD
7329: {{MOV{R10{4*PDDFP(R9){{STORE DFBLK POINTER
7330: {{MOV{R9{R8{{SAVE POINTER TO PDBLK
7331: {{ADD{R6{R9{{POINT PAST PDBLK
7332: {{LCT{R6{4*FARGS(R10){{SET TO COUNT FIELDS
7333: *
7334: * LOOP TO ACQUIRE FIELD VALUES FROM STACK
7335: *
7336: {BDFC1{MOV{(SP)+{-(R9){{MOVE A FIELD VALUE
7337: {{BCT{R6{BDFC1{{LOOP TILL ALL MOVED
7338: {{MOV{R8{R9{{RECALL POINTER TO PDBLK
7339: {{BRN{EXSID{{{EXIT SETTING ID FIELD
7340: {{EJC{{{{
7341: *
7342: * EFBLK
7343: *
7344: * THE ROUTINE FOR AN EFBLK IS PASSED CONTROL FORM THE O$FNC
7345: * ENTRY TO CALL AN EXTERNAL FUNCTION.
7346: *
7347: * (XL) POINTER TO EFBLK
7348: *
7349: {B$EFC{ENT{BL$EF{{{ENTRY POINT (EFBLK)
7350: {{MOV{4*FARGS(R10){R8{{LOAD NUMBER OF ARGUMENTS
7351: {{WTB{R8{{{CONVERT TO OFFSET
7352: {{MOV{R10{-(SP){{SAVE POINTER TO EFBLK
7353: {{MOV{SP{R10{{COPY POINTER TO ARGUMENTS
7354: *
7355: * LOOP TO CONVERT ARGUMENTS
7356: *
7357: {BEFC1{ICA{R10{{{POINT TO NEXT ENTRY
7358: {{MOV{(SP){R9{{LOAD POINTER TO EFBLK
7359: {{DCA{R8{{{DECREMENT EFTAR OFFSET
7360: {{ADD{R8{R9{{POINT TO NEXT EFTAR ENTRY
7361: {{MOV{4*EFTAR(R9){R9{{LOAD EFTAR ENTRY
7362: {{BSW{R9{4{{SWITCH ON TYPE
7363: {{IFF{0{BEFC7{{NO CONVERSION NEEDED
7364: {{IFF{1{BEFC2{{STRING
7365: {{IFF{2{BEFC3{{INTEGER
7366: {{IFF{3{BEFC4{{REAL
7367: {{ESW{{{{END OF SWITCH ON TYPE
7368: *
7369: * HERE TO CONVERT TO STRING
7370: *
7371: {BEFC2{MOV{(R10){-(SP){{STACK ARG PTR
7372: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
7373: {{ERR{039{EXTERNAL{{FUNCTION ARGUMENT IS NOT STRING
7374: {{BRN{BEFC6{{{JUMP TO MERGE
7375: {{EJC{{{{
7376: *
7377: * EFBLK (CONTINUED)
7378: *
7379: * HERE TO CONVERT AN INTEGER
7380: *
7381: {BEFC3{MOV{(R10){R9{{LOAD NEXT ARGUMENT
7382: {{MOV{R8{BEFOF{{SAVE OFFSET
7383: {{JSR{GTINT{{{CONVERT TO INTEGER
7384: {{ERR{040{EXTERNAL{{FUNCTION ARGUMENT IS NOT INTEGER
7385: {{BRN{BEFC5{{{MERGE WITH REAL CASE
7386: *
7387: * HERE TO CONVERT A REAL
7388: *
7389: {BEFC4{MOV{(R10){R9{{LOAD NEXT ARGUMENT
7390: {{MOV{R8{BEFOF{{SAVE OFFSET
7391: {{JSR{GTREA{{{CONVERT TO REAL
7392: {{ERR{265{EXTERNAL{{FUNCTION ARGUMENT IS NOT REAL
7393: *
7394: * INTEGER CASE MERGES HERE
7395: *
7396: {BEFC5{MOV{BEFOF{R8{{RESTORE OFFSET
7397: *
7398: * STRING MERGES HERE
7399: *
7400: {BEFC6{MOV{R9{(R10){{STORE CONVERTED RESULT
7401: *
7402: * NO CONVERSION MERGES HERE
7403: *
7404: {BEFC7{BNZ{R8{BEFC1{{LOOP BACK IF MORE TO GO
7405: *
7406: * HERE AFTER CONVERTING ALL THE ARGUMENTS
7407: *
7408: {{MOV{(SP)+{R10{{RESTORE EFBLK POINTER
7409: {{MOV{4*FARGS(R10){R6{{GET NUMBER OF ARGS
7410: {{JSR{SYSEX{{{CALL ROUTINE TO CALL EXTERNAL FNC
7411: {{PPM{EXFAL{{{FAIL IF FAILURE
7412: {{EJC{{{{
7413: *
7414: * EFBLK (CONTINUED)
7415: *
7416: * RETURN HERE WITH RESULT IN XR
7417: *
7418: * FIRST DEFEND AGAINST NON-STANDARD NULL STRING RETURNED
7419: *
7420: {{MOV{4*EFRSL(R10){R7{{GET RESULT TYPE ID
7421: {{BNZ{R7{BEFA8{{BRANCH IF NOT UNCONVERTED
7422: {{BNE{(R9){#B$SCL{BEFC8{JUMP IF NOT A STRING
7423: {{BZE{4*SCLEN(R9){EXNUL{{RETURN NULL IF NULL
7424: *
7425: * HERE IF CONVERTED RESULT TO CHECK FOR NULL STRING
7426: *
7427: {BEFA8{BNE{R7{#NUM01{BEFC8{JUMP IF NOT A STRING
7428: {{BZE{4*SCLEN(R9){EXNUL{{RETURN NULL IF NULL
7429: *
7430: * RETURN IF RESULT IS IN DYNAMIC STORAGE
7431: *
7432: {BEFC8{BLT{R9{DNAMB{BEFC9{JUMP IF NOT IN DYNAMIC STORAGE
7433: {{BLE{R9{DNAMP{EXIXR{RETURN RESULT IF ALREADY DYNAMIC
7434: *
7435: * HERE WE COPY A RESULT INTO THE DYNAMIC REGION
7436: *
7437: {BEFC9{MOV{(R9){R6{{GET POSSIBLE TYPE WORD
7438: {{BZE{R7{BEF11{{JUMP IF UNCONVERTED RESULT
7439: {{MOV{#B$SCL{R6{{STRING
7440: {{BEQ{R7{#NUM01{BEF10{YES JUMP
7441: {{MOV{#B$ICL{R6{{INTEGER
7442: {{BEQ{R7{#NUM02{BEF10{YES JUMP
7443: {{MOV{#B$RCL{R6{{REAL
7444: *
7445: * STORE TYPE WORD IN RESULT
7446: *
7447: {BEF10{MOV{R6{(R9){{STORED BEFORE COPYING TO DYNAMIC
7448: *
7449: * MERGE FOR UNCONVERTED RESULT
7450: *
7451: {BEF11{JSR{BLKLN{{{GET LENGTH OF BLOCK
7452: {{MOV{R9{R10{{COPY ADDRESS OF OLD BLOCK
7453: {{JSR{ALLOC{{{ALLOCATE DYNAMIC BLOCK SAME SIZE
7454: {{MOV{R9{-(SP){{SET POINTER TO NEW BLOCK AS RESULT
7455: {{MVW{{{{COPY OLD BLOCK TO DYNAMIC BLOCK
7456: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK
7457: {{EJC{{{{
7458: *
7459: * EVBLK
7460: *
7461: * THE ROUTINE FOR AN EVBLK IS NEVER EXECUTED
7462: *
7463: {B$EVT{ENT{BL$EV{{{ENTRY POINT (EVBLK)
7464: {{EJC{{{{
7465: *
7466: * FFBLK
7467: *
7468: * THE ROUTINE FOR AN FFBLK IS EXECUTED FROM THE O$FNC ENTRY
7469: * TO CALL A FIELD FUNCTION AND EXTRACT A FIELD VALUE/NAME.
7470: *
7471: * (XL) POINTER TO FFBLK
7472: *
7473: {B$FFC{ENT{BL$FF{{{ENTRY POINT (FFBLK)
7474: {{MOV{R10{R9{{COPY FFBLK POINTER
7475: {{LCW{R8{{{LOAD NEXT CODE WORD
7476: {{MOV{(SP){R10{{LOAD PDBLK POINTER
7477: {{BNE{(R10){#B$PDT{BFFC2{JUMP IF NOT PDBLK AT ALL
7478: {{MOV{4*PDDFP(R10){R6{{LOAD DFBLK POINTER FROM PDBLK
7479: *
7480: * LOOP TO FIND CORRECT FFBLK FOR THIS PDBLK
7481: *
7482: {BFFC1{BEQ{R6{4*FFDFP(R9){BFFC3{JUMP IF THIS IS THE CORRECT FFBLK
7483: {{MOV{4*FFNXT(R9){R9{{ELSE LINK TO NEXT FFBLK ON CHAIN
7484: {{BNZ{R9{BFFC1{{LOOP BACK IF ANOTHER ENTRY TO CHECK
7485: *
7486: * HERE FOR BAD ARGUMENT
7487: *
7488: {BFFC2{ERB{041{FIELD{{FUNCTION ARGUMENT IS WRONG DATATYPE
7489: {{EJC{{{{
7490: *
7491: * FFBLK (CONTINUED)
7492: *
7493: * HERE AFTER LOCATING CORRECT FFBLK
7494: *
7495: {BFFC3{MOV{4*FFOFS(R9){R6{{LOAD FIELD OFFSET
7496: {{BEQ{R8{#OFNE${BFFC5{JUMP IF CALLED BY NAME
7497: {{ADD{R6{R10{{ELSE POINT TO VALUE FIELD
7498: {{MOV{(R10){R9{{LOAD VALUE
7499: {{BNE{(R9){#B$TRT{BFFC4{JUMP IF NOT TRAPPED
7500: {{SUB{R6{R10{{ELSE RESTORE NAME BASE,OFFSET
7501: {{MOV{R8{(SP){{SAVE NEXT CODE WORD OVER PDBLK PTR
7502: {{JSR{ACESS{{{ACCESS VALUE
7503: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS
7504: {{MOV{(SP){R8{{RESTORE NEXT CODE WORD
7505: *
7506: * HERE AFTER GETTING VALUE IN (XR)
7507: *
7508: {BFFC4{MOV{R9{(SP){{STORE VALUE ON STACK (OVER PDBLK)
7509: {{MOV{R8{R9{{COPY NEXT CODE WORD
7510: {{MOV{(R9){R10{{LOAD ENTRY ADDRESS
7511: {{BRI{R10{{{JUMP TO ROUTINE FOR NEXT CODE WORD
7512: *
7513: * HERE IF CALLED BY NAME
7514: *
7515: {BFFC5{MOV{R6{-(SP){{STORE NAME OFFSET (BASE IS SET)
7516: {{BRN{EXITS{{{EXIT WITH NAME ON STACK
7517: {{EJC{{{{
7518: *
7519: * ICBLK
7520: *
7521: * THE ROUTINE FOR ICBLK IS EXECUTED FROM THE GENERATED
7522: * CODE TO LOAD AN INTEGER VALUE ONTO THE STACK.
7523: *
7524: * (XR) POINTER TO ICBLK
7525: *
7526: {B$ICL{ENT{BL$IC{{{ENTRY POINT (ICBLK)
7527: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
7528: {{EJC{{{{
7529: *
7530: * KVBLK
7531: *
7532: * THE ROUTINE FOR A KVBLK IS NEVER EXECUTED.
7533: *
7534: {B$KVT{ENT{BL$KV{{{ENTRY POINT (KVBLK)
7535: {{EJC{{{{
7536: *
7537: * NMBLK
7538: *
7539: * THE ROUTINE FOR A NMBLK IS EXECUTED FROM THE GENERATED
7540: * CODE FOR THE CASE OF LOADING A NAME ONTO THE STACK
7541: * WHERE THE NAME IS THAT OF A NATURAL VARIABLE WHICH CAN
7542: * BE PREEVALUATED AT COMPILE TIME.
7543: *
7544: * (XR) POINTER TO NMBLK
7545: *
7546: {B$NML{ENT{BL$NM{{{ENTRY POINT (NMBLK)
7547: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
7548: {{EJC{{{{
7549: *
7550: * PDBLK
7551: *
7552: * THE ROUTINE FOR A PDBLK IS NEVER EXECUTED
7553: *
7554: {B$PDT{ENT{BL$PD{{{ENTRY POINT (PDBLK)
7555: {{EJC{{{{
7556: *
7557: * PFBLK
7558: *
7559: * THE ROUTINE FOR A PFBLK IS EXECUTED FROM THE ENTRY O$FNC
7560: * TO CALL A PROGRAM DEFINED FUNCTION.
7561: *
7562: * (XL) POINTER TO PFBLK
7563: *
7564: * THE FOLLOWING STACK ENTRIES ARE MADE BEFORE PASSING
7565: * CONTROL TO THE PROGRAM DEFINED FUNCTION.
7566: *
7567: * SAVED VALUE OF FIRST ARGUMENT
7568: * .
7569: * SAVED VALUE OF LAST ARGUMENT
7570: * SAVED VALUE OF FIRST LOCAL
7571: * .
7572: * SAVED VALUE OF LAST LOCAL
7573: * SAVED VALUE OF FUNCTION NAME
7574: * SAVED CODE BLOCK PTR (R$COD)
7575: * SAVED CODE POINTER (-R$COD)
7576: * SAVED VALUE OF FLPRT
7577: * SAVED VALUE OF FLPTR
7578: * POINTER TO PFBLK
7579: * FLPTR --------------- ZERO (TO BE OVERWRITTEN WITH OFFS)
7580: *
7581: {B$PFC{ENT{BL$PF{{{ENTRY POINT (PFBLK)
7582: {{MOV{R10{BPFPF{{SAVE PFBLK PTR (NEED NOT BE RELOC)
7583: {{MOV{R10{R9{{COPY FOR THE MOMENT
7584: {{MOV{4*PFVBL(R9){R10{{POINT TO VRBLK FOR FUNCTION
7585: *
7586: * LOOP TO FIND OLD VALUE OF FUNCTION
7587: *
7588: {BPF01{MOV{R10{R7{{SAVE POINTER
7589: {{MOV{4*VRVAL(R10){R10{{LOAD VALUE
7590: {{BEQ{(R10){#B$TRT{BPF01{LOOP IF TRBLK
7591: *
7592: * SET VALUE TO NULL AND SAVE OLD FUNCTION VALUE
7593: *
7594: {{MOV{R10{BPFSV{{SAVE OLD VALUE
7595: {{MOV{R7{R10{{POINT BACK TO BLOCK WITH VALUE
7596: {{MOV{#NULLS{4*VRVAL(R10){{SET VALUE TO NULL
7597: {{MOV{4*FARGS(R9){R6{{LOAD NUMBER OF ARGUMENTS
7598: {{ADD{#4*PFARG{R9{{POINT TO PFARG ENTRIES
7599: {{BZE{R6{BPF04{{JUMP IF NO ARGUMENTS
7600: {{MOV{SP{R10{{PTR TO LAST ARG
7601: {{WTB{R6{{{CONVERT NO. OF ARGS TO BYTES OFFSET
7602: {{ADD{R6{R10{{POINT BEFORE FIRST ARG
7603: {{MOV{R10{BPFXT{{REMEMBER ARG POINTER
7604: {{EJC{{{{
7605: *
7606: * PFBLK (CONTINUED)
7607: *
7608: * LOOP TO SAVE OLD ARGUMENT VALUES AND SET NEW ONES
7609: *
7610: {BPF02{MOV{(R9)+{R10{{LOAD VRBLK PTR FOR NEXT ARGUMENT
7611: *
7612: * LOOP THROUGH POSSIBLE TRBLK CHAIN TO FIND VALUE
7613: *
7614: {BPF03{MOV{R10{R8{{SAVE POINTER
7615: {{MOV{4*VRVAL(R10){R10{{LOAD NEXT VALUE
7616: {{BEQ{(R10){#B$TRT{BPF03{LOOP BACK IF TRBLK
7617: *
7618: * SAVE OLD VALUE AND GET NEW VALUE
7619: *
7620: {{MOV{R10{R6{{KEEP OLD VALUE
7621: {{MOV{BPFXT{R10{{POINT BEFORE NEXT STACKED ARG
7622: {{MOV{-(R10){R7{{LOAD ARGUMENT (NEW VALUE)
7623: {{MOV{R6{(R10){{SAVE OLD VALUE
7624: {{MOV{R10{BPFXT{{KEEP ARG PTR FOR NEXT TIME
7625: {{MOV{R8{R10{{POINT BACK TO BLOCK WITH VALUE
7626: {{MOV{R7{4*VRVAL(R10){{SET NEW VALUE
7627: {{BNE{SP{BPFXT{BPF02{LOOP IF NOT ALL DONE
7628: *
7629: * NOW PROCESS LOCALS
7630: *
7631: {BPF04{MOV{BPFPF{R10{{RESTORE PFBLK POINTER
7632: {{MOV{4*PFNLO(R10){R6{{LOAD NUMBER OF LOCALS
7633: {{BZE{R6{BPF07{{JUMP IF NO LOCALS
7634: {{MOV{#NULLS{R7{{GET NULL CONSTANT
7635: {{LCT{R6{R6{{SET LOCAL COUNTER
7636: *
7637: * LOOP TO PROCESS LOCALS
7638: *
7639: {BPF05{MOV{(R9)+{R10{{LOAD VRBLK PTR FOR NEXT LOCAL
7640: *
7641: * LOOP THROUGH POSSIBLE TRBLK CHAIN TO FIND VALUE
7642: *
7643: {BPF06{MOV{R10{R8{{SAVE POINTER
7644: {{MOV{4*VRVAL(R10){R10{{LOAD NEXT VALUE
7645: {{BEQ{(R10){#B$TRT{BPF06{LOOP BACK IF TRBLK
7646: *
7647: * SAVE OLD VALUE AND SET NULL AS NEW VALUE
7648: *
7649: {{MOV{R10{-(SP){{STACK OLD VALUE
7650: {{MOV{R8{R10{{POINT BACK TO BLOCK WITH VALUE
7651: {{MOV{R7{4*VRVAL(R10){{SET NULL AS NEW VALUE
7652: {{BCT{R6{BPF05{{LOOP TILL ALL LOCALS PROCESSED
7653: {{EJC{{{{
7654: *
7655: * PFBLK (CONTINUED)
7656: *
7657: * HERE AFTER PROCESSING ARGUMENTS AND LOCALS
7658: *
7659: {BPF07{ZER{R9{{{ZERO REG XR IN CASE
7660: {{BZE{KVPFL{BPF7C{{SKIP IF PROFILING IS OFF
7661: {{BEQ{KVPFL{#NUM02{BPF7A{BRANCH ON TYPE OF PROFILE
7662: *
7663: * HERE IF &PROFILE = 1
7664: *
7665: {{JSR{SYSTM{{{GET CURRENT TIME
7666: {{STI{PFETM{{{SAVE FOR A SEC
7667: {{SBI{PFSTM{{{FIND TIME USED BY CALLER
7668: {{JSR{ICBLD{{{BUILD INTO AN ICBLK
7669: {{LDI{PFETM{{{RELOAD CURRENT TIME
7670: {{BRN{BPF7B{{{MERGE
7671: *
7672: * HERE IF &PROFILE = 2
7673: *
7674: {BPF7A{LDI{PFSTM{{{GET START TIME OF CALLING STMT
7675: {{JSR{ICBLD{{{ASSEMBLE AN ICBLK ROUND IT
7676: {{JSR{SYSTM{{{GET NOW TIME
7677: *
7678: * BOTH TYPES OF PROFILE MERGE HERE
7679: *
7680: {BPF7B{STI{PFSTM{{{SET START TIME OF 1ST FUNC STMT
7681: {{MNZ{PFFNC{{{FLAG FUNCTION ENTRY
7682: *
7683: * NO PROFILING MERGES HERE
7684: *
7685: {BPF7C{MOV{R9{-(SP){{STACK ICBLK PTR (OR ZERO)
7686: {{MOV{R$COD{R6{{LOAD OLD CODE BLOCK POINTER
7687: {{SCP{R7{{{GET CODE POINTER
7688: {{SUB{R6{R7{{MAKE CODE POINTER INTO OFFSET
7689: {{MOV{BPFPF{R10{{RECALL PFBLK POINTER
7690: {{MOV{BPFSV{-(SP){{STACK OLD VALUE OF FUNCTION NAME
7691: {{MOV{R6{-(SP){{STACK CODE BLOCK POINTER
7692: {{MOV{R7{-(SP){{STACK CODE OFFSET
7693: {{MOV{FLPRT{-(SP){{STACK OLD FLPRT
7694: {{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER
7695: {{MOV{R10{-(SP){{STACK POINTER TO PFBLK
7696: {{ZER{-(SP){{{DUMMY ZERO ENTRY FOR FAIL RETURN
7697: {{CHK{{{{CHECK FOR STACK OVERFLOW
7698: {{MOV{SP{FLPTR{{SET NEW FAIL RETURN VALUE
7699: {{MOV{SP{FLPRT{{SET NEW FLPRT
7700: {{MOV{KVTRA{R6{{LOAD TRACE VALUE
7701: {{ADD{KVFTR{R6{{ADD FTRACE VALUE
7702: {{BNZ{R6{BPF09{{JUMP IF TRACING POSSIBLE
7703: {{ICV{KVFNC{{{ELSE BUMP FNCLEVEL
7704: *
7705: * HERE TO ACTUALLY JUMP TO FUNCTION
7706: *
7707: {BPF08{MOV{4*PFCOD(R10){R9{{POINT TO CODE
7708: {{BRI{(R9){{{OFF TO EXECUTE FUNCTION
7709: *
7710: * HERE IF TRACING IS POSSIBLE
7711: *
7712: {BPF09{MOV{4*PFCTR(R10){R9{{LOAD POSSIBLE CALL TRACE TRBLK
7713: {{MOV{4*PFVBL(R10){R10{{LOAD VRBLK POINTER FOR FUNCTION
7714: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET FOR VARIABLE
7715: {{BZE{KVTRA{BPF10{{JUMP IF TRACE MODE IS OFF
7716: {{BZE{R9{BPF10{{OR IF THERE IS NO CALL TRACE
7717: *
7718: * HERE IF CALL TRACED
7719: *
7720: {{DCV{KVTRA{{{DECREMENT TRACE COUNT
7721: {{BZE{4*TRFNC(R9){BPF11{{JUMP IF PRINT TRACE
7722: {{JSR{TRXEQ{{{EXECUTE FUNCTION TYPE TRACE
7723: {{EJC{{{{
7724: *
7725: * PFBLK (CONTINUED)
7726: *
7727: * HERE TO TEST FOR FTRACE TRACE
7728: *
7729: {BPF10{BZE{KVFTR{BPF16{{JUMP IF FTRACE IS OFF
7730: {{DCV{KVFTR{{{ELSE DECREMENT FTRACE
7731: *
7732: * HERE FOR PRINT TRACE
7733: *
7734: {BPF11{JSR{PRTSN{{{PRINT STATEMENT NUMBER
7735: {{JSR{PRTNM{{{PRINT FUNCTION NAME
7736: {{MOV{#CH$PP{R6{{LOAD LEFT PAREN
7737: {{JSR{PRTCH{{{PRINT LEFT PAREN
7738: {{MOV{4*1(SP){R10{{RECOVER PFBLK POINTER
7739: {{BZE{4*FARGS(R10){BPF15{{SKIP IF NO ARGUMENTS
7740: {{ZER{R7{{{ELSE SET ARGUMENT COUNTER
7741: {{BRN{BPF13{{{JUMP INTO LOOP
7742: *
7743: * LOOP TO PRINT ARGUMENT VALUES
7744: *
7745: {BPF12{MOV{#CH$CM{R6{{LOAD COMMA
7746: {{JSR{PRTCH{{{PRINT TO SEPARATE FROM LAST ARG
7747: *
7748: * MERGE HERE FIRST TIME (NO COMMA REQUIRED)
7749: *
7750: {BPF13{MOV{R7{(SP){{SAVE ARG CTR (OVER FAILOFFS IS OK)
7751: {{WTB{R7{{{CONVERT TO BYTE OFFSET
7752: {{ADD{R7{R10{{POINT TO NEXT ARGUMENT POINTER
7753: {{MOV{4*PFARG(R10){R9{{LOAD NEXT ARGUMENT VRBLK PTR
7754: {{SUB{R7{R10{{RESTORE PFBLK POINTER
7755: {{MOV{4*VRVAL(R9){R9{{LOAD NEXT VALUE
7756: {{JSR{PRTVL{{{PRINT ARGUMENT VALUE
7757: {{EJC{{{{
7758: *
7759: * HERE AFTER DEALING WITH ONE ARGUMENT
7760: *
7761: {{MOV{(SP){R7{{RESTORE ARGUMENT COUNTER
7762: {{ICV{R7{{{INCREMENT ARGUMENT COUNTER
7763: {{BLT{R7{4*FARGS(R10){BPF12{LOOP IF MORE TO PRINT
7764: *
7765: * MERGE HERE IN NO ARGS CASE TO PRINT PAREN
7766: *
7767: {BPF15{MOV{#CH$RP{R6{{LOAD RIGHT PAREN
7768: {{JSR{PRTCH{{{PRINT TO TERMINATE OUTPUT
7769: {{JSR{PRTNL{{{TERMINATE PRINT LINE
7770: *
7771: * MERGE HERE TO EXIT WITH TEST FOR FNCLEVEL TRACE
7772: *
7773: {BPF16{ICV{KVFNC{{{INCREMENT FNCLEVEL
7774: {{MOV{R$FNC{R10{{LOAD PTR TO POSSIBLE TRBLK
7775: {{JSR{KTREX{{{CALL KEYWORD TRACE ROUTINE
7776: *
7777: * CALL FUNCTION AFTER TRACE TESTS COMPLETE
7778: *
7779: {{MOV{4*1(SP){R10{{RESTORE PFBLK POINTER
7780: {{BRN{BPF08{{{JUMP BACK TO EXECUTE FUNCTION
7781: {{EJC{{{{
7782: *
7783: * RCBLK
7784: *
7785: * THE ROUTINE FOR AN RCBLK IS EXECUTED FROM THE GENERATED
7786: * CODE TO LOAD A REAL VALUE ONTO THE STACK.
7787: *
7788: * (XR) POINTER TO RCBLK
7789: *
7790: {B$RCL{ENT{BL$RC{{{ENTRY POINT (RCBLK)
7791: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
7792: {{EJC{{{{
7793: *
7794: * SCBLK
7795: *
7796: * THE ROUTINE FOR AN SCBLK IS EXECUTED FROM THE GENERATED
7797: * CODE TO LOAD A STRING VALUE ONTO THE STACK.
7798: *
7799: * (XR) POINTER TO SCBLK
7800: *
7801: {B$SCL{ENT{BL$SC{{{ENTRY POINT (SCBLK)
7802: {{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
7803: {{EJC{{{{
7804: *
7805: * TBBLK
7806: *
7807: * THE ROUTINE FOR A TBBLK IS NEVER EXECUTED
7808: *
7809: {B$TBT{ENT{BL$TB{{{ENTRY POINT (TBBLK)
7810: {{EJC{{{{
7811: *
7812: * TEBLK
7813: *
7814: * THE ROUTINE FOR A TEBLK IS NEVER EXECUTED
7815: *
7816: {B$TET{ENT{BL$TE{{{ENTRY POINT (TEBLK)
7817: {{EJC{{{{
7818: *
7819: * VCBLK
7820: *
7821: * THE ROUTINE FOR A VCBLK IS NEVER EXECUTED
7822: *
7823: {B$VCT{ENT{BL$VC{{{ENTRY POINT (VCBLK)
7824: {{EJC{{{{
7825: *
7826: * VRBLK
7827: *
7828: * THE VRBLK ROUTINES ARE EXECUTED FROM THE GENERATED CODE.
7829: * THERE ARE SIX ENTRIES FOR VRBLK COVERING VARIOUS CASES
7830: *
7831: {B$VR${ENT{BL$$I{{{MARK START OF VRBLK ENTRY POINTS
7832: *
7833: * ENTRY FOR VRGET (TRAPPED CASE). THIS ROUTINE IS CALLED
7834: * FROM THE GENERATED CODE TO LOAD THE VALUE OF A VARIABLE.
7835: * THIS ENTRY POINT IS USED IF AN ACCESS TRACE OR INPUT
7836: * ASSOCIATION IS CURRENTLY ACTIVE.
7837: *
7838: * (XR) POINTER TO VRGET FIELD OF VRBLK
7839: *
7840: {B$VRA{ENT{BL$$I{{{ENTRY POINT
7841: {{MOV{R9{R10{{COPY NAME BASE (VRGET = 0)
7842: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET
7843: {{JSR{ACESS{{{ACCESS VALUE
7844: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS
7845: {{BRN{EXIXR{{{ELSE EXIT WITH RESULT IN XR
7846: {{EJC{{{{
7847: *
7848: * VRBLK (CONTINUED)
7849: *
7850: * ENTRY FOR VRSTO (ERROR CASE. THIS ROUTINE IS CALLED FROM
7851: * THE EXECUTED CODE FOR AN ATTEMPT TO MODIFY THE VALUE
7852: * OF A PROTECTED (PATTERN VALUED) NATURAL VARIABLE.
7853: *
7854: {B$VRE{ENT{{{{ENTRY POINT
7855: {{ERB{042{ATTEMPT{{TO CHANGE VALUE OF PROTECTED VARIABLE
7856: {{EJC{{{{
7857: *
7858: * VRBLK (CONTINUED)
7859: *
7860: * ENTRY FOR VRTRA (UNTRAPPED CASE). THIS ROUTINE IS CALLED
7861: * FROM THE EXECUTED CODE TO TRANSFER TO A LABEL.
7862: *
7863: * (XR) POINTER TO VRTRA FIELD OF VRBLK
7864: *
7865: {B$VRG{ENT{{{{ENTRY POINT
7866: {{MOV{4*VRLBO(R9){R9{{LOAD CODE POINTER
7867: {{MOV{(R9){R10{{LOAD ENTRY ADDRESS
7868: {{BRI{R10{{{JUMP TO ROUTINE FOR NEXT CODE WORD
7869: {{EJC{{{{
7870: *
7871: * VRBLK (CONTINUED)
7872: *
7873: * ENTRY FOR VRGET (UNTRAPPED CASE). THIS ROUTINE IS CALLED
7874: * FROM THE GENERATED CODE TO LOAD THE VALUE OF A VARIABLE.
7875: *
7876: * (XR) POINTS TO VRGET FIELD OF VRBLK
7877: *
7878: {B$VRL{ENT{{{{ENTRY POINT
7879: {{MOV{4*VRVAL(R9){-(SP){{LOAD VALUE ONTO STACK (VRGET = 0)
7880: {{BRN{EXITS{{{OBEY NEXT CODE WORD
7881: {{EJC{{{{
7882: *
7883: * VRBLK (CONTINUED)
7884: *
7885: * ENTRY FOR VRSTO (UNTRAPPED CASE). THIS ROUTINE IS CALLED
7886: * FROM THE GENERATED CODE TO STORE THE VALUE OF A VARIABLE.
7887: *
7888: * (XR) POINTER TO VRSTO FIELD OF VRBLK
7889: *
7890: {B$VRS{ENT{{{{ENTRY POINT
7891: {{MOV{(SP){4*VRVLO(R9){{STORE VALUE, LEAVE ON STACK
7892: {{BRN{EXITS{{{OBEY NEXT CODE WORD
7893: {{EJC{{{{
7894: *
7895: * VRBLK (CONTINUED)
7896: *
7897: * VRTRA (TRAPPED CASE). THIS ROUTINE IS CALLED FROM THE
7898: * GENERATED CODE TO TRANSFER TO A LABEL WHEN A LABEL
7899: * TRACE IS CURRENTLY ACTIVE.
7900: *
7901: {B$VRT{ENT{{{{ENTRY POINT
7902: {{SUB{#4*VRTRA{R9{{POINT BACK TO START OF VRBLK
7903: {{MOV{R9{R10{{COPY VRBLK POINTER
7904: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET
7905: {{MOV{4*VRLBL(R10){R9{{LOAD POINTER TO TRBLK
7906: {{BZE{KVTRA{BVRT2{{JUMP IF TRACE IS OFF
7907: {{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT
7908: {{BZE{4*TRFNC(R9){BVRT1{{JUMP IF PRINT TRACE CASE
7909: {{JSR{TRXEQ{{{ELSE EXECUTE FULL TRACE
7910: {{BRN{BVRT2{{{MERGE TO JUMP TO LABEL
7911: *
7912: * HERE FOR PRINT TRACE -- PRINT COLON ( LABEL NAME )
7913: *
7914: {BVRT1{JSR{PRTSN{{{PRINT STATEMENT NUMBER
7915: {{MOV{R10{R9{{COPY VRBLK POINTER
7916: {{MOV{#CH$CL{R6{{COLON
7917: {{JSR{PRTCH{{{PRINT IT
7918: {{MOV{#CH$PP{R6{{LEFT PAREN
7919: {{JSR{PRTCH{{{PRINT IT
7920: {{JSR{PRTVN{{{PRINT LABEL NAME
7921: {{MOV{#CH$RP{R6{{RIGHT PAREN
7922: {{JSR{PRTCH{{{PRINT IT
7923: {{JSR{PRTNL{{{TERMINATE LINE
7924: {{MOV{4*VRLBL(R10){R9{{POINT BACK TO TRBLK
7925: *
7926: * MERGE HERE TO JUMP TO LABEL
7927: *
7928: {BVRT2{MOV{4*TRLBL(R9){R9{{LOAD POINTER TO ACTUAL CODE
7929: {{BRI{(R9){{{EXECUTE STATEMENT AT LABEL
7930: {{EJC{{{{
7931: *
7932: * VRBLK (CONTINUED)
7933: *
7934: * ENTRY FOR VRSTO (TRAPPED CASE). THIS ROUTINE IS CALLED
7935: * FROM THE GENERATED CODE TO STORE THE VALUE OF A VARIABLE.
7936: * THIS ENTRY IS USED WHEN A VALUE TRACE OR OUTPUT
7937: * ASSOCIATION IS CURRENTLY ACTIVE.
7938: *
7939: * (XR) POINTER TO VRSTO FIELD OF VRBLK
7940: *
7941: {B$VRV{ENT{{{{ENTRY POINT
7942: {{MOV{(SP){R7{{LOAD VALUE (LEAVE COPY ON STACK)
7943: {{SUB{#4*VRSTO{R9{{POINT TO VRBLK
7944: {{MOV{R9{R10{{COPY VRBLK POINTER
7945: {{MOV{#4*VRVAL{R6{{SET OFFSET
7946: {{JSR{ASIGN{{{CALL ASSIGNMENT ROUTINE
7947: {{PPM{EXFAL{{{FAIL IF ASSIGNMENT FAILS
7948: {{BRN{EXITS{{{ELSE RETURN WITH RESULT ON STACK
7949: {{EJC{{{{
7950: *
7951: * XNBLK
7952: *
7953: * THE ROUTINE FOR AN XNBLK IS NEVER EXECUTED
7954: *
7955: {B$XNT{ENT{BL$XN{{{ENTRY POINT (XNBLK)
7956: {{EJC{{{{
7957: *
7958: * XRBLK
7959: *
7960: * THE ROUTINE FOR AN XRBLK IS NEVER EXECUTED
7961: *
7962: {B$XRT{ENT{BL$XR{{{ENTRY POINT (XRBLK)
7963: *
7964: * MARK ENTRY ADDRESS PAST LAST BLOCK ACTION ROUTINE
7965: *
7966: {B$YYY{ENT{BL$$I{{{LAST BLOCK ROUTINE ENTRY POINT
7967: {{TTL{S{{{P I T B O L -- PATTERN MATCHING ROUTINES
7968: *
7969: * THE FOLLOWING SECTION CONSISTS OF THE PATTERN MATCHING
7970: * ROUTINES. ALL PATTERN NODES CONTAIN A POINTER (PCODE)
7971: * TO ONE OF THE ROUTINES IN THIS SECTION (P$XXX).
7972: *
7973: * NOTE THAT THIS SECTION FOLLOWS THE B$XXX ROUTINES TO
7974: * ENABLE A FAST TEST FOR THE PATTERN DATATYPE.
7975: *
7976: {P$AAA{ENT{BL$$I{{{ENTRY TO MARK FIRST PATTERN
7977: *
7978: *
7979: * THE ENTRY CONDITIONS TO THE MATCH ROUTINE ARE AS FOLLOWS
7980: * (SEE O$PMN, O$PMV, O$PMS AND PROCEDURE MATCH).
7981: *
7982: * STACK CONTENTS.
7983: *
7984: * NAME BASE (O$PMN ONLY)
7985: * NAME OFFSET (O$PMN ONLY)
7986: * TYPE (0-O$PMN, 1-O$PMV, 2-O$PMS)
7987: * PMHBS --------------- INITIAL CURSOR (ZERO)
7988: * INITIAL NODE POINTER
7989: * XS ------------------ =NDABO (ANCHORED), =NDUNA (UNANCH)
7990: *
7991: * REGISTER VALUES.
7992: *
7993: * (XS) SET AS SHOWN IN STACK DIAGRAM
7994: * (XR) POINTER TO INITIAL PATTERN NODE
7995: * (WB) INITIAL CURSOR (ZERO)
7996: *
7997: * GLOBAL PATTERN VALUES
7998: *
7999: * R$PMS POINTER TO SUBJECT STRING SCBLK
8000: * PMSSL LENGTH OF SUBJECT STRING IN CHARS
8001: * PMDFL DOT FLAG, INITIALLY ZERO
8002: * PMHBS SET AS SHOWN IN STACK DIAGRAM
8003: *
8004: * CONTROL IS PASSED BY BRANCHING THROUGH THE PCODE
8005: * FIELD OF THE INITIAL PATTERN NODE (BRI (XR)).
8006: {{EJC{{{{
8007: *
8008: * DESCRIPTION OF ALGORITHM
8009: *
8010: * A PATTERN STRUCTURE IS REPRESENTED AS A LINKED GRAPH
8011: * OF NODES WITH THE FOLLOWING STRUCTURE.
8012: *
8013: * +------------------------------------+
8014: * I PCODE I
8015: * +------------------------------------+
8016: * I PTHEN I
8017: * +------------------------------------+
8018: * I PARM1 I
8019: * +------------------------------------+
8020: * I PARM2 I
8021: * +------------------------------------+
8022: *
8023: * PCODE IS A POINTER TO THE ROUTINE WHICH WILL PERFORM
8024: * THE MATCH OF THIS PARTICULAR NODE TYPE.
8025: *
8026: * PTHEN IS A POINTER TO THE SUCCESSOR NODE. I.E. THE NODE
8027: * TO BE MATCHED IF THE ATTEMPT TO MATCH THIS NODE SUCCEEDS.
8028: * IF THIS IS THE LAST NODE OF THE PATTERN PTHEN POINTS
8029: * TO THE DUMMY NODE NDNTH WHICH INITIATES PATTERN EXIT.
8030: *
8031: * PARM1, PARM2 ARE PARAMETERS WHOSE USE VARIES WITH THE
8032: * PARTICULAR NODE. THEY ARE ONLY PRESENT IF REQUIRED.
8033: *
8034: * ALTERNATIVES ARE HANDLED WITH THE SPECIAL ALTERNATIVE
8035: * NODE WHOSE PARAMETER POINTS TO THE NODE TO BE MATCHED
8036: * IF THERE IS A FAILURE ON THE SUCCESSOR PATH.
8037: *
8038: * THE FOLLOWING EXAMPLE ILLUSTRATES THE MANNER IN WHICH
8039: * THE STRUCTURE IS BUILT UP. THE PATTERN IS
8040: *
8041: * (A / B / C) (D / E) WHERE / IS ALTERNATION
8042: *
8043: * IN THE DIAGRAM, THE NODE MARKED + REPRESENTS AN
8044: * ALTERNATIVE NODE AND THE DOTTED LINE FROM A + NODE
8045: * REPRESENTS THE PARAMETER POINTER TO THE ALTERNATIVE.
8046: *
8047: * +---+ +---+ +---+ +---+
8048: * I + I-----I A I-----I + I-----I D I-----
8049: * +---+ +---+ I +---+ +---+
8050: * . I .
8051: * . I .
8052: * +---+ +---+ I +---+
8053: * I + I-----I B I--I I E I-----
8054: * +---+ +---+ I +---+
8055: * . I
8056: * . I
8057: * +---+ I
8058: * I C I------------I
8059: * +---+
8060: {{EJC{{{{
8061: *
8062: * DURING THE MATCH, THE REGISTERS ARE USED AS FOLLOWS.
8063: *
8064: * (XR) POINTS TO THE CURRENT NODE
8065: * (XL) SCRATCH
8066: * (XS) MAIN STACK POINTER
8067: * (WB) CURSOR (NUMBER OF CHARS MATCHED)
8068: * (WA,WC) SCRATCH
8069: *
8070: * TO KEEP TRACK OF ALTERNATIVES, THE MAIN STACK IS USED AS
8071: * A HISTORY STACK AND CONTAINS TWO WORD ENTRIES.
8072: *
8073: * WORD 1 SAVED CURSOR VALUE
8074: * WORD 2 NODE TO MATCH ON FAILURE
8075: *
8076: * WHEN A FAILURE OCCURS, THE MOST RECENT ENTRY ON THIS
8077: * STACK IS POPPED OFF TO RESTORE THE CURSOR AND POINT
8078: * TO THE NODE TO BE MATCHED AS AN ALTERNATIVE. THE ENTRY
8079: * AT THE BOTTOM OF THE STACK POINTS TO THE FOLLOWING
8080: * SPECIAL NODES DEPENDING ON THE SCAN MODE.
8081: *
8082: * ANCHORED MODE THE BOTTOM ENTRY POINTS TO THE
8083: * SPECIAL NODE NDABO WHICH CAUSES AN
8084: * ABORT. THE CURSOR VALUE STORED
8085: * WITH THIS ENTRY IS ALWAYS ZERO.
8086: *
8087: * UNANCHORED MODE THE BOTTOM ENTRY POINTS TO THE
8088: * SPECIAL NODE NDUNA WHICH MOVES THE
8089: * ANCHOR POINT AND RESTARTS THE MATCH
8090: * THE CURSOR SAVED WITH THIS ENTRY
8091: * IS THE NUMBER OF CHARACTERS WHICH
8092: * LIE BEFORE THE INITIAL ANCHOR POINT
8093: * (I.E. THE NUMBER OF ANCHOR MOVES).
8094: * THIS ENTRY IS THREE WORDS LONG AND
8095: * ALSO CONTAINS THE INITIAL PATTERN.
8096: *
8097: * ENTRIES ARE MADE ON THIS HISTORY STACK BY ALTERNATIVE
8098: * NODES AND BY SOME SPECIAL COMPOUD PATTERNS AS DESCRIBED
8099: * LATER ON. THE FOLLOWING GLOBAL LOCATIONS ARE USED DURING
8100: * PATTERN MATCHING.
8101: *
8102: * R$PMS POINTER TO SUBJECT STRING
8103: * PMSSL LENGTH OF SUBJECT STRING
8104: * PMDFL FLAG SET NON-ZERO FOR DOT PATTERNS
8105: * PMHBS BASE PTR FOR CURRENT HISTORY STACK
8106: *
8107: * THE FOLLOWING EXIT POINTS ARE AVAILABLE TO MATCH ROUTINES
8108: *
8109: * SUCCP SUCCESS IN MATCHING CURRENT NODE
8110: * FAILP FAILURE IN MATCHING CURRENT NODE
8111: {{EJC{{{{
8112: *
8113: * COMPOUND PATTERNS
8114: *
8115: * SOME PATTERNS HAVE IMPLICIT ALTERNATIVES AND THEIR
8116: * REPRESENTATION IN THE PATTERN STRUCTURE CONSISTS OF A
8117: * LINKED SET OF NODES AS INDICATED BY THESE DIAGRAMS.
8118: *
8119: * AS BEFORE, THE + REPRESENTS AN ALTERNATIVE NODE AND
8120: * THE DOTTED LINE FROM A + NODE IS THE PARAMETER POINTER
8121: * TO THE ALTERNATIVE PATTERN.
8122: *
8123: * ARB
8124: * ---
8125: *
8126: * +---+ THIS NODE (P$ARB) MATCHES NULL
8127: * I B I----- AND STACKS CURSOR, SUCCESSOR PTR,
8128: * +---+ CURSOR (COPY) AND A PTR TO NDARC.
8129: *
8130: *
8131: *
8132: *
8133: * BAL
8134: * ---
8135: *
8136: * +---+ THE P$BAL NODE SCANS A BALANCED
8137: * I B I----- STRING AND THEN STACKS A POINTER
8138: * +---+ TO ITSELF ON THE HISTORY STACK.
8139: {{EJC{{{{
8140: *
8141: * COMPOUND PATTERN STRUCTURES (CONTINUED)
8142: *
8143: *
8144: * ARBNO
8145: * -----
8146: *
8147: * +---+ THIS ALTERNATIVE NODE MATCHES NULL
8148: * +----I + I----- THE FIRST TIME AND STACKS A POINTER
8149: * I +---+ TO THE ARGUMENT PATTERN X.
8150: * I .
8151: * I .
8152: * I +---+ NODE (P$ABA) TO STACK CURSOR
8153: * I I A I AND HISTORY STACK BASE PTR.
8154: * I +---+
8155: * I I
8156: * I I
8157: * I +---+ THIS IS THE ARGUMENT PATTERN. AS
8158: * I I X I INDICATED, THE SUCCESSOR OF THE
8159: * I +---+ PATTERN IS THE P$ABC NODE
8160: * I I
8161: * I I
8162: * I +---+ THIS NODE (P$ABC) POPS PMHBS,
8163: * +----I C I STACKS OLD PMHBS AND PTR TO NDABD
8164: * +---+ (UNLESS OPTIMISATION HAS OCCURRED)
8165: *
8166: * STRUCTURE AND EXECUTION OF THIS PATTERN RESEMBLE THOSE OF
8167: * RECURSIVE PATTERN MATCHING AND IMMEDIATE ASSIGNMENT.
8168: * THE ALTERNATIVE NODE AT THE HEAD OF THE STRUCTURE MATCHES
8169: * NULL INITIALLY BUT ON SUBSEQUENT FAILURE ENSURES ATTEMPT
8170: * TO MATCH THE ARGUMENT. BEFORE THE ARGUMENT IS MATCHED
8171: * P$ABA STACKS THE CURSOR,PMHBS AND A PTR TO P$ABB. IF
8172: * THE ARGUMENT CANT BE MATCHED , P$ABB REMOVES THIS SPECIAL
8173: * STACK ENTRY AND FAILS.
8174: * IF ARGUMENT IS MATCHED , P$ABC RESTORES THE OUTER PMHBS
8175: * VALUE (SAVED BY P$ABA) . THEN IF THE ARGUMENT HAS LEFT
8176: * ALTERNATIVES ON STACK IT STACKS THE INNER VALUE OF PMHBS
8177: * AND A PTR TO NDABD. IF ARGUMENT LEFT NOTHING ON THE STACK
8178: * IT OPTIMISES BY REMOVING ITEMS STACKED BY P$ABA. FINALLY
8179: * A CHECK IS MADE THAT ARGUMENT MATCHED MORE THAN THE NULL
8180: * STRING (CHECK IS INTENDED TO PREVENT USELESS LOOPING).
8181: * IF SO THE SUCCESSOR IS AGAIN THE ALTERNATIVE NODE AT THE
8182: * HEAD OF THE STRUCTURE , ENSURING A POSSIBLE EXTRA ATTEMPT
8183: * TO MATCH THE ARG IF NECESSARY. IF NOT , THE SUCCESSOR TO
8184: * ALTERNATIVE IS TAKEN SO AS TO TERMINATE THE LOOP. P$ABD
8185: * RESTORES INNER PMHBS PTR AND FAILS , THUS TRYING TO MATCH
8186: * ALTERNATIVES LEFT BY THE ARBNO ARGUMENT.
8187: {{EJC{{{{
8188: *
8189: * COMPOUND PATTERN STRUCTURES (CONTINUED)
8190: *
8191: * BREAKX
8192: * ------
8193: *
8194: * +---+ THIS NODE IS A BREAK NODE FOR
8195: * +----I B I THE ARGUMENT TO BREAKX, IDENTICAL
8196: * I +---+ TO AN ORDINARY BREAK NODE.
8197: * I I
8198: * I I
8199: * I +---+ THIS ALTERNATIVE NODE STACKS A
8200: * I I + I----- POINTER TO THE BREAKX NODE TO
8201: * I +---+ ALLOW FOR SUBSEQUENT FAILURE
8202: * I .
8203: * I .
8204: * I +---+ THIS IS THE BREAKX NODE ITSELF. IT
8205: * +----I X I MATCHES ONE CHARACTER AND THEN
8206: * +---+ PROCEEDS BACK TO THE BREAK NODE.
8207: *
8208: *
8209: *
8210: *
8211: * FENCE
8212: * -----
8213: *
8214: * +---+ THE FENCE NODE MATCHES NULL AND
8215: * I F I----- STACKS A POINTER TO NODE NDABO TO
8216: * +---+ ABORT ON A SUBSEQUENT REMATCH
8217: *
8218: *
8219: *
8220: *
8221: * SUCCEED
8222: * -------
8223: *
8224: * +---+ THE NODE FOR SUCCEED MATCHES NULL
8225: * I S I----- AND STACKS A POINTER TO ITSELF
8226: * +---+ TO REPEAT THE MATCH ON A FAILURE.
8227: {{EJC{{{{
8228: *
8229: * COMPOUND PATTERNS (CONTINUED)
8230: *
8231: * BINARY DOT (PATTERN ASSIGNMENT)
8232: * -------------------------------
8233: *
8234: * +---+ THIS NODE (P$PAA) SAVES THE CURRENT
8235: * I A I CURSOR AND A POINTER TO THE
8236: * +---+ SPECIAL NODE NDPAB ON THE STACK.
8237: * I
8238: * I
8239: * +---+ THIS IS THE STRUCTURE FOR THE
8240: * I X I PATTERN LEFT ARGUMENT OF THE
8241: * +---+ PATTERN ASSIGNMENT CALL.
8242: * I
8243: * I
8244: * +---+ THIS NODE (P$PAC) SAVES THE CURSOR,
8245: * I C I----- A PTR TO ITSELF, THE CURSOR (COPY)
8246: * +---+ AND A PTR TO NDPAD ON THE STACK.
8247: *
8248: *
8249: * THE FUNCTION OF THE MATCH ROUTINE FOR NDPAB (P$PAB)
8250: * IS SIMPLY TO UNSTACK ITSELF AND FAIL BACK ONTO THE STACK.
8251: *
8252: * THE MATCH ROUTINE FOR P$PAC ALSO SETS THE GLOBAL PATTERN
8253: * FLAG PMDFL NON-ZERO TO INDICATE THAT PATTERN ASSIGNMENTS
8254: * MAY HAVE OCCURED IN THE PATTERN MATCH
8255: *
8256: * IF PMDFL IS SET AT THE END OF THE MATCH (SEE P$NTH), THE
8257: * HISTORY STACK IS SCANNED FOR MATCHING NDPAB-NDPAD PAIRS
8258: * AND THE CORRESPONDING PATTERN ASSIGNMENTS ARE EXECUTED.
8259: *
8260: * THE FUNCTION OF THE MATCH ROUTINE FOR NDPAD (P$PAD)
8261: * IS SIMPLY TO REMOVE ITS ENTRY FROM THE STACK AND FAIL.
8262: * THIS INCLUDES REMOVING THE SPECIAL NODE POINTER STORED
8263: * IN ADDITION TO THE STANDARD TWO ENTRIES ON THE STACK.
8264: {{EJC{{{{
8265: *
8266: * COMPOUNT PATTERN STRUCTURES (CONTINUED)
8267: *
8268: * FENCE (FUNCTION)
8269: * ----------------
8270: *
8271: * +---+ THIS NODE (P$FNA) SAVES THE
8272: * I A I CURRENT HISTORY STACK AND A
8273: * +---+ POINTER TO NDFNB ON THE STACK.
8274: * I
8275: * I
8276: * +---+ THIS IS THE PATTERN STRUCTURE
8277: * I X I GIVEN AS THE ARGUMENT TO THE
8278: * +---+ FENCE FUNCTION.
8279: * I
8280: * I
8281: * +---+ THIS NODE P$FNC RESTORES THE OUTER
8282: * I C I HISTORY STACK PTR SAVED IN P$FNA,
8283: * +---+ AND STACKS THE INNER STACK BASE
8284: * PTR AND A POINTER TO NDFND ON THE
8285: * STACK.
8286: *
8287: * NDFNB (F$FNB) SIMPLY IS THE FAILURE EXIT FOR PATTERN
8288: * ARGUMENT FAILURE, AND IT POPS ITSELF AND FAILS ONTO THE
8289: * STACK.
8290: *
8291: * THE MATCH ROUTINE P$FNC ALLOWS FOR AN OPTIMIZATION WHEN
8292: * THE FENCE PATTERN LEAVES NO ALTERNATIVES. IN THIS CASE,
8293: * THE NDFNB ENTRY IS POPPED, AND THE MATCH CONTINUES.
8294: *
8295: * NDFND (P$FND) IS ENTERED WHEN THE PATTERN FAILS AFTER
8296: * GOING THROUGH A NON-OPTIMIZED P$FNC, AND IT POPS THE
8297: * STACK BACK PAST THE INNTER STACK BASE CREATED BY P$FNA
8298: {{EJC{{{{
8299: *
8300: * COMPOUND PATTERNS (CONTINUED)
8301: *
8302: * EXPRESSION PATTERNS (RECURSIVE PATTERN MATCHES)
8303: * -----------------------------------------------
8304: *
8305: * INITIAL ENTRY FOR A PATTERN NODE IS TO THE ROUTINE P$EXA.
8306: * IF THE EVALUATED RESULT OF THE EXPRESSION IS ITSELF A
8307: * PATTERN, THEN THE FOLLOWING STEPS ARE TAKEN TO ARRANGE
8308: * FOR PROPER RECURSIVE PROCESSING.
8309: *
8310: * 1) A POINTER TO THE CURRENT NODE (THE P$EXA NODE) IS
8311: * STORED ON THE HISTORY STACK WITH A DUMMY CURSOR.
8312: *
8313: * 2) A SPECIAL HISTORY STACK ENTRY IS MADE IN WHICH THE
8314: * NODE POINTER POINTS TO NDEXB, AND THE CURSOR VALUE
8315: * IS THE SAVED VALUE OF PMHBS ON ENTRY TO THIS NODE.
8316: * THE MATCH ROUTINE FOR NDEXB (P$EXB) RESTORES PMHBS
8317: * FROM THIS CURSOR ENTRY, POPS OFF THE P$EXA NODE
8318: * POINTER AND FAILS.
8319: *
8320: * 3) THE RESULTING HISTORY STACK POINTER IS SAVED IN
8321: * PMHBS TO ESTABLISH A NEW LEVEL OF HISTORY STACK.
8322: *
8323: * AFTER MATCHING A PATTERN, THE END OF MATCH ROUTINE GETS
8324: * CONTROL (P$NTH). THIS ROUTINE PROCEEDS AS FOLLOWS.
8325: *
8326: * 1) LOAD THE CURRENT VALUE OF PMHBS AND RECOGNIZE THE
8327: * OUTER LEVEL CASE BY THE FACT THAT THE ASSOCIATED
8328: * CURSOR IN THIS CASE IS THE PATTERN MATCH TYPE CODE
8329: * WHICH IS LESS THAN 3. TERMINATE THE MATCH IN THIS
8330: * CASE AND CONTINUE EXECUTION OF THE PROGRAM.
8331: *
8332: * 2) OTHERWISE MAKE A SPECIAL HISTORY STACK ENTRY IN
8333: * WHICH THE NODE POINTER POINTS TO THE SPECIAL NODE
8334: * NDEXC AND THE CURSOR IS THE CURRENT VALUE OF PMHBS.
8335: * THE MATCH ROUTINE FOR NDEXC (P$EXC) RESETS PMHBS TO
8336: * THIS (INNER) VALUE AND AND THEN FAILS.
8337: *
8338: * 3) USING THE HISTORY STACK ENTRY MADE ON STARTING THE
8339: * EXPRESSION (ACCESSIBLE WITH THE CURRENT VALUE OF
8340: * PMHBS), RESTORE THE P$EXA NODE POINTER AND THE OLD
8341: * PMHBS SETTING. TAKE THE SUCCESSOR AND CONTINUE.
8342: *
8343: * AN OPTIMIZATION IS POSSIBLE IF THE EXPRESSION PATTERN
8344: * MAKES NO ENTRIES ON THE HISTORY STACK. IN THIS CASE,
8345: * INSTEAD OF BUILDING THE P$EXC NODE IN STEP 2, IT IS MORE
8346: * EFFICIENT TO SIMPLY POP OFF THE P$EXB ENTRY AND ITS
8347: * ASSOCIATED NODE POINTER. THE EFFECT IS THE SAME.
8348: {{EJC{{{{
8349: *
8350: * COMPOUND PATTERNS (CONTINUED)
8351: *
8352: * BINARY DOLLAR (IMMEDIATE ASSIGNMENT)
8353: * ------------------------------------
8354: *
8355: * +---+ THIS NODE (P$IMA) STACKS THE CURSOR
8356: * I A I PMHBS AND A PTR TO NDIMB AND RESETS
8357: * +---+ THE STACK PTR PMHBS.
8358: * I
8359: * I
8360: * +---+ THIS IS THE LEFT STRUCTURE FOR THE
8361: * I X I PATTERN LEFT ARGUMENT OF THE
8362: * +---+ IMMEDIATE ASSIGNMENT CALL.
8363: * I
8364: * I
8365: * +---+ THIS NODE (P$IMC) PERFORMS THE
8366: * I C I----- ASSIGNMENT, POPS PMHBS AND STACKS
8367: * +---+ THE OLD PMHBS AND A PTR TO NDIMD.
8368: *
8369: *
8370: * THE STRUCTURE AND EXECUTION OF THIS PATTERN ARE SIMILAR
8371: * TO THOSE OF THE RECURSIVE EXPRESSION PATTERN MATCHING.
8372: *
8373: * THE MATCH ROUTINE FOR NDIMB (P$IMB) RESTORES THE OUTER
8374: * LEVEL VALUE OF PMHBS, UNSTACKS THE SAVED CURSOR AND FAILS
8375: *
8376: * THE MATCH ROUTINE P$IMC USES THE CURRENT VALUE OF PMHBS
8377: * TO LOCATE THE P$IMB ENTRY. THIS ENTRY IS USED TO MAKE
8378: * THE ASSIGNMENT AND RESTORE THE OUTER LEVEL VALUE OF
8379: * PMHBS. FINALLY, THE INNER LEVEL VALUE OF PMHBS AND A
8380: * POINTER TO THE SPECIAL NODE NDIMD ARE STACKED.
8381: *
8382: * THE MATCH ROUTINE FOR NDIMD (P$IMD) RESTORES THE INNER
8383: * LEVEL VALUE OF PMHBS AND FAILS BACK INTO THE STACK.
8384: *
8385: * AN OPTIMIZATION OCCURS IF THE INNER PATTERN MAKES NO
8386: * ENTRIES ON THE HISTORY STACK. IN THIS CASE, P$IMC POPS
8387: * THE P$IMB ENTRY INSTEAD OF MAKING A P$IMD ENTRY.
8388: {{EJC{{{{
8389: *
8390: * ARBNO
8391: *
8392: * SEE COMPOUND PATTERNS SECTION FOR STUCTURE AND
8393: * ALGORITHM FOR MATCHING THIS NODE TYPE.
8394: *
8395: * NO PARAMETERS
8396: *
8397: {P$ABA{ENT{BL$P0{{{P0BLK
8398: {{MOV{R7{-(SP){{STACK CURSOR
8399: {{MOV{R9{-(SP){{STACK DUMMY NODE PTR
8400: {{MOV{PMHBS{-(SP){{STACK OLD STACK BASE PTR
8401: {{MOV{#NDABB{-(SP){{STACK PTR TO NODE NDABB
8402: {{MOV{SP{PMHBS{{STORE NEW STACK BASE PTR
8403: {{BRN{SUCCP{{{SUCCEED
8404: {{EJC{{{{
8405: *
8406: * ARBNO (REMOVE P$ABA SPECIAL STACK ENTRY)
8407: *
8408: * NO PARAMETERS (DUMMY PATTERN)
8409: *
8410: {P$ABB{ENT{{{{ENTRY POINT
8411: {{MOV{R7{PMHBS{{RESTORE HISTORY STACK BASE PTR
8412: {{BRN{FLPOP{{{FAIL AND POP DUMMY NODE PTR
8413: {{EJC{{{{
8414: *
8415: * ARBNO (CHECK IF ARG MATCHED NULL STRING)
8416: *
8417: * NO PARAMETERS (DUMMY PATTERN)
8418: *
8419: {P$ABC{ENT{BL$P0{{{P0BLK
8420: {{MOV{PMHBS{R10{{KEEP P$ABB STACK BASE
8421: {{MOV{4*3(R10){R6{{LOAD INITIAL CURSOR
8422: {{MOV{4*1(R10){PMHBS{{RESTORE OUTER STACK BASE PTR
8423: {{BEQ{R10{SP{PABC1{JUMP IF NO HISTORY STACK ENTRIES
8424: {{MOV{R10{-(SP){{ELSE SAVE INNER PMHBS ENTRY
8425: {{MOV{#NDABD{-(SP){{STACK PTR TO SPECIAL NODE NDABD
8426: {{BRN{PABC2{{{MERGE
8427: *
8428: * OPTIMISE CASE OF NO EXTRA ENTRIES ON STACK FROM ARBNO ARG
8429: *
8430: {PABC1{ADD{#4*NUM04{SP{{REMOVE NDABB ENTRY AND CURSOR
8431: *
8432: * MERGE TO CHECK FOR MATCHING OF NULL STRING
8433: *
8434: {PABC2{BNE{R6{R7{SUCCP{ALLOW FURTHER ATTEMPT IF NON-NULL
8435: {{MOV{4*PTHEN(R9){R9{{BYPASS ALTERNATIVE NODE SO AS TO ..
8436: {{BRN{SUCCP{{{... REFUSE FURTHER MATCH ATTEMPTS
8437: {{EJC{{{{
8438: *
8439: * ARBNO (TRY FOR ALTERNATIVES IN ARBNO ARGUMENT)
8440: *
8441: * NO PARAMETERS (DUMMY PATTERN)
8442: *
8443: {P$ABD{ENT{{{{ENTRY POINT
8444: {{MOV{R7{PMHBS{{RESTORE INNER STACK BASE PTR
8445: {{BRN{FAILP{{{AND FAIL
8446: {{EJC{{{{
8447: *
8448: * ABORT
8449: *
8450: * NO PARAMETERS
8451: *
8452: {P$ABO{ENT{BL$P0{{{P0BLK
8453: {{BRN{EXFAL{{{SIGNAL STATEMENT FAILURE
8454: {{EJC{{{{
8455: *
8456: * ALTERNATION
8457: *
8458: * PARM1 ALTERNATIVE NODE
8459: *
8460: {P$ALT{ENT{BL$P1{{{P1BLK
8461: {{MOV{R7{-(SP){{STACK CURSOR
8462: {{MOV{4*PARM1(R9){-(SP){{STACK POINTER TO ALTERNATIVE
8463: {{CHK{{{{CHECK FOR STACK OVERFLOW
8464: {{BRN{SUCCP{{{IF ALL OK, THEN SUCCEED
8465: {{EJC{{{{
8466: *
8467: * ANY (ONE CHARACTER ARGUMENT) (1-CHAR STRING ALSO)
8468: *
8469: * PARM1 CHARACTER ARGUMENT
8470: *
8471: {P$ANS{ENT{BL$P1{{{P1BLK
8472: {{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARS LEFT
8473: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
8474: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER
8475: {{LCH{R6{(R10){{LOAD CURRENT CHARACTER
8476: {{BNE{R6{4*PARM1(R9){FAILP{FAIL IF NO MATCH
8477: {{ICV{R7{{{ELSE BUMP CURSOR
8478: {{BRN{SUCCP{{{AND SUCCEED
8479: {{EJC{{{{
8480: *
8481: * ANY (MULTI-CHARACTER ARGUMENT CASE)
8482: *
8483: * PARM1 POINTER TO CTBLK
8484: * PARM2 BIT MASK TO SELECT BIT IN CTBLK
8485: *
8486: {P$ANY{ENT{BL$P2{{{P2BLK
8487: *
8488: * EXPRESSION ARGUMENT CASE MERGES HERE
8489: *
8490: {PANY1{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARACTERS LEFT
8491: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
8492: {{PLC{R10{R7{{GET CHAR PTR TO CURRENT CHARACTER
8493: {{LCH{R6{(R10){{LOAD CURRENT CHARACTER
8494: {{MOV{4*PARM1(R9){R10{{POINT TO CTBLK
8495: {{WTB{R6{{{CHANGE TO BYTE OFFSET
8496: {{ADD{R6{R10{{POINT TO ENTRY IN CTBLK
8497: {{MOV{4*CTCHS(R10){R6{{LOAD WORD FROM CTBLK
8498: {{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT
8499: {{ZRB{R6{FAILP{{FAIL IF NO MATCH
8500: {{ICV{R7{{{ELSE BUMP CURSOR
8501: {{BRN{SUCCP{{{AND SUCCEED
8502: {{EJC{{{{
8503: *
8504: * ANY (EXPRESSION ARGUMENT)
8505: *
8506: * PARM1 EXPRESSION POINTER
8507: *
8508: {P$AYD{ENT{BL$P1{{{P1BLK
8509: {{JSR{EVALS{{{EVALUATE STRING ARGUMENT
8510: {{ERR{043{ANY{{EVALUATED ARGUMENT IS NOT STRING
8511: {{PPM{FAILP{{{FAIL IF EVALUATION FAILURE
8512: {{PPM{PANY1{{{MERGE MULTI-CHAR CASE IF OK
8513: {{EJC{{{{
8514: *
8515: * P$ARB INITIAL ARB MATCH
8516: *
8517: * NO PARAMETERS
8518: *
8519: * THE P$ARB NODE IS PART OF A COMPOUND PATTERN STRUCTURE
8520: * FOR AN ARB PATTERN (SEE DESCRIPTION OF COMPOUND PATTERNS)
8521: *
8522: {P$ARB{ENT{BL$P0{{{P0BLK
8523: {{MOV{4*PTHEN(R9){R9{{LOAD SUCCESSOR POINTER
8524: {{MOV{R7{-(SP){{STACK DUMMY CURSOR
8525: {{MOV{R9{-(SP){{STACK SUCCESSOR POINTER
8526: {{MOV{R7{-(SP){{STACK CURSOR
8527: {{MOV{#NDARC{-(SP){{STACK PTR TO SPECIAL NODE NDARC
8528: {{BRI{(R9){{{EXECUTE NEXT NODE MATCHING NULL
8529: {{EJC{{{{
8530: *
8531: * P$ARC EXTEND ARB MATCH
8532: *
8533: * NO PARAMETERS (DUMMY PATTERN)
8534: *
8535: {P$ARC{ENT{{{{ENTRY POINT
8536: {{BEQ{R7{PMSSL{FLPOP{FAIL AND POP STACK TO SUCCESSOR
8537: {{ICV{R7{{{ELSE BUMP CURSOR
8538: {{MOV{R7{-(SP){{STACK UPDATED CURSOR
8539: {{MOV{R9{-(SP){{RESTACK POINTER TO NDARC NODE
8540: {{MOV{4*2(SP){R9{{LOAD SUCCESSOR POINTER
8541: {{BRI{(R9){{{OFF TO REEXECUTE SUCCESSOR NODE
8542: {{EJC{{{{
8543: *
8544: * BAL
8545: *
8546: * NO PARAMETERS
8547: *
8548: * THE P$BAL NODE IS PART OF THE COMPOUND STRUCTURE BUILT
8549: * FOR BAL (SEE SECTION ON COMPOUND PATTERNS).
8550: *
8551: {P$BAL{ENT{BL$P0{{{P0BLK
8552: {{ZER{R8{{{ZERO PARENTHESES LEVEL COUNTER
8553: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
8554: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER
8555: {{BRN{PBAL2{{{JUMP INTO SCAN LOOP
8556: *
8557: * LOOP TO SCAN OUT CHARACTERS
8558: *
8559: {PBAL1{LCH{R6{(R10)+{{LOAD NEXT CHARACTER, BUMP POINTER
8560: {{ICV{R7{{{PUSH CURSOR FOR CHARACTER
8561: {{BEQ{R6{#CH$PP{PBAL3{JUMP IF LEFT PAREN
8562: {{BEQ{R6{#CH$RP{PBAL4{JUMP IF RIGHT PAREN
8563: {{BZE{R8{PBAL5{{ELSE SUCCEED IF AT OUTER LEVEL
8564: *
8565: * HERE AFTER PROCESSING ONE CHARACTER
8566: *
8567: {PBAL2{BNE{R7{PMSSL{PBAL1{LOOP BACK UNLESS END OF STRING
8568: {{BRN{FAILP{{{IN WHICH CASE, FAIL
8569: *
8570: * HERE ON LEFT PAREN
8571: *
8572: {PBAL3{ICV{R8{{{BUMP PAREN LEVEL
8573: {{BRN{PBAL2{{{LOOP BACK TO CHECK END OF STRING
8574: *
8575: * HERE FOR RIGHT PAREN
8576: *
8577: {PBAL4{BZE{R8{FAILP{{FAIL IF NO MATCHING LEFT PAREN
8578: {{DCV{R8{{{ELSE DECREMENT LEVEL COUNTER
8579: {{BNZ{R8{PBAL2{{LOOP BACK IF NOT AT OUTER LEVEL
8580: *
8581: * HERE AFTER SUCCESSFULLY SCANNING A BALANCED STRING
8582: *
8583: {PBAL5{MOV{R7{-(SP){{STACK CURSOR
8584: {{MOV{R9{-(SP){{STACK PTR TO BAL NODE FOR EXTEND
8585: {{BRN{SUCCP{{{AND SUCCEED
8586: {{EJC{{{{
8587: *
8588: * BREAK (EXPRESSION ARGUMENT)
8589: *
8590: * PARM1 EXPRESSION POINTER
8591: *
8592: {P$BKD{ENT{BL$P1{{{P1BLK
8593: {{JSR{EVALS{{{EVALUATE STRING EXPRESSION
8594: {{ERR{044{BREAK{{EVALUATED ARGUMENT IS NOT STRING
8595: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS
8596: {{PPM{PBRK1{{{MERGE WITH MULTI-CHAR CASE IF OK
8597: {{EJC{{{{
8598: *
8599: * BREAK (ONE CHARACTER ARGUMENT)
8600: *
8601: * PARM1 CHARACTER ARGUMENT
8602: *
8603: {P$BKS{ENT{BL$P1{{{P1BLK
8604: {{MOV{PMSSL{R8{{GET SUBJECT STRING LENGTH
8605: {{SUB{R7{R8{{GET NUMBER OF CHARACTERS LEFT
8606: {{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT
8607: {{LCT{R8{R8{{SET COUNTER FOR CHARS LEFT
8608: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
8609: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER
8610: *
8611: * LOOP TO SCAN TILL BREAK CHARACTER FOUND
8612: *
8613: {PBKS1{LCH{R6{(R10)+{{LOAD NEXT CHAR, BUMP POINTER
8614: {{BEQ{R6{4*PARM1(R9){SUCCP{SUCCEED IF BREAK CHARACTER FOUND
8615: {{ICV{R7{{{ELSE PUSH CURSOR
8616: {{BCT{R8{PBKS1{{LOOP BACK IF MORE TO GO
8617: {{BRN{FAILP{{{FAIL IF END OF STRING, NO BREAK CHR
8618: {{EJC{{{{
8619: *
8620: * BREAK (MULTI-CHARACTER ARGUMENT)
8621: *
8622: * PARM1 POINTER TO CTBLK
8623: * PARM2 BIT MASK TO SELECT BIT COLUMN
8624: *
8625: {P$BRK{ENT{BL$P2{{{P2BLK
8626: *
8627: * EXPRESSION ARGUMENT MERGES HERE
8628: *
8629: {PBRK1{MOV{PMSSL{R8{{LOAD SUBJECT STRING LENGTH
8630: {{SUB{R7{R8{{GET NUMBER OF CHARACTERS LEFT
8631: {{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT
8632: {{LCT{R8{R8{{SET COUNTER FOR CHARACTERS LEFT
8633: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
8634: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER
8635: {{MOV{R9{PSAVE{{SAVE NODE POINTER
8636: *
8637: * LOOP TO SEARCH FOR BREAK CHARACTER
8638: *
8639: {PBRK2{LCH{R6{(R10)+{{LOAD NEXT CHAR, BUMP POINTER
8640: {{MOV{4*PARM1(R9){R9{{LOAD POINTER TO CTBLK
8641: {{WTB{R6{{{CONVERT TO BYTE OFFSET
8642: {{ADD{R6{R9{{POINT TO CTBLK ENTRY
8643: {{MOV{4*CTCHS(R9){R6{{LOAD CTBLK WORD
8644: {{MOV{PSAVE{R9{{RESTORE NODE POINTER
8645: {{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT
8646: {{NZB{R6{SUCCP{{SUCCEED IF BREAK CHARACTER FOUND
8647: {{ICV{R7{{{ELSE PUSH CURSOR
8648: {{BCT{R8{PBRK2{{LOOP BACK UNLESS END OF STRING
8649: {{BRN{FAILP{{{FAIL IF END OF STRING, NO BREAK CHR
8650: {{EJC{{{{
8651: *
8652: * BREAKX (EXTENSION)
8653: *
8654: * THIS IS THE ENTRY WHICH CAUSES AN EXTENSION OF A BREAKX
8655: * MATCH WHEN FAILURE OCCURS. SEE SECTION ON COMPOUND
8656: * PATTERNS FOR FULL DETAILS OF BREAKX MATCHING.
8657: *
8658: * NO PARAMETERS
8659: *
8660: {P$BKX{ENT{BL$P0{{{P0BLK
8661: {{ICV{R7{{{STEP CURSOR PAST PREVIOUS BREAK CHR
8662: {{BRN{SUCCP{{{SUCCEED TO REMATCH BREAK
8663: {{EJC{{{{
8664: *
8665: * BREAKX (EXPRESSION ARGUMENT)
8666: *
8667: * SEE SECTION ON COMPOUND PATTERNS FOR FULL STRUCTURE OF
8668: * BREAKX PATTERN. THE ACTUAL CHARACTER MATCHING USES A
8669: * BREAK NODE. HOWEVER, THE ENTRY FOR THE EXPRESSION
8670: * ARGUMENT CASE IS SEPARATED TO GET PROPER ERROR MESSAGES.
8671: *
8672: * PARM1 EXPRESSION POINTER
8673: *
8674: {P$BXD{ENT{BL$P1{{{P1BLK
8675: {{JSR{EVALS{{{EVALUATE STRING ARGUMENT
8676: {{ERR{045{BREAKX{{EVALUATED ARGUMENT IS NOT STRING
8677: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS
8678: {{PPM{PBRK1{{{MERGE WITH BREAK IF ALL OK
8679: {{EJC{{{{
8680: *
8681: * CURSOR ASSIGNMENT
8682: *
8683: * PARM1 NAME BASE
8684: * PARM2 NAME OFFSET
8685: *
8686: {P$CAS{ENT{BL$P2{{{P2BLK
8687: {{MOV{R9{-(SP){{SAVE NODE POINTER
8688: {{MOV{R7{-(SP){{SAVE CURSOR
8689: {{MOV{4*PARM1(R9){R10{{LOAD NAME BASE
8690: {{MTI{R7{{{LOAD CURSOR AS INTEGER
8691: {{MOV{4*PARM2(R9){R7{{LOAD NAME OFFSET
8692: {{JSR{ICBLD{{{GET ICBLK FOR CURSOR VALUE
8693: {{MOV{R7{R6{{MOVE NAME OFFSET
8694: {{MOV{R9{R7{{MOVE VALUE TO ASSIGN
8695: {{JSR{ASINP{{{PERFORM ASSIGNMENT
8696: {{PPM{FLPOP{{{FAIL ON ASSIGNMENT FAILURE
8697: {{MOV{(SP)+{R7{{ELSE RESTORE CURSOR
8698: {{MOV{(SP)+{R9{{RESTORE NODE POINTER
8699: {{BRN{SUCCP{{{AND SUCCEED MATCHING NULL
8700: {{EJC{{{{
8701: *
8702: * EXPRESSION NODE (P$EXA, INITIAL ENTRY)
8703: *
8704: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
8705: * ALGORITHMS FOR HANDLING EXPRESSION NODES.
8706: *
8707: * PARM1 EXPRESSION POINTER
8708: *
8709: {P$EXA{ENT{BL$P1{{{P1BLK
8710: {{JSR{EVALP{{{EVALUATE EXPRESSION
8711: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS
8712: {{BLO{R6{#P$AAA{PEXA1{JUMP IF RESULT IS NOT A PATTERN
8713: *
8714: * HERE IF RESULT OF EXPRESSION IS A PATTERN
8715: *
8716: {{MOV{R7{-(SP){{STACK DUMMY CURSOR
8717: {{MOV{R9{-(SP){{STACK PTR TO P$EXA NODE
8718: {{MOV{PMHBS{-(SP){{STACK HISTORY STACK BASE PTR
8719: {{MOV{#NDEXB{-(SP){{STACK PTR TO SPECIAL NODE NDEXB
8720: {{MOV{SP{PMHBS{{STORE NEW STACK BASE POINTER
8721: {{MOV{R10{R9{{COPY NODE POINTER
8722: {{BRI{(R9){{{MATCH FIRST NODE IN EXPRESSION PAT
8723: *
8724: * HERE IF RESULT OF EXPRESSION IS NOT A PATTERN
8725: *
8726: {PEXA1{BEQ{R6{#B$SCL{PEXA2{JUMP IF IT IS ALREADY A STRING
8727: {{MOV{R10{-(SP){{ELSE STACK RESULT
8728: {{MOV{R9{R10{{SAVE NODE POINTER
8729: {{JSR{GTSTG{{{CONVERT RESULT TO STRING
8730: {{ERR{046{EXPRESSION{{DOES NOT EVALUATE TO PATTERN
8731: {{MOV{R9{R8{{COPY STRING POINTER
8732: {{MOV{R10{R9{{RESTORE NODE POINTER
8733: {{MOV{R8{R10{{COPY STRING POINTER AGAIN
8734: *
8735: * MERGE HERE WITH STRING POINTER IN XL
8736: *
8737: {PEXA2{BZE{4*SCLEN(R10){SUCCP{{JUST SUCCEED IF NULL STRING
8738: {{BRN{PSTR1{{{ELSE MERGE WITH STRING CIRCUIT
8739: {{EJC{{{{
8740: *
8741: * EXPRESSION NODE (P$EXB, REMOVE NDEXB ENTRY)
8742: *
8743: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
8744: * ALGORITHMS FOR HANDLING EXPRESSION NODES.
8745: *
8746: * NO PARAMETERS (DUMMY PATTERN)
8747: *
8748: {P$EXB{ENT{{{{ENTRY POINT
8749: {{MOV{R7{PMHBS{{RESTORE OUTER LEVEL STACK POINTER
8750: {{BRN{FLPOP{{{FAIL AND POP P$EXA NODE PTR
8751: {{EJC{{{{
8752: *
8753: * EXPRESSION NODE (P$EXC, REMOVE NDEXC ENTRY)
8754: *
8755: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
8756: * ALGORITHMS FOR HANDLING EXPRESSION NODES.
8757: *
8758: * NO PARAMETERS (DUMMY PATTERN)
8759: *
8760: {P$EXC{ENT{{{{ENTRY POINT
8761: {{MOV{R7{PMHBS{{RESTORE INNER STACK BASE POINTER
8762: {{BRN{FAILP{{{AND FAIL INTO EXPR PATTERN ALTERNVS
8763: {{EJC{{{{
8764: *
8765: * FAIL
8766: *
8767: * NO PARAMETERS
8768: *
8769: {P$FAL{ENT{BL$P0{{{P0BLK
8770: {{BRN{FAILP{{{JUST SIGNAL FAILURE
8771: {{EJC{{{{
8772: *
8773: * FENCE
8774: *
8775: * SEE COMPOUND PATTERNS SECTION FOR THE STRUCTURE AND
8776: * ALGORITHM FOR MATCHING THIS NODE TYPE.
8777: *
8778: * NO PARAMETERS
8779: *
8780: {P$FEN{ENT{BL$P0{{{P0BLK
8781: {{MOV{R7{-(SP){{STACK DUMMY CURSOR
8782: {{MOV{#NDABO{-(SP){{STACK PTR TO ABORT NODE
8783: {{BRN{SUCCP{{{AND SUCCEED MATCHING NULL
8784: {{EJC{{{{
8785: *
8786: * FENCE (FUNCTION)
8787: *
8788: * SEE COMPOUND PATTERNS COMMENTS AT START OF THIS SECTION
8789: * FOR DETAILS OF SCHEME
8790: *
8791: * NO PARAMETERS
8792: *
8793: {P$FNA{ENT{BL$P0{{{P0BLK
8794: {{MOV{PMHBS{-(SP){{STACK CURRENT HISTORY STACK BASE
8795: {{MOV{#NDFNB{-(SP){{STACK INDIR PTR TO P$FNB (FAILURE)
8796: {{MOV{SP{PMHBS{{BEGIN NEW HISTORY STACK
8797: {{BRN{SUCCP{{{SUCCEED
8798: {{EJC{{{{
8799: *
8800: * FENCE (FUNCTION) (RESET HISTORY STACK AND FAIL)
8801: *
8802: * NO PARAMETERS (DUMMY PATTERN)
8803: *
8804: {P$FNB{ENT{BL$P0{{{P0BLK
8805: {{MOV{R7{PMHBS{{RESTORE OUTER PMHBS STACK BASE
8806: {{BRN{FAILP{{{...AND FAIL
8807: {{EJC{{{{
8808: *
8809: * FENCE (FUNCTION) (MAKE FENCE TRAP ENTRY ON STACK)
8810: *
8811: * NO PARAMETERS (DUMMY PATTERN)
8812: *
8813: {P$FNC{ENT{BL$P0{{{P0BLK
8814: {{MOV{PMHBS{R10{{GET INNER STACK BASE PTR
8815: {{MOV{4*NUM01(R10){PMHBS{{RESTORE OUTER STACK BASE
8816: {{BEQ{R10{SP{PFNC1{OPTIMIZE IF NO ALTERNATIVES
8817: {{MOV{R10{-(SP){{ELSE STACK INNER STACK BASE
8818: {{MOV{#NDFND{-(SP){{STACK PTR TO NDFND
8819: {{BRN{SUCCP{{{SUCCEED
8820: *
8821: * HERE WHEN FENCE FUNCTION LEFT NOTHING ON THE STACK
8822: *
8823: {PFNC1{ADD{#4*NUM02{SP{{POP OFF P$FNB ENTRY
8824: {{BRN{SUCCP{{{SUCCEED
8825: {{EJC{{{{
8826: *
8827: * FENCE (FUNCTION) (SKIP PAST ALTERNATIVES ON FAILURE)
8828: *
8829: * NO PARAMETERS (DUMMY PATTERN)
8830: *
8831: {P$FND{ENT{BL$P0{{{P0BLK
8832: {{MOV{R7{SP{{POP STACK TO FENCE() HISTORY BASE
8833: {{BRN{FLPOP{{{POP BASE ENTRY AND FAIL
8834: {{EJC{{{{
8835: *
8836: * IMMEDIATE ASSIGNMENT (INITIAL ENTRY, SAVE CURRENT CURSOR)
8837: *
8838: * SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE
8839: * STRUCTURE AND ALGORITHM FOR MATCHING THIS NODE TYPE.
8840: *
8841: * NO PARAMETERS
8842: *
8843: {P$IMA{ENT{BL$P0{{{P0BLK
8844: {{MOV{R7{-(SP){{STACK CURSOR
8845: {{MOV{R9{-(SP){{STACK DUMMY NODE POINTER
8846: {{MOV{PMHBS{-(SP){{STACK OLD STACK BASE POINTER
8847: {{MOV{#NDIMB{-(SP){{STACK PTR TO SPECIAL NODE NDIMB
8848: {{MOV{SP{PMHBS{{STORE NEW STACK BASE POINTER
8849: {{BRN{SUCCP{{{AND SUCCEED
8850: {{EJC{{{{
8851: *
8852: * IMMEDIATE ASSIGNMENT (REMOVE CURSOR MARK ENTRY)
8853: *
8854: * SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE
8855: * STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE.
8856: *
8857: * NO PARAMETERS (DUMMY PATTERN)
8858: *
8859: {P$IMB{ENT{{{{ENTRY POINT
8860: {{MOV{R7{PMHBS{{RESTORE HISTORY STACK BASE PTR
8861: {{BRN{FLPOP{{{FAIL AND POP DUMMY NODE PTR
8862: {{EJC{{{{
8863: *
8864: * IMMEDIATE ASSIGNMENT (PERFORM ACTUAL ASSIGNMENT)
8865: *
8866: * SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE
8867: * STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE.
8868: *
8869: * PARM1 NAME BASE OF VARIABLE
8870: * PARM2 NAME OFFSET OF VARIABLE
8871: *
8872: {P$IMC{ENT{BL$P2{{{P2BLK
8873: {{MOV{PMHBS{R10{{LOAD POINTER TO P$IMB ENTRY
8874: {{MOV{R7{R6{{COPY FINAL CURSOR
8875: {{MOV{4*3(R10){R7{{LOAD INITIAL CURSOR
8876: {{MOV{4*1(R10){PMHBS{{RESTORE OUTER STACK BASE POINTER
8877: {{BEQ{R10{SP{PIMC1{JUMP IF NO HISTORY STACK ENTRIES
8878: {{MOV{R10{-(SP){{ELSE SAVE INNER PMHBS POINTER
8879: {{MOV{#NDIMD{-(SP){{AND A PTR TO SPECIAL NODE NDIMD
8880: {{BRN{PIMC2{{{MERGE
8881: *
8882: * HERE IF NO ENTRIES MADE ON HISTORY STACK
8883: *
8884: {PIMC1{ADD{#4*NUM04{SP{{REMOVE NDIMB ENTRY AND CURSOR
8885: *
8886: * MERGE HERE TO PERFORM ASSIGNMENT
8887: *
8888: {PIMC2{MOV{R6{-(SP){{SAVE CURRENT (FINAL) CURSOR
8889: {{MOV{R9{-(SP){{SAVE CURRENT NODE POINTER
8890: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
8891: {{SUB{R7{R6{{COMPUTE SUBSTRING LENGTH
8892: {{JSR{SBSTR{{{BUILD SUBSTRING
8893: {{MOV{R9{R7{{MOVE RESULT
8894: {{MOV{(SP){R9{{RELOAD NODE POINTER
8895: {{MOV{4*PARM1(R9){R10{{LOAD NAME BASE
8896: {{MOV{4*PARM2(R9){R6{{LOAD NAME OFFSET
8897: {{JSR{ASINP{{{PERFORM ASSIGNMENT
8898: {{PPM{FLPOP{{{FAIL IF ASSIGNMENT FAILS
8899: {{MOV{(SP)+{R9{{ELSE RESTORE NODE POINTER
8900: {{MOV{(SP)+{R7{{RESTORE CURSOR
8901: {{BRN{SUCCP{{{AND SUCCEED
8902: {{EJC{{{{
8903: *
8904: * IMMEDIATE ASSIGNMENT (REMOVE NDIMD ENTRY ON FAILURE)
8905: *
8906: * SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE
8907: * STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE.
8908: *
8909: * NO PARAMETERS (DUMMY PATTERN)
8910: *
8911: {P$IMD{ENT{{{{ENTRY POINT
8912: {{MOV{R7{PMHBS{{RESTORE INNER STACK BASE POINTER
8913: {{BRN{FAILP{{{AND FAIL
8914: {{EJC{{{{
8915: *
8916: * LEN (INTEGER ARGUMENT)
8917: *
8918: * PARM1 INTEGER ARGUMENT
8919: *
8920: {P$LEN{ENT{BL$P1{{{P1BLK
8921: *
8922: * EXPRESSION ARGUMENT CASE MERGES HERE
8923: *
8924: {PLEN1{ADD{4*PARM1(R9){R7{{PUSH CURSOR INDICATED AMOUNT
8925: {{BLE{R7{PMSSL{SUCCP{SUCCEED IF NOT OFF END
8926: {{BRN{FAILP{{{ELSE FAIL
8927: {{EJC{{{{
8928: *
8929: * LEN (EXPRESSION ARGUMENT)
8930: *
8931: * PARM1 EXPRESSION POINTER
8932: *
8933: {P$LND{ENT{BL$P1{{{P1BLK
8934: {{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT
8935: {{ERR{047{LEN{{EVALUATED ARGUMENT IS NOT INTEGER
8936: {{ERR{048{LEN{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
8937: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS
8938: {{PPM{PLEN1{{{MERGE WITH NORMAL CIRCUIT IF OK
8939: {{EJC{{{{
8940: *
8941: * NOTANY (EXPRESSION ARGUMENT)
8942: *
8943: * PARM1 EXPRESSION POINTER
8944: *
8945: {P$NAD{ENT{BL$P1{{{P1BLK
8946: {{JSR{EVALS{{{EVALUATE STRING ARGUMENT
8947: {{ERR{049{NOTANY{{EVALUATED ARGUMENT IS NOT STRING
8948: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS
8949: {{PPM{PNAY1{{{MERGE WITH MULTI-CHAR CASE IF OK
8950: {{EJC{{{{
8951: *
8952: * NOTANY (ONE CHARACTER ARGUMENT)
8953: *
8954: * PARM1 CHARACTER ARGUMENT
8955: *
8956: {P$NAS{ENT{BL$P1{{{ENTRY POINT
8957: {{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARS LEFT
8958: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
8959: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER IN STRIN
8960: {{LCH{R6{(R10){{LOAD CURRENT CHARACTER
8961: {{BEQ{R6{4*PARM1(R9){FAILP{FAIL IF MATCH
8962: {{ICV{R7{{{ELSE BUMP CURSOR
8963: {{BRN{SUCCP{{{AND SUCCEED
8964: {{EJC{{{{
8965: *
8966: * NOTANY (MULTI-CHARACTER STRING ARGUMENT)
8967: *
8968: * PARM1 POINTER TO CTBLK
8969: * PARM2 BIT MASK TO SELECT BIT COLUMN
8970: *
8971: {P$NAY{ENT{BL$P2{{{P2BLK
8972: *
8973: * EXPRESSION ARGUMENT CASE MERGES HERE
8974: *
8975: {PNAY1{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARACTERS LEFT
8976: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
8977: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER
8978: {{LCH{R6{(R10){{LOAD CURRENT CHARACTER
8979: {{WTB{R6{{{CONVERT TO BYTE OFFSET
8980: {{MOV{4*PARM1(R9){R10{{LOAD POINTER TO CTBLK
8981: {{ADD{R6{R10{{POINT TO ENTRY IN CTBLK
8982: {{MOV{4*CTCHS(R10){R6{{LOAD ENTRY FROM CTBLK
8983: {{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT
8984: {{NZB{R6{FAILP{{FAIL IF CHARACTER IS MATCHED
8985: {{ICV{R7{{{ELSE BUMP CURSOR
8986: {{BRN{SUCCP{{{AND SUCCEED
8987: {{EJC{{{{
8988: *
8989: * END OF PATTERN MATCH
8990: *
8991: * THIS ROUTINE IS ENTERED ON SUCCESSFUL COMPLETION.
8992: * SEE DESCRIPTION OF EXPRESSION PATTERNS IN COMPOUND
8993: * PATTERN SECTION FOR HANDLING OF RECURSION IN MATCHING.
8994: *
8995: * NO PARAMETERS (DUMMY PATTERN)
8996: *
8997: {P$NTH{ENT{{{{ENTRY POINT
8998: {{MOV{PMHBS{R10{{LOAD POINTER TO BASE OF STACK
8999: {{MOV{4*1(R10){R6{{LOAD SAVED PMHBS (OR PATTERN TYPE)
9000: {{BLE{R6{#NUM02{PNTH2{JUMP IF OUTER LEVEL (PATTERN TYPE)
9001: *
9002: * HERE WE ARE AT THE END OF MATCHING AN EXPRESSION PATTERN
9003: *
9004: {{MOV{R6{PMHBS{{RESTORE OUTER STACK BASE POINTER
9005: {{MOV{4*2(R10){R9{{RESTORE POINTER TO P$EXA NODE
9006: {{BEQ{R10{SP{PNTH1{JUMP IF NO HISTORY STACK ENTRIES
9007: {{MOV{R10{-(SP){{ELSE STACK INNER STACK BASE PTR
9008: {{MOV{#NDEXC{-(SP){{STACK PTR TO SPECIAL NODE NDEXC
9009: {{BRN{SUCCP{{{AND SUCCEED
9010: *
9011: * HERE IF NO HISTORY STACK ENTRIES DURING PATTERN
9012: *
9013: {PNTH1{ADD{#4*NUM04{SP{{REMOVE P$EXB ENTRY AND NODE PTR
9014: {{BRN{SUCCP{{{AND SUCCEED
9015: *
9016: * HERE IF END OF MATCH AT OUTER LEVEL
9017: *
9018: {PNTH2{MOV{R7{PMSSL{{SAVE FINAL CURSOR IN SAFE PLACE
9019: {{BZE{PMDFL{PNTH6{{JUMP IF NO PATTERN ASSIGNMENTS
9020: {{EJC{{{{
9021: *
9022: * END OF PATTERN MATCH (CONTINUED)
9023: *
9024: * NOW WE MUST PERFORM PATTERN ASSIGNMENTS. THIS IS DONE BY
9025: * SCANNING THE HISTORY STACK FOR MATCHING NDPAB-NDPAD PAIRS
9026: *
9027: {PNTH3{DCA{R10{{{POINT PAST CURSOR ENTRY
9028: {{MOV{-(R10){R6{{LOAD NODE POINTER
9029: {{BEQ{R6{#NDPAD{PNTH4{JUMP IF NDPAD ENTRY
9030: {{BNE{R6{#NDPAB{PNTH5{JUMP IF NOT NDPAB ENTRY
9031: *
9032: * HERE FOR NDPAB ENTRY, STACK INITIAL CURSOR
9033: * NOTE THAT THERE MUST BE MORE ENTRIES ON THE STACK.
9034: *
9035: {{MOV{4*1(R10){-(SP){{STACK INITIAL CURSOR
9036: {{CHK{{{{CHECK FOR STACK OVERFLOW
9037: {{BRN{PNTH3{{{LOOP BACK IF OK
9038: *
9039: * HERE FOR NDPAD ENTRY. THE STARTING CURSOR FROM THE
9040: * MATCHING NDPAD ENTRY IS NOW THE TOP STACK ENTRY.
9041: *
9042: {PNTH4{MOV{4*1(R10){R6{{LOAD FINAL CURSOR
9043: {{MOV{(SP){R7{{LOAD INITIAL CURSOR FROM STACK
9044: {{MOV{R10{(SP){{SAVE HISTORY STACK SCAN PTR
9045: {{SUB{R7{R6{{COMPUTE LENGTH OF STRING
9046: *
9047: * BUILD SUBSTRING AND PERFORM ASSIGNMENT
9048: *
9049: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
9050: {{JSR{SBSTR{{{CONSTRUCT SUBSTRING
9051: {{MOV{R9{R7{{COPY SUBSTRING POINTER
9052: {{MOV{(SP){R10{{RELOAD HISTORY STACK SCAN PTR
9053: {{MOV{4*2(R10){R10{{LOAD POINTER TO P$PAC NODE WITH NAM
9054: {{MOV{4*PARM2(R10){R6{{LOAD NAME OFFSET
9055: {{MOV{4*PARM1(R10){R10{{LOAD NAME BASE
9056: {{JSR{ASINP{{{PERFORM ASSIGNMENT
9057: {{PPM{EXFAL{{{MATCH FAILS IF NAME EVAL FAILS
9058: {{MOV{(SP)+{R10{{ELSE RESTORE HISTORY STACK PTR
9059: {{EJC{{{{
9060: *
9061: * END OF PATTERN MATCH (CONTINUED)
9062: *
9063: * HERE CHECK FOR END OF ENTRIES
9064: *
9065: {PNTH5{BNE{R10{SP{PNTH3{LOOP IF MORE ENTRIES TO SCAN
9066: *
9067: * HERE AFTER DEALING WITH PATTERN ASSIGNMENTS
9068: *
9069: {PNTH6{MOV{PMHBS{SP{{WIPE OUT HISTORY STACK
9070: {{MOV{(SP)+{R7{{LOAD INITIAL CURSOR
9071: {{MOV{(SP)+{R8{{LOAD MATCH TYPE CODE
9072: {{MOV{PMSSL{R6{{LOAD FINAL CURSOR VALUE
9073: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
9074: {{ZER{R$PMS{{{CLEAR SUBJECT STRING PTR FOR GBCOL
9075: {{BZE{R8{PNTH7{{JUMP IF CALL BY NAME
9076: {{BEQ{R8{#NUM02{EXITS{EXIT IF STATEMENT LEVEL CALL
9077: *
9078: * HERE WE HAVE A CALL BY VALUE, BUILD SUBSTRING
9079: *
9080: {{SUB{R7{R6{{COMPUTE LENGTH OF STRING
9081: {{JSR{SBSTR{{{BUILD SUBSTRING
9082: {{BRN{EXIXR{{{AND EXIT WITH SUBSTRING VALUE
9083: *
9084: * HERE FOR CALL BY NAME, MAKE STACK ENTRIES FOR O$RPL
9085: *
9086: {PNTH7{MOV{R7{-(SP){{STACK INITIAL CURSOR
9087: {{MOV{R6{-(SP){{STACK FINAL CURSOR
9088: {{BZE{R$PMB{PNTH8{{SKIP IF SUBJECT NOT BUFFER
9089: {{MOV{R$PMB{R10{{ELSE GET PTR TO BCBLK INSTEAD
9090: *
9091: * HERE WITH XL POINTING TO SCBLK OR BCBLK
9092: *
9093: {PNTH8{MOV{R10{-(SP){{STACK SUBJECT POINTER
9094: {{BRN{EXITS{{{EXIT WITH SPECIAL ENTRY ON STACK
9095: {{EJC{{{{
9096: *
9097: * POS (INTEGER ARGUMENT)
9098: *
9099: * PARM1 INTEGER ARGUMENT
9100: *
9101: {P$POS{ENT{BL$P1{{{P1BLK
9102: *
9103: * EXPRESSION ARGUMENT CASE MERGES HERE
9104: *
9105: {PPOS1{BEQ{R7{4*PARM1(R9){SUCCP{SUCCEED IF AT RIGHT LOCATION
9106: {{BRN{FAILP{{{ELSE FAIL
9107: {{EJC{{{{
9108: *
9109: * POS (EXPRESSION ARGUMENT)
9110: *
9111: * PARM1 EXPRESSION POINTER
9112: *
9113: {P$PSD{ENT{BL$P1{{{P1BLK
9114: {{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT
9115: {{ERR{050{POS{{EVALUATED ARGUMENT IS NOT INTEGER
9116: {{ERR{051{POS{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
9117: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS
9118: {{PPM{PPOS1{{{MERGE WITH NORMAL CASE IF OK
9119: {{EJC{{{{
9120: *
9121: * PATTERN ASSIGNMENT (INITIAL ENTRY, SAVE CURSOR)
9122: *
9123: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
9124: * ALGORITHMS FOR MATCHING THIS NODE TYPE.
9125: *
9126: * NO PARAMETERS
9127: *
9128: {P$PAA{ENT{BL$P0{{{P0BLK
9129: {{MOV{R7{-(SP){{STACK INITIAL CURSOR
9130: {{MOV{#NDPAB{-(SP){{STACK PTR TO NDPAB SPECIAL NODE
9131: {{BRN{SUCCP{{{AND SUCCEED MATCHING NULL
9132: {{EJC{{{{
9133: *
9134: * PATTERN ASSIGNMENT (REMOVE SAVED CURSOR)
9135: *
9136: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
9137: * ALGORITHMS FOR MATCHING THIS NODE TYPE.
9138: *
9139: * NO PARAMETERS (DUMMY PATTERN)
9140: *
9141: {P$PAB{ENT{{{{ENTRY POINT
9142: {{BRN{FAILP{{{JUST FAIL (ENTRY IS ALREADY POPPED)
9143: {{EJC{{{{
9144: *
9145: * PATTERN ASSIGNMENT (END OF MATCH, MAKE ASSIGN ENTRY)
9146: *
9147: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
9148: * ALGORITHMS FOR MATCHING THIS NODE TYPE.
9149: *
9150: * PARM1 NAME BASE OF VARIABLE
9151: * PARM2 NAME OFFSET OF VARIABLE
9152: *
9153: {P$PAC{ENT{BL$P2{{{P2BLK
9154: {{MOV{R7{-(SP){{STACK DUMMY CURSOR VALUE
9155: {{MOV{R9{-(SP){{STACK POINTER TO P$PAC NODE
9156: {{MOV{R7{-(SP){{STACK FINAL CURSOR
9157: {{MOV{#NDPAD{-(SP){{STACK PTR TO SPECIAL NDPAD NODE
9158: {{MNZ{PMDFL{{{SET DOT FLAG NON-ZERO
9159: {{BRN{SUCCP{{{AND SUCCEED
9160: {{EJC{{{{
9161: *
9162: * PATTERN ASSIGNMENT (REMOVE ASSIGN ENTRY)
9163: *
9164: * SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
9165: * ALGORITHMS FOR MATCHING THIS NODE TYPE.
9166: *
9167: * NO PARAMETERS (DUMMY NODE)
9168: *
9169: {P$PAD{ENT{{{{ENTRY POINT
9170: {{BRN{FLPOP{{{FAIL AND REMOVE P$PAC NODE
9171: {{EJC{{{{
9172: *
9173: * REM
9174: *
9175: * NO PARAMETERS
9176: *
9177: {P$REM{ENT{BL$P0{{{P0BLK
9178: {{MOV{PMSSL{R7{{POINT CURSOR TO END OF STRING
9179: {{BRN{SUCCP{{{AND SUCCEED
9180: {{EJC{{{{
9181: *
9182: * RPOS (EXPRESSION ARGUMENT)
9183: *
9184: * PARM1 EXPRESSION POINTER
9185: *
9186: {P$RPD{ENT{BL$P1{{{P1BLK
9187: {{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT
9188: {{ERR{052{RPOS{{EVALUATED ARGUMENT IS NOT INTEGER
9189: {{ERR{053{RPOS{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
9190: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS
9191: {{PPM{PRPS1{{{MERGE WITH NORMAL CASE IF OK
9192: {{EJC{{{{
9193: *
9194: * RPOS (INTEGER ARGUMENT)
9195: *
9196: * PARM1 INTEGER ARGUMENT
9197: *
9198: {P$RPS{ENT{BL$P1{{{P1BLK
9199: *
9200: * EXPRESSION ARGUMENT CASE MERGES HERE
9201: *
9202: {PRPS1{MOV{PMSSL{R8{{GET LENGTH OF STRING
9203: {{SUB{R7{R8{{GET NUMBER OF CHARACTERS REMAINING
9204: {{BEQ{R8{4*PARM1(R9){SUCCP{SUCCEED IF AT RIGHT LOCATION
9205: {{BRN{FAILP{{{ELSE FAIL
9206: {{EJC{{{{
9207: *
9208: * RTAB (INTEGER ARGUMENT)
9209: *
9210: * PARM1 INTEGER ARGUMENT
9211: *
9212: {P$RTB{ENT{BL$P1{{{P1BLK
9213: *
9214: * EXPRESSION ARGUMENT CASE MERGES HERE
9215: *
9216: {PRTB1{MOV{R7{R8{{SAVE INITIAL CURSOR
9217: {{MOV{PMSSL{R7{{POINT TO END OF STRING
9218: {{BLT{R7{4*PARM1(R9){FAILP{FAIL IF STRING NOT LONG ENOUGH
9219: {{SUB{4*PARM1(R9){R7{{ELSE SET NEW CURSOR
9220: {{BGE{R7{R8{SUCCP{AND SUCCEED IF NOT TOO FAR ALREADY
9221: {{BRN{FAILP{{{IN WHICH CASE, FAIL
9222: {{EJC{{{{
9223: *
9224: * RTAB (EXPRESSION ARGUMENT)
9225: *
9226: * PARM1 EXPRESSION POINTER
9227: *
9228: {P$RTD{ENT{BL$P1{{{P1BLK
9229: {{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT
9230: {{ERR{054{RTAB{{EVALUATED ARGUMENT IS NOT INTEGER
9231: {{ERR{055{RTAB{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
9232: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS
9233: {{PPM{PRTB1{{{MERGE WITH NORMAL CASE IF SUCCESS
9234: {{EJC{{{{
9235: *
9236: * SPAN (EXPRESSION ARGUMENT)
9237: *
9238: * PARM1 EXPRESSION POINTER
9239: *
9240: {P$SPD{ENT{BL$P1{{{P1BLK
9241: {{JSR{EVALS{{{EVALUATE STRING ARGUMENT
9242: {{ERR{056{SPAN{{EVALUATED ARGUMENT IS NOT STRING
9243: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS
9244: {{PPM{PSPN1{{{MERGE WITH MULTI-CHAR CASE IF OK
9245: {{EJC{{{{
9246: *
9247: * SPAN (MULTI-CHARACTER ARGUMENT CASE)
9248: *
9249: * PARM1 POINTER TO CTBLK
9250: * PARM2 BIT MASK TO SELECT BIT COLUMN
9251: *
9252: {P$SPN{ENT{BL$P2{{{P2BLK
9253: *
9254: * EXPRESSION ARGUMENT CASE MERGES HERE
9255: *
9256: {PSPN1{MOV{PMSSL{R8{{COPY SUBJECT STRING LENGTH
9257: {{SUB{R7{R8{{CALCULATE NUMBER OF CHARACTERS LEFT
9258: {{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT
9259: {{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
9260: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER
9261: {{MOV{R7{PSAVC{{SAVE INITIAL CURSOR
9262: {{MOV{R9{PSAVE{{SAVE NODE POINTER
9263: {{LCT{R8{R8{{SET COUNTER FOR CHARS LEFT
9264: *
9265: * LOOP TO SCAN MATCHING CHARACTERS
9266: *
9267: {PSPN2{LCH{R6{(R10)+{{LOAD NEXT CHARACTER, BUMP POINTER
9268: {{WTB{R6{{{CONVERT TO BYTE OFFSET
9269: {{MOV{4*PARM1(R9){R9{{POINT TO CTBLK
9270: {{ADD{R6{R9{{POINT TO CTBLK ENTRY
9271: {{MOV{4*CTCHS(R9){R6{{LOAD CTBLK ENTRY
9272: {{MOV{PSAVE{R9{{RESTORE NODE POINTER
9273: {{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT
9274: {{ZRB{R6{PSPN3{{JUMP IF NO MATCH
9275: {{ICV{R7{{{ELSE PUSH CURSOR
9276: {{BCT{R8{PSPN2{{LOOP BACK UNLESS END OF STRING
9277: *
9278: * HERE AFTER SCANNING MATCHING CHARACTERS
9279: *
9280: {PSPN3{BNE{R7{PSAVC{SUCCP{SUCCEED IF CHARS MATCHED
9281: {{BRN{FAILP{{{ELSE FAIL IF NULL STRING MATCHED
9282: {{EJC{{{{
9283: *
9284: * SPAN (ONE CHARACTER ARGUMENT)
9285: *
9286: * PARM1 CHARACTER ARGUMENT
9287: *
9288: {P$SPS{ENT{BL$P1{{{P1BLK
9289: {{MOV{PMSSL{R8{{GET SUBJECT STRING LENGTH
9290: {{SUB{R7{R8{{CALCULATE NUMBER OF CHARACTERS LEFT
9291: {{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT
9292: {{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
9293: {{PLC{R10{R7{{POINT TO CURRENT CHARACTER
9294: {{MOV{R7{PSAVC{{SAVE INITIAL CURSOR
9295: {{LCT{R8{R8{{SET COUNTER FOR CHARACTERS LEFT
9296: *
9297: * LOOP TO SCAN MATCHING CHARACTERS
9298: *
9299: {PSPS1{LCH{R6{(R10)+{{LOAD NEXT CHARACTER, BUMP POINTER
9300: {{BNE{R6{4*PARM1(R9){PSPS2{JUMP IF NO MATCH
9301: {{ICV{R7{{{ELSE PUSH CURSOR
9302: {{BCT{R8{PSPS1{{AND LOOP UNLESS END OF STRING
9303: *
9304: * HERE AFTER SCANNING MATCHING CHARACTERS
9305: *
9306: {PSPS2{BNE{R7{PSAVC{SUCCP{SUCCEED IF CHARS MATCHED
9307: {{BRN{FAILP{{{FAIL IF NULL STRING MATCHED
9308: {{EJC{{{{
9309: *
9310: * MULTI-CHARACTER STRING
9311: *
9312: * NOTE THAT ONE CHARACTER STRINGS USE THE CIRCUIT FOR
9313: * ONE CHARACTER ANY ARGUMENTS (P$AN1).
9314: *
9315: * PARM1 POINTER TO SCBLK FOR STRING ARG
9316: *
9317: {P$STR{ENT{BL$P1{{{P1BLK
9318: {{MOV{4*PARM1(R9){R10{{GET POINTER TO STRING
9319: *
9320: * MERGE HERE AFTER EVALUATING EXPRESSION WITH STRING VALUE
9321: *
9322: {PSTR1{MOV{R9{PSAVE{{SAVE NODE POINTER
9323: {{MOV{R$PMS{R9{{LOAD SUBJECT STRING POINTER
9324: {{PLC{R9{R7{{POINT TO CURRENT CHARACTER
9325: {{ADD{4*SCLEN(R10){R7{{COMPUTE NEW CURSOR POSITION
9326: {{BGT{R7{PMSSL{FAILP{FAIL IF PAST END OF STRING
9327: {{MOV{R7{PSAVC{{SAVE UPDATED CURSOR
9328: {{MOV{4*SCLEN(R10){R6{{GET NUMBER OF CHARS TO COMPARE
9329: {{PLC{R10{{{POINT TO CHARS OF TEST STRING
9330: {{CMC{FAILP{FAILP{{COMPARE, FAIL IF NOT EQUAL
9331: {{MOV{PSAVE{R9{{IF ALL MATCHED, RESTORE NODE PTR
9332: {{MOV{PSAVC{R7{{RESTORE UPDATED CURSOR
9333: {{BRN{SUCCP{{{AND SUCCEED
9334: {{EJC{{{{
9335: *
9336: * SUCCEED
9337: *
9338: * SEE SECTION ON COMPOUND PATTERNS FOR DETAILS OF THE
9339: * STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE
9340: *
9341: * NO PARAMETERS
9342: *
9343: {P$SUC{ENT{BL$P0{{{P0BLK
9344: {{MOV{R7{-(SP){{STACK CURSOR
9345: {{MOV{R9{-(SP){{STACK POINTER TO THIS NODE
9346: {{BRN{SUCCP{{{SUCCEED MATCHING NULL
9347: {{EJC{{{{
9348: *
9349: * TAB (INTEGER ARGUMENT)
9350: *
9351: * PARM1 INTEGER ARGUMENT
9352: *
9353: {P$TAB{ENT{BL$P1{{{P1BLK
9354: *
9355: * EXPRESSION ARGUMENT CASE MERGES HERE
9356: *
9357: {PTAB1{BGT{R7{4*PARM1(R9){FAILP{FAIL IF TOO FAR ALREADY
9358: {{MOV{4*PARM1(R9){R7{{ELSE SET NEW CURSOR POSITION
9359: {{BLE{R7{PMSSL{SUCCP{SUCCEED IF NOT OFF END
9360: {{BRN{FAILP{{{ELSE FAIL
9361: {{EJC{{{{
9362: *
9363: * TAB (EXPRESSION ARGUMENT)
9364: *
9365: * PARM1 EXPRESSION POINTER
9366: *
9367: {P$TBD{ENT{BL$P1{{{P1BLK
9368: {{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT
9369: {{ERR{057{TAB{{EVALUATED ARGUMENT IS NOT INTEGER
9370: {{ERR{058{TAB{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
9371: {{PPM{FAILP{{{FAIL IF EVALUATION FAILS
9372: {{PPM{PTAB1{{{MERGE WITH NORMAL CASE IF OK
9373: {{EJC{{{{
9374: *
9375: * ANCHOR MOVEMENT
9376: *
9377: * NO PARAMETERS (DUMMY NODE)
9378: *
9379: {P$UNA{ENT{{{{ENTRY POINT
9380: {{MOV{R7{R9{{COPY INITIAL PATTERN NODE POINTER
9381: {{MOV{(SP){R7{{GET INITIAL CURSOR
9382: {{BEQ{R7{PMSSL{EXFAL{MATCH FAILS IF AT END OF STRING
9383: {{ICV{R7{{{ELSE INCREMENT CURSOR
9384: {{MOV{R7{(SP){{STORE INCREMENTED CURSOR
9385: {{MOV{R9{-(SP){{RESTACK INITIAL NODE PTR
9386: {{MOV{#NDUNA{-(SP){{RESTACK UNANCHORED NODE
9387: {{BRI{(R9){{{REMATCH FIRST NODE
9388: {{EJC{{{{
9389: *
9390: * END OF PATTERN MATCH ROUTINES
9391: *
9392: * THE FOLLOWING ENTRY POINT MARKS THE END OF THE PATTERN
9393: * MATCHING ROUTINES AND ALSO THE END OF THE ENTRY POINTS
9394: * REFERENCED FROM THE FIRST WORD OF BLOCKS IN DYNAMIC STORE
9395: *
9396: {P$YYY{ENT{BL$$I{{{MARK LAST ENTRY IN PATTERN SECTION
9397: {{TTL{S{{{P I T B O L -- PREDEFINED SNOBOL4 FUNCTIONS
9398: *
9399: * THE FOLLOWING SECTION CONTAINS CODING FOR FUNCTIONS
9400: * WHICH ARE PREDEFINED AND AVAILABLE AT THE SNOBOL LEVEL.
9401: *
9402: * THESE ROUTINES RECEIVE CONTROL DIRECTLY FROM THE CODE OR
9403: * INDIRECTLY THROUGH THE O$FNC, O$FNS OR CFUNC ROUTINES.
9404: * IN BOTH CASES THE CONDITIONS ON ENTRY ARE AS FOLLOWS
9405: *
9406: * THE ARGUMENTS ARE ON THE STACK. THE NUMBER OF ARGUMENTS
9407: * HAS BEEN ADJUSTED TO CORRESPOND TO THE SVBLK SVNAR FIELD.
9408: *
9409: * IN CERTAIN FUNCTIONS THE DIRECT CALL IS NOT PERMITTED
9410: * AND IN THESE INSTANCES WE ALSO HAVE.
9411: *
9412: * (WA) ACTUAL NUMBER OF ARGUMENTS IN CALL
9413: *
9414: * CONTROL RETURNS BY PLACING THE FUNCTION RESULT VALUE ON
9415: * ON THE STACK AND CONTINUING EXECUTION WITH THE NEXT
9416: * WORD FROM THE GENERATED CODE.
9417: *
9418: * THE NAMES OF THE ENTRY POINTS OF THESE FUNCTIONS ARE OF
9419: * THE FORM S$XXX WHERE XXX IS THE THREE LETTER CODE FOR
9420: * THE SYSTEM VARIABLE NAME. THE FUNCTIONS ARE IN ORDER
9421: * ALPHABETICALLY BY THEIR ENTRY NAMES.
9422: {{EJC{{{{
9423: *
9424: * ANY
9425: *
9426: {S$ANY{ENT{{{{ENTRY POINT
9427: {{MOV{#P$ANS{R7{{SET PCODE FOR SINGLE CHAR CASE
9428: {{MOV{#P$ANY{R10{{PCODE FOR MULTI-CHAR CASE
9429: {{MOV{#P$AYD{R8{{PCODE FOR EXPRESSION CASE
9430: {{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE
9431: {{ERR{059{ANY{{ARGUMENT IS NOT STRING OR EXPRESSION
9432: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
9433: {{EJC{{{{
9434: *
9435: * APPEND
9436: *
9437: {S$APN{ENT{{{{ENTRY POINT
9438: {{MOV{(SP)+{R10{{GET APPEND ARGUMENT
9439: {{MOV{(SP)+{R9{{GET BCBLK
9440: {{BEQ{(R9){#B$BCT{SAPN1{OK IF FIRST ARG IS BCBLK
9441: {{ERB{275{APPEND{{FIRST ARGUMENT IS NOT BUFFER
9442: *
9443: * HERE TO DO THE APPEND
9444: *
9445: {SAPN1{JSR{APNDB{{{DO THE APPEND
9446: {{ERR{276{APPEND{{SECOND ARGUMENT IS NOT STRING
9447: {{PPM{EXFAL{{{NO ROOM - FAIL
9448: {{BRN{EXNUL{{{EXIT WITH NULL RESULT
9449: {{EJC{{{{
9450: *
9451: * APPLY
9452: *
9453: * APPLY DOES NOT PERMIT THE DIRECT (FAST) CALL SO THAT
9454: * WA CONTAINS THE ACTUAL NUMBER OF ARGUMENTS PASSED.
9455: *
9456: {S$APP{ENT{{{{ENTRY POINT
9457: {{BZE{R6{SAPP3{{JUMP IF NO ARGUMENTS
9458: {{DCV{R6{{{ELSE GET APPLIED FUNC ARG COUNT
9459: {{MOV{R6{R7{{COPY
9460: {{WTB{R7{{{CONVERT TO BYTES
9461: {{MOV{SP{R10{{COPY STACK POINTER
9462: {{ADD{R7{R10{{POINT TO FUNCTION ARGUMENT ON STACK
9463: {{MOV{(R10){R9{{LOAD FUNCTION PTR (APPLY 1ST ARG)
9464: {{BZE{R6{SAPP2{{JUMP IF NO ARGS FOR APPLIED FUNC
9465: {{LCT{R7{R6{{ELSE SET COUNTER FOR LOOP
9466: *
9467: * LOOP TO MOVE ARGUMENTS UP ON STACK
9468: *
9469: {SAPP1{DCA{R10{{{POINT TO NEXT ARGUMENT
9470: {{MOV{(R10){4*1(R10){{MOVE ARGUMENT UP
9471: {{BCT{R7{SAPP1{{LOOP TILL ALL MOVED
9472: *
9473: * MERGE HERE TO CALL FUNCTION (WA = NUMBER OF ARGUMENTS)
9474: *
9475: {SAPP2{ICA{SP{{{ADJUST STACK PTR FOR APPLY 1ST ARG
9476: {{JSR{GTNVR{{{GET VARIABLE BLOCK ADDR FOR FUNC
9477: {{PPM{SAPP3{{{JUMP IF NOT NATURAL VARIABLE
9478: {{MOV{4*VRFNC(R9){R10{{ELSE POINT TO FUNCTION BLOCK
9479: {{BRN{CFUNC{{{GO CALL APPLIED FUNCTION
9480: *
9481: * HERE FOR INVALID FIRST ARGUMENT
9482: *
9483: {SAPP3{ERB{060{APPLY{{FIRST ARG IS NOT NATURAL VARIABLE NAME
9484: {{EJC{{{{
9485: *
9486: * ARBNO
9487: *
9488: * ARBNO BUILDS A COMPOUND PATTERN. SEE DESCRIPTION AT
9489: * START OF PATTERN MATCHING SECTION FOR STRUCTURE FORMED.
9490: *
9491: {S$ABN{ENT{{{{ENTRY POINT
9492: {{ZER{R9{{{SET PARM1 = 0 FOR THE MOMENT
9493: {{MOV{#P$ALT{R7{{SET PCODE FOR ALTERNATIVE NODE
9494: {{JSR{PBILD{{{BUILD ALTERNATIVE NODE
9495: {{MOV{R9{R10{{SAVE PTR TO ALTERNATIVE PATTERN
9496: {{MOV{#P$ABC{R7{{PCODE FOR P$ABC
9497: {{ZER{R9{{{P0BLK
9498: {{JSR{PBILD{{{BUILD P$ABC NODE
9499: {{MOV{R10{4*PTHEN(R9){{PUT ALTERNATIVE NODE AS SUCCESSOR
9500: {{MOV{R10{R6{{REMEMBER ALTERNATIVE NODE POINTER
9501: {{MOV{R9{R10{{COPY P$ABC NODE PTR
9502: {{MOV{(SP){R9{{LOAD ARBNO ARGUMENT
9503: {{MOV{R6{(SP){{STACK ALTERNATIVE NODE POINTER
9504: {{JSR{GTPAT{{{GET ARBNO ARGUMENT AS PATTERN
9505: {{ERR{061{ARBNO{{ARGUMENT IS NOT PATTERN
9506: {{JSR{PCONC{{{CONCAT ARG WITH P$ABC NODE
9507: {{MOV{R9{R10{{REMEMBER PTR TO CONCD PATTERNS
9508: {{MOV{#P$ABA{R7{{PCODE FOR P$ABA
9509: {{ZER{R9{{{P0BLK
9510: {{JSR{PBILD{{{BUILD P$ABA NODE
9511: {{MOV{R10{4*PTHEN(R9){{CONCATENATE NODES
9512: {{MOV{(SP){R10{{RECALL PTR TO ALTERNATIVE NODE
9513: {{MOV{R9{4*PARM1(R10){{POINT ALTERNATIVE BACK TO ARGUMENT
9514: {{BRN{EXITS{{{JUMP FOR NEXT CODE WORD
9515: {{EJC{{{{
9516: *
9517: * ARG
9518: *
9519: {S$ARG{ENT{{{{ENTRY POINT
9520: {{JSR{GTSMI{{{GET SECOND ARG AS SMALL INTEGER
9521: {{ERR{062{ARG{{SECOND ARGUMENT IS NOT INTEGER
9522: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE OR NEGATIVE
9523: {{MOV{R9{R6{{SAVE ARGUMENT NUMBER
9524: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
9525: {{JSR{GTNVR{{{LOCATE VRBLK
9526: {{PPM{SARG1{{{JUMP IF NOT NATURAL VARIABLE
9527: {{MOV{4*VRFNC(R9){R9{{ELSE LOAD FUNCTION BLOCK POINTER
9528: {{BNE{(R9){#B$PFC{SARG1{JUMP IF NOT PROGRAM DEFINED
9529: {{BZE{R6{EXFAL{{FAIL IF ARG NUMBER IS ZERO
9530: {{BGT{R6{4*FARGS(R9){EXFAL{FAIL IF ARG NUMBER IS TOO LARGE
9531: {{WTB{R6{{{ELSE CONVERT TO BYTE OFFSET
9532: {{ADD{R6{R9{{POINT TO ARGUMENT SELECTED
9533: {{MOV{4*PFAGB(R9){R9{{LOAD ARGUMENT VRBLK POINTER
9534: {{BRN{EXVNM{{{EXIT TO BUILD NMBLK
9535: *
9536: * HERE IF 1ST ARGUMENT IS BAD
9537: *
9538: {SARG1{ERB{063{ARG{{FIRST ARGUMENT IS NOT PROGRAM FUNCTION NAME
9539: {{EJC{{{{
9540: *
9541: * ARRAY
9542: *
9543: {S$ARR{ENT{{{{ENTRY POINT
9544: {{MOV{(SP)+{R10{{LOAD INITIAL ELEMENT VALUE
9545: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
9546: {{JSR{GTINT{{{CONVERT FIRST ARG TO INTEGER
9547: {{PPM{SAR02{{{JUMP IF NOT INTEGER
9548: *
9549: * HERE FOR INTEGER FIRST ARGUMENT, BUILD VCBLK
9550: *
9551: {{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE
9552: {{ILE{SAR10{{{JUMP IF ZERO OR NEG (BAD DIMENSION)
9553: {{MFI{R6{SAR11{{ELSE CONVERT TO ONE WORD, TEST OVFL
9554: {{LCT{R7{R6{{COPY ELEMENTS FOR LOOP LATER ON
9555: {{ADD{#VCSI${R6{{ADD SPACE FOR STANDARD FIELDS
9556: {{WTB{R6{{{CONVERT LENGTH TO BYTES
9557: {{BGE{R6{MXLEN{SAR11{FAIL IF TOO LARGE
9558: {{JSR{ALLOC{{{ALLOCATE SPACE FOR VCBLK
9559: {{MOV{#B$VCT{(R9){{STORE TYPE WORD
9560: {{MOV{R6{4*VCLEN(R9){{SET LENGTH
9561: {{MOV{R10{R8{{COPY DEFAULT VALUE
9562: {{MOV{R9{R10{{COPY VCBLK POINTER
9563: {{ADD{#4*VCVLS{R10{{POINT TO FIRST ELEMENT VALUE
9564: *
9565: * LOOP TO SET VECTOR ELEMENTS TO DEFAULT VALUE
9566: *
9567: {SAR01{MOV{R8{(R10)+{{STORE ONE VALUE
9568: {{BCT{R7{SAR01{{LOOP TILL ALL STORED
9569: {{BRN{EXSID{{{EXIT SETTING IDVAL
9570: {{EJC{{{{
9571: *
9572: * ARRAY (CONTINUED)
9573: *
9574: * HERE IF FIRST ARGUMENT IS NOT AN INTEGER
9575: *
9576: {SAR02{MOV{R9{-(SP){{REPLACE ARGUMENT ON STACK
9577: {{JSR{XSCNI{{{INITIALIZE SCAN OF FIRST ARGUMENT
9578: {{ERR{064{ARRAY{{FIRST ARGUMENT IS NOT INTEGER OR STRING
9579: {{PPM{EXNUL{{{DUMMY (UNUSED) NULL STRING EXIT
9580: {{MOV{R$XSC{-(SP){{SAVE PROTOTYPE POINTER
9581: {{MOV{R10{-(SP){{SAVE DEFAULT VALUE
9582: {{ZER{ARCDM{{{ZERO COUNT OF DIMENSIONS
9583: {{ZER{ARPTR{{{ZERO OFFSET TO INDICATE PASS ONE
9584: {{LDI{INTV1{{{LOAD INTEGER ONE
9585: {{STI{ARNEL{{{INITIALIZE ELEMENT COUNT
9586: *
9587: * THE FOLLOWING CODE IS EXECUTED TWICE. THE FIRST TIME
9588: * (ARPTR EQ 0), IT IS USED TO COUNT THE NUMBER OF ELEMENTS
9589: * AND NUMBER OF DIMENSIONS. THE SECOND TIME (ARPTR GT 0) IS
9590: * USED TO ACTUALLY FILL IN THE DIM,LBD FIELDS OF THE ARBLK.
9591: *
9592: {SAR03{LDI{INTV1{{{LOAD ONE AS DEFAULT LOW BOUND
9593: {{STI{ARSVL{{{SAVE AS LOW BOUND
9594: {{MOV{#CH$CL{R8{{SET DELIMITER ONE = COLON
9595: {{MOV{#CH$CM{R10{{SET DELIMITER TWO = COMMA
9596: {{JSR{XSCAN{{{SCAN NEXT BOUND
9597: {{BNE{R6{#NUM01{SAR04{JUMP IF NOT COLON
9598: *
9599: * HERE WE HAVE A COLON ENDING A LOW BOUND
9600: *
9601: {{JSR{GTINT{{{CONVERT LOW BOUND
9602: {{ERR{065{ARRAY{{FIRST ARGUMENT LOWER BOUND IS NOT INTEGER
9603: {{LDI{4*ICVAL(R9){{{LOAD VALUE OF LOW BOUND
9604: {{STI{ARSVL{{{STORE LOW BOUND VALUE
9605: {{MOV{#CH$CM{R8{{SET DELIMITER ONE = COMMA
9606: {{MOV{R8{R10{{AND DELIMITER TWO = COMMA
9607: {{JSR{XSCAN{{{SCAN HIGH BOUND
9608: {{EJC{{{{
9609: *
9610: * ARRAY (CONTINUED)
9611: *
9612: * MERGE HERE TO PROCESS UPPER BOUND
9613: *
9614: {SAR04{JSR{GTINT{{{CONVERT HIGH BOUND TO INTEGER
9615: {{ERR{066{ARRAY{{FIRST ARGUMENT UPPER BOUND IS NOT INTEGER
9616: {{LDI{4*ICVAL(R9){{{GET HIGH BOUND
9617: {{SBI{ARSVL{{{SUBTRACT LOWER BOUND
9618: {{IOV{SAR10{{{BAD DIMENSION IF OVERFLOW
9619: {{ILT{SAR10{{{BAD DIMENSION IF NEGATIVE
9620: {{ADI{INTV1{{{ADD 1 TO GET DIMENSION
9621: {{IOV{SAR10{{{BAD DIMENSION IF OVERFLOW
9622: {{MOV{ARPTR{R10{{LOAD OFFSET (ALSO PASS INDICATOR)
9623: {{BZE{R10{SAR05{{JUMP IF FIRST PASS
9624: *
9625: * HERE IN SECOND PASS TO STORE LBD AND DIM IN ARBLK
9626: *
9627: {{ADD{(SP){R10{{POINT TO CURRENT LOCATION IN ARBLK
9628: {{STI{4*CFP$I(R10){{{STORE DIMENSION
9629: {{LDI{ARSVL{{{LOAD LOW BOUND
9630: {{STI{(R10){{{STORE LOW BOUND
9631: {{ADD{#4*ARDMS{ARPTR{{BUMP OFFSET TO NEXT BOUNDS
9632: {{BRN{SAR06{{{JUMP TO CHECK FOR END OF BOUNDS
9633: *
9634: * HERE IN PASS 1
9635: *
9636: {SAR05{ICV{ARCDM{{{BUMP DIMENSION COUNT
9637: {{MLI{ARNEL{{{MULTIPLY DIMENSION BY COUNT SO FAR
9638: {{IOV{SAR11{{{TOO LARGE IF OVERFLOW
9639: {{STI{ARNEL{{{ELSE STORE UPDATED ELEMENT COUNT
9640: *
9641: * MERGE HERE AFTER PROCESSING ONE SET OF BOUNDS
9642: *
9643: {SAR06{BNZ{R6{SAR03{{LOOP BACK UNLESS END OF BOUNDS
9644: {{BNZ{ARPTR{SAR09{{JUMP IF END OF PASS 2
9645: {{EJC{{{{
9646: *
9647: * ARRAY (CONTINUED)
9648: *
9649: * HERE AT END OF PASS ONE, BUILD ARBLK
9650: *
9651: {{LDI{ARNEL{{{GET NUMBER OF ELEMENTS
9652: {{MFI{R7{SAR11{{GET AS ADDR INTEGER, TEST OVFLO
9653: {{WTB{R7{{{ELSE CONVERT TO LENGTH IN BYTES
9654: {{MOV{#4*ARSI${R6{{SET SIZE OF STANDARD FIELDS
9655: {{LCT{R8{ARCDM{{SET DIMENSION COUNT TO CONTROL LOOP
9656: *
9657: * LOOP TO ALLOW SPACE FOR DIMENSIONS
9658: *
9659: {SAR07{ADD{#4*ARDMS{R6{{ALLOW SPACE FOR ONE SET OF BOUNDS
9660: {{BCT{R8{SAR07{{LOOP BACK TILL ALL ACCOUNTED FOR
9661: {{MOV{R6{R10{{SAVE SIZE (=AROFS)
9662: *
9663: * NOW ALLOCATE SPACE FOR ARBLK
9664: *
9665: {{ADD{R7{R6{{ADD SPACE FOR ELEMENTS
9666: {{ICA{R6{{{ALLOW FOR ARPRO PROTOTYPE FIELD
9667: {{BGE{R6{MXLEN{SAR11{FAIL IF TOO LARGE
9668: {{JSR{ALLOC{{{ELSE ALLOCATE ARBLK
9669: {{MOV{(SP){R7{{LOAD DEFAULT VALUE
9670: {{MOV{R9{(SP){{SAVE ARBLK POINTER
9671: {{MOV{R6{R8{{SAVE LENGTH IN BYTES
9672: {{BTW{R6{{{CONVERT LENGTH BACK TO WORDS
9673: {{LCT{R6{R6{{SET COUNTER TO CONTROL LOOP
9674: *
9675: * LOOP TO CLEAR ENTIRE ARBLK TO DEFAULT VALUE
9676: *
9677: {SAR08{MOV{R7{(R9)+{{SET ONE WORD
9678: {{BCT{R6{SAR08{{LOOP TILL ALL SET
9679: {{EJC{{{{
9680: *
9681: * ARRAY (CONTINUED)
9682: *
9683: * NOW SET INITIAL FIELDS OF ARBLK
9684: *
9685: {{MOV{(SP)+{R9{{RELOAD ARBLK POINTER
9686: {{MOV{(SP){R7{{LOAD PROTOTYPE
9687: {{MOV{#B$ART{(R9){{SET TYPE WORD
9688: {{MOV{R8{4*ARLEN(R9){{STORE LENGTH IN BYTES
9689: {{ZER{4*IDVAL(R9){{{ZERO ID TILL WE GET IT BUILT
9690: {{MOV{R10{4*AROFS(R9){{SET PROTOTYPE FIELD PTR
9691: {{MOV{ARCDM{4*ARNDM(R9){{SET NUMBER OF DIMENSIONS
9692: {{MOV{R9{R8{{SAVE ARBLK POINTER
9693: {{ADD{R10{R9{{POINT TO PROTOTYPE FIELD
9694: {{MOV{R7{(R9){{STORE PROTOTYPE PTR IN ARBLK
9695: {{MOV{#4*ARLBD{ARPTR{{SET OFFSET FOR PASS 2 BOUNDS SCAN
9696: {{MOV{R7{R$XSC{{RESET STRING POINTER FOR XSCAN
9697: {{MOV{R8{(SP){{STORE ARBLK POINTER ON STACK
9698: {{ZER{XSOFS{{{RESET OFFSET PTR TO START OF STRING
9699: {{BRN{SAR03{{{JUMP BACK TO RESCAN BOUNDS
9700: *
9701: * HERE AFTER FILLING IN BOUNDS INFORMATION (END PASS TWO)
9702: *
9703: {SAR09{MOV{(SP)+{R9{{RELOAD POINTER TO ARBLK
9704: {{BRN{EXSID{{{EXIT SETTING IDVAL
9705: *
9706: * HERE FOR BAD DIMENSION
9707: *
9708: {SAR10{ERB{067{ARRAY{{DIMENSION IS ZERO,NEGATIVE OR OUT OF RANGE
9709: *
9710: * HERE IF ARRAY IS TOO LARGE
9711: *
9712: {SAR11{ERB{068{ARRAY{{SIZE EXCEEDS MAXIMUM PERMITTED
9713: {{EJC{{{{
9714: *
9715: * BUFFER
9716: *
9717: {S$BUF{ENT{{{{ENTRY POINT
9718: {{MOV{(SP)+{R10{{GET INITIAL VALUE
9719: {{MOV{(SP)+{R9{{GET REQUESTED ALLOCATION
9720: {{JSR{GTINT{{{CONVERT TO INTEGER
9721: {{ERR{269{BUFFER{{FIRST ARGUMENT IS NOT INTEGER
9722: {{LDI{4*ICVAL(R9){{{GET VALUE
9723: {{ILE{SBF01{{{BRANCH IF NEGATIVE OR ZERO
9724: {{MFI{R6{SBF02{{MOVE WITH OVERFLOW CHECK
9725: {{JSR{ALOBF{{{ALLOCATE THE BUFFER
9726: {{JSR{APNDB{{{COPY IT IN
9727: {{ERR{270{BUFFER{{SECOND ARGUMENT IS NOT STRING OR BUFFER
9728: {{ERR{271{BUFFER{{INITIAL VALUE TOO BIG FOR ALLOCATION
9729: {{BRN{EXSID{{{EXIT SETTING IDVAL
9730: *
9731: * HERE FOR INVALID ALLOCATION SIZE
9732: *
9733: {SBF01{ERB{272{BUFFER{{FIRST ARGUMENT IS NOT POSITIVE
9734: *
9735: * HERE FOR ALLOCATION SIZE INTEGER OVERFLOW
9736: *
9737: {SBF02{ERB{273{BUFFER{{SIZE IS TOO BIG
9738: {{EJC{{{{
9739: *
9740: * BREAK
9741: *
9742: {S$BRK{ENT{{{{ENTRY POINT
9743: {{MOV{#P$BKS{R7{{SET PCODE FOR SINGLE CHAR CASE
9744: {{MOV{#P$BRK{R10{{PCODE FOR MULTI-CHAR CASE
9745: {{MOV{#P$BKD{R8{{PCODE FOR EXPRESSION CASE
9746: {{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE
9747: {{ERR{069{BREAK{{ARGUMENT IS NOT STRING OR EXPRESSION
9748: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
9749: {{EJC{{{{
9750: *
9751: * BREAKX
9752: *
9753: * BREAKX IS A COMPOUND PATTERN. SEE DESCRIPTION AT START
9754: * OF PATTERN MATCHING SECTION FOR STRUCTURE FORMED.
9755: *
9756: {S$BKX{ENT{{{{ENTRY POINT
9757: {{MOV{#P$BKS{R7{{PCODE FOR SINGLE CHAR ARGUMENT
9758: {{MOV{#P$BRK{R10{{PCODE FOR MULTI-CHAR ARGUMENT
9759: {{MOV{#P$BXD{R8{{PCODE FOR EXPRESSION CASE
9760: {{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE
9761: {{ERR{070{BREAKX{{ARGUMENT IS NOT STRING OR EXPRESSION
9762: *
9763: * NOW HOOK BREAKX NODE ON AT FRONT END
9764: *
9765: {{MOV{R9{-(SP){{SAVE PTR TO BREAK NODE
9766: {{MOV{#P$BKX{R7{{SET PCODE FOR BREAKX NODE
9767: {{JSR{PBILD{{{BUILD IT
9768: {{MOV{(SP){4*PTHEN(R9){{SET BREAK NODE AS SUCCESSOR
9769: {{MOV{#P$ALT{R7{{SET PCODE FOR ALTERNATION NODE
9770: {{JSR{PBILD{{{BUILD (PARM1=ALT=BREAKX NODE)
9771: {{MOV{R9{R6{{SAVE PTR TO ALTERNATION NODE
9772: {{MOV{(SP){R9{{POINT TO BREAK NODE
9773: {{MOV{R6{4*PTHEN(R9){{SET ALTERNATE NODE AS SUCCESSOR
9774: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK
9775: {{EJC{{{{
9776: *
9777: * CHAR
9778: *
9779: {S$CHR{ENT{{{{ENTRY POINT
9780: {{JSR{GTSMI{{{CONVERT ARG TO INTEGER
9781: {{ERR{281{CHAR{{ARGUMENT NOT INTEGER
9782: {{PPM{SCHR1{{{TOO BIG ERROR EXIT
9783: {{BGE{R8{#CFP$A{SCHR1{SEE IF OUT OF RANGE OF HOST SET
9784: {{MOV{#NUM01{R6{{IF NOT SET SCBLK ALLOCATION
9785: {{MOV{R8{R7{{SAVE CHAR CODE
9786: {{JSR{ALOCS{{{ALLOCATE 1 BAU SCBLK
9787: {{MOV{R9{R10{{COPY SCBLK POINTER
9788: {{PSC{R10{{{GET SET TO STUFF CHAR
9789: {{SCH{R7{(R10)+{{STUFF IT
9790: {{ZER{R10{{{CLEAR SLOP IN XL
9791: {{BRN{EXIXR{{{EXIT WITH SCBLK POINTER
9792: *
9793: * HERE IF CHAR ARGUMENT IS OUT OF RANGE
9794: *
9795: {SCHR1{ERB{282{CHAR{{ARGUMENT NOT IN RANGE
9796: {{EJC{{{{
9797: *
9798: * CLEAR
9799: *
9800: {S$CLR{ENT{{{{ENTRY POINT
9801: {{JSR{XSCNI{{{INITIALIZE TO SCAN ARGUMENT
9802: {{ERR{071{CLEAR{{ARGUMENT IS NOT STRING
9803: {{PPM{SCLR2{{{JUMP IF NULL
9804: *
9805: * LOOP TO SCAN OUT NAMES IN FIRST ARGUMENT. VARIABLES IN
9806: * THE LIST ARE FALGGED BY SETTING VRGET OF VRBLK TO ZERO.
9807: *
9808: {SCLR1{MOV{#CH$CM{R8{{SET DELIMITER ONE = COMMA
9809: {{MOV{R8{R10{{DELIMITER TWO = COMMA
9810: {{JSR{XSCAN{{{SCAN NEXT VARIABLE NAME
9811: {{JSR{GTNVR{{{LOCATE VRBLK
9812: {{ERR{072{CLEAR{{ARGUMENT HAS NULL VARIABLE NAME
9813: {{ZER{4*VRGET(R9){{{ELSE FLAG BY ZEROING VRGET FIELD
9814: {{BNZ{R6{SCLR1{{LOOP BACK IF STOPPED BY COMMA
9815: *
9816: * HERE AFTER FLAGGING VARIABLES IN ARGUMENT LIST
9817: *
9818: {SCLR2{MOV{HSHTB{R7{{POINT TO START OF HASH TABLE
9819: *
9820: * LOOP THROUGH SLOTS IN HASH TABLE
9821: *
9822: {SCLR3{BEQ{R7{HSHTE{EXNUL{EXIT RETURNING NULL IF NONE LEFT
9823: {{MOV{R7{R9{{ELSE COPY SLOT POINTER
9824: {{ICA{R7{{{BUMP SLOT POINTER
9825: {{SUB{#4*VRNXT{R9{{SET OFFSET TO MERGE INTO LOOP
9826: *
9827: * LOOP THROUGH VRBLKS ON ONE HASH CHAIN
9828: *
9829: {SCLR4{MOV{4*VRNXT(R9){R9{{POINT TO NEXT VRBLK ON CHAIN
9830: {{BZE{R9{SCLR3{{JUMP FOR NEXT BUCKET IF CHAIN END
9831: {{BNZ{4*VRGET(R9){SCLR5{{JUMP IF NOT FLAGGED
9832: {{EJC{{{{
9833: *
9834: * CLEAR (CONTINUED)
9835: *
9836: * HERE FOR FLAGGED VARIABLE, DO NOT SET VALUE TO NULL
9837: *
9838: {{JSR{SETVR{{{FOR FLAGGED VAR, RESTORE VRGET
9839: {{BRN{SCLR4{{{AND LOOP BACK FOR NEXT VRBLK
9840: *
9841: * HERE TO SET VALUE OF A VARIABLE TO NULL
9842: * PRROTECTED VARIABLES (ARB, ETC) ARE EXEMPT
9843: *
9844: {SCLR5{BEQ{4*VRSTO(R9){#B$VRE{SCLR4{CHECK FOR PROTECTED VARIABLE (REG05)
9845: {{MOV{R9{R10{{COPY VRBLK POINTER (REG05)
9846: *
9847: * LOOP TO LOCATE VALUE AT END OF POSSIBLE TRBLK CHAIN
9848: *
9849: {SCLR6{MOV{R10{R6{{SAVE BLOCK POINTER
9850: {{MOV{4*VRVAL(R10){R10{{LOAD NEXT VALUE FIELD
9851: {{BEQ{(R10){#B$TRT{SCLR6{LOOP BACK IF TRAPPED
9852: *
9853: * NOW STORE THE NULL VALUE
9854: *
9855: {{MOV{R6{R10{{RESTORE BLOCK POINTER
9856: {{MOV{#NULLS{4*VRVAL(R10){{STORE NULL CONSTANT VALUE
9857: {{BRN{SCLR4{{{LOOP BACK FOR NEXT VRBLK
9858: {{EJC{{{{
9859: *
9860: * CODE
9861: *
9862: {S$COD{ENT{{{{ENTRY POINT
9863: {{MOV{(SP)+{R9{{LOAD ARGUMENT
9864: {{JSR{GTCOD{{{CONVERT TO CODE
9865: {{PPM{EXFAL{{{FAIL IF CONVERSION IS IMPOSSIBLE
9866: {{BRN{EXIXR{{{ELSE RETURN CODE AS RESULT
9867: {{EJC{{{{
9868: *
9869: * COLLECT
9870: *
9871: {S$COL{ENT{{{{ENTRY POINT
9872: {{MOV{(SP)+{R9{{LOAD ARGUMENT
9873: {{JSR{GTINT{{{CONVERT TO INTEGER
9874: {{ERR{073{COLLECT{{ARGUMENT IS NOT INTEGER
9875: {{LDI{4*ICVAL(R9){{{LOAD COLLECT ARGUMENT
9876: {{STI{CLSVI{{{SAVE COLLECT ARGUMENT
9877: {{ZER{R7{{{SET NO MOVE UP
9878: {{JSR{GBCOL{{{PERFORM GARBAGE COLLECTION
9879: {{MOV{DNAME{R6{{POINT TO END OF MEMORY
9880: {{SUB{DNAMP{R6{{SUBTRACT NEXT LOCATION
9881: {{BTW{R6{{{CONVERT BYTES TO WORDS
9882: {{MTI{R6{{{CONVERT WORDS AVAILABLE AS INTEGER
9883: {{SBI{CLSVI{{{SUBTRACT ARGUMENT
9884: {{IOV{EXFAL{{{FAIL IF OVERFLOW
9885: {{ILT{EXFAL{{{FAIL IF NOT ENOUGH
9886: {{ADI{CLSVI{{{ELSE RECOMPUTE AVAILABLE
9887: {{BRN{EXINT{{{AND EXIT WITH INTEGER RESULT
9888: {{EJC{{{{
9889: *
9890: * CONVERT
9891: *
9892: {S$CNV{ENT{{{{ENTRY POINT
9893: {{JSR{GTSTG{{{CONVERT SECOND ARGUMENT TO STRING
9894: {{ERR{074{CONVERT{{SECOND ARGUMENT IS NOT STRING
9895: {{JSR{FLSTG{{{FOLD LOWER CASE TO UPPER CASE
9896: {{MOV{(SP){R10{{LOAD FIRST ARGUMENT
9897: {{BNE{(R10){#B$PDT{SCV01{JUMP IF NOT PROGRAM DEFINED
9898: *
9899: * HERE FOR PROGRAM DEFINED DATATYPE
9900: *
9901: {{MOV{4*PDDFP(R10){R10{{POINT TO DFBLK
9902: {{MOV{4*DFNAM(R10){R10{{LOAD DATATYPE NAME
9903: {{JSR{IDENT{{{COMPARE WITH SECOND ARG
9904: {{PPM{EXITS{{{EXIT IF IDENT WITH ARG AS RESULT
9905: {{BRN{EXFAL{{{ELSE FAIL
9906: *
9907: * HERE IF NOT PROGRAM DEFINED DATATYPE
9908: *
9909: {SCV01{MOV{R9{-(SP){{SAVE STRING ARGUMENT
9910: {{MOV{#SVCTB{R10{{POINT TO TABLE OF NAMES TO COMPARE
9911: {{ZER{R7{{{INITIALIZE COUNTER
9912: {{MOV{R6{R8{{SAVE LENGTH OF ARGUMENT STRING
9913: *
9914: * LOOP THROUGH TABLE ENTRIES
9915: *
9916: {SCV02{MOV{(R10)+{R9{{LOAD NEXT TABLE ENTRY, BUMP POINTER
9917: {{BZE{R9{EXFAL{{FAIL IF ZERO MARKING END OF LIST
9918: {{BNE{R8{4*SCLEN(R9){SCV05{JUMP IF WRONG LENGTH
9919: {{MOV{R10{CNVTP{{ELSE STORE TABLE POINTER
9920: {{PLC{R9{{{POINT TO CHARS OF TABLE ENTRY
9921: {{MOV{(SP){R10{{LOAD POINTER TO STRING ARGUMENT
9922: {{PLC{R10{{{POINT TO CHARS OF STRING ARG
9923: {{MOV{R8{R6{{SET NUMBER OF CHARS TO COMPARE
9924: {{CMC{SCV04{SCV04{{COMPARE, JUMP IF NO MATCH
9925: {{EJC{{{{
9926: *
9927: * CONVERT (CONTINUED)
9928: *
9929: * HERE WE HAVE A MATCH
9930: *
9931: {SCV03{MOV{R7{R10{{COPY ENTRY NUMBER
9932: {{ICA{SP{{{POP STRING ARG OFF STACK
9933: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
9934: {{BSW{R10{CNVTT{{JUMP TO APPROPRIATE ROUTINE
9935: {{IFF{0{SCV06{{STRING
9936: {{IFF{1{SCV07{{INTEGER
9937: {{IFF{2{SCV09{{NAME
9938: {{IFF{3{SCV10{{PATTERN
9939: {{IFF{4{SCV11{{ARRAY
9940: {{IFF{5{SCV19{{TABLE
9941: {{IFF{6{SCV25{{EXPRESSION
9942: {{IFF{7{SCV26{{CODE
9943: {{IFF{8{SCV27{{NUMERIC
9944: {{IFF{CNVRT{SCV08{{REAL
9945: {{IFF{CNVBT{SCV28{{BUFFER
9946: {{ESW{{{{END OF SWITCH TABLE
9947: *
9948: * HERE IF NO MATCH WITH TABLE ENTRY
9949: *
9950: {SCV04{MOV{CNVTP{R10{{RESTORE TABLE POINTER, MERGE
9951: *
9952: * MERGE HERE IF LENGTHS DID NOT MATCH
9953: *
9954: {SCV05{ICV{R7{{{BUMP ENTRY NUMBER
9955: {{BRN{SCV02{{{LOOP BACK TO CHECK NEXT ENTRY
9956: *
9957: * HERE TO CONVERT TO STRING
9958: *
9959: {SCV06{MOV{R9{-(SP){{REPLACE STRING ARGUMENT ON STACK
9960: {{JSR{GTSTG{{{CONVERT TO STRING
9961: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
9962: {{BRN{EXIXR{{{ELSE RETURN STRING
9963: {{EJC{{{{
9964: *
9965: * CONVERT (CONTINUED)
9966: *
9967: * HERE TO CONVERT TO INTEGER
9968: *
9969: {SCV07{JSR{GTINT{{{CONVERT TO INTEGER
9970: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
9971: {{BRN{EXIXR{{{ELSE RETURN INTEGER
9972: *
9973: * HERE TO CONVERT TO REAL
9974: *
9975: {SCV08{JSR{GTREA{{{CONVERT TO REAL
9976: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
9977: {{BRN{EXIXR{{{ELSE RETURN REAL
9978: *
9979: * HERE TO CONVERT TO NAME
9980: *
9981: {SCV09{BEQ{(R9){#B$NML{EXIXR{RETURN IF ALREADY A NAME
9982: {{JSR{GTNVR{{{ELSE TRY STRING TO NAME CONVERT
9983: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
9984: {{BRN{EXVNM{{{ELSE EXIT BUILDING NMBLK FOR VRBLK
9985: *
9986: * HERE TO CONVERT TO PATTERN
9987: *
9988: {SCV10{JSR{GTPAT{{{CONVERT TO PATTERN
9989: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
9990: {{BRN{EXIXR{{{ELSE RETURN PATTERN
9991: *
9992: * CONVERT TO ARRAY
9993: *
9994: {SCV11{JSR{GTARR{{{GET AN ARRAY
9995: {{PPM{EXFAL{{{FAIL IF NOT CONVERTIBLE
9996: {{BRN{EXSID{{{EXIT SETTING ID FIELD
9997: *
9998: * CONVERT TO TABLE
9999: *
10000: {SCV19{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK
10001: {{MOV{R9{-(SP){{REPLACE ARBLK POINTER ON STACK
10002: {{BEQ{R6{#B$TBT{EXITS{RETURN ARG IF ALREADY A TABLE
10003: {{BNE{R6{#B$ART{EXFAL{ELSE FAIL IF NOT AN ARRAY
10004: {{EJC{{{{
10005: *
10006: * CONVERT (CONTINUED)
10007: *
10008: * HERE TO CONVERT AN ARRAY TO TABLE
10009: *
10010: {{BNE{4*ARNDM(R9){#NUM02{EXFAL{FAIL IF NOT 2-DIM ARRAY
10011: {{LDI{4*ARDM2(R9){{{LOAD DIM 2
10012: {{SBI{INTV2{{{SUBTRACT 2 TO COMPARE
10013: {{INE{EXFAL{{{FAIL IF DIM2 NOT 2
10014: *
10015: * HERE WE HAVE AN ARBLK OF THE RIGHT SHAPE
10016: *
10017: {{LDI{4*ARDIM(R9){{{LOAD DIM 1 (NUMBER OF ELEMENTS)
10018: {{MFI{R6{{{GET AS ONE WORD INTEGER
10019: {{LCT{R7{R6{{COPY TO CONTROL LOOP
10020: {{ADD{#TBSI${R6{{ADD SPACE FOR STANDARD FIELDS
10021: {{WTB{R6{{{CONVERT LENGTH TO BYTES
10022: {{JSR{ALLOC{{{ALLOCATE SPACE FOR TBBLK
10023: {{MOV{R9{R8{{COPY TBBLK POINTER
10024: {{MOV{R9{-(SP){{SAVE TBBLK POINTER
10025: {{MOV{#B$TBT{(R9)+{{STORE TYPE WORD
10026: {{ZER{(R9)+{{{STORE ZERO FOR IDVAL FOR NOW
10027: {{MOV{R6{(R9)+{{STORE LENGTH
10028: {{MOV{#NULLS{(R9)+{{NULL INITIAL LOOKUP VALUE
10029: *
10030: * LOOP TO INITIALIZE BUCKET PTRS TO POINT TO TABLE
10031: *
10032: {SCV20{MOV{R8{(R9)+{{SET BUCKET PTR TO POINT TO TBBLK
10033: {{BCT{R7{SCV20{{LOOP TILL ALL INITIALIZED
10034: {{MOV{#4*ARVL2{R7{{SET OFFSET TO FIRST ARBLK ELEMENT
10035: *
10036: * LOOP TO COPY ELEMENTS FROM ARRAY TO TABLE
10037: *
10038: {SCV21{MOV{4*1(SP){R10{{POINT TO ARBLK
10039: {{BEQ{R7{4*ARLEN(R10){SCV24{JUMP IF ALL MOVED
10040: {{ADD{R7{R10{{ELSE POINT TO CURRENT LOCATION
10041: {{ADD{#4*NUM02{R7{{BUMP OFFSET
10042: {{MOV{(R10){R9{{LOAD SUBSCRIPT NAME
10043: {{DCA{R10{{{ADJUST PTR TO MERGE (TRVAL=1+1)
10044: {{EJC{{{{
10045: *
10046: * CONVERT (CONTINUED)
10047: *
10048: * LOOP TO CHASE DOWN TRBLK CHAIN FOR VALUE
10049: *
10050: {SCV22{MOV{4*TRVAL(R10){R10{{POINT TO NEXT VALUE
10051: {{BEQ{(R10){#B$TRT{SCV22{LOOP BACK IF TRAPPED
10052: *
10053: * HERE WITH NAME IN XR, VALUE IN XL
10054: *
10055: {SCV23{MOV{R10{-(SP){{STACK VALUE
10056: {{MOV{4*1(SP){R10{{LOAD TBBLK POINTER
10057: {{JSR{TFIND{{{BUILD TEBLK (NOTE WB GT 0 BY NAME)
10058: {{PPM{EXFAL{{{FAIL IF ACESS FAILS
10059: {{MOV{(SP)+{4*TEVAL(R10){{STORE VALUE IN TEBLK
10060: {{BRN{SCV21{{{LOOP BACK FOR NEXT ELEMENT
10061: *
10062: * HERE AFTER MOVING ALL ELEMENTS TO TBBLK
10063: *
10064: {SCV24{MOV{(SP)+{R9{{LOAD TBBLK POINTER
10065: {{ICA{SP{{{POP ARBLK POINTER
10066: {{BRN{EXSID{{{EXIT SETTING IDVAL
10067: *
10068: * CONVERT TO EXPRESSION
10069: *
10070: {SCV25{JSR{GTEXP{{{CONVERT TO EXPRESSION
10071: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
10072: {{BRN{EXIXR{{{ELSE RETURN EXPRESSION
10073: *
10074: * CONVERT TO CODE
10075: *
10076: {SCV26{JSR{GTCOD{{{CONVERT TO CODE
10077: {{PPM{EXFAL{{{FAIL IF CONVERSION IS NOT POSSIBLE
10078: {{BRN{EXIXR{{{ELSE RETURN CODE
10079: *
10080: * CONVERT TO NUMERIC
10081: *
10082: {SCV27{JSR{GTNUM{{{CONVERT TO NUMERIC
10083: {{PPM{EXFAL{{{FAIL IF UNCONVERTIBLE
10084: {{BRN{EXIXR{{{RETURN NUMBER
10085: {{EJC{{{{
10086: *
10087: * CONVERT TO BUFFER
10088: *
10089: {SCV28{MOV{R9{-(SP){{STACK STRING FOR PROCEDURE
10090: {{JSR{GTSTG{{{CONVERT TO STRING
10091: {{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
10092: {{MOV{R9{R10{{SAVE STRING POINTER
10093: {{JSR{ALOBF{{{ALLOCATE BUFFER OF SAME SIZE
10094: {{JSR{APNDB{{{COPY IN THE STRING
10095: {{PPM{{{{ALREADY STRING - CANT FAIL TO CNV
10096: {{PPM{{{{MUST BE ENOUGH ROOM
10097: {{BRN{EXSID{{{EXIT SETTING IDVAL FIELD
10098: {{EJC{{{{
10099: *
10100: * COPY
10101: *
10102: {S$COP{ENT{{{{ENTRY POINT
10103: {{JSR{COPYB{{{COPY THE BLOCK
10104: {{PPM{EXITS{{{RETURN IF NO IDVAL FIELD
10105: {{BRN{EXSID{{{EXIT SETTING ID VALUE
10106: {{EJC{{{{
10107: *
10108: * DATA
10109: *
10110: {S$DAT{ENT{{{{ENTRY POINT
10111: {{JSR{XSCNI{{{PREPARE TO SCAN ARGUMENT
10112: {{ERR{075{DATA{{ARGUMENT IS NOT STRING
10113: {{ERR{076{DATA{{ARGUMENT IS NULL
10114: *
10115: * SCAN OUT DATATYPE NAME
10116: *
10117: {{MOV{#CH$PP{R8{{DELIMITER ONE = LEFT PAREN
10118: {{MOV{R8{R10{{DELIMITER TWO = LEFT PAREN
10119: {{JSR{XSCAN{{{SCAN DATATYPE NAME
10120: {{BNZ{R6{SDAT1{{SKIP IF LEFT PAREN FOUND
10121: {{ERB{077{DATA{{ARGUMENT IS MISSING A LEFT PAREN
10122: *
10123: * HERE AFTER SCANNING DATATYPE NAME
10124: *
10125: {SDAT1{MOV{4*SCLEN(R9){R6{{GET LENGTH
10126: {{JSR{FLSTG{{{FOLD LOWER CASE TO UPPER CASE
10127: {{MOV{R9{R10{{SAVE NAME PTR
10128: {{MOV{4*SCLEN(R9){R6{{GET LENGTH
10129: {{CTB{R6{SCSI${{COMPUTE SPACE NEEDED
10130: {{JSR{ALOST{{{REQUEST STATIC STORE FOR NAME
10131: {{MOV{R9{-(SP){{SAVE DATATYPE NAME
10132: {{MVW{{{{COPY NAME TO STATIC
10133: {{MOV{(SP){R9{{GET NAME PTR
10134: {{ZER{R10{{{SCRUB DUD REGISTER
10135: {{JSR{GTNVR{{{LOCATE VRBLK FOR DATATYPE NAME
10136: {{ERR{078{DATA{{ARGUMENT HAS NULL DATATYPE NAME
10137: {{MOV{R9{DATDV{{SAVE VRBLK POINTER FOR DATATYPE
10138: {{MOV{SP{DATXS{{STORE STARTING STACK VALUE
10139: {{ZER{R7{{{ZERO COUNT OF FIELD NAMES
10140: *
10141: * LOOP TO SCAN FIELD NAMES AND STACK VRBLK POINTERS
10142: *
10143: {SDAT2{MOV{#CH$RP{R8{{DELIMITER ONE = RIGHT PAREN
10144: {{MOV{#CH$CM{R10{{DELIMITER TWO = COMMA
10145: {{JSR{XSCAN{{{SCAN NEXT FIELD NAME
10146: {{BNZ{R6{SDAT3{{JUMP IF DELIMITER FOUND
10147: {{ERB{079{DATA{{ARGUMENT IS MISSING A RIGHT PAREN
10148: *
10149: * HERE AFTER SCANNING OUT ONE FIELD NAME
10150: *
10151: {SDAT3{JSR{GTNVR{{{LOCATE VRBLK FOR FIELD NAME
10152: {{ERR{080{DATA{{ARGUMENT HAS NULL FIELD NAME
10153: {{MOV{R9{-(SP){{STACK VRBLK POINTER
10154: {{ICV{R7{{{INCREMENT COUNTER
10155: {{BEQ{R6{#NUM02{SDAT2{LOOP BACK IF STOPPED BY COMMA
10156: {{EJC{{{{
10157: *
10158: * DATA (CONTINUED)
10159: *
10160: * NOW BUILD THE DFBLK
10161: *
10162: {{MOV{#DFSI${R6{{SET SIZE OF DFBLK STANDARD FIELDS
10163: {{ADD{R7{R6{{ADD NUMBER OF FIELDS
10164: {{WTB{R6{{{CONVERT LENGTH TO BYTES
10165: {{MOV{R7{R8{{PRESERVE NO. OF FIELDS
10166: {{JSR{ALOST{{{ALLOCATE SPACE FOR DFBLK
10167: {{MOV{R8{R7{{GET NO OF FIELDS
10168: {{MOV{DATXS{R10{{POINT TO START OF STACK
10169: {{MOV{(R10){R8{{LOAD DATATYPE NAME
10170: {{MOV{R9{(R10){{SAVE DFBLK POINTER ON STACK
10171: {{MOV{#B$DFC{(R9)+{{STORE TYPE WORD
10172: {{MOV{R7{(R9)+{{STORE NUMBER OF FIELDS (FARGS)
10173: {{MOV{R6{(R9)+{{STORE LENGTH (DFLEN)
10174: {{SUB{#4*PDDFS{R6{{COMPUTE PDBLK LENGTH (FOR DFPDL)
10175: {{MOV{R6{(R9)+{{STORE PDBLK LENGTH (DFPDL)
10176: {{MOV{R8{(R9)+{{STORE DATATYPE NAME (DFNAM)
10177: {{LCT{R8{R7{{COPY NUMBER OF FIELDS
10178: *
10179: * LOOP TO MOVE FIELD NAME VRBLK POINTERS TO DFBLK
10180: *
10181: {SDAT4{MOV{-(R10){(R9)+{{MOVE ONE FIELD NAME VRBLK POINTER
10182: {{BCT{R8{SDAT4{{LOOP TILL ALL MOVED
10183: *
10184: * NOW DEFINE THE DATATYPE FUNCTION
10185: *
10186: {{MOV{R6{R8{{COPY LENGTH OF PDBLK FOR LATER LOOP
10187: {{MOV{DATDV{R9{{POINT TO VRBLK
10188: {{MOV{DATXS{R10{{POINT BACK ON STACK
10189: {{MOV{(R10){R10{{LOAD DFBLK POINTER
10190: {{JSR{DFFNC{{{DEFINE FUNCTION
10191: {{EJC{{{{
10192: *
10193: * DATA (CONTINUED)
10194: *
10195: * LOOP TO BUILD FFBLKS
10196: *
10197: *
10198: * NOTICE THAT THE FFBLKS ARE CONSTRUCTED IN REVERSE ORDER
10199: * SO THAT THE REQUIRED OFFSETS CAN BE OBTAINED FROM
10200: * SUCCESSIVE DECREMENTATION OF THE PDBLK LENGTH (IN WC).
10201: *
10202: {SDAT5{MOV{#4*FFSI${R6{{SET LENGTH OF FFBLK
10203: {{JSR{ALLOC{{{ALLOCATE SPACE FOR FFBLK
10204: {{MOV{#B$FFC{(R9){{SET TYPE WORD
10205: {{MOV{#NUM01{4*FARGS(R9){{STORE FARGS (ALWAYS ONE)
10206: {{MOV{DATXS{R10{{POINT BACK ON STACK
10207: {{MOV{(R10){4*FFDFP(R9){{COPY DFBLK PTR TO FFBLK
10208: {{DCA{R8{{{DECREMENT OLD DFPDL TO GET NEXT OFS
10209: {{MOV{R8{4*FFOFS(R9){{SET OFFSET TO THIS FIELD
10210: {{ZER{4*FFNXT(R9){{{TENTATIVELY SET ZERO FORWARD PTR
10211: {{MOV{R9{R10{{COPY FFBLK POINTER FOR DFFNC
10212: {{MOV{(SP){R9{{LOAD VRBLK POINTER FOR FIELD
10213: {{MOV{4*VRFNC(R9){R9{{LOAD CURRENT FUNCTION POINTER
10214: {{BNE{(R9){#B$FFC{SDAT6{SKIP IF NOT CURRENTLY A FIELD FUNC
10215: *
10216: * HERE WE MUST CHAIN AN OLD FFBLK PTR TO PRESERVE IT IN THE
10217: * CASE OF MULTIPLE FIELD FUNCTIONS WITH THE SAME NAME
10218: *
10219: {{MOV{R9{4*FFNXT(R10){{LINK NEW FFBLK TO PREVIOUS CHAIN
10220: *
10221: * MERGE HERE TO DEFINE FIELD FUNCTION
10222: *
10223: {SDAT6{MOV{(SP)+{R9{{LOAD VRBLK POINTER
10224: {{JSR{DFFNC{{{DEFINE FIELD FUNCTION
10225: {{BNE{SP{DATXS{SDAT5{LOOP BACK TILL ALL DONE
10226: {{ICA{SP{{{POP DFBLK POINTER
10227: {{BRN{EXNUL{{{RETURN WITH NULL RESULT
10228: {{EJC{{{{
10229: *
10230: * DATATYPE
10231: *
10232: {S$DTP{ENT{{{{ENTRY POINT
10233: {{MOV{(SP)+{R9{{LOAD ARGUMENT
10234: {{JSR{DTYPE{{{GET DATATYPE
10235: {{BRN{EXIXR{{{AND RETURN IT AS RESULT
10236: {{EJC{{{{
10237: *
10238: * DATE
10239: *
10240: {S$DTE{ENT{{{{ENTRY POINT
10241: {{JSR{SYSDT{{{CALL SYSTEM DATE ROUTINE
10242: {{MOV{4*1(R10){R6{{LOAD LENGTH FOR SBSTR
10243: {{BZE{R6{EXNUL{{RETURN NULL IF LENGTH IS ZERO
10244: {{ZER{R7{{{SET ZERO OFFSET
10245: {{JSR{SBSTR{{{USE SBSTR TO BUILD SCBLK
10246: {{BRN{EXIXR{{{RETURN DATE STRING
10247: {{EJC{{{{
10248: *
10249: * DEFINE
10250: *
10251: {S$DEF{ENT{{{{ENTRY POINT
10252: {{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT
10253: {{ZER{DEFLB{{{ZERO LABEL POINTER IN CASE NULL
10254: {{BEQ{R9{#NULLS{SDF01{JUMP IF NULL SECOND ARGUMENT
10255: {{JSR{GTNVR{{{ELSE FIND VRBLK FOR LABEL
10256: {{PPM{SDF13{{{JUMP IF NOT A VARIABLE NAME
10257: {{MOV{R9{DEFLB{{ELSE SET SPECIFIED ENTRY
10258: *
10259: * SCAN FUNCTION NAME
10260: *
10261: {SDF01{JSR{XSCNI{{{PREPARE TO SCAN FIRST ARGUMENT
10262: {{ERR{081{DEFINE{{FIRST ARGUMENT IS NOT STRING
10263: {{ERR{082{DEFINE{{FIRST ARGUMENT IS NULL
10264: {{MOV{#CH$PP{R8{{DELIMITER ONE = LEFT PAREN
10265: {{MOV{R8{R10{{DELIMITER TWO = LEFT PAREN
10266: {{JSR{XSCAN{{{SCAN OUT FUNCTION NAME
10267: {{BNZ{R6{SDF02{{JUMP IF LEFT PAREN FOUND
10268: {{ERB{083{DEFINE{{FIRST ARGUMENT IS MISSING A LEFT PAREN
10269: *
10270: * HERE AFTER SCANNING OUT FUNCTION NAME
10271: *
10272: {SDF02{JSR{GTNVR{{{GET VARIABLE NAME
10273: {{ERR{084{DEFINE{{FIRST ARGUMENT HAS NULL FUNCTION NAME
10274: {{MOV{R9{DEFVR{{SAVE VRBLK POINTER FOR FUNCTION NAM
10275: {{ZER{R7{{{ZERO COUNT OF ARGUMENTS
10276: {{MOV{SP{DEFXS{{SAVE INITIAL STACK POINTER
10277: {{BNZ{DEFLB{SDF03{{JUMP IF SECOND ARGUMENT GIVEN
10278: {{MOV{R9{DEFLB{{ELSE DEFAULT IS FUNCTION NAME
10279: *
10280: * LOOP TO SCAN ARGUMENT NAMES AND STACK VRBLK POINTERS
10281: *
10282: {SDF03{MOV{#CH$RP{R8{{DELIMITER ONE = RIGHT PAREN
10283: {{MOV{#CH$CM{R10{{DELIMITER TWO = COMMA
10284: {{JSR{XSCAN{{{SCAN OUT NEXT ARGUMENT NAME
10285: {{BNZ{R6{SDF04{{SKIP IF DELIMITER FOUND
10286: {{ERB{085{NULL{{ARG NAME OR MISSING ) IN DEFINE FIRST ARG.
10287: {{EJC{{{{
10288: *
10289: * DEFINE (CONTINUED)
10290: *
10291: * HERE AFTER SCANNING AN ARGUMENT NAME
10292: *
10293: {SDF04{BNE{R9{#NULLS{SDF05{SKIP IF NON-NULL
10294: {{BZE{R7{SDF06{{IGNORE NULL IF CASE OF NO ARGUMENTS
10295: *
10296: * HERE AFTER DEALING WITH THE CASE OF NO ARGUMENTS
10297: *
10298: {SDF05{JSR{GTNVR{{{GET VRBLK POINTER
10299: {{PPM{SDF03{{{LOOP BACK TO IGNORE NULL NAME
10300: {{MOV{R9{-(SP){{STACK ARGUMENT VRBLK POINTER
10301: {{ICV{R7{{{INCREMENT COUNTER
10302: {{BEQ{R6{#NUM02{SDF03{LOOP BACK IF STOPPED BY A COMMA
10303: *
10304: * HERE AFTER SCANNING OUT FUNCTION ARGUMENT NAMES
10305: *
10306: {SDF06{MOV{R7{DEFNA{{SAVE NUMBER OF ARGUMENTS
10307: {{ZER{R7{{{ZERO COUNT OF LOCALS
10308: *
10309: * LOOP TO SCAN LOCAL NAMES AND STACK VRBLK POINTERS
10310: *
10311: {SDF07{MOV{#CH$CM{R8{{SET DELIMITER ONE = COMMA
10312: {{MOV{R8{R10{{SET DELIMITER TWO = COMMA
10313: {{JSR{XSCAN{{{SCAN OUT NEXT LOCAL NAME
10314: {{BNE{R9{#NULLS{SDF08{SKIP IF NON-NULL
10315: {{BZE{R7{SDF09{{IGNORE NULL IF CASE OF NO LOCALS
10316: *
10317: * HERE AFTER SCANNING OUT A LOCAL NAME
10318: *
10319: {SDF08{JSR{GTNVR{{{GET VRBLK POINTER
10320: {{PPM{SDF07{{{LOOP BACK TO IGNORE NULL NAME
10321: {{ICV{R7{{{IF OK, INCREMENT COUNT
10322: {{MOV{R9{-(SP){{STACK VRBLK POINTER
10323: {{BNZ{R6{SDF07{{LOOP BACK IF STOPPED BY A COMMA
10324: {{EJC{{{{
10325: *
10326: * DEFINE (CONTINUED)
10327: *
10328: * HERE AFTER SCANNING LOCALS, BUILD PFBLK
10329: *
10330: {SDF09{MOV{R7{R6{{COPY COUNT OF LOCALS
10331: {{ADD{DEFNA{R6{{ADD NUMBER OF ARGUMENTS
10332: {{MOV{R6{R8{{SET SUM ARGS+LOCALS AS LOOP COUNT
10333: {{ADD{#PFSI${R6{{ADD SPACE FOR STANDARD FIELDS
10334: {{WTB{R6{{{CONVERT LENGTH TO BYTES
10335: {{JSR{ALLOC{{{ALLOCATE SPACE FOR PFBLK
10336: {{MOV{R9{R10{{SAVE POINTER TO PFBLK
10337: {{MOV{#B$PFC{(R9)+{{STORE FIRST WORD
10338: {{MOV{DEFNA{(R9)+{{STORE NUMBER OF ARGUMENTS
10339: {{MOV{R6{(R9)+{{STORE LENGTH (PFLEN)
10340: {{MOV{DEFVR{(R9)+{{STORE VRBLK PTR FOR FUNCTION NAME
10341: {{MOV{R7{(R9)+{{STORE NUMBER OF LOCALS
10342: {{ZER{(R9)+{{{DEAL WITH LABEL LATER
10343: {{ZER{(R9)+{{{ZERO PFCTR
10344: {{ZER{(R9)+{{{ZERO PFRTR
10345: {{BZE{R8{SDF11{{SKIP IF NO ARGS OR LOCALS
10346: {{MOV{R10{R6{{KEEP PFBLK POINTER
10347: {{MOV{DEFXS{R10{{POINT BEFORE ARGUMENTS
10348: {{LCT{R8{R8{{GET COUNT OF ARGS+LOCALS FOR LOOP
10349: *
10350: * LOOP TO MOVE LOCALS AND ARGS TO PFBLK
10351: *
10352: {SDF10{MOV{-(R10){(R9)+{{STORE ONE ENTRY AND BUMP POINTERS
10353: {{BCT{R8{SDF10{{LOOP TILL ALL STORED
10354: {{MOV{R6{R10{{RECOVER PFBLK POINTER
10355: {{EJC{{{{
10356: *
10357: * DEFINE (CONTINUED)
10358: *
10359: * NOW DEAL WITH LABEL
10360: *
10361: {SDF11{MOV{DEFXS{SP{{POP STACK
10362: {{MOV{DEFLB{R9{{POINT TO VRBLK FOR LABEL
10363: {{MOV{4*VRLBL(R9){R9{{LOAD LABEL POINTER
10364: {{BNE{(R9){#B$TRT{SDF12{SKIP IF NOT TRAPPED
10365: {{MOV{4*TRLBL(R9){R9{{ELSE POINT TO REAL LABEL
10366: *
10367: * HERE AFTER LOCATING REAL LABEL POINTER
10368: *
10369: {SDF12{BEQ{R9{#STNDL{SDF13{JUMP IF LABEL IS NOT DEFINED
10370: {{MOV{R9{4*PFCOD(R10){{ELSE STORE LABEL POINTER
10371: {{MOV{DEFVR{R9{{POINT BACK TO VRBLK FOR FUNCTION
10372: {{JSR{DFFNC{{{DEFINE FUNCTION
10373: {{BRN{EXNUL{{{AND EXIT RETURNING NULL
10374: *
10375: * HERE FOR ERRONEOUS LABEL
10376: *
10377: {SDF13{ERB{086{DEFINE{{FUNCTION ENTRY POINT IS NOT DEFINED LABEL
10378: {{EJC{{{{
10379: *
10380: * DETACH
10381: *
10382: {S$DET{ENT{{{{ENTRY POINT
10383: {{MOV{(SP)+{R9{{LOAD ARGUMENT
10384: {{JSR{GTVAR{{{LOCATE VARIABLE
10385: {{ERR{087{DETACH{{ARGUMENT IS NOT APPROPRIATE NAME
10386: {{JSR{DTACH{{{DETACH I/O ASSOCIATION FROM NAME
10387: {{BRN{EXNUL{{{RETURN NULL RESULT
10388: {{EJC{{{{
10389: *
10390: * DIFFER
10391: *
10392: {S$DIF{ENT{{{{ENTRY POINT
10393: {{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT
10394: {{MOV{(SP)+{R10{{LOAD FIRST ARGUMENT
10395: {{JSR{IDENT{{{CALL IDENT COMPARISON ROUTINE
10396: {{PPM{EXFAL{{{FAIL IF IDENT
10397: {{BRN{EXNUL{{{RETURN NULL IF DIFFER
10398: {{EJC{{{{
10399: *
10400: * DUMP
10401: *
10402: {S$DMP{ENT{{{{ENTRY POINT
10403: {{JSR{GTSMI{{{LOAD DUMP ARG AS SMALL INTEGER
10404: {{ERR{088{DUMP{{ARGUMENT IS NOT INTEGER
10405: {{ERR{089{DUMP{{ARGUMENT IS NEGATIVE OR TOO LARGE
10406: {{JSR{DUMPR{{{ELSE CALL DUMP ROUTINE
10407: {{BRN{EXNUL{{{AND RETURN NULL AS RESULT
10408: {{EJC{{{{
10409: *
10410: * DUPL
10411: *
10412: {S$DUP{ENT{{{{ENTRY POINT
10413: {{JSR{GTSMI{{{GET SECOND ARGUMENT AS SMALL INTEGE
10414: {{ERR{090{DUPL{{SECOND ARGUMENT IS NOT INTEGER
10415: {{PPM{SDUP7{{{JUMP IF NEGATIVE OT TOO BIG
10416: {{MOV{R9{R7{{SAVE DUPLICATION FACTOR
10417: {{JSR{GTSTG{{{GET FIRST ARG AS STRING
10418: {{PPM{SDUP4{{{JUMP IF NOT A STRING
10419: *
10420: * HERE FOR CASE OF DUPLICATION OF A STRING
10421: *
10422: {{MTI{R6{{{ACQUIRE LENGTH AS INTEGER
10423: {{STI{DUPSI{{{SAVE FOR THE MOMENT
10424: {{MTI{R7{{{GET DUPLICATION FACTOR AS INTEGER
10425: {{MLI{DUPSI{{{FORM PRODUCT
10426: {{IOV{SDUP3{{{JUMP IF OVERFLOW
10427: {{IEQ{EXNUL{{{RETURN NULL IF RESULT LENGTH = 0
10428: {{MFI{R6{SDUP3{{GET AS ADDR INTEGER, CHECK OVFLO
10429: *
10430: * MERGE HERE WITH RESULT LENGTH IN WA
10431: *
10432: {SDUP1{MOV{R9{R10{{SAVE STRING POINTER
10433: {{JSR{ALOCS{{{ALLOCATE SPACE FOR STRING
10434: {{MOV{R9{-(SP){{SAVE AS RESULT POINTER
10435: {{MOV{R10{R8{{SAVE POINTER TO ARGUMENT STRING
10436: {{PSC{R9{{{PREPARE TO STORE CHARS OF RESULT
10437: {{LCT{R7{R7{{SET COUNTER TO CONTROL LOOP
10438: *
10439: * LOOP THROUGH DUPLICATIONS
10440: *
10441: {SDUP2{MOV{R8{R10{{POINT BACK TO ARGUMENT STRING
10442: {{MOV{4*SCLEN(R10){R6{{GET NUMBER OF CHARACTERS
10443: {{PLC{R10{{{POINT TO CHARS IN ARGUMENT STRING
10444: {{MVC{{{{MOVE CHARACTERS TO RESULT STRING
10445: {{BCT{R7{SDUP2{{LOOP TILL ALL DUPLICATIONS DONE
10446: {{BRN{EXITS{{{THEN EXIT FOR NEXT CODE WORD
10447: {{EJC{{{{
10448: *
10449: * DUPL (CONTINUED)
10450: *
10451: * HERE IF TOO LARGE, SET MAX LENGTH AND LET ALOCS CATCH IT
10452: *
10453: {SDUP3{MOV{DNAME{R6{{SET IMPOSSIBLE LENGTH FOR ALOCS
10454: {{BRN{SDUP1{{{MERGE BACK
10455: *
10456: * HERE IF NOT A STRING
10457: *
10458: {SDUP4{JSR{GTPAT{{{CONVERT ARGUMENT TO PATTERN
10459: {{ERR{091{DUPL{{FIRST ARGUMENT IS NOT STRING OR PATTERN
10460: *
10461: * HERE TO DUPLICATE A PATTERN ARGUMENT
10462: *
10463: {{MOV{R9{-(SP){{STORE PATTERN ON STACK
10464: {{MOV{#NDNTH{R9{{START OFF WITH NULL PATTERN
10465: {{BZE{R7{SDUP6{{NULL PATTERN IS RESULT IF DUPFAC=0
10466: {{MOV{R7{-(SP){{PRESERVE LOOP COUNT
10467: *
10468: * LOOP TO DUPLICATE BY SUCCESSIVE CONCATENATION
10469: *
10470: {SDUP5{MOV{R9{R10{{COPY CURRENT VALUE AS RIGHT ARGUMNT
10471: {{MOV{4*1(SP){R9{{GET A NEW COPY OF LEFT
10472: {{JSR{PCONC{{{CONCATENATE
10473: {{DCV{(SP){{{COUNT DOWN
10474: {{BNZ{(SP){SDUP5{{LOOP
10475: {{ICA{SP{{{POP LOOP COUNT
10476: *
10477: * HERE TO EXIT AFTER CONSTRUCTING PATTERN
10478: *
10479: {SDUP6{MOV{R9{(SP){{STORE RESULT ON STACK
10480: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK
10481: *
10482: * FAIL IF SECOND ARG IS OUT OF RANGE
10483: *
10484: {SDUP7{ICA{SP{{{POP FIRST ARGUMENT
10485: {{BRN{EXFAL{{{FAIL
10486: {{EJC{{{{
10487: *
10488: * EJECT
10489: *
10490: {S$EJC{ENT{{{{ENTRY POINT
10491: {{JSR{IOFCB{{{CALL FCBLK ROUTINE
10492: {{ERR{092{EJECT{{ARGUMENT IS NOT A SUITABLE NAME
10493: {{PPM{SEJC1{{{NULL ARGUMENT
10494: {{JSR{SYSEF{{{CALL EJECT FILE FUNCTION
10495: {{ERR{093{EJECT{{FILE DOES NOT EXIST
10496: {{ERR{094{EJECT{{FILE DOES NOT PERMIT PAGE EJECT
10497: {{ERR{095{EJECT{{CAUSED NON-RECOVERABLE OUTPUT ERROR
10498: {{BRN{EXNUL{{{RETURN NULL AS RESULT
10499: *
10500: * HERE TO EJECT STANDARD OUTPUT FILE
10501: *
10502: {SEJC1{JSR{SYSEP{{{CALL ROUTINE TO EJECT PRINTER
10503: {{BRN{EXNUL{{{EXIT WITH NULL RESULT
10504: {{EJC{{{{
10505: *
10506: * ENDFILE
10507: *
10508: {S$ENF{ENT{{{{ENTRY POINT
10509: {{JSR{IOFCB{{{CALL FCBLK ROUTINE
10510: {{ERR{096{ENDFILE{{ARGUMENT IS NOT A SUITABLE NAME
10511: {{ERR{097{ENDFILE{{ARGUMENT IS NULL
10512: {{JSR{SYSEN{{{CALL ENDFILE ROUTINE
10513: {{ERR{098{ENDFILE{{FILE DOES NOT EXIST
10514: {{ERR{099{ENDFILE{{FILE DOES NOT PERMIT ENDFILE
10515: {{ERR{100{ENDFILE{{CAUSED NON-RECOVERABLE OUTPUT ERROR
10516: {{MOV{R10{R7{{REMEMBER VRBLK PTR FROM IOFCB CALL
10517: *
10518: * LOOP TO FIND TRTRF BLOCK
10519: *
10520: {SENF1{MOV{R10{R9{{COPY POINTER
10521: {{MOV{4*TRVAL(R9){R9{{CHAIN ALONG
10522: {{BNE{(R9){#B$TRT{EXNUL{SKIP OUT IF CHAIN END
10523: {{BNE{4*TRTYP(R9){#TRTFC{SENF1{LOOP IF NOT FOUND
10524: {{MOV{4*TRVAL(R9){4*TRVAL(R10){{REMOVE TRTRF
10525: {{MOV{4*TRTRF(R9){ENFCH{{POINT TO HEAD OF IOCHN
10526: {{MOV{4*TRFPT(R9){R8{{POINT TO FCBLK
10527: {{MOV{R7{R9{{FILEARG1 VRBLK FROM IOFCB
10528: {{JSR{SETVR{{{RESET IT
10529: {{MOV{#R$FCB{R10{{PTR TO HEAD OF FCBLK CHAIN
10530: {{SUB{#4*NUM02{R10{{ADJUST READY TO ENTER LOOP
10531: *
10532: * FIND FCBLK
10533: *
10534: {SENF2{MOV{R10{R9{{COPY PTR
10535: {{MOV{4*2(R10){R10{{GET NEXT LINK
10536: {{BZE{R10{SENF4{{STOP IF CHAIN END
10537: {{BEQ{4*3(R10){R8{SENF3{JUMP IF FCBLK FOUND
10538: {{BRN{SENF2{{{LOOP
10539: *
10540: * REMOVE FCBLK
10541: *
10542: {SENF3{MOV{4*2(R10){4*2(R9){{DELETE FCBLK FROM CHAIN
10543: *
10544: * LOOP WHICH DETACHES ALL VBLS ON IOCHN CHAIN
10545: *
10546: {SENF4{MOV{ENFCH{R10{{GET CHAIN HEAD
10547: {{BZE{R10{EXNUL{{FINISHED IF CHAIN END
10548: {{MOV{4*TRTRF(R10){ENFCH{{CHAIN ALONG
10549: {{MOV{4*IONMO(R10){R6{{NAME OFFSET
10550: {{MOV{4*IONMB(R10){R10{{NAME BASE
10551: {{JSR{DTACH{{{DETACH NAME
10552: {{BRN{SENF4{{{LOOP TILL DONE
10553: {{EJC{{{{
10554: *
10555: * EQ
10556: *
10557: {S$EQF{ENT{{{{ENTRY POINT
10558: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
10559: {{ERR{101{EQ{{FIRST ARGUMENT IS NOT NUMERIC
10560: {{ERR{102{EQ{{SECOND ARGUMENT IS NOT NUMERIC
10561: {{PPM{EXFAL{{{FAIL IF LT
10562: {{PPM{EXNUL{{{RETURN NULL IF EQ
10563: {{PPM{EXFAL{{{FAIL IF GT
10564: {{EJC{{{{
10565: *
10566: * EVAL
10567: *
10568: {S$EVL{ENT{{{{ENTRY POINT
10569: {{MOV{(SP)+{R9{{LOAD ARGUMENT
10570: {{JSR{GTEXP{{{CONVERT TO EXPRESSION
10571: {{ERR{103{EVAL{{ARGUMENT IS NOT EXPRESSION
10572: {{LCW{R8{{{LOAD NEXT CODE WORD
10573: {{BNE{R8{#OFNE${SEVL1{JUMP IF CALLED BY VALUE
10574: {{SCP{R10{{{COPY CODE POINTER
10575: {{MOV{(R10){R6{{GET NEXT CODE WORD
10576: {{BNE{R6{#ORNM${SEVL2{BY NAME UNLESS EXPRESSION
10577: {{BNZ{4*1(SP){SEVL2{{JUMP IF BY NAME
10578: *
10579: * HERE IF CALLED BY VALUE
10580: *
10581: {SEVL1{ZER{R7{{{SET FLAG FOR BY VALUE
10582: {{MOV{R8{-(SP){{SAVE CODE WORD
10583: {{JSR{EVALX{{{EVALUATE EXPRESSION BY VALUE
10584: {{PPM{EXFAL{{{FAIL IF EVALUATION FAILS
10585: {{MOV{R9{R10{{COPY RESULT
10586: {{MOV{(SP){R9{{RELOAD NEXT CODE WORD
10587: {{MOV{R10{(SP){{STACK RESULT
10588: {{BRI{(R9){{{JUMP TO EXECUTE NEXT CODE WORD
10589: *
10590: * HERE IF CALLED BY NAME
10591: *
10592: {SEVL2{MOV{#NUM01{R7{{SET FLAG FOR BY NAME
10593: {{JSR{EVALX{{{EVALUATE EXPRESSION BY NAME
10594: {{PPM{EXFAL{{{FAIL IF EVALUATION FAILS
10595: {{BRN{EXNAM{{{EXIT WITH NAME
10596: {{EJC{{{{
10597: *
10598: * EXIT
10599: *
10600: {S$EXT{ENT{{{{ENTRY POINT
10601: {{ZER{R7{{{CLEAR AMOUNT OF STATIC SHIFT
10602: {{JSR{GBCOL{{{COMPACT MEMORY BY COLLECTING
10603: {{JSR{GTSTG{{{CONVERT ARG TO STRING
10604: {{ERR{104{EXIT{{ARGUMENT IS NOT SUITABLE INTEGER OR STRING
10605: {{MOV{R9{R10{{COPY STRING PTR
10606: {{JSR{GTINT{{{CHECK IT IS INTEGER
10607: {{PPM{SEXT1{{{SKIP IF UNCONVERTIBLE
10608: {{ZER{R10{{{NOTE IT IS INTEGER
10609: {{LDI{4*ICVAL(R9){{{GET INTEGER ARG
10610: {{MOV{R$FCB{R7{{GET FCBLK CHAIN HEADER
10611: *
10612: * MERGE TO CALL OSINT EXIT ROUTINE
10613: *
10614: {SEXT1{MOV{#HEADV{R9{{POINT TO V.V STRING
10615: {{JSR{SYSXI{{{CALL EXTERNAL ROUTINE
10616: {{ERR{105{EXIT{{ACTION NOT AVAILABLE IN THIS IMPLEMENTATION
10617: {{ERR{106{EXIT{{ACTION CAUSED IRRECOVERABLE ERROR
10618: {{IEQ{EXNUL{{{RETURN IF ARGUMENT 0
10619: {{ZER{GBCNT{{{RESUMING EXECUTION SO RESET
10620: {{IGT{SEXT2{{{SKIP IF POSITIVE
10621: {{NGI{{{{MAKE POSITIVE
10622: *
10623: * CHECK FOR OPTION RESPECIFICATION
10624: *
10625: {SEXT2{MFI{R8{{{GET VALUE IN WORK REG
10626: {{BEQ{R8{#NUM03{SEXT3{SKIP IF WAS 3
10627: {{MOV{R8{-(SP){{SAVE VALUE
10628: {{ZER{R8{{{SET TO READ OPTIONS
10629: {{JSR{PRPAR{{{READ SYSPP OPTIONS
10630: {{MOV{(SP)+{R8{{RESTORE VALUE
10631: *
10632: * DEAL WITH HEADER OPTION (FIDDLED BY PRPAR)
10633: *
10634: {SEXT3{MNZ{HEADP{{{ASSUME NO HEADERS
10635: {{BNE{R8{#NUM01{SEXT4{SKIP IF NOT 1
10636: {{ZER{HEADP{{{REQUEST HEADER PRINTING
10637: *
10638: * ALMOST READY TO RESUME RUNNING
10639: *
10640: {SEXT4{JSR{SYSTM{{{GET EXECUTION TIME START (SGD11)
10641: {{STI{TIMSX{{{SAVE AS INITIAL TIME
10642: {{LDI{KVSTC{{{RESET TO ENSURE ...
10643: {{STI{KVSTL{{{... CORRECT EXECUTION STATS
10644: {{BRN{EXNUL{{{RESUME EXECUTION
10645: {{EJC{{{{
10646: *
10647: * FIELD
10648: *
10649: {S$FLD{ENT{{{{ENTRY POINT
10650: {{JSR{GTSMI{{{GET SECOND ARGUMENT (FIELD NUMBER)
10651: {{ERR{107{FIELD{{SECOND ARGUMENT IS NOT INTEGER
10652: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE
10653: {{MOV{R9{R7{{ELSE SAVE INTEGER VALUE
10654: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
10655: {{JSR{GTNVR{{{POINT TO VRBLK
10656: {{PPM{SFLD1{{{JUMP (ERROR) IF NOT VARIABLE NAME
10657: {{MOV{4*VRFNC(R9){R9{{ELSE POINT TO FUNCTION BLOCK
10658: {{BNE{(R9){#B$DFC{SFLD1{ERROR IF NOT DATATYPE FUNCTION
10659: *
10660: * HERE IF FIRST ARGUMENT IS A DATATYPE FUNCTION NAME
10661: *
10662: {{BZE{R7{EXFAL{{FAIL IF ARGUMENT NUMBER IS ZERO
10663: {{BGT{R7{4*FARGS(R9){EXFAL{FAIL IF TOO LARGE
10664: {{WTB{R7{{{ELSE CONVERT TO BYTE OFFSET
10665: {{ADD{R7{R9{{POINT TO FIELD NAME
10666: {{MOV{4*DFFLB(R9){R9{{LOAD VRBLK POINTER
10667: {{BRN{EXVNM{{{EXIT TO BUILD NMBLK
10668: *
10669: * HERE FOR BAD FIRST ARGUMENT
10670: *
10671: {SFLD1{ERB{108{FIELD{{FIRST ARGUMENT IS NOT DATATYPE NAME
10672: {{EJC{{{{
10673: *
10674: * FENCE
10675: *
10676: {S$FNC{ENT{{{{ENTRY POINT
10677: {{MOV{#P$FNC{R7{{SET PCODE FOR P$FNC
10678: {{ZER{R9{{{P0BLK
10679: {{JSR{PBILD{{{BUILD P$FNC NODE
10680: {{MOV{R9{R10{{SAVE POINTER TO IT
10681: {{MOV{(SP)+{R9{{GET ARGUMENT
10682: {{JSR{GTPAT{{{CONVERT TO PATTERN
10683: {{ERR{259{FENCE{{ARGUMENT IS NOT PATTERN
10684: {{JSR{PCONC{{{CONCATENATE TO P$FNC NODE
10685: {{MOV{R9{R10{{SAVE PTR TO CONCATENATED PATTERN
10686: {{MOV{#P$FNA{R7{{SET FOR P$FNA PCODE
10687: {{ZER{R9{{{P0BLK
10688: {{JSR{PBILD{{{CONSTRUCT P$FNA NODE
10689: {{MOV{R10{4*PTHEN(R9){{SET PATTERN AS PTHEN
10690: {{MOV{R9{-(SP){{SET AS RESULT
10691: {{BRN{EXITS{{{DO NEXT CODE WORD
10692: {{EJC{{{{
10693: *
10694: * GE
10695: *
10696: {S$GEF{ENT{{{{ENTRY POINT
10697: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
10698: {{ERR{109{GE{{FIRST ARGUMENT IS NOT NUMERIC
10699: {{ERR{110{GE{{SECOND ARGUMENT IS NOT NUMERIC
10700: {{PPM{EXFAL{{{FAIL IF LT
10701: {{PPM{EXNUL{{{RETURN NULL IF EQ
10702: {{PPM{EXNUL{{{RETURN NULL IF GT
10703: {{EJC{{{{
10704: *
10705: * GT
10706: *
10707: {S$GTF{ENT{{{{ENTRY POINT
10708: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
10709: {{ERR{111{GT{{FIRST ARGUMENT IS NOT NUMERIC
10710: {{ERR{112{GT{{SECOND ARGUMENT IS NOT NUMERIC
10711: {{PPM{EXFAL{{{FAIL IF LT
10712: {{PPM{EXFAL{{{FAIL IF EQ
10713: {{PPM{EXNUL{{{RETURN NULL IF GT
10714: {{EJC{{{{
10715: *
10716: * HOST
10717: *
10718: {S$HST{ENT{{{{ENTRY POINT
10719: {{MOV{(SP)+{R9{{GET THIRD ARG
10720: {{MOV{(SP)+{R10{{GET SECOND ARG
10721: {{MOV{(SP)+{R6{{GET FIRST ARG
10722: {{JSR{SYSHS{{{ENTER SYSHS ROUTINE
10723: {{ERR{254{ERRONEOUS{{ARGUMENT FOR HOST
10724: {{ERR{255{ERROR{{DURING EXECUTION OF HOST
10725: {{PPM{SHST1{{{STORE HOST STRING
10726: {{PPM{EXNUL{{{RETURN NULL RESULT
10727: {{PPM{EXIXR{{{RETURN XR
10728: {{PPM{EXFAL{{{FAIL RETURN
10729: *
10730: * RETURN HOST STRING
10731: *
10732: {SHST1{BZE{R10{EXNUL{{NULL STRING IF SYSHS UNCOOPERATIVE
10733: {{MOV{4*SCLEN(R10){R6{{LENGTH
10734: {{ZER{R7{{{ZERO OFFSET
10735: {{JSR{SBSTR{{{BUILD COPY OF STRING
10736: {{MOV{R9{-(SP){{STACK THE RESULT
10737: {{BRN{EXITS{{{RETURN RESULT ON STACK
10738: {{EJC{{{{
10739: *
10740: * IDENT
10741: *
10742: {S$IDN{ENT{{{{ENTRY POINT
10743: {{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT
10744: {{MOV{(SP)+{R10{{LOAD FIRST ARGUMENT
10745: {{JSR{IDENT{{{CALL IDENT COMPARISON ROUTINE
10746: {{PPM{EXNUL{{{RETURN NULL IF IDENT
10747: {{BRN{EXFAL{{{FAIL IF DIFFER
10748: {{EJC{{{{
10749: *
10750: * INPUT
10751: *
10752: {S$INP{ENT{{{{ENTRY POINT
10753: {{ZER{R7{{{INPUT FLAG
10754: {{JSR{IOPUT{{{CALL INPUT/OUTPUT ASSOC. ROUTINE
10755: {{ERR{113{INPUT{{THIRD ARGUMENT IS NOT A STRING
10756: {{ERR{114{INAPPROPRIATE{{SECOND ARGUMENT FOR INPUT
10757: {{ERR{115{INAPPROPRIATE{{FIRST ARGUMENT FOR INPUT
10758: {{ERR{116{INAPPROPRIATE{{FILE SPECIFICATION FOR INPUT
10759: {{PPM{EXFAL{{{FAIL IF FILE DOES NOT EXIST
10760: {{ERR{117{INPUT{{FILE CANNOT BE READ
10761: {{BRN{EXNUL{{{RETURN NULL STRING
10762: {{EJC{{{{
10763: *
10764: * INSERT
10765: *
10766: {S$INS{ENT{{{{ENTRY POINT
10767: {{MOV{(SP)+{R10{{GET STRING ARG
10768: {{JSR{GTSMI{{{GET REPLACE LENGTH
10769: {{ERR{277{INSERT{{THIRD ARGUMENT NOT INTEGER
10770: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE
10771: {{MOV{R8{R7{{COPY TO PROPER REG
10772: {{JSR{GTSMI{{{GET REPLACE POSITION
10773: {{ERR{278{INSERT{{SECOND ARGUMENT NOT INTEGER
10774: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE
10775: {{BZE{R8{EXFAL{{FAIL IF ZERO
10776: {{DCV{R8{{{DECREMENT TO GET OFFSET
10777: {{MOV{R8{R6{{PUT IN PROPER REGISTER
10778: {{MOV{(SP)+{R9{{GET BUFFER
10779: {{BEQ{(R9){#B$BCT{SINS1{PRESS ON IF TYPE OK
10780: {{ERB{279{INSERT{{FIRST ARGUMENT NOT BUFFER
10781: *
10782: * HERE WHEN EVERYTHING LOADED UP
10783: *
10784: {SINS1{JSR{INSBF{{{CALL TO INSERT
10785: {{ERR{280{INSERT{{FOURTH ARGUMENT NOT A STRING
10786: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE
10787: {{BRN{EXNUL{{{ELSE OK - EXIT WITH NULL
10788: {{EJC{{{{
10789: *
10790: * INTEGER
10791: *
10792: {S$INT{ENT{{{{ENTRY POINT
10793: {{MOV{(SP)+{R9{{LOAD ARGUMENT
10794: {{JSR{GTNUM{{{CONVERT TO NUMERIC
10795: {{PPM{EXFAL{{{FAIL IF NON-NUMERIC
10796: {{BEQ{R6{#B$ICL{EXNUL{RETURN NULL IF INTEGER
10797: {{BRN{EXFAL{{{FAIL IF REAL
10798: {{EJC{{{{
10799: *
10800: * ITEM
10801: *
10802: * ITEM DOES NOT PERMIT THE DIRECT (FAST) CALL SO THAT
10803: * WA CONTAINS THE ACTUAL NUMBER OF ARGUMENTS PASSED.
10804: *
10805: {S$ITM{ENT{{{{ENTRY POINT
10806: *
10807: * DEAL WITH CASE OF NO ARGS
10808: *
10809: {{BNZ{R6{SITM1{{JUMP IF AT LEAST ONE ARG
10810: {{MOV{#NULLS{-(SP){{ELSE SUPPLY GARBAGE NULL ARG
10811: {{MOV{#NUM01{R6{{AND FIX ARGUMENT COUNT
10812: *
10813: * CHECK FOR NAME/VALUE CASES
10814: *
10815: {SITM1{SCP{R9{{{GET CURRENT CODE POINTER
10816: {{MOV{(R9){R10{{LOAD NEXT CODE WORD
10817: {{DCV{R6{{{GET NUMBER OF SUBSCRIPTS
10818: {{MOV{R6{R9{{COPY FOR ARREF
10819: {{BEQ{R10{#OFNE${SITM2{JUMP IF CALLED BY NAME
10820: *
10821: * HERE IF CALLED BY VALUE
10822: *
10823: {{ZER{R7{{{SET CODE FOR CALL BY VALUE
10824: {{BRN{ARREF{{{OFF TO ARRAY REFERENCE ROUTINE
10825: *
10826: * HERE FOR CALL BY NAME
10827: *
10828: {SITM2{MNZ{R7{{{SET CODE FOR CALL BY NAME
10829: {{LCW{R6{{{LOAD AND IGNORE OFNE$ CALL
10830: {{BRN{ARREF{{{OFF TO ARRAY REFERENCE ROUTINE
10831: {{EJC{{{{
10832: *
10833: * LE
10834: *
10835: {S$LEF{ENT{{{{ENTRY POINT
10836: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
10837: {{ERR{118{LE{{FIRST ARGUMENT IS NOT NUMERIC
10838: {{ERR{119{LE{{SECOND ARGUMENT IS NOT NUMERIC
10839: {{PPM{EXNUL{{{RETURN NULL IF LT
10840: {{PPM{EXNUL{{{RETURN NULL IF EQ
10841: {{PPM{EXFAL{{{FAIL IF GT
10842: {{EJC{{{{
10843: *
10844: * LEN
10845: *
10846: {S$LEN{ENT{{{{ENTRY POINT
10847: {{MOV{#P$LEN{R7{{SET PCODE FOR INTEGER ARG CASE
10848: {{MOV{#P$LND{R6{{SET PCODE FOR EXPR ARG CASE
10849: {{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE
10850: {{ERR{120{LEN{{ARGUMENT IS NOT INTEGER OR EXPRESSION
10851: {{ERR{121{LEN{{ARGUMENT IS NEGATIVE OR TOO LARGE
10852: {{BRN{EXIXR{{{RETURN PATTERN NODE
10853: {{EJC{{{{
10854: *
10855: * LEQ
10856: *
10857: {S$LEQ{ENT{{{{ENTRY POINT
10858: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
10859: {{ERR{122{LEQ{{FIRST ARGUMENT IS NOT STRING
10860: {{ERR{123{LEQ{{SECOND ARGUMENT IS NOT STRING
10861: {{PPM{EXFAL{{{FAIL IF LLT
10862: {{PPM{EXNUL{{{RETURN NULL IF LEQ
10863: {{PPM{EXFAL{{{FAIL IF LGT
10864: {{EJC{{{{
10865: *
10866: * LGE
10867: *
10868: {S$LGE{ENT{{{{ENTRY POINT
10869: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
10870: {{ERR{124{LGE{{FIRST ARGUMENT IS NOT STRING
10871: {{ERR{125{LGE{{SECOND ARGUMENT IS NOT STRING
10872: {{PPM{EXFAL{{{FAIL IF LLT
10873: {{PPM{EXNUL{{{RETURN NULL IF LEQ
10874: {{PPM{EXNUL{{{RETURN NULL IF LGT
10875: {{EJC{{{{
10876: *
10877: * LGT
10878: *
10879: {S$LGT{ENT{{{{ENTRY POINT
10880: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
10881: {{ERR{126{LGT{{FIRST ARGUMENT IS NOT STRING
10882: {{ERR{127{LGT{{SECOND ARGUMENT IS NOT STRING
10883: {{PPM{EXFAL{{{FAIL IF LLT
10884: {{PPM{EXFAL{{{FAIL IF LEQ
10885: {{PPM{EXNUL{{{RETURN NULL IF LGT
10886: {{EJC{{{{
10887: *
10888: * LLE
10889: *
10890: {S$LLE{ENT{{{{ENTRY POINT
10891: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
10892: {{ERR{128{LLE{{FIRST ARGUMENT IS NOT STRING
10893: {{ERR{129{LLE{{SECOND ARGUMENT IS NOT STRING
10894: {{PPM{EXNUL{{{RETURN NULL IF LLT
10895: {{PPM{EXNUL{{{RETURN NULL IF LEQ
10896: {{PPM{EXFAL{{{FAIL IF LGT
10897: {{EJC{{{{
10898: *
10899: * LLT
10900: *
10901: {S$LLT{ENT{{{{ENTRY POINT
10902: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
10903: {{ERR{130{LLT{{FIRST ARGUMENT IS NOT STRING
10904: {{ERR{131{LLT{{SECOND ARGUMENT IS NOT STRING
10905: {{PPM{EXNUL{{{RETURN NULL IF LLT
10906: {{PPM{EXFAL{{{FAIL IF LEQ
10907: {{PPM{EXFAL{{{FAIL IF LGT
10908: {{EJC{{{{
10909: *
10910: * LNE
10911: *
10912: {S$LNE{ENT{{{{ENTRY POINT
10913: {{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
10914: {{ERR{132{LNE{{FIRST ARGUMENT IS NOT STRING
10915: {{ERR{133{LNE{{SECOND ARGUMENT IS NOT STRING
10916: {{PPM{EXNUL{{{RETURN NULL IF LLT
10917: {{PPM{EXFAL{{{FAIL IF LEQ
10918: {{PPM{EXNUL{{{RETURN NULL IF LGT
10919: {{EJC{{{{
10920: *
10921: * LOCAL
10922: *
10923: {S$LOC{ENT{{{{ENTRY POINT
10924: {{JSR{GTSMI{{{GET SECOND ARGUMENT (LOCAL NUMBER)
10925: {{ERR{134{LOCAL{{SECOND ARGUMENT IS NOT INTEGER
10926: {{PPM{EXFAL{{{FAIL IF OUT OF RANGE
10927: {{MOV{R9{R7{{SAVE LOCAL NUMBER
10928: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
10929: {{JSR{GTNVR{{{POINT TO VRBLK
10930: {{PPM{SLOC1{{{JUMP IF NOT VARIABLE NAME
10931: {{MOV{4*VRFNC(R9){R9{{ELSE LOAD FUNCTION POINTER
10932: {{BNE{(R9){#B$PFC{SLOC1{JUMP IF NOT PROGRAM DEFINED
10933: *
10934: * HERE IF WE HAVE A PROGRAM DEFINED FUNCTION NAME
10935: *
10936: {{BZE{R7{EXFAL{{FAIL IF SECOND ARG IS ZERO
10937: {{BGT{R7{4*PFNLO(R9){EXFAL{OR TOO LARGE
10938: {{ADD{4*FARGS(R9){R7{{ELSE ADJUST OFFSET TO INCLUDE ARGS
10939: {{WTB{R7{{{CONVERT TO BYTES
10940: {{ADD{R7{R9{{POINT TO LOCAL POINTER
10941: {{MOV{4*PFAGB(R9){R9{{LOAD VRBLK POINTER
10942: {{BRN{EXVNM{{{EXIT BUILDING NMBLK
10943: *
10944: * HERE IF FIRST ARGUMENT IS NO GOOD
10945: *
10946: {SLOC1{ERB{135{LOCAL{{FIRST ARG IS NOT A PROGRAM FUNCTION NAME
10947: {{EJC{{{{
10948: *
10949: * LOAD
10950: *
10951: {S$LOD{ENT{{{{ENTRY POINT
10952: {{JSR{GTSTG{{{LOAD LIBRARY NAME
10953: {{ERR{136{LOAD{{SECOND ARGUMENT IS NOT STRING
10954: {{MOV{R9{R10{{SAVE LIBRARY NAME
10955: {{JSR{XSCNI{{{PREPARE TO SCAN FIRST ARGUMENT
10956: {{ERR{137{LOAD{{FIRST ARGUMENT IS NOT STRING
10957: {{ERR{138{LOAD{{FIRST ARGUMENT IS NULL
10958: {{MOV{R10{-(SP){{STACK LIBRARY NAME
10959: {{MOV{#CH$PP{R8{{SET DELIMITER ONE = LEFT PAREN
10960: {{MOV{R8{R10{{SET DELIMITER TWO = LEFT PAREN
10961: {{JSR{XSCAN{{{SCAN FUNCTION NAME
10962: {{MOV{R9{-(SP){{SAVE PTR TO FUNCTION NAME
10963: {{BNZ{R6{SLOD1{{JUMP IF LEFT PAREN FOUND
10964: {{ERB{139{LOAD{{FIRST ARGUMENT IS MISSING A LEFT PAREN
10965: *
10966: * HERE AFTER SUCCESSFULLY SCANNING FUNCTION NAME
10967: *
10968: {SLOD1{JSR{GTNVR{{{LOCATE VRBLK
10969: {{ERR{140{LOAD{{FIRST ARGUMENT HAS NULL FUNCTION NAME
10970: {{MOV{R9{LODFN{{SAVE VRBLK POINTER
10971: {{ZER{LODNA{{{ZERO COUNT OF ARGUMENTS
10972: *
10973: * LOOP TO SCAN ARGUMENT DATATYPE NAMES
10974: *
10975: {SLOD2{MOV{#CH$RP{R8{{DELIMITER ONE IS RIGHT PAREN
10976: {{MOV{#CH$CM{R10{{DELIMITER TWO IS COMMA
10977: {{JSR{XSCAN{{{SCAN NEXT ARGUMENT NAME
10978: {{ICV{LODNA{{{BUMP ARGUMENT COUNT
10979: {{BNZ{R6{SLOD3{{JUMP IF OK DELIMITER WAS FOUND
10980: {{ERB{141{LOAD{{FIRST ARGUMENT IS MISSING A RIGHT PAREN
10981: {{EJC{{{{
10982: *
10983: * LOAD (CONTINUED)
10984: *
10985: * COME HERE TO ANALYZE THE DATATYPE POINTER IN (XR). THIS
10986: * CODE IS USED BOTH FOR ARGUMENTS (WA=1,2) AND FOR THE
10987: * RESULT DATATYPE (WITH WA SET TO ZERO).
10988: *
10989: {SLOD3{MOV{R9{-(SP){{STACK DATATYPE NAME POINTER
10990: {{MOV{#NUM01{R7{{SET STRING CODE IN CASE
10991: {{MOV{#SCSTR{R10{{POINT TO /STRING/
10992: {{JSR{IDENT{{{CHECK FOR MATCH
10993: {{PPM{SLOD4{{{JUMP IF MATCH
10994: {{MOV{(SP){R9{{ELSE RELOAD NAME
10995: {{ADD{R7{R7{{SET CODE FOR INTEGER (2)
10996: {{MOV{#SCINT{R10{{POINT TO /INTEGER/
10997: {{JSR{IDENT{{{CHECK FOR MATCH
10998: {{PPM{SLOD4{{{JUMP IF MATCH
10999: {{MOV{(SP){R9{{ELSE RELOAD STRING POINTER
11000: {{ICV{R7{{{SET CODE FOR REAL (3)
11001: {{MOV{#SCREA{R10{{POINT TO /REAL/
11002: {{JSR{IDENT{{{CHECK FOR MATCH
11003: {{PPM{SLOD4{{{JUMP IF MATCH
11004: {{ZER{R7{{{ELSE GET CODE FOR NO CONVERT
11005: *
11006: * MERGE HERE WITH PROPER DATATYPE CODE IN WB
11007: *
11008: {SLOD4{MOV{R7{(SP){{STORE CODE ON STACK
11009: {{BEQ{R6{#NUM02{SLOD2{LOOP BACK IF ARG STOPPED BY COMMA
11010: {{BZE{R6{SLOD5{{JUMP IF THAT WAS THE RESULT TYPE
11011: *
11012: * HERE WE SCAN OUT THE RESULT TYPE (ARG STOPPED BY ) )
11013: *
11014: {{MOV{MXLEN{R8{{SET DUMMY (IMPOSSIBLE) DELIMITER 1
11015: {{MOV{R8{R10{{AND DELIMITER TWO
11016: {{JSR{XSCAN{{{SCAN RESULT NAME
11017: {{ZER{R6{{{SET CODE FOR PROCESSING RESULT
11018: {{BRN{SLOD3{{{JUMP BACK TO PROCESS RESULT NAME
11019: {{EJC{{{{
11020: *
11021: * LOAD (CONTINUED)
11022: *
11023: * HERE AFTER PROCESSING ALL ARGS AND RESULT
11024: *
11025: {SLOD5{MOV{LODNA{R6{{GET NUMBER OF ARGUMENTS
11026: {{MOV{R6{R8{{COPY FOR LATER
11027: {{WTB{R6{{{CONVERT LENGTH TO BYTES
11028: {{ADD{#4*EFSI${R6{{ADD SPACE FOR STANDARD FIELDS
11029: {{JSR{ALLOC{{{ALLOCATE EFBLK
11030: {{MOV{#B$EFC{(R9){{SET TYPE WORD
11031: {{MOV{R8{4*FARGS(R9){{SET NUMBER OF ARGUMENTS
11032: {{ZER{4*EFUSE(R9){{{SET USE COUNT (DFFNC WILL SET TO 1)
11033: {{ZER{4*EFCOD(R9){{{ZERO CODE POINTER FOR NOW
11034: {{MOV{(SP)+{4*EFRSL(R9){{STORE RESULT TYPE CODE
11035: {{MOV{LODFN{4*EFVAR(R9){{STORE FUNCTION VRBLK POINTER
11036: {{MOV{R6{4*EFLEN(R9){{STORE EFBLK LENGTH
11037: {{MOV{R9{R7{{SAVE EFBLK POINTER
11038: {{ADD{R6{R9{{POINT PAST END OF EFBLK
11039: {{LCT{R8{R8{{SET NUMBER OF ARGUMENTS FOR LOOP
11040: *
11041: * LOOP TO SET ARGUMENT TYPE CODES FROM STACK
11042: *
11043: {SLOD6{MOV{(SP)+{-(R9){{STORE ONE TYPE CODE FROM STACK
11044: {{BCT{R8{SLOD6{{LOOP TILL ALL STORED
11045: *
11046: * NOW LOAD THE EXTERNAL FUNCTION AND PERFORM DEFINITION
11047: *
11048: {{MOV{(SP)+{R9{{LOAD FUNCTION STRING NAME
11049: {{MOV{(SP){R10{{LOAD LIBRARY NAME
11050: {{MOV{R7{(SP){{STORE EFBLK POINTER
11051: {{JSR{SYSLD{{{CALL FUNCTION TO LOAD EXTERNAL FUNC
11052: {{ERR{142{LOAD{{FUNCTION DOES NOT EXIST
11053: {{ERR{143{LOAD{{FUNCTION CAUSED INPUT ERROR DURING LOAD
11054: {{MOV{(SP)+{R10{{RECALL EFBLK POINTER
11055: {{MOV{R9{4*EFCOD(R10){{STORE CODE POINTER
11056: {{MOV{LODFN{R9{{POINT TO VRBLK FOR FUNCTION
11057: {{JSR{DFFNC{{{PERFORM FUNCTION DEFINITION
11058: {{BRN{EXNUL{{{RETURN NULL RESULT
11059: {{EJC{{{{
11060: *
11061: * LPAD
11062: *
11063: {S$LPD{ENT{{{{ENTRY POINT
11064: {{JSR{GTSTG{{{GET PAD CHARACTER
11065: {{ERR{144{LPAD{{THIRD ARGUMENT NOT A STRING
11066: {{PLC{R9{{{POINT TO CHARACTER (NULL IS BLANK)
11067: {{LCH{R7{(R9){{LOAD PAD CHARACTER
11068: {{JSR{GTSMI{{{GET PAD LENGTH
11069: {{ERR{145{LPAD{{SECOND ARGUMENT IS NOT INTEGER
11070: {{PPM{SLPD3{{{SKIP IF NEGATIVE OR LARGE
11071: *
11072: * MERGE TO CHECK FIRST ARG
11073: *
11074: {SLPD1{JSR{GTSTG{{{GET FIRST ARGUMENT (STRING TO PAD)
11075: {{ERR{146{LPAD{{FIRST ARGUMENT IS NOT STRING
11076: {{BGE{R6{R8{EXIXR{RETURN 1ST ARG IF TOO LONG TO PAD
11077: {{MOV{R9{R10{{ELSE MOVE PTR TO STRING TO PAD
11078: *
11079: * NOW WE ARE READY FOR THE PAD
11080: *
11081: * (XL) POINTER TO STRING TO PAD
11082: * (WB) PAD CHARACTER
11083: * (WC) LENGTH TO PAD STRING TO
11084: *
11085: {{MOV{R8{R6{{COPY LENGTH
11086: {{JSR{ALOCS{{{ALLOCATE SCBLK FOR NEW STRING
11087: {{MOV{R9{-(SP){{SAVE AS RESULT
11088: {{MOV{4*SCLEN(R10){R6{{LOAD LENGTH OF ARGUMENT
11089: {{SUB{R6{R8{{CALCULATE NUMBER OF PAD CHARACTERS
11090: {{PSC{R9{{{POINT TO CHARS IN RESULT STRING
11091: {{LCT{R8{R8{{SET COUNTER FOR PAD LOOP
11092: *
11093: * LOOP TO PERFORM PAD
11094: *
11095: {SLPD2{SCH{R7{(R9)+{{STORE PAD CHARACTER, BUMP PTR
11096: {{BCT{R8{SLPD2{{LOOP TILL ALL PAD CHARS STORED
11097: {{CSC{R9{{{COMPLETE STORE CHARACTERS
11098: *
11099: * NOW COPY STRING
11100: *
11101: {{BZE{R6{EXITS{{EXIT IF NULL STRING
11102: {{PLC{R10{{{ELSE POINT TO CHARS IN ARGUMENT
11103: {{MVC{{{{MOVE CHARACTERS TO RESULT STRING
11104: {{BRN{EXITS{{{JUMP FOR NEXT CODE WORD
11105: *
11106: * HERE IF 2ND ARG IS NEGATIVE OR LARGE
11107: *
11108: {SLPD3{ZER{R8{{{ZERO PAD COUNT
11109: {{BRN{SLPD1{{{MERGE
11110: {{EJC{{{{
11111: *
11112: * LT
11113: *
11114: {S$LTF{ENT{{{{ENTRY POINT
11115: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
11116: {{ERR{147{LT{{FIRST ARGUMENT IS NOT NUMERIC
11117: {{ERR{148{LT{{SECOND ARGUMENT IS NOT NUMERIC
11118: {{PPM{EXNUL{{{RETURN NULL IF LT
11119: {{PPM{EXFAL{{{FAIL IF EQ
11120: {{PPM{EXFAL{{{FAIL IF GT
11121: {{EJC{{{{
11122: *
11123: * NE
11124: *
11125: {S$NEF{ENT{{{{ENTRY POINT
11126: {{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
11127: {{ERR{149{NE{{FIRST ARGUMENT IS NOT NUMERIC
11128: {{ERR{150{NE{{SECOND ARGUMENT IS NOT NUMERIC
11129: {{PPM{EXNUL{{{RETURN NULL IF LT
11130: {{PPM{EXFAL{{{FAIL IF EQ
11131: {{PPM{EXNUL{{{RETURN NULL IF GT
11132: {{EJC{{{{
11133: *
11134: * NOTANY
11135: *
11136: {S$NAY{ENT{{{{ENTRY POINT
11137: {{MOV{#P$NAS{R7{{SET PCODE FOR SINGLE CHAR ARG
11138: {{MOV{#P$NAY{R10{{PCODE FOR MULTI-CHAR ARG
11139: {{MOV{#P$NAD{R8{{SET PCODE FOR EXPR ARG
11140: {{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE
11141: {{ERR{151{NOTANY{{ARGUMENT IS NOT STRING OR EXPRESSION
11142: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
11143: {{EJC{{{{
11144: *
11145: * OPSYN
11146: *
11147: {S$OPS{ENT{{{{ENTRY POINT
11148: {{JSR{GTSMI{{{LOAD THIRD ARGUMENT
11149: {{ERR{152{OPSYN{{THIRD ARGUMENT IS NOT INTEGER
11150: {{ERR{153{OPSYN{{THIRD ARGUMENT IS NEGATIVE OR TOO LARGE
11151: {{MOV{R8{R7{{IF OK, SAVE THIRD ARGUMNET
11152: {{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT
11153: {{JSR{GTNVR{{{LOCATE VARIABLE BLOCK
11154: {{ERR{154{OPSYN{{SECOND ARG IS NOT NATURAL VARIABLE NAME
11155: {{MOV{4*VRFNC(R9){R10{{IF OK, LOAD FUNCTION BLOCK POINTER
11156: {{BNZ{R7{SOPS2{{JUMP IF OPERATOR OPSYN CASE
11157: *
11158: * HERE FOR FUNCTION OPSYN (THIRD ARG ZERO)
11159: *
11160: {{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
11161: {{JSR{GTNVR{{{GET VRBLK POINTER
11162: {{ERR{155{OPSYN{{FIRST ARG IS NOT NATURAL VARIABLE NAME
11163: *
11164: * MERGE HERE TO PERFORM FUNCTION DEFINITION
11165: *
11166: {SOPS1{JSR{DFFNC{{{CALL FUNCTION DEFINER
11167: {{BRN{EXNUL{{{EXIT WITH NULL RESULT
11168: *
11169: * HERE FOR OPERATOR OPSYN (THIRD ARG NON-ZERO)
11170: *
11171: {SOPS2{JSR{GTSTG{{{GET OPERATOR NAME
11172: {{PPM{SOPS5{{{JUMP IF NOT STRING
11173: {{BNE{R6{#NUM01{SOPS5{ERROR IF NOT ONE CHAR LONG
11174: {{PLC{R9{{{ELSE POINT TO CHARACTER
11175: {{LCH{R8{(R9){{LOAD CHARACTER NAME
11176: {{EJC{{{{
11177: *
11178: * OPSYN (CONTINUED)
11179: *
11180: * NOW SET TO SEARCH FOR MATCHING UNARY OR BINARY OPERATOR
11181: * NAME AS APPROPRIATE. NOTE THAT THERE ARE =OPBUN UNDEFINED
11182: * BINARY OPERATORS AND =OPUUN UNDEFINED UNARY OPERATORS.
11183: *
11184: {{MOV{#R$UUB{R6{{POINT TO UNOP POINTERS IN CASE
11185: {{MOV{#OPNSU{R9{{POINT TO NAMES OF UNARY OPERATORS
11186: {{ADD{#OPBUN{R7{{ADD NO. OF UNDEFINED BINARY OPS
11187: {{BEQ{R7{#OPUUN{SOPS3{JUMP IF UNOP (THIRD ARG WAS 1)
11188: {{MOV{#R$UBA{R6{{ELSE POINT TO BINARY OPERATOR PTRS
11189: {{MOV{#OPSNB{R9{{POINT TO NAMES OF BINARY OPERATORS
11190: {{MOV{#OPBUN{R7{{SET NUMBER OF UNDEFINED BINOPS
11191: *
11192: * MERGE HERE TO CHECK LIST (WB = NUMBER TO CHECK)
11193: *
11194: {SOPS3{LCT{R7{R7{{SET COUNTER TO CONTROL LOOP
11195: *
11196: * LOOP TO SEARCH FOR NAME MATCH
11197: *
11198: {SOPS4{BEQ{R8{(R9){SOPS6{JUMP IF NAMES MATCH
11199: {{ICA{R6{{{ELSE PUSH POINTER TO FUNCTION PTR
11200: {{ICA{R9{{{BUMP POINTER
11201: {{BCT{R7{SOPS4{{LOOP BACK TILL ALL CHECKED
11202: *
11203: * HERE IF BAD OPERATOR NAME
11204: *
11205: {SOPS5{ERB{156{OPSYN{{FIRST ARG IS NOT CORRECT OPERATOR NAME
11206: *
11207: * COME HERE ON FINDING A MATCH IN THE OPERATOR NAME TABLE
11208: *
11209: {SOPS6{MOV{R6{R9{{COPY POINTER TO FUNCTION BLOCK PTR
11210: {{SUB{#4*VRFNC{R9{{MAKE IT LOOK LIKE DUMMY VRBLK
11211: {{BRN{SOPS1{{{MERGE BACK TO DEFINE OPERATOR
11212: {{EJC{{{{
11213: *
11214: * OUTPUT
11215: *
11216: {S$OUP{ENT{{{{ENTRY POINT
11217: {{MOV{#NUM03{R7{{OUTPUT FLAG
11218: {{JSR{IOPUT{{{CALL INPUT/OUTPUT ASSOC. ROUTINE
11219: {{ERR{157{OUTPUT{{THIRD ARGUMENT IS NOT A STRING
11220: {{ERR{158{INAPPROPRIATE{{SECOND ARGUMENT FOR OUTPUT
11221: {{ERR{159{INAPPROPRIATE{{FIRST ARGUMENT FOR OUTPUT
11222: {{ERR{160{INAPPROPRIATE{{FILE SPECIFICATION FOR OUTPUT
11223: {{PPM{EXFAL{{{FAIL IF FILE DOES NOT EXIST
11224: {{ERR{161{OUTPUT{{FILE CANNOT BE WRITTEN TO
11225: {{BRN{EXNUL{{{RETURN NULL STRING
11226: {{EJC{{{{
11227: *
11228: * POS
11229: *
11230: {S$POS{ENT{{{{ENTRY POINT
11231: {{MOV{#P$POS{R7{{SET PCODE FOR INTEGER ARG CASE
11232: {{MOV{#P$PSD{R6{{SET PCODE FOR EXPRESSION ARG CASE
11233: {{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE
11234: {{ERR{162{POS{{ARGUMENT IS NOT INTEGER OR EXPRESSION
11235: {{ERR{163{POS{{ARGUMENT IS NEGATIVE OR TOO LARGE
11236: {{BRN{EXIXR{{{RETURN PATTERN NODE
11237: {{EJC{{{{
11238: *
11239: * PROTOTYPE
11240: *
11241: {S$PRO{ENT{{{{ENTRY POINT
11242: {{MOV{(SP)+{R9{{LOAD ARGUMENT
11243: {{MOV{4*TBLEN(R9){R7{{LENGTH IF TABLE, VECTOR (=VCLEN)
11244: {{BTW{R7{{{CONVERT TO WORDS
11245: {{MOV{(R9){R6{{LOAD TYPE WORD OF ARGUMENT BLOCK
11246: {{BEQ{R6{#B$ART{SPRO4{JUMP IF ARRAY
11247: {{BEQ{R6{#B$TBT{SPRO1{JUMP IF TABLE
11248: {{BEQ{R6{#B$VCT{SPRO3{JUMP IF VECTOR
11249: {{BEQ{R6{#B$BCT{SPR05{JUMP IF BUFFER
11250: {{ERB{164{PROTOTYPE{{ARGUMENT IS NOT VALID OBJECT
11251: *
11252: * HERE FOR TABLE
11253: *
11254: {SPRO1{SUB{#TBSI${R7{{SUBTRACT STANDARD FIELDS
11255: *
11256: * MERGE FOR VECTOR
11257: *
11258: {SPRO2{MTI{R7{{{CONVERT TO INTEGER
11259: {{BRN{EXINT{{{EXIT WITH INTEGER RESULT
11260: *
11261: * HERE FOR VECTOR
11262: *
11263: {SPRO3{SUB{#VCSI${R7{{SUBTRACT STANDARD FIELDS
11264: {{BRN{SPRO2{{{MERGE
11265: *
11266: * HERE FOR ARRAY
11267: *
11268: {SPRO4{ADD{4*AROFS(R9){R9{{POINT TO PROTOTYPE FIELD
11269: {{MOV{(R9){R9{{LOAD PROTOTYPE
11270: {{BRN{EXIXR{{{RETURN PROTOTYPE AS RESULT
11271: *
11272: * HERE FOR BUFFER
11273: *
11274: {SPR05{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK
11275: {{MTI{4*BFALC(R9){{{LOAD ALLOCATED LENGTH
11276: {{BRN{EXINT{{{EXIT WITH INTEGER ALLOCATION
11277: {{EJC{{{{
11278: *
11279: * REMDR
11280: *
11281: {S$RMD{ENT{{{{ENTRY POINT
11282: {{ZER{R7{{{SET POSITIVE FLAG
11283: {{MOV{(SP){R9{{LOAD SECOND ARGUMENT
11284: {{JSR{GTINT{{{CONVERT TO INTEGER
11285: {{ERR{165{REMDR{{SECOND ARGUMENT IS NOT INTEGER
11286: {{JSR{ARITH{{{CONVERT ARGS
11287: {{PPM{SRM01{{{FIRST ARG NOT INTEGER
11288: {{PPM{{{{SECOND ARG CHECKED ABOVE
11289: {{PPM{SRM01{{{FIRST ARG REAL
11290: {{LDI{4*ICVAL(R9){{{LOAD LEFT ARGUMENT VALUE
11291: {{RMI{4*ICVAL(R10){{{GET REMAINDER
11292: {{INO{EXINT{{{JUMP IF NO OVERFLOW
11293: {{ERB{167{REMDR{{CAUSED INTEGER OVERFLOW
11294: *
11295: * FAIL FIRST ARGUMENT
11296: *
11297: {SRM01{ERB{166{REMDR{{FIRST ARGUMENT IS NOT INTEGER
11298: {{EJC{{{{
11299: *
11300: * REPLACE
11301: *
11302: * THE ACTUAL REPLACE OPERATION USES AN SCBLK WHOSE CFP$A
11303: * CHARS CONTAIN THE TRANSLATED VERSIONS OF ALL THE CHARS.
11304: * THE TABLE POINTER IS REMEMBERED FROM CALL TO CALL AND
11305: * THE TABLE IS ONLY BUILT WHEN THE ARGUMENTS CHANGE.
11306: *
11307: {S$RPL{ENT{{{{ENTRY POINT
11308: {{JSR{GTSTG{{{LOAD THIRD ARGUMENT AS STRING
11309: {{ERR{168{REPLACE{{THIRD ARGUMENT IS NOT STRING
11310: {{MOV{R9{R10{{SAVE THIRD ARG PTR
11311: {{JSR{GTSTG{{{GET SECOND ARGUMENT
11312: {{ERR{169{REPLACE{{SECOND ARGUMENT IS NOT STRING
11313: *
11314: * CHECK TO SEE IF THIS IS THE SAME TABLE AS LAST TIME
11315: *
11316: {{BNE{R9{R$RA2{SRPL1{JUMP IF 2ND ARGUMENT DIFFERENT
11317: {{BEQ{R10{R$RA3{SRPL4{JUMP IF ARGS SAME AS LAST TIME
11318: *
11319: * HERE WE BUILD A NEW REPLACE TABLE (NOTE WA = 2ND ARG LEN)
11320: *
11321: {SRPL1{MOV{4*SCLEN(R10){R7{{LOAD 3RD ARGUMENT LENGTH
11322: {{BNE{R6{R7{SRPL5{JUMP IF ARGUMENTS NOT SAME LENGTH
11323: {{BZE{R7{SRPL5{{JUMP IF NULL 2ND ARGUMENT
11324: {{MOV{R10{R$RA3{{SAVE THIRD ARG FOR NEXT TIME IN
11325: {{MOV{R9{R$RA2{{SAVE SECOND ARG FOR NEXT TIME IN
11326: {{MOV{KVALP{R10{{POINT TO ALPHABET STRING
11327: {{MOV{4*SCLEN(R10){R6{{LOAD ALPHABET SCBLK LENGTH
11328: {{MOV{R$RPT{R9{{POINT TO CURRENT TABLE (IF ANY)
11329: {{BNZ{R9{SRPL2{{JUMP IF WE ALREADY HAVE A TABLE
11330: *
11331: * HERE WE ALLOCATE A NEW TABLE
11332: *
11333: {{JSR{ALOCS{{{ALLOCATE NEW TABLE
11334: {{MOV{R8{R6{{KEEP SCBLK LENGTH
11335: {{MOV{R9{R$RPT{{SAVE TABLE POINTER FOR NEXT TIME
11336: *
11337: * MERGE HERE WITH POINTER TO NEW TABLE BLOCK IN (XR)
11338: *
11339: {SRPL2{CTB{R6{SCSI${{COMPUTE LENGTH OF SCBLK
11340: {{MVW{{{{COPY TO GET INITIAL TABLE VALUES
11341: {{EJC{{{{
11342: *
11343: * REPLACE (CONTINUED)
11344: *
11345: * NOW WE MUST PLUG SELECTED ENTRIES AS REQUIRED. NOTE THAT
11346: * WE ARE SHORT OF INDEX REGISTERS FOR THE FOLLOWING LOOP.
11347: * HENCE THE NEED TO REPEATEDLY RE-INITIALISE CHAR PTR XL
11348: *
11349: {{MOV{R$RA2{R10{{POINT TO SECOND ARGUMENT
11350: {{LCT{R7{R7{{NUMBER OF CHARS TO PLUG
11351: {{ZER{R8{{{ZERO CHAR OFFSET
11352: {{MOV{R$RA3{R9{{POINT TO 3RD ARG
11353: {{PLC{R9{{{GET CHAR PTR FOR 3RD ARG
11354: *
11355: * LOOP TO PLUG CHARS
11356: *
11357: {SRPL3{MOV{R$RA2{R10{{POINT TO 2ND ARG
11358: {{PLC{R10{R8{{POINT TO NEXT CHAR
11359: {{ICV{R8{{{INCREMENT OFFSET
11360: {{LCH{R6{(R10){{GET NEXT CHAR
11361: {{MOV{R$RPT{R10{{POINT TO TRANSLATE TABLE
11362: {{PSC{R10{R6{{CONVERT CHAR TO OFFSET INTO TABLE
11363: {{LCH{R6{(R9)+{{GET TRANSLATED CHAR
11364: {{SCH{R6{(R10){{STORE IN TABLE
11365: {{CSC{R10{{{COMPLETE STORE CHARACTERS
11366: {{BCT{R7{SRPL3{{LOOP TILL DONE
11367: {{EJC{{{{
11368: *
11369: * REPLACE (CONTINUED)
11370: *
11371: * HERE TO PERFORM TRANSLATE
11372: *
11373: {SRPL4{JSR{GTSTG{{{GET FIRST ARGUMENT
11374: {{ERR{170{REPLACE{{FIRST ARGUMENT IS NOT STRING
11375: {{BZE{R6{EXNUL{{RETURN NULL IF NULL ARGUMENT
11376: {{MOV{R9{R10{{COPY POINTER
11377: {{MOV{R6{R8{{SAVE LENGTH
11378: {{CTB{R6{SCHAR{{GET SCBLK LENGTH
11379: {{JSR{ALLOC{{{ALLOCATE SPACE FOR COPY
11380: {{MOV{R9{R7{{SAVE ADDRESS OF COPY
11381: {{MVW{{{{MOVE SCBLK CONTENTS TO COPY
11382: {{MOV{R$RPT{R9{{POINT TO REPLACE TABLE
11383: {{PLC{R9{{{POINT TO CHARS OF TABLE
11384: {{MOV{R7{R10{{POINT TO STRING TO TRANSLATE
11385: {{PLC{R10{{{POINT TO CHARS OF STRING
11386: {{MOV{R8{R6{{SET NUMBER OF CHARS TO TRANSLATE
11387: {{TRC{{{{PERFORM TRANSLATION
11388: {{MOV{R7{-(SP){{STACK NEW STRING AS RESULT
11389: {{BRN{EXITS{{{RETURN WITH RESULT ON STACK
11390: *
11391: * ERROR POINT
11392: *
11393: {SRPL5{ERB{171{NULL{{OR UNEQUALLY LONG 2ND, 3RD ARGS TO REPLACE
11394: {{EJC{{{{
11395: *
11396: * REWIND
11397: *
11398: {S$REW{ENT{{{{ENTRY POINT
11399: {{JSR{IOFCB{{{CALL FCBLK ROUTINE
11400: {{ERR{172{REWIND{{ARGUMENT IS NOT A SUITABLE NAME
11401: {{ERR{173{REWIND{{ARGUMENT IS NULL
11402: {{JSR{SYSRW{{{CALL SYSTEM REWIND FUNCTION
11403: {{ERR{174{REWIND{{FILE DOES NOT EXIST
11404: {{ERR{175{REWIND{{FILE DOES NOT PERMIT REWIND
11405: {{ERR{176{REWIND{{CAUSED NON-RECOVERABLE ERROR
11406: {{BRN{EXNUL{{{EXIT WITH NULL RESULT IF NO ERROR
11407: {{EJC{{{{
11408: *
11409: * REVERSE
11410: *
11411: {S$RVS{ENT{{{{ENTRY POINT
11412: {{JSR{GTSTG{{{LOAD STRING ARGUMENT
11413: {{ERR{177{REVERSE{{ARGUMENT IS NOT STRING
11414: {{BZE{R6{EXIXR{{RETURN ARGUMENT IF NULL
11415: {{MOV{R9{R10{{ELSE SAVE POINTER TO STRING ARG
11416: {{JSR{ALOCS{{{ALLOCATE SPACE FOR NEW SCBLK
11417: {{MOV{R9{-(SP){{STORE SCBLK PTR ON STACK AS RESULT
11418: {{PSC{R9{{{PREPARE TO STORE IN NEW SCBLK
11419: {{PLC{R10{R8{{POINT PAST LAST CHAR IN ARGUMENT
11420: {{LCT{R8{R8{{SET LOOP COUNTER
11421: *
11422: * LOOP TO MOVE CHARS IN REVERSE ORDER
11423: *
11424: {SRVS1{LCH{R7{-(R10){{LOAD NEXT CHAR FROM ARGUMENT
11425: {{SCH{R7{(R9)+{{STORE IN RESULT
11426: {{BCT{R8{SRVS1{{LOOP TILL ALL MOVED
11427: {{CSC{R9{{{COMPLETE STORE CHARACTERS
11428: {{BRN{EXITS{{{AND THEN JUMP FOR NEXT CODE WORD
11429: {{EJC{{{{
11430: *
11431: * RPAD
11432: *
11433: {S$RPD{ENT{{{{ENTRY POINT
11434: {{JSR{GTSTG{{{GET PAD CHARACTER
11435: {{ERR{178{RPAD{{THIRD ARGUMENT IS NOT STRING
11436: {{PLC{R9{{{POINT TO CHARACTER (NULL IS BLANK)
11437: {{LCH{R7{(R9){{LOAD PAD CHARACTER
11438: {{JSR{GTSMI{{{GET PAD LENGTH
11439: {{ERR{179{RPAD{{SECOND ARGUMENT IS NOT INTEGER
11440: {{PPM{SRPD3{{{SKIP IF NEGATIVE OR LARGE
11441: *
11442: * MERGE TO CHECK FIRST ARG.
11443: *
11444: {SRPD1{JSR{GTSTG{{{GET FIRST ARGUMENT (STRING TO PAD)
11445: {{ERR{180{RPAD{{FIRST ARGUMENT IS NOT STRING
11446: {{BGE{R6{R8{EXIXR{RETURN 1ST ARG IF TOO LONG TO PAD
11447: {{MOV{R9{R10{{ELSE MOVE PTR TO STRING TO PAD
11448: *
11449: * NOW WE ARE READY FOR THE PAD
11450: *
11451: * (XL) POINTER TO STRING TO PAD
11452: * (WB) PAD CHARACTER
11453: * (WC) LENGTH TO PAD STRING TO
11454: *
11455: {{MOV{R8{R6{{COPY LENGTH
11456: {{JSR{ALOCS{{{ALLOCATE SCBLK FOR NEW STRING
11457: {{MOV{R9{-(SP){{SAVE AS RESULT
11458: {{MOV{4*SCLEN(R10){R6{{LOAD LENGTH OF ARGUMENT
11459: {{SUB{R6{R8{{CALCULATE NUMBER OF PAD CHARACTERS
11460: {{PSC{R9{{{POINT TO CHARS IN RESULT STRING
11461: {{LCT{R8{R8{{SET COUNTER FOR PAD LOOP
11462: *
11463: * COPY ARGUMENT STRING
11464: *
11465: {{BZE{R6{SRPD2{{JUMP IF ARGUMENT IS NULL
11466: {{PLC{R10{{{ELSE POINT TO ARGUMENT CHARS
11467: {{MVC{{{{MOVE CHARACTERS TO RESULT STRING
11468: *
11469: * LOOP TO SUPPLY PAD CHARACTERS
11470: *
11471: {SRPD2{SCH{R7{(R9)+{{STORE PAD CHARACTER, BUMP PTR
11472: {{BCT{R8{SRPD2{{LOOP TILL ALL PAD CHARS STORED
11473: {{CSC{R9{{{COMPLETE CHARACTER STORING
11474: {{BRN{EXITS{{{AND EXIT FOR NEXT WORD
11475: *
11476: * HERE IF 2ND ARG IS NEGATIVE OR LARGE
11477: *
11478: {SRPD3{ZER{R8{{{ZERO PAD COUNT
11479: {{BRN{SRPD1{{{MERGE
11480: {{EJC{{{{
11481: *
11482: * RTAB
11483: *
11484: {S$RTB{ENT{{{{ENTRY POINT
11485: {{MOV{#P$RTB{R7{{SET PCODE FOR INTEGER ARG CASE
11486: {{MOV{#P$RTD{R6{{SET PCODE FOR EXPRESSION ARG CASE
11487: {{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE
11488: {{ERR{181{RTAB{{ARGUMENT IS NOT INTEGER OR EXPRESSION
11489: {{ERR{182{RTAB{{ARGUMENT IS NEGATIVE OR TOO LARGE
11490: {{BRN{EXIXR{{{RETURN PATTERN NODE
11491: {{EJC{{{{
11492: *
11493: * SET
11494: *
11495: {S$SET{ENT{{{{ENTRY POINT
11496: {{MOV{(SP)+{R$IO2{{SAVE THIRD ARG
11497: {{MOV{(SP)+{R$IO1{{SAVE SECOND ARG
11498: {{JSR{IOFCB{{{CALL FCBLK ROUTINE
11499: {{ERR{291{SET{{FIRST ARGUMENT IS NOT A SUITABLE NAME
11500: {{ERR{292{SET{{FIRST ARGUMENT IS NULL
11501: {{MOV{R$IO1{R7{{LOAD SECOND ARG
11502: {{MOV{R$IO2{R8{{LOAD THIRD ARG
11503: {{JSR{SYSST{{{CALL SYSTEM SET ROUTINE
11504: {{ERR{293{INAPPROPRIATE{{SECOND ARGUMENT TO SET
11505: {{ERR{294{INAPPROPRIATE{{THIRD ARGUMENT TO SET
11506: {{ERR{295{SET{{FILE DOES NOT EXIST
11507: {{ERR{296{SET{{FILE DOES NOT PERMIT SETTING FILE POINTER
11508: {{ERR{297{SET{{CAUSED NON-RECOVERABLE I/O ERROR
11509: {{BRN{EXNUL{{{OTHERWISEW RETURN NULL
11510: {{EJC{{{{
11511: *
11512: * TAB
11513: *
11514: {S$TAB{ENT{{{{ENTRY POINT
11515: {{MOV{#P$TAB{R7{{SET PCODE FOR INTEGER ARG CASE
11516: {{MOV{#P$TBD{R6{{SET PCODE FOR EXPRESSION ARG CASE
11517: {{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE
11518: {{ERR{183{TAB{{ARGUMENT IS NOT INTEGER OR EXPRESSION
11519: {{ERR{184{TAB{{ARGUMENT IS NEGATIVE OR TOO LARGE
11520: {{BRN{EXIXR{{{RETURN PATTERN NODE
11521: {{EJC{{{{
11522: *
11523: * RPOS
11524: *
11525: {S$RPS{ENT{{{{ENTRY POINT
11526: {{MOV{#P$RPS{R7{{SET PCODE FOR INTEGER ARG CASE
11527: {{MOV{#P$RPD{R6{{SET PCODE FOR EXPRESSION ARG CASE
11528: {{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE
11529: {{ERR{185{RPOS{{ARGUMENT IS NOT INTEGER OR EXPRESSION
11530: {{ERR{186{RPOS{{ARGUMENT IS NEGATIVE OR TOO LARGE
11531: {{BRN{EXIXR{{{RETURN PATTERN NODE
11532: {{EJC{{{{
11533: *
11534: * RSORT
11535: *
11536: {S$RSR{ENT{{{{ENTRY POINT
11537: {{MNZ{R6{{{MARK AS RSORT
11538: {{JSR{SORTA{{{CALL SORT ROUTINE
11539: {{BRN{EXSID{{{RETURN, SETTING IDVAL
11540: {{EJC{{{{
11541: *
11542: * SETEXIT
11543: *
11544: {S$STX{ENT{{{{ENTRY POINT
11545: {{MOV{(SP)+{R9{{LOAD ARGUMENT
11546: {{MOV{STXVR{R6{{LOAD OLD VRBLK POINTER
11547: {{ZER{R10{{{LOAD ZERO IN CASE NULL ARG
11548: {{BEQ{R9{#NULLS{SSTX1{JUMP IF NULL ARGUMENT (RESET CALL)
11549: {{JSR{GTNVR{{{ELSE GET SPECIFIED VRBLK
11550: {{PPM{SSTX2{{{JUMP IF NOT NATURAL VARIABLE
11551: {{MOV{4*VRLBL(R9){R10{{ELSE LOAD LABEL
11552: {{BEQ{R10{#STNDL{SSTX2{JUMP IF LABEL IS NOT DEFINED
11553: {{BNE{(R10){#B$TRT{SSTX1{JUMP IF NOT TRAPPED
11554: {{MOV{4*TRLBL(R10){R10{{ELSE LOAD PTR TO REAL LABEL CODE
11555: *
11556: * HERE TO SET/RESET SETEXIT TRAP
11557: *
11558: {SSTX1{MOV{R9{STXVR{{STORE NEW VRBLK POINTER (OR NULL)
11559: {{MOV{R10{R$SXC{{STORE NEW CODE PTR (OR ZERO)
11560: {{BEQ{R6{#NULLS{EXNUL{RETURN NULL IF NULL RESULT
11561: {{MOV{R6{R9{{ELSE COPY VRBLK POINTER
11562: {{BRN{EXVNM{{{AND RETURN BUILDING NMBLK
11563: *
11564: * HERE IF BAD ARGUMENT
11565: *
11566: {SSTX2{ERB{187{SETEXIT{{ARGUMENT IS NOT LABEL NAME OR NULL
11567: {{EJC{{{{
11568: *
11569: * SORT
11570: *
11571: {S$SRT{ENT{{{{ENTRY POINT
11572: {{ZER{R6{{{MARK AS SORT
11573: {{JSR{SORTA{{{CALL SORT ROUTINE
11574: {{BRN{EXSID{{{RETURN, SETTING IDVAL
11575: {{EJC{{{{
11576: *
11577: * SPAN
11578: *
11579: {S$SPN{ENT{{{{ENTRY POINT
11580: {{MOV{#P$SPS{R7{{SET PCODE FOR SINGLE CHAR ARG
11581: {{MOV{#P$SPN{R10{{SET PCODE FOR MULTI-CHAR ARG
11582: {{MOV{#P$SPD{R8{{SET PCODE FOR EXPRESSION ARG
11583: {{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE
11584: {{ERR{188{SPAN{{ARGUMENT IS NOT STRING OR EXPRESSION
11585: {{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
11586: {{EJC{{{{
11587: *
11588: * SIZE
11589: *
11590: {S$SI${ENT{{{{ENTRY POINT
11591: {{MOV{(SP){R9{{LOAD ARGUMENT
11592: {{BNE{(R9){#B$BCT{SSI$1{BRANCH IF NOT BUFFER
11593: {{ICA{SP{{{ELSE POP ARGUMENT
11594: {{MTI{4*BCLEN(R9){{{LOAD DEFINED LENGTH
11595: {{BRN{EXINT{{{EXIT WITH INTEGER
11596: *
11597: * HERE IF NOT BUFFER
11598: *
11599: {SSI$1{JSR{GTSTG{{{LOAD STRING ARGUMENT
11600: {{ERR{189{SIZE{{ARGUMENT IS NOT STRING
11601: {{MTI{R6{{{LOAD LENGTH AS INTEGER
11602: {{BRN{EXINT{{{EXIT WITH INTEGER RESULT
11603: {{EJC{{{{
11604: *
11605: * STOPTR
11606: *
11607: {S$STT{ENT{{{{ENTRY POINT
11608: {{ZER{R10{{{INDICATE STOPTR CASE
11609: {{JSR{TRACE{{{CALL TRACE PROCEDURE
11610: {{ERR{190{STOPTR{{FIRST ARGUMENT IS NOT APPROPRIATE NAME
11611: {{ERR{191{STOPTR{{SECOND ARGUMENT IS NOT TRACE TYPE
11612: {{BRN{EXNUL{{{RETURN NULL
11613: {{EJC{{{{
11614: *
11615: * SUBSTR
11616: *
11617: {S$SUB{ENT{{{{ENTRY POINT
11618: {{JSR{GTSMI{{{LOAD THIRD ARGUMENT
11619: {{ERR{192{SUBSTR{{THIRD ARGUMENT IS NOT INTEGER
11620: {{PPM{EXFAL{{{JUMP IF NEGATIVE OR TOO LARGE
11621: {{MOV{R9{SBSSV{{SAVE THIRD ARGUMENT
11622: {{JSR{GTSMI{{{LOAD SECOND ARGUMENT
11623: {{ERR{193{SUBSTR{{SECOND ARGUMENT IS NOT INTEGER
11624: {{PPM{EXFAL{{{JUMP IF OUT OF RANGE
11625: {{MOV{R9{R7{{SAVE SECOND ARGUMENT
11626: {{BZE{R7{EXFAL{{JUMP IF SECOND ARGUMENT ZERO
11627: {{DCV{R7{{{ELSE DECREMENT FOR ONES ORIGIN
11628: {{MOV{(SP){R10{{GET FIRST ARG PTR
11629: {{BNE{(R10){#B$BCT{SSUBA{BRANCH IF NOT BUFFER
11630: {{MOV{4*BCBUF(R10){R9{{GET BFBLK PTR
11631: {{MOV{4*BCLEN(R10){R6{{GET LENGTH
11632: {{BRN{SSUBB{{{MERGE
11633: *
11634: * HERE IF NOT BUFFER TO GET STRING
11635: *
11636: {SSUBA{JSR{GTSTG{{{LOAD FIRST ARGUMENT
11637: {{ERR{194{SUBSTR{{FIRST ARGUMENT IS NOT STRING
11638: *
11639: * MERGE WITH BFBLK OR SCBLK PTR IN XR. WA HAS LENGTH
11640: *
11641: {SSUBB{MOV{SBSSV{R8{{RELOAD THIRD ARGUMENT
11642: {{BNZ{R8{SSUB1{{SKIP IF THIRD ARG GIVEN
11643: {{MOV{R6{R8{{ELSE GET STRING LENGTH
11644: {{BGT{R7{R8{EXFAL{FAIL IF IMPROPER
11645: {{SUB{R7{R8{{REDUCE BY OFFSET TO START
11646: *
11647: * MERGE
11648: *
11649: {SSUB1{MOV{R6{R10{{SAVE STRING LENGTH
11650: {{MOV{R8{R6{{SET LENGTH OF SUBSTRING
11651: {{ADD{R7{R8{{ADD 2ND ARG TO 3RD ARG
11652: {{BGT{R8{R10{EXFAL{JUMP IF IMPROPER SUBSTRING
11653: {{MOV{R9{R10{{COPY POINTER TO FIRST ARG
11654: {{JSR{SBSTR{{{BUILD SUBSTRING
11655: {{BRN{EXIXR{{{AND JUMP FOR NEXT CODE WORD
11656: {{EJC{{{{
11657: *
11658: * TABLE
11659: *
11660: {S$TBL{ENT{{{{ENTRY POINT
11661: {{MOV{(SP)+{R10{{GET INITIAL LOOKUP VALUE
11662: {{ICA{SP{{{POP SECOND ARGUMENT
11663: {{JSR{GTSMI{{{LOAD ARGUMENT
11664: {{ERR{195{TABLE{{ARGUMENT IS NOT INTEGER
11665: {{ERR{196{TABLE{{ARGUMENT IS OUT OF RANGE
11666: {{BNZ{R8{STBL1{{JUMP IF NON-ZERO
11667: {{MOV{#TBNBK{R8{{ELSE SUPPLY DEFAULT VALUE
11668: *
11669: * MERGE HERE WITH NUMBER OF HEADERS IN WA
11670: *
11671: {STBL1{MOV{R8{R6{{COPY NUMBER OF HEADERS
11672: {{ADD{#TBSI${R6{{ADJUST FOR STANDARD FIELDS
11673: {{WTB{R6{{{CONVERT LENGTH TO BYTES
11674: {{JSR{ALLOC{{{ALLOCATE SPACE FOR TBBLK
11675: {{MOV{R9{R7{{COPY POINTER TO TBBLK
11676: {{MOV{#B$TBT{(R9)+{{STORE TYPE WORD
11677: {{ZER{(R9)+{{{ZERO ID FOR THE MOMENT
11678: {{MOV{R6{(R9)+{{STORE LENGTH (TBLEN)
11679: {{MOV{R10{(R9)+{{STORE INITIAL LOOKUP VALUE
11680: {{LCT{R8{R8{{SET LOOP COUNTER (NUM HEADERS)
11681: *
11682: * LOOP TO INITIALIZE ALL BUCKET POINTERS
11683: *
11684: {STBL2{MOV{R7{(R9)+{{STORE TBBLK PTR IN BUCKET HEADER
11685: {{BCT{R8{STBL2{{LOOP TILL ALL STORED
11686: {{MOV{R7{R9{{RECALL POINTER TO TBBLK
11687: {{BRN{EXSID{{{EXIT SETTING IDVAL
11688: {{EJC{{{{
11689: *
11690: * TIME
11691: *
11692: {S$TIM{ENT{{{{ENTRY POINT
11693: {{JSR{SYSTM{{{GET TIMER VALUE
11694: {{SBI{TIMSX{{{SUBTRACT STARTING TIME
11695: {{BRN{EXINT{{{EXIT WITH INTEGER VALUE
11696: {{EJC{{{{
11697: *
11698: * TRACE
11699: *
11700: {S$TRA{ENT{{{{ENTRY POINT
11701: {{BEQ{4*3(SP){#NULLS{STR03{JUMP IF FIRST ARGUMENT IS NULL
11702: {{MOV{(SP)+{R9{{LOAD FOURTH ARGUMENT
11703: {{ZER{R10{{{TENTATIVELY SET ZERO POINTER
11704: {{BEQ{R9{#NULLS{STR02{JUMP IF 4TH ARGUMENT IS NULL
11705: {{JSR{GTNVR{{{ELSE POINT TO VRBLK
11706: {{PPM{STR01{{{JUMP IF NOT VARIABLE NAME
11707: {{MOV{4*VRFNC(R9){R10{{ELSE LOAD FUNCTION POINTER
11708: {{BNE{R10{#STNDF{STR02{JUMP IF FUNCTION IS DEFINED
11709: *
11710: * HERE FOR BAD FOURTH ARGUMENT
11711: *
11712: {STR01{ERB{197{TRACE{{FOURTH ARG IS NOT FUNCTION NAME OR NULL
11713: *
11714: * HERE WITH FUNCTION POINTER IN XL
11715: *
11716: {STR02{MOV{(SP)+{R9{{LOAD THIRD ARGUMENT (TAG)
11717: {{ZER{R7{{{SET ZERO AS TRTYP VALUE FOR NOW
11718: {{JSR{TRBLD{{{BUILD TRBLK FOR TRACE CALL
11719: {{MOV{R9{R10{{MOVE TRBLK POINTER FOR TRACE
11720: {{JSR{TRACE{{{CALL TRACE PROCEDURE
11721: {{ERR{198{TRACE{{FIRST ARGUMENT IS NOT APPROPRIATE NAME
11722: {{ERR{199{TRACE{{SECOND ARGUMENT IS NOT TRACE TYPE
11723: {{BRN{EXNUL{{{RETURN NULL
11724: *
11725: * HERE TO CALL SYSTEM TRACE TOGGLE ROUTINE
11726: *
11727: {STR03{JSR{SYSTT{{{CALL IT
11728: {{ADD{#4*NUM04{SP{{POP TRACE ARGUMENTS
11729: {{BRN{EXNUL{{{RETURN
11730: {{EJC{{{{
11731: *
11732: * TRIM
11733: *
11734: {S$TRM{ENT{{{{ENTRY POINT
11735: {{JSR{GTSTG{{{LOAD ARGUMENT AS STRING
11736: {{ERR{200{TRIM{{ARGUMENT IS NOT STRING
11737: {{BZE{R6{EXNUL{{RETURN NULL IF ARGUMENT IS NULL
11738: {{MOV{R9{R10{{COPY STRING POINTER
11739: {{CTB{R6{SCHAR{{GET BLOCK LENGTH
11740: {{JSR{ALLOC{{{ALLOCATE COPY SAME SIZE
11741: {{MOV{R9{R7{{SAVE POINTER TO COPY
11742: {{MVW{{{{COPY OLD STRING BLOCK TO NEW
11743: {{MOV{R7{R9{{RESTORE PTR TO NEW BLOCK
11744: {{JSR{TRIMR{{{TRIM BLANKS (WB IS NON-ZERO)
11745: {{BRN{EXIXR{{{EXIT WITH RESULT IN XR
11746: {{EJC{{{{
11747: *
11748: * UNLOAD
11749: *
11750: {S$UNL{ENT{{{{ENTRY POINT
11751: {{MOV{(SP)+{R9{{LOAD ARGUMENT
11752: {{JSR{GTNVR{{{POINT TO VRBLK
11753: {{ERR{201{UNLOAD{{ARGUMENT IS NOT NATURAL VARIABLE NAME
11754: {{MOV{#STNDF{R10{{GET PTR TO UNDEFINED FUNCTION
11755: {{JSR{DFFNC{{{UNDEFINE NAMED FUNCTION
11756: {{BRN{EXNUL{{{RETURN NULL AS RESULT
11757: {{TTL{S{{{P I T B O L -- UTILITY PROCEDURES
11758: *
11759: * THE FOLLOWING SECTION CONTAINS PROCEDURES WHICH ARE
11760: * USED FOR VARIOUS PURPOSES THROUGHOUT THE SYSTEM.
11761: *
11762: * EACH PROCEDURE IS PRECEDED BY A DESCRIPTION OF THE
11763: * CALLING SEQUENCE. USUALLY THE ARGUMENTS ARE IN REGISTERS
11764: * BUT ARGUMENTS CAN ALSO OCCUR ON THE STACK AND AS
11765: * PARAMETERS ASSEMBLED AFTER THE JSR INSTRUCTION.
11766: *
11767: * THE FOLLOWING CONSIDERATIONS APPLY TO THESE DESCRIPTIONS.
11768: *
11769: * 1) THE STACK POINTER (XS) IS NOT CHANGED UNLESS THE
11770: * CHANGE IS EXPLICITLY DOCUMENTED IN THE CALL.
11771: *
11772: * 2) REGISTERS WHOSE ENTRY VALUES ARE NOT MENTIONED
11773: * MAY CONTAIN ANY VALUE EXCEPT THAT XL,XR MAY ONLY
11774: * CONTAIN PROPER (COLLECTABLE) POINTER VALUES.
11775: * THIS CONDITION ON XR MEANS THAT THE CALLED ROUTINE
11776: * MAY IF IT CHOOSES PRESERVE XR BY STACKING.
11777: *
11778: * 3) REGISTERS NOT MENTIONED ON EXIT CONTAIN THE SAME
11779: * VALUES AS THEY DID ON ENTRY EXCEPT THAT VALUES IN
11780: * XR,XL MAY HAVE BEEN RELOCATED BY THE COLLECTOR.
11781: *
11782: * 4) REGISTERS WHICH ARE DESTROYED ON EXIT MAY CONTAIN
11783: * ANY VALUE EXCEPT THAT VALUES IN XL,XR ARE PROPER
11784: * (COLLECTABLE) POINTERS.
11785: *
11786: * 5) THE CODE POINTER REGISTER POINTS TO THE CURRENT
11787: * CODE LOCATION ON ENTRY AND IS UNCHANGED ON EXIT.
11788: *
11789: * IN THE ABOVE DESCRIPTION, A COLLECTABLE POINTER IS ONE
11790: * WHICH EITHER POINTS OUTSIDE THE DYNAMIC REGION OR
11791: * POINTS TO THE START OF A BLOCK IN THE DYNAMIC REGION.
11792: *
11793: * IN THOSE CASES WHERE THE CALLING SEQUENCE CONTAINS
11794: * PARAMETERS WHICH ARE USED AS ALTERNATE RETURN POINTS,
11795: * THESE PARAMETERS MAY BE REPLACED BY ERROR CODES
11796: * ASSEMBLED WITH THE ERR INSTRUCTION. THIS WILL RESULT
11797: * IN THE POSTING OF THE ERROR IF THE RETURN IS TAKEN.
11798: *
11799: * THE PROCEDURES ALL HAVE NAMES CONSISTING OF FIVE LETTERS
11800: * AND ARE IN ALPHABETICAL ORDER BY THEIR NAMES.
11801: {{EJC{{{{
11802: *
11803: * ACESS - ACCESS VARIABLE VALUE WITH TRACE/INPUT CHECKS
11804: *
11805: * ACESS LOADS THE VALUE OF A VARIABLE. TRACE AND INPUT
11806: * ASSOCIATIONS ARE TESTED FOR AND EXECUTED AS REQUIRED.
11807: * ACESS ALSO HANDLES THE SPECIAL CASES OF PSEUDO-VARIABLES.
11808: *
11809: * (XL) VARIABLE NAME BASE
11810: * (WA) VARIABLE NAME OFFSET
11811: * JSR ACESS CALL TO ACCESS VALUE
11812: * PPM LOC TRANSFER LOC IF ACCESS FAILURE
11813: * (XR) VARIABLE VALUE
11814: * (WA,WB,WC) DESTROYED
11815: * (XL,RA) DESTROYED
11816: *
11817: * FAILURE CAN OCCUR IF AN INPUT ASSOCIATION CAUSES AN END
11818: * OF FILE CONDITION OR IF THE EVALUATION OF AN EXPRESSION
11819: * ASSOCIATED WITH AN EXPRESSION VARIABLE FAILS.
11820: *
11821: {ACESS{PRC{R{1{{ENTRY POINT (RECURSIVE)
11822: {{MOV{R10{R9{{COPY NAME BASE
11823: {{ADD{R6{R9{{POINT TO VARIABLE LOCATION
11824: {{MOV{(R9){R9{{LOAD VARIABLE VALUE
11825: *
11826: * LOOP HERE TO CHECK FOR SUCCESSIVE TRBLKS
11827: *
11828: {ACS02{BNE{(R9){#B$TRT{ACS18{JUMP IF NOT TRAPPED
11829: *
11830: * HERE IF TRAPPED
11831: *
11832: {{BEQ{R9{#TRBKV{ACS12{JUMP IF KEYWORD VARIABLE
11833: {{BNE{R9{#TRBEV{ACS05{JUMP IF NOT EXPRESSION VARIABLE
11834: *
11835: * HERE FOR EXPRESSION VARIABLE, EVALUATE VARIABLE
11836: *
11837: {{MOV{4*EVEXP(R10){R9{{LOAD EXPRESSION POINTER
11838: {{ZER{R7{{{EVALUATE BY VALUE
11839: {{JSR{EVALX{{{EVALUATE EXPRESSION
11840: {{PPM{ACS04{{{JUMP IF EVALUATION FAILURE
11841: {{BRN{ACS02{{{CHECK VALUE FOR MORE TRBLKS
11842: {{EJC{{{{
11843: *
11844: * ACESS (CONTINUED)
11845: *
11846: * HERE ON READING END OF FILE
11847: *
11848: {ACS03{ADD{#4*NUM03{SP{{POP TRBLK PTR, NAME BASE AND OFFSET
11849: {{MOV{R9{DNAMP{{POP UNUSED SCBLK
11850: *
11851: * MERGE HERE WHEN EVALUATION OF EXPRESSION FAILS
11852: *
11853: {ACS04{EXI{1{{{TAKE ALTERNATE (FAILURE) RETURN
11854: *
11855: * HERE IF NOT KEYWORD OR EXPRESSION VARIABLE
11856: *
11857: {ACS05{MOV{4*TRTYP(R9){R7{{LOAD TRAP TYPE CODE
11858: {{BNZ{R7{ACS10{{JUMP IF NOT INPUT ASSOCIATION
11859: {{BZE{KVINP{ACS09{{IGNORE INPUT ASSOC IF INPUT IS OFF
11860: *
11861: * HERE FOR INPUT ASSOCIATION
11862: *
11863: {{MOV{R10{-(SP){{STACK NAME BASE
11864: {{MOV{R6{-(SP){{STACK NAME OFFSET
11865: {{MOV{R9{-(SP){{STACK TRBLK POINTER
11866: {{MOV{4*TRFPT(R9){R10{{GET FILE CTRL BLK PTR OR ZERO
11867: {{BNZ{R10{ACS06{{JUMP IF NOT STANDARD INPUT FILE
11868: {{BEQ{4*TRTER(R9){#V$TER{ACS21{JUMP IF TERMINAL
11869: *
11870: * HERE TO READ FROM STANDARD INPUT FILE
11871: *
11872: {{MOV{CSWIN{R6{{LENGTH FOR READ BUFFER
11873: {{JSR{ALOCS{{{BUILD STRING OF APPROPRIATE LENGTH
11874: {{JSR{SYSRD{{{READ NEXT STANDARD INPUT IMAGE
11875: {{PPM{ACS03{{{JUMP TO FAIL EXIT IF END OF FILE
11876: {{BRN{ACS07{{{ELSE MERGE WITH OTHER FILE CASE
11877: *
11878: * HERE FOR INPUT FROM OTHER THAN STANDARD INPUT FILE
11879: *
11880: {ACS06{MOV{R10{R6{{FCBLK PTR
11881: {{JSR{SYSIL{{{GET INPUT RECORD MAX LENGTH (TO WA)
11882: {{JSR{ALOCS{{{ALLOCATE STRING OF CORRECT SIZE
11883: {{MOV{R10{R6{{FCBLK PTR
11884: {{JSR{SYSIN{{{CALL SYSTEM INPUT ROUTINE
11885: {{PPM{ACS03{{{JUMP TO FAIL EXIT IF END OF FILE
11886: {{PPM{ACS22{{{ERROR
11887: {{PPM{ACS23{{{ERROR
11888: {{EJC{{{{
11889: *
11890: * ACESS (CONTINUED)
11891: *
11892: * MERGE HERE AFTER OBTAINING INPUT RECORD
11893: *
11894: {ACS07{MOV{KVTRM{R7{{LOAD TRIM INDICATOR
11895: {{JSR{TRIMR{{{TRIM RECORD AS REQUIRED
11896: {{MOV{R9{R7{{COPY RESULT POINTER
11897: {{MOV{(SP){R9{{RELOAD POINTER TO TRBLK
11898: *
11899: * LOOP TO CHASE TO END OF TRBLK CHAIN AND STORE VALUE
11900: *
11901: {ACS08{MOV{R9{R10{{SAVE POINTER TO THIS TRBLK
11902: {{MOV{4*TRNXT(R9){R9{{LOAD FORWARD POINTER
11903: {{BEQ{(R9){#B$TRT{ACS08{LOOP IF THIS IS ANOTHER TRBLK
11904: {{MOV{R7{4*TRNXT(R10){{ELSE STORE RESULT AT END OF CHAIN
11905: {{MOV{(SP)+{R9{{RESTORE INITIAL TRBLK POINTER
11906: {{MOV{(SP)+{R6{{RESTORE NAME OFFSET
11907: {{MOV{(SP)+{R10{{RESTORE NAME BASE POINTER
11908: *
11909: * COME HERE TO MOVE TO NEXT TRBLK
11910: *
11911: {ACS09{MOV{4*TRNXT(R9){R9{{LOAD FORWARD PTR TO NEXT VALUE
11912: {{BRN{ACS02{{{BACK TO CHECK IF TRAPPED
11913: *
11914: * HERE TO CHECK FOR ACCESS TRACE TRBLK
11915: *
11916: {ACS10{BNE{R7{#TRTAC{ACS09{LOOP BACK IF NOT ACCESS TRACE
11917: {{BZE{KVTRA{ACS09{{IGNORE ACCESS TRACE IF TRACE OFF
11918: {{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT
11919: {{BZE{4*TRFNC(R9){ACS11{{JUMP IF PRINT TRACE
11920: {{EJC{{{{
11921: *
11922: * ACESS (CONTINUED)
11923: *
11924: * HERE FOR FULL FUNCTION TRACE
11925: *
11926: {{JSR{TRXEQ{{{CALL ROUTINE TO EXECUTE TRACE
11927: {{BRN{ACS09{{{JUMP FOR NEXT TRBLK
11928: *
11929: * HERE FOR CASE OF PRINT TRACE
11930: *
11931: {ACS11{JSR{PRTSN{{{PRINT STATEMENT NUMBER
11932: {{JSR{PRTNV{{{PRINT NAME = VALUE
11933: {{BRN{ACS09{{{JUMP BACK FOR NEXT TRBLK
11934: *
11935: * HERE FOR KEYWORD VARIABLE
11936: *
11937: {ACS12{MOV{4*KVNUM(R10){R9{{LOAD KEYWORD NUMBER
11938: {{BGE{R9{#K$V$${ACS14{JUMP IF NOT ONE WORD VALUE
11939: {{MTI{L^KVABE(R9){{{ELSE LOAD VALUE AS INTEGER
11940: *
11941: * COMMON EXIT WITH KEYWORD VALUE AS INTEGER IN (IA)
11942: *
11943: {ACS13{JSR{ICBLD{{{BUILD ICBLK
11944: {{BRN{ACS18{{{JUMP TO EXIT
11945: *
11946: * HERE IF NOT ONE WORD KEYWORD VALUE
11947: *
11948: {ACS14{BGE{R9{#K$S$${ACS15{JUMP IF SPECIAL CASE
11949: {{SUB{#K$V$${R9{{ELSE GET OFFSET
11950: {{ADD{#NDABO{R9{{POINT TO PATTERN VALUE
11951: {{BRN{ACS18{{{JUMP TO EXIT
11952: *
11953: * HERE IF SPECIAL KEYWORD CASE
11954: *
11955: {ACS15{MOV{KVRTN{R10{{LOAD RTNTYPE IN CASE
11956: {{LDI{KVSTL{{{LOAD STLIMIT IN CASE
11957: {{SUB{#K$S$${R9{{GET CASE NUMBER
11958: {{BSW{R9{5{{SWITCH ON KEYWORD NUMBER
11959: {{IFF{K$$AL{ACS16{{JUMP IF ALPHABET
11960: {{IFF{K$$RT{ACS17{{RTNTYPE
11961: {{IFF{K$$SC{ACS19{{STCOUNT
11962: {{IFF{K$$ET{ACS20{{ERRTEXT
11963: {{IFF{K$$SL{ACS13{{STLIMIT
11964: {{ESW{{{{END SWITCH ON KEYWORD NUMBER
11965: {{EJC{{{{
11966: *
11967: * ACESS (CONTINUED)
11968: *
11969: * ALPHABET
11970: *
11971: {ACS16{MOV{KVALP{R10{{LOAD POINTER TO ALPHABET STRING
11972: *
11973: * RTNTYPE MERGES HERE
11974: *
11975: {ACS17{MOV{R10{R9{{COPY STRING PTR TO PROPER REG
11976: *
11977: * COMMON RETURN POINT
11978: *
11979: {ACS18{EXI{{{{RETURN TO ACESS CALLER
11980: *
11981: * HERE FOR STCOUNT (IA HAS STLIMIT)
11982: *
11983: {ACS19{SBI{KVSTC{{{STCOUNT = LIMIT - LEFT
11984: {{BRN{ACS13{{{MERGE BACK WITH INTEGER RESULT
11985: *
11986: * ERRTEXT
11987: *
11988: {ACS20{MOV{R$ETX{R9{{GET ERRTEXT STRING
11989: {{BRN{ACS18{{{MERGE WITH RESULT
11990: *
11991: * HERE TO READ A RECORD FROM TERMINAL
11992: *
11993: {ACS21{MOV{#RILEN{R6{{BUFFER LENGTH
11994: {{JSR{ALOCS{{{ALLOCATE BUFFER
11995: {{JSR{SYSRI{{{READ RECORD
11996: {{PPM{ACS03{{{ENDFILE
11997: {{BRN{ACS07{{{MERGE WITH RECORD READ
11998: *
11999: * ERROR RETURNS
12000: *
12001: {ACS22{MOV{R9{DNAMP{{POP UNUSED SCBLK
12002: {{ERB{202{INPUT{{FROM FILE CAUSED NON-RECOVERABLE ERROR
12003: *
12004: {ACS23{MOV{R9{DNAMP{{POP UNUSED SCBLK
12005: {{ERB{203{INPUT{{FILE RECORD HAS INCORRECT FORMAT
12006: {{ENP{{{{END PROCEDURE ACESS
12007: {{EJC{{{{
12008: *
12009: * ACOMP -- COMPARE TWO ARITHMETIC VALUES
12010: *
12011: * 1(XS) FIRST ARGUMENT
12012: * 0(XS) SECOND ARGUMENT
12013: * JSR ACOMP CALL TO COMPARE VALUES
12014: * PPM LOC TRANSFER LOC IF ARG1 IS NON-NUMERIC
12015: * PPM LOC TRANSFER LOC IF ARG2 IS NON-NUMERIC
12016: * PPM LOC TRANSFER LOC FOR ARG1 LT ARG2
12017: * PPM LOC TRANSFER LOC FOR ARG1 EQ ARG2
12018: * PPM LOC TRANSFER LOC FOR ARG1 GT ARG2
12019: * (NORMAL RETURN IS NEVER GIVEN)
12020: * (WA,WB,WC,IA,RA) DESTROYED
12021: * (XL,XR) DESTROYED
12022: *
12023: {ACOMP{PRC{N{5{{ENTRY POINT
12024: {{JSR{ARITH{{{LOAD ARITHMETIC OPERANDS
12025: {{PPM{ACMP7{{{JUMP IF FIRST ARG NON-NUMERIC
12026: {{PPM{ACMP8{{{JUMP IF SECOND ARG NON-NUMERIC
12027: {{PPM{ACMP4{{{JUMP IF REAL ARGUMENTS
12028: *
12029: * HERE FOR INTEGER ARGUMENTS
12030: *
12031: {{SBI{4*ICVAL(R10){{{SUBTRACT TO COMPARE
12032: {{IOV{ACMP3{{{JUMP IF OVERFLOW
12033: {{ILT{ACMP5{{{ELSE JUMP IF ARG1 LT ARG2
12034: {{IEQ{ACMP2{{{JUMP IF ARG1 EQ ARG2
12035: *
12036: * HERE IF ARG1 GT ARG2
12037: *
12038: {ACMP1{EXI{5{{{TAKE GT EXIT
12039: *
12040: * HERE IF ARG1 EQ ARG2
12041: *
12042: {ACMP2{EXI{4{{{TAKE EQ EXIT
12043: {{EJC{{{{
12044: *
12045: * ACOMP (CONTINUED)
12046: *
12047: * HERE FOR INTEGER OVERFLOW ON SUBTRACT
12048: *
12049: {ACMP3{LDI{4*ICVAL(R10){{{LOAD SECOND ARGUMENT
12050: {{ILT{ACMP1{{{GT IF NEGATIVE
12051: {{BRN{ACMP5{{{ELSE LT
12052: *
12053: * HERE FOR REAL OPERANDS
12054: *
12055: {ACMP4{SBR{4*RCVAL(R10){{{SUBTRACT TO COMPARE
12056: {{ROV{ACMP6{{{JUMP IF OVERFLOW
12057: {{RGT{ACMP1{{{ELSE JUMP IF ARG1 GT
12058: {{REQ{ACMP2{{{JUMP IF ARG1 EQ ARG2
12059: *
12060: * HERE IF ARG1 LT ARG2
12061: *
12062: {ACMP5{EXI{3{{{TAKE LT EXIT
12063: *
12064: * HERE IF OVERFLOW ON REAL SUBTRACTION
12065: *
12066: {ACMP6{LDR{4*RCVAL(R10){{{RELOAD ARG2
12067: {{RLT{ACMP1{{{GT IF NEGATIVE
12068: {{BRN{ACMP5{{{ELSE LT
12069: *
12070: * HERE IF ARG1 NON-NUMERIC
12071: *
12072: {ACMP7{EXI{1{{{TAKE ERROR EXIT
12073: *
12074: * HERE IF ARG2 NON-NUMERIC
12075: *
12076: {ACMP8{EXI{2{{{TAKE ERROR EXIT
12077: {{ENP{{{{END PROCEDURE ACOMP
12078: {{EJC{{{{
12079: *
12080: * ALLOC ALLOCATE BLOCK OF DYNAMIC STORAGE
12081: *
12082: * (WA) LENGTH REQUIRED IN BYTES
12083: * JSR ALLOC CALL TO ALLOCATE BLOCK
12084: * (XR) POINTER TO ALLOCATED BLOCK
12085: *
12086: * A POSSIBLE ALTERNATIVE TO AOV .. AND FOLLOWING STMT IS -
12087: * MOV DNAME,XR . SUB WA,XR . BLO XR,DNAMP,ALOC2 .
12088: * MOV DNAMP,XR . ADD WA,XR
12089: *
12090: {ALLOC{PRC{E{0{{ENTRY POINT
12091: *
12092: * COMMON EXIT POINT
12093: *
12094: {ALOC1{MOV{DNAMP{R9{{POINT TO NEXT AVAILABLE LOC
12095: {{AOV{R6{R9{ALOC2{POINT PAST ALLOCATED BLOCK
12096: {{BGT{R9{DNAME{ALOC2{JUMP IF NOT ENOUGH ROOM
12097: {{MOV{R9{DNAMP{{STORE NEW POINTER
12098: {{SUB{R6{R9{{POINT BACK TO START OF ALLOCATED BK
12099: {{EXI{{{{RETURN TO CALLER
12100: *
12101: * HERE IF INSUFFICIENT ROOM, TRY A GARBAGE COLLECTION
12102: *
12103: {ALOC2{MOV{R7{ALLSV{{SAVE WB
12104: {{ZER{R7{{{SET NO UPWARD MOVE FOR GBCOL
12105: {{JSR{GBCOL{{{GARBAGE COLLECT
12106: *
12107: * SEE IF ROOM AFTER GBCOL OR SYSMM CALL
12108: *
12109: {ALOC3{MOV{DNAMP{R9{{POINT TO FIRST AVAILABLE LOC
12110: {{AOV{R6{R9{ALC3A{POINT PAST NEW BLOCK
12111: {{BLO{R9{DNAME{ALOC4{JUMP IF THERE IS ROOM NOW
12112: *
12113: * FAILED AGAIN, SEE IF WE CAN GET MORE CORE
12114: *
12115: {ALC3A{JSR{SYSMM{{{TRY TO GET MORE MEMORY
12116: {{WTB{R9{{{CONVERT TO BAUS (SGD05)
12117: {{ADD{R9{DNAME{{BUMP PTR BY AMOUNT OBTAINED
12118: {{BNZ{R9{ALOC3{{JUMP IF GOT MORE CORE
12119: {{ADD{RSMEM{DNAME{{GET THE RESERVE MEMORY
12120: {{ZER{RSMEM{{{ONLY PERMISSIBLE ONCE
12121: {{ICV{ERRFT{{{FATAL ERROR
12122: {{ERB{204{MEMORY{{OVERFLOW
12123: {{EJC{{{{
12124: *
12125: * HERE AFTER SUCCESSFUL GARBAGE COLLECTION
12126: *
12127: {ALOC4{STI{ALLIA{{{SAVE IA
12128: {{MOV{DNAME{R7{{GET DYNAMIC END ADRS
12129: {{SUB{DNAMP{R7{{COMPUTE FREE STORE
12130: {{BTW{R7{{{CONVERT BYTES TO WORDS
12131: {{MTI{R7{{{PUT FREE STORE IN IA
12132: {{MLI{ALFSF{{{MULTIPLY BY FREE STORE FACTOR
12133: {{IOV{ALOC5{{{JUMP IF OVERFLOWED
12134: {{MOV{DNAME{R7{{DYNAMIC END ADRS
12135: {{SUB{DNAMB{R7{{COMPUTE TOTAL AMOUNT OF DYNAMIC
12136: {{BTW{R7{{{CONVERT TO WORDS
12137: {{MOV{R7{ALDYN{{STORE IT
12138: {{SBI{ALDYN{{{SUBTRACT FROM SCALED UP FREE STORE
12139: {{IGT{ALOC5{{{JUMP IF SUFFICIENT FREE STORE
12140: {{JSR{SYSMM{{{TRY TO GET MORE STORE
12141: {{WTB{R9{{{CONVERT TO BAUS (SGD05)
12142: {{ADD{R9{DNAME{{ADJUST DYNAMIC END ADRS
12143: *
12144: * MERGE TO RESTORE IA AND WB
12145: *
12146: {ALOC5{LDI{ALLIA{{{RECOVER IA
12147: {{MOV{ALLSV{R7{{RESTORE WB
12148: {{BRN{ALOC1{{{JUMP BACK TO EXIT
12149: {{ENP{{{{END PROCEDURE ALLOC
12150: {{EJC{{{{
12151: *
12152: * ALOBF -- ALLOCATE BUFFER
12153: *
12154: * THIS ROUTINES ALLOCATES A NEW BUFFER. AS THE BFBLK
12155: * AND BCBLK COME IN PAIRS, BOTH ARE ALLOCATED HERE,
12156: * AND XR POINTS TO THE BCBLK ON RETURN. THE BFBLK
12157: * AND BCBLK ARE SET TO THE NULL BUFFER, AND THE IDVAL
12158: * IS ZERO ON RETURN.
12159: *
12160: * (WA) BUFFER SIZE IN CHARACTERS
12161: * JSR ALOBF CALL TO CREATE BUFFER
12162: * (XR) BCBLK PTR
12163: * (WA,WB) DESTROYED
12164: *
12165: {ALOBF{PRC{E{0{{ENTRY POINT
12166: {{MOV{R6{R7{{HANG ONTO ALLOCATION SIZE
12167: {{CTB{R6{BFSI${{GET TOTAL BLOCK SIZE
12168: {{BGE{R6{MXLEN{ALB01{CHECK FOR MAXLEN EXCEEDED
12169: {{ADD{#4*BCSI${R6{{ADD IN ALLOCATION FOR BCBLK
12170: {{JSR{ALLOC{{{ALLOCATE FRAME
12171: {{MOV{#B$BCT{(R9){{SET TYPE
12172: {{ZER{4*IDVAL(R9){{{NO ID YET
12173: {{ZER{4*BCLEN(R9){{{NO DEFINED LENGTH
12174: {{MOV{R10{R6{{SAVE XL
12175: {{MOV{R9{R10{{COPY BCBLK PTR
12176: {{ADD{#4*BCSI${R10{{BIAS PAST PARTIALLY BUILT BCBLK
12177: {{MOV{#B$BFT{(R10){{SET BFBLK TYPE WORD
12178: {{MOV{R7{4*BFALC(R10){{SET ALLOCATED SIZE
12179: {{MOV{R10{4*BCBUF(R9){{SET POINTER IN BCBLK
12180: {{ZER{4*BFCHR(R10){{{CLEAR FIRST WORD (NULL PAD)
12181: {{MOV{R6{R10{{RESTORE ENTRY XL
12182: {{EXI{{{{RETURN TO CALLER
12183: *
12184: * HERE FOR MXLEN EXCEEDED
12185: *
12186: {ALB01{ERB{274{REQUESTED{{BUFFER ALLOCATION EXCEEDS MXLEN
12187: {{ENP{{{{END PROCEDURE ALOBF
12188: {{EJC{{{{
12189: *
12190: * ALOCS -- ALLOCATE STRING BLOCK
12191: *
12192: * ALOCS IS USED TO BUILD A FRAME FOR A STRING BLOCK INTO
12193: * WHICH THE ACTUAL CHARACTERS ARE PLACED BY THE CALLER.
12194: * ALL STRINGS ARE CREATED WITH A CALL TO ALOCS (THE
12195: * EXCEPTIONS OCCUR IN TRIMR AND S$RPL PROCEDURES).
12196: *
12197: * (WA) LENGTH OF STRING TO BE ALLOCATED
12198: * JSR ALOCS CALL TO ALLOCATE SCBLK
12199: * (XR) POINTER TO RESULTING SCBLK
12200: * (WA) DESTROYED
12201: * (WC) CHARACTER COUNT (ENTRY VALUE OF WA)
12202: *
12203: * THE RESULTING SCBLK HAS THE TYPE WORD AND THE LENGTH
12204: * FILLED IN AND THE LAST WORD IS CLEARED TO ZERO CHARACTERS
12205: * TO ENSURE CORRECT RIGHT PADDING OF THE FINAL WORD.
12206: *
12207: {ALOCS{PRC{E{0{{ENTRY POINT
12208: {{BGT{R6{KVMXL{ALCS2{JUMP IF LENGTH EXCEEEDS MAXLENGTH
12209: {{MOV{R6{R8{{ELSE COPY LENGTH
12210: {{CTB{R6{SCSI${{COMPUTE LENGTH OF SCBLK IN BYTES
12211: {{MOV{DNAMP{R9{{POINT TO NEXT AVAILABLE LOCATION
12212: {{AOV{R6{R9{ALCS0{POINT PAST BLOCK
12213: {{BLO{R9{DNAME{ALCS1{JUMP IF THERE IS ROOM
12214: *
12215: * INSUFFICIENT MEMORY
12216: *
12217: {ALCS0{ZER{R9{{{ELSE CLEAR GARBAGE XR VALUE
12218: {{JSR{ALLOC{{{AND USE STANDARD ALLOCATOR
12219: {{ADD{R6{R9{{POINT PAST END OF BLOCK TO MERGE
12220: *
12221: * MERGE HERE WITH XR POINTING BEYOND NEW BLOCK
12222: *
12223: {ALCS1{MOV{R9{DNAMP{{SET UPDATED STORAGE POINTER
12224: {{ZER{-(R9){{{STORE ZERO CHARS IN LAST WORD
12225: {{DCA{R6{{{DECREMENT LENGTH
12226: {{SUB{R6{R9{{POINT BACK TO START OF BLOCK
12227: {{MOV{#B$SCL{(R9){{SET TYPE WORD
12228: {{MOV{R8{4*SCLEN(R9){{STORE LENGTH IN CHARS
12229: {{EXI{{{{RETURN TO ALOCS CALLER
12230: *
12231: * COME HERE IF STRING IS TOO LONG
12232: *
12233: {ALCS2{ERB{205{STRING{{LENGTH EXCEEDS VALUE OF MAXLNGTH KEYWORD
12234: {{ENP{{{{END PROCEDURE ALOCS
12235: {{EJC{{{{
12236: *
12237: * ALOST -- ALLOCATE SPACE IN STATIC REGION
12238: *
12239: * (WA) LENGTH REQUIRED IN BYTES
12240: * JSR ALOST CALL TO ALLOCATE SPACE
12241: * (XR) POINTER TO ALLOCATED BLOCK
12242: * (WB) DESTROYED
12243: *
12244: * NOTE THAT THE CODING ENSURES THAT THE RESULTING VALUE
12245: * OF STATE IS ALWAYS LESS THAN DNAMB. THIS FACT IS USED
12246: * IN TESTING A VARIABLE NAME FOR BEING IN THE STATIC REGION
12247: *
12248: {ALOST{PRC{E{0{{ENTRY POINT
12249: *
12250: * MERGE BACK HERE AFTER ALLOCATING NEW CHUNK
12251: *
12252: {ALST1{MOV{STATE{R9{{POINT TO CURRENT END OF AREA
12253: {{AOV{R6{R9{ALST2{POINT BEYOND PROPOSED BLOCK
12254: {{BGE{R9{DNAMB{ALST2{JUMP IF OVERLAP WITH DYNAMIC AREA
12255: {{MOV{R9{STATE{{ELSE STORE NEW POINTER
12256: {{SUB{R6{R9{{POINT BACK TO START OF BLOCK
12257: {{EXI{{{{RETURN TO ALOST CALLER
12258: *
12259: * HERE IF NO ROOM, PREPARE TO MOVE DYNAMIC STORAGE UP
12260: *
12261: {ALST2{MOV{R6{ALSTA{{SAVE WA
12262: {{BGE{R6{#4*E$STS{ALST3{SKIP IF REQUESTED CHUNK IS LARGE
12263: {{MOV{#4*E$STS{R6{{ELSE SET TO GET LARGE ENOUGH CHUNK
12264: *
12265: * HERE WITH AMOUNT TO MOVE UP IN WA
12266: *
12267: {ALST3{JSR{ALLOC{{{ALLOCATE BLOCK TO ENSURE ROOM
12268: {{MOV{R9{DNAMP{{AND DELETE IT
12269: {{MOV{R6{R7{{COPY MOVE UP AMOUNT
12270: {{JSR{GBCOL{{{CALL GBCOL TO MOVE DYNAMIC AREA UP
12271: {{MOV{ALSTA{R6{{RESTORE WA
12272: {{BRN{ALST1{{{LOOP BACK TO TRY AGAIN
12273: {{ENP{{{{END PROCEDURE ALOST
12274: {{EJC{{{{
12275: *
12276: * APNDB -- APPEND STRING TO BUFFER
12277: *
12278: * THIS ROUTINE IS USED BY BUFFER HANDLING ROUTINES TO
12279: * APPEND DATA TO AN EXISTING BFBLK.
12280: *
12281: * (XR) EXISTING BCBLK TO BE APPENDED
12282: * (XL) CONVERTABLE TO STRING
12283: * JSR APNDB CALL TO APPEND TO BUFFER
12284: * PPM LOC THREAD IF (XL) CANT BE CONVERTED
12285: * PPM LOC IF NOT ENOUGH ROOM
12286: * (WA,WB) DESTROYED
12287: *
12288: * IF MORE CHARACTERS ARE SPECIFIED THAN CAN BE INSERTED,
12289: * THEN NO ACTION IS TAKEN AND THE SECOND RETURN IS TAKEN.
12290: *
12291: {APNDB{PRC{E{2{{ENTRY POINT
12292: {{MOV{4*BCLEN(R9){R6{{LOAD OFFSET TO INSERT
12293: {{ZER{R7{{{REPLACE SECTION IS NULL
12294: {{JSR{INSBF{{{CALL TO INSERT AT END
12295: {{PPM{APN01{{{CONVERT ERROR
12296: {{PPM{APN02{{{NO ROOM
12297: {{EXI{{{{RETURN TO CALLER
12298: *
12299: * HERE TO TAKE CONVERT FAILURE EXIT
12300: *
12301: {APN01{EXI{1{{{RETURN TO CALLER ALTERNATE
12302: *
12303: * HERE FOR NO FIT EXIT
12304: *
12305: {APN02{EXI{2{{{ALTERNATE EXIT TO CALLER
12306: {{ENP{{{{END PROCEDURE APNDB
12307: {{EJC{{{{
12308: *
12309: * ARITH -- FETCH ARITHMETIC OPERANDS
12310: *
12311: * ARITH IS USED BY FUNCTIONS AND OPERATORS WHICH EXPECT
12312: * TWO NUMERIC ARGUMENTS (OPERANDS) WHICH MUST BOTH BE
12313: * INTEGER OR BOTH BE REAL. ARITH FETCHES TWO ARGUMENTS FROM
12314: * THE STACK AND PERFORMS ANY NECESSARY CONVERSIONS.
12315: *
12316: * 1(XS) FIRST ARGUMENT (LEFT OPERAND)
12317: * 0(XS) SECOND ARGUMENT (RIGHT OPERAND)
12318: * JSR ARITH CALL TO FETCH NUMERIC ARGUMENTS
12319: * PPM LOC TRANSFER LOC FOR OPND 1 NON-NUMERIC
12320: * PPM LOC TRANSFER LOC FOR OPND 2 NON-NUMERIC
12321: * PPM LOC TRANSFER LOC FOR REAL OPERANDS
12322: *
12323: * FOR INTEGER ARGS, CONTROL RETURNS PAST THE PARAMETERS
12324: *
12325: * (IA) LEFT OPERAND VALUE
12326: * (XR) PTR TO ICBLK FOR LEFT OPERAND
12327: * (XL) PTR TO ICBLK FOR RIGHT OPERAND
12328: * (XS) POPPED TWICE
12329: * (WA,WB,RA) DESTROYED
12330: *
12331: * FOR REAL ARGUMENTS, CONTROL RETURNS TO THE LOCATION
12332: * SPECIFIED BY THE THIRD PARAMETER.
12333: *
12334: * (RA) LEFT OPERAND VALUE
12335: * (XR) PTR TO RCBLK FOR LEFT OPERAND
12336: * (XL) PTR TO RCBLK FOR RIGHT OPERAND
12337: * (WA,WB,WC) DESTROYED
12338: * (XS) POPPED TWICE
12339: {{EJC{{{{
12340: *
12341: * ARITH (CONTINUED)
12342: *
12343: * ENTRY POINT
12344: *
12345: {ARITH{PRC{N{3{{ENTRY POINT
12346: {{MOV{(SP)+{R10{{LOAD RIGHT OPERAND
12347: {{MOV{(SP)+{R9{{LOAD LEFT OPERAND
12348: {{MOV{(R10){R6{{GET RIGHT OPERAND TYPE WORD
12349: {{BEQ{R6{#B$ICL{ARTH1{JUMP IF INTEGER
12350: {{BEQ{R6{#B$RCL{ARTH4{JUMP IF REAL
12351: {{MOV{R9{-(SP){{ELSE REPLACE LEFT ARG ON STACK
12352: {{MOV{R10{R9{{COPY LEFT ARG POINTER
12353: {{JSR{GTNUM{{{CONVERT TO NUMERIC
12354: {{PPM{ARTH6{{{JUMP IF UNCONVERTIBLE
12355: {{MOV{R9{R10{{ELSE COPY CONVERTED RESULT
12356: {{MOV{(R10){R6{{GET RIGHT OPERAND TYPE WORD
12357: {{MOV{(SP)+{R9{{RELOAD LEFT ARGUMENT
12358: {{BEQ{R6{#B$RCL{ARTH4{JUMP IF RIGHT ARG IS REAL
12359: *
12360: * HERE IF RIGHT ARG IS AN INTEGER
12361: *
12362: {ARTH1{BNE{(R9){#B$ICL{ARTH3{JUMP IF LEFT ARG NOT INTEGER
12363: *
12364: * EXIT FOR INTEGER CASE
12365: *
12366: {ARTH2{LDI{4*ICVAL(R9){{{LOAD LEFT OPERAND VALUE
12367: {{EXI{{{{RETURN TO ARITH CALLER
12368: *
12369: * HERE FOR RIGHT OPERAND INTEGER, LEFT OPERAND NOT
12370: *
12371: {ARTH3{JSR{GTNUM{{{CONVERT LEFT ARG TO NUMERIC
12372: {{PPM{ARTH7{{{JUMP IF NOT CONVERTIBLE
12373: {{BEQ{R6{#B$ICL{ARTH2{JUMP BACK IF INTEGER-INTEGER
12374: *
12375: * HERE WE MUST CONVERT REAL-INTEGER TO REAL-REAL
12376: *
12377: {{MOV{R9{-(SP){{PUT LEFT ARG BACK ON STACK
12378: {{LDI{4*ICVAL(R10){{{LOAD RIGHT ARGUMENT VALUE
12379: {{ITR{{{{CONVERT TO REAL
12380: {{JSR{RCBLD{{{GET REAL BLOCK FOR RIGHT ARG, MERGE
12381: {{MOV{R9{R10{{COPY RIGHT ARG PTR
12382: {{MOV{(SP)+{R9{{LOAD LEFT ARGUMENT
12383: {{BRN{ARTH5{{{MERGE FOR REAL-REAL CASE
12384: {{EJC{{{{
12385: *
12386: * ARITH (CONTINUED)
12387: *
12388: * HERE IF RIGHT ARGUMENT IS REAL
12389: *
12390: {ARTH4{BEQ{(R9){#B$RCL{ARTH5{JUMP IF LEFT ARG REAL
12391: {{JSR{GTREA{{{ELSE CONVERT TO REAL
12392: {{PPM{ARTH7{{{ERROR IF UNCONVERTIBLE
12393: *
12394: * HERE FOR REAL-REAL
12395: *
12396: {ARTH5{LDR{4*RCVAL(R9){{{LOAD LEFT OPERAND VALUE
12397: {{EXI{3{{{TAKE REAL-REAL EXIT
12398: *
12399: * HERE FOR ERROR CONVERTING RIGHT ARGUMENT
12400: *
12401: {ARTH6{ICA{SP{{{POP UNWANTED LEFT ARG
12402: {{EXI{2{{{TAKE APPROPRIATE ERROR EXIT
12403: *
12404: * HERE FOR ERROR CONVERTING LEFT OPERAND
12405: *
12406: {ARTH7{EXI{1{{{TAKE APPROPRIATE ERROR RETURN
12407: {{ENP{{{{END PROCEDURE ARITH
12408: {{EJC{{{{
12409: *
12410: * ASIGN -- PERFORM ASSIGNMENT
12411: *
12412: * ASIGN PERFORMS THE ASSIGNMENT OF A VALUE TO A VARIABLE
12413: * WITH APPROPRIATE CHECKS FOR OUTPUT ASSOCIATIONS AND
12414: * VALUE TRACE ASSOCIATIONS WHICH ARE EXECUTED AS REQUIRED.
12415: * ASIGN ALSO HANDLES THE SPECIAL CASES OF ASSIGNMENT TO
12416: * PATTERN AND EXPRESSION VARIABLES.
12417: *
12418: * (WB) VALUE TO BE ASSIGNED
12419: * (XL) BASE POINTER FOR VARIABLE
12420: * (WA) OFFSET FOR VARIABLE
12421: * JSR ASIGN CALL TO ASSIGN VALUE TO VARIABLE
12422: * PPM LOC TRANSFER LOC FOR FAILURE
12423: * (XR,XL,WA,WB,WC) DESTROYED
12424: * (RA) DESTROYED
12425: *
12426: * FAILURE OCCURS IF THE EVALUATION OF AN EXPRESSION
12427: * ASSOCIATED WITH AN EXPRESSION VARIABLE FAILS.
12428: *
12429: {ASIGN{PRC{R{1{{ENTRY POINT (RECURSIVE)
12430: *
12431: * MERGE BACK HERE TO ASSIGN RESULT TO EXPRESSION VARIABLE.
12432: *
12433: {ASG01{ADD{R6{R10{{POINT TO VARIABLE VALUE
12434: {{MOV{(R10){R9{{LOAD VARIABLE VALUE
12435: {{BEQ{(R9){#B$TRT{ASG02{JUMP IF TRAPPED
12436: {{MOV{R7{(R10){{ELSE PERFORM ASSIGNMENT
12437: {{ZER{R10{{{CLEAR GARBAGE VALUE IN XL
12438: {{EXI{{{{AND RETURN TO ASIGN CALLER
12439: *
12440: * HERE IF VALUE IS TRAPPED
12441: *
12442: {ASG02{SUB{R6{R10{{RESTORE NAME BASE
12443: {{BEQ{R9{#TRBKV{ASG14{JUMP IF KEYWORD VARIABLE
12444: {{BNE{R9{#TRBEV{ASG04{JUMP IF NOT EXPRESSION VARIABLE
12445: *
12446: * HERE FOR ASSIGNMENT TO EXPRESSION VARIABLE
12447: *
12448: {{MOV{4*EVEXP(R10){R9{{POINT TO EXPRESSION
12449: {{MOV{R7{-(SP){{STORE VALUE TO ASSIGN ON STACK
12450: {{MOV{#NUM01{R7{{SET FOR EVALUATION BY NAME
12451: {{JSR{EVALX{{{EVALUATE EXPRESSION BY NAME
12452: {{PPM{ASG03{{{JUMP IF EVALUATION FAILS
12453: {{MOV{(SP)+{R7{{ELSE RELOAD VALUE TO ASSIGN
12454: {{BRN{ASG01{{{LOOP BACK TO PERFORM ASSIGNMENT
12455: {{EJC{{{{
12456: *
12457: * ASIGN (CONTINUED)
12458: *
12459: * HERE FOR FAILURE DURING EXPRESSION EVALUATION
12460: *
12461: {ASG03{ICA{SP{{{REMOVE STACKED VALUE ENTRY
12462: {{EXI{1{{{TAKE FAILURE EXIT
12463: *
12464: * HERE IF NOT KEYWORD OR EXPRESSION VARIABLE
12465: *
12466: {ASG04{MOV{R9{-(SP){{SAVE PTR TO FIRST TRBLK
12467: *
12468: * LOOP TO CHASE DOWN TRBLK CHAIN AND ASSIGN VALUE AT END
12469: *
12470: {ASG05{MOV{R9{R8{{SAVE PTR TO THIS TRBLK
12471: {{MOV{4*TRNXT(R9){R9{{POINT TO NEXT TRBLK
12472: {{BEQ{(R9){#B$TRT{ASG05{LOOP BACK IF ANOTHER TRBLK
12473: {{MOV{R8{R9{{ELSE POINT BACK TO LAST TRBLK
12474: {{MOV{R7{4*TRVAL(R9){{STORE VALUE AT END OF CHAIN
12475: {{MOV{(SP)+{R9{{RESTORE PTR TO FIRST TRBLK
12476: *
12477: * LOOP TO PROCESS TRBLK ENTRIES ON CHAIN
12478: *
12479: {ASG06{MOV{4*TRTYP(R9){R7{{LOAD TYPE CODE OF TRBLK
12480: {{BEQ{R7{#TRTVL{ASG08{JUMP IF VALUE TRACE
12481: {{BEQ{R7{#TRTOU{ASG10{JUMP IF OUTPUT ASSOCIATION
12482: *
12483: * HERE TO MOVE TO NEXT TRBLK ON CHAIN
12484: *
12485: {ASG07{MOV{4*TRNXT(R9){R9{{POINT TO NEXT TRBLK ON CHAIN
12486: {{BEQ{(R9){#B$TRT{ASG06{LOOP BACK IF ANOTHER TRBLK
12487: {{EXI{{{{ELSE END OF CHAIN, RETURN TO CALLER
12488: *
12489: * HERE TO PROCESS VALUE TRACE
12490: *
12491: {ASG08{BZE{KVTRA{ASG07{{IGNORE VALUE TRACE IF TRACE OFF
12492: {{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT
12493: {{BZE{4*TRFNC(R9){ASG09{{JUMP IF PRINT TRACE
12494: {{JSR{TRXEQ{{{ELSE EXECUTE FUNCTION TRACE
12495: {{BRN{ASG07{{{AND LOOP BACK
12496: {{EJC{{{{
12497: *
12498: * ASIGN (CONTINUED)
12499: *
12500: * HERE FOR PRINT TRACE
12501: *
12502: {ASG09{JSR{PRTSN{{{PRINT STATEMENT NUMBER
12503: {{JSR{PRTNV{{{PRINT NAME = VALUE
12504: {{BRN{ASG07{{{LOOP BACK FOR NEXT TRBLK
12505: *
12506: * HERE FOR OUTPUT ASSOCIATION
12507: *
12508: {ASG10{BZE{KVOUP{ASG07{{IGNORE OUTPUT ASSOC IF OUTPUT OFF
12509: {{MOV{R9{R10{{ELSE COPY TRBLK POINTER
12510: {{MOV{4*TRVAL(R8){-(SP){{STACK VALUE TO OUTPUT (SGD01)
12511: {{JSR{GTSTG{{{CONVERT TO STRING
12512: {{PPM{ASG12{{{GET DATATYPE NAME IF UNCONVERTIBLE
12513: *
12514: * MERGE WITH STRING FOR OUTPUT
12515: *
12516: {ASG11{MOV{4*TRFPT(R10){R6{{FCBLK PTR
12517: {{BZE{R6{ASG13{{JUMP IF STANDARD OUTPUT FILE
12518: *
12519: * HERE FOR OUTPUT TO NON-STANDARD OUTPUT FILE
12520: *
12521: {{JSR{SYSOU{{{CALL SYSTEM OUTPUT ROUTINE
12522: {{ERR{206{OUTPUT{{CAUSED FILE OVERFLOW
12523: {{ERR{207{OUTPUT{{CAUSED NON-RECOVERABLE ERROR
12524: {{EXI{{{{ELSE ALL DONE, RETURN TO CALLER
12525: *
12526: * IF NOT PRINTABLE, GET DATATYPE NAME INSTEAD
12527: *
12528: {ASG12{JSR{DTYPE{{{CALL DATATYPE ROUTINE
12529: {{BRN{ASG11{{{MERGE
12530: *
12531: * HERE TO PRINT A STRING ON THE PRINTER
12532: *
12533: {ASG13{JSR{PRTST{{{PRINT STRING VALUE
12534: {{BEQ{4*TRTER(R10){#V$TER{ASG20{JUMP IF TERMINAL OUTPUT
12535: {{JSR{PRTNL{{{END OF LINE
12536: {{EXI{{{{RETURN TO CALLER
12537: {{EJC{{{{
12538: *
12539: * ASIGN (CONTINUED)
12540: *
12541: * HERE FOR KEYWORD ASSIGNMENT
12542: *
12543: {ASG14{MOV{4*KVNUM(R10){R10{{LOAD KEYWORD NUMBER
12544: {{BEQ{R10{#K$ETX{ASG19{JUMP IF ERRTEXT
12545: {{MOV{R7{R9{{COPY VALUE TO BE ASSIGNED
12546: {{JSR{GTINT{{{CONVERT TO INTEGER
12547: {{ERR{208{KEYWORD{{VALUE ASSIGNED IS NOT INTEGER
12548: {{LDI{4*ICVAL(R9){{{ELSE LOAD VALUE
12549: {{BEQ{R10{#K$STL{ASG16{JUMP IF SPECIAL CASE OF STLIMIT
12550: {{MFI{R6{ASG18{{ELSE GET ADDR INTEGER, TEST OVFLOW
12551: {{BGE{R6{MXLEN{ASG18{FAIL IF TOO LARGE
12552: {{BEQ{R10{#K$ERT{ASG17{JUMP IF SPECIAL CASE OF ERRTYPE
12553: {{BEQ{R10{#K$PFL{ASG21{JUMP IF SPECIAL CASE OF PROFILE
12554: {{BLT{R10{#K$P$${ASG15{JUMP UNLESS PROTECTED
12555: {{ERB{209{KEYWORD{{IN ASSIGNMENT IS PROTECTED
12556: *
12557: * HERE TO DO ASSIGNMENT IF NOT PROTECTED
12558: *
12559: {ASG15{MOV{R6{L^KVABE(R10){{STORE NEW VALUE
12560: {{EXI{{{{RETURN TO ASIGN CALLER
12561: *
12562: * HERE FOR SPECIAL CASE OF STLIMIT
12563: *
12564: * SINCE STCOUNT IS MAINTAINED AS (STLIMIT-STCOUNT)
12565: * IT IS ALSO NECESSARY TO MODIFY STCOUNT APPROPRIATELY.
12566: *
12567: {ASG16{SBI{KVSTL{{{SUBTRACT OLD LIMIT
12568: {{ADI{KVSTC{{{ADD OLD COUNTER
12569: {{STI{KVSTC{{{STORE NEW COUNTER VALUE
12570: {{LDI{4*ICVAL(R9){{{RELOAD NEW LIMIT VALUE
12571: {{STI{KVSTL{{{STORE NEW LIMIT VALUE
12572: {{EXI{{{{RETURN TO ASIGN CALLER
12573: *
12574: * HERE FOR SPECIAL CASE OF ERRTYPE
12575: *
12576: {ASG17{BLE{R6{#NINI9{ERROR{OK TO SIGNAL IF IN RANGE
12577: *
12578: * HERE IF VALUE ASSIGNED IS OUT OF RANGE
12579: *
12580: {ASG18{ERB{210{KEYWORD{{VALUE ASSIGNED IS NEGATIVE OR TOO LARGE
12581: *
12582: * HERE FOR SPECIAL CASE OF ERRTEXT
12583: *
12584: {ASG19{MOV{R7{-(SP){{STACK VALUE
12585: {{JSR{GTSTG{{{CONVERT TO STRING
12586: {{ERR{211{VALUE{{ASSIGNED TO KEYWORD ERRTEXT NOT A STRING
12587: {{MOV{R9{R$ETX{{MAKE ASSIGNMENT
12588: {{EXI{{{{RETURN TO CALLER
12589: *
12590: * PRINT STRING TO TERMINAL
12591: *
12592: {ASG20{JSR{PRTTR{{{PRINT
12593: {{EXI{{{{RETURN
12594: *
12595: * HERE FOR KEYWORD PROFILE
12596: *
12597: {ASG21{BGT{R6{#NUM02{ASG18{MOAN IF NOT 0,1, OR 2
12598: {{BZE{R6{ASG15{{JUST ASSIGN IF ZERO
12599: {{BZE{PFDMP{ASG22{{BRANCH IF FIRST ASSIGNMENT
12600: {{BEQ{R6{PFDMP{ASG23{ALSO IF SAME VALUE AS BEFORE
12601: {{ERB{268{INCONSISTENT{{VALUE ASSIGNED TO KEYWORD PROFILE
12602: *
12603: {ASG22{MOV{R6{PFDMP{{NOTE VALUE ON FIRST ASSIGNMENT
12604: {ASG23{JSR{SYSTM{{{GET THE TIME
12605: {{STI{PFSTM{{{FUDGE SOME KIND OF START TIME
12606: {{BRN{ASG15{{{AND GO ASSIGN
12607: {{ENP{{{{END PROCEDURE ASIGN
12608: {{EJC{{{{
12609: *
12610: * ASINP -- ASSIGN DURING PATTERN MATCH
12611: *
12612: * ASINP IS LIKE ASIGN AND HAS A SIMILAR CALLING SEQUENCE
12613: * AND EFFECT. THE DIFFERENCE IS THAT THE GLOBAL PATTERN
12614: * VARIABLES ARE SAVED AND RESTORED IF REQUIRED.
12615: *
12616: * (XL) BASE POINTER FOR VARIABLE
12617: * (WA) OFFSET FOR VARIABLE
12618: * (WB) VALUE TO BE ASSIGNED
12619: * JSR ASINP CALL TO ASSIGN VALUE TO VARIABLE
12620: * PPM LOC TRANSFER LOC IF FAILURE
12621: * (XR,XL) DESTROYED
12622: * (WA,WB,WC,RA) DESTROYED
12623: *
12624: {ASINP{PRC{R{1{{ENTRY POINT, RECURSIVE
12625: {{ADD{R6{R10{{POINT TO VARIABLE
12626: {{MOV{(R10){R9{{LOAD CURRENT CONTENTS
12627: {{BEQ{(R9){#B$TRT{ASNP1{JUMP IF TRAPPED
12628: {{MOV{R7{(R10){{ELSE PERFORM ASSIGNMENT
12629: {{ZER{R10{{{CLEAR GARBAGE VALUE IN XL
12630: {{EXI{{{{RETURN TO ASINP CALLER
12631: *
12632: * HERE IF VARIABLE IS TRAPPED
12633: *
12634: {ASNP1{SUB{R6{R10{{RESTORE BASE POINTER
12635: {{MOV{PMSSL{-(SP){{STACK SUBJECT STRING LENGTH
12636: {{MOV{PMHBS{-(SP){{STACK HISTORY STACK BASE PTR
12637: {{MOV{R$PMS{-(SP){{STACK SUBJECT STRING POINTER
12638: {{MOV{PMDFL{-(SP){{STACK DOT FLAG
12639: {{JSR{ASIGN{{{CALL FULL-BLOWN ASSIGNMENT ROUTINE
12640: {{PPM{ASNP2{{{JUMP IF FAILURE
12641: {{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG
12642: {{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER
12643: {{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER
12644: {{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH
12645: {{EXI{{{{RETURN TO ASINP CALLER
12646: *
12647: * HERE IF FAILURE IN ASIGN CALL
12648: *
12649: {ASNP2{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG
12650: {{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER
12651: {{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER
12652: {{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH
12653: {{EXI{1{{{TAKE FAILURE EXIT
12654: {{ENP{{{{END PROCEDURE ASINP
12655: {{EJC{{{{
12656: *
12657: * BLKLN -- DETERMINE LENGTH OF BLOCK
12658: *
12659: * BLKLN DETERMINES THE LENGTH OF A BLOCK IN DYNAMIC STORE.
12660: *
12661: * (WA) FIRST WORD OF BLOCK
12662: * (XR) POINTER TO BLOCK
12663: * JSR BLKLN CALL TO GET BLOCK LENGTH
12664: * (WA) LENGTH OF BLOCK IN BYTES
12665: * (XL) DESTROYED
12666: *
12667: * BLKLN IS USED BY THE GARBAGE COLLECTOR AND IS NOT
12668: * PERMITTED TO CALL GBCOL DIRECTLY OR INDIRECTLY.
12669: *
12670: * THE FIRST WORD STORED IN THE BLOCK (I.E. AT XR) MAY
12671: * BE ANYTHING, BUT THE CONTENTS OF WA MUST BE CORRECT.
12672: *
12673: {BLKLN{PRC{E{0{{ENTRY POINT
12674: {{MOV{R6{R10{{COPY FIRST WORD
12675: {{LEI{R10{{{GET ENTRY ID (BL$XX)
12676: {{BSW{R10{BL$$${BLN00{SWITCH ON BLOCK TYPE
12677: {{IFF{BL$AR{BLN01{{ARBLK
12678: {{IFF{BL$BC{BLN04{{BCBLK
12679: {{IFF{BL$CD{BLN01{{CDBLK
12680: {{IFF{BL$EX{BLN01{{EXBLK
12681: {{IFF{BL$IC{BLN07{{ICBLK
12682: {{IFF{BL$NM{BLN03{{NMBLK
12683: {{IFF{BL$P0{BLN02{{P0BLK
12684: {{IFF{BL$P1{BLN03{{P1BLK
12685: {{IFF{BL$P2{BLN04{{P2BLK
12686: {{IFF{BL$RC{BLN09{{RCBLK
12687: {{IFF{BL$SC{BLN10{{SCBLK
12688: {{IFF{BL$SE{BLN02{{SEBLK
12689: {{IFF{BL$TB{BLN01{{TBBLK
12690: {{IFF{BL$VC{BLN01{{VCBLK
12691: {{IFF{DUMMY{BLN00{{
12692: {{IFF{DUMMY{BLN00{{
12693: {{IFF{BL$PD{BLN08{{PDBLK
12694: {{IFF{BL$TR{BLN05{{TRBLK
12695: {{IFF{BL$BF{BLN11{{BFBLK
12696: {{IFF{DUMMY{BLN00{{
12697: {{IFF{DUMMY{BLN00{{
12698: {{IFF{BL$CT{BLN06{{CTBLK
12699: {{IFF{BL$DF{BLN01{{DFBLK
12700: {{IFF{BL$EF{BLN01{{EFBLK
12701: {{IFF{BL$EV{BLN03{{EVBLK
12702: {{IFF{BL$FF{BLN05{{FFBLK
12703: {{IFF{BL$KV{BLN03{{KVBLK
12704: {{IFF{BL$PF{BLN01{{PFBLK
12705: {{IFF{BL$TE{BLN04{{TEBLK
12706: {{ESW{{{{END OF JUMP TABLE ON BLOCK TYPE
12707: {{EJC{{{{
12708: *
12709: * BLKLN (CONTINUED)
12710: *
12711: * HERE FOR BLOCKS WITH LENGTH IN SECOND WORD
12712: *
12713: {BLN00{MOV{4*1(R9){R6{{LOAD LENGTH
12714: {{EXI{{{{RETURN TO BLKLN CALLER
12715: *
12716: * HERE FOR LENGTH IN THIRD WORD (AR,CD,DF,EF,EX,PF,TB,VC)
12717: *
12718: {BLN01{MOV{4*2(R9){R6{{LOAD LENGTH FROM THIRD WORD
12719: {{EXI{{{{RETURN TO BLKLN CALLER
12720: *
12721: * HERE FOR TWO WORD BLOCKS (P0,SE)
12722: *
12723: {BLN02{MOV{#4*NUM02{R6{{LOAD LENGTH (TWO WORDS)
12724: {{EXI{{{{RETURN TO BLKLN CALLER
12725: *
12726: * HERE FOR THREE WORD BLOCKS (NM,P1,EV,KV)
12727: *
12728: {BLN03{MOV{#4*NUM03{R6{{LOAD LENGTH (THREE WORDS)
12729: {{EXI{{{{RETURN TO BLKLN CALLER
12730: *
12731: * HERE FOR FOUR WORD BLOCKS (P2,TE,BC)
12732: *
12733: {BLN04{MOV{#4*NUM04{R6{{LOAD LENGTH (FOUR WORDS)
12734: {{EXI{{{{RETURN TO BLKLN CALLER
12735: *
12736: * HERE FOR FIVE WORD BLOCKS (FF,TR)
12737: *
12738: {BLN05{MOV{#4*NUM05{R6{{LOAD LENGTH
12739: {{EXI{{{{RETURN TO BLKLN CALLER
12740: {{EJC{{{{
12741: *
12742: * BLKLN (CONTINUED)
12743: *
12744: * HERE FOR CTBLK
12745: *
12746: {BLN06{MOV{#4*CTSI${R6{{SET SIZE OF CTBLK
12747: {{EXI{{{{RETURN TO BLKLN CALLER
12748: *
12749: * HERE FOR ICBLK
12750: *
12751: {BLN07{MOV{#4*ICSI${R6{{SET SIZE OF ICBLK
12752: {{EXI{{{{RETURN TO BLKLN CALLER
12753: *
12754: * HERE FOR PDBLK
12755: *
12756: {BLN08{MOV{4*PDDFP(R9){R10{{POINT TO DFBLK
12757: {{MOV{4*DFPDL(R10){R6{{LOAD PDBLK LENGTH FROM DFBLK
12758: {{EXI{{{{RETURN TO BLKLN CALLER
12759: *
12760: * HERE FOR RCBLK
12761: *
12762: {BLN09{MOV{#4*RCSI${R6{{SET SIZE OF RCBLK
12763: {{EXI{{{{RETURN TO BLKLN CALLER
12764: *
12765: * HERE FOR SCBLK
12766: *
12767: {BLN10{MOV{4*SCLEN(R9){R6{{LOAD LENGTH IN CHARACTERS
12768: {{CTB{R6{SCSI${{CALCULATE LENGTH IN BYTES
12769: {{EXI{{{{RETURN TO BLKLN CALLER
12770: *
12771: * HERE FOR BFBLK
12772: *
12773: {BLN11{MOV{4*BFALC(R9){R6{{GET ALLOCATION IN BYTES
12774: {{CTB{R6{BFSI${{CALCULATE LENGTH IN BYTES
12775: {{EXI{{{{RETURN TO BLKLN CALLER
12776: {{ENP{{{{END PROCEDURE BLKLN
12777: {{EJC{{{{
12778: *
12779: * COPYB -- COPY A BLOCK
12780: *
12781: * (XS) BLOCK TO BE COPIED
12782: * JSR COPYB CALL TO COPY BLOCK
12783: * PPM LOC RETURN IF BLOCK HAS NO IDVAL FIELD
12784: * NORMAL RETURN IF IDVAL FIELD
12785: * (XR) COPY OF BLOCK
12786: * (XS) POPPED
12787: * (XL,WA,WB,WC) DESTROYED
12788: *
12789: {COPYB{PRC{N{1{{ENTRY POINT
12790: {{MOV{(SP){R9{{LOAD ARGUMENT
12791: {{BEQ{R9{#NULLS{COP10{RETURN ARGUMENT IF IT IS NULL
12792: {{MOV{(R9){R6{{ELSE LOAD TYPE WORD
12793: {{MOV{R6{R7{{COPY TYPE WORD
12794: {{JSR{BLKLN{{{GET LENGTH OF ARGUMENT BLOCK
12795: {{MOV{R9{R10{{COPY POINTER
12796: {{JSR{ALLOC{{{ALLOCATE BLOCK OF SAME SIZE
12797: {{MOV{R9{(SP){{STORE POINTER TO COPY
12798: {{MVW{{{{COPY CONTENTS OF OLD BLOCK TO NEW
12799: {{MOV{(SP){R9{{RELOAD POINTER TO START OF COPY
12800: {{BEQ{R7{#B$TBT{COP05{JUMP IF TABLE
12801: {{BEQ{R7{#B$VCT{COP01{JUMP IF VECTOR
12802: {{BEQ{R7{#B$PDT{COP01{JUMP IF PROGRAM DEFINED
12803: {{BEQ{R7{#B$BCT{COP11{JUMP IF BUFFER
12804: {{BNE{R7{#B$ART{COP10{RETURN COPY IF NOT ARRAY
12805: *
12806: * HERE FOR ARRAY (ARBLK)
12807: *
12808: {{ADD{4*AROFS(R9){R9{{POINT TO PROTOTYPE FIELD
12809: {{BRN{COP02{{{JUMP TO MERGE
12810: *
12811: * HERE FOR VECTOR, PROGRAM DEFINED
12812: *
12813: {COP01{ADD{#4*PDFLD{R9{{POINT TO PDFLD = VCVLS
12814: *
12815: * MERGE HERE FOR ARBLK, VCBLK, PDBLK TO DELETE TRAP
12816: * BLOCKS FROM ALL VALUE FIELDS (THE COPY IS UNTRAPPED)
12817: *
12818: {COP02{MOV{(R9){R10{{LOAD NEXT POINTER
12819: *
12820: * LOOP TO GET VALUE AT END OF TRBLK CHAIN
12821: *
12822: {COP03{BNE{(R10){#B$TRT{COP04{JUMP IF NOT TRAPPED
12823: {{MOV{4*TRVAL(R10){R10{{ELSE POINT TO NEXT VALUE
12824: {{BRN{COP03{{{AND LOOP BACK
12825: {{EJC{{{{
12826: *
12827: * COPYB (CONTINUED)
12828: *
12829: * HERE WITH UNTRAPPED VALUE IN XL
12830: *
12831: {COP04{MOV{R10{(R9)+{{STORE REAL VALUE, BUMP POINTER
12832: {{BNE{R9{DNAMP{COP02{LOOP BACK IF MORE TO GO
12833: {{BRN{COP09{{{ELSE JUMP TO EXIT
12834: *
12835: * HERE TO COPY A TABLE
12836: *
12837: {COP05{ZER{4*IDVAL(R9){{{ZERO ID TO STOP DUMP BLOWING UP
12838: {{MOV{#4*TESI${R6{{SET SIZE OF TEBLK
12839: {{MOV{#4*TBBUK{R8{{SET INITIAL OFFSET
12840: *
12841: * LOOP THROUGH BUCKETS IN TABLE
12842: *
12843: {COP06{MOV{(SP){R9{{LOAD TABLE POINTER
12844: {{BEQ{R8{4*TBLEN(R9){COP09{JUMP TO EXIT IF ALL DONE
12845: {{ADD{R8{R9{{ELSE POINT TO NEXT BUCKET HEADER
12846: {{ICA{R8{{{BUMP OFFSET
12847: {{SUB{#4*TENXT{R9{{SUBTRACT LINK OFFSET TO MERGE
12848: *
12849: * LOOP THROUGH TEBLKS ON ONE CHAIN
12850: *
12851: {COP07{MOV{4*TENXT(R9){R10{{LOAD POINTER TO NEXT TEBLK
12852: {{MOV{(SP){4*TENXT(R9){{SET END OF CHAIN POINTER IN CASE
12853: {{BEQ{(R10){#B$TBT{COP06{BACK FOR NEXT BUCKET IF CHAIN END
12854: {{MOV{R9{-(SP){{ELSE STACK PTR TO PREVIOUS BLOCK
12855: {{MOV{#4*TESI${R6{{SET SIZE OF TEBLK
12856: {{JSR{ALLOC{{{ALLOCATE NEW TEBLK
12857: {{MOV{R9{R7{{SAVE PTR TO NEW TEBLK
12858: {{MVW{{{{COPY OLD TEBLK TO NEW TEBLK
12859: {{MOV{R7{R9{{RESTORE POINTER TO NEW TEBLK
12860: {{MOV{(SP)+{R10{{RESTORE POINTER TO PREVIOUS BLOCK
12861: {{MOV{R9{4*TENXT(R10){{LINK NEW BLOCK TO PREVIOUS
12862: {{MOV{R9{R10{{COPY POINTER TO NEW BLOCK
12863: *
12864: * LOOP TO SET REAL VALUE AFTER REMOVING TRAP CHAIN
12865: *
12866: {COP08{MOV{4*TEVAL(R10){R10{{LOAD VALUE
12867: {{BEQ{(R10){#B$TRT{COP08{LOOP BACK IF TRAPPED
12868: {{MOV{R10{4*TEVAL(R9){{STORE UNTRAPPED VALUE IN TEBLK
12869: {{BRN{COP07{{{BACK FOR NEXT TEBLK
12870: *
12871: * COMMON EXIT POINT
12872: *
12873: {COP09{MOV{(SP)+{R9{{LOAD POINTER TO BLOCK
12874: {{EXI{{{{RETURN
12875: *
12876: * ALTERNATIVE RETURN
12877: *
12878: {COP10{EXI{1{{{RETURN
12879: {{EJC{{{{
12880: *
12881: * HERE TO COPY BUFFER
12882: *
12883: {COP11{MOV{4*BCBUF(R9){R10{{GET BFBLK PTR
12884: {{MOV{4*BFALC(R10){R6{{GET ALLOCATION
12885: {{CTB{R6{BFSI${{SET TOTAL SIZE
12886: {{MOV{R9{R10{{SAVE BCBLK PTR
12887: {{JSR{ALLOC{{{ALLOCATE BFBLK
12888: {{MOV{4*BCBUF(R10){R7{{GET OLD BFBLK
12889: {{MOV{R9{4*BCBUF(R10){{SET POINTER TO NEW BFBLK
12890: {{MOV{R7{R10{{POINT TO OLD BFBLK
12891: {{MVW{{{{COPY BFBLK TOO
12892: {{ZER{R10{{{CLEAR RUBBISH PTR
12893: {{BRN{COP09{{{BRANCH TO EXIT
12894: {{ENP{{{{END PROCEDURE COPYB
12895: *
12896: * CDGCG -- GENERATE CODE FOR COMPLEX GOTO
12897: *
12898: * USED BY CMPIL TO PROCESS COMPLEX GOTO TREE
12899: *
12900: * (WB) MUST BE COLLECTABLE
12901: * (XR) EXPRESSION POINTER
12902: * JSR CDGCG CALL TO GENERATE COMPLEX GOTO
12903: * (XL,XR,WA) DESTROYED
12904: *
12905: {CDGCG{PRC{E{0{{ENTRY POINT
12906: {{MOV{4*CMOPN(R9){R10{{GET UNARY GOTO OPERATOR
12907: {{MOV{4*CMROP(R9){R9{{POINT TO GOTO OPERAND
12908: {{BEQ{R10{#OPDVD{CDGC2{JUMP IF DIRECT GOTO
12909: {{JSR{CDGNM{{{GENERATE OPND BY NAME IF NOT DIRECT
12910: *
12911: * RETURN POINT
12912: *
12913: {CDGC1{MOV{R10{R6{{GOTO OPERATOR
12914: {{JSR{CDWRD{{{GENERATE IT
12915: {{EXI{{{{RETURN TO CALLER
12916: *
12917: * DIRECT GOTO
12918: *
12919: {CDGC2{JSR{CDGVL{{{GENERATE OPERAND BY VALUE
12920: {{BRN{CDGC1{{{MERGE TO RETURN
12921: {{ENP{{{{END PROCEDURE CDGCG
12922: {{EJC{{{{
12923: *
12924: * CDGEX -- BUILD EXPRESSION BLOCK
12925: *
12926: * CDGEX IS PASSED A POINTER TO AN EXPRESSION TREE (SEE
12927: * EXPAN) AND RETURNS AN EXPRESSION (SEBLK OR EXBLK).
12928: *
12929: * (WC) SOME COLLECTABLE VALUE
12930: * (WB) INTEGER IN RANGE 0 LE X LE MXLEN
12931: * (XL) PTR TO EXPRESSION TREE
12932: * JSR CDGEX CALL TO BUILD EXPRESSION
12933: * (XR) PTR TO SEBLK OR EXBLK
12934: * (XL,WA,WB) DESTROYED
12935: *
12936: {CDGEX{PRC{R{0{{ENTRY POINT, RECURSIVE
12937: {{BLO{(R10){#B$VR${CDGX1{JUMP IF NOT VARIABLE
12938: *
12939: * HERE FOR NATURAL VARIABLE, BUILD SEBLK
12940: *
12941: {{MOV{#4*SESI${R6{{SET SIZE OF SEBLK
12942: {{JSR{ALLOC{{{ALLOCATE SPACE FOR SEBLK
12943: {{MOV{#B$SEL{(R9){{SET TYPE WORD
12944: {{MOV{R10{4*SEVAR(R9){{STORE VRBLK POINTER
12945: {{EXI{{{{RETURN TO CDGEX CALLER
12946: *
12947: * HERE IF NOT VARIABLE, BUILD EXBLK
12948: *
12949: {CDGX1{MOV{R10{R9{{COPY TREE POINTER
12950: {{MOV{R8{-(SP){{SAVE WC
12951: {{MOV{CWCOF{R10{{SAVE CURRENT OFFSET
12952: {{MOV{(R9){R6{{GET TYPE WORD
12953: {{BNE{R6{#B$CMT{CDGX2{CALL BY VALUE IF NOT CMBLK
12954: {{BGE{4*CMTYP(R9){#C$$NM{CDGX2{JUMP IF CMBLK ONLY BY VALUE
12955: {{EJC{{{{
12956: *
12957: * CDGEX (CONTINUED)
12958: *
12959: * HERE IF EXPRESSION CAN BE EVALUATED BY NAME
12960: *
12961: {{JSR{CDGNM{{{GENERATE CODE BY NAME
12962: {{MOV{#ORNM${R6{{LOAD RETURN BY NAME WORD
12963: {{BRN{CDGX3{{{MERGE WITH VALUE CASE
12964: *
12965: * HERE IF EXPRESSION CAN ONLY BE EVALUATED BY VALUE
12966: *
12967: {CDGX2{JSR{CDGVL{{{GENERATE CODE BY VALUE
12968: {{MOV{#ORVL${R6{{LOAD RETURN BY VALUE WORD
12969: *
12970: * MERGE HERE TO CONSTRUCT EXBLK
12971: *
12972: {CDGX3{JSR{CDWRD{{{GENERATE RETURN WORD
12973: {{JSR{EXBLD{{{BUILD EXBLK
12974: {{MOV{(SP)+{R8{{RESTORE WC
12975: {{EXI{{{{RETURN TO CDGEX CALLER
12976: {{ENP{{{{END PROCEDURE CDGEX
12977: {{EJC{{{{
12978: *
12979: * CDGNM -- GENERATE CODE BY NAME
12980: *
12981: * CDGNM IS CALLED DURING THE COMPILATION PROCESS TO
12982: * GENERATE CODE BY NAME FOR AN EXPRESSION. SEE CDBLK
12983: * DESCRIPTION FOR DETAILS OF CODE GENERATED. THE INPUT
12984: * TO CDGNM IS AN EXPRESSION TREE AS GENERATED BY EXPAN.
12985: *
12986: * CDGNM IS A RECURSIVE PROCEDURE WHICH PROCEEDS BY MAKING
12987: * RECURSIVE CALLS TO GENERATE CODE FOR OPERANDS.
12988: *
12989: * (WB) INTEGER IN RANGE 0 LE N LE DNAMB
12990: * (XR) PTR TO TREE GENERATED BY EXPAN
12991: * (WC) CONSTANT FLAG (SEE BELOW)
12992: * JSR CDGNM CALL TO GENERATE CODE BY NAME
12993: * (XR,WA) DESTROYED
12994: * (WC) SET NON-ZERO IF NON-CONSTANT
12995: *
12996: * WC IS SET TO A NON-ZERO (COLLECTABLE) VALUE IF THE
12997: * EXPRESSION FOR WHICH CODE IS GENERATED CANNOT BE
12998: * EVALUATED AT COMPILE TIME, OTHERWISE WC IS UNCHANGED.
12999: *
13000: * THE CODE IS GENERATED IN THE CURRENT CCBLK (SEE CDWRD).
13001: *
13002: {CDGNM{PRC{R{0{{ENTRY POINT, RECURSIVE
13003: {{MOV{R10{-(SP){{SAVE ENTRY XL
13004: {{MOV{R7{-(SP){{SAVE ENTRY WB
13005: {{CHK{{{{CHECK FOR STACK OVERFLOW
13006: {{MOV{(R9){R6{{LOAD TYPE WORD
13007: {{BEQ{R6{#B$CMT{CGN04{JUMP IF CMBLK
13008: {{BHI{R6{#B$VR${CGN02{JUMP IF SIMPLE VARIABLE
13009: *
13010: * MERGE HERE FOR OPERAND YIELDING VALUE (E.G. CONSTANT)
13011: *
13012: {CGN01{ERB{212{SYNTAX{{ERROR. VALUE USED WHERE NAME IS REQUIRED
13013: *
13014: * HERE FOR NATURAL VARIABLE REFERENCE
13015: *
13016: {CGN02{MOV{#OLVN${R6{{LOAD VARIABLE LOAD CALL
13017: {{JSR{CDWRD{{{GENERATE IT
13018: {{MOV{R9{R6{{COPY VRBLK POINTER
13019: {{JSR{CDWRD{{{GENERATE VRBLK POINTER
13020: {{EJC{{{{
13021: *
13022: * CDGNM (CONTINUED)
13023: *
13024: * HERE TO EXIT WITH WC SET CORRECTLY
13025: *
13026: {CGN03{MOV{(SP)+{R7{{RESTORE ENTRY WB
13027: {{MOV{(SP)+{R10{{RESTORE ENTRY XL
13028: {{EXI{{{{RETURN TO CDGNM CALLER
13029: *
13030: * HERE FOR CMBLK
13031: *
13032: {CGN04{MOV{R9{R10{{COPY CMBLK POINTER
13033: {{MOV{4*CMTYP(R9){R9{{LOAD CMBLK TYPE
13034: {{BGE{R9{#C$$NM{CGN01{ERROR IF NOT NAME OPERAND
13035: {{BSW{R9{C$$NM{{ELSE SWITCH ON TYPE
13036: {{IFF{C$ARR{CGN05{{ARRAY REFERENCE
13037: {{IFF{C$FNC{CGN08{{FUNCTION CALL
13038: {{IFF{C$DEF{CGN09{{DEFERRED EXPRESSION
13039: {{IFF{C$IND{CGN10{{INDIRECT REFERENCE
13040: {{IFF{C$KEY{CGN11{{KEYWORD REFERENCE
13041: {{IFF{C$UBO{CGN08{{UNDEFINED BINARY OP
13042: {{IFF{C$UUO{CGN08{{UNDEFINED UNARY OP
13043: {{ESW{{{{END SWITCH ON CMBLK TYPE
13044: *
13045: * HERE TO GENERATE CODE FOR ARRAY REFERENCE
13046: *
13047: {CGN05{MOV{#4*CMOPN{R7{{POINT TO ARRAY OPERAND
13048: *
13049: * LOOP TO GENERATE CODE FOR ARRAY OPERAND AND SUBSCRIPTS
13050: *
13051: {CGN06{JSR{CMGEN{{{GENERATE CODE FOR NEXT OPERAND
13052: {{MOV{4*CMLEN(R10){R8{{LOAD LENGTH OF CMBLK
13053: {{BLT{R7{R8{CGN06{LOOP TILL ALL GENERATED
13054: *
13055: * GENERATE APPROPRIATE ARRAY CALL
13056: *
13057: {{MOV{#OAON${R6{{LOAD ONE-SUBSCRIPT CASE CALL
13058: {{BEQ{R8{#4*CMAR1{CGN07{JUMP TO EXIT IF ONE SUBSCRIPT CASE
13059: {{MOV{#OAMN${R6{{ELSE LOAD MULTI-SUBSCRIPT CASE CALL
13060: {{JSR{CDWRD{{{GENERATE CALL
13061: {{MOV{R8{R6{{COPY CMBLK LENGTH
13062: {{BTW{R6{{{CONVERT TO WORDS
13063: {{SUB{#CMVLS{R6{{CALCULATE NUMBER OF SUBSCRIPTS
13064: {{EJC{{{{
13065: *
13066: * CDGNM (CONTINUED)
13067: *
13068: * HERE TO EXIT GENERATING WORD (NON-CONSTANT)
13069: *
13070: {CGN07{MNZ{R8{{{SET RESULT NON-CONSTANT
13071: {{JSR{CDWRD{{{GENERATE WORD
13072: {{BRN{CGN03{{{BACK TO EXIT
13073: *
13074: * HERE TO GENERATE CODE FOR FUNCTIONS AND UNDEFINED OPRS
13075: *
13076: {CGN08{MOV{R10{R9{{COPY CMBLK POINTER
13077: {{JSR{CDGVL{{{GEN CODE BY VALUE FOR CALL
13078: {{MOV{#OFNE${R6{{GET EXTRA CALL FOR BY NAME
13079: {{BRN{CGN07{{{BACK TO GENERATE AND EXIT
13080: *
13081: * HERE TO GENERATE CODE FOR DEFERED EXPRESSION
13082: *
13083: {CGN09{MOV{4*CMROP(R10){R9{{CHECK IF VARIABLE
13084: {{BHI{(R9){#B$VR${CGN02{TREAT *VARIABLE AS SIMPLE VAR
13085: {{MOV{R9{R10{{COPY PTR TO EXPRESSION TREE
13086: {{JSR{CDGEX{{{ELSE BUILD EXBLK
13087: {{MOV{#OLEX${R6{{SET CALL TO LOAD EXPR BY NAME
13088: {{JSR{CDWRD{{{GENERATE IT
13089: {{MOV{R9{R6{{COPY EXBLK POINTER
13090: {{JSR{CDWRD{{{GENERATE EXBLK POINTER
13091: {{BRN{CGN03{{{BACK TO EXIT
13092: *
13093: * HERE TO GENERATE CODE FOR INDIRECT REFERENCE
13094: *
13095: {CGN10{MOV{4*CMROP(R10){R9{{GET OPERAND
13096: {{JSR{CDGVL{{{GENERATE CODE BY VALUE FOR IT
13097: {{MOV{#OINN${R6{{LOAD CALL FOR INDIRECT BY NAME
13098: {{BRN{CGN12{{{MERGE
13099: *
13100: * HERE TO GENERATE CODE FOR KEYWORD REFERENCE
13101: *
13102: {CGN11{MOV{4*CMROP(R10){R9{{GET OPERAND
13103: {{JSR{CDGNM{{{GENERATE CODE BY NAME FOR IT
13104: {{MOV{#OKWN${R6{{LOAD CALL FOR KEYWORD BY NAME
13105: *
13106: * KEYWORD, INDIRECT MERGE HERE
13107: *
13108: {CGN12{JSR{CDWRD{{{GENERATE CODE FOR OPERATOR
13109: {{BRN{CGN03{{{EXIT
13110: {{ENP{{{{END PROCEDURE CDGNM
13111: {{EJC{{{{
13112: *
13113: * CDGVL -- GENERATE CODE BY VALUE
13114: *
13115: * CDGVL IS CALLED DURING THE COMPILATION PROCESS TO
13116: * GENERATE CODE BY VALUE FOR AN EXPRESSION. SEE CDBLK
13117: * DESCRIPTION FOR DETAILS OF THE CODE GENERATED. THE INPUT
13118: * TO CDGVL IS AN EXPRESSION TREE AS GENERATED BY EXPAN.
13119: *
13120: * CDGVL IS A RECURSIVE PROCEDURE WHICH PROCEEDS BY MAKING
13121: * RECURSIVE CALLS TO GENERATE CODE FOR OPERANDS.
13122: *
13123: * (WB) INTEGER IN RANGE 0 LE N LE DNAMB
13124: * (XR) PTR TO TREE GENERATED BY EXPAN
13125: * (WC) CONSTANT FLAG (SEE BELOW)
13126: * JSR CDGVL CALL TO GENERATE CODE BY VALUE
13127: * (XR,WA) DESTROYED
13128: * (WC) SET NON-ZERO IF NON-CONSTANT
13129: *
13130: * WC IS SET TO A NON-ZERO (COLLECTABLE) VALUE IF THE
13131: * EXPRESSION FOR WHICH CODE IS GENERATED CANNOT BE
13132: * EVALUATED AT COMPILE TIME, OTHERWISE WC IS UNCHANGED.
13133: *
13134: * IF WC IS NON-ZERO ON ENTRY, THEN PREEVALUATION IS NOT
13135: * ALLOWED REGARDLESS OF THE NATURE OF THE OPERAND.
13136: *
13137: * THE CODE IS GENERATED IN THE CURRENT CCBLK (SEE CDWRD).
13138: *
13139: {CDGVL{PRC{R{0{{ENTRY POINT, RECURSIVE
13140: {{MOV{(R9){R6{{LOAD TYPE WORD
13141: {{BEQ{R6{#B$CMT{CGV01{JUMP IF CMBLK
13142: {{BLT{R6{#B$VRA{CGV00{JUMP IF ICBLK, RCBLK, SCBLK
13143: {{BNZ{4*VRLEN(R9){CGVL0{{JUMP IF NOT SYSTEM VARIABLE
13144: {{MOV{R9{-(SP){{STACK XR
13145: {{MOV{4*VRSVP(R9){R9{{POINT TO SVBLK
13146: {{MOV{4*SVBIT(R9){R6{{GET SVBLK PROPERTY BITS
13147: {{MOV{(SP)+{R9{{RECOVER XR
13148: {{ANB{BTCKW{R6{{CHECK IF CONSTANT KEYWORD
13149: {{NZB{R6{CGV00{{JUMP IF CONSTANT KEYWORD
13150: *
13151: * HERE FOR VARIABLE VALUE REFERENCE
13152: *
13153: {CGVL0{MNZ{R8{{{INDICATE NON-CONSTANT VALUE
13154: *
13155: * MERGE HERE FOR SIMPLE CONSTANT (ICBLK,RCBLK,SCBLK)
13156: * AND FOR VARIABLES CORRESPONDING TO CONSTANT KEYWORDS.
13157: *
13158: {CGV00{MOV{R9{R6{{COPY PTR TO VAR OR CONSTANT
13159: {{JSR{CDWRD{{{GENERATE AS CODE WORD
13160: {{EXI{{{{RETURN TO CALLER
13161: {{EJC{{{{
13162: *
13163: * CDGVL (CONTINUED)
13164: *
13165: * HERE FOR TREE NODE (CMBLK)
13166: *
13167: {CGV01{MOV{R7{-(SP){{SAVE ENTRY WB
13168: {{MOV{R10{-(SP){{SAVE ENTRY XL
13169: {{MOV{R8{-(SP){{SAVE ENTRY CONSTANT FLAG
13170: {{MOV{CWCOF{-(SP){{SAVE INITIAL CODE OFFSET
13171: {{CHK{{{{CHECK FOR STACK OVERFLOW
13172: *
13173: * PREPARE TO GENERATE CODE FOR CMBLK. WC IS SET TO THE
13174: * VALUE OF CSWNO (ZERO IF -OPTIMISE, 1 IF -NOOPT) TO
13175: * START WITH AND IS RESET NON-ZERO FOR ANY NON-CONSTANT
13176: * CODE GENERATED. IF IT IS STILL ZERO AFTER GENERATING ALL
13177: * THE CMBLK CODE, THEN ITS VALUE IS COMPUTED AS THE RESULT.
13178: *
13179: {{MOV{R9{R10{{COPY CMBLK POINTER
13180: {{MOV{4*CMTYP(R9){R9{{LOAD CMBLK TYPE
13181: {{MOV{CSWNO{R8{{RESET CONSTANT FLAG
13182: {{BLE{R9{#C$PR${CGV02{JUMP IF NOT PREDICATE VALUE
13183: {{MNZ{R8{{{ELSE FORCE NON-CONSTANT CASE
13184: *
13185: * HERE WITH WC SET APPROPRIATELY
13186: *
13187: {CGV02{BSW{R9{C$$NV{{SWITCH TO APPROPRIATE GENERATOR
13188: {{IFF{C$ARR{CGV03{{ARRAY REFERENCE
13189: {{IFF{C$FNC{CGV05{{FUNCTION CALL
13190: {{IFF{C$DEF{CGV14{{DEFERRED EXPRESSION
13191: {{IFF{C$IND{CGV31{{INDIRECT REFERENCE
13192: {{IFF{C$KEY{CGV27{{KEYWORD REFERENCE
13193: {{IFF{C$UBO{CGV29{{UNDEFINED BINOP
13194: {{IFF{C$UUO{CGV30{{UNDEFINED UNOP
13195: {{IFF{C$BVL{CGV18{{BINOPS WITH VAL OPDS
13196: {{IFF{C$UVL{CGV19{{UNOPS WITH VALU OPND
13197: {{IFF{C$ALT{CGV18{{ALTERNATION
13198: {{IFF{C$CNC{CGV24{{CONCATENATION
13199: {{IFF{C$CNP{CGV24{{CONCATENATION (NOT PATTERN MATCH)
13200: {{IFF{C$UNM{CGV27{{UNOPS WITH NAME OPND
13201: {{IFF{C$BVN{CGV26{{BINARY $ AND .
13202: {{IFF{C$ASS{CGV21{{ASSIGNMENT
13203: {{IFF{C$INT{CGV31{{INTERROGATION
13204: {{IFF{C$NEG{CGV28{{NEGATION
13205: {{IFF{C$SEL{CGV15{{SELECTION
13206: {{IFF{C$PMT{CGV18{{PATTERN MATCH
13207: {{ESW{{{{END SWITCH ON CMBLK TYPE
13208: {{EJC{{{{
13209: *
13210: * CDGVL (CONTINUED)
13211: *
13212: * HERE TO GENERATE CODE FOR ARRAY REFERENCE
13213: *
13214: {CGV03{MOV{#4*CMOPN{R7{{SET OFFSET TO ARRAY OPERAND
13215: *
13216: * LOOP TO GENERATE CODE FOR ARRAY OPERAND AND SUBSCRIPTS
13217: *
13218: {CGV04{JSR{CMGEN{{{GEN VALUE CODE FOR NEXT OPERAND
13219: {{MOV{4*CMLEN(R10){R8{{LOAD CMBLK LENGTH
13220: {{BLT{R7{R8{CGV04{LOOP BACK IF MORE TO GO
13221: *
13222: * GENERATE CALL TO APPROPRIATE ARRAY REFERENCE ROUTINE
13223: *
13224: {{MOV{#OAOV${R6{{SET ONE SUBSCRIPT CALL IN CASE
13225: {{BEQ{R8{#4*CMAR1{CGV32{JUMP TO EXIT IF 1-SUB CASE
13226: {{MOV{#OAMV${R6{{ELSE SET CALL FOR MULTI-SUBSCRIPTS
13227: {{JSR{CDWRD{{{GENERATE CALL
13228: {{MOV{R8{R6{{COPY LENGTH OF CMBLK
13229: {{SUB{#4*CMVLS{R6{{SUBTRACT STANDARD LENGTH
13230: {{BTW{R6{{{GET NUMBER OF WORDS
13231: {{BRN{CGV32{{{JUMP TO GENERATE SUBSCRIPT COUNT
13232: *
13233: * HERE TO GENERATE CODE FOR FUNCTION CALL
13234: *
13235: {CGV05{MOV{#4*CMVLS{R7{{SET OFFSET TO FIRST ARGUMENT
13236: *
13237: * LOOP TO GENERATE CODE FOR ARGUMENTS
13238: *
13239: {CGV06{BEQ{R7{4*CMLEN(R10){CGV07{JUMP IF ALL GENERATED
13240: {{JSR{CMGEN{{{ELSE GEN VALUE CODE FOR NEXT ARG
13241: {{BRN{CGV06{{{BACK TO GENERATE NEXT ARGUMENT
13242: *
13243: * HERE TO GENERATE ACTUAL FUNCTION CALL
13244: *
13245: {CGV07{SUB{#4*CMVLS{R7{{GET NUMBER OF ARG PTRS (BYTES)
13246: {{BTW{R7{{{CONVERT BYTES TO WORDS
13247: {{MOV{4*CMOPN(R10){R9{{LOAD FUNCTION VRBLK POINTER
13248: {{BNZ{4*VRLEN(R9){CGV12{{JUMP IF NOT SYSTEM FUNCTION
13249: {{MOV{4*VRSVP(R9){R10{{LOAD SVBLK PTR IF SYSTEM VAR
13250: {{MOV{4*SVBIT(R10){R6{{LOAD BIT MASK
13251: {{ANB{BTFFC{R6{{TEST FOR FAST FUNCTION CALL ALLOWED
13252: {{ZRB{R6{CGV12{{JUMP IF NOT
13253: {{EJC{{{{
13254: *
13255: * CDGVL (CONTINUED)
13256: *
13257: * HERE IF FAST FUNCTION CALL IS ALLOWED
13258: *
13259: {{MOV{4*SVBIT(R10){R6{{RELOAD BIT INDICATORS
13260: {{ANB{BTPRE{R6{{TEST FOR PREEVALUATION OK
13261: {{NZB{R6{CGV08{{JUMP IF PREEVALUATION PERMITTED
13262: {{MNZ{R8{{{ELSE SET RESULT NON-CONSTANT
13263: *
13264: * TEST FOR CORRECT NUMBER OF ARGS FOR FAST CALL
13265: *
13266: {CGV08{MOV{4*VRFNC(R9){R10{{LOAD PTR TO SVFNC FIELD
13267: {{MOV{4*FARGS(R10){R6{{LOAD SVNAR FIELD VALUE
13268: {{BEQ{R6{R7{CGV11{JUMP IF ARGUMENT COUNT IS CORRECT
13269: {{BHI{R6{R7{CGV09{JUMP IF TOO FEW ARGUMENTS GIVEN
13270: *
13271: * HERE IF TOO MANY ARGUMENTS, PREPARE TO GENERATE O$POPS
13272: *
13273: {{SUB{R6{R7{{GET NUMBER OF EXTRA ARGS
13274: {{LCT{R7{R7{{SET AS COUNT TO CONTROL LOOP
13275: {{MOV{#OPOP${R6{{SET POP CALL
13276: {{BRN{CGV10{{{JUMP TO COMMON LOOP
13277: *
13278: * HERE IF TOO FEW ARGUMENTS, PREPARE TO GENERATE NULLS
13279: *
13280: {CGV09{SUB{R7{R6{{GET NUMBER OF MISSING ARGUMENTS
13281: {{LCT{R7{R6{{LOAD AS COUNT TO CONTROL LOOP
13282: {{MOV{#NULLS{R6{{LOAD PTR TO NULL CONSTANT
13283: *
13284: * LOOP TO GENERATE CALLS TO FIX ARGUMENT COUNT
13285: *
13286: {CGV10{JSR{CDWRD{{{GENERATE ONE CALL
13287: {{BCT{R7{CGV10{{LOOP TILL ALL GENERATED
13288: *
13289: * HERE AFTER ADJUSTING ARG COUNT AS REQUIRED
13290: *
13291: {CGV11{MOV{R10{R6{{COPY POINTER TO SVFNC FIELD
13292: {{BRN{CGV36{{{JUMP TO GENERATE CALL
13293: {{EJC{{{{
13294: *
13295: * CDGVL (CONTINUED)
13296: *
13297: * COME HERE IF FAST CALL IS NOT PERMITTED
13298: *
13299: {CGV12{MOV{#OFNS${R6{{SET ONE ARG CALL IN CASE
13300: {{BEQ{R7{#NUM01{CGV13{JUMP IF ONE ARG CASE
13301: {{MOV{#OFNC${R6{{ELSE LOAD CALL FOR MORE THAN 1 ARG
13302: {{JSR{CDWRD{{{GENERATE IT
13303: {{MOV{R7{R6{{COPY ARGUMENT COUNT
13304: *
13305: * ONE ARG CASE MERGES HERE
13306: *
13307: {CGV13{JSR{CDWRD{{{GENERATE =O$FNS OR ARG COUNT
13308: {{MOV{R9{R6{{COPY VRBLK POINTER
13309: {{BRN{CGV32{{{JUMP TO GENERATE VRBLK PTR
13310: *
13311: * HERE FOR DEFERRED EXPRESSION
13312: *
13313: {CGV14{MOV{4*CMROP(R10){R10{{POINT TO EXPRESSION TREE
13314: {{JSR{CDGEX{{{BUILD EXBLK OR SEBLK
13315: {{MOV{R9{R6{{COPY BLOCK PTR
13316: {{JSR{CDWRD{{{GENERATE PTR TO EXBLK OR SEBLK
13317: {{BRN{CGV34{{{JUMP TO EXIT, CONSTANT TEST
13318: *
13319: * HERE TO GENERATE CODE FOR SELECTION
13320: *
13321: {CGV15{ZER{-(SP){{{ZERO PTR TO CHAIN OF FORWARD JUMPS
13322: {{ZER{-(SP){{{ZERO PTR TO PREV O$SLC FORWARD PTR
13323: {{MOV{#4*CMVLS{R7{{POINT TO FIRST ALTERNATIVE
13324: {{MOV{#OSLA${R6{{SET INITIAL CODE WORD
13325: *
13326: * 0(XS) IS THE OFFSET TO THE PREVIOUS WORD
13327: * WHICH REQUIRES FILLING IN WITH AN
13328: * OFFSET TO THE FOLLOWING O$SLC,O$SLD
13329: *
13330: * 1(XS) IS THE HEAD OF A CHAIN OF OFFSET
13331: * POINTERS INDICATING THOSE LOCATIONS
13332: * TO BE FILLED WITH OFFSETS PAST
13333: * THE END OF ALL THE ALTERNATIVES
13334: *
13335: {CGV16{JSR{CDWRD{{{GENERATE O$SLC (O$SLA FIRST TIME)
13336: {{MOV{CWCOF{(SP){{SET CURRENT LOC AS PTR TO FILL IN
13337: {{JSR{CDWRD{{{GENERATE GARBAGE WORD THERE FOR NOW
13338: {{JSR{CMGEN{{{GEN VALUE CODE FOR ALTERNATIVE
13339: {{MOV{#OSLB${R6{{LOAD O$SLB POINTER
13340: {{JSR{CDWRD{{{GENERATE O$SLB CALL
13341: {{MOV{4*1(SP){R6{{LOAD OLD CHAIN PTR
13342: {{MOV{CWCOF{4*1(SP){{SET CURRENT LOC AS NEW CHAIN HEAD
13343: {{JSR{CDWRD{{{GENERATE FORWARD CHAIN LINK
13344: {{EJC{{{{
13345: *
13346: * CDGVL (CONTINUED)
13347: *
13348: * NOW TO FILL IN THE SKIP OFFSET TO O$SLC,O$SLD
13349: *
13350: {{MOV{(SP){R9{{LOAD OFFSET TO WORD TO PLUG
13351: {{ADD{R$CCB{R9{{POINT TO ACTUAL LOCATION TO PLUG
13352: {{MOV{CWCOF{(R9){{PLUG PROPER OFFSET IN
13353: {{MOV{#OSLC${R6{{LOAD O$SLC PTR FOR NEXT ALTERNATIVE
13354: {{MOV{R7{R9{{COPY OFFSET (DESTROY GARBAGE XR)
13355: {{ICA{R9{{{BUMP EXTRA TIME FOR TEST
13356: {{BLT{R9{4*CMLEN(R10){CGV16{LOOP BACK IF NOT LAST ALTERNATIVE
13357: *
13358: * HERE TO GENERATE CODE FOR LAST ALTERNATIVE
13359: *
13360: {{MOV{#OSLD${R6{{GET HEADER CALL
13361: {{JSR{CDWRD{{{GENERATE O$SLD CALL
13362: {{JSR{CMGEN{{{GENERATE CODE FOR LAST ALTERNATIVE
13363: {{ICA{SP{{{POP OFFSET PTR
13364: {{MOV{(SP)+{R9{{LOAD CHAIN PTR
13365: *
13366: * LOOP TO PLUG OFFSETS PAST STRUCTURE
13367: *
13368: {CGV17{ADD{R$CCB{R9{{MAKE NEXT PTR ABSOLUTE
13369: {{MOV{(R9){R6{{LOAD FORWARD PTR
13370: {{MOV{CWCOF{(R9){{PLUG REQUIRED OFFSET
13371: {{MOV{R6{R9{{COPY FORWARD PTR
13372: {{BNZ{R6{CGV17{{LOOP BACK IF MORE TO GO
13373: {{BRN{CGV33{{{ELSE JUMP TO EXIT (NOT CONSTANT)
13374: *
13375: * HERE FOR BINARY OPS WITH VALUE OPERANDS
13376: *
13377: {CGV18{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND POINTER
13378: {{JSR{CDGVL{{{GEN VALUE CODE FOR LEFT OPERAND
13379: *
13380: * HERE FOR UNARY OPS WITH VALUE OPERAND (BINOPS MERGE)
13381: *
13382: {CGV19{MOV{4*CMROP(R10){R9{{LOAD RIGHT (ONLY) OPERAND PTR
13383: {{JSR{CDGVL{{{GEN CODE BY VALUE
13384: {{EJC{{{{
13385: *
13386: * CDGVL (CONTINUED)
13387: *
13388: * MERGE HERE TO GENERATE OPERATOR CALL FROM CMOPN FIELD
13389: *
13390: {CGV20{MOV{4*CMOPN(R10){R6{{LOAD OPERATOR CALL POINTER
13391: {{BRN{CGV36{{{JUMP TO GENERATE IT WITH CONS TEST
13392: *
13393: * HERE FOR ASSIGNMENT
13394: *
13395: {CGV21{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND POINTER
13396: {{BLO{(R9){#B$VR${CGV22{JUMP IF NOT VARIABLE
13397: *
13398: * HERE FOR ASSIGNMENT TO SIMPLE VARIABLE
13399: *
13400: {{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND PTR
13401: {{JSR{CDGVL{{{GENERATE CODE BY VALUE
13402: {{MOV{4*CMLOP(R10){R6{{RELOAD LEFT OPERAND VRBLK PTR
13403: {{ADD{#4*VRSTO{R6{{POINT TO VRSTO FIELD
13404: {{BRN{CGV32{{{JUMP TO GENERATE STORE PTR
13405: *
13406: * HERE IF NOT SIMPLE VARIABLE ASSIGNMENT
13407: *
13408: {CGV22{JSR{EXPAP{{{TEST FOR PATTERN MATCH ON LEFT SIDE
13409: {{PPM{CGV23{{{JUMP IF NOT PATTERN MATCH
13410: *
13411: * HERE FOR PATTERN REPLACEMENT
13412: *
13413: {{MOV{4*CMROP(R9){4*CMLOP(R10){{SAVE PATTERN PTR IN SAFE PLACE
13414: {{MOV{4*CMLOP(R9){R9{{LOAD SUBJECT PTR
13415: {{JSR{CDGNM{{{GEN CODE BY NAME FOR SUBJECT
13416: {{MOV{4*CMLOP(R10){R9{{LOAD PATTERN PTR
13417: {{JSR{CDGVL{{{GEN CODE BY VALUE FOR PATTERN
13418: {{MOV{#OPMN${R6{{LOAD MATCH BY NAME CALL
13419: {{JSR{CDWRD{{{GENERATE IT
13420: {{MOV{4*CMROP(R10){R9{{LOAD REPLACEMENT VALUE PTR
13421: {{JSR{CDGVL{{{GEN CODE BY VALUE
13422: {{MOV{#ORPL${R6{{LOAD REPLACE CALL
13423: {{BRN{CGV32{{{JUMP TO GEN AND EXIT (NOT CONSTANT)
13424: *
13425: * HERE FOR ASSIGNMENT TO COMPLEX VARIABLE
13426: *
13427: {CGV23{MNZ{R8{{{INHIBIT PRE-EVALUATION
13428: {{JSR{CDGNM{{{GEN CODE BY NAME FOR LEFT SIDE
13429: {{BRN{CGV31{{{MERGE WITH UNOP CIRCUIT
13430: {{EJC{{{{
13431: *
13432: * CDGVL (CONTINUED)
13433: *
13434: * HERE FOR CONCATENATION
13435: *
13436: {CGV24{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND PTR
13437: {{BNE{(R9){#B$CMT{CGV18{ORDINARY BINOP IF NOT CMBLK
13438: {{MOV{4*CMTYP(R9){R7{{LOAD CMBLK TYPE CODE
13439: {{BEQ{R7{#C$INT{CGV25{SPECIAL CASE IF INTERROGATION
13440: {{BEQ{R7{#C$NEG{CGV25{OR NEGATION
13441: {{BNE{R7{#C$FNC{CGV18{ELSE ORDINARY BINOP IF NOT FUNCTION
13442: {{MOV{4*CMOPN(R9){R9{{ELSE LOAD FUNCTION VRBLK PTR
13443: {{BNZ{4*VRLEN(R9){CGV18{{ORDINARY BINOP IF NOT SYSTEM VAR
13444: {{MOV{4*VRSVP(R9){R9{{ELSE POINT TO SVBLK
13445: {{MOV{4*SVBIT(R9){R6{{LOAD BIT INDICATORS
13446: {{ANB{BTPRD{R6{{TEST FOR PREDICATE FUNCTION
13447: {{ZRB{R6{CGV18{{ORDINARY BINOP IF NOT
13448: *
13449: * HERE IF LEFT ARG OF CONCATENATION IS PREDICATE FUNCTION
13450: *
13451: {CGV25{MOV{4*CMLOP(R10){R9{{RELOAD LEFT ARG
13452: {{JSR{CDGVL{{{GEN CODE BY VALUE
13453: {{MOV{#OPOP${R6{{LOAD POP CALL
13454: {{JSR{CDWRD{{{GENERATE IT
13455: {{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND
13456: {{JSR{CDGVL{{{GEN CODE BY VALUE AS RESULT CODE
13457: {{BRN{CGV33{{{EXIT (NOT CONSTANT)
13458: *
13459: * HERE TO GENERATE CODE FOR PATTERN, IMMEDIATE ASSIGNMENT
13460: *
13461: {CGV26{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND
13462: {{JSR{CDGVL{{{GEN CODE BY VALUE, MERGE
13463: *
13464: * HERE FOR UNOPS WITH ARG BY NAME (BINARY $ . MERGE)
13465: *
13466: {CGV27{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND PTR
13467: {{JSR{CDGNM{{{GEN CODE BY NAME FOR RIGHT ARG
13468: {{MOV{4*CMOPN(R10){R9{{GET OPERATOR CODE WORD
13469: {{BNE{(R9){#O$KWV{CGV20{GEN CALL UNLESS KEYWORD VALUE
13470: {{EJC{{{{
13471: *
13472: * CDGVL (CONTINUED)
13473: *
13474: * HERE FOR KEYWORD BY VALUE. THIS IS CONSTANT ONLY IF
13475: * THE OPERAND IS ONE OF THE SPECIAL SYSTEM VARIABLES WITH
13476: * THE SVCKW BIT SET TO INDICATE A CONSTANT KEYWORD VALUE.
13477: * NOTE THAT THE ONLY CONSTANT OPERAND BY NAME IS A VARIABLE
13478: *
13479: {{BNZ{R8{CGV20{{GEN CALL IF NON-CONSTANT (NOT VAR)
13480: {{MNZ{R8{{{ELSE SET NON-CONSTANT IN CASE
13481: {{MOV{4*CMROP(R10){R9{{LOAD PTR TO OPERAND VRBLK
13482: {{BNZ{4*VRLEN(R9){CGV20{{GEN (NON-CONSTANT) IF NOT SYS VAR
13483: {{MOV{4*VRSVP(R9){R9{{ELSE LOAD PTR TO SVBLK
13484: {{MOV{4*SVBIT(R9){R6{{LOAD BIT MASK
13485: {{ANB{BTCKW{R6{{TEST FOR CONSTANT KEYWORD
13486: {{ZRB{R6{CGV20{{GO GEN IF NOT CONSTANT
13487: {{ZER{R8{{{ELSE SET RESULT CONSTANT
13488: {{BRN{CGV20{{{AND JUMP BACK TO GENERATE CALL
13489: *
13490: * HERE TO GENERATE CODE FOR NEGATION
13491: *
13492: {CGV28{MOV{#ONTA${R6{{GET INITIAL WORD
13493: {{JSR{CDWRD{{{GENERATE IT
13494: {{MOV{CWCOF{R7{{SAVE NEXT OFFSET
13495: {{JSR{CDWRD{{{GENERATE GUNK WORD FOR NOW
13496: {{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND PTR
13497: {{JSR{CDGVL{{{GEN CODE BY VALUE
13498: {{MOV{#ONTB${R6{{LOAD END OF EVALUATION CALL
13499: {{JSR{CDWRD{{{GENERATE IT
13500: {{MOV{R7{R9{{COPY OFFSET TO WORD TO PLUG
13501: {{ADD{R$CCB{R9{{POINT TO ACTUAL WORD TO PLUG
13502: {{MOV{CWCOF{(R9){{PLUG WORD WITH CURRENT OFFSET
13503: {{MOV{#ONTC${R6{{LOAD FINAL CALL
13504: {{BRN{CGV32{{{JUMP TO GENERATE IT (NOT CONSTANT)
13505: *
13506: * HERE TO GENERATE CODE FOR UNDEFINED BINARY OPERATOR
13507: *
13508: {CGV29{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND PTR
13509: {{JSR{CDGVL{{{GENERATE CODE BY VALUE
13510: {{EJC{{{{
13511: *
13512: * CDGVL (CONTINUED)
13513: *
13514: * HERE TO GENERATE CODE FOR UNDEFINED UNARY OPERATOR
13515: *
13516: {CGV30{MOV{#C$UO${R7{{SET UNOP CODE + 1
13517: {{SUB{4*CMTYP(R10){R7{{SET NUMBER OF ARGS (1 OR 2)
13518: *
13519: * MERGE HERE FOR UNDEFINED OPERATORS
13520: *
13521: {{MOV{4*CMROP(R10){R9{{LOAD RIGHT (ONLY) OPERAND POINTER
13522: {{JSR{CDGVL{{{GEN VALUE CODE FOR RIGHT OPERAND
13523: {{MOV{4*CMOPN(R10){R9{{LOAD POINTER TO OPERATOR DV
13524: {{MOV{4*DVOPN(R9){R9{{LOAD POINTER OFFSET
13525: {{WTB{R9{{{CONVERT WORD OFFSET TO BYTES
13526: {{ADD{#R$UBA{R9{{POINT TO PROPER FUNCTION PTR
13527: {{SUB{#4*VRFNC{R9{{SET STANDARD FUNCTION OFFSET
13528: {{BRN{CGV12{{{MERGE WITH FUNCTION CALL CIRCUIT
13529: *
13530: * HERE TO GENERATE CODE FOR INTERROGATION, INDIRECTION
13531: *
13532: {CGV31{MNZ{R8{{{SET NON CONSTANT
13533: {{BRN{CGV19{{{MERGE
13534: *
13535: * HERE TO EXIT GENERATING A WORD, RESULT NOT CONSTANT
13536: *
13537: {CGV32{JSR{CDWRD{{{GENERATE WORD, MERGE
13538: *
13539: * HERE TO EXIT WITH NO WORD GENERATED, NOT CONSTANT
13540: *
13541: {CGV33{MNZ{R8{{{INDICATE RESULT IS NOT CONSTANT
13542: *
13543: * COMMON EXIT POINT
13544: *
13545: {CGV34{ICA{SP{{{POP INITIAL CODE OFFSET
13546: {{MOV{(SP)+{R6{{RESTORE OLD CONSTANT FLAG
13547: {{MOV{(SP)+{R10{{RESTORE ENTRY XL
13548: {{MOV{(SP)+{R7{{RESTORE ENTRY WB
13549: {{BNZ{R8{CGV35{{JUMP IF NOT CONSTANT
13550: {{MOV{R6{R8{{ELSE RESTORE ENTRY CONSTANT FLAG
13551: *
13552: * HERE TO RETURN AFTER DEALING WITH WC SETTING
13553: *
13554: {CGV35{EXI{{{{RETURN TO CDGVL CALLER
13555: *
13556: * EXIT HERE TO GENERATE WORD AND TEST FOR CONSTANT
13557: *
13558: {CGV36{JSR{CDWRD{{{GENERATE WORD
13559: {{BNZ{R8{CGV34{{JUMP TO EXIT IF NOT CONSTANT
13560: {{EJC{{{{
13561: *
13562: * CDGVL (CONTINUED)
13563: *
13564: * HERE TO PREEVALUATE CONSTANT SUB-EXPRESSION
13565: *
13566: {{MOV{#ORVL${R6{{LOAD CALL TO RETURN VALUE
13567: {{JSR{CDWRD{{{GENERATE IT
13568: {{MOV{(SP){R10{{LOAD INITIAL CODE OFFSET
13569: {{JSR{EXBLD{{{BUILD EXBLK FOR EXPRESSION
13570: {{ZER{R7{{{SET TO EVALUATE BY VALUE
13571: {{JSR{EVALX{{{EVALUATE EXPRESSION
13572: {{PPM{{{{SHOULD NOT FAIL
13573: {{MOV{(R9){R6{{LOAD TYPE WORD OF RESULT
13574: {{BLO{R6{#P$AAA{CGV37{JUMP IF NOT PATTERN
13575: {{MOV{#OLPT${R6{{ELSE LOAD SPECIAL PATTERN LOAD CALL
13576: {{JSR{CDWRD{{{GENERATE IT
13577: *
13578: * MERGE HERE TO GENERATE POINTER TO RESULTING CONSTANT
13579: *
13580: {CGV37{MOV{R9{R6{{COPY CONSTANT POINTER
13581: {{JSR{CDWRD{{{GENERATE PTR
13582: {{ZER{R8{{{SET RESULT CONSTANT
13583: {{BRN{CGV34{{{JUMP BACK TO EXIT
13584: {{ENP{{{{END PROCEDURE CDGVL
13585: {{EJC{{{{
13586: *
13587: * CDWRD -- GENERATE ONE WORD OF CODE
13588: *
13589: * CDWRD WRITES ONE WORD INTO THE CURRENT CODE BLOCK UNDER
13590: * CONSTRUCTION. A NEW, LARGER, BLOCK IS ALLOCATED IF THERE
13591: * IS INSUFFICIENT ROOM IN THE CURRENT BLOCK. CDWRD ENSURES
13592: * THAT THERE ARE AT LEAST THREE WORDS LEFT IN THE BLOCK
13593: * AFTER ENTERING THE NEW WORD. THIS GUARANTEES THAT ANY
13594: * EXTRA SPACE AT THE END CAN BE SPLIT OFF AS A CCBLK.
13595: *
13596: * (WA) WORD TO BE GENERATED
13597: * JSR CDWRD CALL TO GENERATE WORD
13598: *
13599: {CDWRD{PRC{E{0{{ENTRY POINT
13600: {{MOV{R9{-(SP){{SAVE ENTRY XR
13601: {{MOV{R6{-(SP){{SAVE CODE WORD TO BE GENERATED
13602: *
13603: * MERGE BACK HERE AFTER ALLOCATING LARGER BLOCK
13604: *
13605: {CDWD1{MOV{R$CCB{R9{{LOAD PTR TO CCBLK BEING BUILT
13606: {{BNZ{R9{CDWD2{{JUMP IF BLOCK ALLOCATED
13607: *
13608: * HERE WE ALLOCATE AN ENTIRELY FRESH BLOCK
13609: *
13610: {{MOV{#4*E$CBS{R6{{LOAD INITIAL LENGTH
13611: {{JSR{ALLOC{{{ALLOCATE CCBLK
13612: {{MOV{#B$CCT{(R9){{STORE TYPE WORD
13613: {{MOV{#4*CCCOD{CWCOF{{SET INITIAL OFFSET
13614: {{MOV{R6{4*CCLEN(R9){{STORE BLOCK LENGTH
13615: {{MOV{R9{R$CCB{{STORE PTR TO NEW BLOCK
13616: *
13617: * HERE WE HAVE A BLOCK WE CAN USE
13618: *
13619: {CDWD2{MOV{CWCOF{R6{{LOAD CURRENT OFFSET
13620: {{ADD{#4*NUM04{R6{{ADJUST FOR TEST (FOUR WORDS)
13621: {{BLO{R6{4*CCLEN(R9){CDWD4{JUMP IF ROOM IN THIS BLOCK
13622: *
13623: * HERE IF NO ROOM IN CURRENT BLOCK
13624: *
13625: {{BGE{R6{MXLEN{CDWD5{JUMP IF ALREADY AT MAX SIZE
13626: {{ADD{#4*E$CBS{R6{{ELSE GET NEW SIZE
13627: {{MOV{R10{-(SP){{SAVE ENTRY XL
13628: {{MOV{R9{R10{{COPY POINTER
13629: {{BLT{R6{MXLEN{CDWD3{JUMP IF NOT TOO LARGE
13630: {{MOV{MXLEN{R6{{ELSE RESET TO MAX ALLOWED SIZE
13631: {{EJC{{{{
13632: *
13633: * CDWRD (CONTINUED)
13634: *
13635: * HERE WITH NEW BLOCK SIZE IN WA
13636: *
13637: {CDWD3{JSR{ALLOC{{{ALLOCATE NEW BLOCK
13638: {{MOV{R9{R$CCB{{STORE POINTER TO NEW BLOCK
13639: {{MOV{#B$CCT{(R9)+{{STORE TYPE WORD IN NEW BLOCK
13640: {{MOV{R6{(R9)+{{STORE BLOCK LENGTH
13641: {{ADD{#4*CCUSE{R10{{POINT TO CCUSE,CCCOD FIELDS IN OLD
13642: {{MOV{(R10){R6{{LOAD CCUSE VALUE
13643: {{MVW{{{{COPY USEFUL WORDS FROM OLD BLOCK
13644: {{MOV{(SP)+{R10{{RESTORE XL
13645: {{BRN{CDWD1{{{MERGE BACK TO TRY AGAIN
13646: *
13647: * HERE WITH ROOM IN CURRENT BLOCK
13648: *
13649: {CDWD4{MOV{CWCOF{R6{{LOAD CURRENT OFFSET
13650: {{ICA{R6{{{GET NEW OFFSET
13651: {{MOV{R6{CWCOF{{STORE NEW OFFSET
13652: {{MOV{R6{4*CCUSE(R9){{STORE IN CCBLK FOR GBCOL
13653: {{DCA{R6{{{RESTORE PTR TO THIS WORD
13654: {{ADD{R6{R9{{POINT TO CURRENT ENTRY
13655: {{MOV{(SP)+{R6{{RELOAD WORD TO GENERATE
13656: {{MOV{R6{(R9){{STORE WORD IN BLOCK
13657: {{MOV{(SP)+{R9{{RESTORE ENTRY XR
13658: {{EXI{{{{RETURN TO CALLER
13659: *
13660: * HERE IF COMPILED CODE IS TOO LONG FOR CDBLK
13661: *
13662: {CDWD5{ERB{213{SYNTAX{{ERROR. STATEMENT IS TOO COMPLICATED.
13663: {{ENP{{{{END PROCEDURE CDWRD
13664: {{EJC{{{{
13665: *
13666: * CMGEN -- GENERATE CODE FOR CMBLK PTR
13667: *
13668: * CMGEN IS A SUBSIDIARY PROCEDURE USED TO GENERATE VALUE
13669: * CODE FOR A CMBLK PTR FROM THE MAIN CODE GENERATORS.
13670: *
13671: * (XL) CMBLK POINTER
13672: * (WB) OFFSET TO POINTER IN CMBLK
13673: * JSR CMGEN CALL TO GENERATE CODE
13674: * (XR,WA) DESTROYED
13675: * (WB) BUMPED BY ONE WORD
13676: *
13677: {CMGEN{PRC{R{0{{ENTRY POINT, RECURSIVE
13678: {{MOV{R10{R9{{COPY CMBLK POINTER
13679: {{ADD{R7{R9{{POINT TO CMBLK POINTER
13680: {{MOV{(R9){R9{{LOAD CMBLK POINTER
13681: {{JSR{CDGVL{{{GENERATE CODE BY VALUE
13682: {{ICA{R7{{{BUMP OFFSET
13683: {{EXI{{{{RETURN TO CALLER
13684: {{ENP{{{{END PROCEDURE CMGEN
13685: {{EJC{{{{
13686: *
13687: * CMPIL (COMPILE SOURCE CODE)
13688: *
13689: * CMPIL IS USED TO CONVERT SNOBOL4 SOURCE CODE TO INTERNAL
13690: * FORM (SEE CDBLK FORMAT). IT IS USED BOTH FOR THE INITIAL
13691: * COMPILE AND AT RUN TIME BY THE CODE AND CONVERT FUNCTIONS
13692: * THIS PROCEDURE HAS CONTROL FOR THE ENTIRE DURATION OF
13693: * INITIAL COMPILATION. AN ERROR IN ANY PROCEDURE CALLED
13694: * DURING COMPILATION WILL LEAD FIRST TO THE ERROR SECTION
13695: * AND ULTIMATELY BACK HERE FOR RESUMED COMPILATION. THE
13696: * RE-ENTRY POINTS AFTER AN ERROR ARE SPECIALLY LABELLED -
13697: *
13698: * CMPCE RESUME AFTER CONTROL CARD ERROR
13699: * CMPLE RESUME AFTER LABEL ERROR
13700: * CMPSE RESUME AFTER STATEMENT ERROR
13701: *
13702: * JSR CMPIL CALL TO COMPILE CODE
13703: * (XR) PTR TO CDBLK FOR ENTRY STATEMENT
13704: * (XL,WA,WB,WC,RA) DESTROYED
13705: *
13706: * THE FOLLOWING GLOBAL VARIABLES ARE REFERENCED
13707: *
13708: * CMPSN NUMBER OF NEXT STATEMENT
13709: * TO BE COMPILED.
13710: *
13711: * CSWXX CONTROL CARD SWITCH VALUES ARE
13712: * CHANGED WHEN RELEVANT CONTROL
13713: * CARDS ARE MET.
13714: *
13715: * CWCOF OFFSET TO NEXT WORD IN CODE BLOCK
13716: * BEING BUILT (SEE CDWRD).
13717: *
13718: * LSTSN NUMBER OF STATEMENT MOST RECENTLY
13719: * COMPILED (INITIALLY SET TO ZERO).
13720: *
13721: * R$CIM CURRENT (INITIAL) COMPILER IMAGE
13722: * (ZERO FOR INITIAL COMPILE CALL)
13723: *
13724: * R$CNI USED TO POINT TO FOLLOWING IMAGE.
13725: * (SEE READR PROCEDURE).
13726: *
13727: * SCNGO GOTO SWITCH FOR SCANE PROCEDURE
13728: *
13729: * SCNIL LENGTH OF CURRENT IMAGE EXCLUDING
13730: * CHARACTERS REMOVED BY -INPUT.
13731: *
13732: * SCNPT CURRENT SCAN OFFSET, SEE SCANE.
13733: *
13734: * SCNRS RESCAN SWITCH FOR SCANE PROCEDURE.
13735: *
13736: * SCNSE OFFSET (IN R$CIM) OF MOST RECENTLY
13737: * SCANNED ELEMENT. SET ZERO IF NOT
13738: * CURRENTLY SCANNING ITEMS
13739: {{EJC{{{{
13740: *
13741: * CMPIL (CONTINUED)
13742: *
13743: * STAGE STGIC INITIAL COMPILE IN PROGRESS
13744: * STGXC CODE/CONVERT COMPILE
13745: * STGEV BUILDING EXBLK FOR EVAL
13746: * STGXT EXECUTE TIME (OUTSIDE COMPILE)
13747: * STGCE INITIAL COMPILE AFTER END LINE
13748: * STGXE EXECUTE COMPILE AFTER END LINE
13749: *
13750: * CMPIL ALSO USES A FIXED NUMBER OF LOCATIONS ON THE
13751: * MAIN STACK AS FOLLOWS. (THE DEFINITIONS OF THE ACTUAL
13752: * OFFSETS ARE IN THE DEFINITIONS SECTION).
13753: *
13754: * CMSTM(XS) POINTER TO EXPAN TREE FOR BODY OF
13755: * STATEMENT (SEE EXPAN PROCEDURE).
13756: *
13757: * CMSGO(XS) POINTER TO TREE REPRESENTATION OF
13758: * SUCCESS GOTO (SEE PROCEDURE SCNGO)9
13759: * ZERO IF NO SUCCESS GOTO IS GIVEN
13760: *
13761: * CMFGO(XS) LIKE CMSGO FOR FAILURE GOTO.
13762: *
13763: * CMCGO(XS) SET NON-ZERO ONLY IF THERE IS A
13764: * CONDITIONAL GOTO. USED FOR -FAIL,
13765: * -NOFAIL CODE GENERATION.
13766: *
13767: * CMPCD(XS) POINTER TO CDBLK FOR PREVIOUS
13768: * STATEMENT. ZERO FOR 1ST STATEMENT.
13769: *
13770: * CMFFP(XS) SET NON-ZERO IF CDFAL IN PREVIOUS
13771: * CDBLK NEEDS FILLING WITH FORWARD
13772: * POINTER, ELSE SET TO ZERO.
13773: *
13774: * CMFFC(XS) SAME AS CMFFP FOR CURRENT CDBLK
13775: *
13776: * CMSOP(XS) OFFSET TO WORD IN PREVIOUS CDBLK
13777: * TO BE FILLED IN WITH FORWARD PTR
13778: * TO NEXT CDBLK FOR SUCCESS GOTO.
13779: * ZERO IF NO FILL IN IS REQUIRED.
13780: *
13781: * CMSOC(XS) SAME AS CMSOP FOR CURRENT CDBLK.
13782: *
13783: * CMLBL(XS) POINTER TO VRBLK FOR LABEL OF
13784: * CURRENT STATEMENT. ZERO IF NO LABEL
13785: *
13786: * CMTRA(XS) POINTER TO CDBLK FOR ENTRY STMNT.
13787: {{EJC{{{{
13788: *
13789: * CMPIL (CONTINUED)
13790: *
13791: * ENTRY POINT
13792: *
13793: {CMPIL{PRC{E{0{{ENTRY POINT
13794: {{LCT{R7{#CMNEN{{SET NUMBER OF STACK WORK LOCATIONS
13795: *
13796: * LOOP TO INITIALIZE STACK WORKING LOCATIONS
13797: *
13798: {CMP00{ZER{-(SP){{{STORE A ZERO, MAKE ONE ENTRY
13799: {{BCT{R7{CMP00{{LOOP BACK UNTIL ALL SET
13800: {{MOV{SP{CMPXS{{SAVE STACK POINTER FOR ERROR SEC
13801: {{SSS{CMPSS{{{SAVE S-R STACK POINTER IF ANY
13802: *
13803: * LOOP THROUGH STATEMENTS
13804: *
13805: {CMP01{MOV{SCNPT{R7{{SET SCAN POINTER OFFSET
13806: {{MOV{R7{SCNSE{{SET START OF ELEMENT LOCATION
13807: {{MOV{#OCER${R6{{POINT TO COMPILE ERROR CALL
13808: {{JSR{CDWRD{{{GENERATE AS TEMPORARY CDFAL
13809: {{BLT{R7{SCNIL{CMP04{JUMP IF CHARS LEFT ON THIS IMAGE
13810: *
13811: * LOOP HERE AFTER COMMENT OR CONTROL CARD
13812: * ALSO SPECIAL ENTRY AFTER CONTROL CARD ERROR
13813: *
13814: {CMPCE{ZER{R9{{{CLEAR POSSIBLE GARBAGE XR VALUE
13815: {{BNE{STAGE{#STGIC{CMP02{SKIP UNLESS INITIAL COMPILE
13816: {{JSR{READR{{{READ NEXT INPUT IMAGE
13817: {{BZE{R9{CMP09{{JUMP IF NO INPUT AVAILABLE
13818: {{JSR{NEXTS{{{ACQUIRE NEXT SOURCE IMAGE
13819: {{MOV{CMPSN{LSTSN{{STORE STMT NO FOR USE BY LISTR
13820: {{ZER{SCNPT{{{RESET SCAN POINTER
13821: {{BRN{CMP04{{{GO PROCESS IMAGE
13822: *
13823: * FOR EXECUTE TIME COMPILE, PERMIT EMBEDDED CONTROL CARDS
13824: * AND COMMENTS (BY SKIPPING TO NEXT SEMI-COLON)
13825: *
13826: {CMP02{MOV{R$CIM{R9{{GET CURRENT IMAGE
13827: {{MOV{SCNPT{R7{{GET CURRENT OFFSET
13828: {{PLC{R9{R7{{PREPARE TO GET CHARS
13829: *
13830: * SKIP TO SEMI-COLON
13831: *
13832: {CMP03{LCH{R8{(R9)+{{GET CHAR
13833: {{ICV{SCNPT{{{ADVANCE OFFSET
13834: {{BEQ{R8{#CH$SM{CMP04{SKIP IF SEMI-COLON FOUND
13835: {{BLT{SCNPT{SCNIL{CMP03{LOOP IF MORE CHARS
13836: {{ZER{R9{{{CLEAR GARBAGE XR VALUE
13837: {{BRN{CMP09{{{END OF IMAGE
13838: {{EJC{{{{
13839: *
13840: * CMPIL (CONTINUED)
13841: *
13842: * HERE WITH IMAGE AVAILABLE TO SCAN. NOTE THAT IF THE INPUT
13843: * STRING IS NULL, THEN EVERYTHING IS OK SINCE NULL IS
13844: * ACTUALLY ASSEMBLED AS A WORD OF BLANKS.
13845: *
13846: {CMP04{MOV{R$CIM{R9{{POINT TO CURRENT IMAGE
13847: {{MOV{SCNPT{R7{{LOAD CURRENT OFFSET
13848: {{MOV{R7{R6{{COPY FOR LABEL SCAN
13849: {{PLC{R9{R7{{POINT TO FIRST CHARACTER
13850: {{LCH{R8{(R9)+{{LOAD FIRST CHARACTER
13851: {{BEQ{R8{#CH$SM{CMP12{NO LABEL IF SEMICOLON
13852: {{BEQ{R8{#CH$AS{CMPCE{LOOP BACK IF COMMENT CARD
13853: {{BEQ{R8{#CH$MN{CMP32{JUMP IF CONTROL CARD
13854: {{MOV{R$CIM{R$CMP{{ABOUT TO DESTROY R$CIM
13855: {{MOV{#CMLAB{R10{{POINT TO LABEL WORK STRING
13856: {{MOV{R10{R$CIM{{SCANE IS TO SCAN WORK STRING
13857: {{PSC{R10{{{POINT TO FIRST CHARACTER POSITION
13858: {{SCH{R8{(R10)+{{STORE CHAR JUST LOADED
13859: {{MOV{#CH$SM{R8{{GET A SEMICOLON
13860: {{SCH{R8{(R10){{STORE AFTER FIRST CHAR
13861: {{CSC{R10{{{FINISHED CHARACTER STORING
13862: {{ZER{R10{{{CLEAR POINTER
13863: {{ZER{SCNPT{{{START AT FIRST CHARACTER
13864: {{MOV{SCNIL{-(SP){{PRESERVE IMAGE LENGTH
13865: {{MOV{#NUM02{SCNIL{{READ 2 CHARS AT MOST
13866: {{JSR{SCANE{{{SCAN FIRST CHAR FOR TYPE
13867: {{MOV{(SP)+{SCNIL{{RESTORE IMAGE LENGTH
13868: {{MOV{R10{R8{{NOTE RETURN CODE
13869: {{MOV{R$CMP{R10{{GET OLD R$CIM
13870: {{MOV{R10{R$CIM{{PUT IT BACK
13871: {{MOV{R7{SCNPT{{REINSTATE OFFSET
13872: {{BNZ{SCNBL{CMP12{{BLANK SEEN - CANT BE LABEL
13873: {{MOV{R10{R9{{POINT TO CURRENT IMAGE
13874: {{PLC{R9{R7{{POINT TO FIRST CHAR AGAIN
13875: {{BEQ{R8{#T$VAR{CMP06{OK IF LETTER
13876: {{BEQ{R8{#T$CON{CMP06{OK IF DIGIT
13877: *
13878: * DROP IN OR JUMP FROM ERROR SECTION IF SCANE FAILED
13879: *
13880: {CMPLE{MOV{R$CMP{R$CIM{{POINT TO BAD LINE
13881: {{ERB{214{BAD{{LABEL OR MISPLACED CONTINUATION LINE
13882: *
13883: * LOOP TO SCAN LABEL
13884: *
13885: {CMP05{BEQ{R8{#CH$SM{CMP07{SKIP IF SEMICOLON
13886: {{ICV{R6{{{BUMP OFFSET
13887: {{BEQ{R6{SCNIL{CMP07{JUMP IF END OF IMAGE (LABEL END)
13888: {{EJC{{{{
13889: *
13890: * CMPIL (CONTINUED)
13891: *
13892: * ENTER LOOP AT THIS POINT
13893: *
13894: {CMP06{LCH{R8{(R9)+{{ELSE LOAD NEXT CHARACTER
13895: {{BEQ{R8{#CH$HT{CMP07{JUMP IF HORIZONTAL TAB
13896: {{BNE{R8{#CH$BL{CMP05{LOOP BACK IF NON-BLANK
13897: *
13898: * HERE AFTER SCANNING OUT LABEL
13899: *
13900: {CMP07{MOV{R6{SCNPT{{SAVE UPDATED SCAN OFFSET
13901: {{SUB{R7{R6{{GET LENGTH OF LABEL
13902: {{BZE{R6{CMP12{{SKIP IF LABEL LENGTH ZERO
13903: {{ZER{R9{{{CLEAR GARBAGE XR VALUE
13904: {{JSR{SBSTR{{{BUILD SCBLK FOR LABEL NAME
13905: {{JSR{GTNVR{{{LOCATE/CONTRUCT VRBLK
13906: {{PPM{{{{DUMMY (IMPOSSIBLE) ERROR RETURN
13907: {{MOV{R9{4*CMLBL(SP){{STORE LABEL POINTER
13908: {{BNZ{4*VRLEN(R9){CMP11{{JUMP IF NOT SYSTEM LABEL
13909: {{BNE{4*VRSVP(R9){#V$END{CMP11{JUMP IF NOT END LABEL
13910: *
13911: * HERE FOR END LABEL SCANNED OUT
13912: *
13913: {{ADD{#STGND{STAGE{{ADJUST STAGE APPROPRIATELY
13914: {{JSR{SCANE{{{SCAN OUT NEXT ELEMENT
13915: {{BEQ{R10{#T$SMC{CMP10{JUMP IF END OF IMAGE
13916: {{BNE{R10{#T$VAR{CMP08{ELSE ERROR IF NOT VARIABLE
13917: *
13918: * HERE CHECK FOR VALID INITIAL TRANSFER
13919: *
13920: {{BEQ{4*VRLBL(R9){#STNDL{CMP08{JUMP IF NOT DEFINED (ERROR)
13921: {{MOV{4*VRLBL(R9){4*CMTRA(SP){{ELSE SET INITIAL ENTRY POINTER
13922: {{JSR{SCANE{{{SCAN NEXT ELEMENT
13923: {{BEQ{R10{#T$SMC{CMP10{JUMP IF OK (END OF IMAGE)
13924: *
13925: * HERE FOR BAD TRANSFER LABEL
13926: *
13927: {CMP08{ERB{215{SYNTAX{{ERROR. UNDEFINED OR ERRONEOUS ENTRY LABEL
13928: *
13929: * HERE FOR END OF INPUT (NO END LABEL DETECTED)
13930: *
13931: {CMP09{ADD{#STGND{STAGE{{ADJUST STAGE APPROPRIATELY
13932: {{BEQ{STAGE{#STGXE{CMP10{JUMP IF CODE CALL (OK)
13933: {{ERB{216{SYNTAX{{ERROR. MISSING END LINE
13934: *
13935: * HERE AFTER PROCESSING END LINE (MERGE HERE ON END ERROR)
13936: *
13937: {CMP10{MOV{#OSTP${R6{{SET STOP CALL POINTER
13938: {{JSR{CDWRD{{{GENERATE AS STATEMENT CALL
13939: {{BRN{CMPSE{{{JUMP TO GENERATE AS FAILURE
13940: {{EJC{{{{
13941: *
13942: * CMPIL (CONTINUED)
13943: *
13944: * HERE AFTER PROCESSING LABEL OTHER THAN END
13945: *
13946: {CMP11{BNE{STAGE{#STGIC{CMP12{JUMP IF CODE CALL - REDEF. OK
13947: {{BEQ{4*VRLBL(R9){#STNDL{CMP12{ELSE CHECK FOR REDEFINITION
13948: {{ZER{4*CMLBL(SP){{{LEAVE FIRST LABEL DECLN UNDISTURBED
13949: {{ERB{217{SYNTAX{{ERROR. DUPLICATE LABEL
13950: *
13951: * HERE AFTER DEALING WITH LABEL
13952: *
13953: {CMP12{ZER{R7{{{SET FLAG FOR STATEMENT BODY
13954: {{JSR{EXPAN{{{GET TREE FOR STATEMENT BODY
13955: {{MOV{R9{4*CMSTM(SP){{STORE FOR LATER USE
13956: {{ZER{4*CMSGO(SP){{{CLEAR SUCCESS GOTO POINTER
13957: {{ZER{4*CMFGO(SP){{{CLEAR FAILURE GOTO POINTER
13958: {{ZER{4*CMCGO(SP){{{CLEAR CONDITIONAL GOTO FLAG
13959: {{JSR{SCANE{{{SCAN NEXT ELEMENT
13960: {{BNE{R10{#T$COL{CMP18{JUMP IT NOT COLON (NO GOTO)
13961: *
13962: * LOOP TO PROCESS GOTO FIELDS
13963: *
13964: {CMP13{MNZ{SCNGO{{{SET GOTO FLAG
13965: {{JSR{SCANE{{{SCAN NEXT ELEMENT
13966: {{BEQ{R10{#T$SMC{CMP31{JUMP IF NO FIELDS LEFT
13967: {{BEQ{R10{#T$SGO{CMP14{JUMP IF S FOR SUCCESS GOTO
13968: {{BEQ{R10{#T$FGO{CMP16{JUMP IF F FOR FAILURE GOTO
13969: *
13970: * HERE FOR UNCONDITIONAL GOTO (I.E. NOT F OR S)
13971: *
13972: {{MNZ{SCNRS{{{SET TO RESCAN ELEMENT NOT F,S
13973: {{JSR{SCNGF{{{SCAN OUT GOTO FIELD
13974: {{BNZ{4*CMFGO(SP){CMP17{{ERROR IF FGOTO ALREADY
13975: {{MOV{R9{4*CMFGO(SP){{ELSE SET AS FGOTO
13976: {{BRN{CMP15{{{MERGE WITH SGOTO CIRCUIT
13977: *
13978: * HERE FOR SUCCESS GOTO
13979: *
13980: {CMP14{JSR{SCNGF{{{SCAN SUCCESS GOTO FIELD
13981: {{MOV{#NUM01{4*CMCGO(SP){{SET CONDITIONAL GOTO FLAG
13982: *
13983: * UNCONTIONAL GOTO MERGES HERE
13984: *
13985: {CMP15{BNZ{4*CMSGO(SP){CMP17{{ERROR IF SGOTO ALREADY GIVEN
13986: {{MOV{R9{4*CMSGO(SP){{ELSE SET SGOTO
13987: {{BRN{CMP13{{{LOOP BACK FOR NEXT GOTO FIELD
13988: *
13989: * HERE FOR FAILURE GOTO
13990: *
13991: {CMP16{JSR{SCNGF{{{SCAN GOTO FIELD
13992: {{MOV{#NUM01{4*CMCGO(SP){{SET CONDITONAL GOTO FLAG
13993: {{BNZ{4*CMFGO(SP){CMP17{{ERROR IF FGOTO ALREADY GIVEN
13994: {{MOV{R9{4*CMFGO(SP){{ELSE STORE FGOTO POINTER
13995: {{BRN{CMP13{{{LOOP BACK FOR NEXT FIELD
13996: {{EJC{{{{
13997: *
13998: * CMPIL (CONTINUED)
13999: *
14000: * HERE FOR DUPLICATED GOTO FIELD
14001: *
14002: {CMP17{ERB{218{SYNTAX{{ERROR. DUPLICATED GOTO FIELD
14003: *
14004: * HERE TO GENERATE CODE
14005: *
14006: {CMP18{ZER{SCNSE{{{STOP POSITIONAL ERROR FLAGS
14007: {{MOV{4*CMSTM(SP){R9{{LOAD TREE PTR FOR STATEMENT BODY
14008: {{ZER{R7{{{COLLECTABLE VALUE FOR WB FOR CDGVL
14009: {{ZER{R8{{{RESET CONSTANT FLAG FOR CDGVL
14010: {{JSR{EXPAP{{{TEST FOR PATTERN MATCH
14011: {{PPM{CMP19{{{JUMP IF NOT PATTERN MATCH
14012: {{MOV{#OPMS${4*CMOPN(R9){{ELSE SET PATTERN MATCH POINTER
14013: {{MOV{#C$PMT{4*CMTYP(R9){{
14014: *
14015: * HERE AFTER DEALING WITH SPECIAL PATTERN MATCH CASE
14016: *
14017: {CMP19{JSR{CDGVL{{{GENERATE CODE FOR BODY OF STATEMENT
14018: {{MOV{4*CMSGO(SP){R9{{LOAD SGOTO POINTER
14019: {{MOV{R9{R6{{COPY IT
14020: {{BZE{R9{CMP21{{JUMP IF NO SUCCESS GOTO
14021: {{ZER{4*CMSOC(SP){{{CLEAR SUCCESS OFFSET FILLIN PTR
14022: {{BHI{R9{STATE{CMP20{JUMP IF COMPLEX GOTO
14023: *
14024: * HERE FOR SIMPLE SUCCESS GOTO (LABEL)
14025: *
14026: {{ADD{#4*VRTRA{R6{{POINT TO VRTRA FIELD AS REQUIRED
14027: {{JSR{CDWRD{{{GENERATE SUCCESS GOTO
14028: {{BRN{CMP22{{{JUMP TO DEAL WITH FGOTO
14029: *
14030: * HERE FOR COMPLEX SUCCESS GOTO
14031: *
14032: {CMP20{BEQ{R9{4*CMFGO(SP){CMP22{NO CODE IF SAME AS FGOTO
14033: {{ZER{R7{{{ELSE SET OK VALUE FOR CDGVL IN WB
14034: {{JSR{CDGCG{{{GENERATE CODE FOR SUCCESS GOTO
14035: {{BRN{CMP22{{{JUMP TO DEAL WITH FGOTO
14036: *
14037: * HERE FOR NO SUCCESS GOTO
14038: *
14039: {CMP21{MOV{CWCOF{4*CMSOC(SP){{SET SUCCESS FILL IN OFFSET
14040: {{MOV{#OCER${R6{{POINT TO COMPILE ERROR CALL
14041: {{JSR{CDWRD{{{GENERATE AS TEMPORARY VALUE
14042: {{EJC{{{{
14043: *
14044: * CMPIL (CONTINUED)
14045: *
14046: * HERE TO DEAL WITH FAILURE GOTO
14047: *
14048: {CMP22{MOV{4*CMFGO(SP){R9{{LOAD FAILURE GOTO POINTER
14049: {{MOV{R9{R6{{COPY IT
14050: {{ZER{4*CMFFC(SP){{{SET NO FILL IN REQUIRED YET
14051: {{BZE{R9{CMP23{{JUMP IF NO FAILURE GOTO GIVEN
14052: {{ADD{#4*VRTRA{R6{{POINT TO VRTRA FIELD IN CASE
14053: {{BLO{R9{STATE{CMPSE{JUMP TO GEN IF SIMPLE FGOTO
14054: *
14055: * HERE FOR COMPLEX FAILURE GOTO
14056: *
14057: {{MOV{CWCOF{R7{{SAVE OFFSET TO O$GOF CALL
14058: {{MOV{#OGOF${R6{{POINT TO FAILURE GOTO CALL
14059: {{JSR{CDWRD{{{GENERATE
14060: {{MOV{#OFIF${R6{{POINT TO FAIL IN FAIL WORD
14061: {{JSR{CDWRD{{{GENERATE
14062: {{JSR{CDGCG{{{GENERATE CODE FOR FAILURE GOTO
14063: {{MOV{R7{R6{{COPY OFFSET TO O$GOF FOR CDFAL
14064: {{MOV{#B$CDC{R7{{SET COMPLEX CASE CDTYP
14065: {{BRN{CMP25{{{JUMP TO BUILD CDBLK
14066: *
14067: * HERE IF NO FAILURE GOTO GIVEN
14068: *
14069: {CMP23{MOV{#OUNF${R6{{LOAD UNEXPECTED FAILURE CALL IN CAS
14070: {{MOV{CSWFL{R8{{GET -NOFAIL FLAG
14071: {{ORB{4*CMCGO(SP){R8{{CHECK IF CONDITIONAL GOTO
14072: {{ZRB{R8{CMPSE{{JUMP IF -NOFAIL AND NO COND. GOTO
14073: {{MNZ{4*CMFFC(SP){{{ELSE SET FILL IN FLAG
14074: {{MOV{#OCER${R6{{AND SET COMPILE ERROR FOR TEMPORARY
14075: *
14076: * MERGE HERE WITH CDFAL VALUE IN WA, SIMPLE CDBLK
14077: * ALSO SPECIAL ENTRY AFTER STATEMENT ERROR
14078: *
14079: {CMPSE{MOV{#B$CDS{R7{{SET CDTYP FOR SIMPLE CASE
14080: {{EJC{{{{
14081: *
14082: * CMPIL (CONTINUED)
14083: *
14084: * MERGE HERE TO BUILD CDBLK
14085: *
14086: * (WA) CDFAL VALUE TO BE GENERATED
14087: * (WB) CDTYP VALUE TO BE GENERATED
14088: *
14089: * AT THIS STAGE, WE CHOP OFF AN APPROPRIATE CHUNK OF THE
14090: * CURRENT CCBLK AND CONVERT IT INTO A CDBLK. THE REMAINDER
14091: * OF THE CCBLK IS REFORMATTED TO BE THE NEW CCBLK.
14092: *
14093: {CMP25{MOV{R$CCB{R9{{POINT TO CCBLK
14094: {{MOV{4*CMLBL(SP){R10{{GET POSSIBLE LABEL POINTER
14095: {{BZE{R10{CMP26{{SKIP IF NO LABEL
14096: {{ZER{4*CMLBL(SP){{{CLEAR FLAG FOR NEXT STATEMENT
14097: {{MOV{R9{4*VRLBL(R10){{PUT CDBLK PTR IN VRBLK LABEL FIELD
14098: *
14099: * MERGE AFTER DOING LABEL
14100: *
14101: {CMP26{MOV{R7{(R9){{SET TYPE WORD FOR NEW CDBLK
14102: {{MOV{R6{4*CDFAL(R9){{SET FAILURE WORD
14103: {{MOV{R9{R10{{COPY POINTER TO CCBLK
14104: {{MOV{4*CCUSE(R9){R7{{LOAD LENGTH GEN (= NEW CDLEN)
14105: {{MOV{4*CCLEN(R9){R8{{LOAD TOTAL CCBLK LENGTH
14106: {{ADD{R7{R10{{POINT PAST CDBLK
14107: {{SUB{R7{R8{{GET LENGTH LEFT FOR CHOP OFF
14108: {{MOV{#B$CCT{(R10){{SET TYPE CODE FOR NEW CCBLK AT END
14109: {{MOV{#4*CCCOD{4*CCUSE(R10){{SET INITIAL CODE OFFSET
14110: {{MOV{#4*CCCOD{CWCOF{{REINITIALISE CWCOF
14111: {{MOV{R8{4*CCLEN(R10){{SET NEW LENGTH
14112: {{MOV{R10{R$CCB{{SET NEW CCBLK POINTER
14113: {{MOV{CMPSN{4*CDSTM(R9){{SET STATEMENT NUMBER
14114: {{ICV{CMPSN{{{BUMP STATEMENT NUMBER
14115: *
14116: * SET POINTERS IN PREVIOUS CODE BLOCK AS REQUIRED
14117: *
14118: {{MOV{4*CMPCD(SP){R10{{LOAD PTR TO PREVIOUS CDBLK
14119: {{BZE{4*CMFFP(SP){CMP27{{JUMP IF NO FAILURE FILL IN REQUIRED
14120: {{MOV{R9{4*CDFAL(R10){{ELSE SET FAILURE PTR IN PREVIOUS
14121: *
14122: * HERE TO DEAL WITH SUCCESS FORWARD POINTER
14123: *
14124: {CMP27{MOV{4*CMSOP(SP){R6{{LOAD SUCCESS OFFSET
14125: {{BZE{R6{CMP28{{JUMP IF NO FILL IN REQUIRED
14126: {{ADD{R6{R10{{ELSE POINT TO FILL IN LOCATION
14127: {{MOV{R9{(R10){{STORE FORWARD POINTER
14128: {{ZER{R10{{{CLEAR GARBAGE XL VALUE
14129: {{EJC{{{{
14130: *
14131: * CMPIL (CONTINUED)
14132: *
14133: * NOW SET FILL IN POINTERS FOR THIS STATEMENT
14134: *
14135: {CMP28{MOV{4*CMFFC(SP){4*CMFFP(SP){{COPY FAILURE FILL IN FLAG
14136: {{MOV{4*CMSOC(SP){4*CMSOP(SP){{COPY SUCCESS FILL IN OFFSET
14137: {{MOV{R9{4*CMPCD(SP){{SAVE PTR TO THIS CDBLK
14138: {{BNZ{4*CMTRA(SP){CMP29{{JUMP IF INITIAL ENTRY ALREADY SET
14139: {{MOV{R9{4*CMTRA(SP){{ELSE SET PTR HERE AS DEFAULT
14140: *
14141: * HERE AFTER COMPILING ONE STATEMENT
14142: *
14143: {CMP29{BLT{STAGE{#STGCE{CMP01{JUMP IF NOT END LINE JUST DONE
14144: {{BZE{CSWLS{CMP30{{SKIP IF -NOLIST
14145: {{JSR{LISTR{{{LIST LAST LINE
14146: *
14147: * RETURN
14148: *
14149: {CMP30{MOV{4*CMTRA(SP){R9{{LOAD INITIAL ENTRY CDBLK POINTER
14150: {{ADD{#4*CMNEN{SP{{POP WORK LOCATIONS OFF STACK
14151: {{EXI{{{{AND RETURN TO CMPIL CALLER
14152: *
14153: * HERE AT END OF GOTO FIELD
14154: *
14155: {CMP31{MOV{4*CMFGO(SP){R7{{GET FAIL GOTO
14156: {{ORB{4*CMSGO(SP){R7{{OR IN SUCCESS GOTO
14157: {{BNZ{R7{CMP18{{OK IF NON-NULL FIELD
14158: {{ERB{219{SYNTAX{{ERROR. EMPTY GOTO FIELD
14159: *
14160: * CONTROL CARD FOUND
14161: *
14162: {CMP32{ICV{R7{{{POINT PAST CH$MN
14163: {{JSR{CNCRD{{{PROCESS CONTROL CARD
14164: {{ZER{SCNSE{{{CLEAR START OF ELEMENT LOC.
14165: {{BRN{CMPCE{{{LOOP FOR NEXT STATEMENT
14166: {{ENP{{{{END PROCEDURE CMPIL
14167: {{EJC{{{{
14168: *
14169: * CNCRD -- CONTROL CARD PROCESSOR
14170: *
14171: * CALLED TO DEAL WITH CONTROL CARDS
14172: *
14173: * R$CIM POINTS TO CURRENT IMAGE
14174: * (WB) OFFSET TO 1ST CHAR OF CONTROL CARD
14175: * JSR CNCRD CALL TO PROCESS CONTROL CARDS
14176: * (XL,XR,WA,WB,WC,IA) DESTROYED
14177: *
14178: {CNCRD{PRC{E{0{{ENTRY POINT
14179: {{MOV{R7{SCNPT{{OFFSET FOR CONTROL CARD SCAN
14180: {{MOV{#CCNOC{R6{{NUMBER OF CHARS FOR COMPARISON
14181: {{CTW{R6{0{{CONVERT TO WORD COUNT
14182: {{MOV{R6{CNSWC{{SAVE WORD COUNT
14183: *
14184: * LOOP HERE IF MORE THAN ONE CONTROL CARD
14185: *
14186: {CNC01{BGE{SCNPT{SCNIL{CNC09{RETURN IF END OF IMAGE
14187: {{MOV{R$CIM{R9{{POINT TO IMAGE
14188: {{PLC{R9{SCNPT{{CHAR PTR FOR FIRST CHAR
14189: {{LCH{R6{(R9)+{{GET FIRST CHAR
14190: {{FLC{R6{{{FOLD TO UPPER CASE
14191: {{BEQ{R6{#CH$LI{CNC07{SPECIAL CASE OF -INXXX
14192: {{MNZ{SCNCC{{{SET FLAG FOR SCANE
14193: {{JSR{SCANE{{{SCAN CARD NAME
14194: {{ZER{SCNCC{{{CLEAR SCANE FLAG
14195: {{BNZ{R10{CNC06{{FAIL UNLESS CONTROL CARD NAME
14196: {{MOV{#CCNOC{R6{{NO. OF CHARS TO BE COMPARED
14197: {{BLT{4*SCLEN(R9){R6{CNC06{FAIL IF TOO FEW CHARS
14198: {{MOV{R9{R10{{POINT TO CONTROL CARD NAME
14199: {{ZER{R7{{{ZERO OFFSET FOR SUBSTRING
14200: {{JSR{SBSTR{{{EXTRACT SUBSTRING FOR COMPARISON
14201: {{MOV{4*SCLEN(R9){R6{{RELOAD LENGTH
14202: {{JSR{FLSTG{{{FOLD TO UPPER CASE
14203: {{MOV{R9{CNSCC{{KEEP CONTROL CARD SUBSTRING PTR
14204: {{MOV{#CCNMS{R9{{POINT TO LIST OF STANDARD NAMES
14205: {{ZER{R7{{{INITIALISE NAME OFFSET
14206: {{LCT{R8{#CC$NC{{NUMBER OF STANDARD NAMES
14207: *
14208: * TRY TO MATCH NAME
14209: *
14210: {CNC02{MOV{CNSCC{R10{{POINT TO NAME
14211: {{LCT{R6{CNSWC{{COUNTER FOR INNER LOOP
14212: {{BRN{CNC04{{{JUMP INTO LOOP
14213: *
14214: * INNER LOOP TO MATCH CARD NAME CHARS
14215: *
14216: {CNC03{ICA{R9{{{BUMP STANDARD NAMES PTR
14217: {{ICA{R10{{{BUMP NAME POINTER
14218: *
14219: * HERE TO INITIATE THE LOOP
14220: *
14221: {CNC04{CNE{4*SCHAR(R10){(R9){CNC05{COMP. UP TO CFP$C CHARS AT ONCE
14222: {{BCT{R6{CNC03{{LOOP IF MORE WORDS TO COMPARE
14223: {{EJC{{{{
14224: *
14225: * CNCRD (CONTINUED)
14226: *
14227: * MATCHED - BRANCH ON CARD OFFSET
14228: *
14229: {{MOV{R7{R10{{GET NAME OFFSET
14230: {{BSW{R10{CC$NC{{SWITCH
14231: {{IFF{CC$CA{CNC37{{-CASE
14232: {{IFF{CC$DO{CNC10{{-DOUBLE
14233: {{IFF{CC$DU{CNC11{{-DUMP
14234: {{IFF{CC$EJ{CNC12{{-EJECT
14235: {{IFF{CC$ER{CNC13{{-ERRORS
14236: {{IFF{CC$EX{CNC14{{-EXECUTE
14237: {{IFF{CC$FA{CNC15{{-FAIL
14238: {{IFF{CC$LI{CNC16{{-LIST
14239: {{IFF{CC$NR{CNC17{{-NOERRORS
14240: {{IFF{CC$NX{CNC18{{-NOEXECUTE
14241: {{IFF{CC$NF{CNC19{{-NOFAIL
14242: {{IFF{CC$NL{CNC20{{-NOLIST
14243: {{IFF{CC$NO{CNC21{{-NOOPT
14244: {{IFF{CC$NP{CNC22{{-NOPRINT
14245: {{IFF{CC$OP{CNC24{{-OPTIMISE
14246: {{IFF{CC$PR{CNC25{{-PRINT
14247: {{IFF{CC$SI{CNC27{{-SINGLE
14248: {{IFF{CC$SP{CNC28{{-SPACE
14249: {{IFF{CC$ST{CNC31{{-STITLE
14250: {{IFF{CC$TI{CNC32{{-TITLE
14251: {{IFF{CC$TR{CNC36{{-TRACE
14252: {{ESW{{{{END SWITCH
14253: *
14254: * NOT MATCHED YET. ALIGN STD NAMES PTR AND TRY AGAIN
14255: *
14256: {CNC05{ICA{R9{{{BUMP STANDARD NAMES PTR
14257: {{BCT{R6{CNC05{{LOOP
14258: {{ICV{R7{{{BUMP NAMES OFFSET
14259: {{BCT{R8{CNC02{{CONTINUE IF MORE NAMES
14260: *
14261: * INVALID CONTROL CARD NAME
14262: *
14263: {CNC06{ERB{247{INVALID{{CONTROL CARD
14264: *
14265: * SPECIAL PROCESSING FOR -INXXX
14266: *
14267: {CNC07{LCH{R6{(R9){{GET NEXT CHAR
14268: {{FLC{R6{{{FOLD TO UPPER CASE
14269: {{BNE{R6{#CH$LN{CNC06{FAIL IF NOT LETTER N
14270: {{ADD{#NUM02{SCNPT{{BUMP OFFSET PAST -IN
14271: {{JSR{SCANE{{{SCAN INTEGER AFTER -IN
14272: {{MOV{R9{-(SP){{STACK SCANNED ITEM
14273: {{JSR{GTSMI{{{CHECK IF INTEGER
14274: {{PPM{CNC06{{{FAIL IF NOT INTEGER
14275: {{PPM{CNC06{{{FAIL IF NEGATIVE OR LARGE
14276: {{MOV{R9{CSWIN{{KEEP INTEGER
14277: {{EJC{{{{
14278: *
14279: * CNCRD (CONTINUED)
14280: *
14281: * CHECK FOR MORE CONTROL CARDS BEFORE RETURNING
14282: *
14283: {CNC08{MOV{SCNPT{R6{{PRESERVE IN CASE XEQ TIME COMPILE
14284: {{JSR{SCANE{{{LOOK FOR COMMA
14285: {{BEQ{R10{#T$CMA{CNC01{LOOP IF COMMA FOUND
14286: {{MOV{R6{SCNPT{{RESTORE SCNPT IN CASE XEQ TIME
14287: *
14288: * RETURN POINT
14289: *
14290: {CNC09{EXI{{{{RETURN
14291: *
14292: * -DOUBLE
14293: *
14294: {CNC10{MNZ{CSWDB{{{SET SWITCH
14295: {{BRN{CNC08{{{MERGE
14296: *
14297: * -DUMP
14298: * THIS IS USED FOR SYSTEM DEBUGGING . IT HAS THE EFFECT OF
14299: * PRODUCING A CORE DUMP AT COMPILATION TIME
14300: *
14301: {CNC11{JSR{SYSDM{{{CALL DUMPER
14302: {{BRN{CNC09{{{FINISHED
14303: *
14304: * -EJECT
14305: *
14306: {CNC12{BZE{CSWLS{CNC09{{RETURN IF -NOLIST
14307: {{JSR{PRTPS{{{EJECT
14308: {{JSR{LISTT{{{LIST TITLE
14309: {{BRN{CNC09{{{FINISHED
14310: *
14311: * -ERRORS
14312: *
14313: {CNC13{ZER{CSWER{{{CLEAR SWITCH
14314: {{BRN{CNC08{{{MERGE
14315: *
14316: * -EXECUTE
14317: *
14318: {CNC14{ZER{CSWEX{{{CLEAR SWITCH
14319: {{BRN{CNC08{{{MERGE
14320: *
14321: * -FAIL
14322: *
14323: {CNC15{MNZ{CSWFL{{{SET SWITCH
14324: {{BRN{CNC08{{{MERGE
14325: *
14326: * -LIST
14327: *
14328: {CNC16{MNZ{CSWLS{{{SET SWITCH
14329: {{BEQ{STAGE{#STGIC{CNC08{DONE IF COMPILE TIME
14330: *
14331: * LIST CODE LINE IF EXECUTE TIME COMPILE
14332: *
14333: {{ZER{LSTPF{{{PERMIT LISTING
14334: {{JSR{LISTR{{{LIST LINE
14335: {{BRN{CNC08{{{MERGE
14336: {{EJC{{{{
14337: *
14338: * CNCRD (CONTINUED)
14339: *
14340: * -NOERRORS
14341: *
14342: {CNC17{MNZ{CSWER{{{SET SWITCH
14343: {{BRN{CNC08{{{MERGE
14344: *
14345: * -NOEXECUTE
14346: *
14347: {CNC18{MNZ{CSWEX{{{SET SWITCH
14348: {{BRN{CNC08{{{MERGE
14349: *
14350: * -NOFAIL
14351: *
14352: {CNC19{ZER{CSWFL{{{CLEAR SWITCH
14353: {{BRN{CNC08{{{MERGE
14354: *
14355: * -NOLIST
14356: *
14357: {CNC20{ZER{CSWLS{{{CLEAR SWITCH
14358: {{BRN{CNC08{{{MERGE
14359: *
14360: * -NOOPTIMISE
14361: *
14362: {CNC21{MNZ{CSWNO{{{SET SWITCH
14363: {{BRN{CNC08{{{MERGE
14364: *
14365: * -NOPRINT
14366: *
14367: {CNC22{ZER{CSWPR{{{CLEAR SWITCH
14368: {{BRN{CNC08{{{MERGE
14369: *
14370: * -OPTIMISE
14371: *
14372: {CNC24{ZER{CSWNO{{{CLEAR SWITCH
14373: {{BRN{CNC08{{{MERGE
14374: *
14375: * -PRINT
14376: *
14377: {CNC25{MNZ{CSWPR{{{SET SWITCH
14378: {{BRN{CNC08{{{MERGE
14379: {{EJC{{{{
14380: *
14381: * CNCRD (CONTINUED)
14382: *
14383: * -SINGLE
14384: *
14385: {CNC27{ZER{CSWDB{{{CLEAR SWITCH
14386: {{BRN{CNC08{{{MERGE
14387: *
14388: * -SPACE
14389: *
14390: {CNC28{BZE{CSWLS{CNC09{{RETURN IF -NOLIST
14391: {{JSR{SCANE{{{SCAN INTEGER AFTER -SPACE
14392: {{MOV{#NUM01{R8{{1 SPACE IN CASE
14393: {{BEQ{R9{#T$SMC{CNC29{JUMP IF NO INTEGER
14394: {{MOV{R9{-(SP){{STACK IT
14395: {{JSR{GTSMI{{{CHECK INTEGER
14396: {{PPM{CNC06{{{FAIL IF NOT INTEGER
14397: {{PPM{CNC06{{{FAIL IF NEGATIVE OR LARGE
14398: {{BNZ{R8{CNC29{{JUMP IF NON ZERO
14399: {{MOV{#NUM01{R8{{ELSE 1 SPACE
14400: *
14401: * MERGE WITH COUNT OF LINES TO SKIP
14402: *
14403: {CNC29{ADD{R8{LSTLC{{BUMP LINE COUNT
14404: {{LCT{R8{R8{{CONVERT TO LOOP COUNTER
14405: {{BLT{LSTLC{LSTNP{CNC30{JUMP IF FITS ON PAGE
14406: {{JSR{PRTPS{{{EJECT
14407: {{JSR{LISTT{{{LIST TITLE
14408: {{BRN{CNC09{{{MERGE
14409: *
14410: * SKIP LINES
14411: *
14412: {CNC30{JSR{PRTNL{{{PRINT A BLANK
14413: {{BCT{R8{CNC30{{LOOP
14414: {{BRN{CNC09{{{MERGE
14415: {{EJC{{{{
14416: *
14417: * CNCRD (CONTINUED)
14418: *
14419: * -STITL
14420: *
14421: {CNC31{MOV{#R$STL{CNR$T{{PTR TO R$STL
14422: {{BRN{CNC33{{{MERGE
14423: *
14424: * -TITLE
14425: *
14426: {CNC32{MOV{#NULLS{R$STL{{CLEAR SUBTITLE
14427: {{MOV{#R$TTL{CNR$T{{PTR TO R$TTL
14428: *
14429: * COMMON PROCESSING FOR -TITLE, -STITL
14430: *
14431: {CNC33{MOV{#NULLS{R9{{NULL IN CASE NEEDED
14432: {{MNZ{CNTTL{{{SET FLAG FOR NEXT LISTR CALL
14433: {{MOV{#CCOFS{R7{{OFFSET TO TITLE/SUBTITLE
14434: {{MOV{SCNIL{R6{{INPUT IMAGE LENGTH
14435: {{BLO{R6{R7{CNC34{JUMP IF NO CHARS LEFT
14436: {{SUB{R7{R6{{NO OF CHARS TO EXTRACT
14437: {{MOV{R$CIM{R10{{POINT TO IMAGE
14438: {{JSR{SBSTR{{{GET TITLE/SUBTITLE
14439: *
14440: * STORE TITLE/SUBTITLE
14441: *
14442: {CNC34{MOV{CNR$T{R10{{POINT TO STORAGE LOCATION
14443: {{MOV{R9{(R10){{STORE TITLE/SUBTITLE
14444: {{BEQ{R10{#R$STL{CNC09{RETURN IF STITL
14445: {{BNZ{PRECL{CNC09{{RETURN IF EXTENDED LISTING
14446: {{BZE{PRICH{CNC09{{RETURN IF REGULAR PRINTER
14447: {{MOV{4*SCLEN(R9){R10{{GET LENGTH OF TITLE
14448: {{MOV{R10{R6{{COPY IT
14449: {{BZE{R10{CNC35{{JUMP IF NULL
14450: {{ADD{#NUM10{R10{{INCREMENT
14451: {{BHI{R10{PRLEN{CNC09{USE DEFAULT LSTP0 VAL IF TOO LONG
14452: {{ADD{#NUM04{R6{{POINT JUST PAST TITLE
14453: *
14454: * STORE OFFSET TO PAGE NN MESSAGE FOR SHORT TITLE
14455: *
14456: {CNC35{MOV{R6{LSTPO{{STORE OFFSET
14457: {{BRN{CNC09{{{RETURN
14458: *
14459: * -TRACE
14460: * PROVIDED FOR SYSTEM DEBUGGING. TOGGLES THE SYSTEM LABEL
14461: * TRACE SWITCH AT COMPILE TIME
14462: *
14463: {CNC36{JSR{SYSTT{{{TOGGLE SWITCH
14464: {{BRN{CNC08{{{MERGE
14465: *
14466: * -CASE
14467: * SETS VALUE OF KVCAS SO THAT NAMES ARE FOLDED OR NOT
14468: * DURING COMPILATION.
14469: *
14470: {CNC37{JSR{SCANE{{{SCAN INTEGER AFTER -CASE
14471: {{ZER{R8{{{GET 0 IN CASE NONE THERE
14472: {{BEQ{R10{#T$SMC{CNC38{SKIP IF NO INTEGER
14473: {{MOV{R9{-(SP){{STACK IT
14474: {{JSR{GTSMI{{{CHECK INTEGER
14475: {{PPM{CNC06{{{FAIL IF NOT INTEGER
14476: {{PPM{CNC06{{{FAIL IF NEGATIVE OR TOO LARGE
14477: {CNC38{MOV{R8{KVCAS{{STORE NEW CASE VALUE
14478: {{BRN{CNC09{{{MERGE
14479: {{ENP{{{{END PROCEDURE CNCRD
14480: {{EJC{{{{
14481: *
14482: * DFFNC -- DEFINE FUNCTION
14483: *
14484: * DFFNC IS CALLED WHENEVER A NEW FUNCTION IS ASSIGNED TO
14485: * A VARIABLE. IT DEALS WITH EXTERNAL FUNCTION USE COUNTS.
14486: *
14487: * (XR) POINTER TO VRBLK
14488: * (XL) POINTER TO NEW FUNCTION BLOCK
14489: * JSR DFFNC CALL TO DEFINE FUNCTION
14490: * (WA,WB) DESTROYED
14491: *
14492: {DFFNC{PRC{E{0{{ENTRY POINT
14493: {{BNE{(R10){#B$EFC{DFFN1{SKIP IF NEW FUNCTION NOT EXTERNAL
14494: {{ICV{4*EFUSE(R10){{{ELSE INCREMENT ITS USE COUNT
14495: *
14496: * HERE AFTER DEALING WITH NEW FUNCTION USE COUNT
14497: *
14498: {DFFN1{MOV{R9{R6{{SAVE VRBLK POINTER
14499: {{MOV{4*VRFNC(R9){R9{{LOAD OLD FUNCTION POINTER
14500: {{BNE{(R9){#B$EFC{DFFN2{JUMP IF OLD FUNCTION NOT EXTERNAL
14501: {{MOV{4*EFUSE(R9){R7{{ELSE GET USE COUNT
14502: {{DCV{R7{{{DECREMENT
14503: {{MOV{R7{4*EFUSE(R9){{STORE DECREMENTED VALUE
14504: {{BNZ{R7{DFFN2{{JUMP IF USE COUNT STILL NON-ZERO
14505: {{JSR{SYSUL{{{ELSE CALL SYSTEM UNLOAD FUNCTION
14506: *
14507: * HERE AFTER DEALING WITH OLD FUNCTION USE COUNT
14508: *
14509: {DFFN2{MOV{R6{R9{{RESTORE VRBLK POINTER
14510: {{MOV{R10{R6{{COPY FUNCTION BLOCK PTR
14511: {{BLT{R9{#R$YYY{DFFN3{SKIP CHECKS IF OPSYN OP DEFINITION
14512: {{BNZ{4*VRLEN(R9){DFFN3{{JUMP IF NOT SYSTEM VARIABLE
14513: *
14514: * FOR SYSTEM VARIABLE, CHECK FOR ILLEGAL REDEFINITION
14515: *
14516: {{MOV{4*VRSVP(R9){R10{{POINT TO SVBLK
14517: {{MOV{4*SVBIT(R10){R7{{LOAD BIT INDICATORS
14518: {{ANB{BTFNC{R7{{IS IT A SYSTEM FUNCTION
14519: {{ZRB{R7{DFFN3{{REDEF OK IF NOT
14520: {{ERB{248{ATTEMPTED{{REDEFINITION OF SYSTEM FUNCTION
14521: *
14522: * HERE IF REDEFINITION IS PERMITTED
14523: *
14524: {DFFN3{MOV{R6{4*VRFNC(R9){{STORE NEW FUNCTION POINTER
14525: {{MOV{R6{R10{{RESTORE FUNCTION BLOCK POINTER
14526: {{EXI{{{{RETURN TO DFFNC CALLER
14527: {{ENP{{{{END PROCEDURE DFFNC
14528: {{EJC{{{{
14529: *
14530: * DTACH -- DETACH I/O ASSOCIATED NAMES
14531: *
14532: * DETACHES TRBLKS FROM I/O ASSOCIATED VARIABLES, REMOVES
14533: * ENTRY FROM IOCHN CHAIN ATTACHED TO FILEARG1 VRBLK AND MAY
14534: * REMOVE VRBLK ACCESS AND STORE TRAPS.
14535: * INPUT, OUTPUT, TERMINAL ARE HANDLED SPECIALLY.
14536: *
14537: * (XL) I/O ASSOC. VBL NAME BASE PTR
14538: * (WA) OFFSET TO NAME
14539: * JSR DTACH CALL FOR DETACH OPERATION
14540: * (XL,XR,WA,WB,WC) DESTROYED
14541: *
14542: {DTACH{PRC{E{0{{ENTRY POINT
14543: {{MOV{R10{DTCNB{{STORE NAME BASE (GBCOL NOT CALLED)
14544: {{ADD{R6{R10{{POINT TO NAME LOCATION
14545: {{MOV{R10{DTCNM{{STORE IT
14546: *
14547: * LOOP TO SEARCH FOR I/O TRBLK
14548: *
14549: {DTCH1{MOV{R10{R9{{COPY NAME POINTER
14550: *
14551: * CONTINUE AFTER BLOCK DELETION
14552: *
14553: {DTCH2{MOV{(R10){R10{{POINT TO NEXT VALUE
14554: {{BNE{(R10){#B$TRT{DTCH6{JUMP AT CHAIN END
14555: {{MOV{4*TRTYP(R10){R6{{GET TRAP BLOCK TYPE
14556: {{BEQ{R6{#TRTIN{DTCH3{JUMP IF INPUT
14557: {{BEQ{R6{#TRTOU{DTCH3{JUMP IF OUTPUT
14558: {{ADD{#4*TRNXT{R10{{POINT TO NEXT LINK
14559: {{BRN{DTCH1{{{LOOP
14560: *
14561: * DELETE AN OLD ASSOCIATION
14562: *
14563: {DTCH3{MOV{4*TRVAL(R10){(R9){{DELETE TRBLK
14564: {{MOV{R10{R6{{DUMP XL ...
14565: {{MOV{R9{R7{{... AND XR
14566: {{MOV{4*TRTRF(R10){R10{{POINT TO TRTRF TRAP BLOCK
14567: {{BZE{R10{DTCH5{{JUMP IF NO IOCHN
14568: {{BNE{(R10){#B$TRT{DTCH5{JUMP IF INPUT, OUTPUT, TERMINAL
14569: *
14570: * LOOP TO SEARCH IOCHN CHAIN FOR NAME PTR
14571: *
14572: {DTCH4{MOV{R10{R9{{REMEMBER LINK PTR
14573: {{MOV{4*TRTRF(R10){R10{{POINT TO NEXT LINK
14574: {{BZE{R10{DTCH5{{JUMP IF END OF CHAIN
14575: {{MOV{4*IONMB(R10){R8{{GET NAME BASE
14576: {{ADD{4*IONMO(R10){R8{{ADD OFFSET
14577: {{BNE{R8{DTCNM{DTCH4{LOOP IF NO MATCH
14578: {{MOV{4*TRTRF(R10){4*TRTRF(R9){{REMOVE NAME FROM CHAIN
14579: {{EJC{{{{
14580: *
14581: * DTACH (CONTINUED)
14582: *
14583: * PREPARE TO RESUME I/O TRBLK SCAN
14584: *
14585: {DTCH5{MOV{R6{R10{{RECOVER XL ...
14586: {{MOV{R7{R9{{... AND XR
14587: {{ADD{#4*TRVAL{R10{{POINT TO VALUE FIELD
14588: {{BRN{DTCH2{{{CONTINUE
14589: *
14590: * EXIT POINT
14591: *
14592: {DTCH6{MOV{DTCNB{R9{{POSSIBLE VRBLK PTR
14593: {{JSR{SETVR{{{RESET VRBLK IF NECESSARY
14594: {{EXI{{{{RETURN
14595: {{ENP{{{{END PROCEDURE DTACH
14596: {{EJC{{{{
14597: *
14598: * DTYPE -- GET DATATYPE NAME
14599: *
14600: * (XR) OBJECT WHOSE DATATYPE IS REQUIRED
14601: * JSR DTYPE CALL TO GET DATATYPE
14602: * (XR) RESULT DATATYPE
14603: *
14604: {DTYPE{PRC{E{0{{ENTRY POINT
14605: {{BEQ{(R9){#B$PDT{DTYP1{JUMP IF PROG.DEFINED
14606: {{MOV{(R9){R9{{LOAD TYPE WORD
14607: {{LEI{R9{{{GET ENTRY POINT ID (BLOCK CODE)
14608: {{WTB{R9{{{CONVERT TO BYTE OFFSET
14609: {{MOV{L^SCNMT(R9){R9{{LOAD TABLE ENTRY
14610: {{EXI{{{{EXIT TO DTYPE CALLER
14611: *
14612: * HERE IF PROGRAM DEFINED
14613: *
14614: {DTYP1{MOV{4*PDDFP(R9){R9{{POINT TO DFBLK
14615: {{MOV{4*DFNAM(R9){R9{{GET DATATYPE NAME FROM DFBLK
14616: {{EXI{{{{RETURN TO DTYPE CALLER
14617: {{ENP{{{{END PROCEDURE DTYPE
14618: {{EJC{{{{
14619: *
14620: * DUMPR -- PRINT DUMP OF STORAGE
14621: *
14622: * (XR) DUMP ARGUMENT (SEE BELOW)
14623: * JSR DUMPR CALL TO PRINT DUMP
14624: * (XR,XL) DESTROYED
14625: * (WA,WB,WC,RA) DESTROYED
14626: *
14627: * THE DUMP ARGUMENT HAS THE FOLLOWING SIGNIFICANCE
14628: *
14629: * DMARG = 0 NO DUMP PRINTED
14630: * DMARG = 1 PARTIAL DUMP (NAT VARS, KEYWORDS)
14631: * DMARG EQ 2 FULL DUMP (INCL ARRAYS ETC.)
14632: * DMARG GE 3 CORE DUMP
14633: *
14634: * SINCE DUMPR SCRAMBLES STORE, IT IS NOT PERMISSIBLE TO
14635: * COLLECT IN MID-DUMP. HENCE A COLLECT IS DONE INITIALLY
14636: * AND THEN IF STORE RUNS OUT AN ERROR MESSAGE IS PRODUCED.
14637: *
14638: {DUMPR{PRC{E{0{{ENTRY POINT
14639: {{BZE{R9{DMP28{{SKIP DUMP IF ARGUMENT IS ZERO
14640: {{BGT{R9{#NUM02{DMP29{JUMP IF CORE DUMP REQUIRED
14641: {{ZER{R10{{{CLEAR XL
14642: {{ZER{R7{{{ZERO MOVE OFFSET
14643: {{MOV{R9{DMARG{{SAVE DUMP ARGUMENT
14644: {{JSR{GBCOL{{{COLLECT GARBAGE
14645: {{JSR{PRTPG{{{EJECT PRINTER
14646: {{MOV{#DMHDV{R9{{POINT TO HEADING FOR VARIABLES
14647: {{JSR{PRTST{{{PRINT IT
14648: {{JSR{PRTNL{{{TERMINATE PRINT LINE
14649: {{JSR{PRTNL{{{AND PRINT A BLANK LINE
14650: *
14651: * FIRST ALL NATURAL VARIABLE BLOCKS (VRBLK) WHOSE VALUES
14652: * ARE NON-NULL ARE LINKED IN LEXICAL ORDER USING DMVCH AS
14653: * THE CHAIN HEAD AND CHAINING THROUGH THE VRGET FIELDS.
14654: * NOTE THAT THIS SCRAMBLES STORE IF THE PROCESS IS
14655: * INTERRUPTED BEFORE COMPLETION E.G. BY EXCEEDING TIME OR
14656: * PRINT LIMITS. SINCE THE SUBSEQUENT CORE DUMPS AND
14657: * FAILURES IF EXECUTION IS RESUMED ARE VERY CONFUSING, THE
14658: * EXECUTION TIME ERROR ROUTINE CHECKS FOR THIS EVENT AND
14659: * ATTEMPTS AN UNSCRAMBLE. SIMILAR PRECAUTIONS SHOULD BE
14660: * OBSERVED IF TRANSLATE TIME DUMPING IS IMPLEMENTED.
14661: *
14662: {{ZER{DMVCH{{{SET NULL CHAIN TO START
14663: {{MOV{HSHTB{R6{{POINT TO HASH TABLE
14664: *
14665: * LOOP THROUGH HEADERS IN HASH TABLE
14666: *
14667: {DMP00{MOV{R6{R9{{COPY HASH BUCKET POINTER
14668: {{ICA{R6{{{BUMP POINTER
14669: {{SUB{#4*VRNXT{R9{{SET OFFSET TO MERGE
14670: *
14671: * LOOP THROUGH VRBLKS ON ONE CHAIN
14672: *
14673: {DMP01{MOV{4*VRNXT(R9){R9{{POINT TO NEXT VRBLK ON CHAIN
14674: {{BZE{R9{DMP09{{JUMP IF END OF THIS HASH CHAIN
14675: {{MOV{R9{R10{{ELSE COPY VRBLK POINTER
14676: {{EJC{{{{
14677: *
14678: * DUMPR (CONTINUED)
14679: *
14680: * LOOP TO FIND VALUE AND SKIP IF NULL
14681: *
14682: {DMP02{MOV{4*VRVAL(R10){R10{{LOAD VALUE
14683: {{BEQ{R10{#NULLS{DMP01{LOOP FOR NEXT VRBLK IF NULL VALUE
14684: {{BEQ{(R10){#B$TRT{DMP02{LOOP BACK IF VALUE IS TRAPPED
14685: *
14686: * NON-NULL VALUE, PREPARE TO SEARCH CHAIN
14687: *
14688: {{MOV{R9{R8{{SAVE VRBLK POINTER
14689: {{ADD{#4*VRSOF{R9{{ADJUST PTR TO BE LIKE SCBLK PTR
14690: {{BNZ{4*SCLEN(R9){DMP03{{JUMP IF NON-SYSTEM VARIABLE
14691: {{MOV{4*VRSVO(R9){R9{{ELSE LOAD PTR TO NAME IN SVBLK
14692: *
14693: * HERE WITH NAME POINTER FOR NEW BLOCK IN XR
14694: *
14695: {DMP03{MOV{R9{R7{{SAVE POINTER TO CHARS
14696: {{MOV{R6{DMPSV{{SAVE HASH BUCKET POINTER
14697: {{MOV{#DMVCH{R6{{POINT TO CHAIN HEAD
14698: *
14699: * LOOP TO SEARCH CHAIN FOR CORRECT INSERTION POINT
14700: *
14701: {DMP04{MOV{R6{DMPCH{{SAVE CHAIN POINTER
14702: {{MOV{R6{R10{{COPY IT
14703: {{MOV{(R10){R9{{LOAD POINTER TO NEXT ENTRY
14704: {{BZE{R9{DMP08{{JUMP IF END OF CHAIN TO INSERT
14705: {{ADD{#4*VRSOF{R9{{ELSE GET NAME PTR FOR CHAINED VRBLK
14706: {{BNZ{4*SCLEN(R9){DMP05{{JUMP IF NOT SYSTEM VARIABLE
14707: {{MOV{4*VRSVO(R9){R9{{ELSE POINT TO NAME IN SVBLK
14708: *
14709: * HERE PREPARE TO COMPARE THE NAMES
14710: *
14711: * (WA) SCRATCH
14712: * (WB) POINTER TO STRING OF ENTERING VRBLK
14713: * (WC) POINTER TO ENTERING VRBLK
14714: * (XR) POINTER TO STRING OF CURRENT BLOCK
14715: * (XL) SCRATCH
14716: *
14717: {DMP05{MOV{R7{R10{{POINT TO ENTERING VRBLK STRING
14718: {{MOV{4*SCLEN(R10){R6{{LOAD ITS LENGTH
14719: {{PLC{R10{{{POINT TO CHARS OF ENTERING STRING
14720: {{BHI{R6{4*SCLEN(R9){DMP06{JUMP IF ENTERING LENGTH HIGH
14721: {{PLC{R9{{{ELSE POINT TO CHARS OF OLD STRING
14722: {{CMC{DMP08{DMP07{{COMPARE, INSERT IF NEW IS LLT OLD
14723: {{BRN{DMP08{{{OR IF LEQ (WE HAD SHORTER LENGTH)
14724: *
14725: * HERE WHEN NEW LENGTH IS LONGER THAN OLD LENGTH
14726: *
14727: {DMP06{MOV{4*SCLEN(R9){R6{{LOAD SHORTER LENGTH
14728: {{PLC{R9{{{POINT TO CHARS OF OLD STRING
14729: {{CMC{DMP08{DMP07{{COMPARE, INSERT IF NEW ONE LOW
14730: {{EJC{{{{
14731: *
14732: * DUMPR (CONTINUED)
14733: *
14734: * HERE WE MOVE OUT ON THE CHAIN
14735: *
14736: {DMP07{MOV{DMPCH{R10{{COPY CHAIN POINTER
14737: {{MOV{(R10){R6{{MOVE TO NEXT ENTRY ON CHAIN
14738: {{BRN{DMP04{{{LOOP BACK
14739: *
14740: * HERE AFTER LOCATING THE PROPER INSERTION POINT
14741: *
14742: {DMP08{MOV{DMPCH{R10{{COPY CHAIN POINTER
14743: {{MOV{DMPSV{R6{{RESTORE HASH BUCKET POINTER
14744: {{MOV{R8{R9{{RESTORE VRBLK POINTER
14745: {{MOV{(R10){4*VRGET(R9){{LINK VRBLK TO REST OF CHAIN
14746: {{MOV{R9{(R10){{LINK VRBLK INTO CURRENT CHAIN LOC
14747: {{BRN{DMP01{{{LOOP BACK FOR NEXT VRBLK
14748: *
14749: * HERE AFTER PROCESSING ALL VRBLKS ON ONE CHAIN
14750: *
14751: {DMP09{BNE{R6{HSHTE{DMP00{LOOP BACK IF MORE BUCKETS TO GO
14752: *
14753: * LOOP TO GENERATE DUMP OF NATURAL VARIABLE VALUES
14754: *
14755: {DMP10{MOV{DMVCH{R9{{LOAD POINTER TO NEXT ENTRY ON CHAIN
14756: {{BZE{R9{DMP11{{JUMP IF END OF CHAIN
14757: {{MOV{(R9){DMVCH{{ELSE UPDATE CHAIN PTR TO NEXT ENTRY
14758: {{JSR{SETVR{{{RESTORE VRGET FIELD
14759: {{MOV{R9{R10{{COPY VRBLK POINTER (NAME BASE)
14760: {{MOV{#4*VRVAL{R6{{SET OFFSET FOR VRBLK NAME
14761: {{JSR{PRTNV{{{PRINT NAME = VALUE
14762: {{BRN{DMP10{{{LOOP BACK TILL ALL PRINTED
14763: *
14764: * PREPARE TO PRINT KEYWORDS
14765: *
14766: {DMP11{JSR{PRTNL{{{PRINT BLANK LINE
14767: {{JSR{PRTNL{{{AND ANOTHER
14768: {{MOV{#DMHDK{R9{{POINT TO KEYWORD HEADING
14769: {{JSR{PRTST{{{PRINT HEADING
14770: {{JSR{PRTNL{{{END LINE
14771: {{JSR{PRTNL{{{PRINT ONE BLANK LINE
14772: {{MOV{#VDMKW{R10{{POINT TO LIST OF KEYWORD SVBLK PTRS
14773: {{EJC{{{{
14774: *
14775: * DUMPR (CONTINUED)
14776: *
14777: * LOOP TO DUMP KEYWORD VALUES
14778: *
14779: {DMP12{MOV{(R10)+{R9{{LOAD NEXT SVBLK PTR FROM TABLE
14780: {{BZE{R9{DMP13{{JUMP IF END OF LIST
14781: {{MOV{#CH$AM{R6{{LOAD AMPERSAND
14782: {{JSR{PRTCH{{{PRINT AMPERSAND
14783: {{JSR{PRTST{{{PRINT KEYWORD NAME
14784: {{MOV{4*SVLEN(R9){R6{{LOAD NAME LENGTH FROM SVBLK
14785: {{CTB{R6{SVCHS{{GET LENGTH OF NAME
14786: {{ADD{R6{R9{{POINT TO SVKNM FIELD
14787: {{MOV{(R9){DMPKN{{STORE IN DUMMY KVBLK
14788: {{MOV{#TMBEB{R9{{POINT TO BLANK-EQUAL-BLANK
14789: {{JSR{PRTST{{{PRINT IT
14790: {{MOV{R10{DMPSV{{SAVE TABLE POINTER
14791: {{MOV{#DMPKB{R10{{POINT TO DUMMY KVBLK
14792: {{MOV{#4*KVVAR{R6{{SET ZERO OFFSET
14793: {{JSR{ACESS{{{GET KEYWORD VALUE
14794: {{PPM{{{{FAILURE IS IMPOSSIBLE
14795: {{JSR{PRTVL{{{PRINT KEYWORD VALUE
14796: {{JSR{PRTNL{{{TERMINATE PRINT LINE
14797: {{MOV{DMPSV{R10{{RESTORE TABLE POINTER
14798: {{BRN{DMP12{{{LOOP BACK TILL ALL PRINTED
14799: *
14800: * HERE AFTER COMPLETING PARTIAL DUMP
14801: *
14802: {DMP13{BEQ{DMARG{#NUM01{DMP27{EXIT IF PARTIAL DUMP COMPLETE
14803: {{MOV{DNAMB{R9{{ELSE POINT TO FIRST DYNAMIC BLOCK
14804: *
14805: * LOOP THROUGH BLOCKS IN DYNAMIC STORAGE
14806: *
14807: {DMP14{BEQ{R9{DNAMP{DMP27{JUMP IF END OF USED REGION
14808: {{MOV{(R9){R6{{ELSE LOAD FIRST WORD OF BLOCK
14809: {{BEQ{R6{#B$VCT{DMP16{JUMP IF VECTOR
14810: {{BEQ{R6{#B$ART{DMP17{JUMP IF ARRAY
14811: {{BEQ{R6{#B$PDT{DMP18{JUMP IF PROGRAM DEFINED
14812: {{BEQ{R6{#B$TBT{DMP19{JUMP IF TABLE
14813: {{BEQ{R6{#B$BCT{DMP30{JUMP IF BUFFER
14814: *
14815: * MERGE HERE TO MOVE TO NEXT BLOCK
14816: *
14817: {DMP15{JSR{BLKLN{{{GET LENGTH OF BLOCK
14818: {{ADD{R6{R9{{POINT PAST THIS BLOCK
14819: {{BRN{DMP14{{{LOOP BACK FOR NEXT BLOCK
14820: {{EJC{{{{
14821: *
14822: * DUMPR (CONTINUED)
14823: *
14824: * HERE FOR VECTOR
14825: *
14826: {DMP16{MOV{#4*VCVLS{R7{{SET OFFSET TO FIRST VALUE
14827: {{BRN{DMP19{{{JUMP TO MERGE
14828: *
14829: * HERE FOR ARRAY
14830: *
14831: {DMP17{MOV{4*AROFS(R9){R7{{SET OFFSET TO ARPRO FIELD
14832: {{ICA{R7{{{BUMP TO GET OFFSET TO VALUES
14833: {{BRN{DMP19{{{JUMP TO MERGE
14834: *
14835: * HERE FOR PROGRAM DEFINED
14836: *
14837: {DMP18{MOV{#4*PDFLD{R7{{POINT TO VALUES, MERGE
14838: *
14839: * HERE FOR TABLE (OTHERS MERGE)
14840: *
14841: {DMP19{BZE{4*IDVAL(R9){DMP15{{IGNORE BLOCK IF ZERO ID VALUE
14842: {{JSR{BLKLN{{{ELSE GET BLOCK LENGTH
14843: {{MOV{R9{R10{{COPY BLOCK POINTER
14844: {{MOV{R6{DMPSV{{SAVE LENGTH
14845: {{MOV{R7{R6{{COPY OFFSET TO FIRST VALUE
14846: {{JSR{PRTNL{{{PRINT BLANK LINE
14847: {{MOV{R6{DMPSA{{PRESERVE OFFSET
14848: {{JSR{PRTVL{{{PRINT BLOCK VALUE (FOR TITLE)
14849: {{MOV{DMPSA{R6{{RECOVER OFFSET
14850: {{JSR{PRTNL{{{END PRINT LINE
14851: {{BEQ{(R9){#B$TBT{DMP22{JUMP IF TABLE
14852: {{DCA{R6{{{POINT BEFORE FIRST WORD
14853: *
14854: * LOOP TO PRINT CONTENTS OF ARRAY, VECTOR, OR PROGRAM DEF
14855: *
14856: {DMP20{MOV{R10{R9{{COPY BLOCK POINTER
14857: {{ICA{R6{{{BUMP OFFSET
14858: {{ADD{R6{R9{{POINT TO NEXT VALUE
14859: {{BEQ{R6{DMPSV{DMP14{EXIT IF END (XR PAST BLOCK)
14860: {{SUB{#4*VRVAL{R9{{SUBTRACT OFFSET TO MERGE INTO LOOP
14861: *
14862: * LOOP TO FIND VALUE AND IGNORE NULLS
14863: *
14864: {DMP21{MOV{4*VRVAL(R9){R9{{LOAD NEXT VALUE
14865: {{BEQ{R9{#NULLS{DMP20{LOOP BACK IF NULL VALUE
14866: {{BEQ{(R9){#B$TRT{DMP21{LOOP BACK IF TRAPPED
14867: {{JSR{PRTNV{{{ELSE PRINT NAME = VALUE
14868: {{BRN{DMP20{{{LOOP BACK FOR NEXT FIELD
14869: {{EJC{{{{
14870: *
14871: * DUMPR (CONTINUED)
14872: *
14873: * HERE TO DUMP A TABLE
14874: *
14875: {DMP22{MOV{#4*TBBUK{R8{{SET OFFSET TO FIRST BUCKET
14876: {{MOV{#4*TEVAL{R6{{SET NAME OFFSET FOR ALL TEBLKS
14877: *
14878: * LOOP THROUGH TABLE BUCKETS
14879: *
14880: {DMP23{MOV{R10{-(SP){{SAVE TBBLK POINTER
14881: {{ADD{R8{R10{{POINT TO NEXT BUCKET HEADER
14882: {{ICA{R8{{{BUMP BUCKET OFFSET
14883: {{SUB{#4*TENXT{R10{{SUBTRACT OFFSET TO MERGE INTO LOOP
14884: *
14885: * LOOP TO PROCESS TEBLKS ON ONE CHAIN
14886: *
14887: {DMP24{MOV{4*TENXT(R10){R10{{POINT TO NEXT TEBLK
14888: {{BEQ{R10{(SP){DMP26{JUMP IF END OF CHAIN
14889: {{MOV{R10{R9{{ELSE COPY TEBLK POINTER
14890: *
14891: * LOOP TO FIND VALUE AND IGNORE IF NULL
14892: *
14893: {DMP25{MOV{4*TEVAL(R9){R9{{LOAD NEXT VALUE
14894: {{BEQ{R9{#NULLS{DMP24{IGNORE IF NULL VALUE
14895: {{BEQ{(R9){#B$TRT{DMP25{LOOP BACK IF TRAPPED
14896: {{MOV{R8{DMPSV{{ELSE SAVE OFFSET POINTER
14897: {{JSR{PRTNV{{{PRINT NAME = VALUE
14898: {{MOV{DMPSV{R8{{RELOAD OFFSET
14899: {{BRN{DMP24{{{LOOP BACK FOR NEXT TEBLK
14900: *
14901: * HERE TO MOVE TO NEXT HASH CHAIN
14902: *
14903: {DMP26{MOV{(SP)+{R10{{RESTORE TBBLK POINTER
14904: {{BNE{R8{4*TBLEN(R10){DMP23{LOOP BACK IF MORE BUCKETS TO GO
14905: {{MOV{R10{R9{{ELSE COPY TABLE POINTER
14906: {{ADD{R8{R9{{POINT TO FOLLOWING BLOCK
14907: {{BRN{DMP14{{{LOOP BACK TO PROCESS NEXT BLOCK
14908: *
14909: * HERE AFTER COMPLETING DUMP
14910: *
14911: {DMP27{JSR{PRTPG{{{EJECT PRINTER
14912: *
14913: * MERGE HERE IF NO DUMP GIVEN (DMARG=0)
14914: *
14915: {DMP28{EXI{{{{RETURN TO DUMP CALLER
14916: *
14917: * CALL SYSTEM CORE DUMP ROUTINE
14918: *
14919: {DMP29{JSR{SYSDM{{{CALL IT
14920: {{BRN{DMP28{{{RETURN
14921: {{EJC{{{{
14922: *
14923: * DUMPR (CONTINUED)
14924: *
14925: * HERE TO DUMP BUFFER BLOCK
14926: *
14927: {DMP30{JSR{PRTNL{{{PRINT BLANK LINE
14928: {{JSR{PRTVL{{{PRINT VALUE ID FOR TITLE
14929: {{JSR{PRTNL{{{FORCE NEW LINE
14930: {{MOV{#CH$DQ{R6{{LOAD DOUBLE QUOTE
14931: {{JSR{PRTCH{{{PRINT IT
14932: {{MOV{4*BCLEN(R9){R8{{LOAD DEFINED LENGTH
14933: {{BZE{R8{DMP32{{SKIP CHARACTERS IF NONE
14934: {{LCT{R8{R8{{LOAD COUNT FOR LOOP
14935: {{MOV{R9{R7{{SAVE BCBLK PTR
14936: {{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK
14937: {{PLC{R9{{{GET SET TO LOAD CHARACTERS
14938: *
14939: * LOOP HERE STUFFING CHARACTERS IN OUTPUT STREAM
14940: *
14941: {DMP31{LCH{R6{(R9)+{{GET NEXT CHARACTER
14942: {{JSR{PRTCH{{{STUFF IT
14943: {{BCT{R8{DMP31{{BRANCH FOR NEXT ONE
14944: {{MOV{R7{R9{{RESTORE BCBLK POINTER
14945: *
14946: * MERGE TO STUFF CLOSING QUOTE MARK
14947: *
14948: {DMP32{MOV{#CH$DQ{R6{{STUFF QUOTE
14949: {{JSR{PRTCH{{{PRINT IT
14950: {{JSR{PRTNL{{{PRINT NEW LINE
14951: {{MOV{(R9){R6{{GET FIRST WD FOR BLKLN
14952: {{BRN{DMP15{{{MERGE TO GET NEXT BLOCK
14953: {{ENP{{{{END PROCEDURE DUMPR
14954: {{EJC{{{{
14955: *
14956: * ERMSG -- PRINT ERROR CODE AND ERROR MESSAGE
14957: *
14958: * KVERT ERROR CODE
14959: * JSR ERMSG CALL TO PRINT MESSAGE
14960: * (XR,XL,WA,WB,WC,IA) DESTROYED
14961: *
14962: {ERMSG{PRC{E{0{{ENTRY POINT
14963: {{JSR{PRTIS{{{PRINT ERROR PTR OR BLANK LINE
14964: {{MOV{KVERT{R6{{LOAD ERROR CODE
14965: {{MOV{#ERMMS{R9{{POINT TO ERROR MESSAGE /ERROR/
14966: {{JSR{PRTST{{{PRINT IT
14967: {{JSR{ERTEX{{{GET ERROR MESSAGE TEXT
14968: {{ADD{#THSND{R6{{BUMP ERROR CODE FOR PRINT
14969: {{MTI{R6{{{FAIL CODE IN INT ACC
14970: {{JSR{PRTIN{{{PRINT CODE (NOW HAVE ERROR1XXX)
14971: {{MOV{PRBUF{R10{{POINT TO PRINT BUFFER
14972: {{PSC{R10{#NUM05{{POINT TO THE 1
14973: {{MOV{#CH$BL{R6{{LOAD A BLANK
14974: {{SCH{R6{(R10){{STORE BLANK OVER 1 (ERROR XXX)
14975: {{CSC{R10{{{COMPLETE STORE CHARACTERS
14976: {{ZER{R10{{{CLEAR GARBAGE POINTER IN XL
14977: {{MOV{R9{R6{{KEEP ERROR TEXT
14978: {{MOV{#ERMNS{R9{{POINT TO / -- /
14979: {{JSR{PRTST{{{PRINT IT
14980: {{MOV{R6{R9{{GET ERROR TEXT AGAIN
14981: {{JSR{PRTST{{{PRINT ERROR MESSAGE TEXT
14982: {{JSR{PRTIS{{{PRINT LINE
14983: {{JSR{PRTIS{{{PRINT BLANK LINE
14984: {{EXI{{{{RETURN TO ERMSG CALLER
14985: {{ENP{{{{END PROCEDURE ERMSG
14986: {{EJC{{{{
14987: *
14988: * ERTEX -- GET ERROR MESSAGE TEXT
14989: *
14990: * (WA) ERROR CODE
14991: * JSR ERTEX CALL TO GET ERROR TEXT
14992: * (XR) PTR TO ERROR TEXT IN DYNAMIC
14993: * (R$ETX) COPY OF PTR TO ERROR TEXT
14994: * (XL,WC,IA) DESTROYED
14995: *
14996: {ERTEX{PRC{E{0{{ENTRY POINT
14997: {{MOV{R6{ERTWA{{SAVE WA
14998: {{MOV{R7{ERTWB{{SAVE WB
14999: {{JSR{SYSEM{{{GET FAILURE MESSAGE TEXT
15000: {{MOV{R9{R10{{COPY POINTER TO IT
15001: {{MOV{4*SCLEN(R9){R6{{GET LENGTH OF STRING
15002: {{BZE{R6{ERT02{{JUMP IF NULL
15003: {{ZER{R7{{{OFFSET OF ZERO
15004: {{JSR{SBSTR{{{COPY INTO DYNAMIC STORE
15005: {{MOV{R9{R$ETX{{STORE FOR RELOCATION
15006: *
15007: * RETURN
15008: *
15009: {ERT01{MOV{ERTWB{R7{{RESTORE WB
15010: {{MOV{ERTWA{R6{{RESTORE WA
15011: {{EXI{{{{RETURN TO CALLER
15012: *
15013: * RETURN ERRTEXT CONTENTS INSTEAD OF NULL
15014: *
15015: {ERT02{MOV{R$ETX{R9{{GET ERRTEXT
15016: {{BRN{ERT01{{{RETURN
15017: {{ENP{{{{
15018: {{EJC{{{{
15019: *
15020: * EVALI -- EVALUATE INTEGER ARGUMENT
15021: *
15022: * EVALI IS USED BY PATTERN PRIMITIVES LEN,TAB,RTAB,POS,RPOS
15023: * WHEN THEIR ARGUMENT IS AN EXPRESSION VALUE.
15024: *
15025: * (XR) NODE POINTER
15026: * (WB) CURSOR
15027: * JSR EVALI CALL TO EVALUATE INTEGER
15028: * PPM LOC TRANSFER LOC FOR NON-INTEGER ARG
15029: * PPM LOC TRANSFER LOC FOR OUT OF RANGE ARG
15030: * PPM LOC TRANSFER LOC FOR EVALUATION FAILURE
15031: * PPM LOC TRANSFER LOC FOR SUCCESSFUL EVAL
15032: * (THE NORMAL RETURN IS NEVER TAKEN)
15033: * (XR) PTR TO NODE WITH INTEGER ARGUMENT
15034: * (WC,XL,RA) DESTROYED
15035: *
15036: * ON RETURN, THE NODE POINTED TO HAS THE INTEGER ARGUMENT
15037: * IN PARM1 AND THE PROPER SUCCESSOR POINTER IN PTHEN.
15038: * THIS ALLOWS MERGING WITH THE NORMAL (INTEGER ARG) CASE.
15039: *
15040: {EVALI{PRC{R{4{{ENTRY POINT (RECURSIVE)
15041: {{JSR{EVALP{{{EVALUATE EXPRESSION
15042: {{PPM{EVLI1{{{JUMP ON FAILURE
15043: {{MOV{R10{-(SP){{STACK RESULT FOR GTSMI
15044: {{MOV{4*PTHEN(R9){R10{{LOAD SUCCESSOR POINTER
15045: {{JSR{GTSMI{{{CONVERT ARG TO SMALL INTEGER
15046: {{PPM{EVLI2{{{JUMP IF NOT INTEGER
15047: {{PPM{EVLI3{{{JUMP IF OUT OF RANGE
15048: {{MOV{R9{EVLIV{{STORE RESULT IN SPECIAL DUMMY NODE
15049: {{MOV{R10{EVLIS{{STORE SUCCESSOR POINTER
15050: {{MOV{#EVLIN{R9{{POINT TO DUMMY NODE WITH RESULT
15051: {{EXI{4{{{TAKE SUCCESSFUL EXIT
15052: *
15053: * HERE IF EVALUATION FAILS
15054: *
15055: {EVLI1{EXI{3{{{TAKE FAILURE RETURN
15056: *
15057: * HERE IF ARGUMENT IS NOT INTEGER
15058: *
15059: {EVLI2{EXI{1{{{TAKE NON-INTEGER ERROR EXIT
15060: *
15061: * HERE IF ARGUMENT IS OUT OF RANGE
15062: *
15063: {EVLI3{EXI{2{{{TAKE OUT-OF-RANGE ERROR EXIT
15064: {{ENP{{{{END PROCEDURE EVALI
15065: {{EJC{{{{
15066: *
15067: * EVALP -- EVALUATE EXPRESSION DURING PATTERN MATCH
15068: *
15069: * EVALP IS USED TO EVALUATE AN EXPRESSION (BY VALUE) DURING
15070: * A PATTERN MATCH. THE EFFECT IS LIKE EVALX, BUT PATTERN
15071: * VARIABLES ARE STACKED AND RESTORED IF NECESSARY.
15072: *
15073: * EVALP ALSO DIFFERS FROM EVALX IN THAT IF THE RESULT IS
15074: * AN EXPRESSION IT IS REEVALUATED. THIS OCCURS REPEATEDLY.
15075: *
15076: * (XR) NODE POINTER
15077: * (WB) PATTERN MATCH CURSOR
15078: * JSR EVALP CALL TO EVALUATE EXPRESSION
15079: * PPM LOC TRANSFER LOC IF EVALUATION FAILS
15080: * (XL) RESULT
15081: * (WA) FIRST WORD OF RESULT BLOCK
15082: * (XR,WB) DESTROYED (FAILURE CASE ONLY)
15083: * (WC,RA) DESTROYED
15084: *
15085: * THE EXPRESSION POINTER IS STORED IN PARM1 OF THE NODE
15086: *
15087: * CONTROL RETURNS TO FAILP ON FAILURE OF EVALUATION
15088: *
15089: {EVALP{PRC{R{1{{ENTRY POINT (RECURSIVE)
15090: {{MOV{4*PARM1(R9){R10{{LOAD EXPRESSION POINTER
15091: {{BEQ{(R10){#B$EXL{EVLP1{JUMP IF EXBLK CASE
15092: *
15093: * HERE FOR CASE OF SEBLK
15094: *
15095: * WE CAN GIVE A FAST RETURN IF THE VALUE OF THE VRBLK IS
15096: * NOT AN EXPRESSION AND IS NOT TRAPPED.
15097: *
15098: {{MOV{4*SEVAR(R10){R10{{LOAD VRBLK POINTER
15099: {{MOV{4*VRVAL(R10){R10{{LOAD VALUE OF VRBLK
15100: {{MOV{(R10){R6{{LOAD FIRST WORD OF VALUE
15101: {{BHI{R6{#B$T$${EVLP3{JUMP IF NOT SEBLK, TRBLK OR EXBLK
15102: *
15103: * HERE FOR EXBLK OR SEBLK WITH EXPR VALUE OR TRAPPED VALUE
15104: *
15105: {EVLP1{MOV{R9{-(SP){{STACK NODE POINTER
15106: {{MOV{R7{-(SP){{STACK CURSOR
15107: {{MOV{R$PMS{-(SP){{STACK SUBJECT STRING POINTER
15108: {{MOV{PMSSL{-(SP){{STACK SUBJECT STRING LENGTH
15109: {{MOV{PMDFL{-(SP){{STACK DOT FLAG
15110: {{MOV{PMHBS{-(SP){{STACK HISTORY STACK BASE POINTER
15111: {{MOV{4*PARM1(R9){R9{{LOAD EXPRESSION POINTER
15112: {{EJC{{{{
15113: *
15114: * EVALP (CONTINUED)
15115: *
15116: * LOOP BACK HERE TO REEVALUATE EXPRESSION RESULT
15117: *
15118: {EVLP2{ZER{R7{{{SET FLAG FOR BY VALUE
15119: {{JSR{EVALX{{{EVALUATE EXPRESSION
15120: {{PPM{EVLP4{{{JUMP ON FAILURE
15121: {{MOV{(R9){R6{{ELSE LOAD FIRST WORD OF VALUE
15122: {{BLO{R6{#B$E$${EVLP2{LOOP BACK TO REEVALUATE EXPRESSION
15123: *
15124: * HERE TO RESTORE PATTERN VALUES AFTER SUCCESSFUL EVAL
15125: *
15126: {{MOV{R9{R10{{COPY RESULT POINTER
15127: {{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER
15128: {{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG
15129: {{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH
15130: {{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER
15131: {{MOV{(SP)+{R7{{RESTORE CURSOR
15132: {{MOV{(SP)+{R9{{RESTORE NODE POINTER
15133: *
15134: * COMMON EXIT POINT
15135: *
15136: {EVLP3{EXI{{{{RETURN TO EVALP CALLER
15137: *
15138: * HERE FOR FAILURE DURING EVALUATION
15139: *
15140: {EVLP4{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER
15141: {{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG
15142: {{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH
15143: {{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER
15144: {{ADD{#4*NUM02{SP{{REMOVE NODE PTR, CURSOR
15145: {{EXI{1{{{TAKE FAILURE EXIT
15146: {{ENP{{{{END PROCEDURE EVALP
15147: {{EJC{{{{
15148: *
15149: * EVALS -- EVALUATE STRING ARGUMENT
15150: *
15151: * EVALS IS USED BY SPAN, ANY, NOTANY, BREAK, BREAKX WHEN
15152: * THEY ARE PASSED AN EXPRESSION ARGUMENT.
15153: *
15154: * (XR) NODE POINTER
15155: * (WB) CURSOR
15156: * JSR EVALS CALL TO EVALUATE STRING
15157: * PPM LOC TRANSFER LOC FOR NON-STRING ARG
15158: * PPM LOC TRANSFER LOC FOR EVALUATION FAILURE
15159: * PPM LOC TRANSFER LOC FOR SUCCESSFUL EVAL
15160: * (THE NORMAL RETURN IS NEVER TAKEN)
15161: * (XR) PTR TO NODE WITH PARMS SET
15162: * (XL,WC,RA) DESTROYED
15163: *
15164: * ON RETURN, THE NODE POINTED TO HAS A CHARACTER TABLE
15165: * POINTER IN PARM1 AND A BIT MASK IN PARM2. THE PROPER
15166: * SUCCESSOR IS STORED IN PTHEN OF THIS NODE. THUS IT IS
15167: * OK FOR MERGING WITH THE NORMAL (MULTI-CHAR STRING) CASE.
15168: *
15169: {EVALS{PRC{R{3{{ENTRY POINT (RECURSIVE)
15170: {{JSR{EVALP{{{EVALUATE EXPRESSION
15171: {{PPM{EVLS1{{{JUMP IF EVALUATION FAILS
15172: {{MOV{4*PTHEN(R9){-(SP){{SAVE SUCCESSOR POINTER
15173: {{MOV{R7{-(SP){{SAVE CURSOR
15174: {{MOV{R10{-(SP){{STACK RESULT PTR FOR PATST
15175: {{ZER{R7{{{DUMMY PCODE FOR ONE CHAR STRING
15176: {{ZER{R8{{{DUMMY PCODE FOR EXPRESSION ARG
15177: {{MOV{#P$BRK{R10{{APPROPRIATE PCODE FOR OUR USE
15178: {{JSR{PATST{{{CALL ROUTINE TO BUILD NODE
15179: {{PPM{EVLS2{{{JUMP IF NOT STRING
15180: {{MOV{(SP)+{R7{{RESTORE CURSOR
15181: {{MOV{(SP)+{4*PTHEN(R9){{STORE SUCCESSOR POINTER
15182: {{EXI{3{{{TAKE SUCCESS RETURN
15183: *
15184: * HERE IF EVALUATION FAILS
15185: *
15186: {EVLS1{EXI{2{{{TAKE FAILURE RETURN
15187: *
15188: * HERE IF ARGUMENT IS NOT STRING
15189: *
15190: {EVLS2{ADD{#4*NUM02{SP{{POP SUCCESSOR AND CURSOR
15191: {{EXI{1{{{TAKE NON-STRING ERROR EXIT
15192: {{ENP{{{{END PROCEDURE EVALS
15193: {{EJC{{{{
15194: *
15195: * EVALX -- EVALUATE EXPRESSION
15196: *
15197: * EVALX IS CALLED TO EVALUATE AN EXPRESSION
15198: *
15199: * (XR) POINTER TO EXBLK OR SEBLK
15200: * (WB) 0 IF BY VALUE, 1 IF BY NAME
15201: * JSR EVALX CALL TO EVALUATE EXPRESSION
15202: * PPM LOC TRANSFER LOC IF EVALUATION FAILS
15203: * (XR) RESULT IF CALLED BY VALUE
15204: * (XL,WA) RESULT NAME BASE,OFFSET IF BY NAME
15205: * (XR) DESTROYED (NAME CASE ONLY)
15206: * (XL,WA) DESTROYED (VALUE CASE ONLY)
15207: * (WB,WC,RA) DESTROYED
15208: *
15209: {EVALX{PRC{R{1{{ENTRY POINT, RECURSIVE
15210: {{BEQ{(R9){#B$EXL{EVLX2{JUMP IF EXBLK CASE
15211: *
15212: * HERE FOR SEBLK
15213: *
15214: {{MOV{4*SEVAR(R9){R10{{LOAD VRBLK POINTER (NAME BASE)
15215: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET
15216: {{BNZ{R7{EVLX1{{JUMP IF CALLED BY NAME
15217: {{JSR{ACESS{{{CALL ROUTINE TO ACCESS VALUE
15218: {{PPM{EVLX9{{{JUMP IF FAILURE ON ACCESS
15219: *
15220: * MERGE HERE TO EXIT FOR SEBLK CASE
15221: *
15222: {EVLX1{EXI{{{{RETURN TO EVALX CALLER
15223: {{EJC{{{{
15224: *
15225: * EVALX (CONTINUED)
15226: *
15227: * HERE FOR FULL EXPRESSION (EXBLK) CASE
15228: *
15229: * IF AN ERROR OCCURS IN THE EXPRESSION CODE AT EXECUTION
15230: * TIME, CONTROL IS PASSED VIA ERROR SECTION TO EXFAL
15231: * WITHOUT RETURNING TO THIS ROUTINE.
15232: * THE FOLLOWING ENTRIES ARE MADE ON THE STACK BEFORE
15233: * GIVING CONTROL TO THE EXPRESSION CODE
15234: *
15235: * EVALX RETURN POINT
15236: * SAVED VALUE OF R$COD
15237: * CODE POINTER (-R$COD)
15238: * SAVED VALUE OF FLPTR
15239: * 0 IF BY VALUE, 1 IF BY NAME
15240: * FLPTR --------------- *EXFLC, FAIL OFFSET IN EXBLK
15241: *
15242: {EVLX2{SCP{R8{{{GET CODE POINTER
15243: {{MOV{R$COD{R6{{LOAD CODE BLOCK POINTER
15244: {{SUB{R6{R8{{GET CODE POINTER AS OFFSET
15245: {{MOV{R6{-(SP){{STACK OLD CODE BLOCK POINTER
15246: {{MOV{R8{-(SP){{STACK RELATIVE CODE OFFSET
15247: {{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER
15248: {{MOV{R7{-(SP){{STACK NAME/VALUE INDICATOR
15249: {{MOV{#4*EXFLC{-(SP){{STACK NEW FAIL OFFSET
15250: {{MOV{FLPTR{GTCEF{{KEEP IN CASE OF ERROR
15251: {{MOV{R$COD{R$GTC{{KEEP CODE BLOCK POINTER SIMILARLY
15252: {{MOV{SP{FLPTR{{SET NEW FAILURE POINTER
15253: {{MOV{R9{R$COD{{SET NEW CODE BLOCK POINTER
15254: {{MOV{KVSTN{4*EXSTM(R9){{REMEMBER STMNT NUMBER
15255: {{ADD{#4*EXCOD{R9{{POINT TO FIRST CODE WORD
15256: {{LCP{R9{{{SET CODE POINTER
15257: {{BNE{STAGE{#STGXT{EXITS{JUMP IF NOT EXECUTION TIME
15258: {{MOV{#STGEE{STAGE{{EVALUATING EXPRESSION
15259: {{BRN{EXITS{{{JUMP TO EXECUTE FIRST CODE WORD
15260: {{EJC{{{{
15261: *
15262: * EVALX (CONTINUED)
15263: *
15264: * COME HERE IF SUCCESSFUL RETURN BY VALUE (SEE O$RVL)
15265: *
15266: {EVLX3{MOV{(SP)+{R9{{LOAD VALUE
15267: {{BZE{4*1(SP){EVLX5{{JUMP IF CALLED BY VALUE
15268: {{ERB{249{EXPRESSION{{EVALUATED BY NAME RETURNED VALUE
15269: *
15270: * HERE FOR EXPRESSION RETURNING BY NAME (SEE O$RNM)
15271: *
15272: {EVLX4{MOV{(SP)+{R6{{LOAD NAME OFFSET
15273: {{MOV{(SP)+{R10{{LOAD NAME BASE
15274: {{BNZ{4*1(SP){EVLX5{{JUMP IF CALLED BY NAME
15275: {{JSR{ACESS{{{ELSE ACCESS VALUE FIRST
15276: {{PPM{EVLX6{{{JUMP IF FAILURE DURING ACCESS
15277: *
15278: * HERE AFTER LOADING CORRECT RESULT INTO XR OR XL,WA
15279: *
15280: {EVLX5{ZER{R7{{{NOTE SUCCESSFUL
15281: {{BRN{EVLX7{{{MERGE
15282: *
15283: * HERE FOR FAILURE IN EXPRESSION EVALUATION (SEE O$FEX)
15284: *
15285: {EVLX6{MNZ{R7{{{NOTE UNSUCCESSFUL
15286: *
15287: * RESTORE ENVIRONMENT
15288: *
15289: {EVLX7{BNE{STAGE{#STGEE{EVLX8{SKIP IF WAS NOT PREVIOUSLY XT
15290: {{MOV{#STGXT{STAGE{{EXECUTE TIME
15291: *
15292: * MERGE WITH STAGE SET UP
15293: *
15294: {EVLX8{ADD{#4*NUM02{SP{{POP NAME/VALUE INDICATOR, *EXFAL
15295: {{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER
15296: {{MOV{(SP)+{R8{{LOAD CODE OFFSET
15297: {{ADD{(SP){R8{{MAKE CODE POINTER ABSOLUTE
15298: {{MOV{(SP)+{R$COD{{RESTORE OLD CODE BLOCK POINTER
15299: {{LCP{R8{{{RESTORE OLD CODE POINTER
15300: {{BZE{R7{EVLX1{{JUMP FOR SUCCESSFUL RETURN
15301: *
15302: * MERGE HERE FOR FAILURE IN SEBLK CASE
15303: *
15304: {EVLX9{EXI{1{{{TAKE FAILURE EXIT
15305: {{ENP{{{{END OF PROCEDURE EVALX
15306: {{EJC{{{{
15307: *
15308: * EXBLD -- BUILD EXBLK
15309: *
15310: * EXBLD IS USED TO BUILD AN EXPRESSION BLOCK FROM THE
15311: * CODE COMPILED MOST RECENTLY IN THE CURRENT CCBLK.
15312: *
15313: * (XL) OFFSET IN CCBLK TO START OF CODE
15314: * (WB) INTEGER IN RANGE 0 LE N LE MXLEN
15315: * JSR EXBLD CALL TO BUILD EXBLK
15316: * (XR) PTR TO CONSTRUCTED EXBLK
15317: * (WA,WB,XL) DESTROYED
15318: *
15319: {EXBLD{PRC{E{0{{ENTRY POINT
15320: {{MOV{R10{R6{{COPY OFFSET TO START OF CODE
15321: {{SUB{#4*EXCOD{R6{{CALC REDUCTION IN OFFSET IN EXBLK
15322: {{MOV{R6{-(SP){{STACK FOR LATER
15323: {{MOV{CWCOF{R6{{LOAD FINAL OFFSET
15324: {{SUB{R10{R6{{COMPUTE LENGTH OF CODE
15325: {{ADD{#4*EXSI${R6{{ADD SPACE FOR STANDARD FIELDS
15326: {{JSR{ALLOC{{{ALLOCATE SPACE FOR EXBLK
15327: {{MOV{R9{-(SP){{SAVE POINTER TO EXBLK
15328: {{MOV{#B$EXL{4*EXTYP(R9){{STORE TYPE WORD
15329: {{ZER{4*EXSTM(R9){{{ZEROISE STMNT NUMBER FIELD
15330: {{MOV{R6{4*EXLEN(R9){{STORE LENGTH
15331: {{MOV{#OFEX${4*EXFLC(R9){{STORE FAILURE WORD
15332: {{ADD{#4*EXSI${R9{{SET XR FOR SYSMW
15333: {{MOV{R10{CWCOF{{RESET OFFSET TO START OF CODE
15334: {{ADD{R$CCB{R10{{POINT TO START OF CODE
15335: {{SUB{#4*EXSI${R6{{LENGTH OF CODE TO MOVE
15336: {{MOV{R6{-(SP){{STACK LENGTH OF CODE
15337: {{MVW{{{{MOVE CODE TO EXBLK
15338: {{MOV{(SP)+{R6{{GET LENGTH OF CODE
15339: {{BTW{R6{{{CONVERT BYTE COUNT TO WORD COUNT
15340: {{LCT{R6{R6{{PREPARE COUNTER FOR LOOP
15341: {{MOV{(SP){R10{{COPY EXBLK PTR, DONT UNSTACK
15342: {{ADD{#4*EXCOD{R10{{POINT TO CODE ITSELF
15343: {{MOV{4*1(SP){R7{{GET REDUCTION IN OFFSET
15344: *
15345: * THIS LOOP SEARCHES FOR NEGATION AND SELECTION CODE SO
15346: * THAT THE OFFSETS COMPUTED WHILST CODE WAS IN CODE BLOCK
15347: * CAN BE TRANSFORMED TO REDUCED VALUES APPLICABLE IN AN
15348: * EXBLK.
15349: *
15350: {EXBL1{MOV{(R10)+{R9{{GET NEXT CODE WORD
15351: {{BEQ{R9{#OSLA${EXBL3{JUMP IF SELECTION FOUND
15352: {{BEQ{R9{#ONTA${EXBL3{JUMP IF NEGATION FOUND
15353: {{BCT{R6{EXBL1{{LOOP TO END OF CODE
15354: *
15355: * NO SELECTION FOUND OR MERGE TO EXIT ON TERMINATION
15356: *
15357: {EXBL2{MOV{(SP)+{R9{{POP EXBLK PTR INTO XR
15358: {{MOV{(SP)+{R10{{POP REDUCTION CONSTANT
15359: {{EXI{{{{RETURN TO CALLER
15360: {{EJC{{{{
15361: *
15362: * EXBLD (CONTINUED)
15363: *
15364: * SELECTION OR NEGATION FOUND
15365: * REDUCE THE OFFSETS AS NEEDED. OFFSETS OCCUR IN WORDS
15366: * FOLLOWING CODE WORDS -
15367: * =ONTA$, =OSLA$, =OSLB$, =OSLC$
15368: *
15369: {EXBL3{SUB{R7{(R10)+{{ADJUST OFFSET
15370: {{BCT{R6{EXBL4{{DECREMENT COUNT
15371: *
15372: {EXBL4{BCT{R6{EXBL5{{DECREMENT COUNT
15373: *
15374: * CONTINUE SEARCH FOR MORE OFFSETS
15375: *
15376: {EXBL5{MOV{(R10)+{R9{{GET NEXT CODE WORD
15377: {{BEQ{R9{#OSLA${EXBL3{JUMP IF OFFSET FOUND
15378: {{BEQ{R9{#OSLB${EXBL3{JUMP IF OFFSET FOUND
15379: {{BEQ{R9{#OSLC${EXBL3{JUMP IF OFFSET FOUND
15380: {{BEQ{R9{#ONTA${EXBL3{JUMP IF OFFSET FOUND
15381: {{BCT{R6{EXBL5{{LOOP
15382: {{BRN{EXBL2{{{MERGE TO RETURN
15383: {{ENP{{{{END PROCEDURE EXBLD
15384: {{EJC{{{{
15385: *
15386: * EXPAN -- ANALYZE EXPRESSION
15387: *
15388: * THE EXPRESSION ANALYZER (EXPAN) PROCEDURE IS USED TO SCAN
15389: * AN EXPRESSION AND CONVERT IT INTO A TREE REPRESENTATION.
15390: * SEE DESCRIPTIONS OF CMBLK, CUBLK, CBBLK IN THE STRUCTURES
15391: * SECTION FOR DETAILED FORMAT OF TREE BLOCKS.
15392: *
15393: * THE ANALYZER USES A SIMPLE PRECEDENCE SCHEME IN WHICH
15394: * OPERANDS AND OPERATORS ARE PLACED ON A SINGLE STACK
15395: * AND CONDENSATIONS ARE MADE WHEN LOW PRECEDENCE OPERATORS
15396: * ARE STACKED AFTER A HIGHER PRECEDENCE OPERATOR. A GLOBAL
15397: * VARIABLE (IN WB) KEEPS TRACK OF THE LEVEL AS FOLLOWS.
15398: *
15399: * 0 SCANNING OUTER LEVEL OF STATEMENT OR EXPRESSION
15400: * 1 SCANNING OUTER LEVEL OF NORMAL GOTO
15401: * 2 SCANNING OUTER LEVEL OF DIRECT GOTO
15402: * 3 SCANNING INSIDE ARRAY BRACKETS
15403: * 4 SCANNING INSIDE GROUPING PARENTHESES
15404: * 5 SCANNING INSIDE FUNCTION PARENTHESES
15405: *
15406: * THIS VARIABLE IS SAVED ON THE STACK ON ENCOUNTERING A
15407: * GROUPING AND RESTORED AT THE END OF THE GROUPING.
15408: *
15409: * ANOTHER GLOBAL VARIABLE (IN WC) COUNTS THE NUMBER OF
15410: * ITEMS AT ONE GROUPING LEVEL AND IS INCREMENTED FOR EACH
15411: * COMMA ENCOUNTERED. IT IS STACKED WITH THE LEVEL INDICATOR
15412: *
15413: * THE SCAN IS CONTROLLED BY A THREE STATE FINITE MACHINE.
15414: * A GLOBAL VARIABLE STORED IN WA IS THE CURRENT STATE.
15415: *
15416: * WA=0 NOTHING SCANNED AT THIS LEVEL
15417: * WA=1 OPERAND EXPECTED
15418: * WA=2 OPERATOR EXPECTED
15419: *
15420: * (WB) CALL TYPE (SEE BELOW)
15421: * JSR EXPAN CALL TO ANALYZE EXPRESSION
15422: * (XR) POINTER TO RESULTING TREE
15423: * (XL,WA,WB,WC,RA) DESTROYED
15424: *
15425: * THE ENTRY VALUE OF WB INDICATES THE CALL TYPE AS FOLLOWS.
15426: *
15427: * 0 SCANNING EITHER THE MAIN BODY OF A STATEMENT OR THE
15428: * TEXT OF AN EXPRESSION (FROM EVAL CALL). VALID
15429: * TERMINATORS ARE COLON, SEMICOLON. THE RESCAN FLAG IS
15430: * SET TO RETURN THE TERMINATOR ON THE NEXT SCANE CALL.
15431: *
15432: * 1 SCANNING A NORMAL GOTO. THE ONLY VALID
15433: * TERMINATOR IS A RIGHT PAREN.
15434: *
15435: * 2 SCANNING A DIRECT GOTO. THE ONLY VALID
15436: * TERMINATOR IS A RIGHT BRACKET.
15437: {{EJC{{{{
15438: *
15439: * EXPAN (CONTINUED)
15440: *
15441: * ENTRY POINT
15442: *
15443: {EXPAN{PRC{E{0{{ENTRY POINT
15444: {{ZER{-(SP){{{SET TOP OF STACK INDICATOR
15445: {{ZER{R6{{{SET INITIAL STATE TO ZERO
15446: {{ZER{R8{{{ZERO COUNTER VALUE
15447: *
15448: * LOOP HERE FOR SUCCESSIVE ENTRIES
15449: *
15450: {EXP01{JSR{SCANE{{{SCAN NEXT ELEMENT
15451: {{ADD{R6{R10{{ADD STATE TO SYNTAX CODE
15452: {{BSW{R10{T$NES{{SWITCH ON ELEMENT TYPE/STATE
15453: {{IFF{T$UO0{EXP27{{UNOP, S=0
15454: {{IFF{T$UO1{EXP27{{UNOP, S=1
15455: {{IFF{T$UO2{EXP04{{UNOP, S=2
15456: {{IFF{T$LP0{EXP06{{LEFT PAREN, S=0
15457: {{IFF{T$LP1{EXP06{{LEFT PAREN, S=1
15458: {{IFF{T$LP2{EXP04{{LEFT PAREN, S=2
15459: {{IFF{T$LB0{EXP08{{LEFT BRKT, S=0
15460: {{IFF{T$LB1{EXP08{{LEFT BRKT, S=1
15461: {{IFF{T$LB2{EXP09{{LEFT BRKT, S=2
15462: {{IFF{T$CM0{EXP02{{COMMA, S=0
15463: {{IFF{T$CM1{EXP05{{COMMA, S=1
15464: {{IFF{T$CM2{EXP11{{COMMA, S=2
15465: {{IFF{T$FN0{EXP10{{FUNCTION, S=0
15466: {{IFF{T$FN1{EXP10{{FUNCTION, S=1
15467: {{IFF{T$FN2{EXP04{{FUNCTION, S=2
15468: {{IFF{T$VA0{EXP03{{VARIABLE, S=0
15469: {{IFF{T$VA1{EXP03{{VARIABLE, STATE ONE
15470: {{IFF{T$VA2{EXP04{{VARIABLE, S=2
15471: {{IFF{T$CO0{EXP03{{CONSTANT, S=0
15472: {{IFF{T$CO1{EXP03{{CONSTANT, S=1
15473: {{IFF{T$CO2{EXP04{{CONSTANT, S=2
15474: {{IFF{T$BO0{EXP05{{BINOP, S=0
15475: {{IFF{T$BO1{EXP05{{BINOP, S=1
15476: {{IFF{T$BO2{EXP26{{BINOP, S=2
15477: {{IFF{T$RP0{EXP02{{RIGHT PAREN, S=0
15478: {{IFF{T$RP1{EXP05{{RIGHT PAREN, S=1
15479: {{IFF{T$RP2{EXP12{{RIGHT PAREN, S=2
15480: {{IFF{T$RB0{EXP02{{RIGHT BRKT, S=0
15481: {{IFF{T$RB1{EXP05{{RIGHT BRKT, S=1
15482: {{IFF{T$RB2{EXP18{{RIGHT BRKT, S=2
15483: {{IFF{T$CL0{EXP02{{COLON, S=0
15484: {{IFF{T$CL1{EXP05{{COLON, S=1
15485: {{IFF{T$CL2{EXP19{{COLON, S=2
15486: {{IFF{T$SM0{EXP02{{SEMICOLON, S=0
15487: {{IFF{T$SM1{EXP05{{SEMICOLON, S=1
15488: {{IFF{T$SM2{EXP19{{SEMICOLON, S=2
15489: {{ESW{{{{END SWITCH ON ELEMENT TYPE/STATE
15490: {{EJC{{{{
15491: *
15492: * EXPAN (CONTINUED)
15493: *
15494: * HERE FOR RBR,RPR,COL,SMC,CMA IN STATE 0
15495: *
15496: * SET TO RESCAN THE TERMINATOR ENCOUNTERED AND CREATE
15497: * A NULL CONSTANT (CASE OF OMITTED NULL)
15498: *
15499: {EXP02{MNZ{SCNRS{{{SET TO RESCAN ELEMENT
15500: {{MOV{#NULLS{R9{{POINT TO NULL, MERGE
15501: *
15502: * HERE FOR VAR OR CON IN STATES 0,1
15503: *
15504: * STACK THE VARIABLE/CONSTANT AND SET STATE=2
15505: *
15506: {EXP03{MOV{R9{-(SP){{STACK POINTER TO OPERAND
15507: {{MOV{#NUM02{R6{{SET STATE 2
15508: {{BRN{EXP01{{{JUMP FOR NEXT ELEMENT
15509: *
15510: * HERE FOR VAR,CON,LPR,FNC,UOP IN STATE 2
15511: *
15512: * WE RESCAN THE ELEMENT AND CREATE A CONCATENATION OPERATOR
15513: * THIS IS THE CASE OF THE BLANK CONCATENATION OPERATOR.
15514: *
15515: {EXP04{MNZ{SCNRS{{{SET TO RESCAN ELEMENT
15516: {{MOV{#OPDVC{R9{{POINT TO CONCAT OPERATOR DV
15517: {{BZE{R7{EXP4A{{OK IF AT TOP LEVEL
15518: {{MOV{#OPDVP{R9{{ELSE POINT TO UNMISTAKABLE CONCAT.
15519: *
15520: * MERGE HERE WHEN XR SET UP WITH PROPER CONCATENATION DVBLK
15521: *
15522: {EXP4A{BNZ{SCNBL{EXP26{{MERGE BOP IF BLANKS, ELSE ERROR
15523: {{DCV{SCNSE{{{ADJUST START OF ELEMENT LOCATION
15524: {{ERB{220{SYNTAX{{ERROR. MISSING OPERATOR
15525: *
15526: * HERE FOR CMA,RPR,RBR,COL,SMC,BOP(S=1) BOP(S=0)
15527: *
15528: * THIS IS AN ERRONOUS CONTRUCTION
15529: *
15530: {EXP05{DCV{SCNSE{{{ADJUST START OF ELEMENT LOCATION
15531: {{ERB{221{SYNTAX{{ERROR. MISSING OPERAND
15532: *
15533: * HERE FOR LPR (S=0,1)
15534: *
15535: {EXP06{MOV{#NUM04{R10{{SET NEW LEVEL INDICATOR
15536: {{ZER{R9{{{SET ZERO VALUE FOR CMOPN
15537: {{EJC{{{{
15538: *
15539: * EXPAN (CONTINUED)
15540: *
15541: * MERGE HERE TO STORE OLD LEVEL ON STACK AND START NEW ONE
15542: *
15543: {EXP07{MOV{R9{-(SP){{STACK CMOPN VALUE
15544: {{MOV{R8{-(SP){{STACK OLD COUNTER
15545: {{MOV{R7{-(SP){{STACK OLD LEVEL INDICATOR
15546: {{CHK{{{{CHECK FOR STACK OVERFLOW
15547: {{ZER{R6{{{SET NEW STATE TO ZERO
15548: {{MOV{R10{R7{{SET NEW LEVEL INDICATOR
15549: {{MOV{#NUM01{R8{{INITIALIZE NEW COUNTER
15550: {{BRN{EXP01{{{JUMP TO SCAN NEXT ELEMENT
15551: *
15552: * HERE FOR LBR (S=0,1)
15553: *
15554: * THIS IS AN ILLEGAL USE OF LEFT BRACKET
15555: *
15556: {EXP08{ERB{222{SYNTAX{{ERROR. INVALID USE OF LEFT BRACKET
15557: *
15558: * HERE FOR LBR (S=2)
15559: *
15560: * SET NEW LEVEL AND START TO SCAN SUBSCRIPTS
15561: *
15562: {EXP09{MOV{(SP)+{R9{{LOAD ARRAY PTR FOR CMOPN
15563: {{MOV{#NUM03{R10{{SET NEW LEVEL INDICATOR
15564: {{BRN{EXP07{{{JUMP TO STACK OLD AND START NEW
15565: *
15566: * HERE FOR FNC (S=0,1)
15567: *
15568: * STACK OLD LEVEL AND START TO SCAN ARGUMENTS
15569: *
15570: {EXP10{MOV{#NUM05{R10{{SET NEW LEV INDIC (XR=VRBLK=CMOPN)
15571: {{BRN{EXP07{{{JUMP TO STACK OLD AND START NEW
15572: *
15573: * HERE FOR CMA (S=2)
15574: *
15575: * INCREMENT ARGUMENT COUNT AND CONTINUE
15576: *
15577: {EXP11{ICV{R8{{{INCREMENT COUNTER
15578: {{JSR{EXPDM{{{DUMP OPERATORS AT THIS LEVEL
15579: {{ZER{-(SP){{{SET NEW LEVEL FOR PARAMETER
15580: {{ZER{R6{{{SET NEW STATE
15581: {{BGT{R7{#NUM02{EXP01{LOOP BACK UNLESS OUTER LEVEL
15582: {{ERB{223{SYNTAX{{ERROR. INVALID USE OF COMMA
15583: {{EJC{{{{
15584: *
15585: * EXPAN (CONTINUED)
15586: *
15587: * HERE FOR RPR (S=2)
15588: *
15589: * AT OUTER LEVEL IN A NORMAL GOTO THIS IS A TERMINATOR
15590: * OTHERWISE IT MUST TERMINATE A FUNCTION OR GROUPING
15591: *
15592: {EXP12{BEQ{R7{#NUM01{EXP20{END OF NORMAL GOTO
15593: {{BEQ{R7{#NUM05{EXP13{END OF FUNCTION ARGUMENTS
15594: {{BEQ{R7{#NUM04{EXP14{END OF GROUPING / SELECTION
15595: {{ERB{224{SYNTAX{{ERROR. UNBALANCED RIGHT PARENTHESIS
15596: *
15597: * HERE AT END OF FUNCTION ARGUMENTS
15598: *
15599: {EXP13{MOV{#C$FNC{R10{{SET CMTYP VALUE FOR FUNCTION
15600: {{BRN{EXP15{{{JUMP TO BUILD CMBLK
15601: *
15602: * HERE FOR END OF GROUPING
15603: *
15604: {EXP14{BEQ{R8{#NUM01{EXP17{JUMP IF END OF GROUPING
15605: {{MOV{#C$SEL{R10{{ELSE SET CMTYP FOR SELECTION
15606: *
15607: * MERGE HERE TO BUILD CMBLK FOR LEVEL JUST SCANNED AND
15608: * TO POP UP TO THE PREVIOUS SCAN LEVEL BEFORE CONTINUING.
15609: *
15610: {EXP15{JSR{EXPDM{{{DUMP OPERATORS AT THIS LEVEL
15611: {{MOV{R8{R6{{COPY COUNT
15612: {{ADD{#CMVLS{R6{{ADD FOR STANDARD FIELDS AT START
15613: {{WTB{R6{{{CONVERT LENGTH TO BYTES
15614: {{JSR{ALLOC{{{ALLOCATE SPACE FOR CMBLK
15615: {{MOV{#B$CMT{(R9){{STORE TYPE CODE FOR CMBLK
15616: {{MOV{R10{4*CMTYP(R9){{STORE CMBLK NODE TYPE INDICATOR
15617: {{MOV{R6{4*CMLEN(R9){{STORE LENGTH
15618: {{ADD{R6{R9{{POINT PAST END OF BLOCK
15619: {{LCT{R8{R8{{SET LOOP COUNTER
15620: *
15621: * LOOP TO MOVE REMAINING WORDS TO CMBLK
15622: *
15623: {EXP16{MOV{(SP)+{-(R9){{MOVE ONE OPERAND PTR FROM STACK
15624: {{MOV{(SP)+{R7{{POP TO OLD LEVEL INDICATOR
15625: {{BCT{R8{EXP16{{LOOP TILL ALL MOVED
15626: {{EJC{{{{
15627: *
15628: * EXPAN (CONTINUED)
15629: *
15630: * COMPLETE CMBLK AND STACK POINTER TO IT ON STACK
15631: *
15632: {{SUB{#4*CMVLS{R9{{POINT BACK TO START OF BLOCK
15633: {{MOV{(SP)+{R8{{RESTORE OLD COUNTER
15634: {{MOV{(SP){4*CMOPN(R9){{STORE OPERAND PTR IN CMBLK
15635: {{MOV{R9{(SP){{STACK CMBLK POINTER
15636: {{MOV{#NUM02{R6{{SET NEW STATE
15637: {{BRN{EXP01{{{BACK FOR NEXT ELEMENT
15638: *
15639: * HERE AT END OF A PARENTHESIZED EXPRESSION
15640: *
15641: {EXP17{JSR{EXPDM{{{DUMP OPERATORS AT THIS LEVEL
15642: {{MOV{(SP)+{R9{{RESTORE XR
15643: {{MOV{(SP)+{R7{{RESTORE OUTER LEVEL
15644: {{MOV{(SP)+{R8{{RESTORE OUTER COUNT
15645: {{MOV{R9{(SP){{STORE OPND OVER UNUSED CMOPN VAL
15646: {{MOV{#NUM02{R6{{SET NEW STATE
15647: {{BRN{EXP01{{{BACK FOR NEXT ELE8ENT
15648: *
15649: * HERE FOR RBR (S=2)
15650: *
15651: * AT OUTER LEVEL IN A DIRECT GOTO, THIS IS A TERMINATOR.
15652: * OTHERWISE IT MUST TERMINATE A SUBSCRIPT LIST.
15653: *
15654: {EXP18{MOV{#C$ARR{R10{{SET CMTYP FOR ARRAY REFERENCE
15655: {{BEQ{R7{#NUM03{EXP15{JUMP TO BUILD CMBLK IF END ARRAYREF
15656: {{BEQ{R7{#NUM02{EXP20{JUMP IF END OF DIRECT GOTO
15657: {{ERB{225{SYNTAX{{ERROR. UNBALANCED RIGHT BRACKET
15658: {{EJC{{{{
15659: *
15660: * EXPAN (CONTINUED)
15661: *
15662: * HERE FOR COL,SMC (S=2)
15663: *
15664: * ERROR UNLESS TERMINATING STATEMENT BODY AT OUTER LEVEL
15665: *
15666: {EXP19{MNZ{SCNRS{{{RESCAN TERMINATOR
15667: {{MOV{R7{R10{{COPY LEVEL INDICATOR
15668: {{BSW{R10{6{{SWITCH ON LEVEL INDICATOR
15669: {{IFF{0{EXP20{{NORMAL OUTER LEVEL
15670: {{IFF{1{EXP22{{FAIL IF NORMAL GOTO
15671: {{IFF{2{EXP23{{FAIL IF DIRECT GOTO
15672: {{IFF{3{EXP24{{FAIL ARRAY BRACKETS
15673: {{IFF{4{EXP21{{FAIL IF IN GROUPING
15674: {{IFF{5{EXP21{{FAIL FUNCTION ARGS
15675: {{ESW{{{{END SWITCH ON LEVEL
15676: *
15677: * HERE AT NORMAL END OF EXPRESSION
15678: *
15679: {EXP20{JSR{EXPDM{{{DUMP REMAINING OPERATORS
15680: {{MOV{(SP)+{R9{{LOAD TREE POINTER
15681: {{ICA{SP{{{POP OFF BOTTOM OF STACK MARKER
15682: {{EXI{{{{RETURN TO EXPAN CALLER
15683: *
15684: * MISSING RIGHT PAREN
15685: *
15686: {EXP21{ERB{226{SYNTAX{{ERROR. MISSING RIGHT PAREN
15687: *
15688: * MISSING RIGHT PAREN IN GOTO FIELD
15689: *
15690: {EXP22{ERB{227{SYNTAX{{ERROR. RIGHT PAREN MISSING FROM GOTO
15691: *
15692: * MISSING BRACKET IN GOTO
15693: *
15694: {EXP23{ERB{228{SYNTAX{{ERROR. RIGHT BRACKET MISSING FROM GOTO
15695: *
15696: * MISSING ARRAY BRACKET
15697: *
15698: {EXP24{ERB{229{SYNTAX{{ERROR. MISSING RIGHT ARRAY BRACKET
15699: {{EJC{{{{
15700: *
15701: * EXPAN (CONTINUED)
15702: *
15703: * LOOP HERE WHEN AN OPERATOR CAUSES AN OPERATOR DUMP
15704: *
15705: {EXP25{MOV{R9{EXPSV{{
15706: {{JSR{EXPOP{{{POP ONE OPERATOR
15707: {{MOV{EXPSV{R9{{RESTORE OP DV POINTER AND MERGE
15708: *
15709: * HERE FOR BOP (S=2)
15710: *
15711: * REMOVE OPERATORS (CONDENSE) FROM STACK UNTIL NO MORE
15712: * LEFT AT THIS LEVEL OR TOP ONE HAS LOWER PRECEDENCE.
15713: * LOOP HERE TILL THIS CONDITION IS MET.
15714: *
15715: {EXP26{MOV{4*1(SP){R10{{LOAD OPERATOR DVPTR FROM STACK
15716: {{BLE{R10{#NUM05{EXP27{JUMP IF BOTTOM OF STACK LEVEL
15717: {{BLT{4*DVRPR(R9){4*DVLPR(R10){EXP25{ELSE POP IF NEW PREC IS LO
15718: *
15719: * HERE FOR UOP (S=0,1)
15720: *
15721: * BINARY OPERATOR MERGES AFTER PRECEDENCE CHECK
15722: *
15723: * THE OPERATOR DV IS STORED ON THE STACK AND THE SCAN
15724: * CONTINUES AFTER SETTING THE SCAN STATE TO ONE.
15725: *
15726: {EXP27{MOV{R9{-(SP){{STACK OPERATOR DVPTR ON STACK
15727: {{CHK{{{{CHECK FOR STACK OVERFLOW
15728: {{MOV{#NUM01{R6{{SET NEW STATE
15729: {{BNE{R9{#OPDVS{EXP01{BACK FOR NEXT ELEMENT UNLESS =
15730: *
15731: * HERE FOR SPECIAL CASE OF BINARY =. THE SYNTAX ALLOWS A
15732: * NULL RIGHT ARGUMENT FOR THIS OPERATOR TO BE LEFT
15733: * OUT. ACCORDINGLY WE RESET TO STATE ZERO TO GET PROPER
15734: * ACTION ON A TERMINATOR (SUPPLY A NULL CONSTANT).
15735: *
15736: {{ZER{R6{{{SET STATE ZERO
15737: {{BRN{EXP01{{{JUMP FOR NEXT ELEMENT
15738: {{ENP{{{{END PROCEDURE EXPAN
15739: {{EJC{{{{
15740: *
15741: * EXPAP -- TEST FOR PATTERN MATCH TREE
15742: *
15743: * EXPAP IS PASSED AN EXPRESSION TREE TO DETERMINE IF IT
15744: * IS A PATTERN MATCH. THE FOLLOWING ARE RECOGIZED AS
15745: * MATCHES IN THE CONTEXT OF THIS CALL.
15746: *
15747: * 1) AN EXPLICIT USE OF BINARY QUESTION MARK
15748: * 2) A CONCATENATION
15749: * 3) AN ALTERNATION WHOSE LEFT OPERAND IS A CONCATENATION
15750: *
15751: * (XR) PTR TO EXPAN TREE
15752: * JSR EXPAP CALL TO TEST FOR PATTERN MATCH
15753: * PPM LOC TRANSFER LOC IF NOT A PATTERN MATCH
15754: * (WA) DESTROYED
15755: * (XR) UNCHANGED (IF NOT MATCH)
15756: * (XR) PTR TO BINARY OPERATOR BLK IF MATCH
15757: *
15758: {EXPAP{PRC{E{1{{ENTRY POINT
15759: {{MOV{R10{-(SP){{SAVE XL
15760: {{BNE{(R9){#B$CMT{EXPP2{NO MATCH IF NOT COMPLEX
15761: {{MOV{4*CMTYP(R9){R6{{ELSE LOAD TYPE CODE
15762: {{BEQ{R6{#C$CNC{EXPP1{CONCATENATION IS A MATCH
15763: {{BEQ{R6{#C$PMT{EXPP1{BINARY QUESTION MARK IS A MATCH
15764: {{BNE{R6{#C$ALT{EXPP2{ELSE NOT MATCH UNLESS ALTERNATION
15765: *
15766: * HERE FOR ALTERNATION. CHANGE (A B) / C TO A QM (B / C)
15767: *
15768: {{MOV{4*CMLOP(R9){R10{{LOAD LEFT OPERAND POINTER
15769: {{BNE{(R10){#B$CMT{EXPP2{NOT MATCH IF LEFT OPND NOT COMPLEX
15770: {{BNE{4*CMTYP(R10){#C$CNC{EXPP2{NOT MATCH IF LEFT OP NOT CONC
15771: {{MOV{4*CMROP(R10){4*CMLOP(R9){{XR POINTS TO (B / C)
15772: {{MOV{R9{4*CMROP(R10){{SET XL OPNDS TO A, (B / C)
15773: {{MOV{R10{R9{{POINT TO THIS ALTERED NODE
15774: *
15775: * EXIT HERE FOR PATTERN MATCH
15776: *
15777: {EXPP1{MOV{(SP)+{R10{{RESTORE ENTRY XL
15778: {{EXI{{{{GIVE PATTERN MATCH RETURN
15779: *
15780: * EXIT HERE IF NOT PATTERN MATCH
15781: *
15782: {EXPP2{MOV{(SP)+{R10{{RESTORE ENTRY XL
15783: {{EXI{1{{{GIVE NON-MATCH RETURN
15784: {{ENP{{{{END PROCEDURE EXPAP
15785: {{EJC{{{{
15786: *
15787: * EXPDM -- DUMP OPERATORS AT CURRENT LEVEL (FOR EXPAN)
15788: *
15789: * EXPDM USES EXPOP TO CONDENSE ALL OPERATORS AT THIS SYNTAX
15790: * LEVEL. THE STACK BOTTOM IS RECOGNIZED FROM THE LEVEL
15791: * VALUE WHICH IS SAVED ON THE TOP OF THE STACK.
15792: *
15793: * JSR EXPDM CALL TO DUMP OPERATORS
15794: * (XS) POPPED AS REQUIRED
15795: * (XR,WA) DESTROYED
15796: *
15797: {EXPDM{PRC{N{0{{ENTRY POINT
15798: {{MOV{R10{R$EXS{{SAVE XL VALUE
15799: *
15800: * LOOP TO DUMP OPERATORS
15801: *
15802: {EXDM1{BLE{4*1(SP){#NUM05{EXDM2{JUMP IF STACK BOTTOM (SAVED LEVEL
15803: {{JSR{EXPOP{{{ELSE POP ONE OPERATOR
15804: {{BRN{EXDM1{{{AND LOOP BACK
15805: *
15806: * HERE AFTER POPPING ALL OPERATORS
15807: *
15808: {EXDM2{MOV{R$EXS{R10{{RESTORE XL
15809: {{ZER{R$EXS{{{RELEASE SAVE LOCATION
15810: {{EXI{{{{RETURN TO EXPDM CALLER
15811: {{ENP{{{{END PROCEDURE EXPDM
15812: {{EJC{{{{
15813: *
15814: * EXPOP-- POP OPERATOR (FOR EXPAN)
15815: *
15816: * EXPOP IS USED BY THE EXPAN ROUTINE TO CONDENSE ONE
15817: * OPERATOR FROM THE TOP OF THE SYNTAX STACK. AN APPROPRIATE
15818: * CMBLK IS BUILT FOR THE OPERATOR (UNARY OR BINARY) AND A
15819: * POINTER TO THIS CMBLK IS STACKED.
15820: *
15821: * EXPOP IS ALSO USED BY SCNGF (GOTO FIELD SCAN) PROCEDURE
15822: *
15823: * JSR EXPOP CALL TO POP OPERATOR
15824: * (XS) POPPED APPROPRIATELY
15825: * (XR,XL,WA) DESTROYED
15826: *
15827: {EXPOP{PRC{N{0{{ENTRY POINT
15828: {{MOV{4*1(SP){R9{{LOAD OPERATOR DV POINTER
15829: {{BEQ{4*DVLPR(R9){#LLUNO{EXPO2{JUMP IF UNARY
15830: *
15831: * HERE FOR BINARY OPERATOR
15832: *
15833: {{MOV{#4*CMBS${R6{{SET SIZE OF BINARY OPERATOR CMBLK
15834: {{JSR{ALLOC{{{ALLOCATE SPACE FOR CMBLK
15835: {{MOV{(SP)+{4*CMROP(R9){{POP AND STORE RIGHT OPERAND PTR
15836: {{MOV{(SP)+{R10{{POP AND LOAD OPERATOR DV PTR
15837: {{MOV{(SP){4*CMLOP(R9){{STORE LEFT OPERAND POINTER
15838: *
15839: * COMMON EXIT POINT
15840: *
15841: {EXPO1{MOV{#B$CMT{(R9){{STORE TYPE CODE FOR CMBLK
15842: {{MOV{4*DVTYP(R10){4*CMTYP(R9){{STORE CMBLK NODE TYPE CODE
15843: {{MOV{R10{4*CMOPN(R9){{STORE DVPTR (=PTR TO DAC O$XXX)
15844: {{MOV{R6{4*CMLEN(R9){{STORE CMBLK LENGTH
15845: {{MOV{R9{(SP){{STORE RESULTING NODE PTR ON STACK
15846: {{EXI{{{{RETURN TO EXPOP CALLER
15847: *
15848: * HERE FOR UNARY OPERATOR
15849: *
15850: {EXPO2{MOV{#4*CMUS${R6{{SET SIZE OF UNARY OPERATOR CMBLK
15851: {{JSR{ALLOC{{{ALLOCATE SPACE FOR CMBLK
15852: {{MOV{(SP)+{4*CMROP(R9){{POP AND STORE OPERAND POINTER
15853: {{MOV{(SP){R10{{LOAD OPERATOR DV POINTER
15854: {{BRN{EXPO1{{{MERGE BACK TO EXIT
15855: {{ENP{{{{END PROCEDURE EXPOP
15856: {{EJC{{{{
15857: *
15858: * FLSTG -- FOLD STRING TO UPPER CASE
15859: *
15860: * FLSTG FOLDS A CHARACTER STRING CONTAINING LOWER CASE
15861: * CHARACCTERS TO ONE CONTAINING UPPER CASE CHARACTERS.
15862: * FOLDING IS ONLY DONE IF &CASE (KVCAS) IS NOT ZERO.
15863: *
15864: * (XR) STRING ARGUMENT
15865: * (WA) LENGTH OF STRING
15866: * JSR FLSTG CALL TO FOLD STRING
15867: * (XR) RESULT STRING (POSSIBLY ORIGINAL)
15868: * (WC) DESTROYED
15869: *
15870: {FLSTG{PRC{R{0{{ENTRY POINT
15871: {{BZE{KVCAS{FST99{{SKIP IF &CASE IS 0
15872: {{MOV{R10{-(SP){{SAVE XL ACROSS CALL
15873: {{MOV{R9{-(SP){{SAVE ORIGINAL SCBLK PTR
15874: {{JSR{ALOCS{{{ALLOCATE NEW STRING BLOCK
15875: {{MOV{(SP){R10{{POINT TO ORIGINAL SCBLK
15876: {{MOV{R9{-(SP){{SAVE POINTER TO NEW SCBLK
15877: {{PLC{R10{{{POINT TO ORIGINAL CHARS
15878: {{PLC{R9{{{POINT TO NEW CHARS
15879: {{ZER{-(SP){{{INIT DID FOLD FLAG
15880: {{LCT{R8{R8{{LOAD LOOP COUNTER
15881: {FST01{LCH{R6{(R10)+{{LOAD CHARACTER
15882: {{BGT{#CH$$A{R6{FST02{SKIP IF LESS THAN LC A
15883: {{BGT{R6{#CH$$${FST02{SKIP IF GREATER THAN LC Z
15884: {{FLC{R6{{{FOLD CHARACTER TO UPPER CASE
15885: {{MNZ{(SP){{{SET DID FOLD CHARACTER FLAG
15886: {FST02{SCH{R6{(R9)+{{STORE (POSSIBLY FOLDED) CHARACTER
15887: {{BCT{R8{FST01{{LOOP THRU ENTIRE STRING
15888: {{CSC{R9{{{COMPLETE STORE CHARACTERS
15889: {{BNZ{(SP)+{FST10{{SKIP IF FOLDING DONE
15890: {{MOV{(SP)+{DNAMP{{DO NOT NEED NEW SCBLK
15891: {{MOV{(SP)+{R9{{RETURN ORIGINAL SCBLK
15892: {{BRN{FST20{{{MERGE BELOW
15893: {FST10{MOV{(SP)+{R9{{RETURN NEW SCBLK
15894: {{ICA{SP{{{THROW AWAY ORIGINAL SCBLK POINTER
15895: {FST20{MOV{4*SCLEN(R9){R6{{RELOAD STRING LENGTH
15896: {{MOV{(SP)+{R10{{RESTORE XL
15897: {FST99{EXI{{{{RETURN
15898: {{ENP{{{{
15899: {{EJC{{{{
15900: *
15901: * GBCOL -- PERFORM GARBAGE COLLECTION
15902: *
15903: * GBCOL PERFORMS A GARBAGE COLLECTION ON THE DYNAMIC REGION
15904: * ALL BLOCKS WHICH ARE NO LONGER IN USE ARE ELIMINATED
15905: * BY MOVING BLOCKS WHICH ARE IN USE DOWN AND RESETTING
15906: * DNAMP, THE POINTER TO THE NEXT AVAILABLE LOCATION.
15907: *
15908: * (WB) MOVE OFFSET (SEE BELOW)
15909: * JSR GBCOL CALL TO COLLECT GARBAGE
15910: * (XR) DESTROYED
15911: *
15912: * THE FOLLOWING CONDITIONS MUST BE MET AT THE TIME WHEN
15913: * GBCOL IS CALLED.
15914: *
15915: * 1) ALL POINTERS TO BLOCKS IN THE DYNAMIC AREA MUST BE
15916: * ACCESSIBLE TO THE GARBAGE COLLECTOR. THIS MEANS
15917: * THAT THEY MUST OCCUR IN ONE OF THE FOLLOWING.
15918: *
15919: * A) MAIN STACK, WITH CURRENT TOP
15920: * ELEMENT BEING INDICATED BY XS
15921: *
15922: * B) IN RELOCATABLE FIELDS OF VRBLKS.
15923: *
15924: * C) IN REGISTER XL AT THE TIME OF CALL
15925: *
15926: * E) IN THE SPECIAL REGION OF WORKING
15927: * STORAGE WHERE NAMES BEGIN WITH R$.
15928: *
15929: * 2) ALL POINTERS MUST POINT TO THE START OF BLOCKS WITH
15930: * THE SOLE EXCEPTION OF THE CONTENTS OF THE CODE
15931: * POINTER REGISTER WHICH POINTS INTO THE R$COD BLOCK.
15932: *
15933: * 3) NO LOCATION WHICH APPEARS TO CONTAIN A POINTER
15934: * INTO THE DYNAMIC REGION MAY OCCUR UNLESS IT IS IN
15935: * FACT A POINTER TO THE START OF THE BLOCK. HOWEVER
15936: * POINTERS OUTSIDE THIS AREA MAY OCCUR AND WILL
15937: * NOT BE CHANGED BY THE GARBAGE COLLECTOR.
15938: * IT IS ESPECIALLY IMPORTANT TO MAKE SURE THAT XL
15939: * DOES NOT CONTAIN A GARBAGE VALUE FROM SOME PROCESS
15940: * CARRIED OUT BEFORE THE CALL TO THE COLLECTOR.
15941: *
15942: * GBCOL HAS THE CAPABILITY OF MOVING THE FINAL COMPACTED
15943: * RESULT UP IN MEMORY (WITH ADDRESSES ADJUSTED ACCORDINGLY)
15944: * THIS IS USED TO ADD SPACE TO THE STATIC REGION. THE
15945: * ENTRY VALUE OF WB IS THE NUMBER OF BYTES TO MOVE UP.
15946: * THE CALLER MUST GUARANTEE THAT THERE IS ENOUGH ROOM.
15947: * FURTHERMORE THE VALUE IN WB IF IT IS NON-ZERO, MUST BE AT
15948: * LEAST 256 SO THAT THE MWB INSTRUCTION CONDITIONS ARE MET.
15949: {{EJC{{{{
15950: *
15951: * GBCOL (CONTINUED)
15952: *
15953: * THE ALGORITHM, WHICH IS A MODIFICATION OF THE LISP-2
15954: * GARBAGE COLLECTOR DEVISED BY R.DEWAR AND K.BELCHER
15955: * TAKES THREE PASSES AS FOLLOWS.
15956: *
15957: * 1) ALL POINTERS IN MEMORY ARE SCANNED AND BLOCKS IN USE
15958: * DETERMINED FROM THIS SCAN. NOTE THAT THIS PROCEDURE
15959: * IS RECURSIVE AND USES THE MAIN STACK FOR LINKAGE.
15960: * THE MARKING PROCESS IS THUS SIMILAR TO THAT USED IN
15961: * A STANDARD LISP COLLECTOR. HOWEVER THE METHOD OF
15962: * ACTUALLY MARKING THE BLOCKS IS DIFFERENT.
15963: *
15964: * THE FIRST FIELD OF A BLOCK NORMALLY CONTAINS A
15965: * CODE ENTRY POINT POINTER. SUCH AN ENTRY POINTER
15966: * CAN BE DISTINGUISHED FROM THE ADDRESS OF ANY POINTER
15967: * TO BE PROCESSED BY THE COLLECTOR. DURING GARBAGE
15968: * COLLECTION, THIS WORD IS USED TO BUILD A BACK CHAIN
15969: * OF POINTERS THROUGH FIELDS WHICH POINT TO THE BLOCK.
15970: * THE END OF THE CHAIN IS MARKED BY THE OCCURENCE
15971: * OF THE WORD WHICH USED TO BE IN THE FIRST WORD OF
15972: * THE BLOCK. THIS BACKCHAIN SERVES BOTH AS A MARK
15973: * INDICATING THAT THE BLOCK IS IN USE AND AS A LIST OF
15974: * REFERENCES FOR THE RELOCATION PHASE.
15975: *
15976: * 2) STORAGE IS SCANNED SEQUENTIALLY TO DISCOVER WHICH
15977: * BLOCKS ARE CURRENTLY IN USE AS INDICATED BY THE
15978: * PRESENCE OF A BACKCHAIN. TWO POINTERS ARE MAINTAINED
15979: * ONE SCANS THROUGH LOOKING AT EACH BLOCK. THE OTHER
15980: * IS INCREMENTED ONLY FOR BLOCKS FOUND TO BE IN USE.
15981: * IN THIS WAY, THE EVENTUAL LOCATION OF EACH BLOCK CAN
15982: * BE DETERMINED WITHOUT ACTUALLY MOVING ANY BLOCKS.
15983: * AS EACH BLOCK WHICH IS IN USE IS PROCESSED, THE BACK
15984: * CHAIN IS USED TO RESET ALL POINTERS WHICH POINT TO
15985: * THIS BLOCK TO CONTAIN ITS NEW ADDRESS, I.E. THE
15986: * ADDRESS IT WILL OCCUPY AFTER THE BLOCKS ARE MOVED.
15987: * THE FIRST WORD OF THE BLOCK, TAKEN FROM THE END OF
15988: * THE CHAIN IS RESTORED AT THIS POINT.
15989: *
15990: * DURING PASS 2, THE COLLECTOR BUILDS BLOCKS WHICH
15991: * DESCRIBE THE REGIONS OF STORAGE WHICH ARE TO BE
15992: * MOVED IN THE THIRD PASS. THERE IS ONE DESCRIPTOR FOR
15993: * EACH CONTIGUOUS SET OF GOOD BLOCKS. THE DESCRIPTOR
15994: * IS BUILT JUST BEHIND THE BLOCK TO BE MOVED AND
15995: * CONTAINS A POINTER TO THE NEXT BLOCK AND THE NUMBER
15996: * OF WORDS TO BE MOVED.
15997: *
15998: * 3) IN THE THIRD AND FINAL PASS, THE MOVE DESCRIPTOR
15999: * BLOCKS BUILT IN PASS TWO ARE USED TO ACTUALLY MOVE
16000: * THE BLOCKS DOWN TO THE BOTTOM OF THE DYNAMIC REGION.
16001: * THE COLLECTION IS THEN COMPLETE AND THE NEXT
16002: * AVAILABLE LOCATION POINTER IS RESET.
16003: {{EJC{{{{
16004: *
16005: * GBCOL (CONTINUED)
16006: *
16007: {GBCOL{PRC{E{0{{ENTRY POINT
16008: {{BNZ{DMVCH{GBC14{{FAIL IF IN MID-DUMP
16009: {{MNZ{GBCFL{{{NOTE GBCOL ENTERED
16010: {{MOV{R6{GBSVA{{SAVE ENTRY WA
16011: {{MOV{R7{GBSVB{{SAVE ENTRY WB
16012: {{MOV{R8{GBSVC{{SAVE ENTRY WC
16013: {{MOV{R10{-(SP){{SAVE ENTRY XL
16014: {{SCP{R6{{{GET CODE POINTER VALUE
16015: {{SUB{R$COD{R6{{MAKE RELATIVE
16016: {{LCP{R6{{{AND RESTORE
16017: *
16018: * PROCESS STACK ENTRIES
16019: *
16020: {{MOV{SP{R9{{POINT TO STACK FRONT
16021: {{MOV{STBAS{R10{{POINT PAST END OF STACK
16022: {{BGE{R10{R9{GBC00{OK IF D-STACK
16023: {{MOV{R10{R9{{REVERSE IF ...
16024: {{MOV{SP{R10{{... U-STACK
16025: *
16026: * PROCESS THE STACK
16027: *
16028: {GBC00{JSR{GBCPF{{{PROCESS POINTERS ON STACK
16029: *
16030: * PROCESS SPECIAL WORK LOCATIONS
16031: *
16032: {{MOV{#R$AAA{R9{{POINT TO START OF RELOCATABLE LOCS
16033: {{MOV{#R$YYY{R10{{POINT PAST END OF RELOCATABLE LOCS
16034: {{JSR{GBCPF{{{PROCESS WORK FIELDS
16035: *
16036: * PREPARE TO PROCESS VARIABLE BLOCKS
16037: *
16038: {{MOV{HSHTB{R6{{POINT TO FIRST HASH SLOT POINTER
16039: *
16040: * LOOP THROUGH HASH SLOTS
16041: *
16042: {GBC01{MOV{R6{R10{{POINT TO NEXT SLOT
16043: {{ICA{R6{{{BUMP BUCKET POINTER
16044: {{MOV{R6{GBCNM{{SAVE BUCKET POINTER
16045: {{EJC{{{{
16046: *
16047: * GBCOL (CONTINUED)
16048: *
16049: * LOOP THROUGH VARIABLES ON ONE HASH CHAIN
16050: *
16051: {GBC02{MOV{(R10){R9{{LOAD PTR TO NEXT VRBLK
16052: {{BZE{R9{GBC03{{JUMP IF END OF CHAIN
16053: {{MOV{R9{R10{{ELSE COPY VRBLK POINTER
16054: {{ADD{#4*VRVAL{R9{{POINT TO FIRST RELOC FLD
16055: {{ADD{#4*VRNXT{R10{{POINT PAST LAST (AND TO LINK PTR)
16056: {{JSR{GBCPF{{{PROCESS RELOC FIELDS IN VRBLK
16057: {{BRN{GBC02{{{LOOP BACK FOR NEXT BLOCK
16058: *
16059: * HERE AT END OF ONE HASH CHAIN
16060: *
16061: {GBC03{MOV{GBCNM{R6{{RESTORE BUCKET POINTER
16062: {{BNE{R6{HSHTE{GBC01{LOOP BACK IF MORE BUCKETS TO GO
16063: {{EJC{{{{
16064: *
16065: * GBCOL (CONTINUED)
16066: *
16067: * NOW WE ARE READY TO START PASS TWO. REGISTERS ARE USED
16068: * AS FOLLOWS IN PASS TWO.
16069: *
16070: * (XR) SCANS THROUGH ALL BLOCKS
16071: * (WC) POINTER TO EVENTUAL LOCATION
16072: *
16073: * THE MOVE DESCRIPTION BLOCKS BUILT IN THIS PASS HAVE
16074: * THE FOLLOWING FORMAT.
16075: *
16076: * WORD 1 POINTER TO NEXT MOVE BLOCK,
16077: * ZERO IF END OF CHAIN OF BLOCKS
16078: *
16079: * WORD 2 LENGTH OF BLOCKS TO BE MOVED IN
16080: * BYTES. SET TO THE ADDRESS OF THE
16081: * FIRST BYTE WHILE ACTUALLY SCANNING
16082: * THE BLOCKS.
16083: *
16084: * THE FIRST ENTRY ON THIS CHAIN IS A SPECIAL ENTRY
16085: * CONSISTING OF THE TWO WORDS GBCNM AND GBCNS. AFTER
16086: * BUILDING THE CHAIN OF MOVE DESCRIPTORS, GBCNM POINTS TO
16087: * THE FIRST REAL MOVE BLOCK, AND GBCNS IS THE LENGTH OF
16088: * BLOCKS IN USE AT THE START OF STORAGE WHICH NEED NOT
16089: * BE MOVED SINCE THEY ARE IN THE CORRECT POSITION.
16090: *
16091: {GBC04{MOV{DNAMB{R9{{POINT TO FIRST BLOCK
16092: {{MOV{R9{R8{{SET AS FIRST EVENTUAL LOCATION
16093: {{ADD{GBSVB{R8{{ADD OFFSET FOR EVENTUAL MOVE UP
16094: {{ZER{GBCNM{{{CLEAR INITIAL FORWARD POINTER
16095: {{MOV{#GBCNM{GBCLM{{INITIALIZE PTR TO LAST MOVE BLOCK
16096: {{MOV{R9{GBCNS{{INITIALIZE FIRST ADDRESS
16097: *
16098: * LOOP THROUGH A SERIES OF BLOCKS IN USE
16099: *
16100: {GBC05{BEQ{R9{DNAMP{GBC07{JUMP IF END OF USED REGION
16101: {{MOV{(R9){R6{{ELSE GET FIRST WORD
16102: {{BHI{R6{#P$YYY{GBC06{SKIP IF NOT ENTRY PTR (IN USE)
16103: {{BHI{R6{#B$AAA{GBC07{JUMP IF ENTRY POINTER (UNUSED)
16104: *
16105: * HERE FOR BLOCK IN USE, LOOP TO RELOCATE REFERENCES
16106: *
16107: {GBC06{MOV{R6{R10{{COPY POINTER
16108: {{MOV{(R10){R6{{LOAD FORWARD POINTER
16109: {{MOV{R8{(R10){{RELOCATE REFERENCE
16110: {{BHI{R6{#P$YYY{GBC06{LOOP BACK IF NOT END OF CHAIN
16111: {{BLO{R6{#B$AAA{GBC06{LOOP BACK IF NOT END OF CHAIN
16112: {{EJC{{{{
16113: *
16114: * GBCOL (CONTINUED)
16115: *
16116: * AT END OF CHAIN, RESTORE FIRST WORD AND BUMP PAST
16117: *
16118: {{MOV{R6{(R9){{RESTORE FIRST WORD
16119: {{JSR{BLKLN{{{GET LENGTH OF THIS BLOCK
16120: {{ADD{R6{R9{{BUMP ACTUAL POINTER
16121: {{ADD{R6{R8{{BUMP EVENTUAL POINTER
16122: {{BRN{GBC05{{{LOOP BACK FOR NEXT BLOCK
16123: *
16124: * HERE AT END OF A SERIES OF BLOCKS IN USE
16125: *
16126: {GBC07{MOV{R9{R6{{COPY POINTER PAST LAST BLOCK
16127: {{MOV{GBCLM{R10{{POINT TO PREVIOUS MOVE BLOCK
16128: {{SUB{4*1(R10){R6{{SUBTRACT STARTING ADDRESS
16129: {{MOV{R6{4*1(R10){{STORE LENGTH OF BLOCK TO BE MOVED
16130: *
16131: * LOOP THROUGH A SERIES OF BLOCKS NOT IN USE
16132: *
16133: {GBC08{BEQ{R9{DNAMP{GBC10{JUMP IF END OF USED REGION
16134: {{MOV{(R9){R6{{ELSE LOAD FIRST WORD OF NEXT BLOCK
16135: {{BHI{R6{#P$YYY{GBC09{JUMP IF IN USE
16136: {{BLO{R6{#B$AAA{GBC09{JUMP IF IN USE
16137: {{JSR{BLKLN{{{ELSE GET LENGTH OF NEXT BLOCK
16138: {{ADD{R6{R9{{PUSH POINTER
16139: {{BRN{GBC08{{{AND LOOP BACK
16140: *
16141: * HERE FOR A BLOCK IN USE AFTER PROCESSING A SERIES OF
16142: * BLOCKS WHICH WERE NOT IN USE, BUILD NEW MOVE BLOCK.
16143: *
16144: {GBC09{SUB{#4*NUM02{R9{{POINT 2 WORDS BEHIND FOR MOVE BLOCK
16145: {{MOV{GBCLM{R10{{POINT TO PREVIOUS MOVE BLOCK
16146: {{MOV{R9{(R10){{SET FORWARD PTR IN PREVIOUS BLOCK
16147: {{ZER{(R9){{{ZERO FORWARD PTR OF NEW BLOCK
16148: {{MOV{R9{GBCLM{{REMEMBER ADDRESS OF THIS BLOCK
16149: {{MOV{R9{R10{{COPY PTR TO MOVE BLOCK
16150: {{ADD{#4*NUM02{R9{{POINT BACK TO BLOCK IN USE
16151: {{MOV{R9{4*1(R10){{STORE STARTING ADDRESS
16152: {{BRN{GBC06{{{JUMP TO PROCESS BLOCK IN USE
16153: {{EJC{{{{
16154: *
16155: * GBCOL (CONTINUED)
16156: *
16157: * HERE FOR PASS THREE -- ACTUALLY MOVE THE BLOCKS DOWN
16158: *
16159: * (XL) POINTER TO OLD LOCATION
16160: * (XR) POINTER TO NEW LOCATION
16161: *
16162: {GBC10{MOV{DNAMB{R9{{POINT TO START OF STORAGE
16163: {{ADD{GBCNS{R9{{BUMP PAST UNMOVED BLOCKS AT START
16164: *
16165: * LOOP THROUGH MOVE DESCRIPTORS
16166: *
16167: {GBC11{MOV{GBCNM{R10{{POINT TO NEXT MOVE BLOCK
16168: {{BZE{R10{GBC12{{JUMP IF END OF CHAIN
16169: {{MOV{(R10)+{GBCNM{{MOVE POINTER DOWN CHAIN
16170: {{MOV{(R10)+{R6{{GET LENGTH TO MOVE
16171: {{MVW{{{{PERFORM MOVE
16172: {{BRN{GBC11{{{LOOP BACK
16173: *
16174: * NOW TEST FOR MOVE UP
16175: *
16176: {GBC12{MOV{R9{DNAMP{{SET NEXT AVAILABLE LOC PTR
16177: {{MOV{GBSVB{R7{{RELOAD MOVE OFFSET
16178: {{BZE{R7{GBC13{{JUMP IF NO MOVE REQUIRED
16179: {{MOV{R9{R10{{ELSE COPY OLD TOP OF CORE
16180: {{ADD{R7{R9{{POINT TO NEW TOP OF CORE
16181: {{MOV{R9{DNAMP{{SAVE NEW TOP OF CORE POINTER
16182: {{MOV{R10{R6{{COPY OLD TOP
16183: {{SUB{DNAMB{R6{{MINUS OLD BOTTOM = LENGTH
16184: {{ADD{R7{DNAMB{{BUMP BOTTOM TO GET NEW VALUE
16185: {{MWB{{{{PERFORM MOVE (BACKWARDS)
16186: *
16187: * MERGE HERE TO EXIT
16188: *
16189: {GBC13{MOV{GBSVA{R6{{RESTORE WA
16190: {{SCP{R8{{{GET CODE POINTER
16191: {{ADD{R$COD{R8{{MAKE ABSOLUTE AGAIN
16192: {{LCP{R8{{{AND REPLACE ABSOLUTE VALUE
16193: {{MOV{GBSVC{R8{{RESTORE WC
16194: {{MOV{(SP)+{R10{{RESTORE ENTRY XL
16195: {{ICV{GBCNT{{{INCREMENT COUNT OF COLLECTIONS
16196: {{ZER{R9{{{CLEAR GARBAGE VALUE IN XR
16197: {{ZER{GBCFL{{{NOTE EXIT FROM GBCOL
16198: {{EXI{{{{EXIT TO GBCOL CALLER
16199: *
16200: * GARBAGE COLLECTION NOT ALLOWED WHILST DUMPING
16201: *
16202: {GBC14{ICV{ERRFT{{{FATAL ERROR
16203: {{ERB{250{INSUFFICIENT{{MEMORY TO COMPLETE DUMP
16204: {{ENP{{{{END PROCEDURE GBCOL
16205: {{EJC{{{{
16206: *
16207: * GBCPF -- PROCESS FIELDS FOR GARBAGE COLLECTOR
16208: *
16209: * THIS PROCEDURE IS USED BY THE GARBAGE COLLECTOR TO
16210: * PROCESS FIELDS IN PASS ONE. SEE GBCOL FOR FULL DETAILS.
16211: *
16212: * (XR) PTR TO FIRST LOCATION TO PROCESS
16213: * (XL) PTR PAST LAST LOCATION TO PROCESS
16214: * JSR GBCPF CALL TO PROCESS FIELDS
16215: * (XR,WA,WB,WC,IA) DESTROYED
16216: *
16217: * NOTE THAT ALTHOUGH THIS PROCEDURE USES A RECURSIVE
16218: * APPROACH, IT CONTROLS ITS OWN STACK AND IS NOT RECURSIVE.
16219: *
16220: {GBCPF{PRC{E{0{{ENTRY POINT
16221: {{ZER{-(SP){{{SET ZERO TO MARK BOTTOM OF STACK
16222: {{MOV{R10{-(SP){{SAVE END POINTER
16223: *
16224: * MERGE HERE TO GO DOWN A LEVEL AND START A NEW LOOP
16225: *
16226: * 1(XS) NEXT LVL FIELD PTR (0 AT OUTER LVL)
16227: * 0(XS) PTR PAST LAST FIELD TO PROCESS
16228: * (XR) PTR TO FIRST FIELD TO PROCESS
16229: *
16230: * LOOP TO PROCESS SUCCESSIVE FIELDS
16231: *
16232: {GPF01{MOV{(R9){R10{{LOAD FIELD CONTENTS
16233: {{MOV{R9{R8{{SAVE FIELD POINTER
16234: {{BLT{R10{DNAMB{GPF02{JUMP IF NOT PTR INTO DYNAMIC AREA
16235: {{BGE{R10{DNAMP{GPF02{JUMP IF NOT PTR INTO DYNAMIC AREA
16236: *
16237: * HERE WE HAVE A PTR TO A BLOCK IN THE DYNAMIC AREA.
16238: * LINK THIS FIELD ONTO THE REFERENCE BACKCHAIN.
16239: *
16240: {{MOV{(R10){R6{{LOAD PTR TO CHAIN (OR ENTRY PTR)
16241: {{MOV{R9{(R10){{SET THIS FIELD AS NEW HEAD OF CHAIN
16242: {{MOV{R6{(R9){{SET FORWARD POINTER
16243: *
16244: * NOW SEE IF THIS BLOCK HAS BEEN PROCESSED BEFORE
16245: *
16246: {{BHI{R6{#P$YYY{GPF02{JUMP IF ALREADY PROCESSED
16247: {{BHI{R6{#B$AAA{GPF03{JUMP IF NOT ALREADY PROCESSED
16248: *
16249: * HERE TO MOVE TO NEXT FIELD
16250: *
16251: {GPF02{MOV{R8{R9{{RESTORE FIELD POINTER
16252: {{ICA{R9{{{BUMP TO NEXT FIELD
16253: {{BNE{R9{(SP){GPF01{LOOP BACK IF MORE TO GO
16254: {{EJC{{{{
16255: *
16256: * GBCPF (CONTINUED)
16257: *
16258: * HERE WE POP UP A LEVEL AFTER FINISHING A BLOCK
16259: *
16260: {{MOV{(SP)+{R10{{RESTORE POINTER PAST END
16261: {{MOV{(SP)+{R8{{RESTORE BLOCK POINTER
16262: {{BNZ{R8{GPF02{{CONTINUE LOOP UNLESS OUTER LEVL
16263: {{EXI{{{{RETURN TO CALLER IF OUTER LEVEL
16264: *
16265: * HERE TO PROCESS AN ACTIVE BLOCK WHICH HAS NOT BEEN DONE
16266: *
16267: {GPF03{MOV{R10{R9{{COPY BLOCK POINTER
16268: {{MOV{R6{R10{{COPY FIRST WORD OF BLOCK
16269: {{LEI{R10{{{LOAD ENTRY POINT ID (BL$XX)
16270: *
16271: * BLOCK TYPE SWITCH. NOTE THAT BLOCKS WITH NO RELOCATABLE
16272: * FIELDS JUST RETURN TO GPF02 HERE TO CONTINE TO NEXT FLD.
16273: *
16274: {{BSW{R10{BL$$${{SWITCH ON BLOCK TYPE
16275: {{IFF{BL$AR{GPF06{{ARBLK
16276: {{IFF{BL$BC{GPF18{{BCBLK
16277: {{IFF{BL$CD{GPF08{{CDBLK
16278: {{IFF{BL$EX{GPF17{{EXBLK
16279: {{IFF{BL$IC{GPF02{{ICBLK
16280: {{IFF{BL$NM{GPF10{{NMBLK
16281: {{IFF{BL$P0{GPF10{{P0BLK
16282: {{IFF{BL$P1{GPF12{{P1BLK
16283: {{IFF{BL$P2{GPF12{{P2BLK
16284: {{IFF{BL$RC{GPF02{{RCBLK
16285: {{IFF{BL$SC{GPF02{{SCBLK
16286: {{IFF{BL$SE{GPF02{{SEBLK
16287: {{IFF{BL$TB{GPF08{{TBBLK
16288: {{IFF{BL$VC{GPF08{{VCBLK
16289: {{IFF{BL$XN{GPF02{{XNBLK
16290: {{IFF{BL$XR{GPF09{{XRBLK
16291: {{IFF{BL$PD{GPF13{{PDBLK
16292: {{IFF{BL$TR{GPF16{{TRBLK
16293: {{IFF{BL$BF{GPF02{{BFBLK
16294: {{IFF{BL$CC{GPF07{{CCBLK
16295: {{IFF{BL$CM{GPF04{{CMBLK
16296: {{IFF{BL$CT{GPF02{{CTBLK
16297: {{IFF{BL$DF{GPF02{{DFBLK
16298: {{IFF{BL$EF{GPF02{{EFBLK
16299: {{IFF{BL$EV{GPF10{{EVBLK
16300: {{IFF{BL$FF{GPF11{{FFBLK
16301: {{IFF{BL$KV{GPF02{{KVBLK
16302: {{IFF{BL$PF{GPF14{{PFBLK
16303: {{IFF{BL$TE{GPF15{{TEBLK
16304: {{ESW{{{{END OF JUMP TABLE
16305: {{EJC{{{{
16306: *
16307: * GBCPF (CONTINUED)
16308: *
16309: * CMBLK
16310: *
16311: {GPF04{MOV{4*CMLEN(R9){R6{{LOAD LENGTH
16312: {{MOV{#4*CMTYP{R7{{SET OFFSET
16313: *
16314: * HERE TO PUSH DOWN TO NEW LEVEL
16315: *
16316: * (WC) FIELD PTR AT PREVIOUS LEVEL
16317: * (XR) PTR TO NEW BLOCK
16318: * (WA) LENGTH (RELOC FLDS + FLDS AT START)
16319: * (WB) OFFSET TO FIRST RELOC FIELD
16320: *
16321: {GPF05{ADD{R9{R6{{POINT PAST LAST RELOC FIELD
16322: {{ADD{R7{R9{{POINT TO FIRST RELOC FIELD
16323: {{MOV{R8{-(SP){{STACK OLD FIELD POINTER
16324: {{MOV{R6{-(SP){{STACK NEW LIMIT POINTER
16325: {{CHK{{{{CHECK FOR STACK OVERFLOW
16326: {{BRN{GPF01{{{IF OK, BACK TO PROCESS
16327: *
16328: * ARBLK
16329: *
16330: {GPF06{MOV{4*ARLEN(R9){R6{{LOAD LENGTH
16331: {{MOV{4*AROFS(R9){R7{{SET OFFSET TO 1ST RELOC FLD (ARPRO)
16332: {{BRN{GPF05{{{ALL SET
16333: *
16334: * CCBLK
16335: *
16336: {GPF07{MOV{4*CCUSE(R9){R6{{SET LENGTH IN USE
16337: {{MOV{#4*CCUSE{R7{{1ST WORD (MAKE SURE AT LEAST ONE)
16338: {{BRN{GPF05{{{ALL SET
16339: {{EJC{{{{
16340: *
16341: * GBCPF (CONTINUED)
16342: *
16343: * CDBLK, TBBLK, VCBLK
16344: *
16345: {GPF08{MOV{4*OFFS2(R9){R6{{LOAD LENGTH
16346: {{MOV{#4*OFFS3{R7{{SET OFFSET
16347: {{BRN{GPF05{{{JUMP BACK
16348: *
16349: * XRBLK
16350: *
16351: {GPF09{MOV{4*XRLEN(R9){R6{{LOAD LENGTH
16352: {{MOV{#4*XRPTR{R7{{SET OFFSET
16353: {{BRN{GPF05{{{JUMP BACK
16354: *
16355: * EVBLK, NMBLK, P0BLK
16356: *
16357: {GPF10{MOV{#4*OFFS2{R6{{POINT PAST SECOND FIELD
16358: {{MOV{#4*OFFS1{R7{{OFFSET IS ONE (ONLY RELOC FLD IS 2)
16359: {{BRN{GPF05{{{ALL SET
16360: *
16361: * FFBLK
16362: *
16363: {GPF11{MOV{#4*FFOFS{R6{{SET LENGTH
16364: {{MOV{#4*FFNXT{R7{{SET OFFSET
16365: {{BRN{GPF05{{{ALL SET
16366: *
16367: * P1BLK, P2BLK
16368: *
16369: {GPF12{MOV{#4*PARM2{R6{{LENGTH (PARM2 IS NON-RELOCATABLE)
16370: {{MOV{#4*PTHEN{R7{{SET OFFSET
16371: {{BRN{GPF05{{{ALL SET
16372: {{EJC{{{{
16373: *
16374: * GBCPF (CONTINUED)
16375: *
16376: * PDBLK
16377: *
16378: {GPF13{MOV{4*PDDFP(R9){R10{{LOAD PTR TO DFBLK
16379: {{MOV{4*DFPDL(R10){R6{{GET PDBLK LENGTH
16380: {{MOV{#4*PDFLD{R7{{SET OFFSET
16381: {{BRN{GPF05{{{ALL SET
16382: *
16383: * PFBLK
16384: *
16385: {GPF14{MOV{#4*PFARG{R6{{LENGTH PAST LAST RELOC
16386: {{MOV{#4*PFCOD{R7{{OFFSET TO FIRST RELOC
16387: {{BRN{GPF05{{{ALL SET
16388: *
16389: * TEBLK
16390: *
16391: {GPF15{MOV{#4*TESI${R6{{SET LENGTH
16392: {{MOV{#4*TESUB{R7{{AND OFFSET
16393: {{BRN{GPF05{{{ALL SET
16394: *
16395: * TRBLK
16396: *
16397: {GPF16{MOV{#4*TRSI${R6{{SET LENGTH
16398: {{MOV{#4*TRVAL{R7{{AND OFFSET
16399: {{BRN{GPF05{{{ALL SET
16400: *
16401: * EXBLK
16402: *
16403: {GPF17{MOV{4*EXLEN(R9){R6{{LOAD LENGTH
16404: {{MOV{#4*EXFLC{R7{{SET OFFSET
16405: {{BRN{GPF05{{{JUMP BACK
16406: *
16407: * BCBLK
16408: *
16409: {GPF18{MOV{#4*BCSI${R6{{SET LENGTH
16410: {{MOV{#4*BCBUF{R7{{AND OFFSET
16411: {{BRN{GPF05{{{ALL SET
16412: {{ENP{{{{END PROCEDURE GBCPF
16413: {{EJC{{{{
16414: *
16415: * GTARR -- GET ARRAY
16416: *
16417: * GTARR IS PASSED AN OBJECT AND RETURNS AN ARRAY IF POSSIBL
16418: *
16419: * (XR) VALUE TO BE CONVERTED
16420: * JSR GTARR CALL TO GET ARRAY
16421: * PPM LOC TRANSFER LOC FOR CONVERT IMPOSSIBLE
16422: * (XR) RESULTING ARRAY
16423: * (XL,WA,WB,WC) DESTROYED
16424: *
16425: {GTARR{PRC{E{1{{ENTRY POINT
16426: {{MOV{(R9){R6{{LOAD TYPE WORD
16427: {{BEQ{R6{#B$ART{GTAR8{EXIT IF ALREADY AN ARRAY
16428: {{BEQ{R6{#B$VCT{GTAR8{EXIT IF ALREADY AN ARRAY
16429: {{BNE{R6{#B$TBT{GTA9A{ELSE FAIL IF NOT A TABLE (SGD02)
16430: *
16431: * HERE WE CONVERT A TABLE TO AN ARRAY
16432: *
16433: {{MOV{R9{-(SP){{REPLACE TBBLK POINTER ON STACK
16434: {{ZER{R9{{{SIGNAL FIRST PASS
16435: {{ZER{R7{{{ZERO NON-NULL ELEMENT COUNT
16436: *
16437: * THE FOLLOWING CODE IS EXECUTED TWICE. ON THE FIRST PASS,
16438: * SIGNALLED BY XR=0, THE NUMBER OF NON-NULL ELEMENTS IN
16439: * THE TABLE IS COUNTED IN WB. IN THE SECOND PASS, WHERE
16440: * XR IS A POINTER INTO THE ARBLK, THE NAME AND VALUE ARE
16441: * ENTERED INTO THE CURRENT ARBLK LOCATION.
16442: *
16443: {GTAR1{MOV{(SP){R10{{POINT TO TABLE
16444: {{ADD{4*TBLEN(R10){R10{{POINT PAST LAST BUCKET
16445: {{SUB{#4*TBBUK{R10{{SET FIRST BUCKET OFFSET
16446: {{MOV{R10{R6{{COPY ADJUSTED POINTER
16447: *
16448: * LOOP THROUGH BUCKETS IN TABLE BLOCK
16449: * NEXT THREE LINES OF CODE RELY ON TENXT HAVING A VALUE
16450: * 1 LESS THAN TBBUK.
16451: *
16452: {GTAR2{MOV{R6{R10{{COPY BUCKET POINTER
16453: {{DCA{R6{{{DECREMENT BUCKET POINTER
16454: *
16455: * LOOP THROUGH TEBLKS ON ONE BUCKET CHAIN
16456: *
16457: {GTAR3{MOV{4*TENXT(R10){R10{{POINT TO NEXT TEBLK
16458: {{BEQ{R10{(SP){GTAR6{JUMP IF CHAIN END (TBBLK PTR)
16459: {{MOV{R10{CNVTP{{ELSE SAVE TEBLK POINTER
16460: *
16461: * LOOP TO FIND VALUE DOWN TRBLK CHAIN
16462: *
16463: {GTAR4{MOV{4*TEVAL(R10){R10{{LOAD VALUE
16464: {{BEQ{(R10){#B$TRT{GTAR4{LOOP TILL VALUE FOUND
16465: {{MOV{R10{R8{{COPY VALUE
16466: {{MOV{CNVTP{R10{{RESTORE TEBLK POINTER
16467: {{EJC{{{{
16468: *
16469: * GTARR (CONTINUED)
16470: *
16471: * NOW CHECK FOR NULL AND TEST CASES
16472: *
16473: {{BEQ{R8{#NULLS{GTAR3{LOOP BACK TO IGNORE NULL VALUE
16474: {{BNZ{R9{GTAR5{{JUMP IF SECOND PASS
16475: {{ICV{R7{{{FOR THE FIRST PASS, BUMP COUNT
16476: {{BRN{GTAR3{{{AND LOOP BACK FOR NEXT TEBLK
16477: *
16478: * HERE IN SECOND PASS
16479: *
16480: {GTAR5{MOV{4*TESUB(R10){(R9)+{{STORE SUBSCRIPT NAME
16481: {{MOV{R8{(R9)+{{STORE VALUE IN ARBLK
16482: {{BRN{GTAR3{{{LOOP BACK FOR NEXT TEBLK
16483: *
16484: * HERE AFTER SCANNING TEBLKS ON ONE CHAIN
16485: *
16486: {GTAR6{BNE{R6{(SP){GTAR2{LOOP BACK IF MORE BUCKETS TO GO
16487: {{BNZ{R9{GTAR7{{ELSE JUMP IF SECOND PASS
16488: *
16489: * HERE AFTER COUNTING NON-NULL ELEMENTS
16490: *
16491: {{BZE{R7{GTAR9{{FAIL IF NO NON-NULL ELEMENTS
16492: {{MOV{R7{R6{{ELSE COPY COUNT
16493: {{ADD{R7{R6{{DOUBLE (TWO WORDS/ELEMENT)
16494: {{ADD{#ARVL2{R6{{ADD SPACE FOR STANDARD FIELDS
16495: {{WTB{R6{{{CONVERT LENGTH TO BYTES
16496: {{BGE{R6{MXLEN{GTAR9{FAIL IF TOO LONG FOR ARRAY
16497: {{JSR{ALLOC{{{ELSE ALLOCATE SPACE FOR ARBLK
16498: {{MOV{#B$ART{(R9){{STORE TYPE WORD
16499: {{ZER{4*IDVAL(R9){{{ZERO ID FOR THE MOMENT
16500: {{MOV{R6{4*ARLEN(R9){{STORE LENGTH
16501: {{MOV{#NUM02{4*ARNDM(R9){{SET DIMENSIONS = 2
16502: {{LDI{INTV1{{{GET INTEGER ONE
16503: {{STI{4*ARLBD(R9){{{STORE AS LBD 1
16504: {{STI{4*ARLB2(R9){{{STORE AS LBD 2
16505: {{LDI{INTV2{{{LOAD INTEGER TWO
16506: {{STI{4*ARDM2(R9){{{STORE AS DIM 2
16507: {{MTI{R7{{{GET ELEMENT COUNT AS INTEGER
16508: {{STI{4*ARDIM(R9){{{STORE AS DIM 1
16509: {{ZER{4*ARPR2(R9){{{ZERO PROTOTYPE FIELD FOR NOW
16510: {{MOV{#4*ARPR2{4*AROFS(R9){{SET OFFSET FIELD (SIGNAL PASS 2)
16511: {{MOV{R9{R7{{SAVE ARBLK POINTER
16512: {{ADD{#4*ARVL2{R9{{POINT TO FIRST ELEMENT LOCATION
16513: {{BRN{GTAR1{{{JUMP BACK TO FILL IN ELEMENTS
16514: {{EJC{{{{
16515: *
16516: * GTARR (CONTINUED)
16517: *
16518: * HERE AFTER FILLING IN ELEMENT VALUES
16519: *
16520: {GTAR7{MOV{R7{R9{{RESTORE ARBLK POINTER
16521: {{MOV{R7{(SP){{STORE AS RESULT
16522: *
16523: * NOW WE NEED THE ARRAY PROTOTYPE WHICH IS OF THE FORM NN,2
16524: * THIS IS OBTAINED BY BUILDING THE STRING FOR NN02 AND
16525: * CHANGING THE ZERO TO A COMMA BEFORE STORING IT.
16526: *
16527: {{LDI{4*ARDIM(R9){{{GET NUMBER OF ELEMENTS (NN)
16528: {{MLI{INTVH{{{MULTIPLY BY 100
16529: {{ADI{INTV2{{{ADD 2 (NN02)
16530: {{JSR{ICBLD{{{BUILD INTEGER
16531: {{MOV{R9{-(SP){{STORE PTR FOR GTSTG
16532: {{JSR{GTSTG{{{CONVERT TO STRING
16533: {{PPM{{{{CONVERT FAIL IS IMPOSSIBLE
16534: {{MOV{R9{R10{{COPY STRING POINTER
16535: {{MOV{(SP)+{R9{{RELOAD ARBLK POINTER
16536: {{MOV{R10{4*ARPR2(R9){{STORE PROTOTYPE PTR (NN02)
16537: {{SUB{#NUM02{R6{{ADJUST LENGTH TO POINT TO ZERO
16538: {{PSC{R10{R6{{POINT TO ZERO
16539: {{MOV{#CH$CM{R7{{LOAD A COMMA
16540: {{SCH{R7{(R10){{STORE A COMMA OVER THE ZERO
16541: {{CSC{R10{{{COMPLETE STORE CHARACTERS
16542: *
16543: * NORMAL RETURN
16544: *
16545: {GTAR8{EXI{{{{RETURN TO CALLER
16546: *
16547: * NON-CONVERSION RETURN
16548: *
16549: {GTAR9{MOV{(SP)+{R9{{RESTORE STACK FOR CONV ERR (SGD02)
16550: *
16551: * MERGE TO TAKE CONVERT ERROR WHEN STACK ADJUSTED OK
16552: *
16553: {GTA9A{EXI{1{{{RETURN
16554: {{ENP{{{{PROCEDURE GTARR
16555: {{EJC{{{{
16556: *
16557: * GTCOD -- CONVERT TO CODE
16558: *
16559: * (XR) OBJECT TO BE CONVERTED
16560: * JSR GTCOD CALL TO CONVERT TO CODE
16561: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
16562: * (XR) POINTER TO RESULTING CDBLK
16563: * (XL,WA,WB,WC,RA) DESTROYED
16564: *
16565: * IF A SPITBOL ERROR OCCURS DURING COMPILATION OR PRE-
16566: * EVALUATION, CONTROL IS PASSED VIA ERROR SECTION TO EXFAL
16567: * WITHOUT RETURNING TO THIS ROUTINE.
16568: *
16569: {GTCOD{PRC{E{1{{ENTRY POINT
16570: {{BEQ{(R9){#B$CDS{GTCD1{JUMP IF ALREADY CODE
16571: {{BEQ{(R9){#B$CDC{GTCD1{JUMP IF ALREADY CODE
16572: *
16573: * HERE WE MUST GENERATE A CDBLK BY COMPILATION
16574: *
16575: {{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG
16576: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
16577: {{PPM{GTCD2{{{JUMP IF NON-CONVERTIBLE
16578: {{MOV{FLPTR{GTCEF{{SAVE FAIL PTR IN CASE OF ERROR
16579: {{MOV{R$COD{R$GTC{{ALSO SAVE CODE PTR
16580: {{MOV{R9{R$CIM{{ELSE SET IMAGE POINTER
16581: {{MOV{R6{SCNIL{{SET IMAGE LENGTH
16582: {{ZER{SCNPT{{{SET SCAN POINTER
16583: {{MOV{#STGXC{STAGE{{SET STAGE FOR EXECUTE COMPILE
16584: {{MOV{CMPSN{LSTSN{{IN CASE LISTR CALLED
16585: {{JSR{CMPIL{{{COMPILE STRING
16586: {{MOV{#STGXT{STAGE{{RESET STAGE FOR EXECUTE TIME
16587: {{ZER{R$CIM{{{CLEAR IMAGE
16588: *
16589: * MERGE HERE IF NO CONVERT REQUIRED
16590: *
16591: {GTCD1{EXI{{{{GIVE NORMAL GTCOD RETURN
16592: *
16593: * HERE IF UNCONVERTIBLE
16594: *
16595: {GTCD2{EXI{1{{{GIVE ERROR RETURN
16596: {{ENP{{{{END PROCEDURE GTCOD
16597: {{EJC{{{{
16598: *
16599: * GTEXP -- CONVERT TO EXPRESSION
16600: *
16601: * (XR) INPUT VALUE TO BE CONVERTED
16602: * JSR GTEXP CALL TO CONVERT TO EXPRESSION
16603: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
16604: * (XR) POINTER TO RESULT EXBLK OR SEBLK
16605: * (XL,WA,WB,WC,RA) DESTROYED
16606: *
16607: * IF A SPITBOL ERROR OCCURS DURING COMPILATION OR PRE-
16608: * EVALUATION, CONTROL IS PASSED VIA ERROR SECTION TO EXFAL
16609: * WITHOUT RETURNING TO THIS ROUTINE.
16610: *
16611: {GTEXP{PRC{E{1{{ENTRY POINT
16612: {{BLO{(R9){#B$E$${GTEX1{JUMP IF ALREADY AN EXPRESSION
16613: {{MOV{R9{-(SP){{STORE ARGUMENT FOR GTSTG
16614: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
16615: {{PPM{GTEX2{{{JUMP IF UNCONVERTIBLE
16616: *
16617: * CHECK THE LAST CHARACTER OF THE STRING FOR COLON OR
16618: * SEMICOLON. THESE CHARACTERS CAN LEGITIMATELY END AN
16619: * EXPRESSION IN OPEN CODE, SO EXPAN WILL NOT DETECT THEM
16620: * AS ERRORS, BUT THEY ARE INVALID AS TERMINATORS FOR A
16621: * STRING THAT IS BEING CONVERTED TO EXPRESSION FORM.
16622: *
16623: {{MOV{R9{R10{{COPY INPUT STRING POINTER (REG06)
16624: {{PLC{R10{R6{{POINT ONE PAST THE STRING END (REG06)
16625: {{LCH{R10{-(R10){{FETCH THE LAST CHARACTER (REG06)
16626: {{BEQ{R10{#CH$CL{GTEX2{ERROR IF IT IS A SEMICOLON (REG06)
16627: {{BEQ{R10{#CH$SM{GTEX2{OR IF IT IS A COLON (REG06)
16628: *
16629: * HERE WE CONVERT A STRING BY COMPILATION
16630: *
16631: {{MOV{R9{R$CIM{{SET INPUT IMAGE POINTER
16632: {{ZER{SCNPT{{{SET SCAN POINTER
16633: {{MOV{R6{SCNIL{{SET INPUT IMAGE LENGTH
16634: {{ZER{R7{{{SET CODE FOR NORMAL SCAN
16635: {{MOV{FLPTR{GTCEF{{SAVE FAIL PTR IN CASE OF ERROR
16636: {{MOV{R$COD{R$GTC{{ALSO SAVE CODE PTR
16637: {{MOV{#STGEV{STAGE{{ADJUST STAGE FOR COMPILE
16638: {{MOV{#T$UOK{SCNTP{{INDICATE UNARY OPERATOR ACCEPTABLE
16639: {{JSR{EXPAN{{{BUILD TREE FOR EXPRESSION
16640: {{ZER{SCNRS{{{RESET RESCAN FLAG
16641: {{BNE{SCNPT{SCNIL{GTEX2{ERROR IF NOT END OF IMAGE
16642: {{ZER{R7{{{SET OK VALUE FOR CDGEX CALL
16643: {{MOV{R9{R10{{COPY TREE POINTER
16644: {{JSR{CDGEX{{{BUILD EXPRESSION BLOCK
16645: {{ZER{R$CIM{{{CLEAR POINTER
16646: {{MOV{#STGXT{STAGE{{RESTORE STAGE FOR EXECUTE TIME
16647: *
16648: * MERGE HERE IF NO CONVERSION REQUIRED
16649: *
16650: {GTEX1{EXI{{{{RETURN TO GTEXP CALLER
16651: *
16652: * HERE IF UNCONVERTIBLE
16653: *
16654: {GTEX2{EXI{1{{{TAKE ERROR EXIT
16655: {{ENP{{{{END PROCEDURE GTEXP
16656: {{EJC{{{{
16657: *
16658: * GTINT -- GET INTEGER VALUE
16659: *
16660: * GTINT IS PASSED AN OBJECT AND RETURNS AN INTEGER AFTER
16661: * PERFORMING ANY NECESSARY CONVERSIONS.
16662: *
16663: * (XR) VALUE TO BE CONVERTED
16664: * JSR GTINT CALL TO CONVERT TO INTEGER
16665: * PPM LOC TRANSFER LOC FOR CONVERT IMPOSSIBLE
16666: * (XR) RESULTING INTEGER
16667: * (WC,RA) DESTROYED
16668: * (WA,WB) DESTROYED (ONLY ON CONVERSION ERR)
16669: * (XR) UNCHANGED (ON CONVERT ERROR)
16670: *
16671: {GTINT{PRC{E{1{{ENTRY POINT
16672: {{BEQ{(R9){#B$ICL{GTIN2{JUMP IF ALREADY AN INTEGER
16673: {{MOV{R6{GTINA{{ELSE SAVE WA
16674: {{MOV{R7{GTINB{{SAVE WB
16675: {{JSR{GTNUM{{{CONVERT TO NUMERIC
16676: {{PPM{GTIN3{{{JUMP IF UNCONVERTIBLE
16677: {{BEQ{R6{#B$ICL{GTIN1{JUMP IF INTEGER
16678: *
16679: * HERE WE CONVERT A REAL TO INTEGER
16680: *
16681: {{LDR{4*RCVAL(R9){{{LOAD REAL VALUE
16682: {{RTI{GTIN3{{{CONVERT TO INTEGER (ERR IF OVFLOW)
16683: {{JSR{ICBLD{{{IF OK BUILD ICBLK
16684: *
16685: * HERE AFTER SUCCESSFUL CONVERSION TO INTEGER
16686: *
16687: {GTIN1{MOV{GTINA{R6{{RESTORE WA
16688: {{MOV{GTINB{R7{{RESTORE WB
16689: *
16690: * COMMON EXIT POINT
16691: *
16692: {GTIN2{EXI{{{{RETURN TO GTINT CALLER
16693: *
16694: * HERE ON CONVERSION ERROR
16695: *
16696: {GTIN3{EXI{1{{{TAKE CONVERT ERROR EXIT
16697: {{ENP{{{{END PROCEDURE GTINT
16698: {{EJC{{{{
16699: *
16700: * GTNUM -- GET NUMERIC VALUE
16701: *
16702: * GTNUM IS GIVEN AN OBJECT AND RETURNS EITHER AN INTEGER
16703: * OR A REAL, PERFORMING ANY NECESSARY CONVERSIONS.
16704: *
16705: * (XR) OBJECT TO BE CONVERTED
16706: * JSR GTNUM CALL TO CONVERT TO NUMERIC
16707: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
16708: * (XR) POINTER TO RESULT (INT OR REAL)
16709: * (WA) FIRST WORD OF RESULT BLOCK
16710: * (WB,WC,RA) DESTROYED
16711: * (XR) UNCHANGED (ON CONVERT ERROR)
16712: *
16713: {GTNUM{PRC{E{1{{ENTRY POINT
16714: {{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK
16715: {{BEQ{R6{#B$ICL{GTN34{JUMP IF INTEGER (NO CONVERSION)
16716: {{BEQ{R6{#B$RCL{GTN34{JUMP IF REAL (NO CONVERSION)
16717: *
16718: * AT THIS POINT THE ONLY POSSIBILITY IS TO CONVERT A STRING
16719: * TO AN INTEGER OR REAL AS APPROPRIATE.
16720: *
16721: {{MOV{R9{-(SP){{STACK ARGUMENT IN CASE CONVERT ERR
16722: {{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG
16723: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
16724: {{PPM{GTN36{{{JUMP IF UNCONVERTIBLE
16725: *
16726: * INITIALIZE NUMERIC CONVERSION
16727: *
16728: {{LDI{INTV0{{{INITIALIZE INTEGER RESULT TO ZERO
16729: {{BZE{R6{GTN32{{JUMP TO EXIT WITH ZERO IF NULL
16730: {{LCT{R6{R6{{SET BCT COUNTER FOR FOLLOWING LOOPS
16731: {{ZER{GTNNF{{{TENTATIVELY INDICATE RESULT +
16732: {{STI{GTNEX{{{INITIALISE EXPONENT TO ZERO
16733: {{ZER{GTNSC{{{ZERO SCALE IN CASE REAL
16734: {{ZER{GTNDF{{{RESET FLAG FOR DEC POINT FOUND
16735: {{ZER{GTNRD{{{RESET FLAG FOR DIGITS FOUND
16736: {{LDR{REAV0{{{ZERO REAL ACCUM IN CASE REAL
16737: {{PLC{R9{{{POINT TO ARGUMENT CHARACTERS
16738: *
16739: * MERGE BACK HERE AFTER IGNORING LEADING BLANK
16740: *
16741: {GTN01{LCH{R7{(R9)+{{LOAD FIRST CHARACTER
16742: {{BLT{R7{#CH$D0{GTN02{JUMP IF NOT DIGIT
16743: {{BLE{R7{#CH$D9{GTN06{JUMP IF FIRST CHAR IS A DIGIT
16744: {{EJC{{{{
16745: *
16746: * GTNUM (CONTINUED)
16747: *
16748: * HERE IF FIRST DIGIT IS NON-DIGIT
16749: *
16750: {GTN02{BNE{R7{#CH$BL{GTN03{JUMP IF NON-BLANK
16751: {GTNA2{BCT{R6{GTN01{{ELSE DECR COUNT AND LOOP BACK
16752: {{BRN{GTN07{{{JUMP TO RETURN ZERO IF ALL BLANKS
16753: *
16754: * HERE FOR FIRST CHARACTER NON-BLANK, NON-DIGIT
16755: *
16756: {GTN03{BEQ{R7{#CH$PL{GTN04{JUMP IF PLUS SIGN
16757: {{BEQ{R7{#CH$HT{GTNA2{HORIZONTAL TAB EQUIV TO BLANK
16758: {{BNE{R7{#CH$MN{GTN12{JUMP IF NOT MINUS (MAY BE REAL)
16759: {{MNZ{GTNNF{{{IF MINUS SIGN, SET NEGATIVE FLAG
16760: *
16761: * MERGE HERE AFTER PROCESSING SIGN
16762: *
16763: {GTN04{BCT{R6{GTN05{{JUMP IF CHARS LEFT
16764: {{BRN{GTN36{{{ELSE ERROR
16765: *
16766: * LOOP TO FETCH CHARACTERS OF AN INTEGER
16767: *
16768: {GTN05{LCH{R7{(R9)+{{LOAD NEXT CHARACTER
16769: {{BLT{R7{#CH$D0{GTN08{JUMP IF NOT A DIGIT
16770: {{BGT{R7{#CH$D9{GTN08{JUMP IF NOT A DIGIT
16771: *
16772: * MERGE HERE FOR FIRST DIGIT
16773: *
16774: {GTN06{STI{GTNSI{{{SAVE CURRENT VALUE
16775: {{CVM{GTN35{{{CURRENT*10-(NEW DIG) JUMP IF OVFLOW
16776: {{MNZ{GTNRD{{{SET DIGIT READ FLAG
16777: {{BCT{R6{GTN05{{ELSE LOOP BACK IF MORE CHARS
16778: *
16779: * HERE TO EXIT WITH CONVERTED INTEGER VALUE
16780: *
16781: {GTN07{BNZ{GTNNF{GTN32{{JUMP IF NEGATIVE (ALL SET)
16782: {{NGI{{{{ELSE NEGATE
16783: {{INO{GTN32{{{JUMP IF NO OVERFLOW
16784: {{BRN{GTN36{{{ELSE SIGNAL ERROR
16785: {{EJC{{{{
16786: *
16787: * GTNUM (CONTINUED)
16788: *
16789: * HERE FOR A NON-DIGIT CHARACTER WHILE ATTEMPTING TO
16790: * CONVERT AN INTEGER, CHECK FOR TRAILING BLANKS OR REAL.
16791: *
16792: {GTN08{BEQ{R7{#CH$BL{GTNA9{JUMP IF A BLANK
16793: {{BEQ{R7{#CH$HT{GTNA9{JUMP IF HORIZONTAL TAB
16794: {{ITR{{{{ELSE CONVERT INTEGER TO REAL
16795: {{NGR{{{{NEGATE TO GET POSITIVE VALUE
16796: {{BRN{GTN12{{{JUMP TO TRY FOR REAL
16797: *
16798: * HERE WE SCAN OUT BLANKS TO END OF STRING
16799: *
16800: {GTN09{LCH{R7{(R9)+{{GET NEXT CHAR
16801: {{BEQ{R7{#CH$HT{GTNA9{JUMP IF HORIZONTAL TAB
16802: {{BNE{R7{#CH$BL{GTN36{ERROR IF NON-BLANK
16803: {GTNA9{BCT{R6{GTN09{{LOOP BACK IF MORE CHARS TO CHECK
16804: {{BRN{GTN07{{{RETURN INTEGER IF ALL BLANKS
16805: *
16806: * LOOP TO COLLECT MANTISSA OF REAL
16807: *
16808: {GTN10{LCH{R7{(R9)+{{LOAD NEXT CHARACTER
16809: {{BLT{R7{#CH$D0{GTN12{JUMP IF NON-NUMERIC
16810: {{BGT{R7{#CH$D9{GTN12{JUMP IF NON-NUMERIC
16811: *
16812: * MERGE HERE TO COLLECT FIRST REAL DIGIT
16813: *
16814: {GTN11{SUB{#CH$D0{R7{{CONVERT DIGIT TO NUMBER
16815: {{MLR{REAVT{{{MULTIPLY REAL BY 10.0
16816: {{ROV{GTN36{{{CONVERT ERROR IF OVERFLOW
16817: {{STR{GTNSR{{{SAVE RESULT
16818: {{MTI{R7{{{GET NEW DIGIT AS INTEGER
16819: {{ITR{{{{CONVERT NEW DIGIT TO REAL
16820: {{ADR{GTNSR{{{ADD TO GET NEW TOTAL
16821: {{ADD{GTNDF{GTNSC{{INCREMENT SCALE IF AFTER DEC POINT
16822: {{MNZ{GTNRD{{{SET DIGIT FOUND FLAG
16823: {{BCT{R6{GTN10{{LOOP BACK IF MORE CHARS
16824: {{BRN{GTN22{{{ELSE JUMP TO SCALE
16825: {{EJC{{{{
16826: *
16827: * GTNUM (CONTINUED)
16828: *
16829: * HERE IF NON-DIGIT FOUND WHILE COLLECTING A REAL
16830: *
16831: {GTN12{BNE{R7{#CH$DT{GTN13{JUMP IF NOT DEC POINT
16832: {{BNZ{GTNDF{GTN36{{IF DEC POINT, ERROR IF ONE ALREADY
16833: {{MOV{#NUM01{GTNDF{{ELSE SET FLAG FOR DEC POINT
16834: {{BCT{R6{GTN10{{LOOP BACK IF MORE CHARS
16835: {{BRN{GTN22{{{ELSE JUMP TO SCALE
16836: *
16837: * HERE IF NOT DECIMAL POINT
16838: *
16839: {GTN13{BEQ{R7{#CH$LE{GTN15{JUMP IF E FOR EXPONENT
16840: {{BEQ{R7{#CH$LD{GTN15{JUMP IF D FOR EXPONENT
16841: {{BEQ{R7{#CH$$E{GTN15{JUMP IF E FOR EXPONENT
16842: {{BEQ{R7{#CH$$D{GTN15{JUMP IF D FOR EXPONENT
16843: *
16844: * HERE CHECK FOR TRAILING BLANKS
16845: *
16846: {GTN14{BEQ{R7{#CH$BL{GTNB4{JUMP IF BLANK
16847: {{BEQ{R7{#CH$HT{GTNB4{JUMP IF HORIZONTAL TAB
16848: {{BRN{GTN36{{{ERROR IF NON-BLANK
16849: *
16850: {GTNB4{LCH{R7{(R9)+{{GET NEXT CHARACTER
16851: {{BCT{R6{GTN14{{LOOP BACK TO CHECK IF MORE
16852: {{BRN{GTN22{{{ELSE JUMP TO SCALE
16853: *
16854: * HERE TO READ AND PROCESS AN EXPONENT
16855: *
16856: {GTN15{ZER{GTNES{{{SET EXPONENT SIGN POSITIVE
16857: {{LDI{INTV0{{{INITIALIZE EXPONENT TO ZERO
16858: {{MNZ{GTNDF{{{RESET NO DEC POINT INDICATION
16859: {{BCT{R6{GTN16{{JUMP SKIPPING PAST E OR D
16860: {{BRN{GTN36{{{ERROR IF NULL EXPONENT
16861: *
16862: * CHECK FOR EXPONENT SIGN
16863: *
16864: {GTN16{LCH{R7{(R9)+{{LOAD FIRST EXPONENT CHARACTER
16865: {{BEQ{R7{#CH$PL{GTN17{JUMP IF PLUS SIGN
16866: {{BNE{R7{#CH$MN{GTN19{ELSE JUMP IF NOT MINUS SIGN
16867: {{MNZ{GTNES{{{SET SIGN NEGATIVE IF MINUS SIGN
16868: *
16869: * MERGE HERE AFTER PROCESSING EXPONENT SIGN
16870: *
16871: {GTN17{BCT{R6{GTN18{{JUMP IF CHARS LEFT
16872: {{BRN{GTN36{{{ELSE ERROR
16873: *
16874: * LOOP TO CONVERT EXPONENT DIGITS
16875: *
16876: {GTN18{LCH{R7{(R9)+{{LOAD NEXT CHARACTER
16877: {{EJC{{{{
16878: *
16879: * GTNUM (CONTINUED)
16880: *
16881: * MERGE HERE FOR FIRST EXPONENT DIGIT
16882: *
16883: {GTN19{BLT{R7{#CH$D0{GTN20{JUMP IF NOT DIGIT
16884: {{BGT{R7{#CH$D9{GTN20{JUMP IF NOT DIGIT
16885: {{CVM{GTN36{{{ELSE CURRENT*10, SUBTRACT NEW DIGIT
16886: {{BCT{R6{GTN18{{LOOP BACK IF MORE CHARS
16887: {{BRN{GTN21{{{JUMP IF EXPONENT FIELD IS EXHAUSTED
16888: *
16889: * HERE TO CHECK FOR TRAILING BLANKS AFTER EXPONENT
16890: *
16891: {GTN20{BEQ{R7{#CH$BL{GTNC0{JUMP IF BLANK
16892: {{BEQ{R7{#CH$HT{GTNC0{JUMP IF HORIZONTAL TAB
16893: {{BRN{GTN36{{{ERROR IF NON-BLANK
16894: *
16895: {GTNC0{LCH{R7{(R9)+{{GET NEXT CHARACTER
16896: {{BCT{R6{GTN20{{LOOP BACK TILL ALL BLANKS SCANNED
16897: *
16898: * MERGE HERE AFTER COLLECTING EXPONENT
16899: *
16900: {GTN21{STI{GTNEX{{{SAVE COLLECTED EXPONENT
16901: {{BNZ{GTNES{GTN22{{JUMP IF IT WAS NEGATIVE
16902: {{NGI{{{{ELSE COMPLEMENT
16903: {{IOV{GTN36{{{ERROR IF OVERFLOW
16904: {{STI{GTNEX{{{AND STORE POSITIVE EXPONENT
16905: *
16906: * MERGE HERE WITH EXPONENT (0 IF NONE GIVEN)
16907: *
16908: {GTN22{BZE{GTNRD{GTN36{{ERROR IF NOT DIGITS COLLECTED
16909: {{BZE{GTNDF{GTN36{{ERROR IF NO EXPONENT OR DEC POINT
16910: {{MTI{GTNSC{{{ELSE LOAD SCALE AS INTEGER
16911: {{SBI{GTNEX{{{SUBTRACT EXPONENT
16912: {{IOV{GTN36{{{ERROR IF OVERFLOW
16913: {{ILT{GTN26{{{JUMP IF WE MUST SCALE UP
16914: *
16915: * HERE WE HAVE A NEGATIVE EXPONENT, SO SCALE DOWN
16916: *
16917: {{MFI{R6{GTN36{{LOAD SCALE FACTOR, ERR IF OVFLOW
16918: *
16919: * LOOP TO SCALE DOWN IN STEPS OF 10**10
16920: *
16921: {GTN23{BLE{R6{#NUM10{GTN24{JUMP IF 10 OR LESS TO GO
16922: {{DVR{REATT{{{ELSE DIVIDE BY 10**10
16923: {{SUB{#NUM10{R6{{DECREMENT SCALE
16924: {{BRN{GTN23{{{AND LOOP BACK
16925: {{EJC{{{{
16926: *
16927: * GTNUM (CONTINUED)
16928: *
16929: * HERE SCALE REST OF WAY FROM POWERS OF TEN TABLE
16930: *
16931: {GTN24{BZE{R6{GTN30{{JUMP IF SCALED
16932: {{LCT{R7{#CFP$R{{ELSE GET INDEXING FACTOR
16933: {{MOV{#REAV1{R9{{POINT TO POWERS OF TEN TABLE
16934: {{WTB{R6{{{CONVERT REMAINING SCALE TO BYTE OFS
16935: *
16936: * LOOP TO POINT TO POWERS OF TEN TABLE ENTRY
16937: *
16938: {GTN25{ADD{R6{R9{{BUMP POINTER
16939: {{BCT{R7{GTN25{{ONCE FOR EACH VALUE WORD
16940: {{DVR{(R9){{{SCALE DOWN AS REQUIRED
16941: {{BRN{GTN30{{{AND JUMP
16942: *
16943: * COME HERE TO SCALE RESULT UP (POSITIVE EXPONENT)
16944: *
16945: {GTN26{NGI{{{{GET ABSOLUTE VALUE OF EXPONENT
16946: {{IOV{GTN36{{{ERROR IF OVERFLOW
16947: {{MFI{R6{GTN36{{ACQUIRE SCALE, ERROR IF OVFLOW
16948: *
16949: * LOOP TO SCALE UP IN STEPS OF 10**10
16950: *
16951: {GTN27{BLE{R6{#NUM10{GTN28{JUMP IF 10 OR LESS TO GO
16952: {{MLR{REATT{{{ELSE MULTIPLY BY 10**10
16953: {{ROV{GTN36{{{ERROR IF OVERFLOW
16954: {{SUB{#NUM10{R6{{ELSE DECREMENT SCALE
16955: {{BRN{GTN27{{{AND LOOP BACK
16956: *
16957: * HERE TO SCALE UP REST OF WAY WITH TABLE
16958: *
16959: {GTN28{BZE{R6{GTN30{{JUMP IF SCALED
16960: {{LCT{R7{#CFP$R{{ELSE GET INDEXING FACTOR
16961: {{MOV{#REAV1{R9{{POINT TO POWERS OF TEN TABLE
16962: {{WTB{R6{{{CONVERT REMAINING SCALE TO BYTE OFS
16963: *
16964: * LOOP TO POINT TO PROPER ENTRY IN POWERS OF TEN TABLE
16965: *
16966: {GTN29{ADD{R6{R9{{BUMP POINTER
16967: {{BCT{R7{GTN29{{ONCE FOR EACH WORD IN VALUE
16968: {{MLR{(R9){{{SCALE UP
16969: {{ROV{GTN36{{{ERROR IF OVERFLOW
16970: {{EJC{{{{
16971: *
16972: * GTNUM (CONTINUED)
16973: *
16974: * HERE WITH REAL VALUE SCALED AND READY EXCEPT FOR SIGN
16975: *
16976: {GTN30{BZE{GTNNF{GTN31{{JUMP IF POSITIVE
16977: {{NGR{{{{ELSE NEGATE
16978: *
16979: * HERE WITH PROPERLY SIGNED REAL VALUE IN (RA)
16980: *
16981: {GTN31{JSR{RCBLD{{{BUILD REAL BLOCK
16982: {{BRN{GTN33{{{MERGE TO EXIT
16983: *
16984: * HERE WITH PROPERLY SIGNED INTEGER VALUE IN (IA)
16985: *
16986: {GTN32{JSR{ICBLD{{{BUILD ICBLK
16987: *
16988: * REAL MERGES HERE
16989: *
16990: {GTN33{MOV{(R9){R6{{LOAD FIRST WORD OF RESULT BLOCK
16991: {{ICA{SP{{{POP ARGUMENT OFF STACK
16992: *
16993: * COMMON EXIT POINT
16994: *
16995: {GTN34{EXI{{{{RETURN TO GTNUM CALLER
16996: *
16997: * COME HERE IF OVERFLOW OCCURS DURING COLLECTION OF INTEGER
16998: *
16999: {GTN35{LDI{GTNSI{{{RELOAD INTEGER SO FAR
17000: {{ITR{{{{CONVERT TO REAL
17001: {{NGR{{{{MAKE VALUE POSITIVE
17002: {{BRN{GTN11{{{MERGE WITH REAL CIRCUIT
17003: *
17004: * HERE FOR UNCONVERTIBLE TO STRING OR CONVERSION ERROR
17005: *
17006: {GTN36{MOV{(SP)+{R9{{RELOAD ORIGINAL ARGUMENT
17007: {{EXI{1{{{TAKE CONVERT-ERROR EXIT
17008: {{ENP{{{{END PROCEDURE GTNUM
17009: {{EJC{{{{
17010: *
17011: * GTNVR -- CONVERT TO NATURAL VARIABLE
17012: *
17013: * GTNVR LOCATES A VARIABLE BLOCK (VRBLK) GIVEN EITHER AN
17014: * APPROPRIATE NAME (NMBLK) OR A NON-NULL STRING (SCBLK).
17015: *
17016: * (XR) ARGUMENT
17017: * JSR GTNVR CALL TO CONVERT TO NATURAL VARIABLE
17018: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
17019: * (XR) POINTER TO VRBLK
17020: * (WA,WB) DESTROYED (CONVERSION ERROR ONLY)
17021: * (WC) DESTROYED
17022: *
17023: {GTNVR{PRC{E{1{{ENTRY POINT
17024: {{BNE{(R9){#B$NML{GNV02{JUMP IF NOT NAME
17025: {{MOV{4*NMBAS(R9){R9{{ELSE LOAD NAME BASE IF NAME
17026: {{BLO{R9{STATE{GNV07{SKIP IF VRBLK (IN STATIC REGION)
17027: *
17028: * COMMON ERROR EXIT
17029: *
17030: {GNV01{EXI{1{{{TAKE CONVERT-ERROR EXIT
17031: *
17032: * HERE IF NOT NAME
17033: *
17034: {GNV02{MOV{R6{GNVSA{{SAVE WA
17035: {{MOV{R7{GNVSB{{SAVE WB
17036: {{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG
17037: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
17038: {{PPM{GNV01{{{JUMP IF CONVERSION ERROR
17039: {{BZE{R6{GNV01{{NULL STRING IS AN ERROR
17040: {{JSR{FLSTG{{{FOLD LOWER CASE TO UPPER CASE
17041: {{MOV{R10{-(SP){{SAVE XL
17042: {{MOV{R9{-(SP){{STACK STRING PTR FOR LATER
17043: {{MOV{R9{R7{{COPY STRING POINTER
17044: {{ADD{#4*SCHAR{R7{{POINT TO CHARACTERS OF STRING
17045: {{MOV{R7{GNVST{{SAVE POINTER TO CHARACTERS
17046: {{MOV{R6{R7{{COPY LENGTH
17047: {{CTW{R7{0{{GET NUMBER OF WORDS IN NAME
17048: {{MOV{R7{GNVNW{{SAVE FOR LATER
17049: {{JSR{HASHS{{{COMPUTE HASH INDEX FOR STRING
17050: {{RMI{HSHNB{{{COMPUTE HASH OFFSET BY TAKING MOD
17051: {{MFI{R8{{{GET AS OFFSET
17052: {{WTB{R8{{{CONVERT OFFSET TO BYTES
17053: {{ADD{HSHTB{R8{{POINT TO PROPER HASH CHAIN
17054: {{SUB{#4*VRNXT{R8{{SUBTRACT OFFSET TO MERGE INTO LOOP
17055: {{EJC{{{{
17056: *
17057: * GTNVR (CONTINUED)
17058: *
17059: * LOOP TO SEARCH HASH CHAIN
17060: *
17061: {GNV03{MOV{R8{R10{{COPY HASH CHAIN POINTER
17062: {{MOV{4*VRNXT(R10){R10{{POINT TO NEXT VRBLK ON CHAIN
17063: {{BZE{R10{GNV08{{JUMP IF END OF CHAIN
17064: {{MOV{R10{R8{{SAVE POINTER TO THIS VRBLK
17065: {{BNZ{4*VRLEN(R10){GNV04{{JUMP IF NOT SYSTEM VARIABLE
17066: {{MOV{4*VRSVP(R10){R10{{ELSE POINT TO SVBLK
17067: {{SUB{#4*VRSOF{R10{{ADJUST OFFSET FOR MERGE
17068: *
17069: * MERGE HERE WITH STRING PTR (LIKE VRBLK) IN XL
17070: *
17071: {GNV04{BNE{R6{4*VRLEN(R10){GNV03{BACK FOR NEXT VRBLK IF LENGTHS NE
17072: {{ADD{#4*VRCHS{R10{{ELSE POINT TO CHARS OF CHAIN ENTRY
17073: {{LCT{R7{GNVNW{{GET WORD COUNTER TO CONTROL LOOP
17074: {{MOV{GNVST{R9{{POINT TO CHARS OF NEW NAME
17075: *
17076: * LOOP TO COMPARE CHARACTERS OF THE TWO NAMES
17077: *
17078: {GNV05{CNE{(R9){(R10){GNV03{JUMP IF NO MATCH FOR NEXT VRBLK
17079: {{ICA{R9{{{BUMP NEW NAME POINTER
17080: {{ICA{R10{{{BUMP VRBLK IN CHAIN NAME POINTER
17081: {{BCT{R7{GNV05{{ELSE LOOP TILL ALL COMPARED
17082: {{MOV{R8{R9{{WE HAVE FOUND A MATCH, GET VRBLK
17083: *
17084: * EXIT POINT AFTER FINDING VRBLK OR BUILDING NEW ONE
17085: *
17086: {GNV06{MOV{GNVSA{R6{{RESTORE WA
17087: {{MOV{GNVSB{R7{{RESTORE WB
17088: {{ICA{SP{{{POP STRING POINTER
17089: {{MOV{(SP)+{R10{{RESTORE XL
17090: *
17091: * COMMON EXIT POINT
17092: *
17093: {GNV07{EXI{{{{RETURN TO GTNVR CALLER
17094: *
17095: * NOT FOUND, PREPARE TO SEARCH SYSTEM VARIABLE TABLE
17096: *
17097: {GNV08{ZER{R9{{{CLEAR GARBAGE XR POINTER
17098: {{MOV{R8{GNVHE{{SAVE PTR TO END OF HASH CHAIN
17099: {{BGT{R6{#NUM09{GNV14{CANNOT BE SYSTEM VAR IF LENGTH GT 9
17100: {{MOV{R6{R10{{ELSE COPY LENGTH
17101: {{WTB{R10{{{CONVERT TO BYTE OFFSET
17102: {{MOV{L^VSRCH(R10){R10{{POINT TO FIRST SVBLK OF THIS LENGTH
17103: {{EJC{{{{
17104: *
17105: * GTNVR (CONTINUED)
17106: *
17107: * LOOP TO SEARCH ENTRIES IN STANDARD VARIABLE TABLE
17108: *
17109: {GNV09{MOV{R10{GNVSP{{SAVE TABLE POINTER
17110: {{MOV{(R10)+{R8{{LOAD SVBIT BIT STRING
17111: {{MOV{(R10)+{R7{{LOAD LENGTH FROM TABLE ENTRY
17112: {{BNE{R6{R7{GNV14{JUMP IF END OF RIGHT LENGTH ENTIRES
17113: {{LCT{R7{GNVNW{{GET WORD COUNTER TO CONTROL LOOP
17114: {{MOV{GNVST{R9{{POINT TO CHARS OF NEW NAME
17115: *
17116: * LOOP TO CHECK FOR MATCHING NAMES
17117: *
17118: {GNV10{CNE{(R9){(R10){GNV11{JUMP IF NAME MISMATCH
17119: {{ICA{R9{{{ELSE BUMP NEW NAME POINTER
17120: {{ICA{R10{{{BUMP SVBLK POINTER
17121: {{BCT{R7{GNV10{{ELSE LOOP UNTIL ALL CHECKED
17122: *
17123: * HERE WE HAVE A MATCH IN THE STANDARD VARIABLE TABLE
17124: *
17125: {{ZER{R8{{{SET VRLEN VALUE ZERO
17126: {{MOV{#4*VRSI${R6{{SET STANDARD SIZE
17127: {{BRN{GNV15{{{JUMP TO BUILD VRBLK
17128: *
17129: * HERE IF NO MATCH WITH TABLE ENTRY IN SVBLKS TABLE
17130: *
17131: {GNV11{ICA{R10{{{BUMP PAST WORD OF CHARS
17132: {{BCT{R7{GNV11{{LOOP BACK IF MORE TO GO
17133: {{RSH{R8{SVNBT{{REMOVE UNINTERESTING BITS
17134: *
17135: * LOOP TO BUMP TABLE PTR FOR EACH FLAGGED WORD
17136: *
17137: {GNV12{MOV{BITS1{R7{{LOAD BIT TO TEST
17138: {{ANB{R8{R7{{TEST FOR WORD PRESENT
17139: {{ZRB{R7{GNV13{{JUMP IF NOT PRESENT
17140: {{ICA{R10{{{ELSE BUMP TABLE POINTER
17141: *
17142: * HERE AFTER DEALING WITH ONE WORD (ONE BIT)
17143: *
17144: {GNV13{RSH{R8{1{{REMOVE BIT ALREADY PROCESSED
17145: {{NZB{R8{GNV12{{LOOP BACK IF MORE BITS TO TEST
17146: {{BRN{GNV09{{{ELSE LOOP BACK FOR NEXT SVBLK
17147: *
17148: * HERE IF NOT SYSTEM VARIABLE
17149: *
17150: {GNV14{MOV{R6{R8{{COPY VRLEN VALUE
17151: {{MOV{#VRCHS{R6{{LOAD STANDARD SIZE -CHARS
17152: {{ADD{GNVNW{R6{{ADJUST FOR CHARS OF NAME
17153: {{WTB{R6{{{CONVERT LENGTH TO BYTES
17154: {{EJC{{{{
17155: *
17156: * GTNVR (CONTINUED)
17157: *
17158: * MERGE HERE TO BUILD VRBLK
17159: *
17160: {GNV15{JSR{ALOST{{{ALLOCATE SPACE FOR VRBLK (STATIC)
17161: {{MOV{R9{R7{{SAVE VRBLK POINTER
17162: {{MOV{#STNVR{R10{{POINT TO MODEL VARIABLE BLOCK
17163: {{MOV{#4*VRLEN{R6{{SET LENGTH OF STANDARD FIELDS
17164: {{MVW{{{{SET INITIAL FIELDS OF NEW BLOCK
17165: {{MOV{GNVHE{R10{{LOAD POINTER TO END OF HASH CHAIN
17166: {{MOV{R7{4*VRNXT(R10){{ADD NEW BLOCK TO END OF CHAIN
17167: {{MOV{R8{(R9)+{{SET VRLEN FIELD, BUMP PTR
17168: {{MOV{GNVNW{R6{{GET LENGTH IN WORDS
17169: {{WTB{R6{{{CONVERT TO LENGTH IN BYTES
17170: {{BZE{R8{GNV16{{JUMP IF SYSTEM VARIABLE
17171: *
17172: * HERE FOR NON-SYSTEM VARIABLE -- SET CHARS OF NAME
17173: *
17174: {{MOV{(SP){R10{{POINT BACK TO STRING NAME
17175: {{ADD{#4*SCHAR{R10{{POINT TO CHARS OF NAME
17176: {{MVW{{{{MOVE CHARACTERS INTO PLACE
17177: {{MOV{R7{R9{{RESTORE VRBLK POINTER
17178: {{BRN{GNV06{{{JUMP BACK TO EXIT
17179: *
17180: * HERE FOR SYSTEM VARIABLE CASE TO FILL IN FIELDS WHERE
17181: * NECESSARY FROM THE FIELDS PRESENT IN THE SVBLK.
17182: *
17183: {GNV16{MOV{GNVSP{R10{{LOAD POINTER TO SVBLK
17184: {{MOV{R10{(R9){{SET SVBLK PTR IN VRBLK
17185: {{MOV{R7{R9{{RESTORE VRBLK POINTER
17186: {{MOV{4*SVBIT(R10){R7{{LOAD BIT INDICATORS
17187: {{ADD{#4*SVCHS{R10{{POINT TO CHARACTERS OF NAME
17188: {{ADD{R6{R10{{POINT PAST CHARACTERS
17189: *
17190: * SKIP PAST KEYWORD NUMBER (SVKNM) IF PRESENT
17191: *
17192: {{MOV{BTKNM{R8{{LOAD TEST BIT
17193: {{ANB{R7{R8{{AND TO TEST
17194: {{ZRB{R8{GNV17{{JUMP IF NO KEYWORD NUMBER
17195: {{ICA{R10{{{ELSE BUMP POINTER
17196: {{EJC{{{{
17197: *
17198: * GTNVR (CONTINUED)
17199: *
17200: * HERE TEST FOR FUNCTION (SVFNC AND SVNAR)
17201: *
17202: {GNV17{MOV{BTFNC{R8{{GET TEST BIT
17203: {{ANB{R7{R8{{AND TO TEST
17204: {{ZRB{R8{GNV18{{SKIP IF NO SYSTEM FUNCTION
17205: {{MOV{R10{4*VRFNC(R9){{ELSE POINT VRFNC TO SVFNC FIELD
17206: {{ADD{#4*NUM02{R10{{AND BUMP PAST SVFNC, SVNAR FIELDS
17207: *
17208: * NOW TEST FOR LABEL (SVLBL)
17209: *
17210: {GNV18{MOV{BTLBL{R8{{GET TEST BIT
17211: {{ANB{R7{R8{{AND TO TEST
17212: {{ZRB{R8{GNV19{{JUMP IF BIT IS OFF (NO SYSTEM LABL)
17213: {{MOV{R10{4*VRLBL(R9){{ELSE POINT VRLBL TO SVLBL FIELD
17214: {{ICA{R10{{{BUMP PAST SVLBL FIELD
17215: *
17216: * NOW TEST FOR VALUE (SVVAL)
17217: *
17218: {GNV19{MOV{BTVAL{R8{{LOAD TEST BIT
17219: {{ANB{R7{R8{{AND TO TEST
17220: {{ZRB{R8{GNV06{{ALL DONE IF NO VALUE
17221: {{MOV{(R10){4*VRVAL(R9){{ELSE SET INITIAL VALUE
17222: {{MOV{#B$VRE{4*VRSTO(R9){{SET ERROR STORE ACCESS
17223: {{BRN{GNV06{{{MERGE BACK TO EXIT TO CALLER
17224: {{ENP{{{{END PROCEDURE GTNVR
17225: {{EJC{{{{
17226: *
17227: * GTPAT -- GET PATTERN
17228: *
17229: * GTPAT IS PASSED AN OBJECT IN (XR) AND RETURNS A
17230: * PATTERN AFTER PERFORMING ANY NECESSARY CONVERSIONS
17231: *
17232: * (XR) INPUT ARGUMENT
17233: * JSR GTPAT CALL TO CONVERT TO PATTERN
17234: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
17235: * (XR) RESULTING PATTERN
17236: * (WA) DESTROYED
17237: * (WB) DESTROYED (ONLY ON CONVERT ERROR)
17238: * (XR) UNCHANGED (ONLY ON CONVERT ERROR)
17239: *
17240: {GTPAT{PRC{E{1{{ENTRY POINT
17241: {{BHI{(R9){#P$AAA{GTPT5{JUMP IF PATTERN ALREADY
17242: *
17243: * HERE IF NOT PATTERN, TRY FOR STRING
17244: *
17245: {{MOV{R7{GTPSB{{SAVE WB
17246: {{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG
17247: {{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
17248: {{PPM{GTPT2{{{JUMP IF IMPOSSIBLE
17249: *
17250: * HERE WE HAVE A STRING
17251: *
17252: {{BNZ{R6{GTPT1{{JUMP IF NON-NULL
17253: *
17254: * HERE FOR NULL STRING. GENERATE POINTER TO NULL PATTERN.
17255: *
17256: {{MOV{#NDNTH{R9{{POINT TO NOTHEN NODE
17257: {{BRN{GTPT4{{{JUMP TO EXIT
17258: {{EJC{{{{
17259: *
17260: * GTPAT (CONTINUED)
17261: *
17262: * HERE FOR NON-NULL STRING
17263: *
17264: {GTPT1{MOV{#P$STR{R7{{LOAD PCODE FOR MULTI-CHAR STRING
17265: {{BNE{R6{#NUM01{GTPT3{JUMP IF MULTI-CHAR STRING
17266: *
17267: * HERE FOR ONE CHARACTER STRING, SHARE ONE CHARACTER ANY
17268: *
17269: {{PLC{R9{{{POINT TO CHARACTER
17270: {{LCH{R6{(R9){{LOAD CHARACTER
17271: {{MOV{R6{R9{{SET AS PARM1
17272: {{MOV{#P$ANS{R7{{POINT TO PCODE FOR 1-CHAR ANY
17273: {{BRN{GTPT3{{{JUMP TO BUILD NODE
17274: *
17275: * HERE IF ARGUMENT IS NOT CONVERTIBLE TO STRING
17276: *
17277: {GTPT2{MOV{#P$EXA{R7{{SET PCODE FOR EXPRESSION IN CASE
17278: {{BLO{(R9){#B$E$${GTPT3{JUMP TO BUILD NODE IF EXPRESSION
17279: *
17280: * HERE WE HAVE AN ERROR (CONVERSION IMPOSSIBLE)
17281: *
17282: {{EXI{1{{{TAKE CONVERT ERROR EXIT
17283: *
17284: * MERGE HERE TO BUILD NODE FOR STRING OR EXPRESSION
17285: *
17286: {GTPT3{JSR{PBILD{{{CALL ROUTINE TO BUILD PATTERN NODE
17287: *
17288: * COMMON EXIT AFTER SUCCESSFUL CONVERSION
17289: *
17290: {GTPT4{MOV{GTPSB{R7{{RESTORE WB
17291: *
17292: * MERGE HERE TO EXIT OF NO CONVERSION REQUIRED
17293: *
17294: {GTPT5{EXI{{{{RETURN TO GTPAT CALLER
17295: {{ENP{{{{END PROCEDURE GTPAT
17296: {{EJC{{{{
17297: *
17298: * GTREA -- GET REAL VALUE
17299: *
17300: * GTREA IS PASSED AN OBJECT AND RETURNS A REAL VALUE
17301: * PERFORMING ANY NECESSARY CONVERSIONS.
17302: *
17303: * (XR) OBJECT TO BE CONVERTED
17304: * JSR GTREA CALL TO CONVERT OBJECT TO REAL
17305: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
17306: * (XR) POINTER TO RESULTING REAL
17307: * (WA,WB,WC,RA) DESTROYED
17308: * (XR) UNCHANGED (CONVERT ERROR ONLY)
17309: *
17310: {GTREA{PRC{E{1{{ENTRY POINT
17311: {{MOV{(R9){R6{{GET FIRST WORD OF BLOCK
17312: {{BEQ{R6{#B$RCL{GTRE2{JUMP IF REAL
17313: {{JSR{GTNUM{{{ELSE CONVERT ARGUMENT TO NUMERIC
17314: {{PPM{GTRE3{{{JUMP IF UNCONVERTIBLE
17315: {{BEQ{R6{#B$RCL{GTRE2{JUMP IF REAL WAS RETURNED
17316: *
17317: * HERE FOR CASE OF AN INTEGER TO CONVERT TO REAL
17318: *
17319: {GTRE1{LDI{4*ICVAL(R9){{{LOAD INTEGER
17320: {{ITR{{{{CONVERT TO REAL
17321: {{JSR{RCBLD{{{BUILD RCBLK
17322: *
17323: * EXIT WITH REAL
17324: *
17325: {GTRE2{EXI{{{{RETURN TO GTREA CALLER
17326: *
17327: * HERE ON CONVERSION ERROR
17328: *
17329: {GTRE3{EXI{1{{{TAKE CONVERT ERROR EXIT
17330: {{ENP{{{{END PROCEDURE GTREA
17331: {{EJC{{{{
17332: *
17333: * GTSMI -- GET SMALL INTEGER
17334: *
17335: * GTSMI IS PASSED A SNOBOL OBJECT AND RETURNS AN ADDRESS
17336: * INTEGER IN THE RANGE (0 LE N LE DNAMB). SUCH A VALUE CAN
17337: * ONLY BE DERIVED FROM AN INTEGER IN THE APPROPRIATE RANGE.
17338: * SMALL INTEGERS NEVER APPEAR AS SNOBOL VALUES. HOWEVER,
17339: * THEY ARE USED INTERNALLY FOR A VARIETY OF PURPOSES.
17340: *
17341: * -(XS) ARGUMENT TO CONVERT (ON STACK)
17342: * JSR GTSMI CALL TO CONVERT TO SMALL INTEGER
17343: * PPM LOC TRANSFER LOC FOR NOT INTEGER
17344: * PPM LOC TRANSFER LOC FOR LT 0, GT DNAMB
17345: * (XR,WC) RESULTING SMALL INT (TWO COPIES)
17346: * (XS) POPPED
17347: * (RA) DESTROYED
17348: * (WA,WB) DESTROYED (ON CONVERT ERROR ONLY)
17349: * (XR) INPUT ARG (CONVERT ERROR ONLY)
17350: *
17351: {GTSMI{PRC{N{2{{ENTRY POINT
17352: {{MOV{(SP)+{R9{{LOAD ARGUMENT
17353: {{BEQ{(R9){#B$ICL{GTSM1{SKIP IF ALREADY AN INTEGER
17354: *
17355: * HERE IF NOT AN INTEGER
17356: *
17357: {{JSR{GTINT{{{CONVERT ARGUMENT TO INTEGER
17358: {{PPM{GTSM2{{{JUMP IF CONVERT IS IMPOSSIBLE
17359: *
17360: * MERGE HERE WITH INTEGER
17361: *
17362: {GTSM1{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE
17363: {{MFI{R8{GTSM3{{MOVE AS ONE WORD, JUMP IF OVFLOW
17364: {{BGT{R8{MXLEN{GTSM3{OR IF TOO SMALL
17365: {{MOV{R8{R9{{COPY RESULT TO XR
17366: {{EXI{{{{RETURN TO GTSMI CALLER
17367: *
17368: * HERE IF UNCONVERTIBLE TO INTEGER
17369: *
17370: {GTSM2{EXI{1{{{TAKE NON-INTEGER ERROR EXIT
17371: *
17372: * HERE IF OUT OF RANGE
17373: *
17374: {GTSM3{EXI{2{{{TAKE OUT-OF-RANGE ERROR EXIT
17375: {{ENP{{{{END PROCEDURE GTSMI
17376: {{EJC{{{{
17377: *
17378: * GTSTG -- GET STRING
17379: *
17380: * GTSTG IS PASSED AN OBJECT AND RETURNS A STRING WITH
17381: * ANY NECESSARY CONVERSIONS PERFORMED.
17382: *
17383: * -(XS) INPUT ARGUMENT (ON STACK)
17384: * JSR GTSTG CALL TO CONVERT TO STRING
17385: * PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
17386: * (XR) POINTER TO RESULTING STRING
17387: * (WA) LENGTH OF STRING IN CHARACTERS
17388: * (XS) POPPED
17389: * (RA) DESTROYED
17390: * (XR) INPUT ARG (CONVERT ERROR ONLY)
17391: *
17392: {GTSTG{PRC{N{1{{ENTRY POINT
17393: {{MOV{(SP)+{R9{{LOAD ARGUMENT, POP STACK
17394: {{BEQ{(R9){#B$SCL{GTS30{JUMP IF ALREADY A STRING
17395: *
17396: * HERE IF NOT A STRING ALREADY
17397: *
17398: {GTS01{MOV{R9{-(SP){{RESTACK ARGUMENT IN CASE ERROR
17399: {{MOV{R10{-(SP){{SAVE XL
17400: {{MOV{R7{GTSVB{{SAVE WB
17401: {{MOV{R8{GTSVC{{SAVE WC
17402: {{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK
17403: {{BEQ{R6{#B$ICL{GTS05{JUMP TO CONVERT INTEGER
17404: {{BEQ{R6{#B$RCL{GTS10{JUMP TO CONVERT REAL
17405: {{BEQ{R6{#B$NML{GTS03{JUMP TO CONVERT NAME
17406: {{BEQ{R6{#B$BCT{GTS32{JUMP TO CONVERT BUFFER
17407: *
17408: * HERE ON CONVERSION ERROR
17409: *
17410: {GTS02{MOV{(SP)+{R10{{RESTORE XL
17411: {{MOV{(SP)+{R9{{RELOAD INPUT ARGUMENT
17412: {{EXI{1{{{TAKE CONVERT ERROR EXIT
17413: {{EJC{{{{
17414: *
17415: * GTSTG (CONTINUED)
17416: *
17417: * HERE TO CONVERT A NAME (ONLY POSSIBLE IF NATURAL VAR)
17418: *
17419: {GTS03{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE
17420: {{BHI{R10{STATE{GTS02{ERROR IF NOT NATURAL VAR (STATIC)
17421: {{ADD{#4*VRSOF{R10{{ELSE POINT TO POSSIBLE STRING NAME
17422: {{MOV{4*SCLEN(R10){R6{{LOAD LENGTH
17423: {{BNZ{R6{GTS04{{JUMP IF NOT SYSTEM VARIABLE
17424: {{MOV{4*VRSVO(R10){R10{{ELSE POINT TO SVBLK
17425: {{MOV{4*SVLEN(R10){R6{{AND LOAD NAME LENGTH
17426: *
17427: * MERGE HERE WITH STRING IN XR, LENGTH IN WA
17428: *
17429: {GTS04{ZER{R7{{{SET OFFSET TO ZERO
17430: {{JSR{SBSTR{{{USE SBSTR TO COPY STRING
17431: {{BRN{GTS29{{{JUMP TO EXIT
17432: *
17433: * COME HERE TO CONVERT AN INTEGER
17434: *
17435: {GTS05{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE
17436: {{MOV{#NUM01{GTSSF{{SET SIGN FLAG NEGATIVE
17437: {{ILT{GTS06{{{SKIP IF INTEGER IS NEGATIVE
17438: {{NGI{{{{ELSE NEGATE INTEGER
17439: {{ZER{GTSSF{{{AND RESET NEGATIVE FLAG
17440: {{EJC{{{{
17441: *
17442: * GTSTG (CONTINUED)
17443: *
17444: * HERE WITH SIGN FLAG SET AND SIGN FORCED NEGATIVE AS
17445: * REQUIRED BY THE CVD INSTRUCTION.
17446: *
17447: {GTS06{MOV{GTSWK{R9{{POINT TO RESULT WORK AREA
17448: {{MOV{#NSTMX{R7{{INITIALIZE COUNTER TO MAX LENGTH
17449: {{PSC{R9{R7{{PREPARE TO STORE (RIGHT-LEFT)
17450: *
17451: * LOOP TO CONVERT DIGITS INTO WORK AREA
17452: *
17453: {GTS07{CVD{{{{CONVERT ONE DIGIT INTO WA
17454: {{SCH{R6{-(R9){{STORE IN WORK AREA
17455: {{DCV{R7{{{DECREMENT COUNTER
17456: {{INE{GTS07{{{LOOP IF MORE DIGITS TO GO
17457: {{CSC{R9{{{COMPLETE STORE CHARACTERS
17458: *
17459: * MERGE HERE AFTER CONVERTING INTEGER OR REAL INTO WORK
17460: * AREA. WB IS SET TO NSTMX - (NUMBER OF CHARS IN RESULT).
17461: *
17462: {GTS08{MOV{#NSTMX{R6{{GET MAX NUMBER OF CHARACTERS
17463: {{SUB{R7{R6{{COMPUTE LENGTH OF RESULT
17464: {{MOV{R6{R10{{REMEMBER LENGTH FOR MOVE LATER ON
17465: {{ADD{GTSSF{R6{{ADD ONE FOR NEGATIVE SIGN IF NEEDED
17466: {{JSR{ALOCS{{{ALLOCATE STRING FOR RESULT
17467: {{MOV{R9{R8{{SAVE RESULT POINTER FOR THE MOMENT
17468: {{PSC{R9{{{POINT TO CHARS OF RESULT BLOCK
17469: {{BZE{GTSSF{GTS09{{SKIP IF POSITIVE
17470: {{MOV{#CH$MN{R6{{ELSE LOAD NEGATIVE SIGN
17471: {{SCH{R6{(R9)+{{AND STORE IT
17472: {{CSC{R9{{{COMPLETE STORE CHARACTERS
17473: *
17474: * HERE AFTER DEALING WITH SIGN
17475: *
17476: {GTS09{MOV{R10{R6{{RECALL LENGTH TO MOVE
17477: {{MOV{GTSWK{R10{{POINT TO RESULT WORK AREA
17478: {{PLC{R10{R7{{POINT TO FIRST RESULT CHARACTER
17479: {{MVC{{{{MOVE CHARS TO RESULT STRING
17480: {{MOV{R8{R9{{RESTORE RESULT POINTER
17481: {{BRN{GTS29{{{JUMP TO EXIT
17482: {{EJC{{{{
17483: *
17484: * GTSTG (CONTINUED)
17485: *
17486: * HERE TO CONVERT A REAL
17487: *
17488: {GTS10{LDR{4*RCVAL(R9){{{LOAD REAL
17489: {{ZER{GTSSF{{{RESET NEGATIVE FLAG
17490: {{REQ{GTS31{{{SKIP IF ZERO
17491: {{RGE{GTS11{{{JUMP IF REAL IS POSITIVE
17492: {{MOV{#NUM01{GTSSF{{ELSE SET NEGATIVE FLAG
17493: {{NGR{{{{AND GET ABSOLUTE VALUE OF REAL
17494: *
17495: * NOW SCALE THE REAL TO THE RANGE (0.1 LE X LT 1.0)
17496: *
17497: {GTS11{LDI{INTV0{{{INITIALIZE EXPONENT TO ZERO
17498: *
17499: * LOOP TO SCALE UP IN STEPS OF 10**10
17500: *
17501: {GTS12{STR{GTSRS{{{SAVE REAL VALUE
17502: {{SBR{REAP1{{{SUBTRACT 0.1 TO COMPARE
17503: {{RGE{GTS13{{{JUMP IF SCALE UP NOT REQUIRED
17504: {{LDR{GTSRS{{{ELSE RELOAD VALUE
17505: {{MLR{REATT{{{MULTIPLY BY 10**10
17506: {{SBI{INTVT{{{DECREMENT EXPONENT BY 10
17507: {{BRN{GTS12{{{LOOP BACK TO TEST AGAIN
17508: *
17509: * TEST FOR SCALE DOWN REQUIRED
17510: *
17511: {GTS13{LDR{GTSRS{{{RELOAD VALUE
17512: {{SBR{REAV1{{{SUBTRACT 1.0
17513: {{RLT{GTS17{{{JUMP IF NO SCALE DOWN REQUIRED
17514: {{LDR{GTSRS{{{ELSE RELOAD VALUE
17515: *
17516: * LOOP TO SCALE DOWN IN STEPS OF 10**10
17517: *
17518: {GTS14{SBR{REATT{{{SUBTRACT 10**10 TO COMPARE
17519: {{RLT{GTS15{{{JUMP IF LARGE STEP NOT REQUIRED
17520: {{LDR{GTSRS{{{ELSE RESTORE VALUE
17521: {{DVR{REATT{{{DIVIDE BY 10**10
17522: {{STR{GTSRS{{{STORE NEW VALUE
17523: {{ADI{INTVT{{{INCREMENT EXPONENT BY 10
17524: {{BRN{GTS14{{{LOOP BACK
17525: {{EJC{{{{
17526: *
17527: * GTSTG (CONTINUED)
17528: *
17529: * AT THIS POINT WE HAVE (1.0 LE X LT 10**10)
17530: * COMPLETE SCALING WITH POWERS OF TEN TABLE
17531: *
17532: {GTS15{MOV{#REAV1{R9{{POINT TO POWERS OF TEN TABLE
17533: *
17534: * LOOP TO LOCATE CORRECT ENTRY IN TABLE
17535: *
17536: {GTS16{LDR{GTSRS{{{RELOAD VALUE
17537: {{ADI{INTV1{{{INCREMENT EXPONENT
17538: {{ADD{#4*CFP$R{R9{{POINT TO NEXT ENTRY IN TABLE
17539: {{SBR{(R9){{{SUBTRACT IT TO COMPARE
17540: {{RGE{GTS16{{{LOOP TILL WE FIND A LARGER ENTRY
17541: {{LDR{GTSRS{{{THEN RELOAD THE VALUE
17542: {{DVR{(R9){{{AND COMPLETE SCALING
17543: {{STR{GTSRS{{{STORE VALUE
17544: *
17545: * WE ARE NOW SCALED, SO ROUND BY ADDING 0.5 * 10**(-CFP$S)
17546: *
17547: {GTS17{LDR{GTSRS{{{GET VALUE AGAIN
17548: {{ADR{GTSRN{{{ADD ROUNDING FACTOR
17549: {{STR{GTSRS{{{STORE RESULT
17550: *
17551: * THE ROUNDING OPERATION MAY HAVE PUSHED US UP PAST
17552: * 1.0 AGAIN, SO CHECK ONE MORE TIME.
17553: *
17554: {{SBR{REAV1{{{SUBTRACT 1.0 TO COMPARE
17555: {{RLT{GTS18{{{SKIP IF OK
17556: {{ADI{INTV1{{{ELSE INCREMENT EXPONENT
17557: {{LDR{GTSRS{{{RELOAD VALUE
17558: {{DVR{REAVT{{{DIVIDE BY 10.0 TO RESCALE
17559: {{BRN{GTS19{{{JUMP TO MERGE
17560: *
17561: * HERE IF ROUNDING DID NOT MUCK UP SCALING
17562: *
17563: {GTS18{LDR{GTSRS{{{RELOAD ROUNDED VALUE
17564: {{EJC{{{{
17565: *
17566: * GTSTG (CONTINUED)
17567: *
17568: * NOW WE HAVE COMPLETED THE SCALING AS FOLLOWS
17569: *
17570: * (IA) SIGNED EXPONENT
17571: * (RA) SCALED REAL (ABSOLUTE VALUE)
17572: *
17573: * IF THE EXPONENT IS NEGATIVE OR GREATER THAN CFP$S, THEN
17574: * WE CONVERT THE NUMBER IN THE FORM.
17575: *
17576: * (NEG SIGN) 0 . (CPF$S DIGITS) E (EXP SIGN) (EXP DIGITS)
17577: *
17578: * IF THE EXPONENT IS POSITIVE AND LESS THAN OR EQUAL TO
17579: * CFP$S, THE NUMBER IS CONVERTED IN THE FORM.
17580: *
17581: * (NEG SIGN) (EXPONENT DIGITS) . (CFP$S-EXPONENT DIGITS)
17582: *
17583: * IN BOTH CASES, THE FORMATS OBTAINED FROM THE ABOVE
17584: * RULES ARE MODIFIED BY DELETING TRAILING ZEROS AFTER THE
17585: * DECIMAL POINT. THERE ARE NO LEADING ZEROS IN THE EXPONENT
17586: * AND THE EXPONENT SIGN IS ALWAYS PRESENT.
17587: *
17588: {GTS19{MOV{#CFP$S{R10{{SET NUM DEC DIGITS = CFP$S
17589: {{MOV{#CH$MN{GTSES{{SET EXPONENT SIGN NEGATIVE
17590: {{ILT{GTS21{{{ALL SET IF EXPONENT IS NEGATIVE
17591: {{MFI{R6{{{ELSE FETCH EXPONENT
17592: {{BLE{R6{#CFP$S{GTS20{SKIP IF WE CAN USE SPECIAL FORMAT
17593: {{MTI{R6{{{ELSE RESTORE EXPONENT
17594: {{NGI{{{{SET NEGATIVE FOR CVD
17595: {{MOV{#CH$PL{GTSES{{SET PLUS SIGN FOR EXPONENT SIGN
17596: {{BRN{GTS21{{{JUMP TO GENERATE EXPONENT
17597: *
17598: * HERE IF WE CAN USE THE FORMAT WITHOUT AN EXPONENT
17599: *
17600: {GTS20{SUB{R6{R10{{COMPUTE DIGITS AFTER DECIMAL POINT
17601: {{LDI{INTV0{{{RESET EXPONENT TO ZERO
17602: {{EJC{{{{
17603: *
17604: * GTSTG (CONTINUED)
17605: *
17606: * MERGE HERE AS FOLLOWS
17607: *
17608: * (IA) EXPONENT ABSOLUTE VALUE
17609: * GTSES CHARACTER FOR EXPONENT SIGN
17610: * (RA) POSITIVE FRACTION
17611: * (XL) NUMBER OF DIGITS AFTER DEC POINT
17612: *
17613: {GTS21{MOV{GTSWK{R9{{POINT TO WORK AREA
17614: {{MOV{#NSTMX{R7{{SET CHARACTER CTR TO MAX LENGTH
17615: {{PSC{R9{R7{{PREPARE TO STORE (RIGHT TO LEFT)
17616: {{IEQ{GTS23{{{SKIP EXPONENT IF IT IS ZERO
17617: *
17618: * LOOP TO GENERATE DIGITS OF EXPONENT
17619: *
17620: {GTS22{CVD{{{{CONVERT A DIGIT INTO WA
17621: {{SCH{R6{-(R9){{STORE IN WORK AREA
17622: {{DCV{R7{{{DECREMENT COUNTER
17623: {{INE{GTS22{{{LOOP BACK IF MORE DIGITS TO GO
17624: *
17625: * HERE GENERATE EXPONENT SIGN AND E
17626: *
17627: {{MOV{GTSES{R6{{LOAD EXPONENT SIGN
17628: {{SCH{R6{-(R9){{STORE IN WORK AREA
17629: {{MOV{#CH$LE{R6{{GET CHARACTER LETTER E
17630: {{SCH{R6{-(R9){{STORE IN WORK AREA
17631: {{SUB{#NUM02{R7{{DECREMENT COUNTER FOR SIGN AND E
17632: *
17633: * HERE TO GENERATE THE FRACTION
17634: *
17635: {GTS23{MLR{GTSSC{{{CONVERT REAL TO INTEGER (10**CFP$S)
17636: {{RTI{{{{GET INTEGER (OVERFLOW IMPOSSIBLE)
17637: {{NGI{{{{NEGATE AS REQUIRED BY CVD
17638: *
17639: * LOOP TO SUPPRESS TRAILING ZEROS
17640: *
17641: {GTS24{BZE{R10{GTS27{{JUMP IF NO DIGITS LEFT TO DO
17642: {{CVD{{{{ELSE CONVERT ONE DIGIT
17643: {{BNE{R6{#CH$D0{GTS26{JUMP IF NOT A ZERO
17644: {{DCV{R10{{{DECREMENT COUNTER
17645: {{BRN{GTS24{{{LOOP BACK FOR NEXT DIGIT
17646: {{EJC{{{{
17647: *
17648: * GTSTG (CONTINUED)
17649: *
17650: * LOOP TO GENERATE DIGITS AFTER DECIMAL POINT
17651: *
17652: {GTS25{CVD{{{{CONVERT A DIGIT INTO WA
17653: *
17654: * MERGE HERE FIRST TIME
17655: *
17656: {GTS26{SCH{R6{-(R9){{STORE DIGIT
17657: {{DCV{R7{{{DECREMENT COUNTER
17658: {{DCV{R10{{{DECREMENT COUNTER
17659: {{BNZ{R10{GTS25{{LOOP BACK IF MORE TO GO
17660: *
17661: * HERE GENERATE THE DECIMAL POINT
17662: *
17663: {GTS27{MOV{#CH$DT{R6{{LOAD DECIMAL POINT
17664: {{SCH{R6{-(R9){{STORE IN WORK AREA
17665: {{DCV{R7{{{DECREMENT COUNTER
17666: *
17667: * HERE GENERATE THE DIGITS BEFORE THE DECIMAL POINT
17668: *
17669: {GTS28{CVD{{{{CONVERT A DIGIT INTO WA
17670: {{SCH{R6{-(R9){{STORE IN WORK AREA
17671: {{DCV{R7{{{DECREMENT COUNTER
17672: {{INE{GTS28{{{LOOP BACK IF MORE TO GO
17673: {{CSC{R9{{{COMPLETE STORE CHARACTERS
17674: {{BRN{GTS08{{{ELSE JUMP BACK TO EXIT
17675: *
17676: * EXIT POINT AFTER SUCCESSFUL CONVERSION
17677: *
17678: {GTS29{MOV{(SP)+{R10{{RESTORE XL
17679: {{ICA{SP{{{POP ARGUMENT
17680: {{MOV{GTSVB{R7{{RESTORE WB
17681: {{MOV{GTSVC{R8{{RESTORE WC
17682: *
17683: * MERGE HERE IF NO CONVERSION REQUIRED
17684: *
17685: {GTS30{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH
17686: {{EXI{{{{RETURN TO CALLER
17687: *
17688: * HERE TO RETURN STRING FOR REAL ZERO
17689: *
17690: {GTS31{MOV{#SCRE0{R10{{POINT TO STRING
17691: {{MOV{#NUM02{R6{{2 CHARS
17692: {{ZER{R7{{{ZERO OFFSET
17693: {{JSR{SBSTR{{{COPY STRING
17694: {{BRN{GTS29{{{RETURN
17695: {{EJC{{{{
17696: *
17697: * HERE TO CONVERT A BUFFER BLOCK
17698: *
17699: {GTS32{MOV{R9{R10{{COPY ARG PTR
17700: {{MOV{4*BCLEN(R10){R6{{GET SIZE TO ALLOCATE
17701: {{BZE{R6{GTS33{{IF NULL THEN RETURN NULL
17702: {{JSR{ALOCS{{{ALLOCATE STRING FRAME
17703: {{MOV{R9{R7{{SAVE STRING PTR
17704: {{MOV{4*SCLEN(R9){R6{{GET LENGTH TO MOVE
17705: {{CTB{R6{0{{GET AS MULTIPLE OF WORD SIZE
17706: {{MOV{4*BCBUF(R10){R10{{POINT TO BFBLK
17707: {{ADD{#4*SCSI${R9{{POINT TO START OF CHARACTER AREA
17708: {{ADD{#4*BFSI${R10{{POINT TO START OF BUFFER CHARS
17709: {{MVW{{{{COPY WORDS
17710: {{MOV{R7{R9{{RESTORE SCBLK PTR
17711: {{BRN{GTS29{{{EXIT WITH SCBLK
17712: *
17713: * HERE WHEN NULL BUFFER IS BEING CONVERTED
17714: *
17715: {GTS33{MOV{#NULLS{R9{{POINT TO NULL
17716: {{BRN{GTS29{{{EXIT WITH NULL
17717: {{ENP{{{{END PROCEDURE GTSTG
17718: {{EJC{{{{
17719: *
17720: * GTVAR -- GET VARIABLE FOR I/O/TRACE ASSOCIATION
17721: *
17722: * GTVAR IS USED TO POINT TO AN ACTUAL VARIABLE LOCATION
17723: * FOR THE DETACH,INPUT,OUTPUT,TRACE,STOPTR SYSTEM FUNCTIONS
17724: *
17725: * (XR) ARGUMENT TO FUNCTION
17726: * JSR GTVAR CALL TO LOCATE VARIABLE POINTER
17727: * PPM LOC TRANSFER LOC IF NOT OK VARIABLE
17728: * (XL,WA) NAME BASE,OFFSET OF VARIABLE
17729: * (XR,RA) DESTROYED
17730: * (WB,WC) DESTROYED (CONVERT ERROR ONLY)
17731: * (XR) INPUT ARG (CONVERT ERROR ONLY)
17732: *
17733: {GTVAR{PRC{E{1{{ENTRY POINT
17734: {{BNE{(R9){#B$NML{GTVR2{JUMP IF NOT A NAME
17735: {{MOV{4*NMOFS(R9){R6{{ELSE LOAD NAME OFFSET
17736: {{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE
17737: {{BEQ{(R10){#B$EVT{GTVR1{ERROR IF EXPRESSION VARIABLE
17738: {{BNE{(R10){#B$KVT{GTVR3{ALL OK IF NOT KEYWORD VARIABLE
17739: *
17740: * HERE ON CONVERSION ERROR
17741: *
17742: {GTVR1{EXI{1{{{TAKE CONVERT ERROR EXIT
17743: *
17744: * HERE IF NOT A NAME, TRY CONVERT TO NATURAL VARIABLE
17745: *
17746: {GTVR2{MOV{R8{GTVRC{{SAVE WC
17747: {{JSR{GTNVR{{{LOCATE VRBLK IF POSSIBLE
17748: {{PPM{GTVR1{{{JUMP IF CONVERT ERROR
17749: {{MOV{R9{R10{{ELSE COPY VRBLK NAME BASE
17750: {{MOV{#4*VRVAL{R6{{AND SET OFFSET
17751: {{MOV{GTVRC{R8{{RESTORE WC
17752: *
17753: * HERE FOR NAME OBTAINED
17754: *
17755: {GTVR3{BHI{R10{STATE{GTVR4{ALL OK IF NOT NATURAL VARIABLE
17756: {{BEQ{4*VRSTO(R10){#B$VRE{GTVR1{ERROR IF PROTECTED VARIABLE
17757: *
17758: * COMMON EXIT POINT
17759: *
17760: {GTVR4{EXI{{{{RETURN TO CALLER
17761: {{ENP{{{{END PROCEDURE GTVAR
17762: {{EJC{{{{
17763: *
17764: * HASHS -- COMPUTE HASH INDEX FOR STRING
17765: *
17766: * HASHS IS USED TO CONVERT A STRING TO A UNIQUE INTEGER
17767: * VALUE. THE RESULTING HASH VALUE IS A POSITIVE INTEGER
17768: * IN THE RANGE 0 TO CFP$M
17769: *
17770: * (XR) STRING TO BE HASHED
17771: * JSR HASHS CALL TO HASH STRING
17772: * (IA) HASH VALUE
17773: * (XR,WB,WC) DESTROYED
17774: *
17775: * THE HASH FUNCTION USED IS AS FOLLOWS.
17776: *
17777: * START WITH THE LENGTH OF THE STRING (SGD07)
17778: *
17779: * TAKE THE FIRST E$HNW WORDS OF THE CHARACTERS FROM
17780: * THE STRING OR ALL THE WORDS IF FEWER THAN E$HNW.
17781: *
17782: * COMPUTE THE EXCLUSIVE OR OF ALL THESE WORDS TREATING
17783: * THEM AS ONE WORD BIT STRING VALUES.
17784: *
17785: * MOVE THE RESULT AS AN INTEGER WITH THE MTI INSTRUCTION.
17786: *
17787: {HASHS{PRC{E{0{{ENTRY POINT
17788: {{MOV{4*SCLEN(R9){R8{{LOAD STRING LENGTH IN CHARACTERS
17789: {{MOV{R8{R7{{INITIALIZE WITH LENGTH
17790: {{BZE{R8{HSHS3{{JUMP IF NULL STRING
17791: {{CTW{R8{0{{ELSE GET NUMBER OF WORDS OF CHARS
17792: {{ADD{#4*SCHAR{R9{{POINT TO CHARACTERS OF STRING
17793: {{BLO{R8{#E$HNW{HSHS1{USE WHOLE STRING IF SHORT
17794: {{MOV{#E$HNW{R8{{ELSE SET TO INVOLVE FIRST E$HNW WDS
17795: *
17796: * HERE WITH COUNT OF WORDS TO CHECK IN WC
17797: *
17798: {HSHS1{LCT{R8{R8{{SET COUNTER TO CONTROL LOOP
17799: *
17800: * LOOP TO COMPUTE EXCLUSIVE OR
17801: *
17802: {HSHS2{XOB{(R9)+{R7{{EXCLUSIVE OR NEXT WORD OF CHARS
17803: {{BCT{R8{HSHS2{{LOOP TILL ALL PROCESSED
17804: *
17805: * MERGE HERE WITH EXCLUSIVE OR IN WB
17806: *
17807: {HSHS3{ZGB{R7{{{ZEROISE UNDEFINED BITS
17808: {{ANB{BITSM{R7{{ENSURE IN RANGE 0 TO CFP$M
17809: {{MTI{R7{{{MOVE RESULT AS INTEGER
17810: {{ZER{R9{{{CLEAR GARBAGE VALUE IN XR
17811: {{EXI{{{{RETURN TO HASHS CALLER
17812: {{ENP{{{{END PROCEDURE HASHS
17813: {{EJC{{{{
17814: *
17815: * ICBLD -- BUILD INTEGER BLOCK
17816: *
17817: * (IA) INTEGER VALUE FOR ICBLK
17818: * JSR ICBLD CALL TO BUILD INTEGER BLOCK
17819: * (XR) POINTER TO RESULT ICBLK
17820: * (WA) DESTROYED
17821: *
17822: {ICBLD{PRC{E{0{{ENTRY POINT
17823: {{MFI{R9{ICBL1{{COPY SMALL INTEGERS
17824: {{BLE{R9{#NUM02{ICBL3{JUMP IF 0,1 OR 2
17825: *
17826: * CONSTRUCT ICBLK
17827: *
17828: {ICBL1{MOV{DNAMP{R9{{LOAD POINTER TO NEXT AVAILABLE LOC
17829: {{ADD{#4*ICSI${R9{{POINT PAST NEW ICBLK
17830: {{BLO{R9{DNAME{ICBL2{JUMP IF THERE IS ROOM
17831: {{MOV{#4*ICSI${R6{{ELSE LOAD LENGTH OF ICBLK
17832: {{JSR{ALLOC{{{USE STANDARD ALLOCATOR TO GET BLOCK
17833: {{ADD{R6{R9{{POINT PAST BLOCK TO MERGE
17834: *
17835: * MERGE HERE WITH XR POINTING PAST THE BLOCK OBTAINED
17836: *
17837: {ICBL2{MOV{R9{DNAMP{{SET NEW POINTER
17838: {{SUB{#4*ICSI${R9{{POINT BACK TO START OF BLOCK
17839: {{MOV{#B$ICL{(R9){{STORE TYPE WORD
17840: {{STI{4*ICVAL(R9){{{STORE INTEGER VALUE IN ICBLK
17841: {{EXI{{{{RETURN TO ICBLD CALLER
17842: *
17843: * OPTIMISE BY NOT BUILDING ICBLKS FOR SMALL INTEGERS
17844: *
17845: {ICBL3{WTB{R9{{{CONVERT INTEGER TO OFFSET
17846: {{MOV{L^INTAB(R9){R9{{POINT TO PRE-BUILT ICBLK
17847: {{EXI{{{{RETURN
17848: {{ENP{{{{END PROCEDURE ICBLD
17849: {{EJC{{{{
17850: *
17851: * IDENT -- COMPARE TWO VALUES
17852: *
17853: * IDENT COMPARES TWO VALUES IN THE SENSE OF THE IDENT
17854: * DIFFER FUNCTIONS AVAILABLE AT THE SNOBOL LEVEL.
17855: *
17856: * (XR) FIRST ARGUMENT
17857: * (XL) SECOND ARGUMENT
17858: * JSR IDENT CALL TO COMPARE ARGUMENTS
17859: * PPM LOC TRANSFER LOC IF IDENT
17860: * (NORMAL RETURN IF DIFFER)
17861: * (XR,XL,WC,RA) DESTROYED
17862: *
17863: {IDENT{PRC{E{1{{ENTRY POINT
17864: {{BEQ{R9{R10{IDEN7{JUMP IF SAME POINTER (IDENT)
17865: {{MOV{(R9){R8{{ELSE LOAD ARG 1 TYPE WORD
17866: {{BNE{R8{(R10){IDEN1{DIFFER IF ARG 2 TYPE WORD DIFFER
17867: {{BEQ{R8{#B$SCL{IDEN2{JUMP IF STRINGS
17868: {{BEQ{R8{#B$ICL{IDEN4{JUMP IF INTEGERS
17869: {{BEQ{R8{#B$RCL{IDEN5{JUMP IF REALS
17870: {{BEQ{R8{#B$NML{IDEN6{JUMP IF NAMES
17871: *
17872: * FOR ALL OTHER DATATYPES, MUST BE DIFFER IF XR NE XL
17873: *
17874: * MERGE HERE FOR DIFFER
17875: *
17876: {IDEN1{EXI{{{{TAKE DIFFER EXIT
17877: *
17878: * HERE FOR STRINGS, IDENT ONLY IF LENGTHS AND CHARS SAME
17879: *
17880: {IDEN2{MOV{4*SCLEN(R9){R8{{LOAD ARG 1 LENGTH
17881: {{BNE{R8{4*SCLEN(R10){IDEN1{DIFFER IF LENGTHS DIFFER
17882: {{CTW{R8{0{{GET NUMBER OF WORDS IN STRINGS
17883: {{ADD{#4*SCHAR{R9{{POINT TO CHARS OF ARG 1
17884: {{ADD{#4*SCHAR{R10{{POINT TO CHARS OF ARG 2
17885: {{LCT{R8{R8{{SET LOOP COUNTER
17886: *
17887: * LOOP TO COMPARE CHARACTERS. NOTE THAT WA CANNOT BE ZERO
17888: * SINCE ALL NULL STRINGS POINT TO NULLS AND GIVE XL=XR.
17889: *
17890: {IDEN3{CNE{(R9){(R10){IDEN8{DIFFER IF CHARS DO NOT MATCH
17891: {{ICA{R9{{{ELSE BUMP ARG ONE POINTER
17892: {{ICA{R10{{{BUMP ARG TWO POINTER
17893: {{BCT{R8{IDEN3{{LOOP BACK TILL ALL CHECKED
17894: {{EJC{{{{
17895: *
17896: * IDENT (CONTINUED)
17897: *
17898: * HERE TO EXIT FOR CASE OF TWO IDENT STRINGS
17899: *
17900: {{ZER{R10{{{CLEAR GARBAGE VALUE IN XL
17901: {{ZER{R9{{{CLEAR GARBAGE VALUE IN XR
17902: {{EXI{1{{{TAKE IDENT EXIT
17903: *
17904: * HERE FOR INTEGERS, IDENT IF SAME VALUES
17905: *
17906: {IDEN4{LDI{4*ICVAL(R9){{{LOAD ARG 1
17907: {{SBI{4*ICVAL(R10){{{SUBTRACT ARG 2 TO COMPARE
17908: {{IOV{IDEN1{{{DIFFER IF OVERFLOW
17909: {{INE{IDEN1{{{DIFFER IF RESULT IS NOT ZERO
17910: {{EXI{1{{{TAKE IDENT EXIT
17911: *
17912: * HERE FOR REALS, IDENT IF SAME VALUES
17913: *
17914: {IDEN5{LDR{4*RCVAL(R9){{{LOAD ARG 1
17915: {{SBR{4*RCVAL(R10){{{SUBTRACT ARG 2 TO COMPARE
17916: {{ROV{IDEN1{{{DIFFER IF OVERFLOW
17917: {{RNE{IDEN1{{{DIFFER IF RESULT IS NOT ZERO
17918: {{EXI{1{{{TAKE IDENT EXIT
17919: *
17920: * HERE FOR NAMES, IDENT IF BASES AND OFFSETS SAME
17921: *
17922: {IDEN6{BNE{4*NMOFS(R9){4*NMOFS(R10){IDEN1{DIFFER IF DIFFERENT OFFSET
17923: {{BNE{4*NMBAS(R9){4*NMBAS(R10){IDEN1{DIFFER IF DIFFERENT BASE
17924: *
17925: * MERGE HERE TO SIGNAL IDENT FOR IDENTICAL POINTERS
17926: *
17927: {IDEN7{EXI{1{{{TAKE IDENT EXIT
17928: *
17929: * HERE FOR DIFFER STRINGS
17930: *
17931: {IDEN8{ZER{R9{{{CLEAR GARBAGE PTR IN XR
17932: {{ZER{R10{{{CLEAR GARBAGE PTR IN XL
17933: {{EXI{{{{RETURN TO CALLER (DIFFER)
17934: {{ENP{{{{END PROCEDURE IDENT
17935: {{EJC{{{{
17936: *
17937: * INOUT - USED TO INITIALISE INPUT AND OUTPUT VARIABLES
17938: *
17939: * (XL) POINTER TO VBL NAME STRING
17940: * (WB) TRBLK TYPE
17941: * JSR INOUT CALL TO PERFORM INITIALISATION
17942: * (XL) VRBLK PTR
17943: * (XR) TRBLK PTR
17944: * (WA,WC) DESTROYED
17945: *
17946: * NOTE THAT TRTER (= TRTRF) FIELD OF STANDARD I/O VARIABLES
17947: * POINTS TO CORRESPONDING SVBLK NOT TO A TRBLK AS IS THE
17948: * CASE FOR ORDINARY VARIABLES.
17949: *
17950: {INOUT{PRC{E{0{{ENTRY POINT
17951: {{MOV{R7{-(SP){{STACK TRBLK TYPE
17952: {{MOV{4*SCLEN(R10){R6{{GET NAME LENGTH
17953: {{ZER{R7{{{POINT TO START OF NAME
17954: {{JSR{SBSTR{{{BUILD A PROPER SCBLK
17955: {{JSR{GTNVR{{{BUILD VRBLK
17956: {{PPM{{{{NO ERROR RETURN
17957: {{MOV{R9{R8{{SAVE VRBLK POINTER
17958: {{MOV{(SP)+{R7{{GET TRTER FIELD
17959: {{ZER{R10{{{ZERO TRFPT
17960: {{JSR{TRBLD{{{BUILD TRBLK
17961: {{MOV{R8{R10{{RECALL VRBLK POINTER
17962: {{MOV{4*VRSVP(R10){4*TRTER(R9){{STORE SVBLK POINTER
17963: {{MOV{R9{4*VRVAL(R10){{STORE TRBLK PTR IN VRBLK
17964: {{MOV{#B$VRA{4*VRGET(R10){{SET TRAPPED ACCESS
17965: {{MOV{#B$VRV{4*VRSTO(R10){{SET TRAPPED STORE
17966: {{EXI{{{{RETURN TO CALLER
17967: {{ENP{{{{END PROCEDURE INOUT
17968: {{EJC{{{{
17969: *
17970: * INSBF -- INSERT STRING IN BUFFER
17971: *
17972: * THIS ROUTINE WILL REPLACE A SECTION OF A BUFFER WITH THE
17973: * CONTENTS OF A GIVEN STRING. IF THE LENGTH OF THE
17974: * SECTION TO BE REPLACED IS DIFFERENT THAN THE LENGTH OF
17975: * THE GIVEN STRING, AND THE REPLACEMENT IS NOT AN APPEND,
17976: * THEN THE UPPER SECTION OF THE BUFFER IS SHIFTED UP OR
17977: * DOWN TO CREATE THE PROPER SPACE FOR THE INSERT.
17978: *
17979: * (XR) POINTER TO BFBLK
17980: * (XL) OBJECT WHICH IS STRING CONVERTABLE
17981: * (WA) OFFSET OF START OF INSERT IN (XR)
17982: * (WB) LENGTH OF SECTION IN (XR) REPLACED
17983: * JSR INSBF CALL TO INSERT CHARACTERS IN BUFFER
17984: * PPM LOC THREAD IF (XR) NOT CONVERTABLE
17985: * PPM LOC THREAD IF INSERT NOT POSSIBLE
17986: *
17987: * THE SECOND ALTERNATE EXIT IS TAKEN IF THE INSERT WOULD
17988: * OVERFLOW THE BUFFER, OR IF THE INSERT IS OUT PAST THE
17989: * DEFINED END OF THE BUFFER AS GIVEN.
17990: *
17991: {INSBF{PRC{E{2{{ENTRY POINT
17992: {{MOV{R6{INSSA{{SAVE ENTRY WA
17993: {{MOV{R7{INSSB{{SAVE ENTRY WB
17994: {{MOV{R8{INSSC{{SAVE ENTRY WC
17995: {{ADD{R7{R6{{ADD TO GET OFFSET PAST REPLACE PART
17996: {{MOV{R6{INSAB{{SAVE WA+WB
17997: {{MOV{4*BCLEN(R9){R8{{GET CURRENT DEFINED LENGTH
17998: {{BGT{INSSA{R8{INS07{FAIL IF START OFFSET TOO BIG
17999: {{BGT{R6{R8{INS07{FAIL IF FINAL OFFSET TOO BIG
18000: {{MOV{R10{-(SP){{SAVE ENTRY XL
18001: {{MOV{R9{-(SP){{SAVE BCBLK PTR
18002: {{MOV{R10{-(SP){{STACK AGAIN FOR GTSTG
18003: {{JSR{GTSTG{{{CALL TO CONVERT TO STRING
18004: {{PPM{INS05{{{TAKE STRING CONVERT ERR EXIT
18005: {{MOV{R9{R10{{SAVE STRING PTR
18006: {{MOV{(SP){R9{{RESTORE BCBLK PTR
18007: {{ADD{R8{R6{{ADD BUFFER LEN TO STRING LEN
18008: {{SUB{INSSB{R6{{BIAS OUT COMPONENT BEING REPLACED
18009: {{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK
18010: {{BGT{R6{4*BFALC(R9){INS06{FAIL IF RESULT EXCEEDS ALLOCATION
18011: {{MOV{(SP){R9{{RESTORE BCBLK PTR
18012: {{MOV{R8{R6{{GET BUFFER LENGTH
18013: {{SUB{INSAB{R6{{SUBTRACT TO GET SHIFT LENGTH
18014: {{ADD{4*SCLEN(R10){R8{{ADD LENGTH OF NEW
18015: {{SUB{INSSB{R8{{SUBTRACT OLD TO GET TOTAL NEW LEN
18016: {{MOV{4*BCLEN(R9){R7{{GET OLD BCLEN
18017: {{MOV{R8{4*BCLEN(R9){{STUFF NEW LENGTH
18018: {{BZE{R6{INS04{{SKIP SHIFT IF NOTHING TO DO
18019: {{BEQ{INSSB{4*SCLEN(R10){INS04{SKIP SHIFT IF LENGTHS MATCH
18020: {{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK
18021: {{MOV{R10{-(SP){{SAVE SCBLK PTR
18022: {{BLO{INSSB{4*SCLEN(R10){INS01{BRN IF SHFT IS FOR MORE ROOM
18023: {{EJC{{{{
18024: *
18025: * INSBF (CONTINUED)
18026: *
18027: * WE ARE SHIFTING THE UPPER SEGMENT DOWN TO COMPACT
18028: * THE BUFFER. (THE STRING LENGTH IS SMALLER THAN THE
18029: * SEGMENT BEING REPLACED.) REGISTERS ARE SET AS:
18030: *
18031: * (WA) MOVE (SHIFT DOWN) LENGTH
18032: * (WB) OLD BCLEN
18033: * (WC) NEW BCLEN
18034: * (XR) BFBLK PTR
18035: * (XL),(XS) SCBLK PTR
18036: *
18037: {{MOV{INSSA{R7{{GET OFFSET TO INSERT
18038: {{ADD{4*SCLEN(R10){R7{{ADD INSERT LENGTH TO GET DEST OFF
18039: {{MOV{R9{R10{{MAKE COPY
18040: {{PLC{R10{INSAB{{PREPARE SOURCE FOR MOVE
18041: {{PSC{R9{R7{{PREPARE DESTINATION REG FOR MOVE
18042: {{MVC{{{{MOVE EM OUT
18043: {{BRN{INS02{{{BRANCH TO PAD
18044: *
18045: * WE ARE SHIFTING THE UPPER SEGMENT UP TO EXPAND
18046: * THE BUFFER. (THE STRING LENGTH IS LARGER THAN THE
18047: * SEGMENT BEING REPLACED.)
18048: *
18049: {INS01{MOV{R9{R10{{COPY BFBLK PTR
18050: {{PLC{R10{R7{{SET SOURCE REG FOR MOVE BACKWARDS
18051: {{PSC{R9{R8{{SET DESTINATION PTR FOR MOVE
18052: {{MCB{{{{MOVE BACKWARDS (POSSIBLE OVERLAP)
18053: *
18054: * MERGE HERE AFTER MOVE TO ADJUST PADDING AT NEW BUFFER END
18055: *
18056: {INS02{MOV{(SP)+{R10{{RESTORE SCBLK PTR
18057: {{MOV{R8{R6{{COPY NEW BUFFER END
18058: {{CTB{R6{0{{ROUND OUT
18059: {{SUB{R8{R6{{SUBTRACT TO GET REMAINDER
18060: {{BZE{R6{INS04{{NO PAD IF ALREADY EVEN BOUNDARY
18061: {{MOV{(SP){R9{{GET BCBLK PTR
18062: {{MOV{4*BCBUF(R9){R9{{GET BFBLK PTR
18063: {{PSC{R9{R8{{PREPARE TO PAD
18064: {{ZER{R7{{{CLEAR WB
18065: {{LCT{R6{R6{{LOAD LOOP COUNT
18066: *
18067: * LOOP HERE TO STUFF PAD CHARACTERS
18068: *
18069: {INS03{SCH{R7{(R9)+{{STUFF ZERO PAD
18070: {{BCT{R6{INS03{{BRANCH FOR MORE
18071: {{EJC{{{{
18072: *
18073: * INSBF (CONTINUED)
18074: *
18075: * MERGE HERE WHEN PADDING OK. NOW COPY IN THE INSERT
18076: * STRING TO THE HOLE.
18077: *
18078: {INS04{MOV{(SP){R9{{GET BCBLK PTR
18079: {{MOV{4*BCBUF(R9){R9{{GET BFBLK PTR
18080: {{MOV{4*SCLEN(R10){R6{{GET MOVE LENGTH
18081: {{PLC{R10{{{PREPARE TO COPY FROM FIRST CHAR
18082: {{PSC{R9{INSSA{{PREPARE TO STORE IN HOLE
18083: {{MVC{{{{COPY THE CHARACTERS
18084: {{MOV{(SP)+{R9{{RESTORE ENTRY XR
18085: {{MOV{(SP)+{R10{{RESTORE ENTRY XL
18086: {{MOV{INSSA{R6{{RESTORE ENTRY WA
18087: {{MOV{INSSB{R7{{RESTORE ENTRY WB
18088: {{MOV{INSSC{R8{{RESTORE ENTRY WC
18089: {{EXI{{{{RETURN TO CALLER
18090: *
18091: * HERE TO TAKE STRING CONVERT ERROR EXIT
18092: *
18093: {INS05{MOV{(SP)+{R9{{RESTORE ENTRY XR
18094: {{MOV{(SP)+{R10{{RESTORE ENTRY XL
18095: {{MOV{INSSA{R6{{RESTORE ENTRY WA
18096: {{MOV{INSSB{R7{{RESTORE ENTRY WB
18097: {{MOV{INSSC{R8{{RESTORE ENTRY WC
18098: {{EXI{1{{{ALTERNATE EXIT
18099: *
18100: * HERE FOR INVALID OFFSET OR LENGTH
18101: *
18102: {INS06{MOV{(SP)+{R9{{RESTORE ENTRY XR
18103: {{MOV{(SP)+{R10{{RESTORE ENTRY XL
18104: *
18105: * MERGE FOR LENGTH FAILURE EXIT WITH STACK SET
18106: *
18107: {INS07{MOV{INSSA{R6{{RESTORE ENTRY WA
18108: {{MOV{INSSB{R7{{RESTORE ENTRY WB
18109: {{MOV{INSSC{R8{{RESTORE ENTRY WC
18110: {{EXI{2{{{ALTERNATE EXIT
18111: {{ENP{{{{END PROCEDURE INSBF
18112: {{EJC{{{{
18113: *
18114: * IOFCB -- GET INPUT/OUTPUT FCBLK POINTER
18115: *
18116: * USED BY ENDFILE, EJECT AND REWIND TO FIND THE FCBLK
18117: * (IF ANY) CORRESPONDING TO THEIR ARGUMENT.
18118: *
18119: * -(XS) ARGUMENT
18120: * JSR IOFCB CALL TO FIND FCBLK
18121: * PPM LOC ARG IS AN UNSUITABLE NAME
18122: * PPM LOC ARG IS NULL STRING
18123: * (XS) POPPED
18124: * (XL) PTR TO FILEARG1 VRBLK
18125: * (XR) ARGUMENT
18126: * (WA) FCBLK PTR OR 0
18127: * (WB) DESTROYED
18128: *
18129: {IOFCB{PRC{N{2{{ENTRY POINT
18130: {{JSR{GTSTG{{{GET ARG AS STRING
18131: {{PPM{IOFC2{{{FAIL
18132: {{MOV{R9{R10{{COPY STRING PTR
18133: {{JSR{GTNVR{{{GET AS NATURAL VARIABLE
18134: {{PPM{IOFC3{{{FAIL IF NULL
18135: {{MOV{R10{R7{{COPY STRING POINTER AGAIN
18136: {{MOV{R9{R10{{COPY VRBLK PTR FOR RETURN
18137: {{ZER{R6{{{IN CASE NO TRBLK FOUND
18138: *
18139: * LOOP TO FIND FILE ARG1 TRBLK
18140: *
18141: {IOFC1{MOV{4*VRVAL(R9){R9{{GET POSSIBLE TRBLK PTR
18142: {{BNE{(R9){#B$TRT{IOFC2{FAIL IF END OF CHAIN
18143: {{BNE{4*TRTYP(R9){#TRTFC{IOFC1{LOOP IF NOT FILE ARG TRBLK
18144: {{MOV{4*TRFPT(R9){R6{{GET FCBLK PTR
18145: {{MOV{R7{R9{{COPY ARG
18146: {{EXI{{{{RETURN
18147: *
18148: * FAIL RETURN
18149: *
18150: {IOFC2{EXI{1{{{FAIL
18151: *
18152: * NULL ARG
18153: *
18154: {IOFC3{EXI{2{{{NULL ARG RETURN
18155: {{ENP{{{{END PROCEDURE IOFCB
18156: {{EJC{{{{
18157: *
18158: * IOPPF -- PROCESS FILEARG2 FOR IOPUT
18159: *
18160: * (R$XSC) FILEARG2 PTR
18161: * JSR IOPPF CALL TO PROCESS FILEARG2
18162: * (XL) FILEARG1 PTR
18163: * (XR) FILE ARG2 PTR
18164: * -(XS)..-(XS) FIELDS EXTRACTED FROM FILEARG2
18165: * (WC) NO. OF FIELDS EXTRACTED
18166: * (WB) INPUT/OUTPUT FLAG
18167: * (WA) FCBLK PTR OR 0
18168: *
18169: {IOPPF{PRC{N{0{{ENTRY POINT
18170: {{ZER{R7{{{TO COUNT FIELDS EXTRACTED
18171: *
18172: * LOOP TO EXTRACT FIELDS
18173: *
18174: {IOPP1{MOV{#IODEL{R10{{GET DELIMITER
18175: {{MOV{R10{R8{{COPY IT
18176: {{JSR{XSCAN{{{GET NEXT FIELD
18177: {{MOV{R9{-(SP){{STACK IT
18178: {{ICV{R7{{{INCREMENT COUNT
18179: {{BNZ{R6{IOPP1{{LOOP
18180: {{MOV{R7{R8{{COUNT OF FIELDS
18181: {{MOV{IOPTT{R7{{I/O MARKER
18182: {{MOV{R$IOF{R6{{FCBLK PTR OR 0
18183: {{MOV{R$IO2{R9{{FILE ARG2 PTR
18184: {{MOV{R$IO1{R10{{FILEARG1
18185: {{EXI{{{{RETURN
18186: {{ENP{{{{END PROCEDURE IOPPF
18187: {{EJC{{{{
18188: *
18189: * IOPUT -- ROUTINE USED BY INPUT AND OUTPUT
18190: *
18191: * IOPUT SETS UP INPUT/OUTPUT ASSOCIATIONS. IT BUILDS
18192: * SUCH TRACE AND FILE CONTROL BLOCKS AS ARE NECESSARY AND
18193: * CALLS SYSFC,SYSIO TO PERFORM CHECKS ON THE
18194: * ARGUMENTS AND TO OPEN THE FILES.
18195: *
18196: * +-----------+ +---------------+ +-----------+
18197: * +-.I I I I------.I =B$XRT I
18198: * I +-----------+ +---------------+ +-----------+
18199: * I / / (R$FCB) I *4 I
18200: * I / / +-----------+
18201: * I +-----------+ +---------------+ I I-
18202: * I I NAME +--.I =B$TRT I +-----------+
18203: * I / / +---------------+ I I
18204: * I (FIRST ARG) I =TRTIN/=TRTOU I +-----------+
18205: * I +---------------+ I
18206: * I I VALUE I I
18207: * I +---------------+ I
18208: * I I(TRTRF) 0 OR I--+ I
18209: * I +---------------+ I I
18210: * I I(TRFPT) 0 OR I----+ I
18211: * I +---------------+ I I I
18212: * I (I/O TRBLK) I I I
18213: * I +-----------+ I I I
18214: * I I I I I I
18215: * I +-----------+ I I I
18216: * I I I I I I
18217: * I +-----------+ +---------------+ I I I
18218: * I I +--.I =B$TRT I.-+ I I
18219: * I +-----------+ +---------------+ I I
18220: * I / / I =TRTFC I I I
18221: * I / / +---------------+ I I
18222: * I (FILEARG1 I VALUE I I I
18223: * I VRBLK) +---------------+ I I
18224: * I I(TRTRF) 0 OR I--+ I .
18225: * I +---------------+ I . +-----------+
18226: * I I(TRFPT) 0 OR I------./ FCBLK /
18227: * I +---------------+ I +-----------+
18228: * I (TRTRF) I
18229: * I I
18230: * I I
18231: * I +---------------+ I
18232: * I I =B$XRT I.-+
18233: * I +---------------+
18234: * I I *5 I
18235: * I +---------------+
18236: * +------------------I I
18237: * +---------------+ +-----------+
18238: * I(TRTRF) O OR I------.I =B$XRT I
18239: * +---------------+ +-----------+
18240: * I NAME OFFSET I I ETC I
18241: * +---------------+
18242: * (IOCHN - CHAIN OF NAME POINTERS)
18243: {{EJC{{{{
18244: *
18245: * IOPUT (CONTINUED)
18246: *
18247: * NO ADDITIONAL TRAP BLOCKS ARE USED FOR STANDARD INPUT/OUT
18248: * FILES. OTHERWISE AN I/O TRAP BLOCK IS ATTACHED TO SECOND
18249: * ARG (FILEARG1) VRBLK. SEE DIAGRAM ABOVE FOR DETAILS OF
18250: * THE STRUCTURE BUILT.
18251: *
18252: * -(XS) 1ST ARG (VBL TO BE ASSOCIATED)
18253: * -(XS) 2ND ARG (FILE ARG1)
18254: * -(XS) 3RD ARG (FILE ARG2)
18255: * (WB) 0 FOR INPUT, 3 FOR OUTPUT ASSOC.
18256: * JSR IOPUT CALL FOR INPUT/OUTPUT ASSOCIATION
18257: * PPM LOC 3RD ARG NOT A STRING
18258: * PPM LOC 2ND ARG NOT A SUITABLE NAME
18259: * PPM LOC 1ST ARG NOT A SUITABLE NAME
18260: * PPM LOC INAPPROPRIATE FILE SPEC FOR I/O
18261: * PPM LOC I/O FILE DOES NOT EXIST
18262: * PPM LOC I/O FILE CANNOT BE READ/WRITTEN
18263: * (XS) POPPED
18264: * (XL,XR,WA,WB,WC) DESTROYED
18265: *
18266: {IOPUT{PRC{N{6{{ENTRY POINT
18267: {{ZER{R$IOT{{{IN CASE NO TRTRF BLOCK USED
18268: {{ZER{R$IOF{{{IN CASE NO FCBLK ALOCATED
18269: {{MOV{R7{IOPTT{{STORE I/O TRACE TYPE
18270: {{JSR{XSCNI{{{PREPARE TO SCAN FILEARG2
18271: {{PPM{IOP13{{{FAIL
18272: {{PPM{IOPA0{{{NULL FILE ARG2
18273: *
18274: {IOPA0{MOV{R9{R$IO2{{KEEP FILE ARG2
18275: {{MOV{R6{R10{{COPY LENGTH
18276: {{JSR{GTSTG{{{CONVERT FILEARG1 TO STRING
18277: {{PPM{IOP14{{{FAIL
18278: {{MOV{R9{R$IO1{{KEEP FILEARG1 PTR
18279: {{JSR{GTNVR{{{CONVERT TO NATURAL VARIABLE
18280: {{PPM{IOP00{{{JUMP IF NULL
18281: {{BRN{IOP04{{{JUMP TO PROCESS NON-NULL ARGS
18282: *
18283: * NULL FILEARG1
18284: *
18285: {IOP00{BZE{R10{IOP01{{SKIP IF BOTH ARGS NULL
18286: {{JSR{IOPPF{{{PROCESS FILEARG2
18287: {{JSR{SYSFC{{{CALL FOR FILEARG2 CHECK
18288: {{PPM{IOP16{{{FAIL
18289: {{BRN{IOP11{{{COMPLETE FILE ASSOCIATION
18290: {{EJC{{{{
18291: *
18292: * IOPUT (CONTINUED)
18293: *
18294: * HERE WITH 0 OR FCBLK PTR IN (XL)
18295: *
18296: {IOP01{MOV{IOPTT{R7{{GET TRACE TYPE
18297: {{MOV{R$IOT{R9{{GET 0 OR TRTRF PTR
18298: {{JSR{TRBLD{{{BUILD TRBLK
18299: {{MOV{R9{R8{{COPY TRBLK POINTER
18300: {{MOV{(SP)+{R9{{GET VARIABLE FROM STACK
18301: {{JSR{GTVAR{{{POINT TO VARIABLE
18302: {{PPM{IOP15{{{FAIL
18303: {{MOV{R10{R$ION{{SAVE NAME POINTER
18304: {{MOV{R10{R9{{COPY NAME POINTER
18305: {{ADD{R6{R9{{POINT TO VARIABLE
18306: {{SUB{#4*VRVAL{R9{{SUBTRACT OFFSET,MERGE INTO LOOP
18307: *
18308: * LOOP TO END OF TRBLK CHAIN IF ANY
18309: *
18310: {IOP02{MOV{R9{R10{{COPY BLK PTR
18311: {{MOV{4*VRVAL(R9){R9{{LOAD PTR TO NEXT TRBLK
18312: {{BNE{(R9){#B$TRT{IOP03{JUMP IF NOT TRAPPED
18313: {{BNE{4*TRTYP(R9){IOPTT{IOP02{LOOP IF NOT SAME ASSOCN
18314: {{MOV{4*TRNXT(R9){R9{{GET VALUE AND DELETE OLD TRBLK
18315: *
18316: * IOPUT (CONTINUED)
18317: *
18318: * STORE NEW ASSOCIATION
18319: *
18320: {IOP03{MOV{R8{4*VRVAL(R10){{LINK TO THIS TRBLK
18321: {{MOV{R8{R10{{COPY POINTER
18322: {{MOV{R9{4*TRNXT(R10){{STORE VALUE IN TRBLK
18323: {{MOV{R$ION{R9{{RESTORE POSSIBLE VRBLK POINTER
18324: {{MOV{R6{R7{{KEEP OFFSET TO NAME
18325: {{JSR{SETVR{{{IF VRBLK, SET VRGET,VRSTO
18326: {{MOV{R$IOT{R9{{GET 0 OR TRTRF PTR
18327: {{BNZ{R9{IOP19{{JUMP IF TRTRF BLOCK EXISTS
18328: {{EXI{{{{RETURN TO CALLER
18329: *
18330: * NON STANDARD FILE
18331: * SEE IF AN FCBLK HAS ALREADY BEEN ALLOCATED.
18332: *
18333: {IOP04{ZER{R6{{{IN CASE NO FCBLK FOUND
18334: {{EJC{{{{
18335: *
18336: * IOPUT (CONTINUED)
18337: *
18338: * SEARCH POSSIBLE TRBLK CHAIN TO PICK UP THE FCBLK
18339: *
18340: {IOP05{MOV{R9{R7{{REMEMBER BLK PTR
18341: {{MOV{4*VRVAL(R9){R9{{CHAIN ALONG
18342: {{BNE{(R9){#B$TRT{IOP06{JUMP IF END OF TRBLK CHAIN
18343: {{BNE{4*TRTYP(R9){#TRTFC{IOP05{LOOP IF MORE TO GO
18344: {{MOV{R9{R$IOT{{POINT TO FILE ARG1 TRBLK
18345: {{MOV{4*TRFPT(R9){R6{{GET FCBLK PTR FROM TRBLK
18346: *
18347: * WA = 0 OR FCBLK PTR
18348: * WB = PTR TO PRECEDING BLK TO WHICH ANY TRTRF BLOCK
18349: * FOR FILE ARG1 MUST BE CHAINED.
18350: *
18351: {IOP06{MOV{R6{R$IOF{{KEEP POSSIBLE FCBLK PTR
18352: {{MOV{R7{R$IOP{{KEEP PRECEDING BLK PTR
18353: {{JSR{IOPPF{{{PROCESS FILEARG2
18354: {{JSR{SYSFC{{{SEE IF FCBLK REQUIRED
18355: {{PPM{IOP16{{{FAIL
18356: {{BZE{R6{IOP12{{SKIP IF NO NEW FCBLK WANTED
18357: {{BLT{R8{#NUM02{IOP6A{JUMP IF FCBLK IN DYNAMIC
18358: {{JSR{ALOST{{{GET IT IN STATIC
18359: {{BRN{IOP6B{{{SKIP
18360: *
18361: * OBTAIN FCBLK IN DYNAMIC
18362: *
18363: {IOP6A{JSR{ALLOC{{{GET SPACE FOR FCBLK
18364: *
18365: * MERGE
18366: *
18367: {IOP6B{MOV{R9{R10{{POINT TO FCBLK
18368: {{MOV{R6{R7{{COPY ITS LENGTH
18369: {{BTW{R7{{{GET COUNT AS WORDS (SGD APR80)
18370: {{LCT{R7{R7{{LOOP COUNTER
18371: *
18372: * CLEAR FCBLK
18373: *
18374: {IOP07{ZER{(R9)+{{{CLEAR A WORD
18375: {{BCT{R7{IOP07{{LOOP
18376: {{BEQ{R8{#NUM02{IOP09{SKIP IF IN STATIC - DONT SET FIELDS
18377: {{MOV{#B$XNT{(R10){{STORE XNBLK CODE IN CASE
18378: {{MOV{R6{4*1(R10){{STORE LENGTH
18379: {{BNZ{R8{IOP09{{JUMP IF XNBLK WANTED
18380: {{MOV{#B$XRT{(R10){{XRBLK CODE REQUESTED
18381: *
18382: {{EJC{{{{
18383: * IOPUT (CONTINUED)
18384: *
18385: * COMPLETE FCBLK INITIALISATION
18386: *
18387: {IOP09{MOV{R$IOT{R9{{GET POSSIBLE TRBLK PTR
18388: {{MOV{R10{R$IOF{{STORE FCBLK PTR
18389: {{BNZ{R9{IOP10{{JUMP IF TRBLK ALREADY FOUND
18390: *
18391: * A NEW TRBLK IS NEEDED
18392: *
18393: {{MOV{#TRTFC{R7{{TRTYP FOR FCBLK TRAP BLK
18394: {{JSR{TRBLD{{{MAKE THE BLOCK
18395: {{MOV{R9{R$IOT{{COPY TRTRF PTR
18396: {{MOV{R$IOP{R10{{POINT TO PRECEDING BLK
18397: {{MOV{4*VRVAL(R10){4*VRVAL(R9){{COPY VALUE FIELD TO TRBLK
18398: {{MOV{R9{4*VRVAL(R10){{LINK NEW TRBLK INTO CHAIN
18399: {{MOV{R10{R9{{POINT TO PREDECESSOR BLK
18400: {{JSR{SETVR{{{SET TRACE INTERCEPTS
18401: {{MOV{4*VRVAL(R9){R9{{RECOVER TRBLK PTR
18402: *
18403: * XR IS PTR TO TRBLK, XL IS FCBLK PTR OR 0
18404: *
18405: {IOP10{MOV{R$IOF{4*TRFPT(R9){{STORE FCBLK PTR
18406: *
18407: * CALL SYSIO TO COMPLETE FILE ACCESSING
18408: *
18409: {IOP11{MOV{R$IOF{R6{{COPY FCBLK PTR OR 0
18410: {{MOV{IOPTT{R7{{GET INPUT/OUTPUT FLAG
18411: {{MOV{R$IO2{R9{{GET FILE ARG2
18412: {{MOV{R$IO1{R10{{GET FILE ARG1
18413: {{JSR{SYSIO{{{ASSOCIATE TO THE FILE
18414: {{PPM{IOP17{{{FAIL
18415: {{PPM{IOP18{{{FAIL
18416: {{BNZ{R$IOT{IOP01{{NOT STD INPUT IF NON-NULL TRTRF BLK
18417: {{BNZ{IOPTT{IOP01{{JUMP IF OUTPUT
18418: {{BZE{R8{IOP01{{NO CHANGE TO STANDARD READ LENGTH
18419: {{MOV{R8{CSWIN{{STORE NEW READ LENGTH FOR STD FILE
18420: {{BRN{IOP01{{{MERGE TO FINISH THE TASK
18421: *
18422: * SYSFC MAY HAVE RETURNED A POINTER TO A PRIVATE FCBLK
18423: *
18424: {IOP12{BNZ{R10{IOP09{{JUMP IF PRIVATE FCBLK
18425: {{BRN{IOP11{{{FINISH THE ASSOCIATION
18426: *
18427: * FAILURE RETURNS
18428: *
18429: {IOP13{EXI{1{{{3RD ARG NOT A STRING
18430: {IOP14{EXI{2{{{2ND ARG UNSUITABLE
18431: {IOP15{EXI{3{{{1ST ARG UNSUITABLE
18432: {IOP16{EXI{4{{{FILE SPEC WRONG
18433: {IOP17{EXI{5{{{I/O FILE DOES NOT EXIST
18434: {IOP18{EXI{6{{{I/O FILE CANNOT BE READ/WRITTEN
18435: {{EJC{{{{
18436: *
18437: * IOPUT (CONTINUED)
18438: *
18439: * ADD TO IOCHN CHAIN OF ASSSOCIATED VARIABLES UNLESS ALREAD
18440: * PRESENT.
18441: *
18442: {IOP19{MOV{R$ION{R8{{WC = NAME BASE, WB = NAME OFFSET
18443: *
18444: * SEARCH LOOP
18445: *
18446: {IOP20{MOV{4*TRTRF(R9){R9{{NEXT LINK OF CHAIN
18447: {{BZE{R9{IOP21{{NOT FOUND
18448: {{BNE{R8{4*IONMB(R9){IOP20{NO MATCH
18449: {{BEQ{R7{4*IONMO(R9){IOP22{EXIT IF MATCHED
18450: {{BRN{IOP20{{{LOOP
18451: *
18452: * NOT FOUND
18453: *
18454: {IOP21{MOV{#4*NUM05{R6{{SPACE NEEDED
18455: {{JSR{ALLOC{{{GET IT
18456: {{MOV{#B$XRT{(R9){{STORE XRBLK CODE
18457: {{MOV{R6{4*1(R9){{STORE LENGTH
18458: {{MOV{R8{4*IONMB(R9){{STORE NAME BASE
18459: {{MOV{R7{4*IONMO(R9){{STORE NAME OFFSET
18460: {{MOV{R$IOT{R10{{POINT TO TRTRF BLK
18461: {{MOV{4*TRTRF(R10){R6{{GET PTR FIELD CONTENTS
18462: {{MOV{R9{4*TRTRF(R10){{STORE PTR TO NEW BLOCK
18463: {{MOV{R6{4*TRTRF(R9){{COMPLETE THE LINKING
18464: *
18465: * INSERT FCBLK ON FCBLK CHAIN FOR SYSEJ, SYSXI
18466: *
18467: {IOP22{BZE{R$IOF{IOP25{{SKIP IF NO FCBLK
18468: {{MOV{R$FCB{R10{{PTR TO HEAD OF EXISTING CHAIN
18469: *
18470: * SEE IF FCBLK ALREADY ON CHAIN
18471: *
18472: {IOP23{BZE{R10{IOP24{{NOT ON IF END OF CHAIN
18473: {{BEQ{4*3(R10){R$IOF{IOP25{DONT DUPLICATE IF FIND IT
18474: {{MOV{4*2(R10){R10{{GET NEXT LINK
18475: {{BRN{IOP23{{{LOOP
18476: *
18477: * NOT FOUND SO ADD AN ENTRY FOR THIS FCBLK
18478: *
18479: {IOP24{MOV{#4*NUM04{R6{{SPACE NEEDED
18480: {{JSR{ALLOC{{{GET IT
18481: {{MOV{#B$XRT{(R9){{STORE BLOCK CODE
18482: {{MOV{R6{4*1(R9){{STORE LENGTH
18483: {{MOV{R$FCB{4*2(R9){{STORE PREVIOUS LINK IN THIS NODE
18484: {{MOV{R$IOF{4*3(R9){{STORE FCBLK PTR
18485: {{MOV{R9{R$FCB{{INSERT NODE INTO FCBLK CHAIN
18486: *
18487: * RETURN
18488: *
18489: {IOP25{EXI{{{{RETURN TO CALLER
18490: {{ENP{{{{END PROCEDURE IOPUT
18491: {{EJC{{{{
18492: *
18493: * KTREX -- EXECUTE KEYWORD TRACE
18494: *
18495: * KTREX IS USED TO EXECUTE A POSSIBLE KEYWORD TRACE. IT
18496: * INCLUDES THE TEST ON TRACE AND TESTS FOR TRACE ACTIVE.
18497: *
18498: * (XL) PTR TO TRBLK (OR 0 IF UNTRACED)
18499: * JSR KTREX CALL TO EXECUTE KEYWORD TRACE
18500: * (XL,WA,WB,WC) DESTROYED
18501: * (RA) DESTROYED
18502: *
18503: {KTREX{PRC{R{0{{ENTRY POINT (RECURSIVE)
18504: {{BZE{R10{KTRX3{{IMMEDIATE EXIT IF KEYWORD UNTRACED
18505: {{BZE{KVTRA{KTRX3{{IMMEDIATE EXIT IF TRACE = 0
18506: {{DCV{KVTRA{{{ELSE DECREMENT TRACE
18507: {{MOV{R9{-(SP){{SAVE XR
18508: {{MOV{R10{R9{{COPY TRBLK POINTER
18509: {{MOV{4*TRKVR(R9){R10{{LOAD VRBLK POINTER (NMBAS)
18510: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET
18511: {{BZE{4*TRFNC(R9){KTRX1{{JUMP IF PRINT TRACE
18512: {{JSR{TRXEQ{{{ELSE EXECUTE FULL TRACE
18513: {{BRN{KTRX2{{{AND JUMP TO EXIT
18514: *
18515: * HERE FOR PRINT TRACE
18516: *
18517: {KTRX1{MOV{R10{-(SP){{STACK VRBLK PTR FOR KWNAM
18518: {{MOV{R6{-(SP){{STACK OFFSET FOR KWNAM
18519: {{JSR{PRTSN{{{PRINT STATEMENT NUMBER
18520: {{MOV{#CH$AM{R6{{LOAD AMPERSAND
18521: {{JSR{PRTCH{{{PRINT AMPERSAND
18522: {{JSR{PRTNM{{{PRINT KEYWORD NAME
18523: {{MOV{#TMBEB{R9{{POINT TO BLANK-EQUAL-BLANK
18524: {{JSR{PRTST{{{PRINT BLANK-EQUAL-BLANK
18525: {{JSR{KWNAM{{{GET KEYWORD PSEUDO-VARIABLE NAME
18526: {{MOV{R9{DNAMP{{RESET PTR TO DELETE KVBLK
18527: {{JSR{ACESS{{{GET KEYWORD VALUE
18528: {{PPM{{{{FAILURE IS IMPOSSIBLE
18529: {{JSR{PRTVL{{{PRINT KEYWORD VALUE
18530: {{JSR{PRTNL{{{TERMINATE PRINT LINE
18531: *
18532: * HERE TO EXIT AFTER COMPLETING TRACE
18533: *
18534: {KTRX2{MOV{(SP)+{R9{{RESTORE ENTRY XR
18535: *
18536: * MERGE HERE TO EXIT IF NO TRACE REQUIRED
18537: *
18538: {KTRX3{EXI{{{{RETURN TO KTREX CALLER
18539: {{ENP{{{{END PROCEDURE KTREX
18540: {{EJC{{{{
18541: *
18542: * KWNAM -- GET PSEUDO-VARIABLE NAME FOR KEYWORD
18543: *
18544: * 1(XS) NAME BASE FOR VRBLK
18545: * 0(XS) OFFSET (SHOULD BE *VRVAL)
18546: * JSR KWNAM CALL TO GET PSEUDO-VARIABLE NAME
18547: * (XS) POPPED TWICE
18548: * (XL,WA) RESULTING PSEUDO-VARIABLE NAME
18549: * (XR,WA,WB) DESTROYED
18550: *
18551: {KWNAM{PRC{N{0{{ENTRY POINT
18552: {{ICA{SP{{{IGNORE NAME OFFSET
18553: {{MOV{(SP)+{R9{{LOAD NAME BASE
18554: {{BGE{R9{STATE{KWNM1{JUMP IF NOT NATURAL VARIABLE NAME
18555: {{BNZ{4*VRLEN(R9){KWNM1{{ERROR IF NOT SYSTEM VARIABLE
18556: {{MOV{4*VRSVP(R9){R9{{ELSE POINT TO SVBLK
18557: {{MOV{4*SVBIT(R9){R6{{LOAD BIT MASK
18558: {{ANB{BTKNM{R6{{AND WITH KEYWORD BIT
18559: {{ZRB{R6{KWNM1{{ERROR IF NO KEYWORD ASSOCIATION
18560: {{MOV{4*SVLEN(R9){R6{{ELSE LOAD NAME LENGTH IN CHARACTERS
18561: {{CTB{R6{SVCHS{{COMPUTE OFFSET TO FIELD WE WANT
18562: {{ADD{R6{R9{{POINT TO SVKNM FIELD
18563: {{MOV{(R9){R7{{LOAD SVKNM VALUE
18564: {{MOV{#4*KVSI${R6{{SET SIZE OF KVBLK
18565: {{JSR{ALLOC{{{ALLOCATE KVBLK
18566: {{MOV{#B$KVT{(R9){{STORE TYPE WORD
18567: {{MOV{R7{4*KVNUM(R9){{STORE KEYWORD NUMBER
18568: {{MOV{#TRBKV{4*KVVAR(R9){{SET DUMMY TRBLK POINTER
18569: {{MOV{R9{R10{{COPY KVBLK POINTER
18570: {{MOV{#4*KVVAR{R6{{SET PROPER OFFSET
18571: {{EXI{{{{RETURN TO KVNAM CALLER
18572: *
18573: * HERE IF NOT KEYWORD NAME
18574: *
18575: {KWNM1{ERB{251{KEYWORD{{OPERAND IS NOT NAME OF DEFINED KEYWORD
18576: {{ENP{{{{END PROCEDURE KWNAM
18577: {{EJC{{{{
18578: *
18579: * LCOMP-- COMPARE TWO STRINGS LEXICALLY
18580: *
18581: * 1(XS) FIRST ARGUMENT
18582: * 0(XS) SECOND ARGUMENT
18583: * JSR LCOMP CALL TO COMPARE ARUMENTS
18584: * PPM LOC TRANSFER LOC FOR ARG1 NOT STRING
18585: * PPM LOC TRANSFER LOC FOR ARG2 NOT STRING
18586: * PPM LOC TRANSFER LOC IF ARG1 LLT ARG2
18587: * PPM LOC TRANSFER LOC IF ARG1 LEQ ARG2
18588: * PPM LOC TRANSFER LOC IF ARG1 LGT ARG2
18589: * (THE NORMAL RETURN IS NEVER TAKEN)
18590: * (XS) POPPED TWICE
18591: * (XR,XL) DESTROYED
18592: * (WA,WB,WC,RA) DESTROYED
18593: *
18594: {LCOMP{PRC{N{5{{ENTRY POINT
18595: {{JSR{GTSTG{{{CONVERT SECOND ARG TO STRING
18596: {{PPM{LCMP6{{{JUMP IF SECOND ARG NOT STRING
18597: {{MOV{R9{R10{{ELSE SAVE POINTER
18598: {{MOV{R6{R7{{AND LENGTH
18599: {{JSR{GTSTG{{{CONVERT FIRST ARGUMENT TO STRING
18600: {{PPM{LCMP5{{{JUMP IF NOT STRING
18601: {{MOV{R6{R8{{SAVE ARG 1 LENGTH
18602: {{PLC{R9{{{POINT TO CHARS OF ARG 1
18603: {{PLC{R10{{{POINT TO CHARS OF ARG 2
18604: {{BLO{R6{R7{LCMP1{JUMP IF ARG 1 LENGTH IS SMALLER
18605: {{MOV{R7{R6{{ELSE SET ARG 2 LENGTH AS SMALLER
18606: *
18607: * HERE WITH SMALLER LENGTH IN (WA)
18608: *
18609: {LCMP1{CMC{LCMP4{LCMP3{{COMPARE STRINGS, JUMP IF UNEQUAL
18610: {{BNE{R7{R8{LCMP2{IF EQUAL, JUMP IF LENGTHS UNEQUAL
18611: {{EXI{4{{{ELSE IDENTICAL STRINGS, LEQ EXIT
18612: {{EJC{{{{
18613: *
18614: * LCOMP (CONTINUED)
18615: *
18616: * HERE IF INITIAL STRINGS IDENTICAL, BUT LENGTHS UNEQUAL
18617: *
18618: {LCMP2{BHI{R8{R7{LCMP4{JUMP IF ARG 1 LENGTH GT ARG 2 LENG
18619: *
18620: * HERE IF FIRST ARG LLT SECOND ARG
18621: *
18622: {LCMP3{EXI{3{{{TAKE LLT EXIT
18623: *
18624: * HERE IF FIRST ARG LGT SECOND ARG
18625: *
18626: {LCMP4{EXI{5{{{TAKE LGT EXIT
18627: *
18628: * HERE IF FIRST ARG IS NOT A STRING
18629: *
18630: {LCMP5{EXI{1{{{TAKE BAD FIRST ARG EXIT
18631: *
18632: * HERE FOR SECOND ARG NOT A STRING
18633: *
18634: {LCMP6{EXI{2{{{TAKE BAD SECOND ARG ERROR EXIT
18635: {{ENP{{{{END PROCEDURE LCOMP
18636: {{EJC{{{{
18637: *
18638: * LISTR -- LIST SOURCE LINE
18639: *
18640: * LISTR IS USED TO LIST A SOURCE LINE DURING THE INITIAL
18641: * COMPILATION. IT IS CALLED FROM SCANE AND SCANL.
18642: *
18643: * JSR LISTR CALL TO LIST LINE
18644: * (XR,XL,WA,WB,WC) DESTROYED
18645: *
18646: * GLOBAL LOCATIONS USED BY LISTR
18647: *
18648: * ERLST IF LISTING ON ACCOUNT OF AN ERROR
18649: *
18650: * LSTLC COUNT LINES ON CURRENT PAGE
18651: *
18652: * LSTNP MAX NUMBER OF LINES/PAGE
18653: *
18654: * LSTPF SET NON-ZERO IF THE CURRENT SOURCE
18655: * LINE HAS BEEN LISTED, ELSE ZERO.
18656: *
18657: * LSTPG COMPILER LISTING PAGE NUMBER
18658: *
18659: * LSTSN SET IF STMNT NUM TO BE LISTED
18660: *
18661: * R$CIM POINTER TO CURRENT INPUT LINE.
18662: *
18663: * R$TTL TITLE FOR SOURCE LISTING
18664: *
18665: * R$STL PTR TO SUB-TITLE STRING
18666: *
18667: * ENTRY POINT
18668: *
18669: {LISTR{PRC{E{0{{ENTRY POINT
18670: {{BNZ{CNTTL{LIST5{{JUMP IF -TITLE OR -STITL
18671: {{BNZ{LSTPF{LIST4{{IMMEDIATE EXIT IF ALREADY LISTED
18672: {{BGE{LSTLC{LSTNP{LIST6{JUMP IF NO ROOM
18673: *
18674: * HERE AFTER PRINTING TITLE (IF NEEDED)
18675: *
18676: {LIST0{MOV{R$CIM{R9{{LOAD POINTER TO CURRENT IMAGE
18677: {{PLC{R9{{{POINT TO CHARACTERS
18678: {{LCH{R6{(R9){{LOAD FIRST CHARACTER
18679: {{MOV{LSTSN{R9{{LOAD STATEMENT NUMBER
18680: {{BZE{R9{LIST2{{JUMP IF NO STATEMENT NUMBER
18681: {{MTI{R9{{{ELSE GET STMNT NUMBER AS INTEGER
18682: {{BNE{STAGE{#STGIC{LIST1{SKIP IF EXECUTE TIME
18683: {{BEQ{R6{#CH$AS{LIST2{NO STMNT NUMBER LIST IF COMMENT
18684: {{BEQ{R6{#CH$MN{LIST2{NO STMNT NO. IF CONTROL CARD
18685: *
18686: * PRINT STATEMENT NUMBER
18687: *
18688: {LIST1{JSR{PRTIN{{{ELSE PRINT STATEMENT NUMBER
18689: {{ZER{LSTSN{{{AND CLEAR FOR NEXT TIME IN
18690: {{EJC{{{{
18691: *
18692: * LISTR (CONTINUED)
18693: *
18694: * MERGE HERE AFTER PRINTING STATEMENT NUMBER (IF REQUIRED)
18695: *
18696: {LIST2{MOV{#STNPD{PROFS{{POINT PAST STATEMENT NUMBER
18697: {{MOV{R$CIM{R9{{LOAD POINTER TO CURRENT IMAGE
18698: {{JSR{PRTST{{{PRINT IT
18699: {{ICV{LSTLC{{{BUMP LINE COUNTER
18700: {{BNZ{ERLST{LIST3{{JUMP IF ERROR COPY TO INT.CH.
18701: {{JSR{PRTNL{{{TERMINATE LINE
18702: {{BZE{CSWDB{LIST3{{JUMP IF -SINGLE MODE
18703: {{JSR{PRTNL{{{ELSE ADD A BLANK LINE
18704: {{ICV{LSTLC{{{AND BUMP LINE COUNTER
18705: *
18706: * HERE AFTER PRINTING SOURCE IMAGE
18707: *
18708: {LIST3{MNZ{LSTPF{{{SET FLAG FOR LINE PRINTED
18709: *
18710: * MERGE HERE TO EXIT
18711: *
18712: {LIST4{EXI{{{{RETURN TO LISTR CALLER
18713: *
18714: * PRINT TITLE AFTER -TITLE OR -STITL CARD
18715: *
18716: {LIST5{ZER{CNTTL{{{CLEAR FLAG
18717: *
18718: * EJECT TO NEW PAGE AND LIST TITLE
18719: *
18720: {LIST6{JSR{PRTPS{{{EJECT
18721: {{BZE{PRICH{LIST7{{SKIP IF LISTING TO REGULAR PRINTER
18722: {{BEQ{R$TTL{#NULLS{LIST0{TERMINAL LISTING OMITS NULL TITLE
18723: *
18724: * LIST TITLE
18725: *
18726: {LIST7{JSR{LISTT{{{LIST TITLE
18727: {{BRN{LIST0{{{MERGE
18728: {{ENP{{{{END PROCEDURE LISTR
18729: {{EJC{{{{
18730: *
18731: * LISTT -- LIST TITLE AND SUBTITLE
18732: *
18733: * USED DURING COMPILATION TO PRINT PAGE HEADING
18734: *
18735: * JSR LISTT CALL TO LIST TITLE
18736: * (XR,WA) DESTROYED
18737: *
18738: {LISTT{PRC{E{0{{ENTRY POINT
18739: {{MOV{R$TTL{R9{{POINT TO SOURCE LISTING TITLE
18740: {{JSR{PRTST{{{PRINT TITLE
18741: {{MOV{LSTPO{PROFS{{SET OFFSET
18742: {{MOV{#LSTMS{R9{{SET PAGE MESSAGE
18743: {{JSR{PRTST{{{PRINT PAGE MESSAGE
18744: {{ICV{LSTPG{{{BUMP PAGE NUMBER
18745: {{MTI{LSTPG{{{LOAD PAGE NUMBER AS INTEGER
18746: {{JSR{PRTIN{{{PRINT PAGE NUMBER
18747: {{JSR{PRTNL{{{TERMINATE TITLE LINE
18748: {{ADD{#NUM02{LSTLC{{COUNT TITLE LINE AND BLANK LINE
18749: *
18750: * PRINT SUB-TITLE (IF ANY)
18751: *
18752: {{MOV{R$STL{R9{{LOAD POINTER TO SUB-TITLE
18753: {{BZE{R9{LSTT1{{JUMP IF NO SUB-TITLE
18754: {{JSR{PRTST{{{ELSE PRINT SUB-TITLE
18755: {{JSR{PRTNL{{{TERMINATE LINE
18756: {{ICV{LSTLC{{{BUMP LINE COUNT
18757: *
18758: * RETURN POINT
18759: *
18760: {LSTT1{JSR{PRTNL{{{PRINT A BLANK LINE
18761: {{EXI{{{{RETURN TO CALLER
18762: {{ENP{{{{END PROCEDURE LISTT
18763: {{EJC{{{{
18764: *
18765: * NEXTS -- ACQUIRE NEXT SOURCE IMAGE
18766: *
18767: * NEXTS IS USED TO ACQUIRE THE NEXT SOURCE IMAGE AT COMPILE
18768: * TIME. IT ASSUMES THAT A PRIOR CALL TO READR HAS INPUT
18769: * A LINE IMAGE (SEE PROCEDURE READR). BEFORE THE CURRENT
18770: * IMAGE IS FINALLY LOST IT MAY BE LISTED HERE.
18771: *
18772: * JSR NEXTS CALL TO ACQUIRE NEXT INPUT LINE
18773: * (XR,XL,WA,WB,WC) DESTROYED
18774: *
18775: * GLOBAL VALUES AFFECTED
18776: *
18777: * R$CNI ON INPUT, NEXT IMAGE. ON
18778: * EXIT RESET TO ZERO
18779: *
18780: * R$CIM ON EXIT, SET TO POINT TO IMAGE
18781: *
18782: * SCNIL INPUT IMAGE LENGTH ON EXIT
18783: *
18784: * SCNSE RESET TO ZERO ON EXIT
18785: *
18786: * LSTPF SET ON EXIT IF LINE IS LISTED
18787: *
18788: {NEXTS{PRC{E{0{{ENTRY POINT
18789: {{BZE{CSWLS{NXTS2{{JUMP IF -NOLIST
18790: {{MOV{R$CIM{R9{{POINT TO IMAGE
18791: {{BZE{R9{NXTS2{{JUMP IF NO IMAGE
18792: {{PLC{R9{{{GET CHAR PTR
18793: {{LCH{R6{(R9){{GET FIRST CHAR
18794: {{BNE{R6{#CH$MN{NXTS1{JUMP IF NOT CTRL CARD
18795: {{BZE{CSWPR{NXTS2{{JUMP IF -NOPRINT
18796: *
18797: * HERE TO CALL LISTER
18798: *
18799: {NXTS1{JSR{LISTR{{{LIST LINE
18800: *
18801: * HERE AFTER POSSIBLE LISTING
18802: *
18803: {NXTS2{MOV{R$CNI{R9{{POINT TO NEXT IMAGE
18804: {{MOV{R9{R$CIM{{SET AS NEXT IMAGE
18805: {{ZER{R$CNI{{{CLEAR NEXT IMAGE POINTER
18806: {{MOV{4*SCLEN(R9){R6{{GET INPUT IMAGE LENGTH
18807: {{MOV{CSWIN{R7{{GET MAX ALLOWABLE LENGTH
18808: {{BLO{R6{R7{NXTS3{SKIP IF NOT TOO LONG
18809: {{MOV{R7{R6{{ELSE TRUNCATE
18810: *
18811: * HERE WITH LENGTH IN (WA)
18812: *
18813: {NXTS3{MOV{R6{SCNIL{{USE AS RECORD LENGTH
18814: {{ZER{SCNSE{{{RESET SCNSE
18815: {{ZER{LSTPF{{{SET LINE NOT LISTED YET
18816: {{EXI{{{{RETURN TO NEXTS CALLER
18817: {{ENP{{{{END PROCEDURE NEXTS
18818: {{EJC{{{{
18819: *
18820: * PATIN -- PATTERN CONSTRUCTION FOR LEN,POS,RPOS,TAB,RTAB
18821: *
18822: * THESE PATTERN TYPES ALL GENERATE A SIMILAR NODE TYPE. SO
18823: * THE CONSTRUCTION CODE IS SHARED. SEE FUNCTIONS SECTION
18824: * FOR ACTUAL ENTRY POINTS FOR THESE FIVE FUNCTIONS.
18825: *
18826: * (WA) PCODE FOR EXPRESSION ARG CASE
18827: * (WB) PCODE FOR INTEGER ARG CASE
18828: * JSR PATIN CALL TO BUILD PATTERN NODE
18829: * PPM LOC TRANSFER LOC FOR NOT INTEGER OR EXP
18830: * PPM LOC TRANSFER LOC FOR INT OUT OF RANGE
18831: * (XR) POINTER TO CONSTRUCTED NODE
18832: * (XL,WA,WB,WC,IA) DESTROYED
18833: *
18834: {PATIN{PRC{N{2{{ENTRY POINT
18835: {{MOV{R6{R10{{PRESERVE EXPRESSION ARG PCODE
18836: {{JSR{GTSMI{{{TRY TO CONVERT ARG AS SMALL INTEGER
18837: {{PPM{PTIN2{{{JUMP IF NOT INTEGER
18838: {{PPM{PTIN3{{{JUMP IF OUT OF RANGE
18839: *
18840: * COMMON SUCCESSFUL EXIT POINT
18841: *
18842: {PTIN1{JSR{PBILD{{{BUILD PATTERN NODE
18843: {{EXI{{{{RETURN TO CALLER
18844: *
18845: * HERE IF ARGUMENT IS NOT AN INTEGER
18846: *
18847: {PTIN2{MOV{R10{R7{{COPY EXPR ARG CASE PCODE
18848: {{BLO{(R9){#B$E$${PTIN1{ALL OK IF EXPRESSION ARG
18849: {{EXI{1{{{ELSE TAKE ERROR EXIT FOR WRONG TYPE
18850: *
18851: * HERE FOR ERROR OF OUT OF RANGE INTEGER ARGUMENT
18852: *
18853: {PTIN3{EXI{2{{{TAKE OUT-OF-RANGE ERROR EXIT
18854: {{ENP{{{{END PROCEDURE PATIN
18855: {{EJC{{{{
18856: *
18857: * PATST -- PATTERN CONSTRUCTION FOR ANY,NOTANY,
18858: * BREAK,SPAN AND BREAKX PATTERN FUNCTIONS.
18859: *
18860: * THESE PATTERN FUNCTIONS BUILD SIMILAR TYPES OF NODES AND
18861: * THE CONSTRUCTION CODE IS SHARED. SEE FUNCTIONS SECTION
18862: * FOR ACTUAL ENTRY POINTS FOR THESE FIVE PATTERN FUNCTIONS.
18863: *
18864: * 0(XS) STRING ARGUMENT
18865: * (WB) PCODE FOR ONE CHAR ARGUMENT
18866: * (XL) PCODE FOR MULTI-CHAR ARGUMENT
18867: * (WC) PCODE FOR EXPRESSION ARGUMENT
18868: * JSR PATST CALL TO BUILD NODE
18869: * PPM LOC TRANSFER LOC IF NOT STRING OR EXPR
18870: * (XS) POPPED PAST STRING ARGUMENT
18871: * (XR) POINTER TO CONSTRUCTED NODE
18872: * (XL) DESTROYED
18873: * (WA,WB,WC,RA) DESTROYED
18874: *
18875: * NOTE THAT THERE IS A SPECIAL CALL TO PATST IN THE EVALS
18876: * PROCEDURE WITH A SLIGHTLY DIFFERENT FORM. SEE EVALS
18877: * FOR DETAILS OF THE FORM OF THIS CALL.
18878: *
18879: {PATST{PRC{N{1{{ENTRY POINT
18880: {{JSR{GTSTG{{{CONVERT ARGUMENT AS STRING
18881: {{PPM{PATS7{{{JUMP IF NOT STRING
18882: {{BNE{R6{#NUM01{PATS2{JUMP IF NOT ONE CHAR STRING
18883: *
18884: * HERE FOR ONE CHAR STRING CASE
18885: *
18886: {{BZE{R7{PATS2{{TREAT AS MULTI-CHAR IF EVALS CALL
18887: {{PLC{R9{{{POINT TO CHARACTER
18888: {{LCH{R9{(R9){{LOAD CHARACTER
18889: *
18890: * COMMON EXIT POINT AFTER SUCCESSFUL CONSTRUCTION
18891: *
18892: {PATS1{JSR{PBILD{{{CALL ROUTINE TO BUILD NODE
18893: {{EXI{{{{RETURN TO PATST CALLER
18894: {{EJC{{{{
18895: *
18896: * PATST (CONTINUED)
18897: *
18898: * HERE FOR MULTI-CHARACTER STRING CASE
18899: *
18900: {PATS2{MOV{R10{-(SP){{SAVE MULTI-CHAR PCODE
18901: {{MOV{R9{-(SP){{SAVE STRING POINTER
18902: {{MOV{CTMSK{R8{{LOAD CURRENT MASK BIT
18903: {{LSH{R8{1{{SHIFT TO NEXT POSITION
18904: {{NZB{R8{PATS4{{SKIP IF POSITION LEFT IN THIS TBL
18905: *
18906: * HERE WE MUST ALLOCATE A NEW CHARACTER TABLE
18907: *
18908: {{MOV{#4*CTSI${R6{{SET SIZE OF CTBLK
18909: {{JSR{ALLOC{{{ALLOCATE CTBLK
18910: {{MOV{R9{R$CTP{{STORE PTR TO NEW CTBLK
18911: {{MOV{#B$CTT{(R9)+{{STORE TYPE CODE, BUMP PTR
18912: {{LCT{R7{#CFP$A{{SET NUMBER OF WORDS TO CLEAR
18913: {{MOV{BITS0{R8{{LOAD ALL ZERO BITS
18914: *
18915: * LOOP TO CLEAR ALL BITS IN TABLE TO ZEROS
18916: *
18917: {PATS3{MOV{R8{(R9)+{{MOVE WORD OF ZERO BITS
18918: {{BCT{R7{PATS3{{LOOP TILL ALL CLEARED
18919: {{MOV{BITS1{R8{{SET INITIAL BIT POSITION
18920: *
18921: * MERGE HERE WITH BIT POSITION AVAILABLE
18922: *
18923: {PATS4{MOV{R8{CTMSK{{SAVE PARM2 (NEW BIT POSITION)
18924: {{MOV{(SP)+{R10{{RESTORE POINTER TO ARGUMENT STRING
18925: {{MOV{4*SCLEN(R10){R7{{LOAD STRING LENGTH
18926: {{BZE{R7{PATS6{{JUMP IF NULL STRING CASE
18927: {{LCT{R7{R7{{ELSE SET LOOP COUNTER
18928: {{PLC{R10{{{POINT TO CHARACTERS IN ARGUMENT
18929: {{EJC{{{{
18930: *
18931: * PATST (CONTINUED)
18932: *
18933: * LOOP TO SET BITS IN COLUMN OF TABLE
18934: *
18935: {PATS5{LCH{R6{(R10)+{{LOAD NEXT CHARACTER
18936: {{WTB{R6{{{CONVERT TO BYTE OFFSET
18937: {{MOV{R$CTP{R9{{POINT TO CTBLK
18938: {{ADD{R6{R9{{POINT TO CTBLK ENTRY
18939: {{MOV{R8{R6{{COPY BIT MASK
18940: {{ORB{4*CTCHS(R9){R6{{OR IN BITS ALREADY SET
18941: {{MOV{R6{4*CTCHS(R9){{STORE RESULTING BIT STRING
18942: {{BCT{R7{PATS5{{LOOP TILL ALL BITS SET
18943: *
18944: * COMPLETE PROCESSING FOR MUTI-CHAR STRING CASE
18945: *
18946: {PATS6{MOV{R$CTP{R9{{LOAD CTBLK PTR AS PARM1 FOR PBILD
18947: {{ZER{R10{{{CLEAR GARBAGE PTR IN XL
18948: {{MOV{(SP)+{R7{{LOAD PCODE FOR MULTI-CHAR STR CASE
18949: {{BRN{PATS1{{{BACK TO EXIT (WC=BITSTRING=PARM2)
18950: *
18951: * HERE IF ARGUMENT IS NOT A STRING
18952: *
18953: * NOTE THAT THE CALL FROM EVALS CANNOT PASS AN EXPRESSION
18954: * SINCE EVALP ALWAYS REEVALUATES EXPRESSIONS.
18955: *
18956: {PATS7{MOV{R8{R7{{SET PCODE FOR EXPRESSION ARGUMENT
18957: {{BLO{(R9){#B$E$${PATS1{JUMP TO EXIT IF EXPRESSION ARG
18958: {{EXI{1{{{ELSE TAKE WRONG TYPE ERROR EXIT
18959: {{ENP{{{{END PROCEDURE PATST
18960: {{EJC{{{{
18961: *
18962: * PBILD -- BUILD PATTERN NODE
18963: *
18964: * (XR) PARM1 (ONLY IF REQUIRED)
18965: * (WB) PCODE FOR NODE
18966: * (WC) PARM2 (ONLY IF REQUIRED)
18967: * JSR PBILD CALL TO BUILD NODE
18968: * (XR) POINTER TO CONSTRUCTED NODE
18969: * (WA) DESTROYED
18970: *
18971: {PBILD{PRC{E{0{{ENTRY POINT
18972: {{MOV{R9{-(SP){{STACK POSSIBLE PARM1
18973: {{MOV{R7{R9{{COPY PCODE
18974: {{LEI{R9{{{LOAD ENTRY POINT ID (BL$PX)
18975: {{BEQ{R9{#BL$P1{PBLD1{JUMP IF ONE PARAMETER
18976: {{BEQ{R9{#BL$P0{PBLD3{JUMP IF NO PARAMETERS
18977: *
18978: * HERE FOR TWO PARAMETER CASE
18979: *
18980: {{MOV{#4*PCSI${R6{{SET SIZE OF P2BLK
18981: {{JSR{ALLOC{{{ALLOCATE BLOCK
18982: {{MOV{R8{4*PARM2(R9){{STORE SECOND PARAMETER
18983: {{BRN{PBLD2{{{MERGE WITH ONE PARM CASE
18984: *
18985: * HERE FOR ONE PARAMETER CASE
18986: *
18987: {PBLD1{MOV{#4*PBSI${R6{{SET SIZE OF P1BLK
18988: {{JSR{ALLOC{{{ALLOCATE NODE
18989: *
18990: * MERGE HERE FROM TWO PARM CASE
18991: *
18992: {PBLD2{MOV{(SP){4*PARM1(R9){{STORE FIRST PARAMETER
18993: {{BRN{PBLD4{{{MERGE WITH NO PARAMETER CASE
18994: *
18995: * HERE FOR CASE OF NO PARAMETERS
18996: *
18997: {PBLD3{MOV{#4*PASI${R6{{SET SIZE OF P0BLK
18998: {{JSR{ALLOC{{{ALLOCATE NODE
18999: *
19000: * MERGE HERE FROM OTHER CASES
19001: *
19002: {PBLD4{MOV{R7{(R9){{STORE PCODE
19003: {{ICA{SP{{{POP FIRST PARAMETER
19004: {{MOV{#NDNTH{4*PTHEN(R9){{SET NOTHEN SUCCESSOR POINTER
19005: {{EXI{{{{RETURN TO PBILD CALLER
19006: {{ENP{{{{END PROCEDURE PBILD
19007: {{EJC{{{{
19008: *
19009: * PCONC -- CONCATENATE TWO PATTERNS
19010: *
19011: * (XL) PTR TO RIGHT PATTERN
19012: * (XR) PTR TO LEFT PATTERN
19013: * JSR PCONC CALL TO CONCATENATE PATTERNS
19014: * (XR) PTR TO CONCATENATED PATTERN
19015: * (XL,WA,WB,WC) DESTROYED
19016: *
19017: *
19018: * TO CONCATENATE TWO PATTERNS, ALL SUCCESSORS IN THE LEFT
19019: * PATTERN WHICH POINT TO THE NOTHEN NODE MUST BE CHANGED TO
19020: * POINT TO THE RIGHT PATTERN. HOWEVER, THIS MODIFICATION
19021: * MUST BE PERFORMED ON A COPY OF THE LEFT ARGUMENT RATHER
19022: * THAN THE LEFT ARGUMENT ITSELF, SINCE THE LEFT ARGUMENT
19023: * MAY BE POINTED TO BY SOME OTHER VARIABLE VALUE.
19024: *
19025: * ACCORDINGLY, IT IS NECESSARY TO COPY THE LEFT ARGUMENT.
19026: * THIS IS NOT A TRIVIAL PROCESS SINCE WE MUST AVOID COPYING
19027: * NODES MORE THAN ONCE AND THE PATTERN IS A GRAPH STRUCTURE
19028: * THE FOLLOWING ALGORITHM IS EMPLOYED.
19029: *
19030: * THE STACK IS USED TO STORE A LIST OF NODES WHICH
19031: * HAVE ALREADY BEEN COPIED. THE FORMAT OF THE ENTRIES ON
19032: * THIS LIST CONSISTS OF A TWO WORD BLOCK. THE FIRST WORD
19033: * IS THE OLD ADDRESS AND THE SECOND WORD IS THE ADDRESS
19034: * OF THE COPY. THIS LIST IS SEARCHED BY THE PCOPY
19035: * ROUTINE TO AVOID MAKING DUPLICATE COPIES. A TRICK IS
19036: * USED TO ACCOMPLISH THE CONCATENATION AT THE SAME TIME.
19037: * A SPECIAL ENTRY IS MADE TO START WITH ON THE STACK. THIS
19038: * ENTRY RECORDS THAT THE NOTHEN NODE HAS BEEN COPIED
19039: * ALREADY AND THE ADDRESS OF ITS COPY IS THE RIGHT PATTERN.
19040: * THIS AUTOMATICALLY PERFORMS THE CORRECT REPLACEMENTS.
19041: *
19042: {PCONC{PRC{E{0{{ENTRY POINT
19043: {{ZER{-(SP){{{MAKE ROOM FOR ONE ENTRY AT BOTTOM
19044: {{MOV{SP{R8{{STORE POINTER TO START OF LIST
19045: {{MOV{#NDNTH{-(SP){{STACK NOTHEN NODE AS OLD NODE
19046: {{MOV{R10{-(SP){{STORE RIGHT ARG AS COPY OF NOTHEN
19047: {{MOV{SP{R10{{INITIALIZE POINTER TO STACK ENTRIES
19048: {{JSR{PCOPY{{{COPY FIRST NODE OF LEFT ARG
19049: {{MOV{R6{4*2(R10){{STORE AS RESULT UNDER LIST
19050: {{EJC{{{{
19051: *
19052: * PCONC (CONTINUED)
19053: *
19054: * THE FOLLOWING LOOP SCANS ENTRIES IN THE LIST AND MAKES
19055: * SURE THAT THEIR SUCCESSORS HAVE BEEN COPIED.
19056: *
19057: {PCNC1{BEQ{R10{SP{PCNC2{JUMP IF ALL ENTRIES PROCESSED
19058: {{MOV{-(R10){R9{{ELSE LOAD NEXT OLD ADDRESS
19059: {{MOV{4*PTHEN(R9){R9{{LOAD POINTER TO SUCCESSOR
19060: {{JSR{PCOPY{{{COPY SUCCESSOR NODE
19061: {{MOV{-(R10){R9{{LOAD POINTER TO NEW NODE (COPY)
19062: {{MOV{R6{4*PTHEN(R9){{STORE PTR TO NEW SUCCESSOR
19063: *
19064: * NOW CHECK FOR SPECIAL CASE OF ALTERNATION NODE WHERE
19065: * PARM1 POINTS TO A NODE AND MUST BE COPIED LIKE PTHEN.
19066: *
19067: {{BNE{(R9){#P$ALT{PCNC1{LOOP BACK IF NOT
19068: {{MOV{4*PARM1(R9){R9{{ELSE LOAD POINTER TO ALTERNATIVE
19069: {{JSR{PCOPY{{{COPY IT
19070: {{MOV{(R10){R9{{RESTORE PTR TO NEW NODE
19071: {{MOV{R6{4*PARM1(R9){{STORE PTR TO COPIED ALTERNATIVE
19072: {{BRN{PCNC1{{{LOOP BACK FOR NEXT ENTRY
19073: *
19074: * HERE AT END OF COPY PROCESS
19075: *
19076: {PCNC2{MOV{R8{SP{{RESTORE STACK POINTER
19077: {{MOV{(SP)+{R9{{LOAD POINTER TO COPY
19078: {{EXI{{{{RETURN TO PCONC CALLER
19079: {{ENP{{{{END PROCEDURE PCONC
19080: {{EJC{{{{
19081: *
19082: * PCOPY -- COPY A PATTERN NODE
19083: *
19084: * PCOPY IS CALLED FROM THE PCONC PROCEDURE TO COPY A SINGLE
19085: * PATTERN NODE. THE COPY IS ONLY CARRIED OUT IF THE NODE
19086: * HAS NOT BEEN COPIED ALREADY.
19087: *
19088: * (XR) POINTER TO NODE TO BE COPIED
19089: * (XT) PTR TO CURRENT LOC IN COPY LIST
19090: * (WC) POINTER TO LIST OF COPIED NODES
19091: * JSR PCOPY CALL TO COPY A NODE
19092: * (WA) POINTER TO COPY
19093: * (WB,XR) DESTROYED
19094: *
19095: {PCOPY{PRC{N{0{{ENTRY POINT
19096: {{MOV{R10{R7{{SAVE XT
19097: {{MOV{R8{R10{{POINT TO START OF LIST
19098: *
19099: * LOOP TO SEARCH LIST OF NODES COPIED ALREADY
19100: *
19101: {PCOP1{DCA{R10{{{POINT TO NEXT ENTRY ON LIST
19102: {{BEQ{R9{(R10){PCOP2{JUMP IF MATCH
19103: {{DCA{R10{{{ELSE SKIP OVER COPIED ADDRESS
19104: {{BNE{R10{SP{PCOP1{LOOP BACK IF MORE TO TEST
19105: *
19106: * HERE IF NOT IN LIST, PERFORM COPY
19107: *
19108: {{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK
19109: {{JSR{BLKLN{{{GET LENGTH OF BLOCK
19110: {{MOV{R9{R10{{SAVE POINTER TO OLD NODE
19111: {{JSR{ALLOC{{{ALLOCATE SPACE FOR COPY
19112: {{MOV{R10{-(SP){{STORE OLD ADDRESS ON LIST
19113: {{MOV{R9{-(SP){{STORE NEW ADDRESS ON LIST
19114: {{CHK{{{{CHECK FOR STACK OVERFLOW
19115: {{MVW{{{{MOVE WORDS FROM OLD BLOCK TO COPY
19116: {{MOV{(SP){R6{{LOAD POINTER TO COPY
19117: {{BRN{PCOP3{{{JUMP TO EXIT
19118: *
19119: * HERE IF WE FIND ENTRY IN LIST
19120: *
19121: {PCOP2{MOV{-(R10){R6{{LOAD ADDRESS OF COPY FROM LIST
19122: *
19123: * COMMON EXIT POINT
19124: *
19125: {PCOP3{MOV{R7{R10{{RESTORE XT
19126: {{EXI{{{{RETURN TO PCOPY CALLER
19127: {{ENP{{{{END PROCEDURE PCOPY
19128: {{EJC{{{{
19129: *
19130: * PRFLR -- PRINT PROFILE
19131: * PRFLR IS CALLED TO PRINT THE CONTENTS OF THE PROFILE
19132: * TABLE IN A FAIRLY READABLE TABULAR FORMAT.
19133: *
19134: * JSR PRFLR CALL TO PRINT PROFILE
19135: * (WA,IA) DESTROYED
19136: *
19137: {PRFLR{PRC{E{0{{
19138: {{BZE{PFDMP{PRFL4{{NO PRINTING IF NO PROFILING DONE
19139: {{MOV{R9{-(SP){{PRESERVE ENTRY XR
19140: {{MOV{R7{PFSVW{{AND ALSO WB
19141: {{JSR{PRTPG{{{EJECT
19142: {{MOV{#PFMS1{R9{{LOAD MSG /PROGRAM PROFILE/
19143: {{JSR{PRTST{{{AND PRINT IT
19144: {{JSR{PRTNL{{{FOLLOWED BY NEWLINE
19145: {{JSR{PRTNL{{{AND ANOTHER
19146: {{MOV{#PFMS2{R9{{POINT TO FIRST HDR
19147: {{JSR{PRTST{{{PRINT IT
19148: {{JSR{PRTNL{{{NEW LINE
19149: {{MOV{#PFMS3{R9{{SECOND HDR
19150: {{JSR{PRTST{{{PRINT IT
19151: {{JSR{PRTNL{{{NEW LINE
19152: {{JSR{PRTNL{{{AND ANOTHER BLANK LINE
19153: {{ZER{R7{{{INITIAL STMT COUNT
19154: {{MOV{PFTBL{R9{{POINT TO TABLE ORIGIN
19155: {{ADD{#4*NUM02{R9{{BIAS PAST XNBLK HEADER (SGD07)
19156: *
19157: * LOOP HERE TO PRINT SUCCESSIVE ENTRIES
19158: *
19159: {PRFL1{ICV{R7{{{BUMP STMT NR
19160: {{LDI{(R9){{{LOAD NR OF EXECUTIONS
19161: {{IEQ{PRFL3{{{NO PRINTING IF ZERO
19162: {{MOV{#PFPD1{PROFS{{POINT WHERE TO PRINT
19163: {{JSR{PRTIN{{{AND PRINT IT
19164: {{ZER{PROFS{{{BACK TO START OF LINE
19165: {{MTI{R7{{{LOAD STMT NR
19166: {{JSR{PRTIN{{{PRINT IT THERE
19167: {{MOV{#PFPD2{PROFS{{AND PAD PAST COUNT
19168: {{LDI{4*CFP$I(R9){{{LOAD TOTAL EXEC TIME
19169: {{JSR{PRTIN{{{PRINT THAT TOO
19170: {{LDI{4*CFP$I(R9){{{RELOAD TIME
19171: {{MLI{INTTH{{{CONVERT TO MICROSEC
19172: {{IOV{PRFL2{{{OMIT NEXT BIT IF OVERFLOW
19173: {{DVI{(R9){{{DIVIDE BY EXECUTIONS
19174: {{MOV{#PFPD3{PROFS{{PAD LAST PRINT
19175: {{JSR{PRTIN{{{AND PRINT MCSEC/EXECN
19176: *
19177: * MERGE AFTER PRINTING TIME
19178: *
19179: {PRFL2{JSR{PRTNL{{{THATS ANOTHER LINE
19180: *
19181: * HERE TO GO TO NEXT ENTRY
19182: *
19183: {PRFL3{ADD{#4*PF$I2{R9{{BUMP INDEX PTR (SGD07)
19184: {{BLT{R7{PFNTE{PRFL1{LOOP IF MORE STMTS
19185: {{MOV{(SP)+{R9{{RESTORE CALLERS XR
19186: {{MOV{PFSVW{R7{{AND WB TOO
19187: *
19188: * HERE TO EXIT
19189: *
19190: {PRFL4{EXI{{{{RETURN
19191: {{ENP{{{{END OF PRFLR
19192: {{EJC{{{{
19193: *
19194: * PRFLU -- UPDATE AN ENTRY IN THE PROFILE TABLE
19195: *
19196: * ON ENTRY, KVSTN CONTAINS NR OF STMT TO PROFILE
19197: *
19198: * JSR PRFLU CALL TO UPDATE ENTRY
19199: * (IA) DESTROYED
19200: *
19201: {PRFLU{PRC{E{0{{
19202: {{BNZ{PFFNC{PFLU4{{SKIP IF JUST ENTERED FUNCTION
19203: {{MOV{R9{-(SP){{PRESERVE ENTRY XR
19204: {{MOV{R6{PFSVW{{SAVE WA (SGD07)
19205: {{BNZ{PFTBL{PFLU2{{BRANCH IF TABLE ALLOCATED
19206: *
19207: * HERE IF SPACE FOR PROFILE TABLE NOT YET ALLOCATED.
19208: * CALCULATE SIZE NEEDED, ALLOCATE A STATIC XNBLK, AND
19209: * INITIALIZE IT ALL TO ZERO.
19210: * THE TIME TAKEN FOR THIS WILL BE ATTRIBUTED TO THE CURRENT
19211: * STATEMENT (ASSIGNMENT TO KEYWD PROFILE), BUT SINCE THE
19212: * TIMING FOR THIS STATEMENT IS UP THE POLE ANYWAY, THIS
19213: * DOESNT REALLY MATTER...
19214: *
19215: {{SUB{#NUM01{PFNTE{{ADJUST FOR EXTRA COUNT (SGD07)
19216: {{MTI{PFI2A{{{CONVRT ENTRY SIZE TO INT
19217: {{STI{PFSTE{{{AND STORE SAFELY FOR LATER
19218: {{MTI{PFNTE{{{LOAD TABLE LENGTH AS INTEGER
19219: {{MLI{PFSTE{{{MULTIPLY BY ENTRY SIZE
19220: {{MFI{R6{{{GET BACK ADDRESS-STYLE
19221: {{ADD{#NUM02{R6{{ADD ON 2 WORD OVERHEAD
19222: {{WTB{R6{{{CONVERT THE WHOLE LOT TO BYTES
19223: {{JSR{ALOST{{{GIMME THE SPACE
19224: {{MOV{R9{PFTBL{{SAVE BLOCK POINTER
19225: {{MOV{#B$XNT{(R9)+{{PUT BLOCK TYPE AND ...
19226: {{MOV{R6{(R9)+{{... LENGTH INTO HEADER
19227: {{MFI{R6{{{GET BACK NR OF WDS IN DATA AREA
19228: {{LCT{R6{R6{{LOAD THE COUNTER
19229: *
19230: * LOOP HERE TO ZERO THE BLOCK DATA
19231: *
19232: {PFLU1{ZER{(R9)+{{{BLANK A WORD
19233: {{BCT{R6{PFLU1{{AND ALLLLLLL THE REST
19234: *
19235: * END OF ALLOCATION. MERGE BACK INTO ROUTINE
19236: *
19237: {PFLU2{MTI{KVSTN{{{LOAD NR OF STMT JUST ENDED
19238: {{SBI{INTV1{{{MAKE INTO INDEX OFFSET
19239: {{MLI{PFSTE{{{MAKE OFFSET OF TABLE ENTRY
19240: {{MFI{R6{{{CONVERT TO ADDRESS
19241: {{WTB{R6{{{GET AS BAUS
19242: {{ADD{#4*NUM02{R6{{OFFSET INCLUDES TABLE HEADER
19243: {{MOV{PFTBL{R9{{GET TABLE START
19244: {{BGE{R6{4*NUM01(R9){PFLU3{IF OUT OF TABLE, SKIP IT
19245: {{ADD{R6{R9{{ELSE POINT TO ENTRY
19246: {{LDI{(R9){{{GET NR OF EXECUTIONS SO FAR
19247: {{ADI{INTV1{{{NUDGE UP ONE
19248: {{STI{(R9){{{AND PUT BACK
19249: {{JSR{SYSTM{{{GET TIME NOW
19250: {{STI{PFETM{{{STASH ENDING TIME
19251: {{SBI{PFSTM{{{SUBTRACT START TIME
19252: {{ADI{4*CFP$I(R9){{{ADD CUMULATIVE TIME SO FAR
19253: {{STI{4*CFP$I(R9){{{AND PUT BACK NEW TOTAL
19254: {{LDI{PFETM{{{LOAD END TIME OF THIS STMT ...
19255: {{STI{PFSTM{{{... WHICH IS START TIME OF NEXT
19256: *
19257: * MERGE HERE TO EXIT
19258: *
19259: {PFLU3{MOV{(SP)+{R9{{RESTORE CALLERS XR
19260: {{MOV{PFSVW{R6{{RESTORE SAVED REG
19261: {{EXI{{{{AND RETURN
19262: *
19263: * HERE IF PROFILE IS SUPPRESSED BECAUSE A PROGRAM DEFINED
19264: * FUNCTION IS ABOUT TO BE ENTERED, AND SO THE CURRENT STMT
19265: * HAS NOT YET FINISHED
19266: *
19267: {PFLU4{ZER{PFFNC{{{RESET THE CONDITION FLAG
19268: {{EXI{{{{AND IMMEDIATE RETURN
19269: {{ENP{{{{END OF PROCEDURE PRFLU
19270: {{EJC{{{{
19271: *
19272: * PRPAR - PROCESS PRINT PARAMETERS
19273: *
19274: * (WC) IF NONZERO ASSOCIATE TERMINAL ONLY
19275: * JSR PRPAR CALL TO PROCESS PRINT PARAMETERS
19276: * (XL,XR,WA,WB,WC) DESTROYED
19277: *
19278: * SINCE MEMORY ALLOCATION IS UNDECIDED ON INITIAL CALL,
19279: * TERMINAL CANNOT BE ASSOCIATED. THE ENTRY WITH WC NON-ZERO
19280: * IS PROVIDED SO A LATER CALL CAN BE MADE TO COMPLETE THIS.
19281: *
19282: {PRPAR{PRC{E{0{{ENTRY POINT
19283: {{BNZ{R8{PRPA7{{JUMP TO ASSOCIATE TERMINAL
19284: {{JSR{SYSPP{{{GET PRINT PARAMETERS
19285: {{BNZ{R7{PRPA1{{JUMP IF LINES/PAGE SPECIFIED
19286: {{MOV{#CFP$M{R7{{ELSE USE A LARGE VALUE
19287: {{RSH{R7{1{{BUT NOT TOO LARGE
19288: *
19289: * STORE LINE COUNT/PAGE
19290: *
19291: {PRPA1{MOV{R7{LSTNP{{STORE NUMBER OF LINES/PAGE
19292: {{MOV{R7{LSTLC{{PRETEND PAGE IS FULL INITIALLY
19293: {{ZER{LSTPG{{{CLEAR PAGE NUMBER
19294: {{MOV{PRLEN{R7{{GET PRIOR LENGTH IF ANY
19295: {{BZE{R7{PRPA2{{SKIP IF NO LENGTH
19296: {{BGT{R6{R7{PRPA3{SKIP STORING IF TOO BIG
19297: *
19298: * STORE PRINT BUFFER LENGTH
19299: *
19300: {PRPA2{MOV{R6{PRLEN{{STORE VALUE
19301: *
19302: * PROCESS BITS OPTIONS
19303: *
19304: {PRPA3{MOV{BITS3{R7{{BIT 3 MASK
19305: {{ANB{R8{R7{{GET -NOLIST BIT
19306: {{ZRB{R7{PRPA4{{SKIP IF CLEAR
19307: {{ZER{CSWLS{{{SET -NOLIST
19308: *
19309: * CHECK IF FAIL REPORTS GOTO INTERACTIVE CHANNEL
19310: *
19311: {PRPA4{MOV{BITS1{R7{{BIT 1 MASK
19312: {{ANB{R8{R7{{GET BIT
19313: {{MOV{R7{ERICH{{STORE INT. CHAN. ERROR FLAG
19314: {{MOV{BITS2{R7{{BIT 2 MASK
19315: {{ANB{R8{R7{{GET BIT
19316: {{MOV{R7{PRICH{{FLAG FOR STD PRINTER ON INT. CHAN.
19317: {{MOV{BITS4{R7{{BIT 4 MASK
19318: {{ANB{R8{R7{{GET BIT
19319: {{MOV{R7{CPSTS{{FLAG FOR COMPILE STATS SUPPRESSN.
19320: {{MOV{BITS5{R7{{BIT 5 MASK
19321: {{ANB{R8{R7{{GET BIT
19322: {{MOV{R7{EXSTS{{FLAG FOR EXEC STATS SUPPRESSION
19323: {{EJC{{{{
19324: *
19325: * PRPAR (CONTINUED)
19326: *
19327: {{MOV{BITS6{R7{{BIT 6 MASK
19328: {{ANB{R8{R7{{GET BIT
19329: {{MOV{R7{PRECL{{EXTENDED/COMPACT LISTING FLAG
19330: {{SUB{#NUM08{R6{{POINT 8 CHARS FROM LINE END
19331: {{ZRB{R7{PRPA5{{JUMP IF NOT EXTENDED
19332: {{MOV{R6{LSTPO{{STORE FOR LISTING PAGE HEADINGS
19333: *
19334: * CONTINUE OPTION PROCESSING
19335: *
19336: {PRPA5{MOV{BITS7{R7{{BIT 7 MASK
19337: {{ANB{R8{R7{{GET BIT 7
19338: {{MOV{R7{CSWEX{{SET -NOEXECUTE IF NON-ZERO
19339: {{MOV{BIT10{R7{{BIT 10 MASK
19340: {{ANB{R8{R7{{GET BIT 10
19341: {{MOV{R7{HEADP{{PRETEND PRINTED TO OMIT HEADERS
19342: {{MOV{BITS9{R7{{BIT 9 MASK
19343: {{ANB{R8{R7{{GET BIT 9
19344: {{MOV{R7{PRSTO{{KEEP IT AS STD LISTING OPTION
19345: {{ZRB{R7{PRPA6{{SKIP IF CLEAR
19346: {{MOV{PRLEN{R6{{GET PRINT BUFFER LENGTH
19347: {{SUB{#NUM08{R6{{POINT 8 CHARS FROM LINE END
19348: {{MOV{R6{LSTPO{{STORE PAGE OFFSET
19349: *
19350: * CHECK FOR TERMINAL
19351: *
19352: {PRPA6{ANB{BITS8{R8{{SEE IF TERMINAL TO BE ACTIVATED
19353: {{BNZ{R8{PRPA7{{JUMP IF TERMINAL REQUIRED
19354: {{BZE{INITR{PRPA8{{JUMP IF NO TERMINAL TO DETACH
19355: {{MOV{#V$TER{R10{{PTR TO /TERMINAL/
19356: {{JSR{GTNVR{{{GET VRBLK POINTER
19357: {{PPM{{{{CANT FAIL
19358: {{MOV{#NULLS{4*VRVAL(R9){{CLEAR VALUE OF TERMINAL
19359: {{JSR{SETVR{{{REMOVE ASSOCIATION
19360: {{BRN{PRPA8{{{RETURN
19361: *
19362: * ASSOCIATE TERMINAL
19363: *
19364: {PRPA7{MNZ{INITR{{{NOTE TERMINAL ASSOCIATED
19365: {{BZE{DNAMB{PRPA8{{CANT IF MEMORY NOT ORGANISED
19366: {{MOV{#V$TER{R10{{POINT TO TERMINAL STRING
19367: {{MOV{#TRTOU{R7{{OUTPUT TRACE TYPE
19368: {{JSR{INOUT{{{ATTACH OUTPUT TRBLK TO VRBLK
19369: {{MOV{R9{-(SP){{STACK TRBLK PTR
19370: {{MOV{#V$TER{R10{{POINT TO TERMINAL STRING
19371: {{MOV{#TRTIN{R7{{INPUT TRACE TYPE
19372: {{JSR{INOUT{{{ATTACH INPUT TRACE BLK
19373: {{MOV{(SP)+{4*VRVAL(R9){{ADD OUTPUT TRBLK TO CHAIN
19374: *
19375: * RETURN POINT
19376: *
19377: {PRPA8{EXI{{{{RETURN
19378: {{ENP{{{{END PROCEDURE PRPAR
19379: {{EJC{{{{
19380: *
19381: * PRTCH -- PRINT A CHARACTER
19382: *
19383: * PRTCH IS USED TO PRINT A SINGLE CHARACTER
19384: *
19385: * (WA) CHARACTER TO BE PRINTED
19386: * JSR PRTCH CALL TO PRINT CHARACTER
19387: *
19388: {PRTCH{PRC{E{0{{ENTRY POINT
19389: {{MOV{R9{-(SP){{SAVE XR
19390: {{BNE{PROFS{PRLEN{PRCH1{JUMP IF ROOM IN BUFFER
19391: {{JSR{PRTNL{{{ELSE PRINT THIS LINE
19392: *
19393: * HERE AFTER MAKING SURE WE HAVE ROOM
19394: *
19395: {PRCH1{MOV{PRBUF{R9{{POINT TO PRINT BUFFER
19396: {{PSC{R9{PROFS{{POINT TO NEXT CHARACTER LOCATION
19397: {{SCH{R6{(R9){{STORE NEW CHARACTER
19398: {{CSC{R9{{{COMPLETE STORE CHARACTERS
19399: {{ICV{PROFS{{{BUMP POINTER
19400: {{MOV{(SP)+{R9{{RESTORE ENTRY XR
19401: {{EXI{{{{RETURN TO PRTCH CALLER
19402: {{ENP{{{{END PROCEDURE PRTCH
19403: {{EJC{{{{
19404: *
19405: * PRTIC -- PRINT TO INTERACTIVE CHANNEL
19406: *
19407: * PRTIC IS CALLED TO PRINT THE CONTENTS OF THE STANDARD
19408: * PRINT BUFFER TO THE INTERACTIVE CHANNEL. IT IS ONLY
19409: * CALLED AFTER PRTST HAS SET UP THE STRING FOR PRINTING.
19410: * IT DOES NOT CLEAR THE BUFFER.
19411: *
19412: * JSR PRTIC CALL FOR PRINT
19413: * (WA,WB) DESTROYED
19414: *
19415: {PRTIC{PRC{E{0{{ENTRY POINT
19416: {{MOV{R9{-(SP){{SAVE XR
19417: {{MOV{PRBUF{R9{{POINT TO BUFFER
19418: {{MOV{PROFS{R6{{NO OF CHARS
19419: {{JSR{SYSPI{{{PRINT
19420: {{PPM{PRTC2{{{FAIL RETURN
19421: *
19422: * RETURN
19423: *
19424: {PRTC1{MOV{(SP)+{R9{{RESTORE XR
19425: {{EXI{{{{RETURN
19426: *
19427: * ERROR OCCURED
19428: *
19429: {PRTC2{ZER{ERICH{{{PREVENT LOOPING
19430: {{ERB{252{ERROR{{ON PRINTING TO INTERACTIVE CHANNEL
19431: {{BRN{PRTC1{{{RETURN
19432: {{ENP{{{{PROCEDURE PRTIC
19433: {{EJC{{{{
19434: *
19435: * PRTIS -- PRINT TO INTERACTIVE AND STANDARD PRINTER
19436: *
19437: * PRTIS PUTS A LINE FROM THE PRINT BUFFER ONTO THE
19438: * INTERACTIVE CHANNEL (IF ANY) AND THE STANDARD PRINTER.
19439: * IT ALWAYS PRINTS TO THE STANDARD PRINTER BUT DOES
19440: * NOT DUPLICATE LINES IF THE STANDARD PRINTER IS
19441: * INTERACTIVE. IT CLEARS DOWN THE PRINT BUFFER.
19442: *
19443: * JSR PRTIS CALL FOR PRINTING
19444: * (WA,WB) DESTROYED
19445: *
19446: {PRTIS{PRC{E{0{{ENTRY POINT
19447: {{BNZ{PRICH{PRTS1{{JUMP IF STANDARD PRINTER IS INT.CH.
19448: {{BZE{ERICH{PRTS1{{SKIP IF NOT DOING INT. ERROR REPS.
19449: {{JSR{PRTIC{{{PRINT TO INTERACTIVE CHANNEL
19450: *
19451: * MERGE AND EXIT
19452: *
19453: {PRTS1{JSR{PRTNL{{{PRINT TO STANDARD PRINTER
19454: {{EXI{{{{RETURN
19455: {{ENP{{{{END PROCEDURE PRTIS
19456: {{EJC{{{{
19457: *
19458: * PRTIN -- PRINT AN INTEGER
19459: *
19460: * PRTIN PRINTS THE INTEGER VALUE WHICH IS IN THE INTEGER
19461: * ACCUMULATOR. BLOCKS BUILT IN DYNAMIC STORAGE
19462: * DURING THIS PROCESS ARE IMMEDIATELY DELETED.
19463: *
19464: * (IA) INTEGER VALUE TO BE PRINTED
19465: * JSR PRTIN CALL TO PRINT INTEGER
19466: * (IA,RA) DESTROYED
19467: *
19468: {PRTIN{PRC{E{0{{ENTRY POINT
19469: {{MOV{R9{-(SP){{SAVE XR
19470: {{JSR{ICBLD{{{BUILD INTEGER BLOCK
19471: {{BLO{R9{DNAMB{PRTI1{JUMP IF ICBLK BELOW DYNAMIC
19472: {{BHI{R9{DNAMP{PRTI1{JUMP IF ABOVE DYNAMIC
19473: {{MOV{R9{DNAMP{{IMMEDIATELY DELETE IT
19474: *
19475: * DELETE ICBLK FROM DYNAMIC STORE
19476: *
19477: {PRTI1{MOV{R9{-(SP){{STACK PTR FOR GTSTG
19478: {{JSR{GTSTG{{{CONVERT TO STRING
19479: {{PPM{{{{CONVERT ERROR IS IMPOSSIBLE
19480: {{MOV{R9{DNAMP{{RESET POINTER TO DELETE SCBLK
19481: {{JSR{PRTST{{{PRINT INTEGER STRING
19482: {{MOV{(SP)+{R9{{RESTORE ENTRY XR
19483: {{EXI{{{{RETURN TO PRTIN CALLER
19484: {{ENP{{{{END PROCEDURE PRTIN
19485: {{EJC{{{{
19486: *
19487: * PRTMI -- PRINT MESSAGE AND INTEGER
19488: *
19489: * PRTMI IS USED TO PRINT MESSAGES TOGETHER WITH AN INTEGER
19490: * VALUE STARTING IN COLUMN 15 (USED BY THE ROUTINES AT
19491: * THE END OF COMPILATION).
19492: *
19493: * JSR PRTMI CALL TO PRINT MESSAGE AND INTEGER
19494: *
19495: {PRTMI{PRC{E{0{{ENTRY POINT
19496: {{JSR{PRTST{{{PRINT STRING MESSAGE
19497: {{MOV{#PRTMF{PROFS{{SET OFFSET TO COL 15
19498: {{JSR{PRTIN{{{PRINT INTEGER
19499: {{JSR{PRTNL{{{PRINT LINE
19500: {{EXI{{{{RETURN TO PRTMI CALLER
19501: {{ENP{{{{END PROCEDURE PRTMI
19502: {{EJC{{{{
19503: *
19504: * PRTMX -- AS PRTMI WITH EXTRA COPY TO INTERACTIVE CHAN.
19505: *
19506: * JSR PRTMX CALL FOR PRINTING
19507: * (WA,WB) DESTROYED
19508: *
19509: {PRTMX{PRC{E{0{{ENTRY POINT
19510: {{JSR{PRTST{{{PRINT STRING MESSAGE
19511: {{MOV{#PRTMF{PROFS{{SET PTR TO COLUMN 15
19512: {{JSR{PRTIN{{{PRINT INTEGER
19513: {{JSR{PRTIS{{{PRINT LINE
19514: {{EXI{{{{RETURN
19515: {{ENP{{{{END PROCEDURE PRTMX
19516: {{EJC{{{{
19517: *
19518: * PRTNL -- PRINT NEW LINE (END PRINT LINE)
19519: *
19520: * PRTNL PRINTS THE CONTENTS OF THE PRINT BUFFER, RESETS
19521: * THE BUFFER TO ALL BLANKS AND RESETS THE PRINT POINTER.
19522: *
19523: * JSR PRTNL CALL TO PRINT LINE
19524: *
19525: {PRTNL{PRC{R{0{{ENTRY POINT
19526: {{BNZ{HEADP{PRNL0{{WERE HEADERS PRINTED
19527: {{JSR{PRTPS{{{NO - PRINT THEM
19528: *
19529: * CALL SYSPR
19530: *
19531: {PRNL0{MOV{R9{-(SP){{SAVE ENTRY XR
19532: {{MOV{R6{PRTSA{{SAVE WA
19533: {{MOV{R7{PRTSB{{SAVE WB
19534: {{MOV{PRBUF{R9{{LOAD POINTER TO BUFFER
19535: {{MOV{PROFS{R6{{LOAD NUMBER OF CHARS IN BUFFER
19536: {{JSR{SYSPR{{{CALL SYSTEM PRINT ROUTINE
19537: {{PPM{PRNL2{{{JUMP IF FAILED
19538: {{LCT{R6{PRLNW{{LOAD LENGTH OF BUFFER IN WORDS
19539: {{ADD{#4*SCHAR{R9{{POINT TO CHARS OF BUFFER
19540: {{MOV{NULLW{R7{{GET WORD OF BLANKS
19541: *
19542: * LOOP TO BLANK BUFFER
19543: *
19544: {PRNL1{MOV{R7{(R9)+{{STORE WORD OF BLANKS, BUMP PTR
19545: {{BCT{R6{PRNL1{{LOOP TILL ALL BLANKED
19546: *
19547: * EXIT POINT
19548: *
19549: {{MOV{PRTSB{R7{{RESTORE WB
19550: {{MOV{PRTSA{R6{{RESTORE WA
19551: {{MOV{(SP)+{R9{{RESTORE ENTRY XR
19552: {{ZER{PROFS{{{RESET PRINT BUFFER POINTER
19553: {{EXI{{{{RETURN TO PRTNL CALLER
19554: *
19555: * FILE FULL OR NO OUTPUT FILE FOR LOAD MODULE
19556: *
19557: {PRNL2{BNZ{PRTEF{PRNL3{{JUMP IF NOT FIRST TIME
19558: {{MNZ{PRTEF{{{MARK FIRST OCCURRENCE
19559: {{ERB{253{PRINT{{LIMIT EXCEEDED ON STANDARD OUTPUT CHANNEL
19560: *
19561: * STOP AT ONCE
19562: *
19563: {PRNL3{MOV{#NINI8{R7{{ENDING CODE
19564: {{MOV{KVSTN{R6{{STATEMENT NUMBER
19565: {{JSR{SYSEJ{{{STOP
19566: {{ENP{{{{END PROCEDURE PRTNL
19567: {{EJC{{{{
19568: *
19569: * PRTNM -- PRINT VARIABLE NAME
19570: *
19571: * PRTNM IS USED TO PRINT A CHARACTER REPRESENTATION OF THE
19572: * NAME OF A VARIABLE (NOT A VALUE OF DATATYPE NAME)
19573: * NAMES OF PSEUDO-VARIABLES MAY NOT BE PASSED TO PRTNM.
19574: *
19575: * (XL) NAME BASE
19576: * (WA) NAME OFFSET
19577: * JSR PRTNM CALL TO PRINT NAME
19578: * (WB,WC,RA) DESTROYED
19579: *
19580: {PRTNM{PRC{R{0{{ENTRY POINT (RECURSIVE, SEE PRTVL)
19581: {{MOV{R6{-(SP){{SAVE WA (OFFSET IS COLLECTABLE)
19582: {{MOV{R9{-(SP){{SAVE ENTRY XR
19583: {{MOV{R10{-(SP){{SAVE NAME BASE
19584: {{BHI{R10{STATE{PRN02{JUMP IF NOT NATURAL VARIABLE
19585: *
19586: * HERE FOR NATURAL VARIABLE NAME, RECOGNIZED BY THE FACT
19587: * THAT THE NAME BASE POINTS INTO THE STATIC AREA.
19588: *
19589: {{MOV{R10{R9{{POINT TO VRBLK
19590: {{JSR{PRTVN{{{PRINT NAME OF VARIABLE
19591: *
19592: * COMMON EXIT POINT
19593: *
19594: {PRN01{MOV{(SP)+{R10{{RESTORE NAME BASE
19595: {{MOV{(SP)+{R9{{RESTORE ENTRY VALUE OF XR
19596: {{MOV{(SP)+{R6{{RESTORE WA
19597: {{EXI{{{{RETURN TO PRTNM CALLER
19598: *
19599: * HERE FOR CASE OF NON-NATURAL VARIABLE
19600: *
19601: {PRN02{MOV{R6{R7{{COPY NAME OFFSET
19602: {{BNE{(R10){#B$PDT{PRN03{JUMP IF ARRAY OR TABLE
19603: *
19604: * FOR PROGRAM DEFINED DATATYPE, PRT FLD NAME, LEFT PAREN
19605: *
19606: {{MOV{4*PDDFP(R10){R9{{LOAD POINTER TO DFBLK
19607: {{ADD{R6{R9{{ADD NAME OFFSET
19608: {{MOV{4*PDFOF(R9){R9{{LOAD VRBLK POINTER FOR FIELD
19609: {{JSR{PRTVN{{{PRINT FIELD NAME
19610: {{MOV{#CH$PP{R6{{LOAD LEFT PAREN
19611: {{JSR{PRTCH{{{PRINT CHARACTER
19612: {{EJC{{{{
19613: *
19614: * PRTNM (CONTINUED)
19615: *
19616: * NOW WE PRINT AN IDENTIFYING NAME FOR THE OBJECT IF ONE
19617: * CAN BE FOUND. THE FOLLOWING CODE SEARCHES FOR A NATURAL
19618: * VARIABLE WHICH CONTAINS THIS OBJECT AS VALUE. IF SUCH A
19619: * VARIABLE IS FOUND, ITS NAME IS PRINTED, ELSE THE VALUE
19620: * OF THE OBJECT (AS PRINTED BY PRTVL) IS USED INSTEAD.
19621: *
19622: * FIRST WE POINT TO THE PARENT TBBLK IF THIS IS THE CASE OF
19623: * A TABLE ELEMENT. TO DO THIS, CHASE DOWN THE TRNXT CHAIN.
19624: *
19625: {PRN03{BNE{(R10){#B$TET{PRN04{JUMP IF WE GOT THERE (OR NOT TE)
19626: {{MOV{4*TENXT(R10){R10{{ELSE MOVE OUT ON CHAIN
19627: {{BRN{PRN03{{{AND LOOP BACK
19628: *
19629: * NOW WE ARE READY FOR THE SEARCH. TO SPEED THINGS UP IN
19630: * THE CASE OF CALLS FROM DUMP WHERE THE SAME NAME BASE
19631: * WILL OCCUR REPEATEDLY WHILE DUMPING AN ARRAY OR TABLE,
19632: * WE REMEMBER THE LAST VRBLK POINTER FOUND IN PRNMV. SO
19633: * FIRST CHECK TO SEE IF WE HAVE THIS ONE AGAIN.
19634: *
19635: {PRN04{MOV{PRNMV{R9{{POINT TO VRBLK WE FOUND LAST TIME
19636: {{MOV{HSHTB{R6{{POINT TO HASH TABLE IN CASE NOT
19637: {{BRN{PRN07{{{JUMP INTO SEARCH FOR SPECIAL CHECK
19638: *
19639: * LOOP THROUGH HASH SLOTS
19640: *
19641: {PRN05{MOV{R6{R9{{COPY SLOT POINTER
19642: {{ICA{R6{{{BUMP SLOT POINTER
19643: {{SUB{#4*VRNXT{R9{{INTRODUCE STANDARD VRBLK OFFSET
19644: *
19645: * LOOP THROUGH VRBLKS ON ONE HASH CHAIN
19646: *
19647: {PRN06{MOV{4*VRNXT(R9){R9{{POINT TO NEXT VRBLK ON HASH CHAIN
19648: *
19649: * MERGE HERE FIRST TIME TO CHECK BLOCK WE FOUND LAST TIME
19650: *
19651: {PRN07{MOV{R9{R8{{COPY VRBLK POINTER
19652: {{BZE{R8{PRN09{{JUMP IF CHAIN END (OR PRNMV ZERO)
19653: {{EJC{{{{
19654: *
19655: * PRTNM (CONTINUED)
19656: *
19657: * LOOP TO FIND VALUE (CHASE DOWN POSSIBLE TRBLK CHAIN)
19658: *
19659: {PRN08{MOV{4*VRVAL(R9){R9{{LOAD VALUE
19660: {{BEQ{(R9){#B$TRT{PRN08{LOOP IF THAT WAS A TRBLK
19661: *
19662: * NOW WE HAVE THE VALUE, IS THIS THE BLOCK WE WANT
19663: *
19664: {{BEQ{R9{R10{PRN10{JUMP IF THIS MATCHES THE NAME BASE
19665: {{MOV{R8{R9{{ELSE POINT BACK TO THAT VRBLK
19666: {{BRN{PRN06{{{AND LOOP BACK
19667: *
19668: * HERE TO MOVE TO NEXT HASH SLOT
19669: *
19670: {PRN09{BLT{R6{HSHTE{PRN05{LOOP BACK IF MORE TO GO
19671: {{MOV{R10{R9{{ELSE NOT FOUND, COPY VALUE POINTER
19672: {{JSR{PRTVL{{{PRINT VALUE
19673: {{BRN{PRN11{{{AND MERGE AHEAD
19674: *
19675: * HERE WHEN WE FIND A MATCHING ENTRY
19676: *
19677: {PRN10{MOV{R8{R9{{COPY VRBLK POINTER
19678: {{MOV{R9{PRNMV{{SAVE FOR NEXT TIME IN
19679: {{JSR{PRTVN{{{PRINT VARIABLE NAME
19680: *
19681: * MERGE HERE IF NO ENTRY FOUND
19682: *
19683: {PRN11{MOV{(R10){R8{{LOAD FIRST WORD OF NAME BASE
19684: {{BNE{R8{#B$PDT{PRN13{JUMP IF NOT PROGRAM DEFINED
19685: *
19686: * FOR PROGRAM DEFINED DATATYPE, ADD RIGHT PAREN AND EXIT
19687: *
19688: {{MOV{#CH$RP{R6{{LOAD RIGHT PAREN, MERGE
19689: *
19690: * MERGE HERE TO PRINT FINAL RIGHT PAREN OR BRACKET
19691: *
19692: {PRN12{JSR{PRTCH{{{PRINT FINAL CHARACTER
19693: {{MOV{R7{R6{{RESTORE NAME OFFSET
19694: {{BRN{PRN01{{{MERGE BACK TO EXIT
19695: {{EJC{{{{
19696: *
19697: * PRTNM (CONTINUED)
19698: *
19699: * HERE FOR ARRAY OR TABLE
19700: *
19701: {PRN13{MOV{#CH$BB{R6{{LOAD LEFT BRACKET
19702: {{JSR{PRTCH{{{AND PRINT IT
19703: {{MOV{(SP){R10{{RESTORE BLOCK POINTER
19704: {{MOV{(R10){R8{{LOAD TYPE WORD AGAIN
19705: {{BNE{R8{#B$TET{PRN15{JUMP IF NOT TABLE
19706: *
19707: * HERE FOR TABLE, PRINT SUBSCRIPT VALUE
19708: *
19709: {{MOV{4*TESUB(R10){R9{{LOAD SUBSCRIPT VALUE
19710: {{MOV{R7{R10{{SAVE NAME OFFSET
19711: {{JSR{PRTVL{{{PRINT SUBSCRIPT VALUE
19712: {{MOV{R10{R7{{RESTORE NAME OFFSET
19713: *
19714: * MERGE HERE FROM ARRAY CASE TO PRINT RIGHT BRACKET
19715: *
19716: {PRN14{MOV{#CH$RB{R6{{LOAD RIGHT BRACKET
19717: {{BRN{PRN12{{{MERGE BACK TO PRINT IT
19718: *
19719: * HERE FOR ARRAY OR VECTOR, TO PRINT SUBSCRIPT(S)
19720: *
19721: {PRN15{MOV{R7{R6{{COPY NAME OFFSET
19722: {{BTW{R6{{{CONVERT TO WORDS
19723: {{BEQ{R8{#B$ART{PRN16{JUMP IF ARBLK
19724: *
19725: * HERE FOR VECTOR
19726: *
19727: {{SUB{#VCVLB{R6{{ADJUST FOR STANDARD FIELDS
19728: {{MTI{R6{{{MOVE TO INTEGER ACCUM
19729: {{JSR{PRTIN{{{PRINT LINEAR SUBSCRIPT
19730: {{BRN{PRN14{{{MERGE BACK FOR RIGHT BRACKET
19731: {{EJC{{{{
19732: *
19733: * PRTNM (CONTINUED)
19734: *
19735: * HERE FOR ARRAY. FIRST CALCULATE ABSOLUTE SUBSCRIPT
19736: * OFFSETS BY SUCCESSIVE DIVISIONS BY THE DIMENSION VALUES.
19737: * THIS MUST BE DONE RIGHT TO LEFT SINCE THE ELEMENTS ARE
19738: * STORED ROW-WISE. THE SUBSCRIPTS ARE STACKED AS INTEGERS.
19739: *
19740: {PRN16{MOV{4*AROFS(R10){R8{{LOAD LENGTH OF BOUNDS INFO
19741: {{ICA{R8{{{ADJUST FOR ARPRO FIELD
19742: {{BTW{R8{{{CONVERT TO WORDS
19743: {{SUB{R8{R6{{GET LINEAR ZERO-ORIGIN SUBSCRIPT
19744: {{MTI{R6{{{GET INTEGER VALUE
19745: {{LCT{R6{4*ARNDM(R10){{SET NUM OF DIMENSIONS AS LOOP COUNT
19746: {{ADD{4*AROFS(R10){R10{{POINT PAST BOUNDS INFORMATION
19747: {{SUB{#4*ARLBD{R10{{SET OK OFFSET FOR PROPER PTR LATER
19748: *
19749: * LOOP TO STACK SUBSCRIPT OFFSETS
19750: *
19751: {PRN17{SUB{#4*ARDMS{R10{{POINT TO NEXT SET OF BOUNDS
19752: {{STI{PRNSI{{{SAVE CURRENT OFFSET
19753: {{RMI{4*ARDIM(R10){{{GET REMAINDER ON DIVIDING BY DIMENS
19754: {{MFI{-(SP){{{STORE ON STACK (ONE WORD)
19755: {{LDI{PRNSI{{{RELOAD ARGUMENT
19756: {{DVI{4*ARDIM(R10){{{DIVIDE TO GET QUOTIENT
19757: {{BCT{R6{PRN17{{LOOP TILL ALL STACKED
19758: {{ZER{R9{{{SET OFFSET TO FIRST SET OF BOUNDS
19759: {{LCT{R7{4*ARNDM(R10){{LOAD COUNT OF DIMS TO CONTROL LOOP
19760: {{BRN{PRN19{{{JUMP INTO PRINT LOOP
19761: *
19762: * LOOP TO PRINT SUBSCRIPTS FROM STACK ADJUSTING BY ADDING
19763: * THE APPROPRIATE LOW BOUND VALUE FROM THE ARBLK
19764: *
19765: {PRN18{MOV{#CH$CM{R6{{LOAD A COMMA
19766: {{JSR{PRTCH{{{PRINT IT
19767: *
19768: * MERGE HERE FIRST TIME IN (NO COMMA REQUIRED)
19769: *
19770: {PRN19{MTI{(SP)+{{{LOAD SUBSCRIPT OFFSET AS INTEGER
19771: {{ADD{R9{R10{{POINT TO CURRENT LBD
19772: {{ADI{4*ARLBD(R10){{{ADD LBD TO GET SIGNED SUBSCRIPT
19773: {{SUB{R9{R10{{POINT BACK TO START OF ARBLK
19774: {{JSR{PRTIN{{{PRINT SUBSCRIPT
19775: {{ADD{#4*ARDMS{R9{{BUMP OFFSET TO NEXT BOUNDS
19776: {{BCT{R7{PRN18{{LOOP BACK TILL ALL PRINTED
19777: {{BRN{PRN14{{{MERGE BACK TO PRINT RIGHT BRACKET
19778: {{ENP{{{{END PROCEDURE PRTNM
19779: {{EJC{{{{
19780: *
19781: * PRTNV -- PRINT NAME VALUE
19782: *
19783: * PRTNV IS USED BY THE TRACE AND DUMP ROUTINES TO PRINT
19784: * A LINE OF THE FORM
19785: *
19786: * NAME = VALUE
19787: *
19788: * NOTE THAT THE NAME INVOLVED CAN NEVER BE A PSEUDO-VAR
19789: *
19790: * (XL) NAME BASE
19791: * (WA) NAME OFFSET
19792: * JSR PRTNV CALL TO PRINT NAME = VALUE
19793: * (WB,WC,RA) DESTROYED
19794: *
19795: {PRTNV{PRC{E{0{{ENTRY POINT
19796: {{JSR{PRTNM{{{PRINT ARGUMENT NAME
19797: {{MOV{R9{-(SP){{SAVE ENTRY XR
19798: {{MOV{R6{-(SP){{SAVE NAME OFFSET (COLLECTABLE)
19799: {{MOV{#TMBEB{R9{{POINT TO BLANK EQUAL BLANK
19800: {{JSR{PRTST{{{PRINT IT
19801: {{MOV{R10{R9{{COPY NAME BASE
19802: {{ADD{R6{R9{{POINT TO VALUE
19803: {{MOV{(R9){R9{{LOAD VALUE POINTER
19804: {{JSR{PRTVL{{{PRINT VALUE
19805: {{JSR{PRTNL{{{TERMINATE LINE
19806: {{MOV{(SP)+{R6{{RESTORE NAME OFFSET
19807: {{MOV{(SP)+{R9{{RESTORE ENTRY XR
19808: {{EXI{{{{RETURN TO CALLER
19809: {{ENP{{{{END PROCEDURE PRTNV
19810: {{EJC{{{{
19811: *
19812: * PRTPG -- PRINT A PAGE THROW
19813: *
19814: * PRINTS A PAGE THROW OR A FEW BLANK LINES ON THE STANDARD
19815: * LISTING CHANNEL DEPENDING ON THE LISTING OPTIONS CHOSEN.
19816: *
19817: * JSR PRTPG CALL FOR PAGE EJECT
19818: *
19819: {PRTPG{PRC{E{0{{ENTRY POINT
19820: {{BEQ{STAGE{#STGXT{PRP01{JUMP IF EXECUTION TIME
19821: {{BZE{LSTLC{PRP06{{RETURN IF TOP OF PAGE ALREADY
19822: {{ZER{LSTLC{{{CLEAR LINE COUNT
19823: *
19824: * CHECK TYPE OF LISTING
19825: *
19826: {PRP01{MOV{R9{-(SP){{PRESERVE XR
19827: {{BNZ{PRSTD{PRP02{{EJECT IF FLAG SET
19828: {{BNZ{PRICH{PRP03{{JUMP IF INTERACTIVE LISTING CHANNEL
19829: {{BZE{PRECL{PRP03{{JUMP IF COMPACT LISTING
19830: *
19831: * PERFORM AN EJECT
19832: *
19833: {PRP02{JSR{SYSEP{{{EJECT
19834: {{BRN{PRP04{{{MERGE
19835: *
19836: * COMPACT OR INTERACTIVE CHANNEL LISTING. CANT PRINT
19837: * BLANKS UNTIL CHECK MADE FOR HEADERS PRINTED AND FLAG SET.
19838: *
19839: *
19840: {PRP03{MOV{HEADP{R9{{REMEMBER HEADP
19841: {{MNZ{HEADP{{{SET TO AVOID REPEATED PRTPG CALLS
19842: {{JSR{PRTNL{{{PRINT BLANK LINE
19843: {{JSR{PRTNL{{{PRINT BLANK LINE
19844: {{JSR{PRTNL{{{PRINT BLANK LINE
19845: {{MOV{#NUM03{LSTLC{{COUNT BLANK LINES
19846: {{MOV{R9{HEADP{{RESTORE HEADER FLAG
19847: {{EJC{{{{
19848: *
19849: * PRPTG (CONTINUED)
19850: *
19851: * PRINT THE HEADING
19852: *
19853: {PRP04{BNZ{HEADP{PRP05{{JUMP IF HEADER LISTED
19854: {{MNZ{HEADP{{{MARK HEADERS PRINTED
19855: {{MOV{R10{-(SP){{KEEP XL
19856: {{MOV{#HEADR{R9{{POINT TO LISTING HEADER
19857: {{JSR{PRTST{{{PLACE IT
19858: {{JSR{SYSID{{{GET SYSTEM IDENTIFICATION
19859: {{JSR{PRTST{{{APPEND EXTRA CHARS
19860: {{JSR{PRTNL{{{PRINT IT
19861: {{MOV{R10{R9{{EXTRA HEADER LINE
19862: {{JSR{PRTST{{{PLACE IT
19863: {{JSR{PRTNL{{{PRINT IT
19864: {{JSR{PRTNL{{{PRINT A BLANK
19865: {{JSR{PRTNL{{{AND ANOTHER
19866: {{ADD{#NUM04{LSTLC{{FOUR HEADER LINES PRINTED
19867: {{MOV{(SP)+{R10{{RESTORE XL
19868: *
19869: * MERGE IF HEADER NOT PRINTED
19870: *
19871: {PRP05{MOV{(SP)+{R9{{RESTORE XR
19872: *
19873: * RETURN
19874: *
19875: {PRP06{EXI{{{{RETURN
19876: {{ENP{{{{END PROCEDURE PRTPG
19877: {{EJC{{{{
19878: *
19879: * PRTPS - PRINT PAGE WITH TEST FOR STANDARD LISTING OPTION
19880: *
19881: * IF THE STANDARD LISTING OPTION IS SELECTED, INSIST THAT
19882: * AN EJECT BE DONE
19883: *
19884: * JSR PRTPS CALL FOR EJECT
19885: *
19886: {PRTPS{PRC{E{0{{ENTRY POINT
19887: {{MOV{PRSTO{PRSTD{{COPY OPTION FLAG
19888: {{JSR{PRTPG{{{PRINT PAGE
19889: {{ZER{PRSTD{{{CLEAR FLAG
19890: {{EXI{{{{RETURN
19891: {{ENP{{{{END PROCEDURE PRTPS
19892: {{EJC{{{{
19893: *
19894: * PRTSN -- PRINT STATEMENT NUMBER
19895: *
19896: * PRTSN IS USED TO INITIATE A PRINT TRACE LINE BY PRINTING
19897: * ASTERISKS AND THE CURRENT STATEMENT NUMBER. THE ACTUAL
19898: * FORMAT OF THE OUTPUT GENERATED IS.
19899: *
19900: * ***NNNNN**** III.....IIII
19901: *
19902: * NNNNN IS THE STATEMENT NUMBER WITH LEADING ZEROS REPLACED
19903: * BY ASTERISKS (E.G. *******9****)
19904: *
19905: * III...III REPRESENTS A VARIABLE LENGTH OUTPUT CONSISTING
19906: * OF A NUMBER OF LETTER I CHARACTERS EQUAL TO FNCLEVEL.
19907: *
19908: * JSR PRTSN CALL TO PRINT STATEMENT NUMBER
19909: * (WC) DESTROYED
19910: *
19911: {PRTSN{PRC{E{0{{ENTRY POINT
19912: {{MOV{R9{-(SP){{SAVE ENTRY XR
19913: {{MOV{R6{PRSNA{{SAVE ENTRY WA
19914: {{MOV{#TMASB{R9{{POINT TO ASTERISKS
19915: {{JSR{PRTST{{{PRINT ASTERISKS
19916: {{MOV{#NUM04{PROFS{{POINT INTO MIDDLE OF ASTERISKS
19917: {{MTI{KVSTN{{{LOAD STATEMENT NUMBER AS INTEGER
19918: {{JSR{PRTIN{{{PRINT INTEGER STATEMENT NUMBER
19919: {{MOV{#PRSNF{PROFS{{POINT PAST ASTERISKS PLUS BLANK
19920: {{MOV{KVFNC{R9{{GET FNCLEVEL
19921: {{MOV{#CH$LI{R6{{SET LETTER I
19922: *
19923: * LOOP TO GENERATE LETTER I FNCLEVEL TIMES
19924: *
19925: {PRSN1{BZE{R9{PRSN2{{JUMP IF ALL SET
19926: {{JSR{PRTCH{{{ELSE PRINT AN I
19927: {{DCV{R9{{{DECREMENT COUNTER
19928: {{BRN{PRSN1{{{LOOP BACK
19929: *
19930: * MERRE WITH ALL LETTER I CHARACTERS GENERATED
19931: *
19932: {PRSN2{MOV{#CH$BL{R6{{GET BLANK
19933: {{JSR{PRTCH{{{PRINT BLANK
19934: {{MOV{PRSNA{R6{{RESTORE ENTRY WA
19935: {{MOV{(SP)+{R9{{RESTORE ENTRY XR
19936: {{EXI{{{{RETURN TO PRTSN CALLER
19937: {{ENP{{{{END PROCEDURE PRTSN
19938: {{EJC{{{{
19939: *
19940: * PRTST -- PRINT STRING
19941: *
19942: * PRTST PLACES A STRING OF CHARACTERS IN THE PRINT BUFFER
19943: *
19944: * SEE PRTNL FOR GLOBAL LOCATIONS USED
19945: *
19946: * NOTE THAT THE FIRST WORD OF THE BLOCK (NORMALLY B$SCL)
19947: * IS NOT USED AND NEED NOT BE SET CORRECTLY (SEE PRTVN)
19948: *
19949: * (XR) STRING TO BE PRINTED
19950: * JSR PRTST CALL TO PRINT STRING
19951: * (PROFS) UPDATED PAST CHARS PLACED
19952: *
19953: {PRTST{PRC{R{0{{ENTRY POINT
19954: {{BNZ{HEADP{PRST0{{WERE HEADERS PRINTED
19955: {{JSR{PRTPS{{{NO - PRINT THEM
19956: *
19957: * CALL SYSPR
19958: *
19959: {PRST0{MOV{R6{PRSVA{{SAVE WA
19960: {{MOV{R7{PRSVB{{SAVE WB
19961: {{ZER{R7{{{SET CHARS PRINTED COUNT TO ZERO
19962: *
19963: * LOOP TO PRINT SUCCESSIVE LINES FOR LONG STRING
19964: *
19965: {PRST1{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH
19966: {{SUB{R7{R6{{SUBTRACT COUNT OF CHARS ALREADY OUT
19967: {{BZE{R6{PRST4{{JUMP TO EXIT IF NONE LEFT
19968: {{MOV{R10{-(SP){{ELSE STACK ENTRY XL
19969: {{MOV{R9{-(SP){{SAVE ARGUMENT
19970: {{MOV{R9{R10{{COPY FOR EVENTUAL MOVE
19971: {{MOV{PRLEN{R9{{LOAD PRINT BUFFER LENGTH
19972: {{SUB{PROFS{R9{{GET CHARS LEFT IN PRINT BUFFER
19973: {{BNZ{R9{PRST2{{SKIP IF ROOM LEFT ON THIS LINE
19974: {{JSR{PRTNL{{{ELSE PRINT THIS LINE
19975: {{MOV{PRLEN{R9{{AND SET FULL WIDTH AVAILABLE
19976: {{EJC{{{{
19977: *
19978: * PRTST (CONTINUED)
19979: *
19980: * HERE WITH CHARS TO PRINT AND SOME ROOM IN BUFFER
19981: *
19982: {PRST2{BLO{R6{R9{PRST3{JUMP IF ROOM FOR REST OF STRING
19983: {{MOV{R9{R6{{ELSE SET TO FILL LINE
19984: *
19985: * MERGE HERE WITH CHARACTER COUNT IN WA
19986: *
19987: {PRST3{MOV{PRBUF{R9{{POINT TO PRINT BUFFER
19988: {{PLC{R10{R7{{POINT TO LOCATION IN STRING
19989: {{PSC{R9{PROFS{{POINT TO LOCATION IN BUFFER
19990: {{ADD{R6{R7{{BUMP STRING CHARS COUNT
19991: {{ADD{R6{PROFS{{BUMP BUFFER POINTER
19992: {{MOV{R7{PRSVC{{PRESERVE CHAR COUNTER
19993: {{MVC{{{{MOVE CHARACTERS TO BUFFER
19994: {{MOV{PRSVC{R7{{RECOVER CHAR COUNTER
19995: {{MOV{(SP)+{R9{{RESTORE ARGUMENT POINTER
19996: {{MOV{(SP)+{R10{{RESTORE ENTRY XL
19997: {{BRN{PRST1{{{LOOP BACK TO TEST FOR MORE
19998: *
19999: * HERE TO EXIT AFTER PRINTING STRING
20000: *
20001: {PRST4{MOV{PRSVB{R7{{RESTORE ENTRY WB
20002: {{MOV{PRSVA{R6{{RESTORE ENTRY WA
20003: {{EXI{{{{RETURN TO PRTST CALLER
20004: {{ENP{{{{END PROCEDURE PRTST
20005: {{EJC{{{{
20006: *
20007: * PRTTR -- PRINT TO TERMINAL
20008: *
20009: * CALLED TO PRINT CONTENTS OF STANDARD PRINT BUFFER TO
20010: * ONLINE TERMINAL. CLEARS BUFFER DOWN AND RESETS PROFS.
20011: *
20012: * JSR PRTTR CALL FOR PRINT
20013: * (WA,WB) DESTROYED
20014: *
20015: {PRTTR{PRC{E{0{{ENTRY POINT
20016: {{MOV{R9{-(SP){{SAVE XR
20017: {{JSR{PRTIC{{{PRINT BUFFER CONTENTS
20018: {{MOV{PRBUF{R9{{POINT TO PRINT BFR TO CLEAR IT
20019: {{LCT{R6{PRLNW{{GET BUFFER LENGTH
20020: {{ADD{#4*SCHAR{R9{{POINT PAST SCBLK HEADER
20021: {{MOV{NULLW{R7{{GET BLANKS
20022: *
20023: * LOOP TO CLEAR BUFFER
20024: *
20025: {PRTT1{MOV{R7{(R9)+{{CLEAR A WORD
20026: {{BCT{R6{PRTT1{{LOOP
20027: {{ZER{PROFS{{{RESET PROFS
20028: {{MOV{(SP)+{R9{{RESTORE XR
20029: {{EXI{{{{RETURN
20030: {{ENP{{{{END PROCEDURE PRTTR
20031: {{EJC{{{{
20032: *
20033: * PRTVL -- PRINT A VALUE
20034: *
20035: * PRTVL PLACES AN APPROPRIATE CHARACTER REPRESENTATION OF
20036: * A DATA VALUE IN THE PRINT BUFFER FOR DUMP/TRACE USE.
20037: *
20038: * (XR) VALUE TO BE PRINTED
20039: * JSR PRTVL CALL TO PRINT VALUE
20040: * (WA,WB,WC,RA) DESTROYED
20041: *
20042: {PRTVL{PRC{R{0{{ENTRY POINT, RECURSIVE
20043: {{MOV{R10{-(SP){{SAVE ENTRY XL
20044: {{MOV{R9{-(SP){{SAVE ARGUMENT
20045: {{CHK{{{{CHECK FOR STACK OVERFLOW
20046: *
20047: * LOOP BACK HERE AFTER FINDING A TRAP BLOCK (TRBLK)
20048: *
20049: {PRV01{MOV{4*IDVAL(R9){PRVSI{{COPY IDVAL (IF ANY)
20050: {{MOV{(R9){R10{{LOAD FIRST WORD OF BLOCK
20051: {{LEI{R10{{{LOAD ENTRY POINT ID
20052: {{BSW{R10{BL$$T{PRV02{SWITCH ON BLOCK TYPE
20053: {{IFF{BL$AR{PRV05{{ARBLK
20054: {{IFF{BL$BC{PRV15{{BCBLK
20055: {{IFF{DUMMY{PRV02{{
20056: {{IFF{DUMMY{PRV02{{
20057: {{IFF{BL$IC{PRV08{{ICBLK
20058: {{IFF{BL$NM{PRV09{{NMBLK
20059: {{IFF{DUMMY{PRV02{{
20060: {{IFF{DUMMY{PRV02{{
20061: {{IFF{DUMMY{PRV02{{
20062: {{IFF{BL$RC{PRV08{{RCBLK
20063: {{IFF{BL$SC{PRV11{{SCBLK
20064: {{IFF{BL$SE{PRV12{{SEBLK
20065: {{IFF{BL$TB{PRV13{{TBBLK
20066: {{IFF{BL$VC{PRV13{{VCBLK
20067: {{IFF{DUMMY{PRV02{{
20068: {{IFF{DUMMY{PRV02{{
20069: {{IFF{BL$PD{PRV10{{PDBLK
20070: {{IFF{BL$TR{PRV04{{TRBLK
20071: {{ESW{{{{END OF SWITCH ON BLOCK TYPE
20072: *
20073: * HERE FOR BLOCKS FOR WHICH WE JUST PRINT DATATYPE NAME
20074: *
20075: {PRV02{JSR{DTYPE{{{GET DATATYPE NAME
20076: {{JSR{PRTST{{{PRINT DATATYPE NAME
20077: *
20078: * COMMON EXIT POINT
20079: *
20080: {PRV03{MOV{(SP)+{R9{{RELOAD ARGUMENT
20081: {{MOV{(SP)+{R10{{RESTORE XL
20082: {{EXI{{{{RETURN TO PRTVL CALLER
20083: *
20084: * HERE FOR TRBLK
20085: *
20086: {PRV04{MOV{4*TRVAL(R9){R9{{LOAD REAL VALUE
20087: {{BRN{PRV01{{{AND LOOP BACK
20088: {{EJC{{{{
20089: *
20090: * PRTVL (CONTINUED)
20091: *
20092: * HERE FOR ARRAY (ARBLK)
20093: *
20094: * PRINT ARRAY ( PROTOTYPE ) BLANK NUMBER IDVAL
20095: *
20096: {PRV05{MOV{R9{R10{{PRESERVE ARGUMENT
20097: {{MOV{#SCARR{R9{{POINT TO DATATYPE NAME (ARRAY)
20098: {{JSR{PRTST{{{PRINT IT
20099: {{MOV{#CH$PP{R6{{LOAD LEFT PAREN
20100: {{JSR{PRTCH{{{PRINT LEFT PAREN
20101: {{ADD{4*AROFS(R10){R10{{POINT TO PROTOTYPE
20102: {{MOV{(R10){R9{{LOAD PROTOTYPE
20103: {{JSR{PRTST{{{PRINT PROTOTYPE
20104: *
20105: * VCBLK, TBBLK, BCBLK MERGE HERE FOR ) BLANK NUMBER IDVAL
20106: *
20107: {PRV06{MOV{#CH$RP{R6{{LOAD RIGHT PAREN
20108: {{JSR{PRTCH{{{PRINT RIGHT PAREN
20109: *
20110: * PDBLK MERGES HERE TO PRINT BLANK NUMBER IDVAL
20111: *
20112: {PRV07{MOV{#CH$BL{R6{{LOAD BLANK
20113: {{JSR{PRTCH{{{PRINT IT
20114: {{MOV{#CH$NM{R6{{LOAD NUMBER SIGN
20115: {{JSR{PRTCH{{{PRINT IT
20116: {{MTI{PRVSI{{{GET IDVAL
20117: {{JSR{PRTIN{{{PRINT ID NUMBER
20118: {{BRN{PRV03{{{BACK TO EXIT
20119: *
20120: * HERE FOR INTEGER (ICBLK), REAL (RCBLK)
20121: *
20122: * PRINT CHARACTER REPRESENTATION OF VALUE
20123: *
20124: {PRV08{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG
20125: {{JSR{GTSTG{{{CONVERT TO STRING
20126: {{PPM{{{{ERROR RETURN IS IMPOSSIBLE
20127: {{JSR{PRTST{{{PRINT THE STRING
20128: {{MOV{R9{DNAMP{{DELETE GARBAGE STRING FROM STORAGE
20129: {{BRN{PRV03{{{BACK TO EXIT
20130: {{EJC{{{{
20131: *
20132: * PRTVL (CONTINUED)
20133: *
20134: * NAME (NMBLK)
20135: *
20136: * FOR PSEUDO-VARIABLE, JUST PRINT DATATYPE NAME (NAME)
20137: * FOR ALL OTHER NAMES, PRINT DOT FOLLOWED BY NAME REP
20138: *
20139: {PRV09{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE
20140: {{MOV{(R10){R6{{LOAD FIRST WORD OF BLOCK
20141: {{BEQ{R6{#B$KVT{PRV02{JUST PRINT NAME IF KEYWORD
20142: {{BEQ{R6{#B$EVT{PRV02{JUST PRINT NAME IF EXPRESSION VAR
20143: {{MOV{#CH$DT{R6{{ELSE GET DOT
20144: {{JSR{PRTCH{{{AND PRINT IT
20145: {{MOV{4*NMOFS(R9){R6{{LOAD NAME OFFSET
20146: {{JSR{PRTNM{{{PRINT NAME
20147: {{BRN{PRV03{{{BACK TO EXIT
20148: *
20149: * PROGRAM DATATYPE (PDBLK)
20150: *
20151: * PRINT DATATYPE NAME CH$BL CH$NM IDVAL
20152: *
20153: {PRV10{JSR{DTYPE{{{GET DATATYPE NAME
20154: {{JSR{PRTST{{{PRINT DATATYPE NAME
20155: {{BRN{PRV07{{{MERGE BACK TO PRINT ID
20156: *
20157: * HERE FOR STRING (SCBLK)
20158: *
20159: * PRINT QUOTE STRING-CHARACTERS QUOTE
20160: *
20161: {PRV11{MOV{#CH$SQ{R6{{LOAD SINGLE QUOTE
20162: {{JSR{PRTCH{{{PRINT QUOTE
20163: {{JSR{PRTST{{{PRINT STRING VALUE
20164: {{JSR{PRTCH{{{PRINT ANOTHER QUOTE
20165: {{BRN{PRV03{{{BACK TO EXIT
20166: {{EJC{{{{
20167: *
20168: * PRTVL (CONTINUED)
20169: *
20170: * HERE FOR SIMPLE EXPRESSION (SEBLK)
20171: *
20172: * PRINT ASTERISK VARIABLE-NAME
20173: *
20174: {PRV12{MOV{#CH$AS{R6{{LOAD ASTERISK
20175: {{JSR{PRTCH{{{PRINT ASTERISK
20176: {{MOV{4*SEVAR(R9){R9{{LOAD VARIABLE POINTER
20177: {{JSR{PRTVN{{{PRINT VARIABLE NAME
20178: {{BRN{PRV03{{{JUMP BACK TO EXIT
20179: *
20180: * HERE FOR TABLE (TBBLK) AND ARRAY (VCBLK)
20181: *
20182: * PRINT DATATYPE ( PROTOTYPE ) BLANK NUMBER IDVAL
20183: *
20184: {PRV13{MOV{R9{R10{{PRESERVE ARGUMENT
20185: {{JSR{DTYPE{{{GET DATATYPE NAME
20186: {{JSR{PRTST{{{PRINT DATATYPE NAME
20187: {{MOV{#CH$PP{R6{{LOAD LEFT PAREN
20188: {{JSR{PRTCH{{{PRINT LEFT PAREN
20189: {{MOV{4*TBLEN(R10){R6{{LOAD LENGTH OF BLOCK (=VCLEN)
20190: {{BTW{R6{{{CONVERT TO WORD COUNT
20191: {{SUB{#TBSI${R6{{ALLOW FOR STANDARD FIELDS
20192: {{BEQ{(R10){#B$TBT{PRV14{JUMP IF TABLE
20193: {{ADD{#VCTBD{R6{{FOR VCBLK, ADJUST SIZE
20194: *
20195: * PRINT PROTOTYPE
20196: *
20197: {PRV14{MTI{R6{{{MOVE AS INTEGER
20198: {{JSR{PRTIN{{{PRINT INTEGER PROTOTYPE
20199: {{BRN{PRV06{{{MERGE BACK FOR REST
20200: {{EJC{{{{
20201: *
20202: * PRTVL (CONTINUED)
20203: *
20204: * HERE FOR BUFFER (BCBLK)
20205: *
20206: {PRV15{MOV{R9{R10{{PRESERVE ARGUMENT
20207: {{MOV{#SCBUF{R9{{POINT TO DATATYPE NAME (BUFFER)
20208: {{JSR{PRTST{{{PRINT IT
20209: {{MOV{#CH$PP{R6{{LOAD LEFT PAREN
20210: {{JSR{PRTCH{{{PRINT LEFT PAREN
20211: {{MOV{4*BCBUF(R10){R9{{POINT TO BFBLK
20212: {{MTI{4*BFALC(R9){{{LOAD ALLOCATION SIZE
20213: {{JSR{PRTIN{{{PRINT IT
20214: {{MOV{#CH$CM{R6{{LOAD COMMA
20215: {{JSR{PRTCH{{{PRINT IT
20216: {{MTI{4*BCLEN(R10){{{LOAD DEFINED LENGTH
20217: {{JSR{PRTIN{{{PRINT IT
20218: {{BRN{PRV06{{{MERGE TO FINISH UP
20219: {{ENP{{{{END PROCEDURE PRTVL
20220: {{EJC{{{{
20221: *
20222: * PRTVN -- PRINT NATURAL VARIABLE NAME
20223: *
20224: * PRTVN PRINTS THE NAME OF A NATURAL VARIABLE
20225: *
20226: * (XR) POINTER TO VRBLK
20227: * JSR PRTVN CALL TO PRINT VARIABLE NAME
20228: *
20229: {PRTVN{PRC{E{0{{ENTRY POINT
20230: {{MOV{R9{-(SP){{STACK VRBLK POINTER
20231: {{ADD{#4*VRSOF{R9{{POINT TO POSSIBLE STRING NAME
20232: {{BNZ{4*SCLEN(R9){PRVN1{{JUMP IF NOT SYSTEM VARIABLE
20233: {{MOV{4*VRSVO(R9){R9{{POINT TO SVBLK WITH NAME
20234: *
20235: * MERGE HERE WITH DUMMY SCBLK POINTER IN XR
20236: *
20237: {PRVN1{JSR{PRTST{{{PRINT STRING NAME OF VARIABLE
20238: {{MOV{(SP)+{R9{{RESTORE VRBLK POINTER
20239: {{EXI{{{{RETURN TO PRTVN CALLER
20240: {{ENP{{{{END PROCEDURE PRTVN
20241: {{EJC{{{{
20242: *
20243: * RCBLD -- BUILD A REAL BLOCK
20244: *
20245: * (RA) REAL VALUE FOR RCBLK
20246: * JSR RCBLD CALL TO BUILD REAL BLOCK
20247: * (XR) POINTER TO RESULT RCBLK
20248: * (WA) DESTROYED
20249: *
20250: {RCBLD{PRC{E{0{{ENTRY POINT
20251: {{MOV{DNAMP{R9{{LOAD POINTER TO NEXT AVAILABLE LOC
20252: {{ADD{#4*RCSI${R9{{POINT PAST NEW RCBLK
20253: {{BLO{R9{DNAME{RCBL1{JUMP IF THERE IS ROOM
20254: {{MOV{#4*RCSI${R6{{ELSE LOAD RCBLK LENGTH
20255: {{JSR{ALLOC{{{USE STANDARD ALLOCATOR TO GET BLOCK
20256: {{ADD{R6{R9{{POINT PAST BLOCK TO MERGE
20257: *
20258: * MERGE HERE WITH XR POINTING PAST THE BLOCK OBTAINED
20259: *
20260: {RCBL1{MOV{R9{DNAMP{{SET NEW POINTER
20261: {{SUB{#4*RCSI${R9{{POINT BACK TO START OF BLOCK
20262: {{MOV{#B$RCL{(R9){{STORE TYPE WORD
20263: {{STR{4*RCVAL(R9){{{STORE REAL VALUE IN RCBLK
20264: {{EXI{{{{RETURN TO RCBLD CALLER
20265: {{ENP{{{{END PROCEDURE RCBLD
20266: {{EJC{{{{
20267: *
20268: * READR -- READ NEXT SOURCE IMAGE AT COMPILE TIME
20269: *
20270: * READR IS USED TO READ THE NEXT SOURCE IMAGE. TO PROCESS
20271: * CONTINUATION CARDS PROPERLY, THE COMPILER MUST READ ONE
20272: * LINE AHEAD. THUS READR DOES NOT DESTROY THE CURRENT IMAGE
20273: * SEE ALSO THE NEXTS ROUTINE WHICH ACTUALLY GETS THE IMAGE.
20274: *
20275: * JSR READR CALL TO READ NEXT IMAGE
20276: * (XR) PTR TO NEXT IMAGE (0 IF NONE)
20277: * (R$CNI) COPY OF POINTER
20278: * (WA,WB,WC,XL) DESTROYED
20279: *
20280: {READR{PRC{E{0{{ENTRY POINT
20281: {{MOV{R$CNI{R9{{GET PTR TO NEXT IMAGE
20282: {{BNZ{R9{READ3{{EXIT IF ALREADY READ
20283: {{BNE{STAGE{#STGIC{READ3{EXIT IF NOT INITIAL COMPILE
20284: {{MOV{CSWIN{R6{{MAX READ LENGTH
20285: {{JSR{ALOCS{{{ALLOCATE BUFFER
20286: {{JSR{SYSRD{{{READ INPUT IMAGE
20287: {{PPM{READ4{{{JUMP IF END OF FILE
20288: {{MNZ{R7{{{SET TRIMR TO PERFORM TRIM
20289: {{BLE{4*SCLEN(R9){CSWIN{READ1{USE SMALLER OF STRING LNTH ..
20290: {{MOV{CSWIN{4*SCLEN(R9){{... AND XXX OF -INXXX
20291: *
20292: * PERFORM THE TRIM
20293: *
20294: {READ1{JSR{TRIMR{{{TRIM TRAILING BLANKS
20295: *
20296: * MERGE HERE AFTER READ
20297: *
20298: {READ2{MOV{R9{R$CNI{{STORE COPY OF POINTER
20299: *
20300: * MERGE HERE IF NO READ ATTEMPTED
20301: *
20302: {READ3{EXI{{{{RETURN TO READR CALLER
20303: *
20304: * HERE ON END OF FILE
20305: *
20306: {READ4{MOV{R9{DNAMP{{POP UNUSED SCBLK
20307: {{ZER{R9{{{ZERO PTR AS RESULT
20308: {{BRN{READ2{{{MERGE
20309: {{ENP{{{{END PROCEDURE READR
20310: {{EJC{{{{
20311: *
20312: * SBSTR -- BUILD A SUBSTRING
20313: *
20314: * (XL) PTR TO SCBLK/BFBLK WITH CHARS
20315: * (WA) NUMBER OF CHARS IN SUBSTRING
20316: * (WB) OFFSET TO FIRST CHAR IN SCBLK
20317: * JSR SBSTR CALL TO BUILD SUBSTRING
20318: * (XR) PTR TO NEW SCBLK WITH SUBSTRING
20319: * (XL) ZERO
20320: * (WA,WB,WC,XL,IA) DESTROYED
20321: *
20322: * NOTE THAT SBSTR IS CALLED WITH A DUMMY STRING POINTER
20323: * (POINTING INTO A VRBLK OR SVBLK) TO COPY THE NAME OF A
20324: * VARIABLE AS A STANDARD STRING VALUE.
20325: *
20326: {SBSTR{PRC{E{0{{ENTRY POINT
20327: {{BZE{R6{SBST2{{JUMP IF NULL SUBSTRING
20328: {{JSR{ALOCS{{{ELSE ALLOCATE SCBLK
20329: {{MOV{R8{R6{{MOVE NUMBER OF CHARACTERS
20330: {{MOV{R9{R8{{SAVE PTR TO NEW SCBLK
20331: {{PLC{R10{R7{{PREPARE TO LOAD CHARS FROM OLD BLK
20332: {{PSC{R9{{{PREPARE TO STORE CHARS IN NEW BLK
20333: {{MVC{{{{MOVE CHARACTERS TO NEW STRING
20334: {{MOV{R8{R9{{THEN RESTORE SCBLK POINTER
20335: *
20336: * RETURN POINT
20337: *
20338: {SBST1{ZER{R10{{{CLEAR GARBAGE POINTER IN XL
20339: {{EXI{{{{RETURN TO SBSTR CALLER
20340: *
20341: * HERE FOR NULL SUBSTRING
20342: *
20343: {SBST2{MOV{#NULLS{R9{{SET NULL STRING AS RESULT
20344: {{BRN{SBST1{{{RETURN
20345: {{ENP{{{{END PROCEDURE SBSTR
20346: {{EJC{{{{
20347: *
20348: * SCANE -- SCAN AN ELEMENT
20349: *
20350: * SCANE IS CALLED AT COMPILE TIME (BY EXPAN ,CMPIL,CNCRD)
20351: * TO SCAN ONE ELEMENT FROM THE INPUT IMAGE.
20352: *
20353: * (SCNCC) NON-ZERO IF CALLED FROM CNCRD
20354: * JSR SCANE CALL TO SCAN ELEMENT
20355: * (XR) RESULT POINTER (SEE BELOW)
20356: * (XL) SYNTAX TYPE CODE (T$XXX)
20357: *
20358: * THE FOLLOWING GLOBAL LOCATIONS ARE USED.
20359: *
20360: * R$CIM POINTER TO STRING BLOCK (SCBLK)
20361: * FOR CURRENT INPUT IMAGE.
20362: *
20363: * R$CNI POINTER TO NEXT INPUT IMAGE STRING
20364: * POINTER (ZERO IF NONE).
20365: *
20366: * R$SCP SAVE POINTER (EXIT XR) FROM LAST
20367: * CALL IN CASE RESCAN IS SET.
20368: *
20369: * SCNBL THIS LOCATION IS SET NON-ZERO ON
20370: * EXIT IF SCANE SCANNED PAST BLANKS
20371: * BEFORE LOCATING THE CURRENT ELEMENT
20372: * THE END OF A LINE COUNTS AS BLANKS.
20373: *
20374: * SCNCC CNCRD SETS THIS NON-ZERO TO SCAN
20375: * CONTROL CARD NAMES AND CLEARS IT
20376: * ON RETURN
20377: *
20378: * SCNIL LENGTH OF CURRENT INPUT IMAGE
20379: *
20380: * SCNGO IF SET NON-ZERO ON ENTRY, F AND S
20381: * ARE RETURNED AS SEPARATE SYNTAX
20382: * TYPES (NOT LETTERS) (GOTO PRO-
20383: * CESSING). SCNGO IS RESET ON EXIT.
20384: *
20385: * SCNPT OFFSET TO CURRENT LOC IN R$CIM
20386: *
20387: * SCNRS IF SET NON-ZERO ON ENTRY, SCANE
20388: * RETURNS THE SAME RESULT AS ON THE
20389: * LAST CALL (RESCAN). SCNRS IS RESET
20390: * ON EXIT FROM ANY CALL TO SCANE.
20391: *
20392: * SCNTP SAVE SYNTAX TYPE FROM LAST
20393: * CALL (IN CASE RESCAN IS SET).
20394: {{EJC{{{{
20395: *
20396: * SCANE (CONTINUED)
20397: *
20398: *
20399: *
20400: * ELEMENT SCANNED XL XR
20401: * --------------- -- --
20402: *
20403: * CONTROL CARD NAME 0 POINTER TO SCBLK FOR NAME
20404: *
20405: * UNARY OPERATOR T$UOP PTR TO OPERATOR DVBLK
20406: *
20407: * LEFT PAREN T$LPR T$LPR
20408: *
20409: * LEFT BRACKET T$LBR T$LBR
20410: *
20411: * COMMA T$CMA T$CMA
20412: *
20413: * FUNCTION CALL T$FNC PTR TO FUNCTION VRBLK
20414: *
20415: * VARIABLE T$VAR PTR TO VRBLK
20416: *
20417: * STRING CONSTANT T$CON PTR TO SCBLK
20418: *
20419: * INTEGER CONSTANT T$CON PTR TO ICBLK
20420: *
20421: * REAL CONSTANT T$CON PTR TO RCBLK
20422: *
20423: * BINARY OPERATOR T$BOP PTR TO OPERATOR DVBLK
20424: *
20425: * RIGHT PAREN T$RPR T$RPR
20426: *
20427: * RIGHT BRACKET T$RBR T$RBR
20428: *
20429: * COLON T$COL T$COL
20430: *
20431: * SEMI-COLON T$SMC T$SMC
20432: *
20433: * F (SCNGO NE 0) T$FGO T$FGO
20434: *
20435: * S (SCNGO NE 0) T$SGO T$SGO
20436: {{EJC{{{{
20437: *
20438: * SCANE (CONTINUED)
20439: *
20440: * ENTRY POINT
20441: *
20442: {SCANE{PRC{E{0{{ENTRY POINT
20443: {{ZER{SCNBL{{{RESET BLANKS FLAG
20444: {{MOV{R6{SCNSA{{SAVE WA
20445: {{MOV{R7{SCNSB{{SAVE WB
20446: {{MOV{R8{SCNSC{{SAVE WC
20447: {{BZE{SCNRS{SCN03{{JUMP IF NO RESCAN
20448: *
20449: * HERE FOR RESCAN REQUEST
20450: *
20451: {{MOV{SCNTP{R10{{SET PREVIOUS RETURNED SCAN TYPE
20452: {{MOV{R$SCP{R9{{SET PREVIOUS RETURNED POINTER
20453: {{ZER{SCNRS{{{RESET RESCAN SWITCH
20454: {{BRN{SCN13{{{JUMP TO EXIT
20455: *
20456: * COME HERE TO READ NEW IMAGE TO TEST FOR CONTINUATION
20457: *
20458: {SCN01{JSR{READR{{{READ NEXT IMAGE
20459: {{MOV{#4*DVUBS{R7{{SET WB FOR NOT READING NAME
20460: {{BZE{R9{SCN30{{TREAT AS SEMI-COLON IF NONE
20461: {{PLC{R9{{{ELSE POINT TO FIRST CHARACTER
20462: {{LCH{R8{(R9){{LOAD FIRST CHARACTER
20463: {{BEQ{R8{#CH$DT{SCN02{JUMP IF DOT FOR CONTINUATION
20464: {{BNE{R8{#CH$PL{SCN30{ELSE TREAT AS SEMICOLON UNLESS PLUS
20465: *
20466: * HERE FOR CONTINUATION LINE
20467: *
20468: {SCN02{JSR{NEXTS{{{ACQUIRE NEXT SOURCE IMAGE
20469: {{MOV{#NUM01{SCNPT{{SET SCAN POINTER PAST CONTINUATION
20470: {{MNZ{SCNBL{{{SET BLANKS FLAG
20471: {{EJC{{{{
20472: *
20473: * SCANE (CONTINUED)
20474: *
20475: * MERGE HERE TO SCAN NEXT ELEMENT ON CURRENT LINE
20476: *
20477: {SCN03{MOV{SCNPT{R6{{LOAD CURRENT OFFSET
20478: {{BEQ{R6{SCNIL{SCN01{CHECK CONTINUATION IF END
20479: {{MOV{R$CIM{R10{{POINT TO CURRENT LINE
20480: {{PLC{R10{R6{{POINT TO CURRENT CHARACTER
20481: {{MOV{R6{SCNSE{{SET START OF ELEMENT LOCATION
20482: {{MOV{#OPDVS{R8{{POINT TO OPERATOR DV LIST
20483: {{MOV{#4*DVUBS{R7{{SET CONSTANT FOR OPERATOR CIRCUIT
20484: {{BRN{SCN06{{{START SCANNING
20485: *
20486: * LOOP HERE TO IGNORE LEADING BLANKS AND TABS
20487: *
20488: {SCN05{BZE{R7{SCN10{{JUMP IF TRAILING
20489: {{ICV{SCNSE{{{INCREMENT START OF ELEMENT
20490: {{BEQ{R6{SCNIL{SCN01{JUMP IF END OF IMAGE
20491: {{MNZ{SCNBL{{{NOTE BLANKS SEEN
20492: *
20493: * THE FOLLOWING JUMP IS USED REPEATEDLY FOR SCANNING OUT
20494: * THE CHARACTERS OF A NUMERIC CONSTANT OR VARIABLE NAME.
20495: * THE REGISTERS ARE USED AS FOLLOWS.
20496: *
20497: * (XR) SCRATCH
20498: * (XL) PTR TO NEXT CHARACTER
20499: * (WA) CURRENT SCAN OFFSET
20500: * (WB) *DVUBS (0 IF SCANNING NAME,CONST)
20501: * (WC) =OPDVS (0 IF SCANNING CONSTANT)
20502: *
20503: {SCN06{LCH{R9{(R10)+{{GET NEXT CHARACTER
20504: {{ICV{R6{{{BUMP SCAN OFFSET
20505: {{MOV{R6{SCNPT{{STORE OFFSET PAST CHAR SCANNED
20506: {{BLO{#CFP$U{R9{SCN07{QUICK CHECK FOR OTHER CHAR
20507: {{BSW{R9{CFP$U{SCN07{SWITCH ON SCANNED CHARACTER
20508: *
20509: * SWITCH TABLE FOR SWITCH ON CHARACTER
20510: *
20511: {{EJC{{{{
20512: *
20513: * SCANE (CONTINUED)
20514: *
20515: {{EJC{{{{
20516: *
20517: * SCANE (CONTINUED)
20518: *
20519: {{IFF{DUMMY{SCN07{{
20520: {{IFF{DUMMY{SCN07{{
20521: {{IFF{DUMMY{SCN07{{
20522: {{IFF{DUMMY{SCN07{{
20523: {{IFF{DUMMY{SCN07{{
20524: {{IFF{DUMMY{SCN07{{
20525: {{IFF{DUMMY{SCN07{{
20526: {{IFF{DUMMY{SCN07{{
20527: {{IFF{DUMMY{SCN07{{
20528: {{IFF{CH$HT{SCN05{{HORIZONTAL TAB
20529: {{IFF{DUMMY{SCN07{{
20530: {{IFF{DUMMY{SCN07{{
20531: {{IFF{DUMMY{SCN07{{
20532: {{IFF{DUMMY{SCN07{{
20533: {{IFF{DUMMY{SCN07{{
20534: {{IFF{DUMMY{SCN07{{
20535: {{IFF{DUMMY{SCN07{{
20536: {{IFF{DUMMY{SCN07{{
20537: {{IFF{DUMMY{SCN07{{
20538: {{IFF{DUMMY{SCN07{{
20539: {{IFF{DUMMY{SCN07{{
20540: {{IFF{DUMMY{SCN07{{
20541: {{IFF{DUMMY{SCN07{{
20542: {{IFF{DUMMY{SCN07{{
20543: {{IFF{DUMMY{SCN07{{
20544: {{IFF{DUMMY{SCN07{{
20545: {{IFF{DUMMY{SCN07{{
20546: {{IFF{DUMMY{SCN07{{
20547: {{IFF{DUMMY{SCN07{{
20548: {{IFF{DUMMY{SCN07{{
20549: {{IFF{DUMMY{SCN07{{
20550: {{IFF{DUMMY{SCN07{{
20551: {{IFF{CH$BL{SCN05{{BLANK
20552: {{IFF{CH$EX{SCN37{{EXCLAMATION MARK
20553: {{IFF{CH$DQ{SCN17{{DOUBLE QUOTE
20554: {{IFF{CH$NM{SCN41{{NUMBER SIGN
20555: {{IFF{CH$DL{SCN36{{DOLLAR
20556: {{IFF{CH$PC{SCN38{{PERCENT
20557: {{IFF{CH$AM{SCN44{{AMPERSAND
20558: {{IFF{CH$SQ{SCN16{{SINGLE QUOTE
20559: {{IFF{CH$PP{SCN25{{LEFT PAREN
20560: {{IFF{CH$RP{SCN26{{RIGHT PAREN
20561: {{IFF{CH$AS{SCN49{{ASTERISK
20562: {{IFF{CH$PL{SCN33{{PLUS
20563: {{IFF{CH$CM{SCN31{{COMMA
20564: {{IFF{CH$MN{SCN34{{MINUS
20565: {{IFF{CH$DT{SCN32{{DOT
20566: {{IFF{CH$SL{SCN40{{SLASH
20567: {{IFF{CH$D0{SCN08{{DIGIT 0
20568: {{IFF{CH$D1{SCN08{{DIGIT 1
20569: {{IFF{CH$D2{SCN08{{DIGIT 2
20570: {{IFF{CH$D3{SCN08{{DIGIT 3
20571: {{IFF{CH$D4{SCN08{{DIGIT 4
20572: {{IFF{CH$D5{SCN08{{DIGIT 5
20573: {{IFF{CH$D6{SCN08{{DIGIT 6
20574: {{IFF{CH$D7{SCN08{{DIGIT 7
20575: {{IFF{CH$D8{SCN08{{DIGIT 8
20576: {{IFF{CH$D9{SCN08{{DIGIT 9
20577: {{IFF{CH$CL{SCN29{{COLON
20578: {{IFF{CH$SM{SCN30{{SEMI-COLON
20579: {{IFF{CH$BB{SCN28{{LEFT BRACKET
20580: {{IFF{CH$EQ{SCN46{{EQUAL
20581: {{IFF{CH$RB{SCN27{{RIGHT BRACKET
20582: {{IFF{CH$QU{SCN45{{QUESTION MARK
20583: {{IFF{CH$AT{SCN42{{AT
20584: {{IFF{CH$LA{SCN09{{LETTER A
20585: {{IFF{CH$LB{SCN09{{LETTER B
20586: {{IFF{CH$LC{SCN09{{LETTER C
20587: {{IFF{CH$LD{SCN09{{LETTER D
20588: {{IFF{CH$LE{SCN09{{LETTER E
20589: {{IFF{CH$LF{SCN20{{LETTER F
20590: {{IFF{CH$LG{SCN09{{LETTER G
20591: {{IFF{CH$LH{SCN09{{LETTER H
20592: {{IFF{CH$LI{SCN09{{LETTER I
20593: {{IFF{CH$LJ{SCN09{{LETTER J
20594: {{IFF{CH$LK{SCN09{{LETTER K
20595: {{IFF{CH$LL{SCN09{{LETTER L
20596: {{IFF{CH$LM{SCN09{{LETTER M
20597: {{IFF{CH$LN{SCN09{{LETTER N
20598: {{IFF{CH$LO{SCN09{{LETTER O
20599: {{IFF{CH$LP{SCN09{{LETTER P
20600: {{IFF{CH$LQ{SCN09{{LETTER Q
20601: {{IFF{CH$LR{SCN09{{LETTER R
20602: {{IFF{CH$LS{SCN21{{LETTER S
20603: {{IFF{CH$LT{SCN09{{LETTER T
20604: {{IFF{CH$LU{SCN09{{LETTER U
20605: {{IFF{CH$LV{SCN09{{LETTER V
20606: {{IFF{CH$LW{SCN09{{LETTER W
20607: {{IFF{CH$LX{SCN09{{LETTER X
20608: {{IFF{CH$LY{SCN09{{LETTER Y
20609: {{IFF{CH$L${SCN09{{LETTER Z
20610: {{IFF{CH$OB{SCN28{{LEFT BRACKET
20611: {{IFF{DUMMY{SCN07{{
20612: {{IFF{CH$CB{SCN27{{RIGHT BRACKET
20613: {{IFF{DUMMY{SCN07{{
20614: {{IFF{CH$UN{SCN24{{UNDERLINE
20615: {{IFF{DUMMY{SCN07{{
20616: {{IFF{CH$$A{SCN09{{SHIFTED A
20617: {{IFF{CH$$B{SCN09{{SHIFTED B
20618: {{IFF{CH$$C{SCN09{{SHIFTED C
20619: {{IFF{CH$$D{SCN09{{SHIFTED D
20620: {{IFF{CH$$E{SCN09{{SHIFTED E
20621: {{IFF{CH$$F{SCN20{{SHIFTED F
20622: {{IFF{CH$$G{SCN09{{SHIFTED G
20623: {{IFF{CH$$H{SCN09{{SHIFTED H
20624: {{IFF{CH$$I{SCN09{{SHIFTED I
20625: {{IFF{CH$$J{SCN09{{SHIFTED J
20626: {{IFF{CH$$K{SCN09{{SHIFTED K
20627: {{IFF{CH$$L{SCN09{{SHIFTED L
20628: {{IFF{CH$$M{SCN09{{SHIFTED M
20629: {{IFF{CH$$N{SCN09{{SHIFTED N
20630: {{IFF{CH$$O{SCN09{{SHIFTED O
20631: {{IFF{CH$$P{SCN09{{SHIFTED P
20632: {{IFF{CH$$Q{SCN09{{SHIFTED Q
20633: {{IFF{CH$$R{SCN09{{SHIFTED R
20634: {{IFF{CH$$S{SCN21{{SHIFTED S
20635: {{IFF{CH$$T{SCN09{{SHIFTED T
20636: {{IFF{CH$$U{SCN09{{SHIFTED U
20637: {{IFF{CH$$V{SCN09{{SHIFTED V
20638: {{IFF{CH$$W{SCN09{{SHIFTED W
20639: {{IFF{CH$$X{SCN09{{SHIFTED X
20640: {{IFF{CH$$Y{SCN09{{SHIFTED Y
20641: {{IFF{CH$$${SCN09{{SHIFTED Z
20642: {{IFF{DUMMY{SCN07{{
20643: {{IFF{CH$BR{SCN43{{VERTICAL BAR
20644: {{IFF{DUMMY{SCN07{{
20645: {{IFF{CH$NT{SCN35{{NOT
20646: {{IFF{DUMMY{SCN07{{
20647: {{ESW{{{{END SWITCH ON CHARACTER
20648: *
20649: * HERE FOR ILLEGAL CHARACTER (UNDERLINE MERGES)
20650: *
20651: {SCN07{BZE{R7{SCN10{{JUMP IF SCANNING NAME OR CONSTANT
20652: {{ERB{230{SYNTAX{{ERROR. ILLEGAL CHARACTER
20653: {{EJC{{{{
20654: *
20655: * SCANE (CONTINUED)
20656: *
20657: * HERE FOR DIGITS 0-9
20658: *
20659: {SCN08{BZE{R7{SCN09{{KEEP SCANNING IF NAME/CONSTANT
20660: {{ZER{R8{{{ELSE SET FLAG FOR SCANNING CONSTANT
20661: *
20662: * HERE FOR LETTER. LOOP HERE WHEN SCANNING NAME/CONSTANT
20663: *
20664: {SCN09{BEQ{R6{SCNIL{SCN11{JUMP IF END OF IMAGE
20665: {{ZER{R7{{{SET FLAG FOR SCANNING NAME/CONST
20666: {{BRN{SCN06{{{MERGE BACK TO CONTINUE SCAN
20667: *
20668: * COME HERE FOR DELIMITER ENDING NAME OR CONSTANT
20669: *
20670: {SCN10{DCV{R6{{{RESET OFFSET TO POINT TO DELIMITER
20671: *
20672: * COME HERE AFTER FINISHING SCAN OF NAME OR CONSTANT
20673: *
20674: {SCN11{MOV{R6{SCNPT{{STORE UPDATED SCAN OFFSET
20675: {{MOV{SCNSE{R7{{POINT TO START OF ELEMENT
20676: {{SUB{R7{R6{{GET NUMBER OF CHARACTERS
20677: {{MOV{R$CIM{R10{{POINT TO LINE IMAGE
20678: {{BNZ{R8{SCN15{{JUMP IF NAME
20679: *
20680: * HERE AFTER SCANNING OUT NUMERIC CONSTANT
20681: *
20682: {{JSR{SBSTR{{{GET STRING FOR CONSTANT
20683: {{MOV{R9{DNAMP{{DELETE FROM STORAGE (NOT NEEDED)
20684: {{JSR{GTNUM{{{CONVERT TO NUMERIC
20685: {{PPM{SCN14{{{JUMP IF CONVERSION FAILURE
20686: *
20687: * MERGE HERE TO EXIT WITH CONSTANT
20688: *
20689: {SCN12{MOV{#T$CON{R10{{SET RESULT TYPE OF CONSTANT
20690: {{EJC{{{{
20691: *
20692: * SCANE (CONTINUED)
20693: *
20694: * COMMON EXIT POINT (XR,XL) SET
20695: *
20696: {SCN13{MOV{SCNSA{R6{{RESTORE WA
20697: {{MOV{SCNSB{R7{{RESTORE WB
20698: {{MOV{SCNSC{R8{{RESTORE WC
20699: {{MOV{R9{R$SCP{{SAVE XR IN CASE RESCAN
20700: {{MOV{R10{SCNTP{{SAVE XL IN CASE RESCAN
20701: {{ZER{SCNGO{{{RESET POSSIBLE GOTO FLAG
20702: {{EXI{{{{RETURN TO SCANE CALLER
20703: *
20704: * HERE IF CONVERSION ERROR ON NUMERIC ITEM
20705: *
20706: {SCN14{ERB{231{SYNTAX{{ERROR. INVALID NUMERIC ITEM
20707: *
20708: * HERE AFTER SCANNING OUT VARIABLE NAME
20709: *
20710: {SCN15{JSR{SBSTR{{{BUILD STRING NAME OF VARIABLE
20711: {{BNZ{SCNCC{SCN13{{RETURN IF CNCRD CALL
20712: {{JSR{GTNVR{{{LOCATE/BUILD VRBLK
20713: {{PPM{{{{DUMMY (UNUSED) ERROR RETURN
20714: {{MOV{#T$VAR{R10{{SET TYPE AS VARIABLE
20715: {{BRN{SCN13{{{BACK TO EXIT
20716: *
20717: * HERE FOR SINGLE QUOTE (START OF STRING CONSTANT)
20718: *
20719: {SCN16{BZE{R7{SCN10{{TERMINATOR IF SCANNING NAME OR CNST
20720: {{MOV{#CH$SQ{R7{{SET TERMINATOR AS SINGLE QUOTE
20721: {{BRN{SCN18{{{MERGE
20722: *
20723: * HERE FOR DOUBLE QUOTE (START OF STRING CONSTANT)
20724: *
20725: {SCN17{BZE{R7{SCN10{{TERMINATOR IF SCANNING NAME OR CNST
20726: {{MOV{#CH$DQ{R7{{SET DOUBLE QUOTE TERMINATOR, MERGE
20727: *
20728: * LOOP TO SCAN OUT STRING CONSTANT
20729: *
20730: {SCN18{BEQ{R6{SCNIL{SCN19{ERROR IF END OF IMAGE
20731: {{LCH{R8{(R10)+{{ELSE LOAD NEXT CHARACTER
20732: {{ICV{R6{{{BUMP OFFSET
20733: {{BNE{R8{R7{SCN18{LOOP BACK IF NOT TERMINATOR
20734: {{EJC{{{{
20735: *
20736: * SCANE (CONTINUED)
20737: *
20738: * HERE AFTER SCANNING OUT STRING CONSTANT
20739: *
20740: {{MOV{SCNPT{R7{{POINT TO FIRST CHARACTER
20741: {{MOV{R6{SCNPT{{SAVE OFFSET PAST FINAL QUOTE
20742: {{DCV{R6{{{POINT BACK PAST LAST CHARACTER
20743: {{SUB{R7{R6{{GET NUMBER OF CHARACTERS
20744: {{MOV{R$CIM{R10{{POINT TO INPUT IMAGE
20745: {{JSR{SBSTR{{{BUILD SUBSTRING VALUE
20746: {{BRN{SCN12{{{BACK TO EXIT WITH CONSTANT RESULT
20747: *
20748: * HERE IF NO MATCHING QUOTE FOUND
20749: *
20750: {SCN19{MOV{R6{SCNPT{{SET UPDATED SCAN POINTER
20751: {{ERB{232{SYNTAX{{ERROR. UNMATCHED STRING QUOTE
20752: *
20753: * HERE FOR F (POSSIBLE FAILURE GOTO)
20754: *
20755: {SCN20{MOV{#T$FGO{R9{{SET RETURN CODE FOR FAIL GOTO
20756: {{BRN{SCN22{{{JUMP TO MERGE
20757: *
20758: * HERE FOR S (POSSIBLE SUCCESS GOTO)
20759: *
20760: {SCN21{MOV{#T$SGO{R9{{SET SUCCESS GOTO AS RETURN CODE
20761: *
20762: * SPECIAL GOTO CASES MERGE HERE
20763: *
20764: {SCN22{BZE{SCNGO{SCN09{{TREAT AS NORMAL LETTER IF NOT GOTO
20765: *
20766: * MERGE HERE FOR SPECIAL CHARACTER EXIT
20767: *
20768: {SCN23{BZE{R7{SCN10{{JUMP IF END OF NAME/CONSTANT
20769: {{MOV{R9{R10{{ELSE COPY CODE
20770: {{BRN{SCN13{{{AND JUMP TO EXIT
20771: *
20772: * HERE FOR UNDERLINE
20773: *
20774: {SCN24{BZE{R7{SCN09{{PART OF NAME IF SCANNING NAME
20775: {{BRN{SCN07{{{ELSE ILLEGAL
20776: {{EJC{{{{
20777: *
20778: * SCANE (CONTINUED)
20779: *
20780: * HERE FOR LEFT PAREN
20781: *
20782: {SCN25{MOV{#T$LPR{R9{{SET LEFT PAREN RETURN CODE
20783: {{BNZ{R7{SCN23{{RETURN LEFT PAREN UNLESS NAME
20784: {{BZE{R8{SCN10{{DELIMITER IF SCANNING CONSTANT
20785: *
20786: * HERE FOR LEFT PAREN AFTER NAME (FUNCTION CALL)
20787: *
20788: {{MOV{SCNSE{R7{{POINT TO START OF NAME
20789: {{MOV{R6{SCNPT{{SET POINTER PAST LEFT PAREN
20790: {{DCV{R6{{{POINT BACK PAST LAST CHAR OF NAME
20791: {{SUB{R7{R6{{GET NAME LENGTH
20792: {{MOV{R$CIM{R10{{POINT TO INPUT IMAGE
20793: {{JSR{SBSTR{{{GET STRING NAME FOR FUNCTION
20794: {{JSR{GTNVR{{{LOCATE/BUILD VRBLK
20795: {{PPM{{{{DUMMY (UNUSED) ERROR RETURN
20796: {{MOV{#T$FNC{R10{{SET CODE FOR FUNCTION CALL
20797: {{BRN{SCN13{{{BACK TO EXIT
20798: *
20799: * PROCESSING FOR SPECIAL CHARACTERS
20800: *
20801: {SCN26{MOV{#T$RPR{R9{{RIGHT PAREN, SET CODE
20802: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
20803: *
20804: {SCN27{MOV{#T$RBR{R9{{RIGHT BRACKET, SET CODE
20805: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
20806: *
20807: {SCN28{MOV{#T$LBR{R9{{LEFT BRACKET, SET CODE
20808: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
20809: *
20810: {SCN29{MOV{#T$COL{R9{{COLON, SET CODE
20811: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
20812: *
20813: {SCN30{MOV{#T$SMC{R9{{SEMI-COLON, SET CODE
20814: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
20815: *
20816: {SCN31{MOV{#T$CMA{R9{{COMMA, SET CODE
20817: {{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
20818: {{EJC{{{{
20819: *
20820: * SCANE (CONTINUED)
20821: *
20822: * HERE FOR OPERATORS. ON ENTRY, WC POINTS TO THE TABLE OF
20823: * OPERATOR DOPE VECTORS AND WB IS THE INCREMENT TO STEP
20824: * TO THE NEXT PAIR (BINARY/UNARY) OF DOPE VECTORS IN THE
20825: * LIST. ON REACHING SCN46, THE POINTER HAS BEEN ADJUSTED TO
20826: * POINT TO THE APPROPRIATE PAIR OF DOPE VECTORS.
20827: * THE FIRST THREE ENTRIES ARE SPECIAL SINCE THEY CAN OCCUR
20828: * AS PART OF A VARIABLE NAME (.) OR CONSTANT (.+-).
20829: *
20830: {SCN32{BZE{R7{SCN09{{DOT CAN BE PART OF NAME OR CONSTANT
20831: {{ADD{R7{R8{{ELSE BUMP POINTER
20832: *
20833: {SCN33{BZE{R8{SCN09{{PLUS CAN BE PART OF CONSTANT
20834: {{BZE{R7{SCN48{{PLUS CANNOT BE PART OF NAME
20835: {{ADD{R7{R8{{ELSE BUMP POINTER
20836: *
20837: {SCN34{BZE{R8{SCN09{{MINUS CAN BE PART OF CONSTANT
20838: {{BZE{R7{SCN48{{MINUS CANNOT BE PART OF NAME
20839: {{ADD{R7{R8{{ELSE BUMP POINTER
20840: *
20841: {SCN35{ADD{R7{R8{{NOT
20842: {SCN36{ADD{R7{R8{{DOLLAR
20843: {SCN37{ADD{R7{R8{{EXCLAMATION
20844: {SCN38{ADD{R7{R8{{PERCENT
20845: {SCN39{ADD{R7{R8{{ASTERISK
20846: {SCN40{ADD{R7{R8{{SLASH
20847: {SCN41{ADD{R7{R8{{NUMBER SIGN
20848: {SCN42{ADD{R7{R8{{AT SIGN
20849: {SCN43{ADD{R7{R8{{VERTICAL BAR
20850: {SCN44{ADD{R7{R8{{AMPERSAND
20851: {SCN45{ADD{R7{R8{{QUESTION MARK
20852: *
20853: * ALL OPERATORS COME HERE (EQUAL MERGES DIRECTLY)
20854: * (WC) POINTS TO THE BINARY/UNARY PAIR OF OPERATOR DVBLKS.
20855: *
20856: {SCN46{BZE{R7{SCN10{{OPERATOR TERMINATES NAME/CONSTANT
20857: {{MOV{R8{R9{{ELSE COPY DV POINTER
20858: {{LCH{R8{(R10){{LOAD NEXT CHARACTER
20859: {{MOV{#T$BOP{R10{{SET BINARY OP IN CASE
20860: {{BEQ{R6{SCNIL{SCN47{SHOULD BE BINARY IF IMAGE END
20861: {{BEQ{R8{#CH$BL{SCN47{SHOULD BE BINARY IF FOLLOWED BY BLK
20862: {{BEQ{R8{#CH$HT{SCN47{JUMP IF HORIZONTAL TAB
20863: {{BEQ{R8{#CH$SM{SCN47{SEMICOLON CAN IMMEDIATELY FOLLOW =
20864: *
20865: * HERE FOR UNARY OPERATOR
20866: *
20867: {{ADD{#4*DVBS${R9{{POINT TO DV FOR UNARY OP
20868: {{MOV{#T$UOP{R10{{SET TYPE FOR UNARY OPERATOR
20869: {{BLE{SCNTP{#T$UOK{SCN13{OK UNARY IF OK PRECEDING ELEMENT
20870: {{EJC{{{{
20871: *
20872: * SCANE (CONTINUED)
20873: *
20874: * MERGE HERE TO REQUIRE PRECEDING BLANKS
20875: *
20876: {SCN47{BNZ{SCNBL{SCN13{{ALL OK IF PRECEDING BLANKS, EXIT
20877: *
20878: * FAIL OPERATOR IN THIS POSITION
20879: *
20880: {SCN48{ERB{233{SYNTAX{{ERROR. INVALID USE OF OPERATOR
20881: *
20882: * HERE FOR ASTERISK, COULD BE ** SUBSTITUTE FOR EXCLAMATION
20883: *
20884: {SCN49{BZE{R7{SCN10{{END OF NAME IF SCANNING NAME
20885: {{BEQ{R6{SCNIL{SCN39{NOT ** IF * AT IMAGE END
20886: {{MOV{R6{R9{{ELSE SAVE OFFSET PAST FIRST *
20887: {{MOV{R6{SCNOF{{SAVE ANOTHER COPY
20888: {{LCH{R6{(R10)+{{LOAD NEXT CHARACTER
20889: {{BNE{R6{#CH$AS{SCN50{NOT ** IF NEXT CHAR NOT *
20890: {{ICV{R9{{{ELSE STEP OFFSET PAST SECOND *
20891: {{BEQ{R9{SCNIL{SCN51{OK EXCLAM IF END OF IMAGE
20892: {{LCH{R6{(R10){{ELSE LOAD NEXT CHARACTER
20893: {{BEQ{R6{#CH$BL{SCN51{EXCLAMATION IF BLANK
20894: {{BEQ{R6{#CH$HT{SCN51{EXCLAMATION IF HORIZONTAL TAB
20895: *
20896: * UNARY *
20897: *
20898: {SCN50{MOV{SCNOF{R6{{RECOVER STORED OFFSET
20899: {{MOV{R$CIM{R10{{POINT TO LINE AGAIN
20900: {{PLC{R10{R6{{POINT TO CURRENT CHAR
20901: {{BRN{SCN39{{{MERGE WITH UNARY *
20902: *
20903: * HERE FOR ** AS SUBSTITUTE FOR EXCLAMATION
20904: *
20905: {SCN51{MOV{R9{SCNPT{{SAVE SCAN POINTER PAST 2ND *
20906: {{MOV{R9{R6{{COPY SCAN POINTER
20907: {{BRN{SCN37{{{MERGE WITH EXCLAMATION
20908: {{ENP{{{{END PROCEDURE SCANE
20909: {{EJC{{{{
20910: *
20911: * SCNGF -- SCAN GOTO FIELD
20912: *
20913: * SCNGF IS CALLED FROM CMPIL TO SCAN AND ANALYZE A GOTO
20914: * FIELD INCLUDING THE SURROUNDING BRACKETS OR PARENTHESES.
20915: * FOR A NORMAL GOTO, THE RESULT RETURNED IS EITHER A VRBLK
20916: * POINTER FOR A SIMPLE LABEL OPERAND, OR A POINTER TO AN
20917: * EXPRESSION TREE WITH A SPECIAL OUTER UNARY OPERATOR
20918: * (O$GOC). FOR A DIRECT GOTO, THE RESULT RETURNED IS A
20919: * POINTER TO AN EXPRESSION TREE WITH THE SPECIAL OUTER
20920: * UNARY OPERATOR O$GOD.
20921: *
20922: * JSR SCNGF CALL TO SCAN GOTO FIELD
20923: * (XR) RESULT (SEE ABOVE)
20924: * (XL,WA,WB,WC) DESTROYED
20925: *
20926: {SCNGF{PRC{E{0{{ENTRY POINT
20927: {{JSR{SCANE{{{SCAN INITIAL ELEMENT
20928: {{BEQ{R10{#T$LPR{SCNG1{SKIP IF LEFT PAREN (NORMAL GOTO)
20929: {{BEQ{R10{#T$LBR{SCNG2{SKIP IF LEFT BRACKET (DIRECT GOTO)
20930: {{ERB{234{SYNTAX{{ERROR. GOTO FIELD INCORRECT
20931: *
20932: * HERE FOR LEFT PAREN (NORMAL GOTO)
20933: *
20934: {SCNG1{MOV{#NUM01{R7{{SET EXPAN FLAG FOR NORMAL GOTO
20935: {{JSR{EXPAN{{{ANALYZE GOTO FIELD
20936: {{MOV{#OPDVN{R6{{POINT TO OPDV FOR COMPLEX GOTO
20937: {{BLE{R9{STATB{SCNG3{JUMP IF NOT IN STATIC (SGD15)
20938: {{BLO{R9{STATE{SCNG4{JUMP TO EXIT IF SIMPLE LABEL NAME
20939: {{BRN{SCNG3{{{COMPLEX GOTO - MERGE
20940: *
20941: * HERE FOR LEFT BRACKET (DIRECT GOTO)
20942: *
20943: {SCNG2{MOV{#NUM02{R7{{SET EXPAN FLAG FOR DIRECT GOTO
20944: {{JSR{EXPAN{{{SCAN GOTO FIELD
20945: {{MOV{#OPDVD{R6{{SET OPDV POINTER FOR DIRECT GOTO
20946: {{EJC{{{{
20947: *
20948: * SCNGF (CONTINUED)
20949: *
20950: * MERGE HERE TO BUILD OUTER UNARY OPERATOR BLOCK
20951: *
20952: {SCNG3{MOV{R6{-(SP){{STACK OPERATOR DV POINTER
20953: {{MOV{R9{-(SP){{STACK POINTER TO EXPRESSION TREE
20954: {{JSR{EXPOP{{{POP OPERATOR OFF
20955: {{MOV{(SP)+{R9{{RELOAD NEW EXPRESSION TREE POINTER
20956: *
20957: * COMMON EXIT POINT
20958: *
20959: {SCNG4{EXI{{{{RETURN TO CALLER
20960: {{ENP{{{{END PROCEDURE SCNGF
20961: {{EJC{{{{
20962: *
20963: * SETVR -- SET VRGET,VRSTO FIELDS OF VRBLK
20964: *
20965: * SETVR SETS THE PROPER VALUES IN THE VRGET AND VRSTO
20966: * FIELDS OF A VRBLK. IT IS CALLED WHENEVER TRBLKS ARE
20967: * ADDED OR SUBTRACTED (TRACE,STOPTR,INPUT,OUTPUT,DETACH)
20968: *
20969: * (XR) POINTER TO VRBLK
20970: * JSR SETVR CALL TO SET FIELDS
20971: * (XL,WA) DESTROYED
20972: *
20973: * NOTE THAT SETVR IGNORES THE CALL IF XR DOES NOT POINT
20974: * INTO THE STATIC REGION (I.E. IS SOME OTHER NAME BASE)
20975: *
20976: {SETVR{PRC{E{0{{ENTRY POINT
20977: {{BHI{R9{STATE{SETV1{EXIT IF NOT NATURAL VARIABLE
20978: *
20979: * HERE IF WE HAVE A VRBLK
20980: *
20981: {{MOV{R9{R10{{COPY VRBLK POINTER
20982: {{MOV{#B$VRL{4*VRGET(R9){{STORE NORMAL GET VALUE
20983: {{BEQ{4*VRSTO(R9){#B$VRE{SETV1{SKIP IF PROTECTED VARIABLE
20984: {{MOV{#B$VRS{4*VRSTO(R9){{STORE NORMAL STORE VALUE
20985: {{MOV{4*VRVAL(R10){R10{{POINT TO NEXT ENTRY ON CHAIN
20986: {{BNE{(R10){#B$TRT{SETV1{JUMP IF END OF TRBLK CHAIN
20987: {{MOV{#B$VRA{4*VRGET(R9){{STORE TRAPPED ROUTINE ADDRESS
20988: {{MOV{#B$VRV{4*VRSTO(R9){{SET TRAPPED ROUTINE ADDRESS
20989: *
20990: * MERGE HERE TO EXIT TO CALLER
20991: *
20992: {SETV1{EXI{{{{RETURN TO SETVR CALLER
20993: {{ENP{{{{END PROCEDURE SETVR
20994: {{EJC{{{{
20995: *
20996: * SORTA -- SORT ARRAY
20997: *
20998: * ROUTINE TO SORT AN ARRAY OR TABLE ON SAME BASIS AS IN
20999: * SITBOL. A TABLE IS CONVERTED TO AN ARRAY, LEAVING TWO
21000: * DIMENSIONAL ARRAYS AND VECTORS AS CASES TO BE CONSIDERED.
21001: * WHOLE ROWS OF ARRAYS ARE PERMUTED ACCORDING TO THE
21002: * ORDERING OF THE KEYS THEY CONTAIN, AND THE STRIDE
21003: * REFERRED TO, IS THE THE LENGTH OF A ROW. IT IS ONE
21004: * FOR A VECTOR.
21005: * THE SORT USED IS HEAPSORT, FUNDAMENTALS OF DATA STRUCTURE
21006: * HOROWITZ AND SAHNI, PITMAN 1977, PAGE 347.
21007: * IT IS AN ORDER N*LOG(N) ALGORITHM. IN ORDER
21008: * TO MAKE IT STABLE, COMPARANDS MAY NOT COMPARE EQUAL. THIS
21009: * IS ACHIEVED BY SORTING A COPY ARRAY (REFERRED TO AS THE
21010: * SORT ARRAY) CONTAINING AT ITS HIGH ADDRESS END, BYTE
21011: * OFFSETS TO THE ROWS TO BE SORTED HELD IN THE ORIGINAL
21012: * ARRAY (REFERRED TO AS THE KEY ARRAY). SORTC, THE
21013: * COMPARISON ROUTINE, ACCESSES THE KEYS THROUGH THESE
21014: * OFFSETS AND IN THE CASE OF EQUALITY, RESOLVES IT BY
21015: * COMPARING THE OFFSETS THEMSELVES. THE SORT PERMUTES THE
21016: * OFFSETS WHICH ARE THEN USED IN A FINAL OPERATION TO COPY
21017: * THE ACTUAL ITEMS INTO THE NEW ARRAY IN SORTED ORDER.
21018: * REFERENCES TO ZEROTH ITEM ARE TO NOTIONAL ITEM
21019: * PRECEDING FIRST ACTUAL ITEM.
21020: * REVERSE SORTING FOR RSORT IS DONE BY HAVING THE LESS THAN
21021: * TEST FOR KEYS EFFECTIVELY BE REPLACED BY A
21022: * GREATER THAN TEST.
21023: *
21024: * 1(XS) FIRST ARG - ARRAY OR TABLE
21025: * 0(XS) 2ND ARG - INDEX OR PDTYPE NAME
21026: * (WA) 0 , NON-ZERO FOR SORT , RSORT
21027: * JSR SORTA CALL TO SORT ARRAY
21028: * (XR) SORTED ARRAY
21029: * (XL,WA,WB,WC) DESTROYED
21030: {{EJC{{{{
21031: *
21032: * SORTA (CONTINUED)
21033: *
21034: {SORTA{PRC{N{0{{ENTRY POINT
21035: {{MOV{R6{SRTSR{{SORT/RSORT INDICATOR
21036: {{MOV{#4*NUM01{SRTST{{DEFAULT STRIDE OF 1
21037: {{ZER{SRTOF{{{DEFAULT ZERO OFFSET TO SORT KEY
21038: {{MOV{#NULLS{SRTDF{{CLEAR DATATYPE FIELD NAME
21039: {{MOV{(SP)+{R$SXR{{UNSTACK ARGUMENT 2
21040: {{MOV{(SP)+{R9{{GET FIRST ARGUMENT
21041: {{JSR{GTARR{{{CONVERT TO ARRAY
21042: {{PPM{SRT16{{{FAIL
21043: {{MOV{R9{-(SP){{STACK PTR TO RESULTING KEY ARRAY
21044: {{MOV{R9{-(SP){{ANOTHER COPY FOR COPYB
21045: {{JSR{COPYB{{{GET COPY ARRAY FOR SORTING INTO
21046: {{PPM{{{{CANT FAIL
21047: {{MOV{R9{-(SP){{STACK POINTER TO SORT ARRAY
21048: {{MOV{R$SXR{R9{{GET SECOND ARG
21049: {{MOV{4*1(SP){R10{{GET PTR TO KEY ARRAY
21050: {{BNE{(R10){#B$VCT{SRT02{JUMP IF ARBLK
21051: {{BEQ{R9{#NULLS{SRT01{JUMP IF NULL SECOND ARG
21052: {{JSR{GTNVR{{{GET VRBLK PTR FOR IT
21053: {{ERR{257{ERRONEOUS{{2ND ARG IN SORT/RSORT OF VECTOR
21054: {{MOV{R9{SRTDF{{STORE DATATYPE FIELD NAME VRBLK
21055: *
21056: * COMPUTE N AND OFFSET TO ITEM A(0) IN VECTOR CASE
21057: *
21058: {SRT01{MOV{#4*VCLEN{R8{{OFFSET TO A(0)
21059: {{MOV{#4*VCVLS{R7{{OFFSET TO FIRST ITEM
21060: {{MOV{4*VCLEN(R10){R6{{GET BLOCK LENGTH
21061: {{SUB{#4*VCSI${R6{{GET NO. OF ENTRIES, N (IN BYTES)
21062: {{BRN{SRT04{{{MERGE
21063: *
21064: * HERE FOR ARRAY
21065: *
21066: {SRT02{LDI{4*ARDIM(R10){{{GET POSSIBLE DIMENSION
21067: {{MFI{R6{{{CONVERT TO SHORT INTEGER
21068: {{WTB{R6{{{FURTHER CONVERT TO BAUS
21069: {{MOV{#4*ARVLS{R7{{OFFSET TO FIRST VALUE IF ONE
21070: {{MOV{#4*ARPRO{R8{{OFFSET BEFORE VALUES IF ONE DIM.
21071: {{BEQ{4*ARNDM(R10){#NUM01{SRT04{JUMP IN FACT IF ONE DIM.
21072: {{BNE{4*ARNDM(R10){#NUM02{SRT16{FAIL UNLESS TWO DIMENS
21073: {{LDI{4*ARLB2(R10){{{GET LOWER BOUND 2 AS DEFAULT
21074: {{BEQ{R9{#NULLS{SRT03{JUMP IF DEFAULT SECOND ARG
21075: {{JSR{GTINT{{{CONVERT TO INTEGER
21076: {{PPM{SRT17{{{FAIL
21077: {{LDI{4*ICVAL(R9){{{GET ACTUAL INTEGER VALUE
21078: {{EJC{{{{
21079: *
21080: * SORTA (CONTINUED)
21081: *
21082: * HERE WITH SORT COLUMN INDEX IN IA IN ARRAY CASE
21083: *
21084: {SRT03{SBI{4*ARLB2(R10){{{SUBTRACT LOW BOUND
21085: {{IOV{SRT17{{{FAIL IF OVERFLOW
21086: {{ILT{SRT17{{{FAIL IF BELOW LOW BOUND
21087: {{SBI{4*ARDM2(R10){{{CHECK AGAINST DIMENSION
21088: {{IGE{SRT17{{{FAIL IF TOO LARGE
21089: {{ADI{4*ARDM2(R10){{{RESTORE VALUE
21090: {{MFI{R6{{{GET AS SMALL INTEGER
21091: {{WTB{R6{{{OFFSET WITHIN ROW TO KEY
21092: {{MOV{R6{SRTOF{{KEEP OFFSET
21093: {{LDI{4*ARDM2(R10){{{SECOND DIMENSION IS ROW LENGTH
21094: {{MFI{R6{{{CONVERT TO SHORT INTEGER
21095: {{MOV{R6{R9{{COPY ROW LENGTH
21096: {{WTB{R6{{{CONVERT TO BYTES
21097: {{MOV{R6{SRTST{{STORE AS STRIDE
21098: {{LDI{4*ARDIM(R10){{{GET NUMBER OF ROWS
21099: {{MFI{R6{{{AS A SHORT INTEGER
21100: {{WTB{R6{{{CONVERT N TO BAUS
21101: {{MOV{4*ARLEN(R10){R8{{OFFSET PAST ARRAY END
21102: {{SUB{R6{R8{{ADJUST, GIVING SPACE FOR N OFFSETS
21103: {{DCA{R8{{{POINT TO A(0)
21104: {{MOV{4*AROFS(R10){R7{{OFFSET TO WORD BEFORE FIRST ITEM
21105: {{ICA{R7{{{OFFSET TO FIRST ITEM
21106: *
21107: * SEPARATE PRE-PROCESSING FOR ARRAYS AND VECTORS DONE.
21108: * TO SIMPLIFY LATER KEY COMPARISONS, REMOVAL OF ANY TRBLK
21109: * TRAP BLOCKS FROM ENTRIES IN KEY ARRAY IS EFFECTED.
21110: *
21111: * (XL) = 1(XS) = POINTER TO KEY ARRAY
21112: * (XS) = POINTER TO SORT ARRAY
21113: * WA = NUMBER OF ITEMS, N (CONVERTED TO BYTES).
21114: * WB = OFFSET TO FIRST ITEM OF ARRAYS.
21115: * WC = OFFSET TO A(0)
21116: *
21117: {SRT04{BLE{R6{#4*NUM01{SRT15{RETURN IF ONLY A SINGLE ITEM
21118: {{MOV{R6{SRTSN{{STORE NUMBER OF ITEMS (IN BAUS)
21119: {{MOV{R8{SRTSO{{STORE OFFSET TO A(0)
21120: {{MOV{4*ARLEN(R10){R8{{LENGTH OF ARRAY OR VEC (=VCLEN)
21121: {{ADD{R10{R8{{POINT PAST END OF ARRAY OR VECTOR
21122: {{MOV{R7{SRTSF{{STORE OFFSET TO FIRST ROW
21123: {{ADD{R7{R10{{POINT TO FIRST ITEM IN KEY ARRAY
21124: *
21125: * LOOP THROUGH ARRAY
21126: *
21127: {SRT05{MOV{(R10){R9{{GET AN ENTRY
21128: *
21129: * HUNT ALONG TRBLK CHAIN
21130: *
21131: {SRT06{BNE{(R9){#B$TRT{SRT07{JUMP OUT IF NOT TRBLK
21132: {{MOV{4*TRVAL(R9){R9{{GET VALUE FIELD
21133: {{BRN{SRT06{{{LOOP
21134: {{EJC{{{{
21135: *
21136: * SORTA (CONTINUED)
21137: *
21138: * XR IS VALUE FROM END OF CHAIN
21139: *
21140: {SRT07{MOV{R9{(R10)+{{STORE AS ARRAY ENTRY
21141: {{BLT{R10{R8{SRT05{LOOP IF NOT DONE
21142: {{MOV{(SP){R10{{GET ADRS OF SORT ARRAY
21143: {{MOV{SRTSF{R9{{INITIAL OFFSET TO FIRST KEY
21144: {{MOV{SRTST{R7{{GET STRIDE
21145: {{ADD{SRTSO{R10{{OFFSET TO A(0)
21146: {{ICA{R10{{{POINT TO A(1)
21147: {{MOV{SRTSN{R8{{GET N
21148: {{BTW{R8{{{CONVERT FROM BYTES
21149: {{MOV{R8{SRTNR{{STORE AS ROW COUNT
21150: {{LCT{R8{R8{{LOOP COUNTER
21151: *
21152: * STORE KEY OFFSETS AT TOP OF SORT ARRAY
21153: *
21154: {SRT08{MOV{R9{(R10)+{{STORE AN OFFSET
21155: {{ADD{R7{R9{{BUMP OFFSET BY STRIDE
21156: {{BCT{R8{SRT08{{LOOP THROUGH ROWS
21157: *
21158: * PERFORM THE SORT ON OFFSETS IN SORT ARRAY.
21159: *
21160: * (SRTSN) NUMBER OF ITEMS TO SORT, N (BYTES)
21161: * (SRTSO) OFFSET TO A(0)
21162: *
21163: {SRT09{MOV{SRTSN{R6{{GET N
21164: {{MOV{SRTNR{R8{{GET NUMBER OF ROWS
21165: {{RSH{R8{1{{I = N / 2 (WC=I, INDEX INTO ARRAY)
21166: {{WTB{R8{{{CONVERT BACK TO BYTES
21167: *
21168: * LOOP TO FORM INITIAL HEAP
21169: *
21170: {SRT10{JSR{SORTH{{{SORTH(I,N)
21171: {{DCA{R8{{{I = I - 1
21172: {{BNZ{R8{SRT10{{LOOP IF I GT 0
21173: {{MOV{R6{R8{{I = N
21174: *
21175: * SORTING LOOP. AT THIS POINT, A(1) IS THE LARGEST
21176: * ITEM, SINCE ALGORITHM INITIALISES IT AS, AND THEN MAINTAI
21177: * IT AS, ROOT OF TREE.
21178: *
21179: {SRT11{DCA{R8{{{I = I - 1 (N - 1 INITIALLY)
21180: {{BZE{R8{SRT12{{JUMP IF DONE
21181: {{MOV{(SP){R9{{GET SORT ARRAY ADDRESS
21182: {{ADD{SRTSO{R9{{POINT TO A(0)
21183: {{MOV{R9{R10{{A(0) ADDRESS
21184: {{ADD{R8{R10{{A(I) ADDRESS
21185: {{MOV{4*1(R10){R7{{COPY A(I+1)
21186: {{MOV{4*1(R9){4*1(R10){{MOVE A(1) TO A(I+1)
21187: {{MOV{R7{4*1(R9){{COMPLETE EXCHANGE OF A(1), A(I+1)
21188: {{MOV{R8{R6{{N = I FOR SORTH
21189: {{MOV{#4*NUM01{R8{{I = 1 FOR SORTH
21190: {{JSR{SORTH{{{SORTH(1,N)
21191: {{MOV{R6{R8{{RESTORE WC
21192: {{BRN{SRT11{{{LOOP
21193: {{EJC{{{{
21194: *
21195: * SORTA (CONTINUED)
21196: *
21197: * OFFSETS HAVE BEEN PERMUTED INTO REQUIRED ORDER BY SORT.
21198: * COPY ARRAY ELEMENTS OVER THEM.
21199: *
21200: {SRT12{MOV{(SP){R10{{BASE ADRS OF KEY ARRAY
21201: {{MOV{R10{R8{{COPY IT
21202: {{ADD{SRTSO{R8{{OFFSET OF A(0)
21203: {{ADD{SRTSF{R10{{ADRS OF FIRST ROW OF SORT ARRAY
21204: {{MOV{SRTST{R7{{GET STRIDE
21205: {{BTW{R7{{{CONVERT TO WORDS
21206: *
21207: * COPYING LOOP FOR SUCCESSIVE ITEMS. SORTED OFFSETS ARE
21208: * HELD AT END OF SORT ARRAY.
21209: *
21210: {SRT13{ICA{R8{{{ADRS OF NEXT OF SORTED OFFSETS
21211: {{MOV{R8{R9{{COPY IT FOR ACCESS
21212: {{MOV{(R9){R9{{GET OFFSET
21213: {{ADD{4*1(SP){R9{{ADD KEY ARRAY BASE ADRS
21214: {{LCT{R6{R7{{GET COUNT OF WORDS IN ROW
21215: *
21216: * COPY A COMPLETE ROW
21217: *
21218: {SRT14{MOV{(R9)+{(R10)+{{MOVE A WORD
21219: {{BCT{R6{SRT14{{LOOP
21220: {{DCV{SRTNR{{{DECREMENT ROW COUNT
21221: {{BNZ{SRTNR{SRT13{{REPEAT TILL ALL ROWS DONE
21222: *
21223: * RETURN POINT
21224: *
21225: {SRT15{MOV{(SP)+{R9{{POP RESULT ARRAY PTR
21226: {{ICA{SP{{{POP KEY ARRAY PTR
21227: {{ZER{R$SXL{{{CLEAR JUNK
21228: {{ZER{R$SXR{{{CLEAR JUNK
21229: {{EXI{{{{RETURN
21230: *
21231: * ERROR POINT
21232: *
21233: {SRT16{ERB{256{SORT/RSORT{{1ST ARG NOT SUITABLE ARRAY OR TABLE
21234: {SRT17{ERB{258{SORT/RSORT{{2ND ARG OUT OF RANGE OR NON-INTEGER
21235: {{ENP{{{{END PROCUDURE SORTA
21236: {{EJC{{{{
21237: *
21238: * SORTC -- COMPARE SORT KEYS
21239: *
21240: * COMPARE TWO SORT KEYS GIVEN THEIR OFFSETS. IF
21241: * EQUAL, COMPARE KEY OFFSETS TO GIVE STABLE SORT.
21242: * NOTE THAT IF SRTSR IS NON-ZERO (REQUEST FOR REVERSE
21243: * SORT), THE QUOTED RETURNS ARE INVERTED.
21244: * FOR OBJECTS OF DIFFERING DATATYPES, THE ENTRY POINT
21245: * IDENTIFICATIONS ARE COMPARED.
21246: *
21247: * (XL) BASE ADRS FOR KEYS
21248: * (WA) OFFSET TO KEY 1 ITEM
21249: * (WB) OFFSET TO KEY 2 ITEM
21250: * (SRTSR) ZERO/NON-ZERO FOR SORT/RSORT
21251: * (SRTOF) OFFSET WITHIN ROW TO COMPARANDS
21252: * JSR SORTC CALL TO COMPARE KEYS
21253: * PPM LOC KEY1 LESS THAN KEY2
21254: * NORMAL RETURN, KEY1 GT THAN KEY2
21255: * (XL,XR,WA,WB) DESTROYED
21256: *
21257: {SORTC{PRC{E{1{{ENTRY POINT
21258: {{MOV{R6{SRTS1{{SAVE OFFSET 1
21259: {{MOV{R7{SRTS2{{SAVE OFFSET 2
21260: {{MOV{R8{SRTSC{{SAVE WC
21261: {{ADD{SRTOF{R10{{ADD OFFSET TO COMPARAND FIELD
21262: {{MOV{R10{R9{{COPY BASE + OFFSET
21263: {{ADD{R6{R10{{ADD KEY1 OFFSET
21264: {{ADD{R7{R9{{ADD KEY2 OFFSET
21265: {{MOV{(R10){R10{{GET KEY1
21266: {{MOV{(R9){R9{{GET KEY2
21267: {{BNE{SRTDF{#NULLS{SRC11{JUMP IF DATATYPE FIELD NAME USED
21268: {{EJC{{{{
21269: *
21270: * SORTC (CONTINUED)
21271: *
21272: * MERGE AFTER DEALING WITH FIELD NAME. TRY FOR STRINGS.
21273: *
21274: {SRC01{MOV{(R10){R8{{GET TYPE CODE
21275: {{BNE{R8{(R9){SRC02{SKIP IF NOT SAME DATATYPE
21276: {{BEQ{R8{#B$SCL{SRC09{JUMP IF BOTH STRINGS
21277: *
21278: * NOW TRY FOR NUMERIC
21279: *
21280: {SRC02{MOV{R10{R$SXL{{KEEP ARG1
21281: {{MOV{R9{R$SXR{{KEEP ARG2
21282: {{MOV{R10{-(SP){{STACK
21283: {{MOV{R9{-(SP){{ARGS
21284: {{JSR{ACOMP{{{COMPARE OBJECTS
21285: {{PPM{SRC10{{{NOT NUMERIC
21286: {{PPM{SRC10{{{NOT NUMERIC
21287: {{PPM{SRC03{{{KEY1 LESS
21288: {{PPM{SRC08{{{KEYS EQUAL
21289: {{PPM{SRC05{{{KEY1 GREATER
21290: *
21291: * RETURN IF KEY1 SMALLER (SORT), GREATER (RSORT)
21292: *
21293: {SRC03{BNZ{SRTSR{SRC06{{JUMP IF RSORT
21294: *
21295: {SRC04{MOV{SRTSC{R8{{RESTORE WC
21296: {{EXI{1{{{RETURN
21297: *
21298: * RETURN IF KEY1 GREATER (SORT), SMALLER (RSORT)
21299: *
21300: {SRC05{BNZ{SRTSR{SRC04{{JUMP IF RSORT
21301: *
21302: {SRC06{MOV{SRTSC{R8{{RESTORE WC
21303: {{EXI{{{{RETURN
21304: *
21305: * KEYS ARE OF SAME DATATYPE
21306: *
21307: {SRC07{BLT{R10{R9{SRC03{ITEM FIRST CREATED IS LESS
21308: {{BGT{R10{R9{SRC05{ADDRESSES RISE IN ORDER OF CREATION
21309: *
21310: * DROP THROUGH OR MERGE FOR IDENTICAL OR EQUAL OBJECTS
21311: *
21312: {SRC08{BLT{SRTS1{SRTS2{SRC04{TEST OFFSETS OR KEY ADDRSS INSTEAD
21313: {{BRN{SRC06{{{OFFSET 1 GREATER
21314: {{EJC{{{{
21315: *
21316: * SORTC (CONTINUED)
21317: *
21318: * STRINGS
21319: *
21320: {SRC09{MOV{R10{-(SP){{STACK
21321: {{MOV{R9{-(SP){{ARGS
21322: {{JSR{LCOMP{{{COMPARE OBJECTS
21323: {{PPM{{{{CANT
21324: {{PPM{{{{FAIL
21325: {{PPM{SRC03{{{KEY1 LESS
21326: {{PPM{SRC08{{{KEYS EQUAL
21327: {{PPM{SRC05{{{KEY1 GREATER
21328: *
21329: * ARITHMETIC COMPARISON FAILED - RECOVER ARGS
21330: *
21331: {SRC10{MOV{R$SXL{R10{{GET ARG1
21332: {{MOV{R$SXR{R9{{GET ARG2
21333: {{MOV{(R10){R8{{GET TYPE OF KEY1
21334: {{BEQ{R8{(R9){SRC07{JUMP IF KEYS OF SAME TYPE
21335: {{MOV{R8{R10{{GET BLOCK TYPE WORD
21336: {{MOV{(R9){R9{{GET BLOCK TYPE WORD
21337: {{LEI{R10{{{ENTRY POINT ID FOR KEY1
21338: {{LEI{R9{{{ENTRY POINT ID FOR KEY2
21339: {{BGT{R10{R9{SRC05{JUMP IF KEY1 GT KEY2
21340: {{BRN{SRC03{{{KEY1 LT KEY2
21341: *
21342: * DATATYPE FIELD NAME USED
21343: *
21344: {SRC11{JSR{SORTF{{{CALL ROUTINE TO FIND FIELD 1
21345: {{MOV{R10{-(SP){{STACK ITEM POINTER
21346: {{MOV{R9{R10{{GET KEY2
21347: {{JSR{SORTF{{{FIND FIELD 2
21348: {{MOV{R10{R9{{PLACE AS KEY2
21349: {{MOV{(SP)+{R10{{RECOVER KEY1
21350: {{BRN{SRC01{{{MERGE
21351: {{ENP{{{{PROCEDURE SORTC
21352: {{EJC{{{{
21353: *
21354: * SORTF -- FIND FIELD FOR SORTC
21355: *
21356: * ROUTINE USED BY SORTC TO OBTAIN ITEM CORRESPONDING
21357: * TO A GIVEN FIELD NAME, IF THIS EXISTS, IN A PROGRAMMER
21358: * DEFINED OBJECT PASSED AS ARGUMENT.
21359: * IF SUCH A MATCH OCCURS, RECORD IS KEPT OF DATATYPE
21360: * NAME, FIELD NAME AND OFFSET TO FIELD IN ORDER TO
21361: * SHORT-CIRCUIT LATER SEARCHES ON SAME TYPE. NOTE THAT
21362: * DFBLKS ARE STORED IN STATIC AND HENCE CANNOT BE MOVED.
21363: *
21364: * (SRTDF) VRBLK POINTER OF FIELD NAME
21365: * (XL) POSSIBLE PDBLK POINTER
21366: * JSR SORTF CALL TO SEARCH FOR FIELD NAME
21367: * (XL) ITEM FOUND OR ORIGINAL PDBLK PTR
21368: * (WC) DESTROYED
21369: *
21370: {SORTF{PRC{E{0{{ENTRY POINT
21371: {{BNE{(R10){#B$PDT{SRTF3{RETURN IF NOT PDBLK
21372: {{MOV{R9{-(SP){{KEEP XR
21373: {{MOV{SRTFD{R9{{GET POSSIBLE FORMER DFBLK PTR
21374: {{BZE{R9{SRTF4{{JUMP IF NOT
21375: {{BNE{R9{4*PDDFP(R10){SRTF4{JUMP IF NOT RIGHT DATATYPE
21376: {{BNE{SRTDF{SRTFF{SRTF4{JUMP IF NOT RIGHT FIELD NAME
21377: {{ADD{SRTFO{R10{{ADD OFFSET TO REQUIRED FIELD
21378: *
21379: * HERE WITH XL POINTING TO FOUND FIELD
21380: *
21381: {SRTF1{MOV{(R10){R10{{GET ITEM FROM FIELD
21382: *
21383: * RETURN POINT
21384: *
21385: {SRTF2{MOV{(SP)+{R9{{RESTORE XR
21386: *
21387: {SRTF3{EXI{{{{RETURN
21388: {{EJC{{{{
21389: *
21390: * SORTF (CONTINUED)
21391: *
21392: * CONDUCT A SEARCH
21393: *
21394: {SRTF4{MOV{R10{R9{{COPY ORIGINAL POINTER
21395: {{MOV{4*PDDFP(R9){R9{{POINT TO DFBLK
21396: {{MOV{R9{SRTFD{{KEEP A COPY
21397: {{MOV{4*FARGS(R9){R8{{GET NUMBER OF FIELDS
21398: {{WTB{R8{{{CONVERT TO BYTES
21399: {{ADD{4*DFLEN(R9){R9{{POINT PAST LAST FIELD
21400: *
21401: * LOOP TO FIND NAME IN PDFBLK
21402: *
21403: {SRTF5{DCA{R8{{{COUNT DOWN
21404: {{DCA{R9{{{POINT IN FRONT
21405: {{BEQ{(R9){SRTDF{SRTF6{SKIP OUT IF FOUND
21406: {{BNZ{R8{SRTF5{{LOOP
21407: {{BRN{SRTF2{{{RETURN - NOT FOUND
21408: *
21409: * FOUND
21410: *
21411: {SRTF6{MOV{(R9){SRTFF{{KEEP FIELD NAME PTR
21412: {{ADD{#4*PDFLD{R8{{ADD OFFSET TO FIRST FIELD
21413: {{MOV{R8{SRTFO{{STORE AS FIELD OFFSET
21414: {{ADD{R8{R10{{POINT TO FIELD
21415: {{BRN{SRTF1{{{RETURN
21416: {{ENP{{{{PROCEDURE SORTF
21417: {{EJC{{{{
21418: *
21419: * SORTH -- HEAP ROUTINE FOR SORTA
21420: *
21421: * THIS ROUTINE CONSTRUCTS A HEAP FROM ELEMENTS OF ARRAY, A.
21422: * IN THIS APPLICATION, THE ELEMENTS ARE OFFSETS TO KEYS IN
21423: * A KEY ARRAY.
21424: *
21425: * (XS) POINTER TO SORT ARRAY BASE
21426: * 1(XS) POINTER TO KEY ARRAY BASE
21427: * (WA) MAX ARRAY INDEX, N (IN BYTES)
21428: * (WC) OFFSET J IN A TO ROOT (IN *1 TO *N)
21429: * JSR SORTH CALL SORTH(J,N) TO MAKE HEAP
21430: * (XL,XR,WB) DESTROYED
21431: *
21432: {SORTH{PRC{N{0{{ENTRY POINT
21433: {{MOV{R6{SRTSN{{SAVE N
21434: {{MOV{R8{SRTWC{{KEEP WC
21435: {{MOV{(SP){R10{{SORT ARRAY BASE ADRS
21436: {{ADD{SRTSO{R10{{ADD OFFSET TO A(0)
21437: {{ADD{R8{R10{{POINT TO A(J)
21438: {{MOV{(R10){SRTRT{{GET OFFSET TO ROOT
21439: {{ADD{R8{R8{{DOUBLE J - CANT EXCEED N
21440: *
21441: * LOOP TO MOVE DOWN TREE USING DOUBLED INDEX J
21442: *
21443: {SRH01{BGT{R8{SRTSN{SRH03{DONE IF J GT N
21444: {{BEQ{R8{SRTSN{SRH02{SKIP IF J EQUALS N
21445: {{MOV{(SP){R9{{SORT ARRAY BASE ADRS
21446: {{MOV{4*1(SP){R10{{KEY ARRAY BASE ADRS
21447: {{ADD{SRTSO{R9{{POINT TO A(0)
21448: {{ADD{R8{R9{{ADRS OF A(J)
21449: {{MOV{4*1(R9){R6{{GET A(J+1)
21450: {{MOV{(R9){R7{{GET A(J)
21451: *
21452: * COMPARE SONS. (WA) RIGHT SON, (WB) LEFT SON
21453: *
21454: {{JSR{SORTC{{{COMPARE KEYS - LT(A(J+1),A(J))
21455: {{PPM{SRH02{{{A(J+1) LT A(J)
21456: {{ICA{R8{{{POINT TO GREATER SON, A(J+1)
21457: {{EJC{{{{
21458: *
21459: * SORTH (CONTINUED)
21460: *
21461: * COMPARE ROOT WITH GREATER SON
21462: *
21463: {SRH02{MOV{4*1(SP){R10{{KEY ARRAY BASE ADRS
21464: {{MOV{(SP){R9{{GET SORT ARRAY ADDRESS
21465: {{ADD{SRTSO{R9{{ADRS OF A(0)
21466: {{MOV{R9{R7{{COPY THIS ADRS
21467: {{ADD{R8{R9{{ADRS OF GREATER SON, A(J)
21468: {{MOV{(R9){R6{{GET A(J)
21469: {{MOV{R7{R9{{POINT BACK TO A(0)
21470: {{MOV{SRTRT{R7{{GET ROOT
21471: {{JSR{SORTC{{{COMPARE THEM - LT(A(J),ROOT)
21472: {{PPM{SRH03{{{FATHER EXCEEDS SONS - DONE
21473: {{MOV{(SP){R9{{GET SORT ARRAY ADRS
21474: {{ADD{SRTSO{R9{{POINT TO A(0)
21475: {{MOV{R9{R10{{COPY IT
21476: {{MOV{R8{R6{{COPY J
21477: {{BTW{R8{{{CONVERT TO WORDS
21478: {{RSH{R8{1{{GET J/2
21479: {{WTB{R8{{{CONVERT BACK TO BYTES
21480: {{ADD{R6{R10{{POINT TO A(J)
21481: {{ADD{R8{R9{{ADRS OF A(J/2)
21482: {{MOV{(R10){(R9){{A(J/2) = A(J)
21483: {{MOV{R6{R8{{RECOVER J
21484: {{AOV{R8{R8{SRH03{J = J*2. DONE IF TOO BIG
21485: {{BRN{SRH01{{{LOOP
21486: *
21487: * FINISH BY COPYING ROOT OFFSET BACK INTO ARRAY
21488: *
21489: {SRH03{BTW{R8{{{CONVERT TO WORDS
21490: {{RSH{R8{1{{J = J/2
21491: {{WTB{R8{{{CONVERT BACK TO BYTES
21492: {{MOV{(SP){R9{{SORT ARRAY ADRS
21493: {{ADD{SRTSO{R9{{ADRS OF A(0)
21494: {{ADD{R8{R9{{ADRS OF A(J/2)
21495: {{MOV{SRTRT{(R9){{A(J/2) = ROOT
21496: {{MOV{SRTSN{R6{{RESTORE WA
21497: {{MOV{SRTWC{R8{{RESTORE WC
21498: {{EXI{{{{RETURN
21499: {{ENP{{{{END PROCEDURE SORTH
21500: {{EJC{{{{
21501: {{EJC{{{{
21502: *
21503: * TFIND -- LOCATE TABLE ELEMENT
21504: *
21505: * (XR) SUBSCRIPT VALUE FOR ELEMENT
21506: * (XL) POINTER TO TABLE
21507: * (WB) ZERO BY VALUE, NON-ZERO BY NAME
21508: * JSR TFIND CALL TO LOCATE ELEMENT
21509: * PPM LOC TRANSFER LOCATION IF ACCESS FAILS
21510: * (XR) ELEMENT VALUE (IF BY VALUE)
21511: * (XR) DESTROYED (IF BY NAME)
21512: * (XL,WA) TEBLK NAME (IF BY NAME)
21513: * (XL,WA) DESTROYED (IF BY VALUE)
21514: * (WC,RA) DESTROYED
21515: *
21516: * NOTE THAT IF A CALL BY VALUE SPECIFIES A NON-EXISTENT
21517: * SUBSCRIPT, NULL IS RETURNED WITHOUT BUILDING A NEW TEBLK.
21518: *
21519: {TFIND{PRC{E{1{{ENTRY POINT
21520: {{MOV{R7{-(SP){{SAVE NAME/VALUE INDICATOR
21521: {{MOV{R9{-(SP){{SAVE SUBSCRIPT VALUE
21522: {{MOV{R10{-(SP){{SAVE TABLE POINTER
21523: {{MOV{4*TBLEN(R10){R6{{LOAD LENGTH OF TBBLK
21524: {{BTW{R6{{{CONVERT TO WORD COUNT
21525: {{SUB{#TBBUK{R6{{GET NUMBER OF BUCKETS
21526: {{MTI{R6{{{CONVERT TO INTEGER VALUE
21527: {{STI{TFNSI{{{SAVE FOR LATER
21528: {{MOV{(R9){R10{{LOAD FIRST WORD OF SUBSCRIPT
21529: {{LEI{R10{{{LOAD BLOCK ENTRY ID (BL$XX)
21530: {{BSW{R10{BL$$D{TFN00{SWITCH ON BLOCK TYPE
21531: {{IFF{DUMMY{TFN00{{
21532: {{IFF{DUMMY{TFN00{{
21533: {{IFF{DUMMY{TFN00{{
21534: {{IFF{DUMMY{TFN00{{
21535: {{IFF{BL$IC{TFN02{{JUMP IF INTEGER
21536: {{IFF{BL$NM{TFN04{{JUMP IF NAME
21537: {{IFF{BL$P0{TFN03{{JUMP IF PATTERN
21538: {{IFF{BL$P1{TFN03{{JUMP IF PATTERN
21539: {{IFF{BL$P2{TFN03{{JUMP IF PATTERN
21540: {{IFF{BL$RC{TFN02{{REAL
21541: {{IFF{BL$SC{TFN05{{JUMP IF STRING
21542: {{IFF{DUMMY{TFN00{{
21543: {{IFF{DUMMY{TFN00{{
21544: {{IFF{DUMMY{TFN00{{
21545: {{IFF{DUMMY{TFN00{{
21546: {{IFF{DUMMY{TFN00{{
21547: {{IFF{DUMMY{TFN00{{
21548: {{ESW{{{{END SWITCH ON BLOCK TYPE
21549: *
21550: * HERE FOR BLOCKS FOR WHICH WE USE THE SECOND WORD OF THE
21551: * BLOCK AS THE HASH SOURCE (SEE BLOCK FORMATS FOR DETAILS).
21552: *
21553: {TFN00{MOV{4*1(R9){R6{{LOAD SECOND WORD
21554: *
21555: * MERGE HERE WITH ONE WORD HASH SOURCE IN WA
21556: *
21557: {TFN01{MTI{R6{{{CONVERT TO INTEGER
21558: {{BRN{TFN06{{{JUMP TO MERGE
21559: {{EJC{{{{
21560: *
21561: * TFIND (CONTINUED)
21562: *
21563: * HERE FOR INTEGER OR REAL
21564: *
21565: {TFN02{LDI{4*1(R9){{{LOAD VALUE AS HASH SOURCE
21566: {{IGE{TFN06{{{OK IF POSITIVE OR ZERO
21567: {{NGI{{{{MAKE POSITIVE
21568: {{IOV{TFN06{{{CLEAR POSSIBLE OVERFLOW
21569: {{BRN{TFN06{{{MERGE
21570: *
21571: * FOR PATTERN, USE FIRST WORD (PCODE) AS SOURCE
21572: *
21573: {TFN03{MOV{(R9){R6{{LOAD FIRST WORD AS HASH SOURCE
21574: {{BRN{TFN01{{{MERGE BACK
21575: *
21576: * FOR NAME, USE OFFSET AS HASH SOURCE
21577: *
21578: {TFN04{MOV{4*NMOFS(R9){R6{{LOAD OFFSET AS HASH SOURCE
21579: {{BRN{TFN01{{{MERGE BACK
21580: *
21581: * HERE FOR STRING
21582: *
21583: {TFN05{JSR{HASHS{{{CALL ROUTINE TO COMPUTE HASH
21584: *
21585: * MERGE HERE WITH HASH SOURCE IN (IA)
21586: *
21587: {TFN06{RMI{TFNSI{{{COMPUTE HASH INDEX BY REMAINDERING
21588: {{MFI{R8{{{GET AS ONE WORD INTEGER
21589: {{WTB{R8{{{CONVERT TO BYTE OFFSET
21590: {{MOV{(SP){R10{{GET TABLE PTR AGAIN
21591: {{ADD{R8{R10{{POINT TO PROPER BUCKET
21592: {{MOV{4*TBBUK(R10){R9{{LOAD FIRST TEBLK POINTER
21593: {{BEQ{R9{(SP){TFN10{JUMP IF NO TEBLKS ON CHAIN
21594: *
21595: * LOOP THROUGH TEBLKS ON HASH CHAIN
21596: *
21597: {TFN07{MOV{R9{R7{{SAVE TEBLK POINTER
21598: {{MOV{4*TESUB(R9){R9{{LOAD SUBSCRIPT VALUE
21599: {{MOV{4*1(SP){R10{{LOAD INPUT ARGUMENT SUBSCRIPT VAL
21600: {{JSR{IDENT{{{COMPARE THEM
21601: {{PPM{TFN08{{{JUMP IF EQUAL (IDENT)
21602: *
21603: * HERE IF NO MATCH WITH THAT TEBLK
21604: *
21605: {{MOV{R7{R10{{RESTORE TEBLK POINTER
21606: {{MOV{4*TENXT(R10){R9{{POINT TO NEXT TEBLK ON CHAIN
21607: {{BNE{R9{(SP){TFN07{JUMP IF THERE IS ONE
21608: *
21609: * HERE IF NO MATCH WITH ANY TEBLK ON CHAIN
21610: *
21611: {{MOV{#4*TENXT{R8{{SET OFFSET TO LINK FIELD (XL BASE)
21612: {{BRN{TFN11{{{JUMP TO MERGE
21613: {{EJC{{{{
21614: *
21615: * TFIND (CONTINUED)
21616: *
21617: * HERE WE HAVE FOUND A MATCHING ELEMENT
21618: *
21619: {TFN08{MOV{R7{R10{{RESTORE TEBLK POINTER
21620: {{MOV{#4*TEVAL{R6{{SET TEBLK NAME OFFSET
21621: {{MOV{4*2(SP){R7{{RESTORE NAME/VALUE INDICATOR
21622: {{BNZ{R7{TFN09{{JUMP IF CALLED BY NAME
21623: {{JSR{ACESS{{{ELSE GET VALUE
21624: {{PPM{TFN12{{{JUMP IF REFERENCE FAILS
21625: {{ZER{R7{{{RESTORE NAME/VALUE INDICATOR
21626: *
21627: * COMMON EXIT FOR ENTRY FOUND
21628: *
21629: {TFN09{ADD{#4*NUM03{SP{{POP STACK ENTRIES
21630: {{EXI{{{{RETURN TO TFIND CALLER
21631: *
21632: * HERE IF NO TEBLKS ON THE HASH CHAIN
21633: *
21634: {TFN10{ADD{#4*TBBUK{R8{{GET OFFSET TO BUCKET PTR
21635: {{MOV{(SP){R10{{SET TBBLK PTR AS BASE
21636: *
21637: * MERGE HERE WITH (XL,WC) BASE,OFFSET OF FINAL LINK
21638: *
21639: {TFN11{MOV{(SP){R9{{TBBLK POINTER
21640: {{MOV{4*TBINV(R9){R9{{LOAD DEFAULT VALUE IN CASE
21641: {{MOV{4*2(SP){R7{{LOAD NAME/VALUE INDICATOR
21642: {{BZE{R7{TFN09{{EXIT WITH DEFAULT IF VALUE CALL
21643: *
21644: * HERE WE MUST BUILD A NEW TEBLK
21645: *
21646: {{MOV{#4*TESI${R6{{SET SIZE OF TEBLK
21647: {{JSR{ALLOC{{{ALLOCATE TEBLK
21648: {{ADD{R8{R10{{POINT TO HASH LINK
21649: {{MOV{R9{(R10){{LINK NEW TEBLK AT END OF CHAIN
21650: {{MOV{#B$TET{(R9){{STORE TYPE WORD
21651: {{MOV{#NULLS{4*TEVAL(R9){{SET NULL AS INITIAL VALUE
21652: {{MOV{(SP)+{4*TENXT(R9){{SET TBBLK PTR TO MARK END OF CHAIN
21653: {{MOV{(SP)+{4*TESUB(R9){{STORE SUBSCRIPT VALUE
21654: {{ICA{SP{{{POP PAST NAME/VALUE INDICATOR
21655: {{MOV{R9{R10{{COPY TEBLK POINTER (NAME BASE)
21656: {{MOV{#4*TEVAL{R6{{SET OFFSET
21657: {{EXI{{{{RETURN TO CALLER WITH NEW TEBLK
21658: *
21659: * ACESS FAIL RETURN
21660: *
21661: {TFN12{EXI{1{{{ALTERNATIVE RETURN
21662: {{ENP{{{{END PROCEDURE TFIND
21663: {{EJC{{{{
21664: *
21665: * TRACE -- SET/RESET A TRACE ASSOCIATION
21666: *
21667: * THIS PROCEDURE IS SHARED BY TRACE AND STOPTR TO
21668: * EITHER INITIATE OR STOP A TRACE RESPECTIVELY.
21669: *
21670: * (XL) TRBLK PTR (TRACE) OR ZERO (STOPTR)
21671: * 1(XS) FIRST ARGUMENT (NAME)
21672: * 0(XS) SECOND ARGUMENT (TRACE TYPE)
21673: * JSR TRACE CALL TO SET/RESET TRACE
21674: * PPM LOC TRANSFER LOC IF 1ST ARG IS BAD NAME
21675: * PPM LOC TRANSFER LOC IF 2ND ARG IS BAD TYPE
21676: * (XS) POPPED
21677: * (XL,XR,WA,WB,WC,IA) DESTROYED
21678: *
21679: {TRACE{PRC{N{2{{ENTRY POINT
21680: {{JSR{GTSTG{{{GET TRACE TYPE STRING
21681: {{PPM{TRC15{{{JUMP IF NOT STRING
21682: {{PLC{R9{{{ELSE POINT TO STRING
21683: {{LCH{R6{(R9){{LOAD FIRST CHARACTER
21684: {{FLC{R6{{{FOLD TO UPPER CASE
21685: {{MOV{(SP){R9{{LOAD NAME ARGUMENT
21686: {{MOV{R10{(SP){{STACK TRBLK PTR OR ZERO
21687: {{MOV{#TRTAC{R8{{SET TRTYP FOR ACCESS TRACE
21688: {{BEQ{R6{#CH$LA{TRC10{JUMP IF A (ACCESS)
21689: {{MOV{#TRTVL{R8{{SET TRTYP FOR VALUE TRACE
21690: {{BEQ{R6{#CH$LV{TRC10{JUMP IF V (VALUE)
21691: {{BZE{R6{TRC10{{JUMP IF BLANK (VALUE)
21692: *
21693: * HERE FOR L,K,F,C,R
21694: *
21695: {{BEQ{R6{#CH$LF{TRC01{JUMP IF F (FUNCTION)
21696: {{BEQ{R6{#CH$LR{TRC01{JUMP IF R (RETURN)
21697: {{BEQ{R6{#CH$LL{TRC03{JUMP IF L (LABEL)
21698: {{BEQ{R6{#CH$LK{TRC06{JUMP IF K (KEYWORD)
21699: {{BNE{R6{#CH$LC{TRC15{ELSE ERROR IF NOT C (CALL)
21700: *
21701: * HERE FOR F,C,R
21702: *
21703: {TRC01{JSR{GTNVR{{{POINT TO VRBLK FOR NAME
21704: {{PPM{TRC16{{{JUMP IF BAD NAME
21705: {{ICA{SP{{{POP STACK
21706: {{MOV{4*VRFNC(R9){R9{{POINT TO FUNCTION BLOCK
21707: {{BNE{(R9){#B$PFC{TRC17{ERROR IF NOT PROGRAM FUNCTION
21708: {{BEQ{R6{#CH$LR{TRC02{JUMP IF R (RETURN)
21709: {{EJC{{{{
21710: *
21711: * TRACE (CONTINUED)
21712: *
21713: * HERE FOR F,C TO SET/RESET CALL TRACE
21714: *
21715: {{MOV{R10{4*PFCTR(R9){{SET/RESET CALL TRACE
21716: {{BEQ{R6{#CH$LC{EXNUL{EXIT WITH NULL IF C (CALL)
21717: *
21718: * HERE FOR F,R TO SET/RESET RETURN TRACE
21719: *
21720: {TRC02{MOV{R10{4*PFRTR(R9){{SET/RESET RETURN TRACE
21721: {{EXI{{{{RETURN
21722: *
21723: * HERE FOR L TO SET/RESET LABEL TRACE
21724: *
21725: {TRC03{JSR{GTNVR{{{POINT TO VRBLK
21726: {{PPM{TRC16{{{JUMP IF BAD NAME
21727: {{MOV{4*VRLBL(R9){R10{{LOAD LABEL POINTER
21728: {{BNE{(R10){#B$TRT{TRC04{JUMP IF NO OLD TRACE
21729: {{MOV{4*TRLBL(R10){R10{{ELSE DELETE OLD TRACE ASSOCIATION
21730: *
21731: * HERE WITH OLD LABEL TRACE ASSOCIATION DELETED
21732: *
21733: {TRC04{BEQ{R10{#STNDL{TRC16{ERROR IF UNDEFINED LABEL
21734: {{MOV{(SP)+{R7{{GET TRBLK PTR AGAIN
21735: {{BZE{R7{TRC05{{JUMP IF STOPTR CASE
21736: {{MOV{R7{4*VRLBL(R9){{ELSE SET NEW TRBLK POINTER
21737: {{MOV{#B$VRT{4*VRTRA(R9){{SET LABEL TRACE ROUTINE ADDRESS
21738: {{MOV{R7{R9{{COPY TRBLK POINTER
21739: {{MOV{R10{4*TRLBL(R9){{STORE REAL LABEL IN TRBLK
21740: {{EXI{{{{RETURN
21741: *
21742: * HERE FOR STOPTR CASE FOR LABEL
21743: *
21744: {TRC05{MOV{R10{4*VRLBL(R9){{STORE LABEL PTR BACK IN VRBLK
21745: {{MOV{#B$VRG{4*VRTRA(R9){{STORE NORMAL TRANSFER ADDRESS
21746: {{EXI{{{{RETURN
21747: {{EJC{{{{
21748: *
21749: * TRACE (CONTINUED)
21750: *
21751: * HERE FOR K (KEYWORD)
21752: *
21753: {TRC06{JSR{GTNVR{{{POINT TO VRBLK
21754: {{PPM{TRC16{{{ERROR IF NOT NATURAL VAR
21755: {{BNZ{4*VRLEN(R9){TRC16{{ERROR IF NOT SYSTEM VAR
21756: {{ICA{SP{{{POP STACK
21757: {{BZE{R10{TRC07{{JUMP IF STOPTR CASE
21758: {{MOV{R9{4*TRKVR(R10){{STORE VRBLK PTR IN TRBLK FOR KTREX
21759: *
21760: * MERGE HERE WITH TRBLK SET UP IN WB (OR ZERO)
21761: *
21762: {TRC07{MOV{4*VRSVP(R9){R9{{POINT TO SVBLK
21763: {{BEQ{R9{#V$ERT{TRC08{JUMP IF ERRTYPE
21764: {{BEQ{R9{#V$STC{TRC09{JUMP IF STCOUNT
21765: {{BNE{R9{#V$FNC{TRC17{ELSE ERROR IF NOT FNCLEVEL
21766: *
21767: * FNCLEVEL
21768: *
21769: {{MOV{R10{R$FNC{{SET/RESET FNCLEVEL TRACE
21770: {{EXI{{{{RETURN
21771: *
21772: * ERRTYPE
21773: *
21774: {TRC08{MOV{R10{R$ERT{{SET/RESET ERRTYPE TRACE
21775: {{EXI{{{{RETURN
21776: *
21777: * STCOUNT
21778: *
21779: {TRC09{MOV{R10{R$STC{{SET/RESET STCOUNT TRACE
21780: {{EXI{{{{RETURN
21781: {{EJC{{{{
21782: *
21783: * TRACE (CONTINUED)
21784: *
21785: * A,V MERGE HERE WITH TRTYP VALUE IN WC
21786: *
21787: {TRC10{JSR{GTVAR{{{LOCATE VARIABLE
21788: {{PPM{TRC16{{{ERROR IF NOT APPROPRIATE NAME
21789: {{MOV{(SP)+{R7{{GET NEW TRBLK PTR AGAIN
21790: {{ADD{R10{R6{{POINT TO VARIABLE LOCATION
21791: {{MOV{R6{R9{{COPY VARIABLE POINTER
21792: *
21793: * LOOP TO SEARCH TRBLK CHAIN
21794: *
21795: {TRC11{MOV{(R9){R10{{POINT TO NEXT ENTRY
21796: {{BNE{(R10){#B$TRT{TRC13{JUMP IF NOT TRBLK
21797: {{BLT{R8{4*TRTYP(R10){TRC13{JUMP IF TOO FAR OUT ON CHAIN
21798: {{BEQ{R8{4*TRTYP(R10){TRC12{JUMP IF THIS MATCHES OUR TYPE
21799: {{ADD{#4*TRNXT{R10{{ELSE POINT TO LINK FIELD
21800: {{MOV{R10{R9{{COPY POINTER
21801: {{BRN{TRC11{{{AND LOOP BACK
21802: *
21803: * HERE TO DELETE AN OLD TRBLK OF THE TYPE WE WERE GIVEN
21804: *
21805: {TRC12{MOV{4*TRNXT(R10){R10{{GET PTR TO NEXT BLOCK OR VALUE
21806: {{MOV{R10{(R9){{STORE TO DELETE THIS TRBLK
21807: *
21808: * HERE AFTER DELETING ANY OLD ASSOCIATION OF THIS TYPE
21809: *
21810: {TRC13{BZE{R7{TRC14{{JUMP IF STOPTR CASE
21811: {{MOV{R7{(R9){{ELSE LINK NEW TRBLK IN
21812: {{MOV{R7{R9{{COPY TRBLK POINTER
21813: {{MOV{R10{4*TRNXT(R9){{STORE FORWARD POINTER
21814: {{MOV{R8{4*TRTYP(R9){{STORE APPROPRIATE TRAP TYPE CODE
21815: *
21816: * HERE TO MAKE SURE VRGET,VRSTO ARE SET PROPERLY
21817: *
21818: {TRC14{MOV{R6{R9{{RECALL POSSIBLE VRBLK POINTER
21819: {{SUB{#4*VRVAL{R9{{POINT BACK TO VRBLK
21820: {{JSR{SETVR{{{SET FIELDS IF VRBLK
21821: {{EXI{{{{RETURN
21822: *
21823: * HERE FOR BAD TRACE TYPE
21824: *
21825: {TRC15{EXI{2{{{TAKE BAD TRACE TYPE ERROR EXIT
21826: *
21827: * POP STACK BEFORE FAILING
21828: *
21829: {TRC16{ICA{SP{{{POP STACK
21830: *
21831: * HERE FOR BAD NAME ARGUMENT
21832: *
21833: {TRC17{EXI{1{{{TAKE BAD NAME ERROR EXIT
21834: {{ENP{{{{END PROCEDURE TRACE
21835: {{EJC{{{{
21836: *
21837: * TRBLD -- BUILD TRBLK
21838: *
21839: * TRBLK IS USED BY THE INPUT, OUTPUT AND TRACE FUNCTIONS
21840: * TO CONSTRUCT A TRBLK (TRAP BLOCK)
21841: *
21842: * (XR) TRTAG OR TRTER
21843: * (XL) TRFNC OR TRFPT
21844: * (WB) TRTYP
21845: * JSR TRBLD CALL TO BUILD TRBLK
21846: * (XR) POINTER TO TRBLK
21847: * (WA) DESTROYED
21848: *
21849: {TRBLD{PRC{E{0{{ENTRY POINT
21850: {{MOV{R9{-(SP){{STACK TRTAG (OR TRFNM)
21851: {{MOV{#4*TRSI${R6{{SET SIZE OF TRBLK
21852: {{JSR{ALLOC{{{ALLOCATE TRBLK
21853: {{MOV{#B$TRT{(R9){{STORE FIRST WORD
21854: {{MOV{R10{4*TRFNC(R9){{STORE TRFNC (OR TRFPT)
21855: {{MOV{(SP)+{4*TRTAG(R9){{STORE TRTAG (OR TRFNM)
21856: {{MOV{R7{4*TRTYP(R9){{STORE TYPE
21857: {{MOV{#NULLS{4*TRVAL(R9){{FOR NOW, A NULL VALUE
21858: {{EXI{{{{RETURN TO CALLER
21859: {{ENP{{{{END PROCEDURE TRBLD
21860: {{EJC{{{{
21861: *
21862: * TRIMR -- TRIM TRAILING BLANKS
21863: *
21864: * TRIMR IS PASSED A POINTER TO AN SCBLK WHICH MUST BE THE
21865: * LAST BLOCK IN DYNAMIC STORAGE. TRAILING BLANKS ARE
21866: * TRIMMED OFF AND THE DYNAMIC STORAGE POINTER RESET TO
21867: * THE END OF THE (POSSIBLY) SHORTENED BLOCK.
21868: *
21869: * (WB) NON-ZERO TO TRIM TRAILING BLANKS
21870: * (XR) POINTER TO STRING TO TRIM
21871: * JSR TRIMR CALL TO TRIM STRING
21872: * (XR) POINTER TO TRIMMED STRING
21873: * (XL,WA,WB,WC) DESTROYED
21874: *
21875: * THE CALL WITH WB ZERO STILL PERFORMS THE END ZERO PAD
21876: * AND DNAMP READJUSTMENT. IT IS USED FROM ACESS IF KVTRM=0.
21877: *
21878: {TRIMR{PRC{E{0{{ENTRY POINT
21879: {{MOV{R9{R10{{COPY STRING POINTER
21880: {{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH
21881: {{BZE{R6{TRIM2{{JUMP IF NULL INPUT
21882: {{PLC{R10{R6{{ELSE POINT PAST LAST CHARACTER
21883: {{BZE{R7{TRIM3{{JUMP IF NO TRIM
21884: {{MOV{#CH$BL{R8{{LOAD BLANK CHARACTER
21885: *
21886: * LOOP THROUGH CHARACTERS FROM RIGHT TO LEFT
21887: *
21888: {TRIM0{LCH{R7{-(R10){{LOAD NEXT CHARACTER
21889: {{BEQ{R7{#CH$HT{TRIM1{JUMP IF HORIZONTAL TAB
21890: {{BNE{R7{R8{TRIM3{JUMP IF NON-BLANK FOUND
21891: {TRIM1{DCV{R6{{{ELSE DECREMENT CHARACTER COUNT
21892: {{BNZ{R6{TRIM0{{LOOP BACK IF MORE TO CHECK
21893: *
21894: * HERE IF RESULT IS NULL (NULL OR ALL-BLANK INPUT)
21895: *
21896: {TRIM2{MOV{R9{DNAMP{{WIPE OUT INPUT STRING BLOCK
21897: {{MOV{#NULLS{R9{{LOAD NULL RESULT
21898: {{BRN{TRIM5{{{MERGE TO EXIT
21899: {{EJC{{{{
21900: *
21901: * TRIMR (CONTINUED)
21902: *
21903: * HERE WITH NON-BLANK FOUND (MERGE FOR NO TRIM)
21904: *
21905: {TRIM3{MOV{R6{4*SCLEN(R9){{SET NEW LENGTH
21906: {{MOV{R9{R10{{COPY STRING POINTER
21907: {{PSC{R10{R6{{READY FOR STORING BLANKS
21908: {{CTB{R6{SCHAR{{GET LENGTH OF BLOCK IN BYTES
21909: {{ADD{R9{R6{{POINT PAST NEW BLOCK
21910: {{MOV{R6{DNAMP{{SET NEW TOP OF STORAGE POINTER
21911: {{LCT{R6{#CFP$C{{GET COUNT OF CHARS IN WORD
21912: {{ZER{R8{{{SET BLANK CHAR
21913: *
21914: * LOOP TO ZERO PAD LAST WORD OF CHARACTERS
21915: *
21916: {TRIM4{SCH{R8{(R10)+{{STORE ZERO CHARACTER
21917: {{BCT{R6{TRIM4{{LOOP BACK TILL ALL STORED
21918: {{CSC{R10{{{COMPLETE STORE CHARACTERS
21919: *
21920: * COMMON EXIT POINT
21921: *
21922: {TRIM5{ZER{R10{{{CLEAR GARBAGE XL POINTER
21923: {{EXI{{{{RETURN TO CALLER
21924: {{ENP{{{{END PROCEDURE TRIMR
21925: {{EJC{{{{
21926: *
21927: * TRXEQ -- EXECUTE FUNCTION TYPE TRACE
21928: *
21929: * TRXEQ IS USED TO EXECUTE A TRACE WHEN A FOURTH ARGUMENT
21930: * HAS BEEN SUPPLIED. TRACE HAS ALREADY BEEN DECREMENTED.
21931: *
21932: * (XR) POINTER TO TRBLK
21933: * (XL,WA) NAME BASE,OFFSET FOR VARIABLE
21934: * JSR TRXEQ CALL TO EXECUTE TRACE
21935: * (WB,WC,RA) DESTROYED
21936: *
21937: * THE FOLLOWING STACK ENTRIES ARE MADE BEFORE PASSING
21938: * CONTROL TO THE TRACE FUNCTION USING THE CFUNC ROUTINE.
21939: *
21940: * TRXEQ RETURN POINT WORD(S)
21941: * SAVED VALUE OF TRACE KEYWORD
21942: * TRBLK POINTER
21943: * NAME BASE
21944: * NAME OFFSET
21945: * SAVED VALUE OF R$COD
21946: * SAVED CODE PTR (-R$COD)
21947: * SAVED VALUE OF FLPTR
21948: * FLPTR --------------- ZERO (DUMMY FAIL OFFSET)
21949: * NMBLK FOR VARIABLE NAME
21950: * XS ------------------ TRACE TAG
21951: *
21952: * R$COD AND THE CODE PTR ARE SET TO DUMMY VALUES WHICH
21953: * CAUSE CONTROL TO RETURN TO THE TRXEQ PROCEDURE ON SUCCESS
21954: * OR FAILURE (TRXEQ IGNORES A FAILURE CONDITION).
21955: *
21956: {TRXEQ{PRC{R{0{{ENTRY POINT (RECURSIVE)
21957: {{MOV{R$COD{R8{{LOAD CODE BLOCK POINTER
21958: {{SCP{R7{{{GET CURRENT CODE POINTER
21959: {{SUB{R8{R7{{MAKE CODE POINTER INTO OFFSET
21960: {{MOV{KVTRA{-(SP){{STACK TRACE KEYWORD VALUE
21961: {{MOV{R9{-(SP){{STACK TRBLK POINTER
21962: {{MOV{R10{-(SP){{STACK NAME BASE
21963: {{MOV{R6{-(SP){{STACK NAME OFFSET
21964: {{MOV{R8{-(SP){{STACK CODE BLOCK POINTER
21965: {{MOV{R7{-(SP){{STACK CODE POINTER OFFSET
21966: {{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER
21967: {{ZER{-(SP){{{SET DUMMY FAIL OFFSET
21968: {{MOV{SP{FLPTR{{SET NEW FAILURE POINTER
21969: {{ZER{KVTRA{{{RESET TRACE KEYWORD TO ZERO
21970: {{MOV{#TRXDC{R8{{LOAD NEW (DUMMY) CODE BLK POINTER
21971: {{MOV{R8{R$COD{{SET AS CODE BLOCK POINTER
21972: {{LCP{R8{{{AND NEW CODE POINTER
21973: {{EJC{{{{
21974: *
21975: * TRXEQ (CONTINUED)
21976: *
21977: * NOW PREPARE ARGUMENTS FOR FUNCTION
21978: *
21979: {{MOV{R6{R7{{SAVE NAME OFFSET
21980: {{MOV{#4*NMSI${R6{{LOAD NMBLK SIZE
21981: {{JSR{ALLOC{{{ALLOCATE SPACE FOR NMBLK
21982: {{MOV{#B$NML{(R9){{SET TYPE WORD
21983: {{MOV{R10{4*NMBAS(R9){{STORE NAME BASE
21984: {{MOV{R7{4*NMOFS(R9){{STORE NAME OFFSET
21985: {{MOV{4*6(SP){R10{{RELOAD POINTER TO TRBLK
21986: {{MOV{R9{-(SP){{STACK NMBLK POINTER (1ST ARGUMENT)
21987: {{MOV{4*TRTAG(R10){-(SP){{STACK TRACE TAG (2ND ARGUMENT)
21988: {{MOV{4*TRFNC(R10){R10{{LOAD TRACE FUNCTION POINTER
21989: {{MOV{#NUM02{R6{{SET NUMBER OF ARGUMENTS TO TWO
21990: {{BRN{CFUNC{{{JUMP TO CALL FUNCTION
21991: *
21992: * SEE O$TXR FOR DETAILS OF RETURN TO THIS POINT
21993: *
21994: {TRXQ1{MOV{FLPTR{SP{{POINT BACK TO OUR STACK ENTRIES
21995: {{ICA{SP{{{POP OFF GARBAGE FAIL OFFSET
21996: {{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER
21997: {{MOV{(SP)+{R7{{RELOAD CODE OFFSET
21998: {{MOV{(SP)+{R8{{LOAD OLD CODE BASE POINTER
21999: {{MOV{R8{R9{{COPY CDBLK POINTER
22000: {{MOV{4*CDSTM(R9){KVSTN{{RESTORE STMNT NO
22001: {{MOV{(SP)+{R6{{RELOAD NAME OFFSET
22002: {{MOV{(SP)+{R10{{RELOAD NAME BASE
22003: {{MOV{(SP)+{R9{{RELOAD TRBLK POINTER
22004: {{MOV{(SP)+{KVTRA{{RESTORE TRACE KEYWORD VALUE
22005: {{ADD{R8{R7{{RECOMPUTE ABSOLUTE CODE POINTER
22006: {{LCP{R7{{{RESTORE CODE POINTER
22007: {{MOV{R8{R$COD{{AND CODE BLOCK POINTER
22008: {{EXI{{{{RETURN TO TRXEQ CALLER
22009: {{ENP{{{{END PROCEDURE TRXEQ
22010: {{EJC{{{{
22011: *
22012: * XSCAN -- EXECUTION FUNCTION ARGUMENT SCAN
22013: *
22014: * XSCAN SCANS OUT ONE TOKEN IN A PROTOTYPE ARGUMENT IN
22015: * ARRAY,CLEAR,DATA,DEFINE,LOAD FUNCTION CALLS. XSCAN
22016: * CALLS MUST BE PRECEDED BY A CALL TO THE INITIALIZATION
22017: * PROCEDURE XSCNI. THE FOLLOWING VARIABLES ARE USED.
22018: *
22019: * R$XSC POINTER TO SCBLK FOR FUNCTION ARG
22020: * XSOFS OFFSET (NUM CHARS SCANNED SO FAR)
22021: *
22022: * (WC) DELIMITER ONE (CH$XX)
22023: * (XL) DELIMITER TWO (CH$XX)
22024: * JSR XSCAN CALL TO SCAN NEXT ITEM
22025: * (XR) POINTER TO SCBLK FOR TOKEN SCANNED
22026: * (WA) COMPLETION CODE (SEE BELOW)
22027: * (WC,XL) DESTROYED
22028: *
22029: * THE SCAN STARTS FROM THE CURRENT POSITION AND CONTINUES
22030: * UNTIL ONE OF THE FOLLOWING THREE CONDITIONS OCCURS.
22031: *
22032: * 1) DELIMITER ONE IS ENCOUNTERED (WA SET TO 1)
22033: *
22034: * 2) DELIMITER TWO ENCOUNTERED (WA SET TO 2)
22035: *
22036: * 3) END OF STRING ENCOUNTERED (WA SET TO 0)
22037: *
22038: * THE RESULT IS A STRING CONTAINING ALL CHARACTERS SCANNED
22039: * UP TO BUT NOT INCLUDING ANY DELIMITER CHARACTER.
22040: * THE POINTER IS LEFT POINTING PAST THE DELIMITER.
22041: *
22042: * IF ONLY ONE DELIMITER IS TO BE DETECTED, DELIMITER ONE
22043: * AND DELIMITER TWO SHOULD BE SET TO THE SAME VALUE.
22044: *
22045: * IN THE CASE WHERE THE END OF STRING IS ENCOUNTERED, THE
22046: * STRING INCLUDES ALL THE CHARACTERS TO THE END OF THE
22047: * STRING. NO FURTHER CALLS CAN BE MADE TO XSCAN UNTIL
22048: * XSCNI IS CALLED TO INITIALIZE A NEW ARGUMENT SCAN
22049: {{EJC{{{{
22050: *
22051: * XSCAN (CONTINUED)
22052: *
22053: {XSCAN{PRC{E{0{{ENTRY POINT
22054: {{MOV{R7{XSCWB{{PRESERVE WB
22055: {{MOV{R$XSC{R9{{POINT TO ARGUMENT STRING
22056: {{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH
22057: {{MOV{XSOFS{R7{{LOAD CURRENT OFFSET
22058: {{SUB{R7{R6{{GET NUMBER OF REMAINING CHARACTERS
22059: {{BZE{R6{XSCN2{{JUMP IF NO CHARACTERS LEFT
22060: {{PLC{R9{R7{{POINT TO CURRENT CHARACTER
22061: *
22062: * LOOP TO SEARCH FOR DELIMITER
22063: *
22064: {XSCN1{LCH{R7{(R9)+{{LOAD NEXT CHARACTER
22065: {{BEQ{R7{R8{XSCN3{JUMP IF DELIMITER ONE FOUND
22066: {{BEQ{R7{R10{XSCN4{JUMP IF DELIMITER TWO FOUND
22067: {{DCV{R6{{{DECREMENT COUNT OF CHARS LEFT
22068: {{BNZ{R6{XSCN1{{LOOP BACK IF MORE CHARS TO GO
22069: *
22070: * HERE FOR RUNOUT
22071: *
22072: {XSCN2{MOV{R$XSC{R10{{POINT TO STRING BLOCK
22073: {{MOV{4*SCLEN(R10){R6{{GET STRING LENGTH
22074: {{MOV{XSOFS{R7{{LOAD OFFSET
22075: {{SUB{R7{R6{{GET SUBSTRING LENGTH
22076: {{ZER{R$XSC{{{CLEAR STRING PTR FOR COLLECTOR
22077: {{ZER{XSCRT{{{SET ZERO (RUNOUT) RETURN CODE
22078: {{BRN{XSCN6{{{JUMP TO EXIT
22079: {{EJC{{{{
22080: *
22081: * XSCAN (CONTINUED)
22082: *
22083: * HERE IF DELIMITER ONE FOUND
22084: *
22085: {XSCN3{MOV{#NUM01{XSCRT{{SET RETURN CODE
22086: {{BRN{XSCN5{{{JUMP TO MERGE
22087: *
22088: * HERE IF DELIMITER TWO FOUND
22089: *
22090: {XSCN4{MOV{#NUM02{XSCRT{{SET RETURN CODE
22091: *
22092: * MERGE HERE AFTER DETECTING A DELIMITER
22093: *
22094: {XSCN5{MOV{R$XSC{R10{{RELOAD POINTER TO STRING
22095: {{MOV{4*SCLEN(R10){R8{{GET ORIGINAL LENGTH OF STRING
22096: {{SUB{R6{R8{{MINUS CHARS LEFT = CHARS SCANNED
22097: {{MOV{R8{R6{{MOVE TO REG FOR SBSTR
22098: {{MOV{XSOFS{R7{{SET OFFSET
22099: {{SUB{R7{R6{{COMPUTE LENGTH FOR SBSTR
22100: {{ICV{R8{{{ADJUST NEW CURSOR PAST DELIMITER
22101: {{MOV{R8{XSOFS{{STORE NEW OFFSET
22102: *
22103: * COMMON EXIT POINT
22104: *
22105: {XSCN6{ZER{R9{{{CLEAR GARBAGE CHARACTER PTR IN XR
22106: {{JSR{SBSTR{{{BUILD SUB-STRING
22107: {{MOV{XSCRT{R6{{LOAD RETURN CODE
22108: {{MOV{XSCWB{R7{{RESTORE WB
22109: {{EXI{{{{RETURN TO XSCAN CALLER
22110: {{ENP{{{{END PROCEDURE XSCAN
22111: {{EJC{{{{
22112: *
22113: * XSCNI -- EXECUTION FUNCTION ARGUMENT SCAN
22114: *
22115: * XSCNI INITIALIZES THE SCAN USED FOR PROTOTYPE ARGUMENTS
22116: * IN THE CLEAR, DEFINE, LOAD, DATA, ARRAY FUNCTIONS. SEE
22117: * XSCAN FOR THE PROCEDURE WHICH IS USED AFTER THIS CALL.
22118: *
22119: * -(XS) ARGUMENT TO BE SCANNED (ON STACK)
22120: * JSR XSCNI CALL TO SCAN ARGUMENT
22121: * PPM LOC TRANSFER LOC IF ARG IS NOT STRING
22122: * PPM LOC TRANSFER LOC IF ARGUMENT IS NULL
22123: * (XS) POPPED
22124: * (XR,R$XSC) ARGUMENT (SCBLK PTR)
22125: * (WA) ARGUMENT LENGTH
22126: * (IA,RA) DESTROYED
22127: *
22128: {XSCNI{PRC{N{2{{ENTRY POINT
22129: {{JSR{GTSTG{{{FETCH ARGUMENT AS STRING
22130: {{PPM{XSCI1{{{JUMP IF NOT CONVERTIBLE
22131: {{MOV{R9{R$XSC{{ELSE STORE SCBLK PTR FOR XSCAN
22132: {{ZER{XSOFS{{{SET OFFSET TO ZERO
22133: {{BZE{R6{XSCI2{{JUMP IF NULL STRING
22134: {{EXI{{{{RETURN TO XSCNI CALLER
22135: *
22136: * HERE IF ARGUMENT IS NOT A STRING
22137: *
22138: {XSCI1{EXI{1{{{TAKE NOT-STRING ERROR EXIT
22139: *
22140: * HERE FOR NULL STRING
22141: *
22142: {XSCI2{EXI{2{{{TAKE NULL-STRING ERROR EXIT
22143: {{ENP{{{{END PROCEDURE XSCNI
22144: {{TTL{S{{{P I T B O L -- UTILITY ROUTINES
22145: *
22146: * THE FOLLOWING SECTION CONTAINS UTILITY ROUTINES USED FOR
22147: * VARIOUS PURPOSES THROUGHOUT THE SYSTEM. THESE DIFFER
22148: * FROM THE PROCEDURES IN THE UTILITY PROCEDURES SECTION IN
22149: * THEY ARE NOT IN PROCEDURE FORM AND THEY DO NOT RETURN
22150: * TO THEIR CALLERS. THEY ARE ACCESSED WITH A BRANCH TYPE
22151: * INSTRUCTION AFTER SETTING THE REGISTERS TO APPROPRIATE
22152: * PARAMETER VALUES.
22153: *
22154: * THE REGISTER VALUES REQUIRED FOR EACH ROUTINE ARE
22155: * DOCUMENTED AT THE START OF EACH ROUTINE. REGISTERS NOT
22156: * MENTIONED MAY CONTAIN ANY VALUES EXCEPT THAT XR,XL
22157: * CAN ONLY CONTAIN PROPER COLLECTABLE POINTERS.
22158: *
22159: * SOME OF THESE ROUTINES WILL TOLERATE GARBAGE POINTERS
22160: * IN XL,XR ON ENTRY. THIS IS ALWAYS DOCUMENTED AND IN
22161: * EACH CASE, THE ROUTINE CLEARS THESE GARBAGE VALUES BEFORE
22162: * EXITING AFTER COMPLETING ITS TASK.
22163: *
22164: * THE ROUTINES HAVE NAMES CONSISTING OF FIVE LETTERS
22165: * AND ARE ASSEMBLED IN ALPHABETICAL ORDER.
22166: {{EJC{{{{
22167: * ARREF -- ARRAY REFERENCE
22168: *
22169: * (XL) MAY BE NON-COLLECTABLE
22170: * (XR) NUMBER OF SUBSCRIPTS
22171: * (WB) SET ZERO/NONZERO FOR VALUE/NAME
22172: * THE VALUE IN WB MUST BE COLLECTABLE
22173: * STACK SUBSCRIPTS AND ARRAY OPERAND
22174: * BRN ARREF JUMP TO CALL FUNCTION
22175: *
22176: * ARREF CONTINUES BY EXECUTING THE NEXT CODE WORD WITH
22177: * THE RESULT NAME OR VALUE PLACED ON TOP OF THE STACK.
22178: * TO DEAL WITH THE PROBLEM OF ACCESSING SUBSCRIPTS IN THE
22179: * ORDER OF STACKING, XL IS USED AS A SUBSCRIPT POINTER
22180: * WORKING BELOW THE STACK POINTER.
22181: *
22182: {ARREF{RTN{{{{
22183: {{MOV{R9{R6{{COPY NUMBER OF SUBSCRIPTS
22184: {{MOV{SP{R10{{POINT TO STACK FRONT
22185: {{WTB{R9{{{CONVERT TO BYTE OFFSET
22186: {{ADD{R9{R10{{POINT TO ARRAY OPERAND ON STACK
22187: {{ICA{R10{{{FINAL VALUE FOR STACK POPPING
22188: {{MOV{R10{ARFXS{{KEEP FOR LATER
22189: {{MOV{-(R10){R9{{LOAD ARRAY OPERAND POINTER
22190: {{MOV{R9{R$ARF{{KEEP ARRAY POINTER
22191: {{MOV{R10{R9{{SAVE POINTER TO SUBSCRIPTS
22192: {{MOV{R$ARF{R10{{POINT XL TO POSSIBLE VCBLK OR TBBLK
22193: {{MOV{(R10){R8{{LOAD FIRST WORD
22194: {{BEQ{R8{#B$ART{ARF01{JUMP IF ARBLK
22195: {{BEQ{R8{#B$VCT{ARF07{JUMP IF VCBLK
22196: {{BEQ{R8{#B$TBT{ARF10{JUMP IF TBBLK
22197: {{ERB{235{SUBSCRIPTED{{OPERAND IS NOT TABLE OR ARRAY
22198: *
22199: * HERE FOR ARRAY (ARBLK)
22200: *
22201: {ARF01{BNE{R6{4*ARNDM(R10){ARF09{JUMP IF WRONG NUMBER OF DIMS
22202: {{LDI{INTV0{{{GET INITIAL SUBSCRIPT OF ZERO
22203: {{MOV{R9{R10{{POINT BEFORE SUBSCRIPTS
22204: {{ZER{R6{{{INITIAL OFFSET TO BOUNDS
22205: {{BRN{ARF03{{{JUMP INTO LOOP
22206: *
22207: * LOOP TO COMPUTE SUBSCRIPTS BY MULTIPLICATIONS
22208: *
22209: {ARF02{MLI{4*ARDM2(R9){{{MULTIPLY TOTAL BY NEXT DIMENSION
22210: *
22211: * MERGE HERE FIRST TIME
22212: *
22213: {ARF03{MOV{-(R10){R9{{LOAD NEXT SUBSCRIPT
22214: {{STI{ARFSI{{{SAVE CURRENT SUBSCRIPT
22215: {{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE IN CASE
22216: {{BEQ{(R9){#B$ICL{ARF04{JUMP IF IT WAS AN INTEGER
22217: {{EJC{{{{
22218: *
22219: * ARREF (CONTINUED)
22220: *
22221: *
22222: {{JSR{GTINT{{{CONVERT TO INTEGER
22223: {{PPM{ARF12{{{JUMP IF NOT INTEGER
22224: {{LDI{4*ICVAL(R9){{{IF OK, LOAD INTEGER VALUE
22225: *
22226: * HERE WITH INTEGER SUBSCRIPT IN (IA)
22227: *
22228: {ARF04{MOV{R$ARF{R9{{POINT TO ARRAY
22229: {{ADD{R6{R9{{OFFSET TO NEXT BOUNDS
22230: {{SBI{4*ARLBD(R9){{{SUBTRACT LOW BOUND TO COMPARE
22231: {{IOV{ARF13{{{OUT OF RANGE FAIL IF OVERFLOW
22232: {{ILT{ARF13{{{OUT OF RANGE FAIL IF TOO SMALL
22233: {{SBI{4*ARDIM(R9){{{SUBTRACT DIMENSION
22234: {{IGE{ARF13{{{OUT OF RANGE FAIL IF TOO LARGE
22235: {{ADI{4*ARDIM(R9){{{ELSE RESTORE SUBSCRIPT OFFSET
22236: {{ADI{ARFSI{{{ADD TO CURRENT TOTAL
22237: {{ADD{#4*ARDMS{R6{{POINT TO NEXT BOUNDS
22238: {{BNE{R10{SP{ARF02{LOOP BACK IF MORE TO GO
22239: *
22240: * HERE WITH INTEGER SUBSCRIPT COMPUTED
22241: *
22242: {{MFI{R6{{{GET AS ONE WORD INTEGER
22243: {{WTB{R6{{{CONVERT TO OFFSET
22244: {{MOV{R$ARF{R10{{POINT TO ARBLK
22245: {{ADD{4*AROFS(R10){R6{{ADD OFFSET PAST BOUNDS
22246: {{ICA{R6{{{ADJUST FOR ARPRO FIELD
22247: {{BNZ{R7{ARF08{{EXIT WITH NAME IF NAME CALL
22248: *
22249: * MERGE HERE TO GET VALUE FOR VALUE CALL
22250: *
22251: {ARF05{JSR{ACESS{{{GET VALUE
22252: {{PPM{ARF13{{{FAIL IF ACESS FAILS
22253: *
22254: * RETURN VALUE
22255: *
22256: {ARF06{MOV{ARFXS{SP{{POP STACK ENTRIES
22257: {{ZER{R$ARF{{{FINISHED WITH ARRAY POINTER
22258: {{BRN{EXIXR{{{EXIT WITH VALUE IN XR
22259: {{EJC{{{{
22260: *
22261: * ARREF (CONTINUED)
22262: *
22263: * HERE FOR VECTOR
22264: *
22265: {ARF07{BNE{R6{#NUM01{ARF09{ERROR IF MORE THAN 1 SUBSCRIPT
22266: {{MOV{(SP){R9{{ELSE LOAD SUBSCRIPT
22267: {{JSR{GTINT{{{CONVERT TO INTEGER
22268: {{PPM{ARF12{{{ERROR IF NOT INTEGER
22269: {{LDI{4*ICVAL(R9){{{ELSE LOAD INTEGER VALUE
22270: {{SBI{INTV1{{{SUBTRACT FOR ONES OFFSET
22271: {{MFI{R6{ARF13{{GET SUBSCRIPT AS ONE WORD
22272: {{ADD{#VCVLS{R6{{ADD OFFSET FOR STANDARD FIELDS
22273: {{WTB{R6{{{CONVERT OFFSET TO BYTES
22274: {{BGE{R6{4*VCLEN(R10){ARF13{FAIL IF OUT OF RANGE SUBSCRIPT
22275: {{BZE{R7{ARF05{{BACK TO GET VALUE IF VALUE CALL
22276: *
22277: * RETURN NAME
22278: *
22279: {ARF08{MOV{ARFXS{SP{{POP STACK ENTRIES
22280: {{ZER{R$ARF{{{FINISHED WITH ARRAY POINTER
22281: {{BRN{EXNAM{{{ELSE EXIT WITH NAME
22282: *
22283: * HERE IF SUBSCRIPT COUNT IS WRONG
22284: *
22285: {ARF09{ERB{236{ARRAY{{REFERENCED WITH WRONG NUMBER OF SUBSCRIPTS
22286: *
22287: * TABLE
22288: *
22289: {ARF10{BNE{R6{#NUM01{ARF11{ERROR IF MORE THAN 1 SUBSCRIPT
22290: {{MOV{(SP){R9{{ELSE LOAD SUBSCRIPT
22291: {{JSR{TFIND{{{CALL TABLE SEARCH ROUTINE
22292: {{PPM{ARF13{{{FAIL IF FAILED
22293: {{BNZ{R7{ARF08{{EXIT WITH NAME IF NAME CALL
22294: {{BRN{ARF06{{{ELSE EXIT WITH VALUE
22295: *
22296: * HERE FOR BAD TABLE REFERENCE
22297: *
22298: {ARF11{ERB{237{TABLE{{REFERENCED WITH MORE THAN ONE SUBSCRIPT
22299: *
22300: * HERE FOR BAD SUBSCRIPT
22301: *
22302: {ARF12{ERB{238{ARRAY{{SUBSCRIPT IS NOT INTEGER
22303: *
22304: * HERE TO SIGNAL FAILURE
22305: *
22306: {ARF13{ZER{R$ARF{{{FINISHED WITH ARRAY POINTER
22307: {{BRN{EXFAL{{{FAIL
22308: {{EJC{{{{
22309: *
22310: * CFUNC -- CALL A FUNCTION
22311: *
22312: * CFUNC IS USED TO CALL A SNOBOL LEVEL FUNCTION. IT IS
22313: * USED BY THE APPLY FUNCTION (S$APP), THE FUNCTION
22314: * TRACE ROUTINE (TRXEQ) AND THE MAIN FUNCTION CALL ENTRY
22315: * (O$FNC, O$FNS). IN THE LATTER CASES, CFUNC IS USED ONLY
22316: * IF THE NUMBER OF ARGUMENTS IS INCORRECT.
22317: *
22318: * (XL) POINTER TO FUNCTION BLOCK
22319: * (WA) ACTUAL NUMBER OF ARGUMENTS
22320: * (XS) POINTS TO STACKED ARGUMENTS
22321: * BRN CFUNC JUMP TO CALL FUNCTION
22322: *
22323: * CFUNC CONTINUES BY EXECUTING THE FUNCTION
22324: *
22325: {CFUNC{RTN{{{{
22326: {{BLT{R6{4*FARGS(R10){CFNC1{JUMP IF TOO FEW ARGUMENTS
22327: {{BEQ{R6{4*FARGS(R10){CFNC3{JUMP IF CORRECT NUMBER OF ARGS
22328: *
22329: * HERE IF TOO MANY ARGUMENTS SUPPLIED, POP THEM OFF
22330: *
22331: {{MOV{R6{R7{{COPY ACTUAL NUMBER
22332: {{SUB{4*FARGS(R10){R7{{GET NUMBER OF EXTRA ARGS
22333: {{WTB{R7{{{CONVERT TO BYTES
22334: {{ADD{R7{SP{{POP OFF UNWANTED ARGUMENTS
22335: {{BRN{CFNC3{{{JUMP TO GO OFF TO FUNCTION
22336: *
22337: * HERE IF TOO FEW ARGUMENTS
22338: *
22339: {CFNC1{MOV{4*FARGS(R10){R7{{LOAD REQUIRED NUMBER OF ARGUMENTS
22340: {{BEQ{R7{#NINI9{CFNC3{JUMP IF CASE OF VAR NUM OF ARGS
22341: {{SUB{R6{R7{{CALCULATE NUMBER MISSING
22342: {{LCT{R7{R7{{SET COUNTER TO CONTROL LOOP
22343: *
22344: * LOOP TO SUPPLY EXTRA NULL ARGUMENTS
22345: *
22346: {CFNC2{MOV{#NULLS{-(SP){{STACK A NULL ARGUMENT
22347: {{BCT{R7{CFNC2{{LOOP TILL PROPER NUMBER STACKED
22348: *
22349: * MERGE HERE TO JUMP TO FUNCTION
22350: *
22351: {CFNC3{BRI{(R10){{{JUMP THROUGH FCODE FIELD
22352: {{EJC{{{{
22353: *
22354: * EXFAL -- EXIT SIGNALLING SNOBOL FAILURE
22355: *
22356: * (XL,XR) MAY BE NON-COLLECTABLE
22357: * BRN EXFAL JUMP TO FAIL
22358: *
22359: * EXFAL CONTINUES BY EXECUTING THE APPROPRIATE FAIL GOTO
22360: *
22361: {EXFAL{RTN{{{{
22362: {{MOV{FLPTR{SP{{POP STACK
22363: {{MOV{(SP){R9{{LOAD FAILURE OFFSET
22364: {{ADD{R$COD{R9{{POINT TO FAILURE CODE LOCATION
22365: {{LCP{R9{{{SET CODE POINTER
22366: {{BRN{EXITS{{{DO NEXT CODE WORD
22367: {{EJC{{{{
22368: *
22369: * EXINT -- EXIT WITH INTEGER RESULT
22370: *
22371: * (XL,XR) MAY BE NONCOLLECTABLE
22372: * (IA) INTEGER VALUE
22373: * BRN EXINT JUMP TO EXIT WITH INTEGER
22374: *
22375: * EXINT CONTINUES BY EXECUTING THE NEXT CODE WORD
22376: * WHICH IT DOES BY FALLING THROUGH TO EXIXR
22377: *
22378: {EXINT{RTN{{{{
22379: {{JSR{ICBLD{{{BUILD ICBLK
22380: {{EJC{{{{
22381: * EXIXR -- EXIT WITH RESULT IN (XR)
22382: *
22383: * (XR) RESULT
22384: * (XL) MAY BE NON-COLLECTABLE
22385: * BRN EXIXR JUMP TO EXIT WITH RESULT IN (XR)
22386: *
22387: * EXIXR CONTINUES BY EXECUTING THE NEXT CODE WORD
22388: * WHICH IT DOES BY FALLING THROUGH TO EXITS.
22389: {EXIXR{RTN{{{{
22390: *
22391: {{MOV{R9{-(SP){{STACK RESULT
22392: *
22393: *
22394: * EXITS -- EXIT WITH RESULT IF ANY STACKED
22395: *
22396: * (XR,XL) MAY BE NON-COLLECTABLE
22397: *
22398: * BRN EXITS ENTER EXITS ROUTINE
22399: *
22400: {EXITS{RTN{{{{
22401: {{LCW{R9{{{LOAD NEXT CODE WORD
22402: {{MOV{(R9){R10{{LOAD ENTRY ADDRESS
22403: {{BRI{R10{{{JUMP TO EXECUTE NEXT CODE WORD
22404: {{EJC{{{{
22405: *
22406: * EXNAM -- EXIT WITH NAME IN (XL,WA)
22407: *
22408: * (XL) NAME BASE
22409: * (WA) NAME OFFSET
22410: * (XR) MAY BE NON-COLLECTABLE
22411: * BRN EXNAM JUMP TO EXIT WITH NAME IN (XL,WA)
22412: *
22413: * EXNAM CONTINUES BY EXECUTING THE NEXT CODE WORD
22414: *
22415: {EXNAM{RTN{{{{
22416: {{MOV{R10{-(SP){{STACK NAME BASE
22417: {{MOV{R6{-(SP){{STACK NAME OFFSET
22418: {{BRN{EXITS{{{DO NEXT CODE WORD
22419: {{EJC{{{{
22420: *
22421: * EXNUL -- EXIT WITH NULL RESULT
22422: *
22423: * (XL,XR) MAY BE NON-COLLECTABLE
22424: * BRN EXNUL JUMP TO EXIT WITH NULL VALUE
22425: *
22426: * EXNUL CONTINUES BY EXECUTING THE NEXT CODE WORD
22427: *
22428: {EXNUL{RTN{{{{
22429: {{MOV{#NULLS{-(SP){{STACK NULL VALUE
22430: {{BRN{EXITS{{{DO NEXT CODE WORD
22431: {{EJC{{{{
22432: *
22433: * EXREA -- EXIT WITH REAL RESULT
22434: *
22435: * (XL,XR) MAY BE NON-COLLECTABLE
22436: * (RA) REAL VALUE
22437: * BRN EXREA JUMP TO EXIT WITH REAL VALUE
22438: *
22439: * EXREA CONTINUES BY EXECUTING THE NEXT CODE WORD
22440: *
22441: {EXREA{RTN{{{{
22442: {{JSR{RCBLD{{{BUILD RCBLK
22443: {{BRN{EXIXR{{{JUMP TO EXIT WITH RESULT IN XR
22444: {{EJC{{{{
22445: *
22446: * EXSID -- EXIT SETTING ID FIELD
22447: *
22448: * EXSID IS USED TO EXIT AFTER BUILDING ANY OF THE FOLLOWING
22449: * BLOCKS (ARBLK, TBBLK, PDBLK, VCBLK). IT SETS THE IDVAL.
22450: *
22451: * (XR) PTR TO BLOCK WITH IDVAL FIELD
22452: * (XL) MAY BE NON-COLLECTABLE
22453: * BRN EXSID JUMP TO EXIT AFTER SETTING ID FIELD
22454: *
22455: * EXSID CONTINUES BY EXECUTING THE NEXT CODE WORD
22456: *
22457: {EXSID{RTN{{{{
22458: {{MOV{CURID{R6{{LOAD CURRENT ID VALUE
22459: {{BNE{R6{#CFP$M{EXSI1{JUMP IF NO OVERFLOW
22460: {{ZER{R6{{{ELSE RESET FOR WRAPAROUND
22461: *
22462: * HERE WITH OLD IDVAL IN WA
22463: *
22464: {EXSI1{ICV{R6{{{BUMP ID VALUE
22465: {{MOV{R6{CURID{{STORE FOR NEXT TIME
22466: {{MOV{R6{4*IDVAL(R9){{STORE ID VALUE
22467: {{BRN{EXIXR{{{EXIT WITH RESULT IN (XR)
22468: {{EJC{{{{
22469: *
22470: * EXVNM -- EXIT WITH NAME OF VARIABLE
22471: *
22472: * EXVNM EXITS AFTER STACKING A VALUE WHICH IS A NMBLK
22473: * REFERENCING THE NAME OF A GIVEN NATURAL VARIABLE.
22474: *
22475: * (XR) VRBLK POINTER
22476: * (XL) MAY BE NON-COLLECTABLE
22477: * BRN EXVNM EXIT WITH VRBLK POINTER IN XR
22478: *
22479: {EXVNM{RTN{{{{
22480: {{MOV{R9{R10{{COPY NAME BASE POINTER
22481: {{MOV{#4*NMSI${R6{{SET SIZE OF NMBLK
22482: {{JSR{ALLOC{{{ALLOCATE NMBLK
22483: {{MOV{#B$NML{(R9){{STORE TYPE WORD
22484: {{MOV{R10{4*NMBAS(R9){{STORE NAME BASE
22485: {{MOV{#4*VRVAL{4*NMOFS(R9){{STORE NAME OFFSET
22486: {{BRN{EXIXR{{{EXIT WITH RESULT IN XR
22487: {{EJC{{{{
22488: *
22489: * FLPOP -- FAIL AND POP IN PATTERN MATCHING
22490: *
22491: * FLPOP POPS THE NODE AND CURSOR ON THE STACK AND THEN
22492: * DROPS THROUGH INTO FAILP TO CAUSE PATTERN FAILURE
22493: *
22494: * (XL,XR) MAY BE NON-COLLECTABLE
22495: * BRN FLPOP JUMP TO FAIL AND POP STACK
22496: *
22497: {FLPOP{RTN{{{{
22498: {{ADD{#4*NUM02{SP{{POP TWO ENTRIES OFF STACK
22499: {{EJC{{{{
22500: *
22501: * FAILP -- FAILURE IN MATCHING PATTERN NODE
22502: *
22503: * FAILP IS USED AFTER FAILING TO MATCH A PATTERN NODE.
22504: * SEE PATTERN MATCH ROUTINES FOR DETAILS OF USE.
22505: *
22506: * (XL,XR) MAY BE NON-COLLECTABLE
22507: * BRN FAILP SIGNAL FAILURE TO MATCH
22508: *
22509: * FAILP CONTINUES BY MATCHING AN ALTERNATIVE FROM THE STACK
22510: *
22511: {FAILP{RTN{{{{
22512: {{MOV{(SP)+{R9{{LOAD ALTERNATIVE NODE POINTER
22513: {{MOV{(SP)+{R7{{RESTORE OLD CURSOR
22514: {{MOV{(R9){R10{{LOAD PCODE ENTRY POINTER
22515: {{BRI{R10{{{JUMP TO EXECUTE CODE FOR NODE
22516: {{EJC{{{{
22517: *
22518: * INDIR -- COMPUTE INDIRECT REFERENCE
22519: *
22520: * (WB) NONZERO/ZERO FOR BY NAME/VALUE
22521: * BRN INDIR JUMP TO GET INDIRECT REF ON STACK
22522: *
22523: * INDIR CONTINUES BY EXECUTING THE NEXT CODE WORD
22524: *
22525: {INDIR{RTN{{{{
22526: {{MOV{(SP)+{R9{{LOAD ARGUMENT
22527: {{BEQ{(R9){#B$NML{INDR2{JUMP IF A NAME
22528: {{JSR{GTNVR{{{ELSE CONVERT TO VARIABLE
22529: {{ERR{239{INDIRECTION{{OPERAND IS NOT NAME
22530: {{BZE{R7{INDR1{{SKIP IF BY VALUE
22531: {{MOV{R9{-(SP){{ELSE STACK VRBLK PTR
22532: {{MOV{#4*VRVAL{-(SP){{STACK NAME OFFSET
22533: {{BRN{EXITS{{{EXIT WITH RESULT ON STACK
22534: *
22535: * HERE TO GET VALUE OF NATURAL VARIABLE
22536: *
22537: {INDR1{BRI{(R9){{{JUMP THROUGH VRGET FIELD OF VRBLK
22538: *
22539: * HERE IF OPERAND IS A NAME
22540: *
22541: {INDR2{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE
22542: {{MOV{4*NMOFS(R9){R6{{LOAD NAME OFFSET
22543: {{BNZ{R7{EXNAM{{EXIT IF CALLED BY NAME
22544: {{JSR{ACESS{{{ELSE GET VALUE FIRST
22545: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS
22546: {{BRN{EXIXR{{{ELSE RETURN WITH VALUE IN XR
22547: {{EJC{{{{
22548: *
22549: * MATCH -- INITIATE PATTERN MATCH
22550: *
22551: * (WB) MATCH TYPE CODE
22552: * BRN MATCH JUMP TO INITIATE PATTERN MATCH
22553: *
22554: * MATCH CONTINUES BY EXECUTING THE PATTERN MATCH. SEE
22555: * PATTERN MATCH ROUTINES (P$XXX) FOR FULL DETAILS.
22556: *
22557: {MATCH{RTN{{{{
22558: {{MOV{(SP)+{R9{{LOAD PATTERN OPERAND
22559: {{JSR{GTPAT{{{CONVERT TO PATTERN
22560: {{ERR{240{PATTERN{{MATCH RIGHT OPERAND IS NOT PATTERN
22561: {{MOV{R9{R10{{IF OK, SAVE PATTERN POINTER
22562: {{BNZ{R7{MTCH1{{JUMP IF NOT MATCH BY NAME
22563: {{MOV{(SP){R6{{ELSE LOAD NAME OFFSET
22564: {{MOV{R10{-(SP){{SAVE PATTERN POINTER
22565: {{MOV{4*2(SP){R10{{LOAD NAME BASE
22566: {{JSR{ACESS{{{ACCESS SUBJECT VALUE
22567: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS
22568: {{MOV{(SP){R10{{RESTORE PATTERN POINTER
22569: {{MOV{R9{(SP){{STACK SUBJECT STRING VAL FOR MERGE
22570: {{ZER{R7{{{RESTORE TYPE CODE
22571: *
22572: * MERGE HERE WITH SUBJECT VALUE ON STACK
22573: *
22574: {MTCH1{MOV{(SP){R9{{LOAD SUBJECT VALUE
22575: {{ZER{R$PMB{{{ASSUME NOT A BUFFER
22576: {{BNE{(R9){#B$BCT{MTCHA{BRANCH IF NOT
22577: {{ICA{SP{{{ELSE POP VALUE
22578: {{MOV{R9{R$PMB{{SAVE POINTER
22579: {{MOV{4*BCLEN(R9){R6{{GET DEFINED LENGTH
22580: {{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK
22581: {{BRN{MTCHB{{{
22582: *
22583: * HERE IF NOT BUFFER TO CONVERT TO STRING
22584: *
22585: {MTCHA{JSR{GTSTG{{{NOT BUFFER - CONVERT TO STRING
22586: {{ERR{241{PATTERN{{MATCH LEFT OPERAND IS NOT STRING
22587: *
22588: * MERGE WITH BUFFER OR STRING
22589: *
22590: {MTCHB{MOV{R9{R$PMS{{IF OK, STORE SUBJECT STRING POINTER
22591: {{MOV{R6{PMSSL{{AND LENGTH
22592: {{MOV{R7{-(SP){{STACK MATCH TYPE CODE
22593: {{ZER{-(SP){{{STACK INITIAL CURSOR (ZERO)
22594: {{ZER{R7{{{SET INITIAL CURSOR
22595: {{MOV{SP{PMHBS{{SET HISTORY STACK BASE PTR
22596: {{ZER{PMDFL{{{RESET PATTERN ASSIGNMENT FLAG
22597: {{MOV{R10{R9{{SET INITIAL NODE POINTER
22598: {{BNZ{KVANC{MTCH2{{JUMP IF ANCHORED
22599: *
22600: * HERE FOR UNANCHORED
22601: *
22602: {{MOV{R9{-(SP){{STACK INITIAL NODE POINTER
22603: {{MOV{#NDUNA{-(SP){{STACK POINTER TO ANCHOR MOVE NODE
22604: {{BRI{(R9){{{START MATCH OF FIRST NODE
22605: *
22606: * HERE IN ANCHORED MODE
22607: *
22608: {MTCH2{ZER{-(SP){{{DUMMY CURSOR VALUE
22609: {{MOV{#NDABO{-(SP){{STACK POINTER TO ABORT NODE
22610: {{BRI{(R9){{{START MATCH OF FIRST NODE
22611: {{EJC{{{{
22612: *
22613: * RETRN -- RETURN FROM FUNCTION
22614: *
22615: * (WA) STRING POINTER FOR RETURN TYPE
22616: * BRN RETRN JUMP TO RETURN FROM (SNOBOL) FUNC
22617: *
22618: * RETRN CONTINUES BY EXECUTING THE CODE AT THE RETURN POINT
22619: * THE STACK IS CLEANED OF ANY GARBAGE LEFT BY OTHER
22620: * ROUTINES WHICH MAY HAVE ALTERED FLPTR SINCE FUNCTION
22621: * ENTRY BY USING FLPRT, RESERVED FOR USE ONLY BY
22622: * FUNCTION CALL AND RETURN.
22623: *
22624: {RETRN{RTN{{{{
22625: {{BNZ{KVFNC{RTN01{{JUMP IF NOT LEVEL ZERO
22626: {{ERB{242{FUNCTION{{RETURN FROM LEVEL ZERO
22627: *
22628: * HERE IF NOT LEVEL ZERO RETURN
22629: *
22630: {RTN01{MOV{FLPRT{SP{{POP STACK
22631: {{ICA{SP{{{REMOVE FAILURE OFFSET
22632: {{MOV{(SP)+{R9{{POP PFBLK POINTER
22633: {{MOV{(SP)+{FLPTR{{POP FAILURE POINTER
22634: {{MOV{(SP)+{FLPRT{{POP OLD FLPRT
22635: {{MOV{(SP)+{R7{{POP CODE POINTER OFFSET
22636: {{MOV{(SP)+{R8{{POP OLD CODE BLOCK POINTER
22637: {{ADD{R8{R7{{MAKE OLD CODE POINTER ABSOLUTE
22638: {{LCP{R7{{{RESTORE OLD CODE POINTER
22639: {{MOV{R8{R$COD{{RESTORE OLD CODE BLOCK POINTER
22640: {{DCV{KVFNC{{{DECREMENT FUNCTION LEVEL
22641: {{MOV{KVTRA{R7{{LOAD TRACE
22642: {{ADD{KVFTR{R7{{ADD FTRACE
22643: {{BZE{R7{RTN06{{JUMP IF NO TRACING POSSIBLE
22644: *
22645: * HERE IF THERE MAY BE A TRACE
22646: *
22647: {{MOV{R6{-(SP){{SAVE FUNCTION RETURN TYPE
22648: {{MOV{R9{-(SP){{SAVE PFBLK POINTER
22649: {{MOV{R6{KVRTN{{SET RTNTYPE FOR TRACE FUNCTION
22650: {{MOV{R$FNC{R10{{LOAD FNCLEVEL TRBLK PTR (IF ANY)
22651: {{JSR{KTREX{{{EXECUTE POSSIBLE FNCLEVEL TRACE
22652: {{MOV{4*PFVBL(R9){R10{{LOAD VRBLK PTR (SGD13)
22653: {{BZE{KVTRA{RTN02{{JUMP IF TRACE IS OFF
22654: {{MOV{4*PFRTR(R9){R9{{ELSE LOAD RETURN TRACE TRBLK PTR
22655: {{BZE{R9{RTN02{{JUMP IF NOT RETURN TRACED
22656: {{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT
22657: {{BZE{4*TRFNC(R9){RTN03{{JUMP IF PRINT TRACE
22658: {{MOV{#4*VRVAL{R6{{ELSE SET NAME OFFSET
22659: {{MOV{4*1(SP){KVRTN{{MAKE SURE RTNTYPE IS SET RIGHT
22660: {{JSR{TRXEQ{{{EXECUTE FULL TRACE
22661: {{EJC{{{{
22662: *
22663: * RETRN (CONTINUED)
22664: *
22665: * HERE TO TEST FOR FTRACE
22666: *
22667: {RTN02{BZE{KVFTR{RTN05{{JUMP IF FTRACE IS OFF
22668: {{DCV{KVFTR{{{ELSE DECREMENT FTRACE
22669: *
22670: * HERE FOR PRINT TRACE OF FUNCTION RETURN
22671: *
22672: {RTN03{JSR{PRTSN{{{PRINT STATEMENT NUMBER
22673: {{MOV{4*1(SP){R9{{LOAD RETURN TYPE
22674: {{JSR{PRTST{{{PRINT IT
22675: {{MOV{#CH$BL{R6{{LOAD BLANK
22676: {{JSR{PRTCH{{{PRINT IT
22677: {{MOV{(SP){R10{{LOAD PFBLK PTR
22678: {{MOV{4*PFVBL(R10){R10{{LOAD FUNCTION VRBLK PTR
22679: {{MOV{#4*VRVAL{R6{{SET VRBLK NAME OFFSET
22680: {{BNE{R9{#SCFRT{RTN04{JUMP IF NOT FRETURN CASE
22681: *
22682: * FOR FRETURN, JUST PRINT FUNCTION NAME
22683: *
22684: {{JSR{PRTNM{{{PRINT NAME
22685: {{JSR{PRTNL{{{TERMINATE PRINT LINE
22686: {{BRN{RTN05{{{MERGE
22687: *
22688: * HERE FOR RETURN OR NRETURN, PRINT FUNCTION NAME = VALUE
22689: *
22690: {RTN04{JSR{PRTNV{{{PRINT NAME = VALUE
22691: *
22692: * HERE AFTER COMPLETING TRACE
22693: *
22694: {RTN05{MOV{(SP)+{R9{{POP PFBLK POINTER
22695: {{MOV{(SP)+{R6{{POP RETURN TYPE STRING
22696: *
22697: * MERGE HERE IF NO TRACE REQUIRED
22698: *
22699: {RTN06{MOV{R6{KVRTN{{SET RTNTYPE KEYWORD
22700: {{MOV{4*PFVBL(R9){R10{{LOAD POINTER TO FN VRBLK
22701: {{EJC{{{{
22702: * RETRN (CONTINUED)
22703: *
22704: * GET VALUE OF FUNCTION
22705: *
22706: {RTN07{MOV{R10{RTNBP{{SAVE BLOCK POINTER
22707: {{MOV{4*VRVAL(R10){R10{{LOAD VALUE
22708: {{BEQ{(R10){#B$TRT{RTN07{LOOP BACK IF TRAPPED
22709: {{MOV{R10{RTNFV{{ELSE SAVE FUNCTION RESULT VALUE
22710: {{MOV{(SP)+{RTNSV{{SAVE ORIGINAL FUNCTION VALUE
22711: {{MOV{(SP)+{R10{{POP SAVED POINTER
22712: {{BZE{R10{RTN7C{{NO ACTION IF NONE
22713: {{BZE{KVPFL{RTN7C{{JUMP IF NO PROFILING
22714: {{JSR{PRFLU{{{ELSE PROFILE LAST FUNC STMT
22715: {{BEQ{KVPFL{#NUM02{RTN7A{BRANCH ON VALUE OF PROFILE KEYWD
22716: *
22717: * HERE IF &PROFILE = 1. START TIME MUST BE FRIGGED TO
22718: * APPEAR EARLIER THAN IT ACTUALLY IS, BY AMOUNT USED BEFORE
22719: * THE CALL.
22720: *
22721: {{LDI{PFSTM{{{LOAD CURRENT TIME
22722: {{SBI{4*ICVAL(R10){{{FRIG BY SUBTRACTING SAVED AMOUNT
22723: {{BRN{RTN7B{{{AND MERGE
22724: *
22725: * HERE IF &PROFILE = 2
22726: *
22727: {RTN7A{LDI{4*ICVAL(R10){{{LOAD SAVED TIME
22728: *
22729: * BOTH PROFILE TYPES MERGE HERE
22730: *
22731: {RTN7B{STI{PFSTM{{{STORE BACK CORRECT START TIME
22732: *
22733: * MERGE HERE IF NO PROFILING
22734: *
22735: {RTN7C{MOV{4*FARGS(R9){R7{{GET NUMBER OF ARGS
22736: {{ADD{4*PFNLO(R9){R7{{ADD NUMBER OF LOCALS
22737: {{BZE{R7{RTN10{{JUMP IF NO ARGS/LOCALS
22738: {{LCT{R7{R7{{ELSE SET LOOP COUNTER
22739: {{ADD{4*PFLEN(R9){R9{{AND POINT TO END OF PFBLK
22740: *
22741: * LOOP TO RESTORE FUNCTIONS AND LOCALS
22742: *
22743: {RTN08{MOV{-(R9){R10{{LOAD NEXT VRBLK POINTER
22744: *
22745: * LOOP TO FIND VALUE BLOCK
22746: *
22747: {RTN09{MOV{R10{R6{{SAVE BLOCK POINTER
22748: {{MOV{4*VRVAL(R10){R10{{LOAD POINTER TO NEXT VALUE
22749: {{BEQ{(R10){#B$TRT{RTN09{LOOP BACK IF TRAPPED
22750: {{MOV{R6{R10{{ELSE RESTORE LAST BLOCK POINTER
22751: {{MOV{(SP)+{4*VRVAL(R10){{RESTORE OLD VARIABLE VALUE
22752: {{BCT{R7{RTN08{{LOOP TILL ALL PROCESSED
22753: *
22754: * NOW RESTORE FUNCTION VALUE AND EXIT
22755: *
22756: {RTN10{MOV{RTNBP{R10{{RESTORE PTR TO LAST FUNCTION BLOCK
22757: {{MOV{RTNSV{4*VRVAL(R10){{RESTORE OLD FUNCTION VALUE
22758: {{MOV{RTNFV{R9{{RELOAD FUNCTION RESULT
22759: {{MOV{R$COD{R10{{POINT TO NEW CODE BLOCK
22760: {{MOV{KVSTN{KVLST{{SET LASTNO FROM STNO
22761: {{MOV{4*CDSTM(R10){KVSTN{{RESET PROPER STNO VALUE
22762: {{MOV{KVRTN{R6{{LOAD RETURN TYPE
22763: {{BEQ{R6{#SCRTN{EXIXR{EXIT WITH RESULT IN XR IF RETURN
22764: {{BEQ{R6{#SCFRT{EXFAL{FAIL IF FRETURN
22765: {{EJC{{{{
22766: *
22767: * RETRN (CONTINUED)
22768: *
22769: * HERE FOR NRETURN
22770: *
22771: {{BEQ{(R9){#B$NML{RTN11{JUMP IF IS A NAME
22772: {{JSR{GTNVR{{{ELSE TRY CONVERT TO VARIABLE NAME
22773: {{ERR{243{FUNCTION{{RESULT IN NRETURN IS NOT NAME
22774: {{MOV{R9{R10{{IF OK, COPY VRBLK (NAME BASE) PTR
22775: {{MOV{#4*VRVAL{R6{{SET NAME OFFSET
22776: {{BRN{RTN12{{{AND MERGE
22777: *
22778: * HERE IF RETURNED RESULT IS A NAME
22779: *
22780: {RTN11{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE
22781: {{MOV{4*NMOFS(R9){R6{{LOAD NAME OFFSET
22782: *
22783: * MERGE HERE WITH RETURNED NAME IN (XL,WA)
22784: *
22785: {RTN12{MOV{R10{R9{{PRESERVE XL
22786: {{LCW{R7{{{LOAD NEXT WORD
22787: {{MOV{R9{R10{{RESTORE XL
22788: {{BEQ{R7{#OFNE${EXNAM{EXIT IF CALLED BY NAME
22789: {{MOV{R7{-(SP){{ELSE SAVE CODE WORD
22790: {{JSR{ACESS{{{GET VALUE
22791: {{PPM{EXFAL{{{FAIL IF ACCESS FAILS
22792: {{MOV{R9{R10{{IF OK, COPY RESULT
22793: {{MOV{(SP){R9{{RELOAD NEXT CODE WORD
22794: {{MOV{R10{(SP){{STORE RESULT ON STACK
22795: {{MOV{(R9){R10{{LOAD ROUTINE ADDRESS
22796: {{BRI{R10{{{JUMP TO EXECUTE NEXT CODE WORD
22797: {{EJC{{{{
22798: *
22799: * STCOV -- SIGNAL STATEMENT COUNTER OVERFLOW
22800: *
22801: * BRN STCOV JUMP TO SIGNAL STATEMENT COUNT OFLO
22802: *
22803: * PERMIT UP TO 10 MORE STATEMENTS TO BE OBEYED SO THAT
22804: * SETEXIT TRAP CAN REGAIN CONTROL.
22805: * STCOV CONTINUES BY ISSUING THE ERROR MESSAGE
22806: *
22807: {STCOV{RTN{{{{
22808: {{ICV{ERRFT{{{FATAL ERROR
22809: {{LDI{INTVT{{{GET 10
22810: {{ADI{KVSTL{{{ADD TO FORMER LIMIT
22811: {{STI{KVSTL{{{STORE AS NEW STLIMIT
22812: {{LDI{INTVT{{{GET 10
22813: {{STI{KVSTC{{{SET AS NEW COUNT
22814: {{ERB{244{STATEMENT{{COUNT EXCEEDS VALUE OF STLIMIT KEYWORD
22815: {{EJC{{{{
22816: *
22817: * STMGO -- START EXECUTION OF NEW STATEMENT
22818: *
22819: * (XR) POINTER TO CDBLK FOR NEW STATEMENT
22820: * BRN STMGO JUMP TO EXECUTE NEW STATEMENT
22821: *
22822: * STMGO CONTINUES BY EXECUTING THE NEXT STATEMENT
22823: *
22824: {STMGO{RTN{{{{
22825: {{MOV{R9{R$COD{{SET NEW CODE BLOCK POINTER
22826: {{BZE{KVPFL{STGO1{{SKIP IF NO PROFILING
22827: {{JSR{PRFLU{{{ELSE PROFILE THE STATEMENT
22828: {STGO1{MOV{KVSTN{KVLST{{SET LASTNO
22829: {{MOV{4*CDSTM(R9){KVSTN{{SET STNO
22830: {{ADD{#4*CDCOD{R9{{POINT TO FIRST CODE WORD
22831: {{LCP{R9{{{SET CODE POINTER
22832: {{LDI{KVSTC{{{GET STMT COUNT
22833: {{ILT{EXITS{{{OMIT COUNTING IF NEGATIVE
22834: {{IEQ{STCOV{{{FAIL IF STLIMIT REACHED
22835: {{SBI{INTV1{{{DECREMENT
22836: {{STI{KVSTC{{{REPLACE IT
22837: {{BZE{R$STC{EXITS{{EXIT IF NO STCOUNT TRACE
22838: *
22839: * HERE FOR STCOUNT TRACE
22840: *
22841: {{ZER{R9{{{CLEAR GARBAGE VALUE IN XR
22842: {{MOV{R$STC{R10{{LOAD POINTER TO STCOUNT TRBLK
22843: {{JSR{KTREX{{{EXECUTE KEYWORD TRACE
22844: {{BRN{EXITS{{{AND THEN EXIT FOR NEXT CODE WORD
22845: {{EJC{{{{
22846: *
22847: * STOPR -- TERMINATE RUN
22848: *
22849: * (XR) POINTS TO ENDING MESSAGE
22850: * BRN STOPR JUMP TO TERMINATE RUN
22851: *
22852: * TERMINATE RUN AND PRINT STATISTICS. ON ENTRY XR POINTS
22853: * TO ENDING MESSAGE OR IS ZERO IF MESSAGE PRINTED ALREADY.
22854: *
22855: {STOPR{RTN{{{{
22856: {{BZE{R9{STPRA{{SKIP IF SYSAX ALREADY CALLED (REG04)
22857: {{JSR{SYSAX{{{CALL AFTER EXECUTION PROC
22858: {STPRA{ADD{RSMEM{DNAME{{USE THE RESERVE MEMORY
22859: {{BNE{R9{#ENDMS{STPR0{SKIP IF NOT NORMAL END MESSAGE
22860: {{BNZ{EXSTS{STPR3{{SKIP IF EXEC STATS SUPPRESSED
22861: {{ZER{ERICH{{{CLEAR ERRORS TO INT.CH. FLAG
22862: *
22863: * LOOK TO SEE IF AN ENDING MESSAGE IS SUPPLIED
22864: *
22865: {STPR0{JSR{PRTPG{{{EJECT PRINTER
22866: {{BZE{R9{STPR1{{SKIP IF NO MESSAGE
22867: {{JSR{PRTST{{{PRINT MESSAGE
22868: *
22869: * MERGE HERE IF NO MESSAGE TO PRINT
22870: *
22871: {STPR1{JSR{PRTIS{{{PRINT BLANK LINE
22872: {{MTI{KVSTN{{{GET STATEMENT NUMBER
22873: {{MOV{#STPM1{R9{{POINT TO MESSAGE /IN STATEMENT XXX/
22874: {{JSR{PRTMX{{{PRINT IT
22875: {{JSR{SYSTM{{{GET CURRENT TIME
22876: {{SBI{TIMSX{{{MINUS START TIME = ELAPSED EXEC TIM
22877: {{STI{STPTI{{{SAVE FOR LATER
22878: {{MOV{#STPM3{R9{{POINT TO MSG /EXECUTION TIME MSEC /
22879: {{JSR{PRTMX{{{PRINT IT
22880: {{LDI{KVSTL{{{GET STATEMENT LIMIT
22881: {{ILT{STPR2{{{SKIP IF NEGATIVE
22882: {{SBI{KVSTC{{{MINUS COUNTER = COUNT
22883: {{STI{STPSI{{{SAVE
22884: {{MOV{#STPM2{R9{{POINT TO MESSAGE /STMTS EXECUTED/
22885: {{JSR{PRTMX{{{PRINT IT
22886: {{LDI{STPTI{{{RELOAD ELAPSED TIME
22887: {{MLI{INTTH{{{*1000 (MICROSECS)
22888: {{IOV{STPR2{{{JUMP IF WE CANNOT COMPUTE
22889: {{DVI{STPSI{{{DIVIDE BY STATEMENT COUNT
22890: {{IOV{STPR2{{{JUMP IF OVERFLOW
22891: {{MOV{#STPM4{R9{{POINT TO MSG (MCSEC PER STATEMENT /
22892: {{JSR{PRTMX{{{PRINT IT
22893: {{EJC{{{{
22894: *
22895: * STOPR (CONTINUED)
22896: *
22897: * MERGE TO SKIP MESSAGE (OVERFLOW OR NEGATIVE STLIMIT)
22898: *
22899: {STPR2{MTI{GBCNT{{{LOAD COUNT OF COLLECTIONS
22900: {{MOV{#STPM5{R9{{POINT TO MESSAGE /REGENERATIONS /
22901: {{JSR{PRTMX{{{PRINT IT
22902: {{JSR{PRTIS{{{ONE MORE BLANK FOR LUCK
22903: *
22904: * CHECK IF DUMP REQUESTED
22905: *
22906: {STPR3{JSR{PRFLR{{{PRINT PROFILE IF WANTED
22907: *
22908: {{MOV{KVDMP{R9{{LOAD DUMP KEYWORD
22909: {{JSR{DUMPR{{{EXECUTE DUMP IF REQUESTED
22910: {{MOV{R$FCB{R10{{GET FCBLK CHAIN HEAD
22911: {{MOV{KVABE{R6{{LOAD ABEND VALUE
22912: {{MOV{KVCOD{R7{{LOAD CODE VALUE
22913: {{JSR{SYSEJ{{{EXIT TO SYSTEM
22914: {{EJC{{{{
22915: *
22916: * SUCCP -- SIGNAL SUCCESSFUL MATCH OF A PATTERN NODE
22917: *
22918: * SEE PATTERN MATCH ROUTINES FOR DETAILS
22919: *
22920: * (XR) CURRENT NODE
22921: * (WB) CURRENT CURSOR
22922: * (XL) MAY BE NON-COLLECTABLE
22923: * BRN SUCCP SIGNAL SUCCESSFUL PATTERN MATCH
22924: *
22925: * SUCCP CONTINUES BY MATCHING THE SUCCESSOR NODE
22926: *
22927: {SUCCP{RTN{{{{
22928: {{MOV{4*PTHEN(R9){R9{{LOAD SUCCESSOR NODE
22929: {{MOV{(R9){R10{{LOAD NODE CODE ENTRY ADDRESS
22930: {{BRI{R10{{{JUMP TO MATCH SUCCESSOR NODE
22931: {{EJC{{{{
22932: *
22933: * SYSAB -- PRINT /ABNORMAL END/ AND TERMINATE
22934: *
22935: {SYSAB{RTN{{{{
22936: {{MOV{#ENDAB{R9{{POINT TO MESSAGE
22937: {{MOV{#NUM01{KVABE{{SET ABEND FLAG
22938: {{JSR{PRTNL{{{SKIP TO NEW LINE
22939: {{BRN{STOPR{{{JUMP TO PACK UP
22940: {{EJC{{{{
22941: *
22942: * SYSTU -- PRINT /TIME UP/ AND TERMINATE
22943: *
22944: {SYSTU{RTN{{{{
22945: {{MOV{#ENDTU{R9{{POINT TO MESSAGE
22946: {{MOV{STRTU{R6{{GET CHARS /TU/
22947: {{MOV{R6{KVCOD{{PUT IN KVCOD
22948: {{MOV{TIMUP{R6{{CHECK STATE OF TIMEUP SWITCH
22949: {{MNZ{TIMUP{{{SET SWITCH
22950: {{BNZ{R6{STOPR{{STOP RUN IF ALREADY SET
22951: {{ERB{245{TRANSLATION/EXECUTION{{TIME EXPIRED
22952: {{TTL{S{{{P I T B O L -- STACK OVERFLOW SECTION
22953: *
22954: * CONTROL COMES HERE IF THE MAIN STACK OVERFLOWS
22955: *
22956: {{SEC{{{{START OF STACK OVERFLOW SECTION
22957: *
22958: {{ICV{ERRFT{{{FATAL ERROR
22959: {{MOV{FLPTR{SP{{POP STACK TO AVOID MORE FAILS
22960: {{BNZ{GBCFL{STAK1{{JUMP IF GARBAGE COLLECTING
22961: {{ERB{246{STACK{{OVERFLOW
22962: *
22963: * NO CHANCE OF RECOVERY IN MID GARBAGE COLLECTION
22964: *
22965: {STAK1{MOV{#ENDSO{R9{{POINT TO MESSAGE
22966: {{ZER{KVDMP{{{MEMORY IS UNDUMPABLE
22967: {{BRN{STOPR{{{GIVE UP
22968: {{TTL{S{{{P I T B O L -- ERROR SECTION
22969: *
22970: * THIS SECTION OF CODE IS ENTERED WHENEVER A PROCEDURE
22971: * RETURN VIA AN ERR PARAMETER OR AN ERB OPCODE IS OBEYED.
22972: *
22973: * (WA) IS THE ERROR CODE
22974: *
22975: * THE GLOBAL VARIABLE STAGE INDICATES THE POINT AT WHICH
22976: * THE ERROR OCCURED AS FOLLOWS.
22977: *
22978: * STAGE=STGIC ERROR DURING INITIAL COMPILE
22979: *
22980: * STAGE=STGXC ERROR DURING COMPILE AT EXECUTE
22981: * TIME (CODE, CONVERT FUNCTION CALLS)
22982: *
22983: * STAGE=STGEV ERROR DURING COMPILATION OF
22984: * EXPRESSION AT EXECUTION TIME
22985: * (EVAL, CONVERT FUNCTION CALL).
22986: *
22987: * STAGE=STGXT ERROR AT EXECUTE TIME. COMPILER
22988: * NOT ACTIVE.
22989: *
22990: * STAGE=STGCE ERROR DURING INITIAL COMPILE AFTER
22991: * SCANNING OUT THE END LINE.
22992: *
22993: * STAGE=STGXE ERROR DURING COMPILE AT EXECUTE
22994: * TIME AFTER SCANNING END LINE.
22995: *
22996: * STAGE=STGEE ERROR DURING EXPRESSION EVALUATION
22997: *
22998: {{SEC{{{{START OF ERROR SECTION
22999: *
23000: {ERROR{BEQ{R$CIM{#CMLAB{CMPLE{JUMP IF ERROR IN SCANNING LABEL
23001: {{MOV{R6{KVERT{{SAVE ERROR CODE
23002: {{ZER{SCNRS{{{RESET RESCAN SWITCH FOR SCANE
23003: {{ZER{SCNGO{{{RESET GOTO SWITCH FOR SCANE
23004: {{MOV{STAGE{R9{{LOAD CURRENT STAGE
23005: {{BSW{R9{STGNO{{JUMP TO APPROPRIATE ERROR CIRCUIT
23006: {{IFF{STGIC{ERR01{{INITIAL COMPILE
23007: {{IFF{STGXC{ERR04{{EXECUTE TIME COMPILE
23008: {{IFF{STGEV{ERR04{{EVAL COMPILING EXPR.
23009: {{IFF{STGXT{ERR05{{EXECUTE TIME
23010: {{IFF{STGCE{ERR01{{COMPILE - AFTER END
23011: {{IFF{STGXE{ERR04{{XEQ COMPILE-PAST END
23012: {{IFF{STGEE{ERR04{{EVAL EVALUATING EXPR
23013: {{ESW{{{{END SWITCH ON ERROR TYPE
23014: {{EJC{{{{
23015: *
23016: * ERROR DURING INITIAL COMPILE
23017: *
23018: * THE ERROR MESSAGE IS PRINTED AS PART OF THE COMPILER
23019: * OUTPUT. THIS PRINTOUT INCLUDES THE OFFENDING LINE (IF NOT
23020: * PRINTED ALREADY) AND AN ERROR FLAG UNDER THE APPROPRIATE
23021: * COLUMN AS INDICATED BY SCNSE UNLESS SCNSE IS SET TO ZERO.
23022: *
23023: * AFTER PRINTING THE MESSAGE, THE GENERATED CODE IS
23024: * MODIFIED TO AN ERROR CALL AND CONTROL IS RETURNED TO
23025: * THE CMPIL PROCEDURE AFTER RESETTING THE STACK POINTER.
23026: *
23027: * IF THE ERROR OCCURS AFTER THE END LINE, CONTROL RETURNS
23028: * IN A SLIGHTLY DIFFERENT MANNER TO ENSURE PROPER CLEANUP.
23029: *
23030: {ERR01{MOV{CMPXS{SP{{RESET STACK POINTER
23031: {{SSL{CMPSS{{{RESTORE S-R STACK PTR FOR CMPIL
23032: {{BNZ{ERRSP{ERR03{{JUMP IF ERROR SUPPRESS FLAG SET
23033: {{MOV{ERICH{ERLST{{SET FLAG FOR LISTR
23034: {{JSR{LISTR{{{LIST LINE
23035: {{JSR{PRTIS{{{TERMINATE LISTING
23036: {{ZER{ERLST{{{CLEAR LISTR FLAG
23037: {{MOV{SCNSE{R6{{LOAD SCAN ELEMENT OFFSET
23038: {{BZE{R6{ERR02{{SKIP IF NOT SET
23039: {{LCT{R7{R6{{LOOP COUNTER
23040: {{ICV{R6{{{INCREASE FOR CH$EX
23041: {{JSR{ALOCS{{{STRING BLOCK FOR ERROR FLAG
23042: {{MOV{R9{R6{{REMEMBER STRING PTR
23043: {{PSC{R9{{{READY FOR CHARACTER STORING
23044: {{MOV{R$CIM{R10{{POINT TO BAD STATEMENT
23045: {{PLC{R10{{{READY TO GET CHARS
23046: *
23047: * LOOP TO REPLACE ALL CHARS BUT TABS BY BLANKS
23048: *
23049: {ERRA1{LCH{R8{(R10)+{{GET NEXT CHAR
23050: {{BEQ{R8{#CH$HT{ERRA2{SKIP IF TAB
23051: {{MOV{#CH$BL{R8{{GET A BLANK
23052: {{EJC{{{{
23053: *
23054: * MERGE TO STORE BLANK OR TAB IN ERROR LINE
23055: *
23056: {ERRA2{SCH{R8{(R9)+{{STORE CHAR
23057: {{BCT{R7{ERRA1{{LOOP
23058: {{MOV{#CH$EX{R10{{EXCLAMATION MARK
23059: {{SCH{R10{(R9){{STORE AT END OF ERROR LINE
23060: {{CSC{R9{{{END OF SCH LOOP
23061: {{MOV{#STNPD{PROFS{{ALLOW FOR STATEMENT NUMBER
23062: {{MOV{R6{R9{{POINT TO ERROR LINE
23063: {{JSR{PRTST{{{PRINT ERROR LINE
23064: *
23065: * HERE AFTER PLACING ERROR FLAG AS REQUIRED
23066: *
23067: {ERR02{JSR{ERMSG{{{GENERATE FLAG AND ERROR MESSAGE
23068: {{ADD{#NUM03{LSTLC{{BUMP PAGE CTR FOR BLANK, ERROR, BLK
23069: {{ZER{R9{{{IN CASE OF FATAL ERROR
23070: {{BHI{ERRFT{#NUM03{STOPR{PACK UP IF SEVERAL FATALS
23071: *
23072: * COUNT ERROR, INHIBIT EXECUTION IF REQUIRED
23073: *
23074: {{ICV{CMERC{{{BUMP ERROR COUNT
23075: {{ADD{CSWER{NOXEQ{{INHIBIT XEQ IF -NOERRORS
23076: {{BNE{STAGE{#STGIC{CMP10{SPECIAL RETURN IF AFTER END LINE
23077: {{EJC{{{{
23078: *
23079: * LOOP TO SCAN TO END OF STATEMENT
23080: *
23081: {ERR03{MOV{R$CIM{R9{{POINT TO START OF IMAGE
23082: {{PLC{R9{{{POINT TO FIRST CHAR
23083: {{LCH{R9{(R9){{GET FIRST CHAR
23084: {{BEQ{R9{#CH$MN{CMPCE{JUMP IF ERROR IN CONTROL CARD
23085: {{ZER{SCNRS{{{CLEAR RESCAN FLAG
23086: {{MNZ{ERRSP{{{SET ERROR SUPPRESS FLAG
23087: {{JSR{SCANE{{{SCAN NEXT ELEMENT
23088: {{BNE{R10{#T$SMC{ERR03{LOOP BACK IF NOT STATEMENT END
23089: {{ZER{ERRSP{{{CLEAR ERROR SUPPRESS FLAG
23090: *
23091: * GENERATE ERROR CALL IN CODE AND RETURN TO CMPIL
23092: *
23093: {{MOV{#4*CDCOD{CWCOF{{RESET OFFSET IN CCBLK
23094: {{MOV{#OCER${R6{{LOAD COMPILE ERROR CALL
23095: {{JSR{CDWRD{{{GENERATE IT
23096: {{MOV{CWCOF{4*CMSOC(SP){{SET SUCCESS FILL IN OFFSET
23097: {{MNZ{4*CMFFC(SP){{{SET FAILURE FILL IN FLAG
23098: {{JSR{CDWRD{{{GENERATE SUCC. FILL IN WORD
23099: {{BRN{CMPSE{{{MERGE TO GENERATE ERROR AS CDFAL
23100: *
23101: * ERROR DURING EXECUTE TIME COMPILE OR EXPRESSION EVALUATIO
23102: *
23103: * EXECUTE TIME COMPILATION IS INITIATED THROUGH GTCOD OR
23104: * GTEXP WHICH ARE CALLED BY COMPILE, CODE OR EVAL.
23105: * BEFORE CAUSING STATEMENT FAILURE THROUGH EXFAL IT IS
23106: * HELPFUL TO SET KEYWORD ERRTEXT AND FOR GENERALITY
23107: * THESE ERRORS MAY BE HANDLED BY THE SETEXIT MECHANISM.
23108: *
23109: {ERR04{ZER{R$CCB{{{FORGET GARBAGE CODE BLOCK
23110: {{SSL{INISS{{{RESTORE MAIN PROG S-R STACK PTR
23111: {{JSR{ERTEX{{{GET FAIL MESSAGE TEXT
23112: {{DCA{SP{{{ENSURE STACK OK ON LOOP START
23113: *
23114: * POP STACK UNTIL FIND FLPTR FOR MOST DEEPLY NESTED PROG.
23115: * DEFINED FUNCTION CALL OR CALL OF EVAL / CODE.
23116: *
23117: {ERRA4{ICA{SP{{{POP STACK
23118: {{BEQ{SP{FLPRT{ERRC4{JUMP IF PROG DEFINED FN CALL FOUND
23119: {{BNE{SP{GTCEF{ERRA4{LOOP IF NOT EVAL OR CODE CALL YET
23120: {{MOV{#STGXT{STAGE{{RE-SET STAGE FOR EXECUTE
23121: {{MOV{R$GTC{R$COD{{RECOVER CODE PTR
23122: {{MOV{SP{FLPTR{{RESTORE FAIL POINTER
23123: {{ZER{R$CIM{{{FORGET POSSIBLE IMAGE
23124: *
23125: * TEST ERRLIMIT
23126: *
23127: {ERRB4{BNZ{KVERL{ERR07{{JUMP IF ERRLIMIT NON-ZERO
23128: {{BRN{EXFAL{{{FAIL
23129: *
23130: * RETURN FROM PROG. DEFINED FUNCTION IS OUTSTANDING
23131: *
23132: {ERRC4{MOV{FLPTR{SP{{RESTORE STACK FROM FLPTR
23133: {{BRN{ERRB4{{{MERGE
23134: {{EJC{{{{
23135: *
23136: * ERROR AT EXECUTE TIME.
23137: *
23138: * THE ACTION TAKEN ON AN ERROR IS AS FOLLOWS.
23139: *
23140: * IF ERRLIMIT KEYWORD IS ZERO, AN ABORT IS SIGNALLED,
23141: * SEE CODING FOR SYSTEM LABEL ABORT AT L$ABO.
23142: *
23143: * OTHERWISE, ERRLIMIT IS DECREMENTED AND AN ERRTYPE TRACE
23144: * GENERATED IF REQUIRED. CONTROL RETURNS EITHER VIA A JUMP
23145: * TO CONTINUE (TO TAKE THE FAILURE EXIT) OR A SPECIFIED
23146: * SETEXIT TRAP IS EXECUTED AND CONTROL PASSES TO THE TRAP.
23147: * IF 3 OR MORE FATAL ERRORS OCCUR AN ABORT IS SIGNALLED
23148: * REGARDLESS OF ERRLIMIT AND SETEXIT - LOOPING IS ALL TOO
23149: * PROBABLE OTHERWISE. FATAL ERRORS INCLUDE STACK OVERFLOW
23150: * AND EXCEEDING STLIMIT.
23151: *
23152: {ERR05{SSL{INISS{{{RESTORE MAIN PROG S-R STACK PTR
23153: {{BNZ{DMVCH{ERR08{{JUMP IF IN MID-DUMP
23154: *
23155: * MERGE HERE FROM ERR08
23156: *
23157: {ERR06{BZE{KVERL{LABO1{{ABORT IF ERRLIMIT IS ZERO
23158: {{JSR{ERTEX{{{GET FAIL MESSAGE TEXT
23159: *
23160: * MERGE FROM ERR04
23161: *
23162: {ERR07{BGE{ERRFT{#NUM03{LABO1{ABORT IF TOO MANY FATAL ERRORS
23163: {{DCV{KVERL{{{DECREMENT ERRLIMIT
23164: {{MOV{R$ERT{R10{{LOAD ERRTYPE TRACE POINTER
23165: {{JSR{KTREX{{{GENERATE ERRTYPE TRACE IF REQUIRED
23166: {{MOV{R$COD{R$CNT{{SET CDBLK PTR FOR CONTINUATION
23167: {{MOV{FLPTR{R9{{SET PTR TO FAILURE OFFSET
23168: {{MOV{(R9){STXOF{{SAVE FAILURE OFFSET FOR CONTINUE
23169: {{MOV{R$SXC{R9{{LOAD SETEXIT CDBLK POINTER
23170: {{BZE{R9{LCNT1{{CONTINUE IF NO SETEXIT TRAP
23171: {{ZER{R$SXC{{{ELSE RESET TRAP
23172: {{MOV{#NULLS{STXVR{{RESET SETEXIT ARG TO NULL
23173: {{MOV{(R9){R10{{LOAD PTR TO CODE BLOCK ROUTINE
23174: {{BRI{R10{{{EXECUTE FIRST TRAP STATEMENT
23175: *
23176: * INTERRUPTED PARTLY THROUGH A DUMP WHILST STORE IS IN A
23177: * MESS SO DO A TIDY UP OPERATION. SEE DUMPR FOR DETAILS.
23178: *
23179: {ERR08{MOV{DMVCH{R9{{CHAIN HEAD FOR AFFECTED VRBLKS
23180: {{BZE{R9{ERR06{{DONE IF ZERO
23181: {{MOV{(R9){DMVCH{{SET NEXT LINK AS CHAIN HEAD
23182: {{JSR{SETVR{{{RESTORE VRGET FIELD
23183: {{BRN{ERR08{{{LOOP THROUGH CHAIN
23184: {{TTL{S{{{P I T B O L -- HERE ENDETH THE CODE
23185: *
23186: * END OF ASSEMBLY
23187: *
23188: {{END{{{{END MACRO-SPITBOL ASSEMBLY
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.