BEGIN
EXTERNALROUTINESPEC OPENSQ(INTEGER I)
EXTERNALROUTINESPEC WRITESQ(INTEGER CH,NAME A,B)
EXTERNALROUTINESPEC CLOSESQ(INTEGER CH)
EXTERNALROUTINESPEC READSQ(INTEGER I,NAME S,F)
!TEST* ; %EXTERNALROUTINESPEC REWINDMT
!TEST* ; %EXTERNALROUTINESPEC OPENMT(%STRING (7) S)
SYSTEMROUTINESPEC ITOE(INTEGER START, FINISH)
!TEST* ; %EXTERNALROUTINESPEC UNLOADMT
!TEST* ; %EXTERNALROUTINESPEC WRITEMT(%INTEGER START, LEN, %C
INTEGERNAME FLAG)
!TEST* ; %EXTERNALROUTINESPEC WREOFMT(%INTEGERNAME FLAG)
EXTERNALROUTINESPEC DEFINE(STRING (63) S)
SYSTEMROUTINESPEC OUTFILE(STRING (15) S, C
INTEGER LENGTH, MAXBYTES, PROTECTION, C
INTEGERNAME CONAD, FLAG)
ROUTINESPEC READIN(INTEGER SIZE)
ROUTINESPEC OUT6K
SYSTEMROUTINESPEC MOVE(INTEGER L,F,T)
EXTERNALROUTINESPEC PROMPT(STRING (15) S)
ROUTINE READLINE(STRING (255) NAME LINE)
WHILE NEXTSYMBOL = NL THEN SKIPSYMBOL; ! SKIP BLANK LINES
LINE = ''
WHILE NEXTSYMBOL # NL C
THEN LINE = LINE.NEXTITEM AND SKIPSYMBOL
SKIPSYMBOL
END
!EXTRA* %ROUTINE OPENMT(%STRING(7) S)
!EXTRA* DEFINE('SQ2,T,,F2048')
!EXTRA* OPENSQ(2)
!EXTRA*
!EXTRA* %END
!EXTRA* %ROUTINE UNLOADMT
!EXTRA* %END
!EXTRA* %ROUTINE WRITEMT(%INTEGER START,LEN,%INTEGERNAME FLAG)
!EXTRA* WRITESQ(2,INTEGER(START),INTEGER(START+LEN))
!EXTRA* FLAG=0
!EXTRA* %END
!EXTRA* %ROUTINE REWINDMT
!EXTRA* %END
!EXTRA* %ROUTINE WREOFMT(%INTEGERNAME FLAG)
!EXTRA* FLAG=0
!EXTRA* %END
STRING (7) TAPE, ANS
STRING (15) OFILE, INFILE, USER
OWNBYTEINTEGERARRAY VOL1(1 : 80) = C
X'E5',X'D6',X'D3',X'F1',X'40'(75),2
OWNBYTEINTEGERARRAY HDR1(1 : 80) = C
X'C8',X'C4',X'D9',X'F1',X'F0'(3),
X'F1',X'40'(19),X'F0'(7),X'F1',
X'F0'(6),X'40',X'F0'(5),X'40',
X'F0'(5),X'40',1,
X'F0'(3),X'40'(22)
OWNBYTEINTEGERARRAY HDR2(1 : 80) = C
X'C8',X'C4',X'D9',X'F2',X'C6',
X'F0',X'F6',X'F2',X'F4',X'F0',X'F0',
X'F2',X'F0',X'F4',X'F8',X'40'(35),
X'F0'(2),X'40'(28)
OWNBYTEINTEGERARRAY HDR3(1 : 80) = C
X'C8',X'C4',X'D9',X'F3',0(3),X'48',
X'80'(4),0(3),1,X'80'(16),0(3),2,
X'40'(24),0(3),1,0(3),1,X'40'(12)
OWNBYTEINTEGERARRAY HDR4(1 : 80) = C
X'C8',X'C4',X'D9',X'F4',0(3),X'48',
X'40'(4),X'80'(32),X'E8',X'40'(3),X'E8',
X'40'(3),X'E8',X'40'(3),X'E8',X'40'(3),
X'E8',X'40'(3),X'E8',X'40'(3),0,3,0,
X'00',0(3),2,X'80'(4)
OWNBYTEINTEGERARRAY HDR5(1 : 80) = C
X'C8',X'C4',X'D9',X'F5',0(3),X'34',
X'80'(44),1(2),0(2),X'80'(4),X'E8',
X'40'(3),X'E8',X'40'(3),0,3,0,0,
0(3),2,X'80'(4)
OWNBYTEINTEGERARRAY EOF1(1 : 80) = C
X'C8',X'C4',X'D9',X'F1',X'F0'(3),
X'F1',X'40'(19),X'F0'(7),X'F1',
X'F0'(12),X'40',X'F0'(5),X'40',X'20',
X'F0'(3),X'40'(22)
OWNBYTEINTEGERARRAY EOF2(1 : 80) = C
X'C8',X'C4',X'D9',X'F2',X'C6',
X'F0',X'F6',X'F2',X'F4',X'F0',X'F0',
X'F2',X'F0',X'F4',X'F8',X'40'(35),
X'F0'(2),X'40'(28)
INTEGERARRAY BLOCK(0 : 1600)
INTEGER BLOCKADDR, BLOCK COUNT, CONTENT, I
BLOCKADDR = ADDR(BLOCK(1))
INTEGER FLAG, DIGIT1, DIGIT2, DIGIT3
INTEGERARRAY BK(1 : 256); ! BODY KEYS RECORD - UP TO 60 INITIALISED CMNS
BYTEINTEGERARRAYNAME W
BYTEINTEGERARRAYFORMAT WFM(1 : X'40000')
INTEGER BKL, PRL
INTEGER OUTP; ! POINTER INTO 6K BLOCK OUTPUT BUFFER(WORDS)
INTEGER BKP; ! POINTER INTO BODY KEYS( WORDS)
INTEGER WP; ! WORK FILE POINTER ( BYTE )
INTEGER BLOCKDATA; ! BLOCKING INFO
INTEGER LEFT; ! BYTES LEFT IN AREA
INTEGER SLB; ! SPACE LEFT IN 2K BLOCK
INTEGER WORKCONAD
!!
!!
OUTFILE('SS#KT',X'40000',0,0,WORKCONAD,FLAG)
IF FLAG # 0 START
PRINTSTRING('
CREATE WORKFILE FAILS
')
WRITE(FLAG,1)
STOP
FINISH
W == ARRAY(WORKCONAD,WFM)
!!
PROMPT('TAPE LABEL:')
READ LINE(TAPE)
OPENMT(TAPE)
PROMPT('RELABEL:')
READ LINE(ANS)
IF ANS = 'Y' OR ANS = 'YES' START
PROMPT('NEW LABEL:')
READ LINE(TAPE)
REWINDMT
STRING(ADDR(VOL1(4))) = TAPE
VOL1(4) = X'F1'
ITOE(ADDR(VOL1(5)),6)
WRITEMT(ADDR(VOL1(1)),80,FLAG)
-> ERRORV UNLESS FLAG = 0
FINISH
PROMPT('INPUT FILE:')
READ LINE(INFILE)
DEFINE('SQ1,'.INFILE)
OPENSQ(1)
PROMPT('K USER:')
READ LINE(USER)
PROMPT('OUTPUT FILE:')
READ LINE(OFILE)
STRING(ADDR(HDR3(44))) = OFILE
HDR3(44) = X'40'
STRING(ADDR(HDR3(36))) = USER
HDR3(36) = 2
ITOE(ADDR(HDR3(37)),LENGTH(USER))
ITOE(ADDR(HDR3(45)),LENGTH(OFILE))
! MAY REQUIRE AN INDEX FILENAME AT HDR3(69).
WRITEMT(ADDR(HDR1(1)),80,FLAG)
-> ERRORH UNLESS FLAG = 0
WRITEMT(ADDR(HDR2(1)),80,FLAG)
-> ERRORH UNLESS FLAG = 0
WRITEMT(ADDR(HDR3(1)),80,FLAG)
-> ERRORH UNLESS FLAG = 0
WRITEMT(ADDR(HDR4(1)),80,FLAG)
-> ERRORH UNLESS FLAG = 0
WRITEMT(ADDR(HDR5(1)),80,FLAG)
-> ERRORH UNLESS FLAG = 0
WREOFMT(FLAG) ;! TM
->ERRORTM UNLESS FLAG=0
!!
!! READ IN BODY KEYS RECORD
!!
READSQ(1,BK(1),BK(256))
BKL = BK(1)//4
PRL = BK(2)
!!
BLOCK COUNT=0
CYCLE I=0,1,1600
BLOCK(I)=0
REPEAT
OUTP=1
CYCLE BKP = 1,3,BKL-2; ! AREAS
UNLESS BKP=1 THEN LEFT=BK(BKP+2) AND SLB=X'7F0' C
ELSE LEFT=PRL AND SLB=X'7FC'
READIN(LEFT); ! COPY NEXT AREA INTO WORK FILE
WP = 1
BLOCKDATA = X'80'
CYCLE ; ! BLOCK OUT AREA IN 2K CHUNKS
UNLESS BKP=1 START ;! NOT PROPERTIES RECORD
BLOCK(OUTP)=(4<<24)!12
BLOCK(OUTP+1)=BK(BKP) ;! IIN
BLOCK(OUTP+2)=0 ;! DISPLACEMENT
OUTP=OUTP+3
FINISH
IF LEFT<=SLB START ;! LAST OR ONLY
IF BLOCKDATA # X'80' THEN BLOCKDATA = X'82' C
ELSE BLOCKDATA = X'80'
BLOCK(OUTP) = (BLOCKDATA<<24)!(LEFT+4)
MOVE(LEFT,ADDR(W(WP)),ADDR(BLOCK(OUTP+1)))
IF OUTP<512 THEN OUTP=513 ELSE START
IF OUTP <1024 THEN OUTP=1025 ELSE OUTP=1536
FINISH
IF OUTP=1536 THEN OUT6K
EXIT
FINISH
IF BLOCKDATA = X'81' THEN BLOCKDATA = X'83'; ! START -> CONTINUE
IF BLOCKDATA = X'80' THEN BLOCKDATA = X'81'; ! START
BLOCK(OUTP) = (BLOCKDATA<<24)!(SLB+4)
MOVE(SLB,ADDR(W(WP)),ADDR(BLOCK(OUTP+1)))
IF OUTP<512 THEN OUTP=513 ELSE START
IF OUTP<1024 THEN OUTP=1025 ELSE OUTP=1536
FINISH
LEFT = LEFT-SLB
WP = WP+SLB
IF BKP=1 THEN SLB=X'7FC' ELSE SLB=X'7F0'
IF OUTP = 1536 THEN OUT6K
REPEAT
REPEAT
BLOCK(OUTP)=X'88000004' ;! MODULE TERMINATION RECORD
IF OUTP<1024 THEN BLOCK(1025)=X'88000004'
IF OUTP<512 THEN BLOCK(513)=X'88000004'
OUT6K
WREOFMT(FLAG); ! TM
-> ERRORTM UNLESS FLAG = 0
DIGIT1 = BLOCK COUNT//100
DIGIT2 = (BLOCK COUNT-DIGIT1*100)//10
DIGIT3 = BLOCK COUNT-(DIGIT1*100+DIGIT2*10)
EOF1(56) = DIGIT1+X'F0'
EOF1(57) = DIGIT2+X'F0'
EOF1(58) = DIGIT3+X'F0'
WRITEMT(ADDR(EOF1(1)),80,FLAG)
-> ERRORH UNLESS FLAG = 0
WRITEMT(ADDR(EOF2(1)),80,FLAG)
-> ERRORH UNLESS FLAG = 0
WREOFMT(FLAG); ! TM
-> ERRORTM UNLESS FLAG = 0
! A TEST FOR MORE THAN ONE FILE MAY BE INSERTED HERE AND
! IF +VE THEN RETURN TO 'PROMPT('INPUTFILE:')'.
WREOFMT(FLAG); ! TM
-> ERRORTM UNLESS FLAG = 0
UNLOADMT
NEWLINE
WRITE(BLOCK COUNT,1)
PRINTSTRING(' BLOCKS WRITTEN TO TAPE
')
STOP
ERRORV:
PRINTSTRING('
ERROR WHILE WRITING VOL LABEL
')
UNLOADMT
STOP
ERRORH:
PRINTSTRING('
ERROR WHILE WRITING HEADER LABEL
')
UNLOADMT
STOP
ERRORB:
PRINTSTRING('
ERROR WHILE WRITING BLOCK')
WRITE(BLOCK COUNT+1,1)
NEWLINE
UNLOADMT
STOP
ERRORTM:
PRINTSTRING('
ERROR WHILE WRITING TM
')
UNLOADMT
STOP
!!
!!!
ROUTINE READIN(INTEGER SIZE)
INTEGER A
A=1
PRINTSTRING('
READING IN ')
WRITE(SIZE,4)
NEWLINE
WHILE A <= SIZE THEN CYCLE
READSQ(1,W(A),W(A+1023))
A = A+1024
REPEAT
END
ROUTINE OUT6K
INTEGER I
BLOCK(0)=X'2A0C1004'
WRITEMT(ADDR(BLOCK(0)),6240,FLAG)
IF FLAG # 0 START
PRINTSTRING('
WRITEMT FAILS ')
WRITE(FLAG,1)
STOP
FINISH
CYCLE I=0,1,1600
BLOCK(I)=0
REPEAT
BLOCKCOUNT = BLOCKCOUNT+1
OUTP=1
END
ENDOFPROGRAM