CC

 /*REXX*/
/**********************************************************************/
/*  CALCULADORA                                            MARCO SERRA*/
/*  TSO CC 4*3+3*5        ( = 27 )                                    */
/**********************************************************************/
 ARG NUMEXP
 "ISPEXEC CONTROL ERRORS RETURN"
   DBG = 'N'
   IF DBG = 'S' THEN SAY 'COMEÇOU O FESTIVAL'
   NUMEXP = STRIP(NUMEXP)
   FC=SUBSTR(NUMEXP,1,1)
   IF FC = '#' THEN NUMEXP = SUBSTR(NUMEXP,2,)
/*                                                                    */
CALCULADORA:
   CALL VALIDA
   IF DBG= 'S' THEN SAY 'N: 'N' TL: 'TL
   INTR = NUMEXP
   IF NUMEXP <> "" THEN
   DO
      IF DBG = 'S' THEN
         SAY '1 INTR 'INTR' = NUMEXP 'NUMEXP
      INTERPRET 'RESULTADO = ' NUMEXP
      IF DATATYPE(RESULTADO, NUMBER) <> 1 THEN
      DO
         RESULTADO = 'ERRO!'
      END
      IF DBG = 'S' THEN
         SAY '2 'INTR' = 'RESULTADO
      ZEDSMSG = 'RES.: ' RESULTADO
      ZEDLMSG = ' 'INTR' = ' RESULTADO
      "ISPEXEC SETMSG MSG(ISRZ001)"
      IF DBG = 'S' THEN
         SAY '3 INTR 'INTR' = RESULT 'RESULTADO
   END
   IF DBG = 'S' THEN SAY 'VAI SAIR'
 IF FC = '#' THEN
 DO
   RESULTC = INTR' = 'RESULTADO
   RETURN RESULTC
 END
 ELSE
   RETURN
/*                                                                */
/*--------------------------------------------------------------*-*/
VALIDA:
/*--------------------------------------------------------------*-*/
    NUMEXP = STRIP(NUMEXP)
    LEX = LENGTH(NUMEXP)
    IF LEX > 2 THEN
    DO
       PX = POS(' ', NUMEXP)
       DO WHILE PX > 0
          PARSE VALUE NUMEXP WITH PARI ' ' PARF
          NUMEXP = PARI''PARF
          IF DBG = 'S' THEN SAY 'NUMEXP: >'NUMEXP'<'
          PX = POS(' ', NUMEXP)
       END
    END
    TL = LENGTH(NUMEXP)
    IF DBG = 'S' THEN SAY 'TL: ' TL
    PARE = 0
    IF DBG = 'S' THEN SAY 'VAI ENTRAR NO LOOP'
    DTA = ""
    DT  = 0
    DO N = 1 TO TL
       CH = SUBSTR(NUMEXP, N, 1)
       DT = DATATYPE(CH, NUMBER)
       IF DBG = 'S' THEN
          SAY 'N: 'N' DTA: 'DTA' CHA: 'CHA' DT: 'DT' CH: 'CH
       CALL LOOPVAL
       DTA = DT
       CHA = CH
       IF DBG = 'S' THEN SAY 'NEXT'
       IF DBG = 'S' THEN SAY 'LINHA FINAL DO LOOP. N: 'N' TL: 'TL
    END
    IF DBG = 'S' THEN SAY 'SAIU DO LOOP'
/*                                                                  */
    IF PARE > 0 THEN
    DO
       RESULTADO = '!PAR ESQ S\DTO'
       IF DBG = 'S' THEN
          SAY ' 'INTR' = 'RESULTADO
       ZEDSMSG = 'RES.: ' RESULTADO
       ZEDLMSG = ' 'INTR' = ' RESULTADO
       "ISPEXEC SETMSG MSG(ISRZ001)"
       EXIT
    END
