TITLE 'OPR-B00,08/22/73,DWG702985' PAGE * * * E X T E R N A L C O M M U N I C A T I O N * * * DEFINITIONS * DEF BALCOMP 'BAL,LX FFCOMPAR' INSTRUCTION DEF BASEADR BASE ADR FOR SHORT ADR OFFSETS DEF CHAREQ CHARACTER EQUAL/NOT EQUAL DEF COMPINST COMPARE INST TABLE DEF CONVTABL TYPE CONVERSION CODE TABLE DEF DIVZERO DIVIDE BY ZERO TRAP ROUTINE DEF DTYPEF DYACIC FLOT TYPE SETUP DEF DTYPEIF INTG/FLOT TYPE SETUP DEF DTYPEIF1 * (ALT. ENTRY) DEF DTYPEIF2 * (ALT. ENTRY) DEF DXDRIVER DYADIC EXECUTION DRIVER DEF DXTABLE DYADIC OP ROUTINE ENTRY TABLE DEF EXECUTE EXECUTE XSEG DEF FLOTINF FLOATING POINT INFINITY DEF FLOT0 FLOATING POINT 0.0 DEF FLOT01 FLOATING POINT 0.0, 1.0 DEF FLOT1 FLOATING POINT 1.0 DEF FLOT2 FLOATING POINT 2.0 DEF GENLOAD GEN LOAD BY RSTYPE DEF GENLOADT GEN LOAD TO TEMP DEF GXSEGDL1 GEN DYADIC LOAD (ALT. ENTRY) DEF GXSEGINI GEN XSEG INITIALIZATION DEF GXSEGML GEN MONADIC LOAD DEF GXSTEXC1 GEN STORE/EXECUTE (ALT. ENTRY) DEF GXSTEXEC GEN XSEG STORE; EXECUTE XSEG DEF INTGOVFL INTEGER OVERFLOW (DOMAIN CHANGE) DEF LFADR LEFT ARG ADDRESS DEF LFLGLADR LEFT LOGICAL ADDRESS DEF LFLGLCNT LEFT LOGICAL BIT COUNT DEF LFRANK LEFT ARG RANK DEF LFSIZE LEFT ARG SIZE DEF LFTEMP LEFT ARG VALUE TEMP DEF LFTYPE LEFT ARG TYPE DEF LOADINST LOAD INSTRUCTION TABLE, BY TYPE DEF LODBINST LOAD 2ND ACCUM INST TABLE DEF LOOPLOC LOOP LOCATION DEF MNOP MONADIC NO OP ROUTINE DEF MTYPEF MONADIC FLOT TYPE SETUP DEF MXDRIVER MONADIC EXECUTION DRIVER DEF OPR@ START OF PROCEDURE DEF RSADR RESULT ADDRESS DEF RSRANK RESULT RANK DEF RSSIZE RESULT SIZE DEF RSTYPE RESULT TYPE DEF RTADR RIGHT ARG ADDRESS DEF RTRANK RIGHT ARG RANK DEF RTSIZE RIGHT ARG SIZE DEF RTTEMP RIGHT ARG VALUE TEMP DEF RTTYPE RIGHT ARG TYPE DEF SETADR SET UP ARG ADR CELL DEF SETADRS1 SET UP ADDRESS(ES), SEQUENTIAL DEF STCCSEQ STORE CC CODE SEQ DEF STMPINST STORE IN TEMP INST TABLE DEF STORINST STORE INSTRUCTION TABLE DEF TYPETEMP TYPE TEMP U08-0004 * * REFERENCES * REF ALOCHNW ALLOCATE HEADER AND N WORDS REF ALOCRS ALLOCATE RESULT DATA BLOCK REF BITMASK LOGICAL BIT SELECTION TABLE REF CIRCULAR CIRCULAR FUNCTION EVAL REF CLOADLNK DERAIL LINK FOR GXSEGDL REF COPTRIG COMPOSITE OP TRIGGER REF CSETLNK DERAIL LINK FOR DSETUP REF CSTORLNK DERAIL LINK FOR GXSTEXEC REF CTYPELNK DERAIL LINK FOR DTYPEIF REF DCATEN DYADIC CATENATE OP ROUTINE REF DCOMPRES DYADIC COMPRESS OP ROUTINE REF DDEAL DYADIC DEAL OP ROUTINE REF DDECODE DYADIC DECODE OP ROUTINE REF DDROP DYADIC DROP OP ROUTINE REF DENCODE DYADIC ENCODE OP ROUTINE REF DEXPAND DYADIC EXPAND OP ROUTINE REF DINDEXOF DYADIC INDEX-OF OP ROUTINE REF DMATDIV DYADIC MATRIX DIVIDE OP ROUTINE REF DMEMBER DYADIC MEMBERSHIP OP ROUTINE REF DREF DE-REF REF DRESHAPE DYADIC RESHAPE OP ROUTINE REF DROTATE DYADIC ROTATE OP ROUTINE REF DTAKE DYADIC TAKE OP ROUTINE REF DTBAR DYADIC T-BAR OP ROUTINE REF DTRANS DYADIC TRANSPOSE ROUTINE REF DXRETURN DYADIC EXECUTION DRIVER RETURN REF ERDOMAIN DOMAIN ERROR REF ERLENGTH LENGTH ERROR REF ERRANK RANK ERROR REF ERSYN SYNTAX ERROR HANDLER REF FCEILING F CEILING EVAL REF FEXP F EXPONENTIAL EVAL REF FFACT F FACTORIAL EVAL REF FFCOMB F COMBINATORIAL EVAL REF FFCOMPAR F COMPARISON EVAL REF FFLOG F DYADIC LOG EVAL REF FFLOOR F FLOOR EVAL REF FFPOWER F POWER EVAL REF FFRESIDU F RESIDUE EVAL REF FIPOWER F TO I POWER EVAL REF FLOG F MONADIC LOG EVAL REF FSQRT F SQUARE ROOT EVAL REF F2I CONVERT F TO I REF ICEILING I CEILING EVAL REF IFACT I FACTORIAL EVAL REF IFLOOR I FLOOR EVAL REF IICOMB I COMBINATORIAL EVAL REF IIPOWER I POWER EVAL REF IIRESIDU I RESIDUE EVAL REF IROLL I ROLL EVAL REF LFARG LEFT ARG PNTR REF MDIMEN MONADIC DIMENSION OP ROUTINE REF MGRADEDN MONADIC GRADE DOWN OP ROUTINE REF MGRADEUP MONADIC GRADE UP OP ROUTINE REF MIBEAM MONADIC I-BEAM OP ROUTINE REF MINDEX MONADIC INDEX GENERATOR OP ROUTINE REF MMATINV MONADIC MATRIX INVERT OP ROUTINE REF MRAVEL MONADIC RAVEL OP ROUTINE REF MREVERSE MONADIC REVERSE OP ROUTINE REF MTBAR MONADIC T-BAR OP ROUTINE REF MTRANS MONADIC TRANSPOSE OP ROUTINE REF MXRETURN MONADIC EXECUTION DRIVER RETURN REF OPBREAK OP BREAK HANDLER REF OPER OPERATOR WORDS REF OPRTEMPS TEMPS ARE IN WINDOW IN APLUTSI U08-0006 REF RESULT RESULT PNTR REF RETURN RETURN ADR CELL REF RTARG RIGHT ARG PNTR REF SYSTERR SYSTEM ERROR REF XSEGBASE XSEG BASE REF XSEGBRK XSEG BREAK FLAG PAGE * * * A S S E M B L Y P A R A M E T E R S * * SYSTEM SIG5F PROGSECT CSECT 1 OPR@ RES 0 START OF PROCEDURE BASEADR EQU % BASE ADR FOR SHORT ADR OFFSETS * * REGISTERS * IX EQU 0 INTERPRET REG PAIR IX1 EQU 1 * N EQU 1 XSEG EXECUTION-TIME INDEX X EQU 1 GENERAL INDEX REG T EQU 2 TYPE XL EQU 3 XSEG LOC A EQU 4 ARG ADR/INDEX LX EQU 5 INDEX LINK REG LX7 EQU 7 INDEX LINK REG OP EQU 6 OP CODE INDEX AI EQU 7 ACCUM FOR LOGL/CHAR/INTG VALUES AF EQU 6 ACCUM FOR FLOT VALUES AF1 EQU 7 * BI EQU 9 2ND ACCUM FOR LOGL/CHAR/INTG VALUES BF EQU 8 2ND ACCUM FOR FLOT VALUES BF1 EQU 9 * BUF EQU 7 BUFFER FOR MOVING DATA/CODE GROUPS R EQU 8 GENERAL WORK REG S EQU 11 SIZE L3 EQU 12 LINK REG L2 EQU 13 LINK REG L1 EQU 14 LINK REG * * ARG TYPE CODES * WORDLOGL EQU 0 WORD LOGICAL (WORD) LOGL EQU 1 LOGICAL (BIT) CHAR EQU 2 CHARACTER (BYTE) INTG EQU 3 INTEGER (WORD) FLOT EQU 4 FLOATING (DOUBLEWORD) ISEQ EQU 5 INDEX SEQUENCE VECTOR LIST EQU 6 LIST * * CODESTRING DESIGNATIONS * MOPLOW EQU 50 MONADIC OPS: LOW END MOPROLL EQU 51 MONADIC ROLL MOPEXP EQU 65 MONADIC EXPONENTIAL MOPCEIL EQU 68 MONADIC CEILING MOPABS EQU 70 MONADIC ABSOLUTE VALUE MOPFACT EQU 71 MONADIC FACTORIAL DOPLOW EQU 80 DYADIC OPS: LOW END DOPADD EQU 91 DYADIC ADD DOPMUL EQU 93 DYADIC MULTIPLY DOPDIV EQU 94 DYADIC DIVIDE DOPPOWER EQU 95 DYADIC POWER DOPMAX EQU 98 DYADIC MAXIMUM DOPRESID EQU 100 DYADIC RESIDUE DOPLESS EQU 102 DYADIC LESS DOPNEQ EQU 106 DYADIC NOT EQUAL DOPAND EQU 108 DYADIC AND DOPNAND EQU 110 DYADIC NAND PAGE * * * P R O C S * * TLOC SET 0 U08-0008 * TEMP CNAME 1 DTEMP CNAME 2 PROC DO1 NAME=2 TLOC SET TLOC+(TLOC&1) U08-0011 DISP TLOC U08-0012 LF EQU OPRTEMPS+TLOC U08-0013 TLOC SET TLOC+NAME U08-0014 PEND * * EVEN CNAME 0 ODD CNAME 1 PROC LF EQU % ERROR,1,(CF(2)+NAME)&1 'REGISTER HAS WRONG PARITY' PEND * * EQUAL CNAME PROC LF EQU % ERROR,1,1-(CF(2)=CF(3)) 'REGISTERS MUST BE EQUAL' PEND * * EXCHANGE CNAME OPEN I,K,GROUP GROUP EQU LFARG,LFTYPE,LFSIZE,LFRANK,LFADR PROC LF EQU % I DO NUM(AF) K SET SCOR(AF(I),ARGS,TYPES,SIZES,RANKS,ADRS) ERROR,1,K=0 'UNKNOWN GROUP INDICATOR' LW,R GROUP(K) XW,R GROUP(K)+1 STW,R GROUP(K) FIN PEND CLOSE I,K,GROUP * * NB CNAME X'680' NBGE CNAME X'681' NBLE CNAME X'682' NBE CNAME X'683' NBL CNAME X'691' NBG CNAME X'692' NBNE CNAME X'693' PROC ERROR,1,(AF>=0)+(NUM(AF)>1) 'AF MUST BE NEG CONST ADR' LF GEN,12,20 NAME-1,AF PEND PAGE * * * XSEG GEN PROCS * * CODE CNAME PROC DO CF(2)>0 LF GEN,4,12,16 CF(2),CF(2),AF(1)-BASEADR ELSE LF GEN,32 0 FIN PEND * * GENX CNAME PROC LF INT,IX AF BCR,15 %+4 LM,BUF BASEADR,IX1 STM,BUF 0,XL AW,XL IX PEND * * OPEN GEN GEN CNAME OPEN M,N,MN,I PROC LF EQU % ERROR,1,1-(NUM(CF)=3) 'WRONG NUMBER OF CF ARGS' M SET CF(2) N SET CF(3) MN SET M+N ERROR,1,1-(NUM(AF)=(M>0)+(N>0)) 'WRONG NUMBER OF AF ARGS' DO M>0 I DO N LW,AF(1)+M+I-1 AF(2)+I-1 FIN I DO MN*(MN<3) STW,AF(1)+I-1 I-1,XL ELSE LCI MN STM,AF(1) 0,XL FIN ELSE I DO MN*(MN<3) LW,BUF AF(1)+I-1 STW,BUF I-1,XL ELSE LCI N LM,BUF AF(1) STM,BUF 0,XL FIN FIN AI,XL MN PEND CLOSE M,N,MN,I PAGE * * * TABLE BUILDING PROCS * * TABLE CNAME OPEN T,N PROC T SET %-AF(1) LF EQU T DISP T PEND * * ITEM CNAME PROC N SET T+AF(1)-% ERROR,1,N<0 'ITEM OUT OF SEQUENCE' RES N*(N>0) DISP AF(1) PEND CLOSE T,N PAGE * * * O P E R A T O R E X E C U T I O N D R I V E R S * * USECT PROGSECT * * * MONADIC EXECUTION DRIVER * * ENTERED WITH OPTYPE IN 'OP' REGISTER, AND THE ARG * POINTER IN RTARG. IF NO ERRORS OCCUR, IT RETURNS * TO 'MXRETURN' WITH THE RESULT POINTER IN 'RESULT'. * ERRORS LEAD TO ERDOMAIN, ERRANK, OR ERLENGTH. * * MXDRIVER EQU % MONADIC EXECUTION DRIVER LI,A MXRETURN SET UP RETURN ADR STW,A RETURN CI,OP DOPLOW CHECK OP RANGE BL MXTABLE,OP LOW: GO DIRECTY INTO JUMP TABLE AI,OP MOPLOW-DOPLOW HIGH: SHIFT TO LOWER RANGE FIRST STW,OP OPER SAVE MODIFIED OP (FOR 'INTGOVFL') B MXTABLE,OP * MXTABLE TABLE MOPLOW MONADIC OP JUMP TABLE B MMATINV MONADIC MATRIX INVERT B MROLL MONADIC ROLL B MTBAR MONADIC TYPE CONVERSION B ERSYN UNUSED (REDUCTION, 1ST COORD) B ERSYN UNUSED (REDUCTION) B MINDEX MONADIC INDEX GENERATOR B MDIMEN MONADIC DIMENSION B MRAVEL MONADIC RAVEL AI,OP 1 MONADIC REVERSE (1ST COORD) B MREVERSE MONADIC REVERSE B MTRANS MONADIC TRANSPOSE B MNOP MONADIC PLUS B MMINUS MONADIC MINUS B MSIGNUM MONADIC SIGNUM B MRECIP MONADIC RECIPROCAL B MEXP MONADIC EXPONENTIAL B MLOG MONADIC LOGARITHM B MPITIMES MONADIC PI TIMES B MCEILING MONADIC CEILING B MFLOOR MONADIC FLOOR B MABS MONADIC ABSOLUTE VALUE B MFACT MONADIC FACTORIAL BAL,15 SYSTERR UNUSED BAL,15 SYSTERR UNUSED B MIBEAM MONADIC I-BEAM B MGRADEUP MONADIC GRADE UP B MGRADEDN MONADIC GRADE DOWN B MCOMPL MONADIC COMPLEMENT BAL,15 SYSTERR UNUSED BAL,15 SYSTERR UNUSED PAGE * * * DYADIC OPERATOR EXECUTION DRIVER * * ENTERED WITH OPTYPE IN 'OP' REGISTER, AND THE ARG * POINTERS IN LFARG AND RTARG. IF NO ERRORS OCCUR, * IT RETURNS TO 'DXRETURN' WITH THE RESULT POINTER * IN 'RESULT'. ERRORS LEAD TO ERDOMAIN, ERRANK, OR * ERLENGTH. * * DXDRIVER LI,A DXRETURN SET UP RETURN ADDRESS STW,A RETURN B DXTABLE,OP BRANCH TO APPROPRIATE OP ROUTINE * DXTABLE TABLE DOPLOW DYADIC OP JUMP TABLE B DMATDIV DYADIC MATRIX DIVIDE B DDEAL DYADIC DEAL B DTBAR DYADIC TYPE CONVERSION AI,OP 1 DYADIC COMPRESSION (1ST COORD) B DCOMPRES DYADIC COMPRESSION B DINDEXOF DYADIC INDEX OF B DRESHAPE DYADIC RESHAPE B DCATEN DYADIC CATENATE/LAMINATE AI,OP 1 DYADIC ROTATE (1ST COORD) B DROTATE DYADIC ROTATE B DTRANS DYADIC TRANSPOSE B DADD DYADIC ADD B DSUB DYADIC SUBTRACT B DMUL DYADIC MULTIPLY B DDIV DYADIC DIVIDE B DPOWER DYADIC POWER B DLOG DYADIC LOGARITHM B DCIRC DYADIC CIRCULAR B DMAXIMUM DYADIC MAXIMUM B DMINIMUM DYADIC MINIMUM B DRESIDUE DYADIC RESIDUE B DCOMB DYADIC COMBINATORIAL B DLESS DYADIC LESS B DLESSEQ DYADIC LESS OR EQUAL B DGREAT DYADIC GREATER B DGREATEQ DYADIC GREATER OR EQUAL B DNEQUAL DYADIC NOT EQUAL B DEQUAL DYADIC EQUAL B DAND DYADIC AND B DOR DYADIC OR B DNAND DYADIC NAND B DNOR DYADIC NOR BAL,15 SYSTERR UNUSED BAL,15 SYSTERR UNUSED B DDECODE DYADIC DECODE B DENCODE DYADIC ENCODE B DTAKE DYADIC TAKE B DDROP DYADIC DROP AI,OP 1 DYADIC EXPAND (1ST COORD) B DEXPAND DYADIC EXPAND B DMEMBER DYADIC MEMBERSHIP * * * MONADIC NO-OP ROUTINE (RESULT = ARG) * MNOP EQU % LW,A RTARG GET RIGHT ARG PNTR MTW,1 1,A BUMP ITS REF COUNT STW,A RESULT STORE AS RESULT PNTR B *RETURN RETURN PAGE * * * M O N A D I C S C A L A R O P R O U T I N E S * * MMINUS EQU % MONADIC MINUS LI,T ISEQ IS ARG AN ISEQ ? CB,T *RTARG BNE 16Z1 NO, HANDLE NORMALLY BAL,XL BILDISEQ YES, BUILD ISEQ RESULT LI,OP DOPMUL+1 SET OP CODE TO FALL INTO * RANGE OF ISEQ TABLES * (RETURNS IF ISEQOVFL). 16Z1 LI,OP MOPABS+1 FIX OP TO FALL INTO ABS/NEG RANGE * MABS EQU % MONADIC ABSOLUTE VALUE BAL,LX MTYPEIF ALLOW NUMERIC ARG; RESULT = I/F AI,OP -2 INTG: MODIFY OP BAL,L2 MSETUP FLOT; SET UP ADDRESSES BAL,L1 GXSEGML GEN INIT XSEG CODE LW,IX MOPTBL2,OP GEN LOAD MINUS/ABS OF ARG BAL,LX CHANGOP CI,OP MOPABS IF IT'S INTG, BL GXOVSTEX GEN OVFL TEST CODE B GXSTEXEC GEN STORE, ETC. * * MOPTBL2 TABLE MOPABS-2 I/F MINUS/ABS TABLE LAW,AI AI I ABS LCW,AI AI I MINUS LAD,AF AF F ABS LCD,AF AF F MINUS PAGE * * MEXP EQU % MONADIC EXPONENTIAL MLOG EQU % MONADIC LOGARITHM MPITIMES EQU % MONADIC PI TIMES BAL,L1 MTYPEF SET UP TYPES; RESULT = FLOT MONOP1 BAL,L2 MSETUP SET UP ADDRESSES BAL,L1 GXSEGML GEN LOAD/CONVERT LW,R MOPTBL3,OP GEN BAL TO EVAL ROUTINE GEN,1,0 R B GXSTEXEC GEN STORE, ETC. * * MOPTBL3 TABLE MOPEXP BAL,LX FEXP F EXP BAL,LX FLOG F LOG FML,AF FLOTPI PI TIMES BAL,L1 FCEILING F CEILING BAL,LX FFLOOR F FLOOR BAL,LX IFACT I FACTORIAL BAL,LX FFACT F FACTORIAL BAL,LX IROLL I ROLL * * MROLL EQU % MONADIC ROLL BAL,L1 MTYPEI SET UP TYPES, RESULT = INTG AI,OP MOPFACT+1-MOPROLL MODIFY OP (TO SHARE OP TABLE) B MONOP1 HENCEFORTH, TREAT LIKE 'EXP', ETC. * * MFACT EQU % MONADIC FACTORIAL BAL,LX MTYPEIF SET UP TYPES, RESULT = INTG/FLOT BDR,OP MONOP1 INTG: MODIFY OP, FINISH LIKE EXP B MONOP1 FLOT: FINISH LIKE EXP PAGE * * MSIGNUM EQU % MONADIC SIGNUM LI,T LOGL IF ARG IS LOGL, CB,T *RTARG SIGNUM(ARG) = ARG. BE MNOP BAL,L1 MTYPEI SET TYPES; RESULT = INTG BAL,L2 MSETUP SET ADRS LW,T RTTYPE SET RSTYPE SO THAT ARG'S STW,T RSTYPE WONT BE CONVERTED. BAL,L1 GXSEGML GEN LOAD GEN,0,5 SIGCODE GEN SIGNUM CODE SEQUENCE AWM,XL -2,XL FILL IN BRANCH ADDRESSES AWM,XL -4,XL AWM,XL -5,XL LI,T INTG SET TO STORE BY SIGNUM'S STW,T RSTYPE RESULT TYPE (INTG). B GXSTEXEC GEN STORE, ETC. * * SIGCODE EQU % SIGNUM CODE SEQUENCE NBG -1 (%+4) -5 BEZ 0 (%+4) -4 LI,AI -1 -3 B 0 (%+2) -2 LI,AI +1 -1 PAGE * * MRECIP EQU % MONADIC RECIPROCAL BAL,L1 MTYPEF SET TYPES, RESULT = FLOT BAL,L2 MSETUP SET ADDRESSES BAL,LX GXSEGINI GEN XSEG INIT CODE LI,T FLOT IF ARG IS NOT FLOT, CW,T RTTYPE BE 15Z1 LI,A 1 LOAD/CONVERT IT, BAL,L2 GENLOADT STORE IT IN TEMP. 15Z1 LD,R RECIPINS GEN: LD,AF =1.0 AW,R+1 RTADR FDL,AF ARG (OR TEMP) GEN,2,0 R B GXSTEXEC GEN STORE, ETC. * * BOUND 8 RECIPINS LD,AF FLOT1 RECIPROCAL CODE SEQ FDL,AF 0 PAGE * * MFLOOR EQU % MONADIC FLOOR MCEILING EQU % MONADIC CEILING AW,OP =X'80000000' SET 1ST-TIME FLAG; 'INTGOVFL' WILL * RESTORE OP WITH THIS FLAG RESET. BAL,LX MTYPEIF SET TYPES, RESULT = INTG/FLOT B MNOP INTG (I/L): NO-OP (RESULT=ARG) AI,OP 0 FLOT: IS THIS 1ST TIME ? BGEZ MSETRT NO,DO IT IN FL. DOMAIN MTW,INTG-FLOT RSTYPE YES, SET UP ADDRESSES FOR INTEGER BAL,L2 MSETUP RESULT, AND ATTEMPT OPERATION BAL,LX GXSEGINI LW,R RTADR IN INTG DOMAIN. AW,R LOADINST+FLOT LOAD IT (FLOT) LW,R+1 MOPTBL4,OP GEN BAL ICELING/IFLOOR GEN,2,0 R B GXSTEXEC GEN STORE, ETC. MSETRT STW,T RTTYPE SET RTTYPE TO FL. B MONOP1 * * MOPTBL4 TABLE MOPCEIL INTG FLOOR/CEILING SEQ TABLE BAL,L1 ICEILING I CEILING BAL,LX IFLOOR I FLOOR PAGE * * MCOMPL EQU % MONADIC COMPLEMENT LI,T LOGL IF ARG IS LOGL, DO IT WORD-WISE CB,T *RTARG BE 17Z1 BAL,L1 MTYPEL NOPE - SET UP TYPE, RESUL = LOGL B 17Z2 SET ADR AND DO IT BIT-WISE. 17Z1 STW,T RSTYPE WORDWISE: SET ARG TYPE TO LI,T WORDLOGL 'WORD LOGICAL' FOR ADDRESSING STW,T RTTYPE 'EM 32 BITS AT A TIME. 17Z2 BAL,L2 MSETUP BAL,L1 GXSEGML GEN BIT/WORD LOAD GEN,0,1 EORINST GEN: EOR,AI =-1 B GXSTEXEC GEN BIT/WORD STORE, ETC. PAGE * * * D Y A D I C S C A L A R O P R O U T I N E S * * DADD EQU % DYADIC ADD DSUB EQU % DYADIC SUBTRACT DMUL EQU % DYADIC MULTIPLY LW,X COPTRIG IF WE'RE DOING A COMPOSITE OP, BLZ NORMALOP DON'T DO SPECIAL CASING. LI,T ISEQ IS LEFT ARG AN 'INDEX SEQUENCE' ? CB,T *LFARG BNE 8Z2 NO, CHECK RIGHT ARG CB,T *RTARG YES, IS RIGHT ARG ALSO ISEQ ? BNE 8Z1 NO CI,OP DOPMUL YES, BOTH ARGS ARE ISEQ'S. WE MAY BE NORMALOP ADD OR SUBTRACT THEM, BUT NOT MUL. BAL,XL BILDISEQ FORM RESULTANT ISEQ B ISEQ1 B NORMALOP OVFL: DO IT NORMALLY 8Z1 LH,R *RTARG LEFT ARG IS ISEQ. IS RIGHT ARG U08-0016 CLM,R LISCALAR AN INTEGER OR LOGICAL SCALAR ? U08-0017 BCR,12 8Z3 U08-0018 BNE NORMALOP NO, DO NORMALLY U08-0019 8Z3 BAL,XL BILDISEQ YES, FORM RESULT ISEQ U08-0020 XW,X T SWAP PTRS B NORMALOP OVFL: DO IT NORMALLY 8Z2 CB,T *RTARG LEFT ARG NOT ISEQ; IS RIGHT ARG ? BNE NORMALOP NO LH,R *LFARG YES, IS LEFT ARG AN INTEGER U08-0022 CLM,R LISCALAR OR LOGICAL SCALAR ? U08-0023 BCR,12 8Z4 U08-0024 BNE NORMALOP NO, DO NORMALLY U08-0025 8Z4 BAL,XL BILDISEQ YES, FORM RESULT ISEQ U08-0026 NOP DON'T SWAP ARG PTRS * OVFL: DO IT NORMALLY * * NORMALOP EQU % NORMAL ADD/SUB/MUL BAL,LX DTYPEIF ALLOW NUMERIC ARGS; RSTYPE= I/F AI,OP -3 INTG: MODIFY OP DYOP1 BAL,L2 DSETUP EXAMINE ARG SHAPES; GET RS DATA BLOK BAL,L3 GXSEGDL GEN 1ST PART OF XSEG: LOADS/CONVERTS AW,R DOPTBL2,OP IN-LINE: BUILD OP GEN,1,0 R GEN 'OP RTADR' CI,OP DOPADD IF IT'S INTEGER, BL GXOVSTEX GEN OVERFLOW TEST CODE. B GXSTEXEC * * DDIV EQU % DYADIC DIVIDE BAL,L1 DTYPEF ALLOW NUMERIC ARGS; RSTYPE= F B DYOP1 CONTINUE AS FOR '+' ETC. * * DOPTBL2 TABLE DOPADD-3 ADD/SUB/MUL/DIV TABLE ODD,AI AW,AI 0 I ADD SW,AI 0 I SUBTRACT MW,AI 0 I MULTIPLY FAL,AF 0 F ADD FSL,AF 0 F SUBTRACT FML,AF 0 F MULTIPLY FDL,AF 0 F DIVIDE * U08-0028 * U08-0029 BOUND 8 U08-0030 LISCALAR DATA LOGL**8+0,INTG**8+0 LOGICAL/INTEGER SCALAR HEADINGSU08-0031 PAGE * * DLOG EQU % DYADIC LOGARITHM BAL,L1 DTYPEF ALLOW NUMERIC ARGS; RSTYPE= F B DYOP2 * * DRESIDUE EQU % DYADIC RESIDUE DCOMB EQU % DYADIC COMBINATORIAL DYOP5 BAL,LX DTYPEIF ALLOW NUMERIC ARGS; RSTYPE= I/F DYOP6 AI,OP -2 INTG: MODIFY OP INDEX DYOP2 BAL,L2 DSETUP SET UP SIZES, ADRS DYOP7 BAL,L3 GXSEGDL GEN LOAD LEFT, CONVERTS LW,T RSTYPE AW,R LODBINST,T GEN LOAD RIGHT LW,R+1 DOPTBL3,OP GEN,2,0 R BAL,.. EVALUATOR B GXSTEXEC GEN STORE, ETC. * * DOPTBL3 TABLE DOPPOWER-2 I/F - POWER/LOG/RES/COMB TABLE BAL,LX IIPOWER I POWER ITEM DOPPOWER BAL,LX FFPOWER F POWER BAL,LX FFLOG F LOG ITEM DOPRESID-2 BAL,LX IIRESIDU I RESIDUE BAL,LX IICOMB I COMBINATORIAL BAL,LX FFRESIDU F RESIDUE BAL,L1 FFCOMB F COMBINATORIAL PAGE * * DPOWER EQU % DYADIC POWER LW,X COPTRIG IF WE'RE DOING A COMPOSITE OP, BLZ DYOP5 DON'T DO SPECIAL CASING. LI,R INTG**8+0 IS RIGHT ARG AN CH,R *RTARG INTEGER SCALAR ? BE 12Z3 YES, SEE IF IT'S 2 LI,R FLOT**8+0 NO, IS IT A CH,R *RTARG FLOATING POINT SCALAR ? BE 12Z1 YES, SEE IF IT'S 2.0 OR 0.5 NORMPWR BAL,LX DTYPEIF NO, CHECK TYPES; RSTYPE = I/F B DYOP6 I*I: HANDLED LIKE I-COMB/RESIDUE BAL,L2 DSETUP I*F, F*I, OR F*F: SET UP STUFF LI,T FLOT CW,T RTTYPE CHECK RIGHT ARG TYPE BE DYOP7 F*F OR I*F: TREAT LIKE F-COMB/RESID BAL,LX GXSEGINI F*I: GEN XSEG INIT CODE MTW,INTG-FLOT RSTYPE LI,A 1 GEN LOAD OF RIGHT ARG BAL,L1 GENLOAD IN INTG DOMAIN LW,IX LREGBI TO REGISTER 'BI'. BAL,LX CHANGREG MTW,FLOT-INTG RSTYPE GEN LOAD OF LEFT ARG LI,A 0 IN FLOT DOMAIN BAL,L1 GENLOAD TO REGISTERS 'AF/AF1'. GEN,0,1 FIPWRINS GEN: BAL,LX FIPOWER B GXSTEXEC GEN STORE, ETC. * 12Z1 LI,X 2 RIGHT ARG = FLOT SCALAR LW,R *RTARG,X GET IT'S 1ST WORD CLM,R PWRLIMS IS IT 0.5 OR 2.0 ? BCR,12 12Z4 = 2.0, SQUARE LFARG (FLOT) BCS,3 NORMPWR NEITHER, DO NORMAL POWER * = 0.5, SQUARE ROOT LFARG (FLOT) EXCHANGE ARGS MAKE RTARG ACTIVE (LIKE MONADIC OPS) BAL,L1 MTYPEF PRETEND IT'S A MONADIC 'SQRT' OP 12Z2 BAL,L2 MSETUP CHECK TYPE, SET UP STUFF BAL,L1 GXSEGML GEN LOAD/CONVERT LW,R MOPTBL1,OP GET SQUARE/SQRT INST GEN,1,0 R CI,OP DOPPOWER-2 IF IT'S IN INTG DOMAIN, BE GXOVSTEX GEN OVFL TEST CODE. B GXSTEXEC GEN STORE, ETC. * 12Z3 LI,X 2 RIGHT ARG IS AN INTG SCALAR CW,X *RTARG,X IS IT 2 ? BNE NORMPWR NO, DO NORMAL POWER 12Z4 EXCHANGE ARGS = 2 (OR 2.0), TREAT LIKE A BAL,LX MTYPEIF MONADIC 'SQUARE' OP. AI,OP -1 I*2: DECR OP BY 2 BDR,OP 12Z2 F*2: DECR OP BY 1 * * MOPTBL1 TABLE DOPPOWER-2 SQUARE/SQRT INST TABLE MW,AI AI I SQUARE FML,AF AF F SQUARE BAL,LX FSQRT F SQRT * * BOUND 8 PWRLIMS DATA FS'0.5',FS'2.0' SPECIAL EXPONENT VALUES * FIPWRINS BAL,LX FIPOWER F TO I POWER INST PAGE * * DCIRC EQU % DYADIC CIRCULAR BAL,L1 DTYPEF CHECK TYPES; RESULT = FLOT TYPE BAL,L2 DSETUP SET UP SIZES/ADRS LW,X COPTRIG IF WE'RE DOING A COMPOSITE OP, BGEZ 20Z1 WE MUST GO THROUGH GXSEGDL BAL,L3 GXSEGDL AND GEN CODE TO CONVERT LFARG GEN,0,3 CIRCSEQ1 FROM FLOT IN AF TO INTG IN T. LW,R RTADR GEN LOAD (FLOT) OF RT ARG AW,R LOADINST+FLOT GEN,1,0 R B 20Z3 20Z1 BAL,LX GXSEGINI GEN XSEG INIT CODE MTW,INTG-FLOT RSTYPE GEN FETCH OF LEFT ARG LI,A 0 BAL,L1 GENLOAD IN INTG MODE. LW,IX LREGTX BAL,LX CHANGREG MOVE IT TO 'TX' (IT'S SAFE THERE) LI,S 1 CW,S LFSIZE BNE 20Z2 IF LEFT ARG IS ONE ELEMENT, GEN,0,1 STORETX SAVE LFARG OUTSIDE LOOP, STW,XL LOOPLOC GEN,0,1 LOADTX AND RESTORE IT INSIDE LOOP. 20Z2 EQU % MTW,FLOT-INTG RSTYPE GEN LOAD OF RIGHT ARG LI,A 1 BAL,L1 GENLOAD IN FLOT MODE (REG 'AF/AF1') 20Z3 EQU % GEN,0,3 CIRCSEQ GEN RANGE CHECK, INDEXED BAL B GXSTEXEC GEN STORE, ETC. * * TX EQU 3 INDEX REG FOR 'CIRCULAR' BRANCH * CIRCSEQ CLM,TX CIRCLIMS LEFT ARG RANGE CHECK BCS,9 ERDOMAIN BAL,LX CIRCULAR,TX INDEXED BAL INTO JUMP TABLE * CIRCSEQ1 BAL,LX F2I CONVERT LFARG VALUE TO INTG B ERDOMAIN LW,TX AI .. IN TX. * LOADTX LW,TX LFTEMP STORETX STW,TX LFTEMP * BOUND 8 CIRCLIMS DATA -7,+7 LEFT ARG RANGE PAGE * * DEQUAL EQU % DYADIC EQUAL DNEQUAL EQU % DYADIC NOT EQUAL * U08-0033 * SPECIAL CASE FOR CHARACTER ARGS U08-0034 * U08-0035 LW,X COPTRIG IF WE'RE DOING A COMPOSITE OP, BLZ DYOP3 DON'T DO SPECIAL CASING. LI,T CHAR CB,T *LFARG IF BOTH ARGS NUMERIC, TREAT LIKE BNE 19Z1 OTHER RELATIONALS. CB,T *RTARG IF BOTH ARGS CHARACTER, BNE 19Z2 CHAREQ STW,T LFTYPE SET ALL TYPES = CHAR STW,T RTTYPE STW,T RSTYPE B DYOP4 19Z1 CB,T *RTARG BNE DYOP8 U08-0037 19Z2 LI,T LOGL TYPES MIXED, STW,T RSTYPE RESULT = ALL 0'S OR ALL 1'S. LI,T WORDLOGL (STORED 32 BITS AT A TIME, STW,T LFTYPE OF COURSE). STW,T RTTYPE BAL,L2 DSETUP BAL,LX GXSEGINI LW,R DOPTBL7,OP GEN,1,0 R GEN LI,AI 0/1 B GXSTEXEC * * DLESS EQU % DYADIC LESS DGREAT EQU % DYADIC GREATER DLESSEQ EQU % DYADIC LESS OR EQUAL DGREATEQ EQU % DYADIC GREATER OR EQUAL * U08-0039 * SPECIAL CASE FOR LOGICAL ARGS U08-0040 * U08-0041 LW,X COPTRIG IF WE'RE DOING A COMPOSITE OP, U08-0042 BLZ DYOP3 DON'T DO SPECIAL CASING. U08-0043 DYOP8 LI,T LOGL U08-0044 CB,T *LFARG TEST FOR BOTH-ARGS-LOGICAL U08-0045 BNE DYOP3 U08-0046 CB,T *RTARG U08-0047 BNE DYOP3 U08-0048 STW,T RSTYPE BOTH ARGS LOGL: SET UP TO DO U08-0049 LI,T WORDLOGL OP 32 BITS AT A TIME WITH U08-0050 STW,T LFTYPE LOGICAL OPERATORS. U08-0051 STW,T RTTYPE U08-0052 ERROR,0,1-((DOPLESS&7)=6) 'NEXT INST WONT WORK' U08-0053 CI,OP 2 SINGLES OUT > AND >= OPS U08-0054 BANZ 19Z4 FOR > AND >= SWAP ARGS AND U08-0055 EXCHANGE ARGS TREAT AS < AND <=. U08-0056 19Z4 BAL,L2 DSETUP SET UP ARG/RESULT PARAMS U08-0057 BAL,L3 GXSEGDL GEN LOAD OF LF ARG U08-0058 CI,OP DOPNEQ FOR ALL EXCEPT 'NOT =' U08-0059 BE 19Z5 GEN 'NOT' OPERATION. U08-0060 GEN,0,1 EORINST U08-0061 19Z5 LW,R DOPTBL8,OP GEN AND/OR/EOR OF RT ARG U08-0062 AW,R RTADR U08-0063 GEN,1,0 R U08-0064 B GXSTEXEC GEN STORE/LOOP CODE; EXECUTE XSEG U08-0065 * U08-0066 * GENERAL CASE U08-0067 * U08-0068 DYOP3 BAL,LX DTYPEIF ALLOW NUMERIC ARGS; RSTYPE= I/F B DYOP4 INTG BAL,L3 DSETUPL FLOT: SET UP LOGL DB BAL,L3 GXSEGDL GEN LOAD LEFT AW,R LODBINST+FLOT GEN LOAD OF RIGHT ARG GEN,1,1 R,BALCOMP GEN FUZZ APPLIER LI,R BF SET NEW RT ADR = REG 'BF' B GENCOMP DYOP4 BAL,L3 DSETUPL INTG: SET UP LOGL DB BAL,L3 GXSEGDL GEN LOAD LEFT GENCOMP LW,T RSTYPE AW,R COMPINST,T GEN COMPARE INST LW,R+1 DOPTBL4,OP GET BRANCH INST GEN,2,4 R,STCCSEQ GEN: C..,AF RTARG AWM,XL -3,XL B.. %+3 (TRUE) * LI,AI 0 (FALSE) AWM,XL -5,XL B %+2 * LI,AI -1 * BAL,LX STLOGLRS LI,T LOGL RESTORE CORRECT RESULT TYPE XW,T RSTYPE CI,T CHAR BNE 19Z3 LW,R COPTRIG IF IT'S A CHARACTER COMPARISON, BLZ 19Z3 BEING DONE AS A SCALAR OP, LI,R 3 AW,R RSSIZE SET RSSIZE = NEXT HIGHER AND,R =-4 MULTIPLE OF FOUR CHARS. STW,R RSSIZE 19Z3 BDR,XL GXSTEXEC DISCARD BAL...STLOGLRS, DO NORMAL * STORE GEN (BECAUSE OF COMPOSITE OPS). * * DSETUPL LI,T LOGL SET RSTYPE=LOGL XW,T RSTYPE SAVE OLD RSTYPE (INTG/FLOT) STW,T TYPETEMP BAL,L2 DSETUP NOW DO NORMAL DYADIC SETUP LW,T TYPETEMP RESTORE OLD RSTYPE STW,T RSTYPE B *L3 RETURN * TYPETEMP TEMP TEMP FOR SAVING RSTYPE * * DOPTBL4 TABLE DOPLESS RELATIONAL BRANCH TABLE NBL -2 < NBLE -2 <= NBG -2 > NBGE -2 >= NBNE -2 NOT = NBE -2 = * * DOPTBL7 TABLE DOPNEQ INST TABLE FOR 1='A' AND THE LIKE LI,AI -1 NOT EQUAL LI,AI 0 EQUAL * U08-0070 * U08-0071 DOPTBL8 TABLE DOPLESS INST TBL FOR LOGL RELATIONALS U08-0072 AND,AI 0 A < B LW A; EOR =-1; AND B U08-0073 OR,AI 0 A <= B LW A; EOR =-1; OR B U08-0074 AND,AI 0 A > B LW B; EOR =-1; AND A U08-0075 OR,AI 0 A >= B LW B; EOR =-1; OR A U08-0076 EOR,AI 0 A NOT= B LW A; EOR B U08-0077 EOR,AI 0 A = B LW A; EOR =-1; EOR B U08-0078 * * STCCSEQ EQU % CODE FOR END OF RELAT OP LI,AI 0 -4 NB -1 (%+2) -3 LI,AI -1 -2 BAL,LX STLOGLRS -1 * * BALCOMP BAL,LX FFCOMPAR FUZZIFIER * * COMPINST TABLE CHAR COMPARE INST - BY MODE: CB,AI 0 CHAR CW,AI 0 INTG CD,AF 0 FLOT PAGE * * DAND EQU % DYADIC AND DOR EQU % DYADIC OR DNAND EQU % DYADIC NAND DNOR EQU % DYADIC NOR LW,X COPTRIG IF WE'RE DOING A COMPOSITE OP, BLZ 11Z1 DON'T DO SPECIAL CASING. LI,T LOGL ARE BOTH TYPES LOGL ? CB,T *LFARG BNE 11Z1 NO CB,T *RTARG BE 11Z2 YES 11Z1 BAL,L1 DTYPEL NO: SET UP TYPES B 11Z3 JOIN OTHER CASE 11Z2 STW,T RSTYPE BOTH ARGS LOGL: SET THEIR TYPES TO LI,T WORDLOGL STW,T RTTYPE 'WORD LOGICAL' FOR ADDRESSING STW,T LFTYPE THEM 32 BITS AT A TIME. 11Z3 BAL,L2 DSETUP BAL,L3 GXSEGDL GEN LOADS/CONVERTS AW,R DOPTBL6,OP GEN AND/OR INST (DOES 1 OR 32 OPS) GEN,1,0 R CI,OP DOPNAND IS 'NEGATE' NEEDED ? BL GXSTEXEC NO, GEN STORE, ETC. GEN,0,1 EORINST YES, GEN NEGATE-ALL-BITS INST B GXSTEXEC GEN STORE, ETC. * * DOPTBL6 TABLE DOPAND AND/OR/NAND/NOR INST TABLE AND,AI 0 AND OR,AI 0 OR AND,AI 0 NAND (FOLLOWED BY NEGATE) OR,AI 0 NOR (FOLLOWED BY NEGATE) * EORINST EOR,AI =-1 LOGICAL NEGATE INST (ALL 32 BITS) PAGE * * DMINIMUM EQU % DYADIC MINIMUM DMAXIMUM EQU % DYADIC MAXIMUM BAL,LX DTYPEIF CHECK TYPES NOP (DONT CARE IF IT'S I OR F) BAL,L2 DSETUP SET UP SIZES/ADDRESSES BAL,L3 GXSEGDL GEN LOADS/CONVERTS LW,T RSTYPE AW,R COMPINST,T GEN: COMPARE RTADR LW,R+1 DOPTBL5,OP BLE/BGE %+2 LW,R+2 LOADINST,T LOAD RTADR AW,R+2 RTADR GEN,3,0 R AWM,XL -2,XL B GXSTEXEC GEN STORE, ETC. * * DOPTBL5 TABLE DOPMAX MAX/MIN TABLE BGE 0 (%+2) MAX BLE 0 (%+2) MIN PAGE * * * T Y P E C H E C K I N G R O U T I N E S * * * MONADIC I/F TYPE * * ALLOWS A NUMERIC (RIGHT) ARG. SETS RTTYPE TO ARG * TYPE AND RSTYPE TO RESULT TYPE (INTG FOR LOGL/INTG * ARG, FLOT FOR FLOT ARG). LINK IS LX; RETURNS TO * BAL+1 FOR I/L ARG, BAL+2 FOR F ARG. * MTYPEIF EQU % NUMERIC ARG, I/F RESULT STW,LX TYPELINK SAVE LINK IN CASE OF INTGOVFL LB,X *RTARG GET ARG TYPE STW,X RTTYPE SAVE IT B %+1-LOGL,X TEST IT: B 13Z1 L RSTYPE = I B ERDOMAIN C NOT ALLOWED B 13Z2 I RSTYPE = I B 13Z3 F RSTYPE = F B 13Z1 ISEQ TREAT AS INTG B ERDOMAIN LIST NOT ALLOWED * 13Z1 LI,X INTG LOGL: SET TYPE = INTG 13Z2 STW,X RSTYPE INTG/LOGL: RSTYPE = INTG B 0,LX INTG RETURN * 13Z3 STW,X RSTYPE FLOT: RSTYPE = FLOT B 1,LX FLOT RETURN * * * MONADIC F TYPE * * ALLOWS NUMERIC ARG; SETS RTTYPE = ARG TYPE AND * RSTYPE = FLOT. LINK IS L1. * MTYPEF EQU % NUMERIC ARG, F RESULT BAL,LX MTYPEIF ALLOW NUMERIC ARG; RSTYPE = MTW,FLOT-INTG RSTYPE INTG: CHANGE TO FLOT B *L1 FLOT: RETURN * * * MONADIC I TYPE * * ALLOWS NUMERIC ARG; SETS RTTYPE = ARG TYPE AND * RSTYPE = INTG. LINK IS L1. * MTYPEI EQU % NUMERIC ARG, I RESULT BAL,LX MTYPEIF ALLOW NUMERIC ARG; RSTYPE = NOP LI,T INTG INTG STW,T RSTYPE B *L1 RETURN * * * MONADIC L TYPE * * ALLOWS NUMERIC ARG; SETS RTTYPE = ARG TYPE AND * RSTYPE = LOGL. LINK IS L1. * MTYPEL EQU % NUMERIC ARG, L RESULT BAL,LX MTYPEIF ALLOW NUMERIC ARG; RSTYPE = NOP LI,T LOGL LOGL STW,T RSTYPE B *L1 RETURN PAGE * * * DYADIC I/F TYPE * * ALLOWS NUMERIC ARGS. SETS LFTYPE/RTTYPE TO ARG TYPES * AND RSTYPE TO RESULT TYPE (INTG FOR LOGL/INTG ARGS, * FLOT IF EITHER ARG IS FLOT). LINK IS LX; RETURNS TO * BAL+1 FOR INTG RESULT, BAL+2 FOR FLOT RESULT. * DTYPEIF EQU % NUMERIC ARGS, I/F RESULT LW,X COPTRIG IF WE'RE DOING A COMPOSITE OP, BLZ *CTYPELNK DERAIL TO SPECIAL SUBROUTINE. DTYPEIF1 LB,T *LFARG GET LEFT TYPE DTYPEIF2 STW,T LFTYPE SAVE IT LB,X *RTARG GET RIGHT TYPE STW,X RTTYPE SAVE IT B %+1-LOGL,T TEST LEFT TYPE: B 5Z1-LOGL,X L TEST RIGHT TYPE B ERDOMAIN C NOT ALLOWED B 5Z2-LOGL,X I TEST RIGHT TYPE B 5Z4-LOGL,X F TEST RIGHT TYPE B 5Z1-LOGL,X ISEQ TREAT AS INTG B ERDOMAIN LIST NOT ALLOWED * 5Z1 B 5Z6 L,L RSTYPE=I B ERDOMAIN L,C NOT ALLOWED B 5Z7 L,I RSTYPE=RTTYPE (I) B 5Z3 L,F RSTYPE=RTTYPE (F) B 5Z6 L,ISQ TREAT AS INTG B ERDOMAIN L,LST NOT ALLOWED * 5Z2 B 5Z8 I,L RSTYPE=LFTYPE (I) B ERDOMAIN I,C NOT ALLOWED B 5Z7 I,I RSTYPE=RTTYPE (I) B 5Z3 I,F RSTYPE=RTTYPE (F) B 5Z8 I,ISQ TREAT AS INTG B ERDOMAIN I,LST NOT ALLOWED * 5Z3 STW,X RSTYPE =F B 1,LX RETURN * 5Z4 B 5Z5 F,L RSTYPE=LFTYPE (F) B ERDOMAIN F,C NOT ALLOWED B 5Z5 F,I RSTYPE=LFTYPE (F) B 5Z5 F,F RSTYPE=LFTYPE (F) B 5Z5 F,ISQ TREAT AS INTG B ERDOMAIN F,LST NOT ALLOWED * 5Z5 STW,T RSTYPE =F B 1,LX RETURN 5Z6 LI,X INTG L,L RSTYPE=I 5Z7 STW,X RSTYPE =I STW,LX TYPELINK SAVE LINK IN CASE OF INTGOVFL B 0,LX RETURN 5Z8 STW,T RSTYPE =I STW,LX TYPELINK SAVE LINK IN CASE OF INTGOVFL B 0,LX RETURN * TYPELINK TEMP REMEMBER LINK FOR INTGOVFL * * * DYADIC F TYPE * * ALLOWS NUMERIC ARGS; SETS LFTYPE/RTTYPE TO ARG TYPES * AND RSTYPE TO FLOT. LINK IS L1. * DTYPEF EQU % NUMERIC ARGS, F RESULT BAL,LX DTYPEIF ALLOW NUMERIC ARGS; RSTYPE= MTW,FLOT-INTG RSTYPE INTG: CHANGE TO FLOT B *L1 FLOT: RETURN * * * DYADIC L TYPE * * ALLOWS NUMERIC ARGS; SETS LFTYPE/RTTYPE TO ARG TYPES * AND RSTYPE TO LOGL. LINK IS L1. * DTYPEL EQU % NUMERIC ARGS, L RESULT BAL,LX DTYPEIF ALLOW NUMERIC ARGS; RSTYPE= NOP LI,T LOGL LOGL STW,T RSTYPE B *L1 RETURN PAGE * * * I S E Q M A N I P U L A T I O N R O U T I N E S * * * BUILD ISEQ RESULT * * BUILDS AN ISEQ DATA BLOCK FOR THE RESULT, UNLESS * ANY OPERATION OVERFLOWS. THE OP TO BE DONE IS * SPECIFIED IN 'OP' REG, AND THE INSTRUCTION AT BAL+1 * WILL BE EXECUTED. IF THERE'S NO OVERFLOW, THIS * ROUTINE BUILDS THE RESULT AND EXITS FROM THE OP * DRIVER (THROUGH 'RETURN'); OTHERWISE, IT RETURNS TO * ITS CALLER AT BAL+2, HAVING DEREFFED THE ISEQ DB * IT ESTABLISHED FOR THE RESULT. LINK IS XL. * BILDISEQ LI,S 3 ALLOCATE DB FOR RESULT ISEQ; IT'S BAL,LX7 ALOCHNW SIZE IS HEADER + 3 WORDS. STW,A RESULT COPY RESULT DB PNTR LI,R ISEQ**8+1 SET TYPE = ISEQ, RANK = 1. STH,R *RESULT LW,T LFARG SET T= LEFT PTR LW,X RTARG SET X= RIGHT PTR EXU 0,XL SET T=SCALAR ARG, X=ISEQ ARG * ONE ARG ISEQ, OTHER IS SCALAR (IF OP DYADIC) U08-0080 LW,S 2,X GET ISEQ LENGTH STW,S 2,A SET RESULT ISEQ LENGTH LW,S 2,T GET VALUE OF INTG/LOGL SCALAR U08-0082 LI,R LOGL U08-0083 CB,R *T U08-0084 BNE 4Z1 IF IT'S LOGICAL, U08-0085 SCS,S 1 CONVERT TO INTEGER. U08-0086 AND,S =1 U08-0087 4Z1 STW,S DUMYISEQ+3 MAKE SCALAR VALUE LOOK LIKE ISEQ U08-0088 EXU ISEQTBL1,OP WITH BASE = VALUE, U08-0089 STW,S DUMYISEQ+4 AND STEP = 0 (+-) OR VALUE (*). U08-0090 LI,T DUMYISEQ T= NEW ISEQ PTR U08-0091 EXU 0,XL RESET T=LEFT, X=RIGHT 4Z2 LW,S 3,T GET LEFT BASE/VAL U08-0093 ISEQ2 EXU ISEQTBL2,OP ADD/SUB/MUL RIGHT BASE/VAL BNOV 4Z3 U08-0095 B ISEQOVFL * BOTH ARGS ISEQ (DYADIC OPS ONLY) U08-0097 ISEQ1 LW,S 2,X BOTH ARGS ISEQ, STW,S 2,A COPY SIZE TO RESULT ISEQ CW,S 2,T AND MAKE SURE SIZES AGREE. BE 4Z2 U08-0099 B ERLENGTH 4Z3 STW,S 3,A SET RESULT ISEQ BASE U08-0101 AI,X 1 POINT TO STEP LW,S 4,T GET LEFT STEP/VAL EXU ISEQTBL2,OP ADD/SUB/MUL RIGHT STEP/VAL BOV ISEQOVFL STW,S 4,A SET RESULT ISEQ STEP MW,S 2,A MAKE SURE RESULT ISEQ BOV ISEQOVFL REPRESENTS COMPUTABLE INTEGERS. AW,S 3,A BNOV *RETURN RETURN * ISEQOVFL LI,A 0 OVFL: DISCARD ISEQ PNTR, XW,A RESULT BAL,LX7 DREF DE-REF ISEQ DATA BLOCK, B 1,XL AND RETURN. * * ISEQTBL1 TABLE DOPADD EXU TABLE TO SET 'STEP' OF SCALAR LI,S 0 DYADIC ADD LI,S 0 DYADIC SUBTRACT NOP DYADIC MULTIPLY U08-0103 B ISEQ2 MONADIC NEGATE * * ISEQTBL2 TABLE DOPADD EXU TABLE TO COMBINE BASES/STEPS AW,S 3,X DYADIC ADD SW,S 3,X DYADIC SUBTRACT MW,S 3,X DYADIC MULTIPLY LCW,S 3,X MONADIC NEGATE * U08-0105 * U08-0106 DUMYISEQ EQU LFTEMP-3 DUMMY ISEQ DATA BLOCK: ONLY WORDS U08-0107 * 3 (BASE) AND 4 (STEP) NEEDED. U08-0108 PAGE * * * INTEGER OVERFLOW * * WE ARRIVE HERE WHENEVER AN INTEGER OPERATION OVERFLOWS. * THE OPERATION IS RESTARTED IN THE FLOATING DOMAIN BY * CHANGING 'RSTYPE' FROM INTG TO FLOT AND GOING BACK TO * THE OP ROUTINE AT THE POINT WHERE IT CALLED THE TYPE * SETUP ROUTINE. * INTGOVFL EQU % LI,A 0 DISCARD RESULT PNTR STW,A XSEGBRK DON'T ALLOW BREAKS NOW XW,A RESULT DE-REF THE INTG RESULT DB BAL,LX7 DREF LW,OP OPER RESTORE THE OP CODE LI,T INTG PUT ARG TYPES BACK THE WAY THEY LB,T *LFARG STW,T LFTYPE WERE AT 'DTYPEIF' TIME. LB,T *RTARG STW,T RTTYPE LI,T FLOT SET RESULT TYPE TO FLOT STW,T RSTYPE LW,LX TYPELINK RESTORE OP ROUTINE'S LINK INTO B 1,LX TYPE SUBR; TAKE 'FLOT' RETURN. * * * FLOATING DIVIDE BY ZERO TRAP * * RESULTS IN DOMAIN ERROR IN ALL CASES EXCEPT * WHEN DOING A DYADIC DIVIDE OF 0 BY 0 (=1). * DIVZERO EQU % LI,A X'FF' MAKE SURE OP IS 'DYADIC DIVIDE' AND,A OPER CI,A DOPDIV BNE 0,LX IF NOT, DOMAIN ERROR EXIT CD,AF FLOT0 YES: MAKE SURE NUMERATOR BNEZ 0,LX WAS ZERO. LD,AF FLOT1 OK: SUBSTITUTE ANSWER OF 1.0 B 1,LX RETURN TO OK EXIT PAGE * * * O P E R A T O R S E T U P R O U T I N E S * * * MONADIC OPERATOR SETUP ROUTINE * * SETS UP FOR EXECUTION OF A MONADIC SCALAR OPERATOR. * IT IS CALLED WITH THE ARG AND RESULT TYPES SET UP * IN 'RTTYPE/RSTYPE'. LINK IS L2. * (1) ALLOCATES RESULT DATA BLOCK * (2) ESTABLISHES RESULT DIMENSIONS * (3) SETS UP THE SIZES IN 'RT/RSSIZE' AND * THE ADDRESSES IN 'RT/RSADR'. * * MSETUP EQU % LI,X 1 LB,R *RTARG,X GET ARG RANK STW,R RTRANK SAVE IT FOR 'GETSIZE' LI,A 1 BAL,LX GETSIZE GET ARG SIZE NOP (NO MATTER IF IT'S 1) STW,S RSSIZE = RESULT SIZE BAL,L1 ALOCRS ALLOCATE RESULT DATA BLOCK LW,X RSRANK BEZ 14Z2 IF RANK>0, MTW,1 RTARG MTW,1 RESULT 14Z1 LW,R *RTARG,X COPY ARG DIMENSIONS STW,R *RESULT,X TO RESULT DATA BLOCK. BDR,X 14Z1 MTW,-1 RTARG MTW,-1 RESULT 14Z2 LI,X -2 SET UP RTADR AND RSADR B SETADRS1 * * * DYADIC OPERATOR SETUP ROUTINE * * SETS UP FOR EXECUTION OF A DYADIC SCALAR OPERATOR. * IT IS CALLED WITH THE ARG AND RESULT TYPES SET UP * IN 'LF/RT/RSTYPE'. LINK IS L2. * (1) PERFORMS CONFORMABILITY CHECKS * (2) ALLOCATES RESULT DATA BLOCK * (3) ESTABLISHES RESULT DIMENSIONS * (4) SETS UP THE SIZES IN 'LF/RT/RSSIZE' AND * THE ADDRESSES IN 'LF/RT/RSADR'. * * DSETUP EQU % LW,X COPTRIG IF WE'RE DOING A COMPOSITE OP, BLZ *CSETLNK DERAIL TO SPECIAL SUBROUTINE. LI,X 1 LI,S 1 1 FOR VECTOR/SCALAR TESTS LB,R *LFARG,X GET LEFT RANK STW,R LFRANK REMEMBER IT BEZ 1Z7 IS LEFT ARG A SCALAR ? LB,R *RTARG,X NO, GET RIGHT RANK STW,R RTRANK REMEMBER IT BEZ 1Z6 IS RIGHT ARG A SCALAR ? LI,A 1 NO, GET ITS SIZE BAL,LX GETSIZE B 1Z1 IS IT A ONE-ELMT ARRAY ? BAL,LX GETLSIZE YES, GET LEFT ARG SIZE B 1Z9 IS IT 1? IF NOT, USE LEFT RANK LW,R RTRANK NO, USE HIGHEST RANK CW,R LFRANK WE'VE ALREADY GOT THE LEFT RANK BLE 1Z9 SET UP; IF IT'S THE HIGHEST, B 1Z2 GREAT; ELSE, SWITCH TO RIGHT. 1Z1 BAL,LX GETLSIZE RT ARG ISN'T 1-ELMT; GET LF ARG SIZE B 1Z3 IS LF ARG 1-ELMT ? LW,R RTRANK YES, USE RIGHT RANK 1Z2 STW,R RSRANK (SET UP RT ARG RANK/SIZE) LW,S RTSIZE LI,A 1 B 1Z9 1Z3 LW,R LFRANK BOTH ARGS MULTI-ELMT, MAKE SURE CW,R RTRANK THEY ARE SHAPED ALIKE. BNE ERRANK STW,S RSSIZE SET RESULT SIZE BAL,L1 ALOCRS GET RESULT DATA BLOCK; SET TYPE/RANK LW,X RSRANK IF RANK>0, BEZ SETADRS MTW,1 LFARG SET ARG POINTERS TO WORD BEFORE MTW,1 RTARG FIRST DIMEN. MTW,1 RESULT SET PNTR TO WORD BEFORE DIMENS 1Z4 LW,R *LFARG,X COPY ARG DIMENS TO RESULT DIMENS STW,R *RESULT,X CW,R *RTARG,X MAKE SURE ARG DIMENS AGREE BE 1Z5 MTW,-1 LFARG RESTORE POINTERS TO THEIR MTW,-1 RTARG ORIGINAL POSITION MTW,-1 RESULT B ERLENGTH 1Z5 BDR,X 1Z4 MTW,-1 LFARG RESTORE POINTERS TO THEIR MTW,-1 RTARG ORIGINAL POSITION MTW,-1 RESULT B SETADRS GO SET ADDRESSES 1Z6 STW,S RTSIZE RIGHT ARG SCALAR, SET SIZE=1 BAL,LX GETLSIZE GET LEFT ARG SIZE B 1Z9 (MULTI-ELEM) IN EITHER CASE, USE 08-00003 B 1Z9 (ONE-ELEM) LEFT RANK/SIZE/DIMENS.08-00004 1Z7 STW,S LFSIZE LEFT ARG SCALAR, SET SIZE=1 LB,R *RTARG,X GET RIGHT RANK STW,R RTRANK REMEMBER IT BEZ 1Z8 IS RT ARG SCALAR, TOO? LI,A 1 NO, GET RT ARG SIZE BAL,LX GETSIZE B 1Z9 (MULTI-ELEM) IN EITHER CASE, USE 08-00006 B 1Z9 (ONE-ELEM) RT ARG RANK/SIZE/DIMS.08-00007 1Z8 LI,R 0 SCALAR RESULT: STW,R RSRANK RANK=0 STW,S RTSIZE STW,S RSSIZE SIZE=1 BAL,L1 ALOCRS GET RESULT DATA BLOCK; SET TYPE/RANK B SETADRS GO SET ADDRESSES (NO DIMENS TO MOVE) 1Z9 STW,S RSSIZE USE LF/RT RANK LW,T A REMEMBER WHICH ARG TO USE BAL,L1 ALOCRS GET RESULT DATA BLOCK; SET TYPE/RANK LW,T LFARG,T LW,X RSRANK IF RANK>0, BEZ SETADRS MTW,1 RESULT SET PNTR TO WORD BEFORE DIMENS AI,T 1 1Z10 LW,R *T,X COPY LF/RT DIMENS STW,R *RESULT,X TO RESULT DIMENS. BDR,X 1Z10 MTW,-1 RESULT RESTORE RESULT PNTR TO NORMALCY * * * SET ARG ADDRESS CELL(S) * * 'SETADR' SETS UP LFADR IF X=-3, RTADR IF X=-2, AND * RSADR IF X=-1; LINK IS LX. 'SETADRS' SETS UP ALL * THREE; LINK IS L2. 'SETADRS1' SETS UP THE LAST * (-X) OF THEM; LINK IS L2. FOR EACH ADR CELL BEING * SET UP, THE CORRESPONDING RANK, SIZE, AND TYPE CELLS * MUST BE ESTABLISHED. * SETADRS EQU % SET UP ADDRESSES LI,X -3 SETADRS1 BAL,LX SETADR SET UP ONE ADR CELL BIR,X SETADR1 SET UP ALL THREE OF 'EM B *L2 RETURN * SETADR LI,S 1 SIZE OF 1 FOR VECTOR/SCALAR TESTS SETADR1 EQU % 3Z1 LW,A RESULT+1,X GET ARG WORD LW,T RSTYPE+1,X INITIALIZE ARG/RESULT ADDRESSES B 3Z12,T ..DEPENDS ON DATA TYPE 3Z12 TABLE WORDLOGL B 3Z11 WORD LOGICAL B 3Z10 LOGL B 3Z9 CHAR B 3Z6 INTG B 3Z4 FLOT LW,R ISEQADR,X ISEQ, SET ARG ADR = ADR OF STW,R RSADR+1,X ISEQ ELEMENT CALC ROUTINE. AI,A 4 COMPUTE ISEQ STEP-VALUE LOC STW,A LFSTEPAD+3,X SAVE IT FOR ISEQ ELEMENT ROUTINE LW,R -1,A FETCH ISEQ BASE VALUE STW,R LFVALU+3,X STORE IT FOR ISEQ ELEMENT ROUTINE B 0,LX RETURN 3Z4 EQU % CW,S RSSIZE+1,X FLOT, IS IT SCALAR? BE 3Z2 YES, USE ARG+RANK+2 INT,AI 0,A GET DB SIZE AW,A AI AI,A N**17 USE ARG+(DB SIZE),N B 3Z3 3Z11 LI,T WORDLOGL WORD LOGICAL: CHANGE RSTYPE STW,T RSTYPE TO MATCH ARGS. * IF IT'S A SCALAR OR 1-ELMT CW,S RSSIZE+1,X THING, CHANGE ITS TYPE BE 3Z13 TO (BIT) LOGL & DO NORMALLY. LW,R RSSIZE+1,X OTHERWISE, KEEP WORDLOGL TYPE, AI,R 31 CHANGE SIZES FROM BIT COUNT SLS,R -5 TO WORD COUNT; THEN CONTINUE AS STW,R RSSIZE+1,X FOR INTEGER TYPES. 3Z6 CW,S RSSIZE+1,X INTG: IS IT SCALAR? BE 3Z8 YES, USE ARG+RANK+2 AW,A RSSIZE+1,X NO, USE ARG+SIZE+RANK+2,N 3Z7 AW,A RSRANK+1,X ADD ARG RANK TO ITS ADR AI,A N**17+2 ADD 2 AND INDEX FIELD STW,A RSADR+1,X STORE ADDRESS B 0,LX DONE 3Z9 CW,S RSSIZE+1,X CHAR: IS IT SCALAR? BE 3Z8 YES, USE ARG+RANK+2 LW,A RSSIZE+1,X NO, ADVANCE SIZE TO NEXT AI,A 3 MULTIPLE OF FOUR CHARS. AND,A =-4 STW,A RSSIZE+1,X SLS,A -2 USE ARG+CEILING(SIZE/4)+RANK+2,N AW,A RESULT+1,X B 3Z7 3Z13 MTW,LOGL-WORDLOGL RSTYPE+1,X 3Z10 LW,R LOGLADR,X LOGL: USE ADDRESS OF APPROPRIATE CW,S RSSIZE+1,X (SPECIAL CASE LOGL SCALAR) 08-00009 BNE 3Z14 08-00010 LW,R SLOGLADR,X 08-00011 AI,A 1 08-00012 3Z14 EQU % 08-00013 STW,R RSADR+1,X LOGICAL LOAD/STORE ROUTINE LI,R 1 INITIALIZE LOGL COUNT TO 1 STW,R RSLGLCNT+1,X AW,A RSRANK+1,X INITIALIZE LOGL ADDRESS TO AI,A 1 ARG+RANK+1 STW,A RSLGLADR+1,X B 0,LX DONE 3Z2 AW,A RSRANK+1,X FLOT SCALAR: USE AI,A 3 ARG+RANK+(2 OR 3) AND,A =-2 (WHICHEVER IS EVEN) STW,A RSADR+1,X B 0,LX 3Z8 AW,A RSRANK+1,X SCALAR AI,A 2 USE ARG+RANK+2 3Z3 STW,A RSADR+1,X STORE ADR B 0,LX RETURN * * * GET ARG SIZE * * GETS SIZE OF LEFT (A=0) OR RIGHT (A=1) ARG TO 'S' * AND 'LFSIZE'/'RTSIZE'; COPIES ARG RANK TO 'RSRANK'. * LINK IS 'LX'. IF SIZE=1, IT RETURNS TO BAL+2; * OTHERWISE, RETURNS TO BAL+1. * 'GETLSIZE' IS ALTERNATE ENTRY WHICH SETS A=0 (LEFT). * GETLSIZE LI,A 0 SET UP LF ARG INDEX GETSIZE LI,S 1 1 TO COMPARE AGAINST DIMENS LW,R LFRANK,A GET ARG RANK STW,R RSRANK SET TENTATIVE RESULT RANK BEZ 2Z6 HANDLE ZERO-RANK CASE LW,X LFARG,A GET DIMEN PTR AI,X 1 POINT TO WORD BEFORE 1ST DIMEN 2Z1 CW,S *R,X 1:DIM BL 2Z3 11) BE 2Z2 1=DIM, CONTINUE IN THIS LOOP LI,S 0 1>DIM (DIM=0), STOP STW,S LFSIZE,A SET SIZE=0 B 0,LX RETURN TO 'NOT EQUAL 1' LOC 2Z2 BDR,R 2Z1 2Z6 STW,S LFSIZE,A SET ARG SIZE=1 B 1,LX SIZE=1 ; RETURN 2Z3 LW,S *R,X DIM>1, INITIALIZE SIZE=DIM 2Z4 BDR,R 2Z5 ARE THERE ANY MORE ? STW,S LFSIZE,A SET SIZE >1 B 0,LX NO, RETURN TO 'NOT EQUAL 1' LOC 2Z5 ODD,S MW,S *R,X SIZE = SIZE*DIM BNEZ 2Z4 CONTINUE IF NONZERO (SIZE STILL >1) STW,S LFSIZE,A SET SIZE=0 B 0,LX RETURN, SIZE NOT 1 (=0) PAGE * * * TEMPS FOR ARG SETUP * * LFADR TEMP LEFT ARG ADDRESS RTADR TEMP RIGHT ARG ADDRESS RSADR TEMP RESULT ADDRESS LFLGLADR TEMP LOGICAL WORD ADR FOR LEFT ARG RTLGLADR TEMP LOGICAL WORD ADR FOR RIGHT ARG RSLGLADR TEMP LOGICAL WORD ADR FOR RESULT LFLGLCNT TEMP LOGICAL BIT COUNT FOR LEFT ARG RTLGLCNT TEMP LOGICAL BIT COUNT FOR RIGHT ARG RSLGLCNT TEMP LOGICAL BIT COUNT FOR RESULT LFSTEPAD TEMP LEFT ISEQ STEP ADDRESS RTSTEPAD TEMP RIGHT ISEQ STEP ADDRESS LFVALU TEMP LEFT ISEQ ELEMENT VALUE RTVALU TEMP RIGHT ISEQ ELEMENT VALUE LFRANK TEMP RANK OF LEFT ARG RTRANK TEMP RANK OF RIGHT ARG RSRANK TEMP RANK OF RESULT LFSIZE TEMP SIZE OF LEFT ARG RTSIZE TEMP SIZE OF RIGHT ARG RSSIZE TEMP SIZE OF RESULT LFTYPE TEMP TYPE OF LEFT ARG RTTYPE TEMP TYPE OF RIGHT ARG RSTYPE TEMP TYPE OF RESULT PAGE * * * X S E G G E N R O U T I N E S * * * GEN XSEG INITIALIZATION CODE * * GENS 'LCW,N RSSIZE' AND DEFINES LOOP-TOP LOC. * LINK IS LX. IF THE RESULT IS NULL, THIS ROUTINE EXITS * THROUGH 'RETURN'. * GXSEGINI LI,XL XSEGBASE INIT XSEG LOC COUNTER GEN,0,1 INITINST GEN 'LCW,N RSSIZE' STW,XL LOOPLOC DEFINE TOP-OF-LOOP LOC HERE LW,S RSSIZE IS RESULT NULL ? BNEZ 0,LX NO, RETURN B *RETURN YES, EXIT FROM ENTIRE DRIVER * * * GEN MONADIC LOAD/CONVERT * * SETS UP THE XSEG LOC COUNTER AND GENS: * (1) LOOP INITIALIZATION * (2) LOAD OF ARG * (3) CONVERSION TO RESULT TYPE, IF NECESSARY * ALSO, IT ESTABLISHES THE LOOP-TOP LOC JUST AFTER (1). * LINK IS L1. * * GXSEGML EQU % BAL,LX GXSEGINI GEN INIT, SET LOOPLOC LI,A 1 GEN LOAD RIGHT ARG, CONVERT B GENLOAD TO RSTYPE; RETURN. PAGE * * * GEN DYADIC LOADS/CONVERTS * * SETS UP THE XSEG LOC COUNTER AND GENS THE FOLLOWING: * (1) LOOP INITIALIZATION * (2) CONVERSIONS (IF NECESSARY) OF EACH ARG TO * THE RESULT TYPE * (3) LOAD OF THE LEFT ARG INTO THE 'A' REG * IN ADDITION, THE ROUTINE DOES THE FOLLOWING: * (4) ESTABLISHES THE LOOP-TOP LOC (LEAVING STUFF * OUTSIDE THE LOOP WHEREVER POSSIBLE); ITEMS * (2) AND (4) MAY IMPLY GENNING LOADS/STORES * TO TEMPS * (5) LEAVES THE RIGHT ARG ADDRESS (WHICH MAY HAVE * BEEN CHANGED TO A TEMP ADR) IN 'R'. * LINK IS L3. * * GXSEGDL EQU % GEN XSEG LOADS/CONVERTS BAL,LX GXSEGINI GEN XSEG INIT CODE LW,X COPTRIG IF WE'RE DOING A COMPOSITE OP, BLZ *CLOADLNK DERAIL TO SPECIAL SUBROUTINE. LI,S 1 SIZE OF 1 FOR VECTOR/SCALAR TESTS CW,S LFSIZE BNE 6Z1 IF LEFT ARG IS A SCALAR, LI,A 0 LOAD IT TO ITS TEMP. BAL,L2 GENLOADT LI,S 1 (GENLOADT MAY CLOBBER S) 6Z1 CW,S RTSIZE BNE 6Z2 IF RIGHT ARG IS A SCALAR, LI,A 1 LOAD IT TO ITS TEMP, BAL,L2 GENLOADT THEN ESTABLISH 'TOP OF STW,XL LOOPLOC LOOP' HERE. B 6Z3 6Z2 STW,XL LOOPLOC IF RIGHT ARG IS VECTOR, 'TOP OF LW,T RTTYPE LOOP' IS HERE; CW,T RSTYPE IF IT'S OF THE WRONG TYPE, BNE 6Z4 OR IF IT'S LOGL, CI,T LOGL BNE 6Z3 LOAD (AND CONVERT) IT INTO GXSEGDL1 EQU % 6Z4 LI,A 1 ITS TEMP. BAL,L2 GENLOADT 6Z3 LI,A 0 LOAD UP LEFT ARG BAL,L1 GENLOAD LW,R RTADR RETURN WITH R= RT ADR B *L3 RETURN * * * GEN STORE AND LOOP CONTROL * * GENS STORE INTO RESULT, FOLLOWED BY BIR TO LOOP-TOP * AND XSEG EXIT INST. LINK IS LX. * GXSEGST EQU % GEN XSEG STORE, LOOP CONT LW,R RSADR GEN STORE INTO RESULT LW,T RSTYPE AW,R STORINST,T GEN,1,0 R LW,R LOOPINST AW,R LOOPLOC GEN LOOP CONTROL INST GEN,1,1 R,EXITINST GEN LOOP CONTROL AND EXIT CODE B 0,LX RETURN PAGE * * * GEN LOAD * * GENS LOAD OF LEFT (A=0) OR RIGHT (A=1) ARG FOLLOWED, * IF NECESSARY, BY CONVERSION TO 'RSTYPE'. LINK IS L1. * GENLOAD LW,R LFADR,A GET ADDRESS/INDEX FIELDS LW,T LFTYPE,A CLM,R TEMPADR BCS,9 18Z1 IF ADR IS LFTEMP/RTTEMP, AW,R LTMPINST,T GEN 'LOAD TEMP' INST (DIFFERS B 18Z2 FROM 'LOADINST' ONLY FOR LOGL.) 18Z1 AW,R LOADINST,T INSERT OP/REG FIELDS FOR LOAD 18Z2 GEN,1,0 R GEN LOAD INST CW,T RSTYPE IS TYPE CORRECT ? BE *L1 YES, RETURN SLS,T 2 NO, GEN TYPE CONVERSION: AW,T RSTYPE T = 4*(ARG TYPE)+(RESULT TYPE), GENX CONVTABL,T GEN CONVERSION CODE B *L1 RETURN * * * GEN LOAD TO TEMP * * GENS LOAD AND CONVERT, AS ABOVE, FOLLOWED BY STORE * INTO TEMP; SUBSTITUTES TEMP ADR FOR ARG ADR. LINK IS L2. * GENLOADT BAL,L1 GENLOAD GEN LOAD AND CONVERSION TO 'RSTYPE' LW,R TEMPADR,A SUBSTITUTE TEMP ADR STW,R LFADR,A FOR ARG ADR. LW,T RSTYPE STW,T LFTYPE,A SUBSTITUTE RESULT TYPE AW,R STMPINST,T GEN STORE INTO TEMP GEN,1,0 R PUT IN XSEG B *L2 RETURN * * * GEN CHANGE OF REGS OR OP CODE * * IF THE LAST GENNED INST WAS A LOAD INST, ITS OP CODE * AND REG FIELDS WILL BE CHANGED TO THOSE GIVEN IN 'IX'; * OTHERWISE, THE INST IN 'IX' WILL BE GENNED. LINK IS LX. * CHANGOP EQU % CHANGREG LW,IX1 =X'56000000' IS LAST GEN'ED INST A LOAD ? CS,IX -1,XL BE 7Z1 GEN,1,0 IX NO, GEN THE WHOLE INST B 0,LX 7Z1 LW,IX1 =X'7FF00000' YES, CHANGE OP/REG FIELDS STS,IX -1,XL B 0,LX * LREGBI LW,BI AI CHANGE AI TO BI LREGTX LW,TX AI CHANGE AI TO TX PAGE * * * DATA/TEMPS FOR XSEG GEN ROUTINES * * LOOPLOC TEMP ADDRESS IN XSEG OF LOOP TOP LFTEMP DTEMP LEFT ARG TEMP RTTEMP DTEMP RIGHT ARG TEMP * * LOADINST TABLE WORDLOGL LOAD INSTRUCTION - BY ARG TYPE: LW,AI 0 WORD LOGICAL BAL,LX 0 LOGL LB,AI 0 CHAR LW,AI 0 INTG LD,AF 0 FLOT BAL,LX 0 ISEQ * LODBINST TABLE CHAR LOAD 2ND ACCUM - BY ARG TYPE: LB,BI 0 CHAR LW,BI 0 INTG LD,BF 0 FLOT * LTMPINST TABLE WORDLOGL LOAD FROM TEMP INST - BY ARG TYPE: LW,AI 0 WORD LOGICAL LW,AI 0 LOGL LB,AI 0 CHAR LW,AI 0 INTG LD,AF 0 FLOT LW,AI 0 ISEQ * STORINST TABLE WORDLOGL STORE INSTRUCTION - BY RESULT TYPE: STW,AI 0 WORD LOGICAL BAL,LX 0 LOGL STB,AI 0 CHAR STW,AI 0 INTG STD,AF 0 FLOT * STMPINST TABLE WORDLOGL STORE TO TEMP INST - BY RS TYPE: STW,AI 0 WORD LOGICAL STW,AI 0 LOGL STB,AI 0 CHAR STW,AI 0 INTG STD,AF 0 FLOT * LOGLADR TABLE -3 LOGL LOAD/STORE ROUTINES PZE LDLOGLLF LOAD LOGICAL LEFT ARG PZE LDLOGLRT LOAD LOGICAL RIGHT ARG PZE STLOGLRS STORE LOGICAL RESULT * 08-00015 SLOGLADR TABLE -3 SCALAR LOGL LOAD/STORE ROUTINES 08-00016 PZE LDSLGLLF LOAD SCALAR LOGICAL LEFT 08-00017 PZE LDSLGLRT LOAD SCALAR LOGICAL RIGHT 08-00018 PZE STSLGLRS STORE SCALAR LOGICAL RESULT 08-00019 * ISEQADR TABLE -3 ISEQ LOAD ROUTINES PZE LDISEQLF LOAD ISEQ ELEMENT LEFT PZE LDISEQRT LOAD ISEQ ELEMENT RIGHT * BOUND 8 TEMPADR TABLE 0 ARG TEMP ADDRESS PZE LFTEMP LF PZE RTTEMP RT * CONVTABL TABLE 4*LOGL+WORDLOGL CONVERSION CODE GROUPS - BY 2 TYPES: CODE,0 L TO WORD LOGICAL CODE,0 L TO L CODE,1 TYPEXTOC L TO C (FOR EQ/NEQ OPS) CODE,1 TYPELTOI L TO I CODE,1 TYPELTOF L TO F CODE,0 C TO L ILLEGAL CODE,0 C TO C CODE,0 C TO I ILLEGAL CODE,0 C TO F ILLEGAL CODE,3 TYPEITOL I TO L CODE,1 TYPEXTOC I TO C (FOR EQ/NEQ OPS) CODE,0 I TO I CODE,5 TYPEITOF I TO F CODE,5 TYPEFTOL F TO L CODE,1 TYPEXTOC F TO C (FOR EQ/NEQ OPS) CODE,2 TYPEFTOI F TO I CODE,0 F TO F CODE,3 TYPEITOL ISEQ TO L CODE,1 TYPEXTOC ISEQ TO C CODE,0 ISEQ TO I CODE,5 TYPEITOF ISEQ TO F * TYPELTOI AND,AI =1 INTG VAL = 0 OR 1 * TYPELTOF LD,AF FLOT01,AI CONV LOGL 0/1 TO FLOT 0.0/1.0 * TYPEITOF LW,AF AI GET INTG VALUE LI,AF1 0 CLEAR 2ND WORD SAD,AF -8 MAKE ROOM FOR EXPONENT EOR,AF =X'48000000' INCLUDE EXPONENT FAL,AF FLOT0 NORMALIZE * TYPEFTOL EQU % * TYPEFTOI BAL,LX F2I F TO I CONVERSION SUBROUTINE B ERDOMAIN ERROR IF NOT INTG VALUE * TYPEITOL CI,AI -2 ERROR IF INTG NOT 0/1 BANZ ERDOMAIN LCW,AI AI SET TO 0 OR -1 * TYPEXTOC LI,AI -1 WON'T MATCH ANY CHAR * INITINST LCW,N RSSIZE XSEG LOOP INIT INST LOOPINST BIR,N 0 XSEG LOOP CONTROL INST EXITINST B *RETURN XSEG EXIT INST * BOUND 8 FLOTCONS DATA,8 FL'2',FL'1',FL'0' FLOT0 EQU FLOTCONS+4 FLOATING 0.0 FLOT1 EQU FLOTCONS+2 FLOATING 1.0 FLOT2 EQU FLOTCONS FLOATING 2.0 FLOT01 EQU FLOT0 FLOATING 0.0,1.0 FLOTPI DATA,8 FL'3.141592653589793' FLOTINF DATA X'7FFFFFFF',X'FFFFFFFF' PAGE * * * X S E G E X E C U T I O N R O U T I N E S * * * GEN INTEGER OVERFLOW TEST; GEN STORE; EXECUTE * GXOVSTEX GEN,0,2 OVTSTINS GEN: BNOV %+2 AWM,XL -2,XL B INTGOVFL * * * GEN STORE; EXECUTE * GXSTEXEC LW,X COPTRIG IF WE'RE DOING A COMPOSITE OP, BLZ *CSTORLNK DERAIL TO SPECIAL SUBROUTINE. GXSTEXC1 BAL,LX GXSEGST GEN STORE, BY RESULT TYPE * * * EXECUTE XSEG * EXECUTE LI,IX OPBREAK SET XSEG BREAK FLAG TO SAY, STW,IX XSEGBRK 'XSEG BREAK IS OK NOW.' B XSEGBASE GO TO THE XSEG * * * LOAD/STORE LOGICAL DATA * * LDLOGLLF/RT LOADS INTO ALL BIT POSITIONS OF AI * THE NEXT BIT OF LOGICAL DATA FROM LEFT/RIGHT * ARG. STLOGLRS STORES AI (WHICH MUST BE 0 OR -1) * INTO THE NEXT LOGICAL RESULT BIT. LINK IS LX. * LDLOGLLF LI,AF 0 AF= LEFT ARG INDEX B 10Z1 * LDLOGLRT LI,AF 1 AF= RIGHT ARG INDEX 10Z1 LW,AI LFLGLCNT,AF GET COUNT (NR BITS REMAINING +1) BDR,AI 10Z2 DECR IT LI,AI 32 NO MORE BITS, RESET COUNT MTW,1 LFLGLADR,AF AND GO TO NEXT WORD OF BITS. 10Z2 STW,AI LFLGLCNT,AF STORE NEW COUNT LW,AF LFLGLADR,AF FETCH CURRENT DATA ADR LW,AI BITMASK,AI SELECT APPROPRIATE BIT * BITMASK+J = 2**(J-1) FOR 1<=J<=32 AND,AI 0,AF GET THE BIT BEZ 0,LX IF IT'S ZERO, RETURN WITH AI=0 LI,AI -1 NONZERO, B 0,LX RETURN WITH AI=-1. * STLOGLRS LW,AF RSLGLCNT GET COUNT (NR POSITIONS LEFT +1) BDR,AF 10Z3 DECR IT MTW,1 RSLGLADR NO MORE HOLES, RESET COUNT STW,AF *RSLGLADR AND MOVE TO NEXT FULL WORD. LI,AF 32 ZERO OUT NEW WORD 10Z3 STW,AF RSLGLCNT STORE NEW COUNT AND,AI BITMASK,AF SELECT APPROPRIATE BIT ODD,AI SINCE AI IS ODD, 'STS,AI' DOES STS,AI *RSLGLADR 'OR TO MEMORY' B 0,LX RETURN * 08-00021 * 08-00022 LDSLGLLF LW,AI *LFLGLADR GET LEFT ARG 08-00023 BGEZ 10Z4 TEST 1ST LOGL BIT 08-00024 10Z5 LI,AI -1 1: RETURN ALL 1'S 08-00025 B 0,LX 08-00026 * 08-00027 LDSLGLRT LW,AI *RTLGLADR GET RIGHT ARG 08-00028 BLZ 10Z5 TEST 1ST LOGL BIT 08-00029 10Z4 LI,AI 0 0: RETURN ALL 0'S 08-00030 B 0,LX 08-00031 * 08-00032 STSLGLRS STW,AI *RSLGLADR STORE LOGL SCALAR 08-00033 B 0,LX 08-00034 * * * LOAD ISEQ ELEMENT * * LDISEQLF/RT LOADS INTO AI THE NEXT ELEMENT FROM * THE ISEQ ARG. LINK IS LX. * LDISEQLF LW,AI LFVALU GET LAST VALUE AW,AI *LFSTEPAD ADD ISEQ STEP STW,AI LFVALU STORE AS NEXT VALUE B 0,LX AND RETURN THAT VALUE * LDISEQRT LW,AI RTVALU GET LAST VALUE AW,AI *RTSTEPAD ADD ISEQ STEP STW,AI RTVALU STORE AS NEXT VALUE B 0,LX AND RETURN THAT VALUE * * OVTSTINS BNOV 0 (%+2) -2 B INTGOVFL -1 * ERROR,X'F',TLOC>30 'TOO MANY TEMPS' U08-0110 NTEMPS SET TLOC U08-0111 20Z END