IDT 'FOR' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * FORY ;FOR COMMAND * NXTY ;NEXT COMMAND * FOR2 ;DELETE FROM FOR/NEXT STACK * GSIM ;GET SIMPLE VERIABLE * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * REF ADDF ;ADD REF SUBF ;SUBTRACT REF EVERZ ;EVALUATE EXPRESSION REF NLIN,NLIN0 ;EXIT TO MULTIPLEXOR ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) ERROR2 EQU ERROR+>20 * * EXTERNAL DATA: * REF BUS ;BEGINNING USER STORAGE REF EUS ;END USER STORAGE REF FNS ;FOR/NEXT STACK REF NVD ;NEXT VARIABLE DEFINITION REF NVS ;NEXT VARIABLE STORAGE REF PLC ;PROGRAM LINE COUNTER REF SLT ;STATEMENT LINE TABLE REF VDT ;VARIABLE DEFINITION TABLE REF VNT ;VARIABLE NAME TABLE * * MODULE EQUATES: * NRV EQU 4 ;NUMBER OF RESERVED WORDS REF NXTXB ;NEXT COMMAND BYTE * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'FOR COMMAND' PAGE * ABSTRACT: * * EXECUTE FOR COMMAND. WHEN A FOR * STATEMENT IS EXECUTED, THE FOR/NEXT * STACK (FNS) IS SEARCHED FOR A ZERO * ENTRY. DURING THE SEARCH, IF * AN IDENTICAL ENTRY IS FOUND, IT IS * DELETED AND THE STACK IS ROLLED DOWN. * * A PRE-TEST IS MADE TO SEE IF THE * CONDITION IS MET IN WHICH CASE, THE * FOR COMMAND WILL SEARCH FOR A MATCHING * NEXT. * * THE FOR/NEXT STACK FORMAT IS: * * ! ' ' ' ' ' ' ' ' ! * VAR -----STEP----- ------TO------ PBC PLC * * VAR = 0 INDICATES EMPTY SLOT * * CALLING SEQUENCE: * * B @FORY * * EXIT TO NLIN * EXCEPTIONS AND CONDITIONS: * * FOR W/O NEXT, STACK OVERFLOW * EVALUATION ERRORS * STORAGE OVERFLOW, ILLEGAL DELIMITER * EXPECTING SIMPLE VARIABLE * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) PAGE * ENTRY POINT: * DEF FORY,FOR2 * FORY BL @GSIM ;GET SIMPLE VARIABLE MOV *R4,R3 ;DEFINED? JNE FOR0 ;Y MOV @NVS(9),R3 ;N, DEFINE AI R3,-6 C R3,@NVD(9) ;OK? JL FORE10 ;N MOV R3,*R4 ;Y, DEFINE MOV R3,@NVS(9) ;UPDATE NVS * FOR0 MOV @FNS(9),R4 ;GET F/N STACK ADR CB *R8+,@B56 ;=? JNE FORE36 ;N, PROBLEM * FOR1 MOV *R4,R0 ;DONE? JEQ FOR4 ;Y C R1,R0 ;N, SAME VARIABLE? JEQ FOR1A ;Y AI R4,18 ;N, MOVE TO NEXT C R4,@EUS(9) ;ANYMORE? JL FOR1 ;Y DATA ERROR+11 ;N, STACK OVERFLOW * FOR1A BL @FOR2 ;DELETE JMP FOR1 * FOR2 MOV R4,R5 ;DELETE FROM STACK MOV R4,R0 AI R0,18 * FOR3 MOV *R0+,*R5+ ;MOVE UP C R0,@EUS(9) ;DONE? JLE FOR3 ;N RT ;Y PAGE FOR4 MOV R1,*R4+ ;INSERT VAR NAME BLWP @EVERZ ;GET INITIAL VALUE CI R0,>3800 ;TO? JNE FORE37 ;N, ERROR MOV R3,R6 ;SAVE FOR PRE-TEST MOV *R2+,*R3+ ;MOVE IN INITIAL VALUE MOV *R2+,*R3+ MOV *R2,*R3 * CLR *R4+ ;SET DEFAULT STEP TO 1 CLR *R4 INC *R4+ CLR *R4+ * BLWP @EVERZ ;GET 'TO' VALUE MOV R4,R7 ;SAVE FOR PRE-TEST MOV *R2+,*R4+ ;MOVE IN TERMINATING VALUE MOV *R2+,*R4+ MOV *R2,*R4+ CLR R5 ;SET DEFAULT SIGN CI R0,>3A00 ;'STEP'? JNE FOR6 ;N BLWP @EVERZ ;Y, GET STEP MOV R4,R1 AI R1,-12 ;MOVE BACK TO STEP MOV *R2,R5 ;GET DIRECTION JNE $+6 ;FP MOV @2(2),R5 ;INTEGER * MOV *R2+,*R1+ ;MOVE INTO STEP MOV *R2+,*R1+ MOV *R2,*R1 * FOR6 MOV R8,*R4 ;MOVE IN PBC,PLC DEC *R4+ ;BACKUP OVER DLIM MOV @PLC(9),*R4 * MOV R6,R2 ;DO PRE-TEST MOV R7,R1 BL @SUBF ;R2=R2-R1 (VAR-TERM) MOV *R2+,R1 ;LOOK AT RESULT, INTEGER? JNE $+6 ;N MOV *R2,R1 ;Y JEQ FOR9 ;= IMPLIES NOT DONE * XOR R5,R1 ;'EXCLUSIVE OR' SIGNS JLT FOR9 ;- INPLIES LOOP NOT COMPLETE PAGE FOR7 MOV @-16(4),R5 ;LOOK FOR NEXT CLR @-16(4) ;CLEAR FROM STACK MOV @PLC(9),R6 ;GET PLC * FOR8 AI R6,-4 C R6,@SLT(9) ;ANY MORE STATEMENTS? JL ERR31 ;N MOV *R6,R8 ;GET PBC A @BUS(9),R8 ;GET ABSOLUTE ADDRESS CB *R8+,@NXTXB ;NEXT? JNE FOR8 ;N BL @GSIM ;Y, GET SIMPLE VARIABLE C R1,R5 ;SAME? JNE FOR8 ;N, CONTINUE MOV R6,@PLC(9) ;Y, UPDATE PLC B @NLIN0 * *FOR9 EQU DIM8 FOR9 B @NLIN * FORE36 DATA ERROR2,36 ;MISSING "= * FORE37 DATA ERROR2,37 ;ILLEGAL DELIMITER * FORE10 DATA ERROR+10 ;STORAGE OVERFLOW * ERR31 DATA ERROR+31 ;FOR W/O NEXT * ERR20 DATA ERROR+20 ;EXPECTING SIMPLE VARIABLE TITL 'NEXT COMMAND' PAGE * ABSTRACT: * * PROCESS THE FOOT OF A FOR/NEXT LOOP. * * NEXT SEARCHS THE FOR/NEXT STACK (FNS) * FOR A MATCHING SIMPLE VARIABLE. THE * STEP IS ADDED TO THE VARIABLE AND * A COMPLETION CHECK IS MADE. IF LESS * THAN OR EQUAL, IT LOOPS BACK. OTHERWISE, * THE STACK VARIBLE IS SET TO ZERO, * AND PROGRAM EXECUTION CONTINUES AFTER * THE NEXT STATEMENT. * * CALLING SEQUENCE: * * B @NXTY * * EXIT TO NLIN * * EXCEPTIONS AND CONDITIONS: * * EVALUATION ERRORS * NEXT W/O FOR * * EXTERNAL ROUTINES: * * (SEE EXTERNAL ROUTINE LIST) * * LOCAL DATA: (NONE) PAGE * ENTRY POINT * DEF NXTY * NXTY BL @GSIM ;GET SIMPLE VARIABLE MOV *R4,R6 ;GET ADR JEQ ERR32 ;NOT DEFINED MOV @FNS(9),R4 ;GET F/N STACK ADR * NXT1 C R1,*R4+ ;SAME? JEQ NXT2 ;Y AI R4,16 ;N, MOVE TO NEXT C R4,@EUS(9) ;MORE? JL NXT1 ;Y * ERR32 DATA ERROR+>20 ;NEXT W/O FOR DATA 32 * NXT2 MOV *R4,R5 ;GET SIGN JNE $+6 ;FP MOV @2(4),R5 ;INTEGER * MOV R6,R1 ;READY R2,R1 MOV R4,R2 BL @ADDF ;ADD STEP MOV R2,R1 ;MOVE IN NEW VARIABLE MOV *R1+,*R6+ MOV *R1+,*R6+ MOV *R1,*R6 MOV R4,R1 AI R1,6 ;MOVE TO 'TO' BL @SUBF ;R2=R2-R1 (VAR-TO) MOV *R2+,R1 ;LOOK AT RESULT, INTEGER? JNE $+6 ;N MOV *R2,R1 ;Y JEQ NXT3 ;0, NOT DONE * XOR R5,R1 ;EXCLUSIVE OR WITH STEP JLT NXT3 ;NOT DONE CLR @-2(4) ;DONE, SET TOP OF STACK B @NLIN0 * NXT3 AI R4,12 ;LOOP NOT COMPLETE MOV *R4+,R8 ;RESTORE PBC & PLC MOV *R4,@PLC(9) B @NLIN0 TITL 'GET SIMPLE VARIABLE' PAGE * ABSTRACT: * * GSIM WILL GET NEXT ITEM AND CHECK TO * SEE IF IT IS A SIMPLE VARIABLE. * * CALLING SEQUENCE: * * BL @GSIM * * OUT (R4) = VARIABLE DEFINITION * * EXCEPTIONS AND CONDITIONS: * * EXPECTING SIMPLE VARIABLE * * EXTERNAL ROUTINES: (NONE) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF GSIM * GSIM CLR R0 ;GET VARIABLE MOVB *R8+,R0 CI R0,NRV*>100+>7000 JL ERR20 ;N, EXPECTING SIMPLE VARIABLE MOV @VNT(9),R4 ;GET SYMBOL TABLE ADR SRL R0,7 ;GET INDEX A R0,R4 MOV @->70*2(4),R1 JLT ERR20 ;DIMENSIONED, ERROR MOV @VDT(9),R4 A R0,R4 AI R4,->70*2 RT * B56 BYTE >56 EVEN END IDT 'FORMAT' * * EXTERNAL DEFINITIONS AND REFERENCES * DEF CVBF REF CVBFR PAGE * *PRINT FORMATTING * CVBF MOV R9,R8 MARK FORMAT MOV R7,R6 MARK CHARACTER BUFFER CLR R3 CLEAR DECIMAL FLAG CLR R4 CLEAR BEFORE DECIMAL COUNT CLR R5 CLEAR TOTAL DIGIT HOLDER COUNT * CVBF1 BL @CVBFT GET TYPE JMP CVBF4 NULL, DONE JMP CVBF2 DIGIT HOLDER SETO R3 DECIMAL JMP CVBF3 CHARACTER * CVBF2 MOV R3,R3 BEFORE DECIMAL? JNE $+4 N INC R4 Y, COUNT INC R5 * CVBF3 MOVB @B2A,*R6+ OUT "* JMP CVBF1 * CVBF4 AI R10,-13 GET # OF LEADING DIGITS NEG R10 C R10,R4 GREATER THAN DIGIT HOLDERS? JGT CVBFR1 Y, ERROR RETURN S R4,R5 GET NUMBER OF DIGITS PAST DECIMAL A R10,R5 INDEX TO ROUNDING DIGIT CI R5,12 TOO LARGE? JLT CVBF5 N LI R5,12 Y, SET TO 12 * CVBF5 MOV R5,R0 SET TO ROUND DEC R0 BL @CVBFR ROUND INC R10 ADD NEW DIGIT MOV R9,R8 RESET FOR CVBFT CLR R5 CLR # FLAG * CVBF6 BL @CVBFT GET FORMAT TYPE CVBD7A JMP CVBFR2 DONE JMP CVBF8 DIGIT HOLDER JMP CVBF15 ". CI R0,>2C00 ",? JNE CVBF7 N MOV R5,R5 Y, DIGIT OUT? JEQ CVBF11 N, OUT SPACE CVBF7 MOVB R0,*R7+ Y, OUT CHARACTER JMP CVBF6 B2A BYTE >2A B30 BYTE >30 PAGE CVBFR1 MOV R6,R7 FORMATTING OVERFLOW CVBFR2 MOV R7,@14(13) RETURN UPDATE PTR RTWP DONE * CVBF8 DEC R4 DIGIT HOLDER C R4,R10 TIME FOR DIGIT? JLT CVBF13 Y JEQ CVBF8A N, CHECK FLOATER MOV R4,R4 FLOATER? JNE CVBF10 N CVBF8A CI R0,>2400 N, MAYBE FLOATER THOUGH, "$? JEQ CVBF7 Y, INSERT CI R0,>5300 "S? JNE CVBF9 N MOV R12,R12 Y, POSITIVE? JEQ CVBF11 Y, INSERT BLANK LI R0,>2D00 N, INSERT "- JMP CVBF7 * CVBF9 CI R0,>3C00 "3000 "0? JEQ CVBF12 Y CVBF11 LI R0,>2000 N, INSERT BLANK CVBF12 MOVB R0,*R7+ INSERT JMP CVBF6 * CVBF13 BL @CVBF30 JMP CVBF6 * CVBF15 MOVB R0,*R7+ INSERT ". * CVBF16 BL @CVBFT GET BYTE JMP CVBD7A DONE JMP CVBF20 DIGIT HOLDER JMP $+2 CI R0,>3E00 ">? JNE CVBF18 N MOV R12,R12 Y, POSITIVE? JNE CVBF18 N LI R0,>2000 Y, OUT SPACE CVBF18 MOVB R0,*R7+ OUT JMP CVBF16 * CVBF20 DEC R4 COUNT C R4,R10 TIME FOR DIGIT? JLT CVBF21 Y LI R0,>3000 N, OUT "0 JMP CVBF18 * CVBF21 BL @CVBF30 OUT DIGIT JMP CVBF16 * CVBF30 DEC R10 COUNT DOWN SETO R5 ALLOW COMMA'S MOVB *R3+,*R7+ INSERT DIGIT JNE CVBF31 DEC R7 NO DIGIT DEC R3 MOVB @B30,*R7+ INSERT "0 CVBF31 RT PAGE *CHECK FORMAT TYPE * BL @CVBFT * NULL * DIGIT HOLDER < $ S 0 9 * DECIMAL * CHAR , * CVBFT CLR R0 GET BYTE MOVB *R8+,R0 JEQ CVBFT3 NULL CI R0,>3C00 "2400 "$? JEQ CVBFT2 Y CI R0,>5300 "S? JEQ CVBFT2 Y CI R0,>3000 "0? JEQ CVBFT2 Y CI R0,>3900 "9? JEQ CVBFT2 Y B2E EQU $+2 CI R0,>2E00 ".? JEQ CVBFT1 Y CI R0,>4500 "E? JNE CVBFT4 N LI R0,>2000 Y, DEFAULT TO SPACE MOV R12,R12 NEGATIVE? JEQ $+6 N LI R0,>2D00 Y, OUT "- * CVBFT4 CI R0,>5E00 "^? JNE CVBFT0 N LI R0,>2E00 Y, REPLACE WITH ". * CVBFT0 INCT R11 CVBFT1 INCT R11 CVBFT2 INCT R11 CVBFT3 RT END IDT 'FP' * * REVISION: 12/31/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * FAD ;ADD TO FPAC * FSD ;SUBTRACT FROM FPAC * FMD ;MULTIPLY FPAC * FDD ;DIVIDE FPAC * FLDD ;LOAD FPAC * FSRD ;STORE FPAC * FNEG ;NEGATE FPAC * FCLR ;CLEAR FPAC * FNRM ;NORMALIZE FPAC * FSCL ;SCALE FPAC * FLOAT ;FLOAT FPAC * * FADDI ;3 WRD ADDITION * FSUBI ;3 WRD SUBTRACTION * * THE FLOATING POINT ACCUMULATOR IS THE FIRST 3 * WORDS OF THE FLOATING POINT REGISTERS (R0,R1,R2). * * ALL FLOATING POINT OPERATIONS ASSUME NORMALIZED * NUMBERS AS INPUTS AND ALL RESULTS ARE NORMALIZED. * * THE FORM OF A FLOATING POINT NUMBER IS AS FOLLOWS: * * 1ST WORD SCCC CCCC MMMM MMMM * 2ND WORD MMMM MMMM MMMM MMMM * 3RD WORD MMMM MMMM MMMM MMMM * * WHERE S = SIGN BIT * C = 7 BIT, EXCESS >40 CHARACTERISTIC * M = 40 BIT UNSIGNED MAGNITUDE MANTISSA * 0 <= M < 1 * * A NUMBER IS NORMALIZED WHEN THE 1ST HEX DIGIT * OF THE MANTISSA IS NON-ZERO. * * A TRUE ZERO (ALL ZERO'S) IS USED FOR ZERO. * * COPY: (NONE) * * MACRO: (NONE) * * EXTERNAL ROUTINES: * ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) ERROR2 EQU ERROR+>20 * * EXTERNAL DATA: (NONE) * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'STORE FLOATING POINT ACCUMULATOR' PAGE * ABSTRACT: * * LOAD INTO FPAC A 3 WRD FLOATING POINT #. * * CALLING SEQUENCE: * * XOP XX,1 * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: (NONE) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF FSRD * FSRD MOV R0,*R11+ MOV R1,*R11+ MOV R2,*R11 RTWP TITL 'LOAD FLOATING POINT ACCUMULATOR' PAGE * ABSTRACT: * * LOAD FLOATING POINT ACCUMULATOR WITH 3RD FLOATING * POINT NUMBER. * * CALL SEQUENCE: * * XOP XX,0 * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: (NONE) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF FLDD * FLDD MOV *R11+,R0 ;LOAD FPAC FLDD1 MOV *R11+,R1 MOV *R11,R2 FLDD2 RTWP TITL 'FLOATING POINT ADDITION AND SUBTRACTION' PAGE * ABSTRACT: * * ADD OR SUBTRACT FROM FPAC A 3 WORD FLOATING * POINT NUMBER. * * CALL SEQUENCE: * * XOP XX,2 ;ADD TO FPAC * * XOP XX,3 ;SUBTRACT FROM FPAC * * EXCEPTIONS AND CONDITIONS: * * ERROR 29 CAN RESULT FROM OVERFLOW * * EXTERNAL ROUTINE LIST: * * FLDD ;LOAD FPAC * FARS ;SHIFT FPAC RIGHT 1 HEX DIGIT * FADDI ;ADD R4,R5,R6 TO R0,R1,R2 * * LOCAL DATA: (NONE) * *ENTRY POINT: * DEF FSD ;SUBTRACT FROM FPAC * * SUBTRACTION IS MADE SIMPLY BY TOGGLING SIGN BIT * FSD MOV *R11+,R4 ;GET FIRST WORD, ZERO? JEQ FLDD2 ;Y, ZERO, RETURN AI R4,>8000 ;N, TOGGLE SIGN BIT JMP FAD0 * * ENTRY POINT: * DEF FAD * FAD MOV *R11+,R4 ;GET FIRST WORD, ZERO? JEQ FLDD2 ;Y, RETURN FAD0 MOV R0,R0 ;N, FPAC ZERO? JNE FAD0A ;N MOV R4,R0 ;Y, MOVE TEMP TO FPAC JMP FLDD1 * FAD0A MOV *R11+,R5 ;LOAD R4,R5,R6 MOV *R11,R6 MOVB R0,R3 GET EXPONENTS MOVB R4,R7 SB R0,R0 ISOLATE SB R4,R4 SLA R3,1 REMOVE SIGN JNC FAD1 NEGATIVE? BL @FADN Y, NEGATE * FAD1 SRL R3,9 SLA R7,1 REMOVE SIGN JNC FAD2 NEGATIVE? NEG R6 Y, NEGATE JNE FAD1A NEG R5 JNE FAD1B NEG R4 JMP FAD2 FAD1A INV R5 FAD1B INV R4 * FAD2 LI R10,10 10 SHIFTS GIVE ZERO RESULT SRL R7,9 POSITION EXPONENT * FAD2A C R3,R7 COMPARE EXPONENTS JEQ FAD4 SAME, DO ADD JGT FAD3 SHIFT TEMP (IS R3>R7?) BL @FARS N, R380 ADD SIGN TO EXPONENT JMP FNRM3 * FAD4 BL @FADDI ADD JLT FAD5 NEGATIVE JGT FAD6 POSITIVE MOV R1,R1 JNE FAD6 NON-ZERO MOV R2,R2 JNE FAD6 NON-ZERO JMP FNRM4 ZERO, RTWP * FAD5 BL @FADN NEGATE FPAC ORI R3,>80 ADD SIGN BIT * FAD6 MOVB R0,R0 CHECK ADDITION OVERFLOW JEQ FNRM2 NUMBER OK BL @FARS SHIFT NUMBER JMP FNRM2 NORMALIZE * FADN NEG R2 NEGATE FPAC JNE FADN1 NEG R1 JNE FADN2 NEG R0 RT * FADN1 INV R1 FADN2 INV R0 RT RETURN TITL 'NEGATE AND ABSOLUTE VALUE OF FPAC' PAGE * ABSTRACT: * * GET ABSOLUTE VALUE OF FPAC. * NEGATE FPAC. * * CALL SEQUENCE: * * XOP XX,9 ;NEGATE FPAC * * EXCEPTIONS AND CONDITIONS: (NONE) * * LOCAL DATA: (NONE) * * ENTRY POINT: * * DEF FABS * *FABS ANDI R0,>7FFF CLEAR SIGN BIT * RTWP RETURN * * ENTRY POINT: * DEF FNEG * FNEG MOV R0,R0 ZERO? JEQ FNEG1 Y, LEAVE TRUE ZERO AI R0,>8000 N, COMPLEMENT SIGN BIT FNEG1 RTWP RETURN TITL 'FLOAT FPAC' PAGE * ABSTRACT: * * IF FPAC IS NOT NORMALIZED, AN ATTEMPT WILL BE * MADE TO NORMALIZE. IN GENERAL, FLOAT WORKS ON * R0,R1,R2 AND HENCE IT CAN BE USED TO FLOAT * OTHER SETS OF NUMBERS THAN FPAC. * * CALLING SEQUENCE: * * XOP XX,10 WHERE XX IS NOT USED * * EXCEPTIONS AND CONDITIONS: * * IF R0 IS NON-ZERO, THE ROUTINE WILL ABORT. * * EXTERNAL ROUTING LIST: * * FNRM ;NORMALIZE * FCLR ;CLEAR FPAC * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF FLOAT * FLOAT MOV R0,R0 ALREADY FLOATING? JNE FNRM4 Y, RTWP LI R3,>44 N, GET EXPONENT CLR R2 CLEAR LOW MOV R1,R1 CHECK SIGN JGT FLOAT1 POSITIVE JEQ FCLRP ZERO NEG R1 NEGATIVE LI R3,>C4 NEGATE EXPONENT * FLOAT1 MOVB R1,R0 SHIFT 1 BYTE LEFT JEQ FLOAT2 SHIFT 2 BYTES SWPB R0 SLA R1,8 JMP FNRM2 * FLOAT2 MOV R1,R0 SHIFT 2 BYTES CLR R1 DECT R3 ADJUST EXPONENT JMP FNRM2 TITL 'NORMALIZE FPAC' PAGE * ABSTRACT: * * FPAC IS NORMALIZED SUCH THAT THERE EXISTS * A NON-ZERO HEX DIGIT IN BITS 8-11 OF THE 1ST * WORD OF FPAC. * * CALL SEQUENCE: * * XOP XX,7 WHERE XX IS NOT USED * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: * * FCLR ;CLEAR FPAC * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF FNRM * FNRM CLR R3 CLEAR R3 MOVB R0,R3 GET EXPONENT & SIGN S R3,R0 REMOVE FROM NUMBER JNE FNRM1 LOOK FOR ZERO MOV R1,R1 JNE FNRM1 MOV R2,R2 JEQ FNRM4 ZERO, RETURN * FNRM1 SWPB R3 READY FOR DECREMENTING * FNRM2 CZC @CF0,R0 NORMALIZED? JNE FNRM3 Y CZC @C7F,R3 N, EXPONENT=ZERO? JEQ FCLRP Y, CANNOT NORMALIZE DEC R3 N, OK TO DECREMENT SLA R0,4 SHIFT R0,R1,R2 4 BITS LEFT MOV R1,R9 SRL R9,12 A R9,R0 MOVE 1ST HEX DIGIT ACROSS SLA R1,4 MOV R2,R9 SRL R9,12 A R9,R1 MOVE 2ND HEX DIGIT ACROSS SLA R2,4 JMP FNRM2 * FNRM3 SWPB R3 READY EXPONENT MOVB R3,R0 MOVE INTO FPAC FNRM4 RTWP RETURN TITL 'MULTIPLY FPAC' PAGE * ABSTRACT: * * MULTIPLY FPAC BY FLOATING POINT NUMBER * POINTED TO BY R11. * * CALL SEQUENCE: * * XOP XX,4 * * EXCEPTIONS AND CONDITIONS: * * ERROR 29 CAN RESULT FROM OVERFLOW * * EXTERNAL ROUTINE LIST: * * FCLR ;CLEAR FPAC * FPFX ;FIX EXPONENTS * FAD6 ;ADD AND NORMALIZE * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF FMD * FMD MOV R0,R0 ;FPAC=0? JEQ FCLR ;Y MOV *R11+,R4 ;FPAC X 0? FCLRP JEQ FCLR ;Y MOV *R11+,R5 ;N, LOAD R4,R5,R6 MOV *R11,R6 BL @FPFX FIX EXPONENTS A R7,R3 DATA >FFC0 * *DO MULTIPLICATION * * R4,R5,R6 * R0,R1,R2 * ======== * XX XX A R2 X R6 * XX XX B R2 X R5 * XX XX C R2 X R4 * XX XX D R1 X R6 * XX XX E R1 X R5 * XX XX F R1 X R4 * XX XX G R0 X R6 * XX XX H R0 X R5 * XX XX I R0 X R4 * ----------------- * R7,R8,R9,R10 * MOV R6,R10 MPY R2,R10 R10,R11 (A) MOV R6,R8 MPY R1,R8 R8,R9 (D) MPY R0,R6 R6,R7 (G) * A R9,R10 SUM PARTIAL PRODUCTS (A,D,G) JNC $+4 INC R8 A R7,R8 JNC $+4 INC R6 MOV R8,R9 MOV R6,R8 R8,R9,R10 = A+D+G * MOV R5,R6 MPY R2,R6 R6,R7 (B) A R7,R10 SUM JNC $+4 INC R6 A R6,R9 JNC $+4 INC R8 (NO CARRY OUT) MOV R9,R10 MOV R8,R9 MOV R5,R7 MPY R1,R7 R7,R8 (E) MPY R0,R5 R5,R6 (H) * A R8,R10 FINISH PARTIAL SUMS B,E,H CLR R8 JNC $+4 INC R7 A R7,R9 JNC $+4 INC R8 A R6,R9 JNC $+4 INC R8 CLR R7 A R5,R8 JNC $+4 INC R7 R7,R8,R9,R10 = A+B+D+E+G+H MOV R4,R5 MPY R2,R5 R5,R6 (C) A R6,R10 SUM JNC FMD4 INC R9 JNC FMD4 INC R8 JNC FMD4 INC R7 FMD4 A R5,R9 JNC FMD5 INC R8 JNC FMD5 INC R7 * FMD5 MOV R4,R5 MPY R1,R5 R5,R6 (F) A R6,R9 SUM JNC FMD6 INC R8 JNC FMD6 INC R7 FMD6 A R5,R8 JNC $+4 INC R7 MPY R0,R4 R4,R5 (I) A R5,R8 JNC $+4 INC R7 A R4,R7 PRODUCT COMPLETE MOVB R8,R7 SHIFT 1 BYTE LEFT SWPB R7 MOVB R9,R8 SWPB R8 MOVB R10,R9 SWPB R9 SWPB R10 PAGE *MULTIPLY AND DIVIDE ENTRY * * R10 HAS GUARD BITS FOR NORMALIZING & ROUNDING * FMD7 MOV R7,R0 MOVE INTO FPAC MOV R8,R1 MOV R9,R2 * CZC @CF0,R0 NORMALIZED? JNE FMD9 Y, ROUND CZC @C7F,R3 N, EXP=0? JEQ FCLR Y, CANNOT NORMALIZE DEC R3 N, OK TO DECREMENT SLA R0,4 SHIFT R0,R1,R2,R10 LEFT 4 BITS MOV R1,R9 SRL R9,12 A R9,R0 MOVE 1ST HEX DIGIT ACROSS SLA R1,4 MOV R2,R9 SRL R9,12 A R9,R1 MOVE 2ND HEX DIGIT ACROSS SLA R2,4 MOV R10,R9 SRL R9,12 A R9,R2 MOVE 3RD HEX DIGIT ACROSS SLA R10,4 * *DONE, ROUND USING R10 * FMD9 SLA R10,1 GET GUARD BIT JNC FNRM3 IF ZERO, DONE INC R2 ELSE ROUND JNC FNRM3 INC R1 JNC FNRM3 INC R0 IF THIS FAR, POSSIBILITY B @FAD6 OF NORMALIZATION TITL 'CLEAR FPAC' PAGE * ABSTRACT: * * SET FPAC TO TRUE ZERO. * * CALLING SEQUENCE: * * XOP XX,8 WHERE XX IS NOT USED * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: (NONE) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF FCLR * FCLR CLR R0 CLEAR FPAC CLR R1 CLR R2 RTWP TITL 'DIVIDE FPAC AND FIX EXPONENTS' PAGE * ABSTRACT: * * DIVIDE FPAC BY THE FLOATING POINT NUMBER POINTED * TO BY R11. * * FPFX REMOVES EXPONENTS FROM R0,R1,R2 AND * R4,R5,R6, UNBIASES THEM, PERFORMS MULTIPLICATION * OR DIVISION (ADD OR SUBTRACT) AND THEN * RE-BIASES THEM. * * CALL SEQUENCE: * * XOP XX,5 * BL @FPFX * * EXCEPTIONS AND CONDITIONS: * * ERROR 28 WILL RESULT FROM DIVISION BY ZERO * ERROR 29 WILL RESULT FROM OVERFLOW * * EXTERNAL ROUTINE LIST: * * FCLR ;CLEAR * FMD7 ;FINISH BY NORMALIZING * * LOCAL DATA: (NONE) PAGE *FIX EXPONENTS * * BL @FPFX * BIAS INSTRUCTION * REBIAS # * FPFX MOVB R0,R3 GET EXPONENTS MOVB R4,R7 SB R0,R0 ;REMOVE FROM NUMBERS SB R4,R4 MOV R7,R8 GET SIGN XOR R3,R8 +-,-+ = NEG ++,-- = POS SWPB R3 REMOV SIGN BITS ANDI R3,>7F SWPB R7 ANDI R7,>7F X *R11+ DO ADD FOR MUL, SUB FOR DIV A *R11+,R3 BIAS CZC @CFF80,R3 CHECK FOR OVERFLOW JNE ERR29 PROBLEM SLA R8,1 ADD SIGN JNC $+6 AI R3,>80 NEGATIVE RT RETURN * *FLOATING POINT DIVIDE * * ENTRY POINT: * DEF FDD * FDD MOV R0,R0 ;FPAC=ZERO? JEQ FCLR ;Y MOV *R11+,R4 ;FPAC / 0? JEQ FDDER ;Y, DIVISION BY ZERO MOV *R11+,R5 ;N, LOAD R4,R5,R6 MOV *R11,R6 BL @FPFX FIX EXPONENTS S R7,R3 SUBTRACT EXPONENTS DATA >40 ADD >40 TO BIAS C R0,R4 CHECK FOR PROPER FRACTION JLT FDD2 OK INC R3 IMPROPER, INCREMENT EXPONENT SLA R4,4 SHIFT R4,R5,R6 LEFT 4 BITS MOV R5,R9 SRL R9,12 A R9,R4 MOVE 1ST HEX DIGIT ACROSS SLA R5,4 MOV R6,R9 SRL R9,12 A R9,R5 MOVE 2ND HEX DIGIT ACROSS SLA R6,4 * FDD2 CLR R7 Y, CLEAR QUOTIENT CLR R8 CLR R9 LI R10,40 DO 40 TIMES * FDD3 SLA R0,1 SHIFT LEFT R0,R1,R2,R7,R8,R9 SLA R1,1 JNC $+4 INC R0 SLA R2,1 JNC $+4 INC R1 SLA R7,1 SLA R8,1 JNC $+4 INC R7 SLA R9,1 JNC $+4 INC R8 C R0,R4 IS R0,R1,R2<=R4,R5,R6? JL FDD5 Y JH FDD4 N C R1,R5 MAYBE JL FDD5 Y JH FDD4 N C R2,R6 MAYBE JL FDD5 Y FDD4 BL @FSUBI N, R0,R1,R2=R0,R1,R2-R4,R5,R6 INC R9 ENTER BIT * FDD5 DEC R10 DONE? JNE FDD3 N, LOOP AGAIN SLA R0,1 Y, CHECK FOR ROUNDING C R0,R4 2*REMAINDER < DIVISOR? JL FMD7 Y, NO NEED TO ROUND LI R10,>8000 ROUND JMP FMD7 DONE * FDDER DATA ERROR+28 ;DIVISION BY ZERO * ERR29 DATA ERROR+29 ;FP ERROR TITL 'SHIFT FPAC RIGHT' PAGE * ABSTRACT: * * SHIFT R0,R1,R2 RIGHT 1 HEX DIGIT WHILE * UPDATEING EXPONENT IN R3 * * CALLING SEQUENCE: * * BL @FARS * * EXCEPTIONS AND CONDITIONS: * * ERROR 29 WILL RESULT ON OVERFLOW * * EXTERNAL ROUTINE LIST: * * ERR29 ;ERROR 29 * * LOCAL DATA: (NONE) * * ENTRY POINT: * FARS SRL R2,4 SHIFT R0,R1,R2 4 BITS RIGHT MOV R1,R9 SLA R9,12 A R9,R2 MOVE 1ST HEX DIGIT ACROSS SRL R1,4 MOV R0,R9 SLA R9,12 A R9,R1 MOVE 2ND HEX DIGIT ACROSS SRA R0,4 MOV R3,R9 INC R3 INCREMENT EXPONENT XOR R3,R9 WATCH FOR SIGN CHANGE ANDI R9,>80 SIGN CHANGE? JNE ERR29 Y, OVERFLOW RT TITL 'ADD AND SUBTRACT R4,R5,R6 FROM R0,R1,R2 PAGE * ABSTRACT: * * ADD OR SUBTRACT R4,R5,R6 FROM R0,R1,R2. * * CALL SEQUENCE: * * BL @FADDI * BL @FSUBI * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: (NONE) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF FADDI * FADDI A R6,R2 R0,R1,R2=R0,R1,R2+R4,R5,R6 JNC $+8 INC R1 JNC $+4 INC R0 A R5,R1 JNC $+4 INC R0 A R4,R0 ADDITION COMPLETE RT * * ENTRY POINT: * DEF FSUBI * FSUBI S R6,R2 R0,R1,R2=R0,R1,R2-R4,R5,R6 JOC $+8 DEC R1 JOC $+4 DEC R0 S R5,R1 JOC $+4 DEC R0 S R4,R0 SUBTRACTION COMPLETE RT TITL 'SCALE FPAC' PAGE * ABSTRACT: * * FPAC WILL BE SHIFTED LEFT OR RIGHT IN * ORDER TO MAKE THE EXPONENT AGREE WITH THE * SCALE FACTOR POINTED TO BY R11. THIS * OPERATION IS ESSENTIALLY THE OPPOSITE * OF NORMALIZATION. * SCALING TO >4600 PLACES THE DECIMAL POINT * BETWEEN THE SECOND AND THIRD WORD OF THE FLOATING * POINT NUMBER. SCALING TO >4A00 PLACES THE DECIMAL * POINT AFTER THE THIRD WORD. * HENCE, TO INTEGERIZE A FLOATING POINT NUMBER IN FPAC, * ONE SCALES TO >4A00 AND THEN NORMALIZES. * * CALLING SEQUENCE: * * XOP XX,6 * * EXCEPTIONS AND CONDITIONS: * * ERROR 29 WILL RESULT FROM A LEFT SHIFT * * EXTERNAL ROUTINE LIST: * * ERR29 ;ERROR 29 * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF FSCL * FSCL MOV *R11,R4 GET SCALE FACTOR CLR R3 MOV R0,R8 SAVE SIGN MOVB R8,R7 GET EXPONENT ANDI R7,>7F00 GET EXPONENT S R4,R7 GET DIFFERENCE JEQ FSCL2 ALREADY SCALED MOVB R3,R0 ZERO EXPONENT SRA R7,8 RIGHT JUSTIFY JGT ERR29 SHIFT LEFT, FP ERROR? * FSCL1 BL @FARS SHIFT RIGHT INC R7 DONE? JNE FSCL1 N MOVB R8,R0 RESTORE SIGN BIT ANDI R0,>80FF ;MASK EXPONENT AB R4,R0 FSCL2 RTWP * C7F DATA >007F CF0 DATA >00F0 CFF80 DATA >FF80 END IDT 'FUNC' * 08/16/78 * DEF SYSF,ABSF,NKYF DEF INPF REF FPAC,FPAC2 REF FIX,EVSFR REF HFLG,ENUM,ELNM,LEC REF C4A00 ERROR EQU >2F80 ERROR2 EQU ERROR+>20 * * DEFINE FLOATING POINT XOPS FOR THIS MODULE * DXOP LOADF,0 ;LOAD FPAC DXOP SCALE,6 ;SCALE PFAC DXOP NORMAL,7 ;NORMALIZE FPAC DXOP CLEAR,8 ;CLEAR FPAC DXOP NEGATE,9 ;NEGATE FPAC DXOP FLOATF,10 ;FLOAT FPAC * *SYSTEM FUNCTION * SYSF BL @FIX ;GET PARAMETER MOV R1,R1 ;0? JEQ SYSF0 ;Y SRL R1,1 JNE SYSF2 SYSF1 MOV @ENUM(9),R1 ;RETURN LAST ERROR # JMP INPF1 * SYSF0 MOV @HFLG(9),R1 ;RETURN HELP FLAG JMP INPF1 * SYSF2 MOV @ELNM(9),R1 ;GET LAST ERROR LINE # JMP INPF1 PAGE * * INTEGER PART FUNCTION * INPF MOV *R2,R1 INTEGER ALREADY? JEQ INPF3 Y LOADF *R2 N - LOAD FPAC * * IF NUMBER => SCALING FACTOR GET FLOATING PT OVERFLOW * ANDI R1,>7F00 MASK OUT ALL BUT EXPONENT C R1,@C4A00 => SCALING FACTOR? JHE INPF2 SCALE @C4A00 N - SCALE OFF FRACTION NORMALIZE 0 JMP INPF2 * INPF1 CLEAR 0 SAVE # MOV R1,@FPAC2 INPF2 LI R2,FPAC RETURN ADDRESS INPF3 B @EVSFR RETURN * *ABSOLUTE FUNCTION * ABSF LOADF *R2 ;LOAD FPAC MOV *R2,R1 ;CHECK SIGN JEQ ABSF1 ;INTEGER JGT INPF3 ;+, RT NEGATE 0 ;-, NEGATE JMP INPF2 ;RETURN * ABSF1 ABS @FPAC2 ;INTEGER, TAKE ABS JNO INPF2 ;NO OVERFLOW LI R0,>4480 ;OVERFLOW, LOAD 32768 (FP) CLR R2 LOADF R0 ;LOAD R0,R1,R2 JMP INPF2 * *NKY FUNCTION * NKYF MOV @LEC(9),R0 ;CHARACTER? JEQ INPF2 ;N, RETURN 0 SWPB R0 BL @FIX ;FIX ARGUMENT MOV R1,R1 ;ARG=0? JEQ NKYF1 ;Y, RETURN LEC S R0,R1 ;N, ARG=LEC? JNE INPF2 ;N, RETURN 0 NKYF1 MOV R1,@LEC(9) ;CLEAR LEC MOV R0,R1 JMP INPF1 END IDT 'GETLINE' * DEF GTLN DEF EDER REF AINC REF EDTMP,AUDIO2 REF B20 REF CRLF1 REF CVDIZ REF DCNT REF GETCR REF JMPR0 REF LDP5 REF LNUM REF LSTL REF NIC REF PLF REF SFSN REF TYP0 REF TYP11 REF TYPB REF TYPC REF ERRLS2 ERROR EQU >2F80 DXOP OUTINT,13 PAGE * * EDIT STATEMENT ( ^E) * GTCE MOV *R9,R7 ;GET BUFFER ADR BLWP @CVDIZ ;CONVERT # NOP DATA ERROR+15 NO SUCH LINE JG 12/1/82 BL @SFSN ;SEARCH FOR STATEMENT # MOV *R9,R7 ;RESET BUFFER ADR SETO @DCNT(9) ;RESET INDENT COUNTER BL @LSTL ;LIST LINE BL @TYPC ;OUT CRLF JMP GTCE2 * * GET INPUT LINE * R6 = MAX # OF CHARACTERS * R7 = I/O POINTER * R8 = RETURN ADR * GTLN LI R6,NIC ;MAXIMUM OF NIC CHARACTERS MOV *R9,R7 ;GET IOB PTR MOV R7,R3 MOV R6,R1 * CLR *R3+ ;CLEAR BUFFER DECT R1 ;DONE? JGT $-4 ;N * ABS @AINC(9) ;AUTO-INCREMENT? JGT GTLLP ;N JEQ GTLLP ;N MOV @LNUM(9),R1 ;ADD LINE # AI R1,10 JLT GTCR Y - TERMINATE AUTO INCR JG 12/1/82 OUTINT R1 ;CONVERT MOVB @B20,*R7+ ;SPACE * GTCE2 BL @TYPB ;TYPE LI R6,NIC ;GET NEW COUNT A *R9,R6 ;ADD BUFFER ADR S R7,R6 ;SUB CURRENT ADR PAGE GTLLP BL @GETCR ;LOOP BL @JMPR0 ;DO JUMP ON R0 GTJMP BYTE GTLD-GTJMP/2,>04 ^D BYTE GTCE-GTJMP/2,>05 ^E BYTE GTCF-GTJMP/2,>06 ^F BYTE GTBS-GTJMP/2,>08 ^H BYTE GTLI-GTJMP/2,>09 ^I BYTE GTLF-GTJMP/2,>0A LF BYTE GTCR-GTJMP/2,>0D CR BYTE GTRB-GTJMP/2,>7F RUBOUT DATA 0 CI R0,>2000 ;0700 ;OUT BELL GTLLP3 BL @TYP0 ;ECHO CHARACTER JMP GTLLP * GTLF SETO @AINC(9) ;SET AUTO-INC GTCR B @CRLF1 ;RETURN PAGE * * BACKSPACE (^H) * GTBS C *R9,R7 ;BEGINNING OF BUFFER? JEQ GTLB ;Y, OUT BELL DEC R7 ;N, BACKUP JMP GTRB1 ;OUT BACKSPACE * * RUBOUT * GTRB C *R9,R7 ;BEGINNING OF BUFFER? JEQ GTLB ;Y, OUT BELL DEC R7 ;N, BACKUP MOVB @B20,*R7 ;STORE BLANK BL @TYP11 ;OUT BKSP,BLK DATA >0820 * GTRB1 BL @TYP11 ;OUT BKSP DATA >0800 JMP GTLLP ;GOTO LOOP * * FORWARD SPACE (^F) * GTCF MOVB *R7+,R0 ;GET CHARACTER JNE GTLB+4 ;OK TO SEND DEC R7 ;TOO FAR JMP GTLB ;OUT BELL PAGE * * INSERT BLANKS (^I <# OF BLANKS>) * GTLI BL @GETCR ;GET INSERT # ANDI R0,>0F00 ;MASK SWPB R0 ;RIGHT JUSTIFY MOV R7,R5 ;SAVE CBP (CURRENT BUFFER PTR) GTLI1 DEC R6 ROOM? JLT GTLI3 N JEQ GTLI3 N MOV R5,R7 Y - RESTORE R7 MOVB @B20,R4 INSERT BLK AS 1ST CHAR GTLI2 MOVB *R7,R3 ;GET NEW MOVB R4,*R7+ ;INSERT OLD MOVB R3,R4 ;OLD=NEW JNE GTLI2 ;MORE MOVB R4,*R7 ;CLEAR BUFFER DEC R0 ;DONE? JGT GTLI1 ;N * * INSERT, DELETE, EDER ENTRY * GTLI3 BL @TYPC ;OUT CRLF BL @TYPB ;OUT BUFFER BL @TYP11 ;OUT CR ONLY DATA >0D00 MOV *R9,R7 GTLI4 C R7,R5 ;POSITIONED? JHE GTLLP ;Y, GOTO LOOP CLR R0 MOVB *R7+,R0 ;N, OUT CHARACTER BL @TYP0 JMP GTLI4 ;DO AGAIN * * DELETE CHARACTERS (^D <# OF CHARS>) * GTLD BL @GETCR ;GET # ANDI R0,>0F00 ;MASK SWPB R0 ;RIGHT JUSTIFY GTLD1 MOV R7,R5 ;LOAD PTRS MOV R7,R2 MOVB *R2+,R1 ;LOOK AT 1ST BYTE,23 APRIL79 HJC JEQ GTLI3 ;ZERO INC R6 ;SOMETHING TO DELETE MOVB *R2+,*R5+ ;MOVE CHARACTER BACK JNE $-2 ;MORE TO MOVE DEC R0 ;DONE? JGT GTLD1 ;N GTLD2 MOV R7,R5 ;Y, MARK JMP GTLI3 PAGE * * EDIT ERROR RECOVERY ROUTINE * * IF AN ERROR OCCURRED WHILE LOADING A TAPE FROM * AUDIO CASSETTE THEN DO AN IMMEDIATE RETURN * EDER MOV @PLF(R9),R14 GET DEVICE TYPE CI R14,2 AUDIO CASSETTE? JEQ EDERRT Y - IMMEDIATE RETURN MOV *R11,R3 N - PICKUP ERROR CHARACTERS DEC R7 BL @ERRLS2 OUTPUT ERROR MESSAGE MOV @EDTMP,R6 RESTORE # 'FREE SPACES' IN IOB INC R14 LOADING? JEQ GTLD2 N BL @TYPC Y - OUTPUT CRLF BL @TYPB OUTPUT LINE IN ERROR EDERRT CLR @AUDIO2 INDICATE ERROR HAS OCCURRED B @LDP5 RETURN TO LOAD ROUTINE END IDT 'GETP2' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * GETP2 ;GET POWER OF 2 * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * DXOP FMUL,4 ;MULTIPLY FPAC * * EXTERNAL DATA: * REF CVCH ;VARIABLE HOLDER * * MODULE EQUATES: (NONE) * * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'GET POWER OF 2' * TITL PAGE * ABSTRACT: * * GETP2 WILL RETURN A 3 WORD FLOATING * POINT POWER OF 2 AS SPECIFIED BY R2. * * CALLING SEQUENCE: * * BL @GETP2 * * IN R2 = 1,2 OR 3 * OUT CVCH = # * * * EXCEPTIONS AND CONDITIONS: (NONE) * * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF GETP2 * GETP2 LI R2,GETPC-2 SRA R2,1 ;/2 A R3,R2 ;INDEX SLA R2,1 ;MAKE WORD INDEX MOV *R2,@CVCH ;MOVE INTO CONSTANT FMUL @CVCH ;MULTIPLY FPAC RT * GETPC DATA >4120,>4140,>4180 POWERS OF 2 END IDT 'GETPARM' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * GPRM,GPRM1,GPRM2 ;GET PARAMETER * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * DXOP EVFIX,11 ;EVALUATE AND FIX ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) ERROR2 EQU ERROR+>20 * * EXTERNAL DATA: (NONE) * * MODULE EXTERNALS: * DEF B4A ;>4A * * MODULE EQUATES: (NONE) * * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'GET PARAMTERS' PAGE * ABSTRACT: * * FIX PARAMETERS SUCH THAT: * * XXX[ (R2) , R1 ] = R3 * * DIFFERENT ENTRY POINTS WILL PICK UP * THE EVALUATION AND CHECKING AT * DIFFERENT POINTS. * * CALLING SEQUENCE: * * BL @GPRM * BL @GPRM1 * BL @GPRM2 * * IN (R2) = VARIABLE * OUT R1 = INDEX * R3 = ASSIGNMENT FIXED * * EXCEPTIONS AND CONDITIONS: * * EVALUATION ERRORS, FIX ERRORS, AND * EXPECTING OPERATOR. * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF GPRM,GPRM1,GPRM2 * GPRM CB *R8+,@B4A ;RIGHT BRACKET? JNE ERR1 ;N, ERROR * GPRM1 EVFIX R1 ;GET INDEX * GPRM2 CI R0,>4B00 ;]? JNE ERR1 ;N CB @B56,*R8+ ;=? JNE ERR36 ;N EVFIX R3 ;GET RESULT RT * ERR1 DATA ERROR+1 ERR36 DATA ERROR2,36 B4A BYTE >4A B56 BYTE >56 END IDT 'GOSUB' TITL 'GOSUB/GOTO COMMANDS' * * ROUTINE LIST: * * GOTY ;GOTO COMMAND * GOSY ;GOSUB COMMAND * RTNY ;RETURN COMMAND * POPY ;POP COMMAND * * EXTERNAL ROUTINES: * REF SFSN,CRLF REF LINE0,LINE2,LINE5,NLIN0 DXOP EVFIX,11 ERROR EQU >2F80 XOP XX,14 (ERROR CALL) ERROR2 EQU ERROR+>20 * * EXTERNAL DATA: * REF ELNM ;ERROR LINE NUMBER REF FNS ;FOR/NEXT STACK REF GSC ;GOSUB STACK COUNTER REF GSS ;GOSUB STACK REF PLC ;PROGRAM LINE COUNTER REF SLT ;STATEMENT LOCATION TABLE REF BUS ;BEGINNING USER STORAGE REF C4 ;>0004 * * ABSTRACT: * * EXECUTE GOTO, GOSUB AND SYSTEM GOSUB COMMANDS. * PROVIDE FOR ON COMMAND * * STACK FORMAT: PLC * PBC * * PLC * PBC * * ... * * IF PBC = 0, GOTO NEXT LINE, OTHERWISE CONTINUE EXECUTION ON * THE SAME LINE AS THE CALL WAS MADE (NEEDED FOR ON COMMAND TO * ENSURE YOU DO NOT JUMP BACK INTO THE PARAMETER LIST.) * * CALLING SEQUENCE: * * B @GOSB1 * B @GOSY * B @GOTY * * EXIT TO LINE0 IN DEMULTIPLEXOR (RUN) * * EXCEPTIONS AND CONDITIONS: * * STACK OVERFLOW * STACK UNDERFLOW * NO SUCH LINE # * PAGE * * ENTRY POINT: * DEF GOSY ;GOSUB COMMAND DEF GOS1,GOS2 DEF GOSB1 ;SYSTEM ENTRY DEF GOSON ;ON COMMAND ENTRY DEF GOTY ;GOTO ENTRY * * ENTRY FOR INPUT ERROR HANDLER/ERRECOVY * GOSB1 MOV @PLC(9),R5 GET ADDRESS OF CURRENT LINE MOV @-2(5),@ELNM(9) GET ERROR LINE # CLR R6 SET FOR FIRST OF NEXT LINE JMP GOS1A * * ENTRY FOR CONT (EDIT) * GOS2 MOV @PLC(R9),R5 GET ADDRESS OF CURRENT LINE JMP GOS2A * * INTERRUPT ENTRY POINT (RUN) * GOS1 MOV @PLC(R9),R5 GET ADDRESS OF CURRENT LINE JMP GOS1A * * GOTO ENTRY - CHECK SYNTAX (VALID TERMINATOR?) * GOTY CLR R3 INDICATE A GOTO JG 12/1/82 JMP GOSYA * * GOSUB ENTRY - CHECK SYNTAX (VALID TERMINATOR?) * GOSY SETO R3 INDICATE A GOSUB JG 12/1/82 GOSYA MOV R8,R6 ;SET TO SAVE PBC INCT R6 CLR R0 MOVB *R6+,R0 ;GET DELIMITER JEQ GOSY1 ;EOL CI R0,>3C00 ;::? JEQ GOSON1 ;Y JG 02/3/82 CI R0,>4700 ;!? JNE GOSYE N - ERROR * * ON ENTRY POINT - IGNORE REST OF THE LINE * GOSON EQU $ JG 12/1/82 GOSY1 MOV @PLC(9),R5 SAVE ADD OF CURRENT STMT # JG 12/1/82 JEQ GOSON1 ENTERED FROM KEYBOARD MODE? JG 15/1/82 MOV R3,R3 N - GOTO? JG 12/1/82 JEQ GOSON1 Y JG 12/1/82 * * GOSUB - NOTHING FOLLOWING STATEMENT - GET PBC OF NEXT LINE * MOV R5,R6 GOTO NEXT STATMENT JG 12/1/82 AI R6,-4 C R6,@SLT(9) ;DONE? JL GOS6A Y - SET PBC=0 JG 12/1/82 MOV R6,@PLC(9) ;N, UPDATE MOV *R6,R6 A @BUS(9),R6 GOSON1 MOVB *R8+,R1 GET LINE NUMBER SWPB R1 MOVB *R8+,R1 SWPB R1 SRL R2,2 GOTO? JEQ GOS2A GOS1A MOV @GSC(9),R3 N - GOSUB C R3,@FNS(9) ;ROOM? JHE ERR11 ;N, ERROR MOV R6,*R3+ ;Y, SAVE PBC OR NULL AND PLC MOV @PLC(9),*R3+ MOV R3,@GSC(9) ;UPDATE GSC GOS2A BL @SFSN SEARCH FOR STATEMENT # B @LINE0 * GOS6A CLR R6 PBC=0 JG 12/1/82 JMP GOSON1 JG 12/1/82 * ERR11 DATA ERROR+11 ;STACK OVERFLOW ERR12 DATA ERROR+12 ;STACK UNDERFLOW GOSYE DATA ERROR2,37 ILLEGAL DELIMITER TITL 'RETURN COMMAND' PAGE * * ABSTRACT: * * POPS THE RETURN ADDRESS FROM THE GOSUB STACK (GSS) AND * EFFECTS A TRANSFER TO THAT POPPED ADDRESS. IF THE * UNSTACKED PLC = 0 THEN IT INDICATES THAT THE GOSUB WAS * ENTERED DIRECTLY FROM KEYBOARD MODE. IF THE PBC <> 0 * THEN AN EXIT IS MADE TO THE LINE DEMULTIPLEXER; OTHERWISE * A NEW STATMENT LINE IS INTERPRETED. * * CALLING SEQUENCE: * * B @RTNY * * EXIT TO MULTIPLEXOR * * EXCEPTIONS AND CONDITIONS: * * STACK UNDERFLOW * * ENTRY POINT: * DEF RTNY * RTNY MOV @GSC(9),R3 ;SEE IF STACK EMPTY C R3,@GSS(9) ;EMPTY? JLE ERR12 ;Y DECT R3 ;N, POP PLC MOV *R3,R5 JG 15/1/82 DECT R3 ;POP PBC MOV R3,@GSC(9) ;UPDATE GSC MOV R5,@PLC(R9) UPDATE THE PLC JG 15/1/12 JEQ RTRN3 0 - KEYBOARD MODE WHEN STACKED JG 15/1/12 MOV *R3,R8 ;GET PBC JEQ RTRN2 ;0, GOTO NEXT LINE (ON) B @LINE2 * RTRN2 B @LINE5 * RTRN3 B @CRLF RETURN TO INTERPRETER LOOP JG 15/1/82 TITL 'POP COMMAND' PAGE * * ABSTRACT: * * POP THE PLC AND PBC FROM THE GOSUB STACK AND THROW * THE VALUES AWAY. * * CALLING SEQUENCE: * * B @POPY * * EXIT TO NLIN0 * * EXCEPTIONS AND CONDITIONS: * * STACK UNDERFLOW * * ENTRY POINT: * DEF POPY * POPY C @GSC(9),@GSS(9) JLE ERR12 S @C4,@GSC(9) B @NLIN0 * END IDT 'IF' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * IFY ;IF COMMAND * * COPY: (NONE) * * MACRO: (NONE) * * EXTERNAL ROUTINES: * REF EVERZ ;EVALUATE EXPRESSION REF EVSDZ ;EVALUATE STRING REF LINE,NLIN ;MULTIPLEXOR ENTRY POINTS DXOP EVFIX,11 ;EVALUATE AND FIX ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) ERROR2 EQU ERROR+>20 * * EXTERNAL DATA: * REF ELSF ;ELSE FLAG * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'IF COMMAND' PAGE * ABSTRACT: * * EXECUTE THE IF COMMAND. THE FORM IS: * * IF THEN * IF THEN * IF THEN * IF , * THEN * * CALLING SEQUENCE: * * B @IFY * * EXIT TO LINE OR NLIN * * EXCEPTIONS AND CONDITIONS: * * ILLEGAL DELIMITER, SYNTAX ERROR * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) PAGE * ENTRY POINT: * DEF IFY * IFY CLR @ELSF(9) ;CLEAR ELSE FLAG BLWP @EVSDZ ;CHECK FOR " OR $ JMP IF2 JMP IF2 BLWP @EVERZ ;# MOV *R2+,R1 JNE IFRT MOV *R2,R1 JNE IFRT JMP IF13 * IF2 CI R0,>3B00 ;THEN? JNE IF4 ;N * IF3 MOVB *R2,R1 ;Y, STRING? JNE IFRT ;Y, CONTINUE JMP IF13 ;N, GOTO LINE * IF4 SWPB R0 AI R0,->55 ;LEGAL? JGT IF5 ;Y IFE37 DATA ERROR2,37 ;N * IF5 CI R0,>6 JGT IFE37 ;N MOV R0,R6 MOV R2,R3 ;STRINGS SETO R5 BLWP @EVSDZ ;GET SECOND OPERAND JMP IF7 ;" JMP IF7 ;$ DATA ERROR+14 ;EXPECTING STRING * IFRT B @NLIN * IF6 MOVB *R2+,R1 ;LOAD BYTE FROM SECOND STRING JNE $+4 ;OK SETO R1 ;NULL SB R4,R1 ;SAME BYTE? JNE IF10 ;N DEC R5 ;Y, DONE? JEQ IF11 ;Y * IF7 CI R0,>3F00 ;,? JNE IF8 ;N EVFIX R5 ;Y, GET COUNT * IF8 LI R0,4 ;GET MATCH MOVB *R3+,R4 ;SOURCE NULL? JNE IF6 ;N * IF9 MOVB *R2+,R1 ;LOAD BYTE FROM SECOND STRING IF10 JGT IF12 ;POSITIVE JNE $+4 ;NEGATIVE IF11 DEC R0 ;ZERO DECT R0 * IF12 COC R0,R6 ;CONDITION MET? JEQ IFRT ;Y IF13 SETO @ELSF(9) ;N B @LINE END