Herramientas de usuario
es:basic:qbasic:csembl
CSEMBL es un programa qbasic que toma un listado en ensamblador y utiliza debug.exe para sustituir las etiquetas por referencias a la dirección en memoria de la etiqueta.
- Las referencias se marcan entre signos de porcentaje: %etiqueta%
- Las etiquetas se marcan con dos puntos al principio de línea, así: :etiqueta.
Ejemplo:
ORG 100 JMP %salto% :variable DB 90 90 :salto MOV BX, word ptr [%variable%]
Produce:
100 ORG 100 100 JMP 103 101 DB 90 90 103 MOV BX, [101]
Puede ver ejemplos de programas en csembler_y_programas_relacionados
A continuación aparece el listado en QBASIC:
'Cutressembler.
'M¢dulo pseudo-ensamblador
'Historia
'Versi¢n 1: 22/10/94 10:08
'Versi¢n 2: 16/10/95 ----- A¤adido TLTRIM$
'Versi¢n 3: 02/11/95 ----- A¤adida macro "#&" (especificar comando debug)
' 04/11/95 ----- A¤adida sustituci¢n anti-error de los LOOP.
'Versi¢n 4: 02/12/96 ----- A¤adida lectura de nombre de archivos desde entorno.
' 12/03/98 ----- Agrega la detecci¢n de "Error ^" a la de "^ Error"
' (soluciona la no detecci¢n de errores bajo ciertas
' versiones de DEBUG)
'' 18/07/98 ----- Soporta (creo) instrucciones como JMP %OFF1% + %OFF2%
DECLARE SUB Proponer (A$, B$, C$)
DECLARE FUNCTION NArch$ (A$)
DECLARE SUB SustituirDB (A$, PorEtiq!)
DECLARE SUB EjecDebug ()
DECLARE SUB LeeEtq2 ()
DECLARE SUB ProcLlamEtq (A$)
DECLARE SUB NuevaEtiq (LBL$, Ref$)
DECLARE SUB Salir ()
DECLARE FUNCTION PrSN! (A$)
DECLARE FUNCTION TRIM$ (A$)
DECLARE FUNCTION Inicia! (A$, B$)
DECLARE FUNCTION UTRIM$ (A$)
DECLARE SUB MSGERR (N!, A$, B$)
DECLARE FUNCTION DErrores! ()
DECLARE SUB Abrir (NArch$, Num%, Modo!, Descrip$)
DECLARE FUNCTION Posic! (LBL$)
DECLARE FUNCTION TLTRIM$ (A$)
DECLARE FUNCTION Evalua$ (A$)
COMMON Archivo$, Archivo2$, LlamCsembl
CLS
FILES
'Esto que sigue es una prueba.
'IF Archivo$ = "" THEN Archivo$ = "CSEMEJEM.PLO"
'IF Archivo2$ = "" THEN Archivo2$ = "h:\TMP0"
'IF Archivo3$ = "" THEN Archivo3$ = "h:\TMP1"
'Se acab¢ la prueba.
ETMP$ = ENVIRON$("TEMP"): IF RIGHT$(ETMP$, 1) <> "\" THEN ETMP$ = ETMP$ + "\"
A2M$ = "archivo de destino / primer archivo temporal"
A3M$ = "segundo archivo temporal"
' Esto se a¤ade el 2/12/96:
IF ENVIRON$("CSEMFILE") > "" THEN
Proponer Archivo$, ENVIRON$("CSEMFILE"), "archivo a procesar"
Abrir Archivo$, 1, 1, "archivo a procesar"
ELSE
'Esta l¡nea es lo £nico que hab¡a antes del 2/12/96:
Abrir Archivo$, 1, 1, "archivo a procesar"
END IF
IF Archivo2$ = "" THEN Proponer Archivo2$, ETMP$ + NArch$(Archivo$) + ".TMP", A2M$
Abrir Archivo2$, 2, 2, A2M$
IF Archivo3$ = "" THEN Proponer Archivo3$, ETMP$ + NArch$(Archivo$) + "2.TMP", A3M$
Abrir Archivo3$, 3, 2, A3M$
DIM SHARED Etiq$(500)
DIM SHARED RefE$(500)
PEtiq = 0
L = 0
PRINT #2, "a"
DO
L = L + 1
estado = 0
LINE INPUT #1, A$
IF MID$(TLTRIM$(A$), 1, 1) = ";" THEN A$ = ";" + TLTRIM$(A$): estado = 1
IF MID$(TLTRIM$(A$), 1, 1) = ":" THEN A$ = ";" + TLTRIM$(A$): estado = 1
IF TRIM$(A$) = "" THEN A$ = ";" + A$: estado = 1
'IF MID$(A$, 1, 2) = "#&" THEN STOP
IF estado = 0 THEN
ProcLlamEtq A$
END IF
'Modificaci¢n 2-11-95:
IF MID$(A$, 1, 2) = "#&" THEN
PRINT #2, ";" + A$
PRINT #2, ""
PRINT #2, Evalua$(MID$(A$, 3))
'Esto evita problemas si el comando es "#&a":
PRINT #2, ""
PRINT #2, "A"
ELSE
'Esto era lo original:
PRINT #2, A$
END IF
LOOP UNTIL EOF(1)
PRINT #2, "": PRINT #2, "q"
CLOSE 2: CLOSE 3
EjecDebug
'Lee los Valores de las etiquetas
LEEETQ:
Abrir Archivo2$, 2, 1, A2M$
Abrir Archivo3$, 3, 2, A3M$
DO UNTIL EOF(2)
LINE INPUT #2, A$
SEGYDESP$ = MID$(A$, 1, 9)
B$ = MID$(A$, 10)
'Modificaci¢n (16/10/95) para evitar convertir a may£sculas
'los mensajes literales y los comentarios:
B2$ = UCASE$(LEFT$(TLTRIM$(B$), 2))
IF B2$ <> "DB" AND B2$ <> ";;" AND B2$ <> "DW" THEN
C$ = UTRIM$(B$) 'Esto es lo que hab¡a antes
ELSE
C$ = B2$ + MID$(TLTRIM$(B$), 3) 'Esta posibilidad es nueva
END IF
'Fin de la modificaci¢n
IF MID$(C$, 1, 2) = ";:" THEN NuevaEtiq MID$(C$, 3), SEGYDESP$
'N¢tese que en la l¡nea anterior no se evita que las etiquetas sigan como
'comentarios, sino que siguen igual, para posteriores ejecuciones en
'debug.
PRINT #3, C$
LOOP
CLOSE 2: CLOSE 3
'Cambia las etiquetas por su valor.
SustitEtq:
Abrir Archivo2$, 2, 2, A2M$
Abrir Archivo3$, 3, 1, A3M$
PRINT #2, "a"
DO UNTIL EOF(3)
LINE INPUT #3, C$
IF MID$(C$, 1, 1) = ";" THEN
C$ = MID$(C$, 2)
'Si era un comentario o una etiqueta se restaura el punto y coma
'adicional, para posteriores iteraciones.
IF MID$(C$, 1, 1) = ";" OR MID$(C$, 1, 1) = ":" THEN C$ = ";" + C$
'Si se trata de una l¡nea convertida en comentario para el proceso
'por DEBUG, tras quitar el punto y coma quita la l¡nea siguiente.
IF MID$(C$, 1, 1) <> ";" AND INSTR(C$, "%") > 0 THEN LINE INPUT #3, F$: F$ = ""
END IF
I = INSTR(C$, "%")
'Lo que sigue evita que se procesen como etiquetas los comentarios.
IF MID$(UTRIM$(C$), 1, 1) = ";" THEN I = 0
IF I > 0 THEN
PRINT #2, ";" + C$ 'Vuelve a poner la l¡nea como comentario,
'aunque ponga debajo la "traducci¢n".
IF Inicia(C$, "DB") OR Inicia(C$, "DW") THEN
SustituirDB C$, -1
ELSE
'Quizabucle: 'Etiq. Puesta el 18/7/98
I2 = INSTR(I + 1, C$, "%")
IF I2 < 0 THEN MSGERR L, C$, "Llamada a etiqueta sin cierre derecho.": Salir
EBUSC$ = MID$(C$, I + 1, I2 - 1 - I)
P = Posic(EBUSC$)
IF P = -1 THEN
PRINT "ATENCIàN: Etiqueta no encontrada:"; EBUSC$: ETNOENC = -1
SLEEP 0
ELSE
C1 = Inicia(UTRIM$(A$), "JMP FAR") AND INSTR(A$, "[") = 0
C2 = Inicia(UTRIM$(A$), "CALL FAR") AND INSTR(A$, "[") = 0
IF C1 OR C2 THEN Sustit$ = RefE$(P) ELSE Sustit$ = MID$(RefE$(P), 6, 9)
END IF
C$ = MID$(C$, 1, I - 1) + Sustit$ + MID$(C$, I2 + 1)
' 'Modificaci¢n 18/7/98:
' I = INSTR(I2 + 1, C$, "%")
' IF I > 0 THEN GOTO Quizabucle
' 'Fin modif
END IF
END IF
'Modificaci¢n 2-11-95:
IF MID$(C$, 1, 2) = "#&" THEN
PRINT #2, ";" + C$
PRINT #2, ""
PRINT #2, Evalua$(MID$(C$, 3))
PRINT #2, ""
PRINT #2, "A"
'Modificaci¢n del 2-12-96:
'Elimina las dos l¡neas siguientes a ";#&x..":
LINE INPUT #3, BASURA$
LINE INPUT #3, BASURA$
ELSE
'Esto era lo original:
IF UTRIM$(C$) <> "" THEN PRINT #2, C$: 'PRINT "Escribiendo:"; SPC(8); C$
END IF
LOOP
PRINT #2, "": PRINT #2, "q"
CLOSE 2: CLOSE 3
'Segunda iteraci¢n:
'Resuelve posibles problemas de llamada a etiquetas lejanas o de casos de
'JMP NEAR que no se hayan especificado como tales sino como JMP.
SegundaIter:
IF NIter = 0 THEN NIter = 2 ELSE NIter = NIter + 1
EjecDebug
RepetirIte = 0
LeeEtq2
IF RepetirIte THEN GOTO SustitEtq
'Finaliza:
PRINT "Compilaci¢n de etiquetas terminada."
'Copia #3 en #2
Abrir Archivo2$, 2, 2, A2M$
Abrir Archivo3$, 3, 1, A3M$
PRINT #2, "a"
DO UNTIL EOF(3)
LINE INPUT #3, C$
'Modificaci¢n 2-11-95:
IF MID$(C$, 1, 3) = ";#&" THEN
'Esta condici¢n se agreg¢ el 20/07/98:
'(Ambas, macros con etiquetas y la resoluci¢n de sus etiquetas,
'van precedidas de un s¢lo punto y coma. Esto las distingue:)
IF INSTR(C$, "%") = 0 THEN
PRINT #2, C$
PRINT #2, ""
PRINT #2, Evalua$(MID$(C$, 4))
PRINT #2, ""
PRINT #2, "A"
END IF
ELSE
'Esto era lo original
IF C$ > "" THEN PRINT #2, C$
END IF
'
LOOP
PRINT #2, ""
GRCOM = PrSN("¨Proceder a la grabaci¢n en modo ejecutable?")
IF GRCOM THEN
INPUT "¨Longitud estimada? (HEX)"; L$
L$ = TLTRIM$(L$)
DO WHILE MID$(L$, 1, 1) = "0"
L$ = MID$(L$, 2)
LOOP
IF LEN(L$) > 8 THEN
PRINT "Longitud excesiva, reducida a FFFFFFFF": L$ = "FFFFFFFF"
END IF
IF LEN(L$) > 4 THEN
L2$ = MID$(L$, 1, LEN(L$) - 4)
L$ = RIGHT$(L$, 4)
PRINT #2, "RBX"
PRINT #2, L2$
END IF
PRINT #2, "RCX"
PRINT #2, L$
INPUT "¨Cu l ser el nombre del archivo ejecutable?"; NEjec$
IF PrSN("¨Cargar un archivo ejecutable como base para el actual?") THEN
INPUT "Entre el nombre del archivo base:"; NEjBase$
END IF
PRINT #2, "n" + NEjec$
PRINT #2, "W"
END IF
PRINT #2, "q"
CLOSE 2: CLOSE 3
IF GRCOM THEN
A$ = "DEBUG " + NEjBase$ + " < " + Archivo2$
PRINT "Pulse cualquier tecla para ejecutar:": PRINT A$
DO: LOOP UNTIL INKEY$ > ""
SHELL A$
END IF
Salir
END
'Procesa los errores, especialmente aquellos derivados del control de ficheros.
ControlErrores:
EACT = ERR
SELECT CASE EACT
CASE 53, 52, 70, 75, 76, 64
SELECT CASE EACT
CASE 53: PRINT "El archivo no se encontr¢."
CASE 52, 64: PRINT "Nombre de archivo incorrecto."
CASE 70: PRINT "Permiso denegado."
CASE 75: PRINT "Error de acceso en ruta o archivo."
CASE 76: PRINT "Ruta de acceso no encontrada."
END SELECT
Arch$ = "": RESUME NEXT
CASE 24, 25, 68, 69: PRINT "ERROR DE DISPOSITIVO E/S": END
CASE 61: PRINT "ERROR: DISCO LLENO": END
CASE 71
PRINT "El disquete no est listo."
IF NOT AbriendoArc THEN
PRINT "Reinserte EL MISMO disquete en la unidad y pulse espacio."
PRINT "AVISO: Si insertase un disquete distinto podr¡a perder datos del nuevo disco"
DO: LOOP UNTIL INKEY$ = " ": RESUME
ELSE
PRINT "Inserte el disquete en la unidad y pulse espacio,"
PRINT "o pulse 'INTRO' para cambiar el nombre del archivo."
DO: IN$ = INKEY$: LOOP UNTIL IN$ = " " OR IN$ = CHR$(13)
IF IN$ = " " THEN RESUME ELSE Arch$ = "": RESUME NEXT
END IF
END SELECT
PRINT "ERROR desconocido:"; EACT: STOP
RESUME NEXT
SUB Abrir (NArch$, Num%, Modo, Descrip$)
SHARED Arch$, AbriendoArc
AbriendoArc = -1
Arch$ = NArch$
ON ERROR GOTO ControlErrores
DO
IF Arch$ = "" THEN
PRINT "Entre el nombre del "; Descrip$: INPUT Arch$
END IF
SELECT CASE Modo
CASE 1: OPEN Arch$ FOR INPUT AS Num%
CASE 2: OPEN Arch$ FOR OUTPUT AS Num%
END SELECT
LOOP WHILE Arch$ = ""
NArch$ = Arch$
ON ERROR GOTO 0
AbriendoArc = 0
END SUB
FUNCTION DErrores
DO
ReAnal:
DO UNTIL EOF(3)
LINE INPUT #3, A$
IF A$ > "" THEN EXIT DO
LOOP
''Modificaci¢n 2/11/95:
'IF LEFT$(A$, 2) = "- " THEN
' 'Comando debug como resultado de una llamada "#&":
' A$ = SPACE$(16) + "#&" + MID$(A$, 3)
'END IF
IF (TRIM$(A$) = "") OR (TRIM$(A$) = "-a") OR (TRIM$(A$) = "-q") THEN
IF NOT EOF(3) THEN B$ = A$: GOTO ReAnal ELSE EXIT DO
END IF
EER = 0
'Modificaci¢n 12/03/98:
'Agrega la detecci¢n de "Error ^" a la de "^ Error"
Otroerror = LEFT$(LTRIM$(A$), 5) = "Error"
IF Otroerror THEN Otroerror = Otroerror AND (INSTR(A$, "^") > 0)
'(Creo que este tipo de indicaci¢n de error
'se da s¢lo en ciertas versiones de DEBUG)
IF TRIM$(A$) = "^ Error" OR Otroerror THEN
'Fin modificaci¢n 12/03/98
PRINT "Debug ha se¤alado un error:"
PRINT B$: PRINT A$
PRINT "[PULSE CUALQUIER TECLA PARA CONTINUAR]"
DO: LOOP UNTIL INKEY$ > ""
NErr = NErr + 1: EER = -1
END IF
B$ = A$
IF EER THEN A$ = SPACE$(9) + ";;" + A$
PRINT #2, A$
LOOP UNTIL EOF(3)
PRINT "Debug ";
IF NErr > 0 THEN PRINT "encontr¢"; NErr; ELSE PRINT "no encontr¢";
PRINT " errores. "
DErrores = NErr
END FUNCTION
SUB EjecDebug
SHARED NIter, Archivo2$, Archivo3$
IF NIter > 0 THEN PRINT "Comenzando"; NIter; "¦ iteraci¢n..."
PRINT : PRINT "Ejecutando debug...": PRINT
SHELL "DEBUG <" + Archivo2$ + " >" + Archivo3$
Abrir Archivo2$, 2, 2, A2M$
Abrir Archivo3$, 3, 1, A3M$
DErr = DErrores
IF DErr > 0 THEN
PRINT "Puede continuar o puede salir del m¢dulo compilador de CSEMBLER."
IF NIter = 0 THEN
PRINT "Recomendado: No continuar."
ELSE
PRINT "Si en la primera iteraci¢n no ha habido errores, los posibles errores podr¡an"
PRINT "deberse a un mal control de etiquetas que se corregir en las pr¢ximas"
PRINT "iteraciones. "
END IF
IF PrSN("¨Continuar?") = 0 THEN Salir
END IF
CLOSE 2: CLOSE 3
END SUB
'Funci¢n creada para evaluar expresiones en la ejecuci¢n de comandos
'debug (macro #&nombre_comando).
'Convierte cualquier expresi¢n entre par‚ntesis en su valor.
'No se procesan expresiones fuera de par‚ntesis para evitar procesar
'comandos o m£ltiples par metros como parte de una misma operaci¢n.
'USA NOTACIàN POLACA INVERSA ("RPN")
'Implementado el 2/11/95
FUNCTION Evalua$ (A$)
'EVADEBUG = -1
DIM pila(50)
B$ = A$
I = 0
DO
I = INSTR(I + 1, B$, "(")
IF I > 0 THEN
I2 = INSTR(I + 1, B$, ")")
IF I2 = 0 THEN
PRINT "Evalua: Error: No hay par‚ntesis de cierre en la expresi¢n:"
Evalua$ = B$: EXIT FUNCTION
END IF
Operacion$ = ""
numero$ = ""
puntero = -1
FOR F = I + 1 TO I2 - 1
IF EVADEBUG THEN
PRINT "Op="; Operacion$; " Num="; numero$; " Lin="
PRINT B$: LOCATE CSRLIN - 1, F - 1: COLOR 7, 1: PRINT F$: COLOR 7, 0
END IF
F$ = UCASE$(MID$(B$, F, 1))
SELECT CASE F$
CASE "0" TO "9", "A" TO "F"
IF Operacion$ = "" THEN
numero$ = numero$ + F$
ELSEIF (Operacion$ = "+" OR Operacion$ = "-") AND numero$ = "" THEN
numero$ = Operacion$ + F$
Operacion$ = ""
ELSE
GOSUB EvaluaAlmacenar
GOSUB EvaluaCalcular
END IF
CASE " "
GOSUB Evaluafinpalabra
CASE "+", "-", "*", "/"
Operacion$ = Operacion$ + F$
END SELECT
IF EVADEBUG THEN
PRINT "Pila=";
FOR g = 0 TO puntero: PRINT pila(g); : NEXT: PRINT
SLEEP 0
END IF
NEXT F
GOSUB Evaluafinpalabra
IF puntero > 0 THEN PRINT "Aviso: Evalua: Sobran elementos en la pila."
fin$ = RIGHT$(B$, LEN(B$) - I2)
IF I = 1 THEN I = 2
B$ = LEFT$(B$, I - 1)
FOR F = 0 TO puntero
resultado = pila(F)
B$ = B$ + " " + HEX$(resultado)
NEXT F
B$ = B$ + fin$
END IF
LOOP WHILE I > 0
Evalua$ = B$
EXIT FUNCTION
Evaluafinpalabra:
IF Operacion$ > "" THEN
IF numero$ > "" THEN
GOSUB EvaluaAlmacenar
GOSUB EvaluaCalcular
ELSE
GOSUB EvaluaCalcular
END IF
ELSE
IF numero$ > "" THEN GOSUB EvaluaAlmacenar
END IF
RETURN
EvaluaAlmacenar:
IF numero$ = "" THEN RETURN
signo = 1
IF MID$(numero$, 1) = "+" THEN
signo = 1
numero$ = MID$(numero$, 2)
ELSEIF MID$(numero$, 1) = "-" THEN
signo = -1
numero$ = MID$(numero$, 2)
END IF
puntero = puntero + 1
IF puntero > 50 THEN PRINT "Error: Evalua: Desbordamiento de pila"
pila(puntero) = signo * VAL("&h" + numero$)
numero$ = ""
RETURN
EvaluaCalcular:
SELECT CASE Operacion$
CASE "+"
IF puntero < 1 THEN GOTO EvaluaStakUnder
pila(puntero - 1) = pila(puntero - 1) + pila(puntero)
puntero = puntero - 1
CASE "-"
IF puntero < 1 THEN GOTO EvaluaStakUnder
pila(puntero - 1) = pila(puntero - 1) - pila(puntero)
puntero = puntero - 1
CASE "*"
IF puntero < 1 THEN GOTO EvaluaStakUnder
pila(puntero - 1) = pila(puntero - 1) * pila(puntero)
puntero = puntero - 1
CASE "/"
IF puntero < 1 THEN GOTO EvaluaStakUnder
pila(puntero - 1) = pila(puntero - 1) / pila(puntero)
puntero = puntero - 1
CASE "<"
IF puntero < 1 THEN GOTO EvaluaStakUnder
pila(puntero - 1) = pila(puntero - 1) < pila(puntero)
puntero = puntero - 1
CASE ">"
IF puntero < 1 THEN GOTO EvaluaStakUnder
pila(puntero - 1) = pila(puntero - 1) > pila(puntero)
puntero = puntero - 1
CASE "<=", "=<"
IF puntero < 1 THEN GOTO EvaluaStakUnder
pila(puntero - 1) = pila(puntero - 1) <= pila(puntero)
puntero = puntero - 1
CASE ">=", "=>"
IF puntero < 1 THEN GOTO EvaluaStakUnder
pila(puntero - 1) = pila(puntero - 1) >= pila(puntero)
puntero = puntero - 1
CASE "="
IF puntero < 1 THEN GOTO EvaluaStakUnder
pila(puntero - 1) = pila(puntero - 1) = pila(puntero)
puntero = puntero - 1
CASE "!=", "<>", "><"
IF puntero < 1 THEN GOTO EvaluaStakUnder
pila(puntero - 1) = pila(puntero - 1) <> pila(puntero)
puntero = puntero - 1
CASE ELSE
PRINT "Evalua: Operando no implementado: "; Operacion$; " en:";
PRINT B$
END SELECT
Operacion$ = ""
RETURN
EvaluaStakUnder:
PRINT "Error Irrecuperable: Evalua: Datos agotados en pila."
END
END FUNCTION
FUNCTION Inicia (A$, B$)
C$ = UTRIM$(A$)
D$ = B$
L = LEN(D$)
IF MID$(C$, 1, L) = D$ THEN Inicia = -1: EXIT FUNCTION
IF INSTR(D$, " ") = 0 THEN Inicia = 0: EXIT FUNCTION
W$ = ""
'Evitar espacios duplicados...
FOR F = 1 TO LEN(D$)
M$ = MID$(D$, F, 1)
IF M$ <> " " THEN
W$ = W$ + MID$(D$, F, 1): ESP = 0
ELSE
IF ESP = 0 THEN W$ = W$ + " "
ESP = 1
END IF
NEXT
L = LEN(W$)
IF MID$(C$, 1, L) = W$ THEN Inicia = -1: EXIT FUNCTION
END FUNCTION
'Lee los Valores de las etiquetas para cerciorarse de que no se ha introducido
'ninguna nueva -cosa improbable- ni han cambiado los nombres de las existentes.
'
'Parcialmente modificado el 16/10/95
SUB LeeEtq2
SHARED RepetirIte, Archivo2$, Archivo3$
Abrir Archivo2$, 2, 1, A2M$
Abrir Archivo3$, 3, 2, A3M$
DO UNTIL EOF(2)
LINE INPUT #2, A$
SEGYDESP$ = MID$(A$, 1, 9)
B$ = MID$(A$, 10)
'Modificaci¢n (16/10/95) para evitar convertir a may£sculas
'los mensajes literales y los comentarios:
B2$ = UCASE$(LEFT$(TLTRIM$(B$), 2))
IF B2$ <> "DB" AND B2$ <> ";;" AND B2$ <> "DW" THEN
C$ = UTRIM$(B$) 'Esto es lo que hab¡a antes
ELSE
C$ = B2$ + MID$(TLTRIM$(B$), 3) 'Esta posibilidad es nueva
END IF
'Fin de la modificaci¢n
IF MID$(C$, 1, 2) = ";:" THEN
P = Posic(UTRIM$(MID$(C$, 3)))
IF P = -1 THEN
NuevaEtiq MID$(C$, 3), SEGYDESP$
RepetirIte = -1
PRINT "Encontada nueva etiqueta en una iteraci¢n secundaria."
END IF
r$ = RefE$(P)
IF TRIM$(SEGYDESP$) <> TRIM$(r$) THEN
RepetirIte = -1
PRINT C$; ": "; r$; " =>"; SEGYDESP$
RefE$(P) = TRIM$(SEGYDESP$)
END IF
END IF
PRINT #3, C$
LOOP
PRINT "Last line is: "; A$
CLOSE 2: CLOSE 3
END SUB
'Muestra mensaje de error sint ctico en archivo origen.
SUB MSGERR (N, A$, B$)
PLAY "D#32C16"
PRINT "ERROR en l¡nea "; N; ":"
PRINT A$
PRINT "Descripci¢n del error:"; B$
END SUB
'(comentario a¤adido el 2/12/96):
' Elimina la extensi¢n de un archivo
'Nuevo del 2/12/96:
' Elimina la ruta de un archivo (evita que se proponga una ruta extra¤a
'para el archivo temporal cuando el original incluye ruta).
FUNCTION NArch$ (A$)
'*** Comienzo de la adici¢n del 2/12/96
B$ = A$
I = INSTR(B$, ":")
IF I > 1 THEN B$ = MID$(B$, I + 1)
I = INSTR(B$, "\")
WHILE I > 0
B$ = MID$(B$, I + 1)
I = INSTR(B$, "\")
WEND
'*** Lo que sigue estaba antes (cambiado solamente "A$" por "B$")
I = INSTR(B$, ".")
IF I > 1 THEN NArch$ = LEFT$(B$, I - 1): EXIT FUNCTION
IF I = 1 THEN NArch$ = "": EXIT FUNCTION
NArch$ = B$
END FUNCTION
SUB NuevaEtiq (LBL$, Ref$)
SHARED PEtiq
LBL$ = UTRIM$(LBL$)
'PRINT "A¥ADIR ETIQUETA:"; LBL$; " ÍÍÍ "; Ref$
'IF Posic(LBL$) > -1 THEN PRINT "NO SE HA A¥ADIDO LA ETIQUETA:"; LBL$: EXIT SUB
Etiq$(PEtiq) = LBL$
RefE$(PEtiq) = Ref$
FOR F = PEtiq TO 1 STEP -1
IF Etiq$(F) < Etiq$(F - 1) THEN
SWAP Etiq$(F), Etiq$(F - 1)
SWAP RefE$(F), RefE$(F - 1)
ELSE
EXIT FOR
END IF
NEXT
PEtiq = PEtiq + 1
'PRINT "A¥ADIDA ETIQUETA:"; LBL$
END SUB
FUNCTION Posic (LBL$)
SHARED PEtiq
LBL$ = UTRIM$(LBL$)
MX = PEtiq
MN = 0
'PRINT "Buscando etiqueta:"; LBL$
DO
I = MN + INT((MX - MN) / 2)
'PRINT USING "M¡nimo: ### M ximo: ### Actual:### (&)"; MN; MX; I; Etiq$(I)
IF I < 0 THEN EXIT DO
Etiq$(I) = UTRIM$(Etiq$(I))
IF Etiq$(I) = LBL$ THEN Posic = I: EXIT FUNCTION
IF Etiq$(I) < LBL$ THEN MN = I + 1
IF Etiq$(I) > LBL$ THEN MX = I - 1
LOOP UNTIL MX < MN
Posic = -1
END FUNCTION
'Averigua si en la l¡nea existe un llamado a etiqueta. Si lo hay, procesa
'adecuadamente la l¡nea.
'Asume: A$-> L¡nea a procesar. #2-> Archivo de destino.
SUB ProcLlamEtq (A$)
I = INSTR(A$, "%")
IF I > 0 THEN
I2 = INSTR(I + 1, A$, "%")
IF I2 <= 0 THEN
MSGERR L, A$, "Llamada a etiqueta sin cierre derecho.": Salir
ELSE
IF INSTR(I2 + 1, A$, "%") > 0 AND NOT (Inicia(A$, "DB") OR Inicia(A$, "DW")) THEN
''Modificado el 18/7/98 para permitir suma de etiquetas.
' SustituirDB A$, 0
''Fin modificaci¢n
'Original:
MSGERR L, A$, "Doble llamada a etiqueta o llamada a etiqueta mal escrita."
Salir
'Fin original
END IF
Z$ = ";" + A$: PRINT #2, Z$
A$ = UCASE$(A$)
NOOTRO = -1
IF Inicia(A$, "DB") OR Inicia(A$, "DW") THEN NOOTRO = 0: SustituirDB A$, 0
IF INSTR(A$, "[") > 0 AND NOOTRO THEN GOSUB Sustituircero
IF Inicia(A$, "JMP FAR") AND NOOTRO THEN GOSUB Sustituircero
IF (Inicia(A$, "JMP NE") OR Inicia(A$, "JMP NEAR")) AND NOOTRO THEN
A$ = "DB 90 90 90"
NOOTRO = 0
END IF
IF (MID$(UTRIM$(A$), 1, 1) = "J") AND NOOTRO THEN A$ = "DB 90 90": NOOTRO = 0
'A¤adido el 4 de noviembre de 1995
IF (MID$(UTRIM$(A$), 1, 4) = "LOOP") AND NOOTRO THEN A$ = "DB 90 90": NOOTRO = 0
IF NOOTRO THEN GOSUB Sustituircero
END IF
END IF
EXIT SUB
Sustituircero:
E$ = MID$(A$, 1, I - 1) + " "
E$ = E$ + "0000 "
E$ = E$ + MID$(A$, I2 + 1)
A$ = E$
NOOTRO = 0
END SUB
SUB Proponer (A$, B$, C$)
PRINT "Entre el nombre del "; C$; "("; B$; ")"
INPUT D$
IF D$ = "" THEN A$ = B$ ELSE A$ = D$
END SUB
FUNCTION PrSN (A$)
PRINT A$; " (S/N)"; : LOCATE CSRLIN, POS(0), 1
DO
I$ = INKEY$
SELECT CASE I$
CASE "S", "s", "Y", "y": PrSN = -1: EXIT DO
CASE "N", "n": PrSN = 0: EXIT DO
END SELECT
LOOP
LOCATE , , 0: PRINT
END FUNCTION
SUB Salir
SHARED LlamCsembl
RESET
IF LlamCsembl THEN CHAIN "CsemMain"
IF PrSN("¨Salir a DOS?") THEN SYSTEM ELSE END
END SUB
'Se encarga del control de las sustituciones en las instrucciones DB y DW.
'NUEVO: 16/10/95: Tras las nuevas modificaciones, pueden llegar aqu¡ etiquetas
'en su forma en min£sculas.
'En realidad, el propio sistema de b£squeda de etiquetas convierte etiquetas
'a may£sculas (no hay que tomar medidas de precauci¢n).
SUB SustituirDB (A$, PorEtiq)
IF INSTR(A$, "%") = 0 THEN EXIT SUB
'C = CSRLIN: IF C = 25 THEN PRINT : C = C - 1
FOR F = 1 TO LEN(A$)
'LOCATE C, 1: PRINT A$
'LOCATE C + 1, F: PRINT "^"
'IF EtqAbier THEN LOCATE C + 1, UltAbier: PRINT "^%"
SELECT CASE MID$(A$, F, 1)
CASE CHR$(34)
ComillasAbier = NOT ComillasAbier
IF ComillasAbier AND EtqAbier THEN MSGERR -1, A$, "Signo '%' fuera de comillas."
CASE "%"
IF NOT ComillasAbier THEN
IF EtqAbier THEN
Etq$ = MID$(A$, UltAbier + 1, F - (UltAbier + 1))
IF PorEtiq THEN
P = Posic(Etq$)
IF P = -1 THEN
MSGERR -1, A$, "Etiqueta no encontrada. (" + Etq$ + ")"
Sustit$ = "0000"
ELSE
Sustit$ = MID$(RefE$(P), 6, 4)
END IF
ELSE
Sustit$ = "0000"
END IF
IF UltAbier > 1 THEN E1$ = MID$(A$, 1, UltAbier - 1) ELSE E1$ = ""
IF Inicia(A$, "DB") THEN
IF LEN(Sustit$) < 4 THEN Sustit$ = RIGHT$("0000" + UTRIM$(Sustit$), 4)
E$ = E1$ + RIGHT$(Sustit$, 2) + " " + LEFT$(Sustit$, 2) + " "
ELSE
E$ = E1$ + Sustit$
END IF
A$ = E$ + MID$(A$, F + 1)
'Cambia la posici¢n del acumulador del bucle:
F = LEN(E$)
ELSE
UltAbier = F
END IF
EtqAbier = NOT EtqAbier
END IF
END SELECT
NEXT
END SUB
'Como LTRIM$, pero tambi‚n reconoce los tab.
'Evita la necesidad de Proccom.bas
'Implementado el 16/10/1995
FUNCTION TLTRIM$ (A$)
W$ = LTRIM$(A$)
WHILE LEFT$(W$, 1) = CHR$(9)
W$ = LTRIM$(MID$(LTRIM$(W$), 2))
WEND
TLTRIM$ = W$
END FUNCTION
FUNCTION TRIM$ (A$)
TRIM$ = TLTRIM$(RTRIM$(A$))
END FUNCTION
FUNCTION UTRIM$ (A$)
UTRIM$ = UCASE$(TRIM$(A$))
END FUNCTION
es/basic/qbasic/csembl.txt · Última modificación: 2014/03/02 12:40 por nepenthes
Herramientas de la página
Excepto donde se indique lo contrario, el contenido de este wiki esta bajo la siguiente licencia: CC Attribution-Noncommercial-Share Alike 4.0 International
