|
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 - download
Length: 27648 (0x6c00)
Types: TextFile
Notes: RCSL-43-GL-8480, RCSL-43-GL-8481, RCSL-43-GL-8482
Names: »S1048«
└─⟦a59f0a452⟧ Bits:30000472 DOMUS disk image
└─ ⟦this⟧ »/S1048«
S1048! RCSL: 43-GL8481
AUTHOR: PBP
EDITED: 79.02.05
PROGRAM RC36-1048.01
IBM LABEL PRINT IMAGE
KEYWORDS: MUSIL,CONVERSION,MTA,SP,LISTING
ABSTRACT: THIS PROGRAM HANDLES IBM LABELLED TAPES WITH A
MAXIMUM BLOCK SIZE OF 4000 BYTES, EACH BLOCK
CONSISTING OF FIXED OR VARIABLE OR UNDEFINED LENGTH
RECORDS WITH CCCW OR ANSI CONTROL CHARACTERS AND EBCDIC
CODE DATA.
OUTPUT ON SERIAL PRINTER.
IF ONE RECORD IS GREATER THAN ONE PRINTLINE
THE REST OF THE RECORD IS PRINTED ON SUBSEQUENT LINES.
TAPES WITH UNDEFINED FORMAT IS PRINTED WITH ONE
RECORD = ONE BLOCK.
THE PROGRAM MAY BE OPERATED FROM EITHER OCP OR TTY.
RCSL 43-GL8480: ASCII SOURCE TAPE
RCSL 43-GL8482: REL/BIN !
«ff»
! RC36-01048 PAGE 1
TITLE: IBM LABEL PRINT IMAGE
ABSTRACT: THIS PROGRAM HANDLES IBM LABELLED TAPES WITH A
MAXIMUM BLOCK SIZE OF 4000 BYTES, EACH BLOCK CONSISTING
OF FIXED OR VARIABLE OR UNDEFINED LENGTH RECORDS
WITH CCW OR ANSI CONTROL CHARACTERS AND EBCDIC CODE
DATA. OUTPUT ON SERIAL PRINTER.
IF ONE RECORD IS GREATER THAN ONE PRINTLINE
THE REST OF THE RECORD IS PRINTED ON SUBSEQUENT LINES.
TAPES WITH UNDEFINED FORMAT IS PRINTED WITH ONE
RECORD = ONE BLOCK.
THE PROGRAM MAY BE OPERATED FROM EITHER OCP OR TTY.
SIZE: 10376 BYTES. INCLUDING ONE 4000 BYTES INPUT BUFFER AND
THREE 133 BYTES OUTPUT BUFFERS.
DATE: 79.02.05
RUNTIME PARAMETERS:
MT UNIT : 00000 SELECT MT UNIT
BLOCK NO : 00001 NEXT BLOCK TO BE READ FROM CURRENT DATASET.
DATASET : 00001 THE DATASET FROM WHICH THE BLOCK IS READ.
REWIND : + INDICATES IF REWIND AT END OF DATASET.
MARGIN : 00000 SPACES TO THE LEFT OF THE PRINT LINE.
SELECT : 00999 DEFAULT CCW, SELECT MODE AND VALUE.
10999 OPERATOR SPECIFIED DEFAULT SP1A CONTROL.
20999 OPERATOR SPECIFIED CCW CONTROL.
30999 OPERATOR SPECIFIED ANSI CONTROL.
PAGLENGTH: 00000 IF THIS PARAMETER IS DIFFERENT FROM ZERO,
A PAGESHIFT IS PERFORMED AFTER PAGLENGTH
PRINTED LINES WHEN ONE OF THE FOLLOWING
CONDITIONS HOLDS:
(1) SELECT=00999 AND CCW IN LABEL=SPACE.
(2) SELECT=10999
L-PRINT : - INDICATES IF HEADER LABEL SHOULD BE PRINTED.
«ff»
RC36-01048 PAGE 2
OTHER OUTPUT MESSAGES:
MOUNT VSN AAAAAA WRONG DATASET REEL MOUNTED.
MOUNT REEL NNNNN MULTI VOLUME DATASET OR WRONG REEL MOUNTED.
DATASET ACCEPTED LABEL CONTENT PROCESSED AND ACCEPTED.
RECORDTYPE ERROR RECORD FORMAT NEITHER F NOR V.
BLOCKSIZE ERROR BLOCK GREATER THAN 512 BYTES.
CCW TYPE ERROR CCW NEITHER A NOR M NOR SPACE.
ATTRIBUTE ERROR NEITHER BLOCKED NOR UNDEFINED RECORDS.
SELECT ERROR ILLEGAL VALUE FOR SELECT.
CONTSTATE: +/- STATE OF CONTINUE SWITCH (TTY ONLY).
PROG NO : 1048 PROGRAM EXECUTION IS STOPPED.
RUNNING PROGRAM EXECUTION IS STARTED.
SUSPENDED DRIVERS RELEASED, PROGRAM EXECUTION IS STOPPED.
MOUNT DATA TAPE MT-UNIT IS NOT ON-LINE.
LP ERROR NNNNN CONSULT THE RC3600 OPERATOR MANUAL.
MT ERROR NNNNN CONSULT THE RC3600 OPERATOR MANUAL.
END JOB PROGRAM EXECUTION IS TERMINATED.
INPUT MESSAGES:
STOP STOPS EXECUTION WRITING PROG NO : 1048.
SUSPEND STOPS EXECUTION RELEASING DRIVERS (TTY ONLY).
INT NEXT PARAMETER IS DISPLAYED
(ESCAPE BUTTON ON TTY HAS SAME EFFECT).
STATE ALL PARAMETERS ARE DISPLAYED (TTY ONLY).
"VALUE" CURRENTLY DISPLAYED PAPAMETER IS CHANGED
TO "VALUE".
"TEXT"="VALUE" THE PARAMETER IDENTIFIED BY "TEXT" IS
CHANGED TO "VALUE".
CONT STATE OF CONTINUE SWITCH IS INVERTED.
START PROGRAM EXECUTION IS STARTED.
NOTE: AFTER MT ERROR START MEANS ACCEPTING
THE ERRONEOUS INPUT, AFTER LP ERROR START
MEANS REPEATING THE PRINT OPERATION.
SPECIAL REQUIREMENTS: NONE. !
«ff»
! RC36-01048 PAGE 03 !
CONST
NOQ= 9,
OPTXTS=
'<14><6>
<10>PROG NO : 1048<0>
<10>MT UNIT : <0>
<10>BLOCK NO : <0>
<10>DATASET : <0>
<10>REWIND : <0>
<10>SELECT : <0>
<10>MARGIN : <0>
<10>PAGLENGTH: <0>
<10>L-PRINT : <0>',
LABTXTS='
<14><7><10>DATASET ACCEPTED<13><0>
<14><7><10>RECORDTYPE ERROR<13><0>
<14><7><10>BLOCKSIZE ERROR <13><0>
<14><7><10>CCW TYPE ERROR <13><0>
<14><7><10>ATTRIBUTE ERROR <13><0>',
START= 'START',
STOP= 'STOP',
SUSPEND= 'SUSPEND',
CONT= 'CONT',
INT= 'INT',
STATE= 'STATE',
MINUS= '-',
PLUS= '+',
FIVE= '<5><0>',
FIFTEEN= '<15><0>',
NL= '<10>',
NEXTPARAM= '<27>',
SP1A= '<9>',
SP2A= '<17>',
SK1A= '<137>',
ENDLINE= '<13><0>',
RETURN= '<13>',
«ff»
! RC36-01048 PAGE 04 !
RUNTXT= '<8><4><10>RUNNING<13><0>',
MTTXT= '<7><10>MT ERROR ',
LPTXT= '<7><10>LP ERROR ',
SELECTER= '<14><7><10>SELECT ERROR<13><0>',
EOJTXT= '<14><7><10>END JOB<13><0>',
SUSTXT= '<7><10>SUSPENDED<13><0>',
MTMOUNTTAPE= '<14><7><10>MOUNT DATA TAPE<13><0>',
MOUNTVSN= '<14><7><10>MOUNT VSN ',
MOUNTREEL= '<14><7><10>MOUNT REEL ',
A= '<193>',
B= '<194>',
F= '<198>',
M= '<212>',
U= '<228>',
V= '<229>',
SPACE= '<64>',
REEL1= '<240><240><240><241>',
R133= '<240><240><241><243><243>',
VOL1= '<229><214><211><241>',
HDR1= '<200><196><217><241>',
HDR2= '<200><196><217><242>',
EOF1= '<197><214><198><241>',
EOF2= '<197><214><198><242>',
EOV1= '<197><214><229><241>',
EOV2= '<197><214><229><242>',
CONTSTATE= '<10>CONTSTATE: <0>',
«ff»
!RC36-01048 PAGE 05 !
LPTABLE= ! SPECIAL TABLE POST & TELEGRAFVAESNET
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 85
! 80 ! 38 32 32 32 32 32 32 32
! 88 ! 32 32 33 93 42 41 59 32
! 96 ! 45 47 32 32 32 32 32 32
! 104 ! 32 32 32 44 37 95 62 63
! 112 ! 32 32 32 32 32 32 32 32
! 120 ! 32 32 58 91 92 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 32 83 84 85 86 87 88
! 168 ! 89 90 32 32 32 32 32 32
! 176 ! 32 32 32 32 32 32 32 32
! 184 ! 32 32 32 32 32 32 32 32
! 192 ! 32 65 66 67 68 69 70 71
! 200 ! 72 73 32 32 32 32 32 32
! 208 ! 32 74 75 76 77 78 79 80
! 216 ! 81 82 32 32 32 32 32 32
! 224 ! 32 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
#,
ANSITABLE= ! ANSI TO CCW !
#
78 7 ! SPACE 0 LINES BEFORE PRINT !
64 15 ! 1 !
240 23 ! 2 !
96 31 ! 3 !
241 143 ! SKIP TO CHANNEL 1 BEFORE PRINT !
242 151 ! 2 !
243 159 ! 3 !
244 167 ! 4 !
245 175 ! 5 !
246 183 ! 6 !
239 191 ! 7 !
248 199 ! 8 !
249 207 ! 9 !
193 215 ! 10 !
194 223 ! 11 !
195 231 ! 12 !
0 0 ! !
0 15 ! SPACE 1 LINE BEFORE PRINT !
#,
«ff»
! RC36-01048 PAGE 06 !
EBCASC= ! NUMERIC EBCDIC TO NUMERIC ASCII !
#
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 48 48 48 48 48 48 48 48 48 48 48 48 48 48 48
48 49 50 51 52 53 54 55 56 57 48 48 48 48 48 48
#,
ASCEBC= ! NUMERIC ASCII TO NUMERIC EBCDIC !
#
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 241 242 243 244 245 246 247 248 249 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
240 240 240 240 240 240 240 240 240 240 240 240 240 240 240 240
#;
«ff»
! RC36-01048 PAGE 07 !
VAR
OPDUMMY: STRING(2); ! RUNTIME PARAMETERS !
PROGNO: INTEGER;
MTUNIT: INTEGER;
BLOCKNO: INTEGER;
DATASET: INTEGER;
REWIND: INTEGER;
SELECT: INTEGER;
MARGIN: INTEGER;
PAGELENGTH: INTEGER;
LPRINT: INTEGER;
OPTEXT: STRING(20); ! COMMUNICATION AREA !
OPSTRING: STRING(20);
OPDEC: STRING(10);
OPCONT: STRING(2); ! INTERNAL VARIABLES !
NEXTCONT: STRING(1);
GLCONT: STRING(1);
CURZZZ: STRING(1);
RECSIZE: INTEGER;
FILENO: INTEGER;
SELX: INTEGER;
SELY: INTEGER;
SELZZZ: INTEGER;
DATAINDEX: INTEGER;
DATALENGTH: INTEGER;
SELECTINDEX: INTEGER;
ERRORNO: INTEGER;
MASK: INTEGER;
TOM: INTEGER;
SIGN: INTEGER;
Q: INTEGER;
PAR: INTEGER;
LENGTH: INTEGER;
RECLENGTH: INTEGER;
LPLENGTH: INTEGER;
LPDATALENGTH: INTEGER;
SDATASET: INTEGER;
DFILE: INTEGER;
SFILENO: INTEGER;
SBLOCKNO: INTEGER;
REJECT: INTEGER;
WORKINT: INTEGER;
WORKSTR: STRING(8);
NEWVSN: STRING(6);
NEWDSSN: STRING(6);
NEWVSEQN: STRING(4);
NEWRF: STRING(1);
NEWBL: STRING(5);
NEWRL: STRING(5);
NEWCC: STRING(1);
NEWBA: STRING(1);
OLDVSEQN: STRING(4);
OLDVSN: STRING(6);
P1: INTEGER;
P2: INTEGER;
P3: INTEGER;
S1: STRING(2);
S2: STRING(2);
NEXTLP: INTEGER;
BSIZE: STRING(6);
LINES: INTEGER;
«ff»
! RC36-01048 PAGE 08 !
IN: FILE ! INPUT FILE DESCRIPTION !
'MT0', ! NAME OF INPUT DRIVER !
14, ! KIND= REPEATABLE, !
! POSITIONABLE, !
! BLOCKED. !
1, ! BUFFERS !
4000, ! SHARESIZE !
FB; ! FIXED BLOCKED !
GIVEUP
MTINERROR, ! MT ERROR PROCEDURE !
2'0110001111011111 ! GIVE UP MASK !
OF RECORD ! RECORD STRUCTURE !
LBLOCK: STRING(80);
CCW: STRING(1) FROM 1;
SELECT1: STRING(1) FROM 1;
DATA: STRING(1) FROM 1;
SELECT2: STRING(1) FROM 2;
LABEL: STRING(4) FROM 1;
F5L6: STRING(6) FROM 5;
F22L6: STRING(6) FROM 22;
F28L4: STRING(4) FROM 28;
F5L1: STRING(1) FROM 5;
F6L5: STRING(5) FROM 6;
F11L5: STRING(5) FROM 11;
F37L1: STRING(1) FROM 37;
F39L1: STRING(1) FROM 39
END;
OUT: FILE ! OUTPUT FILE DESCRIPTION !
'SP', ! NAME OF OUTPUT DRIVER !
2, ! KIND= BLOCKED !
3, ! BUFFERS !
133, ! SHARESIZE !
U; ! UNDEFINED !
GIVEUP
LPERROR, ! LP ERROR PROCEDURE !
2'1100001011110110; ! GIVE UP MASK !
CONV
LPTABLE ! CONVERSION TABLE !
OF RECORD ! RECORD STRUCTURE !
CCW: STRING(1);
DATA: STRING(1)
END;
«ff»
! RC36-01048 PAGE 09 !
PROCEDURE INITPOSITION;
BEGIN
100: IF IN.ZMODE=0 THEN
BEGIN
INSERT(48+MTUNIT,IN.ZNAME,2);
OPEN(IN,1);
END;
IF OUT.ZMODE=0 THEN OPEN(OUT,7);
IF DATASET=0 THEN BEGIN DATASET:=1; SDATASET:=0; END;
IF DATASET<>SDATASET THEN
BEGIN
SDATASET:=DATASET;
FILENO:=DATASET*3-2;
BLOCKNO:=1;
END;
DFILE:=DATASET*3-1;
IF DFILE<>FILENO THEN
BEGIN
BLOCKNO:=1;
IN.ZFORM:=2 !FIXED UNBLOCKED FORMAT!;
IN.ZLENGTH:=80 !80 BYTE LABEL BLOCKS!;
IF LPRINT=-1 THEN
IF FILENO<DFILE THEN
IF OLDVSEQN=REEL1 THEN
BEGIN
OUTCHAR(OUT,BYTE SK1A);
WAITZONE(OUT);
LINES:=0;
END;
END;
«ff»
! RC36-01048 PAGE 10 !
IF DFILE=FILENO THEN
BEGIN
CONVERT(NEWRL,WORKSTR,EBCASC,5);
INSERT(0,WORKSTR,5);
DECBIN(WORKSTR,RECSIZE);
IN.ZLENGTH:=RECSIZE;
IN.ZFORM:=3;
IF NEWRF=V THEN IN.ZFORM:=5;
IF NEWRF=U THEN IN.ZFORM:=0;
END;
101: SELX:=SELECT/10000;
SELY:=(SELECT-SELX*10000)/1000;
SELZZZ:=(SELECT-SELX*10000)-SELY*1000;
IF SELX<=3 THEN IF SELX>=0 THEN GOTO 102;
OPMESS(SELECTER); GOTO 1;
102: IF SELX=2 THEN NEWCC:=M;
IF SELX=3 THEN NEWCC:=A;
IF NEWCC=SPACE THEN SELX:=1;
DATAINDEX:=0;
IF SELX<>1 THEN DATAINDEX:=1;
IF SELZZZ<256 THEN DATAINDEX:=DATAINDEX+1;
SELECTINDEX:=DATAINDEX-1;
LPLENGTH:=RECSIZE-DATAINDEX+1;
IF LPLENGTH+MARGIN>133 THEN LPLENGTH:=133-MARGIN;
LPDATALENGTH:=LPLENGTH-1;
SETPOSITION(IN,FILENO,BLOCKNO);
SETPOSITION(OUT,MARGIN,0);
END;
PROCEDURE CONTINUE;
BEGIN
GLCONT:=OPCONT;
OPCONT:=NEXTCONT;
NEXTCONT:=GLCONT;
OPMESS(OPCONT);
END;
«ff»
! RC36-01048 PAGE 11 !
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,10);
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-01048 PAGE 12 !
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 >= 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 OPTEXT=SUSPEND THEN GOTO 10;
IF LENGTH > 6 THEN DIRECTUPDATE;
IF LENGTH > 6 THEN GOTO 1020;
IF OPTEXT = START THEN GOTO 1070;
IF OPTEXT = STOP THEN GOTO 1000;
IF OPTEXT = CONT THEN
BEGIN CONTINUE; GOTO 1040; END;
IF OPTEXT = INT THEN GOTO 1060;
IF OPTEXT = NEXTPARAM THEN GOTO 1060;
IF OPTEXT = NL THEN GOTO 1020;
IF OPTEXT = ENDLINE THEN GOTO 1020;
IF OPTEXT = RETURN THEN GOTO 1020;
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);
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;
«ff»
! RC36-01048 PAGE 13 !
PROCEDURE OPSTOP;
BEGIN
OPWAIT(LENGTH);
OPTEXT:=OPSTRING;
OPIN(OPSTRING);
IF OPTEXT=CONT THEN CONTINUE;
IF OPTEXT=STOP THEN GOTO 1;
IF OPTEXT=SUSPEND THEN GOTO 10;
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;
PROCEDURE MTINERROR;
BEGIN
IF IN.Z0 AND 256 <> 0 THEN !EOF! GOTO 9;
IF IN.Z0 AND 8'041000 = 0 THEN BLOCKNO:=IN.ZBLOCK;
IF IN.Z0 SHIFT 1 < 0 THEN OPMESS(MTMOUNTTAPE);
IF IN.Z0 SHIFT 1 >= 0 THEN
BEGIN
OPMESS(MTTXT);
MASK:=IN.Z0;
SHOWERROR;
END;
REPEAT OPSTOP UNTIL OPTEXT=START;
OPMESS(RUNTXT);
END;
PROCEDURE LPERROR;
BEGIN
NEXTLP:= OUT.Z0 AND 8'000020;
OUT.Z0:= OUT.Z0 - NEXTLP;
IF OUT.Z0 SHIFT 1 < 0 THEN OUT.Z0:= OUT.Z0 AND 8'041342;
IF OUT.Z0 = 8'040000 THEN IF NEXTLP <> 0 THEN
OUT.Z0:= NEXTLP;
IF OUT.Z0 AND 8'001342 <> 0 THEN
OUT.Z0:= OUT.Z0 AND 8'001342;
IF OUT.Z0 <> 0 THEN
BEGIN
OPMESS(LPTXT);
BLOCKNO:=IN.ZBLOCK;
MASK:=OUT.Z0;
SHOWERROR;
NEXTLP:=0;
REPEAT OPSTOP UNTIL OPTEXT=START;
OPMESS(RUNTXT);
IF OUT.Z0 AND 8'141362 <> 0 THEN
REPEATSHARE(OUT);
END;
END;
«ff»
! RC36-01048 PAGE 14 !
PROCEDURE NEXTREEL;
BEGIN ! INCREASE OLDVSEQN BY 1 !
CONVERT(NEWVSEQN,WORKSTR,EBCASC,4);
INSERT(0,WORKSTR,4);
DECBIN(WORKSTR,WORKINT);
WORKINT:=WORKINT+1;
BINDEC(WORKINT,WORKSTR);
CONVERT(WORKSTR,OLDVSEQN,ASCEBC,4);
END;
PROCEDURE DISPVSEQN;
BEGIN ! DISPLAY VOLUME SEQUENCE NUMBER !
CONVERT(OLDVSEQN,WORKSTR,EBCASC,4);
INSERT(0,WORKSTR,4);
OPMESS(WORKSTR); OPMESS(ENDLINE);
END;
PROCEDURE DISPVSN;
BEGIN ! DISPLAY VOLUME SERIAL NUMBER !
CONVERT(OLDVSN,WORKSTR,EBCASC,6);
INSERT(0,WORKSTR,6);
OPMESS(WORKSTR); OPMESS(ENDLINE);
END;
PROCEDURE PRINTREST;
BEGIN
DATALENGTH := LPDATALENGTH + DATAINDEX;
RECLENGTH := RECLENGTH - DATALENGTH;
WHILE RECLENGTH > 0 DO
BEGIN
IN.ZFIRST := IN.ZFIRST + DATALENGTH;
DATALENGTH := 132 - MARGIN;
IF RECLENGTH < DATALENGTH THEN DATALENGTH := RECLENGTH;
PUTREC(OUT,DATALENGTH + 1);
OUT^.CCW := SP1A;
MOVE(IN^.DATA,0,OUT^.DATA,0,DATALENGTH);
RECLENGTH := RECLENGTH - DATALENGTH;
END;
END;
«ff»
! RC36-01048 PAGE 15 !
BEGIN
PROGNO:=1; IN.ZBLOCK:=1; BLOCKNO:=1; FILENO:=1; REWIND:=-1;
MTUNIT:=0; PAGELENGTH:=0;
SELECT:=10999; MARGIN:=0; RECSIZE:=133; LPRINT:=-2;
DATASET:=1; SDATASET:=1; DFILE:=2; OLDVSEQN:=REEL1; NEXTLP:=0;
BINDEC(IN.ZSHAREL,OPDEC); CONVERT(OPDEC,BSIZE,ASCEBC,5);
INSERT(0,BSIZE,5);
LINES:=0;
OPCONT:=FIFTEEN; NEXTCONT:=FIVE; OPIN(OPSTRING);
1: OPCOM;
INITPOSITION; IF OPTEST<>0 THEN OPSTOP;
2: IF DFILE<>FILENO THEN
BEGIN ! READ LABEL GROUP !
GETREC(IN,RECLENGTH);
IF DFILE>FILENO THEN
BEGIN ! READ HEADER LABEL GROUP !
IF IN^.LABEL=VOL1 THEN NEWVSN:=IN^.F5L6;
IF IN^.LABEL=HDR1 THEN
BEGIN
NEWDSSN:=IN^.F22L6; !DATASET SERIAL NUMBER !
NEWVSEQN:=IN^.F28L4; !REEL NUMBER !
NEWRF:=F;
NEWBL:=BSIZE;
NEWRL:=R133;
NEWCC:=A;
NEWBA:=B;
END;
IF IN^.LABEL=HDR2 THEN
BEGIN
NEWRF:=IN^.F5L1; !RECORD FORMAT F V U !
NEWBL:=IN^.F6L5; !BLOCK LENGTH !
NEWRL:=IN^.F11L5; !RECORD LENGTH !
NEWCC:=IN^.F37L1; !PRINT CONTROL A M SPACE !
NEWBA:=IN^.F39L1; !BLOCK ATTRIBUTE B S R SPACE !
END;
IF LPRINT=-1 THEN
IF OLDVSEQN=REEL1 THEN
BEGIN ! PRINT HEADER LABEL !
PUTREC(OUT,81);
OUT^.CCW:=SP2A;
MOVE(IN^,0,OUT^,1,80);
WAITZONE(OUT);
END;
GOTO 2;
END;
BEGIN ! READ TRAILER LABEL GROUP !
IF IN^.LABEL=EOF1 THEN OLDVSEQN:=REEL1;
IF IN^.LABEL=EOF2 THEN OLDVSEQN:=REEL1;
IF IN^.LABEL=EOV1 THEN NEXTREEL;
IF IN^.LABEL=EOV2 THEN NEXTREEL;
GOTO 2;
END;
END;
«ff»
! RC36-01048 PAGE 16 !
200: IF NEWRF=F THEN
BEGIN ! PROCESS FIXED LENGTH RECORDS !
3: REPEAT BEGIN
GETREC(IN,RECLENGTH);
IF SELZZZ<256 THEN
BEGIN
MOVE(IN^.DATA,SELECTINDEX,CURZZZ,0,1);
IF SELY=0 THEN
BEGIN
IF BYTE CURZZZ<>SELZZZ THEN GOTO 6;
GOTO 4;
END;
IF BYTE CURZZZ AND SELZZZ=0 THEN GOTO 6;
END;
4: PUTREC(OUT,LPLENGTH);
IF SELX<>1 THEN
BEGIN
OUT^.CCW:=IN^.CCW;
IF NEWCC=A THEN TRANSLATE(IN^.CCW,OUT^.CCW,ANSITABLE);
GOTO 5;
END;
LINES:=LINES+1;
IF PAGELENGTH<>0 THEN
IF LINES>=PAGELENGTH THEN
BEGIN
OUT^.CCW:=SK1A;
LINES:=0; GOTO 5;
END;
OUT^.CCW:=SP1A;
5: MOVE(IN^.DATA,DATAINDEX,OUT^.DATA,0,LPDATALENGTH);
PRINTREST;
6: END UNTIL IN.ZREM<RECSIZE;
BLOCKNO:=IN.ZBLOCK;
IF OPTEST=0 THEN GOTO 3;
WAITZONE(OUT);
OPSTOP; GOTO 2;
END;
BEGIN ! PROCESS VARIABLE LENGTH OR UNDEFINED RECORDS !
13: REPEAT BEGIN
GETREC(IN,RECLENGTH);
LPLENGTH := RECLENGTH;
IF LPLENGTH-DATAINDEX+1+MARGIN>133 THEN
LPLENGTH:=133-MARGIN+DATAINDEX-1;
IF SELZZZ<256 THEN
BEGIN
MOVE(IN^.DATA,SELECTINDEX,CURZZZ,0,1);
IF SELY=0 THEN
BEGIN
IF BYTE CURZZZ<>SELZZZ THEN GOTO 16;
GOTO 14;
END;
IF BYTE CURZZZ AND SELZZZ=0 THEN GOTO 16;
END;
14: PUTREC(OUT,LPLENGTH-DATAINDEX+1);
IF SELX<>1 THEN
BEGIN
OUT^.CCW:=IN^.CCW;
IF NEWCC=A THEN TRANSLATE(IN^.CCW,OUT^.CCW,ANSITABLE);
GOTO 15;
END;
LINES:=LINES+1;
IF PAGELENGTH<>0 THEN
IF LINES>=PAGELENGTH THEN
BEGIN
OUT^.CCW:=SK1A;
LINES:=0; GOTO 15;
END;
OUT^.CCW:=SP1A;
15: MOVE(IN^.DATA,DATAINDEX,OUT^.DATA,0,LPLENGTH-DATAINDEX);
LPDATALENGTH := LPLENGTH - DATAINDEX;
PRINTREST;
16: END UNTIL IN.ZREM<4;
BLOCKNO:=IN.ZBLOCK;
IF OPTEST=0 THEN GOTO 13;
WAITZONE(OUT);
OPSTOP; GOTO 2;
END;
«ff»
! RC36-01048 PAGE 17 !
! HANDLING OF TAPE MARKS !
9: FILENO:=FILENO+1;
BLOCKNO:=1;
IF FILENO=DFILE THEN
BEGIN ! HEADER LABEL GROUP NOW PROCESSED !
IF OLDVSEQN=REEL1 THEN OLDVSN:=NEWDSSN;
IF OLDVSEQN=REEL1 THEN
IF LPRINT=-1 THEN
BEGIN
OUTCHAR(OUT,BYTE SK1A);
WAITZONE(OUT);
LINES:=0;
END;
REJECT:=0;
IF NEWDSSN<>OLDVSN THEN REJECT:=1;
IF NEWVSEQN<>OLDVSEQN THEN REJECT:=REJECT+2;
IF REJECT<>0 THEN
BEGIN ! WRONG DATASET OR REEL MOUNTED !
SFILENO:=FILENO;
SBLOCKNO:=BLOCKNO;
FILENO:=FILENO-1; ! POSITION AT HEADER GROUP !
BLOCKNO:=1;
IF REJECT<>2 THEN
BEGIN
OPMESS(MOUNTVSN); DISPVSN;
END;
IF REJECT=2 THEN
BEGIN
OPMESS(MOUNTREEL); DISPVSEQN;
END;
REPEAT OPSTOP UNTIL OPTEXT=START;
OPMESS(RUNTXT);
FILENO:=SFILENO;
BLOCKNO:=SBLOCKNO;
OLDVSN:=NEWDSSN;
OLDVSEQN:=NEWVSEQN;
END;
REJECT:=0;
IF NEWRF<>F THEN IF NEWRF<>V THEN
IF NEWRF<>U THEN REJECT:=1;
IF NEWBL>BSIZE THEN REJECT:=2;
IF NEWCC<>A THEN IF NEWCC<>M THEN IF NEWCC<>SPACE THEN
REJECT:=3;
IF NEWBA<>SPACE THEN
IF NEWBA<>B THEN REJECT:=4;
OPSTATUS(1 SHIFT (15-REJECT),LABTXTS);
IF REJECT<>0 THEN
BEGIN ! REJECT THE TAPE !
CLOSE(IN,1 ! REWIND AND SET THE TAPE OFFLINE !);
CLOSE(OUT,1);
BLOCKNO:=1;
FILENO:=1;
DATASET:=1;
REPEAT OPSTOP UNTIL OPTEXT=START;
OPMESS(RUNTXT);
END;
INITPOSITION;
GOTO 2 ! MAIN LOOP !;
END;
«ff»
! RC36-01048 PAGE 18 !
! HANDLING OF TAPE MARKS (CONTINUED) !
IF FILENO=DFILE+1 THEN
BEGIN ! DATA BLOCK GROUP NOW PROCESSED !
INITPOSITION;
GOTO 2 ! MAIN LOOP !;
END;
IF FILENO=DFILE+2 THEN
BEGIN ! TRAILER LABEL GROUP NOW PROCESSED !
IF OLDVSEQN<>NEWVSEQN THEN
IF OLDVSEQN<>REEL1 THEN
BEGIN ! CONTINUATION ON NEW REEL !
CLOSE(IN,1 ! REWIND OLD REEL !);
CLOSE(OUT,1);
FILENO:=1;
DATASET:=1;
BLOCKNO:=1;
OPMESS(MOUNTREEL); DISPVSEQN;
REPEAT OPSTOP UNTIL OPTEXT=START;
OPMESS(RUNTXT);
INITPOSITION;
GOTO 2 ! MAIN LOOP !;
END;
BEGIN ! END OF DATASET !
10: CLOSE(OUT,1);
IF OPTEXT=SUSPEND THEN
BEGIN
CLOSE(IN,1);
OPMESS(SUSTXT);
GOTO 11;
END;
BLOCKNO:=1;
DATASET:=DATASET+1;
IF OPCONT = FIVE THEN
BEGIN
CLOSE(IN,1);
FILENO:=1;
DATASET:=1;
OPMESS(MTMOUNTTAPE);
END;
IF OPCONT = FIFTEEN THEN
BEGIN
CLOSE(IN,REWIND+2);
IF REWIND=-1 THEN
BEGIN
FILENO:=1;
DATASET:=1;
END;
OPMESS(EOJTXT);
END;
11: REPEAT OPSTOP UNTIL OPTEXT=START;
OPMESS(RUNTXT);
INITPOSITION;
GOTO 2 ! MAIN LOOP !;
END;
END;
END;
«ff»
«nul»