PREQ . DEFINE REGISTERS AND SYMBOLS $(1) . . THIS ROUTINE SCANS ARITHMETIC AND LOGICAL EXPRESSIONS . GENERATING RIGHT HAND POLISH IN TABLE 'STRING' INDEXED BY B5. . CALLING SEQUENCE -- A LMJ B11,SCAR . A+1 NORMAL RETURN . SCAR IS CALLED AT 'IF' STATEMENTS, 'CALL' STATEMENTS AND . EQUATIONS. SCAR EXITS AT A RIGHT PARENTHESIS AT LEVEL . 0 IN 'IF' STATEMENTS AND AT END OF STATEMENT FOR CALL'S . AND EQUATIONS. . JU EQU T1 JW EQU T2 JZ EQU S5 JX EQU S6 JY EQU S1 JQ EQU S2 SUDM EQUF SUBT,B10,H2 . LOCATION OF DIMENSIONS GENSUB SUCMT EQUF SUBT,B10,S3 . CURRENT COMMA COUNT GENSUB SUDMLT EQUF SUBT,B10,S2 . MAX NUMBER OF DIMESNIONS GENSUB SUELSZ EQUF SUBT3,B10,H1 . ELEMENT SIZE TIME ACCUMULATED PRODUCT GENSUB SFCID EQUF SUBT3,B10,H1 . CONSTANT DIMENSIONS GENSUB SUALOF EQUF SUBT2,B10,XH2 . ACCUMULATED OFFSET GENSUB SUVC EQUF SUBT2,B10,S3 . VARIABLE COUNT GENSUB SUOFL EQUF SUBT3,B10,H2 . OFFSET LOCATION SUPLFG EQUF SUBT4,B10,S5 . SAVES MINUS SIGN FOR TERM SUNS EQUF SUBT2,B10,S2 . NON ZERO FOR NON STANDARD SUBSCRIPT GENSUB . A 1 BIT IS BAD OPERATOR GENSUB . A 1 BIT IS A BAD OPERATOR GENSUB . A 2 BIT IS BAD TYPE GENSUB . A 44 BIT IS PRODUCT OF INDUCTION VARIABLES GENSUB . A 4 BIT IS PRODUCT OF INDUCTION VARIABLES GENSUB SUDGFL EQUF SUBT,B10,S1 GENSUB SUVRDM EQUF SUBT2,B10,S1 . NON ZERO IF VARIABLE DIMENSIONS GENSUB SUSVA7 EQUF SUBT4,B10,S1 . SAVES A7 SVN1FL EQUF SUBT4,B10,S2 . SAVES N1FLD SUPLFL EQUF SUBT4,B10,S3 . SAVES PLUS OPERATOR SUPRFL EQUF SUBT4,B10,S4 CHSYM EQUF SUBT5,B10,H1 . SYM PTR FOR CHARACTER IDENT CHSFQ EQUF SUBT5,B10,H2 . FLAG THAT CHARACTER DIRECTIVE APPEARED SCAR* SLJ SCARS SAVE REGS TZ PARFLG J $+3 TZ FEB IS THIS AN EQUATION 041800 S R8,STRING,*B5 -NO, OUTPUT DUMMY ITEM 041900 TZ FEB DSL A9,72 L,M A2,15 LEFT PAREN. ITEM NUMBER 042000 L A0,OPERAT-9,A2 GENSUB S A0,STACK,*B8 GENSUB TNZ EQTFLG J SCAR1 J SCAR11 ONLY A SUBSCRIPT ALLOWED IN EQUIVALENCE GENSUB SCAR0 DSL A9,72 RESET A, A AND B 042200 SCAR1 LMJ B11,GIT 042300 J SCAR78 END OF STATEMENT 042400 S A2,FLDF9 . LAST SYNTATIC TYPE S B10,CUFCLV SAVE CURRENT FUNCTION LEVEL L A4,SUDMLT S A4,SUDGFL ALLOW DIGNOSTIC MESSAGES FOR SUBSCRIGENSUB L A5,(01047030 ) ALLOW 'P','-','*',',',')' SSL A5,0,A2 L,M A4,1 TNZ SUDGFL L,M A4,0 JB A5,$+3 OR A4,SUNS SET BIT THAT ILLEGAL SYNTACTIC UNIT GENSUB S A5,SUNS APPEARED WITHIN SUBSCRIPT GENSUB TLE,M A2,9 S A2,FLDF1 SAVE SYNTACTIC TYPE OF OPERAND J *SCAR2,A2 ITEM RETURNED IS - - 042500 SCAR3 LMJ B11,PERR ITEM NOT RECOGNIZABLE 045500 FORM6 FORM 6,12,18 045510 FORM6 010,46,GITV 045600 J SCAR1 GET NEXT ITEM 045700 . 045800 . ITEM IS A STATEMENT LABEL. THIS IS OK ONLY IF 045900 . THE LABEL IS A SIMPLE ARGUMENT. 046000 SCAR4 JZ A6,SCAR46 STATEMENT LABEL ITEM 046100 JZ A7,SCAR5 046110 TNE,M A0,',' IS X=, 046200 J $+3 -YES 046300 TE,M A0,')' IS X = ) J SCAR5 -NO 046500 SCR4 LMJ B11,GETL ENTER LABEL IN LREF AND SYM 046600 A A1,(0150000,0) LABEL REFERENCE ID 046700 S A1,STRING,*B5 S(I) = STATEMENT LABEL 046800 SZ A6 046810 SZ A12 046820 J SCAR1 GET NEXT ITEM 046900 SCAR5 LMJ B11,PERR ILLEGAL USE OF LABEL 047000 FORM6 021,47,GITV 047100 J SCR4 047200 SCR5 SLJ BUG 047300 . 047400 . ITEM IS $ 047500 SCAR6 LMJ B11,PERR IMPROPER DELIMITER 047600 FORM6 012,9,('$ ') L,M A2,11 CONSIDER BAD OPERATOR TO BE ASTERISKS GENSUB J SCAR1+2 GENSUB . 047900 . ITEM IS A NAME 048000 SCAR7 JZ A6,SCAR46 IS UNARY SET 048100 SZ A6 -YES, RESET UNARY 048200 TZ DERFL J SCAR7X JNZ A8,SCAR47 IS STAFUN SET 048300 SCAR8 LMJ B11,GLG1 -NO, SEARCH SYM SEP28 J SCR8 NOT IN, ENTER SYM OCT 1 L,H1 A2,2,A1 048600 AND,M A2,7 -IN, PICK UP CLASS 048700 JZ A3,SCAR10 048800 J SCAR9,A3 BRANCH ON CLASS 048900 SCAR9 J SCAR10 -VARIABLE 049000 J SCAR20 -INTERNAL FUNCTION 049100 J SCAR20 -EXTERNAL FUNCTION 049200 SLJ BUG -CONSTANT 049300 J SCAR35 -PARAMETER 049400 J SCAR30 -ARGUMENT 049500 J SCAR31 -INTRINSIC FUNCTION 049600 AND,M A2,0700 -FORMAT,HOLL ARG. ETC. 049700 TNE,M A3,0400 IS D=4 J SCAR36 YES, CLASS UNASSIGNED 049900 TNZ,M 0,B10 J SCAR9J . TEST IF ANY FUNCTIONS ACTIVE L A0,GXX . USE TERMINATING CHARACTER TO TNE,M A0,',' . TEST FOR VALID ARGUMENT J SCAR9K TE,M A0,')' J SCAR9J SCAR9K AU A1,(0150000,0) . ID FOR LABEL ITEM S A2,STRING,*B5 . PLACE VARIABLE ITEM IN STRING LXM,H2 A2,3,A1 . POINT TO VARIABLES IN LIST S A1,SYMV . SAVE SYNBOL TABLE POINTER LXI,M A2,0 L,S5 A3,2,A1 . NUMBER OF VARIABLES LSSL A3,6 A,S6 A3,2,A1 . SIMULATE L,T3 AN,M A3,1 . ADJUST FOR A JGD SCAR9Z L A12,0,A2 SSA A12,18 . SIMULATE L,XH1 TE A12,(-0101) J SCAR9Q LXM,H2 A2,0,A2 . SKIP TO NEXT PIECE OF TABLE J SCAR9Z SCAR9Q AN,M A2,1 . POINT TO NEXT VARIABLE LMJ B11,GENDP2 JGD A3,SCAR9Z L A1,SYMV . RESTORE POINTER TO NAMELIST SZ A12 . RESET L,M A0,6 S,S2 A0,2,A1 . MARK NAMELIST INVOKED J SCAR1 SCAR9J LMJ B11,PERR FORM6 031,174,SYMV J SCAR82 . FIRST REFERENCE THIS SYMBOL SCR8 TNE A13,GXX J SCR37 MAY BE A STATEMENT FUNCTION TZ DEF2Z J SCR37 SCR8V LMJ B11,GLS . ELSE ENTER AS LOCAL J $+2 SLJ BUG . NEVER BUT ON SEARCH FAILURE L,M A1,0,A1 CLEAR A1(H1) OCT 1 S A1,SYMV OCT 1 J SCAR36 OCT 1 . C=0, THIS IS A VARIABLE 050200 SCAR10 L,M A11,1 GENSUB A A11,SUVC GENSUB S A11,SUVC COUNT VARIABLES IN SUBSCRIPT GENSUB TNZ,XH2 IFDEF J SCR10D L,M A12,0,A1 PUT OUT CONDITIONAL DEFINITIN POINTS LMJ B11,GENDP2 SZ A12 SCR10D L,S3 A2,2,A1 . TEST IF IDENTIFIER IS CHARACTER SSL A2,3 TE,M A2,6 J SCR10E . IT WAS NOT CHARACTER L,M A1,0,A1 TE,H2 A1,N5RGFB . TEST LOC OF CALLING SEQUENCE TNE,H2 A1,N5RGFC . TEST LOCATION OF TEMP J SCR10E . NOT REALLY A CHARACTER IDENT L,H2 A3,3,A1 . POINTER TO INFO EXTENSION L,S2 A4,2,A1 . NUMBER OF DIMENSIONS AND,M A4,7 A A3,A5 . CHARACTER PACKET ULOCATION S A3,CHSFQ+1 L,S1 A4,0,A3 TE,M A4,066 . TEST VALIDITY OF PACKET SLJ BUG L,S3 A4,0,A3 . GET ATTRIBUTE FIELD TEP,M A4,1 . TEST VARIABLE J SCR10Q . WAS A VARIABLE TEP,M A4,2 . TEST FUNCTION J SCR10FC . IT WAS A FUNCTION TE A13,GXX . SEE IF NEXT CHARACTER ID '(' J SCR10Q LMJ B11,SGX1 . SAVE POINTERS AND LOOK FOR : OR , S A1,N0RGSA+1 S A6,N0RGSA+2 . GET SOMEWORKING REGISTERS LR FNXT,R8 . SKIP FIRST PARENTHESIS SZ A6 . PARENTHESIS COUNT SCR10RP LMJ B11,GX NOP . SHOULD NEVER HAPPEN. ERROR HOPEFULLY ELSEWHERE TNE,M A0,'(' A,M A6,1 TNE,M A0,')' AN,M A6,1 TNE,M A0,':' JZ A6,SCR10CL TNE,M A0,')' JN A6,SCR10CM TNE,M A0,',' JZ A6,SCR10CM J SCR10RP SCR10CM LMJ B11,RGX1 . COULD BE EITHER FUNCTION OR SUBSCRIPT L A1,N0RGSA+1 L A6,N0RGSA+2 . RESTORE REGISTERS L,S2 A2,2,A1 . TEST IF THERE ARE DIMENSIONS AND,M A2,7 JNZ A3,SCR10Q . MUST BE A SUBSCRIPT L,H1 A2,2,A1 AND,M A2,7 TNZ A3 A,M A2,2 . CONVERT TO FUNCTION OR,M A2,01000 . SET FUNCTION BIT S,H1 A3,2,A1 SZ A15 . TYPE OF COMA J SCR10FC SCR10CL LMJ B11,RGX1 . RESTORE CHARACTER POINTERS L A1,N0RGSA+1 L A6,N0RGSA+2 SCR10Q AX,M B10,1 . CREATE PSUEDO FUNCTION L A3,CHSFQ . LOCATION OF CHARACTER PACKET L,S3 A4,0,A3 . ATTRIBUTE FIELD OR,M A4,1 . MARK AS VARIABLE S,S3 A5,0,A3 S A1,CHSYM . SAVE SYM POINTER TO CHARACTER IDENT L A2,(020000,0) A,H2 A2,CRFLD . CREATE A SUBSTRING REFERENCE S A2,STRING,*B5 S R15,A7 . SET S2 S B10,N1FLDX . LEVEL ABOCE WHICH OPERATORS ARE OK LEF TZ A10 S B10,FLDEQ . EQUIVALENT TO FLD LEFT OF EQUALS L,M A1,0,A2 . SYM ADDRESS OF FUNCTION TO A1 L A0,A1 S A1,SFCID SZ,H2 SCARPD,B6 . NO DEFINITION POINT FOR SUBSTR$ S,S2 A7,SCARPD,B6 SZ,S1 SCARPD,B6 L,S3 A0,2,A1 S,S3 A0,SCARPD,B6 . SAVE TYPE OF FUNCTION S,JW B6,SCARW+1,B6 . W(J+1) = J L A2,B6 . SIMULATE S,T2 B6 S,S4 A2,SCARW+1,B6 . W(J+1) = J SSL A2,6 S,S3 A2,SCARW+1,B6 . SZ,JZ SCARZ+1,B7 . Z(N+1) = 0 SZ,JX SCARX+1,*B7 L A2,B7 . SIMULATE S,T1 B7 S,S2 A2,SCARU+1,B6 SSL A2,6 S,S1 A2,SCARU+1,B6 S,JY A14,SCARY+1,B6 . Y(J+1) = ABNORM L,M A5,014 . SPECIAL COMMA NUMBER TZ A10 A,M A5,1 . SET ONE HIGHER WHEN LEFT OF EQUALS S,JQ A5,SCARQ+1,*B6 . Q(J+1) = SPECIAL COMMA J = J+1 AU A1,OPERAT+8 . F30 COLON S A2,STACK,*B8 L A1,CHSYM . RESTORE POINTER TO CHARACTER IDENT S R15,A6 L,S2 A2,2,A1 . GET NUMBER OF DIMENSIONS IF ANY AND,M A2,7 TNZ,S2 GEICFL . TEST IMPLIED ARRAY JNZ A3,SCR10E . A DIMENSIONED CHARACTER VARIABLE L,M A12,0,A1 AU A1,(020040,0) . F30 VARIABLE ITEM S A2,STRING,*B5 TZ A10 . TEST FOR BEING LEFT OF EQUALS LMJ B11,GENDP2 . OUTPUT DEFINITION POINT SZ A8 TNE A13,GXX . TEST FOR FOLLOWING SUBSTRING LMJ B11,SCDUST . GO FUDGE UP A SUBSTRING TE A13,GXX LMJ B11,SCDXST . SIMULATE A SUBSTRING TO BE ENTIRE STRI J SCR12A SCR10E TNZ,H2 3,A1 . TEST FOR POINTERS TO DIMENSION INFO J SCAR26 -NO 050400 SCAR11 L,M A12,0,A1 T1=SYM(V) 050500 AU A1,(020000,0) F30 VARIABLE ITEM 050600 L,S1 A4,GEICFL . FLAG NON SUBSCRIPTS FOR DATA STATEMENT TZ SUDM . TEST IF ACTIVE SUBSCRIPT J $+3 TNE,M A4,077 . ONLY TRUE IF DATA STATEMENT A A2,(040,0) . FLAG FOR N6DSP SCR10 S A2,STRING,*B5 TE A13,GXX IS X=( 050800 J SCR12A L FNXT,R8 GENSUB SCR11 S A8,STFUFL GENSUB SZ STFAG TNZ SUDM GENSUB J $+4 L,M A4,1 GENSUB OR A4,SUNS SET FORM THAT ILLEGAL FORM IN SUBSCRIPT GENSUB S A4,SUNS GENSUB A,M B10,1 FOR SUBSCRIPTED SUBSCRIPTS INCREASE FUNCTIONGENSUB SZ CHSFQ . CLEAR FLAG THAT SHOWS CHARACTER APPEAR L A11,N1SBLV A SEPARATE SUBSCRIPT LEVEL A,M A11,1 IS REAUIRED FOR DEFINES S A11,N1SBLV L,M A2,0,B10 GENSUB TG,M A2,11 J SCR10M TO MANY NESTED SUBSCRIPTS GENSUB L,H2 A2,3,A1 LOCATION OF DIMENSIONS GENSUB S A2,SUDM SET DIMENSION LOC/SUBSCRIPT FLAG GENSUB S B10,SUPRFL S A7,SUSVA7 L A2,EQTFLG GENSUB TNZ SUDM GENSUB S A2,SUDM EQUIVALNCE MAY HAVE SUBSCRIPTS WITHOUT GENSUB . BENEFIT OF DIMENSION STATEMENTS GENSUB SZ,H1 SUBT,B10 GENSUB SZ SUBT2,B10 CLEAR FLAGS GENSUB SZ,H1 SUBT3,B10 GENSUB S B5,SUOFL LOCATION OF OFFSET ITEM GENSUB L,M A2,0401 ID FOR OFFSET PLUS OPERATOR GENSUB S,S2 A2,STRING,B5 . SIMULATE S,T1 SSL A2,6 S,S1 A2,STRING,B5 A,M B5,1 LEAVE SPACE FOR OFFSET GENSUB L,S2 A2,2,A1 GENSUB AND,M A2,7 GENSUB S A3,SUDMLT NUMBER OF DIMENSIONS GENSUB L A4,N1FLDX S A4,SVN1FL S B10,N1FLDX ANY OPERATOR IS OK IN SUBSCRIPT GENSUB L A4,OPERAT+7 SEMICOLON GENSUB S A4,STACK,*B8 GENSUB S A4,A6 GENSUB L,H2 A5,SCARR+2 A,M A5,1 TZ LIST S,H2 A5,SCARR+2 SCR12A . TNZ UNTFMT SCANING UNIT OR FORMAT REFERENCE TZ STFAG IS IT AN ARGUMENT J SCR12 TNZ B10 NON ZERO FOR FUNCTION ARGUMENT TZ,H2 CRSD1 C OPTION J SCR12 SUPPRESS DIAGNOSTIC TZ MACNO J SCR12 . A MACRO IS ACTIVE L,S2 A2,2,A1 AND,M A2,3 WAS IT DIMENSIONED JZ A3,SCR12 LMJ B11,PERR FORM6 033,120,SYMV $ USED WITH FEWER SUBSC. THAN DIM. SCR12 JNZ A10,SCAR18 051900 SCAR12 L,S3 A3,2,A1 052000 SSL A3,3 052100 L,S1 A2,SCARU,B6 LSSL A2,6 A,S2 A2,SCARU,B6 . SIMULATE L,T1 EX SUBTYP,A3 GENSUB TNZ SUELSZ GENSUB S A4,SUELSZ SET ELEMENT TYPE OF ARRAY GENSUB TNZ STFAG . FLAG NON ZERO IF ARGUMENT JUST FOUND J SCAR13,A3 052300 SZ STFAG J SCAR0 SCR10M LMJ B11,PERR GENSUB FORM6 02,123,0 J SCAR82 GENSUB . 052400 . BRANCH ON NAME TYPE. IF THE TYPE IS UNASSIGNED, 052500 . ASSIGN ACCORDING TO NAMING CONVENTION. IF REAL OR COMPLEX 052600 . SET THE PROPAGATE REAL BIT IF NOT IBM COMPATIBLE. 052700 . IF DOUBLE PRECISION AND IF IBM COMPATIBLE SET D. PREC. 052800 . PROPAGATE BIT, IF NOT IBM COMPATIBLE PROPAGATE D. PREC. ONLY 052900 . FROM THE LEFT OF THE EQUAL SIGN. 053000 SCAR13 J SCAR14 T=0, UNASSIGNED 053100 J SCAR0 T=1, INTEGER 053200 J SCAR15 T=2, REAL 053300 J SCAR16 T=3, DOUBLE-PRECISION 053400 J SCR15 T=4, COMPLEX 053500 J SCR18 T=5, LOGICAL 053600 J SCAR0 T=6, BOOLEAN BVER2 J SCAR0 T=7 OCTAL SCAR14 L,S3 A2,2,A1 AND,M A2,7 CHECK FOR TYPE STATEMENT TE,M A3,5 J $+3 L,S6 A0,2,A1 TYPE FROM TYPE STATEMENT JNZ A0,$+3 L,S1 A0,0,A1 TYPE FROM FIRST LETTER OF NAME L,S5 A0,P1TAB1,A0 S A0,A3 A,H1 A0,2,A1 SET TYPE 054100 S,H1 A0,2,A1 054200 SSL A3,3 L,S1 A2,SCARU,B6 . SIMULATE L,T1 LSSL A2,6 A,S2 A2,SCARU,B6 EX SUBTYP,A3 GENSUB TNZ SUELSZ GENSUB S A4,SUELSZ SET ELEMENT TYPE OF ARRAY GENSUB J SCAR13,A3 SCR15 S R15,CRCD SET COMPLEX-DOUBLE FLAG 054450 SCAR15 JZ A10,SCARSP TZ,H1 CRCOMP TEST REAL PROPAGATION GENSUB S,JZ R15,SCARZ,A2 -YES, Z(U(J))=1 054700 J SCARSP GENSUB SCAR16 S R15,CRCD SET COMPLEX-DOUBLE FLAG JZ A10,SCARSP TZ,H2 CRCOMP GENSUB SCAR17 S,JX R15,SCARX,A2 X(U(J))=1 055100 J SCARSP GENSUB . 055300 . GENERATE DEFINITION POINT(S). 055400 SCAR18 LMJ B11,GENDP2 055500 SZ A8 GENSUB J SCAR12 GENSUB SCR18 L A11,CUFCLV FUNCTION LEVEL AT START OF SYNTACTIC UNIT TNZ A11 LOGICAL IF FUNCTION LEVEL IS ZERO S R15,LOAR GENSUB SCARSP L,M A4,2 GENSUB TNZ B10 J SCRSPA OR A4,SUNS GENSUB TZ SUDGFL TEST IF WITHIN SUBSCRIPT GENSUB S A5,SUNS SET FLAG FOR NON INTEGER VARIABLE GENSUB TNZ CRSPSU TEST IF SUBSCRIPT SHOULD BE DIAGNOSED GENSUB J SCRSPA TNZ SUDGFL GENSUB J SCRSPA LMJ B11,PERR GENSUB FORM6 030,66,SYMV GENSUB SCRSPA JZ A10,SCAR1 J SCAR0 . 056100 . ITEM IS AN INTERNAL OR EXTERNAL SUBPROGRAM 056200 SCR20S L,H1 A2,2,A1 AND,M A2,04307 . EQUIVALENT BIT IS SET TO SHOW PROPER TE,M A3,04001 J SCAR90 . AN IMPROPER FUNCTION TO LEFT OF EQUALS SZ A8 . CSC24 TZ DEF2Z J SCR21Q J SC20RA GENSUB SCR20Q JZ A10,SCR20+1 SZ A8 J SC20RA GENSUB SCR21Q LMJ B11,PERR FORM6 031,2,SYMV J SCAR82 SCR20T AND,M A4,04307 CSC24 TNE,M A5,04001 STMT FUNCTION LEFT OF EQUALS CSC24 JNZ A10,SCR20U TNE,M A5,04006 . NO DEFINITION POINT FOR FLD LIKE FUNCT J SCR21J L,M A5,1 TE A5,LIST J SCR21J J SCR20U . GENERATE DEFINITIN POINTS FOR INPUT L SCAR20 SZ A15 056300 L,H1 A2,2,A1 AND A2,(0307) TE,M A3,1 J $+3 OR,M A2,01000 SET BIT TO SHOW DEFINE REFERENCED GENSUB S,H1 A3,2,A1 GENSUB SCR20 L,M A4,1 GENSUB OR A4,SUNS SET FLAG FOR NON SYNTACTIC UNIT GENSUB TZ SUDGFL S A5,SUNS IN SUBSCRIPT GENSUB JNZ A10,SCR20S GENSUB SC20RA . GENSUB SZ A12 -NO, T1=0 056400 SZ A14 RESET ABNORM 056500 JZ A8,SCR20J TEST FOR DEFINE OF A FUNCTION L,H1 A3,2,A1 AND,M A3,04307 TNE,M A4,04001 J SCR20J L A4,GITV TNE A4,('FLD ') J SCR20J TE A4,('FLD$ ') . FLD FUNCTION TO CROSS WORD BOUNDARIES TNE A4,('BITS ') . FTN BITS FUNCTION J SCR20J TNE A4,('LOC ') GENSUB J SCR20J L,M A11,0,B10 GENSUB TLE A11,N1FLDX GENSUB SR R15,SFOP GENSUB SCR20J L,H1 A4,2,A1 GENSUB AND,M A4,077 . TEST FOR CHARACTER FUNCTION TE,M A5,062 . TEST EXTERNAL CHARACTER FUNCTION J SC20RQ . NO IT WAS NOT CHARACTER SCR10FC AX,M B10,1 . INCREASE FUNCTION LEVEL FOR SUBSTRING L A3,CHSFQ . LOCATION OF CHARACTER PACKET L,S3 A4,0,A3 . ATTRIBUTE FIELD OR,M A4,2 . MARK AS FUNCTION S,S3 A5,0,A3 S A1,CHSYM . SET CHARACTER ACTIVE FLAG L A2,(020000,0) . MASK FOR VARIABLE ITEM A,H2 A2,CRFLD . CREATE A SUBSTRING REFERENCE S A2,STRING,*B5 . START IMPLIED SUBSTRING L,M A1,0,A2 . SYM ADDRESS OF FUNCTION TO A1 L A0,A1 S A1,SFCID SZ,H2 SCARPD,B6 . SAVE FOR DP OF DEFINED VARIABLE S,S2 A7,SCARPD,B6 SZ,S1 SCARPD,B6 . SIMULATE S,T3 L,S3 A0,2,A1 S,S3 A0,SCARPD,B6 . SAVE TYPE OF FUNCTION L A2,B6 . SIMULATE S,T2 B6 S,S4 A2,SCARW+1,B6 SSL A2,6 S,S3 A2,SCARW+1,B6 SZ,JZ SCARZ+1,B7 . Z(N+1) = 0 SZ,JX SCARX+1,*B7 L A2,B7 . SIMULATE S,T1 B7 S,S2 A2,SCARU+1,B6 SSL A2,6 S,S1 A2,SCARU+1,B6 S,JY A14,SCARY+1,B6 . Y(J+1) = ABNORM L,M A5,014 . SPECIAL COMMA NUMBER TZ A10 A,M A5,1 . SET ONE HIGHER WHEN LEFT OF EQUALS S,JQ A5,SCARQ+1,*B6 . Q(J+1) = SPECIAL COMMA J = J+1 AU A1,OPERAT+8 . F30 COLON S A2,STACK,*B8 L A1,CHSYM . RESTORE POINTER TO CHARACTER IDENT L,H1 A4,2,A1 . RESTORE A4 SC20RQ . TNZ B10 GENSUB J $+4 GENSUB AND,M A4,050 -YES TNE,M A5,050 IS THIS FUNCTION LOGICAL S R15,LOAR -YES, SET LOGICAL FLAG AND,M A4,0100 056900 AU A1,(020000,0) VARIABLE ITEM ID 056910 S A2,STRING,*B5 056920 JZ A5,SCR20T FUNCTION ABNORMAL CSC24 SCR20A AND,M A4,7 CSC24 TNE,M A5,6 J SCAR21 . NO DEF FOR INTRINSIC FUNCTIONS JNZ A8,SCJR21 IGNORE DEF POINT IN STATE FUNC S R15,A14 -YES, SET ABNORM 057100 L,H1 A3,CRCDP 057300 A A3,(02200000) COMMON DP ITEM 057400 SSC A3,21 057500 S A3,SLOUT,*B9 S,H1 B1,CRCDP UPDATE DP1 057800 L,H2 A0,FLF . LOGICAL IF NESTING LEVEL L,M A3,1 OR,S3 A3,LGIEXT,A0 . SET FLAG FOR LABELS WITHIN IF S,S3 A4,LGIEXT,A0 . JGD A0,$-2 . MARK ALL ACTIVE IF LOOPS L,H1 A4,2,A1 . RESTORE A4 SCR20U L,M A12,0,A1 LMJ B11,GENDP2 SZ A12 TNZ FEQ HAS ANY COMMON VARIABLE BEEN EQUIVALENT 057900 J SCAR21 -NO 058000 L,H1 A3,CREDP -YES 058100 A A3,(02300000) EQUIVALENCE DP ID 058200 SSC A3,21 058300 S A3,DPBUF,*B9 058400 S,H1 B1,CREDP 058500 S,H1 B1,3,A1 058510 SCAR21 AND,M A4,0400 D3 058800 JNZ A5,SCAR23 IS THIS A FUNCTION 058900 TNE A13,GXX -YES, IS X=( 059000 J SCAR22 --YES 059100 AND,M A4,02001 CSC22 TE,M A5,02001 DEFINE FUNC CSC22 J SCR21 NO CSC22 SR R8,STRING,*B5 OUTPUT DUMMY ITEM CSC22 AU A1,(0102040,0) CSC22 S A2,STRING,*B5 OUTPUT FUNCTION INDIC CSC22 J SCAR12 CSC22 SCJR21 L,M A5,1 SHOW FUNC REF SO STORAGE ASSIGNED S,H1 A5,3,A1 J SCAR21 SCR21J AND,M A4,7 TNE,M A5,6 SKIP FOR INTRINSIC FUNCTION J SCAR21 L A0,GXX TNE,M A0,',' TEST FOR USE OFFUNCTION AS ARGUMENT J $+3 TE,M A0,')' J SCAR21 L,M A0,0,B1 SEQUENCE NUMBER SN,H1 A0,3,A1 PSUEDO DEFINITION POINT J SCAR21 SCR21 JZ A7,SCR22 IS S2 SET CSC22 L A0,GXX -YES 059300 TNE,M A0,',' IS X=, 059400 J $+3 -YES 059500 TE,M A0,')' -NO, X=) 059800 J SCR22 --NO 059900 AND,M A4,7 TEST FOR NON DEINTRINSIFIED MAGIG FUNCTION TNE,M A5,6 J SCAR12 AND,M A4,0206 060000 SN,H2 A5,3,A1 JNZ A5,SCAR12 IS THIS A STATEMENT FUNCTION 060100 SCR22 LMJ B11,PERR FUNCTION WITHOUT ARGUMENTS 060200 FORM6 031,49,SYMV 060300 J SCAR82 SCAR22 L FNXT,R8 GENSUB SCR23 S R15,A7 SET S2 061200 A,M B10,1 UP FUNCTION LEVEL GENSUB SZ CHSFQ . CLEAR FLAG THAT SHOWS CHARACTER APPEAR L A5,N1FLDX S A5,SVN1FL AND,M A4,04001 TEST FOR STATEMENT FUNCTIONS GENSUB TE,M A5,04001 . CAN APPEAR TO LEFT OF EQUALS J $+3 S A5,FLDEQ . FLAG FOR DEFINE TO LEFT OF EQUALS S B10,N1FLDX LEVEL AT WHICH FUNCTION REFERENCED GENSUB AND,M A4,04006 GENSUB TNE,M A5,04006 S B10,N1FLDX GENSUB JZ A10,$+3 ONLY SET FLAG TO LEFT OF EQUALS TNE,M A5,04006 S A5,FLDEQ FLAG FOR FLD TO LEFT OF EQUALS L,M A0,0 TNE,M A5,04001 L A0,A1 S A1,SFCID S,1 A0,SCARPD,B6 SAVE FOR DP OF DEFINED VARIABLE S,S1 A7,SCARPD,B6 . SIMULATE S,T3 SZ,S1 SCARPD,B6 L,S3 A0,2,A1 S,S3 A0,SCARPD,B6 SAVE TYPE OF FUNCTION L A2,B6 . SIMULATE S,T2 B6 S,S4 A2,SCARW+1,B6 . W(J+1) = J SSL A2,6 S,S3 A2,SCARW+1,B6 SZ,JZ SCARZ+1,B7 Z(N+1)=0 061410 SZ,JX SCARX+1,*B7 X(N+1)=0, N=N+1 061500 L A2,B7 . SIMULATE S,T1 B7 S,S2 A2,SCARU+1,B6 . U(J+1) = N SSL A2,6 S,S1 A2,SCARU+1,B6 S,JY A14,SCARY+1,B6 Y(J+1)=ABNORM 061700 S,JQ A15,SCARQ+1,*B6 Q(J+1)=SPECIAL COMMA, J=J+1 061800 AU A1,OPERAT+8 F30 COLON 061900 S A2,STACK,*B8 062000 L,H2 A0,SCARR+2 A,M A0,1 TZ LIST S,H2 A0,SCARR+2 S R15,A6 SET UNARY 062100 J SCAR12 062200 SCAR23 JNZ A14,SCR2T3 IS SUBROUTINE ABNORMAL L,M A12,0,A1 -NO, OUTPUT DEFINITION POINT LMJ B11,GENDP2 SZ A12 GENSUB S R15,A14 SET ABNORM SCR2T3 TZ B10 GENSUB J SCAR24 TRANSFER NON ZERO FUNCTION LEVEL GENSUB L A0,ST TE,M A0,16 . TEST FOR CALL STMT J SCAR24+2 --YES 062500 TNE A13,GXX IS X=( 062600 J SCAR22 -YES 062700 J SCAR12 062800 SCAR24 TE A13,GXX IS X=( 062900 J SCAR12 -NO 063000 LMJ B11,PERR ILLEGAL SUBROUTINE 063100 FORM6 031,50,SYMV 063200 J SCAR82 IGNORE STATEMENT EXIT 063300 SCAR25 LMJ B11,PERR ILLEGAL FUNCTION REFERENCE 063400 FORM6 032,52,SYMV 063500 J SCAR82 IGNORE STATEMENT EXIT 063600 SCAR26 TNE A13,GXX UNDIMENSIONED VARIABLE 063700 J SCAR34 X=(, AN ERROR 063800 TN,XH2 2,A1 IS THIS AN INDUCTION VARIABLE 063900 J SCAR11 -NO 064000 SZ A12 -YES, T1=0 064100 JNZ A10,SCAR28 A AND B SET 064200 SCAR27 L A2,(010000,0) -NO 064300 L,S3 A3,2,A1 SSL A3,3 . TEST IF IND VAR IS REAL TE,M A3,1 J SCAR11 L,S5 A3,2,A1 . SIMULATE A,T3 A2,2,A1 LSSL A3,6 A,S6 A3,2,A1 A A2,A3 S A2,STRING,*B5 064500 J SCAR1 064600 SCAR28 LMJ B11,PERR REDEFINING INDUCTION VARIABLE 064700 FORM6 030,53,SYMV 064800 DSL A9,72 RESET A AND B 064900 J SCAR27 065000 SCAR30 AND,M A2,01000 L,S3 A4,2,A1 . TEST FOR CHARACTER TYPE SSL A4,3 TNE,M A4,6 J SCAR10 JNZ A4,SCR30J . COULD NOT BE CHARACTER L,S6 A4,2,A1 . GET TYPE FROM TYPE STATEMENT TE,M A4,060 J SCR30J . WAS NOT TYPED CHARACTER A,S3 A4,2,A1 S,S3 A4,2,A1 . ADD TYPE TO SYM TABLE J SCAR10 . GO BUILD SUBSTRINGS SCR30J JNZ A3,SCAR20 -ARGUMENT IS A FUNCTION 065200 TE A13,GXX IS X=( 065300 J SCAR10 -NO 065400 TZ,H2 3,A1 IS ARGUMENT DIMENSIONED 065500 J SCAR11 -YES 065600 AND,M A2,070 . ARG USED AS VARIABLE JNZ A3,SCAR34 . YES-FATAL ERROR A,S6 A2,2,A1 TYPE FOR TYPE SATEMENT SCR30Y TZ FNA CHANGE TO SUBROUTINE A,M A2,0100 SET ABNORMAL BIT 065800 A,M A2,01000 SET F 065900 S,H1 A2,2,A1 066000 J SCAR20 066100 SCAR31 L,S6 A15,2,A1 INTRINSIC FUNCTION -- SPECIAL COMMA 066200 TE A13,GXX 066210 J SCR311 066300 SCR31J AND,M A2,01000 X=( JZ A3,SCR31S . HAS FUNCTION BEEN REFERENCED TNZ FLG -YES, IS NAME IN LOCAL TABLE 066600 J SCR20 --YES, ITS STILL INTRINSIC 066700 SCR31S AND,M A2,04000 . CHECK FOR FUNCTIONS LIKE FLD JNZ A3,SCR20Q SCR31 JNZ A10,SCR310 A AND B SET 066800 OR,M A2,01000 -NO, SET F 066900 S,H1 A3,2,A1 067000 J SCR20 067100 SCR310 TZ FLG 067200 LMJ B11,GLS INSERT IN LOCAL TABLE 067300 J $+2 NOT IN 067400 SLJ BUG IN -- CANT HAPPEN 067500 SZ,S2 2,A1 067600 SZ,S3 2,A1 067700 SZ,H2 2,A1 CLEAN UP MAGIC LIBRARY NAME SZ 3,A1 J SCAR36 067800 SCR311 . THE NEXT SECTION DOES NOT DEINTRINSIFY A MAGIC FUNCTION . IF IT IS USED AS A FUNCTION ARGUMENT L,S4 A3,2,A1 TEST FOR MATH FUNCTION TNE,M A3,077 J $+3 TN,XH2 2,A1 J SCR31K JZ A7,SCR31K THIS IS PART OF AN EXPRESSION L A0,GXX TNE,M A0,',' J SCR31J TNE,M A0,')' J SCR31J SCR31K TNZ FLG J SCAR32 -NO 068000 LMJ B11,GLS -YES, INSERT IN LOCAL 068100 J $+2 068200 SLJ BUG CANT HAPPEN 068300 SCR312 SZ,S2 2,A1 CHANGE MODE TO VARIABLE 068400 SZ,S3 2,A1 068500 SZ,H2 2,A1 CLEAN UP MAGIC LIBRARY NAME SZ 3,A1 J SCAR11 068600 SCAR32 AND,M A2,01000 068700 JZ A3,SCR312 HAS FUNCTION BEEN REFERENCED 068800 SCAR33 LMJ B11,PERR -YES, ERROR 068900 FORM6 032,52,SYMV J SCAR11 069100 SCAR34 LMJ B11,PERR ERROR--UNDIMENSIONED 069200 FORM6 031,55,SYMV VARIABLE WITH SUBSCRIPT 069300 AND,M A2,06000 069500 JNZ A3,SCAR82 IS VARIABLE COMMON OR EQUIV. 069600 AND,M A2,7 TNE,M A3,5 J SCR30Y TZ FNA -NO, CHANGE CLASS TO SUBPROGRAM 069700 A,M A2,0100 SET ABNORMAL BIT 069800 A,M A2,2 EXTERNAL SUBPROGRAM CLASS 069900 S,H1 A2,2,A1 070000 J SCAR20 070100 SCAR35 L A0,3,A1 PARAMETER 070200 L,M A2,020 OR,S2 A2,2,A1 SET BIT TO SHOW REFERENCE S,S2 A3,2,A1 L,M A11,1 A A11,SUVC S A11,SUVC S A0,GITV 070300 SZ A12 JZ A10,SCAR49 INSERT AS AN INTEGER 070400 TNZ,H2 CRSD1 . C OPTION TZ MACNO J $+3 LMJ B11,PERR . GIVE WARNING - REDEFINING PARAMETER FORM6 030,247,SYMV L A0,0,A1 S A0,PGETV L,M A0,PA021 SET TO RETURN TO PARAMETER STATEMENT L,M A2,PH304 MAKE NUMBER AS IF PARAMETER S,1 A0,SCARR+5 S,H2 A2,PAEX SET EXIT OF PARAMETER STATEMENT TNZ MACNO TNZ FLF THERE HAS TO BE A VALID STATEMENT WITHIN LOGICAL IF J SCAR84 LMJ B11,PERR FORM6 032,273,SYMV . PARAMETER VAR. ON LOGICAL IF J SCAR84 . 070800 . TRANSFER HERE IF VARIABLE NOT IN SYM OR CLASS UNASSIGNED 070900 SCAR36 L,H1 A2,2,A1 SELECT MODE WORD 071000 AND A2,(0770070) TNE A13,GXX IS X=( 071200 J SCAR37 GENSUB L,M A11,1 UB A A11,SUVC UB S A11,SUVC COUNT VARIABLES IN SUBSCRIPT UB S,H1 A3,2,A1 SET VARIABLE CLASS 071400 J SCAR11 071500 SCAR37 RES 0 TNZ SUDM JNZ A10,SCR37+1 TZ FNA ARE ALL FUNCTIONS ABNORMAL A,M A3,0100 SET ABNORMAL BIT A,M A3,2 -NO -- EXTERNAL FUNCTION 071900 S,H1 A3,2,A1 072000 AND,M A3,070 TNE,M A4,060 J SCAR10 J SCAR20 072100 SCR37 JZ A10,SCR8V NO, IT IS NOT A STATEMENT FUNCTION TZ SUDM J SCR8V NOT A STATEMENT FUNCTION IF WITHIN SUBSCRIPT LMJ B11,GLS MAKE STATEMENT FUNCTION LOCAL NOP SCR37Q. SZ A3 J SCAR38 DEF* SZ FEB SLJ SCARS LMJ B11,PSDP OUTPUT LABEL IF ANY SR R15,DEF2Z NON ZERO IN DEFINE LMJ B11,GIT GIT VARIABLE CSC22 J SCAR42 EOS-ERROR CSC22 TE,M A2,3 VARIABLE CSC22 J SCAR42 NO-ERROR CSC22 L A4,GITV TNZ FMP J DEF5B LMJ B11,SLT +CRLHL J DEF5A NOT IN DEF5C L,S3 A2,2,A1 AND,M A2,7 IN SYMBOL TABLE TNE,M A3,7 J DEF5D . GO TEST NAMELIST DEF5E L,M A1,0,A1 S A1,SYMV NAME IS MULTIPLY DEFINED LMJ B11,PERR IN SHOULD NOT BE FORM6 032,2,SYMV J SCAR82 DEF5B LMJ B11,SLT +CRGHL J DEF5A J DEF5C DEF5D L,H1 A2,2,A1 AND,M A2,0777 TNE,M A3,0577 J DEF5E . GO GENERATE ERROR MESSAGE DEF5A L A0,GXX TNE A0,A13 IF RIGHT PARENTHESIS INSTEAD OF J DEF8 = TREAT AS STATEMENT FUNCTION TE,M A0,36 = NEXT CSC22 J SCAR42 NO- ERROR CSC22 LMJ B11,GLS NOP . PREVIOUS USE DIAGNOSTIC PUT OUT ABOVE DEF5 LA A3,OPERAT+6 LEFT PAREN CSC22 SA A3,STACK,*B8 OUTPUT LEFT PAREN TO STACK CSC22 SA A1,DEFT SET DEFINE FUNC TAG CSC22 L,M A3,02001 CSC22 J SCAR38+1 DEF8 SZ FEB MAKE LOOK LIKE ARITHMETIC STATEMENT L,M A2,15 LEFT PAREN ITEM NUMBER L A0,OPERAT-9,A2 S A0,STACK,*B8 LMJ B11,GLS NOP . PREVIOUS USE ABOVE J SCR37 SCAR38 A,M A3,1 THIS IS A STATEMENT FUNCTION 072200 L,H1 A4,2,A1 IF DEFINE WAS TYPED AND,M A4,070 . INSERT TYPE A A3,A5 S,S3 A3,2,A1 SSC A3,6 STORE INTO BITS L-17 DO NOT DESTROY SEARCH COUNT S,S2 A3,2,A1 L FNXT,R8 RESET NEXT S A1,A8 . SET STFUN FLAG WITH LOCATION IN SYMBOL TABLE S A1,DERFL SZ SFOP . NON ZERO WHEN OPERATORS IN STATEMENT FUNCTION L,M B4,PRESYM+64 . MAKE ROOM FOR A MAX OF 64 ARGUMENTS MTFSYM LXI B4,(-1) MTFSYM S,H2 B4,2,A1 ADDRESS OF ARGUMENTS 072800 AN,M B4,1 ARGUMENTS ARE STORED ONE ABOVE SZ,H1 STARG GENSUB S,H2 B4,STARG 072900 L,M B10,0 073000 L A14,(070,0) 073100 TNZ FXL ANY EXECUTABLE STATEMENTS YET 073110 J SCAR39 -NO, OK 073120 TZ DEF2Z J SCAR39 LMJ B11,PERR -YES, ERROR 073130 FORM6 02,54,0 . FILE FATAL ERROR CSC17 J SCAR82 . IGNORE STATEMENT CSC17 SCAR39 TZ DEFT DEFINE FUNC CSC22 J SCR41Z YES CSC22 LMJ B11,GIT GET NEXT DUMMY ARGUMENT CSC22 J SCAR42 EOS -- ERROR 073300 TE,M A2,3 IS THIS A VARIABLE 073400 J SCAR42 GENSUB L,H1 A5,STARG INCREMENT ARGUMENT COUNT GENSUB A,M A5,1 GENSUB S,H1 A5,STARG GENSUB L A4,GITV -YES, PICK UP SYMBOL 073600 L,S4 A2,SUANT3,A0 075400 S A4,0,*B4 . SAVE ARGUMENT FOR SEARCHING L FNXT,R8 RESET NEXT J SCAR41,A2 075800 SCAR41 J SCR42 ERROR J SCAR39 X=, 076000 J SCR41 X=) 076100 J SCAR42 X=1, ERROR 076110 SCR41Z SZ FNXT SET SO EQUALS CAN BE RESCANNED GENSUB SCR41 L B4,(4,0) . RESET INDEX J SCAR0 076400 SCR42 TNE,M A0,36 J SCR41Z TREAT=AS ( SCAR42 LMJ B11,PERR GARBAGE IN STATEMENT FUNCTION 076500 FORM6 01,43,0 076600 J SCAR82 IGNORE STATEMENT EXIT 076700 . 077300 . THIS SECTION IS USED WHEN MULTIPLICATION IS IMPLIED. 077400 . THE CURRENT ITEM IS SAVED AND AN * IS INSERTED IN 077500 . THE POLISH STRING. 077600 SCAR46 S A0,IMPMUL+3 SAVE X 077700 S A2,IMPMUL SAVE ITEM NO. 077800 L A0,GITV SAVE ITEM VALUE 077900 S A0,IMPMUL+1 078000 L A0,GITV+1 078100 S A0,IMPMUL+2 078200 S R15,FIMP SET GIT FLAG 078300 TZ DERFL J SCAR82 L,M A2,11 * ITEM NUMBER 078400 LMJ B11,PERR FORM6 01,157,0 J SCAR68 078500 . 078600 . IF THE EXECUTABLE STATEMENT FLAG IS RESET AND SCAR IS 078700 . NOT AT THE BEGINNING OF A STATEMENT, THE STATEMENT FUNCTION 078800 . ARGUMENT TABLE IS SCANNED FOR VARIABLES BEFORE THE 078900 . SYM TABLE IS SCANNED. 079000 . 079100 SCAR47 L,H1 R1,STARG NUMBER OF ARGUMENTS 079200 L A1,(-1,0) A,H2 A1,STARG LOCATION OF FIRST ARGUMENT 079500 L A14,GITV 079510 SE A14,0,*A1 J SCAR8 NOT AN ARGUMENT 079700 L,M A1,SCAR2 . FORCE TO LOOK AT SOMETHING WITHIN ADDR TE A13,GXX IS X = ( 079800 J SCR471 . OUTPUT ITEM REPRESENT IS RELATIVE LOCTN SCR47 L A4,GITV LMJ B11,SLT + CRLHL J $+2 J SCR472 LMJ B11,SLT + CRGHL J SCR473 SCR472 TNZ,H2 3,A1 . TEST FOR DIMENSIONS J SCR473 L,S2 A3,2,A1 AND,M A3,7 TNE,M A4,1 TEST FOR SINGLE DIMENSION J SCR471 LMJ B11,PERR FORM6 0,160,0 J SCR471 SCR473 LMJ B11,PERR FORM6 2,161,0 . DIMENSIONS MUST OCCUR FIRST J SCAR82 . EXIT WITHOUT FINISHING STATEMENT SCR471 L,H1 A2,STARG . NUMBER OF ARGUMENTS AN A2,R1 GENSUB L,M A11,0,B10 AN A11,N1SBLV SUBSCRIPT LEVEL S,S4 A11,(0430000,0) SSL A11,6 S,S3 A11,(0430000,0) . SIMULATE S,T2 S,S6 A2,(0430000,0) SSL A2,6 S,S5 A2,(0430000,0) . SIMULATE S,T3 L A2,(0430000000000) S A2,STFAG J SCR10 . 080300 . ITEM IS AN INTEGER CONSTANT 080400 SCAR48 JZ A6,SCAR46 IS UNARY SET 080500 SZ A6 -YES, RESET UNARY 080600 SZ A12 T1=0 080700 JNZ A10,SCAR53 080800 L A5,GITV TG,M A5,7 J $+4 TE,M A0,'R' TNE,M A0,'L' J SCAR85 TNE,M A0,'H' GENSUB J SCAR85 GENSUB SCAR49 L A5,GITV GENSUB SLJ SCR49S GENSUB S A1,STRING,*B5 GENSUB J SCAR1 GENSUB SCR49R LMA A4,A5 REENT TG,M A4,04000 GENSUB J SCAR50 GENSUB TP A5 GENSUB A A4,(4,0) GENSUB A A4,(030100,0) 081500 L A1,A4 GENSUB J *SCR49S GENSUB SCAR50 S A5,('SVASGN') SAVE SIGN L A0,CRCRFT S A0,SVCRFT SZ CRCRFT LMJ B11,SLT + CRIHL 082000 LMJ B11,SLTI 082100 L A0,SVCRFT S A0,CRCRFT L,M A0,013 082200 S,S3 A0,2,A1 SET INTEGER MODE 082300 A A1,(030000,0) 082400 TP ('SVASGN') A A1,(4,0) GENSUB J *SCR49S GENSUB . 082700 . ITEM IS A LOGICAL CONSTANT 082800 SCAR51 JZ A6,SCAR52 IS UNARY SET 082900 SZ A6 GENSUB SZ A12 083100 TNZ B10 GENSUB S R15,LOAR -YES, SET E 083300 L A0,('TRUE ') 083400 L A2,SYMTRU .TRUE. F30 ITEM 083500 TE A0,GITV IS ITEM TRUE 083600 L A2,SYMFAL -NO, USE .FALSE. F30 ITEM 083700 S A2,STRING,*B5 083800 JNZ A10,SCAR53 ARE A AND B SET 083900 J SCAR1 -NO, GET NEXT ITEM 084000 SCAR52 LMJ B11,PERR 084100 FORM6 010,59,GITV 084200 J SCAR51+1 084300 SCAR53 LMJ B11,PERR ILLEGAL EQUATION 084400 FORM6 01,56,0 084500 J SCAR82 IGNORE STATEMENT EXIT 084600 . 084700 . ITEM IS A COMPLEX CONSTANT 084800 SCAR54 JZ A6,SCAR46 IS UNARY SET 084900 SZ A6 -YES, RESET UNARY 085000 SZ A12 085100 S R15,CRCD SET COMPLEX-DOUBLE FLAG 085210 JNZ A10,SCAR53 085200 L A4,GITV 085300 L A5,GITV+1 085400 LMJ B11,SL2T SEARCH FOR CONSTANT 085500 + CRCHL 085600 LMJ B11,SL2TI INSERT (IF NOT IN) 085700 L,M A0,043 085800 J SCR56 SET COMPLEX MODE WORD 085900 . 086000 . ITEM IS A DOUBLE PRECISION CONSTANT 086100 SCAR55 JZ A6,SCAR46 IS UNARY SET 086200 SZ A6 -YES, RESET UNARY 086300 SZ A12 086400 S R15,CRCD SET COMPLEX-DOUBLE FLAG 086410 JNZ A10,SCAR53 086500 L A4,GITV 086600 L A5,GITV+1 086700 LMJ B11,SL2T SEARCH FOR CONSTANT 086800 + CRDHL 086900 LMJ B11,SL2TI INSERT (IF NOT IN) 087000 L,M A0,033 087100 S,S3 A0,2,A1 SET DOUBLE PRECISION MODE 087200 A A1,(030000,0) 087300 S A1,STRING,*B5 087400 L,S1 A0,SCARU,B6 . SIMULATE L,T1 LSSL A0,6 A,S2 A0,SCARU,B6 TNZ,H2 CRCOMP 087600 S,JX R15,SCARX,A0 SET DBL PRECISION PROPAGATE FLAG 087700 J SCAR1 087800 . 087900 . ITEM IS A REAL CONSTANT 088000 SCAR56 JZ A6,SCAR46 IS UNARY SET 088100 SZ A6 -YES, RESET UNARY 088200 SZ A12 088300 JNZ A10,SCAR53 088400 L A4,GITV 088500 LMJ B11,SLT SEARCH FOR CONSTANT 088600 + CRRHL 088700 LMJ B11,SLTI INSERT (IF NOT IN) 088800 L,M A0,023 088900 SCR56 S,S3 A0,2,A1 SET REAL MODE 089000 A A1,(030000,0) 089100 S A1,STRING,*B5 089200 L,S1 A0,SCARU,B6 . SIMULATE L,T1 LSSL A0,6 A,S2 A0,SCARU,B6 TZ,H1 CRCOMP S,JZ R15,SCARZ,A0 SET REAL PROPAGATION FLAG 089500 J SCAR1 089600 . . . ITEM IS // CONCATENATION SC56CT JNZ A6,SCAR1 SZ A7 J SCAR58 . CLEAN ITEMS OUT OF STACK . 089700 . ITEM=+ 089800 SCAR57 JNZ A6,SCAR1 GENSUB SC58SP SZ A7 GENSUB TNZ SUDM TEST IF PLUS IS PART OF SUBSCRIPT GENSUB J SCAR58 NO GENSUB S A2,SUPLFL SHOW SPECIAL PLUS ON MINUS J SCAR58 CLEAN ALL OF TERM OUT OF STACK GENSUB SC58SC SLJ SCRCLN MULTIPLY TERM BY DIMESNION PRODUCT GENSUB L A2,SUPLFL S A2,SUPLFG SAVE TO NEGATE NEXT TERM GENSUB SZ SUPLFL J SCAR1 GENSUB . 090100 . AT THIS POINT THE OPERATOR JUST RETURNED BY GIT IS COMPARED 090200 . WITH THE LAST OPERATOR IN STACK. IF THE STRENGTH OF 090300 . THE FORMER IS GREATER THAN THE STRENGTH OF THE LATTER THE 090400 . OPERATOR IS ADDED TO STACK. OTHERWISE THE LAST ITEM 090500 . IN STACK GOES TO STRING AND THE ABOVE TEST IS MADE WITH 090600 . THE ITEM NOW LAST IN STACK. 090700 SCAR58 JNZ A10,SCR69 SCR58 JNZ A8,SCR58A . WE WERE IN STATEMENT FUNCTION L,M A14,0,B8 . IF STACK HAS OVERFLOWED, SHORT TG,M A14,MSTACK . GO EDIT FATAL. SHORT J SCR82X SHORT L A14,STACK-1,B8 L,S1 A1,STACK-1,B8 IS ITEM STRENGTH 090910 TG,S1 A1,OPERAT-9,A2 GREATER THAN STACK(K) STRENGTH 091000 J SCAR59 -NO 091100 TNE,M A2,18 -YES, IS ITEM ) 091200 J SCAR61 --YES 091300 S R15,A6 --NO, SET UNARY 091400 TZ SUPLFL J SC58SC GENSUB TNE,M A2,10 IS ITEM- 091500 J SCAR66 -YES 091600 L A3,OPERAT-9,A2 -NO, SELECT F30 ITEM 091700 L,S1 A4,SCARU,B6 . SIMULATE A,T1 SCARU,B6 LSSL A4,6 A,S2 A4,SCARU,B6 L,S3 A5,OPERAT-9,A2 . SIMULATE TN,T2 TOP,M A5,040 . DOES THIS OP HAVE MODE INFO A A3,A4 . YES, ATTACH MODE ADDRESS S A3,STACK,*B8 GENSUB J SCAR1 GET NEXT ITEM 092100 SCR58A L,M A11,0,B10 GENSUB TLE A11,N1FLDX GENSUB SR R15,SFOP . MARK THAT OPERATOR APPEARED JNZ A11,SCR58+1 L A14,(077746637000) SSL A14,0,A2 TEST FOR ARITHMETIC OPERATORS JNB A14,SCR58+1 SR R15,SFOP J SCR58+1 SCAR59 L,S4 A3,STACK-1,B8 . SIMULATE TP,XH2 TEP,M A3,040 . IS STACK ITEM UNARY J SCAR60 -YES, COMPLIMNENT S(I) 092300 S A14,STRING,B5 092400 L,M A3,010 S,S1 A3,STRING,*B5 . CHANGE ID TO 8 A B8,(-1) K=K-1 092600 J SCR58+1 SCAR60 LA,S2 A4,STACK-1,B8 TE,M A4,22 . IS STACK ITEM UNARY .NOT. J SCR60D . NO (FORMERLY SCAR60) LA,S1 A4,STRING-1,B5 TE,M A4,8 . IS STRING ITEM AN OPERATOR J SCR60A . NO LA,S2 A4,STRING-1,B5 TNE,M A4,15 TEST FOR SUBSCRIPTED CONNECTOR J SCR60E TNE,M A4,16 J SCR60F-1 TEST IF FUNCTION TYPED LOGICAL TLE,M A4,10 . CHECK FOR LOGICAL OR TLE,M A4,2 . RELATIONAL OPERATION J SCR60C . ERROR--ILLEGAL .NOT. J SCR60D . (FORMERLY SCAR60) SCR60A TE,M A4,3 . IS STRING ITEM A CONSTANT J SCR60B . NO LA,S2 A4,STRING-1,B5 TE,M A4,2 . IS STRING ITEM A LOGICAL CONSTANT J SCR60C . NO, ERROR J SCR60D . YES,OK (FORMERLY SCAR60) SCR60B TE,M A4,2 . IS STRING ITEM A VARIABLE J SCR60C . NO,ERROR LA,H2 A3,STRING-1,B5 . YES, CHECK MODE SCR60F LA,S3 A3,2,A3 . GET MODE WORD T AND C SSL A3,3 . CHECK T=TYPE TNE,M A3,5 . FOR LOGICAL J SCR60D . YES, OK (FORMERLY SCAR60) SCR60C TNE,M A4,043 DEFINE ARGUMENT J SCR60D LMJ B11,PERR . NO ERROR FORM6 010,65,('.NOT. ') ILLEGAL USE OF .NOT. SCR60D LA A4,(4,0) . SIGN BIT (FORMERLY SCAR60) L,S2 A5,STACK-2,B8 TNE,M A5,10 TEST FOR BINARY MINUS J SCR60J SCR60K XOR A4,STRING-1,B5 S A5,STRING-1,B5 093300 A B8,(-1) K=K-1 093400 J SCR58+1 SCR60E L A3,LSSVL J SCR60F SCR60J TOP A4,STRING-1,B5 J SCR60K L A0,STRING-1,B5 L,S3 A0,2,A0 SSL A0,3 TE,M A0,5 J SCR60K XOR A4,STACK-2,B8 S A5,STACK-2,B8 AN,M B8,1 J SCR58+1 SCAR61 A B8,(-1) K=K-1 093600 TNE A14,OPERAT+7 TEST FOR SEMICOLON TO END SUBSCRIPT GENSUB J SCRSLN PROCESS END OF SUBSCRIPT GENSUB TNE A14,OPERAT+6 IS STACK(K+1) = ( 093610 J SCR62Q SLJ GENDP1 -NO, STACK(K) = COLON 093800 SZ A12 T1=0 093810 L,S3 A12,SCARW,B6 . J =W(J) LSSL A12,6 A,S4 A12,SCARW,B6 LXM B6,A12 . SIMULATE LXM,T2 B6 L,1 A12,SCARPD,B6 GENSUB L,S1 A7,SCARPD,B6 LSSL A7,6 A,S2 A7,SCARPD,B6 L A0,SVN1FL S A0,N1FLDX SZ CHSYM . CLEAR CHARACTER INDICATOR AN,M B10,1 GENSUB S A14,STRING,B5 094100 L,M A0,010 S,S1 A0,STRING,*B5 . CHANGE ID TO 8 TNZ CHSYM . TEST FOR COMPLETING CHARACTER FUNCTION J SCAR62 LMJ B11,SGX1 . SAVE CHARACTER POINTERS LMJ B11,GX . GET NEXT CHARACTER TO TEST FOR SUBSTRI NOP . EOS OF NO GREAT INTEREST TE,M A0,'(' J SCRSLQ . NO SUBSTRING DEFINITION GIVEN J SCDUST . SIMULATE A COMMA AND CONTINUE SCAR62 TNZ,M 0,B8 J SCR62J TNZ LIST J SCAR1 L A0,FLDF9 TE,M A0,14 J SCAR1 SCR62J TZ PARFLG J SCAR63 SHORT TNZ IFDEF . IF STATEMENT TZ NEOS J SCAR63 LMJ B11,PERR TO MANY REIGHT PARENTHESIS FORM6 0,60,0 . 095000 . POLISH STRING AND DEFINITION POINT LIST GENERATION ARE 095100 . FINISHED. THE POLISH STRING IS NOW SCANNED TO ATTACH MODE 095200 . INFORMATION TO OPERATOR ITEMS. 095300 SCAR63 L R2,(0770040,0) 095400 L A0,(1,0) 095500 L,M R1,0,B5 NUMBER OF ITEMS IN STRING 095600 L A1,(0100000,0) OPERATOR ITEM WITH MODE ADDRESS 095700 SCAR64 MSE A1,STRING,*A0 095800 J SCAR83 095900 L,S5 A2,STRING-1,A0 . SELECT ADDRESS OF MODE BITS LSSL A2,6 A,S6 A2,STRING-1,A0 . SIMULATE L,T3 SZ A3 096100 TZ,JZ SCARZ,A2 IS REAL FLAG SET 096200 L,M A3,2 -YES, SET REAL BIT 096300 TZ,JX SCARX,A2 IS DOUBLE PRECISION FLAG SET 096400 L,M A3,1 -YES, SET DOUBLE PRECISION BIT 096500 OR,S3 A3,STRING-1,A0 096540 S,S3 A4,STRING-1,A0 096600 J SCAR64 096700 SCAR66 L,S1 A4,SCARU,B6 . U(J) LSSL A4,6 A,S2 A4,SCARU,B6 A A4,OPERAT + ITEM 097200 S A4,STACK,*B8 097300 L A4,OPERAT+20 UNARY MINUS ITEM 097400 S A4,STACK,*B8 097500 J SCAR1 GET NEXT ITEM 097600 SCR62Q L,M A0,0,B10 TLE,M A0,2 J SCAR62 TNZ SUPRFL J SCAR62 SZ SUPRFL AN,M B10,1 L A0,N1SBLV AN,M A0,1 S A0,N1SBLV J SCAR62 . 097700 . ITEM =- GENSUB SCAR67 SZ A7 RESET S2 097900 JZ A6,SC58SP IS UNARY SET GENSUB L A2,OPERAT+20 -YES, SELECT UNARY MINUS ITEM 098100 S A2,STACK,*B8 098200 J SCAR1 098250 . 098300 . ITEM=*,/,OR** 098400 SCAR68 SZ A7 RESET S2 098500 TE,M A2,12 . TEST DIVIDE OPERATOR JZ A6,SCAR58 098600 L,S1 A4,GEICFL . TEST FOR DATA STATEMENT TE,M A4,077 J SCAR68J SZ FNXT . LET LIST REREAD / L,M A2,18 . PLAY LIKE IT WAS A RP L,M A0,'/' TZ PARFLG . REPLACE PARFLG WITH DELIMITER S A0,PARFLG . SAVE DELIMITER FOR LIST S A0,PARFLG J SCAR58 SCAR68J JZ A6,SCAR58 SCAR69 L R1,OPERR-9,A2 ERROR-ILLEGAL USE OF OPERATOR 098700 LMJ B11,PERR 098900 FORM6 010,65,R1 GENSUB J SCAR1 GET NEXT ITEM 099100 SCR69 L,M A11,0,B10 GENSUB TLE A11,N1FLDX GENSUB J SCAR69 J SCR58 . OPERATORS AT OR ABOVE FLD FUNCTION LEVEL OK . . . COLON OPERATOR SCAR70C TNZ CHSYM . TEST FOR ACTIVE CHARACTER J SCAR69 . ILLEGAL OPERATOR L,M A2,14 . SET AS IF COMMA . DROP THRU TO COMMA CODE . 099200 . ITEM = , GENSUB SCAR70 JNZ A6,SCAR69 IS UNARY SET GENSUB TNZ SUDM TEST FOR BEING IN SUBSCRIPT GENSUB J SCR70S GENSUB L,M A2,18 SIMULATE ')' TO CLEAR STACK AT EACH COMMA GENSUB S A2,COMFLG GENSUB J SCAR58 IN A SUBSCRIPT GENSUB SCR70C . GENSUB SZ COMFLG GENSUB A,M B8,1 REPLACE SEMICOLON ON STACK GENSUB SLJ SCRREW . CLEAN UP THIS DIMENSION GENSUB SR R15,A6 RESET UNARY GENSUB L A0,SUCMT GENSUB AU,M A0,1 GENSUB S A1,SUCMT INCREASE COMMA COUNT GENSUB TG A1,SUDMLT GENSUB J SCAR1 . TOO MANY SUBSCRIPTS A A0,SUDM GENSUB L,S1 A4,0,A0 . TEST IF CURRENT DIM IS A CONSTANT CTABD TE,M A4,1 GENSUB J SCR70V NO VARIABLE GENSUB L A5,SUELSZ GENSUB TZ,S2 0,A0 CTABD J $+3 GENSUB MSI,H2 A5,0,A0 CTABD J $+2 GENSUB MSI,H2 A5,*0,A0 . STILL IN PARAM FORM CTABD S A5,SUELSZ GENSUB J SCAR1 GENSUB SCR70V S A4,SUVRDM SET FLAG FOR AT LEAST ONE VAR DIMENSION GENSUB J SCAR1 GENSUB SCR70S . GENSUB TNZ B10 GENSUB J SCAR71 NO IS FUNCTION LEVEL ZERO GENSUB SZ,JX SCARX+1,B7 --NO, X(N+1)=0 099600 SZ,JZ SCARZ+1,*B7 Z(N+1)=0, N=N+1 099700 L A0,B7 . SIMULATE S,T3 B7 S,S2 A0,SCARU+1,B6 . U(J+1)=N SSL A0,6 S,S1 A0,SCARU+1,B6 . L,S3 A3,SCARW,B6 . W(J+1) = W(J) S,S3 A3,SCARW+1,B6 L,S4 A3,SCARW,B6 S,S4 A3,SCARW+1,*B6 SLJ GENDP1 GENERATE DEFINITION POINT 100100 S R15,A7 SET S2 100200 SZ A12 T1=0 100300 L,JQ A0,SCARQ+1,A3 ATTACH Q(W(J)+1) TO COMMA 100400 S,S6 A0,OPERAT+5 100500 J SCAR58 100600 SCAR71 TZ PARFLG J SCR71J LMJ B11,PERR FORM6 0,62,0 IGNORE IT 100800 J SCAR1 100900 SCR71J L,M A2,',' S A2,PARFLG SET AS TERMINATOR FOR STATEMENT J SCAR78 . 101000 . ITEM = LEFT PARENTHESIS 101100 SCAR72 L,H2 A0,SCARR+2 A,M A0,1 TNZ SUPRFL J SCR72B A,M B10,1 . PARENTHSES IN SUBSCRIPT L A1,N1SBLV A,M A1,1 S A1,N1SBLV S B10,SUPRFL SCR72B TZ LIST S,H2 A0,SCARR+2 JNZ A10,SCAR69 JZ A6,SCAR46 IS UNARY SET 101300 L A0,OPERAT-9,A2 S A0,STACK,*B8 S J SCAR1 . 101700 . ITEM = RIGHT PARENTHESIS 101800 SCAR73 L,H2 A0,SCARR+2 AN,M A0,1 TZ LIST S,H2 A0,SCARR+2 TNZ SUDM GET CLOSING PARENTHESIS FOR SUBSCRIPT GENSUB TNZ PARFLG J $+4 GENSUB L,M A0,')' TNZ B10 GENSUB S A0,PARFLG JZ A6,SCAR58 LA,M A0,0,B8 . CHECK STACK FOR ONLY 1 OPERATOR TE,M A0,1 J SCR73A . MORE THAN 1 OPERATOR LR R1,(') ') . ONLY 1 OPERATOR, THE ')' LMJ B11,PERR . ORIGINALLY PUT THERE, MUST STAY FORM6 012,1,R1 J SCAR1 SCR73A LMJ B11,PERR . ERROR, UNARY SET FORM6 01,69,0 102100 A B8,(-1) K=K-1, IGNORE PREVIOUS 102200 J SCAR58 OPERATOR 102300 . 102400 . ITEM = = 102500 SCAR74 TZ FEB . EQUATION J SCAR7X . NO-ERROR L,M A0,0,B8 . YES SZ IFDEF SZ DERFL TNE,M A0,1 IS K=1 102700 J SCR74Z SCAR7X TZ PARFLG J SCAR83 LMJ B11,PERR FORM6 011,65,('= ') ILLEGAL USE OF = J SCAR82 IGNORE STATEMENT EXIT 103100 SCR74Z TNZ FLDEQ SEE IF DEFINITION POINT TO BE PUT OUT J SCR58+1 S B5,('SVB5 ') L,S6 A4,FLDEQ . TEST IF DEFINE OR FLD TNE,M A4,1 A,M B5,1 . SKIP COMMAS IF DEFINE SCR74P L,S1 A0,STRING-3,B5 LSSL A0,6 A,S2 A0,STRING-3,B5 . SIMULATE L,T1 L A4,GITV NAME OF LAST VARIABLE FOUND TNE,M A0,01020 CHECK FOR FLD OF DEFINED VARIABLE J SCR74Y TNE,M A0,01021 J SCR74Q TE,M A0,01017 J SCR74G L A4,LSSV . NAME OF LAST SUBSCRIPTED VARIABLE SCR74F LMJ B11,GLG1+1 J SCR74V SCR74X S A2,('SVA2 ') L A12,A1 LMJ B11,GENDP2 L A2,('SVA2 ') L B5,('SVB5 ') J SCR58+1 SCR74Y L,H2 A1,STRING-3,B5 SYM TABLE LOCATION OF FUNCTION S A1,SYMV SAVE FOR POSSIBLE DIAGNOSTIC S A2,('SVA2 ') L,H1 A2,2,A1 AND,M A2,04001 TE,M A3,04001 J SCR74X+3 . NOTHING TO DEFINE BUT NOT ILLEGAL L,H2 A2,2,A1 LIN TO POLISH MASK AND,M A2,077777 L,H2 A1,SYM,A3 SYM TABLE LOC OF BASIC VARIABLE JZ A1,SCR74X+3 J SCR74X+1 SCR74V L A0,FLDF1 CHECK LAST OPRAND TYPE TE,M A0,3 J SCAR25 INVALID FUNCTION REFERENCE SLJ N1BUG SCR74Q AN,M B5,1 J SCR74P SCR74G SSL A0,6 . EXTRACT ID OF FILE ITEM TE,M A0,2 . TEST FOR VARIABLE TNE,M A0,1 . TEST FOR INDUCTION VARIABLE J SCR74F . LOOK UP SYM ADDRESS J SCR74X+4 . AN EXPRESSION NOTHING TO DEFINE . 103200 . ITEM= .AND.,.OR. 103300 SCAR75 SZ,JX SCARX+1,B7 X(N+1)=0 103400 SZ,JZ SCARZ+1,*B7 Z(N+1)=0, N=N+1 103500 L A3,B7 . SIMULATE S,T1 B7 S,S2 A3,SCARU+1,B6 . W(J+1) = W(J) SSL A3,6 S,S1 A3,SCARU+1,B6 L,S3 A3,SCARW,B6 . W(J+1) = W(J) S,S3 A3,SCARW+1,B6 L,S4 A3,SCARW,B6 . S,S4 A3,SCARW+1,B6 . 103900 . ITEM = RELATIONAL OPERATORS GENSUB SCAR76 JNZ A6,SCAR69 IS UNARY SET 104100 TNZ B10 GENSUB S R15,LOAR --YES, SET E (LOGICAL FLAG) 104300 SZ A7 RESET S2 104400 J SCAR58 104500 . ITEM =.NOT. 104700 SCAR77 TZ B10 GENSUB J $+3 SR R15,LOAR J SCR58+1 YES SZ A7 RESET S2 105000 JNZ A6,SCAR58 IS UNARY SET 105100 LMJ B11,PERR -NO, ERROR--NON-UNARY .NOT. 105200 FORM6 011,65,('.NOT. ') ILLEGAL USE OF .NOT. J SCAR1 105400 . 105500 . TRANSFER HERE AT END OF STATEMENT 105600 SCAR78 JNZ A6,SCAR80 IS UNARY SET 105700 L,M A2,18 ITEM NUMBER FOR ) 105800 TZ,S1 IFDEF . TEST FOR IF STATEMENT J SCR78J SCR78K TZ NEOS IS THIS FIRST EOS 105900 J SCAR79 -NO, ERROR--TOO MANY ( 106000 S R15,NEOS SET F 106100 J SCR58+1 SCR78J L,M A3,0,B8 TLE,M A3,2 J SCR78K SCAR79 LMJ B11,PERR 106300 FORM6 01,61,0 TOO MANY LEFT PARENTHESES 106400 J SCAR82 IGNORE STATEMENT EXIT 106500 SCAR80 L,S2 A2,STACK-1,B8 F30 OPERATOR NUMBER 106600 A B8,(-1) K=K-1 106700 L,S5 A2,SCART1-1,A2 GIT OPERATOR NUMBER 106800 SZ A6 RESET UNARY 106900 J SCAR69 107000 . TRANSFER HERE IF STACK HAS OVERFLOWED. SHORT . SHORT SCR82X LMJ B11,PERR SHORT FORM6 012,93,('STACK ') STACK TABLE OVERFLOWED . 108400 . IGNORE STATEMENT EXIT 108500 SCAR82 SZ ST 108600 SZ DERFL CLEAR FLAG L A1,A8 TG,M A8,2 SZ,S3 2,A1 L A8,ST . STORE ZERO IN A8 CSC17 LMJ B11,PERR FORM6 2,250,0 INFORM USER THAT THIS WAS FATAL J SCAR84 EXIT 108700 SCAR83 TZ PARFLG DONT SET ST IF A PARRAMETER STMT J SCAR84 L,M A0,1 SET STATEMENT ARITHMETIC TZ LOAR IS STATEMENT LOGICAL 108900 L,M A0,3 -YES 109000 TZ A8 ANY EXECUTABLE STATEMENTS 109100 A,M A0,1 -NO, THIS IS A STATEMENT FUNCTION 109200 S A0,ST 109300 L A0,(0100100,0) F30 = 109400 TZ FEB WAS THERE AN= 109500 S A0,STRING,*B5 -NO, OUTPUT= 109600 SCAR84 L B4,SCARR 109700 L B6,SCARR+1 109800 L B7,SCARR+2 109900 L B8,SCARR+3 110000 L B10,SCARR+4 110100 S A8,STFUFL . SAVE FLAG OF BEING IN STATEMNT FUNCTION DL A6,SCARR+6 DL A8,SCARR+8 DL A10,SCARR+10 DL A12,SCARR+12 DL A14,SCARR+14 SZ DEF2Z TZ PARFLG SZ STFUFL J *SCARR+5 EXIT 111200 . 111300 . PICK UP HOLLERITH ARGUMENT 111400 SCAR85 L FNXT,R8 S A0,HCTYP L A15,GITV NUMBER OF CHARACTERS JZ A15,SCAR89 LMJ B11,GETSYM GET NEXT SYM REF L A4,A15 LMJ B11,HOLL J SCAR88 SCR85Q TZ FRMFLG . ALLOW LONG LISTIN FORMAT J SCR85B TNZ LIST TZ B10 FUNCTON LEVEL J SCAR8T TEST FORINTRINSIC FUNCTION SCR85A . TZ,H1 CRFLD . TEST IF CHARACTER DIRECTIVE APPEARED J SCR85B TLE,M A15,7 J SCR100 ONE WORD LMJ B11, PERR FORM6 0,214,0 SCR85B L,H2 A0,GTSYMA . SYM TABLE ADDRESS ASSIGNED AU A0,(030000,0) F30 CONSTANT ITEM S A1,STRING,*B5 L A4,HOLOUT+1 SAVE FIRST WORD OF HOLLERITH CONST FOR INT USE S A4,0,A1 S,H1 A15,3,A0 . SAVE LENGTH IN CHARACTERS L,M A14,2 . FIELDATA FLAG FOR HOLERITH STRINGS TZ FDASQT L,M A14,3 . ASCII FLAG FOR HOLERITH STRINGS S,S1 A14,3,A0 A,M A15,11 CONSDIER SENINAL WORD OF ALL SEVENS L,M A14,0 DI,M A14,6 . GET LENGTH IN WORDS S,S6 A14,2,A0 . SET LENGTH IN SYMBOL TABLE SSL A14,6 S,S5 A14,2,A0 . SIMULATE S,T3 L,M A1,0367 S,H1 A1,2,A0 . MARK AS HOLERITH CONSTNAT L A0,(1,HOLOUT) L,M A1,15 . LENGTH L,M A2,0 . NO TRAILING CONTROL WORDS L,M A3,0 . FORCE TO FIELDATA LMJ B11,W60F . INSERT ITEM IN F60 J SCAR1 GETSYM TZ,H1 GTSYMA J GTSYB A LOC WAS AVAILABLE FROM BEFORE SLJ TSCSYM L,H2 A0,CRSYM AU,M A0,4 S,H2 A1,CRSYM ADVANCE LOCATION L,M A1,3 MARK AS CONSTANT S,H1 A1,2,A0 TO AVOID DIAGNOSTIC GETSYC AU A0,(020000,0) S,H2 A0,GTSYMA S A1,HOLOUT MARK FOR HOLERITH CONSTANT L,M A3,HOLOUT+1 J 0,B11 GTSYB L,H1 A0,GTSYMA SZ,H1 GTSYMA J GETSYC SCAR88 LMJ B11,PERR EOS BEFORE END OF CONSTANT 115100 FORM6 01,72,0 115200 L,M A0,07777 S,H1 A0,HOLOUT MARK TO PHASE 6 THAT STATEMENT ERRORER L A0,(1,HOLOUT) L,M A1,15 . LENGTH L,M A2,0 . NO TRAILING CONTROL WORDS L,M A3,0 . FORCE TO FIELDATA LMJ B11,W60F . INSERT ITEM IN F60 J SCAR82 IGNORE STATEMENT EXIT 115300 SCAR89 L A0,(' ') ZERO CHARACTERS 115400 S A0,GITV INSERT WORD OF BLANK AND PROCESS 115500 LMJ B11,PERR FORM6 01,99,0 J SCAR49 LIKE AN INTEGER CONSTANT 115600 SCAR90 JZ A8,SCAR25 ANY EXECUTABLE STATEMENTS 115700 TE A13,GXX X=( 115710 J SCAR25 -NO, ERROR 115720 TNZ FLG -NO, IS VARIABLE GLOBAL 115800 J SCAR91 --NO 115900 LMJ B11,GLS --YES, MAKE LOCAL STATEMENT FUNCTI116000 L,H1 A2,2,A1 116100 J SCR37Q SCAR91 TE,M A3,2 IS C=2 116300 J SCAR25 -NO, ERROR 116400 TN,XH2 2,A1 IS I6=0 116600 J SCAR25 -YES, ERROR 116700 AND A2,(0770170) 116800 J SCAR38 116900 SCAR8T L,S3 A2,SCARW,B6 . SIMULATE L,T2 LSSL A2,6 A,S4 A2,SCARW,B6 L,S3 A0,SCARPD,A2 AND,M A0,7 TNZ LIST ALLOW NH IN IO LISTS TE,M A1,6 J SCR85B L A0,SFCID L A0,0,A0 TE A0,('LOC ') J SCR85A J SCR85B . . ITEM IS A QUOTE, I.E. HOLLERITH LITERAL . ITEM IS A QUOTE IE HOLERITH LITERA; SCARQQ TNZ,H1 UNTFMT UNIT NO. BEING SCANNED J $+3 L,M A2,072 QUOTE IS TERMINATOR J SCR71J+1 PUT IN PARFLG JZ A6,SCAR46 JNZ A10,SCAR53 SZ A6 RSET UNARY SZ A12 T1 NOT A VARIABLE LMJ B11,GETSYM GET AVAILABLE LOC IN SYM LMJ B11,QUOTE GET QUOTE STRING ANDPLACE IN J SCRHA L,M A15,2000 AN A15,A4 COMPUTE LENGTH OF QUOTE STRING J SCR85Q SCRHA LMJ B11,PERR FORM6 01,72,0 HOLLERITH FIELD NOT ENDED J SCAR84 SCR100 L A4,HOLOUT+1 L A5,GTSYMA S,H1 A5,GTSYMA SAVEFOR FUTURE USE S A4,GITV IN PARAMETER TREAT HOLERITH AS INTEGER TZ PARFLG AS INTEGERS SO LINKS WIIL ONLY BE MADE ON INTEGER J SCAR49 HEAD LINK LMJ B11,SLT SEARCH FOR CHRCTRS UNDER BOOL HEAD LINK + CRBHL LMJ B11,SLTI INSERT UNDER SAME HEAD LINK L,M A0,063 T,C = BOOLEAN CONSTANT L,M A1,0,A1 S,S3 A0,2,A1 L,M A0,040 S,S2 A0,2,A1 SET EQUIVALENCE BIT TO DIFFERENTIATE BETWEEN . FRACTIONAL AND HOLERITH A A1,(030000,0) S A1,STRING,*B5 J SCAR1 SCARSR S B4,SCARR REENT S B6,SCARR+1 CSC22 S B7,SCARR+2 CSC22 S B8,SCARR+3 CSC22 S B10,SCARR+4 CSC22 S,H2 B11,SCARR+5 DS A6,SCARR+6 DS A8,SCARR+8 DS A10,SCARR+10 DS A12,SCARR+12 DS A14,SCARR+14 L B4,(4,0) CSC22 L B6,(1,0) CSC22 L B7,(1,0) CSC22 L B8,(1,0) CSC22 SZ STARG CSC22 SZ,S1 SCARU . SIMULATE SZ,T1 SZ,S2 SCARU SZ,JX SCARX CSC22 SZ,JZ SCARZ CSC22 S R15,A6 SET UNARY L A7,FXL EXEC STMT FLAG XOR A7,R15 SZ A7 RESET S2 SZ B10 INITIALIZE FUNCTION LEVEL GENSUB SZ CHSFQ . CLEAR FLAG THAT INDICATE CHARACTER STR S R15,A9 GENSUB XOR A9,FEB SET A AND B SZ A11 G=0 SZ A12 T1=0 L,M A13,'(' SZ LOAR CALL STMT ARITH TO BEGIN WITH SZ NEOS RESET F SZ FLDEQ GENSUB TNZ LIST J *SCARS L,XH2 A3,SCARR+2 L,M A2,15 JGD A3,$+2 J *SCARS L A0,OPERAT-9,A2 S A0,STACK,*B8 J $-4 . THIS SUBROUTINE IS ENTERED AFTER A PRODUCT OTO INSERT A PRODUCT GENSUB . OF DIMENSIONS TIMES ELEMENT SIZE. IF THE LAST ITEM IN STRING IS AGENSUB . CONSTANT AND THE LAST OPERATOR IN STACK IS '(' , ',' OR UNARY MINUS GENSUB . THEN THE CONSTANT IS ADDED TO THE OFFSET GENSUB SCRCLR L,S1 A0,STRING-1,B5 REENT TNZ SUVRDM MUST MULTIPLY IF VARIABLE DIMENSINS UB TE,M A0,3 GENSUB J SCRCLA GENSUB L,XH2 A3,STRING-1,B5 GENSUB TZ,S2 STRING-1,B5 GENSUB J SCRCLC SKIP TEST OF INTEGER GENSUB L,S3 A4,2,A3 SSL A4,3 GENSUB TE,M A4,1 GENSUB J SCRCLA GENSUB L A3,0,A3 GET VALUE OF CONSTANT GENSUB SCRCLC . UB L,M A5,4 TEP,S3 A5,STRING-1,B5 LN A3,A3 L A5,SUPLFG UB TNE,M A5,10 UB LN A3,A3 COMPLIMENT IF TERM SHOULD BE NEGATED UB SZ SUPLFG UB SCRCLB TZ EQTFLG . TEST FOR EQUIVALENCE STATEMENT J SCRCLBE . GO PROCESS EQUIVALENCE SCRCLBG MSI A3,SUELSZ A A3,SUALOF ADD CURRENT TERM TO ACCUMULATED OFFSET GENSUB S A3,SUALOF GENSUB AN,M B5,1 GENSUB J SCRCLN THRO ITEM IN STRING AWAY GENSUB SCRCLBE L A5,SUCMT . CURRENT COMMA COUNT A,M A5,1 TE A5,SUDMLT TLE A5,SUDMLT . NUMBER OF DIMENSIONS J SCRCLBG . PROCESS NORMALLY L A5,EQTFLG TEST MODE OF IDENTIFIER TE,M A5,7 . TEST FOR CHARACTER J SCRCLBG . AN,M A3,1 . CORRECT ONE TO ZERO RELATIVE OFFSET SN A3,EQTFLG . SAVE CHARACTER OFFSET AN,M B5,1 . THROW ITEM IN STRING AWAY J SCRCLN SCRCLA . NO OPTIMIZATION POSSIBLE MULTIPLY BY PRODUCT OF DIMESIONS GENSUB . AND OFFSET UP TO THIS POINT GENSUB SR R15,R3 SHOW ONE OPERAND GENSUB SLJ SCRPUR GENSUB L A5,SUELSZ GENSUB L A4,SUPLFG TEST IF TERM SHOULD BE NEGATED GENSUB TNE,M A4,10 GENSUB LN A5,A5 GENSUB SZ SUPLFG GENSUB SLJ SCR49S CONVERT TO INTEGER CONSTANT ITEM GENSUB S A1,STRING,*B5 GENSUB L A1,(0101440,0) S A1,STRING,*B5 L A1,(0101240,0) GENSU S A1,STRING,*B5 INSERT PLUS FOR EACH TERM GENSU J *SCRCLN GENSUB SCRSLN . THIS SECTIO IS CALLED AT SEMICOLON TO CLEAN UP A SUBSCRIPTGENSUB TZ COMFLG GENSUB J SCR70C TEST IF COMMA AND NOT RIGHT PARENTHESIGENSUB SLJ SCRREW CLEAN OUT LAST TERM GENSUB L A0,(0102340,0) . OFFSET PLUS GENSUB L,M A1,01012 TEST FOR PLUS GENSUB L,S1 A5,STRING-1,B5 . SIMULATE TNE,T1 LSSL A5,6 A,S2 A5,STRING-1,B5 TNE A1,A5 S A0,STRING-1,B5 REPLACE PLUS WITH OFFSET PLUS GENSUB S A14,STRING,*B5 OUTPUT SEMICOLON GENSUB L,M A0,01017 TYPE FOR OP CODE GENSUB S,S2 A0,STRING-1,B5 SSL A0,6 S,S1 A0,STRING-1,B5 L A0,SUNS FLAGS FOR PHASE 3 TO INDICATE TYPE OF SUBSGENSUB S,S6 A0,STRING-1,B5 GENSUB L A5,SUALOF ACCUMULATED OFFSET GENSUB TLE,XH2 A5,CRMXOF . DETERMINE MAX NEGATIVE OFFSET S,H2 A5,CRMXOF SLJ SCR49S CONVER TO FILE ITEM GENSUB L A0,SUOFL LOCATION OF OFFSET ITEM GENSUB S A1,STRING,A0 GENSUB L,M A4,4 GENSUB S,S1 A4,STRING,A0 CHANGE TO OFFSET ITEM GENSUB L A1,STRING-1,A0 ADDRESS OF ARRAY GENSUB L,S3 A4,2,A1 . PASS MODE TO TEST FOR CHARACTER L,M A1,0,A1 TNE,H2 A1,N5RGFB L,M A4,1 TNE,H2 A1,N5RGFC L,M A4,1 S,S5 A4,STRING-1,B5 . ON 1017 ITEM L,S1 A4,STRING-1,A0 TEST FOR DUMMY ARGUMENT TNE,M A4,043 J SCRDMY L A5,0,A1 NAME OF ARRAY GENSUB SCRDMA S A5,LSSV NAME OF LAST SUBSCRIPTED VARIABLE S A1,LSSVL SYM LOC OF LAST SUBSCRIPTED VAR GENSUB L A5,SUCMT . CURRENT COMMA COUNT IAGMG A,M A5,1 IAGMG TNZ EQTFLG . NO TEST IN EQUIV. STMT TNE A5,SUDMLT IAGMG J SROKK TLE A5,SUDMLT TOO MANY OR TOO FEW J SRLTH LMJ B11,PERR FORM6 012,12,LSSV . TOO MANY SUBSCRIPTS J SROKK SRLTH LMJ B11,PERR FORM6 030,120,LSSVL TOO FEW SUBSRCIPTS SROKK SZ SUDM L A0,SUELSZ S A0,LSELSZ SZ SUDGFL PREVENT ERRONEOUS DIAGNOSTICS SZ SUPRFL SZ SUELSZ SZ SUDMLT CTABFH L A7,SUSVA7 L A0,SVN1FL S A0,N1FLDX AN,M B10,1 GENSUB L,M A12,0,A1 L A0,N1SBLV AN,M A0,1 S A0,N1SBLV DECREASE SUBSCRIPT LEVEL SZ A6 . A SUBSCRIPT IS LIKE A VARIABLE IT IS AN OPERANGENSUB TNZ CRSPSU TEST FOR DIAGNOSING SUBSCRIPT GENSUB J SCRSLX GENSUB L,M A4,1 GENSUB TOP,S2 A4,SUBT2+1,B10 GENSUB J SCRSLX GENSUB LMJ B11,PERR GENSUB FORM6 030,45,LSSVL SCRSLX TNZ EQTFLG . NO IMPLIED SUBSTRINGS IN EQIUV TNZ CHSYM . TEST IF ARRAY WAS CHARACTER J SCRSLY . IT WAS NOT LMJ B11,SGX1 . SAVE CHARACTER POINTERS LMJ B11,GX . GET NEXT CHARACTER TO TEST FOR SUBSTRI NOP . SUBSTRING DEFINITION TE,M A0,'(' J SCRSLQ . NO SUBSTRING DEFINITION GIVEN J SCDUST . SIMULATE A COMMA AND CONTINUE SCRSLQ . LMJ B11,RGX1 . RESTORE CHARACTER POINTER J SCDXST . BUILD IMPLIED SUBSTRING SCRSLY . TNZ B10 TNZ PARFLG GENSUB J SCAR62 GENSUB L A0,GXX GENSUB TZ A0 S A0,PARFLG GENSUB TZ EQTFLG . NO EXPRESSIONS IN EQUIVALENCE J SCAR84 . GIVE UP TNZ SBSCRP DO LOOP LIMIT FLAG IN LIST TZ LIST J SCAR62 J SCAR84 SCRDMY L A1,STRING-1,A0 . SIMULATE LN,T3 SSC A1,12 SSA A1,24 LN A1,A1 A,H2 A1,STARG A,M A1,1 L A5,0,A1 J SCRDMA . THIS ROUTINE GENERATES A RIGHT HAND POLISH STRING OF POLISH GENSUB . FOR THE VARIABLE DIMENSIONS IN A SUBSCRIPT. THE START OF GENSUB . THE DIMENSIONS IS IN SUBM AND THE NUMBER IS IN SUCMCT GENSUB SCRPRR L A1,(1,0) REENT LXM A1,SUDM GENSUB L A2,SUCMT GENSUB L,M A3,0 FLAG FOR MULTIPLY OPERATOR GENSUB JGD A2,$+2 GENSUB J *SCRPUR GENSUB SCRPR2 L,S1 A4,0,*A1 CTABD TNE,M A4,1 GENSUB J SCRPR3 DIMENSION WAS A CONSTANT GENSUB AN,M A1,1 CTABD L,H2 A4,0,*A1 CTABD A A4,(027700,0) FLAG FOR VARIABLE DIMENSION GENSUB S A4,STRING,*B5 GENSUB L A4,(0101440,0) TZ R3 GENSUB S A4,STRING,*B5 S R15,R3 GENSUB SCRPR3 JGD A2,SCRPR2 GENSUB J *SCRPUR GENSUB . THIS ROUTINE IS CALLED AT A COMMA OR TERMINATING PARENTHESIS GENSUB . FOR A SUBSCRIPT GENSUB . ITE GENERATES POLISH TERMS WHICH WILL SUBTRACT THE PRESENT GENSUB . DIMENSION MULTIPLIER GENSUB SCRRWR SZ R3 COUNT OPERANDS TO DETERMINE NUMBER OF MULTIPLIERSREENT SLJ SCRCLN . OUTPUT VARIABLE DIMENSIONS FOR PREVIOUS TERGENSUB TNZ SUVRDM . TEST IF ANY VARIABLE DIMENSIONS GENSUB J SCRRWA NO VARIALBE DIMENSINS GENSUB SZ R3 GENSUB SLJ SCRPUR GENSUB LN A5,SUELSZ GENSUB SLJ SCR49S CONVERT TO FILE ITEMS GENSUB S A1,STRING,*B5 GENSUB L A1,(0101440,0) S A1,STRING,*B5 L A1,(0101240,0) PLUS ITEM GENSUB S A1,STRING,*B5 GENSUB J SCRRWB GENSUB SCRRWA LN A5,SUELSZ SUBTRACT CURRENT DIMENSION MULTIPLIER GENSUB A A5,SUALOF ACCUMULATED OFFSET GENSUB TN EQTFLG . SET NEGATIVE FOR CHARACTER OFFSET S A5,SUALOF GENSUB SCRRWB . GENSUB J *SCRREW GENSUB SUBTYP L,M A4,0 ERROR GENSUB L,M A4,1 INTEGER GENSUB L,M A4,1 REAL GENSUB L,M A4,2 DOUBLE PRECISION GENSUB L,M A4,2 COMPLEX GENSUB L,M A4,1 LOGICAL GENSUB LMJ B11,CHGTLN . GET THE LENGTH OF THE CHARACTER ELEMEN L,M A4,0 UNASSIGNED GENSUB CHGTLN* . . GET THE ELEMENT LENGTH OF A CHARACTER IDENTIFIER. IF THE LENGTH . IS A CONSTANT PLACE IT IN A4. OTHERWISE LOAD A4 WITH 0777777 AS . A FLAG THAT THE LENGTH IS A VARIABLE. L,H2 A0,3,A1 . POINTER TO DYNAMIC STORAGE L,M A1,0,A1 TE,H2 A1,N5RGFB TNE,H2 A1,N5RGFC J CHGTLJ L,S3 A4,2,A1 . TEST FOR INTRINSIC FUNCTION AND,M A4,7 TNZ EQTFLG . USE ONE FOR ELEMENT LENGTH IN EQUIVALE TNE,M A5,6 J CHGTLJ . IT WAS AN INTRINSIC FUNCTION L,S2 A4,2,A1 . NUMBER OF DIMENSIONS IF ANY AND,M A4,7 . EXTRACT DIMENSIONS A A0,A5 L,S1 A2,1,A0 . SIMULATE L,T1 LSSL A2,6 A,S2 A2,1,A0 . ID OF LENGTH POINTER L,M A4,1 . GIVE UNIT LENGTH TO CHARACTER TE,M A2,0301 L,M A4,0777777 J 0,B11 CHGTLJ L,M A4,1 J 0,B11 $(2) . STFAG +0 . NON ZERO IF LAST VARIABLE WAS STATEMENT FUNCTION EQUQAL FLDEQ +0 NON ZERO IF FLD TO LEFT OF EQUALS DEF2Z +0 NON ZERO FOR DEFINE FLDF1 +0 TYPE OF LAST OPERAND FLDF9 +0 . LAST SYNTATIC TYPE DERFL +0 NON ZERO IF IMPLIED MULTIPLICATION SHOULD BE FATAL SQTFLG + 0 . ZERO FOR X11, NZ FOR QUOTES SCARQC RES 1 COMFLG +0 SET NON ZERO TO CLEAR STACK IN SUBSCRIPTS GENSUB N1SBLV +0 GENSUB CUFCLV +0 FUNCTION LEVEL AT START OF SYNTACTIC UNIT GENSUB SCR49S* J $-$ . ALSO REFERENCED BY N1CHAR J SCR49R REENT SCARS J $-$ REENT J SCARSR REENT SCRCLN J $-$ REENT J SCRCLR REENT SCRREW J $-$ REENT J SCRRWR REENT SCRPUR J $-$ REENT J SCRPRR REENT . . . THIS SECTIONS TAKES ANSI SYNTAX FOR A SUBSTRING IDENT(F,L) AND . GENERATES POLISH AS IF USER HAD WRITTEN SUBSTR(EXP,F,L) SCDUST . DUMMY UP CORRECT POLISH L A2,CHSYM . SYMPOINTER TO CHARACTER IDENT L,M A5,1 A,H2 A5,SCARR+2 TZ LIST S,H2 A5,SCARR+2 . UP PARENTHESIS FOR LIST PROCESSING L A3,CHSFQ . LOCATION OF CHARACTER PACKET SCDUSQ AU A3,(070000,0) . PASS CHARACTER LOCATION PACKET S A4,STRING,*B5 L A4,(0102100,014) . CHARACTER COMMA OPERATOR TZ A10 A,M A4,1 . SET DIFFERENT COMMA LEFT OF EQUALS S A4,STRING,*B5 L FNXT,R8 . THROW AWAY PARENTHESIS L,M A2,016 . NUMBER FOR COMMA SZ A12 . INHIBIT DEFINITION POINTS SZ A6 . FUDGE TO ALLOW OPERATOR TO APPEAR DSL A9,72 . CLEAR A9 AND A10 J SCAR70 . ASSUME WE JUST SAW A COMMA . THE FOLLOWING BUILDS POLISH TO SIMULATE A SUBSTRING . THAT IS EQUIVALENT TO THE ENTIRE STRING SCDXST . L A3,CHSFQ . LOCATION OF CHARACTER PACKET SCDXSQ AU A3,(070000,0) . PASS CHARACTER LOCATION PACKET S A4,STRING,*B5 L A4,(0102100,014) . CHARACTER COMMA OPERATOR TZ A10 A,M A4,1 . SET DIFFERENT COMMA LEFT OF EQUALS S A4,STRING,*B5 L A0,(030100,1) . REPRESENTS FIRST CHARACTER POSISTION S A0,STRING,*B5 S A4,STRING,*B5 L A0,1,A3 . FILE ITEM REPRESENTING LENGTH S A0,STRING,*B5 L A0,(0032100,014) . SUBSTRING COMMA TZ A10 A,M A0,1 S A0,STACK,*B8 . ADD TO STACK SO ) WILL WORK DSL A9,72 L,M A2,18 . SIMULATE CLOSING PARENTHESIS SZ A12 . INHIBIT DEFINITION POINT GENERATION SZ A6 . FUDGE TO ALLOW OPERATOR TO APPEAR J SCAR58 . SCAR2,SUANT1,SLIST2 . S1 SBN TYPE OF SUBSCRIPT ITEM ST . S2 LST ITEM IN DATA LITERALS . S3 MUST BE 0 . S4-6 SCR JUMP TABLE-ITEM TYPE . $(1) . SCAR2* FORM2 0,8,0,SCAR3 -ERR/R FORM2 0,8,0,SCAR6 -$ (ERROR) 042700 FORM2 0,8,0,SCAR4 -STATEMENT LABEL 042800 FORM2 1,10,0,SCAR7 . VARIABLE FORM2 5,4,0,SCAR48 -INTEGER CONSTANT FORM2 0,5,0,SCAR51 -LOGICAL CONSTANT 043100 FORM2 0,7,0,SCAR54 -COMPLEX CONSTANT 043200 FORM2 0,6,0,SCAR55 -DBL. PREC. CONSTANT 043300 FORM2 0,0,0,SCAR56 -REAL CONSTANT 043400 FORM2 3,2,0,SCAR57 -+ FORM2 2,3,0,SCAR67 -- FORM2 0,8,0,SCAR68 -* 043700 FORM2 0,1,0,SCAR68 -/ 043800 FORM2 0,8,0,SCAR68 -** 043900 FORM2 0,8,0,SCAR70 -, 044000 FORM2 0,8,0,SCAR72 -( 044100 FORM2 0,9,0,SCARQQ QUOTE FORM2 0,8,0,SCR5 -UNASSIGNED 044300 FORM2 4,8,0,SCAR73 -) FORM2 0,8,0,SCAR74 -= 044500 FORM2 0,8,0,SCAR76 -.EQ. 044600 FORM2 0,8,0,SCAR76 -.NE. 044700 FORM2 0,8,0,SCAR76 -.GT. 044800 FORM2 0,8,0,SCAR76 -.GE. 044900 FORM2 0,8,0,SCAR76 -.LT. 045000 FORM2 0,8,0,SCAR76 -.LE. 045100 FORM2 0,8,0,SCAR77 -.NOT. 045200 FORM2 0,8,0,SCAR75 -.OR. 045300 FORM2 0,8,0,SCAR75 -.AND. 045400 FORM2 0,0,0,0 SAVE SPAVE FOR UNARY MINUS FORM2 0,8,0,SC56CT . // CONCATENATION FORM2 0,8,0,SCAR70C . COLON OPERATOR END