Сообщение от
form
IORESULT - вроде фича всяких TP/BP/FPK (ну может и еще чья).
на одной из дискет для ДВК нашлось несколько мощных примеров :
Контроль Ошибок:
Код:
PROGRAM ERROR; (* ERROR PROCESSING *)
(*$T-,A- TURN OFF STACK OVERFLOW CHECKING IN CASE THAT WAS THE ERROR! *)
(*$E+ MAKE THIS AN EXTERNAL PROCEDURE DEFINITION
ДАННАЯ ПРОЦЕДУРА ЯВЛЯЕТСЯ ВНЕШНЕЙ *)
TYPE
ERRORTYPE = (FATAL, IOERROR, WARNING);
MESSAGE = ARRAY [1..100] OF CHAR;
PROCEDURE ERROR(CLASS:ERRORTYPE; ERRORNUMBER,ERRORMSGLENGTH:INTEGER;
VAR MSG:MESSAGE; VAR XFILE:TEXT; IOSTATUS,USERPC:INTEGER;
FILENAMELENGTH: INTEGER; VAR FILENAME: MESSAGE);
VAR I:INTEGER;
BEGIN
WRITELN;
CASE CLASS OF
WARNING: WRITE('WARNING: ');
IOERROR: WRITE('?I/O ERROR: ');
ELSE WRITE('?FATAL ERROR: ');
END;
WRITELN(MSG:ERRORMSGLENGTH);
IF CLASS=IOERROR THEN BEGIN
IF FILENAMELENGTH > 0 THEN
WRITELN(' FILENAME: "',FILENAME:FILENAMELENGTH,'"');
WRITELN(' I/O STATUS: ',IOSTATUS:1);
END;
WRITELN(' PROGRAM COUNTER: ',USERPC:-1);
END;
какой-то Интэррапт-же
Код:
(* INTRPT V1.2 --- INTERRUPT INITIALIZATION
ИНИЦИАЛИЗАЦИЯ ВЕКТОРА ПРЕРЫВАНИЯ *)
PROCEDURE INTERRUPT( VECTOR:INTEGER; PROCEDURE ROUTINE; PS:INTEGER);
VAR
PROTFAIL : BOOLEAN;
VECTORS ORIGIN 0B : ARRAY [0..100B] OF RECORD
TRAPADDR : INTEGER;
PROCESSORSTATUS : INTEGER;
END;
BEGIN
(*$C .MCALL .PROTECT
.GLOBL RTAREA, $USRPC, $RESR5
CLRB PROTFAIL(6)
.PROTECT #RTAREA,VECTOR(6)
ROLB PROTFAIL(6)
*) IF PROTFAIL THEN
WRITELN('VECTOR AT ',VECTOR:-1,' NOT AVAILABLE')
ELSE
BEGIN
WITH VECTORS[VECTOR DIV 4] DO
BEGIN
(*$C MOV VECTOR-4(6),@%3
*)(* TRAP := ROUTINEADDR; *)
PROCESSORSTATUS := PS;
END;
END;
END;
PROCEDURE SAVREG;
BEGIN
(*$C MOV %5,-(6)
MOV %4,-(6)
MOV %3,-(6)
MOV %2,-(6)
MOV %1,-(6)
MOV %0,-(6)
MOVB @#^O56,-(6)
MOV $USRPC,-(6)
MOV $RESR5,%5
JMP @16(6)
*)
END;
PROCEDURE RESREG;
BEGIN
(*$C TST (6)+
MOV (6)+,$USRPC
MOVB (6)+,@#^O56
MOV (6)+,%0
MOV (6)+,%1
MOV (6)+,%2
MOV (6)+,%3
MOV (6)+,%4
MOV (6)+,%5
TST (6)+
RTI
*)
END;
Работа с CSI - честно не понял - это обработка входящих параметров?
Код:
(* CSI V1.2 --- COMMAND STRING INTERPRETER (GENERAL) INTERFACE
ИНТЕРФЕЙС ДЛЯ РАБОТЫ С CSI *)
CONST
INMAX = 6; (* MAXIMUM NUMBER OF INPUT FILES *)
(* МАКСИМАЛЬНОЕ ЧИСЛО ВХОДНЫХ ФАЙЛОВ *)
TYPE
TSTRING = ARRAY [1..80] OF CHAR;
CSIEXTENSIONS = ARRAY [1..12] OF CHAR;
CSIDATA = RECORD
O1,O2,O3 : TEXT;
OFLAG1, OFLAG2, OFLAG3 : BOOLEAN;
INN : ARRAY [1..INMAX] OF TEXT;
IFLAG : ARRAY [1..INMAX] OF BOOLEAN;
SWITCHCOUNT : INTEGER;
SWITCH : ARRAY ['@'..'Z'] OF RECORD
GIVEN, ARGFOUND : BOOLEAN;
ARGVALUE : INTEGER;
END;
END;
FUNCTION CSI( STR:TSTRING; DEFEXTTEXT:CSIEXTENSIONS;
VAR CSIDAT:CSIDATA ) : BOOLEAN;
VAR
CHANSFREE, CSIVALUE : BOOLEAN;
C : CHAR;
I, N, CINDEX, RINDEX : INTEGER;
VAL : 0..65535;
DEFEXT : ARRAY [1..4] OF INTEGER;
FUNCTION WAITCHN( CHN : INTEGER ) : BOOLEAN;
VAR FLAG : BOOLEAN;
BEGIN
FLAG := TRUE;
(*$C .MCALL .WAIT
.WAIT CHN(6)
BCC 1$
CLRB FLAG(6)
1$: *)
WAITCHN := FLAG;
END;
PROCEDURE SETOPEN( VAR FIL:TEXT; CHN:INTEGER; RESETFLAG:BOOLEAN;
VAR RESULTFLAG:BOOLEAN );
CONST
STATTEXT = 200B; (* TEXT TYPE FILE (VS. BINARY RECORDS) *)
STATWRITE = 20B; (* FILE OPEN FOR WRITING *)
STATREAD = 10B; (* FILE OPEN FOR READING *)
STATSEEK = 4B; (* FILE IS RANDOM-ACCESS TYPE (SEEK ALLOWED) *)
STATSPAN = 2B; (* RECORDS SPAN BLOCK
BOUNDARIES (DOUBLE SIZE BUFFER) *)
BUFFERLEN = 512; (* SIZE OF FILE BUFFER IN BYTES *)
TYPE
BUFFER = ARRAY [1..BUFFERLEN] OF CHAR;
CHANBLOCK = RECORD
PTR : ^BUFFER;
STAT, DEV, NAME, NAM2, EXT, FSIZ, CHAN, BLOK: 0..65535;
BUFF : ^BUFFER;
BSIZ, HAND, REC : INTEGER;
DATA : ^BUFFER;
PER : INTEGER;
END;
VAR
CHNBLOCK : ^CHANBLOCK;
PTRFILE : RECORD CASE INTEGER OF
1: (P: ^CHANBLOCK);
2: (F: TEXT);
END;
BEGIN
RESULTFLAG := WAITCHN(CHN);
IF RESULTFLAG THEN
BEGIN
NEW(CHNBLOCK);
PTRFILE.P := CHNBLOCK; FIL := PTRFILE.F;
WITH CHNBLOCK^ DO
BEGIN
IF RESETFLAG THEN STAT := STATREAD ELSE STAT := STATWRITE;
STAT := STAT OR STATTEXT;
DEV := 0;
NAME := (ORD('C')*40+ORD('S'))*40+ORD('I')-39488;
NAM2 := (CHN + 31)*40*40;
EXT := 0;
FSIZ := 0;
CHAN := CHN;
BLOK := 0;
BSIZ := BUFFERLEN;
HAND := 100000B; (* RAN ACC DEVICE *)
REC := 1; (* RECORDSIZE: 1 *)
PER := 1000B DIV REC;
NEW(BUFF); DATA := BUFF; PTR := BUFF;
END;
(*$C .GLOBL $CHAN0
MOV CHN(6),%0
ASL %0
MOV CHNBLOCK(6),$CHAN0(0)
*)
IF RESETFLAG THEN GET(FIL);
END;
END;
BEGIN (* CSI *)
CSIVALUE := TRUE;
CINDEX := 1;
FOR RINDEX := 1 TO 4 DO
BEGIN
VAL := 0;
FOR I := 1 TO 3 DO
BEGIN
C := DEFEXTTEXT[CINDEX]; CINDEX := CINDEX+1;
IF (C>='А') AND (C<='З') THEN N := ORD(C)-96 ELSE
IF (C>='A') AND (C<='Z') THEN N := ORD(C)-ORD('@') ELSE
IF (C>='0') AND (C<='9') THEN N := ORD(C)-ORD('0')+31 ELSE
N := 0;
VAL := VAL*40+N;
END;
DEFEXT[RINDEX] := VAL;
END;
WITH CSIDAT DO
BEGIN
OFLAG1:=FALSE; OFLAG2:=FALSE; OFLAG3:=FALSE;
FOR I := 1 TO INMAX DO IFLAG[I]:=FALSE;
SWITCHCOUNT := 0;
FOR C := '@' TO 'Z' DO
WITH SWITCH[C] DO BEGIN
GIVEN:=FALSE; ARGFOUND:=FALSE; ARGVALUE:=0;
END;
CLOSE(O1); CLOSE(O2); CLOSE(O3);
FOR I := 1 TO INMAX DO CLOSE(INN[I]);
CHANSFREE := TRUE;
FOR I := 0 TO 8 DO IF WAITCHN(I) THEN CHANSFREE := FALSE;
IF NOT CHANSFREE THEN
WRITELN('CHANNELS 0..8 ARE NOT AVAILABLE FOR CSI')
ELSE
BEGIN
(*$C .MCALL .CSIGEN
.GLOBL $KORE, LOWSTK, HISTK
MOV %6,%1 ;SET THE STACK TO
;THE USR SWAP SCRATCH AREA
MOV %1, %0 ;
ADD #STR, %0 ;
ADD #DEFEXT,%1
CALL LOWSTK ;
MOV %6, %4 ;
MOV #^O1000, @#^O46 ;
.CSIGEN $KORE, %1, %0 ;DECODE LINE AND OPEN FILES
CLR @#^O46 ;
BCS 10$ ;ERROR OCCURED?
MOV (6)+,%0 ;GET COUNT OF SWITCHES
MOV %0,136(3)
BEQ 6$
BR 1$ ;
10$: MOV %4, %6 ;
CALL HISTK ;
*)
CSIVALUE := FALSE;
(*$C
BR 7$ ;
1$: MOV (6)+,%1 ;GET THE SWITCH CHAR AND ARG FLAG
MOV %1,%2
BIC #^O177600,%2
CMP %2,#^O172 ;MAKE SURE THE SWITCH IS ALPHA
BHI 4$
CMP %2,#^O140
BLO 2$
SUB #^O40,%2
2$: CMP %2,#^O132
BHI 4$
CMP %2,#^O100
BLO 4$
SUB #^O100,%2
3$: ASL %2 ;MAKE THE SWITCH CHAR AN ARRAY INDEX
ASL %2
ADD %3,%2
ADD #138,%2 ;POINT TO ELEMENT OF SWITCH ARRAY
MOVB #1,(2) ;SET SWITCH FOUND
TST %1
BPL 5$
MOVB #1,1(2) ;SET ARG FOUND
MOV (6)+,2(2) ; AND SWITCH VALUE
BR 5$
4$: TST %1
BPL 5$
TST (6)+
5$: DEC %0 ;COUNT DOWN A SWITCH
BNE 1$
6$: MOV %4, %6 ;
CALL HISTK ;
7$: ;
*)
FOR I := 1 TO INMAX DO
SETOPEN(INN[I],I+2,TRUE,IFLAG[I]);
SETOPEN(O1,0,FALSE,OFLAG1);
SETOPEN(O2,1,FALSE,OFLAG2);
SETOPEN(O3,2,FALSE,OFLAG3);
END;
END;
CSI := CSIVALUE;
END; (* CSI *)
Это с дискет, которые публиковал по личной инициативе Patron.
Ответить с цитированием
Размещение рекламы на форуме способствует его дальнейшему развитию 
