$(1) PREQ. PAR* S,H2 B11,PAEX PARAMETER STATEMENT TZ COMPAR IS COMPILER FLAG SET S R15,FOCT YES-SET FLAG FOR OCTAL CONVERSION PA03 PA01 TNZ ST J PA0911 LMJ B11,GIT GET PARAMETER NAME J PA09 EOS EXIT L A0,GITV SAVE PARAMETER NAME S A0,GETV TNE,M A2,3 IS IT A NAME J PA02P LMJ B11,ERR4 NO, TRY TO FIND A NAME J PA09 WE CAN'T PA02P TNZ MACNO J PA02 L A0,GXX L A6,FMP SAVE IF RESET TO MAIN PROGRAM TNE,M A0,':' SZ FMP . SIMULATE MAIN PROGRAM TNE,M A0,'=' J PA02 LMJ B11,GLG J $+2 NOT IN SET TO ZERO J PA02PB L,M A0,014 S,S3 A0,2,A1 S A6,FMP SZ 3,A1 SET INITIAL VALUE TO ZERO PA02PA L A0,GXX L FNXT,R8 . DISCARD SEPARATOR TE,M A0,':' . A COLON TO FORCE GLOBAL MAY BE FOLLOWE J $+4 . BY AN EQUALS AND A VALUE LMJ B11,GX NOP SZ FNXT . IF EQUALS SAVE FOR PA021 L A0,GXX TNE,M A0,'=' J PA021 J PA01 PA02PB L,S3 A0,2,A1 IF PREVIOUS USE AS PARAMETER IGNORE RDEDINIGTION S A6,FMP TE,M A0,014 J PA02PC J PA02PA . PA02 LMJ B11,GLS NAME FOUND, GET SYM LOCATION J PA021 NOT IN LOCAL L,H1 A2,2,A1 IF IN SYM, GET MODE WORD AND,M A2,01007 TNE,M A3,6 IS IT AN INTRINSIC FUNCTION NAME J PA021 YES, OK TZ,H2 CRSD1 . C OPTION J $+3 TNZ MACNO J $+3 TNE,M A3,4 REDEFINITION OF PARAMETER IS OK J PA021 IN MACRO PA02PC . LMJ B11,PERR FORM6 030,2,SYMV J PA0911 PA021* S A1,TSYM SAVE LOC OF PARAMETER ENTRY LMJ B11,GX GIT NEXT CHAR J N1ERXT EOS EXIT TE,M A0,'=' J N1ERR1 NOT AN = SIGN LMJ B11,SCEX SCAN EXPRESION J PA03 L A1,TSYM GET SYM OF PARAMETER L,M A2,014 T=PARAMETER , C=INTEGER S,S3 A2,2,A1 S A3,3,A1 STORE VALUE IN SYM SZ TSYM J PA01 N1ERR1 LMJ B11,PERR FORM6 010,205,GETV NO = SIGN J PA0911 N1ERXT LMJ B11,PERR FORM6 0,4,0 PA0911 LMJ B11,GX J PA09 TE,M A0,',' J PA0911 S R15,ST RESET AS VALID STATEMENT J PA01 PA09 SZ FOCT CLEAR OCTAL FLAG J *PAEX REENT . . . SCEX (SCAN CONSTANT EXPRESIONS) EVALUATES A CONSTANT EXPRESION UP TO A COMMA . AT ZERO PARENTHESIS OR THE CLOSING PARENTHESIS AND LEAVES THE VALUE (IF ANY) . IN A3 CALLING SEQUENCE LMJ B11,SCEX . ERROR RETURN . NORMAL RETURN . SCEX2* S,H2 B11,SCEXER . DON'T PRINT ERRORS SCEX* S,H2 B11,N1TD S A6,('SAVEA6') L A0,CRIHL+1 SAVE INTEGER HEAD LINK S A0,N1TA L A0,(CRBC,CRLC) S A0,CRIHL+1 MAKE DUMMY HEAD LINK L A0,CRSYM SAVE NEXT SYM S A0,N1TC L A0,SYMBRK S A0,N1TE L A1,GTSYMA S A1,('SAVEGT') L B5,(1,0) RESET STRING INDEX S R15,PARFLG SET FLAG FOR SCAR S R15,FEB SET IF STATEMENT FLAG LMJ B11,SCAR SCAN EXPRESION SZ FEB TNZ ST J PA00 YES- ERROR EXIT L,M A0,0,B5 POINTER TO STACK STORAGE JNB A0,N1ERR2 CAN'T HAVE EVEN LENGTH STRING LXI,XM A0,*-1,*0 SET A0 TO GO BACKWARD THRU STACK ANU,M A0,1 S A1,N1TB A0 SHOULD BE HERE WHEN DONE SZ STRING+1,A0 END OF STACK INDICATOR LXI,M B5,0 N1CC JGD B5,N1CA ANY MORE IN STRING L B5,(1,0) TE A0,N1TB NO- IS A0 IN RIGHT PLACE J N1ERR2 NO- AMBIGUITY IN EXPRESION L,M A2,1,A0 YES LMJ B11,N1ITEM FIND VALUE OF ITEM L A1,('SAVEGT') S A1,GTSYMA L,H1 A0,N1TE TE,H1 A0,SYMBRK J N1CC2 L A0,N1TA S A0,CRIHL+1 RESTORE INTEGER HEAD LINK L A0,N1TC S A0,CRSYM RESET NEXT SYM N1CC2 L A6,('SAVEA6') L B11,N1TD SZ SCEXER . CLEAR FLAG J 1,B11 NORMAL EXIT N1CA L,S1 A1,STRING,B5 GET NEXT STRING ITEM TE,M A1,8 IS IT AN OPERATOR J N1CB NO N1CD L A1,STRING,B5 YES- MOVE ITEM TO STACK S A1,STRING,*A0 J N1CC N1CB TE,M A1,2 TNE,M A1,3 J $+2 J N1ERR3 NO- INVALID ITEM L,S1 A2,STRING+1,A0 GET LAST STACK ITEM TNE,M A2,2 J $+3 TE,M A2,3 IS IT AN OPERAND J N1CD NO- ONLY ONE ITEM OF A PAIR L,M A2,0,B5 YES LMJ B11,N1ITEM FIND VALUE OF ITEM L A4,A3 LOAD FIRST OPERAND N1CF L,M A2,1,A0 LMJ B11,N1ITEM FIND VALUE OF ITEM L A6,A3 LOAD SECOND OPERAND N1CG L,S2 A1,STRING+2,A0 GET OPERATOR FROM STACK TG,M A1,14 J N1ERR5 IT IS AN ILLEGAL OPERATOR L,M A3,1 SET DUMMY TRUE EX OPTBL,A1 PERFORM FIRST HALF OF OPERATION L,M A3,0 SET DUMMY FALSE EX OPTBL1,A1 SECOND HALF OF OPERATION N1CJ JO N1ERR6 ERROR-OVER FLOW L,S3 A2,STRING+2,A0 GET SIGN BIT FROM OPERATOR SSC A2,2 TLE,M A1,012 J N1CI N1CI IF OPERATOR LOGICAL L,M A3,0100 JNB A2,N1CE N1CE IF POSITIVE LN A4,A4 ARITHMETIC COMPLEMENT J N1CE N1CI L,M A3,0200 JNB A2,N1CE N1CE IF POSITIVE XOR,M A4,1 L A4,A5 N1CE A,M A0,2 REMOVE LAST TRIAD FROM STACK L,S1 A1,STRING+1,A0 GET NEXT STACK ITEM TE,M A1,2 TNE,M A1,3 IS IT ANOTHER OPERAND J N1CF YES- CONTINUE LM A1,A4 NO- MAKE IT AN ITEM TG,M A1,04000 IS THIS AN IMEDIATE CONSTANT J N1CH NO- MAKE SYM ENTRY A,H1 A3,(030000,0) SSC A4,18 DSC A3,18 S A4,STRING,*A0 PUT OPERAND ITEM OVER OPERATOR IN STACK J N1CC N1CH S A0,('SAVEA0') L A0,CRCRFT S A0,('SVCRCR') SZ,H2 CRCRFT S A4,GITV PLACE CONSTANT FOR SEARCH AND INSERT LMJ B11,SLT + CRIHL LMJ B11,SLTI FIND AND MAKE ENTRY UNDER DUMMY HEAD LNK L,M A2,013 T=INTEGER , C=CONSTANT S,S3 A2,2,A1 A A1,(030000,0) L A0,('SAVEA0') S A1,STRING,*A0 PUT OPERAND ITEM OVER OPERATOR IN STACK L A2,('SVCRCR') S,H2 A2,CRCRFT J N1CC OPTBL J N1ERR5 0 VOID J N1ERR5 1 = OR A4,A6 2 .OR. AND A4,A6 3 .AND. TE A4,A6 4 .EQ. TNE A4,A6 5 .NE. TG A4,A6 6 .LT. TG A6,A4 7 .GT. TLE A4,A6 8 .GE. TLE A6,A4 9 .LE. A A4,A6 10 + DSA A4,36 11 / OPTBL1 MSI A4,A6 12 * J N1EXP 13 ** L A4,A5 2 L A4,A5 3 L A4,A3 4 L A4,A3 5 L A4,A3 6 L A4,A3 7 L A4,A3 8 L A4,A3 9 NOP 10 DI A4,A6 11 NOP 12 N1EXP TNZ A6 FIND A4 ** A6 LEAVE IN A4 J N1ONE TP A6 J N1NEX L A3,A4 AN,M A6,1 L,M A4,1 MSI A4,A3 JGD A6,$-1 J N1CJ N1ONE L,M A4,1 J N1CJ N1NEX JZ A4,N1ERR+1 0 ** -N UNDEFINED LM A3,A4 TE,M A3,1 L,M A4,0 JNB A6,$+2 LM A4,A4 J N1CJ N1ERR* + 0 LMJ B11,SCPERR . FORM6 010,211,GETV DIVISION BY ZERO J PA00 N1ERR2 LMJ B11,SCPERR . FORM6 010,206,GETV AMBIGUITY IN EXPRESION J PA00 N1ERR3 LMJ B11,SCPERR . FORM6 010,207,GETV INVALID ITEM J PA00 N1ERR4 LMJ B11,SCPERR . FORM6 010,208,GETV NON INTEGER ITEM J PA00 N1ERR5 TNE,M A1,17 . TEST FOR COMMA J N1COMA TNE,M A1,16 . TEST FOR FUNCTION J N1FUNC N1ER5X LMJ B11,SCPERR . FORM6 010,209,GETV ILLEGAL OP J PA00 N1ERR6 LMJ B11,SCPERR . FORM6 010,210,GETV OVER FLOW PA00 L A0,N1TA S A0,CRIHL+1 L A6,('SAVEA6') SZ SCEXER . CLEAR FLAG J *N1TD ERROR RETURN N1COMA L,S6 A3,STRING+2,A0 TNE,M A3,1 J N1MOD TNE,M A3,4 J N1SGN TNE,M A3,2 J N1MAX TNE,M A3,3 J N1MIN J N1ER5X N1MAX S A3,COMFLG . SHOW INTRINSIC COMMA TG A6,A4 L A4,A6 J N1CJ N1FUNC TNZ COMFLG J N1ABS SZ COMFLG L A4,A6 J N1CJ N1ABS TE A4,('ABS ') J N1ER5X LM A4,A6 J N1CJ N1MIN S A3,COMFLG TLE A6,A4 L A4,A6 J N1CJ N1MOD S A3,COMFLG DSA A4,36 DI A4,A6 L A4,A5 J N1CJ N1SGN LM A4,A4 S A3,COMFLG TP A6 LN A4,A4 J N1CJ . N1ITEM FINDS THE VALUE OF AN INTEGER OR BOOLEAN CONSTANT ITEM AT STRING+A2 . AND LEAVES IT IN A3 N1ITEM L,XH2 A3,STRING,A2 FIND VALUE OF CONSTANT ITEM TZ,S2 STRING,A2 IS THIS AN IMEDIATE CONSTANT J N1SIGN YES L,H2 A3,STRING,A2 NO- GET SYM L,S3 A3,2,A3 GET MODE TE,M A3,016 . MAX, MIN TNE,M A3,026 . ABS J N1QF TNE,M A3,063 IS IT BOOLEAN J $+3 YES TE,M A3,013 NO- IS IT INTEGER J N1ERR4 NO- NON INTEGER ITEM N1QF . L,H2 A3,STRING,A2 YES L A3,0,A3 LOAD FROM SYM N1SIGN L,S3 A1,STRING,A2 IS SIGN BIT SET SSC A1,2 JB A1,$+2 J 0,B11 L,S2 A1,STRING,A2 TE,M A1,2 J $+4 L A2,A3 XOR A2,(0777777777777) J 0,B11 LN A3,A3 A,M A3,0 J 0,B11 SCPERR TNZ SCEXER . PRINT ERROR? J PERR . YES! J 1,B11 . NO! $(0) PAEX* J $-$ REENT PARFLG* + 0 PGETV* . GETV + 0 N1TA + 0 N1TB + 0 COMFLG +0 N1TC + 0 N1TD + 0 COMPAR* +0 N1TE +0 SCEXER + 0 . PRINT ERRORS? END