V10/cmd/spitbol/spitv35.tok
{{TTL{S{{{P I T B O L - REVISION HISTORY
{{EJC{{{{
* R E V I S I O N H I S T O R Y
* -------------------------------
*
*
* VERSION 3.5B (FEB 81... - SGD PATCHES)
* -----------------------------------
*
* SGD03 - ADDITION OF .CNCI AND SYSCI (INT->STRING
* SYSTEM ROUTINE OPTION)
* SGD04 - (06-MAY-1981) MODIFIED INILN TO 132
* SGD05 - (13-MAY-1981) INSERTED MISSING WTB AFTER SYSMM
* CALLS
* SGD06 - (25-MAY-1981) MERGED IN PROFILER PATCHES
* (NOT MARKED)
* SGD07 - (25-MAY-1981) MUCHO PATCHES TO PROFILER (MARKED,
* BUT BEST JUST TO EXTRACT ENMASSE)
* SGD08 - (25-MAY-1981) USE STRING LENGTH IN HASHS
* SGD09 - (25-MAY-1981) FIXED SERIOUS PARSER PROBLEM
* RELATING TO (X Y) ON LINE BEING VIEWED AS PATTERN
* MATCH. FIXED BY ADDITION OF NEW CMTYP VALUE
* C$CNP (CONCATENATION - NOT PATTERN MATCH)
* SGD10 - (01-AUG-1981) FIXED EXIT(N) RESPECIFICATION CODE
* TO PROPERLY OBSERVE HEADER SEMANTICS ON RETURN.
* SGD11 - (07-AUG-1981) BYPASS PRTPG CALL AT INITIALIZATION
* FOLLOWING COMPILATION IF NO OUTPUT GENERATED.
* THIS PREVENTS OUTPUT FILES CONSISTING OF THE
* HEADERS AND A FEW BLANK LINES WHEN THERE IS NO
* SOURCE LISTING AND NO COMPILATION STATS.
* ALSO FIX TIMSX INITIALIZATION IN SAME CODE.
* SGD12 - (17-AUG-1981) B$EFC CODE DID NOT CHECK FOR
* UNCONVERTED RESULT RETURNING NULL STRING. FIXED.
* SGDBF - ( NOV-1981) ADDED BUFFER TYPE AND SYMBOL CNBF
* SGD13 - (03-MAR-1982) LOAD PFVBL FIELD IN RETRN FOR
* RETURN TRACING. THIS WAS CAUSING BUG ON RETURN
* TRACES THAT TRIED TO ACCESS THE VARIABLE NAME
* SGD14 - ADDED CHAR FUNCTION. CHAR(N) RETURNS NTH
* CHARACTER OF HOST MACHINE CHARACTER SET.
* NOT CONDITIONALIZED OR MARKED.
* SGD15 - FIXED PROBLEM RELATING TO COMPILATION OF GOTO
* FIELDS CONTAINING SMALL INTEGERS (IN CONST SEC).
*
* REG01 - (XX-AUG-82)
* ADDED CFP$U TO EASE TRANSLATION ON SMALLER
* SYSTEMS - CONDITIONAL .CUCF
* ADDED LOWER CASE SUPPORT - CONDITIONAL .CULC
* ADDED SET I/O FUNCTION - CONDITIONAL .CUST
*
* REG02 - (XX-SEP-82)
* CHANGED INILN AND AND INILS TO 258
*
* REG03 - (XX-OCT-82)
* CONDITIONALIZED THE PAGE EJECT AFTER CALL TO SYSBX
* AND ADDED ANOTHER BEFORE CALL TO SYSBX, SO THAT,
* IF DESIRED BY THE IMPLEMENTOR, STANDARD OUTPUT
* WILL REFLECT ASSIGNMENTS MADE BY EXECUTING PROGRAM
* ONLY. CONDITIONAL .CUEJ CONTROLS - IF DEFINED
* EJECT IS BEFORE CALL TO SYSBX.
*
* REG04 - (XX-NOV-82)
* FIXED DIFFICULTIES WITH LISTINGS DURING EXECUTION
* WHEN NO LISTING GENERATED DURING COMPILATION.
*
* -LIST TO CODE() CAUSED BOMB. FIX IS TO RESET
* R$TTL AND R$STL TO NULLS NOT 0 AFTER COMPILATION.
* (LISTR AND LISTT EXPECT NULLS)
*
* WHEN LISTING AND STATISTICS ROUTED TO DIFFERENT
* FILE THAN EXECUTION OUTPUT, ERROR MESSAGE IS SENT
* TO EXECUTION OUTPUT (AND GETS SEPARATED FROM
* ... IN STATEMENT ... MSG). LABO1 CALLS SYSAX AND
* STOPR DOES NOT CALL SYSAX IF ENTERED FROM LABO1.
*
* REG05 - (XX-NOV-82)
* PREVENT CLEAR() FROM CLOBBERING PROTECTED VARIABLES
* AT LABEL SCLR5.
*
* REG06 - (XX-NOV-82)
* FIXED GTEXP FROM ACCEPTING TRAILING SEMICOLON OR
* COLON. NOT LEGAL WAY TO END AN EXPRESSION.
*
* VERSION 3.5A (OCT 79 - SGD PATCHES)
* -----------------------------------
*
* SGD01 - PATCH IN ASIGN TO FIX MULTIPLE TRAP BLOCK PROBLEM
* (ASG10+2)
* SGD02 - PATCH IN GTARR TO FIX NULL CONVERT (GTAR9+0)
*
{{TTL{S{{{P I T B O L -- BASIC INFORMATION
{{EJC{{{{
*
* GENERAL STRUCTURE
* -----------------
*
* THIS PROGRAM IS A TRANSLATOR FOR A VERSION OF THE SNOBOL4
* PROGRAMMING LANGUAGE. LANGUAGE DETAILS ARE CONTAINED IN
* THE MANUAL MACRO SPITBOL BY DEWAR AND MCCANN, TECHNICAL
* REPORT 90, UNIVERSITY OF LEEDS 1976. THE LANGUAGE
* IS IDENTICAL TO THAT IMPLEMENTED BY THE BTL TRANSLATOR
* (R. E. GRISWOLD ET AL.) WITH THE FOLLOWING EXCEPTIONS.
*
* 1) REDEFINITION OF STANDARD SYSTEM FUNCTIONS AND
* OPERATORS IS NOT PERMITTED.
*
* 2) THE VALUE FUNCTION IS NOT PROVIDED.
*
* 3) ACCESS TRACING IS PROVIDED IN ADDITION TO THE
* OTHER STANDARD TRACE MODES.
*
* 4) THE KEYWORD STFCOUNT IS NOT PROVIDED.
*
* 5) THE KEYWORD FULLSCAN IS NOT PROVIDED AND ALL PATTERN
* MATCHING TAKES PLACE IN FULLSCAN MODE (I.E. WITH NO
* HEURISTICS APPLIED).
*
* 6) A SERIES OF EXPRESSIONS SEPARATED BY COMMAS MAY
* BE GROUPED WITHIN PARENTHESES TO PROVIDE A SELECTION
* CAPABILITY. THE SEMANTICS ARE THAT THE SELECTION
* ASSUMES THE VALUE OF THE FIRST EXPRESSION WITHIN IT
* WHICH SUCCEEDS AS THEY ARE EVALUATED FROM THE LEFT.
* IF NO EXPRESSION SUCCEEDS THE ENTIRE STATEMENT FAILS
*
* 7) AN EXPLICIT PATTERN MATCHING OPERATOR IS PROVIDED.
* THIS IS THE BINARY QUERY (SEE GIMPEL SIGPLAN OCT 74)
*
* 8) THE ASSIGNMENT OPERATOR IS INTRODUCED AS IN THE
* GIMPEL REFERENCE.
*
* 9) THE EXIT FUNCTION IS PROVIDED FOR GENERATING LOAD
* MODULES - CF. GIMPELS SITBOL.
*
*
* THE METHOD USED IN THIS PROGRAM IS TO TRANSLATE THE
* SOURCE CODE INTO AN INTERNAL PSEUDO-CODE (SEE FOLLOWING
* SECTION). AN INTERPRETOR IS THEN USED TO EXECUTE THIS
* GENERATED PSEUDO-CODE. THE NATURE OF THE SNOBOL4 LANGUAGE
* IS SUCH THAT THE LATTER TASK IS MUCH MORE COMPLEX THAN
* THE ACTUAL TRANSLATION PHASE. ACCORDINGLY, NEARLY ALL THE
* CODE IN THE PROGRAM SECTION IS CONCERNED WITH THE ACTUAL
* EXECUTION OF THE SNOBOL4 PROGRAM.
{{EJC{{{{
*
* INTERPRETIVE CODE FORMAT
* ------------------------
*
* THE INTERPRETIVE PSEUDO-CODE CONSISTS OF A SERIES OF
* ADDRESS POINTERS. THE EXACT FORMAT OF THE CODE IS
* DESCRIBED IN CONNECTION WITH THE CDBLK FORMAT. THE
* PURPOSE OF THIS SECTION IS TO GIVE GENERAL INSIGHT INTO
* THE INTERPRETIVE APPROACH INVOLVED.
*
* THE BASIC FORM OF THE CODE IS RELATED TO REVERSE POLISH.
* IN OTHER WORDS, THE OPERANDS PRECEDE THE OPERATORS WHICH
* ARE ZERO ADDRESS OPERATORS. THERE ARE SOME EXCEPTIONS TO
* THESE RULES, NOTABLY THE UNARY NOT OPERATOR AND THE
* SELECTION CONSTRUCTION WHICH CLEARLY REQUIRE ADVANCE
* KNOWLEDGE OF THE OPERATOR INVOLVED.
*
* THE OPERANDS ARE MOVED TO THE TOP OF THE MAIN STACK AND
* THE OPERATORS ARE APPLIED TO THE TOP STACK ENTRIES. LIKE
* OTHER VERSIONS OF SPITBOL, THIS PROCESSOR DEPENDS ON
* KNOWING WHETHER OPERANDS ARE REQUIRED BY NAME OR BY VALUE
* AND MOVES THE APPROPRIATE OBJECT TO THE STACK. THUS NO
* NAME/VALUE CHECKS ARE INCLUDED IN THE OPERATOR CIRCUITS.
*
* THE ACTUAL POINTERS IN THE CODE POINT TO A BLOCK WHOSE
* FIRST WORD IS THE ADDRESS OF THE INTERPRETOR ROUTINE
* TO BE EXECUTED FOR THE CODE WORD.
*
* IN THE CASE OF OPERATORS, THE POINTER IS TO A WORD WHICH
* CONTAINS THE ADDRESS OF THE OPERATOR TO BE EXECUTED. IN
* THE CASE OF OPERANDS SUCH AS CONSTANTS, THE POINTER IS TO
* THE OPERAND ITSELF. ACCORDINGLY, ALL OPERANDS CONTAIN
* A FIELD WHICH POINTS TO THE ROUTINE TO LOAD THE VALUE OF
* THE OPERAND ONTO THE STACK. IN THE CASE OF A VARIABLE,
* THERE ARE THREE SUCH POINTERS. ONE TO LOAD THE VALUE,
* ONE TO STORE THE VALUE AND A THIRD TO JUMP TO THE LABEL.
*
* THE HANDLING OF FAILURE RETURNS DESERVES SPECIAL COMMENT.
* THE LOCATION FLPTR CONTAINS THE POINTER TO THE LOCATION
* ON THE MAIN STACK WHICH CONTAINS THE FAILURE RETURN
* WHICH IS IN THE FORM OF A BYTE OFFSET IN THE CURRENT
* CODE BLOCK (CDBLK OR EXBLK). WHEN A FAILURE OCCURS, THE
* STACK IS POPPED AS INDICATED BY THE SETTING OF FLPTR AND
* CONTROL IS PASSED TO THE APPROPRIATE LOCATION IN THE
* CURRENT CODE BLOCK WITH THE STACK POINTER POINTING TO THE
* FAILURE OFFSET ON THE STACK AND FLPTR UNCHANGED.
{{EJC{{{{
*
* INTERNAL DATA REPRESENTATIONS
* -----------------------------
*
* REPRESENTATION OF VALUES
*
* A VALUE IS REPRESENTED BY A POINTER TO A BLOCK WHICH
* DESCRIBES THE TYPE AND PARTICULARS OF THE DATA VALUE.
* IN GENERAL, A VARIABLE IS A LOCATION CONTAINING SUCH A
* POINTER (ALTHOUGH IN THE CASE OF TRACE ASSOCIATIONS THIS
* IS MODIFIED, SEE DESCRIPTION OF TRBLK).
*
* THE FOLLOWING IS A LIST OF POSSIBLE DATATYPES SHOWING THE
* TYPE OF BLOCK USED TO HOLD THE VALUE. THE DETAILS OF
* EACH BLOCK FORMAT ARE GIVEN LATER.
*
* DATATYPE BLOCK TYPE
* -------- ----------
*
*
* ARRAY ARBLK OR VCBLK
*
* CODE CDBLK
*
* EXPRESSION EXBLK OR SEBLK
*
* INTEGER ICBLK
*
* NAME NMBLK
*
* PATTERN P0BLK OR P1BLK OR P2BLK
*
* REAL RCBLK
*
* STRING SCBLK
*
* TABLE TBBLK
*
* PROGRAM DATATYPE PDBLK
{{EJC{{{{
*
* REPRESENTATION OF VARIABLES
* ---------------------------
*
* DURING THE COURSE OF EVALUATING EXPRESSIONS, IT IS
* NECESSARY TO GENERATE NAMES OF VARIABLES (FOR EXAMPLE
* ON THE LEFT SIDE OF A BINARY EQUALS OPERATOR). THESE ARE
* NOT TO BE CONFUSED WITH OBJECTS OF DATATYPE NAME WHICH
* ARE IN FACT VALUES.
*
* FROM A LOGICAL POINT OF VIEW, SUCH NAMES COULD BE SIMPLY
* REPRESENTED BY A POINTER TO THE APPROPRIATE VALUE CELL.
* HOWEVER IN THE CASE OF ARRAYS AND PROGRAM DEFINED
* DATATYPES, THIS WOULD VIOLATE THE RULE THAT THERE MUST BE
* NO POINTERS INTO THE MIDDLE OF A BLOCK IN DYNAMIC STORE.
* ACCORDINGLY, A NAME IS ALWAYS REPRESENTED BY A BASE AND
* OFFSET. THE BASE POINTS TO THE START OF THE BLOCK
* CONTAINING THE VARIABLE VALUE AND THE OFFSET IS THE
* OFFSET WITHIN THIS BLOCK IN BYTES. THUS THE ADDRESS
* OF THE ACTUAL VARIABLE IS DETERMINED BY ADDING THE BASE
* AND OFFSET VALUES.
*
* THE FOLLOWING ARE THE INSTANCES OF VARIABLES REPRESENTED
* IN THIS MANNER.
*
* 1) NATURAL VARIABLE BASE IS PTR TO VRBLK
* OFFSET IS *VRVAL
*
* 2) TABLE ELEMENT BASE IS PTR TO TEBLK
* OFFSET IS *TEVAL
*
* 3) ARRAY ELEMENT BASE IS PTR TO ARBLK
* OFFSET IS OFFSET TO ELEMENT
*
* 4) VECTOR ELEMENT BASE IS PTR TO VCBLK
* OFFSET IS OFFSET TO ELEMENT
*
* 5) PROG DEF DTP BASE IS PTR TO PDBLK
* OFFSET IS OFFSET TO FIELD VALUE
*
* IN ADDITION THERE ARE TWO CASES OF OBJECTS WHICH ARE
* LIKE VARIABLES BUT CANNOT BE HANDLED IN THIS MANNER.
* THESE ARE CALLED PSEUDO-VARIABLES AND ARE REPRESENTED
* WITH A SPECIAL BASE POINTER AS FOLLOWS=
*
* EXPRESSION VARIABLE PTR TO EVBLK (SEE EVBLK)
*
* KEYWORD VARIABLE PTR TO KVBLK (SEE KVBLK)
*
* PSEUDO-VARIABLES ARE HANDLED AS SPECIAL CASES BY THE
* ACCESS PROCEDURE (ACESS) AND THE ASSIGNMENT PROCEDURE
* (ASIGN). SEE THESE TWO PROCEDURES FOR DETAILS.
{{EJC{{{{
*
* ORGANIZATION OF DATA AREA
* -------------------------
*
*
* THE DATA AREA IS DIVIDED INTO TWO REGIONS.
*
* STATIC AREA
*
* THE STATIC AREA BUILDS UP FROM THE BOTTOM AND CONTAINS
* DATA AREAS WHICH ARE ALLOCATED DYNAMICALLY BUT ARE NEVER
* DELETED OR MOVED AROUND. THE MACRO-PROGRAM ITSELF
* USES THE STATIC AREA FOR THE FOLLOWING.
*
* 1) ALL VARIABLE BLOCKS (VRBLK).
*
* 2) THE HASH TABLE FOR VARIABLE BLOCKS.
*
* 3) MISCELLANEOUS BUFFERS AND WORK AREAS (SEE PROGRAM
* INITIALIZATION SECTION).
*
* IN ADDITION, THE SYSTEM PROCEDURES MAY USE THIS AREA FOR
* INPUT/OUTPUT BUFFERS, EXTERNAL FUNCTIONS ETC. SPACE IN
* THE STATIC REGION IS ALLOCATED BY CALLING PROCEDURE ALOST
*
* THE FOLLOWING GLOBAL VARIABLES DEFINE THE CURRENT
* LOCATION AND SIZE OF THE STATIC AREA.
*
* STATB ADDRESS OF START OF STATIC AREA
* STATE ADDRESS+1 OF LAST WORD IN AREA.
*
* THE MINIMUM SIZE OF STATIC IS GIVEN APPROXIMATELY BY
* 12 + *E$HNB + *E$STS + SPACE FOR ALPHABET STRING
* AND STANDARD PRINT BUFFER.
{{EJC{{{{
*
* DYNAMIC AREA
*
* THE DYNAMIC AREA IS BUILT UPWARDS IN MEMORY AFTER THE
* STATIC REGION. DATA IN THIS AREA MUST ALL BE IN STANDARD
* BLOCK FORMATS SO THAT IT CAN BE PROCESSED BY THE GARBAGE
* COLLECTOR (PROCEDURE GBCOL). GBCOL COMPACTS BLOCKS DOWN
* IN THIS REGION AS REQUIRED BY SPACE EXHAUSTION AND CAN
* ALSO MOVE ALL BLOCKS UP TO ALLOW FOR EXPANSION OF THE
* STATIC REGION.
* WITH THE EXCEPTION OF TABLES AND ARRAYS, NO SPITBOL
* OBJECT ONCE BUILT IN DYNAMIC MEMORY IS EVER SUBSEQUENTLY
* MODIFIED. OBSERVING THIS RULE NECESSITATES A COPYING
* ACTION DURING STRING AND PATTERN CONCATENATION.
*
* GARBAGE COLLECTION IS FUNDAMENTAL TO THE ALLOCATION OF
* SPACE FOR VALUES. SPITBOL USES A VERY EFFICIENT GARBAGE
* COLLECTOR WHICH INSISTS THAT POINTERS INTO DYNAMIC STORE
* SHOULD BE IDENTIFIABLE WITHOUT USE OF BIT TABLES,
* MARKER BITS ETC. TO SATISFY THIS REQUIREMENT, DYNAMIC
* MEMORY MUST NOT START AT TOO LOW AN ADDRESS AND LENGTHS
* OF ARRAYS, TABLES, STRINGS, CODE AND EXPRESSION BLOCKS
* MAY NOT EXCEED THE NUMERICAL VALUE OF THE LOWEST DYNAMIC
* ADDRESS. TO AVOID EITHER PENALIZING USERS WITH MODEST
* REQUIREMENTS OR RESTRICTING THOSE WITH GREATER NEEDS ON
* HOST SYSTEMS WHERE DYNAMIC MEMORY IS ALLOCATED IN LOW
* ADDRESSES, THE MINIMUM DYNAMIC ADDRESS MAY BE SPECIFIED
* SUFFICIENTLY HIGH TO PERMIT ARBITRARILY LARGE SPITBOL
* OBJECTS TO BE CREATED ( WITH THE POSSIBILITY IN EXTREME
* CASES OF WASTING LARGE AMOUNTS OF MEMORY BELOW THE
* START ADDRESS). THIS MINIMUM VALUE IS MADE AVAILABLE
* IN VARIABLE MXLEN BY A SYSTEM ROUTINE, SYSMX.
* ALTERNATIVELY SYSMX MAY INDICATE THAT A
* DEFAULT MAY BE USED IN WHICH DYNAMIC IS PLACED
* AT THE LOWEST POSSIBLE ADDRESS FOLLOWING STATIC.
*
* THE FOLLOWING GLOBAL WORK CELLS DEFINE THE LOCATION AND
* LENGTH OF THE DYNAMIC AREA.
*
* DNAMB START OF DYNAMIC AREA
* DNAMP NEXT AVAILABLE LOCATION
* DNAME LAST AVAILABLE LOCATION + 1
*
* DNAMB IS ALWAYS HIGHER THAN STATE SINCE THE ALOST
* PROCEDURE MAINTAINS SOME EXPANSION SPACE ABOVE STATE.
* *** DNAMB MUST NEVER BE PERMITTED TO HAVE A VALUE LESS
* THAN THAT IN MXLEN ***
*
* SPACE IN THE DYNAMIC REGION IS ALLOCATED BY THE ALLOC
* PROCEDURE. THE DYNAMIC REGION MAY BE USED BY SYSTEM
* PROCEDURES PROVIDED THAT ALL THE RULES ARE OBEYED.
{{EJC{{{{
*
* REGISTER USAGE
* --------------
*
* (CP) CODE POINTER REGISTER. USED TO
* HOLD A POINTER TO THE CURRENT
* LOCATION IN THE INTERPRETIVE PSEUDO
* CODE (I.E. PTR INTO A CDBLK).
*
* (XL,XR) GENERAL INDEX REGISTERS. USUALLY
* USED TO HOLD POINTERS TO BLOCKS IN
* DYNAMIC STORAGE. AN IMPORTANT
* RESTRICTION IS THAT THE VALUE IN
* XL MUST BE COLLECTABLE FOR
* A GARBAGE COLLECT CALL. A VALUE
* IS COLLECTABLE IF IT EITHER POINTS
* OUTSIDE THE DYNAMIC AREA, OR IF IT
* POINTS TO THE START OF A BLOCK IN
* THE DYNAMIC AREA.
*
* (XS) STACK POINTER. USED TO POINT TO
* THE STACK FRONT. THE STACK MAY
* BUILD UP OR DOWN AND IS USED
* TO STACK SUBROUTINE RETURN POINTS
* AND OTHER RECURSIVELY SAVED DATA.
*
* (XT) AN ALTERNATIVE NAME FOR XL DURING
* ITS USE IN ACCESSING STACKED ITEMS.
*
* (WA,WB,WC) GENERAL WORK REGISTERS. CANNOT BE
* USED FOR INDEXING, BUT MAY HOLD
* VARIOUS TYPES OF DATA.
*
* (IA) USED FOR ALL SIGNED INTEGER
* ARITHMETIC, BOTH THAT USED BY THE
* TRANSLATOR AND THAT ARISING FROM
* USE OF SNOBOL4 ARITHMETIC OPERATORS
*
* (RA) REAL ACCUMULATOR. USED FOR ALL
* FLOATING POINT ARITHMETIC.
{{EJC{{{{
*
* SPITBOL CONDITIONAL ASSEMBLY SYMBOLS
* ------------------------------------
*
* IN THE SPITBOL TRANSLATOR, THE FOLLOWING CONDITIONAL
* ASSEMBLY SYMBOLS ARE REFERRED TO. TO INCORPORATE THE
* FEATURES REFERRED TO, THE MINIMAL SOURCE SHOULD BE
* PREFACED BY SUITABLE CONDITIONAL ASSEMBLY SYMBOL
* DEFINITIONS.
* IN ALL CASES IT IS PERMISSIBLE TO DEFAULT THE DEFINITIONS
* IN WHICH CASE THE ADDITIONAL FEATURES WILL BE OMITTED
* FROM THE TARGET CODE.
*
* .CASL DEFINE TO INCLUDE 26 SHIFTED LETTRS
* .CAHT DEFINE TO INCLUDE HORIZONTAL TAB
* .CAVT DEFINE TO INCLUDE VERTICAL TAB
* .CIOD IF DEFINED, DEFAULT DELIMITER IS
* NOT USED IN PROCESSING 3RD ARG OF
* INPUT() AND OUTPUT()
* .CNBT DEFINE TO OMIT BATCH INITIALISATION
* .CNCI DEFINE TO ENABLE SYSCI ROUTINE
* .CNEX DEFINE TO OMIT EXIT() CODE.
* .CNLD DEFINE TO OMIT LOAD() CODE.
* .CNPF DEFINE TO OMIT PROFILE STUFF
* .CNRA DEFINE TO OMIT ALL REAL ARITHMETIC
* .CNSR DEFINE TO OMIT SORT, RSORT
* .CSAX DEFINE IF SYSAX IS TO BE CALLED
* .CSN6 DEFINE TO PAD STMT NOS TO 6 CHARS
* .CSN8 DEFINE TO PAD STMT NOS TO 8 CHARS
* .CUCF DEFINE TO INCLUDE CFP$U
* .CULC DEFINE TO INCLUDE &CASE (LC NAMES)
* .CUST DEFINE TO INCLUDE SET() CODE
{{TTL{S{{{P I T B O L -- PROCEDURES SECTION
*
* THIS SECTION STARTS WITH DESCRIPTIONS OF THE OPERATING
* SYSTEM DEPENDENT PROCEDURES WHICH ARE USED BY THE SPITBOL
* TRANSLATOR. ALL SUCH PROCEDURES HAVE FIVE LETTER NAMES
* BEGINNING WITH SYS. THEY ARE LISTED IN ALPHABETICAL
* ORDER.
* ALL PROCEDURES HAVE A SPECIFICATION CONSISTING OF A
* MODEL CALL, PRECEDED BY A POSSIBLY EMPTY LIST OF REGISTER
* CONTENTS GIVING PARAMETERS AVAILABLE TO THE PROCEDURE AND
* FOLLOWED BY A POSSIBLY EMPTY LIST OF REGISTER CONTENTS
* REQUIRED ON RETURN FROM THE CALL OR WHICH MAY HAVE HAD
* THEIR CONTENTS DESTROYED. ONLY THOSE REGISTERS EXPLICITLY
* MENTIONED IN THE LIST AFTER THE CALL MAY HAVE THEIR
* VALUES CHANGED.
* THE SEGMENT OF CODE PROVIDING THE EXTERNAL PROCEDURES IS
* CONVENIENTLY REFERRED TO AS OSINT (OPERATING SYSTEM
* INTERFACE). THE SYSXX PROCEDURES IT CONTAINS PROVIDE
* FACILITIES NOT USUALLY AVAILABLE AS PRIMITIVES IN
* ASSEMBLY LANGUAGES. FOR PARTICULAR TARGET MACHINES,
* IMPLEMENTORS MAY CHOOSE FOR SOME MINIMAL OPCODES WHICH
* DO NOT HAVE REASONABLY DIRECT TRANSLATIONS, TO USE CALLS
* OF ADDITIONAL PROCEDURES WHICH THEY PROVIDE IN OSINT.
* E.G. MWB OR TRC MIGHT BE TRANSLATED AS JSR SYSMB,
* JSR SYSTC IN SOME IMPLEMENTATIONS.
*
* IN THE DESCRIPTIONS, REFERENCE IS MADE TO --BLK
* FORMATS (-- = A PAIR OF LETTERS). SEE THE SPITBOL
* DEFINITIONS SECTION FOR DETAILED DESCRIPTIONS OF ALL
* SUCH BLOCK FORMATS EXCEPT FCBLK FOR WHICH SYSFC SHOULD
* BE CONSULTED.
*
* SECTION 0 CONTAINS INP,INR SPECIFICATIONS OF INTERNAL
* PROCEDURES,ROUTINES. THIS GIVES A SINGLE PASS TRANSLATOR
* INFORMATION MAKING IT EASY TO GENERATE ALTERNATIVE CALLS
* IN THE TRANSLATION OF JSR-S FOR PROCEDURES OF DIFFERENT
* TYPES IF THIS PROVES NECESSARY.
*
{{SEC{{{{START OF PROCEDURES SECTION
{{EJC{{{{
*
* SYSAX -- AFTER EXECUTION
*
{SYSAX{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* IF THE CONDITIONAL ASSEMBLY SYMBOL .CSAX IS DEFINED,
* THIS ROUTINE IS CALLED IMMEDIATELY AFTER EXECUTION AND
* BEFORE PRINTING OF EXECUTION STATISTICS OR DUMP OUTPUT.
* PURPOSE OF CALL IS FOR IMPLEMENTOR TO DETERMINE AND
* IF THE CALL IS NOT REQUIRED IT WILL BE OMITTED IF .CSAX
* IS UNDEFINED. IN THIS CASE SYSAX NEED NOT BE CODED.
*
* JSR SYSAX CALL AFTER EXECUTION
{{EJC{{{{
*
* SYSBX -- BEFORE EXECUTION
*
{SYSBX{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* CALLED AFTER INITIAL SPITBOL COMPILATION AND BEFORE
* COMMENCING EXECUTION IN CASE OSINT NEEDS
* TO ASSIGN FILES OR PERFORM OTHER NECESSARY SERVICES.
* OSINT MAY ALSO CHOOSE TO SEND A MESSAGE TO ONLINE
* TERMINAL (IF ANY) INDICATING THAT EXECUTION IS STARTING.
*
* JSR SYSBX CALL BEFORE EXECUTION STARTS
{{EJC{{{{
*
* SYSDC -- DATE CHECK
*
{SYSDC{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSDC IS CALLED TO CHECK THAT THE EXPIRY DATE FOR A TRIAL
* VERSION OF SPITBOL IS UNEXPIRED.
*
* JSR SYSDC CALL TO CHECK DATE
* RETURN ONLY IF DATE IS OK
{{EJC{{{{
*
* SYSDM -- DUMP CORE
*
{SYSDM{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSDM IS CALLED BY A SPITBOL PROGRAM CALL OF DUMP(N) WITH
* N GE 3. ITS PURPOSE IS TO PROVIDE A CORE DUMP.
* N COULD HOLD AN ENCODING OF THE START ADRS FOR DUMP AND
* AMOUNT TO BE DUMPED E.G. N = 256*A + S , S = START ADRS
* IN KILOWORDS, A = KILOWORDS TO DUMP
*
* (XR) PARAMETER N OF CALL DUMP(N)
* JSR SYSDM CALL TO ENTER ROUTINE
{{EJC{{{{
*
* SYSDT -- GET CURRENT DATE
*
{SYSDT{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSDT IS USED TO OBTAIN THE CURRENT DATE. THE DATE IS
* RETURNED AS A CHARACTER STRING IN ANY FORMAT APPROPRIATE
* TO THE OPERATING SYSTEM IN USE. IT MAY ALSO CONTAIN THE
* CURRENT TIME OF DAY. SYSDT IS USED TO IMPLEMENT THE
* SNOBOL4 FUNCTION DATE.
*
* JSR SYSDT CALL TO GET DATE
* (XL) POINTER TO BLOCK CONTAINING DATE
*
* THE FORMAT OF THE BLOCK IS LIKE AN SCBLK EXCEPT THAT
* THE FIRST WORD NEED NOT BE SET. THE RESULT IS COPIED
* INTO SPITBOL DYNAMIC MEMORY ON RETURN.
{{EJC{{{{
*
* SYSEF -- EJECT FILE
*
{SYSEF{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSEF IS USED TO WRITE A PAGE EJECT TO A NAMED FILE. IT
* MAY ONLY BE USED FOR FILES WHERE THIS CONCEPT MAKES
* SENSE. NOTE THAT SYSEF IS NOT NORMALLY USED FOR THE
* STANDARD OUTPUT FILE (SEE SYSEP).
*
* (WA) PTR TO FCBLK OR ZERO
* (XR) EJECT ARGUMENT (SCBLK PTR)
* JSR SYSEF CALL TO EJECT FILE
* PPM LOC RETURN HERE IF FILE DOES NOT EXIST
* PPM LOC RETURN HERE IF INAPPROPRIATE FILE
* PPM LOC RETURN HERE IF I/O ERROR
{{EJC{{{{
*
* SYSEJ -- END OF JOB
*
{SYSEJ{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSEJ IS CALLED ONCE AT THE END OF EXECUTION TO
* TERMINATE THE RUN. THE SIGNIFICANCE OF THE ABEND AND
* CODE VALUES IS SYSTEM DEPENDENT. IN GENERAL, THE CODE
* VALUE SHOULD BE MADE AVAILABLE FOR TESTING, AND THE
* ABEND VALUE SHOULD CAUSE SOME POST-MORTEM ACTION SUCH AS
* A DUMP. NOTE THAT SYSEJ DOES NOT RETURN TO ITS CALLER.
* SEE SYSXI FOR DETAILS OF FCBLK CHAIN
*
* (WA) VALUE OF ABEND KEYWORD
* (WB) VALUE OF CODE KEYWORD
* (XL) O OR PTR TO HEAD OF FCBLK CHAIN
* JSR SYSEJ CALL TO END JOB
*
* THE FOLLOWING SPECIAL VALUES ARE USED AS CODES IN (WB)
* 999 EXECUTION SUPPRESSED
* 998 STANDARD OUTPUT FILE FULL OR UNAVAILABLE IN A SYSXI
* LOAD MODULE. IN THESE CASES (WA) CONTAINS THE NUMBER
* OF THE STATEMENT CAUSING PREMATURE TERMINATION.
{{EJC{{{{
*
* SYSEM -- GET ERROR MESSAGE TEXT
*
{SYSEM{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSEM IS USED TO OBTAIN THE TEXT OF ERR, ERB CALLS IN THE
* SOURCE PROGRAM GIVEN THE ERROR CODE NUMBER. IT IS ALLOWED
* TO RETURN A NULL STRING IF THIS FACILITY IS UNAVAILABLE.
*
* (WA) ERROR CODE NUMBER
* JSR SYSEM CALL TO GET TEXT
* (XR) TEXT OF MESSAGE
*
* THE RETURNED VALUE IS A POINTER TO A BLOCK IN SCBLK
* FORMAT EXCEPT THAT THE FIRST WORD NEED NOT BE SET. THE
* STRING IS COPIED INTO DYNAMIC MEMORY ON RETURN.
* IF THE NULL STRING IS RETURNED EITHER BECAUSE SYSEM DOES
* NOT PROVIDE ERROR MESSAGE TEXTS OR BECAUSE WA IS OUT OF
* RANGE, SPITBOL WILL PRINT THE STRING STORED IN ERRTEXT
* KEYWORD.
{{EJC{{{{
*
* SYSEN -- ENDFILE
*
{SYSEN{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSEN IS USED TO IMPLEMENT THE SNOBOL4 FUNCTION ENDFILE.
* THE MEANING IS SYSTEM DEPENDENT. IN GENERAL, ENDFILE
* IMPLIES THAT NO FURTHER I/O OPERATIONS WILL BE PERFORMED,
* BUT DOES NOT GUARANTEE THIS TO BE THE CASE. THE FILE
* SHOULD BE CLOSED AFTER THE CALL, A SUBSEQUENT READ
* OR WRITE MAY REOPEN THE FILE AT THE START OR IT MAY BE
* NECESSARY TO REOPEN THE FILE VIA SYSIO.
*
* (WA) PTR TO FCBLK OR ZERO
* (XR) ENDFILE ARGUMENT (SCBLK PTR)
* JSR SYSEN CALL TO ENDFILE
* PPM LOC RETURN HERE IF FILE DOES NOT EXIST
* PPM LOC RETURN HERE IF ENDFILE NOT ALLOWED
* PPM LOC RETURN HERE IF I/O ERROR
* (WA,WB) DESTROYED
*
* THE SECOND ERROR RETURN IS USED FOR FILES FOR WHICH
* ENDFILE IS NOT PERMITTED. FOR EXAMPLE, IT MAY BE EXPECTED
* THAT THE STANDARD INPUT AND OUTPUT FILES ARE IN THIS
* CATEGORY.
{{EJC{{{{
*
* SYSEP -- EJECT PRINTER PAGE
*
{SYSEP{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSEP IS CALLED TO PERFORM A PAGE EJECT ON THE STANDARD
* PRINTER OUTPUT FILE (CORRESPONDING TO SYSPR OUTPUT).
*
* JSR SYSEP CALL TO EJECT PRINTER OUTPUT
{{EJC{{{{
*
* SYSEX -- CALL EXTERNAL FUNCTION
*
{SYSEX{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSEX IS CALLED TO PASS CONTROL TO AN EXTERNAL FUNCTION
* PREVIOUSLY LOADED WITH A CALL TO SYSLD.
*
* (XS) POINTER TO ARGUMENTS ON STACK
* (XL) POINTER TO CONTROL BLOCK (EFBLK)
* (WA) NUMBER OF ARGUMENTS ON STACK
* JSR SYSEX CALL TO PASS CONTROL TO FUNCTION
* PPM LOC RETURN HERE IF FUNCTION CALL FAILS
* (XS) POPPED PAST ARGUMENTS
* (XR) RESULT RETURNED
*
* THE ARGUMENTS ARE STORED ON THE STACK WITH
* THE LAST ARGUMENT AT 0(XS). ON RETURN, XS
* IS POPPED PAST THE ARGUMENTS.
*
* THE FORM OF THE ARGUMENTS AS PASSED IS THAT USED IN THE
* SPITBOL TRANSLATOR (SEE DEFINITIONS AND DATA STRUCTURES
* SECTION). THE CONTROL BLOCK FORMAT IS ALSO DESCRIBED
* (UNDER EFBLK) IN THIS SECTION.
*
* THERE ARE TWO WAYS OF RETURNING A RESULT.
*
* 1) RETURN A POINTER TO A BLOCK IN DYNAMIC STORAGE. THIS
* BLOCK MUST BE IN EXACTLY CORRECT FORMAT, INCLUDING
* THE FIRST WORD. ONLY FUNCTIONS WRITTEN WITH INTIMATE
* KNOWLEDGE OF THE SYSTEM WILL RETURN IN THIS WAY.
*
* 2) STRING, INTEGER AND REAL RESULTS MAY BE RETURNED BY
* POINTING TO A PSEUDO-BLOCK OUTSIDE DYNAMIC MEMORY.
* THIS BLOCK IS IN ICBLK, RCBLK OR SCBLK FORMAT EXCEPT
* THAT THE FIRST WORD WILL BE OVERWRITTEN
* BY A TYPE WORD ON RETURN AND SO NEED NOT
* BE CORRECTLY SET. SUCH A RESULT IS
* COPIED INTO MAIN STORAGE BEFORE PROCEEDING.
* UNCONVERTED RESULTS MAY SIMILARLY BE RETURNED IN A
* PSEUDO-BLOCK WHICH IS IN CORRECT FORMAT INCLUDING
* TYPE WORD RECOGNISABLE BY GARBAGE COLLECTOR SINCE
* BLOCK IS COPIED INTO DYNAMIC MEMORY.
{{EJC{{{{
*
* SYSFC -- FILE CONTROL BLOCK ROUTINE
*
{SYSFC{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SEE ALSO SYSIO
* INPUT AND OUTPUT HAVE 3 ARGUMENTS REFERRED TO AS SHOWN
* INPUT(VARIABLE NAME,FILE ARG1,FILE ARG2)
* OUTPUT(VARIABLE NAME,FILE ARG1,FILE ARG2)
* FILE ARG1 MAY BE AN INTEGER OR STRING USED TO IDENTIFY
* AN I/O CHANNEL. IT IS CONVERTED TO A STRING FOR CHECKING.
* THE EXACT SIGNIFICANCE OF FILE ARG2
* IS NOT RIGOROUSLY PRESCRIBED BUT TO IMPROVE PORTABILITY,
* THE SCHEME DESCRIBED IN THE SPITBOL USER MANUAL
* SHOULD BE ADOPTED WHEN POSSIBLE. THE PREFERRED FORM IS
* A STRING $F$,R$R$,C$C$,I$I$,...,Z$Z$ WHERE
* $F$ IS AN OPTIONAL FILE NAME WHICH IS PLACED FIRST.
* REMAINING ITEMS MAY BE OMITTED OR INCLUDED IN ANY ORDER.
* $R$ IS MAXIMUM RECORD LENGTH
* $C$ IS A CARRIAGE CONTROL CHARACTER OR CHARACTER STRING
* $I$ IS SOME FORM OF CHANNEL IDENTIFICATION USED IN THE
* ABSENCE OF $F$ TO ASSOCIATE THE VARIABLE
* WITH A FILE ALLOCATED DYNAMICALLY BY JCL COMMANDS AT
* SPITBOL LOAD TIME.
* ,...,Z$Z$ ARE ADDITIONAL FIELDS.
* IF , (COMMA) CANNOT BE USED AS A DELIMITER, .CIOD
* SHOULD BE DEFINED TO INTRODUCE BY CONDITIONAL ASSEMBLY
* ANOTHER DELIMITER (SEE
* IODEL EQU *
* EARLY IN DEFINITIONS SECTION).
* SYSFC IS CALLED WHEN A VARIABLE IS INPUT OR OUTPUT
* ASSOCIATED TO CHECK FILE ARG1 AND FILE ARG2 AND
* TO REPORT WHETHER AN FCBLK (FILE CONTROL
* BLOCK) IS NECESSARY AND IF SO WHAT SIZE IT SHOULD BE.
* THIS MAKES IT POSSIBLE FOR SPITBOL RATHER THAN OSINT TO
* ALLOCATE SUCH A BLOCK IN DYNAMIC MEMORY IF REQUIRED
* OR ALTERNATIVELY IN STATIC MEMORY.
* THE SIGNIFICANCE OF AN FCBLK , IF ONE IS REQUESTED, IS
* ENTIRELY UP TO THE SYSTEM INTERFACE. THE ONLY RESTRICTION
* IS THAT IF THE FCBLK SHOULD APPEAR TO LIE IN DYNAMIC
* MEMORY , POINTERS TO IT SHOULD BE PROPER POINTERS TO
* THE START OF A RECOGNISABLE AND GARBAGE COLLECTABLE
* BLOCK (THIS CONDITION WILL BE MET IF SYSFC REQUESTS
* SPITBOL TO PROVIDE AN FCBLK).
* AN OPTION IS PROVIDED FOR OSINT TO RETURN A POINTER IN
* XL TO AN FCBLK WHICH IT PRIVATELY ALLOCATED. THIS PTR
* WILL BE MADE AVAILABLE WHEN I/O OCCURS LATER.
* PRIVATE FCBLKS MAY HAVE ARBITRARY CONTENTS AND SPITBOL
* STORES NOTHING IN THEM.
{{EJC{{{{
* THE REQUESTED SIZE FOR AN FCBLK IN DYNAMIC MEMORY
* SHOULD ALLOW A 2 WORD OVERHEAD FOR BLOCK TYPE AND
* LENGTH FIELDS. INFORMATION SUBSEQUENTLY STORED IN THE
* REMAINING WORDS MAY BE ARBITRARY IF AN XNBLK (EXTERNAL
* NON-RELOCATABLE BLOCK) IS REQUESTED. IF THE REQUEST IS
* FOR AN XRBLK (EXTERNAL RELOCATABLE BLOCK) THE
* CONTENTS OF WORDS SHOULD BE COLLECTABLE (I.E. ANY
* APPARENT POINTERS INTO DYNAMIC SHOULD BE GENUINE BLOCK
* POINTERS). THESE RESTRICTIONS DO NOT APPLY IF AN FCBLK
* IS ALLOCATED OUTSIDE DYNAMIC OR IS NOT ALLOCATED AT ALL.
* IF AN FCBLK IS REQUESTED, ITS FIELDS WILL BE INITIALISED
* TO ZERO BEFORE ENTRY TO SYSIO WITH THE EXCEPTION OF
* WORDS 0 AND 1 IN WHICH THE BLOCK TYPE AND LENGTH
* FIELDS ARE PLACED FOR FCBLKS IN DYNAMIC MEMORY ONLY.
* FOR THE POSSIBLE USE OF SYSEJ AND SYSXI, IF FCBLKS
* ARE USED, A CHAIN IS BUILT SO THAT THEY MAY ALL BE
* FOUND - SEE SYSXI FOR DETAILS.
* IF BOTH FILE ARG1 AND FILE ARG2 ARE NULL, CALLS OF SYSFC
* AND SYSIO ARE OMITTED.
* IF FILE ARG1 IS NULL (STANDARD INPUT/OUTPUT FILE), SYSFC
* IS CALLED TO CHECK NON-NULL FILE ARG2 BUT ANY REQUEST
* FOR AN FCBLK WILL BE IGNORED, SINCE SPITBOL HANDLES THE
* STANDARD FILES SPECIALLY AND CANNOT READILY KEEP FCBLK
* POINTERS FOR THEM.
* FILEARG1 IS TYPE CHECKED BY SPITBOL SO FURTHER CHECKING
* MAY BE UNNECCESSARY IN MANY IMPLEMENTATIONS.
* FILE ARG2 IS PASSED SO THAT SYSFC MAY ANALYSE AND
* CHECK IT. HOWEVER TO ASSIST IN THIS, SPITBOL ALSO PASSES
* ON THE STACK THE COMPONENTS OF THIS ARGUMENT WITH
* FILE NAME, $F$ (OTHERWISE NULL) EXTRACTED AND STACKED
* FIRST.
* THE OTHER FIELDS, IF ANY, ARE EXTRACTED AS SUBSTRINGS,
* POINTERS TO THEM ARE STACKED AND A COUNT OF ALL ITEMS
* STACKED IS PLACED IN WC. IF AN FCBLK WAS EARLIER
* ALLOCATED AND POINTED TO VIA FILE ARG1, SYSFC IS ALSO
* PASSED A POINTER TO THIS FCBLK.
*
* (XL) FILE ARG1 SCBLK PTR (2ND ARG)
* (XR) FILEARG2 (3RD ARG) OR NULL
* -(XS)...-(XS) SCBLKS FOR $F$,$R$,$C$,...
* (WC) NO. OF STACKED SCBLKS ABOVE
* (WA) EXISTING FILE ARG1 FCBLK PTR OR 0
* (WB) 0/3 FOR INPUT/OUTPUT ASSOCN
* JSR SYSFC CALL TO CHECK NEED FOR FCBLK
* PPM LOC INVALID FILE ARGUMENT
* (XS) POPPED (WC) TIMES
* (WA NON ZERO) BYTE SIZE OF REQUESTED FCBLK
* (WA=0,XL NON ZERO) PRIVATE FCBLK PTR IN XL
* (WA=XL=0) NO FCBLK WANTED, NO PRIVATE FCBLK
* (WC) 0/1/2 REQUEST ALLOC OF XRBLK/XNBLK
* /STATIC BLOCK FOR USE AS FCBLK
* (WB) DESTROYED
{{EJC{{{{
*
* SYSHS -- GIVE ACCESS TO HOST COMPUTER FEATURES
*
{SYSHS{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* PROVIDES MEANS FOR IMPLEMENTING SPECIAL FEATURES
* ON DIFFERENT HOST COMPUTERS. THE ONLY DEFINED ENTRY IS
* THAT WHERE ALL ARGUMENTS ARE NULL IN WHICH CASE SYSHS
* RETURNS AN SCBLK CONTAINING NAME OF COMPUTER,
* NAME OF OPERATING SYSTEM AND NAME OF SITE SEPARATED BY
* COLONS. THE SCBLK NEED NOT HAVE A CORRECT FIRST FIELD
* AS THIS IS SUPPLIED ON COPYING STRING TO DYNAMIC MEMORY.
* SPITBOL DOES NO ARGUMENT CHECKING BUT DOES PROVIDE A
* SINGLE ERROR RETURN FOR ARGUMENTS CHECKED AS ERRONEOUS
* BY OSINT. IT ALSO PROVIDES A SINGLE EXECUTION ERROR
* RETURN. IF THESE ARE INADEQUATE, USE MAY BE MADE OF THE
* MINIMAL ERROR SECTION DIRECT AS DESCRIBED IN MINIMAL
* DOCUMENTATION, SECTION 10.
* SEVERAL NON-ERROR RETURNS ARE PROVIDED. THE FIRST
* CORRESPONDS TO THE DEFINED ENTRY OR, FOR IMPLEMENTATION
* DEFINED ENTRIES, ANY STRING MAY BE RETURNED. THE OTHERS
* PERMIT RESPECTIVELY, RETURN A NULL RESULT, RETURN WITH A
* RESULT TO BE STACKED WHICH IS POINTED AT BY XR, AND A
* RETURN CAUSING SPITBOL STATEMENT FAILURE. IF A RETURNED
* RESULT IS IN DYNAMIC MEMORY IT MUST OBEY GARBAGE
* COLLECTOR RULES. THE ONLY RESULTS COPIED ON RETURN
* ARE STRINGS RETURNED VIA PPM LOC3 RETURN.
*
* (WA) ARGUMENT 1
* (XL) ARGUMENT 2
* (XR) ARGUMENT 3
* JSR SYSHS CALL TO GET HOST INFORMATION
* PPM LOC1 ERRONEOUS ARG
* PPM LOC2 EXECUTION ERROR
* PPM LOC3 SCBLK PTR IN XL OR 0 IF UNAVAILABLE
* PPM LOC4 RETURN A NULL RESULT
* PPM LOC5 RETURN RESULT IN XR
* PPM LOC6 CAUSE STATEMENT FAILURE
{{EJC{{{{
*
* SYSID -- RETURN SYSTEM IDENTIFICATION
*
{SYSID{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* THIS ROUTINE SHOULD RETURN STRINGS TO HEAD THE STANDARD
* PRINTER OUTPUT. THE FIRST STRING WILL BE APPENDED TO
* A HEADING LINE OF THE FORM
* MACRO SPITBOL VERSION V.V
* SUPPLIED BY SPITBOL ITSELF. V.V ARE DIGITS GIVING THE
* MAJOR VERSION NUMBER AND GENERALLY AT LEAST A MINOR
* VERSION NUMBER RELATING TO OSINT SHOULD BE SUPPLIED TO
* GIVE SAY
* MACRO SPITBOL VERSION V.V(M.M)
* THE SECOND STRING SHOULD IDENTIFY AT LEAST THE MACHINE
* AND OPERATING SYSTEM. PREFERABLY IT SHOULD INCLUDE
* THE DATE AND TIME OF THE RUN.
* OPTIONALLY THE STRINGS MAY INCLUDE SITE NAME OF THE
* THE IMPLEMENTOR AND/OR MACHINE ON WHICH RUN TAKES PLACE,
* UNIQUE SITE OR COPY NUMBER AND OTHER INFORMATION AS
* APPROPRIATE WITHOUT MAKING IT SO LONG AS TO BE A
* NUISANCE TO USERS.
* THE FIRST WORDS OF THE SCBLKS POINTED AT NEED NOT BE
* CORRECTLY SET.
*
* JSR SYSID CALL FOR SYSTEM IDENTIFICATION
* (XR) SCBLK PTR FOR ADDITION TO HEADER
* (XL) PTR TO SECOND HEADER SCBLK
{{EJC{{{{
*
* SYSIL -- GET INPUT RECORD LENGTH
*
{SYSIL{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSIL IS USED TO GET THE LENGTH OF THE NEXT INPUT RECORD
* FROM A FILE PREVIOUSLY INPUT ASSOCIATED WITH A SYSIO
* CALL. THE LENGTH RETURNED IS USED TO ESTABLISH A BUFFER
* FOR A SUBSEQUENT SYSIN CALL.
*
* (WA) PTR TO FCBLK OR ZERO
* JSR SYSIL CALL TO GET RECORD LENGTH
* (WA) LENGTH OR ZERO IF FILE CLOSED
*
* NO HARM IS DONE IF THE VALUE RETURNED IS TOO LONG SINCE
* UNUSED SPACE WILL BE RECLAIMED AFTER THE SYSIN CALL.
*
* NOTE THAT IT IS THE SYSIL CALL (NOT THE SYSIO CALL) WHICH
* CAUSES THE FILE TO BE OPENED AS REQUIRED FOR THE FIRST
* RECORD INPUT FROM THE FILE.
{{EJC{{{{
*
* SYSIN -- READ INPUT RECORD
*
{SYSIN{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSIN IS USED TO READ A RECORD FROM THE FILE WHICH WAS
* REFERENCED IN A PRIOR CALL TO SYSIL (I.E. THESE CALLS
* ALWAYS OCCUR IN PAIRS). THE BUFFER PROVIDED IS AN
* SCBLK FOR A STRING OF LENGTH SET FROM THE SYSIL CALL.
* IF THE ACTUAL LENGTH READ IS LESS THAN THIS, THE LENGTH
* FIELD OF THE SCBLK MUST BE MODIFIED BEFORE RETURNING
* UNLESS BUFFER IS RIGHT PADDED WITH ZEROES.
* IT IS ALSO PERMISSIBLE TO TAKE ANY OF THE ALTERNATIVE
* RETURNS AFTER SCBLK LENGTH HAS BEEN MODIFIED.
*
* (WA) PTR TO FCBLK OR ZERO
* (XR) POINTER TO BUFFER (SCBLK PTR)
* JSR SYSIN CALL TO READ RECORD
* PPM LOC ENDFILE OR NO I/P FILE AFTER SYSXI
* PPM LOC RETURN HERE IF I/O ERROR
* PPM LOC RETURN HERE IF RECORD FORMAT ERROR
* (WA,WB,WC) DESTROYED
{{EJC{{{{
*
* SYSIO -- INPUT/OUTPUT FILE ASSOCIATION
*
{SYSIO{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SEE ALSO SYSFC.
* SYSIO IS CALLED IN RESPONSE TO A SNOBOL4 INPUT OR OUTPUT
* FUNCTION CALL EXCEPT WHEN FILE ARG1 AND FILE ARG2
* ARE BOTH NULL.
* ITS CALL ALWAYS FOLLOWS IMMEDIATELY AFTER A CALL
* OF SYSFC. IF SYSFC REQUESTED ALLOCATION
* OF AN FCBLK, ITS ADDRESS WILL BE IN WA.
* FOR INPUT FILES, NON-ZERO VALUES OF $R$ SHOULD BE
* COPIED TO WC FOR USE IN ALLOCATING INPUT BUFFERS. IF $R$
* IS DEFAULTED OR NOT IMPLEMENTED, WC SHOULD BE ZEROISED.
* ONCE A FILE HAS BEEN OPENED, SUBSEQUENT INPUT(),OUTPUT()
* CALLS IN WHICH THE SECOND ARGUMENT IS IDENTICAL WITH THAT
* IN A PREVIOUS CALL, MERELY ASSOCIATE THE ADDITIONAL
* VARIABLE NAME (FIRST ARGUMENT) TO THE FILE AND DO NOT
* RESULT IN RE-OPENING THE FILE.
* IN SUBSEQUENT ASSOCIATED ACCESSES TO THE FILE A POINTER
* TO ANY FCBLK ALLOCATED WILL BE MADE AVAILABLE.
*
* (XL) FILE ARG1 SCBLK PTR (2ND ARG)
* (XR) FILE ARG2 SCBLK PTR (3RD ARG)
* (WA) FCBLK PTR (0 IF NONE)
* (WB) 0 FOR INPUT, 3 FOR OUTPUT
* JSR SYSIO CALL TO ASSOCIATE FILE
* PPM LOC RETURN HERE IF FILE DOES NOT EXIST
* PPM LOC RETURN IF INPUT/OUTPUT NOT ALLOWED
* (XL) FCBLK POINTER (0 IF NONE)
* (WC) 0 (FOR DEFAULT) OR MAX RECORD LNGTH
* (WA,WB) DESTROYED
*
* THE SECOND ERROR RETURN IS USED IF THE FILE NAMED EXISTS
* BUT INPUT/OUTPUT FROM THE FILE IS NOT ALLOWED. FOR
* EXAMPLE, THE STANDARD OUTPUT FILE MAY BE IN THIS CATEGORY
* AS REGARDS INPUT ASSOCIATION.
{{EJC{{{{
*
* SYSLD -- LOAD EXTERNAL FUNCTION
*
{SYSLD{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSLD IS CALLED IN RESPONSE TO THE USE OF THE SNOBOL4
* LOAD FUNCTION. THE NAMED FUNCTION IS LOADED (WHATEVER
* THIS MEANS), AND A POINTER IS RETURNED. THE POINTER WILL
* BE USED ON SUBSEQUENT CALLS TO THE FUNCTION (SEE SYSEX).
*
* (XR) POINTER TO FUNCTION NAME (SCBLK)
* (XL) POINTER TO LIBRARY NAME (SCBLK)
* JSR SYSLD CALL TO LOAD FUNCTION
* PPM LOC RETURN HERE IF FUNC DOES NOT EXIST
* PPM LOC RETURN HERE IF I/O ERROR
* (XR) POINTER TO LOADED CODE
*
* THE SIGNIFICANCE OF THE POINTER RETURNED IS UP TO THE
* SYSTEM INTERFACE ROUTINE. THE ONLY RESTRICTION IS THAT
* IF THE POINTER IS WITHIN DYNAMIC STORAGE, IT MUST BE
* A PROPER BLOCK POINTER.
{{EJC{{{{
*
* SYSMM -- GET MORE MEMORY
*
{SYSMM{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSMM IS CALLED IN AN ATTEMPT TO ALLOCATE MORE DYNAMIC
* MEMORY. THIS MEMORY MUST BE ALLOCATED CONTIGUOUSLY WITH
* THE CURRENT DYNAMIC DATA AREA.
*
* THE AMOUNT ALLOCATED IS UP TO THE SYSTEM TO DECIDE. ANY
* VALUE IS ACCEPTABLE INCLUDING ZERO IF ALLOCATION IS
* IMPOSSIBLE.
*
* JSR SYSMM CALL TO GET MORE MEMORY
* (XR) NUMBER OF ADDITIONAL WORDS OBTAINED
{{EJC{{{{
*
* SYSMX -- SUPPLY MXLEN
*
{SYSMX{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* BECAUSE OF THE METHOD OF GARBAGE COLLECTION, NO SPITBOL
* OBJECT IS ALLOWED TO OCCUPY MORE BYTES OF MEMORY THAN
* THE INTEGER GIVING THE LOWEST ADDRESS OF DYNAMIC
* (GARBAGE COLLECTABLE) MEMORY. MXLEN IS THE NAME USED TO
* REFER TO THIS MAXIMUM LENGTH OF AN OBJECT AND FOR MOST
* USERS OF MOST IMPLEMENTATIONS, PROVIDED DYNAMIC MEMORY
* STARTS AT AN ADDRESS OF AT LEAST A FEW THOUSAND WORDS,
* THERE IS NO PROBLEM.
* IF THE DEFAULT STARTING ADDRESS IS LESS THAN SAY 10000 OR
* 20000, THEN A LOAD TIME OPTION SHOULD BE PROVIDED WHERE A
* USER CAN REQUEST THAT HE BE ABLE TO CREATE LARGER
* OBJECTS. THIS ROUTINE INFORMS SPITBOL OF THIS REQUEST IF
* ANY. THE VALUE RETURNED IS EITHER AN INTEGER
* REPRESENTING THE DESIRED VALUE OF MXLEN (AND HENCE THE
* MINIMUM DYNAMIC STORE ADDRESS WHICH MAY RESULT IN
* NON-USE OF SOME STORE) OR ZERO IF A DEFAULT IS ACCEPTABLE
* IN WHICH MXLEN IS SET TO THE LOWEST ADDRESS ALLOCATED
* TO DYNAMIC STORE BEFORE COMPILATION STARTS.
* IF A NON-ZERO VALUE IS RETURNED, THIS IS USED FOR KEYWORD
* MAXLNGTH. OTHERWISE THE INITIAL LOW ADDRESS OF DYNAMIC
* MEMORY IS USED FOR THIS KEYWORD.
*
* JSR SYSMX CALL TO GET MXLEN
* (WA) EITHER MXLEN OR 0 FOR DEFAULT
{{EJC{{{{
*
* SYSOU -- OUTPUT RECORD
*
{SYSOU{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSOU IS USED TO WRITE A RECORD TO A FILE PREVIOUSLY
* ASSOCIATED WITH A SYSIO CALL.
*
* (WA) PTR TO FCBLK OR ZERO
* (XR) RECORD TO BE WRITTEN (SCBLK)
* JSR SYSOU CALL TO OUTPUT RECORD
* PPM LOC FILE FULL OR NO FILE AFTER SYSXI
* PPM LOC RETURN HERE IF I/O ERROR
* (WA,WB,WC) DESTROYED
*
* NOTE THAT IT IS THE SYSOU CALL (NOT THE SYSIO CALL) WHICH
* CAUSES THE FILE TO BE OPENED AS REQUIRED FOR THE FIRST
* RECORD OUTPUT TO THE FILE.
{{EJC{{{{
*
* SYSPI -- PRINT ON INTERACTIVE CHANNEL
*
{SYSPI{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* IF SPITBOL IS RUN FROM AN ONLINE TERMINAL, OSINT CAN
* REQUEST THAT MESSAGES SUCH AS COPIES OF COMPILATION
* ERRORS BE SENT TO THE TERMINAL (SEE SYSPP). IF RELEVANT
* REPLY WAS MADE BY SYSPP THEN SYSPI IS CALLED TO SEND SUCH
* MESSAGES TO THE INTERACTIVE CHANNEL.
* SYSPI IS ALSO USED FOR SENDING OUTPUT TO THE TERMINAL
* THROUGH THE SPECIAL VARIABLE NAME, TERMINAL.
*
* (XR) PTR TO LINE BUFFER (SCBLK)
* (WA) LINE LENGTH
* JSR SYSPI CALL TO PRINT LINE
* PPM LOC FAILURE RETURN
* (WA,WB) DESTROYED
{{EJC{{{{
*
* SYSPP -- OBTAIN PRINT PARAMETERS
*
{SYSPP{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSPP IS CALLED ONCE DURING COMPILATION TO OBTAIN
* PARAMETERS REQUIRED FOR CORRECT PRINTED OUTPUT FORMAT
* AND TO SELECT OTHER OPTIONS. IT MAY ALSO BE CALLED AGAIN
* AFTER SYSXI WHEN A LOAD MODULE IS RESUMED. IN THIS
* CASE THE VALUE RETURNED IN WA MAY BE LESS THAN OR EQUAL
* TO THAT RETURNED IN INITIAL CALL BUT MAY NOT BE
* GREATER.
* THE INFORMATION RETURNED IS -
* 1. LINE LENGTH IN CHARS FOR STANDARD PRINT FILE
* 2. NO OF LINES/PAGE. 0 IS PREFERABLE FOR A NON-PAGED
* DEVICE (E.G. ONLINE TERMINAL) IN WHICH CASE LISTING
* PAGE THROWS ARE SUPPRESSED AND PAGE HEADERS
* RESULTING FROM -TITLE,-STITL LINES ARE KEPT SHORT.
* 3. AN INITIAL -NOLIST OPTION TO SUPPRESS LISTING UNLESS
* THE PROGRAM CONTAINS AN EXPLICIT -LIST.
* 4. OPTIONS TO SUPPRESS LISTING OF COMPILATION AND/OR
* EXECUTION STATS (USEFUL FOR ESTABLISHED PROGRAMS) -
* COMBINED WITH 3. GIVES POSSIBILITY OF LISTING
* FILE NEVER BEING OPENED.
* 5. OPTION TO HAVE COPIES OF ERRORS SENT TO AN
* INTERACTIVE CHANNEL IN ADDITION TO STANDARD PRINTER.
* 6. OPTION TO KEEP PAGE HEADERS SHORT (E.G. IF LISTING
* TO AN ONLINE TERMINAL).
* 7. AN OPTION TO CHOOSE EXTENDED OR COMPACT LISTING
* FORMAT. IN THE FORMER A PAGE EJECT AND IN THE LATTER
* A FEW LINE FEEDS PRECEDE THE PRINTING OF EACH
* OF-- LISTING, COMPILATION STATISTICS, EXECUTION
* OUTPUT AND EXECUTION STATISTICS.
* 8. AN OPTION TO SUPPRESS EXECUTION AS THOUGH A
* -NOEXECUTE CARD WERE SUPPLIED.
* 9. AN OPTION TO REQUEST THAT NAME /TERMINAL/ BE PRE-
* ASSOCIATED TO AN ONLINE TERMINAL VIA SYSPI AND SYSRI
* 10. AN INTERMEDIATE (STANDARD) LISTING OPTION REQUIRING
* THAT PAGE EJECTS OCCUR IN SOURCE LISTINGS. REDUNDANT
* IF EXTENDED OPTION CHOSEN BUT PARTIALLY EXTENDS
* COMPACT OPTION.
* 11. OPTION TO SUPPRESS SYSID IDENTIFICATION.
*
* JSR SYSPP CALL TO GET PRINT PARAMETERS
* (WA) PRINT LINE LENGTH IN CHARS
* (WB) NUMBER OF LINES/PAGE
* (WC) BITS VALUE ...JIHGFEDCBA WHERE
* A = 1 TO SEND ERROR COPY TO INT.CH.
* B = 1 MEANS STD PRINTER IS INT. CH.
* C = 1 FOR -NOLIST OPTION
* D = 1 TO SUPPRESS COMPILN. STATS
* E = 1 TO SUPPRESS EXECN. STATS
* F = 1/0 FOR EXTNDED/COMPACT LISTING
* G = 1 FOR -NOEXECUTE
* H = 1 PRE-ASSOCIATE /TERMINAL/
* I = 1 FOR STANDARD LISTING OPTION.
* J = 1 SUPPRESSES LISTING HEADER
{{EJC{{{{
*
* SYSPR -- PRINT LINE ON STANDARD OUTPUT FILE
*
{SYSPR{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSPR IS USED TO PRINT A SINGLE LINE ON THE STANDARD
* OUTPUT FILE.
*
* (XR) POINTER TO LINE BUFFER (SCBLK)
* (WA) LINE LENGTH
* JSR SYSPR CALL TO PRINT LINE
* PPM LOC TOO MUCH O/P OR NO FILE AFTER SYSXI
* (WA,WB) DESTROYED
*
* THE BUFFER POINTED TO IS THE LENGTH OBTAINED FROM THE
* SYSPP CALL AND IS FILLED OUT WITH TRAILING BLANKS. THE
* VALUE IN WA IS THE ACTUAL LINE LENGTH WHICH MAY BE LESS
* THAN THE MAXIMUM LINE LENGTH POSSIBLE. THERE IS NO SPACE
* CONTROL ASSOCIATED WITH THE LINE, ALL LINES ARE PRINTED
* SINGLE SPACED. NOTE THAT NULL LINES (WA=0) ARE POSSIBLE
* IN WHICH CASE A BLANK LINE IS TO BE PRINTED.
*
* THE ERROR EXIT IS USED FOR SYSTEMS WHICH LIMIT THE AMOUNT
* OF PRINTED OUTPUT. IF POSSIBLE, PRINTING SHOULD BE
* PERMITTED AFTER THIS CONDITION HAS BEEN SIGNALLED ONCE TO
* ALLOW FOR DUMP AND OTHER DIAGNOSTIC INFORMATION.
* ASSUMING THIS TO BE POSSIBLE, SPITBOL MAY MAKE MORE SYSPR
* CALLS. IF THE ERROR RETURN OCCURS ANOTHER TIME, EXECUTION
* IS TERMINATED BY A CALL OF SYSEJ WITH ENDING CODE 998.
{{EJC{{{{
*
* SYSRD -- READ RECORD FROM STANDARD INPUT FILE
*
{SYSRD{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSRD IS USED TO READ A RECORD FROM THE STANDARD INPUT
* FILE. THE BUFFER PROVIDED IS AN SCBLK FOR A STRING THE
* LENGTH OF WHICH IN CHARACTERS IS GIVEN IN WC, THIS
* CORRESPONDING TO THE MAXIMUM LENGTH OF STRING WHICH
* SPITBOL IS PREPARED TO RECEIVE. AT COMPILE TIME IT
* CORRESPONDS TO XXX IN THE MOST RECENT -INXXX CARD
* (DEFAULT 72) AND AT EXECUTION TIME TO THE MOST RECENT
* ,R$R$ (RECORD LENGTH) IN THE THIRD ARG OF AN INPUT()
* STATEMENT FOR THE STANDARD INPUT FILE (DEFAULT 80).
* IF FEWER THAN (WC) CHARACTERS ARE READ, THE LENGTH
* FIELD OF THE SCBLK MUST BE ADJUSTED BEFORE RETURNING
* UNLESS THE BUFFER IS RIGHT PADDED WITH ZEROES.
* IT IS ALSO PERMISSIBLE TO TAKE THE ALTERNATIVE RETURN
* AFTER SUCH AN ADJUSTMENT HAS BEEN MADE.
* SPITBOL MAY CONTINUE TO MAKE CALLS AFTER AN ENDFILE
* RETURN SO THIS ROUTINE SHOULD BE PREPARED TO MAKE
* REPEATED ENDFILE RETURNS.
*
* (XR) POINTER TO BUFFER (SCBLK PTR)
* (WC) LENGTH OF BUFFER IN CHARACTERS
* JSR SYSRD CALL TO READ LINE
* PPM LOC ENDFILE OR NO I/P FILE AFTER SYSXI
* (WA,WB,WC) DESTROYED
{{EJC{{{{
*
* SYSRI -- READ RECORD FROM INTERACTIVE CHANNEL
*
{SYSRI{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* READS A RECORD FROM ONLINE TERMINAL FOR SPITBOL VARIABLE,
* TERMINAL. IF ONLINE TERMINAL IS UNAVAILABLE THEN CODE THE
* ENDFILE RETURN ONLY.
* THE BUFFER PROVIDED IS OF LENGTH 120 CHARACTERS. SYSRI
* SHOULD REPLACE THE COUNT IN THE SECOND WORD OF THE SCBLK
* BY THE ACTUAL CHARACTER COUNT UNLESS BUFFER IS RIGHT
* PADDED WITH ZEROES.
* IT IS ALSO PERMISSIBLE TO TAKE THE ALTERNATIVE
* RETURN AFTER ADJUSTING THE COUNT.
* THE END OF FILE RETURN MAY BE USED IF THIS MAKES
* SENSE ON THE TARGET MACHINE (E.G. IF THERE IS AN
* EOF CHARACTER.)
*
* (XR) PTR TO 120 CHAR BUFFER (SCBLK PTR)
* JSR SYSRI CALL TO READ LINE FROM TERMINAL
* PPM LOC END OF FILE RETURN
* (WA,WB,WC) MAY BE DESTROYED
{{EJC{{{{
*
* SYSRW -- REWIND FILE
*
{SYSRW{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSRW IS USED TO REWIND A FILE I.E. REPOSITION THE FILE
* AT THE START BEFORE THE FIRST RECORD. THE FILE SHOULD BE
* CLOSED AND THE NEXT READ OR WRITE CALL WILL OPEN THE
* FILE AT THE START.
*
* (WA) PTR TO FCBLK OR ZERO
* (XR) REWIND ARG (SCBLK PTR)
* JSR SYSRW CALL TO REWIND FILE
* PPM LOC RETURN HERE IF FILE DOES NOT EXIST
* PPM LOC RETURN HERE IF REWIND NOT ALLOWED
* PPM LOC RETURN HERE IF I/O ERROR
{{EJC{{{{
*
* SYSST -- SET FILE POINTER
*
{SYSST{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSST IS CALLED TO CHANGE THE POSITION OF A FILE
* POINTER. THIS IS ACCOMPLISHED IN A SYSTEM DEPENDENT
* MANNER, AND THUS THE 2ND AND 3RD ARGUMENTS ARE PASSED
* UNCONVERTED.
*
* (WA) FCBLK POINTER
* (WB) 2ND ARGUMENT
* (WC) 3RD ARGUMENT
* JSR SYSST CALL TO SET FILE POINTER
* PPM LOC RETURN HERE IF INVALID 2ND ARG
* PPM LOC RETURN HERE IF INVALID 3RD ARG
* PPM LOC RETURN HERE IF FILE DOES NOT EXIST
* PPM LOC RETURN HERE IF SET NOT ALLOWED
* PPM LOC RETURN HERE IF I/O ERROR
*
{{EJC{{{{
*
* SYSTM -- GET EXECUTION TIME SO FAR
*
{SYSTM{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSTM IS USED TO OBTAIN THE AMOUNT OF EXECUTION TIME
* USED SO FAR SINCE SPITBOL WAS GIVEN CONTROL. THE UNITS
* ARE DESCRIBED AS MILLISECONDS IN THE SPITBOL OUTPUT, BUT
* THE EXACT MEANING IS SYSTEM DEPENDENT. WHERE APPROPRIATE,
* THIS VALUE SHOULD RELATE TO PROCESSOR RATHER THAN CLOCK
* TIMING VALUES.
*
* JSR SYSTM CALL TO GET TIMER VALUE
* (IA) TIME SO FAR IN MILLISECONDS
{{EJC{{{{
*
* SYSTT -- TRACE TOGGLE
*
{SYSTT{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* CALLED BY SPITBOL FUNCTION TRACE() WITH NO ARGS TO
* TOGGLE THE SYSTEM TRACE SWITCH. THIS PERMITS TRACING OF
* LABELS IN SPITBOL CODE TO BE TURNED ON OR OFF.
*
* JSR SYSTT CALL TO TOGGLE TRACE SWITCH
{{EJC{{{{
*
* SYSUL -- UNLOAD EXTERNAL FUNCTION
*
{SYSUL{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* SYSUL IS USED TO UNLOAD A FUNCTION PREVIOUSLY
* LOADED WITH A CALL TO SYSLD.
*
* (XR) PTR TO CONTROL BLOCK (EFBLK)
* JSR SYSUL CALL TO UNLOAD FUNCTION
*
* THE FUNCTION CANNOT BE CALLED FOLLOWING A SYSUL CALL
* UNTIL ANOTHER SYSLD CALL IS MADE FOR THE SAME FUNCTION.
*
* THE EFBLK CONTAINS THE FUNCTION CODE POINTER AND ALSO A
* POINTER TO THE VRBLK CONTAINING THE FUNCTION NAME (SEE
* DEFINITIONS AND DATA STRUCTURES SECTION).
{{EJC{{{{
*
* SYSXI -- EXIT TO PRODUCE LOAD MODULE
*
{SYSXI{EXP{{{{DEFINE EXTERNAL ENTRY POINT
*
* WHEN SYSXI IS CALLED, XL CONTAINS EITHER A STRING POINTER
* OR ZERO. IN THE FORMER CASE, THE STRING GIVES THE
* CHARACTER NAME OF A PROGRAM. THE INTENTION IS THAT
* SPITBOL EXECUTION SHOULD BE TERMINATED FORTHWITH AND
* THE NAMED PROGRAM LOADED AND EXECUTED. THIS TYPE OF CHAIN
* EXECUTION IS VERY SYSTEM DEPENDENT AND IMPLEMENTORS MAY
* CHOOSE TO OMIT IT OR FIND IT IMPOSSIBLE TO PROVIDE.
* IF (XL) IS ZERO,IA CONTAINS ONE OF THE FOLLOWING INTEGERS
*
* -1, -2, -3
* CREATE IF POSSIBLE A LOAD MODULE CONTAINING ONLY THE
* IMPURE AREA OF MEMORY WHICH NEEDS TO BE LOADED WITH
* A COMPATIBLE PURE SEGMENT FOR SUBSEQUENT EXECUTIONS.
* VERSION NUMBERS TO CHECK COMPATIBILITY SHOULD BE
* KEPT IN BOTH SEGMENTS AND CHECKED ON LOADING.
* TO ASSIST WITH THIS CHECK, (XR) ON ENTRY IS A
* POINTER TO AN SCBLK CONTAINING THE SPITBOL MAJOR
* VERSION NUMBER V.V (SEE SYSID).
*
* 0 IF POSSIBLE, RETURN CONTROL TO JOB CONTROL
* COMMAND LEVEL. THE EFFECT IF AVAILABLE WILL BE
* SYSTEM DEPENDENT.
*
* +1, +2, +3
* CREATE IF POSSIBLE A LOAD MODULE FROM ALL OF
* MEMORY. IT SHOULD BE POSSIBLE TO LOAD AND EXECUTE
* THIS MODULE DIRECTLY.
*
* IN THE CASE OF SAVED LOAD MODULES, THE STATUS OF OPEN
* FILES IS NOT PRESERVED AND IMPLEMENTORS MAY CHOOSE TO
* OFFER MEANS OF ATTACHING FILES BEFORE EXECUTION OF LOAD
* MODULES STARTS OR LEAVE IT TO THE USER TO INCLUDE
* SUITABLE INPUT(), OUTPUT() CALLS IN HIS PROGRAM.
* SYSXI SHOULD MAKE A NOTE THAT NO I/O CHANNELS,
* INCLUDING STANDARD FILES, HAVE FILES ATTACHED SO THAT
* CALLS OF SYSIN, SYSOU, SYSPR, SYSRD SHOULD FAIL UNLESS
* NEW ASSOCIATIONS ARE MADE FOR THE LOAD MODULE.
* AT LEAST IN THE CASE OF THE STANDARD OUTPUT FILE, IT IS
* RECOMMENDED THAT EITHER THE USER BE REQUIRED TO ATTACH
* A FILE OR THAT A DEFAULT FILE IS ATTACHED, SINCE THE
* PROBLEM OF ERROR MESSAGES GENERATED BY THE LOAD MODULE
* IS OTHERWISE SEVERE. AS A LAST RESORT, IF SPITBOL
* ATTEMPTS TO WRITE TO THE STANDARD OUTPUT FILE AND GETS A
* REPLY INDICATING THAT SUCH OUPUT IS UNACCEPTABLE IT STOPS
* BY USING AN ENTRY TO SYSEJ WITH ENDING CODE 998.
* AS DESCRIBED BELOW, PASSING OF SOME ARGUMENTS MAKES IT
* CLEAR THAT LOAD MODULE WILL USE A STANDARD OUTPUT FILE.
*
* IF USE IS MADE OF FCBLKS FOR I/O ASSOCIATION, SPITBOL
* BUILDS A CHAIN SO THAT THOSE IN USE MAY BE FOUND IN SYSXI
* AND SYSEJ. THE NODES ARE 4 WORDS LONG. THIRD WORD
* CONTAINS LINK TO NEXT NODE OR 0, FOURTH WORD CONTAINS
* FCBLK POINTER.
{{EJC{{{{
*
* SYSXI (CONTINUED)
*
* (XL) ZERO OR SCBLK PTR
* (XR) PTR TO V.V SCBLK
* (IA) SIGNED INTEGER ARGUMENT
* (WB) 0 OR PTR TO HEAD OF FCBLK CHAIN
* JSR SYSXI CALL TO EXIT
* PPM LOC REQUESTED ACTION NOT POSSIBLE
* PPM LOC ACTION CAUSED IRRECOVERABLE ERROR
* (REGISTERS) SHOULD BE PRESERVED OVER CALL
*
* LOADING AND RUNNING THE LOAD MODULE OR RETURNING FROM
* JCL COMMAND LEVEL CAUSES EXECUTION TO RESUME AT THE POINT
* AFTER THE ERROR RETURNS WHICH FOLLOW THE CALL OF SYSXI.
* THE VALUE PASSED AS EXIT ARGUMENT IS USED TO INDICATE
* OPTIONS REQUIRED ON RESUMPTION OF LOAD MODULE.
* +1 OR -1 REQUIRE THAT ON RESUMPTION, SYSID AND SYSPP BE
* CALLED AND A HEADING PRINTED ON THE STANDARD OUTPUT FILE.
* +2 OR -2 INDICATE THAT SYSPP WILL BE CALLED BUT NOT SYSID
* AND NO HEADING WILL BE PUT ON STANDARD OUTPUT FILE.
* ABOVE OPTIONS HAVE THE OBVIOUS IMPLICATION THAT A
* STANDARD O/P FILE MUST BE PROVIDED FOR THE LOAD MODULE.
* +3 OR -3 INDICATE CALLS OF NEITHER SYSID NOR SYSPP
* AND NO HEADING WILL BE PLACED ON STANDARD OUTPUT FILE.
* NO RETURN FROM SYSXI IS POSSIBLE IF ANOTHER PROGRAM
* IS LOADED AND ENTERED.
{{EJC{{{{
*
* INTRODUCE THE INTERNAL PROCEDURES.
*
{ACESS{INP{R{1{{
{ACOMP{INP{N{5{{
{ALLOC{INP{E{0{{
{ALOBF{INP{E{0{{
{ALOCS{INP{E{0{{
{ALOST{INP{E{0{{
{APNDB{INP{E{2{{
{ARITH{INP{N{3{{
{ASIGN{INP{R{1{{
{ASINP{INP{R{1{{
{BLKLN{INP{E{0{{
{CDGCG{INP{E{0{{
{CDGEX{INP{R{0{{
{CDGNM{INP{R{0{{
{CDGVL{INP{R{0{{
{CDWRD{INP{E{0{{
{CMGEN{INP{R{0{{
{CMPIL{INP{E{0{{
{CNCRD{INP{E{0{{
{COPYB{INP{N{1{{
{DFFNC{INP{E{0{{
{DTACH{INP{E{0{{
{DTYPE{INP{E{0{{
{DUMPR{INP{E{0{{
{ERMSG{INP{E{0{{
{ERTEX{INP{E{0{{
{EVALI{INP{R{4{{
{EVALP{INP{R{1{{
{EVALS{INP{R{3{{
{EVALX{INP{R{1{{
{EXBLD{INP{E{0{{
{EXPAN{INP{E{0{{
{EXPAP{INP{E{1{{
{EXPDM{INP{N{0{{
{EXPOP{INP{N{0{{
{FLSTG{INP{R{0{{
{GBCOL{INP{E{0{{
{GBCPF{INP{E{0{{
{GTARR{INP{E{1{{
{{EJC{{{{
{GTCOD{INP{E{1{{
{GTEXP{INP{E{1{{
{GTINT{INP{E{1{{
{GTNUM{INP{E{1{{
{GTNVR{INP{E{1{{
{GTPAT{INP{E{1{{
{GTREA{INP{E{1{{
{GTSMI{INP{N{2{{
{GTSTG{INP{N{1{{
{GTVAR{INP{E{1{{
{HASHS{INP{E{0{{
{ICBLD{INP{E{0{{
{IDENT{INP{E{1{{
{INOUT{INP{E{0{{
{INSBF{INP{E{2{{
{IOFCB{INP{N{2{{
{IOPPF{INP{N{0{{
{IOPUT{INP{N{6{{
{KTREX{INP{R{0{{
{KWNAM{INP{N{0{{
{LCOMP{INP{N{5{{
{LISTR{INP{E{0{{
{LISTT{INP{E{0{{
{NEXTS{INP{E{0{{
{PATIN{INP{N{2{{
{PATST{INP{N{1{{
{PBILD{INP{E{0{{
{PCONC{INP{E{0{{
{PCOPY{INP{N{0{{
{PRFLR{INP{E{0{{
{PRFLU{INP{E{0{{
{PRPAR{INP{E{0{{
{PRTCH{INP{E{0{{
{PRTIC{INP{E{0{{
{PRTIS{INP{E{0{{
{PRTIN{INP{E{0{{
{PRTMI{INP{E{0{{
{PRTMX{INP{E{0{{
{PRTNL{INP{R{0{{
{PRTNM{INP{R{0{{
{PRTNV{INP{E{0{{
{PRTPG{INP{E{0{{
{PRTPS{INP{E{0{{
{PRTSN{INP{E{0{{
{PRTST{INP{R{0{{
{{EJC{{{{
{PRTTR{INP{E{0{{
{PRTVL{INP{R{0{{
{PRTVN{INP{E{0{{
{RCBLD{INP{E{0{{
{READR{INP{E{0{{
{SBSTR{INP{E{0{{
{SCANE{INP{E{0{{
{SCNGF{INP{E{0{{
{SETVR{INP{E{0{{
{SORTA{INP{N{0{{
{SORTC{INP{E{1{{
{SORTF{INP{E{0{{
{SORTH{INP{E{0{{
{TFIND{INP{E{1{{
{TRACE{INP{N{2{{
{TRBLD{INP{E{0{{
{TRIMR{INP{E{0{{
{TRXEQ{INP{R{0{{
{XSCAN{INP{E{0{{
{XSCNI{INP{N{2{{
*
* INTRODUCE THE INTERNAL ROUTINES
*
{ARREF{INR{{{{
{CFUNC{INR{{{{
{EXFAL{INR{{{{
{EXINT{INR{{{{
{EXITS{INR{{{{
{EXIXR{INR{{{{
{EXNAM{INR{{{{
{EXNUL{INR{{{{
{EXREA{INR{{{{
{EXSID{INR{{{{
{EXVNM{INR{{{{
{FAILP{INR{{{{
{FLPOP{INR{{{{
{INDIR{INR{{{{
{MATCH{INR{{{{
{RETRN{INR{{{{
{STCOV{INR{{{{
{STMGO{INR{{{{
{STOPR{INR{{{{
{SUCCP{INR{{{{
{SYSAB{INR{{{{
{SYSTU{INR{{{{
{{TTL{S{{{P I T B O L -- DEFINITIONS AND DATA STRUCTURES
{{SEC{{{{START OF DEFINITIONS SECTION
*
* DEFINITIONS OF MACHINE PARAMETERS
*
* THE MINIMAL TRANSLATOR SHOULD SUPPLY APPROPRIATE VALUES
* FOR THE PARTICULAR TARGET MACHINE FOR ALL THE
* EQU *
* DEFINITIONS GIVEN AT THE START OF THIS SECTION.
*
{CFP$A{EQU{*{{{NUMBER OF CHARACTERS IN ALPHABET
*
{CFP$B{EQU{*{{{BYTES/WORD ADDRESSING FACTOR
*
{CFP$C{EQU{*{{{NUMBER OF CHARACTERS PER WORD
*
{CFP$F{EQU{*{{{OFFSET IN BYTES TO CHARS IN
* SCBLK. SEE SCBLK FORMAT.
*
{CFP$I{EQU{*{{{NUMBER OF WORDS IN INTEGER CONSTANT
*
{CFP$M{EQU{*{{{MAX POSITIVE INTEGER IN ONE WORD
*
{CFP$N{EQU{*{{{NUMBER OF BITS IN ONE WORD
*
* THE FOLLOWING DEFINITIONS REQUIRE THE SUPPLY OF EITHER
* A SINGLE PARAMETER IF REAL ARITHMETIC IS OMITTED OR
* THREE PARAMETERS IF REAL ARITHMETIC IS INCLUDED.
*
*
{CFP$R{EQU{*{{{NUMBER OF WORDS IN REAL CONSTANT
*
{CFP$S{EQU{*{{{NUMBER OF SIG DIGS FOR REAL OUTPUT
*
{CFP$X{EQU{*{{{MAX DIGITS IN REAL EXPONENT
*
{MXDGS{EQU{CFP$S+CFP$X{{{MAX DIGITS IN REAL NUMBER
*
{NSTMX{EQU{MXDGS+5{{{MAX SPACE FOR REAL (FOR +0.E+)
*
* THE FOLLOWING DEFINITION FOR CFP$U SUPPLIES A REALISTIC
* UPPER BOUND ON THE SIZE OF THE ALPHABET. CFP$U IS USED
* TO SAVE SPACE IN THE SCANE BSW-IFF-ESW TABLE AND TO EASE
* TRANSLATION STORAGE REQUIREMENTS.
*
{CFP$U{EQU{*{{{REALISTIC UPPER BOUND ON ALPHABET
{{EJC{{{{
*
* ENVIRONMENT PARAMETERS
*
* THE SPITBOL PROGRAM IS ESSENTIALLY INDEPENDENT OF
* THE DEFINITIONS OF THESE PARAMETERS. HOWEVER, THE
* EFFICIENCY OF THE SYSTEM MAY BE AFFECTED. CONSEQUENTLY,
* THESE PARAMETERS MAY REQUIRE TUNING FOR A GIVEN VERSION
* THE VALUES GIVEN IN COMMENTS HAVE BEEN SUCCESSFULLY USED.
*
* E$SRS IS THE NUMBER OF WORDS TO RESERVE AT THE END OF
* STORAGE FOR END OF RUN PROCESSING. IT SHOULD BE
* SET AS SMALL AS POSSIBLE WITHOUT CAUSING MEMORY OVERFLOW
* IN CRITICAL SITUATIONS (E.G. MEMORY OVERFLOW TERMINATION)
* AND SHOULD THUS RESERVE SUFFICIENT SPACE AT LEAST FOR
* AN SCBLK CONTAINING SAY 30 CHARACTERS.
*
{E$SRS{EQU{*{{{30 WORDS
*
* E$STS IS THE NUMBER OF WORDS GRABBED IN A CHUNK WHEN
* STORAGE IS ALLOCATED IN THE STATIC REGION. THE MINIMUM
* PERMITTED VALUE IS 256/CFP$B. LARGER VALUES WILL LEAD
* TO INCREASED EFFICIENCY AT THE COST OF WASTING MEMORY.
*
{E$STS{EQU{*{{{500 WORDS
*
* E$CBS IS THE SIZE OF CODE BLOCK ALLOCATED INITIALLY AND
* THE EXPANSION INCREMENT IF OVERFLOW OCCURS. IF THIS VALUE
* IS TOO SMALL OR TOO LARGE, EXCESSIVE GARBAGE COLLECTIONS
* WILL OCCUR DURING COMPILATION AND MEMORY MAY BE LOST
* IN THE CASE OF A TOO LARGE VALUE.
*
{E$CBS{EQU{*{{{500 WORDS
*
* E$HNB IS THE NUMBER OF BUCKET HEADERS IN THE VARIABLE
* HASH TABLE. IT SHOULD ALWAYS BE ODD. LARGER VALUES WILL
* SPEED UP COMPILATION AND INDIRECT REFERENCES AT THE
* EXPENSE OF ADDITIONAL STORAGE FOR THE HASH TABLE ITSELF.
*
{E$HNB{EQU{*{{{127 BUCKET HEADERS
*
* E$HNW IS THE MAXIMUM NUMBER OF WORDS OF A STRING
* NAME WHICH PARTICIPATE IN THE STRING HASH ALGORITHM.
* LARGER VALUES GIVE A BETTER HASH AT THE EXPENSE OF TAKING
* LONGER TO COMPUTE THE HASH. THERE IS SOME OPTIMAL VALUE.
*
{E$HNW{EQU{*{{{6 WORDS
*
* E$FSP . IF THE AMOUNT OF FREE SPACE LEFT AFTER A GARBAGE
* COLLECTION IS SMALL COMPARED TO THE TOTAL AMOUNT OF SPACE
* IN USE GARBAGE COLLECTOR THRASHING IS LIKELY TO OCCUR AS
* THIS SPACE IS USED UP. E$FSP IS A MEASURE OF THE
* MINIMUM PERCENTAGE OF DYNAMIC MEMORY LEFT AS FREE SPACE
* BEFORE THE SYSTEM ROUTINE SYSMM IS CALLED TO TRY TO
* OBTAIN MORE MEMORY.
*
{E$FSP{EQU{*{{{15 PERCENT
{{EJC{{{{
*
* DEFINITIONS OF CODES FOR LETTERS
*
{CH$LA{EQU{*{{{LETTER A
{CH$LB{EQU{*{{{LETTER B
{CH$LC{EQU{*{{{LETTER C
{CH$LD{EQU{*{{{LETTER D
{CH$LE{EQU{*{{{LETTER E
{CH$LF{EQU{*{{{LETTER F
{CH$LG{EQU{*{{{LETTER G
{CH$LH{EQU{*{{{LETTER H
{CH$LI{EQU{*{{{LETTER I
{CH$LJ{EQU{*{{{LETTER J
{CH$LK{EQU{*{{{LETTER K
{CH$LL{EQU{*{{{LETTER L
{CH$LM{EQU{*{{{LETTER M
{CH$LN{EQU{*{{{LETTER N
{CH$LO{EQU{*{{{LETTER O
{CH$LP{EQU{*{{{LETTER P
{CH$LQ{EQU{*{{{LETTER Q
{CH$LR{EQU{*{{{LETTER R
{CH$LS{EQU{*{{{LETTER S
{CH$LT{EQU{*{{{LETTER T
{CH$LU{EQU{*{{{LETTER U
{CH$LV{EQU{*{{{LETTER V
{CH$LW{EQU{*{{{LETTER W
{CH$LX{EQU{*{{{LETTER X
{CH$LY{EQU{*{{{LETTER Y
{CH$L${EQU{*{{{LETTER Z
*
* DEFINITIONS OF CODES FOR DIGITS
*
{CH$D0{EQU{*{{{DIGIT 0
{CH$D1{EQU{*{{{DIGIT 1
{CH$D2{EQU{*{{{DIGIT 2
{CH$D3{EQU{*{{{DIGIT 3
{CH$D4{EQU{*{{{DIGIT 4
{CH$D5{EQU{*{{{DIGIT 5
{CH$D6{EQU{*{{{DIGIT 6
{CH$D7{EQU{*{{{DIGIT 7
{CH$D8{EQU{*{{{DIGIT 8
{CH$D9{EQU{*{{{DIGIT 9
{{EJC{{{{
*
* DEFINITIONS OF CODES FOR SPECIAL CHARACTERS
*
* THE NAMES OF THESE CHARACTERS ARE RELATED TO THEIR
* ORIGINAL REPRESENTATION IN THE EBCDIC SET CORRESPONDING
* TO THE DESCRIPTION IN STANDARD SNOBOL4 MANUALS AND TEXTS.
*
{CH$AM{EQU{*{{{KEYWORD OPERATOR (AMPERSAND)
{CH$AS{EQU{*{{{MULTIPLICATION SYMBOL (ASTERISK)
{CH$AT{EQU{*{{{CURSOR POSITION OPERATOR (AT)
{CH$BB{EQU{*{{{LEFT ARRAY BRACKET (LESS THAN)
{CH$BL{EQU{*{{{BLANK
{CH$BR{EQU{*{{{ALTERNATION OPERATOR (VERTICAL BAR)
{CH$CL{EQU{*{{{GOTO SYMBOL (COLON)
{CH$CM{EQU{*{{{COMMA
{CH$DL{EQU{*{{{INDIRECTION OPERATOR (DOLLAR)
{CH$DT{EQU{*{{{NAME OPERATOR (DOT)
{CH$DQ{EQU{*{{{DOUBLE QUOTE
{CH$EQ{EQU{*{{{EQUAL SIGN
{CH$EX{EQU{*{{{EXPONENTIATION OPERATOR (EXCLM)
{CH$MN{EQU{*{{{MINUS SIGN
{CH$NM{EQU{*{{{NUMBER SIGN
{CH$NT{EQU{*{{{NEGATION OPERATOR (NOT)
{CH$PC{EQU{*{{{PERCENT
{CH$PL{EQU{*{{{PLUS SIGN
{CH$PP{EQU{*{{{LEFT PARENTHESIS
{CH$RB{EQU{*{{{RIGHT ARRAY BRACKET (GRTR THAN)
{CH$RP{EQU{*{{{RIGHT PARENTHESIS
{CH$QU{EQU{*{{{INTERROGATION OPERATOR (QUESTION)
{CH$SL{EQU{*{{{SLASH
{CH$SM{EQU{*{{{SEMICOLON
{CH$SQ{EQU{*{{{SINGLE QUOTE
{CH$UN{EQU{*{{{SPECIAL IDENTIFIER CHAR (UNDERLINE)
{CH$OB{EQU{*{{{OPENING BRACKET
{CH$CB{EQU{*{{{CLOSING BRACKET
{{EJC{{{{
*
* REMAINING CHARS ARE OPTIONAL ADDITIONS TO THE STANDARDS.
*
* TAB CHARACTERS - SYNTACTICALLY EQUIVALENT TO BLANK
*
{CH$HT{EQU{*{{{HORIZONTAL TAB
*
* LOWER CASE OR SHIFTED CASE ALPHABETIC CHARS
*
{CH$$A{EQU{*{{{SHIFTED A
{CH$$B{EQU{*{{{SHIFTED B
{CH$$C{EQU{*{{{SHIFTED C
{CH$$D{EQU{*{{{SHIFTED D
{CH$$E{EQU{*{{{SHIFTED E
{CH$$F{EQU{*{{{SHIFTED F
{CH$$G{EQU{*{{{SHIFTED G
{CH$$H{EQU{*{{{SHIFTED H
{CH$$I{EQU{*{{{SHIFTED I
{CH$$J{EQU{*{{{SHIFTED J
{CH$$K{EQU{*{{{SHIFTED K
{CH$$L{EQU{*{{{SHIFTED L
{CH$$M{EQU{*{{{SHIFTED M
{CH$$N{EQU{*{{{SHIFTED N
{CH$$O{EQU{*{{{SHIFTED O
{CH$$P{EQU{*{{{SHIFTED P
{CH$$Q{EQU{*{{{SHIFTED Q
{CH$$R{EQU{*{{{SHIFTED R
{CH$$S{EQU{*{{{SHIFTED S
{CH$$T{EQU{*{{{SHIFTED T
{CH$$U{EQU{*{{{SHIFTED U
{CH$$V{EQU{*{{{SHIFTED V
{CH$$W{EQU{*{{{SHIFTED W
{CH$$X{EQU{*{{{SHIFTED X
{CH$$Y{EQU{*{{{SHIFTED Y
{CH$$${EQU{*{{{SHIFTED Z
* IF A DELIMITER OTHER THAN CH$CM MUST BE USED IN
* THE THIRD ARGUMENT OF INPUT(),OUTPUT() THEN .CIOD SHOULD
* BE DEFINED AND A PARAMETER SUPPLIED FOR IODEL.
*
{IODEL{EQU{*{{{
{{EJC{{{{
*
* DATA BLOCK FORMATS AND DEFINITIONS
*
* THE FOLLOWING SECTIONS DESCRIBE THE DETAILED FORMAT OF
* ALL POSSIBLE DATA BLOCKS IN STATIC AND DYNAMIC MEMORY.
*
* EVERY BLOCK HAS A NAME OF THE FORM XXBLK WHERE XX IS A
* UNIQUE TWO CHARACTER IDENTIFIER. THE FIRST WORD OF EVERY
* BLOCK MUST CONTAIN A POINTER TO A PROGRAM LOCATION IN THE
* INTERPRETOR WHICH IS IMMEDIATELY PRECEDED BY AN ADDRESS
* CONSTANT CONTAINING THE VALUE BL$XX WHERE XX IS THE BLOCK
* IDENTIFIER. THIS PROVIDES A UNIFORM MECHANISM FOR
* DISTINGUISHING BETWEEN THE VARIOUS BLOCK TYPES.
*
* IN SOME CASES, THE CONTENTS OF THE FIRST WORD IS CONSTANT
* FOR A GIVEN BLOCK TYPE AND MERELY SERVES AS A POINTER
* TO THE IDENTIFYING ADDRESS CONSTANT. HOWEVER, IN OTHER
* CASES THERE ARE SEVERAL POSSIBILITIES FOR THE FIRST
* WORD IN WHICH CASE EACH OF THE SEVERAL PROGRAM ENTRY
* POINTS MUST BE PRECEDED BY THE APPROPRIATE CONSTANT.
*
* IN EACH BLOCK, SOME OF THE FIELDS ARE RELOCATABLE. THIS
* MEANS THAT THEY MAY CONTAIN A POINTER TO ANOTHER BLOCK
* IN THE DYNAMIC AREA. (TO BE MORE PRECISE, IF THEY CONTAIN
* A POINTER WITHIN THE DYNAMIC AREA, THEN IT IS A POINTER
* TO A BLOCK). SUCH FIELDS MUST BE MODIFIED BY THE GARBAGE
* COLLECTOR (PROCEDURE GBCOL) WHENEVER BLOCKS ARE COMPACTED
* IN THE DYNAMIC REGION. THE GARBAGE COLLECTOR (ACTUALLY
* PROCEDURE GBCPF) REQUIRES THAT ALL SUCH RELOCATABLE
* FIELDS IN A BLOCK MUST BE CONTIGUOUS.
{{EJC{{{{
*
* THE DESCRIPTION FORMAT USES THE FOLLOWING SCHEME.
*
* 1) BLOCK TITLE AND TWO CHARACTER IDENTIFIER
*
* 2) DESCRIPTION OF BASIC USE OF BLOCK AND INDICATION
* OF CIRCUMSTANCES UNDER WHICH IT IS CONSTRUCTED.
*
* 3) PICTURE OF THE BLOCK FORMAT. IN THESE PICTURES LOW
* MEMORY ADDRESSES ARE AT THE TOP OF THE PAGE. FIXED
* LENGTH FIELDS ARE SURROUNDED BY I (LETTER I). FIELDS
* WHICH ARE FIXED LENGTH BUT WHOSE LENGTH IS DEPENDENT
* ON A CONFIGURATION PARAMETER ARE SURROUNDED BY *
* (ASTERISK). VARIABLE LENGTH FIELDS ARE SURROUNDED
* BY / (SLASH).
*
* 4) DEFINITION OF SYMBOLIC OFFSETS TO FIELDS IN
* BLOCK AND OF THE SIZE OF THE BLOCK IF FIXED LENGTH
* OR OF THE SIZE OF THE FIXED LENGTH FIELDS IF THE
* BLOCK IS VARIABLE LENGTH.
* NOTE THAT SOME ROUTINES SUCH AS GBCPF ASSUME
* CERTAIN OFFSETS ARE EQUAL. THE DEFINITIONS
* GIVEN HERE ENFORCE THIS. MAKE CHANGES TO
* THEM ONLY WITH DUE CARE.
*
* DEFINITIONS OF COMMON OFFSETS
*
{OFFS1{EQU{1{{{
{OFFS2{EQU{2{{{
{OFFS3{EQU{3{{{
*
* 5) DETAILED COMMENTS ON THE SIGNIFICANCE AND FORMATS
* OF THE VARIOUS FIELDS.
*
* THE ORDER IS ALPHABETICAL BY IDENTIFICATION CODE.
{{EJC{{{{
*
* DEFINITIONS OF BLOCK CODES
*
* THIS TABLE PROVIDES A UNIQUE IDENTIFICATION CODE FOR
* EACH SEPARATE BLOCK TYPE. THE FIRST WORD OF A BLOCK IN
* THE DYNAMIC AREA ALWAYS CONTAINS THE ADDRESS OF A PROGRAM
* ENTRY POINT. THE BLOCK CODE IS USED AS THE ENTRY POINT ID
* THE ORDER OF THESE CODES DICTATES THE ORDER OF THE TABLE
* USED BY THE DATATYPE FUNCTION (SCNMT IN THE CONSTANT SEC)
*
* BLOCK CODES FOR ACCESSIBLE DATATYPES
*
{BL$AR{EQU{0{{{ARBLK ARRAY
{BL$BC{EQU{BL$AR+1{{{BCBLK BUFFER
{BL$CD{EQU{BL$BC+1{{{CDBLK CODE
{BL$EX{EQU{BL$CD+1{{{EXBLK EXPRESSION
{BL$IC{EQU{BL$EX+1{{{ICBLK INTEGER
{BL$NM{EQU{BL$IC+1{{{NMBLK NAME
{BL$P0{EQU{BL$NM+1{{{P0BLK PATTERN
{BL$P1{EQU{BL$P0+1{{{P1BLK PATTERN
{BL$P2{EQU{BL$P1+1{{{P2BLK PATTERN
{BL$RC{EQU{BL$P2+1{{{RCBLK REAL
{BL$SC{EQU{BL$RC+1{{{SCBLK STRING
{BL$SE{EQU{BL$SC+1{{{SEBLK EXPRESSION
{BL$TB{EQU{BL$SE+1{{{TBBLK TABLE
{BL$VC{EQU{BL$TB+1{{{VCBLK ARRAY
{BL$XN{EQU{BL$VC+1{{{XNBLK EXTERNAL
{BL$XR{EQU{BL$XN+1{{{XRBLK EXTERNAL
{BL$PD{EQU{BL$XR+1{{{PDBLK PROGRAM DEFINED DATATYPE
*
{BL$$D{EQU{BL$PD+1{{{NUMBER OF BLOCK CODES FOR DATA
*
* OTHER BLOCK CODES
*
{BL$TR{EQU{BL$PD+1{{{TRBLK
{BL$BF{EQU{BL$TR+1{{{BFBLK
{BL$CC{EQU{BL$BF+1{{{CCBLK
{BL$CM{EQU{BL$CC+1{{{CMBLK
{BL$CT{EQU{BL$CM+1{{{CTBLK
{BL$DF{EQU{BL$CT+1{{{DFBLK
{BL$EF{EQU{BL$DF+1{{{EFBLK
{BL$EV{EQU{BL$EF+1{{{EVBLK
{BL$FF{EQU{BL$EV+1{{{FFBLK
{BL$KV{EQU{BL$FF+1{{{KVBLK
{BL$PF{EQU{BL$KV+1{{{PFBLK
{BL$TE{EQU{BL$PF+1{{{TEBLK
*
{BL$$I{EQU{0{{{DEFAULT IDENTIFICATION CODE
{BL$$T{EQU{BL$TR+1{{{CODE FOR DATA OR TRACE BLOCK
{BL$$${EQU{BL$TE+1{{{NUMBER OF BLOCK CODES
{{EJC{{{{
*
* FIELD REFERENCES
*
* REFERENCES TO THE FIELDS OF DATA BLOCKS ARE SYMBOLIC
* (I.E. USE THE SYMBOLIC OFFSETS) WITH THE FOLLOWING
* EXCEPTIONS.
*
* 1) REFERENCES TO THE FIRST WORD ARE USUALLY NOT
* SYMBOLIC SINCE THEY USE THE (X) OPERAND FORMAT.
*
* 2) THE CODE WHICH CONSTRUCTS A BLOCK IS OFTEN NOT
* SYMBOLIC AND SHOULD BE CHANGED IF THE CORRESPONDING
* BLOCK FORMAT IS MODIFIED.
*
* 3) THE PLC AND PSC INSTRUCTIONS IMPLY AN OFFSET
* CORRESPONDING TO THE DEFINITION OF CFP$F.
*
* 4) THERE ARE NON-SYMBOLIC REFERENCES (EASILY CHANGED)
* IN THE GARBAGE COLLECTOR (PROCEDURES GBCPF, BLKLN).
*
* 5) THE FIELDS IDVAL, FARGS APPEAR IN SEVERAL BLOCKS
* AND ANY CHANGES MUST BE MADE IN PARALLEL TO ALL
* BLOCKS CONTAINING THE FIELDS. THE ACTUAL REFERENCES
* TO THESE FIELDS ARE SYMBOLIC WITH THE ABOVE
* LISTED EXCEPTIONS.
*
* 6) SEVERAL SPOTS IN THE CODE ASSUME THAT THE
* DEFINITIONS OF THE FIELDS VRVAL, TEVAL, TRNXT ARE
* THE SAME (THESE ARE SECTIONS OF CODE WHICH SEARCH
* OUT ALONG A TRBLK CHAIN FROM A VARIABLE).
*
* 7) REFERENCES TO THE FIELDS OF AN ARRAY BLOCK IN THE
* ARRAY REFERENCE ROUTINE ARREF ARE NON-SYMBOLIC.
*
* APART FROM THE EXCEPTIONS LISTED, REFERENCES ARE SYMBOLIC
* AS FAR AS POSSIBLE AND MODIFYING THE ORDER OR NUMBER
* OF FIELDS WILL NOT REQUIRE CHANGES.
{{EJC{{{{
*
* COMMON FIELDS FOR FUNCTION BLOCKS
*
* BLOCKS WHICH REPRESENT CALLABLE FUNCTIONS HAVE TWO
* COMMON FIELDS AT THE START OF THE BLOCK AS FOLLOWS.
*
* +------------------------------------+
* I FCODE I
* +------------------------------------+
* I FARGS I
* +------------------------------------+
* / /
* / REST OF FUNCTION BLOCK /
* / /
* +------------------------------------+
*
{FCODE{EQU{0{{{POINTER TO CODE FOR FUNCTION
{FARGS{EQU{1{{{NUMBER OF ARGUMENTS
*
* FCODE IS A POINTER TO THE LOCATION IN THE INTERPRETOR
* PROGRAM WHICH PROCESSES THIS TYPE OF FUNCTION CALL.
*
* FARGS IS THE EXPECTED NUMBER OF ARGUMENTS. THE ACTUAL
* NUMBER OF ARGUMENTS IS ADJUSTED TO THIS AMOUNT BY
* DELETING EXTRA ARGUMENTS OR SUPPLYING TRAILING NULLS
* FOR MISSING ONES BEFORE TRANSFERRING THOUGH FCODE.
* A VALUE OF 999 MAY BE USED IN THIS FIELD TO INDICATE A
* VARIABLE NUMBER OF ARGUMENTS (SEE SVBLK FIELD SVNAR).
*
* THE BLOCK TYPES WHICH FOLLOW THIS SCHEME ARE.
*
* FFBLK FIELD FUNCTION
* DFBLK DATATYPE FUNCTION
* PFBLK PROGRAM DEFINED FUNCTION
* EFBLK EXTERNAL LOADED FUNCTION
{{EJC{{{{
*
* IDENTIFICATION FIELD
*
*
* ID FIELD
*
* CERTAIN PROGRAM ACCESSIBLE OBJECTS (THOSE WHICH CONTAIN
* OTHER DATA VALUES AND CAN BE COPIED) ARE GIVEN A UNIQUE
* IDENTIFICATION NUMBER (SEE EXSID). THIS ID VALUE IS AN
* ADDRESS INTEGER VALUE WHICH IS ALWAYS STORED IN WORD TWO.
*
{IDVAL{EQU{1{{{ID VALUE FIELD
*
* THE BLOCKS CONTAINING AN IDVAL FIELD ARE.
*
* ARBLK ARRAY
* BCBLK BUFFER CONTROL BLOCK
* PDBLK PROGRAM DEFINED DATATYPE
* TBBLK TABLE
* VCBLK VECTOR BLOCK (ARRAY)
*
* NOTE THAT A ZERO IDVAL MEANS THAT THE BLOCK IS ONLY
* HALF BUILT AND SHOULD NOT BE DUMPED (SEE DUMPR).
{{EJC{{{{
*
* ARRAY BLOCK (ARBLK)
*
* AN ARRAY BLOCK REPRESENTS AN ARRAY VALUE OTHER THAN ONE
* WITH ONE DIMENSION WHOSE LOWER BOUND IS ONE (SEE VCBLK).
* AN ARBLK IS BUILT WITH A CALL TO THE FUNCTIONS CONVERT
* (S$CNV) OR ARRAY (S$ARR).
*
* +------------------------------------+
* I ARTYP I
* +------------------------------------+
* I IDVAL I
* +------------------------------------+
* I ARLEN I
* +------------------------------------+
* I AROFS I
* +------------------------------------+
* I ARNDM I
* +------------------------------------+
* * ARLBD *
* +------------------------------------+
* * ARDIM *
* +------------------------------------+
* * *
* * ABOVE 2 FLDS REPEATED FOR EACH DIM *
* * *
* +------------------------------------+
* I ARPRO I
* +------------------------------------+
* / /
* / ARVLS /
* / /
* +------------------------------------+
{{EJC{{{{
*
* ARRAY BLOCK (CONTINUED)
*
{ARTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$ART
{ARLEN{EQU{IDVAL+1{{{LENGTH OF ARBLK IN BYTES
{AROFS{EQU{ARLEN+1{{{OFFSET IN ARBLK TO ARPRO FIELD
{ARNDM{EQU{AROFS+1{{{NUMBER OF DIMENSIONS
{ARLBD{EQU{ARNDM+1{{{LOW BOUND (FIRST SUBSCRIPT)
{ARDIM{EQU{ARLBD+CFP$I{{{DIMENSION (FIRST SUBSCRIPT)
{ARLB2{EQU{ARDIM+CFP$I{{{LOW BOUND (SECOND SUBSCRIPT)
{ARDM2{EQU{ARLB2+CFP$I{{{DIMENSION (SECOND SUBSCRIPT)
{ARPRO{EQU{ARDIM+CFP$I{{{ARRAY PROTOTYPE (ONE DIMENSION)
{ARVLS{EQU{ARPRO+1{{{START OF VALUES (ONE DIMENSION)
{ARPR2{EQU{ARDM2+CFP$I{{{ARRAY PROTOTYPE (TWO DIMENSIONS)
{ARVL2{EQU{ARPR2+1{{{START OF VALUES (TWO DIMENSIONS)
{ARSI${EQU{ARLBD{{{NUMBER OF STANDARD FIELDS IN BLOCK
{ARDMS{EQU{ARLB2-ARLBD{{{SIZE OF INFO FOR ONE SET OF BOUNDS
*
* THE BOUNDS AND DIMENSION FIELDS ARE SIGNED INTEGER
* VALUES AND EACH OCCUPY CFP$I WORDS IN THE ARBLK.
*
* THE LENGTH OF AN ARBLK IN BYTES MAY NOT EXCEED MXLEN.
* THIS IS REQUIRED TO KEEP NAME OFFSETS GARBAGE COLLECTABLE
*
* THE ACTUAL VALUES ARE ARRANGED IN ROW-WISE ORDER AND
* CAN CONTAIN A DATA POINTER OR A POINTER TO A TRBLK.
*
* BUFFER CONTROL BLOCK (BCBLK)
*
* A BCBLK IS BUILT FOR EVERY BFBLK.
*
* +------------------------------------+
* I BCTYP I
* +------------------------------------+
* I IDVAL I
* +------------------------------------+
* I BCLEN I
* +------------------------------------+
* I BCBUF I
* +------------------------------------+
*
{BCTYP{EQU{0{{{PTR TO DUMMY ROUTINE B$BCT
{BCLEN{EQU{IDVAL+1{{{DEFINED BUFFER LENGTH
{BCBUF{EQU{BCLEN+1{{{PTR TO BFBLK
{BCSI${EQU{BCBUF+1{{{SIZE OF BCBLK
*
* A BCBLK IS AN INDIRECT CONTROL HEADER FOR BFBLK.
* THE REASON FOR NOT STORING THIS DATA DIRECTLY
* IN THE RELATED BFBLK IS SO THAT THE BFBLK CAN
* MAINTAIN THE SAME SKELETAL STRUCTURE AS AN SCBLK
* THUS FACILITATING TRANSPARENT STRING OPERATIONS
* (FOR THE MOST PART). SPECIFICALLY, CFP$F IS THE
* SAME FOR A BFBLK AS FOR AN SCBLK. BY CONVENTION,
* WHEREEVER A BUFFER VALUE IS EMPLOYED, THE BCBLK
* IS POINTED TO.
*
* THE CORRESPONDING BFBLK IS POINTED TO BY THE
* BCBUF POINTER IN THE BCBLK.
*
* BCLEN IS THE CURRENT DEFINED SIZE OF THE CHARACTER
* ARRAY IN THE BFBLK. CHARACTERS FOLLOWING THE OFFSET
* OF BCLEN ARE UNDEFINED.
*
{{EJC{{{{
*
* STRING BUFFER BLOCK (BFBLK)
*
* A BFBLK IS BUILT BY A CALL TO BUFFER(...)
*
* +------------------------------------+
* I BFTYP I
* +------------------------------------+
* I BFALC I
* +------------------------------------+
* / /
* / BFCHR /
* / /
* +------------------------------------+
*
{BFTYP{EQU{0{{{PTR TO DUMMY ROUTINE B$BFT
{BFALC{EQU{BFTYP+1{{{ALLOCATED SIZE OF BUFFER
{BFCHR{EQU{BFALC+1{{{CHARACTERS OF STRING
{BFSI${EQU{BFCHR{{{SIZE OF STANDARD FIELDS IN BFBLK
*
* THE CHARACTERS IN THE BUFFER ARE STORED LEFT JUSTIFIED.
* THE FINAL WORD OF DEFINED CHARACTERS IS ALWAYS ZERO
* (CHARACTER) PADDED. ANY TRAILING ALLOCATION PAST THE
* WORD CONTAINING THE LAST CHARACTER CONTAINS
* UNPREDICTABLE CONTENTS AND IS NEVER REFERENCED.
*
* NOTE THAT THE OFFSET TO THE CHARACTERS OF THE STRING
* IS GIVEN BY CFP$F, AS WITH AN SCBLK. HOWEVER, THE
* OFFSET WHICH IS OCCUPIED BY THE LENGTH FOR AN SCBLK
* IS THE TOTAL CHAR SPACE FOR BFBLKS, AND ROUTINES WHICH
* DEAL WITH BOTH MUST ACCOUNT FOR THIS DIFFERENCE.
*
* THE VALUE OF BFALC MAY NOT EXCEED MXLEN. THE VALUE OF
* BCLEN IS ALWAYS LESS THAN OR EQUAL TO BFALC.
*
{{EJC{{{{
*
* CODE CONSTRUCTION BLOCK (CCBLK)
*
* AT ANY ONE MOMENT THERE IS AT MOST ONE CCBLK INTO
* WHICH THE COMPILER IS CURRENTLY STORING CODE (CDWRD).
*
* +------------------------------------+
* I CCTYP I
* +------------------------------------+
* I CCLEN I
* +------------------------------------+
* I CCUSE I
* +------------------------------------+
* / /
* / CCCOD /
* / /
* +------------------------------------+
*
{CCTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$CCT
{CCLEN{EQU{CCTYP+1{{{LENGTH OF CCBLK IN BYTES
{CCUSE{EQU{CCLEN+1{{{OFFSET PAST LAST USED WORD (BYTES)
{CCCOD{EQU{CCUSE+1{{{START OF GENERATED CODE IN BLOCK
*
* THE REASON THAT THE CCBLK IS A SEPARATE BLOCK TYPE FROM
* THE USUAL CDBLK IS THAT THE GARBAGE COLLECTOR MUST
* ONLY PROCESS THOSE FIELDS WHICH HAVE BEEN SET (SEE GBCPF)
{{EJC{{{{
*
* CODE BLOCK (CDBLK)
*
* A CODE BLOCK IS BUILT FOR EACH STATEMENT COMPILED DURING
* THE INITIAL COMPILATION OR BY SUBSEQUENT CALLS TO CODE.
*
* +------------------------------------+
* I CDJMP I
* +------------------------------------+
* I CDSTM I
* +------------------------------------+
* I CDLEN I
* +------------------------------------+
* I CDFAL I
* +------------------------------------+
* / /
* / CDCOD /
* / /
* +------------------------------------+
*
{CDJMP{EQU{0{{{PTR TO ROUTINE TO EXECUTE STATEMENT
{CDSTM{EQU{CDJMP+1{{{STATEMENT NUMBER
{CDLEN{EQU{OFFS2{{{LENGTH OF CDBLK IN BYTES
{CDFAL{EQU{OFFS3{{{FAILURE EXIT (SEE BELOW)
{CDCOD{EQU{CDFAL+1{{{EXECUTABLE PSEUDO-CODE
{CDSI${EQU{CDCOD{{{NUMBER OF STANDARD FIELDS IN CDBLK
*
* CDSTM IS THE STATEMENT NUMBER OF THE CURRENT STATEMENT.
*
* CDJMP, CDFAL ARE SET AS FOLLOWS.
*
* 1) IF THE FAILURE EXIT IS THE NEXT STATEMENT
*
* CDJMP = B$CDS
* CDFAL = PTR TO CDBLK FOR NEXT STATEMENT
*
* 2) IF THE FAILURE EXIT IS A SIMPLE LABEL NAME
*
* CDJMP = B$CDS
* CDFAL IS A PTR TO THE VRTRA FIELD OF THE VRBLK
*
* 3) IF THERE IS NO FAILURE EXIT (-NOFAIL MODE)
*
* CDJMP = B$CDS
* CDFAL = O$UNF
*
* 4) IF THE FAILURE EXIT IS COMPLEX OR DIRECT
*
* CDJMP = B$CDC
* CDFAL IS THE OFFSET TO THE O$GOF WORD
{{EJC{{{{
*
* CODE BLOCK (CONTINUED)
*
* CDCOD IS THE START OF THE ACTUAL CODE. FIRST WE DESCRIBE
* THE CODE GENERATED FOR AN EXPRESSION. IN AN EXPRESSION,
* ELEMENTS ARE FETCHED BY NAME OR BY VALUE. FOR EXAMPLE,
* THE BINARY EQUAL OPERATOR FETCHES ITS LEFT ARGUMENT
* BY NAME AND ITS RIGHT ARGUMENT BY VALUE. THESE TWO
* CASES GENERATE QUITE DIFFERENT CODE AND ARE DESCRIBED
* SEPARATELY. FIRST WE CONSIDER THE CODE BY VALUE CASE.
*
* GENERATION OF CODE BY VALUE FOR EXPRESSIONS ELEMENTS.
*
* EXPRESSION POINTER TO EXBLK OR SEBLK
*
* INTEGER CONSTANT POINTER TO ICBLK
*
* NULL CONSTANT POINTER TO NULLS
*
* PATTERN (RESULTING FROM PREEVALUATION)
* =O$LPT
* POINTER TO P0BLK,P1BLK OR P2BLK
*
* REAL CONSTANT POINTER TO RCBLK
*
* STRING CONSTANT POINTER TO SCBLK
*
* VARIABLE POINTER TO VRGET FIELD OF VRBLK
*
* ADDITION VALUE CODE FOR LEFT OPERAND
* VALUE CODE FOR RIGHT OPERAND
* =O$ADD
*
* AFFIRMATION VALUE CODE FOR OPERAND
* =O$AFF
*
* ALTERNATION VALUE CODE FOR LEFT OPERAND
* VALUE CODE FOR RIGHT OPERAND
* =O$ALT
*
* ARRAY REFERENCE (CASE OF ONE SUBSCRIPT)
* VALUE CODE FOR ARRAY OPERAND
* VALUE CODE FOR SUBSCRIPT OPERAND
* =O$AOV
*
* (CASE OF MORE THAN ONE SUBSCRIPT)
* VALUE CODE FOR ARRAY OPERAND
* VALUE CODE FOR FIRST SUBSCRIPT
* VALUE CODE FOR SECOND SUBSCRIPT
* ...
* VALUE CODE FOR LAST SUBSCRIPT
* =O$AMV
* NUMBER OF SUBSCRIPTS
{{EJC{{{{
*
* CODE BLOCK (CONTINUED)
*
* ASSIGNMENT (TO NATURAL VARIABLE)
* VALUE CODE FOR RIGHT OPERAND
* POINTER TO VRSTO FIELD OF VRBLK
*
* (TO ANY OTHER VARIABLE)
* NAME CODE FOR LEFT OPERAND
* VALUE CODE FOR RIGHT OPERAND
* =O$ASS
*
* COMPILE ERROR =O$CER
*
*
* COMPLEMENTATION VALUE CODE FOR OPERAND
* =O$COM
*
* CONCATENATION (CASE OF PRED FUNC LEFT OPERAND)
* VALUE CODE FOR LEFT OPERAND
* =O$POP
* VALUE CODE FOR RIGHT OPERAND
*
* (ALL OTHER CASES)
* VALUE CODE FOR LEFT OPERAND
* VALUE CODE FOR RIGHT OPERAND
* =O$CNC
*
* CURSOR ASSIGNMENT NAME CODE FOR OPERAND
* =O$CAS
*
* DIVISION VALUE CODE FOR LEFT OPERAND
* VALUE CODE FOR RIGHT OPERAND
* =O$DVD
*
* EXPONENTIATION VALUE CODE FOR LEFT OPERAND
* VALUE CODE FOR RIGHT OPERAND
* =O$EXP
*
* FUNCTION CALL (CASE OF CALL TO SYSTEM FUNCTION)
* VALUE CODE FOR FIRST ARGUMENT
* VALUE CODE FOR SECOND ARGUMENT
* ...
* VALUE CODE FOR LAST ARGUMENT
* POINTER TO SVFNC FIELD OF SVBLK
*
{{EJC{{{{
*
* CODE BLOCK (CONTINUED)
*
* FUNCTION CALL (CASE OF NON-SYSTEM FUNCTION 1 ARG)
* VALUE CODE FOR ARGUMENT
* =O$FNS
* POINTER TO VRBLK FOR FUNCTION
*
* (NON-SYSTEM FUNCTION, GT 1 ARG)
* VALUE CODE FOR FIRST ARGUMENT
* VALUE CODE FOR SECOND ARGUMENT
* ...
* VALUE CODE FOR LAST ARGUMENT
* =O$FNC
* NUMBER OF ARGUMENTS
* POINTER TO VRBLK FOR FUNCTION
*
* IMMEDIATE ASSIGNMENT VALUE CODE FOR LEFT OPERAND
* NAME CODE FOR RIGHT OPERAND
* =O$IMA
*
* INDIRECTION VALUE CODE FOR OPERAND
* =O$INV
*
* INTERROGATION VALUE CODE FOR OPERAND
* =O$INT
*
* KEYWORD REFERENCE NAME CODE FOR OPERAND
* =O$KWV
*
* MULTIPLICATION VALUE CODE FOR LEFT OPERAND
* VALUE CODE FOR RIGHT OPERAND
* =O$MLT
*
* NAME REFERENCE (NATURAL VARIABLE CASE)
* POINTER TO NMBLK FOR NAME
*
* (ALL OTHER CASES)
* NAME CODE FOR OPERAND
* =O$NAM
*
* NEGATION =O$NTA
* CDBLK OFFSET OF O$NTC WORD
* VALUE CODE FOR OPERAND
* =O$NTB
* =O$NTC
{{EJC{{{{
*
* CODE BLOCK (CONTINUED)
*
* PATTERN ASSIGNMENT VALUE CODE FOR LEFT OPERAND
* NAME CODE FOR RIGHT OPERAND
* =O$PAS
*
* PATTERN MATCH VALUE CODE FOR LEFT OPERAND
* VALUE CODE FOR RIGHT OPERAND
* =O$PMV
*
* PATTERN REPLACEMENT NAME CODE FOR SUBJECT
* VALUE CODE FOR PATTERN
* =O$PMN
* VALUE CODE FOR REPLACEMENT
* =O$RPL
*
* SELECTION (FOR FIRST ALTERNATIVE)
* =O$SLA
* CDBLK OFFSET TO NEXT O$SLC WORD
* VALUE CODE FOR FIRST ALTERNATIVE
* =O$SLB
* CDBLK OFFSET PAST ALTERNATIVES
*
* (FOR SUBSEQUENT ALTERNATIVES)
* =O$SLC
* CDBLK OFFSET TO NEXT O$SLC,O$SLD
* VALUE CODE FOR ALTERNATIVE
* =O$SLB
* OFFSET IN CDBLK PAST ALTERNATIVES
*
* (FOR LAST ALTERNATIVE)
* =O$SLD
* VALUE CODE FOR LAST ALTERNATIVE
*
* SUBTRACTION VALUE CODE FOR LEFT OPERAND
* VALUE CODE FOR RIGHT OPERAND
* =O$SUB
{{EJC{{{{
*
* CODE BLOCK (CONTINUED)
*
* GENERATION OF CODE BY NAME FOR EXPRESSION ELEMENTS.
*
* VARIABLE =O$LVN
* POINTER TO VRBLK
*
* EXPRESSION (CASE OF *NATURAL VARIABLE)
* =O$LVN
* POINTER TO VRBLK
*
* (ALL OTHER CASES)
* =O$LEX
* POINTER TO EXBLK
*
*
* ARRAY REFERENCE (CASE OF ONE SUBSCRIPT)
* VALUE CODE FOR ARRAY OPERAND
* VALUE CODE FOR SUBSCRIPT OPERAND
* =O$AON
*
* (CASE OF MORE THAN ONE SUBSCRIPT)
* VALUE CODE FOR ARRAY OPERAND
* VALUE CODE FOR FIRST SUBSCRIPT
* VALUE CODE FOR SECOND SUBSCRIPT
* ...
* VALUE CODE FOR LAST SUBSCRIPT
* =O$AMN
* NUMBER OF SUBSCRIPTS
*
* COMPILE ERROR =O$CER
*
* FUNCTION CALL (SAME CODE AS FOR VALUE CALL)
* =O$FNE
*
* INDIRECTION VALUE CODE FOR OPERAND
* =O$INN
*
* KEYWORD REFERENCE NAME CODE FOR OPERAND
* =O$KWN
*
* ANY OTHER OPERAND IS AN ERROR IN A NAME POSITION
*
* NOTE THAT IN THIS DESCRIPTION, =O$XXX REFERS TO THE
* GENERATION OF A WORD CONTAINING THE ADDRESS OF ANOTHER
* WORD WHICH CONTAINS THE ENTRY POINT ADDRESS O$XXX.
{{EJC{{{{
*
* CODE BLOCK (CONTINUED)
*
* NOW WE CONSIDER THE OVERALL STRUCTURE OF THE CODE BLOCK
* FOR A STATEMENT WITH POSSIBLE GOTO FIELDS.
*
* FIRST COMES THE CODE FOR THE STATEMENT BODY.
* THE STATEMENT BODY IS AN EXPRESSION TO BE EVALUATED
* BY VALUE ALTHOUGH THE VALUE IS NOT ACTUALLY REQUIRED.
* NORMAL VALUE CODE IS GENERATED FOR THE BODY OF THE
* STATEMENT EXCEPT IN THE CASE OF A PATTERN MATCH BY
* VALUE, IN WHICH CASE THE FOLLOWING IS GENERATED.
*
* VALUE CODE FOR LEFT OPERAND
* VALUE CODE FOR RIGHT OPERAND
* =O$PMS
*
* NEXT WE HAVE THE CODE FOR THE SUCCESS GOTO. THERE ARE
* SEVERAL CASES AS FOLLOWS.
*
* 1) NO SUCCESS GOTO PTR TO CDBLK FOR NEXT STATEMENT
*
* 2) SIMPLE LABEL PTR TO VRTRA FIELD OF VRBLK
*
* 3) COMPLEX GOTO (CODE BY NAME FOR GOTO OPERAND)
* =O$GOC
*
* 4) DIRECT GOTO (CODE BY VALUE FOR GOTO OPERAND)
* =O$GOD
*
* FOLLOWING THIS WE GENERATE CODE FOR THE FAILURE GOTO IF
* IT IS DIRECT OR IF IT IS COMPLEX, SIMPLE FAILURE GOTOS
* HAVING BEEN HANDLED BY AN APPROPRIATE SETTING OF THE
* CDFAL FIELD OF THE CDBLK. THE GENERATED CODE IS ONE
* OF THE FOLLOWING.
*
* 1) COMPLEX FGOTO =O$FIF
* =O$GOF
* NAME CODE FOR GOTO OPERAND
* =O$GOC
*
* 2) DIRECT FGOTO =O$FIF
* =O$GOF
* VALUE CODE FOR GOTO OPERAND
* =O$GOD
*
* AN OPTIMIZATION OCCURS IF THE SUCCESS AND FAILURE GOTOS
* ARE IDENTICAL AND EITHER COMPLEX OR DIRECT. IN THIS CASE,
* NO CODE IS GENERATED FOR THE SUCCESS GOTO AND CONTROL
* IS ALLOWED TO FALL INTO THE FAILURE GOTO ON SUCCESS.
{{EJC{{{{
*
* COMPILER BLOCK (CMBLK)
*
* A COMPILER BLOCK (CMBLK) IS BUILT BY EXPAN TO REPRESENT
* ONE NODE OF A TREE STRUCTURED EXPRESSION REPRESENTATION.
*
* +------------------------------------+
* I CMIDN I
* +------------------------------------+
* I CMLEN I
* +------------------------------------+
* I CMTYP I
* +------------------------------------+
* I CMOPN I
* +------------------------------------+
* / CMVLS OR CMROP /
* / /
* / CMLOP /
* / /
* +------------------------------------+
*
{CMIDN{EQU{0{{{POINTER TO DUMMY ROUTINE B$CMT
{CMLEN{EQU{CMIDN+1{{{LENGTH OF CMBLK IN BYTES
{CMTYP{EQU{CMLEN+1{{{TYPE (C$XXX, SEE LIST BELOW)
{CMOPN{EQU{CMTYP+1{{{OPERAND POINTER (SEE BELOW)
{CMVLS{EQU{CMOPN+1{{{OPERAND VALUE POINTERS (SEE BELOW)
{CMROP{EQU{CMVLS{{{RIGHT (ONLY) OPERATOR OPERAND
{CMLOP{EQU{CMVLS+1{{{LEFT OPERATOR OPERAND
{CMSI${EQU{CMVLS{{{NUMBER OF STANDARD FIELDS IN CMBLK
{CMUS${EQU{CMSI$+1{{{SIZE OF UNARY OPERATOR CMBLK
{CMBS${EQU{CMSI$+2{{{SIZE OF BINARY OPERATOR CMBLK
{CMAR1{EQU{CMVLS+1{{{ARRAY SUBSCRIPT POINTERS
*
* THE CMOPN AND CMVLS FIELDS ARE SET AS FOLLOWS
*
* ARRAY REFERENCE CMOPN = PTR TO ARRAY OPERAND
* CMVLS = PTRS TO SUBSCRIPT OPERANDS
*
* FUNCTION CALL CMOPN = PTR TO VRBLK FOR FUNCTION
* CMVLS = PTRS TO ARGUMENT OPERANDS
*
* SELECTION CMOPN = ZERO
* CMVLS = PTRS TO ALTERNATE OPERANDS
*
* UNARY OPERATOR CMOPN = PTR TO OPERATOR DVBLK
* CMROP = PTR TO OPERAND
*
* BINARY OPERATOR CMOPN = PTR TO OPERATOR DVBLK
* CMROP = PTR TO RIGHT OPERAND
* CMLOP = PTR TO LEFT OPERAND
{{EJC{{{{
*
* CMTYP IS SET TO INDICATE THE TYPE OF EXPRESSION ELEMENT
* AS SHOWN BY THE FOLLOWING TABLE OF DEFINITIONS.
*
{C$ARR{EQU{0{{{ARRAY REFERENCE
{C$FNC{EQU{C$ARR+1{{{FUNCTION CALL
{C$DEF{EQU{C$FNC+1{{{DEFERRED EXPRESSION (UNARY *)
{C$IND{EQU{C$DEF+1{{{INDIRECTION (UNARY $)
{C$KEY{EQU{C$IND+1{{{KEYWORD REFERENCE (UNARY AMPERSAND)
{C$UBO{EQU{C$KEY+1{{{UNDEFINED BINARY OPERATOR
{C$UUO{EQU{C$UBO+1{{{UNDEFINED UNARY OPERATOR
{C$UO${EQU{C$UUO+1{{{TEST VALUE (=C$UUO+1=C$UBO+2)
{C$$NM{EQU{C$UUO+1{{{NUMBER OF CODES FOR NAME OPERANDS
*
* THE REMAINING TYPES INDICATE EXPRESSION ELEMENTS WHICH
* CAN ONLY BE EVALUATED BY VALUE (NOT BY NAME).
*
{C$BVL{EQU{C$UUO+1{{{BINARY OP WITH VALUE OPERANDS
{C$UVL{EQU{C$BVL+1{{{UNARY OPERATOR WITH VALUE OPERAND
{C$ALT{EQU{C$UVL+1{{{ALTERNATION (BINARY BAR)
{C$CNC{EQU{C$ALT+1{{{CONCATENATION
{C$CNP{EQU{C$CNC+1{{{CONCATENATION, NOT PATTERN MATCH
{C$UNM{EQU{C$CNP+1{{{UNARY OP WITH NAME OPERAND
{C$BVN{EQU{C$UNM+1{{{BINARY OP (OPERANDS BY VALUE, NAME)
{C$ASS{EQU{C$BVN+1{{{ASSIGNMENT
{C$INT{EQU{C$ASS+1{{{INTERROGATION
{C$NEG{EQU{C$INT+1{{{NEGATION (UNARY NOT)
{C$SEL{EQU{C$NEG+1{{{SELECTION
{C$PMT{EQU{C$SEL+1{{{PATTERN MATCH
*
{C$PR${EQU{C$BVN{{{LAST PREEVALUABLE CODE
{C$$NV{EQU{C$PMT+1{{{NUMBER OF DIFFERENT CMBLK TYPES
{{EJC{{{{
*
* CHARACTER TABLE BLOCK (CTBLK)
*
* A CHARACTER TABLE BLOCK IS USED TO HOLD LOGICAL CHARACTER
* TABLES FOR USE WITH ANY,NOTANY,SPAN,BREAK,BREAKX
* PATTERNS. EACH CHARACTER TABLE CAN BE USED TO STORE
* CFP$N DISTINCT TABLES AS BIT COLUMNS. A BIT COLUMN
* ALLOCATED FOR EACH ARGUMENT OF MORE THAN ONE CHARACTER
* IN LENGTH TO ONE OF THE ABOVE LISTED PATTERN PRIMITIVES.
*
* +------------------------------------+
* I CTTYP I
* +------------------------------------+
* * *
* * *
* * CTCHS *
* * *
* * *
* +------------------------------------+
*
{CTTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$CTT
{CTCHS{EQU{CTTYP+1{{{START OF CHARACTER TABLE WORDS
{CTSI${EQU{CTCHS+CFP$A{{{NUMBER OF WORDS IN CTBLK
*
* CTCHS IS CFP$A WORDS LONG AND CONSISTS OF A ONE WORD
* BIT STRING VALUE FOR EACH POSSIBLE CHARACTER IN THE
* INTERNAL ALPHABET. EACH OF THE CFP$N POSSIBLE BITS IN
* A BITSTRING IS USED TO FORM A COLUMN OF BIT INDICATORS.
* A BIT IS SET ON IF THE CHARACTER IS IN THE TABLE AND OFF
* IF THE CHARACTER IS NOT PRESENT.
{{EJC{{{{
*
* DATATYPE FUNCTION BLOCK (DFBLK)
*
* A DATATYPE FUNCTION IS USED TO CONTROL THE CONSTRUCTION
* OF A PROGRAM DEFINED DATATYPE OBJECT. A CALL TO THE
* SYSTEM FUNCTION DATA BUILDS A DFBLK FOR THE DATATYPE NAME
*
* NOTE THAT THESE BLOCKS ARE BUILT IN STATIC BECAUSE PDBLK
* LENGTH IS GOT FROM DFLEN FIELD. IF DFBLK WAS IN DYNAMIC
* STORE THIS WOULD CAUSE TROUBLE DURING PASS TWO OF GARBAGE
* COLLECTION. SCBLK REFERRED TO BY DFNAM FIELD IS ALSO PUT
* IN STATIC SO THAT THERE ARE NO RELOC. FIELDS. THIS CUTS
* GARBAGE COLLECTION TASK APPRECIABLY FOR PDBLKS WHICH ARE
* LIKELY TO BE PRESENT IN LARGE NUMBERS.
*
* +------------------------------------+
* I FCODE I
* +------------------------------------+
* I FARGS I
* +------------------------------------+
* I DFLEN I
* +------------------------------------+
* I DFPDL I
* +------------------------------------+
* I DFNAM I
* +------------------------------------+
* / /
* / DFFLD /
* / /
* +------------------------------------+
*
{DFLEN{EQU{FARGS+1{{{LENGTH OF DFBLK IN BYTES
{DFPDL{EQU{DFLEN+1{{{LENGTH OF CORRESPONDING PDBLK
{DFNAM{EQU{DFPDL+1{{{POINTER TO SCBLK FOR DATATYPE NAME
{DFFLD{EQU{DFNAM+1{{{START OF VRBLK PTRS FOR FIELD NAMES
{DFFLB{EQU{DFFLD-1{{{OFFSET BEHIND DFFLD FOR FIELD FUNC
{DFSI${EQU{DFFLD{{{NUMBER OF STANDARD FIELDS IN DFBLK
*
* THE FCODE FIELD POINTS TO THE ROUTINE B$DFC
*
* FARGS (THE NUMBER OF ARGUMENTS) IS THE NUMBER OF FIELDS.
{{EJC{{{{
*
* DOPE VECTOR BLOCK (DVBLK)
*
* A DOPE VECTOR IS ASSEMBLED FOR EACH POSSIBLE OPERATOR IN
* THE SNOBOL4 LANGUAGE AS PART OF THE CONSTANT SECTION.
*
* +------------------------------------+
* I DVOPN I
* +------------------------------------+
* I DVTYP I
* +------------------------------------+
* I DVLPR I
* +------------------------------------+
* I DVRPR I
* +------------------------------------+
*
{DVOPN{EQU{0{{{ENTRY ADDRESS (PTR TO O$XXX)
{DVTYP{EQU{DVOPN+1{{{TYPE CODE (C$XXX, SEE CMBLK)
{DVLPR{EQU{DVTYP+1{{{LEFT PRECEDENCE (LLXXX, SEE BELOW)
{DVRPR{EQU{DVLPR+1{{{RIGHT PRECEDENCE (RRXXX, SEE BELOW)
{DVUS${EQU{DVLPR+1{{{SIZE OF UNARY OPERATOR DV
{DVBS${EQU{DVRPR+1{{{SIZE OF BINARY OPERATOR DV
{DVUBS{EQU{DVUS$+DVBS${{{SIZE OF UNOP + BINOP (SEE SCANE)
*
* THE CONTENTS OF THE DVTYP FIELD IS COPIED INTO THE CMTYP
* FIELD OF THE CMBLK FOR THE OPERATOR IF IT IS USED.
*
* THE CMOPN FIELD OF AN OPERATOR CMBLK POINTS TO THE DVBLK
* ITSELF, PROVIDING THE REQUIRED ENTRY ADDRESS POINTER PTR.
*
* FOR NORMALLY UNDEFINED OPERATORS, THE DVOPN (AND CMOPN)
* FIELDS CONTAIN A WORD OFFSET FROM R$UBA OF THE FUNCTION
* BLOCK POINTER FOR THE OPERATOR (INSTEAD OF O$XXX PTR).
* FOR CERTAIN SPECIAL OPERATORS, THE DVOPN FIELD IS NOT
* REQUIRED AT ALL AND IS ASSEMBLED AS ZERO.
*
* THE LEFT PRECEDENCE IS USED IN COMPARING AN OPERATOR TO
* THE LEFT OF SOME OTHER OPERATOR. IT THEREFORE GOVERNS THE
* PRECEDENCE OF THE OPERATOR TOWARDS ITS RIGHT OPERAND.
*
* THE RIGHT PRECEDENCE IS USED IN COMPARING AN OPERATOR TO
* THE RIGHT OF SOME OTHER OPERATOR. IT THEREFORE GOVERNS
* THE PRECEDENCE OF THE OPERATOR TOWARDS ITS LEFT OPERAND.
*
* HIGHER PRECEDENCE VALUES CORRESPOND TO A TIGHTER BINDING
* CAPABILITY. THUS WE HAVE THE LEFT PRECEDENCE LOWER
* (HIGHER) THAN THE RIGHT PRECEDENCE FOR RIGHT (LEFT)
* ASSOCIATIVE BINARY OPERATORS.
*
* THE LEFT PRECEDENCE OF UNARY OPERATORS IS SET TO AN
* ARBITRARY HIGH VALUE. THE RIGHT VALUE IS NOT REQUIRED AND
* CONSEQUENTLY THE DVRPR FIELD IS OMITTED FOR UNARY OPS.
{{EJC{{{{
*
* TABLE OF OPERATOR PRECEDENCE VALUES
*
{RRASS{EQU{10{{{RIGHT EQUAL
{LLASS{EQU{00{{{LEFT EQUAL
{RRPMT{EQU{20{{{RIGHT QUESTION MARK
{LLPMT{EQU{30{{{LEFT QUESTION MARK
{RRAMP{EQU{40{{{RIGHT AMPERSAND
{LLAMP{EQU{50{{{LEFT AMPERSAND
{RRALT{EQU{70{{{RIGHT VERTICAL BAR
{LLALT{EQU{60{{{LEFT VERTICAL BAR
{RRCNC{EQU{90{{{RIGHT BLANK
{LLCNC{EQU{80{{{LEFT BLANK
{RRATS{EQU{110{{{RIGHT AT
{LLATS{EQU{100{{{LEFT AT
{RRPLM{EQU{120{{{RIGHT PLUS, MINUS
{LLPLM{EQU{130{{{LEFT PLUS, MINUS
{RRNUM{EQU{140{{{RIGHT NUMBER
{LLNUM{EQU{150{{{LEFT NUMBER
{RRDVD{EQU{160{{{RIGHT SLASH
{LLDVD{EQU{170{{{LEFT SLASH
{RRMLT{EQU{180{{{RIGHT ASTERISK
{LLMLT{EQU{190{{{LEFT ASTERISK
{RRPCT{EQU{200{{{RIGHT PERCENT
{LLPCT{EQU{210{{{LEFT PERCENT
{RREXP{EQU{230{{{RIGHT EXCLAMATION
{LLEXP{EQU{220{{{LEFT EXCLAMATION
{RRDLD{EQU{240{{{RIGHT DOLLAR, DOT
{LLDLD{EQU{250{{{LEFT DOLLAR, DOT
{RRNOT{EQU{270{{{RIGHT NOT
{LLNOT{EQU{260{{{LEFT NOT
{LLUNO{EQU{999{{{LEFT ALL UNARY OPERATORS
*
* PRECEDENCES ARE THE SAME AS IN BTL SNOBOL4 WITH THE
* FOLLOWING EXCEPTIONS.
*
* 1) BINARY QUESTION MARK IS LOWERED AND MADE LEFT ASSOC-
* IATIVE TO REFLECT ITS NEW USE FOR PATTERN MATCHING.
*
* 2) ALTERNATION AND CONCATENATION ARE MADE RIGHT
* ASSOCIATIVE FOR GREATER EFFICIENCY IN PATTERN
* CONSTRUCTION AND MATCHING RESPECTIVELY. THIS CHANGE
* IS TRANSPARENT TO THE SNOBOL4 PROGRAMMER.
*
* 3) THE EQUAL SIGN HAS BEEN ADDED AS A LOW PRECEDENCE
* OPERATOR WHICH IS RIGHT ASSOCIATIVE TO REFLECT ITS
* MORE GENERAL USAGE IN THIS VERSION OF SNOBOL4.
{{EJC{{{{
*
* EXTERNAL FUNCTION BLOCK (EFBLK)
*
* AN EXTERNAL FUNCTION BLOCK IS USED TO CONTROL THE CALLING
* OF AN EXTERNAL FUNCTION. IT IS BUILT BY A CALL TO LOAD.
*
* +------------------------------------+
* I FCODE I
* +------------------------------------+
* I FARGS I
* +------------------------------------+
* I EFLEN I
* +------------------------------------+
* I EFUSE I
* +------------------------------------+
* I EFCOD I
* +------------------------------------+
* I EFVAR I
* +------------------------------------+
* I EFRSL I
* +------------------------------------+
* / /
* / EFTAR /
* / /
* +------------------------------------+
*
{EFLEN{EQU{FARGS+1{{{LENGTH OF EFBLK IN BYTES
{EFUSE{EQU{EFLEN+1{{{USE COUNT (FOR OPSYN)
{EFCOD{EQU{EFUSE+1{{{PTR TO CODE (FROM SYSLD)
{EFVAR{EQU{EFCOD+1{{{PTR TO ASSOCIATED VRBLK
{EFRSL{EQU{EFVAR+1{{{RESULT TYPE (SEE BELOW)
{EFTAR{EQU{EFRSL+1{{{ARGUMENT TYPES (SEE BELOW)
{EFSI${EQU{EFTAR{{{NUMBER OF STANDARD FIELDS IN EFBLK
*
* THE FCODE FIELD POINTS TO THE ROUTINE B$EFC.
*
* EFUSE IS USED TO KEEP TRACK OF MULTIPLE USE WHEN OPSYN
* IS EMPLOYED. THE FUNCTION IS AUTOMATICALLY UNLOADED
* WHEN THERE ARE NO MORE REFERENCES TO THE FUNCTION.
*
* EFRSL AND EFTAR ARE TYPE CODES AS FOLLOWS.
*
* 0 TYPE IS UNCONVERTED
* 1 TYPE IS STRING
* 2 TYPE IS INTEGER
* 3 TYPE IS REAL
{{EJC{{{{
*
* EXPRESSION VARIABLE BLOCK (EVBLK)
*
* IN THIS VERSION OF SPITBOL, AN EXPRESSION CAN BE USED IN
* ANY POSITION WHICH WOULD NORMALLY EXPECT A NAME (FOR
* EXAMPLE ON THE LEFT SIDE OF EQUALS OR AS THE RIGHT
* ARGUMENT OF BINARY DOT). THIS CORRESPONDS TO THE CREATION
* OF A PSEUDO-VARIABLE WHICH IS REPRESENTED BY A POINTER TO
* AN EXPRESSION VARIABLE BLOCK AS FOLLOWS.
*
* +------------------------------------+
* I EVTYP I
* +------------------------------------+
* I EVEXP I
* +------------------------------------+
* I EVVAR I
* +------------------------------------+
*
{EVTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$EVT
{EVEXP{EQU{EVTYP+1{{{POINTER TO EXBLK FOR EXPRESSION
{EVVAR{EQU{EVEXP+1{{{POINTER TO TRBEV DUMMY TRBLK
{EVSI${EQU{EVVAR+1{{{SIZE OF EVBLK
*
* THE NAME OF AN EXPRESSION VARIABLE IS REPRESENTED BY A
* BASE POINTER TO THE EVBLK AND AN OFFSET OF EVVAR. THIS
* VALUE APPEARS TO BE TRAPPED BY THE DUMMY TRBEV BLOCK.
*
* NOTE THAT THERE IS NO NEED TO ALLOW FOR THE CASE OF AN
* EXPRESSION VARIABLE WHICH REFERENCES AN SEBLK SINCE A
* VARIABLE WHICH IS OF THE FORM *VAR IS EQUIVALENT TO VAR.
{{EJC{{{{
*
* EXPRESSION BLOCK (EXBLK)
*
* AN EXPRESSION BLOCK IS BUILT FOR EACH EXPRESSION
* REFERENCED IN A PROGRAM OR CREATED BY EVAL OR CONVERT
* DURING EXECUTION OF A PROGRAM.
*
* +------------------------------------+
* I EXTYP I
* +------------------------------------+
* I EXSTM I
* +------------------------------------+
* I EXLEN I
* +------------------------------------+
* I EXFLC I
* +------------------------------------+
* / /
* / EXCOD /
* / /
* +------------------------------------+
*
{EXTYP{EQU{0{{{PTR TO ROUTINE B$EXL TO LOAD EXPR
{EXSTM{EQU{CDSTM{{{STORES STMNT NO. DURING EVALUATION
{EXLEN{EQU{EXSTM+1{{{LENGTH OF EXBLK IN BYTES
{EXFLC{EQU{EXLEN+1{{{FAILURE CODE (=O$FEX)
{EXCOD{EQU{EXFLC+1{{{PSEUDO-CODE FOR EXPRESSION
{EXSI${EQU{EXCOD{{{NUMBER OF STANDARD FIELDS IN EXBLK
*
* THERE ARE TWO CASES FOR EXCOD DEPENDING ON WHETHER THE
* EXPRESSION CAN BE EVALUATED BY NAME (SEE DESCRIPTION
* OF CDBLK FOR DETAILS OF CODE FOR EXPRESSIONS).
*
* IF THE EXPRESSION CAN BE EVALUATED BY NAME WE HAVE.
*
* (CODE FOR EXPR BY NAME)
* =O$RNM
*
* IF THE EXPRESSION CAN ONLY BE EVALUATED BY VALUE.
*
* (CODE FOR EXPR BY VALUE)
* =O$RVL
{{EJC{{{{
*
* FIELD FUNCTION BLOCK (FFBLK)
*
* A FIELD FUNCTION BLOCK IS USED TO CONTROL THE SELECTION
* OF A FIELD FROM A PROGRAM DEFINED DATATYPE BLOCK.
* A CALL TO DATA CREATES AN FFBLK FOR EACH FIELD.
*
* +------------------------------------+
* I FCODE I
* +------------------------------------+
* I FARGS I
* +------------------------------------+
* I FFDFP I
* +------------------------------------+
* I FFNXT I
* +------------------------------------+
* I FFOFS I
* +------------------------------------+
*
{FFDFP{EQU{FARGS+1{{{POINTER TO ASSOCIATED DFBLK
{FFNXT{EQU{FFDFP+1{{{PTR TO NEXT FFBLK ON CHAIN OR ZERO
{FFOFS{EQU{FFNXT+1{{{OFFSET (BYTES) TO FIELD IN PDBLK
{FFSI${EQU{FFOFS+1{{{SIZE OF FFBLK IN WORDS
*
* THE FCODE FIELD POINTS TO THE ROUTINE B$FFC.
*
* FARGS ALWAYS CONTAINS ONE.
*
* FFDFP IS USED TO VERIFY THAT THE CORRECT PROGRAM DEFINED
* DATATYPE IS BEING ACCESSED BY THIS CALL.
* FFDFP IS NON-RELOC. BECAUSE DFBLK IS IN STATIC
*
* FFOFS IS USED TO SELECT THE APPROPRIATE FIELD. NOTE THAT
* IT IS AN ACTUAL OFFSET (NOT A FIELD NUMBER)
*
* FFNXT IS USED TO POINT TO THE NEXT FFBLK OF THE SAME NAME
* IN THE CASE WHERE THERE ARE SEVERAL FIELDS OF THE SAME
* NAME FOR DIFFERENT DATATYPES. ZERO MARKS THE END OF CHAIN
{{EJC{{{{
*
* INTEGER CONSTANT BLOCK (ICBLK)
*
* AN ICBLK IS CREATED FOR EVERY INTEGER REFERENCED OR
* CREATED BY A PROGRAM. NOTE HOWEVER THAT CERTAIN INTERNAL
* INTEGER VALUES ARE STORED AS ADDRESSES (E.G. THE LENGTH
* FIELD IN A STRING CONSTANT BLOCK)
*
* +------------------------------------+
* I ICGET I
* +------------------------------------+
* * ICVAL *
* +------------------------------------+
*
{ICGET{EQU{0{{{PTR TO ROUTINE B$ICL TO LOAD INT
{ICVAL{EQU{ICGET+1{{{INTEGER VALUE
{ICSI${EQU{ICVAL+CFP$I{{{SIZE OF ICBLK
*
* THE LENGTH OF THE ICVAL FIELD IS CFP$I.
{{EJC{{{{
*
* KEYWORD VARIABLE BLOCK (KVBLK)
*
* A KVBLK IS USED TO REPRESENT A KEYWORD PSEUDO-VARIABLE.
* A KVBLK IS BUILT FOR EACH KEYWORD REFERENCE (KWNAM).
*
* +------------------------------------+
* I KVTYP I
* +------------------------------------+
* I KVVAR I
* +------------------------------------+
* I KVNUM I
* +------------------------------------+
*
{KVTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$KVT
{KVVAR{EQU{KVTYP+1{{{POINTER TO DUMMY BLOCK TRBKV
{KVNUM{EQU{KVVAR+1{{{KEYWORD NUMBER
{KVSI${EQU{KVNUM+1{{{SIZE OF KVBLK
*
* THE NAME OF A KEYWORD VARIABLE IS REPRESENTED BY A
* BASE POINTER TO THE KVBLK AND AN OFFSET OF KVVAR. THE
* VALUE APPEARS TO BE TRAPPED BY THE POINTER TO TRBKV.
{{EJC{{{{
*
* NAME BLOCK (NMBLK)
*
* A NAME BLOCK IS USED WHEREVER A NAME MUST BE STORED AS
* A VALUE FOLLOWING USE OF THE UNARY DOT OPERATOR.
*
* +------------------------------------+
* I NMTYP I
* +------------------------------------+
* I NMBAS I
* +------------------------------------+
* I NMOFS I
* +------------------------------------+
*
{NMTYP{EQU{0{{{PTR TO ROUTINE B$NML TO LOAD NAME
{NMBAS{EQU{NMTYP+1{{{BASE POINTER FOR VARIABLE
{NMOFS{EQU{NMBAS+1{{{OFFSET FOR VARIABLE
{NMSI${EQU{NMOFS+1{{{SIZE OF NMBLK
*
* THE ACTUAL FIELD REPRESENTING THE CONTENTS OF THE NAME
* IS FOUND NMOFS BYTES PAST THE ADDRESS IN NMBAS.
*
* THE NAME IS SPLIT INTO BASE AND OFFSET FORM TO AVOID
* CREATION OF A POINTER INTO THE MIDDLE OF A BLOCK WHICH
* COULD NOT BE HANDLED PROPERLY BY THE GARBAGE COLLECTOR.
*
* A NAME MAY BE BUILT FOR ANY VARIABLE (SEE SECTION ON
* REPRESENTATIONS OF VARIABLES) THIS INCLUDES THE
* CASES OF PSEUDO-VARIABLES.
{{EJC{{{{
*
* PATTERN BLOCK, NO PARAMETERS (P0BLK)
*
* A P0BLK IS USED TO REPRESENT PATTERN NODES WHICH DO
* NOT REQUIRE THE USE OF ANY PARAMETER VALUES.
*
* +------------------------------------+
* I PCODE I
* +------------------------------------+
* I PTHEN I
* +------------------------------------+
*
{PCODE{EQU{0{{{PTR TO MATCH ROUTINE (P$XXX)
{PTHEN{EQU{PCODE+1{{{POINTER TO SUBSEQUENT NODE
{PASI${EQU{PTHEN+1{{{SIZE OF P0BLK
*
* PTHEN POINTS TO THE PATTERN BLOCK FOR THE SUBSEQUENT
* NODE TO BE MATCHED. THIS IS A POINTER TO THE PATTERN
* BLOCK NDNTH IF THERE IS NO SUBSEQUENT (END OF PATTERN)
*
* PCODE IS A POINTER TO THE MATCH ROUTINE FOR THE NODE.
{{EJC{{{{
*
* PATTERN BLOCK (ONE PARAMETER)
*
* A P1BLK IS USED TO REPRESENT PATTERN NODES WHICH
* REQUIRE ONE PARAMETER VALUE.
*
* +------------------------------------+
* I PCODE I
* +------------------------------------+
* I PTHEN I
* +------------------------------------+
* I PARM1 I
* +------------------------------------+
*
{PARM1{EQU{PTHEN+1{{{FIRST PARAMETER VALUE
{PBSI${EQU{PARM1+1{{{SIZE OF P1BLK IN WORDS
*
* SEE P0BLK FOR DEFINITIONS OF PCODE, PTHEN
*
* PARM1 CONTAINS A PARAMETER VALUE USED IN MATCHING THE
* NODE. FOR EXAMPLE, IN A LEN PATTERN, IT IS THE INTEGER
* ARGUMENT TO LEN. THE DETAILS OF THE USE OF THE PARAMETER
* FIELD ARE INCLUDED IN THE DESCRIPTION OF THE INDIVIDUAL
* MATCH ROUTINES. PARM1 IS ALWAYS AN ADDRESS POINTER WHICH
* IS PROCESSED BY THE GARBAGE COLLECTOR.
{{EJC{{{{
*
* PATTERN BLOCK (TWO PARAMETERS)
*
* A P2BLK IS USED TO REPRESENT PATTERN NODES WHICH
* REQUIRE TWO PARAMETER VALUES.
*
* +------------------------------------+
* I PCODE I
* +------------------------------------+
* I PTHEN I
* +------------------------------------+
* I PARM1 I
* +------------------------------------+
* I PARM2 I
* +------------------------------------+
*
{PARM2{EQU{PARM1+1{{{SECOND PARAMETER VALUE
{PCSI${EQU{PARM2+1{{{SIZE OF P2BLK IN WORDS
*
* SEE P1BLK FOR DEFINITIONS OF PCODE, PTHEN, PARM1
*
* PARM2 IS A PARAMETER WHICH PERFORMS THE SAME SORT OF
* FUNCTION AS PARM1 (SEE DESCRIPTION OF P1BLK).
*
* PARM2 IS A NON-RELOCATABLE FIELD AND IS NOT
* PROCESSED BY THE GARBAGE COLLECTOR. ACCORDINGLY, IT MAY
* NOT CONTAIN A POINTER TO A BLOCK IN DYNAMIC MEMORY.
{{EJC{{{{
*
* PROGRAM-DEFINED DATATYPE BLOCK
*
* A PDBLK REPRESENTS THE DATA ITEM FORMED BY A CALL TO A
* DATATYPE FUNCTION AS DEFINED BY THE SYSTEM FUNCTION DATA.
*
* +------------------------------------+
* I PDTYP I
* +------------------------------------+
* I IDVAL I
* +------------------------------------+
* I PDDFP I
* +------------------------------------+
* / /
* / PDFLD /
* / /
* +------------------------------------+
*
{PDTYP{EQU{0{{{PTR TO DUMMY ROUTINE B$PDT
{PDDFP{EQU{IDVAL+1{{{PTR TO ASSOCIATED DFBLK
{PDFLD{EQU{PDDFP+1{{{START OF FIELD VALUE POINTERS
{PDFOF{EQU{DFFLD-PDFLD{{{DIFFERENCE IN OFFSET TO FIELD PTRS
{PDSI${EQU{PDFLD{{{SIZE OF STANDARD FIELDS IN PDBLK
{PDDFS{EQU{DFSI$-PDSI${{{DIFFERENCE IN DFBLK, PDBLK SIZES
*
* THE PDDFP POINTER MAY BE USED TO DETERMINE THE DATATYPE
* AND THE NAMES OF THE FIELDS IF REQUIRED. THE DFBLK ALSO
* CONTAINS THE LENGTH OF THE PDBLK IN BYTES (FIELD DFPDL).
* PDDFP IS NON-RELOC. BECAUSE DFBLK IS IN STATIC
*
* PDFLD VALUES ARE STORED IN ORDER FROM LEFT TO RIGHT.
* THEY CONTAIN VALUES OR POINTERS TO TRBLK CHAINS.
{{EJC{{{{
*
* PROGRAM DEFINED FUNCTION BLOCK (PFBLK)
*
* A PFBLK IS CREATED FOR EACH CALL TO THE DEFINE FUNCTION
* AND A POINTER TO THE PFBLK PLACED IN THE PROPER VRBLK.
*
* +------------------------------------+
* I FCODE I
* +------------------------------------+
* I FARGS I
* +------------------------------------+
* I PFLEN I
* +------------------------------------+
* I PFVBL I
* +------------------------------------+
* I PFNLO I
* +------------------------------------+
* I PFCOD I
* +------------------------------------+
* I PFCTR I
* +------------------------------------+
* I PFRTR I
* +------------------------------------+
* / /
* / PFARG /
* / /
* +------------------------------------+
*
{PFLEN{EQU{FARGS+1{{{LENGTH OF PFBLK IN BYTES
{PFVBL{EQU{PFLEN+1{{{POINTER TO VRBLK FOR FUNCTION NAME
{PFNLO{EQU{PFVBL+1{{{NUMBER OF LOCALS
{PFCOD{EQU{PFNLO+1{{{PTR TO CDBLK FOR FIRST STATEMENT
{PFCTR{EQU{PFCOD+1{{{TRBLK PTR IF CALL TRACED ELSE 0
{PFRTR{EQU{PFCTR+1{{{TRBLK PTR IF RETURN TRACED ELSE 0
{PFARG{EQU{PFRTR+1{{{VRBLK PTRS FOR ARGUMENTS AND LOCALS
{PFAGB{EQU{PFARG-1{{{OFFSET BEHIND PFARG FOR ARG, LOCAL
{PFSI${EQU{PFARG{{{NUMBER OF STANDARD FIELDS IN PFBLK
*
* THE FCODE FIELD POINTS TO THE ROUTINE B$PFC.
*
* PFARG IS STORED IN THE FOLLOWING ORDER.
*
* ARGUMENTS (LEFT TO RIGHT)
* LOCALS (LEFT TO RIGHT)
{{EJC{{{{
*
* REAL CONSTANT BLOCK (RCBLK)
*
* AN RCBLK IS CREATED FOR EVERY REAL REFERENCED OR
* CREATED BY A PROGRAM.
*
* +------------------------------------+
* I RCGET I
* +------------------------------------+
* * RCVAL *
* +------------------------------------+
*
{RCGET{EQU{0{{{PTR TO ROUTINE B$RCL TO LOAD REAL
{RCVAL{EQU{RCGET+1{{{REAL VALUE
{RCSI${EQU{RCVAL+CFP$R{{{SIZE OF RCBLK
*
* THE LENGTH OF THE RCVAL FIELD IS CFP$R.
{{EJC{{{{
*
* STRING CONSTANT BLOCK (SCBLK)
*
* AN SCBLK IS BUILT FOR EVERY STRING REFERENCED OR CREATED
* BY A PROGRAM.
*
* +------------------------------------+
* I SCGET I
* +------------------------------------+
* I SCLEN I
* +------------------------------------+
* / /
* / SCHAR /
* / /
* +------------------------------------+
*
{SCGET{EQU{0{{{PTR TO ROUTINE B$SCL TO LOAD STRING
{SCLEN{EQU{SCGET+1{{{LENGTH OF STRING IN CHARACTERS
{SCHAR{EQU{SCLEN+1{{{CHARACTERS OF STRING
{SCSI${EQU{SCHAR{{{SIZE OF STANDARD FIELDS IN SCBLK
*
* THE CHARACTERS OF THE STRING ARE STORED LEFT JUSTIFIED.
* THE FINAL WORD IS PADDED ON THE RIGHT WITH ZEROS.
* (I.E. THE CHARACTER WHOSE INTERNAL CODE IS ZERO).
*
* THE VALUE OF SCLEN MAY NOT EXCEED MXLEN. THIS ENSURES
* THAT CHARACTER OFFSETS (E.G. THE PATTERN MATCH CURSOR)
* CAN BE CORRECTLY PROCESSED BY THE GARBAGE COLLECTOR.
*
* NOTE THAT THE OFFSET TO THE CHARACTERS OF THE STRING
* IS GIVEN IN BYTES BY CFP$F AND THAT THIS VALUE IS
* AUTOMATICALLY ALLOWED FOR IN PLC, PSC.
* NOTE THAT FOR A SPITBOL SCBLK, THE VALUE OF CFP$F
* IS GIVEN BY CFP$B*SCHAR.
{{EJC{{{{
*
* SIMPLE EXPRESSION BLOCK (SEBLK)
*
* AN SEBLK IS USED TO REPRESENT AN EXPRESSION OF THE FORM
* *(NATURAL VARIABLE). ALL OTHER EXPRESSIONS ARE EXBLKS.
*
* +------------------------------------+
* I SETYP I
* +------------------------------------+
* I SEVAR I
* +------------------------------------+
*
{SETYP{EQU{0{{{PTR TO ROUTINE B$SEL TO LOAD EXPR
{SEVAR{EQU{SETYP+1{{{PTR TO VRBLK FOR VARIABLE
{SESI${EQU{SEVAR+1{{{LENGTH OF SEBLK IN WORDS
{{EJC{{{{
*
* STANDARD VARIABLE BLOCK (SVBLK)
*
* AN SVBLK IS ASSEMBLED IN THE CONSTANT SECTION FOR EACH
* VARIABLE WHICH SATISFIES ONE OF THE FOLLOWING CONDITIONS.
*
* 1) IT IS THE NAME OF A SYSTEM FUNCTION
* 2) IT HAS AN INITIAL VALUE
* 3) IT HAS A KEYWORD ASSOCIATION
* 4) IT HAS A STANDARD I/O ASSOCIATION
* 6) IT HAS A STANDARD LABEL ASSOCIATION
*
* IF VRBLKS ARE CONSTRUCTED FOR ANY OF THESE VARIABLES,
* THEN THE VRSVP FIELD POINTS TO THE SVBLK (SEE VRBLK)
*
* +------------------------------------+
* I SVBIT I
* +------------------------------------+
* I SVLEN I
* +------------------------------------+
* I SVCHS I
* +------------------------------------+
* I SVKNM I
* +------------------------------------+
* I SVFNC I
* +------------------------------------+
* I SVNAR I
* +------------------------------------+
* I SVLBL I
* +------------------------------------+
* I SVVAL I
* +------------------------------------+
{{EJC{{{{
*
* STANDARD VARIABLE BLOCK (CONTINUED)
*
{SVBIT{EQU{0{{{BIT STRING INDICATING ATTRIBUTES
{SVLEN{EQU{1{{{(=SCLEN) LENGTH OF NAME IN CHARS
{SVCHS{EQU{2{{{(=SCHAR) CHARACTERS OF NAME
{SVSI${EQU{2{{{NUMBER OF STANDARD FIELDS IN SVBLK
{SVPRE{EQU{1{{{SET IF PREEVALUATION PERMITTED
{SVFFC{EQU{SVPRE+SVPRE{{{SET ON IF FAST CALL PERMITTED
{SVCKW{EQU{SVFFC+SVFFC{{{SET ON IF KEYWORD VALUE CONSTANT
{SVPRD{EQU{SVCKW+SVCKW{{{SET ON IF PREDICATE FUNCTION
{SVNBT{EQU{4{{{NUMBER OF BITS TO RIGHT OF SVKNM
{SVKNM{EQU{SVPRD+SVPRD{{{SET ON IF KEYWORD ASSOCIATION
{SVFNC{EQU{SVKNM+SVKNM{{{SET ON IF SYSTEM FUNCTION
{SVNAR{EQU{SVFNC+SVFNC{{{SET ON IF SYSTEM FUNCTION
{SVLBL{EQU{SVNAR+SVNAR{{{SET ON IF SYSTEM LABEL
{SVVAL{EQU{SVLBL+SVLBL{{{SET ON IF PREDEFINED VALUE
*
* NOTE THAT THE LAST FIVE BITS CORRESPOND IN ORDER
* TO THE FIELDS WHICH ARE PRESENT (SEE PROCEDURE GTNVR).
*
* THE FOLLOWING DEFINITIONS ARE USED IN THE SVBLK TABLE
*
{SVFNF{EQU{SVFNC+SVNAR{{{FUNCTION WITH NO FAST CALL
{SVFNN{EQU{SVFNF+SVFFC{{{FUNCTION WITH FAST CALL, NO PREEVAL
{SVFNP{EQU{SVFNN+SVPRE{{{FUNCTION ALLOWING PREEVALUATION
{SVFPR{EQU{SVFNN+SVPRD{{{PREDICATE FUNCTION
{SVFNK{EQU{SVFNN+SVKNM{{{NO PREEVAL FUNC + KEYWORD
{SVKWV{EQU{SVKNM+SVVAL{{{KEYWORD + VALUE
{SVKWC{EQU{SVCKW+SVKNM{{{KEYWORD WITH CONSTANT VALUE
{SVKVC{EQU{SVKWV+SVCKW{{{CONSTANT KEYWORD + VALUE
{SVKVL{EQU{SVKVC+SVLBL{{{CONSTANT KEYWORD + VALUE + LABEL
{SVFPK{EQU{SVFNP+SVKVC{{{PREEVAL FCN + CONST KEYWD + VAL
*
* THE SVPRE BIT ALLOWS THE COMPILER TO PREEVALUATE A CALL
* TO THE ASSOCIATED SYSTEM FUNCTION IF ALL THE ARGUMENTS
* ARE THEMSELVES CONSTANTS. FUNCTIONS IN THIS CATEGORY
* MUST HAVE NO SIDE EFFECTS AND MUST NEVER CAUSE FAILURE.
* THE CALL MAY GENERATE AN ERROR CONDITION.
*
* THE SVFFC BIT ALLOWS THE COMPILER TO GENERATE THE SPECIAL
* FAST CALL AFTER ADJUSTING THE NUMBER OF ARGUMENTS. ONLY
* THE ITEM AND APPLY FUNCTIONS FALL OUTSIDE THIS CATEGORY.
*
* THE SVCKW BIT IS SET IF THE ASSOCIATED KEYWORD VALUE IS
* A CONSTANT, THUS ALLOWING PREEVALUATION FOR A VALUE CALL.
*
* THE SVPRD BIT IS SET ON FOR ALL PREDICATE FUNCTIONS TO
* ENABLE THE SPECIAL CONCATENATION CODE OPTIMIZATION.
{{EJC{{{{
*
* SVBLK (CONTINUED)
*
* SVKNM KEYWORD NUMBER
*
* SVKNM IS PRESENT ONLY FOR A STANDARD KEYWORD ASSOC.
* IT CONTAINS A KEYWORD NUMBER AS DEFINED BY THE
* KEYWORD NUMBER TABLE GIVEN LATER ON.
*
* SVFNC SYSTEM FUNCTION POINTER
*
* SVFNC IS PRESENT ONLY FOR A SYSTEM FUNCTION ASSOC.
* IT IS A POINTER TO THE ACTUAL CODE FOR THE SYSTEM
* FUNCTION. THE GENERATED CODE FOR A FAST CALL IS A
* POINTER TO THE SVFNC FIELD OF THE SVBLK FOR THE
* FUNCTION. THE VRFNC FIELD OF THE VRBLK POINTS TO
* THIS SAME FIELD, IN WHICH CASE, IT SERVES AS THE
* FCODE FIELD FOR THE FUNCTION CALL.
*
* SVNAR NUMBER OF FUNCTION ARGUMENTS
*
* SVNAR IS PRESENT ONLY FOR A SYSTEM FUNCTION ASSOC.
* IT IS THE NUMBER OF ARGUMENTS REQUIRED FOR A CALL
* TO THE SYSTEM FUNCTION. THE COMPILER USES THIS
* VALUE TO ADJUST THE NUMBER OF ARGUMENTS IN A FAST
* CALL AND IN THE CASE OF A FUNCTION CALLED THROUGH
* THE VRFNC FIELD OF THE VRBLK, THE SVNAR FIELD
* SERVES AS THE FARGS FIELD FOR O$FNC. A SPECIAL
* CASE OCCURS IF THIS VALUE IS SET TO 999. THIS IS
* USED TO INDICATE THAT THE FUNCTION HAS A VARIABLE
* NUMBER OF ARGUMENTS AND CAUSES O$FNC TO PASS CONTROL
* WITHOUT ADJUSTING THE ARGUMENT COUNT. THE ONLY
* PREDEFINED FUNCTIONS USING THIS ARE APPLY AND ITEM.
*
* SVLBL SYSTEM LABEL POINTER
*
* SVLBL IS PRESENT ONLY FOR A STANDARD LABEL ASSOC.
* IT IS A POINTER TO A SYSTEM LABEL ROUTINE (L$XXX).
* THE VRLBL FIELD OF THE CORRESPONDING VRBLK POINTS TO
* THE SVLBL FIELD OF THE SVBLK.
*
* SVVAL SYSTEM VALUE POINTER
*
* SVVAL IS PRESENT ONLY FOR A STANDARD VALUE.
* IT IS A POINTER TO THE PATTERN NODE (NDXXX) WHICH
* IS THE STANDARD INITIAL VALUE OF THE VARIABLE.
* THIS VALUE IS COPIED TO THE VRVAL FIELD OF THE VRBLK
{{EJC{{{{
*
* SVBLK (CONTINUED)
*
* KEYWORD NUMBER TABLE
*
* THE FOLLOWING TABLE GIVES SYMBOLIC NAMES FOR KEYWORD
* NUMBERS. THESE VALUES ARE STORED IN THE SVKNM FIELD OF
* SVBLKS AND IN THE KVNUM FIELD OF KVBLKS. SEE ALSO
* PROCEDURES ASIGN, ACESS AND KWNAM.
*
* UNPROTECTED KEYWORDS WITH ONE WORD INTEGER VALUES
*
{K$ABE{EQU{0{{{ABEND
{K$ANC{EQU{K$ABE+CFP$B{{{ANCHOR
{K$CAS{EQU{K$ANC+CFP$B{{{CASE
{K$COD{EQU{K$CAS+CFP$B{{{CODE
{K$DMP{EQU{K$COD+CFP$B{{{DUMP
{K$ERL{EQU{K$DMP+CFP$B{{{ERRLIMIT
{K$ERT{EQU{K$ERL+CFP$B{{{ERRTYPE
{K$FTR{EQU{K$ERT+CFP$B{{{FTRACE
{K$INP{EQU{K$FTR+CFP$B{{{INPUT
{K$MXL{EQU{K$INP+CFP$B{{{MAXLENGTH
{K$OUP{EQU{K$MXL+CFP$B{{{OUTPUT
{K$PFL{EQU{K$OUP+CFP$B{{{PROFILE
{K$TRA{EQU{K$PFL+CFP$B{{{TRACE
{K$TRM{EQU{K$TRA+CFP$B{{{TRIM
*
* PROTECTED KEYWORDS WITH ONE WORD INTEGER VALUES
*
{K$FNC{EQU{K$TRM+CFP$B{{{FNCLEVEL
{K$LST{EQU{K$FNC+CFP$B{{{LASTNO
{K$STN{EQU{K$LST+CFP$B{{{STNO
*
* KEYWORDS WITH CONSTANT PATTERN VALUES
*
{K$ABO{EQU{K$STN+CFP$B{{{ABORT
{K$ARB{EQU{K$ABO+PASI${{{ARB
{K$BAL{EQU{K$ARB+PASI${{{BAL
{K$FAL{EQU{K$BAL+PASI${{{FAIL
{K$FEN{EQU{K$FAL+PASI${{{FENCE
{K$REM{EQU{K$FEN+PASI${{{REM
{K$SUC{EQU{K$REM+PASI${{{SUCCEED
{{EJC{{{{
*
* KEYWORD NUMBER TABLE (CONTINUED)
*
* SPECIAL KEYWORDS
*
{K$ALP{EQU{K$SUC+1{{{ALPHABET
{K$RTN{EQU{K$ALP+1{{{RTNTYPE
{K$STC{EQU{K$RTN+1{{{STCOUNT
{K$ETX{EQU{K$STC+1{{{ERRTEXT
{K$STL{EQU{K$ETX+1{{{STLIMIT
*
* RELATIVE OFFSETS OF SPECIAL KEYWORDS
*
{K$$AL{EQU{K$ALP-K$ALP{{{ALPHABET
{K$$RT{EQU{K$RTN-K$ALP{{{RTNTYPE
{K$$SC{EQU{K$STC-K$ALP{{{STCOUNT
{K$$ET{EQU{K$ETX-K$ALP{{{ERRTEXT
{K$$SL{EQU{K$STL-K$ALP{{{STLIMIT
*
* SYMBOLS USED IN ASIGN AND ACESS PROCEDURES
*
{K$P$${EQU{K$FNC{{{FIRST PROTECTED KEYWORD
{K$V$${EQU{K$ABO{{{FIRST KEYWORD WITH CONSTANT VALUE
{K$S$${EQU{K$ALP{{{FIRST KEYWORD WITH SPECIAL ACESS
{{EJC{{{{
*
* FORMAT OF A TABLE BLOCK (TBBLK)
*
* A TABLE BLOCK IS USED TO REPRESENT A TABLE VALUE.
* IT IS BUILT BY A CALL TO THE TABLE OR CONVERT FUNCTIONS.
*
* +------------------------------------+
* I TBTYP I
* +------------------------------------+
* I IDVAL I
* +------------------------------------+
* I TBLEN I
* +------------------------------------+
* +------------------------------------+
* I TBINV I
* +------------------------------------+
* / /
* / TBBUK /
* / /
* +------------------------------------+
*
{TBTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$TBT
{TBLEN{EQU{OFFS2{{{LENGTH OF TBBLK IN BYTES
{TBINV{EQU{OFFS3{{{DEFAULT INITIAL LOOKUP VALUE
{TBBUK{EQU{TBINV+1{{{START OF HASH BUCKET POINTERS
{TBSI${EQU{TBBUK{{{SIZE OF STANDARD FIELDS IN TBBLK
{TBNBK{EQU{11{{{DEFAULT NO. OF BUCKETS
*
* THE TABLE BLOCK IS A HASH TABLE WHICH POINTS TO CHAINS
* OF TABLE ELEMENT BLOCKS REPRESENTING THE ELEMENTS
* IN THE TABLE WHICH HASH INTO THE SAME BUCKET.
*
* TBBUK ENTRIES EITHER POINT TO THE FIRST TEBLK ON THE
* CHAIN OR THEY POINT TO THE TBBLK ITSELF TO INDICATE THE
* END OF THE CHAIN.
{{EJC{{{{
*
* TABLE ELEMENT BLOCK (TEBLK)
*
* A TABLE ELEMENT IS USED TO REPRESENT A SINGLE ENTRY IN
* A TABLE (SEE DESCRIPTION OF TBBLK FORMAT FOR HASH TABLE)
*
* +------------------------------------+
* I TETYP I
* +------------------------------------+
* I TESUB I
* +------------------------------------+
* I TEVAL I
* +------------------------------------+
* I TENXT I
* +------------------------------------+
*
{TETYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$TET
{TESUB{EQU{TETYP+1{{{SUBSCRIPT VALUE
{TEVAL{EQU{TESUB+1{{{(=VRVAL) TABLE ELEMENT VALUE
{TENXT{EQU{TEVAL+1{{{LINK TO NEXT TEBLK
* SEE S$CNV WHERE RELATION IS ASSUMED WITH TENXT AND TBBUK
{TESI${EQU{TENXT+1{{{SIZE OF TEBLK IN WORDS
*
* TENXT POINTS TO THE NEXT TEBLK ON THE HASH CHAIN FROM THE
* TBBUK CHAIN FOR THIS HASH INDEX. AT THE END OF THE CHAIN,
* TENXT POINTS BACK TO THE START OF THE TBBLK.
*
* TEVAL CONTAINS A DATA POINTER OR A TRBLK POINTER.
*
* TESUB CONTAINS A DATA POINTER.
{{EJC{{{{
*
* TRAP BLOCK (TRBLK)
*
* A TRAP BLOCK IS USED TO REPRESENT A TRACE OR INPUT OR
* OUTPUT ASSOCIATION IN RESPONSE TO A CALL TO THE TRACE
* INPUT OR OUTPUT SYSTEM FUNCTIONS. SEE BELOW FOR DETAILS
*
* +------------------------------------+
* I TRIDN I
* +------------------------------------+
* I TRTYP I
* +------------------------------------+
* I TRVAL OR TRLBL OR TRNXT OR TRKVR I
* +------------------------------------+
* I TRTAG OR TRTER OR TRTRF I
* +------------------------------------+
* I TRFNC OR TRFPT I
* +------------------------------------+
*
{TRIDN{EQU{0{{{POINTER TO DUMMY ROUTINE B$TRT
{TRTYP{EQU{TRIDN+1{{{TRAP TYPE CODE
{TRVAL{EQU{TRTYP+1{{{VALUE OF TRAPPED VARIABLE (=VRVAL)
{TRNXT{EQU{TRVAL{{{PTR TO NEXT TRBLK ON TRBLK CHAIN
{TRLBL{EQU{TRVAL{{{PTR TO ACTUAL LABEL (TRACED LABEL)
{TRKVR{EQU{TRVAL{{{VRBLK POINTER FOR KEYWORD TRACE
{TRTAG{EQU{TRVAL+1{{{TRACE TAG
{TRTER{EQU{TRTAG{{{PTR TO TERMINAL VRBLK OR NULL
{TRTRF{EQU{TRTAG{{{PTR TO TRBLK HOLDING FCBLK PTR
{TRFNC{EQU{TRTAG+1{{{TRACE FUNCTION VRBLK (ZERO IF NONE)
{TRFPT{EQU{TRFNC{{{FCBLK PTR FOR SYSIO
{TRSI${EQU{TRFNC+1{{{NUMBER OF WORDS IN TRBLK
*
{TRTIN{EQU{0{{{TRACE TYPE FOR INPUT ASSOCIATION
{TRTAC{EQU{TRTIN+1{{{TRACE TYPE FOR ACCESS TRACE
{TRTVL{EQU{TRTAC+1{{{TRACE TYPE FOR VALUE TRACE
{TRTOU{EQU{TRTVL+1{{{TRACE TYPE FOR OUTPUT ASSOCIATION
{TRTFC{EQU{TRTOU+1{{{TRACE TYPE FOR FCBLK IDENTIFICATION
{{EJC{{{{
*
* TRAP BLOCK (CONTINUED)
*
* VARIABLE INPUT ASSOCIATION
*
* THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
* INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE
* OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS
* CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK.
*
* TRTYP IS SET TO TRTIN
* TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL
* TRTER IS A POINTER TO SVBLK IF ASSOCIATION IS
* FOR INPUT, TERMINAL, ELSE IT IS NULL.
* TRTRF POINTS TO THE TRAP BLOCK WHICH IN TURN POINTS
* TO AN FCBLK USED FOR I/O ASSOCIATION.
* TRFPT IS THE FCBLK PTR RETURNED BY SYSIO.
*
* VARIABLE ACCESS TRACE ASSOCIATION
*
* THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
* INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE
* OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS
* CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK.
*
* TRTYP IS SET TO TRTAC
* TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL
* TRTAG IS THE TRACE TAG (0 IF NONE)
* TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
*
* VARIABLE VALUE TRACE ASSOCIATION
*
* THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
* INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE
* OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS
* CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK.
*
* TRTYP IS SET TO TRTVL
* TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL
* TRTAG IS THE TRACE TAG (0 IF NONE)
* TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
{{EJC{{{{
* TRAP BLOCK (CONTINUED)
*
* VARIABLE OUTPUT ASSOCIATION
*
* THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
* INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE
* OF A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS
* CONTAIN =B$VRA AND =B$VRV TO ACTIVATE THE CHECK.
*
* TRTYP IS SET TO TRTOU
* TRNXT POINTS TO NEXT TRBLK OR TRVAL HAS VARIABLE VAL
* TRTER IS A POINTER TO SVBLK IF ASSOCIATION IS
* FOR OUTPUT, TERMINAL, ELSE IT IS NULL.
* TRTRF POINTS TO THE TRAP BLOCK WHICH IN TURN POINTS
* TO AN FCBLK USED FOR I/O ASSOCIATION.
* TRFPT IS THE FCBLK PTR RETURNED BY SYSIO.
*
* FUNCTION CALL TRACE
*
* THE PFCTR FIELD OF THE CORRESPONDING PFBLK IS SET
* TO POINT TO A TRBLK.
*
* TRTYP IS SET TO TRTIN
* TRNXT IS ZERO
* TRTAG IS THE TRACE TAG (0 IF NONE)
* TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
*
* FUNCTION RETURN TRACE
*
* THE PFRTR FIELD OF THE CORRESPONDING PFBLK IS SET
* TO POINT TO A TRBLK
*
* TRTYP IS SET TO TRTIN
* TRNXT IS ZERO
* TRTAG IS THE TRACE TAG (0 IF NONE)
* TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
*
* LABEL TRACE
*
* THE VRLBL OF THE VRBLK FOR THE LABEL IS
* CHANGED TO POINT TO A TRBLK AND THE VRTRA FIELD IS
* SET TO B$VRT TO ACTIVATE THE CHECK.
*
* TRTYP IS SET TO TRTIN
* TRLBL POINTS TO THE ACTUAL LABEL (CDBLK) VALUE
* TRTAG IS THE TRACE TAG (0 IF NONE)
* TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
{{EJC{{{{
*
* TRAP BLOCK (CONTINUED)
*
* KEYWORD TRACE
*
* KEYWORDS WHICH CAN BE TRACED POSSESS A UNIQUE
* LOCATION WHICH IS ZERO IF THERE IS NO TRACE AND
* POINTS TO A TRBLK IF THERE IS A TRACE. THE LOCATIONS
* ARE AS FOLLOWS.
*
* R$ERT ERRTYPE
* R$FNC FNCLEVEL
* R$STC STCOUNT
*
* THE FORMAT OF THE TRBLK IS AS FOLLOWS.
*
* TRTYP IS SET TO TRTIN
* TRKVR IS A POINTER TO THE VRBLK FOR THE KEYWORD
* TRTAG IS THE TRACE TAG (0 IF NONE)
* TRFNC IS THE TRACE FUNCTION VRBLK PTR (0 IF NONE)
*
* INPUT/OUTPUT FILE ARG1 TRAP BLOCK
*
* THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
* INSTEAD OF CONTAINING THE DATA VALUE. IN THE CASE OF
* A NATURAL VARIABLE, THE VRGET AND VRSTO FIELDS
* CONTAIN =B$VRA AND =B$VRV. THIS TRAP BLOCK IS USED
* TO HOLD A POINTER TO THE FCBLK WHICH AN
* IMPLEMENTATION MAY REQUEST TO HOLD INFORMATION
* ABOUT A FILE.
*
* TRTYP IS SET TO TRTFC
* TRNEXT POINTS TO NEXT TRBLK OR TRVAL IS VARIABLE VAL
* TRFNM IS 0
* TRFPT IS THE FCBLK POINTER.
*
* NOTE THAT WHEN MULTIPLE TRAPS ARE SET ON A VARIABLE
* THE ORDER IS IN ASCENDING VALUE OF TRTYP FIELD.
*
* INPUT ASSOCIATION (IF PRESENT)
* ACCESS TRACE (IF PRESENT)
* VALUE TRACE (IF PRESENT)
* OUTPUT ASSOCIATION (IF PRESENT)
*
* THE ACTUAL VALUE OF THE VARIABLE IS STORED IN THE TRVAL
* FIELD OF THE LAST TRBLK ON THE CHAIN.
*
* THIS IMPLEMENTATION DOES NOT PERMIT TRACE OR I/O
* ASSOCIATIONS TO ANY OF THE PSEUDO-VARIABLES.
{{EJC{{{{
*
* VECTOR BLOCK (VCBLK)
*
* A VCBLK IS USED TO REPRESENT AN ARRAY VALUE WHICH HAS
* ONE DIMENSION WHOSE LOWER BOUND IS ONE. ALL OTHER ARRAYS
* ARE REPRESENTED BY ARBLKS. A VCBLK IS CREATED BY THE
* SYSTEM FUNCTION ARRAY (S$ARR) WHEN PASSED AN INTEGER ARG.
*
* +------------------------------------+
* I VCTYP I
* +------------------------------------+
* I IDVAL I
* +------------------------------------+
* I VCLEN I
* +------------------------------------+
* I VCVLS I
* +------------------------------------+
*
{VCTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$VCT
{VCLEN{EQU{OFFS2{{{LENGTH OF VCBLK IN BYTES
{VCVLS{EQU{OFFS3{{{START OF VECTOR VALUES
{VCSI${EQU{VCVLS{{{SIZE OF STANDARD FIELDS IN VCBLK
{VCVLB{EQU{VCVLS-1{{{OFFSET ONE WORD BEHIND VCVLS
{VCTBD{EQU{TBSI$-VCSI${{{DIFFERENCE IN SIZES - SEE PRTVL
*
* VCVLS ARE EITHER DATA POINTERS OR TRBLK POINTERS
*
* THE DIMENSION CAN BE DEDUCED FROM VCLEN.
{{EJC{{{{
*
* VARIABLE BLOCK (VRBLK)
*
* A VARIABLE BLOCK IS BUILT IN THE STATIC MEMORY AREA
* FOR EVERY VARIABLE REFERENCED OR CREATED BY A PROGRAM.
*
* NOTE THAT SINCE THESE BLOCKS ONLY OCCUR IN THE STATIC
* REGION, IT IS PERMISSIBLE TO POINT TO ANY WORD IN
* THE BLOCK AND THIS IS USED TO PROVIDE THREE DISTINCT
* ACCESS POINTS FROM THE GENERATED CODE AS FOLLOWS.
*
* 1) POINT TO VRGET (FIRST WORD OF VRBLK) TO LOAD THE
* VALUE OF THE VARIABLE ONTO THE MAIN STACK.
*
* 2) POINT TO VRSTO (SECOND WORD OF VRBLK) TO STORE THE
* TOP STACK ELEMENT AS THE VALUE OF THE VARIABLE.
*
* 3) POINT TO VRTRA (FOURTH WORD OF VRBLK) TO JUMP TO
* THE LABEL ASSOCIATED WITH THE VARIABLE NAME.
*
* +------------------------------------+
* I VRGET I
* +------------------------------------+
* I VRSTO I
* +------------------------------------+
* I VRVAL I
* +------------------------------------+
* I VRTRA I
* +------------------------------------+
* I VRLBL I
* +------------------------------------+
* I VRFNC I
* +------------------------------------+
* I VRNXT I
* +------------------------------------+
* I VRLEN I
* +------------------------------------+
* / /
* / VRCHS = VRSVP /
* / /
* +------------------------------------+
{{EJC{{{{
*
* VARIABLE BLOCK (CONTINUED)
*
{VRGET{EQU{0{{{POINTER TO ROUTINE TO LOAD VALUE
{VRSTO{EQU{VRGET+1{{{POINTER TO ROUTINE TO STORE VALUE
{VRVAL{EQU{VRSTO+1{{{VARIABLE VALUE
{VRVLO{EQU{VRVAL-VRSTO{{{OFFSET TO VALUE FROM STORE FIELD
{VRTRA{EQU{VRVAL+1{{{POINTER TO ROUTINE TO JUMP TO LABEL
{VRLBL{EQU{VRTRA+1{{{POINTER TO CODE FOR LABEL
{VRLBO{EQU{VRLBL-VRTRA{{{OFFSET TO LABEL FROM TRANSFER FIELD
{VRFNC{EQU{VRLBL+1{{{POINTER TO FUNCTION BLOCK
{VRNXT{EQU{VRFNC+1{{{POINTER TO NEXT VRBLK ON HASH CHAIN
{VRLEN{EQU{VRNXT+1{{{LENGTH OF NAME (OR ZERO)
{VRCHS{EQU{VRLEN+1{{{CHARACTERS OF NAME (VRLEN GT 0)
{VRSVP{EQU{VRLEN+1{{{PTR TO SVBLK (VRLEN EQ 0)
{VRSI${EQU{VRCHS+1{{{NUMBER OF STANDARD FIELDS IN VRBLK
{VRSOF{EQU{VRLEN-SCLEN{{{OFFSET TO DUMMY SCBLK FOR NAME
{VRSVO{EQU{VRSVP-VRSOF{{{PSEUDO-OFFSET TO VRSVP FIELD
*
* VRGET = B$VRL IF NOT INPUT ASSOCIATED OR ACCESS TRACED
* VRGET = B$VRA IF INPUT ASSOCIATED OR ACCESS TRACED
*
* VRSTO = B$VRS IF NOT OUTPUT ASSOCIATED OR VALUE TRACED
* VRSTO = B$VRV IF OUTPUT ASSOCIATED OR VALUE TRACED
* VRSTO = B$VRE IF VALUE IS PROTECTED PATTERN VALUE
*
* VRVAL POINTS TO THE APPROPRIATE VALUE UNLESS THE
* VARIABLE IS I/O/TRACE ASSOCIATED IN WHICH CASE, VRVAL
* POINTS TO AN APPROPRIATE TRBLK (TRAP BLOCK) CHAIN.
*
* VRTRA = B$VRG IF THE LABEL IS NOT TRACED
* VRTRA = B$VRT IF THE LABEL IS TRACED
*
* VRLBL POINTS TO A CDBLK IF THERE IS A LABEL
* VRLBL POINTS TO THE SVBLK SVLBL FIELD FOR A SYSTEM LABEL
* VRLBL POINTS TO STNDL FOR AN UNDEFINED LABEL
* VRLBL POINTS TO A TRBLK IF THE LABEL IS TRACED
*
* VRFNC POINTS TO A FFBLK FOR A FIELD FUNCTION
* VRFNC POINTS TO A DFBLK FOR A DATATYPE FUNCTION
* VRFNC POINTS TO A PFBLK FOR A PROGRAM DEFINED FUNCTION
* VRFNC POINTS TO A EFBLK FOR AN EXTERNAL LOADED FUNCTION
* VRFNC POINTS TO SVFNC (SVBLK) FOR A SYSTEM FUNCTION
* VRFNC POINTS TO STNDF IF THE FUNCTION IS UNDEFINED
*
* VRNXT POINTS TO THE NEXT VRBLK ON THIS CHAIN UNLESS
* THIS IS THE END OF THE CHAIN IN WHICH CASE IT IS ZERO.
*
* VRLEN IS THE NAME LENGTH FOR A NON-SYSTEM VARIABLE.
* VRLEN IS ZERO FOR A SYSTEM VARIABLE.
*
* VRCHS IS THE NAME (LJRZ) IF VRLEN IS NON-ZERO.
* VRSVP IS A PTR TO THE SVBLK IF VRLEN IS ZERO.
{{EJC{{{{
*
* FORMAT OF A NON-RELOCATABLE EXTERNAL BLOCK (XNBLK)
*
* AN XNBLK IS A BLOCK REPRESENTING AN UNKNOWN (EXTERNAL)
* DATA VALUE. THE BLOCK CONTAINS NO POINTERS TO OTHER
* RELOCATABLE BLOCKS. AN XNBLK IS USED BY EXTERNAL FUNCTION
* PROCESSING OR POSSIBLY FOR SYSTEM I/O ROUTINES ETC.
* THE MACRO-SYSTEM ITSELF DOES NOT USE XNBLKS.
* THIS TYPE OF BLOCK MAY BE USED AS A FILE CONTROL BLOCK.
* SEE SYSFC,SYSIN,SYSOU,S$INP,S$OUP FOR DETAILS.
*
* +------------------------------------+
* I XNTYP I
* +------------------------------------+
* I XNLEN I
* +------------------------------------+
* / /
* / XNDTA /
* / /
* +------------------------------------+
*
{XNTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$XNT
{XNLEN{EQU{XNTYP+1{{{LENGTH OF XNBLK IN BYTES
{XNDTA{EQU{XNLEN+1{{{DATA WORDS
{XNSI${EQU{XNDTA{{{SIZE OF STANDARD FIELDS IN XNBLK
*
* NOTE THAT THE TERM NON-RELOCATABLE REFERS TO THE CONTENTS
* AND NOT THE BLOCK ITSELF. AN XNBLK CAN BE MOVED AROUND IF
* IT IS BUILT IN THE DYNAMIC MEMORY AREA.
{{EJC{{{{
*
* RELOCATABLE EXTERNAL BLOCK (XRBLK)
*
* AN XRBLK IS A BLOCK REPRESENTING AN UNKNOWN (EXTERNAL)
* DATA VALUE. THE DATA AREA IN THIS BLOCK CONSISTS ONLY
* OF ADDRESS VALUES AND ANY ADDRESSES POINTING INTO THE
* DYNAMIC MEMORY AREA MUST POINT TO THE START OF OTHER
* DATA BLOCKS. SEE ALSO DESCRIPTION OF XNBLK.
* THIS TYPE OF BLOCK MAY BE USED AS A FILE CONTROL BLOCK.
* SEE SYSFC,SYSIN,SYSOU,S$INP,S$OUP FOR DETAILS.
*
* +------------------------------------+
* I XRTYP I
* +------------------------------------+
* I XRLEN I
* +------------------------------------+
* / /
* / XRPTR /
* / /
* +------------------------------------+
*
{XRTYP{EQU{0{{{POINTER TO DUMMY ROUTINE B$XRT
{XRLEN{EQU{XRTYP+1{{{LENGTH OF XRBLK IN BYTES
{XRPTR{EQU{XRLEN+1{{{START OF ADDRESS POINTERS
{XRSI${EQU{XRPTR{{{SIZE OF STANDARD FIELDS IN XRBLK
{{EJC{{{{
*
* S$CNV (CONVERT) FUNCTION SWITCH CONSTANTS. THE VALUES
* ARE TIED TO THE ORDER OF THE ENTRIES IN THE SVCTB TABLE
* AND HENCE TO THE BRANCH TABLE IN S$CNV.
*
{CNVST{EQU{8{{{MAX STANDARD TYPE CODE FOR CONVERT
{CNVRT{EQU{CNVST+1{{{CONVERT CODE FOR REALS
{CNVBT{EQU{CNVRT+1{{{CONVERT CODE FOR BUFFER
{CNVTT{EQU{CNVBT+1{{{BSW CODE FOR CONVERT
*
* INPUT IMAGE LENGTH
*
{INILN{EQU{132{{{DEFAULT IMAGE LENGTH FOR COMPILER
{INILS{EQU{80{{{IMAGE LENGTH IF -SEQU IN EFFECT
*
{IONMB{EQU{2{{{NAME BASE USED FOR IOCHN IN SYSIO
{IONMO{EQU{4{{{NAME OFFSET USED FOR IOCHN IN SYSIO
*
* IN GENERAL, MEANINGFUL MNEMONICS SHOULD BE USED FOR
* OFFSETS. HOWEVER FOR SMALL INTEGERS USED OFTEN IN
* LITERALS THE FOLLOWING GENERAL DEFINITIONS ARE PROVIDED.
*
{NUM01{EQU{1{{{
{NUM02{EQU{2{{{
{NUM03{EQU{3{{{
{NUM04{EQU{4{{{
{NUM05{EQU{5{{{
{NUM06{EQU{6{{{
{NUM07{EQU{7{{{
{NUM08{EQU{8{{{
{NUM09{EQU{9{{{
{NUM10{EQU{10{{{
{NINI8{EQU{998{{{
{NINI9{EQU{999{{{
{THSND{EQU{1000{{{
{{EJC{{{{
*
* NUMBERS OF UNDEFINED SPITBOL OPERATORS
*
{OPBUN{EQU{5{{{NO. OF BINARY UNDEFINED OPS
{OPUUN{EQU{6{{{NO OF UNARY UNDEFINED OPS
*
* OFFSETS USED IN PRTSN, PRTMI AND ACESS
*
{PRSNF{EQU{13{{{OFFSET USED IN PRTSN
{PRTMF{EQU{15{{{OFFSET TO COL 15 (PRTMI)
{RILEN{EQU{120{{{BUFFER LENGTH FOR SYSRI
*
* CODES FOR STAGES OF PROCESSING
*
{STGIC{EQU{0{{{INITIAL COMPILE
{STGXC{EQU{STGIC+1{{{EXECUTION COMPILE (CODE)
{STGEV{EQU{STGXC+1{{{EXPRESSION EVAL DURING EXECUTION
{STGXT{EQU{STGEV+1{{{EXECUTION TIME
{STGCE{EQU{STGXT+1{{{INITIAL COMPILE AFTER END LINE
{STGXE{EQU{STGCE+1{{{EXEC. COMPILE AFTER END LINE
{STGND{EQU{STGCE-STGIC{{{DIFFERENCE IN STAGE AFTER END
{STGEE{EQU{STGXE+1{{{EVAL EVALUATING EXPRESSION
{STGNO{EQU{STGEE+1{{{NUMBER OF CODES
{{EJC{{{{
*
*
* STATEMENT NUMBER PAD COUNT FOR LISTR
*
{STNPD{EQU{8{{{STATEMENT NO. PAD COUNT
*
* SYNTAX TYPE CODES
*
* THESE CODES ARE RETURNED FROM THE SCANE PROCEDURE.
*
* THEY ARE SPACED 3 APART FOR THE BENEFIT OF EXPAN.
*
{T$UOP{EQU{0{{{UNARY OPERATOR
{T$LPR{EQU{T$UOP+3{{{LEFT PAREN
{T$LBR{EQU{T$LPR+3{{{LEFT BRACKET
{T$CMA{EQU{T$LBR+3{{{COMMA
{T$FNC{EQU{T$CMA+3{{{FUNCTION CALL
{T$VAR{EQU{T$FNC+3{{{VARIABLE
{T$CON{EQU{T$VAR+3{{{CONSTANT
{T$BOP{EQU{T$CON+3{{{BINARY OPERATOR
{T$RPR{EQU{T$BOP+3{{{RIGHT PAREN
{T$RBR{EQU{T$RPR+3{{{RIGHT BRACKET
{T$COL{EQU{T$RBR+3{{{COLON
{T$SMC{EQU{T$COL+3{{{SEMI-COLON
*
* THE FOLLOWING DEFINITIONS ARE USED ONLY IN THE GOTO FIELD
*
{T$FGO{EQU{T$SMC+1{{{FAILURE GOTO
{T$SGO{EQU{T$FGO+1{{{SUCCESS GOTO
*
* THE ABOVE CODES ARE GROUPED SO THAT CODES FOR ELEMENTS
* WHICH CAN LEGITIMATELY IMMEDIATELY PRECEDE A UNARY
* OPERATOR COME FIRST TO FACILITATE OPERATOR SYNTAX CHECK.
*
{T$UOK{EQU{T$FNC{{{LAST CODE OK BEFORE UNARY OPERATOR
{{EJC{{{{
*
* DEFINITIONS OF VALUES FOR EXPAN JUMP TABLE
*
{T$UO0{EQU{T$UOP+0{{{UNARY OPERATOR, STATE ZERO
{T$UO1{EQU{T$UOP+1{{{UNARY OPERATOR, STATE ONE
{T$UO2{EQU{T$UOP+2{{{UNARY OPERATOR, STATE TWO
{T$LP0{EQU{T$LPR+0{{{LEFT PAREN, STATE ZERO
{T$LP1{EQU{T$LPR+1{{{LEFT PAREN, STATE ONE
{T$LP2{EQU{T$LPR+2{{{LEFT PAREN, STATE TWO
{T$LB0{EQU{T$LBR+0{{{LEFT BRACKET, STATE ZERO
{T$LB1{EQU{T$LBR+1{{{LEFT BRACKET, STATE ONE
{T$LB2{EQU{T$LBR+2{{{LEFT BRACKET, STATE TWO
{T$CM0{EQU{T$CMA+0{{{COMMA, STATE ZERO
{T$CM1{EQU{T$CMA+1{{{COMMA, STATE ONE
{T$CM2{EQU{T$CMA+2{{{COMMA, STATE TWO
{T$FN0{EQU{T$FNC+0{{{FUNCTION CALL, STATE ZERO
{T$FN1{EQU{T$FNC+1{{{FUNCTION CALL, STATE ONE
{T$FN2{EQU{T$FNC+2{{{FUNCTION CALL, STATE TWO
{T$VA0{EQU{T$VAR+0{{{VARIABLE, STATE ZERO
{T$VA1{EQU{T$VAR+1{{{VARIABLE, STATE ONE
{T$VA2{EQU{T$VAR+2{{{VARIABLE, STATE TWO
{T$CO0{EQU{T$CON+0{{{CONSTANT, STATE ZERO
{T$CO1{EQU{T$CON+1{{{CONSTANT, STATE ONE
{T$CO2{EQU{T$CON+2{{{CONSTANT, STATE TWO
{T$BO0{EQU{T$BOP+0{{{BINARY OPERATOR, STATE ZERO
{T$BO1{EQU{T$BOP+1{{{BINARY OPERATOR, STATE ONE
{T$BO2{EQU{T$BOP+2{{{BINARY OPERATOR, STATE TWO
{T$RP0{EQU{T$RPR+0{{{RIGHT PAREN, STATE ZERO
{T$RP1{EQU{T$RPR+1{{{RIGHT PAREN, STATE ONE
{T$RP2{EQU{T$RPR+2{{{RIGHT PAREN, STATE TWO
{T$RB0{EQU{T$RBR+0{{{RIGHT BRACKET, STATE ZERO
{T$RB1{EQU{T$RBR+1{{{RIGHT BRACKET, STATE ONE
{T$RB2{EQU{T$RBR+2{{{RIGHT BRACKET, STATE TWO
{T$CL0{EQU{T$COL+0{{{COLON, STATE ZERO
{T$CL1{EQU{T$COL+1{{{COLON, STATE ONE
{T$CL2{EQU{T$COL+2{{{COLON, STATE TWO
{T$SM0{EQU{T$SMC+0{{{SEMICOLON, STATE ZERO
{T$SM1{EQU{T$SMC+1{{{SEMICOLON, STATE ONE
{T$SM2{EQU{T$SMC+2{{{SEMICOLON, STATE TWO
*
{T$NES{EQU{T$SM2+1{{{NUMBER OF ENTRIES IN BRANCH TABLE
{{EJC{{{{
*
* DEFINITION OF OFFSETS USED IN CONTROL CARD PROCESSING
*
{CC$CA{EQU{0{{{-CASE
{CC$DO{EQU{CC$CA+1{{{-DOUBLE
{CC$DU{EQU{CC$DO+1{{{-DUMP
{CC$EJ{EQU{CC$DU+1{{{-EJECT
{CC$ER{EQU{CC$EJ+1{{{-ERRORS
{CC$EX{EQU{CC$ER+1{{{-EXECUTE
{CC$FA{EQU{CC$EX+1{{{-FAIL
{CC$LI{EQU{CC$FA+1{{{-LIST
{CC$NR{EQU{CC$LI+1{{{-NOERRORS
{CC$NX{EQU{CC$NR+1{{{-NOEXECUTE
{CC$NF{EQU{CC$NX+1{{{-NOFAIL
{CC$NL{EQU{CC$NF+1{{{-NOLIST
{CC$NO{EQU{CC$NL+1{{{-NOOPT
{CC$NP{EQU{CC$NO+1{{{-NOPRINT
{CC$OP{EQU{CC$NP+1{{{-OPTIMISE
{CC$PR{EQU{CC$OP+1{{{-PRINT
{CC$SI{EQU{CC$PR+1{{{-SINGLE
{CC$SP{EQU{CC$SI+1{{{-SPACE
{CC$ST{EQU{CC$SP+1{{{-STITL
{CC$TI{EQU{CC$ST+1{{{-TITLE
{CC$TR{EQU{CC$TI+1{{{-TRACE
{CC$NC{EQU{CC$TR+1{{{NUMBER OF CONTROL CARDS
{CCNOC{EQU{4{{{NO. OF CHARS INCLUDED IN MATCH
{CCOFS{EQU{7{{{OFFSET TO START OF TITLE/SUBTITLE
{{EJC{{{{
*
* DEFINITIONS OF STACK OFFSETS USED IN CMPIL PROCEDURE
*
* SEE DESCRIPTION AT START OF CMPIL PROCEDURE FOR DETAILS
* OF USE OF THESE LOCATIONS ON THE STACK.
*
{CMSTM{EQU{0{{{TREE FOR STATEMENT BODY
{CMSGO{EQU{CMSTM+1{{{TREE FOR SUCCESS GOTO
{CMFGO{EQU{CMSGO+1{{{TREE FOR FAIL GOTO
{CMCGO{EQU{CMFGO+1{{{CONDITIONAL GOTO FLAG
{CMPCD{EQU{CMCGO+1{{{PREVIOUS CDBLK POINTER
{CMFFP{EQU{CMPCD+1{{{FAILURE FILL IN FLAG FOR PREVIOUS
{CMFFC{EQU{CMFFP+1{{{FAILURE FILL IN FLAG FOR CURRENT
{CMSOP{EQU{CMFFC+1{{{SUCCESS FILL IN OFFSET FOR PREVIOUS
{CMSOC{EQU{CMSOP+1{{{SUCCESS FILL IN OFFSET FOR CURRENT
{CMLBL{EQU{CMSOC+1{{{PTR TO VRBLK FOR CURRENT LABEL
{CMTRA{EQU{CMLBL+1{{{PTR TO ENTRY CDBLK
*
{CMNEN{EQU{CMTRA+1{{{COUNT OF STACK ENTRIES FOR CMPIL
*
* A FEW CONSTANTS USED BY THE PROFILER
{PFPD1{EQU{8{{{PAD POSITIONS ...
{PFPD2{EQU{20{{{... FOR PROFILE ...
{PFPD3{EQU{32{{{... PRINTOUT
{PF$I2{EQU{CFP$I+CFP$I{{{SIZE OF TABLE ENTRY (2 INTS)
*
{{TTL{S{{{P I T B O L -- CONSTANT SECTION
*
* THIS SECTION CONSISTS ENTIRELY OF ASSEMBLED CONSTANTS.
*
* ALL LABEL NAMES ARE FIVE LETTERS. THE ORDER IS
* APPROXIMATELY ALPHABETICAL, BUT IN SOME CASES (ALWAYS
* DOCUMENTED), CONSTANTS MUST BE PLACED IN SOME SPECIAL
* ORDER WHICH MUST NOT BE DISTURBED.
*
* IT MUST ALSO BE REMEMBERED THAT THERE IS A REQUIREMENT
* FOR NO FORWARD REFERENCES WHICH ALSO DISTURBS THE
* ALPHABETICAL ORDER IN SOME CASES.
*
{{SEC{{{{START OF CONSTANT SECTION
*
* FREE STORE PERCENTAGE (USED BY ALLOC)
*
{ALFSP{DAC{E$FSP{{{FREE STORE PERCENTAGE
*
* BIT CONSTANTS FOR GENERAL USE
*
{BITS0{DBC{0{{{ALL ZERO BITS
{BITS1{DBC{1{{{ONE BIT IN LOW ORDER POSITION
{BITS2{DBC{2{{{BIT IN POSITION 2
{BITS3{DBC{4{{{BIT IN POSITION 3
{BITS4{DBC{8{{{BIT IN POSITION 4
{BITS5{DBC{16{{{BIT IN POSITION 5
{BITS6{DBC{32{{{BIT IN POSITION 6
{BITS7{DBC{64{{{BIT IN POSITION 7
{BITS8{DBC{128{{{BIT IN POSITION 8
{BITS9{DBC{256{{{BIT IN POSITION 9
{BIT10{DBC{512{{{BIT IN POSITION 10
{BITSM{DBC{CFP$M{{{MASK FOR MAX INTEGER
*
* BIT CONSTANTS FOR SVBLK (SVBIT FIELD) TESTS
*
{BTFNC{DBC{SVFNC{{{BIT TO TEST FOR FUNCTION
{BTKNM{DBC{SVKNM{{{BIT TO TEST FOR KEYWORD NUMBER
{BTLBL{DBC{SVLBL{{{BIT TO TEST FOR LABEL
{BTFFC{DBC{SVFFC{{{BIT TO TEST FOR FAST CALL
{BTCKW{DBC{SVCKW{{{BIT TO TEST FOR CONSTANT KEYWORD
{BTPRD{DBC{SVPRD{{{BIT TO TEST FOR PREDICATE FUNCTION
{BTPRE{DBC{SVPRE{{{BIT TO TEST FOR PREEVALUATION
{BTVAL{DBC{SVVAL{{{BIT TO TEST FOR VALUE
{{EJC{{{{
*
* LIST OF NAMES USED FOR CONTROL CARD PROCESSING
*
{CCNMS{DTC{/CASE/{{{
{{DTC{/DOUB/{{{
{{DTC{/DUMP/{{{
{{DTC{/EJEC/{{{
{{DTC{/ERRO/{{{
{{DTC{/EXEC/{{{
{{DTC{/FAIL/{{{
{{DTC{/LIST/{{{
{{DTC{/NOER/{{{
{{DTC{/NOEX/{{{
{{DTC{/NOFA/{{{
{{DTC{/NOLI/{{{
{{DTC{/NOOP/{{{
{{DTC{/NOPR/{{{
{{DTC{/OPTI/{{{
{{DTC{/PRIN/{{{
{{DTC{/SING/{{{
{{DTC{/SPAC/{{{
{{DTC{/STIT/{{{
{{DTC{/TITL/{{{
{{DTC{/TRAC/{{{
*
* HEADER MESSAGES FOR DUMPR PROCEDURE (SCBLK FORMAT)
*
{DMHDK{DAC{B$SCL{{{DUMP OF KEYWORD VALUES
{{DAC{22{{{
{{DTC{/DUMP OF KEYWORD VALUES/{{{
*
{DMHDV{DAC{B$SCL{{{DUMP OF NATURAL VARIABLES
{{DAC{25{{{
{{DTC{/DUMP OF NATURAL VARIABLES/{{{
{{EJC{{{{
*
* MESSAGE TEXT FOR COMPILATION STATISTICS
*
{ENCM1{DAC{B$SCL{{{
{{DAC{10{{{
{{DTC{/STORE USED/{{{
*
{ENCM2{DAC{B$SCL{{{
{{DAC{10{{{
{{DTC{/STORE LEFT/{{{
*
{ENCM3{DAC{B$SCL{{{
{{DAC{11{{{
{{DTC{/COMP ERRORS/{{{
*
{ENCM4{DAC{B$SCL{{{
{{DAC{14{{{
{{DTC{/COMP TIME-MSEC/{{{
*
{ENCM5{DAC{B$SCL{{{EXECUTION SUPPRESSED
{{DAC{20{{{
{{DTC{/EXECUTION SUPPRESSED/{{{
*
* STRING CONSTANT FOR ABNORMAL END
*
{ENDAB{DAC{B$SCL{{{
{{DAC{12{{{
{{DTC{/ABNORMAL END/{{{
{{EJC{{{{
*
* MEMORY OVERFLOW DURING INITIALISATION
*
{ENDMO{DAC{B$SCL{{{
{ENDML{DAC{15{{{
{{DTC{/MEMORY OVERFLOW/{{{
*
* STRING CONSTANT FOR MESSAGE ISSUED BY L$END
*
{ENDMS{DAC{B$SCL{{{
{{DAC{10{{{
{{DTC{/NORMAL END/{{{
*
* FAIL MESSAGE FOR STACK FAIL SECTION
*
{ENDSO{DAC{B$SCL{{{STACK OVERFLOW IN GARBAGE COLLECTOR
{{DAC{36{{{
{{DTC{/STACK OVERFLOW IN GARBAGE COLLECTION/{{{
*
* STRING CONSTANT FOR TIME UP
*
{ENDTU{DAC{B$SCL{{{
{{DAC{15{{{
{{DTC{/ERROR - TIME UP/{{{
{{EJC{{{{
*
* STRING CONSTANT FOR ERROR MESSAGE (ERROR SECTION)
*
{ERMMS{DAC{B$SCL{{{ERROR
{{DAC{5{{{
{{DTC{/ERROR/{{{
*
{ERMNS{DAC{B$SCL{{{STRING / -- /
{{DAC{4{{{
{{DTC{/ -- /{{{
*
* STRING CONSTANT FOR PAGE NUMBERING
*
{LSTMS{DAC{B$SCL{{{PAGE
{{DAC{5{{{
{{DTC{/PAGE /{{{
*
* LISTING HEADER MESSAGE
*
{HEADR{DAC{B$SCL{{{
{{DAC{25{{{
{{DTC{/MACRO SPITBOL VERSION 3.5/{{{
*
{HEADV{DAC{B$SCL{{{FOR EXIT() VERSION NO. CHECK
{{DAC{3{{{
{{DTC{/3.5/{{{
*
* INTEGER CONSTANTS FOR GENERAL USE
* ICBLD OPTIMISATION USES THE FIRST THREE.
*
{INT$R{DAC{B$ICL{{{
{INTV0{DIC{+0{{{0
{INTON{DAC{B$ICL{{{
{INTV1{DIC{+1{{{1
{INTTW{DAC{B$ICL{{{
{INTV2{DIC{+2{{{2
{INTVT{DIC{+10{{{10
{INTVH{DIC{+100{{{100
{INTTH{DIC{+1000{{{1000
*
* TABLE USED IN ICBLD OPTIMISATION
*
{INTAB{DAC{INT$R{{{POINTER TO 0
{{DAC{INTON{{{POINTER TO 1
{{DAC{INTTW{{{POINTER TO 2
{{EJC{{{{
*
* SPECIAL PATTERN NODES. THE FOLLOWING PATTERN NODES
* CONSIST SIMPLY OF A PCODE POINTER, SEE MATCH ROUTINES
* (P$XXX) FOR FULL DETAILS OF THEIR USE AND FORMAT).
*
{NDABB{DAC{P$ABB{{{ARBNO
{NDABD{DAC{P$ABD{{{ARBNO
{NDARC{DAC{P$ARC{{{ARB
{NDEXB{DAC{P$EXB{{{EXPRESSION
{NDFNB{DAC{P$FNB{{{FENCE()
{NDFND{DAC{P$FND{{{FENCE()
{NDEXC{DAC{P$EXC{{{EXPRESSION
{NDIMB{DAC{P$IMB{{{IMMEDIATE ASSIGNMENT
{NDIMD{DAC{P$IMD{{{IMMEDIATE ASSIGNMENT
{NDNTH{DAC{P$NTH{{{PATTERN END (NULL PATTERN)
{NDPAB{DAC{P$PAB{{{PATTERN ASSIGNMENT
{NDPAD{DAC{P$PAD{{{PATTERN ASSIGNMENT
{NDUNA{DAC{P$UNA{{{ANCHOR POINT MOVEMENT
*
* KEYWORD CONSTANT PATTERN NODES. THE FOLLOWING NODES ARE
* USED AS THE VALUES OF PATTERN KEYWORDS AND THE INITIAL
* VALUES OF THE CORRESPONDING NATURAL VARIABLES. ALL
* NODES ARE IN P0BLK FORMAT AND THE ORDER IS TIED TO THE
* DEFINITIONS OF CORRESPONDING K$XXX SYMBOLS.
*
{NDABO{DAC{P$ABO{{{ABORT
{{DAC{NDNTH{{{
{NDARB{DAC{P$ARB{{{ARB
{{DAC{NDNTH{{{
{NDBAL{DAC{P$BAL{{{BAL
{{DAC{NDNTH{{{
{NDFAL{DAC{P$FAL{{{FAIL
{{DAC{NDNTH{{{
{NDFEN{DAC{P$FEN{{{FENCE
{{DAC{NDNTH{{{
{NDREM{DAC{P$REM{{{REM
{{DAC{NDNTH{{{
{NDSUC{DAC{P$SUC{{{SUCCEED
{{DAC{NDNTH{{{
*
* NULL STRING. ALL NULL VALUES POINT TO THIS STRING. THE
* SVCHS FIELD CONTAINS A BLANK TO PROVIDE FOR EASY DEFAULT
* PROCESSING IN TRACE, STOPTR, LPAD AND RPAD.
* NULLW CONTAINS 10 BLANKS WHICH ENSURES AN ALL BLANK WORD
* BUT FOR VERY EXCEPTIONAL MACHINES.
*
{NULLS{DAC{B$SCL{{{NULL STRING VALUE
{{DAC{0{{{SCLEN = 0
{NULLW{DTC{/ /{{{
{{EJC{{{{
*
* OPERATOR DOPE VECTORS (SEE DVBLK FORMAT)
*
{OPDVC{DAC{O$CNC{{{CONCATENATION
{{DAC{C$CNC{{{
{{DAC{LLCNC{{{
{{DAC{RRCNC{{{
*
* OPDVS IS USED WHEN SCANNING BELOW THE TOP LEVEL TO
* INSURE THAT THE CONCATENATION WILL NOT BE LATER
* MISTAKEN FOR PATTERN MATCHING
*
{OPDVP{DAC{O$CNC{{{CONCATENATION - NOT PATTERN MATCH
{{DAC{C$CNP{{{
{{DAC{LLCNC{{{
{{DAC{RRCNC{{{
*
* NOTE THAT THE ORDER OF THE REMAINING ENTRIES IS TIED TO
* THE ORDER OF THE CODING IN THE SCANE PROCEDURE.
*
{OPDVS{DAC{O$ASS{{{ASSIGNMENT
{{DAC{C$ASS{{{
{{DAC{LLASS{{{
{{DAC{RRASS{{{
*
{{DAC{6{{{UNARY EQUAL
{{DAC{C$UUO{{{
{{DAC{LLUNO{{{
*
{{DAC{O$PMV{{{PATTERN MATCH
{{DAC{C$PMT{{{
{{DAC{LLPMT{{{
{{DAC{RRPMT{{{
*
{{DAC{O$INT{{{INTERROGATION
{{DAC{C$UVL{{{
{{DAC{LLUNO{{{
*
{{DAC{1{{{BINARY AMPERSAND
{{DAC{C$UBO{{{
{{DAC{LLAMP{{{
{{DAC{RRAMP{{{
*
{{DAC{O$KWV{{{KEYWORD REFERENCE
{{DAC{C$KEY{{{
{{DAC{LLUNO{{{
*
{{DAC{O$ALT{{{ALTERNATION
{{DAC{C$ALT{{{
{{DAC{LLALT{{{
{{DAC{RRALT{{{
{{EJC{{{{
*
* OPERATOR DOPE VECTORS (CONTINUED)
*
{{DAC{5{{{UNARY VERTICAL BAR
{{DAC{C$UUO{{{
{{DAC{LLUNO{{{
*
{{DAC{0{{{BINARY AT
{{DAC{C$UBO{{{
{{DAC{LLATS{{{
{{DAC{RRATS{{{
*
{{DAC{O$CAS{{{CURSOR ASSIGNMENT
{{DAC{C$UNM{{{
{{DAC{LLUNO{{{
*
{{DAC{2{{{BINARY NUMBER SIGN
{{DAC{C$UBO{{{
{{DAC{LLNUM{{{
{{DAC{RRNUM{{{
*
{{DAC{7{{{UNARY NUMBER SIGN
{{DAC{C$UUO{{{
{{DAC{LLUNO{{{
*
{{DAC{O$DVD{{{DIVISION
{{DAC{C$BVL{{{
{{DAC{LLDVD{{{
{{DAC{RRDVD{{{
*
{{DAC{9{{{UNARY SLASH
{{DAC{C$UUO{{{
{{DAC{LLUNO{{{
*
{{DAC{O$MLT{{{MULTIPLICATION
{{DAC{C$BVL{{{
{{DAC{LLMLT{{{
{{DAC{RRMLT{{{
{{EJC{{{{
*
* OPERATOR DOPE VECTORS (CONTINUED)
*
{{DAC{0{{{DEFERRED EXPRESSION
{{DAC{C$DEF{{{
{{DAC{LLUNO{{{
*
{{DAC{3{{{BINARY PERCENT
{{DAC{C$UBO{{{
{{DAC{LLPCT{{{
{{DAC{RRPCT{{{
*
{{DAC{8{{{UNARY PERCENT
{{DAC{C$UUO{{{
{{DAC{LLUNO{{{
*
{{DAC{O$EXP{{{EXPONENTIATION
{{DAC{C$BVL{{{
{{DAC{LLEXP{{{
{{DAC{RREXP{{{
*
{{DAC{10{{{UNARY EXCLAMATION
{{DAC{C$UUO{{{
{{DAC{LLUNO{{{
*
{{DAC{O$IMA{{{IMMEDIATE ASSIGNMENT
{{DAC{C$BVN{{{
{{DAC{LLDLD{{{
{{DAC{RRDLD{{{
*
{{DAC{O$INV{{{INDIRECTION
{{DAC{C$IND{{{
{{DAC{LLUNO{{{
*
{{DAC{4{{{BINARY NOT
{{DAC{C$UBO{{{
{{DAC{LLNOT{{{
{{DAC{RRNOT{{{
*
{{DAC{0{{{NEGATION
{{DAC{C$NEG{{{
{{DAC{LLUNO{{{
{{EJC{{{{
*
* OPERATOR DOPE VECTORS (CONTINUED)
*
{{DAC{O$SUB{{{SUBTRACTION
{{DAC{C$BVL{{{
{{DAC{LLPLM{{{
{{DAC{RRPLM{{{
*
{{DAC{O$COM{{{COMPLEMENTATION
{{DAC{C$UVL{{{
{{DAC{LLUNO{{{
*
{{DAC{O$ADD{{{ADDITION
{{DAC{C$BVL{{{
{{DAC{LLPLM{{{
{{DAC{RRPLM{{{
*
{{DAC{O$AFF{{{AFFIRMATION
{{DAC{C$UVL{{{
{{DAC{LLUNO{{{
*
{{DAC{O$PAS{{{PATTERN ASSIGNMENT
{{DAC{C$BVN{{{
{{DAC{LLDLD{{{
{{DAC{RRDLD{{{
*
{{DAC{O$NAM{{{NAME REFERENCE
{{DAC{C$UNM{{{
{{DAC{LLUNO{{{
*
* SPECIAL DVS FOR GOTO OPERATORS (SEE PROCEDURE SCNGF)
*
{OPDVD{DAC{O$GOD{{{DIRECT GOTO
{{DAC{C$UVL{{{
{{DAC{LLUNO{{{
*
{OPDVN{DAC{O$GOC{{{COMPLEX NORMAL GOTO
{{DAC{C$UNM{{{
{{DAC{LLUNO{{{
{{EJC{{{{
*
* OPERATOR ENTRY ADDRESS POINTERS, USED IN CODE
*
{OAMN${DAC{O$AMN{{{ARRAY REF (MULTI-SUBS BY VALUE)
{OAMV${DAC{O$AMV{{{ARRAY REF (MULTI-SUBS BY VALUE)
{OAON${DAC{O$AON{{{ARRAY REF (ONE SUB BY NAME)
{OAOV${DAC{O$AOV{{{ARRAY REF (ONE SUB BY VALUE)
{OCER${DAC{O$CER{{{COMPILATION ERROR
{OFEX${DAC{O$FEX{{{FAILURE IN EXPRESSION EVALUATION
{OFIF${DAC{O$FIF{{{FAILURE DURING GOTO EVALUATION
{OFNC${DAC{O$FNC{{{FUNCTION CALL (MORE THAN ONE ARG)
{OFNE${DAC{O$FNE{{{FUNCTION NAME ERROR
{OFNS${DAC{O$FNS{{{FUNCTION CALL (SINGLE ARGUMENT)
{OGOF${DAC{O$GOF{{{SET GOTO FAILURE TRAP
{OINN${DAC{O$INN{{{INDIRECTION BY NAME
{OKWN${DAC{O$KWN{{{KEYWORD REFERENCE BY NAME
{OLEX${DAC{O$LEX{{{LOAD EXPRESSION BY NAME
{OLPT${DAC{O$LPT{{{LOAD PATTERN
{OLVN${DAC{O$LVN{{{LOAD VARIABLE NAME
{ONTA${DAC{O$NTA{{{NEGATION, FIRST ENTRY
{ONTB${DAC{O$NTB{{{NEGATION, SECOND ENTRY
{ONTC${DAC{O$NTC{{{NEGATION, THIRD ENTRY
{OPMN${DAC{O$PMN{{{PATTERN MATCH BY NAME
{OPMS${DAC{O$PMS{{{PATTERN MATCH (STATEMENT)
{OPOP${DAC{O$POP{{{POP TOP STACK ITEM
{ORNM${DAC{O$RNM{{{RETURN NAME FROM EXPRESSION
{ORPL${DAC{O$RPL{{{PATTERN REPLACEMENT
{ORVL${DAC{O$RVL{{{RETURN VALUE FROM EXPRESSION
{OSLA${DAC{O$SLA{{{SELECTION, FIRST ENTRY
{OSLB${DAC{O$SLB{{{SELECTION, SECOND ENTRY
{OSLC${DAC{O$SLC{{{SELECTION, THIRD ENTRY
{OSLD${DAC{O$SLD{{{SELECTION, FOURTH ENTRY
{OSTP${DAC{O$STP{{{STOP EXECUTION
{OUNF${DAC{O$UNF{{{UNEXPECTED FAILURE
{{EJC{{{{
*
* TABLE OF NAMES OF UNDEFINED BINARY OPERATORS FOR OPSYN
*
{OPSNB{DAC{CH$AT{{{AT
{{DAC{CH$AM{{{AMPERSAND
{{DAC{CH$NM{{{NUMBER
{{DAC{CH$PC{{{PERCENT
{{DAC{CH$NT{{{NOT
*
* TABLE OF NAMES OF UNDEFINED UNARY OPERATORS FOR OPSYN
*
{OPNSU{DAC{CH$BR{{{VERTICAL BAR
{{DAC{CH$EQ{{{EQUAL
{{DAC{CH$NM{{{NUMBER
{{DAC{CH$PC{{{PERCENT
{{DAC{CH$SL{{{SLASH
{{DAC{CH$EX{{{EXCLAMATION
*
* ADDRESS CONST CONTAINING PROFILE TABLE ENTRY SIZE
*
{PFI2A{DAC{PF$I2{{{
*
* PROFILER MESSAGE STRINGS
*
{PFMS1{DAC{B$SCL{{{
{{DAC{15{{{
{{DTC{/PROGRAM PROFILE/{{{
{PFMS2{DAC{B$SCL{{{
{{DAC{42{{{
{{DTC{/STMT NUMBER OF -- EXECUTION TIME --/{{{
{PFMS3{DAC{B$SCL{{{
{{DAC{47{{{
{{DTC{/NUMBER EXECUTIONS TOTAL(MSEC) PER EXCN(MCSEC)/{{{
*
*
* REAL CONSTANTS FOR GENERAL USE. NOTE THAT THE CONSTANTS
* STARTING AT REAV1 FORM A POWERS OF TEN TABLE (GTSTG)
*
{REAV0{DRC{+0.0{{{0.0
{REAP1{DRC{+0.1{{{0.1
{REAP5{DRC{+0.5{{{0.5
{REAV1{DRC{+1.0{{{10**0
{REAVT{DRC{+1.0E+1{{{10**1
{{DRC{+1.0E+2{{{10**2
{{DRC{+1.0E+3{{{10**3
{{DRC{+1.0E+4{{{10**4
{{DRC{+1.0E+5{{{10**5
{{DRC{+1.0E+6{{{10**6
{{DRC{+1.0E+7{{{10**7
{{DRC{+1.0E+8{{{10**8
{{DRC{+1.0E+9{{{10**9
{REATT{DRC{+1.0E+10{{{10**10
{{EJC{{{{
*
* STRING CONSTANTS (SCBLK FORMAT) FOR DTYPE PROCEDURE
*
{SCARR{DAC{B$SCL{{{ARRAY
{{DAC{5{{{
{{DTC{/ARRAY/{{{
*
{SCBUF{DAC{B$SCL{{{BUFFER
{{DAC{6{{{
{{DTC{/BUFFER/{{{
*
{SCCOD{DAC{B$SCL{{{CODE
{{DAC{4{{{
{{DTC{/CODE/{{{
*
{SCEXP{DAC{B$SCL{{{EXPRESSION
{{DAC{10{{{
{{DTC{/EXPRESSION/{{{
*
{SCEXT{DAC{B$SCL{{{EXTERNAL
{{DAC{8{{{
{{DTC{/EXTERNAL/{{{
*
{SCINT{DAC{B$SCL{{{INTEGER
{{DAC{7{{{
{{DTC{/INTEGER/{{{
*
{SCNAM{DAC{B$SCL{{{NAME
{{DAC{4{{{
{{DTC{/NAME/{{{
*
{SCNUM{DAC{B$SCL{{{NUMERIC
{{DAC{7{{{
{{DTC{/NUMERIC/{{{
*
{SCPAT{DAC{B$SCL{{{PATTERN
{{DAC{7{{{
{{DTC{/PATTERN/{{{
*
{SCREA{DAC{B$SCL{{{REAL
{{DAC{4{{{
{{DTC{/REAL/{{{
*
{SCSTR{DAC{B$SCL{{{STRING
{{DAC{6{{{
{{DTC{/STRING/{{{
*
{SCTAB{DAC{B$SCL{{{TABLE
{{DAC{5{{{
{{DTC{/TABLE/{{{
{{EJC{{{{
*
* STRING CONSTANTS (SCBLK FORMAT) FOR KVRTN (SEE RETRN)
*
{SCFRT{DAC{B$SCL{{{FRETURN
{{DAC{7{{{
{{DTC{/FRETURN/{{{
*
{SCNRT{DAC{B$SCL{{{NRETURN
{{DAC{7{{{
{{DTC{/NRETURN/{{{
*
{SCRTN{DAC{B$SCL{{{RETURN
{{DAC{6{{{
{{DTC{/RETURN/{{{
*
* DATATYPE NAME TABLE FOR DTYPE PROCEDURE. THE ORDER OF
* THESE ENTRIES IS TIED TO THE B$XXX DEFINITIONS FOR BLOCKS
*
{SCNMT{DAC{SCARR{{{ARBLK ARRAY
{{DAC{SCBUF{{{BFBLK BUFFER
{{DAC{SCCOD{{{CDBLK CODE
{{DAC{SCEXP{{{EXBLK EXPRESSION
{{DAC{SCINT{{{ICBLK INTEGER
{{DAC{SCNAM{{{NMBLK NAME
{{DAC{SCPAT{{{P0BLK PATTERN
{{DAC{SCPAT{{{P1BLK PATTERN
{{DAC{SCPAT{{{P2BLK PATTERN
{{DAC{SCREA{{{RCBLK REAL
{{DAC{SCSTR{{{SCBLK STRING
{{DAC{SCEXP{{{SEBLK EXPRESSION
{{DAC{SCTAB{{{TBBLK TABLE
{{DAC{SCARR{{{VCBLK ARRAY
{{DAC{SCEXT{{{XNBLK EXTERNAL
{{DAC{SCEXT{{{XRBLK EXTERNAL
*
* STRING CONSTANT FOR REAL ZERO
*
{SCRE0{DAC{B$SCL{{{
{{DAC{2{{{
{{DTC{/0./{{{
{{EJC{{{{
*
* USED TO RE-INITIALISE KVSTL
*
{STLIM{DIC{+50000{{{DEFAULT STATEMENT LIMIT
*
* DUMMY FUNCTION BLOCK USED FOR UNDEFINED FUNCTIONS
*
{STNDF{DAC{O$FUN{{{PTR TO UNDEFINED FUNCTION ERR CALL
{{DAC{0{{{DUMMY FARGS COUNT FOR CALL CIRCUIT
*
* DUMMY CODE BLOCK USED FOR UNDEFINED LABELS
*
{STNDL{DAC{L$UND{{{CODE PTR POINTS TO UNDEFINED LBL
*
* DUMMY OPERATOR BLOCK USED FOR UNDEFINED OPERATORS
*
{STNDO{DAC{O$OUN{{{PTR TO UNDEFINED OPERATOR ERR CALL
{{DAC{0{{{DUMMY FARGS COUNT FOR CALL CIRCUIT
*
* STANDARD VARIABLE BLOCK. THIS BLOCK IS USED TO INITIALIZE
* THE FIRST SEVEN FIELDS OF A NEWLY CONSTRUCTED VRBLK.
* ITS FORMAT IS TIED TO THE VRBLK DEFINITIONS (SEE GTNVR).
*
{STNVR{DAC{B$VRL{{{VRGET
{{DAC{B$VRS{{{VRSTO
{{DAC{NULLS{{{VRVAL
{{DAC{B$VRG{{{VRTRA
{{DAC{STNDL{{{VRLBL
{{DAC{STNDF{{{VRFNC
{{DAC{0{{{VRNXT
{{EJC{{{{
*
* MESSAGES USED IN END OF RUN PROCESSING (STOPR)
*
{STPM1{DAC{B$SCL{{{IN STATEMENT
{{DAC{12{{{
{{DTC{/IN STATEMENT/{{{
*
{STPM2{DAC{B$SCL{{{
{{DAC{14{{{
{{DTC{/STMTS EXECUTED/{{{
*
{STPM3{DAC{B$SCL{{{
{{DAC{13{{{
{{DTC{/RUN TIME-MSEC/{{{
*
{STPM4{DAC{B$SCL{{{
{{DAC{12{{{
{{DTC{$MCSEC / STMT${{{
*
{STPM5{DAC{B$SCL{{{
{{DAC{13{{{
{{DTC{/REGENERATIONS/{{{
*
* CHARS FOR /TU/ ENDING CODE
*
{STRTU{DTC{/TU/{{{
*
* TABLE USED BY CONVERT FUNCTION TO CHECK DATATYPE NAME
* THE ENTRIES ARE ORDERED TO CORRESPOND TO BRANCH TABLE
* IN S$CNV
*
{SVCTB{DAC{SCSTR{{{STRING
{{DAC{SCINT{{{INTEGER
{{DAC{SCNAM{{{NAME
{{DAC{SCPAT{{{PATTERN
{{DAC{SCARR{{{ARRAY
{{DAC{SCTAB{{{TABLE
{{DAC{SCEXP{{{EXPRESSION
{{DAC{SCCOD{{{CODE
{{DAC{SCNUM{{{NUMERIC
{{DAC{SCREA{{{REAL
{{DAC{SCBUF{{{BUFFER
{{DAC{0{{{ZERO MARKS END OF LIST
{{EJC{{{{
*
* MESSAGES (SCBLK FORMAT) USED BY TRACE PROCEDURES
*
*
{TMASB{DAC{B$SCL{{{ASTERISKS FOR TRACE STATEMENT NO
{{DAC{13{{{
{{DTC{/************ /{{{
*
{TMBEB{DAC{B$SCL{{{BLANK-EQUAL-BLANK
{{DAC{3{{{
{{DTC{/ = /{{{
*
* DUMMY TRBLK FOR EXPRESSION VARIABLE
*
{TRBEV{DAC{B$TRT{{{DUMMY TRBLK
*
* DUMMY TRBLK FOR KEYWORD VARIABLE
*
{TRBKV{DAC{B$TRT{{{DUMMY TRBLK
*
* DUMMY CODE BLOCK TO RETURN CONTROL TO TRXEQ PROCEDURE
*
{TRXDR{DAC{O$TXR{{{BLOCK POINTS TO RETURN ROUTINE
{TRXDC{DAC{TRXDR{{{POINTER TO BLOCK
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS
*
* SEE SVBLK FORMAT FOR FULL DETAILS OF THE FORMAT. THE
* VRBLKS ARE ORDERED BY LENGTH AND WITHIN EACH LENGTH THE
* ORDER IS ALPHABETICAL BY NAME OF THE VARIABLE.
*
{V$EQF{DBC{SVFPR{{{EQ
{{DAC{2{{{
{{DTC{/EQ/{{{
{{DAC{S$EQF{{{
{{DAC{2{{{
*
{V$GEF{DBC{SVFPR{{{GE
{{DAC{2{{{
{{DTC{/GE/{{{
{{DAC{S$GEF{{{
{{DAC{2{{{
*
{V$GTF{DBC{SVFPR{{{GT
{{DAC{2{{{
{{DTC{/GT/{{{
{{DAC{S$GTF{{{
{{DAC{2{{{
*
{V$LEF{DBC{SVFPR{{{LE
{{DAC{2{{{
{{DTC{/LE/{{{
{{DAC{S$LEF{{{
{{DAC{2{{{
*
{V$LTF{DBC{SVFPR{{{LT
{{DAC{2{{{
{{DTC{/LT/{{{
{{DAC{S$LTF{{{
{{DAC{2{{{
*
{V$NEF{DBC{SVFPR{{{NE
{{DAC{2{{{
{{DTC{/NE/{{{
{{DAC{S$NEF{{{
{{DAC{2{{{
*
{V$ANY{DBC{SVFNP{{{ANY
{{DAC{3{{{
{{DTC{/ANY/{{{
{{DAC{S$ANY{{{
{{DAC{1{{{
*
{V$ARB{DBC{SVKVC{{{ARB
{{DAC{3{{{
{{DTC{/ARB/{{{
{{DAC{K$ARB{{{
{{DAC{NDARB{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
{V$ARG{DBC{SVFNN{{{ARG
{{DAC{3{{{
{{DTC{/ARG/{{{
{{DAC{S$ARG{{{
{{DAC{2{{{
*
{V$BAL{DBC{SVKVC{{{BAL
{{DAC{3{{{
{{DTC{/BAL/{{{
{{DAC{K$BAL{{{
{{DAC{NDBAL{{{
*
{V$END{DBC{SVLBL{{{END
{{DAC{3{{{
{{DTC{/END/{{{
{{DAC{L$END{{{
*
{V$LEN{DBC{SVFNP{{{LEN
{{DAC{3{{{
{{DTC{/LEN/{{{
{{DAC{S$LEN{{{
{{DAC{1{{{
*
{V$LEQ{DBC{SVFPR{{{LEQ
{{DAC{3{{{
{{DTC{/LEQ/{{{
{{DAC{S$LEQ{{{
{{DAC{2{{{
*
{V$LGE{DBC{SVFPR{{{LGE
{{DAC{3{{{
{{DTC{/LGE/{{{
{{DAC{S$LGE{{{
{{DAC{2{{{
*
{V$LGT{DBC{SVFPR{{{LGT
{{DAC{3{{{
{{DTC{/LGT/{{{
{{DAC{S$LGT{{{
{{DAC{2{{{
*
{V$LLE{DBC{SVFPR{{{LLE
{{DAC{3{{{
{{DTC{/LLE/{{{
{{DAC{S$LLE{{{
{{DAC{2{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
{V$LLT{DBC{SVFPR{{{LLT
{{DAC{3{{{
{{DTC{/LLT/{{{
{{DAC{S$LLT{{{
{{DAC{2{{{
*
{V$LNE{DBC{SVFPR{{{LNE
{{DAC{3{{{
{{DTC{/LNE/{{{
{{DAC{S$LNE{{{
{{DAC{2{{{
*
{V$POS{DBC{SVFNP{{{POS
{{DAC{3{{{
{{DTC{/POS/{{{
{{DAC{S$POS{{{
{{DAC{1{{{
*
{V$REM{DBC{SVKVC{{{REM
{{DAC{3{{{
{{DTC{/REM/{{{
{{DAC{K$REM{{{
{{DAC{NDREM{{{
*
{V$SET{DBC{SVFNN{{{SET
{{DAC{3{{{
{{DTC{/SET/{{{
{{DAC{S$SET{{{
{{DAC{3{{{
*
{V$TAB{DBC{SVFNP{{{TAB
{{DAC{3{{{
{{DTC{/TAB/{{{
{{DAC{S$TAB{{{
{{DAC{1{{{
*
{V$CAS{DBC{SVKNM{{{CASE
{{DAC{4{{{
{{DTC{/CASE/{{{
{{DAC{K$CAS{{{
*
{V$CHR{DBC{SVFNP{{{CHAR
{{DAC{4{{{
{{DTC{/CHAR/{{{
{{DAC{S$CHR{{{
{{DAC{1{{{
*
{V$COD{DBC{SVFNK{{{CODE
{{DAC{4{{{
{{DTC{/CODE/{{{
{{DAC{K$COD{{{
{{DAC{S$COD{{{
{{DAC{1{{{
*
{V$COP{DBC{SVFNN{{{COPY
{{DAC{4{{{
{{DTC{/COPY/{{{
{{DAC{S$COP{{{
{{DAC{1{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
{V$DAT{DBC{SVFNN{{{DATA
{{DAC{4{{{
{{DTC{/DATA/{{{
{{DAC{S$DAT{{{
{{DAC{1{{{
*
{V$DTE{DBC{SVFNN{{{DATE
{{DAC{4{{{
{{DTC{/DATE/{{{
{{DAC{S$DTE{{{
{{DAC{0{{{
*
{V$DMP{DBC{SVFNK{{{DUMP
{{DAC{4{{{
{{DTC{/DUMP/{{{
{{DAC{K$DMP{{{
{{DAC{S$DMP{{{
{{DAC{1{{{
*
{V$DUP{DBC{SVFNN{{{DUPL
{{DAC{4{{{
{{DTC{/DUPL/{{{
{{DAC{S$DUP{{{
{{DAC{2{{{
*
{V$EVL{DBC{SVFNN{{{EVAL
{{DAC{4{{{
{{DTC{/EVAL/{{{
{{DAC{S$EVL{{{
{{DAC{1{{{
*
{V$EXT{DBC{SVFNN{{{EXIT
{{DAC{4{{{
{{DTC{/EXIT/{{{
{{DAC{S$EXT{{{
{{DAC{1{{{
*
{V$FAL{DBC{SVKVC{{{FAIL
{{DAC{4{{{
{{DTC{/FAIL/{{{
{{DAC{K$FAL{{{
{{DAC{NDFAL{{{
*
{V$HST{DBC{SVFNN{{{HOST
{{DAC{4{{{
{{DTC{/HOST/{{{
{{DAC{S$HST{{{
{{DAC{3{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
{V$ITM{DBC{SVFNF{{{ITEM
{{DAC{4{{{
{{DTC{/ITEM/{{{
{{DAC{S$ITM{{{
{{DAC{999{{{
*
{V$LOD{DBC{SVFNN{{{LOAD
{{DAC{4{{{
{{DTC{/LOAD/{{{
{{DAC{S$LOD{{{
{{DAC{2{{{
*
{V$LPD{DBC{SVFNP{{{LPAD
{{DAC{4{{{
{{DTC{/LPAD/{{{
{{DAC{S$LPD{{{
{{DAC{3{{{
*
{V$RPD{DBC{SVFNP{{{RPAD
{{DAC{4{{{
{{DTC{/RPAD/{{{
{{DAC{S$RPD{{{
{{DAC{3{{{
*
{V$RPS{DBC{SVFNP{{{RPOS
{{DAC{4{{{
{{DTC{/RPOS/{{{
{{DAC{S$RPS{{{
{{DAC{1{{{
*
{V$RTB{DBC{SVFNP{{{RTAB
{{DAC{4{{{
{{DTC{/RTAB/{{{
{{DAC{S$RTB{{{
{{DAC{1{{{
*
{V$SI${DBC{SVFNP{{{SIZE
{{DAC{4{{{
{{DTC{/SIZE/{{{
{{DAC{S$SI${{{
{{DAC{1{{{
*
*
{V$SRT{DBC{SVFNN{{{SORT
{{DAC{4{{{
{{DTC{/SORT/{{{
{{DAC{S$SRT{{{
{{DAC{2{{{
{V$SPN{DBC{SVFNP{{{SPAN
{{DAC{4{{{
{{DTC{/SPAN/{{{
{{DAC{S$SPN{{{
{{DAC{1{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
{V$STN{DBC{SVKNM{{{STNO
{{DAC{4{{{
{{DTC{/STNO/{{{
{{DAC{K$STN{{{
*
{V$TIM{DBC{SVFNN{{{TIME
{{DAC{4{{{
{{DTC{/TIME/{{{
{{DAC{S$TIM{{{
{{DAC{0{{{
*
{V$TRM{DBC{SVFNK{{{TRIM
{{DAC{4{{{
{{DTC{/TRIM/{{{
{{DAC{K$TRM{{{
{{DAC{S$TRM{{{
{{DAC{1{{{
*
{V$ABE{DBC{SVKNM{{{ABEND
{{DAC{5{{{
{{DTC{/ABEND/{{{
{{DAC{K$ABE{{{
*
{V$ABO{DBC{SVKVL{{{ABORT
{{DAC{5{{{
{{DTC{/ABORT/{{{
{{DAC{K$ABO{{{
{{DAC{L$ABO{{{
{{DAC{NDABO{{{
*
{V$APP{DBC{SVFNF{{{APPLY
{{DAC{5{{{
{{DTC{/APPLY/{{{
{{DAC{S$APP{{{
{{DAC{999{{{
*
{V$ABN{DBC{SVFNP{{{ARBNO
{{DAC{5{{{
{{DTC{/ARBNO/{{{
{{DAC{S$ABN{{{
{{DAC{1{{{
*
{V$ARR{DBC{SVFNN{{{ARRAY
{{DAC{5{{{
{{DTC{/ARRAY/{{{
{{DAC{S$ARR{{{
{{DAC{2{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
{V$BRK{DBC{SVFNP{{{BREAK
{{DAC{5{{{
{{DTC{/BREAK/{{{
{{DAC{S$BRK{{{
{{DAC{1{{{
*
{V$CLR{DBC{SVFNN{{{CLEAR
{{DAC{5{{{
{{DTC{/CLEAR/{{{
{{DAC{S$CLR{{{
{{DAC{1{{{
*
{V$EJC{DBC{SVFNN{{{EJECT
{{DAC{5{{{
{{DTC{/EJECT/{{{
{{DAC{S$EJC{{{
{{DAC{1{{{
*
{V$FEN{DBC{SVFPK{{{FENCE
{{DAC{5{{{
{{DTC{/FENCE/{{{
{{DAC{K$FEN{{{
{{DAC{S$FNC{{{
{{DAC{1{{{
{{DAC{NDFEN{{{
*
{V$FLD{DBC{SVFNN{{{FIELD
{{DAC{5{{{
{{DTC{/FIELD/{{{
{{DAC{S$FLD{{{
{{DAC{2{{{
*
{V$IDN{DBC{SVFPR{{{IDENT
{{DAC{5{{{
{{DTC{/IDENT/{{{
{{DAC{S$IDN{{{
{{DAC{2{{{
*
{V$INP{DBC{SVFNK{{{INPUT
{{DAC{5{{{
{{DTC{/INPUT/{{{
{{DAC{K$INP{{{
{{DAC{S$INP{{{
{{DAC{3{{{
*
{V$LOC{DBC{SVFNN{{{LOCAL
{{DAC{5{{{
{{DTC{/LOCAL/{{{
{{DAC{S$LOC{{{
{{DAC{2{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
{V$OPS{DBC{SVFNN{{{OPSYN
{{DAC{5{{{
{{DTC{/OPSYN/{{{
{{DAC{S$OPS{{{
{{DAC{3{{{
*
{V$RMD{DBC{SVFNP{{{REMDR
{{DAC{5{{{
{{DTC{/REMDR/{{{
{{DAC{S$RMD{{{
{{DAC{2{{{
*
{V$RSR{DBC{SVFNN{{{RSORT
{{DAC{5{{{
{{DTC{/RSORT/{{{
{{DAC{S$RSR{{{
{{DAC{2{{{
*
{V$TBL{DBC{SVFNN{{{TABLE
{{DAC{5{{{
{{DTC{/TABLE/{{{
{{DAC{S$TBL{{{
{{DAC{3{{{
*
{V$TRA{DBC{SVFNK{{{TRACE
{{DAC{5{{{
{{DTC{/TRACE/{{{
{{DAC{K$TRA{{{
{{DAC{S$TRA{{{
{{DAC{4{{{
*
{V$ANC{DBC{SVKNM{{{ANCHOR
{{DAC{6{{{
{{DTC{/ANCHOR/{{{
{{DAC{K$ANC{{{
*
{V$APN{DBC{SVFNN{{{
{{DAC{6{{{
{{DTC{/APPEND/{{{
{{DAC{S$APN{{{
{{DAC{2{{{
*
{V$BKX{DBC{SVFNP{{{BREAKX
{{DAC{6{{{
{{DTC{/BREAKX/{{{
{{DAC{S$BKX{{{
{{DAC{1{{{
*
{V$BUF{DBC{SVFNN{{{BUFFER
{{DAC{6{{{
{{DTC{/BUFFER/{{{
{{DAC{S$BUF{{{
{{DAC{2{{{
*
{V$DEF{DBC{SVFNN{{{DEFINE
{{DAC{6{{{
{{DTC{/DEFINE/{{{
{{DAC{S$DEF{{{
{{DAC{2{{{
*
{V$DET{DBC{SVFNN{{{DETACH
{{DAC{6{{{
{{DTC{/DETACH/{{{
{{DAC{S$DET{{{
{{DAC{1{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
{V$DIF{DBC{SVFPR{{{DIFFER
{{DAC{6{{{
{{DTC{/DIFFER/{{{
{{DAC{S$DIF{{{
{{DAC{2{{{
*
{V$FTR{DBC{SVKNM{{{FTRACE
{{DAC{6{{{
{{DTC{/FTRACE/{{{
{{DAC{K$FTR{{{
*
{V$INS{DBC{SVFNN{{{INSERT
{{DAC{6{{{
{{DTC{/INSERT/{{{
{{DAC{S$INS{{{
{{DAC{4{{{
*
{V$LST{DBC{SVKNM{{{LASTNO
{{DAC{6{{{
{{DTC{/LASTNO/{{{
{{DAC{K$LST{{{
*
{V$NAY{DBC{SVFNP{{{NOTANY
{{DAC{6{{{
{{DTC{/NOTANY/{{{
{{DAC{S$NAY{{{
{{DAC{1{{{
*
{V$OUP{DBC{SVFNK{{{OUTPUT
{{DAC{6{{{
{{DTC{/OUTPUT/{{{
{{DAC{K$OUP{{{
{{DAC{S$OUP{{{
{{DAC{3{{{
*
{V$RET{DBC{SVLBL{{{RETURN
{{DAC{6{{{
{{DTC{/RETURN/{{{
{{DAC{L$RTN{{{
*
{V$REW{DBC{SVFNN{{{REWIND
{{DAC{6{{{
{{DTC{/REWIND/{{{
{{DAC{S$REW{{{
{{DAC{1{{{
*
{V$STT{DBC{SVFNN{{{STOPTR
{{DAC{6{{{
{{DTC{/STOPTR/{{{
{{DAC{S$STT{{{
{{DAC{2{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
{V$SUB{DBC{SVFNN{{{SUBSTR
{{DAC{6{{{
{{DTC{/SUBSTR/{{{
{{DAC{S$SUB{{{
{{DAC{3{{{
*
{V$UNL{DBC{SVFNN{{{UNLOAD
{{DAC{6{{{
{{DTC{/UNLOAD/{{{
{{DAC{S$UNL{{{
{{DAC{1{{{
*
{V$COL{DBC{SVFNN{{{COLLECT
{{DAC{7{{{
{{DTC{/COLLECT/{{{
{{DAC{S$COL{{{
{{DAC{1{{{
*
{V$CNV{DBC{SVFNN{{{CONVERT
{{DAC{7{{{
{{DTC{/CONVERT/{{{
{{DAC{S$CNV{{{
{{DAC{2{{{
*
{V$ENF{DBC{SVFNN{{{ENDFILE
{{DAC{7{{{
{{DTC{/ENDFILE/{{{
{{DAC{S$ENF{{{
{{DAC{1{{{
*
{V$ETX{DBC{SVKNM{{{ERRTEXT
{{DAC{7{{{
{{DTC{/ERRTEXT/{{{
{{DAC{K$ETX{{{
*
{V$ERT{DBC{SVKNM{{{ERRTYPE
{{DAC{7{{{
{{DTC{/ERRTYPE/{{{
{{DAC{K$ERT{{{
*
{V$FRT{DBC{SVLBL{{{FRETURN
{{DAC{7{{{
{{DTC{/FRETURN/{{{
{{DAC{L$FRT{{{
*
{V$INT{DBC{SVFPR{{{INTEGER
{{DAC{7{{{
{{DTC{/INTEGER/{{{
{{DAC{S$INT{{{
{{DAC{1{{{
*
{V$NRT{DBC{SVLBL{{{NRETURN
{{DAC{7{{{
{{DTC{/NRETURN/{{{
{{DAC{L$NRT{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
*
{V$PFL{DBC{SVKNM{{{PROFILE
{{DAC{7{{{
{{DTC{/PROFILE/{{{
{{DAC{K$PFL{{{
*
{V$RPL{DBC{SVFNP{{{REPLACE
{{DAC{7{{{
{{DTC{/REPLACE/{{{
{{DAC{S$RPL{{{
{{DAC{3{{{
*
{V$RVS{DBC{SVFNP{{{REVERSE
{{DAC{7{{{
{{DTC{/REVERSE/{{{
{{DAC{S$RVS{{{
{{DAC{1{{{
*
{V$RTN{DBC{SVKNM{{{RTNTYPE
{{DAC{7{{{
{{DTC{/RTNTYPE/{{{
{{DAC{K$RTN{{{
*
{V$STX{DBC{SVFNN{{{SETEXIT
{{DAC{7{{{
{{DTC{/SETEXIT/{{{
{{DAC{S$STX{{{
{{DAC{1{{{
*
{V$STC{DBC{SVKNM{{{STCOUNT
{{DAC{7{{{
{{DTC{/STCOUNT/{{{
{{DAC{K$STC{{{
*
{V$STL{DBC{SVKNM{{{STLIMIT
{{DAC{7{{{
{{DTC{/STLIMIT/{{{
{{DAC{K$STL{{{
*
{V$SUC{DBC{SVKVC{{{SUCCEED
{{DAC{7{{{
{{DTC{/SUCCEED/{{{
{{DAC{K$SUC{{{
{{DAC{NDSUC{{{
*
{V$ALP{DBC{SVKWC{{{ALPHABET
{{DAC{8{{{
{{DTC{/ALPHABET/{{{
{{DAC{K$ALP{{{
*
{V$CNT{DBC{SVLBL{{{CONTINUE
{{DAC{8{{{
{{DTC{/CONTINUE/{{{
{{DAC{L$CNT{{{
{{EJC{{{{
*
* STANDARD VARIABLE BLOCKS (CONTINUED)
*
{V$DTP{DBC{SVFNP{{{DATATYPE
{{DAC{8{{{
{{DTC{/DATATYPE/{{{
{{DAC{S$DTP{{{
{{DAC{1{{{
*
{V$ERL{DBC{SVKNM{{{ERRLIMIT
{{DAC{8{{{
{{DTC{/ERRLIMIT/{{{
{{DAC{K$ERL{{{
*
{V$FNC{DBC{SVKNM{{{FNCLEVEL
{{DAC{8{{{
{{DTC{/FNCLEVEL/{{{
{{DAC{K$FNC{{{
*
{V$MXL{DBC{SVKNM{{{MAXLNGTH
{{DAC{8{{{
{{DTC{/MAXLNGTH/{{{
{{DAC{K$MXL{{{
*
{V$TER{DBC{0{{{TERMINAL
{{DAC{8{{{
{{DTC{/TERMINAL/{{{
{{DAC{0{{{
*
{V$PRO{DBC{SVFNN{{{PROTOTYPE
{{DAC{9{{{
{{DTC{/PROTOTYPE/{{{
{{DAC{S$PRO{{{
{{DAC{1{{{
*
{{DBC{0{{{DUMMY ENTRY TO END LIST
{{DAC{10{{{LENGTH GT 9 (PROTOTYPE)
{{EJC{{{{
*
* LIST OF SVBLK POINTERS FOR KEYWORDS TO BE DUMPED. THE
* LIST IS IN THE ORDER WHICH APPEARS ON THE DUMP OUTPUT.
*
{VDMKW{DAC{V$ANC{{{ANCHOR
{{DAC{V$CAS{{{CCASE
{{DAC{V$COD{{{CODE
{{DAC{V$DMP{{{DUMP
{{DAC{V$ERL{{{ERRLIMIT
{{DAC{V$ETX{{{ERRTEXT
{{DAC{V$ERT{{{ERRTYPE
{{DAC{V$FNC{{{FNCLEVEL
{{DAC{V$FTR{{{FTRACE
{{DAC{V$INP{{{INPUT
{{DAC{V$LST{{{LASTNO
{{DAC{V$MXL{{{MAXLENGTH
{{DAC{V$OUP{{{OUTPUT
{{DAC{V$PFL{{{PROFILE
{{DAC{V$RTN{{{RTNTYPE
{{DAC{V$STC{{{STCOUNT
{{DAC{V$STL{{{STLIMIT
{{DAC{V$STN{{{STNO
{{DAC{V$TRA{{{TRACE
{{DAC{V$TRM{{{TRIM
{{DAC{0{{{END OF LIST
*
* TABLE USED BY GTNVR TO SEARCH SVBLK LISTS
*
{VSRCH{DAC{0{{{DUMMY ENTRY TO GET PROPER INDEXING
{{DAC{V$EQF{{{START OF 1 CHAR VARIABLES (NONE)
{{DAC{V$EQF{{{START OF 2 CHAR VARIABLES
{{DAC{V$ANY{{{START OF 3 CHAR VARIABLES
{{DAC{V$CAS{{{START OF 4 CHAR VARIABLES
{{DAC{V$ABE{{{START OF 5 CHAR VARIABLES
{{DAC{V$ANC{{{START OF 6 CHAR VARIABLES
{{DAC{V$COL{{{START OF 7 CHAR VARIABLES
{{DAC{V$ALP{{{START OF 8 CHAR VARIABLES
{{DAC{V$PRO{{{START OF 9 CHAR VARIABLES
{{TTL{S{{{P I T B O L -- WORKING STORAGE SECTION
*
* THE WORKING STORAGE SECTION CONTAINS AREAS WHICH ARE
* CHANGED DURING EXECUTION OF THE PROGRAM. THE VALUE
* ASSEMBLED IS THE INITIAL VALUE BEFORE EXECUTION STARTS.
*
* ALL THESE AREAS ARE FIXED LENGTH AREAS. VARIABLE LENGTH
* DATA IS STORED IN THE STATIC OR DYNAMIC REGIONS OF THE
* ALLOCATED DATA AREAS.
*
* THE VALUES IN THIS AREA ARE DESCRIBED EITHER AS WORK
* AREAS OR AS GLOBAL VALUES. A WORK AREA IS USED IN AN
* EPHEMERAL MANNER AND THE VALUE IS NOT SAVED FROM ONE
* ENTRY INTO A ROUTINE TO ANOTHER. A GLOBAL VALUE IS A
* LESS TEMPORARY LOCATION WHOSE VALUE IS SAVED FROM ONE
* CALL TO ANOTHER.
*
* A GENERAL PART OF THE APPROACH IN THIS PROGRAM IS NOT
* TO OVERLAP WORK AREAS BETWEEN PROCEDURES EVEN THOUGH A
* SMALL AMOUNT OF SPACE COULD BE SAVED. SUCH OVERLAP IS
* CONSIDERED A SOURCE OF PROGRAM ERRORS AND DECREASES THE
* INFORMATION LEFT BEHIND AFTER A SYSTEM CRASH OF ANY KIND.
*
* THE NAMES OF THESE LOCATIONS ARE LABELS WITH FIVE LETTER
* (A-Y,$) NAMES. AS FAR AS POSSIBLE THE ORDER IS KEPT
* ALPHABETICAL BY THESE NAMES BUT IN SOME CASES THERE
* ARE SLIGHT DEPARTURES CAUSED BY OTHER ORDER REQUIREMENTS.
*
* UNLESS OTHERWISE DOCUMENTED, THE ORDER OF WORK AREAS
* DOES NOT AFFECT THE EXECUTION OF THE SPITBOL PROGRAM.
*
{{SEC{{{{START OF WORKING STORAGE SECTION
{{EJC{{{{
*
* THIS AREA IS NOT CLEARED BY INITIAL CODE
*
{CMLAB{DAC{B$SCL{{{STRING USED TO CHECK LABEL LEGALITY
{{DAC{2{{{
{{DTC{/ /{{{
*
* LABEL TO MARK START OF WORK AREA
*
{AAAAA{DAC{0{{{
*
* WORK AREAS FOR ALLOC PROCEDURE
*
{ALDYN{DAC{0{{{AMOUNT OF DYNAMIC STORE
{ALFSF{DIC{+0{{{FACTOR IN FREE STORE PCNTAGE CHECK
{ALLIA{DIC{+0{{{DUMP IA
{ALLSV{DAC{0{{{SAVE WB IN ALLOC
*
* WORK AREAS FOR ALOST PROCEDURE
*
{ALSTA{DAC{0{{{SAVE WA IN ALOST
*
* SAVE AREAS FOR ARRAY FUNCTION (S$ARR)
*
{ARCDM{DAC{0{{{COUNT DIMENSIONS
{ARNEL{DIC{+0{{{COUNT ELEMENTS
{ARPTR{DAC{0{{{OFFSET PTR INTO ARBLK
{ARSVL{DIC{+0{{{SAVE INTEGER LOW BOUND
{{EJC{{{{
* WORK AREAS FOR ARREF ROUTINE
*
{ARFSI{DIC{+0{{{SAVE CURRENT EVOLVING SUBSCRIPT
{ARFXS{DAC{0{{{SAVE BASE STACK POINTER
*
* WORK AREAS FOR B$EFC BLOCK ROUTINE
*
{BEFOF{DAC{0{{{SAVE OFFSET PTR INTO EFBLK
*
* WORK AREAS FOR B$PFC BLOCK ROUTINE
*
{BPFPF{DAC{0{{{SAVE PFBLK POINTER
{BPFSV{DAC{0{{{SAVE OLD FUNCTION VALUE
{BPFXT{DAC{0{{{POINTER TO STACKED ARGUMENTS
*
* SAVE AREAS FOR COLLECT FUNCTION (S$COL)
*
{CLSVI{DIC{+0{{{SAVE INTEGER ARGUMENT
*
* GLOBAL VALUES FOR CMPIL PROCEDURE
*
{CMERC{DAC{0{{{COUNT OF INITIAL COMPILE ERRORS
{CMPXS{DAC{0{{{SAVE STACK PTR IN CASE OF ERRORS
{CMPSN{DAC{1{{{NUMBER OF NEXT STATEMENT TO COMPILE
{CMPSS{DAC{0{{{SAVE SUBROUTINE STACK PTR
*
* WORK AREA FOR CNCRD
*
{CNSCC{DAC{0{{{POINTER TO CONTROL CARD STRING
{CNSWC{DAC{0{{{WORD COUNT
{CNR$T{DAC{0{{{POINTER TO R$TTL OR R$STL
{CNTTL{DAC{0{{{FLAG FOR -TITLE, -STITL
*
* WORK AREAS FOR CONVERT FUNCTION (S$CNV)
*
{CNVTP{DAC{0{{{SAVE PTR INTO SCVTB
*
* FLAG FOR SUPPRESSION OF COMPILATION STATISTICS.
*
{CPSTS{DAC{0{{{SUPPRESS COMP. STATS IF NON ZERO
*
* GLOBAL VALUES FOR CONTROL CARD SWITCHES
*
{CSWDB{DAC{0{{{0/1 FOR -SINGLE/-DOUBLE
{CSWER{DAC{0{{{0/1 FOR -ERRORS/-NOERRORS
{CSWEX{DAC{0{{{0/1 FOR -EXECUTE/-NOEXECUTE
{CSWFL{DAC{1{{{0/1 FOR -NOFAIL/-FAIL
{CSWIN{DAC{INILN{{{XXX FOR -INXXX
{CSWLS{DAC{1{{{0/1 FOR -NOLIST/-LIST
{CSWNO{DAC{0{{{0/1 FOR -OPTIMISE/-NOOPT
{CSWPR{DAC{0{{{0/1 FOR -NOPRINT/-PRINT
*
* GLOBAL LOCATION USED BY PATST PROCEDURE
*
{CTMSK{DBC{0{{{LAST BIT POSITION USED IN R$CTP
{CURID{DAC{0{{{CURRENT ID VALUE
{{EJC{{{{
*
* GLOBAL VALUE FOR CDWRD PROCEDURE
*
{CWCOF{DAC{0{{{NEXT WORD OFFSET IN CURRENT CCBLK
*
* WORK AREAS FOR DATA FUNCTION (S$DAT)
*
{DATDV{DAC{0{{{SAVE VRBLK PTR FOR DATATYPE NAME
{DATXS{DAC{0{{{SAVE INITIAL STACK POINTER
*
* WORK AREAS FOR DEFINE FUNCTION (S$DEF)
*
{DEFLB{DAC{0{{{SAVE VRBLK PTR FOR LABEL
{DEFNA{DAC{0{{{COUNT FUNCTION ARGUMENTS
{DEFVR{DAC{0{{{SAVE VRBLK PTR FOR FUNCTION NAME
{DEFXS{DAC{0{{{SAVE INITIAL STACK POINTER
*
* WORK AREAS FOR DUMPR PROCEDURE
*
{DMARG{DAC{0{{{DUMP ARGUMENT
{DMPKB{DAC{B$KVT{{{DUMMY KVBLK FOR USE IN DUMPR
{DMPKT{DAC{TRBKV{{{KVVAR TRBLK POINTER
{DMPKN{DAC{0{{{KEYWORD NUMBER (MUST FOLLOW DMPKB)
{DMPSA{DAC{0{{{PRESERVE WA OVER PRTVL CALL
{DMPSV{DAC{0{{{GENERAL SCRATCH SAVE
{DMVCH{DAC{0{{{CHAIN POINTER FOR VARIABLE BLOCKS
{DMPCH{DAC{0{{{SAVE SORTED VRBLK CHAIN POINTER
*
* GLOBAL LOCATIONS FOR DYNAMIC STORAGE POINTERS
*
{DNAMB{DAC{0{{{START OF DYNAMIC AREA
{DNAMP{DAC{0{{{NEXT AVAILABLE LOC IN DYNAMIC AREA
{DNAME{DAC{0{{{END OF AVAILABLE DYNAMIC AREA
*
* WORK AREA FOR DTACH
*
{DTCNB{DAC{0{{{NAME BASE
{DTCNM{DAC{0{{{NAME PTR
*
* WORK AREAS FOR DUPL FUNCTION (S$DUP)
*
{DUPSI{DIC{+0{{{STORE INTEGER STRING LENGTH
*
* WORK AREA FOR ENDFILE (S$ENF)
*
{ENFCH{DAC{0{{{FOR IOCHN CHAIN HEAD
*
* WORK AREA FOR ERROR PROCESSING.
*
{ERICH{DAC{0{{{COPY ERROR REPORTS TO INT.CHAN IF 1
{ERLST{DAC{0{{{FOR LISTR WHEN ERRORS GO TO INT.CH.
{ERRFT{DAC{0{{{FATAL ERROR FLAG
{ERRSP{DAC{0{{{ERROR SUPPRESSION FLAG
{{EJC{{{{
*
* DUMP AREA FOR ERTEX
*
{ERTWA{DAC{0{{{SAVE WA
{ERTWB{DAC{0{{{SAVE WB
*
* GLOBAL VALUES FOR EVALI
*
{EVLIN{DAC{P$LEN{{{DUMMY PATTERN BLOCK PCODE
{EVLIS{DAC{0{{{POINTER TO SUBSEQUENT NODE
{EVLIV{DAC{0{{{VALUE OF PARAMETER
* WORK AREA FOR EXPAN
*
{EXPSV{DAC{0{{{SAVE OP DOPE VECTOR POINTER
*
* FLAG FOR SUPPRESSION OF EXECUTION STATS
*
{EXSTS{DAC{0{{{SUPPRESS EXEC STATS IF SET
*
* GLOBAL VALUES FOR EXFAL AND RETURN
*
{FLPRT{DAC{0{{{LOCATION OF FAIL OFFSET FOR RETURN
{FLPTR{DAC{0{{{LOCATION OF FAILURE OFFSET ON STACK
*
* WORK AREAS FOR GBCOL PROCEDURE
*
{GBCFL{DAC{0{{{GARBAGE COLLECTOR ACTIVE FLAG
{GBCLM{DAC{0{{{POINTER TO LAST MOVE BLOCK (PASS 3)
{GBCNM{DAC{0{{{DUMMY FIRST MOVE BLOCK
{GBCNS{DAC{0{{{REST OF DUMMY BLOCK (FOLLOWS GBCNM)
{GBSVA{DAC{0{{{SAVE WA
{GBSVB{DAC{0{{{SAVE WB
{GBSVC{DAC{0{{{SAVE WC
*
* GLOBAL LOCATION TO COUNT GARBAGE COLLECTIONS (GBCOL)
*
{GBCNT{DAC{0{{{COUNT OF GARBAGE COLLECTIONS
*
* WORK AREAS FOR GTNVR PROCEDURE
*
{GNVHE{DAC{0{{{PTR TO END OF HASH CHAIN
{GNVNW{DAC{0{{{NUMBER OF WORDS IN STRING NAME
{GNVSA{DAC{0{{{SAVE WA
{GNVSB{DAC{0{{{SAVE WB
{GNVSP{DAC{0{{{POINTER INTO VSRCH TABLE
{GNVST{DAC{0{{{POINTER TO CHARS OF STRING
*
* GLOBAL VALUE FOR GTCOD AND GTEXP
*
{GTCEF{DAC{0{{{SAVE FAIL PTR IN CASE OF ERROR
*
* WORK AREAS FOR GTINT
*
{GTINA{DAC{0{{{SAVE WA
{GTINB{DAC{0{{{SAVE WB
{{EJC{{{{
*
* WORK AREAS FOR GTNUM PROCEDURE
*
{GTNNF{DAC{0{{{ZERO/NONZERO FOR RESULT +/-
{GTNSI{DIC{+0{{{GENERAL INTEGER SAVE
{GTNDF{DAC{0{{{0/1 FOR DEC POINT SO FAR NO/YES
{GTNES{DAC{0{{{ZERO/NONZERO EXPONENT +/-
{GTNEX{DIC{+0{{{REAL EXPONENT
{GTNSC{DAC{0{{{SCALE (PLACES AFTER POINT)
{GTNSR{DRC{+0.0{{{GENERAL REAL SAVE
{GTNRD{DAC{0{{{FLAG FOR OK REAL NUMBER
*
* WORK AREAS FOR GTPAT PROCEDURE
*
{GTPSB{DAC{0{{{SAVE WB
*
* WORK AREAS FOR GTSTG PROCEDURE
*
{GTSSF{DAC{0{{{0/1 FOR RESULT +/-
{GTSVC{DAC{0{{{SAVE WC
{GTSVB{DAC{0{{{SAVE WB
{GTSWK{DAC{0{{{PTR TO WORK AREA FOR GTSTG
{GTSES{DAC{0{{{CHAR + OR - FOR EXPONENT +/-
{GTSRS{DRC{+0.0{{{GENERAL REAL SAVE
*
* GLOBAL LOCATIONS (CONSTANTS) FOR GTSTG PROCEDURE
*
{GTSRN{DRC{+0.0{{{ROUNDING FACTOR 0.5*10**-CFP$S
{GTSSC{DRC{+0.0{{{SCALING VALUE 10**CFP$S
*
* WORK AREAS FOR GTVAR PROCEDURE
*
{GTVRC{DAC{0{{{SAVE WC
*
* FLAG FOR HEADER PRINTING
*
{HEADP{DAC{0{{{HEADER PRINTED FLAG
*
* GLOBAL VALUES FOR VARIABLE HASH TABLE
*
{HSHNB{DIC{+0{{{NUMBER OF HASH BUCKETS
{HSHTB{DAC{0{{{POINTER TO START OF VRBLK HASH TABL
{HSHTE{DAC{0{{{POINTER PAST END OF VRBLK HASH TABL
*
* WORK AREA FOR INIT
*
{INISS{DAC{0{{{SAVE SUBROUTINE STACK PTR
{INITR{DAC{0{{{SAVE TERMINAL FLAG
*
* SAVE AREA FOR INSBF
*
{INSAB{DAC{0{{{ENTRY WA + ENTRY WB
{INSSA{DAC{0{{{SAVE ENTRY WA
{INSSB{DAC{0{{{SAVE ENTRY WB
{INSSC{DAC{0{{{SAVE ENTRY WC
*
* WORK AREAS FOR IOPUT
*
{IOPTT{DAC{0{{{TYPE OF ASSOCIATION
{{EJC{{{{
*
* GLOBAL VALUES FOR KEYWORD VALUES WHICH ARE STORED AS ONE
* WORD INTEGERS. THESE VALUES MUST BE ASSEMBLED IN THE
* FOLLOWING ORDER (AS DICTATED BY K$XXX DEFINITION VALUES).
*
{KVABE{DAC{0{{{ABEND
{KVANC{DAC{0{{{ANCHOR
{KVCAS{DAC{0{{{CASE
{KVCOD{DAC{0{{{CODE
{KVDMP{DAC{0{{{DUMP
{KVERL{DAC{0{{{ERRLIMIT
{KVERT{DAC{0{{{ERRTYPE
{KVFTR{DAC{0{{{FTRACE
{KVINP{DAC{1{{{INPUT
{KVMXL{DAC{5000{{{MAXLENGTH
{KVOUP{DAC{1{{{OUTPUT
{KVPFL{DAC{0{{{PROFILE
{KVTRA{DAC{0{{{TRACE
{KVTRM{DAC{0{{{TRIM
{KVFNC{DAC{0{{{FNCLEVEL
{KVLST{DAC{0{{{LASTNO
{KVSTN{DAC{0{{{STNO
*
* GLOBAL VALUES FOR OTHER KEYWORDS
*
{KVALP{DAC{0{{{ALPHABET
{KVRTN{DAC{NULLS{{{RTNTYPE (SCBLK POINTER)
{KVSTL{DIC{+50000{{{STLIMIT
{KVSTC{DIC{+50000{{{STCOUNT (COUNTS DOWN FROM STLIMIT)
*
* WORK AREAS FOR LOAD FUNCTION
*
{LODFN{DAC{0{{{POINTER TO VRBLK FOR FUNC NAME
{LODNA{DAC{0{{{COUNT NUMBER OF ARGUMENTS
*
* GLOBAL VALUES FOR LISTR PROCEDURE
*
{LSTLC{DAC{0{{{COUNT LINES ON SOURCE LIST PAGE
{LSTNP{DAC{0{{{MAX NUMBER OF LINES ON PAGE
{LSTPF{DAC{1{{{SET NONZERO IF CURRENT IMAGE LISTED
{LSTPG{DAC{0{{{CURRENT SOURCE LIST PAGE NUMBER
{LSTPO{DAC{0{{{OFFSET TO PAGE NNN MESSAGE
{LSTSN{DAC{0{{{REMEMBER LAST STMNUM LISTED
*
* MAXIMUM SIZE OF SPITBOL OBJECTS
*
{MXLEN{DAC{0{{{INITIALISED BY SYSMX CALL
*
* EXECUTION CONTROL VARIABLE
*
{NOXEQ{DAC{0{{{SET NON-ZERO TO INHIBIT EXECUTION
*
* PROFILER GLOBAL VALUES AND WORK LOCATIONS
*
{PFDMP{DAC{0{{{SET NON-0 IF &PROFILE SET NON-0
{PFFNC{DAC{0{{{SET NON-0 IF FUNCT JUST ENTERED
{PFSTM{DIC{+0{{{TO STORE STARTING TIME OF STMT
{PFETM{DIC{+0{{{TO STORE ENDING TIME OF STMT
{PFSVW{DAC{0{{{TO SAVE A W-REG
{PFTBL{DAC{0{{{GETS ADRS OF (IMAG) TABLE BASE
{PFNTE{DAC{0{{{NR OF TABLE ENTRIES
{PFSTE{DIC{+0{{{GETS INT REP OF TABLE ENTRY SIZE
*
{{EJC{{{{
*
* GLOBAL VALUES USED IN PATTERN MATCH ROUTINES
*
{PMDFL{DAC{0{{{PATTERN ASSIGNMENT FLAG
{PMHBS{DAC{0{{{HISTORY STACK BASE POINTER
{PMSSL{DAC{0{{{LENGTH OF SUBJECT STRING IN CHARS
*
* FLAGS USED FOR STANDARD FILE LISTING OPTIONS
*
{PRICH{DAC{0{{{PRINTER ON INTERACTIVE CHANNEL
{PRSTD{DAC{0{{{TESTED BY PRTPG
{PRSTO{DAC{0{{{STANDARD LISTING OPTION FLAG
*
* GLOBAL VALUE FOR PRTNM PROCEDURE
*
{PRNMV{DAC{0{{{VRBLK PTR FROM LAST NAME SEARCH
*
* WORK AREAS FOR PRTNM PROCEDURE
*
{PRNSI{DIC{+0{{{SCRATCH INTEGER LOC
*
* WORK AREAS FOR PRTSN PROCEDURE
*
{PRSNA{DAC{0{{{SAVE WA
*
* GLOBAL VALUES FOR PRINT PROCEDURES
*
{PRBUF{DAC{0{{{PTR TO PRINT BFR IN STATIC
{PRECL{DAC{0{{{EXTENDED/COMPACT LISTING FLAG
{PRLEN{DAC{0{{{LENGTH OF PRINT BUFFER IN CHARS
{PRLNW{DAC{0{{{LENGTH OF PRINT BUFFER IN WORDS
{PROFS{DAC{0{{{OFFSET TO NEXT LOCATION IN PRBUF
{PRTEF{DAC{0{{{ENDFILE FLAG
*
* WORK AREAS FOR PRTST PROCEDURE
*
{PRSVA{DAC{0{{{SAVE WA
{PRSVB{DAC{0{{{SAVE WB
{PRSVC{DAC{0{{{SAVE CHAR COUNTER
*
* WORK AREA FOR PRTNL
*
{PRTSA{DAC{0{{{SAVE WA
{PRTSB{DAC{0{{{SAVE WB
*
* WORK AREA FOR PRTVL
*
{PRVSI{DAC{0{{{SAVE IDVAL
*
* WORK AREAS FOR PATTERN MATCH ROUTINES
*
{PSAVE{DAC{0{{{TEMPORARY SAVE FOR CURRENT NODE PTR
{PSAVC{DAC{0{{{SAVE CURSOR IN P$SPN, P$STR
{{EJC{{{{
*
* AMOUNT OF MEMORY RESERVED FOR END OF EXECUTION
*
{RSMEM{DAC{0{{{RESERVE MEMORY
*
* WORK AREAS FOR RETRN ROUTINE
*
{RTNBP{DAC{0{{{TO SAVE A BLOCK POINTER
{RTNFV{DAC{0{{{NEW FUNCTION VALUE (RESULT)
{RTNSV{DAC{0{{{OLD FUNCTION VALUE (SAVED VALUE)
*
* RELOCATABLE GLOBAL VALUES
*
* ALL THE POINTERS IN THIS SECTION CAN POINT TO BLOCKS IN
* THE DYNAMIC STORAGE AREA AND MUST BE RELOCATED BY THE
* GARBAGE COLLECTOR. THEY ARE IDENTIFIED BY R$XXX NAMES.
*
{R$AAA{DAC{0{{{START OF RELOCATABLE VALUES
{R$ARF{DAC{0{{{ARRAY BLOCK POINTER FOR ARREF
{R$CCB{DAC{0{{{PTR TO CCBLK BEING BUILT (CDWRD)
{R$CIM{DAC{0{{{PTR TO CURRENT COMPILER INPUT STR
{R$CMP{DAC{0{{{COPY OF R$CIM USED IN CMPIL
{R$CNI{DAC{0{{{PTR TO NEXT COMPILER INPUT STRING
{R$CNT{DAC{0{{{CDBLK POINTER FOR SETEXIT CONTINUE
{R$COD{DAC{0{{{POINTER TO CURRENT CDBLK OR EXBLK
{R$CTP{DAC{0{{{PTR TO CURRENT CTBLK FOR PATST
{R$ERT{DAC{0{{{TRBLK POINTER FOR ERRTYPE TRACE
{R$ETX{DAC{NULLS{{{POINTER TO ERRTEXT STRING
{R$EXS{DAC{0{{{= SAVE XL IN EXPDM
{R$FCB{DAC{0{{{FCBLK CHAIN HEAD
{R$FNC{DAC{0{{{TRBLK POINTER FOR FNCLEVEL TRACE
{R$GTC{DAC{0{{{KEEP CODE PTR FOR GTCOD,GTEXP
{R$IO1{DAC{0{{{FILE ARG1 FOR IOPUT
{R$IO2{DAC{0{{{FILE ARG2 FOR IOPUT
{R$IOF{DAC{0{{{FCBLK PTR OR 0
{R$ION{DAC{0{{{NAME BASE PTR
{R$IOP{DAC{0{{{PREDECESSOR BLOCK PTR FOR IOPUT
{R$IOT{DAC{0{{{TRBLK PTR FOR IOPUT
{R$PMB{DAC{0{{{BUFFER PTR IN PATTERN MATCH
{R$PMS{DAC{0{{{SUBJECT STRING PTR IN PATTERN MATCH
{R$RA2{DAC{0{{{REPLACE SECOND ARGUMENT LAST TIME
{R$RA3{DAC{0{{{REPLACE THIRD ARGUMENT LAST TIME
{R$RPT{DAC{0{{{PTR TO CTBLK REPLACE TABLE LAST USD
{R$SCP{DAC{0{{{SAVE POINTER FROM LAST SCANE CALL
{R$SXL{DAC{0{{{PRESERVE XL IN SORTC
{R$SXR{DAC{0{{{PRESERVE XR IN SORTA/SORTC
{R$STC{DAC{0{{{TRBLK POINTER FOR STCOUNT TRACE
{R$STL{DAC{0{{{SOURCE LISTING SUB-TITLE
{R$SXC{DAC{0{{{CODE (CDBLK) PTR FOR SETEXIT TRAP
{R$TTL{DAC{NULLS{{{SOURCE LISTING TITLE
{R$XSC{DAC{0{{{STRING POINTER FOR XSCAN
{{EJC{{{{
*
* THE REMAINING POINTERS IN THIS LIST ARE USED TO POINT
* TO FUNCTION BLOCKS FOR NORMALLY UNDEFINED OPERATORS.
*
{R$UBA{DAC{STNDO{{{BINARY AT
{R$UBM{DAC{STNDO{{{BINARY AMPERSAND
{R$UBN{DAC{STNDO{{{BINARY NUMBER SIGN
{R$UBP{DAC{STNDO{{{BINARY PERCENT
{R$UBT{DAC{STNDO{{{BINARY NOT
{R$UUB{DAC{STNDO{{{UNARY VERTICAL BAR
{R$UUE{DAC{STNDO{{{UNARY EQUAL
{R$UUN{DAC{STNDO{{{UNARY NUMBER SIGN
{R$UUP{DAC{STNDO{{{UNARY PERCENT
{R$UUS{DAC{STNDO{{{UNARY SLASH
{R$UUX{DAC{STNDO{{{UNARY EXCLAMATION
{R$YYY{DAC{0{{{LAST RELOCATABLE LOCATION
*
* WORK AREAS FOR SUBSTR FUNCTION (S$SUB)
*
{SBSSV{DAC{0{{{SAVE THIRD ARGUMENT
*
* GLOBAL LOCATIONS USED IN SCAN PROCEDURE
*
{SCNBL{DAC{0{{{SET NON-ZERO IF SCANNED PAST BLANKS
{SCNCC{DAC{0{{{NON-ZERO TO SCAN CONTROL CARD NAME
{SCNGO{DAC{0{{{SET NON-ZERO TO SCAN GOTO FIELD
{SCNIL{DAC{0{{{LENGTH OF CURRENT INPUT IMAGE
{SCNPT{DAC{0{{{POINTER TO NEXT LOCATION IN R$CIM
{SCNRS{DAC{0{{{SET NON-ZERO TO SIGNAL RESCAN
{SCNTP{DAC{0{{{SAVE SYNTAX TYPE FROM LAST CALL
*
* WORK AREAS FOR SCAN PROCEDURE
*
{SCNSA{DAC{0{{{SAVE WA
{SCNSB{DAC{0{{{SAVE WB
{SCNSC{DAC{0{{{SAVE WC
{SCNSE{DAC{0{{{START OF CURRENT ELEMENT
{SCNOF{DAC{0{{{SAVE OFFSET
{{EJC{{{{
*
* WORK AREA USED BY SORTA, SORTC, SORTF, SORTH
*
{SRTDF{DAC{0{{{DATATYPE FIELD NAME
{SRTFD{DAC{0{{{FOUND DFBLK ADDRESS
{SRTFF{DAC{0{{{FOUND FIELD NAME
{SRTFO{DAC{0{{{OFFSET TO FIELD NAME
{SRTNR{DAC{0{{{NUMBER OF ROWS
{SRTOF{DAC{0{{{OFFSET WITHIN ROW TO SORT KEY
{SRTRT{DAC{0{{{ROOT OFFSET
{SRTS1{DAC{0{{{SAVE OFFSET 1
{SRTS2{DAC{0{{{SAVE OFFSET 2
{SRTSC{DAC{0{{{SAVE WC
{SRTSF{DAC{0{{{SORT ARRAY FIRST ROW OFFSET
{SRTSN{DAC{0{{{SAVE N
{SRTSO{DAC{0{{{OFFSET TO A(0)
{SRTSR{DAC{0{{{0 , NON-ZERO FOR SORT, RSORT
{SRTST{DAC{0{{{STRIDE FROM ONE ROW TO NEXT
{SRTWC{DAC{0{{{DUMP WC
*
* GLOBAL VALUE FOR INDICATING STAGE (SEE ERROR SECTION)
*
{STAGE{DAC{0{{{INITIAL VALUE = INITIAL COMPILE
*
* GLOBAL VALUES DEFINING EXTENT OF STATIC AREA (ALOST)
*
{STATB{DAC{0{{{START OF STATIC AREA
{STATE{DAC{0{{{END OF STATIC AREA
{{EJC{{{{
*
* GLOBAL STACK POINTER
*
{STBAS{DAC{0{{{POINTER PAST STACK BASE
*
* WORK AREAS FOR STOPR ROUTINE
*
{STPSI{DIC{+0{{{SAVE VALUE OF STCOUNT
{STPTI{DIC{+0{{{SAVE TIME ELAPSED
*
* GLOBAL VALUES FOR SETEXIT FUNCTION (S$STX)
*
{STXOF{DAC{0{{{FAILURE OFFSET
{STXVR{DAC{NULLS{{{VRBLK POINTER OR NULL
*
* WORK AREAS FOR TFIND PROCEDURE
*
{TFNSI{DIC{+0{{{NUMBER OF HEADERS
*
* GLOBAL VALUE FOR TIME KEEPING
*
{TIMSX{DIC{+0{{{TIME AT START OF EXECUTION
{TIMUP{DAC{0{{{SET WHEN TIME UP OCCURS
*
* WORK AREAS FOR XSCAN PROCEDURE
*
{XSCRT{DAC{0{{{SAVE RETURN CODE
{XSCWB{DAC{0{{{SAVE REGISTER WB
*
* GLOBAL VALUES FOR XSCAN AND XSCNI PROCEDURES
*
{XSOFS{DAC{0{{{OFFSET TO CURRENT LOCATION IN R$XSC
*
* LABEL TO MARK END OF WORK AREA
*
{YYYYY{DAC{0{{{
{{TTL{S{{{P I T B O L -- INITIALIZATION
*
* INITIALISATION
* THE FOLLOWING SECTION RECEIVES CONTROL FROM THE SYSTEM
* AT THE START OF A RUN WITH THE REGISTERS SET AS FOLLOWS.
*
* (XS) POINTS PAST STACK BASE
* (XR) POINTS TO FIRST WORD OF DATA AREA
* (XL) POINTS TO LAST WORD OF DATA AREA
*
{{SEC{{{{START OF PROGRAM SECTION
{{JSR{SYSTM{{{INITIALISE TIMER
*
* INITIALISE WORK AREA (ESSENTIAL FOR BATCHED RUNS)
*
{{MOV{R9{R7{{PRESERVE XR
{{MOV{#YYYYY{R6{{POINT TO END OF WORK AREA
{{SUB{#AAAAA{R6{{GET LENGTH OF WORK AREA
{{BTW{R6{{{CONVERT TO WORDS
{{LCT{R6{R6{{COUNT FOR LOOP
{{MOV{#AAAAA{R9{{SET UP INDEX REGISTER
*
* CLEAR WORK SPACE
*
{INI01{ZER{(R9)+{{{CLEAR A WORD
{{BCT{R6{INI01{{LOOP TILL DONE
{{MOV{#STNDO{R6{{UNDEFINED OPERATORS POINTER
{{MOV{#R$YYY{R8{{POINT TO TABLE END
{{SUB{#R$UBA{R8{{LENGTH OF UNDEF. OPERATORS TABLE
{{BTW{R8{{{CONVERT TO WORDS
{{LCT{R8{R8{{LOOP COUNTER
{{MOV{#R$UBA{R9{{SET UP XR
*
* SET CORRECT VALUE INTO UNDEFINED OPERATORS TABLE
*
{INI02{MOV{R6{(R9)+{{STORE VALUE
{{BCT{R8{INI02{{LOOP TILL ALL DONE
{{MOV{#NUM01{R6{{GET A 1
{{MOV{R6{CMPSN{{STATEMENT NO
{{MOV{R6{CSWFL{{NOFAIL
{{MOV{R6{CSWLS{{LIST
{{MOV{R6{KVINP{{INPUT
{{MOV{R6{KVOUP{{OUTPUT
{{MOV{R6{LSTPF{{NOTHING FOR LISTR YET
{{MOV{#INILN{R6{{INPUT IMAGE LENGTH
{{MOV{R6{CSWIN{{-IN72
{{MOV{#B$KVT{DMPKB{{DUMP
{{MOV{#TRBKV{DMPKT{{DUMP
{{MOV{#P$LEN{EVLIN{{EVAL
{{EJC{{{{
{{MOV{#NULLS{R6{{GET NULLSTRING POINTER
{{MOV{R6{KVRTN{{RETURN
{{MOV{R6{R$ETX{{ERRTEXT
{{MOV{R6{R$TTL{{TITLE FOR LISTING
{{MOV{R6{STXVR{{SETEXIT
{{STI{TIMSX{{{STORE TIME IN CORRECT PLACE
{{LDI{STLIM{{{GET DEFAULT STLIMIT
{{STI{KVSTL{{{STATEMENT LIMIT
{{STI{KVSTC{{{STATEMENT COUNT
{{MOV{R7{STATB{{STORE START ADRS OF STATIC
{{MOV{#4*E$SRS{RSMEM{{RESERVE MEMORY
{{MOV{SP{STBAS{{STORE STACK BASE
{{SSS{INISS{{{SAVE S-R STACK PTR
*
* NOW CONVERT FREE STORE PERCENTAGE TO A SUITABLE FACTOR
* FOR EASY TESTING IN ALLOC ROUTINE.
*
{{LDI{INTVH{{{GET 100
{{DVI{ALFSP{{{FORM 100 / ALFSP
{{STI{ALFSF{{{STORE THE FACTOR
*
* INITIALIZE VALUES FOR REAL CONVERSION ROUTINE
*
{{LCT{R7{#CFP$S{{LOAD COUNTER FOR SIGNIFICANT DIGITS
{{LDR{REAV1{{{LOAD 1.0
*
* LOOP TO COMPUTE 10**(MAX NUMBER SIGNIFICANT DIGITS)
*
{INI03{MLR{REAVT{{{* 10.0
{{BCT{R7{INI03{{LOOP TILL DONE
{{STR{GTSSC{{{STORE 10**(MAX SIG DIGITS)
{{LDR{REAP5{{{LOAD 0.5
{{DVR{GTSSC{{{COMPUTE 0.5*10**(MAX SIG DIGITS)
{{STR{GTSRN{{{STORE AS ROUNDING BIAS
{{ZER{R8{{{SET TO READ PARAMETERS
{{JSR{PRPAR{{{READ THEM
{{EJC{{{{
*
* NOW COMPUTE STARTING ADDRESS FOR DYNAMIC STORE AND IF
* NECESSARY REQUEST MORE MEMORY.
*
{{SUB{#4*E$SRS{R10{{ALLOW FOR RESERVE MEMORY
{{MOV{PRLEN{R6{{GET PRINT BUFFER LENGTH
{{ADD{#CFP$A{R6{{ADD NO. OF CHARS IN ALPHABET
{{ADD{#NSTMX{R6{{ADD CHARS FOR GTSTG BFR
{{CTB{R6{8{{CONVERT TO BYTES, ALLOWING A MARGIN
{{MOV{STATB{R9{{POINT TO STATIC BASE
{{ADD{R6{R9{{INCREMENT FOR ABOVE BUFFERS
{{ADD{#4*E$HNB{R9{{INCREMENT FOR HASH TABLE
{{ADD{#4*E$STS{R9{{BUMP FOR INITIAL STATIC BLOCK
{{JSR{SYSMX{{{GET MXLEN
{{MOV{R6{KVMXL{{PROVISIONALLY STORE AS MAXLNGTH
{{MOV{R6{MXLEN{{AND AS MXLEN
{{BGT{R9{R6{INI06{SKIP IF STATIC HI EXCEEDS MXLEN
{{MOV{R6{R9{{USE MXLEN INSTEAD
{{ICA{R9{{{MAKE BIGGER THAN MXLEN
*
* HERE TO STORE VALUES WHICH MARK INITIAL DIVISION
* OF DATA AREA INTO STATIC AND DYNAMIC
*
{INI06{MOV{R9{DNAMB{{DYNAMIC BASE ADRS
{{MOV{R9{DNAMP{{DYNAMIC PTR
{{BNZ{R6{INI07{{SKIP IF NON-ZERO MXLEN
{{DCA{R9{{{POINT A WORD IN FRONT
{{MOV{R9{KVMXL{{USE AS MAXLNGTH
{{MOV{R9{MXLEN{{AND AS MXLEN
{{EJC{{{{
*
* LOOP HERE IF NECESSARY TILL ENOUGH MEMORY OBTAINED
* SO THAT DNAME IS ABOVE DNAMB
*
{INI07{MOV{R10{DNAME{{STORE DYNAMIC END ADDRESS
{{BLT{DNAMB{R10{INI09{SKIP IF HIGH ENOUGH
{{JSR{SYSMM{{{REQUEST MORE MEMORY
{{WTB{R9{{{GET AS BAUS (SGD05)
{{ADD{R9{R10{{BUMP BY AMOUNT OBTAINED
{{BNZ{R9{INI07{{TRY AGAIN
{{MOV{#ENDMO{R9{{POINT TO FAILURE MESSAGE
{{MOV{ENDML{R6{{MESSAGE LENGTH
{{JSR{SYSPR{{{PRINT IT (PRTST NOT YET USABLE)
{{PPM{{{{SHOULD NOT FAIL
{{JSR{SYSEJ{{{PACK UP (STOPR NOT YET USABLE)
*
* INITIALISE PRINT BUFFER WITH BLANK WORDS
*
{INI09{MOV{PRLEN{R8{{NO. OF CHARS IN PRINT BFR
{{MOV{STATB{R9{{POINT TO STATIC AGAIN
{{MOV{R9{PRBUF{{PRINT BFR IS PUT AT STATIC START
{{MOV{#B$SCL{(R9)+{{STORE STRING TYPE CODE
{{MOV{R8{(R9)+{{AND STRING LENGTH
{{CTW{R8{0{{GET NUMBER OF WORDS IN BUFFER
{{MOV{R8{PRLNW{{STORE FOR BUFFER CLEAR
{{LCT{R8{R8{{WORDS TO CLEAR
*
* LOOP TO CLEAR BUFFER
*
{INI10{MOV{NULLW{(R9)+{{STORE BLANK
{{BCT{R8{INI10{{LOOP
*
* INITIALIZE NUMBER OF HASH HEADERS
*
{{MOV{#E$HNB{R6{{GET NUMBER OF HASH HEADERS
{{MTI{R6{{{CONVERT TO INTEGER
{{STI{HSHNB{{{STORE FOR USE BY GTNVR PROCEDURE
{{LCT{R6{R6{{COUNTER FOR CLEARING HASH TABLE
{{MOV{R9{HSHTB{{POINTER TO HASH TABLE
*
* LOOP TO CLEAR HASH TABLE
*
{INI11{ZER{(R9)+{{{BLANK A WORD
{{BCT{R6{INI11{{LOOP
{{MOV{R9{HSHTE{{END OF HASH TABLE ADRS IS KEPT
*
* ALLOCATE WORK AREA FOR GTSTG CONVERSION PROCEDURE
*
{{MOV{#NSTMX{R6{{GET MAX NUM CHARS IN OUTPUT NUMBER
{{CTB{R6{SCSI${{NO OF BYTES NEEDED
{{MOV{R9{GTSWK{{STORE BFR ADRS
{{ADD{R6{R9{{BUMP FOR WORK BFR
{{EJC{{{{
*
* BUILD ALPHABET STRING FOR ALPHABET KEYWORD AND REPLACE
*
{{MOV{R9{KVALP{{SAVE ALPHABET POINTER
{{MOV{#B$SCL{(R9){{STRING BLK TYPE
{{MOV{#CFP$A{R8{{NO OF CHARS IN ALPHABET
{{MOV{R8{4*SCLEN(R9){{STORE AS STRING LENGTH
{{MOV{R8{R7{{COPY CHAR COUNT
{{CTB{R7{SCSI${{NO. OF BYTES NEEDED
{{ADD{R9{R7{{CURRENT END ADDRESS FOR STATIC
{{MOV{R7{STATE{{STORE STATIC END ADRS
{{LCT{R8{R8{{LOOP COUNTER
{{PSC{R9{{{POINT TO CHARS OF STRING
{{ZER{R7{{{SET INITIAL CHARACTER VALUE
*
* LOOP TO ENTER CHARACTER CODES IN ORDER
*
{INI12{SCH{R7{(R9)+{{STORE NEXT CODE
{{ICV{R7{{{BUMP CODE VALUE
{{BCT{R8{INI12{{LOOP TILL ALL STORED
{{CSC{R9{{{COMPLETE STORE CHARACTERS
*
* INITIALIZE VARIABLE BLOCKS FOR INPUT AND OUTPUT
*
{{MOV{#V$INP{R10{{POINT TO STRING /INPUT/
{{MOV{#TRTIN{R7{{TRBLK TYPE FOR INPUT
{{JSR{INOUT{{{PERFORM INPUT ASSOCIATION
{{MOV{#V$OUP{R10{{POINT TO STRING /OUTPUT/
{{MOV{#TRTOU{R7{{TRBLK TYPE FOR OUTPUT
{{JSR{INOUT{{{PERFORM OUTPUT ASSOCIATION
{{MOV{INITR{R8{{TERMINAL FLAG
{{BZE{R8{INI13{{SKIP IF NO TERMINAL
{{JSR{PRPAR{{{ASSOCIATE TERMINAL
{{EJC{{{{
*
* CHECK FOR EXPIRY DATE
*
{INI13{JSR{SYSDC{{{CALL DATE CHECK
{{MOV{SP{FLPTR{{IN CASE STACK OVERFLOWS IN COMPILER
*
* NOW COMPILE SOURCE INPUT CODE
*
{{JSR{CMPIL{{{CALL COMPILER
{{MOV{R9{R$COD{{SET PTR TO FIRST CODE BLOCK
{{MOV{#NULLS{R$TTL{{FORGET TITLE (REG04)
{{MOV{#NULLS{R$STL{{FORGET SUB-TITLE (REG04)
{{ZER{R$CIM{{{FORGET COMPILER INPUT IMAGE
{{ZER{R10{{{CLEAR DUD VALUE
{{ZER{R7{{{DONT SHIFT DYNAMIC STORE UP
{{JSR{GBCOL{{{CLEAR GARBAGE LEFT FROM COMPILE
{{BNZ{CPSTS{INIX0{{SKIP IF NO LISTING OF COMP STATS
{{JSR{PRTPG{{{EJECT PAGE
*
* PRINT COMPILE STATISTICS
*
{{MOV{DNAMP{R6{{NEXT AVAILABLE LOC
{{SUB{STATB{R6{{MINUS START
{{BTW{R6{{{CONVERT TO WORDS
{{MTI{R6{{{CONVERT TO INTEGER
{{MOV{#ENCM1{R9{{POINT TO /MEMORY USED (WORDS)/
{{JSR{PRTMI{{{PRINT MESSAGE
{{MOV{DNAME{R6{{END OF MEMORY
{{SUB{DNAMP{R6{{MINUS NEXT AVAILABLE LOC
{{BTW{R6{{{CONVERT TO WORDS
{{MTI{R6{{{CONVERT TO INTEGER
{{MOV{#ENCM2{R9{{POINT TO /MEMORY AVAILABLE (WORDS)/
{{JSR{PRTMI{{{PRINT LINE
{{MTI{CMERC{{{GET COUNT OF ERRORS AS INTEGER
{{MOV{#ENCM3{R9{{POINT TO /COMPILE ERRORS/
{{JSR{PRTMI{{{PRINT IT
{{MTI{GBCNT{{{GARBAGE COLLECTION COUNT
{{SBI{INTV1{{{ADJUST FOR UNAVOIDABLE COLLECT
{{MOV{#STPM5{R9{{POINT TO /STORAGE REGENERATIONS/
{{JSR{PRTMI{{{PRINT GBCOL COUNT
{{JSR{SYSTM{{{GET TIME
{{SBI{TIMSX{{{GET COMPILATION TIME
{{MOV{#ENCM4{R9{{POINT TO COMPILATION TIME (MSEC)/
{{JSR{PRTMI{{{PRINT MESSAGE
{{ADD{#NUM05{LSTLC{{BUMP LINE COUNT
{{BZE{HEADP{INIX0{{NO EJECT IF NOTHING PRINTED (SDG11)
{{JSR{PRTPG{{{EJECT PRINTER
{{EJC{{{{
*
* PREPARE NOW TO START EXECUTION
*
* SET DEFAULT INPUT RECORD LENGTH
*
{INIX0{BGT{CSWIN{#INILN{INIX1{SKIP IF NOT DEFAULT -IN72 USED
{{MOV{#INILS{CSWIN{{ELSE USE DEFAULT RECORD LENGTH
*
* RESET TIMER
*
{INIX1{JSR{SYSTM{{{GET TIME AGAIN
{{STI{TIMSX{{{STORE FOR END RUN PROCESSING
{{ADD{CSWEX{NOXEQ{{ADD -NOEXECUTE FLAG
{{BNZ{NOXEQ{INIX2{{JUMP IF EXECUTION SUPPRESSED
{{ZER{GBCNT{{{INITIALISE COLLECT COUNT
{{JSR{SYSBX{{{CALL BEFORE STARTING EXECUTION
*
* MERGE WHEN LISTING FILE SET FOR EXECUTION
*
{INIY0{MNZ{HEADP{{{MARK HEADERS OUT REGARDLESS
{{ZER{-(SP){{{SET FAILURE LOCATION ON STACK
{{MOV{SP{FLPTR{{SAVE PTR TO FAILURE OFFSET WORD
{{MOV{R$COD{R9{{LOAD PTR TO ENTRY CODE BLOCK
{{MOV{#STGXT{STAGE{{SET STAGE FOR EXECUTE TIME
{{MOV{CMPSN{PFNTE{{COPY STMTS COMPILED COUNT IN CASE
{{JSR{SYSTM{{{TIME YET AGAIN
{{STI{PFSTM{{{
{{BRI{(R9){{{START XEQ WITH FIRST STATEMENT
*
* HERE IF EXECUTION IS SUPPRESSED
*
{INIX2{JSR{PRTNL{{{PRINT A BLANK LINE
{{MOV{#ENCM5{R9{{POINT TO /EXECUTION SUPPRESSED/
{{JSR{PRTST{{{PRINT STRING
{{JSR{PRTNL{{{OUTPUT LINE
{{ZER{R6{{{SET ABEND VALUE TO ZERO
{{MOV{#NINI9{R7{{SET SPECIAL CODE VALUE
{{JSR{SYSEJ{{{END OF JOB, EXIT TO SYSTEM
{{TTL{S{{{P I T B O L -- SNOBOL4 OPERATOR ROUTINES
*
* THIS SECTION INCLUDES ALL ROUTINES WHICH CAN BE ACCESSED
* DIRECTLY FROM THE GENERATED CODE EXCEPT SYSTEM FUNCTIONS.
*
* ALL ROUTINES IN THIS SECTION START WITH A LABEL OF THE
* FORM O$XXX WHERE XXX IS THREE LETTERS. THE GENERATED CODE
* CONTAINS A POINTER TO THE APPROPRIATE ENTRY LABEL.
*
* SINCE THE GENERAL FORM OF THE GENERATED CODE CONSISTS OF
* POINTERS TO BLOCKS WHOSE FIRST WORD IS THE ADDRESS OF THE
* ACTUAL ENTRY POINT LABEL (O$XXX).
*
* THESE ROUTINES ARE IN ALPHABETICAL ORDER BY THEIR
* ENTRY LABEL NAMES (I.E. BY THE XXX OF THE O$XXX NAME)
*
* THESE ROUTINES RECEIVE CONTROL AS FOLLOWS
*
* (CP) POINTER TO NEXT CODE WORD
* (XS) CURRENT STACK POINTER
{{EJC{{{{
*
* BINARY PLUS (ADDITION)
*
{O$ADD{ENT{{{{ENTRY POINT
{{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS
{{ERR{001{ADDITION{{LEFT OPERAND IS NOT NUMERIC
{{ERR{002{ADDITION{{RIGHT OPERAND IS NOT NUMERIC
{{PPM{OADD1{{{JUMP IF REAL OPERANDS
*
* HERE TO ADD TWO INTEGERS
*
{{ADI{4*ICVAL(R10){{{ADD RIGHT OPERAND TO LEFT
{{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW
{{ERB{003{ADDITION{{CAUSED INTEGER OVERFLOW
*
* HERE TO ADD TWO REALS
*
{OADD1{ADR{4*RCVAL(R10){{{ADD RIGHT OPERAND TO LEFT
{{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW
{{ERB{261{ADDITION{{CAUSED REAL OVERFLOW
{{EJC{{{{
*
* UNARY PLUS (AFFIRMATION)
*
{O$AFF{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD OPERAND
{{JSR{GTNUM{{{CONVERT TO NUMERIC
{{ERR{004{AFFIRMATION{{OPERAND IS NOT NUMERIC
{{BRN{EXIXR{{{RETURN IF CONVERTED TO NUMERIC
{{EJC{{{{
*
* BINARY BAR (ALTERNATION)
*
{O$ALT{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD RIGHT OPERAND
{{JSR{GTPAT{{{CONVERT TO PATTERN
{{ERR{005{ALTERNATION{{RIGHT OPERAND IS NOT PATTERN
*
* MERGE HERE FROM SPECIAL (LEFT ALTERNATION) CASE
*
{OALT1{MOV{#P$ALT{R7{{SET PCODE FOR ALTERNATIVE NODE
{{JSR{PBILD{{{BUILD ALTERNATIVE NODE
{{MOV{R9{R10{{SAVE ADDRESS OF ALTERNATIVE NODE
{{MOV{(SP)+{R9{{LOAD LEFT OPERAND
{{JSR{GTPAT{{{CONVERT TO PATTERN
{{ERR{006{ALTERNATION{{LEFT OPERAND IS NOT PATTERN
{{BEQ{R9{#P$ALT{OALT2{JUMP IF LEFT ARG IS ALTERNATION
{{MOV{R9{4*PTHEN(R10){{SET LEFT OPERAND AS SUCCESSOR
{{MOV{R10{R9{{MOVE RESULT TO PROPER REGISTER
{{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
*
* COME HERE IF LEFT ARGUMENT IS ITSELF AN ALTERNATION
*
* THE RESULT IS MORE EFFICIENT IF WE MAKE THE REPLACEMENT
*
* (A / B) / C = A / (B / C)
*
{OALT2{MOV{4*PARM1(R9){4*PTHEN(R10){{BUILD THE (B / C) NODE
{{MOV{4*PTHEN(R9){-(SP){{SET A AS NEW LEFT ARG
{{MOV{R10{R9{{SET (B / C) AS NEW RIGHT ARG
{{BRN{OALT1{{{MERGE BACK TO BUILD A / (B / C)
{{EJC{{{{
*
* ARRAY REFERENCE (MULTIPLE SUBSCRIPTS, BY NAME)
*
{O$AMN{ENT{{{{ENTRY POINT
{{LCW{R9{{{LOAD NUMBER OF SUBSCRIPTS
{{MOV{R9{R7{{SET FLAG FOR BY NAME
{{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE
{{EJC{{{{
*
* ARRAY REFERENCE (MULTIPLE SUBSCRIPTS, BY VALUE)
*
{O$AMV{ENT{{{{ENTRY POINT
{{LCW{R9{{{LOAD NUMBER OF SUBSCRIPTS
{{ZER{R7{{{SET FLAG FOR BY VALUE
{{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE
{{EJC{{{{
*
* ARRAY REFERENCE (ONE SUBSCRIPT, BY NAME)
*
{O$AON{ENT{{{{ENTRY POINT
{{MOV{(SP){R9{{LOAD SUBSCRIPT VALUE
{{MOV{4*1(SP){R10{{LOAD ARRAY VALUE
{{MOV{(R10){R6{{LOAD FIRST WORD OF ARRAY OPERAND
{{BEQ{R6{#B$VCT{OAON2{JUMP IF VECTOR REFERENCE
{{BEQ{R6{#B$TBT{OAON3{JUMP IF TABLE REFERENCE
*
* HERE TO USE CENTRAL ARRAY REFERENCE ROUTINE
*
{OAON1{MOV{#NUM01{R9{{SET NUMBER OF SUBSCRIPTS TO ONE
{{MOV{R9{R7{{SET FLAG FOR BY NAME
{{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE
*
* HERE IF WE HAVE A VECTOR REFERENCE
*
{OAON2{BNE{(R9){#B$ICL{OAON1{USE LONG ROUTINE IF NOT INTEGER
{{LDI{4*ICVAL(R9){{{LOAD INTEGER SUBSCRIPT VALUE
{{MFI{R6{EXFAL{{COPY AS ADDRESS INT, FAIL IF OVFLO
{{BZE{R6{EXFAL{{FAIL IF ZERO
{{ADD{#VCVLB{R6{{COMPUTE OFFSET IN WORDS
{{WTB{R6{{{CONVERT TO BYTES
{{MOV{R6{(SP){{COMPLETE NAME ON STACK
{{BLT{R6{4*VCLEN(R10){EXITS{EXIT IF SUBSCRIPT NOT TOO LARGE
{{BRN{EXFAL{{{ELSE FAIL
*
* HERE FOR TABLE REFERENCE
*
{OAON3{MNZ{R7{{{SET FLAG FOR NAME REFERENCE
{{JSR{TFIND{{{LOCATE/CREATE TABLE ELEMENT
{{PPM{EXFAL{{{FAIL IF ACCESS FAILS
{{MOV{R10{4*1(SP){{STORE NAME BASE ON STACK
{{MOV{R6{(SP){{STORE NAME OFFSET ON STACK
{{BRN{EXITS{{{EXIT WITH RESULT ON STACK
{{EJC{{{{
*
* ARRAY REFERENCE (ONE SUBSCRIPT, BY VALUE)
*
{O$AOV{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD SUBSCRIPT VALUE
{{MOV{(SP)+{R10{{LOAD ARRAY VALUE
{{MOV{(R10){R6{{LOAD FIRST WORD OF ARRAY OPERAND
{{BEQ{R6{#B$VCT{OAOV2{JUMP IF VECTOR REFERENCE
{{BEQ{R6{#B$TBT{OAOV3{JUMP IF TABLE REFERENCE
*
* HERE TO USE CENTRAL ARRAY REFERENCE ROUTINE
*
{OAOV1{MOV{R10{-(SP){{RESTACK ARRAY VALUE
{{MOV{R9{-(SP){{RESTACK SUBSCRIPT
{{MOV{#NUM01{R9{{SET NUMBER OF SUBSCRIPTS TO ONE
{{ZER{R7{{{SET FLAG FOR VALUE CALL
{{BRN{ARREF{{{JUMP TO ARRAY REFERENCE ROUTINE
*
* HERE IF WE HAVE A VECTOR REFERENCE
*
{OAOV2{BNE{(R9){#B$ICL{OAOV1{USE LONG ROUTINE IF NOT INTEGER
{{LDI{4*ICVAL(R9){{{LOAD INTEGER SUBSCRIPT VALUE
{{MFI{R6{EXFAL{{MOVE AS ONE WORD INT, FAIL IF OVFLO
{{BZE{R6{EXFAL{{FAIL IF ZERO
{{ADD{#VCVLB{R6{{COMPUTE OFFSET IN WORDS
{{WTB{R6{{{CONVERT TO BYTES
{{BGE{R6{4*VCLEN(R10){EXFAL{FAIL IF SUBSCRIPT TOO LARGE
{{JSR{ACESS{{{ACCESS VALUE
{{PPM{EXFAL{{{FAIL IF ACCESS FAILS
{{BRN{EXIXR{{{ELSE RETURN VALUE TO CALLER
*
* HERE FOR TABLE REFERENCE BY VALUE
*
{OAOV3{ZER{R7{{{SET FLAG FOR VALUE REFERENCE
{{JSR{TFIND{{{CALL TABLE SEARCH ROUTINE
{{PPM{EXFAL{{{FAIL IF ACCESS FAILS
{{BRN{EXIXR{{{EXIT WITH RESULT IN XR
{{EJC{{{{
*
* ASSIGNMENT
*
{O$ASS{ENT{{{{ENTRY POINT
*
* O$RPL (PATTERN REPLACEMENT) MERGES HERE
*
{OASS0{MOV{(SP)+{R7{{LOAD VALUE TO BE ASSIGNED
{{MOV{(SP)+{R6{{LOAD NAME OFFSET
{{MOV{(SP){R10{{LOAD NAME BASE
{{MOV{R7{(SP){{STORE ASSIGNED VALUE AS RESULT
{{JSR{ASIGN{{{PERFORM ASSIGNMENT
{{PPM{EXFAL{{{FAIL IF ASSIGNMENT FAILS
{{BRN{EXITS{{{EXIT WITH RESULT ON STACK
{{EJC{{{{
*
* COMPILATION ERROR
*
{O$CER{ENT{{{{ENTRY POINT
{{ERB{007{COMPILATION{{ERROR ENCOUNTERED DURING EXECUTION
{{EJC{{{{
*
* UNARY AT (CURSOR ASSIGNMENT)
*
{O$CAS{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R8{{LOAD NAME OFFSET (PARM2)
{{MOV{(SP)+{R9{{LOAD NAME BASE (PARM1)
{{MOV{#P$CAS{R7{{SET PCODE FOR CURSOR ASSIGNMENT
{{JSR{PBILD{{{BUILD NODE
{{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
{{EJC{{{{
*
* CONCATENATION
*
{O$CNC{ENT{{{{ENTRY POINT
{{MOV{(SP){R9{{LOAD RIGHT ARGUMENT
{{BEQ{R9{#NULLS{OCNC3{JUMP IF RIGHT ARG IS NULL
{{MOV{4*1(SP){R10{{LOAD LEFT ARGUMENT
{{BEQ{R10{#NULLS{OCNC4{JUMP IF LEFT ARGUMENT IS NULL
{{MOV{#B$SCL{R6{{GET CONSTANT TO TEST FOR STRING
{{BNE{R6{(R10){OCNC2{JUMP IF LEFT ARG NOT A STRING
{{BNE{R6{(R9){OCNC2{JUMP IF RIGHT ARG NOT A STRING
*
* MERGE HERE TO CONCATENATE TWO STRINGS
*
{OCNC1{MOV{4*SCLEN(R10){R6{{LOAD LEFT ARGUMENT LENGTH
{{ADD{4*SCLEN(R9){R6{{COMPUTE RESULT LENGTH
{{JSR{ALOCS{{{ALLOCATE SCBLK FOR RESULT
{{MOV{R9{4*1(SP){{STORE RESULT PTR OVER LEFT ARGUMENT
{{PSC{R9{{{PREPARE TO STORE CHARS OF RESULT
{{MOV{4*SCLEN(R10){R6{{GET NUMBER OF CHARS IN LEFT ARG
{{PLC{R10{{{PREPARE TO LOAD LEFT ARG CHARS
{{MVC{{{{MOVE CHARACTERS OF LEFT ARGUMENT
{{MOV{(SP)+{R10{{LOAD RIGHT ARG POINTER, POP STACK
{{MOV{4*SCLEN(R10){R6{{LOAD NUMBER OF CHARS IN RIGHT ARG
{{PLC{R10{{{PREPARE TO LOAD RIGHT ARG CHARS
{{MVC{{{{MOVE CHARACTERS OF RIGHT ARGUMENT
{{BRN{EXITS{{{EXIT WITH RESULT ON STACK
*
* COME HERE IF ARGUMENTS ARE NOT BOTH STRINGS
*
{OCNC2{JSR{GTSTG{{{CONVERT RIGHT ARG TO STRING
{{PPM{OCNC5{{{JUMP IF RIGHT ARG IS NOT STRING
{{MOV{R9{R10{{SAVE RIGHT ARG PTR
{{JSR{GTSTG{{{CONVERT LEFT ARG TO STRING
{{PPM{OCNC6{{{JUMP IF LEFT ARG IS NOT A STRING
{{MOV{R9{-(SP){{STACK LEFT ARGUMENT
{{MOV{R10{-(SP){{STACK RIGHT ARGUMENT
{{MOV{R9{R10{{MOVE LEFT ARG TO PROPER REG
{{MOV{(SP){R9{{MOVE RIGHT ARG TO PROPER REG
{{BRN{OCNC1{{{MERGE BACK TO CONCATENATE STRINGS
{{EJC{{{{
*
* CONCATENATION (CONTINUED)
*
* COME HERE FOR NULL RIGHT ARGUMENT
*
{OCNC3{ICA{SP{{{REMOVE RIGHT ARG FROM STACK
{{BRN{EXITS{{{RETURN WITH LEFT ARGUMENT ON STACK
*
* HERE FOR NULL LEFT ARGUMENT
*
{OCNC4{ICA{SP{{{UNSTACK ONE ARGUMENT
{{MOV{R9{(SP){{STORE RIGHT ARGUMENT
{{BRN{EXITS{{{EXIT WITH RESULT ON STACK
*
* HERE IF RIGHT ARGUMENT IS NOT A STRING
*
{OCNC5{MOV{R9{R10{{MOVE RIGHT ARGUMENT PTR
{{MOV{(SP)+{R9{{LOAD LEFT ARG POINTER
*
* MERGE HERE WHEN LEFT ARGUMENT IS NOT A STRING
*
{OCNC6{JSR{GTPAT{{{CONVERT LEFT ARG TO PATTERN
{{ERR{008{CONCATENATION{{LEFT OPND IS NOT STRING OR PATTERN
{{MOV{R9{-(SP){{SAVE RESULT ON STACK
{{MOV{R10{R9{{POINT TO RIGHT OPERAND
{{JSR{GTPAT{{{CONVERT TO PATTERN
{{ERR{009{CONCATENATION{{RIGHT OPD IS NOT STRING OR PATTERN
{{MOV{R9{R10{{MOVE FOR PCONC
{{MOV{(SP)+{R9{{RELOAD LEFT OPERAND PTR
{{JSR{PCONC{{{CONCATENATE PATTERNS
{{BRN{EXIXR{{{EXIT WITH RESULT IN XR
{{EJC{{{{
*
* COMPLEMENTATION
*
{O$COM{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD OPERAND
{{MOV{(R9){R6{{LOAD TYPE WORD
*
* MERGE BACK HERE AFTER CONVERSION
*
{OCOM1{BEQ{R6{#B$ICL{OCOM2{JUMP IF INTEGER
{{BEQ{R6{#B$RCL{OCOM3{JUMP IF REAL
{{JSR{GTNUM{{{ELSE CONVERT TO NUMERIC
{{ERR{010{COMPLEMENTATION{{OPERAND IS NOT NUMERIC
{{BRN{OCOM1{{{BACK TO CHECK CASES
*
* HERE TO COMPLEMENT INTEGER
*
{OCOM2{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE
{{NGI{{{{NEGATE
{{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW
{{ERB{011{COMPLEMENTATION{{CAUSED INTEGER OVERFLOW
*
* HERE TO COMPLEMENT REAL
*
{OCOM3{LDR{4*RCVAL(R9){{{LOAD REAL VALUE
{{NGR{{{{NEGATE
{{BRN{EXREA{{{RETURN REAL RESULT
{{EJC{{{{
*
* BINARY SLASH (DIVISION)
*
{O$DVD{ENT{{{{ENTRY POINT
{{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS
{{ERR{012{DIVISION{{LEFT OPERAND IS NOT NUMERIC
{{ERR{013{DIVISION{{RIGHT OPERAND IS NOT NUMERIC
{{PPM{ODVD2{{{JUMP IF REAL OPERANDS
*
* HERE TO DIVIDE TWO INTEGERS
*
{{DVI{4*ICVAL(R10){{{DIVIDE LEFT OPERAND BY RIGHT
{{INO{EXINT{{{RESULT OK IF NO OVERFLOW
{{ERB{014{DIVISION{{CAUSED INTEGER OVERFLOW
*
* HERE TO DIVIDE TWO REALS
*
{ODVD2{DVR{4*RCVAL(R10){{{DIVIDE LEFT OPERAND BY RIGHT
{{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW
{{ERB{262{DIVISION{{CAUSED REAL OVERFLOW
{{EJC{{{{
*
* EXPONENTIATION
*
{O$EXP{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD EXPONENT
{{JSR{GTNUM{{{CONVERT TO NUMBER
{{ERR{015{EXPONENTIATION{{RIGHT OPERAND IS NOT NUMERIC
{{BNE{R6{#B$ICL{OEXP7{JUMP IF REAL
{{MOV{R9{R10{{MOVE EXPONENT
{{MOV{(SP)+{R9{{LOAD BASE
{{JSR{GTNUM{{{CONVERT TO NUMERIC
{{ERR{016{EXPONENTIATION{{LEFT OPERAND IS NOT NUMERIC
{{LDI{4*ICVAL(R10){{{LOAD EXPONENT
{{ILT{OEXP8{{{ERROR IF NEGATIVE EXPONENT
{{BEQ{R6{#B$RCL{OEXP3{JUMP IF BASE IS REAL
*
* HERE TO EXPONENTIATE AN INTEGER
*
{{MFI{R6{OEXP2{{CONVERT EXPONENT TO 1 WORD INTEGER
{{LCT{R6{R6{{SET LOOP COUNTER
{{LDI{INTV1{{{LOAD INITIAL VALUE OF 1
{{BNZ{R6{OEXP1{{JUMP IF NON-ZERO EXPONENT
{{INE{EXINT{{{GIVE ZERO AS RESULT FOR NONZERO**0
{{BRN{OEXP4{{{ELSE ERROR OF 0**0
*
* LOOP TO PERFORM EXPONENTIATION
*
{OEXP1{MLI{4*ICVAL(R9){{{MULTIPLY BY BASE
{{IOV{OEXP2{{{JUMP IF OVERFLOW
{{BCT{R6{OEXP1{{LOOP BACK TILL COMPUTATION COMPLETE
{{BRN{EXINT{{{THEN RETURN INTEGER RESULT
*
* HERE IF INTEGER OVERFLOW
*
{OEXP2{ERB{017{EXPONENTIATION{{CAUSED INTEGER OVERFLOW
{{EJC{{{{
*
* EXPONENTIATION (CONTINUED)
*
* HERE TO EXPONENTIATE A REAL
*
{OEXP3{MFI{R6{OEXP6{{CONVERT EXPONENT TO ONE WORD
{{LCT{R6{R6{{SET LOOP COUNTER
{{LDR{REAV1{{{LOAD 1.0 AS INITIAL VALUE
{{BNZ{R6{OEXP5{{JUMP IF NON-ZERO EXPONENT
{{RNE{EXREA{{{RETURN 1.0 IF NONZERO**ZERO
*
* HERE FOR ERROR OF 0**0 OR 0.0**0
*
{OEXP4{ERB{018{EXPONENTIATION{{RESULT IS UNDEFINED
*
* LOOP TO PERFORM EXPONENTIATION
*
{OEXP5{MLR{4*RCVAL(R9){{{MULTIPLY BY BASE
{{ROV{OEXP6{{{JUMP IF OVERFLOW
{{BCT{R6{OEXP5{{LOOP TILL COMPUTATION COMPLETE
{{BRN{EXREA{{{THEN RETURN REAL RESULT
*
* HERE IF REAL OVERFLOW
*
{OEXP6{ERB{266{EXPONENTIATION{{CAUSED REAL OVERFLOW
*
* HERE IF REAL EXPONENT
*
{OEXP7{ERB{267{EXPONENTIATION{{RIGHT OPERAND IS REAL NOT INTEGER
*
* HERE FOR NEGATIVE EXPONENT
*
{OEXP8{ERB{019{EXPONENTIATION{{RIGHT OPERAND IS NEGATIVE
{{EJC{{{{
*
* FAILURE IN EXPRESSION EVALUATION
*
* THIS ENTRY POINT IS USED IF THE EVALUATION OF AN
* EXPRESSION, INITIATED BY THE EVALX PROCEDURE, FAILS.
* CONTROL IS RETURNED TO AN APPROPRIATE POINT IN EVALX.
*
{O$FEX{ENT{{{{ENTRY POINT
{{BRN{EVLX6{{{JUMP TO FAILURE LOC IN EVALX
{{EJC{{{{
*
* FAILURE DURING EVALUATION OF A COMPLEX OR DIRECT GOTO
*
{O$FIF{ENT{{{{ENTRY POINT
{{ERB{020{GOTO{{EVALUATION FAILURE
{{EJC{{{{
*
* FUNCTION CALL (MORE THAN ONE ARGUMENT)
*
{O$FNC{ENT{{{{ENTRY POINT
{{LCW{R6{{{LOAD NUMBER OF ARGUMENTS
{{LCW{R9{{{LOAD FUNCTION VRBLK POINTER
{{MOV{4*VRFNC(R9){R10{{LOAD FUNCTION POINTER
{{BNE{R6{4*FARGS(R10){CFUNC{USE CENTRAL ROUTINE IF WRONG NUM
{{BRI{(R10){{{JUMP TO FUNCTION IF ARG COUNT OK
{{EJC{{{{
*
* FUNCTION NAME ERROR
*
{O$FNE{ENT{{{{ENTRY POINT
{{LCW{R6{{{GET NEXT CODE WORD
{{BNE{R6{#ORNM${OFNE1{FAIL IF NOT EVALUATING EXPRESSION
{{BZE{4*2(SP){EVLX3{{OK IF EXPR. WAS WANTED BY VALUE
*
* HERE FOR ERROR
*
{OFNE1{ERB{021{FUNCTION{{CALLED BY NAME RETURNED A VALUE
{{EJC{{{{
*
* FUNCTION CALL (SINGLE ARGUMENT)
*
{O$FNS{ENT{{{{ENTRY POINT
{{LCW{R9{{{LOAD FUNCTION VRBLK POINTER
{{MOV{#NUM01{R6{{SET NUMBER OF ARGUMENTS TO ONE
{{MOV{4*VRFNC(R9){R10{{LOAD FUNCTION POINTER
{{BNE{R6{4*FARGS(R10){CFUNC{USE CENTRAL ROUTINE IF WRONG NUM
{{BRI{(R10){{{JUMP TO FUNCTION IF ARG COUNT OK
{{EJC{{{{
* CALL TO UNDEFINED FUNCTION
*
{O$FUN{ENT{{{{ENTRY POINT
{{ERB{022{UNDEFINED{{FUNCTION CALLED
{{EJC{{{{
*
* EXECUTE COMPLEX GOTO
*
{O$GOC{ENT{{{{ENTRY POINT
{{MOV{4*1(SP){R9{{LOAD NAME BASE POINTER
{{BHI{R9{STATE{OGOC1{JUMP IF NOT NATURAL VARIABLE
{{ADD{#4*VRTRA{R9{{ELSE POINT TO VRTRA FIELD
{{BRI{(R9){{{AND JUMP THROUGH IT
*
* HERE IF GOTO OPERAND IS NOT NATURAL VARIABLE
*
{OGOC1{ERB{023{GOTO{{OPERAND IS NOT A NATURAL VARIABLE
{{EJC{{{{
*
* EXECUTE DIRECT GOTO
*
{O$GOD{ENT{{{{ENTRY POINT
{{MOV{(SP){R9{{LOAD OPERAND
{{MOV{(R9){R6{{LOAD FIRST WORD
{{BEQ{R6{#B$CDS{BCDS0{JUMP IF CODE BLOCK TO CODE ROUTINE
{{BEQ{R6{#B$CDC{BCDC0{JUMP IF CODE BLOCK TO CODE ROUTINE
{{ERB{024{GOTO{{OPERAND IN DIRECT GOTO IS NOT CODE
{{EJC{{{{
*
* SET GOTO FAILURE TRAP
*
* THIS ROUTINE IS EXECUTED AT THE START OF A COMPLEX OR
* DIRECT FAILURE GOTO TO TRAP A SUBSEQUENT FAIL (SEE EXFAL)
*
{O$GOF{ENT{{{{ENTRY POINT
{{MOV{FLPTR{R9{{POINT TO FAIL OFFSET ON STACK
{{ICA{(R9){{{POINT FAILURE TO O$FIF WORD
{{ICP{{{{POINT TO NEXT CODE WORD
{{BRN{EXITS{{{EXIT TO CONTINUE
{{EJC{{{{
*
* BINARY DOLLAR (IMMEDIATE ASSIGNMENT)
*
* THE PATTERN BUILT BY BINARY DOLLAR IS A COMPOUND PATTERN.
* SEE DESCRIPTION AT START OF PATTERN MATCH SECTION FOR
* DETAILS OF THE STRUCTURE WHICH IS CONSTRUCTED.
*
{O$IMA{ENT{{{{ENTRY POINT
{{MOV{#P$IMC{R7{{SET PCODE FOR LAST NODE
{{MOV{(SP)+{R8{{POP NAME OFFSET (PARM2)
{{MOV{(SP)+{R9{{POP NAME BASE (PARM1)
{{JSR{PBILD{{{BUILD P$IMC NODE
{{MOV{R9{R10{{SAVE PTR TO NODE
{{MOV{(SP){R9{{LOAD LEFT ARGUMENT
{{JSR{GTPAT{{{CONVERT TO PATTERN
{{ERR{025{IMMEDIATE{{ASSIGNMENT LEFT OPERAND IS NOT PATTERN
{{MOV{R9{(SP){{SAVE PTR TO LEFT OPERAND PATTERN
{{MOV{#P$IMA{R7{{SET PCODE FOR FIRST NODE
{{JSR{PBILD{{{BUILD P$IMA NODE
{{MOV{(SP)+{4*PTHEN(R9){{SET LEFT OPERAND AS P$IMA SUCCESSOR
{{JSR{PCONC{{{CONCATENATE TO FORM FINAL PATTERN
{{BRN{EXIXR{{{ALL DONE
{{EJC{{{{
*
* INDIRECTION (BY NAME)
*
{O$INN{ENT{{{{ENTRY POINT
{{MNZ{R7{{{SET FLAG FOR RESULT BY NAME
{{BRN{INDIR{{{JUMP TO COMMON ROUTINE
{{EJC{{{{
*
* INTERROGATION
*
{O$INT{ENT{{{{ENTRY POINT
{{MOV{#NULLS{(SP){{REPLACE OPERAND WITH NULL
{{BRN{EXITS{{{EXIT FOR NEXT CODE WORD
{{EJC{{{{
*
* INDIRECTION (BY VALUE)
*
{O$INV{ENT{{{{ENTRY POINT
{{ZER{R7{{{SET FLAG FOR BY VALUE
{{BRN{INDIR{{{JUMP TO COMMON ROUTINE
{{EJC{{{{
*
* KEYWORD REFERENCE (BY NAME)
*
{O$KWN{ENT{{{{ENTRY POINT
{{JSR{KWNAM{{{GET KEYWORD NAME
{{BRN{EXNAM{{{EXIT WITH RESULT NAME
{{EJC{{{{
*
* KEYWORD REFERENCE (BY VALUE)
*
{O$KWV{ENT{{{{ENTRY POINT
{{JSR{KWNAM{{{GET KEYWORD NAME
{{MOV{R9{DNAMP{{DELETE KVBLK
{{JSR{ACESS{{{ACCESS VALUE
{{PPM{EXNUL{{{DUMMY (UNUSED) FAILURE RETURN
{{BRN{EXIXR{{{JUMP WITH VALUE IN XR
{{EJC{{{{
*
* LOAD EXPRESSION BY NAME
*
{O$LEX{ENT{{{{ENTRY POINT
{{MOV{#4*EVSI${R6{{SET SIZE OF EVBLK
{{JSR{ALLOC{{{ALLOCATE SPACE FOR EVBLK
{{MOV{#B$EVT{(R9){{SET TYPE WORD
{{MOV{#TRBEV{4*EVVAR(R9){{SET DUMMY TRBLK POINTER
{{LCW{R6{{{LOAD EXBLK POINTER
{{MOV{R6{4*EVEXP(R9){{SET EXBLK POINTER
{{MOV{R9{R10{{MOVE NAME BASE TO PROPER REG
{{MOV{#4*EVVAR{R6{{SET NAME OFFSET = ZERO
{{BRN{EXNAM{{{EXIT WITH NAME IN (XL,WA)
{{EJC{{{{
*
* LOAD PATTERN VALUE
*
{O$LPT{ENT{{{{ENTRY POINT
{{LCW{R9{{{LOAD PATTERN POINTER
{{BRN{EXIXR{{{STACK PTR AND OBEY NEXT CODE WORD
{{EJC{{{{
*
* LOAD VARIABLE NAME
*
{O$LVN{ENT{{{{ENTRY POINT
{{LCW{R6{{{LOAD VRBLK POINTER
{{MOV{R6{-(SP){{STACK VRBLK PTR (NAME BASE)
{{MOV{#4*VRVAL{-(SP){{STACK NAME OFFSET
{{BRN{EXITS{{{EXIT WITH RESULT ON STACK
{{EJC{{{{
*
* BINARY ASTERISK (MULTIPLICATION)
*
{O$MLT{ENT{{{{ENTRY POINT
{{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS
{{ERR{026{MULTIPLICATION{{LEFT OPERAND IS NOT NUMERIC
{{ERR{027{MULTIPLICATION{{RIGHT OPERAND IS NOT NUMERIC
{{PPM{OMLT1{{{JUMP IF REAL OPERANDS
*
* HERE TO MULTIPLY TWO INTEGERS
*
{{MLI{4*ICVAL(R10){{{MULTIPLY LEFT OPERAND BY RIGHT
{{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW
{{ERB{028{MULTIPLICATION{{CAUSED INTEGER OVERFLOW
*
* HERE TO MULTIPLY TWO REALS
*
{OMLT1{MLR{4*RCVAL(R10){{{MULTIPLY LEFT OPERAND BY RIGHT
{{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW
{{ERB{263{MULTIPLICATION{{CAUSED REAL OVERFLOW
{{EJC{{{{
*
* NAME REFERENCE
*
{O$NAM{ENT{{{{ENTRY POINT
{{MOV{#4*NMSI${R6{{SET LENGTH OF NMBLK
{{JSR{ALLOC{{{ALLOCATE NMBLK
{{MOV{#B$NML{(R9){{SET NAME BLOCK CODE
{{MOV{(SP)+{4*NMOFS(R9){{SET NAME OFFSET FROM OPERAND
{{MOV{(SP)+{4*NMBAS(R9){{SET NAME BASE FROM OPERAND
{{BRN{EXIXR{{{EXIT WITH RESULT IN XR
{{EJC{{{{
*
* NEGATION
*
* INITIAL ENTRY
*
{O$NTA{ENT{{{{ENTRY POINT
{{LCW{R6{{{LOAD NEW FAILURE OFFSET
{{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER
{{MOV{R6{-(SP){{STACK NEW FAILURE OFFSET
{{MOV{SP{FLPTR{{SET NEW FAILURE POINTER
{{BRN{EXITS{{{JUMP TO CONTINUE EXECUTION
*
* ENTRY AFTER SUCCESSFUL EVALUATION OF OPERAND
*
{O$NTB{ENT{{{{ENTRY POINT
{{MOV{4*2(SP){FLPTR{{RESTORE OLD FAILURE POINTER
{{BRN{EXFAL{{{AND FAIL
*
* ENTRY FOR FAILURE DURING OPERAND EVALUATION
*
{O$NTC{ENT{{{{ENTRY POINT
{{ICA{SP{{{POP FAILURE OFFSET
{{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER
{{BRN{EXNUL{{{EXIT GIVING NULL RESULT
{{EJC{{{{
*
* USE OF UNDEFINED OPERATOR
*
{O$OUN{ENT{{{{ENTRY POINT
{{ERB{029{UNDEFINED{{OPERATOR REFERENCED
{{EJC{{{{
*
* BINARY DOT (PATTERN ASSIGNMENT)
*
* THE PATTERN BUILT BY BINARY DOT IS A COMPOUND PATTERN.
* SEE DESCRIPTION AT START OF PATTERN MATCH SECTION FOR
* DETAILS OF THE STRUCTURE WHICH IS CONSTRUCTED.
*
{O$PAS{ENT{{{{ENTRY POINT
{{MOV{#P$PAC{R7{{LOAD PCODE FOR P$PAC NODE
{{MOV{(SP)+{R8{{LOAD NAME OFFSET (PARM2)
{{MOV{(SP)+{R9{{LOAD NAME BASE (PARM1)
{{JSR{PBILD{{{BUILD P$PAC NODE
{{MOV{R9{R10{{SAVE PTR TO NODE
{{MOV{(SP){R9{{LOAD LEFT OPERAND
{{JSR{GTPAT{{{CONVERT TO PATTERN
{{ERR{030{PATTERN{{ASSIGNMENT LEFT OPERAND IS NOT PATTERN
{{MOV{R9{(SP){{SAVE PTR TO LEFT OPERAND PATTERN
{{MOV{#P$PAA{R7{{SET PCODE FOR P$PAA NODE
{{JSR{PBILD{{{BUILD P$PAA NODE
{{MOV{(SP)+{4*PTHEN(R9){{SET LEFT OPERAND AS P$PAA SUCCESSOR
{{JSR{PCONC{{{CONCATENATE TO FORM FINAL PATTERN
{{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
{{EJC{{{{
*
* PATTERN MATCH (BY NAME, FOR REPLACEMENT)
*
{O$PMN{ENT{{{{ENTRY POINT
{{ZER{R7{{{SET TYPE CODE FOR MATCH BY NAME
{{BRN{MATCH{{{JUMP TO ROUTINE TO START MATCH
{{EJC{{{{
*
* PATTERN MATCH (STATEMENT)
*
* O$PMS IS USED IN PLACE OF O$PMV WHEN THE PATTERN MATCH
* OCCURS AT THE OUTER (STATEMENT) LEVEL SINCE IN THIS
* CASE THE SUBSTRING VALUE NEED NOT BE CONSTRUCTED.
*
{O$PMS{ENT{{{{ENTRY POINT
{{MOV{#NUM02{R7{{SET FLAG FOR STATEMENT TO MATCH
{{BRN{MATCH{{{JUMP TO ROUTINE TO START MATCH
{{EJC{{{{
*
* PATTERN MATCH (BY VALUE)
*
{O$PMV{ENT{{{{ENTRY POINT
{{MOV{#NUM01{R7{{SET TYPE CODE FOR VALUE MATCH
{{BRN{MATCH{{{JUMP TO ROUTINE TO START MATCH
{{EJC{{{{
*
* POP TOP ITEM ON STACK
*
{O$POP{ENT{{{{ENTRY POINT
{{ICA{SP{{{POP TOP STACK ENTRY
{{BRN{EXITS{{{OBEY NEXT CODE WORD
{{EJC{{{{
*
* TERMINATE EXECUTION (CODE COMPILED FOR END STATEMENT)
*
{O$STP{ENT{{{{ENTRY POINT
{{BRN{LEND0{{{JUMP TO END CIRCUIT
{{EJC{{{{
*
* RETURN NAME FROM EXPRESSION
* THIS ENTRY POINTS IS USED IF THE EVALUATION OF AN
* EXPRESSION, INITIATED BY THE EVALX PROCEDURE, RETURNS
* A NAME. CONTROL IS RETURNED TO THE PROPER POINT IN EVALX.
*
{O$RNM{ENT{{{{ENTRY POINT
{{BRN{EVLX4{{{RETURN TO EVALX PROCEDURE
{{EJC{{{{
*
* PATTERN REPLACEMENT
*
* WHEN THIS ROUTINE GETS CONTROL, THE FOLLOWING STACK
* ENTRIES HAVE BEEN MADE (SEE END OF MATCH ROUTINE P$NTH)
*
* SUBJECT NAME BASE
* SUBJECT NAME OFFSET
* INITIAL CURSOR VALUE
* FINAL CURSOR VALUE
* SUBJECT POINTER
* (XS) ---------------- REPLACEMENT VALUE
*
{O$RPL{ENT{{{{ENTRY POINT
{{JSR{GTSTG{{{CONVERT REPLACEMENT VAL TO STRING
{{ERR{031{PATTERN{{REPLACEMENT RIGHT OPERAND IS NOT STRING
*
* GET RESULT LENGTH AND ALLOCATE RESULT SCBLK
*
{{MOV{(SP){R10{{LOAD SUBJECT STRING POINTER
{{BEQ{(R10){#B$BCT{ORPL4{BRANCH IF BUFFER ASSIGNMENT
{{ADD{4*SCLEN(R10){R6{{ADD SUBJECT STRING LENGTH
{{ADD{4*2(SP){R6{{ADD STARTING CURSOR
{{SUB{4*1(SP){R6{{MINUS FINAL CURSOR = TOTAL LENGTH
{{BZE{R6{ORPL3{{JUMP IF RESULT IS NULL
{{MOV{R9{-(SP){{RESTACK REPLACEMENT STRING
{{JSR{ALOCS{{{ALLOCATE SCBLK FOR RESULT
{{MOV{4*3(SP){R6{{GET INITIAL CURSOR (PART 1 LEN)
{{MOV{R9{4*3(SP){{STACK RESULT POINTER
{{PSC{R9{{{POINT TO CHARACTERS OF RESULT
*
* MOVE PART 1 (START OF SUBJECT) TO RESULT
*
{{BZE{R6{ORPL1{{JUMP IF FIRST PART IS NULL
{{MOV{4*1(SP){R10{{ELSE POINT TO SUBJECT STRING
{{PLC{R10{{{POINT TO SUBJECT STRING CHARS
{{MVC{{{{MOVE FIRST PART TO RESULT
{{EJC{{{{
* PATTERN REPLACEMENT (CONTINUED)
*
* NOW MOVE IN REPLACEMENT VALUE
*
{ORPL1{MOV{(SP)+{R10{{LOAD REPLACEMENT STRING, POP
{{MOV{4*SCLEN(R10){R6{{LOAD LENGTH
{{BZE{R6{ORPL2{{JUMP IF NULL REPLACEMENT
{{PLC{R10{{{ELSE POINT TO CHARS OF REPLACEMENT
{{MVC{{{{MOVE IN CHARS (PART 2)
*
* NOW MOVE IN REMAINDER OF STRING (PART 3)
*
{ORPL2{MOV{(SP)+{R10{{LOAD SUBJECT STRING POINTER, POP
{{MOV{(SP)+{R8{{LOAD FINAL CURSOR, POP
{{MOV{4*SCLEN(R10){R6{{LOAD SUBJECT STRING LENGTH
{{SUB{R8{R6{{MINUS FINAL CURSOR = PART 3 LENGTH
{{BZE{R6{OASS0{{JUMP TO ASSIGN IF PART 3 IS NULL
{{PLC{R10{R8{{ELSE POINT TO LAST PART OF STRING
{{MVC{{{{MOVE PART 3 TO RESULT
{{BRN{OASS0{{{JUMP TO PERFORM ASSIGNMENT
*
* HERE IF RESULT IS NULL
*
{ORPL3{ADD{#4*NUM02{SP{{POP SUBJECT STR PTR, FINAL CURSOR
{{MOV{#NULLS{(SP){{SET NULL RESULT
{{BRN{OASS0{{{JUMP TO ASSIGN NULL VALUE
*
* HERE FOR BUFFER SUBSTRING ASSIGNMENT
*
{ORPL4{MOV{R9{R10{{COPY SCBLK REPLACEMENT PTR
{{MOV{(SP)+{R9{{UNSTACK BCBLK PTR
{{MOV{(SP)+{R7{{GET FINAL CURSOR VALUE
{{MOV{(SP)+{R6{{GET INITIAL CURSOR
{{SUB{R6{R7{{GET LENGTH IN WB
{{ADD{#4*NUM02{SP{{GET RID OF NAME BASE/OFFSET
{{JSR{INSBF{{{INSERT SUBSTRING
{{PPM{{{{CONVERT FAIL IMPOSSIBLE
{{PPM{EXFAL{{{FAIL IF INSERT FAILS
{{BRN{EXNUL{{{ELSE NULL RESULT
{{EJC{{{{
*
* RETURN VALUE FROM EXPRESSION
*
* THIS ENTRY POINTS IS USED IF THE EVALUATION OF AN
* EXPRESSION, INITIATED BY THE EVALX PROCEDURE, RETURNS
* A VALUE. CONTROL IS RETURNED TO THE PROPER POINT IN EVALX
*
{O$RVL{ENT{{{{ENTRY POINT
{{BRN{EVLX3{{{RETURN TO EVALX PROCEDURE
{{EJC{{{{
*
* SELECTION
*
* INITIAL ENTRY
*
{O$SLA{ENT{{{{ENTRY POINT
{{LCW{R6{{{LOAD NEW FAILURE OFFSET
{{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER
{{MOV{R6{-(SP){{STACK NEW FAILURE OFFSET
{{MOV{SP{FLPTR{{SET NEW FAILURE POINTER
{{BRN{EXITS{{{JUMP TO EXECUTE FIRST ALTERNATIVE
*
* ENTRY AFTER SUCCESSFUL EVALUATION OF ALTERNATIVE
*
{O$SLB{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD RESULT
{{ICA{SP{{{POP FAIL OFFSET
{{MOV{(SP){FLPTR{{RESTORE OLD FAILURE POINTER
{{MOV{R9{(SP){{RESTACK RESULT
{{LCW{R6{{{LOAD NEW CODE OFFSET
{{ADD{R$COD{R6{{POINT TO ABSOLUTE CODE LOCATION
{{LCP{R6{{{SET NEW CODE POINTER
{{BRN{EXITS{{{JUMP TO CONTINUE PAST SELECTION
*
* ENTRY AT START OF SUBSEQUENT ALTERNATIVES
*
{O$SLC{ENT{{{{ENTRY POINT
{{LCW{R6{{{LOAD NEW FAIL OFFSET
{{MOV{R6{(SP){{STORE NEW FAIL OFFSET
{{BRN{EXITS{{{JUMP TO EXECUTE NEXT ALTERNATIVE
*
* ENTRY AT START OF LAST ALTERNATIVE
*
{O$SLD{ENT{{{{ENTRY POINT
{{ICA{SP{{{POP FAILURE OFFSET
{{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER
{{BRN{EXITS{{{JUMP TO EXECUTE LAST ALTERNATIVE
{{EJC{{{{
*
* BINARY MINUS (SUBTRACTION)
*
{O$SUB{ENT{{{{ENTRY POINT
{{JSR{ARITH{{{FETCH ARITHMETIC OPERANDS
{{ERR{032{SUBTRACTION{{LEFT OPERAND IS NOT NUMERIC
{{ERR{033{SUBTRACTION{{RIGHT OPERAND IS NOT NUMERIC
{{PPM{OSUB1{{{JUMP IF REAL OPERANDS
*
* HERE TO SUBTRACT TWO INTEGERS
*
{{SBI{4*ICVAL(R10){{{SUBTRACT RIGHT OPERAND FROM LEFT
{{INO{EXINT{{{RETURN INTEGER IF NO OVERFLOW
{{ERB{034{SUBTRACTION{{CAUSED INTEGER OVERFLOW
*
* HERE TO SUBTRACT TWO REALS
*
{OSUB1{SBR{4*RCVAL(R10){{{SUBTRACT RIGHT OPERAND FROM LEFT
{{RNO{EXREA{{{RETURN REAL IF NO OVERFLOW
{{ERB{264{SUBTRACTION{{CAUSED REAL OVERFLOW
{{EJC{{{{
*
* DUMMY OPERATOR TO RETURN CONTROL TO TRXEQ PROCEDURE
*
{O$TXR{ENT{{{{ENTRY POINT
{{BRN{TRXQ1{{{JUMP INTO TRXEQ PROCEDURE
{{EJC{{{{
*
* UNEXPECTED FAILURE
*
* NOTE THAT IF A SETEXIT TRAP IS OPERATING THEN
* TRANSFER TO SYSTEM LABEL CONTINUE
* WILL RESULT IN LOOPING HERE. DIFFICULT TO AVOID EXCEPT
* WITH A CONSIDERABLE OVERHEAD WHICH IS NOT WORTHWHILE OR
* ELSE BY A TECHNIQUE SUCH AS SETTING KVERL TO ZERO.
*
{O$UNF{ENT{{{{ENTRY POINT
{{ERB{035{UNEXPECTED{{FAILURE IN -NOFAIL MODE
{{TTL{S{{{P I T B O L -- SNOBOL4 BUILTIN LABEL ROUTINES
*
* THE FOLLOWING SECTION CONTAINS THE ROUTINES FOR LABELS
* WHICH HAVE A PREDEFINED MEANING IN SNOBOL4.
*
* CONTROL IS PASSED DIRECTLY TO THE LABEL NAME ENTRY POINT.
*
* ENTRY NAMES ARE OF THE FORM L$XXX WHERE XXX IS THE THREE
* LETTER VARIABLE NAME IDENTIFIER.
*
* ENTRIES ARE IN ALPHABETICAL ORDER
{{EJC{{{{
*
* ABORT
*
{L$ABO{ENT{{{{ENTRY POINT
*
* MERGE HERE IF EXECUTION TERMINATES IN ERROR
*
{LABO1{MOV{KVERT{R6{{LOAD ERROR CODE
{{BZE{R6{LABO2{{JUMP IF NO ERROR HAS OCCURED
{{JSR{SYSAX{{{CALL AFTER EXECUTION PROC (REG04)
{{JSR{PRTPG{{{ELSE EJECT PRINTER
{{JSR{ERMSG{{{PRINT ERROR MESSAGE
{{ZER{R9{{{INDICATE NO MESSAGE TO PRINT
{{BRN{STOPR{{{JUMP TO ROUTINE TO STOP RUN
*
* HERE IF NO ERROR HAD OCCURED
*
{LABO2{ERB{036{GOTO{{ABORT WITH NO PRECEDING ERROR
{{EJC{{{{
*
* CONTINUE
*
{L$CNT{ENT{{{{ENTRY POINT
*
* MERGE HERE AFTER EXECUTION ERROR
*
{LCNT1{MOV{R$CNT{R9{{LOAD CONTINUATION CODE BLOCK PTR
{{BZE{R9{LCNT2{{JUMP IF NO PREVIOUS ERROR
{{ZER{R$CNT{{{CLEAR FLAG
{{MOV{R9{R$COD{{ELSE STORE AS NEW CODE BLOCK PTR
{{ADD{STXOF{R9{{ADD FAILURE OFFSET
{{LCP{R9{{{LOAD CODE POINTER
{{MOV{FLPTR{SP{{RESET STACK POINTER
{{BRN{EXITS{{{JUMP TO TAKE INDICATED FAILURE
*
* HERE IF NO PREVIOUS ERROR
*
{LCNT2{ERB{037{GOTO{{CONTINUE WITH NO PRECEDING ERROR
{{EJC{{{{
*
* END
*
{L$END{ENT{{{{ENTRY POINT
*
* MERGE HERE FROM END CODE CIRCUIT
*
{LEND0{MOV{#ENDMS{R9{{POINT TO MESSAGE /NORMAL TERM../
{{BRN{STOPR{{{JUMP TO ROUTINE TO STOP RUN
{{EJC{{{{
*
* FRETURN
*
{L$FRT{ENT{{{{ENTRY POINT
{{MOV{#SCFRT{R6{{POINT TO STRING /FRETURN/
{{BRN{RETRN{{{JUMP TO COMMON RETURN ROUTINE
{{EJC{{{{
*
* NRETURN
*
{L$NRT{ENT{{{{ENTRY POINT
{{MOV{#SCNRT{R6{{POINT TO STRING /NRETURN/
{{BRN{RETRN{{{JUMP TO COMMON RETURN ROUTINE
{{EJC{{{{
*
* RETURN
*
{L$RTN{ENT{{{{ENTRY POINT
{{MOV{#SCRTN{R6{{POINT TO STRING /RETURN/
{{BRN{RETRN{{{JUMP TO COMMON RETURN ROUTINE
{{EJC{{{{
*
* UNDEFINED LABEL
*
{L$UND{ENT{{{{ENTRY POINT
{{ERB{038{GOTO{{UNDEFINED LABEL
{{TTL{S{{{P I T B O L -- BLOCK ACTION ROUTINES
*
* THE FIRST WORD OF EVERY BLOCK IN DYNAMIC STORAGE AND THE
* VRGET, VRSTO AND VRTRA FIELDS OF A VRBLK CONTAIN A
* POINTER TO AN ENTRY POINT IN THE PROGRAM. ALL SUCH ENTRY
* POINTS ARE IN THE FOLLOWING SECTION EXCEPT THOSE FOR
* PATTERN BLOCKS WHICH ARE IN THE PATTERN MATCHING SEGMENT
* LATER ON (LABELS OF THE FORM P$XXX), AND DOPE VECTORS
* (D$XXX) WHICH ARE IN THE DOPE VECTOR SECTION FOLLOWING
* THE PATTERN ROUTINES (DOPE VECTORS ARE USED FOR CMBLKS).
*
* THE ENTRY POINTS IN THIS SECTION HAVE LABELS OF THE
* FORM B$XXY WHERE XX IS THE TWO CHARACTER BLOCK TYPE FOR
* THE CORRESPONDING BLOCK AND Y IS ANY LETTER.
*
* IN SOME CASES, THE POINTERS SERVE NO OTHER PURPOSE THAN
* TO IDENTIFY THE BLOCK TYPE. IN THIS CASE THE ROUTINE
* IS NEVER EXECUTED AND THUS NO CODE IS ASSEMBLED.
*
* FOR EACH OF THESE ENTRY POINTS CORRESPONDING TO A BLOCK
* AN ENTRY POINT IDENTIFICATION IS ASSEMBLED (BL$XX).
*
* THE EXACT ENTRY CONDITIONS DEPEND ON THE MANNER IN
* WHICH THE ROUTINE IS ACCESSED AND ARE DOCUMENTED WITH
* THE INDIVIDUAL ROUTINES AS REQUIRED.
*
* THE ORDER OF THESE ROUTINES IS ALPHABETICAL WITH THE
* FOLLOWING EXCEPTIONS.
*
* THE ROUTINES FOR SEBLK AND EXBLK ENTRIES OCCUR FIRST SO
* THAT EXPRESSIONS CAN BE QUICKLY IDENTIFIED FROM THE FACT
* THAT THEIR ROUTINES LIE BEFORE THE SYMBOL B$E$$.
*
* THESE ARE IMMEDIATELY FOLLOWED BY THE ROUTINE FOR A TRBLK
* SO THAT THE TEST AGAINST THE SYMBOL B$T$$ CHECKS FOR
* TRAPPED VALUES OR EXPRESSION VALUES (SEE PROCEDURE EVALP)
*
* THE PATTERN ROUTINES LIE AFTER THIS SECTION SO THAT
* PATTERNS ARE IDENTIFIED WITH ROUTINES STARTING AT OR
* AFTER THE INITIAL INSTRUCTION IN THESE ROUTINES (P$AAA).
*
* THE SYMBOL B$AAA DEFINES THE FIRST LOCATION FOR BLOCK
* ROUTINES AND THE SYMBOL P$YYY (AT THE END OF THE PATTERN
* MATCH ROUTINES SECTION) DEFINES THE LAST SUCH ENTRY POINT
*
{B$AAA{ENT{BL$$I{{{ENTRY POINT OF FIRST BLOCK ROUTINE
{{EJC{{{{
*
* EXBLK
*
* THE ROUTINE FOR AN EXBLK LOADS THE EXPRESSION ONTO
* THE STACK AS A VALUE.
*
* (XR) POINTER TO EXBLK
*
{B$EXL{ENT{BL$EX{{{ENTRY POINT (EXBLK)
{{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
{{EJC{{{{
*
* SEBLK
*
* THE ROUTINE FOR SEBLK IS ACCESSED FROM THE GENERATED
* CODE TO LOAD THE EXPRESSION VALUE ONTO THE STACK.
*
{B$SEL{ENT{BL$SE{{{ENTRY POINT (SEBLK)
{{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
*
* DEFINE SYMBOL WHICH MARKS END OF ENTRIES FOR EXPRESSIONS
*
{B$E$${ENT{BL$$I{{{ENTRY POINT
{{EJC{{{{
*
* TRBLK
*
* THE ROUTINE FOR A TRBLK IS NEVER EXECUTED
*
{B$TRT{ENT{BL$TR{{{ENTRY POINT (TRBLK)
*
* DEFINE SYMBOL MARKING END OF TRAP AND EXPRESSION BLOCKS
*
{B$T$${ENT{BL$$I{{{END OF TRBLK,SEBLK,EXBLK ENTRIES
{{EJC{{{{
*
* ARBLK
*
* THE ROUTINE FOR ARBLK IS NEVER EXECUTED
*
{B$ART{ENT{BL$AR{{{ENTRY POINT (ARBLK)
{{EJC{{{{
*
* BCBLK
*
* THE ROUTINE FOR A BCBLK IS NEVER EXECUTED
*
* (XR) POINTER TO BCBLK
*
{B$BCT{ENT{BL$BC{{{ENTRY POINT (BCBLK)
{{EJC{{{{
*
* BFBLK
*
* THE ROUTINE FOR A BFBLK IS NEVER EXECUTED
*
* (XR) POINTER TO BFBLK
*
{B$BFT{ENT{BL$BF{{{ENTRY POINT (BFBLK)
{{EJC{{{{
*
* CCBLK
*
* THE ROUTINE FOR CCBLK IS NEVER ENTERED
*
{B$CCT{ENT{BL$CC{{{ENTRY POINT (CCBLK)
{{EJC{{{{
*
* CDBLK
*
* THE CDBLK ROUTINES ARE EXECUTED FROM THE GENERATED CODE.
* THERE ARE TWO CASES DEPENDING ON THE FORM OF CDFAL.
*
* ENTRY FOR COMPLEX FAILURE CODE AT CDFAL
*
* (XR) POINTER TO CDBLK
*
{B$CDC{ENT{BL$CD{{{ENTRY POINT (CDBLK)
{BCDC0{MOV{FLPTR{SP{{POP GARBAGE OFF STACK
{{MOV{4*CDFAL(R9){(SP){{SET FAILURE OFFSET
{{BRN{STMGO{{{ENTER STMT
{{EJC{{{{
*
* CDBLK (CONTINUED)
*
* ENTRY FOR SIMPLE FAILURE CODE AT CDFAL
*
* (XR) POINTER TO CDBLK
*
{B$CDS{ENT{BL$CD{{{ENTRY POINT (CDBLK)
{BCDS0{MOV{FLPTR{SP{{POP GARBAGE OFF STACK
{{MOV{#4*CDFAL{(SP){{SET FAILURE OFFSET
{{BRN{STMGO{{{ENTER STMT
{{EJC{{{{
*
* CMBLK
*
* THE ROUTINE FOR A CMBLK IS NEVER EXECUTED
*
{B$CMT{ENT{BL$CM{{{ENTRY POINT (CMBLK)
{{EJC{{{{
*
* CTBLK
*
* THE ROUTINE FOR A CTBLK IS NEVER EXECUTED
*
{B$CTT{ENT{BL$CT{{{ENTRY POINT (CTBLK)
{{EJC{{{{
*
* DFBLK
*
* THE ROUTINE FOR A DFBLK IS ACCESSED FROM THE O$FNC ENTRY
* TO CALL A DATATYPE FUNCTION AND BUILD A PDBLK.
*
* (XL) POINTER TO DFBLK
*
{B$DFC{ENT{BL$DF{{{ENTRY POINT
{{MOV{4*DFPDL(R10){R6{{LOAD LENGTH OF PDBLK
{{JSR{ALLOC{{{ALLOCATE PDBLK
{{MOV{#B$PDT{(R9){{STORE TYPE WORD
{{MOV{R10{4*PDDFP(R9){{STORE DFBLK POINTER
{{MOV{R9{R8{{SAVE POINTER TO PDBLK
{{ADD{R6{R9{{POINT PAST PDBLK
{{LCT{R6{4*FARGS(R10){{SET TO COUNT FIELDS
*
* LOOP TO ACQUIRE FIELD VALUES FROM STACK
*
{BDFC1{MOV{(SP)+{-(R9){{MOVE A FIELD VALUE
{{BCT{R6{BDFC1{{LOOP TILL ALL MOVED
{{MOV{R8{R9{{RECALL POINTER TO PDBLK
{{BRN{EXSID{{{EXIT SETTING ID FIELD
{{EJC{{{{
*
* EFBLK
*
* THE ROUTINE FOR AN EFBLK IS PASSED CONTROL FORM THE O$FNC
* ENTRY TO CALL AN EXTERNAL FUNCTION.
*
* (XL) POINTER TO EFBLK
*
{B$EFC{ENT{BL$EF{{{ENTRY POINT (EFBLK)
{{MOV{4*FARGS(R10){R8{{LOAD NUMBER OF ARGUMENTS
{{WTB{R8{{{CONVERT TO OFFSET
{{MOV{R10{-(SP){{SAVE POINTER TO EFBLK
{{MOV{SP{R10{{COPY POINTER TO ARGUMENTS
*
* LOOP TO CONVERT ARGUMENTS
*
{BEFC1{ICA{R10{{{POINT TO NEXT ENTRY
{{MOV{(SP){R9{{LOAD POINTER TO EFBLK
{{DCA{R8{{{DECREMENT EFTAR OFFSET
{{ADD{R8{R9{{POINT TO NEXT EFTAR ENTRY
{{MOV{4*EFTAR(R9){R9{{LOAD EFTAR ENTRY
{{BSW{R9{4{{SWITCH ON TYPE
{{IFF{0{BEFC7{{NO CONVERSION NEEDED
{{IFF{1{BEFC2{{STRING
{{IFF{2{BEFC3{{INTEGER
{{IFF{3{BEFC4{{REAL
{{ESW{{{{END OF SWITCH ON TYPE
*
* HERE TO CONVERT TO STRING
*
{BEFC2{MOV{(R10){-(SP){{STACK ARG PTR
{{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
{{ERR{039{EXTERNAL{{FUNCTION ARGUMENT IS NOT STRING
{{BRN{BEFC6{{{JUMP TO MERGE
{{EJC{{{{
*
* EFBLK (CONTINUED)
*
* HERE TO CONVERT AN INTEGER
*
{BEFC3{MOV{(R10){R9{{LOAD NEXT ARGUMENT
{{MOV{R8{BEFOF{{SAVE OFFSET
{{JSR{GTINT{{{CONVERT TO INTEGER
{{ERR{040{EXTERNAL{{FUNCTION ARGUMENT IS NOT INTEGER
{{BRN{BEFC5{{{MERGE WITH REAL CASE
*
* HERE TO CONVERT A REAL
*
{BEFC4{MOV{(R10){R9{{LOAD NEXT ARGUMENT
{{MOV{R8{BEFOF{{SAVE OFFSET
{{JSR{GTREA{{{CONVERT TO REAL
{{ERR{265{EXTERNAL{{FUNCTION ARGUMENT IS NOT REAL
*
* INTEGER CASE MERGES HERE
*
{BEFC5{MOV{BEFOF{R8{{RESTORE OFFSET
*
* STRING MERGES HERE
*
{BEFC6{MOV{R9{(R10){{STORE CONVERTED RESULT
*
* NO CONVERSION MERGES HERE
*
{BEFC7{BNZ{R8{BEFC1{{LOOP BACK IF MORE TO GO
*
* HERE AFTER CONVERTING ALL THE ARGUMENTS
*
{{MOV{(SP)+{R10{{RESTORE EFBLK POINTER
{{MOV{4*FARGS(R10){R6{{GET NUMBER OF ARGS
{{JSR{SYSEX{{{CALL ROUTINE TO CALL EXTERNAL FNC
{{PPM{EXFAL{{{FAIL IF FAILURE
{{EJC{{{{
*
* EFBLK (CONTINUED)
*
* RETURN HERE WITH RESULT IN XR
*
* FIRST DEFEND AGAINST NON-STANDARD NULL STRING RETURNED
*
{{MOV{4*EFRSL(R10){R7{{GET RESULT TYPE ID
{{BNZ{R7{BEFA8{{BRANCH IF NOT UNCONVERTED
{{BNE{(R9){#B$SCL{BEFC8{JUMP IF NOT A STRING
{{BZE{4*SCLEN(R9){EXNUL{{RETURN NULL IF NULL
*
* HERE IF CONVERTED RESULT TO CHECK FOR NULL STRING
*
{BEFA8{BNE{R7{#NUM01{BEFC8{JUMP IF NOT A STRING
{{BZE{4*SCLEN(R9){EXNUL{{RETURN NULL IF NULL
*
* RETURN IF RESULT IS IN DYNAMIC STORAGE
*
{BEFC8{BLT{R9{DNAMB{BEFC9{JUMP IF NOT IN DYNAMIC STORAGE
{{BLE{R9{DNAMP{EXIXR{RETURN RESULT IF ALREADY DYNAMIC
*
* HERE WE COPY A RESULT INTO THE DYNAMIC REGION
*
{BEFC9{MOV{(R9){R6{{GET POSSIBLE TYPE WORD
{{BZE{R7{BEF11{{JUMP IF UNCONVERTED RESULT
{{MOV{#B$SCL{R6{{STRING
{{BEQ{R7{#NUM01{BEF10{YES JUMP
{{MOV{#B$ICL{R6{{INTEGER
{{BEQ{R7{#NUM02{BEF10{YES JUMP
{{MOV{#B$RCL{R6{{REAL
*
* STORE TYPE WORD IN RESULT
*
{BEF10{MOV{R6{(R9){{STORED BEFORE COPYING TO DYNAMIC
*
* MERGE FOR UNCONVERTED RESULT
*
{BEF11{JSR{BLKLN{{{GET LENGTH OF BLOCK
{{MOV{R9{R10{{COPY ADDRESS OF OLD BLOCK
{{JSR{ALLOC{{{ALLOCATE DYNAMIC BLOCK SAME SIZE
{{MOV{R9{-(SP){{SET POINTER TO NEW BLOCK AS RESULT
{{MVW{{{{COPY OLD BLOCK TO DYNAMIC BLOCK
{{BRN{EXITS{{{EXIT WITH RESULT ON STACK
{{EJC{{{{
*
* EVBLK
*
* THE ROUTINE FOR AN EVBLK IS NEVER EXECUTED
*
{B$EVT{ENT{BL$EV{{{ENTRY POINT (EVBLK)
{{EJC{{{{
*
* FFBLK
*
* THE ROUTINE FOR AN FFBLK IS EXECUTED FROM THE O$FNC ENTRY
* TO CALL A FIELD FUNCTION AND EXTRACT A FIELD VALUE/NAME.
*
* (XL) POINTER TO FFBLK
*
{B$FFC{ENT{BL$FF{{{ENTRY POINT (FFBLK)
{{MOV{R10{R9{{COPY FFBLK POINTER
{{LCW{R8{{{LOAD NEXT CODE WORD
{{MOV{(SP){R10{{LOAD PDBLK POINTER
{{BNE{(R10){#B$PDT{BFFC2{JUMP IF NOT PDBLK AT ALL
{{MOV{4*PDDFP(R10){R6{{LOAD DFBLK POINTER FROM PDBLK
*
* LOOP TO FIND CORRECT FFBLK FOR THIS PDBLK
*
{BFFC1{BEQ{R6{4*FFDFP(R9){BFFC3{JUMP IF THIS IS THE CORRECT FFBLK
{{MOV{4*FFNXT(R9){R9{{ELSE LINK TO NEXT FFBLK ON CHAIN
{{BNZ{R9{BFFC1{{LOOP BACK IF ANOTHER ENTRY TO CHECK
*
* HERE FOR BAD ARGUMENT
*
{BFFC2{ERB{041{FIELD{{FUNCTION ARGUMENT IS WRONG DATATYPE
{{EJC{{{{
*
* FFBLK (CONTINUED)
*
* HERE AFTER LOCATING CORRECT FFBLK
*
{BFFC3{MOV{4*FFOFS(R9){R6{{LOAD FIELD OFFSET
{{BEQ{R8{#OFNE${BFFC5{JUMP IF CALLED BY NAME
{{ADD{R6{R10{{ELSE POINT TO VALUE FIELD
{{MOV{(R10){R9{{LOAD VALUE
{{BNE{(R9){#B$TRT{BFFC4{JUMP IF NOT TRAPPED
{{SUB{R6{R10{{ELSE RESTORE NAME BASE,OFFSET
{{MOV{R8{(SP){{SAVE NEXT CODE WORD OVER PDBLK PTR
{{JSR{ACESS{{{ACCESS VALUE
{{PPM{EXFAL{{{FAIL IF ACCESS FAILS
{{MOV{(SP){R8{{RESTORE NEXT CODE WORD
*
* HERE AFTER GETTING VALUE IN (XR)
*
{BFFC4{MOV{R9{(SP){{STORE VALUE ON STACK (OVER PDBLK)
{{MOV{R8{R9{{COPY NEXT CODE WORD
{{MOV{(R9){R10{{LOAD ENTRY ADDRESS
{{BRI{R10{{{JUMP TO ROUTINE FOR NEXT CODE WORD
*
* HERE IF CALLED BY NAME
*
{BFFC5{MOV{R6{-(SP){{STORE NAME OFFSET (BASE IS SET)
{{BRN{EXITS{{{EXIT WITH NAME ON STACK
{{EJC{{{{
*
* ICBLK
*
* THE ROUTINE FOR ICBLK IS EXECUTED FROM THE GENERATED
* CODE TO LOAD AN INTEGER VALUE ONTO THE STACK.
*
* (XR) POINTER TO ICBLK
*
{B$ICL{ENT{BL$IC{{{ENTRY POINT (ICBLK)
{{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
{{EJC{{{{
*
* KVBLK
*
* THE ROUTINE FOR A KVBLK IS NEVER EXECUTED.
*
{B$KVT{ENT{BL$KV{{{ENTRY POINT (KVBLK)
{{EJC{{{{
*
* NMBLK
*
* THE ROUTINE FOR A NMBLK IS EXECUTED FROM THE GENERATED
* CODE FOR THE CASE OF LOADING A NAME ONTO THE STACK
* WHERE THE NAME IS THAT OF A NATURAL VARIABLE WHICH CAN
* BE PREEVALUATED AT COMPILE TIME.
*
* (XR) POINTER TO NMBLK
*
{B$NML{ENT{BL$NM{{{ENTRY POINT (NMBLK)
{{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
{{EJC{{{{
*
* PDBLK
*
* THE ROUTINE FOR A PDBLK IS NEVER EXECUTED
*
{B$PDT{ENT{BL$PD{{{ENTRY POINT (PDBLK)
{{EJC{{{{
*
* PFBLK
*
* THE ROUTINE FOR A PFBLK IS EXECUTED FROM THE ENTRY O$FNC
* TO CALL A PROGRAM DEFINED FUNCTION.
*
* (XL) POINTER TO PFBLK
*
* THE FOLLOWING STACK ENTRIES ARE MADE BEFORE PASSING
* CONTROL TO THE PROGRAM DEFINED FUNCTION.
*
* SAVED VALUE OF FIRST ARGUMENT
* .
* SAVED VALUE OF LAST ARGUMENT
* SAVED VALUE OF FIRST LOCAL
* .
* SAVED VALUE OF LAST LOCAL
* SAVED VALUE OF FUNCTION NAME
* SAVED CODE BLOCK PTR (R$COD)
* SAVED CODE POINTER (-R$COD)
* SAVED VALUE OF FLPRT
* SAVED VALUE OF FLPTR
* POINTER TO PFBLK
* FLPTR --------------- ZERO (TO BE OVERWRITTEN WITH OFFS)
*
{B$PFC{ENT{BL$PF{{{ENTRY POINT (PFBLK)
{{MOV{R10{BPFPF{{SAVE PFBLK PTR (NEED NOT BE RELOC)
{{MOV{R10{R9{{COPY FOR THE MOMENT
{{MOV{4*PFVBL(R9){R10{{POINT TO VRBLK FOR FUNCTION
*
* LOOP TO FIND OLD VALUE OF FUNCTION
*
{BPF01{MOV{R10{R7{{SAVE POINTER
{{MOV{4*VRVAL(R10){R10{{LOAD VALUE
{{BEQ{(R10){#B$TRT{BPF01{LOOP IF TRBLK
*
* SET VALUE TO NULL AND SAVE OLD FUNCTION VALUE
*
{{MOV{R10{BPFSV{{SAVE OLD VALUE
{{MOV{R7{R10{{POINT BACK TO BLOCK WITH VALUE
{{MOV{#NULLS{4*VRVAL(R10){{SET VALUE TO NULL
{{MOV{4*FARGS(R9){R6{{LOAD NUMBER OF ARGUMENTS
{{ADD{#4*PFARG{R9{{POINT TO PFARG ENTRIES
{{BZE{R6{BPF04{{JUMP IF NO ARGUMENTS
{{MOV{SP{R10{{PTR TO LAST ARG
{{WTB{R6{{{CONVERT NO. OF ARGS TO BYTES OFFSET
{{ADD{R6{R10{{POINT BEFORE FIRST ARG
{{MOV{R10{BPFXT{{REMEMBER ARG POINTER
{{EJC{{{{
*
* PFBLK (CONTINUED)
*
* LOOP TO SAVE OLD ARGUMENT VALUES AND SET NEW ONES
*
{BPF02{MOV{(R9)+{R10{{LOAD VRBLK PTR FOR NEXT ARGUMENT
*
* LOOP THROUGH POSSIBLE TRBLK CHAIN TO FIND VALUE
*
{BPF03{MOV{R10{R8{{SAVE POINTER
{{MOV{4*VRVAL(R10){R10{{LOAD NEXT VALUE
{{BEQ{(R10){#B$TRT{BPF03{LOOP BACK IF TRBLK
*
* SAVE OLD VALUE AND GET NEW VALUE
*
{{MOV{R10{R6{{KEEP OLD VALUE
{{MOV{BPFXT{R10{{POINT BEFORE NEXT STACKED ARG
{{MOV{-(R10){R7{{LOAD ARGUMENT (NEW VALUE)
{{MOV{R6{(R10){{SAVE OLD VALUE
{{MOV{R10{BPFXT{{KEEP ARG PTR FOR NEXT TIME
{{MOV{R8{R10{{POINT BACK TO BLOCK WITH VALUE
{{MOV{R7{4*VRVAL(R10){{SET NEW VALUE
{{BNE{SP{BPFXT{BPF02{LOOP IF NOT ALL DONE
*
* NOW PROCESS LOCALS
*
{BPF04{MOV{BPFPF{R10{{RESTORE PFBLK POINTER
{{MOV{4*PFNLO(R10){R6{{LOAD NUMBER OF LOCALS
{{BZE{R6{BPF07{{JUMP IF NO LOCALS
{{MOV{#NULLS{R7{{GET NULL CONSTANT
{{LCT{R6{R6{{SET LOCAL COUNTER
*
* LOOP TO PROCESS LOCALS
*
{BPF05{MOV{(R9)+{R10{{LOAD VRBLK PTR FOR NEXT LOCAL
*
* LOOP THROUGH POSSIBLE TRBLK CHAIN TO FIND VALUE
*
{BPF06{MOV{R10{R8{{SAVE POINTER
{{MOV{4*VRVAL(R10){R10{{LOAD NEXT VALUE
{{BEQ{(R10){#B$TRT{BPF06{LOOP BACK IF TRBLK
*
* SAVE OLD VALUE AND SET NULL AS NEW VALUE
*
{{MOV{R10{-(SP){{STACK OLD VALUE
{{MOV{R8{R10{{POINT BACK TO BLOCK WITH VALUE
{{MOV{R7{4*VRVAL(R10){{SET NULL AS NEW VALUE
{{BCT{R6{BPF05{{LOOP TILL ALL LOCALS PROCESSED
{{EJC{{{{
*
* PFBLK (CONTINUED)
*
* HERE AFTER PROCESSING ARGUMENTS AND LOCALS
*
{BPF07{ZER{R9{{{ZERO REG XR IN CASE
{{BZE{KVPFL{BPF7C{{SKIP IF PROFILING IS OFF
{{BEQ{KVPFL{#NUM02{BPF7A{BRANCH ON TYPE OF PROFILE
*
* HERE IF &PROFILE = 1
*
{{JSR{SYSTM{{{GET CURRENT TIME
{{STI{PFETM{{{SAVE FOR A SEC
{{SBI{PFSTM{{{FIND TIME USED BY CALLER
{{JSR{ICBLD{{{BUILD INTO AN ICBLK
{{LDI{PFETM{{{RELOAD CURRENT TIME
{{BRN{BPF7B{{{MERGE
*
* HERE IF &PROFILE = 2
*
{BPF7A{LDI{PFSTM{{{GET START TIME OF CALLING STMT
{{JSR{ICBLD{{{ASSEMBLE AN ICBLK ROUND IT
{{JSR{SYSTM{{{GET NOW TIME
*
* BOTH TYPES OF PROFILE MERGE HERE
*
{BPF7B{STI{PFSTM{{{SET START TIME OF 1ST FUNC STMT
{{MNZ{PFFNC{{{FLAG FUNCTION ENTRY
*
* NO PROFILING MERGES HERE
*
{BPF7C{MOV{R9{-(SP){{STACK ICBLK PTR (OR ZERO)
{{MOV{R$COD{R6{{LOAD OLD CODE BLOCK POINTER
{{SCP{R7{{{GET CODE POINTER
{{SUB{R6{R7{{MAKE CODE POINTER INTO OFFSET
{{MOV{BPFPF{R10{{RECALL PFBLK POINTER
{{MOV{BPFSV{-(SP){{STACK OLD VALUE OF FUNCTION NAME
{{MOV{R6{-(SP){{STACK CODE BLOCK POINTER
{{MOV{R7{-(SP){{STACK CODE OFFSET
{{MOV{FLPRT{-(SP){{STACK OLD FLPRT
{{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER
{{MOV{R10{-(SP){{STACK POINTER TO PFBLK
{{ZER{-(SP){{{DUMMY ZERO ENTRY FOR FAIL RETURN
{{CHK{{{{CHECK FOR STACK OVERFLOW
{{MOV{SP{FLPTR{{SET NEW FAIL RETURN VALUE
{{MOV{SP{FLPRT{{SET NEW FLPRT
{{MOV{KVTRA{R6{{LOAD TRACE VALUE
{{ADD{KVFTR{R6{{ADD FTRACE VALUE
{{BNZ{R6{BPF09{{JUMP IF TRACING POSSIBLE
{{ICV{KVFNC{{{ELSE BUMP FNCLEVEL
*
* HERE TO ACTUALLY JUMP TO FUNCTION
*
{BPF08{MOV{4*PFCOD(R10){R9{{POINT TO CODE
{{BRI{(R9){{{OFF TO EXECUTE FUNCTION
*
* HERE IF TRACING IS POSSIBLE
*
{BPF09{MOV{4*PFCTR(R10){R9{{LOAD POSSIBLE CALL TRACE TRBLK
{{MOV{4*PFVBL(R10){R10{{LOAD VRBLK POINTER FOR FUNCTION
{{MOV{#4*VRVAL{R6{{SET NAME OFFSET FOR VARIABLE
{{BZE{KVTRA{BPF10{{JUMP IF TRACE MODE IS OFF
{{BZE{R9{BPF10{{OR IF THERE IS NO CALL TRACE
*
* HERE IF CALL TRACED
*
{{DCV{KVTRA{{{DECREMENT TRACE COUNT
{{BZE{4*TRFNC(R9){BPF11{{JUMP IF PRINT TRACE
{{JSR{TRXEQ{{{EXECUTE FUNCTION TYPE TRACE
{{EJC{{{{
*
* PFBLK (CONTINUED)
*
* HERE TO TEST FOR FTRACE TRACE
*
{BPF10{BZE{KVFTR{BPF16{{JUMP IF FTRACE IS OFF
{{DCV{KVFTR{{{ELSE DECREMENT FTRACE
*
* HERE FOR PRINT TRACE
*
{BPF11{JSR{PRTSN{{{PRINT STATEMENT NUMBER
{{JSR{PRTNM{{{PRINT FUNCTION NAME
{{MOV{#CH$PP{R6{{LOAD LEFT PAREN
{{JSR{PRTCH{{{PRINT LEFT PAREN
{{MOV{4*1(SP){R10{{RECOVER PFBLK POINTER
{{BZE{4*FARGS(R10){BPF15{{SKIP IF NO ARGUMENTS
{{ZER{R7{{{ELSE SET ARGUMENT COUNTER
{{BRN{BPF13{{{JUMP INTO LOOP
*
* LOOP TO PRINT ARGUMENT VALUES
*
{BPF12{MOV{#CH$CM{R6{{LOAD COMMA
{{JSR{PRTCH{{{PRINT TO SEPARATE FROM LAST ARG
*
* MERGE HERE FIRST TIME (NO COMMA REQUIRED)
*
{BPF13{MOV{R7{(SP){{SAVE ARG CTR (OVER FAILOFFS IS OK)
{{WTB{R7{{{CONVERT TO BYTE OFFSET
{{ADD{R7{R10{{POINT TO NEXT ARGUMENT POINTER
{{MOV{4*PFARG(R10){R9{{LOAD NEXT ARGUMENT VRBLK PTR
{{SUB{R7{R10{{RESTORE PFBLK POINTER
{{MOV{4*VRVAL(R9){R9{{LOAD NEXT VALUE
{{JSR{PRTVL{{{PRINT ARGUMENT VALUE
{{EJC{{{{
*
* HERE AFTER DEALING WITH ONE ARGUMENT
*
{{MOV{(SP){R7{{RESTORE ARGUMENT COUNTER
{{ICV{R7{{{INCREMENT ARGUMENT COUNTER
{{BLT{R7{4*FARGS(R10){BPF12{LOOP IF MORE TO PRINT
*
* MERGE HERE IN NO ARGS CASE TO PRINT PAREN
*
{BPF15{MOV{#CH$RP{R6{{LOAD RIGHT PAREN
{{JSR{PRTCH{{{PRINT TO TERMINATE OUTPUT
{{JSR{PRTNL{{{TERMINATE PRINT LINE
*
* MERGE HERE TO EXIT WITH TEST FOR FNCLEVEL TRACE
*
{BPF16{ICV{KVFNC{{{INCREMENT FNCLEVEL
{{MOV{R$FNC{R10{{LOAD PTR TO POSSIBLE TRBLK
{{JSR{KTREX{{{CALL KEYWORD TRACE ROUTINE
*
* CALL FUNCTION AFTER TRACE TESTS COMPLETE
*
{{MOV{4*1(SP){R10{{RESTORE PFBLK POINTER
{{BRN{BPF08{{{JUMP BACK TO EXECUTE FUNCTION
{{EJC{{{{
*
* RCBLK
*
* THE ROUTINE FOR AN RCBLK IS EXECUTED FROM THE GENERATED
* CODE TO LOAD A REAL VALUE ONTO THE STACK.
*
* (XR) POINTER TO RCBLK
*
{B$RCL{ENT{BL$RC{{{ENTRY POINT (RCBLK)
{{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
{{EJC{{{{
*
* SCBLK
*
* THE ROUTINE FOR AN SCBLK IS EXECUTED FROM THE GENERATED
* CODE TO LOAD A STRING VALUE ONTO THE STACK.
*
* (XR) POINTER TO SCBLK
*
{B$SCL{ENT{BL$SC{{{ENTRY POINT (SCBLK)
{{BRN{EXIXR{{{STACK XR AND OBEY NEXT CODE WORD
{{EJC{{{{
*
* TBBLK
*
* THE ROUTINE FOR A TBBLK IS NEVER EXECUTED
*
{B$TBT{ENT{BL$TB{{{ENTRY POINT (TBBLK)
{{EJC{{{{
*
* TEBLK
*
* THE ROUTINE FOR A TEBLK IS NEVER EXECUTED
*
{B$TET{ENT{BL$TE{{{ENTRY POINT (TEBLK)
{{EJC{{{{
*
* VCBLK
*
* THE ROUTINE FOR A VCBLK IS NEVER EXECUTED
*
{B$VCT{ENT{BL$VC{{{ENTRY POINT (VCBLK)
{{EJC{{{{
*
* VRBLK
*
* THE VRBLK ROUTINES ARE EXECUTED FROM THE GENERATED CODE.
* THERE ARE SIX ENTRIES FOR VRBLK COVERING VARIOUS CASES
*
{B$VR${ENT{BL$$I{{{MARK START OF VRBLK ENTRY POINTS
*
* ENTRY FOR VRGET (TRAPPED CASE). THIS ROUTINE IS CALLED
* FROM THE GENERATED CODE TO LOAD THE VALUE OF A VARIABLE.
* THIS ENTRY POINT IS USED IF AN ACCESS TRACE OR INPUT
* ASSOCIATION IS CURRENTLY ACTIVE.
*
* (XR) POINTER TO VRGET FIELD OF VRBLK
*
{B$VRA{ENT{BL$$I{{{ENTRY POINT
{{MOV{R9{R10{{COPY NAME BASE (VRGET = 0)
{{MOV{#4*VRVAL{R6{{SET NAME OFFSET
{{JSR{ACESS{{{ACCESS VALUE
{{PPM{EXFAL{{{FAIL IF ACCESS FAILS
{{BRN{EXIXR{{{ELSE EXIT WITH RESULT IN XR
{{EJC{{{{
*
* VRBLK (CONTINUED)
*
* ENTRY FOR VRSTO (ERROR CASE. THIS ROUTINE IS CALLED FROM
* THE EXECUTED CODE FOR AN ATTEMPT TO MODIFY THE VALUE
* OF A PROTECTED (PATTERN VALUED) NATURAL VARIABLE.
*
{B$VRE{ENT{{{{ENTRY POINT
{{ERB{042{ATTEMPT{{TO CHANGE VALUE OF PROTECTED VARIABLE
{{EJC{{{{
*
* VRBLK (CONTINUED)
*
* ENTRY FOR VRTRA (UNTRAPPED CASE). THIS ROUTINE IS CALLED
* FROM THE EXECUTED CODE TO TRANSFER TO A LABEL.
*
* (XR) POINTER TO VRTRA FIELD OF VRBLK
*
{B$VRG{ENT{{{{ENTRY POINT
{{MOV{4*VRLBO(R9){R9{{LOAD CODE POINTER
{{MOV{(R9){R10{{LOAD ENTRY ADDRESS
{{BRI{R10{{{JUMP TO ROUTINE FOR NEXT CODE WORD
{{EJC{{{{
*
* VRBLK (CONTINUED)
*
* ENTRY FOR VRGET (UNTRAPPED CASE). THIS ROUTINE IS CALLED
* FROM THE GENERATED CODE TO LOAD THE VALUE OF A VARIABLE.
*
* (XR) POINTS TO VRGET FIELD OF VRBLK
*
{B$VRL{ENT{{{{ENTRY POINT
{{MOV{4*VRVAL(R9){-(SP){{LOAD VALUE ONTO STACK (VRGET = 0)
{{BRN{EXITS{{{OBEY NEXT CODE WORD
{{EJC{{{{
*
* VRBLK (CONTINUED)
*
* ENTRY FOR VRSTO (UNTRAPPED CASE). THIS ROUTINE IS CALLED
* FROM THE GENERATED CODE TO STORE THE VALUE OF A VARIABLE.
*
* (XR) POINTER TO VRSTO FIELD OF VRBLK
*
{B$VRS{ENT{{{{ENTRY POINT
{{MOV{(SP){4*VRVLO(R9){{STORE VALUE, LEAVE ON STACK
{{BRN{EXITS{{{OBEY NEXT CODE WORD
{{EJC{{{{
*
* VRBLK (CONTINUED)
*
* VRTRA (TRAPPED CASE). THIS ROUTINE IS CALLED FROM THE
* GENERATED CODE TO TRANSFER TO A LABEL WHEN A LABEL
* TRACE IS CURRENTLY ACTIVE.
*
{B$VRT{ENT{{{{ENTRY POINT
{{SUB{#4*VRTRA{R9{{POINT BACK TO START OF VRBLK
{{MOV{R9{R10{{COPY VRBLK POINTER
{{MOV{#4*VRVAL{R6{{SET NAME OFFSET
{{MOV{4*VRLBL(R10){R9{{LOAD POINTER TO TRBLK
{{BZE{KVTRA{BVRT2{{JUMP IF TRACE IS OFF
{{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT
{{BZE{4*TRFNC(R9){BVRT1{{JUMP IF PRINT TRACE CASE
{{JSR{TRXEQ{{{ELSE EXECUTE FULL TRACE
{{BRN{BVRT2{{{MERGE TO JUMP TO LABEL
*
* HERE FOR PRINT TRACE -- PRINT COLON ( LABEL NAME )
*
{BVRT1{JSR{PRTSN{{{PRINT STATEMENT NUMBER
{{MOV{R10{R9{{COPY VRBLK POINTER
{{MOV{#CH$CL{R6{{COLON
{{JSR{PRTCH{{{PRINT IT
{{MOV{#CH$PP{R6{{LEFT PAREN
{{JSR{PRTCH{{{PRINT IT
{{JSR{PRTVN{{{PRINT LABEL NAME
{{MOV{#CH$RP{R6{{RIGHT PAREN
{{JSR{PRTCH{{{PRINT IT
{{JSR{PRTNL{{{TERMINATE LINE
{{MOV{4*VRLBL(R10){R9{{POINT BACK TO TRBLK
*
* MERGE HERE TO JUMP TO LABEL
*
{BVRT2{MOV{4*TRLBL(R9){R9{{LOAD POINTER TO ACTUAL CODE
{{BRI{(R9){{{EXECUTE STATEMENT AT LABEL
{{EJC{{{{
*
* VRBLK (CONTINUED)
*
* ENTRY FOR VRSTO (TRAPPED CASE). THIS ROUTINE IS CALLED
* FROM THE GENERATED CODE TO STORE THE VALUE OF A VARIABLE.
* THIS ENTRY IS USED WHEN A VALUE TRACE OR OUTPUT
* ASSOCIATION IS CURRENTLY ACTIVE.
*
* (XR) POINTER TO VRSTO FIELD OF VRBLK
*
{B$VRV{ENT{{{{ENTRY POINT
{{MOV{(SP){R7{{LOAD VALUE (LEAVE COPY ON STACK)
{{SUB{#4*VRSTO{R9{{POINT TO VRBLK
{{MOV{R9{R10{{COPY VRBLK POINTER
{{MOV{#4*VRVAL{R6{{SET OFFSET
{{JSR{ASIGN{{{CALL ASSIGNMENT ROUTINE
{{PPM{EXFAL{{{FAIL IF ASSIGNMENT FAILS
{{BRN{EXITS{{{ELSE RETURN WITH RESULT ON STACK
{{EJC{{{{
*
* XNBLK
*
* THE ROUTINE FOR AN XNBLK IS NEVER EXECUTED
*
{B$XNT{ENT{BL$XN{{{ENTRY POINT (XNBLK)
{{EJC{{{{
*
* XRBLK
*
* THE ROUTINE FOR AN XRBLK IS NEVER EXECUTED
*
{B$XRT{ENT{BL$XR{{{ENTRY POINT (XRBLK)
*
* MARK ENTRY ADDRESS PAST LAST BLOCK ACTION ROUTINE
*
{B$YYY{ENT{BL$$I{{{LAST BLOCK ROUTINE ENTRY POINT
{{TTL{S{{{P I T B O L -- PATTERN MATCHING ROUTINES
*
* THE FOLLOWING SECTION CONSISTS OF THE PATTERN MATCHING
* ROUTINES. ALL PATTERN NODES CONTAIN A POINTER (PCODE)
* TO ONE OF THE ROUTINES IN THIS SECTION (P$XXX).
*
* NOTE THAT THIS SECTION FOLLOWS THE B$XXX ROUTINES TO
* ENABLE A FAST TEST FOR THE PATTERN DATATYPE.
*
{P$AAA{ENT{BL$$I{{{ENTRY TO MARK FIRST PATTERN
*
*
* THE ENTRY CONDITIONS TO THE MATCH ROUTINE ARE AS FOLLOWS
* (SEE O$PMN, O$PMV, O$PMS AND PROCEDURE MATCH).
*
* STACK CONTENTS.
*
* NAME BASE (O$PMN ONLY)
* NAME OFFSET (O$PMN ONLY)
* TYPE (0-O$PMN, 1-O$PMV, 2-O$PMS)
* PMHBS --------------- INITIAL CURSOR (ZERO)
* INITIAL NODE POINTER
* XS ------------------ =NDABO (ANCHORED), =NDUNA (UNANCH)
*
* REGISTER VALUES.
*
* (XS) SET AS SHOWN IN STACK DIAGRAM
* (XR) POINTER TO INITIAL PATTERN NODE
* (WB) INITIAL CURSOR (ZERO)
*
* GLOBAL PATTERN VALUES
*
* R$PMS POINTER TO SUBJECT STRING SCBLK
* PMSSL LENGTH OF SUBJECT STRING IN CHARS
* PMDFL DOT FLAG, INITIALLY ZERO
* PMHBS SET AS SHOWN IN STACK DIAGRAM
*
* CONTROL IS PASSED BY BRANCHING THROUGH THE PCODE
* FIELD OF THE INITIAL PATTERN NODE (BRI (XR)).
{{EJC{{{{
*
* DESCRIPTION OF ALGORITHM
*
* A PATTERN STRUCTURE IS REPRESENTED AS A LINKED GRAPH
* OF NODES WITH THE FOLLOWING STRUCTURE.
*
* +------------------------------------+
* I PCODE I
* +------------------------------------+
* I PTHEN I
* +------------------------------------+
* I PARM1 I
* +------------------------------------+
* I PARM2 I
* +------------------------------------+
*
* PCODE IS A POINTER TO THE ROUTINE WHICH WILL PERFORM
* THE MATCH OF THIS PARTICULAR NODE TYPE.
*
* PTHEN IS A POINTER TO THE SUCCESSOR NODE. I.E. THE NODE
* TO BE MATCHED IF THE ATTEMPT TO MATCH THIS NODE SUCCEEDS.
* IF THIS IS THE LAST NODE OF THE PATTERN PTHEN POINTS
* TO THE DUMMY NODE NDNTH WHICH INITIATES PATTERN EXIT.
*
* PARM1, PARM2 ARE PARAMETERS WHOSE USE VARIES WITH THE
* PARTICULAR NODE. THEY ARE ONLY PRESENT IF REQUIRED.
*
* ALTERNATIVES ARE HANDLED WITH THE SPECIAL ALTERNATIVE
* NODE WHOSE PARAMETER POINTS TO THE NODE TO BE MATCHED
* IF THERE IS A FAILURE ON THE SUCCESSOR PATH.
*
* THE FOLLOWING EXAMPLE ILLUSTRATES THE MANNER IN WHICH
* THE STRUCTURE IS BUILT UP. THE PATTERN IS
*
* (A / B / C) (D / E) WHERE / IS ALTERNATION
*
* IN THE DIAGRAM, THE NODE MARKED + REPRESENTS AN
* ALTERNATIVE NODE AND THE DOTTED LINE FROM A + NODE
* REPRESENTS THE PARAMETER POINTER TO THE ALTERNATIVE.
*
* +---+ +---+ +---+ +---+
* I + I-----I A I-----I + I-----I D I-----
* +---+ +---+ I +---+ +---+
* . I .
* . I .
* +---+ +---+ I +---+
* I + I-----I B I--I I E I-----
* +---+ +---+ I +---+
* . I
* . I
* +---+ I
* I C I------------I
* +---+
{{EJC{{{{
*
* DURING THE MATCH, THE REGISTERS ARE USED AS FOLLOWS.
*
* (XR) POINTS TO THE CURRENT NODE
* (XL) SCRATCH
* (XS) MAIN STACK POINTER
* (WB) CURSOR (NUMBER OF CHARS MATCHED)
* (WA,WC) SCRATCH
*
* TO KEEP TRACK OF ALTERNATIVES, THE MAIN STACK IS USED AS
* A HISTORY STACK AND CONTAINS TWO WORD ENTRIES.
*
* WORD 1 SAVED CURSOR VALUE
* WORD 2 NODE TO MATCH ON FAILURE
*
* WHEN A FAILURE OCCURS, THE MOST RECENT ENTRY ON THIS
* STACK IS POPPED OFF TO RESTORE THE CURSOR AND POINT
* TO THE NODE TO BE MATCHED AS AN ALTERNATIVE. THE ENTRY
* AT THE BOTTOM OF THE STACK POINTS TO THE FOLLOWING
* SPECIAL NODES DEPENDING ON THE SCAN MODE.
*
* ANCHORED MODE THE BOTTOM ENTRY POINTS TO THE
* SPECIAL NODE NDABO WHICH CAUSES AN
* ABORT. THE CURSOR VALUE STORED
* WITH THIS ENTRY IS ALWAYS ZERO.
*
* UNANCHORED MODE THE BOTTOM ENTRY POINTS TO THE
* SPECIAL NODE NDUNA WHICH MOVES THE
* ANCHOR POINT AND RESTARTS THE MATCH
* THE CURSOR SAVED WITH THIS ENTRY
* IS THE NUMBER OF CHARACTERS WHICH
* LIE BEFORE THE INITIAL ANCHOR POINT
* (I.E. THE NUMBER OF ANCHOR MOVES).
* THIS ENTRY IS THREE WORDS LONG AND
* ALSO CONTAINS THE INITIAL PATTERN.
*
* ENTRIES ARE MADE ON THIS HISTORY STACK BY ALTERNATIVE
* NODES AND BY SOME SPECIAL COMPOUD PATTERNS AS DESCRIBED
* LATER ON. THE FOLLOWING GLOBAL LOCATIONS ARE USED DURING
* PATTERN MATCHING.
*
* R$PMS POINTER TO SUBJECT STRING
* PMSSL LENGTH OF SUBJECT STRING
* PMDFL FLAG SET NON-ZERO FOR DOT PATTERNS
* PMHBS BASE PTR FOR CURRENT HISTORY STACK
*
* THE FOLLOWING EXIT POINTS ARE AVAILABLE TO MATCH ROUTINES
*
* SUCCP SUCCESS IN MATCHING CURRENT NODE
* FAILP FAILURE IN MATCHING CURRENT NODE
{{EJC{{{{
*
* COMPOUND PATTERNS
*
* SOME PATTERNS HAVE IMPLICIT ALTERNATIVES AND THEIR
* REPRESENTATION IN THE PATTERN STRUCTURE CONSISTS OF A
* LINKED SET OF NODES AS INDICATED BY THESE DIAGRAMS.
*
* AS BEFORE, THE + REPRESENTS AN ALTERNATIVE NODE AND
* THE DOTTED LINE FROM A + NODE IS THE PARAMETER POINTER
* TO THE ALTERNATIVE PATTERN.
*
* ARB
* ---
*
* +---+ THIS NODE (P$ARB) MATCHES NULL
* I B I----- AND STACKS CURSOR, SUCCESSOR PTR,
* +---+ CURSOR (COPY) AND A PTR TO NDARC.
*
*
*
*
* BAL
* ---
*
* +---+ THE P$BAL NODE SCANS A BALANCED
* I B I----- STRING AND THEN STACKS A POINTER
* +---+ TO ITSELF ON THE HISTORY STACK.
{{EJC{{{{
*
* COMPOUND PATTERN STRUCTURES (CONTINUED)
*
*
* ARBNO
* -----
*
* +---+ THIS ALTERNATIVE NODE MATCHES NULL
* +----I + I----- THE FIRST TIME AND STACKS A POINTER
* I +---+ TO THE ARGUMENT PATTERN X.
* I .
* I .
* I +---+ NODE (P$ABA) TO STACK CURSOR
* I I A I AND HISTORY STACK BASE PTR.
* I +---+
* I I
* I I
* I +---+ THIS IS THE ARGUMENT PATTERN. AS
* I I X I INDICATED, THE SUCCESSOR OF THE
* I +---+ PATTERN IS THE P$ABC NODE
* I I
* I I
* I +---+ THIS NODE (P$ABC) POPS PMHBS,
* +----I C I STACKS OLD PMHBS AND PTR TO NDABD
* +---+ (UNLESS OPTIMISATION HAS OCCURRED)
*
* STRUCTURE AND EXECUTION OF THIS PATTERN RESEMBLE THOSE OF
* RECURSIVE PATTERN MATCHING AND IMMEDIATE ASSIGNMENT.
* THE ALTERNATIVE NODE AT THE HEAD OF THE STRUCTURE MATCHES
* NULL INITIALLY BUT ON SUBSEQUENT FAILURE ENSURES ATTEMPT
* TO MATCH THE ARGUMENT. BEFORE THE ARGUMENT IS MATCHED
* P$ABA STACKS THE CURSOR,PMHBS AND A PTR TO P$ABB. IF
* THE ARGUMENT CANT BE MATCHED , P$ABB REMOVES THIS SPECIAL
* STACK ENTRY AND FAILS.
* IF ARGUMENT IS MATCHED , P$ABC RESTORES THE OUTER PMHBS
* VALUE (SAVED BY P$ABA) . THEN IF THE ARGUMENT HAS LEFT
* ALTERNATIVES ON STACK IT STACKS THE INNER VALUE OF PMHBS
* AND A PTR TO NDABD. IF ARGUMENT LEFT NOTHING ON THE STACK
* IT OPTIMISES BY REMOVING ITEMS STACKED BY P$ABA. FINALLY
* A CHECK IS MADE THAT ARGUMENT MATCHED MORE THAN THE NULL
* STRING (CHECK IS INTENDED TO PREVENT USELESS LOOPING).
* IF SO THE SUCCESSOR IS AGAIN THE ALTERNATIVE NODE AT THE
* HEAD OF THE STRUCTURE , ENSURING A POSSIBLE EXTRA ATTEMPT
* TO MATCH THE ARG IF NECESSARY. IF NOT , THE SUCCESSOR TO
* ALTERNATIVE IS TAKEN SO AS TO TERMINATE THE LOOP. P$ABD
* RESTORES INNER PMHBS PTR AND FAILS , THUS TRYING TO MATCH
* ALTERNATIVES LEFT BY THE ARBNO ARGUMENT.
{{EJC{{{{
*
* COMPOUND PATTERN STRUCTURES (CONTINUED)
*
* BREAKX
* ------
*
* +---+ THIS NODE IS A BREAK NODE FOR
* +----I B I THE ARGUMENT TO BREAKX, IDENTICAL
* I +---+ TO AN ORDINARY BREAK NODE.
* I I
* I I
* I +---+ THIS ALTERNATIVE NODE STACKS A
* I I + I----- POINTER TO THE BREAKX NODE TO
* I +---+ ALLOW FOR SUBSEQUENT FAILURE
* I .
* I .
* I +---+ THIS IS THE BREAKX NODE ITSELF. IT
* +----I X I MATCHES ONE CHARACTER AND THEN
* +---+ PROCEEDS BACK TO THE BREAK NODE.
*
*
*
*
* FENCE
* -----
*
* +---+ THE FENCE NODE MATCHES NULL AND
* I F I----- STACKS A POINTER TO NODE NDABO TO
* +---+ ABORT ON A SUBSEQUENT REMATCH
*
*
*
*
* SUCCEED
* -------
*
* +---+ THE NODE FOR SUCCEED MATCHES NULL
* I S I----- AND STACKS A POINTER TO ITSELF
* +---+ TO REPEAT THE MATCH ON A FAILURE.
{{EJC{{{{
*
* COMPOUND PATTERNS (CONTINUED)
*
* BINARY DOT (PATTERN ASSIGNMENT)
* -------------------------------
*
* +---+ THIS NODE (P$PAA) SAVES THE CURRENT
* I A I CURSOR AND A POINTER TO THE
* +---+ SPECIAL NODE NDPAB ON THE STACK.
* I
* I
* +---+ THIS IS THE STRUCTURE FOR THE
* I X I PATTERN LEFT ARGUMENT OF THE
* +---+ PATTERN ASSIGNMENT CALL.
* I
* I
* +---+ THIS NODE (P$PAC) SAVES THE CURSOR,
* I C I----- A PTR TO ITSELF, THE CURSOR (COPY)
* +---+ AND A PTR TO NDPAD ON THE STACK.
*
*
* THE FUNCTION OF THE MATCH ROUTINE FOR NDPAB (P$PAB)
* IS SIMPLY TO UNSTACK ITSELF AND FAIL BACK ONTO THE STACK.
*
* THE MATCH ROUTINE FOR P$PAC ALSO SETS THE GLOBAL PATTERN
* FLAG PMDFL NON-ZERO TO INDICATE THAT PATTERN ASSIGNMENTS
* MAY HAVE OCCURED IN THE PATTERN MATCH
*
* IF PMDFL IS SET AT THE END OF THE MATCH (SEE P$NTH), THE
* HISTORY STACK IS SCANNED FOR MATCHING NDPAB-NDPAD PAIRS
* AND THE CORRESPONDING PATTERN ASSIGNMENTS ARE EXECUTED.
*
* THE FUNCTION OF THE MATCH ROUTINE FOR NDPAD (P$PAD)
* IS SIMPLY TO REMOVE ITS ENTRY FROM THE STACK AND FAIL.
* THIS INCLUDES REMOVING THE SPECIAL NODE POINTER STORED
* IN ADDITION TO THE STANDARD TWO ENTRIES ON THE STACK.
{{EJC{{{{
*
* COMPOUNT PATTERN STRUCTURES (CONTINUED)
*
* FENCE (FUNCTION)
* ----------------
*
* +---+ THIS NODE (P$FNA) SAVES THE
* I A I CURRENT HISTORY STACK AND A
* +---+ POINTER TO NDFNB ON THE STACK.
* I
* I
* +---+ THIS IS THE PATTERN STRUCTURE
* I X I GIVEN AS THE ARGUMENT TO THE
* +---+ FENCE FUNCTION.
* I
* I
* +---+ THIS NODE P$FNC RESTORES THE OUTER
* I C I HISTORY STACK PTR SAVED IN P$FNA,
* +---+ AND STACKS THE INNER STACK BASE
* PTR AND A POINTER TO NDFND ON THE
* STACK.
*
* NDFNB (F$FNB) SIMPLY IS THE FAILURE EXIT FOR PATTERN
* ARGUMENT FAILURE, AND IT POPS ITSELF AND FAILS ONTO THE
* STACK.
*
* THE MATCH ROUTINE P$FNC ALLOWS FOR AN OPTIMIZATION WHEN
* THE FENCE PATTERN LEAVES NO ALTERNATIVES. IN THIS CASE,
* THE NDFNB ENTRY IS POPPED, AND THE MATCH CONTINUES.
*
* NDFND (P$FND) IS ENTERED WHEN THE PATTERN FAILS AFTER
* GOING THROUGH A NON-OPTIMIZED P$FNC, AND IT POPS THE
* STACK BACK PAST THE INNTER STACK BASE CREATED BY P$FNA
{{EJC{{{{
*
* COMPOUND PATTERNS (CONTINUED)
*
* EXPRESSION PATTERNS (RECURSIVE PATTERN MATCHES)
* -----------------------------------------------
*
* INITIAL ENTRY FOR A PATTERN NODE IS TO THE ROUTINE P$EXA.
* IF THE EVALUATED RESULT OF THE EXPRESSION IS ITSELF A
* PATTERN, THEN THE FOLLOWING STEPS ARE TAKEN TO ARRANGE
* FOR PROPER RECURSIVE PROCESSING.
*
* 1) A POINTER TO THE CURRENT NODE (THE P$EXA NODE) IS
* STORED ON THE HISTORY STACK WITH A DUMMY CURSOR.
*
* 2) A SPECIAL HISTORY STACK ENTRY IS MADE IN WHICH THE
* NODE POINTER POINTS TO NDEXB, AND THE CURSOR VALUE
* IS THE SAVED VALUE OF PMHBS ON ENTRY TO THIS NODE.
* THE MATCH ROUTINE FOR NDEXB (P$EXB) RESTORES PMHBS
* FROM THIS CURSOR ENTRY, POPS OFF THE P$EXA NODE
* POINTER AND FAILS.
*
* 3) THE RESULTING HISTORY STACK POINTER IS SAVED IN
* PMHBS TO ESTABLISH A NEW LEVEL OF HISTORY STACK.
*
* AFTER MATCHING A PATTERN, THE END OF MATCH ROUTINE GETS
* CONTROL (P$NTH). THIS ROUTINE PROCEEDS AS FOLLOWS.
*
* 1) LOAD THE CURRENT VALUE OF PMHBS AND RECOGNIZE THE
* OUTER LEVEL CASE BY THE FACT THAT THE ASSOCIATED
* CURSOR IN THIS CASE IS THE PATTERN MATCH TYPE CODE
* WHICH IS LESS THAN 3. TERMINATE THE MATCH IN THIS
* CASE AND CONTINUE EXECUTION OF THE PROGRAM.
*
* 2) OTHERWISE MAKE A SPECIAL HISTORY STACK ENTRY IN
* WHICH THE NODE POINTER POINTS TO THE SPECIAL NODE
* NDEXC AND THE CURSOR IS THE CURRENT VALUE OF PMHBS.
* THE MATCH ROUTINE FOR NDEXC (P$EXC) RESETS PMHBS TO
* THIS (INNER) VALUE AND AND THEN FAILS.
*
* 3) USING THE HISTORY STACK ENTRY MADE ON STARTING THE
* EXPRESSION (ACCESSIBLE WITH THE CURRENT VALUE OF
* PMHBS), RESTORE THE P$EXA NODE POINTER AND THE OLD
* PMHBS SETTING. TAKE THE SUCCESSOR AND CONTINUE.
*
* AN OPTIMIZATION IS POSSIBLE IF THE EXPRESSION PATTERN
* MAKES NO ENTRIES ON THE HISTORY STACK. IN THIS CASE,
* INSTEAD OF BUILDING THE P$EXC NODE IN STEP 2, IT IS MORE
* EFFICIENT TO SIMPLY POP OFF THE P$EXB ENTRY AND ITS
* ASSOCIATED NODE POINTER. THE EFFECT IS THE SAME.
{{EJC{{{{
*
* COMPOUND PATTERNS (CONTINUED)
*
* BINARY DOLLAR (IMMEDIATE ASSIGNMENT)
* ------------------------------------
*
* +---+ THIS NODE (P$IMA) STACKS THE CURSOR
* I A I PMHBS AND A PTR TO NDIMB AND RESETS
* +---+ THE STACK PTR PMHBS.
* I
* I
* +---+ THIS IS THE LEFT STRUCTURE FOR THE
* I X I PATTERN LEFT ARGUMENT OF THE
* +---+ IMMEDIATE ASSIGNMENT CALL.
* I
* I
* +---+ THIS NODE (P$IMC) PERFORMS THE
* I C I----- ASSIGNMENT, POPS PMHBS AND STACKS
* +---+ THE OLD PMHBS AND A PTR TO NDIMD.
*
*
* THE STRUCTURE AND EXECUTION OF THIS PATTERN ARE SIMILAR
* TO THOSE OF THE RECURSIVE EXPRESSION PATTERN MATCHING.
*
* THE MATCH ROUTINE FOR NDIMB (P$IMB) RESTORES THE OUTER
* LEVEL VALUE OF PMHBS, UNSTACKS THE SAVED CURSOR AND FAILS
*
* THE MATCH ROUTINE P$IMC USES THE CURRENT VALUE OF PMHBS
* TO LOCATE THE P$IMB ENTRY. THIS ENTRY IS USED TO MAKE
* THE ASSIGNMENT AND RESTORE THE OUTER LEVEL VALUE OF
* PMHBS. FINALLY, THE INNER LEVEL VALUE OF PMHBS AND A
* POINTER TO THE SPECIAL NODE NDIMD ARE STACKED.
*
* THE MATCH ROUTINE FOR NDIMD (P$IMD) RESTORES THE INNER
* LEVEL VALUE OF PMHBS AND FAILS BACK INTO THE STACK.
*
* AN OPTIMIZATION OCCURS IF THE INNER PATTERN MAKES NO
* ENTRIES ON THE HISTORY STACK. IN THIS CASE, P$IMC POPS
* THE P$IMB ENTRY INSTEAD OF MAKING A P$IMD ENTRY.
{{EJC{{{{
*
* ARBNO
*
* SEE COMPOUND PATTERNS SECTION FOR STUCTURE AND
* ALGORITHM FOR MATCHING THIS NODE TYPE.
*
* NO PARAMETERS
*
{P$ABA{ENT{BL$P0{{{P0BLK
{{MOV{R7{-(SP){{STACK CURSOR
{{MOV{R9{-(SP){{STACK DUMMY NODE PTR
{{MOV{PMHBS{-(SP){{STACK OLD STACK BASE PTR
{{MOV{#NDABB{-(SP){{STACK PTR TO NODE NDABB
{{MOV{SP{PMHBS{{STORE NEW STACK BASE PTR
{{BRN{SUCCP{{{SUCCEED
{{EJC{{{{
*
* ARBNO (REMOVE P$ABA SPECIAL STACK ENTRY)
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$ABB{ENT{{{{ENTRY POINT
{{MOV{R7{PMHBS{{RESTORE HISTORY STACK BASE PTR
{{BRN{FLPOP{{{FAIL AND POP DUMMY NODE PTR
{{EJC{{{{
*
* ARBNO (CHECK IF ARG MATCHED NULL STRING)
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$ABC{ENT{BL$P0{{{P0BLK
{{MOV{PMHBS{R10{{KEEP P$ABB STACK BASE
{{MOV{4*3(R10){R6{{LOAD INITIAL CURSOR
{{MOV{4*1(R10){PMHBS{{RESTORE OUTER STACK BASE PTR
{{BEQ{R10{SP{PABC1{JUMP IF NO HISTORY STACK ENTRIES
{{MOV{R10{-(SP){{ELSE SAVE INNER PMHBS ENTRY
{{MOV{#NDABD{-(SP){{STACK PTR TO SPECIAL NODE NDABD
{{BRN{PABC2{{{MERGE
*
* OPTIMISE CASE OF NO EXTRA ENTRIES ON STACK FROM ARBNO ARG
*
{PABC1{ADD{#4*NUM04{SP{{REMOVE NDABB ENTRY AND CURSOR
*
* MERGE TO CHECK FOR MATCHING OF NULL STRING
*
{PABC2{BNE{R6{R7{SUCCP{ALLOW FURTHER ATTEMPT IF NON-NULL
{{MOV{4*PTHEN(R9){R9{{BYPASS ALTERNATIVE NODE SO AS TO ..
{{BRN{SUCCP{{{... REFUSE FURTHER MATCH ATTEMPTS
{{EJC{{{{
*
* ARBNO (TRY FOR ALTERNATIVES IN ARBNO ARGUMENT)
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$ABD{ENT{{{{ENTRY POINT
{{MOV{R7{PMHBS{{RESTORE INNER STACK BASE PTR
{{BRN{FAILP{{{AND FAIL
{{EJC{{{{
*
* ABORT
*
* NO PARAMETERS
*
{P$ABO{ENT{BL$P0{{{P0BLK
{{BRN{EXFAL{{{SIGNAL STATEMENT FAILURE
{{EJC{{{{
*
* ALTERNATION
*
* PARM1 ALTERNATIVE NODE
*
{P$ALT{ENT{BL$P1{{{P1BLK
{{MOV{R7{-(SP){{STACK CURSOR
{{MOV{4*PARM1(R9){-(SP){{STACK POINTER TO ALTERNATIVE
{{CHK{{{{CHECK FOR STACK OVERFLOW
{{BRN{SUCCP{{{IF ALL OK, THEN SUCCEED
{{EJC{{{{
*
* ANY (ONE CHARACTER ARGUMENT) (1-CHAR STRING ALSO)
*
* PARM1 CHARACTER ARGUMENT
*
{P$ANS{ENT{BL$P1{{{P1BLK
{{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARS LEFT
{{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
{{PLC{R10{R7{{POINT TO CURRENT CHARACTER
{{LCH{R6{(R10){{LOAD CURRENT CHARACTER
{{BNE{R6{4*PARM1(R9){FAILP{FAIL IF NO MATCH
{{ICV{R7{{{ELSE BUMP CURSOR
{{BRN{SUCCP{{{AND SUCCEED
{{EJC{{{{
*
* ANY (MULTI-CHARACTER ARGUMENT CASE)
*
* PARM1 POINTER TO CTBLK
* PARM2 BIT MASK TO SELECT BIT IN CTBLK
*
{P$ANY{ENT{BL$P2{{{P2BLK
*
* EXPRESSION ARGUMENT CASE MERGES HERE
*
{PANY1{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARACTERS LEFT
{{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
{{PLC{R10{R7{{GET CHAR PTR TO CURRENT CHARACTER
{{LCH{R6{(R10){{LOAD CURRENT CHARACTER
{{MOV{4*PARM1(R9){R10{{POINT TO CTBLK
{{WTB{R6{{{CHANGE TO BYTE OFFSET
{{ADD{R6{R10{{POINT TO ENTRY IN CTBLK
{{MOV{4*CTCHS(R10){R6{{LOAD WORD FROM CTBLK
{{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT
{{ZRB{R6{FAILP{{FAIL IF NO MATCH
{{ICV{R7{{{ELSE BUMP CURSOR
{{BRN{SUCCP{{{AND SUCCEED
{{EJC{{{{
*
* ANY (EXPRESSION ARGUMENT)
*
* PARM1 EXPRESSION POINTER
*
{P$AYD{ENT{BL$P1{{{P1BLK
{{JSR{EVALS{{{EVALUATE STRING ARGUMENT
{{ERR{043{ANY{{EVALUATED ARGUMENT IS NOT STRING
{{PPM{FAILP{{{FAIL IF EVALUATION FAILURE
{{PPM{PANY1{{{MERGE MULTI-CHAR CASE IF OK
{{EJC{{{{
*
* P$ARB INITIAL ARB MATCH
*
* NO PARAMETERS
*
* THE P$ARB NODE IS PART OF A COMPOUND PATTERN STRUCTURE
* FOR AN ARB PATTERN (SEE DESCRIPTION OF COMPOUND PATTERNS)
*
{P$ARB{ENT{BL$P0{{{P0BLK
{{MOV{4*PTHEN(R9){R9{{LOAD SUCCESSOR POINTER
{{MOV{R7{-(SP){{STACK DUMMY CURSOR
{{MOV{R9{-(SP){{STACK SUCCESSOR POINTER
{{MOV{R7{-(SP){{STACK CURSOR
{{MOV{#NDARC{-(SP){{STACK PTR TO SPECIAL NODE NDARC
{{BRI{(R9){{{EXECUTE NEXT NODE MATCHING NULL
{{EJC{{{{
*
* P$ARC EXTEND ARB MATCH
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$ARC{ENT{{{{ENTRY POINT
{{BEQ{R7{PMSSL{FLPOP{FAIL AND POP STACK TO SUCCESSOR
{{ICV{R7{{{ELSE BUMP CURSOR
{{MOV{R7{-(SP){{STACK UPDATED CURSOR
{{MOV{R9{-(SP){{RESTACK POINTER TO NDARC NODE
{{MOV{4*2(SP){R9{{LOAD SUCCESSOR POINTER
{{BRI{(R9){{{OFF TO REEXECUTE SUCCESSOR NODE
{{EJC{{{{
*
* BAL
*
* NO PARAMETERS
*
* THE P$BAL NODE IS PART OF THE COMPOUND STRUCTURE BUILT
* FOR BAL (SEE SECTION ON COMPOUND PATTERNS).
*
{P$BAL{ENT{BL$P0{{{P0BLK
{{ZER{R8{{{ZERO PARENTHESES LEVEL COUNTER
{{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
{{PLC{R10{R7{{POINT TO CURRENT CHARACTER
{{BRN{PBAL2{{{JUMP INTO SCAN LOOP
*
* LOOP TO SCAN OUT CHARACTERS
*
{PBAL1{LCH{R6{(R10)+{{LOAD NEXT CHARACTER, BUMP POINTER
{{ICV{R7{{{PUSH CURSOR FOR CHARACTER
{{BEQ{R6{#CH$PP{PBAL3{JUMP IF LEFT PAREN
{{BEQ{R6{#CH$RP{PBAL4{JUMP IF RIGHT PAREN
{{BZE{R8{PBAL5{{ELSE SUCCEED IF AT OUTER LEVEL
*
* HERE AFTER PROCESSING ONE CHARACTER
*
{PBAL2{BNE{R7{PMSSL{PBAL1{LOOP BACK UNLESS END OF STRING
{{BRN{FAILP{{{IN WHICH CASE, FAIL
*
* HERE ON LEFT PAREN
*
{PBAL3{ICV{R8{{{BUMP PAREN LEVEL
{{BRN{PBAL2{{{LOOP BACK TO CHECK END OF STRING
*
* HERE FOR RIGHT PAREN
*
{PBAL4{BZE{R8{FAILP{{FAIL IF NO MATCHING LEFT PAREN
{{DCV{R8{{{ELSE DECREMENT LEVEL COUNTER
{{BNZ{R8{PBAL2{{LOOP BACK IF NOT AT OUTER LEVEL
*
* HERE AFTER SUCCESSFULLY SCANNING A BALANCED STRING
*
{PBAL5{MOV{R7{-(SP){{STACK CURSOR
{{MOV{R9{-(SP){{STACK PTR TO BAL NODE FOR EXTEND
{{BRN{SUCCP{{{AND SUCCEED
{{EJC{{{{
*
* BREAK (EXPRESSION ARGUMENT)
*
* PARM1 EXPRESSION POINTER
*
{P$BKD{ENT{BL$P1{{{P1BLK
{{JSR{EVALS{{{EVALUATE STRING EXPRESSION
{{ERR{044{BREAK{{EVALUATED ARGUMENT IS NOT STRING
{{PPM{FAILP{{{FAIL IF EVALUATION FAILS
{{PPM{PBRK1{{{MERGE WITH MULTI-CHAR CASE IF OK
{{EJC{{{{
*
* BREAK (ONE CHARACTER ARGUMENT)
*
* PARM1 CHARACTER ARGUMENT
*
{P$BKS{ENT{BL$P1{{{P1BLK
{{MOV{PMSSL{R8{{GET SUBJECT STRING LENGTH
{{SUB{R7{R8{{GET NUMBER OF CHARACTERS LEFT
{{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT
{{LCT{R8{R8{{SET COUNTER FOR CHARS LEFT
{{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
{{PLC{R10{R7{{POINT TO CURRENT CHARACTER
*
* LOOP TO SCAN TILL BREAK CHARACTER FOUND
*
{PBKS1{LCH{R6{(R10)+{{LOAD NEXT CHAR, BUMP POINTER
{{BEQ{R6{4*PARM1(R9){SUCCP{SUCCEED IF BREAK CHARACTER FOUND
{{ICV{R7{{{ELSE PUSH CURSOR
{{BCT{R8{PBKS1{{LOOP BACK IF MORE TO GO
{{BRN{FAILP{{{FAIL IF END OF STRING, NO BREAK CHR
{{EJC{{{{
*
* BREAK (MULTI-CHARACTER ARGUMENT)
*
* PARM1 POINTER TO CTBLK
* PARM2 BIT MASK TO SELECT BIT COLUMN
*
{P$BRK{ENT{BL$P2{{{P2BLK
*
* EXPRESSION ARGUMENT MERGES HERE
*
{PBRK1{MOV{PMSSL{R8{{LOAD SUBJECT STRING LENGTH
{{SUB{R7{R8{{GET NUMBER OF CHARACTERS LEFT
{{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT
{{LCT{R8{R8{{SET COUNTER FOR CHARACTERS LEFT
{{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
{{PLC{R10{R7{{POINT TO CURRENT CHARACTER
{{MOV{R9{PSAVE{{SAVE NODE POINTER
*
* LOOP TO SEARCH FOR BREAK CHARACTER
*
{PBRK2{LCH{R6{(R10)+{{LOAD NEXT CHAR, BUMP POINTER
{{MOV{4*PARM1(R9){R9{{LOAD POINTER TO CTBLK
{{WTB{R6{{{CONVERT TO BYTE OFFSET
{{ADD{R6{R9{{POINT TO CTBLK ENTRY
{{MOV{4*CTCHS(R9){R6{{LOAD CTBLK WORD
{{MOV{PSAVE{R9{{RESTORE NODE POINTER
{{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT
{{NZB{R6{SUCCP{{SUCCEED IF BREAK CHARACTER FOUND
{{ICV{R7{{{ELSE PUSH CURSOR
{{BCT{R8{PBRK2{{LOOP BACK UNLESS END OF STRING
{{BRN{FAILP{{{FAIL IF END OF STRING, NO BREAK CHR
{{EJC{{{{
*
* BREAKX (EXTENSION)
*
* THIS IS THE ENTRY WHICH CAUSES AN EXTENSION OF A BREAKX
* MATCH WHEN FAILURE OCCURS. SEE SECTION ON COMPOUND
* PATTERNS FOR FULL DETAILS OF BREAKX MATCHING.
*
* NO PARAMETERS
*
{P$BKX{ENT{BL$P0{{{P0BLK
{{ICV{R7{{{STEP CURSOR PAST PREVIOUS BREAK CHR
{{BRN{SUCCP{{{SUCCEED TO REMATCH BREAK
{{EJC{{{{
*
* BREAKX (EXPRESSION ARGUMENT)
*
* SEE SECTION ON COMPOUND PATTERNS FOR FULL STRUCTURE OF
* BREAKX PATTERN. THE ACTUAL CHARACTER MATCHING USES A
* BREAK NODE. HOWEVER, THE ENTRY FOR THE EXPRESSION
* ARGUMENT CASE IS SEPARATED TO GET PROPER ERROR MESSAGES.
*
* PARM1 EXPRESSION POINTER
*
{P$BXD{ENT{BL$P1{{{P1BLK
{{JSR{EVALS{{{EVALUATE STRING ARGUMENT
{{ERR{045{BREAKX{{EVALUATED ARGUMENT IS NOT STRING
{{PPM{FAILP{{{FAIL IF EVALUATION FAILS
{{PPM{PBRK1{{{MERGE WITH BREAK IF ALL OK
{{EJC{{{{
*
* CURSOR ASSIGNMENT
*
* PARM1 NAME BASE
* PARM2 NAME OFFSET
*
{P$CAS{ENT{BL$P2{{{P2BLK
{{MOV{R9{-(SP){{SAVE NODE POINTER
{{MOV{R7{-(SP){{SAVE CURSOR
{{MOV{4*PARM1(R9){R10{{LOAD NAME BASE
{{MTI{R7{{{LOAD CURSOR AS INTEGER
{{MOV{4*PARM2(R9){R7{{LOAD NAME OFFSET
{{JSR{ICBLD{{{GET ICBLK FOR CURSOR VALUE
{{MOV{R7{R6{{MOVE NAME OFFSET
{{MOV{R9{R7{{MOVE VALUE TO ASSIGN
{{JSR{ASINP{{{PERFORM ASSIGNMENT
{{PPM{FLPOP{{{FAIL ON ASSIGNMENT FAILURE
{{MOV{(SP)+{R7{{ELSE RESTORE CURSOR
{{MOV{(SP)+{R9{{RESTORE NODE POINTER
{{BRN{SUCCP{{{AND SUCCEED MATCHING NULL
{{EJC{{{{
*
* EXPRESSION NODE (P$EXA, INITIAL ENTRY)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
* ALGORITHMS FOR HANDLING EXPRESSION NODES.
*
* PARM1 EXPRESSION POINTER
*
{P$EXA{ENT{BL$P1{{{P1BLK
{{JSR{EVALP{{{EVALUATE EXPRESSION
{{PPM{FAILP{{{FAIL IF EVALUATION FAILS
{{BLO{R6{#P$AAA{PEXA1{JUMP IF RESULT IS NOT A PATTERN
*
* HERE IF RESULT OF EXPRESSION IS A PATTERN
*
{{MOV{R7{-(SP){{STACK DUMMY CURSOR
{{MOV{R9{-(SP){{STACK PTR TO P$EXA NODE
{{MOV{PMHBS{-(SP){{STACK HISTORY STACK BASE PTR
{{MOV{#NDEXB{-(SP){{STACK PTR TO SPECIAL NODE NDEXB
{{MOV{SP{PMHBS{{STORE NEW STACK BASE POINTER
{{MOV{R10{R9{{COPY NODE POINTER
{{BRI{(R9){{{MATCH FIRST NODE IN EXPRESSION PAT
*
* HERE IF RESULT OF EXPRESSION IS NOT A PATTERN
*
{PEXA1{BEQ{R6{#B$SCL{PEXA2{JUMP IF IT IS ALREADY A STRING
{{MOV{R10{-(SP){{ELSE STACK RESULT
{{MOV{R9{R10{{SAVE NODE POINTER
{{JSR{GTSTG{{{CONVERT RESULT TO STRING
{{ERR{046{EXPRESSION{{DOES NOT EVALUATE TO PATTERN
{{MOV{R9{R8{{COPY STRING POINTER
{{MOV{R10{R9{{RESTORE NODE POINTER
{{MOV{R8{R10{{COPY STRING POINTER AGAIN
*
* MERGE HERE WITH STRING POINTER IN XL
*
{PEXA2{BZE{4*SCLEN(R10){SUCCP{{JUST SUCCEED IF NULL STRING
{{BRN{PSTR1{{{ELSE MERGE WITH STRING CIRCUIT
{{EJC{{{{
*
* EXPRESSION NODE (P$EXB, REMOVE NDEXB ENTRY)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
* ALGORITHMS FOR HANDLING EXPRESSION NODES.
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$EXB{ENT{{{{ENTRY POINT
{{MOV{R7{PMHBS{{RESTORE OUTER LEVEL STACK POINTER
{{BRN{FLPOP{{{FAIL AND POP P$EXA NODE PTR
{{EJC{{{{
*
* EXPRESSION NODE (P$EXC, REMOVE NDEXC ENTRY)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
* ALGORITHMS FOR HANDLING EXPRESSION NODES.
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$EXC{ENT{{{{ENTRY POINT
{{MOV{R7{PMHBS{{RESTORE INNER STACK BASE POINTER
{{BRN{FAILP{{{AND FAIL INTO EXPR PATTERN ALTERNVS
{{EJC{{{{
*
* FAIL
*
* NO PARAMETERS
*
{P$FAL{ENT{BL$P0{{{P0BLK
{{BRN{FAILP{{{JUST SIGNAL FAILURE
{{EJC{{{{
*
* FENCE
*
* SEE COMPOUND PATTERNS SECTION FOR THE STRUCTURE AND
* ALGORITHM FOR MATCHING THIS NODE TYPE.
*
* NO PARAMETERS
*
{P$FEN{ENT{BL$P0{{{P0BLK
{{MOV{R7{-(SP){{STACK DUMMY CURSOR
{{MOV{#NDABO{-(SP){{STACK PTR TO ABORT NODE
{{BRN{SUCCP{{{AND SUCCEED MATCHING NULL
{{EJC{{{{
*
* FENCE (FUNCTION)
*
* SEE COMPOUND PATTERNS COMMENTS AT START OF THIS SECTION
* FOR DETAILS OF SCHEME
*
* NO PARAMETERS
*
{P$FNA{ENT{BL$P0{{{P0BLK
{{MOV{PMHBS{-(SP){{STACK CURRENT HISTORY STACK BASE
{{MOV{#NDFNB{-(SP){{STACK INDIR PTR TO P$FNB (FAILURE)
{{MOV{SP{PMHBS{{BEGIN NEW HISTORY STACK
{{BRN{SUCCP{{{SUCCEED
{{EJC{{{{
*
* FENCE (FUNCTION) (RESET HISTORY STACK AND FAIL)
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$FNB{ENT{BL$P0{{{P0BLK
{{MOV{R7{PMHBS{{RESTORE OUTER PMHBS STACK BASE
{{BRN{FAILP{{{...AND FAIL
{{EJC{{{{
*
* FENCE (FUNCTION) (MAKE FENCE TRAP ENTRY ON STACK)
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$FNC{ENT{BL$P0{{{P0BLK
{{MOV{PMHBS{R10{{GET INNER STACK BASE PTR
{{MOV{4*NUM01(R10){PMHBS{{RESTORE OUTER STACK BASE
{{BEQ{R10{SP{PFNC1{OPTIMIZE IF NO ALTERNATIVES
{{MOV{R10{-(SP){{ELSE STACK INNER STACK BASE
{{MOV{#NDFND{-(SP){{STACK PTR TO NDFND
{{BRN{SUCCP{{{SUCCEED
*
* HERE WHEN FENCE FUNCTION LEFT NOTHING ON THE STACK
*
{PFNC1{ADD{#4*NUM02{SP{{POP OFF P$FNB ENTRY
{{BRN{SUCCP{{{SUCCEED
{{EJC{{{{
*
* FENCE (FUNCTION) (SKIP PAST ALTERNATIVES ON FAILURE)
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$FND{ENT{BL$P0{{{P0BLK
{{MOV{R7{SP{{POP STACK TO FENCE() HISTORY BASE
{{BRN{FLPOP{{{POP BASE ENTRY AND FAIL
{{EJC{{{{
*
* IMMEDIATE ASSIGNMENT (INITIAL ENTRY, SAVE CURRENT CURSOR)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE
* STRUCTURE AND ALGORITHM FOR MATCHING THIS NODE TYPE.
*
* NO PARAMETERS
*
{P$IMA{ENT{BL$P0{{{P0BLK
{{MOV{R7{-(SP){{STACK CURSOR
{{MOV{R9{-(SP){{STACK DUMMY NODE POINTER
{{MOV{PMHBS{-(SP){{STACK OLD STACK BASE POINTER
{{MOV{#NDIMB{-(SP){{STACK PTR TO SPECIAL NODE NDIMB
{{MOV{SP{PMHBS{{STORE NEW STACK BASE POINTER
{{BRN{SUCCP{{{AND SUCCEED
{{EJC{{{{
*
* IMMEDIATE ASSIGNMENT (REMOVE CURSOR MARK ENTRY)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE
* STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE.
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$IMB{ENT{{{{ENTRY POINT
{{MOV{R7{PMHBS{{RESTORE HISTORY STACK BASE PTR
{{BRN{FLPOP{{{FAIL AND POP DUMMY NODE PTR
{{EJC{{{{
*
* IMMEDIATE ASSIGNMENT (PERFORM ACTUAL ASSIGNMENT)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE
* STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE.
*
* PARM1 NAME BASE OF VARIABLE
* PARM2 NAME OFFSET OF VARIABLE
*
{P$IMC{ENT{BL$P2{{{P2BLK
{{MOV{PMHBS{R10{{LOAD POINTER TO P$IMB ENTRY
{{MOV{R7{R6{{COPY FINAL CURSOR
{{MOV{4*3(R10){R7{{LOAD INITIAL CURSOR
{{MOV{4*1(R10){PMHBS{{RESTORE OUTER STACK BASE POINTER
{{BEQ{R10{SP{PIMC1{JUMP IF NO HISTORY STACK ENTRIES
{{MOV{R10{-(SP){{ELSE SAVE INNER PMHBS POINTER
{{MOV{#NDIMD{-(SP){{AND A PTR TO SPECIAL NODE NDIMD
{{BRN{PIMC2{{{MERGE
*
* HERE IF NO ENTRIES MADE ON HISTORY STACK
*
{PIMC1{ADD{#4*NUM04{SP{{REMOVE NDIMB ENTRY AND CURSOR
*
* MERGE HERE TO PERFORM ASSIGNMENT
*
{PIMC2{MOV{R6{-(SP){{SAVE CURRENT (FINAL) CURSOR
{{MOV{R9{-(SP){{SAVE CURRENT NODE POINTER
{{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
{{SUB{R7{R6{{COMPUTE SUBSTRING LENGTH
{{JSR{SBSTR{{{BUILD SUBSTRING
{{MOV{R9{R7{{MOVE RESULT
{{MOV{(SP){R9{{RELOAD NODE POINTER
{{MOV{4*PARM1(R9){R10{{LOAD NAME BASE
{{MOV{4*PARM2(R9){R6{{LOAD NAME OFFSET
{{JSR{ASINP{{{PERFORM ASSIGNMENT
{{PPM{FLPOP{{{FAIL IF ASSIGNMENT FAILS
{{MOV{(SP)+{R9{{ELSE RESTORE NODE POINTER
{{MOV{(SP)+{R7{{RESTORE CURSOR
{{BRN{SUCCP{{{AND SUCCEED
{{EJC{{{{
*
* IMMEDIATE ASSIGNMENT (REMOVE NDIMD ENTRY ON FAILURE)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR DETAILS OF THE
* STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE.
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$IMD{ENT{{{{ENTRY POINT
{{MOV{R7{PMHBS{{RESTORE INNER STACK BASE POINTER
{{BRN{FAILP{{{AND FAIL
{{EJC{{{{
*
* LEN (INTEGER ARGUMENT)
*
* PARM1 INTEGER ARGUMENT
*
{P$LEN{ENT{BL$P1{{{P1BLK
*
* EXPRESSION ARGUMENT CASE MERGES HERE
*
{PLEN1{ADD{4*PARM1(R9){R7{{PUSH CURSOR INDICATED AMOUNT
{{BLE{R7{PMSSL{SUCCP{SUCCEED IF NOT OFF END
{{BRN{FAILP{{{ELSE FAIL
{{EJC{{{{
*
* LEN (EXPRESSION ARGUMENT)
*
* PARM1 EXPRESSION POINTER
*
{P$LND{ENT{BL$P1{{{P1BLK
{{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT
{{ERR{047{LEN{{EVALUATED ARGUMENT IS NOT INTEGER
{{ERR{048{LEN{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
{{PPM{FAILP{{{FAIL IF EVALUATION FAILS
{{PPM{PLEN1{{{MERGE WITH NORMAL CIRCUIT IF OK
{{EJC{{{{
*
* NOTANY (EXPRESSION ARGUMENT)
*
* PARM1 EXPRESSION POINTER
*
{P$NAD{ENT{BL$P1{{{P1BLK
{{JSR{EVALS{{{EVALUATE STRING ARGUMENT
{{ERR{049{NOTANY{{EVALUATED ARGUMENT IS NOT STRING
{{PPM{FAILP{{{FAIL IF EVALUATION FAILS
{{PPM{PNAY1{{{MERGE WITH MULTI-CHAR CASE IF OK
{{EJC{{{{
*
* NOTANY (ONE CHARACTER ARGUMENT)
*
* PARM1 CHARACTER ARGUMENT
*
{P$NAS{ENT{BL$P1{{{ENTRY POINT
{{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARS LEFT
{{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
{{PLC{R10{R7{{POINT TO CURRENT CHARACTER IN STRIN
{{LCH{R6{(R10){{LOAD CURRENT CHARACTER
{{BEQ{R6{4*PARM1(R9){FAILP{FAIL IF MATCH
{{ICV{R7{{{ELSE BUMP CURSOR
{{BRN{SUCCP{{{AND SUCCEED
{{EJC{{{{
*
* NOTANY (MULTI-CHARACTER STRING ARGUMENT)
*
* PARM1 POINTER TO CTBLK
* PARM2 BIT MASK TO SELECT BIT COLUMN
*
{P$NAY{ENT{BL$P2{{{P2BLK
*
* EXPRESSION ARGUMENT CASE MERGES HERE
*
{PNAY1{BEQ{R7{PMSSL{FAILP{FAIL IF NO CHARACTERS LEFT
{{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
{{PLC{R10{R7{{POINT TO CURRENT CHARACTER
{{LCH{R6{(R10){{LOAD CURRENT CHARACTER
{{WTB{R6{{{CONVERT TO BYTE OFFSET
{{MOV{4*PARM1(R9){R10{{LOAD POINTER TO CTBLK
{{ADD{R6{R10{{POINT TO ENTRY IN CTBLK
{{MOV{4*CTCHS(R10){R6{{LOAD ENTRY FROM CTBLK
{{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT
{{NZB{R6{FAILP{{FAIL IF CHARACTER IS MATCHED
{{ICV{R7{{{ELSE BUMP CURSOR
{{BRN{SUCCP{{{AND SUCCEED
{{EJC{{{{
*
* END OF PATTERN MATCH
*
* THIS ROUTINE IS ENTERED ON SUCCESSFUL COMPLETION.
* SEE DESCRIPTION OF EXPRESSION PATTERNS IN COMPOUND
* PATTERN SECTION FOR HANDLING OF RECURSION IN MATCHING.
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$NTH{ENT{{{{ENTRY POINT
{{MOV{PMHBS{R10{{LOAD POINTER TO BASE OF STACK
{{MOV{4*1(R10){R6{{LOAD SAVED PMHBS (OR PATTERN TYPE)
{{BLE{R6{#NUM02{PNTH2{JUMP IF OUTER LEVEL (PATTERN TYPE)
*
* HERE WE ARE AT THE END OF MATCHING AN EXPRESSION PATTERN
*
{{MOV{R6{PMHBS{{RESTORE OUTER STACK BASE POINTER
{{MOV{4*2(R10){R9{{RESTORE POINTER TO P$EXA NODE
{{BEQ{R10{SP{PNTH1{JUMP IF NO HISTORY STACK ENTRIES
{{MOV{R10{-(SP){{ELSE STACK INNER STACK BASE PTR
{{MOV{#NDEXC{-(SP){{STACK PTR TO SPECIAL NODE NDEXC
{{BRN{SUCCP{{{AND SUCCEED
*
* HERE IF NO HISTORY STACK ENTRIES DURING PATTERN
*
{PNTH1{ADD{#4*NUM04{SP{{REMOVE P$EXB ENTRY AND NODE PTR
{{BRN{SUCCP{{{AND SUCCEED
*
* HERE IF END OF MATCH AT OUTER LEVEL
*
{PNTH2{MOV{R7{PMSSL{{SAVE FINAL CURSOR IN SAFE PLACE
{{BZE{PMDFL{PNTH6{{JUMP IF NO PATTERN ASSIGNMENTS
{{EJC{{{{
*
* END OF PATTERN MATCH (CONTINUED)
*
* NOW WE MUST PERFORM PATTERN ASSIGNMENTS. THIS IS DONE BY
* SCANNING THE HISTORY STACK FOR MATCHING NDPAB-NDPAD PAIRS
*
{PNTH3{DCA{R10{{{POINT PAST CURSOR ENTRY
{{MOV{-(R10){R6{{LOAD NODE POINTER
{{BEQ{R6{#NDPAD{PNTH4{JUMP IF NDPAD ENTRY
{{BNE{R6{#NDPAB{PNTH5{JUMP IF NOT NDPAB ENTRY
*
* HERE FOR NDPAB ENTRY, STACK INITIAL CURSOR
* NOTE THAT THERE MUST BE MORE ENTRIES ON THE STACK.
*
{{MOV{4*1(R10){-(SP){{STACK INITIAL CURSOR
{{CHK{{{{CHECK FOR STACK OVERFLOW
{{BRN{PNTH3{{{LOOP BACK IF OK
*
* HERE FOR NDPAD ENTRY. THE STARTING CURSOR FROM THE
* MATCHING NDPAD ENTRY IS NOW THE TOP STACK ENTRY.
*
{PNTH4{MOV{4*1(R10){R6{{LOAD FINAL CURSOR
{{MOV{(SP){R7{{LOAD INITIAL CURSOR FROM STACK
{{MOV{R10{(SP){{SAVE HISTORY STACK SCAN PTR
{{SUB{R7{R6{{COMPUTE LENGTH OF STRING
*
* BUILD SUBSTRING AND PERFORM ASSIGNMENT
*
{{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
{{JSR{SBSTR{{{CONSTRUCT SUBSTRING
{{MOV{R9{R7{{COPY SUBSTRING POINTER
{{MOV{(SP){R10{{RELOAD HISTORY STACK SCAN PTR
{{MOV{4*2(R10){R10{{LOAD POINTER TO P$PAC NODE WITH NAM
{{MOV{4*PARM2(R10){R6{{LOAD NAME OFFSET
{{MOV{4*PARM1(R10){R10{{LOAD NAME BASE
{{JSR{ASINP{{{PERFORM ASSIGNMENT
{{PPM{EXFAL{{{MATCH FAILS IF NAME EVAL FAILS
{{MOV{(SP)+{R10{{ELSE RESTORE HISTORY STACK PTR
{{EJC{{{{
*
* END OF PATTERN MATCH (CONTINUED)
*
* HERE CHECK FOR END OF ENTRIES
*
{PNTH5{BNE{R10{SP{PNTH3{LOOP IF MORE ENTRIES TO SCAN
*
* HERE AFTER DEALING WITH PATTERN ASSIGNMENTS
*
{PNTH6{MOV{PMHBS{SP{{WIPE OUT HISTORY STACK
{{MOV{(SP)+{R7{{LOAD INITIAL CURSOR
{{MOV{(SP)+{R8{{LOAD MATCH TYPE CODE
{{MOV{PMSSL{R6{{LOAD FINAL CURSOR VALUE
{{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
{{ZER{R$PMS{{{CLEAR SUBJECT STRING PTR FOR GBCOL
{{BZE{R8{PNTH7{{JUMP IF CALL BY NAME
{{BEQ{R8{#NUM02{EXITS{EXIT IF STATEMENT LEVEL CALL
*
* HERE WE HAVE A CALL BY VALUE, BUILD SUBSTRING
*
{{SUB{R7{R6{{COMPUTE LENGTH OF STRING
{{JSR{SBSTR{{{BUILD SUBSTRING
{{BRN{EXIXR{{{AND EXIT WITH SUBSTRING VALUE
*
* HERE FOR CALL BY NAME, MAKE STACK ENTRIES FOR O$RPL
*
{PNTH7{MOV{R7{-(SP){{STACK INITIAL CURSOR
{{MOV{R6{-(SP){{STACK FINAL CURSOR
{{BZE{R$PMB{PNTH8{{SKIP IF SUBJECT NOT BUFFER
{{MOV{R$PMB{R10{{ELSE GET PTR TO BCBLK INSTEAD
*
* HERE WITH XL POINTING TO SCBLK OR BCBLK
*
{PNTH8{MOV{R10{-(SP){{STACK SUBJECT POINTER
{{BRN{EXITS{{{EXIT WITH SPECIAL ENTRY ON STACK
{{EJC{{{{
*
* POS (INTEGER ARGUMENT)
*
* PARM1 INTEGER ARGUMENT
*
{P$POS{ENT{BL$P1{{{P1BLK
*
* EXPRESSION ARGUMENT CASE MERGES HERE
*
{PPOS1{BEQ{R7{4*PARM1(R9){SUCCP{SUCCEED IF AT RIGHT LOCATION
{{BRN{FAILP{{{ELSE FAIL
{{EJC{{{{
*
* POS (EXPRESSION ARGUMENT)
*
* PARM1 EXPRESSION POINTER
*
{P$PSD{ENT{BL$P1{{{P1BLK
{{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT
{{ERR{050{POS{{EVALUATED ARGUMENT IS NOT INTEGER
{{ERR{051{POS{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
{{PPM{FAILP{{{FAIL IF EVALUATION FAILS
{{PPM{PPOS1{{{MERGE WITH NORMAL CASE IF OK
{{EJC{{{{
*
* PATTERN ASSIGNMENT (INITIAL ENTRY, SAVE CURSOR)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
* ALGORITHMS FOR MATCHING THIS NODE TYPE.
*
* NO PARAMETERS
*
{P$PAA{ENT{BL$P0{{{P0BLK
{{MOV{R7{-(SP){{STACK INITIAL CURSOR
{{MOV{#NDPAB{-(SP){{STACK PTR TO NDPAB SPECIAL NODE
{{BRN{SUCCP{{{AND SUCCEED MATCHING NULL
{{EJC{{{{
*
* PATTERN ASSIGNMENT (REMOVE SAVED CURSOR)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
* ALGORITHMS FOR MATCHING THIS NODE TYPE.
*
* NO PARAMETERS (DUMMY PATTERN)
*
{P$PAB{ENT{{{{ENTRY POINT
{{BRN{FAILP{{{JUST FAIL (ENTRY IS ALREADY POPPED)
{{EJC{{{{
*
* PATTERN ASSIGNMENT (END OF MATCH, MAKE ASSIGN ENTRY)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
* ALGORITHMS FOR MATCHING THIS NODE TYPE.
*
* PARM1 NAME BASE OF VARIABLE
* PARM2 NAME OFFSET OF VARIABLE
*
{P$PAC{ENT{BL$P2{{{P2BLK
{{MOV{R7{-(SP){{STACK DUMMY CURSOR VALUE
{{MOV{R9{-(SP){{STACK POINTER TO P$PAC NODE
{{MOV{R7{-(SP){{STACK FINAL CURSOR
{{MOV{#NDPAD{-(SP){{STACK PTR TO SPECIAL NDPAD NODE
{{MNZ{PMDFL{{{SET DOT FLAG NON-ZERO
{{BRN{SUCCP{{{AND SUCCEED
{{EJC{{{{
*
* PATTERN ASSIGNMENT (REMOVE ASSIGN ENTRY)
*
* SEE COMPOUND PATTERNS DESCRIPTION FOR THE STRUCTURE AND
* ALGORITHMS FOR MATCHING THIS NODE TYPE.
*
* NO PARAMETERS (DUMMY NODE)
*
{P$PAD{ENT{{{{ENTRY POINT
{{BRN{FLPOP{{{FAIL AND REMOVE P$PAC NODE
{{EJC{{{{
*
* REM
*
* NO PARAMETERS
*
{P$REM{ENT{BL$P0{{{P0BLK
{{MOV{PMSSL{R7{{POINT CURSOR TO END OF STRING
{{BRN{SUCCP{{{AND SUCCEED
{{EJC{{{{
*
* RPOS (EXPRESSION ARGUMENT)
*
* PARM1 EXPRESSION POINTER
*
{P$RPD{ENT{BL$P1{{{P1BLK
{{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT
{{ERR{052{RPOS{{EVALUATED ARGUMENT IS NOT INTEGER
{{ERR{053{RPOS{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
{{PPM{FAILP{{{FAIL IF EVALUATION FAILS
{{PPM{PRPS1{{{MERGE WITH NORMAL CASE IF OK
{{EJC{{{{
*
* RPOS (INTEGER ARGUMENT)
*
* PARM1 INTEGER ARGUMENT
*
{P$RPS{ENT{BL$P1{{{P1BLK
*
* EXPRESSION ARGUMENT CASE MERGES HERE
*
{PRPS1{MOV{PMSSL{R8{{GET LENGTH OF STRING
{{SUB{R7{R8{{GET NUMBER OF CHARACTERS REMAINING
{{BEQ{R8{4*PARM1(R9){SUCCP{SUCCEED IF AT RIGHT LOCATION
{{BRN{FAILP{{{ELSE FAIL
{{EJC{{{{
*
* RTAB (INTEGER ARGUMENT)
*
* PARM1 INTEGER ARGUMENT
*
{P$RTB{ENT{BL$P1{{{P1BLK
*
* EXPRESSION ARGUMENT CASE MERGES HERE
*
{PRTB1{MOV{R7{R8{{SAVE INITIAL CURSOR
{{MOV{PMSSL{R7{{POINT TO END OF STRING
{{BLT{R7{4*PARM1(R9){FAILP{FAIL IF STRING NOT LONG ENOUGH
{{SUB{4*PARM1(R9){R7{{ELSE SET NEW CURSOR
{{BGE{R7{R8{SUCCP{AND SUCCEED IF NOT TOO FAR ALREADY
{{BRN{FAILP{{{IN WHICH CASE, FAIL
{{EJC{{{{
*
* RTAB (EXPRESSION ARGUMENT)
*
* PARM1 EXPRESSION POINTER
*
{P$RTD{ENT{BL$P1{{{P1BLK
{{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT
{{ERR{054{RTAB{{EVALUATED ARGUMENT IS NOT INTEGER
{{ERR{055{RTAB{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
{{PPM{FAILP{{{FAIL IF EVALUATION FAILS
{{PPM{PRTB1{{{MERGE WITH NORMAL CASE IF SUCCESS
{{EJC{{{{
*
* SPAN (EXPRESSION ARGUMENT)
*
* PARM1 EXPRESSION POINTER
*
{P$SPD{ENT{BL$P1{{{P1BLK
{{JSR{EVALS{{{EVALUATE STRING ARGUMENT
{{ERR{056{SPAN{{EVALUATED ARGUMENT IS NOT STRING
{{PPM{FAILP{{{FAIL IF EVALUATION FAILS
{{PPM{PSPN1{{{MERGE WITH MULTI-CHAR CASE IF OK
{{EJC{{{{
*
* SPAN (MULTI-CHARACTER ARGUMENT CASE)
*
* PARM1 POINTER TO CTBLK
* PARM2 BIT MASK TO SELECT BIT COLUMN
*
{P$SPN{ENT{BL$P2{{{P2BLK
*
* EXPRESSION ARGUMENT CASE MERGES HERE
*
{PSPN1{MOV{PMSSL{R8{{COPY SUBJECT STRING LENGTH
{{SUB{R7{R8{{CALCULATE NUMBER OF CHARACTERS LEFT
{{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT
{{MOV{R$PMS{R10{{POINT TO SUBJECT STRING
{{PLC{R10{R7{{POINT TO CURRENT CHARACTER
{{MOV{R7{PSAVC{{SAVE INITIAL CURSOR
{{MOV{R9{PSAVE{{SAVE NODE POINTER
{{LCT{R8{R8{{SET COUNTER FOR CHARS LEFT
*
* LOOP TO SCAN MATCHING CHARACTERS
*
{PSPN2{LCH{R6{(R10)+{{LOAD NEXT CHARACTER, BUMP POINTER
{{WTB{R6{{{CONVERT TO BYTE OFFSET
{{MOV{4*PARM1(R9){R9{{POINT TO CTBLK
{{ADD{R6{R9{{POINT TO CTBLK ENTRY
{{MOV{4*CTCHS(R9){R6{{LOAD CTBLK ENTRY
{{MOV{PSAVE{R9{{RESTORE NODE POINTER
{{ANB{4*PARM2(R9){R6{{AND WITH SELECTED BIT
{{ZRB{R6{PSPN3{{JUMP IF NO MATCH
{{ICV{R7{{{ELSE PUSH CURSOR
{{BCT{R8{PSPN2{{LOOP BACK UNLESS END OF STRING
*
* HERE AFTER SCANNING MATCHING CHARACTERS
*
{PSPN3{BNE{R7{PSAVC{SUCCP{SUCCEED IF CHARS MATCHED
{{BRN{FAILP{{{ELSE FAIL IF NULL STRING MATCHED
{{EJC{{{{
*
* SPAN (ONE CHARACTER ARGUMENT)
*
* PARM1 CHARACTER ARGUMENT
*
{P$SPS{ENT{BL$P1{{{P1BLK
{{MOV{PMSSL{R8{{GET SUBJECT STRING LENGTH
{{SUB{R7{R8{{CALCULATE NUMBER OF CHARACTERS LEFT
{{BZE{R8{FAILP{{FAIL IF NO CHARACTERS LEFT
{{MOV{R$PMS{R10{{ELSE POINT TO SUBJECT STRING
{{PLC{R10{R7{{POINT TO CURRENT CHARACTER
{{MOV{R7{PSAVC{{SAVE INITIAL CURSOR
{{LCT{R8{R8{{SET COUNTER FOR CHARACTERS LEFT
*
* LOOP TO SCAN MATCHING CHARACTERS
*
{PSPS1{LCH{R6{(R10)+{{LOAD NEXT CHARACTER, BUMP POINTER
{{BNE{R6{4*PARM1(R9){PSPS2{JUMP IF NO MATCH
{{ICV{R7{{{ELSE PUSH CURSOR
{{BCT{R8{PSPS1{{AND LOOP UNLESS END OF STRING
*
* HERE AFTER SCANNING MATCHING CHARACTERS
*
{PSPS2{BNE{R7{PSAVC{SUCCP{SUCCEED IF CHARS MATCHED
{{BRN{FAILP{{{FAIL IF NULL STRING MATCHED
{{EJC{{{{
*
* MULTI-CHARACTER STRING
*
* NOTE THAT ONE CHARACTER STRINGS USE THE CIRCUIT FOR
* ONE CHARACTER ANY ARGUMENTS (P$AN1).
*
* PARM1 POINTER TO SCBLK FOR STRING ARG
*
{P$STR{ENT{BL$P1{{{P1BLK
{{MOV{4*PARM1(R9){R10{{GET POINTER TO STRING
*
* MERGE HERE AFTER EVALUATING EXPRESSION WITH STRING VALUE
*
{PSTR1{MOV{R9{PSAVE{{SAVE NODE POINTER
{{MOV{R$PMS{R9{{LOAD SUBJECT STRING POINTER
{{PLC{R9{R7{{POINT TO CURRENT CHARACTER
{{ADD{4*SCLEN(R10){R7{{COMPUTE NEW CURSOR POSITION
{{BGT{R7{PMSSL{FAILP{FAIL IF PAST END OF STRING
{{MOV{R7{PSAVC{{SAVE UPDATED CURSOR
{{MOV{4*SCLEN(R10){R6{{GET NUMBER OF CHARS TO COMPARE
{{PLC{R10{{{POINT TO CHARS OF TEST STRING
{{CMC{FAILP{FAILP{{COMPARE, FAIL IF NOT EQUAL
{{MOV{PSAVE{R9{{IF ALL MATCHED, RESTORE NODE PTR
{{MOV{PSAVC{R7{{RESTORE UPDATED CURSOR
{{BRN{SUCCP{{{AND SUCCEED
{{EJC{{{{
*
* SUCCEED
*
* SEE SECTION ON COMPOUND PATTERNS FOR DETAILS OF THE
* STRUCTURE AND ALGORITHMS FOR MATCHING THIS NODE TYPE
*
* NO PARAMETERS
*
{P$SUC{ENT{BL$P0{{{P0BLK
{{MOV{R7{-(SP){{STACK CURSOR
{{MOV{R9{-(SP){{STACK POINTER TO THIS NODE
{{BRN{SUCCP{{{SUCCEED MATCHING NULL
{{EJC{{{{
*
* TAB (INTEGER ARGUMENT)
*
* PARM1 INTEGER ARGUMENT
*
{P$TAB{ENT{BL$P1{{{P1BLK
*
* EXPRESSION ARGUMENT CASE MERGES HERE
*
{PTAB1{BGT{R7{4*PARM1(R9){FAILP{FAIL IF TOO FAR ALREADY
{{MOV{4*PARM1(R9){R7{{ELSE SET NEW CURSOR POSITION
{{BLE{R7{PMSSL{SUCCP{SUCCEED IF NOT OFF END
{{BRN{FAILP{{{ELSE FAIL
{{EJC{{{{
*
* TAB (EXPRESSION ARGUMENT)
*
* PARM1 EXPRESSION POINTER
*
{P$TBD{ENT{BL$P1{{{P1BLK
{{JSR{EVALI{{{EVALUATE INTEGER ARGUMENT
{{ERR{057{TAB{{EVALUATED ARGUMENT IS NOT INTEGER
{{ERR{058{TAB{{EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
{{PPM{FAILP{{{FAIL IF EVALUATION FAILS
{{PPM{PTAB1{{{MERGE WITH NORMAL CASE IF OK
{{EJC{{{{
*
* ANCHOR MOVEMENT
*
* NO PARAMETERS (DUMMY NODE)
*
{P$UNA{ENT{{{{ENTRY POINT
{{MOV{R7{R9{{COPY INITIAL PATTERN NODE POINTER
{{MOV{(SP){R7{{GET INITIAL CURSOR
{{BEQ{R7{PMSSL{EXFAL{MATCH FAILS IF AT END OF STRING
{{ICV{R7{{{ELSE INCREMENT CURSOR
{{MOV{R7{(SP){{STORE INCREMENTED CURSOR
{{MOV{R9{-(SP){{RESTACK INITIAL NODE PTR
{{MOV{#NDUNA{-(SP){{RESTACK UNANCHORED NODE
{{BRI{(R9){{{REMATCH FIRST NODE
{{EJC{{{{
*
* END OF PATTERN MATCH ROUTINES
*
* THE FOLLOWING ENTRY POINT MARKS THE END OF THE PATTERN
* MATCHING ROUTINES AND ALSO THE END OF THE ENTRY POINTS
* REFERENCED FROM THE FIRST WORD OF BLOCKS IN DYNAMIC STORE
*
{P$YYY{ENT{BL$$I{{{MARK LAST ENTRY IN PATTERN SECTION
{{TTL{S{{{P I T B O L -- PREDEFINED SNOBOL4 FUNCTIONS
*
* THE FOLLOWING SECTION CONTAINS CODING FOR FUNCTIONS
* WHICH ARE PREDEFINED AND AVAILABLE AT THE SNOBOL LEVEL.
*
* THESE ROUTINES RECEIVE CONTROL DIRECTLY FROM THE CODE OR
* INDIRECTLY THROUGH THE O$FNC, O$FNS OR CFUNC ROUTINES.
* IN BOTH CASES THE CONDITIONS ON ENTRY ARE AS FOLLOWS
*
* THE ARGUMENTS ARE ON THE STACK. THE NUMBER OF ARGUMENTS
* HAS BEEN ADJUSTED TO CORRESPOND TO THE SVBLK SVNAR FIELD.
*
* IN CERTAIN FUNCTIONS THE DIRECT CALL IS NOT PERMITTED
* AND IN THESE INSTANCES WE ALSO HAVE.
*
* (WA) ACTUAL NUMBER OF ARGUMENTS IN CALL
*
* CONTROL RETURNS BY PLACING THE FUNCTION RESULT VALUE ON
* ON THE STACK AND CONTINUING EXECUTION WITH THE NEXT
* WORD FROM THE GENERATED CODE.
*
* THE NAMES OF THE ENTRY POINTS OF THESE FUNCTIONS ARE OF
* THE FORM S$XXX WHERE XXX IS THE THREE LETTER CODE FOR
* THE SYSTEM VARIABLE NAME. THE FUNCTIONS ARE IN ORDER
* ALPHABETICALLY BY THEIR ENTRY NAMES.
{{EJC{{{{
*
* ANY
*
{S$ANY{ENT{{{{ENTRY POINT
{{MOV{#P$ANS{R7{{SET PCODE FOR SINGLE CHAR CASE
{{MOV{#P$ANY{R10{{PCODE FOR MULTI-CHAR CASE
{{MOV{#P$AYD{R8{{PCODE FOR EXPRESSION CASE
{{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE
{{ERR{059{ANY{{ARGUMENT IS NOT STRING OR EXPRESSION
{{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
{{EJC{{{{
*
* APPEND
*
{S$APN{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R10{{GET APPEND ARGUMENT
{{MOV{(SP)+{R9{{GET BCBLK
{{BEQ{(R9){#B$BCT{SAPN1{OK IF FIRST ARG IS BCBLK
{{ERB{275{APPEND{{FIRST ARGUMENT IS NOT BUFFER
*
* HERE TO DO THE APPEND
*
{SAPN1{JSR{APNDB{{{DO THE APPEND
{{ERR{276{APPEND{{SECOND ARGUMENT IS NOT STRING
{{PPM{EXFAL{{{NO ROOM - FAIL
{{BRN{EXNUL{{{EXIT WITH NULL RESULT
{{EJC{{{{
*
* APPLY
*
* APPLY DOES NOT PERMIT THE DIRECT (FAST) CALL SO THAT
* WA CONTAINS THE ACTUAL NUMBER OF ARGUMENTS PASSED.
*
{S$APP{ENT{{{{ENTRY POINT
{{BZE{R6{SAPP3{{JUMP IF NO ARGUMENTS
{{DCV{R6{{{ELSE GET APPLIED FUNC ARG COUNT
{{MOV{R6{R7{{COPY
{{WTB{R7{{{CONVERT TO BYTES
{{MOV{SP{R10{{COPY STACK POINTER
{{ADD{R7{R10{{POINT TO FUNCTION ARGUMENT ON STACK
{{MOV{(R10){R9{{LOAD FUNCTION PTR (APPLY 1ST ARG)
{{BZE{R6{SAPP2{{JUMP IF NO ARGS FOR APPLIED FUNC
{{LCT{R7{R6{{ELSE SET COUNTER FOR LOOP
*
* LOOP TO MOVE ARGUMENTS UP ON STACK
*
{SAPP1{DCA{R10{{{POINT TO NEXT ARGUMENT
{{MOV{(R10){4*1(R10){{MOVE ARGUMENT UP
{{BCT{R7{SAPP1{{LOOP TILL ALL MOVED
*
* MERGE HERE TO CALL FUNCTION (WA = NUMBER OF ARGUMENTS)
*
{SAPP2{ICA{SP{{{ADJUST STACK PTR FOR APPLY 1ST ARG
{{JSR{GTNVR{{{GET VARIABLE BLOCK ADDR FOR FUNC
{{PPM{SAPP3{{{JUMP IF NOT NATURAL VARIABLE
{{MOV{4*VRFNC(R9){R10{{ELSE POINT TO FUNCTION BLOCK
{{BRN{CFUNC{{{GO CALL APPLIED FUNCTION
*
* HERE FOR INVALID FIRST ARGUMENT
*
{SAPP3{ERB{060{APPLY{{FIRST ARG IS NOT NATURAL VARIABLE NAME
{{EJC{{{{
*
* ARBNO
*
* ARBNO BUILDS A COMPOUND PATTERN. SEE DESCRIPTION AT
* START OF PATTERN MATCHING SECTION FOR STRUCTURE FORMED.
*
{S$ABN{ENT{{{{ENTRY POINT
{{ZER{R9{{{SET PARM1 = 0 FOR THE MOMENT
{{MOV{#P$ALT{R7{{SET PCODE FOR ALTERNATIVE NODE
{{JSR{PBILD{{{BUILD ALTERNATIVE NODE
{{MOV{R9{R10{{SAVE PTR TO ALTERNATIVE PATTERN
{{MOV{#P$ABC{R7{{PCODE FOR P$ABC
{{ZER{R9{{{P0BLK
{{JSR{PBILD{{{BUILD P$ABC NODE
{{MOV{R10{4*PTHEN(R9){{PUT ALTERNATIVE NODE AS SUCCESSOR
{{MOV{R10{R6{{REMEMBER ALTERNATIVE NODE POINTER
{{MOV{R9{R10{{COPY P$ABC NODE PTR
{{MOV{(SP){R9{{LOAD ARBNO ARGUMENT
{{MOV{R6{(SP){{STACK ALTERNATIVE NODE POINTER
{{JSR{GTPAT{{{GET ARBNO ARGUMENT AS PATTERN
{{ERR{061{ARBNO{{ARGUMENT IS NOT PATTERN
{{JSR{PCONC{{{CONCAT ARG WITH P$ABC NODE
{{MOV{R9{R10{{REMEMBER PTR TO CONCD PATTERNS
{{MOV{#P$ABA{R7{{PCODE FOR P$ABA
{{ZER{R9{{{P0BLK
{{JSR{PBILD{{{BUILD P$ABA NODE
{{MOV{R10{4*PTHEN(R9){{CONCATENATE NODES
{{MOV{(SP){R10{{RECALL PTR TO ALTERNATIVE NODE
{{MOV{R9{4*PARM1(R10){{POINT ALTERNATIVE BACK TO ARGUMENT
{{BRN{EXITS{{{JUMP FOR NEXT CODE WORD
{{EJC{{{{
*
* ARG
*
{S$ARG{ENT{{{{ENTRY POINT
{{JSR{GTSMI{{{GET SECOND ARG AS SMALL INTEGER
{{ERR{062{ARG{{SECOND ARGUMENT IS NOT INTEGER
{{PPM{EXFAL{{{FAIL IF OUT OF RANGE OR NEGATIVE
{{MOV{R9{R6{{SAVE ARGUMENT NUMBER
{{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
{{JSR{GTNVR{{{LOCATE VRBLK
{{PPM{SARG1{{{JUMP IF NOT NATURAL VARIABLE
{{MOV{4*VRFNC(R9){R9{{ELSE LOAD FUNCTION BLOCK POINTER
{{BNE{(R9){#B$PFC{SARG1{JUMP IF NOT PROGRAM DEFINED
{{BZE{R6{EXFAL{{FAIL IF ARG NUMBER IS ZERO
{{BGT{R6{4*FARGS(R9){EXFAL{FAIL IF ARG NUMBER IS TOO LARGE
{{WTB{R6{{{ELSE CONVERT TO BYTE OFFSET
{{ADD{R6{R9{{POINT TO ARGUMENT SELECTED
{{MOV{4*PFAGB(R9){R9{{LOAD ARGUMENT VRBLK POINTER
{{BRN{EXVNM{{{EXIT TO BUILD NMBLK
*
* HERE IF 1ST ARGUMENT IS BAD
*
{SARG1{ERB{063{ARG{{FIRST ARGUMENT IS NOT PROGRAM FUNCTION NAME
{{EJC{{{{
*
* ARRAY
*
{S$ARR{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R10{{LOAD INITIAL ELEMENT VALUE
{{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
{{JSR{GTINT{{{CONVERT FIRST ARG TO INTEGER
{{PPM{SAR02{{{JUMP IF NOT INTEGER
*
* HERE FOR INTEGER FIRST ARGUMENT, BUILD VCBLK
*
{{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE
{{ILE{SAR10{{{JUMP IF ZERO OR NEG (BAD DIMENSION)
{{MFI{R6{SAR11{{ELSE CONVERT TO ONE WORD, TEST OVFL
{{LCT{R7{R6{{COPY ELEMENTS FOR LOOP LATER ON
{{ADD{#VCSI${R6{{ADD SPACE FOR STANDARD FIELDS
{{WTB{R6{{{CONVERT LENGTH TO BYTES
{{BGE{R6{MXLEN{SAR11{FAIL IF TOO LARGE
{{JSR{ALLOC{{{ALLOCATE SPACE FOR VCBLK
{{MOV{#B$VCT{(R9){{STORE TYPE WORD
{{MOV{R6{4*VCLEN(R9){{SET LENGTH
{{MOV{R10{R8{{COPY DEFAULT VALUE
{{MOV{R9{R10{{COPY VCBLK POINTER
{{ADD{#4*VCVLS{R10{{POINT TO FIRST ELEMENT VALUE
*
* LOOP TO SET VECTOR ELEMENTS TO DEFAULT VALUE
*
{SAR01{MOV{R8{(R10)+{{STORE ONE VALUE
{{BCT{R7{SAR01{{LOOP TILL ALL STORED
{{BRN{EXSID{{{EXIT SETTING IDVAL
{{EJC{{{{
*
* ARRAY (CONTINUED)
*
* HERE IF FIRST ARGUMENT IS NOT AN INTEGER
*
{SAR02{MOV{R9{-(SP){{REPLACE ARGUMENT ON STACK
{{JSR{XSCNI{{{INITIALIZE SCAN OF FIRST ARGUMENT
{{ERR{064{ARRAY{{FIRST ARGUMENT IS NOT INTEGER OR STRING
{{PPM{EXNUL{{{DUMMY (UNUSED) NULL STRING EXIT
{{MOV{R$XSC{-(SP){{SAVE PROTOTYPE POINTER
{{MOV{R10{-(SP){{SAVE DEFAULT VALUE
{{ZER{ARCDM{{{ZERO COUNT OF DIMENSIONS
{{ZER{ARPTR{{{ZERO OFFSET TO INDICATE PASS ONE
{{LDI{INTV1{{{LOAD INTEGER ONE
{{STI{ARNEL{{{INITIALIZE ELEMENT COUNT
*
* THE FOLLOWING CODE IS EXECUTED TWICE. THE FIRST TIME
* (ARPTR EQ 0), IT IS USED TO COUNT THE NUMBER OF ELEMENTS
* AND NUMBER OF DIMENSIONS. THE SECOND TIME (ARPTR GT 0) IS
* USED TO ACTUALLY FILL IN THE DIM,LBD FIELDS OF THE ARBLK.
*
{SAR03{LDI{INTV1{{{LOAD ONE AS DEFAULT LOW BOUND
{{STI{ARSVL{{{SAVE AS LOW BOUND
{{MOV{#CH$CL{R8{{SET DELIMITER ONE = COLON
{{MOV{#CH$CM{R10{{SET DELIMITER TWO = COMMA
{{JSR{XSCAN{{{SCAN NEXT BOUND
{{BNE{R6{#NUM01{SAR04{JUMP IF NOT COLON
*
* HERE WE HAVE A COLON ENDING A LOW BOUND
*
{{JSR{GTINT{{{CONVERT LOW BOUND
{{ERR{065{ARRAY{{FIRST ARGUMENT LOWER BOUND IS NOT INTEGER
{{LDI{4*ICVAL(R9){{{LOAD VALUE OF LOW BOUND
{{STI{ARSVL{{{STORE LOW BOUND VALUE
{{MOV{#CH$CM{R8{{SET DELIMITER ONE = COMMA
{{MOV{R8{R10{{AND DELIMITER TWO = COMMA
{{JSR{XSCAN{{{SCAN HIGH BOUND
{{EJC{{{{
*
* ARRAY (CONTINUED)
*
* MERGE HERE TO PROCESS UPPER BOUND
*
{SAR04{JSR{GTINT{{{CONVERT HIGH BOUND TO INTEGER
{{ERR{066{ARRAY{{FIRST ARGUMENT UPPER BOUND IS NOT INTEGER
{{LDI{4*ICVAL(R9){{{GET HIGH BOUND
{{SBI{ARSVL{{{SUBTRACT LOWER BOUND
{{IOV{SAR10{{{BAD DIMENSION IF OVERFLOW
{{ILT{SAR10{{{BAD DIMENSION IF NEGATIVE
{{ADI{INTV1{{{ADD 1 TO GET DIMENSION
{{IOV{SAR10{{{BAD DIMENSION IF OVERFLOW
{{MOV{ARPTR{R10{{LOAD OFFSET (ALSO PASS INDICATOR)
{{BZE{R10{SAR05{{JUMP IF FIRST PASS
*
* HERE IN SECOND PASS TO STORE LBD AND DIM IN ARBLK
*
{{ADD{(SP){R10{{POINT TO CURRENT LOCATION IN ARBLK
{{STI{4*CFP$I(R10){{{STORE DIMENSION
{{LDI{ARSVL{{{LOAD LOW BOUND
{{STI{(R10){{{STORE LOW BOUND
{{ADD{#4*ARDMS{ARPTR{{BUMP OFFSET TO NEXT BOUNDS
{{BRN{SAR06{{{JUMP TO CHECK FOR END OF BOUNDS
*
* HERE IN PASS 1
*
{SAR05{ICV{ARCDM{{{BUMP DIMENSION COUNT
{{MLI{ARNEL{{{MULTIPLY DIMENSION BY COUNT SO FAR
{{IOV{SAR11{{{TOO LARGE IF OVERFLOW
{{STI{ARNEL{{{ELSE STORE UPDATED ELEMENT COUNT
*
* MERGE HERE AFTER PROCESSING ONE SET OF BOUNDS
*
{SAR06{BNZ{R6{SAR03{{LOOP BACK UNLESS END OF BOUNDS
{{BNZ{ARPTR{SAR09{{JUMP IF END OF PASS 2
{{EJC{{{{
*
* ARRAY (CONTINUED)
*
* HERE AT END OF PASS ONE, BUILD ARBLK
*
{{LDI{ARNEL{{{GET NUMBER OF ELEMENTS
{{MFI{R7{SAR11{{GET AS ADDR INTEGER, TEST OVFLO
{{WTB{R7{{{ELSE CONVERT TO LENGTH IN BYTES
{{MOV{#4*ARSI${R6{{SET SIZE OF STANDARD FIELDS
{{LCT{R8{ARCDM{{SET DIMENSION COUNT TO CONTROL LOOP
*
* LOOP TO ALLOW SPACE FOR DIMENSIONS
*
{SAR07{ADD{#4*ARDMS{R6{{ALLOW SPACE FOR ONE SET OF BOUNDS
{{BCT{R8{SAR07{{LOOP BACK TILL ALL ACCOUNTED FOR
{{MOV{R6{R10{{SAVE SIZE (=AROFS)
*
* NOW ALLOCATE SPACE FOR ARBLK
*
{{ADD{R7{R6{{ADD SPACE FOR ELEMENTS
{{ICA{R6{{{ALLOW FOR ARPRO PROTOTYPE FIELD
{{BGE{R6{MXLEN{SAR11{FAIL IF TOO LARGE
{{JSR{ALLOC{{{ELSE ALLOCATE ARBLK
{{MOV{(SP){R7{{LOAD DEFAULT VALUE
{{MOV{R9{(SP){{SAVE ARBLK POINTER
{{MOV{R6{R8{{SAVE LENGTH IN BYTES
{{BTW{R6{{{CONVERT LENGTH BACK TO WORDS
{{LCT{R6{R6{{SET COUNTER TO CONTROL LOOP
*
* LOOP TO CLEAR ENTIRE ARBLK TO DEFAULT VALUE
*
{SAR08{MOV{R7{(R9)+{{SET ONE WORD
{{BCT{R6{SAR08{{LOOP TILL ALL SET
{{EJC{{{{
*
* ARRAY (CONTINUED)
*
* NOW SET INITIAL FIELDS OF ARBLK
*
{{MOV{(SP)+{R9{{RELOAD ARBLK POINTER
{{MOV{(SP){R7{{LOAD PROTOTYPE
{{MOV{#B$ART{(R9){{SET TYPE WORD
{{MOV{R8{4*ARLEN(R9){{STORE LENGTH IN BYTES
{{ZER{4*IDVAL(R9){{{ZERO ID TILL WE GET IT BUILT
{{MOV{R10{4*AROFS(R9){{SET PROTOTYPE FIELD PTR
{{MOV{ARCDM{4*ARNDM(R9){{SET NUMBER OF DIMENSIONS
{{MOV{R9{R8{{SAVE ARBLK POINTER
{{ADD{R10{R9{{POINT TO PROTOTYPE FIELD
{{MOV{R7{(R9){{STORE PROTOTYPE PTR IN ARBLK
{{MOV{#4*ARLBD{ARPTR{{SET OFFSET FOR PASS 2 BOUNDS SCAN
{{MOV{R7{R$XSC{{RESET STRING POINTER FOR XSCAN
{{MOV{R8{(SP){{STORE ARBLK POINTER ON STACK
{{ZER{XSOFS{{{RESET OFFSET PTR TO START OF STRING
{{BRN{SAR03{{{JUMP BACK TO RESCAN BOUNDS
*
* HERE AFTER FILLING IN BOUNDS INFORMATION (END PASS TWO)
*
{SAR09{MOV{(SP)+{R9{{RELOAD POINTER TO ARBLK
{{BRN{EXSID{{{EXIT SETTING IDVAL
*
* HERE FOR BAD DIMENSION
*
{SAR10{ERB{067{ARRAY{{DIMENSION IS ZERO,NEGATIVE OR OUT OF RANGE
*
* HERE IF ARRAY IS TOO LARGE
*
{SAR11{ERB{068{ARRAY{{SIZE EXCEEDS MAXIMUM PERMITTED
{{EJC{{{{
*
* BUFFER
*
{S$BUF{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R10{{GET INITIAL VALUE
{{MOV{(SP)+{R9{{GET REQUESTED ALLOCATION
{{JSR{GTINT{{{CONVERT TO INTEGER
{{ERR{269{BUFFER{{FIRST ARGUMENT IS NOT INTEGER
{{LDI{4*ICVAL(R9){{{GET VALUE
{{ILE{SBF01{{{BRANCH IF NEGATIVE OR ZERO
{{MFI{R6{SBF02{{MOVE WITH OVERFLOW CHECK
{{JSR{ALOBF{{{ALLOCATE THE BUFFER
{{JSR{APNDB{{{COPY IT IN
{{ERR{270{BUFFER{{SECOND ARGUMENT IS NOT STRING OR BUFFER
{{ERR{271{BUFFER{{INITIAL VALUE TOO BIG FOR ALLOCATION
{{BRN{EXSID{{{EXIT SETTING IDVAL
*
* HERE FOR INVALID ALLOCATION SIZE
*
{SBF01{ERB{272{BUFFER{{FIRST ARGUMENT IS NOT POSITIVE
*
* HERE FOR ALLOCATION SIZE INTEGER OVERFLOW
*
{SBF02{ERB{273{BUFFER{{SIZE IS TOO BIG
{{EJC{{{{
*
* BREAK
*
{S$BRK{ENT{{{{ENTRY POINT
{{MOV{#P$BKS{R7{{SET PCODE FOR SINGLE CHAR CASE
{{MOV{#P$BRK{R10{{PCODE FOR MULTI-CHAR CASE
{{MOV{#P$BKD{R8{{PCODE FOR EXPRESSION CASE
{{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE
{{ERR{069{BREAK{{ARGUMENT IS NOT STRING OR EXPRESSION
{{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
{{EJC{{{{
*
* BREAKX
*
* BREAKX IS A COMPOUND PATTERN. SEE DESCRIPTION AT START
* OF PATTERN MATCHING SECTION FOR STRUCTURE FORMED.
*
{S$BKX{ENT{{{{ENTRY POINT
{{MOV{#P$BKS{R7{{PCODE FOR SINGLE CHAR ARGUMENT
{{MOV{#P$BRK{R10{{PCODE FOR MULTI-CHAR ARGUMENT
{{MOV{#P$BXD{R8{{PCODE FOR EXPRESSION CASE
{{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE
{{ERR{070{BREAKX{{ARGUMENT IS NOT STRING OR EXPRESSION
*
* NOW HOOK BREAKX NODE ON AT FRONT END
*
{{MOV{R9{-(SP){{SAVE PTR TO BREAK NODE
{{MOV{#P$BKX{R7{{SET PCODE FOR BREAKX NODE
{{JSR{PBILD{{{BUILD IT
{{MOV{(SP){4*PTHEN(R9){{SET BREAK NODE AS SUCCESSOR
{{MOV{#P$ALT{R7{{SET PCODE FOR ALTERNATION NODE
{{JSR{PBILD{{{BUILD (PARM1=ALT=BREAKX NODE)
{{MOV{R9{R6{{SAVE PTR TO ALTERNATION NODE
{{MOV{(SP){R9{{POINT TO BREAK NODE
{{MOV{R6{4*PTHEN(R9){{SET ALTERNATE NODE AS SUCCESSOR
{{BRN{EXITS{{{EXIT WITH RESULT ON STACK
{{EJC{{{{
*
* CHAR
*
{S$CHR{ENT{{{{ENTRY POINT
{{JSR{GTSMI{{{CONVERT ARG TO INTEGER
{{ERR{281{CHAR{{ARGUMENT NOT INTEGER
{{PPM{SCHR1{{{TOO BIG ERROR EXIT
{{BGE{R8{#CFP$A{SCHR1{SEE IF OUT OF RANGE OF HOST SET
{{MOV{#NUM01{R6{{IF NOT SET SCBLK ALLOCATION
{{MOV{R8{R7{{SAVE CHAR CODE
{{JSR{ALOCS{{{ALLOCATE 1 BAU SCBLK
{{MOV{R9{R10{{COPY SCBLK POINTER
{{PSC{R10{{{GET SET TO STUFF CHAR
{{SCH{R7{(R10)+{{STUFF IT
{{ZER{R10{{{CLEAR SLOP IN XL
{{BRN{EXIXR{{{EXIT WITH SCBLK POINTER
*
* HERE IF CHAR ARGUMENT IS OUT OF RANGE
*
{SCHR1{ERB{282{CHAR{{ARGUMENT NOT IN RANGE
{{EJC{{{{
*
* CLEAR
*
{S$CLR{ENT{{{{ENTRY POINT
{{JSR{XSCNI{{{INITIALIZE TO SCAN ARGUMENT
{{ERR{071{CLEAR{{ARGUMENT IS NOT STRING
{{PPM{SCLR2{{{JUMP IF NULL
*
* LOOP TO SCAN OUT NAMES IN FIRST ARGUMENT. VARIABLES IN
* THE LIST ARE FALGGED BY SETTING VRGET OF VRBLK TO ZERO.
*
{SCLR1{MOV{#CH$CM{R8{{SET DELIMITER ONE = COMMA
{{MOV{R8{R10{{DELIMITER TWO = COMMA
{{JSR{XSCAN{{{SCAN NEXT VARIABLE NAME
{{JSR{GTNVR{{{LOCATE VRBLK
{{ERR{072{CLEAR{{ARGUMENT HAS NULL VARIABLE NAME
{{ZER{4*VRGET(R9){{{ELSE FLAG BY ZEROING VRGET FIELD
{{BNZ{R6{SCLR1{{LOOP BACK IF STOPPED BY COMMA
*
* HERE AFTER FLAGGING VARIABLES IN ARGUMENT LIST
*
{SCLR2{MOV{HSHTB{R7{{POINT TO START OF HASH TABLE
*
* LOOP THROUGH SLOTS IN HASH TABLE
*
{SCLR3{BEQ{R7{HSHTE{EXNUL{EXIT RETURNING NULL IF NONE LEFT
{{MOV{R7{R9{{ELSE COPY SLOT POINTER
{{ICA{R7{{{BUMP SLOT POINTER
{{SUB{#4*VRNXT{R9{{SET OFFSET TO MERGE INTO LOOP
*
* LOOP THROUGH VRBLKS ON ONE HASH CHAIN
*
{SCLR4{MOV{4*VRNXT(R9){R9{{POINT TO NEXT VRBLK ON CHAIN
{{BZE{R9{SCLR3{{JUMP FOR NEXT BUCKET IF CHAIN END
{{BNZ{4*VRGET(R9){SCLR5{{JUMP IF NOT FLAGGED
{{EJC{{{{
*
* CLEAR (CONTINUED)
*
* HERE FOR FLAGGED VARIABLE, DO NOT SET VALUE TO NULL
*
{{JSR{SETVR{{{FOR FLAGGED VAR, RESTORE VRGET
{{BRN{SCLR4{{{AND LOOP BACK FOR NEXT VRBLK
*
* HERE TO SET VALUE OF A VARIABLE TO NULL
* PRROTECTED VARIABLES (ARB, ETC) ARE EXEMPT
*
{SCLR5{BEQ{4*VRSTO(R9){#B$VRE{SCLR4{CHECK FOR PROTECTED VARIABLE (REG05)
{{MOV{R9{R10{{COPY VRBLK POINTER (REG05)
*
* LOOP TO LOCATE VALUE AT END OF POSSIBLE TRBLK CHAIN
*
{SCLR6{MOV{R10{R6{{SAVE BLOCK POINTER
{{MOV{4*VRVAL(R10){R10{{LOAD NEXT VALUE FIELD
{{BEQ{(R10){#B$TRT{SCLR6{LOOP BACK IF TRAPPED
*
* NOW STORE THE NULL VALUE
*
{{MOV{R6{R10{{RESTORE BLOCK POINTER
{{MOV{#NULLS{4*VRVAL(R10){{STORE NULL CONSTANT VALUE
{{BRN{SCLR4{{{LOOP BACK FOR NEXT VRBLK
{{EJC{{{{
*
* CODE
*
{S$COD{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{JSR{GTCOD{{{CONVERT TO CODE
{{PPM{EXFAL{{{FAIL IF CONVERSION IS IMPOSSIBLE
{{BRN{EXIXR{{{ELSE RETURN CODE AS RESULT
{{EJC{{{{
*
* COLLECT
*
{S$COL{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{JSR{GTINT{{{CONVERT TO INTEGER
{{ERR{073{COLLECT{{ARGUMENT IS NOT INTEGER
{{LDI{4*ICVAL(R9){{{LOAD COLLECT ARGUMENT
{{STI{CLSVI{{{SAVE COLLECT ARGUMENT
{{ZER{R7{{{SET NO MOVE UP
{{JSR{GBCOL{{{PERFORM GARBAGE COLLECTION
{{MOV{DNAME{R6{{POINT TO END OF MEMORY
{{SUB{DNAMP{R6{{SUBTRACT NEXT LOCATION
{{BTW{R6{{{CONVERT BYTES TO WORDS
{{MTI{R6{{{CONVERT WORDS AVAILABLE AS INTEGER
{{SBI{CLSVI{{{SUBTRACT ARGUMENT
{{IOV{EXFAL{{{FAIL IF OVERFLOW
{{ILT{EXFAL{{{FAIL IF NOT ENOUGH
{{ADI{CLSVI{{{ELSE RECOMPUTE AVAILABLE
{{BRN{EXINT{{{AND EXIT WITH INTEGER RESULT
{{EJC{{{{
*
* CONVERT
*
{S$CNV{ENT{{{{ENTRY POINT
{{JSR{GTSTG{{{CONVERT SECOND ARGUMENT TO STRING
{{ERR{074{CONVERT{{SECOND ARGUMENT IS NOT STRING
{{JSR{FLSTG{{{FOLD LOWER CASE TO UPPER CASE
{{MOV{(SP){R10{{LOAD FIRST ARGUMENT
{{BNE{(R10){#B$PDT{SCV01{JUMP IF NOT PROGRAM DEFINED
*
* HERE FOR PROGRAM DEFINED DATATYPE
*
{{MOV{4*PDDFP(R10){R10{{POINT TO DFBLK
{{MOV{4*DFNAM(R10){R10{{LOAD DATATYPE NAME
{{JSR{IDENT{{{COMPARE WITH SECOND ARG
{{PPM{EXITS{{{EXIT IF IDENT WITH ARG AS RESULT
{{BRN{EXFAL{{{ELSE FAIL
*
* HERE IF NOT PROGRAM DEFINED DATATYPE
*
{SCV01{MOV{R9{-(SP){{SAVE STRING ARGUMENT
{{MOV{#SVCTB{R10{{POINT TO TABLE OF NAMES TO COMPARE
{{ZER{R7{{{INITIALIZE COUNTER
{{MOV{R6{R8{{SAVE LENGTH OF ARGUMENT STRING
*
* LOOP THROUGH TABLE ENTRIES
*
{SCV02{MOV{(R10)+{R9{{LOAD NEXT TABLE ENTRY, BUMP POINTER
{{BZE{R9{EXFAL{{FAIL IF ZERO MARKING END OF LIST
{{BNE{R8{4*SCLEN(R9){SCV05{JUMP IF WRONG LENGTH
{{MOV{R10{CNVTP{{ELSE STORE TABLE POINTER
{{PLC{R9{{{POINT TO CHARS OF TABLE ENTRY
{{MOV{(SP){R10{{LOAD POINTER TO STRING ARGUMENT
{{PLC{R10{{{POINT TO CHARS OF STRING ARG
{{MOV{R8{R6{{SET NUMBER OF CHARS TO COMPARE
{{CMC{SCV04{SCV04{{COMPARE, JUMP IF NO MATCH
{{EJC{{{{
*
* CONVERT (CONTINUED)
*
* HERE WE HAVE A MATCH
*
{SCV03{MOV{R7{R10{{COPY ENTRY NUMBER
{{ICA{SP{{{POP STRING ARG OFF STACK
{{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
{{BSW{R10{CNVTT{{JUMP TO APPROPRIATE ROUTINE
{{IFF{0{SCV06{{STRING
{{IFF{1{SCV07{{INTEGER
{{IFF{2{SCV09{{NAME
{{IFF{3{SCV10{{PATTERN
{{IFF{4{SCV11{{ARRAY
{{IFF{5{SCV19{{TABLE
{{IFF{6{SCV25{{EXPRESSION
{{IFF{7{SCV26{{CODE
{{IFF{8{SCV27{{NUMERIC
{{IFF{CNVRT{SCV08{{REAL
{{IFF{CNVBT{SCV28{{BUFFER
{{ESW{{{{END OF SWITCH TABLE
*
* HERE IF NO MATCH WITH TABLE ENTRY
*
{SCV04{MOV{CNVTP{R10{{RESTORE TABLE POINTER, MERGE
*
* MERGE HERE IF LENGTHS DID NOT MATCH
*
{SCV05{ICV{R7{{{BUMP ENTRY NUMBER
{{BRN{SCV02{{{LOOP BACK TO CHECK NEXT ENTRY
*
* HERE TO CONVERT TO STRING
*
{SCV06{MOV{R9{-(SP){{REPLACE STRING ARGUMENT ON STACK
{{JSR{GTSTG{{{CONVERT TO STRING
{{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
{{BRN{EXIXR{{{ELSE RETURN STRING
{{EJC{{{{
*
* CONVERT (CONTINUED)
*
* HERE TO CONVERT TO INTEGER
*
{SCV07{JSR{GTINT{{{CONVERT TO INTEGER
{{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
{{BRN{EXIXR{{{ELSE RETURN INTEGER
*
* HERE TO CONVERT TO REAL
*
{SCV08{JSR{GTREA{{{CONVERT TO REAL
{{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
{{BRN{EXIXR{{{ELSE RETURN REAL
*
* HERE TO CONVERT TO NAME
*
{SCV09{BEQ{(R9){#B$NML{EXIXR{RETURN IF ALREADY A NAME
{{JSR{GTNVR{{{ELSE TRY STRING TO NAME CONVERT
{{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
{{BRN{EXVNM{{{ELSE EXIT BUILDING NMBLK FOR VRBLK
*
* HERE TO CONVERT TO PATTERN
*
{SCV10{JSR{GTPAT{{{CONVERT TO PATTERN
{{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
{{BRN{EXIXR{{{ELSE RETURN PATTERN
*
* CONVERT TO ARRAY
*
{SCV11{JSR{GTARR{{{GET AN ARRAY
{{PPM{EXFAL{{{FAIL IF NOT CONVERTIBLE
{{BRN{EXSID{{{EXIT SETTING ID FIELD
*
* CONVERT TO TABLE
*
{SCV19{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK
{{MOV{R9{-(SP){{REPLACE ARBLK POINTER ON STACK
{{BEQ{R6{#B$TBT{EXITS{RETURN ARG IF ALREADY A TABLE
{{BNE{R6{#B$ART{EXFAL{ELSE FAIL IF NOT AN ARRAY
{{EJC{{{{
*
* CONVERT (CONTINUED)
*
* HERE TO CONVERT AN ARRAY TO TABLE
*
{{BNE{4*ARNDM(R9){#NUM02{EXFAL{FAIL IF NOT 2-DIM ARRAY
{{LDI{4*ARDM2(R9){{{LOAD DIM 2
{{SBI{INTV2{{{SUBTRACT 2 TO COMPARE
{{INE{EXFAL{{{FAIL IF DIM2 NOT 2
*
* HERE WE HAVE AN ARBLK OF THE RIGHT SHAPE
*
{{LDI{4*ARDIM(R9){{{LOAD DIM 1 (NUMBER OF ELEMENTS)
{{MFI{R6{{{GET AS ONE WORD INTEGER
{{LCT{R7{R6{{COPY TO CONTROL LOOP
{{ADD{#TBSI${R6{{ADD SPACE FOR STANDARD FIELDS
{{WTB{R6{{{CONVERT LENGTH TO BYTES
{{JSR{ALLOC{{{ALLOCATE SPACE FOR TBBLK
{{MOV{R9{R8{{COPY TBBLK POINTER
{{MOV{R9{-(SP){{SAVE TBBLK POINTER
{{MOV{#B$TBT{(R9)+{{STORE TYPE WORD
{{ZER{(R9)+{{{STORE ZERO FOR IDVAL FOR NOW
{{MOV{R6{(R9)+{{STORE LENGTH
{{MOV{#NULLS{(R9)+{{NULL INITIAL LOOKUP VALUE
*
* LOOP TO INITIALIZE BUCKET PTRS TO POINT TO TABLE
*
{SCV20{MOV{R8{(R9)+{{SET BUCKET PTR TO POINT TO TBBLK
{{BCT{R7{SCV20{{LOOP TILL ALL INITIALIZED
{{MOV{#4*ARVL2{R7{{SET OFFSET TO FIRST ARBLK ELEMENT
*
* LOOP TO COPY ELEMENTS FROM ARRAY TO TABLE
*
{SCV21{MOV{4*1(SP){R10{{POINT TO ARBLK
{{BEQ{R7{4*ARLEN(R10){SCV24{JUMP IF ALL MOVED
{{ADD{R7{R10{{ELSE POINT TO CURRENT LOCATION
{{ADD{#4*NUM02{R7{{BUMP OFFSET
{{MOV{(R10){R9{{LOAD SUBSCRIPT NAME
{{DCA{R10{{{ADJUST PTR TO MERGE (TRVAL=1+1)
{{EJC{{{{
*
* CONVERT (CONTINUED)
*
* LOOP TO CHASE DOWN TRBLK CHAIN FOR VALUE
*
{SCV22{MOV{4*TRVAL(R10){R10{{POINT TO NEXT VALUE
{{BEQ{(R10){#B$TRT{SCV22{LOOP BACK IF TRAPPED
*
* HERE WITH NAME IN XR, VALUE IN XL
*
{SCV23{MOV{R10{-(SP){{STACK VALUE
{{MOV{4*1(SP){R10{{LOAD TBBLK POINTER
{{JSR{TFIND{{{BUILD TEBLK (NOTE WB GT 0 BY NAME)
{{PPM{EXFAL{{{FAIL IF ACESS FAILS
{{MOV{(SP)+{4*TEVAL(R10){{STORE VALUE IN TEBLK
{{BRN{SCV21{{{LOOP BACK FOR NEXT ELEMENT
*
* HERE AFTER MOVING ALL ELEMENTS TO TBBLK
*
{SCV24{MOV{(SP)+{R9{{LOAD TBBLK POINTER
{{ICA{SP{{{POP ARBLK POINTER
{{BRN{EXSID{{{EXIT SETTING IDVAL
*
* CONVERT TO EXPRESSION
*
{SCV25{JSR{GTEXP{{{CONVERT TO EXPRESSION
{{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
{{BRN{EXIXR{{{ELSE RETURN EXPRESSION
*
* CONVERT TO CODE
*
{SCV26{JSR{GTCOD{{{CONVERT TO CODE
{{PPM{EXFAL{{{FAIL IF CONVERSION IS NOT POSSIBLE
{{BRN{EXIXR{{{ELSE RETURN CODE
*
* CONVERT TO NUMERIC
*
{SCV27{JSR{GTNUM{{{CONVERT TO NUMERIC
{{PPM{EXFAL{{{FAIL IF UNCONVERTIBLE
{{BRN{EXIXR{{{RETURN NUMBER
{{EJC{{{{
*
* CONVERT TO BUFFER
*
{SCV28{MOV{R9{-(SP){{STACK STRING FOR PROCEDURE
{{JSR{GTSTG{{{CONVERT TO STRING
{{PPM{EXFAL{{{FAIL IF CONVERSION NOT POSSIBLE
{{MOV{R9{R10{{SAVE STRING POINTER
{{JSR{ALOBF{{{ALLOCATE BUFFER OF SAME SIZE
{{JSR{APNDB{{{COPY IN THE STRING
{{PPM{{{{ALREADY STRING - CANT FAIL TO CNV
{{PPM{{{{MUST BE ENOUGH ROOM
{{BRN{EXSID{{{EXIT SETTING IDVAL FIELD
{{EJC{{{{
*
* COPY
*
{S$COP{ENT{{{{ENTRY POINT
{{JSR{COPYB{{{COPY THE BLOCK
{{PPM{EXITS{{{RETURN IF NO IDVAL FIELD
{{BRN{EXSID{{{EXIT SETTING ID VALUE
{{EJC{{{{
*
* DATA
*
{S$DAT{ENT{{{{ENTRY POINT
{{JSR{XSCNI{{{PREPARE TO SCAN ARGUMENT
{{ERR{075{DATA{{ARGUMENT IS NOT STRING
{{ERR{076{DATA{{ARGUMENT IS NULL
*
* SCAN OUT DATATYPE NAME
*
{{MOV{#CH$PP{R8{{DELIMITER ONE = LEFT PAREN
{{MOV{R8{R10{{DELIMITER TWO = LEFT PAREN
{{JSR{XSCAN{{{SCAN DATATYPE NAME
{{BNZ{R6{SDAT1{{SKIP IF LEFT PAREN FOUND
{{ERB{077{DATA{{ARGUMENT IS MISSING A LEFT PAREN
*
* HERE AFTER SCANNING DATATYPE NAME
*
{SDAT1{MOV{4*SCLEN(R9){R6{{GET LENGTH
{{JSR{FLSTG{{{FOLD LOWER CASE TO UPPER CASE
{{MOV{R9{R10{{SAVE NAME PTR
{{MOV{4*SCLEN(R9){R6{{GET LENGTH
{{CTB{R6{SCSI${{COMPUTE SPACE NEEDED
{{JSR{ALOST{{{REQUEST STATIC STORE FOR NAME
{{MOV{R9{-(SP){{SAVE DATATYPE NAME
{{MVW{{{{COPY NAME TO STATIC
{{MOV{(SP){R9{{GET NAME PTR
{{ZER{R10{{{SCRUB DUD REGISTER
{{JSR{GTNVR{{{LOCATE VRBLK FOR DATATYPE NAME
{{ERR{078{DATA{{ARGUMENT HAS NULL DATATYPE NAME
{{MOV{R9{DATDV{{SAVE VRBLK POINTER FOR DATATYPE
{{MOV{SP{DATXS{{STORE STARTING STACK VALUE
{{ZER{R7{{{ZERO COUNT OF FIELD NAMES
*
* LOOP TO SCAN FIELD NAMES AND STACK VRBLK POINTERS
*
{SDAT2{MOV{#CH$RP{R8{{DELIMITER ONE = RIGHT PAREN
{{MOV{#CH$CM{R10{{DELIMITER TWO = COMMA
{{JSR{XSCAN{{{SCAN NEXT FIELD NAME
{{BNZ{R6{SDAT3{{JUMP IF DELIMITER FOUND
{{ERB{079{DATA{{ARGUMENT IS MISSING A RIGHT PAREN
*
* HERE AFTER SCANNING OUT ONE FIELD NAME
*
{SDAT3{JSR{GTNVR{{{LOCATE VRBLK FOR FIELD NAME
{{ERR{080{DATA{{ARGUMENT HAS NULL FIELD NAME
{{MOV{R9{-(SP){{STACK VRBLK POINTER
{{ICV{R7{{{INCREMENT COUNTER
{{BEQ{R6{#NUM02{SDAT2{LOOP BACK IF STOPPED BY COMMA
{{EJC{{{{
*
* DATA (CONTINUED)
*
* NOW BUILD THE DFBLK
*
{{MOV{#DFSI${R6{{SET SIZE OF DFBLK STANDARD FIELDS
{{ADD{R7{R6{{ADD NUMBER OF FIELDS
{{WTB{R6{{{CONVERT LENGTH TO BYTES
{{MOV{R7{R8{{PRESERVE NO. OF FIELDS
{{JSR{ALOST{{{ALLOCATE SPACE FOR DFBLK
{{MOV{R8{R7{{GET NO OF FIELDS
{{MOV{DATXS{R10{{POINT TO START OF STACK
{{MOV{(R10){R8{{LOAD DATATYPE NAME
{{MOV{R9{(R10){{SAVE DFBLK POINTER ON STACK
{{MOV{#B$DFC{(R9)+{{STORE TYPE WORD
{{MOV{R7{(R9)+{{STORE NUMBER OF FIELDS (FARGS)
{{MOV{R6{(R9)+{{STORE LENGTH (DFLEN)
{{SUB{#4*PDDFS{R6{{COMPUTE PDBLK LENGTH (FOR DFPDL)
{{MOV{R6{(R9)+{{STORE PDBLK LENGTH (DFPDL)
{{MOV{R8{(R9)+{{STORE DATATYPE NAME (DFNAM)
{{LCT{R8{R7{{COPY NUMBER OF FIELDS
*
* LOOP TO MOVE FIELD NAME VRBLK POINTERS TO DFBLK
*
{SDAT4{MOV{-(R10){(R9)+{{MOVE ONE FIELD NAME VRBLK POINTER
{{BCT{R8{SDAT4{{LOOP TILL ALL MOVED
*
* NOW DEFINE THE DATATYPE FUNCTION
*
{{MOV{R6{R8{{COPY LENGTH OF PDBLK FOR LATER LOOP
{{MOV{DATDV{R9{{POINT TO VRBLK
{{MOV{DATXS{R10{{POINT BACK ON STACK
{{MOV{(R10){R10{{LOAD DFBLK POINTER
{{JSR{DFFNC{{{DEFINE FUNCTION
{{EJC{{{{
*
* DATA (CONTINUED)
*
* LOOP TO BUILD FFBLKS
*
*
* NOTICE THAT THE FFBLKS ARE CONSTRUCTED IN REVERSE ORDER
* SO THAT THE REQUIRED OFFSETS CAN BE OBTAINED FROM
* SUCCESSIVE DECREMENTATION OF THE PDBLK LENGTH (IN WC).
*
{SDAT5{MOV{#4*FFSI${R6{{SET LENGTH OF FFBLK
{{JSR{ALLOC{{{ALLOCATE SPACE FOR FFBLK
{{MOV{#B$FFC{(R9){{SET TYPE WORD
{{MOV{#NUM01{4*FARGS(R9){{STORE FARGS (ALWAYS ONE)
{{MOV{DATXS{R10{{POINT BACK ON STACK
{{MOV{(R10){4*FFDFP(R9){{COPY DFBLK PTR TO FFBLK
{{DCA{R8{{{DECREMENT OLD DFPDL TO GET NEXT OFS
{{MOV{R8{4*FFOFS(R9){{SET OFFSET TO THIS FIELD
{{ZER{4*FFNXT(R9){{{TENTATIVELY SET ZERO FORWARD PTR
{{MOV{R9{R10{{COPY FFBLK POINTER FOR DFFNC
{{MOV{(SP){R9{{LOAD VRBLK POINTER FOR FIELD
{{MOV{4*VRFNC(R9){R9{{LOAD CURRENT FUNCTION POINTER
{{BNE{(R9){#B$FFC{SDAT6{SKIP IF NOT CURRENTLY A FIELD FUNC
*
* HERE WE MUST CHAIN AN OLD FFBLK PTR TO PRESERVE IT IN THE
* CASE OF MULTIPLE FIELD FUNCTIONS WITH THE SAME NAME
*
{{MOV{R9{4*FFNXT(R10){{LINK NEW FFBLK TO PREVIOUS CHAIN
*
* MERGE HERE TO DEFINE FIELD FUNCTION
*
{SDAT6{MOV{(SP)+{R9{{LOAD VRBLK POINTER
{{JSR{DFFNC{{{DEFINE FIELD FUNCTION
{{BNE{SP{DATXS{SDAT5{LOOP BACK TILL ALL DONE
{{ICA{SP{{{POP DFBLK POINTER
{{BRN{EXNUL{{{RETURN WITH NULL RESULT
{{EJC{{{{
*
* DATATYPE
*
{S$DTP{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{JSR{DTYPE{{{GET DATATYPE
{{BRN{EXIXR{{{AND RETURN IT AS RESULT
{{EJC{{{{
*
* DATE
*
{S$DTE{ENT{{{{ENTRY POINT
{{JSR{SYSDT{{{CALL SYSTEM DATE ROUTINE
{{MOV{4*1(R10){R6{{LOAD LENGTH FOR SBSTR
{{BZE{R6{EXNUL{{RETURN NULL IF LENGTH IS ZERO
{{ZER{R7{{{SET ZERO OFFSET
{{JSR{SBSTR{{{USE SBSTR TO BUILD SCBLK
{{BRN{EXIXR{{{RETURN DATE STRING
{{EJC{{{{
*
* DEFINE
*
{S$DEF{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT
{{ZER{DEFLB{{{ZERO LABEL POINTER IN CASE NULL
{{BEQ{R9{#NULLS{SDF01{JUMP IF NULL SECOND ARGUMENT
{{JSR{GTNVR{{{ELSE FIND VRBLK FOR LABEL
{{PPM{SDF13{{{JUMP IF NOT A VARIABLE NAME
{{MOV{R9{DEFLB{{ELSE SET SPECIFIED ENTRY
*
* SCAN FUNCTION NAME
*
{SDF01{JSR{XSCNI{{{PREPARE TO SCAN FIRST ARGUMENT
{{ERR{081{DEFINE{{FIRST ARGUMENT IS NOT STRING
{{ERR{082{DEFINE{{FIRST ARGUMENT IS NULL
{{MOV{#CH$PP{R8{{DELIMITER ONE = LEFT PAREN
{{MOV{R8{R10{{DELIMITER TWO = LEFT PAREN
{{JSR{XSCAN{{{SCAN OUT FUNCTION NAME
{{BNZ{R6{SDF02{{JUMP IF LEFT PAREN FOUND
{{ERB{083{DEFINE{{FIRST ARGUMENT IS MISSING A LEFT PAREN
*
* HERE AFTER SCANNING OUT FUNCTION NAME
*
{SDF02{JSR{GTNVR{{{GET VARIABLE NAME
{{ERR{084{DEFINE{{FIRST ARGUMENT HAS NULL FUNCTION NAME
{{MOV{R9{DEFVR{{SAVE VRBLK POINTER FOR FUNCTION NAM
{{ZER{R7{{{ZERO COUNT OF ARGUMENTS
{{MOV{SP{DEFXS{{SAVE INITIAL STACK POINTER
{{BNZ{DEFLB{SDF03{{JUMP IF SECOND ARGUMENT GIVEN
{{MOV{R9{DEFLB{{ELSE DEFAULT IS FUNCTION NAME
*
* LOOP TO SCAN ARGUMENT NAMES AND STACK VRBLK POINTERS
*
{SDF03{MOV{#CH$RP{R8{{DELIMITER ONE = RIGHT PAREN
{{MOV{#CH$CM{R10{{DELIMITER TWO = COMMA
{{JSR{XSCAN{{{SCAN OUT NEXT ARGUMENT NAME
{{BNZ{R6{SDF04{{SKIP IF DELIMITER FOUND
{{ERB{085{NULL{{ARG NAME OR MISSING ) IN DEFINE FIRST ARG.
{{EJC{{{{
*
* DEFINE (CONTINUED)
*
* HERE AFTER SCANNING AN ARGUMENT NAME
*
{SDF04{BNE{R9{#NULLS{SDF05{SKIP IF NON-NULL
{{BZE{R7{SDF06{{IGNORE NULL IF CASE OF NO ARGUMENTS
*
* HERE AFTER DEALING WITH THE CASE OF NO ARGUMENTS
*
{SDF05{JSR{GTNVR{{{GET VRBLK POINTER
{{PPM{SDF03{{{LOOP BACK TO IGNORE NULL NAME
{{MOV{R9{-(SP){{STACK ARGUMENT VRBLK POINTER
{{ICV{R7{{{INCREMENT COUNTER
{{BEQ{R6{#NUM02{SDF03{LOOP BACK IF STOPPED BY A COMMA
*
* HERE AFTER SCANNING OUT FUNCTION ARGUMENT NAMES
*
{SDF06{MOV{R7{DEFNA{{SAVE NUMBER OF ARGUMENTS
{{ZER{R7{{{ZERO COUNT OF LOCALS
*
* LOOP TO SCAN LOCAL NAMES AND STACK VRBLK POINTERS
*
{SDF07{MOV{#CH$CM{R8{{SET DELIMITER ONE = COMMA
{{MOV{R8{R10{{SET DELIMITER TWO = COMMA
{{JSR{XSCAN{{{SCAN OUT NEXT LOCAL NAME
{{BNE{R9{#NULLS{SDF08{SKIP IF NON-NULL
{{BZE{R7{SDF09{{IGNORE NULL IF CASE OF NO LOCALS
*
* HERE AFTER SCANNING OUT A LOCAL NAME
*
{SDF08{JSR{GTNVR{{{GET VRBLK POINTER
{{PPM{SDF07{{{LOOP BACK TO IGNORE NULL NAME
{{ICV{R7{{{IF OK, INCREMENT COUNT
{{MOV{R9{-(SP){{STACK VRBLK POINTER
{{BNZ{R6{SDF07{{LOOP BACK IF STOPPED BY A COMMA
{{EJC{{{{
*
* DEFINE (CONTINUED)
*
* HERE AFTER SCANNING LOCALS, BUILD PFBLK
*
{SDF09{MOV{R7{R6{{COPY COUNT OF LOCALS
{{ADD{DEFNA{R6{{ADD NUMBER OF ARGUMENTS
{{MOV{R6{R8{{SET SUM ARGS+LOCALS AS LOOP COUNT
{{ADD{#PFSI${R6{{ADD SPACE FOR STANDARD FIELDS
{{WTB{R6{{{CONVERT LENGTH TO BYTES
{{JSR{ALLOC{{{ALLOCATE SPACE FOR PFBLK
{{MOV{R9{R10{{SAVE POINTER TO PFBLK
{{MOV{#B$PFC{(R9)+{{STORE FIRST WORD
{{MOV{DEFNA{(R9)+{{STORE NUMBER OF ARGUMENTS
{{MOV{R6{(R9)+{{STORE LENGTH (PFLEN)
{{MOV{DEFVR{(R9)+{{STORE VRBLK PTR FOR FUNCTION NAME
{{MOV{R7{(R9)+{{STORE NUMBER OF LOCALS
{{ZER{(R9)+{{{DEAL WITH LABEL LATER
{{ZER{(R9)+{{{ZERO PFCTR
{{ZER{(R9)+{{{ZERO PFRTR
{{BZE{R8{SDF11{{SKIP IF NO ARGS OR LOCALS
{{MOV{R10{R6{{KEEP PFBLK POINTER
{{MOV{DEFXS{R10{{POINT BEFORE ARGUMENTS
{{LCT{R8{R8{{GET COUNT OF ARGS+LOCALS FOR LOOP
*
* LOOP TO MOVE LOCALS AND ARGS TO PFBLK
*
{SDF10{MOV{-(R10){(R9)+{{STORE ONE ENTRY AND BUMP POINTERS
{{BCT{R8{SDF10{{LOOP TILL ALL STORED
{{MOV{R6{R10{{RECOVER PFBLK POINTER
{{EJC{{{{
*
* DEFINE (CONTINUED)
*
* NOW DEAL WITH LABEL
*
{SDF11{MOV{DEFXS{SP{{POP STACK
{{MOV{DEFLB{R9{{POINT TO VRBLK FOR LABEL
{{MOV{4*VRLBL(R9){R9{{LOAD LABEL POINTER
{{BNE{(R9){#B$TRT{SDF12{SKIP IF NOT TRAPPED
{{MOV{4*TRLBL(R9){R9{{ELSE POINT TO REAL LABEL
*
* HERE AFTER LOCATING REAL LABEL POINTER
*
{SDF12{BEQ{R9{#STNDL{SDF13{JUMP IF LABEL IS NOT DEFINED
{{MOV{R9{4*PFCOD(R10){{ELSE STORE LABEL POINTER
{{MOV{DEFVR{R9{{POINT BACK TO VRBLK FOR FUNCTION
{{JSR{DFFNC{{{DEFINE FUNCTION
{{BRN{EXNUL{{{AND EXIT RETURNING NULL
*
* HERE FOR ERRONEOUS LABEL
*
{SDF13{ERB{086{DEFINE{{FUNCTION ENTRY POINT IS NOT DEFINED LABEL
{{EJC{{{{
*
* DETACH
*
{S$DET{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{JSR{GTVAR{{{LOCATE VARIABLE
{{ERR{087{DETACH{{ARGUMENT IS NOT APPROPRIATE NAME
{{JSR{DTACH{{{DETACH I/O ASSOCIATION FROM NAME
{{BRN{EXNUL{{{RETURN NULL RESULT
{{EJC{{{{
*
* DIFFER
*
{S$DIF{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT
{{MOV{(SP)+{R10{{LOAD FIRST ARGUMENT
{{JSR{IDENT{{{CALL IDENT COMPARISON ROUTINE
{{PPM{EXFAL{{{FAIL IF IDENT
{{BRN{EXNUL{{{RETURN NULL IF DIFFER
{{EJC{{{{
*
* DUMP
*
{S$DMP{ENT{{{{ENTRY POINT
{{JSR{GTSMI{{{LOAD DUMP ARG AS SMALL INTEGER
{{ERR{088{DUMP{{ARGUMENT IS NOT INTEGER
{{ERR{089{DUMP{{ARGUMENT IS NEGATIVE OR TOO LARGE
{{JSR{DUMPR{{{ELSE CALL DUMP ROUTINE
{{BRN{EXNUL{{{AND RETURN NULL AS RESULT
{{EJC{{{{
*
* DUPL
*
{S$DUP{ENT{{{{ENTRY POINT
{{JSR{GTSMI{{{GET SECOND ARGUMENT AS SMALL INTEGE
{{ERR{090{DUPL{{SECOND ARGUMENT IS NOT INTEGER
{{PPM{SDUP7{{{JUMP IF NEGATIVE OT TOO BIG
{{MOV{R9{R7{{SAVE DUPLICATION FACTOR
{{JSR{GTSTG{{{GET FIRST ARG AS STRING
{{PPM{SDUP4{{{JUMP IF NOT A STRING
*
* HERE FOR CASE OF DUPLICATION OF A STRING
*
{{MTI{R6{{{ACQUIRE LENGTH AS INTEGER
{{STI{DUPSI{{{SAVE FOR THE MOMENT
{{MTI{R7{{{GET DUPLICATION FACTOR AS INTEGER
{{MLI{DUPSI{{{FORM PRODUCT
{{IOV{SDUP3{{{JUMP IF OVERFLOW
{{IEQ{EXNUL{{{RETURN NULL IF RESULT LENGTH = 0
{{MFI{R6{SDUP3{{GET AS ADDR INTEGER, CHECK OVFLO
*
* MERGE HERE WITH RESULT LENGTH IN WA
*
{SDUP1{MOV{R9{R10{{SAVE STRING POINTER
{{JSR{ALOCS{{{ALLOCATE SPACE FOR STRING
{{MOV{R9{-(SP){{SAVE AS RESULT POINTER
{{MOV{R10{R8{{SAVE POINTER TO ARGUMENT STRING
{{PSC{R9{{{PREPARE TO STORE CHARS OF RESULT
{{LCT{R7{R7{{SET COUNTER TO CONTROL LOOP
*
* LOOP THROUGH DUPLICATIONS
*
{SDUP2{MOV{R8{R10{{POINT BACK TO ARGUMENT STRING
{{MOV{4*SCLEN(R10){R6{{GET NUMBER OF CHARACTERS
{{PLC{R10{{{POINT TO CHARS IN ARGUMENT STRING
{{MVC{{{{MOVE CHARACTERS TO RESULT STRING
{{BCT{R7{SDUP2{{LOOP TILL ALL DUPLICATIONS DONE
{{BRN{EXITS{{{THEN EXIT FOR NEXT CODE WORD
{{EJC{{{{
*
* DUPL (CONTINUED)
*
* HERE IF TOO LARGE, SET MAX LENGTH AND LET ALOCS CATCH IT
*
{SDUP3{MOV{DNAME{R6{{SET IMPOSSIBLE LENGTH FOR ALOCS
{{BRN{SDUP1{{{MERGE BACK
*
* HERE IF NOT A STRING
*
{SDUP4{JSR{GTPAT{{{CONVERT ARGUMENT TO PATTERN
{{ERR{091{DUPL{{FIRST ARGUMENT IS NOT STRING OR PATTERN
*
* HERE TO DUPLICATE A PATTERN ARGUMENT
*
{{MOV{R9{-(SP){{STORE PATTERN ON STACK
{{MOV{#NDNTH{R9{{START OFF WITH NULL PATTERN
{{BZE{R7{SDUP6{{NULL PATTERN IS RESULT IF DUPFAC=0
{{MOV{R7{-(SP){{PRESERVE LOOP COUNT
*
* LOOP TO DUPLICATE BY SUCCESSIVE CONCATENATION
*
{SDUP5{MOV{R9{R10{{COPY CURRENT VALUE AS RIGHT ARGUMNT
{{MOV{4*1(SP){R9{{GET A NEW COPY OF LEFT
{{JSR{PCONC{{{CONCATENATE
{{DCV{(SP){{{COUNT DOWN
{{BNZ{(SP){SDUP5{{LOOP
{{ICA{SP{{{POP LOOP COUNT
*
* HERE TO EXIT AFTER CONSTRUCTING PATTERN
*
{SDUP6{MOV{R9{(SP){{STORE RESULT ON STACK
{{BRN{EXITS{{{EXIT WITH RESULT ON STACK
*
* FAIL IF SECOND ARG IS OUT OF RANGE
*
{SDUP7{ICA{SP{{{POP FIRST ARGUMENT
{{BRN{EXFAL{{{FAIL
{{EJC{{{{
*
* EJECT
*
{S$EJC{ENT{{{{ENTRY POINT
{{JSR{IOFCB{{{CALL FCBLK ROUTINE
{{ERR{092{EJECT{{ARGUMENT IS NOT A SUITABLE NAME
{{PPM{SEJC1{{{NULL ARGUMENT
{{JSR{SYSEF{{{CALL EJECT FILE FUNCTION
{{ERR{093{EJECT{{FILE DOES NOT EXIST
{{ERR{094{EJECT{{FILE DOES NOT PERMIT PAGE EJECT
{{ERR{095{EJECT{{CAUSED NON-RECOVERABLE OUTPUT ERROR
{{BRN{EXNUL{{{RETURN NULL AS RESULT
*
* HERE TO EJECT STANDARD OUTPUT FILE
*
{SEJC1{JSR{SYSEP{{{CALL ROUTINE TO EJECT PRINTER
{{BRN{EXNUL{{{EXIT WITH NULL RESULT
{{EJC{{{{
*
* ENDFILE
*
{S$ENF{ENT{{{{ENTRY POINT
{{JSR{IOFCB{{{CALL FCBLK ROUTINE
{{ERR{096{ENDFILE{{ARGUMENT IS NOT A SUITABLE NAME
{{ERR{097{ENDFILE{{ARGUMENT IS NULL
{{JSR{SYSEN{{{CALL ENDFILE ROUTINE
{{ERR{098{ENDFILE{{FILE DOES NOT EXIST
{{ERR{099{ENDFILE{{FILE DOES NOT PERMIT ENDFILE
{{ERR{100{ENDFILE{{CAUSED NON-RECOVERABLE OUTPUT ERROR
{{MOV{R10{R7{{REMEMBER VRBLK PTR FROM IOFCB CALL
*
* LOOP TO FIND TRTRF BLOCK
*
{SENF1{MOV{R10{R9{{COPY POINTER
{{MOV{4*TRVAL(R9){R9{{CHAIN ALONG
{{BNE{(R9){#B$TRT{EXNUL{SKIP OUT IF CHAIN END
{{BNE{4*TRTYP(R9){#TRTFC{SENF1{LOOP IF NOT FOUND
{{MOV{4*TRVAL(R9){4*TRVAL(R10){{REMOVE TRTRF
{{MOV{4*TRTRF(R9){ENFCH{{POINT TO HEAD OF IOCHN
{{MOV{4*TRFPT(R9){R8{{POINT TO FCBLK
{{MOV{R7{R9{{FILEARG1 VRBLK FROM IOFCB
{{JSR{SETVR{{{RESET IT
{{MOV{#R$FCB{R10{{PTR TO HEAD OF FCBLK CHAIN
{{SUB{#4*NUM02{R10{{ADJUST READY TO ENTER LOOP
*
* FIND FCBLK
*
{SENF2{MOV{R10{R9{{COPY PTR
{{MOV{4*2(R10){R10{{GET NEXT LINK
{{BZE{R10{SENF4{{STOP IF CHAIN END
{{BEQ{4*3(R10){R8{SENF3{JUMP IF FCBLK FOUND
{{BRN{SENF2{{{LOOP
*
* REMOVE FCBLK
*
{SENF3{MOV{4*2(R10){4*2(R9){{DELETE FCBLK FROM CHAIN
*
* LOOP WHICH DETACHES ALL VBLS ON IOCHN CHAIN
*
{SENF4{MOV{ENFCH{R10{{GET CHAIN HEAD
{{BZE{R10{EXNUL{{FINISHED IF CHAIN END
{{MOV{4*TRTRF(R10){ENFCH{{CHAIN ALONG
{{MOV{4*IONMO(R10){R6{{NAME OFFSET
{{MOV{4*IONMB(R10){R10{{NAME BASE
{{JSR{DTACH{{{DETACH NAME
{{BRN{SENF4{{{LOOP TILL DONE
{{EJC{{{{
*
* EQ
*
{S$EQF{ENT{{{{ENTRY POINT
{{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
{{ERR{101{EQ{{FIRST ARGUMENT IS NOT NUMERIC
{{ERR{102{EQ{{SECOND ARGUMENT IS NOT NUMERIC
{{PPM{EXFAL{{{FAIL IF LT
{{PPM{EXNUL{{{RETURN NULL IF EQ
{{PPM{EXFAL{{{FAIL IF GT
{{EJC{{{{
*
* EVAL
*
{S$EVL{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{JSR{GTEXP{{{CONVERT TO EXPRESSION
{{ERR{103{EVAL{{ARGUMENT IS NOT EXPRESSION
{{LCW{R8{{{LOAD NEXT CODE WORD
{{BNE{R8{#OFNE${SEVL1{JUMP IF CALLED BY VALUE
{{SCP{R10{{{COPY CODE POINTER
{{MOV{(R10){R6{{GET NEXT CODE WORD
{{BNE{R6{#ORNM${SEVL2{BY NAME UNLESS EXPRESSION
{{BNZ{4*1(SP){SEVL2{{JUMP IF BY NAME
*
* HERE IF CALLED BY VALUE
*
{SEVL1{ZER{R7{{{SET FLAG FOR BY VALUE
{{MOV{R8{-(SP){{SAVE CODE WORD
{{JSR{EVALX{{{EVALUATE EXPRESSION BY VALUE
{{PPM{EXFAL{{{FAIL IF EVALUATION FAILS
{{MOV{R9{R10{{COPY RESULT
{{MOV{(SP){R9{{RELOAD NEXT CODE WORD
{{MOV{R10{(SP){{STACK RESULT
{{BRI{(R9){{{JUMP TO EXECUTE NEXT CODE WORD
*
* HERE IF CALLED BY NAME
*
{SEVL2{MOV{#NUM01{R7{{SET FLAG FOR BY NAME
{{JSR{EVALX{{{EVALUATE EXPRESSION BY NAME
{{PPM{EXFAL{{{FAIL IF EVALUATION FAILS
{{BRN{EXNAM{{{EXIT WITH NAME
{{EJC{{{{
*
* EXIT
*
{S$EXT{ENT{{{{ENTRY POINT
{{ZER{R7{{{CLEAR AMOUNT OF STATIC SHIFT
{{JSR{GBCOL{{{COMPACT MEMORY BY COLLECTING
{{JSR{GTSTG{{{CONVERT ARG TO STRING
{{ERR{104{EXIT{{ARGUMENT IS NOT SUITABLE INTEGER OR STRING
{{MOV{R9{R10{{COPY STRING PTR
{{JSR{GTINT{{{CHECK IT IS INTEGER
{{PPM{SEXT1{{{SKIP IF UNCONVERTIBLE
{{ZER{R10{{{NOTE IT IS INTEGER
{{LDI{4*ICVAL(R9){{{GET INTEGER ARG
{{MOV{R$FCB{R7{{GET FCBLK CHAIN HEADER
*
* MERGE TO CALL OSINT EXIT ROUTINE
*
{SEXT1{MOV{#HEADV{R9{{POINT TO V.V STRING
{{JSR{SYSXI{{{CALL EXTERNAL ROUTINE
{{ERR{105{EXIT{{ACTION NOT AVAILABLE IN THIS IMPLEMENTATION
{{ERR{106{EXIT{{ACTION CAUSED IRRECOVERABLE ERROR
{{IEQ{EXNUL{{{RETURN IF ARGUMENT 0
{{ZER{GBCNT{{{RESUMING EXECUTION SO RESET
{{IGT{SEXT2{{{SKIP IF POSITIVE
{{NGI{{{{MAKE POSITIVE
*
* CHECK FOR OPTION RESPECIFICATION
*
{SEXT2{MFI{R8{{{GET VALUE IN WORK REG
{{BEQ{R8{#NUM03{SEXT3{SKIP IF WAS 3
{{MOV{R8{-(SP){{SAVE VALUE
{{ZER{R8{{{SET TO READ OPTIONS
{{JSR{PRPAR{{{READ SYSPP OPTIONS
{{MOV{(SP)+{R8{{RESTORE VALUE
*
* DEAL WITH HEADER OPTION (FIDDLED BY PRPAR)
*
{SEXT3{MNZ{HEADP{{{ASSUME NO HEADERS
{{BNE{R8{#NUM01{SEXT4{SKIP IF NOT 1
{{ZER{HEADP{{{REQUEST HEADER PRINTING
*
* ALMOST READY TO RESUME RUNNING
*
{SEXT4{JSR{SYSTM{{{GET EXECUTION TIME START (SGD11)
{{STI{TIMSX{{{SAVE AS INITIAL TIME
{{LDI{KVSTC{{{RESET TO ENSURE ...
{{STI{KVSTL{{{... CORRECT EXECUTION STATS
{{BRN{EXNUL{{{RESUME EXECUTION
{{EJC{{{{
*
* FIELD
*
{S$FLD{ENT{{{{ENTRY POINT
{{JSR{GTSMI{{{GET SECOND ARGUMENT (FIELD NUMBER)
{{ERR{107{FIELD{{SECOND ARGUMENT IS NOT INTEGER
{{PPM{EXFAL{{{FAIL IF OUT OF RANGE
{{MOV{R9{R7{{ELSE SAVE INTEGER VALUE
{{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
{{JSR{GTNVR{{{POINT TO VRBLK
{{PPM{SFLD1{{{JUMP (ERROR) IF NOT VARIABLE NAME
{{MOV{4*VRFNC(R9){R9{{ELSE POINT TO FUNCTION BLOCK
{{BNE{(R9){#B$DFC{SFLD1{ERROR IF NOT DATATYPE FUNCTION
*
* HERE IF FIRST ARGUMENT IS A DATATYPE FUNCTION NAME
*
{{BZE{R7{EXFAL{{FAIL IF ARGUMENT NUMBER IS ZERO
{{BGT{R7{4*FARGS(R9){EXFAL{FAIL IF TOO LARGE
{{WTB{R7{{{ELSE CONVERT TO BYTE OFFSET
{{ADD{R7{R9{{POINT TO FIELD NAME
{{MOV{4*DFFLB(R9){R9{{LOAD VRBLK POINTER
{{BRN{EXVNM{{{EXIT TO BUILD NMBLK
*
* HERE FOR BAD FIRST ARGUMENT
*
{SFLD1{ERB{108{FIELD{{FIRST ARGUMENT IS NOT DATATYPE NAME
{{EJC{{{{
*
* FENCE
*
{S$FNC{ENT{{{{ENTRY POINT
{{MOV{#P$FNC{R7{{SET PCODE FOR P$FNC
{{ZER{R9{{{P0BLK
{{JSR{PBILD{{{BUILD P$FNC NODE
{{MOV{R9{R10{{SAVE POINTER TO IT
{{MOV{(SP)+{R9{{GET ARGUMENT
{{JSR{GTPAT{{{CONVERT TO PATTERN
{{ERR{259{FENCE{{ARGUMENT IS NOT PATTERN
{{JSR{PCONC{{{CONCATENATE TO P$FNC NODE
{{MOV{R9{R10{{SAVE PTR TO CONCATENATED PATTERN
{{MOV{#P$FNA{R7{{SET FOR P$FNA PCODE
{{ZER{R9{{{P0BLK
{{JSR{PBILD{{{CONSTRUCT P$FNA NODE
{{MOV{R10{4*PTHEN(R9){{SET PATTERN AS PTHEN
{{MOV{R9{-(SP){{SET AS RESULT
{{BRN{EXITS{{{DO NEXT CODE WORD
{{EJC{{{{
*
* GE
*
{S$GEF{ENT{{{{ENTRY POINT
{{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
{{ERR{109{GE{{FIRST ARGUMENT IS NOT NUMERIC
{{ERR{110{GE{{SECOND ARGUMENT IS NOT NUMERIC
{{PPM{EXFAL{{{FAIL IF LT
{{PPM{EXNUL{{{RETURN NULL IF EQ
{{PPM{EXNUL{{{RETURN NULL IF GT
{{EJC{{{{
*
* GT
*
{S$GTF{ENT{{{{ENTRY POINT
{{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
{{ERR{111{GT{{FIRST ARGUMENT IS NOT NUMERIC
{{ERR{112{GT{{SECOND ARGUMENT IS NOT NUMERIC
{{PPM{EXFAL{{{FAIL IF LT
{{PPM{EXFAL{{{FAIL IF EQ
{{PPM{EXNUL{{{RETURN NULL IF GT
{{EJC{{{{
*
* HOST
*
{S$HST{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{GET THIRD ARG
{{MOV{(SP)+{R10{{GET SECOND ARG
{{MOV{(SP)+{R6{{GET FIRST ARG
{{JSR{SYSHS{{{ENTER SYSHS ROUTINE
{{ERR{254{ERRONEOUS{{ARGUMENT FOR HOST
{{ERR{255{ERROR{{DURING EXECUTION OF HOST
{{PPM{SHST1{{{STORE HOST STRING
{{PPM{EXNUL{{{RETURN NULL RESULT
{{PPM{EXIXR{{{RETURN XR
{{PPM{EXFAL{{{FAIL RETURN
*
* RETURN HOST STRING
*
{SHST1{BZE{R10{EXNUL{{NULL STRING IF SYSHS UNCOOPERATIVE
{{MOV{4*SCLEN(R10){R6{{LENGTH
{{ZER{R7{{{ZERO OFFSET
{{JSR{SBSTR{{{BUILD COPY OF STRING
{{MOV{R9{-(SP){{STACK THE RESULT
{{BRN{EXITS{{{RETURN RESULT ON STACK
{{EJC{{{{
*
* IDENT
*
{S$IDN{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT
{{MOV{(SP)+{R10{{LOAD FIRST ARGUMENT
{{JSR{IDENT{{{CALL IDENT COMPARISON ROUTINE
{{PPM{EXNUL{{{RETURN NULL IF IDENT
{{BRN{EXFAL{{{FAIL IF DIFFER
{{EJC{{{{
*
* INPUT
*
{S$INP{ENT{{{{ENTRY POINT
{{ZER{R7{{{INPUT FLAG
{{JSR{IOPUT{{{CALL INPUT/OUTPUT ASSOC. ROUTINE
{{ERR{113{INPUT{{THIRD ARGUMENT IS NOT A STRING
{{ERR{114{INAPPROPRIATE{{SECOND ARGUMENT FOR INPUT
{{ERR{115{INAPPROPRIATE{{FIRST ARGUMENT FOR INPUT
{{ERR{116{INAPPROPRIATE{{FILE SPECIFICATION FOR INPUT
{{PPM{EXFAL{{{FAIL IF FILE DOES NOT EXIST
{{ERR{117{INPUT{{FILE CANNOT BE READ
{{BRN{EXNUL{{{RETURN NULL STRING
{{EJC{{{{
*
* INSERT
*
{S$INS{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R10{{GET STRING ARG
{{JSR{GTSMI{{{GET REPLACE LENGTH
{{ERR{277{INSERT{{THIRD ARGUMENT NOT INTEGER
{{PPM{EXFAL{{{FAIL IF OUT OF RANGE
{{MOV{R8{R7{{COPY TO PROPER REG
{{JSR{GTSMI{{{GET REPLACE POSITION
{{ERR{278{INSERT{{SECOND ARGUMENT NOT INTEGER
{{PPM{EXFAL{{{FAIL IF OUT OF RANGE
{{BZE{R8{EXFAL{{FAIL IF ZERO
{{DCV{R8{{{DECREMENT TO GET OFFSET
{{MOV{R8{R6{{PUT IN PROPER REGISTER
{{MOV{(SP)+{R9{{GET BUFFER
{{BEQ{(R9){#B$BCT{SINS1{PRESS ON IF TYPE OK
{{ERB{279{INSERT{{FIRST ARGUMENT NOT BUFFER
*
* HERE WHEN EVERYTHING LOADED UP
*
{SINS1{JSR{INSBF{{{CALL TO INSERT
{{ERR{280{INSERT{{FOURTH ARGUMENT NOT A STRING
{{PPM{EXFAL{{{FAIL IF OUT OF RANGE
{{BRN{EXNUL{{{ELSE OK - EXIT WITH NULL
{{EJC{{{{
*
* INTEGER
*
{S$INT{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{JSR{GTNUM{{{CONVERT TO NUMERIC
{{PPM{EXFAL{{{FAIL IF NON-NUMERIC
{{BEQ{R6{#B$ICL{EXNUL{RETURN NULL IF INTEGER
{{BRN{EXFAL{{{FAIL IF REAL
{{EJC{{{{
*
* ITEM
*
* ITEM DOES NOT PERMIT THE DIRECT (FAST) CALL SO THAT
* WA CONTAINS THE ACTUAL NUMBER OF ARGUMENTS PASSED.
*
{S$ITM{ENT{{{{ENTRY POINT
*
* DEAL WITH CASE OF NO ARGS
*
{{BNZ{R6{SITM1{{JUMP IF AT LEAST ONE ARG
{{MOV{#NULLS{-(SP){{ELSE SUPPLY GARBAGE NULL ARG
{{MOV{#NUM01{R6{{AND FIX ARGUMENT COUNT
*
* CHECK FOR NAME/VALUE CASES
*
{SITM1{SCP{R9{{{GET CURRENT CODE POINTER
{{MOV{(R9){R10{{LOAD NEXT CODE WORD
{{DCV{R6{{{GET NUMBER OF SUBSCRIPTS
{{MOV{R6{R9{{COPY FOR ARREF
{{BEQ{R10{#OFNE${SITM2{JUMP IF CALLED BY NAME
*
* HERE IF CALLED BY VALUE
*
{{ZER{R7{{{SET CODE FOR CALL BY VALUE
{{BRN{ARREF{{{OFF TO ARRAY REFERENCE ROUTINE
*
* HERE FOR CALL BY NAME
*
{SITM2{MNZ{R7{{{SET CODE FOR CALL BY NAME
{{LCW{R6{{{LOAD AND IGNORE OFNE$ CALL
{{BRN{ARREF{{{OFF TO ARRAY REFERENCE ROUTINE
{{EJC{{{{
*
* LE
*
{S$LEF{ENT{{{{ENTRY POINT
{{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
{{ERR{118{LE{{FIRST ARGUMENT IS NOT NUMERIC
{{ERR{119{LE{{SECOND ARGUMENT IS NOT NUMERIC
{{PPM{EXNUL{{{RETURN NULL IF LT
{{PPM{EXNUL{{{RETURN NULL IF EQ
{{PPM{EXFAL{{{FAIL IF GT
{{EJC{{{{
*
* LEN
*
{S$LEN{ENT{{{{ENTRY POINT
{{MOV{#P$LEN{R7{{SET PCODE FOR INTEGER ARG CASE
{{MOV{#P$LND{R6{{SET PCODE FOR EXPR ARG CASE
{{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE
{{ERR{120{LEN{{ARGUMENT IS NOT INTEGER OR EXPRESSION
{{ERR{121{LEN{{ARGUMENT IS NEGATIVE OR TOO LARGE
{{BRN{EXIXR{{{RETURN PATTERN NODE
{{EJC{{{{
*
* LEQ
*
{S$LEQ{ENT{{{{ENTRY POINT
{{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
{{ERR{122{LEQ{{FIRST ARGUMENT IS NOT STRING
{{ERR{123{LEQ{{SECOND ARGUMENT IS NOT STRING
{{PPM{EXFAL{{{FAIL IF LLT
{{PPM{EXNUL{{{RETURN NULL IF LEQ
{{PPM{EXFAL{{{FAIL IF LGT
{{EJC{{{{
*
* LGE
*
{S$LGE{ENT{{{{ENTRY POINT
{{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
{{ERR{124{LGE{{FIRST ARGUMENT IS NOT STRING
{{ERR{125{LGE{{SECOND ARGUMENT IS NOT STRING
{{PPM{EXFAL{{{FAIL IF LLT
{{PPM{EXNUL{{{RETURN NULL IF LEQ
{{PPM{EXNUL{{{RETURN NULL IF LGT
{{EJC{{{{
*
* LGT
*
{S$LGT{ENT{{{{ENTRY POINT
{{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
{{ERR{126{LGT{{FIRST ARGUMENT IS NOT STRING
{{ERR{127{LGT{{SECOND ARGUMENT IS NOT STRING
{{PPM{EXFAL{{{FAIL IF LLT
{{PPM{EXFAL{{{FAIL IF LEQ
{{PPM{EXNUL{{{RETURN NULL IF LGT
{{EJC{{{{
*
* LLE
*
{S$LLE{ENT{{{{ENTRY POINT
{{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
{{ERR{128{LLE{{FIRST ARGUMENT IS NOT STRING
{{ERR{129{LLE{{SECOND ARGUMENT IS NOT STRING
{{PPM{EXNUL{{{RETURN NULL IF LLT
{{PPM{EXNUL{{{RETURN NULL IF LEQ
{{PPM{EXFAL{{{FAIL IF LGT
{{EJC{{{{
*
* LLT
*
{S$LLT{ENT{{{{ENTRY POINT
{{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
{{ERR{130{LLT{{FIRST ARGUMENT IS NOT STRING
{{ERR{131{LLT{{SECOND ARGUMENT IS NOT STRING
{{PPM{EXNUL{{{RETURN NULL IF LLT
{{PPM{EXFAL{{{FAIL IF LEQ
{{PPM{EXFAL{{{FAIL IF LGT
{{EJC{{{{
*
* LNE
*
{S$LNE{ENT{{{{ENTRY POINT
{{JSR{LCOMP{{{CALL STRING COMPARISON ROUTINE
{{ERR{132{LNE{{FIRST ARGUMENT IS NOT STRING
{{ERR{133{LNE{{SECOND ARGUMENT IS NOT STRING
{{PPM{EXNUL{{{RETURN NULL IF LLT
{{PPM{EXFAL{{{FAIL IF LEQ
{{PPM{EXNUL{{{RETURN NULL IF LGT
{{EJC{{{{
*
* LOCAL
*
{S$LOC{ENT{{{{ENTRY POINT
{{JSR{GTSMI{{{GET SECOND ARGUMENT (LOCAL NUMBER)
{{ERR{134{LOCAL{{SECOND ARGUMENT IS NOT INTEGER
{{PPM{EXFAL{{{FAIL IF OUT OF RANGE
{{MOV{R9{R7{{SAVE LOCAL NUMBER
{{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
{{JSR{GTNVR{{{POINT TO VRBLK
{{PPM{SLOC1{{{JUMP IF NOT VARIABLE NAME
{{MOV{4*VRFNC(R9){R9{{ELSE LOAD FUNCTION POINTER
{{BNE{(R9){#B$PFC{SLOC1{JUMP IF NOT PROGRAM DEFINED
*
* HERE IF WE HAVE A PROGRAM DEFINED FUNCTION NAME
*
{{BZE{R7{EXFAL{{FAIL IF SECOND ARG IS ZERO
{{BGT{R7{4*PFNLO(R9){EXFAL{OR TOO LARGE
{{ADD{4*FARGS(R9){R7{{ELSE ADJUST OFFSET TO INCLUDE ARGS
{{WTB{R7{{{CONVERT TO BYTES
{{ADD{R7{R9{{POINT TO LOCAL POINTER
{{MOV{4*PFAGB(R9){R9{{LOAD VRBLK POINTER
{{BRN{EXVNM{{{EXIT BUILDING NMBLK
*
* HERE IF FIRST ARGUMENT IS NO GOOD
*
{SLOC1{ERB{135{LOCAL{{FIRST ARG IS NOT A PROGRAM FUNCTION NAME
{{EJC{{{{
*
* LOAD
*
{S$LOD{ENT{{{{ENTRY POINT
{{JSR{GTSTG{{{LOAD LIBRARY NAME
{{ERR{136{LOAD{{SECOND ARGUMENT IS NOT STRING
{{MOV{R9{R10{{SAVE LIBRARY NAME
{{JSR{XSCNI{{{PREPARE TO SCAN FIRST ARGUMENT
{{ERR{137{LOAD{{FIRST ARGUMENT IS NOT STRING
{{ERR{138{LOAD{{FIRST ARGUMENT IS NULL
{{MOV{R10{-(SP){{STACK LIBRARY NAME
{{MOV{#CH$PP{R8{{SET DELIMITER ONE = LEFT PAREN
{{MOV{R8{R10{{SET DELIMITER TWO = LEFT PAREN
{{JSR{XSCAN{{{SCAN FUNCTION NAME
{{MOV{R9{-(SP){{SAVE PTR TO FUNCTION NAME
{{BNZ{R6{SLOD1{{JUMP IF LEFT PAREN FOUND
{{ERB{139{LOAD{{FIRST ARGUMENT IS MISSING A LEFT PAREN
*
* HERE AFTER SUCCESSFULLY SCANNING FUNCTION NAME
*
{SLOD1{JSR{GTNVR{{{LOCATE VRBLK
{{ERR{140{LOAD{{FIRST ARGUMENT HAS NULL FUNCTION NAME
{{MOV{R9{LODFN{{SAVE VRBLK POINTER
{{ZER{LODNA{{{ZERO COUNT OF ARGUMENTS
*
* LOOP TO SCAN ARGUMENT DATATYPE NAMES
*
{SLOD2{MOV{#CH$RP{R8{{DELIMITER ONE IS RIGHT PAREN
{{MOV{#CH$CM{R10{{DELIMITER TWO IS COMMA
{{JSR{XSCAN{{{SCAN NEXT ARGUMENT NAME
{{ICV{LODNA{{{BUMP ARGUMENT COUNT
{{BNZ{R6{SLOD3{{JUMP IF OK DELIMITER WAS FOUND
{{ERB{141{LOAD{{FIRST ARGUMENT IS MISSING A RIGHT PAREN
{{EJC{{{{
*
* LOAD (CONTINUED)
*
* COME HERE TO ANALYZE THE DATATYPE POINTER IN (XR). THIS
* CODE IS USED BOTH FOR ARGUMENTS (WA=1,2) AND FOR THE
* RESULT DATATYPE (WITH WA SET TO ZERO).
*
{SLOD3{MOV{R9{-(SP){{STACK DATATYPE NAME POINTER
{{MOV{#NUM01{R7{{SET STRING CODE IN CASE
{{MOV{#SCSTR{R10{{POINT TO /STRING/
{{JSR{IDENT{{{CHECK FOR MATCH
{{PPM{SLOD4{{{JUMP IF MATCH
{{MOV{(SP){R9{{ELSE RELOAD NAME
{{ADD{R7{R7{{SET CODE FOR INTEGER (2)
{{MOV{#SCINT{R10{{POINT TO /INTEGER/
{{JSR{IDENT{{{CHECK FOR MATCH
{{PPM{SLOD4{{{JUMP IF MATCH
{{MOV{(SP){R9{{ELSE RELOAD STRING POINTER
{{ICV{R7{{{SET CODE FOR REAL (3)
{{MOV{#SCREA{R10{{POINT TO /REAL/
{{JSR{IDENT{{{CHECK FOR MATCH
{{PPM{SLOD4{{{JUMP IF MATCH
{{ZER{R7{{{ELSE GET CODE FOR NO CONVERT
*
* MERGE HERE WITH PROPER DATATYPE CODE IN WB
*
{SLOD4{MOV{R7{(SP){{STORE CODE ON STACK
{{BEQ{R6{#NUM02{SLOD2{LOOP BACK IF ARG STOPPED BY COMMA
{{BZE{R6{SLOD5{{JUMP IF THAT WAS THE RESULT TYPE
*
* HERE WE SCAN OUT THE RESULT TYPE (ARG STOPPED BY ) )
*
{{MOV{MXLEN{R8{{SET DUMMY (IMPOSSIBLE) DELIMITER 1
{{MOV{R8{R10{{AND DELIMITER TWO
{{JSR{XSCAN{{{SCAN RESULT NAME
{{ZER{R6{{{SET CODE FOR PROCESSING RESULT
{{BRN{SLOD3{{{JUMP BACK TO PROCESS RESULT NAME
{{EJC{{{{
*
* LOAD (CONTINUED)
*
* HERE AFTER PROCESSING ALL ARGS AND RESULT
*
{SLOD5{MOV{LODNA{R6{{GET NUMBER OF ARGUMENTS
{{MOV{R6{R8{{COPY FOR LATER
{{WTB{R6{{{CONVERT LENGTH TO BYTES
{{ADD{#4*EFSI${R6{{ADD SPACE FOR STANDARD FIELDS
{{JSR{ALLOC{{{ALLOCATE EFBLK
{{MOV{#B$EFC{(R9){{SET TYPE WORD
{{MOV{R8{4*FARGS(R9){{SET NUMBER OF ARGUMENTS
{{ZER{4*EFUSE(R9){{{SET USE COUNT (DFFNC WILL SET TO 1)
{{ZER{4*EFCOD(R9){{{ZERO CODE POINTER FOR NOW
{{MOV{(SP)+{4*EFRSL(R9){{STORE RESULT TYPE CODE
{{MOV{LODFN{4*EFVAR(R9){{STORE FUNCTION VRBLK POINTER
{{MOV{R6{4*EFLEN(R9){{STORE EFBLK LENGTH
{{MOV{R9{R7{{SAVE EFBLK POINTER
{{ADD{R6{R9{{POINT PAST END OF EFBLK
{{LCT{R8{R8{{SET NUMBER OF ARGUMENTS FOR LOOP
*
* LOOP TO SET ARGUMENT TYPE CODES FROM STACK
*
{SLOD6{MOV{(SP)+{-(R9){{STORE ONE TYPE CODE FROM STACK
{{BCT{R8{SLOD6{{LOOP TILL ALL STORED
*
* NOW LOAD THE EXTERNAL FUNCTION AND PERFORM DEFINITION
*
{{MOV{(SP)+{R9{{LOAD FUNCTION STRING NAME
{{MOV{(SP){R10{{LOAD LIBRARY NAME
{{MOV{R7{(SP){{STORE EFBLK POINTER
{{JSR{SYSLD{{{CALL FUNCTION TO LOAD EXTERNAL FUNC
{{ERR{142{LOAD{{FUNCTION DOES NOT EXIST
{{ERR{143{LOAD{{FUNCTION CAUSED INPUT ERROR DURING LOAD
{{MOV{(SP)+{R10{{RECALL EFBLK POINTER
{{MOV{R9{4*EFCOD(R10){{STORE CODE POINTER
{{MOV{LODFN{R9{{POINT TO VRBLK FOR FUNCTION
{{JSR{DFFNC{{{PERFORM FUNCTION DEFINITION
{{BRN{EXNUL{{{RETURN NULL RESULT
{{EJC{{{{
*
* LPAD
*
{S$LPD{ENT{{{{ENTRY POINT
{{JSR{GTSTG{{{GET PAD CHARACTER
{{ERR{144{LPAD{{THIRD ARGUMENT NOT A STRING
{{PLC{R9{{{POINT TO CHARACTER (NULL IS BLANK)
{{LCH{R7{(R9){{LOAD PAD CHARACTER
{{JSR{GTSMI{{{GET PAD LENGTH
{{ERR{145{LPAD{{SECOND ARGUMENT IS NOT INTEGER
{{PPM{SLPD3{{{SKIP IF NEGATIVE OR LARGE
*
* MERGE TO CHECK FIRST ARG
*
{SLPD1{JSR{GTSTG{{{GET FIRST ARGUMENT (STRING TO PAD)
{{ERR{146{LPAD{{FIRST ARGUMENT IS NOT STRING
{{BGE{R6{R8{EXIXR{RETURN 1ST ARG IF TOO LONG TO PAD
{{MOV{R9{R10{{ELSE MOVE PTR TO STRING TO PAD
*
* NOW WE ARE READY FOR THE PAD
*
* (XL) POINTER TO STRING TO PAD
* (WB) PAD CHARACTER
* (WC) LENGTH TO PAD STRING TO
*
{{MOV{R8{R6{{COPY LENGTH
{{JSR{ALOCS{{{ALLOCATE SCBLK FOR NEW STRING
{{MOV{R9{-(SP){{SAVE AS RESULT
{{MOV{4*SCLEN(R10){R6{{LOAD LENGTH OF ARGUMENT
{{SUB{R6{R8{{CALCULATE NUMBER OF PAD CHARACTERS
{{PSC{R9{{{POINT TO CHARS IN RESULT STRING
{{LCT{R8{R8{{SET COUNTER FOR PAD LOOP
*
* LOOP TO PERFORM PAD
*
{SLPD2{SCH{R7{(R9)+{{STORE PAD CHARACTER, BUMP PTR
{{BCT{R8{SLPD2{{LOOP TILL ALL PAD CHARS STORED
{{CSC{R9{{{COMPLETE STORE CHARACTERS
*
* NOW COPY STRING
*
{{BZE{R6{EXITS{{EXIT IF NULL STRING
{{PLC{R10{{{ELSE POINT TO CHARS IN ARGUMENT
{{MVC{{{{MOVE CHARACTERS TO RESULT STRING
{{BRN{EXITS{{{JUMP FOR NEXT CODE WORD
*
* HERE IF 2ND ARG IS NEGATIVE OR LARGE
*
{SLPD3{ZER{R8{{{ZERO PAD COUNT
{{BRN{SLPD1{{{MERGE
{{EJC{{{{
*
* LT
*
{S$LTF{ENT{{{{ENTRY POINT
{{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
{{ERR{147{LT{{FIRST ARGUMENT IS NOT NUMERIC
{{ERR{148{LT{{SECOND ARGUMENT IS NOT NUMERIC
{{PPM{EXNUL{{{RETURN NULL IF LT
{{PPM{EXFAL{{{FAIL IF EQ
{{PPM{EXFAL{{{FAIL IF GT
{{EJC{{{{
*
* NE
*
{S$NEF{ENT{{{{ENTRY POINT
{{JSR{ACOMP{{{CALL ARITHMETIC COMPARISON ROUTINE
{{ERR{149{NE{{FIRST ARGUMENT IS NOT NUMERIC
{{ERR{150{NE{{SECOND ARGUMENT IS NOT NUMERIC
{{PPM{EXNUL{{{RETURN NULL IF LT
{{PPM{EXFAL{{{FAIL IF EQ
{{PPM{EXNUL{{{RETURN NULL IF GT
{{EJC{{{{
*
* NOTANY
*
{S$NAY{ENT{{{{ENTRY POINT
{{MOV{#P$NAS{R7{{SET PCODE FOR SINGLE CHAR ARG
{{MOV{#P$NAY{R10{{PCODE FOR MULTI-CHAR ARG
{{MOV{#P$NAD{R8{{SET PCODE FOR EXPR ARG
{{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE
{{ERR{151{NOTANY{{ARGUMENT IS NOT STRING OR EXPRESSION
{{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
{{EJC{{{{
*
* OPSYN
*
{S$OPS{ENT{{{{ENTRY POINT
{{JSR{GTSMI{{{LOAD THIRD ARGUMENT
{{ERR{152{OPSYN{{THIRD ARGUMENT IS NOT INTEGER
{{ERR{153{OPSYN{{THIRD ARGUMENT IS NEGATIVE OR TOO LARGE
{{MOV{R8{R7{{IF OK, SAVE THIRD ARGUMNET
{{MOV{(SP)+{R9{{LOAD SECOND ARGUMENT
{{JSR{GTNVR{{{LOCATE VARIABLE BLOCK
{{ERR{154{OPSYN{{SECOND ARG IS NOT NATURAL VARIABLE NAME
{{MOV{4*VRFNC(R9){R10{{IF OK, LOAD FUNCTION BLOCK POINTER
{{BNZ{R7{SOPS2{{JUMP IF OPERATOR OPSYN CASE
*
* HERE FOR FUNCTION OPSYN (THIRD ARG ZERO)
*
{{MOV{(SP)+{R9{{LOAD FIRST ARGUMENT
{{JSR{GTNVR{{{GET VRBLK POINTER
{{ERR{155{OPSYN{{FIRST ARG IS NOT NATURAL VARIABLE NAME
*
* MERGE HERE TO PERFORM FUNCTION DEFINITION
*
{SOPS1{JSR{DFFNC{{{CALL FUNCTION DEFINER
{{BRN{EXNUL{{{EXIT WITH NULL RESULT
*
* HERE FOR OPERATOR OPSYN (THIRD ARG NON-ZERO)
*
{SOPS2{JSR{GTSTG{{{GET OPERATOR NAME
{{PPM{SOPS5{{{JUMP IF NOT STRING
{{BNE{R6{#NUM01{SOPS5{ERROR IF NOT ONE CHAR LONG
{{PLC{R9{{{ELSE POINT TO CHARACTER
{{LCH{R8{(R9){{LOAD CHARACTER NAME
{{EJC{{{{
*
* OPSYN (CONTINUED)
*
* NOW SET TO SEARCH FOR MATCHING UNARY OR BINARY OPERATOR
* NAME AS APPROPRIATE. NOTE THAT THERE ARE =OPBUN UNDEFINED
* BINARY OPERATORS AND =OPUUN UNDEFINED UNARY OPERATORS.
*
{{MOV{#R$UUB{R6{{POINT TO UNOP POINTERS IN CASE
{{MOV{#OPNSU{R9{{POINT TO NAMES OF UNARY OPERATORS
{{ADD{#OPBUN{R7{{ADD NO. OF UNDEFINED BINARY OPS
{{BEQ{R7{#OPUUN{SOPS3{JUMP IF UNOP (THIRD ARG WAS 1)
{{MOV{#R$UBA{R6{{ELSE POINT TO BINARY OPERATOR PTRS
{{MOV{#OPSNB{R9{{POINT TO NAMES OF BINARY OPERATORS
{{MOV{#OPBUN{R7{{SET NUMBER OF UNDEFINED BINOPS
*
* MERGE HERE TO CHECK LIST (WB = NUMBER TO CHECK)
*
{SOPS3{LCT{R7{R7{{SET COUNTER TO CONTROL LOOP
*
* LOOP TO SEARCH FOR NAME MATCH
*
{SOPS4{BEQ{R8{(R9){SOPS6{JUMP IF NAMES MATCH
{{ICA{R6{{{ELSE PUSH POINTER TO FUNCTION PTR
{{ICA{R9{{{BUMP POINTER
{{BCT{R7{SOPS4{{LOOP BACK TILL ALL CHECKED
*
* HERE IF BAD OPERATOR NAME
*
{SOPS5{ERB{156{OPSYN{{FIRST ARG IS NOT CORRECT OPERATOR NAME
*
* COME HERE ON FINDING A MATCH IN THE OPERATOR NAME TABLE
*
{SOPS6{MOV{R6{R9{{COPY POINTER TO FUNCTION BLOCK PTR
{{SUB{#4*VRFNC{R9{{MAKE IT LOOK LIKE DUMMY VRBLK
{{BRN{SOPS1{{{MERGE BACK TO DEFINE OPERATOR
{{EJC{{{{
*
* OUTPUT
*
{S$OUP{ENT{{{{ENTRY POINT
{{MOV{#NUM03{R7{{OUTPUT FLAG
{{JSR{IOPUT{{{CALL INPUT/OUTPUT ASSOC. ROUTINE
{{ERR{157{OUTPUT{{THIRD ARGUMENT IS NOT A STRING
{{ERR{158{INAPPROPRIATE{{SECOND ARGUMENT FOR OUTPUT
{{ERR{159{INAPPROPRIATE{{FIRST ARGUMENT FOR OUTPUT
{{ERR{160{INAPPROPRIATE{{FILE SPECIFICATION FOR OUTPUT
{{PPM{EXFAL{{{FAIL IF FILE DOES NOT EXIST
{{ERR{161{OUTPUT{{FILE CANNOT BE WRITTEN TO
{{BRN{EXNUL{{{RETURN NULL STRING
{{EJC{{{{
*
* POS
*
{S$POS{ENT{{{{ENTRY POINT
{{MOV{#P$POS{R7{{SET PCODE FOR INTEGER ARG CASE
{{MOV{#P$PSD{R6{{SET PCODE FOR EXPRESSION ARG CASE
{{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE
{{ERR{162{POS{{ARGUMENT IS NOT INTEGER OR EXPRESSION
{{ERR{163{POS{{ARGUMENT IS NEGATIVE OR TOO LARGE
{{BRN{EXIXR{{{RETURN PATTERN NODE
{{EJC{{{{
*
* PROTOTYPE
*
{S$PRO{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{MOV{4*TBLEN(R9){R7{{LENGTH IF TABLE, VECTOR (=VCLEN)
{{BTW{R7{{{CONVERT TO WORDS
{{MOV{(R9){R6{{LOAD TYPE WORD OF ARGUMENT BLOCK
{{BEQ{R6{#B$ART{SPRO4{JUMP IF ARRAY
{{BEQ{R6{#B$TBT{SPRO1{JUMP IF TABLE
{{BEQ{R6{#B$VCT{SPRO3{JUMP IF VECTOR
{{BEQ{R6{#B$BCT{SPR05{JUMP IF BUFFER
{{ERB{164{PROTOTYPE{{ARGUMENT IS NOT VALID OBJECT
*
* HERE FOR TABLE
*
{SPRO1{SUB{#TBSI${R7{{SUBTRACT STANDARD FIELDS
*
* MERGE FOR VECTOR
*
{SPRO2{MTI{R7{{{CONVERT TO INTEGER
{{BRN{EXINT{{{EXIT WITH INTEGER RESULT
*
* HERE FOR VECTOR
*
{SPRO3{SUB{#VCSI${R7{{SUBTRACT STANDARD FIELDS
{{BRN{SPRO2{{{MERGE
*
* HERE FOR ARRAY
*
{SPRO4{ADD{4*AROFS(R9){R9{{POINT TO PROTOTYPE FIELD
{{MOV{(R9){R9{{LOAD PROTOTYPE
{{BRN{EXIXR{{{RETURN PROTOTYPE AS RESULT
*
* HERE FOR BUFFER
*
{SPR05{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK
{{MTI{4*BFALC(R9){{{LOAD ALLOCATED LENGTH
{{BRN{EXINT{{{EXIT WITH INTEGER ALLOCATION
{{EJC{{{{
*
* REMDR
*
{S$RMD{ENT{{{{ENTRY POINT
{{ZER{R7{{{SET POSITIVE FLAG
{{MOV{(SP){R9{{LOAD SECOND ARGUMENT
{{JSR{GTINT{{{CONVERT TO INTEGER
{{ERR{165{REMDR{{SECOND ARGUMENT IS NOT INTEGER
{{JSR{ARITH{{{CONVERT ARGS
{{PPM{SRM01{{{FIRST ARG NOT INTEGER
{{PPM{{{{SECOND ARG CHECKED ABOVE
{{PPM{SRM01{{{FIRST ARG REAL
{{LDI{4*ICVAL(R9){{{LOAD LEFT ARGUMENT VALUE
{{RMI{4*ICVAL(R10){{{GET REMAINDER
{{INO{EXINT{{{JUMP IF NO OVERFLOW
{{ERB{167{REMDR{{CAUSED INTEGER OVERFLOW
*
* FAIL FIRST ARGUMENT
*
{SRM01{ERB{166{REMDR{{FIRST ARGUMENT IS NOT INTEGER
{{EJC{{{{
*
* REPLACE
*
* THE ACTUAL REPLACE OPERATION USES AN SCBLK WHOSE CFP$A
* CHARS CONTAIN THE TRANSLATED VERSIONS OF ALL THE CHARS.
* THE TABLE POINTER IS REMEMBERED FROM CALL TO CALL AND
* THE TABLE IS ONLY BUILT WHEN THE ARGUMENTS CHANGE.
*
{S$RPL{ENT{{{{ENTRY POINT
{{JSR{GTSTG{{{LOAD THIRD ARGUMENT AS STRING
{{ERR{168{REPLACE{{THIRD ARGUMENT IS NOT STRING
{{MOV{R9{R10{{SAVE THIRD ARG PTR
{{JSR{GTSTG{{{GET SECOND ARGUMENT
{{ERR{169{REPLACE{{SECOND ARGUMENT IS NOT STRING
*
* CHECK TO SEE IF THIS IS THE SAME TABLE AS LAST TIME
*
{{BNE{R9{R$RA2{SRPL1{JUMP IF 2ND ARGUMENT DIFFERENT
{{BEQ{R10{R$RA3{SRPL4{JUMP IF ARGS SAME AS LAST TIME
*
* HERE WE BUILD A NEW REPLACE TABLE (NOTE WA = 2ND ARG LEN)
*
{SRPL1{MOV{4*SCLEN(R10){R7{{LOAD 3RD ARGUMENT LENGTH
{{BNE{R6{R7{SRPL5{JUMP IF ARGUMENTS NOT SAME LENGTH
{{BZE{R7{SRPL5{{JUMP IF NULL 2ND ARGUMENT
{{MOV{R10{R$RA3{{SAVE THIRD ARG FOR NEXT TIME IN
{{MOV{R9{R$RA2{{SAVE SECOND ARG FOR NEXT TIME IN
{{MOV{KVALP{R10{{POINT TO ALPHABET STRING
{{MOV{4*SCLEN(R10){R6{{LOAD ALPHABET SCBLK LENGTH
{{MOV{R$RPT{R9{{POINT TO CURRENT TABLE (IF ANY)
{{BNZ{R9{SRPL2{{JUMP IF WE ALREADY HAVE A TABLE
*
* HERE WE ALLOCATE A NEW TABLE
*
{{JSR{ALOCS{{{ALLOCATE NEW TABLE
{{MOV{R8{R6{{KEEP SCBLK LENGTH
{{MOV{R9{R$RPT{{SAVE TABLE POINTER FOR NEXT TIME
*
* MERGE HERE WITH POINTER TO NEW TABLE BLOCK IN (XR)
*
{SRPL2{CTB{R6{SCSI${{COMPUTE LENGTH OF SCBLK
{{MVW{{{{COPY TO GET INITIAL TABLE VALUES
{{EJC{{{{
*
* REPLACE (CONTINUED)
*
* NOW WE MUST PLUG SELECTED ENTRIES AS REQUIRED. NOTE THAT
* WE ARE SHORT OF INDEX REGISTERS FOR THE FOLLOWING LOOP.
* HENCE THE NEED TO REPEATEDLY RE-INITIALISE CHAR PTR XL
*
{{MOV{R$RA2{R10{{POINT TO SECOND ARGUMENT
{{LCT{R7{R7{{NUMBER OF CHARS TO PLUG
{{ZER{R8{{{ZERO CHAR OFFSET
{{MOV{R$RA3{R9{{POINT TO 3RD ARG
{{PLC{R9{{{GET CHAR PTR FOR 3RD ARG
*
* LOOP TO PLUG CHARS
*
{SRPL3{MOV{R$RA2{R10{{POINT TO 2ND ARG
{{PLC{R10{R8{{POINT TO NEXT CHAR
{{ICV{R8{{{INCREMENT OFFSET
{{LCH{R6{(R10){{GET NEXT CHAR
{{MOV{R$RPT{R10{{POINT TO TRANSLATE TABLE
{{PSC{R10{R6{{CONVERT CHAR TO OFFSET INTO TABLE
{{LCH{R6{(R9)+{{GET TRANSLATED CHAR
{{SCH{R6{(R10){{STORE IN TABLE
{{CSC{R10{{{COMPLETE STORE CHARACTERS
{{BCT{R7{SRPL3{{LOOP TILL DONE
{{EJC{{{{
*
* REPLACE (CONTINUED)
*
* HERE TO PERFORM TRANSLATE
*
{SRPL4{JSR{GTSTG{{{GET FIRST ARGUMENT
{{ERR{170{REPLACE{{FIRST ARGUMENT IS NOT STRING
{{BZE{R6{EXNUL{{RETURN NULL IF NULL ARGUMENT
{{MOV{R9{R10{{COPY POINTER
{{MOV{R6{R8{{SAVE LENGTH
{{CTB{R6{SCHAR{{GET SCBLK LENGTH
{{JSR{ALLOC{{{ALLOCATE SPACE FOR COPY
{{MOV{R9{R7{{SAVE ADDRESS OF COPY
{{MVW{{{{MOVE SCBLK CONTENTS TO COPY
{{MOV{R$RPT{R9{{POINT TO REPLACE TABLE
{{PLC{R9{{{POINT TO CHARS OF TABLE
{{MOV{R7{R10{{POINT TO STRING TO TRANSLATE
{{PLC{R10{{{POINT TO CHARS OF STRING
{{MOV{R8{R6{{SET NUMBER OF CHARS TO TRANSLATE
{{TRC{{{{PERFORM TRANSLATION
{{MOV{R7{-(SP){{STACK NEW STRING AS RESULT
{{BRN{EXITS{{{RETURN WITH RESULT ON STACK
*
* ERROR POINT
*
{SRPL5{ERB{171{NULL{{OR UNEQUALLY LONG 2ND, 3RD ARGS TO REPLACE
{{EJC{{{{
*
* REWIND
*
{S$REW{ENT{{{{ENTRY POINT
{{JSR{IOFCB{{{CALL FCBLK ROUTINE
{{ERR{172{REWIND{{ARGUMENT IS NOT A SUITABLE NAME
{{ERR{173{REWIND{{ARGUMENT IS NULL
{{JSR{SYSRW{{{CALL SYSTEM REWIND FUNCTION
{{ERR{174{REWIND{{FILE DOES NOT EXIST
{{ERR{175{REWIND{{FILE DOES NOT PERMIT REWIND
{{ERR{176{REWIND{{CAUSED NON-RECOVERABLE ERROR
{{BRN{EXNUL{{{EXIT WITH NULL RESULT IF NO ERROR
{{EJC{{{{
*
* REVERSE
*
{S$RVS{ENT{{{{ENTRY POINT
{{JSR{GTSTG{{{LOAD STRING ARGUMENT
{{ERR{177{REVERSE{{ARGUMENT IS NOT STRING
{{BZE{R6{EXIXR{{RETURN ARGUMENT IF NULL
{{MOV{R9{R10{{ELSE SAVE POINTER TO STRING ARG
{{JSR{ALOCS{{{ALLOCATE SPACE FOR NEW SCBLK
{{MOV{R9{-(SP){{STORE SCBLK PTR ON STACK AS RESULT
{{PSC{R9{{{PREPARE TO STORE IN NEW SCBLK
{{PLC{R10{R8{{POINT PAST LAST CHAR IN ARGUMENT
{{LCT{R8{R8{{SET LOOP COUNTER
*
* LOOP TO MOVE CHARS IN REVERSE ORDER
*
{SRVS1{LCH{R7{-(R10){{LOAD NEXT CHAR FROM ARGUMENT
{{SCH{R7{(R9)+{{STORE IN RESULT
{{BCT{R8{SRVS1{{LOOP TILL ALL MOVED
{{CSC{R9{{{COMPLETE STORE CHARACTERS
{{BRN{EXITS{{{AND THEN JUMP FOR NEXT CODE WORD
{{EJC{{{{
*
* RPAD
*
{S$RPD{ENT{{{{ENTRY POINT
{{JSR{GTSTG{{{GET PAD CHARACTER
{{ERR{178{RPAD{{THIRD ARGUMENT IS NOT STRING
{{PLC{R9{{{POINT TO CHARACTER (NULL IS BLANK)
{{LCH{R7{(R9){{LOAD PAD CHARACTER
{{JSR{GTSMI{{{GET PAD LENGTH
{{ERR{179{RPAD{{SECOND ARGUMENT IS NOT INTEGER
{{PPM{SRPD3{{{SKIP IF NEGATIVE OR LARGE
*
* MERGE TO CHECK FIRST ARG.
*
{SRPD1{JSR{GTSTG{{{GET FIRST ARGUMENT (STRING TO PAD)
{{ERR{180{RPAD{{FIRST ARGUMENT IS NOT STRING
{{BGE{R6{R8{EXIXR{RETURN 1ST ARG IF TOO LONG TO PAD
{{MOV{R9{R10{{ELSE MOVE PTR TO STRING TO PAD
*
* NOW WE ARE READY FOR THE PAD
*
* (XL) POINTER TO STRING TO PAD
* (WB) PAD CHARACTER
* (WC) LENGTH TO PAD STRING TO
*
{{MOV{R8{R6{{COPY LENGTH
{{JSR{ALOCS{{{ALLOCATE SCBLK FOR NEW STRING
{{MOV{R9{-(SP){{SAVE AS RESULT
{{MOV{4*SCLEN(R10){R6{{LOAD LENGTH OF ARGUMENT
{{SUB{R6{R8{{CALCULATE NUMBER OF PAD CHARACTERS
{{PSC{R9{{{POINT TO CHARS IN RESULT STRING
{{LCT{R8{R8{{SET COUNTER FOR PAD LOOP
*
* COPY ARGUMENT STRING
*
{{BZE{R6{SRPD2{{JUMP IF ARGUMENT IS NULL
{{PLC{R10{{{ELSE POINT TO ARGUMENT CHARS
{{MVC{{{{MOVE CHARACTERS TO RESULT STRING
*
* LOOP TO SUPPLY PAD CHARACTERS
*
{SRPD2{SCH{R7{(R9)+{{STORE PAD CHARACTER, BUMP PTR
{{BCT{R8{SRPD2{{LOOP TILL ALL PAD CHARS STORED
{{CSC{R9{{{COMPLETE CHARACTER STORING
{{BRN{EXITS{{{AND EXIT FOR NEXT WORD
*
* HERE IF 2ND ARG IS NEGATIVE OR LARGE
*
{SRPD3{ZER{R8{{{ZERO PAD COUNT
{{BRN{SRPD1{{{MERGE
{{EJC{{{{
*
* RTAB
*
{S$RTB{ENT{{{{ENTRY POINT
{{MOV{#P$RTB{R7{{SET PCODE FOR INTEGER ARG CASE
{{MOV{#P$RTD{R6{{SET PCODE FOR EXPRESSION ARG CASE
{{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE
{{ERR{181{RTAB{{ARGUMENT IS NOT INTEGER OR EXPRESSION
{{ERR{182{RTAB{{ARGUMENT IS NEGATIVE OR TOO LARGE
{{BRN{EXIXR{{{RETURN PATTERN NODE
{{EJC{{{{
*
* SET
*
{S$SET{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R$IO2{{SAVE THIRD ARG
{{MOV{(SP)+{R$IO1{{SAVE SECOND ARG
{{JSR{IOFCB{{{CALL FCBLK ROUTINE
{{ERR{291{SET{{FIRST ARGUMENT IS NOT A SUITABLE NAME
{{ERR{292{SET{{FIRST ARGUMENT IS NULL
{{MOV{R$IO1{R7{{LOAD SECOND ARG
{{MOV{R$IO2{R8{{LOAD THIRD ARG
{{JSR{SYSST{{{CALL SYSTEM SET ROUTINE
{{ERR{293{INAPPROPRIATE{{SECOND ARGUMENT TO SET
{{ERR{294{INAPPROPRIATE{{THIRD ARGUMENT TO SET
{{ERR{295{SET{{FILE DOES NOT EXIST
{{ERR{296{SET{{FILE DOES NOT PERMIT SETTING FILE POINTER
{{ERR{297{SET{{CAUSED NON-RECOVERABLE I/O ERROR
{{BRN{EXNUL{{{OTHERWISEW RETURN NULL
{{EJC{{{{
*
* TAB
*
{S$TAB{ENT{{{{ENTRY POINT
{{MOV{#P$TAB{R7{{SET PCODE FOR INTEGER ARG CASE
{{MOV{#P$TBD{R6{{SET PCODE FOR EXPRESSION ARG CASE
{{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE
{{ERR{183{TAB{{ARGUMENT IS NOT INTEGER OR EXPRESSION
{{ERR{184{TAB{{ARGUMENT IS NEGATIVE OR TOO LARGE
{{BRN{EXIXR{{{RETURN PATTERN NODE
{{EJC{{{{
*
* RPOS
*
{S$RPS{ENT{{{{ENTRY POINT
{{MOV{#P$RPS{R7{{SET PCODE FOR INTEGER ARG CASE
{{MOV{#P$RPD{R6{{SET PCODE FOR EXPRESSION ARG CASE
{{JSR{PATIN{{{CALL COMMON ROUTINE TO BUILD NODE
{{ERR{185{RPOS{{ARGUMENT IS NOT INTEGER OR EXPRESSION
{{ERR{186{RPOS{{ARGUMENT IS NEGATIVE OR TOO LARGE
{{BRN{EXIXR{{{RETURN PATTERN NODE
{{EJC{{{{
*
* RSORT
*
{S$RSR{ENT{{{{ENTRY POINT
{{MNZ{R6{{{MARK AS RSORT
{{JSR{SORTA{{{CALL SORT ROUTINE
{{BRN{EXSID{{{RETURN, SETTING IDVAL
{{EJC{{{{
*
* SETEXIT
*
{S$STX{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{MOV{STXVR{R6{{LOAD OLD VRBLK POINTER
{{ZER{R10{{{LOAD ZERO IN CASE NULL ARG
{{BEQ{R9{#NULLS{SSTX1{JUMP IF NULL ARGUMENT (RESET CALL)
{{JSR{GTNVR{{{ELSE GET SPECIFIED VRBLK
{{PPM{SSTX2{{{JUMP IF NOT NATURAL VARIABLE
{{MOV{4*VRLBL(R9){R10{{ELSE LOAD LABEL
{{BEQ{R10{#STNDL{SSTX2{JUMP IF LABEL IS NOT DEFINED
{{BNE{(R10){#B$TRT{SSTX1{JUMP IF NOT TRAPPED
{{MOV{4*TRLBL(R10){R10{{ELSE LOAD PTR TO REAL LABEL CODE
*
* HERE TO SET/RESET SETEXIT TRAP
*
{SSTX1{MOV{R9{STXVR{{STORE NEW VRBLK POINTER (OR NULL)
{{MOV{R10{R$SXC{{STORE NEW CODE PTR (OR ZERO)
{{BEQ{R6{#NULLS{EXNUL{RETURN NULL IF NULL RESULT
{{MOV{R6{R9{{ELSE COPY VRBLK POINTER
{{BRN{EXVNM{{{AND RETURN BUILDING NMBLK
*
* HERE IF BAD ARGUMENT
*
{SSTX2{ERB{187{SETEXIT{{ARGUMENT IS NOT LABEL NAME OR NULL
{{EJC{{{{
*
* SORT
*
{S$SRT{ENT{{{{ENTRY POINT
{{ZER{R6{{{MARK AS SORT
{{JSR{SORTA{{{CALL SORT ROUTINE
{{BRN{EXSID{{{RETURN, SETTING IDVAL
{{EJC{{{{
*
* SPAN
*
{S$SPN{ENT{{{{ENTRY POINT
{{MOV{#P$SPS{R7{{SET PCODE FOR SINGLE CHAR ARG
{{MOV{#P$SPN{R10{{SET PCODE FOR MULTI-CHAR ARG
{{MOV{#P$SPD{R8{{SET PCODE FOR EXPRESSION ARG
{{JSR{PATST{{{CALL COMMON ROUTINE TO BUILD NODE
{{ERR{188{SPAN{{ARGUMENT IS NOT STRING OR EXPRESSION
{{BRN{EXIXR{{{JUMP FOR NEXT CODE WORD
{{EJC{{{{
*
* SIZE
*
{S$SI${ENT{{{{ENTRY POINT
{{MOV{(SP){R9{{LOAD ARGUMENT
{{BNE{(R9){#B$BCT{SSI$1{BRANCH IF NOT BUFFER
{{ICA{SP{{{ELSE POP ARGUMENT
{{MTI{4*BCLEN(R9){{{LOAD DEFINED LENGTH
{{BRN{EXINT{{{EXIT WITH INTEGER
*
* HERE IF NOT BUFFER
*
{SSI$1{JSR{GTSTG{{{LOAD STRING ARGUMENT
{{ERR{189{SIZE{{ARGUMENT IS NOT STRING
{{MTI{R6{{{LOAD LENGTH AS INTEGER
{{BRN{EXINT{{{EXIT WITH INTEGER RESULT
{{EJC{{{{
*
* STOPTR
*
{S$STT{ENT{{{{ENTRY POINT
{{ZER{R10{{{INDICATE STOPTR CASE
{{JSR{TRACE{{{CALL TRACE PROCEDURE
{{ERR{190{STOPTR{{FIRST ARGUMENT IS NOT APPROPRIATE NAME
{{ERR{191{STOPTR{{SECOND ARGUMENT IS NOT TRACE TYPE
{{BRN{EXNUL{{{RETURN NULL
{{EJC{{{{
*
* SUBSTR
*
{S$SUB{ENT{{{{ENTRY POINT
{{JSR{GTSMI{{{LOAD THIRD ARGUMENT
{{ERR{192{SUBSTR{{THIRD ARGUMENT IS NOT INTEGER
{{PPM{EXFAL{{{JUMP IF NEGATIVE OR TOO LARGE
{{MOV{R9{SBSSV{{SAVE THIRD ARGUMENT
{{JSR{GTSMI{{{LOAD SECOND ARGUMENT
{{ERR{193{SUBSTR{{SECOND ARGUMENT IS NOT INTEGER
{{PPM{EXFAL{{{JUMP IF OUT OF RANGE
{{MOV{R9{R7{{SAVE SECOND ARGUMENT
{{BZE{R7{EXFAL{{JUMP IF SECOND ARGUMENT ZERO
{{DCV{R7{{{ELSE DECREMENT FOR ONES ORIGIN
{{MOV{(SP){R10{{GET FIRST ARG PTR
{{BNE{(R10){#B$BCT{SSUBA{BRANCH IF NOT BUFFER
{{MOV{4*BCBUF(R10){R9{{GET BFBLK PTR
{{MOV{4*BCLEN(R10){R6{{GET LENGTH
{{BRN{SSUBB{{{MERGE
*
* HERE IF NOT BUFFER TO GET STRING
*
{SSUBA{JSR{GTSTG{{{LOAD FIRST ARGUMENT
{{ERR{194{SUBSTR{{FIRST ARGUMENT IS NOT STRING
*
* MERGE WITH BFBLK OR SCBLK PTR IN XR. WA HAS LENGTH
*
{SSUBB{MOV{SBSSV{R8{{RELOAD THIRD ARGUMENT
{{BNZ{R8{SSUB1{{SKIP IF THIRD ARG GIVEN
{{MOV{R6{R8{{ELSE GET STRING LENGTH
{{BGT{R7{R8{EXFAL{FAIL IF IMPROPER
{{SUB{R7{R8{{REDUCE BY OFFSET TO START
*
* MERGE
*
{SSUB1{MOV{R6{R10{{SAVE STRING LENGTH
{{MOV{R8{R6{{SET LENGTH OF SUBSTRING
{{ADD{R7{R8{{ADD 2ND ARG TO 3RD ARG
{{BGT{R8{R10{EXFAL{JUMP IF IMPROPER SUBSTRING
{{MOV{R9{R10{{COPY POINTER TO FIRST ARG
{{JSR{SBSTR{{{BUILD SUBSTRING
{{BRN{EXIXR{{{AND JUMP FOR NEXT CODE WORD
{{EJC{{{{
*
* TABLE
*
{S$TBL{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R10{{GET INITIAL LOOKUP VALUE
{{ICA{SP{{{POP SECOND ARGUMENT
{{JSR{GTSMI{{{LOAD ARGUMENT
{{ERR{195{TABLE{{ARGUMENT IS NOT INTEGER
{{ERR{196{TABLE{{ARGUMENT IS OUT OF RANGE
{{BNZ{R8{STBL1{{JUMP IF NON-ZERO
{{MOV{#TBNBK{R8{{ELSE SUPPLY DEFAULT VALUE
*
* MERGE HERE WITH NUMBER OF HEADERS IN WA
*
{STBL1{MOV{R8{R6{{COPY NUMBER OF HEADERS
{{ADD{#TBSI${R6{{ADJUST FOR STANDARD FIELDS
{{WTB{R6{{{CONVERT LENGTH TO BYTES
{{JSR{ALLOC{{{ALLOCATE SPACE FOR TBBLK
{{MOV{R9{R7{{COPY POINTER TO TBBLK
{{MOV{#B$TBT{(R9)+{{STORE TYPE WORD
{{ZER{(R9)+{{{ZERO ID FOR THE MOMENT
{{MOV{R6{(R9)+{{STORE LENGTH (TBLEN)
{{MOV{R10{(R9)+{{STORE INITIAL LOOKUP VALUE
{{LCT{R8{R8{{SET LOOP COUNTER (NUM HEADERS)
*
* LOOP TO INITIALIZE ALL BUCKET POINTERS
*
{STBL2{MOV{R7{(R9)+{{STORE TBBLK PTR IN BUCKET HEADER
{{BCT{R8{STBL2{{LOOP TILL ALL STORED
{{MOV{R7{R9{{RECALL POINTER TO TBBLK
{{BRN{EXSID{{{EXIT SETTING IDVAL
{{EJC{{{{
*
* TIME
*
{S$TIM{ENT{{{{ENTRY POINT
{{JSR{SYSTM{{{GET TIMER VALUE
{{SBI{TIMSX{{{SUBTRACT STARTING TIME
{{BRN{EXINT{{{EXIT WITH INTEGER VALUE
{{EJC{{{{
*
* TRACE
*
{S$TRA{ENT{{{{ENTRY POINT
{{BEQ{4*3(SP){#NULLS{STR03{JUMP IF FIRST ARGUMENT IS NULL
{{MOV{(SP)+{R9{{LOAD FOURTH ARGUMENT
{{ZER{R10{{{TENTATIVELY SET ZERO POINTER
{{BEQ{R9{#NULLS{STR02{JUMP IF 4TH ARGUMENT IS NULL
{{JSR{GTNVR{{{ELSE POINT TO VRBLK
{{PPM{STR01{{{JUMP IF NOT VARIABLE NAME
{{MOV{4*VRFNC(R9){R10{{ELSE LOAD FUNCTION POINTER
{{BNE{R10{#STNDF{STR02{JUMP IF FUNCTION IS DEFINED
*
* HERE FOR BAD FOURTH ARGUMENT
*
{STR01{ERB{197{TRACE{{FOURTH ARG IS NOT FUNCTION NAME OR NULL
*
* HERE WITH FUNCTION POINTER IN XL
*
{STR02{MOV{(SP)+{R9{{LOAD THIRD ARGUMENT (TAG)
{{ZER{R7{{{SET ZERO AS TRTYP VALUE FOR NOW
{{JSR{TRBLD{{{BUILD TRBLK FOR TRACE CALL
{{MOV{R9{R10{{MOVE TRBLK POINTER FOR TRACE
{{JSR{TRACE{{{CALL TRACE PROCEDURE
{{ERR{198{TRACE{{FIRST ARGUMENT IS NOT APPROPRIATE NAME
{{ERR{199{TRACE{{SECOND ARGUMENT IS NOT TRACE TYPE
{{BRN{EXNUL{{{RETURN NULL
*
* HERE TO CALL SYSTEM TRACE TOGGLE ROUTINE
*
{STR03{JSR{SYSTT{{{CALL IT
{{ADD{#4*NUM04{SP{{POP TRACE ARGUMENTS
{{BRN{EXNUL{{{RETURN
{{EJC{{{{
*
* TRIM
*
{S$TRM{ENT{{{{ENTRY POINT
{{JSR{GTSTG{{{LOAD ARGUMENT AS STRING
{{ERR{200{TRIM{{ARGUMENT IS NOT STRING
{{BZE{R6{EXNUL{{RETURN NULL IF ARGUMENT IS NULL
{{MOV{R9{R10{{COPY STRING POINTER
{{CTB{R6{SCHAR{{GET BLOCK LENGTH
{{JSR{ALLOC{{{ALLOCATE COPY SAME SIZE
{{MOV{R9{R7{{SAVE POINTER TO COPY
{{MVW{{{{COPY OLD STRING BLOCK TO NEW
{{MOV{R7{R9{{RESTORE PTR TO NEW BLOCK
{{JSR{TRIMR{{{TRIM BLANKS (WB IS NON-ZERO)
{{BRN{EXIXR{{{EXIT WITH RESULT IN XR
{{EJC{{{{
*
* UNLOAD
*
{S$UNL{ENT{{{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{JSR{GTNVR{{{POINT TO VRBLK
{{ERR{201{UNLOAD{{ARGUMENT IS NOT NATURAL VARIABLE NAME
{{MOV{#STNDF{R10{{GET PTR TO UNDEFINED FUNCTION
{{JSR{DFFNC{{{UNDEFINE NAMED FUNCTION
{{BRN{EXNUL{{{RETURN NULL AS RESULT
{{TTL{S{{{P I T B O L -- UTILITY PROCEDURES
*
* THE FOLLOWING SECTION CONTAINS PROCEDURES WHICH ARE
* USED FOR VARIOUS PURPOSES THROUGHOUT THE SYSTEM.
*
* EACH PROCEDURE IS PRECEDED BY A DESCRIPTION OF THE
* CALLING SEQUENCE. USUALLY THE ARGUMENTS ARE IN REGISTERS
* BUT ARGUMENTS CAN ALSO OCCUR ON THE STACK AND AS
* PARAMETERS ASSEMBLED AFTER THE JSR INSTRUCTION.
*
* THE FOLLOWING CONSIDERATIONS APPLY TO THESE DESCRIPTIONS.
*
* 1) THE STACK POINTER (XS) IS NOT CHANGED UNLESS THE
* CHANGE IS EXPLICITLY DOCUMENTED IN THE CALL.
*
* 2) REGISTERS WHOSE ENTRY VALUES ARE NOT MENTIONED
* MAY CONTAIN ANY VALUE EXCEPT THAT XL,XR MAY ONLY
* CONTAIN PROPER (COLLECTABLE) POINTER VALUES.
* THIS CONDITION ON XR MEANS THAT THE CALLED ROUTINE
* MAY IF IT CHOOSES PRESERVE XR BY STACKING.
*
* 3) REGISTERS NOT MENTIONED ON EXIT CONTAIN THE SAME
* VALUES AS THEY DID ON ENTRY EXCEPT THAT VALUES IN
* XR,XL MAY HAVE BEEN RELOCATED BY THE COLLECTOR.
*
* 4) REGISTERS WHICH ARE DESTROYED ON EXIT MAY CONTAIN
* ANY VALUE EXCEPT THAT VALUES IN XL,XR ARE PROPER
* (COLLECTABLE) POINTERS.
*
* 5) THE CODE POINTER REGISTER POINTS TO THE CURRENT
* CODE LOCATION ON ENTRY AND IS UNCHANGED ON EXIT.
*
* IN THE ABOVE DESCRIPTION, A COLLECTABLE POINTER IS ONE
* WHICH EITHER POINTS OUTSIDE THE DYNAMIC REGION OR
* POINTS TO THE START OF A BLOCK IN THE DYNAMIC REGION.
*
* IN THOSE CASES WHERE THE CALLING SEQUENCE CONTAINS
* PARAMETERS WHICH ARE USED AS ALTERNATE RETURN POINTS,
* THESE PARAMETERS MAY BE REPLACED BY ERROR CODES
* ASSEMBLED WITH THE ERR INSTRUCTION. THIS WILL RESULT
* IN THE POSTING OF THE ERROR IF THE RETURN IS TAKEN.
*
* THE PROCEDURES ALL HAVE NAMES CONSISTING OF FIVE LETTERS
* AND ARE IN ALPHABETICAL ORDER BY THEIR NAMES.
{{EJC{{{{
*
* ACESS - ACCESS VARIABLE VALUE WITH TRACE/INPUT CHECKS
*
* ACESS LOADS THE VALUE OF A VARIABLE. TRACE AND INPUT
* ASSOCIATIONS ARE TESTED FOR AND EXECUTED AS REQUIRED.
* ACESS ALSO HANDLES THE SPECIAL CASES OF PSEUDO-VARIABLES.
*
* (XL) VARIABLE NAME BASE
* (WA) VARIABLE NAME OFFSET
* JSR ACESS CALL TO ACCESS VALUE
* PPM LOC TRANSFER LOC IF ACCESS FAILURE
* (XR) VARIABLE VALUE
* (WA,WB,WC) DESTROYED
* (XL,RA) DESTROYED
*
* FAILURE CAN OCCUR IF AN INPUT ASSOCIATION CAUSES AN END
* OF FILE CONDITION OR IF THE EVALUATION OF AN EXPRESSION
* ASSOCIATED WITH AN EXPRESSION VARIABLE FAILS.
*
{ACESS{PRC{R{1{{ENTRY POINT (RECURSIVE)
{{MOV{R10{R9{{COPY NAME BASE
{{ADD{R6{R9{{POINT TO VARIABLE LOCATION
{{MOV{(R9){R9{{LOAD VARIABLE VALUE
*
* LOOP HERE TO CHECK FOR SUCCESSIVE TRBLKS
*
{ACS02{BNE{(R9){#B$TRT{ACS18{JUMP IF NOT TRAPPED
*
* HERE IF TRAPPED
*
{{BEQ{R9{#TRBKV{ACS12{JUMP IF KEYWORD VARIABLE
{{BNE{R9{#TRBEV{ACS05{JUMP IF NOT EXPRESSION VARIABLE
*
* HERE FOR EXPRESSION VARIABLE, EVALUATE VARIABLE
*
{{MOV{4*EVEXP(R10){R9{{LOAD EXPRESSION POINTER
{{ZER{R7{{{EVALUATE BY VALUE
{{JSR{EVALX{{{EVALUATE EXPRESSION
{{PPM{ACS04{{{JUMP IF EVALUATION FAILURE
{{BRN{ACS02{{{CHECK VALUE FOR MORE TRBLKS
{{EJC{{{{
*
* ACESS (CONTINUED)
*
* HERE ON READING END OF FILE
*
{ACS03{ADD{#4*NUM03{SP{{POP TRBLK PTR, NAME BASE AND OFFSET
{{MOV{R9{DNAMP{{POP UNUSED SCBLK
*
* MERGE HERE WHEN EVALUATION OF EXPRESSION FAILS
*
{ACS04{EXI{1{{{TAKE ALTERNATE (FAILURE) RETURN
*
* HERE IF NOT KEYWORD OR EXPRESSION VARIABLE
*
{ACS05{MOV{4*TRTYP(R9){R7{{LOAD TRAP TYPE CODE
{{BNZ{R7{ACS10{{JUMP IF NOT INPUT ASSOCIATION
{{BZE{KVINP{ACS09{{IGNORE INPUT ASSOC IF INPUT IS OFF
*
* HERE FOR INPUT ASSOCIATION
*
{{MOV{R10{-(SP){{STACK NAME BASE
{{MOV{R6{-(SP){{STACK NAME OFFSET
{{MOV{R9{-(SP){{STACK TRBLK POINTER
{{MOV{4*TRFPT(R9){R10{{GET FILE CTRL BLK PTR OR ZERO
{{BNZ{R10{ACS06{{JUMP IF NOT STANDARD INPUT FILE
{{BEQ{4*TRTER(R9){#V$TER{ACS21{JUMP IF TERMINAL
*
* HERE TO READ FROM STANDARD INPUT FILE
*
{{MOV{CSWIN{R6{{LENGTH FOR READ BUFFER
{{JSR{ALOCS{{{BUILD STRING OF APPROPRIATE LENGTH
{{JSR{SYSRD{{{READ NEXT STANDARD INPUT IMAGE
{{PPM{ACS03{{{JUMP TO FAIL EXIT IF END OF FILE
{{BRN{ACS07{{{ELSE MERGE WITH OTHER FILE CASE
*
* HERE FOR INPUT FROM OTHER THAN STANDARD INPUT FILE
*
{ACS06{MOV{R10{R6{{FCBLK PTR
{{JSR{SYSIL{{{GET INPUT RECORD MAX LENGTH (TO WA)
{{JSR{ALOCS{{{ALLOCATE STRING OF CORRECT SIZE
{{MOV{R10{R6{{FCBLK PTR
{{JSR{SYSIN{{{CALL SYSTEM INPUT ROUTINE
{{PPM{ACS03{{{JUMP TO FAIL EXIT IF END OF FILE
{{PPM{ACS22{{{ERROR
{{PPM{ACS23{{{ERROR
{{EJC{{{{
*
* ACESS (CONTINUED)
*
* MERGE HERE AFTER OBTAINING INPUT RECORD
*
{ACS07{MOV{KVTRM{R7{{LOAD TRIM INDICATOR
{{JSR{TRIMR{{{TRIM RECORD AS REQUIRED
{{MOV{R9{R7{{COPY RESULT POINTER
{{MOV{(SP){R9{{RELOAD POINTER TO TRBLK
*
* LOOP TO CHASE TO END OF TRBLK CHAIN AND STORE VALUE
*
{ACS08{MOV{R9{R10{{SAVE POINTER TO THIS TRBLK
{{MOV{4*TRNXT(R9){R9{{LOAD FORWARD POINTER
{{BEQ{(R9){#B$TRT{ACS08{LOOP IF THIS IS ANOTHER TRBLK
{{MOV{R7{4*TRNXT(R10){{ELSE STORE RESULT AT END OF CHAIN
{{MOV{(SP)+{R9{{RESTORE INITIAL TRBLK POINTER
{{MOV{(SP)+{R6{{RESTORE NAME OFFSET
{{MOV{(SP)+{R10{{RESTORE NAME BASE POINTER
*
* COME HERE TO MOVE TO NEXT TRBLK
*
{ACS09{MOV{4*TRNXT(R9){R9{{LOAD FORWARD PTR TO NEXT VALUE
{{BRN{ACS02{{{BACK TO CHECK IF TRAPPED
*
* HERE TO CHECK FOR ACCESS TRACE TRBLK
*
{ACS10{BNE{R7{#TRTAC{ACS09{LOOP BACK IF NOT ACCESS TRACE
{{BZE{KVTRA{ACS09{{IGNORE ACCESS TRACE IF TRACE OFF
{{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT
{{BZE{4*TRFNC(R9){ACS11{{JUMP IF PRINT TRACE
{{EJC{{{{
*
* ACESS (CONTINUED)
*
* HERE FOR FULL FUNCTION TRACE
*
{{JSR{TRXEQ{{{CALL ROUTINE TO EXECUTE TRACE
{{BRN{ACS09{{{JUMP FOR NEXT TRBLK
*
* HERE FOR CASE OF PRINT TRACE
*
{ACS11{JSR{PRTSN{{{PRINT STATEMENT NUMBER
{{JSR{PRTNV{{{PRINT NAME = VALUE
{{BRN{ACS09{{{JUMP BACK FOR NEXT TRBLK
*
* HERE FOR KEYWORD VARIABLE
*
{ACS12{MOV{4*KVNUM(R10){R9{{LOAD KEYWORD NUMBER
{{BGE{R9{#K$V$${ACS14{JUMP IF NOT ONE WORD VALUE
{{MTI{L^KVABE(R9){{{ELSE LOAD VALUE AS INTEGER
*
* COMMON EXIT WITH KEYWORD VALUE AS INTEGER IN (IA)
*
{ACS13{JSR{ICBLD{{{BUILD ICBLK
{{BRN{ACS18{{{JUMP TO EXIT
*
* HERE IF NOT ONE WORD KEYWORD VALUE
*
{ACS14{BGE{R9{#K$S$${ACS15{JUMP IF SPECIAL CASE
{{SUB{#K$V$${R9{{ELSE GET OFFSET
{{ADD{#NDABO{R9{{POINT TO PATTERN VALUE
{{BRN{ACS18{{{JUMP TO EXIT
*
* HERE IF SPECIAL KEYWORD CASE
*
{ACS15{MOV{KVRTN{R10{{LOAD RTNTYPE IN CASE
{{LDI{KVSTL{{{LOAD STLIMIT IN CASE
{{SUB{#K$S$${R9{{GET CASE NUMBER
{{BSW{R9{5{{SWITCH ON KEYWORD NUMBER
{{IFF{K$$AL{ACS16{{JUMP IF ALPHABET
{{IFF{K$$RT{ACS17{{RTNTYPE
{{IFF{K$$SC{ACS19{{STCOUNT
{{IFF{K$$ET{ACS20{{ERRTEXT
{{IFF{K$$SL{ACS13{{STLIMIT
{{ESW{{{{END SWITCH ON KEYWORD NUMBER
{{EJC{{{{
*
* ACESS (CONTINUED)
*
* ALPHABET
*
{ACS16{MOV{KVALP{R10{{LOAD POINTER TO ALPHABET STRING
*
* RTNTYPE MERGES HERE
*
{ACS17{MOV{R10{R9{{COPY STRING PTR TO PROPER REG
*
* COMMON RETURN POINT
*
{ACS18{EXI{{{{RETURN TO ACESS CALLER
*
* HERE FOR STCOUNT (IA HAS STLIMIT)
*
{ACS19{SBI{KVSTC{{{STCOUNT = LIMIT - LEFT
{{BRN{ACS13{{{MERGE BACK WITH INTEGER RESULT
*
* ERRTEXT
*
{ACS20{MOV{R$ETX{R9{{GET ERRTEXT STRING
{{BRN{ACS18{{{MERGE WITH RESULT
*
* HERE TO READ A RECORD FROM TERMINAL
*
{ACS21{MOV{#RILEN{R6{{BUFFER LENGTH
{{JSR{ALOCS{{{ALLOCATE BUFFER
{{JSR{SYSRI{{{READ RECORD
{{PPM{ACS03{{{ENDFILE
{{BRN{ACS07{{{MERGE WITH RECORD READ
*
* ERROR RETURNS
*
{ACS22{MOV{R9{DNAMP{{POP UNUSED SCBLK
{{ERB{202{INPUT{{FROM FILE CAUSED NON-RECOVERABLE ERROR
*
{ACS23{MOV{R9{DNAMP{{POP UNUSED SCBLK
{{ERB{203{INPUT{{FILE RECORD HAS INCORRECT FORMAT
{{ENP{{{{END PROCEDURE ACESS
{{EJC{{{{
*
* ACOMP -- COMPARE TWO ARITHMETIC VALUES
*
* 1(XS) FIRST ARGUMENT
* 0(XS) SECOND ARGUMENT
* JSR ACOMP CALL TO COMPARE VALUES
* PPM LOC TRANSFER LOC IF ARG1 IS NON-NUMERIC
* PPM LOC TRANSFER LOC IF ARG2 IS NON-NUMERIC
* PPM LOC TRANSFER LOC FOR ARG1 LT ARG2
* PPM LOC TRANSFER LOC FOR ARG1 EQ ARG2
* PPM LOC TRANSFER LOC FOR ARG1 GT ARG2
* (NORMAL RETURN IS NEVER GIVEN)
* (WA,WB,WC,IA,RA) DESTROYED
* (XL,XR) DESTROYED
*
{ACOMP{PRC{N{5{{ENTRY POINT
{{JSR{ARITH{{{LOAD ARITHMETIC OPERANDS
{{PPM{ACMP7{{{JUMP IF FIRST ARG NON-NUMERIC
{{PPM{ACMP8{{{JUMP IF SECOND ARG NON-NUMERIC
{{PPM{ACMP4{{{JUMP IF REAL ARGUMENTS
*
* HERE FOR INTEGER ARGUMENTS
*
{{SBI{4*ICVAL(R10){{{SUBTRACT TO COMPARE
{{IOV{ACMP3{{{JUMP IF OVERFLOW
{{ILT{ACMP5{{{ELSE JUMP IF ARG1 LT ARG2
{{IEQ{ACMP2{{{JUMP IF ARG1 EQ ARG2
*
* HERE IF ARG1 GT ARG2
*
{ACMP1{EXI{5{{{TAKE GT EXIT
*
* HERE IF ARG1 EQ ARG2
*
{ACMP2{EXI{4{{{TAKE EQ EXIT
{{EJC{{{{
*
* ACOMP (CONTINUED)
*
* HERE FOR INTEGER OVERFLOW ON SUBTRACT
*
{ACMP3{LDI{4*ICVAL(R10){{{LOAD SECOND ARGUMENT
{{ILT{ACMP1{{{GT IF NEGATIVE
{{BRN{ACMP5{{{ELSE LT
*
* HERE FOR REAL OPERANDS
*
{ACMP4{SBR{4*RCVAL(R10){{{SUBTRACT TO COMPARE
{{ROV{ACMP6{{{JUMP IF OVERFLOW
{{RGT{ACMP1{{{ELSE JUMP IF ARG1 GT
{{REQ{ACMP2{{{JUMP IF ARG1 EQ ARG2
*
* HERE IF ARG1 LT ARG2
*
{ACMP5{EXI{3{{{TAKE LT EXIT
*
* HERE IF OVERFLOW ON REAL SUBTRACTION
*
{ACMP6{LDR{4*RCVAL(R10){{{RELOAD ARG2
{{RLT{ACMP1{{{GT IF NEGATIVE
{{BRN{ACMP5{{{ELSE LT
*
* HERE IF ARG1 NON-NUMERIC
*
{ACMP7{EXI{1{{{TAKE ERROR EXIT
*
* HERE IF ARG2 NON-NUMERIC
*
{ACMP8{EXI{2{{{TAKE ERROR EXIT
{{ENP{{{{END PROCEDURE ACOMP
{{EJC{{{{
*
* ALLOC ALLOCATE BLOCK OF DYNAMIC STORAGE
*
* (WA) LENGTH REQUIRED IN BYTES
* JSR ALLOC CALL TO ALLOCATE BLOCK
* (XR) POINTER TO ALLOCATED BLOCK
*
* A POSSIBLE ALTERNATIVE TO AOV .. AND FOLLOWING STMT IS -
* MOV DNAME,XR . SUB WA,XR . BLO XR,DNAMP,ALOC2 .
* MOV DNAMP,XR . ADD WA,XR
*
{ALLOC{PRC{E{0{{ENTRY POINT
*
* COMMON EXIT POINT
*
{ALOC1{MOV{DNAMP{R9{{POINT TO NEXT AVAILABLE LOC
{{AOV{R6{R9{ALOC2{POINT PAST ALLOCATED BLOCK
{{BGT{R9{DNAME{ALOC2{JUMP IF NOT ENOUGH ROOM
{{MOV{R9{DNAMP{{STORE NEW POINTER
{{SUB{R6{R9{{POINT BACK TO START OF ALLOCATED BK
{{EXI{{{{RETURN TO CALLER
*
* HERE IF INSUFFICIENT ROOM, TRY A GARBAGE COLLECTION
*
{ALOC2{MOV{R7{ALLSV{{SAVE WB
{{ZER{R7{{{SET NO UPWARD MOVE FOR GBCOL
{{JSR{GBCOL{{{GARBAGE COLLECT
*
* SEE IF ROOM AFTER GBCOL OR SYSMM CALL
*
{ALOC3{MOV{DNAMP{R9{{POINT TO FIRST AVAILABLE LOC
{{AOV{R6{R9{ALC3A{POINT PAST NEW BLOCK
{{BLO{R9{DNAME{ALOC4{JUMP IF THERE IS ROOM NOW
*
* FAILED AGAIN, SEE IF WE CAN GET MORE CORE
*
{ALC3A{JSR{SYSMM{{{TRY TO GET MORE MEMORY
{{WTB{R9{{{CONVERT TO BAUS (SGD05)
{{ADD{R9{DNAME{{BUMP PTR BY AMOUNT OBTAINED
{{BNZ{R9{ALOC3{{JUMP IF GOT MORE CORE
{{ADD{RSMEM{DNAME{{GET THE RESERVE MEMORY
{{ZER{RSMEM{{{ONLY PERMISSIBLE ONCE
{{ICV{ERRFT{{{FATAL ERROR
{{ERB{204{MEMORY{{OVERFLOW
{{EJC{{{{
*
* HERE AFTER SUCCESSFUL GARBAGE COLLECTION
*
{ALOC4{STI{ALLIA{{{SAVE IA
{{MOV{DNAME{R7{{GET DYNAMIC END ADRS
{{SUB{DNAMP{R7{{COMPUTE FREE STORE
{{BTW{R7{{{CONVERT BYTES TO WORDS
{{MTI{R7{{{PUT FREE STORE IN IA
{{MLI{ALFSF{{{MULTIPLY BY FREE STORE FACTOR
{{IOV{ALOC5{{{JUMP IF OVERFLOWED
{{MOV{DNAME{R7{{DYNAMIC END ADRS
{{SUB{DNAMB{R7{{COMPUTE TOTAL AMOUNT OF DYNAMIC
{{BTW{R7{{{CONVERT TO WORDS
{{MOV{R7{ALDYN{{STORE IT
{{SBI{ALDYN{{{SUBTRACT FROM SCALED UP FREE STORE
{{IGT{ALOC5{{{JUMP IF SUFFICIENT FREE STORE
{{JSR{SYSMM{{{TRY TO GET MORE STORE
{{WTB{R9{{{CONVERT TO BAUS (SGD05)
{{ADD{R9{DNAME{{ADJUST DYNAMIC END ADRS
*
* MERGE TO RESTORE IA AND WB
*
{ALOC5{LDI{ALLIA{{{RECOVER IA
{{MOV{ALLSV{R7{{RESTORE WB
{{BRN{ALOC1{{{JUMP BACK TO EXIT
{{ENP{{{{END PROCEDURE ALLOC
{{EJC{{{{
*
* ALOBF -- ALLOCATE BUFFER
*
* THIS ROUTINES ALLOCATES A NEW BUFFER. AS THE BFBLK
* AND BCBLK COME IN PAIRS, BOTH ARE ALLOCATED HERE,
* AND XR POINTS TO THE BCBLK ON RETURN. THE BFBLK
* AND BCBLK ARE SET TO THE NULL BUFFER, AND THE IDVAL
* IS ZERO ON RETURN.
*
* (WA) BUFFER SIZE IN CHARACTERS
* JSR ALOBF CALL TO CREATE BUFFER
* (XR) BCBLK PTR
* (WA,WB) DESTROYED
*
{ALOBF{PRC{E{0{{ENTRY POINT
{{MOV{R6{R7{{HANG ONTO ALLOCATION SIZE
{{CTB{R6{BFSI${{GET TOTAL BLOCK SIZE
{{BGE{R6{MXLEN{ALB01{CHECK FOR MAXLEN EXCEEDED
{{ADD{#4*BCSI${R6{{ADD IN ALLOCATION FOR BCBLK
{{JSR{ALLOC{{{ALLOCATE FRAME
{{MOV{#B$BCT{(R9){{SET TYPE
{{ZER{4*IDVAL(R9){{{NO ID YET
{{ZER{4*BCLEN(R9){{{NO DEFINED LENGTH
{{MOV{R10{R6{{SAVE XL
{{MOV{R9{R10{{COPY BCBLK PTR
{{ADD{#4*BCSI${R10{{BIAS PAST PARTIALLY BUILT BCBLK
{{MOV{#B$BFT{(R10){{SET BFBLK TYPE WORD
{{MOV{R7{4*BFALC(R10){{SET ALLOCATED SIZE
{{MOV{R10{4*BCBUF(R9){{SET POINTER IN BCBLK
{{ZER{4*BFCHR(R10){{{CLEAR FIRST WORD (NULL PAD)
{{MOV{R6{R10{{RESTORE ENTRY XL
{{EXI{{{{RETURN TO CALLER
*
* HERE FOR MXLEN EXCEEDED
*
{ALB01{ERB{274{REQUESTED{{BUFFER ALLOCATION EXCEEDS MXLEN
{{ENP{{{{END PROCEDURE ALOBF
{{EJC{{{{
*
* ALOCS -- ALLOCATE STRING BLOCK
*
* ALOCS IS USED TO BUILD A FRAME FOR A STRING BLOCK INTO
* WHICH THE ACTUAL CHARACTERS ARE PLACED BY THE CALLER.
* ALL STRINGS ARE CREATED WITH A CALL TO ALOCS (THE
* EXCEPTIONS OCCUR IN TRIMR AND S$RPL PROCEDURES).
*
* (WA) LENGTH OF STRING TO BE ALLOCATED
* JSR ALOCS CALL TO ALLOCATE SCBLK
* (XR) POINTER TO RESULTING SCBLK
* (WA) DESTROYED
* (WC) CHARACTER COUNT (ENTRY VALUE OF WA)
*
* THE RESULTING SCBLK HAS THE TYPE WORD AND THE LENGTH
* FILLED IN AND THE LAST WORD IS CLEARED TO ZERO CHARACTERS
* TO ENSURE CORRECT RIGHT PADDING OF THE FINAL WORD.
*
{ALOCS{PRC{E{0{{ENTRY POINT
{{BGT{R6{KVMXL{ALCS2{JUMP IF LENGTH EXCEEEDS MAXLENGTH
{{MOV{R6{R8{{ELSE COPY LENGTH
{{CTB{R6{SCSI${{COMPUTE LENGTH OF SCBLK IN BYTES
{{MOV{DNAMP{R9{{POINT TO NEXT AVAILABLE LOCATION
{{AOV{R6{R9{ALCS0{POINT PAST BLOCK
{{BLO{R9{DNAME{ALCS1{JUMP IF THERE IS ROOM
*
* INSUFFICIENT MEMORY
*
{ALCS0{ZER{R9{{{ELSE CLEAR GARBAGE XR VALUE
{{JSR{ALLOC{{{AND USE STANDARD ALLOCATOR
{{ADD{R6{R9{{POINT PAST END OF BLOCK TO MERGE
*
* MERGE HERE WITH XR POINTING BEYOND NEW BLOCK
*
{ALCS1{MOV{R9{DNAMP{{SET UPDATED STORAGE POINTER
{{ZER{-(R9){{{STORE ZERO CHARS IN LAST WORD
{{DCA{R6{{{DECREMENT LENGTH
{{SUB{R6{R9{{POINT BACK TO START OF BLOCK
{{MOV{#B$SCL{(R9){{SET TYPE WORD
{{MOV{R8{4*SCLEN(R9){{STORE LENGTH IN CHARS
{{EXI{{{{RETURN TO ALOCS CALLER
*
* COME HERE IF STRING IS TOO LONG
*
{ALCS2{ERB{205{STRING{{LENGTH EXCEEDS VALUE OF MAXLNGTH KEYWORD
{{ENP{{{{END PROCEDURE ALOCS
{{EJC{{{{
*
* ALOST -- ALLOCATE SPACE IN STATIC REGION
*
* (WA) LENGTH REQUIRED IN BYTES
* JSR ALOST CALL TO ALLOCATE SPACE
* (XR) POINTER TO ALLOCATED BLOCK
* (WB) DESTROYED
*
* NOTE THAT THE CODING ENSURES THAT THE RESULTING VALUE
* OF STATE IS ALWAYS LESS THAN DNAMB. THIS FACT IS USED
* IN TESTING A VARIABLE NAME FOR BEING IN THE STATIC REGION
*
{ALOST{PRC{E{0{{ENTRY POINT
*
* MERGE BACK HERE AFTER ALLOCATING NEW CHUNK
*
{ALST1{MOV{STATE{R9{{POINT TO CURRENT END OF AREA
{{AOV{R6{R9{ALST2{POINT BEYOND PROPOSED BLOCK
{{BGE{R9{DNAMB{ALST2{JUMP IF OVERLAP WITH DYNAMIC AREA
{{MOV{R9{STATE{{ELSE STORE NEW POINTER
{{SUB{R6{R9{{POINT BACK TO START OF BLOCK
{{EXI{{{{RETURN TO ALOST CALLER
*
* HERE IF NO ROOM, PREPARE TO MOVE DYNAMIC STORAGE UP
*
{ALST2{MOV{R6{ALSTA{{SAVE WA
{{BGE{R6{#4*E$STS{ALST3{SKIP IF REQUESTED CHUNK IS LARGE
{{MOV{#4*E$STS{R6{{ELSE SET TO GET LARGE ENOUGH CHUNK
*
* HERE WITH AMOUNT TO MOVE UP IN WA
*
{ALST3{JSR{ALLOC{{{ALLOCATE BLOCK TO ENSURE ROOM
{{MOV{R9{DNAMP{{AND DELETE IT
{{MOV{R6{R7{{COPY MOVE UP AMOUNT
{{JSR{GBCOL{{{CALL GBCOL TO MOVE DYNAMIC AREA UP
{{MOV{ALSTA{R6{{RESTORE WA
{{BRN{ALST1{{{LOOP BACK TO TRY AGAIN
{{ENP{{{{END PROCEDURE ALOST
{{EJC{{{{
*
* APNDB -- APPEND STRING TO BUFFER
*
* THIS ROUTINE IS USED BY BUFFER HANDLING ROUTINES TO
* APPEND DATA TO AN EXISTING BFBLK.
*
* (XR) EXISTING BCBLK TO BE APPENDED
* (XL) CONVERTABLE TO STRING
* JSR APNDB CALL TO APPEND TO BUFFER
* PPM LOC THREAD IF (XL) CANT BE CONVERTED
* PPM LOC IF NOT ENOUGH ROOM
* (WA,WB) DESTROYED
*
* IF MORE CHARACTERS ARE SPECIFIED THAN CAN BE INSERTED,
* THEN NO ACTION IS TAKEN AND THE SECOND RETURN IS TAKEN.
*
{APNDB{PRC{E{2{{ENTRY POINT
{{MOV{4*BCLEN(R9){R6{{LOAD OFFSET TO INSERT
{{ZER{R7{{{REPLACE SECTION IS NULL
{{JSR{INSBF{{{CALL TO INSERT AT END
{{PPM{APN01{{{CONVERT ERROR
{{PPM{APN02{{{NO ROOM
{{EXI{{{{RETURN TO CALLER
*
* HERE TO TAKE CONVERT FAILURE EXIT
*
{APN01{EXI{1{{{RETURN TO CALLER ALTERNATE
*
* HERE FOR NO FIT EXIT
*
{APN02{EXI{2{{{ALTERNATE EXIT TO CALLER
{{ENP{{{{END PROCEDURE APNDB
{{EJC{{{{
*
* ARITH -- FETCH ARITHMETIC OPERANDS
*
* ARITH IS USED BY FUNCTIONS AND OPERATORS WHICH EXPECT
* TWO NUMERIC ARGUMENTS (OPERANDS) WHICH MUST BOTH BE
* INTEGER OR BOTH BE REAL. ARITH FETCHES TWO ARGUMENTS FROM
* THE STACK AND PERFORMS ANY NECESSARY CONVERSIONS.
*
* 1(XS) FIRST ARGUMENT (LEFT OPERAND)
* 0(XS) SECOND ARGUMENT (RIGHT OPERAND)
* JSR ARITH CALL TO FETCH NUMERIC ARGUMENTS
* PPM LOC TRANSFER LOC FOR OPND 1 NON-NUMERIC
* PPM LOC TRANSFER LOC FOR OPND 2 NON-NUMERIC
* PPM LOC TRANSFER LOC FOR REAL OPERANDS
*
* FOR INTEGER ARGS, CONTROL RETURNS PAST THE PARAMETERS
*
* (IA) LEFT OPERAND VALUE
* (XR) PTR TO ICBLK FOR LEFT OPERAND
* (XL) PTR TO ICBLK FOR RIGHT OPERAND
* (XS) POPPED TWICE
* (WA,WB,RA) DESTROYED
*
* FOR REAL ARGUMENTS, CONTROL RETURNS TO THE LOCATION
* SPECIFIED BY THE THIRD PARAMETER.
*
* (RA) LEFT OPERAND VALUE
* (XR) PTR TO RCBLK FOR LEFT OPERAND
* (XL) PTR TO RCBLK FOR RIGHT OPERAND
* (WA,WB,WC) DESTROYED
* (XS) POPPED TWICE
{{EJC{{{{
*
* ARITH (CONTINUED)
*
* ENTRY POINT
*
{ARITH{PRC{N{3{{ENTRY POINT
{{MOV{(SP)+{R10{{LOAD RIGHT OPERAND
{{MOV{(SP)+{R9{{LOAD LEFT OPERAND
{{MOV{(R10){R6{{GET RIGHT OPERAND TYPE WORD
{{BEQ{R6{#B$ICL{ARTH1{JUMP IF INTEGER
{{BEQ{R6{#B$RCL{ARTH4{JUMP IF REAL
{{MOV{R9{-(SP){{ELSE REPLACE LEFT ARG ON STACK
{{MOV{R10{R9{{COPY LEFT ARG POINTER
{{JSR{GTNUM{{{CONVERT TO NUMERIC
{{PPM{ARTH6{{{JUMP IF UNCONVERTIBLE
{{MOV{R9{R10{{ELSE COPY CONVERTED RESULT
{{MOV{(R10){R6{{GET RIGHT OPERAND TYPE WORD
{{MOV{(SP)+{R9{{RELOAD LEFT ARGUMENT
{{BEQ{R6{#B$RCL{ARTH4{JUMP IF RIGHT ARG IS REAL
*
* HERE IF RIGHT ARG IS AN INTEGER
*
{ARTH1{BNE{(R9){#B$ICL{ARTH3{JUMP IF LEFT ARG NOT INTEGER
*
* EXIT FOR INTEGER CASE
*
{ARTH2{LDI{4*ICVAL(R9){{{LOAD LEFT OPERAND VALUE
{{EXI{{{{RETURN TO ARITH CALLER
*
* HERE FOR RIGHT OPERAND INTEGER, LEFT OPERAND NOT
*
{ARTH3{JSR{GTNUM{{{CONVERT LEFT ARG TO NUMERIC
{{PPM{ARTH7{{{JUMP IF NOT CONVERTIBLE
{{BEQ{R6{#B$ICL{ARTH2{JUMP BACK IF INTEGER-INTEGER
*
* HERE WE MUST CONVERT REAL-INTEGER TO REAL-REAL
*
{{MOV{R9{-(SP){{PUT LEFT ARG BACK ON STACK
{{LDI{4*ICVAL(R10){{{LOAD RIGHT ARGUMENT VALUE
{{ITR{{{{CONVERT TO REAL
{{JSR{RCBLD{{{GET REAL BLOCK FOR RIGHT ARG, MERGE
{{MOV{R9{R10{{COPY RIGHT ARG PTR
{{MOV{(SP)+{R9{{LOAD LEFT ARGUMENT
{{BRN{ARTH5{{{MERGE FOR REAL-REAL CASE
{{EJC{{{{
*
* ARITH (CONTINUED)
*
* HERE IF RIGHT ARGUMENT IS REAL
*
{ARTH4{BEQ{(R9){#B$RCL{ARTH5{JUMP IF LEFT ARG REAL
{{JSR{GTREA{{{ELSE CONVERT TO REAL
{{PPM{ARTH7{{{ERROR IF UNCONVERTIBLE
*
* HERE FOR REAL-REAL
*
{ARTH5{LDR{4*RCVAL(R9){{{LOAD LEFT OPERAND VALUE
{{EXI{3{{{TAKE REAL-REAL EXIT
*
* HERE FOR ERROR CONVERTING RIGHT ARGUMENT
*
{ARTH6{ICA{SP{{{POP UNWANTED LEFT ARG
{{EXI{2{{{TAKE APPROPRIATE ERROR EXIT
*
* HERE FOR ERROR CONVERTING LEFT OPERAND
*
{ARTH7{EXI{1{{{TAKE APPROPRIATE ERROR RETURN
{{ENP{{{{END PROCEDURE ARITH
{{EJC{{{{
*
* ASIGN -- PERFORM ASSIGNMENT
*
* ASIGN PERFORMS THE ASSIGNMENT OF A VALUE TO A VARIABLE
* WITH APPROPRIATE CHECKS FOR OUTPUT ASSOCIATIONS AND
* VALUE TRACE ASSOCIATIONS WHICH ARE EXECUTED AS REQUIRED.
* ASIGN ALSO HANDLES THE SPECIAL CASES OF ASSIGNMENT TO
* PATTERN AND EXPRESSION VARIABLES.
*
* (WB) VALUE TO BE ASSIGNED
* (XL) BASE POINTER FOR VARIABLE
* (WA) OFFSET FOR VARIABLE
* JSR ASIGN CALL TO ASSIGN VALUE TO VARIABLE
* PPM LOC TRANSFER LOC FOR FAILURE
* (XR,XL,WA,WB,WC) DESTROYED
* (RA) DESTROYED
*
* FAILURE OCCURS IF THE EVALUATION OF AN EXPRESSION
* ASSOCIATED WITH AN EXPRESSION VARIABLE FAILS.
*
{ASIGN{PRC{R{1{{ENTRY POINT (RECURSIVE)
*
* MERGE BACK HERE TO ASSIGN RESULT TO EXPRESSION VARIABLE.
*
{ASG01{ADD{R6{R10{{POINT TO VARIABLE VALUE
{{MOV{(R10){R9{{LOAD VARIABLE VALUE
{{BEQ{(R9){#B$TRT{ASG02{JUMP IF TRAPPED
{{MOV{R7{(R10){{ELSE PERFORM ASSIGNMENT
{{ZER{R10{{{CLEAR GARBAGE VALUE IN XL
{{EXI{{{{AND RETURN TO ASIGN CALLER
*
* HERE IF VALUE IS TRAPPED
*
{ASG02{SUB{R6{R10{{RESTORE NAME BASE
{{BEQ{R9{#TRBKV{ASG14{JUMP IF KEYWORD VARIABLE
{{BNE{R9{#TRBEV{ASG04{JUMP IF NOT EXPRESSION VARIABLE
*
* HERE FOR ASSIGNMENT TO EXPRESSION VARIABLE
*
{{MOV{4*EVEXP(R10){R9{{POINT TO EXPRESSION
{{MOV{R7{-(SP){{STORE VALUE TO ASSIGN ON STACK
{{MOV{#NUM01{R7{{SET FOR EVALUATION BY NAME
{{JSR{EVALX{{{EVALUATE EXPRESSION BY NAME
{{PPM{ASG03{{{JUMP IF EVALUATION FAILS
{{MOV{(SP)+{R7{{ELSE RELOAD VALUE TO ASSIGN
{{BRN{ASG01{{{LOOP BACK TO PERFORM ASSIGNMENT
{{EJC{{{{
*
* ASIGN (CONTINUED)
*
* HERE FOR FAILURE DURING EXPRESSION EVALUATION
*
{ASG03{ICA{SP{{{REMOVE STACKED VALUE ENTRY
{{EXI{1{{{TAKE FAILURE EXIT
*
* HERE IF NOT KEYWORD OR EXPRESSION VARIABLE
*
{ASG04{MOV{R9{-(SP){{SAVE PTR TO FIRST TRBLK
*
* LOOP TO CHASE DOWN TRBLK CHAIN AND ASSIGN VALUE AT END
*
{ASG05{MOV{R9{R8{{SAVE PTR TO THIS TRBLK
{{MOV{4*TRNXT(R9){R9{{POINT TO NEXT TRBLK
{{BEQ{(R9){#B$TRT{ASG05{LOOP BACK IF ANOTHER TRBLK
{{MOV{R8{R9{{ELSE POINT BACK TO LAST TRBLK
{{MOV{R7{4*TRVAL(R9){{STORE VALUE AT END OF CHAIN
{{MOV{(SP)+{R9{{RESTORE PTR TO FIRST TRBLK
*
* LOOP TO PROCESS TRBLK ENTRIES ON CHAIN
*
{ASG06{MOV{4*TRTYP(R9){R7{{LOAD TYPE CODE OF TRBLK
{{BEQ{R7{#TRTVL{ASG08{JUMP IF VALUE TRACE
{{BEQ{R7{#TRTOU{ASG10{JUMP IF OUTPUT ASSOCIATION
*
* HERE TO MOVE TO NEXT TRBLK ON CHAIN
*
{ASG07{MOV{4*TRNXT(R9){R9{{POINT TO NEXT TRBLK ON CHAIN
{{BEQ{(R9){#B$TRT{ASG06{LOOP BACK IF ANOTHER TRBLK
{{EXI{{{{ELSE END OF CHAIN, RETURN TO CALLER
*
* HERE TO PROCESS VALUE TRACE
*
{ASG08{BZE{KVTRA{ASG07{{IGNORE VALUE TRACE IF TRACE OFF
{{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT
{{BZE{4*TRFNC(R9){ASG09{{JUMP IF PRINT TRACE
{{JSR{TRXEQ{{{ELSE EXECUTE FUNCTION TRACE
{{BRN{ASG07{{{AND LOOP BACK
{{EJC{{{{
*
* ASIGN (CONTINUED)
*
* HERE FOR PRINT TRACE
*
{ASG09{JSR{PRTSN{{{PRINT STATEMENT NUMBER
{{JSR{PRTNV{{{PRINT NAME = VALUE
{{BRN{ASG07{{{LOOP BACK FOR NEXT TRBLK
*
* HERE FOR OUTPUT ASSOCIATION
*
{ASG10{BZE{KVOUP{ASG07{{IGNORE OUTPUT ASSOC IF OUTPUT OFF
{{MOV{R9{R10{{ELSE COPY TRBLK POINTER
{{MOV{4*TRVAL(R8){-(SP){{STACK VALUE TO OUTPUT (SGD01)
{{JSR{GTSTG{{{CONVERT TO STRING
{{PPM{ASG12{{{GET DATATYPE NAME IF UNCONVERTIBLE
*
* MERGE WITH STRING FOR OUTPUT
*
{ASG11{MOV{4*TRFPT(R10){R6{{FCBLK PTR
{{BZE{R6{ASG13{{JUMP IF STANDARD OUTPUT FILE
*
* HERE FOR OUTPUT TO NON-STANDARD OUTPUT FILE
*
{{JSR{SYSOU{{{CALL SYSTEM OUTPUT ROUTINE
{{ERR{206{OUTPUT{{CAUSED FILE OVERFLOW
{{ERR{207{OUTPUT{{CAUSED NON-RECOVERABLE ERROR
{{EXI{{{{ELSE ALL DONE, RETURN TO CALLER
*
* IF NOT PRINTABLE, GET DATATYPE NAME INSTEAD
*
{ASG12{JSR{DTYPE{{{CALL DATATYPE ROUTINE
{{BRN{ASG11{{{MERGE
*
* HERE TO PRINT A STRING ON THE PRINTER
*
{ASG13{JSR{PRTST{{{PRINT STRING VALUE
{{BEQ{4*TRTER(R10){#V$TER{ASG20{JUMP IF TERMINAL OUTPUT
{{JSR{PRTNL{{{END OF LINE
{{EXI{{{{RETURN TO CALLER
{{EJC{{{{
*
* ASIGN (CONTINUED)
*
* HERE FOR KEYWORD ASSIGNMENT
*
{ASG14{MOV{4*KVNUM(R10){R10{{LOAD KEYWORD NUMBER
{{BEQ{R10{#K$ETX{ASG19{JUMP IF ERRTEXT
{{MOV{R7{R9{{COPY VALUE TO BE ASSIGNED
{{JSR{GTINT{{{CONVERT TO INTEGER
{{ERR{208{KEYWORD{{VALUE ASSIGNED IS NOT INTEGER
{{LDI{4*ICVAL(R9){{{ELSE LOAD VALUE
{{BEQ{R10{#K$STL{ASG16{JUMP IF SPECIAL CASE OF STLIMIT
{{MFI{R6{ASG18{{ELSE GET ADDR INTEGER, TEST OVFLOW
{{BGE{R6{MXLEN{ASG18{FAIL IF TOO LARGE
{{BEQ{R10{#K$ERT{ASG17{JUMP IF SPECIAL CASE OF ERRTYPE
{{BEQ{R10{#K$PFL{ASG21{JUMP IF SPECIAL CASE OF PROFILE
{{BLT{R10{#K$P$${ASG15{JUMP UNLESS PROTECTED
{{ERB{209{KEYWORD{{IN ASSIGNMENT IS PROTECTED
*
* HERE TO DO ASSIGNMENT IF NOT PROTECTED
*
{ASG15{MOV{R6{L^KVABE(R10){{STORE NEW VALUE
{{EXI{{{{RETURN TO ASIGN CALLER
*
* HERE FOR SPECIAL CASE OF STLIMIT
*
* SINCE STCOUNT IS MAINTAINED AS (STLIMIT-STCOUNT)
* IT IS ALSO NECESSARY TO MODIFY STCOUNT APPROPRIATELY.
*
{ASG16{SBI{KVSTL{{{SUBTRACT OLD LIMIT
{{ADI{KVSTC{{{ADD OLD COUNTER
{{STI{KVSTC{{{STORE NEW COUNTER VALUE
{{LDI{4*ICVAL(R9){{{RELOAD NEW LIMIT VALUE
{{STI{KVSTL{{{STORE NEW LIMIT VALUE
{{EXI{{{{RETURN TO ASIGN CALLER
*
* HERE FOR SPECIAL CASE OF ERRTYPE
*
{ASG17{BLE{R6{#NINI9{ERROR{OK TO SIGNAL IF IN RANGE
*
* HERE IF VALUE ASSIGNED IS OUT OF RANGE
*
{ASG18{ERB{210{KEYWORD{{VALUE ASSIGNED IS NEGATIVE OR TOO LARGE
*
* HERE FOR SPECIAL CASE OF ERRTEXT
*
{ASG19{MOV{R7{-(SP){{STACK VALUE
{{JSR{GTSTG{{{CONVERT TO STRING
{{ERR{211{VALUE{{ASSIGNED TO KEYWORD ERRTEXT NOT A STRING
{{MOV{R9{R$ETX{{MAKE ASSIGNMENT
{{EXI{{{{RETURN TO CALLER
*
* PRINT STRING TO TERMINAL
*
{ASG20{JSR{PRTTR{{{PRINT
{{EXI{{{{RETURN
*
* HERE FOR KEYWORD PROFILE
*
{ASG21{BGT{R6{#NUM02{ASG18{MOAN IF NOT 0,1, OR 2
{{BZE{R6{ASG15{{JUST ASSIGN IF ZERO
{{BZE{PFDMP{ASG22{{BRANCH IF FIRST ASSIGNMENT
{{BEQ{R6{PFDMP{ASG23{ALSO IF SAME VALUE AS BEFORE
{{ERB{268{INCONSISTENT{{VALUE ASSIGNED TO KEYWORD PROFILE
*
{ASG22{MOV{R6{PFDMP{{NOTE VALUE ON FIRST ASSIGNMENT
{ASG23{JSR{SYSTM{{{GET THE TIME
{{STI{PFSTM{{{FUDGE SOME KIND OF START TIME
{{BRN{ASG15{{{AND GO ASSIGN
{{ENP{{{{END PROCEDURE ASIGN
{{EJC{{{{
*
* ASINP -- ASSIGN DURING PATTERN MATCH
*
* ASINP IS LIKE ASIGN AND HAS A SIMILAR CALLING SEQUENCE
* AND EFFECT. THE DIFFERENCE IS THAT THE GLOBAL PATTERN
* VARIABLES ARE SAVED AND RESTORED IF REQUIRED.
*
* (XL) BASE POINTER FOR VARIABLE
* (WA) OFFSET FOR VARIABLE
* (WB) VALUE TO BE ASSIGNED
* JSR ASINP CALL TO ASSIGN VALUE TO VARIABLE
* PPM LOC TRANSFER LOC IF FAILURE
* (XR,XL) DESTROYED
* (WA,WB,WC,RA) DESTROYED
*
{ASINP{PRC{R{1{{ENTRY POINT, RECURSIVE
{{ADD{R6{R10{{POINT TO VARIABLE
{{MOV{(R10){R9{{LOAD CURRENT CONTENTS
{{BEQ{(R9){#B$TRT{ASNP1{JUMP IF TRAPPED
{{MOV{R7{(R10){{ELSE PERFORM ASSIGNMENT
{{ZER{R10{{{CLEAR GARBAGE VALUE IN XL
{{EXI{{{{RETURN TO ASINP CALLER
*
* HERE IF VARIABLE IS TRAPPED
*
{ASNP1{SUB{R6{R10{{RESTORE BASE POINTER
{{MOV{PMSSL{-(SP){{STACK SUBJECT STRING LENGTH
{{MOV{PMHBS{-(SP){{STACK HISTORY STACK BASE PTR
{{MOV{R$PMS{-(SP){{STACK SUBJECT STRING POINTER
{{MOV{PMDFL{-(SP){{STACK DOT FLAG
{{JSR{ASIGN{{{CALL FULL-BLOWN ASSIGNMENT ROUTINE
{{PPM{ASNP2{{{JUMP IF FAILURE
{{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG
{{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER
{{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER
{{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH
{{EXI{{{{RETURN TO ASINP CALLER
*
* HERE IF FAILURE IN ASIGN CALL
*
{ASNP2{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG
{{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER
{{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER
{{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH
{{EXI{1{{{TAKE FAILURE EXIT
{{ENP{{{{END PROCEDURE ASINP
{{EJC{{{{
*
* BLKLN -- DETERMINE LENGTH OF BLOCK
*
* BLKLN DETERMINES THE LENGTH OF A BLOCK IN DYNAMIC STORE.
*
* (WA) FIRST WORD OF BLOCK
* (XR) POINTER TO BLOCK
* JSR BLKLN CALL TO GET BLOCK LENGTH
* (WA) LENGTH OF BLOCK IN BYTES
* (XL) DESTROYED
*
* BLKLN IS USED BY THE GARBAGE COLLECTOR AND IS NOT
* PERMITTED TO CALL GBCOL DIRECTLY OR INDIRECTLY.
*
* THE FIRST WORD STORED IN THE BLOCK (I.E. AT XR) MAY
* BE ANYTHING, BUT THE CONTENTS OF WA MUST BE CORRECT.
*
{BLKLN{PRC{E{0{{ENTRY POINT
{{MOV{R6{R10{{COPY FIRST WORD
{{LEI{R10{{{GET ENTRY ID (BL$XX)
{{BSW{R10{BL$$${BLN00{SWITCH ON BLOCK TYPE
{{IFF{BL$AR{BLN01{{ARBLK
{{IFF{BL$BC{BLN04{{BCBLK
{{IFF{BL$CD{BLN01{{CDBLK
{{IFF{BL$EX{BLN01{{EXBLK
{{IFF{BL$IC{BLN07{{ICBLK
{{IFF{BL$NM{BLN03{{NMBLK
{{IFF{BL$P0{BLN02{{P0BLK
{{IFF{BL$P1{BLN03{{P1BLK
{{IFF{BL$P2{BLN04{{P2BLK
{{IFF{BL$RC{BLN09{{RCBLK
{{IFF{BL$SC{BLN10{{SCBLK
{{IFF{BL$SE{BLN02{{SEBLK
{{IFF{BL$TB{BLN01{{TBBLK
{{IFF{BL$VC{BLN01{{VCBLK
{{IFF{DUMMY{BLN00{{
{{IFF{DUMMY{BLN00{{
{{IFF{BL$PD{BLN08{{PDBLK
{{IFF{BL$TR{BLN05{{TRBLK
{{IFF{BL$BF{BLN11{{BFBLK
{{IFF{DUMMY{BLN00{{
{{IFF{DUMMY{BLN00{{
{{IFF{BL$CT{BLN06{{CTBLK
{{IFF{BL$DF{BLN01{{DFBLK
{{IFF{BL$EF{BLN01{{EFBLK
{{IFF{BL$EV{BLN03{{EVBLK
{{IFF{BL$FF{BLN05{{FFBLK
{{IFF{BL$KV{BLN03{{KVBLK
{{IFF{BL$PF{BLN01{{PFBLK
{{IFF{BL$TE{BLN04{{TEBLK
{{ESW{{{{END OF JUMP TABLE ON BLOCK TYPE
{{EJC{{{{
*
* BLKLN (CONTINUED)
*
* HERE FOR BLOCKS WITH LENGTH IN SECOND WORD
*
{BLN00{MOV{4*1(R9){R6{{LOAD LENGTH
{{EXI{{{{RETURN TO BLKLN CALLER
*
* HERE FOR LENGTH IN THIRD WORD (AR,CD,DF,EF,EX,PF,TB,VC)
*
{BLN01{MOV{4*2(R9){R6{{LOAD LENGTH FROM THIRD WORD
{{EXI{{{{RETURN TO BLKLN CALLER
*
* HERE FOR TWO WORD BLOCKS (P0,SE)
*
{BLN02{MOV{#4*NUM02{R6{{LOAD LENGTH (TWO WORDS)
{{EXI{{{{RETURN TO BLKLN CALLER
*
* HERE FOR THREE WORD BLOCKS (NM,P1,EV,KV)
*
{BLN03{MOV{#4*NUM03{R6{{LOAD LENGTH (THREE WORDS)
{{EXI{{{{RETURN TO BLKLN CALLER
*
* HERE FOR FOUR WORD BLOCKS (P2,TE,BC)
*
{BLN04{MOV{#4*NUM04{R6{{LOAD LENGTH (FOUR WORDS)
{{EXI{{{{RETURN TO BLKLN CALLER
*
* HERE FOR FIVE WORD BLOCKS (FF,TR)
*
{BLN05{MOV{#4*NUM05{R6{{LOAD LENGTH
{{EXI{{{{RETURN TO BLKLN CALLER
{{EJC{{{{
*
* BLKLN (CONTINUED)
*
* HERE FOR CTBLK
*
{BLN06{MOV{#4*CTSI${R6{{SET SIZE OF CTBLK
{{EXI{{{{RETURN TO BLKLN CALLER
*
* HERE FOR ICBLK
*
{BLN07{MOV{#4*ICSI${R6{{SET SIZE OF ICBLK
{{EXI{{{{RETURN TO BLKLN CALLER
*
* HERE FOR PDBLK
*
{BLN08{MOV{4*PDDFP(R9){R10{{POINT TO DFBLK
{{MOV{4*DFPDL(R10){R6{{LOAD PDBLK LENGTH FROM DFBLK
{{EXI{{{{RETURN TO BLKLN CALLER
*
* HERE FOR RCBLK
*
{BLN09{MOV{#4*RCSI${R6{{SET SIZE OF RCBLK
{{EXI{{{{RETURN TO BLKLN CALLER
*
* HERE FOR SCBLK
*
{BLN10{MOV{4*SCLEN(R9){R6{{LOAD LENGTH IN CHARACTERS
{{CTB{R6{SCSI${{CALCULATE LENGTH IN BYTES
{{EXI{{{{RETURN TO BLKLN CALLER
*
* HERE FOR BFBLK
*
{BLN11{MOV{4*BFALC(R9){R6{{GET ALLOCATION IN BYTES
{{CTB{R6{BFSI${{CALCULATE LENGTH IN BYTES
{{EXI{{{{RETURN TO BLKLN CALLER
{{ENP{{{{END PROCEDURE BLKLN
{{EJC{{{{
*
* COPYB -- COPY A BLOCK
*
* (XS) BLOCK TO BE COPIED
* JSR COPYB CALL TO COPY BLOCK
* PPM LOC RETURN IF BLOCK HAS NO IDVAL FIELD
* NORMAL RETURN IF IDVAL FIELD
* (XR) COPY OF BLOCK
* (XS) POPPED
* (XL,WA,WB,WC) DESTROYED
*
{COPYB{PRC{N{1{{ENTRY POINT
{{MOV{(SP){R9{{LOAD ARGUMENT
{{BEQ{R9{#NULLS{COP10{RETURN ARGUMENT IF IT IS NULL
{{MOV{(R9){R6{{ELSE LOAD TYPE WORD
{{MOV{R6{R7{{COPY TYPE WORD
{{JSR{BLKLN{{{GET LENGTH OF ARGUMENT BLOCK
{{MOV{R9{R10{{COPY POINTER
{{JSR{ALLOC{{{ALLOCATE BLOCK OF SAME SIZE
{{MOV{R9{(SP){{STORE POINTER TO COPY
{{MVW{{{{COPY CONTENTS OF OLD BLOCK TO NEW
{{MOV{(SP){R9{{RELOAD POINTER TO START OF COPY
{{BEQ{R7{#B$TBT{COP05{JUMP IF TABLE
{{BEQ{R7{#B$VCT{COP01{JUMP IF VECTOR
{{BEQ{R7{#B$PDT{COP01{JUMP IF PROGRAM DEFINED
{{BEQ{R7{#B$BCT{COP11{JUMP IF BUFFER
{{BNE{R7{#B$ART{COP10{RETURN COPY IF NOT ARRAY
*
* HERE FOR ARRAY (ARBLK)
*
{{ADD{4*AROFS(R9){R9{{POINT TO PROTOTYPE FIELD
{{BRN{COP02{{{JUMP TO MERGE
*
* HERE FOR VECTOR, PROGRAM DEFINED
*
{COP01{ADD{#4*PDFLD{R9{{POINT TO PDFLD = VCVLS
*
* MERGE HERE FOR ARBLK, VCBLK, PDBLK TO DELETE TRAP
* BLOCKS FROM ALL VALUE FIELDS (THE COPY IS UNTRAPPED)
*
{COP02{MOV{(R9){R10{{LOAD NEXT POINTER
*
* LOOP TO GET VALUE AT END OF TRBLK CHAIN
*
{COP03{BNE{(R10){#B$TRT{COP04{JUMP IF NOT TRAPPED
{{MOV{4*TRVAL(R10){R10{{ELSE POINT TO NEXT VALUE
{{BRN{COP03{{{AND LOOP BACK
{{EJC{{{{
*
* COPYB (CONTINUED)
*
* HERE WITH UNTRAPPED VALUE IN XL
*
{COP04{MOV{R10{(R9)+{{STORE REAL VALUE, BUMP POINTER
{{BNE{R9{DNAMP{COP02{LOOP BACK IF MORE TO GO
{{BRN{COP09{{{ELSE JUMP TO EXIT
*
* HERE TO COPY A TABLE
*
{COP05{ZER{4*IDVAL(R9){{{ZERO ID TO STOP DUMP BLOWING UP
{{MOV{#4*TESI${R6{{SET SIZE OF TEBLK
{{MOV{#4*TBBUK{R8{{SET INITIAL OFFSET
*
* LOOP THROUGH BUCKETS IN TABLE
*
{COP06{MOV{(SP){R9{{LOAD TABLE POINTER
{{BEQ{R8{4*TBLEN(R9){COP09{JUMP TO EXIT IF ALL DONE
{{ADD{R8{R9{{ELSE POINT TO NEXT BUCKET HEADER
{{ICA{R8{{{BUMP OFFSET
{{SUB{#4*TENXT{R9{{SUBTRACT LINK OFFSET TO MERGE
*
* LOOP THROUGH TEBLKS ON ONE CHAIN
*
{COP07{MOV{4*TENXT(R9){R10{{LOAD POINTER TO NEXT TEBLK
{{MOV{(SP){4*TENXT(R9){{SET END OF CHAIN POINTER IN CASE
{{BEQ{(R10){#B$TBT{COP06{BACK FOR NEXT BUCKET IF CHAIN END
{{MOV{R9{-(SP){{ELSE STACK PTR TO PREVIOUS BLOCK
{{MOV{#4*TESI${R6{{SET SIZE OF TEBLK
{{JSR{ALLOC{{{ALLOCATE NEW TEBLK
{{MOV{R9{R7{{SAVE PTR TO NEW TEBLK
{{MVW{{{{COPY OLD TEBLK TO NEW TEBLK
{{MOV{R7{R9{{RESTORE POINTER TO NEW TEBLK
{{MOV{(SP)+{R10{{RESTORE POINTER TO PREVIOUS BLOCK
{{MOV{R9{4*TENXT(R10){{LINK NEW BLOCK TO PREVIOUS
{{MOV{R9{R10{{COPY POINTER TO NEW BLOCK
*
* LOOP TO SET REAL VALUE AFTER REMOVING TRAP CHAIN
*
{COP08{MOV{4*TEVAL(R10){R10{{LOAD VALUE
{{BEQ{(R10){#B$TRT{COP08{LOOP BACK IF TRAPPED
{{MOV{R10{4*TEVAL(R9){{STORE UNTRAPPED VALUE IN TEBLK
{{BRN{COP07{{{BACK FOR NEXT TEBLK
*
* COMMON EXIT POINT
*
{COP09{MOV{(SP)+{R9{{LOAD POINTER TO BLOCK
{{EXI{{{{RETURN
*
* ALTERNATIVE RETURN
*
{COP10{EXI{1{{{RETURN
{{EJC{{{{
*
* HERE TO COPY BUFFER
*
{COP11{MOV{4*BCBUF(R9){R10{{GET BFBLK PTR
{{MOV{4*BFALC(R10){R6{{GET ALLOCATION
{{CTB{R6{BFSI${{SET TOTAL SIZE
{{MOV{R9{R10{{SAVE BCBLK PTR
{{JSR{ALLOC{{{ALLOCATE BFBLK
{{MOV{4*BCBUF(R10){R7{{GET OLD BFBLK
{{MOV{R9{4*BCBUF(R10){{SET POINTER TO NEW BFBLK
{{MOV{R7{R10{{POINT TO OLD BFBLK
{{MVW{{{{COPY BFBLK TOO
{{ZER{R10{{{CLEAR RUBBISH PTR
{{BRN{COP09{{{BRANCH TO EXIT
{{ENP{{{{END PROCEDURE COPYB
*
* CDGCG -- GENERATE CODE FOR COMPLEX GOTO
*
* USED BY CMPIL TO PROCESS COMPLEX GOTO TREE
*
* (WB) MUST BE COLLECTABLE
* (XR) EXPRESSION POINTER
* JSR CDGCG CALL TO GENERATE COMPLEX GOTO
* (XL,XR,WA) DESTROYED
*
{CDGCG{PRC{E{0{{ENTRY POINT
{{MOV{4*CMOPN(R9){R10{{GET UNARY GOTO OPERATOR
{{MOV{4*CMROP(R9){R9{{POINT TO GOTO OPERAND
{{BEQ{R10{#OPDVD{CDGC2{JUMP IF DIRECT GOTO
{{JSR{CDGNM{{{GENERATE OPND BY NAME IF NOT DIRECT
*
* RETURN POINT
*
{CDGC1{MOV{R10{R6{{GOTO OPERATOR
{{JSR{CDWRD{{{GENERATE IT
{{EXI{{{{RETURN TO CALLER
*
* DIRECT GOTO
*
{CDGC2{JSR{CDGVL{{{GENERATE OPERAND BY VALUE
{{BRN{CDGC1{{{MERGE TO RETURN
{{ENP{{{{END PROCEDURE CDGCG
{{EJC{{{{
*
* CDGEX -- BUILD EXPRESSION BLOCK
*
* CDGEX IS PASSED A POINTER TO AN EXPRESSION TREE (SEE
* EXPAN) AND RETURNS AN EXPRESSION (SEBLK OR EXBLK).
*
* (WC) SOME COLLECTABLE VALUE
* (WB) INTEGER IN RANGE 0 LE X LE MXLEN
* (XL) PTR TO EXPRESSION TREE
* JSR CDGEX CALL TO BUILD EXPRESSION
* (XR) PTR TO SEBLK OR EXBLK
* (XL,WA,WB) DESTROYED
*
{CDGEX{PRC{R{0{{ENTRY POINT, RECURSIVE
{{BLO{(R10){#B$VR${CDGX1{JUMP IF NOT VARIABLE
*
* HERE FOR NATURAL VARIABLE, BUILD SEBLK
*
{{MOV{#4*SESI${R6{{SET SIZE OF SEBLK
{{JSR{ALLOC{{{ALLOCATE SPACE FOR SEBLK
{{MOV{#B$SEL{(R9){{SET TYPE WORD
{{MOV{R10{4*SEVAR(R9){{STORE VRBLK POINTER
{{EXI{{{{RETURN TO CDGEX CALLER
*
* HERE IF NOT VARIABLE, BUILD EXBLK
*
{CDGX1{MOV{R10{R9{{COPY TREE POINTER
{{MOV{R8{-(SP){{SAVE WC
{{MOV{CWCOF{R10{{SAVE CURRENT OFFSET
{{MOV{(R9){R6{{GET TYPE WORD
{{BNE{R6{#B$CMT{CDGX2{CALL BY VALUE IF NOT CMBLK
{{BGE{4*CMTYP(R9){#C$$NM{CDGX2{JUMP IF CMBLK ONLY BY VALUE
{{EJC{{{{
*
* CDGEX (CONTINUED)
*
* HERE IF EXPRESSION CAN BE EVALUATED BY NAME
*
{{JSR{CDGNM{{{GENERATE CODE BY NAME
{{MOV{#ORNM${R6{{LOAD RETURN BY NAME WORD
{{BRN{CDGX3{{{MERGE WITH VALUE CASE
*
* HERE IF EXPRESSION CAN ONLY BE EVALUATED BY VALUE
*
{CDGX2{JSR{CDGVL{{{GENERATE CODE BY VALUE
{{MOV{#ORVL${R6{{LOAD RETURN BY VALUE WORD
*
* MERGE HERE TO CONSTRUCT EXBLK
*
{CDGX3{JSR{CDWRD{{{GENERATE RETURN WORD
{{JSR{EXBLD{{{BUILD EXBLK
{{MOV{(SP)+{R8{{RESTORE WC
{{EXI{{{{RETURN TO CDGEX CALLER
{{ENP{{{{END PROCEDURE CDGEX
{{EJC{{{{
*
* CDGNM -- GENERATE CODE BY NAME
*
* CDGNM IS CALLED DURING THE COMPILATION PROCESS TO
* GENERATE CODE BY NAME FOR AN EXPRESSION. SEE CDBLK
* DESCRIPTION FOR DETAILS OF CODE GENERATED. THE INPUT
* TO CDGNM IS AN EXPRESSION TREE AS GENERATED BY EXPAN.
*
* CDGNM IS A RECURSIVE PROCEDURE WHICH PROCEEDS BY MAKING
* RECURSIVE CALLS TO GENERATE CODE FOR OPERANDS.
*
* (WB) INTEGER IN RANGE 0 LE N LE DNAMB
* (XR) PTR TO TREE GENERATED BY EXPAN
* (WC) CONSTANT FLAG (SEE BELOW)
* JSR CDGNM CALL TO GENERATE CODE BY NAME
* (XR,WA) DESTROYED
* (WC) SET NON-ZERO IF NON-CONSTANT
*
* WC IS SET TO A NON-ZERO (COLLECTABLE) VALUE IF THE
* EXPRESSION FOR WHICH CODE IS GENERATED CANNOT BE
* EVALUATED AT COMPILE TIME, OTHERWISE WC IS UNCHANGED.
*
* THE CODE IS GENERATED IN THE CURRENT CCBLK (SEE CDWRD).
*
{CDGNM{PRC{R{0{{ENTRY POINT, RECURSIVE
{{MOV{R10{-(SP){{SAVE ENTRY XL
{{MOV{R7{-(SP){{SAVE ENTRY WB
{{CHK{{{{CHECK FOR STACK OVERFLOW
{{MOV{(R9){R6{{LOAD TYPE WORD
{{BEQ{R6{#B$CMT{CGN04{JUMP IF CMBLK
{{BHI{R6{#B$VR${CGN02{JUMP IF SIMPLE VARIABLE
*
* MERGE HERE FOR OPERAND YIELDING VALUE (E.G. CONSTANT)
*
{CGN01{ERB{212{SYNTAX{{ERROR. VALUE USED WHERE NAME IS REQUIRED
*
* HERE FOR NATURAL VARIABLE REFERENCE
*
{CGN02{MOV{#OLVN${R6{{LOAD VARIABLE LOAD CALL
{{JSR{CDWRD{{{GENERATE IT
{{MOV{R9{R6{{COPY VRBLK POINTER
{{JSR{CDWRD{{{GENERATE VRBLK POINTER
{{EJC{{{{
*
* CDGNM (CONTINUED)
*
* HERE TO EXIT WITH WC SET CORRECTLY
*
{CGN03{MOV{(SP)+{R7{{RESTORE ENTRY WB
{{MOV{(SP)+{R10{{RESTORE ENTRY XL
{{EXI{{{{RETURN TO CDGNM CALLER
*
* HERE FOR CMBLK
*
{CGN04{MOV{R9{R10{{COPY CMBLK POINTER
{{MOV{4*CMTYP(R9){R9{{LOAD CMBLK TYPE
{{BGE{R9{#C$$NM{CGN01{ERROR IF NOT NAME OPERAND
{{BSW{R9{C$$NM{{ELSE SWITCH ON TYPE
{{IFF{C$ARR{CGN05{{ARRAY REFERENCE
{{IFF{C$FNC{CGN08{{FUNCTION CALL
{{IFF{C$DEF{CGN09{{DEFERRED EXPRESSION
{{IFF{C$IND{CGN10{{INDIRECT REFERENCE
{{IFF{C$KEY{CGN11{{KEYWORD REFERENCE
{{IFF{C$UBO{CGN08{{UNDEFINED BINARY OP
{{IFF{C$UUO{CGN08{{UNDEFINED UNARY OP
{{ESW{{{{END SWITCH ON CMBLK TYPE
*
* HERE TO GENERATE CODE FOR ARRAY REFERENCE
*
{CGN05{MOV{#4*CMOPN{R7{{POINT TO ARRAY OPERAND
*
* LOOP TO GENERATE CODE FOR ARRAY OPERAND AND SUBSCRIPTS
*
{CGN06{JSR{CMGEN{{{GENERATE CODE FOR NEXT OPERAND
{{MOV{4*CMLEN(R10){R8{{LOAD LENGTH OF CMBLK
{{BLT{R7{R8{CGN06{LOOP TILL ALL GENERATED
*
* GENERATE APPROPRIATE ARRAY CALL
*
{{MOV{#OAON${R6{{LOAD ONE-SUBSCRIPT CASE CALL
{{BEQ{R8{#4*CMAR1{CGN07{JUMP TO EXIT IF ONE SUBSCRIPT CASE
{{MOV{#OAMN${R6{{ELSE LOAD MULTI-SUBSCRIPT CASE CALL
{{JSR{CDWRD{{{GENERATE CALL
{{MOV{R8{R6{{COPY CMBLK LENGTH
{{BTW{R6{{{CONVERT TO WORDS
{{SUB{#CMVLS{R6{{CALCULATE NUMBER OF SUBSCRIPTS
{{EJC{{{{
*
* CDGNM (CONTINUED)
*
* HERE TO EXIT GENERATING WORD (NON-CONSTANT)
*
{CGN07{MNZ{R8{{{SET RESULT NON-CONSTANT
{{JSR{CDWRD{{{GENERATE WORD
{{BRN{CGN03{{{BACK TO EXIT
*
* HERE TO GENERATE CODE FOR FUNCTIONS AND UNDEFINED OPRS
*
{CGN08{MOV{R10{R9{{COPY CMBLK POINTER
{{JSR{CDGVL{{{GEN CODE BY VALUE FOR CALL
{{MOV{#OFNE${R6{{GET EXTRA CALL FOR BY NAME
{{BRN{CGN07{{{BACK TO GENERATE AND EXIT
*
* HERE TO GENERATE CODE FOR DEFERED EXPRESSION
*
{CGN09{MOV{4*CMROP(R10){R9{{CHECK IF VARIABLE
{{BHI{(R9){#B$VR${CGN02{TREAT *VARIABLE AS SIMPLE VAR
{{MOV{R9{R10{{COPY PTR TO EXPRESSION TREE
{{JSR{CDGEX{{{ELSE BUILD EXBLK
{{MOV{#OLEX${R6{{SET CALL TO LOAD EXPR BY NAME
{{JSR{CDWRD{{{GENERATE IT
{{MOV{R9{R6{{COPY EXBLK POINTER
{{JSR{CDWRD{{{GENERATE EXBLK POINTER
{{BRN{CGN03{{{BACK TO EXIT
*
* HERE TO GENERATE CODE FOR INDIRECT REFERENCE
*
{CGN10{MOV{4*CMROP(R10){R9{{GET OPERAND
{{JSR{CDGVL{{{GENERATE CODE BY VALUE FOR IT
{{MOV{#OINN${R6{{LOAD CALL FOR INDIRECT BY NAME
{{BRN{CGN12{{{MERGE
*
* HERE TO GENERATE CODE FOR KEYWORD REFERENCE
*
{CGN11{MOV{4*CMROP(R10){R9{{GET OPERAND
{{JSR{CDGNM{{{GENERATE CODE BY NAME FOR IT
{{MOV{#OKWN${R6{{LOAD CALL FOR KEYWORD BY NAME
*
* KEYWORD, INDIRECT MERGE HERE
*
{CGN12{JSR{CDWRD{{{GENERATE CODE FOR OPERATOR
{{BRN{CGN03{{{EXIT
{{ENP{{{{END PROCEDURE CDGNM
{{EJC{{{{
*
* CDGVL -- GENERATE CODE BY VALUE
*
* CDGVL IS CALLED DURING THE COMPILATION PROCESS TO
* GENERATE CODE BY VALUE FOR AN EXPRESSION. SEE CDBLK
* DESCRIPTION FOR DETAILS OF THE CODE GENERATED. THE INPUT
* TO CDGVL IS AN EXPRESSION TREE AS GENERATED BY EXPAN.
*
* CDGVL IS A RECURSIVE PROCEDURE WHICH PROCEEDS BY MAKING
* RECURSIVE CALLS TO GENERATE CODE FOR OPERANDS.
*
* (WB) INTEGER IN RANGE 0 LE N LE DNAMB
* (XR) PTR TO TREE GENERATED BY EXPAN
* (WC) CONSTANT FLAG (SEE BELOW)
* JSR CDGVL CALL TO GENERATE CODE BY VALUE
* (XR,WA) DESTROYED
* (WC) SET NON-ZERO IF NON-CONSTANT
*
* WC IS SET TO A NON-ZERO (COLLECTABLE) VALUE IF THE
* EXPRESSION FOR WHICH CODE IS GENERATED CANNOT BE
* EVALUATED AT COMPILE TIME, OTHERWISE WC IS UNCHANGED.
*
* IF WC IS NON-ZERO ON ENTRY, THEN PREEVALUATION IS NOT
* ALLOWED REGARDLESS OF THE NATURE OF THE OPERAND.
*
* THE CODE IS GENERATED IN THE CURRENT CCBLK (SEE CDWRD).
*
{CDGVL{PRC{R{0{{ENTRY POINT, RECURSIVE
{{MOV{(R9){R6{{LOAD TYPE WORD
{{BEQ{R6{#B$CMT{CGV01{JUMP IF CMBLK
{{BLT{R6{#B$VRA{CGV00{JUMP IF ICBLK, RCBLK, SCBLK
{{BNZ{4*VRLEN(R9){CGVL0{{JUMP IF NOT SYSTEM VARIABLE
{{MOV{R9{-(SP){{STACK XR
{{MOV{4*VRSVP(R9){R9{{POINT TO SVBLK
{{MOV{4*SVBIT(R9){R6{{GET SVBLK PROPERTY BITS
{{MOV{(SP)+{R9{{RECOVER XR
{{ANB{BTCKW{R6{{CHECK IF CONSTANT KEYWORD
{{NZB{R6{CGV00{{JUMP IF CONSTANT KEYWORD
*
* HERE FOR VARIABLE VALUE REFERENCE
*
{CGVL0{MNZ{R8{{{INDICATE NON-CONSTANT VALUE
*
* MERGE HERE FOR SIMPLE CONSTANT (ICBLK,RCBLK,SCBLK)
* AND FOR VARIABLES CORRESPONDING TO CONSTANT KEYWORDS.
*
{CGV00{MOV{R9{R6{{COPY PTR TO VAR OR CONSTANT
{{JSR{CDWRD{{{GENERATE AS CODE WORD
{{EXI{{{{RETURN TO CALLER
{{EJC{{{{
*
* CDGVL (CONTINUED)
*
* HERE FOR TREE NODE (CMBLK)
*
{CGV01{MOV{R7{-(SP){{SAVE ENTRY WB
{{MOV{R10{-(SP){{SAVE ENTRY XL
{{MOV{R8{-(SP){{SAVE ENTRY CONSTANT FLAG
{{MOV{CWCOF{-(SP){{SAVE INITIAL CODE OFFSET
{{CHK{{{{CHECK FOR STACK OVERFLOW
*
* PREPARE TO GENERATE CODE FOR CMBLK. WC IS SET TO THE
* VALUE OF CSWNO (ZERO IF -OPTIMISE, 1 IF -NOOPT) TO
* START WITH AND IS RESET NON-ZERO FOR ANY NON-CONSTANT
* CODE GENERATED. IF IT IS STILL ZERO AFTER GENERATING ALL
* THE CMBLK CODE, THEN ITS VALUE IS COMPUTED AS THE RESULT.
*
{{MOV{R9{R10{{COPY CMBLK POINTER
{{MOV{4*CMTYP(R9){R9{{LOAD CMBLK TYPE
{{MOV{CSWNO{R8{{RESET CONSTANT FLAG
{{BLE{R9{#C$PR${CGV02{JUMP IF NOT PREDICATE VALUE
{{MNZ{R8{{{ELSE FORCE NON-CONSTANT CASE
*
* HERE WITH WC SET APPROPRIATELY
*
{CGV02{BSW{R9{C$$NV{{SWITCH TO APPROPRIATE GENERATOR
{{IFF{C$ARR{CGV03{{ARRAY REFERENCE
{{IFF{C$FNC{CGV05{{FUNCTION CALL
{{IFF{C$DEF{CGV14{{DEFERRED EXPRESSION
{{IFF{C$IND{CGV31{{INDIRECT REFERENCE
{{IFF{C$KEY{CGV27{{KEYWORD REFERENCE
{{IFF{C$UBO{CGV29{{UNDEFINED BINOP
{{IFF{C$UUO{CGV30{{UNDEFINED UNOP
{{IFF{C$BVL{CGV18{{BINOPS WITH VAL OPDS
{{IFF{C$UVL{CGV19{{UNOPS WITH VALU OPND
{{IFF{C$ALT{CGV18{{ALTERNATION
{{IFF{C$CNC{CGV24{{CONCATENATION
{{IFF{C$CNP{CGV24{{CONCATENATION (NOT PATTERN MATCH)
{{IFF{C$UNM{CGV27{{UNOPS WITH NAME OPND
{{IFF{C$BVN{CGV26{{BINARY $ AND .
{{IFF{C$ASS{CGV21{{ASSIGNMENT
{{IFF{C$INT{CGV31{{INTERROGATION
{{IFF{C$NEG{CGV28{{NEGATION
{{IFF{C$SEL{CGV15{{SELECTION
{{IFF{C$PMT{CGV18{{PATTERN MATCH
{{ESW{{{{END SWITCH ON CMBLK TYPE
{{EJC{{{{
*
* CDGVL (CONTINUED)
*
* HERE TO GENERATE CODE FOR ARRAY REFERENCE
*
{CGV03{MOV{#4*CMOPN{R7{{SET OFFSET TO ARRAY OPERAND
*
* LOOP TO GENERATE CODE FOR ARRAY OPERAND AND SUBSCRIPTS
*
{CGV04{JSR{CMGEN{{{GEN VALUE CODE FOR NEXT OPERAND
{{MOV{4*CMLEN(R10){R8{{LOAD CMBLK LENGTH
{{BLT{R7{R8{CGV04{LOOP BACK IF MORE TO GO
*
* GENERATE CALL TO APPROPRIATE ARRAY REFERENCE ROUTINE
*
{{MOV{#OAOV${R6{{SET ONE SUBSCRIPT CALL IN CASE
{{BEQ{R8{#4*CMAR1{CGV32{JUMP TO EXIT IF 1-SUB CASE
{{MOV{#OAMV${R6{{ELSE SET CALL FOR MULTI-SUBSCRIPTS
{{JSR{CDWRD{{{GENERATE CALL
{{MOV{R8{R6{{COPY LENGTH OF CMBLK
{{SUB{#4*CMVLS{R6{{SUBTRACT STANDARD LENGTH
{{BTW{R6{{{GET NUMBER OF WORDS
{{BRN{CGV32{{{JUMP TO GENERATE SUBSCRIPT COUNT
*
* HERE TO GENERATE CODE FOR FUNCTION CALL
*
{CGV05{MOV{#4*CMVLS{R7{{SET OFFSET TO FIRST ARGUMENT
*
* LOOP TO GENERATE CODE FOR ARGUMENTS
*
{CGV06{BEQ{R7{4*CMLEN(R10){CGV07{JUMP IF ALL GENERATED
{{JSR{CMGEN{{{ELSE GEN VALUE CODE FOR NEXT ARG
{{BRN{CGV06{{{BACK TO GENERATE NEXT ARGUMENT
*
* HERE TO GENERATE ACTUAL FUNCTION CALL
*
{CGV07{SUB{#4*CMVLS{R7{{GET NUMBER OF ARG PTRS (BYTES)
{{BTW{R7{{{CONVERT BYTES TO WORDS
{{MOV{4*CMOPN(R10){R9{{LOAD FUNCTION VRBLK POINTER
{{BNZ{4*VRLEN(R9){CGV12{{JUMP IF NOT SYSTEM FUNCTION
{{MOV{4*VRSVP(R9){R10{{LOAD SVBLK PTR IF SYSTEM VAR
{{MOV{4*SVBIT(R10){R6{{LOAD BIT MASK
{{ANB{BTFFC{R6{{TEST FOR FAST FUNCTION CALL ALLOWED
{{ZRB{R6{CGV12{{JUMP IF NOT
{{EJC{{{{
*
* CDGVL (CONTINUED)
*
* HERE IF FAST FUNCTION CALL IS ALLOWED
*
{{MOV{4*SVBIT(R10){R6{{RELOAD BIT INDICATORS
{{ANB{BTPRE{R6{{TEST FOR PREEVALUATION OK
{{NZB{R6{CGV08{{JUMP IF PREEVALUATION PERMITTED
{{MNZ{R8{{{ELSE SET RESULT NON-CONSTANT
*
* TEST FOR CORRECT NUMBER OF ARGS FOR FAST CALL
*
{CGV08{MOV{4*VRFNC(R9){R10{{LOAD PTR TO SVFNC FIELD
{{MOV{4*FARGS(R10){R6{{LOAD SVNAR FIELD VALUE
{{BEQ{R6{R7{CGV11{JUMP IF ARGUMENT COUNT IS CORRECT
{{BHI{R6{R7{CGV09{JUMP IF TOO FEW ARGUMENTS GIVEN
*
* HERE IF TOO MANY ARGUMENTS, PREPARE TO GENERATE O$POPS
*
{{SUB{R6{R7{{GET NUMBER OF EXTRA ARGS
{{LCT{R7{R7{{SET AS COUNT TO CONTROL LOOP
{{MOV{#OPOP${R6{{SET POP CALL
{{BRN{CGV10{{{JUMP TO COMMON LOOP
*
* HERE IF TOO FEW ARGUMENTS, PREPARE TO GENERATE NULLS
*
{CGV09{SUB{R7{R6{{GET NUMBER OF MISSING ARGUMENTS
{{LCT{R7{R6{{LOAD AS COUNT TO CONTROL LOOP
{{MOV{#NULLS{R6{{LOAD PTR TO NULL CONSTANT
*
* LOOP TO GENERATE CALLS TO FIX ARGUMENT COUNT
*
{CGV10{JSR{CDWRD{{{GENERATE ONE CALL
{{BCT{R7{CGV10{{LOOP TILL ALL GENERATED
*
* HERE AFTER ADJUSTING ARG COUNT AS REQUIRED
*
{CGV11{MOV{R10{R6{{COPY POINTER TO SVFNC FIELD
{{BRN{CGV36{{{JUMP TO GENERATE CALL
{{EJC{{{{
*
* CDGVL (CONTINUED)
*
* COME HERE IF FAST CALL IS NOT PERMITTED
*
{CGV12{MOV{#OFNS${R6{{SET ONE ARG CALL IN CASE
{{BEQ{R7{#NUM01{CGV13{JUMP IF ONE ARG CASE
{{MOV{#OFNC${R6{{ELSE LOAD CALL FOR MORE THAN 1 ARG
{{JSR{CDWRD{{{GENERATE IT
{{MOV{R7{R6{{COPY ARGUMENT COUNT
*
* ONE ARG CASE MERGES HERE
*
{CGV13{JSR{CDWRD{{{GENERATE =O$FNS OR ARG COUNT
{{MOV{R9{R6{{COPY VRBLK POINTER
{{BRN{CGV32{{{JUMP TO GENERATE VRBLK PTR
*
* HERE FOR DEFERRED EXPRESSION
*
{CGV14{MOV{4*CMROP(R10){R10{{POINT TO EXPRESSION TREE
{{JSR{CDGEX{{{BUILD EXBLK OR SEBLK
{{MOV{R9{R6{{COPY BLOCK PTR
{{JSR{CDWRD{{{GENERATE PTR TO EXBLK OR SEBLK
{{BRN{CGV34{{{JUMP TO EXIT, CONSTANT TEST
*
* HERE TO GENERATE CODE FOR SELECTION
*
{CGV15{ZER{-(SP){{{ZERO PTR TO CHAIN OF FORWARD JUMPS
{{ZER{-(SP){{{ZERO PTR TO PREV O$SLC FORWARD PTR
{{MOV{#4*CMVLS{R7{{POINT TO FIRST ALTERNATIVE
{{MOV{#OSLA${R6{{SET INITIAL CODE WORD
*
* 0(XS) IS THE OFFSET TO THE PREVIOUS WORD
* WHICH REQUIRES FILLING IN WITH AN
* OFFSET TO THE FOLLOWING O$SLC,O$SLD
*
* 1(XS) IS THE HEAD OF A CHAIN OF OFFSET
* POINTERS INDICATING THOSE LOCATIONS
* TO BE FILLED WITH OFFSETS PAST
* THE END OF ALL THE ALTERNATIVES
*
{CGV16{JSR{CDWRD{{{GENERATE O$SLC (O$SLA FIRST TIME)
{{MOV{CWCOF{(SP){{SET CURRENT LOC AS PTR TO FILL IN
{{JSR{CDWRD{{{GENERATE GARBAGE WORD THERE FOR NOW
{{JSR{CMGEN{{{GEN VALUE CODE FOR ALTERNATIVE
{{MOV{#OSLB${R6{{LOAD O$SLB POINTER
{{JSR{CDWRD{{{GENERATE O$SLB CALL
{{MOV{4*1(SP){R6{{LOAD OLD CHAIN PTR
{{MOV{CWCOF{4*1(SP){{SET CURRENT LOC AS NEW CHAIN HEAD
{{JSR{CDWRD{{{GENERATE FORWARD CHAIN LINK
{{EJC{{{{
*
* CDGVL (CONTINUED)
*
* NOW TO FILL IN THE SKIP OFFSET TO O$SLC,O$SLD
*
{{MOV{(SP){R9{{LOAD OFFSET TO WORD TO PLUG
{{ADD{R$CCB{R9{{POINT TO ACTUAL LOCATION TO PLUG
{{MOV{CWCOF{(R9){{PLUG PROPER OFFSET IN
{{MOV{#OSLC${R6{{LOAD O$SLC PTR FOR NEXT ALTERNATIVE
{{MOV{R7{R9{{COPY OFFSET (DESTROY GARBAGE XR)
{{ICA{R9{{{BUMP EXTRA TIME FOR TEST
{{BLT{R9{4*CMLEN(R10){CGV16{LOOP BACK IF NOT LAST ALTERNATIVE
*
* HERE TO GENERATE CODE FOR LAST ALTERNATIVE
*
{{MOV{#OSLD${R6{{GET HEADER CALL
{{JSR{CDWRD{{{GENERATE O$SLD CALL
{{JSR{CMGEN{{{GENERATE CODE FOR LAST ALTERNATIVE
{{ICA{SP{{{POP OFFSET PTR
{{MOV{(SP)+{R9{{LOAD CHAIN PTR
*
* LOOP TO PLUG OFFSETS PAST STRUCTURE
*
{CGV17{ADD{R$CCB{R9{{MAKE NEXT PTR ABSOLUTE
{{MOV{(R9){R6{{LOAD FORWARD PTR
{{MOV{CWCOF{(R9){{PLUG REQUIRED OFFSET
{{MOV{R6{R9{{COPY FORWARD PTR
{{BNZ{R6{CGV17{{LOOP BACK IF MORE TO GO
{{BRN{CGV33{{{ELSE JUMP TO EXIT (NOT CONSTANT)
*
* HERE FOR BINARY OPS WITH VALUE OPERANDS
*
{CGV18{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND POINTER
{{JSR{CDGVL{{{GEN VALUE CODE FOR LEFT OPERAND
*
* HERE FOR UNARY OPS WITH VALUE OPERAND (BINOPS MERGE)
*
{CGV19{MOV{4*CMROP(R10){R9{{LOAD RIGHT (ONLY) OPERAND PTR
{{JSR{CDGVL{{{GEN CODE BY VALUE
{{EJC{{{{
*
* CDGVL (CONTINUED)
*
* MERGE HERE TO GENERATE OPERATOR CALL FROM CMOPN FIELD
*
{CGV20{MOV{4*CMOPN(R10){R6{{LOAD OPERATOR CALL POINTER
{{BRN{CGV36{{{JUMP TO GENERATE IT WITH CONS TEST
*
* HERE FOR ASSIGNMENT
*
{CGV21{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND POINTER
{{BLO{(R9){#B$VR${CGV22{JUMP IF NOT VARIABLE
*
* HERE FOR ASSIGNMENT TO SIMPLE VARIABLE
*
{{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND PTR
{{JSR{CDGVL{{{GENERATE CODE BY VALUE
{{MOV{4*CMLOP(R10){R6{{RELOAD LEFT OPERAND VRBLK PTR
{{ADD{#4*VRSTO{R6{{POINT TO VRSTO FIELD
{{BRN{CGV32{{{JUMP TO GENERATE STORE PTR
*
* HERE IF NOT SIMPLE VARIABLE ASSIGNMENT
*
{CGV22{JSR{EXPAP{{{TEST FOR PATTERN MATCH ON LEFT SIDE
{{PPM{CGV23{{{JUMP IF NOT PATTERN MATCH
*
* HERE FOR PATTERN REPLACEMENT
*
{{MOV{4*CMROP(R9){4*CMLOP(R10){{SAVE PATTERN PTR IN SAFE PLACE
{{MOV{4*CMLOP(R9){R9{{LOAD SUBJECT PTR
{{JSR{CDGNM{{{GEN CODE BY NAME FOR SUBJECT
{{MOV{4*CMLOP(R10){R9{{LOAD PATTERN PTR
{{JSR{CDGVL{{{GEN CODE BY VALUE FOR PATTERN
{{MOV{#OPMN${R6{{LOAD MATCH BY NAME CALL
{{JSR{CDWRD{{{GENERATE IT
{{MOV{4*CMROP(R10){R9{{LOAD REPLACEMENT VALUE PTR
{{JSR{CDGVL{{{GEN CODE BY VALUE
{{MOV{#ORPL${R6{{LOAD REPLACE CALL
{{BRN{CGV32{{{JUMP TO GEN AND EXIT (NOT CONSTANT)
*
* HERE FOR ASSIGNMENT TO COMPLEX VARIABLE
*
{CGV23{MNZ{R8{{{INHIBIT PRE-EVALUATION
{{JSR{CDGNM{{{GEN CODE BY NAME FOR LEFT SIDE
{{BRN{CGV31{{{MERGE WITH UNOP CIRCUIT
{{EJC{{{{
*
* CDGVL (CONTINUED)
*
* HERE FOR CONCATENATION
*
{CGV24{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND PTR
{{BNE{(R9){#B$CMT{CGV18{ORDINARY BINOP IF NOT CMBLK
{{MOV{4*CMTYP(R9){R7{{LOAD CMBLK TYPE CODE
{{BEQ{R7{#C$INT{CGV25{SPECIAL CASE IF INTERROGATION
{{BEQ{R7{#C$NEG{CGV25{OR NEGATION
{{BNE{R7{#C$FNC{CGV18{ELSE ORDINARY BINOP IF NOT FUNCTION
{{MOV{4*CMOPN(R9){R9{{ELSE LOAD FUNCTION VRBLK PTR
{{BNZ{4*VRLEN(R9){CGV18{{ORDINARY BINOP IF NOT SYSTEM VAR
{{MOV{4*VRSVP(R9){R9{{ELSE POINT TO SVBLK
{{MOV{4*SVBIT(R9){R6{{LOAD BIT INDICATORS
{{ANB{BTPRD{R6{{TEST FOR PREDICATE FUNCTION
{{ZRB{R6{CGV18{{ORDINARY BINOP IF NOT
*
* HERE IF LEFT ARG OF CONCATENATION IS PREDICATE FUNCTION
*
{CGV25{MOV{4*CMLOP(R10){R9{{RELOAD LEFT ARG
{{JSR{CDGVL{{{GEN CODE BY VALUE
{{MOV{#OPOP${R6{{LOAD POP CALL
{{JSR{CDWRD{{{GENERATE IT
{{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND
{{JSR{CDGVL{{{GEN CODE BY VALUE AS RESULT CODE
{{BRN{CGV33{{{EXIT (NOT CONSTANT)
*
* HERE TO GENERATE CODE FOR PATTERN, IMMEDIATE ASSIGNMENT
*
{CGV26{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND
{{JSR{CDGVL{{{GEN CODE BY VALUE, MERGE
*
* HERE FOR UNOPS WITH ARG BY NAME (BINARY $ . MERGE)
*
{CGV27{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND PTR
{{JSR{CDGNM{{{GEN CODE BY NAME FOR RIGHT ARG
{{MOV{4*CMOPN(R10){R9{{GET OPERATOR CODE WORD
{{BNE{(R9){#O$KWV{CGV20{GEN CALL UNLESS KEYWORD VALUE
{{EJC{{{{
*
* CDGVL (CONTINUED)
*
* HERE FOR KEYWORD BY VALUE. THIS IS CONSTANT ONLY IF
* THE OPERAND IS ONE OF THE SPECIAL SYSTEM VARIABLES WITH
* THE SVCKW BIT SET TO INDICATE A CONSTANT KEYWORD VALUE.
* NOTE THAT THE ONLY CONSTANT OPERAND BY NAME IS A VARIABLE
*
{{BNZ{R8{CGV20{{GEN CALL IF NON-CONSTANT (NOT VAR)
{{MNZ{R8{{{ELSE SET NON-CONSTANT IN CASE
{{MOV{4*CMROP(R10){R9{{LOAD PTR TO OPERAND VRBLK
{{BNZ{4*VRLEN(R9){CGV20{{GEN (NON-CONSTANT) IF NOT SYS VAR
{{MOV{4*VRSVP(R9){R9{{ELSE LOAD PTR TO SVBLK
{{MOV{4*SVBIT(R9){R6{{LOAD BIT MASK
{{ANB{BTCKW{R6{{TEST FOR CONSTANT KEYWORD
{{ZRB{R6{CGV20{{GO GEN IF NOT CONSTANT
{{ZER{R8{{{ELSE SET RESULT CONSTANT
{{BRN{CGV20{{{AND JUMP BACK TO GENERATE CALL
*
* HERE TO GENERATE CODE FOR NEGATION
*
{CGV28{MOV{#ONTA${R6{{GET INITIAL WORD
{{JSR{CDWRD{{{GENERATE IT
{{MOV{CWCOF{R7{{SAVE NEXT OFFSET
{{JSR{CDWRD{{{GENERATE GUNK WORD FOR NOW
{{MOV{4*CMROP(R10){R9{{LOAD RIGHT OPERAND PTR
{{JSR{CDGVL{{{GEN CODE BY VALUE
{{MOV{#ONTB${R6{{LOAD END OF EVALUATION CALL
{{JSR{CDWRD{{{GENERATE IT
{{MOV{R7{R9{{COPY OFFSET TO WORD TO PLUG
{{ADD{R$CCB{R9{{POINT TO ACTUAL WORD TO PLUG
{{MOV{CWCOF{(R9){{PLUG WORD WITH CURRENT OFFSET
{{MOV{#ONTC${R6{{LOAD FINAL CALL
{{BRN{CGV32{{{JUMP TO GENERATE IT (NOT CONSTANT)
*
* HERE TO GENERATE CODE FOR UNDEFINED BINARY OPERATOR
*
{CGV29{MOV{4*CMLOP(R10){R9{{LOAD LEFT OPERAND PTR
{{JSR{CDGVL{{{GENERATE CODE BY VALUE
{{EJC{{{{
*
* CDGVL (CONTINUED)
*
* HERE TO GENERATE CODE FOR UNDEFINED UNARY OPERATOR
*
{CGV30{MOV{#C$UO${R7{{SET UNOP CODE + 1
{{SUB{4*CMTYP(R10){R7{{SET NUMBER OF ARGS (1 OR 2)
*
* MERGE HERE FOR UNDEFINED OPERATORS
*
{{MOV{4*CMROP(R10){R9{{LOAD RIGHT (ONLY) OPERAND POINTER
{{JSR{CDGVL{{{GEN VALUE CODE FOR RIGHT OPERAND
{{MOV{4*CMOPN(R10){R9{{LOAD POINTER TO OPERATOR DV
{{MOV{4*DVOPN(R9){R9{{LOAD POINTER OFFSET
{{WTB{R9{{{CONVERT WORD OFFSET TO BYTES
{{ADD{#R$UBA{R9{{POINT TO PROPER FUNCTION PTR
{{SUB{#4*VRFNC{R9{{SET STANDARD FUNCTION OFFSET
{{BRN{CGV12{{{MERGE WITH FUNCTION CALL CIRCUIT
*
* HERE TO GENERATE CODE FOR INTERROGATION, INDIRECTION
*
{CGV31{MNZ{R8{{{SET NON CONSTANT
{{BRN{CGV19{{{MERGE
*
* HERE TO EXIT GENERATING A WORD, RESULT NOT CONSTANT
*
{CGV32{JSR{CDWRD{{{GENERATE WORD, MERGE
*
* HERE TO EXIT WITH NO WORD GENERATED, NOT CONSTANT
*
{CGV33{MNZ{R8{{{INDICATE RESULT IS NOT CONSTANT
*
* COMMON EXIT POINT
*
{CGV34{ICA{SP{{{POP INITIAL CODE OFFSET
{{MOV{(SP)+{R6{{RESTORE OLD CONSTANT FLAG
{{MOV{(SP)+{R10{{RESTORE ENTRY XL
{{MOV{(SP)+{R7{{RESTORE ENTRY WB
{{BNZ{R8{CGV35{{JUMP IF NOT CONSTANT
{{MOV{R6{R8{{ELSE RESTORE ENTRY CONSTANT FLAG
*
* HERE TO RETURN AFTER DEALING WITH WC SETTING
*
{CGV35{EXI{{{{RETURN TO CDGVL CALLER
*
* EXIT HERE TO GENERATE WORD AND TEST FOR CONSTANT
*
{CGV36{JSR{CDWRD{{{GENERATE WORD
{{BNZ{R8{CGV34{{JUMP TO EXIT IF NOT CONSTANT
{{EJC{{{{
*
* CDGVL (CONTINUED)
*
* HERE TO PREEVALUATE CONSTANT SUB-EXPRESSION
*
{{MOV{#ORVL${R6{{LOAD CALL TO RETURN VALUE
{{JSR{CDWRD{{{GENERATE IT
{{MOV{(SP){R10{{LOAD INITIAL CODE OFFSET
{{JSR{EXBLD{{{BUILD EXBLK FOR EXPRESSION
{{ZER{R7{{{SET TO EVALUATE BY VALUE
{{JSR{EVALX{{{EVALUATE EXPRESSION
{{PPM{{{{SHOULD NOT FAIL
{{MOV{(R9){R6{{LOAD TYPE WORD OF RESULT
{{BLO{R6{#P$AAA{CGV37{JUMP IF NOT PATTERN
{{MOV{#OLPT${R6{{ELSE LOAD SPECIAL PATTERN LOAD CALL
{{JSR{CDWRD{{{GENERATE IT
*
* MERGE HERE TO GENERATE POINTER TO RESULTING CONSTANT
*
{CGV37{MOV{R9{R6{{COPY CONSTANT POINTER
{{JSR{CDWRD{{{GENERATE PTR
{{ZER{R8{{{SET RESULT CONSTANT
{{BRN{CGV34{{{JUMP BACK TO EXIT
{{ENP{{{{END PROCEDURE CDGVL
{{EJC{{{{
*
* CDWRD -- GENERATE ONE WORD OF CODE
*
* CDWRD WRITES ONE WORD INTO THE CURRENT CODE BLOCK UNDER
* CONSTRUCTION. A NEW, LARGER, BLOCK IS ALLOCATED IF THERE
* IS INSUFFICIENT ROOM IN THE CURRENT BLOCK. CDWRD ENSURES
* THAT THERE ARE AT LEAST THREE WORDS LEFT IN THE BLOCK
* AFTER ENTERING THE NEW WORD. THIS GUARANTEES THAT ANY
* EXTRA SPACE AT THE END CAN BE SPLIT OFF AS A CCBLK.
*
* (WA) WORD TO BE GENERATED
* JSR CDWRD CALL TO GENERATE WORD
*
{CDWRD{PRC{E{0{{ENTRY POINT
{{MOV{R9{-(SP){{SAVE ENTRY XR
{{MOV{R6{-(SP){{SAVE CODE WORD TO BE GENERATED
*
* MERGE BACK HERE AFTER ALLOCATING LARGER BLOCK
*
{CDWD1{MOV{R$CCB{R9{{LOAD PTR TO CCBLK BEING BUILT
{{BNZ{R9{CDWD2{{JUMP IF BLOCK ALLOCATED
*
* HERE WE ALLOCATE AN ENTIRELY FRESH BLOCK
*
{{MOV{#4*E$CBS{R6{{LOAD INITIAL LENGTH
{{JSR{ALLOC{{{ALLOCATE CCBLK
{{MOV{#B$CCT{(R9){{STORE TYPE WORD
{{MOV{#4*CCCOD{CWCOF{{SET INITIAL OFFSET
{{MOV{R6{4*CCLEN(R9){{STORE BLOCK LENGTH
{{MOV{R9{R$CCB{{STORE PTR TO NEW BLOCK
*
* HERE WE HAVE A BLOCK WE CAN USE
*
{CDWD2{MOV{CWCOF{R6{{LOAD CURRENT OFFSET
{{ADD{#4*NUM04{R6{{ADJUST FOR TEST (FOUR WORDS)
{{BLO{R6{4*CCLEN(R9){CDWD4{JUMP IF ROOM IN THIS BLOCK
*
* HERE IF NO ROOM IN CURRENT BLOCK
*
{{BGE{R6{MXLEN{CDWD5{JUMP IF ALREADY AT MAX SIZE
{{ADD{#4*E$CBS{R6{{ELSE GET NEW SIZE
{{MOV{R10{-(SP){{SAVE ENTRY XL
{{MOV{R9{R10{{COPY POINTER
{{BLT{R6{MXLEN{CDWD3{JUMP IF NOT TOO LARGE
{{MOV{MXLEN{R6{{ELSE RESET TO MAX ALLOWED SIZE
{{EJC{{{{
*
* CDWRD (CONTINUED)
*
* HERE WITH NEW BLOCK SIZE IN WA
*
{CDWD3{JSR{ALLOC{{{ALLOCATE NEW BLOCK
{{MOV{R9{R$CCB{{STORE POINTER TO NEW BLOCK
{{MOV{#B$CCT{(R9)+{{STORE TYPE WORD IN NEW BLOCK
{{MOV{R6{(R9)+{{STORE BLOCK LENGTH
{{ADD{#4*CCUSE{R10{{POINT TO CCUSE,CCCOD FIELDS IN OLD
{{MOV{(R10){R6{{LOAD CCUSE VALUE
{{MVW{{{{COPY USEFUL WORDS FROM OLD BLOCK
{{MOV{(SP)+{R10{{RESTORE XL
{{BRN{CDWD1{{{MERGE BACK TO TRY AGAIN
*
* HERE WITH ROOM IN CURRENT BLOCK
*
{CDWD4{MOV{CWCOF{R6{{LOAD CURRENT OFFSET
{{ICA{R6{{{GET NEW OFFSET
{{MOV{R6{CWCOF{{STORE NEW OFFSET
{{MOV{R6{4*CCUSE(R9){{STORE IN CCBLK FOR GBCOL
{{DCA{R6{{{RESTORE PTR TO THIS WORD
{{ADD{R6{R9{{POINT TO CURRENT ENTRY
{{MOV{(SP)+{R6{{RELOAD WORD TO GENERATE
{{MOV{R6{(R9){{STORE WORD IN BLOCK
{{MOV{(SP)+{R9{{RESTORE ENTRY XR
{{EXI{{{{RETURN TO CALLER
*
* HERE IF COMPILED CODE IS TOO LONG FOR CDBLK
*
{CDWD5{ERB{213{SYNTAX{{ERROR. STATEMENT IS TOO COMPLICATED.
{{ENP{{{{END PROCEDURE CDWRD
{{EJC{{{{
*
* CMGEN -- GENERATE CODE FOR CMBLK PTR
*
* CMGEN IS A SUBSIDIARY PROCEDURE USED TO GENERATE VALUE
* CODE FOR A CMBLK PTR FROM THE MAIN CODE GENERATORS.
*
* (XL) CMBLK POINTER
* (WB) OFFSET TO POINTER IN CMBLK
* JSR CMGEN CALL TO GENERATE CODE
* (XR,WA) DESTROYED
* (WB) BUMPED BY ONE WORD
*
{CMGEN{PRC{R{0{{ENTRY POINT, RECURSIVE
{{MOV{R10{R9{{COPY CMBLK POINTER
{{ADD{R7{R9{{POINT TO CMBLK POINTER
{{MOV{(R9){R9{{LOAD CMBLK POINTER
{{JSR{CDGVL{{{GENERATE CODE BY VALUE
{{ICA{R7{{{BUMP OFFSET
{{EXI{{{{RETURN TO CALLER
{{ENP{{{{END PROCEDURE CMGEN
{{EJC{{{{
*
* CMPIL (COMPILE SOURCE CODE)
*
* CMPIL IS USED TO CONVERT SNOBOL4 SOURCE CODE TO INTERNAL
* FORM (SEE CDBLK FORMAT). IT IS USED BOTH FOR THE INITIAL
* COMPILE AND AT RUN TIME BY THE CODE AND CONVERT FUNCTIONS
* THIS PROCEDURE HAS CONTROL FOR THE ENTIRE DURATION OF
* INITIAL COMPILATION. AN ERROR IN ANY PROCEDURE CALLED
* DURING COMPILATION WILL LEAD FIRST TO THE ERROR SECTION
* AND ULTIMATELY BACK HERE FOR RESUMED COMPILATION. THE
* RE-ENTRY POINTS AFTER AN ERROR ARE SPECIALLY LABELLED -
*
* CMPCE RESUME AFTER CONTROL CARD ERROR
* CMPLE RESUME AFTER LABEL ERROR
* CMPSE RESUME AFTER STATEMENT ERROR
*
* JSR CMPIL CALL TO COMPILE CODE
* (XR) PTR TO CDBLK FOR ENTRY STATEMENT
* (XL,WA,WB,WC,RA) DESTROYED
*
* THE FOLLOWING GLOBAL VARIABLES ARE REFERENCED
*
* CMPSN NUMBER OF NEXT STATEMENT
* TO BE COMPILED.
*
* CSWXX CONTROL CARD SWITCH VALUES ARE
* CHANGED WHEN RELEVANT CONTROL
* CARDS ARE MET.
*
* CWCOF OFFSET TO NEXT WORD IN CODE BLOCK
* BEING BUILT (SEE CDWRD).
*
* LSTSN NUMBER OF STATEMENT MOST RECENTLY
* COMPILED (INITIALLY SET TO ZERO).
*
* R$CIM CURRENT (INITIAL) COMPILER IMAGE
* (ZERO FOR INITIAL COMPILE CALL)
*
* R$CNI USED TO POINT TO FOLLOWING IMAGE.
* (SEE READR PROCEDURE).
*
* SCNGO GOTO SWITCH FOR SCANE PROCEDURE
*
* SCNIL LENGTH OF CURRENT IMAGE EXCLUDING
* CHARACTERS REMOVED BY -INPUT.
*
* SCNPT CURRENT SCAN OFFSET, SEE SCANE.
*
* SCNRS RESCAN SWITCH FOR SCANE PROCEDURE.
*
* SCNSE OFFSET (IN R$CIM) OF MOST RECENTLY
* SCANNED ELEMENT. SET ZERO IF NOT
* CURRENTLY SCANNING ITEMS
{{EJC{{{{
*
* CMPIL (CONTINUED)
*
* STAGE STGIC INITIAL COMPILE IN PROGRESS
* STGXC CODE/CONVERT COMPILE
* STGEV BUILDING EXBLK FOR EVAL
* STGXT EXECUTE TIME (OUTSIDE COMPILE)
* STGCE INITIAL COMPILE AFTER END LINE
* STGXE EXECUTE COMPILE AFTER END LINE
*
* CMPIL ALSO USES A FIXED NUMBER OF LOCATIONS ON THE
* MAIN STACK AS FOLLOWS. (THE DEFINITIONS OF THE ACTUAL
* OFFSETS ARE IN THE DEFINITIONS SECTION).
*
* CMSTM(XS) POINTER TO EXPAN TREE FOR BODY OF
* STATEMENT (SEE EXPAN PROCEDURE).
*
* CMSGO(XS) POINTER TO TREE REPRESENTATION OF
* SUCCESS GOTO (SEE PROCEDURE SCNGO)9
* ZERO IF NO SUCCESS GOTO IS GIVEN
*
* CMFGO(XS) LIKE CMSGO FOR FAILURE GOTO.
*
* CMCGO(XS) SET NON-ZERO ONLY IF THERE IS A
* CONDITIONAL GOTO. USED FOR -FAIL,
* -NOFAIL CODE GENERATION.
*
* CMPCD(XS) POINTER TO CDBLK FOR PREVIOUS
* STATEMENT. ZERO FOR 1ST STATEMENT.
*
* CMFFP(XS) SET NON-ZERO IF CDFAL IN PREVIOUS
* CDBLK NEEDS FILLING WITH FORWARD
* POINTER, ELSE SET TO ZERO.
*
* CMFFC(XS) SAME AS CMFFP FOR CURRENT CDBLK
*
* CMSOP(XS) OFFSET TO WORD IN PREVIOUS CDBLK
* TO BE FILLED IN WITH FORWARD PTR
* TO NEXT CDBLK FOR SUCCESS GOTO.
* ZERO IF NO FILL IN IS REQUIRED.
*
* CMSOC(XS) SAME AS CMSOP FOR CURRENT CDBLK.
*
* CMLBL(XS) POINTER TO VRBLK FOR LABEL OF
* CURRENT STATEMENT. ZERO IF NO LABEL
*
* CMTRA(XS) POINTER TO CDBLK FOR ENTRY STMNT.
{{EJC{{{{
*
* CMPIL (CONTINUED)
*
* ENTRY POINT
*
{CMPIL{PRC{E{0{{ENTRY POINT
{{LCT{R7{#CMNEN{{SET NUMBER OF STACK WORK LOCATIONS
*
* LOOP TO INITIALIZE STACK WORKING LOCATIONS
*
{CMP00{ZER{-(SP){{{STORE A ZERO, MAKE ONE ENTRY
{{BCT{R7{CMP00{{LOOP BACK UNTIL ALL SET
{{MOV{SP{CMPXS{{SAVE STACK POINTER FOR ERROR SEC
{{SSS{CMPSS{{{SAVE S-R STACK POINTER IF ANY
*
* LOOP THROUGH STATEMENTS
*
{CMP01{MOV{SCNPT{R7{{SET SCAN POINTER OFFSET
{{MOV{R7{SCNSE{{SET START OF ELEMENT LOCATION
{{MOV{#OCER${R6{{POINT TO COMPILE ERROR CALL
{{JSR{CDWRD{{{GENERATE AS TEMPORARY CDFAL
{{BLT{R7{SCNIL{CMP04{JUMP IF CHARS LEFT ON THIS IMAGE
*
* LOOP HERE AFTER COMMENT OR CONTROL CARD
* ALSO SPECIAL ENTRY AFTER CONTROL CARD ERROR
*
{CMPCE{ZER{R9{{{CLEAR POSSIBLE GARBAGE XR VALUE
{{BNE{STAGE{#STGIC{CMP02{SKIP UNLESS INITIAL COMPILE
{{JSR{READR{{{READ NEXT INPUT IMAGE
{{BZE{R9{CMP09{{JUMP IF NO INPUT AVAILABLE
{{JSR{NEXTS{{{ACQUIRE NEXT SOURCE IMAGE
{{MOV{CMPSN{LSTSN{{STORE STMT NO FOR USE BY LISTR
{{ZER{SCNPT{{{RESET SCAN POINTER
{{BRN{CMP04{{{GO PROCESS IMAGE
*
* FOR EXECUTE TIME COMPILE, PERMIT EMBEDDED CONTROL CARDS
* AND COMMENTS (BY SKIPPING TO NEXT SEMI-COLON)
*
{CMP02{MOV{R$CIM{R9{{GET CURRENT IMAGE
{{MOV{SCNPT{R7{{GET CURRENT OFFSET
{{PLC{R9{R7{{PREPARE TO GET CHARS
*
* SKIP TO SEMI-COLON
*
{CMP03{LCH{R8{(R9)+{{GET CHAR
{{ICV{SCNPT{{{ADVANCE OFFSET
{{BEQ{R8{#CH$SM{CMP04{SKIP IF SEMI-COLON FOUND
{{BLT{SCNPT{SCNIL{CMP03{LOOP IF MORE CHARS
{{ZER{R9{{{CLEAR GARBAGE XR VALUE
{{BRN{CMP09{{{END OF IMAGE
{{EJC{{{{
*
* CMPIL (CONTINUED)
*
* HERE WITH IMAGE AVAILABLE TO SCAN. NOTE THAT IF THE INPUT
* STRING IS NULL, THEN EVERYTHING IS OK SINCE NULL IS
* ACTUALLY ASSEMBLED AS A WORD OF BLANKS.
*
{CMP04{MOV{R$CIM{R9{{POINT TO CURRENT IMAGE
{{MOV{SCNPT{R7{{LOAD CURRENT OFFSET
{{MOV{R7{R6{{COPY FOR LABEL SCAN
{{PLC{R9{R7{{POINT TO FIRST CHARACTER
{{LCH{R8{(R9)+{{LOAD FIRST CHARACTER
{{BEQ{R8{#CH$SM{CMP12{NO LABEL IF SEMICOLON
{{BEQ{R8{#CH$AS{CMPCE{LOOP BACK IF COMMENT CARD
{{BEQ{R8{#CH$MN{CMP32{JUMP IF CONTROL CARD
{{MOV{R$CIM{R$CMP{{ABOUT TO DESTROY R$CIM
{{MOV{#CMLAB{R10{{POINT TO LABEL WORK STRING
{{MOV{R10{R$CIM{{SCANE IS TO SCAN WORK STRING
{{PSC{R10{{{POINT TO FIRST CHARACTER POSITION
{{SCH{R8{(R10)+{{STORE CHAR JUST LOADED
{{MOV{#CH$SM{R8{{GET A SEMICOLON
{{SCH{R8{(R10){{STORE AFTER FIRST CHAR
{{CSC{R10{{{FINISHED CHARACTER STORING
{{ZER{R10{{{CLEAR POINTER
{{ZER{SCNPT{{{START AT FIRST CHARACTER
{{MOV{SCNIL{-(SP){{PRESERVE IMAGE LENGTH
{{MOV{#NUM02{SCNIL{{READ 2 CHARS AT MOST
{{JSR{SCANE{{{SCAN FIRST CHAR FOR TYPE
{{MOV{(SP)+{SCNIL{{RESTORE IMAGE LENGTH
{{MOV{R10{R8{{NOTE RETURN CODE
{{MOV{R$CMP{R10{{GET OLD R$CIM
{{MOV{R10{R$CIM{{PUT IT BACK
{{MOV{R7{SCNPT{{REINSTATE OFFSET
{{BNZ{SCNBL{CMP12{{BLANK SEEN - CANT BE LABEL
{{MOV{R10{R9{{POINT TO CURRENT IMAGE
{{PLC{R9{R7{{POINT TO FIRST CHAR AGAIN
{{BEQ{R8{#T$VAR{CMP06{OK IF LETTER
{{BEQ{R8{#T$CON{CMP06{OK IF DIGIT
*
* DROP IN OR JUMP FROM ERROR SECTION IF SCANE FAILED
*
{CMPLE{MOV{R$CMP{R$CIM{{POINT TO BAD LINE
{{ERB{214{BAD{{LABEL OR MISPLACED CONTINUATION LINE
*
* LOOP TO SCAN LABEL
*
{CMP05{BEQ{R8{#CH$SM{CMP07{SKIP IF SEMICOLON
{{ICV{R6{{{BUMP OFFSET
{{BEQ{R6{SCNIL{CMP07{JUMP IF END OF IMAGE (LABEL END)
{{EJC{{{{
*
* CMPIL (CONTINUED)
*
* ENTER LOOP AT THIS POINT
*
{CMP06{LCH{R8{(R9)+{{ELSE LOAD NEXT CHARACTER
{{BEQ{R8{#CH$HT{CMP07{JUMP IF HORIZONTAL TAB
{{BNE{R8{#CH$BL{CMP05{LOOP BACK IF NON-BLANK
*
* HERE AFTER SCANNING OUT LABEL
*
{CMP07{MOV{R6{SCNPT{{SAVE UPDATED SCAN OFFSET
{{SUB{R7{R6{{GET LENGTH OF LABEL
{{BZE{R6{CMP12{{SKIP IF LABEL LENGTH ZERO
{{ZER{R9{{{CLEAR GARBAGE XR VALUE
{{JSR{SBSTR{{{BUILD SCBLK FOR LABEL NAME
{{JSR{GTNVR{{{LOCATE/CONTRUCT VRBLK
{{PPM{{{{DUMMY (IMPOSSIBLE) ERROR RETURN
{{MOV{R9{4*CMLBL(SP){{STORE LABEL POINTER
{{BNZ{4*VRLEN(R9){CMP11{{JUMP IF NOT SYSTEM LABEL
{{BNE{4*VRSVP(R9){#V$END{CMP11{JUMP IF NOT END LABEL
*
* HERE FOR END LABEL SCANNED OUT
*
{{ADD{#STGND{STAGE{{ADJUST STAGE APPROPRIATELY
{{JSR{SCANE{{{SCAN OUT NEXT ELEMENT
{{BEQ{R10{#T$SMC{CMP10{JUMP IF END OF IMAGE
{{BNE{R10{#T$VAR{CMP08{ELSE ERROR IF NOT VARIABLE
*
* HERE CHECK FOR VALID INITIAL TRANSFER
*
{{BEQ{4*VRLBL(R9){#STNDL{CMP08{JUMP IF NOT DEFINED (ERROR)
{{MOV{4*VRLBL(R9){4*CMTRA(SP){{ELSE SET INITIAL ENTRY POINTER
{{JSR{SCANE{{{SCAN NEXT ELEMENT
{{BEQ{R10{#T$SMC{CMP10{JUMP IF OK (END OF IMAGE)
*
* HERE FOR BAD TRANSFER LABEL
*
{CMP08{ERB{215{SYNTAX{{ERROR. UNDEFINED OR ERRONEOUS ENTRY LABEL
*
* HERE FOR END OF INPUT (NO END LABEL DETECTED)
*
{CMP09{ADD{#STGND{STAGE{{ADJUST STAGE APPROPRIATELY
{{BEQ{STAGE{#STGXE{CMP10{JUMP IF CODE CALL (OK)
{{ERB{216{SYNTAX{{ERROR. MISSING END LINE
*
* HERE AFTER PROCESSING END LINE (MERGE HERE ON END ERROR)
*
{CMP10{MOV{#OSTP${R6{{SET STOP CALL POINTER
{{JSR{CDWRD{{{GENERATE AS STATEMENT CALL
{{BRN{CMPSE{{{JUMP TO GENERATE AS FAILURE
{{EJC{{{{
*
* CMPIL (CONTINUED)
*
* HERE AFTER PROCESSING LABEL OTHER THAN END
*
{CMP11{BNE{STAGE{#STGIC{CMP12{JUMP IF CODE CALL - REDEF. OK
{{BEQ{4*VRLBL(R9){#STNDL{CMP12{ELSE CHECK FOR REDEFINITION
{{ZER{4*CMLBL(SP){{{LEAVE FIRST LABEL DECLN UNDISTURBED
{{ERB{217{SYNTAX{{ERROR. DUPLICATE LABEL
*
* HERE AFTER DEALING WITH LABEL
*
{CMP12{ZER{R7{{{SET FLAG FOR STATEMENT BODY
{{JSR{EXPAN{{{GET TREE FOR STATEMENT BODY
{{MOV{R9{4*CMSTM(SP){{STORE FOR LATER USE
{{ZER{4*CMSGO(SP){{{CLEAR SUCCESS GOTO POINTER
{{ZER{4*CMFGO(SP){{{CLEAR FAILURE GOTO POINTER
{{ZER{4*CMCGO(SP){{{CLEAR CONDITIONAL GOTO FLAG
{{JSR{SCANE{{{SCAN NEXT ELEMENT
{{BNE{R10{#T$COL{CMP18{JUMP IT NOT COLON (NO GOTO)
*
* LOOP TO PROCESS GOTO FIELDS
*
{CMP13{MNZ{SCNGO{{{SET GOTO FLAG
{{JSR{SCANE{{{SCAN NEXT ELEMENT
{{BEQ{R10{#T$SMC{CMP31{JUMP IF NO FIELDS LEFT
{{BEQ{R10{#T$SGO{CMP14{JUMP IF S FOR SUCCESS GOTO
{{BEQ{R10{#T$FGO{CMP16{JUMP IF F FOR FAILURE GOTO
*
* HERE FOR UNCONDITIONAL GOTO (I.E. NOT F OR S)
*
{{MNZ{SCNRS{{{SET TO RESCAN ELEMENT NOT F,S
{{JSR{SCNGF{{{SCAN OUT GOTO FIELD
{{BNZ{4*CMFGO(SP){CMP17{{ERROR IF FGOTO ALREADY
{{MOV{R9{4*CMFGO(SP){{ELSE SET AS FGOTO
{{BRN{CMP15{{{MERGE WITH SGOTO CIRCUIT
*
* HERE FOR SUCCESS GOTO
*
{CMP14{JSR{SCNGF{{{SCAN SUCCESS GOTO FIELD
{{MOV{#NUM01{4*CMCGO(SP){{SET CONDITIONAL GOTO FLAG
*
* UNCONTIONAL GOTO MERGES HERE
*
{CMP15{BNZ{4*CMSGO(SP){CMP17{{ERROR IF SGOTO ALREADY GIVEN
{{MOV{R9{4*CMSGO(SP){{ELSE SET SGOTO
{{BRN{CMP13{{{LOOP BACK FOR NEXT GOTO FIELD
*
* HERE FOR FAILURE GOTO
*
{CMP16{JSR{SCNGF{{{SCAN GOTO FIELD
{{MOV{#NUM01{4*CMCGO(SP){{SET CONDITONAL GOTO FLAG
{{BNZ{4*CMFGO(SP){CMP17{{ERROR IF FGOTO ALREADY GIVEN
{{MOV{R9{4*CMFGO(SP){{ELSE STORE FGOTO POINTER
{{BRN{CMP13{{{LOOP BACK FOR NEXT FIELD
{{EJC{{{{
*
* CMPIL (CONTINUED)
*
* HERE FOR DUPLICATED GOTO FIELD
*
{CMP17{ERB{218{SYNTAX{{ERROR. DUPLICATED GOTO FIELD
*
* HERE TO GENERATE CODE
*
{CMP18{ZER{SCNSE{{{STOP POSITIONAL ERROR FLAGS
{{MOV{4*CMSTM(SP){R9{{LOAD TREE PTR FOR STATEMENT BODY
{{ZER{R7{{{COLLECTABLE VALUE FOR WB FOR CDGVL
{{ZER{R8{{{RESET CONSTANT FLAG FOR CDGVL
{{JSR{EXPAP{{{TEST FOR PATTERN MATCH
{{PPM{CMP19{{{JUMP IF NOT PATTERN MATCH
{{MOV{#OPMS${4*CMOPN(R9){{ELSE SET PATTERN MATCH POINTER
{{MOV{#C$PMT{4*CMTYP(R9){{
*
* HERE AFTER DEALING WITH SPECIAL PATTERN MATCH CASE
*
{CMP19{JSR{CDGVL{{{GENERATE CODE FOR BODY OF STATEMENT
{{MOV{4*CMSGO(SP){R9{{LOAD SGOTO POINTER
{{MOV{R9{R6{{COPY IT
{{BZE{R9{CMP21{{JUMP IF NO SUCCESS GOTO
{{ZER{4*CMSOC(SP){{{CLEAR SUCCESS OFFSET FILLIN PTR
{{BHI{R9{STATE{CMP20{JUMP IF COMPLEX GOTO
*
* HERE FOR SIMPLE SUCCESS GOTO (LABEL)
*
{{ADD{#4*VRTRA{R6{{POINT TO VRTRA FIELD AS REQUIRED
{{JSR{CDWRD{{{GENERATE SUCCESS GOTO
{{BRN{CMP22{{{JUMP TO DEAL WITH FGOTO
*
* HERE FOR COMPLEX SUCCESS GOTO
*
{CMP20{BEQ{R9{4*CMFGO(SP){CMP22{NO CODE IF SAME AS FGOTO
{{ZER{R7{{{ELSE SET OK VALUE FOR CDGVL IN WB
{{JSR{CDGCG{{{GENERATE CODE FOR SUCCESS GOTO
{{BRN{CMP22{{{JUMP TO DEAL WITH FGOTO
*
* HERE FOR NO SUCCESS GOTO
*
{CMP21{MOV{CWCOF{4*CMSOC(SP){{SET SUCCESS FILL IN OFFSET
{{MOV{#OCER${R6{{POINT TO COMPILE ERROR CALL
{{JSR{CDWRD{{{GENERATE AS TEMPORARY VALUE
{{EJC{{{{
*
* CMPIL (CONTINUED)
*
* HERE TO DEAL WITH FAILURE GOTO
*
{CMP22{MOV{4*CMFGO(SP){R9{{LOAD FAILURE GOTO POINTER
{{MOV{R9{R6{{COPY IT
{{ZER{4*CMFFC(SP){{{SET NO FILL IN REQUIRED YET
{{BZE{R9{CMP23{{JUMP IF NO FAILURE GOTO GIVEN
{{ADD{#4*VRTRA{R6{{POINT TO VRTRA FIELD IN CASE
{{BLO{R9{STATE{CMPSE{JUMP TO GEN IF SIMPLE FGOTO
*
* HERE FOR COMPLEX FAILURE GOTO
*
{{MOV{CWCOF{R7{{SAVE OFFSET TO O$GOF CALL
{{MOV{#OGOF${R6{{POINT TO FAILURE GOTO CALL
{{JSR{CDWRD{{{GENERATE
{{MOV{#OFIF${R6{{POINT TO FAIL IN FAIL WORD
{{JSR{CDWRD{{{GENERATE
{{JSR{CDGCG{{{GENERATE CODE FOR FAILURE GOTO
{{MOV{R7{R6{{COPY OFFSET TO O$GOF FOR CDFAL
{{MOV{#B$CDC{R7{{SET COMPLEX CASE CDTYP
{{BRN{CMP25{{{JUMP TO BUILD CDBLK
*
* HERE IF NO FAILURE GOTO GIVEN
*
{CMP23{MOV{#OUNF${R6{{LOAD UNEXPECTED FAILURE CALL IN CAS
{{MOV{CSWFL{R8{{GET -NOFAIL FLAG
{{ORB{4*CMCGO(SP){R8{{CHECK IF CONDITIONAL GOTO
{{ZRB{R8{CMPSE{{JUMP IF -NOFAIL AND NO COND. GOTO
{{MNZ{4*CMFFC(SP){{{ELSE SET FILL IN FLAG
{{MOV{#OCER${R6{{AND SET COMPILE ERROR FOR TEMPORARY
*
* MERGE HERE WITH CDFAL VALUE IN WA, SIMPLE CDBLK
* ALSO SPECIAL ENTRY AFTER STATEMENT ERROR
*
{CMPSE{MOV{#B$CDS{R7{{SET CDTYP FOR SIMPLE CASE
{{EJC{{{{
*
* CMPIL (CONTINUED)
*
* MERGE HERE TO BUILD CDBLK
*
* (WA) CDFAL VALUE TO BE GENERATED
* (WB) CDTYP VALUE TO BE GENERATED
*
* AT THIS STAGE, WE CHOP OFF AN APPROPRIATE CHUNK OF THE
* CURRENT CCBLK AND CONVERT IT INTO A CDBLK. THE REMAINDER
* OF THE CCBLK IS REFORMATTED TO BE THE NEW CCBLK.
*
{CMP25{MOV{R$CCB{R9{{POINT TO CCBLK
{{MOV{4*CMLBL(SP){R10{{GET POSSIBLE LABEL POINTER
{{BZE{R10{CMP26{{SKIP IF NO LABEL
{{ZER{4*CMLBL(SP){{{CLEAR FLAG FOR NEXT STATEMENT
{{MOV{R9{4*VRLBL(R10){{PUT CDBLK PTR IN VRBLK LABEL FIELD
*
* MERGE AFTER DOING LABEL
*
{CMP26{MOV{R7{(R9){{SET TYPE WORD FOR NEW CDBLK
{{MOV{R6{4*CDFAL(R9){{SET FAILURE WORD
{{MOV{R9{R10{{COPY POINTER TO CCBLK
{{MOV{4*CCUSE(R9){R7{{LOAD LENGTH GEN (= NEW CDLEN)
{{MOV{4*CCLEN(R9){R8{{LOAD TOTAL CCBLK LENGTH
{{ADD{R7{R10{{POINT PAST CDBLK
{{SUB{R7{R8{{GET LENGTH LEFT FOR CHOP OFF
{{MOV{#B$CCT{(R10){{SET TYPE CODE FOR NEW CCBLK AT END
{{MOV{#4*CCCOD{4*CCUSE(R10){{SET INITIAL CODE OFFSET
{{MOV{#4*CCCOD{CWCOF{{REINITIALISE CWCOF
{{MOV{R8{4*CCLEN(R10){{SET NEW LENGTH
{{MOV{R10{R$CCB{{SET NEW CCBLK POINTER
{{MOV{CMPSN{4*CDSTM(R9){{SET STATEMENT NUMBER
{{ICV{CMPSN{{{BUMP STATEMENT NUMBER
*
* SET POINTERS IN PREVIOUS CODE BLOCK AS REQUIRED
*
{{MOV{4*CMPCD(SP){R10{{LOAD PTR TO PREVIOUS CDBLK
{{BZE{4*CMFFP(SP){CMP27{{JUMP IF NO FAILURE FILL IN REQUIRED
{{MOV{R9{4*CDFAL(R10){{ELSE SET FAILURE PTR IN PREVIOUS
*
* HERE TO DEAL WITH SUCCESS FORWARD POINTER
*
{CMP27{MOV{4*CMSOP(SP){R6{{LOAD SUCCESS OFFSET
{{BZE{R6{CMP28{{JUMP IF NO FILL IN REQUIRED
{{ADD{R6{R10{{ELSE POINT TO FILL IN LOCATION
{{MOV{R9{(R10){{STORE FORWARD POINTER
{{ZER{R10{{{CLEAR GARBAGE XL VALUE
{{EJC{{{{
*
* CMPIL (CONTINUED)
*
* NOW SET FILL IN POINTERS FOR THIS STATEMENT
*
{CMP28{MOV{4*CMFFC(SP){4*CMFFP(SP){{COPY FAILURE FILL IN FLAG
{{MOV{4*CMSOC(SP){4*CMSOP(SP){{COPY SUCCESS FILL IN OFFSET
{{MOV{R9{4*CMPCD(SP){{SAVE PTR TO THIS CDBLK
{{BNZ{4*CMTRA(SP){CMP29{{JUMP IF INITIAL ENTRY ALREADY SET
{{MOV{R9{4*CMTRA(SP){{ELSE SET PTR HERE AS DEFAULT
*
* HERE AFTER COMPILING ONE STATEMENT
*
{CMP29{BLT{STAGE{#STGCE{CMP01{JUMP IF NOT END LINE JUST DONE
{{BZE{CSWLS{CMP30{{SKIP IF -NOLIST
{{JSR{LISTR{{{LIST LAST LINE
*
* RETURN
*
{CMP30{MOV{4*CMTRA(SP){R9{{LOAD INITIAL ENTRY CDBLK POINTER
{{ADD{#4*CMNEN{SP{{POP WORK LOCATIONS OFF STACK
{{EXI{{{{AND RETURN TO CMPIL CALLER
*
* HERE AT END OF GOTO FIELD
*
{CMP31{MOV{4*CMFGO(SP){R7{{GET FAIL GOTO
{{ORB{4*CMSGO(SP){R7{{OR IN SUCCESS GOTO
{{BNZ{R7{CMP18{{OK IF NON-NULL FIELD
{{ERB{219{SYNTAX{{ERROR. EMPTY GOTO FIELD
*
* CONTROL CARD FOUND
*
{CMP32{ICV{R7{{{POINT PAST CH$MN
{{JSR{CNCRD{{{PROCESS CONTROL CARD
{{ZER{SCNSE{{{CLEAR START OF ELEMENT LOC.
{{BRN{CMPCE{{{LOOP FOR NEXT STATEMENT
{{ENP{{{{END PROCEDURE CMPIL
{{EJC{{{{
*
* CNCRD -- CONTROL CARD PROCESSOR
*
* CALLED TO DEAL WITH CONTROL CARDS
*
* R$CIM POINTS TO CURRENT IMAGE
* (WB) OFFSET TO 1ST CHAR OF CONTROL CARD
* JSR CNCRD CALL TO PROCESS CONTROL CARDS
* (XL,XR,WA,WB,WC,IA) DESTROYED
*
{CNCRD{PRC{E{0{{ENTRY POINT
{{MOV{R7{SCNPT{{OFFSET FOR CONTROL CARD SCAN
{{MOV{#CCNOC{R6{{NUMBER OF CHARS FOR COMPARISON
{{CTW{R6{0{{CONVERT TO WORD COUNT
{{MOV{R6{CNSWC{{SAVE WORD COUNT
*
* LOOP HERE IF MORE THAN ONE CONTROL CARD
*
{CNC01{BGE{SCNPT{SCNIL{CNC09{RETURN IF END OF IMAGE
{{MOV{R$CIM{R9{{POINT TO IMAGE
{{PLC{R9{SCNPT{{CHAR PTR FOR FIRST CHAR
{{LCH{R6{(R9)+{{GET FIRST CHAR
{{FLC{R6{{{FOLD TO UPPER CASE
{{BEQ{R6{#CH$LI{CNC07{SPECIAL CASE OF -INXXX
{{MNZ{SCNCC{{{SET FLAG FOR SCANE
{{JSR{SCANE{{{SCAN CARD NAME
{{ZER{SCNCC{{{CLEAR SCANE FLAG
{{BNZ{R10{CNC06{{FAIL UNLESS CONTROL CARD NAME
{{MOV{#CCNOC{R6{{NO. OF CHARS TO BE COMPARED
{{BLT{4*SCLEN(R9){R6{CNC06{FAIL IF TOO FEW CHARS
{{MOV{R9{R10{{POINT TO CONTROL CARD NAME
{{ZER{R7{{{ZERO OFFSET FOR SUBSTRING
{{JSR{SBSTR{{{EXTRACT SUBSTRING FOR COMPARISON
{{MOV{4*SCLEN(R9){R6{{RELOAD LENGTH
{{JSR{FLSTG{{{FOLD TO UPPER CASE
{{MOV{R9{CNSCC{{KEEP CONTROL CARD SUBSTRING PTR
{{MOV{#CCNMS{R9{{POINT TO LIST OF STANDARD NAMES
{{ZER{R7{{{INITIALISE NAME OFFSET
{{LCT{R8{#CC$NC{{NUMBER OF STANDARD NAMES
*
* TRY TO MATCH NAME
*
{CNC02{MOV{CNSCC{R10{{POINT TO NAME
{{LCT{R6{CNSWC{{COUNTER FOR INNER LOOP
{{BRN{CNC04{{{JUMP INTO LOOP
*
* INNER LOOP TO MATCH CARD NAME CHARS
*
{CNC03{ICA{R9{{{BUMP STANDARD NAMES PTR
{{ICA{R10{{{BUMP NAME POINTER
*
* HERE TO INITIATE THE LOOP
*
{CNC04{CNE{4*SCHAR(R10){(R9){CNC05{COMP. UP TO CFP$C CHARS AT ONCE
{{BCT{R6{CNC03{{LOOP IF MORE WORDS TO COMPARE
{{EJC{{{{
*
* CNCRD (CONTINUED)
*
* MATCHED - BRANCH ON CARD OFFSET
*
{{MOV{R7{R10{{GET NAME OFFSET
{{BSW{R10{CC$NC{{SWITCH
{{IFF{CC$CA{CNC37{{-CASE
{{IFF{CC$DO{CNC10{{-DOUBLE
{{IFF{CC$DU{CNC11{{-DUMP
{{IFF{CC$EJ{CNC12{{-EJECT
{{IFF{CC$ER{CNC13{{-ERRORS
{{IFF{CC$EX{CNC14{{-EXECUTE
{{IFF{CC$FA{CNC15{{-FAIL
{{IFF{CC$LI{CNC16{{-LIST
{{IFF{CC$NR{CNC17{{-NOERRORS
{{IFF{CC$NX{CNC18{{-NOEXECUTE
{{IFF{CC$NF{CNC19{{-NOFAIL
{{IFF{CC$NL{CNC20{{-NOLIST
{{IFF{CC$NO{CNC21{{-NOOPT
{{IFF{CC$NP{CNC22{{-NOPRINT
{{IFF{CC$OP{CNC24{{-OPTIMISE
{{IFF{CC$PR{CNC25{{-PRINT
{{IFF{CC$SI{CNC27{{-SINGLE
{{IFF{CC$SP{CNC28{{-SPACE
{{IFF{CC$ST{CNC31{{-STITLE
{{IFF{CC$TI{CNC32{{-TITLE
{{IFF{CC$TR{CNC36{{-TRACE
{{ESW{{{{END SWITCH
*
* NOT MATCHED YET. ALIGN STD NAMES PTR AND TRY AGAIN
*
{CNC05{ICA{R9{{{BUMP STANDARD NAMES PTR
{{BCT{R6{CNC05{{LOOP
{{ICV{R7{{{BUMP NAMES OFFSET
{{BCT{R8{CNC02{{CONTINUE IF MORE NAMES
*
* INVALID CONTROL CARD NAME
*
{CNC06{ERB{247{INVALID{{CONTROL CARD
*
* SPECIAL PROCESSING FOR -INXXX
*
{CNC07{LCH{R6{(R9){{GET NEXT CHAR
{{FLC{R6{{{FOLD TO UPPER CASE
{{BNE{R6{#CH$LN{CNC06{FAIL IF NOT LETTER N
{{ADD{#NUM02{SCNPT{{BUMP OFFSET PAST -IN
{{JSR{SCANE{{{SCAN INTEGER AFTER -IN
{{MOV{R9{-(SP){{STACK SCANNED ITEM
{{JSR{GTSMI{{{CHECK IF INTEGER
{{PPM{CNC06{{{FAIL IF NOT INTEGER
{{PPM{CNC06{{{FAIL IF NEGATIVE OR LARGE
{{MOV{R9{CSWIN{{KEEP INTEGER
{{EJC{{{{
*
* CNCRD (CONTINUED)
*
* CHECK FOR MORE CONTROL CARDS BEFORE RETURNING
*
{CNC08{MOV{SCNPT{R6{{PRESERVE IN CASE XEQ TIME COMPILE
{{JSR{SCANE{{{LOOK FOR COMMA
{{BEQ{R10{#T$CMA{CNC01{LOOP IF COMMA FOUND
{{MOV{R6{SCNPT{{RESTORE SCNPT IN CASE XEQ TIME
*
* RETURN POINT
*
{CNC09{EXI{{{{RETURN
*
* -DOUBLE
*
{CNC10{MNZ{CSWDB{{{SET SWITCH
{{BRN{CNC08{{{MERGE
*
* -DUMP
* THIS IS USED FOR SYSTEM DEBUGGING . IT HAS THE EFFECT OF
* PRODUCING A CORE DUMP AT COMPILATION TIME
*
{CNC11{JSR{SYSDM{{{CALL DUMPER
{{BRN{CNC09{{{FINISHED
*
* -EJECT
*
{CNC12{BZE{CSWLS{CNC09{{RETURN IF -NOLIST
{{JSR{PRTPS{{{EJECT
{{JSR{LISTT{{{LIST TITLE
{{BRN{CNC09{{{FINISHED
*
* -ERRORS
*
{CNC13{ZER{CSWER{{{CLEAR SWITCH
{{BRN{CNC08{{{MERGE
*
* -EXECUTE
*
{CNC14{ZER{CSWEX{{{CLEAR SWITCH
{{BRN{CNC08{{{MERGE
*
* -FAIL
*
{CNC15{MNZ{CSWFL{{{SET SWITCH
{{BRN{CNC08{{{MERGE
*
* -LIST
*
{CNC16{MNZ{CSWLS{{{SET SWITCH
{{BEQ{STAGE{#STGIC{CNC08{DONE IF COMPILE TIME
*
* LIST CODE LINE IF EXECUTE TIME COMPILE
*
{{ZER{LSTPF{{{PERMIT LISTING
{{JSR{LISTR{{{LIST LINE
{{BRN{CNC08{{{MERGE
{{EJC{{{{
*
* CNCRD (CONTINUED)
*
* -NOERRORS
*
{CNC17{MNZ{CSWER{{{SET SWITCH
{{BRN{CNC08{{{MERGE
*
* -NOEXECUTE
*
{CNC18{MNZ{CSWEX{{{SET SWITCH
{{BRN{CNC08{{{MERGE
*
* -NOFAIL
*
{CNC19{ZER{CSWFL{{{CLEAR SWITCH
{{BRN{CNC08{{{MERGE
*
* -NOLIST
*
{CNC20{ZER{CSWLS{{{CLEAR SWITCH
{{BRN{CNC08{{{MERGE
*
* -NOOPTIMISE
*
{CNC21{MNZ{CSWNO{{{SET SWITCH
{{BRN{CNC08{{{MERGE
*
* -NOPRINT
*
{CNC22{ZER{CSWPR{{{CLEAR SWITCH
{{BRN{CNC08{{{MERGE
*
* -OPTIMISE
*
{CNC24{ZER{CSWNO{{{CLEAR SWITCH
{{BRN{CNC08{{{MERGE
*
* -PRINT
*
{CNC25{MNZ{CSWPR{{{SET SWITCH
{{BRN{CNC08{{{MERGE
{{EJC{{{{
*
* CNCRD (CONTINUED)
*
* -SINGLE
*
{CNC27{ZER{CSWDB{{{CLEAR SWITCH
{{BRN{CNC08{{{MERGE
*
* -SPACE
*
{CNC28{BZE{CSWLS{CNC09{{RETURN IF -NOLIST
{{JSR{SCANE{{{SCAN INTEGER AFTER -SPACE
{{MOV{#NUM01{R8{{1 SPACE IN CASE
{{BEQ{R9{#T$SMC{CNC29{JUMP IF NO INTEGER
{{MOV{R9{-(SP){{STACK IT
{{JSR{GTSMI{{{CHECK INTEGER
{{PPM{CNC06{{{FAIL IF NOT INTEGER
{{PPM{CNC06{{{FAIL IF NEGATIVE OR LARGE
{{BNZ{R8{CNC29{{JUMP IF NON ZERO
{{MOV{#NUM01{R8{{ELSE 1 SPACE
*
* MERGE WITH COUNT OF LINES TO SKIP
*
{CNC29{ADD{R8{LSTLC{{BUMP LINE COUNT
{{LCT{R8{R8{{CONVERT TO LOOP COUNTER
{{BLT{LSTLC{LSTNP{CNC30{JUMP IF FITS ON PAGE
{{JSR{PRTPS{{{EJECT
{{JSR{LISTT{{{LIST TITLE
{{BRN{CNC09{{{MERGE
*
* SKIP LINES
*
{CNC30{JSR{PRTNL{{{PRINT A BLANK
{{BCT{R8{CNC30{{LOOP
{{BRN{CNC09{{{MERGE
{{EJC{{{{
*
* CNCRD (CONTINUED)
*
* -STITL
*
{CNC31{MOV{#R$STL{CNR$T{{PTR TO R$STL
{{BRN{CNC33{{{MERGE
*
* -TITLE
*
{CNC32{MOV{#NULLS{R$STL{{CLEAR SUBTITLE
{{MOV{#R$TTL{CNR$T{{PTR TO R$TTL
*
* COMMON PROCESSING FOR -TITLE, -STITL
*
{CNC33{MOV{#NULLS{R9{{NULL IN CASE NEEDED
{{MNZ{CNTTL{{{SET FLAG FOR NEXT LISTR CALL
{{MOV{#CCOFS{R7{{OFFSET TO TITLE/SUBTITLE
{{MOV{SCNIL{R6{{INPUT IMAGE LENGTH
{{BLO{R6{R7{CNC34{JUMP IF NO CHARS LEFT
{{SUB{R7{R6{{NO OF CHARS TO EXTRACT
{{MOV{R$CIM{R10{{POINT TO IMAGE
{{JSR{SBSTR{{{GET TITLE/SUBTITLE
*
* STORE TITLE/SUBTITLE
*
{CNC34{MOV{CNR$T{R10{{POINT TO STORAGE LOCATION
{{MOV{R9{(R10){{STORE TITLE/SUBTITLE
{{BEQ{R10{#R$STL{CNC09{RETURN IF STITL
{{BNZ{PRECL{CNC09{{RETURN IF EXTENDED LISTING
{{BZE{PRICH{CNC09{{RETURN IF REGULAR PRINTER
{{MOV{4*SCLEN(R9){R10{{GET LENGTH OF TITLE
{{MOV{R10{R6{{COPY IT
{{BZE{R10{CNC35{{JUMP IF NULL
{{ADD{#NUM10{R10{{INCREMENT
{{BHI{R10{PRLEN{CNC09{USE DEFAULT LSTP0 VAL IF TOO LONG
{{ADD{#NUM04{R6{{POINT JUST PAST TITLE
*
* STORE OFFSET TO PAGE NN MESSAGE FOR SHORT TITLE
*
{CNC35{MOV{R6{LSTPO{{STORE OFFSET
{{BRN{CNC09{{{RETURN
*
* -TRACE
* PROVIDED FOR SYSTEM DEBUGGING. TOGGLES THE SYSTEM LABEL
* TRACE SWITCH AT COMPILE TIME
*
{CNC36{JSR{SYSTT{{{TOGGLE SWITCH
{{BRN{CNC08{{{MERGE
*
* -CASE
* SETS VALUE OF KVCAS SO THAT NAMES ARE FOLDED OR NOT
* DURING COMPILATION.
*
{CNC37{JSR{SCANE{{{SCAN INTEGER AFTER -CASE
{{ZER{R8{{{GET 0 IN CASE NONE THERE
{{BEQ{R10{#T$SMC{CNC38{SKIP IF NO INTEGER
{{MOV{R9{-(SP){{STACK IT
{{JSR{GTSMI{{{CHECK INTEGER
{{PPM{CNC06{{{FAIL IF NOT INTEGER
{{PPM{CNC06{{{FAIL IF NEGATIVE OR TOO LARGE
{CNC38{MOV{R8{KVCAS{{STORE NEW CASE VALUE
{{BRN{CNC09{{{MERGE
{{ENP{{{{END PROCEDURE CNCRD
{{EJC{{{{
*
* DFFNC -- DEFINE FUNCTION
*
* DFFNC IS CALLED WHENEVER A NEW FUNCTION IS ASSIGNED TO
* A VARIABLE. IT DEALS WITH EXTERNAL FUNCTION USE COUNTS.
*
* (XR) POINTER TO VRBLK
* (XL) POINTER TO NEW FUNCTION BLOCK
* JSR DFFNC CALL TO DEFINE FUNCTION
* (WA,WB) DESTROYED
*
{DFFNC{PRC{E{0{{ENTRY POINT
{{BNE{(R10){#B$EFC{DFFN1{SKIP IF NEW FUNCTION NOT EXTERNAL
{{ICV{4*EFUSE(R10){{{ELSE INCREMENT ITS USE COUNT
*
* HERE AFTER DEALING WITH NEW FUNCTION USE COUNT
*
{DFFN1{MOV{R9{R6{{SAVE VRBLK POINTER
{{MOV{4*VRFNC(R9){R9{{LOAD OLD FUNCTION POINTER
{{BNE{(R9){#B$EFC{DFFN2{JUMP IF OLD FUNCTION NOT EXTERNAL
{{MOV{4*EFUSE(R9){R7{{ELSE GET USE COUNT
{{DCV{R7{{{DECREMENT
{{MOV{R7{4*EFUSE(R9){{STORE DECREMENTED VALUE
{{BNZ{R7{DFFN2{{JUMP IF USE COUNT STILL NON-ZERO
{{JSR{SYSUL{{{ELSE CALL SYSTEM UNLOAD FUNCTION
*
* HERE AFTER DEALING WITH OLD FUNCTION USE COUNT
*
{DFFN2{MOV{R6{R9{{RESTORE VRBLK POINTER
{{MOV{R10{R6{{COPY FUNCTION BLOCK PTR
{{BLT{R9{#R$YYY{DFFN3{SKIP CHECKS IF OPSYN OP DEFINITION
{{BNZ{4*VRLEN(R9){DFFN3{{JUMP IF NOT SYSTEM VARIABLE
*
* FOR SYSTEM VARIABLE, CHECK FOR ILLEGAL REDEFINITION
*
{{MOV{4*VRSVP(R9){R10{{POINT TO SVBLK
{{MOV{4*SVBIT(R10){R7{{LOAD BIT INDICATORS
{{ANB{BTFNC{R7{{IS IT A SYSTEM FUNCTION
{{ZRB{R7{DFFN3{{REDEF OK IF NOT
{{ERB{248{ATTEMPTED{{REDEFINITION OF SYSTEM FUNCTION
*
* HERE IF REDEFINITION IS PERMITTED
*
{DFFN3{MOV{R6{4*VRFNC(R9){{STORE NEW FUNCTION POINTER
{{MOV{R6{R10{{RESTORE FUNCTION BLOCK POINTER
{{EXI{{{{RETURN TO DFFNC CALLER
{{ENP{{{{END PROCEDURE DFFNC
{{EJC{{{{
*
* DTACH -- DETACH I/O ASSOCIATED NAMES
*
* DETACHES TRBLKS FROM I/O ASSOCIATED VARIABLES, REMOVES
* ENTRY FROM IOCHN CHAIN ATTACHED TO FILEARG1 VRBLK AND MAY
* REMOVE VRBLK ACCESS AND STORE TRAPS.
* INPUT, OUTPUT, TERMINAL ARE HANDLED SPECIALLY.
*
* (XL) I/O ASSOC. VBL NAME BASE PTR
* (WA) OFFSET TO NAME
* JSR DTACH CALL FOR DETACH OPERATION
* (XL,XR,WA,WB,WC) DESTROYED
*
{DTACH{PRC{E{0{{ENTRY POINT
{{MOV{R10{DTCNB{{STORE NAME BASE (GBCOL NOT CALLED)
{{ADD{R6{R10{{POINT TO NAME LOCATION
{{MOV{R10{DTCNM{{STORE IT
*
* LOOP TO SEARCH FOR I/O TRBLK
*
{DTCH1{MOV{R10{R9{{COPY NAME POINTER
*
* CONTINUE AFTER BLOCK DELETION
*
{DTCH2{MOV{(R10){R10{{POINT TO NEXT VALUE
{{BNE{(R10){#B$TRT{DTCH6{JUMP AT CHAIN END
{{MOV{4*TRTYP(R10){R6{{GET TRAP BLOCK TYPE
{{BEQ{R6{#TRTIN{DTCH3{JUMP IF INPUT
{{BEQ{R6{#TRTOU{DTCH3{JUMP IF OUTPUT
{{ADD{#4*TRNXT{R10{{POINT TO NEXT LINK
{{BRN{DTCH1{{{LOOP
*
* DELETE AN OLD ASSOCIATION
*
{DTCH3{MOV{4*TRVAL(R10){(R9){{DELETE TRBLK
{{MOV{R10{R6{{DUMP XL ...
{{MOV{R9{R7{{... AND XR
{{MOV{4*TRTRF(R10){R10{{POINT TO TRTRF TRAP BLOCK
{{BZE{R10{DTCH5{{JUMP IF NO IOCHN
{{BNE{(R10){#B$TRT{DTCH5{JUMP IF INPUT, OUTPUT, TERMINAL
*
* LOOP TO SEARCH IOCHN CHAIN FOR NAME PTR
*
{DTCH4{MOV{R10{R9{{REMEMBER LINK PTR
{{MOV{4*TRTRF(R10){R10{{POINT TO NEXT LINK
{{BZE{R10{DTCH5{{JUMP IF END OF CHAIN
{{MOV{4*IONMB(R10){R8{{GET NAME BASE
{{ADD{4*IONMO(R10){R8{{ADD OFFSET
{{BNE{R8{DTCNM{DTCH4{LOOP IF NO MATCH
{{MOV{4*TRTRF(R10){4*TRTRF(R9){{REMOVE NAME FROM CHAIN
{{EJC{{{{
*
* DTACH (CONTINUED)
*
* PREPARE TO RESUME I/O TRBLK SCAN
*
{DTCH5{MOV{R6{R10{{RECOVER XL ...
{{MOV{R7{R9{{... AND XR
{{ADD{#4*TRVAL{R10{{POINT TO VALUE FIELD
{{BRN{DTCH2{{{CONTINUE
*
* EXIT POINT
*
{DTCH6{MOV{DTCNB{R9{{POSSIBLE VRBLK PTR
{{JSR{SETVR{{{RESET VRBLK IF NECESSARY
{{EXI{{{{RETURN
{{ENP{{{{END PROCEDURE DTACH
{{EJC{{{{
*
* DTYPE -- GET DATATYPE NAME
*
* (XR) OBJECT WHOSE DATATYPE IS REQUIRED
* JSR DTYPE CALL TO GET DATATYPE
* (XR) RESULT DATATYPE
*
{DTYPE{PRC{E{0{{ENTRY POINT
{{BEQ{(R9){#B$PDT{DTYP1{JUMP IF PROG.DEFINED
{{MOV{(R9){R9{{LOAD TYPE WORD
{{LEI{R9{{{GET ENTRY POINT ID (BLOCK CODE)
{{WTB{R9{{{CONVERT TO BYTE OFFSET
{{MOV{L^SCNMT(R9){R9{{LOAD TABLE ENTRY
{{EXI{{{{EXIT TO DTYPE CALLER
*
* HERE IF PROGRAM DEFINED
*
{DTYP1{MOV{4*PDDFP(R9){R9{{POINT TO DFBLK
{{MOV{4*DFNAM(R9){R9{{GET DATATYPE NAME FROM DFBLK
{{EXI{{{{RETURN TO DTYPE CALLER
{{ENP{{{{END PROCEDURE DTYPE
{{EJC{{{{
*
* DUMPR -- PRINT DUMP OF STORAGE
*
* (XR) DUMP ARGUMENT (SEE BELOW)
* JSR DUMPR CALL TO PRINT DUMP
* (XR,XL) DESTROYED
* (WA,WB,WC,RA) DESTROYED
*
* THE DUMP ARGUMENT HAS THE FOLLOWING SIGNIFICANCE
*
* DMARG = 0 NO DUMP PRINTED
* DMARG = 1 PARTIAL DUMP (NAT VARS, KEYWORDS)
* DMARG EQ 2 FULL DUMP (INCL ARRAYS ETC.)
* DMARG GE 3 CORE DUMP
*
* SINCE DUMPR SCRAMBLES STORE, IT IS NOT PERMISSIBLE TO
* COLLECT IN MID-DUMP. HENCE A COLLECT IS DONE INITIALLY
* AND THEN IF STORE RUNS OUT AN ERROR MESSAGE IS PRODUCED.
*
{DUMPR{PRC{E{0{{ENTRY POINT
{{BZE{R9{DMP28{{SKIP DUMP IF ARGUMENT IS ZERO
{{BGT{R9{#NUM02{DMP29{JUMP IF CORE DUMP REQUIRED
{{ZER{R10{{{CLEAR XL
{{ZER{R7{{{ZERO MOVE OFFSET
{{MOV{R9{DMARG{{SAVE DUMP ARGUMENT
{{JSR{GBCOL{{{COLLECT GARBAGE
{{JSR{PRTPG{{{EJECT PRINTER
{{MOV{#DMHDV{R9{{POINT TO HEADING FOR VARIABLES
{{JSR{PRTST{{{PRINT IT
{{JSR{PRTNL{{{TERMINATE PRINT LINE
{{JSR{PRTNL{{{AND PRINT A BLANK LINE
*
* FIRST ALL NATURAL VARIABLE BLOCKS (VRBLK) WHOSE VALUES
* ARE NON-NULL ARE LINKED IN LEXICAL ORDER USING DMVCH AS
* THE CHAIN HEAD AND CHAINING THROUGH THE VRGET FIELDS.
* NOTE THAT THIS SCRAMBLES STORE IF THE PROCESS IS
* INTERRUPTED BEFORE COMPLETION E.G. BY EXCEEDING TIME OR
* PRINT LIMITS. SINCE THE SUBSEQUENT CORE DUMPS AND
* FAILURES IF EXECUTION IS RESUMED ARE VERY CONFUSING, THE
* EXECUTION TIME ERROR ROUTINE CHECKS FOR THIS EVENT AND
* ATTEMPTS AN UNSCRAMBLE. SIMILAR PRECAUTIONS SHOULD BE
* OBSERVED IF TRANSLATE TIME DUMPING IS IMPLEMENTED.
*
{{ZER{DMVCH{{{SET NULL CHAIN TO START
{{MOV{HSHTB{R6{{POINT TO HASH TABLE
*
* LOOP THROUGH HEADERS IN HASH TABLE
*
{DMP00{MOV{R6{R9{{COPY HASH BUCKET POINTER
{{ICA{R6{{{BUMP POINTER
{{SUB{#4*VRNXT{R9{{SET OFFSET TO MERGE
*
* LOOP THROUGH VRBLKS ON ONE CHAIN
*
{DMP01{MOV{4*VRNXT(R9){R9{{POINT TO NEXT VRBLK ON CHAIN
{{BZE{R9{DMP09{{JUMP IF END OF THIS HASH CHAIN
{{MOV{R9{R10{{ELSE COPY VRBLK POINTER
{{EJC{{{{
*
* DUMPR (CONTINUED)
*
* LOOP TO FIND VALUE AND SKIP IF NULL
*
{DMP02{MOV{4*VRVAL(R10){R10{{LOAD VALUE
{{BEQ{R10{#NULLS{DMP01{LOOP FOR NEXT VRBLK IF NULL VALUE
{{BEQ{(R10){#B$TRT{DMP02{LOOP BACK IF VALUE IS TRAPPED
*
* NON-NULL VALUE, PREPARE TO SEARCH CHAIN
*
{{MOV{R9{R8{{SAVE VRBLK POINTER
{{ADD{#4*VRSOF{R9{{ADJUST PTR TO BE LIKE SCBLK PTR
{{BNZ{4*SCLEN(R9){DMP03{{JUMP IF NON-SYSTEM VARIABLE
{{MOV{4*VRSVO(R9){R9{{ELSE LOAD PTR TO NAME IN SVBLK
*
* HERE WITH NAME POINTER FOR NEW BLOCK IN XR
*
{DMP03{MOV{R9{R7{{SAVE POINTER TO CHARS
{{MOV{R6{DMPSV{{SAVE HASH BUCKET POINTER
{{MOV{#DMVCH{R6{{POINT TO CHAIN HEAD
*
* LOOP TO SEARCH CHAIN FOR CORRECT INSERTION POINT
*
{DMP04{MOV{R6{DMPCH{{SAVE CHAIN POINTER
{{MOV{R6{R10{{COPY IT
{{MOV{(R10){R9{{LOAD POINTER TO NEXT ENTRY
{{BZE{R9{DMP08{{JUMP IF END OF CHAIN TO INSERT
{{ADD{#4*VRSOF{R9{{ELSE GET NAME PTR FOR CHAINED VRBLK
{{BNZ{4*SCLEN(R9){DMP05{{JUMP IF NOT SYSTEM VARIABLE
{{MOV{4*VRSVO(R9){R9{{ELSE POINT TO NAME IN SVBLK
*
* HERE PREPARE TO COMPARE THE NAMES
*
* (WA) SCRATCH
* (WB) POINTER TO STRING OF ENTERING VRBLK
* (WC) POINTER TO ENTERING VRBLK
* (XR) POINTER TO STRING OF CURRENT BLOCK
* (XL) SCRATCH
*
{DMP05{MOV{R7{R10{{POINT TO ENTERING VRBLK STRING
{{MOV{4*SCLEN(R10){R6{{LOAD ITS LENGTH
{{PLC{R10{{{POINT TO CHARS OF ENTERING STRING
{{BHI{R6{4*SCLEN(R9){DMP06{JUMP IF ENTERING LENGTH HIGH
{{PLC{R9{{{ELSE POINT TO CHARS OF OLD STRING
{{CMC{DMP08{DMP07{{COMPARE, INSERT IF NEW IS LLT OLD
{{BRN{DMP08{{{OR IF LEQ (WE HAD SHORTER LENGTH)
*
* HERE WHEN NEW LENGTH IS LONGER THAN OLD LENGTH
*
{DMP06{MOV{4*SCLEN(R9){R6{{LOAD SHORTER LENGTH
{{PLC{R9{{{POINT TO CHARS OF OLD STRING
{{CMC{DMP08{DMP07{{COMPARE, INSERT IF NEW ONE LOW
{{EJC{{{{
*
* DUMPR (CONTINUED)
*
* HERE WE MOVE OUT ON THE CHAIN
*
{DMP07{MOV{DMPCH{R10{{COPY CHAIN POINTER
{{MOV{(R10){R6{{MOVE TO NEXT ENTRY ON CHAIN
{{BRN{DMP04{{{LOOP BACK
*
* HERE AFTER LOCATING THE PROPER INSERTION POINT
*
{DMP08{MOV{DMPCH{R10{{COPY CHAIN POINTER
{{MOV{DMPSV{R6{{RESTORE HASH BUCKET POINTER
{{MOV{R8{R9{{RESTORE VRBLK POINTER
{{MOV{(R10){4*VRGET(R9){{LINK VRBLK TO REST OF CHAIN
{{MOV{R9{(R10){{LINK VRBLK INTO CURRENT CHAIN LOC
{{BRN{DMP01{{{LOOP BACK FOR NEXT VRBLK
*
* HERE AFTER PROCESSING ALL VRBLKS ON ONE CHAIN
*
{DMP09{BNE{R6{HSHTE{DMP00{LOOP BACK IF MORE BUCKETS TO GO
*
* LOOP TO GENERATE DUMP OF NATURAL VARIABLE VALUES
*
{DMP10{MOV{DMVCH{R9{{LOAD POINTER TO NEXT ENTRY ON CHAIN
{{BZE{R9{DMP11{{JUMP IF END OF CHAIN
{{MOV{(R9){DMVCH{{ELSE UPDATE CHAIN PTR TO NEXT ENTRY
{{JSR{SETVR{{{RESTORE VRGET FIELD
{{MOV{R9{R10{{COPY VRBLK POINTER (NAME BASE)
{{MOV{#4*VRVAL{R6{{SET OFFSET FOR VRBLK NAME
{{JSR{PRTNV{{{PRINT NAME = VALUE
{{BRN{DMP10{{{LOOP BACK TILL ALL PRINTED
*
* PREPARE TO PRINT KEYWORDS
*
{DMP11{JSR{PRTNL{{{PRINT BLANK LINE
{{JSR{PRTNL{{{AND ANOTHER
{{MOV{#DMHDK{R9{{POINT TO KEYWORD HEADING
{{JSR{PRTST{{{PRINT HEADING
{{JSR{PRTNL{{{END LINE
{{JSR{PRTNL{{{PRINT ONE BLANK LINE
{{MOV{#VDMKW{R10{{POINT TO LIST OF KEYWORD SVBLK PTRS
{{EJC{{{{
*
* DUMPR (CONTINUED)
*
* LOOP TO DUMP KEYWORD VALUES
*
{DMP12{MOV{(R10)+{R9{{LOAD NEXT SVBLK PTR FROM TABLE
{{BZE{R9{DMP13{{JUMP IF END OF LIST
{{MOV{#CH$AM{R6{{LOAD AMPERSAND
{{JSR{PRTCH{{{PRINT AMPERSAND
{{JSR{PRTST{{{PRINT KEYWORD NAME
{{MOV{4*SVLEN(R9){R6{{LOAD NAME LENGTH FROM SVBLK
{{CTB{R6{SVCHS{{GET LENGTH OF NAME
{{ADD{R6{R9{{POINT TO SVKNM FIELD
{{MOV{(R9){DMPKN{{STORE IN DUMMY KVBLK
{{MOV{#TMBEB{R9{{POINT TO BLANK-EQUAL-BLANK
{{JSR{PRTST{{{PRINT IT
{{MOV{R10{DMPSV{{SAVE TABLE POINTER
{{MOV{#DMPKB{R10{{POINT TO DUMMY KVBLK
{{MOV{#4*KVVAR{R6{{SET ZERO OFFSET
{{JSR{ACESS{{{GET KEYWORD VALUE
{{PPM{{{{FAILURE IS IMPOSSIBLE
{{JSR{PRTVL{{{PRINT KEYWORD VALUE
{{JSR{PRTNL{{{TERMINATE PRINT LINE
{{MOV{DMPSV{R10{{RESTORE TABLE POINTER
{{BRN{DMP12{{{LOOP BACK TILL ALL PRINTED
*
* HERE AFTER COMPLETING PARTIAL DUMP
*
{DMP13{BEQ{DMARG{#NUM01{DMP27{EXIT IF PARTIAL DUMP COMPLETE
{{MOV{DNAMB{R9{{ELSE POINT TO FIRST DYNAMIC BLOCK
*
* LOOP THROUGH BLOCKS IN DYNAMIC STORAGE
*
{DMP14{BEQ{R9{DNAMP{DMP27{JUMP IF END OF USED REGION
{{MOV{(R9){R6{{ELSE LOAD FIRST WORD OF BLOCK
{{BEQ{R6{#B$VCT{DMP16{JUMP IF VECTOR
{{BEQ{R6{#B$ART{DMP17{JUMP IF ARRAY
{{BEQ{R6{#B$PDT{DMP18{JUMP IF PROGRAM DEFINED
{{BEQ{R6{#B$TBT{DMP19{JUMP IF TABLE
{{BEQ{R6{#B$BCT{DMP30{JUMP IF BUFFER
*
* MERGE HERE TO MOVE TO NEXT BLOCK
*
{DMP15{JSR{BLKLN{{{GET LENGTH OF BLOCK
{{ADD{R6{R9{{POINT PAST THIS BLOCK
{{BRN{DMP14{{{LOOP BACK FOR NEXT BLOCK
{{EJC{{{{
*
* DUMPR (CONTINUED)
*
* HERE FOR VECTOR
*
{DMP16{MOV{#4*VCVLS{R7{{SET OFFSET TO FIRST VALUE
{{BRN{DMP19{{{JUMP TO MERGE
*
* HERE FOR ARRAY
*
{DMP17{MOV{4*AROFS(R9){R7{{SET OFFSET TO ARPRO FIELD
{{ICA{R7{{{BUMP TO GET OFFSET TO VALUES
{{BRN{DMP19{{{JUMP TO MERGE
*
* HERE FOR PROGRAM DEFINED
*
{DMP18{MOV{#4*PDFLD{R7{{POINT TO VALUES, MERGE
*
* HERE FOR TABLE (OTHERS MERGE)
*
{DMP19{BZE{4*IDVAL(R9){DMP15{{IGNORE BLOCK IF ZERO ID VALUE
{{JSR{BLKLN{{{ELSE GET BLOCK LENGTH
{{MOV{R9{R10{{COPY BLOCK POINTER
{{MOV{R6{DMPSV{{SAVE LENGTH
{{MOV{R7{R6{{COPY OFFSET TO FIRST VALUE
{{JSR{PRTNL{{{PRINT BLANK LINE
{{MOV{R6{DMPSA{{PRESERVE OFFSET
{{JSR{PRTVL{{{PRINT BLOCK VALUE (FOR TITLE)
{{MOV{DMPSA{R6{{RECOVER OFFSET
{{JSR{PRTNL{{{END PRINT LINE
{{BEQ{(R9){#B$TBT{DMP22{JUMP IF TABLE
{{DCA{R6{{{POINT BEFORE FIRST WORD
*
* LOOP TO PRINT CONTENTS OF ARRAY, VECTOR, OR PROGRAM DEF
*
{DMP20{MOV{R10{R9{{COPY BLOCK POINTER
{{ICA{R6{{{BUMP OFFSET
{{ADD{R6{R9{{POINT TO NEXT VALUE
{{BEQ{R6{DMPSV{DMP14{EXIT IF END (XR PAST BLOCK)
{{SUB{#4*VRVAL{R9{{SUBTRACT OFFSET TO MERGE INTO LOOP
*
* LOOP TO FIND VALUE AND IGNORE NULLS
*
{DMP21{MOV{4*VRVAL(R9){R9{{LOAD NEXT VALUE
{{BEQ{R9{#NULLS{DMP20{LOOP BACK IF NULL VALUE
{{BEQ{(R9){#B$TRT{DMP21{LOOP BACK IF TRAPPED
{{JSR{PRTNV{{{ELSE PRINT NAME = VALUE
{{BRN{DMP20{{{LOOP BACK FOR NEXT FIELD
{{EJC{{{{
*
* DUMPR (CONTINUED)
*
* HERE TO DUMP A TABLE
*
{DMP22{MOV{#4*TBBUK{R8{{SET OFFSET TO FIRST BUCKET
{{MOV{#4*TEVAL{R6{{SET NAME OFFSET FOR ALL TEBLKS
*
* LOOP THROUGH TABLE BUCKETS
*
{DMP23{MOV{R10{-(SP){{SAVE TBBLK POINTER
{{ADD{R8{R10{{POINT TO NEXT BUCKET HEADER
{{ICA{R8{{{BUMP BUCKET OFFSET
{{SUB{#4*TENXT{R10{{SUBTRACT OFFSET TO MERGE INTO LOOP
*
* LOOP TO PROCESS TEBLKS ON ONE CHAIN
*
{DMP24{MOV{4*TENXT(R10){R10{{POINT TO NEXT TEBLK
{{BEQ{R10{(SP){DMP26{JUMP IF END OF CHAIN
{{MOV{R10{R9{{ELSE COPY TEBLK POINTER
*
* LOOP TO FIND VALUE AND IGNORE IF NULL
*
{DMP25{MOV{4*TEVAL(R9){R9{{LOAD NEXT VALUE
{{BEQ{R9{#NULLS{DMP24{IGNORE IF NULL VALUE
{{BEQ{(R9){#B$TRT{DMP25{LOOP BACK IF TRAPPED
{{MOV{R8{DMPSV{{ELSE SAVE OFFSET POINTER
{{JSR{PRTNV{{{PRINT NAME = VALUE
{{MOV{DMPSV{R8{{RELOAD OFFSET
{{BRN{DMP24{{{LOOP BACK FOR NEXT TEBLK
*
* HERE TO MOVE TO NEXT HASH CHAIN
*
{DMP26{MOV{(SP)+{R10{{RESTORE TBBLK POINTER
{{BNE{R8{4*TBLEN(R10){DMP23{LOOP BACK IF MORE BUCKETS TO GO
{{MOV{R10{R9{{ELSE COPY TABLE POINTER
{{ADD{R8{R9{{POINT TO FOLLOWING BLOCK
{{BRN{DMP14{{{LOOP BACK TO PROCESS NEXT BLOCK
*
* HERE AFTER COMPLETING DUMP
*
{DMP27{JSR{PRTPG{{{EJECT PRINTER
*
* MERGE HERE IF NO DUMP GIVEN (DMARG=0)
*
{DMP28{EXI{{{{RETURN TO DUMP CALLER
*
* CALL SYSTEM CORE DUMP ROUTINE
*
{DMP29{JSR{SYSDM{{{CALL IT
{{BRN{DMP28{{{RETURN
{{EJC{{{{
*
* DUMPR (CONTINUED)
*
* HERE TO DUMP BUFFER BLOCK
*
{DMP30{JSR{PRTNL{{{PRINT BLANK LINE
{{JSR{PRTVL{{{PRINT VALUE ID FOR TITLE
{{JSR{PRTNL{{{FORCE NEW LINE
{{MOV{#CH$DQ{R6{{LOAD DOUBLE QUOTE
{{JSR{PRTCH{{{PRINT IT
{{MOV{4*BCLEN(R9){R8{{LOAD DEFINED LENGTH
{{BZE{R8{DMP32{{SKIP CHARACTERS IF NONE
{{LCT{R8{R8{{LOAD COUNT FOR LOOP
{{MOV{R9{R7{{SAVE BCBLK PTR
{{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK
{{PLC{R9{{{GET SET TO LOAD CHARACTERS
*
* LOOP HERE STUFFING CHARACTERS IN OUTPUT STREAM
*
{DMP31{LCH{R6{(R9)+{{GET NEXT CHARACTER
{{JSR{PRTCH{{{STUFF IT
{{BCT{R8{DMP31{{BRANCH FOR NEXT ONE
{{MOV{R7{R9{{RESTORE BCBLK POINTER
*
* MERGE TO STUFF CLOSING QUOTE MARK
*
{DMP32{MOV{#CH$DQ{R6{{STUFF QUOTE
{{JSR{PRTCH{{{PRINT IT
{{JSR{PRTNL{{{PRINT NEW LINE
{{MOV{(R9){R6{{GET FIRST WD FOR BLKLN
{{BRN{DMP15{{{MERGE TO GET NEXT BLOCK
{{ENP{{{{END PROCEDURE DUMPR
{{EJC{{{{
*
* ERMSG -- PRINT ERROR CODE AND ERROR MESSAGE
*
* KVERT ERROR CODE
* JSR ERMSG CALL TO PRINT MESSAGE
* (XR,XL,WA,WB,WC,IA) DESTROYED
*
{ERMSG{PRC{E{0{{ENTRY POINT
{{JSR{PRTIS{{{PRINT ERROR PTR OR BLANK LINE
{{MOV{KVERT{R6{{LOAD ERROR CODE
{{MOV{#ERMMS{R9{{POINT TO ERROR MESSAGE /ERROR/
{{JSR{PRTST{{{PRINT IT
{{JSR{ERTEX{{{GET ERROR MESSAGE TEXT
{{ADD{#THSND{R6{{BUMP ERROR CODE FOR PRINT
{{MTI{R6{{{FAIL CODE IN INT ACC
{{JSR{PRTIN{{{PRINT CODE (NOW HAVE ERROR1XXX)
{{MOV{PRBUF{R10{{POINT TO PRINT BUFFER
{{PSC{R10{#NUM05{{POINT TO THE 1
{{MOV{#CH$BL{R6{{LOAD A BLANK
{{SCH{R6{(R10){{STORE BLANK OVER 1 (ERROR XXX)
{{CSC{R10{{{COMPLETE STORE CHARACTERS
{{ZER{R10{{{CLEAR GARBAGE POINTER IN XL
{{MOV{R9{R6{{KEEP ERROR TEXT
{{MOV{#ERMNS{R9{{POINT TO / -- /
{{JSR{PRTST{{{PRINT IT
{{MOV{R6{R9{{GET ERROR TEXT AGAIN
{{JSR{PRTST{{{PRINT ERROR MESSAGE TEXT
{{JSR{PRTIS{{{PRINT LINE
{{JSR{PRTIS{{{PRINT BLANK LINE
{{EXI{{{{RETURN TO ERMSG CALLER
{{ENP{{{{END PROCEDURE ERMSG
{{EJC{{{{
*
* ERTEX -- GET ERROR MESSAGE TEXT
*
* (WA) ERROR CODE
* JSR ERTEX CALL TO GET ERROR TEXT
* (XR) PTR TO ERROR TEXT IN DYNAMIC
* (R$ETX) COPY OF PTR TO ERROR TEXT
* (XL,WC,IA) DESTROYED
*
{ERTEX{PRC{E{0{{ENTRY POINT
{{MOV{R6{ERTWA{{SAVE WA
{{MOV{R7{ERTWB{{SAVE WB
{{JSR{SYSEM{{{GET FAILURE MESSAGE TEXT
{{MOV{R9{R10{{COPY POINTER TO IT
{{MOV{4*SCLEN(R9){R6{{GET LENGTH OF STRING
{{BZE{R6{ERT02{{JUMP IF NULL
{{ZER{R7{{{OFFSET OF ZERO
{{JSR{SBSTR{{{COPY INTO DYNAMIC STORE
{{MOV{R9{R$ETX{{STORE FOR RELOCATION
*
* RETURN
*
{ERT01{MOV{ERTWB{R7{{RESTORE WB
{{MOV{ERTWA{R6{{RESTORE WA
{{EXI{{{{RETURN TO CALLER
*
* RETURN ERRTEXT CONTENTS INSTEAD OF NULL
*
{ERT02{MOV{R$ETX{R9{{GET ERRTEXT
{{BRN{ERT01{{{RETURN
{{ENP{{{{
{{EJC{{{{
*
* EVALI -- EVALUATE INTEGER ARGUMENT
*
* EVALI IS USED BY PATTERN PRIMITIVES LEN,TAB,RTAB,POS,RPOS
* WHEN THEIR ARGUMENT IS AN EXPRESSION VALUE.
*
* (XR) NODE POINTER
* (WB) CURSOR
* JSR EVALI CALL TO EVALUATE INTEGER
* PPM LOC TRANSFER LOC FOR NON-INTEGER ARG
* PPM LOC TRANSFER LOC FOR OUT OF RANGE ARG
* PPM LOC TRANSFER LOC FOR EVALUATION FAILURE
* PPM LOC TRANSFER LOC FOR SUCCESSFUL EVAL
* (THE NORMAL RETURN IS NEVER TAKEN)
* (XR) PTR TO NODE WITH INTEGER ARGUMENT
* (WC,XL,RA) DESTROYED
*
* ON RETURN, THE NODE POINTED TO HAS THE INTEGER ARGUMENT
* IN PARM1 AND THE PROPER SUCCESSOR POINTER IN PTHEN.
* THIS ALLOWS MERGING WITH THE NORMAL (INTEGER ARG) CASE.
*
{EVALI{PRC{R{4{{ENTRY POINT (RECURSIVE)
{{JSR{EVALP{{{EVALUATE EXPRESSION
{{PPM{EVLI1{{{JUMP ON FAILURE
{{MOV{R10{-(SP){{STACK RESULT FOR GTSMI
{{MOV{4*PTHEN(R9){R10{{LOAD SUCCESSOR POINTER
{{JSR{GTSMI{{{CONVERT ARG TO SMALL INTEGER
{{PPM{EVLI2{{{JUMP IF NOT INTEGER
{{PPM{EVLI3{{{JUMP IF OUT OF RANGE
{{MOV{R9{EVLIV{{STORE RESULT IN SPECIAL DUMMY NODE
{{MOV{R10{EVLIS{{STORE SUCCESSOR POINTER
{{MOV{#EVLIN{R9{{POINT TO DUMMY NODE WITH RESULT
{{EXI{4{{{TAKE SUCCESSFUL EXIT
*
* HERE IF EVALUATION FAILS
*
{EVLI1{EXI{3{{{TAKE FAILURE RETURN
*
* HERE IF ARGUMENT IS NOT INTEGER
*
{EVLI2{EXI{1{{{TAKE NON-INTEGER ERROR EXIT
*
* HERE IF ARGUMENT IS OUT OF RANGE
*
{EVLI3{EXI{2{{{TAKE OUT-OF-RANGE ERROR EXIT
{{ENP{{{{END PROCEDURE EVALI
{{EJC{{{{
*
* EVALP -- EVALUATE EXPRESSION DURING PATTERN MATCH
*
* EVALP IS USED TO EVALUATE AN EXPRESSION (BY VALUE) DURING
* A PATTERN MATCH. THE EFFECT IS LIKE EVALX, BUT PATTERN
* VARIABLES ARE STACKED AND RESTORED IF NECESSARY.
*
* EVALP ALSO DIFFERS FROM EVALX IN THAT IF THE RESULT IS
* AN EXPRESSION IT IS REEVALUATED. THIS OCCURS REPEATEDLY.
*
* (XR) NODE POINTER
* (WB) PATTERN MATCH CURSOR
* JSR EVALP CALL TO EVALUATE EXPRESSION
* PPM LOC TRANSFER LOC IF EVALUATION FAILS
* (XL) RESULT
* (WA) FIRST WORD OF RESULT BLOCK
* (XR,WB) DESTROYED (FAILURE CASE ONLY)
* (WC,RA) DESTROYED
*
* THE EXPRESSION POINTER IS STORED IN PARM1 OF THE NODE
*
* CONTROL RETURNS TO FAILP ON FAILURE OF EVALUATION
*
{EVALP{PRC{R{1{{ENTRY POINT (RECURSIVE)
{{MOV{4*PARM1(R9){R10{{LOAD EXPRESSION POINTER
{{BEQ{(R10){#B$EXL{EVLP1{JUMP IF EXBLK CASE
*
* HERE FOR CASE OF SEBLK
*
* WE CAN GIVE A FAST RETURN IF THE VALUE OF THE VRBLK IS
* NOT AN EXPRESSION AND IS NOT TRAPPED.
*
{{MOV{4*SEVAR(R10){R10{{LOAD VRBLK POINTER
{{MOV{4*VRVAL(R10){R10{{LOAD VALUE OF VRBLK
{{MOV{(R10){R6{{LOAD FIRST WORD OF VALUE
{{BHI{R6{#B$T$${EVLP3{JUMP IF NOT SEBLK, TRBLK OR EXBLK
*
* HERE FOR EXBLK OR SEBLK WITH EXPR VALUE OR TRAPPED VALUE
*
{EVLP1{MOV{R9{-(SP){{STACK NODE POINTER
{{MOV{R7{-(SP){{STACK CURSOR
{{MOV{R$PMS{-(SP){{STACK SUBJECT STRING POINTER
{{MOV{PMSSL{-(SP){{STACK SUBJECT STRING LENGTH
{{MOV{PMDFL{-(SP){{STACK DOT FLAG
{{MOV{PMHBS{-(SP){{STACK HISTORY STACK BASE POINTER
{{MOV{4*PARM1(R9){R9{{LOAD EXPRESSION POINTER
{{EJC{{{{
*
* EVALP (CONTINUED)
*
* LOOP BACK HERE TO REEVALUATE EXPRESSION RESULT
*
{EVLP2{ZER{R7{{{SET FLAG FOR BY VALUE
{{JSR{EVALX{{{EVALUATE EXPRESSION
{{PPM{EVLP4{{{JUMP ON FAILURE
{{MOV{(R9){R6{{ELSE LOAD FIRST WORD OF VALUE
{{BLO{R6{#B$E$${EVLP2{LOOP BACK TO REEVALUATE EXPRESSION
*
* HERE TO RESTORE PATTERN VALUES AFTER SUCCESSFUL EVAL
*
{{MOV{R9{R10{{COPY RESULT POINTER
{{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER
{{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG
{{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH
{{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER
{{MOV{(SP)+{R7{{RESTORE CURSOR
{{MOV{(SP)+{R9{{RESTORE NODE POINTER
*
* COMMON EXIT POINT
*
{EVLP3{EXI{{{{RETURN TO EVALP CALLER
*
* HERE FOR FAILURE DURING EVALUATION
*
{EVLP4{MOV{(SP)+{PMHBS{{RESTORE HISTORY STACK BASE POINTER
{{MOV{(SP)+{PMDFL{{RESTORE DOT FLAG
{{MOV{(SP)+{PMSSL{{RESTORE SUBJECT STRING LENGTH
{{MOV{(SP)+{R$PMS{{RESTORE SUBJECT STRING POINTER
{{ADD{#4*NUM02{SP{{REMOVE NODE PTR, CURSOR
{{EXI{1{{{TAKE FAILURE EXIT
{{ENP{{{{END PROCEDURE EVALP
{{EJC{{{{
*
* EVALS -- EVALUATE STRING ARGUMENT
*
* EVALS IS USED BY SPAN, ANY, NOTANY, BREAK, BREAKX WHEN
* THEY ARE PASSED AN EXPRESSION ARGUMENT.
*
* (XR) NODE POINTER
* (WB) CURSOR
* JSR EVALS CALL TO EVALUATE STRING
* PPM LOC TRANSFER LOC FOR NON-STRING ARG
* PPM LOC TRANSFER LOC FOR EVALUATION FAILURE
* PPM LOC TRANSFER LOC FOR SUCCESSFUL EVAL
* (THE NORMAL RETURN IS NEVER TAKEN)
* (XR) PTR TO NODE WITH PARMS SET
* (XL,WC,RA) DESTROYED
*
* ON RETURN, THE NODE POINTED TO HAS A CHARACTER TABLE
* POINTER IN PARM1 AND A BIT MASK IN PARM2. THE PROPER
* SUCCESSOR IS STORED IN PTHEN OF THIS NODE. THUS IT IS
* OK FOR MERGING WITH THE NORMAL (MULTI-CHAR STRING) CASE.
*
{EVALS{PRC{R{3{{ENTRY POINT (RECURSIVE)
{{JSR{EVALP{{{EVALUATE EXPRESSION
{{PPM{EVLS1{{{JUMP IF EVALUATION FAILS
{{MOV{4*PTHEN(R9){-(SP){{SAVE SUCCESSOR POINTER
{{MOV{R7{-(SP){{SAVE CURSOR
{{MOV{R10{-(SP){{STACK RESULT PTR FOR PATST
{{ZER{R7{{{DUMMY PCODE FOR ONE CHAR STRING
{{ZER{R8{{{DUMMY PCODE FOR EXPRESSION ARG
{{MOV{#P$BRK{R10{{APPROPRIATE PCODE FOR OUR USE
{{JSR{PATST{{{CALL ROUTINE TO BUILD NODE
{{PPM{EVLS2{{{JUMP IF NOT STRING
{{MOV{(SP)+{R7{{RESTORE CURSOR
{{MOV{(SP)+{4*PTHEN(R9){{STORE SUCCESSOR POINTER
{{EXI{3{{{TAKE SUCCESS RETURN
*
* HERE IF EVALUATION FAILS
*
{EVLS1{EXI{2{{{TAKE FAILURE RETURN
*
* HERE IF ARGUMENT IS NOT STRING
*
{EVLS2{ADD{#4*NUM02{SP{{POP SUCCESSOR AND CURSOR
{{EXI{1{{{TAKE NON-STRING ERROR EXIT
{{ENP{{{{END PROCEDURE EVALS
{{EJC{{{{
*
* EVALX -- EVALUATE EXPRESSION
*
* EVALX IS CALLED TO EVALUATE AN EXPRESSION
*
* (XR) POINTER TO EXBLK OR SEBLK
* (WB) 0 IF BY VALUE, 1 IF BY NAME
* JSR EVALX CALL TO EVALUATE EXPRESSION
* PPM LOC TRANSFER LOC IF EVALUATION FAILS
* (XR) RESULT IF CALLED BY VALUE
* (XL,WA) RESULT NAME BASE,OFFSET IF BY NAME
* (XR) DESTROYED (NAME CASE ONLY)
* (XL,WA) DESTROYED (VALUE CASE ONLY)
* (WB,WC,RA) DESTROYED
*
{EVALX{PRC{R{1{{ENTRY POINT, RECURSIVE
{{BEQ{(R9){#B$EXL{EVLX2{JUMP IF EXBLK CASE
*
* HERE FOR SEBLK
*
{{MOV{4*SEVAR(R9){R10{{LOAD VRBLK POINTER (NAME BASE)
{{MOV{#4*VRVAL{R6{{SET NAME OFFSET
{{BNZ{R7{EVLX1{{JUMP IF CALLED BY NAME
{{JSR{ACESS{{{CALL ROUTINE TO ACCESS VALUE
{{PPM{EVLX9{{{JUMP IF FAILURE ON ACCESS
*
* MERGE HERE TO EXIT FOR SEBLK CASE
*
{EVLX1{EXI{{{{RETURN TO EVALX CALLER
{{EJC{{{{
*
* EVALX (CONTINUED)
*
* HERE FOR FULL EXPRESSION (EXBLK) CASE
*
* IF AN ERROR OCCURS IN THE EXPRESSION CODE AT EXECUTION
* TIME, CONTROL IS PASSED VIA ERROR SECTION TO EXFAL
* WITHOUT RETURNING TO THIS ROUTINE.
* THE FOLLOWING ENTRIES ARE MADE ON THE STACK BEFORE
* GIVING CONTROL TO THE EXPRESSION CODE
*
* EVALX RETURN POINT
* SAVED VALUE OF R$COD
* CODE POINTER (-R$COD)
* SAVED VALUE OF FLPTR
* 0 IF BY VALUE, 1 IF BY NAME
* FLPTR --------------- *EXFLC, FAIL OFFSET IN EXBLK
*
{EVLX2{SCP{R8{{{GET CODE POINTER
{{MOV{R$COD{R6{{LOAD CODE BLOCK POINTER
{{SUB{R6{R8{{GET CODE POINTER AS OFFSET
{{MOV{R6{-(SP){{STACK OLD CODE BLOCK POINTER
{{MOV{R8{-(SP){{STACK RELATIVE CODE OFFSET
{{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER
{{MOV{R7{-(SP){{STACK NAME/VALUE INDICATOR
{{MOV{#4*EXFLC{-(SP){{STACK NEW FAIL OFFSET
{{MOV{FLPTR{GTCEF{{KEEP IN CASE OF ERROR
{{MOV{R$COD{R$GTC{{KEEP CODE BLOCK POINTER SIMILARLY
{{MOV{SP{FLPTR{{SET NEW FAILURE POINTER
{{MOV{R9{R$COD{{SET NEW CODE BLOCK POINTER
{{MOV{KVSTN{4*EXSTM(R9){{REMEMBER STMNT NUMBER
{{ADD{#4*EXCOD{R9{{POINT TO FIRST CODE WORD
{{LCP{R9{{{SET CODE POINTER
{{BNE{STAGE{#STGXT{EXITS{JUMP IF NOT EXECUTION TIME
{{MOV{#STGEE{STAGE{{EVALUATING EXPRESSION
{{BRN{EXITS{{{JUMP TO EXECUTE FIRST CODE WORD
{{EJC{{{{
*
* EVALX (CONTINUED)
*
* COME HERE IF SUCCESSFUL RETURN BY VALUE (SEE O$RVL)
*
{EVLX3{MOV{(SP)+{R9{{LOAD VALUE
{{BZE{4*1(SP){EVLX5{{JUMP IF CALLED BY VALUE
{{ERB{249{EXPRESSION{{EVALUATED BY NAME RETURNED VALUE
*
* HERE FOR EXPRESSION RETURNING BY NAME (SEE O$RNM)
*
{EVLX4{MOV{(SP)+{R6{{LOAD NAME OFFSET
{{MOV{(SP)+{R10{{LOAD NAME BASE
{{BNZ{4*1(SP){EVLX5{{JUMP IF CALLED BY NAME
{{JSR{ACESS{{{ELSE ACCESS VALUE FIRST
{{PPM{EVLX6{{{JUMP IF FAILURE DURING ACCESS
*
* HERE AFTER LOADING CORRECT RESULT INTO XR OR XL,WA
*
{EVLX5{ZER{R7{{{NOTE SUCCESSFUL
{{BRN{EVLX7{{{MERGE
*
* HERE FOR FAILURE IN EXPRESSION EVALUATION (SEE O$FEX)
*
{EVLX6{MNZ{R7{{{NOTE UNSUCCESSFUL
*
* RESTORE ENVIRONMENT
*
{EVLX7{BNE{STAGE{#STGEE{EVLX8{SKIP IF WAS NOT PREVIOUSLY XT
{{MOV{#STGXT{STAGE{{EXECUTE TIME
*
* MERGE WITH STAGE SET UP
*
{EVLX8{ADD{#4*NUM02{SP{{POP NAME/VALUE INDICATOR, *EXFAL
{{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER
{{MOV{(SP)+{R8{{LOAD CODE OFFSET
{{ADD{(SP){R8{{MAKE CODE POINTER ABSOLUTE
{{MOV{(SP)+{R$COD{{RESTORE OLD CODE BLOCK POINTER
{{LCP{R8{{{RESTORE OLD CODE POINTER
{{BZE{R7{EVLX1{{JUMP FOR SUCCESSFUL RETURN
*
* MERGE HERE FOR FAILURE IN SEBLK CASE
*
{EVLX9{EXI{1{{{TAKE FAILURE EXIT
{{ENP{{{{END OF PROCEDURE EVALX
{{EJC{{{{
*
* EXBLD -- BUILD EXBLK
*
* EXBLD IS USED TO BUILD AN EXPRESSION BLOCK FROM THE
* CODE COMPILED MOST RECENTLY IN THE CURRENT CCBLK.
*
* (XL) OFFSET IN CCBLK TO START OF CODE
* (WB) INTEGER IN RANGE 0 LE N LE MXLEN
* JSR EXBLD CALL TO BUILD EXBLK
* (XR) PTR TO CONSTRUCTED EXBLK
* (WA,WB,XL) DESTROYED
*
{EXBLD{PRC{E{0{{ENTRY POINT
{{MOV{R10{R6{{COPY OFFSET TO START OF CODE
{{SUB{#4*EXCOD{R6{{CALC REDUCTION IN OFFSET IN EXBLK
{{MOV{R6{-(SP){{STACK FOR LATER
{{MOV{CWCOF{R6{{LOAD FINAL OFFSET
{{SUB{R10{R6{{COMPUTE LENGTH OF CODE
{{ADD{#4*EXSI${R6{{ADD SPACE FOR STANDARD FIELDS
{{JSR{ALLOC{{{ALLOCATE SPACE FOR EXBLK
{{MOV{R9{-(SP){{SAVE POINTER TO EXBLK
{{MOV{#B$EXL{4*EXTYP(R9){{STORE TYPE WORD
{{ZER{4*EXSTM(R9){{{ZEROISE STMNT NUMBER FIELD
{{MOV{R6{4*EXLEN(R9){{STORE LENGTH
{{MOV{#OFEX${4*EXFLC(R9){{STORE FAILURE WORD
{{ADD{#4*EXSI${R9{{SET XR FOR SYSMW
{{MOV{R10{CWCOF{{RESET OFFSET TO START OF CODE
{{ADD{R$CCB{R10{{POINT TO START OF CODE
{{SUB{#4*EXSI${R6{{LENGTH OF CODE TO MOVE
{{MOV{R6{-(SP){{STACK LENGTH OF CODE
{{MVW{{{{MOVE CODE TO EXBLK
{{MOV{(SP)+{R6{{GET LENGTH OF CODE
{{BTW{R6{{{CONVERT BYTE COUNT TO WORD COUNT
{{LCT{R6{R6{{PREPARE COUNTER FOR LOOP
{{MOV{(SP){R10{{COPY EXBLK PTR, DONT UNSTACK
{{ADD{#4*EXCOD{R10{{POINT TO CODE ITSELF
{{MOV{4*1(SP){R7{{GET REDUCTION IN OFFSET
*
* THIS LOOP SEARCHES FOR NEGATION AND SELECTION CODE SO
* THAT THE OFFSETS COMPUTED WHILST CODE WAS IN CODE BLOCK
* CAN BE TRANSFORMED TO REDUCED VALUES APPLICABLE IN AN
* EXBLK.
*
{EXBL1{MOV{(R10)+{R9{{GET NEXT CODE WORD
{{BEQ{R9{#OSLA${EXBL3{JUMP IF SELECTION FOUND
{{BEQ{R9{#ONTA${EXBL3{JUMP IF NEGATION FOUND
{{BCT{R6{EXBL1{{LOOP TO END OF CODE
*
* NO SELECTION FOUND OR MERGE TO EXIT ON TERMINATION
*
{EXBL2{MOV{(SP)+{R9{{POP EXBLK PTR INTO XR
{{MOV{(SP)+{R10{{POP REDUCTION CONSTANT
{{EXI{{{{RETURN TO CALLER
{{EJC{{{{
*
* EXBLD (CONTINUED)
*
* SELECTION OR NEGATION FOUND
* REDUCE THE OFFSETS AS NEEDED. OFFSETS OCCUR IN WORDS
* FOLLOWING CODE WORDS -
* =ONTA$, =OSLA$, =OSLB$, =OSLC$
*
{EXBL3{SUB{R7{(R10)+{{ADJUST OFFSET
{{BCT{R6{EXBL4{{DECREMENT COUNT
*
{EXBL4{BCT{R6{EXBL5{{DECREMENT COUNT
*
* CONTINUE SEARCH FOR MORE OFFSETS
*
{EXBL5{MOV{(R10)+{R9{{GET NEXT CODE WORD
{{BEQ{R9{#OSLA${EXBL3{JUMP IF OFFSET FOUND
{{BEQ{R9{#OSLB${EXBL3{JUMP IF OFFSET FOUND
{{BEQ{R9{#OSLC${EXBL3{JUMP IF OFFSET FOUND
{{BEQ{R9{#ONTA${EXBL3{JUMP IF OFFSET FOUND
{{BCT{R6{EXBL5{{LOOP
{{BRN{EXBL2{{{MERGE TO RETURN
{{ENP{{{{END PROCEDURE EXBLD
{{EJC{{{{
*
* EXPAN -- ANALYZE EXPRESSION
*
* THE EXPRESSION ANALYZER (EXPAN) PROCEDURE IS USED TO SCAN
* AN EXPRESSION AND CONVERT IT INTO A TREE REPRESENTATION.
* SEE DESCRIPTIONS OF CMBLK, CUBLK, CBBLK IN THE STRUCTURES
* SECTION FOR DETAILED FORMAT OF TREE BLOCKS.
*
* THE ANALYZER USES A SIMPLE PRECEDENCE SCHEME IN WHICH
* OPERANDS AND OPERATORS ARE PLACED ON A SINGLE STACK
* AND CONDENSATIONS ARE MADE WHEN LOW PRECEDENCE OPERATORS
* ARE STACKED AFTER A HIGHER PRECEDENCE OPERATOR. A GLOBAL
* VARIABLE (IN WB) KEEPS TRACK OF THE LEVEL AS FOLLOWS.
*
* 0 SCANNING OUTER LEVEL OF STATEMENT OR EXPRESSION
* 1 SCANNING OUTER LEVEL OF NORMAL GOTO
* 2 SCANNING OUTER LEVEL OF DIRECT GOTO
* 3 SCANNING INSIDE ARRAY BRACKETS
* 4 SCANNING INSIDE GROUPING PARENTHESES
* 5 SCANNING INSIDE FUNCTION PARENTHESES
*
* THIS VARIABLE IS SAVED ON THE STACK ON ENCOUNTERING A
* GROUPING AND RESTORED AT THE END OF THE GROUPING.
*
* ANOTHER GLOBAL VARIABLE (IN WC) COUNTS THE NUMBER OF
* ITEMS AT ONE GROUPING LEVEL AND IS INCREMENTED FOR EACH
* COMMA ENCOUNTERED. IT IS STACKED WITH THE LEVEL INDICATOR
*
* THE SCAN IS CONTROLLED BY A THREE STATE FINITE MACHINE.
* A GLOBAL VARIABLE STORED IN WA IS THE CURRENT STATE.
*
* WA=0 NOTHING SCANNED AT THIS LEVEL
* WA=1 OPERAND EXPECTED
* WA=2 OPERATOR EXPECTED
*
* (WB) CALL TYPE (SEE BELOW)
* JSR EXPAN CALL TO ANALYZE EXPRESSION
* (XR) POINTER TO RESULTING TREE
* (XL,WA,WB,WC,RA) DESTROYED
*
* THE ENTRY VALUE OF WB INDICATES THE CALL TYPE AS FOLLOWS.
*
* 0 SCANNING EITHER THE MAIN BODY OF A STATEMENT OR THE
* TEXT OF AN EXPRESSION (FROM EVAL CALL). VALID
* TERMINATORS ARE COLON, SEMICOLON. THE RESCAN FLAG IS
* SET TO RETURN THE TERMINATOR ON THE NEXT SCANE CALL.
*
* 1 SCANNING A NORMAL GOTO. THE ONLY VALID
* TERMINATOR IS A RIGHT PAREN.
*
* 2 SCANNING A DIRECT GOTO. THE ONLY VALID
* TERMINATOR IS A RIGHT BRACKET.
{{EJC{{{{
*
* EXPAN (CONTINUED)
*
* ENTRY POINT
*
{EXPAN{PRC{E{0{{ENTRY POINT
{{ZER{-(SP){{{SET TOP OF STACK INDICATOR
{{ZER{R6{{{SET INITIAL STATE TO ZERO
{{ZER{R8{{{ZERO COUNTER VALUE
*
* LOOP HERE FOR SUCCESSIVE ENTRIES
*
{EXP01{JSR{SCANE{{{SCAN NEXT ELEMENT
{{ADD{R6{R10{{ADD STATE TO SYNTAX CODE
{{BSW{R10{T$NES{{SWITCH ON ELEMENT TYPE/STATE
{{IFF{T$UO0{EXP27{{UNOP, S=0
{{IFF{T$UO1{EXP27{{UNOP, S=1
{{IFF{T$UO2{EXP04{{UNOP, S=2
{{IFF{T$LP0{EXP06{{LEFT PAREN, S=0
{{IFF{T$LP1{EXP06{{LEFT PAREN, S=1
{{IFF{T$LP2{EXP04{{LEFT PAREN, S=2
{{IFF{T$LB0{EXP08{{LEFT BRKT, S=0
{{IFF{T$LB1{EXP08{{LEFT BRKT, S=1
{{IFF{T$LB2{EXP09{{LEFT BRKT, S=2
{{IFF{T$CM0{EXP02{{COMMA, S=0
{{IFF{T$CM1{EXP05{{COMMA, S=1
{{IFF{T$CM2{EXP11{{COMMA, S=2
{{IFF{T$FN0{EXP10{{FUNCTION, S=0
{{IFF{T$FN1{EXP10{{FUNCTION, S=1
{{IFF{T$FN2{EXP04{{FUNCTION, S=2
{{IFF{T$VA0{EXP03{{VARIABLE, S=0
{{IFF{T$VA1{EXP03{{VARIABLE, STATE ONE
{{IFF{T$VA2{EXP04{{VARIABLE, S=2
{{IFF{T$CO0{EXP03{{CONSTANT, S=0
{{IFF{T$CO1{EXP03{{CONSTANT, S=1
{{IFF{T$CO2{EXP04{{CONSTANT, S=2
{{IFF{T$BO0{EXP05{{BINOP, S=0
{{IFF{T$BO1{EXP05{{BINOP, S=1
{{IFF{T$BO2{EXP26{{BINOP, S=2
{{IFF{T$RP0{EXP02{{RIGHT PAREN, S=0
{{IFF{T$RP1{EXP05{{RIGHT PAREN, S=1
{{IFF{T$RP2{EXP12{{RIGHT PAREN, S=2
{{IFF{T$RB0{EXP02{{RIGHT BRKT, S=0
{{IFF{T$RB1{EXP05{{RIGHT BRKT, S=1
{{IFF{T$RB2{EXP18{{RIGHT BRKT, S=2
{{IFF{T$CL0{EXP02{{COLON, S=0
{{IFF{T$CL1{EXP05{{COLON, S=1
{{IFF{T$CL2{EXP19{{COLON, S=2
{{IFF{T$SM0{EXP02{{SEMICOLON, S=0
{{IFF{T$SM1{EXP05{{SEMICOLON, S=1
{{IFF{T$SM2{EXP19{{SEMICOLON, S=2
{{ESW{{{{END SWITCH ON ELEMENT TYPE/STATE
{{EJC{{{{
*
* EXPAN (CONTINUED)
*
* HERE FOR RBR,RPR,COL,SMC,CMA IN STATE 0
*
* SET TO RESCAN THE TERMINATOR ENCOUNTERED AND CREATE
* A NULL CONSTANT (CASE OF OMITTED NULL)
*
{EXP02{MNZ{SCNRS{{{SET TO RESCAN ELEMENT
{{MOV{#NULLS{R9{{POINT TO NULL, MERGE
*
* HERE FOR VAR OR CON IN STATES 0,1
*
* STACK THE VARIABLE/CONSTANT AND SET STATE=2
*
{EXP03{MOV{R9{-(SP){{STACK POINTER TO OPERAND
{{MOV{#NUM02{R6{{SET STATE 2
{{BRN{EXP01{{{JUMP FOR NEXT ELEMENT
*
* HERE FOR VAR,CON,LPR,FNC,UOP IN STATE 2
*
* WE RESCAN THE ELEMENT AND CREATE A CONCATENATION OPERATOR
* THIS IS THE CASE OF THE BLANK CONCATENATION OPERATOR.
*
{EXP04{MNZ{SCNRS{{{SET TO RESCAN ELEMENT
{{MOV{#OPDVC{R9{{POINT TO CONCAT OPERATOR DV
{{BZE{R7{EXP4A{{OK IF AT TOP LEVEL
{{MOV{#OPDVP{R9{{ELSE POINT TO UNMISTAKABLE CONCAT.
*
* MERGE HERE WHEN XR SET UP WITH PROPER CONCATENATION DVBLK
*
{EXP4A{BNZ{SCNBL{EXP26{{MERGE BOP IF BLANKS, ELSE ERROR
{{DCV{SCNSE{{{ADJUST START OF ELEMENT LOCATION
{{ERB{220{SYNTAX{{ERROR. MISSING OPERATOR
*
* HERE FOR CMA,RPR,RBR,COL,SMC,BOP(S=1) BOP(S=0)
*
* THIS IS AN ERRONOUS CONTRUCTION
*
{EXP05{DCV{SCNSE{{{ADJUST START OF ELEMENT LOCATION
{{ERB{221{SYNTAX{{ERROR. MISSING OPERAND
*
* HERE FOR LPR (S=0,1)
*
{EXP06{MOV{#NUM04{R10{{SET NEW LEVEL INDICATOR
{{ZER{R9{{{SET ZERO VALUE FOR CMOPN
{{EJC{{{{
*
* EXPAN (CONTINUED)
*
* MERGE HERE TO STORE OLD LEVEL ON STACK AND START NEW ONE
*
{EXP07{MOV{R9{-(SP){{STACK CMOPN VALUE
{{MOV{R8{-(SP){{STACK OLD COUNTER
{{MOV{R7{-(SP){{STACK OLD LEVEL INDICATOR
{{CHK{{{{CHECK FOR STACK OVERFLOW
{{ZER{R6{{{SET NEW STATE TO ZERO
{{MOV{R10{R7{{SET NEW LEVEL INDICATOR
{{MOV{#NUM01{R8{{INITIALIZE NEW COUNTER
{{BRN{EXP01{{{JUMP TO SCAN NEXT ELEMENT
*
* HERE FOR LBR (S=0,1)
*
* THIS IS AN ILLEGAL USE OF LEFT BRACKET
*
{EXP08{ERB{222{SYNTAX{{ERROR. INVALID USE OF LEFT BRACKET
*
* HERE FOR LBR (S=2)
*
* SET NEW LEVEL AND START TO SCAN SUBSCRIPTS
*
{EXP09{MOV{(SP)+{R9{{LOAD ARRAY PTR FOR CMOPN
{{MOV{#NUM03{R10{{SET NEW LEVEL INDICATOR
{{BRN{EXP07{{{JUMP TO STACK OLD AND START NEW
*
* HERE FOR FNC (S=0,1)
*
* STACK OLD LEVEL AND START TO SCAN ARGUMENTS
*
{EXP10{MOV{#NUM05{R10{{SET NEW LEV INDIC (XR=VRBLK=CMOPN)
{{BRN{EXP07{{{JUMP TO STACK OLD AND START NEW
*
* HERE FOR CMA (S=2)
*
* INCREMENT ARGUMENT COUNT AND CONTINUE
*
{EXP11{ICV{R8{{{INCREMENT COUNTER
{{JSR{EXPDM{{{DUMP OPERATORS AT THIS LEVEL
{{ZER{-(SP){{{SET NEW LEVEL FOR PARAMETER
{{ZER{R6{{{SET NEW STATE
{{BGT{R7{#NUM02{EXP01{LOOP BACK UNLESS OUTER LEVEL
{{ERB{223{SYNTAX{{ERROR. INVALID USE OF COMMA
{{EJC{{{{
*
* EXPAN (CONTINUED)
*
* HERE FOR RPR (S=2)
*
* AT OUTER LEVEL IN A NORMAL GOTO THIS IS A TERMINATOR
* OTHERWISE IT MUST TERMINATE A FUNCTION OR GROUPING
*
{EXP12{BEQ{R7{#NUM01{EXP20{END OF NORMAL GOTO
{{BEQ{R7{#NUM05{EXP13{END OF FUNCTION ARGUMENTS
{{BEQ{R7{#NUM04{EXP14{END OF GROUPING / SELECTION
{{ERB{224{SYNTAX{{ERROR. UNBALANCED RIGHT PARENTHESIS
*
* HERE AT END OF FUNCTION ARGUMENTS
*
{EXP13{MOV{#C$FNC{R10{{SET CMTYP VALUE FOR FUNCTION
{{BRN{EXP15{{{JUMP TO BUILD CMBLK
*
* HERE FOR END OF GROUPING
*
{EXP14{BEQ{R8{#NUM01{EXP17{JUMP IF END OF GROUPING
{{MOV{#C$SEL{R10{{ELSE SET CMTYP FOR SELECTION
*
* MERGE HERE TO BUILD CMBLK FOR LEVEL JUST SCANNED AND
* TO POP UP TO THE PREVIOUS SCAN LEVEL BEFORE CONTINUING.
*
{EXP15{JSR{EXPDM{{{DUMP OPERATORS AT THIS LEVEL
{{MOV{R8{R6{{COPY COUNT
{{ADD{#CMVLS{R6{{ADD FOR STANDARD FIELDS AT START
{{WTB{R6{{{CONVERT LENGTH TO BYTES
{{JSR{ALLOC{{{ALLOCATE SPACE FOR CMBLK
{{MOV{#B$CMT{(R9){{STORE TYPE CODE FOR CMBLK
{{MOV{R10{4*CMTYP(R9){{STORE CMBLK NODE TYPE INDICATOR
{{MOV{R6{4*CMLEN(R9){{STORE LENGTH
{{ADD{R6{R9{{POINT PAST END OF BLOCK
{{LCT{R8{R8{{SET LOOP COUNTER
*
* LOOP TO MOVE REMAINING WORDS TO CMBLK
*
{EXP16{MOV{(SP)+{-(R9){{MOVE ONE OPERAND PTR FROM STACK
{{MOV{(SP)+{R7{{POP TO OLD LEVEL INDICATOR
{{BCT{R8{EXP16{{LOOP TILL ALL MOVED
{{EJC{{{{
*
* EXPAN (CONTINUED)
*
* COMPLETE CMBLK AND STACK POINTER TO IT ON STACK
*
{{SUB{#4*CMVLS{R9{{POINT BACK TO START OF BLOCK
{{MOV{(SP)+{R8{{RESTORE OLD COUNTER
{{MOV{(SP){4*CMOPN(R9){{STORE OPERAND PTR IN CMBLK
{{MOV{R9{(SP){{STACK CMBLK POINTER
{{MOV{#NUM02{R6{{SET NEW STATE
{{BRN{EXP01{{{BACK FOR NEXT ELEMENT
*
* HERE AT END OF A PARENTHESIZED EXPRESSION
*
{EXP17{JSR{EXPDM{{{DUMP OPERATORS AT THIS LEVEL
{{MOV{(SP)+{R9{{RESTORE XR
{{MOV{(SP)+{R7{{RESTORE OUTER LEVEL
{{MOV{(SP)+{R8{{RESTORE OUTER COUNT
{{MOV{R9{(SP){{STORE OPND OVER UNUSED CMOPN VAL
{{MOV{#NUM02{R6{{SET NEW STATE
{{BRN{EXP01{{{BACK FOR NEXT ELE8ENT
*
* HERE FOR RBR (S=2)
*
* AT OUTER LEVEL IN A DIRECT GOTO, THIS IS A TERMINATOR.
* OTHERWISE IT MUST TERMINATE A SUBSCRIPT LIST.
*
{EXP18{MOV{#C$ARR{R10{{SET CMTYP FOR ARRAY REFERENCE
{{BEQ{R7{#NUM03{EXP15{JUMP TO BUILD CMBLK IF END ARRAYREF
{{BEQ{R7{#NUM02{EXP20{JUMP IF END OF DIRECT GOTO
{{ERB{225{SYNTAX{{ERROR. UNBALANCED RIGHT BRACKET
{{EJC{{{{
*
* EXPAN (CONTINUED)
*
* HERE FOR COL,SMC (S=2)
*
* ERROR UNLESS TERMINATING STATEMENT BODY AT OUTER LEVEL
*
{EXP19{MNZ{SCNRS{{{RESCAN TERMINATOR
{{MOV{R7{R10{{COPY LEVEL INDICATOR
{{BSW{R10{6{{SWITCH ON LEVEL INDICATOR
{{IFF{0{EXP20{{NORMAL OUTER LEVEL
{{IFF{1{EXP22{{FAIL IF NORMAL GOTO
{{IFF{2{EXP23{{FAIL IF DIRECT GOTO
{{IFF{3{EXP24{{FAIL ARRAY BRACKETS
{{IFF{4{EXP21{{FAIL IF IN GROUPING
{{IFF{5{EXP21{{FAIL FUNCTION ARGS
{{ESW{{{{END SWITCH ON LEVEL
*
* HERE AT NORMAL END OF EXPRESSION
*
{EXP20{JSR{EXPDM{{{DUMP REMAINING OPERATORS
{{MOV{(SP)+{R9{{LOAD TREE POINTER
{{ICA{SP{{{POP OFF BOTTOM OF STACK MARKER
{{EXI{{{{RETURN TO EXPAN CALLER
*
* MISSING RIGHT PAREN
*
{EXP21{ERB{226{SYNTAX{{ERROR. MISSING RIGHT PAREN
*
* MISSING RIGHT PAREN IN GOTO FIELD
*
{EXP22{ERB{227{SYNTAX{{ERROR. RIGHT PAREN MISSING FROM GOTO
*
* MISSING BRACKET IN GOTO
*
{EXP23{ERB{228{SYNTAX{{ERROR. RIGHT BRACKET MISSING FROM GOTO
*
* MISSING ARRAY BRACKET
*
{EXP24{ERB{229{SYNTAX{{ERROR. MISSING RIGHT ARRAY BRACKET
{{EJC{{{{
*
* EXPAN (CONTINUED)
*
* LOOP HERE WHEN AN OPERATOR CAUSES AN OPERATOR DUMP
*
{EXP25{MOV{R9{EXPSV{{
{{JSR{EXPOP{{{POP ONE OPERATOR
{{MOV{EXPSV{R9{{RESTORE OP DV POINTER AND MERGE
*
* HERE FOR BOP (S=2)
*
* REMOVE OPERATORS (CONDENSE) FROM STACK UNTIL NO MORE
* LEFT AT THIS LEVEL OR TOP ONE HAS LOWER PRECEDENCE.
* LOOP HERE TILL THIS CONDITION IS MET.
*
{EXP26{MOV{4*1(SP){R10{{LOAD OPERATOR DVPTR FROM STACK
{{BLE{R10{#NUM05{EXP27{JUMP IF BOTTOM OF STACK LEVEL
{{BLT{4*DVRPR(R9){4*DVLPR(R10){EXP25{ELSE POP IF NEW PREC IS LO
*
* HERE FOR UOP (S=0,1)
*
* BINARY OPERATOR MERGES AFTER PRECEDENCE CHECK
*
* THE OPERATOR DV IS STORED ON THE STACK AND THE SCAN
* CONTINUES AFTER SETTING THE SCAN STATE TO ONE.
*
{EXP27{MOV{R9{-(SP){{STACK OPERATOR DVPTR ON STACK
{{CHK{{{{CHECK FOR STACK OVERFLOW
{{MOV{#NUM01{R6{{SET NEW STATE
{{BNE{R9{#OPDVS{EXP01{BACK FOR NEXT ELEMENT UNLESS =
*
* HERE FOR SPECIAL CASE OF BINARY =. THE SYNTAX ALLOWS A
* NULL RIGHT ARGUMENT FOR THIS OPERATOR TO BE LEFT
* OUT. ACCORDINGLY WE RESET TO STATE ZERO TO GET PROPER
* ACTION ON A TERMINATOR (SUPPLY A NULL CONSTANT).
*
{{ZER{R6{{{SET STATE ZERO
{{BRN{EXP01{{{JUMP FOR NEXT ELEMENT
{{ENP{{{{END PROCEDURE EXPAN
{{EJC{{{{
*
* EXPAP -- TEST FOR PATTERN MATCH TREE
*
* EXPAP IS PASSED AN EXPRESSION TREE TO DETERMINE IF IT
* IS A PATTERN MATCH. THE FOLLOWING ARE RECOGIZED AS
* MATCHES IN THE CONTEXT OF THIS CALL.
*
* 1) AN EXPLICIT USE OF BINARY QUESTION MARK
* 2) A CONCATENATION
* 3) AN ALTERNATION WHOSE LEFT OPERAND IS A CONCATENATION
*
* (XR) PTR TO EXPAN TREE
* JSR EXPAP CALL TO TEST FOR PATTERN MATCH
* PPM LOC TRANSFER LOC IF NOT A PATTERN MATCH
* (WA) DESTROYED
* (XR) UNCHANGED (IF NOT MATCH)
* (XR) PTR TO BINARY OPERATOR BLK IF MATCH
*
{EXPAP{PRC{E{1{{ENTRY POINT
{{MOV{R10{-(SP){{SAVE XL
{{BNE{(R9){#B$CMT{EXPP2{NO MATCH IF NOT COMPLEX
{{MOV{4*CMTYP(R9){R6{{ELSE LOAD TYPE CODE
{{BEQ{R6{#C$CNC{EXPP1{CONCATENATION IS A MATCH
{{BEQ{R6{#C$PMT{EXPP1{BINARY QUESTION MARK IS A MATCH
{{BNE{R6{#C$ALT{EXPP2{ELSE NOT MATCH UNLESS ALTERNATION
*
* HERE FOR ALTERNATION. CHANGE (A B) / C TO A QM (B / C)
*
{{MOV{4*CMLOP(R9){R10{{LOAD LEFT OPERAND POINTER
{{BNE{(R10){#B$CMT{EXPP2{NOT MATCH IF LEFT OPND NOT COMPLEX
{{BNE{4*CMTYP(R10){#C$CNC{EXPP2{NOT MATCH IF LEFT OP NOT CONC
{{MOV{4*CMROP(R10){4*CMLOP(R9){{XR POINTS TO (B / C)
{{MOV{R9{4*CMROP(R10){{SET XL OPNDS TO A, (B / C)
{{MOV{R10{R9{{POINT TO THIS ALTERED NODE
*
* EXIT HERE FOR PATTERN MATCH
*
{EXPP1{MOV{(SP)+{R10{{RESTORE ENTRY XL
{{EXI{{{{GIVE PATTERN MATCH RETURN
*
* EXIT HERE IF NOT PATTERN MATCH
*
{EXPP2{MOV{(SP)+{R10{{RESTORE ENTRY XL
{{EXI{1{{{GIVE NON-MATCH RETURN
{{ENP{{{{END PROCEDURE EXPAP
{{EJC{{{{
*
* EXPDM -- DUMP OPERATORS AT CURRENT LEVEL (FOR EXPAN)
*
* EXPDM USES EXPOP TO CONDENSE ALL OPERATORS AT THIS SYNTAX
* LEVEL. THE STACK BOTTOM IS RECOGNIZED FROM THE LEVEL
* VALUE WHICH IS SAVED ON THE TOP OF THE STACK.
*
* JSR EXPDM CALL TO DUMP OPERATORS
* (XS) POPPED AS REQUIRED
* (XR,WA) DESTROYED
*
{EXPDM{PRC{N{0{{ENTRY POINT
{{MOV{R10{R$EXS{{SAVE XL VALUE
*
* LOOP TO DUMP OPERATORS
*
{EXDM1{BLE{4*1(SP){#NUM05{EXDM2{JUMP IF STACK BOTTOM (SAVED LEVEL
{{JSR{EXPOP{{{ELSE POP ONE OPERATOR
{{BRN{EXDM1{{{AND LOOP BACK
*
* HERE AFTER POPPING ALL OPERATORS
*
{EXDM2{MOV{R$EXS{R10{{RESTORE XL
{{ZER{R$EXS{{{RELEASE SAVE LOCATION
{{EXI{{{{RETURN TO EXPDM CALLER
{{ENP{{{{END PROCEDURE EXPDM
{{EJC{{{{
*
* EXPOP-- POP OPERATOR (FOR EXPAN)
*
* EXPOP IS USED BY THE EXPAN ROUTINE TO CONDENSE ONE
* OPERATOR FROM THE TOP OF THE SYNTAX STACK. AN APPROPRIATE
* CMBLK IS BUILT FOR THE OPERATOR (UNARY OR BINARY) AND A
* POINTER TO THIS CMBLK IS STACKED.
*
* EXPOP IS ALSO USED BY SCNGF (GOTO FIELD SCAN) PROCEDURE
*
* JSR EXPOP CALL TO POP OPERATOR
* (XS) POPPED APPROPRIATELY
* (XR,XL,WA) DESTROYED
*
{EXPOP{PRC{N{0{{ENTRY POINT
{{MOV{4*1(SP){R9{{LOAD OPERATOR DV POINTER
{{BEQ{4*DVLPR(R9){#LLUNO{EXPO2{JUMP IF UNARY
*
* HERE FOR BINARY OPERATOR
*
{{MOV{#4*CMBS${R6{{SET SIZE OF BINARY OPERATOR CMBLK
{{JSR{ALLOC{{{ALLOCATE SPACE FOR CMBLK
{{MOV{(SP)+{4*CMROP(R9){{POP AND STORE RIGHT OPERAND PTR
{{MOV{(SP)+{R10{{POP AND LOAD OPERATOR DV PTR
{{MOV{(SP){4*CMLOP(R9){{STORE LEFT OPERAND POINTER
*
* COMMON EXIT POINT
*
{EXPO1{MOV{#B$CMT{(R9){{STORE TYPE CODE FOR CMBLK
{{MOV{4*DVTYP(R10){4*CMTYP(R9){{STORE CMBLK NODE TYPE CODE
{{MOV{R10{4*CMOPN(R9){{STORE DVPTR (=PTR TO DAC O$XXX)
{{MOV{R6{4*CMLEN(R9){{STORE CMBLK LENGTH
{{MOV{R9{(SP){{STORE RESULTING NODE PTR ON STACK
{{EXI{{{{RETURN TO EXPOP CALLER
*
* HERE FOR UNARY OPERATOR
*
{EXPO2{MOV{#4*CMUS${R6{{SET SIZE OF UNARY OPERATOR CMBLK
{{JSR{ALLOC{{{ALLOCATE SPACE FOR CMBLK
{{MOV{(SP)+{4*CMROP(R9){{POP AND STORE OPERAND POINTER
{{MOV{(SP){R10{{LOAD OPERATOR DV POINTER
{{BRN{EXPO1{{{MERGE BACK TO EXIT
{{ENP{{{{END PROCEDURE EXPOP
{{EJC{{{{
*
* FLSTG -- FOLD STRING TO UPPER CASE
*
* FLSTG FOLDS A CHARACTER STRING CONTAINING LOWER CASE
* CHARACCTERS TO ONE CONTAINING UPPER CASE CHARACTERS.
* FOLDING IS ONLY DONE IF &CASE (KVCAS) IS NOT ZERO.
*
* (XR) STRING ARGUMENT
* (WA) LENGTH OF STRING
* JSR FLSTG CALL TO FOLD STRING
* (XR) RESULT STRING (POSSIBLY ORIGINAL)
* (WC) DESTROYED
*
{FLSTG{PRC{R{0{{ENTRY POINT
{{BZE{KVCAS{FST99{{SKIP IF &CASE IS 0
{{MOV{R10{-(SP){{SAVE XL ACROSS CALL
{{MOV{R9{-(SP){{SAVE ORIGINAL SCBLK PTR
{{JSR{ALOCS{{{ALLOCATE NEW STRING BLOCK
{{MOV{(SP){R10{{POINT TO ORIGINAL SCBLK
{{MOV{R9{-(SP){{SAVE POINTER TO NEW SCBLK
{{PLC{R10{{{POINT TO ORIGINAL CHARS
{{PLC{R9{{{POINT TO NEW CHARS
{{ZER{-(SP){{{INIT DID FOLD FLAG
{{LCT{R8{R8{{LOAD LOOP COUNTER
{FST01{LCH{R6{(R10)+{{LOAD CHARACTER
{{BGT{#CH$$A{R6{FST02{SKIP IF LESS THAN LC A
{{BGT{R6{#CH$$${FST02{SKIP IF GREATER THAN LC Z
{{FLC{R6{{{FOLD CHARACTER TO UPPER CASE
{{MNZ{(SP){{{SET DID FOLD CHARACTER FLAG
{FST02{SCH{R6{(R9)+{{STORE (POSSIBLY FOLDED) CHARACTER
{{BCT{R8{FST01{{LOOP THRU ENTIRE STRING
{{CSC{R9{{{COMPLETE STORE CHARACTERS
{{BNZ{(SP)+{FST10{{SKIP IF FOLDING DONE
{{MOV{(SP)+{DNAMP{{DO NOT NEED NEW SCBLK
{{MOV{(SP)+{R9{{RETURN ORIGINAL SCBLK
{{BRN{FST20{{{MERGE BELOW
{FST10{MOV{(SP)+{R9{{RETURN NEW SCBLK
{{ICA{SP{{{THROW AWAY ORIGINAL SCBLK POINTER
{FST20{MOV{4*SCLEN(R9){R6{{RELOAD STRING LENGTH
{{MOV{(SP)+{R10{{RESTORE XL
{FST99{EXI{{{{RETURN
{{ENP{{{{
{{EJC{{{{
*
* GBCOL -- PERFORM GARBAGE COLLECTION
*
* GBCOL PERFORMS A GARBAGE COLLECTION ON THE DYNAMIC REGION
* ALL BLOCKS WHICH ARE NO LONGER IN USE ARE ELIMINATED
* BY MOVING BLOCKS WHICH ARE IN USE DOWN AND RESETTING
* DNAMP, THE POINTER TO THE NEXT AVAILABLE LOCATION.
*
* (WB) MOVE OFFSET (SEE BELOW)
* JSR GBCOL CALL TO COLLECT GARBAGE
* (XR) DESTROYED
*
* THE FOLLOWING CONDITIONS MUST BE MET AT THE TIME WHEN
* GBCOL IS CALLED.
*
* 1) ALL POINTERS TO BLOCKS IN THE DYNAMIC AREA MUST BE
* ACCESSIBLE TO THE GARBAGE COLLECTOR. THIS MEANS
* THAT THEY MUST OCCUR IN ONE OF THE FOLLOWING.
*
* A) MAIN STACK, WITH CURRENT TOP
* ELEMENT BEING INDICATED BY XS
*
* B) IN RELOCATABLE FIELDS OF VRBLKS.
*
* C) IN REGISTER XL AT THE TIME OF CALL
*
* E) IN THE SPECIAL REGION OF WORKING
* STORAGE WHERE NAMES BEGIN WITH R$.
*
* 2) ALL POINTERS MUST POINT TO THE START OF BLOCKS WITH
* THE SOLE EXCEPTION OF THE CONTENTS OF THE CODE
* POINTER REGISTER WHICH POINTS INTO THE R$COD BLOCK.
*
* 3) NO LOCATION WHICH APPEARS TO CONTAIN A POINTER
* INTO THE DYNAMIC REGION MAY OCCUR UNLESS IT IS IN
* FACT A POINTER TO THE START OF THE BLOCK. HOWEVER
* POINTERS OUTSIDE THIS AREA MAY OCCUR AND WILL
* NOT BE CHANGED BY THE GARBAGE COLLECTOR.
* IT IS ESPECIALLY IMPORTANT TO MAKE SURE THAT XL
* DOES NOT CONTAIN A GARBAGE VALUE FROM SOME PROCESS
* CARRIED OUT BEFORE THE CALL TO THE COLLECTOR.
*
* GBCOL HAS THE CAPABILITY OF MOVING THE FINAL COMPACTED
* RESULT UP IN MEMORY (WITH ADDRESSES ADJUSTED ACCORDINGLY)
* THIS IS USED TO ADD SPACE TO THE STATIC REGION. THE
* ENTRY VALUE OF WB IS THE NUMBER OF BYTES TO MOVE UP.
* THE CALLER MUST GUARANTEE THAT THERE IS ENOUGH ROOM.
* FURTHERMORE THE VALUE IN WB IF IT IS NON-ZERO, MUST BE AT
* LEAST 256 SO THAT THE MWB INSTRUCTION CONDITIONS ARE MET.
{{EJC{{{{
*
* GBCOL (CONTINUED)
*
* THE ALGORITHM, WHICH IS A MODIFICATION OF THE LISP-2
* GARBAGE COLLECTOR DEVISED BY R.DEWAR AND K.BELCHER
* TAKES THREE PASSES AS FOLLOWS.
*
* 1) ALL POINTERS IN MEMORY ARE SCANNED AND BLOCKS IN USE
* DETERMINED FROM THIS SCAN. NOTE THAT THIS PROCEDURE
* IS RECURSIVE AND USES THE MAIN STACK FOR LINKAGE.
* THE MARKING PROCESS IS THUS SIMILAR TO THAT USED IN
* A STANDARD LISP COLLECTOR. HOWEVER THE METHOD OF
* ACTUALLY MARKING THE BLOCKS IS DIFFERENT.
*
* THE FIRST FIELD OF A BLOCK NORMALLY CONTAINS A
* CODE ENTRY POINT POINTER. SUCH AN ENTRY POINTER
* CAN BE DISTINGUISHED FROM THE ADDRESS OF ANY POINTER
* TO BE PROCESSED BY THE COLLECTOR. DURING GARBAGE
* COLLECTION, THIS WORD IS USED TO BUILD A BACK CHAIN
* OF POINTERS THROUGH FIELDS WHICH POINT TO THE BLOCK.
* THE END OF THE CHAIN IS MARKED BY THE OCCURENCE
* OF THE WORD WHICH USED TO BE IN THE FIRST WORD OF
* THE BLOCK. THIS BACKCHAIN SERVES BOTH AS A MARK
* INDICATING THAT THE BLOCK IS IN USE AND AS A LIST OF
* REFERENCES FOR THE RELOCATION PHASE.
*
* 2) STORAGE IS SCANNED SEQUENTIALLY TO DISCOVER WHICH
* BLOCKS ARE CURRENTLY IN USE AS INDICATED BY THE
* PRESENCE OF A BACKCHAIN. TWO POINTERS ARE MAINTAINED
* ONE SCANS THROUGH LOOKING AT EACH BLOCK. THE OTHER
* IS INCREMENTED ONLY FOR BLOCKS FOUND TO BE IN USE.
* IN THIS WAY, THE EVENTUAL LOCATION OF EACH BLOCK CAN
* BE DETERMINED WITHOUT ACTUALLY MOVING ANY BLOCKS.
* AS EACH BLOCK WHICH IS IN USE IS PROCESSED, THE BACK
* CHAIN IS USED TO RESET ALL POINTERS WHICH POINT TO
* THIS BLOCK TO CONTAIN ITS NEW ADDRESS, I.E. THE
* ADDRESS IT WILL OCCUPY AFTER THE BLOCKS ARE MOVED.
* THE FIRST WORD OF THE BLOCK, TAKEN FROM THE END OF
* THE CHAIN IS RESTORED AT THIS POINT.
*
* DURING PASS 2, THE COLLECTOR BUILDS BLOCKS WHICH
* DESCRIBE THE REGIONS OF STORAGE WHICH ARE TO BE
* MOVED IN THE THIRD PASS. THERE IS ONE DESCRIPTOR FOR
* EACH CONTIGUOUS SET OF GOOD BLOCKS. THE DESCRIPTOR
* IS BUILT JUST BEHIND THE BLOCK TO BE MOVED AND
* CONTAINS A POINTER TO THE NEXT BLOCK AND THE NUMBER
* OF WORDS TO BE MOVED.
*
* 3) IN THE THIRD AND FINAL PASS, THE MOVE DESCRIPTOR
* BLOCKS BUILT IN PASS TWO ARE USED TO ACTUALLY MOVE
* THE BLOCKS DOWN TO THE BOTTOM OF THE DYNAMIC REGION.
* THE COLLECTION IS THEN COMPLETE AND THE NEXT
* AVAILABLE LOCATION POINTER IS RESET.
{{EJC{{{{
*
* GBCOL (CONTINUED)
*
{GBCOL{PRC{E{0{{ENTRY POINT
{{BNZ{DMVCH{GBC14{{FAIL IF IN MID-DUMP
{{MNZ{GBCFL{{{NOTE GBCOL ENTERED
{{MOV{R6{GBSVA{{SAVE ENTRY WA
{{MOV{R7{GBSVB{{SAVE ENTRY WB
{{MOV{R8{GBSVC{{SAVE ENTRY WC
{{MOV{R10{-(SP){{SAVE ENTRY XL
{{SCP{R6{{{GET CODE POINTER VALUE
{{SUB{R$COD{R6{{MAKE RELATIVE
{{LCP{R6{{{AND RESTORE
*
* PROCESS STACK ENTRIES
*
{{MOV{SP{R9{{POINT TO STACK FRONT
{{MOV{STBAS{R10{{POINT PAST END OF STACK
{{BGE{R10{R9{GBC00{OK IF D-STACK
{{MOV{R10{R9{{REVERSE IF ...
{{MOV{SP{R10{{... U-STACK
*
* PROCESS THE STACK
*
{GBC00{JSR{GBCPF{{{PROCESS POINTERS ON STACK
*
* PROCESS SPECIAL WORK LOCATIONS
*
{{MOV{#R$AAA{R9{{POINT TO START OF RELOCATABLE LOCS
{{MOV{#R$YYY{R10{{POINT PAST END OF RELOCATABLE LOCS
{{JSR{GBCPF{{{PROCESS WORK FIELDS
*
* PREPARE TO PROCESS VARIABLE BLOCKS
*
{{MOV{HSHTB{R6{{POINT TO FIRST HASH SLOT POINTER
*
* LOOP THROUGH HASH SLOTS
*
{GBC01{MOV{R6{R10{{POINT TO NEXT SLOT
{{ICA{R6{{{BUMP BUCKET POINTER
{{MOV{R6{GBCNM{{SAVE BUCKET POINTER
{{EJC{{{{
*
* GBCOL (CONTINUED)
*
* LOOP THROUGH VARIABLES ON ONE HASH CHAIN
*
{GBC02{MOV{(R10){R9{{LOAD PTR TO NEXT VRBLK
{{BZE{R9{GBC03{{JUMP IF END OF CHAIN
{{MOV{R9{R10{{ELSE COPY VRBLK POINTER
{{ADD{#4*VRVAL{R9{{POINT TO FIRST RELOC FLD
{{ADD{#4*VRNXT{R10{{POINT PAST LAST (AND TO LINK PTR)
{{JSR{GBCPF{{{PROCESS RELOC FIELDS IN VRBLK
{{BRN{GBC02{{{LOOP BACK FOR NEXT BLOCK
*
* HERE AT END OF ONE HASH CHAIN
*
{GBC03{MOV{GBCNM{R6{{RESTORE BUCKET POINTER
{{BNE{R6{HSHTE{GBC01{LOOP BACK IF MORE BUCKETS TO GO
{{EJC{{{{
*
* GBCOL (CONTINUED)
*
* NOW WE ARE READY TO START PASS TWO. REGISTERS ARE USED
* AS FOLLOWS IN PASS TWO.
*
* (XR) SCANS THROUGH ALL BLOCKS
* (WC) POINTER TO EVENTUAL LOCATION
*
* THE MOVE DESCRIPTION BLOCKS BUILT IN THIS PASS HAVE
* THE FOLLOWING FORMAT.
*
* WORD 1 POINTER TO NEXT MOVE BLOCK,
* ZERO IF END OF CHAIN OF BLOCKS
*
* WORD 2 LENGTH OF BLOCKS TO BE MOVED IN
* BYTES. SET TO THE ADDRESS OF THE
* FIRST BYTE WHILE ACTUALLY SCANNING
* THE BLOCKS.
*
* THE FIRST ENTRY ON THIS CHAIN IS A SPECIAL ENTRY
* CONSISTING OF THE TWO WORDS GBCNM AND GBCNS. AFTER
* BUILDING THE CHAIN OF MOVE DESCRIPTORS, GBCNM POINTS TO
* THE FIRST REAL MOVE BLOCK, AND GBCNS IS THE LENGTH OF
* BLOCKS IN USE AT THE START OF STORAGE WHICH NEED NOT
* BE MOVED SINCE THEY ARE IN THE CORRECT POSITION.
*
{GBC04{MOV{DNAMB{R9{{POINT TO FIRST BLOCK
{{MOV{R9{R8{{SET AS FIRST EVENTUAL LOCATION
{{ADD{GBSVB{R8{{ADD OFFSET FOR EVENTUAL MOVE UP
{{ZER{GBCNM{{{CLEAR INITIAL FORWARD POINTER
{{MOV{#GBCNM{GBCLM{{INITIALIZE PTR TO LAST MOVE BLOCK
{{MOV{R9{GBCNS{{INITIALIZE FIRST ADDRESS
*
* LOOP THROUGH A SERIES OF BLOCKS IN USE
*
{GBC05{BEQ{R9{DNAMP{GBC07{JUMP IF END OF USED REGION
{{MOV{(R9){R6{{ELSE GET FIRST WORD
{{BHI{R6{#P$YYY{GBC06{SKIP IF NOT ENTRY PTR (IN USE)
{{BHI{R6{#B$AAA{GBC07{JUMP IF ENTRY POINTER (UNUSED)
*
* HERE FOR BLOCK IN USE, LOOP TO RELOCATE REFERENCES
*
{GBC06{MOV{R6{R10{{COPY POINTER
{{MOV{(R10){R6{{LOAD FORWARD POINTER
{{MOV{R8{(R10){{RELOCATE REFERENCE
{{BHI{R6{#P$YYY{GBC06{LOOP BACK IF NOT END OF CHAIN
{{BLO{R6{#B$AAA{GBC06{LOOP BACK IF NOT END OF CHAIN
{{EJC{{{{
*
* GBCOL (CONTINUED)
*
* AT END OF CHAIN, RESTORE FIRST WORD AND BUMP PAST
*
{{MOV{R6{(R9){{RESTORE FIRST WORD
{{JSR{BLKLN{{{GET LENGTH OF THIS BLOCK
{{ADD{R6{R9{{BUMP ACTUAL POINTER
{{ADD{R6{R8{{BUMP EVENTUAL POINTER
{{BRN{GBC05{{{LOOP BACK FOR NEXT BLOCK
*
* HERE AT END OF A SERIES OF BLOCKS IN USE
*
{GBC07{MOV{R9{R6{{COPY POINTER PAST LAST BLOCK
{{MOV{GBCLM{R10{{POINT TO PREVIOUS MOVE BLOCK
{{SUB{4*1(R10){R6{{SUBTRACT STARTING ADDRESS
{{MOV{R6{4*1(R10){{STORE LENGTH OF BLOCK TO BE MOVED
*
* LOOP THROUGH A SERIES OF BLOCKS NOT IN USE
*
{GBC08{BEQ{R9{DNAMP{GBC10{JUMP IF END OF USED REGION
{{MOV{(R9){R6{{ELSE LOAD FIRST WORD OF NEXT BLOCK
{{BHI{R6{#P$YYY{GBC09{JUMP IF IN USE
{{BLO{R6{#B$AAA{GBC09{JUMP IF IN USE
{{JSR{BLKLN{{{ELSE GET LENGTH OF NEXT BLOCK
{{ADD{R6{R9{{PUSH POINTER
{{BRN{GBC08{{{AND LOOP BACK
*
* HERE FOR A BLOCK IN USE AFTER PROCESSING A SERIES OF
* BLOCKS WHICH WERE NOT IN USE, BUILD NEW MOVE BLOCK.
*
{GBC09{SUB{#4*NUM02{R9{{POINT 2 WORDS BEHIND FOR MOVE BLOCK
{{MOV{GBCLM{R10{{POINT TO PREVIOUS MOVE BLOCK
{{MOV{R9{(R10){{SET FORWARD PTR IN PREVIOUS BLOCK
{{ZER{(R9){{{ZERO FORWARD PTR OF NEW BLOCK
{{MOV{R9{GBCLM{{REMEMBER ADDRESS OF THIS BLOCK
{{MOV{R9{R10{{COPY PTR TO MOVE BLOCK
{{ADD{#4*NUM02{R9{{POINT BACK TO BLOCK IN USE
{{MOV{R9{4*1(R10){{STORE STARTING ADDRESS
{{BRN{GBC06{{{JUMP TO PROCESS BLOCK IN USE
{{EJC{{{{
*
* GBCOL (CONTINUED)
*
* HERE FOR PASS THREE -- ACTUALLY MOVE THE BLOCKS DOWN
*
* (XL) POINTER TO OLD LOCATION
* (XR) POINTER TO NEW LOCATION
*
{GBC10{MOV{DNAMB{R9{{POINT TO START OF STORAGE
{{ADD{GBCNS{R9{{BUMP PAST UNMOVED BLOCKS AT START
*
* LOOP THROUGH MOVE DESCRIPTORS
*
{GBC11{MOV{GBCNM{R10{{POINT TO NEXT MOVE BLOCK
{{BZE{R10{GBC12{{JUMP IF END OF CHAIN
{{MOV{(R10)+{GBCNM{{MOVE POINTER DOWN CHAIN
{{MOV{(R10)+{R6{{GET LENGTH TO MOVE
{{MVW{{{{PERFORM MOVE
{{BRN{GBC11{{{LOOP BACK
*
* NOW TEST FOR MOVE UP
*
{GBC12{MOV{R9{DNAMP{{SET NEXT AVAILABLE LOC PTR
{{MOV{GBSVB{R7{{RELOAD MOVE OFFSET
{{BZE{R7{GBC13{{JUMP IF NO MOVE REQUIRED
{{MOV{R9{R10{{ELSE COPY OLD TOP OF CORE
{{ADD{R7{R9{{POINT TO NEW TOP OF CORE
{{MOV{R9{DNAMP{{SAVE NEW TOP OF CORE POINTER
{{MOV{R10{R6{{COPY OLD TOP
{{SUB{DNAMB{R6{{MINUS OLD BOTTOM = LENGTH
{{ADD{R7{DNAMB{{BUMP BOTTOM TO GET NEW VALUE
{{MWB{{{{PERFORM MOVE (BACKWARDS)
*
* MERGE HERE TO EXIT
*
{GBC13{MOV{GBSVA{R6{{RESTORE WA
{{SCP{R8{{{GET CODE POINTER
{{ADD{R$COD{R8{{MAKE ABSOLUTE AGAIN
{{LCP{R8{{{AND REPLACE ABSOLUTE VALUE
{{MOV{GBSVC{R8{{RESTORE WC
{{MOV{(SP)+{R10{{RESTORE ENTRY XL
{{ICV{GBCNT{{{INCREMENT COUNT OF COLLECTIONS
{{ZER{R9{{{CLEAR GARBAGE VALUE IN XR
{{ZER{GBCFL{{{NOTE EXIT FROM GBCOL
{{EXI{{{{EXIT TO GBCOL CALLER
*
* GARBAGE COLLECTION NOT ALLOWED WHILST DUMPING
*
{GBC14{ICV{ERRFT{{{FATAL ERROR
{{ERB{250{INSUFFICIENT{{MEMORY TO COMPLETE DUMP
{{ENP{{{{END PROCEDURE GBCOL
{{EJC{{{{
*
* GBCPF -- PROCESS FIELDS FOR GARBAGE COLLECTOR
*
* THIS PROCEDURE IS USED BY THE GARBAGE COLLECTOR TO
* PROCESS FIELDS IN PASS ONE. SEE GBCOL FOR FULL DETAILS.
*
* (XR) PTR TO FIRST LOCATION TO PROCESS
* (XL) PTR PAST LAST LOCATION TO PROCESS
* JSR GBCPF CALL TO PROCESS FIELDS
* (XR,WA,WB,WC,IA) DESTROYED
*
* NOTE THAT ALTHOUGH THIS PROCEDURE USES A RECURSIVE
* APPROACH, IT CONTROLS ITS OWN STACK AND IS NOT RECURSIVE.
*
{GBCPF{PRC{E{0{{ENTRY POINT
{{ZER{-(SP){{{SET ZERO TO MARK BOTTOM OF STACK
{{MOV{R10{-(SP){{SAVE END POINTER
*
* MERGE HERE TO GO DOWN A LEVEL AND START A NEW LOOP
*
* 1(XS) NEXT LVL FIELD PTR (0 AT OUTER LVL)
* 0(XS) PTR PAST LAST FIELD TO PROCESS
* (XR) PTR TO FIRST FIELD TO PROCESS
*
* LOOP TO PROCESS SUCCESSIVE FIELDS
*
{GPF01{MOV{(R9){R10{{LOAD FIELD CONTENTS
{{MOV{R9{R8{{SAVE FIELD POINTER
{{BLT{R10{DNAMB{GPF02{JUMP IF NOT PTR INTO DYNAMIC AREA
{{BGE{R10{DNAMP{GPF02{JUMP IF NOT PTR INTO DYNAMIC AREA
*
* HERE WE HAVE A PTR TO A BLOCK IN THE DYNAMIC AREA.
* LINK THIS FIELD ONTO THE REFERENCE BACKCHAIN.
*
{{MOV{(R10){R6{{LOAD PTR TO CHAIN (OR ENTRY PTR)
{{MOV{R9{(R10){{SET THIS FIELD AS NEW HEAD OF CHAIN
{{MOV{R6{(R9){{SET FORWARD POINTER
*
* NOW SEE IF THIS BLOCK HAS BEEN PROCESSED BEFORE
*
{{BHI{R6{#P$YYY{GPF02{JUMP IF ALREADY PROCESSED
{{BHI{R6{#B$AAA{GPF03{JUMP IF NOT ALREADY PROCESSED
*
* HERE TO MOVE TO NEXT FIELD
*
{GPF02{MOV{R8{R9{{RESTORE FIELD POINTER
{{ICA{R9{{{BUMP TO NEXT FIELD
{{BNE{R9{(SP){GPF01{LOOP BACK IF MORE TO GO
{{EJC{{{{
*
* GBCPF (CONTINUED)
*
* HERE WE POP UP A LEVEL AFTER FINISHING A BLOCK
*
{{MOV{(SP)+{R10{{RESTORE POINTER PAST END
{{MOV{(SP)+{R8{{RESTORE BLOCK POINTER
{{BNZ{R8{GPF02{{CONTINUE LOOP UNLESS OUTER LEVL
{{EXI{{{{RETURN TO CALLER IF OUTER LEVEL
*
* HERE TO PROCESS AN ACTIVE BLOCK WHICH HAS NOT BEEN DONE
*
{GPF03{MOV{R10{R9{{COPY BLOCK POINTER
{{MOV{R6{R10{{COPY FIRST WORD OF BLOCK
{{LEI{R10{{{LOAD ENTRY POINT ID (BL$XX)
*
* BLOCK TYPE SWITCH. NOTE THAT BLOCKS WITH NO RELOCATABLE
* FIELDS JUST RETURN TO GPF02 HERE TO CONTINE TO NEXT FLD.
*
{{BSW{R10{BL$$${{SWITCH ON BLOCK TYPE
{{IFF{BL$AR{GPF06{{ARBLK
{{IFF{BL$BC{GPF18{{BCBLK
{{IFF{BL$CD{GPF08{{CDBLK
{{IFF{BL$EX{GPF17{{EXBLK
{{IFF{BL$IC{GPF02{{ICBLK
{{IFF{BL$NM{GPF10{{NMBLK
{{IFF{BL$P0{GPF10{{P0BLK
{{IFF{BL$P1{GPF12{{P1BLK
{{IFF{BL$P2{GPF12{{P2BLK
{{IFF{BL$RC{GPF02{{RCBLK
{{IFF{BL$SC{GPF02{{SCBLK
{{IFF{BL$SE{GPF02{{SEBLK
{{IFF{BL$TB{GPF08{{TBBLK
{{IFF{BL$VC{GPF08{{VCBLK
{{IFF{BL$XN{GPF02{{XNBLK
{{IFF{BL$XR{GPF09{{XRBLK
{{IFF{BL$PD{GPF13{{PDBLK
{{IFF{BL$TR{GPF16{{TRBLK
{{IFF{BL$BF{GPF02{{BFBLK
{{IFF{BL$CC{GPF07{{CCBLK
{{IFF{BL$CM{GPF04{{CMBLK
{{IFF{BL$CT{GPF02{{CTBLK
{{IFF{BL$DF{GPF02{{DFBLK
{{IFF{BL$EF{GPF02{{EFBLK
{{IFF{BL$EV{GPF10{{EVBLK
{{IFF{BL$FF{GPF11{{FFBLK
{{IFF{BL$KV{GPF02{{KVBLK
{{IFF{BL$PF{GPF14{{PFBLK
{{IFF{BL$TE{GPF15{{TEBLK
{{ESW{{{{END OF JUMP TABLE
{{EJC{{{{
*
* GBCPF (CONTINUED)
*
* CMBLK
*
{GPF04{MOV{4*CMLEN(R9){R6{{LOAD LENGTH
{{MOV{#4*CMTYP{R7{{SET OFFSET
*
* HERE TO PUSH DOWN TO NEW LEVEL
*
* (WC) FIELD PTR AT PREVIOUS LEVEL
* (XR) PTR TO NEW BLOCK
* (WA) LENGTH (RELOC FLDS + FLDS AT START)
* (WB) OFFSET TO FIRST RELOC FIELD
*
{GPF05{ADD{R9{R6{{POINT PAST LAST RELOC FIELD
{{ADD{R7{R9{{POINT TO FIRST RELOC FIELD
{{MOV{R8{-(SP){{STACK OLD FIELD POINTER
{{MOV{R6{-(SP){{STACK NEW LIMIT POINTER
{{CHK{{{{CHECK FOR STACK OVERFLOW
{{BRN{GPF01{{{IF OK, BACK TO PROCESS
*
* ARBLK
*
{GPF06{MOV{4*ARLEN(R9){R6{{LOAD LENGTH
{{MOV{4*AROFS(R9){R7{{SET OFFSET TO 1ST RELOC FLD (ARPRO)
{{BRN{GPF05{{{ALL SET
*
* CCBLK
*
{GPF07{MOV{4*CCUSE(R9){R6{{SET LENGTH IN USE
{{MOV{#4*CCUSE{R7{{1ST WORD (MAKE SURE AT LEAST ONE)
{{BRN{GPF05{{{ALL SET
{{EJC{{{{
*
* GBCPF (CONTINUED)
*
* CDBLK, TBBLK, VCBLK
*
{GPF08{MOV{4*OFFS2(R9){R6{{LOAD LENGTH
{{MOV{#4*OFFS3{R7{{SET OFFSET
{{BRN{GPF05{{{JUMP BACK
*
* XRBLK
*
{GPF09{MOV{4*XRLEN(R9){R6{{LOAD LENGTH
{{MOV{#4*XRPTR{R7{{SET OFFSET
{{BRN{GPF05{{{JUMP BACK
*
* EVBLK, NMBLK, P0BLK
*
{GPF10{MOV{#4*OFFS2{R6{{POINT PAST SECOND FIELD
{{MOV{#4*OFFS1{R7{{OFFSET IS ONE (ONLY RELOC FLD IS 2)
{{BRN{GPF05{{{ALL SET
*
* FFBLK
*
{GPF11{MOV{#4*FFOFS{R6{{SET LENGTH
{{MOV{#4*FFNXT{R7{{SET OFFSET
{{BRN{GPF05{{{ALL SET
*
* P1BLK, P2BLK
*
{GPF12{MOV{#4*PARM2{R6{{LENGTH (PARM2 IS NON-RELOCATABLE)
{{MOV{#4*PTHEN{R7{{SET OFFSET
{{BRN{GPF05{{{ALL SET
{{EJC{{{{
*
* GBCPF (CONTINUED)
*
* PDBLK
*
{GPF13{MOV{4*PDDFP(R9){R10{{LOAD PTR TO DFBLK
{{MOV{4*DFPDL(R10){R6{{GET PDBLK LENGTH
{{MOV{#4*PDFLD{R7{{SET OFFSET
{{BRN{GPF05{{{ALL SET
*
* PFBLK
*
{GPF14{MOV{#4*PFARG{R6{{LENGTH PAST LAST RELOC
{{MOV{#4*PFCOD{R7{{OFFSET TO FIRST RELOC
{{BRN{GPF05{{{ALL SET
*
* TEBLK
*
{GPF15{MOV{#4*TESI${R6{{SET LENGTH
{{MOV{#4*TESUB{R7{{AND OFFSET
{{BRN{GPF05{{{ALL SET
*
* TRBLK
*
{GPF16{MOV{#4*TRSI${R6{{SET LENGTH
{{MOV{#4*TRVAL{R7{{AND OFFSET
{{BRN{GPF05{{{ALL SET
*
* EXBLK
*
{GPF17{MOV{4*EXLEN(R9){R6{{LOAD LENGTH
{{MOV{#4*EXFLC{R7{{SET OFFSET
{{BRN{GPF05{{{JUMP BACK
*
* BCBLK
*
{GPF18{MOV{#4*BCSI${R6{{SET LENGTH
{{MOV{#4*BCBUF{R7{{AND OFFSET
{{BRN{GPF05{{{ALL SET
{{ENP{{{{END PROCEDURE GBCPF
{{EJC{{{{
*
* GTARR -- GET ARRAY
*
* GTARR IS PASSED AN OBJECT AND RETURNS AN ARRAY IF POSSIBL
*
* (XR) VALUE TO BE CONVERTED
* JSR GTARR CALL TO GET ARRAY
* PPM LOC TRANSFER LOC FOR CONVERT IMPOSSIBLE
* (XR) RESULTING ARRAY
* (XL,WA,WB,WC) DESTROYED
*
{GTARR{PRC{E{1{{ENTRY POINT
{{MOV{(R9){R6{{LOAD TYPE WORD
{{BEQ{R6{#B$ART{GTAR8{EXIT IF ALREADY AN ARRAY
{{BEQ{R6{#B$VCT{GTAR8{EXIT IF ALREADY AN ARRAY
{{BNE{R6{#B$TBT{GTA9A{ELSE FAIL IF NOT A TABLE (SGD02)
*
* HERE WE CONVERT A TABLE TO AN ARRAY
*
{{MOV{R9{-(SP){{REPLACE TBBLK POINTER ON STACK
{{ZER{R9{{{SIGNAL FIRST PASS
{{ZER{R7{{{ZERO NON-NULL ELEMENT COUNT
*
* THE FOLLOWING CODE IS EXECUTED TWICE. ON THE FIRST PASS,
* SIGNALLED BY XR=0, THE NUMBER OF NON-NULL ELEMENTS IN
* THE TABLE IS COUNTED IN WB. IN THE SECOND PASS, WHERE
* XR IS A POINTER INTO THE ARBLK, THE NAME AND VALUE ARE
* ENTERED INTO THE CURRENT ARBLK LOCATION.
*
{GTAR1{MOV{(SP){R10{{POINT TO TABLE
{{ADD{4*TBLEN(R10){R10{{POINT PAST LAST BUCKET
{{SUB{#4*TBBUK{R10{{SET FIRST BUCKET OFFSET
{{MOV{R10{R6{{COPY ADJUSTED POINTER
*
* LOOP THROUGH BUCKETS IN TABLE BLOCK
* NEXT THREE LINES OF CODE RELY ON TENXT HAVING A VALUE
* 1 LESS THAN TBBUK.
*
{GTAR2{MOV{R6{R10{{COPY BUCKET POINTER
{{DCA{R6{{{DECREMENT BUCKET POINTER
*
* LOOP THROUGH TEBLKS ON ONE BUCKET CHAIN
*
{GTAR3{MOV{4*TENXT(R10){R10{{POINT TO NEXT TEBLK
{{BEQ{R10{(SP){GTAR6{JUMP IF CHAIN END (TBBLK PTR)
{{MOV{R10{CNVTP{{ELSE SAVE TEBLK POINTER
*
* LOOP TO FIND VALUE DOWN TRBLK CHAIN
*
{GTAR4{MOV{4*TEVAL(R10){R10{{LOAD VALUE
{{BEQ{(R10){#B$TRT{GTAR4{LOOP TILL VALUE FOUND
{{MOV{R10{R8{{COPY VALUE
{{MOV{CNVTP{R10{{RESTORE TEBLK POINTER
{{EJC{{{{
*
* GTARR (CONTINUED)
*
* NOW CHECK FOR NULL AND TEST CASES
*
{{BEQ{R8{#NULLS{GTAR3{LOOP BACK TO IGNORE NULL VALUE
{{BNZ{R9{GTAR5{{JUMP IF SECOND PASS
{{ICV{R7{{{FOR THE FIRST PASS, BUMP COUNT
{{BRN{GTAR3{{{AND LOOP BACK FOR NEXT TEBLK
*
* HERE IN SECOND PASS
*
{GTAR5{MOV{4*TESUB(R10){(R9)+{{STORE SUBSCRIPT NAME
{{MOV{R8{(R9)+{{STORE VALUE IN ARBLK
{{BRN{GTAR3{{{LOOP BACK FOR NEXT TEBLK
*
* HERE AFTER SCANNING TEBLKS ON ONE CHAIN
*
{GTAR6{BNE{R6{(SP){GTAR2{LOOP BACK IF MORE BUCKETS TO GO
{{BNZ{R9{GTAR7{{ELSE JUMP IF SECOND PASS
*
* HERE AFTER COUNTING NON-NULL ELEMENTS
*
{{BZE{R7{GTAR9{{FAIL IF NO NON-NULL ELEMENTS
{{MOV{R7{R6{{ELSE COPY COUNT
{{ADD{R7{R6{{DOUBLE (TWO WORDS/ELEMENT)
{{ADD{#ARVL2{R6{{ADD SPACE FOR STANDARD FIELDS
{{WTB{R6{{{CONVERT LENGTH TO BYTES
{{BGE{R6{MXLEN{GTAR9{FAIL IF TOO LONG FOR ARRAY
{{JSR{ALLOC{{{ELSE ALLOCATE SPACE FOR ARBLK
{{MOV{#B$ART{(R9){{STORE TYPE WORD
{{ZER{4*IDVAL(R9){{{ZERO ID FOR THE MOMENT
{{MOV{R6{4*ARLEN(R9){{STORE LENGTH
{{MOV{#NUM02{4*ARNDM(R9){{SET DIMENSIONS = 2
{{LDI{INTV1{{{GET INTEGER ONE
{{STI{4*ARLBD(R9){{{STORE AS LBD 1
{{STI{4*ARLB2(R9){{{STORE AS LBD 2
{{LDI{INTV2{{{LOAD INTEGER TWO
{{STI{4*ARDM2(R9){{{STORE AS DIM 2
{{MTI{R7{{{GET ELEMENT COUNT AS INTEGER
{{STI{4*ARDIM(R9){{{STORE AS DIM 1
{{ZER{4*ARPR2(R9){{{ZERO PROTOTYPE FIELD FOR NOW
{{MOV{#4*ARPR2{4*AROFS(R9){{SET OFFSET FIELD (SIGNAL PASS 2)
{{MOV{R9{R7{{SAVE ARBLK POINTER
{{ADD{#4*ARVL2{R9{{POINT TO FIRST ELEMENT LOCATION
{{BRN{GTAR1{{{JUMP BACK TO FILL IN ELEMENTS
{{EJC{{{{
*
* GTARR (CONTINUED)
*
* HERE AFTER FILLING IN ELEMENT VALUES
*
{GTAR7{MOV{R7{R9{{RESTORE ARBLK POINTER
{{MOV{R7{(SP){{STORE AS RESULT
*
* NOW WE NEED THE ARRAY PROTOTYPE WHICH IS OF THE FORM NN,2
* THIS IS OBTAINED BY BUILDING THE STRING FOR NN02 AND
* CHANGING THE ZERO TO A COMMA BEFORE STORING IT.
*
{{LDI{4*ARDIM(R9){{{GET NUMBER OF ELEMENTS (NN)
{{MLI{INTVH{{{MULTIPLY BY 100
{{ADI{INTV2{{{ADD 2 (NN02)
{{JSR{ICBLD{{{BUILD INTEGER
{{MOV{R9{-(SP){{STORE PTR FOR GTSTG
{{JSR{GTSTG{{{CONVERT TO STRING
{{PPM{{{{CONVERT FAIL IS IMPOSSIBLE
{{MOV{R9{R10{{COPY STRING POINTER
{{MOV{(SP)+{R9{{RELOAD ARBLK POINTER
{{MOV{R10{4*ARPR2(R9){{STORE PROTOTYPE PTR (NN02)
{{SUB{#NUM02{R6{{ADJUST LENGTH TO POINT TO ZERO
{{PSC{R10{R6{{POINT TO ZERO
{{MOV{#CH$CM{R7{{LOAD A COMMA
{{SCH{R7{(R10){{STORE A COMMA OVER THE ZERO
{{CSC{R10{{{COMPLETE STORE CHARACTERS
*
* NORMAL RETURN
*
{GTAR8{EXI{{{{RETURN TO CALLER
*
* NON-CONVERSION RETURN
*
{GTAR9{MOV{(SP)+{R9{{RESTORE STACK FOR CONV ERR (SGD02)
*
* MERGE TO TAKE CONVERT ERROR WHEN STACK ADJUSTED OK
*
{GTA9A{EXI{1{{{RETURN
{{ENP{{{{PROCEDURE GTARR
{{EJC{{{{
*
* GTCOD -- CONVERT TO CODE
*
* (XR) OBJECT TO BE CONVERTED
* JSR GTCOD CALL TO CONVERT TO CODE
* PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
* (XR) POINTER TO RESULTING CDBLK
* (XL,WA,WB,WC,RA) DESTROYED
*
* IF A SPITBOL ERROR OCCURS DURING COMPILATION OR PRE-
* EVALUATION, CONTROL IS PASSED VIA ERROR SECTION TO EXFAL
* WITHOUT RETURNING TO THIS ROUTINE.
*
{GTCOD{PRC{E{1{{ENTRY POINT
{{BEQ{(R9){#B$CDS{GTCD1{JUMP IF ALREADY CODE
{{BEQ{(R9){#B$CDC{GTCD1{JUMP IF ALREADY CODE
*
* HERE WE MUST GENERATE A CDBLK BY COMPILATION
*
{{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG
{{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
{{PPM{GTCD2{{{JUMP IF NON-CONVERTIBLE
{{MOV{FLPTR{GTCEF{{SAVE FAIL PTR IN CASE OF ERROR
{{MOV{R$COD{R$GTC{{ALSO SAVE CODE PTR
{{MOV{R9{R$CIM{{ELSE SET IMAGE POINTER
{{MOV{R6{SCNIL{{SET IMAGE LENGTH
{{ZER{SCNPT{{{SET SCAN POINTER
{{MOV{#STGXC{STAGE{{SET STAGE FOR EXECUTE COMPILE
{{MOV{CMPSN{LSTSN{{IN CASE LISTR CALLED
{{JSR{CMPIL{{{COMPILE STRING
{{MOV{#STGXT{STAGE{{RESET STAGE FOR EXECUTE TIME
{{ZER{R$CIM{{{CLEAR IMAGE
*
* MERGE HERE IF NO CONVERT REQUIRED
*
{GTCD1{EXI{{{{GIVE NORMAL GTCOD RETURN
*
* HERE IF UNCONVERTIBLE
*
{GTCD2{EXI{1{{{GIVE ERROR RETURN
{{ENP{{{{END PROCEDURE GTCOD
{{EJC{{{{
*
* GTEXP -- CONVERT TO EXPRESSION
*
* (XR) INPUT VALUE TO BE CONVERTED
* JSR GTEXP CALL TO CONVERT TO EXPRESSION
* PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
* (XR) POINTER TO RESULT EXBLK OR SEBLK
* (XL,WA,WB,WC,RA) DESTROYED
*
* IF A SPITBOL ERROR OCCURS DURING COMPILATION OR PRE-
* EVALUATION, CONTROL IS PASSED VIA ERROR SECTION TO EXFAL
* WITHOUT RETURNING TO THIS ROUTINE.
*
{GTEXP{PRC{E{1{{ENTRY POINT
{{BLO{(R9){#B$E$${GTEX1{JUMP IF ALREADY AN EXPRESSION
{{MOV{R9{-(SP){{STORE ARGUMENT FOR GTSTG
{{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
{{PPM{GTEX2{{{JUMP IF UNCONVERTIBLE
*
* CHECK THE LAST CHARACTER OF THE STRING FOR COLON OR
* SEMICOLON. THESE CHARACTERS CAN LEGITIMATELY END AN
* EXPRESSION IN OPEN CODE, SO EXPAN WILL NOT DETECT THEM
* AS ERRORS, BUT THEY ARE INVALID AS TERMINATORS FOR A
* STRING THAT IS BEING CONVERTED TO EXPRESSION FORM.
*
{{MOV{R9{R10{{COPY INPUT STRING POINTER (REG06)
{{PLC{R10{R6{{POINT ONE PAST THE STRING END (REG06)
{{LCH{R10{-(R10){{FETCH THE LAST CHARACTER (REG06)
{{BEQ{R10{#CH$CL{GTEX2{ERROR IF IT IS A SEMICOLON (REG06)
{{BEQ{R10{#CH$SM{GTEX2{OR IF IT IS A COLON (REG06)
*
* HERE WE CONVERT A STRING BY COMPILATION
*
{{MOV{R9{R$CIM{{SET INPUT IMAGE POINTER
{{ZER{SCNPT{{{SET SCAN POINTER
{{MOV{R6{SCNIL{{SET INPUT IMAGE LENGTH
{{ZER{R7{{{SET CODE FOR NORMAL SCAN
{{MOV{FLPTR{GTCEF{{SAVE FAIL PTR IN CASE OF ERROR
{{MOV{R$COD{R$GTC{{ALSO SAVE CODE PTR
{{MOV{#STGEV{STAGE{{ADJUST STAGE FOR COMPILE
{{MOV{#T$UOK{SCNTP{{INDICATE UNARY OPERATOR ACCEPTABLE
{{JSR{EXPAN{{{BUILD TREE FOR EXPRESSION
{{ZER{SCNRS{{{RESET RESCAN FLAG
{{BNE{SCNPT{SCNIL{GTEX2{ERROR IF NOT END OF IMAGE
{{ZER{R7{{{SET OK VALUE FOR CDGEX CALL
{{MOV{R9{R10{{COPY TREE POINTER
{{JSR{CDGEX{{{BUILD EXPRESSION BLOCK
{{ZER{R$CIM{{{CLEAR POINTER
{{MOV{#STGXT{STAGE{{RESTORE STAGE FOR EXECUTE TIME
*
* MERGE HERE IF NO CONVERSION REQUIRED
*
{GTEX1{EXI{{{{RETURN TO GTEXP CALLER
*
* HERE IF UNCONVERTIBLE
*
{GTEX2{EXI{1{{{TAKE ERROR EXIT
{{ENP{{{{END PROCEDURE GTEXP
{{EJC{{{{
*
* GTINT -- GET INTEGER VALUE
*
* GTINT IS PASSED AN OBJECT AND RETURNS AN INTEGER AFTER
* PERFORMING ANY NECESSARY CONVERSIONS.
*
* (XR) VALUE TO BE CONVERTED
* JSR GTINT CALL TO CONVERT TO INTEGER
* PPM LOC TRANSFER LOC FOR CONVERT IMPOSSIBLE
* (XR) RESULTING INTEGER
* (WC,RA) DESTROYED
* (WA,WB) DESTROYED (ONLY ON CONVERSION ERR)
* (XR) UNCHANGED (ON CONVERT ERROR)
*
{GTINT{PRC{E{1{{ENTRY POINT
{{BEQ{(R9){#B$ICL{GTIN2{JUMP IF ALREADY AN INTEGER
{{MOV{R6{GTINA{{ELSE SAVE WA
{{MOV{R7{GTINB{{SAVE WB
{{JSR{GTNUM{{{CONVERT TO NUMERIC
{{PPM{GTIN3{{{JUMP IF UNCONVERTIBLE
{{BEQ{R6{#B$ICL{GTIN1{JUMP IF INTEGER
*
* HERE WE CONVERT A REAL TO INTEGER
*
{{LDR{4*RCVAL(R9){{{LOAD REAL VALUE
{{RTI{GTIN3{{{CONVERT TO INTEGER (ERR IF OVFLOW)
{{JSR{ICBLD{{{IF OK BUILD ICBLK
*
* HERE AFTER SUCCESSFUL CONVERSION TO INTEGER
*
{GTIN1{MOV{GTINA{R6{{RESTORE WA
{{MOV{GTINB{R7{{RESTORE WB
*
* COMMON EXIT POINT
*
{GTIN2{EXI{{{{RETURN TO GTINT CALLER
*
* HERE ON CONVERSION ERROR
*
{GTIN3{EXI{1{{{TAKE CONVERT ERROR EXIT
{{ENP{{{{END PROCEDURE GTINT
{{EJC{{{{
*
* GTNUM -- GET NUMERIC VALUE
*
* GTNUM IS GIVEN AN OBJECT AND RETURNS EITHER AN INTEGER
* OR A REAL, PERFORMING ANY NECESSARY CONVERSIONS.
*
* (XR) OBJECT TO BE CONVERTED
* JSR GTNUM CALL TO CONVERT TO NUMERIC
* PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
* (XR) POINTER TO RESULT (INT OR REAL)
* (WA) FIRST WORD OF RESULT BLOCK
* (WB,WC,RA) DESTROYED
* (XR) UNCHANGED (ON CONVERT ERROR)
*
{GTNUM{PRC{E{1{{ENTRY POINT
{{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK
{{BEQ{R6{#B$ICL{GTN34{JUMP IF INTEGER (NO CONVERSION)
{{BEQ{R6{#B$RCL{GTN34{JUMP IF REAL (NO CONVERSION)
*
* AT THIS POINT THE ONLY POSSIBILITY IS TO CONVERT A STRING
* TO AN INTEGER OR REAL AS APPROPRIATE.
*
{{MOV{R9{-(SP){{STACK ARGUMENT IN CASE CONVERT ERR
{{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG
{{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
{{PPM{GTN36{{{JUMP IF UNCONVERTIBLE
*
* INITIALIZE NUMERIC CONVERSION
*
{{LDI{INTV0{{{INITIALIZE INTEGER RESULT TO ZERO
{{BZE{R6{GTN32{{JUMP TO EXIT WITH ZERO IF NULL
{{LCT{R6{R6{{SET BCT COUNTER FOR FOLLOWING LOOPS
{{ZER{GTNNF{{{TENTATIVELY INDICATE RESULT +
{{STI{GTNEX{{{INITIALISE EXPONENT TO ZERO
{{ZER{GTNSC{{{ZERO SCALE IN CASE REAL
{{ZER{GTNDF{{{RESET FLAG FOR DEC POINT FOUND
{{ZER{GTNRD{{{RESET FLAG FOR DIGITS FOUND
{{LDR{REAV0{{{ZERO REAL ACCUM IN CASE REAL
{{PLC{R9{{{POINT TO ARGUMENT CHARACTERS
*
* MERGE BACK HERE AFTER IGNORING LEADING BLANK
*
{GTN01{LCH{R7{(R9)+{{LOAD FIRST CHARACTER
{{BLT{R7{#CH$D0{GTN02{JUMP IF NOT DIGIT
{{BLE{R7{#CH$D9{GTN06{JUMP IF FIRST CHAR IS A DIGIT
{{EJC{{{{
*
* GTNUM (CONTINUED)
*
* HERE IF FIRST DIGIT IS NON-DIGIT
*
{GTN02{BNE{R7{#CH$BL{GTN03{JUMP IF NON-BLANK
{GTNA2{BCT{R6{GTN01{{ELSE DECR COUNT AND LOOP BACK
{{BRN{GTN07{{{JUMP TO RETURN ZERO IF ALL BLANKS
*
* HERE FOR FIRST CHARACTER NON-BLANK, NON-DIGIT
*
{GTN03{BEQ{R7{#CH$PL{GTN04{JUMP IF PLUS SIGN
{{BEQ{R7{#CH$HT{GTNA2{HORIZONTAL TAB EQUIV TO BLANK
{{BNE{R7{#CH$MN{GTN12{JUMP IF NOT MINUS (MAY BE REAL)
{{MNZ{GTNNF{{{IF MINUS SIGN, SET NEGATIVE FLAG
*
* MERGE HERE AFTER PROCESSING SIGN
*
{GTN04{BCT{R6{GTN05{{JUMP IF CHARS LEFT
{{BRN{GTN36{{{ELSE ERROR
*
* LOOP TO FETCH CHARACTERS OF AN INTEGER
*
{GTN05{LCH{R7{(R9)+{{LOAD NEXT CHARACTER
{{BLT{R7{#CH$D0{GTN08{JUMP IF NOT A DIGIT
{{BGT{R7{#CH$D9{GTN08{JUMP IF NOT A DIGIT
*
* MERGE HERE FOR FIRST DIGIT
*
{GTN06{STI{GTNSI{{{SAVE CURRENT VALUE
{{CVM{GTN35{{{CURRENT*10-(NEW DIG) JUMP IF OVFLOW
{{MNZ{GTNRD{{{SET DIGIT READ FLAG
{{BCT{R6{GTN05{{ELSE LOOP BACK IF MORE CHARS
*
* HERE TO EXIT WITH CONVERTED INTEGER VALUE
*
{GTN07{BNZ{GTNNF{GTN32{{JUMP IF NEGATIVE (ALL SET)
{{NGI{{{{ELSE NEGATE
{{INO{GTN32{{{JUMP IF NO OVERFLOW
{{BRN{GTN36{{{ELSE SIGNAL ERROR
{{EJC{{{{
*
* GTNUM (CONTINUED)
*
* HERE FOR A NON-DIGIT CHARACTER WHILE ATTEMPTING TO
* CONVERT AN INTEGER, CHECK FOR TRAILING BLANKS OR REAL.
*
{GTN08{BEQ{R7{#CH$BL{GTNA9{JUMP IF A BLANK
{{BEQ{R7{#CH$HT{GTNA9{JUMP IF HORIZONTAL TAB
{{ITR{{{{ELSE CONVERT INTEGER TO REAL
{{NGR{{{{NEGATE TO GET POSITIVE VALUE
{{BRN{GTN12{{{JUMP TO TRY FOR REAL
*
* HERE WE SCAN OUT BLANKS TO END OF STRING
*
{GTN09{LCH{R7{(R9)+{{GET NEXT CHAR
{{BEQ{R7{#CH$HT{GTNA9{JUMP IF HORIZONTAL TAB
{{BNE{R7{#CH$BL{GTN36{ERROR IF NON-BLANK
{GTNA9{BCT{R6{GTN09{{LOOP BACK IF MORE CHARS TO CHECK
{{BRN{GTN07{{{RETURN INTEGER IF ALL BLANKS
*
* LOOP TO COLLECT MANTISSA OF REAL
*
{GTN10{LCH{R7{(R9)+{{LOAD NEXT CHARACTER
{{BLT{R7{#CH$D0{GTN12{JUMP IF NON-NUMERIC
{{BGT{R7{#CH$D9{GTN12{JUMP IF NON-NUMERIC
*
* MERGE HERE TO COLLECT FIRST REAL DIGIT
*
{GTN11{SUB{#CH$D0{R7{{CONVERT DIGIT TO NUMBER
{{MLR{REAVT{{{MULTIPLY REAL BY 10.0
{{ROV{GTN36{{{CONVERT ERROR IF OVERFLOW
{{STR{GTNSR{{{SAVE RESULT
{{MTI{R7{{{GET NEW DIGIT AS INTEGER
{{ITR{{{{CONVERT NEW DIGIT TO REAL
{{ADR{GTNSR{{{ADD TO GET NEW TOTAL
{{ADD{GTNDF{GTNSC{{INCREMENT SCALE IF AFTER DEC POINT
{{MNZ{GTNRD{{{SET DIGIT FOUND FLAG
{{BCT{R6{GTN10{{LOOP BACK IF MORE CHARS
{{BRN{GTN22{{{ELSE JUMP TO SCALE
{{EJC{{{{
*
* GTNUM (CONTINUED)
*
* HERE IF NON-DIGIT FOUND WHILE COLLECTING A REAL
*
{GTN12{BNE{R7{#CH$DT{GTN13{JUMP IF NOT DEC POINT
{{BNZ{GTNDF{GTN36{{IF DEC POINT, ERROR IF ONE ALREADY
{{MOV{#NUM01{GTNDF{{ELSE SET FLAG FOR DEC POINT
{{BCT{R6{GTN10{{LOOP BACK IF MORE CHARS
{{BRN{GTN22{{{ELSE JUMP TO SCALE
*
* HERE IF NOT DECIMAL POINT
*
{GTN13{BEQ{R7{#CH$LE{GTN15{JUMP IF E FOR EXPONENT
{{BEQ{R7{#CH$LD{GTN15{JUMP IF D FOR EXPONENT
{{BEQ{R7{#CH$$E{GTN15{JUMP IF E FOR EXPONENT
{{BEQ{R7{#CH$$D{GTN15{JUMP IF D FOR EXPONENT
*
* HERE CHECK FOR TRAILING BLANKS
*
{GTN14{BEQ{R7{#CH$BL{GTNB4{JUMP IF BLANK
{{BEQ{R7{#CH$HT{GTNB4{JUMP IF HORIZONTAL TAB
{{BRN{GTN36{{{ERROR IF NON-BLANK
*
{GTNB4{LCH{R7{(R9)+{{GET NEXT CHARACTER
{{BCT{R6{GTN14{{LOOP BACK TO CHECK IF MORE
{{BRN{GTN22{{{ELSE JUMP TO SCALE
*
* HERE TO READ AND PROCESS AN EXPONENT
*
{GTN15{ZER{GTNES{{{SET EXPONENT SIGN POSITIVE
{{LDI{INTV0{{{INITIALIZE EXPONENT TO ZERO
{{MNZ{GTNDF{{{RESET NO DEC POINT INDICATION
{{BCT{R6{GTN16{{JUMP SKIPPING PAST E OR D
{{BRN{GTN36{{{ERROR IF NULL EXPONENT
*
* CHECK FOR EXPONENT SIGN
*
{GTN16{LCH{R7{(R9)+{{LOAD FIRST EXPONENT CHARACTER
{{BEQ{R7{#CH$PL{GTN17{JUMP IF PLUS SIGN
{{BNE{R7{#CH$MN{GTN19{ELSE JUMP IF NOT MINUS SIGN
{{MNZ{GTNES{{{SET SIGN NEGATIVE IF MINUS SIGN
*
* MERGE HERE AFTER PROCESSING EXPONENT SIGN
*
{GTN17{BCT{R6{GTN18{{JUMP IF CHARS LEFT
{{BRN{GTN36{{{ELSE ERROR
*
* LOOP TO CONVERT EXPONENT DIGITS
*
{GTN18{LCH{R7{(R9)+{{LOAD NEXT CHARACTER
{{EJC{{{{
*
* GTNUM (CONTINUED)
*
* MERGE HERE FOR FIRST EXPONENT DIGIT
*
{GTN19{BLT{R7{#CH$D0{GTN20{JUMP IF NOT DIGIT
{{BGT{R7{#CH$D9{GTN20{JUMP IF NOT DIGIT
{{CVM{GTN36{{{ELSE CURRENT*10, SUBTRACT NEW DIGIT
{{BCT{R6{GTN18{{LOOP BACK IF MORE CHARS
{{BRN{GTN21{{{JUMP IF EXPONENT FIELD IS EXHAUSTED
*
* HERE TO CHECK FOR TRAILING BLANKS AFTER EXPONENT
*
{GTN20{BEQ{R7{#CH$BL{GTNC0{JUMP IF BLANK
{{BEQ{R7{#CH$HT{GTNC0{JUMP IF HORIZONTAL TAB
{{BRN{GTN36{{{ERROR IF NON-BLANK
*
{GTNC0{LCH{R7{(R9)+{{GET NEXT CHARACTER
{{BCT{R6{GTN20{{LOOP BACK TILL ALL BLANKS SCANNED
*
* MERGE HERE AFTER COLLECTING EXPONENT
*
{GTN21{STI{GTNEX{{{SAVE COLLECTED EXPONENT
{{BNZ{GTNES{GTN22{{JUMP IF IT WAS NEGATIVE
{{NGI{{{{ELSE COMPLEMENT
{{IOV{GTN36{{{ERROR IF OVERFLOW
{{STI{GTNEX{{{AND STORE POSITIVE EXPONENT
*
* MERGE HERE WITH EXPONENT (0 IF NONE GIVEN)
*
{GTN22{BZE{GTNRD{GTN36{{ERROR IF NOT DIGITS COLLECTED
{{BZE{GTNDF{GTN36{{ERROR IF NO EXPONENT OR DEC POINT
{{MTI{GTNSC{{{ELSE LOAD SCALE AS INTEGER
{{SBI{GTNEX{{{SUBTRACT EXPONENT
{{IOV{GTN36{{{ERROR IF OVERFLOW
{{ILT{GTN26{{{JUMP IF WE MUST SCALE UP
*
* HERE WE HAVE A NEGATIVE EXPONENT, SO SCALE DOWN
*
{{MFI{R6{GTN36{{LOAD SCALE FACTOR, ERR IF OVFLOW
*
* LOOP TO SCALE DOWN IN STEPS OF 10**10
*
{GTN23{BLE{R6{#NUM10{GTN24{JUMP IF 10 OR LESS TO GO
{{DVR{REATT{{{ELSE DIVIDE BY 10**10
{{SUB{#NUM10{R6{{DECREMENT SCALE
{{BRN{GTN23{{{AND LOOP BACK
{{EJC{{{{
*
* GTNUM (CONTINUED)
*
* HERE SCALE REST OF WAY FROM POWERS OF TEN TABLE
*
{GTN24{BZE{R6{GTN30{{JUMP IF SCALED
{{LCT{R7{#CFP$R{{ELSE GET INDEXING FACTOR
{{MOV{#REAV1{R9{{POINT TO POWERS OF TEN TABLE
{{WTB{R6{{{CONVERT REMAINING SCALE TO BYTE OFS
*
* LOOP TO POINT TO POWERS OF TEN TABLE ENTRY
*
{GTN25{ADD{R6{R9{{BUMP POINTER
{{BCT{R7{GTN25{{ONCE FOR EACH VALUE WORD
{{DVR{(R9){{{SCALE DOWN AS REQUIRED
{{BRN{GTN30{{{AND JUMP
*
* COME HERE TO SCALE RESULT UP (POSITIVE EXPONENT)
*
{GTN26{NGI{{{{GET ABSOLUTE VALUE OF EXPONENT
{{IOV{GTN36{{{ERROR IF OVERFLOW
{{MFI{R6{GTN36{{ACQUIRE SCALE, ERROR IF OVFLOW
*
* LOOP TO SCALE UP IN STEPS OF 10**10
*
{GTN27{BLE{R6{#NUM10{GTN28{JUMP IF 10 OR LESS TO GO
{{MLR{REATT{{{ELSE MULTIPLY BY 10**10
{{ROV{GTN36{{{ERROR IF OVERFLOW
{{SUB{#NUM10{R6{{ELSE DECREMENT SCALE
{{BRN{GTN27{{{AND LOOP BACK
*
* HERE TO SCALE UP REST OF WAY WITH TABLE
*
{GTN28{BZE{R6{GTN30{{JUMP IF SCALED
{{LCT{R7{#CFP$R{{ELSE GET INDEXING FACTOR
{{MOV{#REAV1{R9{{POINT TO POWERS OF TEN TABLE
{{WTB{R6{{{CONVERT REMAINING SCALE TO BYTE OFS
*
* LOOP TO POINT TO PROPER ENTRY IN POWERS OF TEN TABLE
*
{GTN29{ADD{R6{R9{{BUMP POINTER
{{BCT{R7{GTN29{{ONCE FOR EACH WORD IN VALUE
{{MLR{(R9){{{SCALE UP
{{ROV{GTN36{{{ERROR IF OVERFLOW
{{EJC{{{{
*
* GTNUM (CONTINUED)
*
* HERE WITH REAL VALUE SCALED AND READY EXCEPT FOR SIGN
*
{GTN30{BZE{GTNNF{GTN31{{JUMP IF POSITIVE
{{NGR{{{{ELSE NEGATE
*
* HERE WITH PROPERLY SIGNED REAL VALUE IN (RA)
*
{GTN31{JSR{RCBLD{{{BUILD REAL BLOCK
{{BRN{GTN33{{{MERGE TO EXIT
*
* HERE WITH PROPERLY SIGNED INTEGER VALUE IN (IA)
*
{GTN32{JSR{ICBLD{{{BUILD ICBLK
*
* REAL MERGES HERE
*
{GTN33{MOV{(R9){R6{{LOAD FIRST WORD OF RESULT BLOCK
{{ICA{SP{{{POP ARGUMENT OFF STACK
*
* COMMON EXIT POINT
*
{GTN34{EXI{{{{RETURN TO GTNUM CALLER
*
* COME HERE IF OVERFLOW OCCURS DURING COLLECTION OF INTEGER
*
{GTN35{LDI{GTNSI{{{RELOAD INTEGER SO FAR
{{ITR{{{{CONVERT TO REAL
{{NGR{{{{MAKE VALUE POSITIVE
{{BRN{GTN11{{{MERGE WITH REAL CIRCUIT
*
* HERE FOR UNCONVERTIBLE TO STRING OR CONVERSION ERROR
*
{GTN36{MOV{(SP)+{R9{{RELOAD ORIGINAL ARGUMENT
{{EXI{1{{{TAKE CONVERT-ERROR EXIT
{{ENP{{{{END PROCEDURE GTNUM
{{EJC{{{{
*
* GTNVR -- CONVERT TO NATURAL VARIABLE
*
* GTNVR LOCATES A VARIABLE BLOCK (VRBLK) GIVEN EITHER AN
* APPROPRIATE NAME (NMBLK) OR A NON-NULL STRING (SCBLK).
*
* (XR) ARGUMENT
* JSR GTNVR CALL TO CONVERT TO NATURAL VARIABLE
* PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
* (XR) POINTER TO VRBLK
* (WA,WB) DESTROYED (CONVERSION ERROR ONLY)
* (WC) DESTROYED
*
{GTNVR{PRC{E{1{{ENTRY POINT
{{BNE{(R9){#B$NML{GNV02{JUMP IF NOT NAME
{{MOV{4*NMBAS(R9){R9{{ELSE LOAD NAME BASE IF NAME
{{BLO{R9{STATE{GNV07{SKIP IF VRBLK (IN STATIC REGION)
*
* COMMON ERROR EXIT
*
{GNV01{EXI{1{{{TAKE CONVERT-ERROR EXIT
*
* HERE IF NOT NAME
*
{GNV02{MOV{R6{GNVSA{{SAVE WA
{{MOV{R7{GNVSB{{SAVE WB
{{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG
{{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
{{PPM{GNV01{{{JUMP IF CONVERSION ERROR
{{BZE{R6{GNV01{{NULL STRING IS AN ERROR
{{JSR{FLSTG{{{FOLD LOWER CASE TO UPPER CASE
{{MOV{R10{-(SP){{SAVE XL
{{MOV{R9{-(SP){{STACK STRING PTR FOR LATER
{{MOV{R9{R7{{COPY STRING POINTER
{{ADD{#4*SCHAR{R7{{POINT TO CHARACTERS OF STRING
{{MOV{R7{GNVST{{SAVE POINTER TO CHARACTERS
{{MOV{R6{R7{{COPY LENGTH
{{CTW{R7{0{{GET NUMBER OF WORDS IN NAME
{{MOV{R7{GNVNW{{SAVE FOR LATER
{{JSR{HASHS{{{COMPUTE HASH INDEX FOR STRING
{{RMI{HSHNB{{{COMPUTE HASH OFFSET BY TAKING MOD
{{MFI{R8{{{GET AS OFFSET
{{WTB{R8{{{CONVERT OFFSET TO BYTES
{{ADD{HSHTB{R8{{POINT TO PROPER HASH CHAIN
{{SUB{#4*VRNXT{R8{{SUBTRACT OFFSET TO MERGE INTO LOOP
{{EJC{{{{
*
* GTNVR (CONTINUED)
*
* LOOP TO SEARCH HASH CHAIN
*
{GNV03{MOV{R8{R10{{COPY HASH CHAIN POINTER
{{MOV{4*VRNXT(R10){R10{{POINT TO NEXT VRBLK ON CHAIN
{{BZE{R10{GNV08{{JUMP IF END OF CHAIN
{{MOV{R10{R8{{SAVE POINTER TO THIS VRBLK
{{BNZ{4*VRLEN(R10){GNV04{{JUMP IF NOT SYSTEM VARIABLE
{{MOV{4*VRSVP(R10){R10{{ELSE POINT TO SVBLK
{{SUB{#4*VRSOF{R10{{ADJUST OFFSET FOR MERGE
*
* MERGE HERE WITH STRING PTR (LIKE VRBLK) IN XL
*
{GNV04{BNE{R6{4*VRLEN(R10){GNV03{BACK FOR NEXT VRBLK IF LENGTHS NE
{{ADD{#4*VRCHS{R10{{ELSE POINT TO CHARS OF CHAIN ENTRY
{{LCT{R7{GNVNW{{GET WORD COUNTER TO CONTROL LOOP
{{MOV{GNVST{R9{{POINT TO CHARS OF NEW NAME
*
* LOOP TO COMPARE CHARACTERS OF THE TWO NAMES
*
{GNV05{CNE{(R9){(R10){GNV03{JUMP IF NO MATCH FOR NEXT VRBLK
{{ICA{R9{{{BUMP NEW NAME POINTER
{{ICA{R10{{{BUMP VRBLK IN CHAIN NAME POINTER
{{BCT{R7{GNV05{{ELSE LOOP TILL ALL COMPARED
{{MOV{R8{R9{{WE HAVE FOUND A MATCH, GET VRBLK
*
* EXIT POINT AFTER FINDING VRBLK OR BUILDING NEW ONE
*
{GNV06{MOV{GNVSA{R6{{RESTORE WA
{{MOV{GNVSB{R7{{RESTORE WB
{{ICA{SP{{{POP STRING POINTER
{{MOV{(SP)+{R10{{RESTORE XL
*
* COMMON EXIT POINT
*
{GNV07{EXI{{{{RETURN TO GTNVR CALLER
*
* NOT FOUND, PREPARE TO SEARCH SYSTEM VARIABLE TABLE
*
{GNV08{ZER{R9{{{CLEAR GARBAGE XR POINTER
{{MOV{R8{GNVHE{{SAVE PTR TO END OF HASH CHAIN
{{BGT{R6{#NUM09{GNV14{CANNOT BE SYSTEM VAR IF LENGTH GT 9
{{MOV{R6{R10{{ELSE COPY LENGTH
{{WTB{R10{{{CONVERT TO BYTE OFFSET
{{MOV{L^VSRCH(R10){R10{{POINT TO FIRST SVBLK OF THIS LENGTH
{{EJC{{{{
*
* GTNVR (CONTINUED)
*
* LOOP TO SEARCH ENTRIES IN STANDARD VARIABLE TABLE
*
{GNV09{MOV{R10{GNVSP{{SAVE TABLE POINTER
{{MOV{(R10)+{R8{{LOAD SVBIT BIT STRING
{{MOV{(R10)+{R7{{LOAD LENGTH FROM TABLE ENTRY
{{BNE{R6{R7{GNV14{JUMP IF END OF RIGHT LENGTH ENTIRES
{{LCT{R7{GNVNW{{GET WORD COUNTER TO CONTROL LOOP
{{MOV{GNVST{R9{{POINT TO CHARS OF NEW NAME
*
* LOOP TO CHECK FOR MATCHING NAMES
*
{GNV10{CNE{(R9){(R10){GNV11{JUMP IF NAME MISMATCH
{{ICA{R9{{{ELSE BUMP NEW NAME POINTER
{{ICA{R10{{{BUMP SVBLK POINTER
{{BCT{R7{GNV10{{ELSE LOOP UNTIL ALL CHECKED
*
* HERE WE HAVE A MATCH IN THE STANDARD VARIABLE TABLE
*
{{ZER{R8{{{SET VRLEN VALUE ZERO
{{MOV{#4*VRSI${R6{{SET STANDARD SIZE
{{BRN{GNV15{{{JUMP TO BUILD VRBLK
*
* HERE IF NO MATCH WITH TABLE ENTRY IN SVBLKS TABLE
*
{GNV11{ICA{R10{{{BUMP PAST WORD OF CHARS
{{BCT{R7{GNV11{{LOOP BACK IF MORE TO GO
{{RSH{R8{SVNBT{{REMOVE UNINTERESTING BITS
*
* LOOP TO BUMP TABLE PTR FOR EACH FLAGGED WORD
*
{GNV12{MOV{BITS1{R7{{LOAD BIT TO TEST
{{ANB{R8{R7{{TEST FOR WORD PRESENT
{{ZRB{R7{GNV13{{JUMP IF NOT PRESENT
{{ICA{R10{{{ELSE BUMP TABLE POINTER
*
* HERE AFTER DEALING WITH ONE WORD (ONE BIT)
*
{GNV13{RSH{R8{1{{REMOVE BIT ALREADY PROCESSED
{{NZB{R8{GNV12{{LOOP BACK IF MORE BITS TO TEST
{{BRN{GNV09{{{ELSE LOOP BACK FOR NEXT SVBLK
*
* HERE IF NOT SYSTEM VARIABLE
*
{GNV14{MOV{R6{R8{{COPY VRLEN VALUE
{{MOV{#VRCHS{R6{{LOAD STANDARD SIZE -CHARS
{{ADD{GNVNW{R6{{ADJUST FOR CHARS OF NAME
{{WTB{R6{{{CONVERT LENGTH TO BYTES
{{EJC{{{{
*
* GTNVR (CONTINUED)
*
* MERGE HERE TO BUILD VRBLK
*
{GNV15{JSR{ALOST{{{ALLOCATE SPACE FOR VRBLK (STATIC)
{{MOV{R9{R7{{SAVE VRBLK POINTER
{{MOV{#STNVR{R10{{POINT TO MODEL VARIABLE BLOCK
{{MOV{#4*VRLEN{R6{{SET LENGTH OF STANDARD FIELDS
{{MVW{{{{SET INITIAL FIELDS OF NEW BLOCK
{{MOV{GNVHE{R10{{LOAD POINTER TO END OF HASH CHAIN
{{MOV{R7{4*VRNXT(R10){{ADD NEW BLOCK TO END OF CHAIN
{{MOV{R8{(R9)+{{SET VRLEN FIELD, BUMP PTR
{{MOV{GNVNW{R6{{GET LENGTH IN WORDS
{{WTB{R6{{{CONVERT TO LENGTH IN BYTES
{{BZE{R8{GNV16{{JUMP IF SYSTEM VARIABLE
*
* HERE FOR NON-SYSTEM VARIABLE -- SET CHARS OF NAME
*
{{MOV{(SP){R10{{POINT BACK TO STRING NAME
{{ADD{#4*SCHAR{R10{{POINT TO CHARS OF NAME
{{MVW{{{{MOVE CHARACTERS INTO PLACE
{{MOV{R7{R9{{RESTORE VRBLK POINTER
{{BRN{GNV06{{{JUMP BACK TO EXIT
*
* HERE FOR SYSTEM VARIABLE CASE TO FILL IN FIELDS WHERE
* NECESSARY FROM THE FIELDS PRESENT IN THE SVBLK.
*
{GNV16{MOV{GNVSP{R10{{LOAD POINTER TO SVBLK
{{MOV{R10{(R9){{SET SVBLK PTR IN VRBLK
{{MOV{R7{R9{{RESTORE VRBLK POINTER
{{MOV{4*SVBIT(R10){R7{{LOAD BIT INDICATORS
{{ADD{#4*SVCHS{R10{{POINT TO CHARACTERS OF NAME
{{ADD{R6{R10{{POINT PAST CHARACTERS
*
* SKIP PAST KEYWORD NUMBER (SVKNM) IF PRESENT
*
{{MOV{BTKNM{R8{{LOAD TEST BIT
{{ANB{R7{R8{{AND TO TEST
{{ZRB{R8{GNV17{{JUMP IF NO KEYWORD NUMBER
{{ICA{R10{{{ELSE BUMP POINTER
{{EJC{{{{
*
* GTNVR (CONTINUED)
*
* HERE TEST FOR FUNCTION (SVFNC AND SVNAR)
*
{GNV17{MOV{BTFNC{R8{{GET TEST BIT
{{ANB{R7{R8{{AND TO TEST
{{ZRB{R8{GNV18{{SKIP IF NO SYSTEM FUNCTION
{{MOV{R10{4*VRFNC(R9){{ELSE POINT VRFNC TO SVFNC FIELD
{{ADD{#4*NUM02{R10{{AND BUMP PAST SVFNC, SVNAR FIELDS
*
* NOW TEST FOR LABEL (SVLBL)
*
{GNV18{MOV{BTLBL{R8{{GET TEST BIT
{{ANB{R7{R8{{AND TO TEST
{{ZRB{R8{GNV19{{JUMP IF BIT IS OFF (NO SYSTEM LABL)
{{MOV{R10{4*VRLBL(R9){{ELSE POINT VRLBL TO SVLBL FIELD
{{ICA{R10{{{BUMP PAST SVLBL FIELD
*
* NOW TEST FOR VALUE (SVVAL)
*
{GNV19{MOV{BTVAL{R8{{LOAD TEST BIT
{{ANB{R7{R8{{AND TO TEST
{{ZRB{R8{GNV06{{ALL DONE IF NO VALUE
{{MOV{(R10){4*VRVAL(R9){{ELSE SET INITIAL VALUE
{{MOV{#B$VRE{4*VRSTO(R9){{SET ERROR STORE ACCESS
{{BRN{GNV06{{{MERGE BACK TO EXIT TO CALLER
{{ENP{{{{END PROCEDURE GTNVR
{{EJC{{{{
*
* GTPAT -- GET PATTERN
*
* GTPAT IS PASSED AN OBJECT IN (XR) AND RETURNS A
* PATTERN AFTER PERFORMING ANY NECESSARY CONVERSIONS
*
* (XR) INPUT ARGUMENT
* JSR GTPAT CALL TO CONVERT TO PATTERN
* PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
* (XR) RESULTING PATTERN
* (WA) DESTROYED
* (WB) DESTROYED (ONLY ON CONVERT ERROR)
* (XR) UNCHANGED (ONLY ON CONVERT ERROR)
*
{GTPAT{PRC{E{1{{ENTRY POINT
{{BHI{(R9){#P$AAA{GTPT5{JUMP IF PATTERN ALREADY
*
* HERE IF NOT PATTERN, TRY FOR STRING
*
{{MOV{R7{GTPSB{{SAVE WB
{{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG
{{JSR{GTSTG{{{CONVERT ARGUMENT TO STRING
{{PPM{GTPT2{{{JUMP IF IMPOSSIBLE
*
* HERE WE HAVE A STRING
*
{{BNZ{R6{GTPT1{{JUMP IF NON-NULL
*
* HERE FOR NULL STRING. GENERATE POINTER TO NULL PATTERN.
*
{{MOV{#NDNTH{R9{{POINT TO NOTHEN NODE
{{BRN{GTPT4{{{JUMP TO EXIT
{{EJC{{{{
*
* GTPAT (CONTINUED)
*
* HERE FOR NON-NULL STRING
*
{GTPT1{MOV{#P$STR{R7{{LOAD PCODE FOR MULTI-CHAR STRING
{{BNE{R6{#NUM01{GTPT3{JUMP IF MULTI-CHAR STRING
*
* HERE FOR ONE CHARACTER STRING, SHARE ONE CHARACTER ANY
*
{{PLC{R9{{{POINT TO CHARACTER
{{LCH{R6{(R9){{LOAD CHARACTER
{{MOV{R6{R9{{SET AS PARM1
{{MOV{#P$ANS{R7{{POINT TO PCODE FOR 1-CHAR ANY
{{BRN{GTPT3{{{JUMP TO BUILD NODE
*
* HERE IF ARGUMENT IS NOT CONVERTIBLE TO STRING
*
{GTPT2{MOV{#P$EXA{R7{{SET PCODE FOR EXPRESSION IN CASE
{{BLO{(R9){#B$E$${GTPT3{JUMP TO BUILD NODE IF EXPRESSION
*
* HERE WE HAVE AN ERROR (CONVERSION IMPOSSIBLE)
*
{{EXI{1{{{TAKE CONVERT ERROR EXIT
*
* MERGE HERE TO BUILD NODE FOR STRING OR EXPRESSION
*
{GTPT3{JSR{PBILD{{{CALL ROUTINE TO BUILD PATTERN NODE
*
* COMMON EXIT AFTER SUCCESSFUL CONVERSION
*
{GTPT4{MOV{GTPSB{R7{{RESTORE WB
*
* MERGE HERE TO EXIT OF NO CONVERSION REQUIRED
*
{GTPT5{EXI{{{{RETURN TO GTPAT CALLER
{{ENP{{{{END PROCEDURE GTPAT
{{EJC{{{{
*
* GTREA -- GET REAL VALUE
*
* GTREA IS PASSED AN OBJECT AND RETURNS A REAL VALUE
* PERFORMING ANY NECESSARY CONVERSIONS.
*
* (XR) OBJECT TO BE CONVERTED
* JSR GTREA CALL TO CONVERT OBJECT TO REAL
* PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
* (XR) POINTER TO RESULTING REAL
* (WA,WB,WC,RA) DESTROYED
* (XR) UNCHANGED (CONVERT ERROR ONLY)
*
{GTREA{PRC{E{1{{ENTRY POINT
{{MOV{(R9){R6{{GET FIRST WORD OF BLOCK
{{BEQ{R6{#B$RCL{GTRE2{JUMP IF REAL
{{JSR{GTNUM{{{ELSE CONVERT ARGUMENT TO NUMERIC
{{PPM{GTRE3{{{JUMP IF UNCONVERTIBLE
{{BEQ{R6{#B$RCL{GTRE2{JUMP IF REAL WAS RETURNED
*
* HERE FOR CASE OF AN INTEGER TO CONVERT TO REAL
*
{GTRE1{LDI{4*ICVAL(R9){{{LOAD INTEGER
{{ITR{{{{CONVERT TO REAL
{{JSR{RCBLD{{{BUILD RCBLK
*
* EXIT WITH REAL
*
{GTRE2{EXI{{{{RETURN TO GTREA CALLER
*
* HERE ON CONVERSION ERROR
*
{GTRE3{EXI{1{{{TAKE CONVERT ERROR EXIT
{{ENP{{{{END PROCEDURE GTREA
{{EJC{{{{
*
* GTSMI -- GET SMALL INTEGER
*
* GTSMI IS PASSED A SNOBOL OBJECT AND RETURNS AN ADDRESS
* INTEGER IN THE RANGE (0 LE N LE DNAMB). SUCH A VALUE CAN
* ONLY BE DERIVED FROM AN INTEGER IN THE APPROPRIATE RANGE.
* SMALL INTEGERS NEVER APPEAR AS SNOBOL VALUES. HOWEVER,
* THEY ARE USED INTERNALLY FOR A VARIETY OF PURPOSES.
*
* -(XS) ARGUMENT TO CONVERT (ON STACK)
* JSR GTSMI CALL TO CONVERT TO SMALL INTEGER
* PPM LOC TRANSFER LOC FOR NOT INTEGER
* PPM LOC TRANSFER LOC FOR LT 0, GT DNAMB
* (XR,WC) RESULTING SMALL INT (TWO COPIES)
* (XS) POPPED
* (RA) DESTROYED
* (WA,WB) DESTROYED (ON CONVERT ERROR ONLY)
* (XR) INPUT ARG (CONVERT ERROR ONLY)
*
{GTSMI{PRC{N{2{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{BEQ{(R9){#B$ICL{GTSM1{SKIP IF ALREADY AN INTEGER
*
* HERE IF NOT AN INTEGER
*
{{JSR{GTINT{{{CONVERT ARGUMENT TO INTEGER
{{PPM{GTSM2{{{JUMP IF CONVERT IS IMPOSSIBLE
*
* MERGE HERE WITH INTEGER
*
{GTSM1{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE
{{MFI{R8{GTSM3{{MOVE AS ONE WORD, JUMP IF OVFLOW
{{BGT{R8{MXLEN{GTSM3{OR IF TOO SMALL
{{MOV{R8{R9{{COPY RESULT TO XR
{{EXI{{{{RETURN TO GTSMI CALLER
*
* HERE IF UNCONVERTIBLE TO INTEGER
*
{GTSM2{EXI{1{{{TAKE NON-INTEGER ERROR EXIT
*
* HERE IF OUT OF RANGE
*
{GTSM3{EXI{2{{{TAKE OUT-OF-RANGE ERROR EXIT
{{ENP{{{{END PROCEDURE GTSMI
{{EJC{{{{
*
* GTSTG -- GET STRING
*
* GTSTG IS PASSED AN OBJECT AND RETURNS A STRING WITH
* ANY NECESSARY CONVERSIONS PERFORMED.
*
* -(XS) INPUT ARGUMENT (ON STACK)
* JSR GTSTG CALL TO CONVERT TO STRING
* PPM LOC TRANSFER LOC IF CONVERT IMPOSSIBLE
* (XR) POINTER TO RESULTING STRING
* (WA) LENGTH OF STRING IN CHARACTERS
* (XS) POPPED
* (RA) DESTROYED
* (XR) INPUT ARG (CONVERT ERROR ONLY)
*
{GTSTG{PRC{N{1{{ENTRY POINT
{{MOV{(SP)+{R9{{LOAD ARGUMENT, POP STACK
{{BEQ{(R9){#B$SCL{GTS30{JUMP IF ALREADY A STRING
*
* HERE IF NOT A STRING ALREADY
*
{GTS01{MOV{R9{-(SP){{RESTACK ARGUMENT IN CASE ERROR
{{MOV{R10{-(SP){{SAVE XL
{{MOV{R7{GTSVB{{SAVE WB
{{MOV{R8{GTSVC{{SAVE WC
{{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK
{{BEQ{R6{#B$ICL{GTS05{JUMP TO CONVERT INTEGER
{{BEQ{R6{#B$RCL{GTS10{JUMP TO CONVERT REAL
{{BEQ{R6{#B$NML{GTS03{JUMP TO CONVERT NAME
{{BEQ{R6{#B$BCT{GTS32{JUMP TO CONVERT BUFFER
*
* HERE ON CONVERSION ERROR
*
{GTS02{MOV{(SP)+{R10{{RESTORE XL
{{MOV{(SP)+{R9{{RELOAD INPUT ARGUMENT
{{EXI{1{{{TAKE CONVERT ERROR EXIT
{{EJC{{{{
*
* GTSTG (CONTINUED)
*
* HERE TO CONVERT A NAME (ONLY POSSIBLE IF NATURAL VAR)
*
{GTS03{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE
{{BHI{R10{STATE{GTS02{ERROR IF NOT NATURAL VAR (STATIC)
{{ADD{#4*VRSOF{R10{{ELSE POINT TO POSSIBLE STRING NAME
{{MOV{4*SCLEN(R10){R6{{LOAD LENGTH
{{BNZ{R6{GTS04{{JUMP IF NOT SYSTEM VARIABLE
{{MOV{4*VRSVO(R10){R10{{ELSE POINT TO SVBLK
{{MOV{4*SVLEN(R10){R6{{AND LOAD NAME LENGTH
*
* MERGE HERE WITH STRING IN XR, LENGTH IN WA
*
{GTS04{ZER{R7{{{SET OFFSET TO ZERO
{{JSR{SBSTR{{{USE SBSTR TO COPY STRING
{{BRN{GTS29{{{JUMP TO EXIT
*
* COME HERE TO CONVERT AN INTEGER
*
{GTS05{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE
{{MOV{#NUM01{GTSSF{{SET SIGN FLAG NEGATIVE
{{ILT{GTS06{{{SKIP IF INTEGER IS NEGATIVE
{{NGI{{{{ELSE NEGATE INTEGER
{{ZER{GTSSF{{{AND RESET NEGATIVE FLAG
{{EJC{{{{
*
* GTSTG (CONTINUED)
*
* HERE WITH SIGN FLAG SET AND SIGN FORCED NEGATIVE AS
* REQUIRED BY THE CVD INSTRUCTION.
*
{GTS06{MOV{GTSWK{R9{{POINT TO RESULT WORK AREA
{{MOV{#NSTMX{R7{{INITIALIZE COUNTER TO MAX LENGTH
{{PSC{R9{R7{{PREPARE TO STORE (RIGHT-LEFT)
*
* LOOP TO CONVERT DIGITS INTO WORK AREA
*
{GTS07{CVD{{{{CONVERT ONE DIGIT INTO WA
{{SCH{R6{-(R9){{STORE IN WORK AREA
{{DCV{R7{{{DECREMENT COUNTER
{{INE{GTS07{{{LOOP IF MORE DIGITS TO GO
{{CSC{R9{{{COMPLETE STORE CHARACTERS
*
* MERGE HERE AFTER CONVERTING INTEGER OR REAL INTO WORK
* AREA. WB IS SET TO NSTMX - (NUMBER OF CHARS IN RESULT).
*
{GTS08{MOV{#NSTMX{R6{{GET MAX NUMBER OF CHARACTERS
{{SUB{R7{R6{{COMPUTE LENGTH OF RESULT
{{MOV{R6{R10{{REMEMBER LENGTH FOR MOVE LATER ON
{{ADD{GTSSF{R6{{ADD ONE FOR NEGATIVE SIGN IF NEEDED
{{JSR{ALOCS{{{ALLOCATE STRING FOR RESULT
{{MOV{R9{R8{{SAVE RESULT POINTER FOR THE MOMENT
{{PSC{R9{{{POINT TO CHARS OF RESULT BLOCK
{{BZE{GTSSF{GTS09{{SKIP IF POSITIVE
{{MOV{#CH$MN{R6{{ELSE LOAD NEGATIVE SIGN
{{SCH{R6{(R9)+{{AND STORE IT
{{CSC{R9{{{COMPLETE STORE CHARACTERS
*
* HERE AFTER DEALING WITH SIGN
*
{GTS09{MOV{R10{R6{{RECALL LENGTH TO MOVE
{{MOV{GTSWK{R10{{POINT TO RESULT WORK AREA
{{PLC{R10{R7{{POINT TO FIRST RESULT CHARACTER
{{MVC{{{{MOVE CHARS TO RESULT STRING
{{MOV{R8{R9{{RESTORE RESULT POINTER
{{BRN{GTS29{{{JUMP TO EXIT
{{EJC{{{{
*
* GTSTG (CONTINUED)
*
* HERE TO CONVERT A REAL
*
{GTS10{LDR{4*RCVAL(R9){{{LOAD REAL
{{ZER{GTSSF{{{RESET NEGATIVE FLAG
{{REQ{GTS31{{{SKIP IF ZERO
{{RGE{GTS11{{{JUMP IF REAL IS POSITIVE
{{MOV{#NUM01{GTSSF{{ELSE SET NEGATIVE FLAG
{{NGR{{{{AND GET ABSOLUTE VALUE OF REAL
*
* NOW SCALE THE REAL TO THE RANGE (0.1 LE X LT 1.0)
*
{GTS11{LDI{INTV0{{{INITIALIZE EXPONENT TO ZERO
*
* LOOP TO SCALE UP IN STEPS OF 10**10
*
{GTS12{STR{GTSRS{{{SAVE REAL VALUE
{{SBR{REAP1{{{SUBTRACT 0.1 TO COMPARE
{{RGE{GTS13{{{JUMP IF SCALE UP NOT REQUIRED
{{LDR{GTSRS{{{ELSE RELOAD VALUE
{{MLR{REATT{{{MULTIPLY BY 10**10
{{SBI{INTVT{{{DECREMENT EXPONENT BY 10
{{BRN{GTS12{{{LOOP BACK TO TEST AGAIN
*
* TEST FOR SCALE DOWN REQUIRED
*
{GTS13{LDR{GTSRS{{{RELOAD VALUE
{{SBR{REAV1{{{SUBTRACT 1.0
{{RLT{GTS17{{{JUMP IF NO SCALE DOWN REQUIRED
{{LDR{GTSRS{{{ELSE RELOAD VALUE
*
* LOOP TO SCALE DOWN IN STEPS OF 10**10
*
{GTS14{SBR{REATT{{{SUBTRACT 10**10 TO COMPARE
{{RLT{GTS15{{{JUMP IF LARGE STEP NOT REQUIRED
{{LDR{GTSRS{{{ELSE RESTORE VALUE
{{DVR{REATT{{{DIVIDE BY 10**10
{{STR{GTSRS{{{STORE NEW VALUE
{{ADI{INTVT{{{INCREMENT EXPONENT BY 10
{{BRN{GTS14{{{LOOP BACK
{{EJC{{{{
*
* GTSTG (CONTINUED)
*
* AT THIS POINT WE HAVE (1.0 LE X LT 10**10)
* COMPLETE SCALING WITH POWERS OF TEN TABLE
*
{GTS15{MOV{#REAV1{R9{{POINT TO POWERS OF TEN TABLE
*
* LOOP TO LOCATE CORRECT ENTRY IN TABLE
*
{GTS16{LDR{GTSRS{{{RELOAD VALUE
{{ADI{INTV1{{{INCREMENT EXPONENT
{{ADD{#4*CFP$R{R9{{POINT TO NEXT ENTRY IN TABLE
{{SBR{(R9){{{SUBTRACT IT TO COMPARE
{{RGE{GTS16{{{LOOP TILL WE FIND A LARGER ENTRY
{{LDR{GTSRS{{{THEN RELOAD THE VALUE
{{DVR{(R9){{{AND COMPLETE SCALING
{{STR{GTSRS{{{STORE VALUE
*
* WE ARE NOW SCALED, SO ROUND BY ADDING 0.5 * 10**(-CFP$S)
*
{GTS17{LDR{GTSRS{{{GET VALUE AGAIN
{{ADR{GTSRN{{{ADD ROUNDING FACTOR
{{STR{GTSRS{{{STORE RESULT
*
* THE ROUNDING OPERATION MAY HAVE PUSHED US UP PAST
* 1.0 AGAIN, SO CHECK ONE MORE TIME.
*
{{SBR{REAV1{{{SUBTRACT 1.0 TO COMPARE
{{RLT{GTS18{{{SKIP IF OK
{{ADI{INTV1{{{ELSE INCREMENT EXPONENT
{{LDR{GTSRS{{{RELOAD VALUE
{{DVR{REAVT{{{DIVIDE BY 10.0 TO RESCALE
{{BRN{GTS19{{{JUMP TO MERGE
*
* HERE IF ROUNDING DID NOT MUCK UP SCALING
*
{GTS18{LDR{GTSRS{{{RELOAD ROUNDED VALUE
{{EJC{{{{
*
* GTSTG (CONTINUED)
*
* NOW WE HAVE COMPLETED THE SCALING AS FOLLOWS
*
* (IA) SIGNED EXPONENT
* (RA) SCALED REAL (ABSOLUTE VALUE)
*
* IF THE EXPONENT IS NEGATIVE OR GREATER THAN CFP$S, THEN
* WE CONVERT THE NUMBER IN THE FORM.
*
* (NEG SIGN) 0 . (CPF$S DIGITS) E (EXP SIGN) (EXP DIGITS)
*
* IF THE EXPONENT IS POSITIVE AND LESS THAN OR EQUAL TO
* CFP$S, THE NUMBER IS CONVERTED IN THE FORM.
*
* (NEG SIGN) (EXPONENT DIGITS) . (CFP$S-EXPONENT DIGITS)
*
* IN BOTH CASES, THE FORMATS OBTAINED FROM THE ABOVE
* RULES ARE MODIFIED BY DELETING TRAILING ZEROS AFTER THE
* DECIMAL POINT. THERE ARE NO LEADING ZEROS IN THE EXPONENT
* AND THE EXPONENT SIGN IS ALWAYS PRESENT.
*
{GTS19{MOV{#CFP$S{R10{{SET NUM DEC DIGITS = CFP$S
{{MOV{#CH$MN{GTSES{{SET EXPONENT SIGN NEGATIVE
{{ILT{GTS21{{{ALL SET IF EXPONENT IS NEGATIVE
{{MFI{R6{{{ELSE FETCH EXPONENT
{{BLE{R6{#CFP$S{GTS20{SKIP IF WE CAN USE SPECIAL FORMAT
{{MTI{R6{{{ELSE RESTORE EXPONENT
{{NGI{{{{SET NEGATIVE FOR CVD
{{MOV{#CH$PL{GTSES{{SET PLUS SIGN FOR EXPONENT SIGN
{{BRN{GTS21{{{JUMP TO GENERATE EXPONENT
*
* HERE IF WE CAN USE THE FORMAT WITHOUT AN EXPONENT
*
{GTS20{SUB{R6{R10{{COMPUTE DIGITS AFTER DECIMAL POINT
{{LDI{INTV0{{{RESET EXPONENT TO ZERO
{{EJC{{{{
*
* GTSTG (CONTINUED)
*
* MERGE HERE AS FOLLOWS
*
* (IA) EXPONENT ABSOLUTE VALUE
* GTSES CHARACTER FOR EXPONENT SIGN
* (RA) POSITIVE FRACTION
* (XL) NUMBER OF DIGITS AFTER DEC POINT
*
{GTS21{MOV{GTSWK{R9{{POINT TO WORK AREA
{{MOV{#NSTMX{R7{{SET CHARACTER CTR TO MAX LENGTH
{{PSC{R9{R7{{PREPARE TO STORE (RIGHT TO LEFT)
{{IEQ{GTS23{{{SKIP EXPONENT IF IT IS ZERO
*
* LOOP TO GENERATE DIGITS OF EXPONENT
*
{GTS22{CVD{{{{CONVERT A DIGIT INTO WA
{{SCH{R6{-(R9){{STORE IN WORK AREA
{{DCV{R7{{{DECREMENT COUNTER
{{INE{GTS22{{{LOOP BACK IF MORE DIGITS TO GO
*
* HERE GENERATE EXPONENT SIGN AND E
*
{{MOV{GTSES{R6{{LOAD EXPONENT SIGN
{{SCH{R6{-(R9){{STORE IN WORK AREA
{{MOV{#CH$LE{R6{{GET CHARACTER LETTER E
{{SCH{R6{-(R9){{STORE IN WORK AREA
{{SUB{#NUM02{R7{{DECREMENT COUNTER FOR SIGN AND E
*
* HERE TO GENERATE THE FRACTION
*
{GTS23{MLR{GTSSC{{{CONVERT REAL TO INTEGER (10**CFP$S)
{{RTI{{{{GET INTEGER (OVERFLOW IMPOSSIBLE)
{{NGI{{{{NEGATE AS REQUIRED BY CVD
*
* LOOP TO SUPPRESS TRAILING ZEROS
*
{GTS24{BZE{R10{GTS27{{JUMP IF NO DIGITS LEFT TO DO
{{CVD{{{{ELSE CONVERT ONE DIGIT
{{BNE{R6{#CH$D0{GTS26{JUMP IF NOT A ZERO
{{DCV{R10{{{DECREMENT COUNTER
{{BRN{GTS24{{{LOOP BACK FOR NEXT DIGIT
{{EJC{{{{
*
* GTSTG (CONTINUED)
*
* LOOP TO GENERATE DIGITS AFTER DECIMAL POINT
*
{GTS25{CVD{{{{CONVERT A DIGIT INTO WA
*
* MERGE HERE FIRST TIME
*
{GTS26{SCH{R6{-(R9){{STORE DIGIT
{{DCV{R7{{{DECREMENT COUNTER
{{DCV{R10{{{DECREMENT COUNTER
{{BNZ{R10{GTS25{{LOOP BACK IF MORE TO GO
*
* HERE GENERATE THE DECIMAL POINT
*
{GTS27{MOV{#CH$DT{R6{{LOAD DECIMAL POINT
{{SCH{R6{-(R9){{STORE IN WORK AREA
{{DCV{R7{{{DECREMENT COUNTER
*
* HERE GENERATE THE DIGITS BEFORE THE DECIMAL POINT
*
{GTS28{CVD{{{{CONVERT A DIGIT INTO WA
{{SCH{R6{-(R9){{STORE IN WORK AREA
{{DCV{R7{{{DECREMENT COUNTER
{{INE{GTS28{{{LOOP BACK IF MORE TO GO
{{CSC{R9{{{COMPLETE STORE CHARACTERS
{{BRN{GTS08{{{ELSE JUMP BACK TO EXIT
*
* EXIT POINT AFTER SUCCESSFUL CONVERSION
*
{GTS29{MOV{(SP)+{R10{{RESTORE XL
{{ICA{SP{{{POP ARGUMENT
{{MOV{GTSVB{R7{{RESTORE WB
{{MOV{GTSVC{R8{{RESTORE WC
*
* MERGE HERE IF NO CONVERSION REQUIRED
*
{GTS30{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH
{{EXI{{{{RETURN TO CALLER
*
* HERE TO RETURN STRING FOR REAL ZERO
*
{GTS31{MOV{#SCRE0{R10{{POINT TO STRING
{{MOV{#NUM02{R6{{2 CHARS
{{ZER{R7{{{ZERO OFFSET
{{JSR{SBSTR{{{COPY STRING
{{BRN{GTS29{{{RETURN
{{EJC{{{{
*
* HERE TO CONVERT A BUFFER BLOCK
*
{GTS32{MOV{R9{R10{{COPY ARG PTR
{{MOV{4*BCLEN(R10){R6{{GET SIZE TO ALLOCATE
{{BZE{R6{GTS33{{IF NULL THEN RETURN NULL
{{JSR{ALOCS{{{ALLOCATE STRING FRAME
{{MOV{R9{R7{{SAVE STRING PTR
{{MOV{4*SCLEN(R9){R6{{GET LENGTH TO MOVE
{{CTB{R6{0{{GET AS MULTIPLE OF WORD SIZE
{{MOV{4*BCBUF(R10){R10{{POINT TO BFBLK
{{ADD{#4*SCSI${R9{{POINT TO START OF CHARACTER AREA
{{ADD{#4*BFSI${R10{{POINT TO START OF BUFFER CHARS
{{MVW{{{{COPY WORDS
{{MOV{R7{R9{{RESTORE SCBLK PTR
{{BRN{GTS29{{{EXIT WITH SCBLK
*
* HERE WHEN NULL BUFFER IS BEING CONVERTED
*
{GTS33{MOV{#NULLS{R9{{POINT TO NULL
{{BRN{GTS29{{{EXIT WITH NULL
{{ENP{{{{END PROCEDURE GTSTG
{{EJC{{{{
*
* GTVAR -- GET VARIABLE FOR I/O/TRACE ASSOCIATION
*
* GTVAR IS USED TO POINT TO AN ACTUAL VARIABLE LOCATION
* FOR THE DETACH,INPUT,OUTPUT,TRACE,STOPTR SYSTEM FUNCTIONS
*
* (XR) ARGUMENT TO FUNCTION
* JSR GTVAR CALL TO LOCATE VARIABLE POINTER
* PPM LOC TRANSFER LOC IF NOT OK VARIABLE
* (XL,WA) NAME BASE,OFFSET OF VARIABLE
* (XR,RA) DESTROYED
* (WB,WC) DESTROYED (CONVERT ERROR ONLY)
* (XR) INPUT ARG (CONVERT ERROR ONLY)
*
{GTVAR{PRC{E{1{{ENTRY POINT
{{BNE{(R9){#B$NML{GTVR2{JUMP IF NOT A NAME
{{MOV{4*NMOFS(R9){R6{{ELSE LOAD NAME OFFSET
{{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE
{{BEQ{(R10){#B$EVT{GTVR1{ERROR IF EXPRESSION VARIABLE
{{BNE{(R10){#B$KVT{GTVR3{ALL OK IF NOT KEYWORD VARIABLE
*
* HERE ON CONVERSION ERROR
*
{GTVR1{EXI{1{{{TAKE CONVERT ERROR EXIT
*
* HERE IF NOT A NAME, TRY CONVERT TO NATURAL VARIABLE
*
{GTVR2{MOV{R8{GTVRC{{SAVE WC
{{JSR{GTNVR{{{LOCATE VRBLK IF POSSIBLE
{{PPM{GTVR1{{{JUMP IF CONVERT ERROR
{{MOV{R9{R10{{ELSE COPY VRBLK NAME BASE
{{MOV{#4*VRVAL{R6{{AND SET OFFSET
{{MOV{GTVRC{R8{{RESTORE WC
*
* HERE FOR NAME OBTAINED
*
{GTVR3{BHI{R10{STATE{GTVR4{ALL OK IF NOT NATURAL VARIABLE
{{BEQ{4*VRSTO(R10){#B$VRE{GTVR1{ERROR IF PROTECTED VARIABLE
*
* COMMON EXIT POINT
*
{GTVR4{EXI{{{{RETURN TO CALLER
{{ENP{{{{END PROCEDURE GTVAR
{{EJC{{{{
*
* HASHS -- COMPUTE HASH INDEX FOR STRING
*
* HASHS IS USED TO CONVERT A STRING TO A UNIQUE INTEGER
* VALUE. THE RESULTING HASH VALUE IS A POSITIVE INTEGER
* IN THE RANGE 0 TO CFP$M
*
* (XR) STRING TO BE HASHED
* JSR HASHS CALL TO HASH STRING
* (IA) HASH VALUE
* (XR,WB,WC) DESTROYED
*
* THE HASH FUNCTION USED IS AS FOLLOWS.
*
* START WITH THE LENGTH OF THE STRING (SGD07)
*
* TAKE THE FIRST E$HNW WORDS OF THE CHARACTERS FROM
* THE STRING OR ALL THE WORDS IF FEWER THAN E$HNW.
*
* COMPUTE THE EXCLUSIVE OR OF ALL THESE WORDS TREATING
* THEM AS ONE WORD BIT STRING VALUES.
*
* MOVE THE RESULT AS AN INTEGER WITH THE MTI INSTRUCTION.
*
{HASHS{PRC{E{0{{ENTRY POINT
{{MOV{4*SCLEN(R9){R8{{LOAD STRING LENGTH IN CHARACTERS
{{MOV{R8{R7{{INITIALIZE WITH LENGTH
{{BZE{R8{HSHS3{{JUMP IF NULL STRING
{{CTW{R8{0{{ELSE GET NUMBER OF WORDS OF CHARS
{{ADD{#4*SCHAR{R9{{POINT TO CHARACTERS OF STRING
{{BLO{R8{#E$HNW{HSHS1{USE WHOLE STRING IF SHORT
{{MOV{#E$HNW{R8{{ELSE SET TO INVOLVE FIRST E$HNW WDS
*
* HERE WITH COUNT OF WORDS TO CHECK IN WC
*
{HSHS1{LCT{R8{R8{{SET COUNTER TO CONTROL LOOP
*
* LOOP TO COMPUTE EXCLUSIVE OR
*
{HSHS2{XOB{(R9)+{R7{{EXCLUSIVE OR NEXT WORD OF CHARS
{{BCT{R8{HSHS2{{LOOP TILL ALL PROCESSED
*
* MERGE HERE WITH EXCLUSIVE OR IN WB
*
{HSHS3{ZGB{R7{{{ZEROISE UNDEFINED BITS
{{ANB{BITSM{R7{{ENSURE IN RANGE 0 TO CFP$M
{{MTI{R7{{{MOVE RESULT AS INTEGER
{{ZER{R9{{{CLEAR GARBAGE VALUE IN XR
{{EXI{{{{RETURN TO HASHS CALLER
{{ENP{{{{END PROCEDURE HASHS
{{EJC{{{{
*
* ICBLD -- BUILD INTEGER BLOCK
*
* (IA) INTEGER VALUE FOR ICBLK
* JSR ICBLD CALL TO BUILD INTEGER BLOCK
* (XR) POINTER TO RESULT ICBLK
* (WA) DESTROYED
*
{ICBLD{PRC{E{0{{ENTRY POINT
{{MFI{R9{ICBL1{{COPY SMALL INTEGERS
{{BLE{R9{#NUM02{ICBL3{JUMP IF 0,1 OR 2
*
* CONSTRUCT ICBLK
*
{ICBL1{MOV{DNAMP{R9{{LOAD POINTER TO NEXT AVAILABLE LOC
{{ADD{#4*ICSI${R9{{POINT PAST NEW ICBLK
{{BLO{R9{DNAME{ICBL2{JUMP IF THERE IS ROOM
{{MOV{#4*ICSI${R6{{ELSE LOAD LENGTH OF ICBLK
{{JSR{ALLOC{{{USE STANDARD ALLOCATOR TO GET BLOCK
{{ADD{R6{R9{{POINT PAST BLOCK TO MERGE
*
* MERGE HERE WITH XR POINTING PAST THE BLOCK OBTAINED
*
{ICBL2{MOV{R9{DNAMP{{SET NEW POINTER
{{SUB{#4*ICSI${R9{{POINT BACK TO START OF BLOCK
{{MOV{#B$ICL{(R9){{STORE TYPE WORD
{{STI{4*ICVAL(R9){{{STORE INTEGER VALUE IN ICBLK
{{EXI{{{{RETURN TO ICBLD CALLER
*
* OPTIMISE BY NOT BUILDING ICBLKS FOR SMALL INTEGERS
*
{ICBL3{WTB{R9{{{CONVERT INTEGER TO OFFSET
{{MOV{L^INTAB(R9){R9{{POINT TO PRE-BUILT ICBLK
{{EXI{{{{RETURN
{{ENP{{{{END PROCEDURE ICBLD
{{EJC{{{{
*
* IDENT -- COMPARE TWO VALUES
*
* IDENT COMPARES TWO VALUES IN THE SENSE OF THE IDENT
* DIFFER FUNCTIONS AVAILABLE AT THE SNOBOL LEVEL.
*
* (XR) FIRST ARGUMENT
* (XL) SECOND ARGUMENT
* JSR IDENT CALL TO COMPARE ARGUMENTS
* PPM LOC TRANSFER LOC IF IDENT
* (NORMAL RETURN IF DIFFER)
* (XR,XL,WC,RA) DESTROYED
*
{IDENT{PRC{E{1{{ENTRY POINT
{{BEQ{R9{R10{IDEN7{JUMP IF SAME POINTER (IDENT)
{{MOV{(R9){R8{{ELSE LOAD ARG 1 TYPE WORD
{{BNE{R8{(R10){IDEN1{DIFFER IF ARG 2 TYPE WORD DIFFER
{{BEQ{R8{#B$SCL{IDEN2{JUMP IF STRINGS
{{BEQ{R8{#B$ICL{IDEN4{JUMP IF INTEGERS
{{BEQ{R8{#B$RCL{IDEN5{JUMP IF REALS
{{BEQ{R8{#B$NML{IDEN6{JUMP IF NAMES
*
* FOR ALL OTHER DATATYPES, MUST BE DIFFER IF XR NE XL
*
* MERGE HERE FOR DIFFER
*
{IDEN1{EXI{{{{TAKE DIFFER EXIT
*
* HERE FOR STRINGS, IDENT ONLY IF LENGTHS AND CHARS SAME
*
{IDEN2{MOV{4*SCLEN(R9){R8{{LOAD ARG 1 LENGTH
{{BNE{R8{4*SCLEN(R10){IDEN1{DIFFER IF LENGTHS DIFFER
{{CTW{R8{0{{GET NUMBER OF WORDS IN STRINGS
{{ADD{#4*SCHAR{R9{{POINT TO CHARS OF ARG 1
{{ADD{#4*SCHAR{R10{{POINT TO CHARS OF ARG 2
{{LCT{R8{R8{{SET LOOP COUNTER
*
* LOOP TO COMPARE CHARACTERS. NOTE THAT WA CANNOT BE ZERO
* SINCE ALL NULL STRINGS POINT TO NULLS AND GIVE XL=XR.
*
{IDEN3{CNE{(R9){(R10){IDEN8{DIFFER IF CHARS DO NOT MATCH
{{ICA{R9{{{ELSE BUMP ARG ONE POINTER
{{ICA{R10{{{BUMP ARG TWO POINTER
{{BCT{R8{IDEN3{{LOOP BACK TILL ALL CHECKED
{{EJC{{{{
*
* IDENT (CONTINUED)
*
* HERE TO EXIT FOR CASE OF TWO IDENT STRINGS
*
{{ZER{R10{{{CLEAR GARBAGE VALUE IN XL
{{ZER{R9{{{CLEAR GARBAGE VALUE IN XR
{{EXI{1{{{TAKE IDENT EXIT
*
* HERE FOR INTEGERS, IDENT IF SAME VALUES
*
{IDEN4{LDI{4*ICVAL(R9){{{LOAD ARG 1
{{SBI{4*ICVAL(R10){{{SUBTRACT ARG 2 TO COMPARE
{{IOV{IDEN1{{{DIFFER IF OVERFLOW
{{INE{IDEN1{{{DIFFER IF RESULT IS NOT ZERO
{{EXI{1{{{TAKE IDENT EXIT
*
* HERE FOR REALS, IDENT IF SAME VALUES
*
{IDEN5{LDR{4*RCVAL(R9){{{LOAD ARG 1
{{SBR{4*RCVAL(R10){{{SUBTRACT ARG 2 TO COMPARE
{{ROV{IDEN1{{{DIFFER IF OVERFLOW
{{RNE{IDEN1{{{DIFFER IF RESULT IS NOT ZERO
{{EXI{1{{{TAKE IDENT EXIT
*
* HERE FOR NAMES, IDENT IF BASES AND OFFSETS SAME
*
{IDEN6{BNE{4*NMOFS(R9){4*NMOFS(R10){IDEN1{DIFFER IF DIFFERENT OFFSET
{{BNE{4*NMBAS(R9){4*NMBAS(R10){IDEN1{DIFFER IF DIFFERENT BASE
*
* MERGE HERE TO SIGNAL IDENT FOR IDENTICAL POINTERS
*
{IDEN7{EXI{1{{{TAKE IDENT EXIT
*
* HERE FOR DIFFER STRINGS
*
{IDEN8{ZER{R9{{{CLEAR GARBAGE PTR IN XR
{{ZER{R10{{{CLEAR GARBAGE PTR IN XL
{{EXI{{{{RETURN TO CALLER (DIFFER)
{{ENP{{{{END PROCEDURE IDENT
{{EJC{{{{
*
* INOUT - USED TO INITIALISE INPUT AND OUTPUT VARIABLES
*
* (XL) POINTER TO VBL NAME STRING
* (WB) TRBLK TYPE
* JSR INOUT CALL TO PERFORM INITIALISATION
* (XL) VRBLK PTR
* (XR) TRBLK PTR
* (WA,WC) DESTROYED
*
* NOTE THAT TRTER (= TRTRF) FIELD OF STANDARD I/O VARIABLES
* POINTS TO CORRESPONDING SVBLK NOT TO A TRBLK AS IS THE
* CASE FOR ORDINARY VARIABLES.
*
{INOUT{PRC{E{0{{ENTRY POINT
{{MOV{R7{-(SP){{STACK TRBLK TYPE
{{MOV{4*SCLEN(R10){R6{{GET NAME LENGTH
{{ZER{R7{{{POINT TO START OF NAME
{{JSR{SBSTR{{{BUILD A PROPER SCBLK
{{JSR{GTNVR{{{BUILD VRBLK
{{PPM{{{{NO ERROR RETURN
{{MOV{R9{R8{{SAVE VRBLK POINTER
{{MOV{(SP)+{R7{{GET TRTER FIELD
{{ZER{R10{{{ZERO TRFPT
{{JSR{TRBLD{{{BUILD TRBLK
{{MOV{R8{R10{{RECALL VRBLK POINTER
{{MOV{4*VRSVP(R10){4*TRTER(R9){{STORE SVBLK POINTER
{{MOV{R9{4*VRVAL(R10){{STORE TRBLK PTR IN VRBLK
{{MOV{#B$VRA{4*VRGET(R10){{SET TRAPPED ACCESS
{{MOV{#B$VRV{4*VRSTO(R10){{SET TRAPPED STORE
{{EXI{{{{RETURN TO CALLER
{{ENP{{{{END PROCEDURE INOUT
{{EJC{{{{
*
* INSBF -- INSERT STRING IN BUFFER
*
* THIS ROUTINE WILL REPLACE A SECTION OF A BUFFER WITH THE
* CONTENTS OF A GIVEN STRING. IF THE LENGTH OF THE
* SECTION TO BE REPLACED IS DIFFERENT THAN THE LENGTH OF
* THE GIVEN STRING, AND THE REPLACEMENT IS NOT AN APPEND,
* THEN THE UPPER SECTION OF THE BUFFER IS SHIFTED UP OR
* DOWN TO CREATE THE PROPER SPACE FOR THE INSERT.
*
* (XR) POINTER TO BFBLK
* (XL) OBJECT WHICH IS STRING CONVERTABLE
* (WA) OFFSET OF START OF INSERT IN (XR)
* (WB) LENGTH OF SECTION IN (XR) REPLACED
* JSR INSBF CALL TO INSERT CHARACTERS IN BUFFER
* PPM LOC THREAD IF (XR) NOT CONVERTABLE
* PPM LOC THREAD IF INSERT NOT POSSIBLE
*
* THE SECOND ALTERNATE EXIT IS TAKEN IF THE INSERT WOULD
* OVERFLOW THE BUFFER, OR IF THE INSERT IS OUT PAST THE
* DEFINED END OF THE BUFFER AS GIVEN.
*
{INSBF{PRC{E{2{{ENTRY POINT
{{MOV{R6{INSSA{{SAVE ENTRY WA
{{MOV{R7{INSSB{{SAVE ENTRY WB
{{MOV{R8{INSSC{{SAVE ENTRY WC
{{ADD{R7{R6{{ADD TO GET OFFSET PAST REPLACE PART
{{MOV{R6{INSAB{{SAVE WA+WB
{{MOV{4*BCLEN(R9){R8{{GET CURRENT DEFINED LENGTH
{{BGT{INSSA{R8{INS07{FAIL IF START OFFSET TOO BIG
{{BGT{R6{R8{INS07{FAIL IF FINAL OFFSET TOO BIG
{{MOV{R10{-(SP){{SAVE ENTRY XL
{{MOV{R9{-(SP){{SAVE BCBLK PTR
{{MOV{R10{-(SP){{STACK AGAIN FOR GTSTG
{{JSR{GTSTG{{{CALL TO CONVERT TO STRING
{{PPM{INS05{{{TAKE STRING CONVERT ERR EXIT
{{MOV{R9{R10{{SAVE STRING PTR
{{MOV{(SP){R9{{RESTORE BCBLK PTR
{{ADD{R8{R6{{ADD BUFFER LEN TO STRING LEN
{{SUB{INSSB{R6{{BIAS OUT COMPONENT BEING REPLACED
{{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK
{{BGT{R6{4*BFALC(R9){INS06{FAIL IF RESULT EXCEEDS ALLOCATION
{{MOV{(SP){R9{{RESTORE BCBLK PTR
{{MOV{R8{R6{{GET BUFFER LENGTH
{{SUB{INSAB{R6{{SUBTRACT TO GET SHIFT LENGTH
{{ADD{4*SCLEN(R10){R8{{ADD LENGTH OF NEW
{{SUB{INSSB{R8{{SUBTRACT OLD TO GET TOTAL NEW LEN
{{MOV{4*BCLEN(R9){R7{{GET OLD BCLEN
{{MOV{R8{4*BCLEN(R9){{STUFF NEW LENGTH
{{BZE{R6{INS04{{SKIP SHIFT IF NOTHING TO DO
{{BEQ{INSSB{4*SCLEN(R10){INS04{SKIP SHIFT IF LENGTHS MATCH
{{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK
{{MOV{R10{-(SP){{SAVE SCBLK PTR
{{BLO{INSSB{4*SCLEN(R10){INS01{BRN IF SHFT IS FOR MORE ROOM
{{EJC{{{{
*
* INSBF (CONTINUED)
*
* WE ARE SHIFTING THE UPPER SEGMENT DOWN TO COMPACT
* THE BUFFER. (THE STRING LENGTH IS SMALLER THAN THE
* SEGMENT BEING REPLACED.) REGISTERS ARE SET AS:
*
* (WA) MOVE (SHIFT DOWN) LENGTH
* (WB) OLD BCLEN
* (WC) NEW BCLEN
* (XR) BFBLK PTR
* (XL),(XS) SCBLK PTR
*
{{MOV{INSSA{R7{{GET OFFSET TO INSERT
{{ADD{4*SCLEN(R10){R7{{ADD INSERT LENGTH TO GET DEST OFF
{{MOV{R9{R10{{MAKE COPY
{{PLC{R10{INSAB{{PREPARE SOURCE FOR MOVE
{{PSC{R9{R7{{PREPARE DESTINATION REG FOR MOVE
{{MVC{{{{MOVE EM OUT
{{BRN{INS02{{{BRANCH TO PAD
*
* WE ARE SHIFTING THE UPPER SEGMENT UP TO EXPAND
* THE BUFFER. (THE STRING LENGTH IS LARGER THAN THE
* SEGMENT BEING REPLACED.)
*
{INS01{MOV{R9{R10{{COPY BFBLK PTR
{{PLC{R10{R7{{SET SOURCE REG FOR MOVE BACKWARDS
{{PSC{R9{R8{{SET DESTINATION PTR FOR MOVE
{{MCB{{{{MOVE BACKWARDS (POSSIBLE OVERLAP)
*
* MERGE HERE AFTER MOVE TO ADJUST PADDING AT NEW BUFFER END
*
{INS02{MOV{(SP)+{R10{{RESTORE SCBLK PTR
{{MOV{R8{R6{{COPY NEW BUFFER END
{{CTB{R6{0{{ROUND OUT
{{SUB{R8{R6{{SUBTRACT TO GET REMAINDER
{{BZE{R6{INS04{{NO PAD IF ALREADY EVEN BOUNDARY
{{MOV{(SP){R9{{GET BCBLK PTR
{{MOV{4*BCBUF(R9){R9{{GET BFBLK PTR
{{PSC{R9{R8{{PREPARE TO PAD
{{ZER{R7{{{CLEAR WB
{{LCT{R6{R6{{LOAD LOOP COUNT
*
* LOOP HERE TO STUFF PAD CHARACTERS
*
{INS03{SCH{R7{(R9)+{{STUFF ZERO PAD
{{BCT{R6{INS03{{BRANCH FOR MORE
{{EJC{{{{
*
* INSBF (CONTINUED)
*
* MERGE HERE WHEN PADDING OK. NOW COPY IN THE INSERT
* STRING TO THE HOLE.
*
{INS04{MOV{(SP){R9{{GET BCBLK PTR
{{MOV{4*BCBUF(R9){R9{{GET BFBLK PTR
{{MOV{4*SCLEN(R10){R6{{GET MOVE LENGTH
{{PLC{R10{{{PREPARE TO COPY FROM FIRST CHAR
{{PSC{R9{INSSA{{PREPARE TO STORE IN HOLE
{{MVC{{{{COPY THE CHARACTERS
{{MOV{(SP)+{R9{{RESTORE ENTRY XR
{{MOV{(SP)+{R10{{RESTORE ENTRY XL
{{MOV{INSSA{R6{{RESTORE ENTRY WA
{{MOV{INSSB{R7{{RESTORE ENTRY WB
{{MOV{INSSC{R8{{RESTORE ENTRY WC
{{EXI{{{{RETURN TO CALLER
*
* HERE TO TAKE STRING CONVERT ERROR EXIT
*
{INS05{MOV{(SP)+{R9{{RESTORE ENTRY XR
{{MOV{(SP)+{R10{{RESTORE ENTRY XL
{{MOV{INSSA{R6{{RESTORE ENTRY WA
{{MOV{INSSB{R7{{RESTORE ENTRY WB
{{MOV{INSSC{R8{{RESTORE ENTRY WC
{{EXI{1{{{ALTERNATE EXIT
*
* HERE FOR INVALID OFFSET OR LENGTH
*
{INS06{MOV{(SP)+{R9{{RESTORE ENTRY XR
{{MOV{(SP)+{R10{{RESTORE ENTRY XL
*
* MERGE FOR LENGTH FAILURE EXIT WITH STACK SET
*
{INS07{MOV{INSSA{R6{{RESTORE ENTRY WA
{{MOV{INSSB{R7{{RESTORE ENTRY WB
{{MOV{INSSC{R8{{RESTORE ENTRY WC
{{EXI{2{{{ALTERNATE EXIT
{{ENP{{{{END PROCEDURE INSBF
{{EJC{{{{
*
* IOFCB -- GET INPUT/OUTPUT FCBLK POINTER
*
* USED BY ENDFILE, EJECT AND REWIND TO FIND THE FCBLK
* (IF ANY) CORRESPONDING TO THEIR ARGUMENT.
*
* -(XS) ARGUMENT
* JSR IOFCB CALL TO FIND FCBLK
* PPM LOC ARG IS AN UNSUITABLE NAME
* PPM LOC ARG IS NULL STRING
* (XS) POPPED
* (XL) PTR TO FILEARG1 VRBLK
* (XR) ARGUMENT
* (WA) FCBLK PTR OR 0
* (WB) DESTROYED
*
{IOFCB{PRC{N{2{{ENTRY POINT
{{JSR{GTSTG{{{GET ARG AS STRING
{{PPM{IOFC2{{{FAIL
{{MOV{R9{R10{{COPY STRING PTR
{{JSR{GTNVR{{{GET AS NATURAL VARIABLE
{{PPM{IOFC3{{{FAIL IF NULL
{{MOV{R10{R7{{COPY STRING POINTER AGAIN
{{MOV{R9{R10{{COPY VRBLK PTR FOR RETURN
{{ZER{R6{{{IN CASE NO TRBLK FOUND
*
* LOOP TO FIND FILE ARG1 TRBLK
*
{IOFC1{MOV{4*VRVAL(R9){R9{{GET POSSIBLE TRBLK PTR
{{BNE{(R9){#B$TRT{IOFC2{FAIL IF END OF CHAIN
{{BNE{4*TRTYP(R9){#TRTFC{IOFC1{LOOP IF NOT FILE ARG TRBLK
{{MOV{4*TRFPT(R9){R6{{GET FCBLK PTR
{{MOV{R7{R9{{COPY ARG
{{EXI{{{{RETURN
*
* FAIL RETURN
*
{IOFC2{EXI{1{{{FAIL
*
* NULL ARG
*
{IOFC3{EXI{2{{{NULL ARG RETURN
{{ENP{{{{END PROCEDURE IOFCB
{{EJC{{{{
*
* IOPPF -- PROCESS FILEARG2 FOR IOPUT
*
* (R$XSC) FILEARG2 PTR
* JSR IOPPF CALL TO PROCESS FILEARG2
* (XL) FILEARG1 PTR
* (XR) FILE ARG2 PTR
* -(XS)..-(XS) FIELDS EXTRACTED FROM FILEARG2
* (WC) NO. OF FIELDS EXTRACTED
* (WB) INPUT/OUTPUT FLAG
* (WA) FCBLK PTR OR 0
*
{IOPPF{PRC{N{0{{ENTRY POINT
{{ZER{R7{{{TO COUNT FIELDS EXTRACTED
*
* LOOP TO EXTRACT FIELDS
*
{IOPP1{MOV{#IODEL{R10{{GET DELIMITER
{{MOV{R10{R8{{COPY IT
{{JSR{XSCAN{{{GET NEXT FIELD
{{MOV{R9{-(SP){{STACK IT
{{ICV{R7{{{INCREMENT COUNT
{{BNZ{R6{IOPP1{{LOOP
{{MOV{R7{R8{{COUNT OF FIELDS
{{MOV{IOPTT{R7{{I/O MARKER
{{MOV{R$IOF{R6{{FCBLK PTR OR 0
{{MOV{R$IO2{R9{{FILE ARG2 PTR
{{MOV{R$IO1{R10{{FILEARG1
{{EXI{{{{RETURN
{{ENP{{{{END PROCEDURE IOPPF
{{EJC{{{{
*
* IOPUT -- ROUTINE USED BY INPUT AND OUTPUT
*
* IOPUT SETS UP INPUT/OUTPUT ASSOCIATIONS. IT BUILDS
* SUCH TRACE AND FILE CONTROL BLOCKS AS ARE NECESSARY AND
* CALLS SYSFC,SYSIO TO PERFORM CHECKS ON THE
* ARGUMENTS AND TO OPEN THE FILES.
*
* +-----------+ +---------------+ +-----------+
* +-.I I I I------.I =B$XRT I
* I +-----------+ +---------------+ +-----------+
* I / / (R$FCB) I *4 I
* I / / +-----------+
* I +-----------+ +---------------+ I I-
* I I NAME +--.I =B$TRT I +-----------+
* I / / +---------------+ I I
* I (FIRST ARG) I =TRTIN/=TRTOU I +-----------+
* I +---------------+ I
* I I VALUE I I
* I +---------------+ I
* I I(TRTRF) 0 OR I--+ I
* I +---------------+ I I
* I I(TRFPT) 0 OR I----+ I
* I +---------------+ I I I
* I (I/O TRBLK) I I I
* I +-----------+ I I I
* I I I I I I
* I +-----------+ I I I
* I I I I I I
* I +-----------+ +---------------+ I I I
* I I +--.I =B$TRT I.-+ I I
* I +-----------+ +---------------+ I I
* I / / I =TRTFC I I I
* I / / +---------------+ I I
* I (FILEARG1 I VALUE I I I
* I VRBLK) +---------------+ I I
* I I(TRTRF) 0 OR I--+ I .
* I +---------------+ I . +-----------+
* I I(TRFPT) 0 OR I------./ FCBLK /
* I +---------------+ I +-----------+
* I (TRTRF) I
* I I
* I I
* I +---------------+ I
* I I =B$XRT I.-+
* I +---------------+
* I I *5 I
* I +---------------+
* +------------------I I
* +---------------+ +-----------+
* I(TRTRF) O OR I------.I =B$XRT I
* +---------------+ +-----------+
* I NAME OFFSET I I ETC I
* +---------------+
* (IOCHN - CHAIN OF NAME POINTERS)
{{EJC{{{{
*
* IOPUT (CONTINUED)
*
* NO ADDITIONAL TRAP BLOCKS ARE USED FOR STANDARD INPUT/OUT
* FILES. OTHERWISE AN I/O TRAP BLOCK IS ATTACHED TO SECOND
* ARG (FILEARG1) VRBLK. SEE DIAGRAM ABOVE FOR DETAILS OF
* THE STRUCTURE BUILT.
*
* -(XS) 1ST ARG (VBL TO BE ASSOCIATED)
* -(XS) 2ND ARG (FILE ARG1)
* -(XS) 3RD ARG (FILE ARG2)
* (WB) 0 FOR INPUT, 3 FOR OUTPUT ASSOC.
* JSR IOPUT CALL FOR INPUT/OUTPUT ASSOCIATION
* PPM LOC 3RD ARG NOT A STRING
* PPM LOC 2ND ARG NOT A SUITABLE NAME
* PPM LOC 1ST ARG NOT A SUITABLE NAME
* PPM LOC INAPPROPRIATE FILE SPEC FOR I/O
* PPM LOC I/O FILE DOES NOT EXIST
* PPM LOC I/O FILE CANNOT BE READ/WRITTEN
* (XS) POPPED
* (XL,XR,WA,WB,WC) DESTROYED
*
{IOPUT{PRC{N{6{{ENTRY POINT
{{ZER{R$IOT{{{IN CASE NO TRTRF BLOCK USED
{{ZER{R$IOF{{{IN CASE NO FCBLK ALOCATED
{{MOV{R7{IOPTT{{STORE I/O TRACE TYPE
{{JSR{XSCNI{{{PREPARE TO SCAN FILEARG2
{{PPM{IOP13{{{FAIL
{{PPM{IOPA0{{{NULL FILE ARG2
*
{IOPA0{MOV{R9{R$IO2{{KEEP FILE ARG2
{{MOV{R6{R10{{COPY LENGTH
{{JSR{GTSTG{{{CONVERT FILEARG1 TO STRING
{{PPM{IOP14{{{FAIL
{{MOV{R9{R$IO1{{KEEP FILEARG1 PTR
{{JSR{GTNVR{{{CONVERT TO NATURAL VARIABLE
{{PPM{IOP00{{{JUMP IF NULL
{{BRN{IOP04{{{JUMP TO PROCESS NON-NULL ARGS
*
* NULL FILEARG1
*
{IOP00{BZE{R10{IOP01{{SKIP IF BOTH ARGS NULL
{{JSR{IOPPF{{{PROCESS FILEARG2
{{JSR{SYSFC{{{CALL FOR FILEARG2 CHECK
{{PPM{IOP16{{{FAIL
{{BRN{IOP11{{{COMPLETE FILE ASSOCIATION
{{EJC{{{{
*
* IOPUT (CONTINUED)
*
* HERE WITH 0 OR FCBLK PTR IN (XL)
*
{IOP01{MOV{IOPTT{R7{{GET TRACE TYPE
{{MOV{R$IOT{R9{{GET 0 OR TRTRF PTR
{{JSR{TRBLD{{{BUILD TRBLK
{{MOV{R9{R8{{COPY TRBLK POINTER
{{MOV{(SP)+{R9{{GET VARIABLE FROM STACK
{{JSR{GTVAR{{{POINT TO VARIABLE
{{PPM{IOP15{{{FAIL
{{MOV{R10{R$ION{{SAVE NAME POINTER
{{MOV{R10{R9{{COPY NAME POINTER
{{ADD{R6{R9{{POINT TO VARIABLE
{{SUB{#4*VRVAL{R9{{SUBTRACT OFFSET,MERGE INTO LOOP
*
* LOOP TO END OF TRBLK CHAIN IF ANY
*
{IOP02{MOV{R9{R10{{COPY BLK PTR
{{MOV{4*VRVAL(R9){R9{{LOAD PTR TO NEXT TRBLK
{{BNE{(R9){#B$TRT{IOP03{JUMP IF NOT TRAPPED
{{BNE{4*TRTYP(R9){IOPTT{IOP02{LOOP IF NOT SAME ASSOCN
{{MOV{4*TRNXT(R9){R9{{GET VALUE AND DELETE OLD TRBLK
*
* IOPUT (CONTINUED)
*
* STORE NEW ASSOCIATION
*
{IOP03{MOV{R8{4*VRVAL(R10){{LINK TO THIS TRBLK
{{MOV{R8{R10{{COPY POINTER
{{MOV{R9{4*TRNXT(R10){{STORE VALUE IN TRBLK
{{MOV{R$ION{R9{{RESTORE POSSIBLE VRBLK POINTER
{{MOV{R6{R7{{KEEP OFFSET TO NAME
{{JSR{SETVR{{{IF VRBLK, SET VRGET,VRSTO
{{MOV{R$IOT{R9{{GET 0 OR TRTRF PTR
{{BNZ{R9{IOP19{{JUMP IF TRTRF BLOCK EXISTS
{{EXI{{{{RETURN TO CALLER
*
* NON STANDARD FILE
* SEE IF AN FCBLK HAS ALREADY BEEN ALLOCATED.
*
{IOP04{ZER{R6{{{IN CASE NO FCBLK FOUND
{{EJC{{{{
*
* IOPUT (CONTINUED)
*
* SEARCH POSSIBLE TRBLK CHAIN TO PICK UP THE FCBLK
*
{IOP05{MOV{R9{R7{{REMEMBER BLK PTR
{{MOV{4*VRVAL(R9){R9{{CHAIN ALONG
{{BNE{(R9){#B$TRT{IOP06{JUMP IF END OF TRBLK CHAIN
{{BNE{4*TRTYP(R9){#TRTFC{IOP05{LOOP IF MORE TO GO
{{MOV{R9{R$IOT{{POINT TO FILE ARG1 TRBLK
{{MOV{4*TRFPT(R9){R6{{GET FCBLK PTR FROM TRBLK
*
* WA = 0 OR FCBLK PTR
* WB = PTR TO PRECEDING BLK TO WHICH ANY TRTRF BLOCK
* FOR FILE ARG1 MUST BE CHAINED.
*
{IOP06{MOV{R6{R$IOF{{KEEP POSSIBLE FCBLK PTR
{{MOV{R7{R$IOP{{KEEP PRECEDING BLK PTR
{{JSR{IOPPF{{{PROCESS FILEARG2
{{JSR{SYSFC{{{SEE IF FCBLK REQUIRED
{{PPM{IOP16{{{FAIL
{{BZE{R6{IOP12{{SKIP IF NO NEW FCBLK WANTED
{{BLT{R8{#NUM02{IOP6A{JUMP IF FCBLK IN DYNAMIC
{{JSR{ALOST{{{GET IT IN STATIC
{{BRN{IOP6B{{{SKIP
*
* OBTAIN FCBLK IN DYNAMIC
*
{IOP6A{JSR{ALLOC{{{GET SPACE FOR FCBLK
*
* MERGE
*
{IOP6B{MOV{R9{R10{{POINT TO FCBLK
{{MOV{R6{R7{{COPY ITS LENGTH
{{BTW{R7{{{GET COUNT AS WORDS (SGD APR80)
{{LCT{R7{R7{{LOOP COUNTER
*
* CLEAR FCBLK
*
{IOP07{ZER{(R9)+{{{CLEAR A WORD
{{BCT{R7{IOP07{{LOOP
{{BEQ{R8{#NUM02{IOP09{SKIP IF IN STATIC - DONT SET FIELDS
{{MOV{#B$XNT{(R10){{STORE XNBLK CODE IN CASE
{{MOV{R6{4*1(R10){{STORE LENGTH
{{BNZ{R8{IOP09{{JUMP IF XNBLK WANTED
{{MOV{#B$XRT{(R10){{XRBLK CODE REQUESTED
*
{{EJC{{{{
* IOPUT (CONTINUED)
*
* COMPLETE FCBLK INITIALISATION
*
{IOP09{MOV{R$IOT{R9{{GET POSSIBLE TRBLK PTR
{{MOV{R10{R$IOF{{STORE FCBLK PTR
{{BNZ{R9{IOP10{{JUMP IF TRBLK ALREADY FOUND
*
* A NEW TRBLK IS NEEDED
*
{{MOV{#TRTFC{R7{{TRTYP FOR FCBLK TRAP BLK
{{JSR{TRBLD{{{MAKE THE BLOCK
{{MOV{R9{R$IOT{{COPY TRTRF PTR
{{MOV{R$IOP{R10{{POINT TO PRECEDING BLK
{{MOV{4*VRVAL(R10){4*VRVAL(R9){{COPY VALUE FIELD TO TRBLK
{{MOV{R9{4*VRVAL(R10){{LINK NEW TRBLK INTO CHAIN
{{MOV{R10{R9{{POINT TO PREDECESSOR BLK
{{JSR{SETVR{{{SET TRACE INTERCEPTS
{{MOV{4*VRVAL(R9){R9{{RECOVER TRBLK PTR
*
* XR IS PTR TO TRBLK, XL IS FCBLK PTR OR 0
*
{IOP10{MOV{R$IOF{4*TRFPT(R9){{STORE FCBLK PTR
*
* CALL SYSIO TO COMPLETE FILE ACCESSING
*
{IOP11{MOV{R$IOF{R6{{COPY FCBLK PTR OR 0
{{MOV{IOPTT{R7{{GET INPUT/OUTPUT FLAG
{{MOV{R$IO2{R9{{GET FILE ARG2
{{MOV{R$IO1{R10{{GET FILE ARG1
{{JSR{SYSIO{{{ASSOCIATE TO THE FILE
{{PPM{IOP17{{{FAIL
{{PPM{IOP18{{{FAIL
{{BNZ{R$IOT{IOP01{{NOT STD INPUT IF NON-NULL TRTRF BLK
{{BNZ{IOPTT{IOP01{{JUMP IF OUTPUT
{{BZE{R8{IOP01{{NO CHANGE TO STANDARD READ LENGTH
{{MOV{R8{CSWIN{{STORE NEW READ LENGTH FOR STD FILE
{{BRN{IOP01{{{MERGE TO FINISH THE TASK
*
* SYSFC MAY HAVE RETURNED A POINTER TO A PRIVATE FCBLK
*
{IOP12{BNZ{R10{IOP09{{JUMP IF PRIVATE FCBLK
{{BRN{IOP11{{{FINISH THE ASSOCIATION
*
* FAILURE RETURNS
*
{IOP13{EXI{1{{{3RD ARG NOT A STRING
{IOP14{EXI{2{{{2ND ARG UNSUITABLE
{IOP15{EXI{3{{{1ST ARG UNSUITABLE
{IOP16{EXI{4{{{FILE SPEC WRONG
{IOP17{EXI{5{{{I/O FILE DOES NOT EXIST
{IOP18{EXI{6{{{I/O FILE CANNOT BE READ/WRITTEN
{{EJC{{{{
*
* IOPUT (CONTINUED)
*
* ADD TO IOCHN CHAIN OF ASSSOCIATED VARIABLES UNLESS ALREAD
* PRESENT.
*
{IOP19{MOV{R$ION{R8{{WC = NAME BASE, WB = NAME OFFSET
*
* SEARCH LOOP
*
{IOP20{MOV{4*TRTRF(R9){R9{{NEXT LINK OF CHAIN
{{BZE{R9{IOP21{{NOT FOUND
{{BNE{R8{4*IONMB(R9){IOP20{NO MATCH
{{BEQ{R7{4*IONMO(R9){IOP22{EXIT IF MATCHED
{{BRN{IOP20{{{LOOP
*
* NOT FOUND
*
{IOP21{MOV{#4*NUM05{R6{{SPACE NEEDED
{{JSR{ALLOC{{{GET IT
{{MOV{#B$XRT{(R9){{STORE XRBLK CODE
{{MOV{R6{4*1(R9){{STORE LENGTH
{{MOV{R8{4*IONMB(R9){{STORE NAME BASE
{{MOV{R7{4*IONMO(R9){{STORE NAME OFFSET
{{MOV{R$IOT{R10{{POINT TO TRTRF BLK
{{MOV{4*TRTRF(R10){R6{{GET PTR FIELD CONTENTS
{{MOV{R9{4*TRTRF(R10){{STORE PTR TO NEW BLOCK
{{MOV{R6{4*TRTRF(R9){{COMPLETE THE LINKING
*
* INSERT FCBLK ON FCBLK CHAIN FOR SYSEJ, SYSXI
*
{IOP22{BZE{R$IOF{IOP25{{SKIP IF NO FCBLK
{{MOV{R$FCB{R10{{PTR TO HEAD OF EXISTING CHAIN
*
* SEE IF FCBLK ALREADY ON CHAIN
*
{IOP23{BZE{R10{IOP24{{NOT ON IF END OF CHAIN
{{BEQ{4*3(R10){R$IOF{IOP25{DONT DUPLICATE IF FIND IT
{{MOV{4*2(R10){R10{{GET NEXT LINK
{{BRN{IOP23{{{LOOP
*
* NOT FOUND SO ADD AN ENTRY FOR THIS FCBLK
*
{IOP24{MOV{#4*NUM04{R6{{SPACE NEEDED
{{JSR{ALLOC{{{GET IT
{{MOV{#B$XRT{(R9){{STORE BLOCK CODE
{{MOV{R6{4*1(R9){{STORE LENGTH
{{MOV{R$FCB{4*2(R9){{STORE PREVIOUS LINK IN THIS NODE
{{MOV{R$IOF{4*3(R9){{STORE FCBLK PTR
{{MOV{R9{R$FCB{{INSERT NODE INTO FCBLK CHAIN
*
* RETURN
*
{IOP25{EXI{{{{RETURN TO CALLER
{{ENP{{{{END PROCEDURE IOPUT
{{EJC{{{{
*
* KTREX -- EXECUTE KEYWORD TRACE
*
* KTREX IS USED TO EXECUTE A POSSIBLE KEYWORD TRACE. IT
* INCLUDES THE TEST ON TRACE AND TESTS FOR TRACE ACTIVE.
*
* (XL) PTR TO TRBLK (OR 0 IF UNTRACED)
* JSR KTREX CALL TO EXECUTE KEYWORD TRACE
* (XL,WA,WB,WC) DESTROYED
* (RA) DESTROYED
*
{KTREX{PRC{R{0{{ENTRY POINT (RECURSIVE)
{{BZE{R10{KTRX3{{IMMEDIATE EXIT IF KEYWORD UNTRACED
{{BZE{KVTRA{KTRX3{{IMMEDIATE EXIT IF TRACE = 0
{{DCV{KVTRA{{{ELSE DECREMENT TRACE
{{MOV{R9{-(SP){{SAVE XR
{{MOV{R10{R9{{COPY TRBLK POINTER
{{MOV{4*TRKVR(R9){R10{{LOAD VRBLK POINTER (NMBAS)
{{MOV{#4*VRVAL{R6{{SET NAME OFFSET
{{BZE{4*TRFNC(R9){KTRX1{{JUMP IF PRINT TRACE
{{JSR{TRXEQ{{{ELSE EXECUTE FULL TRACE
{{BRN{KTRX2{{{AND JUMP TO EXIT
*
* HERE FOR PRINT TRACE
*
{KTRX1{MOV{R10{-(SP){{STACK VRBLK PTR FOR KWNAM
{{MOV{R6{-(SP){{STACK OFFSET FOR KWNAM
{{JSR{PRTSN{{{PRINT STATEMENT NUMBER
{{MOV{#CH$AM{R6{{LOAD AMPERSAND
{{JSR{PRTCH{{{PRINT AMPERSAND
{{JSR{PRTNM{{{PRINT KEYWORD NAME
{{MOV{#TMBEB{R9{{POINT TO BLANK-EQUAL-BLANK
{{JSR{PRTST{{{PRINT BLANK-EQUAL-BLANK
{{JSR{KWNAM{{{GET KEYWORD PSEUDO-VARIABLE NAME
{{MOV{R9{DNAMP{{RESET PTR TO DELETE KVBLK
{{JSR{ACESS{{{GET KEYWORD VALUE
{{PPM{{{{FAILURE IS IMPOSSIBLE
{{JSR{PRTVL{{{PRINT KEYWORD VALUE
{{JSR{PRTNL{{{TERMINATE PRINT LINE
*
* HERE TO EXIT AFTER COMPLETING TRACE
*
{KTRX2{MOV{(SP)+{R9{{RESTORE ENTRY XR
*
* MERGE HERE TO EXIT IF NO TRACE REQUIRED
*
{KTRX3{EXI{{{{RETURN TO KTREX CALLER
{{ENP{{{{END PROCEDURE KTREX
{{EJC{{{{
*
* KWNAM -- GET PSEUDO-VARIABLE NAME FOR KEYWORD
*
* 1(XS) NAME BASE FOR VRBLK
* 0(XS) OFFSET (SHOULD BE *VRVAL)
* JSR KWNAM CALL TO GET PSEUDO-VARIABLE NAME
* (XS) POPPED TWICE
* (XL,WA) RESULTING PSEUDO-VARIABLE NAME
* (XR,WA,WB) DESTROYED
*
{KWNAM{PRC{N{0{{ENTRY POINT
{{ICA{SP{{{IGNORE NAME OFFSET
{{MOV{(SP)+{R9{{LOAD NAME BASE
{{BGE{R9{STATE{KWNM1{JUMP IF NOT NATURAL VARIABLE NAME
{{BNZ{4*VRLEN(R9){KWNM1{{ERROR IF NOT SYSTEM VARIABLE
{{MOV{4*VRSVP(R9){R9{{ELSE POINT TO SVBLK
{{MOV{4*SVBIT(R9){R6{{LOAD BIT MASK
{{ANB{BTKNM{R6{{AND WITH KEYWORD BIT
{{ZRB{R6{KWNM1{{ERROR IF NO KEYWORD ASSOCIATION
{{MOV{4*SVLEN(R9){R6{{ELSE LOAD NAME LENGTH IN CHARACTERS
{{CTB{R6{SVCHS{{COMPUTE OFFSET TO FIELD WE WANT
{{ADD{R6{R9{{POINT TO SVKNM FIELD
{{MOV{(R9){R7{{LOAD SVKNM VALUE
{{MOV{#4*KVSI${R6{{SET SIZE OF KVBLK
{{JSR{ALLOC{{{ALLOCATE KVBLK
{{MOV{#B$KVT{(R9){{STORE TYPE WORD
{{MOV{R7{4*KVNUM(R9){{STORE KEYWORD NUMBER
{{MOV{#TRBKV{4*KVVAR(R9){{SET DUMMY TRBLK POINTER
{{MOV{R9{R10{{COPY KVBLK POINTER
{{MOV{#4*KVVAR{R6{{SET PROPER OFFSET
{{EXI{{{{RETURN TO KVNAM CALLER
*
* HERE IF NOT KEYWORD NAME
*
{KWNM1{ERB{251{KEYWORD{{OPERAND IS NOT NAME OF DEFINED KEYWORD
{{ENP{{{{END PROCEDURE KWNAM
{{EJC{{{{
*
* LCOMP-- COMPARE TWO STRINGS LEXICALLY
*
* 1(XS) FIRST ARGUMENT
* 0(XS) SECOND ARGUMENT
* JSR LCOMP CALL TO COMPARE ARUMENTS
* PPM LOC TRANSFER LOC FOR ARG1 NOT STRING
* PPM LOC TRANSFER LOC FOR ARG2 NOT STRING
* PPM LOC TRANSFER LOC IF ARG1 LLT ARG2
* PPM LOC TRANSFER LOC IF ARG1 LEQ ARG2
* PPM LOC TRANSFER LOC IF ARG1 LGT ARG2
* (THE NORMAL RETURN IS NEVER TAKEN)
* (XS) POPPED TWICE
* (XR,XL) DESTROYED
* (WA,WB,WC,RA) DESTROYED
*
{LCOMP{PRC{N{5{{ENTRY POINT
{{JSR{GTSTG{{{CONVERT SECOND ARG TO STRING
{{PPM{LCMP6{{{JUMP IF SECOND ARG NOT STRING
{{MOV{R9{R10{{ELSE SAVE POINTER
{{MOV{R6{R7{{AND LENGTH
{{JSR{GTSTG{{{CONVERT FIRST ARGUMENT TO STRING
{{PPM{LCMP5{{{JUMP IF NOT STRING
{{MOV{R6{R8{{SAVE ARG 1 LENGTH
{{PLC{R9{{{POINT TO CHARS OF ARG 1
{{PLC{R10{{{POINT TO CHARS OF ARG 2
{{BLO{R6{R7{LCMP1{JUMP IF ARG 1 LENGTH IS SMALLER
{{MOV{R7{R6{{ELSE SET ARG 2 LENGTH AS SMALLER
*
* HERE WITH SMALLER LENGTH IN (WA)
*
{LCMP1{CMC{LCMP4{LCMP3{{COMPARE STRINGS, JUMP IF UNEQUAL
{{BNE{R7{R8{LCMP2{IF EQUAL, JUMP IF LENGTHS UNEQUAL
{{EXI{4{{{ELSE IDENTICAL STRINGS, LEQ EXIT
{{EJC{{{{
*
* LCOMP (CONTINUED)
*
* HERE IF INITIAL STRINGS IDENTICAL, BUT LENGTHS UNEQUAL
*
{LCMP2{BHI{R8{R7{LCMP4{JUMP IF ARG 1 LENGTH GT ARG 2 LENG
*
* HERE IF FIRST ARG LLT SECOND ARG
*
{LCMP3{EXI{3{{{TAKE LLT EXIT
*
* HERE IF FIRST ARG LGT SECOND ARG
*
{LCMP4{EXI{5{{{TAKE LGT EXIT
*
* HERE IF FIRST ARG IS NOT A STRING
*
{LCMP5{EXI{1{{{TAKE BAD FIRST ARG EXIT
*
* HERE FOR SECOND ARG NOT A STRING
*
{LCMP6{EXI{2{{{TAKE BAD SECOND ARG ERROR EXIT
{{ENP{{{{END PROCEDURE LCOMP
{{EJC{{{{
*
* LISTR -- LIST SOURCE LINE
*
* LISTR IS USED TO LIST A SOURCE LINE DURING THE INITIAL
* COMPILATION. IT IS CALLED FROM SCANE AND SCANL.
*
* JSR LISTR CALL TO LIST LINE
* (XR,XL,WA,WB,WC) DESTROYED
*
* GLOBAL LOCATIONS USED BY LISTR
*
* ERLST IF LISTING ON ACCOUNT OF AN ERROR
*
* LSTLC COUNT LINES ON CURRENT PAGE
*
* LSTNP MAX NUMBER OF LINES/PAGE
*
* LSTPF SET NON-ZERO IF THE CURRENT SOURCE
* LINE HAS BEEN LISTED, ELSE ZERO.
*
* LSTPG COMPILER LISTING PAGE NUMBER
*
* LSTSN SET IF STMNT NUM TO BE LISTED
*
* R$CIM POINTER TO CURRENT INPUT LINE.
*
* R$TTL TITLE FOR SOURCE LISTING
*
* R$STL PTR TO SUB-TITLE STRING
*
* ENTRY POINT
*
{LISTR{PRC{E{0{{ENTRY POINT
{{BNZ{CNTTL{LIST5{{JUMP IF -TITLE OR -STITL
{{BNZ{LSTPF{LIST4{{IMMEDIATE EXIT IF ALREADY LISTED
{{BGE{LSTLC{LSTNP{LIST6{JUMP IF NO ROOM
*
* HERE AFTER PRINTING TITLE (IF NEEDED)
*
{LIST0{MOV{R$CIM{R9{{LOAD POINTER TO CURRENT IMAGE
{{PLC{R9{{{POINT TO CHARACTERS
{{LCH{R6{(R9){{LOAD FIRST CHARACTER
{{MOV{LSTSN{R9{{LOAD STATEMENT NUMBER
{{BZE{R9{LIST2{{JUMP IF NO STATEMENT NUMBER
{{MTI{R9{{{ELSE GET STMNT NUMBER AS INTEGER
{{BNE{STAGE{#STGIC{LIST1{SKIP IF EXECUTE TIME
{{BEQ{R6{#CH$AS{LIST2{NO STMNT NUMBER LIST IF COMMENT
{{BEQ{R6{#CH$MN{LIST2{NO STMNT NO. IF CONTROL CARD
*
* PRINT STATEMENT NUMBER
*
{LIST1{JSR{PRTIN{{{ELSE PRINT STATEMENT NUMBER
{{ZER{LSTSN{{{AND CLEAR FOR NEXT TIME IN
{{EJC{{{{
*
* LISTR (CONTINUED)
*
* MERGE HERE AFTER PRINTING STATEMENT NUMBER (IF REQUIRED)
*
{LIST2{MOV{#STNPD{PROFS{{POINT PAST STATEMENT NUMBER
{{MOV{R$CIM{R9{{LOAD POINTER TO CURRENT IMAGE
{{JSR{PRTST{{{PRINT IT
{{ICV{LSTLC{{{BUMP LINE COUNTER
{{BNZ{ERLST{LIST3{{JUMP IF ERROR COPY TO INT.CH.
{{JSR{PRTNL{{{TERMINATE LINE
{{BZE{CSWDB{LIST3{{JUMP IF -SINGLE MODE
{{JSR{PRTNL{{{ELSE ADD A BLANK LINE
{{ICV{LSTLC{{{AND BUMP LINE COUNTER
*
* HERE AFTER PRINTING SOURCE IMAGE
*
{LIST3{MNZ{LSTPF{{{SET FLAG FOR LINE PRINTED
*
* MERGE HERE TO EXIT
*
{LIST4{EXI{{{{RETURN TO LISTR CALLER
*
* PRINT TITLE AFTER -TITLE OR -STITL CARD
*
{LIST5{ZER{CNTTL{{{CLEAR FLAG
*
* EJECT TO NEW PAGE AND LIST TITLE
*
{LIST6{JSR{PRTPS{{{EJECT
{{BZE{PRICH{LIST7{{SKIP IF LISTING TO REGULAR PRINTER
{{BEQ{R$TTL{#NULLS{LIST0{TERMINAL LISTING OMITS NULL TITLE
*
* LIST TITLE
*
{LIST7{JSR{LISTT{{{LIST TITLE
{{BRN{LIST0{{{MERGE
{{ENP{{{{END PROCEDURE LISTR
{{EJC{{{{
*
* LISTT -- LIST TITLE AND SUBTITLE
*
* USED DURING COMPILATION TO PRINT PAGE HEADING
*
* JSR LISTT CALL TO LIST TITLE
* (XR,WA) DESTROYED
*
{LISTT{PRC{E{0{{ENTRY POINT
{{MOV{R$TTL{R9{{POINT TO SOURCE LISTING TITLE
{{JSR{PRTST{{{PRINT TITLE
{{MOV{LSTPO{PROFS{{SET OFFSET
{{MOV{#LSTMS{R9{{SET PAGE MESSAGE
{{JSR{PRTST{{{PRINT PAGE MESSAGE
{{ICV{LSTPG{{{BUMP PAGE NUMBER
{{MTI{LSTPG{{{LOAD PAGE NUMBER AS INTEGER
{{JSR{PRTIN{{{PRINT PAGE NUMBER
{{JSR{PRTNL{{{TERMINATE TITLE LINE
{{ADD{#NUM02{LSTLC{{COUNT TITLE LINE AND BLANK LINE
*
* PRINT SUB-TITLE (IF ANY)
*
{{MOV{R$STL{R9{{LOAD POINTER TO SUB-TITLE
{{BZE{R9{LSTT1{{JUMP IF NO SUB-TITLE
{{JSR{PRTST{{{ELSE PRINT SUB-TITLE
{{JSR{PRTNL{{{TERMINATE LINE
{{ICV{LSTLC{{{BUMP LINE COUNT
*
* RETURN POINT
*
{LSTT1{JSR{PRTNL{{{PRINT A BLANK LINE
{{EXI{{{{RETURN TO CALLER
{{ENP{{{{END PROCEDURE LISTT
{{EJC{{{{
*
* NEXTS -- ACQUIRE NEXT SOURCE IMAGE
*
* NEXTS IS USED TO ACQUIRE THE NEXT SOURCE IMAGE AT COMPILE
* TIME. IT ASSUMES THAT A PRIOR CALL TO READR HAS INPUT
* A LINE IMAGE (SEE PROCEDURE READR). BEFORE THE CURRENT
* IMAGE IS FINALLY LOST IT MAY BE LISTED HERE.
*
* JSR NEXTS CALL TO ACQUIRE NEXT INPUT LINE
* (XR,XL,WA,WB,WC) DESTROYED
*
* GLOBAL VALUES AFFECTED
*
* R$CNI ON INPUT, NEXT IMAGE. ON
* EXIT RESET TO ZERO
*
* R$CIM ON EXIT, SET TO POINT TO IMAGE
*
* SCNIL INPUT IMAGE LENGTH ON EXIT
*
* SCNSE RESET TO ZERO ON EXIT
*
* LSTPF SET ON EXIT IF LINE IS LISTED
*
{NEXTS{PRC{E{0{{ENTRY POINT
{{BZE{CSWLS{NXTS2{{JUMP IF -NOLIST
{{MOV{R$CIM{R9{{POINT TO IMAGE
{{BZE{R9{NXTS2{{JUMP IF NO IMAGE
{{PLC{R9{{{GET CHAR PTR
{{LCH{R6{(R9){{GET FIRST CHAR
{{BNE{R6{#CH$MN{NXTS1{JUMP IF NOT CTRL CARD
{{BZE{CSWPR{NXTS2{{JUMP IF -NOPRINT
*
* HERE TO CALL LISTER
*
{NXTS1{JSR{LISTR{{{LIST LINE
*
* HERE AFTER POSSIBLE LISTING
*
{NXTS2{MOV{R$CNI{R9{{POINT TO NEXT IMAGE
{{MOV{R9{R$CIM{{SET AS NEXT IMAGE
{{ZER{R$CNI{{{CLEAR NEXT IMAGE POINTER
{{MOV{4*SCLEN(R9){R6{{GET INPUT IMAGE LENGTH
{{MOV{CSWIN{R7{{GET MAX ALLOWABLE LENGTH
{{BLO{R6{R7{NXTS3{SKIP IF NOT TOO LONG
{{MOV{R7{R6{{ELSE TRUNCATE
*
* HERE WITH LENGTH IN (WA)
*
{NXTS3{MOV{R6{SCNIL{{USE AS RECORD LENGTH
{{ZER{SCNSE{{{RESET SCNSE
{{ZER{LSTPF{{{SET LINE NOT LISTED YET
{{EXI{{{{RETURN TO NEXTS CALLER
{{ENP{{{{END PROCEDURE NEXTS
{{EJC{{{{
*
* PATIN -- PATTERN CONSTRUCTION FOR LEN,POS,RPOS,TAB,RTAB
*
* THESE PATTERN TYPES ALL GENERATE A SIMILAR NODE TYPE. SO
* THE CONSTRUCTION CODE IS SHARED. SEE FUNCTIONS SECTION
* FOR ACTUAL ENTRY POINTS FOR THESE FIVE FUNCTIONS.
*
* (WA) PCODE FOR EXPRESSION ARG CASE
* (WB) PCODE FOR INTEGER ARG CASE
* JSR PATIN CALL TO BUILD PATTERN NODE
* PPM LOC TRANSFER LOC FOR NOT INTEGER OR EXP
* PPM LOC TRANSFER LOC FOR INT OUT OF RANGE
* (XR) POINTER TO CONSTRUCTED NODE
* (XL,WA,WB,WC,IA) DESTROYED
*
{PATIN{PRC{N{2{{ENTRY POINT
{{MOV{R6{R10{{PRESERVE EXPRESSION ARG PCODE
{{JSR{GTSMI{{{TRY TO CONVERT ARG AS SMALL INTEGER
{{PPM{PTIN2{{{JUMP IF NOT INTEGER
{{PPM{PTIN3{{{JUMP IF OUT OF RANGE
*
* COMMON SUCCESSFUL EXIT POINT
*
{PTIN1{JSR{PBILD{{{BUILD PATTERN NODE
{{EXI{{{{RETURN TO CALLER
*
* HERE IF ARGUMENT IS NOT AN INTEGER
*
{PTIN2{MOV{R10{R7{{COPY EXPR ARG CASE PCODE
{{BLO{(R9){#B$E$${PTIN1{ALL OK IF EXPRESSION ARG
{{EXI{1{{{ELSE TAKE ERROR EXIT FOR WRONG TYPE
*
* HERE FOR ERROR OF OUT OF RANGE INTEGER ARGUMENT
*
{PTIN3{EXI{2{{{TAKE OUT-OF-RANGE ERROR EXIT
{{ENP{{{{END PROCEDURE PATIN
{{EJC{{{{
*
* PATST -- PATTERN CONSTRUCTION FOR ANY,NOTANY,
* BREAK,SPAN AND BREAKX PATTERN FUNCTIONS.
*
* THESE PATTERN FUNCTIONS BUILD SIMILAR TYPES OF NODES AND
* THE CONSTRUCTION CODE IS SHARED. SEE FUNCTIONS SECTION
* FOR ACTUAL ENTRY POINTS FOR THESE FIVE PATTERN FUNCTIONS.
*
* 0(XS) STRING ARGUMENT
* (WB) PCODE FOR ONE CHAR ARGUMENT
* (XL) PCODE FOR MULTI-CHAR ARGUMENT
* (WC) PCODE FOR EXPRESSION ARGUMENT
* JSR PATST CALL TO BUILD NODE
* PPM LOC TRANSFER LOC IF NOT STRING OR EXPR
* (XS) POPPED PAST STRING ARGUMENT
* (XR) POINTER TO CONSTRUCTED NODE
* (XL) DESTROYED
* (WA,WB,WC,RA) DESTROYED
*
* NOTE THAT THERE IS A SPECIAL CALL TO PATST IN THE EVALS
* PROCEDURE WITH A SLIGHTLY DIFFERENT FORM. SEE EVALS
* FOR DETAILS OF THE FORM OF THIS CALL.
*
{PATST{PRC{N{1{{ENTRY POINT
{{JSR{GTSTG{{{CONVERT ARGUMENT AS STRING
{{PPM{PATS7{{{JUMP IF NOT STRING
{{BNE{R6{#NUM01{PATS2{JUMP IF NOT ONE CHAR STRING
*
* HERE FOR ONE CHAR STRING CASE
*
{{BZE{R7{PATS2{{TREAT AS MULTI-CHAR IF EVALS CALL
{{PLC{R9{{{POINT TO CHARACTER
{{LCH{R9{(R9){{LOAD CHARACTER
*
* COMMON EXIT POINT AFTER SUCCESSFUL CONSTRUCTION
*
{PATS1{JSR{PBILD{{{CALL ROUTINE TO BUILD NODE
{{EXI{{{{RETURN TO PATST CALLER
{{EJC{{{{
*
* PATST (CONTINUED)
*
* HERE FOR MULTI-CHARACTER STRING CASE
*
{PATS2{MOV{R10{-(SP){{SAVE MULTI-CHAR PCODE
{{MOV{R9{-(SP){{SAVE STRING POINTER
{{MOV{CTMSK{R8{{LOAD CURRENT MASK BIT
{{LSH{R8{1{{SHIFT TO NEXT POSITION
{{NZB{R8{PATS4{{SKIP IF POSITION LEFT IN THIS TBL
*
* HERE WE MUST ALLOCATE A NEW CHARACTER TABLE
*
{{MOV{#4*CTSI${R6{{SET SIZE OF CTBLK
{{JSR{ALLOC{{{ALLOCATE CTBLK
{{MOV{R9{R$CTP{{STORE PTR TO NEW CTBLK
{{MOV{#B$CTT{(R9)+{{STORE TYPE CODE, BUMP PTR
{{LCT{R7{#CFP$A{{SET NUMBER OF WORDS TO CLEAR
{{MOV{BITS0{R8{{LOAD ALL ZERO BITS
*
* LOOP TO CLEAR ALL BITS IN TABLE TO ZEROS
*
{PATS3{MOV{R8{(R9)+{{MOVE WORD OF ZERO BITS
{{BCT{R7{PATS3{{LOOP TILL ALL CLEARED
{{MOV{BITS1{R8{{SET INITIAL BIT POSITION
*
* MERGE HERE WITH BIT POSITION AVAILABLE
*
{PATS4{MOV{R8{CTMSK{{SAVE PARM2 (NEW BIT POSITION)
{{MOV{(SP)+{R10{{RESTORE POINTER TO ARGUMENT STRING
{{MOV{4*SCLEN(R10){R7{{LOAD STRING LENGTH
{{BZE{R7{PATS6{{JUMP IF NULL STRING CASE
{{LCT{R7{R7{{ELSE SET LOOP COUNTER
{{PLC{R10{{{POINT TO CHARACTERS IN ARGUMENT
{{EJC{{{{
*
* PATST (CONTINUED)
*
* LOOP TO SET BITS IN COLUMN OF TABLE
*
{PATS5{LCH{R6{(R10)+{{LOAD NEXT CHARACTER
{{WTB{R6{{{CONVERT TO BYTE OFFSET
{{MOV{R$CTP{R9{{POINT TO CTBLK
{{ADD{R6{R9{{POINT TO CTBLK ENTRY
{{MOV{R8{R6{{COPY BIT MASK
{{ORB{4*CTCHS(R9){R6{{OR IN BITS ALREADY SET
{{MOV{R6{4*CTCHS(R9){{STORE RESULTING BIT STRING
{{BCT{R7{PATS5{{LOOP TILL ALL BITS SET
*
* COMPLETE PROCESSING FOR MUTI-CHAR STRING CASE
*
{PATS6{MOV{R$CTP{R9{{LOAD CTBLK PTR AS PARM1 FOR PBILD
{{ZER{R10{{{CLEAR GARBAGE PTR IN XL
{{MOV{(SP)+{R7{{LOAD PCODE FOR MULTI-CHAR STR CASE
{{BRN{PATS1{{{BACK TO EXIT (WC=BITSTRING=PARM2)
*
* HERE IF ARGUMENT IS NOT A STRING
*
* NOTE THAT THE CALL FROM EVALS CANNOT PASS AN EXPRESSION
* SINCE EVALP ALWAYS REEVALUATES EXPRESSIONS.
*
{PATS7{MOV{R8{R7{{SET PCODE FOR EXPRESSION ARGUMENT
{{BLO{(R9){#B$E$${PATS1{JUMP TO EXIT IF EXPRESSION ARG
{{EXI{1{{{ELSE TAKE WRONG TYPE ERROR EXIT
{{ENP{{{{END PROCEDURE PATST
{{EJC{{{{
*
* PBILD -- BUILD PATTERN NODE
*
* (XR) PARM1 (ONLY IF REQUIRED)
* (WB) PCODE FOR NODE
* (WC) PARM2 (ONLY IF REQUIRED)
* JSR PBILD CALL TO BUILD NODE
* (XR) POINTER TO CONSTRUCTED NODE
* (WA) DESTROYED
*
{PBILD{PRC{E{0{{ENTRY POINT
{{MOV{R9{-(SP){{STACK POSSIBLE PARM1
{{MOV{R7{R9{{COPY PCODE
{{LEI{R9{{{LOAD ENTRY POINT ID (BL$PX)
{{BEQ{R9{#BL$P1{PBLD1{JUMP IF ONE PARAMETER
{{BEQ{R9{#BL$P0{PBLD3{JUMP IF NO PARAMETERS
*
* HERE FOR TWO PARAMETER CASE
*
{{MOV{#4*PCSI${R6{{SET SIZE OF P2BLK
{{JSR{ALLOC{{{ALLOCATE BLOCK
{{MOV{R8{4*PARM2(R9){{STORE SECOND PARAMETER
{{BRN{PBLD2{{{MERGE WITH ONE PARM CASE
*
* HERE FOR ONE PARAMETER CASE
*
{PBLD1{MOV{#4*PBSI${R6{{SET SIZE OF P1BLK
{{JSR{ALLOC{{{ALLOCATE NODE
*
* MERGE HERE FROM TWO PARM CASE
*
{PBLD2{MOV{(SP){4*PARM1(R9){{STORE FIRST PARAMETER
{{BRN{PBLD4{{{MERGE WITH NO PARAMETER CASE
*
* HERE FOR CASE OF NO PARAMETERS
*
{PBLD3{MOV{#4*PASI${R6{{SET SIZE OF P0BLK
{{JSR{ALLOC{{{ALLOCATE NODE
*
* MERGE HERE FROM OTHER CASES
*
{PBLD4{MOV{R7{(R9){{STORE PCODE
{{ICA{SP{{{POP FIRST PARAMETER
{{MOV{#NDNTH{4*PTHEN(R9){{SET NOTHEN SUCCESSOR POINTER
{{EXI{{{{RETURN TO PBILD CALLER
{{ENP{{{{END PROCEDURE PBILD
{{EJC{{{{
*
* PCONC -- CONCATENATE TWO PATTERNS
*
* (XL) PTR TO RIGHT PATTERN
* (XR) PTR TO LEFT PATTERN
* JSR PCONC CALL TO CONCATENATE PATTERNS
* (XR) PTR TO CONCATENATED PATTERN
* (XL,WA,WB,WC) DESTROYED
*
*
* TO CONCATENATE TWO PATTERNS, ALL SUCCESSORS IN THE LEFT
* PATTERN WHICH POINT TO THE NOTHEN NODE MUST BE CHANGED TO
* POINT TO THE RIGHT PATTERN. HOWEVER, THIS MODIFICATION
* MUST BE PERFORMED ON A COPY OF THE LEFT ARGUMENT RATHER
* THAN THE LEFT ARGUMENT ITSELF, SINCE THE LEFT ARGUMENT
* MAY BE POINTED TO BY SOME OTHER VARIABLE VALUE.
*
* ACCORDINGLY, IT IS NECESSARY TO COPY THE LEFT ARGUMENT.
* THIS IS NOT A TRIVIAL PROCESS SINCE WE MUST AVOID COPYING
* NODES MORE THAN ONCE AND THE PATTERN IS A GRAPH STRUCTURE
* THE FOLLOWING ALGORITHM IS EMPLOYED.
*
* THE STACK IS USED TO STORE A LIST OF NODES WHICH
* HAVE ALREADY BEEN COPIED. THE FORMAT OF THE ENTRIES ON
* THIS LIST CONSISTS OF A TWO WORD BLOCK. THE FIRST WORD
* IS THE OLD ADDRESS AND THE SECOND WORD IS THE ADDRESS
* OF THE COPY. THIS LIST IS SEARCHED BY THE PCOPY
* ROUTINE TO AVOID MAKING DUPLICATE COPIES. A TRICK IS
* USED TO ACCOMPLISH THE CONCATENATION AT THE SAME TIME.
* A SPECIAL ENTRY IS MADE TO START WITH ON THE STACK. THIS
* ENTRY RECORDS THAT THE NOTHEN NODE HAS BEEN COPIED
* ALREADY AND THE ADDRESS OF ITS COPY IS THE RIGHT PATTERN.
* THIS AUTOMATICALLY PERFORMS THE CORRECT REPLACEMENTS.
*
{PCONC{PRC{E{0{{ENTRY POINT
{{ZER{-(SP){{{MAKE ROOM FOR ONE ENTRY AT BOTTOM
{{MOV{SP{R8{{STORE POINTER TO START OF LIST
{{MOV{#NDNTH{-(SP){{STACK NOTHEN NODE AS OLD NODE
{{MOV{R10{-(SP){{STORE RIGHT ARG AS COPY OF NOTHEN
{{MOV{SP{R10{{INITIALIZE POINTER TO STACK ENTRIES
{{JSR{PCOPY{{{COPY FIRST NODE OF LEFT ARG
{{MOV{R6{4*2(R10){{STORE AS RESULT UNDER LIST
{{EJC{{{{
*
* PCONC (CONTINUED)
*
* THE FOLLOWING LOOP SCANS ENTRIES IN THE LIST AND MAKES
* SURE THAT THEIR SUCCESSORS HAVE BEEN COPIED.
*
{PCNC1{BEQ{R10{SP{PCNC2{JUMP IF ALL ENTRIES PROCESSED
{{MOV{-(R10){R9{{ELSE LOAD NEXT OLD ADDRESS
{{MOV{4*PTHEN(R9){R9{{LOAD POINTER TO SUCCESSOR
{{JSR{PCOPY{{{COPY SUCCESSOR NODE
{{MOV{-(R10){R9{{LOAD POINTER TO NEW NODE (COPY)
{{MOV{R6{4*PTHEN(R9){{STORE PTR TO NEW SUCCESSOR
*
* NOW CHECK FOR SPECIAL CASE OF ALTERNATION NODE WHERE
* PARM1 POINTS TO A NODE AND MUST BE COPIED LIKE PTHEN.
*
{{BNE{(R9){#P$ALT{PCNC1{LOOP BACK IF NOT
{{MOV{4*PARM1(R9){R9{{ELSE LOAD POINTER TO ALTERNATIVE
{{JSR{PCOPY{{{COPY IT
{{MOV{(R10){R9{{RESTORE PTR TO NEW NODE
{{MOV{R6{4*PARM1(R9){{STORE PTR TO COPIED ALTERNATIVE
{{BRN{PCNC1{{{LOOP BACK FOR NEXT ENTRY
*
* HERE AT END OF COPY PROCESS
*
{PCNC2{MOV{R8{SP{{RESTORE STACK POINTER
{{MOV{(SP)+{R9{{LOAD POINTER TO COPY
{{EXI{{{{RETURN TO PCONC CALLER
{{ENP{{{{END PROCEDURE PCONC
{{EJC{{{{
*
* PCOPY -- COPY A PATTERN NODE
*
* PCOPY IS CALLED FROM THE PCONC PROCEDURE TO COPY A SINGLE
* PATTERN NODE. THE COPY IS ONLY CARRIED OUT IF THE NODE
* HAS NOT BEEN COPIED ALREADY.
*
* (XR) POINTER TO NODE TO BE COPIED
* (XT) PTR TO CURRENT LOC IN COPY LIST
* (WC) POINTER TO LIST OF COPIED NODES
* JSR PCOPY CALL TO COPY A NODE
* (WA) POINTER TO COPY
* (WB,XR) DESTROYED
*
{PCOPY{PRC{N{0{{ENTRY POINT
{{MOV{R10{R7{{SAVE XT
{{MOV{R8{R10{{POINT TO START OF LIST
*
* LOOP TO SEARCH LIST OF NODES COPIED ALREADY
*
{PCOP1{DCA{R10{{{POINT TO NEXT ENTRY ON LIST
{{BEQ{R9{(R10){PCOP2{JUMP IF MATCH
{{DCA{R10{{{ELSE SKIP OVER COPIED ADDRESS
{{BNE{R10{SP{PCOP1{LOOP BACK IF MORE TO TEST
*
* HERE IF NOT IN LIST, PERFORM COPY
*
{{MOV{(R9){R6{{LOAD FIRST WORD OF BLOCK
{{JSR{BLKLN{{{GET LENGTH OF BLOCK
{{MOV{R9{R10{{SAVE POINTER TO OLD NODE
{{JSR{ALLOC{{{ALLOCATE SPACE FOR COPY
{{MOV{R10{-(SP){{STORE OLD ADDRESS ON LIST
{{MOV{R9{-(SP){{STORE NEW ADDRESS ON LIST
{{CHK{{{{CHECK FOR STACK OVERFLOW
{{MVW{{{{MOVE WORDS FROM OLD BLOCK TO COPY
{{MOV{(SP){R6{{LOAD POINTER TO COPY
{{BRN{PCOP3{{{JUMP TO EXIT
*
* HERE IF WE FIND ENTRY IN LIST
*
{PCOP2{MOV{-(R10){R6{{LOAD ADDRESS OF COPY FROM LIST
*
* COMMON EXIT POINT
*
{PCOP3{MOV{R7{R10{{RESTORE XT
{{EXI{{{{RETURN TO PCOPY CALLER
{{ENP{{{{END PROCEDURE PCOPY
{{EJC{{{{
*
* PRFLR -- PRINT PROFILE
* PRFLR IS CALLED TO PRINT THE CONTENTS OF THE PROFILE
* TABLE IN A FAIRLY READABLE TABULAR FORMAT.
*
* JSR PRFLR CALL TO PRINT PROFILE
* (WA,IA) DESTROYED
*
{PRFLR{PRC{E{0{{
{{BZE{PFDMP{PRFL4{{NO PRINTING IF NO PROFILING DONE
{{MOV{R9{-(SP){{PRESERVE ENTRY XR
{{MOV{R7{PFSVW{{AND ALSO WB
{{JSR{PRTPG{{{EJECT
{{MOV{#PFMS1{R9{{LOAD MSG /PROGRAM PROFILE/
{{JSR{PRTST{{{AND PRINT IT
{{JSR{PRTNL{{{FOLLOWED BY NEWLINE
{{JSR{PRTNL{{{AND ANOTHER
{{MOV{#PFMS2{R9{{POINT TO FIRST HDR
{{JSR{PRTST{{{PRINT IT
{{JSR{PRTNL{{{NEW LINE
{{MOV{#PFMS3{R9{{SECOND HDR
{{JSR{PRTST{{{PRINT IT
{{JSR{PRTNL{{{NEW LINE
{{JSR{PRTNL{{{AND ANOTHER BLANK LINE
{{ZER{R7{{{INITIAL STMT COUNT
{{MOV{PFTBL{R9{{POINT TO TABLE ORIGIN
{{ADD{#4*NUM02{R9{{BIAS PAST XNBLK HEADER (SGD07)
*
* LOOP HERE TO PRINT SUCCESSIVE ENTRIES
*
{PRFL1{ICV{R7{{{BUMP STMT NR
{{LDI{(R9){{{LOAD NR OF EXECUTIONS
{{IEQ{PRFL3{{{NO PRINTING IF ZERO
{{MOV{#PFPD1{PROFS{{POINT WHERE TO PRINT
{{JSR{PRTIN{{{AND PRINT IT
{{ZER{PROFS{{{BACK TO START OF LINE
{{MTI{R7{{{LOAD STMT NR
{{JSR{PRTIN{{{PRINT IT THERE
{{MOV{#PFPD2{PROFS{{AND PAD PAST COUNT
{{LDI{4*CFP$I(R9){{{LOAD TOTAL EXEC TIME
{{JSR{PRTIN{{{PRINT THAT TOO
{{LDI{4*CFP$I(R9){{{RELOAD TIME
{{MLI{INTTH{{{CONVERT TO MICROSEC
{{IOV{PRFL2{{{OMIT NEXT BIT IF OVERFLOW
{{DVI{(R9){{{DIVIDE BY EXECUTIONS
{{MOV{#PFPD3{PROFS{{PAD LAST PRINT
{{JSR{PRTIN{{{AND PRINT MCSEC/EXECN
*
* MERGE AFTER PRINTING TIME
*
{PRFL2{JSR{PRTNL{{{THATS ANOTHER LINE
*
* HERE TO GO TO NEXT ENTRY
*
{PRFL3{ADD{#4*PF$I2{R9{{BUMP INDEX PTR (SGD07)
{{BLT{R7{PFNTE{PRFL1{LOOP IF MORE STMTS
{{MOV{(SP)+{R9{{RESTORE CALLERS XR
{{MOV{PFSVW{R7{{AND WB TOO
*
* HERE TO EXIT
*
{PRFL4{EXI{{{{RETURN
{{ENP{{{{END OF PRFLR
{{EJC{{{{
*
* PRFLU -- UPDATE AN ENTRY IN THE PROFILE TABLE
*
* ON ENTRY, KVSTN CONTAINS NR OF STMT TO PROFILE
*
* JSR PRFLU CALL TO UPDATE ENTRY
* (IA) DESTROYED
*
{PRFLU{PRC{E{0{{
{{BNZ{PFFNC{PFLU4{{SKIP IF JUST ENTERED FUNCTION
{{MOV{R9{-(SP){{PRESERVE ENTRY XR
{{MOV{R6{PFSVW{{SAVE WA (SGD07)
{{BNZ{PFTBL{PFLU2{{BRANCH IF TABLE ALLOCATED
*
* HERE IF SPACE FOR PROFILE TABLE NOT YET ALLOCATED.
* CALCULATE SIZE NEEDED, ALLOCATE A STATIC XNBLK, AND
* INITIALIZE IT ALL TO ZERO.
* THE TIME TAKEN FOR THIS WILL BE ATTRIBUTED TO THE CURRENT
* STATEMENT (ASSIGNMENT TO KEYWD PROFILE), BUT SINCE THE
* TIMING FOR THIS STATEMENT IS UP THE POLE ANYWAY, THIS
* DOESNT REALLY MATTER...
*
{{SUB{#NUM01{PFNTE{{ADJUST FOR EXTRA COUNT (SGD07)
{{MTI{PFI2A{{{CONVRT ENTRY SIZE TO INT
{{STI{PFSTE{{{AND STORE SAFELY FOR LATER
{{MTI{PFNTE{{{LOAD TABLE LENGTH AS INTEGER
{{MLI{PFSTE{{{MULTIPLY BY ENTRY SIZE
{{MFI{R6{{{GET BACK ADDRESS-STYLE
{{ADD{#NUM02{R6{{ADD ON 2 WORD OVERHEAD
{{WTB{R6{{{CONVERT THE WHOLE LOT TO BYTES
{{JSR{ALOST{{{GIMME THE SPACE
{{MOV{R9{PFTBL{{SAVE BLOCK POINTER
{{MOV{#B$XNT{(R9)+{{PUT BLOCK TYPE AND ...
{{MOV{R6{(R9)+{{... LENGTH INTO HEADER
{{MFI{R6{{{GET BACK NR OF WDS IN DATA AREA
{{LCT{R6{R6{{LOAD THE COUNTER
*
* LOOP HERE TO ZERO THE BLOCK DATA
*
{PFLU1{ZER{(R9)+{{{BLANK A WORD
{{BCT{R6{PFLU1{{AND ALLLLLLL THE REST
*
* END OF ALLOCATION. MERGE BACK INTO ROUTINE
*
{PFLU2{MTI{KVSTN{{{LOAD NR OF STMT JUST ENDED
{{SBI{INTV1{{{MAKE INTO INDEX OFFSET
{{MLI{PFSTE{{{MAKE OFFSET OF TABLE ENTRY
{{MFI{R6{{{CONVERT TO ADDRESS
{{WTB{R6{{{GET AS BAUS
{{ADD{#4*NUM02{R6{{OFFSET INCLUDES TABLE HEADER
{{MOV{PFTBL{R9{{GET TABLE START
{{BGE{R6{4*NUM01(R9){PFLU3{IF OUT OF TABLE, SKIP IT
{{ADD{R6{R9{{ELSE POINT TO ENTRY
{{LDI{(R9){{{GET NR OF EXECUTIONS SO FAR
{{ADI{INTV1{{{NUDGE UP ONE
{{STI{(R9){{{AND PUT BACK
{{JSR{SYSTM{{{GET TIME NOW
{{STI{PFETM{{{STASH ENDING TIME
{{SBI{PFSTM{{{SUBTRACT START TIME
{{ADI{4*CFP$I(R9){{{ADD CUMULATIVE TIME SO FAR
{{STI{4*CFP$I(R9){{{AND PUT BACK NEW TOTAL
{{LDI{PFETM{{{LOAD END TIME OF THIS STMT ...
{{STI{PFSTM{{{... WHICH IS START TIME OF NEXT
*
* MERGE HERE TO EXIT
*
{PFLU3{MOV{(SP)+{R9{{RESTORE CALLERS XR
{{MOV{PFSVW{R6{{RESTORE SAVED REG
{{EXI{{{{AND RETURN
*
* HERE IF PROFILE IS SUPPRESSED BECAUSE A PROGRAM DEFINED
* FUNCTION IS ABOUT TO BE ENTERED, AND SO THE CURRENT STMT
* HAS NOT YET FINISHED
*
{PFLU4{ZER{PFFNC{{{RESET THE CONDITION FLAG
{{EXI{{{{AND IMMEDIATE RETURN
{{ENP{{{{END OF PROCEDURE PRFLU
{{EJC{{{{
*
* PRPAR - PROCESS PRINT PARAMETERS
*
* (WC) IF NONZERO ASSOCIATE TERMINAL ONLY
* JSR PRPAR CALL TO PROCESS PRINT PARAMETERS
* (XL,XR,WA,WB,WC) DESTROYED
*
* SINCE MEMORY ALLOCATION IS UNDECIDED ON INITIAL CALL,
* TERMINAL CANNOT BE ASSOCIATED. THE ENTRY WITH WC NON-ZERO
* IS PROVIDED SO A LATER CALL CAN BE MADE TO COMPLETE THIS.
*
{PRPAR{PRC{E{0{{ENTRY POINT
{{BNZ{R8{PRPA7{{JUMP TO ASSOCIATE TERMINAL
{{JSR{SYSPP{{{GET PRINT PARAMETERS
{{BNZ{R7{PRPA1{{JUMP IF LINES/PAGE SPECIFIED
{{MOV{#CFP$M{R7{{ELSE USE A LARGE VALUE
{{RSH{R7{1{{BUT NOT TOO LARGE
*
* STORE LINE COUNT/PAGE
*
{PRPA1{MOV{R7{LSTNP{{STORE NUMBER OF LINES/PAGE
{{MOV{R7{LSTLC{{PRETEND PAGE IS FULL INITIALLY
{{ZER{LSTPG{{{CLEAR PAGE NUMBER
{{MOV{PRLEN{R7{{GET PRIOR LENGTH IF ANY
{{BZE{R7{PRPA2{{SKIP IF NO LENGTH
{{BGT{R6{R7{PRPA3{SKIP STORING IF TOO BIG
*
* STORE PRINT BUFFER LENGTH
*
{PRPA2{MOV{R6{PRLEN{{STORE VALUE
*
* PROCESS BITS OPTIONS
*
{PRPA3{MOV{BITS3{R7{{BIT 3 MASK
{{ANB{R8{R7{{GET -NOLIST BIT
{{ZRB{R7{PRPA4{{SKIP IF CLEAR
{{ZER{CSWLS{{{SET -NOLIST
*
* CHECK IF FAIL REPORTS GOTO INTERACTIVE CHANNEL
*
{PRPA4{MOV{BITS1{R7{{BIT 1 MASK
{{ANB{R8{R7{{GET BIT
{{MOV{R7{ERICH{{STORE INT. CHAN. ERROR FLAG
{{MOV{BITS2{R7{{BIT 2 MASK
{{ANB{R8{R7{{GET BIT
{{MOV{R7{PRICH{{FLAG FOR STD PRINTER ON INT. CHAN.
{{MOV{BITS4{R7{{BIT 4 MASK
{{ANB{R8{R7{{GET BIT
{{MOV{R7{CPSTS{{FLAG FOR COMPILE STATS SUPPRESSN.
{{MOV{BITS5{R7{{BIT 5 MASK
{{ANB{R8{R7{{GET BIT
{{MOV{R7{EXSTS{{FLAG FOR EXEC STATS SUPPRESSION
{{EJC{{{{
*
* PRPAR (CONTINUED)
*
{{MOV{BITS6{R7{{BIT 6 MASK
{{ANB{R8{R7{{GET BIT
{{MOV{R7{PRECL{{EXTENDED/COMPACT LISTING FLAG
{{SUB{#NUM08{R6{{POINT 8 CHARS FROM LINE END
{{ZRB{R7{PRPA5{{JUMP IF NOT EXTENDED
{{MOV{R6{LSTPO{{STORE FOR LISTING PAGE HEADINGS
*
* CONTINUE OPTION PROCESSING
*
{PRPA5{MOV{BITS7{R7{{BIT 7 MASK
{{ANB{R8{R7{{GET BIT 7
{{MOV{R7{CSWEX{{SET -NOEXECUTE IF NON-ZERO
{{MOV{BIT10{R7{{BIT 10 MASK
{{ANB{R8{R7{{GET BIT 10
{{MOV{R7{HEADP{{PRETEND PRINTED TO OMIT HEADERS
{{MOV{BITS9{R7{{BIT 9 MASK
{{ANB{R8{R7{{GET BIT 9
{{MOV{R7{PRSTO{{KEEP IT AS STD LISTING OPTION
{{ZRB{R7{PRPA6{{SKIP IF CLEAR
{{MOV{PRLEN{R6{{GET PRINT BUFFER LENGTH
{{SUB{#NUM08{R6{{POINT 8 CHARS FROM LINE END
{{MOV{R6{LSTPO{{STORE PAGE OFFSET
*
* CHECK FOR TERMINAL
*
{PRPA6{ANB{BITS8{R8{{SEE IF TERMINAL TO BE ACTIVATED
{{BNZ{R8{PRPA7{{JUMP IF TERMINAL REQUIRED
{{BZE{INITR{PRPA8{{JUMP IF NO TERMINAL TO DETACH
{{MOV{#V$TER{R10{{PTR TO /TERMINAL/
{{JSR{GTNVR{{{GET VRBLK POINTER
{{PPM{{{{CANT FAIL
{{MOV{#NULLS{4*VRVAL(R9){{CLEAR VALUE OF TERMINAL
{{JSR{SETVR{{{REMOVE ASSOCIATION
{{BRN{PRPA8{{{RETURN
*
* ASSOCIATE TERMINAL
*
{PRPA7{MNZ{INITR{{{NOTE TERMINAL ASSOCIATED
{{BZE{DNAMB{PRPA8{{CANT IF MEMORY NOT ORGANISED
{{MOV{#V$TER{R10{{POINT TO TERMINAL STRING
{{MOV{#TRTOU{R7{{OUTPUT TRACE TYPE
{{JSR{INOUT{{{ATTACH OUTPUT TRBLK TO VRBLK
{{MOV{R9{-(SP){{STACK TRBLK PTR
{{MOV{#V$TER{R10{{POINT TO TERMINAL STRING
{{MOV{#TRTIN{R7{{INPUT TRACE TYPE
{{JSR{INOUT{{{ATTACH INPUT TRACE BLK
{{MOV{(SP)+{4*VRVAL(R9){{ADD OUTPUT TRBLK TO CHAIN
*
* RETURN POINT
*
{PRPA8{EXI{{{{RETURN
{{ENP{{{{END PROCEDURE PRPAR
{{EJC{{{{
*
* PRTCH -- PRINT A CHARACTER
*
* PRTCH IS USED TO PRINT A SINGLE CHARACTER
*
* (WA) CHARACTER TO BE PRINTED
* JSR PRTCH CALL TO PRINT CHARACTER
*
{PRTCH{PRC{E{0{{ENTRY POINT
{{MOV{R9{-(SP){{SAVE XR
{{BNE{PROFS{PRLEN{PRCH1{JUMP IF ROOM IN BUFFER
{{JSR{PRTNL{{{ELSE PRINT THIS LINE
*
* HERE AFTER MAKING SURE WE HAVE ROOM
*
{PRCH1{MOV{PRBUF{R9{{POINT TO PRINT BUFFER
{{PSC{R9{PROFS{{POINT TO NEXT CHARACTER LOCATION
{{SCH{R6{(R9){{STORE NEW CHARACTER
{{CSC{R9{{{COMPLETE STORE CHARACTERS
{{ICV{PROFS{{{BUMP POINTER
{{MOV{(SP)+{R9{{RESTORE ENTRY XR
{{EXI{{{{RETURN TO PRTCH CALLER
{{ENP{{{{END PROCEDURE PRTCH
{{EJC{{{{
*
* PRTIC -- PRINT TO INTERACTIVE CHANNEL
*
* PRTIC IS CALLED TO PRINT THE CONTENTS OF THE STANDARD
* PRINT BUFFER TO THE INTERACTIVE CHANNEL. IT IS ONLY
* CALLED AFTER PRTST HAS SET UP THE STRING FOR PRINTING.
* IT DOES NOT CLEAR THE BUFFER.
*
* JSR PRTIC CALL FOR PRINT
* (WA,WB) DESTROYED
*
{PRTIC{PRC{E{0{{ENTRY POINT
{{MOV{R9{-(SP){{SAVE XR
{{MOV{PRBUF{R9{{POINT TO BUFFER
{{MOV{PROFS{R6{{NO OF CHARS
{{JSR{SYSPI{{{PRINT
{{PPM{PRTC2{{{FAIL RETURN
*
* RETURN
*
{PRTC1{MOV{(SP)+{R9{{RESTORE XR
{{EXI{{{{RETURN
*
* ERROR OCCURED
*
{PRTC2{ZER{ERICH{{{PREVENT LOOPING
{{ERB{252{ERROR{{ON PRINTING TO INTERACTIVE CHANNEL
{{BRN{PRTC1{{{RETURN
{{ENP{{{{PROCEDURE PRTIC
{{EJC{{{{
*
* PRTIS -- PRINT TO INTERACTIVE AND STANDARD PRINTER
*
* PRTIS PUTS A LINE FROM THE PRINT BUFFER ONTO THE
* INTERACTIVE CHANNEL (IF ANY) AND THE STANDARD PRINTER.
* IT ALWAYS PRINTS TO THE STANDARD PRINTER BUT DOES
* NOT DUPLICATE LINES IF THE STANDARD PRINTER IS
* INTERACTIVE. IT CLEARS DOWN THE PRINT BUFFER.
*
* JSR PRTIS CALL FOR PRINTING
* (WA,WB) DESTROYED
*
{PRTIS{PRC{E{0{{ENTRY POINT
{{BNZ{PRICH{PRTS1{{JUMP IF STANDARD PRINTER IS INT.CH.
{{BZE{ERICH{PRTS1{{SKIP IF NOT DOING INT. ERROR REPS.
{{JSR{PRTIC{{{PRINT TO INTERACTIVE CHANNEL
*
* MERGE AND EXIT
*
{PRTS1{JSR{PRTNL{{{PRINT TO STANDARD PRINTER
{{EXI{{{{RETURN
{{ENP{{{{END PROCEDURE PRTIS
{{EJC{{{{
*
* PRTIN -- PRINT AN INTEGER
*
* PRTIN PRINTS THE INTEGER VALUE WHICH IS IN THE INTEGER
* ACCUMULATOR. BLOCKS BUILT IN DYNAMIC STORAGE
* DURING THIS PROCESS ARE IMMEDIATELY DELETED.
*
* (IA) INTEGER VALUE TO BE PRINTED
* JSR PRTIN CALL TO PRINT INTEGER
* (IA,RA) DESTROYED
*
{PRTIN{PRC{E{0{{ENTRY POINT
{{MOV{R9{-(SP){{SAVE XR
{{JSR{ICBLD{{{BUILD INTEGER BLOCK
{{BLO{R9{DNAMB{PRTI1{JUMP IF ICBLK BELOW DYNAMIC
{{BHI{R9{DNAMP{PRTI1{JUMP IF ABOVE DYNAMIC
{{MOV{R9{DNAMP{{IMMEDIATELY DELETE IT
*
* DELETE ICBLK FROM DYNAMIC STORE
*
{PRTI1{MOV{R9{-(SP){{STACK PTR FOR GTSTG
{{JSR{GTSTG{{{CONVERT TO STRING
{{PPM{{{{CONVERT ERROR IS IMPOSSIBLE
{{MOV{R9{DNAMP{{RESET POINTER TO DELETE SCBLK
{{JSR{PRTST{{{PRINT INTEGER STRING
{{MOV{(SP)+{R9{{RESTORE ENTRY XR
{{EXI{{{{RETURN TO PRTIN CALLER
{{ENP{{{{END PROCEDURE PRTIN
{{EJC{{{{
*
* PRTMI -- PRINT MESSAGE AND INTEGER
*
* PRTMI IS USED TO PRINT MESSAGES TOGETHER WITH AN INTEGER
* VALUE STARTING IN COLUMN 15 (USED BY THE ROUTINES AT
* THE END OF COMPILATION).
*
* JSR PRTMI CALL TO PRINT MESSAGE AND INTEGER
*
{PRTMI{PRC{E{0{{ENTRY POINT
{{JSR{PRTST{{{PRINT STRING MESSAGE
{{MOV{#PRTMF{PROFS{{SET OFFSET TO COL 15
{{JSR{PRTIN{{{PRINT INTEGER
{{JSR{PRTNL{{{PRINT LINE
{{EXI{{{{RETURN TO PRTMI CALLER
{{ENP{{{{END PROCEDURE PRTMI
{{EJC{{{{
*
* PRTMX -- AS PRTMI WITH EXTRA COPY TO INTERACTIVE CHAN.
*
* JSR PRTMX CALL FOR PRINTING
* (WA,WB) DESTROYED
*
{PRTMX{PRC{E{0{{ENTRY POINT
{{JSR{PRTST{{{PRINT STRING MESSAGE
{{MOV{#PRTMF{PROFS{{SET PTR TO COLUMN 15
{{JSR{PRTIN{{{PRINT INTEGER
{{JSR{PRTIS{{{PRINT LINE
{{EXI{{{{RETURN
{{ENP{{{{END PROCEDURE PRTMX
{{EJC{{{{
*
* PRTNL -- PRINT NEW LINE (END PRINT LINE)
*
* PRTNL PRINTS THE CONTENTS OF THE PRINT BUFFER, RESETS
* THE BUFFER TO ALL BLANKS AND RESETS THE PRINT POINTER.
*
* JSR PRTNL CALL TO PRINT LINE
*
{PRTNL{PRC{R{0{{ENTRY POINT
{{BNZ{HEADP{PRNL0{{WERE HEADERS PRINTED
{{JSR{PRTPS{{{NO - PRINT THEM
*
* CALL SYSPR
*
{PRNL0{MOV{R9{-(SP){{SAVE ENTRY XR
{{MOV{R6{PRTSA{{SAVE WA
{{MOV{R7{PRTSB{{SAVE WB
{{MOV{PRBUF{R9{{LOAD POINTER TO BUFFER
{{MOV{PROFS{R6{{LOAD NUMBER OF CHARS IN BUFFER
{{JSR{SYSPR{{{CALL SYSTEM PRINT ROUTINE
{{PPM{PRNL2{{{JUMP IF FAILED
{{LCT{R6{PRLNW{{LOAD LENGTH OF BUFFER IN WORDS
{{ADD{#4*SCHAR{R9{{POINT TO CHARS OF BUFFER
{{MOV{NULLW{R7{{GET WORD OF BLANKS
*
* LOOP TO BLANK BUFFER
*
{PRNL1{MOV{R7{(R9)+{{STORE WORD OF BLANKS, BUMP PTR
{{BCT{R6{PRNL1{{LOOP TILL ALL BLANKED
*
* EXIT POINT
*
{{MOV{PRTSB{R7{{RESTORE WB
{{MOV{PRTSA{R6{{RESTORE WA
{{MOV{(SP)+{R9{{RESTORE ENTRY XR
{{ZER{PROFS{{{RESET PRINT BUFFER POINTER
{{EXI{{{{RETURN TO PRTNL CALLER
*
* FILE FULL OR NO OUTPUT FILE FOR LOAD MODULE
*
{PRNL2{BNZ{PRTEF{PRNL3{{JUMP IF NOT FIRST TIME
{{MNZ{PRTEF{{{MARK FIRST OCCURRENCE
{{ERB{253{PRINT{{LIMIT EXCEEDED ON STANDARD OUTPUT CHANNEL
*
* STOP AT ONCE
*
{PRNL3{MOV{#NINI8{R7{{ENDING CODE
{{MOV{KVSTN{R6{{STATEMENT NUMBER
{{JSR{SYSEJ{{{STOP
{{ENP{{{{END PROCEDURE PRTNL
{{EJC{{{{
*
* PRTNM -- PRINT VARIABLE NAME
*
* PRTNM IS USED TO PRINT A CHARACTER REPRESENTATION OF THE
* NAME OF A VARIABLE (NOT A VALUE OF DATATYPE NAME)
* NAMES OF PSEUDO-VARIABLES MAY NOT BE PASSED TO PRTNM.
*
* (XL) NAME BASE
* (WA) NAME OFFSET
* JSR PRTNM CALL TO PRINT NAME
* (WB,WC,RA) DESTROYED
*
{PRTNM{PRC{R{0{{ENTRY POINT (RECURSIVE, SEE PRTVL)
{{MOV{R6{-(SP){{SAVE WA (OFFSET IS COLLECTABLE)
{{MOV{R9{-(SP){{SAVE ENTRY XR
{{MOV{R10{-(SP){{SAVE NAME BASE
{{BHI{R10{STATE{PRN02{JUMP IF NOT NATURAL VARIABLE
*
* HERE FOR NATURAL VARIABLE NAME, RECOGNIZED BY THE FACT
* THAT THE NAME BASE POINTS INTO THE STATIC AREA.
*
{{MOV{R10{R9{{POINT TO VRBLK
{{JSR{PRTVN{{{PRINT NAME OF VARIABLE
*
* COMMON EXIT POINT
*
{PRN01{MOV{(SP)+{R10{{RESTORE NAME BASE
{{MOV{(SP)+{R9{{RESTORE ENTRY VALUE OF XR
{{MOV{(SP)+{R6{{RESTORE WA
{{EXI{{{{RETURN TO PRTNM CALLER
*
* HERE FOR CASE OF NON-NATURAL VARIABLE
*
{PRN02{MOV{R6{R7{{COPY NAME OFFSET
{{BNE{(R10){#B$PDT{PRN03{JUMP IF ARRAY OR TABLE
*
* FOR PROGRAM DEFINED DATATYPE, PRT FLD NAME, LEFT PAREN
*
{{MOV{4*PDDFP(R10){R9{{LOAD POINTER TO DFBLK
{{ADD{R6{R9{{ADD NAME OFFSET
{{MOV{4*PDFOF(R9){R9{{LOAD VRBLK POINTER FOR FIELD
{{JSR{PRTVN{{{PRINT FIELD NAME
{{MOV{#CH$PP{R6{{LOAD LEFT PAREN
{{JSR{PRTCH{{{PRINT CHARACTER
{{EJC{{{{
*
* PRTNM (CONTINUED)
*
* NOW WE PRINT AN IDENTIFYING NAME FOR THE OBJECT IF ONE
* CAN BE FOUND. THE FOLLOWING CODE SEARCHES FOR A NATURAL
* VARIABLE WHICH CONTAINS THIS OBJECT AS VALUE. IF SUCH A
* VARIABLE IS FOUND, ITS NAME IS PRINTED, ELSE THE VALUE
* OF THE OBJECT (AS PRINTED BY PRTVL) IS USED INSTEAD.
*
* FIRST WE POINT TO THE PARENT TBBLK IF THIS IS THE CASE OF
* A TABLE ELEMENT. TO DO THIS, CHASE DOWN THE TRNXT CHAIN.
*
{PRN03{BNE{(R10){#B$TET{PRN04{JUMP IF WE GOT THERE (OR NOT TE)
{{MOV{4*TENXT(R10){R10{{ELSE MOVE OUT ON CHAIN
{{BRN{PRN03{{{AND LOOP BACK
*
* NOW WE ARE READY FOR THE SEARCH. TO SPEED THINGS UP IN
* THE CASE OF CALLS FROM DUMP WHERE THE SAME NAME BASE
* WILL OCCUR REPEATEDLY WHILE DUMPING AN ARRAY OR TABLE,
* WE REMEMBER THE LAST VRBLK POINTER FOUND IN PRNMV. SO
* FIRST CHECK TO SEE IF WE HAVE THIS ONE AGAIN.
*
{PRN04{MOV{PRNMV{R9{{POINT TO VRBLK WE FOUND LAST TIME
{{MOV{HSHTB{R6{{POINT TO HASH TABLE IN CASE NOT
{{BRN{PRN07{{{JUMP INTO SEARCH FOR SPECIAL CHECK
*
* LOOP THROUGH HASH SLOTS
*
{PRN05{MOV{R6{R9{{COPY SLOT POINTER
{{ICA{R6{{{BUMP SLOT POINTER
{{SUB{#4*VRNXT{R9{{INTRODUCE STANDARD VRBLK OFFSET
*
* LOOP THROUGH VRBLKS ON ONE HASH CHAIN
*
{PRN06{MOV{4*VRNXT(R9){R9{{POINT TO NEXT VRBLK ON HASH CHAIN
*
* MERGE HERE FIRST TIME TO CHECK BLOCK WE FOUND LAST TIME
*
{PRN07{MOV{R9{R8{{COPY VRBLK POINTER
{{BZE{R8{PRN09{{JUMP IF CHAIN END (OR PRNMV ZERO)
{{EJC{{{{
*
* PRTNM (CONTINUED)
*
* LOOP TO FIND VALUE (CHASE DOWN POSSIBLE TRBLK CHAIN)
*
{PRN08{MOV{4*VRVAL(R9){R9{{LOAD VALUE
{{BEQ{(R9){#B$TRT{PRN08{LOOP IF THAT WAS A TRBLK
*
* NOW WE HAVE THE VALUE, IS THIS THE BLOCK WE WANT
*
{{BEQ{R9{R10{PRN10{JUMP IF THIS MATCHES THE NAME BASE
{{MOV{R8{R9{{ELSE POINT BACK TO THAT VRBLK
{{BRN{PRN06{{{AND LOOP BACK
*
* HERE TO MOVE TO NEXT HASH SLOT
*
{PRN09{BLT{R6{HSHTE{PRN05{LOOP BACK IF MORE TO GO
{{MOV{R10{R9{{ELSE NOT FOUND, COPY VALUE POINTER
{{JSR{PRTVL{{{PRINT VALUE
{{BRN{PRN11{{{AND MERGE AHEAD
*
* HERE WHEN WE FIND A MATCHING ENTRY
*
{PRN10{MOV{R8{R9{{COPY VRBLK POINTER
{{MOV{R9{PRNMV{{SAVE FOR NEXT TIME IN
{{JSR{PRTVN{{{PRINT VARIABLE NAME
*
* MERGE HERE IF NO ENTRY FOUND
*
{PRN11{MOV{(R10){R8{{LOAD FIRST WORD OF NAME BASE
{{BNE{R8{#B$PDT{PRN13{JUMP IF NOT PROGRAM DEFINED
*
* FOR PROGRAM DEFINED DATATYPE, ADD RIGHT PAREN AND EXIT
*
{{MOV{#CH$RP{R6{{LOAD RIGHT PAREN, MERGE
*
* MERGE HERE TO PRINT FINAL RIGHT PAREN OR BRACKET
*
{PRN12{JSR{PRTCH{{{PRINT FINAL CHARACTER
{{MOV{R7{R6{{RESTORE NAME OFFSET
{{BRN{PRN01{{{MERGE BACK TO EXIT
{{EJC{{{{
*
* PRTNM (CONTINUED)
*
* HERE FOR ARRAY OR TABLE
*
{PRN13{MOV{#CH$BB{R6{{LOAD LEFT BRACKET
{{JSR{PRTCH{{{AND PRINT IT
{{MOV{(SP){R10{{RESTORE BLOCK POINTER
{{MOV{(R10){R8{{LOAD TYPE WORD AGAIN
{{BNE{R8{#B$TET{PRN15{JUMP IF NOT TABLE
*
* HERE FOR TABLE, PRINT SUBSCRIPT VALUE
*
{{MOV{4*TESUB(R10){R9{{LOAD SUBSCRIPT VALUE
{{MOV{R7{R10{{SAVE NAME OFFSET
{{JSR{PRTVL{{{PRINT SUBSCRIPT VALUE
{{MOV{R10{R7{{RESTORE NAME OFFSET
*
* MERGE HERE FROM ARRAY CASE TO PRINT RIGHT BRACKET
*
{PRN14{MOV{#CH$RB{R6{{LOAD RIGHT BRACKET
{{BRN{PRN12{{{MERGE BACK TO PRINT IT
*
* HERE FOR ARRAY OR VECTOR, TO PRINT SUBSCRIPT(S)
*
{PRN15{MOV{R7{R6{{COPY NAME OFFSET
{{BTW{R6{{{CONVERT TO WORDS
{{BEQ{R8{#B$ART{PRN16{JUMP IF ARBLK
*
* HERE FOR VECTOR
*
{{SUB{#VCVLB{R6{{ADJUST FOR STANDARD FIELDS
{{MTI{R6{{{MOVE TO INTEGER ACCUM
{{JSR{PRTIN{{{PRINT LINEAR SUBSCRIPT
{{BRN{PRN14{{{MERGE BACK FOR RIGHT BRACKET
{{EJC{{{{
*
* PRTNM (CONTINUED)
*
* HERE FOR ARRAY. FIRST CALCULATE ABSOLUTE SUBSCRIPT
* OFFSETS BY SUCCESSIVE DIVISIONS BY THE DIMENSION VALUES.
* THIS MUST BE DONE RIGHT TO LEFT SINCE THE ELEMENTS ARE
* STORED ROW-WISE. THE SUBSCRIPTS ARE STACKED AS INTEGERS.
*
{PRN16{MOV{4*AROFS(R10){R8{{LOAD LENGTH OF BOUNDS INFO
{{ICA{R8{{{ADJUST FOR ARPRO FIELD
{{BTW{R8{{{CONVERT TO WORDS
{{SUB{R8{R6{{GET LINEAR ZERO-ORIGIN SUBSCRIPT
{{MTI{R6{{{GET INTEGER VALUE
{{LCT{R6{4*ARNDM(R10){{SET NUM OF DIMENSIONS AS LOOP COUNT
{{ADD{4*AROFS(R10){R10{{POINT PAST BOUNDS INFORMATION
{{SUB{#4*ARLBD{R10{{SET OK OFFSET FOR PROPER PTR LATER
*
* LOOP TO STACK SUBSCRIPT OFFSETS
*
{PRN17{SUB{#4*ARDMS{R10{{POINT TO NEXT SET OF BOUNDS
{{STI{PRNSI{{{SAVE CURRENT OFFSET
{{RMI{4*ARDIM(R10){{{GET REMAINDER ON DIVIDING BY DIMENS
{{MFI{-(SP){{{STORE ON STACK (ONE WORD)
{{LDI{PRNSI{{{RELOAD ARGUMENT
{{DVI{4*ARDIM(R10){{{DIVIDE TO GET QUOTIENT
{{BCT{R6{PRN17{{LOOP TILL ALL STACKED
{{ZER{R9{{{SET OFFSET TO FIRST SET OF BOUNDS
{{LCT{R7{4*ARNDM(R10){{LOAD COUNT OF DIMS TO CONTROL LOOP
{{BRN{PRN19{{{JUMP INTO PRINT LOOP
*
* LOOP TO PRINT SUBSCRIPTS FROM STACK ADJUSTING BY ADDING
* THE APPROPRIATE LOW BOUND VALUE FROM THE ARBLK
*
{PRN18{MOV{#CH$CM{R6{{LOAD A COMMA
{{JSR{PRTCH{{{PRINT IT
*
* MERGE HERE FIRST TIME IN (NO COMMA REQUIRED)
*
{PRN19{MTI{(SP)+{{{LOAD SUBSCRIPT OFFSET AS INTEGER
{{ADD{R9{R10{{POINT TO CURRENT LBD
{{ADI{4*ARLBD(R10){{{ADD LBD TO GET SIGNED SUBSCRIPT
{{SUB{R9{R10{{POINT BACK TO START OF ARBLK
{{JSR{PRTIN{{{PRINT SUBSCRIPT
{{ADD{#4*ARDMS{R9{{BUMP OFFSET TO NEXT BOUNDS
{{BCT{R7{PRN18{{LOOP BACK TILL ALL PRINTED
{{BRN{PRN14{{{MERGE BACK TO PRINT RIGHT BRACKET
{{ENP{{{{END PROCEDURE PRTNM
{{EJC{{{{
*
* PRTNV -- PRINT NAME VALUE
*
* PRTNV IS USED BY THE TRACE AND DUMP ROUTINES TO PRINT
* A LINE OF THE FORM
*
* NAME = VALUE
*
* NOTE THAT THE NAME INVOLVED CAN NEVER BE A PSEUDO-VAR
*
* (XL) NAME BASE
* (WA) NAME OFFSET
* JSR PRTNV CALL TO PRINT NAME = VALUE
* (WB,WC,RA) DESTROYED
*
{PRTNV{PRC{E{0{{ENTRY POINT
{{JSR{PRTNM{{{PRINT ARGUMENT NAME
{{MOV{R9{-(SP){{SAVE ENTRY XR
{{MOV{R6{-(SP){{SAVE NAME OFFSET (COLLECTABLE)
{{MOV{#TMBEB{R9{{POINT TO BLANK EQUAL BLANK
{{JSR{PRTST{{{PRINT IT
{{MOV{R10{R9{{COPY NAME BASE
{{ADD{R6{R9{{POINT TO VALUE
{{MOV{(R9){R9{{LOAD VALUE POINTER
{{JSR{PRTVL{{{PRINT VALUE
{{JSR{PRTNL{{{TERMINATE LINE
{{MOV{(SP)+{R6{{RESTORE NAME OFFSET
{{MOV{(SP)+{R9{{RESTORE ENTRY XR
{{EXI{{{{RETURN TO CALLER
{{ENP{{{{END PROCEDURE PRTNV
{{EJC{{{{
*
* PRTPG -- PRINT A PAGE THROW
*
* PRINTS A PAGE THROW OR A FEW BLANK LINES ON THE STANDARD
* LISTING CHANNEL DEPENDING ON THE LISTING OPTIONS CHOSEN.
*
* JSR PRTPG CALL FOR PAGE EJECT
*
{PRTPG{PRC{E{0{{ENTRY POINT
{{BEQ{STAGE{#STGXT{PRP01{JUMP IF EXECUTION TIME
{{BZE{LSTLC{PRP06{{RETURN IF TOP OF PAGE ALREADY
{{ZER{LSTLC{{{CLEAR LINE COUNT
*
* CHECK TYPE OF LISTING
*
{PRP01{MOV{R9{-(SP){{PRESERVE XR
{{BNZ{PRSTD{PRP02{{EJECT IF FLAG SET
{{BNZ{PRICH{PRP03{{JUMP IF INTERACTIVE LISTING CHANNEL
{{BZE{PRECL{PRP03{{JUMP IF COMPACT LISTING
*
* PERFORM AN EJECT
*
{PRP02{JSR{SYSEP{{{EJECT
{{BRN{PRP04{{{MERGE
*
* COMPACT OR INTERACTIVE CHANNEL LISTING. CANT PRINT
* BLANKS UNTIL CHECK MADE FOR HEADERS PRINTED AND FLAG SET.
*
*
{PRP03{MOV{HEADP{R9{{REMEMBER HEADP
{{MNZ{HEADP{{{SET TO AVOID REPEATED PRTPG CALLS
{{JSR{PRTNL{{{PRINT BLANK LINE
{{JSR{PRTNL{{{PRINT BLANK LINE
{{JSR{PRTNL{{{PRINT BLANK LINE
{{MOV{#NUM03{LSTLC{{COUNT BLANK LINES
{{MOV{R9{HEADP{{RESTORE HEADER FLAG
{{EJC{{{{
*
* PRPTG (CONTINUED)
*
* PRINT THE HEADING
*
{PRP04{BNZ{HEADP{PRP05{{JUMP IF HEADER LISTED
{{MNZ{HEADP{{{MARK HEADERS PRINTED
{{MOV{R10{-(SP){{KEEP XL
{{MOV{#HEADR{R9{{POINT TO LISTING HEADER
{{JSR{PRTST{{{PLACE IT
{{JSR{SYSID{{{GET SYSTEM IDENTIFICATION
{{JSR{PRTST{{{APPEND EXTRA CHARS
{{JSR{PRTNL{{{PRINT IT
{{MOV{R10{R9{{EXTRA HEADER LINE
{{JSR{PRTST{{{PLACE IT
{{JSR{PRTNL{{{PRINT IT
{{JSR{PRTNL{{{PRINT A BLANK
{{JSR{PRTNL{{{AND ANOTHER
{{ADD{#NUM04{LSTLC{{FOUR HEADER LINES PRINTED
{{MOV{(SP)+{R10{{RESTORE XL
*
* MERGE IF HEADER NOT PRINTED
*
{PRP05{MOV{(SP)+{R9{{RESTORE XR
*
* RETURN
*
{PRP06{EXI{{{{RETURN
{{ENP{{{{END PROCEDURE PRTPG
{{EJC{{{{
*
* PRTPS - PRINT PAGE WITH TEST FOR STANDARD LISTING OPTION
*
* IF THE STANDARD LISTING OPTION IS SELECTED, INSIST THAT
* AN EJECT BE DONE
*
* JSR PRTPS CALL FOR EJECT
*
{PRTPS{PRC{E{0{{ENTRY POINT
{{MOV{PRSTO{PRSTD{{COPY OPTION FLAG
{{JSR{PRTPG{{{PRINT PAGE
{{ZER{PRSTD{{{CLEAR FLAG
{{EXI{{{{RETURN
{{ENP{{{{END PROCEDURE PRTPS
{{EJC{{{{
*
* PRTSN -- PRINT STATEMENT NUMBER
*
* PRTSN IS USED TO INITIATE A PRINT TRACE LINE BY PRINTING
* ASTERISKS AND THE CURRENT STATEMENT NUMBER. THE ACTUAL
* FORMAT OF THE OUTPUT GENERATED IS.
*
* ***NNNNN**** III.....IIII
*
* NNNNN IS THE STATEMENT NUMBER WITH LEADING ZEROS REPLACED
* BY ASTERISKS (E.G. *******9****)
*
* III...III REPRESENTS A VARIABLE LENGTH OUTPUT CONSISTING
* OF A NUMBER OF LETTER I CHARACTERS EQUAL TO FNCLEVEL.
*
* JSR PRTSN CALL TO PRINT STATEMENT NUMBER
* (WC) DESTROYED
*
{PRTSN{PRC{E{0{{ENTRY POINT
{{MOV{R9{-(SP){{SAVE ENTRY XR
{{MOV{R6{PRSNA{{SAVE ENTRY WA
{{MOV{#TMASB{R9{{POINT TO ASTERISKS
{{JSR{PRTST{{{PRINT ASTERISKS
{{MOV{#NUM04{PROFS{{POINT INTO MIDDLE OF ASTERISKS
{{MTI{KVSTN{{{LOAD STATEMENT NUMBER AS INTEGER
{{JSR{PRTIN{{{PRINT INTEGER STATEMENT NUMBER
{{MOV{#PRSNF{PROFS{{POINT PAST ASTERISKS PLUS BLANK
{{MOV{KVFNC{R9{{GET FNCLEVEL
{{MOV{#CH$LI{R6{{SET LETTER I
*
* LOOP TO GENERATE LETTER I FNCLEVEL TIMES
*
{PRSN1{BZE{R9{PRSN2{{JUMP IF ALL SET
{{JSR{PRTCH{{{ELSE PRINT AN I
{{DCV{R9{{{DECREMENT COUNTER
{{BRN{PRSN1{{{LOOP BACK
*
* MERRE WITH ALL LETTER I CHARACTERS GENERATED
*
{PRSN2{MOV{#CH$BL{R6{{GET BLANK
{{JSR{PRTCH{{{PRINT BLANK
{{MOV{PRSNA{R6{{RESTORE ENTRY WA
{{MOV{(SP)+{R9{{RESTORE ENTRY XR
{{EXI{{{{RETURN TO PRTSN CALLER
{{ENP{{{{END PROCEDURE PRTSN
{{EJC{{{{
*
* PRTST -- PRINT STRING
*
* PRTST PLACES A STRING OF CHARACTERS IN THE PRINT BUFFER
*
* SEE PRTNL FOR GLOBAL LOCATIONS USED
*
* NOTE THAT THE FIRST WORD OF THE BLOCK (NORMALLY B$SCL)
* IS NOT USED AND NEED NOT BE SET CORRECTLY (SEE PRTVN)
*
* (XR) STRING TO BE PRINTED
* JSR PRTST CALL TO PRINT STRING
* (PROFS) UPDATED PAST CHARS PLACED
*
{PRTST{PRC{R{0{{ENTRY POINT
{{BNZ{HEADP{PRST0{{WERE HEADERS PRINTED
{{JSR{PRTPS{{{NO - PRINT THEM
*
* CALL SYSPR
*
{PRST0{MOV{R6{PRSVA{{SAVE WA
{{MOV{R7{PRSVB{{SAVE WB
{{ZER{R7{{{SET CHARS PRINTED COUNT TO ZERO
*
* LOOP TO PRINT SUCCESSIVE LINES FOR LONG STRING
*
{PRST1{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH
{{SUB{R7{R6{{SUBTRACT COUNT OF CHARS ALREADY OUT
{{BZE{R6{PRST4{{JUMP TO EXIT IF NONE LEFT
{{MOV{R10{-(SP){{ELSE STACK ENTRY XL
{{MOV{R9{-(SP){{SAVE ARGUMENT
{{MOV{R9{R10{{COPY FOR EVENTUAL MOVE
{{MOV{PRLEN{R9{{LOAD PRINT BUFFER LENGTH
{{SUB{PROFS{R9{{GET CHARS LEFT IN PRINT BUFFER
{{BNZ{R9{PRST2{{SKIP IF ROOM LEFT ON THIS LINE
{{JSR{PRTNL{{{ELSE PRINT THIS LINE
{{MOV{PRLEN{R9{{AND SET FULL WIDTH AVAILABLE
{{EJC{{{{
*
* PRTST (CONTINUED)
*
* HERE WITH CHARS TO PRINT AND SOME ROOM IN BUFFER
*
{PRST2{BLO{R6{R9{PRST3{JUMP IF ROOM FOR REST OF STRING
{{MOV{R9{R6{{ELSE SET TO FILL LINE
*
* MERGE HERE WITH CHARACTER COUNT IN WA
*
{PRST3{MOV{PRBUF{R9{{POINT TO PRINT BUFFER
{{PLC{R10{R7{{POINT TO LOCATION IN STRING
{{PSC{R9{PROFS{{POINT TO LOCATION IN BUFFER
{{ADD{R6{R7{{BUMP STRING CHARS COUNT
{{ADD{R6{PROFS{{BUMP BUFFER POINTER
{{MOV{R7{PRSVC{{PRESERVE CHAR COUNTER
{{MVC{{{{MOVE CHARACTERS TO BUFFER
{{MOV{PRSVC{R7{{RECOVER CHAR COUNTER
{{MOV{(SP)+{R9{{RESTORE ARGUMENT POINTER
{{MOV{(SP)+{R10{{RESTORE ENTRY XL
{{BRN{PRST1{{{LOOP BACK TO TEST FOR MORE
*
* HERE TO EXIT AFTER PRINTING STRING
*
{PRST4{MOV{PRSVB{R7{{RESTORE ENTRY WB
{{MOV{PRSVA{R6{{RESTORE ENTRY WA
{{EXI{{{{RETURN TO PRTST CALLER
{{ENP{{{{END PROCEDURE PRTST
{{EJC{{{{
*
* PRTTR -- PRINT TO TERMINAL
*
* CALLED TO PRINT CONTENTS OF STANDARD PRINT BUFFER TO
* ONLINE TERMINAL. CLEARS BUFFER DOWN AND RESETS PROFS.
*
* JSR PRTTR CALL FOR PRINT
* (WA,WB) DESTROYED
*
{PRTTR{PRC{E{0{{ENTRY POINT
{{MOV{R9{-(SP){{SAVE XR
{{JSR{PRTIC{{{PRINT BUFFER CONTENTS
{{MOV{PRBUF{R9{{POINT TO PRINT BFR TO CLEAR IT
{{LCT{R6{PRLNW{{GET BUFFER LENGTH
{{ADD{#4*SCHAR{R9{{POINT PAST SCBLK HEADER
{{MOV{NULLW{R7{{GET BLANKS
*
* LOOP TO CLEAR BUFFER
*
{PRTT1{MOV{R7{(R9)+{{CLEAR A WORD
{{BCT{R6{PRTT1{{LOOP
{{ZER{PROFS{{{RESET PROFS
{{MOV{(SP)+{R9{{RESTORE XR
{{EXI{{{{RETURN
{{ENP{{{{END PROCEDURE PRTTR
{{EJC{{{{
*
* PRTVL -- PRINT A VALUE
*
* PRTVL PLACES AN APPROPRIATE CHARACTER REPRESENTATION OF
* A DATA VALUE IN THE PRINT BUFFER FOR DUMP/TRACE USE.
*
* (XR) VALUE TO BE PRINTED
* JSR PRTVL CALL TO PRINT VALUE
* (WA,WB,WC,RA) DESTROYED
*
{PRTVL{PRC{R{0{{ENTRY POINT, RECURSIVE
{{MOV{R10{-(SP){{SAVE ENTRY XL
{{MOV{R9{-(SP){{SAVE ARGUMENT
{{CHK{{{{CHECK FOR STACK OVERFLOW
*
* LOOP BACK HERE AFTER FINDING A TRAP BLOCK (TRBLK)
*
{PRV01{MOV{4*IDVAL(R9){PRVSI{{COPY IDVAL (IF ANY)
{{MOV{(R9){R10{{LOAD FIRST WORD OF BLOCK
{{LEI{R10{{{LOAD ENTRY POINT ID
{{BSW{R10{BL$$T{PRV02{SWITCH ON BLOCK TYPE
{{IFF{BL$AR{PRV05{{ARBLK
{{IFF{BL$BC{PRV15{{BCBLK
{{IFF{DUMMY{PRV02{{
{{IFF{DUMMY{PRV02{{
{{IFF{BL$IC{PRV08{{ICBLK
{{IFF{BL$NM{PRV09{{NMBLK
{{IFF{DUMMY{PRV02{{
{{IFF{DUMMY{PRV02{{
{{IFF{DUMMY{PRV02{{
{{IFF{BL$RC{PRV08{{RCBLK
{{IFF{BL$SC{PRV11{{SCBLK
{{IFF{BL$SE{PRV12{{SEBLK
{{IFF{BL$TB{PRV13{{TBBLK
{{IFF{BL$VC{PRV13{{VCBLK
{{IFF{DUMMY{PRV02{{
{{IFF{DUMMY{PRV02{{
{{IFF{BL$PD{PRV10{{PDBLK
{{IFF{BL$TR{PRV04{{TRBLK
{{ESW{{{{END OF SWITCH ON BLOCK TYPE
*
* HERE FOR BLOCKS FOR WHICH WE JUST PRINT DATATYPE NAME
*
{PRV02{JSR{DTYPE{{{GET DATATYPE NAME
{{JSR{PRTST{{{PRINT DATATYPE NAME
*
* COMMON EXIT POINT
*
{PRV03{MOV{(SP)+{R9{{RELOAD ARGUMENT
{{MOV{(SP)+{R10{{RESTORE XL
{{EXI{{{{RETURN TO PRTVL CALLER
*
* HERE FOR TRBLK
*
{PRV04{MOV{4*TRVAL(R9){R9{{LOAD REAL VALUE
{{BRN{PRV01{{{AND LOOP BACK
{{EJC{{{{
*
* PRTVL (CONTINUED)
*
* HERE FOR ARRAY (ARBLK)
*
* PRINT ARRAY ( PROTOTYPE ) BLANK NUMBER IDVAL
*
{PRV05{MOV{R9{R10{{PRESERVE ARGUMENT
{{MOV{#SCARR{R9{{POINT TO DATATYPE NAME (ARRAY)
{{JSR{PRTST{{{PRINT IT
{{MOV{#CH$PP{R6{{LOAD LEFT PAREN
{{JSR{PRTCH{{{PRINT LEFT PAREN
{{ADD{4*AROFS(R10){R10{{POINT TO PROTOTYPE
{{MOV{(R10){R9{{LOAD PROTOTYPE
{{JSR{PRTST{{{PRINT PROTOTYPE
*
* VCBLK, TBBLK, BCBLK MERGE HERE FOR ) BLANK NUMBER IDVAL
*
{PRV06{MOV{#CH$RP{R6{{LOAD RIGHT PAREN
{{JSR{PRTCH{{{PRINT RIGHT PAREN
*
* PDBLK MERGES HERE TO PRINT BLANK NUMBER IDVAL
*
{PRV07{MOV{#CH$BL{R6{{LOAD BLANK
{{JSR{PRTCH{{{PRINT IT
{{MOV{#CH$NM{R6{{LOAD NUMBER SIGN
{{JSR{PRTCH{{{PRINT IT
{{MTI{PRVSI{{{GET IDVAL
{{JSR{PRTIN{{{PRINT ID NUMBER
{{BRN{PRV03{{{BACK TO EXIT
*
* HERE FOR INTEGER (ICBLK), REAL (RCBLK)
*
* PRINT CHARACTER REPRESENTATION OF VALUE
*
{PRV08{MOV{R9{-(SP){{STACK ARGUMENT FOR GTSTG
{{JSR{GTSTG{{{CONVERT TO STRING
{{PPM{{{{ERROR RETURN IS IMPOSSIBLE
{{JSR{PRTST{{{PRINT THE STRING
{{MOV{R9{DNAMP{{DELETE GARBAGE STRING FROM STORAGE
{{BRN{PRV03{{{BACK TO EXIT
{{EJC{{{{
*
* PRTVL (CONTINUED)
*
* NAME (NMBLK)
*
* FOR PSEUDO-VARIABLE, JUST PRINT DATATYPE NAME (NAME)
* FOR ALL OTHER NAMES, PRINT DOT FOLLOWED BY NAME REP
*
{PRV09{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE
{{MOV{(R10){R6{{LOAD FIRST WORD OF BLOCK
{{BEQ{R6{#B$KVT{PRV02{JUST PRINT NAME IF KEYWORD
{{BEQ{R6{#B$EVT{PRV02{JUST PRINT NAME IF EXPRESSION VAR
{{MOV{#CH$DT{R6{{ELSE GET DOT
{{JSR{PRTCH{{{AND PRINT IT
{{MOV{4*NMOFS(R9){R6{{LOAD NAME OFFSET
{{JSR{PRTNM{{{PRINT NAME
{{BRN{PRV03{{{BACK TO EXIT
*
* PROGRAM DATATYPE (PDBLK)
*
* PRINT DATATYPE NAME CH$BL CH$NM IDVAL
*
{PRV10{JSR{DTYPE{{{GET DATATYPE NAME
{{JSR{PRTST{{{PRINT DATATYPE NAME
{{BRN{PRV07{{{MERGE BACK TO PRINT ID
*
* HERE FOR STRING (SCBLK)
*
* PRINT QUOTE STRING-CHARACTERS QUOTE
*
{PRV11{MOV{#CH$SQ{R6{{LOAD SINGLE QUOTE
{{JSR{PRTCH{{{PRINT QUOTE
{{JSR{PRTST{{{PRINT STRING VALUE
{{JSR{PRTCH{{{PRINT ANOTHER QUOTE
{{BRN{PRV03{{{BACK TO EXIT
{{EJC{{{{
*
* PRTVL (CONTINUED)
*
* HERE FOR SIMPLE EXPRESSION (SEBLK)
*
* PRINT ASTERISK VARIABLE-NAME
*
{PRV12{MOV{#CH$AS{R6{{LOAD ASTERISK
{{JSR{PRTCH{{{PRINT ASTERISK
{{MOV{4*SEVAR(R9){R9{{LOAD VARIABLE POINTER
{{JSR{PRTVN{{{PRINT VARIABLE NAME
{{BRN{PRV03{{{JUMP BACK TO EXIT
*
* HERE FOR TABLE (TBBLK) AND ARRAY (VCBLK)
*
* PRINT DATATYPE ( PROTOTYPE ) BLANK NUMBER IDVAL
*
{PRV13{MOV{R9{R10{{PRESERVE ARGUMENT
{{JSR{DTYPE{{{GET DATATYPE NAME
{{JSR{PRTST{{{PRINT DATATYPE NAME
{{MOV{#CH$PP{R6{{LOAD LEFT PAREN
{{JSR{PRTCH{{{PRINT LEFT PAREN
{{MOV{4*TBLEN(R10){R6{{LOAD LENGTH OF BLOCK (=VCLEN)
{{BTW{R6{{{CONVERT TO WORD COUNT
{{SUB{#TBSI${R6{{ALLOW FOR STANDARD FIELDS
{{BEQ{(R10){#B$TBT{PRV14{JUMP IF TABLE
{{ADD{#VCTBD{R6{{FOR VCBLK, ADJUST SIZE
*
* PRINT PROTOTYPE
*
{PRV14{MTI{R6{{{MOVE AS INTEGER
{{JSR{PRTIN{{{PRINT INTEGER PROTOTYPE
{{BRN{PRV06{{{MERGE BACK FOR REST
{{EJC{{{{
*
* PRTVL (CONTINUED)
*
* HERE FOR BUFFER (BCBLK)
*
{PRV15{MOV{R9{R10{{PRESERVE ARGUMENT
{{MOV{#SCBUF{R9{{POINT TO DATATYPE NAME (BUFFER)
{{JSR{PRTST{{{PRINT IT
{{MOV{#CH$PP{R6{{LOAD LEFT PAREN
{{JSR{PRTCH{{{PRINT LEFT PAREN
{{MOV{4*BCBUF(R10){R9{{POINT TO BFBLK
{{MTI{4*BFALC(R9){{{LOAD ALLOCATION SIZE
{{JSR{PRTIN{{{PRINT IT
{{MOV{#CH$CM{R6{{LOAD COMMA
{{JSR{PRTCH{{{PRINT IT
{{MTI{4*BCLEN(R10){{{LOAD DEFINED LENGTH
{{JSR{PRTIN{{{PRINT IT
{{BRN{PRV06{{{MERGE TO FINISH UP
{{ENP{{{{END PROCEDURE PRTVL
{{EJC{{{{
*
* PRTVN -- PRINT NATURAL VARIABLE NAME
*
* PRTVN PRINTS THE NAME OF A NATURAL VARIABLE
*
* (XR) POINTER TO VRBLK
* JSR PRTVN CALL TO PRINT VARIABLE NAME
*
{PRTVN{PRC{E{0{{ENTRY POINT
{{MOV{R9{-(SP){{STACK VRBLK POINTER
{{ADD{#4*VRSOF{R9{{POINT TO POSSIBLE STRING NAME
{{BNZ{4*SCLEN(R9){PRVN1{{JUMP IF NOT SYSTEM VARIABLE
{{MOV{4*VRSVO(R9){R9{{POINT TO SVBLK WITH NAME
*
* MERGE HERE WITH DUMMY SCBLK POINTER IN XR
*
{PRVN1{JSR{PRTST{{{PRINT STRING NAME OF VARIABLE
{{MOV{(SP)+{R9{{RESTORE VRBLK POINTER
{{EXI{{{{RETURN TO PRTVN CALLER
{{ENP{{{{END PROCEDURE PRTVN
{{EJC{{{{
*
* RCBLD -- BUILD A REAL BLOCK
*
* (RA) REAL VALUE FOR RCBLK
* JSR RCBLD CALL TO BUILD REAL BLOCK
* (XR) POINTER TO RESULT RCBLK
* (WA) DESTROYED
*
{RCBLD{PRC{E{0{{ENTRY POINT
{{MOV{DNAMP{R9{{LOAD POINTER TO NEXT AVAILABLE LOC
{{ADD{#4*RCSI${R9{{POINT PAST NEW RCBLK
{{BLO{R9{DNAME{RCBL1{JUMP IF THERE IS ROOM
{{MOV{#4*RCSI${R6{{ELSE LOAD RCBLK LENGTH
{{JSR{ALLOC{{{USE STANDARD ALLOCATOR TO GET BLOCK
{{ADD{R6{R9{{POINT PAST BLOCK TO MERGE
*
* MERGE HERE WITH XR POINTING PAST THE BLOCK OBTAINED
*
{RCBL1{MOV{R9{DNAMP{{SET NEW POINTER
{{SUB{#4*RCSI${R9{{POINT BACK TO START OF BLOCK
{{MOV{#B$RCL{(R9){{STORE TYPE WORD
{{STR{4*RCVAL(R9){{{STORE REAL VALUE IN RCBLK
{{EXI{{{{RETURN TO RCBLD CALLER
{{ENP{{{{END PROCEDURE RCBLD
{{EJC{{{{
*
* READR -- READ NEXT SOURCE IMAGE AT COMPILE TIME
*
* READR IS USED TO READ THE NEXT SOURCE IMAGE. TO PROCESS
* CONTINUATION CARDS PROPERLY, THE COMPILER MUST READ ONE
* LINE AHEAD. THUS READR DOES NOT DESTROY THE CURRENT IMAGE
* SEE ALSO THE NEXTS ROUTINE WHICH ACTUALLY GETS THE IMAGE.
*
* JSR READR CALL TO READ NEXT IMAGE
* (XR) PTR TO NEXT IMAGE (0 IF NONE)
* (R$CNI) COPY OF POINTER
* (WA,WB,WC,XL) DESTROYED
*
{READR{PRC{E{0{{ENTRY POINT
{{MOV{R$CNI{R9{{GET PTR TO NEXT IMAGE
{{BNZ{R9{READ3{{EXIT IF ALREADY READ
{{BNE{STAGE{#STGIC{READ3{EXIT IF NOT INITIAL COMPILE
{{MOV{CSWIN{R6{{MAX READ LENGTH
{{JSR{ALOCS{{{ALLOCATE BUFFER
{{JSR{SYSRD{{{READ INPUT IMAGE
{{PPM{READ4{{{JUMP IF END OF FILE
{{MNZ{R7{{{SET TRIMR TO PERFORM TRIM
{{BLE{4*SCLEN(R9){CSWIN{READ1{USE SMALLER OF STRING LNTH ..
{{MOV{CSWIN{4*SCLEN(R9){{... AND XXX OF -INXXX
*
* PERFORM THE TRIM
*
{READ1{JSR{TRIMR{{{TRIM TRAILING BLANKS
*
* MERGE HERE AFTER READ
*
{READ2{MOV{R9{R$CNI{{STORE COPY OF POINTER
*
* MERGE HERE IF NO READ ATTEMPTED
*
{READ3{EXI{{{{RETURN TO READR CALLER
*
* HERE ON END OF FILE
*
{READ4{MOV{R9{DNAMP{{POP UNUSED SCBLK
{{ZER{R9{{{ZERO PTR AS RESULT
{{BRN{READ2{{{MERGE
{{ENP{{{{END PROCEDURE READR
{{EJC{{{{
*
* SBSTR -- BUILD A SUBSTRING
*
* (XL) PTR TO SCBLK/BFBLK WITH CHARS
* (WA) NUMBER OF CHARS IN SUBSTRING
* (WB) OFFSET TO FIRST CHAR IN SCBLK
* JSR SBSTR CALL TO BUILD SUBSTRING
* (XR) PTR TO NEW SCBLK WITH SUBSTRING
* (XL) ZERO
* (WA,WB,WC,XL,IA) DESTROYED
*
* NOTE THAT SBSTR IS CALLED WITH A DUMMY STRING POINTER
* (POINTING INTO A VRBLK OR SVBLK) TO COPY THE NAME OF A
* VARIABLE AS A STANDARD STRING VALUE.
*
{SBSTR{PRC{E{0{{ENTRY POINT
{{BZE{R6{SBST2{{JUMP IF NULL SUBSTRING
{{JSR{ALOCS{{{ELSE ALLOCATE SCBLK
{{MOV{R8{R6{{MOVE NUMBER OF CHARACTERS
{{MOV{R9{R8{{SAVE PTR TO NEW SCBLK
{{PLC{R10{R7{{PREPARE TO LOAD CHARS FROM OLD BLK
{{PSC{R9{{{PREPARE TO STORE CHARS IN NEW BLK
{{MVC{{{{MOVE CHARACTERS TO NEW STRING
{{MOV{R8{R9{{THEN RESTORE SCBLK POINTER
*
* RETURN POINT
*
{SBST1{ZER{R10{{{CLEAR GARBAGE POINTER IN XL
{{EXI{{{{RETURN TO SBSTR CALLER
*
* HERE FOR NULL SUBSTRING
*
{SBST2{MOV{#NULLS{R9{{SET NULL STRING AS RESULT
{{BRN{SBST1{{{RETURN
{{ENP{{{{END PROCEDURE SBSTR
{{EJC{{{{
*
* SCANE -- SCAN AN ELEMENT
*
* SCANE IS CALLED AT COMPILE TIME (BY EXPAN ,CMPIL,CNCRD)
* TO SCAN ONE ELEMENT FROM THE INPUT IMAGE.
*
* (SCNCC) NON-ZERO IF CALLED FROM CNCRD
* JSR SCANE CALL TO SCAN ELEMENT
* (XR) RESULT POINTER (SEE BELOW)
* (XL) SYNTAX TYPE CODE (T$XXX)
*
* THE FOLLOWING GLOBAL LOCATIONS ARE USED.
*
* R$CIM POINTER TO STRING BLOCK (SCBLK)
* FOR CURRENT INPUT IMAGE.
*
* R$CNI POINTER TO NEXT INPUT IMAGE STRING
* POINTER (ZERO IF NONE).
*
* R$SCP SAVE POINTER (EXIT XR) FROM LAST
* CALL IN CASE RESCAN IS SET.
*
* SCNBL THIS LOCATION IS SET NON-ZERO ON
* EXIT IF SCANE SCANNED PAST BLANKS
* BEFORE LOCATING THE CURRENT ELEMENT
* THE END OF A LINE COUNTS AS BLANKS.
*
* SCNCC CNCRD SETS THIS NON-ZERO TO SCAN
* CONTROL CARD NAMES AND CLEARS IT
* ON RETURN
*
* SCNIL LENGTH OF CURRENT INPUT IMAGE
*
* SCNGO IF SET NON-ZERO ON ENTRY, F AND S
* ARE RETURNED AS SEPARATE SYNTAX
* TYPES (NOT LETTERS) (GOTO PRO-
* CESSING). SCNGO IS RESET ON EXIT.
*
* SCNPT OFFSET TO CURRENT LOC IN R$CIM
*
* SCNRS IF SET NON-ZERO ON ENTRY, SCANE
* RETURNS THE SAME RESULT AS ON THE
* LAST CALL (RESCAN). SCNRS IS RESET
* ON EXIT FROM ANY CALL TO SCANE.
*
* SCNTP SAVE SYNTAX TYPE FROM LAST
* CALL (IN CASE RESCAN IS SET).
{{EJC{{{{
*
* SCANE (CONTINUED)
*
*
*
* ELEMENT SCANNED XL XR
* --------------- -- --
*
* CONTROL CARD NAME 0 POINTER TO SCBLK FOR NAME
*
* UNARY OPERATOR T$UOP PTR TO OPERATOR DVBLK
*
* LEFT PAREN T$LPR T$LPR
*
* LEFT BRACKET T$LBR T$LBR
*
* COMMA T$CMA T$CMA
*
* FUNCTION CALL T$FNC PTR TO FUNCTION VRBLK
*
* VARIABLE T$VAR PTR TO VRBLK
*
* STRING CONSTANT T$CON PTR TO SCBLK
*
* INTEGER CONSTANT T$CON PTR TO ICBLK
*
* REAL CONSTANT T$CON PTR TO RCBLK
*
* BINARY OPERATOR T$BOP PTR TO OPERATOR DVBLK
*
* RIGHT PAREN T$RPR T$RPR
*
* RIGHT BRACKET T$RBR T$RBR
*
* COLON T$COL T$COL
*
* SEMI-COLON T$SMC T$SMC
*
* F (SCNGO NE 0) T$FGO T$FGO
*
* S (SCNGO NE 0) T$SGO T$SGO
{{EJC{{{{
*
* SCANE (CONTINUED)
*
* ENTRY POINT
*
{SCANE{PRC{E{0{{ENTRY POINT
{{ZER{SCNBL{{{RESET BLANKS FLAG
{{MOV{R6{SCNSA{{SAVE WA
{{MOV{R7{SCNSB{{SAVE WB
{{MOV{R8{SCNSC{{SAVE WC
{{BZE{SCNRS{SCN03{{JUMP IF NO RESCAN
*
* HERE FOR RESCAN REQUEST
*
{{MOV{SCNTP{R10{{SET PREVIOUS RETURNED SCAN TYPE
{{MOV{R$SCP{R9{{SET PREVIOUS RETURNED POINTER
{{ZER{SCNRS{{{RESET RESCAN SWITCH
{{BRN{SCN13{{{JUMP TO EXIT
*
* COME HERE TO READ NEW IMAGE TO TEST FOR CONTINUATION
*
{SCN01{JSR{READR{{{READ NEXT IMAGE
{{MOV{#4*DVUBS{R7{{SET WB FOR NOT READING NAME
{{BZE{R9{SCN30{{TREAT AS SEMI-COLON IF NONE
{{PLC{R9{{{ELSE POINT TO FIRST CHARACTER
{{LCH{R8{(R9){{LOAD FIRST CHARACTER
{{BEQ{R8{#CH$DT{SCN02{JUMP IF DOT FOR CONTINUATION
{{BNE{R8{#CH$PL{SCN30{ELSE TREAT AS SEMICOLON UNLESS PLUS
*
* HERE FOR CONTINUATION LINE
*
{SCN02{JSR{NEXTS{{{ACQUIRE NEXT SOURCE IMAGE
{{MOV{#NUM01{SCNPT{{SET SCAN POINTER PAST CONTINUATION
{{MNZ{SCNBL{{{SET BLANKS FLAG
{{EJC{{{{
*
* SCANE (CONTINUED)
*
* MERGE HERE TO SCAN NEXT ELEMENT ON CURRENT LINE
*
{SCN03{MOV{SCNPT{R6{{LOAD CURRENT OFFSET
{{BEQ{R6{SCNIL{SCN01{CHECK CONTINUATION IF END
{{MOV{R$CIM{R10{{POINT TO CURRENT LINE
{{PLC{R10{R6{{POINT TO CURRENT CHARACTER
{{MOV{R6{SCNSE{{SET START OF ELEMENT LOCATION
{{MOV{#OPDVS{R8{{POINT TO OPERATOR DV LIST
{{MOV{#4*DVUBS{R7{{SET CONSTANT FOR OPERATOR CIRCUIT
{{BRN{SCN06{{{START SCANNING
*
* LOOP HERE TO IGNORE LEADING BLANKS AND TABS
*
{SCN05{BZE{R7{SCN10{{JUMP IF TRAILING
{{ICV{SCNSE{{{INCREMENT START OF ELEMENT
{{BEQ{R6{SCNIL{SCN01{JUMP IF END OF IMAGE
{{MNZ{SCNBL{{{NOTE BLANKS SEEN
*
* THE FOLLOWING JUMP IS USED REPEATEDLY FOR SCANNING OUT
* THE CHARACTERS OF A NUMERIC CONSTANT OR VARIABLE NAME.
* THE REGISTERS ARE USED AS FOLLOWS.
*
* (XR) SCRATCH
* (XL) PTR TO NEXT CHARACTER
* (WA) CURRENT SCAN OFFSET
* (WB) *DVUBS (0 IF SCANNING NAME,CONST)
* (WC) =OPDVS (0 IF SCANNING CONSTANT)
*
{SCN06{LCH{R9{(R10)+{{GET NEXT CHARACTER
{{ICV{R6{{{BUMP SCAN OFFSET
{{MOV{R6{SCNPT{{STORE OFFSET PAST CHAR SCANNED
{{BLO{#CFP$U{R9{SCN07{QUICK CHECK FOR OTHER CHAR
{{BSW{R9{CFP$U{SCN07{SWITCH ON SCANNED CHARACTER
*
* SWITCH TABLE FOR SWITCH ON CHARACTER
*
{{EJC{{{{
*
* SCANE (CONTINUED)
*
{{EJC{{{{
*
* SCANE (CONTINUED)
*
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{CH$HT{SCN05{{HORIZONTAL TAB
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{DUMMY{SCN07{{
{{IFF{CH$BL{SCN05{{BLANK
{{IFF{CH$EX{SCN37{{EXCLAMATION MARK
{{IFF{CH$DQ{SCN17{{DOUBLE QUOTE
{{IFF{CH$NM{SCN41{{NUMBER SIGN
{{IFF{CH$DL{SCN36{{DOLLAR
{{IFF{CH$PC{SCN38{{PERCENT
{{IFF{CH$AM{SCN44{{AMPERSAND
{{IFF{CH$SQ{SCN16{{SINGLE QUOTE
{{IFF{CH$PP{SCN25{{LEFT PAREN
{{IFF{CH$RP{SCN26{{RIGHT PAREN
{{IFF{CH$AS{SCN49{{ASTERISK
{{IFF{CH$PL{SCN33{{PLUS
{{IFF{CH$CM{SCN31{{COMMA
{{IFF{CH$MN{SCN34{{MINUS
{{IFF{CH$DT{SCN32{{DOT
{{IFF{CH$SL{SCN40{{SLASH
{{IFF{CH$D0{SCN08{{DIGIT 0
{{IFF{CH$D1{SCN08{{DIGIT 1
{{IFF{CH$D2{SCN08{{DIGIT 2
{{IFF{CH$D3{SCN08{{DIGIT 3
{{IFF{CH$D4{SCN08{{DIGIT 4
{{IFF{CH$D5{SCN08{{DIGIT 5
{{IFF{CH$D6{SCN08{{DIGIT 6
{{IFF{CH$D7{SCN08{{DIGIT 7
{{IFF{CH$D8{SCN08{{DIGIT 8
{{IFF{CH$D9{SCN08{{DIGIT 9
{{IFF{CH$CL{SCN29{{COLON
{{IFF{CH$SM{SCN30{{SEMI-COLON
{{IFF{CH$BB{SCN28{{LEFT BRACKET
{{IFF{CH$EQ{SCN46{{EQUAL
{{IFF{CH$RB{SCN27{{RIGHT BRACKET
{{IFF{CH$QU{SCN45{{QUESTION MARK
{{IFF{CH$AT{SCN42{{AT
{{IFF{CH$LA{SCN09{{LETTER A
{{IFF{CH$LB{SCN09{{LETTER B
{{IFF{CH$LC{SCN09{{LETTER C
{{IFF{CH$LD{SCN09{{LETTER D
{{IFF{CH$LE{SCN09{{LETTER E
{{IFF{CH$LF{SCN20{{LETTER F
{{IFF{CH$LG{SCN09{{LETTER G
{{IFF{CH$LH{SCN09{{LETTER H
{{IFF{CH$LI{SCN09{{LETTER I
{{IFF{CH$LJ{SCN09{{LETTER J
{{IFF{CH$LK{SCN09{{LETTER K
{{IFF{CH$LL{SCN09{{LETTER L
{{IFF{CH$LM{SCN09{{LETTER M
{{IFF{CH$LN{SCN09{{LETTER N
{{IFF{CH$LO{SCN09{{LETTER O
{{IFF{CH$LP{SCN09{{LETTER P
{{IFF{CH$LQ{SCN09{{LETTER Q
{{IFF{CH$LR{SCN09{{LETTER R
{{IFF{CH$LS{SCN21{{LETTER S
{{IFF{CH$LT{SCN09{{LETTER T
{{IFF{CH$LU{SCN09{{LETTER U
{{IFF{CH$LV{SCN09{{LETTER V
{{IFF{CH$LW{SCN09{{LETTER W
{{IFF{CH$LX{SCN09{{LETTER X
{{IFF{CH$LY{SCN09{{LETTER Y
{{IFF{CH$L${SCN09{{LETTER Z
{{IFF{CH$OB{SCN28{{LEFT BRACKET
{{IFF{DUMMY{SCN07{{
{{IFF{CH$CB{SCN27{{RIGHT BRACKET
{{IFF{DUMMY{SCN07{{
{{IFF{CH$UN{SCN24{{UNDERLINE
{{IFF{DUMMY{SCN07{{
{{IFF{CH$$A{SCN09{{SHIFTED A
{{IFF{CH$$B{SCN09{{SHIFTED B
{{IFF{CH$$C{SCN09{{SHIFTED C
{{IFF{CH$$D{SCN09{{SHIFTED D
{{IFF{CH$$E{SCN09{{SHIFTED E
{{IFF{CH$$F{SCN20{{SHIFTED F
{{IFF{CH$$G{SCN09{{SHIFTED G
{{IFF{CH$$H{SCN09{{SHIFTED H
{{IFF{CH$$I{SCN09{{SHIFTED I
{{IFF{CH$$J{SCN09{{SHIFTED J
{{IFF{CH$$K{SCN09{{SHIFTED K
{{IFF{CH$$L{SCN09{{SHIFTED L
{{IFF{CH$$M{SCN09{{SHIFTED M
{{IFF{CH$$N{SCN09{{SHIFTED N
{{IFF{CH$$O{SCN09{{SHIFTED O
{{IFF{CH$$P{SCN09{{SHIFTED P
{{IFF{CH$$Q{SCN09{{SHIFTED Q
{{IFF{CH$$R{SCN09{{SHIFTED R
{{IFF{CH$$S{SCN21{{SHIFTED S
{{IFF{CH$$T{SCN09{{SHIFTED T
{{IFF{CH$$U{SCN09{{SHIFTED U
{{IFF{CH$$V{SCN09{{SHIFTED V
{{IFF{CH$$W{SCN09{{SHIFTED W
{{IFF{CH$$X{SCN09{{SHIFTED X
{{IFF{CH$$Y{SCN09{{SHIFTED Y
{{IFF{CH$$${SCN09{{SHIFTED Z
{{IFF{DUMMY{SCN07{{
{{IFF{CH$BR{SCN43{{VERTICAL BAR
{{IFF{DUMMY{SCN07{{
{{IFF{CH$NT{SCN35{{NOT
{{IFF{DUMMY{SCN07{{
{{ESW{{{{END SWITCH ON CHARACTER
*
* HERE FOR ILLEGAL CHARACTER (UNDERLINE MERGES)
*
{SCN07{BZE{R7{SCN10{{JUMP IF SCANNING NAME OR CONSTANT
{{ERB{230{SYNTAX{{ERROR. ILLEGAL CHARACTER
{{EJC{{{{
*
* SCANE (CONTINUED)
*
* HERE FOR DIGITS 0-9
*
{SCN08{BZE{R7{SCN09{{KEEP SCANNING IF NAME/CONSTANT
{{ZER{R8{{{ELSE SET FLAG FOR SCANNING CONSTANT
*
* HERE FOR LETTER. LOOP HERE WHEN SCANNING NAME/CONSTANT
*
{SCN09{BEQ{R6{SCNIL{SCN11{JUMP IF END OF IMAGE
{{ZER{R7{{{SET FLAG FOR SCANNING NAME/CONST
{{BRN{SCN06{{{MERGE BACK TO CONTINUE SCAN
*
* COME HERE FOR DELIMITER ENDING NAME OR CONSTANT
*
{SCN10{DCV{R6{{{RESET OFFSET TO POINT TO DELIMITER
*
* COME HERE AFTER FINISHING SCAN OF NAME OR CONSTANT
*
{SCN11{MOV{R6{SCNPT{{STORE UPDATED SCAN OFFSET
{{MOV{SCNSE{R7{{POINT TO START OF ELEMENT
{{SUB{R7{R6{{GET NUMBER OF CHARACTERS
{{MOV{R$CIM{R10{{POINT TO LINE IMAGE
{{BNZ{R8{SCN15{{JUMP IF NAME
*
* HERE AFTER SCANNING OUT NUMERIC CONSTANT
*
{{JSR{SBSTR{{{GET STRING FOR CONSTANT
{{MOV{R9{DNAMP{{DELETE FROM STORAGE (NOT NEEDED)
{{JSR{GTNUM{{{CONVERT TO NUMERIC
{{PPM{SCN14{{{JUMP IF CONVERSION FAILURE
*
* MERGE HERE TO EXIT WITH CONSTANT
*
{SCN12{MOV{#T$CON{R10{{SET RESULT TYPE OF CONSTANT
{{EJC{{{{
*
* SCANE (CONTINUED)
*
* COMMON EXIT POINT (XR,XL) SET
*
{SCN13{MOV{SCNSA{R6{{RESTORE WA
{{MOV{SCNSB{R7{{RESTORE WB
{{MOV{SCNSC{R8{{RESTORE WC
{{MOV{R9{R$SCP{{SAVE XR IN CASE RESCAN
{{MOV{R10{SCNTP{{SAVE XL IN CASE RESCAN
{{ZER{SCNGO{{{RESET POSSIBLE GOTO FLAG
{{EXI{{{{RETURN TO SCANE CALLER
*
* HERE IF CONVERSION ERROR ON NUMERIC ITEM
*
{SCN14{ERB{231{SYNTAX{{ERROR. INVALID NUMERIC ITEM
*
* HERE AFTER SCANNING OUT VARIABLE NAME
*
{SCN15{JSR{SBSTR{{{BUILD STRING NAME OF VARIABLE
{{BNZ{SCNCC{SCN13{{RETURN IF CNCRD CALL
{{JSR{GTNVR{{{LOCATE/BUILD VRBLK
{{PPM{{{{DUMMY (UNUSED) ERROR RETURN
{{MOV{#T$VAR{R10{{SET TYPE AS VARIABLE
{{BRN{SCN13{{{BACK TO EXIT
*
* HERE FOR SINGLE QUOTE (START OF STRING CONSTANT)
*
{SCN16{BZE{R7{SCN10{{TERMINATOR IF SCANNING NAME OR CNST
{{MOV{#CH$SQ{R7{{SET TERMINATOR AS SINGLE QUOTE
{{BRN{SCN18{{{MERGE
*
* HERE FOR DOUBLE QUOTE (START OF STRING CONSTANT)
*
{SCN17{BZE{R7{SCN10{{TERMINATOR IF SCANNING NAME OR CNST
{{MOV{#CH$DQ{R7{{SET DOUBLE QUOTE TERMINATOR, MERGE
*
* LOOP TO SCAN OUT STRING CONSTANT
*
{SCN18{BEQ{R6{SCNIL{SCN19{ERROR IF END OF IMAGE
{{LCH{R8{(R10)+{{ELSE LOAD NEXT CHARACTER
{{ICV{R6{{{BUMP OFFSET
{{BNE{R8{R7{SCN18{LOOP BACK IF NOT TERMINATOR
{{EJC{{{{
*
* SCANE (CONTINUED)
*
* HERE AFTER SCANNING OUT STRING CONSTANT
*
{{MOV{SCNPT{R7{{POINT TO FIRST CHARACTER
{{MOV{R6{SCNPT{{SAVE OFFSET PAST FINAL QUOTE
{{DCV{R6{{{POINT BACK PAST LAST CHARACTER
{{SUB{R7{R6{{GET NUMBER OF CHARACTERS
{{MOV{R$CIM{R10{{POINT TO INPUT IMAGE
{{JSR{SBSTR{{{BUILD SUBSTRING VALUE
{{BRN{SCN12{{{BACK TO EXIT WITH CONSTANT RESULT
*
* HERE IF NO MATCHING QUOTE FOUND
*
{SCN19{MOV{R6{SCNPT{{SET UPDATED SCAN POINTER
{{ERB{232{SYNTAX{{ERROR. UNMATCHED STRING QUOTE
*
* HERE FOR F (POSSIBLE FAILURE GOTO)
*
{SCN20{MOV{#T$FGO{R9{{SET RETURN CODE FOR FAIL GOTO
{{BRN{SCN22{{{JUMP TO MERGE
*
* HERE FOR S (POSSIBLE SUCCESS GOTO)
*
{SCN21{MOV{#T$SGO{R9{{SET SUCCESS GOTO AS RETURN CODE
*
* SPECIAL GOTO CASES MERGE HERE
*
{SCN22{BZE{SCNGO{SCN09{{TREAT AS NORMAL LETTER IF NOT GOTO
*
* MERGE HERE FOR SPECIAL CHARACTER EXIT
*
{SCN23{BZE{R7{SCN10{{JUMP IF END OF NAME/CONSTANT
{{MOV{R9{R10{{ELSE COPY CODE
{{BRN{SCN13{{{AND JUMP TO EXIT
*
* HERE FOR UNDERLINE
*
{SCN24{BZE{R7{SCN09{{PART OF NAME IF SCANNING NAME
{{BRN{SCN07{{{ELSE ILLEGAL
{{EJC{{{{
*
* SCANE (CONTINUED)
*
* HERE FOR LEFT PAREN
*
{SCN25{MOV{#T$LPR{R9{{SET LEFT PAREN RETURN CODE
{{BNZ{R7{SCN23{{RETURN LEFT PAREN UNLESS NAME
{{BZE{R8{SCN10{{DELIMITER IF SCANNING CONSTANT
*
* HERE FOR LEFT PAREN AFTER NAME (FUNCTION CALL)
*
{{MOV{SCNSE{R7{{POINT TO START OF NAME
{{MOV{R6{SCNPT{{SET POINTER PAST LEFT PAREN
{{DCV{R6{{{POINT BACK PAST LAST CHAR OF NAME
{{SUB{R7{R6{{GET NAME LENGTH
{{MOV{R$CIM{R10{{POINT TO INPUT IMAGE
{{JSR{SBSTR{{{GET STRING NAME FOR FUNCTION
{{JSR{GTNVR{{{LOCATE/BUILD VRBLK
{{PPM{{{{DUMMY (UNUSED) ERROR RETURN
{{MOV{#T$FNC{R10{{SET CODE FOR FUNCTION CALL
{{BRN{SCN13{{{BACK TO EXIT
*
* PROCESSING FOR SPECIAL CHARACTERS
*
{SCN26{MOV{#T$RPR{R9{{RIGHT PAREN, SET CODE
{{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
*
{SCN27{MOV{#T$RBR{R9{{RIGHT BRACKET, SET CODE
{{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
*
{SCN28{MOV{#T$LBR{R9{{LEFT BRACKET, SET CODE
{{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
*
{SCN29{MOV{#T$COL{R9{{COLON, SET CODE
{{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
*
{SCN30{MOV{#T$SMC{R9{{SEMI-COLON, SET CODE
{{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
*
{SCN31{MOV{#T$CMA{R9{{COMMA, SET CODE
{{BRN{SCN23{{{TAKE SPECIAL CHARACTER EXIT
{{EJC{{{{
*
* SCANE (CONTINUED)
*
* HERE FOR OPERATORS. ON ENTRY, WC POINTS TO THE TABLE OF
* OPERATOR DOPE VECTORS AND WB IS THE INCREMENT TO STEP
* TO THE NEXT PAIR (BINARY/UNARY) OF DOPE VECTORS IN THE
* LIST. ON REACHING SCN46, THE POINTER HAS BEEN ADJUSTED TO
* POINT TO THE APPROPRIATE PAIR OF DOPE VECTORS.
* THE FIRST THREE ENTRIES ARE SPECIAL SINCE THEY CAN OCCUR
* AS PART OF A VARIABLE NAME (.) OR CONSTANT (.+-).
*
{SCN32{BZE{R7{SCN09{{DOT CAN BE PART OF NAME OR CONSTANT
{{ADD{R7{R8{{ELSE BUMP POINTER
*
{SCN33{BZE{R8{SCN09{{PLUS CAN BE PART OF CONSTANT
{{BZE{R7{SCN48{{PLUS CANNOT BE PART OF NAME
{{ADD{R7{R8{{ELSE BUMP POINTER
*
{SCN34{BZE{R8{SCN09{{MINUS CAN BE PART OF CONSTANT
{{BZE{R7{SCN48{{MINUS CANNOT BE PART OF NAME
{{ADD{R7{R8{{ELSE BUMP POINTER
*
{SCN35{ADD{R7{R8{{NOT
{SCN36{ADD{R7{R8{{DOLLAR
{SCN37{ADD{R7{R8{{EXCLAMATION
{SCN38{ADD{R7{R8{{PERCENT
{SCN39{ADD{R7{R8{{ASTERISK
{SCN40{ADD{R7{R8{{SLASH
{SCN41{ADD{R7{R8{{NUMBER SIGN
{SCN42{ADD{R7{R8{{AT SIGN
{SCN43{ADD{R7{R8{{VERTICAL BAR
{SCN44{ADD{R7{R8{{AMPERSAND
{SCN45{ADD{R7{R8{{QUESTION MARK
*
* ALL OPERATORS COME HERE (EQUAL MERGES DIRECTLY)
* (WC) POINTS TO THE BINARY/UNARY PAIR OF OPERATOR DVBLKS.
*
{SCN46{BZE{R7{SCN10{{OPERATOR TERMINATES NAME/CONSTANT
{{MOV{R8{R9{{ELSE COPY DV POINTER
{{LCH{R8{(R10){{LOAD NEXT CHARACTER
{{MOV{#T$BOP{R10{{SET BINARY OP IN CASE
{{BEQ{R6{SCNIL{SCN47{SHOULD BE BINARY IF IMAGE END
{{BEQ{R8{#CH$BL{SCN47{SHOULD BE BINARY IF FOLLOWED BY BLK
{{BEQ{R8{#CH$HT{SCN47{JUMP IF HORIZONTAL TAB
{{BEQ{R8{#CH$SM{SCN47{SEMICOLON CAN IMMEDIATELY FOLLOW =
*
* HERE FOR UNARY OPERATOR
*
{{ADD{#4*DVBS${R9{{POINT TO DV FOR UNARY OP
{{MOV{#T$UOP{R10{{SET TYPE FOR UNARY OPERATOR
{{BLE{SCNTP{#T$UOK{SCN13{OK UNARY IF OK PRECEDING ELEMENT
{{EJC{{{{
*
* SCANE (CONTINUED)
*
* MERGE HERE TO REQUIRE PRECEDING BLANKS
*
{SCN47{BNZ{SCNBL{SCN13{{ALL OK IF PRECEDING BLANKS, EXIT
*
* FAIL OPERATOR IN THIS POSITION
*
{SCN48{ERB{233{SYNTAX{{ERROR. INVALID USE OF OPERATOR
*
* HERE FOR ASTERISK, COULD BE ** SUBSTITUTE FOR EXCLAMATION
*
{SCN49{BZE{R7{SCN10{{END OF NAME IF SCANNING NAME
{{BEQ{R6{SCNIL{SCN39{NOT ** IF * AT IMAGE END
{{MOV{R6{R9{{ELSE SAVE OFFSET PAST FIRST *
{{MOV{R6{SCNOF{{SAVE ANOTHER COPY
{{LCH{R6{(R10)+{{LOAD NEXT CHARACTER
{{BNE{R6{#CH$AS{SCN50{NOT ** IF NEXT CHAR NOT *
{{ICV{R9{{{ELSE STEP OFFSET PAST SECOND *
{{BEQ{R9{SCNIL{SCN51{OK EXCLAM IF END OF IMAGE
{{LCH{R6{(R10){{ELSE LOAD NEXT CHARACTER
{{BEQ{R6{#CH$BL{SCN51{EXCLAMATION IF BLANK
{{BEQ{R6{#CH$HT{SCN51{EXCLAMATION IF HORIZONTAL TAB
*
* UNARY *
*
{SCN50{MOV{SCNOF{R6{{RECOVER STORED OFFSET
{{MOV{R$CIM{R10{{POINT TO LINE AGAIN
{{PLC{R10{R6{{POINT TO CURRENT CHAR
{{BRN{SCN39{{{MERGE WITH UNARY *
*
* HERE FOR ** AS SUBSTITUTE FOR EXCLAMATION
*
{SCN51{MOV{R9{SCNPT{{SAVE SCAN POINTER PAST 2ND *
{{MOV{R9{R6{{COPY SCAN POINTER
{{BRN{SCN37{{{MERGE WITH EXCLAMATION
{{ENP{{{{END PROCEDURE SCANE
{{EJC{{{{
*
* SCNGF -- SCAN GOTO FIELD
*
* SCNGF IS CALLED FROM CMPIL TO SCAN AND ANALYZE A GOTO
* FIELD INCLUDING THE SURROUNDING BRACKETS OR PARENTHESES.
* FOR A NORMAL GOTO, THE RESULT RETURNED IS EITHER A VRBLK
* POINTER FOR A SIMPLE LABEL OPERAND, OR A POINTER TO AN
* EXPRESSION TREE WITH A SPECIAL OUTER UNARY OPERATOR
* (O$GOC). FOR A DIRECT GOTO, THE RESULT RETURNED IS A
* POINTER TO AN EXPRESSION TREE WITH THE SPECIAL OUTER
* UNARY OPERATOR O$GOD.
*
* JSR SCNGF CALL TO SCAN GOTO FIELD
* (XR) RESULT (SEE ABOVE)
* (XL,WA,WB,WC) DESTROYED
*
{SCNGF{PRC{E{0{{ENTRY POINT
{{JSR{SCANE{{{SCAN INITIAL ELEMENT
{{BEQ{R10{#T$LPR{SCNG1{SKIP IF LEFT PAREN (NORMAL GOTO)
{{BEQ{R10{#T$LBR{SCNG2{SKIP IF LEFT BRACKET (DIRECT GOTO)
{{ERB{234{SYNTAX{{ERROR. GOTO FIELD INCORRECT
*
* HERE FOR LEFT PAREN (NORMAL GOTO)
*
{SCNG1{MOV{#NUM01{R7{{SET EXPAN FLAG FOR NORMAL GOTO
{{JSR{EXPAN{{{ANALYZE GOTO FIELD
{{MOV{#OPDVN{R6{{POINT TO OPDV FOR COMPLEX GOTO
{{BLE{R9{STATB{SCNG3{JUMP IF NOT IN STATIC (SGD15)
{{BLO{R9{STATE{SCNG4{JUMP TO EXIT IF SIMPLE LABEL NAME
{{BRN{SCNG3{{{COMPLEX GOTO - MERGE
*
* HERE FOR LEFT BRACKET (DIRECT GOTO)
*
{SCNG2{MOV{#NUM02{R7{{SET EXPAN FLAG FOR DIRECT GOTO
{{JSR{EXPAN{{{SCAN GOTO FIELD
{{MOV{#OPDVD{R6{{SET OPDV POINTER FOR DIRECT GOTO
{{EJC{{{{
*
* SCNGF (CONTINUED)
*
* MERGE HERE TO BUILD OUTER UNARY OPERATOR BLOCK
*
{SCNG3{MOV{R6{-(SP){{STACK OPERATOR DV POINTER
{{MOV{R9{-(SP){{STACK POINTER TO EXPRESSION TREE
{{JSR{EXPOP{{{POP OPERATOR OFF
{{MOV{(SP)+{R9{{RELOAD NEW EXPRESSION TREE POINTER
*
* COMMON EXIT POINT
*
{SCNG4{EXI{{{{RETURN TO CALLER
{{ENP{{{{END PROCEDURE SCNGF
{{EJC{{{{
*
* SETVR -- SET VRGET,VRSTO FIELDS OF VRBLK
*
* SETVR SETS THE PROPER VALUES IN THE VRGET AND VRSTO
* FIELDS OF A VRBLK. IT IS CALLED WHENEVER TRBLKS ARE
* ADDED OR SUBTRACTED (TRACE,STOPTR,INPUT,OUTPUT,DETACH)
*
* (XR) POINTER TO VRBLK
* JSR SETVR CALL TO SET FIELDS
* (XL,WA) DESTROYED
*
* NOTE THAT SETVR IGNORES THE CALL IF XR DOES NOT POINT
* INTO THE STATIC REGION (I.E. IS SOME OTHER NAME BASE)
*
{SETVR{PRC{E{0{{ENTRY POINT
{{BHI{R9{STATE{SETV1{EXIT IF NOT NATURAL VARIABLE
*
* HERE IF WE HAVE A VRBLK
*
{{MOV{R9{R10{{COPY VRBLK POINTER
{{MOV{#B$VRL{4*VRGET(R9){{STORE NORMAL GET VALUE
{{BEQ{4*VRSTO(R9){#B$VRE{SETV1{SKIP IF PROTECTED VARIABLE
{{MOV{#B$VRS{4*VRSTO(R9){{STORE NORMAL STORE VALUE
{{MOV{4*VRVAL(R10){R10{{POINT TO NEXT ENTRY ON CHAIN
{{BNE{(R10){#B$TRT{SETV1{JUMP IF END OF TRBLK CHAIN
{{MOV{#B$VRA{4*VRGET(R9){{STORE TRAPPED ROUTINE ADDRESS
{{MOV{#B$VRV{4*VRSTO(R9){{SET TRAPPED ROUTINE ADDRESS
*
* MERGE HERE TO EXIT TO CALLER
*
{SETV1{EXI{{{{RETURN TO SETVR CALLER
{{ENP{{{{END PROCEDURE SETVR
{{EJC{{{{
*
* SORTA -- SORT ARRAY
*
* ROUTINE TO SORT AN ARRAY OR TABLE ON SAME BASIS AS IN
* SITBOL. A TABLE IS CONVERTED TO AN ARRAY, LEAVING TWO
* DIMENSIONAL ARRAYS AND VECTORS AS CASES TO BE CONSIDERED.
* WHOLE ROWS OF ARRAYS ARE PERMUTED ACCORDING TO THE
* ORDERING OF THE KEYS THEY CONTAIN, AND THE STRIDE
* REFERRED TO, IS THE THE LENGTH OF A ROW. IT IS ONE
* FOR A VECTOR.
* THE SORT USED IS HEAPSORT, FUNDAMENTALS OF DATA STRUCTURE
* HOROWITZ AND SAHNI, PITMAN 1977, PAGE 347.
* IT IS AN ORDER N*LOG(N) ALGORITHM. IN ORDER
* TO MAKE IT STABLE, COMPARANDS MAY NOT COMPARE EQUAL. THIS
* IS ACHIEVED BY SORTING A COPY ARRAY (REFERRED TO AS THE
* SORT ARRAY) CONTAINING AT ITS HIGH ADDRESS END, BYTE
* OFFSETS TO THE ROWS TO BE SORTED HELD IN THE ORIGINAL
* ARRAY (REFERRED TO AS THE KEY ARRAY). SORTC, THE
* COMPARISON ROUTINE, ACCESSES THE KEYS THROUGH THESE
* OFFSETS AND IN THE CASE OF EQUALITY, RESOLVES IT BY
* COMPARING THE OFFSETS THEMSELVES. THE SORT PERMUTES THE
* OFFSETS WHICH ARE THEN USED IN A FINAL OPERATION TO COPY
* THE ACTUAL ITEMS INTO THE NEW ARRAY IN SORTED ORDER.
* REFERENCES TO ZEROTH ITEM ARE TO NOTIONAL ITEM
* PRECEDING FIRST ACTUAL ITEM.
* REVERSE SORTING FOR RSORT IS DONE BY HAVING THE LESS THAN
* TEST FOR KEYS EFFECTIVELY BE REPLACED BY A
* GREATER THAN TEST.
*
* 1(XS) FIRST ARG - ARRAY OR TABLE
* 0(XS) 2ND ARG - INDEX OR PDTYPE NAME
* (WA) 0 , NON-ZERO FOR SORT , RSORT
* JSR SORTA CALL TO SORT ARRAY
* (XR) SORTED ARRAY
* (XL,WA,WB,WC) DESTROYED
{{EJC{{{{
*
* SORTA (CONTINUED)
*
{SORTA{PRC{N{0{{ENTRY POINT
{{MOV{R6{SRTSR{{SORT/RSORT INDICATOR
{{MOV{#4*NUM01{SRTST{{DEFAULT STRIDE OF 1
{{ZER{SRTOF{{{DEFAULT ZERO OFFSET TO SORT KEY
{{MOV{#NULLS{SRTDF{{CLEAR DATATYPE FIELD NAME
{{MOV{(SP)+{R$SXR{{UNSTACK ARGUMENT 2
{{MOV{(SP)+{R9{{GET FIRST ARGUMENT
{{JSR{GTARR{{{CONVERT TO ARRAY
{{PPM{SRT16{{{FAIL
{{MOV{R9{-(SP){{STACK PTR TO RESULTING KEY ARRAY
{{MOV{R9{-(SP){{ANOTHER COPY FOR COPYB
{{JSR{COPYB{{{GET COPY ARRAY FOR SORTING INTO
{{PPM{{{{CANT FAIL
{{MOV{R9{-(SP){{STACK POINTER TO SORT ARRAY
{{MOV{R$SXR{R9{{GET SECOND ARG
{{MOV{4*1(SP){R10{{GET PTR TO KEY ARRAY
{{BNE{(R10){#B$VCT{SRT02{JUMP IF ARBLK
{{BEQ{R9{#NULLS{SRT01{JUMP IF NULL SECOND ARG
{{JSR{GTNVR{{{GET VRBLK PTR FOR IT
{{ERR{257{ERRONEOUS{{2ND ARG IN SORT/RSORT OF VECTOR
{{MOV{R9{SRTDF{{STORE DATATYPE FIELD NAME VRBLK
*
* COMPUTE N AND OFFSET TO ITEM A(0) IN VECTOR CASE
*
{SRT01{MOV{#4*VCLEN{R8{{OFFSET TO A(0)
{{MOV{#4*VCVLS{R7{{OFFSET TO FIRST ITEM
{{MOV{4*VCLEN(R10){R6{{GET BLOCK LENGTH
{{SUB{#4*VCSI${R6{{GET NO. OF ENTRIES, N (IN BYTES)
{{BRN{SRT04{{{MERGE
*
* HERE FOR ARRAY
*
{SRT02{LDI{4*ARDIM(R10){{{GET POSSIBLE DIMENSION
{{MFI{R6{{{CONVERT TO SHORT INTEGER
{{WTB{R6{{{FURTHER CONVERT TO BAUS
{{MOV{#4*ARVLS{R7{{OFFSET TO FIRST VALUE IF ONE
{{MOV{#4*ARPRO{R8{{OFFSET BEFORE VALUES IF ONE DIM.
{{BEQ{4*ARNDM(R10){#NUM01{SRT04{JUMP IN FACT IF ONE DIM.
{{BNE{4*ARNDM(R10){#NUM02{SRT16{FAIL UNLESS TWO DIMENS
{{LDI{4*ARLB2(R10){{{GET LOWER BOUND 2 AS DEFAULT
{{BEQ{R9{#NULLS{SRT03{JUMP IF DEFAULT SECOND ARG
{{JSR{GTINT{{{CONVERT TO INTEGER
{{PPM{SRT17{{{FAIL
{{LDI{4*ICVAL(R9){{{GET ACTUAL INTEGER VALUE
{{EJC{{{{
*
* SORTA (CONTINUED)
*
* HERE WITH SORT COLUMN INDEX IN IA IN ARRAY CASE
*
{SRT03{SBI{4*ARLB2(R10){{{SUBTRACT LOW BOUND
{{IOV{SRT17{{{FAIL IF OVERFLOW
{{ILT{SRT17{{{FAIL IF BELOW LOW BOUND
{{SBI{4*ARDM2(R10){{{CHECK AGAINST DIMENSION
{{IGE{SRT17{{{FAIL IF TOO LARGE
{{ADI{4*ARDM2(R10){{{RESTORE VALUE
{{MFI{R6{{{GET AS SMALL INTEGER
{{WTB{R6{{{OFFSET WITHIN ROW TO KEY
{{MOV{R6{SRTOF{{KEEP OFFSET
{{LDI{4*ARDM2(R10){{{SECOND DIMENSION IS ROW LENGTH
{{MFI{R6{{{CONVERT TO SHORT INTEGER
{{MOV{R6{R9{{COPY ROW LENGTH
{{WTB{R6{{{CONVERT TO BYTES
{{MOV{R6{SRTST{{STORE AS STRIDE
{{LDI{4*ARDIM(R10){{{GET NUMBER OF ROWS
{{MFI{R6{{{AS A SHORT INTEGER
{{WTB{R6{{{CONVERT N TO BAUS
{{MOV{4*ARLEN(R10){R8{{OFFSET PAST ARRAY END
{{SUB{R6{R8{{ADJUST, GIVING SPACE FOR N OFFSETS
{{DCA{R8{{{POINT TO A(0)
{{MOV{4*AROFS(R10){R7{{OFFSET TO WORD BEFORE FIRST ITEM
{{ICA{R7{{{OFFSET TO FIRST ITEM
*
* SEPARATE PRE-PROCESSING FOR ARRAYS AND VECTORS DONE.
* TO SIMPLIFY LATER KEY COMPARISONS, REMOVAL OF ANY TRBLK
* TRAP BLOCKS FROM ENTRIES IN KEY ARRAY IS EFFECTED.
*
* (XL) = 1(XS) = POINTER TO KEY ARRAY
* (XS) = POINTER TO SORT ARRAY
* WA = NUMBER OF ITEMS, N (CONVERTED TO BYTES).
* WB = OFFSET TO FIRST ITEM OF ARRAYS.
* WC = OFFSET TO A(0)
*
{SRT04{BLE{R6{#4*NUM01{SRT15{RETURN IF ONLY A SINGLE ITEM
{{MOV{R6{SRTSN{{STORE NUMBER OF ITEMS (IN BAUS)
{{MOV{R8{SRTSO{{STORE OFFSET TO A(0)
{{MOV{4*ARLEN(R10){R8{{LENGTH OF ARRAY OR VEC (=VCLEN)
{{ADD{R10{R8{{POINT PAST END OF ARRAY OR VECTOR
{{MOV{R7{SRTSF{{STORE OFFSET TO FIRST ROW
{{ADD{R7{R10{{POINT TO FIRST ITEM IN KEY ARRAY
*
* LOOP THROUGH ARRAY
*
{SRT05{MOV{(R10){R9{{GET AN ENTRY
*
* HUNT ALONG TRBLK CHAIN
*
{SRT06{BNE{(R9){#B$TRT{SRT07{JUMP OUT IF NOT TRBLK
{{MOV{4*TRVAL(R9){R9{{GET VALUE FIELD
{{BRN{SRT06{{{LOOP
{{EJC{{{{
*
* SORTA (CONTINUED)
*
* XR IS VALUE FROM END OF CHAIN
*
{SRT07{MOV{R9{(R10)+{{STORE AS ARRAY ENTRY
{{BLT{R10{R8{SRT05{LOOP IF NOT DONE
{{MOV{(SP){R10{{GET ADRS OF SORT ARRAY
{{MOV{SRTSF{R9{{INITIAL OFFSET TO FIRST KEY
{{MOV{SRTST{R7{{GET STRIDE
{{ADD{SRTSO{R10{{OFFSET TO A(0)
{{ICA{R10{{{POINT TO A(1)
{{MOV{SRTSN{R8{{GET N
{{BTW{R8{{{CONVERT FROM BYTES
{{MOV{R8{SRTNR{{STORE AS ROW COUNT
{{LCT{R8{R8{{LOOP COUNTER
*
* STORE KEY OFFSETS AT TOP OF SORT ARRAY
*
{SRT08{MOV{R9{(R10)+{{STORE AN OFFSET
{{ADD{R7{R9{{BUMP OFFSET BY STRIDE
{{BCT{R8{SRT08{{LOOP THROUGH ROWS
*
* PERFORM THE SORT ON OFFSETS IN SORT ARRAY.
*
* (SRTSN) NUMBER OF ITEMS TO SORT, N (BYTES)
* (SRTSO) OFFSET TO A(0)
*
{SRT09{MOV{SRTSN{R6{{GET N
{{MOV{SRTNR{R8{{GET NUMBER OF ROWS
{{RSH{R8{1{{I = N / 2 (WC=I, INDEX INTO ARRAY)
{{WTB{R8{{{CONVERT BACK TO BYTES
*
* LOOP TO FORM INITIAL HEAP
*
{SRT10{JSR{SORTH{{{SORTH(I,N)
{{DCA{R8{{{I = I - 1
{{BNZ{R8{SRT10{{LOOP IF I GT 0
{{MOV{R6{R8{{I = N
*
* SORTING LOOP. AT THIS POINT, A(1) IS THE LARGEST
* ITEM, SINCE ALGORITHM INITIALISES IT AS, AND THEN MAINTAI
* IT AS, ROOT OF TREE.
*
{SRT11{DCA{R8{{{I = I - 1 (N - 1 INITIALLY)
{{BZE{R8{SRT12{{JUMP IF DONE
{{MOV{(SP){R9{{GET SORT ARRAY ADDRESS
{{ADD{SRTSO{R9{{POINT TO A(0)
{{MOV{R9{R10{{A(0) ADDRESS
{{ADD{R8{R10{{A(I) ADDRESS
{{MOV{4*1(R10){R7{{COPY A(I+1)
{{MOV{4*1(R9){4*1(R10){{MOVE A(1) TO A(I+1)
{{MOV{R7{4*1(R9){{COMPLETE EXCHANGE OF A(1), A(I+1)
{{MOV{R8{R6{{N = I FOR SORTH
{{MOV{#4*NUM01{R8{{I = 1 FOR SORTH
{{JSR{SORTH{{{SORTH(1,N)
{{MOV{R6{R8{{RESTORE WC
{{BRN{SRT11{{{LOOP
{{EJC{{{{
*
* SORTA (CONTINUED)
*
* OFFSETS HAVE BEEN PERMUTED INTO REQUIRED ORDER BY SORT.
* COPY ARRAY ELEMENTS OVER THEM.
*
{SRT12{MOV{(SP){R10{{BASE ADRS OF KEY ARRAY
{{MOV{R10{R8{{COPY IT
{{ADD{SRTSO{R8{{OFFSET OF A(0)
{{ADD{SRTSF{R10{{ADRS OF FIRST ROW OF SORT ARRAY
{{MOV{SRTST{R7{{GET STRIDE
{{BTW{R7{{{CONVERT TO WORDS
*
* COPYING LOOP FOR SUCCESSIVE ITEMS. SORTED OFFSETS ARE
* HELD AT END OF SORT ARRAY.
*
{SRT13{ICA{R8{{{ADRS OF NEXT OF SORTED OFFSETS
{{MOV{R8{R9{{COPY IT FOR ACCESS
{{MOV{(R9){R9{{GET OFFSET
{{ADD{4*1(SP){R9{{ADD KEY ARRAY BASE ADRS
{{LCT{R6{R7{{GET COUNT OF WORDS IN ROW
*
* COPY A COMPLETE ROW
*
{SRT14{MOV{(R9)+{(R10)+{{MOVE A WORD
{{BCT{R6{SRT14{{LOOP
{{DCV{SRTNR{{{DECREMENT ROW COUNT
{{BNZ{SRTNR{SRT13{{REPEAT TILL ALL ROWS DONE
*
* RETURN POINT
*
{SRT15{MOV{(SP)+{R9{{POP RESULT ARRAY PTR
{{ICA{SP{{{POP KEY ARRAY PTR
{{ZER{R$SXL{{{CLEAR JUNK
{{ZER{R$SXR{{{CLEAR JUNK
{{EXI{{{{RETURN
*
* ERROR POINT
*
{SRT16{ERB{256{SORT/RSORT{{1ST ARG NOT SUITABLE ARRAY OR TABLE
{SRT17{ERB{258{SORT/RSORT{{2ND ARG OUT OF RANGE OR NON-INTEGER
{{ENP{{{{END PROCUDURE SORTA
{{EJC{{{{
*
* SORTC -- COMPARE SORT KEYS
*
* COMPARE TWO SORT KEYS GIVEN THEIR OFFSETS. IF
* EQUAL, COMPARE KEY OFFSETS TO GIVE STABLE SORT.
* NOTE THAT IF SRTSR IS NON-ZERO (REQUEST FOR REVERSE
* SORT), THE QUOTED RETURNS ARE INVERTED.
* FOR OBJECTS OF DIFFERING DATATYPES, THE ENTRY POINT
* IDENTIFICATIONS ARE COMPARED.
*
* (XL) BASE ADRS FOR KEYS
* (WA) OFFSET TO KEY 1 ITEM
* (WB) OFFSET TO KEY 2 ITEM
* (SRTSR) ZERO/NON-ZERO FOR SORT/RSORT
* (SRTOF) OFFSET WITHIN ROW TO COMPARANDS
* JSR SORTC CALL TO COMPARE KEYS
* PPM LOC KEY1 LESS THAN KEY2
* NORMAL RETURN, KEY1 GT THAN KEY2
* (XL,XR,WA,WB) DESTROYED
*
{SORTC{PRC{E{1{{ENTRY POINT
{{MOV{R6{SRTS1{{SAVE OFFSET 1
{{MOV{R7{SRTS2{{SAVE OFFSET 2
{{MOV{R8{SRTSC{{SAVE WC
{{ADD{SRTOF{R10{{ADD OFFSET TO COMPARAND FIELD
{{MOV{R10{R9{{COPY BASE + OFFSET
{{ADD{R6{R10{{ADD KEY1 OFFSET
{{ADD{R7{R9{{ADD KEY2 OFFSET
{{MOV{(R10){R10{{GET KEY1
{{MOV{(R9){R9{{GET KEY2
{{BNE{SRTDF{#NULLS{SRC11{JUMP IF DATATYPE FIELD NAME USED
{{EJC{{{{
*
* SORTC (CONTINUED)
*
* MERGE AFTER DEALING WITH FIELD NAME. TRY FOR STRINGS.
*
{SRC01{MOV{(R10){R8{{GET TYPE CODE
{{BNE{R8{(R9){SRC02{SKIP IF NOT SAME DATATYPE
{{BEQ{R8{#B$SCL{SRC09{JUMP IF BOTH STRINGS
*
* NOW TRY FOR NUMERIC
*
{SRC02{MOV{R10{R$SXL{{KEEP ARG1
{{MOV{R9{R$SXR{{KEEP ARG2
{{MOV{R10{-(SP){{STACK
{{MOV{R9{-(SP){{ARGS
{{JSR{ACOMP{{{COMPARE OBJECTS
{{PPM{SRC10{{{NOT NUMERIC
{{PPM{SRC10{{{NOT NUMERIC
{{PPM{SRC03{{{KEY1 LESS
{{PPM{SRC08{{{KEYS EQUAL
{{PPM{SRC05{{{KEY1 GREATER
*
* RETURN IF KEY1 SMALLER (SORT), GREATER (RSORT)
*
{SRC03{BNZ{SRTSR{SRC06{{JUMP IF RSORT
*
{SRC04{MOV{SRTSC{R8{{RESTORE WC
{{EXI{1{{{RETURN
*
* RETURN IF KEY1 GREATER (SORT), SMALLER (RSORT)
*
{SRC05{BNZ{SRTSR{SRC04{{JUMP IF RSORT
*
{SRC06{MOV{SRTSC{R8{{RESTORE WC
{{EXI{{{{RETURN
*
* KEYS ARE OF SAME DATATYPE
*
{SRC07{BLT{R10{R9{SRC03{ITEM FIRST CREATED IS LESS
{{BGT{R10{R9{SRC05{ADDRESSES RISE IN ORDER OF CREATION
*
* DROP THROUGH OR MERGE FOR IDENTICAL OR EQUAL OBJECTS
*
{SRC08{BLT{SRTS1{SRTS2{SRC04{TEST OFFSETS OR KEY ADDRSS INSTEAD
{{BRN{SRC06{{{OFFSET 1 GREATER
{{EJC{{{{
*
* SORTC (CONTINUED)
*
* STRINGS
*
{SRC09{MOV{R10{-(SP){{STACK
{{MOV{R9{-(SP){{ARGS
{{JSR{LCOMP{{{COMPARE OBJECTS
{{PPM{{{{CANT
{{PPM{{{{FAIL
{{PPM{SRC03{{{KEY1 LESS
{{PPM{SRC08{{{KEYS EQUAL
{{PPM{SRC05{{{KEY1 GREATER
*
* ARITHMETIC COMPARISON FAILED - RECOVER ARGS
*
{SRC10{MOV{R$SXL{R10{{GET ARG1
{{MOV{R$SXR{R9{{GET ARG2
{{MOV{(R10){R8{{GET TYPE OF KEY1
{{BEQ{R8{(R9){SRC07{JUMP IF KEYS OF SAME TYPE
{{MOV{R8{R10{{GET BLOCK TYPE WORD
{{MOV{(R9){R9{{GET BLOCK TYPE WORD
{{LEI{R10{{{ENTRY POINT ID FOR KEY1
{{LEI{R9{{{ENTRY POINT ID FOR KEY2
{{BGT{R10{R9{SRC05{JUMP IF KEY1 GT KEY2
{{BRN{SRC03{{{KEY1 LT KEY2
*
* DATATYPE FIELD NAME USED
*
{SRC11{JSR{SORTF{{{CALL ROUTINE TO FIND FIELD 1
{{MOV{R10{-(SP){{STACK ITEM POINTER
{{MOV{R9{R10{{GET KEY2
{{JSR{SORTF{{{FIND FIELD 2
{{MOV{R10{R9{{PLACE AS KEY2
{{MOV{(SP)+{R10{{RECOVER KEY1
{{BRN{SRC01{{{MERGE
{{ENP{{{{PROCEDURE SORTC
{{EJC{{{{
*
* SORTF -- FIND FIELD FOR SORTC
*
* ROUTINE USED BY SORTC TO OBTAIN ITEM CORRESPONDING
* TO A GIVEN FIELD NAME, IF THIS EXISTS, IN A PROGRAMMER
* DEFINED OBJECT PASSED AS ARGUMENT.
* IF SUCH A MATCH OCCURS, RECORD IS KEPT OF DATATYPE
* NAME, FIELD NAME AND OFFSET TO FIELD IN ORDER TO
* SHORT-CIRCUIT LATER SEARCHES ON SAME TYPE. NOTE THAT
* DFBLKS ARE STORED IN STATIC AND HENCE CANNOT BE MOVED.
*
* (SRTDF) VRBLK POINTER OF FIELD NAME
* (XL) POSSIBLE PDBLK POINTER
* JSR SORTF CALL TO SEARCH FOR FIELD NAME
* (XL) ITEM FOUND OR ORIGINAL PDBLK PTR
* (WC) DESTROYED
*
{SORTF{PRC{E{0{{ENTRY POINT
{{BNE{(R10){#B$PDT{SRTF3{RETURN IF NOT PDBLK
{{MOV{R9{-(SP){{KEEP XR
{{MOV{SRTFD{R9{{GET POSSIBLE FORMER DFBLK PTR
{{BZE{R9{SRTF4{{JUMP IF NOT
{{BNE{R9{4*PDDFP(R10){SRTF4{JUMP IF NOT RIGHT DATATYPE
{{BNE{SRTDF{SRTFF{SRTF4{JUMP IF NOT RIGHT FIELD NAME
{{ADD{SRTFO{R10{{ADD OFFSET TO REQUIRED FIELD
*
* HERE WITH XL POINTING TO FOUND FIELD
*
{SRTF1{MOV{(R10){R10{{GET ITEM FROM FIELD
*
* RETURN POINT
*
{SRTF2{MOV{(SP)+{R9{{RESTORE XR
*
{SRTF3{EXI{{{{RETURN
{{EJC{{{{
*
* SORTF (CONTINUED)
*
* CONDUCT A SEARCH
*
{SRTF4{MOV{R10{R9{{COPY ORIGINAL POINTER
{{MOV{4*PDDFP(R9){R9{{POINT TO DFBLK
{{MOV{R9{SRTFD{{KEEP A COPY
{{MOV{4*FARGS(R9){R8{{GET NUMBER OF FIELDS
{{WTB{R8{{{CONVERT TO BYTES
{{ADD{4*DFLEN(R9){R9{{POINT PAST LAST FIELD
*
* LOOP TO FIND NAME IN PDFBLK
*
{SRTF5{DCA{R8{{{COUNT DOWN
{{DCA{R9{{{POINT IN FRONT
{{BEQ{(R9){SRTDF{SRTF6{SKIP OUT IF FOUND
{{BNZ{R8{SRTF5{{LOOP
{{BRN{SRTF2{{{RETURN - NOT FOUND
*
* FOUND
*
{SRTF6{MOV{(R9){SRTFF{{KEEP FIELD NAME PTR
{{ADD{#4*PDFLD{R8{{ADD OFFSET TO FIRST FIELD
{{MOV{R8{SRTFO{{STORE AS FIELD OFFSET
{{ADD{R8{R10{{POINT TO FIELD
{{BRN{SRTF1{{{RETURN
{{ENP{{{{PROCEDURE SORTF
{{EJC{{{{
*
* SORTH -- HEAP ROUTINE FOR SORTA
*
* THIS ROUTINE CONSTRUCTS A HEAP FROM ELEMENTS OF ARRAY, A.
* IN THIS APPLICATION, THE ELEMENTS ARE OFFSETS TO KEYS IN
* A KEY ARRAY.
*
* (XS) POINTER TO SORT ARRAY BASE
* 1(XS) POINTER TO KEY ARRAY BASE
* (WA) MAX ARRAY INDEX, N (IN BYTES)
* (WC) OFFSET J IN A TO ROOT (IN *1 TO *N)
* JSR SORTH CALL SORTH(J,N) TO MAKE HEAP
* (XL,XR,WB) DESTROYED
*
{SORTH{PRC{N{0{{ENTRY POINT
{{MOV{R6{SRTSN{{SAVE N
{{MOV{R8{SRTWC{{KEEP WC
{{MOV{(SP){R10{{SORT ARRAY BASE ADRS
{{ADD{SRTSO{R10{{ADD OFFSET TO A(0)
{{ADD{R8{R10{{POINT TO A(J)
{{MOV{(R10){SRTRT{{GET OFFSET TO ROOT
{{ADD{R8{R8{{DOUBLE J - CANT EXCEED N
*
* LOOP TO MOVE DOWN TREE USING DOUBLED INDEX J
*
{SRH01{BGT{R8{SRTSN{SRH03{DONE IF J GT N
{{BEQ{R8{SRTSN{SRH02{SKIP IF J EQUALS N
{{MOV{(SP){R9{{SORT ARRAY BASE ADRS
{{MOV{4*1(SP){R10{{KEY ARRAY BASE ADRS
{{ADD{SRTSO{R9{{POINT TO A(0)
{{ADD{R8{R9{{ADRS OF A(J)
{{MOV{4*1(R9){R6{{GET A(J+1)
{{MOV{(R9){R7{{GET A(J)
*
* COMPARE SONS. (WA) RIGHT SON, (WB) LEFT SON
*
{{JSR{SORTC{{{COMPARE KEYS - LT(A(J+1),A(J))
{{PPM{SRH02{{{A(J+1) LT A(J)
{{ICA{R8{{{POINT TO GREATER SON, A(J+1)
{{EJC{{{{
*
* SORTH (CONTINUED)
*
* COMPARE ROOT WITH GREATER SON
*
{SRH02{MOV{4*1(SP){R10{{KEY ARRAY BASE ADRS
{{MOV{(SP){R9{{GET SORT ARRAY ADDRESS
{{ADD{SRTSO{R9{{ADRS OF A(0)
{{MOV{R9{R7{{COPY THIS ADRS
{{ADD{R8{R9{{ADRS OF GREATER SON, A(J)
{{MOV{(R9){R6{{GET A(J)
{{MOV{R7{R9{{POINT BACK TO A(0)
{{MOV{SRTRT{R7{{GET ROOT
{{JSR{SORTC{{{COMPARE THEM - LT(A(J),ROOT)
{{PPM{SRH03{{{FATHER EXCEEDS SONS - DONE
{{MOV{(SP){R9{{GET SORT ARRAY ADRS
{{ADD{SRTSO{R9{{POINT TO A(0)
{{MOV{R9{R10{{COPY IT
{{MOV{R8{R6{{COPY J
{{BTW{R8{{{CONVERT TO WORDS
{{RSH{R8{1{{GET J/2
{{WTB{R8{{{CONVERT BACK TO BYTES
{{ADD{R6{R10{{POINT TO A(J)
{{ADD{R8{R9{{ADRS OF A(J/2)
{{MOV{(R10){(R9){{A(J/2) = A(J)
{{MOV{R6{R8{{RECOVER J
{{AOV{R8{R8{SRH03{J = J*2. DONE IF TOO BIG
{{BRN{SRH01{{{LOOP
*
* FINISH BY COPYING ROOT OFFSET BACK INTO ARRAY
*
{SRH03{BTW{R8{{{CONVERT TO WORDS
{{RSH{R8{1{{J = J/2
{{WTB{R8{{{CONVERT BACK TO BYTES
{{MOV{(SP){R9{{SORT ARRAY ADRS
{{ADD{SRTSO{R9{{ADRS OF A(0)
{{ADD{R8{R9{{ADRS OF A(J/2)
{{MOV{SRTRT{(R9){{A(J/2) = ROOT
{{MOV{SRTSN{R6{{RESTORE WA
{{MOV{SRTWC{R8{{RESTORE WC
{{EXI{{{{RETURN
{{ENP{{{{END PROCEDURE SORTH
{{EJC{{{{
{{EJC{{{{
*
* TFIND -- LOCATE TABLE ELEMENT
*
* (XR) SUBSCRIPT VALUE FOR ELEMENT
* (XL) POINTER TO TABLE
* (WB) ZERO BY VALUE, NON-ZERO BY NAME
* JSR TFIND CALL TO LOCATE ELEMENT
* PPM LOC TRANSFER LOCATION IF ACCESS FAILS
* (XR) ELEMENT VALUE (IF BY VALUE)
* (XR) DESTROYED (IF BY NAME)
* (XL,WA) TEBLK NAME (IF BY NAME)
* (XL,WA) DESTROYED (IF BY VALUE)
* (WC,RA) DESTROYED
*
* NOTE THAT IF A CALL BY VALUE SPECIFIES A NON-EXISTENT
* SUBSCRIPT, NULL IS RETURNED WITHOUT BUILDING A NEW TEBLK.
*
{TFIND{PRC{E{1{{ENTRY POINT
{{MOV{R7{-(SP){{SAVE NAME/VALUE INDICATOR
{{MOV{R9{-(SP){{SAVE SUBSCRIPT VALUE
{{MOV{R10{-(SP){{SAVE TABLE POINTER
{{MOV{4*TBLEN(R10){R6{{LOAD LENGTH OF TBBLK
{{BTW{R6{{{CONVERT TO WORD COUNT
{{SUB{#TBBUK{R6{{GET NUMBER OF BUCKETS
{{MTI{R6{{{CONVERT TO INTEGER VALUE
{{STI{TFNSI{{{SAVE FOR LATER
{{MOV{(R9){R10{{LOAD FIRST WORD OF SUBSCRIPT
{{LEI{R10{{{LOAD BLOCK ENTRY ID (BL$XX)
{{BSW{R10{BL$$D{TFN00{SWITCH ON BLOCK TYPE
{{IFF{DUMMY{TFN00{{
{{IFF{DUMMY{TFN00{{
{{IFF{DUMMY{TFN00{{
{{IFF{DUMMY{TFN00{{
{{IFF{BL$IC{TFN02{{JUMP IF INTEGER
{{IFF{BL$NM{TFN04{{JUMP IF NAME
{{IFF{BL$P0{TFN03{{JUMP IF PATTERN
{{IFF{BL$P1{TFN03{{JUMP IF PATTERN
{{IFF{BL$P2{TFN03{{JUMP IF PATTERN
{{IFF{BL$RC{TFN02{{REAL
{{IFF{BL$SC{TFN05{{JUMP IF STRING
{{IFF{DUMMY{TFN00{{
{{IFF{DUMMY{TFN00{{
{{IFF{DUMMY{TFN00{{
{{IFF{DUMMY{TFN00{{
{{IFF{DUMMY{TFN00{{
{{IFF{DUMMY{TFN00{{
{{ESW{{{{END SWITCH ON BLOCK TYPE
*
* HERE FOR BLOCKS FOR WHICH WE USE THE SECOND WORD OF THE
* BLOCK AS THE HASH SOURCE (SEE BLOCK FORMATS FOR DETAILS).
*
{TFN00{MOV{4*1(R9){R6{{LOAD SECOND WORD
*
* MERGE HERE WITH ONE WORD HASH SOURCE IN WA
*
{TFN01{MTI{R6{{{CONVERT TO INTEGER
{{BRN{TFN06{{{JUMP TO MERGE
{{EJC{{{{
*
* TFIND (CONTINUED)
*
* HERE FOR INTEGER OR REAL
*
{TFN02{LDI{4*1(R9){{{LOAD VALUE AS HASH SOURCE
{{IGE{TFN06{{{OK IF POSITIVE OR ZERO
{{NGI{{{{MAKE POSITIVE
{{IOV{TFN06{{{CLEAR POSSIBLE OVERFLOW
{{BRN{TFN06{{{MERGE
*
* FOR PATTERN, USE FIRST WORD (PCODE) AS SOURCE
*
{TFN03{MOV{(R9){R6{{LOAD FIRST WORD AS HASH SOURCE
{{BRN{TFN01{{{MERGE BACK
*
* FOR NAME, USE OFFSET AS HASH SOURCE
*
{TFN04{MOV{4*NMOFS(R9){R6{{LOAD OFFSET AS HASH SOURCE
{{BRN{TFN01{{{MERGE BACK
*
* HERE FOR STRING
*
{TFN05{JSR{HASHS{{{CALL ROUTINE TO COMPUTE HASH
*
* MERGE HERE WITH HASH SOURCE IN (IA)
*
{TFN06{RMI{TFNSI{{{COMPUTE HASH INDEX BY REMAINDERING
{{MFI{R8{{{GET AS ONE WORD INTEGER
{{WTB{R8{{{CONVERT TO BYTE OFFSET
{{MOV{(SP){R10{{GET TABLE PTR AGAIN
{{ADD{R8{R10{{POINT TO PROPER BUCKET
{{MOV{4*TBBUK(R10){R9{{LOAD FIRST TEBLK POINTER
{{BEQ{R9{(SP){TFN10{JUMP IF NO TEBLKS ON CHAIN
*
* LOOP THROUGH TEBLKS ON HASH CHAIN
*
{TFN07{MOV{R9{R7{{SAVE TEBLK POINTER
{{MOV{4*TESUB(R9){R9{{LOAD SUBSCRIPT VALUE
{{MOV{4*1(SP){R10{{LOAD INPUT ARGUMENT SUBSCRIPT VAL
{{JSR{IDENT{{{COMPARE THEM
{{PPM{TFN08{{{JUMP IF EQUAL (IDENT)
*
* HERE IF NO MATCH WITH THAT TEBLK
*
{{MOV{R7{R10{{RESTORE TEBLK POINTER
{{MOV{4*TENXT(R10){R9{{POINT TO NEXT TEBLK ON CHAIN
{{BNE{R9{(SP){TFN07{JUMP IF THERE IS ONE
*
* HERE IF NO MATCH WITH ANY TEBLK ON CHAIN
*
{{MOV{#4*TENXT{R8{{SET OFFSET TO LINK FIELD (XL BASE)
{{BRN{TFN11{{{JUMP TO MERGE
{{EJC{{{{
*
* TFIND (CONTINUED)
*
* HERE WE HAVE FOUND A MATCHING ELEMENT
*
{TFN08{MOV{R7{R10{{RESTORE TEBLK POINTER
{{MOV{#4*TEVAL{R6{{SET TEBLK NAME OFFSET
{{MOV{4*2(SP){R7{{RESTORE NAME/VALUE INDICATOR
{{BNZ{R7{TFN09{{JUMP IF CALLED BY NAME
{{JSR{ACESS{{{ELSE GET VALUE
{{PPM{TFN12{{{JUMP IF REFERENCE FAILS
{{ZER{R7{{{RESTORE NAME/VALUE INDICATOR
*
* COMMON EXIT FOR ENTRY FOUND
*
{TFN09{ADD{#4*NUM03{SP{{POP STACK ENTRIES
{{EXI{{{{RETURN TO TFIND CALLER
*
* HERE IF NO TEBLKS ON THE HASH CHAIN
*
{TFN10{ADD{#4*TBBUK{R8{{GET OFFSET TO BUCKET PTR
{{MOV{(SP){R10{{SET TBBLK PTR AS BASE
*
* MERGE HERE WITH (XL,WC) BASE,OFFSET OF FINAL LINK
*
{TFN11{MOV{(SP){R9{{TBBLK POINTER
{{MOV{4*TBINV(R9){R9{{LOAD DEFAULT VALUE IN CASE
{{MOV{4*2(SP){R7{{LOAD NAME/VALUE INDICATOR
{{BZE{R7{TFN09{{EXIT WITH DEFAULT IF VALUE CALL
*
* HERE WE MUST BUILD A NEW TEBLK
*
{{MOV{#4*TESI${R6{{SET SIZE OF TEBLK
{{JSR{ALLOC{{{ALLOCATE TEBLK
{{ADD{R8{R10{{POINT TO HASH LINK
{{MOV{R9{(R10){{LINK NEW TEBLK AT END OF CHAIN
{{MOV{#B$TET{(R9){{STORE TYPE WORD
{{MOV{#NULLS{4*TEVAL(R9){{SET NULL AS INITIAL VALUE
{{MOV{(SP)+{4*TENXT(R9){{SET TBBLK PTR TO MARK END OF CHAIN
{{MOV{(SP)+{4*TESUB(R9){{STORE SUBSCRIPT VALUE
{{ICA{SP{{{POP PAST NAME/VALUE INDICATOR
{{MOV{R9{R10{{COPY TEBLK POINTER (NAME BASE)
{{MOV{#4*TEVAL{R6{{SET OFFSET
{{EXI{{{{RETURN TO CALLER WITH NEW TEBLK
*
* ACESS FAIL RETURN
*
{TFN12{EXI{1{{{ALTERNATIVE RETURN
{{ENP{{{{END PROCEDURE TFIND
{{EJC{{{{
*
* TRACE -- SET/RESET A TRACE ASSOCIATION
*
* THIS PROCEDURE IS SHARED BY TRACE AND STOPTR TO
* EITHER INITIATE OR STOP A TRACE RESPECTIVELY.
*
* (XL) TRBLK PTR (TRACE) OR ZERO (STOPTR)
* 1(XS) FIRST ARGUMENT (NAME)
* 0(XS) SECOND ARGUMENT (TRACE TYPE)
* JSR TRACE CALL TO SET/RESET TRACE
* PPM LOC TRANSFER LOC IF 1ST ARG IS BAD NAME
* PPM LOC TRANSFER LOC IF 2ND ARG IS BAD TYPE
* (XS) POPPED
* (XL,XR,WA,WB,WC,IA) DESTROYED
*
{TRACE{PRC{N{2{{ENTRY POINT
{{JSR{GTSTG{{{GET TRACE TYPE STRING
{{PPM{TRC15{{{JUMP IF NOT STRING
{{PLC{R9{{{ELSE POINT TO STRING
{{LCH{R6{(R9){{LOAD FIRST CHARACTER
{{FLC{R6{{{FOLD TO UPPER CASE
{{MOV{(SP){R9{{LOAD NAME ARGUMENT
{{MOV{R10{(SP){{STACK TRBLK PTR OR ZERO
{{MOV{#TRTAC{R8{{SET TRTYP FOR ACCESS TRACE
{{BEQ{R6{#CH$LA{TRC10{JUMP IF A (ACCESS)
{{MOV{#TRTVL{R8{{SET TRTYP FOR VALUE TRACE
{{BEQ{R6{#CH$LV{TRC10{JUMP IF V (VALUE)
{{BZE{R6{TRC10{{JUMP IF BLANK (VALUE)
*
* HERE FOR L,K,F,C,R
*
{{BEQ{R6{#CH$LF{TRC01{JUMP IF F (FUNCTION)
{{BEQ{R6{#CH$LR{TRC01{JUMP IF R (RETURN)
{{BEQ{R6{#CH$LL{TRC03{JUMP IF L (LABEL)
{{BEQ{R6{#CH$LK{TRC06{JUMP IF K (KEYWORD)
{{BNE{R6{#CH$LC{TRC15{ELSE ERROR IF NOT C (CALL)
*
* HERE FOR F,C,R
*
{TRC01{JSR{GTNVR{{{POINT TO VRBLK FOR NAME
{{PPM{TRC16{{{JUMP IF BAD NAME
{{ICA{SP{{{POP STACK
{{MOV{4*VRFNC(R9){R9{{POINT TO FUNCTION BLOCK
{{BNE{(R9){#B$PFC{TRC17{ERROR IF NOT PROGRAM FUNCTION
{{BEQ{R6{#CH$LR{TRC02{JUMP IF R (RETURN)
{{EJC{{{{
*
* TRACE (CONTINUED)
*
* HERE FOR F,C TO SET/RESET CALL TRACE
*
{{MOV{R10{4*PFCTR(R9){{SET/RESET CALL TRACE
{{BEQ{R6{#CH$LC{EXNUL{EXIT WITH NULL IF C (CALL)
*
* HERE FOR F,R TO SET/RESET RETURN TRACE
*
{TRC02{MOV{R10{4*PFRTR(R9){{SET/RESET RETURN TRACE
{{EXI{{{{RETURN
*
* HERE FOR L TO SET/RESET LABEL TRACE
*
{TRC03{JSR{GTNVR{{{POINT TO VRBLK
{{PPM{TRC16{{{JUMP IF BAD NAME
{{MOV{4*VRLBL(R9){R10{{LOAD LABEL POINTER
{{BNE{(R10){#B$TRT{TRC04{JUMP IF NO OLD TRACE
{{MOV{4*TRLBL(R10){R10{{ELSE DELETE OLD TRACE ASSOCIATION
*
* HERE WITH OLD LABEL TRACE ASSOCIATION DELETED
*
{TRC04{BEQ{R10{#STNDL{TRC16{ERROR IF UNDEFINED LABEL
{{MOV{(SP)+{R7{{GET TRBLK PTR AGAIN
{{BZE{R7{TRC05{{JUMP IF STOPTR CASE
{{MOV{R7{4*VRLBL(R9){{ELSE SET NEW TRBLK POINTER
{{MOV{#B$VRT{4*VRTRA(R9){{SET LABEL TRACE ROUTINE ADDRESS
{{MOV{R7{R9{{COPY TRBLK POINTER
{{MOV{R10{4*TRLBL(R9){{STORE REAL LABEL IN TRBLK
{{EXI{{{{RETURN
*
* HERE FOR STOPTR CASE FOR LABEL
*
{TRC05{MOV{R10{4*VRLBL(R9){{STORE LABEL PTR BACK IN VRBLK
{{MOV{#B$VRG{4*VRTRA(R9){{STORE NORMAL TRANSFER ADDRESS
{{EXI{{{{RETURN
{{EJC{{{{
*
* TRACE (CONTINUED)
*
* HERE FOR K (KEYWORD)
*
{TRC06{JSR{GTNVR{{{POINT TO VRBLK
{{PPM{TRC16{{{ERROR IF NOT NATURAL VAR
{{BNZ{4*VRLEN(R9){TRC16{{ERROR IF NOT SYSTEM VAR
{{ICA{SP{{{POP STACK
{{BZE{R10{TRC07{{JUMP IF STOPTR CASE
{{MOV{R9{4*TRKVR(R10){{STORE VRBLK PTR IN TRBLK FOR KTREX
*
* MERGE HERE WITH TRBLK SET UP IN WB (OR ZERO)
*
{TRC07{MOV{4*VRSVP(R9){R9{{POINT TO SVBLK
{{BEQ{R9{#V$ERT{TRC08{JUMP IF ERRTYPE
{{BEQ{R9{#V$STC{TRC09{JUMP IF STCOUNT
{{BNE{R9{#V$FNC{TRC17{ELSE ERROR IF NOT FNCLEVEL
*
* FNCLEVEL
*
{{MOV{R10{R$FNC{{SET/RESET FNCLEVEL TRACE
{{EXI{{{{RETURN
*
* ERRTYPE
*
{TRC08{MOV{R10{R$ERT{{SET/RESET ERRTYPE TRACE
{{EXI{{{{RETURN
*
* STCOUNT
*
{TRC09{MOV{R10{R$STC{{SET/RESET STCOUNT TRACE
{{EXI{{{{RETURN
{{EJC{{{{
*
* TRACE (CONTINUED)
*
* A,V MERGE HERE WITH TRTYP VALUE IN WC
*
{TRC10{JSR{GTVAR{{{LOCATE VARIABLE
{{PPM{TRC16{{{ERROR IF NOT APPROPRIATE NAME
{{MOV{(SP)+{R7{{GET NEW TRBLK PTR AGAIN
{{ADD{R10{R6{{POINT TO VARIABLE LOCATION
{{MOV{R6{R9{{COPY VARIABLE POINTER
*
* LOOP TO SEARCH TRBLK CHAIN
*
{TRC11{MOV{(R9){R10{{POINT TO NEXT ENTRY
{{BNE{(R10){#B$TRT{TRC13{JUMP IF NOT TRBLK
{{BLT{R8{4*TRTYP(R10){TRC13{JUMP IF TOO FAR OUT ON CHAIN
{{BEQ{R8{4*TRTYP(R10){TRC12{JUMP IF THIS MATCHES OUR TYPE
{{ADD{#4*TRNXT{R10{{ELSE POINT TO LINK FIELD
{{MOV{R10{R9{{COPY POINTER
{{BRN{TRC11{{{AND LOOP BACK
*
* HERE TO DELETE AN OLD TRBLK OF THE TYPE WE WERE GIVEN
*
{TRC12{MOV{4*TRNXT(R10){R10{{GET PTR TO NEXT BLOCK OR VALUE
{{MOV{R10{(R9){{STORE TO DELETE THIS TRBLK
*
* HERE AFTER DELETING ANY OLD ASSOCIATION OF THIS TYPE
*
{TRC13{BZE{R7{TRC14{{JUMP IF STOPTR CASE
{{MOV{R7{(R9){{ELSE LINK NEW TRBLK IN
{{MOV{R7{R9{{COPY TRBLK POINTER
{{MOV{R10{4*TRNXT(R9){{STORE FORWARD POINTER
{{MOV{R8{4*TRTYP(R9){{STORE APPROPRIATE TRAP TYPE CODE
*
* HERE TO MAKE SURE VRGET,VRSTO ARE SET PROPERLY
*
{TRC14{MOV{R6{R9{{RECALL POSSIBLE VRBLK POINTER
{{SUB{#4*VRVAL{R9{{POINT BACK TO VRBLK
{{JSR{SETVR{{{SET FIELDS IF VRBLK
{{EXI{{{{RETURN
*
* HERE FOR BAD TRACE TYPE
*
{TRC15{EXI{2{{{TAKE BAD TRACE TYPE ERROR EXIT
*
* POP STACK BEFORE FAILING
*
{TRC16{ICA{SP{{{POP STACK
*
* HERE FOR BAD NAME ARGUMENT
*
{TRC17{EXI{1{{{TAKE BAD NAME ERROR EXIT
{{ENP{{{{END PROCEDURE TRACE
{{EJC{{{{
*
* TRBLD -- BUILD TRBLK
*
* TRBLK IS USED BY THE INPUT, OUTPUT AND TRACE FUNCTIONS
* TO CONSTRUCT A TRBLK (TRAP BLOCK)
*
* (XR) TRTAG OR TRTER
* (XL) TRFNC OR TRFPT
* (WB) TRTYP
* JSR TRBLD CALL TO BUILD TRBLK
* (XR) POINTER TO TRBLK
* (WA) DESTROYED
*
{TRBLD{PRC{E{0{{ENTRY POINT
{{MOV{R9{-(SP){{STACK TRTAG (OR TRFNM)
{{MOV{#4*TRSI${R6{{SET SIZE OF TRBLK
{{JSR{ALLOC{{{ALLOCATE TRBLK
{{MOV{#B$TRT{(R9){{STORE FIRST WORD
{{MOV{R10{4*TRFNC(R9){{STORE TRFNC (OR TRFPT)
{{MOV{(SP)+{4*TRTAG(R9){{STORE TRTAG (OR TRFNM)
{{MOV{R7{4*TRTYP(R9){{STORE TYPE
{{MOV{#NULLS{4*TRVAL(R9){{FOR NOW, A NULL VALUE
{{EXI{{{{RETURN TO CALLER
{{ENP{{{{END PROCEDURE TRBLD
{{EJC{{{{
*
* TRIMR -- TRIM TRAILING BLANKS
*
* TRIMR IS PASSED A POINTER TO AN SCBLK WHICH MUST BE THE
* LAST BLOCK IN DYNAMIC STORAGE. TRAILING BLANKS ARE
* TRIMMED OFF AND THE DYNAMIC STORAGE POINTER RESET TO
* THE END OF THE (POSSIBLY) SHORTENED BLOCK.
*
* (WB) NON-ZERO TO TRIM TRAILING BLANKS
* (XR) POINTER TO STRING TO TRIM
* JSR TRIMR CALL TO TRIM STRING
* (XR) POINTER TO TRIMMED STRING
* (XL,WA,WB,WC) DESTROYED
*
* THE CALL WITH WB ZERO STILL PERFORMS THE END ZERO PAD
* AND DNAMP READJUSTMENT. IT IS USED FROM ACESS IF KVTRM=0.
*
{TRIMR{PRC{E{0{{ENTRY POINT
{{MOV{R9{R10{{COPY STRING POINTER
{{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH
{{BZE{R6{TRIM2{{JUMP IF NULL INPUT
{{PLC{R10{R6{{ELSE POINT PAST LAST CHARACTER
{{BZE{R7{TRIM3{{JUMP IF NO TRIM
{{MOV{#CH$BL{R8{{LOAD BLANK CHARACTER
*
* LOOP THROUGH CHARACTERS FROM RIGHT TO LEFT
*
{TRIM0{LCH{R7{-(R10){{LOAD NEXT CHARACTER
{{BEQ{R7{#CH$HT{TRIM1{JUMP IF HORIZONTAL TAB
{{BNE{R7{R8{TRIM3{JUMP IF NON-BLANK FOUND
{TRIM1{DCV{R6{{{ELSE DECREMENT CHARACTER COUNT
{{BNZ{R6{TRIM0{{LOOP BACK IF MORE TO CHECK
*
* HERE IF RESULT IS NULL (NULL OR ALL-BLANK INPUT)
*
{TRIM2{MOV{R9{DNAMP{{WIPE OUT INPUT STRING BLOCK
{{MOV{#NULLS{R9{{LOAD NULL RESULT
{{BRN{TRIM5{{{MERGE TO EXIT
{{EJC{{{{
*
* TRIMR (CONTINUED)
*
* HERE WITH NON-BLANK FOUND (MERGE FOR NO TRIM)
*
{TRIM3{MOV{R6{4*SCLEN(R9){{SET NEW LENGTH
{{MOV{R9{R10{{COPY STRING POINTER
{{PSC{R10{R6{{READY FOR STORING BLANKS
{{CTB{R6{SCHAR{{GET LENGTH OF BLOCK IN BYTES
{{ADD{R9{R6{{POINT PAST NEW BLOCK
{{MOV{R6{DNAMP{{SET NEW TOP OF STORAGE POINTER
{{LCT{R6{#CFP$C{{GET COUNT OF CHARS IN WORD
{{ZER{R8{{{SET BLANK CHAR
*
* LOOP TO ZERO PAD LAST WORD OF CHARACTERS
*
{TRIM4{SCH{R8{(R10)+{{STORE ZERO CHARACTER
{{BCT{R6{TRIM4{{LOOP BACK TILL ALL STORED
{{CSC{R10{{{COMPLETE STORE CHARACTERS
*
* COMMON EXIT POINT
*
{TRIM5{ZER{R10{{{CLEAR GARBAGE XL POINTER
{{EXI{{{{RETURN TO CALLER
{{ENP{{{{END PROCEDURE TRIMR
{{EJC{{{{
*
* TRXEQ -- EXECUTE FUNCTION TYPE TRACE
*
* TRXEQ IS USED TO EXECUTE A TRACE WHEN A FOURTH ARGUMENT
* HAS BEEN SUPPLIED. TRACE HAS ALREADY BEEN DECREMENTED.
*
* (XR) POINTER TO TRBLK
* (XL,WA) NAME BASE,OFFSET FOR VARIABLE
* JSR TRXEQ CALL TO EXECUTE TRACE
* (WB,WC,RA) DESTROYED
*
* THE FOLLOWING STACK ENTRIES ARE MADE BEFORE PASSING
* CONTROL TO THE TRACE FUNCTION USING THE CFUNC ROUTINE.
*
* TRXEQ RETURN POINT WORD(S)
* SAVED VALUE OF TRACE KEYWORD
* TRBLK POINTER
* NAME BASE
* NAME OFFSET
* SAVED VALUE OF R$COD
* SAVED CODE PTR (-R$COD)
* SAVED VALUE OF FLPTR
* FLPTR --------------- ZERO (DUMMY FAIL OFFSET)
* NMBLK FOR VARIABLE NAME
* XS ------------------ TRACE TAG
*
* R$COD AND THE CODE PTR ARE SET TO DUMMY VALUES WHICH
* CAUSE CONTROL TO RETURN TO THE TRXEQ PROCEDURE ON SUCCESS
* OR FAILURE (TRXEQ IGNORES A FAILURE CONDITION).
*
{TRXEQ{PRC{R{0{{ENTRY POINT (RECURSIVE)
{{MOV{R$COD{R8{{LOAD CODE BLOCK POINTER
{{SCP{R7{{{GET CURRENT CODE POINTER
{{SUB{R8{R7{{MAKE CODE POINTER INTO OFFSET
{{MOV{KVTRA{-(SP){{STACK TRACE KEYWORD VALUE
{{MOV{R9{-(SP){{STACK TRBLK POINTER
{{MOV{R10{-(SP){{STACK NAME BASE
{{MOV{R6{-(SP){{STACK NAME OFFSET
{{MOV{R8{-(SP){{STACK CODE BLOCK POINTER
{{MOV{R7{-(SP){{STACK CODE POINTER OFFSET
{{MOV{FLPTR{-(SP){{STACK OLD FAILURE POINTER
{{ZER{-(SP){{{SET DUMMY FAIL OFFSET
{{MOV{SP{FLPTR{{SET NEW FAILURE POINTER
{{ZER{KVTRA{{{RESET TRACE KEYWORD TO ZERO
{{MOV{#TRXDC{R8{{LOAD NEW (DUMMY) CODE BLK POINTER
{{MOV{R8{R$COD{{SET AS CODE BLOCK POINTER
{{LCP{R8{{{AND NEW CODE POINTER
{{EJC{{{{
*
* TRXEQ (CONTINUED)
*
* NOW PREPARE ARGUMENTS FOR FUNCTION
*
{{MOV{R6{R7{{SAVE NAME OFFSET
{{MOV{#4*NMSI${R6{{LOAD NMBLK SIZE
{{JSR{ALLOC{{{ALLOCATE SPACE FOR NMBLK
{{MOV{#B$NML{(R9){{SET TYPE WORD
{{MOV{R10{4*NMBAS(R9){{STORE NAME BASE
{{MOV{R7{4*NMOFS(R9){{STORE NAME OFFSET
{{MOV{4*6(SP){R10{{RELOAD POINTER TO TRBLK
{{MOV{R9{-(SP){{STACK NMBLK POINTER (1ST ARGUMENT)
{{MOV{4*TRTAG(R10){-(SP){{STACK TRACE TAG (2ND ARGUMENT)
{{MOV{4*TRFNC(R10){R10{{LOAD TRACE FUNCTION POINTER
{{MOV{#NUM02{R6{{SET NUMBER OF ARGUMENTS TO TWO
{{BRN{CFUNC{{{JUMP TO CALL FUNCTION
*
* SEE O$TXR FOR DETAILS OF RETURN TO THIS POINT
*
{TRXQ1{MOV{FLPTR{SP{{POINT BACK TO OUR STACK ENTRIES
{{ICA{SP{{{POP OFF GARBAGE FAIL OFFSET
{{MOV{(SP)+{FLPTR{{RESTORE OLD FAILURE POINTER
{{MOV{(SP)+{R7{{RELOAD CODE OFFSET
{{MOV{(SP)+{R8{{LOAD OLD CODE BASE POINTER
{{MOV{R8{R9{{COPY CDBLK POINTER
{{MOV{4*CDSTM(R9){KVSTN{{RESTORE STMNT NO
{{MOV{(SP)+{R6{{RELOAD NAME OFFSET
{{MOV{(SP)+{R10{{RELOAD NAME BASE
{{MOV{(SP)+{R9{{RELOAD TRBLK POINTER
{{MOV{(SP)+{KVTRA{{RESTORE TRACE KEYWORD VALUE
{{ADD{R8{R7{{RECOMPUTE ABSOLUTE CODE POINTER
{{LCP{R7{{{RESTORE CODE POINTER
{{MOV{R8{R$COD{{AND CODE BLOCK POINTER
{{EXI{{{{RETURN TO TRXEQ CALLER
{{ENP{{{{END PROCEDURE TRXEQ
{{EJC{{{{
*
* XSCAN -- EXECUTION FUNCTION ARGUMENT SCAN
*
* XSCAN SCANS OUT ONE TOKEN IN A PROTOTYPE ARGUMENT IN
* ARRAY,CLEAR,DATA,DEFINE,LOAD FUNCTION CALLS. XSCAN
* CALLS MUST BE PRECEDED BY A CALL TO THE INITIALIZATION
* PROCEDURE XSCNI. THE FOLLOWING VARIABLES ARE USED.
*
* R$XSC POINTER TO SCBLK FOR FUNCTION ARG
* XSOFS OFFSET (NUM CHARS SCANNED SO FAR)
*
* (WC) DELIMITER ONE (CH$XX)
* (XL) DELIMITER TWO (CH$XX)
* JSR XSCAN CALL TO SCAN NEXT ITEM
* (XR) POINTER TO SCBLK FOR TOKEN SCANNED
* (WA) COMPLETION CODE (SEE BELOW)
* (WC,XL) DESTROYED
*
* THE SCAN STARTS FROM THE CURRENT POSITION AND CONTINUES
* UNTIL ONE OF THE FOLLOWING THREE CONDITIONS OCCURS.
*
* 1) DELIMITER ONE IS ENCOUNTERED (WA SET TO 1)
*
* 2) DELIMITER TWO ENCOUNTERED (WA SET TO 2)
*
* 3) END OF STRING ENCOUNTERED (WA SET TO 0)
*
* THE RESULT IS A STRING CONTAINING ALL CHARACTERS SCANNED
* UP TO BUT NOT INCLUDING ANY DELIMITER CHARACTER.
* THE POINTER IS LEFT POINTING PAST THE DELIMITER.
*
* IF ONLY ONE DELIMITER IS TO BE DETECTED, DELIMITER ONE
* AND DELIMITER TWO SHOULD BE SET TO THE SAME VALUE.
*
* IN THE CASE WHERE THE END OF STRING IS ENCOUNTERED, THE
* STRING INCLUDES ALL THE CHARACTERS TO THE END OF THE
* STRING. NO FURTHER CALLS CAN BE MADE TO XSCAN UNTIL
* XSCNI IS CALLED TO INITIALIZE A NEW ARGUMENT SCAN
{{EJC{{{{
*
* XSCAN (CONTINUED)
*
{XSCAN{PRC{E{0{{ENTRY POINT
{{MOV{R7{XSCWB{{PRESERVE WB
{{MOV{R$XSC{R9{{POINT TO ARGUMENT STRING
{{MOV{4*SCLEN(R9){R6{{LOAD STRING LENGTH
{{MOV{XSOFS{R7{{LOAD CURRENT OFFSET
{{SUB{R7{R6{{GET NUMBER OF REMAINING CHARACTERS
{{BZE{R6{XSCN2{{JUMP IF NO CHARACTERS LEFT
{{PLC{R9{R7{{POINT TO CURRENT CHARACTER
*
* LOOP TO SEARCH FOR DELIMITER
*
{XSCN1{LCH{R7{(R9)+{{LOAD NEXT CHARACTER
{{BEQ{R7{R8{XSCN3{JUMP IF DELIMITER ONE FOUND
{{BEQ{R7{R10{XSCN4{JUMP IF DELIMITER TWO FOUND
{{DCV{R6{{{DECREMENT COUNT OF CHARS LEFT
{{BNZ{R6{XSCN1{{LOOP BACK IF MORE CHARS TO GO
*
* HERE FOR RUNOUT
*
{XSCN2{MOV{R$XSC{R10{{POINT TO STRING BLOCK
{{MOV{4*SCLEN(R10){R6{{GET STRING LENGTH
{{MOV{XSOFS{R7{{LOAD OFFSET
{{SUB{R7{R6{{GET SUBSTRING LENGTH
{{ZER{R$XSC{{{CLEAR STRING PTR FOR COLLECTOR
{{ZER{XSCRT{{{SET ZERO (RUNOUT) RETURN CODE
{{BRN{XSCN6{{{JUMP TO EXIT
{{EJC{{{{
*
* XSCAN (CONTINUED)
*
* HERE IF DELIMITER ONE FOUND
*
{XSCN3{MOV{#NUM01{XSCRT{{SET RETURN CODE
{{BRN{XSCN5{{{JUMP TO MERGE
*
* HERE IF DELIMITER TWO FOUND
*
{XSCN4{MOV{#NUM02{XSCRT{{SET RETURN CODE
*
* MERGE HERE AFTER DETECTING A DELIMITER
*
{XSCN5{MOV{R$XSC{R10{{RELOAD POINTER TO STRING
{{MOV{4*SCLEN(R10){R8{{GET ORIGINAL LENGTH OF STRING
{{SUB{R6{R8{{MINUS CHARS LEFT = CHARS SCANNED
{{MOV{R8{R6{{MOVE TO REG FOR SBSTR
{{MOV{XSOFS{R7{{SET OFFSET
{{SUB{R7{R6{{COMPUTE LENGTH FOR SBSTR
{{ICV{R8{{{ADJUST NEW CURSOR PAST DELIMITER
{{MOV{R8{XSOFS{{STORE NEW OFFSET
*
* COMMON EXIT POINT
*
{XSCN6{ZER{R9{{{CLEAR GARBAGE CHARACTER PTR IN XR
{{JSR{SBSTR{{{BUILD SUB-STRING
{{MOV{XSCRT{R6{{LOAD RETURN CODE
{{MOV{XSCWB{R7{{RESTORE WB
{{EXI{{{{RETURN TO XSCAN CALLER
{{ENP{{{{END PROCEDURE XSCAN
{{EJC{{{{
*
* XSCNI -- EXECUTION FUNCTION ARGUMENT SCAN
*
* XSCNI INITIALIZES THE SCAN USED FOR PROTOTYPE ARGUMENTS
* IN THE CLEAR, DEFINE, LOAD, DATA, ARRAY FUNCTIONS. SEE
* XSCAN FOR THE PROCEDURE WHICH IS USED AFTER THIS CALL.
*
* -(XS) ARGUMENT TO BE SCANNED (ON STACK)
* JSR XSCNI CALL TO SCAN ARGUMENT
* PPM LOC TRANSFER LOC IF ARG IS NOT STRING
* PPM LOC TRANSFER LOC IF ARGUMENT IS NULL
* (XS) POPPED
* (XR,R$XSC) ARGUMENT (SCBLK PTR)
* (WA) ARGUMENT LENGTH
* (IA,RA) DESTROYED
*
{XSCNI{PRC{N{2{{ENTRY POINT
{{JSR{GTSTG{{{FETCH ARGUMENT AS STRING
{{PPM{XSCI1{{{JUMP IF NOT CONVERTIBLE
{{MOV{R9{R$XSC{{ELSE STORE SCBLK PTR FOR XSCAN
{{ZER{XSOFS{{{SET OFFSET TO ZERO
{{BZE{R6{XSCI2{{JUMP IF NULL STRING
{{EXI{{{{RETURN TO XSCNI CALLER
*
* HERE IF ARGUMENT IS NOT A STRING
*
{XSCI1{EXI{1{{{TAKE NOT-STRING ERROR EXIT
*
* HERE FOR NULL STRING
*
{XSCI2{EXI{2{{{TAKE NULL-STRING ERROR EXIT
{{ENP{{{{END PROCEDURE XSCNI
{{TTL{S{{{P I T B O L -- UTILITY ROUTINES
*
* THE FOLLOWING SECTION CONTAINS UTILITY ROUTINES USED FOR
* VARIOUS PURPOSES THROUGHOUT THE SYSTEM. THESE DIFFER
* FROM THE PROCEDURES IN THE UTILITY PROCEDURES SECTION IN
* THEY ARE NOT IN PROCEDURE FORM AND THEY DO NOT RETURN
* TO THEIR CALLERS. THEY ARE ACCESSED WITH A BRANCH TYPE
* INSTRUCTION AFTER SETTING THE REGISTERS TO APPROPRIATE
* PARAMETER VALUES.
*
* THE REGISTER VALUES REQUIRED FOR EACH ROUTINE ARE
* DOCUMENTED AT THE START OF EACH ROUTINE. REGISTERS NOT
* MENTIONED MAY CONTAIN ANY VALUES EXCEPT THAT XR,XL
* CAN ONLY CONTAIN PROPER COLLECTABLE POINTERS.
*
* SOME OF THESE ROUTINES WILL TOLERATE GARBAGE POINTERS
* IN XL,XR ON ENTRY. THIS IS ALWAYS DOCUMENTED AND IN
* EACH CASE, THE ROUTINE CLEARS THESE GARBAGE VALUES BEFORE
* EXITING AFTER COMPLETING ITS TASK.
*
* THE ROUTINES HAVE NAMES CONSISTING OF FIVE LETTERS
* AND ARE ASSEMBLED IN ALPHABETICAL ORDER.
{{EJC{{{{
* ARREF -- ARRAY REFERENCE
*
* (XL) MAY BE NON-COLLECTABLE
* (XR) NUMBER OF SUBSCRIPTS
* (WB) SET ZERO/NONZERO FOR VALUE/NAME
* THE VALUE IN WB MUST BE COLLECTABLE
* STACK SUBSCRIPTS AND ARRAY OPERAND
* BRN ARREF JUMP TO CALL FUNCTION
*
* ARREF CONTINUES BY EXECUTING THE NEXT CODE WORD WITH
* THE RESULT NAME OR VALUE PLACED ON TOP OF THE STACK.
* TO DEAL WITH THE PROBLEM OF ACCESSING SUBSCRIPTS IN THE
* ORDER OF STACKING, XL IS USED AS A SUBSCRIPT POINTER
* WORKING BELOW THE STACK POINTER.
*
{ARREF{RTN{{{{
{{MOV{R9{R6{{COPY NUMBER OF SUBSCRIPTS
{{MOV{SP{R10{{POINT TO STACK FRONT
{{WTB{R9{{{CONVERT TO BYTE OFFSET
{{ADD{R9{R10{{POINT TO ARRAY OPERAND ON STACK
{{ICA{R10{{{FINAL VALUE FOR STACK POPPING
{{MOV{R10{ARFXS{{KEEP FOR LATER
{{MOV{-(R10){R9{{LOAD ARRAY OPERAND POINTER
{{MOV{R9{R$ARF{{KEEP ARRAY POINTER
{{MOV{R10{R9{{SAVE POINTER TO SUBSCRIPTS
{{MOV{R$ARF{R10{{POINT XL TO POSSIBLE VCBLK OR TBBLK
{{MOV{(R10){R8{{LOAD FIRST WORD
{{BEQ{R8{#B$ART{ARF01{JUMP IF ARBLK
{{BEQ{R8{#B$VCT{ARF07{JUMP IF VCBLK
{{BEQ{R8{#B$TBT{ARF10{JUMP IF TBBLK
{{ERB{235{SUBSCRIPTED{{OPERAND IS NOT TABLE OR ARRAY
*
* HERE FOR ARRAY (ARBLK)
*
{ARF01{BNE{R6{4*ARNDM(R10){ARF09{JUMP IF WRONG NUMBER OF DIMS
{{LDI{INTV0{{{GET INITIAL SUBSCRIPT OF ZERO
{{MOV{R9{R10{{POINT BEFORE SUBSCRIPTS
{{ZER{R6{{{INITIAL OFFSET TO BOUNDS
{{BRN{ARF03{{{JUMP INTO LOOP
*
* LOOP TO COMPUTE SUBSCRIPTS BY MULTIPLICATIONS
*
{ARF02{MLI{4*ARDM2(R9){{{MULTIPLY TOTAL BY NEXT DIMENSION
*
* MERGE HERE FIRST TIME
*
{ARF03{MOV{-(R10){R9{{LOAD NEXT SUBSCRIPT
{{STI{ARFSI{{{SAVE CURRENT SUBSCRIPT
{{LDI{4*ICVAL(R9){{{LOAD INTEGER VALUE IN CASE
{{BEQ{(R9){#B$ICL{ARF04{JUMP IF IT WAS AN INTEGER
{{EJC{{{{
*
* ARREF (CONTINUED)
*
*
{{JSR{GTINT{{{CONVERT TO INTEGER
{{PPM{ARF12{{{JUMP IF NOT INTEGER
{{LDI{4*ICVAL(R9){{{IF OK, LOAD INTEGER VALUE
*
* HERE WITH INTEGER SUBSCRIPT IN (IA)
*
{ARF04{MOV{R$ARF{R9{{POINT TO ARRAY
{{ADD{R6{R9{{OFFSET TO NEXT BOUNDS
{{SBI{4*ARLBD(R9){{{SUBTRACT LOW BOUND TO COMPARE
{{IOV{ARF13{{{OUT OF RANGE FAIL IF OVERFLOW
{{ILT{ARF13{{{OUT OF RANGE FAIL IF TOO SMALL
{{SBI{4*ARDIM(R9){{{SUBTRACT DIMENSION
{{IGE{ARF13{{{OUT OF RANGE FAIL IF TOO LARGE
{{ADI{4*ARDIM(R9){{{ELSE RESTORE SUBSCRIPT OFFSET
{{ADI{ARFSI{{{ADD TO CURRENT TOTAL
{{ADD{#4*ARDMS{R6{{POINT TO NEXT BOUNDS
{{BNE{R10{SP{ARF02{LOOP BACK IF MORE TO GO
*
* HERE WITH INTEGER SUBSCRIPT COMPUTED
*
{{MFI{R6{{{GET AS ONE WORD INTEGER
{{WTB{R6{{{CONVERT TO OFFSET
{{MOV{R$ARF{R10{{POINT TO ARBLK
{{ADD{4*AROFS(R10){R6{{ADD OFFSET PAST BOUNDS
{{ICA{R6{{{ADJUST FOR ARPRO FIELD
{{BNZ{R7{ARF08{{EXIT WITH NAME IF NAME CALL
*
* MERGE HERE TO GET VALUE FOR VALUE CALL
*
{ARF05{JSR{ACESS{{{GET VALUE
{{PPM{ARF13{{{FAIL IF ACESS FAILS
*
* RETURN VALUE
*
{ARF06{MOV{ARFXS{SP{{POP STACK ENTRIES
{{ZER{R$ARF{{{FINISHED WITH ARRAY POINTER
{{BRN{EXIXR{{{EXIT WITH VALUE IN XR
{{EJC{{{{
*
* ARREF (CONTINUED)
*
* HERE FOR VECTOR
*
{ARF07{BNE{R6{#NUM01{ARF09{ERROR IF MORE THAN 1 SUBSCRIPT
{{MOV{(SP){R9{{ELSE LOAD SUBSCRIPT
{{JSR{GTINT{{{CONVERT TO INTEGER
{{PPM{ARF12{{{ERROR IF NOT INTEGER
{{LDI{4*ICVAL(R9){{{ELSE LOAD INTEGER VALUE
{{SBI{INTV1{{{SUBTRACT FOR ONES OFFSET
{{MFI{R6{ARF13{{GET SUBSCRIPT AS ONE WORD
{{ADD{#VCVLS{R6{{ADD OFFSET FOR STANDARD FIELDS
{{WTB{R6{{{CONVERT OFFSET TO BYTES
{{BGE{R6{4*VCLEN(R10){ARF13{FAIL IF OUT OF RANGE SUBSCRIPT
{{BZE{R7{ARF05{{BACK TO GET VALUE IF VALUE CALL
*
* RETURN NAME
*
{ARF08{MOV{ARFXS{SP{{POP STACK ENTRIES
{{ZER{R$ARF{{{FINISHED WITH ARRAY POINTER
{{BRN{EXNAM{{{ELSE EXIT WITH NAME
*
* HERE IF SUBSCRIPT COUNT IS WRONG
*
{ARF09{ERB{236{ARRAY{{REFERENCED WITH WRONG NUMBER OF SUBSCRIPTS
*
* TABLE
*
{ARF10{BNE{R6{#NUM01{ARF11{ERROR IF MORE THAN 1 SUBSCRIPT
{{MOV{(SP){R9{{ELSE LOAD SUBSCRIPT
{{JSR{TFIND{{{CALL TABLE SEARCH ROUTINE
{{PPM{ARF13{{{FAIL IF FAILED
{{BNZ{R7{ARF08{{EXIT WITH NAME IF NAME CALL
{{BRN{ARF06{{{ELSE EXIT WITH VALUE
*
* HERE FOR BAD TABLE REFERENCE
*
{ARF11{ERB{237{TABLE{{REFERENCED WITH MORE THAN ONE SUBSCRIPT
*
* HERE FOR BAD SUBSCRIPT
*
{ARF12{ERB{238{ARRAY{{SUBSCRIPT IS NOT INTEGER
*
* HERE TO SIGNAL FAILURE
*
{ARF13{ZER{R$ARF{{{FINISHED WITH ARRAY POINTER
{{BRN{EXFAL{{{FAIL
{{EJC{{{{
*
* CFUNC -- CALL A FUNCTION
*
* CFUNC IS USED TO CALL A SNOBOL LEVEL FUNCTION. IT IS
* USED BY THE APPLY FUNCTION (S$APP), THE FUNCTION
* TRACE ROUTINE (TRXEQ) AND THE MAIN FUNCTION CALL ENTRY
* (O$FNC, O$FNS). IN THE LATTER CASES, CFUNC IS USED ONLY
* IF THE NUMBER OF ARGUMENTS IS INCORRECT.
*
* (XL) POINTER TO FUNCTION BLOCK
* (WA) ACTUAL NUMBER OF ARGUMENTS
* (XS) POINTS TO STACKED ARGUMENTS
* BRN CFUNC JUMP TO CALL FUNCTION
*
* CFUNC CONTINUES BY EXECUTING THE FUNCTION
*
{CFUNC{RTN{{{{
{{BLT{R6{4*FARGS(R10){CFNC1{JUMP IF TOO FEW ARGUMENTS
{{BEQ{R6{4*FARGS(R10){CFNC3{JUMP IF CORRECT NUMBER OF ARGS
*
* HERE IF TOO MANY ARGUMENTS SUPPLIED, POP THEM OFF
*
{{MOV{R6{R7{{COPY ACTUAL NUMBER
{{SUB{4*FARGS(R10){R7{{GET NUMBER OF EXTRA ARGS
{{WTB{R7{{{CONVERT TO BYTES
{{ADD{R7{SP{{POP OFF UNWANTED ARGUMENTS
{{BRN{CFNC3{{{JUMP TO GO OFF TO FUNCTION
*
* HERE IF TOO FEW ARGUMENTS
*
{CFNC1{MOV{4*FARGS(R10){R7{{LOAD REQUIRED NUMBER OF ARGUMENTS
{{BEQ{R7{#NINI9{CFNC3{JUMP IF CASE OF VAR NUM OF ARGS
{{SUB{R6{R7{{CALCULATE NUMBER MISSING
{{LCT{R7{R7{{SET COUNTER TO CONTROL LOOP
*
* LOOP TO SUPPLY EXTRA NULL ARGUMENTS
*
{CFNC2{MOV{#NULLS{-(SP){{STACK A NULL ARGUMENT
{{BCT{R7{CFNC2{{LOOP TILL PROPER NUMBER STACKED
*
* MERGE HERE TO JUMP TO FUNCTION
*
{CFNC3{BRI{(R10){{{JUMP THROUGH FCODE FIELD
{{EJC{{{{
*
* EXFAL -- EXIT SIGNALLING SNOBOL FAILURE
*
* (XL,XR) MAY BE NON-COLLECTABLE
* BRN EXFAL JUMP TO FAIL
*
* EXFAL CONTINUES BY EXECUTING THE APPROPRIATE FAIL GOTO
*
{EXFAL{RTN{{{{
{{MOV{FLPTR{SP{{POP STACK
{{MOV{(SP){R9{{LOAD FAILURE OFFSET
{{ADD{R$COD{R9{{POINT TO FAILURE CODE LOCATION
{{LCP{R9{{{SET CODE POINTER
{{BRN{EXITS{{{DO NEXT CODE WORD
{{EJC{{{{
*
* EXINT -- EXIT WITH INTEGER RESULT
*
* (XL,XR) MAY BE NONCOLLECTABLE
* (IA) INTEGER VALUE
* BRN EXINT JUMP TO EXIT WITH INTEGER
*
* EXINT CONTINUES BY EXECUTING THE NEXT CODE WORD
* WHICH IT DOES BY FALLING THROUGH TO EXIXR
*
{EXINT{RTN{{{{
{{JSR{ICBLD{{{BUILD ICBLK
{{EJC{{{{
* EXIXR -- EXIT WITH RESULT IN (XR)
*
* (XR) RESULT
* (XL) MAY BE NON-COLLECTABLE
* BRN EXIXR JUMP TO EXIT WITH RESULT IN (XR)
*
* EXIXR CONTINUES BY EXECUTING THE NEXT CODE WORD
* WHICH IT DOES BY FALLING THROUGH TO EXITS.
{EXIXR{RTN{{{{
*
{{MOV{R9{-(SP){{STACK RESULT
*
*
* EXITS -- EXIT WITH RESULT IF ANY STACKED
*
* (XR,XL) MAY BE NON-COLLECTABLE
*
* BRN EXITS ENTER EXITS ROUTINE
*
{EXITS{RTN{{{{
{{LCW{R9{{{LOAD NEXT CODE WORD
{{MOV{(R9){R10{{LOAD ENTRY ADDRESS
{{BRI{R10{{{JUMP TO EXECUTE NEXT CODE WORD
{{EJC{{{{
*
* EXNAM -- EXIT WITH NAME IN (XL,WA)
*
* (XL) NAME BASE
* (WA) NAME OFFSET
* (XR) MAY BE NON-COLLECTABLE
* BRN EXNAM JUMP TO EXIT WITH NAME IN (XL,WA)
*
* EXNAM CONTINUES BY EXECUTING THE NEXT CODE WORD
*
{EXNAM{RTN{{{{
{{MOV{R10{-(SP){{STACK NAME BASE
{{MOV{R6{-(SP){{STACK NAME OFFSET
{{BRN{EXITS{{{DO NEXT CODE WORD
{{EJC{{{{
*
* EXNUL -- EXIT WITH NULL RESULT
*
* (XL,XR) MAY BE NON-COLLECTABLE
* BRN EXNUL JUMP TO EXIT WITH NULL VALUE
*
* EXNUL CONTINUES BY EXECUTING THE NEXT CODE WORD
*
{EXNUL{RTN{{{{
{{MOV{#NULLS{-(SP){{STACK NULL VALUE
{{BRN{EXITS{{{DO NEXT CODE WORD
{{EJC{{{{
*
* EXREA -- EXIT WITH REAL RESULT
*
* (XL,XR) MAY BE NON-COLLECTABLE
* (RA) REAL VALUE
* BRN EXREA JUMP TO EXIT WITH REAL VALUE
*
* EXREA CONTINUES BY EXECUTING THE NEXT CODE WORD
*
{EXREA{RTN{{{{
{{JSR{RCBLD{{{BUILD RCBLK
{{BRN{EXIXR{{{JUMP TO EXIT WITH RESULT IN XR
{{EJC{{{{
*
* EXSID -- EXIT SETTING ID FIELD
*
* EXSID IS USED TO EXIT AFTER BUILDING ANY OF THE FOLLOWING
* BLOCKS (ARBLK, TBBLK, PDBLK, VCBLK). IT SETS THE IDVAL.
*
* (XR) PTR TO BLOCK WITH IDVAL FIELD
* (XL) MAY BE NON-COLLECTABLE
* BRN EXSID JUMP TO EXIT AFTER SETTING ID FIELD
*
* EXSID CONTINUES BY EXECUTING THE NEXT CODE WORD
*
{EXSID{RTN{{{{
{{MOV{CURID{R6{{LOAD CURRENT ID VALUE
{{BNE{R6{#CFP$M{EXSI1{JUMP IF NO OVERFLOW
{{ZER{R6{{{ELSE RESET FOR WRAPAROUND
*
* HERE WITH OLD IDVAL IN WA
*
{EXSI1{ICV{R6{{{BUMP ID VALUE
{{MOV{R6{CURID{{STORE FOR NEXT TIME
{{MOV{R6{4*IDVAL(R9){{STORE ID VALUE
{{BRN{EXIXR{{{EXIT WITH RESULT IN (XR)
{{EJC{{{{
*
* EXVNM -- EXIT WITH NAME OF VARIABLE
*
* EXVNM EXITS AFTER STACKING A VALUE WHICH IS A NMBLK
* REFERENCING THE NAME OF A GIVEN NATURAL VARIABLE.
*
* (XR) VRBLK POINTER
* (XL) MAY BE NON-COLLECTABLE
* BRN EXVNM EXIT WITH VRBLK POINTER IN XR
*
{EXVNM{RTN{{{{
{{MOV{R9{R10{{COPY NAME BASE POINTER
{{MOV{#4*NMSI${R6{{SET SIZE OF NMBLK
{{JSR{ALLOC{{{ALLOCATE NMBLK
{{MOV{#B$NML{(R9){{STORE TYPE WORD
{{MOV{R10{4*NMBAS(R9){{STORE NAME BASE
{{MOV{#4*VRVAL{4*NMOFS(R9){{STORE NAME OFFSET
{{BRN{EXIXR{{{EXIT WITH RESULT IN XR
{{EJC{{{{
*
* FLPOP -- FAIL AND POP IN PATTERN MATCHING
*
* FLPOP POPS THE NODE AND CURSOR ON THE STACK AND THEN
* DROPS THROUGH INTO FAILP TO CAUSE PATTERN FAILURE
*
* (XL,XR) MAY BE NON-COLLECTABLE
* BRN FLPOP JUMP TO FAIL AND POP STACK
*
{FLPOP{RTN{{{{
{{ADD{#4*NUM02{SP{{POP TWO ENTRIES OFF STACK
{{EJC{{{{
*
* FAILP -- FAILURE IN MATCHING PATTERN NODE
*
* FAILP IS USED AFTER FAILING TO MATCH A PATTERN NODE.
* SEE PATTERN MATCH ROUTINES FOR DETAILS OF USE.
*
* (XL,XR) MAY BE NON-COLLECTABLE
* BRN FAILP SIGNAL FAILURE TO MATCH
*
* FAILP CONTINUES BY MATCHING AN ALTERNATIVE FROM THE STACK
*
{FAILP{RTN{{{{
{{MOV{(SP)+{R9{{LOAD ALTERNATIVE NODE POINTER
{{MOV{(SP)+{R7{{RESTORE OLD CURSOR
{{MOV{(R9){R10{{LOAD PCODE ENTRY POINTER
{{BRI{R10{{{JUMP TO EXECUTE CODE FOR NODE
{{EJC{{{{
*
* INDIR -- COMPUTE INDIRECT REFERENCE
*
* (WB) NONZERO/ZERO FOR BY NAME/VALUE
* BRN INDIR JUMP TO GET INDIRECT REF ON STACK
*
* INDIR CONTINUES BY EXECUTING THE NEXT CODE WORD
*
{INDIR{RTN{{{{
{{MOV{(SP)+{R9{{LOAD ARGUMENT
{{BEQ{(R9){#B$NML{INDR2{JUMP IF A NAME
{{JSR{GTNVR{{{ELSE CONVERT TO VARIABLE
{{ERR{239{INDIRECTION{{OPERAND IS NOT NAME
{{BZE{R7{INDR1{{SKIP IF BY VALUE
{{MOV{R9{-(SP){{ELSE STACK VRBLK PTR
{{MOV{#4*VRVAL{-(SP){{STACK NAME OFFSET
{{BRN{EXITS{{{EXIT WITH RESULT ON STACK
*
* HERE TO GET VALUE OF NATURAL VARIABLE
*
{INDR1{BRI{(R9){{{JUMP THROUGH VRGET FIELD OF VRBLK
*
* HERE IF OPERAND IS A NAME
*
{INDR2{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE
{{MOV{4*NMOFS(R9){R6{{LOAD NAME OFFSET
{{BNZ{R7{EXNAM{{EXIT IF CALLED BY NAME
{{JSR{ACESS{{{ELSE GET VALUE FIRST
{{PPM{EXFAL{{{FAIL IF ACCESS FAILS
{{BRN{EXIXR{{{ELSE RETURN WITH VALUE IN XR
{{EJC{{{{
*
* MATCH -- INITIATE PATTERN MATCH
*
* (WB) MATCH TYPE CODE
* BRN MATCH JUMP TO INITIATE PATTERN MATCH
*
* MATCH CONTINUES BY EXECUTING THE PATTERN MATCH. SEE
* PATTERN MATCH ROUTINES (P$XXX) FOR FULL DETAILS.
*
{MATCH{RTN{{{{
{{MOV{(SP)+{R9{{LOAD PATTERN OPERAND
{{JSR{GTPAT{{{CONVERT TO PATTERN
{{ERR{240{PATTERN{{MATCH RIGHT OPERAND IS NOT PATTERN
{{MOV{R9{R10{{IF OK, SAVE PATTERN POINTER
{{BNZ{R7{MTCH1{{JUMP IF NOT MATCH BY NAME
{{MOV{(SP){R6{{ELSE LOAD NAME OFFSET
{{MOV{R10{-(SP){{SAVE PATTERN POINTER
{{MOV{4*2(SP){R10{{LOAD NAME BASE
{{JSR{ACESS{{{ACCESS SUBJECT VALUE
{{PPM{EXFAL{{{FAIL IF ACCESS FAILS
{{MOV{(SP){R10{{RESTORE PATTERN POINTER
{{MOV{R9{(SP){{STACK SUBJECT STRING VAL FOR MERGE
{{ZER{R7{{{RESTORE TYPE CODE
*
* MERGE HERE WITH SUBJECT VALUE ON STACK
*
{MTCH1{MOV{(SP){R9{{LOAD SUBJECT VALUE
{{ZER{R$PMB{{{ASSUME NOT A BUFFER
{{BNE{(R9){#B$BCT{MTCHA{BRANCH IF NOT
{{ICA{SP{{{ELSE POP VALUE
{{MOV{R9{R$PMB{{SAVE POINTER
{{MOV{4*BCLEN(R9){R6{{GET DEFINED LENGTH
{{MOV{4*BCBUF(R9){R9{{POINT TO BFBLK
{{BRN{MTCHB{{{
*
* HERE IF NOT BUFFER TO CONVERT TO STRING
*
{MTCHA{JSR{GTSTG{{{NOT BUFFER - CONVERT TO STRING
{{ERR{241{PATTERN{{MATCH LEFT OPERAND IS NOT STRING
*
* MERGE WITH BUFFER OR STRING
*
{MTCHB{MOV{R9{R$PMS{{IF OK, STORE SUBJECT STRING POINTER
{{MOV{R6{PMSSL{{AND LENGTH
{{MOV{R7{-(SP){{STACK MATCH TYPE CODE
{{ZER{-(SP){{{STACK INITIAL CURSOR (ZERO)
{{ZER{R7{{{SET INITIAL CURSOR
{{MOV{SP{PMHBS{{SET HISTORY STACK BASE PTR
{{ZER{PMDFL{{{RESET PATTERN ASSIGNMENT FLAG
{{MOV{R10{R9{{SET INITIAL NODE POINTER
{{BNZ{KVANC{MTCH2{{JUMP IF ANCHORED
*
* HERE FOR UNANCHORED
*
{{MOV{R9{-(SP){{STACK INITIAL NODE POINTER
{{MOV{#NDUNA{-(SP){{STACK POINTER TO ANCHOR MOVE NODE
{{BRI{(R9){{{START MATCH OF FIRST NODE
*
* HERE IN ANCHORED MODE
*
{MTCH2{ZER{-(SP){{{DUMMY CURSOR VALUE
{{MOV{#NDABO{-(SP){{STACK POINTER TO ABORT NODE
{{BRI{(R9){{{START MATCH OF FIRST NODE
{{EJC{{{{
*
* RETRN -- RETURN FROM FUNCTION
*
* (WA) STRING POINTER FOR RETURN TYPE
* BRN RETRN JUMP TO RETURN FROM (SNOBOL) FUNC
*
* RETRN CONTINUES BY EXECUTING THE CODE AT THE RETURN POINT
* THE STACK IS CLEANED OF ANY GARBAGE LEFT BY OTHER
* ROUTINES WHICH MAY HAVE ALTERED FLPTR SINCE FUNCTION
* ENTRY BY USING FLPRT, RESERVED FOR USE ONLY BY
* FUNCTION CALL AND RETURN.
*
{RETRN{RTN{{{{
{{BNZ{KVFNC{RTN01{{JUMP IF NOT LEVEL ZERO
{{ERB{242{FUNCTION{{RETURN FROM LEVEL ZERO
*
* HERE IF NOT LEVEL ZERO RETURN
*
{RTN01{MOV{FLPRT{SP{{POP STACK
{{ICA{SP{{{REMOVE FAILURE OFFSET
{{MOV{(SP)+{R9{{POP PFBLK POINTER
{{MOV{(SP)+{FLPTR{{POP FAILURE POINTER
{{MOV{(SP)+{FLPRT{{POP OLD FLPRT
{{MOV{(SP)+{R7{{POP CODE POINTER OFFSET
{{MOV{(SP)+{R8{{POP OLD CODE BLOCK POINTER
{{ADD{R8{R7{{MAKE OLD CODE POINTER ABSOLUTE
{{LCP{R7{{{RESTORE OLD CODE POINTER
{{MOV{R8{R$COD{{RESTORE OLD CODE BLOCK POINTER
{{DCV{KVFNC{{{DECREMENT FUNCTION LEVEL
{{MOV{KVTRA{R7{{LOAD TRACE
{{ADD{KVFTR{R7{{ADD FTRACE
{{BZE{R7{RTN06{{JUMP IF NO TRACING POSSIBLE
*
* HERE IF THERE MAY BE A TRACE
*
{{MOV{R6{-(SP){{SAVE FUNCTION RETURN TYPE
{{MOV{R9{-(SP){{SAVE PFBLK POINTER
{{MOV{R6{KVRTN{{SET RTNTYPE FOR TRACE FUNCTION
{{MOV{R$FNC{R10{{LOAD FNCLEVEL TRBLK PTR (IF ANY)
{{JSR{KTREX{{{EXECUTE POSSIBLE FNCLEVEL TRACE
{{MOV{4*PFVBL(R9){R10{{LOAD VRBLK PTR (SGD13)
{{BZE{KVTRA{RTN02{{JUMP IF TRACE IS OFF
{{MOV{4*PFRTR(R9){R9{{ELSE LOAD RETURN TRACE TRBLK PTR
{{BZE{R9{RTN02{{JUMP IF NOT RETURN TRACED
{{DCV{KVTRA{{{ELSE DECREMENT TRACE COUNT
{{BZE{4*TRFNC(R9){RTN03{{JUMP IF PRINT TRACE
{{MOV{#4*VRVAL{R6{{ELSE SET NAME OFFSET
{{MOV{4*1(SP){KVRTN{{MAKE SURE RTNTYPE IS SET RIGHT
{{JSR{TRXEQ{{{EXECUTE FULL TRACE
{{EJC{{{{
*
* RETRN (CONTINUED)
*
* HERE TO TEST FOR FTRACE
*
{RTN02{BZE{KVFTR{RTN05{{JUMP IF FTRACE IS OFF
{{DCV{KVFTR{{{ELSE DECREMENT FTRACE
*
* HERE FOR PRINT TRACE OF FUNCTION RETURN
*
{RTN03{JSR{PRTSN{{{PRINT STATEMENT NUMBER
{{MOV{4*1(SP){R9{{LOAD RETURN TYPE
{{JSR{PRTST{{{PRINT IT
{{MOV{#CH$BL{R6{{LOAD BLANK
{{JSR{PRTCH{{{PRINT IT
{{MOV{(SP){R10{{LOAD PFBLK PTR
{{MOV{4*PFVBL(R10){R10{{LOAD FUNCTION VRBLK PTR
{{MOV{#4*VRVAL{R6{{SET VRBLK NAME OFFSET
{{BNE{R9{#SCFRT{RTN04{JUMP IF NOT FRETURN CASE
*
* FOR FRETURN, JUST PRINT FUNCTION NAME
*
{{JSR{PRTNM{{{PRINT NAME
{{JSR{PRTNL{{{TERMINATE PRINT LINE
{{BRN{RTN05{{{MERGE
*
* HERE FOR RETURN OR NRETURN, PRINT FUNCTION NAME = VALUE
*
{RTN04{JSR{PRTNV{{{PRINT NAME = VALUE
*
* HERE AFTER COMPLETING TRACE
*
{RTN05{MOV{(SP)+{R9{{POP PFBLK POINTER
{{MOV{(SP)+{R6{{POP RETURN TYPE STRING
*
* MERGE HERE IF NO TRACE REQUIRED
*
{RTN06{MOV{R6{KVRTN{{SET RTNTYPE KEYWORD
{{MOV{4*PFVBL(R9){R10{{LOAD POINTER TO FN VRBLK
{{EJC{{{{
* RETRN (CONTINUED)
*
* GET VALUE OF FUNCTION
*
{RTN07{MOV{R10{RTNBP{{SAVE BLOCK POINTER
{{MOV{4*VRVAL(R10){R10{{LOAD VALUE
{{BEQ{(R10){#B$TRT{RTN07{LOOP BACK IF TRAPPED
{{MOV{R10{RTNFV{{ELSE SAVE FUNCTION RESULT VALUE
{{MOV{(SP)+{RTNSV{{SAVE ORIGINAL FUNCTION VALUE
{{MOV{(SP)+{R10{{POP SAVED POINTER
{{BZE{R10{RTN7C{{NO ACTION IF NONE
{{BZE{KVPFL{RTN7C{{JUMP IF NO PROFILING
{{JSR{PRFLU{{{ELSE PROFILE LAST FUNC STMT
{{BEQ{KVPFL{#NUM02{RTN7A{BRANCH ON VALUE OF PROFILE KEYWD
*
* HERE IF &PROFILE = 1. START TIME MUST BE FRIGGED TO
* APPEAR EARLIER THAN IT ACTUALLY IS, BY AMOUNT USED BEFORE
* THE CALL.
*
{{LDI{PFSTM{{{LOAD CURRENT TIME
{{SBI{4*ICVAL(R10){{{FRIG BY SUBTRACTING SAVED AMOUNT
{{BRN{RTN7B{{{AND MERGE
*
* HERE IF &PROFILE = 2
*
{RTN7A{LDI{4*ICVAL(R10){{{LOAD SAVED TIME
*
* BOTH PROFILE TYPES MERGE HERE
*
{RTN7B{STI{PFSTM{{{STORE BACK CORRECT START TIME
*
* MERGE HERE IF NO PROFILING
*
{RTN7C{MOV{4*FARGS(R9){R7{{GET NUMBER OF ARGS
{{ADD{4*PFNLO(R9){R7{{ADD NUMBER OF LOCALS
{{BZE{R7{RTN10{{JUMP IF NO ARGS/LOCALS
{{LCT{R7{R7{{ELSE SET LOOP COUNTER
{{ADD{4*PFLEN(R9){R9{{AND POINT TO END OF PFBLK
*
* LOOP TO RESTORE FUNCTIONS AND LOCALS
*
{RTN08{MOV{-(R9){R10{{LOAD NEXT VRBLK POINTER
*
* LOOP TO FIND VALUE BLOCK
*
{RTN09{MOV{R10{R6{{SAVE BLOCK POINTER
{{MOV{4*VRVAL(R10){R10{{LOAD POINTER TO NEXT VALUE
{{BEQ{(R10){#B$TRT{RTN09{LOOP BACK IF TRAPPED
{{MOV{R6{R10{{ELSE RESTORE LAST BLOCK POINTER
{{MOV{(SP)+{4*VRVAL(R10){{RESTORE OLD VARIABLE VALUE
{{BCT{R7{RTN08{{LOOP TILL ALL PROCESSED
*
* NOW RESTORE FUNCTION VALUE AND EXIT
*
{RTN10{MOV{RTNBP{R10{{RESTORE PTR TO LAST FUNCTION BLOCK
{{MOV{RTNSV{4*VRVAL(R10){{RESTORE OLD FUNCTION VALUE
{{MOV{RTNFV{R9{{RELOAD FUNCTION RESULT
{{MOV{R$COD{R10{{POINT TO NEW CODE BLOCK
{{MOV{KVSTN{KVLST{{SET LASTNO FROM STNO
{{MOV{4*CDSTM(R10){KVSTN{{RESET PROPER STNO VALUE
{{MOV{KVRTN{R6{{LOAD RETURN TYPE
{{BEQ{R6{#SCRTN{EXIXR{EXIT WITH RESULT IN XR IF RETURN
{{BEQ{R6{#SCFRT{EXFAL{FAIL IF FRETURN
{{EJC{{{{
*
* RETRN (CONTINUED)
*
* HERE FOR NRETURN
*
{{BEQ{(R9){#B$NML{RTN11{JUMP IF IS A NAME
{{JSR{GTNVR{{{ELSE TRY CONVERT TO VARIABLE NAME
{{ERR{243{FUNCTION{{RESULT IN NRETURN IS NOT NAME
{{MOV{R9{R10{{IF OK, COPY VRBLK (NAME BASE) PTR
{{MOV{#4*VRVAL{R6{{SET NAME OFFSET
{{BRN{RTN12{{{AND MERGE
*
* HERE IF RETURNED RESULT IS A NAME
*
{RTN11{MOV{4*NMBAS(R9){R10{{LOAD NAME BASE
{{MOV{4*NMOFS(R9){R6{{LOAD NAME OFFSET
*
* MERGE HERE WITH RETURNED NAME IN (XL,WA)
*
{RTN12{MOV{R10{R9{{PRESERVE XL
{{LCW{R7{{{LOAD NEXT WORD
{{MOV{R9{R10{{RESTORE XL
{{BEQ{R7{#OFNE${EXNAM{EXIT IF CALLED BY NAME
{{MOV{R7{-(SP){{ELSE SAVE CODE WORD
{{JSR{ACESS{{{GET VALUE
{{PPM{EXFAL{{{FAIL IF ACCESS FAILS
{{MOV{R9{R10{{IF OK, COPY RESULT
{{MOV{(SP){R9{{RELOAD NEXT CODE WORD
{{MOV{R10{(SP){{STORE RESULT ON STACK
{{MOV{(R9){R10{{LOAD ROUTINE ADDRESS
{{BRI{R10{{{JUMP TO EXECUTE NEXT CODE WORD
{{EJC{{{{
*
* STCOV -- SIGNAL STATEMENT COUNTER OVERFLOW
*
* BRN STCOV JUMP TO SIGNAL STATEMENT COUNT OFLO
*
* PERMIT UP TO 10 MORE STATEMENTS TO BE OBEYED SO THAT
* SETEXIT TRAP CAN REGAIN CONTROL.
* STCOV CONTINUES BY ISSUING THE ERROR MESSAGE
*
{STCOV{RTN{{{{
{{ICV{ERRFT{{{FATAL ERROR
{{LDI{INTVT{{{GET 10
{{ADI{KVSTL{{{ADD TO FORMER LIMIT
{{STI{KVSTL{{{STORE AS NEW STLIMIT
{{LDI{INTVT{{{GET 10
{{STI{KVSTC{{{SET AS NEW COUNT
{{ERB{244{STATEMENT{{COUNT EXCEEDS VALUE OF STLIMIT KEYWORD
{{EJC{{{{
*
* STMGO -- START EXECUTION OF NEW STATEMENT
*
* (XR) POINTER TO CDBLK FOR NEW STATEMENT
* BRN STMGO JUMP TO EXECUTE NEW STATEMENT
*
* STMGO CONTINUES BY EXECUTING THE NEXT STATEMENT
*
{STMGO{RTN{{{{
{{MOV{R9{R$COD{{SET NEW CODE BLOCK POINTER
{{BZE{KVPFL{STGO1{{SKIP IF NO PROFILING
{{JSR{PRFLU{{{ELSE PROFILE THE STATEMENT
{STGO1{MOV{KVSTN{KVLST{{SET LASTNO
{{MOV{4*CDSTM(R9){KVSTN{{SET STNO
{{ADD{#4*CDCOD{R9{{POINT TO FIRST CODE WORD
{{LCP{R9{{{SET CODE POINTER
{{LDI{KVSTC{{{GET STMT COUNT
{{ILT{EXITS{{{OMIT COUNTING IF NEGATIVE
{{IEQ{STCOV{{{FAIL IF STLIMIT REACHED
{{SBI{INTV1{{{DECREMENT
{{STI{KVSTC{{{REPLACE IT
{{BZE{R$STC{EXITS{{EXIT IF NO STCOUNT TRACE
*
* HERE FOR STCOUNT TRACE
*
{{ZER{R9{{{CLEAR GARBAGE VALUE IN XR
{{MOV{R$STC{R10{{LOAD POINTER TO STCOUNT TRBLK
{{JSR{KTREX{{{EXECUTE KEYWORD TRACE
{{BRN{EXITS{{{AND THEN EXIT FOR NEXT CODE WORD
{{EJC{{{{
*
* STOPR -- TERMINATE RUN
*
* (XR) POINTS TO ENDING MESSAGE
* BRN STOPR JUMP TO TERMINATE RUN
*
* TERMINATE RUN AND PRINT STATISTICS. ON ENTRY XR POINTS
* TO ENDING MESSAGE OR IS ZERO IF MESSAGE PRINTED ALREADY.
*
{STOPR{RTN{{{{
{{BZE{R9{STPRA{{SKIP IF SYSAX ALREADY CALLED (REG04)
{{JSR{SYSAX{{{CALL AFTER EXECUTION PROC
{STPRA{ADD{RSMEM{DNAME{{USE THE RESERVE MEMORY
{{BNE{R9{#ENDMS{STPR0{SKIP IF NOT NORMAL END MESSAGE
{{BNZ{EXSTS{STPR3{{SKIP IF EXEC STATS SUPPRESSED
{{ZER{ERICH{{{CLEAR ERRORS TO INT.CH. FLAG
*
* LOOK TO SEE IF AN ENDING MESSAGE IS SUPPLIED
*
{STPR0{JSR{PRTPG{{{EJECT PRINTER
{{BZE{R9{STPR1{{SKIP IF NO MESSAGE
{{JSR{PRTST{{{PRINT MESSAGE
*
* MERGE HERE IF NO MESSAGE TO PRINT
*
{STPR1{JSR{PRTIS{{{PRINT BLANK LINE
{{MTI{KVSTN{{{GET STATEMENT NUMBER
{{MOV{#STPM1{R9{{POINT TO MESSAGE /IN STATEMENT XXX/
{{JSR{PRTMX{{{PRINT IT
{{JSR{SYSTM{{{GET CURRENT TIME
{{SBI{TIMSX{{{MINUS START TIME = ELAPSED EXEC TIM
{{STI{STPTI{{{SAVE FOR LATER
{{MOV{#STPM3{R9{{POINT TO MSG /EXECUTION TIME MSEC /
{{JSR{PRTMX{{{PRINT IT
{{LDI{KVSTL{{{GET STATEMENT LIMIT
{{ILT{STPR2{{{SKIP IF NEGATIVE
{{SBI{KVSTC{{{MINUS COUNTER = COUNT
{{STI{STPSI{{{SAVE
{{MOV{#STPM2{R9{{POINT TO MESSAGE /STMTS EXECUTED/
{{JSR{PRTMX{{{PRINT IT
{{LDI{STPTI{{{RELOAD ELAPSED TIME
{{MLI{INTTH{{{*1000 (MICROSECS)
{{IOV{STPR2{{{JUMP IF WE CANNOT COMPUTE
{{DVI{STPSI{{{DIVIDE BY STATEMENT COUNT
{{IOV{STPR2{{{JUMP IF OVERFLOW
{{MOV{#STPM4{R9{{POINT TO MSG (MCSEC PER STATEMENT /
{{JSR{PRTMX{{{PRINT IT
{{EJC{{{{
*
* STOPR (CONTINUED)
*
* MERGE TO SKIP MESSAGE (OVERFLOW OR NEGATIVE STLIMIT)
*
{STPR2{MTI{GBCNT{{{LOAD COUNT OF COLLECTIONS
{{MOV{#STPM5{R9{{POINT TO MESSAGE /REGENERATIONS /
{{JSR{PRTMX{{{PRINT IT
{{JSR{PRTIS{{{ONE MORE BLANK FOR LUCK
*
* CHECK IF DUMP REQUESTED
*
{STPR3{JSR{PRFLR{{{PRINT PROFILE IF WANTED
*
{{MOV{KVDMP{R9{{LOAD DUMP KEYWORD
{{JSR{DUMPR{{{EXECUTE DUMP IF REQUESTED
{{MOV{R$FCB{R10{{GET FCBLK CHAIN HEAD
{{MOV{KVABE{R6{{LOAD ABEND VALUE
{{MOV{KVCOD{R7{{LOAD CODE VALUE
{{JSR{SYSEJ{{{EXIT TO SYSTEM
{{EJC{{{{
*
* SUCCP -- SIGNAL SUCCESSFUL MATCH OF A PATTERN NODE
*
* SEE PATTERN MATCH ROUTINES FOR DETAILS
*
* (XR) CURRENT NODE
* (WB) CURRENT CURSOR
* (XL) MAY BE NON-COLLECTABLE
* BRN SUCCP SIGNAL SUCCESSFUL PATTERN MATCH
*
* SUCCP CONTINUES BY MATCHING THE SUCCESSOR NODE
*
{SUCCP{RTN{{{{
{{MOV{4*PTHEN(R9){R9{{LOAD SUCCESSOR NODE
{{MOV{(R9){R10{{LOAD NODE CODE ENTRY ADDRESS
{{BRI{R10{{{JUMP TO MATCH SUCCESSOR NODE
{{EJC{{{{
*
* SYSAB -- PRINT /ABNORMAL END/ AND TERMINATE
*
{SYSAB{RTN{{{{
{{MOV{#ENDAB{R9{{POINT TO MESSAGE
{{MOV{#NUM01{KVABE{{SET ABEND FLAG
{{JSR{PRTNL{{{SKIP TO NEW LINE
{{BRN{STOPR{{{JUMP TO PACK UP
{{EJC{{{{
*
* SYSTU -- PRINT /TIME UP/ AND TERMINATE
*
{SYSTU{RTN{{{{
{{MOV{#ENDTU{R9{{POINT TO MESSAGE
{{MOV{STRTU{R6{{GET CHARS /TU/
{{MOV{R6{KVCOD{{PUT IN KVCOD
{{MOV{TIMUP{R6{{CHECK STATE OF TIMEUP SWITCH
{{MNZ{TIMUP{{{SET SWITCH
{{BNZ{R6{STOPR{{STOP RUN IF ALREADY SET
{{ERB{245{TRANSLATION/EXECUTION{{TIME EXPIRED
{{TTL{S{{{P I T B O L -- STACK OVERFLOW SECTION
*
* CONTROL COMES HERE IF THE MAIN STACK OVERFLOWS
*
{{SEC{{{{START OF STACK OVERFLOW SECTION
*
{{ICV{ERRFT{{{FATAL ERROR
{{MOV{FLPTR{SP{{POP STACK TO AVOID MORE FAILS
{{BNZ{GBCFL{STAK1{{JUMP IF GARBAGE COLLECTING
{{ERB{246{STACK{{OVERFLOW
*
* NO CHANCE OF RECOVERY IN MID GARBAGE COLLECTION
*
{STAK1{MOV{#ENDSO{R9{{POINT TO MESSAGE
{{ZER{KVDMP{{{MEMORY IS UNDUMPABLE
{{BRN{STOPR{{{GIVE UP
{{TTL{S{{{P I T B O L -- ERROR SECTION
*
* THIS SECTION OF CODE IS ENTERED WHENEVER A PROCEDURE
* RETURN VIA AN ERR PARAMETER OR AN ERB OPCODE IS OBEYED.
*
* (WA) IS THE ERROR CODE
*
* THE GLOBAL VARIABLE STAGE INDICATES THE POINT AT WHICH
* THE ERROR OCCURED AS FOLLOWS.
*
* STAGE=STGIC ERROR DURING INITIAL COMPILE
*
* STAGE=STGXC ERROR DURING COMPILE AT EXECUTE
* TIME (CODE, CONVERT FUNCTION CALLS)
*
* STAGE=STGEV ERROR DURING COMPILATION OF
* EXPRESSION AT EXECUTION TIME
* (EVAL, CONVERT FUNCTION CALL).
*
* STAGE=STGXT ERROR AT EXECUTE TIME. COMPILER
* NOT ACTIVE.
*
* STAGE=STGCE ERROR DURING INITIAL COMPILE AFTER
* SCANNING OUT THE END LINE.
*
* STAGE=STGXE ERROR DURING COMPILE AT EXECUTE
* TIME AFTER SCANNING END LINE.
*
* STAGE=STGEE ERROR DURING EXPRESSION EVALUATION
*
{{SEC{{{{START OF ERROR SECTION
*
{ERROR{BEQ{R$CIM{#CMLAB{CMPLE{JUMP IF ERROR IN SCANNING LABEL
{{MOV{R6{KVERT{{SAVE ERROR CODE
{{ZER{SCNRS{{{RESET RESCAN SWITCH FOR SCANE
{{ZER{SCNGO{{{RESET GOTO SWITCH FOR SCANE
{{MOV{STAGE{R9{{LOAD CURRENT STAGE
{{BSW{R9{STGNO{{JUMP TO APPROPRIATE ERROR CIRCUIT
{{IFF{STGIC{ERR01{{INITIAL COMPILE
{{IFF{STGXC{ERR04{{EXECUTE TIME COMPILE
{{IFF{STGEV{ERR04{{EVAL COMPILING EXPR.
{{IFF{STGXT{ERR05{{EXECUTE TIME
{{IFF{STGCE{ERR01{{COMPILE - AFTER END
{{IFF{STGXE{ERR04{{XEQ COMPILE-PAST END
{{IFF{STGEE{ERR04{{EVAL EVALUATING EXPR
{{ESW{{{{END SWITCH ON ERROR TYPE
{{EJC{{{{
*
* ERROR DURING INITIAL COMPILE
*
* THE ERROR MESSAGE IS PRINTED AS PART OF THE COMPILER
* OUTPUT. THIS PRINTOUT INCLUDES THE OFFENDING LINE (IF NOT
* PRINTED ALREADY) AND AN ERROR FLAG UNDER THE APPROPRIATE
* COLUMN AS INDICATED BY SCNSE UNLESS SCNSE IS SET TO ZERO.
*
* AFTER PRINTING THE MESSAGE, THE GENERATED CODE IS
* MODIFIED TO AN ERROR CALL AND CONTROL IS RETURNED TO
* THE CMPIL PROCEDURE AFTER RESETTING THE STACK POINTER.
*
* IF THE ERROR OCCURS AFTER THE END LINE, CONTROL RETURNS
* IN A SLIGHTLY DIFFERENT MANNER TO ENSURE PROPER CLEANUP.
*
{ERR01{MOV{CMPXS{SP{{RESET STACK POINTER
{{SSL{CMPSS{{{RESTORE S-R STACK PTR FOR CMPIL
{{BNZ{ERRSP{ERR03{{JUMP IF ERROR SUPPRESS FLAG SET
{{MOV{ERICH{ERLST{{SET FLAG FOR LISTR
{{JSR{LISTR{{{LIST LINE
{{JSR{PRTIS{{{TERMINATE LISTING
{{ZER{ERLST{{{CLEAR LISTR FLAG
{{MOV{SCNSE{R6{{LOAD SCAN ELEMENT OFFSET
{{BZE{R6{ERR02{{SKIP IF NOT SET
{{LCT{R7{R6{{LOOP COUNTER
{{ICV{R6{{{INCREASE FOR CH$EX
{{JSR{ALOCS{{{STRING BLOCK FOR ERROR FLAG
{{MOV{R9{R6{{REMEMBER STRING PTR
{{PSC{R9{{{READY FOR CHARACTER STORING
{{MOV{R$CIM{R10{{POINT TO BAD STATEMENT
{{PLC{R10{{{READY TO GET CHARS
*
* LOOP TO REPLACE ALL CHARS BUT TABS BY BLANKS
*
{ERRA1{LCH{R8{(R10)+{{GET NEXT CHAR
{{BEQ{R8{#CH$HT{ERRA2{SKIP IF TAB
{{MOV{#CH$BL{R8{{GET A BLANK
{{EJC{{{{
*
* MERGE TO STORE BLANK OR TAB IN ERROR LINE
*
{ERRA2{SCH{R8{(R9)+{{STORE CHAR
{{BCT{R7{ERRA1{{LOOP
{{MOV{#CH$EX{R10{{EXCLAMATION MARK
{{SCH{R10{(R9){{STORE AT END OF ERROR LINE
{{CSC{R9{{{END OF SCH LOOP
{{MOV{#STNPD{PROFS{{ALLOW FOR STATEMENT NUMBER
{{MOV{R6{R9{{POINT TO ERROR LINE
{{JSR{PRTST{{{PRINT ERROR LINE
*
* HERE AFTER PLACING ERROR FLAG AS REQUIRED
*
{ERR02{JSR{ERMSG{{{GENERATE FLAG AND ERROR MESSAGE
{{ADD{#NUM03{LSTLC{{BUMP PAGE CTR FOR BLANK, ERROR, BLK
{{ZER{R9{{{IN CASE OF FATAL ERROR
{{BHI{ERRFT{#NUM03{STOPR{PACK UP IF SEVERAL FATALS
*
* COUNT ERROR, INHIBIT EXECUTION IF REQUIRED
*
{{ICV{CMERC{{{BUMP ERROR COUNT
{{ADD{CSWER{NOXEQ{{INHIBIT XEQ IF -NOERRORS
{{BNE{STAGE{#STGIC{CMP10{SPECIAL RETURN IF AFTER END LINE
{{EJC{{{{
*
* LOOP TO SCAN TO END OF STATEMENT
*
{ERR03{MOV{R$CIM{R9{{POINT TO START OF IMAGE
{{PLC{R9{{{POINT TO FIRST CHAR
{{LCH{R9{(R9){{GET FIRST CHAR
{{BEQ{R9{#CH$MN{CMPCE{JUMP IF ERROR IN CONTROL CARD
{{ZER{SCNRS{{{CLEAR RESCAN FLAG
{{MNZ{ERRSP{{{SET ERROR SUPPRESS FLAG
{{JSR{SCANE{{{SCAN NEXT ELEMENT
{{BNE{R10{#T$SMC{ERR03{LOOP BACK IF NOT STATEMENT END
{{ZER{ERRSP{{{CLEAR ERROR SUPPRESS FLAG
*
* GENERATE ERROR CALL IN CODE AND RETURN TO CMPIL
*
{{MOV{#4*CDCOD{CWCOF{{RESET OFFSET IN CCBLK
{{MOV{#OCER${R6{{LOAD COMPILE ERROR CALL
{{JSR{CDWRD{{{GENERATE IT
{{MOV{CWCOF{4*CMSOC(SP){{SET SUCCESS FILL IN OFFSET
{{MNZ{4*CMFFC(SP){{{SET FAILURE FILL IN FLAG
{{JSR{CDWRD{{{GENERATE SUCC. FILL IN WORD
{{BRN{CMPSE{{{MERGE TO GENERATE ERROR AS CDFAL
*
* ERROR DURING EXECUTE TIME COMPILE OR EXPRESSION EVALUATIO
*
* EXECUTE TIME COMPILATION IS INITIATED THROUGH GTCOD OR
* GTEXP WHICH ARE CALLED BY COMPILE, CODE OR EVAL.
* BEFORE CAUSING STATEMENT FAILURE THROUGH EXFAL IT IS
* HELPFUL TO SET KEYWORD ERRTEXT AND FOR GENERALITY
* THESE ERRORS MAY BE HANDLED BY THE SETEXIT MECHANISM.
*
{ERR04{ZER{R$CCB{{{FORGET GARBAGE CODE BLOCK
{{SSL{INISS{{{RESTORE MAIN PROG S-R STACK PTR
{{JSR{ERTEX{{{GET FAIL MESSAGE TEXT
{{DCA{SP{{{ENSURE STACK OK ON LOOP START
*
* POP STACK UNTIL FIND FLPTR FOR MOST DEEPLY NESTED PROG.
* DEFINED FUNCTION CALL OR CALL OF EVAL / CODE.
*
{ERRA4{ICA{SP{{{POP STACK
{{BEQ{SP{FLPRT{ERRC4{JUMP IF PROG DEFINED FN CALL FOUND
{{BNE{SP{GTCEF{ERRA4{LOOP IF NOT EVAL OR CODE CALL YET
{{MOV{#STGXT{STAGE{{RE-SET STAGE FOR EXECUTE
{{MOV{R$GTC{R$COD{{RECOVER CODE PTR
{{MOV{SP{FLPTR{{RESTORE FAIL POINTER
{{ZER{R$CIM{{{FORGET POSSIBLE IMAGE
*
* TEST ERRLIMIT
*
{ERRB4{BNZ{KVERL{ERR07{{JUMP IF ERRLIMIT NON-ZERO
{{BRN{EXFAL{{{FAIL
*
* RETURN FROM PROG. DEFINED FUNCTION IS OUTSTANDING
*
{ERRC4{MOV{FLPTR{SP{{RESTORE STACK FROM FLPTR
{{BRN{ERRB4{{{MERGE
{{EJC{{{{
*
* ERROR AT EXECUTE TIME.
*
* THE ACTION TAKEN ON AN ERROR IS AS FOLLOWS.
*
* IF ERRLIMIT KEYWORD IS ZERO, AN ABORT IS SIGNALLED,
* SEE CODING FOR SYSTEM LABEL ABORT AT L$ABO.
*
* OTHERWISE, ERRLIMIT IS DECREMENTED AND AN ERRTYPE TRACE
* GENERATED IF REQUIRED. CONTROL RETURNS EITHER VIA A JUMP
* TO CONTINUE (TO TAKE THE FAILURE EXIT) OR A SPECIFIED
* SETEXIT TRAP IS EXECUTED AND CONTROL PASSES TO THE TRAP.
* IF 3 OR MORE FATAL ERRORS OCCUR AN ABORT IS SIGNALLED
* REGARDLESS OF ERRLIMIT AND SETEXIT - LOOPING IS ALL TOO
* PROBABLE OTHERWISE. FATAL ERRORS INCLUDE STACK OVERFLOW
* AND EXCEEDING STLIMIT.
*
{ERR05{SSL{INISS{{{RESTORE MAIN PROG S-R STACK PTR
{{BNZ{DMVCH{ERR08{{JUMP IF IN MID-DUMP
*
* MERGE HERE FROM ERR08
*
{ERR06{BZE{KVERL{LABO1{{ABORT IF ERRLIMIT IS ZERO
{{JSR{ERTEX{{{GET FAIL MESSAGE TEXT
*
* MERGE FROM ERR04
*
{ERR07{BGE{ERRFT{#NUM03{LABO1{ABORT IF TOO MANY FATAL ERRORS
{{DCV{KVERL{{{DECREMENT ERRLIMIT
{{MOV{R$ERT{R10{{LOAD ERRTYPE TRACE POINTER
{{JSR{KTREX{{{GENERATE ERRTYPE TRACE IF REQUIRED
{{MOV{R$COD{R$CNT{{SET CDBLK PTR FOR CONTINUATION
{{MOV{FLPTR{R9{{SET PTR TO FAILURE OFFSET
{{MOV{(R9){STXOF{{SAVE FAILURE OFFSET FOR CONTINUE
{{MOV{R$SXC{R9{{LOAD SETEXIT CDBLK POINTER
{{BZE{R9{LCNT1{{CONTINUE IF NO SETEXIT TRAP
{{ZER{R$SXC{{{ELSE RESET TRAP
{{MOV{#NULLS{STXVR{{RESET SETEXIT ARG TO NULL
{{MOV{(R9){R10{{LOAD PTR TO CODE BLOCK ROUTINE
{{BRI{R10{{{EXECUTE FIRST TRAP STATEMENT
*
* INTERRUPTED PARTLY THROUGH A DUMP WHILST STORE IS IN A
* MESS SO DO A TIDY UP OPERATION. SEE DUMPR FOR DETAILS.
*
{ERR08{MOV{DMVCH{R9{{CHAIN HEAD FOR AFFECTED VRBLKS
{{BZE{R9{ERR06{{DONE IF ZERO
{{MOV{(R9){DMVCH{{SET NEXT LINK AS CHAIN HEAD
{{JSR{SETVR{{{RESTORE VRGET FIELD
{{BRN{ERR08{{{LOOP THROUGH CHAIN
{{TTL{S{{{P I T B O L -- HERE ENDETH THE CODE
*
* END OF ASSEMBLY
*
{{END{{{{END MACRO-SPITBOL ASSEMBLY