IDT 'ATNF' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * 30 MAY 79 ;UPDATE AND COPY FOR REL2 * ROUTINE LIST: * * ATNF ;ARC-TANGENT FUNCTION * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * REF FUNFX ;FIX ARGUMENT REF PLYX,PLYXX ;EVALUATE POLYMONIAL REF EVSFR ;EXIT TO EVALUATOR * 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 * * EXTERNAL DATA: * REF FPAC ;FLOATING POINT ACCUMULATOR REF TEMP ;TEMP REGISTER REF DS,DS1 DATA STORAGE * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'ARC-TANGENT FUNCTION' PAGE * ABSTRACT: * * COMPUTE ARC-TANGENT OF ARGUMENT (R2). * RESULT IS IN RADIANS. * * CALLING SEQUENCE: * * B @ATNF * * EXIT TO EVSFR * * * EXCEPTIONS AND CONDITIONS: * * FLOATING POINT ERRORS * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE 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 TITL 'BASIC LINE EDITOR' IDT 'EDIT' * * CREATED: 12 MARCH 1981 * DEF EDIT,EDIT1,LSTL,LDP5,LDPY DEF SAVY,LDSTRT DEF LCN1,LCN2,LCN3,LCN4 DEF LNXT,LDEF DEF RNGOTO,RNGSUB,RNTRAP,RNRSTR DEF RNON,RNINP,RNERR,RNREM,RNELSE,RNIF * REF PROGM,RENUMS,EDTMP,UNIT,AUDIO,AUDIO2 REF RENCMP,NINE REF B20,B01,STRTC,RUNP1 REF BUS,EORBUS,DDM,DLC,EBP REF CKEX,CVDB20 REF CVDIFZ,CVDIZ,EDER REF FNS,GSC,GSS,LNUM REF FOR2,JMPR0 REF FPAC,SLT,SLN REF GETC,LINE2 REF PLC,MODE,NVD,NVS,PLF,EFLG REF PUTB,RUNP,SIZE REF SSP,UFT,VDT,VNT REF TYPB,TYPE,TYPC,DCNT,GOS2,CRLF,HOUT REF ASR0,CLEARS JG 02/3/82 DXOP EVFIX,11 DXOP OUTFP,12 DXOP OUTINT,13 * ERROR EQU >2F80 ERROR2 EQU ERROR+>20 PAGE * * CONTINUE COMMAND * CONT SETO @MODE(9) SET TO RUN BL @TYPC OUT CRLF MOV @SLN(9),R1 GET LINE # B @GOS2 PAGE * * LOAD * * = 0 OR BLANK THEN 733 DIGITAL CASSETTES * = 1 BUBBLE MEMORY TERMINAL * = 2 EIA AUDIO CASSETTES * ELSE EPROM ADDRESS * * PROGRAM LOAD FLAG (PLF) = -1 WHEN LOAD COMPLETE * ELSE REFLECTS DEVICE BEING USED * LDPY CLR @PLF(9) LOADING IN OPERATION BL @CKEX CHECK FOR EXPRESSION JMP LDP5 NONE EVFIX R2 GET DEVICE TYPE/ADDRESS CI R2,2 EPROM? JLE LDP01 N - * * PROGRAM STORED IN EPROM * LDSTRT INCT R2 ;MOVE OVER RUN ID MOV *R2+,@SLT(9) ;GET SLT DISPLACEMENT MOV *R2+,@VNT(9) ;GET VNT DISPLACEMENT MOV @EORBUS(9),R1 ;GET OLD BUS MOV R1,@VDT(9) MOV R1,@NVD(9) A *R2+,@NVD(9) ;ADD VARIABLE SPACE MOV R2,@BUS(9) ;GET NEW BUS A R2,@SLT(9) ;GET ABS ADDR OF SLT A R2,@VNT(9) ;GET ABS ADDR OF VNT AI R2,-8 ;POINT TO RUN/NORUN FLAG SETO @PLF(R9) LOAD FINISHED C @STRTC,*R2 ;AUTO RUN REQUESTED? JNE LDP0 ;NO - MANUAL START B @RUNP1 YES - FORCE RUN LDP0 B @CRLF * * PROGRAM STORED ON AUDIO CASSETTE * LDP0A MOV @UNIT(R9),@AUDIO SAVE UNIT FLAG MOV @D2,@UNIT(R9) PORT A=OFF, PORT B=ON * * AUDIO2 IS USED BY EDER ROUTINE (GETLINE) TO * INDICATE THAT AN ERROR HAS OCCURRED WHILE READING * THE TAPE. PRINTING IS INHIBITED FOR AUDIO * CASSETTE ERRORS. * SETO @AUDIO2 'CLEAR' ERROR INDICATOR JMP LDP1 * * PROGRAM STORED ON TAPE * LDP01 A R2,@PLF(R9) SET DEVICE TYPE DEC R2 JLT LDP5 733 JGT LDP0A AUDIO LI R1,PLYBON BUBBLE - REWIND TAPE/KILL KEYBORD BL @TYPE * * 733 AND BUBBLE TERMINAL - ISSUE BLOCK FORWARD * BLKFWD MUST IMMEDIATELY PRECEDE BUBFWD * LDP5 MOV @PLF(R9),R3 GET DEVICE TYPE LI R1,@BLKFWD DEC R3 JLT LDP5A ASR 733 JNE LDP1 AUDIO CASSETTES C *R1+,*R1+ BUBBLE TERMINAL LDP5A BL @TYPE OUTPUT BLOCK FORWARD LDP1 MOV *R9,R7 GET BUFFER ADR * * HAVE TO CHECK FOR ESCAPE CHARACTER HERE * LDP2 BL @GETC GET CHARACTER JMP LDP2 NOTHING JMP LDP2A CHARACTER JMP LDP4 ESCAPE LDP2A BL @PUTB STORE IT JMP LDP3 CR JMP LDP2 CONTROL CHARACTER JMP LDP2 CHARACTER * * WHEN LINE COMPLETE SEND IT THROUGH THE EDITOR * LDP3 BL @EDIT EDIT LINE JMP LDP5 * * IF BUBBLE TERMINAL THEN REWIND CASSETTE, RE-ENABLE * THE KEYBOARD AND SWITCH OFF PLAYBACK MODE * LDP4 MOV @PLF(R9),R3 EOF/ESC - GET DEVICE TYPE DEC R3 JGT LDP4B AUDIO JNE LDP4A 733 LI R1,PLYBOF BUBBLE - REWIND/PLAYBACK OFF BL @TYPE LDP4A B @CRLF DONE * * AUDIO CASSETTE * LDP4B MOV @AUDIO,@UNIT(R9) RESTORE ORIGINAL UNIT INC @AUDIO2 ANY ERRORS DURING LOAD OPERATION? JEQ LDP4A N CLR @EFLG(R9) Y - FATAL ERROR DATA ERROR2,44 OUTPUT ERROR MSG PAGE * EDIT INPUT STRING * * R6 = SUBSCRIPT STACK PTR * R7 = INPUT BYTE PTR * R8 = OUTPUT BYTE PTR * R9 = SYSTEM PTRS * R10 = RETURN ADR * R12 = BEGINNING OF COMMAND PTR * R14 = SAVE FOR LINE COUNTER * * PROBLEM WITH THE RENUMBER COMMAND NOT BEING ABLE * TO CORRECTLY ACCESS STATEMENT NUMBERS FOR VALUES * 1 TO 9 AS THESE ARE COMPRESSED AS >64 TO >6C. * THE SECONDARY ENTRY POINT (EDIT1) HAS BEEN DEFINED * FOR THE RENUMBER COMMAND - RENCMP IS SET TO THE * REQUIRED VALUE IN THAT ROUTINE. THIS ALLOWS THE * VALUES 1 TO 9 TO BE STORED AS >6D >0001 TO >6D >0009. * THE RENUMBER ROUTINE FORCES THE EDITOR TO UNCOMPRESS * THE PROGRAM BEFORE RENUMBERING STARTS; ON COMPLETION * THE PROGRAM IS THEN COMPRESSED. * EDIT MOV @NINE,@RENCMP COMPRESSED FLAG=9 (FULL) EDIT1 MOV R11,R10 SAVE RETURN MOV R6,@EDTMP SAVE LINE COUNT FOR EDER ROUTINE CLR @EFLG(R9) DISABLE ERROR COMMAND MOV *R9,R7 ;GET I/O PTR LI R6,SSP ;GET SUBSCRIPT STACK PTR SETO *R6 ;MARK SUBSCRIPT STACK LI R8,EBP ;GET EDIT BUFFER PTR MOV @VNT(9),R5 ;SET UP RESERVED WORDS CLR *R5+ ;CLEAR DUMMY VARIABLES CLR *R5+ CLR *R5+ LI R0,>11D2 MOV R0,*R5 * * GET LINE NUMBER * BLWP @CVDIZ ;CONVERT LINE NUMBER JMP EDER3 ;OVERFLOW CLR R1 ;NO NUMBER MOV R1,@LNUM(9) ;STORE LINE NUMBER JLT EDER3 JEQ $+4 ;LINE # DEC R7 ;Y, BACKUP OVER DELIMITER MOV R0,R0 ;DONE? JNE ED3 ;N B @EMV0 ;Y, DELETE LINE * *DECODE COMMAND WORD * ED3 BL @EDGLS ;GET FIRST LETTER JMP EDSCI ;LET OR "; MOV R7,R3 ;MARK MOV R1,R0 BL @EDGL ;GET SECOND LETTER JMP EDLET A R1,R0 * *CHECK FOR TWO LETTER COMMANDS HERE * CI R0,>1920 ;IF? JEQ EDIF ;Y CI R0,>39E0 ;ON? JEQ EDON ;Y BL @EDGL ;N, GET 3RD LETTER JMP EDLET ;LET A R1,R0 PAGE *SEARCH COMMAND LIST * LI R4,EDSCL ;Y, GET COMMAND LIST PTR * ED5 MOV *R4+,R1 ;GET FIRST COMMAND SRL R1,1 ;MOVE 2ND WORD INDICATOR INTO CARRY C R0,R1 ;FOUND? JEQ ED6 ;MAYBE CI R4,EDCLE ;N, MORE COMMANDS? JL ED5 ;Y * EDLET MOV R3,R7 ;RESTORE R7 * EDLETA MOVB @LETB,*R8+ ;INSERT >6 (IMPLIED LET) JMP ED13 * ED6 MOV R0,R2 ;SAVE IN CASE NOT FOUND MOV R7,R15 MOV @EDCS(4),R0 ;GET SECOND WORD JNC ED9 ;FOUND * ED7 MOV R0,R5 ANDI R5,>3E ;MASK CHARACTER JEQ ED9 ;FOUND BL @EDGL ;GET LETTER JMP ED8 ;PROBLEM SRL R1,9 ;POSITION C R5,R1 ;LETTER SAME? JEQ ED7 ;Y * ED8 MOV R2,R0 ;PROBLEM, CONTINUE TO LOOK MOV R15,R7 JMP ED5 * EDER3 BL @EDER ;INVALID LINE NUMBER TEXT '03' * EDIF LI R4,IFB ;IF ENTRY JMP ED10 * EDON LI R4,ONB ;ON ENTRY JMP ED10 * EDSCI CB *R7+,@B3B ;";? JNE EDLETA ;N LI R4,PTRB ;"; ENTRY JMP ED10 PAGE *COMMAND TYPE DONE *CHECK FOR GOTO OR GOSUB * ED9 LI R1,EDCL AI R4,-EDCL (NOT ALLOWED) S R1,R4 SYSTEM COMMAND? JGT ED10 N - CONTINUE TRANSLATION B *R0 Y - EXECUTE COMMAND * ED10 SLA R4,7 ;POSITION BYTE MOVB R4,*R8+ ;STORE IN STREAM CI R4,>300 ;CHECK SPECIAL TYPES JLT ED12 ;GOTO,GOSUB JEQ ED3 ;ELSE CI R4,>400 ;REM? JNE ED14 ;N B @EDREM ;Y * ED11 MOVB @B3F,*R8+ ;STORE , * ED12 BLWP @CVDIZ ;GET INTEGER NOP JMP EDER3 MOVB R1,*R8+ ;STORE INTEGER SWPB R1 MOVB R1,*R8+ CI R0,>2C00 ;",? JEQ ED11 ;Y * ED13 DEC R7 ;FALL THRU TO ED20 * ED14 MOV R8,R12 ;MARK PAGE *PROCESS RESET OF LIST * ED20 BLWP @CVDIFZ ;LOOK FOR NUMBER JMP ED23 ;OVERFLOW, FP JMP ED30 ;NO NUMBER JMP ED20H ;HEX CI R1,-1 ;<-1? JLT ED21 ;Y * * FOLLOWING LINE MODIFIED TO ALLOW THE RENUM * COMMAND TO WORK WITH STATEMENT #S 1 TO 9 * C R1,@RENCMP FULL COMPRESSION? JGT ED21 ;Y AI R1,>63 ;N - GET CODE (62-6C) JMP ED22 ;INSERT * ED20H MOVB @B6E,*R8+ ;MARK AS HEX JMP ED21A * ED21 MOVB @B6D,*R8+ ;2 BYTE INTEGER, INSERT >6D ED21A MOVB R1,*R8+ ED22 SWPB R1 MOVB R1,*R8+ JMP ED24 ;LOOK FOR OPERATOR * ED23 MOVB @B6F,*R8+ ;FP #, INSERT >6F LI R3,6 LI R4,FPAC ;GET FPAC ADR * MOVB *R4+,*R8+ ;MOVE IN NUMBER DEC R3 ;DONE? JNE $-4 ;N * ED24 DEC R7 ;Y, BACKUP OVER DELIMITER * *VARIABLE OR KEY WORD *GET 3 CHARACTERS - EXIT TO EDOP IF NON-LETTER * ED30 BL @EDGWO ;CHECK FOR WORD OPERATER BL @EDGLS ;PROCESS COMMAND LIST JMP EDOP ;NOT LETTER, OPERATOR MOV R1,R0 BL @EDGL ;GET NEXT LETTER JMP EDV1 ;NOT LETTER, 1 CHARACTER VARIABLE A R1,R0 ;ADD NEW LETTER CI R0,>38C0 ;'FN'? JNE ED31 ;N B @EDFN ;Y, FUNCTION * ED31 BL @EDGL ;N, GET 3RD LETTER JMP EDV2 ;NOT LETTER, 2 LETTER VARIABLE A R1,R0 PAGE *LOOK FOR 3 LETTER KEY WORDS * LI R4,EDIL ;GET LIST PTR * ED32 MOV *R4+,R1 ;GET CHARACTERS SRL R1,1 ;REMOVE TERMINATOR C R0,R1 ;SAME? JNE ED34 ;N LI R11,EDIL AI R4,>1A*2 S R11,R4 SRL R4,1 ;SYSTEM FUNCTION * ED33 SWPB R4 ;POSITION MOVB R4,*R8+ ;INSERT JMP ED20 * ED34 CI R4,EDILE ;N, LIST DONE? JL ED32 ;N JMP ED35 * *1 CHARACTER VARIABLE * EDV1 MOV R0,R3 ;LOOK FOR # BL @CVDB20 ;CHECK FOR DIGIT JMP EDV1A ;N DEC R7 ;Y, BACKUP BLWP @CVDIZ ;CONVERT JMP EDER4 ;FP #, ILLEGAL VARIABLE NAME JMP EDV1B ;NO NUMBER CZC @CFF80,R1 ;TOO LARGE? JNE EDER4 ;Y, ILLEGAL NAME A R1,R3 ;COMBINE ORI R3,>0380 ;INDICATE AS NUMBER C380 EQU $-2 * EDV1A DEC R7 ;BACKUP OVER DELIMITER * EDV1B MOV R3,R0 ;RESTORE R0 PAGE *2 OR 3 CHARACTER VARIABLE * EDV2 EQU $ ED35 BL @EDGP ;LOOK FOR DIMENSION JMP ED35A ;Y, DIMENSIONED DEC R7 ;BACKUP JMP ED36 * ED35A NEG R0 ;SET DIMENSION INCT R6 ;STACK -1 SETO *R6 * *SAVE VARIABLE NAME * ED36 LI R4,>FF00+>70 ;-# OF VARIABLES MOV @VNT(9),R5 ;GET VARIABLE TABLE ADR * ED37 C R5,@VDT(9) ;DONE? JHE ED38 ;Y, MAKE NEW VARIABLE C R0,*R5+ ;VARIABLE SAME? JEQ ED39 ;Y, FOUND INC R4 ;STILL ROOM? JNE ED37 ;Y DATA ERROR+5 ;N, TOO MANY VARIABLES * EDER4 BL @EDER ;ILLEGAL VARIABLE NAME TEXT '04' * ERR10 DATA ERROR+10 ;STORAGE OVERFLOW PAGE *DEFINE NEW VARIABLE * ED38 MOV @NVD(9),R2 ;GET END OF TABLE C *R2+,*R2+ ;ADD 4 C R2,@NVS(9) ;ROOM FOR NEW VARIABLE? JHE ERR10 ;N MOV R2,@NVD(9) ;Y, UPDATE NVD * ED38A AI R2,-4 ;MOVE POINTERS UP 2 BYTES MOV *R2+,*R2 C R2,R5 ;DONE? JH ED38A ;N MOV R0,*R5 ;Y, STORE NEW NAME INCT @VDT(9) ;UPDATE VDT * ED39 MOV R0,R0 ;DIMENSIONED? JLT ED33 ;Y SWPB R4 ;N, INSERT VARIABLE CODE MOVB R4,*R8+ * * TRANSLATE CHARACTER INTO CODE * EDOP CLR R0 ;GET OPERATER MOVB *R7+,R0 ;GET BYTE JEQ ED90 ;DONE MOV R0,R1 SWPB R1 CI R0,>4100 ;<"A? JL EDOP1 ;Y CI R0,>5B00 ;>"Z? JL ED49 ;N, LETTER, TRY WORD OPERATER AI R1,-26 ;SKIP ALPHABET CI R0,>5E00 ;>"^? JH EDER6 ;Y, INVALID CHARACTER * EDOP1 MOVB @EDSL->21(1),R1 ;GET CODE JEQ EDER6 ;INVALID CHARACTER MOVB R1,*R8 ;STORE BYTE BL @JMPR0 ;SWITCHBOARD ON SPECIAL CHARACTERS EDOPTB BYTE EDOP-EDOPTB/2,>20 SP BYTE ED50-EDOPTB/2,>28 "( BYTE ED50-EDOPTB/2,>5B "[ BYTE ED51-EDOPTB/2,>29 ") BYTE ED51-EDOPTB/2,>5D "] BYTE ED42-EDOPTB/2,>22 "" BYTE ED42-EDOPTB/2,>27 "' BYTE ED47-EDOPTB/2,>3A ": BYTE ED54-EDOPTB/2,>21 "! BYTE ED43-EDOPTB/2,>3D "= BYTE ED45-EDOPTB/2,>3E "> DATA 0 ED40 INC R8 ;MOVE OVER CODE ED41 B @ED20 ;CONTINUE PARSE * ED42 INC R8 ;PROCESS " OR ' MOVB *R7+,*R8 ;GET NEXT BYTE JEQ EDER2 ;PROBLEM CB R0,*R8 ;CLOSE? JNE ED42 ;N SB *R8,*R8+ ;Y, TERMINATE WITH NULL JMP ED41 * ED43 DEC R8 ;PROCESS "= CB *R8,@B57 ;>=? JEQ ED44 ;Y CB *R8,@B59 ;<=? JEQ ED44 ;Y CB *R8+,@B56 ;==? JNE ED40 SB @B01,@-1(8) ;Y, MAKE == JMP ED41 * ED44 AB @B01,*R8+ ;MODIFY CODE JMP ED41 ;GOTO ED20 * ED45 CB @-1(8),@B59 ;PROCESS "> JNE ED40 AB @B02,@-1(8) ;MAKE <> JMP ED41 * ED46 INC R7 ;PROCESS :,THEN ED47 CB *R7,@B20 ;SPACE JEQ ED46 ;Y, IGNOR CB *R7,@B3A ;ANOTHER COLON? JEQ ED46 ;Y INC R8 ;N, PROCESS NEW COMMAND B @ED3 * EDER6 BL @EDER ;ILLEGAL CHARACTER TEXT '06' * *LOOK FOR WORD OPERATER * ED49 DEC R7 BL @EDGWO BL @EDER ;EXPECTING OPERATER TEXT '07' PAGE *( OR [ ENTRY * ED50 C R8,R12 ;COMMAND BYTE? JH ED50A ;N CB @-1(8),@BCPB ;MEM,CRB,CRF,BIT? JL ED50B ;N, LEAVE ( ED50A MOVB @-1(R8),R1 LAST CHAR STORED STRING TERMINATOR (0)? JEQ ED50B Y CB R1,@B38 N - FUNCTION ARGUMENTS? JHE ED50B ;N, LEAVE ( INCT R6 ;Y, MAKE [ CLR *R6 ;INSERT -1 INTO STACK SB @B02,*R8 ;*R8=>4A * ED50B DEC *R6 ;INCREMENT TOP ITEM ON STACK JMP ED40 ;LEAVE * *) OR ] ENTRY * ED51 INC *R6 ;NEED ]? JLT ED52 ;N, LEAVE >4D DECT R6 ;Y, DECREMENT STACK CI R6,SSP ;UNMATCHED? JL EDER2 ;Y SB @B02,*R8 ;N, INSERT ] CODE (>4B) * ED52 INC R8 ;LEAVE CODE ED52A JMP EDOP ;LOOK FOR OPERATER JG 12/1/82 PAGE *PROCESS REMARKS * ED54 INC R8 ;PROCESS TAIL REMARK * EDREM MOVB *R7+,*R8+ ;MOVE REMARK JNE EDREM * *END PARSE, CHECK FINAL ERRORS * ED90 CI R6,SSP ;SUBSCRIPT ERROR? JNE EDER2 ;Y INC *R6 ;PAREN ERROR? JNE EDER2 ;Y SB *R8,*R8+ ;N, MARK OUTPUT SB *R8,*R8 ;DOUBLE NULL SETO R0 ;SET TO INSERT MOV @LNUM(9),R1 ;GET LINE NUMBER JNE EMV0 ;INSERT OR CHANGE MOV *R9,R7 ;NO LINE NUMBER AI R7,30 ;MOVE INTO IOB MOV R7,R0 ;MARK LI R3,EBP ;**NOTE** ALL PTRS ON WRD BOUNDARIES * MOV *R3+,*R7+ ;MOVE C R3,R8 ;DONE? JL $-4 ;N * MOV R0,R8 ;SET R8 CB *R8,@B02 ;CHECK TYPE, GOTO/GOSUB? JG 15/1/82 JH ED91 ;N SETO @MODE(9) ;Y, SET TO RUN MODE CLR @PLC(R9) INDICATE FROM KEYBOARD MODE JG 15/1/82 BL @TYPC ;OUT CRLF * ED91 B @LINE2 * EDER2 BL @EDER ;UNMATCHED PARENTHESIS TEXT '02' PAGE *PROCESS FN- * EDFN BL @EDGLS ;GET LETTER JMP EDER8 ;NO LETTER SRL R1,2 ;POSITION MOVB R1,*R8+ ;INSERT INLINE MOV R8,R3 ;CHECK PREVIOUS BYTE DECT R3 ;LOOK FOR OPERATOR CI R3,EBP ;BEGINNING OF BUFFER? JNE ED52A ;N, DISREGUARD JG 12/1/82 CB *R3,@DEFXB ;'DEF'? JNE ED52A ;N, CONTINUE JG 12/1/82 BL @EDGP ;Y, LOOK FOR ( OR [ JMP EDFN0 ;"( OR "[, OK DEC R7 ;NEITHER, LOOK FOR "= JMP EDFN3 * EDFN0 LI R3,3 ;Y, ALLOW 3 DUMMY VARIABLES MOV @VNT(9),R4 ;GET STORAGE ADR * EDFN1 BL @EDGLS ;GET DUMMY VARIABLE JMP EDER9 ;PROBLEM MOVB R1,*R8+ ;INSERT IN CODE MOV R1,*R4+ ;STORE CODE BL @EDGP ;GET NEXT BYTE JMP EDER9 DEC R3 ;ROOM FOR MORE? JEQ EDFN2 ;N, SEE IF ") CI R1,>2C00 ;Y, DELIMITER ",? JEQ EDFN1 ;Y, LOOP * EDFN2 CI R1,>2900 ;N, CLOSING PAREN? JEQ EDFN3 ;Y, LOOK FOR "= CI R1,>5D00 ;N, "]? JNE EDER2 ;N, PROBLEM EDFN3 CB @B3D,*R7 ;Y, "=? JEQ ED52A ;Y JG 12/1/82 CB @B20,*R7+ ;SPACE? JEQ EDFN3 ;Y, TRY AGAIN BL @EDER ;MISSING ASSIGNMENT TEXT '36' * EDER8 BL @EDER ;ILLEGAL FUNCTION NAME TEXT '08' * EDER9 BL @EDER ;ILLEGAL FUNCTION ARGUMENT TEXT '09' PAGE *FINISH EDIT PROCESS * BL @EMV * * IN R0 = 0 FOR DELETE, <>0 FOR CHANGE OR INSERT * R1 = LINE NUMBER * EMV MOV R11,R10 ;SAVE RETURN EMV0 MOV R1,R1 ;DELETE 0? JEQ EMVR ;Y, ACTION COMPLETE LI R2,EBP S R2,R8 ;GET # OF BYTES INC R8 ;GET # OF WORDS (NEXT HIGHEST) SRA R8,1 MOV R8,R2 ;GET # OF BYTES SLA R2,1 MOV @SLT(9),R6 ;GET START OF STATEMENT TABLE MOV R6,R7 S @BUS(9),R7 ;R7=POINT OF QUESTION IN PSEUDO SOURCE * *UPON EXIT OF EMV1, R7 DISPLACES INTO PSEUDO SOURCE * AND R6 POINTS INTO SLT * EMV1 MOV *R6,R4 ;DONE? JEQ EMV2 ;Y C R1,*R6 ;N, FOUND? JEQ EMV5 ;Y, CHANGE OR DELETE JGT EMV2 ;Y, NEW LINE INCT R6 MOV *R6+,R7 ;GET NEW POINT OF QUESTION JMP EMV1 * ERR13 MOV R1,R3 COPY UNFOUND STMT # (ERRECOVY) JG 12/1/82 DATA ERROR+13 ;NO SUCH LINE NUMBER * EMV2 MOV R0,R0 ;NEW #, DELETE? JEQ ERR13 ;Y, PROBLEM * *INSERT NEW LINE ENTRY * MOV R6,R3 ;GET SOURCE BL @EMVA ;ADJUST DATA 4 ;INSERT 4 BYTES IN SLT MOV R1,*R6+ ;INSERT NEW LINE # MOV R7,*R6 ;INSERT DISPLACEMENT * EMV3 LI R4,EBP ;MOVE IN SOURCE LINE MOV *R6,R6 ;GET ADR A @BUS(9),R6 ;MAKE DISPLACEMENT, POINTER MOV R6,R7 ;MOVE IN STRING * MOV *R4+,*R7+ ;MOVE DEC R8 ;DONE? JNE $-4 ;N PAGE *ADJUST GOSUB * * IN R2 = PBC ADJUSTMENT * R3 = PLC ADJUSTMENT * R6 = START * R7 = END * EMV4 MOV @GSC(9),R4 ;GET GOSUB STACK PTR * EMV4A C R4,@GSS(9) ;DONE? JLE EMV4E ;Y AI R4,-4 ;N, BACKUP C R6,*R4 ;LESS THAN INSERTED LINE? JH EMV4A ;Y C R7,*R4 ;GREATER THAN? JLE EMV4C ;Y MOV R4,R5 ;N, DELETE ENTRY * EMV4B MOV @4(5),*R5+ ;DELETE ENTRY C R5,@GSC(9) ;DONE? JL EMV4B A @CM4,@GSC(9) ;BACKUP PTR JMP EMV4A * EMV4C A R2,*R4 ;Y, ADJUST PBC A R3,@2(4) ;ADJUST PLC JMP EMV4A * *ADJUST FOR/NEXT STACK * EMV4E MOV @FNS(9),R4 ;DO FOR/NEXT STACK * EMV4F MOV *R4,R0 ;DONE? JEQ EMV4J ;Y MOV R4,R5 ;N AI R5,14 C R6,*R5 ;LESS THAN INSERTED LINE? JH EMV4I ;Y C R7,*R5 ;>=? JLE EMV4H ;Y BL @FOR2 ;DELETE ENTRY JMP EMV4F ;LOOK AGAIN * EMV4H A R2,*R5+ ;Y, ADJUST PBC A R3,*R5 ;ADJUST PLC EMV4I AI R4,18 ;MOVE TO NEXT JMP EMV4F PAGE *ADJUST DATA POINTERS * EMV4J MOV R9,R4 ;GET DELIMITER PTR AI R4,DDM ;DISPLACE C R6,*R4 ;CHECK DATA PTRS JH EMV4L ;OK C R7,*R4 ;DELETED OR CHANGED? JLE EMV4K ;N, INSERTED CLR *R4 ;Y, SET TO LOOK FURTHER JMP EMV4KA * EMV4K MOV *R4,R0 ;DEFINED? JEQ EMV4L ;N, DON'T WORRY ABOUT IT A R2,*R4 ;Y, ADJUST PBC * EMV4KA A R3,@DLC(9) ;ADJUST PLC * *ADJUST FUNCTION DEFINITION STACK * EMV4L MOV @UFT(9),R4 ;GET POINTER * EMV4M MOV *R4,R0 ;DEFINED? JEQ EMV4O ;N C R6,*R4 ;LESS THAN CHANGED LINE? JH EMV4O ;Y C R7,*R4 JLE EMV4N ;N CLR *R4 ;UNDEFINE JMP EMV4O * EMV4N A R2,*R4 ;ADJUST PBC EMV4O C *R4+,*R4+ ;MOVE TO NEXT C R4,@GSS(9) ;DONE? JL EMV4M ;N * EMVR B *R10 ;RETURN PAGE *DELETE OR CHANGE LINE * EMV5 MOV @2(6),R11 ;GET BOL S R7,R11 ;GET -LINE LENGTH MOV R0,R0 ;DELETE LINE? JNE EMV6 ;N * *DELETE LINE * MOV R11,R2 ;Y MOV R6,R3 AI R3,4 ;GET SLT SOURCE BL @EMVA ;ADJUST CM4 DATA -4 ;DELETE 4 BYTES FROM SLT JMP EMV4 * *CHANGE LINE * EMV6 A R11,R2 ;GET DELTA CHANGE MOV @NVD(9),R0 ;CHECK STORAGE A R2,R0 C R0,@NVS(9) ;ROOM? JHE EMVE10 ;N LI R13,EMV6A ;GET RETURN ADR JMP EMVA1 * EMV6A DATA 0 ;LEAVE PLC ALONE INCT R6 ;MOVE TO LINE ADR JMP EMV3 * EMVE10 DATA ERROR+10 ;STORAGE OVERFLOW PAGE *ALTER SOURCE CODE * BL @EMVA * DATA (SLT ADJUSTMENT) * R3=SLT SOURCE PTR * EMVA MOV R11,R13 ;SAVE RETURN MOV @NVD(9),R4 ;GET THRU POINTER (END OF VARIABLE DEFS) MOV R3,R5 ;GET DESTINATION A *R13,R5 ; (4=INSERT,-4=DELETE,0=CHANGE) MOV R4,R0 ;CHECK FOR SIZE A *R13,R0 A R2,R0 ;ADD LINE C R0,@NVS(9) JHE EMVE10 ;OVERFLOW A *R13,@VNT(9) ;ADJUST POINTERS A *R13,@VDT(9) A *R13,@NVD(9) BL @MOVE ;DO FIRST MOVE * EMVA1 MOV R7,R3 ;MAKE HOLE IN PSEUDO SOURCE A @BUS(9),R3 ;MAKE DISPLACEMENT INTO POINTER MOV @NVD(9),R4 ;THRU MOV R3,R5 A R2,R5 ;DESTINATION A R2,R6 A R2,@SLT(9) ;ADJUST POINTERS A R2,@VNT(9) A R2,@VDT(9) A R2,@NVD(9) BL @MOVE ;DO SECOND MOVE * *ADJUST SLT * MOV R6,R3 ;GET POINTER * EMVA2 C R3,@SLT(9) ;DONE? JLE EMVA3 ;Y DECT R3 ;N A R2,*R3 ;ADJUST PTR DECT R3 JMP EMVA2 * EMVA3 MOV *R13+,R3 ;GET PLC ADJUSTMENT B *R13 ;RETURN PAGE *MOVE * BL @MOVE * * IN R3 = SOURCE * R4 = SOURCE END * R5 = DESTINATION * MOVE C R3,R5 ;THERE? JEQ MOVE4 ;Y JL MOVE2 ;N, SD, DONE? JH MOVE4 ;Y MOV *R3+,*R5+ ;MOVE DATA JMP MOVE1 * MOVE2 MOV R4,R0 ;S"Z? JHE EDGL1 ;Y CLR R1 ;LETTER MOVB *R7+,R1 SLA R1,2 ;REMOVE UPPER BITS SRL R0,5 ;ADJUST R0 INCT R11 EDGL1 RT * MOVE4 EQU EDGL1 * *GET WORD OPERATER * EDGWO MOV R11,R5 BL @EDGLS ;GET LETTER B *R5 ;NO LETTER, RETURN DEC R7 ;OK, PROCESS LI R4,EDGWOL ;GET WORD OPERATER LIST * EDGWO1 MOV R7,R3 ;MARK * EDGWO2 MOVB *R4+,R1 ;GET CHARACTER, FOUND? JEQ EDGWO4 ;Y CB *R3+,R1 ;N, SAVE LETTER? JEQ EDGWO2 ;Y MOVB *R4+,R1 ;N, MOVE TO NEXT JNE $-2 INC R4 ;MOVE OVER CODE MOVB *R4,R1 ;DONE? JNE EDGWO1 ;N, KEEP TRYING B *R5 ;Y, RETURN * EDGWO4 MOVB *R4,*R8 ;RESERVED WORD, GET CODE MOV R3,R7 ;UPDATE R7 CB *R8,@B3B ;THEN? JEQ EDGWO5 ;Y, PROCESS : B @ED40 ;N, INSERT OPERATER * EDGWO5 B @ED47 PAGE *GET CHARACTER * * BL @EDGP * "( OR "[ * OTHER * EDGP CLR R1 MOVB *R7+,R1 ;GET CHARACTER CI R1,>2000 ;SP? JEQ EDGP ;Y CI R1,>2800 ;"(? JEQ EDGP1 ;Y CI R1,>5B00 ;"[? JEQ EDGP1 ;Y INCT R11 ;N, RETURN 2(11) EDGP1 RT PAGE * * COMMAND LIST * * SYMBOLS STORED AS: * 3333 3222 2211 111S * WHERE S=0 3 LETTERS * S=1 4-6 LETTERS * * 0 1 2 3 4 5 6 7 * 0 @ A B C D E F G * 1 H I J K L M N O * 2 P Q R S T U V W * 3 X Y Z * EDSCL DATA >7564 RUN DATA >D266,>9A58 SIZ,LIS DATA >73C6 CON DATA >7CA0 PRO(GRAM) DATA >7164 REN(UMBER) DATA >2B06 CLE(AR) JG 02/3/82 * EDCL DATA >A3CF GOTO* RNGOTO EQU ($-EDCL)/2 RENUMBER OPCODE DATA >9BCF GOSUB* RNGSUB EQU ($-EDCL)/2 RENUMBER OPCODE DATA >9B0B ELSE* RNELSE EQU ($-EDCL)/2 RENUMBER OPCODE DATA >6964 REM* RNREM EQU ($-EDCL)/2 RENUMBER OPCODE DATA >93CC FOR* DATA 0 (LET*) DATA >A049 DATA NXTX DATA >C15D NEXT DATA >948B ERROR RNERR EQU ($-EDCL)/2 RENUMBER OPCODE PRTX DATA >4CA1 PRINT DATA >6047 CALL DATA >0BD9 LOAD DATA >8393 INPUT RNINP EQU ($-EDCL)/2 RENUMBER OPCODE DATA >0965 READ DATA >9965 RESTOR RNRSTR EQU ($-EDCL)/2 RENUMBER OPCODE DATA >A165 RETURN DATA >7D27 STOP DATA >4BAB UNIT DATA >6A69 TIME DATA >B067 SAVE DATA >9845 BASE DATA >1CCB ESCAPE DATA >2BDD NOESC DATA >7065 RANDOM DATA >0B53 IMASK DATA >A493 IRTN DATA >0CA9 TRAP RNTRAP EQU ($-EDCL)/2 RENUMBER OPCODE DATA >A845 BAUD DATA >0B8B ENABLE DATA >83E0 POP DATA >6A48 DIM DATA >A158 LET ONX DATA >73C0 ON RNON EQU ($-EDCL)/2 RENUMBER OPCODE IFX DATA >3240 IF RNIF EQU ($-EDCL)/2 RENUMBER OPCODE DEFX DATA >3148 DEF DATA >B95C NEW DATA >238A END BCP EQU $-EDCL/2+1 ****** INSERTS BEFORE HERE DATA >A244 BIT (SEE ED50) DATA >1486 CRB DATA >3486 CRF DATA >695A MEM DATA >25DA MWD EDCLE EQU $ * IFB EQU IFX-EDCL+2 ONB EQU ONX-EDCL+2 PTRB EQU PRTX-EDCL+2 PAGE * * SECOND HALF OF PRIMITIVE TABLE * DATA RUNP DATA SIZE,LST DATA CONT DATA PROGM DATA RENUMS DATA CLEARS JG 02/3/82 * EDCS EQU $-EDCL-2 DATA >001E,>00AA GOTO,GOSUB B0A EQU $+1 DATA >000A ELSE* BCPB BYTE BCP,0 REM* CFF80 DATA >FF80 FOR* DATA >0000 (LET)* B02 EQU $+1 DATA >0002 DATA DATA >0028 NEXT DATA >049E ERROR DATA >051C PRINT DATA >0018 CALL DATA >0008 LOAD DATA >052A INPUT DATA >0008 READ DATA >93E8 RESTOR DATA >74AA RETURN DATA >0020 STOP DATA >0028 UNIT DATA >000A TIME DATA >000A SAVE DATA >000A BASE DATA >2C02 ESCAPE DATA >00E6 NOESC DATA >6BC8 RANDOM DATA >02E6 IMASK DATA >001C IRTN DATA >0020 TRAP DATA >0008 BAUD DATA >2B04 ENABLE * PAGE * * SYSTEM FUNCTION TABLE * EDIL DATA >9882 ABS DATA >9102 ADR DATA >1CC2 ASC DATA >7502 ATN DATA >9BC6 COS DATA >860A EXP DATA >8392 INP DATA >3BD8 LOG DATA >CADC NKY DATA >7266 SIN DATA >9466 SQR DATA >9E66 SYS DATA >1A68 TIC * * ASSIGNABLE FUNCTIONS * DATA >A244 BIT DATA >1486 CRB DATA >3486 CRF DATA >695A MEM DATA >25DA MWD 2 MAY 1979 HJC * * CHARACTER FUNCTIONS * DATA >7158 LEN DATA >40DA MCH DATA >44A6 SRH EDILE EQU $ * * TRANSLATION TABLE INDEXED BY ASCII CODE. * NULLS ARE ILLEGAL. * EDSL DATA >4744,>3E43 ! " # $ DATA >4248,>454C % & ' ( DATA >4D5F,>5D3F ) * + , DATA >5C00,>5E00 - . / 0 DATA >0000,>0000 1 2 3 4 DATA >0000,>0000 5 6 7 8 DATA >003C,>4059 9 : ; < B56 DATA >5657,>413D = > ? @ DATA >4C46,>4D60 [ \ ] ^ * B59 EQU EDSL+27 B57 EQU EDSL+29 B46 EQU EDSL+33 PAGE EDGWOL EQU $ WORD OPERATORS LSTO TEXT 'TO' BYTE 0,>38 LSTB TEXT 'TAB' BYTE 0,>39 LSST TEXT 'STEP' BYTE 0,>3A LSTH TEXT 'THEN' BYTE 0,>3B LSOR TEXT 'OR' BYTE 0,>4E LSLOR TEXT 'LOR' BYTE 0,>4F LSAN TEXT 'AND' BYTE 0,>50 LSLAN TEXT 'LAND' BYTE 0,>51 LSNT TEXT 'NOT' BYTE 0,>52 LSLNT TEXT 'LNOT' BYTE 0,>53 LSLXO TEXT 'LXOR' BYTE 0,>54,0 PAGE * * LIST TRANSLATION TABLE INDEXED BY PSEUDO CODE. * "_ ARE UNDEFINED. * EDLC EQU $ B3A BYTE >3A : B40 BYTE >40 @ BYTE >23 # B2C BYTE >2C , B3B BYTE >3B ; B3F BYTE >3F ? BYTE >25 % BYTE >24 $ BYTE >22 " BYTE >27 ' BYTE >5C \ BYTE >21 ! BYTE >26 & B03 BYTE >03 _ (UNUSED) B5B BYTE >5B [ B5D BYTE >5D ] BYTE >28 ( BYTE >29 ) B1B BYTE >1B OR (UNUSED) B6D BYTE >6D LOR (UNUSED) B4E BYTE >4E AND (UNUSED) B6F BYTE >6F LAND (UNUSED) B38 BYTE >38 NOT (UNUSED) DEFXB BYTE DEFX-EDCL/2+1 LNOT (UNUSED) NXTXB BYTE NXTX-EDCL/2+1 LXOR (UNUSED) BYTE >3D == B3D BYTE >3D = BYTE >3E > BYTE >3E >= BYTE >3C < BYTE >3C <= BYTE >3C <> BYTE >2D - BYTE >2B + BYTE >2F / BYTE >2A * BYTE >5E ^ EVEN PAGE LCN1 EQU EDLC->3C LCN2 EQU EDCL-2 LCN3 EQU EDIL->36 LCN4 EQU EDCS+2 LNXT EQU NXTX-EDCL+2 LDEF EQU DEFX-EDCL+2 * ERR46 DATA ERROR2,46 * * SAVE * * = 0 OR BLANK - 733 DIGITAL CASSETTES * = 1 - BUBBLE MEMORY TERMINAL * = 2 - EIA AUDIO CASSETTES * * PROGRAM LOAD FLAG (PLF) REFLECTS DEVICE TYPE * OR -1 (LISTING) * SAVY CLR @PLF(R9) SET DEFAULT DEVICE TYPE LI R1,RCDON REF DC2 STRING BL @CKEX LOOK FOR EXPRESSION JMP SAV1 NONE EVFIX R2 CI R2,2 TOO LARGE? D2 EQU $-2 JH ERR46 Y - ERROR A R2,@PLF(R9) STORE DEVICE TYPE DEC R2 JGT SAV3 AUDIO JEQ SAV2 BUBBLE SAV1 C *R1+,*R1+ 733 - ONLY NEED DC2 CHARACTER SAV2 BL @TYPE OUTPUT TAPE START COMMANDS JMP LST0A SAV3 MOV @UNIT(R9),@AUDIO SAVE UNIT FLAG MOV @D2,@UNIT(R9) PORT A=OFF, PORT B=ON JMP LST0A PAGE * * LIST COMMAND * LST BL @TYPC ;OUT CRLF LST0A MOV @LNUM(9),R1 ;GET INITIAL START MOV @VNT(9),R8 ;GET TABLE ADR DECT R8 ;BACKUP LST0 C R8,@SLT(9) ;DONE? JLE LST2 ;Y AI R8,-4 ;MOVE TO NEXT ENTRY C R1,*R8 ;SAME? JGT LST0 SETO @DCNT(9) ;RESET INDENT COUNTER LST1 C R8,@SLT(9) ;DONE? JL LST2 ;Y MOV *R8+,R1 ;N, GET LINE NUMBER MOV *R9,R7 ;GET BUFFER ADR BL @LSTL ;LIST LINE AI R8,-6 ;PREPARE FOR NEXT LINE MOVB @B0D,*R7+ ;OUT CRLF MOVB @B0A,*R7+ SB *R7,*R7 * * IF SAVING PROGRAM AND RUNNING AT 1200 BUAD (ASR733, BUBBLE * MEMORY TERMINAL - AUDIO????) THEN * REMOVE THE 3 CHARACTER DELAY: PRETEND TO BE RUNNING AT * 300 BAUD - NEED PROPER CRLF DELAY * MOV @ASR0(R9),R3 SAVE BAUD RATE JG 02/3/82 MOV @PLF(R9),R0 JG 02/3/82 INC R0 SAVE OPERATION? JG 15/3/82 JEQ LST1A N - LIST JG 02/3/82 MOV R3,R3 Y - 1200 BAUD? JG 02/3/82 JNE LST1A N JG 02/3/82 SETO @ASR0(R9) Y - PRETEND TO BE 300 BAUD JG 02/3/82 LST1A BL @TYPB ;OUTPUT LINE JG 02/3/82 MOV R3,@ASR0(R9) RESTORE ORIGINAL BAUD RATE JG 02/3/82 BL @GETC ;CHECK FOR ESC JMP LST1 ;NOTHING JMP LST1 ;CHARACTER * * LIST/SAVE COMPLETE. IF SAVE NEED TO ADD 'ESCAPE' * CHARACTER AND DC4 TO TAPE. * LST2 MOV @PLF(R9),R3 EOF/ESCAPE - LIST? JLT LST4 Y - LI R1,RCDOF N - REF STOP TAPE COMMAND STRING DEC R3 JNE LST2A AUDIO OR 733 C *R1+,*R1+ BUBBLE - NEED TO RE-ENABLE PRINTER LST2A BL @TYPE DEC R3 JNE LST4 BUBBLE OR 733 MOV @AUDIO,@UNIT(R9) RESTORE ORIGINAL UNIT FLAG LST4 B @CRLF DONE PAGE *LIST GOTO'S AND GOSUB'S * LSTG1 MOVB @B2C,*R7+ ;OUT ", * LSTG MOVB *R3+,R1 ;GET LINE NUMBER SWPB R1 MOVB *R3+,R1 SWPB R1 OUTINT R1 ;CONVERT CB *R3+,@B3F ;CHECK NEXT BYTE FOR ", JEQ LSTG1 ;Y, ANOTHER GOTO, OR GOSUB DEC R3 ;N, PROCESS JMP LSTLX PAGE *LIST LINE * BL @LSTL * * IN R1 = LINE # * R7 = IOB * *R8 = PBC * PRESERVE R6,R8 * R15 = SP * LSTL MOV R11,R10 ;SAVE RETURN MOV *R8,R3 ;GET PBC A @BUS(9),R3 ;MAKE DISPLACEMENT INTO POINTER LI R15,>2000 ;GET SPACE MOVB R15,*R7+ ;OUT SPACE OUTINT R1 ;CONVERT LINE NUMBER MOV @DCNT(9),R2 ;GET INDENT COUNT CB *R3,@B03 ;ELSE? JNE LSTL1 ;N DECT R2 ;Y, INDENT 2 MORE SPACES * LSTL1 MOVB R15,*R7+ ;OUT SPACE INC R2 ;MORE? JLT LSTL1 ;Y CB *R3,@NXTXB ;NEXT? JNE LSTL2 ;N DEC R7 ;Y, INDENT 1 LESS * LSTL2 MOVB R15,*R7+ ;OUT SPACE * LSTL3 CLR R0 MOVB *R3+,R0 ;GET TYPE CI R0,>0600 ;IMPLIED LET? LETB EQU $-2 JEQ LSTL4 ;Y BL @LWRD ;LIST COMMAND TYPE DATA LCN2 ;EDCL-2 MOVB R15,*R7+ ;OUT SPACE CI R0,BCP*2 ;BIT,CRB,CRF,MEM? JL LSTL4 ;N DEC R7 ;Y, ELIMINATE SPACE * LSTL4 MOV R0,R14 ;SAVE TYPE CI R0,>3*2 ;CHECK TYPE JLT LSTG ;GOTO OR GOSUB JEQ LSTL3 ;ELSE CI R0,>5*2 JLT LSTRM ;LT - REMARK STATEMENT JGT LSTL5 ;GT - CONTINUE LOOKING DEC @DCNT(9) ;FOR, DECREMENT COUNTER * LSTL5 CI R0,LNXT ;NEXT? JNE LSTL6 ;N INC @DCNT(9) ;Y, INCREMENT COUNTER JLT LSTL6 ;COUNTER OK SETO @DCNT(9) ;RESET COUNTER LSTL6 MOV R0,R14 ;SAVE TYPE PAGE LSTLX MOVB *R3+,R0 ;GET CODE JEQ LSTLE ;DONE CB R0,@B1B ;USER FUNCTION? JL LSTFNP ;Y CB R0,@B38 ;SYSTEM FUNCTION? JL LSTSF ;Y SRL R0,8 ;READY R0,R4 MOV R0,R4 CI R0,>3C ;TO, TAB, STEP, THEN? JL LSTTT ;Y CI R0,>4E ;< OR? JL LSTLX0 ;Y CI R0,>54 ;> LXOR? JLE LSTTI ;N * LSTLX0 CI R0,>62 ;CHARACTER? JL LSTCR ;Y CI R0,>6F ;CONSTANT? JL LSTCN ;Y, INTEGERS JEQ LSTCNF ;Y, FLOATING POINT * MOV @VNT(9),R5 ;N, VARIABLE SLA R0,1 ;X 2 A R0,R5 ;INDEX & GET VARIABLE CLR R2 MOV @-2*>70(5),R5 JGT LSTVN ;DIMENSIONED? NEG R5 ;Y B4A EQU $+3 LI R2,>4A ;OUT [ * LSTVN COC @C380,R5 ;LETTER + NUMBER? JNE LSTVN1 ;N BL @LWRDO ;Y, OUT CHARACTER SRL R1,2 MOV R5,R1 ;OUT # ANDI R1,>7F ;MASK OUTINT R1 ;CONVERT JMP LSTVN2 * LSTVN1 SLA R5,1 ;REGULAR VARIABLE LI R13,LSTVN2 B @LWRD2 ;LIST * LSTVN2 MOV R2,R4 ;"[ NEEDED? JNE LSTCR1 ;Y JMP LSTLX * LSTLE SB *R7,*R7 ;PUT NULL ON END B *R10 PAGE LSTCR MOVB @LCN1(4),*R7+ ;EDLC->3C SWPB R0 BL @JMPR0 ;LOOK FOR CODES LSTCRT BYTE LSTCR0-LSTCRT/2,>44 " BYTE LSTCR0-LSTCRT/2,>45 ' BYTE LSTTR-LSTCRT/2,>47 ! DATA 0 BL @LSTCR2 ;LOOK FOR DOUBLES * == >= <= <> :: DATA >3D55,>3D58,>3D5A,>3E5B,>3A3C,>0000 * *TAIL REMARK * LSTTR DEC R7 ;BACKUP OVER ! MOVB R15,*R7+ ;OUT SPACE MOVB R15,*R7+ MOVB @LCN1(4),*R7+ JMP LSTRM1 * *REMARK ENTRY * LSTRM DEC R7 ;REM, MOVE BACK 1 CHAR * LSTRM1 MOVB *R3+,*R7+ ;MOVE INTO LINE JNE $-2 DEC R7 ;BACKUP B *R10 ;RETURN PAGE * LSTCR2 MOVB *R11+,*R7 ;MOVE CHARACTER INTO LINE JEQ LSTLX ;NOT FOUND CB R0,*R11+ ;FOUND? JNE LSTCR2 ;N, KEEP LOOKING CB *R7+,@B3A ;":? JNE LSTLX ;N LSTL2P B @LSTL2 * LSTFNP JMP LSTFN LSTCR0 MOVB *R3+,*R7+ ;MOVE IN CHARACTER STRING JNE $-2 ;LOOP UNTIL NULL DEC R7 ;BACKUP OVER NULL * LSTCR1 MOVB @LCN1(4),*R7+ ;EDLC->3C JMP LSTLX * LSTSF BL @LWRD ;LIST SYSTEM FUNCTION DATA LCN3 ;EDIL->36 LSTSF1 CB *R3,@B4A ;[? JEQ LSTLX ;Y, NO SPACE LSTSP MOVB R15,*R7+ ;OUT SPACE LSTLXP JMP LSTLX * LSTTI AI R4,->12 ;MOVE BACK BY THEN * LSTTT MOVB R15,*R7+ ;OUT SPACE A R4,R4 ;DOUBLE INDEX MOV @LSTTL->70(4),R5 38*2 * LSTT1 MOVB *R5+,*R7+ ;MOVE LETTER MOVB *R5,R0 ;CHECK END JNE LSTT1 ;LOOP CI R4,>3B*2 ;THEN? JEQ LSTL2P ;Y JMP LSTSP ;OUT SPACE PAGE LSTCN CI R0,>6D ;-1 THRU 9? JHE LSTCN1 ;N AI R0,->63 ;Y MOV R0,R1 JMP LSTCN2 ;CONVERT * LSTCN1 MOVB *R3+,R1 ;INTEGER SWPB R1 MOVB *R3+,R1 SWPB R1 B6E EQU $+3 CI R0,>6E ;HEX? JEQ LSTCN3 ;Y * LSTCN2 OUTINT R1 ;N, CONVERT JMP LSTLXP * LSTCN3 BL @HOUT ;OUT HEX JMP LSTLXP * LSTCNF OUTFP *R3 ;OUTPUT FP # AI R3,6 ;INCREMENT OVER NUMBER JMP LSTLXP * *USER FUNCTION ENTRY * LSTFN MOVB @B46,*R7+ ;OUT "F MOVB @B4E,*R7+ ;OUT "N AI R0,>4000 MOVB R0,*R7+ ;OUT LETTER CI R14,LDEF ;DEF? JNE LSTSF1 ;N, CHECK FOR ( MOV @VNT(R9),R14 GET TABLE ADDR & CLEAR 'LDEF' CB *R3,@B56 ;Y, ARGUMENTS? JEQ LSTLXP ;N MOVB @B5B,*R7+ ;Y, OUT "[ * LSTFD1 MOVB *R3+,*R14 ;SAVE DUMMY NAME MOV *R14+,R1 SRA R1,2 BL @LWRDO1 ;MAKE LETTER & STORE CB *R3,@B56 ;=? JEQ LSTFD2 ;Y MOVB @B2C,*R7+ ;N, OUT ", JMP LSTFD1 ;LOOP AGAIN * LSTFD2 MOVB @B5D,*R7+ ;OUT "] JMP LSTLXP * LSTTL DATA LSTO,LSTB DATA LSST,LSTH DATA LSOR,LSLOR DATA LSAN,LSLAN DATA LSNT,LSLNT DATA LSLXO PAGE *LIST WORD * BL @LWRD * ADR * LWRD MOV *R11+,R4 ;GET ADR OF WORD MOV R11,R13 ;SAVE RETURN SRA R0,7 ;SWAP AND X 2 A R0,R4 ;INDEX * LWRD1 MOV *R4,R5 ;GET WORD LWRD2 BL @LWRDO ;OUT FIRST CHARACTER SLA R1,7 BL @LWRDO ;OUT 2ND OR 5TH CHARACTER SLA R1,2 BL @LWRDO ;OUT 3RD OR 6TH CHARACTER SRL R1,3 AI R4,@LCN4 ;MOVE TO NEXT HALF (EDCS+2) SRL R5,1 ;ANOTHER HALF? JOC LWRD1 ;Y B *R13 ;N, RETURN * LWRDO MOV R5,R1 ;LOAD TEMP X *R11+ ;EXECUTE SHIFT ANDI R1,>1F00 ;MASK JEQ LWRDO2 ;RETURN * LWRDO1 AI R1,>4000 ;ADD LETTER BITS MOVB R1,*R7+ ;MOVE OUT LWRDO2 RT ;RETURN * * DON'T INSERT BETWEEN BLKFWD AND BUBFWD * BLKFWD BYTE >10,>37,>0,>0 <7> BYTE >1B,>32,>0 <2> RCDOF BYTE >1B B0D BYTE >0D,>14,>0 BYTE >1B,>1B,>1B,>35 <5> BYTE >1B,>38,>14,>0 <8> RCDON BYTE >1B,>35,>1B,>39 <5><9> BYTE >12,>0 PLYBON BYTE >1B,>34,>1B,>3A,>0 <4><:> PLYBOF BYTE >1B,>34,>1B,>3B <4><;> BYTE >13,>0 EVEN END IDT 'ERROR' * 08/11/78 * DEF ERRY REF EFLG REF NLIN DXOP EVFIX,11 * *ERROR COMMAND * ERRY EVFIX @EFLG(9) ;GET LINE NUMBER B @NLIN END IDT 'ERRORLST' OPTION TUNLST * * THIS MODULE OUTPUTS THE ERROR MESSAGE IN PLACE OF * THE ERROR NUMBER AS TYPICALLY OUTPUT. * DEF ERRLS1,ERRLS2 REF TYPE * CRLF1 EQU $ BYTE >0A,>0D ASTER EQU $ BYTE >2A,>2A,>2A,0 CRLF2 EQU $ BYTE >2A,>2A,>2A,>0A,>0D,0 EVEN PAGE ERRLS1 EQU $ MOV R11,R10 SAVE RETURN MOV *R9,R7 GET BUFFER ADDRESS LI R2,CRLF1 GET "CR/LF***" BL @MOVE MOVE INTO BUFFER SLA R1,1 MULTIPLY BY 2 TO GET WORD INDX MOV @ERRTBL-2(R1),R2 GET ERROR ADRESS FROM TABLE BL @MOVE MOVE INTO BUFFER LI R2,ASTER GET "***" BL @MOVE MOVE INTO BUFFER B *R10 AND RETURN * * MOVE * MOVE EQU $ MOVB *R2+,*R7+ MOVE CHARACTER JNE MOVE NULL TERMINATES STRING DEC R7 BACKUP BUFFER POINTER B *R11 RETURN PAGE ERRLS2 EQU $ MOV R11,R10 SAVE RETURN LI R1,CRLF1 GET "CR/LF***" BL @TYPE OUTPUT STRING R1 MOV R3,R0 GET ERROR NUMBER(IN ASCII) SWPB R0 RJ TENS DIGIT ANDI R0,>F MASK DIGIT MPY @D10,R0 CONVERT MOV R3,R11 COPY ERROR NUMBER ANDI R11,>F MASK DIGIT A R11,R1 ADD TO RESULT SLA R1,1 MULTIPLY BY 2 TO GET WORD INDX MOV @ERRTBL-2(R1),R1 GET ERROR ADDRESS FROM TABLE BL @TYPE OUTPUT STRING R1 LI R1,CRLF2 GET "***CR/LF" BL @TYPE OUTPUT STRING R1 B *R10 AND RETURN * D10 DATA 10 CONSTANT 10 PAGE ERRTBL EQU $ DATA ERR01 DATA ERR02 DATA ERR03 DATA ERR04 DATA ERR05 DATA ERR06 DATA ERR07 DATA ERR08 DATA ERR09 DATA ERR10 DATA ERR11 DATA ERR12 DATA ERR13 DATA ERR14 DATA ERR15 DATA ERR16 DATA ERR17 DATA ERR18 DATA ERR19 DATA ERR20 DATA ERR21 DATA ERR22 DATA ERR23 DATA ERR24 DATA ERR25 DATA ERR26 DATA ERR27 DATA ERR28 DATA ERR29 DATA ERR30 DATA ERR31 DATA ERR32 DATA ERR33 DATA ERR34 DATA ERR35 DATA ERR36 DATA ERR37 DATA ERR38 DATA ERR39 DATA ERR40 DATA ERR41 DATA ERR42 DATA ERR43 DATA ERR44 DATA ERR45 DATA ERR46 PAGE ERR01 EQU $ TEXT 'SYNTAX ERROR' BYTE 0 ERR02 EQU $ TEXT 'UNMATCHED PARENTHESIS' BYTE 0 ERR03 EQU $ TEXT 'INVALID LINE NUMBER' BYTE 0 ERR04 EQU $ TEXT 'ILLEGAL VARIABLE NAME' BYTE 0 ERR05 EQU $ TEXT 'TOO MANY VARIABLES' BYTE 0 ERR06 EQU $ TEXT 'ILLEGAL CHARACTER' BYTE 0 ERR07 EQU $ TEXT 'EXPECTING OPERATOR' BYTE 0 ERR08 EQU $ TEXT 'ILLEGAL FUNCTION NAME' BYTE 0 ERR09 EQU $ TEXT 'ILLEGAL FUNCTION ARGUMENT' BYTE 0 ERR10 EQU $ TEXT 'STORAGE OVERFLOW' BYTE 0 ERR11 EQU $ TEXT 'STACK OVERFLOW' BYTE 0 ERR12 EQU $ TEXT 'STACK UNDERFLOW' BYTE 0 ERR13 EQU $ ERR15 EQU $ TEXT 'NO SUCH LINE NUMBER' BYTE 0 ERR14 EQU $ TEXT 'EXPECTING STRING VARIABLE' BYTE 0 ERR16 EQU $ TEXT 'EXPECTING DIMENSIONED VARIABLE' BYTE 0 ERR17 EQU $ TEXT 'SUBSCRIPT OUT OF RANGE' BYTE 0 ERR18 EQU $ TEXT 'TOO FEW SUBSCRIPTS' BYTE 0 ERR19 EQU $ TEXT 'TOO MANY SUBSCRIPTS' BYTE 0 ERR20 EQU $ TEXT 'EXPECTING SIMPLE VARIABLE' BYTE 0 ERR21 EQU $ TEXT 'DIGITS OUT OF RANGE' BYTE 0 ERR22 EQU $ TEXT 'EXPECTING VARIABLE' BYTE 0 ERR23 EQU $ TEXT 'READ OUT OF DATA' BYTE 0 ERR24 EQU $ TEXT 'READ TYPE DIFFERS FROM DATA TYPE' BYTE 0 ERR25 EQU $ TEXT 'SQUARE OF NEGATIVE NUMBER' BYTE 0 ERR26 EQU $ TEXT 'LOG OF NON-POSITIVE NUMBER' BYTE 0 ERR27 EQU $ TEXT 'EXPRESSION TOO COMPLEX' BYTE 0 ERR28 EQU $ TEXT 'DIVISION BY ZERO' BYTE 0 ERR29 EQU $ TEXT 'FLOATING POINT OVERFLOW' BYTE 0 ERR30 EQU $ TEXT 'FIX ERROR' BYTE 0 ERR31 EQU $ TEXT 'FOR W/O NEXT' BYTE 0 ERR32 EQU $ TEXT 'NEXT W/O FOR' BYTE 0 ERR33 EQU $ TEXT 'EXP FUNCTION HAS INVALID ARGUMENT' BYTE 0 ERR34 EQU $ TEXT 'UNNORMALIZED NUMBER' BYTE 0 ERR35 EQU $ TEXT 'PARAMETER ERROR' BYTE 0 ERR36 EQU $ TEXT 'MISSING ASSIGNMENT OPERATOR' BYTE 0 ERR37 EQU $ TEXT 'ILLEGAL DELIMITER' BYTE 0 ERR38 EQU $ TEXT 'UNDEFINED FUNCTION' BYTE 0 ERR39 EQU $ TEXT 'UNDIMENSIONED VARIABLE' BYTE 0 ERR40 EQU $ TEXT 'UNDEFINED VARIABLE' BYTE 0 ERR41 EQU $ TEXT 'INVALID MEMORY LIMIT' JG 15/3/82 BYTE 0 ERR42 EQU $ TEXT 'INTERRUPT W/O TRAP' BYTE 0 ERR43 EQU $ TEXT 'INVALID BAUD RATE' BYTE 0 ERR44 EQU $ TEXT 'TAPE READ ERROR' BYTE 0 ERR45 EQU $ ERROR LINE REMOVED JG 15/3/82 BYTE 0 ERR46 EQU $ TEXT 'INVALID DEVICE NUMBER' BYTE 0 EVEN END IDT 'ESCAPE' * 08/11/78 * DEF ESCY DEF NOEY REF MODE REF NLIN0 * *ESCAPE ENABLE COMMAND * ESCY MOV @MODE(9),R0 ;IDLE? JEQ ESCR ;Y, RETURN SETO @MODE(9) ;N, ENABLE ESCAPES ESCR B @NLIN0 * * *ESCAPE DISABLE COMMAND * NOEY ABS @MODE(9) ;CLEAR UPPER BIT JMP ESCR END IDT 'EVAL' * * REVISION: 12/31/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * 30 MAY 79 ;COPY AND UPDATE TO REL5 * ROUTINE LIST: * * EVARZ ;EVALUATE VARIABLE * EVERZ ;EVALUATE EXPRESSION * EVSDZ ;EVALUATE STRING * EVFX ;EVALUATE AND FIX * CKEX ;CHECK FOR EXPRESSION * * EVAL ;RECURSIZE EVALUATOR * EVALS2 ;2ND ENTRY IN RECURSIVE EVALUATOR * ADDF ;ADD TWO VARIABLES * SUBF ;SUBTRACT TWO VARIABLES * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * 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 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 * REF ABSF ;ABSOLUTE VALUE FUNCTION REF ASCF ;CONVERT ASCII FUNCTION REF ATNF ;ARC-TANGENT FUNCTION REF COSF ;COSINE FUNCTION REF EXPF ;EXPONENTIAL FUNCTION REF INPF ;INTEGER PART FUNCTION REF LOGF ;LOG FUNCTION REF NKYF ;KEY FUNCTION REF SINF ;SINE FUNCTION REF SQRF ;SQUARE ROOT FUNCTION REF SYSF ;SYSTEM FUNCTION REF TICF ;TIC FUNCTION REF BITF ;BIT FUNCTION REF CRBF ;CRB FUNCTION REF CRFF ;CRF FUNCTION REF MEMF ;MEM FUNCTION REF MWDF ;MEMORY WORD FUNCTION REF LENF ;STRING LENGTH FUNCTION REF MCHF ;STRING MATCH FUNCTION REF SRHF ;STRING SEARCH FUNCTION REF POWF ;POWER FUNCTION REF LORF ;LOGICAL OR FUNCTION REF LXORF ;LOGICAL EXCLUSIVE OR FUNCTION REF LANDF ;LOGICAL AND FUNCTION REF ANDF ;AND FUNCTION REF ORF ;OR FUNCTION REF NOTF ;NOT FUNCTION REF LNOTF ;LOGICAL NOT FUNCTION * REF FIX ;FIX ROUTINE REF FLOAT ;FLOAT ROUTINE REF RANDZ ;GET RANDOM NUMBER ROUTINE REF ADRF RETURN ADDRESS OF VARIABLE FUNCTION * * EXTERNAL DATA: * REF EVSKB,EVSKE ;EVALUATION STACK REF FPAC,FPAC2 ;FLOATING POINT ACCUMULATOR REF TEMP ;TEMP FLOATING POINT REGISTER REF TEMP2,TEMP4 REF FUZZ ;FUZZ VALUE REF UFT ;USER-FUNCTION-TABLE INDEX REF VDT ;VARIABLE-DEFINITION-TABLE INDEX REF VNT ;NVARIABLE-NAME-TABLE INDEX REF IOB ;I/O-BUFFER INDEX REF DLIM ;DELIMITER INDEX REF NVD ;NEXT-VARIABLE-DEFINITION INDEX REF NVS ;NEXT-VARIABLE-STORAGE INDEX REF WPR2 ;SECONDARY WORKSPACE REF AUDIO EVFX TEMP STORAGE (USED IN LOAD/SAVE) * * MODULE EXTERNAL DEFINITIONS: * DEF EVSFR ;RETURN FOR FUNCTIONS DEF EVOP3A ;RETURN FOR OPERATORS DEF B01,B05 ;BYTES DEF C1,C4,C6 ;WORDS * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'EVALUATE STRING CONSTANT OR VARIABLE' PAGE * ABSTRACT: * * EVSD EVALUATES FOR A STRING CONSTANT OR VARIABLE * BEGINNING AT THE PBC (R8). MULTIPLY RETURNS ARE * USED ACCORDING TO WHAT IS FOUND. IF NO STRING * OR VARIABLE IS FOUND, THE PBC (PROGRAM BYTE COUNTER) * IS LEFT UNCHANGED. * * CALLING SEQUENCE: * * BLWP @EVSDZ * STRING CONSTANT RETURN ("---") * STRING VARIABLE RETURN ($VAR) * NEITHER * * IN R8 = PBC (PROGRAM BYTE COUNTER) * R9 = PTRS * OUT R0 = DLIM (DELIMITER * R2 = PTR TO STRING * R8 = PBC UPDATED * * EXCEPTIONS AND CONDITIONS: * * ERRORS INCLUDE EXPECTING VARIABLE, SYNTAX ERROR, * UNDEFINED FUNCTION, ILLEGAL DELIMITER, STORAGE * OVERFLOW, UNDEFINED VARIABLE, EXPRESSION TOO * COMPLEX, SUBSCRIPT ERROR, TOO MANY SUBSCRIPTS, * UNDIMENSIONED VARIABLE, AND ALL ARITHMETIC ERRORS. * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) PAGE * ENTRY POINT: * DEF EVSDZ * EVSDZ DATA WPR2,EVSD EVSD MOV @16(13),R8 ;GET PBC CB *R8,@B43 ;$? JEQ EVSD2 ;Y JL EVSD1 ;NOT STRING CB *R8+,@B45 ;" OR '? JH EVSD1 ;N MOV R8,R2 ;Y * MOVB *R8+,R0 ;LOOK FOR "0 JNE $-2 * CLR R0 MOVB *R8+,R0 ;RETURN DELIMITER MOV @18(13),R9 JMP EVER1 * EVSD1 C *R14+,*R14+ ;NOT STRING, RETURN 4(14) RTWP * EVSD2 INCT R14 INC @16(13) ;SKIP $ * * THIS SHOULD FALL INTO EVAR TITL 'EVALUATE VARIABLE' PAGE * ABSTRACT: * * EVAR CALLS THE EXPRESSION EVALUATOR FOR * ONE ITEM ONLY, NAMELY A VARIABLE. WITH * R5 ZEROED, THE EVALUATOR WILL EVALUATE * UP TO THE FIRST OPERATER OR DELIMITER. * UPON RETURNING, EVAR WILL CHECK TO SEE * IF THE RESULT IS IN THE EXPRESSION STACK * IN WHICH CASE AN EXCEPTION WOULD OCCUR. * * CALLING SEQUENCE: * * BLWP @EVARZ * NORMAL RETURN * * IN R8 = PBC * R9 = PTRS * OUT R0 = DLIM * R2 = ADR * R8 = PBC UPDATED * * EXCEPTIONS AND CONDITIONS: * * SAME AS EVSD * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) PAGE * ENTRY POINT: * DEF EVARZ * EVAR CLR R5 ;SET FOR VARIABLE ONLY BL @EVALS1 ;EVALUATE CI R2,EVSKB ;# IN STACK? JL EVER1 ;N, RETURN * ERR22 DATA ERROR+22 ;EXPECTING VARIABLE EVARZ DATA WPR2,EVAR TITL 'CHECK FOR EXPRESSION' PAGE * ABSTRACT: * * CKEX IS CALLED TO SEE IF AN EXPRESSION * COULD OCCUR NEXT. THE EXCEPTION WOULD * OCCUR IF A DELIMITER WAS THE NEXT ITEM. * * CALLING SEQUENCE: * * BL @CKEX * NO EXPRESSION * EXPRESSION * * IN R8 = PBC * * EXCEPTIONS AND CONDITIONS: (NONE) * * EXTERNAL ROUTINE LIST: (NONE) * * LOCAL DATA: (NONE) * * ENTRY POINT: * DEF CKEX * CKEX MOVB *R8,@DLIM(9) JEQ CKEX2 ;EOL CB *R8,@B38 ;FUNCTION? JL CKEX1 ;Y CB *R8,@B4C ;OPERATOR OR VARIABLE? JL CKEX2 ;N, TAKE ERROR RETURN * CKEX1 INCT R11 CKEX2 RT TITL 'EVALUATE FULL EXPRESSION' PAGE * ABSTRACT: * * EVER WILL EVALUATE A FULL EXPRESSION AND * WILL EXIT THRU THE ERROR CALL * WITH ANY EXCEPTION. * * CALL SEQUENCE: * * BLWP @EVERZ * * IN R8 = PBC * R9 = PTRS * OUT R0 = DLIM * R2 = ADR * R8 = PBC UPDATED * * EXCEPTIONS AND CONDITIONS: * * SAME AS EVSD * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES:) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * DEF EVERZ * EVERZ DATA WPR2,EVER EVER BL @EVALS ;EVALUATE EVER1 MOV R2,@4(13) ;RETURN PARAMETERS EVER2 MOV R0,@DLIM(9) ;RETURN DELIMITER MOV R0,*R13 MOV R8,@16(13) ;UPDATE PBC RTWP TITL 'EVALUATE AND FIX RESULT' PAGE * ABSTRACT: * * EVFX USES AN XOP CALL SINCE IT IS * USED SO OFTEN AND RETURNS A 1 WORD, * 2'S COMPLEMENT INTEGER IN THE OPERAND * OF THE EXOP. EVFX DOES A FULL * EVALUATION (R5 <> 0) AND RETURNS * R0, R8, AND THE RESULT. * * SINCE R0 IS ALTERED, EVFX R0 WOULD * BE ILLEGAL. * * CALLING SEQUENCE: * * XOP XX,11 * * IN R8 = PBC * R9 = PTRS * OUT R0 = DLIM * R8 = PBC UPDATED * *R11 = # * * EXCEPTIONS AND CONDITIONS: * * SAME AS EVSD WITH THE ADDITION OF * A FIX ERROR POSSIBILITY. * * R0,R8 CANNOT BE USED AS THE RETURNING * FIELD. * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) * * ENTRY POINT: * * DXOP EVFIX,11 DEF EVFX ;*** NOT USED *** * EVFX MOV R11,@AUDIO SAVE ADDRESS (AUDIO - LOAD/SAVE) BL @EVALS EVALUATE BL @FIX FIX RESULT MOV @AUDIO,R12 RESTORE RETURN ADDRESS MOV R1,*R12 RETURN # JMP EVER2 TITL 'EXPRESSION EVALUATOR' PAGE * ABSTRACT: * * EVAL IS A RECURSIVE STACK EXPRESSION EVALUATOR. * R6 POINTS TO THE BOTTOM OF THE STACK WHERE * OPERANDS AND OTHER DATA ARE STACKED * WHILE R7 POINTS TO THE TOP OF THE STACK WHERE * OPERATORS ARE STACKED. BOTH ENDS OF THE STACK * ARE MARKED WITH NULLS TO CHECK FOR PROPER * EXPRESSION TERMINATION. THE ROUTINE CONSISTS * MAINLY OF A MULTIPLEXOR AND A PRECEDENCE ORIENTED * PROCESSOR. * * VARIABLES ARE STORED ON A STACK AS AN ADDRESS. * CONSTANTS GO DIRECTLY ON THE STACK FOLLOWED BY * A -1 TO INDICATE A CONSTANT VALUE. IE: * * * (PTR) * ----- /XXXX XXXX XXXX/ * * 4110 * * * 0000 * * * 0000 * * * -1 * * * USER FUNCTIONS, SYSTEM FUNCTIONS, AND DIMENSIONED * VARIABLES ALL RECURSE ON THE EVALUATOR TO * OBTAIN THE ARGUMENTS. * * THE LEFT BYTE OF R5 CONTROLS WHETHER A OPERATOR * IS UNARY OR NOT. WHEN NULL AND AN OPERATOR IS * ENCOUNTERED, IT MUST BE UNARY! UPON ENCOUNTERING * A VARIABLE, THIS LEFT BYTE IS SET INDICATING * THE NEXT OPERATOR WILL NOT BE UNARY. * * THE RIGHT BYTE OF R5 CONTROLS HOW FAR THE * EVALUATION IS TO GO. IE, ONE ONLY WANTS THE * FIRST VARIABLE FOR AN ASSIGNMENT STATEMENT OR * ANYWHERE ONE WANTS TO STORE A VALUE. THUS, * WHEN THE RIGHT BYTE OF R5 IS ZERO, EVALUATION * WILL TERMINATE AT THE FIRST OPERATOR. * * WHEN A DELIMITER IS ENCOUNTED, THE RIGHT BYTE * OF R5 IS SET TO ZERO THUS TERMINATING THE * EVALUATION OF THE EXPRESSION. * * THE LEAST SIGNIFICANT BIT OF THE OPERATOR * ADDRESS IS USED TO INDICATE A UNARY OPERATION. * * USER FUNCTIONS USE THE STACK QUITE EXTENSIVELY * PUSHING FUNCTION ADDRESS, DUMMY ARGUMENTS, PLC, * R5, AND A RETORE-STACK-POINTER (R4) FOR EACH * LEVEL OF FUNCTIONS. * * CALLING SEQUENCE: * * BL @EVALS ;START EVALUATION * * IN (R9) = POINTERS * R5 = EXPRESSION FLAG * * (FALL THRU TO EVAL) * * BL @EVAL ;RECURSIVE EVALUATOR * * R5 = EXPRESSION FLAG * R6 = BOTTOM OF STACK * R7 = TOP OF STACK * R8 = PLC * (R9) = POINTERS * * EXCEPTIONS AND CONDITIONS: * * IF R6 >= R7, THEN AN EXPRESSION TOO * COMPLEX OCCURS. * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODLULE VARIABLES AND CONSTANTS PAGE *USER FUNCTION EVALUATION * *STACK: R5 * FUNC ADR * DUMMY #1 * DUMMY #2 * DUMMY #3 * . . . * R8 * R4 = STACK+2 * ERR38 DATA ERROR2,38 ;UNDEFINED FUNCTION * EVAFN MOV R5,*R6+ ;SAVE R5 MOV R6,R4 ;MARK MOV @UFT(9),R3 ;GET TABLE ADR SRL R0,6 ;GET INDEX A R0,R3 ;INDEX MOV *R3+,*R6+ ;STACK ADR JEQ ERR38 ;NOT DEFINED, ERROR MOV *R3,R1 ;GET COUNT JEQ EVAFN5 ;NO ARGUMENTS MOV @VDT(9),R3 MOV *R3+,*R6+ ;SAVE OLD DUMMIES MOV *R3+,*R6+ MOV *R3,*R6+ AI R3,-4 SETO R5 ;DO FULL EVAL IF NOT [ CB *R8+,@B4A ;[? JEQ EVAFN1 ;Y DEC R8 ;N CLR R5 SETO R1 ;SET COUNT TO -1 * EVAFN1 MOV R1,*R6+ ;PUSH COUNT MOV R3,*R6+ MOV R4,*R6+ BL @EVAL ;EVALUATE NEXT PARAMETER DECT R6 MOV *R6,R4 ;POP R4 DECT R6 MOV *R6,R3 ;POP SYMBOL TABLE PTR DECT R6 MOV *R6,R1 ;POP COUNT MOV R6,*R3+ ;LOAD NEW DUMMY ADR MOV *R2+,*R6+ ;STACK MOV *R2+,*R6+ MOV *R2,*R6+ INC R1 ;LOOKING FOR VARIABLE ONLY? JEQ EVAFN2 ;Y DECT R1 ;N, DONE? JEQ EVAFN4 ;Y SETO R5 ;N, DO FULL CI R0,>3F00 ;,? JEQ EVAFN1 ;Y EVER37 DATA ERROR2,37 ;ILLEGAL DELIMITER * EVAFN2 DEC R8 ;BACKUP OVER DELIMITER JMP EVAFN5 * EVAFN4 CI R0,>4B00 ;]? JNE EVER37 ;N, ERROR * EVAFN5 MOV R4,*R6+ ;PUSH R4 MOV R8,*R6+ ;PUSH R8 MOV *R4,R8 ;GET DEF ADR SETO R5 BL @EVAL ;EVALUATE DECT R6 MOV *R6,R8 ;POP R8 DECT R6 MOV *R6,R6 ;POP R6 (R4) MOV R6,R4 INCT R4 ;MOVE TO DUMMY STORAGE MOV @VDT(9),R3 MOV *R4+,*R3+ ;RESTORE OLD VARIABLE ADDRESSES MOV *R4+,*R3+ MOV *R4,*R3 JMP EVSFR ;RETURN PAGE *DO SYSTEM STRING OPERAND * EVSFO CB *R8,@B43 ;$? JEQ EVSFO2 ;Y JL EVSFO1 CB *R8,@B45 ;" OR '? JH EVSFO1 ;N INC R8 ;Y MOV R8,R2 ;SAVE ADR * MOVB *R8+,R0 ;MOVE TO END OF STRING JNE $-2 MOVB *R8+,R0 ;GET DELIMITER INCT R11 * EVSFO1 RT * EVSFO2 INC R8 ;MOVE TO VARIABLE INCT R11 ;SET RETURN CLR R5 B @EVAL ;DO EVALUATION PAGE *SYSTEM FUNCTION EVALUATION * EVSF MOV R5,*R6+ ;STACK R5,R0 MOV R0,*R6+ LI R1,1 ;DEFAULT SECOND PARAMETER TO 1 CB *R8+,@B4A ;[? JEQ EVSF1 ;Y CLR R5 ;N, DO VARIABLE ONLY DEC R8 BL @EVAL DEC R8 JMP EVSF2 * EVSF1 BL @EVSFO ;CHECK FOR STRING JMP EVSF1A ;N MOV R2,*R6+ ;STACK ADR CI R0,>3F00 ;,? JNE EVSF1B ;N BL @EVSFO ;GET SECOND STRING JMP EVER37 MOV R2,R1 JMP EVSF1B * EVSF1A SETO R5 ;DO FULL EVALUATION BL @EVAL CI R0,>4B00 ;]? JEQ EVSF2 ;Y CI R0,>3F00 ;,? JNE EVER37 ;N, ERROR MOV R2,*R6+ ;STACK ADR SETO R5 BL @EVAL ;GET SECOND PARAMETER BL @FIX * EVSF1B DECT R6 ;POP 1ST OPERAND MOV *R6,R2 CI R0,>4B00 ;]? JNE EVER37 ;N, ERROR * EVSF2 DECT R6 ;POP ID MOV *R6,R3 SRL R3,7 ;GET INDEX MOV @SFUNP->36(3),R11 CLEAR 0 ;CLEAR FPAC BL *R11 ;GOTO ROUTINE * EVSFR DECT R6 ;POP R5 MOV *R6,R5 * EVSF4 MOV *R2+,*R6+ ;MOVE RESULT ON STACK MOV *R2+,*R6+ MOV *R2,*R6+ JMP EVAL6 ;CONTINUE * *GET RANDOM NUMBER * EVRND BLWP @RANDZ ;GET RANDOM # IN FPAC LI R2,@FPAC JMP EVSF4 PAGE *ENTRY POINT: * DEF EVAL ;FULL EXPRESSION EVALUATION DEF EVALS2 ;PARTIAL EXPRESSION EVALUATION * EVALS SETO R5 ;FULL EXPRESSION * EVALS1 MOV @16(13),R8 ;GET PBC MOV @18(13),R9 ;GET POINTERS * EVALS2 LI R6,EVSKB ;GET BEGINNING STACK PTR LI R7,EVSKE ;GET END STACK PTR * *EVALUATE SIMPLE EXPRESSION * EVAL MOV R11,*R6+ ;STACK RETURN CLR *R6+ ;MARK OPERAND STACK CLR R0 ;MARK OPERATOR STACK MOVB R0,R5 ;IF OPERATOR: MUST BE UNARY * EVAL1 DEC R7 ;PUSH ON OPERATOR STACK MOVB R0,*R7 C R6,R7 ;STACK OVERFLOW? JHE EVER27 ;Y, ERROR * EVAL2 MOVB *R8+,R0 ;PARSE JEQ EVADL ;DONE CI R0,>6F00 ;VARIABLE? JH EVAV ;Y JEQ EVFP ;N, FP # CI R0,>6200 ;CONSTANT? JHE EVAL3 ;Y CI R0,>4C00 ;"( OR OPERATER? JH EVOP ;OPERATER JEQ EVAL1 ;"(, PUSH CI R0,>3800 ;DELIMITER? JHE EVADL ;Y CI R0,>1B00 ;SYSTEM FUNCTION? JHE EVSF ;Y B @EVAFN ;FUNCTION * EVFP MOVB *R8+,*R6+ ;FP CONSTANT MOVB *R8+,*R6+ MOVB *R8+,*R6+ MOVB *R8+,*R6+ MOVB *R8+,*R6+ MOVB *R8+,*R6+ JMP EVAL6 ;MARK * EVAL3 CI R0,>6D00 ;1 WORD INTEGER? JHE EVAL4 ;Y SWPB R0 AI R0,->63 ;N, -1 THRU 9 JMP EVAL5 ;STORE # * EVER10 DATA ERROR+10 ;STORAGE OVERFLOW PAGE *UNARY MINUS * EVAL9 LI R0,>6100 ;STACK - EVAL91 JMP EVAL1 * *VARIABLE * EVAV CI R0,>7300 ;RND? JEQ EVRND ;Y MOV @VNT(9),R1 ;GET VARIABLE TABLE SRL R0,7 ;SWAP & X 2 A R0,R1 ;INDEX MOV @->70*2(1),R1 ;DIMENSIONED JLT EVADV ;Y MOV @VDT(9),R1 A R0,R1 MOV @->70*2(1),R0 ;DEFINED? JNE EVAL7 ;Y SWPB R5 ;POSITION EVALUATION TYPE LJ IN R5 MOVB R5,R5 ;FULL OR VARIABLE EVALUATION ? SWPB R5 ;RESTORE EVALUATION TYPE TO ORIGINAL POSITION JNE EVER40 ;NE - FULL EVAL - DO NOT DEFINE - ERROR MOV @NVS(9),R0 ;VARIABLE EVALUATION ONLY - DEFINE IT AI R0,-6 C R0,@NVD(9) ;OK? JL EVER10 ;N, STORAGE OVERFLOW MOV R0,@->70*2(1) MOV R0,@NVS(9) ;UPDATA NVS JMP EVAL7 EVER40 EQU $ DATA ERROR2,40 ;UNDEFINED VARIABLE * *CONSTANTS * EVAL4 MOVB *R8+,R0 ;1 WRD CONSTANT SWPB R0 MOVB *R8+,R0 SWPB R0 * EVAL5 CLR *R6+ ;MOVE INTO STACK MOV R0,*R6+ ;INSERT 0,#,0 CLR *R6+ * EVAL6 SETO R0 ;MARK AS CONSTANT * EVAL7 MOV R0,*R6+ ;MARK STACK CLR R0 * EVAL8 MOVB @BFF,R5 ;IF OPERATOR: MUST NOT BE UNARY C R6,R7 ;STACK OVERFLOW? JL EVAL2 ;N, OK * EVER27 DATA ERROR+27 ;Y, EXPRESSION TOO COMPLEX PAGE *OPERATOR * *HANDLE UNARY OPERATORS * EVOPA CI R0,>5D00 ;"+? JEQ EVAL2 ;Y, IGNOR CI R0,>5C00 ;N, "-? JEQ EVAL9 ;Y, STACK UNARY - CI R0,>5200 ;NOT? JEQ EVAL1 ;Y, STACK CI R0,>5300 ;LNOT? JEQ EVAL1 ;Y, STACK EVER0 DATA ERROR+1 ;N, SYNTAX ERROR * *HANDLE OPENING AND CLOSING PAREN'S * EVOP0 CI R0,>4D00 ;")? JNE EVOP1 ;N EVOP0A CB *R7,@B4C ;(? JNE EVOP1 ;N INC R7 ;Y, POP JMP EVAL2 * EVOP0B MOVB *R7,R1 ;NULL? JNE EVOP0A ;N JMP EVADL ;Y, TERMINATE * *OPERATER ENTRY * EVOP MOVB R5,R1 ;NEED UNARY OPERATER? JEQ EVOPA ;Y CI R0,>4D00 ;)? JEQ EVOP0B ;Y ANDI R5,>FF ;N, ALLOW UNARY ONLY TO FOLLOW JNE EVOP1 ;FULL EXPRESSION * *DELIMITER ENTRY * EVADL CLR R5 ;SET TO TERMINATE CLR R0 ;DO CR * EVOP1 MOVB *R7,R1 ;LOOK AT TOP OPERATOR MOV R0,R4 ANDI R4,>FE00 ;LAP OFF LOW BIT CB R4,R1 ;HIGHER PRECEDENCE? JH EVAL91 ;Y, STACK MOVB *R7+,R3 ;N, POP OPERATER JEQ EVOP4 ;DONE SRL R3,7 ;SWAP & X 2 MOV @EVATB->9C(3),R11 * DECT R6 ;POP VARIABLE MOV *R6,R1 ;EMPTY? JEQ EVER0 ;Y INC *R6 ;CONSTANT? JNE EVOP2 ;N AI R6,-6 ;Y MOV R6,R1 * EVOP2 COC @C1,R11 ;UNARY OPERATION? JEQ EVOP3 ;Y DECT R6 ;N, GET SECOND OPERAND MOV *R6,R2 ;EMPTY? JEQ EVER0 ;Y INC *R6 ;CONSTANT? JNE EVOP3 ;N AI R6,-6 ;Y MOV R6,R2 * EVOP3 BL *R11 ;DO OPERATION * EVOP3A MOV *R2+,*R6+ ;MOVE RESULTS ON STACK MOV *R2+,*R6+ MOV *R2,*R6+ SETO *R6+ ;MARK AS CONSTANT JMP EVOP0 ;CONTINUE * EVOP4 MOVB @-1(8),R0 ;GET DELIMITER DECT R6 ;POP VARIABLE MOV *R6,R2 ;EMPTY? JEQ EVER0 ;Y, ERROR INC *R6 ;CONSTANT? JNE EVOP5 ;N AI R6,-6 ;Y MOV R6,R2 * EVOP5 AI R6,-4 ;DONE, POP STACK MOV *R6,R11 MOV @2(6),R1 ;STACK EMPTIED? JNE EVER0 ;N, ERROR RT PAGE EVAL8P JMP EVAL8 * *DIMENSIONED VARIABLE * EVADV MOV @VDT(9),R1 A R0,R1 MOV @->70*2(1),R4 ;DEFINED? JEQ ERR39 ;N, UNDIMENSIONED VARIABLE MOV R5,*R6+ ;STACK R5 CLR *R6+ ;ZERO INDEX & STACK * EVADV1 MOV R4,*R6+ ;STACK R4 SETO R5 ;DO FULL EXPRESSION BL @EVAL ;RECURSE BL @FIX ;FIX # DECT R6 ;POP BASE ADR MOV *R6,R4 DECT R6 ;READY FOR INDEX POP C R1,*R4+ ;EXCEED DIMENSION? JH ERR17 ;Y, SUBSCRIPT ERROR MOV *R4+,R5 ;GET DEL MULTIPLIER CI R5,-1 ;DONE? JEQ EVADV2 ;Y MPY R5,R1 ;MULTIPLY A R2,*R6+ ;ADD TO INDEX & STACK CI R0,>3F00 ;,? JEQ EVADV1 ;Y, DO AGAIN * ERR18 DATA ERROR+18 ;N, TOO FEW SUBSCRIPTS * EVADV2 A *R6,R1 ;ADD FINAL DIMENSION MPY @C6,R1 ;MULTIPLY BY 6 A R4,R2 ;ADD BASE DECT R6 ;POP R5 MOV *R6,R5 MOV R2,*R6+ ;STACK ADDRESS CI R0,>4B00 ;]? JEQ EVAL8P ;Y CI R0,>4000 ;;? JNE ERR19 ;N, TOO MANY SUBSCRIPTS MOV R5,*R6+ ;Y, STACK R5 SETO R5 ;DO FULL EVAL BL @EVAL ;RECURSE BL @FIX ;GET INTEGER CI R0,>4B00 ;]? JNE EVADVE ;N, ERROR DECT R6 ;Y, POP R5 MOV *R6,R5 DECT R6 ;POP ADR MOV *R6,R0 DEC R1 ;INDEX=COUNT-1 JLT ERR17 ;ERROR A R1,R0 ;INDEX C R0,@IOB(9) ;EXCEED MEMORY? JHE ERR17 ;Y, ERROR B @EVAL7 ;N, CONTINUE * ERR17 DATA ERROR+17 ;SUBSCRIPT ERROR * ERR19 DATA ERROR+19 ;TOO MANY SUBSCRIPTS * ERR39 DATA ERROR2,39 ;UNDIMENSIONED VARIABLE * EVADVE DATA ERROR2,37 ;INVALID DELIMITER * EVATB DATA ORF,LORF DATA ANDF,LANDF DATA NOTF,LNOTF DATA LXORF DATA FUZF DATA EQUF,GTHF DATA GEQF,LTHF DATA LEQF,NEQUF DATA SUBF,ADDF DATA DIVF,MULF DATA POWF,UMNF+1 * EVPR EQU $-EVATB DATA 0 B01 EQU $+1 C1 DATA 1 C4 DATA 4 B05 EQU $+1 DATA 5 DATA 2 DATA 3 C6 DATA 6 * SFUNP DATA ABSF DATA ADRF DATA ASCF DATA ATNF DATA COSF DATA EXPF DATA INPF DATA LOGF DATA NKYF DATA SINF DATA SQRF DATA SYSF DATA TICF DATA BITF DATA CRBF DATA CRFF DATA MEMF DATA MWDF DATA LENF DATA MCHF DATA SRHF TITL 'ARITHMETIC OPERATIONS' PAGE * ABSTRACT: * * ARITHMETIC OPERATIONS SUCH AS ADD, SUBTRACT, * MULTIPLY, DIVIDE, UNARY MINUS, AND RELATIONAL * OPERATORS SUCH AS FUZZ, EQUAL, NOT EQUAL, * LESS THAN, GREATER THAN, LESS THAN OR EQUAL, * GREAT THAN OR EQUAL, AND NOT EQUAL USE * OPERANDS POINTED TO BY R1,R2 AND RETURN A * RESULT POINTED TO BY R2. * * PREP DETERMINES IF BOTH OPERANDS ARE INTEGER * VALUES (IN WHICH CASE AN ATTEMPT IS MADE TO * DO AN INTERATION OPERATION) OR IF 1 OR BOTH * OF THE OPERANDS IS A FLOATING POINT NUMBER * (IN WHICH CASE BOTH ARE FLOATED AND A FLOATING * POINT OPERATION IS PERFORMED.) * * RELATIONAL OPERATORS ARE GIVEN A VALUE CORRE- * SPONDING TO THE COMPARISON TO BE MADE. BIT 0 * IS THE EQUAL BIT, BIT 1 IS THE LESS-THAN BIT, * AND BIT 2 IS THE GREATER-THAN BIT. HENCE: * * 0000 = FUZZ * 0001 = EQUAL * 0002 = LESS-THAN * 0003 = LESS-THAN OR EQUAL * 0004 = GREATER-THAN * 0005 = GREATER-THAN OR EQUAL * 0006 = NOT EQUAL (LESS-THAN, GREATER-THAN) * * CALLING SEQUENCE: * * BL @ADDF * BL @SUBF * BL @MULF * BL @DIVF * * IN (R1) = OPERAND 1 * (R2) = OPERAND 2 * * OUT (R2) = RESULT * * * B @FUZF ;== * B @EQUF ;= * B @LTHF ;< * B @LEQF ;<= * B @GTHF ;> * B @GEQF ;>= * B @NEQUF ;<> * * IN (R1) = OPERAND 1 * (R2) = OPERAND 2 * * OUT (R2) = RESULT * EXITS TO EVOP3A * * B @UMNF ;- (UNARY MINUS) * * IN (R1) = OPERAND * * OUT (R2) = RESULT * EXISTS TO EVOP3A * * EXCEPTIONS AND CONDITIONS: * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS PAGE *ARITHMETIC PREPARATION * BL @PREP * VECTOR * BOTH INTEGERS * * IN R1 = SOURCE 1 * R2 = SOURCE 2 * * INT OUT R3 = S1 * R1 = S2 * PREP MOV *R1,@TEMP ;LOAD TEMP MOV @2(1),@TEMP2 MOV @4(1),@TEMP4 LOADF *R2 ;LOAD FPAC MOV *R1+,R3 ;INTEGER? JNE PREP4 ;N MOV *R2+,R3 ;INTEGER? JNE PREP4 ;N MOV *R1,R3 ;BOTH INTEGERS MOV *R2,R1 ;GET INTEGERS B @2(11) PAGE * ENTRY POINT: * DEF ADDF * ADDF MOV R11,R10 ;SAVE RETURN BL @PREP ;PREPARE OPEANDS DATA 2*>40+>2C20 A R3,R1 ;BOTH INTEGERS JNO PREP5A ;NO OVERFLOW PREP4 BLWP @FLTMZ ;FLOAT TEMP FLOATF 0 ;FLOAT FPAC X *R11 ;DO FP OPERATION DATA TEMP JMP PREP5B ;RETURN * PREP5 NEG R1 ;NEGATE RESULT * PREP5A MOV R1,@FPAC2 ;SAVE RESULT * PREP5B LI R2,FPAC ;GET ADDRESS OF RESULT B *R10 ;RETURN * FLTMZ DATA TEMP,FLOAT * * ENTRY POINT: * DEF SUBF * SUBF MOV R11,R10 ;SAVE RETURN BL @PREP DATA 3*>40+>2C20 S R3,R1 ;INTEGERS JNO PREP5A JMP PREP4 ;OVERFLOW PAGE *MULTIPLY * MULF MOV R11,R10 ;SAVE RETURN BL @PREP DATA 4*>40+>2C20 MOV R3,R3 ;R3<0? JLT MULF5 ;Y MOV R1,R1 ;R1<0? JLT MULF6 ;Y * MULF2 MPY R3,R1 ;R1,R2 = R3 X R1 MOV R1,R1 ;OVERFLOW? JNE PREP4 ;Y MOV R2,R1 ;OVERFLOW? JLT PREP4 ;Y JMP PREP5A ;N * MULF5 NEG R3 ;R3<0 MOV R1,R1 ;R1<0 JGT MULF7 ;N NEG R1 ;Y JMP MULF2 ;Y * MULF6 NEG R1 ;SIGNS DIFFERENT MULF7 MPY R3,R1 ;R1,R2 = R3 X R1 MOV R1,R1 ;OVERFLOW? JNE PREP4 ;Y MOV R2,R1 ;OVERFLOW? JLT PREP4 ;Y JMP PREP5 ;RETURN PAGE *DIVIDE * DIVF MOV R11,R10 ;SAVE RETURN BL @PREP DATA 5*>40+>2C20 MOV R3,R3 ;SOURCE<0? JLT DIVF5 ;Y JEQ ERR28 ;DIVISION BY ZERO MOV R1,R2 ;DESTINATION<0? JLT DIVF6 ;Y * DIVF2 CLR R1 ;POSITIVE RESULT DIV R3,R1 ;DIVIDE MOV R2,R2 ;REMAINDER? JNE PREP4 ;Y, FLOAT MOV R1,R1 ;OVERFLOW? JLT PREP4 ;Y, FLOAT JMP PREP5A ;N, STORE RESULTS * DIVF5 NEG R3 ;SOURCE<0 MOV R1,R2 ;DESTINATION<0? JGT DIVF7 ;N NEG R2 ;Y, POSITIVE RESULT JMP DIVF2 * DIVF6 NEG R2 ;SIGNS DIFFERENT DIVF7 CLR R1 DIV R3,R1 ;DIVIDE MOV R2,R2 ;REMAINDER? JNE PREP4 ;Y, OVERFLOW MOV R1,R1 ;OVERFLOW? JLT PREP4 ;Y JMP PREP5 ;RETURN * ERR28 DATA ERROR+28 ;DIVISION BY ZERO PAGE *RELATIONAL OPERATERS * FUZF EQU $ EQUF EQU $ LTHF EQU $ LEQF EQU $ GTHF EQU $ GEQF EQU $ NEQUF EQU $ MOV @EVATB->AA+EVPR(3),R4 BL @SUBF LI R3,4 ;GET MATCH CONSTANT MOV R4,R4 ;FUZZ? JNE EQUF1 ;N INC R4 ;Y, R4=0001 MOV *R2,R1 ;GET EXPONENT JEQ EQUF1 ;INTEGER ANDI R1,>7F00 ;ISOLATE CI R1,FUZZ ;LESS THAN FUZZ? JL EQUF2A ;Y, EQUAL JMP EQUF3 ;N, UNEQUAL, SET R3 TO -2 * EQUF1 MOV *R2+,R1 ;GET SIGN OF RESULT JNE EQUF2 MOV *R2,R1 EQUF2 JGT EQUF3 JNE $+4 EQUF2A DEC R3 DECT R3 * EQUF3 CLEAR 0 ;CLEAR FPAC COC R3,R4 ;CORRESPONDING BITS SET? JNE UMNF3 INC @FPAC2 ;RETURN 1 JMP UMNF3 PAGE *UNARY MINUS * UMNF LOADF *R1 ;LOAD FPAC MOV *R1,R1 ;INTEGER JEQ UMNF1 ;Y NEGATE 0 ;N, NEGATE FPAC JMP UMNF3 * UMNF1 NEG @FPAC2 * UMNF3 LI R2,FPAC ;RETURN UMNF4 B @EVOP3A B38 BYTE >38 B43 BYTE >43 B45 BYTE >45 B4A BYTE >4A B4C BYTE >4C BFF BYTE >FF EVEN END IDT 'EXPF' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * EXPF ;EXPONENTIAL FUNCTION * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * REF FUNFX ;FIXES ARGUMENT REF PLYX,PLYXX ;EVALUATE POLYNOMIALS REF FUNBK ;BREAK FP # REF GETP2 ;GET POWER OF 2 * 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 ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) ERROR2 EQU ERROR+>20 * * EXTERNAL DATA: * REF FPAC ;FLOATING POINT ACCUMULATOR REF TEMP ;3 WRD TEMPORARY STORAGE REF DS1 ;3 WRD TEMPORARY STORAGE REF DS ;3 WRD TEMPORARY STORAGE * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'EXPONENTIAL FUNCTION' PAGE * ABSTRACT: * * CALCULATE THE EXPONENTIAL VALUE OF * E RAISED TO (ARG) * * CALLING SEQUENCE: * * B @EXPF * * IN (R2) = ARG * OUT (R2) = E ^ ARG * * EXCEPTIONS AND CONDITIONS: * * ERROR 33 = EXP ARGUMENT TOO LARGE * FLOATING POINT ERRORS * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) PAGE * ENTRY POINT: * DEF EXPF * ERR33 DATA ERROR2,33 ;EXP ARG TOO LARGE * EXPF MOV R11,R10 BL @FUNFX ;FIX SIGN & FPAC JEQ EXPF2 ;EXP(0)=1 FMUL @EXPC0 ;F=F*LN 2 BL @FUNBK ;BREAK TO INTEGER AND FRACTION CI R1,>7D ;ARGUMENT TOO LARGE? JGT ERR33 ;Y, ERROR MOV R1,R2 ;N, SAVE FSUB @EXPC1 ;F=(F*LN 2)-C1 STORE @DS ;STORE IN DS BL @PLYXX ;EVALUATE DATA EXPC2 FMUL @DS ;* DS STORE @DS ;STORE IN DS AGAIN BL @PLYX ;EVALUATE DATA EXPC3 STORE @TEMP ;MOVE TO TEMP FSUB @DS ;-DS STORE @DS1 ;SAVE IN DS1 LOADF @TEMP ;MOVE TEMP TO FPAC FADD @DS ;ADD DS FDIV @DS1 ;/ DS1 FMUL @EXPC4 ;* C4 MOV R2,R1 ;FIX EXPONENT SRL R1,2 SWPB R1 A R1,@FPAC ;ADD TO EXPONENT MOV R3,R1 ANDI R2,>3 ;NEED POWER OF 2? JEQ EXPF1 ;N MOV R2,R3 BL @GETP2 ;MULTIPY BY POWER OF 2 * EXPF1 MOV R1,R1 ;NEGATIVE? JEQ EXPF3 ;N, RETURN STORE @TEMP ;Y, MOVE TO TEMP LOADF @FP1 ;GET INVERSE, LOAD FPAC FDIV @TEMP JMP EXPF3 ;DONE * EXPF2 LOADF @FP1 ;EXP(0)=1 * EXPF3 LI R2,FPAC B *R10 * EXPC0 DATA >4117,>1547,>652C 1.442695 LOG 2 (E) EXPC1 DATA >4080,>0000,>0000 1/2 EXPC2 DATA 2 DATA >423C,>9D67,>06A2 60.614853 DATA >4476,>4EF8,>C12A DATA >461F,>BE80,>58C1 EXPC3 DATA 3 FP1 DATA >4110,>0000,>0000 DATA >436D,>549A,>5FE1 DATA >4550,>02D2,>6DCF DATA >465B,>9820,>5C39 EXPC4 DATA >4116,>A09E,>667F 1.4142135 END IDT 'EXPF' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * EXPF ;EXPONENTIAL FUNCTION * * COPY: (NONE) * * MARCO: (NONE) * * EXTERNAL ROUTINES: * REF FUNFX ;FIXES ARGUMENT REF PLYX,PLYXX ;EVALUATE POLYNOMIALS REF FUNBK ;BREAK FP # REF GETP2 ;GET POWER OF 2 * 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 ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) ERROR2 EQU ERROR+>20 * * EXTERNAL DATA: * REF FPAC ;FLOATING POINT ACCUMULATOR REF TEMP ;3 WRD TEMPORARY STORAGE REF DS1 ;3 WRD TEMPORARY STORAGE REF DS ;3 WRD TEMPORARY STORAGE * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: (NONE) TITL 'EXPONENTIAL FUNCTION' PAGE * ABSTRACT: * * CALCULATE THE EXPONENTIAL VALUE OF * E RAISED TO (ARG) * * CALLING SEQUENCE: * * B @EXPF * * IN (R2) = ARG * OUT (R2) = E ^ ARG * * EXCEPTIONS AND CONDITIONS: * * ERROR 33 = EXP ARGUMENT TOO LARGE * FLOATING POINT ERRORS * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) PAGE * ENTRY POINT: * DEF EXPF * ERR33 DATA ERROR2,33 ;EXP ARG TOO LARGE * EXPF MOV R11,R10 BL @FUNFX ;FIX SIGN & FPAC JEQ EXPF2 ;EXP(0)=1 FMUL @EXPC0 ;F=F*LN 2 BL @FUNBK ;BREAK TO INTEGER AND FRACTION CI R1,>7D ;ARGUMENT TOO LARGE? JGT ERR33 ;Y, ERROR MOV R1,R2 ;N, SAVE FSUB @EXPC1 ;F=(F*LN 2)-C1 STORE @DS ;STORE IN DS BL @PLYXX ;EVALUATE DATA EXPC2 FMUL @DS ;* DS STORE @DS ;STORE IN DS AGAIN BL @PLYX ;EVALUATE DATA EXPC3 STORE @TEMP ;MOVE TO TEMP FSUB @DS ;-DS STORE @DS1 ;SAVE IN DS1 LOADF @TEMP ;MOVE TEMP TO FPAC FADD @DS ;ADD DS FDIV @DS1 ;/ DS1 FMUL @EXPC4 ;* C4 MOV R2,R1 ;FIX EXPONENT SRL R1,2 SWPB R1 A R1,@FPAC ;ADD TO EXPONENT MOV R3,R1 ANDI R2,>3 ;NEED POWER OF 2? JEQ EXPF1 ;N MOV R2,R3 BL @GETP2 ;MULTIPY BY POWER OF 2 * EXPF1 MOV R1,R1 ;NEGATIVE? JEQ EXPF3 ;N, RETURN STORE @TEMP ;Y, MOVE TO TEMP LOADF @FP1 ;GET INVERSE, LOAD FPAC FDIV @TEMP JMP EXPF3 ;DONE * EXPF2 LOADF @FP1 ;EXP(0)=1 * EXPF3 LI R2,FPAC B *R10 * EXPC0 DATA >4117,>1547,>652C 1.442695 LOG 2 (E) EXPC1 DATA >4080,>0000,>0000 1/2 EXPC2 DATA 2 DATA >423C,>9D67,>06A2 60.614853 DATA >4476,>4EF8,>C12A DATA >461F,>BE80,>58C1 EXPC3 DATA 3 FP1 DATA >4110,>0000,>0000 DATA >436D,>549A,>5FE1 DATA >4550,>02D2,>6DCF DATA >465B,>9820,>5C39 EXPC4 DATA >4116,>A09E,>667F 1.4142135 END IDT 'FIX' * * REVISION: 12/01/78 1.01 ;SOURCE STANDARDIZATION * 08/09/78 1.00 ;INITIAL RECEIPT BY TI * * ROUTINE LIST: * * FIX ;FIX 2'S COMPLEMENT INTEGER * PFIX ;FIX 16-BIT POSITIVE INTEGER * * COPY: (NONE) * * MACRO: (NONE) * * EXTERNAL ROUTINES: * DXOP LOADF,0 ;LOAD FPAC DXOP SCALE,6 ;SCALE FPAC DXOP CLEAR,8 ;CLEAR FPAC ERROR EQU >2F80 ;XOP XX,14 (ERROR CALL) * * EXTERNAL DATA: * REF FPAC,FPAC2 ;FLOATING POINT ACCUMULATOR * * MODULE EQUATES: (NONE) * * MODULE VARIABLES AND CONSTANTS: * TITL "FIX INTEGER" PAGE * ABSTRACT: * * FIX RETURNS THE 2'S COMPLEMENT 16-BIT INTEGER VALUE OF * THE 3 WORD NUMBER POINTED TO BY R2. IF THE NUMBER IS ALREADY * AN INTEGER (1ST WORD = 0 ) THEN IT SIMPLY RETURNS THE SECOND WORD. * IF THE VALUE IS A FLOATING POINT NUMBER (1ST WORD <> 0) THEN THE * NUMBER IS LOADED INTO THE FLOATING POINT ACCUMULATOR, SCALED SUCH THAT * THE DECIMAL POINT IS AFTER THE SECOND WORD, AD THEN THE RESULT OR * 2ND WORD OF FPAC IS RETURNED. CARE IS TAKE TO ZERO FPAC AND * TO NEGATE THE RESULT DEPENDING UPON THE SIGN BIT. * * PFIX RETURNS A 16-BIT RESULT RATHER THAN THE 2'S * COMPLEMENT VALUE. * * CALLING SEQUENCE: * * BL @FIX * OR * BL @PFIX * * IN - (R2) = 3 WORD PBASIC NUMBER. * OUT - R1 = RESULT. * * NORMAL EXIT - RETURN * * EXCEPTIONS AND CONDITIONS: * * ERROR 30 RESULTS IF THE ABSOLUTE VALUE OF THE NUMBER IS * GREATER THAN 2^15 * * R0 IS PRESERVED * * EXTERNAL ROUTINE LIST: * * (SEE EXTERNAL ROUTINES) * * LOCAL DATA: * * (SEE MODULE VARIABLES AND CONSTANTS) PAGE * ENTRY POINT: * DEF FIX * FIX MOV *R2+,R1 ;INTEGER? JNE FIX1 ;N, DO INTF MOV *R2,R1 ;Y, RETURN # RT * FIX1 LOADF @-2(2) ;LOAD FPAC * FIX2 MOV R1,R2 ;SAVE ANDI R1,>7F80 ;MASK TO EXPONENT + 1 BIT CI R1,>4400 ;TOO LARGE? JGT ERR30 ;Y SCALE @C4600 ;N, GET INTEGER MOV @FPAC2,R1 CLEAR 0 ;LEAVE FPAC ZERO SLA R2,1 ;NEGATIVE? JNC FIX3 ;N NEG R1 ;Y FIX3 RT * ERR30 DATA ERROR+30 ;FIX ERROR * * * ENTRY POINT: * DEF PFIX * PFIX LOADF *R2 ;LOAD FPAC MOV *R2,R1 ;INTEGER? JEQ PFIX1 ;Y SCALE @C4600 ;N, SCALE * PFIX1 MOV @FPAC2,R1 ;GET RESULT RT C4600 DATA >4600 END