/*                                                                    */
    FG.1  = POS('%%',NUMEXP)
    FG.2  = POS('()',NUMEXP)
    FG.3  = POS(')(',NUMEXP)
    FG.4  = POS('-*',NUMEXP)
    FG.5  = POS('-/',NUMEXP)
    FG.6  = POS('+*',NUMEXP)
    FG.7  = POS('+/',NUMEXP)
    FG.8  = POS('..',NUMEXP)
    FG.9  = POS('.(',NUMEXP)
    FG.10 = POS('.)',NUMEXP)
    FG.11 = POS('.*',NUMEXP)
    FG.12 = POS('./',NUMEXP)
    FG.13 = POS('.-',NUMEXP)
    FG.14 = POS('.+',NUMEXP)
    FG.14 = POS('.%',NUMEXP)
    FG.15 = POS(').',NUMEXP)
    FG.16 = POS('. ',NUMEXP)
    DO TG = 1 TO 16
       IF FG.TG > 0 THEN
       DO
          RESULTADO = '!SQALFA 'TG': 'FG.TG
          IF DBG = 'S' THEN
             SAY ' 'INTR' = 'RESULTADO
          ZEDSMSG = 'RES.: ' RESULTADO
          ZEDLMSG = ' 'INTR' = ' RESULTADO
          "ISPEXEC SETMSG MSG(ISRZ001)"
          EXIT
       END
    END
    DO TG = 1 TO LEX
    END
/**/
 RETURN
/*                                                                  */
/*----------------------------------------------------------------*-*/
LOOPVAL:
/*--------------------------------------------------------------*-*/
    IF DT <> 1 THEN
    DO
       IF DBG = 'S' THEN
          SAY ' DT <> 1: ' DT':'CA
       CALL VALALFA
       CALL VALPARE
       CALL VALSEQA
    END
    IF N > 1 & DT = 1 & DTA <> 1 THEN
    DO
       CALL VALSEQN
    END
/**/
 RETURN
/*                                                                    */
/*--------------------------------------------------------------------*/
VALALFA:
/*--------------------------------------------------------------------*/
    IF CH <> ' ' & CH <> '+' & CH <> '-'& CH <> '*' THEN
    IF CH <> '/' & CH <> '%' & CH <> '='& CH <> ' ' THEN
    IF CH <> '(' & CH <> ')' THEN
    IF CH <> '.' & CH <> ' '& CH <> ' ' THEN
    DO
       INTR = NUMEXP
       RESULTADO = '!NAO NUMER.'
       IF DBG = 'S' THEN
          SAY ' 'INTR' = 'RESULTADO
       ZEDSMSG = 'RES.: ' RESULTADO
       ZEDLMSG = ' 'INTR' = ' RESULTADO
       "ISPEXEC SETMSG MSG(ISRZ001)"
       EXIT
    END
/**/
 RETURN
/*                                                                    */
/*--------------------------------------------------------------------*/
VALPARE:
/*--------------------------------------------------------------------*/
    IF CH = '(' THEN
    DO
       PARE = PARE + 1
    END
    IF CH = ')' THEN
    DO
       IF PARE = 0 THEN
       DO
          RESULTADO = '!PAR DTQ S\ESQ'
          IF DBG = 'S' THEN
             SAY ' 'INTR' = 'RESULTADO
          ZEDSMSG = 'RES.: ' RESULTADO
          ZEDLMSG = ' 'INTR' = ' RESULTADO
          "ISPEXEC SETMSG MSG(ISRZ001)"
          EXIT
       END
       ELSE PARE = PARE - 1
    END
/**/
 RETURN
