V10/cmd/spitbol/4.3/diff.out
1,4c1,6
< 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
< * -------------------------------
---
> * CHANGES [SGD]
> * -------------
> * 1. COMMENTED OUT DEFAULT .DEF, .UNDEF AS THESE MACHINE-
> * DEPENDENT. I SUGGEST AGAIN THAT THESE DO NOT BELONG
> * IN MINIMAL SOURCE, UNLESS SOMETHING OF THE FORM .*DEF
> * IS TO BE INCORPORTATED INTO MINIMAL LANGUAGE DEFN.
5a8,11
> * 2. NOTED THAT DESCRIPTION OF BEV, BOD MISSING FROM
> * SBL42.CMT MINIMAL DESCRIPTION, AND DISCUSSION OF
> * "ODD"/"EVEN" AND REQUIREMENTS PERTAINING THERETO
> * SEEMS INSUFFICIENT.
7,8c13,21
< * VERSION 3.5B (FEB 81... - SGD PATCHES)
< * -----------------------------------
---
> * 3. PERMIT CODE KEYWORD TO CONTAIN ANY INTEGER VALUE.
> * THIS CONSISTS OF REMOVING THE ENFORCED RESTRICTION
> * IN ASIGN (SEE ASG24), SINCE CODE CONTAINS NO RELOC.
> * USE OF KEYWORD VALUE (AS IT SHOULDNT). SBL DOC.
> * MUST BE UPDATED. ADDRESS OF CODE VALUE NOW PASSED TO
> * OSINT (KVCOD), INSTEAD OF VALUE ITSELF. HENCE OSINT
> * DOCUMENTATION MUST LIKEWISE BE REVISED. CHANGES
> * MADE IN KEYWORD DEFINITION TABLES, PROCEDURES ACESS
> * AND ASIGN SINCE CODE NOW SPECIAL KEYWORD.
10,42c23,24
< * 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).
---
> * EROSI RETURNS NOW CONTAIN NEW CODE KEYWORD VALUE IN
> * IA. OSINT DOCUMENTATION MUST BE REVISED.
44,48c26,29
< * 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
---
> * INTERESTINGLY, THIS SHOULD PERMIT THE SPITBOL PROGRAM
> * TO INTERROGATE THE CODE KEYWORD AT THE START OF
> * EXECUTION TO DETERMINE IF COMPILATION ERRORS
> * OCCURRED.
50,51c31,46
< * REG02 - (XX-SEP-82)
< * CHANGED INILN AND AND INILS TO 258
---
> * 4. ADD -COPY "FILETAG" CONTROL CARD. -COPY PERMITTED IN
> * CODE STRINGS. NESTING IS PERMITTED TO ANY LEVEL,
> * THOUGH OSINT IS FREE TO RESTRICT THE MAXIMUM LEVEL.
> * NOTE REQUIREMENT FOR FILETAG SPECIFIED AS
> * STRING CONSTANT SINCE FILETAGS MAY CONTAIN SEMICOLONS.
> * I HAVE TRIED TO MAKE THIS ENHANCEMENT WITH MINIMUM
> * (MINIMAL?) AMOUNT OF NEW CODE, SO THE FEATURE IS
> * NOT CONDITIONALIZED. THE SOLUTION
> * REQUIRED THE ADDITION OF A NEW BLOCK TYPE (COBLK) TO
> * BUILD THE INPUT CONTEXT SAVE STACK AS A CHAIN OF
> * COBLKS. A RECUSIVE SOLUTION ON CMPIL/READR/NEXTS
> * WOULD HAVE REQUIRED EXTENSIVE MODIFICATIONS AND
> * SUBSTANTIAL NEW CODE. NOTE THAT FORMS SUCH AS
> * CODE('-COPY "FILE.SBL"') ARE ACCEPTABLE, WHICH IS
> * VIEWED AS SIGNIFICANT ENHANCEMENT IN ADDITION TO
> * COMPILE-TIME INCLUDE.
53,59c48,50
< * 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.
---
> * TO SUPPORT THIS FEATURE, TWO NEW OSINT ROUTINES ARE
> * DEFINED, SYSSC (START COPY) AND SYSEC (END COPY) WITH
> * LOGICS DESCRIBED IN THE .CMT FILE.
61,63c52,57
< * REG04 - (XX-NOV-82)
< * FIXED DIFFICULTIES WITH LISTINGS DURING EXECUTION
< * WHEN NO LISTING GENERATED DURING COMPILATION.
---
> * BECAUSE OF ANNOYANCE FACTOR, SOURCE LISTING OF
> * CODE() INFO VIA -LIST, INCLUDING -COPY INPUT, IS
> * NO LONGER POSSIBLE. IF THIS IS PERMITTED, THEN
> * ONE FINDS -COPY INPUT BEING PRINTED ON STD.
> * OUTPUT CHANNEL (DEPENDING ON STATE OF -LIST),
> * UNLESS EXPLICIT -NOLIST IS GIVEN.
65,67c59,63
< * -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)
---
> * 5. THE DOCUMENTATION FOR SYSIO IS INCONSISTENT. IT
> * SHOWS 0,1,2,3 BEING POSSIBLE INPUTS DEPENDING ON
> * INPUT/OUTPUT, STD/NONSTD. HOWEVER, IT ALSO APPEARS
> * (AND IS STATED) THAT SYSIO IS NOT CALLED FOR STD
> * INPUT/OUTPUT.
69,224c65,67
< * 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
---
> * 6. SINCE -PRINT,-NOPRINT REMOVED IN V4, I HAVE
> * REINSTATED THE CIRCUIT IN NEXTS TO AVOID LISTING
> * CONTROL CARDS (-COPY FORCES LIST IN CNCRD THOUGH).
226c69,70
< * TABLE TBBLK
---
> * 7. WA NOW CONTAINS THE INITIAL VALUE OF &CODE ON ENTRY
> * TO SPITBOL.
228,229c72,77
< * PROGRAM DATATYPE PDBLK
< EJC
---
> * 8. ADDED DDC (DEFINE DISPLAY CONSTANT). IS IDENTICAL
> * TO DTC EXCEPT THAT ON SYSTEMS SUPPORTING LOWER CASE,
> * THE DISPLAY TEXT CAN BE TRANSLATED WITH A
> * CASE MIX. FOR EXAMPLE, CAPITALIZE ONLY THE FIRST
> * LETTER, OR THE FIRST LETTER OF EVERY WORD, OR NO
> * UPPER CASE (FOR EUNICHS), ETC.
231,232c79,81
< * REPRESENTATION OF VARIABLES
< * ---------------------------
---
> * 9. FIX MINOR OVERSIGHT IN FAILING TO CLEAR R$PMB AT
> * END OF PATTERN MATCH, THUS LEAVING PTR TO BCBLK
> * THAT CANNOT BE COLLECTED.
234,238c83,92
< * 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.
---
> * 10. AFTER CONSULTATION WITH DAVE SHIELDS, IT WAS AGREED
> * TO REINSTATE ARG,FIELD,ITEM AND LOCAL FUNCTIONS.
> * COMMENTS WERE RECEIVED THAT REMOVING THEM BREAKS
> * EXISTING CODE IN DIFFICULT-TO-FIX WAYS, INCLUDING
> * A NUMBER OF THE UTILITY ROUTINES IN GIMPELS BOOK.
> * IN ANY EVENT, THESE ARE SNOBOL4 COMPATIBILITY
> * FUNCTIONS THAT TAKE LITTLE CODE SPACE. AS A
> * RESULT OF THIS, AND -COPY, ERROR NUMBERS HAVE
> * BEEN PUSHED BACK OVER THE 255 THRESHOLD, WHICH
> * SEEMS UNAVOIDABLE UNLESS MAJOR SURGERY IS DONE.
240,250c94,95
< * 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.
---
> * 11. VERSION ID CHANGED TO V4.3 DUE TO SUBSTANTIAL
> * CHANGES.
252,253c97,98
< * THE FOLLOWING ARE THE INSTANCES OF VARIABLES REPRESENTED
< * IN THIS MANNER.
---
> * 12. PERMIT DOLLAR SIGN IN VARIABLE NAMES. MINOR
> * CHANGE TO OPERATOR TABLE AND SCANE.
255,256c100,103
< * 1) NATURAL VARIABLE BASE IS PTR TO VRBLK
< * OFFSET IS *VRVAL
---
> * 13. PERMIT BUFFER TYPE FOR LOAD SPECIFICATION. AS
> * A SIDE-EFFECT, THE CODE FOR BUFFER CONVERSION HAS
> * BEEN CENTRALIZED IN GTBUF. ALSO FIXED PADDING
> * BUG IN INSBF RELATED TO ZERO PADDING.
258,259c105,108
< * 2) TABLE ELEMENT BASE IS PTR TO TEBLK
< * OFFSET IS *TEVAL
---
> * 14. DOCUMENT THAT SYSIL MUST NEVER REQUEST ZERO BYTES.
> * DOING SO CAUSES ACESS TO POTENTIALLY CREATE
> * INVALID MEMORY CAUSING LATER GARBAGE COLLECTOR
> * PROBLEMS OR MISADJUSTMENTS OF DNAMP, ETC.
261,262c110,112
< * 3) ARRAY ELEMENT BASE IS PTR TO ARBLK
< * OFFSET IS OFFSET TO ELEMENT
---
> * 15. VDIFFER FUNCTION ADDED. VDIFFER(X,Y) RETURNS X
> * IF DIFFERENT FROM Y. IN MOST CASES IT IS EXPECTED
> * THAT Y WOULD BE NULL.
264,281c114
< * 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.
---
> SEC FORMAL START OF PROCEDURES SECTION
284,411d116
< * 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
< *
416,422c121,134
< * 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.
---
> * ASSEMBLY SYMBOLS ARE REFERRED TO.
> * A PARTICULAR SET OF DEFAULT SETTINGS IS GIVEN IN THIS
> * SOURCE BY USE OF .DEF AND .UNDEF PSEUDO OPS.
> * A DIFFERENT SELECTION MAY BE MADE BY VARYING THE
> * DEFINITIONS. AS AN ALTERNATIVE, THIS SECTION MAY BE
> * COMMENTED OUT AND THE MINIMAL TRANSLATOR PRELOADED WITH
> * THE SELECTED DEFINITIONS, THUS ALLOWING A MORE DYNAMIC
> * CHOICE TO BE MADE.
> * SOME OF THE CONDITIONAL FEATURES CHOOSE AMONGST A VARIETY
> * OF OPTIONS. OTHERS ARE DEFINED PRINCIPALLY TO ALLOW
> * OMISSION OF A FEATURE WHICH IS NOT WANTED IN ORDER TO
> * SAVE MEMORY OR BECAUSE IT CANNOT BE SUPPORTED.
> * NOTE THAT IF .CPLC OPTION IS CHOSEN, TRANSLATION OF DTC,
> * ERR, ERB ARGUMENTS SHOULD BE TO LOWER CASE.
424,505c136,158
< * .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
< .DEF .CASL
< .DEF .CAHT
< .DEF .CIOD
< .DEF .CSAX
< .DEF .CSN8
< .DEF .CUCF
< .DEF .CUEJ
< .DEF .CULC
< .DEF .CUST
< 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
< .IF .CSAX
< 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
---
> *.DEF .CAHT DEFINE TO INCLUDE HORIZONTAL TAB
> *.DEF .CASL DEFINE TO INCLUDE 26 SHIFTED LETTRS
> *.DEF .CAVT DEFINE TO INCLUDE VERTICAL TAB
> *.UNDEF .CEPP DEFINE FOR ODD PARITY ENTRY POINTS
> *.UNDEF .CNBF DEFINE TO OMIT BUFFER EXTENSION
> *.UNDEF .CNBT DEFINE TO OMIT BATCH INITIALISATION
> *.UNDEF .CNEX DEFINE TO OMIT EXIT() CODE
> *.UNDEF .CNFN DEFINE TO OMIT FENCE() CODE
> *.UNDEF .CNLD DEFINE TO OMIT LOAD() CODE
> *.UNDEF .CNPF DEFINE TO OMIT PROFILE CODE
> *.UNDEF .CNRA DEFINE TO OMIT ALL REAL ARITHMETIC
> *.UNDEF .CNSR DEFINE TO OMIT SORT, RSORT CODE
> *.DEF .CPLC DEFINE IF HOST PREFERS LOWER CASE
> *.UNDEF .CRPP DEFINE FOR ODD PARITY RETURN POINTS
> *.UNDEF .CS16 DEFINE TO INITIALIZE STLIM TO 32767
> *.UNDEF .CSAX DEFINE IF SYSAX IS TO BE CALLED
> *.UNDEF .CSCI DEFINE TO ENABLE SYSCI ROUTINE
> *.UNDEF .CSCV DEFINE FOR CLU, CUL CASE CONVERSION
> *.DEF .CSIG DEFINE TO IGNORE CASE OF LETTERS
> *.UNDEF .CSN6 DEFINE TO PAD STMT NOS TO 6 CHARS
> *.DEF .CSN8 DEFINE TO PAD STMT NOS TO 8 CHARS
> *.UNDEF .CTMD DEFINE IF SYSTM UNIT IS DECISECOND
> .IF .CASL
506a160,161
> .UNDEF .CSIG .CSIG USELESS WITHOUT LC LETTERS
> .UNDEF .CPLC .CPLC ERRONEOUS WITHOUT LC LETTERS
510c165
< * SYSBX -- BEFORE EXECUTION
---
> * ACTUAL PROCESSABLE EXP PROCEDURE DEFINITIONS
512,547c167,169
< 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
< .IF .CNCI
< *
< * SYSCI -- CONVERT INTEGER
< *
< SYSCI EXP
< *
< * SYSCI IS AN OPTIONAL OSINT ROUTINE THAT CAUSES SPITBOL TO
< * CALL SYSCI TO CONVERT INTEGER VALUES TO STRINGS, RATHER
< * THAN USING SPITBOL'S OWN INTERNAL CONVERSION CODE. THIS
< * CODE MAY BE LESS EFFICIENT ON MACHINES WITH HARDWARE
< * CONVERSION INSTRUCTIONS AND IN SUCH CASES, IT MAY BE AN
< * ADVANTAGE TO INCLUDE SYSCI. THE SYMBOL .CNCI MUST BE
< * DEFINED IF THIS ROUTINE IS TO BE USED.
< *
< * THE RULES FOR CONVERTING INTEGERS TO STRINGS ARE THAT
< * POSITIVE VALUES ARE REPRESENTED WITHOUT ANY SIGN, AND
< * THERE ARE NEVER ANY LEADING BLANKS OR ZEROS, EXCEPT IN
< * THE CASE OF ZERO ITSELF WHICH IS REPRESENTED AS A SINGLE
< * ZERO DIGIT. NEGATIVE NUMBERS ARE REPRESENTED WITH A
< * PRECEEDING MINUS SIGN. THERE ARE NEVER ANY TRAILING
< * BLANKS, AND CONVERSION CANNOT FAIL.
< *
< * (IA) VALUE TO BE CONVERTED
< * JSR SYSCI CALL TO CONVERT INTEGER VALUE
< * (XL) POINTER TO PSEUDO-SCBLK WITH STRING
< EJC
---
> .IF .CSAX
> SYSAX EXP E,0
> .ELSE
549,1250c171,203
< *
< * 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
---
> SYSBX EXP E,0
> .IF .CSCI
> SYSCI EXP E,0
> .FI
> SYSDT EXP E,0
> SYSEC EXP E,2
> SYSEF EXP E,2
> SYSEJ EXP E,0
> SYSEM EXP E,0
> SYSEN EXP E,2
> SYSEP EXP E,2
> .IF .CNLD
> .ELSE
> SYSEX EXP E,1
> .FI
> SYSHS EXP E,2
> SYSID EXP E,0
> SYSIL EXP E,0
> SYSIN EXP E,2
> SYSIO EXP E,2
> .IF .CNLD
> .ELSE
> SYSLD EXP E,2
> .FI
> SYSMM EXP E,0
> SYSMX EXP E,0
> SYSOU EXP E,2
> SYSPI EXP E,2
> SYSPP EXP E,0
> SYSPR EXP E,2
> SYSRD EXP E,2
> SYSRI EXP E,2
> SYSSC EXP E,2
1252,1272c205
< *
< * 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
---
> SYSST EXP E,2
1274,1316c207,212
< *
< * 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).
---
> SYSTM EXP E,0
> SYSTT EXP E,0
> .IF .CNLD
> .ELSE
> SYSUL EXP E,0
> .FI
1319,1405c215
< 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.
---
> SYSXI EXP E,2
1407a218
> * NAME GLOBAL LABELS, INTERNAL PROCEDURES AND ROUTINES.
1409,1410c220,228
< * INTRODUCE THE INTERNAL PROCEDURES.
< *
---
> CMPCE GLB
> CMPEL GLB
> CMPLE GLB
> CMPSE GLB
> EVLXF GLB
> EVLXN GLB
> EVLXV GLB
> LCNXE GLB
> TRXQR GLB
1420d237
< APNDB INP E,2
1428a246
> CBLCK INP N,1
1437c255
< COPYB INP N,1
---
> COPND INP E,0
1439d256
< DTACH INP E,0
1444c261
< EVALI INP R,4
---
> EVALI INP R,3
1446c263
< EVALS INP R,3
---
> EVALS INP R,2
1453,1455d269
< .IF .CULC
< FLSTG INP R,0
< .FI
1458a273,276
> .IF .CNBF
> .ELSE
> GTBUF INP E,1
> .FI
1481,1483c299,300
< IOFCB INP N,2
< IOPPF INP N,0
< IOPUT INP N,6
---
> IOFTG INP N,1
> IOPUT INP N,4
1500a318
> PRTCF INP E,0
1502,1503c320,321
< PRTIC INP E,0
< PRTIS INP E,0
---
> PRTFB INP E,0
> PRTFH INP R,0
1506,1507d323
< PRTMX INP E,0
< PRTNL INP R,0
1511a328
> PRTSF INP E,0
1515c332
< PRTTR INP E,0
---
> PRTVF INP E,0
1517a335,336
> PTTFH INP E,0
> PTTST INP E,0
1522a342,345
> .IF .CASL
> SBSCC INP E,0
> SBSTG INP E,0
> .FI
1529c352
< SORTA INP N,0
---
> SORTA INP N,1
1532c355
< SORTH INP E,0
---
> SORTH INP N,0
1535c358
< TRACE INP N,2
---
> TRACE INP N,3
1536a360
> TRCHN INP E,1
1541,1543d364
< *
< * INTRODUCE THE INTERNAL ROUTINES
< *
1545a367,368
> EROSI INR
> ERROR INR
1560a384
> INITL INR
1562a387
> STAKV INR
1567,1568d391
< SYSAB INR
< SYSTU INR
1569a393,395
> * THIS SECTION CONTAINS ALL SYMBOL DEFINITIONS AND ALSO
> * PICTURES OF ALL DATA STRUCTURES USED IN THE SYSTEM.
> *
1577a404,407
> * NOTE THAT EVEN IF CONDITIONAL ASSEMBLY IS USED TO OMIT
> * SOME FEATURE (E.G. REAL ARITHMETIC) A FULL SET OF CFP$-
> * VALUES MUST BE SUPPLIED. USE DUMMY VALUES IF GENUINE
> * ONES ARE NOT NEEDED.
1581c411
< CFP$B EQU * BYTES/WORD ADDRESSING FACTOR
---
> CFP$B EQU * BAUS/WORD ADDRESSING FACTOR
1585c415
< CFP$F EQU * OFFSET IN BYTES TO CHARS IN
---
> CFP$F EQU * OFFSET IN BAUS TO CHARS IN
1594,1601d423
< * THE FOLLOWING DEFINITIONS REQUIRE THE SUPPLY OF EITHER
< * A SINGLE PARAMETER IF REAL ARITHMETIC IS OMITTED OR
< * THREE PARAMETERS IF REAL ARITHMETIC IS INCLUDED.
< *
< .IF .CNRA
< NSTMX EQU * NO. OF DECIMAL DIGITS IN CFP$M
< .ELSE
< *
1606,1613d427
< 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+)
< .FI
< .IF .CUCF
< *
1620c434,439
< .FI
---
> *
> 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+)
1759a579
> * THEY ARE ALL UNDER CONDITIONAL ASSEMBLY.
1798a619,620
> .IF .CASL
> DFA$A EQU CH$$A-CH$LA DIFF BETWEEN LC AND UC LETTERS
1800,1807d621
< * 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.
< *
< .IF .CIOD
< IODEL EQU *
< .ELSE
< IODEL EQU CH$CM
1927c741,742
< BL$CT EQU BL$CM+1 CTBLK
---
> BL$CO EQU BL$CM+1 COBLK
> BL$CT EQU BL$CO+1 CTBLK
2030,2033d844
< .IF .CNBF
< .ELSE
< * BCBLK BUFFER CONTROL BLOCK
< .FI
2079c890
< ARLEN EQU IDVAL+1 LENGTH OF ARBLK IN BYTES
---
> ARLEN EQU IDVAL+1 LENGTH OF ARBLK IN BAUS
2096c907
< * THE LENGTH OF AN ARBLK IN BYTES MAY NOT EXCEED MXLEN.
---
> * THE LENGTH OF AN ARBLK IN BAUS MAY NOT EXCEED MXLEN.
2103c914
< *
---
> EJC
2197,2198c1008,1009
< CCLEN EQU CCTYP+1 LENGTH OF CCBLK IN BYTES
< CCUSE EQU CCLEN+1 OFFSET PAST LAST USED WORD (BYTES)
---
> CCLEN EQU CCTYP+1 LENGTH OF CCBLK IN BAUS
> CCUSE EQU CCLEN+1 OFFSET PAST LAST USED WORD (BAUS)
2227c1038
< CDLEN EQU OFFS2 LENGTH OF CDBLK IN BYTES
---
> CDLEN EQU OFFS2 LENGTH OF CDBLK IN BAUS
2564c1375
< CMLEN EQU CMIDN+1 LENGTH OF CMBLK IN BYTES
---
> CMLEN EQU CMIDN+1 LENGTH OF CMBLK IN BAUS
2626a1438,1477
> * COPY FILE BLOCK (COBLK)
> *
> * A CHAIN STACK OF COPY BLOCKS IS BUILT FOR EVERY NESTED
> * -COPY CONTROL CARD. THE CONTROL BLOCK IS USED TO PRESERVE
> * THE INPUT CONTEXT OF THE FILE CONTAINING THE -COPY.
> * AS -COPYS ARE ENDED, THESE BLOCKS ARE POPPED OFF THE CHAIN
> * AND THE STATE RESTORED. SEE ROUTINES CNCRD, COPND.
> *
> * +------------------------------------+
> * I COTYP I
> * +------------------------------------+
> * I CONXT I
> * +------------------------------------+
> * I COIOT I
> * +------------------------------------+
> * I COTTI I
> * +------------------------------------+
> * I COCIM I
> * +------------------------------------+
> * I COSPT I
> * +------------------------------------+
> * I COSLS I
> * +------------------------------------+
> * I COSIN I
> * +------------------------------------+
> * I COSTL I
> * +------------------------------------+
> *
> COTYP EQU 0 POINTER TO DUMMY ROUTINE B$COP
> CONXT EQU COTYP+1 POINT TO NEXT (OUTER -COPY) COBLK
> COIOT EQU CONXT+1 RECORD IOTAG FOR OSINT
> COTTI EQU COIOT+1 RECORD TTINS FLAG
> COCIM EQU COTTI+1 RECORD R$CIM COMPILER IMAGE
> COSPT EQU COCIM+1 RECORD SCNPT SCAN POINTER
> COSLS EQU COSPT+1 RECORD CSWLS LISTING FLAG
> COSIN EQU COSLS+1 RECORD CSWIN -INXXX VALUE
> COSTL EQU COSIN+1 RECORD R$STL -STITL STRING PTR
> COSI$ EQU COSTL+1 SIZE OF COBLK
> EJC
> *
2688c1539
< DFLEN EQU FARGS+1 LENGTH OF DFBLK IN BYTES
---
> DFLEN EQU FARGS+1 LENGTH OF DFBLK IN BAUS
2798a1650,1651
> .IF .CNLD
> .ELSE
2826c1679
< EFLEN EQU FARGS+1 LENGTH OF EFBLK IN BYTES
---
> EFLEN EQU FARGS+1 LENGTH OF EFBLK IN BAUS
2845a1699,1700
> * 4 TYPE IS BUFFER
> .FI
2901c1756
< EXLEN EQU EXSTM+1 LENGTH OF EXBLK IN BYTES
---
> EXLEN EQU EXSTM+1 LENGTH OF EXBLK IN BAUS
2941c1796
< FFOFS EQU FFNXT+1 OFFSET (BYTES) TO FIELD IN PDBLK
---
> FFOFS EQU FFNXT+1 OFFSET (BAUS) TO FIELD IN PDBLK
3022c1877
< * IS FOUND NMOFS BYTES PAST THE ADDRESS IN NMBAS.
---
> * IS FOUND NMOFS BAUS PAST THE ADDRESS IN NMBAS.
3135c1990
< * CONTAINS THE LENGTH OF THE PDBLK IN BYTES (FIELD DFPDL).
---
> * CONTAINS THE LENGTH OF THE PDBLK IN BAUS (FIELD DFPDL).
3169c2024
< PFLEN EQU FARGS+1 LENGTH OF PFBLK IN BYTES
---
> PFLEN EQU FARGS+1 LENGTH OF PFBLK IN BAUS
3176c2031
< PFAGB EQU PFARG-1 OFFSET BEHIND PFARG FOR ARG, LOCAL
---
> PFAGB EQU PFARG-1 OFFSET BEHIND PFARG FOR ARG,LOCAL
3237c2092
< * IS GIVEN IN BYTES BY CFP$F AND THAT THIS VALUE IS
---
> * IS GIVEN IN BAUS BY CFP$F AND THAT THIS VALUE IS
3278c2133
< * I SVCHS I
---
> * / SVCHS /
3323c2178,2181
< SVFPK EQU SVFNP+SVKVC PREEVAL FCN + CONST KEYWD + VAL
---
> .IF .CNFN
> .ELSE
> SVFPK EQU SVFNP+SVKVC PREEVAL FUNC + CONST KEYWD+VAL
> .FI
3333c2191
< * THE ITEM AND APPLY FUNCTIONS FALL OUTSIDE THIS CATEGORY.
---
> * THE APPLY FUNCTION FALLS OUTSIDE THIS CATEGORY.
3373c2231
< * PREDEFINED FUNCTIONS USING THIS ARE APPLY AND ITEM.
---
> * PREDEFINED FUNCTION USING THIS IS APPLY.
3401,3409c2259,2260
< K$ABE EQU 0 ABEND
< K$ANC EQU K$ABE+CFP$B ANCHOR
< .IF .CULC
< K$CAS EQU K$ANC+CFP$B CASE
< K$COD EQU K$CAS+CFP$B CODE
< .ELSE
< K$COD EQU K$ANC+CFP$B CODE
< .FI
< K$DMP EQU K$COD+CFP$B DUMP
---
> K$ANC EQU 0 ANCHOR
> K$DMP EQU K$ANC+CFP$B DUMP
3447c2298,2299
< K$STC EQU K$RTN+1 STCOUNT
---
> K$COD EQU K$RTN+1 CODE
> K$STC EQU K$COD+1 STCOUNT
3454a2307
> K$$CD EQU K$COD-K$ALP CODE
3478d2330
< * +------------------------------------+
3487c2339
< TBLEN EQU OFFS2 LENGTH OF TBBLK IN BYTES
---
> TBLEN EQU OFFS2 LENGTH OF TBBLK IN BAUS
3546c2398
< * I TRTAG OR TRTER OR TRTRF I
---
> * I TRTAG OR TRTER I
3548c2400
< * I TRFNC OR TRFPT I
---
> * I TRFNC OR TRTRI I
3557c2409
< TRTAG EQU TRVAL+1 TRACE TAG
---
> TRTAG EQU TRVAL+1 TRACE TAG OR IOTAG
3559d2410
< TRTRF EQU TRTAG PTR TO TRBLK HOLDING FCBLK PTR
3561c2412
< TRFPT EQU TRFNC FCBLK PTR FOR SYSIO
---
> TRTRI EQU TRFNC PTR TO TRACE BLOCK HOLDING IOTAG
3567,3568c2418,2419
< TRTOU EQU TRTVL+1 TRACE TYPE FOR OUTPUT ASSOCIATION
< TRTFC EQU TRTOU+1 TRACE TYPE FOR FCBLK IDENTIFICATION
---
> TRTIO EQU TRTVL+1 TRACE TYPE FOR IOTAG TRACE BLOCK
> TRTOU EQU TRTIO+1 TRACE TYPE FOR OUTPUT ASSOCIATION
3584,3586c2435
< * 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.
---
> * TRTRI IS A PTR TO IOTAG TRBLK FROM SYSIO OR ZERO.
3625,3627c2474
< * 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.
---
> * TRTRI IS A PTR TO IOTAG TRBLK FROM SYSIO OR ZERO.
3681c2528
< * INPUT/OUTPUT FILE ARG1 TRAP BLOCK
---
> * INPUT/OUTPUT FILETAG TRAP BLOCK (TRTIO)
3683c2530
< * THE VALUE FIELD OF THE VARIABLE POINTS TO A TRBLK
---
> * THE VALUE FIELD OF THE FILETAG VBL POINTS TO A TRBLK
3687,3689c2534
< * TO HOLD A POINTER TO THE FCBLK WHICH AN
< * IMPLEMENTATION MAY REQUEST TO HOLD INFORMATION
< * ABOUT A FILE.
---
> * TO HOLD THE IOTAG RETURNED BY A SYSIO CALL
3691,3694c2536,2538
< * TRTYP IS SET TO TRTFC
< * TRNEXT POINTS TO NEXT TRBLK OR TRVAL IS VARIABLE VAL
< * TRFNM IS 0
< * TRFPT IS THE FCBLK POINTER.
---
> * TRTYP IS SET TO TRTIO
> * TRNXT POINTS TO NEXT TRBLK OR TRVAL IS VARIABLE VAL
> * TRTAG HOLDS THE IOTAG.
3701a2546
> * FILETAG ASSOCIATION (IF PRESENT)
3729c2574
< VCLEN EQU OFFS2 LENGTH OF VCBLK IN BYTES
---
> VCLEN EQU OFFS2 LENGTH OF VCBLK IN BAUS
3832c2677
< * VRCHS IS THE NAME (LJRZ) IF VRLEN IS NON-ZERO.
---
> * VRCHS IS THE NAME IF VRLEN IS NON-ZERO.
3843,3844d2687
< * THIS TYPE OF BLOCK MAY BE USED AS A FILE CONTROL BLOCK.
< * SEE SYSFC,SYSIN,SYSOU,S$INP,S$OUP FOR DETAILS.
3857c2700
< XNLEN EQU XNTYP+1 LENGTH OF XNBLK IN BYTES
---
> XNLEN EQU XNTYP+1 LENGTH OF XNBLK IN BAUS
3873,3874d2715
< * THIS TYPE OF BLOCK MAY BE USED AS A FILE CONTROL BLOCK.
< * SEE SYSFC,SYSIN,SYSOU,S$INP,S$OUP FOR DETAILS.
3887c2728
< XRLEN EQU XRTYP+1 LENGTH OF XRBLK IN BYTES
---
> XRLEN EQU XRTYP+1 LENGTH OF XRBLK IN BAUS
3911,3912c2752
< INILN EQU 132 DEFAULT IMAGE LENGTH FOR COMPILER
< INILS EQU 80 IMAGE LENGTH IF -SEQU IN EFFECT
---
> INILN EQU 160 DEFAULT IMAGE LENGTH FOR COMPILER
3914,3916d2753
< IONMB EQU 2 NAME BASE USED FOR IOCHN IN SYSIO
< IONMO EQU 4 NAME OFFSET USED FOR IOCHN IN SYSIO
< *
3931d2767
< NINI8 EQU 998
3934d2769
< EJC
3945c2780
< RILEN EQU 120 BUFFER LENGTH FOR SYSRI
---
> RILEN EQU 160 BUFFER LENGTH FOR SYSRI
4051,4053c2886,2888
< .IF .CULC
< CC$CA EQU 0 -CASE
< CC$DO EQU CC$CA+1 -DOUBLE
---
> .IF .CASL
> CC$CI EQU 0 -CASEIG
> CC$CO EQU CC$CI+1 -COPY
4055c2890
< CC$DO EQU 0 -DOUBLE
---
> CC$CO EQU 0 -COPY
4057,4061c2892,2893
< 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$EJ EQU CC$CO+1 -EJECT
> CC$FA EQU CC$EJ+1 -FAIL
4063,4065c2895,2900
< CC$NR EQU CC$LI+1 -NOERRORS
< CC$NX EQU CC$NR+1 -NOEXECUTE
< CC$NF EQU CC$NX+1 -NOFAIL
---
> .IF .CASL
> CC$NC EQU CC$LI+1 -NOCASEIG
> CC$NF EQU CC$NC+1 -NOFAIL
> .ELSE
> CC$NF EQU CC$LI+1 -NOFAIL
> .FI
4067,4073c2902
< 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$ST EQU CC$NL+1 -STITL
4076c2905
< CC$NC EQU CC$TR+1 NUMBER OF CONTROL CARDS
---
> CC$CT EQU CC$TR+1 NUMBER OF CONTROL CARDS
4079d2907
< EJC
4108d2935
< *
4157c2984
< .IF .CULC
---
> .IF .CASL
4159c2986
< DTC /DOUB/
---
> DTC /COPY/
4161c2988
< CCNMS DTC /DOUB/
---
> CCNMS DTC /COPY/
4163d2989
< DTC /DUMP/
4165,4166d2990
< DTC /ERRO/
< DTC /EXEC/
4169,4170c2993,2995
< DTC /NOER/
< DTC /NOEX/
---
> .IF .CASL
> DTC /NOCA/
> .FI
4173,4178d2997
< DTC /NOOP/
< DTC /NOPR/
< DTC /OPTI/
< DTC /PRIN/
< DTC /SING/
< DTC /SPAC/
4185c3004
< DMHDK DAC B$SCL DUMP OF KEYWORD VALUES
---
> DMHDK DAC B$SCL
4187c3006
< DTC /DUMP OF KEYWORD VALUES/
---
> DDC /DUMP OF KEYWORD VALUES/
4189c3008
< DMHDV DAC B$SCL DUMP OF NATURAL VARIABLES
---
> DMHDV DAC B$SCL
4191,4192c3010
< DTC /DUMP OF NATURAL VARIABLES/
< EJC
---
> DDC /DUMP OF NATURAL VARIABLES/
4198c3016
< DTC /STORE USED/
---
> DDC /STORE USED/
4202c3020
< DTC /STORE LEFT/
---
> DDC /STORE LEFT/
4206c3024
< DTC /COMP ERRORS/
---
> DDC /COMP ERRORS/
4210c3028,3032
< DTC /COMP TIME-MSEC/
---
> .IF .CTMD
> DDC /COMP TIME-DSEC/
> .ELSE
> DDC /COMP TIME-MSEC/
> .FI
4212c3034
< ENCM5 DAC B$SCL EXECUTION SUPPRESSED
---
> ENCM5 DAC B$SCL
4214c3036,3037
< DTC /EXECUTION SUPPRESSED/
---
> DDC /EXECUTION SUPPRESSED/
> EJC
4216c3039
< * STRING CONSTANT FOR ABNORMAL END
---
> * FOR TERMINATION IN COMPILATION
4218,4221c3041,3043
< ENDAB DAC B$SCL
< DAC 12
< DTC /ABNORMAL END/
< EJC
---
> ENDIC DAC B$SCL
> DAC 14
> DDC /IN COMPILATION/
4227c3049
< DTC /MEMORY OVERFLOW/
---
> DDC /MEMORY OVERFLOW/
4233c3055
< DTC /NORMAL END/
---
> DDC /NORMAL END/
4237c3059
< ENDSO DAC B$SCL STACK OVERFLOW IN GARBAGE COLLECTOR
---
> ENDSO DAC B$SCL
4239,4245c3061
< DTC /STACK OVERFLOW IN GARBAGE COLLECTION/
< *
< * STRING CONSTANT FOR TIME UP
< *
< ENDTU DAC B$SCL
< DAC 15
< DTC /ERROR - TIME UP/
---
> DDC /STACK OVERFLOW IN GARBAGE COLLECTION/
4250c3066
< ERMMS DAC B$SCL ERROR
---
> ERMMS DAC B$SCL
4252c3068
< DTC /ERROR/
---
> DDC /ERROR/
4254c3070
< ERMNS DAC B$SCL STRING / -- /
---
> ERMNS DAC B$SCL
4257a3074,3076
> *
> ERRTF DAC 251 FATAL ERROR CODE - SEE LABEL ERRAF
> *
4260c3079
< LSTMS DAC B$SCL PAGE
---
> LSTMS DAC B$SCL
4262c3081
< DTC /PAGE /
---
> DDC /PAGE /
4268c3087
< DTC /MACRO SPITBOL VERSION 3.5/
---
> DDC /MACRO SPITBOL VERSION 4.3/
4272c3091
< DTC /3.5/
---
> DTC /4.3/
4301a3121,3123
> NDEXC DAC P$EXC EXPRESSION
> .IF .CNFN
> .ELSE
4304c3126
< NDEXC DAC P$EXC EXPRESSION
---
> .FI
4351,4353c3173,3175
< * OPDVS IS USED WHEN SCANNING BELOW THE TOP LEVEL TO
< * INSURE THAT THE CONCATENATION WILL NOT BE LATER
< * MISTAKEN FOR PATTERN MATCHING
---
> * OPDVP IS USED WHEN SCANNING BELOW TOP LEVEL TO ENSURE
> * THE CONCATENATION WILL NOT LATER BE MISTAKEN FOR
> * PATTERN MATCHING
4355c3177
< OPDVP DAC O$CNC CONCATENATION - NOT PATTERN MATCH
---
> OPDVP DAC O$CNC PROVEN CONCATENATION
4459,4467d3280
< DAC O$IMA IMMEDIATE ASSIGNMENT
< DAC C$BVN
< DAC LLDLD
< DAC RRDLD
< *
< DAC O$INV INDIRECTION
< DAC C$IND
< DAC LLUNO
< *
4497a3311,3319
> DAC O$IMA IMMEDIATE ASSIGNMENT
> DAC C$BVN
> DAC LLDLD
> DAC RRDLD
> *
> DAC O$INV INDIRECTION
> DAC C$IND
> DAC LLUNO
> *
4580c3402
< DTC /PROGRAM PROFILE/
---
> DDC /PROGRAM PROFILE/
4583c3405
< DTC /STMT NUMBER OF -- EXECUTION TIME --/
---
> DDC /STMT NUMBER OF -- EXECUTION TIME --/
4586c3408
< DTC /NUMBER EXECUTIONS TOTAL(MSEC) PER EXCN(MCSEC)/
---
> DDC /NUMBER EXECUTIONS TOTAL(MSEC) PER EXCN(MCSEC)/
4588d3409
< *
4616a3438,3439
> .IF .CNBF
> .ELSE
4618c3441
< SCBUF DAC B$SCL BUFFER
---
> SCBUF DAC B$SCL
4620a3444
> .FI
4717a3542,3544
> .IF .CS16
> STLIM DIC +32767 DEFAULT STATEMENT LIMIT
> .ELSE
4718a3546
> .FI
4749c3577
< STPM1 DAC B$SCL IN STATEMENT
---
> STPM1 DAC B$SCL
4751c3579
< DTC /IN STATEMENT/
---
> DDC /IN STATEMENT/
4755c3583
< DTC /STMTS EXECUTED/
---
> DDC /STMTS EXECUTED/
4759c3587,3591
< DTC /RUN TIME-MSEC/
---
> .IF .CTMD
> DDC /RUN TIME-DSEC/
> .ELSE
> DDC /RUN TIME-MSEC/
> .FI
4763c3595
< DTC $MCSEC / STMT$
---
> DDC $MCSEC / STMT$
4767c3599
< DTC /REGENERATIONS/
---
> DDC /REGENERATIONS/
4769,4772d3600
< * CHARS FOR /TU/ ENDING CODE
< *
< STRTU DTC /TU/
< *
4800c3628
< TMASB DAC B$SCL ASTERISKS FOR TRACE STATEMENT NO
---
> TMASB DAC B$SCL
4803d3630
<
4805c3632
< TMBEB DAC B$SCL BLANK-EQUAL-BLANK
---
> TMBEB DAC B$SCL
4891a3719,3724
> V$CTI DBC SVFNP CTI
> DAC 3
> DTC /CTI/
> DAC S$CTI
> DAC 1
> *
4896a3730,3735
> V$ITC DBC SVFNN ITC
> DAC 3
> DTC /ITC/
> DAC S$ITC
> DAC 1
> *
4967d3805
< .IF .CULC
4969,4980d3806
< V$CAS DBC SVKNM CASE
< DAC 4
< DTC /CASE/
< DAC K$CAS
< .FI
< *
< V$CHR DBC SVFNP CHAR
< DAC 4
< DTC /CHAR/
< DAC S$CHR
< DAC 1
< *
5077a3904
> EJC
5078a3906,3908
> * STANDARD VARIABLE BLOCKS (CONTINUED)
> *
> *
5133,5137d3962
< V$ABE DBC SVKNM ABEND
< DAC 5
< DTC /ABEND/
< DAC K$ABE
< *
5183a4009,4011
> .IF .CNFN
> V$FEN DBC SVKVC FENCE
> .ELSE
5184a4013
> .FI
5187a4017,4018
> .IF .CNFN
> .ELSE
5189a4021
> .FI
5217d4048
< *
5257a4089,4092
> EJC
> *
> * STANDARD VARIABLE BLOCKS (CONTINUED)
> *
5260,5261c4095
< *
< V$APN DBC SVFNN
---
> V$APN DBC SVFNN APPEND
5273d4106
< *
5286c4119
< DAC S$DEF
---
> DAC S$DFN
5294d4126
< EJC
5296,5297d4127
< * STANDARD VARIABLE BLOCKS (CONTINUED)
< *
5308c4138
< *
---
> EJC
5310a4141
> *
5316d4146
< *
5317a4148
> *
5341,5346d4171
< V$REW DBC SVFNN REWIND
< DAC 6
< DTC /REWIND/
< DAC S$REW
< DAC 1
< *
5377c4202
< DAC S$CNV
---
> DAC S$CVT
5384c4209
< DAC 1
---
> DAC 2
5414d4238
< *
5423a4248
> *
5462a4288,4293
> V$VDF DBC SVFPR VDIFFER
> DAC 7
> DTC /VDIFFER/
> DAC S$VDF
> DAC 2
> *
5466a4298
> EJC
5467a4300,4301
> * STANDARD VARIABLE BLOCKS (CONTINUED)
> *
5472d4305
< EJC
5474,5475d4306
< * STANDARD VARIABLE BLOCKS (CONTINUED)
< *
5516,5518d4346
< .IF .CULC
< DAC V$CAS CCASE
< .FI
5548,5553c4376,4377
< .IF .CULC
< DAC V$CAS START OF 4 CHAR VARIABLES
< .ELSE
< DAC V$CHR START OF 4 CHAR VARIABLES
< .FI
< DAC V$ABE START OF 5 CHAR VARIABLES
---
> DAC V$COD START OF 4 CHAR VARIABLES
> DAC V$ABO START OF 5 CHAR VARIABLES
5598c4422
< * LABEL TO MARK START OF WORK AREA
---
> * LABEL TO MARK START OF WORK AREA WHICH IS CLEARED
5663,5665c4487,4489
< CSWDB DAC 0 0/1 FOR -SINGLE/-DOUBLE
< CSWER DAC 0 0/1 FOR -ERRORS/-NOERRORS
< CSWEX DAC 0 0/1 FOR -EXECUTE/-NOEXECUTE
---
> .IF .CASL
> CSWCI DAC 0 0/1 FOR -NOCASEIG/CASEIG
> .FI
5669,5670c4493
< CSWNO DAC 0 0/1 FOR -OPTIMISE/-NOOPT
< CSWPR DAC 0 0/1 FOR -NOPRINT/-PRINT
---
> EJC
5676d4498
< EJC
5711,5715d4532
< * WORK AREA FOR DTACH
< *
< DTCNB DAC 0 NAME BASE
< DTCNM DAC 0 NAME PTR
< *
5726,5727c4543
< ERICH DAC 0 COPY ERROR REPORTS TO INT.CHAN IF 1
< ERLST DAC 0 FOR LISTR WHEN ERRORS GO TO INT.CH.
---
> EROSN DAC 0 FLAG FOR SPECIAL EROSI RETURN
5741a4558
> *
5798a4616
> GTNSV DIC +0 SAVE IA
5821a4640
> EJC
5827c4646
< * FLAG FOR HEADER PRINTING
---
> * FLAGS FOR HEADER PRINTING
5828a4648
> HEADN DAC 0 NON-ZERO IF HDRS NOT TO BE PRINTED
5838a4659
> INICD DIC +0 CODE KWD VAL (NEEDED FOR BATCH)
5846c4667,4669
< INSAB DAC 0 ENTRY WA + ENTRY WB
---
> INSAB DAC 0 ENTRY WA PLUS ENTRY WB
> INSBB DAC 0 BFBLK POINTER
> INSBC DAC 0 BCBLK POINTER
5849d4671
< INSSC DAC 0 SAVE ENTRY WC
5854c4676,4680
< IOPTT DAC 0 TYPE OF ASSOCIATION
---
> IOPNF DAC 0 NAME OFFSET
> IOPVR DAC 0 FILETAG VRBLK
> IOPWA DAC 0 KEEP WA
> IOPWB DAC 0 KEEP WB
> IOPWC DAC 0 KEEP WC
5861d4686
< KVABE DAC 0 ABEND
5863,5866d4687
< .IF .CULC
< KVCAS DAC 0 CASE
< .FI
< KVCOD DAC 0 CODE
5887a4709,4713
> KVCOD DIC 0 CODE
> .IF .CS16
> KVSTL DIC +32767 STLIMIT
> KVSTC DIC +32767 STCOUNT (COUNTS DOWN FROM STLIMIT)
> .ELSE
5889a4716
> .FI
5897a4725
> EJC
5920c4748
< PFDMP DAC 0 SET NON-0 IF &PROFILE SET NON-0
---
> PFDMP DAC 0 SET NON-0 IF PROFILE SET NON-0
5927c4755
< PFSTE DIC +0 GETS INT REP OF TABLE ENTRY SIZE
---
> PFSTE DIC +0 TABLE ENTRY SIZE IN BAUS
5929d4756
< *
5938,5943d4764
< * 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
< *
5957a4779,4780
> PRAVL DAC 0 SET IF PRINT FILE AVAILABLE
> PRBLK DAC 0 ADDRESS OF BUFFER BLANKING STRING
5958a4782,4783
> PRCHS DAC 0 ADDRESS OF CHARS IN PRINT BUFFER
> PRCMV DAC 0 NO. OF BAUS TO MOVE IN BFR CLEARING
5961d4785
< PRLNW DAC 0 LENGTH OF PRINT BUFFER IN WORDS
5962a4787,4789
> PRPUT DAC 0 SET IF CHARS TO BE PUT IN BFR
> PRSTD DAC 0 TESTED BY PRTPG
> PRSTO DAC 0 STANDARD LISTING OPTION FLAG
5965c4792
< * WORK AREAS FOR PRTST PROCEDURE
---
> * WORK AREAS FOR PRTST, PTTST PROCEDURES
5969c4796,4797
< PRSVC DAC 0 SAVE CHAR COUNTER
---
> PRTVA DAC 0 SAVE WA
> PRTVB DAC 0 SAVE WB
5971,5975d4798
< * WORK AREA FOR PRTNL
< *
< PRTSA DAC 0 SAVE WA
< PRTSB DAC 0 SAVE WB
< *
5985a4809,4812
> * FLAG TO TELL ERROR THAT WE ARE READING SOURCE LINE
> *
> RDRER DAC 0 READ-SOURCE-LINE IN PROGRESS FLAG
> *
6009a4837
> R$COP DAC 0 PTR TO -COPY CHAIN STACK
6014d4841
< R$FCB DAC 0 FCBLK CHAIN HEAD
6017,6022c4844,4847
< 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$IO1 DAC 0 FIRST ARGUMENT
> R$IOL DAC 0 SECOND ARGUMENT (FILETAG) SCBLK PTR
> R$IOR DAC 0 FILEPROPS SCBLK PTR
> R$IOT DAC 0 TRTIO TRACE BLK PTR
6077a4903,4910
> *
> * WORK AREA FOR DETACH PROCEDURE
> *
> SDETF DAC 0 TRACE BLOCK FLAG
> *
> * WORK AREA FOR ENDFILE PROCEDURE
> *
> SENFR DAC 0 SAVE XR
6102c4935
< * GLOBAL VALUE FOR INDICATING STAGE (SEE ERROR SECTION)
---
> * VALUES FOR INDICATING COMPILATION/EXECUTION STAGE
6104a4938
> STAGX DAC 0 NON-ZERO IF EXECUTING
6119a4954
> STPXR DAC 0 SAVE XR
6133d4967
< TIMUP DAC 0 SET WHEN TIME UP OCCURS
6134a4969,4981
> * TERMINAL BUFFER ADDRESSES, FLAGS ETC
> *
> TTBLK DAC 0 BLANKING STRING ADRS
> TTBUF DAC 0 BUFFER ADRS
> TTCHS DAC 0 START OF BUFFER CHARACTERS
> TTCMV DAC 0 COUNT OF BLANKING CHARS TO MOVE
> TTERL DAC 0 ERROR FLAG
> TTINS DAC 0 NON-ZERO IF STD INPUT FROM TERML
> TTLEN DAC 0 LENGTH OF TERMINAL BUFFER
> TTLST DAC 0 COPY STD O/P TO TERML IF SET
> TTOFS DAC 0 OFFSET TO POSITION IN TERML BFR
> TTOUS DAC 0 SET IF STD OUTPUT TO TERMINAL
> *
6136a4984,4985
> XSCBL DAC 0 COUNT OF TRAILING BLANKS
> XSCNB DAC 0 NON-ZERO IF NON-BLANKS SEEN
6155a5005
> * (WA) INITIAL &CODE VALUE
6158c5008,5010
< JSR SYSTM INITIALISE TIMER
---
> *
> INITL RTN INITIALISATION CODE
> MOV WA,INICD SAVE INITIAL CODE KYWD VALUE
6160d5011
< STI TIMSX STORE TIME
6196c5047
< MOV WA,CSWIN -IN72
---
> MOV WA,CSWIN STORE FOR LATER USE
6206d5056
< STI TIMSX STORE TIME IN CORRECT PLACE
6211a5062,5068
> .IF .CSIG
> MNZ CSWCI -CASEIG
> .FI
> JSR SYSTM INITIALISE TIMER
> STI TIMSX STORE TIME
> LDI INICD LOAD INITIAL CODE KWD VALUE
> STI KVCOD STORE
6247a5105,5106
> ADD TTLEN,WA ADD TERMINAL BUFFER LENGTH
> ADD WA,WA ALLOW FOR EQUALLY BIG BLANK STRINGS
6250c5109
< CTB WA,8 CONVERT TO BYTES, ALLOWING A MARGIN
---
> CTB WA,8 CONVERT TO BAUS, ALLOWING A MARGIN
6258c5117
< BGT XR,WA,INI06 SKIP IF STATIC HI EXCEEDS MXLEN
---
> BGT XR,WA,INI05 SKIP IF STATIC HI EXCEEDS MXLEN
6265c5124
< INI06 MOV XR,DNAMB DYNAMIC BASE ADRS
---
> INI05 MOV XR,DNAMB DYNAMIC BASE ADRS
6267c5126
< BNZ WA,INI07 SKIP IF NON-ZERO MXLEN
---
> BNZ WA,INI06 SKIP IF NON-ZERO MXLEN
6271d5129
< EJC
6276,6277c5134,5135
< INI07 MOV XL,DNAME STORE DYNAMIC END ADDRESS
< BLT DNAMB,XL,INI09 SKIP IF HIGH ENOUGH
---
> INI06 MOV XL,DNAME STORE DYNAMIC END ADDRESS
> BLT DNAMB,XL,INI08 SKIP IF HIGH ENOUGH
6279c5137
< WTB XR GET AS BAUS (SGD05)
---
> WTB XR CONVERT TO BAUS
6281c5139
< BNZ XR,INI07 TRY AGAIN
---
> BNZ XR,INI06 TRY AGAIN
6283c5141
< MOV ENDML,WA MESSAGE LENGTH
---
> MOV ENDML,WC MESSAGE LENGTH
6285c5143,5148
< PPM SHOULD NOT FAIL
---
> PPM INI07
> PPM INI07
> *
> * EMERGENCY SHUTDOWN
> *
> INI07 MOV =KVCOD,WA CODE KEYWORD
6286a5150
> EJC
6290c5154
< INI09 MOV PRLEN,WC NO. OF CHARS IN PRINT BFR
---
> INI08 MOV PRLEN,WA NO. OF CHARS IN PRINT BFR
6294,6297c5158,5169
< MOV WC,(XR)+ AND STRING LENGTH
< CTW WC,0 GET NUMBER OF WORDS IN BUFFER
< MOV WC,PRLNW STORE FOR BUFFER CLEAR
< LCT WC,WC WORDS TO CLEAR
---
> MOV WA,(XR)+ AND STRING LENGTH
> MOV XR,PRCHS KEEP ADRS OF BUFFER PROPER
> MOV XR,XL COPY IT
> CTB WA,0 WORDS NEEDED EXPRESSED IN BAUS
> MOV WA,PRCMV KEEP FOR CLEARING BUFFER
> MOV XR,PRBLK CONSTRUCT ADRS OF BLANKING STRING
> ADD WA,PRBLK ADD OFFSET TO BLANKING STRING
> ADD WA,WA CLEAR BOTH BFR AND BLANKING STRING
> MOV NULLW,(XR)+ CLEAR FIRST WORD
> BZE WA,INI09 SKIP IF NO PRINT BUFFER
> DCA WA ADJUST FOR FIRST WORD
> MVW PERFORM BLANKING
6299c5171
< * LOOP TO CLEAR BUFFER
---
> * SET UP TERMINAL BUFFER
6301,6302c5173,5187
< INI10 MOV NULLW,(XR)+ STORE BLANK
< BCT WC,INI10 LOOP
---
> INI09 MOV TTLEN,WA LENGTH OF TERMINAL BUFFER
> MOV XR,TTBUF ADRS OF TERMINAL STRING BUFFER
> MOV =B$SCL,(XR)+ STRING TYPE CODE
> MOV WA,(XR)+ STRING LENGTH
> MOV XR,TTCHS KEEP ADRS OF BUFFER PROPER
> MOV XR,XL COPY IT
> CTB WA,0 WORDS NEEDED EXPRESSED IN BAUS
> MOV WA,TTCMV KEEP FOR CLEARING BUFFER
> MOV XR,TTBLK CONSTRUCT ADRS OF BLANKING STRING
> ADD WA,TTBLK ADD OFFSET TO BLANKING STRING
> ADD WA,WA CLEAR BOTH BFR AND BLANKING STRING
> MOV NULLW,(XR)+ CLEAR FIRST WORD
> BZE WA,INI10 SKIP IF NO PRINT BUFFER
> DCA WA ADJUST FOR FIRST WORD
> MVW PERFORM BLANKING
6306c5191
< MOV =E$HNB,WA GET NUMBER OF HASH HEADERS
---
> INI10 MOV =E$HNB,WA GET NUMBER OF HASH HEADERS
6321c5206
< CTB WA,SCSI$ NO OF BYTES NEEDED
---
> CTB WA,SCSI$ NO OF BAUS NEEDED
6333c5218
< CTB WB,SCSI$ NO. OF BYTES NEEDED
---
> CTB WB,SCSI$ NO. OF BAUS NEEDED
6347c5232
< * INITIALIZE VARIABLE BLOCKS FOR INPUT AND OUTPUT
---
> * INITIALIZE VARIABLE BLOCKS FOR INPUT OUTPUT TERMINAL
6355,6357c5240,5246
< MOV INITR,WC TERMINAL FLAG
< BZE WC,INI13 SKIP IF NO TERMINAL
< JSR PRPAR ASSOCIATE TERMINAL
---
> BZE TTLEN,INI13 SKIP IF NO TERMINAL I/O
> MOV =V$TER,XL POINT TO STRING /TERMINAL/
> MOV =TRTOU,WB TRTYP FOR OUTPUT
> JSR INOUT PERFORM ASSOCIATION
> MOV =V$TER,XL
> MOV =TRTIN,WB TRTYP FOR INPUT
> JSR INOUT PERFORM ASSOCIATION
6360d5248
< * CHECK FOR EXPIRY DATE
6362,6363c5250
< INI13 JSR SYSDC CALL DATE CHECK
< MOV XS,FLPTR IN CASE STACK OVERFLOWS IN COMPILER
---
> * PREPARE FOR COMPILATION
6364a5252,5253
> INI13 MOV XS,FLPTR IN CASE STACK OVERFLOWS IN COMPILER
> *
6369,6370c5258,5259
< MOV =NULLS,R$TTL FORGET TITLE (REG04)
< MOV =NULLS,R$STL FORGET SUB-TITLE (REG04)
---
> MOV =NULLS,R$TTL FORGET TITLE
> MOV =NULLS,R$STL FORGET SUB-TITLE
6375c5264
< BNZ CPSTS,INIX0 SKIP IF NO LISTING OF COMP STATS
---
> BNZ CPSTS,INIX1 SKIP IF NO LISTING OF COMP STATS
6404,6407d5292
< .IF .CUEJ
< BZE HEADP,INIX0 NO EJECT IF NOTHING PRINTED (SDG11)
< JSR PRTPG EJECT PRINTER
< .FI
6412d5296
< * SET DEFAULT INPUT RECORD LENGTH
6414,6415c5298
< INIX0 BGT CSWIN,=INILN,INIX1 SKIP IF NOT DEFAULT -IN72 USED
< MOV =INILS,CSWIN ELSE USE DEFAULT RECORD LENGTH
---
> * CHECK FOR NOEXECUTE
6417,6422c5300
< * 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
---
> INIX1 BNZ NOXEQ,INIX3 JUMP IF EXECUTION SUPPRESSED
6424,6429c5302,5303
< JSR SYSBX CALL BEFORE STARTING EXECUTION
< .IF .CUEJ
< .ELSE
< BZE HEADP,INIY0 NO EJECT IF NOTHING PRINTED (SGD11)
< JSR PRTPG EJECT PRINTER
< .FI
---
> BZE HEADP,INIX2 SKIP IF NO PRTPG CALLS IN COMPILN
> JSR PRTPG EJECT STANDARD PRINTER FILE
6431c5305
< * MERGE WHEN LISTING FILE SET FOR EXECUTION
---
> * INFORM OSINT OF STAGE
6433c5307
< INIY0 MNZ HEADP MARK HEADERS OUT REGARDLESS
---
> INIX2 JSR SYSBX CALL BEFORE STARTING EXECUTION
6437a5312,5313
> JSR SYSTM GET TIME
> STI TIMSX STORE FOR END RUN PROCESSING
6440,6442c5316,5317
< MOV CMPSN,PFNTE COPY STMTS COMPILED COUNT IN CASE
< JSR SYSTM TIME YET AGAIN
< STI PFSTM
---
> STI PFSTM STORE TIME FOR PROFILER
> MOV CMPSN,PFNTE COPY STATEMENTS COMPILED COUNT
6448c5323
< INIX2 JSR PRTNL PRINT A BLANK LINE
---
> INIX3 JSR PRTFH PRINT A BLANK LINE
6450,6453c5325,5327
< JSR PRTST PRINT STRING
< JSR PRTNL OUTPUT LINE
< ZER WA SET ABEND VALUE TO ZERO
< MOV =NINI9,WB SET SPECIAL CODE VALUE
---
> MOV TTERL,TTLST TO FORCE MSG TO TERMINAL
> JSR PRTSF PRINT NOEXECUTE MESSAGE
> MOV =KVCOD,WA ENDING CODE
6500c5374
< ERB 261,ADDITION CAUSED REAL OVERFLOW
---
> ERB 004,ADDITION CAUSED REAL OVERFLOW
6509c5383
< ERR 004,AFFIRMATION OPERAND IS NOT NUMERIC
---
> ERR 005,AFFIRMATION OPERAND IS NOT NUMERIC
6518c5392
< ERR 005,ALTERNATION RIGHT OPERAND IS NOT PATTERN
---
> ERR 006,ALTERNATION RIGHT OPERAND IS NOT PATTERN
6527c5401
< ERR 006,ALTERNATION LEFT OPERAND IS NOT PATTERN
---
> ERR 007,ALTERNATION LEFT OPERAND IS NOT PATTERN
6551d5424
< EJC
6559d5431
< EJC
6583c5455
< WTB WA CONVERT TO BYTES
---
> WTB WA CONVERT TO BAUS
6622c5494
< WTB WA CONVERT TO BYTES
---
> WTB WA CONVERT TO BAUS
6636c5508
< * ASSIGNMENT
---
> * ASSIGNMENT (O$RPL MERGES)
6639,6642c5511
< *
< * O$RPL (PATTERN REPLACEMENT) MERGES HERE
< *
< OASS0 MOV (XS)+,WB LOAD VALUE TO BE ASSIGNED
---
> MOV (XS)+,WB LOAD VALUE TO BE ASSIGNED
6649d5517
< EJC
6654,6655c5522
< ERB 007,COMPILATION ERROR ENCOUNTERED DURING EXECUTION
< EJC
---
> ERB 008,COMPILATION ERROR ENCOUNTERED DURING EXECUTION
6729c5596
< ERR 008,CONCATENATION LEFT OPND IS NOT STRING OR PATTERN
---
> ERR 009,CONCATENATION LEFT OPND IS NOT STRING OR PATTERN
6733c5600
< ERR 009,CONCATENATION RIGHT OPD IS NOT STRING OR PATTERN
---
> ERR 010,CONCATENATION RIGHT OPD IS NOT STRING OR PATTERN
6754c5621
< ERR 010,COMPLEMENTATION OPERAND IS NOT NUMERIC
---
> ERR 011,COMPLEMENTATION OPERAND IS NOT NUMERIC
6762c5629
< ERB 011,COMPLEMENTATION CAUSED INTEGER OVERFLOW
---
> ERB 012,COMPLEMENTATION CAUSED INTEGER OVERFLOW
6778,6779c5645,5646
< ERR 012,DIVISION LEFT OPERAND IS NOT NUMERIC
< ERR 013,DIVISION RIGHT OPERAND IS NOT NUMERIC
---
> ERR 013,DIVISION LEFT OPERAND IS NOT NUMERIC
> ERR 014,DIVISION RIGHT OPERAND IS NOT NUMERIC
6789c5656
< ERB 014,DIVISION CAUSED INTEGER OVERFLOW
---
> ERB 015,DIVISION CAUSED INTEGER OVERFLOW
6797c5664
< ERB 262,DIVISION CAUSED REAL OVERFLOW
---
> ERB 016,DIVISION CAUSED REAL OVERFLOW
6806c5673
< ERR 015,EXPONENTIATION RIGHT OPERAND IS NOT NUMERIC
---
> ERR 017,EXPONENTIATION RIGHT OPERAND IS NOT NUMERIC
6814c5681
< ERR 016,EXPONENTIATION LEFT OPERAND IS NOT NUMERIC
---
> ERR 018,EXPONENTIATION LEFT OPERAND IS NOT NUMERIC
6840c5707
< OEXP2 ERB 017,EXPONENTIATION CAUSED INTEGER OVERFLOW
---
> OEXP2 ERB 019,EXPONENTIATION CAUSED INTEGER OVERFLOW
6858c5725
< OEXP4 ERB 018,EXPONENTIATION RESULT IS UNDEFINED
---
> OEXP4 ERB 020,EXPONENTIATION RESULT IS UNDEFINED
6871c5738
< OEXP6 ERB 266,EXPONENTIATION CAUSED REAL OVERFLOW
---
> OEXP6 ERB 021,EXPONENTIATION CAUSED REAL OVERFLOW
6875c5742
< OEXP7 ERB 267,EXPONENTIATION RIGHT OPERAND IS REAL NOT INTEGER
---
> OEXP7 ERB 022,EXPONENTIATION RIGHT OPERAND IS REAL NOT INTEGER
6880c5747
< OEXP8 ERB 019,EXPONENTIATION RIGHT OPERAND IS NEGATIVE
---
> OEXP8 ERB 023,EXPONENTIATION RIGHT OPERAND IS NEGATIVE
6890,6891c5757
< BRN EVLX6 JUMP TO FAILURE LOC IN EVALX
< EJC
---
> JMG EVLXF JUMP TO FAILURE LOC IN EVALX
6896,6897c5762
< ERB 020,GOTO EVALUATION FAILURE
< EJC
---
> ERB 024,GOTO EVALUATION FAILURE
6907d5771
< EJC
6914c5778,5779
< BZE 2(XS),EVLX3 OK IF EXPR. WAS WANTED BY VALUE
---
> BNZ 2(XS),OFNE1 FAIL UNLESS EXPRN WANTED BY VALUE
> JMG EVLXV JOIN EXPRESSION BY VALUE CODE
6918,6919c5783
< OFNE1 ERB 021,FUNCTION CALLED BY NAME RETURNED A VALUE
< EJC
---
> OFNE1 ERB 025,FUNCTION CALLED BY NAME RETURNED A VALUE
6933,6934c5797
< ERB 022,UNDEFINED FUNCTION CALLED
< EJC
---
> ERB 026,UNDEFINED FUNCTION CALLED
6946,6947c5809
< OGOC1 ERB 023,GOTO OPERAND IS NOT A NATURAL VARIABLE
< EJC
---
> OGOC1 ERB 027,GOTO OPERAND IS NOT A NATURAL VARIABLE
6954,6957c5816,5818
< BEQ WA,=B$CDS,BCDS0 JUMP IF CODE BLOCK TO CODE ROUTINE
< BEQ WA,=B$CDC,BCDC0 JUMP IF CODE BLOCK TO CODE ROUTINE
< ERB 024,GOTO OPERAND IN DIRECT GOTO IS NOT CODE
< EJC
---
> BEQ WA,=B$CDC,OGOD1 JUMP IF CODE BLOCK
> BEQ WA,=B$CDS,OGOD2 JUMP IF CODE BLOCK
> ERB 028,GOTO OPERAND IN DIRECT GOTO IS NOT CODE
6958a5820,5831
> * CASE OF COMPLEX FAILURE CODE
> *
> OGOD1 MOV FLPTR,XS POP GARBAGE OFF STACK
> MOV CDFAL(XR),(XS) SET NEW FAILURE OFFSET
> BRN STMGO JUMP TO EXECUTE CODE
> *
> * CASE OF SIMPLE FAILURE CODE
> *
> OGOD2 MOV FLPTR,XS POP GARBAGE OFF STACK
> MOV *CDFAL,(XS) SET NEW FAILURE OFFSET
> BRN STMGO JUMP TO EXECUTE CODE
> *
6985c5858
< ERR 025,IMMEDIATE ASSIGNMENT LEFT OPERAND IS NOT PATTERN
---
> ERR 029,IMMEDIATE ASSIGNMENT LEFT OPERAND IS NOT PATTERN
6992d5864
< EJC
6999d5870
< EJC
7006d5876
< EJC
7020d5889
< EJC
7030d5898
< EJC
7044d5911
< EJC
7060d5926
< EJC
7066,7067c5932,5933
< ERR 026,MULTIPLICATION LEFT OPERAND IS NOT NUMERIC
< ERR 027,MULTIPLICATION RIGHT OPERAND IS NOT NUMERIC
---
> ERR 030,MULTIPLICATION LEFT OPERAND IS NOT NUMERIC
> ERR 031,MULTIPLICATION RIGHT OPERAND IS NOT NUMERIC
7077c5943
< ERB 028,MULTIPLICATION CAUSED INTEGER OVERFLOW
---
> ERB 032,MULTIPLICATION CAUSED INTEGER OVERFLOW
7085c5951
< ERB 263,MULTIPLICATION CAUSED REAL OVERFLOW
---
> ERB 033,MULTIPLICATION CAUSED REAL OVERFLOW
7087d5952
< EJC
7123d5987
< EJC
7128,7129c5992
< ERB 029,UNDEFINED OPERATOR REFERENCED
< EJC
---
> ERB 034,UNDEFINED OPERATOR REFERENCED
7145c6008
< ERR 030,PATTERN ASSIGNMENT LEFT OPERAND IS NOT PATTERN
---
> ERR 035,PATTERN ASSIGNMENT LEFT OPERAND IS NOT PATTERN
7159d6021
< EJC
7170d6031
< EJC
7177d6037
< EJC
7184d6043
< EJC
7189,7190c6048,6050
< BRN LEND0 JUMP TO END CIRCUIT
< EJC
---
> MOV =ENDMS,XR ENDING MESSAGE
> ZER WA NO ERROR CODE
> BRN STOPR STOP THE RUN
7198c6058
< BRN EVLX4 RETURN TO EVALX PROCEDURE
---
> JMG EVLXN RETURN TO EVALX PROCEDURE
7210c6070
< * SUBJECT POINTER
---
> * SUBJECT STRING POINTER
7215c6075
< ERR 031,PATTERN REPLACEMENT RIGHT OPERAND IS NOT STRING
---
> ERR 036,PATTERN REPLACEMENT RIGHT OPERAND IS NOT STRING
7222c6082
< BEQ (XL),=B$BCT,ORPL4 BRANCH IF BUFFER ASSIGNMENT
---
> BEQ (XL),=B$BCT,ORPL5 BRANCH IF BUFFER ASSIGNMENT
7257c6117
< BZE WA,OASS0 JUMP TO ASSIGN IF PART 3 IS NULL
---
> BZE WA,ORPL4 JUMP TO ASSIGN IF PART 3 IS NULL
7260c6120
< BRN OASS0 JUMP TO PERFORM ASSIGNMENT
---
> BRN ORPL4 JUMP TO PERFORM ASSIGNMENT
7266c6126,6130
< BRN OASS0 JUMP TO ASSIGN NULL VALUE
---
> *
> * MERGE WITH ASSIGNMENT ROUTINE
> *
> ORPL4 MOV =O$ASS,XL CONTINUATION ROUTINE
> BRI XL ENTER ROUTINE
7272c6136
< ORPL4 MOV XR,XL COPY SCBLK REPLACEMENT PTR
---
> ORPL5 MOV XR,XL COPY SCBLK REPLACEMENT PTR
7292c6156
< BRN EVLX3 RETURN TO EVALX PROCEDURE
---
> BRN EVLXV RETURN TO EVALX PROCEDURE
7337,7338c6201,6202
< ERR 032,SUBTRACTION LEFT OPERAND IS NOT NUMERIC
< ERR 033,SUBTRACTION RIGHT OPERAND IS NOT NUMERIC
---
> ERR 037,SUBTRACTION LEFT OPERAND IS NOT NUMERIC
> ERR 038,SUBTRACTION RIGHT OPERAND IS NOT NUMERIC
7348c6212
< ERB 034,SUBTRACTION CAUSED INTEGER OVERFLOW
---
> ERB 039,SUBTRACTION CAUSED INTEGER OVERFLOW
7356c6220
< ERB 264,SUBTRACTION CAUSED REAL OVERFLOW
---
> ERB 040,SUBTRACTION CAUSED REAL OVERFLOW
7358d6221
< EJC
7363,7364c6226
< BRN TRXQ1 JUMP INTO TRXEQ PROCEDURE
< EJC
---
> JMG TRXQR JUMP INTO TRXEQ PROCEDURE
7375c6237
< ERB 035,UNEXPECTED FAILURE IN -NOFAIL MODE
---
> ERB 041,UNEXPECTED FAILURE IN -NOFAIL MODE
7387d6248
< EJC
7391a6253,6255
> MOV KVERT,WA LOAD ERROR CODE
> ZER XR INDICATE NO ENDING MESSAGE
> BNZ WA,STOPR STOP RUN
7393d6256
< * MERGE HERE IF EXECUTION TERMINATES IN ERROR
7395,7404c6258
< LABO1 MOV KVERT,WA LOAD ERROR CODE
< BZE WA,LABO2 JUMP IF NO ERROR HAS OCCURED
< .IF .CSAX
< JSR SYSAX CALL AFTER EXECUTION PROC (REG04)
< .ELSE
< .FI
< JSR PRTPG ELSE EJECT PRINTER
< JSR ERMSG PRINT ERROR MESSAGE
< ZER XR INDICATE NO MESSAGE TO PRINT
< BRN STOPR JUMP TO ROUTINE TO STOP RUN
---
> * FAIL IF NO ERROR HAD OCCURED
7406c6260
< * HERE IF NO ERROR HAD OCCURED
---
> ERB 042,GOTO ABORT WITH NO PRECEDING ERROR
7408,7410d6261
< LABO2 ERB 036,GOTO ABORT WITH NO PRECEDING ERROR
< EJC
< *
7417,7418c6268,6269
< LCNT1 MOV R$CNT,XR LOAD CONTINUATION CODE BLOCK PTR
< BZE XR,LCNT2 JUMP IF NO PREVIOUS ERROR
---
> LCNXE MOV R$CNT,XR LOAD CONTINUATION CODE BLOCK PTR
> BZE XR,LCNT1 JUMP IF NO PREVIOUS ERROR
7428c6279
< LCNT2 ERB 037,GOTO CONTINUE WITH NO PRECEDING ERROR
---
> LCNT1 ERB 043,GOTO CONTINUE WITH NO PRECEDING ERROR
7434,7437c6285,6286
< *
< * MERGE HERE FROM END CODE CIRCUIT
< *
< LEND0 MOV =ENDMS,XR POINT TO MESSAGE /NORMAL TERM../
---
> MOV =ENDMS,XR POINT TO MESSAGE /NORMAL TERM../
> ZER WA NO ERROR CODE
7439d6287
< EJC
7446d6293
< EJC
7453d6299
< EJC
7460d6305
< EJC
7465c6310
< ERB 038,GOTO UNDEFINED LABEL
---
> ERB 044,GOTO UNDEFINED LABEL
7523d6367
< EJC
7536d6379
< EJC
7547d6389
< EJC
7565d6406
< EJC
7582d6422
< EJC
7594c6434
< BCDC0 MOV FLPTR,XS POP GARBAGE OFF STACK
---
> MOV FLPTR,XS POP GARBAGE OFF STACK
7597d6436
< EJC
7599,7600d6437
< * CDBLK (CONTINUED)
< *
7606c6443
< BCDS0 MOV FLPTR,XS POP GARBAGE OFF STACK
---
> MOV FLPTR,XS POP GARBAGE OFF STACK
7609d6445
< EJC
7616d6451
< EJC
7617a6453,6458
> * COBLK
> *
> * THE ROUTINE FOR A COBLK IS NEVER EXECUTED
> *
> B$COP ENT BL$CO ENTRY POINT (COBLK)
> *
7646a6488,6489
> .IF .CNLD
> .ELSE
7657,7658d6499
< .IF .CNLD
< .ELSE
7671,7676c6512
< .IF .CNRA
< BSW XR,3 SWITCH ON TYPE
< .ELSE
< BSW XR,4 SWITCH ON TYPE
< .FI
< IFF 0,BEFC7 NO CONVERSION NEEDED
---
> BSW XR,5,BEFC7 SWITCH ON EFTAR TYPE
7682a6519,6522
> .IF .CNBF
> .ELSE
> IFF 4,BEFCA BUFFER
> .FI
7689c6529
< ERR 039,EXTERNAL FUNCTION ARGUMENT IS NOT STRING
---
> ERR 045,EXTERNAL FUNCTION ARGUMENT IS NOT STRING
7700c6540
< ERR 040,EXTERNAL FUNCTION ARGUMENT IS NOT INTEGER
---
> ERR 046,EXTERNAL FUNCTION ARGUMENT IS NOT INTEGER
7710,7711c6550
< ERR 265,EXTERNAL FUNCTION ARGUMENT IS NOT REAL
< .FI
---
> ERR 047,EXTERNAL FUNCTION ARGUMENT IS NOT REAL
7714a6554,6570
> .FI
> .IF .CNBF
> .ELSE
> BRN BEFC5 MERGE
> *
> * HERE TO CONVERT BUFFER
> *
> BEFCA MOV (XT),XR LOAD ARGUMENT
> MOV WC,BEFOF SAVE OFFSET
> MOV XL,-(XS) SAVE EFBLK PTR
> JSR GTBUF GET A BUFFER
> ERR 259,EXTERNAL FUNCTION ARGUMENT IS NOT BUFFER
> MOV (XS)+,XL RESTORE EFBLK PTR
> *
> * INTEGER AND REAL CASE MERGES HERE
> *
> .FI
7739c6595
< MOV EFRSL(XL),WB GET RESULT TYPE ID
---
> MOV EFRSL(XL),WB GET RESULT TYPE
7764a6621
> BEQ WB,=NUM03,BEF10 YES JUMP
7765a6623,6627
> .IF .CNBF
> .ELSE
> MOV =B$BCT,WA BUFFER
> BEQ WB,=NUM04,BEF10 YES JUMP
> .FI
7780d6641
< EJC
7811,7812c6672
< BFFC2 ERB 041,FIELD FUNCTION ARGUMENT IS WRONG DATATYPE
< EJC
---
> BFFC2 ERB 048,FIELD FUNCTION ARGUMENT IS WRONG DATATYPE
7814,7815d6673
< * FFBLK (CONTINUED)
< *
7851d6708
< EJC
7858d6714
< EJC
7871d6726
< EJC
7924c6779
< WTB WA CONVERT NO. OF ARGS TO BYTES OFFSET
---
> WTB WA CONVERT NO. OF ARGS TO BAUS OFFSET
7989c6844
< * HERE IF &PROFILE = 1
---
> * HERE IF PROFILE = 1
7998c6853
< * HERE IF &PROFILE = 2
---
> * HERE IF PROFILE = 2
8007a6863
> EJC
8008a6865,6866
> * PFBLK (CONTINUED)
> *
8078c6936
< WTB WB CONVERT TO BYTE OFFSET
---
> WTB WB CONVERT TO BAU OFFSET
8095,8096c6953
< JSR PRTCH PRINT TO TERMINATE OUTPUT
< JSR PRTNL TERMINATE PRINT LINE
---
> JSR PRTCF PRINT TO TERMINATE OUTPUT
8122d6978
< EJC
8133d6988
< EJC
8140d6994
< EJC
8147d7000
< EJC
8176d7028
< EJC
8178,8179d7029
< * VRBLK (CONTINUED)
< *
8185,8186c7035
< ERB 042,ATTEMPT TO CHANGE VALUE OF PROTECTED VARIABLE
< EJC
---
> ERB 049,ATTEMPT TO CHANGE VALUE OF PROTECTED VARIABLE
8188,8189d7036
< * VRBLK (CONTINUED)
< *
8199d7045
< EJC
8201,8202d7046
< * VRBLK (CONTINUED)
< *
8223d7066
< EJC
8225,8226d7067
< * VRBLK (CONTINUED)
< *
8252,8253c7093
< JSR PRTCH PRINT IT
< JSR PRTNL TERMINATE LINE
---
> JSR PRTCF PRINT IT
8286d7125
< EJC
8593a7433,7434
> .IF .CNFN
> .ELSE
8596,8597d7436
< * COMPOUNT PATTERN STRUCTURES (CONTINUED)
< *
8627c7466,7467
< * STACK BACK PAST THE INNTER STACK BASE CREATED BY P$FNA
---
> * STACK BACK PAST THE INNER STACK BASE CREATED BY P$FNA
> .FI
8734d7573
< EJC
8743d7581
< EJC
8767d7604
< EJC
8784d7620
< EJC
8809d7644
< EJC
8811a7647
> * EXPRESSION ARGUMENT CASE MERGES
8817,8820c7653
< *
< * EXPRESSION ARGUMENT CASE MERGES HERE
< *
< PANY1 BEQ WB,PMSSL,FAILP FAIL IF NO CHARACTERS LEFT
---
> BEQ WB,PMSSL,FAILP FAIL IF NO CHARACTERS LEFT
8825c7658
< WTB WA CHANGE TO BYTE OFFSET
---
> WTB WA CHANGE TO BAU OFFSET
8832d7664
< EJC
8838a7671
> MOV =P$ANY,WA PCODE FOR NEW NODE
8840c7673
< ERR 043,ANY EVALUATED ARGUMENT IS NOT STRING
---
> ERR 050,ANY EVALUATED ARGUMENT IS NOT STRING
8842c7675
< PPM PANY1 MERGE MULTI-CHAR CASE IF OK
---
> BRI XL MERGE MULTI-CHAR CASE IF OK
8859d7691
< EJC
8922a7755
> MOV =P$BRK,WA PCODE FOR NEW NODE
8924c7757
< ERR 044,BREAK EVALUATED ARGUMENT IS NOT STRING
---
> ERR 051,BREAK EVALUATED ARGUMENT IS NOT STRING
8926,8927c7759
< PPM PBRK1 MERGE WITH MULTI-CHAR CASE IF OK
< EJC
---
> BRI XL MERGE WITH MULTI-CHAR CASE IF OK
8950a7783
> * EXPRESSION ARGUMENT CASE MERGES
8956,8959c7789
< *
< * EXPRESSION ARGUMENT MERGES HERE
< *
< PBRK1 MOV PMSSL,WC LOAD SUBJECT STRING LENGTH
---
> MOV PMSSL,WC LOAD SUBJECT STRING LENGTH
8971c7801
< WTB WA CONVERT TO BYTE OFFSET
---
> WTB WA CONVERT TO BAU OFFSET
8993d7822
< EJC
9004a7834
> MOV =P$BRK,WA PCODE FOR NEW NODE
9006c7836
< ERR 045,BREAKX EVALUATED ARGUMENT IS NOT STRING
---
> ERR 052,BREAKX EVALUATED ARGUMENT IS NOT STRING
9008,9009c7838
< PPM PBRK1 MERGE WITH BREAK IF ALL OK
< EJC
---
> BRI XL MERGE WITH BREAK IF ALL OK
9060c7889
< ERR 046,EXPRESSION DOES NOT EVALUATE TO PATTERN
---
> ERR 053,EXPRESSION DOES NOT EVALUATE TO PATTERN
9068c7897,7908
< BRN PSTR1 ELSE MERGE WITH STRING CIRCUIT
---
> MOV XR,PSAVE SAVE NODE PTR
> MOV R$PMS,XR LOAD SUBJECT STRING PTR
> PLC XR,WB POINT TO CURRENT CHAR
> ADD SCLEN(XL),WB COMPUTE NEW CURSOR POSITION
> BGT WB,PMSSL,FAILP FAIL IF PAST END OF STRING
> MOV WB,PSAVC SAVE UPDATED CURSOR
> MOV SCLEN(XL),WA NUMBER OF CHARS TO COMPARE
> PLC XL POINT TO TEST STRING CHARS
> CMC FAILP,FAILP COMPARE, FAIL IF UNEQUAL
> MOV PSAVE,XR IF ALL MATCHED, RESTORE NODE PTR
> MOV PSAVC,WB RESTORE UPDATED CURSOR
> BRN SUCCP AND SUCCEED
9093d7932
< EJC
9102d7940
< *
9114c7952,7953
< EJC
---
> .IF .CNFN
> .ELSE
9128d7966
< EJC
9137d7974
< EJC
9155d7991
< EJC
9163a8000
> .FI
9180d8016
< EJC
9232d8067
< EJC
9251,9254c8086
< *
< * EXPRESSION ARGUMENT CASE MERGES HERE
< *
< PLEN1 ADD PARM1(XR),WB PUSH CURSOR INDICATED AMOUNT
---
> ADD PARM1(XR),WB PUSH CURSOR INDICATED AMOUNT
9257d8088
< EJC
9265,9266c8096,8097
< ERR 047,LEN EVALUATED ARGUMENT IS NOT INTEGER
< ERR 048,LEN EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 054,LEN EVALUATED ARGUMENT IS NOT INTEGER
> ERR 055,LEN EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
9268c8099,8101
< PPM PLEN1 MERGE WITH NORMAL CIRCUIT IF OK
---
> ADD PARM1(XR),WB PUSH CURSOR INDICATED AMOUNT
> BLE WB,PMSSL,SUCCP SUCCEED IF NOT OFF END
> BRN FAILP ELSE FAIL
9275a8109
> MOV =P$NAY,WA PCODE FOR NEW NODE
9277c8111
< ERR 049,NOTANY EVALUATED ARGUMENT IS NOT STRING
---
> ERR 056,NOTANY EVALUATED ARGUMENT IS NOT STRING
9279c8113
< PPM PNAY1 MERGE WITH MULTI-CHAR CASE IF OK
---
> BRI XL MERGE WITH MULTI-CHAR CASE IF OK
9296a8131
> * EXPRESSION ARGUMENT CASE MERGES
9302,9305c8137
< *
< * EXPRESSION ARGUMENT CASE MERGES HERE
< *
< PNAY1 BEQ WB,PMSSL,FAILP FAIL IF NO CHARACTERS LEFT
---
> BEQ WB,PMSSL,FAILP FAIL IF NO CHARACTERS LEFT
9309c8141
< WTB WA CONVERT TO BYTE OFFSET
---
> WTB WA CONVERT TO BAU OFFSET
9405a8238
> ZER R$PMB CLEAR POSSIBLE BCBLK PTR FOR GBCOL
9418a8252
> MOV XL,-(XS) STACK SUBJECT STRING POINTER
9422c8256
< .FI
---
> ZER R$PMB CLEAR BCBLK PTR FOR GBCOL
9426a8261
> .FI
9435,9438c8270
< *
< * EXPRESSION ARGUMENT CASE MERGES HERE
< *
< PPOS1 BEQ WB,PARM1(XR),SUCCP SUCCEED IF AT RIGHT LOCATION
---
> BEQ WB,PARM1(XR),SUCCP SUCCEED IF AT RIGHT LOCATION
9440d8271
< EJC
9448,9449c8279,8280
< ERR 050,POS EVALUATED ARGUMENT IS NOT INTEGER
< ERR 051,POS EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 057,POS EVALUATED ARGUMENT IS NOT INTEGER
> ERR 058,POS EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
9451c8282,8283
< PPM PPOS1 MERGE WITH NORMAL CASE IF OK
---
> BEQ WB,PARM1(XR),SUCCP SUCCEED IF AT RIGHT LOCATION
> BRN FAILP ELSE FAIL
9465d8296
< EJC
9476d8306
< EJC
9493d8322
< EJC
9513d8341
< EJC
9521,9522c8349,8350
< ERR 052,RPOS EVALUATED ARGUMENT IS NOT INTEGER
< ERR 053,RPOS EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 059,RPOS EVALUATED ARGUMENT IS NOT INTEGER
> ERR 060,RPOS EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
9524,9525c8352,8353
< PPM PRPS1 MERGE WITH NORMAL CASE IF OK
< EJC
---
> MOV =P$RPS,XL CONTINUATION ROUTINE
> BRI XL ENTER ROUTINE
9527a8356
> * EXPRESSION ARGUMENT CASE MERGES
9532,9535c8361
< *
< * EXPRESSION ARGUMENT CASE MERGES HERE
< *
< PRPS1 MOV PMSSL,WC GET LENGTH OF STRING
---
> MOV PMSSL,WC GET LENGTH OF STRING
9541a8368
> * EXPRESSION ARGUMENT CASE MERGES
9546,9549c8373
< *
< * EXPRESSION ARGUMENT CASE MERGES HERE
< *
< PRTB1 MOV WB,WC SAVE INITIAL CURSOR
---
> MOV WB,WC SAVE INITIAL CURSOR
9555d8378
< EJC
9563,9564c8386,8387
< ERR 054,RTAB EVALUATED ARGUMENT IS NOT INTEGER
< ERR 055,RTAB EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 061,RTAB EVALUATED ARGUMENT IS NOT INTEGER
> ERR 062,RTAB EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
9566c8389,8390
< PPM PRTB1 MERGE WITH NORMAL CASE IF SUCCESS
---
> MOV =P$RTB,XL CONTINUATION ROUTINE
> BRI XL ENTER ROUTINE
9573a8398
> MOV =P$SPN,WA PCODE FOR NEW NODE
9575c8400
< ERR 056,SPAN EVALUATED ARGUMENT IS NOT STRING
---
> ERR 063,SPAN EVALUATED ARGUMENT IS NOT STRING
9577,9578c8402
< PPM PSPN1 MERGE WITH MULTI-CHAR CASE IF OK
< EJC
---
> BRI XL MERGE WITH MULTI-CHAR CASE IF OK
9580a8405
> * EXPRESSION ARGUMENT CASE MERGES
9586,9589c8411
< *
< * EXPRESSION ARGUMENT CASE MERGES HERE
< *
< PSPN1 MOV PMSSL,WC COPY SUBJECT STRING LENGTH
---
> MOV PMSSL,WC COPY SUBJECT STRING LENGTH
9601c8423
< WTB WA CONVERT TO BYTE OFFSET
---
> WTB WA CONVERT TO BAU OFFSET
9641d8462
< EJC
9643c8464
< * MULTI-CHARACTER STRING
---
> * MULTI-CHARACTER STRING (MERGE FROM P$EXA)
9652,9655c8473
< *
< * MERGE HERE AFTER EVALUATING EXPRESSION WITH STRING VALUE
< *
< PSTR1 MOV XR,PSAVE SAVE NODE POINTER
---
> MOV XR,PSAVE SAVE NODE POINTER
9682a8501
> * EXPRESSION CASE MERGES
9687,9690c8506
< *
< * EXPRESSION ARGUMENT CASE MERGES HERE
< *
< PTAB1 BGT WB,PARM1(XR),FAILP FAIL IF TOO FAR ALREADY
---
> BGT WB,PARM1(XR),FAILP FAIL IF TOO FAR ALREADY
9694d8509
< EJC
9702,9703c8517,8518
< ERR 057,TAB EVALUATED ARGUMENT IS NOT INTEGER
< ERR 058,TAB EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 064,TAB EVALUATED ARGUMENT IS NOT INTEGER
> ERR 065,TAB EVALUATED ARGUMENT IS NEGATIVE OR TOO LARGE
9705,9706c8520,8521
< PPM PTAB1 MERGE WITH NORMAL CASE IF OK
< EJC
---
> MOV =P$TAB,XL CONTINUATION ROUTINE
> BRI XL ENTER ROUTINE
9721d8535
< EJC
9764c8578
< ERR 059,ANY ARGUMENT IS NOT STRING OR EXPRESSION
---
> ERR 066,ANY ARGUMENT IS NOT STRING OR EXPRESSION
9766d8579
< EJC
9768a8582
> EJC
9776c8590
< ERB 275,APPEND FIRST ARGUMENT IS NOT BUFFER
---
> ERB 067,APPEND FIRST ARGUMENT IS NOT BUFFER
9780,9781c8594,8597
< SAPN1 JSR APNDB DO THE APPEND
< ERR 276,APPEND SECOND ARGUMENT IS NOT STRING
---
> SAPN1 MOV BCLEN(XR),WA OFFSET TO BUFFER END
> ZER WB NO CHARS TO BE REPLACED
> JSR INSBF DO THE APPEND
> ERR 068,APPEND SECOND ARGUMENT IS NOT STRING
9784d8599
< EJC
9785a8601
> EJC
9796c8612
< WTB WB CONVERT TO BYTES
---
> WTB WB CONVERT TO BAUS
9819c8635
< SAPP3 ERB 060,APPLY FIRST ARG IS NOT NATURAL VARIABLE NAME
---
> SAPP3 ERB 069,APPLY FIRST ARG IS NOT NATURAL VARIABLE NAME
9841c8657
< ERR 061,ARBNO ARGUMENT IS NOT PATTERN
---
> ERR 070,ARBNO ARGUMENT IS NOT PATTERN
9857c8673
< ERR 062,ARG SECOND ARGUMENT IS NOT INTEGER
---
> ERR 253,ARG SECOND ARGUMENT IS NOT INTEGER
9874c8690
< SARG1 ERB 063,ARG FIRST ARGUMENT IS NOT PROGRAM FUNCTION NAME
---
> SARG1 ERB 252,ARG FIRST ARGUMENT IS NOT PROGRAM FUNCTION NAME
9892c8708
< WTB WA CONVERT LENGTH TO BYTES
---
> WTB WA CONVERT LENGTH TO BAUS
9914c8730
< ERR 064,ARRAY FIRST ARGUMENT IS NOT INTEGER OR STRING
---
> ERR 071,ARRAY FIRST ARGUMENT IS NOT INTEGER OR STRING
9938c8754
< ERR 065,ARRAY FIRST ARGUMENT LOWER BOUND IS NOT INTEGER
---
> ERR 072,ARRAY FIRST ARGUMENT LOWER BOUND IS NOT INTEGER
9950,9951c8766,8772
< SAR04 JSR GTINT CONVERT HIGH BOUND TO INTEGER
< ERR 066,ARRAY FIRST ARGUMENT UPPER BOUND IS NOT INTEGER
---
> SAR04 BNZ WA,SAR4A SKIP IF DELIMITER 1 OR 2
> BNZ XSCNB,SAR10 JUMP IF ILLEGALLY PLACED BLANK
> *
> * CHECK FOR INTEGER BOUND
> *
> SAR4A JSR GTINT CONVERT HIGH BOUND TO INTEGER
> ERR 073,ARRAY FIRST ARGUMENT UPPER BOUND IS NOT INTEGER
9989c8810
< WTB WB ELSE CONVERT TO LENGTH IN BYTES
---
> WTB WB ELSE CONVERT TO LENGTH IN BAUS
10007c8828
< MOV WA,WC SAVE LENGTH IN BYTES
---
> MOV WA,WC SAVE LENGTH IN BAUS
10024c8845
< MOV WC,ARLEN(XR) STORE LENGTH IN BYTES
---
> MOV WC,ARLEN(XR) STORE LENGTH IN BAUS
10044c8865
< SAR10 ERB 067,ARRAY DIMENSION IS ZERO,NEGATIVE OR OUT OF RANGE
---
> SAR10 ERB 074,BAD DIMENSION, ZERO, NEGATIVE OR OUT OF RANGE
10048c8869
< SAR11 ERB 068,ARRAY SIZE EXCEEDS MAXIMUM PERMITTED
---
> SAR11 ERB 075,ARRAY SIZE EXCEEDS MAXIMUM PERMITTED
10050,10051d8870
< .IF .CNBF
< .ELSE
10053,10078d8871
< * BUFFER
< *
< S$BUF ENT ENTRY POINT
< MOV (XS)+,XL GET INITIAL VALUE
< MOV (XS)+,XR GET REQUESTED ALLOCATION
< JSR GTINT CONVERT TO INTEGER
< ERR 269,BUFFER FIRST ARGUMENT IS NOT INTEGER
< LDI ICVAL(XR) GET VALUE
< ILE SBF01 BRANCH IF NEGATIVE OR ZERO
< MFI WA,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
< .FI
< *
10086c8879
< ERR 069,BREAK ARGUMENT IS NOT STRING OR EXPRESSION
---
> ERR 076,BREAK ARGUMENT IS NOT STRING OR EXPRESSION
10100c8893
< ERR 070,BREAKX ARGUMENT IS NOT STRING OR EXPRESSION
---
> ERR 077,BREAKX ARGUMENT IS NOT STRING OR EXPRESSION
10113a8907,8908
> .IF .CNBF
> .ELSE
10116c8911
< * CHAR
---
> * BUFFER
10118,10130c8913,8923
< S$CHR ENT ENTRY POINT
< JSR GTSMI CONVERT ARG TO INTEGER
< ERR 281,CHAR ARGUMENT NOT INTEGER
< PPM SCHR1 TOO BIG ERROR EXIT
< BGE WC,=CFP$A,SCHR1 SEE IF OUT OF RANGE OF HOST SET
< MOV =NUM01,WA IF NOT SET SCBLK ALLOCATION
< MOV WC,WB SAVE CHAR CODE
< JSR ALOCS ALLOCATE 1 BAU SCBLK
< MOV XR,XL COPY SCBLK POINTER
< PSC XL GET SET TO STUFF CHAR
< SCH WB,(XL)+ STUFF IT
< ZER XL CLEAR SLOP IN XL
< BRN EXIXR EXIT WITH SCBLK POINTER
---
> S$BUF ENT ENTRY POINT
> MOV (XS)+,XL GET INITIAL STRING
> JSR GTSMI CONVERT MEMORY REQUEST TO INTEGER
> ERR 078,BUFFER FIRST ARGUMENT IS NOT INTEGER
> PPM SBF01 FAIL IF OUT OF RANGE
> MOV WC,WA MOVE LENGTH TO CORRECT REGISTER
> JSR ALOBF ALLOCATE THE BUFFER
> JSR INSBF COPY INITIAL ARG IN
> ERR 079,BUFFER SECOND ARGUMENT IS NOT STRING OR BUFFER
> ERR 080,BUFFER INITIAL VALUE TOO BIG FOR ALLOCATION
> BRN EXSID EXIT SETTING IDVAL
10132c8925
< * HERE IF CHAR ARGUMENT IS OUT OF RANGE
---
> * HERE FOR INVALID ALLOCATION SIZE
10134c8927,8928
< SCHR1 ERB 282,CHAR ARGUMENT NOT IN RANGE
---
> SBF01 ERB 081,BUFFER FIRST ARGUMENT IS OUT OF RANGE
> .FI
10141c8935
< ERR 071,CLEAR ARGUMENT IS NOT STRING
---
> ERR 082,CLEAR ARGUMENT IS NOT STRING
10145c8939
< * THE LIST ARE FALGGED BY SETTING VRGET OF VRBLK TO ZERO.
---
> * THE LIST ARE FLAGGED BY SETTING VRGET OF VRBLK TO ZERO.
10151c8945
< ERR 072,CLEAR ARGUMENT HAS NULL VARIABLE NAME
---
> PPM SCLR7 ERRONEOUS NAME
10153a8948
> BNZ XSCNB,SCLR7 BADLY PLACED BLANK
10181c8976
< * PRROTECTED VARIABLES (ARB, ETC) ARE EXEMPT
---
> * PROTECTED VARIABLES (ARB ETC) ARE EXEMPT
10183,10184c8978,8979
< SCLR5 BEQ VRSTO(XR),=B$VRE,SCLR4 CHECK FOR PROTECTED VARIABLE (REG05)
< MOV XR,XL COPY VRBLK POINTER (REG05)
---
> SCLR5 BEQ VRSTO(XR),=B$VRE,SCLR4 CHECK FOR PROTECTED VARIABLE
> MOV XR,XL COPY VRBLK POINTER
10196a8992,8995
> *
> * ERROR POINT
> *
> SCLR7 ERB 083,NULL VARIABLE NAME OR ILLEGAL BLANK IN CLEAR ARG
10213c9012
< ERR 073,COLLECT ARGUMENT IS NOT INTEGER
---
> ERR 084,COLLECT ARGUMENT IS NOT INTEGER
10220c9019
< BTW WA CONVERT BYTES TO WORDS
---
> BTW WA CONVERT BAUS TO WORDS
10231c9030
< S$CNV ENT ENTRY POINT
---
> S$CVT ENT ENTRY POINT
10233,10235c9032,9036
< ERR 074,CONVERT SECOND ARGUMENT IS NOT STRING
< .IF .CULC
< JSR FLSTG FOLD LOWER CASE TO UPPER CASE
---
> ERR 085,CONVERT SECOND ARGUMENT IS NOT STRING
> .IF .CASL
> MOV XR,XL COPY STRING PTR TO XL
> ZER WB ZERO OFFSET
> JSR SBSTG CONVERT CASE OF ARG IF NECESSARY
10253c9054
< MOV WA,WC SAVE LENGTH OF ARGUMENT STRING
---
> MOV SCLEN(XR),WC SAVE LENGTH OF ARGUMENT STRING
10287c9088
< IFF CNVRT,SCV08 REAL
---
> IFF 9,SCV08 REAL
10371c9172
< WTB WA CONVERT LENGTH TO BYTES
---
> WTB WA CONVERT LENGTH TO BAUS
10441,10442c9242
< SCV28 MOV XR,-(XS) STACK STRING FOR PROCEDURE
< JSR GTSTG CONVERT TO STRING
---
> SCV28 JSR GTBUF CONVERT TO BUFFER
10444,10448d9243
< MOV XR,XL 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
10450d9244
< EJC
10451a9246
> EJC
10456c9251
< JSR COPYB COPY THE BLOCK
---
> JSR CBLCK COPY THE BLOCK
10458a9254,9270
> *
> * CTI
> *
> S$CTI ENT
> LDI INTV0 ZERO IN CASE NULL STRING
> JSR GTSTG GET ARG AS A STRING
> ERR 086,CTI ARGUMENT IS NOT A STRING
> BZE WA,SCT01 SKIP IF NULL
> PLC XR PREPARE TO READ THE CHARACTER
> LCH WB,(XR) GET THE CHARACTER
> MTI WB CONVERT TO INTEGER
> ZER XR CLEAR GARBAGE
> *
> * MAKE ICBLK AND RETURN
> *
> SCT01 JSR ICBLD BUILD ICBLK
> BRN EXIXR RETURN INTEGER RESULT
10465,10466c9277,9278
< ERR 075,DATA ARGUMENT IS NOT STRING
< ERR 076,DATA ARGUMENT IS NULL
---
> ERR 087,DATA ARGUMENT IS NOT STRING
> ERR 088,DATA ARGUMENT IS NULL
10474c9286
< ERB 077,DATA ARGUMENT IS MISSING A LEFT PAREN
---
> ERB 089,DATA ARGUMENT IS MISSING A LEFT PAREN
10478,10482d9289
< .IF .CULC
< SDAT1 MOV SCLEN(XR),WA GET LENGTH
< JSR FLSTG FOLD LOWER CASE TO UPPER CASE
< MOV XR,XL SAVE NAME PTR
< .ELSE
10484d9290
< .FI
10493c9299
< ERR 078,DATA ARGUMENT HAS NULL DATATYPE NAME
---
> ERR 090,DATA ARGUMENT HAS NULL DATATYPE NAME
10504c9310
< ERB 079,DATA ARGUMENT IS MISSING A RIGHT PAREN
---
> ERB 091,BAD BLANK OR MISSING RIGHT PAREN IN DATA ARG
10509c9315
< ERR 080,DATA ARGUMENT HAS NULL FIELD NAME
---
> ERR 092,DATA ARGUMENT HAS NULL FIELD NAME
10521c9327
< WTB WA CONVERT LENGTH TO BYTES
---
> WTB WA CONVERT LENGTH TO BAUS
10608c9414
< S$DEF ENT ENTRY POINT
---
> S$DFN ENT ENTRY POINT
10619,10620c9425,9426
< ERR 081,DEFINE FIRST ARGUMENT IS NOT STRING
< ERR 082,DEFINE FIRST ARGUMENT IS NULL
---
> ERR 093,DEFINE FIRST ARGUMENT IS NOT STRING
> ERR 094,DEFINE FIRST ARGUMENT IS NULL
10625c9431
< ERB 083,DEFINE FIRST ARGUMENT IS MISSING A LEFT PAREN
---
> ERB 095,DEFINE FIRST ARGUMENT IS MISSING A LEFT PAREN
10630c9436
< ERR 084,DEFINE FIRST ARGUMENT HAS NULL FUNCTION NAME
---
> ERR 096,DEFINE FIRST ARGUMENT HAS NULL FUNCTION NAME
10642,10643c9448,9454
< BNZ WA,SDF04 SKIP IF DELIMITER FOUND
< ERB 085,NULL ARG NAME OR MISSING ) IN DEFINE FIRST ARG.
---
> BZE WA,SDF14 FAIL IF RUNOUT
> JSR GTNVR GET VRBLK POINTER
> PPM SDF04 IGNORE NULL NAME
> MOV XR,-(XS) STACK ARGUMENT VRBLK POINTER
> ICV WB INCREMENT COUNTER
> BEQ WA,=NUM02,SDF03 LOOP BACK IF STOPPED BY A COMMA
> BRN SDF05 JUMP FOR RIGHT PAREN
10648c9459
< * HERE AFTER SCANNING AN ARGUMENT NAME
---
> * NULL ARG FOUND. CONTINUE IF STOPPED BY COMMA
10650,10651c9461
< SDF04 BNE XR,=NULLS,SDF05 SKIP IF NON-NULL
< BZE WB,SDF06 IGNORE NULL IF CASE OF NO ARGUMENTS
---
> SDF04 BEQ WA,=NUM02,SDF03 LOOP IF COMMA
10653,10660d9462
< * HERE AFTER DEALING WITH THE CASE OF NO ARGUMENTS
< *
< SDF05 JSR GTNVR GET VRBLK POINTER
< PPM SDF03 LOOP BACK TO IGNORE NULL NAME
< MOV XR,-(XS) STACK ARGUMENT VRBLK POINTER
< ICV WB INCREMENT COUNTER
< BEQ WA,=NUM02,SDF03 LOOP BACK IF STOPPED BY A COMMA
< *
10663c9465
< SDF06 MOV WB,DEFNA SAVE NUMBER OF ARGUMENTS
---
> SDF05 MOV WB,DEFNA SAVE NUMBER OF ARGUMENTS
10668c9470
< SDF07 MOV =CH$CM,WC SET DELIMITER ONE = COMMA
---
> SDF06 MOV =CH$CM,WC SET DELIMITER ONE = COMMA
10671,10672c9473,9474
< BNE XR,=NULLS,SDF08 SKIP IF NON-NULL
< BZE WB,SDF09 IGNORE NULL IF CASE OF NO LOCALS
---
> BNZ WA,SDF07 SKIP IF COMMA FOUND
> BNZ XSCNB,SDF14 FAIL IF BAD BLANK, OK IF LAST LOC
10676,10677c9478,9479
< SDF08 JSR GTNVR GET VRBLK POINTER
< PPM SDF07 LOOP BACK TO IGNORE NULL NAME
---
> SDF07 JSR GTNVR GET VRBLK POINTER
> PPM SDF08 IGNORE NULL NAME
10680c9482,9487
< BNZ WA,SDF07 LOOP BACK IF STOPPED BY A COMMA
---
> BNZ WA,SDF06 LOOP BACK IF STOPPED BY A COMMA
> BRN SDF09 JUMP FOR END OF STRING
> *
> * NULL LOCAL
> *
> SDF08 BNZ WA,SDF06 LOOP IF COMMA AFTER NULL LOCAL
10691c9498
< WTB WA CONVERT LENGTH TO BYTES
---
> WTB WA CONVERT LENGTH TO BAUS
10734c9541,9545
< SDF13 ERB 086,DEFINE FUNCTION ENTRY POINT IS NOT DEFINED LABEL
---
> SDF13 ERB 097,DEFINE FUNCTION ENTRY POINT IS NOT DEFINED LABEL
> *
> * ERRONEOUS ARG OR LOCAL
> *
> SDF14 ERB 098,BAD BLANK OR MISSING RIGHT PAREN IN DEFINE ARG
10742,10744c9553,9573
< ERR 087,DETACH ARGUMENT IS NOT APPROPRIATE NAME
< JSR DTACH DETACH I/O ASSOCIATION FROM NAME
< BRN EXNUL RETURN NULL RESULT
---
> ERR 099,DETACH ARGUMENT IS NOT APPROPRIATE NAME
> MOV WA,-(XS) KEEP OFFSET
> ZER SDETF CLEAR FAIL FLAG
> MOV =TRTIN,WB TRACE TYPE
> ZER XR REMOVE TRBLK
> JSR TRCHN REMOVE ANY INPUT ASSOCIATION
> PPM SDET1 SKIP IF NO INPUT TRBLK
> MNZ SDETF NOTE TRBLK REMOVED
> *
> * REPEAT FOR OUTPUT TRBLK
> *
> SDET1 MOV (XS)+,WA RECOVER OFFSET
> MOV =TRTOU,WB TRTYP
> JSR TRCHN REMOVE ANY OUTPUT ASSOCIATION
> PPM SDET2 SKIP IF NO TRBLK
> BRN EXNUL SUCCEED
> *
> * CHECK AT LEAST ONE TRBLK REMOVED
> *
> SDET2 BNZ SDETF,EXNUL SUCCEED IF SO
> BRN EXFAL ELSE FAIL
10761,10762c9590,9591
< ERR 088,DUMP ARGUMENT IS NOT INTEGER
< ERR 089,DUMP ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 100,DUMP ARGUMENT IS NOT INTEGER
> ERR 101,DUMP ARGUMENT IS NEGATIVE OR TOO LARGE
10771c9600
< ERR 090,DUPL SECOND ARGUMENT IS NOT INTEGER
---
> ERR 102,DUPL SECOND ARGUMENT IS NOT INTEGER
10816c9645
< ERR 091,DUPL FIRST ARGUMENT IS NOT STRING OR PATTERN
---
> ERR 103,DUPL FIRST ARGUMENT IS NOT STRING OR PATTERN
10848,10850c9677,9685
< JSR IOFCB CALL FCBLK ROUTINE
< ERR 092,EJECT ARGUMENT IS NOT A SUITABLE NAME
< PPM SEJC1 NULL ARGUMENT
---
> MOV (XS)+,WB GET ARGUMENT
> MOV WB,-(XS) RESTACK IT
> JSR GTSTG CONVERT TO STRING
> PPM SEJC2 FAIL IF CANT
> BZE WA,SEJC1 SKIP IF NULL STRING
> MOV WB,-(XS) RESTACK ORIGINAL ARG
> JSR IOFTG CALL FILETAG ROUTINE
> PPM SEJC2 FAIL
> BZE WA,EXFAL FAIL IF NOT ASSOCIATED
10852,10854c9687,9688
< ERR 093,EJECT FILE DOES NOT EXIST
< ERR 094,EJECT FILE DOES NOT PERMIT PAGE EJECT
< ERR 095,EJECT CAUSED NON-RECOVERABLE OUTPUT ERROR
---
> PPM EXFAL FAIL RETURN
> PPM EROSI ERROR RETURN
10859a9694,9695
> PPM EXFAL FAIL RETURN
> PPM EROSI ERROR RETURN
10860a9697,9700
> *
> * ERROR POINT
> *
> SEJC2 ERB 104,EJECT ARGUMENT IS NOT A SUITABLE FILETAG
10866,10873c9706,9709
< 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 XL,WB REMEMBER VRBLK PTR FROM IOFCB CALL
---
> JSR GTSTG CONVERT SECOND ARG TO STRING
> ERR 105,ENDFILE SECOND ARGUMENT IS NOT A STRING
> BNZ WA,SENF1 SKIP IF NON NULL SECOND ARG
> ZER XR 0 IF NULL
10875c9711
< * LOOP TO FIND TRTRF BLOCK
---
> * NOW PROCESS FILETAG
10877,10909c9713,9728
< SENF1 MOV XL,XR COPY POINTER
< MOV TRVAL(XR),XR CHAIN ALONG
< BNE (XR),=B$TRT,EXNUL SKIP OUT IF CHAIN END
< BNE TRTYP(XR),=TRTFC,SENF1 LOOP IF NOT FOUND
< MOV TRVAL(XR),TRVAL(XL) REMOVE TRTRF
< MOV TRTRF(XR),ENFCH POINT TO HEAD OF IOCHN
< MOV TRFPT(XR),WC POINT TO FCBLK
< MOV WB,XR FILEARG1 VRBLK FROM IOFCB
< JSR SETVR RESET IT
< MOV =R$FCB,XL PTR TO HEAD OF FCBLK CHAIN
< SUB *NUM02,XL ADJUST READY TO ENTER LOOP
< *
< * FIND FCBLK
< *
< SENF2 MOV XL,XR COPY PTR
< MOV 2(XL),XL GET NEXT LINK
< BZE XL,SENF4 STOP IF CHAIN END
< BEQ 3(XL),WC,SENF3 JUMP IF FCBLK FOUND
< BRN SENF2 LOOP
< *
< * REMOVE FCBLK
< *
< SENF3 MOV 2(XL),2(XR) DELETE FCBLK FROM CHAIN
< *
< * LOOP WHICH DETACHES ALL VBLS ON IOCHN CHAIN
< *
< SENF4 MOV ENFCH,XL GET CHAIN HEAD
< BZE XL,EXNUL FINISHED IF CHAIN END
< MOV TRTRF(XL),ENFCH CHAIN ALONG
< MOV IONMO(XL),WA NAME OFFSET
< MOV IONMB(XL),XL NAME BASE
< JSR DTACH DETACH NAME
< BRN SENF4 LOOP TILL DONE
---
> SENF1 MOV XR,SENFR KEEP SECOND ARG
> JSR IOFTG CALL FILETAG PROC (WB = VRBLK PTR)
> ERR 106,ENDFILE FIRST ARGUMENT IS NOT A SUITABLE FILETAG
> BZE WA,EXFAL FAIL IF NO IOTAG
> MOV SENFR,XR RECOVER SECOND ARG
> JSR SYSEN CALL ENDFILE ROUTINE
> PPM EXFAL FAIL RETURN
> PPM EROSI ERROR RETURN
> BNZ WA,EXNUL RETURN NULL IF NO FILE CLOSURE
> MOV WB,XL POINT TO FILETAG VRBLK
> MOV *VRVAL,WA OFFSET TO VALUE FIELD
> ZER XR FOR TRBLK REMOVAL
> MOV =TRTIO,WB TRTYP
> JSR TRCHN REMOVE TRBLK
> PPM EXFAL (CANT FAIL HERE)
> BRN EXNUL RETURN NULL
10916,10917c9735,9736
< ERR 101,EQ FIRST ARGUMENT IS NOT NUMERIC
< ERR 102,EQ SECOND ARGUMENT IS NOT NUMERIC
---
> ERR 107,EQ FIRST ARGUMENT IS NOT NUMERIC
> ERR 108,EQ SECOND ARGUMENT IS NOT NUMERIC
10928c9747
< ERR 103,EVAL ARGUMENT IS NOT EXPRESSION
---
> ERR 109,EVAL ARGUMENT IS NOT EXPRESSION
10963c9782
< ERR 104,EXIT ARGUMENT IS NOT SUITABLE INTEGER OR STRING
---
> ERR 110,EXIT ARGUMENT IS NOT SUITABLE INTEGER OR STRING
10969d9787
< MOV R$FCB,WB GET FCBLK CHAIN HEADER
10973a9792
> MOV =KVCOD,WA VALUE OF CODE KEYWORD
10975,10976c9794,9795
< ERR 105,EXIT ACTION NOT AVAILABLE IN THIS IMPLEMENTATION
< ERR 106,EXIT ACTION CAUSED IRRECOVERABLE ERROR
---
> PPM EXFAL FAIL RETURN
> PPM EROSI ERROR RETURN
10978c9797
< ZER GBCNT RESUMING EXECUTION SO RESET
---
> ZER GBCNT RESUMING EXECUTION SO.
10984c9803
< SEXT2 MFI WC GET VALUE IN WORK REG
---
> SEXT2 MFI WC GET VALUE IN WORK REGISTER
10989c9808
< MOV (XS)+,WC RESTORE VALUE
---
> MOV (XS)+,WA RESTORE VALUE
10991c9810
< * DEAL WITH HEADER OPTION (FIDDLED BY PRPAR)
---
> * DEAL WITH HEADER OPTIONS (FIDDLED BY PRPAR)
10999c9818
< SEXT4 JSR SYSTM GET EXECUTION TIME START (SGD11)
---
> SEXT4 JSR SYSTM GET RECOMMENCEMENT TIME
11004a9824,9825
> .IF .CNFN
> .ELSE
11006a9828,9848
> * FENCE
> *
> S$FNC ENT ENTRY POINT
> MOV =P$FNC,WB SET PCODE FOR P$FNC
> ZER XR P0BLK
> JSR PBILD BUILD P$FNC NODE
> MOV XR,XL SAVE POINTER TO IT
> MOV (XS)+,XR GET ARGUMENT
> JSR GTPAT CONVERT TO PATTERN
> ERR 180,FENCE ARGUMENT IS NOT PATTERN
> JSR PCONC CONCATENATE TO P$FNC NODE
> MOV XR,XL SAVE PTR TO CONCATENATED PATTERN
> MOV =P$FNA,WB SET FOR P$FNA PCODE
> ZER XR P0BLK
> JSR PBILD CONSTRUCT P$FNA NODE
> MOV XL,PTHEN(XR) SET PATTERN AS PTHEN
> MOV XR,-(XS) SET AS RESULT
> BRN EXITS DO NEXT CODE WORD
> EJC
> .FI
> *
11011c9853
< ERR 107,FIELD SECOND ARGUMENT IS NOT INTEGER
---
> ERR 255,FIELD SECOND ARGUMENT IS NOT INTEGER
11031c9873
< SFLD1 ERB 108,FIELD FIRST ARGUMENT IS NOT DATATYPE NAME
---
> SFLD1 ERB 254,FIELD FIRST ARGUMENT IS NOT DATATYPE NAME
11034,11053d9875
< * FENCE
< *
< S$FNC ENT ENTRY POINT
< MOV =P$FNC,WB SET PCODE FOR P$FNC
< ZER XR P0BLK
< JSR PBILD BUILD P$FNC NODE
< MOV XR,XL SAVE POINTER TO IT
< MOV (XS)+,XR GET ARGUMENT
< JSR GTPAT CONVERT TO PATTERN
< ERR 259,FENCE ARGUMENT IS NOT PATTERN
< JSR PCONC CONCATENATE TO P$FNC NODE
< MOV XR,XL SAVE PTR TO CONCATENATED PATTERN
< MOV =P$FNA,WB SET FOR P$FNA PCODE
< ZER XR P0BLK
< JSR PBILD CONSTRUCT P$FNA NODE
< MOV XL,PTHEN(XR) SET PATTERN AS PTHEN
< MOV XR,-(XS) SET AS RESULT
< BRN EXITS DO NEXT CODE WORD
< EJC
< *
11058,11059c9880,9881
< ERR 109,GE FIRST ARGUMENT IS NOT NUMERIC
< ERR 110,GE SECOND ARGUMENT IS NOT NUMERIC
---
> ERR 111,GE FIRST ARGUMENT IS NOT NUMERIC
> ERR 112,GE SECOND ARGUMENT IS NOT NUMERIC
11063d9884
< EJC
11069,11070c9890,9891
< ERR 111,GT FIRST ARGUMENT IS NOT NUMERIC
< ERR 112,GT SECOND ARGUMENT IS NOT NUMERIC
---
> ERR 113,GT FIRST ARGUMENT IS NOT NUMERIC
> ERR 114,GT SECOND ARGUMENT IS NOT NUMERIC
11079,11087c9900,9913
< MOV (XS)+,XR GET THIRD ARG
< MOV (XS)+,XL GET SECOND ARG
< MOV (XS)+,WA 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
---
> JSR GTSTG CONVERT ARG TO STRING
> ERR 115,ERRONEOUS THIRD ARGUMENT FOR HOST
> MOV WA,WB KEEP LENGTH
> MOV XR,WC KEEP THIRD ARG
> JSR GTSTG CONVERT ARG TO STRING
> ERR 116,ERRONEOUS SECOND ARGUMENT FOR HOST
> ORB WA,WB NON ZERO UNLESS TWO ARGS NULL
> MOV XR,XL KEEP SECOND ARG
> JSR GTSTG CONVERT ARG TO STRING
> ERR 117,ERRONEOUS FIRST ARGUMENT FOR HOST
> ORB WA,WB NON ZERO UNLESS ALL ARGS NULL
> MOV XR,WA KEEP FIRST ARG
> MOV WC,XR GET THIRD ARG
> JSR SYSHS CALL SYSHS ROUTINE
11089,11093c9915,9916
< *
< * RETURN HOST STRING
< *
< SHST1 BZE XL,EXNUL NULL STRING IF SYSHS UNCOOPERATIVE
< MOV SCLEN(XL),WA LENGTH
---
> PPM EROSI ERROR RETURN
> MOV SCLEN(XL),WA LENGTH OF RETURNED STRING
11115,11120c9938,9941
< 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
---
> ERR 118,INPUT THIRD ARGUMENT (FILEPROPS) IS NOT A STRING
> ERR 119,INAPPROPRIATE SECOND ARGUMENT (FILETAG) FOR INPUT
> ERR 120,INAPPROPRIATE FIRST ARGUMENT FOR INPUT
> PPM EXFAL FAIL RETURN
11122d9942
< EJC
11124a9945
> EJC
11131c9952
< ERR 277,INSERT THIRD ARGUMENT NOT INTEGER
---
> ERR 121,INSERT THIRD ARGUMENT NOT INTEGER
11135c9956
< ERR 278,INSERT SECOND ARGUMENT NOT INTEGER
---
> ERR 122,INSERT SECOND ARGUMENT NOT INTEGER
11142c9963
< ERB 279,INSERT FIRST ARGUMENT NOT BUFFER
---
> ERB 123,INSERT FIRST ARGUMENT NOT BUFFER
11147c9968
< ERR 280,INSERT FOURTH ARGUMENT NOT A STRING
---
> ERR 124,INSERT FOURTH ARGUMENT NOT A STRING
11150d9970
< EJC
11151a9972
> EJC
11162a9984,10000
> * ITC
> *
> S$ITC ENT
> JSR GTSMI OBTAIN ARG AS AN INTEGER
> ERR 125,ITC ARGUMENT IS NOT A SMALL INTEGER
> PPM EXFAL FAIL IF OUT OF RANGE
> BGE WC,=CFP$A,EXFAL FURTHER RANGE CHECK
> MOV WC,WB PRESERVE WC
> MOV =NUM01,WA FOR SCBLK REQUEST
> JSR ALOCS BUILD STRING BLOCK
> MOV XR,XL COPY STRING PTR
> PSC XL READY TO STORE CHAR
> SCH WB,(XL) STORE IT
> ZER XL CLEAR GARBAGE
> BRN EXIXR RETURN STRING RESULT
> EJC
> *
11200,11201c10038,10039
< ERR 118,LE FIRST ARGUMENT IS NOT NUMERIC
< ERR 119,LE SECOND ARGUMENT IS NOT NUMERIC
---
> ERR 126,LE FIRST ARGUMENT IS NOT NUMERIC
> ERR 127,LE SECOND ARGUMENT IS NOT NUMERIC
11213,11214c10051,10052
< ERR 120,LEN ARGUMENT IS NOT INTEGER OR EXPRESSION
< ERR 121,LEN ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 128,LEN ARGUMENT IS NOT INTEGER OR EXPRESSION
> ERR 129,LEN ARGUMENT IS NEGATIVE OR TOO LARGE
11222,11223c10060,10061
< ERR 122,LEQ FIRST ARGUMENT IS NOT STRING
< ERR 123,LEQ SECOND ARGUMENT IS NOT STRING
---
> ERR 130,LEQ FIRST ARGUMENT IS NOT STRING
> ERR 131,LEQ SECOND ARGUMENT IS NOT STRING
11233,11234c10071,10072
< ERR 124,LGE FIRST ARGUMENT IS NOT STRING
< ERR 125,LGE SECOND ARGUMENT IS NOT STRING
---
> ERR 132,LGE FIRST ARGUMENT IS NOT STRING
> ERR 133,LGE SECOND ARGUMENT IS NOT STRING
11244,11245c10082,10083
< ERR 126,LGT FIRST ARGUMENT IS NOT STRING
< ERR 127,LGT SECOND ARGUMENT IS NOT STRING
---
> ERR 134,LGT FIRST ARGUMENT IS NOT STRING
> ERR 135,LGT SECOND ARGUMENT IS NOT STRING
11255,11256c10093,10094
< ERR 128,LLE FIRST ARGUMENT IS NOT STRING
< ERR 129,LLE SECOND ARGUMENT IS NOT STRING
---
> ERR 136,LLE FIRST ARGUMENT IS NOT STRING
> ERR 137,LLE SECOND ARGUMENT IS NOT STRING
11266,11267c10104,10105
< ERR 130,LLT FIRST ARGUMENT IS NOT STRING
< ERR 131,LLT SECOND ARGUMENT IS NOT STRING
---
> ERR 138,LLT FIRST ARGUMENT IS NOT STRING
> ERR 139,LLT SECOND ARGUMENT IS NOT STRING
11277,11278c10115,10116
< ERR 132,LNE FIRST ARGUMENT IS NOT STRING
< ERR 133,LNE SECOND ARGUMENT IS NOT STRING
---
> ERR 140,LNE FIRST ARGUMENT IS NOT STRING
> ERR 141,LNE SECOND ARGUMENT IS NOT STRING
11282,11309d10119
< 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 XR,WB SAVE LOCAL NUMBER
< MOV (XS)+,XR LOAD FIRST ARGUMENT
< JSR GTNVR POINT TO VRBLK
< PPM SLOC1 JUMP IF NOT VARIABLE NAME
< MOV VRFNC(XR),XR ELSE LOAD FUNCTION POINTER
< BNE (XR),=B$PFC,SLOC1 JUMP IF NOT PROGRAM DEFINED
< *
< * HERE IF WE HAVE A PROGRAM DEFINED FUNCTION NAME
< *
< BZE WB,EXFAL FAIL IF SECOND ARG IS ZERO
< BGT WB,PFNLO(XR),EXFAL OR TOO LARGE
< ADD FARGS(XR),WB ELSE ADJUST OFFSET TO INCLUDE ARGS
< WTB WB CONVERT TO BYTES
< ADD WB,XR POINT TO LOCAL POINTER
< MOV PFAGB(XR),XR 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
11318c10128
< ERR 136,LOAD SECOND ARGUMENT IS NOT STRING
---
> ERR 142,LOAD SECOND ARGUMENT IS NOT STRING
11321,11322c10131,10132
< ERR 137,LOAD FIRST ARGUMENT IS NOT STRING
< ERR 138,LOAD FIRST ARGUMENT IS NULL
---
> ERR 143,LOAD FIRST ARGUMENT IS NOT STRING
> ERR 144,LOAD FIRST ARGUMENT IS NULL
11329c10139
< ERB 139,LOAD FIRST ARGUMENT IS MISSING A LEFT PAREN
---
> ERB 145,LOAD FIRST ARGUMENT IS MISSING A LEFT PAREN
11334c10144
< ERR 140,LOAD FIRST ARGUMENT HAS NULL FUNCTION NAME
---
> ERR 146,LOAD FIRST ARGUMENT HAS NULL FUNCTION NAME
11345c10155
< ERB 141,LOAD FIRST ARGUMENT IS MISSING A RIGHT PAREN
---
> ERB 147,BAD BLANK OR MISSING RIGHT PAREN IN LOAD ARG
11355c10165
< MOV =NUM01,WB SET STRING CODE IN CASE
---
> MOV =NUM01,WB SET STRING CODE IN CASE (1)
11363a10174
> ICV WB ELSE SET CODE FOR REAL (3)
11366,11367c10177
< MOV (XS),XR ELSE RELOAD STRING POINTER
< ICV WB SET CODE FOR REAL (3)
---
> MOV (XS),XR RELOAD STRING POINTER
11371a10182,10189
> ICV WB SET CODE FOR BUFFER (4)
> .IF .CNBF
> .ELSE
> MOV (XS),XR RELOAD STRING POINTER
> MOV =SCBUF,XL POINT TO /BUFFER/
> JSR IDENT CHECK FOR MATCH
> PPM SLOD4 JUMP IF MATCH
> .FI
11395c10213
< WTB WA CONVERT LENGTH TO BYTES
---
> WTB WA CONVERT LENGTH TO BAUS
11420,11421c10238,10239
< ERR 142,LOAD FUNCTION DOES NOT EXIST
< ERR 143,LOAD FUNCTION CAUSED INPUT ERROR DURING LOAD
---
> PPM EXFAL FAIL RETURN
> PPM EROSI ERROR RETURN
11429a10248,10275
> * LOCAL
> *
> S$LOC ENT ENTRY POINT
> JSR GTSMI GET SECOND ARGUMENT (LOCAL NUMBER)
> ERR 256,LOCAL SECOND ARGUMENT IS NOT INTEGER
> PPM EXFAL FAIL IF OUT OF RANGE
> MOV XR,WB SAVE LOCAL NUMBER
> MOV (XS)+,XR LOAD FIRST ARGUMENT
> JSR GTNVR POINT TO VRBLK
> PPM SLOC1 JUMP IF NOT VARIABLE NAME
> MOV VRFNC(XR),XR ELSE LOAD FUNCTION POINTER
> BNE (XR),=B$PFC,SLOC1 JUMP IF NOT PROGRAM DEFINED
> *
> * HERE IF WE HAVE A PROGRAM DEFINED FUNCTION NAME
> *
> BZE WB,EXFAL FAIL IF SECOND ARG IS ZERO
> BGT WB,PFNLO(XR),EXFAL OR TOO LARGE
> ADD FARGS(XR),WB ELSE ADJUST OFFSET TO INCLUDE ARGS
> WTB WB CONVERT TO BYTES
> ADD WB,XR POINT TO LOCAL POINTER
> MOV PFAGB(XR),XR LOAD VRBLK POINTER
> BRN EXVNM EXIT BUILDING NMBLK
> *
> * HERE IF FIRST ARGUMENT IS NO GOOD
> *
> SLOC1 ERB 257,LOCAL FIRST ARG IS NOT A PROGRAM FUNCTION NAME
> EJC
> *
11434c10280
< ERR 144,LPAD THIRD ARGUMENT NOT A STRING
---
> ERR 148,LPAD THIRD ARGUMENT NOT A STRING
11438c10284
< ERR 145,LPAD SECOND ARGUMENT IS NOT INTEGER
---
> ERR 149,LPAD SECOND ARGUMENT IS NOT INTEGER
11444c10290
< ERR 146,LPAD FIRST ARGUMENT IS NOT STRING
---
> ERR 150,LPAD FIRST ARGUMENT IS NOT STRING
11485,11486c10331,10332
< ERR 147,LT FIRST ARGUMENT IS NOT NUMERIC
< ERR 148,LT SECOND ARGUMENT IS NOT NUMERIC
---
> ERR 151,LT FIRST ARGUMENT IS NOT NUMERIC
> ERR 152,LT SECOND ARGUMENT IS NOT NUMERIC
11496,11497c10342,10343
< ERR 149,NE FIRST ARGUMENT IS NOT NUMERIC
< ERR 150,NE SECOND ARGUMENT IS NOT NUMERIC
---
> ERR 153,NE FIRST ARGUMENT IS NOT NUMERIC
> ERR 154,NE SECOND ARGUMENT IS NOT NUMERIC
11510c10356
< ERR 151,NOTANY ARGUMENT IS NOT STRING OR EXPRESSION
---
> ERR 155,NOTANY ARGUMENT IS NOT STRING OR EXPRESSION
11518,11519c10364,10365
< ERR 152,OPSYN THIRD ARGUMENT IS NOT INTEGER
< ERR 153,OPSYN THIRD ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 156,OPSYN THIRD ARGUMENT IS NOT INTEGER
> ERR 157,OPSYN THIRD ARGUMENT IS NEGATIVE OR TOO LARGE
11523c10369
< ERR 154,OPSYN SECOND ARG IS NOT NATURAL VARIABLE NAME
---
> ERR 158,OPSYN SECOND ARG IS NOT NATURAL VARIABLE NAME
11531c10377
< ERR 155,OPSYN FIRST ARG IS NOT NATURAL VARIABLE NAME
---
> ERR 159,OPSYN FIRST ARG IS NOT NATURAL VARIABLE NAME
11574c10420
< SOPS5 ERB 156,OPSYN FIRST ARG IS NOT CORRECT OPERATOR NAME
---
> SOPS5 ERB 160,OPSYN FIRST ARG IS NOT CORRECT OPERATOR NAME
11586c10432
< MOV =NUM03,WB OUTPUT FLAG
---
> MOV =NUM02,WB OUTPUT FLAG
11588,11593c10434,10437
< 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
---
> ERR 161,OUTPUT THIRD ARGUMENT (FILEPROPS) IS NOT A STRING
> ERR 162,INAPPROPRIATE SECOND ARGUMENT (FILETAG) FOR OUTPUT
> ERR 163,INAPPROPRIATE FIRST ARGUMENT FOR OUTPUT
> PPM EXFAL FAIL RETURN
11603,11604c10447,10448
< ERR 162,POS ARGUMENT IS NOT INTEGER OR EXPRESSION
< ERR 163,POS ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 164,POS ARGUMENT IS NOT INTEGER OR EXPRESSION
> ERR 165,POS ARGUMENT IS NEGATIVE OR TOO LARGE
11617a10462,10463
> .IF .CNBF
> .ELSE
11619c10465,10466
< ERB 164,PROTOTYPE ARGUMENT IS NOT VALID OBJECT
---
> .FI
> ERB 166,PROTOTYPE ARGUMENT IS NOT TABLE OR ARRAY
11657c10504
< ERR 165,REMDR SECOND ARGUMENT IS NOT INTEGER
---
> ERR 167,REMDR SECOND ARGUMENT IS NOT INTEGER
11668c10515
< ERB 167,REMDR CAUSED INTEGER OVERFLOW
---
> ERB 168,REMDR CAUSED INTEGER OVERFLOW
11672c10519
< SRM01 ERB 166,REMDR FIRST ARGUMENT IS NOT INTEGER
---
> SRM01 ERB 169,REMDR FIRST ARGUMENT IS NOT INTEGER
11684c10531
< ERR 168,REPLACE THIRD ARGUMENT IS NOT STRING
---
> ERR 170,REPLACE THIRD ARGUMENT IS NOT STRING
11687c10534
< ERR 169,REPLACE SECOND ARGUMENT IS NOT STRING
---
> ERR 171,REPLACE SECOND ARGUMENT IS NOT STRING
11749c10596
< ERR 170,REPLACE FIRST ARGUMENT IS NOT STRING
---
> ERR 172,REPLACE FIRST ARGUMENT IS NOT STRING
11768c10615
< SRPL5 ERB 171,NULL OR UNEQUALLY LONG 2ND, 3RD ARGS TO REPLACE
---
> SRPL5 ERB 173,NULL OR UNEQUALLY LONG 2ND, 3RD ARGS TO REPLACE
11771,11783d10617
< * 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
< *
11788c10622
< ERR 177,REVERSE ARGUMENT IS NOT STRING
---
> ERR 174,REVERSE ARGUMENT IS NOT STRING
11810c10644
< ERR 178,RPAD THIRD ARGUMENT IS NOT STRING
---
> ERR 175,RPAD THIRD ARGUMENT IS NOT STRING
11814c10648
< ERR 179,RPAD SECOND ARGUMENT IS NOT INTEGER
---
> ERR 176,RPAD SECOND ARGUMENT IS NOT INTEGER
11820c10654
< ERR 180,RPAD FIRST ARGUMENT IS NOT STRING
---
> ERR 177,RPAD FIRST ARGUMENT IS NOT STRING
11863,11864c10697,10698
< ERR 181,RTAB ARGUMENT IS NOT INTEGER OR EXPRESSION
< ERR 182,RTAB ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 178,RTAB ARGUMENT IS NOT INTEGER OR EXPRESSION
> ERR 179,RTAB ARGUMENT IS NEGATIVE OR TOO LARGE
11872c10706
< MOV (XS)+,R$IO2 SAVE THIRD ARG
---
> MOV (XS)+,R$IOL SAVE THIRD ARG
11874,11876c10708,10710
< JSR IOFCB CALL FCBLK ROUTINE
< ERR 291,SET FIRST ARGUMENT IS NOT A SUITABLE NAME
< ERR 292,SET FIRST ARGUMENT IS NULL
---
> JSR IOFTG CALL IOTAG ROUTINE
> ERR 180,SET FIRST ARGUMENT IS NOT A SUITABLE NAME
> BZE WA,EXFAL FAIL IF NO IOTAG
11878c10712
< MOV R$IO2,WC LOAD THIRD ARG
---
> MOV R$IOL,WC LOAD THIRD ARG
11880,11885c10714,10716
< 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
---
> PPM EXFAL FAILURE RETURN
> PPM EROSI ERROR RETURN
> BRN EXNUL OTHERWISE RETURN NULL
11889,11899d10719
< * TAB
< *
< S$TAB ENT ENTRY POINT
< MOV =P$TAB,WB SET PCODE FOR INTEGER ARG CASE
< MOV =P$TBD,WA 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
< *
11906,11907c10726,10727
< ERR 185,RPOS ARGUMENT IS NOT INTEGER OR EXPRESSION
< ERR 186,RPOS ARGUMENT IS NEGATIVE OR TOO LARGE
---
> ERR 181,RPOS ARGUMENT IS NOT INTEGER OR EXPRESSION
> ERR 182,RPOS ARGUMENT IS NEGATIVE OR TOO LARGE
11917a10738
> PPM EXFAL FAIL EMPTY TABLE
11946c10767
< SSTX2 ERB 187,SETEXIT ARGUMENT IS NOT LABEL NAME OR NULL
---
> SSTX2 ERB 183,SETEXIT ARGUMENT IS NOT LABEL NAME OR NULL
11955a10777
> PPM EXFAL FAIL EMPTY TABLE
11967c10789
< ERR 188,SPAN ARGUMENT IS NOT STRING OR EXPRESSION
---
> ERR 184,SPAN ARGUMENT IS NOT STRING OR EXPRESSION
11974a10797
> JSR GTSTG LOAD STRING ARGUMENT
11981d10803
< .FI
11986c10808,10809
< ERR 189,SIZE ARGUMENT IS NOT STRING
---
> .FI
> ERR 185,SIZE ARGUMENT IS NOT STRING
11996,11997c10819,10821
< ERR 190,STOPTR FIRST ARGUMENT IS NOT APPROPRIATE NAME
< ERR 191,STOPTR SECOND ARGUMENT IS NOT TRACE TYPE
---
> ERR 186,STOPTR FIRST ARGUMENT IS NOT APPROPRIATE NAME
> ERR 187,STOPTR SECOND ARGUMENT IS NOT TRACE TYPE
> PPM EXFAL FAIL RETURN
12005c10829
< ERR 192,SUBSTR THIRD ARGUMENT IS NOT INTEGER
---
> ERR 188,SUBSTR THIRD ARGUMENT IS NOT INTEGER
12009c10833
< ERR 193,SUBSTR SECOND ARGUMENT IS NOT INTEGER
---
> ERR 189,SUBSTR SECOND ARGUMENT IS NOT INTEGER
12014a10839
> JSR GTSTG LOAD FIRST ARGUMENT
12024d10848
< .FI
12026c10850,10855
< ERR 194,SUBSTR FIRST ARGUMENT IS NOT STRING
---
> .FI
> ERR 190,SUBSTR FIRST ARGUMENT IS NOT STRING
> MOV XR,XL COPY POINTER TO FIRST ARG
> .IF .CNBF
> MOV SBSSV,WC RELOAD THIRD ARGUMENT
> .ELSE
12028c10857
< * MERGE WITH BFBLK OR SCBLK PTR IN XR. WA HAS LENGTH
---
> * MERGE WITH BFBLK OR SCBLK IN XR, LENGTH IN WA
12030a10860
> .FI
12032c10862
< MOV WA,WC ELSE GET STRING LENGTH
---
> MOV SCLEN(XL),WC ELSE GET STRING LENGTH
12038,12039c10868
< SSUB1 MOV WA,XL SAVE STRING LENGTH
< MOV WC,WA SET LENGTH OF SUBSTRING
---
> SSUB1 MOV WC,WA SET LENGTH OF SUBSTRING
12041,12042c10870
< BGT WC,XL,EXFAL JUMP IF IMPROPER SUBSTRING
< MOV XR,XL COPY POINTER TO FIRST ARG
---
> BGT WC,SCLEN(XL),EXFAL JUMP IF IMPROPER SUBSTRING
12046a10875,10885
> * TAB
> *
> S$TAB ENT ENTRY POINT
> MOV =P$TAB,WB SET PCODE FOR INTEGER ARG CASE
> MOV =P$TBD,WA SET PCODE FOR EXPRESSION ARG CASE
> JSR PATIN CALL COMMON ROUTINE TO BUILD NODE
> ERR 191,TAB ARGUMENT IS NOT INTEGER OR EXPRESSION
> ERR 192,TAB ARGUMENT IS NEGATIVE OR TOO LARGE
> BRN EXIXR RETURN PATTERN NODE
> EJC
> *
12053,12054c10892,10893
< ERR 195,TABLE ARGUMENT IS NOT INTEGER
< ERR 196,TABLE ARGUMENT IS OUT OF RANGE
---
> ERR 193,TABLE ARGUMENT IS NOT INTEGER
> ERR 194,TABLE ARGUMENT IS OUT OF RANGE
12062c10901
< WTB WA CONVERT LENGTH TO BYTES
---
> WTB WA CONVERT LENGTH TO BAUS
12101c10940
< STR01 ERB 197,TRACE FOURTH ARG IS NOT FUNCTION NAME OR NULL
---
> STR01 ERB 195,TRACE FOURTH ARG IS NOT FUNCTION NAME OR NULL
12110,12111c10949,10951
< ERR 198,TRACE FIRST ARGUMENT IS NOT APPROPRIATE NAME
< ERR 199,TRACE SECOND ARGUMENT IS NOT TRACE TYPE
---
> ERR 196,TRACE FIRST ARGUMENT IS NOT APPROPRIATE NAME
> ERR 197,TRACE SECOND ARGUMENT IS NOT TRACE TYPE
> PPM UNUSED RETURN
12125c10965
< ERR 200,TRIM ARGUMENT IS NOT STRING
---
> ERR 198,TRIM ARGUMENT IS NOT STRING
12142c10982
< ERR 201,UNLOAD ARGUMENT IS NOT NATURAL VARIABLE NAME
---
> ERR 199,UNLOAD ARGUMENT IS NOT NATURAL VARIABLE NAME
12145a10986,10995
> EJC
> *
> * VDIFFER
> *
> S$VDF ENT ENTRY POINT
> MOV (XS)+,XR LOAD SECOND ARGUMENT
> MOV (XS),XL LOAD FIRST ARGUMENT
> JSR IDENT CALL IDENT COMPARISON ROUTINE
> PPM EXFAL FAIL IF IDENT
> BRN EXITS RETURN FIRST ARG IF DIFFER
12255c11105
< MOV TRFPT(XR),XL GET FILE CTRL BLK PTR OR ZERO
---
> MOV TRTRI(XR),XL GET TRTIO BLOCK PTR OR 0
12263c11113,11121
< JSR SYSRD READ NEXT STANDARD INPUT IMAGE
---
> BZE TTINS,ACSA5 SKIP IF NOT TERML STD INPUT
> JSR SYSRI READ FROM TERMINAL
> PPM ACS03 END FILE
> PPM EROSI ERROR
> BRN ACS07 MERGE
> *
> * GENUINE STD INPUT FILE
> *
> ACSA5 JSR SYSRD READ NEXT STANDARD INPUT IMAGE
12264a11123
> PPM EROSI ERROR RETURN
12269c11128,11129
< ACS06 MOV XL,WA FCBLK PTR
---
> ACS06 MOV TRTAG(XL),WA OBTAIN IOTAG
> BZE WA,ACS03 FAIL IF ENDFILE DONE
12272c11132
< MOV XL,WA FCBLK PTR
---
> MOV TRTAG(XL),WA GET IOTAG
12275,12276c11135
< PPM ACS22 ERROR
< PPM ACS23 ERROR
---
> PPM ACS22 ERROR RETURN
12328c11187
< MTI KVABE(XR) ELSE LOAD VALUE AS INTEGER
---
> MTI KVANC(XR) ELSE LOAD VALUE AS INTEGER
12338a11198
> WTB XR CONVERT TO OFFSET IN BAUS
12347c11207
< BSW XR,5 SWITCH ON KEYWORD NUMBER
---
> BSW XR,6 SWITCH ON KEYWORD NUMBER
12349a11210
> IFF K$$CD,ACS23 CODE
12385a11247
> PPM EROSI ERROR RETURN
12388c11250
< * ERROR RETURNS
---
> * ERROR RETURN
12391c11253
< ERB 202,INPUT FROM FILE CAUSED NON-RECOVERABLE ERROR
---
> BRN EROSI GENERATE ERROR MESSAGE
12393,12394c11255,11258
< ACS23 MOV XR,DNAMP POP UNUSED SCBLK
< ERB 203,INPUT FILE RECORD HAS INCORRECT FORMAT
---
> * ACCESS CODE KEYWORD
> *
> ACS23 LDI KVCOD GET CODE VALUE
> BRN ACS13 EXIT
12480c11344
< * (WA) LENGTH REQUIRED IN BYTES
---
> * (WA) LENGTH REQUIRED IN BAUS
12514c11378
< WTB XR CONVERT TO BAUS (SGD05)
---
> WTB XR CONVERT TO BAUS
12520c11384
< ERB 204,MEMORY OVERFLOW
---
> ERB 200,MEMORY OVERFLOW
12528c11392
< BTW WB CONVERT BYTES TO WORDS
---
> BTW WB CONVERT BAUS TO WORDS
12539c11403
< WTB XR CONVERT TO BAUS (SGD05)
---
> WTB XR CONVERT TO BAUS
12561a11426,11427
> * (WA) 0 (INITIAL OFFSET TO BFBLK CHARS)
> * (WB) 0 (INITIAL BCLEN)
12563d11428
< * (WA,WB) DESTROYED
12580c11445,11446
< ZER BFCHR(XL) CLEAR FIRST WORD (NULL PAD)
---
> ZER WB CLEAR FOR RETURN
> MOV WB,BFCHR(XL) CLEAR FIRST WORD (NULL PAD)
12581a11448
> ZER WA CLEAR FOR RETURN
12586c11453
< ALB01 ERB 274,REQUESTED BUFFER ALLOCATION EXCEEDS MXLEN
---
> ALB01 ERB 201,REQUESTED BUFFER ALLOCATION EXCEEDS MAXLNGTH
12611c11478
< CTB WA,SCSI$ COMPUTE LENGTH OF SCBLK IN BYTES
---
> CTB WA,SCSI$ COMPUTE LENGTH OF SCBLK IN BAUS
12634c11501
< ALCS2 ERB 205,STRING LENGTH EXCEEDS VALUE OF MAXLNGTH KEYWORD
---
> ALCS2 ERB 202,STRING LENGTH EXCEEDS VALUE OF MAXLNGTH KEYWORD
12640c11507
< * (WA) LENGTH REQUIRED IN BYTES
---
> * (WA) LENGTH REQUIRED IN BAUS
12676,12677d11542
< .IF .CNBF
< .ELSE
12679,12712d11543
< * 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 BCLEN(XR),WA LOAD OFFSET TO INSERT
< ZER WB 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
< .FI
< *
12882c11713
< * HERE FOR FAILURE DURING EXPRESSION EVALUATION
---
> * HERE FOR FAILURE RETURNS
12885d11715
< EXI 1 TAKE FAILURE EXIT
12886a11717,11718
> ASG3A EXI 1 TAKE FAILURE EXIT
> *
12933c11765
< MOV TRVAL(WC),-(XS) STACK VALUE TO OUTPUT (SGD01)
---
> MOV TRVAL(XR),-(XS) STACK VALUE TO OUTPUT
12939c11771
< ASG11 MOV TRFPT(XL),WA FCBLK PTR
---
> ASG11 MOV TRTRI(XL),WA TRTIO BLK PTR
12943a11776,11779
> MOV WA,XL COPY TRTIO BLOCK PTR TO XL
> MOV TRTAG(XL),WA GET IOTAG
> BZE WA,ASG3A FAIL IF ENDFILE DONE
> MOV SCLEN(XR),WC STRING LENGTH
12945,12946c11781,11782
< ERR 206,OUTPUT CAUSED FILE OVERFLOW
< ERR 207,OUTPUT CAUSED NON-RECOVERABLE ERROR
---
> PPM ASG3A FAIL RETURN
> PPM EROSI ERROR RETURN
12954c11790
< * HERE TO PRINT A STRING ON THE PRINTER
---
> * HERE TO PRINT A STRING
12956,12958c11792,11793
< ASG13 JSR PRTST PRINT STRING VALUE
< BEQ TRTER(XL),=V$TER,ASG20 JUMP IF TERMINAL OUTPUT
< JSR PRTNL END OF LINE
---
> ASG13 BEQ TRTER(XL),=V$TER,ASG20 JUMP IF TERMINAL OUTPUT
> JSR PRTSF PRINT STRING AND FLUSH BUFFER
12970c11805
< ERR 208,KEYWORD VALUE ASSIGNED IS NOT INTEGER
---
> ERR 203,KEYWORD VALUE ASSIGNED IS NOT INTEGER
12972a11808
> BEQ XL,=K$COD,ASG24 JUMP IF SPECIAL CASE OF CODE
12981c11817
< ERB 209,KEYWORD IN ASSIGNMENT IS PROTECTED
---
> ERB 204,KEYWORD IN ASSIGNMENT IS PROTECTED
12985c11821
< ASG15 MOV WA,KVABE(XL) STORE NEW VALUE
---
> ASG15 MOV WA,KVANC(XL) STORE NEW VALUE
12998a11835
> EJC
12999a11837,11838
> * ASIGN (CONTINUED)
> *
13006c11845
< ASG18 ERB 210,KEYWORD VALUE ASSIGNED IS NEGATIVE OR TOO LARGE
---
> ASG18 ERB 205,KEYWORD VALUE ASSIGNED IS NEGATIVE OR TOO LARGE
13012c11851
< ERR 211,VALUE ASSIGNED TO KEYWORD ERRTEXT NOT A STRING
---
> ERR 206,VALUE ASSIGNED TO KEYWORD ERRTEXT NOT A STRING
13018c11857,11858
< ASG20 JSR PRTTR PRINT
---
> ASG20 JSR PTTST PRINT STRING TO TERMINAL
> JSR PTTFH FLUSH TERMINAL BUFFER
13020d11859
< *
13029c11868
< ERB 268,INCONSISTENT VALUE ASSIGNED TO KEYWORD PROFILE
---
> ERB 207,INCONSISTENT VALUE ASSIGNED TO KEYWORD PROFILE
13031c11870
< ASG22 MOV WA,PFDMP NOTE VALUE ON FIRST ASSIGNMENT
---
> ASG22 MOV WA,PFDMP NOTE VALUE ON FIRST ASSIGNMENT
13035a11875,11879
> *
> * HERE FOR KEYWORD ASSIGNMENT TO CODE
> *
> ASG24 STI KVCOD STORE VALUE
> EXI RETURN TO CALLER
13093c11937
< * (WA) LENGTH OF BLOCK IN BYTES
---
> * (WA) LENGTH OF BLOCK IN BAUS
13107,13111d11950
< .IF .CNBF
< .ELSE
< IFF BL$BC,BLN04 BCBLK
< IFF BL$BF,BLN11 BFBLK
< .FI
13112a11952
> IFF BL$CO,BLN12 COBLK
13131a11972,11976
> .IF .CNBF
> .ELSE
> IFF BL$BC,BLN04 BCBLK
> IFF BL$BF,BLN11 BFBLK
> .FI
13162c12007
< * HERE FOR FOUR WORD BLOCKS (P2,TE,BC)
---
> * HERE FOR FOUR WORD BLOCKS (P2,TE)
13202c12047
< CTB WA,SCSI$ CALCULATE LENGTH IN BYTES
---
> CTB WA,SCSI$ CALCULATE LENGTH IN BAUS
13209,13210c12054,12055
< BLN11 MOV BFALC(XR),WA GET ALLOCATION IN BYTES
< CTB WA,BFSI$ CALCULATE LENGTH IN BYTES
---
> BLN11 MOV BFALC(XR),WA GET ALLOCATION IN BAUS
> CTB WA,BFSI$ CALCULATE LENGTH IN BAUS
13212a12058,12062
> *
> * HERE FOR COBLK
> *
> BLN12 MOV *COSI$,WA GET SIZE IN BAUS
> EXI RETURN TO BLKLN CALLER
13216c12066
< * COPYB -- COPY A BLOCK
---
> * CBLCK -- COPY A BLOCK
13219c12069
< * JSR COPYB CALL TO COPY BLOCK
---
> * JSR CBLCK CALL TO COPY BLOCK
13226c12076
< COPYB PRC N,1 ENTRY POINT
---
> CBLCK PRC N,1 ENTRY POINT
13228c12078
< BEQ XR,=NULLS,COP10 RETURN ARGUMENT IF IT IS NULL
---
> BEQ XR,=NULLS,CBL10 RETURN ARGUMENT IF IT IS NULL
13237,13239c12087,12089
< BEQ WB,=B$TBT,COP05 JUMP IF TABLE
< BEQ WB,=B$VCT,COP01 JUMP IF VECTOR
< BEQ WB,=B$PDT,COP01 JUMP IF PROGRAM DEFINED
---
> BEQ WB,=B$TBT,CBL05 JUMP IF TABLE
> BEQ WB,=B$VCT,CBL01 JUMP IF VECTOR
> BEQ WB,=B$PDT,CBL01 JUMP IF PROGRAM DEFINED
13242c12092
< BEQ WB,=B$BCT,COP11 JUMP IF BUFFER
---
> BEQ WB,=B$BCT,CBL11 JUMP IF BUFFER
13244c12094
< BNE WB,=B$ART,COP10 RETURN COPY IF NOT ARRAY
---
> BNE WB,=B$ART,CBL10 RETURN COPY IF NOT ARRAY
13249c12099
< BRN COP02 JUMP TO MERGE
---
> BRN CBL02 JUMP TO MERGE
13253c12103
< COP01 ADD *PDFLD,XR POINT TO PDFLD = VCVLS
---
> CBL01 ADD *PDFLD,XR POINT TO PDFLD = VCVLS
13258c12108
< COP02 MOV (XR),XL LOAD NEXT POINTER
---
> CBL02 MOV (XR),XL LOAD NEXT POINTER
13262c12112
< COP03 BNE (XL),=B$TRT,COP04 JUMP IF NOT TRAPPED
---
> CBL03 BNE (XL),=B$TRT,CBL04 JUMP IF NOT TRAPPED
13264c12114
< BRN COP03 AND LOOP BACK
---
> BRN CBL03 AND LOOP BACK
13267c12117
< * COPYB (CONTINUED)
---
> * CBLCK (CONTINUED)
13271,13273c12121,12123
< COP04 MOV XL,(XR)+ STORE REAL VALUE, BUMP POINTER
< BNE XR,DNAMP,COP02 LOOP BACK IF MORE TO GO
< BRN COP09 ELSE JUMP TO EXIT
---
> CBL04 MOV XL,(XR)+ STORE REAL VALUE, BUMP POINTER
> BNE XR,DNAMP,CBL02 LOOP BACK IF MORE TO GO
> BRN CBL09 ELSE JUMP TO EXIT
13277c12127
< COP05 ZER IDVAL(XR) ZERO ID TO STOP DUMP BLOWING UP
---
> CBL05 ZER IDVAL(XR) ZERO ID TO STOP DUMP BLOWING UP
13283,13284c12133,12134
< COP06 MOV (XS),XR LOAD TABLE POINTER
< BEQ WC,TBLEN(XR),COP09 JUMP TO EXIT IF ALL DONE
---
> CBL06 MOV (XS),XR LOAD TABLE POINTER
> BEQ WC,TBLEN(XR),CBL09 JUMP TO EXIT IF ALL DONE
13291c12141
< COP07 MOV TENXT(XR),XL LOAD POINTER TO NEXT TEBLK
---
> CBL07 MOV TENXT(XR),XL LOAD POINTER TO NEXT TEBLK
13293c12143
< BEQ (XL),=B$TBT,COP06 BACK FOR NEXT BUCKET IF CHAIN END
---
> BEQ (XL),=B$TBT,CBL06 BACK FOR NEXT BUCKET IF CHAIN END
13306,13307c12156,12157
< COP08 MOV TEVAL(XL),XL LOAD VALUE
< BEQ (XL),=B$TRT,COP08 LOOP BACK IF TRAPPED
---
> CBL08 MOV TEVAL(XL),XL LOAD VALUE
> BEQ (XL),=B$TRT,CBL08 LOOP BACK IF TRAPPED
13309c12159
< BRN COP07 BACK FOR NEXT TEBLK
---
> BRN CBL07 BACK FOR NEXT TEBLK
13313c12163
< COP09 MOV (XS)+,XR LOAD POINTER TO BLOCK
---
> CBL09 MOV (XS)+,XR LOAD POINTER TO BLOCK
13318,13319c12168
< COP10 EXI 1 RETURN
< EJC
---
> CBL10 EXI 1 RETURN
13321a12171
> EJC
13325c12175
< COP11 MOV BCBUF(XR),XL GET BFBLK PTR
---
> CBL11 MOV BCBUF(XR),XL GET BFBLK PTR
13335c12185
< BRN COP09 BRANCH TO EXIT
---
> BRN CBL09 BRANCH TO EXIT
13337c12187,12188
< ENP END PROCEDURE COPYB
---
> ENP END PROCEDURE CBLCK
> EJC
13455c12306
< CGN01 ERB 212,SYNTAX ERROR. VALUE USED WHERE NAME IS REQUIRED
---
> CGN01 ERB 208,SYNTAX ERROR. VALUE USED WHERE NAME IS REQUIRED
13586,13592d12436
< BNZ VRLEN(XR),CGVL0 JUMP IF NOT SYSTEM VARIABLE
< MOV XR,-(XS) STACK XR
< MOV VRSVP(XR),XR POINT TO SVBLK
< MOV SVBIT(XR),WA GET SVBLK PROPERTY BITS
< MOV (XS)+,XR RECOVER XR
< ANB BTCKW,WA CHECK IF CONSTANT KEYWORD
< NZB WA,CGV00 JUMP IF CONSTANT KEYWORD
13616,13617c12460
< * PREPARE TO GENERATE CODE FOR CMBLK. WC IS SET TO THE
< * VALUE OF CSWNO (ZERO IF -OPTIMISE, 1 IF -NOOPT) TO
---
> * PREPARE TO GENERATE CODE FOR CMBLK. WC IS CLEARED TO
13624c12467
< MOV CSWNO,WC RESET CONSTANT FLAG
---
> ZER WC CLEAR OPTIMISE FLAG
13644d12486
< IFF C$CNP,CGV24 CONCATENATION (NOT PATTERN MATCH)
13645a12488
> IFF C$CNP,CGV24 CONCAT. NOT PATTERN
13688,13689c12531,12532
< CGV07 SUB *CMVLS,WB GET NUMBER OF ARG PTRS (BYTES)
< BTW WB CONVERT BYTES TO WORDS
---
> CGV07 SUB *CMVLS,WB GET NUMBER OF ARG PTRS (BAUS)
> BTW WB CONVERT BAUS TO WORDS
13968c12811
< WTB XR CONVERT WORD OFFSET TO BYTES
---
> WTB XR CONVERT WORD OFFSET TO BAUS
14105c12948
< CDWD5 ERB 213,SYNTAX ERROR. STATEMENT IS TOO COMPLICATED.
---
> CDWD5 ERB 209,SYNTAX ERROR. STATEMENT IS TOO COMPLICATED.
14258,14260c13101,13107
< BNE STAGE,=STGIC,CMP02 SKIP UNLESS INITIAL COMPILE
< JSR READR READ NEXT INPUT IMAGE
< BZE XR,CMP09 JUMP IF NO INPUT AVAILABLE
---
> BEQ STAGE,=STGIC,CMPC1 READ IF INITIAL COMPILE
> BZE R$COP,CMP02 ELSE SKIP IF NO -COPY IN FORCE
> *
> * HERE TO ATTEMPT READ (STGIC OR -COPY)
> *
> CMPC1 JSR READR READ NEXT INPUT IMAGE
> BZE XR,CMPC2 JUMP IF NO INPUT AVAILABLE
14265a13113,13119
> * HERE IF READR HAD NOTHING TO RETURN. IF NOT DURING
> * INITIAL COMPILE, THEN MUST BE AT OUTER LEVEL OF -COPY
> * IN CODE(). R$CIM HAS BEEN RESTORED TO CODE STRING
> * BY COPND SO WE CONTINUE FROM THE -COPY STMT.
> *
> CMPC2 BEQ STAGE,=STGIC,CMP09 JUMP IF INITIAL COMPILE
> *
14296c13150
< BEQ WC,=CH$MN,CMP32 JUMP IF CONTROL CARD
---
> BEQ WC,=CH$MN,CMP33 JUMP IF CONTROL CARD
14324c13178
< ERB 214,BAD LABEL OR MISPLACED CONTINUATION LINE
---
> ERB 210,BAD LABEL OR MISPLACED CONTINUATION LINE
14363c13217
< BEQ XL,=T$SMC,CMP10 JUMP IF END OF IMAGE
---
> BEQ XL,=T$SMC,CMPEE JUMP IF END OF IMAGE
14371c13225
< BEQ XL,=T$SMC,CMP10 JUMP IF OK (END OF IMAGE)
---
> BEQ XL,=T$SMC,CMPEE JUMP IF OK (END OF IMAGE)
14375c13229
< CMP08 ERB 215,SYNTAX ERROR. UNDEFINED OR ERRONEOUS ENTRY LABEL
---
> CMP08 ERB 211,SYNTAX ERROR. UNDEFINED OR ERRONEOUS ENTRY LABEL
14380,14381c13234,13235
< BEQ STAGE,=STGXE,CMP10 JUMP IF CODE CALL (OK)
< ERB 216,SYNTAX ERROR. MISSING END LINE
---
> BEQ STAGE,=STGXE,CMPEE JUMP IF CODE CALL (OK)
> ERB 212,SYNTAX ERROR. MISSING END LINE
14385c13239
< CMP10 MOV =OSTP$,WA SET STOP CALL POINTER
---
> CMPEE MOV =OSTP$,WA SET STOP CALL POINTER
14397c13251
< ERB 217,SYNTAX ERROR. DUPLICATE LABEL
---
> ERB 213,SYNTAX ERROR. DUPLICATE LABEL
14414c13268
< BEQ XL,=T$SMC,CMP31 JUMP IF NO FIELDS LEFT
---
> BEQ XL,=T$SMC,CMP32 JUMP IF NO FIELDS LEFT
14450c13304
< CMP17 ERB 218,SYNTAX ERROR. DUPLICATED GOTO FIELD
---
> CMP17 ERB 214,SYNTAX ERROR. DUPLICATED GOTO FIELD
14599d13452
< EXI AND RETURN TO CMPIL CALLER
14600a13454,13459
> * LOOP TO UNNEST ANY OUTSTANDING -COPY LEVELS
> *
> CMP31 JSR COPND CALL TO UNNEST -COPY
> BNZ R$COP,CMP31 LOOP IF NOT ALL -COPYS CLOSED
> EXI RETURN TO CMPIL CALLER
> *
14603c13462
< CMP31 MOV CMFGO(XS),WB GET FAIL GOTO
---
> CMP32 MOV CMFGO(XS),WB GET FAIL GOTO
14606c13465
< ERB 219,SYNTAX ERROR. EMPTY GOTO FIELD
---
> ERB 215,SYNTAX ERROR. EMPTY GOTO FIELD
14610c13469
< CMP32 ICV WB POINT PAST CH$MN
---
> CMP33 ICV WB POINT PAST CH$MN
14634c13493
< CNC01 BGE SCNPT,SCNIL,CNC09 RETURN IF END OF IMAGE
---
> CNC01 BGE SCNPT,SCNIL,CNC10 RETURN IF END OF IMAGE
14638,14640d13496
< .IF .CULC
< FLC WA FOLD TO UPPER CASE
< .FI
14641a13498,13500
> .IF .CASL
> BEQ WA,=CH$$I,CNC07 DITTO (LC)
> .FI
14649a13509,13511
> .IF .CASL
> JSR SBSCC CONVERT CASE BEFORE COMPARISON
> .ELSE
14651,14653d13512
< .IF .CULC
< MOV SCLEN(XR),WA RELOAD LENGTH
< JSR FLSTG FOLD TO UPPER CASE
14658c13517
< LCT WC,=CC$NC NUMBER OF STANDARD NAMES
---
> LCT WC,=CC$CT NUMBER OF STANDARD NAMES
14682,14684c13541,13543
< BSW XL,CC$NC SWITCH
< .IF .CULC
< IFF CC$CA,CNC37 -CASE
---
> BSW XL,CC$CT SWITCH
> .IF .CASL
> IFF CC$CI,CNC11 -CASEIG
14686,14687c13545
< IFF CC$DO,CNC10 -DOUBLE
< IFF CC$DU,CNC11 -DUMP
---
> IFF CC$CO,CNC23 -COPY
14689,14705c13547,13556
< 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
---
> IFF CC$FA,CNC13 -FAIL
> IFF CC$LI,CNC14 -LIST
> .IF .CASL
> IFF CC$NC,CNC15 -NOCASEIG
> .FI
> IFF CC$NF,CNC16 -NOFAIL
> IFF CC$NL,CNC17 -NOLIST
> IFF CC$ST,CNC18 -STITLE
> IFF CC$TI,CNC19 -TITLE
> IFF CC$TR,CNC22 -TRACE
14717c13568
< CNC06 ERB 247,INVALID CONTROL CARD
---
> CNC06 ERB 216,INVALID CONTROL CARD
14722,14723c13573,13574
< .IF .CULC
< FLC WA FOLD TO UPPER CASE
---
> .IF .CASL
> BEQ WA,=CH$$N,CNC08 SKIP IF LC N
14725a13577,13579
> .IF .CASL
> CNC08 ADD =NUM02,SCNPT BUMP OFFSET PAST -IN
> .ELSE
14726a13581
> .FI
14739c13594
< CNC08 MOV SCNPT,WA PRESERVE IN CASE XEQ TIME COMPILE
---
> CNC09 MOV SCNPT,WA PRESERVE IN CASE XEQ TIME COMPILE
14746c13601,13602
< CNC09 EXI RETURN
---
> CNC10 EXI RETURN
> .IF .CASL
14748c13604
< * -DOUBLE
---
> * -CASEIG
14750,14751c13606,13608
< CNC10 MNZ CSWDB SET SWITCH
< BRN CNC08 MERGE
---
> CNC11 MNZ CSWCI SET SWITCH
> BRN CNC09 MERGE
> .FI
14753,14759d13609
< * -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
< *
14762c13612
< CNC12 BZE CSWLS,CNC09 RETURN IF -NOLIST
---
> CNC12 BZE CSWLS,CNC10 RETURN IF -NOLIST
14765c13615
< BRN CNC09 FINISHED
---
> BRN CNC10 FINISHED
14767,14776d13616
< * -ERRORS
< *
< CNC13 ZER CSWER CLEAR SWITCH
< BRN CNC08 MERGE
< *
< * -EXECUTE
< *
< CNC14 ZER CSWEX CLEAR SWITCH
< BRN CNC08 MERGE
< *
14779,14780c13619,13620
< CNC15 MNZ CSWFL SET SWITCH
< BRN CNC08 MERGE
---
> CNC13 MNZ CSWFL SET SWITCH
> BRN CNC09 MERGE
14784,14785c13624,13626
< CNC16 MNZ CSWLS SET SWITCH
< BEQ STAGE,=STGIC,CNC08 DONE IF COMPILE TIME
---
> CNC14 MNZ CSWLS SET SWITCH
> BRN CNC09 MERGE
> .IF .CASL
14787c13628
< * LIST CODE LINE IF EXECUTE TIME COMPILE
---
> * -NOCASEIG
14789,14792c13630,13632
< ZER LSTPF PERMIT LISTING
< JSR LISTR LIST LINE
< BRN CNC08 MERGE
< EJC
---
> CNC15 ZER CSWCI CLEAR SWITCH
> BRN CNC09 MERGE
> .FI
14794,14805d13633
< * CNCRD (CONTINUED)
< *
< * -NOERRORS
< *
< CNC17 MNZ CSWER SET SWITCH
< BRN CNC08 MERGE
< *
< * -NOEXECUTE
< *
< CNC18 MNZ CSWEX SET SWITCH
< BRN CNC08 MERGE
< *
14808,14834c13636,13637
< 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
---
> CNC16 ZER CSWFL CLEAR SWITCH
> BRN CNC09 MERGE
14839c13642
< * -SINGLE
---
> * -NOLIST
14841,14863c13644
< CNC27 ZER CSWDB CLEAR SWITCH
< BRN CNC08 MERGE
< *
< * -SPACE
< *
< CNC28 BZE CSWLS,CNC09 RETURN IF -NOLIST
< JSR SCANE SCAN INTEGER AFTER -SPACE
< MOV =NUM01,WC 1 SPACE IN CASE
< BEQ XR,=T$SMC,CNC29 JUMP IF NO INTEGER
< MOV XR,-(XS) STACK IT
< JSR GTSMI CHECK INTEGER
< PPM CNC06 FAIL IF NOT INTEGER
< PPM CNC06 FAIL IF NEGATIVE OR LARGE
< BNZ WC,CNC29 JUMP IF NON ZERO
< MOV =NUM01,WC ELSE 1 SPACE
< *
< * MERGE WITH COUNT OF LINES TO SKIP
< *
< CNC29 ADD WC,LSTLC BUMP LINE COUNT
< LCT WC,WC CONVERT TO LOOP COUNTER
< BLT LSTLC,LSTNP,CNC30 JUMP IF FITS ON PAGE
< JSR PRTPS EJECT
< JSR LISTT LIST TITLE
---
> CNC17 ZER CSWLS CLEAR SWITCH
14866,14874d13646
< * SKIP LINES
< *
< CNC30 JSR PRTNL PRINT A BLANK
< BCT WC,CNC30 LOOP
< BRN CNC09 MERGE
< EJC
< *
< * CNCRD (CONTINUED)
< *
14877,14878c13649,13650
< CNC31 MOV =R$STL,CNR$T PTR TO R$STL
< BRN CNC33 MERGE
---
> CNC18 MOV =R$STL,CNR$T PTR TO R$STL
> BRN CNC20 MERGE
14882c13654
< CNC32 MOV =NULLS,R$STL CLEAR SUBTITLE
---
> CNC19 MOV =NULLS,R$STL CLEAR SUBTITLE
14887c13659
< CNC33 MOV =NULLS,XR NULL IN CASE NEEDED
---
> CNC20 MOV =NULLS,XR NULL IN CASE NEEDED
14891c13663
< BLO WA,WB,CNC34 JUMP IF NO CHARS LEFT
---
> BLO WA,WB,CNC21 JUMP IF NO CHARS LEFT
14898c13670
< CNC34 MOV CNR$T,XL POINT TO STORAGE LOCATION
---
> CNC21 MOV CNR$T,XL POINT TO STORAGE LOCATION
14900,14908c13672
< BEQ XL,=R$STL,CNC09 RETURN IF STITL
< BNZ PRECL,CNC09 RETURN IF EXTENDED LISTING
< BZE PRICH,CNC09 RETURN IF REGULAR PRINTER
< MOV SCLEN(XR),XL GET LENGTH OF TITLE
< MOV XL,WA COPY IT
< BZE XL,CNC35 JUMP IF NULL
< ADD =NUM10,XL INCREMENT
< BHI XL,PRLEN,CNC09 USE DEFAULT LSTP0 VAL IF TOO LONG
< ADD =NUM04,WA POINT JUST PAST TITLE
---
> BRN CNC10 RETURN
14910,14914d13673
< * STORE OFFSET TO PAGE NN MESSAGE FOR SHORT TITLE
< *
< CNC35 MOV WA,LSTPO STORE OFFSET
< BRN CNC09 RETURN
< *
14915a13675
> *
14919,14921c13679,13680
< CNC36 JSR SYSTT TOGGLE SWITCH
< BRN CNC08 MERGE
< .IF .CULC
---
> CNC22 JSR SYSTT TOGGLE SWITCH
> BRN CNC09 MERGE
14923,14925c13682
< * -CASE
< * SETS VALUE OF KVCAS SO THAT NAMES ARE FOLDED OR NOT
< * DURING COMPILATION.
---
> * -COPY
14927,14936c13684,13708
< CNC37 JSR SCANE SCAN INTEGER AFTER -CASE
< ZER WC GET 0 IN CASE NONE THERE
< BEQ XL,=T$SMC,CNC38 SKIP IF NO INTEGER
< MOV XR,-(XS) STACK IT
< JSR GTSMI CHECK INTEGER
< PPM CNC06 FAIL IF NOT INTEGER
< PPM CNC06 FAIL IF NEGATIVE OR TOO LARGE
< CNC38 MOV WC,KVCAS STORE NEW CASE VALUE
< BRN CNC09 MERGE
< .FI
---
> * GET FILETAG AND NOTIFY OSINT THAT WE ARE NESTING
> *
> CNC23 JSR SCANE GET FILETAG
> BNE =T$CON,XL,CNC06 ERR IF NOT CONSTANT
> BNE =B$SCL,(XR),CNC06 ERR IF NOT SCBLK
> JSR SYSSC CALL TO START COPY
> ERR 258,COPY FILE DOES NOT EXIST
> PPM EROSI ERROR RETURN (ALWAYS)
> MOV WA,WB SAVE IOTAG FROM OSINT
> MOV *COSI$,WA GET SIZE OF COPY BLOCK
> JSR ALLOC ALLOCATE
> MOV =B$COP,COTYP(XR) SET TYPE
> MOV R$COP,CONXT(XR) PLACE AT FRONT OF STACK CHN
> MOV XR,R$COP SPLICE IT IN
> MOV WB,COIOT(XR) SAVE OSINT IOTAG
> MOV TTINS,COTTI(XR) SAVE TTINS
> ZER TTINS INPUT NOT FROM TERMINAL NOW
> MOV R$CIM,COCIM(XR) SAVE R$CIM IN CASE EXEC TIME
> MOV SCNPT,COSPT(XR) SAVE SCNPT IN CASE EXEC TIME
> MOV CSWLS,COSLS(XR) SAVE LIST FLAG
> MOV CSWIN,COSIN(XR) SAVE -INXXX VALUE
> MOV R$STL,COSTL(XR) SAVE SUBTITLE
> BZE CSWLS,CNC10 NO LIST -COPY IF -NOLIST
> JSR LISTR LIST -COPY CARD
> BRN CNC10 EXIT
14939a13712,13750
> * COPND -- END -COPY NESTING
> *
> * COPND IS CALLED FROM CMPIL AND READR IN ORDER TO
> * UNNEST ONE LEVEL OF -COPY AND RESTORE THE PREVIOUS
> * INPUT COMPILE STRING. THE COPY BLOCK IS REMOVED
> * FROM THE CHAIN AND THE STATE RESTORED FROM IT.
> *
> * JSR COPND CALL TO END -COPY AT CUR. LEVEL
> * (XL,WA,WB,WC) DESTROYED
> *
> COPND PRC E,0 ENTRY POINT
> MOV R$COP,XL GET POINTER TO CURRENT COBLK
> BZE XL,COP02 EXIT IF NONE
> MOV CONXT(XL),R$COP TAKE OFF CHAIN
> MOV COIOT(XL),WA GET IOTAG FOR OSINT
> JSR SYSEC CALL TO END COPY
> PPM DO NOT USE
> PPM EROSI ERROR EXIT
> BZE CSWLS,COP01 SKIP LISTING IF -NOLIST
> JSR LISTR LIST CURRENT IMAGE
> *
> * MERGE AFTER POSSIBLE LISTING OF CURRENT IMAGE
> *
> COP01 MOV COTTI(XL),TTINS RESTORE TERMINAL INPUT FLAG
> MOV COSLS(XL),CSWLS RESTORE LISTING STATE
> MOV COSPT(XL),SCNPT GET OLD SCAN POINTER
> MOV COSIN(XL),CSWIN OLD INPUT IMAGE LENGTH
> MOV COSTL(XL),R$STL RESTORE SUBTITLE STRING
> MNZ LSTPF THIS IMAGE LISTED IN CNCRD
> MOV COCIM(XL),XL GET OLD COMPILER IMAGE SCBLK
> MOV XL,R$CIM RESTORE IT
> MOV SCLEN(XL),SCNIL SET INPUT IMAGE LENGTH TOO
> *
> * MERGE TO EXIT
> *
> COP02 EXI RETURN TO CALLER
> ENP END PROCEDURE COPND
> EJC
> *
14950a13762,13763
> .IF .CNLD
> .ELSE
14957,14958d13769
< .IF .CNLD
< .ELSE
14966d13776
< .FI
14970a13781
> .FI
14981c13792
< ERB 248,ATTEMPTED REDEFINITION OF SYSTEM FUNCTION
---
> ERB 217,ATTEMPTED REDEFINITION OF SYSTEM FUNCTION
14991,15058d13801
< * 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 XL,DTCNB STORE NAME BASE (GBCOL NOT CALLED)
< ADD WA,XL POINT TO NAME LOCATION
< MOV XL,DTCNM STORE IT
< *
< * LOOP TO SEARCH FOR I/O TRBLK
< *
< DTCH1 MOV XL,XR COPY NAME POINTER
< *
< * CONTINUE AFTER BLOCK DELETION
< *
< DTCH2 MOV (XL),XL POINT TO NEXT VALUE
< BNE (XL),=B$TRT,DTCH6 JUMP AT CHAIN END
< MOV TRTYP(XL),WA GET TRAP BLOCK TYPE
< BEQ WA,=TRTIN,DTCH3 JUMP IF INPUT
< BEQ WA,=TRTOU,DTCH3 JUMP IF OUTPUT
< ADD *TRNXT,XL POINT TO NEXT LINK
< BRN DTCH1 LOOP
< *
< * DELETE AN OLD ASSOCIATION
< *
< DTCH3 MOV TRVAL(XL),(XR) DELETE TRBLK
< MOV XL,WA DUMP XL ...
< MOV XR,WB ... AND XR
< MOV TRTRF(XL),XL POINT TO TRTRF TRAP BLOCK
< BZE XL,DTCH5 JUMP IF NO IOCHN
< BNE (XL),=B$TRT,DTCH5 JUMP IF INPUT, OUTPUT, TERMINAL
< *
< * LOOP TO SEARCH IOCHN CHAIN FOR NAME PTR
< *
< DTCH4 MOV XL,XR REMEMBER LINK PTR
< MOV TRTRF(XL),XL POINT TO NEXT LINK
< BZE XL,DTCH5 JUMP IF END OF CHAIN
< MOV IONMB(XL),WC GET NAME BASE
< ADD IONMO(XL),WC ADD OFFSET
< BNE WC,DTCNM,DTCH4 LOOP IF NO MATCH
< MOV TRTRF(XL),TRTRF(XR) REMOVE NAME FROM CHAIN
< EJC
< *
< * DTACH (CONTINUED)
< *
< * PREPARE TO RESUME I/O TRBLK SCAN
< *
< DTCH5 MOV WA,XL RECOVER XL ...
< MOV WB,XR ... AND XR
< ADD *TRVAL,XL POINT TO VALUE FIELD
< BRN DTCH2 CONTINUE
< *
< * EXIT POINT
< *
< DTCH6 MOV DTCNB,XR POSSIBLE VRBLK PTR
< JSR SETVR RESET VRBLK IF NECESSARY
< EXI RETURN
< ENP END PROCEDURE DTACH
< EJC
< *
15069c13812
< WTB XR CONVERT TO BYTE OFFSET
---
> WTB XR CONVERT TO BAU OFFSET
15092,15093c13835
< * DMARG EQ 2 FULL DUMP (INCL ARRAYS ETC.)
< * DMARG GE 3 CORE DUMP
---
> * DMARG GE 2 FULL DUMP (INCL ARRAYS ETC.)
15101d13842
< BGT XR,=NUM02,DMP29 JUMP IF CORE DUMP REQUIRED
15108,15110c13849
< JSR PRTST PRINT IT
< JSR PRTNL TERMINATE PRINT LINE
< JSR PRTNL AND PRINT A BLANK LINE
---
> JSR PRTFB PRINT IT
15227,15228c13966,13967
< DMP11 JSR PRTNL PRINT BLANK LINE
< JSR PRTNL AND ANOTHER
---
> DMP11 JSR PRTFH PRINT BLANK LINE
> JSR PRTFH AND ANOTHER
15230,15232c13969
< JSR PRTST PRINT HEADING
< JSR PRTNL END LINE
< JSR PRTNL PRINT ONE BLANK LINE
---
> JSR PRTFB PRINT HEADING
15256,15257c13993
< JSR PRTVL PRINT KEYWORD VALUE
< JSR PRTNL TERMINATE PRINT LINE
---
> JSR PRTVF PRINT KEYWORD VALUE
15276c14012
< BEQ WA,=B$BCT,DMP30 JUMP IF BUFFER
---
> BEQ WA,=B$BCT,DMP29 JUMP IF BUFFER
15310c14046
< JSR PRTNL PRINT BLANK LINE
---
> JSR PRTFH PRINT BLANK LINE
15312c14048
< JSR PRTVL PRINT BLOCK VALUE (FOR TITLE)
---
> JSR PRTVF PRINT BLOCK VALUE (FOR TITLE)
15314d14049
< JSR PRTNL END PRINT LINE
15380,15384d14114
< *
< * CALL SYSTEM CORE DUMP ROUTINE
< *
< DMP29 JSR SYSDM CALL IT
< BRN DMP28 RETURN
15393,15395c14123,14124
< DMP30 JSR PRTNL PRINT BLANK LINE
< JSR PRTVL PRINT VALUE ID FOR TITLE
< JSR PRTNL FORCE NEW LINE
---
> DMP29 JSR PRTFH PRINT BLANK LINE
> JSR PRTVF PRINT VALUE ID FOR TITLE
15415,15416c14144
< JSR PRTCH PRINT IT
< JSR PRTNL PRINT NEW LINE
---
> JSR PRTCF PRINT IT
15430c14158
< JSR PRTIS PRINT ERROR PTR OR BLANK LINE
---
> JSR PRTFH PRINT ERROR PTR OR BLANK LINE
15448,15450c14176
< JSR PRTST PRINT ERROR MESSAGE TEXT
< JSR PRTIS PRINT LINE
< JSR PRTIS PRINT BLANK LINE
---
> JSR PRTFB PRINT ERROR MESSAGE TEXT
15465a14192
> BNZ EROSN,ERT03 SKIP IF SPECIAL EROSI RETURN
15483a14211,14216
> *
> * SPECIAL CASE SET UP BY EROSI RETURN TO AVOID SYSEM CALL
> *
> ERT03 ZER EROSN CLEAR FLAG
> MOV R$ETX,XR GET ERROR MESSAGE TEXT
> BRN ERT01 RETURN WITHOUT MAKING SYSEM CALL
15498,15499d14230
< * PPM LOC TRANSFER LOC FOR SUCCESSFUL EVAL
< * (THE NORMAL RETURN IS NEVER TAKEN)
15507c14238
< EVALI PRC R,4 ENTRY POINT (RECURSIVE)
---
> EVALI PRC R,3 ENTRY POINT (RECURSIVE)
15518c14249
< EXI 4 TAKE SUCCESSFUL EXIT
---
> EXI SUCCESSFUL RETURN
15621a14353
> * (WA) APPROPRIATE MULTI CHARACTER PCODE
15626,15627c14358
< * PPM LOC TRANSFER LOC FOR SUCCESSFUL EVAL
< * (THE NORMAL RETURN IS NEVER TAKEN)
---
> * (XL) PCODE OF NEW NODE (ENTRY WA)
15629c14360
< * (XL,WC,RA) DESTROYED
---
> * (WA,WC,RA) DESTROYED
15634a14366,14367
> * THIS IS DONE BY THE USUAL INDIRECT BRANCH THROUGH THE
> * PCODE PASSED IN WA.
15636c14369,14370
< EVALS PRC R,3 ENTRY POINT (RECURSIVE)
---
> EVALS PRC R,2 ENTRY POINT (RECURSIVE)
> MOV WA,-(XS) KEEP PCODE
15638a14373
> MOV (XS)+,WA RECOVER PCODE
15644c14379
< MOV =P$BRK,XL APPROPRIATE PCODE FOR OUR USE
---
> MOV WA,XL APPROPRIATE PCODE FOR OUR USE
15649c14384,14385
< EXI 3 TAKE SUCCESS RETURN
---
> MOV (XR),XL GET PCODE
> EXI TAKE SUCCESS RETURN
15653c14389,14390
< EVLS1 EXI 2 TAKE FAILURE RETURN
---
> EVLS1 MOV (XS)+,WA POP STACK
> EXI 2 TAKE FAILURE RETURN
15733c14470
< EVLX3 MOV (XS)+,XR LOAD VALUE
---
> EVLXV MOV (XS)+,XR LOAD VALUE
15735c14472
< ERB 249,EXPRESSION EVALUATED BY NAME RETURNED VALUE
---
> ERB 218,EXPRESSION EVALUATED BY NAME RETURNED VALUE
15739c14476
< EVLX4 MOV (XS)+,WA LOAD NAME OFFSET
---
> EVLXN MOV (XS)+,WA LOAD NAME OFFSET
15743c14480
< PPM EVLX6 JUMP IF FAILURE DURING ACCESS
---
> PPM EVLXF JUMP IF FAILURE DURING ACCESS
15752c14489
< EVLX6 MNZ WB NOTE UNSUCCESSFUL
---
> EVLXF MNZ WB NOTE UNSUCCESSFUL
15806c14543
< BTW WA CONVERT BYTE COUNT TO WORD COUNT
---
> BTW WA CONVERT BAU COUNT TO WORD COUNT
15985c14722
< MOV =OPDVP,XR ELSE POINT TO UNMISTAKABLE CONCAT.
---
> MOV =OPDVP,XR ELSE POINT TO UNMISTAKEABLE CONCAT
15987c14724
< * MERGE HERE WHEN XR SET UP WITH PROPER CONCATENATION DVBLK
---
> * MERGE WITH CORRECT CONCATENATION DVBLK IN XR
15991c14728
< ERB 220,SYNTAX ERROR. MISSING OPERATOR
---
> ERB 219,SYNTAX ERROR. MISSING OPERATOR
15998c14735
< ERB 221,SYNTAX ERROR. MISSING OPERAND
---
> ERB 220,SYNTAX ERROR. MISSING OPERAND
16023c14760
< EXP08 ERB 222,SYNTAX ERROR. INVALID USE OF LEFT BRACKET
---
> EXP08 ERB 221,SYNTAX ERROR. INVALID USE OF LEFT BRACKET
16049c14786
< ERB 223,SYNTAX ERROR. INVALID USE OF COMMA
---
> ERB 222,SYNTAX ERROR. INVALID USE OF COMMA
16062c14799
< ERB 224,SYNTAX ERROR. UNBALANCED RIGHT PARENTHESIS
---
> ERB 223,SYNTAX ERROR. UNBALANCED RIGHT PARENTHESIS
16080c14817
< WTB WA CONVERT LENGTH TO BYTES
---
> WTB WA CONVERT LENGTH TO BAUS
16124c14861
< ERB 225,SYNTAX ERROR. UNBALANCED RIGHT BRACKET
---
> ERB 224,SYNTAX ERROR. UNBALANCED RIGHT BRACKET
16153c14890
< EXP21 ERB 226,SYNTAX ERROR. MISSING RIGHT PAREN
---
> EXP21 ERB 225,SYNTAX ERROR. MISSING RIGHT PAREN
16157c14894
< EXP22 ERB 227,SYNTAX ERROR. RIGHT PAREN MISSING FROM GOTO
---
> EXP22 ERB 226,SYNTAX ERROR. RIGHT PAREN MISSING FROM GOTO
16161c14898
< EXP23 ERB 228,SYNTAX ERROR. RIGHT BRACKET MISSING FROM GOTO
---
> EXP23 ERB 227,SYNTAX ERROR. RIGHT BRACKET MISSING FROM GOTO
16165c14902
< EXP24 ERB 229,SYNTAX ERROR. MISSING RIGHT ARRAY BRACKET
---
> EXP24 ERB 228,SYNTAX ERROR. MISSING RIGHT ARRAY BRACKET
16269c15006
< EXDM1 BLE 1(XS),=NUM05,EXDM2 JUMP IF STACK BOTTOM (SAVED LEVEL
---
> EXDM1 BLE 1(XS),=NUM05,EXDM2 JUMP IF STACK BOTTOM (SAVED LEVEL)
16324d15060
< .IF .CULC
16326,16369d15061
< * 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 XL,-(XS) SAVE XL ACROSS CALL
< MOV XR,-(XS) SAVE ORIGINAL SCBLK PTR
< JSR ALOCS ALLOCATE NEW STRING BLOCK
< MOV (XS),XL POINT TO ORIGINAL SCBLK
< MOV XR,-(XS) SAVE POINTER TO NEW SCBLK
< PLC XL POINT TO ORIGINAL CHARS
< PLC XR POINT TO NEW CHARS
< ZER -(XS) INIT DID FOLD FLAG
< LCT WC,WC LOAD LOOP COUNTER
< FST01 LCH WA,(XL)+ LOAD CHARACTER
< BGT =CH$$A,WA,FST02 SKIP IF LESS THAN LC A
< BGT WA,=CH$$$,FST02 SKIP IF GREATER THAN LC Z
< FLC WA FOLD CHARACTER TO UPPER CASE
< MNZ (XS) SET DID FOLD CHARACTER FLAG
< FST02 SCH WA,(XR)+ STORE (POSSIBLY FOLDED) CHARACTER
< BCT WC,FST01 LOOP THRU ENTIRE STRING
< CSC XR COMPLETE STORE CHARACTERS
< BNZ (XS)+,FST10 SKIP IF FOLDING DONE
< MOV (XS)+,DNAMP DO NOT NEED NEW SCBLK
< MOV (XS)+,XR RETURN ORIGINAL SCBLK
< BRN FST20 MERGE BELOW
< FST10 MOV (XS)+,XR RETURN NEW SCBLK
< ICA XS THROW AWAY ORIGINAL SCBLK POINTER
< FST20 MOV SCLEN(XR),WA RELOAD STRING LENGTH
< MOV (XS)+,XL RESTORE XL
< FST99 EXI RETURN
< ENP
< EJC
< .FI
< *
16414c15106
< * ENTRY VALUE OF WB IS THE NUMBER OF BYTES TO MOVE UP.
---
> * ENTRY VALUE OF WB IS THE NUMBER OF BAUS TO MOVE UP.
16549,16550c15241,15242
< * BYTES. SET TO THE ADDRESS OF THE
< * FIRST BYTE WHILE ACTUALLY SCANNING
---
> * BAUS. SET TO THE ADDRESS OF THE
> * FIRST BAU WHILE ACTUALLY SCANNING
16570a15263,15265
> .IF .CEPP
> BOD WA,GBC07 JUMP IF ENTRY POINTER (UNUSED)
> .ELSE
16572a15268
> .FI
16578a15275,15277
> .IF .CEPP
> BEV WA,GBC06 LOOP BACK IF NOT END OF CHAIN
> .ELSE
16580a15280
> .FI
16603a15304,15306
> .IF .CEPP
> BEV WA,GBC09 JUMP IF IN USE
> .ELSE
16605a15309
> .FI
16672c15376
< ERB 250,INSUFFICIENT MEMORY TO COMPLETE DUMP
---
> ERB 229,INSUFFICIENT MEMORY TO COMPLETE DUMP
16702a15407,15410
> .IF .CRPP
> BOD XL,GPF02 JUMP IF NOT PTR INTO DYNAMIC AREA
> .ELSE
> .FI
16714a15423,15425
> .IF .CEPP
> BOD WA,GPF03 JUMP IF NOT ALREADY PROCESSED
> .ELSE
16716a15428
> .FI
16752a15465
> IFF BL$CO,GPF19 COBLK
16889a15603,15608
> *
> * COBLK
> *
> GPF19 MOV *COSI$,WA SET LENGTH
> MOV *CONXT,WB AND OFFSET
> BRN GPF05 ALL SET
16890a15610,15611
> .IF .CNBF
> .ELSE
16892a15614,15648
> * GTBUF -- GET BUFFER
> *
> * GTBUF IS PASSED AN OBJECT AND RETURNS A BUFFER IF
> * POSSIBLE. UNLESS THE OBJECT IS ALREADY A BUFFER,
> * THIS INVOLVES A CONVERSION TO STRING AND THEN
> * STRING TO BUFFER.
> *
> * (XR) OBJECT TO BE CONVERTED
> * JSR GTBUF CALL TO GET BUFFER
> * PPM LOC TRANSFER LOC FOR CONVERT IMPOSSIBLE
> * (XR) RESULTING BUFFER
> * (XL,WA,WB,WC) DESTROYED
> *
> GTBUF PRC E,1 ENTRY POINT
> BEQ (XR),=B$BCT,GTB01 EXIT IF ALREADY BUFFER
> MOV XR,-(XS) STACK TO CONVERT TO STRING
> JSR GTSTG CONVERT TO STRING
> PPM GTB02 CONVERSION ERROR
> MOV XR,XL SAVE STRING POINTER
> JSR ALOBF ALLOCATE BUFFER OF SAME SIZE
> JSR INSBF COPY IN THE STRING
> PPM ALREADY STRING - CANT FAIL TO CNV
> PPM MUST BE ENOUGH ROOM
> *
> * MERGE TO EXIT WITH BUFFER CONTROL BLK IN (XR)
> *
> GTB01 EXI RETURN TO CALLER
> *
> * HERE ON CONVERSION FAILURE
> *
> GTB02 EXI 1 TAKE FAILURE EXIT
> ENP
> .FI
> EJC
> *
16895c15651
< * GTARR IS PASSED AN OBJECT AND RETURNS AN ARRAY IF POSSIBL
---
> * GTARR IS PASSED AN OBJECT AND RETURNS AN ARRAY IF POSSIBLE
16907c15663,15664
< BNE WA,=B$TBT,GTA9A ELSE FAIL IF NOT A TABLE (SGD02)
---
> MOV XR,-(XS) PLACE POSSIBLE TBBLK PTR ON STACK
> BNE WA,=B$TBT,GTAR9 ELSE FAIL IF NOT A TABLE
16911d15667
< MOV XR,-(XS) REPLACE TBBLK POINTER ON STACK
16973c15729
< WTB WA CONVERT LENGTH TO BYTES
---
> WTB WA CONVERT LENGTH TO BAUS
17027,17031c15783,15784
< GTAR9 MOV (XS)+,XR RESTORE STACK FOR CONV ERR (SGD02)
< *
< * MERGE TO TAKE CONVERT ERROR WHEN STACK ADJUSTED OK
< *
< GTA9A EXI 1 RETURN
---
> GTAR9 MOV (XS)+,XR CLEAR UP STACK
> EXI 1 RETURN
17095,17099c15848,15852
< * 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.
---
> * CHECK THE LAST CHAR OF STRING FOR COLON OR
> * SEMICOLON. THEY CAN LEGITIMATELY END AN EXPRESSION
> * IN OPEN CODE, SO EXPAN WILL NOT FAIL THEM BUT THEY ARE
> * INVALID AS TERMINATORS FOR A STRING WHICH IS TO BE
> * CONVERTED TO EXPRESSION FORM.
17101,17105c15854,15858
< MOV XR,XL COPY INPUT STRING POINTER (REG06)
< PLC XL,WA POINT ONE PAST THE STRING END (REG06)
< LCH XL,-(XL) FETCH THE LAST CHARACTER (REG06)
< BEQ XL,=CH$CL,GTEX2 ERROR IF IT IS A SEMICOLON (REG06)
< BEQ XL,=CH$SM,GTEX2 OR IF IT IS A COLON (REG06)
---
> MOV XR,XL COPY ARGUMENT STRING
> PLC XL,WA POINT PAST STRING END
> LCH XL,-(XL) GET LAST CHAR
> BEQ XL,=CH$CL,GTEX2 FAIL IF COLON
> BEQ XL,=CH$SM,GTEX2 FAIL IF SEMICOLON
17196c15949
< BEQ WA,=B$ICL,GTN34 JUMP IF INTEGER (NO CONVERSION)
---
> BEQ WA,=B$ICL,GTN3A JUMP IF INTEGER (NO CONVERSION)
17199c15952
< BEQ WA,=B$RCL,GTN34 JUMP IF REAL (NO CONVERSION)
---
> BEQ WA,=B$RCL,GTN3A JUMP IF REAL (NO CONVERSION)
17204a15958
> STI GTNSV SAVE IA
17357,17359c16111,16113
< .IF .CULC
< BEQ WB,=CH$$E,GTN15 JUMP IF E FOR EXPONENT
< BEQ WB,=CH$$D,GTN15 JUMP IF D FOR EXPONENT
---
> .IF .CASL
> BEQ WB,=CH$$E,GTN15 JUMP FOR EXPT
> BEQ WB,=CH$$D,GTN15 JUMP FOR EXPT
17462c16216
< WTB WA CONVERT REMAINING SCALE TO BYTE OFS
---
> WTB WA CONVERT REMAINING SCALE TO BAU OFS
17490c16244
< WTB WA CONVERT REMAINING SCALE TO BYTE OFS
---
> WTB WA CONVERT REMAINING SCALE TO BAU OFS
17524c16278,16279
< GTN34 EXI RETURN TO GTNUM CALLER
---
> GTN34 LDI GTNSV RECOVER IA
> GTN3A EXI RETURN TO GTNUM CALLER
17538a16294
> LDI GTNSV RECOVER IA
17552d16307
< * (WA,WB) DESTROYED (CONVERSION ERROR ONLY)
17558a16314
> BRN GNV01 FAIL
17559a16316,16320
> * RESTORE REGS AND FAIL
> *
> GNV00 MOV GNVSA,WA RESTORE REGS
> MOV GNVSB,WB
> *
17570,17574c16331,16332
< PPM GNV01 JUMP IF CONVERSION ERROR
< BZE WA,GNV01 NULL STRING IS AN ERROR
< .IF .CULC
< JSR FLSTG FOLD LOWER CASE TO UPPER CASE
< .FI
---
> PPM GNV00 JUMP IF CONVERSION ERROR
> BZE WA,GNV00 NULL STRING IS AN ERROR
17575a16334,16339
> .IF .CASL
> MOV XR,XL COPY STRING POINTER
> ZER WB ZERO OFFSET
> JSR SBSTG CONVERT TO PREFERRED CASE
> MOV SCLEN(XR),WA RECOVER STRING LENGTH
> .FI
17586c16350
< WTB WC CONVERT OFFSET TO BYTES
---
> WTB WC CONVERT OFFSET TO BAUS
17635c16399
< WTB XL CONVERT TO BYTE OFFSET
---
> WTB XL CONVERT TO BAU OFFSET
17687c16451
< WTB WA CONVERT LENGTH TO BYTES
---
> WTB WA CONVERT LENGTH TO BAUS
17703c16467
< WTB WA CONVERT TO LENGTH IN BYTES
---
> WTB WA CONVERT TO LENGTH IN BAUS
17826c16590
< * MERGE HERE TO EXIT OF NO CONVERSION REQUIRED
---
> * MERGE HERE TO EXIT IF NO CONVERSION REQUIRED
17901c16665
< BGT WC,MXLEN,GTSM3 OR IF TOO SMALL
---
> BGT WC,MXLEN,GTSM3 OR IF TOO LARGE
17979c16743
< .IF .CNCI
---
> .IF .CSCI
18008d16771
< .FI
18023a16787
> .FI
18181a16946,16948
> .IF .CPLC
> MOV =CH$$E,WA GET CHAR LETTER E
> .ELSE
18182a16950
> .FI
18265c17033
< MOV BCBUF(XL),XL POINT TO BFBLK
---
> MOV BCBUF(XL),XL POINT TOBFBLK
18326c17094
< * HASHS IS USED TO CONVERT A STRING TO A UNIQUE INTEGER
---
> * HASHS REPRODUCIBLY MAPS A STRING TO AN INTEGER
18337c17105
< * START WITH THE LENGTH OF THE STRING (SGD07)
---
> * START WITH THE LENGTH OF THE STRING
18383,18384c17151,17154
< MFI XR,ICBL1 COPY SMALL INTEGERS
< BLE XR,=NUM02,ICBL3 JUMP IF 0,1 OR 2
---
> ILT ICBL1 SKIP IF NEGATIVE
> SBI INTV2 REDUCE BY TWO
> ILE ICBL3 JUMP IF 0 , 1 OR 2
> ADI INTV2 RESTORE VALUE
18405c17175,17177
< ICBL3 WTB XR CONVERT INTEGER TO OFFSET
---
> ICBL3 ADI INTV2 RESTORE VALUE
> MFI XR CONVERT TO SHORT INTEGER
> WTB XR CONVERT INTEGER TO OFFSET
18503c17275
< * INOUT - USED TO INITIALISE INPUT AND OUTPUT VARIABLES
---
> * INOUT - USED TO INITIALISE .INPUT .OUTPUT .TERMINAL
18506c17278
< * (WB) TRBLK TYPE
---
> * (WB) TRBLK TYPE (TRTYP FIELD)
18508,18509d17279
< * (XL) VRBLK PTR
< * (XR) TRBLK PTR
18521c17291
< JSR GTNVR BUILD VRBLK
---
> JSR GTNVR FIND OR BUILD VRBLK
18524,18525c17294,17296
< MOV (XS)+,WB GET TRTER FIELD
< ZER XL ZERO TRFPT
---
> MOV (XS)+,WB GET TRTYP FIELD
> ZER XL ZERO TRTRI
> MOV VRSVP(XR),XR GET SVBLK POINTER
18528,18531c17299,17301
< MOV VRSVP(XL),TRTER(XR) STORE SVBLK POINTER
< MOV XR,VRVAL(XL) STORE TRBLK PTR IN VRBLK
< MOV =B$VRA,VRGET(XL) SET TRAPPED ACCESS
< MOV =B$VRV,VRSTO(XL) SET TRAPPED STORE
---
> MOV *VRVAL,WA OFFSET TO VALUE FIELD
> JSR TRCHN PUT TRBLK IN TRACE CHAIN
> PPM CANT FAIL
18542,18543c17312,17313
< * SECTION TO BE REPLACED IS DIFFERENT THAN THE LENGTH OF
< * THE GIVEN STRING, AND THE REPLACEMENT IS NOT AN APPEND,
---
> * SECTION TO BE REPLACED DIFFERS FROM THAT OF THE
> * GIVEN STRING, AND THE REPLACEMENT IS NOT AN APPEND,
18547,18548c17317,17318
< * (XR) POINTER TO BFBLK
< * (XL) OBJECT WHICH IS STRING CONVERTABLE
---
> * (XR) POINTER TO BCBLK
> * (XL) OBJECT WHICH IS STRING CONVERTIBLE
18552,18553c17322,17324
< * PPM LOC THREAD IF (XR) NOT CONVERTABLE
< * PPM LOC THREAD IF INSERT NOT POSSIBLE
---
> * PPM LOC ERROR IF (XR) NOT CONVERTIBLE
> * PPM LOC FAIL IF INSERT NOT POSSIBLE
> * (XL,WA,WB,WC) DESTROYED
18562d17332
< MOV WC,INSSC SAVE ENTRY WC
18568d17337
< MOV XL,-(XS) SAVE ENTRY XL
18570c17339
< MOV XL,-(XS) STACK AGAIN FOR GTSTG
---
> MOV XL,-(XS) STACK STRING POINTER FOR GTSTG
18572c17341
< PPM INS05 TAKE STRING CONVERT ERR EXIT
---
> PPM INS06 TAKE STRING CONVERT ERR EXIT
18574c17343,17346
< MOV (XS),XR RESTORE BCBLK PTR
---
> MOV (XS)+,XR RESTORE BCBLK PTR
> MOV XR,INSBC BCBLK PTR - NO DANGER OF GARB COLLN
> MOV BCBUF(XR),XR POINT TO BFBLK
> MOV XR,INSBB BFBLK PTR - NO DANGER OF GARB COLLN
18577,18579c17349,17350
< MOV BCBUF(XR),XR POINT TO BFBLK
< BGT WA,BFALC(XR),INS06 FAIL IF RESULT EXCEEDS ALLOCATION
< MOV (XS),XR RESTORE BCBLK PTR
---
> BGT WA,BFALC(XR),INS07 FAIL IF RESULT EXCEEDS ALLOCATION
> MOV INSBC,XR RESTORE BCBLK PTR
18586,18588c17357
< BZE WA,INS04 SKIP SHIFT IF NOTHING TO DO
< BEQ INSSB,SCLEN(XL),INS04 SKIP SHIFT IF LENGTHS MATCH
< MOV BCBUF(XR),XR POINT TO BFBLK
---
> MOV INSBB,XR POINT TO BFBLK
18590c17359,17361
< BLO INSSB,SCLEN(XL),INS01 BRN IF SHFT IS FOR MORE ROOM
---
> BZE WA,INS02 SKIP SHIFT IF NOTHING TO DO
> BEQ INSSB,SCLEN(XL),INS02 SKIP SHIFT IF LENGTHS MATCH
> BLO INSSB,SCLEN(XL),INS01 BRN IF SHIFT IS FOR MORE ROOM
18597c17368
< * SEGMENT BEING REPLACED.) REGISTERS ARE SET AS:
---
> * SEGMENT BEING REPLACED). REGISTERS ARE SET AS -
18622c17393
< * MERGE HERE AFTER MOVE TO ADJUST PADDING AT NEW BUFFER END
---
> * MERGE HERE AFTER POSSIBLE MOVE TO ADJUST ZERO FILL AT END
18626a17398
> BTC WA CONVERT TO CHAR COUNT
18629,18630c17401
< MOV (XS),XR GET BCBLK PTR
< MOV BCBUF(XR),XR GET BFBLK PTR
---
> MOV INSBB,XR POINT TO BFBLK
18633a17405
> EJC
18634a17407,17408
> * INSBF (CONTINUED)
> *
18639d17412
< EJC
18641,18642d17413
< * INSBF (CONTINUED)
< *
18646,18647c17417
< INS04 MOV (XS),XR GET BCBLK PTR
< MOV BCBUF(XR),XR GET BFBLK PTR
---
> INS04 MOV INSBB,XR POINT TO BFBLK
18648a17419
> BZE WA,INS05 SKIP IF NO CHARS TO INSERT
18652,18656c17423,17427
< MOV (XS)+,XR RESTORE ENTRY XR
< MOV (XS)+,XL RESTORE ENTRY XL
< MOV INSSA,WA RESTORE ENTRY WA
< MOV INSSB,WB RESTORE ENTRY WB
< MOV INSSC,WC RESTORE ENTRY WC
---
> *
> * SUCCESSFUL RETURN
> *
> INS05 MOV INSBC,XR RESTORE ENTRY XR
> ZER XL CLEAR GARBAGE CHAR POINTER
18661,18665c17432
< INS05 MOV (XS)+,XR RESTORE ENTRY XR
< MOV (XS)+,XL RESTORE ENTRY XL
< MOV INSSA,WA RESTORE ENTRY WA
< MOV INSSB,WB RESTORE ENTRY WB
< MOV INSSC,WC RESTORE ENTRY WC
---
> INS06 ICA XS DISCARD UNWANTED STACK TOP
18670,18678c17437
< INS06 MOV (XS)+,XR RESTORE ENTRY XR
< MOV (XS)+,XL RESTORE ENTRY XL
< *
< * MERGE FOR LENGTH FAILURE EXIT WITH STACK SET
< *
< INS07 MOV INSSA,WA RESTORE ENTRY WA
< MOV INSSB,WB RESTORE ENTRY WB
< MOV INSSC,WC RESTORE ENTRY WC
< EXI 2 ALTERNATE EXIT
---
> INS07 EXI 2 ALTERNATE EXIT
18681a17441
> * IOFTG -- GET IOTAG
18683c17443,17444
< * IOFCB -- GET INPUT/OUTPUT FCBLK POINTER
---
> * USED TO FIND THE IOTAG (IF ANY) CORRESPONDING TO THE
> * FILETAG ARGUMENT.
18685,18691c17446,17448
< * 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) FILETAG ARGUMENT
> * JSR IOFTG CALL TO FIND IOTAG
> * PPM LOC ARG IS AN UNSUITABLE FILETAG
18693,18696c17450,17454
< * (XL) PTR TO FILEARG1 VRBLK
< * (XR) ARGUMENT
< * (WA) FCBLK PTR OR 0
< * (WB) DESTROYED
---
> * (XL) PTR TO FILETAG SCBLK
> * (XR) PTR TO TRTIO TRACE BLK OR ZERO
> * (WA) IOTAG OR ZERO
> * (WB) PTR TO FILETAG VRBLK
> * (WC) VALUE/0 FOR INTEGER/STRING FILETAG
18698c17456
< IOFCB PRC N,2 ENTRY POINT
---
> IOFTG PRC N,1 ENTRY POINT
18700c17458
< PPM IOFC2 FAIL
---
> PPM IOFT4 FAIL
18702,18705c17460,17474
< JSR GTNVR GET AS NATURAL VARIABLE
< PPM IOFC3 FAIL IF NULL
< MOV XL,WB COPY STRING POINTER AGAIN
< MOV XR,XL COPY VRBLK PTR FOR RETURN
---
> MOV XR,-(XS) STACK STRING
> JSR GTSMI TRY CONVERSION TO INTEGER
> PPM IOFT5 SKIP IF CANT
> PPM IOFT5 SKIP IF CANT
> *
> * MERGE WITH WC SET UP
> *
> IOFT1 MOV WC,WB KEEP INTEGER OR ZERO
> MOV XL,XR FILETAG STRING TO XR FOR GTNVR CALL
> JSR GTNVR FIND VRBLK
> PPM IOFT4 SKIP IF NULL STRING
> MOV XL,-(XS) KEEP SCBLK PTR
> ZER XL IN CASE NO TRTIO BLK FOUND
> MOV WB,WC KEEP INTEGER OR ZERO
> MOV XR,WB COPY VRBLK PTR FOR RETURN
18710,18715c17479,17483
< IOFC1 MOV VRVAL(XR),XR GET POSSIBLE TRBLK PTR
< BNE (XR),=B$TRT,IOFC2 FAIL IF END OF CHAIN
< BNE TRTYP(XR),=TRTFC,IOFC1 LOOP IF NOT FILE ARG TRBLK
< MOV TRFPT(XR),WA GET FCBLK PTR
< MOV WB,XR COPY ARG
< EXI RETURN
---
> IOFT2 MOV VRVAL(XR),XR GET POSSIBLE TRBLK PTR
> BNE (XR),=B$TRT,IOFT3 SKIP IF END OF CHAIN
> BNE TRTYP(XR),=TRTIO,IOFT2 LOOP IF NOT FILETAG TRBLK
> MOV TRTAG(XR),WA GET IOTAG OR 0
> MOV XR,XL TRTIO BLK PTR
18717c17485
< * FAIL RETURN
---
> * RETURN POINT
18719c17487,17489
< IOFC2 EXI 1 FAIL
---
> IOFT3 MOV XL,XR TRTIO BLK PTR OR 0
> MOV (XS)+,XL RECOVER SCBLK PTR
> EXI SUCCESSFUL RETURN
18721c17491
< * NULL ARG
---
> * FAIL RETURN
18723,18724c17493
< IOFC3 EXI 2 NULL ARG RETURN
< ENP END PROCEDURE IOFCB
---
> IOFT4 EXI 1 FAIL
18727c17496
< * IOPPF -- PROCESS FILEARG2 FOR IOPUT
---
> * NON NUMERIC FILETAG
18729,18755c17498,17500
< * (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 WB TO COUNT FIELDS EXTRACTED
< *
< * LOOP TO EXTRACT FIELDS
< *
< IOPP1 MOV =IODEL,XL GET DELIMITER
< MOV XL,WC COPY IT
< JSR XSCAN GET NEXT FIELD
< MOV XR,-(XS) STACK IT
< ICV WB INCREMENT COUNT
< BNZ WA,IOPP1 LOOP
< MOV WB,WC COUNT OF FIELDS
< MOV IOPTT,WB I/O MARKER
< MOV R$IOF,WA FCBLK PTR OR 0
< MOV R$IO2,XR FILE ARG2 PTR
< MOV R$IO1,XL FILEARG1
< EXI RETURN
< ENP END PROCEDURE IOPPF
---
> IOFT5 ZER WC NOTE NON NUMERIC
> BRN IOFT1 MERGE
> ENP END PROCEDURE IOFTG
18758c17503
< * IOPUT -- ROUTINE USED BY INPUT AND OUTPUT
---
> * IOPUT -- PROCESS INPUT AND OUTPUT ARGUMENTS
18760,18763c17505,17507
< * 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.
---
> * IOPUT CHECKS THE ARGUMENTS OF INPUT AND OUTPUT CALLS,
> * SETS UP THE REQUIRED ASSOCIATIONS AND CALLS SYSIO TO
> * OPEN THE REQUESTED FILES.
18765,18820d17508
< * +-----------+ +---------------+ +-----------+
< * +-.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.
< *
18822,18824c17510,17512
< * -(XS) 2ND ARG (FILE ARG1)
< * -(XS) 3RD ARG (FILE ARG2)
< * (WB) 0 FOR INPUT, 3 FOR OUTPUT ASSOC.
---
> * -(XS) 2ND ARG (FILETAG)
> * -(XS) 3RD ARG (FILEPROPS)
> * (WB) 0 FOR INPUT, 2 FOR OUTPUT ASSOC.
18827c17515
< * PPM LOC 2ND ARG NOT A SUITABLE NAME
---
> * PPM LOC 2ND ARG NOT A SUITABLE FILETAG
18829,18831c17517
< * 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
---
> * PPM LOC FAIL RETURN
18835,18858d17520
< IOPUT PRC N,6 ENTRY POINT
< ZER R$IOT IN CASE NO TRTRF BLOCK USED
< ZER R$IOF IN CASE NO FCBLK ALOCATED
< MOV WB,IOPTT STORE I/O TRACE TYPE
< JSR XSCNI PREPARE TO SCAN FILEARG2
< PPM IOP13 FAIL
< PPM IOPA0 NULL FILE ARG2
< *
< IOPA0 MOV XR,R$IO2 KEEP FILE ARG2
< MOV WA,XL COPY LENGTH
< JSR GTSTG CONVERT FILEARG1 TO STRING
< PPM IOP14 FAIL
< MOV XR,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 XL,IOP01 SKIP IF BOTH ARGS NULL
< JSR IOPPF PROCESS FILEARG2
< JSR SYSFC CALL FOR FILEARG2 CHECK
< PPM IOP16 FAIL
< BRN IOP11 COMPLETE FILE ASSOCIATION
18859a17522,17538
> * FIRST ARG NAME
> * I I
> * +------+
> * I I-----+
> * +------+ V
> * I I +----------------+
> * I =B$TRT I
> * +----------------+
> * I =TRTIN/=TRTOU I
> * +----------------+
> * I VALUE OR TRCHN +
> * +----------------+
> * TRTER I I-----+
> * +----------------+ V
> * TRTRI I 0 I +------+
> * +----------------+ I I SVBLK
> * I/O TRACE BLOCK +------+
18861c17540
< * IOPUT (CONTINUED)
---
> * 1. ASSOCIATION TO STANDARD FILES.
18863c17542,17558
< * HERE WITH 0 OR FCBLK PTR IN (XL)
---
> * FIRST ARG NAME FILETAG VRBLK
> * I I I I
> * +------+ LK1 +------+ LK2
> * I I---+ +---+ I I---+
> * +------+ V I V +------+ V
> * I I +----------------+ I +----------------+
> * I =B$TRT I I I =B$TRT I
> * +----------------+ I +----------------+
> * I =TRTIN/=TRTOU I I I =TRTIO I
> * +----------------+ I +----------------+
> * I VALUE OR TRCHN I I I VALUE OR TRCHN I
> * +----------------+ I +----------------+
> * TRTER I 0 I I I 0 OR IOTAG I TRTAG
> * +----------------+ I +----------------+
> * TRTRI I I--+ I 0 I TRTRI
> * +----------------+ +----------------+
> * I/O TRACE BLOCK TRTIO BLOCK
18865,18875c17560
< IOP01 MOV IOPTT,WB GET TRACE TYPE
< MOV R$IOT,XR GET 0 OR TRTRF PTR
< JSR TRBLD BUILD TRBLK
< MOV XR,WC COPY TRBLK POINTER
< MOV (XS)+,XR GET VARIABLE FROM STACK
< JSR GTVAR POINT TO VARIABLE
< PPM IOP15 FAIL
< MOV XL,R$ION SAVE NAME POINTER
< MOV XL,XR COPY NAME POINTER
< ADD WA,XR POINT TO VARIABLE
< SUB *VRVAL,XR SUBTRACT OFFSET,MERGE INTO LOOP
---
> * 2. REGULAR CASE.
18877,18902c17562,17579
< * LOOP TO END OF TRBLK CHAIN IF ANY
< *
< IOP02 MOV XR,XL COPY BLK PTR
< MOV VRVAL(XR),XR LOAD PTR TO NEXT TRBLK
< BNE (XR),=B$TRT,IOP03 JUMP IF NOT TRAPPED
< BNE TRTYP(XR),IOPTT,IOP02 LOOP IF NOT SAME ASSOCN
< MOV TRNXT(XR),XR GET VALUE AND DELETE OLD TRBLK
< *
< * IOPUT (CONTINUED)
< *
< * STORE NEW ASSOCIATION
< *
< IOP03 MOV WC,VRVAL(XL) LINK TO THIS TRBLK
< MOV WC,XL COPY POINTER
< MOV XR,TRNXT(XL) STORE VALUE IN TRBLK
< MOV R$ION,XR RESTORE POSSIBLE VRBLK POINTER
< MOV WA,WB KEEP OFFSET TO NAME
< JSR SETVR IF VRBLK, SET VRGET,VRSTO
< MOV R$IOT,XR GET 0 OR TRTRF PTR
< BNZ XR,IOP19 JUMP IF TRTRF BLOCK EXISTS
< EXI RETURN TO CALLER
< *
< * NON STANDARD FILE
< * SEE IF AN FCBLK HAS ALREADY BEEN ALLOCATED.
< *
< IOP04 ZER WA IN CASE NO FCBLK FOUND
---
> * THE STRUCTURES BUILT FOR I/O ASSOCIATIONS ARE AS SHOWN
> * ABOVE. A TRACE BLOCK CHAIN (TRCHN) MAY HOLD ANY OR ALL
> * OF THE TYPES, =TRTIN, =TRTOU, =TRTIO, BUT NOT MORE THAN
> * ONE BLOCK OF ANY GIVEN TYPE. CASES ARE -
> * 1. NO FILETAG OR IOTAG IS USED FOR ASSOCIATING STANDARD
> * FILES (SYSRD, SYSPR, TERMINAL). THE I/O TRACE BLOCK
> * IS DISTINGUISHED BY A NON-NULL TRTER FIELD POINTING
> * TO THE RELEVANT SVBLK (V$INP, V$OUP, V$TER) AND A
> * ZERO TRTRI FIELD. FOR TERMINAL, TRBLKS OF BOTH
> * INPUT AND OUTPUT TYPE ARE CHAINED FROM THE FIRST ARG
> * VIA THE TRCHN FIELD.
> * 2. THE I/O TRACE BLOCK FOR THE REGULAR CASE HAS A ZERO
> * TRTER FIELD AND A POINTER TO A TRTIO BLOCK IS IN
> * THE TRTRI FIELD. THE FILETAG MUST BE A NATURAL
> * VARIABLE AND THE TRTIO TRACE BLOCK ATTACHED TO IT
> * HOLDS THE IOTAG.
> * THE EFFECT OF ENDFILE() IS TO CLEAR IOTAG AND BREAK LK2.
> * THE EFFECT OF DETACH() IS TO BREAK LK1.
18903a17581,17586
> IOPUT PRC N,4 ENTRY POINT
> MOV WB,IOPWB KEEP ASSOCIATION TYPE FLAG
> JSR GTSTG CONVERT THIRD ARG TO STRING
> PPM IOP12 FAIL THIRD ARG
> BNZ WA,IOP01 SKIP IF NON NULL
> ZER XR NOTE NULL ARG
18905c17588
< * IOPUT (CONTINUED)
---
> * PROCESS SECOND ARG
18907,18950c17590,17610
< * SEARCH POSSIBLE TRBLK CHAIN TO PICK UP THE FCBLK
< *
< IOP05 MOV XR,WB REMEMBER BLK PTR
< MOV VRVAL(XR),XR CHAIN ALONG
< BNE (XR),=B$TRT,IOP06 JUMP IF END OF TRBLK CHAIN
< BNE TRTYP(XR),=TRTFC,IOP05 LOOP IF MORE TO GO
< MOV XR,R$IOT POINT TO FILE ARG1 TRBLK
< MOV TRFPT(XR),WA 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 WA,R$IOF KEEP POSSIBLE FCBLK PTR
< MOV WB,R$IOP KEEP PRECEDING BLK PTR
< JSR IOPPF PROCESS FILEARG2
< JSR SYSFC SEE IF FCBLK REQUIRED
< PPM IOP16 FAIL
< BZE WA,IOP12 SKIP IF NO NEW FCBLK WANTED
< BLT WC,=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 XR,XL POINT TO FCBLK
< MOV WA,WB COPY ITS LENGTH
< BTW WB GET COUNT AS WORDS (SGD APR80)
< LCT WB,WB LOOP COUNTER
< *
< * CLEAR FCBLK
< *
< IOP07 ZER (XR)+ CLEAR A WORD
< BCT WB,IOP07 LOOP
< BEQ WC,=NUM02,IOP09 SKIP IF IN STATIC - DONT SET FIELDS
< MOV =B$XNT,(XL) STORE XNBLK CODE IN CASE
< MOV WA,1(XL) STORE LENGTH
< BNZ WC,IOP09 JUMP IF XNBLK WANTED
< MOV =B$XRT,(XL) XRBLK CODE REQUESTED
< *
---
> IOP01 MOV XR,R$IOR KEEP FILEPROPS STRING PTR
> JSR IOFTG CHECK SECOND ARG
> PPM IOP07 FAIL SECOND ARG
> MOV XL,R$IOL KEEP SCBLK FOR FILETAG
> MOV XR,R$IOT KEEP TRTIO BLK PTR
> MOV WA,IOPWA KEEP IOTAG
> MOV WB,IOPVR KEEP FILETAG VRBLK PTR
> MOV WC,IOPWC KEEP FILETAG VALUE
> MOV (XS)+,XR GET FIRST ARG OFF STACK
> JSR GTVAR CONVERT TO NAME
> PPM IOP13 FAIL FIRST ARG
> MOV XL,R$IO1 SAVE FIRST ARG NAME BASE ADRS
> MOV WA,IOPNF SAVE FIRST ARG NAME OFFSET
> MOV WB,XR FILETAG VRBLK PTR
> BNZ VRLEN(XR),IOP02 NOT SPECIAL CASE IF NOT SYS NAME
> MOV VRSVP(XR),WC GET SVBLK PTR
> MOV =TRTIN,WB IN CASE .INPUT
> BEQ WC,=V$INP,IOP06 JUMP IF .INPUT
> MOV =TRTOU,WB IN CASE .OUTPUT OR .TERMINAL
> BEQ WC,=V$OUP,IOP08 JUMP IF .OUTPUT
> BEQ WC,=V$TER,IOP09 JUMP IF .TERMINAL
18952d17611
< * IOPUT (CONTINUED)
18954c17613
< * COMPLETE FCBLK INITIALISATION
---
> * NORMAL CASE
18956,18958c17615,17624
< IOP09 MOV R$IOT,XR GET POSSIBLE TRBLK PTR
< MOV XL,R$IOF STORE FCBLK PTR
< BNZ XR,IOP10 JUMP IF TRBLK ALREADY FOUND
---
> IOP02 BNZ R$IOT,IOP03 SKIP IF TRTIO BLK EXISTS ALREADY
> MOV =TRTIO,WB TRACE BLOCK TYPE WORD
> ZER XR ZERO IOTAG WORD
> ZER XL ZERO TRTRI FIELD
> JSR TRBLD BUILD TRTIO TRBLK
> MOV XR,R$IOT SAVE TRTIO BLK PTR
> MOV IOPVR,XL GET FILETAG VRBLK
> MOV *VRVAL,WA OFFSET TO VALUE FIELD
> JSR TRCHN PLACE IN TRBLK CHAIN FOR FILETAG
> PPM UNUSED RETURN
18960c17626
< * A NEW TRBLK IS NEEDED
---
> * MERGE TO BUILD TRBLK FOR FIRST ARG
18962,18970c17628,17630
< MOV =TRTFC,WB TRTYP FOR FCBLK TRAP BLK
< JSR TRBLD MAKE THE BLOCK
< MOV XR,R$IOT COPY TRTRF PTR
< MOV R$IOP,XL POINT TO PRECEDING BLK
< MOV VRVAL(XL),VRVAL(XR) COPY VALUE FIELD TO TRBLK
< MOV XR,VRVAL(XL) LINK NEW TRBLK INTO CHAIN
< MOV XL,XR POINT TO PREDECESSOR BLK
< JSR SETVR SET TRACE INTERCEPTS
< MOV VRVAL(XR),XR RECOVER TRBLK PTR
---
> IOP03 MOV =TRTIN,WB IN CASE INPUT
> BZE IOPWB,IOP04 SKIP IF SO
> MOV =TRTOU,WB IN CASE OUTPUT
18972c17632
< * XR IS PTR TO TRBLK, XL IS FCBLK PTR OR 0
---
> * BUILD TRACE BLOCK
18974c17634,17641
< IOP10 MOV R$IOF,TRFPT(XR) STORE FCBLK PTR
---
> IOP04 ICV IOPWB NOTE NOT STANDARD I/O FILE
> MOV R$IOT,XL TRTIO BLK PTR TO TRTRI FIELD
> ZER XR ZERO TRTER FIELD
> JSR TRBLD BUILD I/O TRACE BLOCK
> MOV R$IO1,XL ASSOCIATED VBL NAME BASE
> MOV IOPNF,WA NAME OFFSET
> JSR TRCHN UPDATE TRACE CHAIN FOR FIRST ARG
> PPM UNUSED RETURN
18976c17643
< * CALL SYSIO TO COMPLETE FILE ACCESSING
---
> * PREPARE FOR AND MAKE SYSIO CALL
18978,19003c17645,17656
< IOP11 MOV R$IOF,WA COPY FCBLK PTR OR 0
< MOV IOPTT,WB GET INPUT/OUTPUT FLAG
< MOV R$IO2,XR GET FILE ARG2
< MOV R$IO1,XL 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 WC,IOP01 NO CHANGE TO STANDARD READ LENGTH
< MOV WC,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 XL,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
---
> IOP05 MOV R$IOL,XL FILETAG SCBLK PTR
> MOV R$IOR,XR FILEPROPS SCBLK PTR
> MOV IOPWA,WA IOTAG OR ZERO
> MOV IOPWB,WB ASSOCIATION TYPE NUMBER
> MOV IOPWC,WC POSSIBLE FILETAG VALUE
> JSR SYSIO CALL SYSTEM ROUTINE TO OPEN FILE
> PPM IOP14 FAIL RETURN
> PPM EROSI ERROR RETURN
> MOV R$IOT,XL TRTIO POINTER
> BZE XL,IOP11 DONE IF ZERO
> MOV WA,TRTAG(XL) STORE RETURNED IOTAG
> BRN IOP11 SUCCEED
19006c17659
< * IOPUT (CONTINUED)
---
> * SPECIAL CASE OF .INPUT
19008,19009c17661
< * ADD TO IOCHN CHAIN OF ASSSOCIATED VARIABLES UNLESS ALREAD
< * PRESENT.
---
> IOP06 BZE IOPWB,IOP09 FAIL OUTPUT(.X,.INPUT)
19011c17663
< IOP19 MOV R$ION,WC WC = NAME BASE, WB = NAME OFFSET
---
> * BAD FILETAG
19013c17665
< * SEARCH LOOP
---
> IOP07 EXI 2 ERRONEOUS SECOND ARG
19015,19019c17667
< IOP20 MOV TRTRF(XR),XR NEXT LINK OF CHAIN
< BZE XR,IOP21 NOT FOUND
< BNE WC,IONMB(XR),IOP20 NO MATCH
< BEQ WB,IONMO(XR),IOP22 EXIT IF MATCHED
< BRN IOP20 LOOP
---
> * SPECIAL CASE OF .OUTPUT
19021c17669
< * NOT FOUND
---
> IOP08 BZE IOPWB,IOP07 FAIL INPUT(.X,.OUTPUT)
19023,19032c17671
< IOP21 MOV *NUM05,WA SPACE NEEDED
< JSR ALLOC GET IT
< MOV =B$XRT,(XR) STORE XRBLK CODE
< MOV WA,1(XR) STORE LENGTH
< MOV WC,IONMB(XR) STORE NAME BASE
< MOV WB,IONMO(XR) STORE NAME OFFSET
< MOV R$IOT,XL POINT TO TRTRF BLK
< MOV TRTRF(XL),WA GET PTR FIELD CONTENTS
< MOV XR,TRTRF(XL) STORE PTR TO NEW BLOCK
< MOV WA,TRTRF(XR) COMPLETE THE LINKING
---
> * SPECIAL CASE OF .TERMINAL AND MERGE FOR OTHERS
19034c17673,17685
< * INSERT FCBLK ON FCBLK CHAIN FOR SYSEJ, SYSXI
---
> IOP09 ZER R$IOT NOTE NO TRTIO BLOCK
> MOV WC,XR SVBLK PTR FOR TRTER FIELD
> ZER XL ZERO TRTRI FIELD
> JSR TRBLD BUILD TRBLK
> MOV R$IO1,XL ASSOCIATED VBL NAME BASE
> MOV IOPNF,WA NAME OFFSET
> JSR TRCHN UPDATE TRACE CHAIN FOR ARG 1
> PPM UNUSED RETURN
> BNE TRTER(XR),=V$TER,IOP10 DONE UNLESS TERMINAL
> BNE TRTYP(XR),=TRTOU,IOP10 DONE IF TERM. 2ND TIME ROUND
> MOV =V$TER,WC TRTER FIELD
> MOV =TRTIN,WB TRTYP FIELD
> BRN IOP09 REPEAT LOOP FOR TERMINAL
19036,19037c17687
< IOP22 BZE R$IOF,IOP25 SKIP IF NO FCBLK
< MOV R$FCB,XL PTR TO HEAD OF EXISTING CHAIN
---
> * CHECK SPECIAL CASES FOR NON-NULL THIRD ARGS
19039c17689,17690
< * SEE IF FCBLK ALREADY ON CHAIN
---
> IOP10 ZER IOPWA NO IOTAG
> BNZ R$IOR,IOP05 MERGE ONLY IF FILEPROPS NON-NULL
19041,19044c17692
< IOP23 BZE XL,IOP24 NOT ON IF END OF CHAIN
< BEQ 3(XL),R$IOF,IOP25 DONT DUPLICATE IF FIND IT
< MOV 2(XL),XL GET NEXT LINK
< BRN IOP23 LOOP
---
> * SUCCESS RETURN
19046c17694,17698
< * NOT FOUND SO ADD AN ENTRY FOR THIS FCBLK
---
> IOP11 ZER R$IO1 CLEAR GARBAGE
> ZER R$IOL
> ZER R$IOR
> ZER R$IOT
> EXI RETURN TO CALLER
19048,19054c17700
< IOP24 MOV *NUM04,WA SPACE NEEDED
< JSR ALLOC GET IT
< MOV =B$XRT,(XR) STORE BLOCK CODE
< MOV WA,1(XR) STORE LENGTH
< MOV R$FCB,2(XR) STORE PREVIOUS LINK IN THIS NODE
< MOV R$IOF,3(XR) STORE FCBLK PTR
< MOV XR,R$FCB INSERT NODE INTO FCBLK CHAIN
---
> * ERROR RETURNS
19056c17702
< * RETURN
---
> IOP12 EXI 1 ERRONEOUS THIRD ARG
19058c17704,17706
< IOP25 EXI RETURN TO CALLER
---
> IOP13 EXI 3 ERRONEOUS FIRST ARG
> *
> IOP14 EXI 4 FAIL RETURN FROM SYSIO
19098,19099c17746
< JSR PRTVL PRINT KEYWORD VALUE
< JSR PRTNL TERMINATE PRINT LINE
---
> JSR PRTVF PRINT KEYWORD VALUE
19144c17791
< KWNM1 ERB 251,KEYWORD OPERAND IS NOT NAME OF DEFINED KEYWORD
---
> KWNM1 ERB 230,KEYWORD OPERAND IS NOT NAME OF DEFINED KEYWORD
19173c17820
< BLO WA,WB,LCMP1 JUMP IF ARG 1 LENGTH IS SMALLER
---
> BLO WA,WB,LCMP0 JUMP IF ARG 1 LENGTH IS SMALLER
19178,19179c17825,17830
< LCMP1 CMC LCMP4,LCMP3 COMPARE STRINGS, JUMP IF UNEQUAL
< BNE WB,WC,LCMP2 IF EQUAL, JUMP IF LENGTHS UNEQUAL
---
> LCMP0 BZE WA,LCMP1 SKIP IF A NULL ARG
> CMC LCMP4,LCMP3 COMPARE STRINGS, JUMP IF UNEQUAL
> *
> * EQUAL STRINGS OR AT LEAST ONE NULL ARG
> *
> LCMP1 BNE WB,WC,LCMP2 IF EQUAL, JUMP IF LENGTHS UNEQUAL
19239c17890,17897
< BNZ CNTTL,LIST5 JUMP IF -TITLE OR -STITL
---
> MOV STAGE,WA GET COMPILER STAGE
> BEQ WA,=STGIC,LIST0 LIST OK IF INITIAL COMPILE
> BEQ WA,=STGCE,LIST0 LIST OK IF END LINE
> BRN LIST4 ELSE NO LISTING OF SOURCE
> *
> * HERE WHEN STAGE IS OK TO LIST
> *
> LIST0 BNZ CNTTL,LIST5 JUMP IF -TITLE OR -STITL
19245c17903
< LIST0 MOV R$CIM,XR LOAD POINTER TO CURRENT IMAGE
---
> LIST1 MOV R$CIM,XR LOAD POINTER TO CURRENT IMAGE
19251d17908
< BNE STAGE,=STGIC,LIST1 SKIP IF EXECUTE TIME
19254,19257c17911
< *
< * PRINT STATEMENT NUMBER
< *
< LIST1 JSR PRTIN ELSE PRINT STATEMENT NUMBER
---
> JSR PRTIN ELSE PRINT STATEMENT NUMBER
19267c17921
< JSR PRTST PRINT IT
---
> JSR PRTSF PRINT IT
19269,19273c17923
< 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
---
> MNZ LSTPF SET FLAG FOR LINE PRINTED
19275,19278d17924
< * HERE AFTER PRINTING SOURCE IMAGE
< *
< LIST3 MNZ LSTPF SET FLAG FOR LINE PRINTED
< *
19290,19291c17936,17937
< BZE PRICH,LIST7 SKIP IF LISTING TO REGULAR PRINTER
< BEQ R$TTL,=NULLS,LIST0 TERMINAL LISTING OMITS NULL TITLE
---
> BNZ PRLEN,LIST7 SKIP IF LISTING TO REGULAR PRINTER
> BEQ R$TTL,=NULLS,LIST1 TERMINAL LISTING OMITS NULL TITLE
19296c17942
< BRN LIST0 MERGE
---
> BRN LIST1 MERGE
19316c17962
< JSR PRTNL TERMINATE TITLE LINE
---
> JSR PRTFH TERMINATE TITLE LINE
19323,19324c17969
< JSR PRTST ELSE PRINT SUB-TITLE
< JSR PRTNL TERMINATE LINE
---
> JSR PRTSF ELSE PRINT SUB-TITLE
19329c17974
< LSTT1 JSR PRTNL PRINT A BLANK LINE
---
> LSTT1 JSR PRTFH PRINT A BLANK LINE
19358c18003
< BZE CSWLS,NXTS2 JUMP IF -NOLIST
---
> BZE CSWLS,NXTS1 JUMP IF -NOLIST
19360c18005
< BZE XR,NXTS2 JUMP IF NO IMAGE
---
> BZE XR,NXTS1 JUMP IF NO IMAGE
19363,19364c18008,18009
< BNE WA,=CH$MN,NXTS1 JUMP IF NOT CTRL CARD
< BZE CSWPR,NXTS2 JUMP IF -NOPRINT
---
> BEQ WA,=CH$MN,NXTS1 SKIP LISTING IF CONTROL CARD
> JSR LISTR LIST LINE
19366,19369d18010
< * HERE TO CALL LISTER
< *
< NXTS1 JSR LISTR LIST LINE
< *
19372c18013
< NXTS2 MOV R$CNI,XR POINT TO NEXT IMAGE
---
> NXTS1 MOV R$CNI,XR POINT TO NEXT IMAGE
19377c18018
< BLO WA,WB,NXTS3 SKIP IF NOT TOO LONG
---
> BLO WA,WB,NXTS2 SKIP IF NOT TOO LONG
19382c18023
< NXTS3 MOV WA,SCNIL USE AS RECORD LENGTH
---
> NXTS2 MOV WA,SCNIL USE AS RECORD LENGTH
19505c18146
< WTB WA CONVERT TO BYTE OFFSET
---
> WTB WA CONVERT TO BAU OFFSET
19697d18337
< EJC
19699a18340
> EJC
19714,19716c18355
< JSR PRTST AND PRINT IT
< JSR PRTNL FOLLOWED BY NEWLINE
< JSR PRTNL AND ANOTHER
---
> JSR PRTFB AND PRINT IT
19718,19719c18357
< JSR PRTST PRINT IT
< JSR PRTNL NEW LINE
---
> JSR PRTSF PRINT IT
19721,19723c18359
< JSR PRTST PRINT IT
< JSR PRTNL NEW LINE
< JSR PRTNL AND ANOTHER BLANK LINE
---
> JSR PRTFB
19726c18362,18363
< ADD *NUM02,XR BIAS PAST XNBLK HEADER (SGD07)
---
> ADD *NUM02,XR BIASS PAST XNBLK HEADER
> EJC
19728c18365
< * LOOP HERE TO PRINT SUCCESSIVE ENTRIES
---
> * PRFLR (CONTINUED)
19729a18367,18368
> * LOOP FOR PRINTING TABLE ENTRIES
> *
19748c18387
< * MERGE AFTER PRINTING TIME
---
> * PRINT A BLANK
19750c18389
< PRFL2 JSR PRTNL THATS ANOTHER LINE
---
> PRFL2 JSR PRTFH THATS ANOTHER LINE
19752c18391
< * HERE TO GO TO NEXT ENTRY
---
> * TEST TO SEE IF LOOP FINISHED
19754c18393
< PRFL3 ADD *PF$I2,XR BUMP INDEX PTR (SGD07)
---
> PRFL3 ADD *PF$I2,XR BUMP INDEX POINTER
19759c18398
< * HERE TO EXIT
---
> * RETURN POINT
19775c18414
< MOV WA,PFSVW SAVE WA (SGD07)
---
> MOV WA,PFSVW SAVE WA
19786c18425
< SUB =NUM01,PFNTE ADJUST FOR EXTRA COUNT (SGD07)
---
> SUB =NUM01,PFNTE ADJUST FOR EXTRA COUNT
19804c18443,18444
< BCT WA,PFLU1 AND ALLLLLLL THE REST
---
> BCT WA,PFLU1 AND ALL THE REST
> EJC
19805a18446,18447
> * PRFLU (CONTINUED)
> *
19828c18470
< * MERGE HERE TO EXIT
---
> * RETURN POINT
19831c18473
< MOV PFSVW,WA RESTORE SAVED REG
---
> MOV PFSVW,WA RESTORE WA
19841d18482
< EJC
19842a18484
> EJC
19844c18486
< * PRPAR - PROCESS PRINT PARAMETERS
---
> * PRPAR -- PROCESS PRINT PARAMETERS
19846d18487
< * (WC) IF NONZERO ASSOCIATE TERMINAL ONLY
19848c18489
< * (XL,XR,WA,WB,WC) DESTROYED
---
> * (XR,WA,WB,WC) DESTROYED
19850,19853d18490
< * 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.
< *
19855c18492
< BNZ WC,PRPA7 JUMP TO ASSOCIATE TERMINAL
---
> MOV XL,-(XS) SAVE XL
19866,19868c18503,18504
< MOV PRLEN,WB GET PRIOR LENGTH IF ANY
< BZE WB,PRPA2 SKIP IF NO LENGTH
< BGT WA,WB,PRPA3 SKIP STORING IF TOO BIG
---
> BZE PRLEN,PRPA2 SKIP IF NOT SYSXI RESUMPTION
> BHI WA,PRLEN,PRPA3 SKIP IF BIGGER THAN PRIOR BFRS
19874c18510
< * PROCESS BITS OPTIONS
---
> * CHECK TERMINAL BUFFER SIZE
19876,19879c18512,18513
< PRPA3 MOV BITS3,WB BIT 3 MASK
< ANB WC,WB GET -NOLIST BIT
< ZRB WB,PRPA4 SKIP IF CLEAR
< ZER CSWLS SET -NOLIST
---
> PRPA3 BZE TTLEN,PRPA4 SKIP IF NOT SYSXI RESUMPTION
> BHI XL,TTLEN,PRPA5 SKIP IF TOO BIG
19881c18515
< * CHECK IF FAIL REPORTS GOTO INTERACTIVE CHANNEL
---
> * STORE TERMINAL BUFFER LENGTH
19883c18517,18521
< PRPA4 MOV BITS1,WB BIT 1 MASK
---
> PRPA4 MOV XL,TTLEN BFR LENGTH
> *
> * PROCESS BITS OPTIONS
> *
> PRPA5 MOV BITS1,WB BIT 1 MASK
19885c18523
< MOV WB,ERICH STORE INT. CHAN. ERROR FLAG
---
> MOV WB,TTINS INPUT FROM TERMINAL FLAG
19888,19894c18526,18533
< MOV WB,PRICH FLAG FOR STD PRINTER ON INT. CHAN.
< MOV BITS4,WB BIT 4 MASK
< ANB WC,WB GET BIT
< MOV WB,CPSTS FLAG FOR COMPILE STATS SUPPRESSN.
< MOV BITS5,WB BIT 5 MASK
< ANB WC,WB GET BIT
< MOV WB,EXSTS FLAG FOR EXEC STATS SUPPRESSION
---
> MOV WB,TTOUS STD OUTPUT TO TERMINAL FLAG
> MOV TTLEN,TTERL ERRORS TO TERML IF AVAILABLE
> MOV PRLEN,PRAVL NOTE IF A PRINT FILE IS AVAILABLE
> ZRB WB,PRPA6 IF FLAG SET, CLEAR TTERL SINCE ...
> ZER TTERL ... TERML GETS ALL OUTPUT ALREADY
> MOV TTLEN,TTOUS REGULAR O/P TO TERML IF AVAILABLE
> MOV TTLEN,PRLEN REVISED PRINT BUFFER LENGTH
> ZER TTLEN DONT NEED SEPARATE TERML BUFFER
19899,19904c18538
< MOV BITS6,WB BIT 6 MASK
< ANB WC,WB GET BIT
< MOV WB,PRECL EXTENDED/COMPACT LISTING FLAG
< SUB =NUM08,WA POINT 8 CHARS FROM LINE END
< ZRB WB,PRPA5 JUMP IF NOT EXTENDED
< MOV WA,LSTPO STORE FOR LISTING PAGE HEADINGS
---
> * GET OFFSET TO /PAGE NN/ PART OF HEADER
19906c18540,18543
< * CONTINUE OPTION PROCESSING
---
> PRPA6 MOV PRLEN,WA STD BFR LENGTH
> BNZ WA,PRPA7 USE IF NON-ZERO
> MOV TTLEN,WA ELSE TRY TERMINAL
> BZE WA,PRPA8 GIVE UP IF ZERO ALSO
19908,19920c18545
< PRPA5 MOV BITS7,WB BIT 7 MASK
< ANB WC,WB GET BIT 7
< MOV WB,CSWEX SET -NOEXECUTE IF NON-ZERO
< MOV BIT10,WB BIT 10 MASK
< ANB WC,WB GET BIT 10
< MOV WB,HEADP PRETEND PRINTED TO OMIT HEADERS
< MOV BITS9,WB BIT 9 MASK
< ANB WC,WB GET BIT 9
< MOV WB,PRSTO KEEP IT AS STD LISTING OPTION
< ZRB WB,PRPA6 SKIP IF CLEAR
< MOV PRLEN,WA GET PRINT BUFFER LENGTH
< SUB =NUM08,WA POINT 8 CHARS FROM LINE END
< MOV WA,LSTPO STORE PAGE OFFSET
---
> * GET OFFSET
19922c18547,18552
< * CHECK FOR TERMINAL
---
> PRPA7 MOV WA,PRLEN STORE AS BUFFER LENGTH
> SUB =NUM08,WA JUST BEFORE END OF LINE
> MOV WA,LSTPO KEEP IT
> MOV TTOUS,WB CONSTRUCT VALUE FOR ...
> ORB PRAVL,WB ... USE IN DECIDING WHETHER TO ...
> MOV WB,PRPUT ... PUT STRINGS IN OUTPUT BUFFER
19924,19932c18554
< PRPA6 ANB BITS8,WC SEE IF TERMINAL TO BE ACTIVATED
< BNZ WC,PRPA7 JUMP IF TERMINAL REQUIRED
< BZE INITR,PRPA8 JUMP IF NO TERMINAL TO DETACH
< MOV =V$TER,XL PTR TO /TERMINAL/
< JSR GTNVR GET VRBLK POINTER
< PPM CANT FAIL
< MOV =NULLS,VRVAL(XR) CLEAR VALUE OF TERMINAL
< JSR SETVR REMOVE ASSOCIATION
< BRN PRPA8 RETURN
---
> * MORE BITS
19934c18556,18559
< * ASSOCIATE TERMINAL
---
> PRPA8 MOV BITS3,WB BIT 3 MASK
> ANB WC,WB GET -NOLIST BIT
> ZRB WB,PRPA9 SKIP IF CLEAR
> ZER CSWLS SET -NOLIST
19936,19945c18561
< PRPA7 MNZ INITR NOTE TERMINAL ASSOCIATED
< BZE DNAMB,PRPA8 CANT IF MEMORY NOT ORGANISED
< MOV =V$TER,XL POINT TO TERMINAL STRING
< MOV =TRTOU,WB OUTPUT TRACE TYPE
< JSR INOUT ATTACH OUTPUT TRBLK TO VRBLK
< MOV XR,-(XS) STACK TRBLK PTR
< MOV =V$TER,XL POINT TO TERMINAL STRING
< MOV =TRTIN,WB INPUT TRACE TYPE
< JSR INOUT ATTACH INPUT TRACE BLK
< MOV (XS)+,VRVAL(XR) ADD OUTPUT TRBLK TO CHAIN
---
> * MORE BITS
19947c18563,18575
< * RETURN POINT
---
> PRPA9 MOV BITS4,WB BIT 4 MASK
> ANB WC,WB GET BIT
> MOV WB,CPSTS FLAG FOR COMPILE STATS SUPPRESSN.
> MOV BITS5,WB BIT 5 MASK
> ANB WC,WB GET BIT
> MOV WB,EXSTS FLAG FOR EXEC STATS SUPPRESSION
> MOV BITS6,WB BIT 6 MASK
> ANB WC,WB GET BIT
> MOV WB,NOXEQ SET NOEXECUTE IF NON-ZERO
> MOV BITS7,WB BIT 7 MASK
> ANB WC,WB GET BIT
> ZRB WB,PRP10 SKIP IF NOT SET
> ZER TTERL CLEAR ERRORS TO TERML IF SET
19949c18577,18589
< PRPA8 EXI RETURN
---
> * MORE BITS
> *
> PRP10 MOV BITS8,WB BIT 8 MASK
> ANB WC,WB GET BIT
> MOV WB,HEADN SYSID HEADERS INCLUDE/OMIT FLAG
> MOV BITS9,WB BIT 9 MASK
> ANB WC,WB GET BIT
> MOV WB,PRSTO STANDARD LISTING FLAG
> MOV BIT10,WB BIT 10 MASK
> ANB WC,WB GET BIT
> MOV WB,PRECL EXTENDED LISTING OPTION
> MOV (XS)+,XL RESTORE XL
> EXI RETURN
19953c18593
< * PRTCH -- PRINT A CHARACTER
---
> * PRTCF -- PRINT CHAR TO STD PRINTER AND FLUSH BFR
19954a18595,18605
> * (WA) CHAR TO PRINT
> * JSR PRTCF CALL TO PRINT AND FLUSH
> *
> PRTCF PRC E,0 ENTRY POINT
> JSR PRTCH PRINT CHARACTER
> JSR PRTFH FLUSH BUFFER
> EXI RETURN TO CALLER
> ENP END PROCEDURE PRTCF
> *
> * PRTCH -- PRINT A CHARACTER ON STANDARD PRINTER
> *
19960a18612
> BZE PRLEN,PTCH2 SKIP IF NO PRINT FILE
19962,19963c18614,18615
< BNE PROFS,PRLEN,PRCH1 JUMP IF ROOM IN BUFFER
< JSR PRTNL ELSE PRINT THIS LINE
---
> BNE PROFS,PRLEN,PTCH1 JUMP IF ROOM IN BUFFER
> JSR PRTFH ELSE PRINT THIS LINE
19967c18619
< PRCH1 MOV PRBUF,XR POINT TO PRINT BUFFER
---
> PTCH1 MOV PRBUF,XR POINT TO PRINT BUFFER
19973c18625,18628
< EXI RETURN TO PRTCH CALLER
---
> *
> * RETURN POINT
> *
> PTCH2 EXI RETURN TO PRTCH CALLER
19974a18630,18640
> *
> * PRTFB -- PRINT STRING, FLUSH BFR AND PRINT BLANK LINE
> *
> * (XR) STRING TO PRINT
> * JSR PRTFB CALL FOR PRINT FLUSH AND BLANK
> *
> PRTFB PRC E,0 ENTRY POINT
> JSR PRTSF PRINT AND FLUSH
> JSR PRTFH PRINT BLANK
> EXI RETURN TO CALLER
> ENP END PROCEDURE PRTFB
19977c18643
< * PRTIC -- PRINT TO INTERACTIVE CHANNEL
---
> * PRTFH -- FLUSH STANDARD PRINT BUFFER
19979,19982c18645,18649
< * 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.
---
> * PRTFH PRINTS THE CONTENTS OF THE PRINT BUFFER, RESETS
> * THE BUFFER TO ALL BLANKS AND RESETS THE PRINT POINTER.
> * ON ITS FIRST CALL IT MAY PRINT LISTING HEADERS.
> * IF TTLST IS NON-ZERO, IT COPIES PRINT BUFFER TO
> * TERMINAL AND FLUSHES THIS ALSO.
19984,19985c18651
< * JSR PRTIC CALL FOR PRINT
< * (WA,WB) DESTROYED
---
> * JSR PRTFH CALL TO FLUSH BUFFER
19987,19992c18653,18655
< PRTIC PRC E,0 ENTRY POINT
< MOV XR,-(XS) SAVE XR
< MOV PRBUF,XR POINT TO BUFFER
< MOV PROFS,WA NO OF CHARS
< JSR SYSPI PRINT
< PPM PRTC2 FAIL RETURN
---
> PRTFH PRC R,0 ENTRY POINT
> BNZ HEADP,PTFH1 WERE HEADERS PRINTED
> JSR PRTPS NO - PRINT THEM
19994c18657
< * RETURN
---
> * HEADERS DONE
19996,19997c18659,18668
< PRTC1 MOV (XS)+,XR RESTORE XR
< EXI RETURN
---
> PTFH1 BZE PRLEN,PTFH4 SKIP IF NO OUTPUT POSSIBLE
> MOV XL,-(XS) SAVE XL
> MOV XR,-(XS) SAVE XR
> MOV WA,-(XS) SAVE WA
> MOV WC,-(XS) SAVE WC
> MOV PRBUF,XR LOAD POINTER TO BUFFER
> MOV PROFS,WC LOAD NUMBER OF CHARS IN BUFFER
> BNZ PRAVL,PTFH5 SKIP IF PRINT FILE AVAILABLE
> BNZ TTOUS,PTFH2 SKIP IF STD OUTPUT TO TERML
> BZE TTLST,PTFH3 LAST POSSIBILITY IS ERROR TO TERML
19999c18670
< * ERROR OCCURED
---
> * SEND TO TERMINAL
20001,20004c18672,18674
< PRTC2 ZER ERICH PREVENT LOOPING
< ERB 252,ERROR ON PRINTING TO INTERACTIVE CHANNEL
< BRN PRTC1 RETURN
< ENP PROCEDURE PRTIC
---
> PTFH2 JSR SYSPI PRINT TO TERMINAL
> PPM PTFH6 FAIL
> PPM EROSI ERROR
20005a18676
> * PRTFH (CONTINUED)
20007c18678
< * PRTIS -- PRINT TO INTERACTIVE AND STANDARD PRINTER
---
> * BLANK BUFFER
20009,20013c18680,18688
< * 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.
---
> PTFH3 MOV PRBLK,XL POINT TO BLANKING STRING
> MOV PRCHS,XR POINT TO BUFFER
> MOV PRCMV,WA COUNT OF BAUS TO MOVE
> MVW MOVE BLANKS INTO BUFFER
> ZER PROFS RESET OFFSET
> MOV (XS)+,WC RESTORE WC
> MOV (XS)+,WA RECOVER WA
> MOV (XS)+,XR RESTORE XR
> MOV (XS)+,XL RESTORE XL
20015,20016c18690
< * JSR PRTIS CALL FOR PRINTING
< * (WA,WB) DESTROYED
---
> * RETURN POINT
20018,20021c18692
< 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
---
> PTFH4 EXI RETURN TO CALLER
20023c18694
< * MERGE AND EXIT
---
> * HERE FOR REGULAR PRINT FILE
20025,20027c18696,18710
< PRTS1 JSR PRTNL PRINT TO STANDARD PRINTER
< EXI RETURN
< ENP END PROCEDURE PRTIS
---
> PTFH5 JSR SYSPR CALL SYSTEM PRINT ROUTINE
> PPM PTFH6 JUMP IF FAILED
> PPM EROSI STOP IF ERROR
> BZE TTLST,PTFH3 SKIP IF NO COPY TO TERMINAL
> MOV PROFS,SCLEN(XR) SET STRING LENGTH FOR PTTST
> JSR PTTST COPY STD BUFFER TO TERML BFR
> JSR PTTFH FLUSH IT
> MOV PRLEN,SCLEN(XR) RESTORE BUFFER LENGTH
> BRN PTFH3 MERGE
> *
> * A FAILURE SUCH AS FILE OVERFILLED OCCURRED
> *
> PTFH6 BZE STAGX,PTFH3 IGNORE IF COMPILE TIME
> BRN EXFAL ELSE CAUSE STMT FAILURE
> ENP END PROCEDURE PRTFH
20057d18739
< EJC
20071c18753
< JSR PRTNL PRINT LINE
---
> JSR PRTFH PRINT LINE
20076,20140d18757
< * 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 XR,-(XS) SAVE ENTRY XR
< MOV WA,PRTSA SAVE WA
< MOV WB,PRTSB SAVE WB
< MOV PRBUF,XR LOAD POINTER TO BUFFER
< MOV PROFS,WA LOAD NUMBER OF CHARS IN BUFFER
< JSR SYSPR CALL SYSTEM PRINT ROUTINE
< PPM PRNL2 JUMP IF FAILED
< LCT WA,PRLNW LOAD LENGTH OF BUFFER IN WORDS
< ADD *SCHAR,XR POINT TO CHARS OF BUFFER
< MOV NULLW,WB GET WORD OF BLANKS
< *
< * LOOP TO BLANK BUFFER
< *
< PRNL1 MOV WB,(XR)+ STORE WORD OF BLANKS, BUMP PTR
< BCT WA,PRNL1 LOOP TILL ALL BLANKED
< *
< * EXIT POINT
< *
< MOV PRTSB,WB RESTORE WB
< MOV PRTSA,WA RESTORE WA
< MOV (XS)+,XR 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,WB ENDING CODE
< MOV KVSTN,WA STATEMENT NUMBER
< JSR SYSEJ STOP
< ENP END PROCEDURE PRTNL
< EJC
< *
20376,20377c18993
< JSR PRTVL PRINT VALUE
< JSR PRTNL TERMINATE LINE
---
> JSR PRTVF PRINT VALUE
20384c19000
< * PRTPG -- PRINT A PAGE THROW
---
> * PRTPG -- PRINT A PAGE THROW
20387c19003
< * LISTING CHANNEL DEPENDING ON THE LISTING OPTIONS CHOSEN.
---
> * LISTING FILE DEPENDING ON THE LISTING OPTIONS CHOSEN.
20392,20393c19008,19009
< BEQ STAGE,=STGXT,PRP01 JUMP IF EXECUTION TIME
< BZE LSTLC,PRP06 RETURN IF TOP OF PAGE ALREADY
---
> BNZ STAGX,PTPG1 SKIP IF EXECUTION TIME
> BZE LSTLC,PTPG6 RETURN IF TOP OF PAGE ALREADY
20398,20401c19014,19017
< PRP01 MOV XR,-(XS) PRESERVE XR
< BNZ PRSTD,PRP02 EJECT IF FLAG SET
< BNZ PRICH,PRP03 JUMP IF INTERACTIVE LISTING CHANNEL
< BZE PRECL,PRP03 JUMP IF COMPACT LISTING
---
> PTPG1 MOV XR,-(XS) PRESERVE XR
> BNZ PRECL,PTPG2 EJECT IF EXTENDED LISTING
> BZE PRSTD,PTPG3 SKIP IF COMPACT LISTING
> BNZ TTOUS,PTPG3 SKIP IF LISTING TO TERMINAL
20405,20406c19021,19024
< PRP02 JSR SYSEP EJECT
< BRN PRP04 MERGE
---
> PTPG2 JSR SYSEP EJECT
> PPM PTPG4 IGNORE FAILURE
> PPM EROSI ERROR
> BRN PTPG4 MERGE
20408,20409c19026
< * COMPACT OR INTERACTIVE CHANNEL LISTING. CANT PRINT
< * BLANKS UNTIL CHECK MADE FOR HEADERS PRINTED AND FLAG SET.
---
> * COMPACT LISTING.
20411,20416c19028,19033
< *
< PRP03 MOV HEADP,XR 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
---
> PTPG3 BNZ HEADN,PTPG4 SKIP IF HEADERS OMITTED
> MOV HEADP,XR REMEMBER HEADP
> MNZ HEADP SET TO AVOID RECURSIVE PRTPG CALLS
> JSR PRTFH PRINT BLANK LINE
> JSR PRTFH PRINT BLANK LINE
> JSR PRTFH PRINT BLANK LINE
20425c19042
< PRP04 BNZ HEADP,PRP05 JUMP IF HEADER LISTED
---
> PTPG4 BNZ HEADP,PTPG5 JUMP IF HEADER LISTED
20426a19044
> BNZ HEADN,PTPG5 SKIP IF HEADERS OMITTED
20431,20432c19049
< JSR PRTST APPEND EXTRA CHARS
< JSR PRTNL PRINT IT
---
> JSR PRTSF APPEND EXTRA CHARS AND PRINT
20434,20437c19051,19052
< JSR PRTST PLACE IT
< JSR PRTNL PRINT IT
< JSR PRTNL PRINT A BLANK
< JSR PRTNL AND ANOTHER
---
> JSR PRTFB PLACE IT AND A BLANK
> JSR PRTFH AND ANOTHER
20443c19058
< PRP05 MOV (XS)+,XR RESTORE XR
---
> PTPG5 MOV (XS)+,XR RESTORE XR
20447c19062
< PRP06 EXI RETURN
---
> PTPG6 EXI RETURN
20451c19066
< * PRTPS - PRINT PAGE WITH TEST FOR STANDARD LISTING OPTION
---
> * PRTPS -- PRINT PAGE WITH TEST FOR STANDARD LISTING OPTION
20463a19079,19089
> *
> * PRTSF -- PRINT STRING TO STD PRINTER AND FLUSH BFR
> *
> * (XR) STRING TO PRINT
> * JSR PRTSF CALL TO PRINT AND FLUSH
> *
> PRTSF PRC E,0 ENTRY POINT
> JSR PRTST PRINT STRING
> JSR PRTFH FLUSH BUFFER
> EXI RETURN TO CALLER
> ENP END PROCEDURE PRTSF
20512c19138
< * PRTST -- PRINT STRING
---
> * PRTST -- PRINT STRING TO STANDARD FILE
20514c19140
< * PRTST PLACES A STRING OF CHARACTERS IN THE PRINT BUFFER
---
> * PLACE A STRING OF CHARACTERS IN THE STANDARD PRINT BUFFER
20516,20517d19141
< * SEE PRTNL FOR GLOBAL LOCATIONS USED
< *
20519a19144,19147
> * IF GLOBAL TTOUS IS NON-ZERO, STRING IS SENT TO TERMINAL
> * INSTEAD OF STANDARD OUTPUT FILE.
> * IF GLOBAL TTLST IS NON-ZERO, STRING IS SENT TO
> * TERMINAL AS WELL AS STANDARD OUTPUT FILE
20526c19154
< BNZ HEADP,PRST0 WERE HEADERS PRINTED
---
> BNZ HEADP,PTST1 WERE HEADERS PRINTED
20529c19157
< * CALL SYSPR
---
> * HEADERS DEALT WITH
20531c19159,19165
< PRST0 MOV WA,PRSVA SAVE WA
---
> PTST1 BZE PRLEN,PTST7 SKIP IF NO O/P POSSIBLE
> BNZ PRPUT,PTST2 SKIP IF PUTTING IS OK
> BZE TTLST,PTST7 SKIP OUT IF NOT ERROR TO TERML
> *
> * KEEP REGISTERS
> *
> PTST2 MOV WA,PRSVA SAVE WA
20537c19171
< PRST1 MOV SCLEN(XR),WA LOAD STRING LENGTH
---
> PTST3 MOV SCLEN(XR),WA LOAD STRING LENGTH
20539c19173
< BZE WA,PRST4 JUMP TO EXIT IF NONE LEFT
---
> BZE WA,PTST6 JUMP TO EXIT IF NONE LEFT
20545,20546c19179,19180
< BNZ XR,PRST2 SKIP IF ROOM LEFT ON THIS LINE
< JSR PRTNL ELSE PRINT THIS LINE
---
> BNZ XR,PTST4 SKIP IF ROOM LEFT ON THIS LINE
> JSR PRTFH PRINT THIS LINE
20554c19188
< PRST2 BLO WA,XR,PRST3 JUMP IF ROOM FOR REST OF STRING
---
> PTST4 BLO WA,XR,PTST5 JUMP IF ROOM FOR REST OF STRING
20559c19193
< PRST3 MOV PRBUF,XR POINT TO PRINT BUFFER
---
> PTST5 MOV PRBUF,XR POINT TO PRINT BUFFER
20564d19197
< MOV WB,PRSVC PRESERVE CHAR COUNTER
20566d19198
< MOV PRSVC,WB RECOVER CHAR COUNTER
20569c19201
< BRN PRST1 LOOP BACK TO TEST FOR MORE
---
> BRN PTST3 LOOP BACK TO TEST FOR MORE
20573c19205
< PRST4 MOV PRSVB,WB RESTORE ENTRY WB
---
> PTST6 MOV PRSVB,WB RESTORE ENTRY WB
20575,20577d19206
< EXI RETURN TO PRTST CALLER
< ENP END PROCEDURE PRTST
< EJC
20579c19208
< * PRTTR -- PRINT TO TERMINAL
---
> * RETURN POINT
20581,20582c19210,19211
< * CALLED TO PRINT CONTENTS OF STANDARD PRINT BUFFER TO
< * ONLINE TERMINAL. CLEARS BUFFER DOWN AND RESETS PROFS.
---
> PTST7 EXI RETURN TO PRTST CALLER
> ENP END PROCEDURE PRTST
20584,20585c19213
< * JSR PRTTR CALL FOR PRINT
< * (WA,WB) DESTROYED
---
> * PRTVF -- PLACE A VALUE AND FLUSH STANDARD BUFFER
20587,20593c19215,19216
< PRTTR PRC E,0 ENTRY POINT
< MOV XR,-(XS) SAVE XR
< JSR PRTIC PRINT BUFFER CONTENTS
< MOV PRBUF,XR POINT TO PRINT BFR TO CLEAR IT
< LCT WA,PRLNW GET BUFFER LENGTH
< ADD *SCHAR,XR POINT PAST SCBLK HEADER
< MOV NULLW,WB GET BLANKS
---
> * (XR) VALUE TO PRINT
> * JSR PRTVF CALL TO PRINT AND FLUSH
20595,20602c19218,19222
< * LOOP TO CLEAR BUFFER
< *
< PRTT1 MOV WB,(XR)+ CLEAR A WORD
< BCT WA,PRTT1 LOOP
< ZER PROFS RESET PROFS
< MOV (XS)+,XR RESTORE XR
< EXI RETURN
< ENP END PROCEDURE PRTTR
---
> PRTVF PRC E,0 ENTRY POINT
> JSR PRTVL PLACE VALUE
> JSR PRTFH FLUSH BUFFER
> EXI RETURN TO CALLER
> ENP END PROCEDURE PRTVF
20676c19296
< * VCBLK, TBBLK, BCBLK MERGE HERE FOR ) BLANK NUMBER IDVAL
---
> * VCBLK, TBBLK MERGE HERE FOR ) BLANK NUMBER IDVAL
20814a19435,19536
> EJC
> *
> * PTTFH -- FLUSH TERMINAL BUFFER
> *
> * PRINTS THE CONTENTS OF THE TTY BUFFER, RESETS
> * THE BUFFER TO ALL BLANKS AND RESETS THE POINTER.
> *
> * JSR PTTFH CALL TO FLUSH BUFFER
> *
> PTTFH PRC E,0 ENTRY POINT
> BZE TTLEN,PTTF2 SKIP IF NO TERMINAL
> MOV XL,-(XS) SAVE XL
> MOV XR,-(XS) SAVE XR
> MOV WA,-(XS) SAVE WA
> MOV WC,-(XS) SAVE WC
> MOV TTBUF,XR LOAD POINTER TO BUFFER
> MOV TTOFS,WC LOAD NUMBER OF CHARS IN BUFFER
> JSR SYSPI CALL SYSTEM PRINT ROUTINE
> PPM PTTF3 JUMP IF FAILED
> PPM EROSI STOP IF ERROR
> *
> * BLANK BUFFER
> *
> PTTF1 MOV TTBLK,XL POINT TO BLANKING STRING
> MOV TTCHS,XR POINT TO BUFFER
> MOV TTCMV,WA COUNT OF BAUS TO MOVE
> MVW MOVE BLANKS INTO BUFFER
> ZER TTOFS RESET OFFSET
> MOV (XS)+,WC RESTORE WC
> MOV (XS)+,WA RECOVER WA
> MOV (XS)+,XR RESTORE XR
> MOV (XS)+,XL RESTORE XL
> *
> * RETURN POINT
> *
> PTTF2 EXI RETURN TO CALLER
> *
> * A FAILURE SUCH AS FILE OVERFILLED OCCURRED
> *
> PTTF3 BZE STAGX,PTTF1 IGNORE IF COMPILE TIME
> BRN EXFAL ELSE CAUSE STMT FAILURE
> ENP END PROCEDURE
> EJC
> *
> * PTTST -- PRINT STRING TO TERMINAL
> *
> * PLACE A STRING OF CHARACTERS IN THE TERMINAL BUFFER
> *
> * 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 PTTST CALL TO PRINT STRING
> * (TTOFS) UPDATED PAST CHARS PLACED
> *
> PTTST PRC E,0 ENTRY POINT
> BZE TTLEN,PTTS5 SKIP IF NO TERMINAL
> MOV WA,PRTVA SAVE WA
> MOV WB,PRTVB SAVE WB
> ZER WB SET CHARS PRINTED COUNT TO ZERO
> *
> * LOOP TO PRINT SUCCESSIVE LINES FOR LONG STRING
> *
> PTTS1 MOV SCLEN(XR),WA LOAD STRING LENGTH
> SUB WB,WA SUBTRACT COUNT OF CHARS ALREADY OUT
> BZE WA,PTTS4 JUMP TO EXIT IF NONE LEFT
> MOV XL,-(XS) ELSE STACK ENTRY XL
> MOV XR,-(XS) SAVE ARGUMENT
> MOV XR,XL COPY FOR EVENTUAL MOVE
> MOV TTLEN,XR LOAD BUFFER LENGTH
> SUB TTOFS,XR GET CHARS LEFT IN BUFFER
> BNZ XR,PTTS2 SKIP IF ROOM LEFT ON THIS LINE
> JSR PTTFH ELSE PRINT THIS LINE
> MOV TTLEN,XR AND SET FULL WIDTH AVAILABLE
> *
> * HERE WITH CHARS TO PRINT AND SOME ROOM IN BUFFER
> *
> PTTS2 BLO WA,XR,PTTS3 JUMP IF ROOM FOR REST OF STRING
> MOV XR,WA ELSE SET TO FILL LINE
> *
> * MERGE HERE WITH CHARACTER COUNT IN WA
> *
> PTTS3 MOV TTBUF,XR POINT TO PRINT BUFFER
> PLC XL,WB POINT TO LOCATION IN STRING
> PSC XR,TTOFS POINT TO LOCATION IN BUFFER
> ADD WA,WB BUMP STRING CHARS COUNT
> ADD WA,TTOFS BUMP BUFFER POINTER
> MVC MOVE CHARACTERS TO BUFFER
> MOV (XS)+,XR RESTORE ARGUMENT POINTER
> MOV (XS)+,XL RESTORE ENTRY XL
> BRN PTTS1 LOOP BACK TO TEST FOR MORE
> EJC
> *
> * HERE TO EXIT AFTER PRINTING STRING
> *
> PTTS4 MOV PRTVB,WB RESTORE ENTRY WB
> MOV PRTVA,WA RESTORE ENTRY WA
> *
> * RETURN POINT
> *
> PTTS5 EXI RETURN TO PTTST CALLER
> ENP END PROCEDURE PTTST
20851a19574,19578
> * THE GLOBAL FLAG RDRER IS SET JUST BEFORE THE READ, AND
> * CLEARED AFTER IT. THIS IS SO THAT IN THE EVENT SYSRD
> * OR SYSRI TAKE AN EROSI EXIT, THE ERROR APPENDAGE CAN
> * RECOGNIZE THE SITUATION AND TAKE APPROPRIATE ACTION.
> *
20859,20861c19586,19596
< BNZ XR,READ3 EXIT IF ALREADY READ
< BNE STAGE,=STGIC,READ3 EXIT IF NOT INITIAL COMPILE
< MOV CSWIN,WA MAX READ LENGTH
---
> BNZ XR,READ5 EXIT IF ALREADY READ
> *
> * MERGE FROM -COPY EOF TO TRY READ
> *
> READ0 BEQ STAGE,=STGIC,READ1 READ IF INITIAL COMPILE
> BZE R$COP,READ6 ELSE EXIT IF NO -COPY IN FORCE
> *
> * ATTEMPT READ
> *
> READ1 MOV CSWIN,WA MAX READ LENGTH
> MNZ RDRER NOTE IN-READR IN CASE EROSI
20863,20864c19598,19612
< JSR SYSRD READ INPUT IMAGE
< PPM READ4 JUMP IF END OF FILE
---
> BZE TTINS,READ2 SKIP IF STANDARD INPUT FILE
> JSR SYSRI READ FROM TERMINAL
> PPM READ7 FAIL
> PPM EROSI ERROR
> BRN READ3 MERGE
> *
> * READ FROM STANDARD FILE
> *
> READ2 JSR SYSRD READ INPUT IMAGE
> PPM READ7 JUMP IF END OF FILE
> PPM EROSI ERROR RETURN
> *
> * MERGE
> *
> READ3 ZER RDRER NOTE NOT-IN-READR FOR ERROR RTN
20866c19614
< BLE SCLEN(XR),CSWIN,READ1 USE SMALLER OF STRING LNTH ..
---
> BLE SCLEN(XR),CSWIN,READ4 USE SMALLER OF STRING LNTH..
20871c19619
< READ1 JSR TRIMR TRIM TRAILING BLANKS
---
> READ4 JSR TRIMR TRIM TRAILING BLANKS
20875c19623
< READ2 MOV XR,R$CNI STORE COPY OF POINTER
---
> READ5 MOV XR,R$CNI STORE COPY OF POINTER
20879c19627
< READ3 EXI RETURN TO READR CALLER
---
> READ6 EXI RETURN TO READR CALLER
20883c19631,19632
< READ4 MOV XR,DNAMP POP UNUSED SCBLK
---
> READ7 ZER RDRER NOTE NOT-IN-READR FOR ERR
> MOV XR,DNAMP POP UNUSED SCBLK
20885c19634,19636
< BRN READ2 MERGE
---
> BZE R$COP,READ5 SKIP IF NO -COPY IN FORCE
> JSR COPND CALL TO END THIS -COPY (EOF)
> BRN READ0 TRY AGAIN
20886a19638
> .IF .CASL
20888a19641,19724
> * SBSCC -- BUILD SUBSTRING WITH CASE CONVERSION
> *
> * (XL) PTR TO SCBLK CONTAINING CHARS
> * (WA) CHAR COUNT
> * (WB) OFFSET TO FIRST CHAR IN SCBLK
> * JSR SBSCC CALL TO BUILD SUBSTRING
> * (XR) PTR TO NEW SCBLK WITH SUBSTRING
> * (WA,WB,WC,XL,IA) DESTROYED
> *
> * IF OPTION .CPLC IS SELECTED (PREFER LOWER CASE), TARGET
> * CASE IS LOWER CASE, OTHERWISE IT IS UPPER CASE.
> *
> SBSCC PRC E,0 ENTRY POINT
> BZE WA,SBSC4 JUMP IF NULL SUBSTRING
> JSR ALOCS ELSE ALLOCATE SCBLK
> MOV WC,WA MOVE NUMBER OF CHARACTERS
> MOV XR,WC SAVE PTR TO NEW SCBLK
> PLC XL,WB PREPARE TO LOAD CHARS FROM OLD BLK
> PSC XR PREPARE TO STORE CHARS IN NEW BLK
> LCT WA,WA TO COUNT ROUND LOOP
> *
> * LOOP TO COPY AND TRANSLATE CHARS
> *
> SBSC1 LCH WB,(XL)+ GET CHAR
> .IF .CPLC
> BGT WB,=CH$L$,SBSC2 SKIP IF NOT UC LETTER
> BLT WB,=CH$LA,SBSC2 SKIP IF NOT UC LETTER
> .IF .CSCV
> CUL WB CONVERT FROM UC TO LC
> .ELSE
> ADD =DFA$A,WB CONVERT FROM UC TO LC
> .FI
> .ELSE
> BGT WB,=CH$$$,SBSC2 SKIP IF NOT A LC LETTER
> BLT WB,=CH$$A,SBSC2 SKIP IF NOT A LC LETTER
> .IF .CSCV
> CLU WB CONVERT FROM LC TO UC
> .ELSE
> SUB =DFA$A,WB CONVERT FROM LC TO UC
> .FI
> .FI
> *
> * STORE CHAR IN NEW SUBSTRING
> *
> SBSC2 SCH WB,(XR)+ STORE CHAR
> BCT WA,SBSC1 LOOP
> MOV WC,XR RESTORE SCBLK POINTER
> *
> * RETURN POINT
> *
> SBSC3 ZER XL CLEAR GARBAGE POINTER IN XL
> EXI RETURN TO SBSCC CALLER
> *
> * HERE FOR NULL SUBSTRING
> *
> SBSC4 MOV =NULLS,XR SET NULL STRING AS RESULT
> BRN SBSC3 RETURN
> ENP END PROCEDURE SBSCC
> EJC
> *
> * SBSTG -- BUILD SUBSTRING POSSIBLY CONVERTING CASE
> *
> * (XL) PTR TO SCBLK CONTAINING CHARS
> * (WA) CHAR COUNT
> * (WB) OFFSET TO FIRST CHAR IN SCBLK
> * JSR SBSTG CALL TO BUILD SUBSTRING
> * (XR) PTR TO NEW SCBLK WITH SUBSTRING
> * (WA,WB,WC,XL,IA) DESTROYED
> *
> * IF CASE IS TO BE IGNORED (-CASEIG OR .CSIG), SUBSTRING
> * IS CONVERTED TO PREFERRED CASE (DEFAULT UPPER),
> * OTHERWISE CASE IS LEFT ALONE.
> *
> SBSTG PRC E,0 ENTRY POINT
> BZE CSWCI,SBSG1 SKIP IF CASE NOT IGNORED
> JSR SBSCC CONVERT TO IGNORE CASE
> EXI RETURN TO CALLER
> *
> SBSG1 JSR SBSTR READ SUBSTRING IN MIXED CASE
> EXI RETURN TO CALLER
> ENP END PROCEDURE SBSTG
> .FI
> EJC
> *
20891c19727
< * (XL) PTR TO SCBLK/BFBLK WITH CHARS
---
> * (XL) PTR TO SCBLK CONTAINING CHARS
20896d19731
< * (XL) ZERO
21086,21087c19921
< .IF .CUCF
< BLO =CFP$U,XR,SCN07 QUICK CHECK FOR OTHER CHAR
---
> BGE XR,=CFP$U,SCN07 QUICK CHECK FOR OTHER CHAR
21089,21091d19922
< .ELSE
< BSW XR,CFP$A,SCN07 SWITCH ON SCANNED CHARACTER
< .FI
21187,21190c20018,20021
< IFF CH$PL,SCN33 PLUS
< IFF CH$MN,SCN34 MINUS
< IFF CH$NT,SCN35 NOT
< IFF CH$DL,SCN36 DOLLAR
---
> IFF CH$PL,SCN34 PLUS
> IFF CH$MN,SCN35 MINUS
> IFF CH$NT,SCN36 NOT
> IFF CH$DL,SCN33 DOLLAR
21206c20037
< ERB 230,SYNTAX ERROR. ILLEGAL CHARACTER
---
> ERB 232,SYNTAX ERROR. ILLEGAL CHARACTER
21260c20091
< SCN14 ERB 231,SYNTAX ERROR. INVALID NUMERIC ITEM
---
> SCN14 ERB 233,SYNTAX ERROR. INVALID NUMERIC ITEM
21263a20095,20097
> .IF .CASL
> SCN15 JSR SBSTG BUILD STRING NAME OF VARIABLE
> .ELSE
21264a20099
> .FI
21305c20140
< ERB 232,SYNTAX ERROR. UNMATCHED STRING QUOTE
---
> ERB 234,SYNTAX ERROR. UNMATCHED STRING QUOTE
21381,21382c20216,20217
< * THE FIRST THREE ENTRIES ARE SPECIAL SINCE THEY CAN OCCUR
< * AS PART OF A VARIABLE NAME (.) OR CONSTANT (.+-).
---
> * THE FIRST FOUR ENTRIES ARE SPECIAL SINCE THEY CAN OCCUR
> * AS PART OF A VARIABLE NAME (.$) OR CONSTANT (.+-).
21387c20222,20225
< SCN33 BZE WC,SCN09 PLUS CAN BE PART OF CONSTANT
---
> SCN33 BZE WB,SCN09 DOLLAR CAN BE PART OF NAME
> ADD WB,WC ELSE BUMP POINTER
> *
> SCN34 BZE WC,SCN09 PLUS CAN BE PART OF CONSTANT
21391c20229
< SCN34 BZE WC,SCN09 MINUS CAN BE PART OF CONSTANT
---
> SCN35 BZE WC,SCN09 MINUS CAN BE PART OF CONSTANT
21393a20232,20234
> LCH XR,(XL) GET NEXT CHARACTER
> BLT XR,=CH$D0,SCN36 SKIP IF NOT DIGIT
> BLE XR,=CH$D9,SCN08 JUMP IF DIGIT
21395,21396c20236
< SCN35 ADD WB,WC NOT
< SCN36 ADD WB,WC DOLLAR
---
> SCN36 ADD WB,WC NOT
21405a20246
> EJC
21406a20248,20249
> * SCANE (CONTINUED)
> *
21439c20282
< SCN48 ERB 233,SYNTAX ERROR. INVALID USE OF OPERATOR
---
> SCN48 ERB 235,SYNTAX ERROR. INVALID USE OF OPERATOR
21494c20337
< ERB 234,SYNTAX ERROR. GOTO FIELD INCORRECT
---
> ERB 236,SYNTAX ERROR. GOTO FIELD INCORRECT
21500,21501c20343,20344
< MOV =OPDVN,WA POINT TO OPDV FOR COMPLEX GOTO
< BLE XR,STATB,SCNG3 JUMP IF NOT IN STATIC (SGD15)
---
> MOV =OPDVN,WA ELSE POINT TO OPDV FOR COMPLEX GOTO
> BLE XR,STATB,SCNG3 JUMP IF NOT IN STATIC
21503c20346
< BRN SCNG3 COMPLEX GOTO - MERGE
---
> BRN SCNG3 AND MERGE
21571c20414
< * THE SORT USED IS HEAPSORT, FUNDAMENTALS OF DATA STRUCTURE
---
> * THE SORT USED IS HEAPSORT, FUNDAMENTALS OF DATA STRUCTURES,
21576c20419
< * SORT ARRAY) CONTAINING AT ITS HIGH ADDRESS END, BYTE
---
> * SORT ARRAY) CONTAINING AT ITS HIGH ADDRESS END, BAU
21588a20432,20433
> * GIVES ERROR MESSAGES FOR INCORRECT ARGS, RETURNS EXI 1
> * FOR EMPTY TABLE.
21593a20439
> * PPM LOC FAIL RETURN FOR EMPTY TABLE
21600c20446
< SORTA PRC N,0 ENTRY POINT
---
> SORTA PRC N,1 ENTRY POINT
21606a20453,20455
> MOV (XR),WA GET ARG TYPE
> BEQ WA,=B$ART,SRT00 SKIP IF ARRAY
> BNE WA,=B$TBT,SRT16 ERROR IF NOT TABLE
21608,21611c20457,20463
< PPM SRT16 FAIL
< MOV XR,-(XS) STACK PTR TO RESULTING KEY ARRAY
< MOV XR,-(XS) ANOTHER COPY FOR COPYB
< JSR COPYB GET COPY ARRAY FOR SORTING INTO
---
> PPM SRT18 FAIL
> *
> * MAKE COPY OF ARRAY
> *
> SRT00 MOV XR,-(XS) STACK PTR TO RESULTING KEY ARRAY
> MOV XR,-(XS) ANOTHER COPY FOR CBLCK
> JSR CBLCK GET COPY ARRAY FOR SORTING INTO
21619c20471
< ERR 257,ERRONEOUS 2ND ARG IN SORT/RSORT OF VECTOR
---
> ERR 237,ERRONEOUS 2ND ARG IN SORT/RSORT OF VECTOR
21627c20479
< SUB *VCSI$,WA GET NO. OF ENTRIES, N (IN BYTES)
---
> SUB *VCSI$,WA GET NO. OF ENTRIES, N (IN BAUS)
21635c20487
< MOV *ARVLS,WB OFFSET TO FIRST VALUE IF ONE
---
> MOV *ARVLS,WB OFFSET TO FIRST VALUE IF ONE DIM.
21637,21639c20489,20491
< BEQ ARNDM(XL),=NUM01,SRT04 JUMP IN FACT IF ONE DIM.
< BNE ARNDM(XL),=NUM02,SRT16 FAIL UNLESS TWO DIMENS
< LDI ARLB2(XL) GET LOWER BOUND 2 AS DEFAULT
---
> BEQ ARNDM(XL),=NUM01,SRT04 JUMP IF IN FACT ONE DIMENSION
> BNE ARNDM(XL),=NUM02,SRT16 FAIL UNLESS TWO DIMENSIONAL
> LDI ARLB2(XL) GET LOWER BOUND 2 AS DEFAULT COLUMN
21662c20514
< WTB WA CONVERT TO BYTES
---
> WTB WA CONVERT TO BAUS
21679c20531
< * WA = NUMBER OF ITEMS, N (CONVERTED TO BYTES).
---
> * WA = NUMBER OF ITEMS, N (CONVERTED TO BAUS).
21714c20566
< BTW WC CONVERT FROM BYTES
---
> BTW WC CONVERT FROM BAUS
21726c20578
< * (SRTSN) NUMBER OF ITEMS TO SORT, N (BYTES)
---
> * (SRTSN) NUMBER OF ITEMS TO SORT, N (BAUS)
21732c20584
< WTB WC CONVERT BACK TO BYTES
---
> WTB WC CONVERT BACK TO BAUS
21742c20594
< * ITEM, SINCE ALGORITHM INITIALISES IT AS, AND THEN MAINTAI
---
> * ITEM, SINCE ALGORITHM INITIALISES IT AS, AND THEN MAINTAINS
21799,21800c20651,20656
< 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
---
> SRT16 ERB 238,SORT/RSORT 1ST ARG NOT SUITABLE ARRAY OR TABLE
> SRT17 ERB 239,SORT/RSORT 2ND ARG OUT OF RANGE OR NON-INTEGER
> *
> * SOFT FAIL RETURN
> *
> SRT18 EXI 1 RETURN
21964c20820
< WTB WC CONVERT TO BYTES
---
> WTB WC CONVERT TO BAUS
21993c20849
< * (WA) MAX ARRAY INDEX, N (IN BYTES)
---
> * (WA) MAX ARRAY INDEX, N (IN BAUS)
22045c20901
< WTB WC CONVERT BACK TO BYTES
---
> WTB WC CONVERT BACK TO BAUS
22057c20913
< WTB WC CONVERT BACK TO BYTES
---
> WTB WC CONVERT BACK TO BAUS
22123a20980,20982
> * POSSIBILITY OF OVERFLOW EXIST ON TWOS COMPLEMENT
> * MACHINE IF HASH SOURCE IS MOST NEGATIVE INTEGER OR IS
> * A REAL HAVING THE SAME BIT PATTERN.
22149c21008
< WTB WC CONVERT TO BYTE OFFSET
---
> WTB WC CONVERT TO BAU OFFSET
22202a21062
> MOV XR,WB COPY DEFAULT VALUE
22211c21071
< MOV =NULLS,TEVAL(XR) SET NULL AS INITIAL VALUE
---
> MOV WB,TEVAL(XR) SET DEFAULT AS INITIAL VALUE
22214c21074
< ICA XS POP PAST NAME/VALUE INDICATOR
---
> MOV (XS)+,WB RESTORE NAME/VALUE INDICATOR
22235a21096
> * PPM LOC FAIL STOPTR IF NON-EXISTENT TRACE
22239c21100
< TRACE PRC N,2 ENTRY POINT
---
> TRACE PRC N,3 ENTRY POINT
22244,22246c21105,21112
< .IF .CULC
< FLC WA FOLD TO UPPER CASE
< .FI
---
> .IF .CASL
> BLT WA,=CH$$A,TRC00 SKIP IF NOT LOWER CASE
> SUB =DFA$A,WA CONVERT LOWER TO UPPER CASE
> *
> * HERE WITH UPPER CASE TRACE TYPE CODE
> *
> TRC00 MOV (XS),XR LOAD NAME ARGUMENT
> .ELSE
22247a21114
> .FI
22253,22255d21119
< .IF .CULC
< BZE WA,TRC10 JUMP IF BLANK (VALUE)
< .ELSE
22257d21120
< .FI
22273a21137
> MOV XL,WB COPY TRBLK PTR OR 0
22280a21145
> ORB PFCTR(XR),WB STOPTR FAIL CHECK
22282c21147
< BEQ WA,=CH$LC,EXNUL EXIT WITH NULL IF C (CALL)
---
> BEQ WA,=CH$LC,TRC11 RETURN IF LETTER C
22286,22287c21151,21153
< TRC02 MOV XL,PFRTR(XR) SET/RESET RETURN TRACE
< EXI RETURN
---
> TRC02 ORB PFRTR(XR),WB STOPTR FAIL CHECK
> MOV XL,PFRTR(XR) SET/RESET RETURN TRACE
> BRN TRC11 RETURN
22292a21159
> MOV (XS)+,WB GET TRBLK OR ZERO
22295a21163
> BRN TRCA4 MERGE
22299,22300c21167,21171
< TRC04 BEQ XL,=STNDL,TRC16 ERROR IF UNDEFINED LABEL
< MOV (XS)+,WB GET TRBLK PTR AGAIN
---
> TRC04 BZE WB,TRC12 FAIL IF STOPTR OF UNTRACED LABEL
> *
> * TEST FOR UNDEFINED LABEL
> *
> TRCA4 BEQ XL,=STNDL,TRC17 ERROR IF UNDEFINED LABEL
22326c21197
< * MERGE HERE WITH TRBLK SET UP IN WB (OR ZERO)
---
> * MERGE HERE WITH TRBLK SET UP IN XL (OR ZERO)
22328a21200
> MOV XL,WB COPY TRBLK PR OR 0
22334a21207
> ORB R$FNC,WB STOPTR FAIL CHECK
22336c21209
< EXI RETURN
---
> BRN TRC11 RETURN
22340,22341c21213,21215
< TRC08 MOV XL,R$ERT SET/RESET ERRTYPE TRACE
< EXI RETURN
---
> TRC08 ORB R$ERT,WB STOPTR FAIL CHECK
> MOV XL,R$ERT SET/RESET ERRTYPE TRACE
> BRN TRC11 RETURN
22345,22346c21219,21221
< TRC09 MOV XL,R$STC SET/RESET STCOUNT TRACE
< EXI RETURN
---
> TRC09 ORB R$STC,WB STOPTR FAIL CHECK
> MOV XL,R$STC SET/RESET STCOUNT TRACE
> BRN TRC11 RETURN
22355,22357c21230,21234
< MOV (XS)+,WB GET NEW TRBLK PTR AGAIN
< ADD XL,WA POINT TO VARIABLE LOCATION
< MOV WA,XR COPY VARIABLE POINTER
---
> MOV (XS)+,XR GET NEW TRBLK PTR AGAIN
> MOV WC,WB COPY TRACE TYPE
> JSR TRCHN UPDATE TRACE CHAIN
> PPM TRC12 FAIL
> EXI RETURN
22359c21236
< * LOOP TO SEARCH TRBLK CHAIN
---
> * RETURN AFTER CHECKING STOPTR FAIL CONDITION (WB = 0)
22361,22367c21238,21239
< TRC11 MOV (XR),XL POINT TO NEXT ENTRY
< BNE (XL),=B$TRT,TRC13 JUMP IF NOT TRBLK
< BLT WC,TRTYP(XL),TRC13 JUMP IF TOO FAR OUT ON CHAIN
< BEQ WC,TRTYP(XL),TRC12 JUMP IF THIS MATCHES OUR TYPE
< ADD *TRNXT,XL ELSE POINT TO LINK FIELD
< MOV XL,XR COPY POINTER
< BRN TRC11 AND LOOP BACK
---
> TRC11 ZRB WB,TRC12 FAIL IF NECESSARY
> EXI ELSE RETURN
22369c21241
< * HERE TO DELETE AN OLD TRBLK OF THE TYPE WE WERE GIVEN
---
> * FAIL STOPTR
22371,22372c21243
< TRC12 MOV TRNXT(XL),XL GET PTR TO NEXT BLOCK OR VALUE
< MOV XL,(XR) STORE TO DELETE THIS TRBLK
---
> TRC12 EXI 3 FAIL RETURN
22374,22388d21244
< * HERE AFTER DELETING ANY OLD ASSOCIATION OF THIS TYPE
< *
< TRC13 BZE WB,TRC14 JUMP IF STOPTR CASE
< MOV WB,(XR) ELSE LINK NEW TRBLK IN
< MOV WB,XR COPY TRBLK POINTER
< MOV XL,TRNXT(XR) STORE FORWARD POINTER
< MOV WC,TRTYP(XR) STORE APPROPRIATE TRAP TYPE CODE
< *
< * HERE TO MAKE SURE VRGET,VRSTO ARE SET PROPERLY
< *
< TRC14 MOV WA,XR RECALL POSSIBLE VRBLK POINTER
< SUB *VRVAL,XR POINT BACK TO VRBLK
< JSR SETVR SET FIELDS IF VRBLK
< EXI RETURN
< *
22409c21265
< * (XL) TRFNC OR TRFPT
---
> * (XL) TRFNC OR TRTRI
22420,22421c21276,21277
< MOV XL,TRFNC(XR) STORE TRFNC (OR TRFPT)
< MOV (XS)+,TRTAG(XR) STORE TRTAG (OR TRFNM)
---
> MOV XL,TRFNC(XR) STORE TRFNC (OR TRTRI)
> MOV (XS)+,TRTAG(XR) STORE TRTAG (OR TRTER)
22427a21284,21340
> * TRCHN -- UPDATE TRACE BLOCK CHAIN
> *
> * CALLED WHEN A TRACE BLOCK CHAIN IS TO BE UPDATED BY
> * ADDITION OR REMOVAL OF A TRBLK.
> * IF A TRBLK OF THE SAME TYPE AS AN ADDITION IS ALREADY
> * PRESENT IT IS DELETED. THE TRTAG FIELD OF ANY DELETED
> * TRBLK IS CLEARED AS REQUIRED BY S$ENF.
> *
> * (XL,WA) POINTER, OFFSET TO TRACED VARIABLE
> * (XR) PTR TO NEW TRBLK OR 0 FOR REMOVAL
> * (WB) TRACE TYPE (TRTYP)
> * JSR TRCHN CALL TO UPDATE TRACE CHAIN
> * PPM LOC NO TRACE BLK OF REQD DELETION TYPE
> * (WA,WC) DESTROYED
> *
> TRCHN PRC E,1 ENTRY POINT
> ADD XL,WA KEEP POINTER TO TRACED LOCATION
> MOV WA,XL COPY POINTER
> SUB *TRNXT,XL ADJUST OFFSET BEFORE ENTERING LOOP
> MOV XR,WC COPY TRBLK PTR
> *
> * LOOP TO FIND TRACE BLOCK
> *
> TRCH1 MOV XL,XR COPY SO XR POINTS TO PREDECESSOR
> MOV TRNXT(XL),XL POINT TO POSSIBLE TRACE BLOCK
> BNE (XL),=B$TRT,TRCH2 SKIP OUT AT CHAIN END
> BLT WB,TRTYP(XL),TRCH2 SKIP IF TOO FAR OUT ON CHAIN
> BNE WB,TRTYP(XL),TRCH1 LOOP UNLESS TYPE MATCHES
> MOV TRNXT(XL),TRNXT(XR) REMOVE LINK TO OLD TRBLK
> ZER TRTAG(XL) CLEAR IOTAG FIELD OF DELETED BLOCK
> BZE WC,TRCH3 DONE IF NO NEW TRBLK
> *
> * OLD TRBLK REMOVED AND/OR END OF CHAIN REACHED
> *
> TRCH2 BZE WC,TRCH4 FAIL IF REQD BLOCK TYPE NOT FOUND
> MOV WC,XL POINT TO NEW TRBLK
> MOV TRNXT(XR),TRNXT(XL) ATTACH TAIL OF CHAIN TO IT
> MOV WC,TRNXT(XR) LINK NEW BLOCK IN
> MOV WB,TRTYP(XL) ENSURE TRTYP FIELD SET UP
> *
> * UPDATE ACCESS FIELDS OF NAME IF IT IS A VRBLK
> *
> TRCH3 MOV WA,XR POINT TO VBL
> SUB *VRVAL,XR ADJUST TO POSSIBLE VRBLK NAME BASE
> JSR SETVR UPDATE ACCESS FIELDS
> MOV WA,XL RECOVER XL
> MOV WC,XR RECOVER XR
> EXI RETURN TO CALLER
> *
> * FAIL RETURN
> *
> TRCH4 MOV WA,XL RECOVER XL
> MOV WC,XR RECOVER XR
> EXI 1 FAIL
> ENP END PROCEDURE TRCHN
> EJC
> *
22475,22476c21388,21389
< PSC XL,WA READY FOR STORING BLANKS
< CTB WA,SCHAR GET LENGTH OF BLOCK IN BYTES
---
> PSC XL,WA READY FOR STORING ZEROES
> CTB WA,SCHAR GET LENGTH OF BLOCK IN BAUS
22480c21393
< ZER WC SET BLANK CHAR
---
> ZER WC SET ZERO CHAR
22562c21475
< TRXQ1 MOV FLPTR,XS POINT BACK TO OUR STACK ENTRIES
---
> TRXQR MOV FLPTR,XS POINT BACK TO OUR STACK ENTRIES
22595a21509
> * (XSCNB) ERROR INDICATOR - SEE 4) BELOW
22596a21511,21513
> * LEADING BLANKS AND TRAILING BLANKS POSITIONED BEFORE A
> * DELIMITER OR AT THE END OF THE ARGUMENT STRING ARE
> * IGNORED. OTHER BLANKS ARE ILLEGAL.
22598c21515
< * UNTIL ONE OF THE FOLLOWING THREE CONDITIONS OCCURS.
---
> * UNTIL ONE OF THE FOLLOWING CONDITIONS OCCURS.
22604c21521
< * 3) END OF STRING ENCOUNTERED (WA SET TO 0)
---
> * 3) END OF STRING ENCOUNTERED (WA AND XSCNB SET TO 0)
22605a21523,21524
> * 4) ILLEGAL BLANK (WA 0, XSCNB NON-ZERO)
> *
22622a21542,21543
> ZER XSCBL CLEAR COUNT OF TRAILING BLANKS
> ZER XSCNB CLEAR NON-BLANK SEEN FLAG
22632c21553
< XSCN1 LCH WB,(XR)+ LOAD NEXT CHARACTER
---
> XSCN0 LCH WB,(XR)+ LOAD NEXT CHARACTER
22635,22636c21556,21561
< DCV WA DECREMENT COUNT OF CHARS LEFT
< BNZ WA,XSCN1 LOOP BACK IF MORE CHARS TO GO
---
> BEQ WB,=CH$BL,XSCN7 SKIP IF IT IS A BLANK
> .IF .CAHT
> BEQ WB,=CH$HT,XSCN7 SKIP IF IT IS A TAB
> .FI
> BNZ XSCBL,XSCN2 FAIL CHAR AFTER TRAILING BLANK
> MNZ XSCNB NOTE A NON-BLANK SEEN
22637a21563,21568
> * COUNT CHARS DONE
> *
> XSCN1 DCV WA DECREMENT COUNT OF CHARS LEFT
> BNZ WA,XSCN0 LOOP BACK IF MORE CHARS TO GO
> ZER XSCNB CLEAR ERRONEOUS BLANKS FLAG
> *
22643a21575
> SUB XSCBL,WA ADJUST FOR TRAILING BLANKS
22665a21598
> SUB XSCBL,WA ADJUST FOR TRAILING BLANKS
22673a21607,21609
> .IF .CASL
> JSR SBSTG BUILD SUBSTRING
> .ELSE
22674a21611
> .FI
22677a21615,21625
> *
> * DEAL WITH BLANK
> *
> XSCN7 BZE XSCNB,XSCN8 SKIP IF LEADING BLANK
> ICV XSCBL ELSE COUNT TRAILING BLANK
> BRN XSCN1 LOOP
> *
> * LEADING BLANK
> *
> XSCN8 ICV XSOFS PUSH OFFSET PAST BLANK
> BRN XSCN1 LOOP
22753c21701
< WTB XR CONVERT TO BYTE OFFSET
---
> WTB XR CONVERT TO BAU OFFSET
22765c21713
< ERB 235,SUBSCRIPTED OPERAND IS NOT TABLE OR ARRAY
---
> ERB 240,SUBSCRIPTED OPERAND IS NOT TABLE OR ARRAY
22841c21789
< WTB WA CONVERT OFFSET TO BYTES
---
> WTB WA CONVERT OFFSET TO BAUS
22853c21801
< ARF09 ERB 236,ARRAY REFERENCED WITH WRONG NUMBER OF SUBSCRIPTS
---
> ARF09 ERB 241,ARRAY REFERENCED WITH WRONG NUMBER OF SUBSCRIPTS
22866c21814
< ARF11 ERB 237,TABLE REFERENCED WITH MORE THAN ONE SUBSCRIPT
---
> ARF11 ERB 242,TABLE REFERENCED WITH MORE THAN ONE SUBSCRIPT
22870c21818
< ARF12 ERB 238,ARRAY SUBSCRIPT IS NOT INTEGER
---
> ARF12 ERB 243,ARRAY SUBSCRIPT IS NOT INTEGER
22901c21849
< WTB WB CONVERT TO BYTES
---
> WTB WB CONVERT TO BAUS
22921a21870,21888
> * EROSI -- PROCESS ERROR RETURN FROM OSINT
> *
> * (WA) 0 OR ERROR CODE IN 256 TO 998
> * (XL) 0 OR PSEUDO SCBLK FOR ERROR MESSAGE
> * (IA) NEW VALUE FOR CODE KEYWORD
> * BRN EROSI JUMP TO PROCESS ERROR
> *
> EROSI RTN
> STI KVCOD STORE NEW CODE KEYWORD VALUE
> MOV WA,KVERT STORE ERROR CODE
> BZE XL,ERROR FAIL AT ONCE IF NO ERROR MSG TEXT
> MOV SCLEN(XL),WA STRING LENGTH
> ZER WB ZERO OFFSET
> JSR SBSTR COPY ERROR MESSAGE STRING
> MOV XR,R$ETX AND STORE IT
> MNZ EROSN NOTE NO CALL OF SYSEM
> MOV KVERT,WA RECALL ERROR CODE
> BRN ERROR ENTER ERROR SECTION
> *
22935d21901
< EJC
22972d21937
< EJC
22999d21963
< EJC
23015d21978
< EJC
23058d22020
< EJC
23070d22031
< EJC
23100c22061
< ERR 239,INDIRECTION OPERAND IS NOT NAME
---
> ERR 244,INDIRECTION OPERAND IS NOT NAME
23131c22092
< ERR 240,PATTERN MATCH RIGHT OPERAND IS NOT PATTERN
---
> ERR 245,PATTERN MATCH RIGHT OPERAND IS NOT PATTERN
23161c22122,22125
< ERR 241,PATTERN MATCH LEFT OPERAND IS NOT STRING
---
> ERR 246,PATTERN MATCH LEFT OPERAND IS NOT STRING
> .IF .CNBF
> MOV XR,R$PMS IF OK, STORE SUBJECT STRING POINTER
> .ELSE
23163c22127
< * MERGE WITH BUFFER OR STRING
---
> * MERGE WITH NULL STRING OR BUFFER
23165a22130
> .FI
23173a22139
> EJC
23174a22141,22142
> * MATCH (CONTINUED)
> *
23201c22169
< ERB 242,FUNCTION RETURN FROM LEVEL ZERO
---
> ERB 247,FUNCTION RETURN FROM LEVEL ZERO
23227c22195
< MOV PFVBL(XR),XL LOAD VRBLK PTR (SGD13)
---
> MOV PFVBL(XR),XL LOAD VRBLK POINTER
23260c22228
< JSR PRTNL TERMINATE PRINT LINE
---
> JSR PRTFH TERMINATE PRINT LINE
23295c22263
< * HERE IF &PROFILE = 1. START TIME MUST BE FRIGGED TO
---
> * HERE IF PROFILE = 1. START TIME MUST BE FRIGGED TO
23303c22271
< * HERE IF &PROFILE = 2
---
> * HERE IF PROFILE = 2
23331a22300
> EJC
23332a22302,22303
> * RETRN (CONTINUED)
> *
23344d22314
< EJC
23346,23347d22315
< * RETRN (CONTINUED)
< *
23352c22320
< ERR 243,FUNCTION RESULT IN NRETURN IS NOT NAME
---
> ERR 248,FUNCTION RESULT IN NRETURN IS NOT NAME
23393c22361
< ERB 244,STATEMENT COUNT EXCEEDS VALUE OF STLIMIT KEYWORD
---
> ERB 249,STATEMENT COUNT EXCEEDS VALUE OF STLIMIT KEYWORD
23409a22378,22380
> *
> * MERGE PROFILE, NO-PROFILE CASES
> *
23432c22403,22404
< * (XR) POINTS TO ENDING MESSAGE
---
> * (WA) 0 OR ERROR MESSAGE CODE
> * (XR) 0 OR ENDING MESSAGE POINTER
23436c22408,22410
< * TO ENDING MESSAGE OR IS ZERO IF MESSAGE PRINTED ALREADY.
---
> * TO ENDING MESSAGE OR IS ZERO IF MESSAGE PRINTED ALREADY.
> * (WA) AND (XR) ARE BOTH NON-ZERO ONLY IN THE CASE OF FATAL
> * ERRORS DURING INITIAL COMPILE.
23440d22413
< BZE XR,STPRA SKIP IF SYSAX ALREADY CALLED (REG04)
23442d22414
< STPRA ADD RSMEM,DNAME USE THE RESERVE MEMORY
23444d22415
< ADD RSMEM,DNAME USE THE RESERVE MEMORY
23446,23448c22417,22424
< BNE XR,=ENDMS,STPR0 SKIP IF NOT NORMAL END MESSAGE
< BNZ EXSTS,STPR3 SKIP IF EXEC STATS SUPPRESSED
< ZER ERICH CLEAR ERRORS TO INT.CH. FLAG
---
> ADD RSMEM,DNAME USE THE RESERVE MEMORY
> BZE WA,STPR1 SKIP IF NO ERROR MESSAGE
> MOV XR,STPXR KEEP 0 OR ENDING MESSAGE
> MOV TTERL,TTLST SEND ERROR AND STATS TO TERML
> JSR PRTPG PAGE THROW
> JSR ERMSG PRINT ERROR MESSAGE
> MOV STPXR,XR RECOVER 0 OR ENDING MESSAGE
> ZER EXSTS TO FORCE ENDING STATS OUT FOR ERROR
23450c22426
< * LOOK TO SEE IF AN ENDING MESSAGE IS SUPPLIED
---
> * PROCESS ENDING STATISTICS
23452,23454c22428,22433
< STPR0 JSR PRTPG EJECT PRINTER
< BZE XR,STPR1 SKIP IF NO MESSAGE
< JSR PRTST PRINT MESSAGE
---
> STPR1 MTI KVSTN GET STATEMENT NUMBER
> IEQ STPR6 SKIP IF COMPILE TIME
> BNZ EXSTS,STPR4 SKIP IF NO STATS TO BE PRINTED
> JSR PRTPG EJECT PRINTER
> BZE XR,STPR2 SKIP IF NO MESSAGE
> JSR PRTFB PRINT MESSAGE
23458,23459c22437
< STPR1 JSR PRTIS PRINT BLANK LINE
< MTI KVSTN GET STATEMENT NUMBER
---
> STPR2 JSR PRTFH PRINT BLANK LINE
23461c22439
< JSR PRTMX PRINT IT
---
> JSR PRTMI PRINT IT
23466c22444
< JSR PRTMX PRINT IT
---
> JSR PRTMI PRINT IT
23468c22446
< ILT STPR2 SKIP IF NEGATIVE
---
> ILT STPR3 SKIP IF NEGATIVE
23472c22450,22452
< JSR PRTMX PRINT IT
---
> JSR PRTMI PRINT IT
> .IF .CTMD
> .ELSE
23475c22455
< IOV STPR2 JUMP IF WE CANNOT COMPUTE
---
> IOV STPR3 JUMP IF WE CANNOT COMPUTE
23477c22457
< IOV STPR2 JUMP IF OVERFLOW
---
> IOV STPR3 JUMP IF OVERFLOW
23479c22459,22460
< JSR PRTMX PRINT IT
---
> JSR PRTMI PRINT IT
> .FI
23486c22467
< STPR2 MTI GBCNT LOAD COUNT OF COLLECTIONS
---
> STPR3 MTI GBCNT LOAD COUNT OF COLLECTIONS
23488,23489c22469,22470
< JSR PRTMX PRINT IT
< JSR PRTIS ONE MORE BLANK FOR LUCK
---
> JSR PRTMI PRINT IT
> JSR PRTFH ONE MORE BLANK FOR LUCK
23494c22475
< STPR3 MOV KVDMP,XR LOAD DUMP KEYWORD
---
> STPR4 MOV KVDMP,XR LOAD DUMP KEYWORD
23496,23497c22477
< STPR3 JSR PRFLR PRINT PROFILE IF WANTED
< *
---
> STPR4 JSR PRFLR PRINT PROFILE IF WANTED
23501,23503c22481,22484
< MOV R$FCB,XL GET FCBLK CHAIN HEAD
< MOV KVABE,WA LOAD ABEND VALUE
< MOV KVCOD,WB LOAD CODE VALUE
---
> *
> * MERGE TO END RUN FOR SEVERE COMPILATION ERRORS
> *
> STPR5 MOV =KVCOD,WA LOAD CODE VALUE
23504a22486,22496
> *
> * TERMINATION DURING COMPILE
> *
> STPR6 BZE XR,STPR7 SKIP IF NO MESSAGE
> JSR PRTSF ELSE PRINT IT
> *
> * NOTIFICATION THAT IT IS COMPILE TIME
> *
> STPR7 MOV =ENDIC,XR NOTIFY USER
> JSR PRTSF SEND IT
> BRN STPR5 END
23522,23542d22513
< EJC
< *
< * SYSAB -- PRINT /ABNORMAL END/ AND TERMINATE
< *
< SYSAB RTN
< MOV =ENDAB,XR 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,XR POINT TO MESSAGE
< MOV STRTU,WA GET CHARS /TU/
< MOV WA,KVCOD PUT IN KVCOD
< MOV TIMUP,WA CHECK STATE OF TIMEUP SWITCH
< MNZ TIMUP SET SWITCH
< BNZ WA,STOPR STOP RUN IF ALREADY SET
< ERB 245,TRANSLATION/EXECUTION TIME EXPIRED
23548a22520
> STAKV RTN ENTRY POINT FOR STACK OVERFLOW
23552c22524
< ERB 246,STACK OVERFLOW
---
> ERB 250,STACK OVERFLOW
23557a22530,22531
> ZER WA NO ERROR MESSAGE
> MOV TTERL,TTLST SEND MESSAGE TO TERML IF POSSIBLE
23591c22565,22567
< ERROR BEQ R$CIM,=CMLAB,CMPLE JUMP IF ERROR IN SCANNING LABEL
---
> ERROR RTN ERROR CODE ENTRY POINT
> BGE ERRFT,=NUM03,ERR16 SKIP IF TOO MANY FATALS
> BEQ R$CIM,=CMLAB,ERRG1 JUMP IF ERROR IN LABEL SCAN
23598,23601c22574,22577
< IFF STGXC,ERR04 EXECUTE TIME COMPILE
< IFF STGEV,ERR04 EVAL COMPILING EXPR.
< IFF STGEE,ERR04 EVAL EVALUATING EXPR
< IFF STGXT,ERR05 EXECUTE TIME
---
> IFF STGXC,ERR08 EXECUTE TIME COMPILE
> IFF STGEV,ERR08 EVAL COMPILING EXPR.
> IFF STGEE,ERR08 EVAL EVALUATING EXPR
> IFF STGXT,ERR12 EXECUTE TIME
23603c22579
< IFF STGXE,ERR04 XEQ COMPILE-PAST END
---
> IFF STGXE,ERR08 XEQ COMPILE-PAST END
23605d22580
< EJC
23608d22582
< *
23613d22586
< *
23617d22589
< *
23619a22592
> EJC
23623,23624c22596,22600
< BNZ ERRSP,ERR03 JUMP IF ERROR SUPPRESS FLAG SET
< MOV ERICH,ERLST SET FLAG FOR LISTR
---
> BNZ ERRSP,ERR06 JUMP IF ERROR SUPPRESS FLAG SET
> JSR PRTFH PRINT A BLANK
> MOV TTERL,TTLST SET FLAG FOR LISTR
> ADD =NUM03,LSTLC CAUSE EJECT IF BELOW 4 LINES LEFT
> MOV LSTLC,-(XS) KEEP LINE COUNT
23626,23629c22602,22609
< JSR PRTIS TERMINATE LISTING
< ZER ERLST CLEAR LISTR FLAG
< MOV SCNSE,WA LOAD SCAN ELEMENT OFFSET
< BZE WA,ERR02 SKIP IF NOT SET
---
> JSR PRTFH TERMINATE LISTING
> MOV (XS)+,WA RECOVER LINE COUNT
> BGT LSTLC,WA,ERR02 SKIP IF NOT NEW PAGE
> ADD =NUM04,LSTLC BUMP FOR LINES PRINTED
> *
> * PRINT FLAG UNDER BAD ELEMENT
> *
> ERR02 MOV SCNSE,WA LOAD SCAN ELEMENT OFFSET
23631c22611
< LCT WB,WA LOOP COUNTER
---
> MOV WA,WB COPY OFFSET
23635a22616
> BZE WB,ERR05 SKIP IF NO BLANKS BEFORE ERROR FLAG
23637a22619
> LCT WB,WB LOOP COUNTER
23641,23642c22623,22624
< ERRA1 LCH WC,(XL)+ GET NEXT CHAR
< BEQ WC,=CH$HT,ERRA2 SKIP IF TAB
---
> ERR03 LCH WC,(XL)+ GET NEXT CHAR
> BEQ WC,=CH$HT,ERR04 SKIP IF TAB
23648,23650c22630,22636
< ERRA2 SCH WC,(XR)+ STORE CHAR
< BCT WB,ERRA1 LOOP
< MOV =CH$EX,XL EXCLAMATION MARK
---
> ERR04 SCH WC,(XR)+ STORE CHAR
> BCT WB,ERR03 LOOP
> EJC
> *
> * MERGE IN CASE OF NO PRECEDING BLANKS
> *
> ERR05 MOV =CH$EX,XL EXCLAMATION MARK
23658c22644
< MFI GTNSI STORE AS SIGNED INTEGER
---
> STI GTNSI STORE AS SIGNED INTEGER
23662c22648
< STI PROFS USE AS CHARACTER OFFSET
---
> MFI PROFS USE AS CHARACTER OFFSET
23669,23670c22655,22656
< ERR02 JSR ERMSG GENERATE FLAG AND ERROR MESSAGE
< ADD =NUM03,LSTLC BUMP PAGE CTR FOR BLANK, ERROR, BLK
---
> JSR ERMSG GENERATE FLAG AND ERROR MESSAGE
> ZER TTLST REVERT TO REGULAR LISTING
23672c22658,22659
< BHI ERRFT,=NUM03,STOPR PACK UP IF SEVERAL FATALS
---
> ICV CMERC BUMP ERROR COUNT
> BNE STAGE,=STGIC,ERRG2 SPECIAL RETURN IF AFTER END LINE
23674c22661,22662
< * COUNT ERROR, INHIBIT EXECUTION IF REQUIRED
---
> * IF ERROR IN READR THEN EITHER CLOSE OUT
> * CURRENT -COPY LEVEL, OR IF AT TOP THEN ABORT
23676,23679c22664,22667
< ICV CMERC BUMP ERROR COUNT
< ADD CSWER,NOXEQ INHIBIT XEQ IF -NOERRORS
< BNE STAGE,=STGIC,CMP10 SPECIAL RETURN IF AFTER END LINE
< EJC
---
> BZE RDRER,ERR06 SKIP IF NOT ERROR WHILE READING
> BZE R$COP,ERR16 ABORT IF AT TOP LEVEL INPUT FILE
> ZER RDRER ELSE CLEAR READR ERROR FLAG
> JSR COPND AND CLOSE OUT THIS COPY LEVEL
23683c22671,22672
< ERR03 MOV R$CIM,XR POINT TO START OF IMAGE
---
> ERR06 MOV R$CIM,XR POINT TO START OF IMAGE
> BZE XR,ERR07 SKIP IF NO INPUT IMAGE
23686c22675
< BEQ XR,=CH$MN,CMPCE JUMP IF ERROR IN CONTROL CARD
---
> BEQ XR,=CH$MN,ERRG3 JUMP IF ERROR IN CONTROL CARD
23690c22679
< BNE XL,=T$SMC,ERR03 LOOP BACK IF NOT STATEMENT END
---
> BNE XL,=T$SMC,ERR06 LOOP BACK IF NOT STATEMENT END
23691a22681
> EJC
23695c22685
< MOV *CDCOD,CWCOF RESET OFFSET IN CCBLK
---
> ERR07 MOV *CDCOD,CWCOF RESET OFFSET IN CCBLK
23701c22691,22692
< BRN CMPSE MERGE TO GENERATE ERROR AS CDFAL
---
> JMG CMPSE MERGE TO GENERATE ERROR AS CDFAL
> EJC
23703c22694
< * ERROR DURING EXECUTE TIME COMPILE OR EXPRESSION EVALUATIO
---
> * ERROR DURING EXECUTE TIME COMPILE OR EXPRESSION EVALUATION.
23711c22702,22704
< ERR04 ZER R$CCB FORGET GARBAGE CODE BLOCK
---
> ERR08 JSR COPND CALL TO CLOSE OFF THIS LEVEL
> BNZ R$COP,ERR08 LOOP IF NOT ALL -COPYS CLOSED
> ZER R$CCB FORGET GARBAGE CODE BLOCK
23719,23721c22712,22714
< ERRA4 ICA XS POP STACK
< BEQ XS,FLPRT,ERRC4 JUMP IF PROG DEFINED FN CALL FOUND
< BNE XS,GTCEF,ERRA4 LOOP IF NOT EVAL OR CODE CALL YET
---
> ERR09 ICA XS POP STACK
> BEQ XS,FLPRT,ERR11 JUMP IF PROG DEFINED FN CALL FOUND
> BNE XS,GTCEF,ERR09 LOOP IF NOT EVAL OR CODE CALL YET
23729c22722
< ERRB4 BNZ KVERL,ERR07 JUMP IF ERRLIMIT NON-ZERO
---
> ERR10 BNZ KVERL,ERR14 JUMP IF ERRLIMIT NON-ZERO
23734,23736c22727,22728
< ERRC4 MOV FLPTR,XS RESTORE STACK FROM FLPTR
< BRN ERRB4 MERGE
< EJC
---
> ERR11 MOV FLPTR,XS RESTORE STACK FROM FLPTR
> BRN ERR10 MERGE
23742,23744c22734
< * IF ERRLIMIT KEYWORD IS ZERO, AN ABORT IS SIGNALLED,
< * SEE CODING FOR SYSTEM LABEL ABORT AT L$ABO.
< *
---
> * IF ERRLIMIT KEYWORD IS ZERO, THE RUN IS ABORTED.
23749c22739
< * IF 3 OR MORE FATAL ERRORS OCCUR AN ABORT IS SIGNALLED
---
> * IF 3 OR MORE FATAL ERRORS OCCUR AN ABORT OCCURS
23752a22743
> EJC
23754,23755c22745,22746
< ERR05 SSL INISS RESTORE MAIN PROG S-R STACK PTR
< BNZ DMVCH,ERR08 JUMP IF IN MID-DUMP
---
> ERR12 SSL INISS RESTORE MAIN PROG S-R STACK PTR
> BNZ DMVCH,ERR15 JUMP IF IN MID-DUMP
23757c22748
< * MERGE HERE FROM ERR08
---
> * MERGE HERE AFTER DUMP TIDY UP
23759c22750,22751
< ERR06 BZE KVERL,LABO1 ABORT IF ERRLIMIT IS ZERO
---
> ERR13 ZER XR CLEAR XR FLAG
> BZE KVERL,STOPR ABORT IF ERRLIMIT IS ZERO
23762c22754
< * MERGE FROM ERR04
---
> * MERGE AFTER ERRLIMIT TEST
23764,23765c22756
< ERR07 BGE ERRFT,=NUM03,LABO1 ABORT IF TOO MANY FATAL ERRORS
< DCV KVERL DECREMENT ERRLIMIT
---
> ERR14 DCV KVERL DECREMENT ERRLIMIT
23772c22763
< BZE XR,LCNT1 CONTINUE IF NO SETEXIT TRAP
---
> BZE XR,ERRG4 CONTINUE IF NO SETEXIT TRAP
23781,23782c22772,22773
< ERR08 MOV DMVCH,XR CHAIN HEAD FOR AFFECTED VRBLKS
< BZE XR,ERR06 DONE IF ZERO
---
> ERR15 MOV DMVCH,XR CHAIN HEAD FOR AFFECTED VRBLKS
> BZE XR,ERR13 DONE IF ZERO
23785c22776,22795
< BRN ERR08 LOOP THROUGH CHAIN
---
> BRN ERR15 LOOP THROUGH CHAIN
> *
> * TAKE DRACONIAN STEPS FOR REPEATED FATAL ERRORS
> *
> ERR16 MOV ERRTF,WA ERROR CODE
> MOV WA,KVERT PLACE ERROR CODE FOR ERMSG
> MNZ XR IN CASE COMPILE TIME
> BEQ STAGE,=STGIC,STOPR JUMP IF SO
> BEQ STAGE,=STGCE,STOPR ALSO COMPILE TIME
> ZER XR INDICATE EXECUTION
> BRN STOPR TERMINATE RUN
> *
> ERRAF ERB 251,TOO MANY FATAL ERRORS
> *
> * HERE FOR GLOBAL ERROR JUMPS
> *
> ERRG1 JMG CMPLE
> ERRG2 JMG CMPEE
> ERRG3 JMG CMPCE
> ERRG4 JMG LCNXE
23791,23801d22800
<
<
<
<
<
<
<
<
<
<
<