TITLE 'CODEXEQ-B00,08/22/73,DWG702985' SYSTEM SIG7F CSECT 1 PCC 0 CONTROL CARDS NOT PRINTED. CODEXEQ@ RES 0 ORIGIN OF CODESTRING EXEC. MODULE. * * REF'S AND DEF'S * DEF CODEXEQ@ = START OF 'CODEXEQ' MODULE. DEF CX CODESTRING EXECUTION ENTRY PT. SPACE 2 DEF XEQEMPTY RETURN PT WHEN AN 'EXECUTE' IS OK, * BUT PRODUCED NO CODESTRING, E.G. * A SUCCESSFUL COMMAND EXECUTION. DEF LOBRNCK ENTERED FOR ERR-CTRL BRANCH. DEF OBSERVED RESUME AFTER AN OBSERVATION. DEF RESQQUAD RESUME AFTER QUOTE-QUAD INPUT. DEF QDBDONE RESUME AFTER QUAD-ZERO INPUT. DEF QOUTRET RESUME AFTER QUAD-ZERO OUTPUT. DEF RETURNMX RETURN FROM MONADIC-OP EXECUTION. DEF RETURNDX DYADIC-OP EXECUTION. DEF RETURNNI NILADIC INTRINSIC FUNC. DEF RETURNSX SUBSCRIPT EXECUTION. DEF RETURNAX ASSIGNED-INDEXING EXEC. SPACE 3 * REFS TO PROCEDURE: REF F2I FLOATING-TO-INTEGER CONVERSION. REF CTEST TRIES TO GET MORE COMMON REF ALOCBLK ALLOCATE DATA BLOCK. REF ALOCHNW ALLOCATE HEADER PLUS N WDS. REF ALOCRS ALLOCATE RESULT DATA BLOCK. REF ALOCTRES ALLOCATE TEXT TYPE RESULT DATA BLK. REF DREF DEREFERENCE A DATA BLOCK. REF MAYDREF DEREFERENCE A DATA BLOCK, IF ANY. REF ERDOMAIN DOMAIN ERROR. REF ERRANK RANK ERROR. REF ERLENGTH LENGTH ERROR. REF SYSTERR SYSTEM ERROR HANDLER (TOTALLY LOST). REF OPBREAK STARTS TBL OF ERROR ENTRY PTS. REF SICLR% CLEAR STATE INDICATOR TO GO-STATE. REF BREAKFLG BREAK FLAG (NZ IF BRK OR HANG-UP). REF MXDRIVER MONADIC OPERATOR EXECUTION DRIVER. REF DXDRIVER DYADIC OPERATOR EXECUTION DRIVER. REF SXDRIVER SUBSCRIPTING EXECUTION DRIVER. REF AXDRIVER INDEXED ASSIGNMENT EXECUTION DRIVER. REF INNER INNER PRODUCT EXECUTION DRIVER. REF OUTER OUTER PRODUCT EXECUTION DRIVER. REF REDUCE REDUCTION OPERATOR EXECUTION DRIVER. REF SCAN SCAN OPERATOR EXECUTION DRIVER. U19-0004 REF NINTRIN NILADIC OPERATOR EXECUTION DRIVER. REF MINTRIN MONADIC OPERATOR EXECUTION DRIVER. REF DINTRIN DYADIC OPERATOR EXECUTION DRIVER. REF INPDIR REQUESTS DIRECT INPUT. REF INPEVAL REQUESTS EVALUATED INPUT. REF INPQQUAD REQUESTS QUOTE-QUAD INPUT. REF INPXEQ DOES INPUT-TRANS. FOR EXECUTE OPER. REF INPBLIND REQUESTS BLIND INPUT. REF QZIN QUAD-0 (GRAPHICS) INPUT START PT. REF QZOUT QUAD-0 (GRAPHICS) OUTPUT START PT. REF MIXEDOUT STMT DISPLAYER (MIXED OUTPUT). REF SINGOUT DISPLAY SINGLE DATA BLOCK VALUE. REF BLINDOUT OUTPUTS BLINDLY REF SHOWSTOP DISPLAYS STOPPED-FUNC.NAME & LINE #. REF FUNLDISP DISPLAYS FUNC.NAME & LINE NUMBER. REF OBSERVER DISPLAYS AN OBSERVATION. * REFS TO CONTEXT: REF OPER DBLWD TEMP FOR OPERATOR INFO. REF CXDTEMP DBLWD TEMP USED BY CODESTRING EXEC. REF FDEFPTR (DB PTR) FUNCTION DESCRIPTOR. REF XTEMP (DB PTR) INDEX OR COORD. REF NILCK (DB PTR) REF LFARG (DB PTR) LEFT ARG. REF RTARG (DB PTR) RIGHT ARG. REF RESULT (DB PTR) RESULT. REF CURRCS PTS AT CURRENT CODESTR. DATA BLK +2. REF RSSIZE HOLDS NO.OF ELEMENTS FOR RESULT D.B. REF RSTYPE USED TO HOLD TYPE OF RESULT DATA BLK REF RSRANK USED TO HOLD RANK OF RESULT DATA BLK REF BRNVAL BRANCH VALUE. REF GOSTATE GO-STATE FOR STATE INDICATOR CLEARS. REF CATCHTBL CATCH TABLE. REF OBSFLAG OBSERVE-CMD FLAG (0=NO & -1=YES). REF OBSERVE OBSERVATION SETTING (0=NO & -1=YES). REF STATEPTR PTS AT TOP STATE-ENTRY IN STACK. REF TOPOSTAK OFTEN PTS AT TOP OF EXECUTION STACK. REF ORGADJ VALUE USED IN ADJUSTING TO ORIGIN 1. REF OFFSET OCCAS. USED TO SAVE CURR. CS OFFSET. REF CXSCRTCH SCRATCH AREA FOR CODESTRING EXEC. REF INBUF INPUT BUFFER. REF IMAGE INTERNAL IMAGE OF INPUT LINE. REF SYMT PTS AT 1ST WD OF SYMBOL TABLE. REF NAMEPTR PTS TO REF-INDIC WD FOR A VAR. NAME. REF BLINBUF BLIND INPUT BUFFER REF STKLIMIT CURRENT LIMIT TO EXEC.STACK. REF LOCNEED LOC (+1) NEEDED FOR COMMON INCREASE. * REFS TO CONSTANTS: REF X1FFFF X'1FFFF' REF XFF0000 X'FF0000' REF BITPOS 32-WD TBL OF BITS (BITPOS-K CONTAINS * A WD HAVING A 1 ONLY IN BIT POS K) REF FUNTYPES RANGE OF FUNCTION TYPES. * * EQU'S RELATED TO THE CONTEXT REF'S. * OPERHOLD EQU CXDTEMP HOLDS OPER INFO TILL OTHER OP EXECD. XPARAMS EQU CXDTEMP INDEX SEQUENCE PARAMETERS-- XADD EQU XPARAMS ADDITIVE FACTOR. XMULT EQU XPARAMS+1 MULTIPLICATIVE FACTOR. DENTRY EQU BITPOS-4 DY. FUN CAT.OF EXEC.STACK ENTRY. BENTRY EQU BITPOS-5 BRACKET CAT.OF EXEC.STACK ENTRY. OENTRY EQU BITPOS-6 OPERATOR CAT.OF EXEC.STACK ENTRY. COORD1 EQU BITPOS-7 COORDINATE-1 (FOR OPS LIKE %RV1). PTRITEM EQU LFARG FOR PTR SCANITEM. LINKX EQU CXSCRTCH+0 LINK TO 'SUBEX'. LINKMX EQU CXSCRTCH+0 LINK TO 'MONEX'. ACFLAG EQU CXSCRTCH+0 ASSIGNMENT-COMPLETED FLAG. XSIZE EQU CXSCRTCH+0 EXECUTION STACK SIZE FOR FUN.CALL. STSET EQU CXSCRTCH+0 STOP OR TRACE BIT SETTING. SCANTEMP EQU CXSCRTCH+1 SCAN ITEM HOLDER. NFL4ST EQU CXSCRTCH+1 NO.OF FUN LINES FOR STOP OR TRACE. OFFSETR EQU CXSCRTCH+2 OFFSET FOR RE-SCAN OF DESIGNATOR. LINKT EQU CXSCRTCH+2 LINK HOLDER FURING TRACED SHOW SET. FDLPTR EQU CXSCRTCH+2 FUN DESCRIPTOR LINE-PTR PTR. OPCURRBY EQU CXSCRTCH+3 CURR.BYTE HOLDER FOR OPWRAP. * * STANDARD EQU'S * REGISTERS R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 * * EXECUTION STACK CATEGORIES * CATV EQU 0 (NOT USED MUCH) VALUE PTR. CATAPRYM EQU 1 ASSIGNMENT (COMPLETED). CATO EQU 2 OPERATOR. CATX EQU 3 INDEX (LIST PTR). CATB EQU 4 BRACKETED. CATP EQU 5 PARENTHESIZED. CATS EQU 6 STMT. CATQ EQU 7 QUAD-STATE (FOR EVAL-INPUT). CATD EQU 8 DYADIC FUNC. (WITHOUT LEFT ARG). CATA EQU 9 ASSIGNMENT (NOT YET COMPLETED). CATF EQU 10 FUNCTION-STATE. * * SCAN ITEM INDICATORS: * SCANPTR EQU 0 (NOT USED MUCH) PTR SCANVN EQU 1 VN SCANBRN EQU SCANVN+1 BRN SCANBOS EQU SCANBRN+1 BOS SCANLP EQU SCANBOS+1 LP SCANLB EQU SCANLP+1 LB SCANSEMI EQU SCANLB+1 SEMI SCANOPM EQU SCANSEMI+1 OPM SCANOP EQU SCANOPM+1 OP * * DATA BLOCK TYPES: * TYPELOGL EQU 1 LOGICAL TYPETEXT EQU 2 TEXT TYPEINTG EQU 3 INTEGER TYPEREAL EQU 4 REAL TYPELIST EQU 6 LIST TYPENFN EQU 8 FUNC.DESCR, NILADIC & NO RESULT. TYPEMFN EQU X'A' FUNC.DESCR, MONADIC & NO RESULT. TYPEDI EQU X'E' DYADIC INTRINSIC TYPEMI EQU X'F' MONADIC INTRINSIC TYPENI EQU X'10' NILADIC INTRINSIC * * OTHER EQU'S * OFFSETS INTO A FUNCTION DESCRIPTOR DATABLK * XSIZOFF EQU 2 EXEC. STACK SIZE FOR THE FUNCTION. RESOFF EQU XSIZOFF+1 RESULT NAME PTR. LFOFF EQU RESOFF+1 LEFT ARGUMENT NAME PTR. FNOFF EQU LFOFF+1 FUNCTION-NAME NAME PTR. RTOFF EQU FNOFF+1 RIGHT ARGUMENT NAME PTR. NFLOFF EQU RTOFF+1 NO.OF FUNCTION LINES. LINSTART EQU NFLOFF+1 LINE PTRS START HERE. * CODESTRING DESIGNATIONS. QZCODE EQU 25 QUAD-0 Q1CODE EQU 26 QUAD-1 QUADCODE EQU 35 QUAD STOPNMCD EQU 21 STOPNAME COMMACOD EQU 87 COMMA OPERATOR (FOR LAMINATION). BOSCODE EQU 37 BEGINNING-OF-STMT. SEMICODE EQU 38 SEMICOLON SMOCODE EQU 46 SMALL CIRCLE SCAN1COD EQU 118 SCAN OPERATOR (ON 1ST COORD) U19-0006 XEQCODE EQU 120 EXECUTE OPERATOR (EPSILON). DUMMYCD EQU 138 CODE FOR DUMMY-USED FOR SPACER * MISC. STOPBIT EQU X'40000' POS.OF STOP FLAG BIT. TRACEBIT EQU X'20000' POS.OF TRACE FLAG BIT. FLINFLG EQU X'10000' FUNCTION-LINE FLAG BIT (IN S-ENTRY). DYINFLAG EQU X'200' DYADIC INTRINSIC OPERATOR FLAG (IN * O-ENTRY -- OPTYPE'S HI BYTE). PENDFLAG EQU X'8000' PENDENT FLAG BIT (IN F OR Q ENTRY). EFLAG EQU X'10000' MARKS 'EXECUTE' TYPE OF Q-ENTRY. NEWLINE EQU X'15' END-OF-INPUT CHARACTER. LBLFLAG EQU X'20000' LABEL FLAG BIT (IN SYM TBL REFERENT * INDICATOR WD). TOPRANK EQU 63 MAXIMUM POSSIBLE RANK. DYADIC EQU 80 1ST DYADIC OP CODESTRING DESIGNATION MONADIC EQU 50 1ST MON. OPER CODESTRING DESIGNATION * * DOUBLEWORD CONSTANTS * BOUND 8 DYSCLRS DATA 91,111 RANGE OF DYADIC SCALAR CODE DESIGS. MDYSCLRS DATA 91,101 MONADIC DYSCLRS. MONRANGE DATA 50,101 POSS. MONADIC OPERATOR CODE DESIGS. DYRANGE DATA 80,120 DYADIC OPERATOR CODESTR. DESIGNAT'S. REDRANGE DATA X'100'+91,X'100'+111 RANGE OF REDUCTION OP-TYPES. S2XRANGE DATA SCAN1COD,XEQCODE SCAN-THRU-EXECUTE OPERATOR RANGE. U19-0008 CATO2D DATA CATO,CATD RANGE OF CATEGORIES -- O THRU D. STMASKS DATA STOPBIT,-STOPBIT-1 FLAG & MASK FOR -- STOP VECTOR. DATA TRACEBIT,-TRACEBIT-1 -- TRACE VECTOR. * * CONSTANTS * PENTRY DATA X'5000000' PAREN-CATEGORY OF STACK ENTRY. SENTRY DATA X'6000000' STMT-CATEGORY OF STACK ENTRY. FSENTRY DATA X'6010000' FUN-STMT-CATEGORY OF STACK ENTRY. QPENTRY DATA X'7008000' QUAD-STATE CAT. OF STACK ENTRY * (PENDENT). AENTRY DATA X'9000000' ASSIGNMENT-CAT. OF STACK ENTRY (NOT * YET COMPLETED ASSIGNMENT). FPENTRY DATA X'A008000' FUNC-STATE CAT. OF STACK ENTRY * (PENDENT). PAGE ************************************************************************ * * * STACKUP -- PUSHES THE STACK UP 1 WD & VERIFIES THAT THIS IS BELOW * * THE STACK LIMIT (I.E. ROOM FOR 2 WDS IF NEEDED). * * REGS: R1 -- (ENTRY) CURRENT TOP OF STACK. * * (EXIT) NEW TOP OF STACK (UNFILLED). * * R4 -- LINK, EXIT VIA 0,R4. * * R8 IS VOLATILE. * * * STACKUP AI,R1 -1 ADD 1 WD TO EXECUTION STACK. CW,R1 STKLIMIT IS THIS STILL BELOW THE LIMIT. BG 0,R4 YES, EXIT. STW,R1 LOCNEED NO, SAVE THE LOCATION NEEDED. AI,R1 1 RESTORE STACK PTR IN CASE WS FULL. BAL,R8 CTEST TRY TO GET MORE COMMON... B CXERWS NO LUCK -- WS FULL. B 0,R4 OK, EXIT. PAGE ************************************************************************ * * * GENLIST -- GENERATES A LIST TYPE OF DATA BLOCK USING NILCK AND THE * * N V-ENTRIES CONTAINED IN THE SERIES (FOR EXAMPLE, B-ENTRY) * * AT THE TOP OF THE EXECUTION STACK. * * REGS: R11 (ENTRY) CONTAINS N. * * R13 LINK, EXIT VIA *R13. * * R4,R5,R11,R12,R14 ARE VOLATILE; SEE ALSO ALOCRS. * * R1 (EXIT) PTS AT EXECUTION STACK ENTRY AFTER THE * * N-TH V-ENTRY. * * * SPACE LOCAL GENLIST1,GENLIST2 SPACE GENLIST LI,R12 1 NOTE: ASSUME RANK OF A LIST IS 1; STW,R12 RSRANK (SEE ALSO DELTA-FMT). LI,R12 TYPELIST FOR LIST TYPE DATA BLOCK. STW,R12 RSTYPE AI,R11 2 ACCOUNT FOR NILCK AND TRACKING WD. STW,R11 RSSIZE STW,R1 TOPOSTAK SAVE STACK PTR. IN CASE WS FULL. STW,R3 OPER+1 SAVE OFFSET IN CASE WS FULL OCCURS. BAL,R14 ALOCRS ALLOCATE 'RESULT' DATA BLOCK. STW,R4 PTRITEM SAVE LOC OF DATA BLOCK AS PTR ITEM. LW,R5 RSSIZE = NO.OF DATA PTRS IN THE LIST AI,R5 -1 BUT NOT COUNTING THE TRACKING WD STW,R5 2,R4 (I.E. LENGTH OF LIST). LW,R12 NILCK GET 1ST DATA PTR (OR NIL). B GENLIST2 GENLIST1 LI,R12 0 XW,R12 0,R1 GET NEXT DATA PTR (OR NIL). GENLIST2 AI,R4 1 INCR PTR INTO THE DATA BLOCK. STW,R12 2,R4 FILL IN A DATA PTR. AI,R1 1 PT AT NEXT ENTRY IN EXECUTION STACK. BDR,R5 GENLIST1 STW,R5 3,R4 NOTE--LIST LENGTH MUST NOT START OUT ZERO; * ZERO THE TRACKING WD. B *R13 PAGE ************************************************************************ * * * NUMSV -- CHECK NUMERIC SCALAR OR VECTOR DATA BLOCK. * * REGS: R7 LINK, EXIT VIA 0,R7 FOR SCALAR OR * * 1,R7 FOR VECTOR. * * R4 (ENTRY) PTS TO DATA BLOCK HEADER. * * (EXIT) PTS AT DATA BLOCK HEADER + 3. * * R6 (EXIT) CONTAINS NUMERIC TYPE INDICATOR: * * 1 FOR LOGL * * 2 FOR INTG * * 3 FOR REAL * * 4 FOR XSEQ (INDEX SEQUENCE) * * R13 (EXIT) = 0. * * R12 (VECTOR EXIT) CONTAINS LENGTH OF VECTOR * * (SCALAR EXIT) CONTAINS 'LENGTH' = 1. * * * SPACE LOCAL NUMTCK,RNKCK SPACE NUMSV LB,R6 *R4 GET TYPE OF DATA BLOCK NUMTCK B NUMTCK,R6 @ VECTOR ON THE TYPE -- 0 IMPOSSIBLE. B RNKCK @ 1 -- LOGL (NUMERIC TYPE 1) B NUMCKNIL @ 2 -- TEXT, MAYBE EMPTY VECTOR. BDR,R6 RNKCK @ 3 -- INTG (NUMERIC TYPE 2) BDR,R6 RNKCK @ 4 -- REAL (NUMERIC TYPE 3) BDR,R6 RNKCK @ 5 -- XSEQ (NUMERIC TYPE 4) B CXERDOM @ 6 -- LIST -- DOMAIN ERROR. RNKCK LW,R13 0,R4 DATA BLOCK'S HEADER WORD. AI,R4 3 PT AT DATA BLK HDR + 3. LI,R12 1 IF SCALAR, PREPARE LENGTH = 1. AND,R13 XFF0000 CK THE RANK... BEZ 0,R7 0, TAKE SCALAR EXIT. LW,R12 -1,R4 NZ, GET LENGTH WORD. AI,R13 -X'10000' VERIFY THAT RANK = 1... BEZ 1,R7 OK, TAKE VECTOR EXIT. B CXERRANK NO -- RANK ERROR. NUMCKNIL LI,R13 -X'0201' MINUS(TYPE 2 RANK 1). AH,R13 *R4 = 0 IF TEXT VECTOR... BNEZ CXERDOM NOT VECTOR -- DOMAIN ERROR. AI,R4 3 PT AT DATA BLK HDR + 3. LW,R12 -1,R4 GET LENGTH... BEZ 1,R7 EMPTY VECTOR (ASSUME INTG) -- EXIT B CXERDOM OOPS -- DOMAIN ERROR. PAGE ************************************************************************ * * * SHADOW -- PLACES A NEW REFERENT INDICATOR IN A GIVEN SYMBOL TABLE * * ENTRY, PUSHES THE OLD REFERENT INDICATOR INTO THE EXECUTION * * STACK, AND PUSHES THE SYMBOL TABLE ENTRY OFFSET (I.E. THE * * NAME POINTER) INTO THE STACK. * * REGS: R6 -- LINK, EXIT VIA 0,R6. * * R4 -- (ENTRY) CONTAINS NEW REFERENT INDICATOR. * * R7 -- (ENTRY) CONTAINS THE NAME POINTER. * * R1 -- (ENTRY) PTS AT EXECUTION STACK LOC. * * (EXIT) PTS AT EXECUTION STACK LOC OF NAME PTR. * * R4 IS VOLATILE. * * * SHADOW XW,R4 *SYMT,R7 GET OLD, PLACE NEW REFERENT-INDIC. STW,R4 -1,R1 PUSH OLD REF-IND. STW,R7 -2,R1 PUSH NAME PTR. AI,R1 -2 UPDATE STACK PTR. B 0,R6 EXIT. PAGE ************************************************************************ * * * SUSPCLR -- ENTERED FOR SUSPENSION-CLEAR AND DIRECT INPUT REQUEST. * * * SUSPCLR LI,R3 PENDFLAG = PENDENT FLAG. LW,R4 STATEPTR PT AT TOP STATE ENTRY. SUSPCLRP LI,R5 X'7FFF' AND,R5 0,R4 EXTRACT 'NEXT' FIELD... BEZ SUSPCLRF ZERO = FINAL STATE ENTRY. AW,R4 R5 PT AT NEXT STATE ENTRY. CW,R3 0,R4 IS IT PENDENT... BANZ SUSPCLRP YES, KEEP HUNTING. SUSPCLRF STW,R4 GOSTATE PT AT STATE TO CLEAR DOWN TO AND LI,R14 INPDIR REQUEST DIRECT INPUT AFTER B SICLR% CLEARING THE STATE INDICATOR. PAGE CXBREAK BAL,R2 INTERR BRK DETECTED BY CODEXEQ. @ CXLSERR BAL,R2 INTERR @ CXERSYN BAL,R2 INTERR @ CXERUND BAL,R2 INTERR @ CXERNOR BAL,R2 INTERR @ CXERIO BAL,R2 IOERR @ CXERDOM BAL,R2 INTERR @ CXERRANK BAL,R2 INTERR @ CXERLEN BAL,R2 INTERR @ CXERWS BAL,R2 INTERR @ INTERR STW,R1 TOPOSTAK SAVE CURRENT TOP OF STACK. IOERR STW,R3 OPER+1 SAVE CURRENT BYTE OFFSET IN CODESTR. B OPBREAK-CXBREAK-1,R2 GOTO APPR. ERROR-ENTRY PT. PAGE A38 STW,R1 TOPOSTAK SAVE STACK PTR. LW,R4 1,R1 GET DATA BLK PTR (I.E. V-ENTRY). AI,R6 -QZCODE CHECK FOR QUAD-ZERO... BE QZOUTSET YES -- SET FOR GRAFIX OUTPUT. LI,R14 QOUTRET-1 NORMAL RETURN FROM OUTPUT IS QOUTRET AI,R6 QZCODE-QUADCODE NOT QUAD-ZERO, WHICH IS IT... BGEZ SINGOUT QUAD OR QUOTE-QUAD (SINGLE D.B.). AI,R6 QUADCODE-Q1CODE+1 BLIND, GET QUAD NUMBER. LI,R5 TYPETEXT CB,R5 *R4 VERIFY DATA BLK IS TEXT TYPE. BE BLINDOUT OK. B CXERDOM OOPS -- DOMAIN ERROR. QZOUTSET STW,R3 OPER+1 SAVE CS OFFSET TO THE QUAD CODE. STW,R4 RTARG SET PTR TO ARG. MTW,1 1,R4 BUMP ITS REF-COUNT. LW,R5 BREAKFLG TEST FOR BREAK... BEZ QZOUT NO -- DO GRAFIX OUTPUT. B CXBREAK YES. B CXERIO @ ERROR RETURN FOR QUAD-OUT -- I/O ERR QOUTRET LW,R1 TOPOSTAK @ RESTORE STACK PTR. LI,R2 CATAPRYM SET TOP CAT = A-PRIME. STB,R2 *R1 BDR,R3 NXTSCAN A25 AI,R6 -QUADCODE WHICH TYPE OF QUAD... BEZ A25EVAL EVALUATED-INPUT. STW,R1 TOPOSTAK (SAVE STACK PTR). BLZ A25Q BLIND OR QUAD-ZERO. B INPQQUAD QUOTE-QUAD INPUT; RESQQUAD LW,R1 TOPOSTAK RESUME AFTER QUOTE-QUAD INPUT TRY. AI,R13 0 AFTER PTING AT TOP OF STACK, CK FOR: BGZ DCSSUSP O-U-T, DROP CS & CLR SUSPENSION. BLZ CXBREAK HANGUP, BREAK CODESTR.EXECUTION. AI,R11 -1 NORMAL, DROP END-OF-INPUT CHAR. LI,R2 BA(IMAGE) PT AT IMAGE BUFFER QDB STW,R11 RSSIZE SAVE LENGTH OF INPUT. LI,R4 TYPETEXT STW,R4 RSTYPE SET FOR TEXT TYPE OF DATA BLK. LI,R4 1 ASSUME VECTOR RANK. CW,R4 RSSIZE BUT IF LENGTH IS 1, USE SCALAR RANK. BNE QDBRANK LI,R4 0 QDBRANK STW,R4 RSRANK STW,R1 TOPOSTAK SAVE STACK PTR. IN CASE WS FULL. STW,R3 OPER+1 SAVE OFFSET IN CASE WS FULL OCCURS. BAL,R14 ALOCTRES ALOC TEXT RESULT DATA BLK. LW,R11 RSSIZE STW,R11 2,R4 SET LENGTH WORD IN CASE OF VECTOR. BEZ QDBDONE 0, EMPTY VECTOR. AI,R4 3 PT AT 1ST VALUE WD FOR A VECTOR. SLS,R4 2 USE BYTE LOC. CI,R11 1 IS IT A VECTOR... BNE QDBFILL YES. AI,R4 -4 NO, BACK UP 1 WD. QDBFILL LB,R5 0,R2 STB,R5 0,R4 AI,R2 1 MOVE TEXT CHARS INTO THE DATA BLK. AI,R4 1 BDR,R11 QDBFILL QDBDONE LI,R4 0 MOVE RESULT INTO PTRITEM. XW,R4 RESULT STW,R4 PTRITEM B QRESCAN A25Q AI,R6 QUADCODE-QZCODE CHECK FOR QUAD-ZERO... BNEZ A25BLIND BLIND INPUT. STW,R3 OPER+1 QUAD-ZERO, SAVE CS OFFSET TO IT. LW,R5 BREAKFLG TEST FOR BREAK... BEZ QZIN NO -- DO GRAFIX INPUT. B CXBREAK YES. A25BLIND RES 0 R6 HAS THE QUAD NUMBER. BAL,R14 INPBLIND @ DO BLIND INPUT. B CXERIO @ ERROR RETURN -- I/O ERROR. LW,R1 TOPOSTAK @ NORMAL RETURN, RESTORE STACK PTR. LI,R2 BA(BLINBUF) PT AT BLIND INPUT BUFFER. B QDB A25EVAL LI,R13 0 (NO E-FLAG) LI,R14 INPEVAL SET TO REQUEST EVALUATED INPUT. STACKQE BAL,R4 STACKUP ADD A WD TO EXECUTION STACK. LI,R6 0 XW,R6 CURRCS MOVE CURRENT CODESTRING DATA BLK PTR STW,R6 0,R1 SLS,R3 17 AND CURRENT BYTE POSITION STS,R3 0,R1 INTO THE STACK. AI,R1 -1 PT AT WD TO RECEIVE Q-ENTRY. STW,R1 TOPOSTAK SAVE STACK PTR. XW,R1 STATEPTR UPDATE STATE PTR. SW,R1 TOPOSTAK CALC OFFSET TO NEXT STATE ENTRY. OR,R1 QPENTRY SET Q CATEGORY, PENDENT STATE. STW,R1 *TOPOSTAK STS,R13 *TOPOSTAK SET E-FLAG VALUE. B *R14 DO EVAL-INPUT OR EXECUTE-TRANSLAT'N. SORXV B CKSCANOP @ SCAN OPERATOR (ON 1ST COORD). U19-0010 B CKSCANOP @ SCAN OPERATOR. U19-0011 * B XEQCK @ EXECUTE OPERATOR. U19-0012 XEQCK LW,R4 RTARG @ U19-0013 LI,R5 1 SET FOR 1 ELEM (& FOR RANK TEST). LI,R6 NEWLINE GET END-OF-INPUT CHAR. LB,R13 *R4,R5 GET RANK... BEZ XEQCKS SCALAR AI,R13 -1 ARRAY, VERIFY VECTOR... BNEZ ERRANK OOPS -- RANK ERROR. LW,R5 2,R4 GET NO.OF ELEMS... BEZ XEQCKL NONE, JUST USE END-OF-INPUT CHAR. CI,R5 512 VERIFY NOT TOO MANY... BG ERLENGTH OOPS -- LENGTH ERROR. AI,R4 3 PT AT 1ST VALUE WD. XEQCKTYP LB,R13 *RTARG AI,R13 -TYPETEXT VERIFY TEXT VECTOR OR SCALAR... BEZ XEQCKBUF OK, START MOVING CHARS (RT TO LF). B ERDOMAIN OOPS -- DOMAIN ERROR. XEQCKS AI,R4 2 PT AT VALUE WD. B XEQCKTYP XEQCKC LB,R6 *R4,R5 GET CHAR. XEQCKBUF STB,R6 INBUF,R5 PUT CHAR IN INPUT BUFFER. BDR,R5 XEQCKC LOOP TILL REACHING LEFTMOST CHAR. LB,R6 *R4 PUT IT IN. XEQCKL STB,R6 INBUF LI,R4 0 XW,R4 RTARG DEREFERENCE RT ARG. BAL,R7 DREF LI,R4 0 XW,R4 XTEMP TEST FOR COORD TO LEFT OF XEQ-OPER. BEZ XEQCKR NO, LEAVE NIL ENTRY IN STACK. STW,R4 0,R1 YES, PUT X-ENTRY IN STACK. XEQCKR LW,R3 OFFSETR PT TO DESIGNATOR TO BE RE-SCANNED * WHEN EXECUTE IS COMPLETED. LI,R13 EFLAG SET E-FLAG. LI,R14 INPXEQ SET TO ENTER 'INPUT' TRANSLATOR FOR B STACKQE EXECUTE & STACK Q-ENTRY. REQUIN STW,R1 TOPOSTAK SAVE STACK PTR. B INPEVAL DO EVALUATED INPUT AGAIN. A6 LB,R6 *CURRCS,R3 LOOK AT ITEM BEFORE BRANCH ARROW. AI,R6 -BOSCODE SHOULD BE BEGINNING-OF-STMT CODE. BNEZ CXERSYN OOPS -- SYNTAX ERROR. AI,R3 1 OK, RESTORE PTR IN CASE OF ERROR. LW,R6 NILCK CK FOR BRANCH VALUE... BEZ DCSSUSP NONE,DROP CS & SUSPENSION-CLEAR B CXERSYN OOPS -- SYNTAX ERROR * YOU CAN'T BRANCH FROM EVAL-INPUT A9 LI,R4 0 ELIMINATE THE REFERENCE TO THE XW,R4 CURRCS CODESTRING DATA BLK THAT BROUGHT AI,R4 -2 THE EVALUATED INPUT. BAL,R7 DREF LI,R4 0 XW,R4 NILCK MOVE VALUE ACQUIRED, IF ANY... BNEZ A9VAL VALUE IS PRESENT. QETEST LI,R4 EFLAG NO VALUE, CK Q-ENTRY... CW,R4 0,R1 BAZ REQUIN EVAL-INPUT, RE-REQUEST IT. STW,R1 TOPOSTAK SAVE STACK PTR IN CASE WS FULL. XEQEMPTY LW,R1 TOPOSTAK LI,R11 4 BAL,R7 ALOCBLK ALLOCATE FOR EMPTY VECTOR. LI,R11 (TYPEINTG**8)+1 TYPE=INTG & RANK=1. STH,R11 *R4 LI,R11 0 LENGTH=0. STW,R11 2,R4 A9VAL STW,R4 PTRITEM SET PTR TO VALUE DATA BLK. LI,R4 X'7FFF' SET STATE PTR TO AIM AT NEXT STATE- AND,R4 0,R1 ENTRY IN EXECUTION STACK. AWM,R4 STATEPTR LI,R3 X'1FFFF' RESTORE CURRENT CODESTRING DATA BLK AND,R3 1,R1 PTR THAT HAD THE EVAL-INPUT QUAD. STW,R3 CURRCS LW,R3 1,R1 RESTORE THAT BYTE OFFSET. SLS,R3 -17 AI,R1 2 DROP THE Q-ENTRY FROM EXEC. STACK. LI,R11 EFLAG WAS IT EVAL-INPUT OR EXECUTE... CW,R11 -2,R1 BAZ QRESCAN EVAL-INPUT. BAL,R14 QOBS (QUERY OBSERVE SETTING) LI,R4 0 EXECUTE. XW,R4 PTRITEM MOVE VALUE PTR OUT OF PTRITEM, AND XW,R4 0,R1 REPLACE X OR NIL ENTRY... BEZ A9XEQEND NIL. AI,R1 -1 X-ENTRY (COORD FOR OPER UP NEXT) STW,R4 0,R1 PUSH IT BACK INTO STACK. A9XEQEND LB,R2 *R1 GET TOP CATEGORY (X OR V). B NXTSCAN RESCAN WHERE EXECUTE ORIGINATED. QRESCAN LI,R4 0 SET 'PTR' TYPE OF SCAN ITEM. LB,R2 *R1 GET NEW TOP CAT SURFACED. B CXPTR,R2 VECTOR ON THAT CATEGORY. A16 STD,R6 OPER SAVE OPERATOR INFORMATION. LI,R14 NXTSCAN RETURN TO RESUME SCANNING AFTER BDR,R3 MONEX MONADIC OPERATOR EXECUTION. A37 LD,R10 STMASKS-STOPNMCD-STOPNMCD,R6 SET BIT & MASK FOR * STOP OR TRACE. LI,R2 CATAPRYM CONVERT TOP CAT TO A-PRIME. STB,R2 *R1 LW,R4 1,R1 GET V-ENTRY, I.E. DATA BLK PTR. LI,R7 1 LB,R7 *R4,R7 IS ITS RANK = 2... AI,R7 -2 BNEZ A37ST NO, CK STOP OR TRACE VECTOR. AI,R10 -STOPBIT YES, CK SIDETRACK TBL. BNEZ CXERRANK OOPS -- RANK ERR (TRACE TBL). LW,R11 3,R4 GET 2ND LENGTH WD... BEZ A37ECLR ZERO, CLEAR OUT ERR-CTRL TABLE. AI,R11 -2 BNEZ A37EQ1Z NOT 0 OR 2, 1ST LENGTH WD MUST = 0 LW,R11 2,R4 TWO, GET 1ST LENGTH WD... BEZ A37ECLR ZERO, CLEAR OUT ERR-CTRL TABLE. LB,R6 *R4 NZ, GET TYPE OF DATA BLK. CI,R6 TYPEINTG BE A37EINTG INTEGER TYPE. STW,R5 FDEFPTR NON-INTG TYPE, SAVE PTR TO & MTW,1 1,R5 BUMP REF-CNT OF FUNCT.DESCRIPTOR. SLS,R11 1 = # WDS FOR INTG VERSION OF TABLE. AI,R11 4 + 2-WD HDR O 2 LENGTH WDS. BAL,R7 ALOCBLK ALLOC DATA BLK FOR INTG TYPE TABLE. STW,R4 RESULT SAVE PTR TO IT. LI,R7 (TYPEINTG**8)+2 STH,R7 *RESULT SET TYPE = INTEGER & RANK = 2. LW,R10 1,R1 GET PTR TO NON-INTG TABLE AGAIN. LI,R11 2 STW,R11 3,R4 SET 2ND LENGTH WD = 2. AI,R10 2 PT AT NON-INTG TABLE'S 1ST LENGTH WD LW,R11 *R10 AND GET THAT LENGTH IN ORDER TO STW,R11 2,R4 SET 1ST LENGTH WD OF INTG TBL. SLS,R11 1 GET # ELEMENTS FOR ERR-CTRL TBL. AI,R4 4 PT AT 1ST INTG ELEMENT POSITION. AI,R6 -TYPEREAL TEST TYPE OF NON-INTG TBL... BEZ A37EREAL REAL. AI,R6 TYPEREAL-TYPELOGL BNEZ CXERDOM ROTTEN -- DOMAIN ERR. AI,R10 1 LOGL, PT AT LAST LENGTH WD. A37ELWD LI,R13 32 32 LOGL BITS PER WD. AI,R10 1 LW,R7 *R10 GET NEXT WD OF LOGL DATA. A37ELBIT LI,R6 0 SLD,R6 1 GET NEXT LOGL VALUE -- 1 OR 0. STW,R6 0,R4 SET INTEGER VALUE. AI,R4 1 PT AT NEXT WD OF INTG DATA BLK. AI,R11 -1 IS INTG ERR-CTRL TBL READY YET... BEZ A37ERDY YES. BDR,R13 A37ELBIT NO, LOOP TILL LOGL WD EXHAUSTED B A37ELWD THEN GET ANOTHER. BULL-POOP. A37EREAL AI,R10 2 PT AT NEXT REAL VALUE. LD,R6 *R10 GEDDIT. BAL,R5 F2I @ CONVERT FL.PT VALUE TO INTEGER... B CXERDOM @ WON'T -- DOMAIN ERR. STW,R7 0,R4 @ OK, SET INTEGER VALUE. AI,R4 1 PT AT NEXT WD OF INTG DATA BLK. BDR,R11 A37EREAL LOOP TILL INTG ERR-CTRL TBL READY. A37ERDY LI,R5 0 REMOVE REF TO FUNCTION DESCRIPTOR & XW,R5 FDEFPTR SET R5 TO PT AT IT AGAIN. MTW,-1 1,R5 LI,R4 0 MOVE PTR TO INTG ERR-CTRL TABLE XW,R4 RESULT INTO R4. B A37ESET A37EINTG MTW,1 1,R4 BUMP REF-CNT OF ERR-CTRL TBL. A37ESET XW,R4 XSIZOFF,R5 INSTALL PTR TO ERR-CTRL IN XSIZE WD. LI,R7 X'E0000' DID THE ERR-CTRL FUNCTION HAVE AN AND,R7 R4 OLD ERR-CTRL TABLE... BEZ A37ENEW NO. STS,R7 XSIZOFF,R5 YES, SET XSIZE VALUE BACK IN. A37EOLD LI,R7 NXTSCANU RESUME CODESTRING SCAN AFTER B DREF DEREFERENCING OLD ERR-CTRL TBL. A37ENEW LW,R7 R4 GET XSIZE VALUE. SLS,R7 17 MOVE IT UP ABOVE ADDR.FIELD. STS,R7 XSIZOFF,R5 SET XSIZE VALUE BACK IN THERE. BDR,R3 NXTSCAN RESUME CODESTRING SCAN. A37EQ1Z LW,R11 2,R4 IS 1ST LENGTH WD ZERO... BNEZ CXERLEN NO, 2ND LENGTH WD BAD -- LENGTHERR A37ECLR LW,R4 XSIZOFF,R5 GET OLD XSIZE WD FOR FUN.DESCRIPTOR. CI,R4 X'E0000' CK FOR PTR TO ERR-CTRL TBL... BAZ NXTSCANU NO (ALREADY CLEARED) RESUME SCAN. SLS,R4 -17 YES,GET XSIZE VALUE ONLY. XW,R4 XSIZOFF,R5 REPLACE OLD XSIZE WD & B A37EOLD DEREF OLD ERR-CTRL TBL. A37ST BAL,R7 NUMSV @ CK NUMERIC SCALAR OR VECTOR... AI,R4 -1 @ SCALAR, PT AT HEADER + 2. * @ VECTOR. A37CLR STW,R10 STSET SAVE STOP OR TRACE FLAG SETTING. LI,R10 X'10000' IS THIS A LOCKED FUNCTION... CW,R10 0,R5 BANZ NXTSCANU YES, RESUME SCAN. LI,R10 0 CLEAR FOR SELECTIVE LOADS, BELOW. LW,R13 NFLOFF,R5 NO.OF FUN LINE PTRS; R5 = FUNDEF PTR BEZ NXTSCANU NO LINES, RESUME SCAN. STW,R13 NFL4ST SAVE IT FOR STOP OR TRACE BOUND CK. AI,R5 LINSTART-1 PT JUST BEFORE LINE 1 AND STW,R5 FDLPTR SAVE THAT LOC. AI,R5 1 PT AT LINE 1. A37CLREM LS,R10 0,R5 CLEAR OLD STOP OR ELSE TRACE STW,R10 0,R5 FLAGS. AI,R5 1 BDR,R13 A37CLREM AI,R12 0 TEST FOR EMPTY VECTOR. BEZ NXTSCANU YES, RESUME SCAN. LW,R10 STSET NO, GET STOP OR ELSE TRACE FLAG. A37VT B A37VT,R6 @ VECTOR ON NUMERIC TYPE: B A37LOGL @ 1 -- LOGL B A37INTG @ 2 -- INTG B A37REAL @ 3 -- REAL * B A37XSEQ @ 4 -- INDEX SEQUENCE A37XSEQ LI,R7 A37X @ SET RETURN TO A37X, SEE ALSO A37DECR STW,R7 RSTYPE LW,R6 0,R4 GET INDEX PARAMETERS LW,R7 1,R4 AND STD,R6 XPARAMS SAVE THEM. LI,R4 1 START INDEX SEQUENCE A37X LW,R7 R4 MW,R7 XMULT CALCULATE CORRESPONDING VALUE. AW,R7 XADD B A37Z CK VALUE AS A LINE NO. A37REAL LI,R7 A37R SET RETURN TO A37R, SEE ALSO A37DECR STW,R7 RSTYPE AI,R4 1 PT AT 1ST DBLWD (ODD OR EVEN IS OK). SLS,R4 -1 = DBLWD LOC OF 1ST VALUE. A37R LD,R6 0,R4 GET REAL VALUE FOR CONVERSION. BAL,R5 F2I CONVERT FLOATING TO INTEGER... B CXERDOM NO -- DOMAIN ERROR. B A37Z YES, CHECK LINE NO. A37INTG LI,R7 A37I SET RETURN TO A37I, SEE ALSO A37DECR STW,R7 RSTYPE A37I LW,R7 0,R4 GET INTEGER VALUE. A37Z BLEZ A37DECR NEG OR ZERO IS IGNORED, AND SO ARE CW,R7 NFL4ST BG A37DECR VALUES ABOVE LAST LINE NO. AWM,R10 *FDLPTR,R7 OK, SET THAT FLAG BIT. A37DECR AI,R4 1 PT AT NEXT VALUE. BDR,R12 *RSTYPE LOOP BACK ACCORDING TO TYPE OF DATA. BDR,R3 NXTSCAN RESUME SCAN. A37LOGL AWM,R6 FDLPTR PTS AT LINE 1'S ENTRY NOW. A37WD LI,R5 32 32 BITS PER WORD. LW,R13 0,R4 GET LOGICAL VALUE(S). BGEZ A37LDECR 1ST BIT NOT A 1. A37L1 AWM,R10 *FDLPTR SET STOP OR TRACE FLAG FOR LINE 1. BDR,R3 NXTSCAN RESUME SCAN. A37SHIFT SLS,R13 1 TEST NEXT BIT... BOV A37L1 1, LINE 1 IS TO BE FLAGGED. A37LDECR AI,R12 -1 DECR ELEMENT COUNT... BEZ NXTSCANU 0, RESUME SCAN; NO TRACE OR STOP. BDR,R5 A37SHIFT DECR BIT COUNT... AI,R4 1 0, USE NEXT DATA WORD. B A37WD A8 LI,R7 A8SHOW RETURN FROM 'STMTV' TO 'A8SHOW' STMTV LI,R5 0 MOVE NILCK INTO R5. XW,R5 NILCK BEZ 0,R7 EXIT IF NIL. LW,R12 ACFLAG NON-NIL (V-ENTRY), IF AN ASSIGNMENT BEZ STMTADD WASN'T JUST COMPLETED PUT V IN * THE S-ENTRY. STMTTRCK LW,R12 OBSERVE DID WE OBSERVE... BNEZ STMTDREF YES, SKIP TRACE CHECK. LI,R12 TRACEBIT IS THIS STMT BEING TRACED... CW,R12 0,R1 BANZ STMTADD YES, PUT V-ENTRY IN THE S-ENTRY. STMTDREF LW,R4 R5 NO, PT AT V-ENTRY'S DATA BLK. B DREF DEREFERENCE IT (DREF EXITS 'STMTV' * SINCE DREF ALSO USES R7 AS LINK). STMTADD XW,R5 0,R1 POP S-ENTRY AND PUSH V-ENTRY. AI,R5 1 INCR S-ENTRY'S COUNT. BAL,R4 STACKUP ALLOC 1 MORE WD FOR EXEC. STACK. STW,R5 0,R1 PUSH NEW S-ENTRY CATEGORY WD. B 0,R7 EXIT. A8SHOW LI,R6 A8WRAPCS RETURN FROM 'STMTSHOW' TO 'A8WRAPCS' STMTSHOW LI,R13 X'FFFF' TEST S-ENTRY'S COUNT. AND,R13 0,R1 BEZ NOSHOW ZERO, NO STMT DISPLAY, NO DEREF-ING. LW,R4 OBSERVE DID WE OBSERVE THIS LINE... BEZ STMTSHOM NO. CI,R13 1 YES, SINGLE VALUE... BE DONTSHOW YEP, ITS BEEN SHOWN ALREADY. STMTSHOM STW,R1 TOPOSTAK SAVE STACK PTR. LI,R3 0 PRESET COLUMN INDICATOR. LI,R12 TRACEBIT IS THIS A TRACED LINE... CW,R12 0,R1 BAZ SHOWEM NO. AI,R4 0 YES, BUT WAS IT OBSERVED... BNEZ SHOWEM YEP, JUST SHOW MIXED OUTPUT. STW,R6 LINKT SAVE LINK. LW,R1 STATEPTR YES, PT AT ITS F-ENTRY. BAL,R14 FUNLDISP DISPLAY FUNC.NAME & LINE NUMBER. LW,R6 LINKT RESTORE LINK. LW,R1 TOPOSTAK PT AT THE S-ENTRY AND INT,R13 0,R1 GET ITS COUNT AGAIN. SHOWEM BAL,R14 MIXEDOUT @ STMT DISPLAY (MIXED OUTPUT). B CXERIO @ ERR RETURN -- I/O ERROR. LW,R1 TOPOSTAK @ OK RETURN, RESTORE STACK PTR. DONTSHOW LW,R12 0,R1 SAVE S-ENTRY CATEGORY WORD. AI,R1 1 PT AT 1ST V-ENTRY UNDER S-ENTRY. SENTDREF LI,R4 0 MOVE V-ENTRY'S XW,R4 0,R1 DATA BLK PTR INTO R4. BAL,R7 DREF DEREFERENCE. AI,R1 1 PT AT NEXT WD IN EXECUTION STACK. BDR,R13 SENTDREF B 0,R6 EXIT, R1 PTS AT F-ENTRY. NOSHOW LW,R12 0,R1 SAVE S-ENTRY. AI,R1 1 PT AT F-ENTRY. B 0,R6 EXIT. A8WRAPCS LI,R6 SCANBOS SCAN ITEM WAS BEGINNING-OF-STMT. WRAPCS LI,R4 0 MOVE CODESTRING DATA BLK PTR XW,R4 CURRCS INTO R4. AI,R4 -2 PT AT ITS HEADER. BAL,R7 DREF DEREFERENCE. AI,R6 -SCANBOS WHICH SCAN ITEM... BEZ NONBRN BEGINNING OF STMT. LI,R7 X'FFFF' BRANCH ARROW. AND,R7 0,R1 IS F-ENTRY THE FINAL ENTRY... BNEZ LOBRNCK NO, FUNCTION-STATE. CXTHRU STW,R1 TOPOSTAK SAVE STACK PTR. B INPDIR GO TO DIRECT INPUT HANDLER. LOBRNCK LW,R7 BRNVAL GET BRANCH VALUE-- BGZ GFL ABOVE ZERO, TRY TO GET FUNC LINE. B FEXIT TOO LOW, EXIT THE FUNCTION. NONBRN CI,R12 FLINFLG WAS STMT A FUNC LINE... BANZ NXTFLIN YES, TRY TO GET NEXT FUNC LINE. B CXTHRU NO. NXTFLIN LW,R7 1,R1 GET CURRENT LINE NO. SLS,R7 -17 AI,R7 1 INCR IT. GFL LI,R6 0 MOVE CURRLINO AND FDEFPTR INTO R6... XW,R6 1,R1 BNEZ GF NZ, WE'VE GOT A GOOD F-ENTRY. B SUSPCLR 0, NO GOOD (I.E. SI DAMAGE). GF CW,R7 NFLOFF,R6 DOES LINE NO. EXCEED HIGHEST ONE... BLE FLINE NO, WE'VE GOT A FUNC. LINE. B FXRES YES, START EXIT FROM FUNCTION. FEXIT LI,R6 0 MOVE CURRLINO AND FDEFPTR INTO R6... XW,R6 1,R1 BEZ SUSPCLR 0 IF F-ENTRY HAS HAD SI DAMAGE. FXRES LW,R5 RESOFF,R6 GET NAME PTR FOR RESULT. BLZ FXCALL (NONE, LEAVE PTRITEM = ZERO.) LI,R3 X'1FFFF' AND,R3 *SYMT,R5 EXTRACT REFERENT (DBPTR OR NIL). STW,R3 PTRITEM BEZ FXCALL (NIL) MTW,1 1,R3 IF DBPTR, INCR DATA BLK REF COUNT. FXCALL LI,R3 X'1FFFF' EXTRACT CALLPTR FROM F-ENTRY AND AND,R3 2,R1 RESTORE CURRCS TO PT AT THE OLD STW,R3 CURRCS CODESTRING DATA BLK (+2). LI,R3 0 CLEARING EXTRA REF, GET CALLBYTE-- XW,R3 2,R1 RESTORING R3 TO THE BYTE OFFSET SLS,R3 -17 EXISTING WHEN THE CALL OCCURRED. LI,R14 X'7FFF' EXTR OFFSET TO NEXT STATE-ENTRY AND,R14 0,R1 AND SET STATE POINTER TO PT AT AWM,R14 STATEPTR THAT ENTRY AGAIN. LW,R14 OBSFLAG IS OBSERVE-CMD IN EFFECT... BEZ FXDEREFF NO. LW,R4 STATEPTR YES, PT AT CALLING STATE ENTRY. LI,R2 CATF FXFINDF CB,R2 *R4 LOOK FOR AN F-STATE... BE FXF OK. LI,R5 X'7FFF' NOPE, TRY NEXT. AND,R5 0,R4 AW,R4 R5 B FXFINDF FXF LI,R5 PENDFLAG PENDENT OR SUSPENDED... CW,R5 0,R4 BAZ FXOBSERV SUSPENDED -- OBSERVE DIRECT LINE. LI,R5 TRACEBIT PENDENT. CW,R5 -1,R4 WAS THIS A TRACED LINE... BANZ FXOBSERV YES -- OBSERVE TRACED FUN.LINE. LI,R14 0 NO, DON'T OBSERVE THIS LINE. FXOBSERV STW,R14 OBSERVE OBSERVATION SETTING. FXDEREFF MTW,-1 1,R6 DECR REF-COUNT OF FUNDEF DATA BLK. AI,R1 4 POP DOWN TO WD FOLLOWING THE COUNT-- LW,R14 -1,R1 NO.OF SHADOW PAIRS. BEZ FPOPPED NONE, F-ENTRY IS POPPED. LI,R7 FUND RETURN FROM 'DREF' TO 'FUND'. FUNSHAD LW,R5 0,R1 GET SHADOWED NAME PTR. LI,R4 0 XW,R4 1,R1 GET SHADOWED REFERENT INDICATOR. AI,R1 2 POP THAT SHADOW PAIR. XW,R4 *SYMT,R5 UNSHADOW. AND,R4 X1FFFF EXTR. DBPTR (IF ANY) FOR LOCAL. BNEZ DREF DEREFERENCE DBPTR (REMOVES LOCAL). FUND BDR,R14 FUNSHAD FPOPPED LI,R4 0 CLAIM CURRENT SCAN ITEM = PTR LB,R2 *R1 SET TOP CAT FOR ENTRY SURFACED. LW,R14 PTRITEM TEST FOR FUNCTION RESULT... BNEZ CXPTR,R2 YES, DO CONTEXT ANALYSIS FOR IT. B NORESULT,R2 NO, VECTOR ON THE TOP CAT. LOOKY LB,R6 *CURRCS,R3 CK ITEM TO LEFT OF FUNCTION CALL... CI,R6 BOSCODE BE CXBOS BEGINNING OF STMT, OK. CI,R6 SEMICODE BE CXSEMI SEMICOLON, OK (EMPTY SUBSTMT VALUE). CI,R6 DUMMYCD CHECK FOR DUMMY CODE BNE CXERNOR NO RESULT-ERROR BDR,R3 LOOKY SKIP DUMMY AND KEEP LOOKING NORESULT B CXERNOR @ V B NXTSCANU @ A-PRIME (JUST RETURNED FROM A CATCH) B CXERNOR @ O B CXERNOR @ X B CXERNOR @ B B CXERNOR @ P BDR,R3 LOOKY @ S -- LOOK AHEAD FOR BOS OR SEMI. BDR,R3 LOOKY @ Q -- LOOK AHEAD FOR BOS (SEMI FAILS) B CXERNOR @ D * B CXERNOR @ A (CAN'T GET HERE FROM THERE) * * NOTE-- R12 CONTAINS A FLAG-BIT (FLINFLG) = 1 IF FLINE IS REACHED VIA * A STMT WITHIN THE FUNCTION OR VIA INVOKING THE FUNCTION. * IT IS 0 IF FLINE IS REACHED VIA A DIRECT BRANCH STMT. * FLINE SLS,R6 -1 (FDEFPTR IS EVEN, SO THIS IS OK). STH,R7 R6 PUT NEW LINE NO. IN PLACE OF CURRENT SLS,R6 1 LINE NO. AND PUT THE NEW STW,R6 1,R1 'CURRLINO,FDEFPTR' WD IN F-ENTRY. FLINE1 AW,R7 R6 GET THAT LINE PTR ENTRY FROM THE LW,R7 LINSTART-1,R7 FUNCTION DESCRIPTOR. CI,R7 STOPBIT IS ITS STOP FLAG SET... BAZ FGO NO. CI,R12 FLINFLG YES, OVERRIDE THE STOP... BAZ FGO YEP, DIRECT BRANCH DOESN'T STOP. LI,R5 -PENDFLAG-1 NOPE, GET 1'S COMPLEMENT OF THE AND,R5 0,R1 PENDENT FLAG-- I.E. TO MAKE THIS STW,R5 0,R1 F-ENTRY A STOPPED FUNCTION. STW,R1 TOPOSTAK SAVE STACK PTR. B SHOWSTOP DISPLAY THE STOP, R1 PTS AT F-ENTRY. FGO LI,R13 PENDFLAG SET F-ENTRY TO BE PENDENT. STS,R13 0,R1 LI,R2 0 SET FOR NO OBSERVATION. LI,R12 TRACEBIT EXTRACT TRACE FLAG FROM LINE PTR AND,R12 R7 ENTRY... BEZ FLSETOBS O--NO OBSERVATION OF THIS LINE. LW,R2 OBSFLAG NZ--USE OBSERVE-CMD SETTING. FLSETOBS STW,R2 OBSERVE =0 IF NO OBSERVATION & =-1 IF YES. OR,R12 FSENTRY COMPOSE S-ENTRY FOR FUN.LINE (CNT=0) STW,R12 -1,R1 PUT S-ENTRY ABOVE F-ENTRY IN STACK. AND,R7 X1FFFF EXTR. PTR TO CODESTRING DATA BLK +2. STW,R7 CURRCS THAT IS LOC OF CURRENT CODESTR. NOW. MTW,1 -1,R7 INCR REF-COUNT OF CODESTRING DATA BK LH,R3 *CURRCS GET OFFSET TO RTMOST CODE DESIGNATOR LI,R2 CATS TOP CAT IS AN S-ENTRY. AI,R1 -1 SET STACK PTR TO AIM AT NEW S-ENTRY LW,R6 BREAKFLG TEST FOR BREAK... BEZ NXTSCAN NO -- START SCANNING. B CXBREAK YES -- BREAK OR HANG-UP. A5 LB,R4 *CURRCS,R3 GET ITEM TO LEFT OF BRANCH ARROW... AI,R4 -BOSCODE BEZ A5NILCK BEGINNING OF STMT, OK. AI,R4 BOSCODE-SEMICODE BEZ A5NILCK SEMICOLON, OK. B CXERSYN ELSE -- SYNTAX ERROR. A5NILCK AI,R3 1 BACK TO BRANCH ARROW IN CASE ERROR. LW,R4 NILCK TEST NILCK... BNEZ A5C23 NON-NIL, A5 CASE 2 OR 3. BAL,R6 STMTSHOW IF NEC. DISPLAY STMT VALUES, POP THE * S-ENTRY, AND DEREFERENCE VALUES. DCSSUSP LI,R4 0 XW,R4 CURRCS DEREFERENCE CURRENT CODESTRING D.B. AI,R4 -2 LI,R7 SUSPCLR AND THEN DO SUSPENSION-CLEAR. B DREF A5C23 BAL,R7 NUMSV @ CK NUMERIC SCALAR OR VECTOR... BDR,R4 A5C3 @ SCALAR -- DEFINITELY NON-EMPTY. AI,R12 0 @ VECTOR -- EMPTY... BEZ A5C2 YES. A5C3 LI,R5 A5BSET-1 NO, SET LINK TO IVAL SO THAT * NON-INTEGER EXIT WILL GIVE ERROR * AND INTEGER EXIT WILL BE TO A5BSET IVAL B IVAL,R6 @ VECTOR ON NUMERIC TYPE: B ILOGL @ 1 -- LOGL B IINTG @ 2 -- INTG B IREAL @ 3 -- REAL * B IXSEQ @ 4 -- XSEQ (INDEX SEQUENCE) IXSEQ LW,R7 0,R4 @ JUST ADD THE 2 PARAMETERS. AW,R7 1,R4 B 1,R5 INTEGER EXIT. IREAL AI,R4 1 PT AT VALUE WD (EVEN OR ODD WD OK). SLS,R4 -1 PT AT VALUE DBLWD. LD,R6 0,R4 GET VALUE FOR FLOAT-TO-INTG CONV., B F2I IF NON-INTEGER, F2I EXITS 0,R5 * IF INTEGER (WITHIN FUZZ) EXIT 1,R5 ILOGL LI,R7 0 ASSUME VALUE IS 0. LW,R6 0,R4 GET LOGICAL. BGEZ 1,R5 IT IS 0, INTEGER EXIT. LI,R7 1 B 1,R5 NO, USE 1, INTEGER EXIT. IINTG LW,R7 0,R4 GET INTEGER B 1,R5 INTEGER EXIT. B CXERDOM @ NON-INTEGER BRANCH -- DOMAIN ERROR. A5BSET STW,R7 BRNVAL @ SAVE BRANCH VALUE. LI,R5 0 XW,R5 NILCK MOVE NILCK INTO R5. BAL,R7 STMTTRCK HANDLE TRACE CHECK. LI,R6 WRAPCS RETURN TO CODESTRING WRAP-UP FROM B STMTSHOW STMT DISPLAY AND DEREFER-- * NOTE THAT R6 WILL NOT = SCANBOS. A5C2 LI,R4 0 XW,R4 NILCK MOVE NILCK INTO R4. LI,R7 NXTSCAN RESUME SCAN AFTER BDR,R3 DREF DEREFING THE EMPTY VECTOR. A31 B A31VORP,R4 VECTOR ON SCANITEM VN OR PTR: A31VORP B A31NILCK @ 0 -- PTR. * B A31VN @ 1 -- VN. A31VN AND,R5 X1FFFF @ EXTR. DATA BLK PTR FROM REF-IND. WD. STW,R5 PTRITEM MTW,1 1,R5 INCR REF COUNT OF THAT DATA BLOCK. A31NILCK BAL,R14 QNILCK QUERY SUBSCRIPTING. DYFUN LW,R5 0,R1 PULL D-ENTRY. USE A30 TO DROP IT * FROM THE EXECUTION STACK. MTW,-1 1,R5 DEREFERENCE IT TEMPORARILY. A30 AI,R1 1 DROP A-PRIME (OR D) ENTRY. A29 LW,R7 0,R1 PULL V-ENTRY. STW,R7 RTARG SAVE AS RIGHT ARGUMENT. AI,R1 1 DROP V-ENTRY FROM EXECUTION STACK. A26 AND,R5 X1FFFF EXTR. FUNDEF PTR FROM REF-IND. WD * OR FROM PULLED D-ENTRY. MTW,1 1,R5 INCR REF COUNT OF FUNDEF DATA BLK. STW,R5 FDEFPTR LW,R8 XSIZOFF,R5 GET XSIZE WD. CI,R8 X'E0000' DOES IT CONTAIN AN ERR-CTRL TBL PTR BAZ FXSIZE NO. SLS,R8 -17 YES, SHIFT XSIZE DOWN. FXSIZE STW,R8 XSIZE SAVE EXEC.STACK SIZE FOR FUN.CALL. SW,R1 XSIZE ALLOC EXEC.STACK SPACE FOR F-ENTRY. CW,R1 STKLIMIT DOES IT FIT... BG FBUILD YES, BUILD F-ENTRY. STW,R1 LOCNEED SAVE LOC NEEDED. AW,R1 XSIZE RESTORE STACK PTR IN CASE WS FULL. BAL,R8 CTEST GET ENUF MORE COMMON, IF POSSIBLE. B CXERWS WS FULL. FBUILD LW,R5 FDEFPTR PT AT FUNCTION DESCRIPTOR DATA BLK. AW,R1 XSIZE RESTORE STACK POINTER (BEFORE THE STW,R1 TOPOSTAK F-ENTRY) AND SAVE THAT LOC. LW,R7 RESOFF,R5 GET RESULT NAME POINTER... BLZ FLF NO RESULT. LI,R4 0 RESULT, USE NO REFERENT. BAL,R6 SHADOW FLF LW,R7 LFOFF,R5 GET LF DUMMY NAME POINTER... BLZ FRT NO LF DUMMY. LI,R4 0 LF DUMMY, USE AS REFERENT XW,R4 LFARG THE LEFT ARGUMENT. BAL,R6 SHADOW FRT LW,R7 RTOFF,R5 GET RT DUMMY NAME POINTER... BLZ FNFL NO RT DUMMY. LI,R4 0 RT DUMMY, USE AS REFERENT XW,R4 RTARG THE RIGHT ARGUMENT. BAL,R6 SHADOW FNFL AW,R5 NFLOFF,R5 PT AT THE FUNDEF WORD THAT FOLLOWS AI,R5 LINSTART+1 THE 'LOCALS AND LABELS' WORD. LW,R8 -1,R5 GET LOCALS AND LABELS COUNTS. BEZ FNSHAD NO LOCALS OR LABELS. LI,R9 X'FFFF' AND,R9 -1,R5 GET NO.OF LABELS. BEZ FLCLS NONE, TRY LOCALS. LI,R6 FLBL RETURN FROM 'SHADOW' TO 'FLBL'. FLBL AI,R5 2 PT AT WD AFTER SHADOW PAIR. LW,R7 -2,R5 GET NAME POINTER LW,R4 -1,R5 GET REFERENT INDICATOR FOR LABEL. MTW,1 1,R4 INCR REF COUNT OF LABEL'S DATA BLK. BDR,R9 SHADOW BAL,R6 SHADOW SHADOW LAST LABEL FLCLS LH,R9 R8 GET NO.OF LOCALS. BEZ FNSHAD NO LOCALS. LI,R6 FLCL RETURN FROM 'SHADOW' TO 'FLCL'. AI,R9 1 FAKE AN EXTRA LOCAL FOR LOOPING. SLS,R5 1 USE HALFWORD RESOLUTION. FLCL LI,R4 0 NO REFERENT FOR LOCAL SHADOWING. LH,R7 0,R5 GET LOCAL NAME PTR (EXCEPT LAST TRY) AI,R5 1 PT AT NEXT HALFWORD. BDR,R9 SHADOW FNSHAD LW,R13 TOPOSTAK CALC. NO.OF SHADOW WORDS IN STACK. SW,R13 R1 SLS,R13 -1 USE NO.OF SHADOW PAIRS. STW,R13 -1,R1 PUT IT IN STACK. SLS,R3 17 MOVE CALLBYTE TO PROPER FIELD. STS,R3 CURRCS OR IT INTO CALLPTR WORD. LI,R13 0 XW,R13 CURRCS MOVE CALLBYTE--CALLPTR STW,R13 -2,R1 INTO THE STACK. LI,R6 0 XW,R6 FDEFPTR MOVE FDEFPTR AI,R6 X'20000' AND CURRLINO (=1) STW,R6 -3,R1 INTO THE STACK. AI,R1 -4 PT AT TOP OF F-ENTRY. STW,R1 TOPOSTAK SAVE IT. LW,R13 STATEPTR GET OLD STATE PTR. SW,R13 TOPOSTAK CALC. OFFSET FROM F-ENTRY TO NEXT * STATE-ENTRY. OR,R13 FPENTRY FUNCTION-STATE CATEGORY, PENDING. STW,R13 0,R1 SET F-ENTRY. STW,R1 STATEPTR UPDATE STATE PTR TO NEW F-ENTRY. LI,R12 FLINFLG FAKE S-ENTRY SO STOP ON 1 WILL WORK. LI,R7 1 SET LINE NO. = 1. LW,R13 NFLOFF,R6 GET NO.OF FUNC LINES... BGZ FLINE1 OK, GET LINE 1. STW,R13 PTRITEM ZERO, SET PTRITEM NIL. B FXCALL EXIT THIS FUNCTION CALL. A14 INT,R11 0,R1 EXTR COUNT FROM THE B-ENTRY. BAL,R13 GENLIST GENERATE THE LIST DATA BLOCK. LI,R2 CATX SET X CATEGORY. STB,R2 PTRITEM LI,R12 0 STW,R12 NILCK ELIMINATE EXTRA REFS STW,R12 RESULT AI,R3 -1 SET TO RESUME CODESTRING SCAN. CXPUSHDP CW,R1 STKLIMIT IS THERE ROOM FOR 1 MORE WD... BG CXPUSHIT YES. STW,R1 LOCNEED NO, SAVE LOC NEEDED (ABOVE LIMIT). BAL,R8 CTEST GET MORE COMMON, IF POSSIBLE. B CXERWS WS FULL. CXPUSHIT XW,R12 PTRITEM CLEAR & GET DB PTR & ITS CATEGORY. STW,R12 -1,R1 STACK IT. BDR,R1 NXTSCAN FIX STACK PTR & GO SCAN. A15 LW,R12 NILCK GET V-ENTRY... BNEZ A15OK OK. B CXERSYN NIL -- SYNTAX ERROR. A15OK LI,R11 X'FFFF' EXTRACT THE COUNT FIELD OF AND,R11 0,R1 THE P-ENTRY. BEZ A15ONE IF 0, USE ONE VALUE PTR (IN NILCK). LI,R13 A15LIST NZ, USE LIST DATA BLOCK PTR. B GENLIST GENERATE THE LIST DATA BLOCK. A15ONE STW,R12 PTRITEM SET PTR ITEM. AI,R1 1 PT AT ENTRY IN EXEC. STACK AFTER P. A15LIST LB,R2 *R1 GET NEW TOP-OF-STACK CATEGORY. A15PAREN BAL,R6 CXPVSET SET UP AND RESCAN FOR PTR ITEM. CXDOT CI,R2 CATO TOP CAT AN O... BNE CXERSYN NO -- SYNTAX ERROR. INT,R13 0,R1 YES, EXTRACT OPTYPE FROM O ENTRY. CLM,R13 DYSCLRS IS IT ONE DYADIC SCALAR... BCS,9 CXERSYN NO -- SYNTAX ERROR. AI,R3 -1 YES -- BACK UP TO NEXT SCAN ITEM. LB,R6 *CURRCS,R3 GET IT. CLM,R6 DYSCLRS IS IT A DYADIC SCALAR... BCR,9 A21 YES, ENTER ACTION ROUTINE. CI,R6 SMOCODE NO, IS IT A SMALL CIRCLE... BNE CXERSYN NO -- SYNTAX ERROR. A21 SLS,R6 8 OK, PUT IT IN UPPER BYTE OF AWM,R6 0,R1 OPTYPE FIELD OF THE O ENTRY. BDR,R3 NXTSCAN RESUME CODESTRING SCAN. CXAP B A4 BRN -- A-PRIME ENTRY @ B A10 BOS -- A-PRIME ENTRY @ B A4 LP -- A-PRIME ENTRY @ B A4 LB -- A-PRIME ENTRY @ * B A10 SEMI-- A-PRIME ENTRY @ A10 STW,R4 ACFLAG SET ACFLAG NON-NIL. @ A4 AI,R1 1 DROP A-PRIME ENTRY. A3 LI,R12 0 XW,R12 0,R1 PICK OUT THE V-ENTRY AND STW,R12 NILCK PUT IT IN NILCK. AI,R1 1 DROP IT FROM THE EXECUTION STACK. LB,R2 *R1 GET SURFACED CATEGORY, I.E. TOP CAT. B ZRESCAN,R2 RESCAN FOR TERMINATOR CLASS ITEM. CXBE B CXERSYN BRN -- B ENTRY @ B CXERSYN BOS -- B ENTRY @ B CXERSYN LP -- B ENTRY @ B A14 LB -- B ENTRY @ * B A11 SEMI-- B ENTRY @ A11 LW,R12 NILCK GET V ENTRY OR NIL @ CXPLENT XW,R12 0,R1 EXCHANGE (I.E. POP,SAVE, AND PUSH) LI,R13 0 STW,R13 NILCK ELIMINATE ANY EXTRA REF TO NEW V. AI,R12 1 INCR COUNT. AI,R3 -1 SET TO RESUME CODESTRING SCAN. CXPUSHC CW,R1 STKLIMIT IS THERE ROOM FOR 1 MORE WD... BG CXPUSHOK YES. STW,R1 LOCNEED NO, SAVE LOC NEEDED (ABOVE LIMIT). BAL,R8 CTEST GET MORE COMMON, IF POSSIBLE. B CXERWS WS FULL. CXPUSHOK STW,R12 -1,R1 STACK THE WD. BDR,R1 NXTSCAN FIX STACK PTR & GO SCAN. CXPE B CXERSYN BRN -- P ENTRY @ B CXERSYN BOS -- P ENTRY @ B A15 LP -- P ENTRY @ B CXERSYN LB -- P ENTRY @ * B A12 SEMI-- P ENTRY @ A12 LW,R12 NILCK GET V ENTRY... @ BNEZ CXPLENT YES, PUSH LIST ENTRY. B CXERSYN NO -- SYNTAX ERROR. CXSE BDR,R3 A5 BRN -- S ENTRY (LOOK AHEAD NEXT) @ B A8 BOS -- S ENTRY @ B CXERSYN LP -- S ENTRY @ B CXERSYN LB -- S ENTRY @ * B A13 SEMI-- S ENTRY @ A13 LI,R7 NXTSCAN RESUME SCANNING AFTER @ BDR,R3 STMTV HANDLING THE SUBSTMT VALUE. CXQE BDR,R3 A6 BRN -- Q ENTRY (LOOK AHEAD NEXT) @ B A9 BOS -- Q ENTRY @ B CXERSYN LP -- Q ENTRY @ B CXERSYN LB -- Q ENTRY @ B CXERSYN SEMI-- Q ENTRY @ A17 EQU CXOPAP A20 EQU CXOPAP CXOPAP AI,R1 1 DROP A-PRIME ENTRY. B CXOPVE-SCANOPM,R4 VECTOR ON SCAN ITEM. CXOPVE B A16 ENTER ACTION ROUTINE. @ A19 BAL,R4 STACKUP ADD 1 WD TO EXEC. STACK. @ STW,R7 0,R1 PUT 2ND OPER WD. OR,R6 OENTRY SET O-ENTRY CATEGORY. STW,R6 -1,R1 PUT 1ST (CATEGORY) OPER WD. LI,R2 CATO SET TOP CAT. AI,R1 -1 PT AT NEW TOP-O-STACK. BDR,R3 NXTSCAN RESUME SCAN. CXOPV B CXOPVE-SCANOPM,R4 V VECTOR ON SCAN ITEM. @ B CXOPAP A-PRIME @ B A7 O @ B A18,R5 X VECTOR ON COORD ALLOWANCE.@ B CXERSYN B @ B CXERSYN P @ B CXERSYN S @ B CXERSYN Q @ B CXERSYN D @ B CXERSYN A @ * NOTE -- A18 MUST BE LOCATED 1 WD AFTER A 'B CXERSYN', COORD DISALLOWD A18 STD,R6 OPERHOLD HOLD CURRENT OPERATOR INFO. @ LB,R6 OPERHOLD+1 DOES IT ALREADY HAVE A COORDINATE... BNEZ CXERSYN YES -- SYNTAX ERROR. STW,R4 SCANTEMP OK, SAVE SCANOPM OR SCANOP. LI,R4 0 XW,R4 0,R1 SAVE THE X-ENTRY. STW,R4 XTEMP AI,R1 1 DROP THE X-ENTRY. LB,R2 *R1 NEW TOP CAT A V-ENTRY... BEZ A18X YES. CI,R2 CATO NO, AN O-ENTRY... BNE CXERSYN NAY -- SYNTAX ERROR. BAL,R14 CXPOPMON AYE, POP AND EXECUTE IT MONADIC. A18X LW,R4 XTEMP PT AT THE LIST DATA BLK OF X-ENTRY. LW,R14 2,R4 CK THAT IT IS A LIST OF LENGTH = 1. AI,R14 -1 BNEZ CXERRANK NO -- RANK ERROR. LW,R4 3,R4 YES, PT AT THE INDICATED DATA BLK. BEZ CXERSYN NO COORD GIVEN -- SYNTAX ERROR. BAL,R7 NUMSV @ CK NUMERIC SCALAR OR VECTOR... BDR,R4 A18VAL @ SCALAR, PT AT DATA BLK HDR + 2. AI,R12 -1 @ VECTOR, VERIFY LENGTH = 1. BNEZ CXERRANK OOPS -- RANK ERROR. A18VAL BAL,R5 IVAL @ GET INTEGER VALUE... B A18LAMCK @ NON-INTEGER, TRY LAMINATE ON FLOOR A18ORG AW,R7 ORGADJ @ ADJUST INTEGER TO INT. ORIGIN OF 1. BLEZ CXERRANK OOPS -- RANK ERROR. CI,R7 TOPRANK IS RANK RIDICULOUSLY HIGH... A18HICK BG CXERRANK OOPS -- RANK ERROR. STB,R7 OPERHOLD+1 OK, SET COORD (MAYBE LAMINATE BIT). LI,R4 0 XW,R4 XTEMP DEREFERENCE THE LIST DATA BLK. BAL,R7 DREF LD,R6 OPERHOLD GET THE OPERATOR INFORMATION. LW,R4 SCANTEMP GET SCANOPM OR SCANOP. B A18EXIT-SCANOPM,R4 EXIT ACCORDINGLY: A18EXIT B A16 OPM @ B A19 OP @ A18LAMCK AW,R7 ORGADJ ADJUST TO INTERNAL ORIGIN OF 1. BLZ CXERRANK OOPS -- RANK ERROR. AI,R7 X'40' SET LAMINATE BIT. LI,R5 COMMACOD VERIFY THAT THIS IS A COMMA OPERATOR CB,R5 *CURRCS,R3 BNE CXERRANK OOPS -- RANK ERROR. CI,R7 TOPRANK+X'40' OK, VERIFY RANK ISN'T TOO HIGH. B A18HICK CXOP1 LI,R4 SCANOP SET 'OP' SCAN ITEM. CXCOORD1 LW,R7 COORD1 COORDINATE-1 OPERATION. OR,R7 R3 = 2ND OPER WORD. LI,R5 -1 TO DISALLOW FURTHER COORD SPECIFCTN. STW,R3 OFFSETR SAVE OFFSET TO OPERATOR DESIGNATOR. B CXOPV,R2 CONTEXT ANALYSIS START FOR OP OR OPM CXOPM1 LI,R4 SCANOPM SET 'OPM' SCAN ITEM. B CXCOORD1 CXOP LI,R4 SCANOP SET 'OP' SCAN ITEM. CXNCOOR3 STW,R3 OFFSETR SAVE OFFSET TO OPERATOR DESIGNATOR. CXNCOORD LI,R5 -1 TO DISALLOW COORDINATE SPECIFICATION LW,R7 R3 = 2ND OPER WORD. B CXOPV,R2 CONTEXT ANALYSIS START FOR OP OR OPM CXOPM LI,R4 SCANOPM SET 'OPM' SCAN ITEM. B CXNCOOR3 CXCOP LI,R4 SCANOP SET 'OP' SCAN ITEM. CXCOK LI,R5 0 TO ALLOW COORDINATE SPECIFICATION. LW,R7 R3 = 2ND OPER WORD, SO FAR. STW,R3 OFFSETR SAVE OFFSET TO OPERATOR DESIGNATOR. B CXOPV,R2 CONTEXT ANALYSIS START FOR OP OR OPM CXCOPM LI,R4 SCANOPM SET 'OPM' SCAN ITEM. B CXCOK CXREDSET OR,R7 R3 = 2ND OPER WD, PTS AT DYADIC SCALAR. AI,R6 X'100' SET THE 'REDUCTION' FLAG. B CXOPV,R2 CONTEXT ANALYSIS FOR THIS OPM. CXCRED LI,R5 0 TO ALLOW COORDINATE SPECIFICATION. LI,R7 0 START WITH NO COORDINATE. CXRED LI,R4 SCANOPM SET 'OPM' SCAN ITEM. STW,R3 OFFSETR SAVE OFFSET TO REDUCE-OP DESIGNATOR. AI,R3 -1 GET THE CODESTRING DESIGNATOR TO THE LB,R6 *CURRCS,R3 LEFT OF THE REDUCTION SLASH. CLM,R6 DYSCLRS IS IT A DYADIC SCALAR... BCR,9 CXREDSET YES, SET FOR REDUCTION. AI,R6 DYADIC-MONADIC NO, MAYBE IT WAS CODESTRUNG AS AN CLM,R6 MDYSCLRS OPM. TEST BIASED VERSION... BCR,9 CXREDSET NOW ITS A DYADIC SCALAR. B CXERSYN OOPS -- SYNTAX ERROR. CXRED1 LI,R5 -1 TO DISALLOW FURTHER COORD SPECIFCTN. LW,R7 COORD1 COORDINATE-1 REDUCTION. B CXRED CKSCANOP LI,R4 1 PUT OFFSET TO LEFT-MOST OPERATOR U19-0015 STH,R3 OPER+1,R4 IN 'CURRBYTE' IN CASE ERROR. U19-0016 MTW,-1 OFFSETR UPDATE SAVED OFFSET FOR A7 RETURN. U19-0017 LB,R6 *CURRCS,R3 GET CURRENT CODESTRING DESIGNATOR. U19-0018 CLM,R6 DYSCLRS IS IT A DYADIC SCALAR... U19-0019 BCR,9 CKSCANOK YES, SET FOR SCAN-OPERATOR EXEC. U19-0020 AI,R6 DYADIC-MONADIC NO, BUT MIGHT BE MONADIC VERSION. U19-0021 CLM,R6 MDYSCLRS NOW IS IT A DYADIC SCALAR... U19-0022 BCS,9 CXERSYN NOPE -- SYNTAX ERROR. U19-0023 CKSCANOK STW,R6 OPER USE THAT OP FOR OPER TEMPS. U19-0024 B SCAN U19-0025 A7R STW,R3 OFFSETR SAVE OFFSET TO SCAN ITEM DESIGNATOR. A7 BAL,R14 CXPOPMON HANDLE STACKED OP MONADICALLY. LW,R3 OFFSETR RESTORE SAVED OFFSET. B NXTSCAN CXSEMI LI,R4 SCANSEMI SET 'SEMI' SCAN ITEM. CXACFLAG LI,R13 0 CLEAR ACFLAG, I.E. SET NIL. STW,R13 ACFLAG CXZCLASS LI,R13 0 (TERMINATOR CLASS OF ITEM) STW,R13 NILCK CLEAR NILCK, I.E. SET NIL. B ZRESCAN,R2 CONTEXT ANALYSIS START FOR Z-CLASS. ZRESCAN B A3 TOP-CAT = V @ B CXAP-SCANBRN,R4 A-PRIME VECTOR ON SCAN ITEM. @ B A7R O @ B CXERSYN X @ B CXBE-SCANBRN,R4 B VECTOR ON SCAN ITEM. @ B CXPE-SCANBRN,R4 P VECTOR ON SCAN ITEM. @ B CXSE-SCANBRN,R4 S VECTOR ON SCAN ITEM. @ B CXQE-SCANBRN,R4 Q VECTOR ON SCAN ITEM. @ B CXERSYN D @ B CXERSYN A @ CXBRN LI,R4 SCANBRN SET 'BRN' SCAN ITEM. B CXZCLASS CXBOS LI,R4 SCANBOS SET 'BOS' SCAN ITEM. B CXACFLAG CXLP LI,R4 SCANLP SET 'LP' SCAN ITEM. B CXZCLASS CXLB LI,R4 SCANLB SET 'LB' SCAN ITEM. B CXZCLASS CXRB CI,R2 CATAPRYM TOP CAT AN A-PRIME... BNE A1 NO. A2 AI,R1 1 YES, DROP A-PRIME ENTRY. A1 LW,R12 BENTRY GET B-ENTRY WITH COUNT = 0. CXPCNXT LB,R2 R12 SET TOP CAT FOR NEXT BDR,R3 CXPUSHC CATEGORY AND SCAN AFTER PUSHING. A34 LW,R12 AENTRY GET A-ENTRY. B CXPCNXT A24 LW,R12 PENTRY GET P-ENTRY. B CXPCNXT A28 AI,R1 1 DROP A-PRIME ENTRY. A27 LI,R12 X'1FFFF' OBTAIN LOC OF FUNCTION DESCRIPTOR AND,R12 *SYMT,R4 DATA BLOCK. OR,R12 DENTRY D ENTRY CATEGORY (DYADIC FUNC). LI,R2 CATD SET NEW TOP CAT. XW,R12 PTRITEM SAVE D-ENTRY & CLEAR R12. MTW,1 1,R5 INCR REF COUNT OF FUNDEF DATA BLK. BDR,R3 CXPUSHDP PUSH D-ENTRY & RESUME SCAN. CXQUAD CLM,R2 CATO2D TOP CAT FOR QUAD... BCR,9 A25 OK, INPUT. BCS,8 A38 OK, OUTPUT. B CXERSYN BAD -- SYNTAX ERROR. CXRP CLM,R2 CATO2D TOP CAT OK FOR RIGHT PAREN... BCR,9 A24 OK. B CXERSYN NO -- SYNTAX ERROR. CXASS CI,R2 CATO TOP CAT OK FOR ASSIGN ARROW... BL CXASSV,R2 OK, HIT A34 OR A35. BE A7R MAYBE, HIT A7. B CXERSYN BAD, SYNTAX ERROR. CXASSV B A34 @ A35 LI,R2 CATA CONVERT A-PRIME TO A ENTRY @ STB,R2 *R1 AT TOP OF STACK. BDR,R3 NXTSCAN A36 CI,R5 LBLFLAG TRYING TO ASSIGN TO A LABEL... BAZ AOK NO. B CXERSYN YES -- SYNTAX ERROR. AOK LW,R7 NILCK IS THIS AN INDEXED ASSIGNMENT... BEZ ASIMPLE NO, SIMPLE ASSIGNMENT. STW,R1 TOPOSTAK YES, SAVE STACK PTR. STW,R3 OPER+1 SAVE CURRENT CODESTRING OFFSET. LW,R6 1,R1 GET V-ENTRY. STW,R6 RTARG IT IS THE RT. ARGUMENT FOR ASS. MTW,1 1,R6 INCR REF COUNT OF ITS DATA BLK. LW,R3 NAMEPTR PT TO REF-INDIC. WD FOR VN. LI,R4 X'1FFFF' AND,R4 *SYMT,R3 GET REFERENT DATA BLK PTR. MTW,1 1,R4 BUMP ITS REF-COUNT STW,R4 LFARG MOVE IT INTO LF. ARG. PTR. B AXDRIVER ENTER INDEXED-ASSIGNMENT EXECUTION * DRIVER, IT WILL RETURN TO RETURNAX RETURNAX LW,R1 TOPOSTAK RESTORE STACK PTR; (R3 SET). LI,R4 0 XW,R4 RTARG DE-REF. (THE EXTRA REF) TO RTARG. BAL,R7 DREF U19-0027 LI,R4 0 XW,R4 LFARG DE-REF. OLD DATA BLK FOR VN. BAL,R7 DREF U19-0029 LW,R5 NAMEPTR PT TO REF-INDICATOR FOR VN. LW,R4 *SYMT,R5 GET OLD DATA BLK REFERENCE. LI,R7 X'1FFFF' LI,R6 0 XW,R6 RESULT MOVE NEW DATA BLK PTR INTO SYM TBL. STS,R6 *SYMT,R5 LI,R7 A36DONE GO TO 'A36DONE' AFTER B DREF DE-REFING OLD DATA BLK. ASIMPLE LW,R6 NAMEPTR PT TO REF-INDIC. WD FOR VN. LI,R4 X'E0000' AND,R4 *SYMT,R6 COMBINE FLAG-BITS AND NEW DATA BLK OR,R4 1,R1 PTR (V-ENTRY). MTW,1 1,R4 INCR REF-COUNT OF THAT DATA BLK. XW,R4 *SYMT,R6 INSERT NEW REFERENT-INDICATOR WD. BAL,R7 MAYDREF DEREFERENCE THE OLD (UNLESS NIL). A36DONE LI,R2 CATAPRYM SET TOP CAT TO BE A-PRIME (I.E. STB,R2 *R1 ASSIGNMENT-COMPLETED). LW,R4 CATCHTBL IS A CATCH IN EFFECT... BLZ NXTSCANU NO, RESUME SCAN. CW,R4 NAMEPTR YES, FOR THIS VN... BNE A36CATC2 NO, TRY OTHER CATCH. LW,R6 CATCHTBL+1 YES, GET FUN.NAME PTR. A36CATCH LI,R5 X'1FFFF' EXTRACT REF-PTR FOR FUN.NAME... AND,R5 *SYMT,R6 BEZ NXTSCANU NONE, RESUME SCAN. LB,R6 *R5 GET DATA BLK TYPE. AI,R6 -TYPENFN VERIFY NILADIC FUNC., NO RESULT... BNEZ NXTSCANU NOPE, RESUME SCAN. B A26 OK, EXECUTE CATCH FUNCTION. A36CATC2 LW,R4 CATCHTBL+2 IS 2ND CATCH IN EFFECT... BLZ NXTSCANU NO, RESUME SCAN. CW,R4 NAMEPTR YES, FOR THIS VN... BNE NXTSCANU NO, RESUME SCAN. LW,R6 CATCHTBL+3 YES, GET FUN.NAME PTR. B A36CATCH A32 B A32VORP,R4 VECTOR ON SCANITEM VN OR PTR: A32VORP B A32NILCK @ 0 -- PTR. * B A32VN @ 1 -- VN. A32VN AND,R5 X1FFFF @ EXTR. DATA BLK PTR FROM REF-IND. WD. STW,R5 PTRITEM MTW,1 1,R5 INCR REF COUNT OF THAT DATA BLOCK. A32NILCK LI,R14 CXPUSHV SET TO EXIT TO CXPUSHV. QNILCK LW,R7 NILCK IS THERE A SUBSCRIPT... BNEZ SUBEX YES. QOBS LW,R7 OBSERVE NO, OBSERVE SET... BEZ *R14 NOPE -- EXIT. AI,R6 -A15PAREN-1 YEP. BEZ *R14 (EXIT IF VIA PAREN -- REDUNDANT). STW,R3 OFFSET SAVE CS POS. FOR OBSERVE'S MARKER. LW,R6 PTRITEM PT AT OPERAND'S DATA BLK. B OBSERVER OBSERVE THAT VALUE, OBSERVED B *R14 RESUME HERE. SUBEX STW,R3 OPER+1 SAVE CURRENT CODESTRING OFFSET. STW,R1 TOPOSTAK SAVE EXECUTION STACK PTR. STW,R14 LINKX SAVE LINK TO SUBEX. LW,R6 BREAKFLG TEST FOR BREAK... BEZ SXDRIVER NO -- ENTER SUBSCRIPTING DRIVER, B CXBREAK * IT WILL RETURN TO RETURNSX. RETURNSX LW,R1 TOPOSTAK RESTORE STACK PTR; (R3 SET). LI,R4 0 XW,R4 RTARG DE-REF. RTARG (WAS LFARG WHEN * ENTERING 'SXDRIVER'). BAL,R7 DREF LI,R5 0 XW,R5 RESULT MOVE RESULT INTO PTRITEM. STW,R5 PTRITEM LW,R14 LINKX SET TO EXIT VIA SAVED LINK (SUBEX) B QOBS AFTER QUERY OBSERVE SETTING. CXPUSHV BAL,R4 STACKUP ADD 1 LOC TO EXECUTION STACK. LI,R5 0 GET PTR OUT OF PTRITEM XW,R5 PTRITEM = V ENTRY FOR NEW STACK LOC. STW,R5 0,R1 FILL IT WITH V-ENTRY. LI,R2 CATV TOP CAT IS FOR V-ENTRY. BDR,R3 NXTSCAN RESUME SCAN. A23 B A23VORP,R4 VECTOR ON SCANITEM VN OR PTR: A23VORP B A23NILCK @ 0 -- PTR. * B A23VN @ 1 -- VN. A23VN AND,R5 X1FFFF @ EXTR. DATA BLK PTR FROM REF-IND. WD. STW,R5 PTRITEM MTW,1 1,R5 INCR REF COUNT OF THAT DATA BLOCK. A23NILCK BAL,R14 QNILCK QUERY SUBSCRIPTING. DYEX STW,R3 OFFSET SAVE CODESTRING OFFSET LI,R6 X'FFFF' GET OPTYPE AND,R6 0,R1 AND LW,R7 1,R1 2ND OPER. INFO WD. STD,R6 OPER SAVE BOTH. STW,R7 OPCURRBY (SAVE CURR.BYTE FOR OPWRAP). AI,R1 2 DROP O-ENTRY FROM EXECUTION STACK. LI,R14 0 PULL THE XW,R14 0,R1 V-ENTRY AND STW,R14 RTARG MAKE IT THE RT ARGUMENT. * LFARG (LEFT ARG) IS IN 'PTRITEM' * LFARG AND PTRITEM ARE SAME CELL. STW,R1 TOPOSTAK HOLD TOP-O-STACK, RESULT WILL FILL. LW,R5 BREAKFLG TEST FOR BREAK... BEZ DRANGECK NO -- RANGE CHECK THE OPER. B CXBREAK YES. DRANGECK CLM,R6 DYRANGE CK FOR ORDINARY DYADIC OP. BCR,9 DXDRIVER YES, ENTER DYADIC EXECUTION DRIVER, * IT WILL RETURN TO RETURNDX. LI,R5 2 GET MOST SIGNIFICANT BYTE OF THE LB,R5 OPER,R5 OPTYPE FIELD. CI,R5 SMOCODE CK FOR SMALL CIRCLE... BG INNER HI -- INNER PRODUCT... BE OUTER ON -- OUTER PRODUCT... AI,R6 -DYINFLAG (REMOVE DYADIC-INTRINSIC FLAG) B DINTRIN LO -- DYADIC INTRINSIC... * NOTE--THEY ALL RETURN TO RETURNDX. RETURNDX LW,R1 TOPOSTAK RESTORE STACK PTR; (R2=0, I.E. CATV) LW,R3 OFFSET RESTORE CODESTRING OFFSET. LI,R4 0 XW,R4 LFARG DEREFERENCE LEFT ARG. BAL,R7 DREF LI,R14 NXTSCANU SET TO EXIT TO NXTSCANU. OPWRAP LI,R4 0 WRAP UP OPERATOR. XW,R4 RTARG BAL,R7 DREF DEREFERENCE RIGHT ARG. LI,R6 0 XW,R6 RESULT MOVE RESULT DB PTR INTO TOP-O-STACK. STW,R6 0,R1 LW,R7 OBSERVE IS OBSERVE SET... BEZ *R14 NO -- EXIT. INT,R7 OPCURRBY YES,SAVE CURR.BYT TO OPERATOR. STW,R7 OFFSET RESUME FOR EXIT AT OBSERVED AFTER B OBSERVER DISPLAYING THE OBSERVATION. A33 LW,R7 NILCK IS ITEM ALREADY TO BE INDEXED... BEZ A33N NO. B A33VORP,R4 YES, VECTOR ON SCANITEM VN OR PTR: A33VORP B A33X @ 0 -- PTR. * B A33VN @ 1 -- VN. A33VN AND,R5 X1FFFF @ EXTR. DATA BLK PTR FROM REF-IND. WD. STW,R5 PTRITEM MTW,1 1,R5 INCR REF COUNT OF THAT DATA BLOCK. A33X BAL,R14 SUBEX EXECUTE SUBSCRIPTING (ONCE). LI,R4 0 SET SCANITEM FOR PTR (NOT VN). A33N LI,R7 0 XW,R7 0,R1 PULL X-ENTRY OUT OF TOP-O-STACK STW,R7 NILCK AND SAVE IT IN NILCK (NON-NIL). AI,R1 1 POP AND GET LB,R2 *R1 NEW TOP CAT. B CXPTR,R2 CONTEXT ANALYSIS FOR VN OR PTR. CXNMV LI,R4 0 STW,R4 NILCK CLEAR NILCK FLAG, I.E. SET NIL. LI,R4 SCANVN SET 'VN' SCAN ITEM. B CXPTR,R2 CONTEXT ANALYSIS FOR VN. CXNMNI CLM,R2 CATO2D TOP CAT OK FOR NILADIC INTRINSIC... BCS,9 CXERSYN NO -- SYNTAX ERROR. LH,R2 *R5 YES, EXTRACT INTRINSIC'S NO. AI,R2 -(TYPENI**8) STD,R2 OPER SAVE I AND SAVE OFFSET TO CODESTRING STW,R1 TOPOSTAK SAVE STACK PTR. LW,R4 BREAKFLG TEST FOR BREAK... BEZ NINTRIN NO -- EXEQ NILADIC INTRINSIC & GO B CXBREAK * TO RETURNNI AFTER 'RESULT' SET. RETURNNI LW,R1 TOPOSTAK RESTORE STACK PTR (NOTE--R4 = 0). XW,R4 RESULT MOVE RESULT INTO PTRITEM. STW,R4 PTRITEM B FPOPPED ASSUME WE'VE POPPED AN F-ENTRY. CXNMMI CI,R2 CATO IS AN OPERATOR AT TOP OF STACK... BE A22 YES -- IT IS MONADIC. LH,R6 *R5 NO, EXTRACT MONADIC-INTRINSIC'S AI,R6 -(TYPEMI**8) 'OPERATOR' NO. LI,R4 SCANOPM SET 'OPM' SCAN ITEM. B CXNCOORD CXNMDI CI,R2 CATO IS AN OPERATOR AT TOP OF STACK... BE A22 YES -- IT IS MONADIC. LH,R6 *R5 NO, EXTR. DYADIC-INTRIN'S 'OPER.' AI,R6 -(TYPEDI**8)+DYINFLAG NO. AND FLAG IT. LI,R4 SCANOP SET 'OP' SCAN ITEM. B CXNCOORD CXNMNF CLM,R2 CATO2D TOP CAT OK FOR NILADIC FUNCTION... BCR,9 A26 YES, ENTER ACTION ROUTINE. B CXERSYN NO -- SYNTAX ERROR. CXNMDF CI,R2 CATO TOP CAT OK FOR DYADIC FUNCTION... BLE CXNMDFV,R2 YES, HIT PROPER ACTION ROUTINE. B CXERSYN NO -- SYNTAX ERROR. CXNMDFV B A27 @ B A28 @ B A22 @ CXNMMF CI,R2 CATO TOP CAT OK FOR MONADIC FUNCTION... BLE CXNMMFV,R2 YES, HIT PROPER ACTION ROUTINE. B CXERSYN NO -- SYNTAX ERROR. CXNMMFV B A29 @ B A30 @ A22 BAL,R14 CXPOPMON HANDLE STACKED OP MONADICALLY. LW,R4 NAMEPTR RESTORE PTR TO FUNCTION NAME. B CXNRESC RESCAN FOR THAT NAME. CXPOPMON LI,R6 X'FFFF' GET OPTYPE AND,R6 0,R1 AND LW,R7 1,R1 2ND OPER. INFO WD. STD,R6 OPER SAVE BOTH. AI,R1 2 DROP O-ENTRY FROM EXECUTION STACK. MONEX STW,R14 LINKMX SAVE LINK. STW,R3 OFFSET SAVE CODESTRING OFFSET. STW,R7 OPCURRBY (SAVE CURR.BYTE FOR OPWRAP). LI,R14 0 PULL THE XW,R14 0,R1 V-ENTRY AND STW,R14 RTARG MAKE IT THE RT ARGUMENT. STW,R1 TOPOSTAK HOLD TOP-O-STACK, RESULT WILL FILL. LW,R5 BREAKFLG TEST FOR BREAK... BEZ MRANGECK NO -- RANGE CHECK THE OPER. B CXBREAK YES. MRANGECK CLM,R6 MONRANGE CK FOR ORDINARY MONADIC OP. BCR,9 MXDRIVER YES, ENTER MONADIC EXECUTION DRIVER, * IT WILL RETURN TO RETURNMX. BCS,1 MINTRIN NO, (LO) TRY INTRINSIC MONADIC, IT * TOO WILL RETURN TO RETURNMX. CLM,R6 REDRANGE NO, (HI) CK FOR REDUCTION RANGE. BCR,9 REDUCE OK, REDUCE WILL RETURN TO RETURNMX CLM,R6 S2XRANGE NO, CK FOR SCAN OR EXECUTE CASE... U19-0031 BCR,9 SORXV-SCAN1COD,R6 YES, VECTOR ACCORDING TO WHICH. U19-0032 B CXERSYN OOPS -- SYNTAX ERROR RETURNMX LW,R1 TOPOSTAK RESTORE STACK PTR; (R2=0, I.E. CATV) LW,R3 OFFSET RESTORE CODESTRING OFFSET. LW,R14 LINKMX SET TO EXIT VIA SAVED LINK (MONEX) B OPWRAP AFTER WRAPPING UP THE OPERATION. CXSLOGL1 LI,R6 -1 PUT A 1 IN BIT POSITION ZERO. CXSLOGL0 LI,R13 TYPELOGL LOGICAL TYPE DATA BLOCK. B CXGENWD GEN LOGICAL SCALAR DATA BLOCK. CXSIBYTE LB,R6 *CURRCS,R3 GET BYTE-FORM OF INTEGER. CXSI09 LI,R13 TYPEINTG FOR INTEGER TYPE OF DATA BLOCK. CXGENWD LI,R11 2 ASK FOR 2 WDS PLUS HEADER. STW,R1 TOPOSTAK SAVE STACK PTR. IN CASE WS FULL. STW,R3 OPER+1 SAVE OFFSET IN CASE WS FULL OCCURS. BAL,R7 ALOCHNW ALLOCATE DATA BLOCK. CXSTWD STW,R6 2,R4 FILL IN VALUE WORD. STW,R4 PTRITEM SAVE LOC OF DATA BLOCK FOR PTR ITEM. STB,R13 *PTRITEM FILL IN DATA BLOCK TYPE. LI,R4 0 SET 'PTR' SCAN ITEM. STW,R4 NILCK CLEAR NILCK FLAG, I.E. SET NIL. B CXPTR,R2 CONTEXT ANALYSIS FOR PTR. CXPTR B CXERSYN V -- SYNTAX ERROR. @ B CXERSYN A-PRIME -- SYNTAX ERROR. @ B A23 O @ B A33 X @ B A32 B @ B A32 P @ B A32 S @ B A32 Q @ B A31 D @ B CXVORP,R4 A -- IS SCAN ITEM PTR OR VN... @ CXVORP B CXERSYN @ PTR -- SYNTAX ERROR. B A36 @ VN, ENTER ACTION ROUTINE. CXSIWORD SLS,R3 -2 WORD OFFSET TO INTEGER VALUE. LW,R6 *CURRCS,R3 GET INTEGER. SLS,R3 2 OFFSET TO LEFTMOST BYTE OF INTEGER. B CXSI09 CXSREAL SLS,R3 -2 WORD OFFSET TO 2ND REAL WD. LW,R13 *CURRCS,R3 GET 2ND REAL WD. AI,R3 -1 OFFSET TO 1ST REAL WD. LW,R6 *CURRCS,R3 GET 1ST REAL WD. SLS,R3 2 OFFSET TO LEFTMOST BYTE OF REAL PAIR LI,R11 2 ASK FOR 2 WDS PLUS HEADER. STW,R1 TOPOSTAK SAVE STACK PTR. IN CASE WS FULL. STW,R3 OPER+1 SAVE OFFSET IN CASE WS FULL OCCURS. BAL,R7 ALOCHNW ALLOCATE DATA BLOCK. STW,R13 3,R4 FILL IN 2ND REAL WD. LI,R13 TYPEREAL FOR REAL TYPE OF DATA BLOCK. B CXSTWD FILL IN 1ST REAL WD AND SET PTR. CXSTEXT LB,R6 *CURRCS,R3 GET TEXT SCALAR BYTE. SCS,R6 -8 PUT IT IN BYTE ZERO. LI,R13 TYPETEXT FOR TEXT TYPE OF DATA BLOCK. B CXGENWD GEN THAT DATA BLOCK. CXVINTG LI,R6 TYPEINTG FOR INTEGER TYPE OF DATA BLOCK. CXVLEN LB,R11 *CURRCS,R3 GET LENGTH BYTE CXVALOC STW,R11 RSSIZE = NO.OF ELEMENTS OF TYPE. STW,R6 RSTYPE TYPE OF DATA BLOCK. LI,R14 1 RANK IS 1 FOR VECTOR. STW,R14 RSRANK STW,R1 TOPOSTAK SAVE STACK PTR. IN CASE WS FULL. STW,R3 OPER+1 SAVE OFFSET IN CASE WS FULL OCCURS. BAL,R14 ALOCRS ALLOCATE 'RESULT' DATA BLOCK. STW,R4 PTRITEM SAVE LOC OF DATA BLK FOR PTR ITEM. AI,R4 2 PT AT LENGTH WD OF DATA BLK. LW,R5 RSSIZE GET LENGTH AGAIN. STW,R5 0,R4 PUT IT IN DATA BLK. BEZ CXPVSET EMPTY VECTOR. CXFILLV B CXFILLV,R6 TYPE... (0 IS IMPOSSIBLE) B CXFLOGL @ 1 FILL IN LOGICAL VALUES. B CXFTEXT @ 2 FILL IN TEXT VALUES. B CXFINTG @ 3 FILL IN INTEGER VALUES. * B CXFREAL @ 4 FILL IN REAL VALUES. CXFREAL AI,R4 1 @ WD AFTER LENGTH IS GARBAGE, WE NEED SLS,R5 1 EVEN BNDRY. 2 WDS PER ELEMENT. STW,R5 RSSIZE SET SIZE IN WORDS, NOT DBLWDS. CXFINTG AW,R4 RSSIZE PT AT LAST VALUE WD OF DATA BLK. SLS,R3 -2 WD OFFSET TO LENGTH BYTE IN CODESTR. CXFWORD AI,R3 -1 FILL IN WORD VALUES, LW,R10 *CURRCS,R3 FROM LAST STW,R10 0,R4 TO FIRST. AI,R4 -1 BDR,R5 CXFWORD SLS,R3 2 OFFSET TO LEFTMOST BYTE OF 1ST WD. CXPVSET LI,R4 0 SET UP FOR PTR ITEMS OF VECTOR CLASS STW,R4 RESULT ELIMINATE THE EXTRA REF TO DATA BLK. STW,R4 NILCK CLEAR NILCK FLAG, I.E. NIL. B CXPTR,R2 CONTEXT ANALYSIS FOR PTR. CXFLOGL AI,R5 7 CALC. NO.OF BYTES SLS,R5 -3 FOR LOGICAL VALUES STW,R5 RSSIZE CXFTEXT SLS,R4 2 PT AT BYTE IN DATA BLOCK THAT AI,R4 3 PRECEDES 1ST VALUE BYTE SPOT. AW,R4 RSSIZE PT AT LAST VALUE BYTE TO FILL. CXFBYTE AI,R3 -1 FILL IN BYTE VALUES, LB,R10 *CURRCS,R3 FROM LAST STB,R10 0,R4 TO FIRST. AI,R4 -1 BDR,R5 CXFBYTE B CXPVSET FINISH POINTING AT LEFTMOST VAL BYTE CXVLOGL LI,R6 TYPELOGL FOR LOGICAL TYPE DATA BLOCK. B CXVLEN CXVREAL LI,R6 TYPEREAL FOR REAL TYPE DATA BLOCK. B CXVLEN CXVTEXT LI,R6 TYPETEXT FOR TEXT TYPE DATA BLOCK. B CXVLEN CXVTEXTL LB,R11 *CURRCS,R3 GET LO BYTE OF LONG-TEXT LENGTH. SCD,R10 -8 HOLD IT. AI,R3 -1 OFFSET TO HI BYTE. LB,R11 *CURRCS,R3 GET IT. SCD,R10 8 FORM LENGTH HALFWORD, IN R11. LI,R6 TYPETEXT FOR TEXT TYPE DATA BLOCK. B CXVALOC PREPARE TO ALLOCATE IT. CXCOMMNT LB,R6 *CURRCS,R3 GET LENGTH OF COMMENT. SW,R3 R6 OFFSET TO 1ST COMMENT CHAR, IF ANY. BDR,R3 NXTSCAN FORGET IT. CXSTORTR LB,R4 *CURRCS,R3 GET RIGHT BYTE OF NAME POINTER. SLD,R4 -8 SAVE IT. AI,R3 -1 GET LEFT BYTE. LB,R4 *CURRCS,R3 SLD,R4 8 = THE NAME POINTER. LI,R5 X'1FFFF' EXTRACT REFERENT, I.E. AND,R5 *SYMT,R4 DATA BLOCK PTR. BEZ CXERUND OOPS, NONE -- UNDEFINED. LB,R10 *R5 OK, GET ITS TYPE. CLM,R10 FUNTYPES VERIFY THAT ITS A FUNCTION NAME. BCS,9 CXERSYN GOOF -- SYNTAX ERROR. CI,R2 CATA IS TOP-O-STACK CATEGORY AN A... BE A37 YES, ENTER ACTION ROUTINE. B CXERSYN NO, SYNTAX ERROR CXNAME STW,R3 OFFSETR SAVE OFFSET TO NAME DESIGNATOR. AI,R3 -1 LB,R4 *CURRCS,R3 GET RIGHT BYTE OF NAME POINTER. SLD,R4 -8 HOLD IT. AI,R3 -1 GET LEFT BYTE. LB,R4 *CURRCS,R3 SLD,R4 8 = THE NAME POINTER. STW,R4 NAMEPTR CXNRESC LW,R5 *SYMT,R4 GET ITS REFERENT INDICATOR WORD. CI,R5 X'1FFFF' IS THERE A REFERENT... BANZ CXNAMFND YES. CI,R2 CATA NO, IS THIS AN ASSIGNMENT... BE CXNMV YEP, GO AHEAD. B CXERUND NOPE -- UNDEFINED. CXNAMFND LB,R6 *R5 GET TYPE OF DATA BLK REFERENCED. B CXNAMTYP,R6 CXNAMTYP BAL,R15 SYSTERR @ 0 -- SHOULD BE IMPOSSIBLE. B CXNMV @ 1 -- LOGL VARIABLE B CXNMV @ 2 -- TEXT VARIABLE B CXNMV @ 3 -- INTG VARIABLE B CXNMV @ 4 -- REAL VARIABLE B CXNMV @ 5 -- INDEX SEQUENCE VARIABLE B CXNMV @ 6 -- LIST VARIABLE BAL,R15 SYSTERR @ 7 -- CODESTRING -- MAYBURY'S ERROR B CXNMNF @ 8 -- NILADIC FUNC, NO RESULT. B CXNMNF @ 9 -- NILADIC FUNC, RESULT. B CXNMMF @ 10-- MONADIC FUNC, NO RESULT. B CXNMMF @ 11-- MONADIC FUNC, RESULT. B CXNMDF @ 12-- DYADIC FUNC, NO RESULT. B CXNMDF @ 13-- DYADIC FUNC, RESULT. B CXNMDI @ 14-- DYADIC INTRINSIC. B CXNMMI @ 15-- MONADIC INTRINSIC. B CXNMNI @ 16-- NILADIC INTRINSIC. B CXERSYN 17-- GROUP -- SYNTAX ERROR. CXBADCD EQU SYSTERR -- CRASH IF BAD CODE; SOMETHING IS HAYWIRE. CXV B CXSLOGL0 0@ 0 LOGICAL SCALAR CONSTANT B CXSLOGL1 1@ 1 LOGICAL SCALAR CONSTANT B CXSI09 2@ 2 SCALAR CONSTANT B CXSI09 3@ 3 SCALAR CONSTANT B CXSI09 4@ 4 SCALAR CONSTANT B CXSI09 5@ 5 SCALAR CONSTANT B CXSI09 6@ 6 SCALAR CONSTANT B CXSI09 7@ 7 SCALAR CONSTANT B CXSI09 8@ 8 SCALAR CONSTANT B CXSI09 9@ 9 SCALAR CONSTANT BDR,R3 CXSIBYTE 10@ INTEGER BYTE SCALAR CONSTANT BDR,R3 CXSIWORD 11@ INTEGER WORD SCALAR CONSTANT BDR,R3 CXSREAL 12@ REAL SCALAR CONSTANT BDR,R3 CXSTEXT 13@ TEXT SCALAR CONSTANT BDR,R3 CXVLOGL 14@ LOGICAL VECTOR CONSTANT BDR,R3 CXVINTG 15@ INTEGER VECTOR CONSTANT BDR,R3 CXVREAL 16@ REAL VECTOR CONSTANT BDR,R3 CXVTEXT 17@ TEXT VECTOR CONSTANT BDR,R3 CXVTEXTL 18@ LONG TEXT VECTOR CONSTANT B CXLSERR 19@ ERROR (DURING LINE SCAN) BDR,R3 CXCOMMNT 20@ COMMENT BDR,R3 CXSTORTR 21@ STOPNAME BDR,R3 CXSTORTR 22@ TRACENAME B CXNAME 23@ NAME BAL,R15 CXBADCD 24@ * B CXQUAD 25@ QUAD-0 B CXQUAD 26@ QUAD-1 B CXQUAD 27@ QUAD-2 B CXQUAD 28@ QUAD-3 B CXQUAD 29@ QUAD-4 B CXQUAD 30@ QUAD-5 B CXQUAD 31@ QUAD-6 B CXQUAD 32@ QUAD-7 B CXQUAD 33@ QUAD-8 B CXQUAD 34@ QUAD-9 B CXQUAD 35@ QUAD B CXQUAD 36@ QUOTE-QUAD B CXBOS 37@ BEGINNING-OF-STMT B CXSEMI 38@ SEMICOLON B CXLB 39@ LEFT BRACKET B CXRB 40@ RIGHT BRACKET B CXLP 41@ LEFT PAREN B CXRP 42@ RIGHT PAREN B CXBRN 43@ BRANCH ARROW B CXASS 44@ ASSIGN ARROW B CXDOT 45@ DOT BAL,R15 CXBADCD 46@ SMALL CIRCLE BAL,R15 CXBADCD 47@ * BAL,R15 CXBADCD 48@ * BAL,R15 CXBADCD 49@ * B CXOPM 50@ DOMINO MONADIC USE B CXOPM 51@ ROLL MONADIC USE B CXOPM 52@ T-BAR MONADIC USE B CXRED1 53@ REDUCE ON 1ST COORD MONADIC USE B CXCRED 54@ REDUCE MONADIC USE B CXOPM 55@ IOTA MONADIC USE B CXOPM 56@ RHO MONADIC USE B CXOPM 57@ RAVEL MONADIC USE B CXOPM1 58@ REVERSE ON 1ST COORD MONADIC USE B CXCOPM 59@ REVERSE MONADIC USE B CXOPM 60@ TRANSPOSE MONADIC USE B CXOPM 61@ IDENTITY MONADIC USE B CXOPM 62@ MINUS MONADIC USE B CXOPM 63@ SIGNUM MONADIC USE B CXOPM 64@ RECIPROCAL MONADIC USE B CXOPM 65@ EXPONENTIAL MONADIC USE B CXOPM 66@ NATURAL LOG MONADIC USE B CXOPM 67@ PI TIMES MONADIC USE B CXOPM 68@ CEILING MONADIC USE B CXOPM 69@ FLOOR MONADIC USE B CXOPM 70@ ABSOLUTE MONADIC USE B CXOPM 71@ FACTORIAL (GAMMA) MONADIC USE BAL,R15 CXBADCD 72@ * BAL,R15 CXBADCD 73@ * B CXOPM 74@ I-BEAM B CXOPM 75@ GRADE UP B CXOPM 76@ GRADE DOWN B CXOPM 77@ NOT BAL,R15 CXBADCD 78@ * BAL,R15 CXBADCD 79@ * B CXOP 80@ DOMINO B CXOP 81@ ROLL OR DEAL B CXOP 82@ T-BAR B CXOP1 83@ COMPRESS ON 1ST COORD B CXCOP 84@ COMPRESS B CXOP 85@ IOTA B CXOP 86@ RHO B CXCOP 87@ COMMA B CXOP1 88@ REVERSE OR ROTATE ON 1ST COORD B CXCOP 89@ REVERSE OR ROTATE B CXOP 90@ TRANSPOSE B CXOP 91@ PLUS B CXOP 92@ MINUS B CXOP 93@ TIMES B CXOP 94@ DIVIDE B CXOP 95@ EXPONENT B CXOP 96@ LOG B CXOP 97@ CIRCLE B CXOP 98@ MAX OR CEILING B CXOP 99@ MIN OR FLOOR B CXOP 100@ ABSOLUTE OR RESIDUE B CXOP 101@ EXCLAMATION PT B CXOP 102@ LESS THAN B CXOP 103@ LESS THAN OR EQUAL B CXOP 104@ GREATER THAN B CXOP 105@ GREATER THAN OR EQUAL B CXOP 106@ NOT EQUAL B CXOP 107@ EQUAL B CXOP 108@ AND B CXOP 109@ OR B CXOP 110@ NAND B CXOP 111@ NOR BAL,R15 CXBADCD 112@ * BAL,R15 CXBADCD 113@ * B CXOP 114@ DECODE B CXOP 115@ ENCODE B CXOP 116@ TAKE B CXOP 117@ DROP B CXOP1 118@ EXPAND OR SCAN ON 1ST COORD U19-0034 B CXCOP 119@ EXPAND OR SCAN U19-0035 B CXOP 120@ EPSILON BAL,R15 CXBADCD 121@ * BAL,R15 CXBADCD 122@ * BAL,R15 CXBADCD 123@ DIERESIS BAL,R15 CXBADCD 124@ NEGATIVE SIGN BAL,R15 CXBADCD 125@ UNDERSCORE BAL,R15 CXBADCD 126@ DOLLAR SIGN BAL,R15 CXBADCD 127@ ALPHA BAL,R15 CXBADCD 128@ OMEGA BAL,R15 CXBADCD 129@ DEL BAL,R15 CXBADCD 130@ LOCKED DEL BAL,R15 CXBADCD 131@ LEFT CUP BAL,R15 CXBADCD 132@ RIGHT CUP BAL,R15 CXBADCD 133@ CAP BAL,R15 CXBADCD 134@ CUP BAL,R15 CXBADCD 135@ COLON BAL,R15 CXBADCD 136@ * BAL,R15 CXBADCD 137@ * NXTSCANU AI,R3 -1 138@ DUMMY -- PT AT NEXT CODESTR.DESIG. NXTSCAN LB,R6 *CURRCS,R3 GET CODESTRING DESIGNATOR. B CXV,R6 VECTOR TO THAT CD'S PRELIM PROCESSOR CX LH,R3 *CURRCS OFFSET TO RIGHTMOST ITEM OF CODESTR. LW,R1 TOPOSTAK PT AT TOP OF EXECUTION STACK. LB,R2 *TOPOSTAK GET TOP CATEGORY. CI,R2 CATQ CK FOR Q-ENTRY (EVALUATED-INPUT REQ) BE NXTSCAN YES, START SCANNING. LW,R12 SENTRY NO, PUSH AN S-ENTRY (COUNT = 0) LI,R2 CATS SET TOP CAT TO S-ENTRY. LW,R8 OBSFLAG SET OBSERVATION SETTING FOR THIS STW,R8 OBSERVE DIRECT LINE: 0=NO & -1=YES. B CXPUSHC PUSH CATEGORY WD AND START SCAN. PAGE ************************************************************************ SPACE 2 Z SET %-CODEXEQ@ SPACE Z SET Z+Z/10*6+Z/100*96+Z/1000*1536 SIZE IN DECIMAL. SPACE 2 END