|
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: 28842 (0x70aa)
Description: Bits:30000867 PROGRAM RC36-00016.00 - MUS SINGLE USER EDITOR
Types: 8-hole paper tape, TextFileEven
! RCSL: 43-GL124
AUTHOR: CAMS
EDITED: 75.04.23
PROGRAM RC36-00016.00
MUS SINGLE USER EDITOR
KEYWORDS: MUSIL,EDITOR,SINGLE USER,LISTING
ABSTRACT: THIS PROGRAM HAS FOLLOWING INPUT DEVICES:
PAPERTAPE-READER, CARD-READER, CASSETTE,
MAGTAPE. OUTPUT DEVICES ON PAPERTAPE-PUNCH
CASSETTE, MAGTAPE, LINEPRINTER;
ASCII SOURCE RCSL: 43-GL 125
BINARY / TTY RCSL: 43-GL 126
«ff»
RC36-00016 PAGE 01
ABSTRACT: THIS PROGRAM HAS FOLLOWING INPUT DEVICES:
PAPERTAPE-READER, CARD-READER, CASSETTE,
MAGTAPE. OUTPUT DEVICES ON PAPERTAPE-PUNCH
CASSETTE, MAGTAPE, LINEPRINTER.
SIZE: 12960 BYTES. INCLUDING ONE 512 BYTES INPUT BUFFER
AND ONE 512 BYTES OUTPUT BUFFER.
DATE: APRIL 23TH 1975.
OUTPUT MESSAGES:
DEVICE ERROR: CONSULT THE RC3600 OPERATORS MANUAL
COMMAND ERROR: CONSULT THE MUSIL TEXT EDITOR
INPUT MESSAGES:
INPUT COMMAND CONSULT THE MUSIL TEXT EDITOR
SPECIAL REQUIREMENTS: NONE
!
«ff»
! RC36-00016 PAGE 02 !
CONST
ERMS2= "BUFFER IS FULL - Y OR A INPUT IS TERMINATED<10><0>",
ERMS3= "STRING NOT FOUND<10><0>",
ERMS4= "NO SUCH FILE<10><0>",
ERMS5= 'PARITY ERROR IN LINE NUMBER <10><0>',
ERMS6= "NO INPUT FILE<10><0>",
ERMS7= "NO OUTPUT FILE<10><0>",
ERMS8= '<10>BUFFER CAPACITY EXCEEDED DURING COMMAND INPUT<10>
COMMAND IS TERMINATED<10><0>',
ERMS9= '??<10><10><0>',
ERMS10= 'WRONG FILENUMBER<10><0>',
ERMS11= 'MACRO CONTENTS X IN COMMAND <10><0>',
ERMS12= 'FILE ALREADY EXIST<10><0>',
ERMS13= '<10>CORRECT ERROR WRITE STOP/START <0>',
ERMS14= 'MACRO UNDEFINED <10><0>',
NEWLINE= "<10>",
SPACE= "<32>",
ESCAPE= "<36>",
ESCAPENEWLINE= "<36><10><0>",
ASTERISK= "<42>",
DOLLAR= 36,
ERRORS= ' ERROR ',
NEW= 'NEW',
SP= 'SP',
FD= 'FD',
PTP= 'PTP',
CT= 'CT',
MT= 'MT',
LPT= 'LPT',
LPTC= 'LPTC',
DEVICECOUNT= 108,
DEVICES= 'MT0<0><0><0><14><5><3>
MT1<0><0><0><14><5><3>
MT2<0><0><0><14><5><3>
MT3<0><0><0><14><5><3>
SP<0><0><0><0><1><0><3>
CT0<0><0><0><14><1><3>
CT1<0><0><0><14><1><3>
PTR<0><0><0><1><9><0>
PTP<0><0><0><1><0><11>
FD0<0><0><0><14><1><3>
LPT<0><0><0><1><0><3>
LPTC<0><0><1><0><3>
CDRC<0><0><2><9><0>',
STOP= 'STOP',
BINARYZERO= '<0><0><0><0><0><0>',
«ff»
! RC36-00016 PAGE 03 !
A= 65, ! COMMAND APPEND PAGE TO BUFFER !
B= 66, ! COMMAND SET POINTER TO BUFFER START !
C= 67, ! COMMAND CHANGE A STRING !
D= 68, ! COMMAND DELETE A CHARACTER STRING !
E= 69, ! COMMAND TERMINATE, COPY AT END !
F= 70, ! COMMAND PUNCH LEADER OR FF !
G= 71, ! COMMAND SET FILE !
H= 72, ! COMMAND AS E PLUS DRIVER RELEASE !
I= 73, ! COMMAND INSERT STRING !
J= 74, ! COMMAND SET POINTER TO LINE J !
K= 75, ! COMMAND DELETE A LINE STRING !
L= 76, ! COMMAND SET POINTER RELATIVE !
M= 77, ! COMMAND SET POINTER RELATIVE !
N= 78, ! COMMAND SEARCH STRING OVER MORE PAGES!
P= 80, ! COMMAND PUNCH BUFFER !
Q= 81, ! COMMAND SEARCH STRING OVER MORE PAGES!
R= 82, ! COMMAND REPLACE BUFFER !
S= 83, ! COMMAND SEARCH STRING IN BUFFER !
T= 84, ! COMMAND TYPE BUFFER !
X= 88, ! COMMAND MACRO !
Y= 89, ! COMMAND READ A PAGE TO BUFFER !
W= 87, ! COMMAND HELP CHARACTER !
Z= 90, ! COMMAND SET POINTER TO BUFFER END !
COLON= 58, ! COMMAND DISPLAY NUMBER OF LINES !
DOT= 46, ! COMMAND DISPLAY CURRENT LINE NO !
EQUAL= 61, ! COMMAND DISPLAY NO OF CHARS IN BUF !
BUFFERSIZE= 4800, ! SIZE OF TEXT/COMMAND BUFFER !
BUFFERSIZEM3= 4797; ! LAST COMMAND POSITION IN BUF. !
«ff»
! RC36-00016 PAGE 04 !
VAR
OPSTRING: STRING(80); ! OPERATOR INPUT BUFFER !
BUFFER: STRING(BUFFERSIZE); ! TEXT + COMMAND BUFFER !
NEWNAME: STRING(6);
COMPT: INTEGER; ! COMMAND POINTER !
PRVCH: STRING(2); ! SAVED PREVIOUS CHARACTER !
TABSIM: INTEGER; ! TABULATOR SIMULATION COUNT !
OPLENGTH: INTEGER; ! OPERATOR INPUT LENGTH !
LAST: INTEGER; ! FIRST FREE POSITION IN BUFFER !
SAVPT: INTEGER; ! SAVED COMMAND POINTER !
ARGUMENT: INTEGER; ! COMMAND ARGUMENT !
RADIX: INTEGER; ! COMMAND ARGUMENT RADIX !
SIGN: INTEGER; ! COMMAND ARGUMENT SIGN !
COMCHAR: INTEGER; ! CHARACTER FROM COMMAND STRING !
COMMAND: INTEGER; ! COMMAND FROM COMMAND STRING !
CURPT: INTEGER; ! TEXT POINTER !
LINENO: INTEGER; ! LINE NUMBER BINARY !
DECLINENO: STRING(6); ! LINE NUMBER DECIMAL !
SCANPT: INTEGER; ! POINTER FROM WHICH CR IS SCANNED !
SLIDELENGTH: INTEGER; ! NO OF CHARACTERS TO SLIDE TEXT !
LOOPARGUMENT: INTEGER; ! LOOP COUNT FOR REPLACE COMMAND !
TEGN: INTEGER; ! I/O CHARACTER BUFFER !
BUFFERPT: INTEGER; ! POINTS AT END OF COMPT BUFFER !
CHAR1: STRING(1); ! HELP CHARACTER !
CHAR2: STRING(1); ! HELP CHARACTER !
VAR1: INTEGER; ! HELP VARIABEL !
VAR2: INTEGER; ! HELP VARIABEL !
VAR3: INTEGER; ! HELP VARIABEL !
OLDDRIVENO: INTEGER; ! TEST FOR INIT OF DISC !
LPTCHECK: INTEGER; ! LINEPRINTER CALL CHECK !
MACROPT: INTEGER; ! POINTS AT START OF MACRO !
MACROCHECK: INTEGER; ! TEST FOR MACRO ARE RECURSIVE !
SAVCOMPT: INTEGER; ! SAVE COMPT DURING MACRO !
ERRO1: INTEGER; ! DEVICE ERROR VARIABEL !
ERRO2: INTEGER; ! DEVICE ERROR VARIABEL !
FILECOUNT: INTEGER; ! FILECOUNT FOR BOT !
LAZYARG: INTEGER; ! COUNTS FOR EXECUTION OF MACRO !
DRIVENO: INTEGER; ! DISC DRIVE NUMBER !
BLOCKNO: INTEGER; ! BLOCKNUMBER !
FILENO: INTEGER; ! FILENUMBER !
KIND: INTEGER; ! KIND FOR DEVICE !
INMODE: INTEGER; ! MODE FOR INPUT DEVICE !
OUTMODE: INTEGER; ! MODE FOR OUTPUT DEVICE !
OPOUT: FILE 'TTY',
2,
1,
40,
UB
OF STRING(1);
IN: FILE "PTR", ! INPUT ZONE DESCRIPTOR !
1, ! KIND !
1, ! SHARES !
255, ! SHARESIZE !
U; ! UNFORMATTED !
GIVEUP INERROR, 8'161777
OF STRING(512); ! !
OUT: FILE "PTP", ! OUTPUT ZONE DESCRIPTOR !
1, ! KIND !
1, ! SHARES !
255, ! SHARESIZE !
UB; ! UNFORMATTED BLOCKED !
GIVEUP OUTERROR, 8'143777
OF STRING(512); ! !
«ff»
! RC36-00016 PAGE 05 !
PROCEDURE FILEMARK;
BEGIN
IF COMMAND = N THEN
BEGIN
VAR3:=OUT.ZFILE+1;
CLOSE(OUT,0); OPEN(OUT,3);
SETPOSITION(OUT,VAR3,1);
END;
END;
PROCEDURE ERROROPMESS;
BEGIN
OPMESS(ERRORS);
ERRO2:=20;
WHILE ERRO1 > 0 DO
BEGIN
ERRO2:=ERRO2+1;
ERRO1:=ERRO1 SHIFT 1;
END;
BINDEC(ERRO2,DECLINENO);
OPMESS(DECLINENO);
OPMESS(NEWLINE);
OPMESS(ERMS13);
OPIN(OPSTRING);
OPWAIT(ERRO1);
IF OPSTRING = STOP THEN GOTO 1000;
END;
PROCEDURE INERROR;
BEGIN
IF IN.Z0 AND 8'000040 <> 0 THEN GOTO 5095;
IF IN.Z0 AND 8'000020 <> 0 THEN
BEGIN
IF IN.ZREM <> 0 THEN GOTO 5095;
IN.ZFIRST:=IN.ZTOP; INSERT(25,IN^,0);
IN.ZREM:=1;
GOTO 5095;
END;
IF IN.Z0 AND 8'040000 <> 0 THEN
IF IN.ZKIND = 8'76 THEN
BEGIN
OPMESS(ERMS4);
GOTO 2060;
END;
IF IN.Z0 AND 8'000400 <> 0 THEN
BEGIN
IF COMMAND <> N THEN GOTO 5093;
FILECOUNT:=FILECOUNT+1;
IF FILECOUNT = 2 THEN
BEGIN
5093: IN.ZFIRST:=IN.ZTOP; INSERT(25,IN^,0); IN.ZREM:=1;
LAST:=0;
END;
IF OUT.ZNAME = CT THEN FILEMARK;
IF OUT.ZNAME = MT THEN FILEMARK;
GOTO 5095;
END;
OPMESS(IN.ZNAME);
ERRO1:=IN.Z0;
ERROROPMESS;
REPEATSHARE(IN);
5095: END;
«ff»
! RC36-00016 PAGE 06 !
PROCEDURE OUTERROR;
BEGIN
IF OUT.ZKIND = 8'76 THEN
BEGIN
IF OUT.Z0 AND 8'040000 <> 0 THEN OPMESS(ERMS4);
IF OUT.Z0 AND 8'020000 <> 0 THEN OPMESS(ERMS12);
IF OUT.Z0 AND 8'117777 <> 0 THEN GOTO 5085;
GOTO 2060;
END;
5085: OPMESS(OUT.ZNAME);
ERRO1:=OUT.Z0;
ERROROPMESS;
REPEATSHARE(OUT);
END;
PROCEDURE GETACHARACTER;
BEGIN
REPEAT
MOVE(BUFFER,COMPT,CHAR1,0,1);
COMCHAR:=BYTE CHAR1;
COMPT:=COMPT+1
UNTIL COMCHAR <> 13;
END;
PROCEDURE SIMULATETABS;
BEGIN
REPEAT
OUTCHAR(OPOUT,32);
TABSIM:=TABSIM+1
UNTIL TABSIM AND 7 = 0;
OUTBLOCK(OPOUT);
END;
PROCEDURE SLIDESTRING;
BEGIN
VAR1:=LAST; VAR3:=80;
REPEAT
IF VAR1-CURPT < 80 THEN VAR3:=VAR1-CURPT;
MOVE(BUFFER,VAR1-VAR3,OPSTRING,0,VAR3);
VAR1:=VAR1-VAR3;
MOVE(OPSTRING,0,BUFFER,VAR1+SLIDELENGTH,VAR3)
UNTIL VAR1= CURPT;
LAST:=LAST+SLIDELENGTH;
END;
PROCEDURE FEED;
BEGIN
VAR3:=10;
REPEAT
OUTCHAR(OUT,0);
VAR3:=VAR3-1
UNTIL VAR3 <= 0;
END;
PROCEDURE CALCULATELINENO;
BEGIN
VAR1:=0;
WHILE VAR1 < LAST DO
BEGIN
MOVE(BUFFER,VAR1,CHAR1,0,1);
IF BYTE CHAR1 = 13 THEN LINENO:=LINENO+1;
VAR1:=VAR1+1
END;
END;
«ff»
! RC36-00016 PAGE 07 !
PROCEDURE INSERTSTRING;
BEGIN
VAR2:=COMPT;
MOVE(BUFFER,COMPT,CHAR1,0,1);
WHILE BYTE CHAR1 <> 27 DO
BEGIN
MOVE(BUFFER,COMPT,CHAR1,0,1);
COMPT:=COMPT+1;
END;
IF COMPT = VAR2 THEN GOTO 5025;
SLIDELENGTH:=COMPT-(VAR2+1);
IF SLIDELENGTH + LAST > BUFFERPT - 25 THEN
BEGIN
OPMESS(ERMS8);
COMPT:=0; LAZYARG:=0; GOTO 1000;
END;
SLIDESTRING;
MOVE(BUFFER,VAR2,BUFFER,CURPT,SLIDELENGTH);
CURPT:=CURPT+SLIDELENGTH;
5025: END;
PROCEDURE SCANCR;
BEGIN
IF ARGUMENT > 0 THEN
BEGIN
REPEAT
MOVE(BUFFER,SCANPT,CHAR1,0,1);
IF BYTE CHAR1 = 13 THEN ARGUMENT:=ARGUMENT-1;
IF SCANPT >= LAST THEN
BEGIN
SCANPT:=LAST;
GOTO 5010;
END;
SCANPT:=SCANPT+1
UNTIL ARGUMENT <1;
GOTO 5010;
END;
IF ARGUMENT <=0 THEN
BEGIN
MOVE(BUFFER,SCANPT,CHAR1,0,1);
IF BYTE CHAR1 = 13 THEN SCANPT:=SCANPT-1;
REPEAT
MOVE(BUFFER,SCANPT,CHAR1,0,1);
IF BYTE CHAR1 = 13 THEN ARGUMENT:=ARGUMENT+1;
SCANPT:=SCANPT-1;
IF SCANPT < -1 THEN ARGUMENT:=1
UNTIL ARGUMENT > 0;
SCANPT:=SCANPT+2;
IF SCANPT < 0 THEN SCANPT:=0;
END;
5010: END;
«ff»
! RC36-00016 PAGE 08 !
PROCEDURE LASTESCAPE;
BEGIN
MOVE(BUFFER,VAR1+1,CHAR1,0,1);
IF BYTE CHAR1 = 27 THEN
BEGIN
IF BYTE PRVCH <> 8 THEN OUTCHAR(OPOUT,36);
VAR1:=BUFFERSIZEM3;
END;
TEGN:=36;
END;
PROCEDURE HELPPRINT;
BEGIN
IF OPTEST <> 0 THEN LINENO:=0;
MOVE(BUFFER,VAR1,CHAR1,0,1);
TEGN:=BYTE CHAR1;
IF TEGN > 31 THEN TABSIM:=TABSIM+1;
IF TEGN < 32 THEN
BEGIN
IF TEGN = 12 THEN
BEGIN
OUTCHAR(OPOUT,94);
OUTCHAR(OPOUT,76);
TABSIM:=0;
GOTO 5030;
END;
IF TEGN = 27 THEN LASTESCAPE;
IF TEGN = 13 THEN
BEGIN
TABSIM:=0;
LINENO:=LINENO-1;
END;
IF TEGN = 9 THEN
BEGIN
SIMULATETABS;
GOTO 5030;
END;
END;
OUTCHAR(OPOUT,TEGN);
5030: VAR1:=VAR1+1;
IF VAR1 = LAST THEN LINENO:=0;
END;
«ff»
! RC36-00016 PAGE 09 !
PROCEDURE TYPECOMMAND;
BEGIN
TABSIM:=0; LAZYARG:=0; VAR1:=SAVPT; COMPT:=0;
WHILE VAR1 < BUFFERSIZEM3 DO HELPPRINT;
OUTBLOCK(OPOUT);
END;
PROCEDURE SEARCHSTRING;
BEGIN
VAR2:=COMPT;
WHILE CURPT <= LAST DO
BEGIN
MOVE(BUFFER,CURPT,CHAR1,0,1);
MOVE(BUFFER,VAR2,CHAR2,0,1);
IF BYTE CHAR2 = 27 THEN GOTO 5000;
IF BYTE CHAR1 <> BYTE CHAR2 THEN
BEGIN
CURPT:=CURPT-(VAR2-COMPT)+1;
VAR2:=COMPT;
GOTO 5004;
END;
CURPT:=CURPT+1;
VAR2:=VAR2+1;
5004: END;
IF CURPT >=LAST THEN CURPT:=0;
5000: ARGUMENT:=VAR2-COMPT;
COMPT:=VAR2+1;
END;
PROCEDURE LINEPRINT;
BEGIN
IF TEGN = 12 THEN
BEGIN
TABSIM:=0;
OUTCHAR(OUT,12);
GOTO 5060;
END;
IF TEGN = 9 THEN
BEGIN
REPEAT
OUTCHAR(OUT,31);
TABSIM:=TABSIM+1
UNTIL TABSIM AND 7 = 0;
GOTO 5060;
END;
IF TEGN > 31 THEN TABSIM:=TABSIM+1;
IF TEGN = 32 THEN
BEGIN
OUTCHAR(OUT,31);
GOTO 5060;
END;
END;
«ff»
! RC36-00016 PAGE 10 !
PROCEDURE PUNCHPAGE;
BEGIN
IF OUT.ZMODE = 0 THEN
BEGIN
OPMESS(ERMS7);
GOTO 2060;
END;
IF CURPT = LAST THEN IF ARGUMENT <> 0 THEN GOTO 5050;
IF LAST = 0 THEN GOTO 5050;
TABSIM:=0;
VAR1:=CURPT;
IF ARGUMENT = 0 THEN
BEGIN
VAR1:=0;
ARGUMENT:=10000;
END;
REPEAT
BEGIN
MOVE(BUFFER,VAR1,CHAR1,0,1);
TEGN:=BYTE CHAR1;
IF LPTCHECK = 1 THEN LINEPRINT;
IF TEGN < 32 THEN
BEGIN
IF TEGN=9 THEN
BEGIN
OUTCHAR(OUT,127);
OUTCHAR(OUT,9);
GOTO 5060;
END;
IF TEGN=13 THEN
BEGIN
TABSIM:=0;
OUTCHAR(OUT,10);
OUTCHAR(OUT,13);
ARGUMENT:=ARGUMENT-1;
IF ARGUMENT <= 0 THEN VAR1:=LAST;
GOTO 5060;
END;
IF TEGN=12 THEN
BEGIN
IF OUT.ZNAME = PTP THEN FEED;
OUTCHAR(OUT,12);
IF OUT.ZNAME = PTP THEN FEED;
END;
GOTO 5060;
END;
OUTCHAR(OUT,TEGN);
5060: VAR1:=VAR1+1;
END
UNTIL VAR1 >=LAST;
IF COMCHAR <> 87 THEN
BEGIN
IF OUT.ZNAME = PTP THEN FEED;
OUTCHAR(OUT,12);
IF OUT.ZNAME = PTP THEN FEED;
END;
5050: END;
«ff»
! RC36-00016 PAGE 11 !
PROCEDURE APPENDPAGE;
BEGIN
IF IN.ZMODE = 0 THEN
BEGIN
OPMESS(ERMS6);
GOTO 2060;
END;
IF COMPT-LAST <= 50 THEN GOTO 7;
LINENO:= 1;
CALCULATELINENO;
FILECOUNT:=0;
REPEAT
INCHAR(IN,TEGN);
TEGN:=TEGN AND 127;
INSERT(TEGN,BUFFER,LAST);
IF TEGN < 32 THEN
BEGIN
IF TEGN = 0 THEN LAST:=LAST-1;
IF TEGN =10 THEN LAST:=LAST-1;
IF TEGN = 12 THEN GOTO 9;
IF TEGN = 13 THEN LINENO:= LINENO+1;
IF TEGN = 25 THEN GOTO 9;
IF TEGN = 26 THEN
BEGIN
BINDEC(LINENO,DECLINENO);
MOVE(DECLINENO,1,ERMS5,28,4);
OPMESS(ERMS5);
INSERT(92,BUFFER,LAST);
KIND:=0;
END;
END;
IF TEGN < 127 THEN LAST:=LAST+1
UNTIL COMPT-LAST < 50;
IF COMPT-LAST <= 50 THEN
BEGIN
7: OPMESS(ERMS2);
GOTO 2060;
END;
9: INSERT(27,BUFFER,LAST);
END;
PROCEDURE FILECHECK;
BEGIN
IF FILENO = 0 THEN
BEGIN
OPMESS(ERMS10);
GOTO 2060;
END;
END;
«ff»
! RC36-00016 PAGE 12 !
PROCEDURE DISPLAY;
BEGIN
BINDEC(ARGUMENT,DECLINENO);
OPMESS(DECLINENO);
OPMESS(NEWLINE);
END;
PROCEDURE DELETESTRING;
BEGIN
IF ARGUMENT < 0 THEN
BEGIN
MOVE(BUFFER,CURPT,BUFFER,CURPT+ARGUMENT,LAST-CURPT+1);
CURPT:= CURPT+ARGUMENT;
LAST:= LAST+ARGUMENT;
END;
IF ARGUMENT > 0 THEN
BEGIN
MOVE(BUFFER,CURPT+ARGUMENT,BUFFER,CURPT,
LAST-CURPT-ARGUMENT+1);
LAST:= LAST-ARGUMENT;
END;
END;
PROCEDURE DELETECOMMAND;
BEGIN
IF COMPT >= BUFFERPT - 1 THEN
BEGIN
OPMESS(NEWLINE);
GOTO 1000;
END;
VAR2:=TABSIM; TABSIM:=0;
VAR1:=BUFFERPT-2;
HELPPRINT;
ERRO1:= LAST; ERRO2:=CURPT;
CURPT:=COMPT; LAST:=BUFFERPT-2;
SLIDELENGTH:=2; SLIDESTRING;
LAST:=ERRO1; CURPT:=ERRO2;
TABSIM:=VAR2-1; COMPT:=COMPT+2;
OUTBLOCK(OPOUT);
END;
PROCEDURE INIT;
BEGIN
IF OLDDRIVENO SHIFT (-DRIVENO) EXTRACT 1 = 0 THEN
BEGIN
IF COMMAND = R THEN INITCAT(IN,DRIVENO,0);
IF COMMAND = W THEN INITCAT(OUT,DRIVENO,0);
LINENO:=1;
OLDDRIVENO:=OLDDRIVENO + (LINENO SHIFT DRIVENO);
END;
END;
PROCEDURE CLOSEOUT;
BEGIN
IF OUT.ZMODE <> 0 THEN
BEGIN
IF OUT.ZKIND = 8'76 THEN
WHILE OUT.ZREM > 0 DO OUTCHAR(OUT,25);
CLOSE(OUT,1);
END;
END;
«ff»
! RC36-00016 PAGE 13 !
PROCEDURE GETNAME;
BEGIN
MOVE(BINARYZERO,0,NEWNAME,0,6);
VAR1:=0; VAR2:=1;
BLOCKNO:=1; FILENO:=0;
GETACHARACTER;
IF COMCHAR= DOLLAR THEN
BEGIN
VAR2:=0;
GETACHARACTER;
END;
REPEAT
IF COMCHAR = 27 THEN GOTO 500;
IF COMCHAR = COLON THEN GOTO 400;
INSERT(COMCHAR,NEWNAME,VAR1);
GETACHARACTER;
VAR1:=VAR1+1
UNTIL VAR1 > 6;
300: OPMESS(ERMS4);
GOTO 2060;
400: ! READ IN A FILENUMBER !
MOVE(BUFFER,COMPT,DECLINENO,0,6);
DECBIN(DECLINENO,FILENO);
REPEAT
GETACHARACTER
UNTIL COMCHAR = 27;
500: IF VAR2 <> 0 THEN
BEGIN ! DISCFILE !
BLOCKNO:=0;
INMODE:=1;
OUTMODE:=3;
KIND:= 8'76;
DRIVENO:=FILENO; FILENO:=0;
INSERT(DRIVENO,NEWNAME,5);
GOTO 600;
END;
IF VAR2 = 0 THEN ! NORMAL DEVICE !
REPEAT
MOVE(DEVICES,VAR2,DECLINENO,0,6);
IF NEWNAME = DECLINENO THEN
BEGIN
MOVE(DEVICES,VAR2+6,DECLINENO,0,3);
KIND:=BYTE DECLINENO;
INMODE:=WORD DECLINENO EXTRACT 8;
MOVE(DECLINENO,2,DECLINENO,0,1);
OUTMODE:=BYTE DECLINENO;
IF NEWNAME = MT THEN FILECHECK;
IF NEWNAME = CT THEN FILECHECK;
IF NEWNAME = FD THEN FILECHECK;
GOTO 600;
END;
VAR2:=VAR2+9
UNTIL VAR2 > DEVICECOUNT;
GOTO 300; ! ERROR !
600: END;
«ff»
! RC36-00016 PAGE 14 !
BEGIN
10: OPMESS(NEWLINE);
IN.ZMODE:=0; OUT.ZMODE:=0;
OLDDRIVENO:=0;
BUFFERPT:=BUFFERSIZEM3;
LAZYARG:=0; MACROPT:=BUFFERSIZEM3;
OPEN(OPOUT,3);
INSERT(27,BUFFER,BUFFERSIZEM3);
INSERT(27,BUFFER,BUFFERSIZEM3+1);
INSERT(27,BUFFER,BUFFERSIZEM3+2);
LAST:= 0; CURPT:= 0; COMPT:= 0;
1000: IF LAZYARG > 0 THEN GOTO 5090;
IF COMPT - 2 > BUFFERPT THEN
BEGIN
COMPT:=SAVCOMPT;
GOTO 2000;
END;
1005: COMPT:=BUFFERPT;
OPMESS(ASTERISK);
MACROCHECK:=0;
PRVCH:=SPACE;
TABSIM:=1;
1010: OPIN(OPSTRING);
OPWAIT(OPLENGTH);
TABSIM:=TABSIM+OPLENGTH;
1020: IF BYTE PRVCH = 27 THEN IF BYTE OPSTRING = 27 THEN
BEGIN
OPMESS(ESCAPENEWLINE);
GOTO 2000;
END;
1030: MOVE(OPSTRING,OPLENGTH-1,PRVCH,0,1);
IF BYTE PRVCH = 9 THEN
BEGIN
TABSIM:= TABSIM-1;
SIMULATETABS;
END;
IF BYTE PRVCH = 10 THEN
BEGIN
INSERT(13,OPSTRING,OPLENGTH-1);
TABSIM:=0;
END;
IF BYTE PRVCH = 13 THEN TABSIM:=0;
IF BYTE PRVCH = 12 THEN
BEGIN
OUTCHAR(OPOUT,94);
OUTCHAR(OPOUT,76);
OUTBLOCK(OPOUT);
TABSIM:= 0;
END;
IF BYTE PRVCH = 27 THEN OPMESS(ESCAPE);
1040: IF COMPT < LAST+OPLENGTH+10 THEN
BEGIN
OPMESS(ERMS8);
LAST:=LAST-20;
GOTO 1000;
END;
MOVE(BUFFER,COMPT,BUFFER,COMPT-OPLENGTH,BUFFERPT-COMPT);
COMPT:= COMPT-OPLENGTH;
MOVE(OPSTRING,0,BUFFER,BUFFERPT-OPLENGTH,OPLENGTH);
IF BYTE PRVCH = 8 THEN DELETECOMMAND;
GOTO 1010;
«ff»
! RC36-00016 PAGE 15 !
2060: OPMESS(ERMS9);
TYPECOMMAND;
GOTO 1000;
2000: SAVPT:= COMPT;
ARGUMENT:= 0;
RADIX:= 10;
SIGN:= 1;
GETACHARACTER;
IF COMCHAR = 34 THEN
BEGIN
RADIX:= 8;
GETACHARACTER;
END;
IF COMCHAR = 43 THEN GOTO 2020;
IF COMCHAR = 45 THEN
BEGIN
SIGN:=-SIGN;
2020: GETACHARACTER;
END;
2010: IF COMCHAR >= 48 THEN
IF COMCHAR <= 57 THEN
BEGIN
IF COMCHAR-48 > RADIX THEN GOTO 2060;
ARGUMENT:= ARGUMENT*RADIX+COMCHAR-48;
GOTO 2020;
END;
ARGUMENT:= (ARGUMENT AND 8'3777)*SIGN;
IF COMCHAR = 27 THEN
BEGIN
GETACHARACTER;
IF COMCHAR = 27 THEN GOTO 1000;
COMPT:=COMPT-1;
GOTO 2000;
END;
COMMAND:=COMCHAR;
IF COMMAND = A THEN
BEGIN
CURPT:= LAST;
APPENDPAGE;
IF LAST = CURPT THEN GOTO 2060;
GOTO 2000;
END;
IF COMMAND = B THEN
BEGIN
CURPT:= 0;
GOTO 2000;
END;
IF COMMAND = C THEN
BEGIN
SEARCHSTRING;
IF CURPT = 0 THEN
BEGIN
OPMESS(ERMS3);
GOTO 2060;
END;
ARGUMENT:= -ARGUMENT;
DELETESTRING;
INSERTSTRING;
GOTO 2000;
END;
«ff»
! RC36-00016 PAGE 16 !
IF COMMAND = D THEN
BEGIN
IF CURPT + ARGUMENT > LAST THEN
ARGUMENT:= LAST-CURPT;
IF ARGUMENT < 0 THEN
IF CURPT + ARGUMENT < 0 THEN
ARGUMENT:= -CURPT;
DELETESTRING;
GOTO 2000;
END;
IF COMMAND = E THEN
BEGIN
REPEAT
ARGUMENT:= 0;
PUNCHPAGE;
LAST:= 0;
CURPT:= 0;
APPENDPAGE;
IF KIND = 0 THEN GOTO 1000
UNTIL LAST = 0;
GOTO 2000;
END;
IF COMMAND = F THEN
BEGIN
IF OUT.ZMODE = 0 THEN
BEGIN
OPMESS(ERMS7);
GOTO 2060;
END;
IF OUT.ZNAME <> PTP THEN
BEGIN
IF ARGUMENT = 0 THEN OUTCHAR(OUT,12);
GOTO 2000;
END;
IF ARGUMENT < 0 THEN GOTO 2000;
IF ARGUMENT = 0 THEN
BEGIN
FEED;
OUTCHAR(OUT,12);
FEED;
GOTO 2000;
END;
IF ARGUMENT > 1000 THEN ARGUMENT:= 1000;
ARGUMENT:= ARGUMENT*10;
WHILE ARGUMENT > 0 DO
BEGIN
OUTCHAR(OUT,0);
ARGUMENT:= ARGUMENT-1;
END;
GOTO 2000;
END;
«ff»
! RC36-00016 PAGE 17 !
IF COMMAND = G THEN
BEGIN
GETACHARACTER;
COMMAND:=COMCHAR;
IF COMCHAR = K THEN
BEGIN
GETNAME;
OUT.ZKIND:=KIND;
OUT.ZNAME:=NEWNAME;
REMOVEENTRY(OUT);
GOTO 2000;
END;
IF COMCHAR = R THEN
BEGIN
! CHANGE OF INPUT FILES !
IF IN.ZMODE <> 0 THEN CLOSE(IN,1);
GETNAME;
IF INMODE = 0 THEN
BEGIN
OPMESS(ERMS6);
GOTO 2060;
END;
IN.ZKIND:=KIND;
IN.ZNAME:=NEWNAME;
IF IN.ZKIND = 8'76 THEN INIT;
OPEN(IN,INMODE);
SETPOSITION(IN,FILENO,BLOCKNO);
GOTO 2000;
END;
IF COMCHAR = C THEN
BEGIN
! CLOSE ALL FILES !
IF IN.ZMODE <> 0 THEN CLOSE(IN,1);
CLOSEOUT;
GOTO 2000;
END;
«ff»
! RC36-00016 PAGE 18 !
IF COMCHAR = W THEN
BEGIN
! CHANGE OF OUTPUT FILES !
LPTCHECK:=0;
CLOSEOUT;
GETNAME;
IF OUTMODE = 0 THEN
BEGIN
OPMESS(ERMS7);
GOTO 2060;
END;
OUT.ZKIND:=KIND;
OUT.ZNAME:=NEWNAME;
IF OUT.ZNAME = LPTC THEN LPTCHECK:=1;
IF OUT.ZNAME = LPT THEN LPTCHECK:=1;
IF OUT.ZNAME = SP THEN LPTCHECK:=1;
IF KIND = 8'76 THEN
BEGIN
INIT;
CREATEENTRY(OUT,10,1);
END;
OUT.ZSHAREL:=512;
IF OUT.ZNAME = CT THEN OUT.ZSHAREL:=80;
IF OUT.ZNAME = MT THEN OUT.ZSHAREL:=80;
OPEN(OUT,OUTMODE);
SETPOSITION(OUT,FILENO,BLOCKNO);
GOTO 2000;
END;
IF COMCHAR = I THEN
BEGIN
GETNAME;
IF NEWNAME <> NEW THEN GOTO 2060;
OUT.ZKIND:=KIND;
OUT.ZNAME:=NEWNAME;
INITCAT(OUT,DRIVENO,1);
GOTO 2000;
END;
! COMCHAR <> R/W/C !
COMPT:=SAVPT;
GOTO 2060;
END;
«ff»
! RC36-00016 PAGE 19 !
IF COMMAND = H THEN
BEGIN
REPEAT
ARGUMENT:= 0;
PUNCHPAGE;
LAST:= 0;
CURPT:= 0;
APPENDPAGE;
IF KIND = 0 THEN GOTO 1000
UNTIL LAST = 0;
CLOSE(IN,1);
CLOSEOUT;
GOTO 1000;
END;
IF COMMAND = I THEN
BEGIN
IF ARGUMENT = 0 THEN
BEGIN
INSERTSTRING;
GOTO 2000;
END;
IF ARGUMENT < 0 THEN GOTO 2060;
SLIDELENGTH:= 1;
SLIDESTRING;
ARGUMENT:= ARGUMENT AND 127;
INSERT(ARGUMENT,BUFFER,CURPT);
CURPT:= CURPT+1;
GOTO 2000;
END;
IF COMMAND = J THEN
BEGIN
ARGUMENT:= ARGUMENT-1;
IF ARGUMENT <=0 THEN ARGUMENT:=0;
SCANPT:= 0;
SCANCR;
CURPT:= SCANPT;
GOTO 2000;
END;
«ff»
! RC36-00016 PAGE 20 !
IF COMMAND = K THEN
BEGIN
SCANPT:= CURPT;
SCANCR;
ARGUMENT:= SCANPT-CURPT;
DELETESTRING;
GOTO 2000;
END;
IF COMMAND = L THEN
BEGIN
SCANPT:= CURPT;
SCANCR;
CURPT:= SCANPT;
GOTO 2000;
END;
IF COMMAND = M THEN
BEGIN
CURPT:=ARGUMENT+CURPT;
IF CURPT<0 THEN CURPT:=0;
IF CURPT>LAST THEN CURPT:=LAST;
GOTO 2000;
END;
IF COMMAND = N THEN
BEGIN
SEARCHSTRING;
WHILE CURPT = 0 DO
BEGIN
ARGUMENT:= 0;
PUNCHPAGE;
CURPT:= 0;
LAST:= 0;
APPENDPAGE;
IF KIND = 0 THEN GOTO 1000;
IF LAST = CURPT THEN
BEGIN
OPMESS(ERMS3);
GOTO 2060;
END;
COMPT:=COMPT-1;
SEARCHSTRING;
END;
GOTO 2000;
END;
«ff»
! RC36-00016 PAGE 21 !
IF COMMAND = P THEN
BEGIN
IF ARGUMENT < 0 THEN GOTO 2060;
GETACHARACTER;
IF COMCHAR <> 87 THEN COMPT:=COMPT-1;
PUNCHPAGE;
GOTO 2000;
END;
IF COMMAND = Q THEN
BEGIN
SEARCHSTRING;
WHILE CURPT = 0 DO
BEGIN
CURPT:=0;
LAST:= 0;
APPENDPAGE;
IF KIND = 0 THEN GOTO 1000;
IF LAST = CURPT THEN
BEGIN
OPMESS(ERMS3);
GOTO 2060;
END;
COMPT:=COMPT-1;
SEARCHSTRING;
END;
GOTO 2000;
END;
IF COMMAND = R THEN
BEGIN
IF ARGUMENT < 0 THEN GOTO 2060;
LOOPARGUMENT:= ARGUMENT;
ARGUMENT:= 0;
REPEAT
PUNCHPAGE;
CURPT:= 0;
LAST:= 0;
APPENDPAGE;
IF KIND = 0 THEN GOTO 1000;
IF LAST = CURPT THEN GOTO 2060;
LOOPARGUMENT:= LOOPARGUMENT-1
UNTIL LOOPARGUMENT <=0;
GOTO 2000;
END;
IF COMMAND = S THEN
BEGIN
SEARCHSTRING;
IF CURPT = 0 THEN
BEGIN
OPMESS(ERMS3);
GOTO 2060;
END;
GOTO 2000;
END;
«ff»
! RC36-00016 PAGE 22 !
IF COMMAND = T THEN
BEGIN
IF ARGUMENT < 0 THEN GOTO 2060;
IF LAST = 0 THEN GOTO 2000;
IF ARGUMENT > 0 THEN LINENO:=ARGUMENT;
IF CURPT >= LAST THEN
IF ARGUMENT > 0 THEN LINENO:=0;
IF ARGUMENT = 0 THEN LINENO:=10000;
VAR1:=CURPT;
IF ARGUMENT = 0 THEN VAR1:=0;
TABSIM:=0;
OPIN(OPSTRING);
WHILE LINENO > 0 DO HELPPRINT;
OUTBLOCK(OPOUT);
GOTO 2000;
END;
IF COMMAND = X THEN
BEGIN
IF ARGUMENT < 0 THEN GOTO 2060;
GETACHARACTER;
IF COMCHAR = M THEN
BEGIN
MACROPT:=COMPT;
BUFFERPT:=SAVPT;
INSERT(27,BUFFER,SAVPT);
INSERT(27,BUFFER,SAVPT+1);
GOTO 1005;
END;
IF COMCHAR = D THEN
BEGIN
MACROPT:=BUFFERSIZEM3;
BUFFERPT:=BUFFERSIZEM3;
GOTO 1000;
END;
IF MACROPT = BUFFERSIZEM3 THEN
BEGIN
OPMESS(ERMS14);
GOTO 2060;
END;
IF MACROCHECK = X THEN
BEGIN
OPMESS(ERMS11);
BUFFERPT:=BUFFERSIZEM3;
MACROPT:=BUFFERSIZEM3;
END;
MACROCHECK:=X;
COMPT:=COMPT-1;
SAVCOMPT:=COMPT;
LAZYARG:=ARGUMENT;
5090: COMPT:=MACROPT;
LAZYARG:=LAZYARG-1;
GOTO 2000;
END;
«ff»
! RC36-00016 PAGE 23 !
IF COMMAND = Y THEN
BEGIN
LAST:= 0;
CURPT:= 0;
APPENDPAGE;
IF LAST = CURPT THEN GOTO 2060;
GOTO 2000;
END;
IF COMMAND = Z THEN
BEGIN
CURPT:= LAST;
GOTO 2000;
END;
IF COMMAND = DOT THEN
BEGIN
ARGUMENT:=LAST;
LAST:=CURPT;
LINENO:= 1;
CALCULATELINENO;
LAST:=ARGUMENT;
ARGUMENT:= LINENO;
DISPLAY;
GOTO 2000;
END;
IF COMMAND = COLON THEN
BEGIN
LINENO:= 0;
CALCULATELINENO;
ARGUMENT:= LINENO;
DISPLAY;
GOTO 2000;
END;
IF COMMAND = EQUAL THEN
BEGIN
ARGUMENT:= LAST;
DISPLAY;
GOTO 2000;
END;
GOTO 2060;
END;
«ff»