/*                                                                    */
/*--------------------------------------------------------------------*/
VALSEQA:
/*--------------------------------------------------------------------*/
    IF CH <> CHA THEN
    DO
       IF DBG = 'S' THEN
          SAY 'CH: 'CH' <> CHA: 'CHA
       IF DTA <> 1 THEN
       DO
          CALL VALSQAOPR
          CALL VALSQACHR
       END
       IF DBG = 'S' THEN
          SAY ' DTA: 'DTA' CHA: 'CHA' DT: 'DT' CH: 'CH
       IF DTA = 1 THEN
       DO
          IF CH = '(' then
          DO
             INTR = NUMEXP
             RESULTADO = '!SEQ INV!'
             IF DBG = 'S' THEN
                SAY ' 'INTR' = 'RESULTADO
             RESULTADO = RESULTADO''DTA DT CHA CH
             ZEDSMSG = 'RES.: ' RESULTADO
             ZEDLMSG = ' 'INTR' = ' RESULTADO
             "ISPEXEC SETMSG MSG(ISRZ001)"
             EXIT
          END
       END
    END
/**/
 RETURN
/*                                                                    */
/*--------------------------------------------------------------------*/
VALSQAOPR:
/*--------------------------------------------------------------------*/
    IF CHA = '+' | CHA = '/' | CHA = '-' | CHA = '*' THEN
    DO
       IF CH <> '+' & CH <> '-' & CH <> '/' & CH <> '.' THEN
       IF CH <> '(' & CH <> ' ' & CH <> ' ' THEN
       DO
          INTR = NUMEXP
          RESULTADO = '!SEQ OPR INV!'
          IF DBG = 'S' THEN
             SAY ' 'INTR' = 'RESULTADO
          RESULTADO = RESULTADO''DTA DT CHA CH
          ZEDSMSG = 'RES.: ' RESULTADO
          ZEDLMSG = ' 'INTR' = ' RESULTADO
          "ISPEXEC SETMSG MSG(ISRZ001)"
          EXIT
       END
       IF CH = '/' & CHA <> '/' THEN
       IF CHA <> ')' & CHA <> ' ' & CHA <> ' ' THEN
       DO
          INTR = NUMEXP
          RESULTADO = '!SEQ OPR/INV!'
          IF DBG = 'S' THEN
             SAY ' 'INTR' = 'RESULTADO
          RESULTADO = RESULTADO''DTA DT CHA CH
          ZEDSMSG = 'RES.: ' RESULTADO
          ZEDLMSG = ' 'INTR' = ' RESULTADO
          "ISPEXEC SETMSG MSG(ISRZ001)"
          EXIT
       END
    END
/**/
 RETURN
/*                                                                    */
/*--------------------------------------------------------------------*/
VALSQACHR:
/*--------------------------------------------------------------------*/
    IF CHA <> ')' & CHA <> ' ' & CH <> '(' THEN
    IF CH  <> '.' & CH  <> ' ' THEN
    DO
       INTR = NUMEXP
       RESULTADO = '!SEQ CHR INV!'
       IF DBG = 'S' THEN
          SAY ' 'INTR' = 'RESULTADO
       RESULTADO = RESULTADO''DTA DT CHA CH
       ZEDSMSG = 'RES.: ' RESULTADO
       ZEDLMSG = ' 'INTR' = ' RESULTADO
       "ISPEXEC SETMSG MSG(ISRZ001)"
       EXIT
    END
/**/
 RETURN
/*                                                                    */
/*--------------------------------------------------------------------*/
VALSEQN:
/*--------------------------------------------------------------------*/
    IF CHA <> '+' & CHA <> '-' & CHA <> '*' & CHA <> '/' THEN
    IF CHA <> '(' & CHA <> '.' & CHA <> '=' & CHA <> ' ' THEN
    DO
       INTR = NUMEXP
       RESULTADO = '!SEQ NUM INV!'
       IF DBG = 'S' THEN
          SAY ' 'INTR' = 'RESULTADO
       RESULTADO = RESULTADO''DTA DT CHA CH
       ZEDSMSG = 'RES.: ' RESULTADO
       ZEDLMSG = ' 'INTR' = ' RESULTADO
       "ISPEXEC SETMSG MSG(ISRZ001)"
       EXIT
    END
/**/
 RETURN
/*                                                                    */
/**********************************************************************/

Comentários

Mensagens populares deste blogue

ED

Z#SQLCOD