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.
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