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
/* */
/**********************************************************************/
/**********************************************************************/
/* 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
Enviar um comentário