{{ :es:basic:qbasic:pantallazo_csembl_1.png?300|}}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:
<code>
ORG 100
JMP %salto%
:variable
DB 90 90
:salto
MOV BX, word ptr [%variable%]
</code>{{ :es:basic:qbasic:pantallazo_csembl_2.png?300|}}

Produce:
<code lang=asm>
100 ORG 100
100 JMP 103
101 DB 90 90
103 MOV BX, [101]
</code>

Puede ver ejemplos de programas en [[csembler_y_programas_relacionados]]

A continuación aparece el listado en QBASIC:

<code lang=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

</code>