*VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF ATNF * ATNF EQU $ BL @FUNFX ;FIX JMP ATNF5 ;0 * ATNF0 CLR R1 MOVB *R2,R1 CLR R4 MOV @FPAC,R2 S @ATNC6,R2 ;<1? JLT ATNF1 ;Y STORE @TEMP ;MOVE TO TEMP LOADF @ATNC6 ;LOAD 1 FDIV @TEMP ;GET INVERSE INC R4 ;SET FLAG * ATNF1 STORE @TEMP ;MOVE TO TEMP FSUB @ATNC0 ;F-C0 MOV @FPAC,R2 ;GET SIGN LOADF @TEMP ;MOVE TEMP TO FPAC MOV R2,R2 ;>.268...? JLT ATNF2 ;N FADD @ATNC1 ;Y STORE @DS SAVE IN DS LOADF @TEMP ;MOVE TEMP TO FPAC FMUL @ATNC1 FSUB @ATNC6 ;SUBTRACT 1 FDIV @DS F=F/DS * ATNF2 STORE @DS STORE IN DS BL @PLYXX ;EVALUATE DATA ATNC2 STORE @DS1 SAVE IN DS1 BL @PLYX ;EVALUATE DATA ATNC3 FDIV @DS1 DIVIDE BY DS1 FMUL @DS MULTIPLY BY DS MOV R2,R2 ;WAS IT >.268...? JLT ATNF3 ;N FADD @ATNC4 ;Y, ADD CONSTANT * ATNF3 DEC R4 JNE ATNF4 FADD @ATNC5 * ATNF4 SRC R3,1 ;GET SIGN BIT SZC @C8000,@FPAC A R3,@FPAC ;ADD SIGN ATNF5 LI R2,FPAC ;GET VALUE B @EVSFR ;AND RETURN * C8000 DATA >8000 ATNC0 DATA >4044,>9851,>7A7B ATNC1 DATA >411B,>B67A,>E858 ATNC2 DATA 4 ATNC6 DATA >4110,>0000,>0000 DATA >4225,>10EB,>4200 DATA >42CF,>B153,>9710 DATA >4316,>CA99,>3433 DATA >42C5,>33FE,>142D ATNC3 DATA 3 DATA >41C9,>8867,>F42A DATA >427D,>9444,>406E DATA >4312,>AED9,>3E72 DATA >42C5,>33FE,>142D ATNC4 DATA >4086,>0A91,>C16C ATNC5 DATA >C119,>21FB,>5444 END IDT 'BASE' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * BASY ;BASE COMMAND * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * REF NLIN ;EXIT TO MULTIPLEXOR DXOP EVFIX,11 ;EVALUATE AND FIX * * EXTERNAL DATA: * REF BCRU ;BASE CRU INDEX * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'BASE COMMAND' PAGE * ABSTRACT: * * THE BASE COMMAND WILL SET A CRU BASE * THAT IS USED BY CRM AND CRF * FUNCTIONS: * * CALLING SEQUENCE: * * B @BASY * * EXIT TO NLIN * * EXCEPTIONS AND CONDITIONS: * * EVALUATION ERRORS * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF BASY * BASY EVFIX @BCRU(9) ;SAVE B @NLIN END IDT 'BITF' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * BITF ;BIT FUNCTION * BITY ;BIT COMMAND * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * REF EVSFR ;EXIT TO EVALUATOR REF NLIN ;EXIT TO MULTIPLEXOR REF EVERZ ;EVALUATE EXPRESSION REF GPRM1 ;GET-PARAMETER ENTRY DXOP STORE,1 ;STORE FPAC DXOP EVFIX,11 ;EVALUATE AND FIX DXOP OUTFP,12 ;OUT FLOATING POINT # ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) * * EXTERNAL DATA: * REF FPAC,FPAC2 ;FLOATING POINT ACCUMULATOR * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'BIT COMMAND' PAGE * ABSTRACT: * * THE BIT COMMAND ALLOWS A PBASIC STATEMENT * TO ALTER ANY BIT WITHIN A PBASIC * VARIABLE. THE FORM IS: * * BIT[ , ] = * * WHERE: = VARIABLE TO BE ALTERED * = BIT POSITION WITHIN VARIABLE * = 0 OR <>0 TO RESET OR SET * * CALLING SEQUENCE: * * B @BITY * * EXIT TO NLIN * * EXCEPTIONS AND CONDITIONS: * * EVALUATION ERRORS * ERROR 1 IF BRACKETS MISSING OR NO ", * * EXTERNAL ROUTINE LIST: * * NLIN ;EXIT TO MULTIPLEXOR * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF BITY * BITY CB *R8+,@B4A ;RIGHT BRACKET? JNE ERR1 ;N, ERROR BLWP @EVERZ ;GET ADR CI R0,>3F00 ;,? JNE ERR1 ;N BL @GPRM1 ;GET PARAMETERS DEC R1 MOV R1,R0 ;GET WORD INDEX SRL R1,3 A R1,R2 ;INDEX LI R1,>8000 SRC R1,0 ;POSITION MASK SZC R1,*R2 ;SET BIT TO ZERO MOV R3,R3 ;NEED 1? JEQ BITY1 ;N SOC R1,*R2 ;Y, SET BIT TO ONE BITY1 B @NLIN ;RETURN ERR1 DATA ERROR+1 B4A BYTE >4A EVEN TITL 'BIT FUNCTION' PAGE * ABSTRACT: * * THE BIT FUNCTION WILL DISPLAY ANY * BIT VALUE WITHIN A PBASIC VARIABLE. * * BIT[ , ] * * WHERE = PBASIC VARIABLE * = BIT POSITION * * CALLING SEQUENCE: * * B @BITF * * EXIT TO EVSFR * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: * * LOCAL DATA: * * ENTRY POINT: * DEF BITF * BITF DEC R1 MOV R1,R0 SRL R1,3 ;GET WORD INDEX A R1,R2 ;INDEX LI R1,>8000 ;GET INITIAL MASK SRC R1,0 ;SHIFT MOV *R2,R2 ;GET WORD COC R1,R2 ;BIT SET? JNE BITF1 ;N, RETURN 0 INC @FPAC2 ;Y, RETURN 1 * BITF1 LI R2,FPAC ;RETURN ADR B @EVSFR END IDT 'CLLY' TITL 'CALL USER PROGRAM' * DEF CLLY REF EVSDZ REF NLIN REF CLLWP,CLWP12,CALVEC ERROR EQU >2F80 DXOP EVFIX,11 * * CALL COMMAND * * CALL "ROUTINE NAME",ADDRESS,PARMS * * PARMS (UPTO 12) ARE SEPARATED BY COMMAS * THESE ARE STORED IN THE USER'S REGISTERS R0 - R11; * R12 CONTAINS THE NUMBER OF ARGUMENTS PASSED OVER. * * PARMS SHOULD BE EITHER: * INTEGER VALUES/EXPRESSIONS OR * THE ADDRESS OF THE VARIABLE/ARRAY ELEMENT * CONTAINING THE DESIRED PARAMETER. * * THE ADDRESS OF X IS PASSED BY - ADR(X) * CLLY BLWP @EVSDZ CHECK FOR "STRING" JMP CLL1 "STRING" NOP $VAR - ERROR 1 DATA ERROR+1 NEITHER - ERROR 1 * * SET UP THE BLWP VECTOR (CALLVEC) TO THE USER'S PROG * CLL1 LI R10,CALVEC GET ROUTINE'S ADDRESS LI R12,CLLWP REF "USER'S" WORKSPACE LI R11,CLWP12 REF LAST+1 USEABLE REGISTER SETO R2 CLEAR COUNT MOV R12,*R10+ SET CALLVEC'S WP CLL2 INC R2 INCREMENT COUNT EVFIX *R10+ STUFF NEXT ARGUMENT INTO REGISTER CI R0,>3F00 MORE ARGUMENTS? JNE CLL4 N - FINISH C R10,R11 REGISTER'S FULL? JL CLL2 N - BACK FOR NEXT ARGUMENT * * ALL ARGUMENTS HAVE BEEN STORED IN THE REGISTERS * (OR ALL THAT ARE GOING TO BE HANDLED) * CLL4 MOV R2,*R11 SAVE COUNT IN USER'S R12 BLWP @-4(R12) BLWP TO USER'S ROUTINE B @NLIN RETURNS TO HERE END IDT 'CHRF' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * SRHF ;STRING SEARCH FUNCTION * MCHF ;STRING MATCH FUNCTION * LENF ;STRING LENGTH FUNCTION * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * REF EVSFR ;EXIT ENTRY TO EVALUATOR * * EXTERNAL DATA: * REF FPAC,FPAC2 ;FLOATING POINT ACCUMULATOR * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'STRING SEARCH FUNCTION' PAGE * ABSTRACT: * * SRH WILL SEARCH FOR THE FIRST STRING * IN THE SECOND STRING AND RETURN THE * STARTING CHARACTER POSITION OF THE * FIRST MATCH IF FOUND. OTHERWISE RETURN * A 0. * * CALLING SEQUENCE: * * B @SRHF * * EXIT TO EVSFR * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF SRHF * SRHF INC @FPAC2 ;COUNT MOVB *R1+,R0 ;GET FIRST BYTE JEQ SRHF2 ;NOT FOUND, RETURN 0 CB *R2,R0 ;SAME? JNE SRHF ;N, CONTINUE LOOKING MOV R2,R3 ;Y, LOOK FURTHER INC R3 MOV R1,R4 * SRHF1 MOVB *R3+,R0 ;MATCH? JEQ SRHF3 ;Y, RETURN FPAC CB R0,*R4+ ;SAME? JEQ SRHF1 ;Y, CONTINUE JMP SRHF ;N, START AGAIN * SRHF2 CLR @FPAC2 SRHF3 LI R2,FPAC B @EVSFR TITL 'CHARACTER MATCH FUNCTION' PAGE * ABSTRACT: * * MATCH STRING 1 INTO STRING 2 AND RETURN * THE NUMBER OF CHARACTERS TO WHICH THEY * AGREE. * * CALLING SEQUENCE: * * B @MCHF * * EXIT TO EVSFR * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL FUNCTION LIST: (NONE) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF MCHF * * MCHF CB *R2,*R1+ SAME? JNE SRHF3 N MOV *R2,*R2+ Y - BUT WERE THEY NULL? JEQ SRHF3 Y - THEN DON'T COUNT INC @FPAC2 N - NOT NULL; THEN COUNT JMP MCHF TITL 'STRING LENGTH FUNCTION' PAGE * ABSTRACT: * * RETURN THE STRING LENGTH (THE FIRST * NULL BYTE. * * CALLING SEQUENCE: * * B @LENF * * EXIT TO EVSFR * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: (NONE) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF LENF * * LENF MOVB *R2+,R1 JEQ SRHF3 ;DONE INC @FPAC2 ;COUNT JMP LENF * END IDT 'CRUF' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * CRBY ;CRB COMMAND * CRBF ;CRB FUNCTION * CRFY ;CRF COMMAND * CRFF ;CRF FUNCTION * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * REF FIX ;INTEGER FIX REF EVSFR ;ENTRY EXIT TO EVALUATOR REF NLIN ;ENTRY EXIT TO MULTIPLEXOR REF GPRM ;GET PARAMETER DXOP OUTINT,13 ;OUT INTEGER ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) * * EXTERNAL DATA: * REF FPAC,FPAC2 ;FLOATING POINT ACCUMULATOR REF BCRU ;BASE CRU INDEX * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'MULTIPLE-BIT CRU STORE (CRF)' PAGE * ABSTRACT: * * STORE MULTIPLY BIT TO CRU LINES AT * CRU BASE AS SELECTED BY BASE COMMAND. * * CALLING SEQUENCE: * * B @CRFY * * EXIT TO NLIN * * EXCEPTIONS AND CONDITIONS: * * PARAMETER AND EVALUATION ERRORS * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF CRFY * CRFY BL @GPRM ;GET PARAMETERS ANDI R1,>F ;MASK COUNT JEQ CRF1 ;0=16 BITS CI R1,8 ;BYTE? JGT CRF1 ;N SWPB R3 ;Y * CRF1 SLA R1,6 ;POSITION AI R1,>3003 ;MAKE 'LDCR R3,X' JMP CRBY1 TITL 'SINGLE-BIT CRU STORE (CRB)' PAGE * ABSTRACT: * * STORE SINGLE CRU BIT AS A DISPLACEMENT * FROM CRU BASE AS SPECIFIED BY * BASE COMMAND. * * CALLING SEQUENCE: * * B @CRBY * * EXIT TO NLIN * * EXCEPTIONS AND CONDITIONS: * * EVALUATION AND PARAMETER ERRORS * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: (NONE) * * ENTRY POINT * DEF CRBY * CRBY BL @GPRM ;GET DISPLACEMENT ANDI R1,>FF ;MASK AI R1,>1D00 ;GET SBO MOV R3,R3 ;SET TO 1? JNE CRBY1 ;N AI R1,>0100 ;Y, CHANGE TO SBZ * CRBY1 MOV @BCRU(9),R12 X R1 ;DO CRU INSTRUCTION B @NLIN ;RETURN TITL 'MULTIPLE-BIT CRU READ (CRF)' PAGE * ABSTRACT: * * READ FROM CRU LINES THE ARGUMENT NUMBER OF * BITS. * * CALLING SEQUENCE: * * B @CRFF * * EXIT TO EVSFR * * EXCEPTIONS AND CONDITIONS: * * FIX ERROR * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF CRFF * CRFF BL @FIX ;GET PARAMETER ANDI R1,>F ;MASK MOV R1,R0 ;SAVE SLA R1,6 ;POSITION AI R1,>3401 ;MAKE 'STCR R1,X' MOV @BCRU(9),R12 ;GET BASE X R1 ;DO STCR MOV R0,R0 ;16? JEQ CRFF1 ;Y CI R0,8 ;N, BYTE? JGT CRFF1 ;N SRL R1,8 ;Y, POSITION RESULTS * CRFF1 MOV R1,@FPAC2 CRFF2 LI R2,FPAC ;RETURN ADR B @EVSFR TITL 'SINGLE-BIT CRU READ (CRB)' PAGE * ABSTRACT: * * READ 1 CRU BIT GIVEN BY THE CRU BASE * AND THE ARGUMENT DISPLACEMENT. * * CALLING SEQUENCE: * * B @CRBF * * EXIT TO EVSFR * * EXCEPTIONS AND CONDITIONS: * * FIX ERROR * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF CRBF * CRBF BL @FIX ;GET DISPLACEMENT ANDI R1,>FF ;MASK AI R1,>1F00 ;MAKE 'TB XX' MOV @BCRU(9),R12 ;GET BASE X R1 ;DO TEST JNE CRFF2 ;0, RT INC @FPAC2 ;1 JMP CRFF2 END IDT 'CVBD' * 08/09/78 * DEF CVBD,CVBI,CVBFR REF FPAC,FPAC2 REF CVHD,CVHD01,CVHD15,CVHD12 REF FFLG REF FADDI,FSUBI REF CVGCN,B01,B05 REF CVBF * * DEFINE FLOATING POINT XOPS FOR THIS MODULE * DXOP LOADF,0 ;LOAD FPAC DXOP STORE,1 ;STORE FPAC DXOP FADD,2 ;ADD TO FPAC DXOP FSUB,3 ;SUBTRACT FROM FPAC DXOP FMUL,4 ;MULTIPLY FPAC DXOP FDIV,5 ;DIVIDE 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 * DXOP EVFIX,11 ;EVALUATE AND FIX DXOP OUTFP,12 ;OUT FLOATING POINT # DXOP OUTINT,13 ;OUT INTEGER ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) ERROR2 EQU ERROR+>20 PAGE ERR34 DATA ERROR2,34 ;UNNORMALIZED # * *OUTPUT INTEGER * CVBI CLEAR 0 ;CLEAR FPAC MOV *R11,@FPAC2 JMP CVBD0 * *OUTPUT FLOATING POINT # * CVBD LI R10,FPAC ;GET FPAC ADDRESS MOVB *R11+,*R10+ MOVB *R11+,*R10+ MOVB *R11+,*R10+ MOVB *R11+,*R10+ MOVB *R11+,*R10+ MOVB *R11,*R10 * CVBD0 FLOATF 0 ;FLOAT FPAC IF NECESSARY CLR R12 ;CLEAR SIGN FLAG LI R7,CVHD ;GET HOLD ADR SB *R7,*R7+ ;CLEAR FIRST BYTE MOV @FPAC,R1 ;CHECK FOR ZERO JLT CVBD1 ;NEGATIVE JGT CVBD2 ;POSITIVE MOVB @B30,*R7+ ;ZERO, OUT "0 LI R10,12 ;SET DIGIT COUNT JMP CVBD12 * CVBD1 NEGATE 0 ;NEGATE FPAC SETO R12 ;SET FLAG * CVBD2 ANDI R1,>00F0 ;NORMALIZED? JEQ ERR34 ;N CLR R10 ;CLEAR DECIMAL ADJUST COUNTER * CVBD3 MOVB @FPAC,R1 GET EXPONENT SRL R1,8 LI R8,>4A GET EXP=4A (16^10) S R1,R8 JEQ CVBD6 EXP=4A JLT CVBD4 EXP<4A (MUL) * BL @CVGCN FIX A R8,R10 UPDATE DECIMAL ADJUSTOR FMUL *R0 MULTIPLY JMP CVBD3 * CVBD4 NEG R8 R8=-R8 BL @CVGCN S R8,R10 UPDATE DECIMAL ADJUSTOR FDIV *R0 DIVIDE JMP CVBD3 * CVBD5 BL @FADDI WENT NEG, ADD BACK INC R10 JMP CVBD7 * CVBD6 STORE R0 LOAD FPAC IN R0,R1,R2 ANDI R0,>00FF CLEAR EXPONENT LI R3,CVTB0 GET TABLE ADR LI R9,>30 "0 * CVBD7 MOV *R3+,R4 GET 1ST # MOV *R3+,R5 MOV *R3+,R6 BL @FSUBI R0,R1,R2=R0,R1,R2-R4,R5,R6 JLT CVBD5 WENT NEG, ADD BACK * CVBD8 INC R9 COUNT BL @FSUBI ;R0,R1,R2=R0,R1,R2-R4,R5,R6 JEQ CVBD8 JGT CVBD8 BL @FADDI WENT NEGATIVE, ADD BACK SWPB R9 READY BYTE FOR STORING MOVB R9,*R7+ MOVE INTO BUFFER LI R9,>2F RELOAD R9 MOV *R3+,R4 GET NEXT CONSTANT MOV *R3+,R5 MOV *R3+,R6 CI R3,CVTB0E DONE? JLE CVBD8 N PAGE *CONVERSION DONE, ROUND AND SUPPRESS TRAILING ZERO'S * * R10 = F = .001 * E = .01 * D = .1 * C = 1 * B = 10 * A = 100 * CVBD12 SB *R7,*R7+ OUT NULL CI R7,CVHD15 DONE? JL CVBD12 N * MOV @14(13),R7 GET OUTPUT BUFFER PTR MOV @18(13),R9 GET POINTERS LI R0,10 GET ROUNDING DIGIT COUNT MOV @FFLG(9),R9 FORMATTING? JNE CVBFP Y BL @CVBFR N, ROUND DEC R10 NEW DIGIT CLR R4 CLEAR TRAILING ZEROES * CVBD16 CB @B30,*R5 "0? JNE CVBD17 N MOVB R4,*R5 Y, MAKE NULL DEC R5 BACKUP 1 DIGIT JMP CVBD16 * CVBFP B @CVBF DO FORMATTING * *SET SIGN AND GET INITIAL PTRS * CVBD17 MOV R12,R12 NEGATIVE? JEQ $+6 N MOVB @B2D,*R7+ Y, OUT "- PAGE *PROCESS FORMAT FREE # * DECT R10 >E11? JLT CVBD27 Y CI R10,16 N, 30 ;ADD BITS AI R10,>30 SWPB R9 ;POSITION SWPB R10 MOVB R9,*R7+ ;MOVE INTO STREAM MOVB R10,*R7+ JMP CVBD25 ;RETURN PAGE * *ROUND CHARACTER STRING TO R0 TH POSITION * CVBFR LI R6,CVHD01 GET STRING ADR MOVB @B30,@CVHD12 FORCE 12TH DIGIT TO '0' A R0,R6 INDEX TO ROUNDING POSITION MOVB R0,R0 ABLE TO ROUND? JNE CVBFR3 N MOV R6,R5 Y, MARK INC R6 * MOVB *R6,R3 GET ROUNDING DIGIT JEQ CVBFR3 DONE MOVB R0,*R6 SET TO NULL AB @B05,R3 ADD 5 CB @B3A,R3 CARRY? JH CVBFR3 N, DONE * CVBFR1 DEC R6 Y, HANDLE CARRY MOVB *R6,R0 EOS? JEQ CVBFR2 Y, INSERT NEW DIGIT AB @B01,*R6 N, ADD CARRY CB @B3A,*R6 CARRY? JH CVBFR3 N, DONE MOVB @B30,*R6 Y, INSERT "0 JMP CVBFR1 CONTINUE * CVBFR2 X *R11 NEW DIGIT, ADJUST R10 MOVB @B31,*R6 INSERT "1 * CVBFR3 LI R3,CVHD GET INITIAL PTR MOVB *R3+,R6 NULL? JEQ CVBFR4 Y DEC R3 N, MOVE BACK CVBFR4 B @2(11) RETURN * * CVTB0 DATA >00E8,>D4A5,>1000 DATA >0017,>4876,>E800 DATA >0002,>540B,>E400 DATA >0000,>3B9A,>CA00 DATA >0000,>05F5,>E100 DATA >0000,>0098,>9680 DATA >0000,>000F,>4240 DATA >0000,>0001,>86A0 DATA >0000,>0000,>2710 DATA >0000,>0000,>03E8 DATA >0000,>0000,>0064 C000A EQU $+4 DATA >0000,>0000,>000A DATA >0000,>0000,>0001 CVTB0E EQU $ * B2A BYTE >2A B2D BYTE >2D B2E BYTE >2E B30 BYTE >30 B31 BYTE >31 B3A BYTE >3A B45 BYTE >45 EVEN END IDT 'CVDB' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * 30 MAY 79 ;COPY AND UPDATE TO REL5 * ROUTINE LIST: * * CVDIZ ;CONVERT DECIMAL TO BINARY INTEGER * CVDIFZ ;CONVERT DECIMAL TO FLOATING POINT * CVDB20 ;GET NEXT DIGIT * * COPY: (NONE) * * MACRO: (NONE) * * EXTERNAL ROUTINES: * REF CVGCN1 ;GET FLOATING POINT CONSTANT * DXOP LOADF,0 ;LOAD FPAC DXOP STORE,1 ;STORE FPAC DXOP FADD,2 ;ADD TO FPAC DXOP FSUB,3 ;SUBTRACT FROM FPAC DXOP FMUL,4 ;MULTIPLY FPAC DXOP FDIV,5 ;DIVIDE FPAC DXOP SCALE,6 ;SCALE FPAC DXOP NORMAL,7 ;NORMALIZE FPAC DXOP CLEAR,8 ;CLEAR FPAC DXOP NEGATE,9 ;NEGATE FPAC DXOP FLOATF,10 ;FLOAT FPAC ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) ERROR2 EQU ERROR+>20 * * EXTERNAL DATA: * REF TEMP ;3 WORD TEMPORARY STORAGE REF CVCH ;CONVERSION HOLDING AREA REF WPR2 ;SECONDARY WORKSPACE REF CVC10 ;FLOATING POINT CONSTANTS REF FPAC FLOATING POINT ACCUMULATOR * * MODULE EQUATES: (NONE) * * * MODULE VARIABLES AND CONSTANTS: * TITL "CONVERT DECIMAL TO BINARY" PAGE * ABSTRACT: * * CVDIZ AND CVDIFZ CONVERT A STRING OF * ASCII DECIMAL DIGITS TO A BINARY NUMBER. * CVDIZ IS CALLED IF ONLY AN INTEGER WILL * BE ACCEPTED. CVDIFZ IS CALLED IF A * FLOATING POINT NUMBER CAN BE ALLOWED. * CVDI IS FIRST EXECUTED TO GET AN * INTEGER. IF IT FAILS, THEN A RETURN * IS MADE OR CVDIFZ IS EXECUTED DEPENDING * ON WHICH ROUTINE WAS INITIALLY CALLED. * * * CALLING SEQUENCE: * * BLWP @CVDIZ * OR * BLWP @CVDIFZ * * IN - R7 =PTR * * OUT - R0 = DELIMITER * R1 = 16-BIT 2'S COMPLEMENT INTEGER * FPAC = FLOATING POINT NUMBER * R7 = NEW PTR * * NORMAL EXIT - RTWP * ERROR EXIT * * EXCEPTIONS AND CONDITIONS: * * * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF CVDIZ,CVDIFZ * * CONVERT DECIMAL TO INTEGER * BLWP @CVDIZ * 16-BIT OVERFLOW - FP # IN FPAC * NO NUMBER * (HEX ON CVDIF) * NUMBER * * IN R7 = PTR * OUT R0 = DELIMITER * R1 = 16-BIT 2'S COMPLEMENT INTEGER * R7 = NEW PTR * CVDIZ DATA WPR2,CVDI CVDIFZ DATA WPR2,CVDIF * CVDI CLR R8 GET INTEGER ONLY JMP $+4 CVDIF SETO R8 ALLOW EXPONENT * MOV @14(13),R7 GET PTR CLR R2 CLEAR RESULT CLR R4 CLEAR SIGN FLAG BL @CVDB25 LOOK FOR SIGN JMP CVDI4 NO NUMBER, RETURN SETO R4 NEGATIVE MOV R7,R6 * CVDIH1 MOVB *R6+,R0 SRL R0,8 ;POSITION AI R0,->30 JLT CVDIH4 ;NOT HEX CI R0,>09 JLE CVDIH2 ;HEX 0-9 AI R0,->07 CI R0,>0A JLT CVDIH4 ;NOT HEX CI R0,>0F JH CVDIH3 ;NOT HEX, "H MAYBE? * CVDIH2 SLA R2,4 ;ADD NEW HEX DIGIT A R0,R2 JMP CVDIH1 * CVDIH3 AI R0,->11 ;"H? JNE CVDIH4 ;N MOVB *R6+,R0 ;Y, GET DELIMITER MOV R6,R7 ;UPDATE R7 JMP CVDI3A * CVDIH4 CLR R2 ;NOT HEX, CLEAR R2 * CVDI1 BL @CVDB20 GET DIGIT JMP CVDI2 N MOV R2,R1 SET FOR MULTIPLICATION MPY @C000A,R1 R1,R2=R1*10 MOV R1,R1 OVERFLOW? JNE CVDB Y MOV R2,R2 OVERFLOW? JLT CVDB ;Y A R0,R2 ADD NEW DIGIT, OVERFLOW? JLT CVDB Y, OVERFLOW JMP CVDI1 LOOP * CVDI2 CI R0,>2E00 ".? JEQ CVDI5 Y CI R0,>4500 "E? JEQ CVDI5 Y - SEE IF LEGAL * CVDI3 MOV R8,R8 ;SKIP HEX RETURN? JEQ CVDI3A ;Y INCT R14 ;N * CVDI3A MOV R4,R4 N, NEGATIVE? JEQ $+4 N NEG R2 Y, NEGATE MOV R2,@2(13) RETURN NUMBER IN R1 MOV R7,@14(13) RETURN PTR IN R7 INCT R14 RETURN 4(14) CVDI4 INCT R14 RETURN 2(14) - NO NUMBER MOV R0,*R13 RETURN DELIMITER IN R0 RTWP RETURN 0(14) - OVERFLOW * CVDI5 MOV R8,R8 EXPONENT ALLOWED? JEQ CVDI3A N * * FALL THRU TO CVDB PAGE * CONVERT DECIMAL TO FP * BLWP @CVDBZ * NUMBER * NO NUMBER * * IN R7 = STRING ADDRESS * OUT R0 = DELIMITER * R7 = NEW PTR * FPAC = NUMBER * CVDB CLEAR 0 CLEAR FPAC MOV @14(13),R7 GET STRING ADR MOV @18(13),R9 GET POINTER REGISTER SETO R2 SET DECIMAL FLAG CLR R6 DECIMAL ADJUSTMENT=0 * CLR R12 CLEAR SIGN FLAG CLR R4 CLEAR SIGNIFICANT DIGITS COUNT BL @CVDB25 PROCESS SIGN JMP CVDI4 NO NUMBER SETO R12 NEG, SET TO -1 * CVDB1 BL @CVDB20 GET CHARACTER JMP CVDB4 NOT NUMBER MOV R2,R2 AFTER DECIMAL? JLT $+4 N INC R6 Y, COUNT MOV R0,R0 '0'? JNE CVDB1A MOV R4,R4 Y - LEADING '0'? JEQ CVDB1 CVDB1A INC R4 Y - INCREMENT SIG DIGITS COUNT CI R4,11 11 SIG DIGITS? JLE CVDB1C CLR R0 Y - SET DIGIT TO 0 CVDB1C FMUL @CVC10 ;OK, FPAC=FPAC*10 SLA R0,4 00X0 JEQ CVDB1 IGNOR IF ZERO AI R0,>4100 41X0 (FP # NOW) MOV R0,@CVCH SAVE FADD @CVCH ADD NEW DIGIT JMP CVDB1 * CVDB4 CI R0,>2E00 ".? JNE CVDB5 N MOV R2,R2 Y - FIRST PERIOD? JEQ CVDB10 N - END CONVERSION MOV R8,R8 EXPONENT ALLOWED? JEQ CVDB10 N - FINISH CLR R2 Y, SET FLAG JMP CVDB1 * CVDB5 CI R0,>4500 "E? JNE CVDB10 N LI R5,>0501 Y, (NEG R1) BL @CVDB25 CHECK FOR SIGN JMP CVDI4 PROBLEM, RETURN NO NUMBER SLA R5,12 NEG, LOAD NOOP (1000) CLR R1 * CVDB6 BL @CVDB20 GET DIGIT JMP CVDB7 NO DIGIT, DONE MOV R1,R3 MPY @C000A,R3 X 10 A R0,R4 ADD NEW DIGIT MOV R4,R1 RESTORE R1 JMP CVDB6 LOOP AGAIN * CVDB7 X R5 DO EXPONENT CHANGE A R1,R6 ADD EXPONENT ADJUSTOR * CVDB10 MOV R0,*R13 DONE, RETURN DELIMITER MOV R7,@14(13) RETURN NEW PTR * CVDB11 MOV R6,R8 CHECK ADJUSTMENT JLT CVDB12 DO ADJUSTMENT NECESSARY JEQ CVDB13 " " " BL @CVGCN1 GET CONSTANT S R8,R6 FDIV *R0 DIVIDE BY 10^R6 JMP CVDB11 * CVDB12 NEG R8 BL @CVGCN1 GET CONSTANT A R8,R6 FMUL *R0 MULTIPLY BY 10^R6 JMP CVDB11 * CVDB13 MOV R12,R12 CHECK FOR NEGATIVE # JEQ CVDB14 POSITIVE NEGATE 0 * * NOTE: -32768 IS EVALUATED AS +32768 (HAS TO GO TO FLOATING * POINT FORMAT) AND THEN NEGATED. IF FPAC CORRESPONDS TO * >C480 >0000 >0000 THEN SET IT TO >0000 >8000 >0000 * LI R12,FPAC REF FPAC MOV R12,R3 LI R6,CC480 REF -32768 (IN FL PT FORMAT) C *R12+,*R6+ 1ST WORD SAME? JNE CVDB14 C *R12+,*R6+ Y - 2ND WORD SAME? JNE CVDB14 C *R12,*R6+ Y - 3RD WORD SAME? JNE CVDB14 CLR *R3+ Y - CLEAR 1ST WORD MOV *R6,*R3+ 2ND WORD TO >8000 MOV *R6,R2 R2=RESULT REGISTER FOR CVDI CLR *R3 CLEAR 3RD WORD CLR R4 CLEAR NEGATE FLAG JMP CVDI3 CVDB14 RTWP * CC480 DATA >C480,0,0 DATA >8000 PAGE * ABSTRACT: * * CVDB20 GETS THE NEXT DIGIT IF THERE * IS ONE. LEADING BLANKS ARE SKIPPED. * IF THE NEXT CHARACTER IS A NON-DIGIT * THEN RETURN IS MADE TO THE FIRST * INSTRUCTION FOLLOWING THE CALL. IF * THE NEXT CHARACTER IS A DIGIT, A * RETURN IS TAKEN TO THE SECOND * INSTRUCTION FOLLOWING THE CALL. * * CALLING SEQUENCE: * * BL @CVDB20 * * IN - R7 = POINTER * OUT - R0 = CHARACTER * * NORMAL EXIT - RETURN + 1 ON DIGIT * RETURN ON NON-DIGIT * * EXCEPTIONS AND CONDITIONS: * * * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF CVDB20 CVDB20 CLR R0 GET DIGIT MOVB *R7+,R0 GET NEXT CHARACTER JEQ CVDB22 EOL CI R0,>2000 BLANK? JEQ CVDB20 Y CI R0,>3000 <"0? JL CVDB22 Y CI R0,>3900 >"9? JH CVDB22 Y SLA R0,4 SRL R0,12 RIGHT JUSTIFY CHARACTER INCT R11 CVDB22 RT RETURN PAGE * PROCESS SIGN * BL @CVDB25 * NO NUMBER * -NUMBER * NUMBER OR +NUMBER * CVDB25 CB *R7+,@B20 SPACE? JEQ CVDB25 ? DEC R7 BACKUP MOV R7,R1 MARK MOV R11,R10 BL @CVDB20 GET NUMBER JMP CVDB28 NO NUMBER CVDB26 INCT R10 NUMBER, RETURN 4(10) INCT R10 -NUMBER, RETURN 2(10) CVDB27 MOV R1,R7 RESTORE R7 B *R10 RETURN * CVDB28 CI R0,>2B00 "+? JEQ CVDB29 Y CI R0,>2D00 N, "-? JEQ CVDB30 Y CI R0,>2E00 ".? JNE CVDB27 N, NO NUMBER DEC R7 Y, BACKUP OVER PERIOD * CVDB29 BL @CVDB31 PROCESS POSITIVE NUMBER JMP CVDB26 OK * CVDB30 BL @CVDB31 PROCESS NEGATIVE NUMBER JMP CVDB26+2 OK * CVDB31 MOV R11,R3 SAVE RETURN MOV R7,R1 MARK BL @CVDB20 DIGIT? JMP CVDB32 N, LOOK FOR PERIOD B *R3 Y, NUMBER * CVDB32 CI R0,>2E00 ".? JNE CVDB27 N, NO NUMBER BL @CVDB20 Y, LOOK FOR DIGIT JMP CVDB27 NO NUMBER B *R3 NUMBER OK * C000A DATA >000A B20 BYTE >20 EVEN END IDT 'CVGC' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * CVGCN ;GET CONSTANT * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: (NONE) * * EXTERNAL DATA: (NONE) * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: * DEF CVC10 ;FLOATING POINT CONSTANT 10. TITL 'GET CONVERSION CONSTANT' PAGE * ABSTRACT: * * CVGCN WILL GET THE POWER OF TEN CLOSEST * TO THE POWER OF 16 IN R8. IE: * * 16^1 > 10^1 * 16^2 > 10^2 * 16^3 > 10^3 * 16^4 > 10^4 * 16^5 > 10^6 * 16^6 > 10^7 * .... .... * * CALLING SEQUENCE: * * BL @CVGCN * * IN R8 = POWER OF 16 * OUT (R0) = FP CONSTANT * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: (NONE) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF CVGCN,CVGCN1 * CVGCN CI R8,5 JL CVGCN2 INC R8 EXP CHANGE >=5 CVGCN1 CI R8,10 JL CVGCN2 LI R8,9 EXP CHANGE >9, USE 9 * CVGCN2 X *R11+ ADJUST DECIMAL COUNTER LI R0,CVTB1 GET 10'S TABLE ADR SLA R8,1 MAKE WORD INDEX A R8,R0 INDEX SLA R8,1 R8 X 2 A R8,R0 R3=R3+3*R8 RT RETURN * CVTB1 DATA >4110,>0000,>0000 10^0 CVC10 DATA >41A0,>0000,>0000 10^1 DATA >4264,>0000,>0000 10^2 DATA >433E,>8000,>0000 10^3 DATA >4427,>1000,>0000 10^4 DATA >4518,>6A00,>0000 10^5 DATA >45F4,>2400,>0000 10^6 DATA >4698,>9680,>0000 10^7 DATA >475F,>5E10,>0000 10^8 DATA >483B,>9ACA,>0000 10^9 END IDT 'DEF' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * DEFY ;DEF COMMAND * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * REF LINE ;MULTIPLEXOR * * EXTERNAL DATA: * REF UFT ;USER FUNCTION TABLE REF MODE ;MODE FLAG * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'DEF COMMAND' PAGE * ABSTRACT: * * PLACE THE USER FUNCTION PROGRAM- * BYTE-COUNTER AND NUMBER OF ARGUMENTS * IN USER-FUNCTION-TABLE (UFT) THUS * DEFINING THE FUNCTION. * * CALLING SEQUENCE: * * B @DEFY * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF DEFY * *DEF COMMAND * *USER FUNCTION TABLE: * * PBC * # OF ARGUMENTS * ... * DEFY MOV @MODE(9),R0 ;RUNNING? JEQ DEF2 ;N, DON'T DEFINE CLR R0 MOVB *R8+,R0 ;GET TYPE SETO R1 ;START COUNT * DEF1 INC R1 ;COUNT ARGUMENTS CB *R8+,@B56 ;=? JNE DEF1 ;N MOV @UFT(9),R3 ;Y, DEFINE FUNCTION SRL R0,6 ;GET INDEX A R0,R3 ;INDEX MOV R8,*R3+ ;SAVE ADR MOV R1,*R3 ;SAVE COUNT DEF2 B @LINE ;GOTO NEXT LINE B56 BYTE >56 EVEN END IDT 'DIM' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * DIMY ;DIMENSION COMMAND * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * REF EVAL,EVALS2 ;RECURSIVE EVALUATOR REF EVARZ ;EVALUATE VARIABLE REF FIX ;FIX ARGUMENT REF NLIN ;EXIT TO MULTIPLEXOR ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) ERROR2 EQU ERROR+>20 * * EXTERNAL DATA: * REF VDT ;VARIABLE DEFINITION TABLE INDEX REF NVS ;NEXT VARIABLE STORAGE REF NVD ;NEXT VARIABLE DEFINITION REF DLIM ;PROGRAM DELIMITER REF C6 ;CONSTANT 6 * * MODULE EQUATES: * NRV EQU 4 ;NUMBER OF RESERVED WORDS * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'DIMENSION STATEMENT' PAGE * ABSTRACT: * * DIMENSION A VARIABLE. A DIMENSIONED * VARIABLE IS INDICATED IN THE VDT BY A * NEGATIVE VALUE. THE VARIABLE * DEFINITION POINT TO THE INFORMATION * VECTOR. * *INFORMATION VECTOR FORMAT: * * D1,X1,D2,X2,...DN,-1,...DATA... * *WHERE D1,D2,...DN = DIMENSIONS * X1,X2,... = MULTIPLIERS * * X1 = D2+1 X D3+1 X ... DN+1 * X2 = D3+1 X D4+1 X ... DN+1 * ... * XN = 1 * * CALLING SEQUENCE: * * B @DIMY * * EXCEPTIONS AND CONDITIONS: * * EVALUATION ERRORS, STORAGE OVERFLOW * EXPECTING DIMENSIONED VARIABLE * INVALID DELIMITER * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) PAGE * ENTRY POINT: * DEF DIMY * DIMY CLR R0 ;GET VARIABLE NAME MOVB *R8+,R0 CI R0,NRV*>100+>7000 ;VARIABLE? JL ERR16 ;N MOV @VDT(9),R14 ;Y, GET SYMBOL ADR SRL R0,7 A R0,R14 ;INDEX AI R14,->70*2 ;ELIMINATE DISPLACEMENT MOV *R14,R1 ;DEFINED? JNE DIM3 ;Y, SEE IF EXCEEDS PREVIOUS * SETO R5 ;DO FULL EVALUATIONS BL @EVALS2 ;DO INITIAL EVAL CLR *R6+ ;ZERO COUNT JMP DIM2 * DIM1 BL @EVAL ;EVALUATE NEXT SUBSCRIPT * DIM2 BL @FIX ;FIX PARAMETER (R2) DECT R6 ;POP COUNT MOV *R6,R3 INC R3 ;COUNT DIMENSION MOV R1,*R6+ ;PUSH DIMENSION SETO *R6+ ;LEAVE SPACE FOR DEL MULTIPLIER MOV R3,*R6+ ;PUSH COUNT AGAIN CI R0,>3F00 ;,? JEQ DIM1 ;Y CI R0,>4B00 ;]? JNE DIME37 ;N, ERROR DECT R6 ;RETRIEVE COUNT MOV *R6,R0 MOV R0,R10 ;GET INFORMATION VECTOR LENGTH SLA R10,2 ;COUNT X 4 LI R1,1 ;SET DEL(N) TO 1 JMP DIM5 * DIME37 DATA ERROR2,37 PAGE DIM3 DEC R8 ;BACKUP TO VARIABLE BLWP @EVARZ ;EVALUATE JMP DIM7 * DIM4 AI R6,-4 ;DO ANOTHER DIMENSION MOV *R6,R2 ;GET DIMENSION INC R2 ;INCREMENT MPY R1,R2 ;GET PRODUCT MOV R2,R2 ;OVERFLOW? JNE DIME10 ;Y MOV R3,R1 ;SET R1 JLT DIME10 MOV R1,@-2(6) ;STORE DEL IN INFORMATION VECTOR * DIM5 DEC R0 ;DONE? JNE DIM4 ;N AI R6,-4 ;FINISHED, CALCULATE VECTOR MOV *R6,R0 INC R0 ;1ST DIMENSION + 1 MPY R0,R1 ;GET FINAL DIMENSION SIZE MPY @C6,R2 ;X 6 BYTES A R10,R3 ;ADD INFORMATION VECTOR LENGTH MOV @NVS(9),R2 ;DEFINE S R3,R2 C R2,@NVD(9) ;OK? JL DIME10 ;N, STORAGE OVERFLOW MOV R2,*R14 ;Y, SET IN SYMBOL TABLE MOV R2,@NVS(9) ;UPDATE NVS * DIM6 MOV *R6+,*R2+ ;MOVE INFORMATION VECTOR INC @-2(6) ;DONE? JNE DIM6 ;N * CLR R0 MOVB *R8+,R0 ;GET NEXT BYTE * DIM7 CI R0,>3F00 ;",? JEQ DIMY ;Y, DO NEXT VARIABLE MOV R0,@DLIM(9) ;N, SAVE IN DLIM DIM8 B @NLIN ;RETURN * DIME10 DATA ERROR+10 ;STORAGE OVERFLOW * ERR16 DATA ERROR+16 ;EXPECTING DIMENSIONED VARIABLE END