|
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
Notes: RCSL-43-GL-196, RCSL-43-GL-6500, RCSL-43-GL-6501, RCSL-43-GL-6502
Names: »SPTMT«
└─⟦a59f0a452⟧ Bits:30000472 DOMUS disk image
└─⟦this⟧ »/SPTMT«
! RCSL : 43-GL6501
AUTHOR: JSVJ
EDITED: 78.03.17
PROGRAM RC36-00813.00
GENERERING AF MT TIL P OG T TEST.
KEYWORDS: MUSIL,CONVERSION,CT,MTA,SP,LISTING
ABSTRACT: THIS PROGRAM HANDLES DISKETTES WRITTEN
IN IBM 3740 FORMAT WITH EBCDIC DATA.
OUTPUT IS ON STANDARD IBM OS LABELLED MAGNETIC
TAPES WITH EBCDIC CODE DATA. THE INPUT RECORDS
ARE MAX. 256 CHARACTERS. ONE INPUT RECORD
IS ONE BLOCK ON THE MAGNETIC TAPE. THE MAGNETIC
TAPE WILL ONLY CONTAIN ONE DATASET.
A LOG CONTAINING STATISTICS FOR THE JOB IS
PRINTED ON EITHER SERIAL PRINTER OR TTY.
THE PROGRAM MUST BE OPERATED FROM TTY.
RCSL 43-GL6500: ASCII SOURCE TAPE
RCSL 43-GL6502: REL.BIN/TTY !
«ff»
! RC36-00813 PAGE 01
TITLE: DISKETTE TO LABELLED MAG-TAPE WITH LOG.
ABSTRACT: THIS PROGRAM HANDLES DISKETTES WRITTEN
IN IBM 3740 FORMAT WITH EBCDIC DATA.
OUTPUT IS ON STANDARD IBM OS LABELLED MAGNETIC
TAPES WITH EBCDIC CODE DATA. THE INPUT RECORDS
ARE MAX. 256 CHARACTERS. ONE INPUT RECORD
IS ONE BLOCK ON THE MAGNETIC TAPE. THE MAGNETIC
TAPE WILL ONLY CONTAIN ONE DATASET.
A LOG CONTAINING STATISTICS FOR THE JOB IS
PRINTED ON EITHER SERIAL PRINTER OR TTY.
THE PROGRAM MUST BE OPERATED FROM TTY.
SIZE: 6878 BYTES. INCLUDING TWO 128 BYTES INPUT BUFFERS
AND FOUR 172 BYTES OUTPUT BUFFER.
DATE: 78.03.17.
RUNTIME PARAMETERS:
RECORDSIZE : 00172 RECORDSIZE MAX. 172 CHARACTERS.
LABELCHECK : + INDICATES IF EXPIRATION DATE ON THE OUTPUT
TAPE SHOULD BE CHECKED BEFORE WRITING.
VOL SER NO : (MAX. 6 CHARACTERS)
IF THIS PARAMETER IS EMPTY, THE OUTPUTTAPE
MUST CONTAIN A VOLUME LABEL. AFTER
PROCESSING THIS PARAMETER CONTAINS
THE VOLUME SERIAL NUMBER.
IF THE PARAMETER IS NON EMPTY AND THE
OUTPUTTAPE HAS A VOLUME LABEL, THEN
THE VOLUME SERIAL NUMBER MUST BE THE
SAME AS THE PARAMETER.
FINALLY, IF THE PARAMETER IS NON-
EMPTY AND THE OUTPUTTAPE HAS NO
VOLUME LABEL, A VOLUME LABEL WITH THIS
SERIAL NUMBER IS CREATED.
DATA IDENTIFIER: (MAX.17 CHARACTERS)
EXPIRATION DATE: 00000 (5 DIGITS) YYDDD (DDD: DAY-NO - YY: YEAR).
MT DENSITY : 1600 1600/800.
«ff»
RC36-00813 PAGE 02
OTHER OUTPUT MESSAGES:
CONTSTATE: +/- STATE OF CONTINUE SWITCH.
CONTSTATE=+ MEANS THAT MORE DISKETTES SHALL
BE COPIED INTO ONE OUTPUTFILE.
CONTSTATE=- MEANS THAT THE JOB IS TERMINATED
AT END OF FILE FROM DISKETTE.
PROG NO : 813 PROGRAM EXECUTION IS STOPPED.
RUNNING PROGRAM EXECUTION IS STARTED.
MOUNT NEXT DISKETTE END OF FILE WAS MET ON DISKETTE.
AND CONTSTATE=+.
WRITE START, STOP OR CONT. (CONT WILL
TERMINATE THE JOB )
TAPE PROTECTED LABELCHEK = +, AND DATE < EXPIRATIONDATE
ON OUTPUTTAPE.
VOLUME LABEL MISSINGVOL SER NO IS EMPTY AND THERE IS NO
VOLUME LABEL ON THE OUTPUTTAPE.
EXPIRATION DATE ERROR EXPIRATION DATE > 99366.
MT DENSITY ERROR MT DENSITY NOT SPECIFIED TO 1600 OR 800.
MOUNT DATA TAPE MT-UNIT IS NOT ON-LINE.
MT ERROR NNNNN CONSULT THE RC3600 OPERATORS MANUAL.
CT ERROR NNNNN CONSULT THE RC3600 OPERATORS MANUAL.
END-OF-TAPE MARK EOT MARK DETECTED.
STOP WILL IN THIS CASE TERMINATE THE JOB.
END JOB PROGRAM EXECUTION IS TERMINATED NORMALLY,
AND THE PROGRAM IS READY TO WRITE A NEW
OUTPUTTAPE.
SUSPENDED THE JOB IS TERMINATED ABNORMALLY,AND THE
OUTPUTTAPE IS REWOUND.
ON/OFF CURRENT STATE OF CONTINUE.
«ff»
RC36-00813 PAGE 03
INPUT MESSAGES:
STOP STOPS EXECUTION WRITING PROG NO : 813.
STOP HAS NO EFFECT AFTER AN DEVICE EROOR
MESSAGE.
SUSPEND TERMINATES THE JOB ABNORMALLY.
THE OUTPUTAPE IS REWOUND.
<ESC> NEXT PARAMETER IS DISPLAYED
STATE ALL RUNTIME PARAMETERS ARE DISPLAYED
"VALUE" CURRENTLY DISPLAYED RUNTIME PARAMETER
IS CHANGED TO "VALUE".
"TEXT"="VALUE" THE RUNTIME PARAMETER IDENTIFIED BY "TEXT" IS
CHANGED TO "VALUE"
CONT STATE OF CONTINUE SWITCH IS INVERTED.
CURRENT STATE OF CONTINUE IS DISPLAYED(ON/OFF).
START PROGRAM EXECUTION IS STARTED.
NOTE: AFTER MT ERROR START MEANS
REPEATING THE WRITE/READ OPERATION.
AFTER ERROR ON DISKETTE IT MEANS ACCEPTING
THE ERRONEUS BLOCK.
ACCEPT IN CASE OF SEQUENCE ERROR AND DISKETTE IS
WANTED ANYWAY, TYPE ACCEPT.
SPECIAL REQUIREMENTS: CODEPROCEDURE P0005 (GETDATE) RCSL: 43-GL196.
!
«ff»
! RC36-00813 PAGE 04 !
CONST
NOQ= 11,
OPTXTS=
'<10>PROG NO : 813<0>
<10>VOLUME IDENT : <0>
<10>DATASET NAME : <0>
<10>RECORDSIZE : <0>
<10>LABELCHECK : <0>
<10>VOL SER NO : <0>
<10>DATA IDENTIFIER: <0>
<10>EXPIRATION DATE: <0>
<10>MTUNIT : <0>
<10>MTDENSITY : <0>
<10>LOGPRINT : <0>',
START= 'START',
STOP= 'STOP',
SUSPEND= 'SUSPEND',
CONT= 'CONT',
STATE= 'STATE',
ACCEPT = 'ACCEPT',
MINUS= '-',
PLUS= '+',
FIVE= '<5><0>',
FIFTEEN= '<15><0>',
NL= '<10><0>',
NEXTPARAM= '<27>',
ENDLINE= '<13><0>',
BELL= '<7><7><7>',
RUNTXT= '<8><4><10>RUNNING<13><0>',
SUSTXT= '<7><10>SUSPENDED<13><10>',
FDTXT= '<7><10>FD ERROR ',
MTTXT= '<7><10>MT ERROR ',
EOJTXT= '<14><7><10>END JOB<13><0>',
MOUNTDISK= '<7><10>MOUNT DISKETTE<13><0>',
FDEOF= '<7><10>MOUNT NEXT DISKETTE<13><0>',
MTMOUNTTAPE= '<14><7><10>MOUNT DATA TAPE<13><0>',
ENDTAPE= '<14><7><10>END-OF-TAPE MARK<13><0>',
CONTSTATE= '<10>CONSTATE : <0>',
IDENTEMPTY= '<7><10>DATA IDENTIFIER EMPTY<13>',
WRONGVOL= '<7><10>WRONG VOLUME LABEL<13>',
PROTECTTXT= '<7><10>TAPE PROTECTED<13><0>',
EXERROR= '<7><10>EXPIRATION DATE ERROR<13><0>',
DENERROR= '<7><10>MT DENSITY ERROR<13><0>',
RECERROR= '<7><10>RECORDSIZE ERROR<13><0>',
WRONGUNIT= '<7><10>MT UNIT CONFLICT<13><0>',
VOLMIS= '<7><10>VOLUME LABEL MISSING<13><0>',
INITEXP= '00000<0>',
INITINF= '<0><0><0><0><0><0><0><0><0><0><0><0><0><0><0><0><0><0><0><0>',
INITVOLSER= ' <0>',
READ= 8'122,
ZERO= 8'60,
ASCIISPS= ' ',
«ff»
! RC36-00813 PAGE 05 !
VOL1=
'VOL10
',
HDR1=
'HDR1 00000000010001000101
0000000 ',
HDR2=
'HDR2F000000000000
',
EOF1= 'EOF1',
EOF2= 'EOF2',
VOL1L= '<229><214><211><241>',
HDR1L= '<200><196><217><241>',
HDR2L= '<200><196><217><242>',
DEN800= '2',
DEN1600= '3',
ON= 'ON<13><0>',
OFF= 'OFF<13><0>',
C99366= '99366',
TRUE= -1,
FALSE= -2,
FFORM= 2,
UFORM= 0,
«ff»
! RC36-00813 PAGE 06 !
! EBCDIC TO ASCII CONVERSION TABLE : !
EATAB=! 0 1 2 3 4 5 6 7 !
#
! 0 ! 32 32 32 32 32 32 32 32
! 8 ! 32 32 32 32 32 32 32 32
! 16 ! 32 32 32 32 32 32 32 32
! 24 ! 32 32 32 32 32 32 32 32
! 32 ! 32 32 32 32 32 32 32 32
! 40 ! 32 32 32 32 32 32 32 32
! 48 ! 32 32 32 32 32 32 32 32
! 56 ! 32 32 32 32 32 32 32 32
! 64 ! 32 32 32 32 32 32 32 32
! 72 ! 32 32 32 46 60 40 43 94
! 80 ! 38 32 32 32 32 32 32 32
! 88 ! 32 32 33 36 42 41 59 94
! 96 ! 45 47 32 32 32 32 32 32
! 104 ! 32 32 124 44 37 95 62 63
! 112 ! 32 32 32 32 32 32 32 32
! 120 ! 32 32 58 35 64 39 61 34
! 128 ! 32 65 66 67 68 69 70 71
! 136 ! 72 73 32 32 32 32 32 32
! 144 ! 32 74 75 76 77 78 79 80
! 152 ! 81 82 32 32 32 32 32 32
! 160 ! 32 126 83 84 85 86 87 88
! 168 ! 89 90 32 32 32 91 32 32
! 176 ! 32 32 32 32 32 32 32 32
! 184 ! 32 32 32 32 32 93 32 32
! 192 ! 123 65 66 67 68 69 70 71
! 200 ! 72 73 32 32 32 32 32 32
! 208 ! 125 74 75 76 77 78 79 80
! 216 ! 81 82 32 32 32 32 32 32
! 224 ! 92 32 83 84 85 86 87 88
! 232 ! 89 90 32 32 32 32 32 32
! 240 ! 48 49 50 51 52 53 54 55
! 248 ! 56 57 94 32 32 32 32 32
#,
«ff»
! RC36-00813 PAGE 07 !
! ASCII TO EBCDIC CONVERSION TABLE : !
AETAB= ! 0 1 2 3 4 5 6 7!
#
! 0 ! 64 64 64 64 64 64 64 64
! 8 ! 64 64 64 64 64 64 64 64
! 16 ! 64 64 64 64 64 64 64 64
! 24 ! 64 64 64 64 64 64 64 64
! 32 ! 64 90 127 123 91 108 80 125
! 40 ! 77 93 92 78 107 96 75 97
! 48 ! 240 241 242 243 244 245 246 247
! 56 ! 248 249 122 94 76 126 110 111
! 64 ! 124 193 194 195 196 197 198 199
! 72 ! 200 201 209 210 211 212 213 214
! 80 ! 215 216 217 226 227 228 229 230
! 88 ! 231 232 233 173 224 189 250 109
! 96 ! 121 129 130 131 132 133 134 135
! 104 ! 136 137 145 146 147 148 149 150
! 112 ! 151 152 153 162 163 164 165 166
! 120 ! 167 168 169 192 106 208 161 7
#;
«ff»
! RC36-00813 PAGE 08 !
VAR
OPDUMMY: STRING(2); ! RUNTIME PARAMETERS !
PROGNO: INTEGER;
TPAR5: INTEGER;
TPAR4: INTEGER;
RECSIZE: INTEGER;
LABELCHECK: INTEGER;
TPAR3: INTEGER;
TPAR1: INTEGER;
TPAR2: INTEGER;
MTUNIT: INTEGER;
MTDENSITY: INTEGER;
LOGPRINT: INTEGER;
OPTEXT: STRING(80); ! COMMUNICATION AREA !
OPSTRING: STRING(80);
OPDEC: STRING(10);
OPCONT: STRING(2); ! INTERNAL VARIABLES !
NEXTCONT: STRING(1); ! USED BY STANDARD !
GLCONT: STRING(1); ! PROCEDURES. !
ERRORNO: INTEGER;
MASK: INTEGER;
TOM: INTEGER;
SIGN: INTEGER;
Q: INTEGER;
PAR: INTEGER;
LENGTH: INTEGER;
P1: INTEGER;
P2: INTEGER;
P3: INTEGER;
S1: STRING(2);
S2: STRING(2);
«ff»
! RC36-00813 PAGE 09 !
EOT: INTEGER; ! INTERNAL VARIABLES !
TAPESREAD: INTEGER;
INT1: INTEGER;
EXYYDDD: INTEGER;
FILENO: INTEGER;
BLOCKNO: INTEGER;
NEWMT: INTEGER;
MTREADMODE: INTEGER;
READGIVEUP: INTEGER;
IDENTLENGTH: INTEGER;
STOPPED: INTEGER;
RECLENGTH: INTEGER;
SEQCHECK: INTEGER;
CHAR: INTEGER;
INDEX: INTEGER;
OFFLINE: INTEGER;
SERIALTEXT: STRING(7);
TAPEVOLSER: STRING(6);
IDENTTEXT: STRING(20);
CREDATE: STRING(6);
EXPDATE: STRING(6);
H1LABEL: STRING(80);
H2LABEL: STRING(80);
DATE: STRING(5);
TAPEDATE: STRING(5);
BLKNO: STRING(6);
RECLGT: STRING(6);
STR3740: STRING(18);
VOLUMEID: STRING(7);
DATASETNAME: STRING(9);
«ff»
! RC36-00813 PAGE 10 !
IN: FILE ! INPUT FILE DESCRIPTION !
'3740', ! NAME OF INPUT DRIVER !
14, ! KIND= BLOCKED, !
! REPEATABLE, !
! POSITIONABLE, !
2, ! BUFFERS !
128, ! SHARESIZE !
U; ! UNDEFINED !
CONV STR3740;
GIVEUP
RDERROR, ! FD ERROR PROCEDURE !
2'1110001111111110 ! GIVE UP MASK !
OF STRING(1); ! RECORD STRUCTURE !
OUT: FILE ! OUTPUT FILE DESCRIPTION !
'MT0', ! NAME OF OUTPUT DRIVER !
14, ! KIND= REPEATABLE, !
! POSITIONABLE, !
! BLOCKED. !
4, ! BUFFERS !
256, ! SHARESIZE !
U; ! UNDEFINED !
GIVEUP
MTOUTERROR, ! MT ERROR PROCEDURE !
2'0110011111111110 ! GIVE UP MASK !
OF STRING(80); ! RECORD STRUCTURE !
«ff»
! RC36-00813 PAGE 11 !
PROCEDURE GETDATE(CONST DATE: STRING(5) );
CODEBODY P0005;
PROCEDURE CONTINUE;
BEGIN
GLCONT:=OPCONT;
OPCONT:=NEXTCONT;
NEXTCONT:=GLCONT;
IF OPCONT=FIFTEEN THEN OPMESS(OFF);
IF OPCONT=FIVE THEN OPMESS(ON);
END;
PROCEDURE OPSTOP;
BEGIN
OPWAIT(LENGTH);
OPTEXT:=OPSTRING;
OPIN(OPSTRING);
STOPPED:= 0;
IF OPTEXT=CONT THEN CONTINUE;
IF OPTEXT=STOP THEN STOPPED:= 1;
IF OPTEXT=START THEN STOPPED:= 2;
IF OPTEXT=SUSPEND THEN STOPPED:=3;
END;
PROCEDURE OPEN3740;
BEGIN
! TRANSFER VOL-ID + DATASETNAME + INFORMATION !
! ABOUT CHECK OF SEQUENCE-NUMBER ON !
! MULTI-VOLUME-DATASETS !
STR3740:=ASCIISPS;
INSERT(READ,STR3740,0);
INSERT(ZERO,STR3740,1);
MOVE(VOLUMEID,0,STR3740,3,6);
MOVE(DATASETNAME,0,STR3740,9,8);
CONVERT(STR3740,STR3740,AETAB,18);
CONVERT(STR3740,STR3740,EATAB,18);
0: SEQCHECK:=0;
OPEN(IN,1);
IF SEQCHECK <> 0 THEN
BEGIN
INSERT(READ,STR3740,2);
GOTO 0;
! SEQENCE ERROR ACCEPTED !
END;
END;
«ff»
! RC36-00813 PAGE 12 !
PROCEDURE INITPOSITION;
BEGIN
! PARAMETER CHECK !
2000: IF NEWMT=FALSE THEN GOTO 2009;
IF RECSIZE > 0 THEN
IF RECSIZE <= 256 THEN GOTO 2003;
OPMESS(RECERROR);
GOTO 2008;
2003: IF IDENTLENGTH=0 THEN
BEGIN OPMESS(IDENTEMPTY); GOTO 2008; END;
IF EXPDATE > C99366 THEN
BEGIN OPMESS(EXERROR); GOTO 2008; END;
INSERT(MTUNIT+48,OUT.ZNAME,2);
IF MTUNIT >= 0 THEN
IF MTUNIT <= 3 THEN GOTO 2006;
OPMESS(WRONGUNIT);
GOTO 2008;
2006: IF MTDENSITY = 800 THEN GOTO 2009;
IF MTDENSITY =1600 THEN GOTO 2009;
OPMESS(DENERROR);
2008: REPEAT OPSTOP UNTIL STOPPED <> 0;
IF STOPPED = 1 THEN GOTO 1;
IF STOPPED = 3 THEN GOTO 12;
GOTO 2000;
2009:«ff»
! RC36-00813 PAGE 13 !
IF NEWMT = TRUE THEN
BEGIN
! CREATION AND CHECK OF LABELS !
! LABELCHECK !
OUT.ZSHAREL:=80; OPEN(OUT,5);
SETPOSITION(OUT,1,1);
MTREADMODE:=TRUE; READGIVEUP:=FALSE;
GETDATE(DATE);
2010: GETREC(OUT,RECLENGTH);
! CHECK VOLUME LABEL !
IF READGIVEUP=TRUE THEN GOTO 2011;
IF RECLENGTH<>80 THEN GOTO 2011;
IF OUT^<>VOL1L THEN
BEGIN
! NO VOLUME LABEL !
2011: IF SERIALTEXT=INITINF THEN
BEGIN
OPMESS(VOLMIS);
CLOSE(OUT,1); BLOCKNO:=1; GOTO 2008;
END;
! CREATE VOLUME LABEL !
CLOSE(OUT,0); MTREADMODE:=FALSE;
OPEN(OUT,3); SETPOSITION(OUT,1,1);
PUTREC(OUT,80);
OUT^:=VOL1;
MOVE(SERIALTEXT,0,OUT^,4,6);
CONVERT(OUT^,OUT^,AETAB,80);
END ELSE
BEGIN
MOVE(OUT^,4,TAPEVOLSER,0,6);
CONVERT(TAPEVOLSER,TAPEVOLSER,EATAB,6);
IF SERIALTEXT=INITINF THEN
SERIALTEXT:=TAPEVOLSER
ELSE IF SERIALTEXT<>TAPEVOLSER THEN
BEGIN
OPMESS(WRONGVOL);
CLOSE(OUT,1); BLOCKNO:=1; GOTO 2008;
END;
IF LABELCHECK=TRUE THEN
BEGIN
GETREC(OUT,RECLENGTH);
IF READGIVEUP=TRUE THEN GOTO 2012;
IF RECLENGTH<>80 THEN GOTO 2012;
IF OUT^<>HDR1L THEN GOTO 2012;
! HDR1 LABEL PRESENT. CHECK EXPIRATION DATE !
MOVE(OUT^,48,TAPEDATE,0,5);
CONVERT(TAPEDATE,TAPEDATE,EATAB,5);
IF TAPEDATE>DATE THEN
BEGIN
OPMESS(PROTECTTXT);
CLOSE(OUT,1); GOTO 2008;
END;
END ! LABELCHECK=TRUE !;
END !OUT^=VOL1L!;
2012: CLOSE(OUT,0); MTREADMODE:=FALSE;
«ff»
! RC36-0813 PAGE 14 !
! WRITE NEW HDR LABELS !
OPEN(OUT,3); SETPOSITION(OUT,1,2);
H1LABEL:=HDR1;
MOVE(IDENTTEXT,0,H1LABEL,4,IDENTLENGTH);
MOVE(DATE,0,H1LABEL,42,5);
MOVE(EXPDATE,0,H1LABEL,48,5);
MOVE(SERIALTEXT,0,H1LABEL,21,6);
PUTREC(OUT,80);
CONVERT(H1LABEL,OUT^,AETAB,80);
H2LABEL:=HDR2;
BINDEC(RECSIZE,RECLGT);
MOVE(RECLGT,0,H2LABEL,5,5);
MOVE(RECLGT,0,H2LABEL,10,5);
IF MTDENSITY=800 THEN MOVE(DEN800,0,H2LABEL,15,1);
IF MTDENSITY=1600 THEN MOVE(DEN1600,0,H2LABEL,15,1);
PUTREC(OUT,80);
CONVERT(H2LABEL,OUT^,AETAB,80);
CLOSE(OUT,0); FILENO:=2;
OUT.ZFORM:=UFORM;
OUT.ZSHAREL:=RECSIZE; OPEN(OUT,3);
NEWMT := FALSE;
SETPOSITION(OUT,FILENO,BLOCKNO);
END ! NEWMT=TRUE !
ELSE IF BLOCKNO<>OUT.ZBLOCK THEN SETPOSITION(OUT,FILENO,BLOCKNO);
END ! INITPOSITION !;
«ff»
! RC 36-00813 PAGE 15 !
PROCEDURE DIRECTUPDATE;
BEGIN
P1:=0; ! INDEX IN INPUT STRING !
P2:=0; ! INDEX IN CONSTANT STRING !
P3:=1; ! PARAMETER NUMBER IN CONSTANT STRING !
REPEAT BEGIN
MOVE(OPTEXT,P1,S1,0,1);
MOVE(OPTXTS,P2,S2,0,1);
WHILE BYTE S1 <> BYTE S2 DO
BEGIN
IF BYTE S2 = 0 THEN P3:=P3+1;
P2:=P2+1;
MOVE(OPTXTS,P2,S2,0,1);
IF P3>NOQ THEN S2:=S1;
END;
IF P3<=NOQ THEN
BEGIN
WHILE BYTE S1 = BYTE S2 DO
BEGIN
P1:=P1+1;
P2:=P2+1;
MOVE(OPTEXT,P1,S1,0,1);
MOVE(OPTXTS,P2,S2,0,1);
IF BYTE S1 = 61 THEN
BEGIN
MOVE(OPTEXT,P1+1,OPTEXT,0,20);
LENGTH:=LENGTH-P1-1;
Q:=P3;
MOVE(OPDUMMY,Q*2,OPDUMMY,0,2);
PAR:= WORD OPDUMMY;
P3:=NOQ;
END;
END;
P2:=P2-P1+1;
P1:=0;
END;
END UNTIL P3>=NOQ;
END;
«ff»
! RC36-00813 PAGE 16 !
PROCEDURE OPCOM;
BEGIN
1000: Q:=0;
1010: REPEAT BEGIN
IF OPTEXT=STATE THEN
BEGIN Q:=1; OPMESS(CONTSTATE); IF OPCONT=FIVE THEN
OPMESS(PLUS); IF OPCONT=FIFTEEN THEN
OPMESS(MINUS); GOTO 1040;
END;
1015: Q:=Q+1;
1020: OPSTATUS(1 SHIFT(16-Q),OPTXTS); IF Q<>1 THEN BEGIN
MOVE(OPDUMMY,Q*2,OPDUMMY,0,2);
PAR:= WORD OPDUMMY;
IF PAR = -1 THEN OPMESS(PLUS);
IF PAR = -2 THEN OPMESS(MINUS);
IF PAR = -3 THEN OPMESS(IDENTTEXT);
IF PAR = -4 THEN OPMESS(EXPDATE);
IF PAR = -5 THEN OPMESS(SERIALTEXT);
IF PAR = -6 THEN OPMESS(DATASETNAME);
IF PAR = -7 THEN OPMESS(VOLUMEID);
IF PAR >= 0 THEN
BEGIN BINDEC(PAR,OPDEC); OPMESS(OPDEC); END; END;
IF OPTEXT=STATE THEN GOTO 1060;
1040: OPMESS(ENDLINE);
OPWAIT(LENGTH);
OPTEXT:=OPSTRING;
OPIN(OPSTRING);
IF OPTEXT=STATE THEN BEGIN Q:=0; GOTO 1015; END;
IF LENGTH > 6 THEN DIRECTUPDATE;
IF OPTEXT = START THEN GOTO 1070;
IF OPTEXT = STOP THEN GOTO 1000;
IF OPTEXT = SUSPEND THEN GOTO 12;
IF OPTEXT = CONT THEN
BEGIN CONTINUE; GOTO 1040; END;
IF OPTEXT = NEXTPARAM THEN GOTO 1060;
IF OPTEXT = NL THEN GOTO 1020;
IF OPTEXT = ENDLINE THEN GOTO 1020;
IF PAR = -7 THEN
BEGIN
IF LENGTH > 7 THEN LENGTH := 7;
VOLUMEID := INITINF;
MOVE(OPTEXT,0,VOLUMEID,0,LENGTH-1);
GOTO 1055;
END;
IF PAR = -6 THEN
BEGIN
IF LENGTH > 9 THEN LENGTH := 9;
DATASETNAME:= INITINF;
MOVE(OPTEXT,0,DATASETNAME,0,LENGTH-1);
GOTO 1055;
END;
«ff»
! RC36-00813 PAGE 17 !
IF PAR=-3 THEN
BEGIN
IF LENGTH>18 THEN LENGTH:=18;
IDENTLENGTH:=LENGTH-1;
IDENTTEXT:=INITINF;
MOVE(OPTEXT,0,IDENTTEXT,0,IDENTLENGTH);
GOTO 1055;
END;
IF PAR=-4 THEN
BEGIN
IF LENGTH>6 THEN LENGTH:=6;
EXPDATE:=INITEXP;
MOVE(OPTEXT,0,EXPDATE,0,LENGTH-1);
GOTO 1055;
END;
IF PAR = -5 THEN
BEGIN
IF LENGTH>7 THEN LENGTH:=7;
IF LENGTH=1 THEN SERIALTEXT:=INITINF
ELSE SERIALTEXT:=INITVOLSER;
MOVE(OPTEXT,0,SERIALTEXT,0,LENGTH-1);
END;
SIGN:=0;
IF OPTEXT = MINUS THEN SIGN:=-1;
IF OPTEXT = PLUS THEN SIGN:=+1;
IF SIGN <> 0 THEN INSERT(48,OPTEXT,0);
DECBIN(OPTEXT,TOM);
IF PAR < 0 THEN
BEGIN IF SIGN=0 THEN GOTO 1020; PAR:=-2;
IF SIGN=1 THEN PAR:=-1; GOTO 1050;
END;
IF SIGN=0 THEN
BEGIN SIGN:=1; PAR:=0; END;
PAR:=PAR+TOM*SIGN;
IF PAR<0 THEN GOTO 1020;
1050: INSERT(PAR SHIFT(-8),OPDUMMY,0);
INSERT(PAR, OPDUMMY,1);
MOVE(OPDUMMY,0,OPDUMMY,Q*2,2);
1055: IF OPTEST <> 0 THEN GOTO 1040;
GOTO 1020;
1060: IF OPTEXT=STATE THEN IF Q<NOQ THEN GOTO 1015;
END UNTIL Q>=NOQ; GOTO 1000;
1070: OPMESS(RUNTXT);
END;
PROCEDURE SHOWERROR;
BEGIN
ERRORNO:=20;
WHILE MASK>0 DO
BEGIN
MASK:=MASK SHIFT 1;
ERRORNO:=ERRORNO+1
END;
BINDEC(ERRORNO,OPTEXT);
OPMESS(OPTEXT); OPMESS(ENDLINE);
END;
«ff»
! RC36-00813 PAGE 18 !
PROCEDURE RDERROR;
BEGIN
IF IN.Z0 SHIFT 1 < 0 THEN
BEGIN
OFFLINE:=OFFLINE-1;
IF OFFLINE > 0 THEN REPEATSHARE(IN);
OPMESS(MOUNTDISK);
OFFLINE:=5;
END;
IF IN.Z0 AND 8'400 <> 0 THEN GOTO 9;
IF IN.Z0 AND 8'20 <> 0 THEN GOTO 10;
IF IN.Z0 SHIFT 1 > 0 THEN
BEGIN
OPMESS(FDTXT);
MASK:=IN.Z0;
SHOWERROR;
END;
REPEAT OPSTOP;
IF OPTEXT = ACCEPT THEN
BEGIN
IF IN.Z0 AND 8'2000 <> 0 THEN SEQCHECK:=1;
GOTO 100;
END;
IF OPTEXT = SUSPEND THEN GOTO 12;
IF OPTEXT = STOP THEN GOTO 1
UNTIL OPTEXT = START;
100: OPMESS(RUNTXT);
REPEATSHARE(IN);
END;
PROCEDURE MTOUTERROR;
BEGIN
IF OUT.Z0 AND 8'043000 = 0 THEN BLOCKNO:=OUT.ZBLOCK;
IF OUT.Z0 AND 8'000020 <> 0 THEN EOT:= TRUE;
OUT.Z0:=OUT.Z0 AND 8'177757;
IF MTREADMODE = TRUE THEN
IF OUT.Z0 AND 8'000602 <> 0 THEN
BEGIN
READGIVEUP:= TRUE; ! TIMER - EOF - BLOCKLENGTH ERROR !
OUT.ZREM:= OUT.ZSHAREL;
GOTO 3000;
END;
IF OUT.Z0 SHIFT 1 < 0 THEN OPMESS(MTMOUNTTAPE);
IF OUT.Z0 SHIFT 1 > 0 THEN
BEGIN
OPMESS(MTTXT);
MASK:=OUT.Z0;
SHOWERROR;
END;
IF OUT.Z0<>0 THEN
BEGIN
2999: REPEAT OPSTOP UNTIL STOPPED <> 0;
IF STOPPED = 1 THEN GOTO 2999;
IF STOPPED=3 THEN GOTO 12;
OPMESS(RUNTXT);
IF MTREADMODE = TRUE THEN GOTO 3000;
IF OUT.Z0 AND 8'063352 <> 0 THEN
REPEATSHARE(OUT);
END;
3000: END;
«ff»
! RC36-00813 PAGE 19 !
BEGIN
RECSIZE:=172;
LABELCHECK := TRUE;
TPAR1:=-3;
TPAR2:=-4;
TPAR3:=-5;
TPAR4:=-6;
TPAR5:=-7;
IDENTTEXT:= INITINF;
IDENTLENGTH:= 0;
SERIALTEXT:=INITINF;
VOLUMEID:=INITINF;
DATASETNAME:=INITINF;
EXYYDDD:= 0;
EXPDATE:= INITEXP;
LOGPRINT:=TRUE;
MTUNIT:=0;
MTDENSITY:= 1600;
FILENO:= 1;
BLOCKNO:=1;
NEWMT:= TRUE;
OPCONT:= FIFTEEN;
NEXTCONT:= FIVE;
EOT:= FALSE;
OUT.ZFILE:= 1;
OUT.ZBLOCK:= 1;
OFFLINE:=5;
OPIN(OPSTRING);
1: OPCOM;
2: INITPOSITION;
«ff»
! RC36-00813 PAGE 20 !
! MAIN LOOP !
CHAR:=33;
3: REPEAT
INDEX:=0;
PUTREC(OUT,RECSIZE);
WHILE INDEX < RECSIZE DO
BEGIN
INSERT(CHAR,OUT^,INDEX);
INDEX:=INDEX+1;
END;
CONVERT(OUT^,OUT^,AETAB,RECSIZE);
CHAR:=CHAR+1;
IF CHAR > 126 THEN CHAR:=33;
IF EOT = TRUE THEN
BEGIN
OPMESS(ENDTAPE);
REPEAT OPSTOP UNTIL STOPPED <> 0;
IF STOPPED = 3 THEN GOTO 12;
IF STOPPED = 1 THEN GOTO 11;
END
UNTIL OPTEST <> 0;
OPSTOP;
IF STOPPED = 1 THEN GOTO 9;
IF STOPPED = 2 THEN GOTO 3;
IF STOPPED = 3 THEN GOTO 12;
IF STOPPED = 0 THEN GOTO 3;
BLOCKNO:= OUT.ZBLOCK;
FILENO:= OUT.ZFILE;
GOTO 1;
«ff»
! RC36-00813 PAGE 21 !
10:
WAITZONE(OUT);
OPMESS(FDEOF);
REPEAT
BEGIN
OPSTOP;
IF OPCONT=FIFTEEN THEN GOTO 11;
END UNTIL STOPPED<>0;
IF STOPPED = 1 THEN GOTO 1;
IF STOPPED = 3 THEN GOTO 12;
OPEN3740;
OPMESS(RUNTXT);
GOTO 3;
! END OF FILE FROM FD !
9: WAITZONE(OUT);
IF OPCONT = FIVE THEN
BEGIN
BLOCKNO:= OUT.ZBLOCK;
FILENO:= OUT.ZFILE;
GOTO 10;
END;
! END OF JOB !
11: BLOCKNO:= OUT.ZBLOCK;
CLOSE(OUT,0);
OUT.ZFORM:=UFORM;
OUT.ZSHAREL:=80; OPEN(OUT,3);
SETPOSITION(OUT,3,1);
PUTREC(OUT,80);
H1LABEL:=EOF1;
BINDEC(BLOCKNO-1,BLKNO);
MOVE(BLKNO,0,H1LABEL,55,5);
CONVERT(H1LABEL,OUT^,AETAB,80);
PUTREC(OUT,80);
H2LABEL:=EOF2;
CONVERT(H2LABEL,OUT^,AETAB,80);
OPMESS(EOJTXT); GOTO 13;
! SUSPEND !
12: OPMESS(SUSTXT); OUT.ZMODE:=0;
13: CLOSE(OUT,1); OUT.ZFORM:=UFORM;
BLOCKNO:= 1;
FILENO:= 1;
EOT:= FALSE;
NEWMT:= TRUE;
REPEAT OPSTOP UNTIL STOPPED <> 0;
IF STOPPED = 1 THEN GOTO 1;
IF STOPPED=3 THEN GOTO 12;
OPMESS(RUNTXT);
GOTO 2;
END;
«ff»
«nul»