COMPILE * /--- FILE TYPE = E * /--- BLOCK COMPILE 00 000 79/11/13 23.15 IDENT COMPILE TITLE COMPILE TUTOR CALC COMPILER * CST COMMON SYMBOL TABLE * EXT LEXADD ADDRESS OF LEX HOOK EXT KEYTYPE LEXICAL KEY LOOKUP ARRAY * * ERROR HANDLING ROUTINES * EXT CHARERR,BADPAR,VARERR EXT FORMERR,EQERR,TEMPERR EXT ALFERR,INDXERR,SEGERR EXT VARTERR,OPTERR,ASIGERR EXT COMPERR,LNGERR,LITERR EXT UNITERR,MATERR,CPXERR EXT TSTERR,NOAERR,SIZERR EXT MNYAERR,MINDERR EXT FIPERR * SYMLST SET 2 * ********************************************************* * KNOWN BUGS-- * (1) CANNOT SUPERSCRIPT CAPITAL LETTERS USING * THE NON-LOCKING SUPERSCRIPT. LOCKING * SUPERSCRIPT DOES PERMIT CAPITAL LETTERS * IN THE EXPONENT. * 'RELATED PROBLEM IS THAT SUB-SUP-SUP IS NOT THE * SAME AS SUP... * 'WOULD BE NICE FOR KG. TO BE TAKEN AS KG'. * (2) SEARCH FOR LITERAL ALREADY IN UNIT MAY FIND * BRANCH-TABLE ENTRY WHICH WILL BE MODIFIED * LATER....IN WHICH CASE -CALC- USES WRONG LIT. * (3) CANNOT USE MATRIX(I,J) AS A FUNCTION ARGUMENT. * ALSO CANNOT SAY ',V+10&3', IF V IS A VECTOR. * (4) B',C', NEEDS IMPLIED MULTIPLY. * * QUIKNUM (2A), CHARSET/RESTART TAGS (2D), COMMA SEPARATOR * IN MATRICES (3F), AND FLOATING-POINT NUMBER INTERPRETING * (15E,F,G,16B,C) ALL USE ',1R'X', WHERE THEY SHOULD BE * USING (PERHAPS'.) SOME OPCODE COMPARISONS..... ********************************************************* * /--- BLOCK PLATO 00 000 81/07/27 21.52 * POINTERS TO EXEC ROUTINES - DEFINED HERE FOR PLATO * PASSED TO THE CONDENSOR THROUGH ECS * IFPLT PLATO * EXT ERXINDX ERROR EXIT, -GETVAR- EXT ALEXLOC EXT SEGMNTI,SEGMNTO,ALOOPS EXT VECEL,MATEL,VECO,MATO EXT ASVARS,ACVARS,ARVARS,ALVARS,AWVARS INSTLNG EQU INFOLTH-ARAYLTH-2 COMPILE INST BUFF LGTH (500-258) * ENTRY LLAERR,LLSEGI,LLSEGO ENTRY LLVECEL,LLMATEL,LLVECO,LLMATO ENTRY LLALOOP,RVARL,LVARN * LLEXLOC EQU ALEXLOC LLAERR VFD 60/ERXINDX LLSEGI VFD 60/SEGMNTI LLSEGO VFD 60/SEGMNTO LLVECEL VFD 60/VECEL LLMATEL VFD 60/MATEL LLVECO VFD 60/VECO LLMATO VFD 60/MATO LLALOOP VFD 60/ALOOPS RVARL VFD 60/RVARLIM LVARN VFD 60/0 * LIST X *CALL LEXTXT LIST * * IFPLT ENDIF * /--- BLOCK COMMENTS 00 000 78/12/21 18.18 TITLE COMMENTS * *WRITTEN BY BRUCE SHERWOOD 1971 *SEGMENTS BY DAVE ANDERSEN 1972 *ARRAYS BY DON SHIRER 1974 * *COMPILES 6400 MACHINE CODE FROM AN INPUT SOURCE LINE. ****RETURNS MACHINE CODE IN INFO ARRAY ****AND GETVAR CODE IN X1. ****B1 RETURNED 0 IF OK TO STORE INTO EXPRESSION. * *THESE ROUTINES USE A0-A4, A6-A7, X0-X7, B1-B3. * *THE GENERATED MACHINE CODE USES X0-X7, A1,A2,A6,A7. *B1 IS USED FOR INLINE SHIFT OPERATIONS. *OUT-OF-LINE FUNCTIONS (FILES -GETVAR- AND -TFUNCT-) *USE MANY REGISTERS BUT SAVE AND RESTORE THE ABOVE *REGISTERS, AS WELL AS B3, WHICH HOLDS THE RETURN *ADDRESS FROM THE CALC---JP B3 TERMINATES THE CALC. * * *THE COMPILATION PROCEDURE IS ESSENTIALLY AS DESCRIBED IN *CHAPTER 8 OF -THE ANATOMY OF A COMPILER-, *BY JOHN A. N. LEE. ***A MODIFICATION OF THIS SCHEME IS THAT *EACH OPERATOR HAS TWO DIFFERENT *PRECEDENCE LEVELS--ONE WHEN IN HAND *AND ONE WHEN IN THE STACK. THIS IS *DUE TO A SUGGESTION OF LOUIS *STEINBERG, AND VASTLY SIMPLIFIES *UNARY MINUS AND MULTIPLE ASSIGNMENTS. * * *COMPILE CALLS LEX FOR THE NEXT LEXICAL *ITEM IN A ONE-PASS COMPILATION. LEX *RETURNS IN OP THE OPERATOR NUMBER *OR AN OPERAND IN ADTYPE, AS A GETVAR *CODE. THIS CODE CONSISTS OF A BIT *TO SPECIFY MODE (0 I, 1 F), A 3-BIT *TYPE CODE -- 0 SHORT LITERAL, 1 LONG *LITERAL, 2 STUDENT BANK, 3 COMMON, *4 CALC -- , AND XCODEAL=14 BITS OF *ADDRESS. *TYPE 4 IS NEVER RETURNED *BY LEX BUT IS USED INTERNALLY BY *COMPILE TO FLAG A COMPUTED INDEXED *ADDRESS. *WITH TYPE 4 (CALC) THE ADDRESS+B5 IS THE BEGINNING *ADDRESS OF THE CALC IN -EXTRA STORAGE-. *OPERANDS ALREADY IN REGISTERS APPEAR * * /--- BLOCK COMMENTS 00 000 78/12/21 18.18 *IN THE ADS LIST AS (SIGN BIT, I/F BIT *IN USUAL POSITION, REGISTER NUMBER IN *BOTTOM OF WORD). IF OPERAND CODE IS *NEGATIVE, OPERAND IS IN REGISTER. * * LITERALS ARE SAVED IN *LITS* BY *LEX* IF IMMEDIATE (IE'; * '74.5'7 IN '7N1_4.5'7) AND THE 22ND BIT OF THEIR ADTYPES * ARE SET TO DISTINGUISH THEM FROM LITERALS WHOSE ADTYPES * POINT INTO *TOKBUF*. AT CODE GENERATION TIME, LITERALS * ARE RETRIEVED FROM EITHER *LITS* OR *TOKBUF* AND ARE * PLANTED IN THE *INFO* BUFFER BY *LSEEK* WHICH ELIMINATES * DUPLICATE LITERALS TO SAVE ON UNIT BINARY SPACE. LITERALS * ARE STORED EITHER AS I OR F, WHICH EVER IS MORE EFFICIENT. * FOR EXAMPLE, 3.00 AND 3 ARE TREATED IDENTICALLY. * * *VARIABLE NAMES MUST NOT START WITH A NUMBER. *EXPRESSIONS SUCH AS 45.3ALFA OR 34(-X)(3+X) ARE LEGAL. *THE ONLY PLACE WHERE AN EXPLICIT MULTIPLICATION SIGN *IS REQUIRED IS IN 3X*Y, WHERE X AND Y ARE DEFINED *VARIABLES. HOWEVER, IN STUDENT MODE (STORE, ANSV) EVEN *THIS IS ALLOWED--- 3XY IS TAKEN AS 3*X*Y IF THERE IS NO *VARIABLE XY . ALSO, ALTHO AUTHORS MUST USE PARENS *AROUND FUNCTION ARGUMENTS -- SIN(3X) --, STUDENTS CAN *WRITE -- SIN3X -- . STUDENTS MAY REFER TO DEFINED *VARIABLES, BUT V(INDEX) IS TAKEN TO MEAN V*(INDEX). * *OTHER SPECIAL FEATURES INCLUDE --- *MULTIPLE ASSIGNMENT - X_3+Y_7+(Z_12)-W_34 . *RELATIONAL OPERATORS - <,>,=,^<,^>,^= FOR * $LT$,$GT$,$EQ$,$LE$,$GE$,$NE$ *TRUTH VALUE = -1 , FALSE VALUE = 0. *COMBINE RELATIONS WITH $AND$ AND $OR$ WHICH GIVE -1 OR 0. *PARENTHESES - ^[ AND [ EQUIVALENT TO ( * ^] AND ] EQUIVALENT TO ) *^P IS PI, ^O IS PI/180 -- SIN(45^O) IS SIN(.785) . *MIXED MODE OK, WITH N1_V2_34.7 LEAVING V2=34.7, N1=35. * NOTE ROUNDING WHEN SETTING AN INTEGER VARIABLE. *BIT OPERATIONS - $UNION$,$MASK$,$DIFF$,$ARS$,$CLS$ . * (ARS IS ARITHMETIC RIGHT SHIFT, CLS IS CIR. LEFT SHIFT) *SUPERSCRIPTS (LOCKING AND NON-LOCKING) INDICATE * EXPONENTIATION. FOR INTEGER LITERAL EXPONENTS * BETWEEN -63 AND +63 THE MULTIPLIES ARE CODED * IN LINE RATHER THAN AS CALL TO EXPONENTIATION ROUTINE. * * * * /--- BLOCK COMMENTS 00 000 78/06/20 22.15 * * ARRAYS ARE HANDLED AS FOLLOWS... * * ARRAYS AND ARRAY ELEMENTS BOTH HAVE GETVAR CODE=6 * * AN ARAYWORD IS STUCK IN EXTRA STORAGE DESCRIBING TYPE * AND SIZE OF EACH ARRAY USED IN A UNIT * THERE ARE 2 OF THESE WORDS IF ARRAY IS SEGMENTED OR * BASE IS REDEFINED * DESCRIPTIONS OF THESE ARRAY INFO WORDS ARE IN DEFINE, * BLOCK *ARRAY* * * ARRAY ELEMENTS ARE CONVERTED TO REGULAR SCALARS IN * CONDENSOR IF HAVE LITERAL ARGUMENTS, IF NOT, COMPILATION * IS FORCED TO EVALUATE INDICES THRU SUBROUTINES * (VECEL, MATEL) AT EXECUTION TIME. * 'IN THIS CASE, CODE IS GENERATED TO SET B1 TO POINT TO * THE ARRAY DESCRIPTOR WORD (B5+N), X3 TO THE ROW, AND * X4 TO THE COLUMN. * * WHOLE ARRAYS ARE MARKED WHEN ENCOUNTERED BY SETTING * BIT 58 IN OPERAND ADTYPE * * IF ANY WHOLE ARRAY IS ENCOUNTERED IN INITIAL LEXICAL * PASS, SEARCH FOR ARRAY OPERATIONS IS TURNED ON * * ELEMENT-BY-ELEMENT ARRAY OPERATIONS, INCLUDING MOST * BINARY OPERATIONS AND ASSIGNMENT USE STANDARD SCALAR * CODE GENERATORS, BUT CODE IS PREFACED BY CALL TO -AINIT- * AND FOLLOWED BY CALL TO -ALOOPS-...THESE EXECUTION * ROUTINES DO THE INDEX LOOPING AND EXITS * * ALL WHOLE ARRAY OPERATION RESULTS ARE PUT INTO TEMPORARY * STORAGE AT TOP OF *WORK* BEFORE ASSIGNMENT OPERATION * IS CALLED, SO YOU CAN DO THINGS LIKE CALC V_V*V. * * ASSIGNMENTS REQUIRING NO I/F CONVERSION COULD BE SPEEDED * UP IN FUTURE BY USING ECS TRANSFER OPERATIONS * * ARRAYS ARE CHECKED FOR TYPE AND CONFORMALITY WHEN * OPERATION IS ENCOUNTERED, ARRAY ELEMENTS ARE CHECKED * FOR IN-BOUNDS WHEN EVALUATED * * MANY NON-STANDARD EXTENSIONS OF MATRIX OPERATIONS ARE * INCLUDED TO MAKE THESE USEFUL TO WIDER AUDIENCE * * THE DEFINE STRUCTURE INCLUDES PROVISIONS FOR FUTURE * COMPLEX, SEGMENTED, OR 3-DIMENSIONAL ARRAYS, BUT * MACHINERY HAS NOT YET BEEN INCLUDED FOR THESE IN EITHER * THE CONDENSOR OR THE EXECUTOR * THEY NOW GIVE CONDENSE ERROR MESSAGES * * MORE ON ARRAY USAGE AND FUTURE PLANS IN LESSON -ARRAY- * * * /--- BLOCK COMPCOM 00 000 79/12/04 07.03 PLATO TITLE COMPCOM -- ENTRY POINT FOR -COMPUTE- PUTCOMP BSS 1 TO SATISFY REFERENCES COMPNAM BSS 1 TO SATISFY REFERENCES * ENTRY COMPCOM COMPCOM EQ * SPECIAL ENTRY POINT FOR COMPUTE COMMAND SA1 COMPCOM BX6 X1 MX7 0 SA6 COMPILE SX6 1 FLAG THAT CODE MUST BE GENERATED SA6 COMPALL EVEN FOR SIMPLE VARIABLE REF. SA7 COMPNAM SA7 CSYMADD NO -COMPSYM- SYMBOL TABLE SA7 PUTCOMP NOT A -PUTCOMP- CALL MX7 1 LX7 -OKASIGN SET OKASSIGN BIT SA7 COMSPEC THIS CELL USED TO CHECK SPECS SX7 -2 NO UNIT DIMENSION STUFF SA7 NUNITS EQ CMPCOM2 * * QCMPCOM IS THE ENTRY POINT FOR THE 3-ARG -COMPUTE- * ENTRY QCMPCOM QCMPCOM EQ * SA1 QCMPCOM MX7 1 LX7 -OKASIGN SET OKASSIGN BIT SA7 COMSPEC CELL CHECKED FOR SPECS VALUES BX6 X1 SA6 QUIKCMP PLANT EQ FOR RETURN SX6 -2 SA6 NUNITS NO UNIT DIMENSIONS ALLOWED EQ QUIK2 JUMP INTO QUIKCMP * ENDIF * * /--- BLOCK CONTCOM 00 000 78/01/25 15.08 CONDEN TITLE CONTCOM -- ENTRY POINT FOR CONTINUED CALCS * CONTCOM IS THE ENTRY POINT FOR CONTINUED CALC * ENTRY CONTCOM CONTCOM EQ * SA1 CONTCOM LOAD UP RJ WORD BX6 X1 SA6 COMPILE TRANSFER IT SX6 1 FLAG THAT THIS IS A CALC COMMAND SA6 CALC MX7 0 SA7 COMPNAM SA7 PUTCOMP NOT A -PUTCOMP- CALL SA7 CSYMADD NO -COMPSYM- SYMBOL TABLE EQ COMPIL2 * TITLE COMPNAM -- ALLOW UNDEFINED SYMBOLS * * -COMPNAM- IS A SPECIAL ENTRY POINT USED BY * COMMANDS SUCH AS -MICRO- AND -CHARSET- WHERE * THE AUTHOR MAY WISH TO ENTER AN UNDEFINED NAME * AS THE ARGUMENT * ENTRY COMPNAM COMPNAM BSSZ 1 SA1 COMPNAM SAVE RJ ADDRESS BX6 X1 SA6 COMPILE EQ CMPLX * TITLE COMPSYM -- ALLOW SPECIAL DEFINED SYMBOLS * * -COMPSYM- IS A SPECIAL ENTRY USED BY COMMANDS * THAT WISH TO ALLOW SPECIAL SYMBOLS ...SUCH AS * -SLIDE NOSLIDE- * * ENTRY COMPSYM COMPSYM EQ * SA1 COMPSYM PLANT RETURN ADDRESS BX6 X1 SX7 B1 ADDRESS OF SYMBOL TABLE SA6 COMPILE SA7 CSYMADD SX6 B2 NUMBER OF SYMBOL(S) SA6 CSYMNUM MX7 0 SA7 COMPNAM SA7 COMPALL SET NO COMPILE OF SIMPLE VAR OR LIT SA7 PUTCOMP NOT A -PUTCOMP- CALL EQ CMPCOM2 * * /--- BLOCK PUTCOMP 00 000 78/01/25 15.14 TITLE PUTCOMP -- GENERATE CODE TO STORE VALUE * * -PUTCOMP- SPECIAL ENTRY TO GENERATE CODE * TO STORE THE QUANTITY IN X6 * ENTRY PUTCOMP PUTCOMP EQ * SA1 PUTCOMP FIX UP ENTRY POINT BX6 X1 MX7 1 SA6 COMPILE SA7 RSULTX1 DONT NEED RESULT IN X1 MX7 0 SA7 CALC NOT A CALC SA7 COMPALL SA7 COMPNAM SA7 CSYMADD NO -COMPSYM- SYMBOL TABLE EQ CMPCOM3 * TITLE PCOMP1 -- FORCE COMPILED CODE FOR PUTCOMP * * SAME AS -PUTCOMP- EXCEPT THAT COMPILED CODE IS * PRODUCED EVEN FOR SIMPLE VARIABLE REFERENCES * ENTRY PCOMP1 PCOMP1 EQ * SA1 PCOMP1 FIX UP ENTRY POINT BX6 X1 MX7 1 SA6 COMPILE SA6 PUTCOMP MARK AS -PUTCOMP- CALL SA7 RSULTX1 DONT NEED RESULT IN X1 SA7 COMPALL MUST ALWAYS COMPILE CODE SA7 CMOVFLG DONT MOVE CODE TO EXTRA STORAGE MX7 0 SA7 CALC NOT A CALC SA7 COMPNAM SA7 CSYMADD NO -COMPSYM- SYMBOL TABLE EQ COMPIL2 * TITLE GCOMP -- ENTRY POINT FOR -GOTO- AND -DO- * * SPECIAL DRIVER FOR -COMPILE- USED BY GOTO AND DO * * ENTRY GCOMP GCOMP EQ * SA1 GCOMP BX6 X1 PLANT RETURN ADDRESS SA6 COMPILE RJ GCOMP0 EQ CMPCOM4 DECODE EXPRESSION * * ENTRY GCOMP1 GCOMP1 EQ * SA1 GCOMP1 SET UP EXIT ADDRESS BX6 X1 SA6 COMPILE RJ GCOMP0 EQ COMPIL2 LEAVE *NINST* ALONE * * GCOMP0 EQ * SX6 1 ALWAYS COMPILED CODE SA6 COMPALL SA6 CMOVFLG DONT MOVE CODE TO EXTRA STORAGE MX7 0 SA7 COMPNAM NOT A -COMPNAM- CALL SA7 CSYMADD NO -COMPSYM- SYMBOL TABLE SA7 PUTCOMP SA7 RSULTX1 LEAVE RESULT IN X1 SA7 CALC NOT A -CALC- COMMAND EQ GCOMP0 * ENDIF * /--- BLOCK QUIKCMP 00 000 79/12/05 01.16 TITLE QUIKCMP -- ENTRY POINT FOR LIKELY LITERALS * * * -QUIKCMP- * SPECIAL ENTRY FOR CASES WHERE THE INPUT IS LIKELY * TO BE A LITERAL * * ENTRY QUIKCMP QUIKCMP EQ * PLATO SA1 TSPECS PULL IN -SPECS- BITS BX6 X1 SA6 COMSPEC COPY TO CELL CHECKED BY COMPILE ENDIF QUIK2 SA1 WORDPT POINTER TO FIRST CHARACTER SA1 X1 SA2 X1+KEYTYPE ZR X2,QUIKNUM JUMP IF FIRST CHARACTER NUMERIC * PLATO QCOMP SA1 QUIKCMP BX6 X1 SA6 COMPILE PLANT RETURN EQ CMPCOM1 ENTER COMPILE AFTER COMSPEC SET ENDIF CONDEN QCOMP RJ COMPILE DO NORMAL COMPILE CALL EQ QUIKCMP AND RETURN ENDIF * /--- BLOCK QUIKCMP 00 000 78/12/18 21.00 * * PROCESS NUMERIC CONSTANT * QUIKNUM SX0 X1-1R. CHECK FOR DECIMAL POINT ZR X0,QCOMP SX6 X1-1R0 SAVE FIRST NUMBER MX7 12 MASK FOR 48 BIT CHECK SB2 3 * QNLP SA1 A1+1 LOAD NEXT CHARACTER SA2 X1+KEYTYPE NZ X2,QUIKN10 JUMP IF NOT NUMERIC SX0 X1-1R. ZR X0,QCOMP EXIT IF DECIMAL POINT LX4 X6,B2 MULTIPLY BY 8 LX6 1 MULTIPLY BY 2 IX6 X4+X6 MULTIPLY BY 10 SX1 X1-1R0 CONVERT CHARACTER TO NUMERIC IX6 X1+X6 BX1 X7*X6 SEE IF OVER 48 BITS LONG ZR X1,QNLP EQ QCOMP EXIT IF OVER 48 BITS * QUIKN10 BX7 X1 SAVE LAST CHARACTER SA7 LASTKEY ZR X1,QUIKN20 JUMP IF END-OF-LINE SX0 X2-OPCOMMA NZ X0,QCOMP EXIT IF NOT COMMA SX7 A1+1 SA7 WORDPT UPDATE *WORDPT* EQ QUIKN25 * QUIKN20 SX7 A1 POINTER TO LAST CHARACTER SA7 WORDPT UPDATE *WORDPT* * QUIKN25 SB1 1 MARK NOT STOREABLE MX0 -XCODEAL CHECK FOR 14 BIT LITERAL BX1 X0*X6 NZ X1,QUIKN30 JUMP IF LONG LITERAL BX1 -X0*X6 SET UP -GETVAR- CODE EQ QUIKN90 * QUIKN30 SA1 INX GET XSTOR POINTER SA6 X1+INFO STORE LONG LITERAL SX6 X1+1 SA6 A1 UPDATE *INX* SX6 1 1 = GETVAR TYPE FOR LONG LIT LX6 XCODEAL BX1 X1+X6 LONG INTEGER LITERAL * QUIKN90 MX6 0 SA6 TOPCNT CLEAR *OPCNT* SA6 TVARCNT CLEAR *VARCNT* SA2 NUNITS CHECK FOR UNIT DIMENSIONS WANTED SX2 X2+1 NG X2,QUIKCMP JUMP IF NO UNIT DIM WANTED ZERO UADS,NUMAX MUST CLEAR *UADS* EQ QUIKCMP RETURN * /--- BLOCK COMPILU 00 000 78/01/25 15.39 CONDEN TITLE COMPILU -- ENTRY POINT FOR -ANSU- ARGUMENT ENTRY COMPILU * * ENTRY POINT FOR CONDENSING FIRST ARG OF -ANSU- COMMAND * COMPILU EQ * SA1 COMPILU BX6 X1 MX7 0 SA6 COMPILE SA7 COMPNAM SA7 COMPALL SET NO COMPILE OF SIMPLE VAR OR LIT SA7 CSYMADD NO -COMPSYM- SYMBOL TABLE SA7 PUTCOMP NOT A -PUTCOMP- CALL SA7 RSULTX1 SET TO LEAVE RESULT IN X1 SA7 CALC FLAG THAT THIS IS NOT A CALC COMMAND SA7 CMOVFLG SET TO MOVE CODE TO XTRA STOR AT END OF LIN SX6 INST SA6 NINST INSTRUCTION STREAM POINTER SA7 X6 CLEAR FIRST INSTRUCTION WORD SX7 X6+INSTLNG SA7 NINSTLIM LIMIT ON ADVANCE OF NINST SX7 -1 ALLOW UNITS SA7 NUNITS EQ COMPIL2B ENDIF * /--- BLOCK COMPILE 00 000 79/12/05 01.15 TITLE COMPILE -- MAIN ENTRY POINT TO COMPILER * * -COMPILE- * * PARSES EXPRESSION AT CURRENT POSITION IN THE * INPUT LINE AND RETURNS A GETVAR CODE FOR THE * RESULTING COMPILED CODE. * * ENTRY COMPILE COMPILE EQ * PLATO SA1 TSPECS PICK UP -SPECS- BITS BX7 X1 SA7 COMSPEC AND PUT THEM HERE ENDIF CMPCOM1 MX7 0 SA7 COMPNAM CMPLX MX7 0 SA7 COMPALL SET NO COMPILE OF SIMPLE VAR OR LIT SA7 CSYMADD NO -COMPSYM- SYMBOL TABLE SA7 PUTCOMP NOT A -PUTCOMP- CALL CMPCOM2 MX7 0 SA7 RSULTX1 SET TO LEAVE RESULT IN X1 SA7 CALC FLAG THAT THIS IS NOT A CALC COMMAND * CMPCOM3 SA7 CMOVFLG SET TO MOVE CODE TO XTRA STOR AT END OF LIN * CONDEN CMPCOM4 SX6 INST ENDIF PLATO CMPCOM4 SX6 INFO+INFOX COMPILE CODE INTO INFO BUFFER * (OFFSET INFOX TO LEAVE ROOM FOR LITERALS) ENDIF * SA6 NINST INSTRUCTION STREAM POINTER MX7 0 SA7 X6 CLEAR FIRST INSTRUCTION WORD SX7 X6+INSTLNG SA7 NINSTLIM LIMIT ON ADVANCE OF NINST CONDEN COMPIL2 SX7 -2 SUPPRESS UNIT DIMENSION STUFF SA7 NUNITS -1 TO USE COMPILE DIMENSIONS, -2 SUPPRESSES ENDIF COMPIL2B BSS 0 * USEFUL FOR DEBUGGING * DMADBUG CONDEN * SA1 AZERBUF * BX0 X1 * SA0 SHARE *+ RE ADSMAX ZERO OUT ADS BUFFER * RJ ECSPRTY * DMADBUG ENDIF * /--- BLOCK COMPILE 00 000 78/06/06 21.50 MX7 0 CLEAR COMPILE VARIABLES SA7 TVARCNT COUNT NUMBER OF VARIABLE REFERENCES SA7 VSKMODE SET -VSEEK- MODE SA7 INHAND SA7 PREVOPL SA7 ADS SA7 OPSL SA7 RX CLEAR REGISTER RESERVATIONS SA7 RX+1 SA7 RX+2 SA7 RX+3 SA7 RX+4 SA7 RX+5 SA7 RX+6 SA7 RX+7 SA7 NADS SA7 TEMP FLAG NO TEMPORARY STORAGE USED YET SA7 NARGS NO MULTIPLE ARGUMENTS EXPECTED SA7 NARRAYS PERMIT WHOLE ARRAY OPERATIONS SA7 TMPAFLG CLEAR TEMP ARRAY INFO WORD SA7 TMPASIZ NO TEMP ARRAY WORDS USED SA7 BUFCHK NO ECS ARRAY BUFFER CHECK YET SA7 OPSL+1 BOL PRECEDENCE IS ZERO SX7 -1 SA7 TOPCNT INITIALIZE COUNT OF NUMBER OF OPERATORS SA7 NUADS FLAG NO UNIT OPERANDS SX7 1 SA1 PUTCOMP SEE IF -PUTCOMP- CALL ZR X1,COMPILA SA7 RX+6 RESERVE X6 MX1 1 SX6 6 MARK QUANTITY TO STORE IN X6 BX6 X1+X6 SA6 ADS COMPILA SA7 NOPS SA7 OPS+1 SA7 LASTOP CALL INITDEF GO INITIALIZE FOR -DEFINE- CALL INITLEX INITIALIZE -LEX- PARAMETERS PLATO SA1 NCOMPIL BX7 X1 SA7 COMPIL BE SURE LOCATION COMPIL CONTAINS RJ LEX ENDIF * * /--- BLOCK COMPNAM 00 000 75/08/20 02.01 TITLE COMPNAM * * * DO PROCESSING FOR *COMPNAM* CALLS * SA1 COMPNAM ZR X1,COMPIL JUMP IF NOT A -COMPNAM- CALL * * DECIDE IF ALPHA STRING OR EXPRESSION * SA1 WORDPT GET POINTER TO FIRST CHARACTER * CMPN100 SA2 X1 LOAD NEXT CHARACTER SX0 X2-1R STRIP OFF LEADING SPACES NZ X0,CMPN110 SX1 X1+1 ADVANCE CHARACTER POINTER EQ CMPN100 * CMPN110 SX0 X2-1R( ZR X0,COMPIL EXPRESSION IF LEFT PAREN SX0 X2-KLBRACK ZR X0,COMPIL EXPRESSION IF LEFT BRACKET SX0 X2-KUP NZ X0,CMPN120 ALPHA STRING IF NOT SHIFT CODE SA2 A2+1 LOAD NEXT CHARACTER SX0 X2-1R, ZR X0,COMPIL EXPRESSION IF DOUBLE QUOTE SX0 X2-1R7 ZR X0,COMPIL EXPRESSION IF SINGLE QUOTE * * COLLECT CHARACTERS OF ALPHA LITERAL * CMPN120 SB1 60 INITIALIZE SHIFT MX6 0 INITIALIZE WORD BUILDING SA1 X1-1 INITIALIZE READ REGISTER * CMPN130 SA1 A1+1 LOAD NEXT CHARACTER ZR X1,CMPN140 CHECK IF END-OF-LINE SA2 X1+KEYTYPE SX0 X2-OPCOMMA CHECK IF COMMA ZR X0,CMPN142 SB1 B1-6 DECREMENT SHIFT COUNT NG B1,ALFERR LX1 X1,B1 POSITION NEXT CHARACTER BX6 X1+X6 MERGE WITH WORD BUILDING EQ CMPN130 * * /--- BLOCK COMPNAM 00 000 78/12/18 21.01 * CMPN140 SX7 A1 UPDATE *WORDPT* FOR END-OF-LINE SA7 WORDPT EQ CMPN145 * CMPN142 SX7 A1+1 UPDATE *WORDPT* FOR COMMA SA7 WORDPT * CMPN145 ZR X6,ALFERR ERROR IF NO CHARACTERS BX7 X1 SA7 LASTKEY SET LAST CHARACTER ZR B1,CMPN160 JUMP IF FULL WORD SA1 IFILL ZR X1,CMPN160 JUMP IF ZERO FILL * CMPN150 SB1 B1-6 COMPUTE SHIFT COUNT NG B1,CMPN160 BX0 X1 GET FILL CHARACTER LX0 X0,B1 BX6 X0+X6 ADD TO WORD BUILDING EQ CMPN150 * * SET UP -GETVAR- CODE AND RETURN INFO * CMPN160 SA1 INX GET XSTOR POINTER SA6 X1+INFO STORE LONG LITERAL SX6 X1+1 SA6 A1 UPDATE *INX* SX6 1 1 = GETVAR TYPE FOR LONG LIT LX6 XCODEAL BX1 X1+X6 X1 = -GETVAR- CODE (LONG LIT) MX6 0 SA6 TOPCNT CLEAR *OPCNT* SA6 TVARCNT CLEAR *VARCNT* SB1 1 MARK NOT STOREABLE SA2 NUNITS CHECK UNIT DIMENSIONS NEEDED SX2 X2+1 NG X2,COMPNAM EXIT IF NO UNITS NEEDED ZERO UADS,NUMAX MUST CLEAR *UADS* EQ COMPNAM EXIT * /--- BLOCK COMPIL 00 000 78/06/06 21.38 TITLE COMPIL -- MAIN LOOP FOR COMPILER * PLATO *WHEN COLLECTING ARGUMENT FOR PARENS-LESS FUNCTION, *LOCATION COMPIL CONTAINS EQ SPECIAL. ENDIF * * THERE IS A LOOK-AHEAD INSIDE -LEX- WHEN A MINUS IS * ENCOUNTERED DURING EXECUTION, TO SEE WHETHER THE * NEXT LEXICAL ITEM IS A UNIT SUCH AS METER, IN WHICH CASE * OP IS RETURNED AS A MULTIPLICATION. -COMPILE- MUST NOT * CHANGE -AD- OR -ADTYPE-, WHICH CONTAIN THE INFO ON THE * LOOK-AHEAD ITEM, AND IT MUST USE -OP- AS THE TEST * FOR WHETHER THE ITEM IN HAND IS AN OP OR AN AD. * COMPIL CALL LEX GET NEXT LEXICAL ITEM COMPIL1 SA1 OP ZR X1,AD1 JUMP IF ADDRESS, NOT OP COMPILB NG X1,OP0 BYPASS SPL TEST IF OP IS NEG SX2 X1-OPMULT TEST FOR SPECIAL CASE OP PL X2,OP0 JUMP IF NOT SB1 X1 JP B1+OPJMP GO TO SPECIAL CASE ROUTINE OPJMP EQ OP0 JUST IN CASE X1=0 ACCIDENTLY + EQ ISEOL END OF LINE OP + EQ PLUS CHECK FOR UNARY + + EQ MINUS CHECK FOR UNARY - + EQ ISEOL COMMA AS END-OF-LINE + EQ ISPIAD CHECK IF PI IS OP OR AD + EQ ISDEGR DEGREE SIGN OPERATOR + EQ ISSEG SEGMENT OP + EQ ISARRAY MATRIX OP + EQ ISARRAY VECTOR OP + EQ ISARRAY SCALAR OP OP0 BX7 X1 SA7 LASTOP SAVE FOR LATER UNARY- CHECK OP1 SA2 TOPCNT COUNT OPERATORS ENCOUNTERED SX7 X2+1 OPTOTAL COUNT USEFUL IN FORMULA JUDGING SA7 TOPCNT SA3 PREVOPL PREVIOUS OP LEVEL PLATO NG X1,NEEDPAR JUMP IF FUNCTION NEEDS PARENS ENDIF SA2 X1+PRECED GET PRECEDENCE OP2 SB1 X2 GET INHAND PRECEDENCE SB2 X3 PRECEDENCE OF TOP OF STACK LT B1,B2,FORCE FORCE COMPILE IF PRECEDENCE RIGHT MX7 30 BX7 -X7*X2 GET 2 PRECEDENCE LEVELS AX7 18 GET STACK PRECEDENCE SA7 PREVOPL UPDATE PREVIOUS PRECEDENCE LEVEL SA2 NOPS SX2 X2+1 SX0 X2-OPSMAX SEE IF TOO MANY OPS PL X0,LNGERR SA7 X2+OPSL ADD OP LEVEL TO LIST BX7 X1 SA7 X2+OPS ADD OP TO LIST BX7 X2 SA7 NOPS UPDATE OP POINTER SX7 X1-OPASIGN CHECK FOR ASSIGNMENT TO INDEXED VARIABLE NZ X7,COMPIL JUMP IF NOT ASSIGNMENT * /--- BLOCK COMPIL 00 000 79/12/04 00.30 * * CHECK FOR SPECS OKASSIGN DURING EXECUTION. * PLATO SA2 COMSPEC GET SPECS BITS LX2 OKASIGN OKASSIGN BIT IN SIGN BIT PL X2,ASIGERR JUMP IF NOT ALLOWED ENDIF * SA2 NADS CHECK FOR LAST AD BEING INDEXED ZR X2,EQERR JUMP IF NO ADDRESS TO STORE INTO SA2 X2+ADS BX7 X2 NOW EXAMINE AD AX7 XCODEAL POSTION TYPE CODE MX1 -3 BX7 -X1*X7 MASK OFF 3 BIT CODE SX7 X7-4 CHECK FOR INDEXED VARIABLE NZ X7,COMPIL EXIT IF NOT * *MOVE ABSOLUTE ADDRESS IN A1 TO AVAILABLE X-REGISTER *TO USE LATER WHEN ASSIGNMENT OP IS PROCESSED. * * 'I BELIEVE THAT THIS ROUTINE SHOULD USE -CHOOSEX- * INSTEAD OF THIS JUNK. 'HAVEN'7T GOTTEN INTO WHY IT * DOESN'7T YET. (THEY MIGHT TRY REGISTER X7 TOO) M.MIDDEN * * 'REASON IS THIS'; THE INDEX OF THE INDEXED VARIABLE IS * EVALUATED EARLY IN THE EXPRESSION (TO THE LEFT OF THE * ASSIGNMENT ARROW), AND WE WANT TO USE TYPICAL DESTINATION * REGISTERS IN THE EVALUATION OF THE RIGHT-HAND SIDE, * ENDING FINALLY WITH USING THE SAVED ADDRESS. B. SHERWOOD SA1 RX+3 USE X3 IF AVAILABLE ZR X1,PICKED (RX+3) = 0 IF X3 NOT IN USE SA1 RX+4 IF X3 NOT AVAILABLE, TRY X4 ZR X1,PICKED SA1 RX+5 THEN TRY X5 ZR X1,PICKED SA1 RX+0 KEEP LOOKING ZR X1,PICKED EQ MINDERR CANT COMPILE IF NO REGISTER PICKED SB1 A1-RX CALC CHOSEN REGISTER NUMBER SX7 1 SA7 A1 MARK IT TO BE IN USE MX7 57 BX7 X7*X2 DISCARD ORIGINAL REGISTER NUMBER (X1) SX1 B1 BX7 X1+X7 MERGE NEW REGISTER NUMBER SA7 A2 WRITE BACK NEW AD ENTRY SX7 74010B SXN A1+B0 LX1 6 BUILD SXN A1 BX7 X7+X1 RJ SHORT SB1 1 RJ FREEX FREE X1 EQ COMPIL * /--- BLOCK NEEDPAR 00 000 78/06/06 21.40 PLATO TITLE NEED PARENTHESES * NEEDPAR SA2 JPSPEC EQ SPECIAL INSTRUCTION BX7 X2 BX1 -X1 MAKE OP CODE POSITIVE SA7 COMPIL PLANT IN PLACE OF RJ LEX SA2 NEEDPRL GET PRECEDENCE LEVEL PARENLESS FUNCTION MX7 0 SA7 PRELEX PRELEX=0 MEANS NO LOOK-AHEAD LEX CALL YET BX7 X1 SAVE OPCODE IN LASTOP SA7 LASTOP EQ OP2 NEEDPRL VFD 30/0,12/60,18/95 INSTACK PRECEDENCE LT DIV AND MULT *ASSURES COLLECTION OF TERMS IN SUCH EXPRESSIONS AS SIN2PIX/L. JPSPEC EQ SPECIAL REPLACES COMPIL RJ LEX WHEN COLLECTING * ARGUMENT OF PARENS-LESS FUNCTION. PRELEX BSS 1 NONZERO IF PREOP AND PREAD HAVE INFO PREOP BSS 1 PRE-OP SET BY EXTRA LOOK-AHEAD CALL TO LEX NCOMPIL CALL LEX NORMAL CONTENTS OF LOCATION COMPIL * * *WHEN COLLECTING THE ARGUMENT OF A PARENS-LESS FUNCTION *LOCATION -COMPIL- IS ALTERED TO BRANCH HERE, WHERE WE *LOOK AHEAD ONE LEXICAL ITEM IF NECESSARY. IF OP IS *MULTIPLY OR DIVIDE, WE CALL LEX AN EXTRA TIME TO SEE *WHETHER THIS OP IS FOLLOWED BY A FUNCTION, IN WHICH CASE *WE SET OP INHAND PRECEDENCE LOW TO FORCE COMPILATION OF *THE PARENS-LESS FUNCTION. THIS HANDLES SUCH STUDENT *STATEMENTS AS SINXCOSX AND SINX/COSX. * SPECIAL SA1 PRELEX CHECK FOR PREAD AND PREOP ALREADY SET ZR X1,SPEC2 JUMP IF PREOP AND PREAD DO NOT HAVE INFO NG X1,LASTSP JUMP IF LAST USE OF SPECIAL ROUTINE MX7 0 SA7 A1 CLEAR PRELEX FLAG SA1 PREOP USE ALREADY ACQUIRED PREOP AND PREAD BX7 X1 SA7 OP EQ SPEC3 BYPASS REGULAR CALL TO LEX * SPEC2 CALL LEX GET NEXT LEXICAL ITEM (OP AND AD) SPEC3 SA1 OP CHECK FOR * OR / ZR X1,AD1 JUMP IF NOT AN OPERATOR SX2 X1-OPMULT ZR X2,CHECKUP JUMP IF * SX2 X1-OPDIV ZR X2,CHECKUP JUMP IF / EQ COMPILB BACK TO MAINSTREAM * LASTSP SA2 NCOMPIL RESTORE LOCATION COMPIL TO NORMAL FORM * /--- BLOCK CHECKUP 00 000 78/06/06 21.40 BX7 X2 SA7 COMPIL SA1 PREOP MOCK UP RJ LEX BX7 X1 SA7 OP ZR X1,AD1 JUMP IF OPERAND NOT OPERATOR EQ COMPILB * CHECKUP BX7 X1 CHECK WHETHER NEXT LEXICAL ITEM IS FUNCTION SA7 PREOP SAVE OP SA7 PRELEX SET PRELEX NONZERO TO FLAG LOOK-AHEAD CALL LEX LOOK AHEAD ONE LEXICAL ITEM SA1 PREOP PICK UP * OR / SA2 OP BX7 X2 SA7 A1 SAVE NEW OP IN PREOP BX7 X1 SA7 A2 REPLACE OP WITH PREOP ZR X2,COMPILB JUMP IF OPERAND, NOT FUNCTION OR OPERATOR NG X2,ISFUNCT JUMP IF IT IS A FUNCTION (PARES-LESS) SX3 X2-OP( CHECK FOR LEFT PARENS ZR X3,ISFUNCT EITHER ( OR FUNCTION TERMINATES ARGUMENT SX3 X2-OPFCT CHECK WHETHER OP CORRESPONDS TO A FUNCTION NG X3,COMPILB JUMP IF NOT FUNCTION SX3 X2-ARAYOP PL X3,COMPILB JUMP IF NOT FUNCTION * ISFUNCT MX7 1 NEGATIVE SA7 PRELEX SET NEGATIVE FOR LAST JUMP TO SPECIAL BX7 X1 SA7 LASTOP DUPLICATE OPERATIONS AT LOCATION OP1 SA2 TOPCNT COUNT OPERATORS ENCOUNTERED SX7 X2+1 SA7 A2 MX2 0 SPECIAL PRECEDENCE TO FORCE * ALL OPERATIONS, BACK TO PRECEDING FUNCT. * (CORRECT PRECEDENCE RESTORED AT CMPF3) EQ FORCE FORCE COMPILATION ENDIF * * TITLE MINUS, PLUS, ISDEGR, ISPI, ENDINST * * MINUS SA2 LASTOP NEED OLD LASTOP FOR UNARY CHECK BX7 X1 BUT SAVE MINUS OP IN LASTOP SA7 A2 RJ UPLMIN CHECK WHETHER UNARY OPERATION SX1 OPUSUB LABEL AS UNARY MINUS EQ OP1 * PLUS SA2 LASTOP NEED LASTOP FOR UNARY CHECK BX7 X1 BUT SAVE PLUS IN LASTOP SA7 A2 RJ UPLMIN CHECK WHETHER UNARY OPERATION EQ COMPIL IGNORE UNARY PLUS * ISDEGR SX7 B0 DEGREE OPERATOR IS EFFECTIVELY AN ADDRESS SA7 LASTOP SO CLEAR LASTOP EQ OP1 * * *PI CAN EITHER BE AN OPERATOR, AS IN 3PI, WHERE IT MEANS *GENERATE LITERAL -AND- A MULTIPLY INSTRUCTION, OR *PI CAN BE AN ADDRESS (OPERAND) AS IN 3+PI. *THE SAME ROUTINE THAT CHECKS FOR UNARY PLUS OR MINUS *MAKES THE APPROPRIATE CHECKS FOR THE TWO KINDS OF PI. * /--- BLOCK ENDINST 00 000 78/01/25 15.46 * ISPIAD SA2 LASTOP NEED LASTOP FOR UNARY CHECK SX7 B0 CLEAR LASTOP SINCE BOTH KINDS OF PI ARE ADS SA7 A2 RJ UPLMIN UPLMIN RETURNS IF PI IS AN ADDRESS SX0 B0 PI IS STORED AT LITS+0 RJ LITREF FORM LONG LITERAL REFERENCE EQ COMPIL * UPLMIN EQ * CHECK FOR UNARY + OR - OPERATION *LASTOP MUST BE IN X2 ZR X2,OP1 NOT IF PRECEDING ITEM NOT OP SX7 X2-OP) ZR X7,OP1 NOT IF ) SX7 X2-OPNAME CHECK FOR PRECEDING SPECIAL NAME PL X7,OP1 EFFECTIVELY AN AD, NOT AN OP EQ UPLMIN * ENDINSA SA1 NARRAYS NZ X1,ENDAINS JUMP IF ARRAYS BEING PROCESSED ENDINST SA1 NOPS END OF THIS INSTRUCTION SX7 X1-1 SA7 NOPS DECREMENT NOPS SA3 X1+OPS SAVE LAST OPERATION PERFORMED BX6 X3 SA6 FINALOP ENDINS2 SA1 INHAND RESTORE TO OP2 CONDITIONS SA2 INHANDL SA3 X7+OPSL PREVIOUS LEVEL EQ OP2 AGAIN COMPARE LEVELS * ENDAINS PL X1,ENDINST EXIT IF NO ARRAY LOOP GOING ON BX7 -X1 RESET + SX7 X7+1 INCREMENT NUMBER OF ARRAY OPS SA7 A1 SA1 TMPARAY STORE IN TEMPORARY ARRAY RJ LDALOOP GENERATE RJ ALOOPS, ETC. RJ AIFBIT SET I/F BIT OF RESULT ARRAYWD * SB1 RAINTER * RJ LDASUB GENERATE *RJ INTERRUPT TEST* RJ LDAINTR GENERATE *RJ AINTER* INTRUPTEST EQ ENDINST * AIFBIT EQ * SET I/F BIT OF RESULT ARRAYWD MX0 1 LX0 XCODEAL+4 I/F BIT SA1 NADS SA2 X1+ADS GET ADTYPE OF RESULT SA3 FLOAT BX7 -X0*X2 CLEAR I/F BIT ZR X3,ENDAIN5 JUMP IF RESULT INTEGER BX7 X7+X0 SET I/F BIT ENDAIN5 SA7 A2 RESTORE ADTYPE EQ AIFBIT * LDALOOP EQ * ENTER WITH STORE ADDRESS IN X1 SX7 6110B CODE FOR SB1 LX7 18 BX7 X7+X1 GENERATE SB1 STORADDRESS RJ LONGI *****NEW CHANGE MIGHT PUT SA6 X4+B1 HERE***** SA1 LLALOOP SX7 0100B CODE FOR RJ ** LX7 18 BX7 X7+X1 GENERATE RJ ALOOPS RJ LONGI RJ PAD MAKE SURE START NEW WORD SB1 6 RJ FREEX RELEASE RESULT REGISTER EQ LDALOOP * /--- BLOCK ISSEG 00 000 78/06/06 21.41 TITLE SEGMENT AND ARRAY * * -SEGMENT- INVOLVES AN *OP* AND AN *AD* * SO DOES ARRAY/COMPLEX WHICH USES THIS TOO * ISSEG SA2 NUNITS NO UNITS ALLOWED PL X2,UNITERR SA2 NOPS SX7 X2+1 INCREMENT *NOPS* SX6 X7-OPSMAX-1 PL X6,LNGERR EXIT IF TOO MANY OPS SA7 A2 BX6 X1 STORE -SEG- OR -ARRAY- OP SA6 X7+OPS AND IN OPS LIST SA3 X1+PRECED GET PRECEDENCE OF SEG OR ARRAY AX3 18 POSITION STACK PRECEDENCE MX0 -12 BX6 -X0*X3 MASK OFF PRECEDENCE SA6 X7+OPSL * CALL LEX GET SEGMENT,ARRAY ADTYPE SA1 OP NZ X1,SEGERR ERROR IF OPERATOR SA2 NADS SX7 X2+1 SX2 X7-ADSMAX SEE IF TOO MANY ADS PL X2,LNGERR SA7 A2 INCREMENT NADS SA3 ADTYPE MX0 -XCODEAL BX1 -X0*X3 MASK OFF ADDRESS OF LIT AX3 XCODEAL MX0 -3 MASK FOR TYPE CODE BX0 -X0*X3 SA2 NOPS SA2 X2+OPS GET LAST OP SX2 X2-OPSEG IS EITHER ARRAY OR SEG OP NZ X2,ISARY1 JUMP IF ARRAY SX3 X0-5 MUST BE 5 FOR -SEGMENT- NZ X3,SEGERR * SA2 ATOKEN ADDRESS OF *TOKBUF* IX0 X1+X2 ECS ADDR OF LITERAL SA0 LITEMP + RE 1 RJ ECSPRTY SA1 LITEMP GET LITERAL INTO X1 BX6 X1 RJ LSEEK ADD LITERAL TO XSTOR SX7 5 LX7 XCODEAL BX6 X6+X7 FORM CODE WITH NEW ADDRESS SA1 NADS SA6 X1+ADS ADD TO *ADS* LIST CALL LEX GET LEFT PAREN SA1 OP SX2 X1-OP( ERROR IF NOT LEFT PAREN NZ X2,BADPAR SA2 NOPS SX7 X2+1 INCREMENT *NOPS* SA7 A2 BX6 X1 SA6 LASTOP SA6 X7+OPS SA3 X6+PRECED AX3 18 PRECEDENCE OF LEFT PAREN MX0 -12 BX6 -X0*X3 SA6 PREVOPL SAVE PRECEDENCE LEVEL SA6 X7+OPSL EQ COMPIL DONT FORCE COMPILATION * LITEMP BSS 1 LITEMP2 BSS 1 * * /--- BLOCK ISARRAY 00 000 78/01/26 21.34 * ISARRAY EQU ISSEG SEE PREVIOUS BLOCK * * ISARY1 SX3 X0-6 MUST BE 6 FOR -ARRAY- NZ X3,MATERR SA3 ATOKEN ADDRESS OF *TOKBUF* IX0 X1+X3 ECS ADDR OF LITERAL SA0 LITEMP + RE 2 RJ ECSPRTY SA1 LITEMP GET LITERAL INTO X1 SX2 X2+OPSEG-OPSCAL ZR X2,SCALEL JUMP IF SCALAR ARRAY BX6 X1 NOW MUST CHECK TO SEE IF 1OR2 MX0 2 LITWORDS TO PUT IN XTRA STORAGE LX0 58 MASK FOR BASE/SEGMENT BITS BX0 X0*X6 IS ZERO IF NO 2D ARAYWD SA0 A1 SAVE 1ST LIT ADDR ZR X0,ISARY3 JUMP IF NO 2ND INFO WORD SA1 A1+1 GET 2ND INFO WORD BX7 X1 RJ LSEEK2 INFO WORDS IN X6 AND X7 EQ ISARY6 ISARY3 RJ LSEEK ISARY6 SA2 A0 GET BACK ARAYWD MX0 1 LX0 XCODEAL+4 MASK OFF I/F BIT BX0 X0*X2 SX7 6 CODE FOR ARRAY/COMPLEX LX7 XCODEAL BX7 X7+X0 MERGE CODE, I/F BIT, BX6 X6+X7 AND XSTOR ADDRESS SA1 NADS SA6 X1+ADS ADD TO *ADS* LIST CALL LEX GET NEXT LEXICAL ITEM SA1 OP * CHECK FOR WHOLE ARRAY OR ARRAY ELEMENT SX2 X1-OP( ERROR IF NOT LEFT PAREN NZ X2,WARRAY IF NO ( MUST BE WHOLE ARRAY SA2 NOPS SX7 X2+1 INCREMENT *NOPS* SA7 A2 BX6 X1 SA6 LASTOP SA6 X7+OPS SA3 X6+PRECED ISARY8 AX3 18 PRECEDENCE OF LEFT PAREN MX0 -12 SA1 TOPCNT INCREMENT TOTAL OP COUNT SX6 X1+2 SA6 A1 BX6 -X0*X3 SA6 PREVOPL SAVE PRECEDENCE LEVEL SA6 X7+OPSL SA1 X2+OPS GET LAST OP SX1 X1-OPMAT ZR X1,ISMATR JUMP IF MATRIX EQ COMPIL DONT FORCE COMPILATION * * /--- BLOCK WARRAY 00 000 77/12/19 16.02 ISMATR SA1 WORDPT SX0 1R, ONLY , AND EOL TERMINATE CALL PSCAN FIND COMMA SEPARATING ARGUMENTS ZR X1,FORMERR ERROR IF EOL ENCOUNTERED FIRST SX7 COPARGS PUT ARGUMENT SEPARATOR CHARCTR SA7 B1 INTO COMMA POSITION SX6 B1 SA6 NARGS SAVE THIS POSITION EQ COMPIL * WARRAY SA1 NARRAYS IS 0 IF NO ARRAYS FOUND YET NG X1,NOAERR NO ARRAYS ALLOWED IF - NZ X1,WARRAY2 IF ALREADY SET, DONT CHANGE SX6 1 THIS TURNS ON ARRAY OPS SEARCH SA6 NARRAYS WARRAY2 MX0 1 LX0 59 SET BIT 58 SA1 NADS SA2 X1+ADS GET ADTYPE BX6 X2+X0 MERGE IN WHOLE ARRAY BIT SA6 A2 AND RESTORE SA1 NOPS SX7 X1-1 DECREMENT TO DISCARD ARRAY OP SA7 A1 SX7 B0 SA7 LASTOP CLEAR IT FOR UNARY CHECKSJ EQ COMPIL1 HAVE NEXT OP OR ADTYPE ALREADY * * NOTE, SEGMENTED SCALARS NOT ALLOWED * SO ONLY REAL OR COMPLEX REAL SCALAR REACHES HERE SCALEL BX3 X1 COPY OF ARRAYWD LX3 1 REAL/COMPLEX BIT AT LEFT NG X3,CPXERR JUMP IF COMPLEX**FOR NOW MX0 -XCODEAL-4 BX6 -X0*X1 ISOLATE GETVARCODE OF STARTLOC SA6 ADTYPE SAVE IT SA2 NOPS SX7 X2-1 DECREMENT OPS TO DISCARD SA7 A2 OPSCAL OP SA2 NADS SX7 X2-1 DECREMENT NADS--WILL INCREMENT SA7 A2 AGAIN IN AD1 EQ AD1 PUT SCALAR GETVAR IN ADS LIST * * * ARGUMENT SEPARATOR FOR MATRICES, MULT.ARG.FUNCTS ARGSEP SA1 TOPCNT DONT COUNT AS OPERATOR SX7 X1-1 SA7 A1 MX7 0 SA7 LASTOP SA4 NARGS SX7 1R, REPLACE ARGSEP WITH , AGAIN SA7 X4 EQ ENDINST JUST DISCARD THIS OP NOW * * /--- BLOCK ISEOL 00 000 74/07/13 05.03 TITLE ISEOL, ADS, UNITS, FORCE, OPJUMP * ISEOL SA2 PUTCOMP SEE IF *PUTCOMP* CALL ZR X2,OP0 NG X2,OP0 * * IF -PUTCOMP- CALL GENERATE CODE TO STORE X6 UNLESS * SIMPLE VARIABLE REFERENCE * MX6 -1 RESET -PUTCOMP- FLAG SA6 A2 SA2 COMPALL SEE IF SHOULD ALWAYS COMPILE NZ X2,PUTCMP1 SA2 NOPS SX2 X2-2 NOT SIMPLE IF MORE THAN 1 OP PL X2,PUTCMP1 SA2 NADS CHECK FOR EXACTLY 1 ADTYPE SX6 X2-1 NG X6,EQERR NZ X6,PUTCMP1 JUMP IF NOT SIMPLEST CASE SA2 X2+ADS NG X2,PUTCMP1 JUMP IF IN REGISTER AX2 XCODEAL POSITION -GETVAR- TYPE CODE MX6 -3 BX2 -X6*X2 MASK OFF TYPE CODE SX6 X2-2 ZR X6,OP0 EXIT IF TYPE 2 (STUDENT VAR) SX6 X2-3 ZR X6,OP0 EXIT IF TYPE 3 (COMMON VAR) * PUTCMP1 SX1 OPASIGN RETURN OP CODE FOR ASSIGN BX7 X1 SA7 OP SX7 PUTCMP2 NEXT CALL TO -LEX- WILL BRANCH SA7 LEXADD TO -PUTCMP2- EQ OP0 * PUTCMP2 SX7 EOL RETURN OP CODE FOR END-OF-LINE SA7 OP SA1 NADS ALSO ADD TO ADDRESS STACK ZR X1,FORMERR ERROR IF NO ADTYPE TO STORE IN SA2 X1+ADS SX6 1 LX6 XCODEAL+3 MASK FOR I/F BIT BX6 X2*X6 SAVE I/F BIT SX7 X1+1 SX1 X7-ADSMAX PL X1,LNGERR ERROR IF TOO MANY ADDRESSES SA7 A1 MX0 -3 SA1 ADS GET CURRENT REGISTER NUMBER BX2 -X0*X1 MX1 1 MARK IN REGISTER BX1 X1+X2 BX6 X1+X6 ATTACH I/F BIT SA6 X7+ADS STORE ADTYPE EQ LEX RETURN TO CALLER VIA -LEX- * * /--- BLOCK RPAREN/AD 00 000 74/08/08 22.26 * RPAREN SA1 TOPCNT DECREMENT TOPCNT BY 2 (LEFT AND RIGHT PAR) SX7 X1-2 SA7 A1 SA1 NOPS TO PROCESS RT PAREN, SX1 X1-1 JUST BACK UP STACK POINTER SA2 X1+OPS GET PREVIOUS OPERATOR SX7 X2-OP( MUST BE LEFT PAREN NZ X7,BADPAR SX7 X1-1 BACK STACK POINTER OVER LEFT PAREN SA7 NOPS EQ ENDINS2 * * AD1 SX7 B0 ADDRESS, NOT OP IN HAND SA7 LASTOP CLEAR LAST ITEM OPCODE SA1 ADTYPE GETVAR CODE NG X1,VARERR ADTYPE NEGATIVE IF UNRECOGNIZED NAME SA3 NADS SX7 X3+1 SX6 X7-ADSMAX SEE IF TOO MANY ADS PL X6,LNGERR SA7 A3 INCREMENT NADS BX6 X1 SA6 X7+ADS ADD ADDRESS TO ADS LIST SA2 NUNITS NG X2,COMPIL JUMP IF NO UNITS * MOVE UADTYPE DIMENSION VECTOR INTO UADS BUFFER SB1 X2 NUMBER OF DIMENSIONS SA1 ATEMPEC BX0 X1 SA0 UADTYPE + WE B1 RJ ECSPRTY SA1 NUADS PL X1,AD2 JUMP IF NOT FIRST UNITS AD DX1 X2*X3 CALC NUADS STARTING PLACE IX1 X1-X2 AD2 SX7 X1-UADSMAX PL X7,LNGERR JUMP IF TOO MANY UNIT ADS SX7 X1+B1 SA7 A1 UPDATE NUADS SA0 X7+UADS + RE B1 RJ ECSPRTY EQ COMPIL * ENTER WITH X2=NUMBER OF UNITS, X1=CODE TO PLANT DOUNITS EQ * MANIPULATE UNIT COEFFS SB2 X2 NUNITS IN X2, CODE IN X1 BX7 X1 OPERATION CODE IN X1 SA7 DOUNIOP PLANT CODE SB1 1 INDEX SA1 NUADS NUADS STARTS AT ZERO ZR X1,UNITERR MUST BE TWO OPERANDS IX7 X1-X2 DECREMENT NUADS SA7 A1 SA2 X1+UADS-1 SECOND LIST (MINUS 1) SA1 A2-B2 FIRST LIST (MINUS 1) DOUNIOP EQ * PLANT CODE HERE + SA7 A1 STORE DIMENSION COEFF RESULT SB2 B2-B1 COUNT GT B2,B0,DOUNIOP EQ DOUNITS * ADDEM SA1 A1+B1 FROM FIRST LIST SA2 A2+B1 FROM SECOND LIST FX7 X1+X2 ADD COEFFS IF MULTIPLYING UNITS NX7 X7 * SUBEM SA1 A1+B1 FROM FIRST LIST SA2 A2+B1 FROM SECOND LIST FX7 X1-X2 SUB COEFFS IF DIVIDING UNITS NX7 X7 * /--- BLOCK DOUNITS 00 000 78/12/21 18.20 * * ENTER WITH X2=NUMBER OF UNITS * ZEROU EQ * CHECK FOR ZERO UNITS COEFFS SB2 X2 NUNITS IN X2 SB1 1 INDEX SA1 NUADS NUADS STARTS AT ZERO SA1 X1+UADS-1 START OF DIMENSIONS (-1) DOZEROU SA1 A1+B1 PICK UP COEFF NZ X1,UNITERR JUMP IF COEFF NOT ZERO SB2 B2-B1 COUNT GT B2,B0,DOZEROU EQ ZEROU * * * ENTER WITH X2=NUMBER OF UNITS * SAMEU EQ * CHECK FOR UNITS BEING THE SAME SB2 X2 NUNITS IN X2, CODE IN X1 SB1 1 INDEX SA1 NUADS NUADS STARTS AT ZERO ZR X1,FORMERR MUST BE TWO OPERANDS IX7 X1-X2 DECREMENT NUADS SA7 A1 SA2 X1+UADS-1 SECOND LIST (MINUS 1) SA1 A2-B2 FIRST LIST (MINUS 1) SAMEU1 SA1 A1+B1 FROM FIRST LIST SA2 A2+B1 FROM SECOND LIST BX7 X1-X2 COMPARE COEFFS IF ADDING UNITS NZ X7,UNITERR JUMP IF UNITS DO NOT MATCH SB2 B2-B1 COUNT GT B2,B0,SAMEU1 EQ SAMEU * * /--- BLOCK DOUNITS 00 000 78/12/21 18.22 * UADZERO EQ * CREATE ZERO UNITS COEFFS SB2 X2 SA2 NUADS POINTER IN UNIT STACK NG X2,UNITERR NUADS SHOULD NOT BE NEGATIVE SX7 X2+B2 INCREMENT SX0 X7-UADSMAX PL X0,LNGERR JUMP IF TOO MANY SA7 A2 SA0 X7+UADS SX1 A0 MOVE TO *X1* BECAUSE OF -CALL- ZERO X1,B2 ZERO UNIT COEFFS FOR PI OR DEG EQ UADZERO * * 3KG=3KG OR 5KG $ARS$ 3KG --- DIMENSIONLESS RESULT SAMEUZ EQ * ARGS MUST HAVE SAME UNITS RJ SAMEU (AND ZERO UNITS RESULT) SA2 NUNITS SB2 X2 SA2 NUADS SA0 X2+UADS SX1 A0 MOVE TO *X1* BECAUSE OF -CALL- ZERO X1,B2 ZERO REST OF UNIT EQ SAMEUZ * * FORCE BX7 X1 SAVE IN HAND OP SA7 INHAND BX7 X2 AND ITS LEVEL SA7 INHANDL SA1 NOPS SA1 X1+OPS GET FORCED OP SB1 X1 OPJUMP1 SX7 1 SA7 NOTLITS OPERANDS NOT LITERALS UNTIL PROVEN ELSEWISE SX7 B1 SA7 SAVEOP SAVE OP NUMBER JP B1+OPJUMP GO PROCESS * * /--- BLOCK OPJUMP 00 000 75/06/28 03.29 TITLE OPJUMP * * *** WARNING *** * IF THE ORDER OF THIS TABLE IS CHANGED * THE XTEXT FILE FOR COMPILE (-LEXTXT-) * MUST ALSO BE CHANGED * PURGMAC SYM SYM MACRO NAM,P1,P2,JUMP + EQ JUMP - VFD 12/P1,18/P2 ENDM * * OPJUMP BSS 1 TABLE OF JUMPS FOR PROCESSING OPS PRECED EQU OPJUMP STACK AND INHAND PRECEDENCE LEVELS * IN LOWER PARTS OF JUMP TABLE ENTRIES + EQ ENDLINE END OF LINE (0 AS TERMINATOR) - VFD 12/0,18/-1 + EQ ADD - VFD 12/50,18/49 + EQ SUB - VFD 12/50,18/49 + EQ ENDLINE COMMA AS TERMINATOR - VFD 12/0,18/-1 + EQ PILIT PI LITERAL - VFD 12/64,18/63 + EQ DEGREE DEGREE TO RADIAN - VFD 12/64,18/63 + EQ SEGRAY SEGMENT(I) - VFD 12/96,18/95 + EQ MATRAY REAL/COMPLEX MATRIX ELEMENT - VFD 12/96,18/95 + EQ VECTRAY REAL/COMPLEX VECTOR ELEMENT - VFD 12/96,18/95 + EQ SCALRAY REAL/COMPLEX SCALAR ELEMENT - VFD 12/96,18/95 + EQ MULT - VFD 12/64,18/63 DIVIDE EQ DIV - VFD 12/62,18/61 + EQ BADPAR - VFD 12/2,18/99 + EQ RPAREN RIGHT PAREN - VFD 12/98,18/3 + EQ ARGSEP ARGUMENT SEPARATOR - VFD 12/7,18/6 + EQ ASSIGN ASSIGNMENT - VFD 12/10,18/95 + EQ UMINUS UNARY MINUS - VFD 12/54,18/95 + EQ DOTMULT DOT MULTIPLY - VFD 12/68,18/67 + EQ CRSMULT CROSS MULTIPLY - VFD 12/72,18/71 + EQ CHARERR ILLEGAL CHARACTER - VFD 12/100,18/100 HIGH PRECEDENCE + EQ UNION UNION - VFD 12/26,18/25 + EQ MASK MASK - VFD 12/28,18/27 + EQ DIFF LOGICAL DIFFERENCE - VFD 12/28,18/27 + EQ ARS ARITHMETIC RIGHT SHIFT - VFD 12/28,18/27 + EQ CLS CIRCULAR LEFT SHIFT - VFD 12/28,18/27 FSTFCT EQ COMPLOG OR - VFD 12/20,18/19 + EQ COMPLOG AND - VFD 12/22,18/21 + EQ COMPLOG GT - VFD 12/24,18/23 + EQ COMPLOG GE - VFD 12/24,18/23 + EQ COMPLOG LT - VFD 12/24,18/23 + EQ COMPLOG LE - VFD 12/24,18/23 + EQ COMPLOG EQ - VFD 12/24,18/23 + EQ COMPLOG NE - VFD 12/24,18/23 * /--- BLOCK OPJUMP 00 000 80/03/23 11.17 + EQ EXPO EXPONENTIATION (2 ARGUMENTS, LIKE GT) - VFD 12/68,18/69 LIST G,X *CALL LEXDEF LIST * * NFUNCTS EQU *-FSTFCT NUMBER OF FUNCTIONS / NAMES * * /--- BLOCK ADD 00 000 78/07/31 05.11 TITLE ADD, SUB, MULT, DIVIDE * ADD SX7 36000B INTEGER ADD SA7 IOP SX7 34000B FLOAT ADD (RX) SA7 FLOAT SA2 NUNITS ARE THERE UNITS NG X2,ADD1 JUMP IF NOT RJ SAMEU CHECK FOR SAME UNIT DIMENSIONS ADD1 RJ PREBIN DETERMINE 'I/'F TYPE NZ B3,ADDJP IF NOT BOTH INTEGER SA3 NOTLITS ZR X3,ADDJP WILL BE OPTIMIZED ELSEWISE SA3 NARRAYS ZR X3,NTADDAR JUMP IF NO ARRAYS BX7 X1+X2 TEST WHOLE ARRAY FLAG LX7 1 IN BIT 58 NG X7,ADDJP JUMP IF EITHER IS AN ARRAY NTADDAR MX7 0 SA7 FLOAT NOT FLOATING INSTRUCTION MX7 57 BX3 X1 GETVAR CODE IN X1 NG X3,TRY2ND 1ST ARG IN REGISTER AX3 XCODEAL BX3 -X7*X3 ZR X3,SMALAD SMALL 1ST ARG TRY2ND NG X2,ADDJP 2ND ARG IN REGISTER BX4 X2 AX4 XCODEAL BX4 -X7*X4 NZ X4,ADDJP JUMP IF NEITHER SMALL INTEGER BX7 X1 SWITCH ORDER OF ADS SA7 A2 BX7 X2 SA7 A1 SA1 A1 SA2 A2 SMALAD MX7 60-XCODEAL BX7 -X7*X1 GET 14 BITS OF SMALL LITERAL SX7 X7-1 NZ X7,ADDJP JUMP IF NOT 1 SB1 1 *BECAUSE FUNCTIONS AND SEGMENTS PUT INTO X1'. RJ GENREAD GET THE NON-ONE ARGUMENT SX7 1 SA7 B1+RX RESERVE THAT REGISTER SA0 B1 SA1 NADS IX7 X1-X7 GET TO OTHER ADS SA7 A1 SB1 2 RJ CHEKRR SX7 B1+430B GENERATE -1 LX7 6 SX7 X7+59 MXN 60-1 RJ SHORT RJ FREEX MX7 0 CLEAR FIRST REGISTER SA7 A0+RX SB2 A0 SX0 B2 LX0 3 * /--- BLOCK ADD 00 000 78/07/31 04.45 SX3 X0+B1 ORIGIN REGISTER RJ PICKX GET DESTINATION REGISTER MX7 1 RESERVE IT SA7 B1+RX SX7 B1 LX7 6 BX7 X3+X7 SX6 37000B SUBTRACT INSTRUCTION BX7 X6+X7 RJ SHORT EQ ENDINSA ADDJP LX0 1 FLAG FIRST OPERAND FOR CHANGE JP B3+ADDS ADDS EQ IADD I+I EQ ADDIF I+F EQ ADDFI F+I EQ ADD2 F+F * ADDIF LX0 1 FLAG FIRST OPERAND FOR MODE CHANGE ADDIF BX7 X1+X0 (PREBIN SET X0 TO I/F MASK) SA7 A1 EQ ADD2 * ADDFI LX0 1 FLAG SECOND OPERAND FOR MODE CHANGE ADDFI BX7 X2+X0 (PREBIN SET X0 TO I/F MASK) SA7 A2 EQ ADD2 IADD SX7 B0 SA7 FLOAT ADD2 RJ BINARY READ TWO OPERANDS SA1 FLOAT IS IT FLOATING NZ X1,ADDF JUMP IF FLOATING SA1 IOP GET INTEGER OPERATION BX7 X1+X7 MERGE REGISTERS RJ SHORT ADD INSTRUCTION TO STREAM EQ ENDINSA ADDF BX7 X1+X7 MERGE FLOATING OPERATION WITH REGISTERS RJ SHORT ADD INSTRUCTION TO STREAMF NORM SA1 NOTLITS SHORT LEAVES LITERAL IN X7 IF NOTLITS=0 NZ X1,NORM2 JUMP IF NOT LITERALS NX7 X7 NORM THE LITERAL SA7 A7 AND STORE AGAIN INTO LITS TABLE EQ ENDINST * NORM2 SX2 B1 NORMALIZE, B1 IS REGISTER NUMBER LX2 6 CONSTRUCT NXI XI INSTRUCTION SX2 X2+B1 SX7 X2+24000B 24 IS NORMALIZE RJ SHORT EQ ENDINSA * SUB SX7 37000B INTEGER SUB SA7 IOP SX7 35000B FLOAT SUB (RX) SA7 FLOAT SA2 NUNITS NG X2,SUB1 RJ SAMEU SUB1 RJ PREBIN LX0 1 FLAG FIRST OPERAND FOR MODE CHANGE JP B3+ADDS * MULT SA2 NUNITS CHECK FOR UNITS NG X2,MULT1 JUMP IF NO UNITS SA1 ADDEM CODE FOR ADDING UNIT COEFFS RJ DOUNITS MULT1 RJ PREBIN CHECK FOR I/F TYPE MULT1B SX7 41000B FLOAT MULT (RX) SA7 FLOAT LX0 1 (PREBIN SET X0 TO I/F MASK) JP MULTS+B3 * /--- BLOCK MULT 00 000 75/10/18 20.16 MULTS EQ IMULT I * I + BX7 X1+X0 I * F SA7 A1 FLAG 1ST OPERAND FOR MODE CHANGE EQ MULT2 + BX7 X2+X0 F * I SA7 A2 FLAG 2ND OPERAND FOR MODE CHANGE MULT2 RJ BINARY MODE CHANGE BITS ARE NOW SET SA1 FLOAT GET INSTRUCTION CODE BX7 X1+X7 MERGE REGISTER NUMBERS RJ SHORT ADD INSTRUCTION TO STREAM EQ ENDINSA * *INTEGER MULTIPLY----- IMULT SX7 B0 CLEAR FLOAT FOR INT MULT. SA7 FLOAT RJ BINARY GET OPERANDS INTO REGISTERS SX7 X7+42000B INTEGER MULTIPLY RJ SHORT ADD INSTRUCTION TO STREAM EQ ENDINSA * * DIV SX7 45000B FLOAT DIV (RX) SA7 FLOAT RJ FLTBOTH FLOAT BOTH OPERANDS SA2 NUNITS NG X2,MULT2 JUMP IF NOT UNITS SA1 SUBEM CODE TO SUBTRACT UNIT COEFFS RJ DOUNITS EQ MULT2 * PILIT SX0 B0 PI LITERAL STORED AT LITS+0 RJ LITREF GENERATE LONG LITERAL REFERENCE EQ MULT GENERATE MULTIPLY INSTRUCTION * * DEGREE SX0 1 PI/180 LITERAL IN LITS+1 RJ LITREF GENERATE LONG LITERAL REFERENCE SA1 TOPCNT DO NOT COUNT AS AN OPERATION SX7 X1-1 SA7 A1 EQ MULT GENERATE MULTIPLY INSTRUCTION * * *LITREF CREATES ENTRY IN ADS LIST FOR FLOATING LONG *LITERAL AT LITS+(X0). X0=0 FOR PI, X0=1 FOR PI/180. LITREF EQ * CREATE LONG LITERAL REFERENCE SA1 NLITS INCREMENT NLITS SINCE GENREAD SX7 X1+1 WILL DECREMENT NLITS SA7 A1 SA1 NADS HANDLE DEGREE SIGN SX7 X1+1 GENERATE REFERENCE TO DEGREE-RADIAN FACTOR SX6 X7-ADSMAX PL X6,LNGERR ERROR IF TOO MANY ADS SA7 A1 UPDATE NADS SX6 11B GETVAR CODE FOR FLOATING LIT LX6 XCODEAL BX6 X6+X0 SX2 1 SET *LITS* FLAG LX2 LITSHFT BX6 X6+X2 SA6 X7+ADS LITERAL IS PI OR PI/180 SA2 NUNITS NG X2,LITREF JUMP IF NO UNITS INVOLVED RJ UADZERO EQ LITREF * MASK RJ PREBIN INTEGER MASK MX7 0 SA7 FLOAT RJ BINARY SX7 X7+11000B RJ SHORT SA2 NUNITS NG X2,ENDINSA * /--- BLOCK MULT 00 000 75/10/18 20.16 RJ SAMEUZ MUST HAVE SAME UNITS EQ ENDINSA * /--- BLOCK UNION 00 000 75/10/18 20.47 * UNION RJ PREBIN INTEGER UNION MX7 0 SA7 FLOAT RJ BINARY SX7 X7+12000B RJ SHORT SA2 NUNITS NG X2,ENDINSA RJ SAMEUZ MUST HAVE SAME UNITS EQ ENDINSA * DIFF RJ PREBIN LOGICAL DIFFERENCE MX7 0 SA7 FLOAT RJ BINARY SX7 X7+13000B BXN XA-XB RJ SHORT SA2 NUNITS NG X2,ENDINSA RJ SAMEUZ MUST HAVE SAME UNITS EQ ENDINSA * ARS MX7 0 ARITHMETIC RIGHT SHIFT SA7 SHIFTDN SX7 21000B SHIFT WITH 2ND ARG CONSTANT SA7 IOP STORE FOR POSSIBLE OPTIMIZATION RJ PREBIN RJ LBINARY SA2 SHIFTDN ZR X2,ARSB1 SA2 NOTLITS ZR X2,ENDINSA SA2 IOP BX7 X7+X2 UNION IN REGISTER EQ ARSSTR ARSB1 SX7 X7+23000B ARSSTR RJ SHORT EQ ENDINSA * CLS SX7 0 CIRCULAR LEFT SHIFT SA7 SHIFTDN FLAG FOR SHIFT OPTIMIZED SX7 20000B SHIFT WITH 2ND ARG CONSTANT SA7 IOP STORE FOR POSSIBLE OPTIMIZATION RJ PREBIN CHECK IF BOTH LITERALS RJ LBINARY SA2 SHIFTDN ZR X2,CLSB1 SA2 NOTLITS ZR X2,ENDINSA DONE IF HAD LITERALS SA2 IOP BX7 X7+X2 UNION IN REGISTER EQ CLSSTR CLSB1 SX7 X7+22000B CLSSTR RJ SHORT EQ ENDINSA * * SHIFTDN BSS 1 CHECK TO SEE IF SHIFT OPTIMIZED * * /--- BLOCK DOTMULT 00 000 77/12/18 16.55 TITLE ARRAY MULTIPLICATION * DOTMULT SX7 RDOTMUL FLAG FOR DOT MULTIPLY SA7 IOP SAVE IT ARAYMUL SA2 NUNITS NG X2,DOTM01 JUMP IF NO UNITS SA1 ADDEM ADD UNIT COEFFS RJ DOUNITS DOTM01 RJ PREBIN B3=I/F BIT INFO, CHK FOR 2 ADS * SA3 IOP * SB2 X3-RDOTMUL SET B2=0 IF DOT PRODUCT BX4 X1+X2 LX4 1 EXAMINE WHOLE-ARRAY BIT PL X4,MULT1B IF NEITHER ARRAY,NORMAL MULTPY BX4 X1*X2 LX4 1 MX7 -XCODEAL NG X4,DOTM10 JUMP IF BOTH ARE ARRAYS * NE B2,B0,SIZERR NO SCALARS IN CROSSPRODUCT SA3 IOP SX3 X3-RDOTMUL NZ X3,SIZERR NO SCALARS IN CROSSPRODUCT MX3 -9 BX4 X1 LX4 1 NG X4,DOTM02 JUMP IF 1ST OPERAND IS ARRAY BX4 -X7*X2 GET ADDRESS AND SA4 X4+INFO 2D OPERAND ARAYWD AX4 36 BX4 -X3*X4 ISOLATE ROWS NZ X4,SIZERR ROWS2 MUST BE 1 IF OP1 SCALAR EQ MULT1B DO REGULAR MULTIPLY * DOTM02 BX4 -X7*X1 GET ADDRESS AND SA4 X4+INFO 1ST OPERAND ARAYWD AX4 27 BX4 -X3*X4 ISOLATE COLS NZ X4,SIZERR COLS1 MUST BE 1 IF OP2 SCALAR EQ MULT1B DO REGULAR MULTIPLY * * /--- BLOCK DOTMULT 00 000 76/11/28 10.26 DOTM10 BX1 -X7*X1 ADDRESSES OF ARRAYWDS BX2 -X7*X2 SA3 X1+INFO GET ARRAY WDS SA4 X2+INFO BX6 X3-X4 LX6 1 EXAMINE REAL/COMPLEX BIT NG X6,CPXERR ERROR UNLESS BOTH SAME TYPE * BX6 X3+X4 LX6 3 TEST MERGED SEGMENT BITS PL X6,DOTM14 JUMP IF NEITHER SEGMENTED SX6 B3 SAVE IFTYPE SA6 FLOAT LX4 3 PL X4,DOTM12 JUMP IF 2D ARRAY NOT SEGMENTED LX4 57 BX7 X4 SA7 ASIZE RJ ARYPREP CLEAR X1,X2,X6,CHECK SAVEBUFFER RJ ASEGTMP CONVERT 2D ARG TO TEMP ARRAY SA1 NADS SA1 X1+ADS-1 GET 1ST OPERAND ADTYPE MX7 -XCODEAL BX1 -X7*X1 ADDR OF ARAYWD SA3 X1+INFO GET 1ST ARAYWD DOTM12 LX3 3 PL X3,DOTM13 JUMP IF 1ST NOT SEGMENTED * EQ TSTERR **THIS PART NOT FULLY TESTED** LX3 57 BX7 X3 SA7 ASIZE RJ POPNADS SET FOR FIRST OPERAND RJ ARYPREP CLEAR X1,X2,X6,CHECK SAVEBUFFER RJ ASEGTMP CONVERT 1ST ARG TO TEMP ARRAY SA1 NADS SX7 X1+1 BACKUP TO 2D OPERAND SA7 A1 DOTM13 SA1 NADS SA2 X1+ADS SA1 X1+ADS-1 MX7 -XCODEAL BX1 -X7*X1 ADDRESS OF ARRAYWDS BX2 -X7*X2 SA3 FLOAT GET SAVED B3 SB3 X3 SA3 X1+INFO ARRAY INFO WORDS (NOW TEMPARAY) SA4 X2+INFO * NOW CHECK FOR CONFORMALITY DOTM14 MX0 2 MASK FOR DIMENSIONS BX5 X3+X4 LX5 4 MERGED DIMENSIONS AT LEFT MX0 -9 MASK FOR SIZE FIELDS LX3 24 LX4 24 GET ROWS AT RIGHT BX6 -X0*X3 ROWS1-1 BX7 -X0*X4 ROWS2-1 LX3 9 LX4 9 BX3 -X0*X3 COLS1-1 BX4 -X0*X4 COLS2-1 * NE B2,B0,CRSMUL5 JUMP IF CROSSPRODUCT SA1 IOP SX1 X1-RDOTMUL NZ X1,CRSMUL5 JUMP IF CROSSPRODUCT * CHECK CONFORMALITY OF VECTOR PROD SEPARATELY PL X5,DOTM30 JUMP IF NEITHER ARE MATRICES DOTM15 IX5 X3-X7 COLS1-ROWS2 NZ X5,SIZERR INNER DIMENSIONS MUST MATCH * /--- BLOCK DOTMULT 00 000 78/01/25 16.08 **LATER MUST CHECK FOR COMPLEX ARRAY..DOUBLE SIZE SX0 X6+1 ROWS1 SX5 X4+1 COLS2 DX5 X0*X5 ROWS1*COLS2 SX0 X5-1 SIZE-1 ZR X0,DOTM21 JUMP IF RESULT SCALAR (SIZE=1) SX0 X0-ARAYLTH+1 PL X0,SIZERR ERROR IF SIZE TOO BIG * RESULT IS MATRIX DOTM20 LX5 9 BX5 X5+X6 SIZE,ROWS1 LX5 9 BX0 X5+X4 SIZE,ROWS1,COL2 LX0 27 =RESULT ARAYWD SIZE FIELDS * * WHEN COMPLEX ADDED...INSERT CMPLX/REAL BIT HERE DOTM21 LX7 9 BX7 X7+X4 ROW2,COL2 SA7 TMPARAY SAVE TEMPORARILY BX7 X0 SA7 ASIZE RESULT SIZE FIELD (0 IF SCALAR) SX7 B3 IFBITS SA7 FLOAT SAVE FOR ADTYPE IN AIFBIT SX5 7110B SX1 B0+... LX5 18 LX6 9 BX6 X6+X7 ROWS1/IFBITS BX7 X5+X6 SX1 ROWS1/IFBITS ** SA7 FFLT SAVE TEMPORARILY RJ ARYPREP CLEAR X1,2,6, FORM RJ ABUFCHK SA1 FFLT BX7 X1 RESTORE X1 INFO RJ LONGI GENERATE SX1 ROWS1/IFBITS * SA1 TMPARAY ROW2/COL2 SX7 7120B SX2 B0+... LX7 18 BX7 X7+X1 RJ LONGI GENERATE SX2 ROWS2/COLS2 * NOW GET ADDRESSES INTO B1,B2 SA1 NADS SA1 X1+ADS GET 2D OPERAND IN X1 RJ GETARAD GET ACTUAL 2D ARAY ADDR IN X3 SX7 6120B SB2 B0+... LX7 18 BX7 X7+X3 RJ LONGI GENERATE SB2 (ARAY2 STARTLOC) * SA2 FLOAT TYPE STORED HERE SX3 X2-4 PL X3,ISATRA JUMP IF TYPE 4,5,6,7 ETC * SA1 NADS SA1 X1+ADS-1 GET 1ST OPERAND IN X1 RJ GETARAD SX7 6110B SB1 B0+... LX7 18 BX7 X7+X3 RJ LONGI GENERATE SB1(ARAY1 STARTLOC) RJ POPNADS DECREMENT NADS * DOTM60 SB1 1 FORCE NEW TMPARAY RJ CALCTMP SA1 TMPARAY WHERE TO STORE SX7 5100B LX7 18 BX7 X7+X1 GENERATE SA0 TMPARAY RJ LONGI * * /--- BLOCK CROSSMULT 00 000 76/06/20 05.34 * DOTM70 SA1 IOP GET DISPLACEMENT SB1 X1 FOR DOT/CROSS PROD RJ LDASUB GENERATE RJ DOT/CROSS PROD * RJ TMPAD CREATE TEMP ARRAYWD, ADTYPE RJ AIFBIT SET I/F BIT OF TEMP ARAYWD * SB1 RAINTER * RJ LDASUB GENERATE *RJ ARRAY INTERRUPT* RJ LDAINTR GENERATE *RJ AINTER* INTRUPTEST SA1 NARRAYS SX7 X1+1 INCREMENT TO COUNT ARRAY OPS SA7 NARRAYS EQ ENDINST * * ENTER HERE IF BOTH OPERANDS VECTORS DOTM30 IX5 X6-X7 TEST ROWS1-ROWS2 NZ X5,SIZERR MUST BE IDENTICAL LENGTH MX6 0 MOCK UP ROW1=1 MX0 0 TO SET SIZE=0 EQ DOTM21 * * PATCH SO TRANSPOSE, REVERSE, ETC CAN USE DOTPROD ISATRA SX7 66120B SB1 B2+B0 RJ SHORT ONLY ONE OPERAND ADDR FOR FUNCT SA1 NADS SA2 X1+ADS MX0 1 LX0 XCODEAL+4 I/F BIT MASK BX7 X0*X2 SA7 FLOAT I/F BIT OF OPERAND FOR AIFBIT SX7 RDOTMUL SA7 IOP TRANSPOSE,REV USE DOT MUL EQ DOTM60 * IF PUT TRACE IN HERE, SHOULD GOTO DOTM70 * * * * ARRAY CROSS PRODUCT * CRSMULT SX7 RCRSMUL SA7 IOP SAVE FLAG EQ ARAYMUL * CRSMUL5 SB1 X7-1 CROSS MULT MUST HAVE LE B1,B0,SIZERR 3 OR MORE ELEMENTS PL X5,CRSMUL7 JUMP IF BOTH VECTORS NZ X4,SIZERR 2D OPERAND MUST BE VECTOR IX0 X6-X3 AND 1ST OPERAND SQUARE ARRAY NZ X0,SIZERR JUMP UNLESS ROWS1=COLS1 BX0 X7 SAVE COLS2 TEMPORARILY SX7 RDOTMUL RESET FLAG SINCE ARRAY SA7 IOP CROSS MULT SAME AS DOT BX7 X0 EQ DOTM15 DO DOT MULTIPLY ON ARRAY.VECTOR * CRSMUL7 SX5 X7+1 SIZE=ROWS2 FOR VECTOR CROSSMULT EQ DOTM20 NOTE ROW1 USED ONLY IN ASIZE * * /--- BLOCK ENDLINE 00 000 78/12/18 21.07 TITLE ENDLINE -- END OF EXPRESSION PROCESSING * PLATO ENDLINE SA1 OLDB5 -1 IF STUD DEF UNIT NOT IN CM NG X1,ENDL CALL POSTOR RESTORE PRESENT UNIT ENDIF CONDEN ENDLINE BSS 0 ENDIF ENDL SA1 NUNITS SX7 X1+1 CHECKING FOR NUNITS=-1 NZ X7,ENDLIN2 ZERO UADS,NUMAX MUST CLEAR *UADS* ENDLIN2 SA1 WORDPT RETURN LAST KEY FOUND (0 OR COMMA) SA2 X1-1 BX7 X2 SA7 LASTKEY NZ X7,NOTEOL SX7 A2 SA7 A1 BACK UP WORDPT IF EOL NOTEOL SA1 NADS CHECK THAT THERE IS EXACTLY ONE OPERAND SA2 X1+ADS MX7 1 SET NOTLITS FOR ANY ROUTINE SA7 NOTLITS WHICH CALLS COMPILE AND USES SHORT SX0 1 AND SAVE I/F INFO LX0 XCODEAL+3 I/F BIT MASK BX7 X0*X2 SA7 FLOAT SAVE FLOAT BIT SX1 X1-1 NZ X1,FORMERR OTHERWISE ERROR IN FORM OF EXPRESSION SA1 COMPALL IF THIS FLAG SET, COMPILE CODE EVEN NZ X1,ENDL1 FOR SIMPLE VARIABLE OR LITERAL * * CHECK FOR SPECS NOOPS OR SPECS NOVARS * PLATO SA3 COMSPEC BX1 X3 LX1 NOOPS CHECK FOR NOOPS SPECIFIED PL X1,OPSOK SA1 TOPCNT NUMBER OF OPERATIONS NZ X1,OPTERR * /--- BLOCK ENDLINE 00 000 79/12/04 00.39 OPSOK LX3 NOVARS CHECK FOR NOVARS SPECIFIED PL X3,VARSOK SA1 TVARCNT NUMBER OF VARIABLE REFERENCES NZ X1,VARTERR ENDIF * VARSOK SA1 CALC CHECK WHETHER A CALC COMMAND ZR X1,NOTCALC JUMP IF NOT A CALC COMMAND SA1 FINALOP LAST OPERATION IN CALC SHOULD BE ASSIGN SX1 X1-OPASIGN NZ X1,EQERR JUMP IF NOT ASSIGN SA3 NARRAYS ZR X3,VARSOK2 JUMP IF NO ARRAYS USED BX3 X2 LX3 1 CHECK WHOLE ARRAY BIT NG X3,ENDARAY SKIP GENREAD FOR ARRAYS VARSOK2 PL X2,SIMPLE JUMP IF RESULT NOT IN REGISTER ENDL1 SA1 RSULTX1 IF ZERO, MAKE SURE RESULT IN X1 NZ X1,ENDL2 AT END OF CALC SB1 1 GENERATE A READ IF NECESSARY (EXPRESSION) RJ GENREAD SB2 B1-1 CHECK FOR NOT IN X1 ZR B2,ENDL2 JUMP IF VALUE IN X1 SX7 B1 B1 IS PRESENT REGISTER LX7 3 SX7 X7+10100B CONSTRUCT BX1 XN RJ SHORT ADD TO STREAM ENDL2 SX0 B0 CLEAR X0, IN CASE MOVCODE NOT CALLED SA1 CMOVFLG IF ZERO, COMPILE CALC EXIT JUMP NZ X1,COMPEND AND MOVE CODE GENERATED INTO EXTRA STORAGE * /--- BLOCK COMPEND 00 000 76/06/17 16.06 SX7 23B LX7 21 COMPILE JP B3 RJ LONGI LAST INSTRUCTION RJ PAD PAD OUT THE INSTRUCTION TO LEFT-ADJUST IT RJ MOVCODE AND MOVE CODE TO EXTRA STORAGE *MOVCODE SETS X0 TO EXTRA STORAGE LOCATION OF CODE. COMPEND SX1 4 FLAG CALC CODE LX1 XCODEAL BX1 X0+X1 BRING IN EXTRA STORAGE POINTER *X0 IS ZERO IF MOVCODE WAS NOT CALLED, AS WITH -BRANCH- *COMMAND. IN THIS CASE -BRANCH- SIMPLY NEEDS I/F INFO. SA2 FLOAT PICK UP I/F BIT BX1 X1+X2 EQ CHKSTOR SIMPLE SA1 NADS SIMPLE VARIABLE REFERENCE, NO CALC SA1 X1+ADS CHKSTOR SB1 B0 FLAG FOR STORE-INTO-ABLE BX3 X1 GETVAR CODE INTO X3 AX3 XCODEAL GET INITIAL BITS MX0 57 BX3 -X0*X3 THROW AWAY I/F INFO SB2 X3 0SHORT,1LONG,2STUDENT,3COMMON,4CALC JP B2+CHKSTR2 CHKSTR2 EQ NOSTORE SHORT LIT EQ LONGLIT LONG LIT EQ COMPILE STUDENT EQ COMPILE COMMON EQ CHKSTR3 CALC EQ COMPERR SEGMENT EQ COMPERR ARRAY/COMPLEX EQ NOSTORE -JUMP-TYPE GETVAR CODE * CHKSTR3 SA2 ADS+1 PICK UP AD TO CHECK FOR INDEXED VARIABLE AX2 XCODEAL POSITION TYPE CODE MX0 -3 BX2 -X0*X2 MASK OFF TYPE CODE SX2 X2-4 TYPE 4 = INDEXED STORE ZR X2,COMPILE JUMP IF CAN STORE INTO INDEXED VARIABLE SA2 PUTCOMP ZR X2,NOSTORE EXIT IF NOT -PUTCOMP- CALL SA2 FINALOP LAST OPERATION IN CALC SHOULD BE AN ASSIGN SX2 X2-OPASIGN NZ X2,EQERR JUMP IF NOT ASSIGN SB1 1 EQ COMPILE * /--- BLOCK NOTCALC 00 000 76/06/17 16.11 * NOTCALC SA3 NARRAYS NZ X3,ARYUSED JUMP IF WHOLE ARRAYS USED NOARAY SX7 0 SA7 ARAYFLG INDICATE RESULT NOT ARRAY EQ VARSOK2 * ARYUSED SA3 TMPAFLG =0IF NO OPERATIONS PERFORMED NZ X3,NOAERR NO ARRAY CALCS ALLOWED * PROBLEM IS ARAY CALCS USE A0, ALSO USED BY GETVAR BX3 X2 TEST ADTYPE LX3 1 ARAYBIT AT LEFT PL X3,NOARAY JUMP IF RESULT NOT WHOLE ARRAY LX3 1 TEST TEMP ARAY BIT NG X3,TEMPERR CANT USE TEMPARAY ***CHANGE*** SA3 ARAYFLG =1 IF ARAYS PERMITTED BX7 -X3 REVERSE SIGN TO SA7 A3 NOTIFY CALLING PGM ARRAYS FOUND SX3 X3-1 NZ X3,NOAERR NO ARRAYS PERMITTED MX0 -17 BX1 -X0*X2 MASK OFF ARAY AND I/F BITS SB1 0 CAN STORE INTO 1ST ELEMENT EQ COMPILE EXIT WITH GETVAR=6 * /--- BLOCK NOSTORE 00 000 77/02/26 13.31 * NOSTORE SB1 1 CANT STORE INTO THIS SA2 PUTCOMP ZR X2,COMPILE EXIT IF NOT -PUTCOMP- CALL EQ EQERR LONGLIT BSS 0 RJ RLLIT (X6) = LONG LITERAL MX0 59 MASK OUT *LITS* BIT LX1 60-LITSHFT BX1 X0*X1 LX1 LITSHFT MX0 -XCODEAL BX2 X6 ***SEE WHETHER LITERAL CAN BE EXPRESSED AS SHORT INTEGER NG X6,LNGLIT2 SHORT LITERAL CANT BE NEGATIVE BX3 X1 X1 HAS COMPLETE GETVAR CODE AX3 XCODEAL+3 GET I/F BIT ZR X3,ILNGLIT ZERO IF LONG INTEGER UX2 X2,B1 FIX THE FLOATING LITERAL--MAY BE INTEGER LX2 X2,B1 PX3 X2 NX3 X3 BX3 X6-X3 COMPARE REFLOATED INTEGER WITH F LITERAL NZ X3,LNGLIT2 JUMP IF FRACTIONAL FLOATING LITERAL BX6 X2 CALL IT A LONG INTEGER MX3 57-XCODEAL DROP F BIT BX1 -X3*X1 ILNGLIT BX3 X0*X6 SEE WHETHER LONG INTEGER IS IN FACT SHORT NZ X3,LNGLIT2 JUMP IF LONGER THAN XCODEAL BITS BX1 X6 OTHERWISE, SHORT LITERAL HAS CODE 0 EQ NOSTORE LNGLIT2 BX0 X0*X1 SAVE CODE TYPE RJ LSEEK PLANT LITERAL MX1 -XCODEAL BX0 X0*X1 BX1 X0+X6 X6 RETURNED WITH EXTRA STORAGE ADDRESS EQ NOSTORE * ENDARAY SX0 B0 THIS IS LIKE ENDL2 SA1 CMOVFLG NZ X1,COMPEND SX7 23B LX7 21 COMPILE JP B3 RJ LONGI LAST INSTRUCTION RJ PAD RJ MOVCODE AND MOVE CODE TO EXTRA STORAGE EQ COMPEND CREATE FINAL CALC CODE * * * /--- BLOCK LOGICAL 00 000 78/01/25 13.49 TITLE COMPILE LOGICAL EXPRESSIONS * COMPLOG SX7 B0 CLEAR FLOAT FLAG SA7 FLOAT SA2 NUNITS NG X2,CMPLG0 RJ SAMEUZ LOGICAL OPERATIONS * EXPONENTIATION JUMPS TO CMPLG0 WITH FLOAT SET.... CMPLG0 RJ PREBIN FIND OUT MODES (I OR F) SX7 1 FLAG NOT LITERALS SA7 NOTLITS SX6 B3 SAVE FLOATING/INTEGER FLAG SA6 FFLT JP B3+COMPL B3=0,1,2,3 FOR II,IF,FI,FF ARGS COMPL EQ CMPLOG1 BOTH ARGUMENTS INTEGERS EQ COMPIF FIRST I, SECOND FLOATING EQ COMPFI FIRST F, SECOND I EQ COMPFF BOTH ARGUMENTS FLOATING COMPIF LX0 1 FLAG FIRST OPERAND FOR MODE CHANGE BX7 X1+X0 (PREBIN LEAVES X0 WITH I/F MASK IN IT) SA7 A1 EQ COMPFF COMPFI LX0 1 FLAG SECOND OPERAND FOR MODE CHANGE BX7 X2+X0 SA7 A2 COMPFF SX7 1 FLAG FLOATING RESULT LX7 XCODEAL+3 SA7 FLOAT CMPLOG1 SA4 NARRAYS NZ X4,ACMPLOG JUMP IF ARRAY OPS IN PROGRESS CMPLGA1 SB1 2 RJ FORCEX FORCE ARG INTO X2 RJ FREEX THEN FREE THE REGISTER * (BECAUSE WE USE ITS CONTENTS IMMEDIATELY) CMPLOG2 SA1 NADS WORK ON FIRST ARGUMENT SX7 X1-1 ZR X7,FORMERR ERROR IF NO OPERANDS SA7 A1 BY DECREMENTING AD POINTER EQ CMPF31 * * HANDLE 2-ARG FUNCTIONS WITH ARRAY ARGUMENTS * ACMPLOG SA1 NADS SA2 X1+ADS SA3 A2-1 OPERAND ADS 1,2 IN X3,X2 BX7 X3+X2 TEST WHOLARRAY FLAG LX7 1 IN BIT 58 PL X7,CMPLGA1 EXIT IF NEITHER IS ARRAY * UP TO HERE SHOULD BE INLINE CODE FOR SPEED RJ BINARY INITIALIZE AND LOAD ARRAYS SA1 SAVEOP SX0 X1-FUNCT0 GET FUNCTION NUMBER RJ GENFCT GENERATE RJ FUNCTIONSUBR SX7 10611B RJ SHORT GENERATE CODE FOR BX6 X1 EQ ENDINSA GENERATE RJ ALOOPS * * * /--- BLOCK INTCMP 00 000 77/12/18 17.03 TITLE FUNCTIONS AND SYSTEM VARIABLES * * HANDLE -INT- FUNCTION * INTCMP RJ FCCHK CHECK FOR CONSTANT ZR X0,ICOMPF ZR X2,INTIN JUMP IF INTEGER BX1 X3 RJ TINTX TAKE INTEGER PART OF CONSTANT MX4 0 RESULT IS INTEGER * INT10 SA2 NUNITS PL X2,ICOMPF EXIT IF *UNITS* INVOLVED NZ X4,INTLONG CHECK FOR FLOATING LITERAL INTIN MX0 -XCODEAL BX0 X0*X1 NZ X0,INTLONG STORE LONG LITERAL IN LIT TABLE BX7 X1 0 CODE = SHORT LITERAL CALC EQ INTBOTH * INTLONG BX6 X1 (X6) = LITERAL SX1 X4+1 LONG INTEGER CALC RJ SLLIT (X6) = ADTYPE WITH ADDRESS BX7 X6 INTBOTH SA1 NADS SA7 X1+ADS STORE LONG LITERAL GETVAR CODE EQ CMPFCT3 * * HANDLE -ROUND- FUNCTION * RNDCMP RJ FCCHK CHECK FOR CONSTANT ZR X0,ICOMPF ZR X2,INTIN JUMP IF INTEGER BX1 X3 RJ TRND ROUND CONSTANT MX4 0 RESULT IS INTEGER EQ INT10 * * HANDLE FRAC FUNCTION * FRACCMP RJ FCCHK CHECK FOR CONSTANT ZR X0,COMPFCT NZ X2,FRACTK JUMP IF FLOATING SX1 0 EQ FRACBTH FRACTK BX1 X3 RJ TFRACX FRACTIONAL PART OF CONSTANT FRACBTH SX4 10B RESULT IS FLOATING EQ INT10 * /--- BLOCK L/R MASK 00 000 77/12/19 16.43 EJECT * * HANDLE -LMASK- AND -RMASK- FUNCTIONS * LMSKCMP RJ FCCHK CHECK FOR CONSTANT ZR X0,ICOMPF ZR X2,LMSKCM1 JUMP IF INTEGER BX1 X3 RJ TRND CONVERT TO INTEGER LMSKCM1 RJ TLMASK CREATE LMASK MX4 0 RESULT IS INTEGER EQ INT10 * MASKERR EQ ICOMPF IF ERROR, LET EXECUTOR GIVE IT. * RMSKCMP RJ FCCHK CHECK FOR CONSTANT ZR X0,ICOMPF ZR X2,RMSKCM1 JUMP IF INTEGER BX1 X3 RJ TRND CONVERT TO INTEGER RMSKCM1 RJ TRMASK CREATE RMASK MX4 0 RESULT IS INTEGER EQ INT10 * /--- BLOCK VARLOC 00 000 86/03/12 19.32 * EJECT * * HANDLE -VARLOC- FUNCTION * VARLCMP RJ FCCHK CHECK FOR CONSTANT NZ X0,VARCNST IS A CONSTANT NG X1,VARINRG EXPRESSION/INDEXED VARIABLE SA1 FINDXED FLAG FOR INDEXED VARIABLE ZR X1,ICOMPF INDEXED, CREATE CALL TO TVARLOC * SX4 X4-1 ZR X4,VARL2 IF TYPE 3 GETVAR (COMMON) SX1 VARLIM+1 IX1 X3-X1 NG X1,VARL2 IF STUDENT VAR SA1 ARVARS SA4 ASVARS IX1 X1-X4 X4 NOW BIAS TO NR1 IX1 X3-X1 SX4 X1-RVARLIM-1 NG X4,VARCMPT SA1 ALVARS TRY LOCAL VARS SA4 ASVARS IX1 X1-X4 X4 NOW BIAS TO NL1 IX1 X3-X1 SX4 X1-LVARLIM-1 NG X4,VARCMPT EQ ICOMPF VARL2 BX1 X3 X3 = THE XCODEAL BITS, INDEX EQ VARCMPT * VARINRG SA1 FINDXED FLAG FOR IF INDEXED VARIABLE ZR X1,ICOMPF INDEXED, CREATE CALL TO TVARLOC * VARCNST MX1 0 CONSTANT/EXPRESSION VARCMPT MX4 0 RESULT IS INTEGER EQ INT10 * * EJECT * * HANDLE FIP FUNCTIONS * FIPCMP RJ FCCHK CHECK FOR CONSTANT NZ X0,FIPERR --- ERROR IF CONSTANT NG X1,FIPCMP2 --- IF EXPRESSION/INDEXED VAR. EQ ICOMPF --- CREATE FUNCTION CALL * FIPCMP2 SA1 FINDXED INDEXED VARIABLE FLAG NZ X1,FIPERR --- ERROR IF EXPRESSION EQ ICOMPF --- CREATE FUNCTION CALL * /--- BLOCK ICMPNAM 00 000 76/12/11 01.11 EJECT * * HANDLE INTEGER SPL NAMES LIKE -ANSOK- -WHERE- * ICMPNAM SX7 B0 FLAG INTEGER RESULT EQ CMPNAMI * * HANDLE FLOATING SPL NAMES -SIZE-CLOCK-PROCTIM- * COMPNM SX7 1 FLAG FLOATING RESULT LX7 XCODEAL+3 CMPNAMI SA7 FLOAT SA1 NADS SX7 X1+1 INCREMENT NADS TO CREATE REFERENCE TO X1 SX1 X7-ADSMAX PL X1,LNGERR ERROR IF TOO MANY ADS SA7 A1 SB1 1 CHECK THAT REGISTER X1 IS AVAILABLE RJ CHEKRR MOVE X1 ELSEWHERE IF NECESSARY SA2 NUNITS NG X2,CMPFCT2 JUMP IF NO UNITS INVOLVED RJ UADZERO CLEAR UNITS COEFFS * SA1 NARRAYS * NZ X1,NOAERR NO ARRAY OPERATIONS ALLOWED YET EQ CMPFCT2 * * *I/F MODE OF ARG IRRELEVANT FOR ABS(X) OR COMP(X) IFCOMP RJ IFIRR SET FLOAT SPEC TO OPERAND MODE SX7 B0 FLAG NOT ARRAY OPERATION SA7 FFLT SET AS INTEGER ARGUMENT EQ CMPF3 * IFIRR EQ * I/F MODE IRRELEVANT SA1 NADS GET OPERAND TYPE SA1 X1+ADS SX0 10B LX0 XCODEAL I/F BIT BX7 X0*X1 SA7 FLOAT SAVE IN FLOAT FOR RESULT I/F TYPING EQ IFIRR * * ICOMPF MX7 0 INTEGER RESULT SA7 FLOAT SX7 1 THEN PLACE I/F BIT MASK IN X7 LX7 XCODEAL+3 EQ CMPF1 * * * PROCESS SQRT(X) SQTFCT SA2 NUNITS NG X2,COMPFCT JUMP IF NO UNITS SA3 =.5 RJ MULTEM UNIT DIMENSIONS TIMES .5 SQTFCT2 SX7 1 ENTRY POINT FOR X**.5 LX7 XCODEAL+3 SA7 FLOAT SA1 NADS SA2 X1+ADS GET OPERAND TO CHECK FOR NEEDED MODE CHANGE BX6 X7*X2 GET FLOAT BIT SA6 FFLT SAVE FLOAT BIT EQ CMPF3 * * CONST SA3 NADS SX7 X3+1 INCREMENT NADS SX6 X7-ADSMAX ERROR IF TOO MANY ADS SA7 A3 MX6 0 SA6 X7+ADS ADD ADDRESS TO ADS LIST SA2 NUNITS NG X2,CONST1 SEE IF *UNITS* RJ UADZERO EQ CONST1 'N'O'T'E'; CONSTANT CHECKED FOR SPECIAL'. * * /--- BLOCK ACMPF30 00 000 78/06/06 21.44 * HANDLE ONE-ARGUMENT FUNCTIONS WITH ARRAY OPERANDS ACMPF30 SA1 NADS ENTER WITH X4=NARRAYS SA2 X1+ADS GETVAR CODE LX2 1 LOOK AT WHOLE-ARRAY BIT PL X2,CMPF31 EXIT IF NOT ARRAY LX2 59 RESTORE GETVARCODE MX0 -XCODEAL BX2 -X0*X2 GET ARRAYWD ADDR SA2 X2+INFO GET ARRAYWD BX7 X2 SA7 ASIZE SAVE FOR CALCTMP BX6 -X4 SA6 NARRAYS - FOR ALOOPS FLAG SB1 0 REUSE TMPARRAY RJ CALCTMP RJ ARYPREP CLEAR X1,2,6, FORM RJ ABUFCHK SB1 RAINIT RJ LDAINIT GENERATE ALOOP INITIALIZATION SB1 1 RJ LDARRAY GENERATE LOAD OPERAND TO X1 SA1 SAVEOP SX0 X1-FUNCT0 GET FUNCTION NUMBER RJ GENFCT GENERATE RJ FUNCTION SX7 10611B RJ SHORT GENERATE CODE FOR BX6 X1 RJ TMPAD CHANGE ADTYPE TO TEMP ARRAY PLATO SA1 PRELEX NG X1,ENDINSA QUIT IF REGULAR LEX CALL SA1 NCOMPIL MAKESURE COMPIL HAS RJ LEX BX7 X1 SA7 COMPIL ENDIF EQ ENDINSA GO DO ALOOP * * * HANDLE ONE-ARGUMENT FUNCTION CALLS * COMPFCT SX7 1 FLAG AS FLOATING RESULT LX7 XCODEAL+3 SA7 FLOAT CMPF1 SA1 NADS SA2 X1+ADS GET OPERAND TO CHECK FOR NEEDED MODE CHANGE BX6 X7*X2 GET FLOAT BIT SA6 FFLT SAVE FLOAT BIT SA2 NUNITS NG X2,CMPF3 JUMP IF NO UNITS RJ ZEROU CHECK FOR ZERO UNIT COEFFS * CMPF3 SA1 INHAND RESTORE CORRECT INHAND PRECEDENCE LEVEL SA1 X1+PRECED BECAUSE WE MAY BE COMPILING BX7 X1 A PARENS-LESS FUNCTION. SA7 INHANDL (SEE -ISFUNCT- CODE ABOVE) SA4 NARRAYS NZ X4,ACMPF30 JUMP IF ARRAY OPS IN PROGRESS CMPF31 SB1 1 RJ FORCEX FORCE ARG INTO X1 CMPFCT2 RJ SETAD SET AD REFERENCE IN ADS LIST CONST1 SA1 SAVEOP SX0 X1-FUNCT0 GET FUNCTION NUMBER RJ GENFCT GENERATE CODE TO LOAD FN TO X1 CMPFCT3 BSS 0 PLATO SA1 PRELEX NG X1,ENDINST JUMP IF PREAD AND PREOP CONTAIN INFO SA1 NCOMPIL ELSE INSURE LOCATION COMPIL CONTAINS RJ LEX BX7 X1 SA7 COMPIL ENDIF EQ ENDINST * /--- BLOCK ARAYFN 00 000 77/12/19 16.51 EJECT * * SCALAR RESULT ARRAY FUNCTIONS * ARAYFN SA1 NADS SA2 X1+ADS OPERAND ADTYPE MX0 -XCODEAL MX7 1 LX7 XCODEAL+4 I/F BIT MASK BX7 X7*X2 I/F BIT OF OPERAND SA7 FLOAT SAVE IT FOR SETAD BX6 -X0*X2 LX2 1 PL X2,NOTARFN SA1 X6+INFO GET ARRAYWD BX6 X1 SA6 ASIZE SAVE IT * SA3 SAVEOP SX6 X3-ASUMOP GET RELATIVE ARAYFN NUMBER IX6 X6+X6 INTEGER ARAYFN TYPE ZR X7,ARAYF10 JUMP IF INTEGER TYPE SX6 X6+1 ADD 1 TO TYPE NUM IF FLOATING ARAYF10 SA6 IOP SAVE TYPE NG X6,COMPERR SX6 X6-12 ONLY ARAYFNTYPES 0-11 LEGAL YET PL X6,COMPERR RJ ARYPREP CLEAR X1,2,6, FORM RJ ABUFCHK * /--- BLOCK ARAYFN10 00 000 76/07/29 00.06 SA1 ASIZE GET BACK ARRAYWD LX1 3 PL X1,ARAYF20 JUMP IF NOT SEGMENTED ARRAY * RJ ASEGTMP CHANGE SEG ARRAY TO REAL TEMP. * ARAYF20 SA1 IOP GET TYPE SX7 6120B SB2 B0+... LX7 18 BX7 X7+X1 RJ LONGI GENERATE SB2 (ARAYFN TYPE) * SA1 NADS SA1 X1+ADS ARRAY ADTYPE RJ GETARAD X3=ARAYSTART ADDR * SX7 5100B LX7 18 BX7 X7+X3 RJ LONGI GENERATE SA0(ARAY ADDR) SA1 ASIZE GET BACK ARRAYWORD MX0 -9 AX1 45 BX1 -X0*X1 SIZE FIELD SX7 6110B SB1 B0+... LX7 18 BX7 X7+X1 RJ LONGI GENERATE SB1 SIZE SB1 RARAYFN RJ LDASUB GENERATE RJ ARAYFN RJ SETAD RESULT LEFT IN X1 SA1 NARRAYS SX7 X1+1 SA7 NARRAYS INCREMENT NUMBER ARRAY OPNS EQ CMPFCT3 * NOTARFN SB1 1 IS SCALAR OPERAND RJ FORCEX RETURN RESULT=OPERAND RJ SETAD IN X1 EQ CMPFCT3 * * NEXT SUBROUTINE CONVERTS SEGMENTED TO TEMPORARY REALARRAY * ASEGTMP EQ * (SET ASIZE=ARAYWD BEFORE ENTRY) SB1 RAINIT GENERATE RJ AINIT RJ LDAINIT SB1 1 GENERATE CODE TO LOAD AND RJ LDARRAY CONVERT SEG ARAY TO INTEGER SB1 1 RJ CALCTMP FORCE NEW TMPARRAY ADDRESS RJ TMPAD FORM NEW TMPARRAYWD AND ADTYPE SX7 10611B GENERATE BX6 X1 RJ SHORT SA1 TMPARAY STORE ADDRESS RJ LDALOOP * NOTE...DONT HAVE TO RJ AIFBIT SINCE RESULT IS INTEGER RJ LDAINTR GENERATE TIMESLICE CHECK EQ ASEGTMP * * /--- BLOCK ARAYTRSP 00 000 76/07/29 01.19 * ATRANSP SX7 4 'TRANSP('A) TYPE FOR DOTMULT SA7 IOP SAVE IT ATRA2 SA1 NADS SA2 X1+ADS OPERAND ADTYPE LX2 1 TEST WHOLEARRAY BIT PL X2,NOTATRA JUMP IF SCALAR LX2 59 MX0 -XCODEAL BX1 -X0*X2 SA2 X1+INFO ARRAY INFO WORD ** BX7 X2 LX7 3 PL X7,ATRA3 JUMP IF NOT SEGMENTED BX7 X2 SA7 ASIZE SAVE IT FOR CALCTMP RJ ARYPREP CLEAR X1,X2,X6, FORM RJ ABUFCHK RJ ASEGTMP CONVERT SEG ARAY TO REAL TEMP SA2 ASIZE RESTORE INFO ** ATRA3 BX0 X2 SAVE IT MX6 -9 AX2 27 BX4 -X6*X2 COLS AX2 9 BX7 -X6*X2 ROWS AX2 9 BX6 -X6*X2 SIZE MX3 -18 LX3 27 ROWCOL MASK SB1 5 SA1 IOP FN TYPE SB3 X1 EQ B3,B1,DOTM21 JUMP IF REV(X) BX0 X3*X0 CLEAR OUT ROW/COL BX1 X4 LX1 9 BX1 X1+X7 LX1 27 BX0 X1+X0 RESULT HAS COLS/ROWS REVERSED EQ DOTM21 GENERATE CALL TO DOTPROD * ATRACE EQ TSTERR TRACE * AREVERS SX7 5 'REV('A) TYPE FOR DOTPROD SA7 IOP SAVE IT EQ ATRA2 * NOTATRA MX0 1 LX0 XCODEAL+4 I/F BIT MASK LX2 59 RESTORE ADTYPE BX7 X0*X2 OPERAND I/F TYPE SA7 FLOAT SAVE FOR SETAD EQ NOTARFN RESULT=OPERAND * /--- BLOCK INDEXEDVAR 00 000 78/09/19 20.26 TITLE INDEXED VARIABLES * * DESPITE THE LABELS, THIS BLOCK OF CODE CONCERNS * INDEXED VARIABLES, NOT REAL/COMPLEX ARRAYELEMENTS * SEE *ISARRAY* *MATRAY* ETC FOR THOSE * * ARAYN EQ * RETURN WITH LITERAL INDEX MX6 59 SA6 FINDXED FLAG NON-INDEXED VARIABLE *INDEX RETURNED IN X6 (NEGATIVE IF NOT LITERAL) SA2 NUNITS NG X2,ARAYN1 RJ ZEROU CHECK FOR ZERO UNIT COEFFS ARAYN1 SA1 NADS CHECK FOR LITERAL SA2 X1+ADS BX6 X2 A COPY OF GETVAR CODE NG X2,ARAYN3 NOT LITERAL IF IN REGISTER AX2 XCODEAL SHIFT OUT GETVAR ADDRESS ZR X2,ARAYN IF SHORT LITERAL, EXIT WITH INDEX IN X6 MX1 -4 ISOLATE TYPE CODE BX2 -X1*X2 SX7 X2-1 NZ X7,ARAYN2 JUMP IF NOT LONG INTEGER BX1 X6 RJ RLLIT (X6) = LITERAL NG X6,VARERR EQ ARAYN ARAYN2 SX7 X2-11B CHECK FOR FLOATING LITERAL NZ X7,ARAYN3 JUMP IF NOT FLOATING LITERAL BX1 X6 RJ RLLIT (X6) = LONG LITERAL NG X6,VARERR SA3 =.5 ROUND THE FLOATING LITERAL FX6 X6+X3 UX6 X6,B2 FIX THE FLOATING LITERAL LX6 X6,B2 LEAVE IN X6 EQ ARAYN RETURN INDEX IN X6 ARAYN3 LX6 1 WHOLE-ARRAY BIT AT TOP NG X6,NOAERR INDEX CANT BE WHOLE-ARRAY MX6 59 SET X6 NEGATIVE TO SIGNAL NOT LITERAL EQ ARAYN * * ARYII RJ ARAYN CHECK FOR LITERAL INDEX SA0 VARLIM STUDENT VAR LIMIT SA1 ASVARS BX7 X1 ADDRESS OF STUDENT BANK VARS SA7 IOP NG X6,IARRAY JUMP IF NOT LITERAL INDEX SX7 2 STUDENT BANK INTEGER ARYV LX7 XCODEAL BX7 X7+X6 SA7 A2 REPLACE ADS REFERENCE (A2 SET BY ARAYN) CALL VBOUND CHECK STUDENT BANK BOUNDS EQ ENDINST VBOUND WILL EXIT TO VARERR IF NO GOOD * ARYFI RJ ARAYN CHECK FOR LITERAL INDEX SA0 VARLIM STUDENT VAR LIMIT SA1 ASVARS BX7 X1 ADDRESS OF STUDENT BANK VARS SA7 IOP NG X6,FARRAY JUMP IF NOT LITERAL INDEX SX7 12B STUDENT BANK FLOATING EQ ARYV * * /--- BLOCK RARRAY 00 000 79/02/09 12.09 * ARYCII RJ ARAYN CHECK FOR LITERAL INDEX SA0 NCVRLIM INDEX LIMIT SA1 ACVARS BX7 X1 ADDRESS OF COMMON VARS SA7 IOP NG X6,IARRAY JUMP IF NOT LITERAL INDEX SX7 3 COMMON INTEGER ARYC LX7 XCODEAL BX7 X7+X6 SA7 A2 REPLACE ADS REFERENCE (A2 SET BY ARAYN) CALL CBOUND CHECK STUDENT BANK BOUNDS EQ ENDINST CBOUND WILL EXIT TO VARERR IF NO GOOD * ARYCFI RJ ARAYN CHECK FOR LITERAL INDEX SA0 NCVRLIM INDEX LIMIT SA1 ACVARS BX7 X1 ADDRESS OF COMMON VARS SA7 IOP NG X6,FARRAY JUMP IF NOT LITERAL INDEX SX7 13B COMMON FLOATING EQ ARYC * * RARRAY RJ ARAYN CHECK FOR LITERAL INDEX SA1 ARVARS BX7 X1 ADDRESS OF R-VARIABLES SA7 IOP SA1 RVARL GET NUMBER OF R-VARIABLES SA0 X1 NG X6,IARRAY JUMP IF NOT LITERAL INDEX MX7 0 SA7 FLOAT MARK AS INTEGER SA7 FINDXED FLAG EXECUTION TIME VARIABLE * NRK CALL RBOUND CHECK BOUNDS SA1 ASVARS COMPUTE BIAS TO R-VARS SA3 ARVARS IX1 X3-X1 IX6 X1+X6 ADD BIAS TO INDEX SX7 2 LX7 XCODEAL TYPE 2 = STUDENT BANK SA1 FLOAT BX7 X1+X7 MERGE I/F BIT AND TYPE BX7 X6+X7 ATTACH ADDRESS SA1 NADS SA7 X1+ADS REPLACE ENTRY IN ADDRESS STACK EQ ENDINST * RFARRAY RJ ARAYN CHECK FOR LITERAL INDEX SA1 ARVARS BX7 X1 ADDRESS OF R-VARIABLES SA7 IOP SA1 RVARL GET NUMBER OF R-VARIABLES SA0 X1 NG X6,FARRAY JUMP IF NOT LITERAL INDEX MX7 0 SA7 FINDXED FLAG EXECUTION TIME VARIABLE SX7 1 LX7 XCODEAL+3 MARK AS FLOATING SA7 FLOAT EQ NRK LARRAY RJ ARAYN CHECK FOR LITERAL INDEX SA1 ALVARS BX7 X1 ADDRESS OF L-VARIABLES SA7 IOP SA1 LVARN X1 = NUMBER OF L-VARIABLES SA0 X1 NG X6,IARRAY JUMP IF NOT LITERAL INDEX * MX7 0 SA7 FLOAT MARK AS INTEGER SA7 FINDXED FLAG EXECUTION TIME VARIABLE * * /--- BLOCK RARRAY 00 000 78/09/19 20.28 NLK RJ =XLBOUND CHECK BOUNDS SA1 ASVARS COMPUTE BIAS TO L-VARS SA3 ALVARS IX1 X3-X1 IX6 X1+X6 ADD BIAS TO INDEX SX7 2 LX7 XCODEAL TYPE 2 = N(I) REFERENCE SA1 FLOAT BX7 X1+X7 MERGE I/F BIT AND TYPE BX7 X6+X7 ATTACH ADDRESS SA1 NADS SA7 X1+ADS REPLACE ENTRY IN ADDRESS STACK EQ ENDINST * LFARRAY RJ ARAYN CHECK FOR LITERAL INDEX SA1 ALVARS BX7 X1 ADDRESS OF L-VARIABLES SA7 IOP SA1 LVARN X1 = NUMBER OF L-VARIABLES SA0 X1 NG X6,FARRAY JUMP IF NOT LITERAL INDEX * MX7 0 SA7 FINDXED FLAG EXECUTION TIME VARIABLE SX7 1 MARK AS FLOATING LX7 XCODEAL+3 SA7 FLOAT EQ NLK * * /--- BLOCK IARRAY 00 000 79/02/09 12.10 * IARRAY SX7 B0 INTEGER INDEXED VARIABLE EQ SCARRAY FARRAY SX7 1 FLOATING INDEXED VARIABLE LX7 XCODEAL+3 FORM FLOAT BIT SCARRAY SA7 FLOAT FLOAT=0/1 FOR I/F SB1 1 STUDENT OR COMMON ARRAY RJ GENREAD READ INDEX INTO X1 RJ FREEX FREE REGISTER WHICH NOW HOLDS INDEX MX6 0 SA6 FINDXED FLAG INDEXED VARIABLE IN X1 SA1 NADS DETERMINE WHETHER INDEX IS I OR F SA1 X1+ADS GET OPERAND LX1 59-XCODEAL-3 SHIFT I/F BIT INTO SIGN BIT PL X1,SCARAY2 JUMP IF INTEGER INDEX RJ INDXFLT ROUND INDEX * SCARAY2 SX7 B1 CONSTRUCT -SB1 XN- (INDEX IS IN XN) LX7 3 SX7 X7+63100B FORM SB1 XN+B0 RJ SHORT SHORT PRESERVES B1 SX7 A0 VARLIM OR NCVRLIM--INDEX LIMIT SX6 612B FORM SB2 VARLIM OR SB2 NCVRLIM LX6 21 BX7 X6+X7 30-BIT INSTRUCTION RJ LONGI SA1 LLAERR ADDRESS OF -ARAYERR- SX6 0601B GE B0,B1,ARAYERR LX6 18 BX7 X1+X6 RJ LONGI SA1 LLAERR ADDRESS OF -ARAYERR- SX6 0721B LT B2,B1,ARAYERR LX6 18 BX7 X6+X1 RJ LONGI SA1 IOP PICK UP BASE VARIABLE ADDRESS SX7 5111B LX7 18 FORM A SA1 B1+K BX7 X1+X7 RJ LONGI SA1 FLOAT SX7 4 FLAG ARRAY AS TYPE 4 GETVAR CODE LX7 XCODEAL BX7 X1+X7 SA7 A1 SETAD WILL MERGE FLOAT WITH SIGN BIT RJ SETAD SET AD REFERENCE EQ ENDINST * * /--- BLOCK SEGMENT 00 000 77/12/18 17.17 TITLE SEGMENT INDEXING * PRE-CHECK TO SEE IF SEGMENT WILL BE STORED INTO * SEGRAY SB2 SEGRAY1 RJ NESTCHK EQ SEGPUT * * SUBROUTINE TO CHECK IF NESTED SEG/ARRAY OPS * B2 CONTAINS NESTED EXIT, B1 SAVES OP NESTCHK EQ * EXITS HERE IF NOT NESTED SA1 INHAND LOAD FORCING OPERATOR SX7 X1-OPASIGN NZ X7,PARCHK JUMP IF NOT ASSIGN SA1 NOPS SX1 X1-1 BACK UP TO PREVIOUS OP ZR X1,NESTCHK ASSIGN INTO IF THIS IS LAST OP SA1 X1+OPS SX2 X1-OPSEG CHECK FOR NESTING ZR X2,NESTOUT JUMP OUT IF NESTED ARRAY/SEG SX2 X1-OPMAT ZR X2,NESTOUT SX2 X1-OPVEC ZR X2,NESTOUT SX2 X1-OPSCAL ZR X2,NESTOUT SX2 X1-ARAYOP ZR X2,NESTOUT SX2 X1-ARAYOP-1 ZR X2,NESTOUT SX2 X1-CARAYOP ZR X2,NESTOUT SX2 X1-CARAYOP-1 ZR X2,NESTOUT SX2 X1-RARAYOP ZR X2,NESTOUT SX2 X1-RARAYOP-1 ZR X2,NESTOUT SX2 X1-LARAYOP ZR X2,NESTOUT SX2 X1-LARAYOP-1 ZR X2,NESTOUT SB2 B0 FLAG TO MARK ASSIGNED INTO EQ NESTCHK * CHECK FOR (SEG) OR (ARRAY) PARCHK SX7 X1-OP) INSIDE NESTED PARENS NZ X7,NESTOUT JUMP IF NO RT PAREN SA1 NOPS SX1 X1-1 BACK UP TO PREVIOUS OPERATOR ZR X1,BADPAR UNBALANCED PARENS IF NO OP SA2 X1+OPS LOAD PREVIOUS OPERATOR SX2 X2-OP( NZ X2,NESTOUT EXIT IF NOT LEFT PAREN SX6 B1 OP WAS IN B1(ALSO IN SAVEOP) SA6 X1+OPS MOVE BACK -ARRAY- OPCODE SA3 X1+OPSL+1 LOAD ARRAY PRECEDENCE BX6 X3 SA6 X1+OPSL MOVE BACK ARRAY PRECEDENCE SA6 PREVOPL BX7 X1 UPDATE *NOPS* SA7 A1 SA1 TOPCNT SX6 X1-2 DECREMENT *OPCNT* FOR () SA6 A1 MX6 0 SA6 LASTOP FOR UNARY + AND - CHECKS EQ COMPIL * NESTOUT JP B2 GO COMPILE SEG/ARRAY * * /--- BLOCK SEGMENT 00 000 78/09/15 17.05 * * COMPILE CODE TO LOAD SEGMENT TO X1 * SEGRAY1 MX7 0 SET FOR INTEGER SA7 FLOAT SA1 NADS SX7 X1-1 MUST BE TWO ADDRESSES NG X7,SEGERR ZR X7,SEGERR MX0 -XCODEAL SA2 X7+ADS LOAD ADTYPE OF INFO WORD BX0 -X0*X2 MASK OFF ADDRESS OF LITERAL SA2 X0+INFO LOAD SEGMENT INFO WORD BX6 X2 SA6 SEGWD LX6 2 POSITION -VERTICAL- BIT NG X6,SEGVERT * CONDEN SA1 X1+ADS LOAD INDEX ADTYPE BX2 X1 AX2 XCODEAL POSITION TYPE CODE ZR X2,SCONST TREAT CONSTANT INDEX SPECIALLY ENDIF * SEG05 SB1 1 READ INDEX TO X1 RJ FORCEX SA1 NADS SX7 X1-1 BACK UP IN ADDRESS STACK SA7 A1 SA1 X1+ADS SEE IF INDEX IS I OR F LX1 59-XCODEAL-3 PL X1,SEG10 JUMP IF INTEGER INDEX RJ INDXFLT ROUND FLOATING TO INTEGER * SEG10 RJ LDLITAD GENERATE (SB1 SEG LITWD ADDR) SA1 LLSEGI RJ ADDRESS SX7 0100B LX7 18 POSITION RJ OPERATION CODE BX7 X1+X7 GENERATE RJ SEGMNTI RJ LONGI RJ PAD * SCONST COMES HERE TOO... SEG20 SX7 1 SET UP GETVAR CODE FOR LITERAL LX7 14 SA7 FLOAT RJ SETAD CHANGE SEGMENT ENTRY TO LITERAL MX6 0 SA6 FINDXED FLAG INDEXED VARIABLE *SIGH* EQ ENDINST * /--- BLOCK SEGMENT 00 000 77/12/18 17.19 TITLE GENERATE CODE FOR CONSTANT INDEX CASE * * PRODUCE CODE FOR LOAD OF CONSTANT INDEX CASE * CONDEN SCONST SA2 NADS SX7 X2-1 BACK UP IN ADDRESS STACK SA7 A2 SX1 X1-1 COMPUTE INDEX NG X1,VARERR PX7 X1 CONVERT INDEX TO FLOATING NX7 X7 SA3 =0.01 AVOID ROUND-OFF ERROR FX3 X3+X7 NX3 X3 SA2 SEGWD LOAD SEGMENT INFO WORD SX7 X2 PICK OFF BYTES/WORD PX6 X7 NX6 X6 CONVERT TO FLOATING FX3 X3/X6 COMPUTE WORD COUNT UX3 X3,B2 LX3 X3,B2 X3 = WORD COUNT DX7 X3*X7 IX7 X1-X7 X7 = REMAINDER SA7 SEGWD1 AX2 18 BIAS TO START OF ARRAY SX6 X2 IX6 X3+X6 COMPUTE INDEX PL X2,SCSVAR STUDENT BANK OR ROUTER VARIABLE CALL CBOUND CHECK AGAINST COMMON BOUNDS SA1 ACVARS BASE ADDRESS FOR COMMON EQ SCSA1 * SCSVAR SB1 X2-VARLIM-1 CHECK BASE ADDRESS PL B1,SCRVAR JUMP IF ROUTER VARIABLE CALL VBOUND CHECK STUDENT BANK BOUNDS EQ SCSTUD * SCRVAR SA1 ASVARS ADDRESS OF STUDENT VARIABLES SA3 ARVARS ADDRESS OF ROUTER VARIABLES IX1 X3-X1 BX7 X6 SAVE ADDRESS REL TO STUDENT IX6 X6-X1 SUBTRACT OFF R-VARIABLE BIAS SB1 X6-RVARLIM-1 CHECK BASE ADDRESS PL B1,SCLVAR JUMP IF LOCAL VARIABLE * CALL RBOUND CHECK ROUTER VARIABLE BOUNDS BX6 X7 EQ SCSTUD * SCLVAR SA1 ASVARS ADDRESS OF STUDENT VARIABLES SA3 ALVARS ADDRESS OF LOCAL VARIABLES IX1 X3-X1 BX6 X7 RESTORE ADDRESS REL TO STUDENT IX6 X6-X1 X6 = LOCAL BANK INDEX RJ =XLBOUND CHECK LOCAL VARIABLE BOUNDS BX6 X7 EQ SCSTUD * * * /--- BLOCK SEGVERT 00 000 78/01/25 16.20 * SCSTUD SA1 ASVARS BASE ADDRESS FOR STUDENT/ROUTER * SCSA1 IX6 X1+X6 ABSOLUTE ADDRESS TO LOAD SA6 IOP SB1 1 OBTAIN READ REGISTER RJ CHEKRR SX7 1 MARK REGISTER IN USE SA7 B1+RX SX6 B1 SAVE REGISTER NUMBER SA6 FREG LX6 3 POSITION REGISTER NUMBER SX7 X6+5100B GENERATE A SAN B0+K SA1 IOP LX7 18 POSITION INSTRUCTION CODE BX7 X1+X7 ATTACH ADDRESS PORTION RJ LONGI * SA1 SEGWD LX1 1 SIGNED BIT NG X1,SCSA2 SKIP IF SIGNED SEGMENT SB1 2 RJ CHEKRR RESERVE X2 FOR MASK SX7 1 SA7 B1+RX MARK BUSY SA1 SEGWD LX1 1 GET INFO WORD BACK SCSA2 AX1 18+18+1 SX3 X1 PICK OFF BITS/BYTE COUNT SB2 X1 SA2 SEGWD1 LOAD BYTE INDEX DX6 X2*X3 SHIFT COUNT TO LEFT-JUSTIFY SB1 X6 EQ SEGVER3 GENERATE CODE TO EXTRACT SEGMT * ENDIF * /--- BLOCK SEGVERT 00 000 78/01/25 14.09 TITLE GENERATE CODE TO LOAD VERTICAL SEGMENT * * COMPILE CODE TO LOAD VERTICAL SEGMENT * SEGVERT RJ VSINDX GENERATE CODE TO LOAD INDEX SA1 NADS SX6 X1-1 BACK UP IN ADDRESS STACK SA6 A1 SA1 SEGWD LOAD SEGMENT INFO WORD LX1 1 PUTS SIGNBIT AT LEFT NG X1,SEGVER2 SKIP IF SIGNED SB1 2 RJ CHEKRR RESERVE X2 FOR MASK SX7 1 SA7 B1+RX MARK BUSY SEGVER2 SA1 SEGWD HERE WE GO AGAIN SB1 X1-1 STARTBIT-1 = LEFTJUSTIFY SHIFT LX1 1 PUTS SIGNBIT AT LEFT AX1 18+18+1 POSITION BITS / BYTE COUNT SB2 X1 BITS/BYTE SEGVER3 SA0 112B SPECIFY MASKREG=X2, WORD REG=X1 * RJ VREAD GENERATE VERTSEG EXTRACT CODE * * HERE, IF THE SEGMENT WAS SIGNED, X2 DIDN'7T GET CHECKED. * THIS MAY CAUSE A PROBLEM SOMEDAY, AND TRYING TO HELP... SB1 2 RJ FREEX RELEASE MASK REGISTER EQ SEG20 * * /--- BLOCK SVCONST 00 000 79/02/09 12.11 CONDEN TITLE GENERATE CODE FOR CONSTANT VERTICAL SEGMENT * * PRODUCE CODE FOR CONSTANT INDEX VERTICAL SEGMENT * SVCONST ZR X2,VARERR ERROR IF INDEX ZERO SB1 X2-1 SA3 SEGWD LOAD SEGMENT INFO WORD AX3 18 POSITION BASE ADDRESS SX6 X3+B1 INDEX + RELATIVE BASE ADDRESS NG X3,SVCC JUMP IF -NC- VARIABLE SA1 ASVARS IX7 X1+X6 COMPUTE ABSOLUTE ADDRESS SA7 SEGWD1 SB2 X3-VARLIM-1 PL B2,SVCR JUMP IF -NR- VARIABLE SX1 VARLIM SET END TEST EQ SVC100 * SVCR IX3 X3+X1 CM ADDR OF BASE SA2 ARVARS CM ADDR OF RVARS IX2 X3-X2 NR INDEX SB2 X2-RVARLIM-1 PL B2,SVCL IF COULD BE IN LOCAL VAR BANK * SA1 RVARL X1 = MAX RVAR INDEX SX6 X2+B1 X6 = RVAR INDEX EQ SVC100 * SVCL SA2 ALVARS CM ADDR OF LVARS IX2 X3-X2 NL INDEX SA1 LVARN X1 = MAX LVAR INDEX SX2 X2 IX3 X1-X2 NG X3,VARERR SX6 X2+B1 X6 = LVAR INDEX EQ SVC100 * SVCC SA3 ACVARS IX7 X3+X6 COMPUTE ABSOLUTE BASE ADDRESS SA7 SEGWD1 SX1 NCVRLIM SET END TEST * SVC100 IX0 X1-X6 CHECK IF INDEX IN BOUNDS NG X0,VARERR SVC110 SB1 1 CALL CHEKRR OBTAIN REGISTER X1 FOR READ SX6 1 SA6 RX+1 MARK REGISTER IN USE SA1 SEGWD1 SX7 5110B GENERATE SA1 B0+ADDRESS LX7 18 BX7 X1+X7 ATTACH ABSOLUTE ADDRESS CALL LONGI EQ VSINDX * ENDIF * * /--- BLOCK SEGPUT 00 000 77/12/18 17.24 TITLE SEGPUT * * SWITCH SEGMENT AND INDEX ADTYPES FOR LATER * ASSIGNMENT OPERATION * SEGPUT SA1 NADS SX7 X1-1 BACK UP INDEX IN ADDRESS STACK NG X7,SEGERR ZR X7,SEGERR SA3 X1+ADS LOAD ADTYPE OF INDEX EXPRESSION SA2 X1+ADS-1 GET SEGMENT ADTYPE BX6 X2 SA6 X1+ADS MOVE ADTYPE DOWN IN STACK BX6 X3 SA6 X1+ADS-1 MOVE INDEX UP IN STACK EQ ENDINST * /--- BLOCK GETARY 00 000 77/12/18 17.22 TITLE ARRAY/COMPLEX INDEXING * * SUBROUTINE TO PUT ARAYWD IN X1, ARAYWD2 OR 0 IN X2 * ENTER WITH NADS OF ARAYWD IN X7 (DONT CHANGE X6) GETARY EQ * SA1 X7+ADS LOAD ARRAY ADTYPE MX0 -XCODEAL MASK OUT ADDRESS BX2 -X0*X1 OF INFO WORD SA1 X2+INFO GET ARRAYWD IN X1 MX2 0 BX7 X1 LX7 4 MX0 -2 BX7 -X0*X7 MASK OFF BASE+SEG BITS ZR X7,GETARY IF NO ARAYWD2, EXIT WITH X2=0 SA2 A1+1 ARAYWD2 STORED AFTER ARAYWD EQ GETARY * * GETS ARAYWD AND PUTS IN X4 X7 HAS NADS * DONT TOUCH X1,X2,X3,X7 GETARY4 EQ * SA4 X7+ADS LOAD ARRAY ADTYPE MX0 -XCODEAL MASK OUT ADDRESS BX4 -X0*X4 OF INFO WORD SA4 X4+INFO GET ARRAYWD IN X4 EQ GETARY4 * * /--- BLOCK MATRAY 00 000 78/09/15 17.09 TITLE ARRAY PROCESSING * * PRE-CHECK TO SEE IF ARRAY WILL BE STORED INTO * MATRAY SB2 MATRAY1 RJ NESTCHK SETS B2=0 IF ASSIGNED INTO * MATRAY1 SA3 NADS MUST HAVE 2INDEX + ARRAYWD SX7 X3-3 SO CHECK FOR 3 ADS NG X7,MATERR * CONDEN SA1 X3+ADS LOAD 2D INDEX AD (COL) TO X1 SA2 A1-1 AND 1ST INDEX AD (ROW) TO X2 BX7 X1 AX7 XCODEAL+1 POSITION UPPER 2 GETVAR BITS NZ X7,MATRAY3 JUMP IF NOT CONSTANT BX7 X2 AX7 XCODEAL+1 ZR X7,MCONST JUMP IF BOTH INDICES CONST ENDIF * MATRAY3 ZR B2,MATPUT JUMP IF ASSIGNED INTO SB1 4 RJ LOADIND LOAD COL INDEX TO X4 RJ POPNADS BACK UP TO ROW INDEX SB1 3 RJ LOADIND LOAD ROW INDEX TO X3 RJ POPNADS BACK UP TO ARRAY ADTYPE RJ LDLITAD LOAD ARAYWD ADDR TO B1 SB1 1 RJ CHEKRR CLEAR X1 FOR RESULT SB1 4 RJ FREEX RELEASE X4 (RISKY'/) SA1 LLMATEL RJ ADDRESS MATRAY5 SX7 0100B LX7 18 POSITION RJ OPERATION CODE BX7 X1+X7 GENERATE RJ MATEL RJ LONGI RJ PAD SB1 3 RJ FREEX RELEASE X3 SA1 IOP SA1 X1+INFO GET ARAYWD(KEEP ADDR IN A1) MX0 1 LX0 XCODEAL+4 MASK FOR I/F BIT SX7 4 TYPE 4 CODE FOR INDEXED CALC LX7 XCODEAL BX2 X0*X1 ADD I/F BIT FROM ARAYWD BX7 X2+X7 SETAD WILL ADD SIGN BIT LX1 3 CHECK FOR VERTICAL SEGMENT SA7 FLOAT PL X1,MATRAY9 JUMP IF NOT SEGMENTED SB1 1 GETVAR LEAVES IN X1 RJ MATVS FORM CODE TO EXTRACT VERTSEGMT * MATRAY9 RJ SETAD CHANGE OPERAND TO CALC IN X1 MX6 0 SA6 FINDXED FLAG INDEXED VARIABLE EQ ENDINST IN X1 * MATPUT SA1 NADS SX7 X1-2 MUST BE AT LEAST 3 ADS NG X7,MATERR ZR X7,MATERR SA2 X1+ADS LOAD 2D INDEX AD SA3 X1+ADS-1 LOAD 1ST INDEX AD SA4 X1+ADS-2 LOAD ARAYWD ADTYPE BX6 X4 AND MOVE ARAYWD TO ENDOFSTACK SA6 A2 WHERE ASSIGN CAN FIND IT BX6 X2 SA6 A3 THEN 2D INDEX BEFORE THAT BX6 X3 SA6 A4 THEN 1ST EQ ENDINST * /--- BLOCK VECTRAY 00 000 78/09/15 17.14 TITLE ARRAY PROCESSING * VECTRAY SB2 VECTRA1 RJ NESTCHK SETS B2=0 IF ASSIGNED INTO * VECTRA1 SA3 NADS SX7 X3-2 MUST BE TWO ADDRESSES NG X7,MATERR * CONDEN VECTRA2 SA1 X3+ADS LOAD INDEX ADTYPE BX7 X1 AX7 XCODEAL+1 POSITION UPPER 2 GETVAR BITS ZR X7,VCONST TREAT CONSTANT INDEX SPECIALLY ENDIF * VECTRA3 ZR B2,SEGPUT IF ASSIGN, EXCHANGE ADTYPE,INDX SB1 3 RJ LOADIND LOAD ROW INDEX TO X3 RJ POPNADS BACK UP TO ARRAY ADTYPE RJ LDLITAD LOAD ARAYWD ADDR TO B1 SB1 1 RJ CHEKRR CLEAR X1 FOR RESULT SA1 LLVECEL RJ ADDRESS EQ MATRAY5 GENERATE RJ VECEL * * SCALRAY SB2 SCALRA1 RJ NESTCHK SETS B2=0 IF ASSIGNED INTO * SCALRA1 EQ CPXERR ONLY COMPLEX AT THIS POINT * * CONDEN * CHANGE MATRIX ELEMENT INTO REGULAR VARIABLE * IF IT HAS CONSTANT INDICES MCONST SX7 X3-2 ENTER WITH R,C ADS IN X1,X2 RJ GETARY4 GET ARAYWD IN X4 LX4 3 CHECK SEGMENT BIT NG X4,MATRAY3 DONT DO SEGMENTED ARRAYS HERE SA7 A3 BACKUP NADS PAST INDICES RJ GETINDX C (COL) IN X6 SA6 SEGWD1 SAVE C BX1 X2 ROW INDEX AD RJ GETINDX R (ROW) IN X6 RJ GETARY GET ARAYWDS IN X1,X2 RJ ROWCHK ADJUSTED ROW INDEX IN X7 SA3 SEGWD1 GET BACK C RJ COLCHK ADJ COL IN X6, NUMCOL-1 IN X4 SX4 X4+1 DX3 X4*X7 (R-ROW1)*COLS IX7 X3+X6 +(C-COL1) EQ VCONST2 * * * CHANGE VECTOR ELEMENT INTO REGULAR VARIABLE VCONST SX7 X3-1 BACKUP ADDR. STACK((NADS)IN X3) RJ GETARY4 GET ARAYWD IN X2 LX4 3 CHECK SEGMENT BIT NG X4,VECTRA3 DONT DO SEGMENTED ARRAYS HERE SA7 A3 BACKUP NADS PAST INDEX(KEEP X7) RJ GETINDX EXTRACT INTEGER INDEX RJ GETARY GET ARAYWDS IN X1,X2 RJ ROWCHK GET ADJUSTED ROW INDEX VCONST2 RJ MERGAD GET ELEMENT AD IN X6 SA1 NADS SA6 X1+ADS REPLACE ARRAY WITH EL ADTYPE MX6 0 SA6 FINDXED FLAG INDEXED VARIABLE EQ ENDINST * ENDIF * /--- BLOCK UNARY 00 000 77/12/18 17.28 TITLE UNARY OPS * UMINUS SA1 TOPCNT DO NOT COUNT UNARY MINUS AS AN OPERATION SX7 X1-1 SA7 A1 SA1 NADS CHECK FOR LITERAL UNARY MINUS SA4 NARRAYS NZ X4,AUMINUS JUMP IF ARRAYS OPS IN PROGRESS UMINUS1 SA1 X1+ADS GET OPERAND SB1 A1 SAVE ADTYPE ADDR IN B1 NG X1,UMINUS2 JUMP IF IN REGISTER BX7 X1 AX7 XCODEAL+1 THROW AWAY BOTTOM GETVAR CODE BIT MX0 58 MASK OUT I/F BIT BX7 -X0*X7 GET UPPER TWO BITS OF GETVAR CODE NZ X7,UMINUS2 JUMP IF NOT LITERAL (0 OR 1 CODE) BX0 X1 AX0 XCODEAL CHECK FOR SHORT OR LONG LITERAL SX6 X1 (X6)=SHORT LITERAL ZR X0,UMSHORT JUMP IF SHORT LITERAL * BX2 X0 SAVE TYPE CODE RJ RLLIT (X6) = LONG LITERAL BX0 X2 RESTORE TYPE CODE BX1 X6 (X0=1 OR 3 FOR I OR F LONG LITERAL) UMSHORT BSS 0 BX6 -X6 COMPLEMENT THE LITERAL SX1 1 MAKE SURE LONG LIT GETVAR CODE BX1 X0+X1 (X1) = TYPE CODE RJ SLLIT STORE LIT AND (X6) = ADTYPE SA6 B1 AND CHANGE OPERAND IN ADS LIST EQ ENDINST * UMINUS2 RJ IFIRR UNARY MINUS, I/F IRRELEVANT SB1 1 RJ GENREAD READ TO X1 IF NOT IN REGISTER SX0 B1 CONSTRUCT COMPLEMENT INSTRUCTION SX1 14000B BX3 X0+X1 RJ PICKX PICK DESTINATION REGISTER SX7 B1 DESTINATION IN B1 LX7 6 BX7 X3+X7 COMPLETE COMPLEMENT INSTRUCTION RJ SHORT ADD TO INSTRUCTION STREAM EQ ENDINST * AUMINUS SA2 X1+ADS ENTER FROM UMINUS WITH X1=NADS LX2 1 LOOK AT WHOLE ARRAY BIT PL X2,UMINUS1 EXIT IF NOT ARRAY LX2 59 MX0 -XCODEAL BX3 -X0*X2 SA3 X3+INFO GET ARRAYWD BX7 X3*X0 SA7 ASIZE AND SAVE SB1 0 ALLOW RE-USE OF TMPARAY RJ CALCTMP GET ADDRESS OF TEMP STOR RJ ARYPREP CLEAR X1,2,6, FORM RJ ABUFCHK SB1 RAINIT RJ LDAINIT INITIALIZE FOR LOOP SB1 1 RJ LDARRAY SX7 14611B CODE FOR BX6 -X1 RJ SHORT RJ TMPAD CHANGE ADTYPE TO TEMP ARRAY MX0 1 * /--- BLOCK UNARY 00 000 78/12/21 18.19 LX0 XCODEAL+4 I/F BIT MASK BX7 X0*X2 I/F BIT OF OPERAND(LEFT IN X2) SA7 FLOAT ENDAINS WILL SET ADTYPE I/F SA1 NARRAYS BX7 -X1 SET - AS FLAG FOR LOOPING OP SA7 A1 EQ ENDINSA * * /--- BLOCK UEXPON 00 000 79/08/24 13.46 * TITLE EXPONENTIATION * EXPO SA1 NOPS FOR EXPONENTS, FIRST CHECK FOR PI SA2 X1+OPS-1 GET PRECEDING STACK OPERATOR SX7 X2-OPPI NZ X7,EXPOA JUMP IF NOT PRECEDED BY PI OPERATOR SX7 OPMULT CHANGE STACK PI TO MULT SA7 A2 SX0 B0 PI IS LITS+0 RJ LITREF ADD PI LITERAL TO ADS STACK SA1 NADS SWITCH PI AND EXPONENT IN ADS STACK SX2 X1-2 NG X2,FORMERR MUST BE AT LEAST 2 OPERANDS SA2 X1+ADS GET PI SA1 A2-1 GET EXPONENT BX7 X2 SA7 A1 SWITCH THEM BX7 X1 SA7 A2 EXPOA SX7 1 HANDLE EXPONENTIATION LX7 XCODEAL+3 SA7 FLOAT FLOATING RESULT SX7 B0 SA7 RECIP CLEAR RECIPROCAL FLAG SA1 NADS CHECK FOR EXPONENT TYPE SX2 X1-2 NG X2,FORMERR MUST BE AT LEAST 2 OPERANDS SA3 X1+ADS GET EXPONENT OPERAND BX7 X3 SA7 POWER SAVE EXPONENT SA4 NARRAYS ZR X4,EXPOA1 JUMP IF NO ARRAYS BX2 X3 MUST PRESERVE X3,X7 LX2 1 CHECK EXPONENT ADTYPE ARRAY BIT NG X2,NOAERR WHOLE ARRAYS NOT ALLOWED SA2 A3-1 OPERAND ADTYPE LX2 1 NG X2,NOAERR NO ARRAYS...UNDEFINED OPERATION EXPOA1 SA2 NUNITS CHECK FOR UNITS NG X2,EXPOAA JUMP IF NO UNITS NG X3,UNITERR JUMP IF POWER IS IN REGISTER AX7 XCODEAL ZR X7,INTPOW JUMP IF SHORT LITERAL MX0 57 BX0 -X0*X7 AX0 1 NZ X0,UNITERR JUMP IF NOT LITERAL BX1 X3 (X1) = ADTYPE RJ RLLIT (X6) = LONG LITERAL BX3 X6 LX7 59-3 SIGN BIT = I/F BIT NG X7,GOTPOW IF FLOATING LITERAL * INTPOW PX3 X3 NX3 X3 ELSE FLOAT IT GOTPOW RJ ZEROU CHECK THAT EXPONENT HAS NO DIMENSIONS SA2 NUNITS NUNITS IN X2, EXPONENT IN X3 SA1 NUADS IX7 X1-X2 DECREMENT UADS POINTER SA7 A1 RJ MULTEM MULTIPLY UNIT COEFFICIENTS SA1 NADS RESTORE A1 SA3 POWER RESTORE X3 * * /--- BLOCK EXPO1 00 000 78/11/21 22.20 * USED TO TREAT ZERO EXPONENT SPECIALLY, BUT THAT MEANT THAT * A&0 GAVE 1 INSTEAD OF 0/0 WHEN A=0. EXPOAA ZR X3,CMPLG0 NOT SPECIAL IF EXPONENT IS ZERO MX0 54 KEEP ALL BUT BOTTOM 6 BITS BX0 X0*X3 ZR X0,EXPO1 JUMP IF POS EXPONENT LT 64 AX0 XCODEAL CHECK FOR NEGATIVE EXPONENT MX7 57 SHOULD BE LONG LITERAL BX7 -X7*X0 MASK FOR GETVAR CODE ID SX7 X7-1 WHICH SHOULD BE 1 NZ X7,CMPLG0 JUMP IF NOT LONG LIT LX0 56 THEN CHECK FOR INT OR FLOAT MX7 60-XCODEAL ACQUIRE LITERAL BX7 -X7*X3 SA4 X7+LITS LITERAL IN X4 PL X0,EXPO0 JUMP IF NOT FLOATING SA2 =.5 CHECK FOR X**.5 BX7 X2-X4 NZ X7,CMPLG0 JUMP IF EXPONENT NOT .5 NG X7,CMPLG0 JUMP IF EXPONENT IS -.5 SX7 X1-1 ZR X7,FORMERR JUMP IF NO BASE SA7 A1 DECREMENT NADS SX7 1 SA7 NOTLITS FLAG ARG NOT LITERAL SX7 OPSQRT SA7 SAVEOP SAVE OP CODE EQ SQTFCT2 GO DO SQRT * EXPO0 PL X4,CMPLG0 JUMP IF NOT NEGATIVE INTEGER BX3 -X4 MAKE INT EXPONENT POSITIVE MX0 54 CHECK FOR EXPONENT<64 BX0 X0*X3 NZ X0,CMPLG0 JUMP IF EXPONENT>64 SX7 1 NEED TO TAKE RECIPROCAL SA7 RECIP BX7 X3 SAVE POWER SA7 POWER EXPO1 SX7 X1-1 DECREMENT NADS ZR X7,FORMERR ERROR IF NO OPERANDS LEFT SA7 A1 SX7 X3-1 CHECK FOR EXPONENT 1 ZR X7,RECIPRO NOTHING TO DO--X**1 RJ FLOTONE FLOAT THE BASE IF REQUIRED SB1 1 READ BASE INTO X1 RJ GENREAD IF NOT IN A REGISTER SX3 B1 GET REGISTER NUMBER LX3 3 SX3 X3+B1 LX3 3 SX3 X3+B1 FORM NNN REFERENCE SB1 X3 SAVE NNN SA4 POWER RESTORE POWER LX4 59 MX5 1 FORM SIGN BIT MASK NG X4,ODD JUMP IF ODD POWER * EVEN SX7 B1+40000B FORM FXN XN*XN TO SQUARE BASE EVEN SX7 B1+41000B (RX) RJ SHORT SQUARE THE BASE LX4 59 START WITH BASE**2 IN XN * /--- BLOCK ODD 00 000 74/07/13 15.54 PL X4,EVEN JUMP BACK IF STILL NO BIT SET IN EXPONENT BX4 -X5*X4 THROW OUT SIGN BIT ZR X4,EXPOD JUMP IF ALL DONE ODD AX3 3 MAKE NN REFERENCE SX7 X3+41200B FORM RX2 XN*XN RJ SHORT LX3 3 SB1 X3+2 FORM NN2 FOR USE IN FORMING FXN XN*X2 EXPOC BX4 -X5*X4 THROW OUT SIGN BIT LX4 59 CHECK NEXT HIGHER BIT IN EXPONENT PL X4,NOTON JUMP IF BIT NOT ON SX7 B1+41000B FORM RXN XN*X2 TO MULTIPLY UP RJ SHORT BX4 -X5*X4 THROW OUT SIGN BIT ZR X4,EXPOD JUMP IF MULTIPLIES DONE NOTON SX7 41222B RX2 X2*X2 TO SQUARE AGAIN RJ SHORT EQ EXPOC KEEP GOING EXPOD SX3 B1 GET FINAL REGISTER NUMBER AX3 6 SX7 1 SA7 X3+RX TAG REGISTER IN USE BX7 X5+X3 TACK ON SIGN BIT TO INDICATE REGISTER LX5 XCODEAL+4 FORM FLOAT BIT BX7 X7+X5 SA1 NADS SA7 X1+ADS EQ RECIPRO CHECK FOR RECIPROCAL * * RECIPRO SA1 RECIP CHECK FOR NEEDED RECIPROCAL ZR X1,ENDINST JUMP IF NO RECIPROCAL NEEDED SA1 NADS MOVE DIVIDEND UP SX6 X1+1 SX7 X6-ADSMAX SEE IF TOO MANY ADS PL X7,LNGERR SA6 A1 SA2 X1+ADS BX7 X2 SA7 A2+1 SX7 1 INSERT NUMERATOR (1) SA7 A2 INTO ADS LIST SX7 45000B FLOATING DIVIDE (RX) SA7 FLOAT NORMAL DIVIDE STUFF EXCEPT FOR UNITS RJ FLTBOTH WHICH ARE ALREADY DONE EQ MULT2 * * FLOTONE EQ * SET CHANGE BIT TO FLOAT OPERAND SA1 NADS GET OPERAND SA1 X1+ADS SX0 1 FORM I/F BIT MASK LX0 XCODEAL+3 BX7 X0*X1 GET BIT NZ X7,FLOTONE DONE IF ALREADY FLOATED LX0 1 ELSE SET CHANGE BIT BX7 X1+X0 SA7 A1 EQ FLOTONE * * ENTER MULTEM WITH X2=NUNITS, X3=EXPONENT * MULTEM EQ * MULTIPLY UNITS BY EXPONENT SB2 X2 NUNITS IN X2 SB1 1 INDEX SA1 NUADS NUADS STARTS AT ZERO SA1 X1+UADS-1 START OF DIMENSIONS (-1) MULTEM2 SA1 A1+B1 PICK UP COEFF FX7 X1*X3 EXPONENT IN X3 SA7 A1 SB2 B2-B1 COUNT GT B2,B0,MULTEM2 EQ MULTEM * /--- BLOCK ASSIGN 00 000 77/12/18 17.29 TITLE ASSIGNMENT OPERATION * ASSIGN RJ PREBIN ASSIGNMENT OPERATION SA1 NOTLITS BOTH OPERANDS LITERALS IF ZERO ZR X1,EQERR CANT STORE INTO LITERAL SA3 NUNITS PL X3,UNITERR CANT STORE IF UNITS INVOLVED SA4 NARRAYS NZ X4,AASSIGN JUMP IF WHOLE ARRAYS FOUND ASSIGN1 JP B3+ASSIGN2 B3=0 ITOI, 1 FTOI, 2 ITOF, 3 FTOF ASSIGN2 EQ ASSIGN3 I=I EQ ASFTOI I=F EQ ASITOF F=I EQ ASSIGN3 F=F ASFTOI SA1 NOPS MOCK UP ROUND OPERATION SX7 X1+1 SX1 X7-OPSMAX SEE IF TOO MANY OPS PL X1,LNGERR SA7 A1 BY INCREMENTING NO. OF OPERATIONS SB1 RNDFIOP AND JUMPING THRU OPJUMP TABLE EQ OPJUMP1 ASITOF LX0 1 FLAG MODE CHANGE FOR GENREAD BX7 X2+X0 (PREBIN SET X0 TO I/F BIT) SA7 A2 AND A2 IS ADDRESS OF SECOND OPERAND * /--- BLOCK ASSIGN 00 000 78/01/25 14.37 ASSIGN3 SB1 6 TRY TO GET IN X6 RJ GENREAD SX0 B1-6 MUST BE IN X6 OR X7 TO STORE PL X0,ASSIGN4 JUMP IF IN X6 OR X7 SX7 1 SA7 B1+RX MARK RESULT REGISTER IN USE SX7 B1 SAVE REGISTER SA7 IOP SB1 6 RJ CHEKRR MOVE X6 SOMEPLACE SA1 IOP GENERATE BX6 XN BX7 X1 LX7 3 POSITION REGISTER FOR BX INST. SX7 X7+10600B BX6 XN MX6 0 SA6 X1+RX MARK REGISTER NO LONGER IN USE RJ SHORT PUT BX6 XN INTO CALC CODE ASSIGN4 SA1 NADS SET UP RESULT ADTYPE SX7 X1-1 ZR X7,FORMERR JUMP IF NO OPERAND TO STORE INTO SA7 A1 DECREMENT NADS *FLAG RESULT AS I OR F SA1 X7+ADS RESULT ADDRESS SX0 1 LX0 XCODEAL+3 MASK FOR I/F BIT BX2 X0*X1 SX7 1 FLAG RESULT REGISTER IN USE SA7 RX+B1 SX7 B1 RESULT REGISTER ASSIGNMENT BX7 X7+X2 MERGE WITH I/F BIT MX0 1 BX7 X7+X0 AND FLAG AS BEING IN REGISTER SA7 A1 STORE ADTYPE * MX0 60-XCODEAL BX2 -X0*X1 GET ADDRESS OF STORE AX1 XCODEAL CODE TYPE MX0 57 BX1 -X0*X1 THROW AWAY I/F INFO SB2 X1 JP B2+ASSIGN5 ASSIGN5 EQ EQERR CANT STORE INTO SHORT EQ EQERR OR LONG LITERAL EQ ASTUD STUDENT EQ ACOM COMMON EQ AINDEX INDEXED VARIABLE EQ ASEG SEGMENT EQ AARRAYL ARRAY EQ EQERR 7 * /--- BLOCK ASSIGN 00 000 76/07/07 01.59 ASTUD SA1 ASVARS IX2 X1+X2 ABSOLUTE ADDRESS ASTUD2 SX7 B1+510B SAN B0+K LX7 18+3 BX7 X7+X2 ATTACH ADDRESS RJ LONGI EQ ENDINST ACOM SA1 ACVARS COMMON VARIABLE ADDRESS IX2 X1+X2 EQ ASTUD2 AINDEX SX7 B1+530B SAN XM LX7 3 BX7 X7+X2 LX7 3 MX6 0 FREE THE X REGISTER SA6 X2+RX RJ SHORT EQ ENDINST * * AARRAYL SA1 X2+INFO GET ARRAYWORD MX0 1 LX0 XCODEAL+4 I/F BIT MASK SX7 A1 SAVE ARRAYWORD ADDR FOR ASEG22 SA7 TMPARAY BX7 X0*X1 LX1 4 TOP DIM. BIT SA7 SEGWD SAVE I/F BIT PL X1,AVEC JUMP IF NOT MATRIX LX1 1 OTHER DIMEN BIT NG X1,MATERR NO 3-D YET SX1 6115B SB1 B5+** LX1 18 BX7 X1+X2 ATTACH ADDRESS SA7 SEGWD1 SAVE RJ POPNADS BACK UP TO COL ADTYPE SB1 4 RJ LOADIND LOAD COL INDEX TO X4 RJ POPNADS BACK UP TO ROW ADTYPE SB1 3 RJ LOADIND LOAD ROW INDEX TO X3 SA1 NADS SX7 X1+2 RESULT NADS SA7 A1 * SB1 7 READ RESULT TO X7 SB1 6 READ RESULT TO X6 *** RJ FORCEX SA2 SEGWD1 BX7 X2 LOAD SB1 B5+ARAYWD RJ LONGI SA1 NADS SX6 X1-2 X6 NEEDED LATER SA6 A1 SA3 SEGWD I/F BIT SA1 LLMATO RJ ADDRESS EQ ASEG20 * * AVEC LX1 1 PL X1,CPXERR NO COMPLEX YET SX1 6115B LX1 18 BX7 X1+X2 GENERATE SB1 B5+ARAYWD SA7 SEGWD1 SAVE IT RJ POPNADS BACK UP TO INDEX SB1 3 RJ LOADIND LOAD INDEX TO X3 SA1 NADS ADVANCE TO RESULT SX7 X1+1 SA7 A1 * SB1 7 READ RESULT TO X7 SB1 6 READ RESULT TO X6 RJ FORCEX SA2 SEGWD1 BX7 X2 LOAD SB1 B5+ARAYWD RJ LONGI SA1 NADS SX6 X1-1 X6 USED LATER SA6 A1 SA3 SEGWD I/F BIT SA1 LLVECO RJ ADDRESS EQ ASEG22 * /--- BLOCK ASSIGN 00 000 78/01/25 16.36 * * ASSIGNMENT INTO SEGMENT * ASEG BX6 X2 SAVE ADDRESS OF SEGMENT LITERAL SA6 IOP MX6 0 SA6 TMPARAY FLAG FOR ARAY TEST IN ASEG22 SA1 X2+INFO LOAD SEGMENT INFO WORD BX6 X1 SA6 SEGWD SAVE LX6 2 POSITION -VERTICAL- OPTION BIT NG X6,ASEGV * SB1 4 MUST BE SURE REGISTER X4 FREE RJ CHEKRR SX7 5145B GENERATE CODE TO LOAD SEGMENT SA1 IOP GET ADDRESS OF INFO WORD LX7 18 INFO WORD TO X4 BX7 X1+X7 RJ LONGI ADD A SA4 B5+K SX7 1 SA7 RX+4 MARK X4 AS IN USE RJ POPNADS BACK UP TO INDEX ADTYPE SB1 3 RJ LOADIND LOAD INDEX TO X3 * ASEG10 SA1 NADS ADVANCE NADS AGAIN TEMPORARILY SX7 X1+1 SA7 A1 * SB1 7 READ TO X7 SB1 6 READ RESULT TO X6 *** RJ FORCEX SA1 NADS SX6 X1-1 BACK UP ADTYPE POINTER AGAIN SA6 A1 SA1 LLSEGO RJ ADDRESS MX3 0 SEGMENT I/F BIT ALWAYS 0 ASEG20 SB1 4 RELEASE X4 RJ FREEX DOES NOT CHANGE X1,X3,X6 * ASEG22 MX2 1 TOP BIT FOR IN REGISTER * SX7 7 FORM RESULT ADTYPE (BE IN X7) SX7 6 FORM RESULT ADTYPE IN X6 *** BX7 X3+X7 MERGE IN I/F BIT BX7 X2+X7 AND REGISTER BIT SA7 X6+ADS REWRITE ADDRESS ENTRY SX7 0100B BUILD AN RJ INSTRUCTION LX7 18 BX7 X7+X1 RJ ADDR IN X1 RJ LONGI ADD CALL TO SEGMENT ROUTINE RJ PAD SA1 TMPARAY NZ X1,AMATSG JUMP IF ARRAY TO TEST FOR SEGMT ASEG29 SB1 3 RELEASE X3 RJ FREEX EQ ENDINST * * * /--- BLOCK ASSIGN 00 000 77/12/18 17.30 ASEGV RJ POPNADS BACK UP TO INDEX ADTYPE RJ VSINDX GENERATE CODE TO LOAD TO X1 SA1 NADS SX6 X1+1 ADVANCE TO QUANTITY TO STORE SA6 A1 SB1 6 READ QUANTITY TO STORE TO X6 RJ FORCEX SB1 3 OBTAIN X3 FOR MASK RJ CHEKRR SX7 1 SA7 RX+3 MARK BUSY SB1 7 OBTAIN X7 FOR STORE RJ CHEKRR RJ POPNADS BACK UP TO INDEX AGAIN * SA1 SEGWD LOAD SEGMENT INFO WORD SB1 X1-1 GET STARTING BIT POSITION AX1 18+18 SB2 X1 GET NUMBER OF BITS PER BYTE * RJ VSTORE GENERATE CODE TO STORE VSEG * SB1 1 CALL FREEX RELEASE X1 SB1 3 CALL FREEX RELEASE X3 * SB1 7 * CALL FREEX RELEASE X7 (NEVER RESERVED'/) * MX1 1 FORM RESULT ADTYPE SX6 6 RESULT IS IN X6 BX6 X1+X6 SA1 NADS LOAD POINTER IN ADDRESS STACK SA6 X1+ADS STORE RESULT ADTYPE EQ ENDINST * /--- BLOCK AASSIGN 00 000 77/12/18 17.33 TITLE ARRAY ASSIGNMENT OPERATION * * CHECK IF ASSIGNMENT TO WHOLE ARRAY AASSIGN SA1 NADS ENTER WITH NARRAYS IN X4 SA2 X1+ADS SA3 A2-1 OPERANDS IN X2,X3 BX7 X3+X2 LX7 1 PL X7,ASSIGN1 JUMP BACK IF NEITHER IS ARRAY * SB1 X4-2 TEST FOR NO MORE THAN 2ARAYOPS SX7 1 RESET NARRAYS AFTER STORE IF OK LE B1,B0,AASGN0 JUMP IF 2 OR 1 ARAYOPS PLATO EQ MNYAERR ONLY ONE OPERATION IN COMPUTE ENDIF * * SX7 1000B FLAG FOR 2MANYARAYS IN ENDLIN AASGN0 SA7 NARRAYS RESTORE COUNT SX7 B3 SA7 IOP SAVE I/F MODES OF OPERANDS BX4 X3*X2 LX4 1 NG X4,AASGN10 JUMP IF BOTH ARRAYS LX3 1 PL X3,EQERR CANT STORE ARRAY INTO SCALAR RJ STORTMP IS IN REGISTER, STORE IT SA1 NADS SX1 X1-1 SA2 X1+ADS GET 1ST (ARRAY) OPERAND RJ STORTMP GET ASIZE EQ AASGN20 AASGN10 RJ SIZCHK CHECK IF ARRAYS ARE CONFORMAL AASGN20 RJ ARYPREP CLEAR X1,2,6, FORM RJ ABUFCHK SB1 RAINIT RJ LDAINIT INITIALIZE LOOP SB1 1 RJ LDARRAY GENERATE LOAD RESULT TO X1 CODE SA1 IOP GET BACK OPERAND I/F TYPES SB3 X1 JP B3+AASGN22 =0 IF I=I, =1 IF I=F, ETC AASGN22 EQ AASGN30 IS I=I EQ AASGN80 I=F EQ AASGN70 F=I AASGN30 SX7 10611B F=F RJ SHORT GENERATE CODE FOR BX6 X1 AASGN40 RJ POPNADS DECREMENT ADS SA1 X7+ADS GET ADTYPE BX2 X1 LX2 2 SEE IF IS TMPARRAY NG X2,EQERR CANT STORE INTO TMPARRAY MX0 -XCODEAL BX2 -X0*X1 GET ADDRESS OF ARRAYWD SA3 X2+INFO GET ARRAYWD FROM XTRA STORAGE BX1 -X0*X3 REL. ADDRESS OF ARRAY TO STORE SA4 ASVARS PL X3,AASGN45 SIGN BIT=0 FOR STUD, =1 FOR COM SA4 ACVARS * /--- BLOCK AASSIGN 00 000 76/07/17 04.13 AASGN45 IX1 X1+X4 ADD RELATIVE ADDR TO BASE LX3 3 PL X3,AASGN50 SA2 A3+1 GET 2D ARRAYWD LX2 1 PL X2,MATERR SEE AMATVS BELOW LX2 11 MX0 -6 BX4 -X0*X2 SB2 X4 LX2 6 BX4 -X0*X2 SB1 X4-1 BX6 X1 SA6 SEGWD SAVE REL BASE ADDR SX7 5214B CODE FOR *SA1 X4+K* LX7 18 BX7 X7+X1 GENERATE *SA1 X4+BASEADDR* RJ LONGI GET WD IN X1, RESULT IN X6 RJ VSTORE MASK IN X3, STORE FROM X7 ***TEMP KLUDGE TO PREVENT OVERWRITING BY ALOOP SX7 10670B MOCKUP BX6 X7 SO ALOOPS RJ SHORT STORES SEGMENTED WD AGAIN SA1 SEGWD GET BACK BASE ADDR * AASGN50 RJ LDALOOP GENERATE RJ ALOOPS, ETC RJ LDAINTR GENERATE *RJ AINTER* INTRUPTEST * EQ ENDINST * * COME HERE TO FLOAT RESULT FOR F=I AASGN70 SX7 27601B GENERATE CODE FOR PX6 X1 RJ SHORT SX7 24606B GENERATE CODE FOR NX6 X6 RJ SHORT EQ AASGN40 NOW STORE IT * * COME HERE TO ROUND RESULT FOR I=F AASGN80 SX1 RNDFIOP ROUNDING OPERATOR SX0 X1-FUNCT0 GET FUNCTION NUMBER SX6 1 SA6 FFLT SET FOR FLOATING ARGUMENT RJ GENFCT LOAD ROUNDED INTEGER TO X1 EQ AASGN30 NOW PUT IN X6 AND STORE * * AMATSG SA1 X1 GET ARRAYWD1 LX1 3 TEST SEGMENT BIT PL X1,ASEG29 EXIT IF NOT SEGMENTED SA2 A1+1 GET SECOND ARAYWD LX2 1 PL X2,MATERR NO HORIZONTAL SEGMENTS YET * * ASSIGN TO VERTICAL-SEGMENTED ARRAY ELEMENT... * ARRAY STORE ROUTINE IN GETVAR, READS INSTEAD OF * STORES IF ARRAY IS VERTICAL SEGMENT * LX2 11 MX0 -6 BX3 -X0*X2 SB2 X3 EXTRACT BITS/BYTE LX2 6 BX4 -X0*X2 SB1 X4-1 AND STARTBIT-1 RJ VSTORE GENERATE SEGMENT STORE CODE SX7 10722B RJ SHORT FORM BX7 X2 TO RESTORE X7 SX1 1 SX7 5012B FORM SA1 A2+1 LX7 18 BX7 X7+X1 RJ LONGI SX1 2 SX7 5022B FORM SA2 A2+2 LX7 18 BX7 X7+X1 RJ LONGI TO RESTORE X1, X2 EQ ASEG29 * * /--- BLOCK PREBIN 00 000 77/12/19 16.12 TITLE PREBIN -- DETERMINE TYPES OF OPERANDS * * -PREBIN- * * PREBIN CALLED BEFORE BINARY TO DETERMINE I/F TYPES * OF 2 OPERANDS. * PREBIN EQ * PLACE IN B3 THE I/F TYPES OF THE 2 OPERANDS SX0 1 B3=0 II, 1 IF, 2 FI, 3 FF LX0 XCODEAL+3 I/F MASK SA1 NADS SX2 X1-2 NG X2,FORMERR MUST BE AT LEAST 2 OPERANDS SA2 X1+ADS GET SECOND OPERAND SA1 A2-1 GET FIRST OPERAND BX3 X0*X1 FIRST TYPE BX4 X0*X2 SECOND TYPE LX3 1 BX3 X3+X4 FIRST TYPE--SECOND TYPE (2 BITS) AX3 XCODEAL+3 SB3 X3 *NEXT CHECK WHETHER BOTH ARE LITERALS NG X1,PREBIN NOT IF IN REGISTER NG X2,PREBIN NOT IF IN REGISTER MX7 58 BX3 X1 FIRST ADTYPE AX3 XCODEAL+1 DISCARD ADDRESS AND LIT BIT BX3 -X7*X3 UPPER TWO BITS OF TYPE CODE, NO I/F BIT NZ X3,PREBIN MUST BE STUDENT OR COMMON IF NZ BX3 X2 SECOND ADTYPE AX3 XCODEAL+1 DISCARD ADDRESS AND LIT BIT BX3 -X7*X3 UPPER TWO BITS OF TYPE CODE, NO I/F BIT NZ X3,PREBIN MUST BE STUDENT OR COMMON IF NZ SX7 B0 SA7 NOTLITS 0 IF LITERALS, NZ IF VARIABLES EQ PREBIN * TITLE FLTBOTH -- FLOAT BOTH OPERANDS * * -FLTBOTH- * * CONVERTS BOTH BINARY OPERANDS TO FLOATING POINT * * FLTBOTH EQ * FLOAT BOTH OPERANDS RJ PREBIN DETERMINE I/F TYPES BX7 X0*X1 PREBIN SET X0 TO I/F MASK BX7 X7-X0 COMPLEMENT BIT LX7 1 SHIFT TO CHANGE MODE POSITION BX7 X1+X7 MERGE WITH ORIGINAL ADTYPE SA7 A1 BX7 X0*X2 PREBIN SET X0 TO I/F MASK BX7 X7-X0 COMPLEMENT BIT LX7 1 SHIFT TO CHANGE MODE POSITION BX7 X2+X7 MERGE WITH ORIGINAL ADTYPE SA7 A2 EQ FLTBOTH * /--- BLOCK BINARY 00 000 77/12/19 16.14 TITLE BINARY -- PLACE 2 OPERANDS IN REGISTERS * * -BINARY- * * GENERATE CODE TO PUT 2 OPERANDS FROM THE TOP OF * THE *ADS* STACK INTO REGISTERS FOR A BINARY * OPERATION. * * BINARY EQ * PLACE TWO OPERANDS IN REGISTERS SA1 NADS SX2 X1-2 NG X2,FORMERR MUST BE AT LEAST 2 OPERANDS SA2 NARRAYS NZ X2,ABINARY JUMP IF ARRAYS BEING PROCESSED BINARY1 SB1 2 READ SECOND OPERAND INTO X2 RJ GENREAD GENERATE READ OF LAST OPERAND SX7 1 SA7 B1+RX RESERVE REGISTER TEMPORARILY SA0 B1 SAVE REGISTER LOCATION SA1 NADS SX7 X1-1 DECREMENT NADS TO GET FIRST OPERAND SA7 A1 SB1 1 READ FIRST OPERAND INTO X1 SX7 A0 A0 GENREAD DESTROYS A0 SA7 BINA0 RJ GENREAD GENERATE READ OF FIRST OPERAND SA1 BINA0 SA0 X1 MX7 0 SA7 A0+RX RELEASE FIRST REGISTER SA1 NOTLITS CHECK WHETHER LITERAL OPERANDS NZ X1,BINARY3 JUMP IF NOT LITERALS SA1 FLOAT IS RESULT FLOATING ZR X1,BINARY2 JUMP IF INTEGER SX1 10B I/F BIT BINARY2 SX7 X1+1 1 FOR LONG LITERAL LX7 XCODEAL SA1 NLITS INCREMENT NUMBER OF LITERALS SX6 X1+1 RESULT WILL BE PLACED THERE SA6 A1 SX1 X6-LITL PL X1,LITERR JUMP IF TOO MANY LITERALS IN THIS CALC BX7 X7+X6 FORM RESULT ADTYPE SA1 NADS AND STORE IN ADS LIST SA7 X1+ADS SX7 712B LITERAL OPERATION FROM X1,X2 INTO X7 EQ BINARY BINARY3 SX0 B1 NOT LITERALS LX0 3 SB2 A0 SX3 X0+B2 ORIGIN REGISTERS RJ PICKX PICK A DESTINATION REGISTER BINARY4 SX7 1 SA7 B1+RX RESERVE RESULT REGISTER SX7 B1 RETURNED IN B1 LX7 6 BX7 X3+X7 ALL 3 REGISTERS EQ BINARY RETURNED IN X7 * * /--- BLOCK BINARY 00 000 78/01/23 21.44 * * COME HERE WHEN PROCESSING ARRAY ELEMENTS * INTIALIZE ARRAY ELEMENT BY ELEMENT LOOP * ABINARY SA2 X1+ADS ENTER FROM BINARY WITH X1=NADS SA3 A2-1 OPERAND ADS 1,2 IN X3,X2 BX7 X3+X2 TEST WHOLARRAY FLAG LX7 1 IN BIT 58 PL X7,BINARY1 EXIT IF NEITHER IS ARRAY * UP TO HERE SHOULD BE INLINE CODE FOR SPEED BX4 X3*X2 LX4 1 LOOK AT $AND$ OF W-ARRAY BITS NG X4,ABIN10 JUMP IF BOTH ARE ARRAYS * ONE IS SCALAR...MAKE SURE NOT IN REGISTER * ROUTINE AINIT IN FILE GETVAR STORES REGISTERS X7,X4,X3. * 'THUS THESE REGISTERS MUST NOT CONTAIN THE SCALAR TO BE * ADDED TO THE ARRAY. * * X4 IS THE LOOP COUNTER, AND X3 IS THE ARRAYSEGV MASK. * X7 IS USED IN AINIT, BUT POSSIBLY SHOULDN'7T BE. 'INSTEAD * X6 SHOULD BE USED TO STORE X3 AND X4 INTO MEMORY. RJ STORTMP CHK 2D OPERAND AND SET ASIZE SA1 NADS SX1 X1-1 GET 1ST ADTYPE SA2 X1+ADS RJ STORTMP CHK 1ST OPERAND EQ ABIN20 ABIN10 RJ SIZCHK CHECK IF ARRAYS ARE CONFORMAL * ABIN20 RJ ARYPREP CLEAR X1,2,6, FORM RJ ABUFCHK ** SB1 RAINIT RJ LDAINIT GENERATE ALOOP INITIALIZATION SB1 2 RJ LDARRAY GENERATE LOAD 2D OPERAND TO X2 RJ POPNADS DECREMENT NADS SB1 1 RJ LDARRAY GENERATE LOAD 1ST OPERAND TO X1 *FORM RESULT ADTYPE SB1 0 ALLOW RE-USE OF TMPARAY RJ CALCTMP GET LOC OF TMPARRAY BUFFER RJ TMPAD FORM TEMP ARRAYWD AND ADTYPE SA1 NARRAYS BX7 -X1 FLAG FOR ARRAY OP IN PROGRESS SA7 A1 *SET REGISTER ASSIGNMENTS * SX3 12B ORIGIN REGISTERS * EQ BINARY4 SB1 6 RESULT REGISTER SX7 612B RESULT IN X6, BUT DONT RESERVE EQ BINARY BINA0 BSS 1 * /--- BLOCK TMPAD 00 000 77/12/19 16.19 TITLE TMPAD -- FORMS ARRAYWORD/AD FOR *TMPARY* * * -TMPAD- * * FORMS ARRAYWORD AND *ADS* FOR OPERATIONS FROM * *TMPARY* * TMPAD EQ * FORMS ARRAYWD AND AD FOR TMPARY SA1 ASIZE TEMPORARY ARRAY LITWORD SA2 TMPARAY AND ADDRESS ZR X1,TMPAD2 JUMP IF RESULT IS SCALAR MX0 -18 BX6 X0*X1 MASK OUT OLD AND ADD NEW BX6 X6+X2 CM START ADDRESS (I/F BIT=0) MX0 2 LX0 58 ALL TMP ARRAYS ARE WHOLE WORDS BX6 -X0*X6 SO MASK OUT BASE REDEF,SEG BITS RJ LSEEK PLANT X6 AS LITERAL MX0 2 LX0 59 BITS 57,58 SET FOR TEMPARRAY BX7 X6+X0 ADD ADDRESS OF LIT FROM LSEEK SX0 6 LX0 XCODEAL ARRAY CODE TYPE BX7 X7+X0 MERGE IN TMPAD6 SA1 NADS SA2 X1+ADS ORIGINAL ADTYPE NEEDED 4 UMINUS SA7 X1+ADS REPLACE 1ST OPERAND WITH EQ TMPAD RESULT TEMP-ARRAY ADTYPE * * IF SCALAR FROM DOTMULT, RESULT STILL IN REGISTER X7 TMPAD2 MX0 1 IN-REGISTER BIT SX7 7 REGISTER NUMBER BX7 X7+X0 WILL ADD I/F BIT LATER SX6 1 SA6 RX+7 MARK REGISTER 7 IN USE EQ TMPAD6 AND PUT IN RESULT ADTYPE * /--- BLOCK SIZCHK 00 000 77/12/19 16.21 TITLE SIZCHK -- CHECKS ARRAYS FOR CONFORMALITY * * -SIZCHK- * * CHECKS THE ARRAY BINARY OPERANDS TO MAKE SURE * THEIR SIZES CONFORM. * * SIZCHK EQ * CHECKS ARRAYS FOR CONFORMALITY MX0 -XCODEAL BX1 -X0*X3 BX2 -X0*X2 EXTRACT ADDRESSES FROM ADTYPES MX0 36 MASK FOR SIZE+ROWS+COLS+PLANES SA1 X1+INFO SA2 X2+INFO GET ARRAYWD LITERALS BX7 X1 SA7 ASIZE SAVE TMPARRAY LITWORD LX0 54 BX3 X0*X1 EXTRACT SIZE,SHAPE INFO BX4 X0*X2 IX7 X3-X4 NZ X7,SIZERR ERROR IF NOT CONFORMAL BX7 X1-X2 LOOK AT DIFFERENCE BETWEEN LX7 1 REAL/COMPLEX BITS PL X7,SIZCHK EXIT IF IDENTICAL EQ CPXERR ERROR IF NOT * TITLE GETARAD * GETARAD EQ * ENTER WITH OPERAND ADS IN X1 MX0 -XCODEAL * BX3 -X0*X1 BX6 -X0*X1 ADDR OF ARRAY LIT WD * SA3 X3+INFO SA3 X6+INFO ARAYWD INFO SA6 SEGWD SAVE ADDR MX4 0 TEMP ARAY ADDR ALREADY ABSOLUTE LX1 2 PUT TEMP ARAY BIT AT LEFT NG X1,GETARA5 JUMP IF TEMP ARAY SA4 ASVARS PL X3,GETARA5 JUMP IF IN STUDENT BANK SA4 ACVARS MUST BE IN COMMON BANK GETARA5 BX3 -X0*X3 EXTRACT RELATIVE START ADDR IX3 X4+X3 MAKE IT ABSOLUTE EQ GETARAD * /--- BLOCK LDAINTR 00 000 79/02/09 13.54 TITLE LDAINTR -- CODE TO TEST FOR ARRAY INTERRUPT * -LDAINTR- * GENERATE CODE TO TEST IF ARRAY INTERRUPT NEEDED * LDAINTR EQ * SA1 TMPAFLG SX2 X1 GET TMPARAY ADDR MX0 -9 LX1 15 POSITION SIZE CODE BX1 -X0*X1 SA3 AWVARS WORK-1 SX3 X3-ARAYLTH START OF TEMPARAY IX6 X2-X3 IX6 X1+X6 ADD SIZE TO GET TMP WORDS USED BX6 -X0*X6 9BITLIMIT SX7 6110B CODE FOR *SB1* LX7 18 BX7 X7+X6 RJ LONGI GENERATE *SB1 TMPASIZ* SB1 RAINTER RJ LDASUB GENERATE *RJ AINTER* EQ LDAINTR * TITLE ARYPREP * * THIS MUST BE DONE BEFORE ANY WHOLE-ARRAY PROCESS * CLEARS X1,X2,X6 FOR GETVAR ARRAY ROUTINES AND * CALLS ECS INTERRUPT BUFFER AVAILABILITY ROUTINE * *'N'O'T'E'; THE ONLY REASON THIS WORKS IS THAT CHOOSEX DOES NOT *CHOOSE X1,X2,X6. 'THUSLY THE FOLLOWING DOESN'7T HAPPEN'; *CHEKRR FREES UP X1. CHEKRR THEN MOVES X2 INTO X1. * ARYPREP EQ * SB1 1 CLEAN OUT X1,X2,X6 FOR RJ CHEKRR ARRAY LOOP ROUTINES SB1 2 RJ CHEKRR SB1 6 RJ CHEKRR SA2 BUFCHK ZR IF NO INTERRUPT CALL YET NZ X2,ARYPREP EXIT IF DONE ALREADY THIS LINE MX7 -1 SET FLAG TO SHOW CHECK DONE SA7 A2 FOR ECS SAVE BUFFER SB1 RBUFCHK RJ LDASUB GENERATE *RJ ABUFCHK* EQ ARYPREP * TITLE LDAINIT * * GENERATE CODE TO INITIALIZE SIZE,INDEX FOR ALOOPS * ENTER WITH ENTRY OFFSET IN B1 (RAINIT, ETC) LDAINIT EQ * SA1 ASIZE LX1 15 MX0 -9 BX1 -X0*X1 MASK OUT NO. OF ARRAY ELEMENTS SX7 6110B CODE FOR SB1 ** LX7 18 BX7 X1+X7 GENERATE CODE FOR SB1 SIZE RJ LONGI RJ LDASUB GENERATE RJ AINIT (ETC) EQ LDAINIT * TITLE LDASUB * LDASUB EQ * GENERATE RJ ARRAY*SUBR*ADDR SA2 LLALOOP ENTRY REFERENCE ADDRESS SX7 B1 ENTER WITH RELATIVE ADDR IN B1 IX2 X2-X7 ABSOLUTE ADDR OF ARRAY SUBR SX7 0100B CODE FOR RJ ** LX7 18 BX7 X7+X2 GENERATE RJ ** RJ LONGI RJ PAD MAKE SURE START NEW INSTR WORD EQ LDASUB * /--- BLOCK CALCTMP 00 000 79/02/09 13.54 TITLE CALCTMP * * SUBROUTINE TO PUT ABSOLUTE ARRAY STARTING ADDRESS * INTO X3 * CALCTMP EQ * SA4 TMPAFLG GET CURRENT TMPARAY INFO MX7 -XCODEAL BX7 -X7*X4 EXTRACT 14BIT CURRENT ADDRESS MX0 9 LX0 54 POSITION SIZE FIELD MASK SA3 ASIZE GET CURRENT SIZE INFO ZR X3,CLCTMP8 JUMP IF ONLY NEED SCALAR BX3 X0*X3 EXTRACT SIZE ZR X7,CLCTMP2 JUMP IF NOT INITIALIZED YET NE B1,B0,CLCTMP5 FORCE NEW TMPARAY IF B1=1 SA2 AOPAD 2 OPERAND ADDR IN LOWER 36 BITS SX6 X2 GET ONE IX6 X6-X7 IF CURRENT TMPARRAY MATCHES ONE ZR X6,CLCTMP3 CAN USE IT FOR RESULT AS WELL AX2 18 SX6 X2 TRY 2D IX6 X6-X7 NZ X6,CLCTMP5 GET NEW TMPARAY IF NO MATCH CLCTMP3 SA7 TMPARAY SAVE ADDRESS FOR IMMED. USE BX7 X7+X3 MERGE ADDRESS, CURRENT SIZE SX3 X7 EXTRACT ADDRESS AGAIN SA7 TMPAFLG RESTORE ARRAY FLAG RJ SVAOPAD TEMPARAY WAS LAST OPERAND EQ CALCTMP * CLCTMP2 BSS 0 MUST GET INITIAL TMPARAY ADDR SA4 AWVARS LOC OF TOP OF WORK-1 SX7 ARAYLTH IX7 X4-X7 LOC OF START OF TEMP ARAY BUFFR EQ CLCTMP3 * * NEW TMPARAY NEEDED...SEE IF ROOM ENOUGH CLCTMP5 BX6 X0*X4 EXTRACT CURRENT TMPARRAY SIZE AX6 45 BX4 X3*X0 COPY NEW SIZE FIELD AX4 45 POSITION NEEDED SIZE AT RIGHT IX7 X6+X7 LOC OF START OF NEXT TMPARRAY IX6 X7+X4 +SIZ = END SA2 AWVARS IX6 X2-X6 WORK-1 - END NG X6,MNYAERR ERROR IF OVERFLOW SA7 TMPARAY SAVE ADDRESS BX7 X7+X3 MERGE IN NEW SIZE SA7 TMPAFLG RESTORE NEW TMPAFLG EQ CALCTMP * CLCTMP8 MX0 1 BX7 X0+X4 SET TMPAFLG NONZERO FOR NOTCALC SA7 TMPAFLG SA2 TEMP TEMP STORAGE POINTER SX7 X2+1 SA7 A2 INCREMENT POINTER SX7 X7-TEMPLIM PL X7,TEMPERR CHECK FOR TOO MANY TEMPS SX7 X2+VARLIM+1 RELATIVE TEMP STORE ADDRESS SA4 ASVARS STUDVAR START IX7 X7+X4 SA7 TMPARAY ABSOLUTE TEMP STORE ADDR EQ CALCTMP * /--- BLOCK STORTMP 00 000 78/09/15 18.56 TITLE STORTMP * * -STORTMP- * * SUBROUTINE TO STORE REGISTER TO TEMP LOC * STORTMP EQ * ENTER WITH NADS IN X1,AD IN X2 NG X2,STORT2 IF SCALAR IN REGISTER, STORIT LX2 1 CHECK ARRAY FLAG PL X2,STORTMP IF SCALAR IN MEMORY, EXIT MX0 -XCODEAL IS ARRAY LX2 59 BX2 -X0*X2 GET XSTOR ADDRESS SA2 X2+INFO GET ARRAYWD INFO BX7 X2 SA7 ASIZE SAVE TMPARRAY INFO EQ STORTMP STORT2 SA0 X1 SAVE NADS MX0 -3 MASK FOR REGISTER NUMBER BX1 -X0*X2 REGISTER NUMBER NOW IN * SB1 X1 * SB2 7 * EQ B1,B2,STORT5 JUMP IF IN X7 * RJ FREEX FREE CURRENT REGISTER SB2 X1 SB1 7 EQ B1,B2,STORT5 JUMP IF IN X7 CALL CHEKRR B1=7, FREE UP REG 7 SA2 A0+ADS GET BACK ADS MX0 -3 BX1 -X0*X2 REGISTER AGAIN IN X1 SB1 X1 RJ FREEX FREE CURRENT REGISTER SX7 1070B CODE FOR BX7J BX7 X7+X1 X1 UNCHANGED BY FREEX LX7 3 BX7J0 RJ SHORT ADD *BX7 XJ* TO INSTRUCTIONS STORT5 SA1 A0+ADS SET A1=ADDRESS OF ADTYPE RJ STR7TMP STORE IN TMP AND RESET ADTYPE CALL FREEX,7 RELEASE X7 EQ STORTMP * TITLE SVAOPAD * * SUBR TO SAVE ARRAY OPERAND ADDRESS * SVAOPAD EQ * OP ADDR IN X3 ON ENTRY SA1 AOPAD LX1 18 SHIFT PREVIOUS ONE OUT MX0 -18 BX6 X0*X1 BX3 -X0*X3 LEAVE 18 BIT ADDR IN X3 BX6 X3+X6 MERGE IN LATEST OPND ADDR SA6 A1 EQ SVAOPAD * /--- BLOCK STORTMP 00 000 77/12/19 16.28 TITLE LDARRAY -- LOAD ARRAY/SCALAR OPERANDS * * -LDARRAY- * * SUBROUTINE TO LOAD ARRAY OR SCALAR OPERANDS * * B1 = REGISTER NUMBER * LDARRAY EQ * ENTER WITH DESIRED REG. IN B1 SA1 NADS SA1 X1+ADS GET ADTYPE NG X1,MATERR ERROR IF STILL IN REGISTER***** * SX2 B1 REGISTER NUMBER LX1 1 * RJ FREEX MAKE SURE REGISTER FREE 2 READ NG X1,LDARAY2 JUMP IF IT IS ARRAY SX3 0 FLAG FOR NOT ARRAY RJ SVAOPAD SAVE FOR CALCTMP CHECK RJ GENREAD IS SCALAR, SO READ INTO X(B1) EQ LDARRAY * LDARAY2 LX1 59 RESTORE OPERAND ADTYPE RJ GETARAD RETURN ABS STARTLOC IN X3 * LDARAY4 RJ SVAOPAD SAVE ARRAY ADDR FOR CALCTMP SX7 5204B CODE FOR SA* X4+** LX7 18 BX7 X7+X3 MERGE IN ADDRESS OF START SX2 B1 GET BACK REGISTER NUMBER LX2 21 POSITION IT BX7 X7+X2 FORM SAN X4+(STARTLOC) RJ LONGI SA1 SEGWD GET BACK ARRAYWD SA1 X1+INFO LX1 3 PL X1,LDARAY5 SKIP IF NOT SEGMENT RJ MATVS FORM CODE TO EXTRACT SEGMNT LDARAY5 SA1 NADS SA1 X1+ADS GET BACK ADTYPE LX1 60-XCODEAL-5 PUT MODECHANGE BIT AT LEFT PL X1,LDARRAY EXIT IF NO MODECHANGE RJ FLOATIT GENERATE PACK AND NORMALIZE EQ LDARRAY * /--- BLOCK LBINARY 00 000 77/12/19 16.29 TITLE LBINARY -- PREPARE ARGUMENTS FOR SHIFTING * * -LBINARY- * * PREPARE ARGUMENTS FOR SHIFT OPERATIONS * ALSO DO OPTIMIZING FOR CONSTANT 2ND ARG, * AS WELL AS FOR BOTH ARGUMENTS CONSTANT. * LBINARY EQ * PLACE 2 ARGUMENTS IN X1 AND B1 MX7 0 SA7 FLOAT CALL THE RESULT INTEGER TYPE SA1 NADS SX2 X1-2 NG X2,FORMERR MUST BE AT LEAST 2 OPERANDS SA4 NARRAYS NZ X4,ALBINRY JUMP IF ARRAY OPS IN PROGRESS LBINRY1 SA1 X1+ADS SEE WHETHER SHIFT COUNT MUST BE FIXED SX0 1 LX0 XCODEAL+3 I/F BIT BX0 X0*X1 NZ X0,ASFTOI MOCK UP A ROUND F TO I FUNCTION SA2 NUNITS NG X2,LBINAR2 RJ SAMEUZ SAME UNIT, DIMENSIONLESS RESULT LBINAR2 SB1 1 READ SECOND OPERAND INTO X1 SA2 NADS SA2 X2+ADS NG X2,LBINA21 JUMP IF IN REGISTER MX0 58 AX2 XCODEAL+1 BX2 -X0*X2 ZR X2,LBINAR5 JUMP IF 2ND ARG CONSTANT * LBINA21 RJ GENREAD GENERATE READ OF LAST OPERAND SX1 B1 REGISTER ASSIGNMENT SX7 X1+6310B GENERATE SB1 XN LX7 3 RJ SHORT GET1ST SA1 NADS SX7 X1-1 DECREMENT NADS TO GET FIRST OPERAND SA7 A1 SB1 1 READ FIRST OPERAND INTO X1 RJ GENREAD SA2 NOTLITS CHECK FOR BOTH CONSTANT ZR X2,SHIFDO SA2 SHIFTDN NZ X2,LBINAR6 JUMP IF 2ND ARG WAS CONSTANT SA0 B1+10B ORIGIN REGISTERS (B1 AND XN) RJ PICKX PICK A DESTINATION REGISTER LBINAR4 SX7 1 SA7 B1+RX RESERVE RESULT REGISTER SX7 B1 RETURNED IN B1 LX7 6 SX0 A0 ORIGIN REGISTERS BX7 X7+X0 X(DESINATION)--B1--X(ORIGIN) EQ LBINARY * /--- BLOCK LBINARY 00 000 78/01/20 15.00 * LBINAR6 SX7 1 SA7 B1+RX RESERVE REGISTER SX7 B1 MX0 1 BX6 X7+X0 FLAG REGISTER ADTYPE WITH SIGN BIT LX7 6 POSITION REGISTER CORRECTLY SA1 NADS SA6 X1+ADS STORE ADTYPE OF RESULT EQ LBINARY * LBINAR5 SA2 NOTLITS BX7 X2 MX6 0 SA6 A2 KLUGE NOTLITS SO GENREAD SA7 SHIFTDN RETURNS CONSTANT RJ GENREAD GET 2ND ARGUMENT SA2 SHIFTDN BX7 X2 MX6 -6 SA7 NOTLITS RESTORE NOTLITS SX7 1 SA7 A2 SET SHIFTDN TO SAY 2ND ARG CONSTANT SA3 IOP SA2 ARGX1 LOAD 2ND ARGUMENT PL X2,LBINAR7 NEGATIVE, SHIFT OTHER WAY BX2 -X2 SX4 X3-20000B ZR X4,LBINA55 SX3 20000B EQ LBINAR7 LBINA55 SX3 21000B LBINAR7 BX6 -X6*X2 LIMIT CONSTANT TO SIX BITS BX6 X6+X3 UNION CONSTANT INTO INSTRUCTION SA6 A3 EQ GET1ST GET 1ST ARGUMENT * * SHIFDO SX7 1 1 FOR LONG LITERAL SA1 NLITS INCREMENT NUMBER OF LITERALS SX6 X1+1 RESULT WILL BE PLACED THERE SA6 A1 SX1 X6-LITL PL X1,LITERR JUMP IF TOO MANY LITERALS IN THIS CALC LX7 XCODEAL TURN CORRECT BIT ON BX7 X7+X6 FORM RESULT ADTYPE SX1 1 INDICATE STORED IN *LITS* LX1 LITSHFT BX7 X7+X1 SA1 NADS AND STORE IN ADS LIST SA7 X1+ADS * *NOTE THAT INSTRUCTION HAS X7 SPECIFIED AS SHIFTING REGISTER SA1 =46000460004600000700B THREE PASSES SA2 IOP BX7 X1+X2 PUT NOPS AND INST. TOGETHER SA7 EXECUTE PLANT THE INSTRUCTION SA1 ARGX1 LOAD FIRST ARG BX7 X1 PUT INTO X7 RJ EXECIT EXECUTE THE PLANTED INSTRUCTION SA1 NLITS RESULT IN X7 *NLITS HAS BEEN ALREADY INCREMENTED ABOVE SA7 X1+LITS STORE IN LITS TABLE MX0 60-XCODEAL CHECK TO SEE IF RESULT IS SHORT LITERAL BX0 X0*X7 NZ X0,LBINARY LONG, ALREADY SET UP CORRECTLY SA1 NADS SA7 X1+ADS CHANGE TO SHORT EQ LBINARY * * * /--- BLOCK LBINARY 00 000 78/09/16 00.56 * ALBINRY SA2 X1+ADS ENTER FROM LBINARY WITH X1=NADS SA3 A2-1 OPERAND ADS 1,2 IN X3,X2 BX7 X3+X2 TEST WHOLARRAY FLAG LX7 1 IN BIT 58 PL X7,LBINRY1 EXIT IF NEITHER IS ARRAY * UP TO HERE SHOULD BE INLINE CODE FOR SPEED BX4 X3*X2 LX4 1 NG X4,ALBIN10 JUMP IF BOTH ARE ARRAYS BX0 X2 LX0 1 IS 2D OPERAND AN ARRAY NG X0,ALBIN05 JUMP IF IS, CHECK FLOAT LATER LX0 59-XCODEAL-4 CHECK I/F BIT OF SCALAR NG X0,ASFTOI IF FLOATING,MOCK UP ROUNDING OP RJ STORTMP PUT FIXED SCALAR IN TMP STORAGE **** EQ ALBIN20 AND SET ASIZ IF ARRAY SA1 NADS RESTORE AFTER STORTMP SA2 X1+ADS SA3 A2-1 ALBIN05 SX1 X1-1 NADS-1=1ST OPERAND ADDR BX2 X3 1ST OPERAND RJ STORTMP STORE SCALAR, SET ASIZ IF ARRAY EQ ALBIN20 ALBIN10 RJ SIZCHK CHECK IF ARRAYS CONFORMAL ** ALBIN20 RJ ARYPREP CLEAR X1,2,6, FORM RJ ABUFCHK SB1 RAINIT RJ LDAINIT GENERATE ALOOP INITIALIZATION SB1 1 RJ LDARRAY LOAD 2D OPERAND TO X1 SA1 NADS SA2 X1+ADS 2D OPERAND * NOTE SCALAR 2D OPERAND WAS FIXED ABOVE LX2 60-XCODEAL-4 CHECK I/F BIT NG X2,ALBIN80 JUMP IF FLOATING ALBIN30 SX7 63110B SB1 X1 RJ SHORT GENERATE INSTRUCTION RJ POPNADS SB1 1 RJ LDARRAY GENERATE SA1 1ST OPERAND SB1 0 ALLOW REUSE OF TMPARAY RJ CALCTMP GET LOC OF TMPARAY RJ TMPAD FORM TEMPARAYWD AND OPERAND SA1 NARRAYS BX7 -X1 FLAG FOR ARRAY LOOP IN PROGRESS SA7 A1 SX7 611B TAG FOR X6,B1,X1 SHIFT CODES EQ LBINARY (DEST=X6, BUT X6 RESTORED LATER * SA0 11B ORIGIN REGISTERS B1,X1 * SB1 6 RESULT IN X6 * EQ LBINAR4 * * ROUNDS 2D OPERAND (IN X1) AND FIXES INTO X1 ALBIN80 SX1 RNDFIOP ROUNDING OPERATOR SX0 X1-FUNCT0 GET FUNCTION NUMBER SX6 1 SA6 FFLT MARK FLOATING ARGUMENT RJ GENFCT GENERATE ROUNDING RJ CODE EQ ALBIN30 * * /--- BLOCK MATVS 00 000 77/12/19 19.33 TITLE MATVS * * EXTRACT VERTICALSEGMENT FROM WORD IN X1 * FOR ARRAY OPERATIONS * * A1 = ADDRESS OF ARRAY INFO WORDS * MATVS EQ * ARRAY INFO WD ADDR IN A1 SA1 A1+1 GET 2D ARAYWORD LX1 1 CHECK VERTSEG BIT PL X1,MATERR DONT ALLOW HORIZSEG YET SX6 B1 SA6 MATB1 SAVE B1 LX6 3 SX6 X6+B1 LX6 3 A0=(B1)(B1)4B INDICATING **** SA0 X6+4 WORD IN X(B1), MASK IN X4 SA0 X6+3 WORD IN X(B1), MASK IN X3 LX1 59 SIGNED BIT AT TOP AX1 42 POSITION STARTBIT MX0 -6 BX6 -X0*X1 SB1 X6-1 STARTBIT-1 AX1 6 BX3 -X0*X1 BITS/BYTE SB2 X3 * RJ VREAD GENERATE VERTSEG EXTRACT CODE * SA1 MATB1 RESTORE B1 SB1 X1 EQ MATVS * MATB1 BSS 1 SAVE B1 * * /--- BLOCK GETINDX 00 000 77/12/19 20.04 CONDEN TITLE GETINDX -- GET INTEGER INDEX * * SUBROUTINE TO GET INTEGER INDEX INTO X6 * ENTER WITH INDEX GETVAR CODE IN X1 * ABS(INDEX) MUST BE LESS THAN 13 BITS * MUST NOT CHANGE X7 GETINDX EQ * MX0 -XCODEAL BX6 -X0*X1 MASK OFF ADDRESS AX1 XCODEAL-1 CHECK FOR 13BIT SHORT LITERAL ZR X1,GETINDX IF IS, EXIT WITH X6=LITERAL AX1 1 POSITION GETVAR TYPE SX1 X1-1 CHECK FOR LONG INTEGER LIT TYPE NZ X1,INDXERR ONLY CALLED BY 0,1 TYPE SA1 X6+LITS GET LONG LITERAL INDEX BX6 X1 PL X1,INDXERR IF PLUS, IS GT 13 BITS ZR X1,GETINDX -0 IS OK BX1 -X1 GET ABS(INDEX) MX0 -13 BX1 X0*X1 CHECK FOR UPPER BITS ZR X1,GETINDX EQ INDXERR ERROR IF GT 13 BITS * ENDIF * /--- BLOCK LOADIND 00 000 77/12/19 19.35 TITLE LOADIND -- LOAD INDEX TO X(B1) * * -LOADIND- * * GENERATES CODE TO LOAD THE CURENT INDEX, ADS(NADS) * TO REGISTER(B1) AS IN INTEGER VALUE. * * ON ENTRY, * B1 = REGISTER NUMBER TO BE LOADED * * LOADIND EQ * LOADS INDEX TO X(B1) RJ FORCEX SA1 NADS SA1 X1+ADS SEE IF INDEX IS I OR F LX1 59-XCODEAL-3 PL X1,LOADIND EXIT IF INTEGER INDEX RJ INDXFLT ROUND INDEX EQ LOADIND * /--- BLOCK POPNADS 00 000 77/12/19 19.35 TITLE POPNADS -- BACKUP NADS POINTER * * -POPNADS- * * BACKUP THE NADS POINTER TO THE PREVIOUS ENTRY * IN THE ADS LIST. THIS ESSENTIALLY POPS THE LAST * OPERAND OFF THE STACK. * POPNADS EQ * BACKUP NADS POINTER SA1 NADS SX7 X1-1 BACK UP TO INDEX GETVAR CODE ZR X7,INDXERR NG X7,INDXERR ERROR IF NO INDEX ADTYPE SA7 A1 EQ POPNADS * /--- BLOCK ROW/COLCHK 00 000 77/12/19 20.05 CONDEN TITLE ROW/COLUMN BOUNDS CHECKING * * SUBROUTINE TO CHECK IF ROWS IN BOUNDS ROWCHK EQ * INDEX IN X6, ARAYWDS IN X1,X2 SX7 1 DEFAULT ROW1 ZR X2,ROWCHK2 JUMP IF NO ARAYWD2 BX7 X2 EXTRACT ROW1 FROM ARAYWD2 LX7 18 AX7 46 EXTEND SIGN+PUT ROW1 AT RT ROWCHK2 IX7 X6-X7 NG X7,INDXERR ROW MUST BE GE ROW1 BX3 X1 EXTRACT ROWS-1 FROM ARAYWD LX3 6+2*9 POSITION ROWS-1 AT RIGHT MX0 -9 BX3 -X0*X3 MASK OFF NUMROWS-1 IX3 X3-X7 (ROWS-1)-(INDEX-ROW1) NG X3,INDXERR ERROR IF TOO MANY ROWS EQ ROWCHK EXIT WITH ADJUSTED INDEX IN X7 * * SUBROUTINE TO CHECK COLUMN BOUNDS * DONT CHANGE X1,X2,X7 (SEE ROWCHK FOR DETAILS) COLCHK EQ * ENTER WITH ARAYWDS IN X1,X2 BX4 X1 AND COL INDEX IN X3 LX4 6+3*9 MX0 -9 BX4 -X0*X4 NUMCOLS-1 LEFT IN X4 SX6 1 ZR X2,COLCHK2 BX6 X2 LX6 32 AX6 46 COLCHK2 IX6 X3-X6 COL-COL1 NG X6,INDXERR IX3 X4-X6 (NUMCOLS-1)-(INDEX-COL1) NG X3,INDXERR EQ COLCHK EXIT WITH COL-COL1 IN X6 * *SUBROUTINE TO MERGE ADJUSTED INDEX (IN X7) WITH *ARRAYWD START LOC AND I/F BIT (IN X1) MERGAD EQ * MX0 -XCODEAL BX3 -X0*X1 EXTRACT ARRAY START ADDRESS IX6 X7+X3 ADD ADJUSTED ARRAY ELEMENT INDX MX0 1 LX0 XCODEAL+4 POSITION MASK BX4 X0*X1 TO EXTRACT I/F BIT BX6 X6+X4 AND MERGE IN SX4 2 STUD BANK GETVAR TYPE PL X1,MERGAD2 JUMP IF ARRAY IN STUD BANK SX4 3 COMMON BANK GETVAR TYPE MERGAD2 LX4 XCODEAL POSITION GETVAR TYPE BX6 X6+X4 AND MERGE IN EQ MERGAD EXIT WITH GETVAR CODE IN X6 * ENDIF * /--- BLOCK FCCHK 00 000 86/03/12 19.37 TITLE FCCHK -- CHECK TYPE OF GETVAR CODE * * * RETURNS X0 = -1 IF CONSTANT, 0 IF NOT * X1 = GETVAR CODE * X2 = I/F TYPE * X3 = VALUE OF CONSTANT * X4 = GETVAR TYPE - 2 * (USED BY *VARLOC*) * FCCHK EQ * MX0 0 PRE-SET NOT CONSTANT SA1 NADS LOAD POINTER IN ADDRESS STACK SA1 X1+ADS LOAD -GETVAR- CODE SX2 1 SX3 1 LX3 LITSHFT *LITS* BIT BX4 -X3*X1 TURN OFF *LITS* BIT LX2 XCODEAL+3 POSITION I/F BIT BX4 -X2*X4 BX2 X2*X1 NG X1,FCCHK EXIT IF IN REGISTER * MX3 -XCODEAL BX3 -X3*X1 MASK OFF ADDRESS PORTION AX4 XCODEAL POSITION TYPE CODE SX4 X4-2 0 AND 1 = CONSTANT CODES PL X4,FCCHK EXIT IF NOT CONSTANT MX0 -1 SX4 X4+1 CHECK FOR SHORT LITERAL NZ X4,FCCHK RJ =XRLLIT X6 = LITERAL BX3 X6 BX1 X3 X1 = LITERAL MX0 -1 EQ FCCHK * /--- BLOCK TRND 00 000 77/12/19 16.40 TITLE FUNCTIONS (FROM GETVAR) * * -TRND- * * ROUND VALUE IN X1 TO NEAREST INTEGER BOUNDARY * * TRND EQ * SA2 =.5 ROUND TO NEAREST INTEGER PL X1,PLRND BX2 -X2 SUBTRACT .5 IF NUMBER IS NEG PLRND RX1 X1+X2 ADD .5 UX1 X1,B1 TRUNCATE X1 LX1 X1,B1 MX2 0 IX1 X1+X2 CHANGE -0 TO +0 EQ TRND * EJECT * * -TLMASK- * * MASK GENERATING FUNCTIONS (LEFT AND RIGHT) * TLMASK EQ * SX1 X1+0 CONVERT -0 TO +0 ZR X1,TLMASK +++ DONE NG X1,MASKERR --- ERROR IF NEGATIVE COUNT SB1 X1-1 SX1 B1-BPW PL X1,MASKERR --- ERROR IF OVER BITS PER WORD MX1 1 AX1 X1,B1 EQ TLMASK * TRMASK EQ * SX1 X1+0 CONVERT -0 TO +0 ZR X1,TRMASK +++ DONE NG X1,MASKERR --- ERROR IF NEGATIVE COUNT SB1 X1-1 SX1 B1-BPW PL X1,MASKERR --- ERROR IF OVER BITS PER WORD MX1 1 AX1 X1,B1 LX1 1 LX1 X1,B1 RE-POSITION AT RIGHT EQ TRMASK * /--- BLOCK TINTX 00 000 77/12/19 16.41 EJECT * PLATO USE ROUTINES FROM -GETVAR- EXT TINTX,TFRACX ENDIF * CONDEN ROUTINES COPIED FROM -GETVAR- EQTOLER DATA 1.0E-9 A=B IF ABS(A-B) LT EQTOLER * * * -TINTX- * TINTX EQ * SA2 EQTOLER MUST ROUND ARGUMENT PL X1,TINT1 BX2 -X2 TINT1 FX1 X1+X2 ROUND NX1 X1 UX1 X1,B1 SB2 B1-11 PL B2,TINT2 NUMBER IS TOO BIG LX1 X1,B1 NZ X1,TINTX MX1 0 ELIMINATE -0 EQ TINTX TINT2 NG X1,TINT3 HUGE NEGATIVE NUMBER MX1 -1 LX1 59 MAXIMUM POSITIVE NUMBER EQ TINTX TINT3 MX1 1 MAXIMUM NEGATIVE NUMBER EQ TINTX * EJECT * * -TFRACX- * TFRACX EQ * NG X1,NGFRAC HANDLE NEGATIVE ARGUMENT SEPARATELY SA2 EQTOLER ROUND BY FLOATING TOLERANCE FX2 X1+X2 UX2 X2,B1 * GT B1,B0,ZRFRAC CANNOT USE INTEGER > 48 BITS * LX2 X2,B1 TRUNCATE PX2 X2 NX2 X2 REFLOAT FX1 X1-X2 SUBTRACT INTEGER PART FROM NUMBER NX1 X1 NG X1,ZRFRAC CONSIDER THE FRACTION TO BE ZERO SA2 EQTOLER FX2 X1-X2 CHECK FOR FRACTION SMALLER THAN TOLER NG X2,ZRFRAC CONSIDER FRACTION TO BE ZERO EQ TFRACX ZRFRAC MX1 0 SET FRACTION ZERO EQ TFRACX NGFRAC SA2 EQTOLER ROUND BY TOLERANCE FX2 X1-X2 ARG WAS NEGATIVE UX2 X2,B1 LX2 X2,B1 TRUNCATE PX2 X2 NX2 X2 REFLOAT FX1 X1-X2 SUBTRACT OFF THE INTEGER PART NX1 X1 PL X1,ZRFRAC CONSIDER SMALL FRACTION ZERO SA2 EQTOLER FX2 X1+X2 PL X2,ZRFRAC CONSIDER SMALL FRACTION ZERO EQ TFRACX * * ENDIF * /--- BLOCK GENREAD 00 000 78/09/15 19.10 TITLE GENERATE A READ INSTRUCTION * * -GENREAD- * * GENERATE A READ INSTRUCTION * GENREAD EQ * GENERATE A READ IF NEEDED SA1 NADS GET OPERAND ZR X1,FORMERR NG X1,FORMERR MUST BE AT LEAST ONE OPERAND SA1 X1+ADS NG X1,GENR0 JUMP IF ALREADY IN REGISTER SX3 B1-6 SEE IF X6 OR X7 NG X3,GENR0 JUMP IF NOT BX3 X1 AX3 XCODEAL SHIFT OFF ADDRESS PORTION ZR X3,GENR0 JUMP IF SHORT I LITERAL SB1 1 ELSE RESET TO USE X1 * GENR0 MX3 1 MASK TO STRIP OFF SIGN BIT BX2 X3 AND LITS/TOKBUF BIT LX2 LITSHF1 BX3 X2+X3 BX3 -X3*X1 SAVE IN X3 PL X1,NOTINR JUMP IF NOT ALREADY IN REGISTER *****KLUGE FIXUP FOR THE CASE OF 3/SQRT(49) *****IN WHICH SQRT(49) IS IN X1 AND MUST BE MOVED MX1 57 BX2 -X1*X3 REGISTER NUMBER--THROW AWAY I/F BIT SX1 B1-2 NZ X1,GENR1 JUMP IF NOT SA2 SX1 X2-1 NZ X1,GENR1 JUMP IF NOT IN X1 SX7 10210B MOVE X1 TO X2 RJ SHORT SB1 1 AND FREE X1 RJ FREEX SX2 2 OPERAND IN X2 GENR1 SB1 X2 FINAL REGISTER LOCATION RJ FREEX FREE IT MX6 -1 SA6 FINDXED FLAG NOT INDEXED VARIABLE AX3 XCODEAL+4 CHECK FOR CHANGE MODE ZR X3,GENREAD RJ FLOATIT FLOAT THE INTEGER EQ GENREAD * ***OPERAND NOT IN REGISTER-- NOTINR SA2 NOTLITS IS THIS A LITERAL OPERATION ZR X2,GENR2 JUMP IF LITERALS RJ CHEKRR CHECK READ REGISTER AVAILIBILITY GENR2 MX0 60-XCODEAL MASK FOR ADDRESS PART OF CODE MX6 -1 SA6 FINDXED FLAG NOT INDEXED VARIABLE BX6 -X0*X3 AX3 XCODEAL MX0 56 BX2 -X0*X3 SAVE 4-BIT TYPE SB2 X2 AX3 4 X3 NONZERO NOW MEANS CHANGE MODE JP B2+VTYPE * /--- BLOCK GENREAD 00 000 78/07/28 03.26 * VTYPE EQ ISHORT EQ ILONG EQ ISTUD EQ ICOM EQ COMPERR IMPOSSIBLE CODE TYPE EQ SEGERR EQ MATERR EQ COMPERR IMPOSSIBLE CODE TYPE EQ COMPERR NO SHORT F LITERALS EQ FLONG EQ ISTUD EQ ICOM EQ COMPERR IMPOSSIBLE CODE TYPE EQ COMPERR IMPOSSIBLE CODE TYPE EQ COMPERR IMPOSSIBLE CODE TYPE EQ COMPERR IMPOSSIBLE CODE TYPE * ISHORT NZ X3,ISHORT2 IF NO I TO F NEEDED, X3 ZERO SA1 NOTLITS IS IT LITERAL OPERATION ZR X1,ITSLIT JUMP IF ITS LITERALS ZR X6,ISHORT0 JUMP IF LITERAL = 0 ITSHT1 SX7 B1+710B CONSTRUCT SXN LITERAL LX7 21 BX7 X7+X6 X6 HOLDS LITERAL RJ LONGI ADD INSTUCTION TO STREAM RJ FREEX FREE THE REGISTER EQ GENREAD * ISHORT0 SX1 0 ITMSK SX7 B1+430B MXN 0 LX7 6 BX7 X7+X1 RJ SHORT ADD INSTRUCTION TO STREAM RJ FREEX EQ GENREAD * ISHORT2 PX6 X6 NEED FLOATED, SO PLANT FLOATED LITERAL NX6 X6 ISHORT3 SA1 NOTLITS CHECK FOR LITERAL OPERATION NZ X1,ISHORT4 JUMP IF NOT LITERALS ITSLIT SA6 ARG+B1 B1 IS 1 OR 2---STORE IN ARG1 OR ARG2 EQ GENREAD ISHORT4 BSS 0 ZR X6,ISHORT0 -- LITERAL 0 CAN BE HANDLED SB2 B1 ELSE SAVE B1 RJ LSEEK PLANT LITERAL IN EXTRA STORAGE SB1 B2 RESTORE B1 SX3 B0 CHANGE DONE SX0 5 LITERALS RELATIVE TO B5 GENR3 SX7 B1+510B CONSTRUCT SAN BM+(ADDRESS) LX7 3 BX7 X7+X0 BRING IN B-REGISTER LX7 18 BX7 X7+X6 X6 CONTAINS ADDRESS RJ LONGI ADD INSTRUCTION TO STREAM RJ FREEX FREE REGISTER ZR X3,GENREAD ALL DONE IF NO FLOAT NEEDED RJ FLOATIT ADD IN FLOAT INSTRUCTIONS (PXN, NXN) EQ GENREAD * * /--- BLOCK GENREAD 00 000 78/07/28 03.39 ILONG SA1 NADS X1 = GETVAR CODE SA1 X1+ADS RJ RLLIT X6 = LITERAL NZ X3,ISHORT2 FLOAT IF NECESSARY * EQ ISHORT3 BX1 X6 SAVE LITERAL IN X6 AX1 17 NZ X1,ISHORT3 NOT FIT IN 18 BITS SA1 NOTLITS ZR X1,ITSLIT JUMP IF ITS LITERALS PL X6,ITSHT1 SHORT 18 BIT POSITIVE NUMBER NZ X6,FIXMNS IT IS NEGATIVE SX1 60 MINUS 0 EQ ITMSK FIXMNS SX1 X6+1 ZR X1,MNS1 MX1 -18 BX6 -X1*X6 EQ ITSHT1 IT IS NOW 18 BITS LONG MNS1 SX1 59 EQ ITMSK MINUS 1 = MXN 60-1 * ISTUD MX0 0 NO B REGISTER NEEDED SA1 ASVARS IX6 X1+X6 FORM ABSOLUTE ADDRESS EQ GENR3 ICOM MX0 0 NO B REGISTER NEEDED SA1 ACVARS IX6 X1+X6 FORM ABSOLUTE ADDRESS EQ GENR3 FLONG SA1 NADS X1 = GETVAR CODE SA1 X1+ADS RJ RLLIT X6 = LITERAL EQ ISHORT3 * /--- BLOCK VREAD 00 000 77/12/18 17.20 TITLE VREAD -- CODE TO READ VERTICAL SEGMENTS * * COMPILE CODE TO READ VERTICAL SEGMENT OUT OF * WORD IN X1 ... B1=STARTBIT-1, B2=BITS/BYTE * AND A0 HAS REGISTERS TO USE (*SHORT* SAVES THESE) * VREAD EQ * NG X1,VREADS JUMP IF SIGNED SEGMENT SX6 B1+B2 SB-1+BB = SHIFT TO RIGHTJUSTIFY MX0 -6 BX6 -X0*X6 PROTECTION SX3 X6-60 ZR X3,VREAD2 CHECK FOR SHIFT = 60 SX2 A0 BX2 X0*X2 GET WORD REGISTER N00B SX2 X2+20000B ADD LX CODE BX7 X2+X6 AND SHIFT COUNT CALL SHORT FORM *LXN SHIFT* * VREAD2 SX2 60 SX1 B2 IX1 X2-X1 MX0 -6 PROTECTION BX1 -X0*X1 MX0 -3 SX2 A0 BX2 -X0*X2 GET MASK REGISTER SX2 X2+430B FORM MXK MASK LX2 6 BX7 X2+X1 CALL SHORT SX7 A0+15000B FORM BXN -XM*XN CALL SHORT EQ VREAD * VREADS MX0 -6 SX6 B1 LEFT JUSTIFY SHIFT BX6 -X0*X6 PROTECTION SX1 A0 BX1 X0*X1 GET WORD REGISTER N00B SA0 X1 AND SAVE IT SX7 X6+20000B FORM AN LXN K BX7 X1+X7 RJ SHORT ADD INSTRUCTION SB1 60 SX2 B1-B2 60-BB = RIGHTJUSTIFY SHIFT SX1 A0 GET WORD REGISTER BX1 X1+X2 SX7 X1+21000B FORM AN AXN K RJ SHORT EQ VREAD * /--- BLOCK VSTORE 00 000 77/12/18 17.31 TITLE VSTORE * * VSTORE CALLED WITH B1=STARTBIT, B2=BITS/BYTE * GENERATE CODE TO SHIFT RESULT (IN X6), FORM * MASK (IN X3), CLEAR OUT BYTE IN OLD WORD (IN X1) * AND STORE (FROM X7) BACK WITH NEW BYTE * VSTORE EQ * SX6 B1+B2 COMPUTE SHIFT TO RIGHT JUSTIFY MX0 -6 BX6 -X0*X6 PROTECTION SA0 X6 SAVE SX0 X6-60 SKIP IF LX1 60 ZR X0,VSTOR2 SX7 20100B FORM LX1 SHIFT BX7 X6+X7 CALL SHORT * NOTE SHORT SAVES B1,B2,A0 VSTOR2 SB1 60 SX1 B1-B2 MASK SIZE MX0 -6 BX1 -X0*X1 PROTECTION SX7 43300B FORM MX3 MASK BX7 X1+X7 CALL SHORT SX7 11131B FORM BX1 X3*X1 CALL SHORT SX7 15763B GENERATE AN BX7 -X3*X6 CALL SHORT SX7 12717B FORM BX7 X1+X7 CALL SHORT * SB1 A0 LOAD RIGHT-JUSTIFY SHIFT SB2 60 SX1 B2-B1 COMPUTE SHIFT TO RE-POSITION ZR X1,VSTOR4 SKIP IF SHIFT IS 0 SX7 20700B GENERATE AN LX7 SHIFT BX7 X1+X7 CALL SHORT * VSTOR4 SX7 54710B GENERATE AN SA7 A1+B0 CALL SHORT EQ VSTORE DONE * /--- BLOCK VSINDX 00 000 77/12/18 17.20 TITLE VSINDX -- CODE TO LOAD SEGMENT INFO WORD * * -VSINDX- * GENERATE CODE TO LOAD VERTICAL SEGMENT WORD * ON ENTRY - *SEGWD* = SEGMENT INFO WORD * *NADS* = POINTER TO INDEX * VSINDX EQ * CONDEN SA1 NADS INDEX IN ADDRESS STACK SA2 X1+ADS LOAD INDEX ADTYPE MX0 -XCODEAL BX3 X0*X2 ZR X3,SVCONST JUMP IF CONSTANT INDEX ENDIF * SB1 1 READ INDEX TO X1 CALL FORCEX SA1 NADS LOAD POINTER IN ADDRESS STACK SA1 X1+ADS LOAD INDEX ADTYPE LX1 59-XCODEAL-3 POSITION I/F BIT PL X1,VSEG10 JUMP IF INTEGER INDEX SB1 2 CALL CHEKRR OBTAIN X2 FOR -INDXFLT- SB1 1 REGISTER NUMBER OF INDEX CALL INDXFLT GENERATE CODE TO ROUND INDEX * VSEG10 SX6 1 SET INDEX REGISTER NUMBER SA6 FREG SX7 63110B GENERATE A SB1 X1+B0 CALL SHORT * SX7 0601B SET UP GE B0,B1,K * LX7 18 * SA1 LLAERR ADDRESS OF -ARAYERR- * BX7 X1+X7 * CALL LONGI GE B0,B1,ARAYERR SA1 SEGWD LOAD SEGMENT INFO WORD AX1 18 POSITION BASE ADDRESS SX4 X1 PICK OFF BASE ADDRESS NG X1,VSEGC JUMP IF -NC- VARIABLE SA2 ASVARS ADDRESS OF -N- VARIABLES IX6 X2+X4 SA6 SEGWD1 SAVE ABSOLUTE BASE ADDRESS SX2 X4-VARLIM-1 PL X2,VSEGR JUMP IF -NR- VARIABLE * /--- BLOCK VSINDX 00 000 79/02/09 13.55 * SX1 VARLIM SET LIMIT FOR -N- VARIABLES EQ VSEG30 * VSEGR SA2 ARVARS X2 = CM ADDR OF NR1 IX4 X6-X2 X4 = RVAR BASE INDEX OF SEG SX3 X4-RVARLIM-1 PL X3,VSEGL IF -NL- VARIABLE * SA1 RVARL ZR X1,VARERR SET LIMIT FOR -NR- VARIABLES EQ VSEG30 * VSEGL SA2 ALVARS X2 = CM ADDR OF NL1 IX4 X6-X2 X4 = LVAR BASE ADDRESS OF SEG SA1 LVARN X1 = LOCALS IN THIS UNIT IX3 X2-X4 NG X3,VARERR IF NOT INSIDE ANY VAR BANK * EQ VSEG30 * VSEGC SA2 ACVARS ADDRESS OF -NC- VARIABLES IX6 X2+X4 SA6 SEGWD1 SAVE ABSOLUTE BASE ADDRESS SX1 NCVRLIM SET LIMIT FOR -NC- VARIABLES * VSEG30 IX1 X1-X4 SUBTRACT BASE ADDRESS NG X1,VARERR SX1 X1+1 COMPUTE MAX LEGAL INDEX SX7 6120B GENERATE A SB2 B0+LIMIT LX7 18 BX7 X1+X7 ATTACH LIMIT CALL LONGI * SX7 0601B SET UP GE B0,B1,K LX7 18 SA1 LLAERR ADDRESS OF -ARAYERR- BX7 X1+X7 CALL LONGI GE B0,B1,ARAYERR * SX7 0721B GENERATE A LT B2,B1,ARAYERR LX7 18 SA1 LLAERR ADDRESS OF -ARAYERR- BX7 X1+X7 CALL LONGI LT B2,B1,ARAYERR * SX7 5111B GENERATE A SA1 B1+BASE LX7 18 SA1 SEGWD1 LOAD ABSOLUTE BASE ADDRESS SX1 X1-1 ADJUST (INDEX STARTS AT 1) BX7 X1+X7 CALL LONGI SA1 B1+BASE EQ VSINDX * /--- BLOCK LDLITAD 00 000 77/12/19 19.24 TITLE LDLITAD -- CODE TO GET ADDRESS OF INFO WORD * * -LDLITAD- * * GENERATES CODE TO LOAD THE ADDRESS OF THE SEGMENT/ * ARRAY LITERAL INFO WORD TO REGISTER B1. * * LDLITAD EQ * SUBROUT TO LOAD LITWD ADR TO B1 SA1 NADS LOAD SEGMENT/ARRAY ADTYPE SA1 X1+ADS MX0 -XCODEAL BX7 -X0*X1 MASK OFF ADDRESS OF INFO SA7 IOP SAVE FOR ARRAY SX1 6115B GENERATE A SB1 B5+K LX1 18 BX7 X1+X7 ATTACH ADDRESS RJ LONGI EQ LDLITAD * /--- BLOCK GENFCT 00 000 77/12/19 16.50 TITLE GENFCT -- GENERATE CODE TO CALL FUNCTION * * -GENFCT- * * GENERATE CODE TO CALL FUNCTION AND RETURN RESULT * IN REGISTER X1. * * GENFCT EQ * GENERATE CODE TO GET FN RESULT SA1 LLEXLOC ADDRESS OF TABLE OF ADDRESSES IX0 X0+X1 ENTER WITH FN NUMBER IN X0 SA0 ITEMP + RE 1 READ TABLE ENTRY RJ ECSPRTY SA1 A0 LOAD ADDRESS AND CONSTANT BIT NG X1,CMPKON JUMP IF CONSTANT NOT FUNCTION BX0 X1 LX0 1 SEE IF FUNCTION HAS AN ARGUMENT NG X0,CMPF20 JUMP IF NO ARGUMENT SA2 FFLT ZR X2,CMPF20 JUMP IF INTEGER ARGUMENT SX1 X1-2 DECREMENT ADDRESS FOR FLOATING * CMPF20 SX1 X1 PICK OFF ADDRESS PORTION SX7 0100B LX7 18 SET UP -RJ- INSTRUCTION BX7 X1+X7 RJ LONGI ADD -RJ- TO INSTRUCTION STREAM RJ PAD FILL OUT REST OF WORD EQ GENFCT * CMPKON BX0 X1 LX0 1 JUMP IF CONSTANT NG X0,CMPKON1 FALL THROUGH IF MEMORY FETCH SX1 X1 GET ADDRESS PORTION SX7 5110B GENERATE A SA1 B0+K LX7 18 BX7 X1+X7 ATTACH ADDRESS RJ LONGI ADD TO INSTRUCTION STREAM EQ GENFCT CMPKON1 MX0 2 BX1 -X0*X1 MX4 0 EQ INTIN CREATE INTEGER GETVAR * /--- BLOCK SETAD 00 000 77/12/19 16.48 TITLE SETAD -- MARK *ADS* ENTRY NOW IN REGISTER * * -SETAD- * * MARK ENTRY IN *ADS* LIST NOW IN REGISTER * SETAD EQ * SET AD IN ADS LIST TO REGISTER ASSIGNMENT SX7 1 UPDATE AD REFERENCE SA7 RX+1 FLAG X1 IN USE MX1 1 SIGN BIT FOR REGISTER BX7 X7+X1 SA1 FLOAT 0 IF INTEGER RESULT OF FUNCTION BX7 X7+X1 SA1 NADS SA7 X1+ADS EQ SETAD * /--- BLOCK FLOATIT 00 000 77/12/19 19.37 TITLE FLOATIT -- SET UP FLOAT INSTRUCTIONS * * -FLOATIT- * * GENERATE CODE TO CONVERT THE INTEGER CONTENTS OF * A REGISTER TO FLOATING POINT FORMAT. * * B1 = REGISTER NUMBER * * FLOATIT EQ * SET UP FLOAT INSTRUCTIONS SX7 B1 B1 HAS REGISTER NO. LX7 6 SX7 X7+B1 N0N SX7 X7+27000B 27 IS PXN RJ SHORT SX7 B1 B1 HAS REGISTER NO. LX7 6 SX7 X7+B1 N0N SX7 X7+24000B 24 IS NXN RJ SHORT EQ FLOATIT * /--- BLOCK INDXFLT 00 000 77/12/18 17.16 TITLE INDXFLT -- GENERATE CODE TO ROUND INDEX * * -INDXFLT- * GENERATE INSTRUCTIONS TO ROUND INDEX * B1 = REGISTER NUMBER OF INDEX * * CODE PRODUCED WILL DESTROY X2 * * INDXFLT EQ * SX7 17174B 0.5 = 17174 00000 00000 00000 SX6 712B -SX2- OPERATION LX6 21 BX7 X6+X7 MERGE TO FORM -SX2 17174B- RJ LONGI LONGI PRESERVES B1 SX7 20255B -LX2 45- RJ SHORT SX2 AND LX2 FORM 0.5 IN X2 SX7 B1 NEXT FORM -FXN X2+XN- LX7 6 SX7 X7+B1 N0N SX7 X7+30020B FORM -FXN X2+XN- RJ SHORT SX7 B1 LX7 6 SX7 X7+B1 SX7 X7+26010B FORM -UXN B1,XN- RJ SHORT SX7 B1 LX7 6 SX7 X7+B1 SX7 X7+22010B FORM -LXN B1,XN- RJ SHORT EQ INDXFLT * /--- BLOCK FORCEX 00 000 78/01/31 23.21 TITLE FORCEX -- READ ADTYPE TO SPECIFIED REGISTER * * -FORCEX- * * READ ADTYPE TO SPECIFIED REGISTER * B1 ENTERED WITH REGISTER TO GET. EXITS THE SAME. * FORCEX EQ * SX6 B1 SAVE DESIRED REGISTER NUMBER SA6 FREG RJ GENREAD TRY TO READ TO DESIRED REGISTER SA2 FREG SB2 X2 SEE IF READ TO PROPER REGISTER MX7 1 SA7 B1+RX MARK CURRENT REGISTER IN USE EQ B1,B2,FORCEX SX6 B1 SAVE CURRENT REGISTER NUMBER SA6 FREG SB1 B2 GET DESIRED REGISTER NUMBER SA1 B1+RX ZR X1,FCONT DESIRED REGISTER IS FREE SX6 X6-7 ZR X6,PMIND IS EXPRESSION TOO COMPLICATED PFCONT RJ CHEKRR FREE DESIRED REGISTER * B1 SAVED IN CHEKRR FCONT SX7 1 MARK DESIRED REGISTER IN USE SA7 B1+RX SX1 B1 SA2 FREG CURRENT REGISTER NUMBER MX7 0 FREE CURRENT REGISTER SA7 X2+RX LX1 6 POSITION REGISTER NUMBERS LX2 3 BX1 X1+X2 SX7 X1+10000B FORM A BXN XM RJ SHORT EQ FORCEX * * BELOW IS FIX TO FIX PMIND SA1 RX+3 IS X3 AVAILABLE ZR X1,PFCONT SA1 RX+4 ZR X1,PFCONT SA1 RX+5 ZR X1,PFCONT SA1 RX+0 ZR X1,PFCONT EQ MINDERR EXPRESSION IS COMPLICATED * FREG BSS 1 * * /--- BLOCK CHEKRR 00 000 80/01/17 22.19 TITLE CHEKRR -- CHECK READ REGISTER AVAILABLE * * -CHEKRR- * * CHECK IF A READ REGISTER IS AVAILABLE. IF NOT, * CODE IS GENERATED TO MAKE IT AVAILABLE BY SAVING * THE DESIRED REGISTER IN A TEMPORARY. * * ENTER WITH B1 = REGISTER TO CHECK. EXITS THE SAME. * * CHEKRR EQ * CHECK READ REGISTER AVAILABILITY SA1 B1+RX REQUESTED READ REGISTER NO. IN B1 ZR X1,CHEKRR AVAILABLE SB2 B1 NOPE, SAVE DESIRED REGISTER NO. IN B2 RJ CHOOSEX CHOOSE A REGISTER TO SEND X1 TO. SX7 B0 SA7 B2+RX FREE IT EQ B1,B2,CHEKRR AVOID BX7 X7 SX7 B2 SB3 1 MX2 57 MASK FOR REGISTER NUMBER SA1 ADS-1 FINDXN SA1 A1+B3 FIND THE REFERENCE TO IT PL X1,FINDXN REGISTER REFERENCE HAS SIGN BIT LIT BX6 -X2*X1 REG. NO. BX6 X6-X7 NZ X6,FINDXN MUST BE IN ADS LIST *** ERROR PROTECTION SX6 OPS+OPSMAX SX7 A1 IX6 X7-X6 PL X6,MINDERR EXPRESSION TOO COMPLICATED *** SX7 B1 DESTINATION REGISTER NO. BX1 X2*X1 SAVE BITS OTHER THAN REGISTER NO. BX6 X1+X7 BRING IN NEW REG. NO. SA6 A1 CHANGE ADDRESS TO NEW REGISTER SX7 X7+100B BUILD BX(DESTINATION) ORIGIN LX7 3 SX7 X7+B2 ORIGIN REGISTER NO. LX7 3 RJ SHORT ADD TO INSTRUCTION STREAM SB1 B2 RESTORE B1 EQ CHEKRR * /--- BLOCK PICKX 00 000 77/12/19 19.40 TITLE PICKX -- PICK A RESULT REGISTER * * -PICKX- * * CHOOSE A RESULT DESTINATION REGISTER. THIS ALSO * UPDATES THE ADS ENTRY CORRESPONDING TO THE DESIRED * REGISTER. * * B1 = REGISTER NUMBER * * PICKX EQ * PICK A RESULT DESTINATION REGISTER ***** * ATTEMPT TO USE X1 FOR DESTINATION IF LAST OP. * *INHAND OP PRECEDENCE LEVEL FOR END OF LINE OR COMMA IS -1 SA1 INHANDL CHECK WHETHER LAST OPERATION SX1 X1+B0 OP INHAND LEVEL IN LOW-ORDER BITS PL X1,PICKXX JUMP IF NOT END OF LINE OR COMMA SA1 NOPS SX1 X1-2 IF LAST OP, NOPS=2 (OPS(1) IS BEGIN LINE) NZ X1,PICKXX JUMP IF NOT LAST OP SB1 1 CHOOSE X1 DESTINATION EQ PICKED2 PICKXX RJ CHOOSEX CHOOSE A VACANT REGISTER PICKED2 SX7 B1 UPDATE OPERAND REFERENCE (B1 GIVES REG. NO) MX0 1 SIGN BIT BX7 X7+X0 FLAG REGISTER ADTYPE WITH SIGN BIT SA1 FLOAT IS IT FLOATING RESULT ZR X1,PICKED3 JUMP IF INTEGER RESULT SX0 1 LX0 XCODEAL+3 SET UP I/F BIT BX7 X7+X0 MERGE PICKED3 SA1 NADS SA7 X1+ADS STORE ADTYPE OF RESULT EQ PICKX * /--- BLOCK CHOOSEX 00 000 77/12/19 19.42 TITLE CHOOSEX -- CHOOSE A VACANT REGISTER * * -CHOOSEX- * * CHOOSE ANY UNUSED REGISTER. IF ALL REGISTERS ARE * IN USE, CODE WILL BE GENERATED TO MAKE FREE X7 BY * STORING THE VALUE INTO A TEMPORARY CM CELL. * * ON EXIT, * B1 = UNUSED REGISTER NUMBER * * CHOOSEX EQ * CHOOSE A VACANT REGISTER SA1 RX+7 USE X7 IF AVAILABLE ZR X1,CHOSEN (RX+7) = 0 IF X7 NOT IN USE SA1 RX+0 THEN TRY X0 ZR X1,CHOSEN SA1 RX+5 KEEP LOOKING ZR X1,CHOSEN SA1 RX+4 ZR X1,CHOSEN SA1 RX+3 ZR X1,CHOSEN SX7 7 NO REGISTER AVAILABLE, STORE X7 IN TEMPS MX2 57 MASK FOR REGISTER NUMBER SB1 1 SA1 ADS-1 FINDX7 SA1 A1+B1 FIND THE OPERAND NOW IN X7 PL X1,FINDX7 REGISTER IS FLAGGED NEGATIVE BX1 -X2*X1 GET REGISTER NUMBER BX1 X1-X7 NZ X1,FINDX7 RJ STR7TMP PUT CONTENTS OF X7 IN TEMPSTOR SB1 7 MARK REGISTER 7 CHOSEN EQ CHOOSEX * CHOSEN SB1 A1-RX CALC CHOSEN REGISTER NUMBER SX7 1 SA7 A1 MARK IT TO BE IN USE EQ CHOOSEX * /--- BLOCK STR7TMP 00 000 77/12/19 19.43 TITLE STR7TMP -- CODE TO STORE X7 IN TEMPORARY * * GENERATES CODE TO STORE X7 IN TEMPSTOR LOC * AND UPDATES ADS LIST ACCORDINGLY. * * ON ENTRY, * A1 = ADDRESS OF ENTRY IN *ADS* LIST CORRESPONDING * TO THE OPERAND IN REGISTER X7. * * STR7TMP EQ * ENTER WITH *ADS+NADS* IN A1 SA2 TEMP PICK UP PRESENT TEMP STACK PTR SX7 X2+1 INCREMENT TEMP POINTER SA7 TEMP SX7 X7-TEMPLIM PL X7,TEMPERR JUMP IF TOO MANY TEMPS USED SX2 X2+VARLIM+1 FIRST TEMP IS V(VARLIM+1) SX7 1 CONSTRUCT I/F MASK LX7 XCODEAL+3 SA1 A1 GET ADTYPE OF OPERAND IN X7 BX7 X7*X1 GET I/F BIT BX7 X7+X2 BRING IN TEMP ADDRESS SX1 2 GETVAR CODE FOR STUDENT BANK LX1 XCODEAL BX7 X7+X1 FORM COMPLETE GETVAR CODE SA7 A1 AND CHANGE STACK AD (WAS IN X7) SX7 5170B GENERATE SA7 B0+** LX7 18 SA1 ASVARS GET BASE ADD FOR STUDENT VARS IX2 X1+X2 BX7 X7+X2 RJ LONGI EQ STR7TMP * /--- BLOCK FREEX 00 000 77/12/19 19.43 TITLE RLLIT -- RETRIEVE LONG LITERAL * * -RLLIT- * RETRIEVE LONG LITERAL * * (X6) = LONG LITERAL * * ON ENTRY - (X1) = GETVAR CODE FOR LITERAL * * ON EXIT - (X6) = LITERAL * (X1) = GETVAR CODE W/LIST BIT RESET * * USES A/X0,A/X6,A1 * ENTRY RLLIT RLLIT EQ * MX0 60-XCODEAL ADDRESS MASK BX0 -X0*X1 ADDRESS OF LITERAL BX6 X1 SAVE ADTYPE LX1 60-LITSHF1 *LITS* BIT = SIGN BIT PL X1,RLLIT10 IF LITERAL IS IN *TOKBUF* * SA1 NLITS LITS STACK POINTER BX1 X1-X0 CHECK FOR TOP OF LITS STACK NZ X1,RLLIT08 DO NOT DECREMENT IF NOT TOP * BX1 X6 SAVE ADTYPE SX6 X0-1 POP LITS STACK SA6 A1 BX6 X1 SAVE ADTYPE RLLIT08 SA1 X0+LITS GET LIT * MX0 59 TURN OFF *LITS* BIT * LX1 60-LITSHFT * BX1 X0*X1 * LX1 LITSHFT EQ RLLIT20 * RLLIT10 BSS 0 LITERAL IS IN *TOKBUF* SA1 ATOKEN ADDR OF TOKENS IX0 X1+X0 ADDR OF LIT IN ECS SA0 LLITEMP RE 1 LITERAL IS IN *LLITEMP* RJ ECSPRTY SA1 LLITEMP (X1) = LITERAL * RLLIT20 BX0 X6 RESTORE (X1) AND SET (X6) BX6 X1 BX1 X0 EQ RLLIT * * TITLE SLLIT -- STORE LONG LITERAL * * -SLLIT- * STORE LONG LITERAL * * ON ENTRY - (X6) = LONG LITERAL * (X1) = TYPE CODE * * ON EXIT - (X6) = ADTYPE WITH ADDRESS * * USES X0,A/X1,X6 * ENTRY SLLIT SLLIT EQ * BX0 X1 SAVE TYPE CODE SA1 NLITS SA6 LITS+1+X1 STORE LITERAL AND FREE X6 SX6 X1+1 SA6 A1 SX1 X6-LITL JUMP IF TOO MANY LITERALS PL X1,LITERR * /--- BLOCK FREEX 00 000 77/12/19 19.43 LX0 XCODEAL POSITION TYPE CODE BX6 X0+X6 CREATE GETVAR CODE SX0 1 LX0 LITSHFT POSITION *LITS* BIT BX6 X0+X6 FLAG LIT ADDR POINTS TO *LITS* EQ SLLIT * LLITEMP BSS 1 TITLE FREEX -- FREE UP A REGISTER * * -FREEX- * * MARK A REGISTER UNUSED * * B1 = REGISTER TO FREE UP * * FREEX EQ * FREE REGISTER NO LONGER IN USE SX7 B0 MUST NOT ALTER X1,X3,X6 SA7 B1+RX REGISTER SPECIFIED IN B1 EQ FREEX * /--- BLOCK LSEEK 00 000 77/12/17 18.01 TITLE LSEEK -- SEARCH FOR EXISTING LITERALS * * -LSEEK- * * SUBROUTINE TO PLANT LITERAL IN XTRA STORAGE * MUST NOT CHANGE B2,X0,A0 OR X6,X1,A1 AS SET * RETURN B1=0 IF NEW LITERAL * LSEEK EQ * ADD ONE LITERAL MX2 0 FLAG ONLY ONE RJ LSEEKA EQ LSEEK * LSEEK2 EQ * ADD TWO LITERALS MX2 -1 FLAG TWO RJ LSEEKA (X7 HAS 2ND LITERAL) EQ LSEEK2 * LSEEKA EQ * SEEK LITERAL IN EXTRA STORAGE SA1 INX GET EXTRA STORAGE POINTER SA6 X1+INFO PLANT SEARCH ITEM SA1 INFO-1 INITIAL ADDRESS SB1 1 SA7 A6+B1 PLANT 2ND LITERAL LSEEKB SA1 A1+B1 GET NEXT ITEM BX1 X6-X1 COMPARE WITH X6 NZ X1,LSEEKB NG X1,LSEEKB PROTECT AGAINST (-0)-(0) ZR X2,LSEEKC JUMP IF ONLY ONE LITERAL SA3 A1+B1 GET 2ND LIT IX3 X3-X7 NZ X3,LSEEKB NG X3,LSEEKB PROTECT AGAINST (-0)-(0) LSEEKC SB1 INFO COMPUTE LOCATION OF LITERAL SX6 A1-B1 SB1 A6 CHECK FOR NEW OR OLD LITERAL SB1 A1-B1 COMPARE FOUND AND PLANT ADDRESSES NZ B1,LSEEKA DONE IF OLD LITERAL SA1 INX OTHERWISE ADVANCE INX SX7 X1+1 SA7 A1 ZR X2,LSEEKA SX7 X7+1 TWO LITERALS SA7 A7 EQ LSEEKA * /--- BLOCK MOVCODE 00 000 77/12/19 19.45 TITLE MOVE CODE * * -MOVCODE- * * MOVE CODE INTO *ARGUMENT STORAGE* * EXITS WITH ARG STORAGE ADDRESS OF CODE IN X0 * ALSO DESTROYS A1,X1,A2,X2,A7,X7,B1,A0 * * ****NOTE**** THIS ROUTINE IS NO LONGER * USED BY -CALCS- BECAUSE IT DOES NOT DO * PROPER END TESTS FOR POSSIBLE OVERFLOW * OF THE -INFO- BUFFER -- 'PHIL 8/3/76 * * ENTRY MOVCODE MOVCODE EQ * CONDEN SX2 INST CONDEN ENDIF PLATO SX2 INFO+INFOX LOCATION OF CODE DURING EXEC ENDIF * SA0 X2 SA1 NINST POINTER TO LAST WORD OF CODE PLUS 1 IX2 X1-X2 SB1 X2 COUNT OF CODE WORDS SA1 ATEMPEC ECS WORK BUFFER POINTER BX0 X1 + WE B1 SEND CODE TO ECS - RJ =XECSPRTY SA1 INX INFO POINTER SX7 X1+B1 INCREMENT INX SA7 A1 SA0 X1+INFO + RE B1 MOVE CODE INTO INFO BUFFER - RJ =XECSPRTY BX0 X1 LOCATION OF CODE IN INFO EQ MOVCODE * /--- BLOCK PAD 00 000 78/01/25 13.50 TITLE PAD OUT INSTRUCTION WORD WITH NO-OPS * * -PAD- * * -LABDEF- IN IDENT CALCS ASSUMES THAT -PAD- * DOES NOT DESTROY A4,B4,X4,A5,B5,X5,A7,B7,X7 * * THIS ROUTINE DOES NOT CHANGE B1,B2,A0 * ENTRY PAD PAD EQ * PAD OUT AN INSTRUCTION WITH NO-OPS SA1 NINST GET CURRENT INSTRUCTION WORD SA2 X1 PADX1 ZR X2,PAD NO NEED TO PAD IF WORD EMPTY LX2 15 MAY HAVE 15 OR 30 BITS TO PAD MX0 15 CHECK FOR NEEDED PADDING TO LEFT-ADJUST BX6 X2*X0 EXAMINE LEFT-MOST INSTRUCTION SX0 46000B SET UP NO-OP INSTRUCTION NZ X6,PAD2 IF BITS SET, NOW LEFT-ADJUSTED BX2 X2+X0 NO-OP AT RIGHT EQ PADX1 LOOP PAD2 BX6 X2+X0 STICK IN A NO-OP SA6 A2 PUT BACK LEFT-SHIFTED SB3 PAD * * UPDATE INSTRUCTION WORD POINTER--- ASSUMES A1,X1,B3 SET AT ENTRY * DESTROYS X6,A6,X1,A2,X2 * DO NOT ALTER B1,B2,A0...A4,B4,X4,A5,B5,X5,A7,B7,X7 ENTRY UPNINST UPNINST SX1 X1+1 INCREMENT INSTUCTION WORD POINTER AND SA2 NINSTLIM LIMIT ON NINST IX2 X1-X2 PL X2,LNGERR TOO BAD, RAN OVER BX6 X1 SA6 A1 STORE NEW POINTER MX6 0 SA6 X1 CLEAR OUT NEW INST WORD JP B3 RETURN TO CALLER * /--- BLOCK SHORT 00 000 78/01/20 14.58 TITLE ADD SHORT INSTRUCTION TO STREAM * * -SHORT- * * ADD A SHORT (15-BIT) INSTRUCTION TO THE OUTPUT * STREAM. * * X7 = INSTRUCTION TO ADD (LOWER 15 BITS) * * * DONT ALTER B1,B2,A0 IN THIS SUBROUTINE (DLS) * ENTRY SHORT SHORT EQ * ADD SHORT INSTRUCTION TO STREAM SA1 NOTLITS IS IT LITERAL OPERATION NZ X1,SHORT2 JUMP IF NOT LITERALS SA1 =46000460004600000000B THREE PASSES BX7 X1+X7 PLUS INSTRUCTION SA7 EXECUTE PLANT IT SA1 ARGX1 LOAD FIRST ARG SA2 ARGX2 LOAD SECOND ARG RJ EXECIT EXECUTE THE PLANTED INSTRUCTION SA1 NLITS RESULT IN X7 *NLITS HAS BEEN ALREADY INCREMENTED BY -BINARY-. SA7 X1+LITS STORE IN LITS TABLE MX0 60-XCODEAL CHECK TO SEE IF RESULT IS SHORT LITERAL BX0 X0*X7 NZ X0,SHORT3 IF LONG, SET LITS BIT * SA1 NADS SA7 X1+ADS CHANGE TO SHORT EQ SHORT SHORT2 SA1 NINST NOT LITERAL OPERATION SA2 X1 GET CURRENT WORD LX2 15 BX7 X7+X2 MERGE NEW INSTRUCTION SA7 A2 STORE MX0 15 BX0 X7*X0 CHECK FOR FULL WORD ZR X0,SHORT SB3 SHORT EQ UPNINST UPDATE NINST, RETURN TO SHORT * SHORT3 SA2 NADS INSERT *LITS* ADDRESS/BIT SA2 X2+ADS AX2 XCODEAL LX2 XCODEAL BX6 X1+X2 ADDRESS SX1 1 INDICATE STORED IN *LITS LX1 LITSHFT BX6 X1+X6 SA1 NADS SA6 X1+ADS EQ SHORT * * * * THIS LITTLE THING IS DONE TO INSURE THAT THE INSTRUCTION * STACK IS VOIDED. 'ON 'C'D'C MACHINES, A -RJ- INSTRUCTION * FORCES THE MACHINE TO RE-READ THE INSTRUCTIONS. * THIS ROUTINE IS REFERENCED FROM ',SHORT', AND ',LBINARY',. * (ALL OPTIMIZATIONS ARE DONE IN SHORT BUT SHIFTS, AND THOSE * ARE DONE IN LBINARY.) * EXECIT EQ * EXECUTE BSS 1 EXECUTE THE COMMAND EQ EXECIT RETURN FROM WHENCE IT CAME * * /--- BLOCK LONGI 00 000 77/12/19 16.05 TITLE ADD LONG INSTRUCTION TO STREAM * * -LONGI- * * ADD LONG INSTRUCTION TO OUTPUT STREAM. * * X7 = 30-BIT INSTRUCTION * * * DO NOT ALTER B1,B2,A0,A5,B5,X5 IN THIS SUBROUTINE * ENTRY LONGI LONGI EQ * ADD LONG INSTRUCTION TO STREAM SA1 NINST SA2 X1 GET CURRENT WORD MX0 30 BX0 X0*X2 CHECK FOR ENOUGH SPACE ZR X0,LONG2 JUMP IF SPACE LX2 15 SX6 46000B SET UP PASS BX6 X6+X2 SA6 A2 PUT IT AWAY SB3 LONG2A EQ UPNINST INC NINST, RETURN TO LONG2A LONG2A SA1 NINST RELOAD IT MX2 0 LONG2 LX2 30 BX7 X7+X2 BUILD WHOLE INSTRUCTION WORD SA7 X1 STORE IT IN STREAM MX0 15 CHECK FOR FULL WORD BX0 X0*X7 ZR X0,LONGI SB3 LONGI EQ UPNINST INC INST POINTER, RETURN TO LONGI * /--- BLOCK STORAGE 00 000 78/09/15 19.13 TITLE STORAGE DEFINITIONS * * * STORAGE DEFINITIONS * * PREVOPL BSS 1 PREVIOUS OP LEVEL LASTOP BSS 1 LAST ITEM OPCODE, FOR UNARY - CHECK FINALOP BSS 1 LAST OPERATION COMPILED CALC BSS 1 1 IF CALC, 0 IF NOT A CALC COMMAND INHAND BSS 1 OP IN HAND INHANDL BSS 1 OP LEVEL IN HAND IOP BSS 1 SAVE INSTRUCTION CODE SAVEOP BSS 1 SAVE OP FFLT BSS 1 FLOATING ARGUMENT FLAG POWER BSS 1 SAVE EXPONENTIATION POWER FLOAT BSS 1 SAVE FLOATING-PT INSTRUCTION CODE TEMP BSS 1 TEMP STACK POINTER ENTRY NOTLITS NOTLITS BSS 1 NZ IF OPERANDS NOT BOTH LITERALS RECIP BSS 1 RECIPROCAL FLAG (0 IF NOT NEEDED) ARGX1 BSS 2 LITERAL ARGUMENTS ARGX2 EQU ARGX1+1 ARG EQU ARGX1-1 SEGWD BSS 1 TEMP VARIABLES USED SEGWD1 BSS 1 BY SEGMENT, ARRAY ROUTINES BUFCHK BSS 1 NZ IF HAVE CHEKED ECS AVAILABLE ASIZE BSS 1 TEMP-ARRAY SIZE,TYPE ENTRY ARAYFLG ARAYFLG BSS 1 SET=1 BY CALLER IF EXPECTS ARAY TMPASIZ BSS 1 TEMP ARRAY STORAGE USED TMPAFLG BSS 1 TEMPORARY ARRAY INFO AOPAD BSS 1 SAVE ARRAY OPERAND ADDRESSES TMPARAY BSS 1 TEMPORARY ARRAY ADDRESS NARGS BSS 1 NO. OF COMMAS IN MULTIPLE-ARGUMENT FUNCTION NARRAYS BSS 1 NO. OF WHOLE ARRAYS ENCOUNTERED RX BSS 8 REGISTER RESERVATIONS * ZERO IF NOT IN USE, 1 IF IN USE ENTRY CSYMADD,CSYMNUM CSYMADD BSS 1 SYMBOL TABLE ADDRESS CSYMNUM BSS 1 NUMBER OF SYMBOLS IN TABLE CONDEN TOPCNT BSS 1 NUMBER OF OPERATORS ENCOUNTERED ENTRY TVARCNT TVARCNT BSS 1 NUMBER OF VARIABLES REFERENCED ENDIF * FINDXED BSS 1 0=INDEXED VARIABLE, IF IN REG. *SEE VARLOC OPTIMIZATION FOR EXAMPLE USEAGE * /--- BLOCK END 00 000 77/12/16 15.14 * END