Comando DIM ($B34B-$B3A1)No se bien porque comienza buscando una coma, y da SYNTAX ERROR si no esta la coma
- Pone un 1 en DIMFLG
- Pone la primera letra del nombre de la variable en VARNAM
- Coloca un supuesto 0 como segunda letra
- coloca tipo numérico en VALTYP=0
- Toma otra letra, esta puede ser numérica
- Lee mas caracteres, ignorándolos mientras sean Alfanuméricos
- Acepta un $ como definidor de string
- Busca "(" pero acepta variables solas
- Si es arreglo, evalúa una expresión numérica o da error
- Puede evaluar varias expresiones
Lo que veo mal de todo esto es que se debió ejecutar alguna rutina para buscar el nombre de una variable ya que esto obviamente es muy usado y eso no esta pasando.
Código: Seleccionar todo
2758 * DIM
2759 B34B BD B2 6D LB34B JSR LB26D SYNTAX CHECK FOR COMMA
2760 B34E C6 01 DIM LDB #1 DIMENSION FLAG
2761 B350 8D 08 BSR LB35A SAVE ARRAY SPACE FOR THIS VARIABLE
2762 B352 9D A5 JSR GETCCH GET CURRENT INPUT CHARACTER
2763 B354 26 F5 BNE LB34B KEEP DIMENSIONING IF NOT END OF LINE
2764 B356 39 RTS
Código: Seleccionar todo
2765 * EVALUATE A VARIABLE - RETURN X AND
2766 * VARPTR POINTING TO VARIABLE DESCRIPTOR
2767 * EACH VARIABLE REQUIRES 7 BYTES - THE FIRST TWO
2768 * BYTES ARE THE VARIABLE NAME AND THE NEXT 5
2769 * BYTES ARE THE DESCRIPTOR. IF BIT 7 OF THE
2770 * FIRST BYTE OF VARlABLE NAME IS SET, THE
2771 * VARIABLE IS A DEF FN VARIABLE. IF BIT 7 OF
2772 * THE SECOND BYTE OF VARIABLE NAME IS SET, THE
2773 * VARIABLE IS A STRING, OTHERWISE THE VARIABLE
2774 * IS NUMERIC.
2775 * IF THE VARIABLE IS NOT FOUND, A ZERO VARIABLE IS
2776 * INSERTED INTO THE VARIABLE SPACE
2777 B357 5F LB357 CLRB DIMENSION FLAG = 0; DO NOT SET UP AN ARRAY
2778 B358 9D A5 JSR GETCCH GET CURRENT INPUT CHARACTER
2779 B35A D7 05 LB35A STB DIMFLG SAVE ARRAY FLAG
2780 B35C 97 37 STA VARNAM SAVE INPUT CHARACTER
2781 * ENTRY POINT FOR DEF FN VARIABLE SEARCH
2782 B35E 9D A5 LB35C JSR GETCCH GET CURRENT INPUT CHARACTER
2783 B360 8D 40 BSR LB3A2 SET CARRY IF NOT ALPHA
2784 B362 10 25 FF 11 LBCS LB277 SYNTAX ERROR IF NOT ALPHA
2785 B366 5F CLRB DEFAULT 2ND VARIABLE CHARACTER TO ZERO
2786 B367 D7 06 STB VALTYP SET VARIABLE TYPE TO NUMERIC
2787 B369 9D 9F JSR GETNCH GET ANOTHER CHARACTER FROM BASIC
2788 B36B 25 04 BCS LB371 BRANCH IF NUMERIC (2ND CHARACTER IN
2789 * VARIABLE MAY BE NUMERIC)
2790 B36D 8D 33 BSR LB3A2 SET CARRY IF NOT ALPHA
2791 B36F 25 0A BCS LB37B BRANCH IF NOT ALPHA
2792 B371 1F 89 LB371 TFR A,B SAVE 2ND CHARACTER IN ACCB
2793 * READ INPUT CHARACTERS UNTIL A NON ALPHA OR
2794 * NON NUMERIC IS FOUND - IGNORE ALL CHARACTERS
2795 * IN VARIABLE NAME AFTER THE 1ST TWO
2796 B373 9D 9F LB373 JSR GETNCH GET AN INPUT CHARACTER
2797 B375 25 FC BCS LB373 BRANCH IF NUMERIC
2798 B377 8D 29 BSR LB3A2 SET CARRY IF NOT ALPHA
2799 B379 24 F8 BCC LB373 BRANCH IF ALPHA
2800 B37B 81 24 LB37B CMPA #'$ CHECK FOR A STRING VARIABLE
2801 B37D 26 06 BNE LB385 BRANCH IF IT IS NOT A STRING
2802 B37F 03 06 COM VALTYP SET VARIABLE TYPE TO STRING
2803 B381 CB 80 ADDB #$80 SET BIT 7 OF 2ND CHARACTER (STRING)
2804 B383 9D 9F JSR GETNCH GET AN INPUT CHARACTER
2805 B385 D7 38 LB385 STB VARNAM+1 SAVE 2ND CHARACTER IN VARNAM+1
2806 B387 9A 08 ORA ARYDIS OR IN THE ARRAY DISABLE FLAG - IF = $80,
2807 * DON’T SEARCH FOR VARIABLES IN THE ARRAYS
2808 B389 80 28 SUBA #'( IS THIS AN ARRAY VARIABLE?
2809 > B38B 10 27 00 75 LBEQ LB404 BRANCH IF IT IS
2810 B38F 0F 08 CLR ARYDIS RESET THE ARRAY DISABLE FLAG
2811 B391 9E 1B LDX VARTAB POINT X TO THE START OF VARIABLES
2812 B393 DC 37 LDD VARNAM GET VARIABLE IN QUESTION
2813 B395 9C 1D LB395 CMPX ARYTAB COMPARE X TO THE END OF VARIABLES
2814 B397 27 12 BEQ LB3AB BRANCH IF END OF VARIABLES
2815 B399 10 A3 81 CMPD ,X++ * COMPARE VARIABLE IN QUESTION TO CURRENT
2816 B39C 27 3E BEQ LB3DC * VARIABLE AND BRANCH IF MATCH
2817 B39E 30 05 LEAX 5,X = MOVE POINTER TO NEXT VARIABLE AND
2818 B3A0 20 F3 BRA LB395 = KEEP LOOKING
IS_MAYUSEsta pequeña rutina enciende el acarreo si el byte en ACCA no es una letra mayúscula.
ENTRADAS: ACCA
SALIDAS: Acarreo si no es mayúsculas
En B3A8 no se porque usa SUBA -('Z+1), en lugar de ADDA 'Z+1 , esta restando un negativo (complementario) pero podría hacer usado una suma para reponer el valor. También se podía haber usado CMPA.
Código: Seleccionar todo
2819
2820 * SET CARRY IF NOT UPPER CASE ALPHA
2821 B3A2 81 41 LB3A2 CMPA #'A * CARRY SET IF < ‘A’
2822 B3A4 25 04 BCS LB3AA *
2823 B3A6 80 5B SUBA #'Z+1 =
2824 B3A8 80 A5 SUBA #-('Z+1) = CARRY CLEAR IF <= 'Z'
2825 B3AA 39 LB3AA RTS
Código: Seleccionar todo
2826 * PUT A NEW VARIABLE IN TABLE OF VARIABLES
2827 B3AB 8E 00 8A LB3AB LDX #ZERO POINT X TO ZERO LOCATION
2828 B3AE EE E4 LDU ,S GET CURRENT RETURN ADDRESS
2829 B3B0 11 83 B2 87 CMPU #LB287 DID WE COME FROM ‘EVALUATE ALPHA EXPR’?
2830 B3B4 27 28 BEQ LB3DE YES - RETURN A ZERO VALUE
2831 B3B6 DC 1F LDD ARYEND * GET END OF ARRAYS ADDRESS AND
2832 B3B8 DD 43 STD V43 * SAVE IT AT V43
2833 B3BA C3 00 07 ADDD #7 = ADD 7 TO END OF ARRAYS (EACH
2834 B3BD DD 41 STD V41 = VARIABLE = 7 BYTES) AND SAVE AT V41
2835 B3BF 9E 1D LDX ARYTAB * GET END OF VARIABLES AND SAVE AT V47
2836 B3C1 9F 47 STX V47 *
2837 B3C3 BD AC 1E JSR LAC1E MAKE A SEVEN BYTE SLOT FOR NEW VARIABLE AT
2838 * TOP OF VARIABLES
2839 B3C6 9E 41 LDX V41 = GET NEW END OF ARRAYS AND SAVE IT
2840 B3C8 9F 1F STX ARYEND =
2841 B3CA 9E 45 LDX V45 * GET NEW END OF VARIABLES AND SAVE IT
2842 B3CC 9F 1D STX ARYTAB *
2843 B3CE 9E 47 LDX V47 GET OLD END OF VARIABLES
2844 B3D0 DC 37 LDD VARNAM GET NEW VARIABLE NAME
2845 B3D2 ED 81 STD ,X++ SAVE VARIABLE NAME
2846 B3D4 4F CLRA * ZERO OUT THE FP VALUE OF THE NUMERIC
2847 B3D5 5F CLRB * VARIABLE OR THE LENGTH AND ADDRESS
2848 B3D6 ED 84 STD ,X * OF A STRING VARIABLE
2849 B3D8 ED 02 STD 2,X *
2850 B3DA A7 04 STA 4,X *
2851 B3DC 9F 39 LB3DC STX VARPTR STORE ADDRESS OF VARIABLE VALUE
2852 B3DE 39 LB3DE RTS
2853 *
2854 B3DF 90 80 00 00 00 LB3DF FCB $90,$80,$00,$00,$00 * FLOATING POINT -32768
2855 * SMALLEST SIGNED TWO BYTE INTEGER
2856 *
2857 B3E4 9D 9F LB3E4 JSR GETNCH GET AN INPUT CHARACTER FROM BASIC
2858 B3E6 BD B1 41 LB3E6 JSR LB141 GO EVALUATE NUMERIC EXPRESSION
2859 B3E9 96 54 LB3E9 LDA FP0SGN GET FPA0 MANTISSA SIGN
2860 B3EB 2B 5D BMI LB44A ‘FC’ ERROR IF NEGATIVE NUMBER
2861
2862 * CONVERT FPA0 TO A SIGNED TWO BYTE INTEGER; RETURN VALUE IN ACCD
2863 B3ED BD B1 43 INTCNV JSR LB143 ‘TM’ ERROR IF STRING VARIABLE
2864 B3F0 96 4F LDA FP0EXP GET FPA0 EXPONENT
2865 B3F2 81 90 CMPA #$90 * COMPARE TO 32768 - LARGEST INTEGER EXPONENT AND
2866 B3F4 25 08 BCS LB3FE * BRANCH IF FPA0 < 32768
2867 B3F6 8E B3 DF LDX #LB3DF POINT X TO FP VALUE OF -32768
2868 B3F9 BD BC 96 JSR LBC96 COMPARE -32768 TO FPA0
2869 B3FC 26 4C BNE LB44A ‘FC’ ERROR IF NOT =
2870 B3FE BD BC C8 LB3FE JSR LBCC8 CONVERT FPA0 TO A TWO BYTE INTEGER
2871 B401 DC 52 LDD FPA0+2 GET THE INTEGER
2872 B403 39 RTS
2873 * EVALUATE AN ARRAY VARIABLE
2874 B404 DC 05 LB404 LDD DIMFLG GET ARRAY FLAG AND VARIABLE TYPE
2875 B406 34 06 PSHS B,A SAVE THEM ON STACK
2876 B408 12 NOP DEAD SPACE CAUSED BY 1.2 REVISION
2877 B409 5F CLRB RESET DIMENSION COUNTER
2878 B40A 9E 37 LB40A LDX VARNAM GET VARIABLE NAME
2879 B40C 34 14 PSHS X,B SAVE VARIABLE NAME AND DIMENSION COUNTER
2880 B40E 8D D4 BSR LB3E4 EVALUATE EXPRESSION (DIMENSlON LENGTH)
2881 B410 35 34 PULS B,X,Y PULL OFF VARIABLE NAME, DIMENSlON COUNTER,
2882 * ARRAY FLAG
2883 B412 9F 37 STX VARNAM SAVE VARIABLE NAME AND VARIABLE TYPE
2884 B414 DE 52 LDU FPA0+2 GET DIMENSION LENGTH
2885 B416 34 60 PSHS U,Y SAVE DIMENSION LENGTH, ARRAY FLAG, VARIABLE TYPE
2886 B418 5C INCB INCREASE DIMENSION COUNTER
2887 B419 9D A5 JSR GETCCH GET CURRENT INPUT CHARACTER
2888 B41B 81 2C CMPA #', CHECK FOR ANOTHER DIMENSION
2889 B41D 27 EB BEQ LB40A BRANCH IF MORE
2890 B41F D7 03 STB TMPLOC SAVE DIMENSION COUNTER
2891 B421 BD B2 67 JSR LB267 SYNTAX CHECK FOR A ‘)‘
2892 B424 35 06 PULS A,B * RESTORE VARIABLE TYPE AND ARRAY
2893 B426 DD 05 STD DIMFLG * FLAG - LEAVE DIMENSION LENGTH ON STACK
2894 B428 9E 1D LDX ARYTAB GET START OF ARRAYS
2895 B42A 9C 1F LB42A CMPX ARYEND COMPARE TO END OF ARRAYS
2896 B42C 27 21 BEQ LB44F BRANCH IF NO MATCH FOUND
2897 B42E DC 37 LDD VARNAM GET VARIABLE IN QUESTION
2898 B430 10 A3 84 CMPD ,X COMPARE TO CURRENT VARIABLE
2899 B433 27 06 BEQ LB43B BRANCH IF =
2900 B435 EC 02 LDD 2,X GET OFFSET TO NEXT ARRAY VARIABLE
2901 B437 30 8B LEAX D,X ADD TO CURRENT POINTER
2902 B439 20 EF BRA LB42A KEEP SEARCHING
2903 B43B C6 12 LB43B LDB #2*9 ‘REDIMENSIONED ARRAY’ ERROR
2904 B43D 96 05 LDA DIMFLG * TEST ARRAY FLAG - IF <>0 YOU ARE TRYING
2905 B43F 26 0B BNE LB44C * TO REDIMENSION AN ARRAY
2906 B441 D6 03 LDB TMPLOC GET NUMBER OF DIMENSIONS IN ARRAY
2907 B443 E1 04 CMPB 4,X COMPARE TO THIS ARRAYS DIMENSIONS
2908 B445 27 59 BEQ LB4A0 BRANCH IF =
2909 B447 C6 10 LB447 LDB #8*2 ‘BAD SUBSCRIPT’
2910 B449 8C FCB SKP2 SKIP TWO BYTES
2911 B44A C6 08 LB44A LDB #4*2 ‘ILLEGAL FUNCTION CALL’
2912 B44C 7E AC 46 LB44C JMP LAC46 JUMP TO ERROR SERVICING ROUTINE
2913
2914 * INSERT A NEW ARRAY INTO ARRAY VARIABLES
2915 * EACH SET OF ARRAY VARIABLES IS PRECEEDED BY A DE-
2916 * SCRIPTOR BLOCK COMPOSED OF 5+2*N BYTES WHERE N IS THE
2917 * NUMBER OF DIMENSIONS IN THE ARRAY. THE BLOCK IS DEFINED
2918 * AS FOLLOWS: BYTES 0,1:VARIABLE’S NAME; 2,3:TOTAL LENGTH
2919 * OF ARRAY ITEMS AND DESCRIPTOR BLOCK; 4:NUMBER OF DIMEN-
2920 * ISIONS; 5,6:LENGTH OF DIMENSION 1; 7,8:LENGTH OF DIMEN-
2921 * SION 2;… 4+N,5+N:LENGTH OF DIMENSION N.
2922
2923 B44F CC 00 05 LB44F LDD #5 * 5 BYTES/ARRAY ENTRY SAVE AT COEFPT
2924 B452 DD 64 STD COEFPT *
2925 B454 DC 37 LDD VARNAM = GET NAME OF ARRAY AND SAVE IN
2926 B456 ED 84 STD ,X = FIRST 2 BYTES OF DESCRIPTOR
2927 B458 D6 03 LDB TMPLOC GET NUMBER OF DIMENSIONS AND SAVE IN
2928 B45A E7 04 STB 4,X * 5TH BYTE OF DESCRIPTOR
2929 B45C BD AC 33 JSR LAC33 CHECK FOR ROOM FOR DESCRIPTOR IN FREE RAM
2930 B45F 9F 41 STX V41 TEMPORARILY SAVE DESCRIPTOR ADDRESS
2931 B461 C6 0B LB461 LDB #11 * DEFAULT DIMENSION VALUE:X(10)
2932 B463 4F CLRA *
2933 B464 0D 05 TST DIMFLG = CHECK ARRAY FLAG AND BRANCH IF
2934 B466 27 05 BEQ LB46D = NOT DIMENSIONING AN ARRAY
2935 B468 35 06 PULS A,B GET DIMENSION LENGTH
2936 B46A C3 00 01 ADDD #1 ADD ONE (X(0) HAS A LENGTH OF ONE)
2937 B46D ED 05 LB46D STD 5,X SAVE LENGTH OF ARRAY DIMENSION
2938 B46F 8D 5D BSR LB4CE MULTIPLY ACCUM ARRAY SIZE NUMBER LENGTH
2939 * OF NEW DIMENSION
2940 B471 DD 64 STD COEFPT TEMP STORE NEW CURRENT ACCUMULATED ARRAY SIZE
2941 B473 30 02 LEAX 2,X BUMP POINTER UP TWO
2942 B475 0A 03 DEC TMPLOC * DECREMENT DIMENSION COUNTER AND BRANCH IF
2943 B477 26 E8 BNE LB461 * NOT DONE WITH ALL DIMENSIONS
2944 B479 9F 0F STX TEMPTR SAVE ADDRESS OF (END OF ARRAY DESCRIPTOR - 5)
2945 B47B D3 0F ADDD TEMPTR ADD TOTAL SIZE OF NEW ARRAY
2946 B47D 10 25 F7 C3 LBCS LAC44 ‘OM’ ERROR IF > $FFFF
2947 B481 1F 01 TFR D,X SAVE END OF ARRAY IN X
2948 B483 BD AC 37 JSR LAC37 MAKE SURE THERE IS ENOUGH FREE RAM FOR ARRAY
2949 B486 83 00 35 SUBD #STKBUF-5 SUBTRACT OUT THE (STACK BUFFER - 5)
2950 B489 DD 1F STD ARYEND SAVE NEW END OF ARRAYS
2951 B48B 4F CLRA ZERO = TERMINATOR BYTE
2952 B48C 30 1F LB48C LEAX -1,X * STORE TWO TERMINATOR BYTES AT
2953 B48E A7 05 STA 5,X * THE END OF THE ARRAY DESCRIPTOR
2954 B490 9C 0F CMPX TEMPTR *
2955 B492 26 F8 BNE LB48C *
2956 B494 9E 41 LDX V41 GET ADDRESS OF START OF DESCRIPTOR
2957 B496 96 1F LDA ARYEND GET MSB OF END OF ARRAYS; LSB ALREADY THERE
2958 B498 93 41 SUBD V41 SUBTRACT OUT ADDRESS OF START OF DESCRIPTOR
2959 B49A ED 02 STD 2,X SAVE LENGTH OF (ARRAY AND DESCRIPTOR)
2960 B49C 96 05 LDA DIMFLG * GET ARRAY FLAG AND BRANCH
2961 B49E 26 2D BNE LB4CD * BACK IF DIMENSIONING
2962 * CALCULATE POINTER TO CORRECT ELEMENT
2963 B4A0 E6 04 LB4A0 LDB 4,X GET THE NUMBER OF DIMENSIONS
2964 B4A2 D7 03 STB TMPLOC TEMPORARILY SAVE
2965 B4A4 4F CLRA * INITIALIZE POINTER
2966 B4A5 5F CLRB * TO ZERO
2967 B4A6 DD 64 LB4A6 STD COEFPT SAVE ACCUMULATED POINTER
2968 B4A8 35 06 PULS A,B * PULL DIMENSION ARGUMENT OFF THE
2969 B4AA DD 52 STD FPA0+2 * STACK AND SAVE IT
2970 B4AC 10 A3 05 CMPD 5,X COMPARE TO STORED ‘DIM’ ARGUMENT
2971 B4AF 24 3A BCC LB4EB ‘BS’ ERROR IF > = "DIM" ARGUMENT
2972 B4B1 DE 64 LDU COEFPT * GET ACCUMULATED POINTER AND
2973 B4B3 27 04 BEQ LB4B9 * BRANCH IF 1ST DIMENSION
2974 B4B5 8D 17 BSR LB4CE = MULTIPLY ACCUMULATED POINTER AND DIMENSION
2975 B4B7 D3 52 ADDD FPA0+2 = LENGTH AND ADD TO CURRENT ARGUMENT
2976 B4B9 30 02 LB4B9 LEAX 2,X MOVE POINTER TO NEXT DIMENSION
2977 B4BB 0A 03 DEC TMPLOC * DECREMENT DIMENSION COUNTER AND
2978 B4BD 26 E7 BNE LB4A6 * BRANCH IF ANY DIMENSIONS LEFT
2979 * MULTIPLY ACCD BY 5 - 5 BYTES/ARRAY VALUE
2980 B4BF ED E3 STD ,--S
2981 B4C1 58 ASLB
2982 B4C2 49 ROLA TIMES 2
2983 B4C3 58 ASLB
2984 B4C4 49 ROLA TIMES 4
2985 B4C5 E3 E1 ADDD ,S++ TIMES 5
2986 B4C7 30 8B LEAX D,X ADD OFFSET TO START OF ARRAY
2987 B4C9 30 05 LEAX 5,X ADJUST POINTER FOR SIZE OF DESCRIPTOR
2988 B4CB 9F 39 STX VARPTR SAVE POINTER TO ARRAY VALUE
2989 B4CD 39 LB4CD RTS
2990 * MULTIPLY 2 BYTE NUMBER IN 5,X BY THE 2 BYTE NUMBER
2991 IN COEFPT. RETURN RESULT IN ACCD, BS ERROR IF > $FFFF
2992 B4CE 86 10 LB4CE LDA #16 16 SHIFTS TO DO A MULTIPLY
2993 B4D0 97 45 STA V45 SHIFT COUNTER
2994 B4D2 EC 05 LDD 5,X * GET SIZE OF DIMENSION
2995 B4D4 DD 17 STD BOTSTK * AND SAVE IT
2996 B4D6 4F CLRA * ZERO
2997 B4D7 5F CLRB * ACCD
2998 B4D8 58 LB4D8 ASLB = SHIFT ACCB LEFT
2999 B4D9 49 ROLA = ONE BIT
3000 B4DA 25 0F BCS LB4EB 'BS' ERROR IF CARRY
3001 B4DC 08 65 ASL COEFPT+1 * SHIFT MULTIPLICAND LEFT ONE
3002 B4DE 09 64 ROL COEFPT * BIT - ADD MULTIPLIER TO ACCUMULATOR
3003 B4E0 24 04 BCC LB4E6 * IF CARRY <> 0
3004 B4E2 D3 17 ADDD BOTSTK ADD MULTIPLIER TO ACCD
3005 B4E4 25 05 BCS LB4EB 'BS' ERROR IF CARRY (>$FFFF)
3006 B4E6 0A 45 LB4E6 DEC V45 * DECREMENT SHIFT COUNTER
3007 B4E8 26 EE BNE LB4D8 * IF NOT DONE
3008 B4EA 39 RTS
3009 B4EB 7E B4 47 LB4EB JMP LB447 'BS' ERROR