Freigeben über

The ABC language, thirty years later...

  • Artikel

Back in March 1986, I was in my second year of college (Data Processing at the Universidade Federal do Ceara in Brazil). I was also teaching programming night classes at a Brazilian technical school. On that year, I created a language called ABC, complete with a little compiler. It compiled the ABC code into pseudo code and ran it right away.

I actually used this language for a few years to teach an introductory programming class. Both the commands of the ABC language and the messages of the compiler were written in Portuguese. This made it easier for my Brazilian students to start in computer programming without having to know any English. Once they were familiar with the basic principles, they would start using conventional languages like Basic and Pascal.

The students would write some ABC code using a text editor and run the command "ABC filename" to compile and immediately run the code if no errors were found. The tool wrote a binary log entry for every attempt to compile/run a program with the name of the file, the error that stopped the compilation or how many instructions were executed. The teachers had a tool to read this binary log and examine the progress of a student over time.

I remember having a lot of fun with this project. The language was very simple and each command would have up to two parameters, followed by a semicolon. There were dozens of commands including:

  • Inicio (start, no action)
  • Fim (end, no action)
  • * (comment, no action)
  • Mova (move, move register to another register)
  • Troque (swap, swap contents of two registers)
  • Salve (save, put data into a register)
  • Restore (restore, restore data from a register)
  • Entre (enter, receive input from the keyboard)
  • Escreva (write, write to the printer)
  • Escreva> (writeline, write to the printer and jump to the next line)
  • Salte (jump, jump to the next printed page)
  • Mostre (display, display on the screen)
  • Mostre> (displayline, display on the screen and jump to the next line)
  • Apague (erase, erase the screen)
  • Cursor (cursor, position the cursor at the specified screen coordinates)
  • Pausa (pause, pause for the specified seconds)
  • Bip (beep, make a beeping sound)
  • Pare (stop, stop executing the program)
  • Desvie (goto, jump to the specified line number)
  • Se (if, start a conditional block)
  • FimSe (endif, end a conditional block)
  • Enquanto (while, start a loop until a condition is met)
  • FimEnq (endwhile, end of while loop)
  • Chame (call, call a subroutine)
  • Retorne (return, return from a subroutine)
  • Repita (repeat, start a loop that repeats a number of times)
  • FimRep (endrepeat, end of repeat loop)
  • AbraSai (openwrite, open file for writing)
  • AbraEnt (openread, open file for reading)
  • Feche (close, close file)
  • Leia (read, read from file)
  • Grave (write, write to file)
  • Ponha (poke, write to memory address)
  • Pegue (peek, read from memory address)

The language used 26 pre-defined variables named after each letter. There were also 100 memory positions you could read/write into. I was very proud of how you could use complex expressions with multiple operators, parenthesis, different numeric bases (binary, octal, decimal, hex) and functions like:

  • Raiz (square root)
  • Inverso (reverse string)
  • Caractere (convert number into ASCII character)
  • Codigo (convert ASCII character into a number)
  • FimArq (end of file)
  • Qualquer (random number generator)
  • Tamanho (length of a string)
  • Primeiro (first character of a string)
  • Restante (all but the first character of a string)

I had a whole lot of samples written in ABC, showcasing each of the command, but I somehow lost them along the way. I also had a booklet that we used in the programming classes, with a series of concept followed by examples in ABC. I also could not find it. Oh, well...

At least the source code survived (see below). I used an old version of Microsoft Basic running on a CP/M 2.2 operating system on a TRS-80 clone. Here are a few comments for those not familiar with that 1980's language:

  • Line numbers were required. Colons were used to separate multiple commands in a single line.
  • Variables ending in $ were of type string. Variable with no suffix were of type integer.
  • Your variable names could be any length, but only the first 4 characters were actually used. Periods were allowed in variable names.
  • DIM was used to create arrays. Array dimensions were predefined and fixed. There wasn't a lot of memory.
  • READ command was used to read from DATA lines. RESTORE would set the next DATA line to READ.
  • Files could be OPEN for sequential read ("I" mode), sequential write ("O" mode) or random access ("R" mode).

It compiled into a single ABC.COM file (that was the executable extension then). It also used the ABC.OVR file, which contained the error message and up to 128 compilation log entries. Comments are in Portuguese, but I bet you can understand most of it. The code is a little messy, but keep in mind this was written 30 years ago...

 

 2 '************************************************************
