|
DataMuseum.dkPresents historical artifacts from the history of: RegneCentralen RC3600/RC7000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RegneCentralen RC3600/RC7000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 25088 (0x6200)
Types: TextFile
Names: »YIOO6«
└─⟦6dbcc9c03⟧ Bits:30000463 DOMUS disk image
└─⟦this⟧ »/YIOO6«
!
RCSL: XX-YYZZZZ
AUTOR: FRS
EDITED: 82.05.25
PROGRAM RC36-00XXX.06
MUS TEST : IOO
KEYWORDS: RC3600, MUS, I/O TEST, LISTING.
ABSTRACT: THIS PROGRAM IS ABLE TO TEST ALL INPUT AND OUTPUT DEVICES
IN A RC3600 SYSTEM OR A RC8000 SYSTEM PARALLEL WITH NCP.
ASCII SOURCE: XX-YYZZZZ
REL.BIN: XX-YYZZZZ
SIZE: SSSS BYTES
«ff»
MUS TEST : I/O
FUNCTION : I/O TEST HAS ONLY THREE MAIN - PARAMETERS :
1) NO. OF CHAR ,
2) ZONE NAME AND
3) CHARACTER .
THE PROGRAM COMMUNICATES WITH THE RC3600 STANDARD
MUS - DRIVER PROCCESSES BY MEANS OF A 'ZONE DESCRIBTOR'
DESCRIBTED IN THE SECOND PARAMETER.
THE THIRD PARAMETER MAKES IT POSSIBLE TO SPECIFY THE
FOLLOWING THREE DATATYPES :
1) RANDOM ,
2) TEXT BY OWN CHOISE ,
3) A PATTERN OF NUMBERS BY OWN CHOISE .
IT CAN ALSO BE USED FOR DATACHECK.
DATACHECK, LENGTHCHECK AND STATUSCHECK CAN BE SWITCHED
OFF BY USING THE COMMAND : 'OFF'
ALL NUMBERS CAN BE SPECIFIED IN OCTAL, E.G.(8'100),
DECIMAL OR AS BYTES E.G.(B69-49) = (69 SHIFT 8) + 49 .
PARAMETERS : 1. NO OF CHAR : IT IS POSSIBLE TO USE NUMBERS FROM
1 TO MAX (136 OR 2000) . THE NR OF BUFFERS IS
CALCULATED AS MAX_LENGTH // NO_OF_CHAR.
MAX IS 3 BUFFERS.IF YOU WANT ONLY ONE BUFFER, TYPE
.<NO_OF_CHAR> E.G .12
2. ZONE NAME : YOU CAN GIVE THE NORMAL DRIVER NAME
E.G. LPT , TTY .
@ BEFOR NAME IS 'MESSAGE MODE'
THE PROGRAM ASK FOR M0 - M3, SEND MESSAGE, WAIT
ANSWER AND WRITES THE ANSWER A0 - A3 IN DECIMAL
AND OCTAL. ^ IS USED TO GET A OWN DATAAREA OF 80 BYTES
/ BEFOR NAME IS 'SETZONE MODE'
6 NEW PARAMETERS ARE REQUIRED :
SEQUENCE: W(WRITE), R(READ) AND WR(WRITE SET-
POSITION, READ).
MODE: WRITE-MODE, READ-MODE OR BOTH
SEE TABLE 1.
KIND: DEVICE KIND
BIT 15 CHR ORIENTED,
14 BLOCK ORIENTED,
13 POSITIONABLE,
12 REPEATABLE,
11 DISC FILE
0 COROTINEN FILE.
DELAY: TIME IN 20MSEC PERIODS AFTER ONE OPERRATION
FILE: IF ONLY ONE NUMBER THEN FIX FILE,
WHEN TO NUMBERS THEN FROM FILE TO FILE.
BLOCK: SEE FILE.
PASS: NO OF PASSES; CR = CONT
IF PASS OUT THEN GOTO NO OF CHAR.
CONV: NAME OF CONVERSATIONS TABLE.
DEFAULTS ARE
SEQUENCE: WRITE, MODE: 3, KIND: 1, FILE,BLOCK: 0,CONV: 0
DELAY: 0.
3. CHAR : NORMAL ASCII TEXT E.G. E OR TEST, THE PROGRAM
WILL CONVERT THIS SIGN OR TEXT INTO A FULL BUFFER
LENGTH SPECIFIED BY 'NR OF CHAR' OR RANDOM.
@<START VALUE> FOR RANDOM
OR @SYNC FOR AUTOMATIC SYNC
^<NUMBER> <NUMBER>.......... FOR PATTERN
NUMBER = 123 (IN DEC) OR 8'100 (IN OCTAL)
MAX 8 BIT.
«ff»
COMMANDS : TO RUNNING PROG. 'STOP' = CLOSE FILE AND RELEASE
GOTO NO OF CHAR.
'CHAR' = CLOSE FILE BUT NOT RELEASE
GOTO CHAR.
'START'= IF CURRENT OFF THEN
NO REPEAT .
'STAT' = NO HALT IN CASE OF ERROR
BUT ERROR MESSAGES ARE
WRITTEN ON THE CONSOLE AND
ACCUMULATE IN A STATISTIC-
FIELD.-THE FIELD IS CLEARED.
'DON' = SWITCH DATACHECK ON.
'DOFF' = SWITCH DATACHECK OFF.
'PA' = PRINT CURRENT BUFFER ASCII
'PO' = PRINT CURRENT BUFFER OKTAL
AS 8-BIT CHAR.
'PP' = PRINT CURRENT POSITION
'PS' = PRINT STATISTIC-FIELD
'ESC' = ESCAPE FROM PRINT.
OTHER COMMANDS HAS NO EFFECT.
IF STATUSERROR 'STOP','CHAR','PA','PO'= AS LISTED ABOVE
'OFF' = SWITCH THE CURREND STATUSBITOFF
'START'= CONTINIUE, BUT WITHOUT
REPEAT LAST OPERATION.
OTHER COMMANDS = CONTINIUE.
IF DATAERROR 'STOP','CHAR','PA','PO'= AS LISTED ABOVE
'OFF' = SWITCH DATACHECK OFF AND CONT
'<NUMBER>' = CONT, IF MORE DATAERR.
THEN PRINT N DATAERROR'S.
'START' = START NEXT BLOCK AND CONTINIUE
OTHER COMMANDS = CONTINIUE
'SYNC' = SYNCRONIZE RANDOM SEQUENCE
IF LENGTHERROR 'STOP','CHAR','PA','PO'= AS LISTED ABOVE
'OFF' = SWITCH LENGTH CHECK OFF AND CONT
OTHER COMMANDS = CONTINIUE
OTHER 'ESC' = ESCAPE AND 'GOTO NO OF CHAR'.
ERROR'S: STATUSERROR LPT ERROR 8'000002
BIT 14 IS SET (TIMEOUT)
DATAERROR DATA ERROR 00078/W00029/R00028
WRITTEN IN POSITION 78 29
READ IN POSITION 78 28
LENGTHERROR LENGTH ERROR /W00080/R00010
WRITTEN BLOCKLENGTH = 80
READED BLOCHLENGTH = 10
!
«ff»
CONST
HEAD ='<10>* * * I/O TEST * * *<10>
VER. 1.6 MAX 1024 CHR<0>',
MAXL = 1056, ! MAX BUFFERLENGTH + 32 FOR SHARE !
NOCHAR='<10>NO. OF CHAR: <0>',
ZNAME ='<10>ZONE NAME: <0>',
TXCHAR='<10>CHAR: <0>',
ZTX1 ='<10>/SEQUENCE: <0>',
ZTX2 =' MODE: <0>',
ZTX3 ='/KIND: <0>',
ZTX4 ='/FILE: <0>',
ZTX5 ='/BLOCK: <0>',
ZTX6 ='/CONV: <0>',
ZTX7 ='/DELAY: <0>',
ZTX8 ='/PASS: <0>',
ZTX9 ='<10>*** PASS ***<0>',
DATA ='<10>DATA <0>',
LEN ='<10>LENGTH<0>',
ERR =' ERROR <0>',
OKTAL =' 8<39><0>',
STXT ='<10>*** STATISTICS ***<0>',
BTXT ='<10>BIT: TIMES<10><0>',
NTXT ='<10>NO STATUS BITS<0>',
W ='/W<0>',
R ='/R<0>',
BL ='/B<0>',
FI =' IN/F<0>',
TR ='R',
TWR ='WR',
Q ='<10>? <0>',
LF ='<10><0>',
TM ='M : <0>',
TA ='<10>A : <0>',
TOUT ='TIMEOUT<0>',
OK ='OK<0>',
STCCW ='<13><10>',
NULL ='<0><0><0><0><0><0>',
OFF ='OFF',
DON ='DON',
DOFF ='DOFF',
STOP ='STOP',
CHAR ='CHAR',
SYNC ='SYNC',
STAT ='STAT',
PS ='PS',
PO ='PO',
PP ='PP',
START ='START';
«ff»
VAR
ZDATA : STRING(MAXL);
OPSTR,LINE : STRING(80);
CCW : STRING(2);
STATFIELD : STRING(32);
HELP1 : STRING(12);
HELP2 : STRING(6);
HELP3 : STRING(8);
HELP ! 0 1 ! : STRING(2); ! USED AS ADDR. POINTER !
XN ! 2 3 ! : INTEGER;
X ! 4 5 ! : INTEGER;
A ! 6 7 ! : INTEGER;
OPLENGTH : INTEGER;
LENGTH : INTEGER;
BPOINTER : INTEGER;
OPOINTER : INTEGER;
CPOINTER : INTEGER;
SQ : INTEGER;
MODE,CMODE : INTEGER;
FIRSTTIME : INTEGER;
CBLOCK : INTEGER;
CFILE : INTEGER;
FBLOCK : INTEGER;
FFILE : INTEGER;
RBLOCK : INTEGER;
RFILE : INTEGER;
ENDBLOCK : INTEGER;
ENDFILE : INTEGER;
OLDXN,SAVEXN : INTEGER;
B,C,D,E : INTEGER;
Y,Z,LA : INTEGER;
NOOFSHARES : INTEGER;
ERRCOUNT : INTEGER;
MASK : INTEGER;
TIME,DTIME : INTEGER;
PASS,SPASS : INTEGER;
SP,SB : INTEGER;
DSTAT,LSTAT : INTEGER;
BUF : INTEGER;
MES : RECORD
MES0 : INTEGER;
MES1 : INTEGER;
MES2 : INTEGER;
MES3 : INTEGER;
MALL : STRING(8) FROM 1
END;
ZONE: FILE' ',1,3,1,U;
GIVEUP ZONEERR,
2'1110011111111111
OF STRING(1);
! SQ = SEQUENCE CONTROL (PROG. STATE CONTR.)
BITNR. DEC.V CONTR.
------------------------
2 8192 RANDOM SYNC REQ
3 4096 RANDOM SYNC SW
4 2048 STATISTICS
5 1024 RANDOMBLOCK
6 512 RANDOMFILE
7 256 CCW
8 128 DATA CHECK
9 64 LENGTH CHECK
10 32 RANDOM
11 16 READ AFTER WRITE(WR)
12 8 READ(R)
13 4 WRITE(W)
14 2 VAR. BLOCK
15 1 VAR. FILE
!
«ff»
PROCEDURE WAITTA( VAR SMESS : INTEGER; VAR SBUF : INTEGER;
VAR TIME : INTEGER);
CODEBODY;
PROCEDURE SENDMESSAGE( VAR SMESS : INTEGER; NAME : STRING(6);
SBUF : INTEGER);
CODEBODY;
PROCEDURE CHANGETABLE( FILE F; CONST IDENT : STRING(6));
CODEBODY;
PROCEDURE BINOCT( CONST NUMBER : INTEGER; VAR TEXT : STRING(6));
CODEBODY P0087;
PROCEDURE RANDOM( VAR I : INTEGER);
CODEBODY RANDM;
PROCEDURE DELAY(CONST DTIME : INTEGER);
CODEBODY P0023;
PROCEDURE INITZONE(FILE Z; CONST SHARES: INTEGER;
CONST LENGTH: INTEGER; CONST AREA: INTEGER);
CODEBODY P0155;
PROCEDURE TAKEADDRESS(CONST STR: STRING(1);
VAR ADDR: INTEGER);
CODEBODY P0159;
PROCEDURE OPCOM;
BEGIN
OPWAIT(OPLENGTH);
HELP1:=LINE;
OPIN(LINE);
END;
PROCEDURE GETNR;
BEGIN
C:=0;
REPEAT
C:=C+1;
MOVE(OPSTR,A,HELP,0,1);
A:=A+1
UNTIL BYTE HELP < 48;
D:= BYTE HELP; ! DELIMITER !
MOVE(OPSTR,A-C,HELP1,0,C);
DECBIN(HELP1,B);
END;
PROCEDURE NEXTNR;
BEGIN
GETNR;
IF B = 8 THEN
IF D = 39 THEN ! 8' FOR OKTALNR !
BEGIN
GETNR;
B:=0; E:=0;
REPEAT
MOVE(HELP1,C-2,HELP,0,1);
IF BYTE HELP < 56 THEN ! OKTALNR ARE OK !
BEGIN
B:=B+((BYTE HELP - 48) SHIFT E);
E:=E+3;
END;
C:=C-1
UNTIL C = 1;
END;
END;
«ff»
PROCEDURE ISOLATE;
BEGIN
MOVE(OPSTR,OPOINTER,HELP,0,1);
IF BYTE HELP = 94 THEN ! SET INT IN OPSTR !
BEGIN
A:=OPOINTER+1;
REPEAT
NEXTNR;
INSERT(B,OPSTR,OPOINTER);
OPOINTER:=OPOINTER+1
UNTIL D = 13;
END ELSE
BEGIN
Y:=0;
IF BYTE HELP = 66 THEN ! B FOR BYTEMODE !
BEGIN
A:=1;
NEXTNR;
X:=B SHIFT 8;
NEXTNR;
X:=X+B;
END ELSE
BEGIN
A:=OPOINTER; ! WORDMODE !
NEXTNR;
X:=B;
IF D <> 13 THEN ! 2.INT !
BEGIN
NEXTNR;
Y:=B;
END;
END;
IF D <> 13 THEN GOTO 2; ! ERROR !
END;
END;
PROCEDURE STRIN;
BEGIN
OPWAIT(OPLENGTH);
OPSTR:=LINE;
OPIN(LINE);
IF BYTE OPSTR = 27 THEN GOTO 1; ! ESCAPE !
END;
PROCEDURE SETBUFFER;
BEGIN
FIRSTTIME:=FIRSTTIME-1; ! FALSE !
BPOINTER:=0;
WHILE LENGTH - BPOINTER > OPOINTER DO
BEGIN
MOVE(OPSTR,0,ZONE^,BPOINTER,OPOINTER);
BPOINTER:=BPOINTER + OPOINTER;
END;
MOVE(OPSTR,0,ZONE^,BPOINTER,LENGTH - BPOINTER);
MOVE(CCW,0,ZONE^,LENGTH,2);
END;
PROCEDURE WRITEPOSITION;
BEGIN
IF SQ AND 3 <> 0 THEN
BEGIN
OPMESS(FI); BINDEC(CFILE,HELP2); OPMESS(HELP2);
OPMESS(BL); BINDEC(CBLOCK,HELP2); OPMESS(HELP2);
END;
END;
«ff»
PROCEDURE INSERTSTAT;
BEGIN
SP:=0;
SB:=2'1000000000000000;
REPEAT
IF ZONE.Z0 AND SB <> 0 THEN ! INCR BIT COUNT !
BEGIN
MOVE(STATFIELD,SP,HELP2,0,2);
A:=WORD HELP2 + 1;
INSERT(A,STATFIELD,SP+1);
INSERT(A SHIFT (-8),STATFIELD,SP);
END;
SP:=SP+2;
SB:=SB SHIFT (-1)
UNTIL SB = 0;
END;
PROCEDURE CLEARSTAT;
BEGIN
SP:=0;
REPEAT
MOVE(NULL,0,STATFIELD,SP,6);
SP:=SP+6
UNTIL SP = 30;
MOVE(NULL,0,STATFIELD,SP,2);
DSTAT:=0;
LSTAT:=0;
END;
PROCEDURE PRINTSTAT;
BEGIN
OPMESS(STXT);
SP:=0; SB:=0;
REPEAT
MOVE(STATFIELD,SP*2,HELP2,0,2);
A:=WORD HELP2;
IF A <> 0 THEN
BEGIN
IF SB = 0 THEN OPMESS(BTXT);
SB:=1;
IF SP > 9 THEN
BEGIN
INSERT(49,HELP2,0);
INSERT(SP+38,HELP2,1);
END ELSE
BEGIN
INSERT(32,HELP2,0);
INSERT(SP+48,HELP2,1);
END;
INSERT(32,HELP2,2);
INSERT(58,HELP2,3);
INSERT(32,HELP2,4);
INSERT(0,HELP2,5);
OPMESS(HELP2);
BINDEC(A,HELP2); OPMESS(HELP2);
OPMESS(LF);
END;
SP:=SP+1
UNTIL SP = 16;
IF SB = 0 THEN OPMESS(NTXT);
OPMESS(DATA); OPMESS(ERR);
BINDEC(DSTAT,HELP2); OPMESS(HELP2);
OPMESS(LEN); OPMESS(ERR);
BINDEC(LSTAT,HELP2); OPMESS(HELP2); OPMESS(LF);
IF SPASS <> 0 THEN
BEGIN
MOVE(ZTX8,1,HELP3,0,7); OPMESS(HELP3);
BINDEC(SPASS-PASS,HELP2); OPMESS(HELP2); OPMESS(LF);
END;
END;
«ff»
PROCEDURE SETRANDOM;
BEGIN
BPOINTER:=0;
OLDXN:=XN;
REPEAT
RANDOM(XN);
INSERT(XN,ZONE^,BPOINTER);
BPOINTER:=BPOINTER + 1
UNTIL BPOINTER >= LENGTH;
END;
PROCEDURE WRITEOKTAL;
BEGIN
OPMESS(OKTAL);
BINOCT(A,HELP3);
INSERT(0,HELP3,6);
OPMESS(HELP3);
END;
PROCEDURE RCOM;
BEGIN
OPCOM;
IF HELP1 = CHAR THEN
BEGIN
CLOSE(ZONE,0);
GOTO 3;
END;
IF HELP1 = STOP THEN
BEGIN
CLOSE(ZONE,1);
GOTO 1;
END;
IF HELP1 = DON THEN ! SWITCH DATACHECK ON !
IF SQ AND 128 = 0 THEN SQ:=SQ+128;
IF HELP1 = DOFF THEN ! SWITCH DATACHECK OFF !
IF SQ AND 128 <> 0 THEN SQ:=SQ-128;
IF HELP1 = STAT THEN
BEGIN
IF SQ AND 2048 = 0 THEN SQ:=SQ+2048;
CLEARSTAT;
END;
IF BYTE HELP1 = 80 THEN ! P FOR PRINT CUR RECORD !
BEGIN
IF HELP1 = PP THEN WRITEPOSITION ELSE
IF HELP1 = PS THEN PRINTSTAT ELSE
BEGIN
BINDEC(ZONE.ZLENGTH-ZONE.ZREM,HELP2);
OPMESS(HELP2); OPMESS(LF);
B:=0;
INSERT(0,HELP,1);
REPEAT
IF OPTEST <> 0 THEN ! ESCAPE !
BEGIN
OPCOM;
GOTO 100;
END;
MOVE(ZONE^,B,HELP,0,1);
IF HELP1 = PO THEN
BEGIN
A:=BYTE HELP;
WRITEOKTAL;
IF B AND 7 = 7 THEN OPMESS(LF);
END ELSE OPMESS(HELP);
B:=B+1
UNTIL B >= ZONE.ZLENGTH-ZONE.ZREM;
END;
100:OPMESS(LF);
END;
END;
«ff»
PROCEDURE WRITEINTEGER;
BEGIN
BINDEC(A,HELP3);
OPMESS(HELP3);
END;
PROCEDURE DATAERR;
BEGIN
DSTAT:=DSTAT+1;
FIRSTTIME:=NOOFSHARES;
OPMESS(DATA); OPMESS(ERR);
A:=BPOINTER;
WRITEINTEGER;
OPMESS(W);
A:=OLDXN AND 255;
WRITEINTEGER;
OPMESS(R);
A:= BYTE HELP;
WRITEINTEGER;
WRITEPOSITION;
IF ERRCOUNT = 0 THEN
BEGIN
IF SQ AND 2048 = 0 THEN
BEGIN
OPMESS(Q);
RCOM;
END ELSE
IF OPTEST <> 0 THEN RCOM;
IF HELP1 = SYNC THEN ! SET SYNC AND SYNC REQ !
IF SQ AND 4096 = 0 THEN SQ:=SQ+4096;
IF HELP1 = OFF THEN
BEGIN
SQ:=SQ-128; ! STOP DATACHECK !
GOTO 1002;
END;
IF HELP1 = START THEN GOTO 1002;
IF BYTE HELP1 < 58 THEN ! PRINT ERRORS !
IF BYTE HELP1 > 48 THEN DECBIN(HELP1,ERRCOUNT);
END ELSE
ERRCOUNT:=ERRCOUNT-1;
END;
PROCEDURE LENGTHERR;
BEGIN
LSTAT:=LSTAT+1;
OPMESS(LEN); OPMESS(ERR);
OPMESS(W);
WRITEINTEGER;
OPMESS(R);
A:=ZONE.ZSHAREL; WRITEINTEGER;
WRITEPOSITION;
IF SQ AND 2048 = 0 THEN ! STATISTICS !
BEGIN
OPMESS(Q);
RCOM;
END;
IF HELP1 = OFF THEN SQ:=SQ-64; ! STOP LENGTHCHECK !
END;
«ff»
PROCEDURE ZONEERR;
BEGIN
INSERTSTAT;
IF MASK AND ZONE.Z0 <> 0 THEN
BEGIN
OPMESS(LF);
OPMESS(ZONE.ZNAME); OPMESS(ERR);
A:=ZONE.Z0;
WRITEOKTAL;
WRITEPOSITION;
IF SQ AND 2048 = 0 THEN ! STATISTICS !
BEGIN OPMESS(LF); RCOM; END;
IF HELP1 = OFF THEN MASK:=MASK-ZONE.Z0;
END;
IF OPTEST <> 0 THEN RCOM;
IF HELP1 <> START THEN
BEGIN
IF ZONE.Z0 AND 8'1004 <> 0 THEN GOTO 999
ELSE REPEATSHARE(ZONE);
END;
END;
PROCEDURE BACKSPACE;
BEGIN
IF CBLOCK = FBLOCK THEN
BEGIN
IF CFILE > FFILE THEN CFILE:=CFILE-1
ELSE CFILE:=ENDFILE-1;
CBLOCK:=ENDBLOCK-1;
END
ELSE CBLOCK:=CBLOCK-1;
SETPOSITION(ZONE,CFILE,CBLOCK);
END;
PROCEDURE COMPARE;
BEGIN
MOVE(OPSTR,B,HELP1,0,1);
B:=B+1;
MOVE(ZONE^,BPOINTER,HELP,0,1);
BPOINTER:=BPOINTER+1;
IF BYTE HELP <> BYTE HELP1 THEN
BEGIN
OLDXN:= BYTE HELP1;
DATAERR;
END;
END;
PROCEDURE PUTOUT;
BEGIN
ZONE.ZMODE:=MODE;
PUTREC(ZONE,ZONE.ZSHAREL);
IF SQ AND 32 <> 0 THEN SETRANDOM ! RANDOM !
ELSE
IF FIRSTTIME > 0 THEN SETBUFFER;
END;
«ff»
PROCEDURE POSITION;
BEGIN
IF SQ AND 3 <> 0 THEN ! VAR POSITION !
BEGIN
CBLOCK:=CBLOCK+1;
IF CBLOCK = ENDBLOCK THEN
BEGIN
CBLOCK:=FBLOCK;
IF SQ AND 8 = 0 THEN ! NOT READ !
BEGIN
IF ZONE.ZKIND AND 16 = 0 THEN ! NOT DISCFILE !
BEGIN
IF ZONE.ZMODE AND 2 <> 0 THEN
BEGIN
CLOSE(ZONE,0); ! WRITE FILEMARK !
OPEN(ZONE,MODE);
END;
END;
END;
CFILE:=CFILE+1;
IF CFILE = ENDFILE THEN
BEGIN
IF PASS <> 0 THEN PASS:=PASS-1;
IF PASS = 1 THEN
BEGIN
CLOSE(ZONE,1);
OPMESS(ZTX9);
PASS:=PASS+1;
GOTO 1;
END;
CFILE:=FFILE;
END;
SETPOSITION(ZONE,CFILE,CBLOCK);
END;
END;
END;
PROCEDURE GETIN;
BEGIN
ZONE.ZMODE:=CMODE;
ZONE.ZREM:=0;
GETREC(ZONE,A);
IF SQ AND 64 <> 0 THEN ! LENGTHCHECK !
IF ZONE.ZSHAREL <> A THEN LENGTHERR;
END;
PROCEDURE RPOSITION;
BEGIN ! CX:=RANDOM((RX MOD (ENDX-FX)+FX)); !
IF SQ AND 512 <> 0 THEN ! RANDOM FILE !
BEGIN
RANDOM(RFILE);
RFILE:=RFILE AND 8'77777;
CFILE:=RFILE/(ENDFILE-FFILE);
CFILE:=(RFILE-CFILE*(ENDFILE-FFILE))+FFILE;
END;
IF SQ AND 1024 <> 0 THEN ! RANDOM BLOCK !
BEGIN
RANDOM(RBLOCK);
RBLOCK:=RBLOCK AND 8'77777;
CBLOCK:=RBLOCK/(ENDBLOCK-FBLOCK);
CBLOCK:=(RBLOCK-CBLOCK*(ENDBLOCK-FBLOCK))+FBLOCK;
END;
SETPOSITION(ZONE,CFILE,CBLOCK);
END;
«ff»
PROCEDURE MESSAGE;
BEGIN
MOVE(OPSTR,1,ZONE.ZNAME,0,OPLENGTH-2);
MOVE(TM,0,HELP2,0,6);
Z:=0;
REPEAT
INSERT(Z+48,HELP2,1);
OPMESS(HELP2);
STRIN;
IF BYTE OPSTR = 94 THEN TAKEADDRESS(ZDATA,X) ELSE
ISOLATE;
MOVE(HELP,4,MES.MALL,Z*2,2); ! MES.MESX:=X !
Z:=Z+1
UNTIL Z = 4;
SENDMESSAGE(MES.MES0,ZONE.ZNAME,BUF);
IF BUF > 0 THEN
BEGIN
TIME:=3000; ! WAIT MAX 60 SEC !
WAITTA(MES.MES0,BUF,TIME);
IF TIME = 0 THEN
BEGIN
OPMESS(TOUT);
GOTO 2;
END;
OPMESS(OK);
END;
MOVE(TA,0,HELP2,0,6);
Z:=0;
REPEAT
INSERT(Z+48,HELP2,2);
OPMESS(HELP2);
MOVE(MES.MALL,Z*2,HELP,6,2); ! A:=MES.MESX !
WRITEINTEGER;
WRITEOKTAL;
Z:=Z+1
UNTIL Z = 4;
GOTO 2;
END;
PROCEDURE SETMODE;
BEGIN
OPMESS(ZTX2);
STRIN;
ISOLATE;
IF BYTE OPSTR <> 13 THEN CMODE:=X;
END;
«ff»
PROCEDURE SETZONE;
BEGIN
SQ:=196; ! W,LCHECK,DCHECK !
MODE:=3; ZONE.ZKIND:=1;
ZONE.ZMASK:=8'163777;
CFILE:=0; CBLOCK:=0;
FFILE:=0; FBLOCK:=0;
DTIME:=0; PASS:=0;
MOVE(OPSTR,1,ZONE.ZNAME,0,OPLENGTH-2);
OPMESS(ZTX1); ! SEQUENZ !
STRIN;
IF OPSTR <> TR THEN ! NOT READ !
BEGIN
IF OPSTR = TWR THEN SQ:=SQ-4+16; ! READ AFTER WRITE !
OPMESS(W);
END ELSE
BEGIN
SQ:=SQ-4+8; ! READ !
MODE:=1; CMODE:=1; ! DEFAULT READ MODE !
ZONE.ZMASK:=8'161777;
OPMESS(R);
END;
SETMODE;
IF BYTE OPSTR <> 13 THEN MODE:= X;
IF SQ AND 16 <> 0 THEN ! READ AFTER WRITE !
BEGIN
OPMESS(R);
SETMODE;
END;
OPMESS(ZTX3); ! KIND !
STRIN;
ISOLATE;
IF BYTE OPSTR <> 13 THEN ZONE.ZKIND:=X;
OPMESS(ZTX7); ! DELAY !
STRIN;
ISOLATE;
IF BYTE OPSTR <> 13 THEN DTIME:=X;
OPMESS(ZTX4); ! FILE !
STRIN;
IF BYTE OPSTR = 64 THEN ! RANDOMPOSITION !
BEGIN
OPOINTER:=1;
SQ:=SQ+512;
END;
ISOLATE;
FFILE:=X;
ENDFILE:=X+1;
IF Y <> 0 THEN ! VAR FILE !
BEGIN
SQ:=SQ+1;
ENDFILE:=Y+1;
END;
«ff»
OPOINTER:=0;
OPMESS(ZTX5); ! BLOCK !
STRIN;
IF BYTE OPSTR = 64 THEN ! RANDOMPOSITION !
BEGIN
OPOINTER:=1;
SQ:=SQ+1024;
END;
ISOLATE;
FBLOCK:=X;
ENDBLOCK:=X+1;
IF Y <> 0 THEN
BEGIN
SQ:=SQ+2; ! VAR BLOCKLENGTH !
ENDBLOCK:=Y+1;
END;
! PASS !
IF SQ AND 1536 = 0 THEN ! NOT RANDOMPOS !
IF SQ AND 3 <> 0 THEN ! BUT VAR POS !
BEGIN
OPMESS(ZTX8);
STRIN;
ISOLATE;
IF BYTE OPSTR <> 13 THEN PASS:=X+1;
END;
SPASS:=PASS;
OPMESS(ZTX6); ! CONV !
STRIN;
MOVE(NULL,0,OPSTR,OPLENGTH-1,5);
CHANGETABLE(ZONE,OPSTR);
END;
«ff»
BEGIN
OPMESS(HEAD); OPIN(LINE);
SQ:=196;
MODE:=3; ZONE.ZKIND:=1;
DTIME:=0; PASS:=0; SPASS:=0;
CLEARSTAT;
1:REPEAT
OPMESS(NOCHAR);
OPCOM;
NOOFSHARES:=0;
IF BYTE HELP1 = 46 THEN NOOFSHARES:=1;
MOVE(HELP1,NOOFSHARES,HELP2,0,6);
DECBIN(HELP2,LENGTH);
IF LENGTH < 1 THEN GOTO 1
UNTIL LENGTH <= MAXL-32;
2:REPEAT
ERRCOUNT:=0;
MASK:=8'163777;
MOVE(NULL,0,ZONE.ZNAME,0,6);
OPMESS(ZNAME);
STRIN;
OPOINTER:=0;
REPEAT
MOVE(OPSTR,OPOINTER,HELP,0,1);
IF BYTE HELP = 58 THEN ! : FOR UNIT !
BEGIN
MOVE(OPSTR,OPOINTER+1,HELP1,0,OPLENGTH-OPOINTER-1);
DECBIN(HELP1,X);
INSERT(X,ZONE.ZNAME,5);
OPLENGTH:=OPOINTER+1;
END;
OPOINTER:=OPOINTER+1
UNTIL OPOINTER = OPLENGTH;
OPOINTER:=0;
IF BYTE OPSTR = 64 THEN MESSAGE; ! @ FOR SENDM,WAITA !
IF BYTE OPSTR = 47 THEN SETZONE
ELSE
MOVE(OPSTR,OPOINTER,ZONE.ZNAME,0,OPLENGTH-1)
UNTIL BYTE ZONE.ZNAME > 32;
«ff»
3:OPMESS(TXCHAR);
STRIN;
SQ:=(SQ AND 1567)+192; ! DCH,@,LCH=ON STAT,CCW,RANDOM=OFF !
CBLOCK:=FBLOCK; CFILE:=FFILE;
RBLOCK:=FBLOCK; RFILE:=FFILE;
OPOINTER:=0;
IF BYTE OPSTR = 64 THEN ! @ FOR RANDOM !
BEGIN
MOVE(OPSTR,1,HELP2,0,4);
IF HELP2 = SYNC THEN SQ:=SQ+8192; ! SET SYNC REQ !
OPOINTER:=1;
ISOLATE;
XN:=X; OLDXN:=X;
SQ:=SQ+32;
END ELSE
BEGIN
IF BYTE OPSTR = 94 THEN ISOLATE ! ^ FOR DEC VALUE !
ELSE
BEGIN
IF SQ AND 256 = 0 THEN SQ:=SQ+256; ! SET SQ.CCW !
MOVE(STCCW,0,CCW,0,2);
Y:=OPLENGTH-1;
REPEAT
OPOINTER:=OPOINTER+1;
MOVE(OPSTR,OPOINTER,HELP,0,1);
IF BYTE HELP = 94 THEN ! SPECIAL CCW !
BEGIN
Y:=OPOINTER;
ISOLATE;
IF OPOINTER-Y <> 2 THEN GOTO 3; ! SPEC. CCW NOT OK !
MOVE(OPSTR,Y,CCW,0,2);
END
UNTIL OPOINTER = OPLENGTH;
OPOINTER:=Y;
END;
END;
IF BYTE OPSTR = 13 THEN ! CR !
BEGIN
IF SQ AND 8 = 0 THEN GOTO 3; ! NO READ !
SQ:=SQ-384;
END;
«ff»
! MAIN LOOP !
TAKEADDRESS(ZDATA,X);
Z:=LENGTH;
IF NOOFSHARES <> 1 THEN NOOFSHARES:=(MAXL-32)/LENGTH;
IF SQ AND 256 <> 0 THEN Z:=Z+2;
IF NOOFSHARES > 3 THEN NOOFSHARES:=3; ! MAX NUMBER OF SHARES ARE 3 !
IF SQ AND 1552 <> 0 THEN NOOFSHARES:=1; ! WSR AND RANDOMPOSITION !
INITZONE(ZONE,NOOFSHARES,Z,X);
FIRSTTIME:=NOOFSHARES;
999:
OPEN(ZONE,MODE);
SETPOSITION(ZONE,CFILE,CBLOCK);
1000:
IF SQ AND 1536 <> 0 THEN RPOSITION;
IF SQ AND 16 <> 0 THEN ZONE.ZREM:=ZONE.ZSHAREL;
IF SQ AND 8 = 0 THEN ! NOT READ !
BEGIN
PUTOUT;
IF SQ AND 16 <> 0 THEN ! ONLY WSR !
BEGIN
OUTBLOCK(ZONE);
POSITION;
BACKSPACE;
GOTO 1001;
END;
POSITION; ! ONLY WRITE !
END
ELSE
BEGIN
1001:
GETIN; ! NOT WRITE !
IF SQ AND 128 <> 0 THEN
BEGIN
! DATACHECK !
BPOINTER:=0;
IF SQ AND 32 <> 0 THEN ! RANDOM !
BEGIN
REPEAT
MOVE(ZONE^,BPOINTER,HELP,0,1);
BPOINTER:=BPOINTER+1;
IF SQ AND 4096 <> 0 THEN
BEGIN ! SYNC SW = ON !
OLDXN:=BYTE HELP;
MOVE(ZONE^,BPOINTER,HELP,0,1);
IF OLDXN <> BYTE HELP THEN
BEGIN
B:=0;
LA:=LENGTH/4;
IF LA < 2 THEN LA:=1;
SAVEXN:=OLDXN;
1004: A:=0;
REPEAT
MOVE(ZONE^,BPOINTER+A,HELP,0,1);
RANDOM(OLDXN);
IF BYTE HELP <> OLDXN AND 255 THEN
WHILE B < 256 DO
BEGIN
SAVEXN:=SAVEXN+256;
B:=B+1;
OLDXN:=SAVEXN;
GOTO 1004;
END;
A:=A+1;
IF B = 256 THEN A:=LA
UNTIL A = LA;
OLDXN:=SAVEXN;
SQ:=SQ-4096;
END;
END ELSE
BEGIN
RANDOM(OLDXN);
IF BYTE HELP <> OLDXN AND 255 THEN
BEGIN
IF SQ AND 8192 <> 0 THEN ! SYNC REQ !
BEGIN
IF BPOINTER = 1 THEN ! NEW SYNC !
BEGIN
IF SQ AND 4096 = 0 THEN SQ:=SQ+4096;
END ELSE DATAERR;
END ELSE
DATAERR;
END;
END
UNTIL BPOINTER >= LENGTH;
END
ELSE
BEGIN
REPEAT
B:=0;
REPEAT COMPARE UNTIL B >= OPOINTER
UNTIL BPOINTER >=LENGTH-OPOINTER;
B:=0;
WHILE BPOINTER < LENGTH DO COMPARE;
END;
END;
1002:
POSITION;
END;
IF FFILE = 0 THEN CLOSE(ZONE,1);
IF DTIME <> 0 THEN DELAY(DTIME);
IF OPTEST <> 0 THEN RCOM; ! OPERATOR INTERV !
IF FFILE = 0 THEN GOTO 999;
GOTO 1000;
END;
«ff»
«nul»