Код:
; 00021
.INCLUDE "LB:[MACROS]MACROS.MAC"
MODULE CommonUCS, MNAME=CUCS, VER=03, LIBR=YES, COMM=<Common User Code Set>
.REM %
------------------------------------------------------------
| Copyrigth (c) 1994 by WAS, Saratov, Russia. |
| All rights reserved. |
------------------------------------------------------------
Автор: Хунта, г. Саратов, 9 января 1994 г.
Функция: перекодировка ASCII в другие кодировки
в текстовых файлах.
Замечание: в случае ошибок в операциях OPEN, GET, PUT
или CLOSE для вывода сообщений об ошибках
используется программа "МО".
Сама программа, а также ее исходный текст
могут быть получены у автора (г. Саратов).
Изменения: 6 мая 1988 г. - исходная версия V01.01
28 июня 1988 г. - добавлен код для V01.02
multi-buffering FCS-11
20 декабря 1988 г. - добавлено использование VX0103
big-buffering FCS-11
9 января 1994 г. - common версия: WAS.02
15 января 1994 г. - добавлена возможность WAS.03
коммандной строки в виде
file1=file2
%
; Variants
;
; MBF = 1 - один буфер для файла
; MBF >= 2 - n буферов для файла
; (только для FCS-11 с поддержкой multi-buffering)
;
MBF=2.
;
; OBS = 1 - 512.-ти байтный буфер
; OBS >= 2 - n*512.-ти байтный буфер
; (только для FCS-11 с поддержкой big-buffering)
;
OBS=20.
;
; E$GCML = 0 - использовать стандартный GCML
; E$GCML = 1 - использовать расширенный GCML
;
E$GCML=0
;;;;
.IIF NDF MBF MBF=1
.IIF LE MBF-1 MBF=1
.IIF NDF OBS OBS=1
.IIF LE OBS-1 OBS=1
.IIF NDF E$GCML E$GCML=0
;;;;
FROM SYSMAC IMPORT DIR$, ALUN$, QIOW$
FROM SYSMAC IMPORT GREG$S, EXTK$S, SDRC$S, STSE$S, WSIG$S
FROM SYSMAC IMPORT FCSMC$, FCSBT$, FDOF$L, FSROF$
.IIF EQ E$GCML FROM SYSMAC IMPORT GCMLD$, GCMLB$, GCML$
.IIF NE E$GCML FROM SYSMAC IMPORT EGCMI$
FROM SYSMAC IMPORT CSI$, CSI$1, CSI$2
FROM SYSLIB.QIOSYM IMPORT IE.UPN, IE.EOF, TF.CCO
FROM SYSLIB.VCTDF IMPORT $DSW, .FSRPT
FROM SYSLIB.FCSTYP IMPORT .FCTYP
FROM SYSLIB.RQLCB IMPORT $RLCB
FROM MAIN IMPORT $CTAB
;;;;
EXPORT QUALIFIED CUCS
;;;;
MAXD = 1 ; макс. вложенность ККФ
CLUN = 1 ; lun ввода комманд
ILUN = 2 ; lun входного файла
OLUN = 3 ; lun выходного файла
MXRLEN = 256. ; макс. длина строки в файле
FCSMC$
FCSBT$
FDOF$L
FSROF$ DEF$L
.IIF NE E$GCML EGCMI$
GCMLD$
CSI$
;
; Constants
;
NBF1=3 ; simple version
NBF2=<OBS>*2+1 ; big only
NBF3=<MBF>*2+1 ; multi only
NBF4=<MBF*OBS>*2+1 ; big & multi-buffering FCS-11
SPSZ1=NBF1*<512.+S.BFHD>
SPSZ2=NBF2*<512.+S.BFHD>
SPSZ3=NBF3*<512.+S.BFHD>
SPSZ4=NBF4*<512.+S.BFHD>
FSRSZ$ 0
$PRINT
$IDATA
GREG:
INP:
BUF: .LIMIT
.=INP
.BLKB MXRLEN
.EVEN
PROCEDURE INIT
$PDATA
CALUN: ALUN$ CLUN, TI, 0
IALUN: ALUN$ ILUN, SY, 0
OALUN: ALUN$ OLUN, SY, 0
.IIF NE FT.BBF-2 .ERROR
.IIF NE FT.MBF-4 .ERROR
FCSTYP: .WORD SPSZ1 ; simple
.WORD SPSZ2 ; FT.BBF
.WORD SPSZ3 ; FT.MBF
.WORD SPSZ4 ; FT.BBF & FT.MBF
$IDATA
QINIT: .WORD 0
BEGIN
IF QINIT EQ #0 THEN
DIR$ #CALUN
DIR$ #IALUN
DIR$ #OALUN
MOV @#.FSRPT, R1
IF RESULT IS EQ THEN
BPT
END
IF A.DFUI(R1) EQ #0 THEN
FINIT$ ; инициализация FCS-11
END
CALL .FCTYP ; получить тип FCS-11
BIC #^C<FT.BBF!FT.MBF>, R1
.IIF NE FT.BBF-2 .ERROR
.IIF NE FT.MBF-4 .ERROR
MOV FCSTYP(R1), R1 ; сколько надо памяти
MOV INP+2, R2 ; конец задачи по построению
MOV #GREG, R3 ; получить размер задачи в памяти
GREG$S , R3 ; от Executive'а
MOV G.RGRS(R3), R3
ASH #6, R3 ; в байты
SUB R2, R3 ; сейчас свободно
SUB R3, R1 ; требуемое-имеемое
ADD #77, R1 ; выравнивание
ASH #-6, R1 ; в кол-во 100(8) байтных блоков
EXTK$S R1 ; расширить
MOV #GREG, R1 ; получить новый размер задачи
GREG$S , R1 ; от Executive'а
MOV G.RGRS(R1), R1 ; в R1
ASH #6, R1 ; в байты
SUB R2, R1 ; размер свободной памяти
MOV @#.FSRPT, R0 ; free memory listhead
CALL $RLCB ; отдать
INC QINIT ; инициализация проведена
END
RETURN
END INIT
PROCEDURE CALLMO
$PDATA
MO: .RAD50 /MO..../
BEGIN
SUB #11.*2, SP ; 11 пустых слов
MOV #3*400+1, R1 ; 3 - серьезность ошибки, 1 - ошибка директивы
IF R0 PL #0 THEN ; если R0 положительно, то
NEGB R0 ; сделать положительным байт
INC R1 ; а ошибка - ошибка в/в
ELSE ; иначе
NEG R0 ; сделать положительным слово
END ; все
PUSH R0 ; второе слово - код ошибки
PUSH R1 ; первое слово - тип ошибки
MOV SP, R1 ; указатель на буфер посылки
LOOP ; цикл
SDRC$S #MO, R1, #1 ; послать сообщение MO....
IF RESULT IS CC LEAVE LOOP ; если все в порядке - покинуть цикл
MOV @#$DSW, R0 ; код ошибки - в R0
IF R0 NE #IE.UPN THEN ; если код не "нехватка динамической памяти", то
BPT ; запрос отладчика (или завершить задачу)
END ; все
WSIG$S ; подождать важное событие
END ; и повторить
STSE$S #1 ; ждем вывода сообщения
ADD #13.*2, SP ; очистить стек
SEC ; была ошибка и вызов CALLMO
RETURN ; возврат
END CALLMO
PROCEDURE FIERR
BEGIN
MOV IFDB+F.ERR, R0
BR CALLMO
END FIERR
PROCEDURE OIERR
BEGIN
PRINT <CommonUCS -- Открытие входного файла:>
BR FIERR
END OIERR
PROCEDURE GIERR
BEGIN
PRINT <CommonUCS -- Прочитать из входного файла:>
BR FIERR
END GIERR
PROCEDURE FOERR
BEGIN
MOV OFDB+F.ERR, R0
BR CALLMO
END FOERR
PROCEDURE OOERR
BEGIN
PRINT <CommonUCS -- Открытие выходного файла:>
BR FOERR
END OOERR
PROCEDURE POERR
BEGIN
PRINT <CommonUCS -- Записать в выходной файл:>
BR FOERR
END POERR
$IDATA
CSIBLK: .BLKB C.SIZE
.EVEN
IFDB: FDBDF$
FDRC$A FD.PLC!FD.INS, BUF, MXRLEN
FDOP$A ILUN, CSIBLK+C.DSDS, DFNB
FDBF$A , OBS*512., MBF
DFNB: NMBLK$ TXT, TXT, 0, SY, 0
OFDB: FDBDF$
FDRC$A FD.INS
FDOP$A OLUN, CSIBLK+C.DSDS, DFNB
FDBF$A , OBS*512., MBF
PROCEDURE CSI1
BEGIN
CSI$2 #CSIBLK, OUTPUT ; взять выходной
IF RESULT IS CC THEN
FDBF$R #IFDB, , , ,#FD.RAH ; Multi-buffering для чтения
OPNS$R ; открыть входноя файл
IF RESULT IS CC THEN ; если все ок, то
MOV #IFDB+F.FNB, R0 ; скопировать FDB FNB входного файла
MOV #OFDB+F.FNB, R1 ; в FDB FNB выходного файла
THRU R2 := #S.FNBW ; длина FNB в словах
MOV (R0)+, (R1)+ ; пересылка
END
FDBF$R #OFDB, , , ,#FD.WBH ; Multi-buffering для записи
OPNS$M ; открытие по FID'у
IF RESULT IS CS THEN ; если есть ошибка, то
CLOSE$ #IFDB ; закрыть входной FDB
CALLR OOERR ; вызвать MO....
END ; с ошибкой открытия выходного файла
ELSE
CALLR OIERR ; вызвать MO....
END ; с ошибкой открытия входного файла
ELSE
PRINT <CommonUCS -- Ошибка CSI-2 на выходном файле>
SEC
END
RETURN
END CSI1
PROCEDURE CSI2
BEGIN
CSI$2 #CSIBLK, INPUT ; взять входной
IF RESULT IS CC THEN
FDBF$R #IFDB, , , ,#FD.RAH ; Multi-buffering для чтения
OPNS$R ; открыть входноя файл
IF RESULT IS CC THEN ; если все ок, то
CSI$2 #CSIBLK, OUTPUT ; взять выходной
IF RESULT IS CC THEN
FDBF$R #OFDB, , , ,#FD.WBH ; Multi-buffering для записи
FDAT$R , IFDB+F.RTYP, IFDB+F.RATT, IFDB+F.RSIZ
OPNS$W ; открыть выходноя файл
IF RESULT IS CS THEN ; если есть ошибка, то
CLOSE$ #IFDB ; закрыть входной FDB
CALLR OOERR ; вызвать MO....
END ; с ошибкой открытия выходного файла
ELSE
PRINT <CommonUCS -- Ошибка CSI-2 на выходном файле>
SEC
END
ELSE
CALLR OIERR ; вызвать MO....
END ; с ошибкой открытия входного файла
ELSE
PRINT <CommonUCS -- Ошибка CSI-2 на входном файле>
SEC
END
RETURN
END CSI2
PROCEDURE CSI
$ASCII
PRMPT: .ASCII <15><12>/CommonUCS>/
PRMP.L=.-PRMPT
$IDATA
GCML:
.IIF EQ E$GCML GCMLB$ MAXD, UCS, INP, CLUN, , MXRLEN
.IIF NE E$GCML GCML: ECMLB$ , CLUN, MAXD, UCS, INP, MXRLEN
BEGIN
CSI$1 #CSIBLK, GCML+G.CMLD+2, GCML+G.CMLD ; проверить синтаксис
IF RESULT IS CC THEN
IFB #CS.EQU OFF.IN CSIBLK+C.STAT THEN
CALL CSI1
ELSE
CALL CSI2
END
ELSE
PRINT <CommonUCS -- Ошибка синтаксиса коммандной строки>
SEC
END
RETURN
END CSI
PROCEDURE CUCS
BEGIN
CALL INIT
; MOVB #GE.COM!GE.IND!GE.SIZ, GCML+G.MODE ; умолчание
LOOP
GCML$ #GCML, #PRMPT, #PRMP.L ; получить коммандную строку
IF RESULT IS CS THEN ; если ошибка
IFB GCML+G.ERR NE #IE.EOF THEN ; и ошибка - не ^Z
PRINT <CommonUCS -- Ошибка получения коммандной строки>
END
RETURN
END
IF GCML+G.CMLD NE #0 THEN ; не пустая строка
CALL CSI
IF RESULT IS CC THEN
REPEAT
GET$ #IFDB ; очередная запись
IF RESULT IS CS THEN ; если ошибка
IFB IFDB+F.ERR NE #IE.EOF THEN ; и не eof
CALL GIERR ; вызвать MO....
END
SEC
ELSE
MOV IFDB+F.NRBD+2, R0 ; адрес записи
MOV IFDB+F.NRBD, R1 ; ее длина
MOV R0, R2 ; сохранить
MOV R1, R3 ; в R2 и R3
IF RESULT IS NE THEN ; пустая строка - ничего не делать
THRU R1 ; конвертирование
CLR R5
BISB (R0), R5
MOVB $CTAB(R5), (R0)+
END
END
PUT$ #OFDB, R2, R3 ; вывести в файл
IF RESULT IS CS THEN ; если ошибка
CALL POERR
END
END
UNTIL RESULT IS CS
CLOSE$ #IFDB
CLOSE$ #OFDB
END
END
END
END CUCS
END CommonUCS
.END
) так (приведённый пример под RSX, но аналогично можно и под RT):
Ответить с цитированием