3 '*   COMPILADOR/EXECUTOR DE LINGUAGEM ABC - MARCO/1986      *
4 '*               Jose Barreto de Araujo Junior              *
5 '*     com calculo recursivo de expressoes aritmeticas      *
6 '************************************************************
10 ' Versao  2.0 em 20/07/86
11 ' Revisao 2.1 em 31/07/86
12 ' Revisao 2.2 em 05/08/86
13 ' Revisao 2.3 em 15/02/87
14 ' Revisao 2.4 em 07/06/87, em MSDOS
20 '********** DEFINICOES INICIAIS
21 DEFINT A-Z:CLS:LOCATE 1,1,1:ON ERROR GOTO 63000
22 C.CST=1:C.REGIST=2:LT$=STRING$(51,45)
25 DIM ENT$(30),RET$(30),TP(30),P1$(30),P2$(30)
30 DIM CMD(200),PR1$(199),PR2$(199)
35 DIM MEM$(99),REGIST$(26),PRM$(4),MSG$(99)
36 DIM CT(40),REP(10),REPC(10),ENQ(10),ENQ$(10),CHA(10)
40 DEF FNS$(X)=MID$(STR$(X),2)
55 OPER$="!&=#><+-*/^~":MAU$=";.[]()?*"
60 FUNC$="RAIZ     INVERSO  CARACTER CODIGO   FIMARQ   QUALQUER "
62 FUNC$=FUNC$+"TAMANHO  PRIMEIRO RESTANTE ARQUIVO  "
65 ESC$=CHR$(27):BIP$=CHR$(7):TABHEX$="FEDCBA9876543210"
66 OK$=CHR$(5)+CHR$(6)+CHR$(11)
70 M.LN=199:M.CMD=37:MAX=16^4/2-1
75 ESP$=" ":BK$=CHR$(8):RN$="R":IN$="I":OU$="O":NL$=""
80 OPEN RN$,1,"ABC2.OVR",32:FIELD 1,32 AS ER$
85 IF LOF(1)=0 THEN CLOSE:KILL"ABC2.OVR":PRINT "ABC2.OVR NAO ENCONTRADO":END
90 GOSUB 10000 '********** MOSTRA MENSAGEM INICIAL
95 PRINT "Nome do programa: ";:BAS=1:GOSUB 18000:AR$=RI$:GOSUB 10205
99 '********** DEFINICAO DOS COMANDOS
100 DIM CMD$(37),PR$(37):CHQ=0:RESTORE 125
105 FOR X=1 TO M.CMD:READ CMD$(X),PR$(X)
110    CHQ=CHQ+ASC(CMD$(X))+VAL(PR$(X))
115 NEXT : IF CHQ<>3402 THEN END
120 '********** TABELA DOS COMANDOS E PARAMETROS
125 DATA INICIO,10,FIM,10,"*",10
130 DATA MOVA,54,TROQUE,55
135 DATA SALVE,30,RESTAURE,30," ",00
140 DATA ENTRE,52,ESCREVA,42,ESCREVA>,42,MOSTRE,42,MOSTRE>,42
145 DATA SALTE,00,APAGUE,00,CURSOR,22,PAUSA,20,BIP,00
150 DATA PARE,00,DESVIE,40,SE,20," ",00,FIMSE,00
155 DATA ENQUANTO,20," ",00,FIMENQ,00,CHAME,20,RETORNE,00
160 DATA REPITA,20,FIMREP,00
165 DATA ABRASAI,30,ABRAENT,30,FECHE,00,LEIA,50,GRAVE,40
170 DATA PONHA,42,PEGUE,52
190 '********** ABRE ARQUIVO PROGRAMA
200 IF LEN(ARQ$)=0 THEN ERROR 99:GOTO 64000
210 OPEN RN$,2,ARQ$:ULT=LOF(2):CLOSE#2
220 IF ULT=0 THEN KILL ARQ$:ERROR 109:GOTO 64000
390 '********** COMPILACAO
400 N.ERR=0:N.LN=0:IDT=0:CT.SE=0:CT.REP=0:CT.ENQ=0:I.CT=0:LN.ANT=0:CMP=1
405 PRINT:PRINT:PRINT "Compilando ";ARQ$
406 IF DEPUR THEN PRINT "Depuracao"
407 PRINT
410 OPEN IN$,2,ARQ$
415 WHILE NOT EOF(2)
420     LN.ERR=0:LINE INPUT#2,LN$
422     IF INKEY$=ESC$ THEN PRINT "*** Interrompido":GOTO 64000
425     N.LN=N.LN+1:GOSUB 20000 '*ANALISE SINTATICA DA LINHA
430 WEND:CLOSE#2
435 FOR X=IDT TO 1 STEP -1
440     ERROR CT(X)+115
445 NEXT X
450 PRINT:PRINT FNS$(N.LN);" linha(s) compilada(s)"
490 '********** EXECUCAO
500 IF N.ERR THEN PRINT FNS$(N.ERR);" erro(s)":GOTO 64000
510 PRINT "0 erros"
515 PRINT "Executando ";ARQ$:PRINT
520 NL=1:CMP=0:N.CMD=0:CHA=0:ENQ=0:REP=0:SE=0:ESC=0
525 FOR X=1 TO 99:MEM$(X)="":NEXT:FOR X=1 TO 26:REGIST$(X)="":NEXT
530 WHILE NL<=M.LN
535     PNL=NL+1:CMD=CMD(NL):PR1$=PR1$(NL):PR2$=PR2$(NL)
540     IF CMD>3 THEN GOSUB 30000:N.CMD=N.CMD+1 '****** EXECUTA COMANDO
550     NL=PNL:REGIST$(26)=INKEY$
555     IF REGIST$(26)=ESC$ OR ESC=1 THEN NL=M.LN+1:PRINT "*** Interrompido"
560 WEND
570 PRINT:PRINT ARQ$;" executado"
580 PRINT FNS$(N.CMD);" comando(s) executado(s)"
590 PRINT:PRINT "Executar novamente? ";
600 A$=INPUT$(1):IF A$="S" OR A$="s" THEN PRINT "sim":GOTO 515
610 PRINT "nao";:GOTO 64000
9999 '********** ROTINA DE MENSAGEM INICIAL
10000 CLS:PRINT LT$
10020 XA$="| COMPILADOR/EXECUTOR DE LINGUAGEM ABC VERSAO 2.4 |"
10030 PRINT XA$:PRINT LT$:PRINT
10040 CHQ=0:FOR X=1 TO LEN(XA$):CHQ=CHQ+ASC(MID$(XA$,X,1)):NEXT
10050 IF CHQ<>3500 THEN END ELSE RETURN
10199 '********** ROTINA PARA PEGAR NOME DO ARQUIVO
10200 AR$=NL$:K=PEEK(128):FOR X=130 TO 128+K:AR$=AR$+CHR$(PEEK(X)):NEXT
10205 IF AR$="" THEN ERROR 99:GOTO 64000
10210 AR$=AR$+ESP$:PS=INSTR(AR$,ESP$)
10220 ARQ$=LEFT$(AR$,PS-1):RESTO$=MID$(AR$,PS+1)
10221 IF LEFT$(RESTO$,1)="?" THEN DEPUR=1
10230 FOR X=1 TO LEN(MAU$):P$=MID$(MAU$,X,1)
10240   IF INSTR(ARQ$,P$) THEN ERROR 100:GOTO 64000
10250 NEXT
10270 IF LEN(ARQ$)>12 THEN ERROR 100:GOTO 64000
10280 IF INSTR(ARQ$,".")=0 THEN ARQ$=ARQ$+".ABC"
10290 RETURN
17999 '********** ROTINA DE ENTRADA DE DADOS
18000 BAS$=FNS$(BAS):RI$=NL$
18010 A$=INPUT$(1)
18020 WHILE LEN(RI$)<255 AND A$<>CHR$(13) AND A$<>ESC$
18030    RET$=RI$
18040    IF A$=BK$ AND RI$<>NL$ THEN RI$=LEFT$(RI$,LEN(RI$)-1):PRINT ESC$;"[D ";ESC$;"[D";
18050    IF BAS=1 AND A$>=ESP$ THEN RI$=RI$+A$:PRINT A$;
18070    IF BAS>1 AND INSTR(17-BAS,TABHEX$,A$) THEN RI$=RI$+A$:PRINT A$;
18090    A$=INPUT$(1)
18100 WEND
18105 IF A$=ESC$ THEN ESC=1
18110 A$=RI$:GOSUB 42030:RI$=RC$:RETURN
18120 RETURN
18499 '********** CONVERTE PARA BASE ESTRANHA
18500 IF BAS=0 THEN BAS=1
18505 IF BAS=1 OR BAS=10 THEN RETURN
18510 A=VAL(A$):A$=""
18520 WHILE A>0:RS=A MOD BAS:A$=MID$(TABHEX$,16-RS,1)+A$:A=A\BAS:WEND
18525 IF A$="" THEN A$="0"
18530 RETURN
18999 '********** EXECUTA PROCURA DE FIMREP,FIMSE,FIMENQ
19000 IDT=0
19010 WHILE (CMD(PNL)<>FIM OR IDT>0) AND PNL<100
19020    IF CMD(PNL)=INI THEN IDT=IDT+1
19030    IF CMD(PNL)=FIM THEN IDT=IDT-1
19040    PNL=PNL+1
19050 WEND:PNL=PNL+1
19060 RETURN
19500 FOR X=1 TO LEN(UP$)
19510     PP$=MID$(UP$,X,1)
19520     IF PP$>="a" AND PP$<="z" THEN MID$(UP$,X,1)=CHR$(ASC(PP$)-32)
19530 NEXT X:RETURN
19600 N.PRM=N.PRM+1:PRM$(N.PRM)=LEFT$(A$,C-1):A$=MID$(A$,C+1)
19610 C=1:WHILE MID$(A$,C,1)=ESP$:C=C+1:WEND:A$=MID$(A$,C):C=0
19620 IF LEN(PRM$(N.PRM))=1 THEN PRM$(N.PRM)=CHR$(ASC(PRM$(N.PRM))+(PRM$(N.PRM)>"Z")*32)
19630 RETURN
19990 '********** ANALISE SINTATICA DA LINHA
19999 '********** RETIRA BRANCOS FINAIS E INICIAIS
20000 N.PRM=0:A$=LN$:PRM$(1)=NL$:PRM$(2)=NL$
20010 C=1:WHILE MID$(A$,C,1)=ESP$:C=C+1:WEND:A$=MID$(A$,C)
20020 C=LEN(A$)
20040 WHILE MID$(A$,C,1)=ESP$ AND C>0:C=C-1:WEND
20050 A$=LEFT$(A$,C):LN$=A$
20100 '********** ISOLA O NUMERO DA LINHA
20105 C=INSTR(A$,ESP$):NUM$=LEFT$(A$,C):A$=MID$(A$,C+1)
20110 C=1:WHILE MID$(A$,C,1)=ESP$:C=C+1:WEND:A$=MID$(A$,C)
20115 IF NUM$="" AND A$="" THEN RETURN
20120 PRINT NUM$;TAB(5+IDT*3);A$
20130 NL=VAL(NUM$):IF NL<1 OR NL>M.LN THEN ERROR 111:RETURN
20135 IF NL<=LN.ANT THEN ERROR 122:RETURN ELSE LN.ANT=NL
20140 IF MID$(A$,LEN(A$))<>";" THEN PRINT TAB(5+IDT*3);"*** ponto e virgula assumido aqui":A$=A$+";"
20200 '********** ISOLA COMANDO
20210 C=1:P=ASC(MID$(A$,C,1))
20220 WHILE P>59 OR P=42:C=C+1:P=ASC(MID$(A$,C,1)):WEND
20230 CMD$=LEFT$(A$,C-1):A$=MID$(A$,C):A$=LEFT$(A$,LEN(A$)-1)
20240 C=1:WHILE MID$(A$,C,1)=ESP$:C=C+1:WEND:A$=MID$(A$,C)
20300 '********** ISOLA PARAMETROS
20310 IF INSTR(A$,CHR$(34)) THEN GOSUB 27000
20315 PAR=0:C=1
20320 WHILE C<=LEN(A$) AND NPRM<4
20340    P$=MID$(A$,C,1)
20350    IF P$="(" THEN PAR=PAR+1
20360    IF P$=")" THEN PAR=PAR-1
20380    IF P$=ESP$ AND PAR=0 THEN GOSUB 19600
20390    C=C+1
20400 WEND
20410 IF A$<>NL$ THEN N.PRM=N.PRM+1:PRM$(N.PRM)=A$
20420 IF N.PRM>2 THEN ERROR 112:RETURN
20430 PR1$=PRM$(1):PR2$=PRM$(2)
20990 '********** IDENTIFICA COMANDO, 99=ERRO
21000 C.CMD=99:UP$=CMD$:GOSUB 19500:CMD$=UP$
21010 FOR X=1 TO M.CMD
21020   IF CMD$=CMD$(X) THEN C.CMD=X
21030 NEXT X
21040 IF C.CMD=99 THEN ERROR 114:RETURN
21050 CMD(NL)=C.CMD:PR1$(NL)=PR1$:PR2$(NL)=PR2$
21060 '********** ANALISE DE COMANDOS PARENTESIS
21100 C=C.CMD
21110 INI=-(C=21)-2*(C=24)-3*(C=29)
21120 FIM=-(C=23)-2*(C=26)-3*(C=30)
21130 IF INI THEN IDT=IDT+1:CT(IDT)=INI
21140 IF FIM THEN GOSUB 26000:IF LN.ERR THEN RETURN
21990 '********** IDENTIFICA PARAMETROS
22000 PR1=VAL(LEFT$(PR$(C.CMD),1)):PR2=VAL(RIGHT$(PR$(C.CMD),1))
22010 PR$=PR1$:PR=PR1:GOSUB 25000:IF LN.ERR THEN RETURN
22020 TIP.ANT=TIP2:PR$=PR2$:PR=PR2:GOSUB 25000
22025 IF PR1+PR2>7 AND TIP2<>TIP.ANT THEN ERROR 110
22030 RETURN
24990 '********** ANALISE DO PARAMETRO
25000 IF PR=0 AND PR$<>NL$ THEN ERROR 112:RETURN
25010 IF PR=1 OR PR=0 THEN RETURN
25020 ENT$(I)=PR$:GOSUB 41000:IF LN.ERR THEN RETURN
25030 TIP1=TP(I)
25040 I=I+1:ENT$(I)=PR$:GOSUB 40000:IF LN.ERR THEN RETURN
25050 TIP2=TP(I+1)
25060 IF PR=4 THEN RETURN
25070 IF PR=2 AND TIP2=1 THEN RETURN
25080 IF PR=3 AND TIP2=-1 THEN RETURN
25090 IF PR=5 AND TIP1=C.REGIST THEN RETURN
25110 ERROR 115:RETURN
25990 '********** ANALISE DE FIMSE,FIMENQ E FIMREP
26000 IF IDT=0 THEN ERROR 115+FIM:RETURN
26010 IF CT(IDT)<>FIM THEN ERROR 118+CT(IDT):IDT=IDT-1:GOTO 26000
26020 IDT=IDT-1:IF IDT<0 THEN IDT=0
26030 RETURN
26999 '********** TROCA "" POR ()1
27000 ASP=0
27010 WHILE INSTR(A$,CHR$(34))
27020     P=INSTR(A$,CHR$(34))
27030     IF ASP=0 THEN MID$(A$,P,1)="(" ELSE A$=LEFT$(A$,P-1)+")1"+MID$(A$,P+1)
27040     ASP=NOT ASP
27050 WEND
27060 RETURN
29999 '********** EXECUTA COMANDO
30000 IF DEPUR THEN PRINT USING "### & & &;";NL;CMD$(CMD);PR1$;PR2$
30005                ON CMD    GOSUB 30100,30200,30300,30400,30500
30010 IF CMD>5  THEN ON CMD-5  GOSUB 30600,30700,30800,30900,31000
30020 IF CMD>10 THEN ON CMD-10 GOSUB 31100,31200,31300,31400,31500
30030 IF CMD>15 THEN ON CMD-15 GOSUB 31600,31700,31800,31900,32000
30040 IF CMD>20 THEN ON CMD-20 GOSUB 32100,32200,32300,32400,32500
30050 IF CMD>25 THEN ON CMD-25 GOSUB 32600,32700,32800,32900,33000
30060 IF CMD>30 THEN ON CMD-30 GOSUB 33100,33200,33300,33400,33500,33600,33700
30080 RETURN
30099  ' COMANDO INICIO
30100 RETURN
30199  ' COMANDO FIM
30200 RETURN
30299  ' COMANDO *
30300 RETURN
30399  ' COMANDO MOVA
30400 I=I+1:ENT$(I)=PR2$:GOSUB 40000
30410 X1=ASC(PR1$):REGIST$(X1-64)=RET$(I+1):RETURN
30499  ' COMANDO TROQUE
30500 X1=ASC(PR1$)-64:X2=ASC(PR2$)-64:SWAP REGIST$(X1),REGIST$(X2):RETURN
30599  ' COMANDO SALVE
30600 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X$=RET$(I+1)
30602 OPEN OU$,3,X$:FOR X=0 TO 99:WRITE#3,MEM$(X):NEXT:CLOSE#3:RETURN
30699  ' COMANDO RESTAURE
30700 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X$=RET$(I+1)
30702 OPEN IN$,3,X$:FOR X=0 TO 99:LINE INPUT#3,MEM$(X):NEXT:CLOSE#3:RETURN
30799  ' COMANDO INDEFINIDO 3
30800 RETURN
30899  ' COMANDO ENTRE
30900 I=I+1:ENT$(I)=PR2$:GOSUB 40000:BAS=VAL(RET$(I+1))
30905 IF BAS=0 THEN IF PR1$>"M" THEN BAS=1 ELSE BAS=10
30910 GOSUB 18000:X1=ASC(PR1$)-64:REGIST$(X1)=RI$:PRINT:RETURN
30999  ' COMANDO ESCREVA
31000 IF PR1$<>"" THEN I=I+1:ENT$(I)=PR1$:GOSUB 40000:X1$=RET$(I+1) ELSE X1$=""
31010 I=I+1:ENT$(I)=PR1$:GOSUB 40000:BAS=VAL(RET$(I+1))
31015 IF BAS>16 THEN ERROR 107
31020 A$=X1$:GOSUB 18500:LPRINT A$;:RETURN
31099  ' COMANDO ESCREVA>
31100 IF PR1$<>"" THEN I=I+1:ENT$(I)=PR1$:GOSUB 40000:X1$=RET$(I+1) ELSE X1$=""
31110 I=I+1:ENT$(I)=PR2$:GOSUB 40000:BAS=VAL(RET$(I+1))
31115 IF BAS>16 THEN ERROR 107
31120 A$=X1$:GOSUB 18500:LPRINT A$:RETURN
31199  ' COMANDO MOSTRE
31200 I=I+1:ENT$(I)=PR2$:GOSUB 40000:X1=VAL(RET$(I+1))
31201 IF X1>16 THEN BAS=X1:ERROR 107
31205 IF PR1$<>"" THEN I=I+1:ENT$(I)=PR1$:GOSUB 40000:A$=RET$(I+1) ELSE A$=""
31210 BAS=X1:GOSUB 18500:PRINT A$;:RETURN
31299  ' COMANDO MOSTRE>
31300 I=I+1:ENT$(I)=PR2$:GOSUB 40000:X1=VAL(RET$(I+1))
31301 IF X1>16 THEN BAS=X1:ERROR 107
31305 IF PR1$<>"" THEN I=I+1:ENT$(I)=PR1$:GOSUB 40000:A$=RET$(I+1) ELSE PR1$=""
31310 BAS=X1:GOSUB 18500:PRINT A$:RETURN
31399  ' COMANDO SALTE
31400 LPRINT CHR$(12);:RETURN
31499  ' COMANDO APAGUE
31500 CLS:RETURN
31599  ' COMANDO CURSOR
31600 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X1=VAL(RET$(I+1))
31610 I=I+1:ENT$(I)=PR2$:GOSUB 40000:X2=VAL(RET$(I+1))
31620 LOCATE X1,X2:RETURN
31699  ' COMANDO PAUSA
31700 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X1=VAL(RET$(I+1))
31710 FOR X!=1 TO X1*1000:NEXT:RETURN
31799  ' COMANDO BIP
31800 BEEP:RETURN
31899  ' COMANDO PARE
31900 PNL=M.LN+1:RETURN
31999  ' COMANDO DESVIE
32000 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X1=VAL(RET$(I+1))
32010 IF X1<1 OR X1>M.LN THEN ERROR 108
32020 PNL=X1:RETURN
32099  ' COMANDO SE
32100 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X1=VAL(RET$(I+1))
32110 IF X1=0 THEN INI=21:FIM=23:GOSUB 19000:RETURN
32120 RETURN
32199  ' COMANDO INDEFINIDO 4
32200 RETURN
32299  ' COMANDO FIMSE
32300 RETURN
32399  ' COMANDO ENQUANTO
32400 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X1=VAL(RET$(I+1))
32410 IF X1=0 THEN INI=24:FIM=26:GOSUB 19000:RETURN
32420 ENQ=ENQ+1:ENQ$(ENQ)=PR1$:ENQ(ENQ)=PNL:RETURN
32499  ' COMANDO INDEFINIDO 5
32500 RETURN
32599  ' COMANDO FIMENQ
32600 IF ENQ=0 THEN ERROR 120
32605 I=I+1:ENT$(I)=ENQ$(ENQ):GOSUB 40000:X1=VAL(RET$(I+1))
32610 IF X1>0 THEN PNL=ENQ(ENQ):RETURN
32620 ENQ=ENQ-1:RETURN
32699  ' COMANDO CHAME
32700 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X1=VAL(RET$(I+1))
32710 IF X1<1 OR X1>M.LN THEN ERROR 108
32720 CHA=CHA+1:CHA(CHA)=PNL:PNL=X1:RETURN
32799  ' COMANDO RETORNE
32800 IF CHA=0 THEN ERROR 109
32810 PNL=CHA(CHA):CHA=CHA-1:RETURN
32899  ' COMANDO REPITA
32900 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X1=VAL(RET$(I+1))
32905 IF X1=0 THEN INI=29:FIM=30:GOSUB 19000:RETURN
32910 REP=REP+1:REPC(REP)=X1:REP(REP)=PNL:RETURN
32999  ' COMANDO FIMREP
33000 IF REP=0 THEN ERROR 118
33010 REPC(REP)=REPC(REP)-1:IF REPC(REP)>0 THEN PNL=REP(REP):RETURN
33020 REP=REP-1:RETURN
33099  ' COMANDO ABRASAI
33100 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X$=RET$(I+1)
33110 OPEN OU$,3,X$:RETURN
33199  ' COMANDO ABRAENT
33200 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X$=RET$(I+1)
33210 OPEN IN$,3,X$:RETURN
33299  ' COMANDO FECHE
33300 CLOSE#3:RETURN
33399  ' COMANDO LEIA
33400 LINE INPUT #3,X$
33410 X1=ASC(PR1$)-64:REGIST$(X1)=X$:RETURN
33499  ' COMANDO GRAVE
33500 I=I+1:ENT$(I)=PR1$:GOSUB 40000:X$=RET$(I+1)
33510 PRINT#3,X$:RETURN
33599  ' COMANDO PONHA
33600 I=I+1:ENT$(I)=PR1$:GOSUB 40000:XXXX$=RET$(I+1)
33610 I=I+1:ENT$(I)=PR2$:GOSUB 40000:X1=VAL(RET$(I+1))
33615 IF X1>99 THEN ERROR 124
33620 MEM$(X1)=XXXX$:RETURN
33699  ' COMANDO PEGUE
33700 X1=ASC(PR1$)-64
33710 I=I+1:ENT$(I)=PR2$:GOSUB 40000:X2=VAL(RET$(I+1))
33720 IF X2>99 THEN ERROR 124
33730 REGIST$(X1)=MEM$(X2):RETURN
39990 '********** AVALIA EXPRESSAO (RECURSIVA)
40000 GOSUB 41000:'**********AVALIA SINTAXE
40010 IF TP(I)=C.CST THEN GOSUB 42000:RET$(I)=RC$:I=I-1:RETURN
40020 IF TP(I)=C.REGIST THEN GOSUB 43000:RET$(I)=RR$:I=I-1:RETURN
40030 IF TP(I)<199   THEN GOSUB 40100:RETURN
40040 IF TP(I)<255   THEN GOSUB 40200:RETURN
40050 ERROR 101
40090 '********** FUNCAO
40100 I=I+1:ENT$(I)=P1$(I-1):GOSUB 40000
40110 P1$(I)=RET$(I+1):GOSUB 45000:RET$(I)=RP$:I=I-1:RETURN
40190 '********** OPERADOR
40200 I=I+1:ENT$(I)=P1$(I-1):GOSUB 40000:P1$(I)=RET$(I+1):TP(I)=TP(I)*TP(I+1)
40220 I=I+1:ENT$(I)=P2$(I-1):GOSUB 40000:P2$(I)=RET$(I+1)
40230 IF SGN(TP(I))<>TP(I+1) THEN ERROR 110
40240 GOSUB 47000:RET$(I)=RP$:I=I-1:RETURN
40990 '********** AVALIA SINTAXE
41000 A$=ENT$(I)
41010 IF LEN(A$)=1 AND VAL(A$)=0 AND A$<>"0" THEN TP(I)=2:ENT$(I)=CHR$(ASC(ENT$(I))+(ENT$(I)>"Z")*32):RETURN 
41025 FOR XX=1 TO 6:B$=MID$(OPER$,XX*2-1,2):PAR=0
41030   FOR X=LEN(A$) TO 1 STEP -1:P$=MID$(A$,X,1)
41050     IF P$="(" THEN PAR=PAR+1 
41060     IF P$=")" THEN PAR=PAR-1 
41080     IF INSTR(B$,P$) AND PAR=0 THEN 41500
41090   NEXT X:IF PAR<>0 THEN ERROR 105
41105 NEXT XX
41110 P$=MID$(A$,1,1):PAR=0
41120 IF P$<>"(" THEN P1$(I)=A$:P2$(I)="10":TP(I)=1:RETURN 
41130 FOR X=1 TO LEN(A$):P$=MID$(A$,X,1)
41140   IF P$="(" THEN PAR=PAR+1   
41160   IF P$=")" THEN PAR=PAR-1   
41170   IF P$=")" AND PAR=0 THEN 41200  
41180 NEXT X:ERROR 105
41200 P1$(I)=MID$(A$,2,X-2):P2$(I)=MID$(A$,X+1)
41220 IF VAL(P2$(I))>0 AND VAL(P2$(I))<17 THEN TP(I)=1:RETURN
41230 IF VAL(P2$(I))>16 THEN ERROR 107
41235 IF P2$(I)=NL$ THEN TP(I)=100:RETURN 
41250 UP$=P2$(I):GOSUB 19500:FUN$=UP$:X=INSTR(FUNC$,FUN$):IF X=0 THEN ERROR 108
41260 TP(I)=(X-1)\9+1:IF (X MOD 9<>1)AND X>0 THEN ERROR 108
41270 TP(I)=100+TP(I):RETURN
41500 K=INSTR(OPER$,P$):P1$(I)=LEFT$(A$,X-1):P2$(I)=MID$(A$,X+1)
41530 TP(I)=200+K:RETURN
41990 '********** AVALIA CONSTANTE
42000 A$=P1$(I):BAS=VAL(P2$(I))
42030 VALOR=0:DIG=-1:IF BAS=1 THEN RC$=A$:TP(I)=-1:RETURN
42070 FOR X=LEN(A$) TO 1 STEP -1:DIG=DIG+1:P$=MID$(A$,X,1)
42080   IF INSTR(17-BAS,TABHEX$,P$)=0 THEN ERROR 103:GOTO 42120
42100   Y=16-INSTR(TABHEX$,P$):VALOR=VALOR+Y*BAS^DIG
42101   IF VALOR>MAX THEN ERROR 6:GOTO 42120
42110 NEXT X
42120 RC$=FNS$(VALOR):TP(I)=1:RETURN
42990 '********** AVALIA REGISTISTRADOR
43000 X=ASC(ENT$(I)):IF X<65 OR X>90 THEN ERROR 102:RETURN
43010 IF X-64>12 THEN TP(I)=-1 ELSE TP(I)=1
43020 RR$=REGIST$(X-64):RETURN
44990 '********** CALCULA FUNCAO
45000 P1$=P1$(I):P2$=P2$(I):TP=TP(I+1)
45005 ON TP(I)-99 GOSUB 45100,45110,45120,45130,45140,45150,45160,45170,45180,45190,45200
45010 RETURN
45100 RP$=P1$:TP(I)=TP:RETURN
45110 IF TP=-1 THEN ERROR 110
45115 RP$=FNS$(INT(SQR(VAL(P1$)))):TP(I)=1:RETURN
45120 IF TP=1  THEN ERROR 110
45125 RP$=CHR$(15)+P1$+CHR$(14):TP(I)=-1:RETURN
45130 IF TP=-1 THEN ERROR 110
45135 RP$=CHR$(VAL(P1$)):TP(I)=-1:RETURN
45140 IF TP=1  THEN ERROR 110
45145 RP$=FNS$(INT(ASC(P1$))):TP(I)=1:RETURN
45150 TP(I)=1:IF CMP=1 THEN RETURN
45151 IF EOF(3) THEN RP$="1" ELSE RP$="0" 
45155 RETURN
45160 IF TP=-1 THEN ERROR 110
45165 RP$=FNS$(INT(RND(1)*VAL(P1$))+1):TP(I)=1:RETURN
45170 IF TP=1  THEN ERROR 110
45175 RP$=FNS$(LEN(P1$)):TP(I)=1:RETURN
45180 IF TP=1 THEN ERROR 110
45185 RP$=LEFT$(P1$,1):TP(I)=-1:RETURN
45190 IF TP=1 THEN ERROR 110
45195 RP$=MID$(P1$,2):TP(I)=-1:RETURN
45200 TP(I)=1:IF CMP=1 THEN RETURN
45203 OPEN RN$,2,P1$:RP$=FNS$(LOF(2)):CLOSE#2
45206 IF VAL(RP$)=0 THEN KILL P1$
45208 RETURN
46990 '********** CALCULA OPERADOR (OPERA)
47000 P1$=P1$(I):P2$=P2$(I):TP=SGN(TP(I)):TP(I)=ABS(TP(I))
47002 ON TP(I)-200 GOSUB 47210,47220,47230,47240,47250,47260
47005 IF TP(I)>206 THEN ON TP(I)-206 GOSUB 47110,47120,47130,47140,47150,47160
47010 IF TP(I)<212 AND VAL(RP$)>MAX THEN ERROR 6
47020 IF TP(I)<212 AND VAL(RP$)<0 THEN ERROR 123
47030 RETURN
47110 IF TP=-1 THEN ERROR 110
47115 RP$=FNS$(VAL(P1$)+VAL(P2$)):TP(I)=1:RETURN
47120 IF TP=-1 THEN ERROR 110
47125 RP$=FNS$(VAL(P1$)-VAL(P2$)):TP(I)=1:RETURN
47130 IF TP=-1 THEN ERROR 110
47135 RP$=FNS$(VAL(P1$)*VAL(P2$)):TP(I)=1:RETURN
47140 IF TP=-1 THEN ERROR 110
47145 RP$=FNS$(VAL(P1$)/VAL(P2$)):TP(I)=1:RETURN
47150 IF TP=-1 THEN ERROR 110
47155 RP$=FNS$(VAL(P1$)^VAL(P2$)):TP(I)=1:RETURN
47160 IF TP= 1 THEN ERROR 110
47165 RP$=P1$+P2$:TP(I)=-1:RETURN
47210 IF TP=-1 THEN ERROR 110
47215 RP$=FNS$(VAL(P1$) OR VAL(P2$)):TP(I)=1:RETURN
47220 IF TP=-1 THEN ERROR 110
47225 RP$=FNS$(VAL(P1$) AND VAL(P2$)):TP(I)=1:RETURN
47230 RP$=FNS$(P1$=P2$):TP(I)=1:RETURN
47240 RP$=FNS$(P1$<>P2$):TP(I)=1:RETURN
47250 IF TP=-1 THEN RP$=FNS$(P1$>P2$):TP(I)=1:RETURN
47255 RP$=FNS$(VAL(P1$)>VAL(P2$)):TP(I)=1:RETURN
47260 IF TP=-1 THEN RP$=FNS$(P1$<P2$):TP(I)=1:RETURN
47265 RP$=FNS$(VAL(P1$)<VAL(P2$)):TP(I)=1:RETURN
62990 '********** ROTINA DE ERRO
63000 E$=CHR$(ERR):IF INSTR(OK$,E$) AND CMP=1 THEN RESUME NEXT
63009 E=ERR:N.ERR=N.ERR+1:LN.ERR=1:PRINT TAB(5+IDT*3);"*** erro *** ";
63010 IF CMP=0 OR E<100 THEN PRINT "fatal *** ";
63020 GET #1,E:PRINT ER$
63440 IF CMP=1 AND E>99 THEN RESUME NEXT
64000 GET 1,129:ULT=VAL(ER$):IF E>0 THEN GET 1,E ELSE LSET ER$=""
64050 REGIST=(ULT MOD 128)+130
64055 ARQ$=MID$(ARQ$,2):P=INSTR(ARQ$,"."):IF P>0 THEN ARQ$=LEFT$(ARQ$,P-1)
64060 LSET ER$=FNS$(N.ERR)+" "+FNS$(N.CMD)+" "+ARQ$+" "+ER$
64070 PUT 1,REGIST
64080 LSET ER$=STR$(ULT+1):PUT 1,129
64090 PRINT:PRINT "Final de execucao"
64100 END

Comments

  • Anonymous
    June 06, 2016
    Hello Mr. Barreto. Congratulations for this post. As you have a long time experience with Microsoft Products I would like to suggest you some post about Microsoft Products; specially about Windows Server and Database family. Regards !