1117 lines
38 KiB
COBOL
1117 lines
38 KiB
COBOL
|
||
*
|
||
* Copyright (C) 2003, Hudson Reis,
|
||
* Infocont Sistemas Integrados Ltda.
|
||
* Carlucio Lopes
|
||
*
|
||
*
|
||
* This program is free software; you can redistribute it and/or
|
||
* modify it under the terms of the GNU General Public License as
|
||
* published by the Free Software Foundation; either version 2,
|
||
* or (at your option) any later version.
|
||
*
|
||
* This program is distributed in the hope that it will be useful,
|
||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
* GNU General Public License for more details.
|
||
*
|
||
* You should have received a copy of the GNU General Public
|
||
* License along with this software; see the file COPYING.
|
||
* If not, write to the Free Software Foundation, Inc., 59 Temple
|
||
* Place, Suite 330, Boston, MA 02111-1307 USA
|
||
*
|
||
identification division.
|
||
program-id. mbparser.
|
||
author. Carlucio Lopes.
|
||
date-written. 03/09/2003.
|
||
*
|
||
* Parser para dialeto MB COBOL.
|
||
*
|
||
environment division.
|
||
configuration section.
|
||
input-output section.
|
||
file-control.
|
||
select arquivo-entrada assign to disk
|
||
organization is line sequential
|
||
access mode is sequential
|
||
file status is ws77-file-status.
|
||
|
||
select arquivo-saida assign to disk
|
||
organization is line sequential
|
||
access mode is sequential
|
||
file status is ws77-file-status.
|
||
|
||
data division.
|
||
file section.
|
||
fd arquivo-entrada
|
||
value of file-id is ws77-arquivo-entrada.
|
||
01 reg-arquivo-entrada pic x(256).
|
||
|
||
fd arquivo-saida
|
||
value of file-id is ws77-arquivo-saida.
|
||
01 reg-arquivo-saida pic x(256).
|
||
|
||
working-storage section.
|
||
* Teste de file status.
|
||
77 ws77-file-status pic x(002) value spaces.
|
||
88 ws88-ok values are "00" "02" "04".
|
||
88 ws88-diretorio-inexistente value "05".
|
||
88 ws88-fim-arquivo value "10".
|
||
88 ws88-inexiste-registro value "22".
|
||
88 ws88-disco-cheio value "24".
|
||
88 ws88-arquivo-inexistente value "35".
|
||
88 ws88-layout-diferente value "39".
|
||
88 ws88-arquivo-ja-aberto value "41".
|
||
88 ws88-arquivo-nao-aberto values are "42" "47".
|
||
88 ws88-arquivo-bloqueado value "9A".
|
||
88 ws88-registro-bloqueado value "9D".
|
||
88 ws88-indice-corrompido values are "9$" "9)" "9(".
|
||
* Linhas usadas para parsing do fonte.
|
||
77 ws77-linha-para-parsing pic x(256) value spaces.
|
||
77 ws77-linha-temporaria pic x(256) value spaces.
|
||
77 ws77-buffer-temporario pic x(256) value spaces.
|
||
77 ws77-troca pic 9(03) value zeros.
|
||
77 ws77-troca2 pic 9(03) value zeros.
|
||
77 ws77-linpos pic x(37)
|
||
value " LINE POSITION ".
|
||
|
||
01 ws50troca redefines ws77-linha-para-parsing.
|
||
02 ws50trocando occurs 256 times pic x.
|
||
|
||
01 ws50linpos redefines ws77-linpos.
|
||
02 ws50lineposi occurs 37 times pic x.
|
||
|
||
|
||
* Vari<72>veis que ser<65>o usadas para quebrar a frase
|
||
* passada na linha de comando, pelo usu<73>rio.
|
||
* O n<>mero m<>ximo argumentos supotados <20> 8.
|
||
01 ws01-args.
|
||
02 ws02-arg-a pic x(256) value spaces.
|
||
02 ws02-arg-b pic x(256) value spaces.
|
||
02 ws02-arg-c pic x(256) value spaces.
|
||
02 ws02-arg-d pic x(256) value spaces.
|
||
02 ws02-arg-e pic x(256) value spaces.
|
||
02 ws02-arg-f pic x(256) value spaces.
|
||
02 ws02-arg-g pic x(256) value spaces.
|
||
02 ws02-arg-h pic x(256) value spaces.
|
||
* Vari<72>veis para serem usadas como contadores.
|
||
01 ws01-contadores.
|
||
02 ws02-i pic 9(003) value zeros.
|
||
02 ws02-j pic 9(003) value zeros.
|
||
02 ws02-k pic 9(003) value zeros.
|
||
02 ws02-l pic 9(003) value zeros.
|
||
02 ws02-m pic 9(003) value zeros.
|
||
02 ws02-n pic 9(003) value zeros.
|
||
* Flags condicionais para gravacao de linha.
|
||
01 ws01-grava-linha pic 9(001) value zeros.
|
||
88 ws88-grava-linha value 0.
|
||
88 ws88-nao-grava-linha value 1.
|
||
* Flags de termino/nao termino de linha.
|
||
01 ws01-termino-linha pic 9(001) value zeros.
|
||
88 ws88-terminou-linha value 0.
|
||
88 ws88-nao-terminou-linha value 1.
|
||
01 ws01-status-linha pic 9(001) value zeros.
|
||
88 ws88-linha-continuada value 0.
|
||
88 ws88-ultima-linha value 1.
|
||
* Flags para o DISPLAY.
|
||
01 ws01-display pic 9(001) value zeros.
|
||
88 ws88-display-nao-terminado value 0.
|
||
88 ws88-display-terminado value 1.
|
||
* Flags para o ACCEPT.
|
||
01 ws01-accept pic 9(001) value zeros.
|
||
88 ws88-accept-nao-terminado value 0.
|
||
88 ws88-accept-terminado value 1.
|
||
* Flags para Identification division.
|
||
77 ws77-linha-id pic 9(005) value zeros.
|
||
77 ws77-id pic 9(001) value zeros.
|
||
88 ws88-nao-existe-id value 0.
|
||
88 ws88-existe-id value 1.
|
||
* Flags para Environment division.
|
||
77 ws77-linha-ed pic 9(005) value zeros.
|
||
77 ws77-ed pic 9(001) value zeros.
|
||
88 ws88-nao-existe-ed value 0.
|
||
88 ws88-existe-ed value 1.
|
||
* Crt Status clause.
|
||
77 ws77-crt-status-field pic x(256) value spaces.
|
||
77 ws77-crt-status-length pic 9(003) value zeros.
|
||
01 ws01-precisa-crt-status pic 9(001) value zeros.
|
||
88 ws88-nao-precisa-crt-status value 0.
|
||
88 ws88-precisa-crt-status value 1.
|
||
* Case.
|
||
01 ws01-case.
|
||
02 ws02-maiusculo pic x(26)
|
||
value "ABCDEFGHIJKLMNOPQRSTUVXYWZ".
|
||
02 ws02-minusculo pic x(26)
|
||
value "abcdefghijklmnopqrstuvxywz".
|
||
* Linhas armazenadas.
|
||
01 ws01-linhas.
|
||
03 ws03-registro-armazenado pic x(256) occurs 1000 times.
|
||
* Para debug.
|
||
77 ws77-conta-linha pic 9(005) value 1.
|
||
* Verbos a serem parseados.
|
||
01 ws01-verbos.
|
||
02 ws02-tokens pic x(256) occurs 256 times.
|
||
|
||
linkage section.
|
||
* Arquivos de entrada e sa<73>da
|
||
*77 ws77-arquivo-entrada pic x(256) value spaces.
|
||
*77 ws77-arquivo-saida pic x(256) value spaces.
|
||
copy "globals.ls".
|
||
|
||
procedure division using ws77-arquivo-entrada
|
||
ws77-arquivo-saida
|
||
ws77-processo.
|
||
perform descobrir-informacoes
|
||
move 1 to ws77-conta-linha
|
||
open input arquivo-entrada
|
||
if not ws88-ok
|
||
display "Erro na abertura do arquivo"
|
||
exit program
|
||
end-if
|
||
open output arquivo-saida
|
||
|
||
if ws88-nao-existe-id
|
||
write reg-arquivo-saida from
|
||
" IDENTIFICATION DIVISION."
|
||
move spaces to reg-arquivo-saida
|
||
string " PROGRAM-ID. " ws77-arquivo-entrada(1:6)
|
||
"." into reg-arquivo-saida
|
||
write reg-arquivo-saida
|
||
write reg-arquivo-saida from spaces
|
||
if ws88-nao-existe-ed
|
||
if ws88-precisa-crt-status
|
||
write reg-arquivo-saida from
|
||
" ENVIRONMENT DIVISION."
|
||
write reg-arquivo-saida from
|
||
" CONFIGURATION SECTION."
|
||
write reg-arquivo-saida from
|
||
" SPECIAL-NAMES."
|
||
string " CRT STATUS IS "
|
||
ws77-crt-status-field(1:ws77-crt-status-length)
|
||
"." into reg-arquivo-saida
|
||
write reg-arquivo-saida
|
||
end-if
|
||
end-if
|
||
end-if
|
||
|
||
perform until ws88-fim-arquivo
|
||
read arquivo-entrada
|
||
if not ws88-fim-arquivo
|
||
display "No..: " ws77-conta-linha
|
||
display "Desc: " reg-arquivo-entrada
|
||
move reg-arquivo-entrada
|
||
to ws77-linha-para-parsing
|
||
inspect ws77-linha-para-parsing
|
||
converting ws02-minusculo
|
||
to ws02-maiusculo
|
||
set ws88-grava-linha to true
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " LOCK "
|
||
if ws02-i > 0
|
||
perform testes-lock
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " DATA "
|
||
if ws02-i > 0
|
||
perform testes-data
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " ACCEPT "
|
||
if ws02-i > 0
|
||
perform testes-accept
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " DISPLAY "
|
||
if ws02-i > 0
|
||
perform testes-display
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " DELETE "
|
||
if ws02-i > 0
|
||
perform testes-delete
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" CALL "
|
||
if ws02-i > 0
|
||
perform testes-call
|
||
else
|
||
move zeros to ws02-i
|
||
inspect
|
||
ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" IDENTIFICATION "
|
||
if ws02-i > 0
|
||
perform testes-id
|
||
else
|
||
move zeros to ws02-i
|
||
inspect
|
||
ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" ENVIRONMENT "
|
||
if ws02-i > 0
|
||
perform testes-ed
|
||
else
|
||
perform mais-testes
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
add 1 to ws77-conta-linha
|
||
end-if
|
||
end-perform
|
||
|
||
close arquivo-entrada
|
||
close arquivo-saida
|
||
exit program.
|
||
|
||
testes-lock.
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " MODE "
|
||
if ws02-i > 0
|
||
display "Encontrou clausula LOCK MODE"
|
||
display "Nao grava linha"
|
||
set ws88-nao-grava-linha to true
|
||
else
|
||
write reg-arquivo-saida
|
||
from reg-arquivo-entrada
|
||
end-if
|
||
.
|
||
testes-data.
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " RECORD "
|
||
if ws02-i > 0
|
||
display "Encontrou DATA RECORD!"
|
||
move " ." to reg-arquivo-entrada
|
||
set ws88-grava-linha to true
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " DIVISION"
|
||
if ws02-i > 0
|
||
display "Encontrou DATA DIVISION!"
|
||
if ws88-nao-existe-ed
|
||
write reg-arquivo-saida from
|
||
" ENVIRONMENT DIVISION."
|
||
if ws88-precisa-crt-status
|
||
write reg-arquivo-saida from
|
||
" CONFIGURATION SECTION."
|
||
write reg-arquivo-saida from
|
||
" SPECIAL-NAMES."
|
||
string " CRT STATUS IS "
|
||
ws77-crt-status-field
|
||
(1:ws77-crt-status-length)
|
||
"." into reg-arquivo-saida
|
||
write reg-arquivo-saida
|
||
end-if
|
||
end-if
|
||
write reg-arquivo-saida from spaces
|
||
end-if
|
||
end-if
|
||
if ws88-grava-linha
|
||
write reg-arquivo-saida from reg-arquivo-entrada
|
||
end-if
|
||
.
|
||
testes-display.
|
||
set ws88-display-nao-terminado to true
|
||
perform until ws88-display-terminado
|
||
move zeros to ws02-i
|
||
* Substituir (xx, xx) por line xx position xx
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " ("
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
perform substituir-accept
|
||
move spaces to reg-arquivo-entrada
|
||
move ws77-linha-para-parsing to reg-arquivo-entrada
|
||
write reg-arquivo-saida
|
||
from reg-arquivo-entrada
|
||
move spaces to ws77-linha-para-parsing
|
||
move ws77-linpos to ws77-linha-para-parsing
|
||
move ws77-linha-para-parsing to reg-arquivo-entrada
|
||
* Substituir (xx, xx) por line xx position xx
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " LINE "
|
||
if ws02-i > 0
|
||
display "Encontrou LINE, vai retirar o AT."
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " AT "
|
||
if ws02-i > 0
|
||
add 1 to ws02-i
|
||
move spaces
|
||
to reg-arquivo-entrada(ws02-i:4)
|
||
ws77-linha-para-parsing(ws02-i:4)
|
||
end-if
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " PROMPT "
|
||
if ws02-i > 0
|
||
display "Encontrou o PROMPT, vai remove-lo"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " PROMPT "
|
||
if ws02-i > 0
|
||
add 1 to ws02-i
|
||
move spaces
|
||
to reg-arquivo-entrada(ws02-i:8)
|
||
ws77-linha-para-parsing(ws02-i:8)
|
||
end-if
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" BACKGROUND-COLOR "
|
||
if ws02-i > 0
|
||
display " Encontrou o BACKGROUND-COLOR vai
|
||
- " remove-lo"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " BACKGROUND-COLOR "
|
||
if ws02-i > 0
|
||
add 1 to ws02-i
|
||
move spaces
|
||
to reg-arquivo-entrada(ws02-i:18)
|
||
ws77-linha-para-parsing
|
||
(ws02-i:18)
|
||
add 18 to ws02-i
|
||
perform varying ws02-j
|
||
from ws02-i by 1
|
||
until ws77-linha-para-parsing
|
||
(ws02-j:1)
|
||
not equal spaces or ws02-j >= 256
|
||
continue
|
||
end-perform
|
||
perform varying ws02-i
|
||
from ws02-j by 1
|
||
until ws77-linha-para-parsing
|
||
(ws02-i:1)
|
||
equal spaces or ws02-j >= 256
|
||
move spaces
|
||
to ws77-linha-para-parsing
|
||
(ws02-i:1)
|
||
move spaces
|
||
to reg-arquivo-entrada
|
||
(ws02-i:1)
|
||
end-perform
|
||
end-if
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" FOREGROUND-COLOR "
|
||
if ws02-i > 0
|
||
display " Encontrou o FOREGROUND-COLOR
|
||
- " vai remove-lo"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " FOREGROUND-COLOR "
|
||
if ws02-i > 0
|
||
add 1 to ws02-i
|
||
move spaces
|
||
to reg-arquivo-entrada
|
||
(ws02-i:18)
|
||
ws77-linha-para-parsing
|
||
(ws02-i:18)
|
||
end-if
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" AUTO-SKIP "
|
||
if ws02-i > 0
|
||
display " Encontrou o AUTO-SKIP
|
||
- " sera substituido pelo
|
||
- " AUTO"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " AUTO-SKIP "
|
||
if ws02-i > 0
|
||
add 1 to ws02-i
|
||
move spaces
|
||
to reg-arquivo-entrada
|
||
(ws02-i:10)
|
||
ws77-linha-para-parsing
|
||
(ws02-i:10)
|
||
move " AUTO "
|
||
to reg-arquivo-entrada
|
||
(ws02-i:6)
|
||
ws77-linha-para-parsing
|
||
(ws02-i:6)
|
||
end-if
|
||
else
|
||
set ws88-display-terminado to true
|
||
write reg-arquivo-saida
|
||
from reg-arquivo-entrada
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
else
|
||
write reg-arquivo-saida
|
||
from reg-arquivo-entrada
|
||
set ws88-display-terminado to true
|
||
end-if
|
||
end-perform
|
||
.
|
||
testes-accept.
|
||
set ws88-accept-nao-terminado to true
|
||
perform until ws88-accept-terminado
|
||
move zeros to ws02-i
|
||
* Substituir (xx, xx) por line xx position xx
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " ("
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
perform substituir-accept
|
||
move spaces to reg-arquivo-entrada
|
||
move ws77-linha-para-parsing to reg-arquivo-entrada
|
||
write reg-arquivo-saida
|
||
from reg-arquivo-entrada
|
||
move spaces to ws77-linha-para-parsing
|
||
move ws77-linpos to ws77-linha-para-parsing
|
||
move ws77-linha-para-parsing to reg-arquivo-entrada
|
||
* Substituir (xx, xx) por line xx position xx
|
||
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " LINE "
|
||
if ws02-i > 0
|
||
display "Encontrou LINE, vai retirar o AT.498"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " AT "
|
||
if ws02-i > 0
|
||
add 1 to ws02-i
|
||
move spaces
|
||
to reg-arquivo-entrada(ws02-i:4)
|
||
ws77-linha-para-parsing(ws02-i:4)
|
||
end-if
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " PROMPT "
|
||
if ws02-i > 0
|
||
display "Encontrou o PROMPT, vai remove-lo"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " PROMPT "
|
||
if ws02-i > 0
|
||
add 1 to ws02-i
|
||
move spaces
|
||
to reg-arquivo-entrada(ws02-i:8)
|
||
ws77-linha-para-parsing(ws02-i:8)
|
||
end-if
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" BACKGROUND-COLOR "
|
||
if ws02-i > 0
|
||
display " Encontrou o BACKGROUND-COLOR vai
|
||
- " remove-lo"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " BACKGROUND-COLOR "
|
||
if ws02-i > 0
|
||
add 1 to ws02-i
|
||
move spaces
|
||
to reg-arquivo-entrada(ws02-i:18)
|
||
ws77-linha-para-parsing
|
||
(ws02-i:18)
|
||
add 18 to ws02-i
|
||
perform varying ws02-j
|
||
from ws02-i by 1
|
||
until ws77-linha-para-parsing
|
||
(ws02-j:1)
|
||
not equal spaces or ws02-j >= 256
|
||
continue
|
||
end-perform
|
||
perform varying ws02-i
|
||
from ws02-j by 1
|
||
until ws77-linha-para-parsing
|
||
(ws02-i:1)
|
||
equal spaces or ws02-j >= 256
|
||
move spaces
|
||
to ws77-linha-para-parsing
|
||
(ws02-i:1)
|
||
move spaces
|
||
to reg-arquivo-entrada
|
||
(ws02-i:1)
|
||
end-perform
|
||
end-if
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" FOREGROUND-COLOR "
|
||
if ws02-i > 0
|
||
display " Encontrou o FOREGROUND-COLOR
|
||
- " vai remove-lo"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " FOREGROUND-COLOR "
|
||
if ws02-i > 0
|
||
add 1 to ws02-i
|
||
move spaces
|
||
to reg-arquivo-entrada
|
||
(ws02-i:18)
|
||
ws77-linha-para-parsing
|
||
(ws02-i:18)
|
||
end-if
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" AUTO-SKIP "
|
||
if ws02-i > 0
|
||
display " Encontrou o AUTO-SKIP
|
||
- " sera substituido pelo
|
||
- " AUTO"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " AUTO-SKIP "
|
||
if ws02-i > 0
|
||
add 1 to ws02-i
|
||
move spaces
|
||
to reg-arquivo-entrada
|
||
(ws02-i:10)
|
||
ws77-linha-para-parsing
|
||
(ws02-i:10)
|
||
move " AUTO "
|
||
to reg-arquivo-entrada
|
||
(ws02-i:6)
|
||
ws77-linha-para-parsing
|
||
(ws02-i:6)
|
||
end-if
|
||
else
|
||
set ws88-accept-terminado to true
|
||
write reg-arquivo-saida
|
||
from reg-arquivo-entrada
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " FROM "
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " ESCAPE "
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " KEY"
|
||
if ws02-i > 0
|
||
set ws88-accept-terminado to true
|
||
end-if
|
||
else
|
||
write reg-arquivo-saida
|
||
from reg-arquivo-entrada
|
||
set ws88-accept-terminado to true
|
||
end-if
|
||
else
|
||
write reg-arquivo-saida
|
||
from reg-arquivo-entrada
|
||
set ws88-accept-terminado to true
|
||
end-if
|
||
end-if
|
||
end-perform
|
||
.
|
||
descobrir-informacoes.
|
||
open input arquivo-entrada
|
||
if not ws88-ok
|
||
display "Erro na abertura do arquivo"
|
||
exit program
|
||
end-if
|
||
perform until ws88-fim-arquivo
|
||
read arquivo-entrada
|
||
if not ws88-fim-arquivo
|
||
move reg-arquivo-entrada
|
||
to ws77-linha-para-parsing
|
||
inspect ws77-linha-para-parsing
|
||
converting ws02-minusculo
|
||
to ws02-maiusculo
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " ACCEPT "
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " FROM "
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" ESCAPE "
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" KEY"
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " ACCEPT "
|
||
add 8 to ws02-i
|
||
move zeros to ws02-j
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-j for characters
|
||
before " FROM "
|
||
compute ws02-k = ws02-j - ws02-i
|
||
add 1 to ws02-k
|
||
move ws77-linha-para-parsing
|
||
(ws02-i:ws02-k)
|
||
to ws77-crt-status-field
|
||
move ws02-k to ws77-crt-status-length
|
||
set ws88-precisa-crt-status to true
|
||
end-if
|
||
end-if
|
||
end-if
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " IDENTIFICATION "
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " DIVISION"
|
||
if ws02-i > 0
|
||
set ws88-existe-id to true
|
||
move ws77-conta-linha to ws77-linha-id
|
||
end-if
|
||
else
|
||
If not ws88-existe-id
|
||
set ws88-nao-existe-id to true
|
||
end-if
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " ENVIRONMENT "
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " DIVISION"
|
||
if ws02-i > 0
|
||
set ws88-existe-ed to true
|
||
move ws77-conta-linha to ws77-linha-ed
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
add 1 to ws77-conta-linha
|
||
end-perform
|
||
close arquivo-entrada
|
||
.
|
||
testes-delete.
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " DELETE "
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " FILE "
|
||
if ws02-i > 0
|
||
set ws88-nao-grava-linha to true
|
||
end-if
|
||
end-if
|
||
if ws88-grava-linha
|
||
write reg-arquivo-saida from reg-arquivo-entrada
|
||
end-if
|
||
.
|
||
testes-call.
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters before " CALL "
|
||
add 6 to ws02-i
|
||
move zeros to ws02-j
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-j for all " USING "
|
||
if ws02-j > 0
|
||
move zeros to ws02-j
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-j for characters before " USING "
|
||
if ws02-j > 0
|
||
compute ws02-k = ws02-j - ws02-i
|
||
move zeros to ws02-l
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-l for all 'X"AF"'
|
||
if ws02-l > 0
|
||
set ws88-nao-grava-linha to true
|
||
else
|
||
move zeros to ws02-l
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-l for all 'X"91"'
|
||
if ws02-l > 0
|
||
set ws88-nao-grava-linha to true
|
||
else
|
||
inspect reg-arquivo-entrada(ws02-i:ws02-k)
|
||
converting ws02-minusculo
|
||
to ws02-maiusculo
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
if ws88-grava-linha
|
||
write reg-arquivo-saida from reg-arquivo-entrada
|
||
end-if
|
||
.
|
||
testes-id.
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " DIVISION"
|
||
if ws02-i > 0
|
||
display "Encontrou IDENTIFICATION DIVISION!"
|
||
write reg-arquivo-saida from reg-arquivo-entrada
|
||
read arquivo-entrada
|
||
move reg-arquivo-entrada
|
||
to ws77-linha-para-parsing
|
||
inspect ws77-linha-para-parsing
|
||
converting ws02-minusculo
|
||
to ws02-maiusculo
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " PROGRAM-ID"
|
||
if ws02-i <= 0
|
||
display "Nao encontrou PROGRAM-ID!"
|
||
string " PROGRAM-ID. " ws77-arquivo-entrada(1:6)
|
||
"." into reg-arquivo-saida
|
||
write reg-arquivo-saida
|
||
else
|
||
display "Encontrou PROGRAM-ID!"
|
||
write reg-arquivo-saida from reg-arquivo-entrada
|
||
end-if
|
||
.
|
||
testes-ed.
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " DIVISION"
|
||
if ws02-i > 0
|
||
display "Encontrou ENVIRONMENT DIVISION!"
|
||
write reg-arquivo-saida from reg-arquivo-entrada
|
||
read arquivo-entrada
|
||
move reg-arquivo-entrada
|
||
to ws77-linha-para-parsing
|
||
inspect ws77-linha-para-parsing
|
||
converting ws02-minusculo
|
||
to ws02-maiusculo
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " CONFIGURATION "
|
||
if ws02-i > 0
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " SECTION"
|
||
if ws02-i > 0
|
||
display "Encontrou CONFIGURATION SECTION!"
|
||
write reg-arquivo-saida from reg-arquivo-entrada
|
||
read arquivo-entrada
|
||
move reg-arquivo-entrada
|
||
to ws77-linha-para-parsing
|
||
inspect ws77-linha-para-parsing
|
||
converting ws02-minusculo
|
||
to ws02-maiusculo
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " SOURCE-COMPUTER"
|
||
if ws02-i > 0
|
||
display "Encontrou SOURCE-COMPUTER!"
|
||
write reg-arquivo-saida
|
||
from reg-arquivo-entrada
|
||
read arquivo-entrada
|
||
move reg-arquivo-entrada
|
||
to ws77-linha-para-parsing
|
||
inspect ws77-linha-para-parsing
|
||
converting ws02-minusculo
|
||
to ws02-maiusculo
|
||
end-if
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all " SPECIAL-NAMES"
|
||
if ws02-i > 0
|
||
display "Encontrou SPECIAL-NAMES!"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" DECIMAL-POINT"
|
||
if ws02-i > 0
|
||
display "Encontrou DECIMAL-POINT na mesma
|
||
- " linha da SPECIAL-NAMES"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " DECIMAL-POINT"
|
||
if ws02-i > 0
|
||
move spaces
|
||
to reg-arquivo-saida
|
||
move reg-arquivo-entrada
|
||
(1:ws02-i)
|
||
to reg-arquivo-saida
|
||
write reg-arquivo-saida
|
||
end-if
|
||
else
|
||
write reg-arquivo-saida
|
||
from reg-arquivo-entrada
|
||
end-if
|
||
move spaces to reg-arquivo-saida
|
||
if ws88-precisa-crt-status
|
||
display "Precisa de CRT STATUS!"
|
||
string " CRT STATUS IS "
|
||
ws77-crt-status-field
|
||
(1:ws77-crt-status-length)
|
||
into reg-arquivo-saida
|
||
write reg-arquivo-saida
|
||
set ws88-nao-grava-linha to true
|
||
end-if
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all
|
||
" DECIMAL-POINT"
|
||
if ws02-i > 0
|
||
display "Encontrou DECIMAL-POINT na mesma
|
||
- " linha da SPECIAL-NAMES"
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters
|
||
before " DECIMAL-POINT"
|
||
if ws02-i > 0
|
||
add 2 to ws02-i
|
||
compute ws02-j = 256 - ws02-i
|
||
move spaces
|
||
to reg-arquivo-saida
|
||
move reg-arquivo-entrada
|
||
(ws02-i:ws02-j)
|
||
to reg-arquivo-saida(12:242)
|
||
write reg-arquivo-saida
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
end-if
|
||
.
|
||
mais-testes.
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all ' "'
|
||
if ws02-i > 0
|
||
perform testes-aspas-duplas
|
||
else
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for all ' -'
|
||
if ws02-i > 0
|
||
perform testes-hifen
|
||
else
|
||
write reg-arquivo-saida from reg-arquivo-entrada
|
||
end-if
|
||
end-if
|
||
.
|
||
testes-aspas-duplas.
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters before ' "'
|
||
if ws02-i = 6
|
||
display "Encontrou aspas duplas, acertando-as para a colu
|
||
- "una 12"
|
||
add 2 to ws02-i
|
||
compute ws02-j = 256 - ws02-i
|
||
move spaces to reg-arquivo-saida(1:11)
|
||
move reg-arquivo-entrada(ws02-i:ws02-j)
|
||
to reg-arquivo-saida(12:244)
|
||
if reg-arquivo-saida(73:183) not equal spaces
|
||
display "Linha n<>o acabou, os testes devem ser feitos
|
||
- "pelo testes-hifen"
|
||
set ws88-nao-terminou-linha to true
|
||
move reg-arquivo-saida(73:183)
|
||
to ws77-linha-temporaria
|
||
move spaces to reg-arquivo-saida(73:183)
|
||
end-if
|
||
write reg-arquivo-saida
|
||
else
|
||
move zeros to ws02-j
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-j for characters before ' -'
|
||
if ws02-j = 5
|
||
perform testes-hifen
|
||
else
|
||
write reg-arquivo-saida from reg-arquivo-entrada
|
||
end-if
|
||
end-if
|
||
.
|
||
testes-hifen.
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-i for characters before " -"
|
||
if ws02-i = 5
|
||
display "Encontrado hifen"
|
||
set ws88-linha-continuada to true
|
||
move zeros to ws02-m
|
||
inspect ws77-linha-para-parsing
|
||
tallying ws02-m for all '"'
|
||
if ws02-m >= 2
|
||
display "Ultima linha!"
|
||
set ws88-ultima-linha to true
|
||
end-if
|
||
add 3 to ws02-i
|
||
compute ws02-j = 256 - ws02-i
|
||
move spaces to reg-arquivo-saida
|
||
move " - " to reg-arquivo-saida(1:11)
|
||
if ws88-terminou-linha
|
||
display "Linha terminada"
|
||
move reg-arquivo-entrada(ws02-i:ws02-j)
|
||
to reg-arquivo-saida(12:244)
|
||
else
|
||
display "Linha nao terminada"
|
||
move '"' to reg-arquivo-saida(12:1)
|
||
perform varying ws02-k from 256 by -1
|
||
until ws77-linha-temporaria(ws02-k:1)
|
||
not equal spaces
|
||
continue
|
||
end-perform
|
||
move ws77-linha-temporaria(1:ws02-k)
|
||
to reg-arquivo-saida(13:ws02-k)
|
||
compute ws02-l = 13 + ws02-k
|
||
display "Linha ant." reg-arquivo-saida(1:ws02-l)
|
||
add 1 to ws02-i
|
||
subtract 1 from ws02-j
|
||
compute ws02-m = 256 - ws02-l
|
||
display "I: " ws02-i
|
||
display "J: " ws02-j
|
||
display "L: " ws02-l
|
||
display "K: " ws02-k
|
||
display "M: " ws02-m
|
||
move reg-arquivo-entrada(ws02-i:ws02-j)
|
||
to reg-arquivo-saida(ws02-l:ws02-m)
|
||
display "Linha atual: " reg-arquivo-saida
|
||
end-if
|
||
if reg-arquivo-saida(73:183) not equal spaces
|
||
display "Linha nao terminou.. testes-hifen"
|
||
set ws88-nao-terminou-linha to true
|
||
move reg-arquivo-saida(73:183)
|
||
to ws77-linha-temporaria
|
||
move spaces to reg-arquivo-saida(73:183)
|
||
else
|
||
display "Linha terminou.."
|
||
set ws88-terminou-linha to true
|
||
end-if
|
||
write reg-arquivo-saida
|
||
if ws88-ultima-linha
|
||
if ws88-nao-terminou-linha
|
||
display "Ultima linha desta instrucao!"
|
||
move spaces to reg-arquivo-saida
|
||
move zeros to ws02-i
|
||
inspect ws77-linha-temporaria
|
||
tallying ws02-i for all '"'
|
||
if ws02-i >= 1
|
||
move ' - "'
|
||
to reg-arquivo-saida(1:12)
|
||
move 13 to ws02-k
|
||
else
|
||
move 12 to ws02-k
|
||
end-if
|
||
perform varying ws02-i from 256 by -1
|
||
until ws77-linha-temporaria(ws02-i:1)
|
||
not equal spaces
|
||
continue
|
||
end-perform
|
||
move ws77-linha-temporaria(1:ws02-i)
|
||
to reg-arquivo-saida(ws02-k:243)
|
||
perform varying ws02-i from 256 by -1
|
||
until reg-arquivo-saida(ws02-i:1)
|
||
not equal '"'
|
||
continue
|
||
end-perform
|
||
compute ws02-j = 256 - ws02-i
|
||
move reg-arquivo-saida(ws02-i:ws02-j)
|
||
to ws77-linha-temporaria
|
||
move spaces to reg-arquivo-saida(ws02-i:ws02-j)
|
||
write reg-arquivo-saida
|
||
move spaces to reg-arquivo-saida
|
||
move ws77-linha-temporaria
|
||
to reg-arquivo-saida(ws02-k:244)
|
||
write reg-arquivo-saida
|
||
set ws88-terminou-linha to true
|
||
end-if
|
||
end-if
|
||
end-if
|
||
.
|
||
|
||
substituir-accept.
|
||
move 1 to ws77-troca.
|
||
perform sub-accept1 thru sub-accept-exit.
|
||
|
||
sub-accept1.
|
||
if ws50trocando (ws77-troca) not = "("
|
||
compute ws77-troca = ws77-troca + 1
|
||
go to sub-accept1.
|
||
move spaces to ws50trocando (ws77-troca).
|
||
compute ws77-troca = ws77-troca + 1.
|
||
move 17 to ws77-troca2.
|
||
|
||
sub-accept2.
|
||
if ws50trocando (ws77-troca) = ")"
|
||
move spaces to ws50trocando (ws77-troca)
|
||
move 256 to ws77-troca
|
||
go to sub-accept3.
|
||
|
||
if ws50trocando (ws77-troca) = ","
|
||
move spaces to ws50trocando (ws77-troca)
|
||
compute ws77-troca = ws77-troca + 1
|
||
go to sub-accept2.
|
||
|
||
if ws50trocando (ws77-troca) = " "
|
||
move spaces to ws50trocando (ws77-troca)
|
||
compute ws77-troca = ws77-troca + 1
|
||
move 32 to ws77-troca2
|
||
go to sub-accept2.
|
||
|
||
move ws50trocando (ws77-troca) to
|
||
ws50lineposi (ws77-troca2).
|
||
move spaces to ws50trocando (ws77-troca).
|
||
compute ws77-troca2 = ws77-troca2 + 1.
|
||
compute ws77-troca = ws77-troca + 1.
|
||
go to sub-accept2.
|
||
|
||
|
||
sub-accept3.
|
||
if ws50trocando (ws77-troca) = " "
|
||
compute ws77-troca = ws77-troca - 1
|
||
go to sub-accept3.
|
||
|
||
if ws50trocando (ws77-troca) = "."
|
||
move 37 to ws77-troca2
|
||
move "." to ws50lineposi (ws77-troca2)
|
||
move spaces to ws50trocando (ws77-troca)
|
||
go to sub-accept-exit.
|
||
|
||
move " " to ws50lineposi (ws77-troca2).
|
||
|
||
sub-accept-exit.
|
||
exit.
|