!* THIS PROGRAM TAKEN FROM 4-75 TO 2970 ON 2/5/78 AND MODIFIED
!* TO USE NEW STANDARD DATA FILES THROUGH TEMOPORARY OMF SQ INTERFACE.
!!
!!
!!*******************************************************
!!* *
!!* THIS PROGRAM PACKAGES OMF OBJECTS PRODUCED ON EMAS *
!!* ONTO A TAPE IN MAGNETIC MEDIA ENGINEERING FORMAT. *
!!* *
!!*************************************************
!!
!! TAPE FORMAT IS:
!! <--------------FILE 1------------------->
!! *V* *H* *H* *U* *D* *D* *E* *E* *U*
!! *O* *D* *D* *H* TM *A*->*A* TM *O* *O* *T* TM < FILE2 >< FILEN > TM
!! *L* *R* *R* *L* *T* *T* *F* *F* *L*
!! *1* *1* *2* *1* *A* *A* *1* *2* *1*
!!
!!
ROUTINESPEC WRITEBTAPE(STRING (63) S)
EXTERNALROUTINE WRITEKTAPE(STRING (63) S)
WRITEBTAPE(S)
END
EXTERNALROUTINE WRITEBTAPE(STRING (63) DUMMY)
EXTERNALROUTINESPEC OPENOMF(STRING (32) S, INTEGER CH, MODE)
EXTERNALROUTINESPEC READOMF(INTEGER CH, A, INTEGERNAME L)
EXTERNALROUTINESPEC CSOMF(STRING (63) S)
EXTERNALROUTINESPEC COPY(STRING (63) S)
SYSTEMROUTINESPEC ITOE(INTEGER A, L)
EXTERNALROUTINESPEC REWINDMT
EXTERNALROUTINESPEC OPENMT(STRING (7) S)
EXTERNALROUTINESPEC UNLOADMT
EXTERNALROUTINESPEC WRITEMT(INTEGER START, LEN, C
INTEGERNAME FLAG)
EXTERNALROUTINESPEC WRITETMMT(INTEGERNAME FLAG)
RECORDFORMAT INRFM(INTEGER CONAD, FILESIZE, A, C
STRING (6) B, INTEGER C, D, E, F)
SYSTEMROUTINESPEC CONNECT(STRING (32) S, C
INTEGER ACCESS, MAXBYTES, PROTECTION, C
RECORDNAME R, INTEGERNAME J)
RECORD IN(INRFM)
SYSTEMROUTINESPEC MOVE(INTEGER L, F, T)
EXTERNALSTRINGFNSPEC TIME
EXTERNALSTRINGFNSPEC DATE
EXTERNALROUTINESPEC PROMPT(STRING (15) S)
ROUTINE READLINE(STRING (255) NAME LINE)
WHILE NEXTSYMBOL = NL THEN SKIPSYMBOL; ! SKIP BLANK LINES
LINE = ''
WHILE NEXTSYMBOL # NL THEN LENGTH(LINE) = LENGTH(LINE)+ C
1 AND BYTEINTEGER(ADDR(LINE)+LENGTH(LINE)) = C
NEXTSYMBOL AND SKIPSYMBOL
SKIPSYMBOL
END
STRING (7) TAPE
STRING (32) OFILE, INFILE, USER, BEFORE, AFTER, PDFILE
RECORDFORMAT FHEADFMT(INTEGER FILESIZE, LENGTH OF HEADER, C
PHYSICALSIZE, FILETYPE, SUM CHECK, DATE AND TIME, OFFSET, C
NUMPDMEMBERS)
RECORDNAME FHEAD(FHEADFMT)
RECORDFORMAT PDF(INTEGER START, STRING (11) NAME, C
INTEGER HOLE, S1, S2, S3)
RECORDARRAYFORMAT APDF(1 : 10000)(PDF)
RECORDARRAYNAME PD(PDF)
OWNBYTEINTEGERARRAY VOL1(1 : 96) = C
0(3),0,0,96, C
X'E5',X'D6',X'D3',X'F1',X'40'(75),X'F2',0(10)
OWNBYTEINTEGERARRAY HDR1(1 : 96) = C
0(3),1,0,96,X'C8',X'C4',X'D9',X'F1', C
X'40'(17),X'40'(6),X'F0'(3),X'F1',X'F0'(3),X'F1',X'F0'(3),X'F1', C
X'F0'(2),X'40',X'F9',X'F8',X'F3',X'F5',X'F9', C
X'40',X'F9',X'F9',X'F3',X'F5',X'F9',X'40',X'F0'(6), C
X'40'(13),X'40'(7),0(10)
OWNBYTEINTEGERARRAY HDR2(1 : 96) = C
0(3),2,0,96,X'C8',X'C4',X'D9',X'F2', C
X'E5',X'F0',X'F4',X'F1'(2),X'F6',X'F0',X'F4',X'F1',X'F0'(2), C
X'40'(35),X'F0',X'F8',X'40'(28),0(10)
OWNBYTEINTEGERARRAY UHL1(1 : 96) = C
0(3),3,0,96,X'E4',X'C8',X'D3',X'F1',X'40'(4), C
X'F7',X'F8',X'61',X'F1',X'F1',X'61',X'F2',X'F6', C
X'40'(58),X'D6',X'D4',X'40'(4),0(10)
OWNBYTEINTEGERARRAY EOF1(1 : 96) = C
0(4),0,96,X'C5',X'D6',X'C6',X'F1',X'40'(17), C
X'40'(6),X'F0'(3),X'F1', C
X'F0'(3),X'F1',X'F0'(3),X'F1',X'F0'(2), C
X'40',X'F9',X'F8',X'F3',X'F5',X'F9',X'40', C
X'F9',X'F9',X'F3',X'F5',X'F9', C
X'40',X'F0'(6),X'40'(13),X'40'(7),0(10)
OWNBYTEINTEGERARRAY EOF2(1 : 96) = C
0(4),0,96,X'C5',X'D6',X'C6',X'F2', C
X'E5',X'F0',X'F4',X'F1',X'F1',X'F6',X'F0',X'F4',X'F1', C
X'F0',X'F0',X'40'(35),X'F0',X'F8',X'40'(28), C
0(10)
OWNBYTEINTEGERARRAY UTL1(1 : 96) = C
0(4),0,96,X'E4',X'E3',X'D3',X'F1',X'40'(4), C
X'F7',X'F6',X'61',X'F1',X'F1',X'61',X'F2',X'F6', C
3,X'40'(40),X'40'(17),X'D6',X'D4',X'40'(4),0(10)
CONSTINTEGER CHARACTER = 3
INTEGERFNSPEC FILETYPE
BYTEINTEGERARRAY BLOCK(0 : 4115)
INTEGER BLOCKADDR, BLOCK COUNT, I, DATA BLOCKS
INTEGER L
INTEGER FLAG, DIGIT1, DIGIT2, DIGIT3
INTEGER PDINDEX, LASTREC, J
!!
!!
PRINTSTRING("
".DATE." ".TIME." VSN 2.2
")
BLOCKADDR = ADDR(BLOCK(0))
PROMPT('TAPE NAME:')
READ LINE(TAPE)
OPENMT(TAPE."*")
PDINDEX = 0
! REWINDMT
BLOCK COUNT = 0
STRING(ADDR(VOL1(10))) = TAPE
VOL1(10) = X'F1'
ITOE(ADDR(VOL1(11)),6)
WRITEMT(ADDR(VOL1(1)),96,FLAG)
-> ERRORV UNLESS FLAG = 0
LOOP:
IF PDINDEX = 0 START
PROMPT('INPUT FILE:')
READ LINE(INFILE)
IF INFILE = ".END" OR INFILE = "STOP" THEN -> LAST
CONNECT(INFILE,0,0,0,IN,FLAG)
IF FLAG # 0 THEN -> ERRORC
FHEAD == RECORD(IN_CONAD)
IF FHEAD_FILETYPE = 6 START ; ! PDFILE
PDFILE = INFILE
PD == ARRAY(FHEAD_OFFSET+IN_CONAD,APDF)
PDINDEX = 1
FINISH
FINISH
IF PDINDEX # 0 START
INFILE = PDFILE."_".PD(PDINDEX)_NAME
IF PDINDEX = FHEAD_NUMPDMEMBERS THEN PDINDEX = 0 C
ELSE PDINDEX = PDINDEX+1
FINISH
UNLESS INFILE -> USER.(".").OFILE THEN OFILE = INFILE
IF FILETYPE = CHARACTER START
COPY(INFILE.",T#SRCE")
CSOMF("T#SRCE,T#SQSRCE")
INFILE = "T#SQSRCE"
UHL1(81) = X'40'
UHL1(82) = X'40'
FINISH ELSE START
UHL1(81) = X'D6'; ! O
UHL1(82) = X'D4'; ! M
FINISH
OPENOMF(INFILE,1,0)
IF OFILE -> BEFORE.("_").AFTER THEN OFILE = AFTER
! FILL IN FILE NAME - USER IDENTIFIER
CYCLE I = 11,1,28
HDR1(I) = X'40'
EOF1(I) = X'40'
REPEAT
STRING(ADDR(HDR1(10))) = OFILE
HDR1(10) = X'F1'
STRING(ADDR(EOF1(10))) = OFILE
EOF1(10) = X'F1'
ITOE(ADDR(HDR1(11)),LENGTH(OFILE))
ITOE(ADDR(EOF1(11)),LENGTH(OFILE))
!!
INTEGER(ADDR(HDR1(1))) = BLOCK COUNT+1
WRITEMT(ADDR(HDR1(1)),96,FLAG)
-> ERRORH UNLESS FLAG = 0
INTEGER(ADDR(HDR2(1))) = BLOCK COUNT+2
WRITEMT(ADDR(HDR2(1)),96,FLAG)
-> ERRORH UNLESS FLAG = 0
INTEGER(ADDR(UHL1(1))) = BLOCK COUNT+3
WRITEMT(ADDR(UHL1(1)),96,FLAG)
-> ERRORH UNLESS FLAG = 0
WRITETMMT(FLAG); ! TM
-> ERRORTM UNLESS FLAG = 0
BLOCK COUNT = BLOCK COUNT+4
DATA BLOCKS = 0
!!
!!
!!
CYCLE
BLOCK COUNT = BLOCK COUNT+1
CYCLE I = 0,1,4115
BLOCK(I) = 0
REPEAT
INTEGER(BLOCKADDR) = BLOCK COUNT
IF INFILE = "T#SQSRCE" START
I = 12
CYCLE
READOMF(1,ADDR(BLOCK(I)),L)
ITOE(ADDR(BLOCK(I)),L)
IF L = 0 THEN -> EOB
LASTREC = I-10
J = L+4
MOVE(2,ADDR(J)+2,ADDR(BLOCK(I-4)))
BLOCK(I-2) = 0
BLOCK(I-1) = 0
I = I+L+4
IF I+200 > 4115 THEN -> EOB
REPEAT
FINISH ELSE START
READOMF(1,ADDR(BLOCK(12)),L)
-> EOF IF L = 0
LASTREC = 2
INTEGER(BLOCKADDR+8) = (L+4)<<16
! + 1 WORD FOR RCW -BLOCK(3) ITSELF
FINISH
EOB: INTEGER(BLOCKADDR+4) = X'10140000'!LASTREC
WRITEMT(BLOCKADDR,4116,FLAG)
-> ERRORB UNLESS FLAG = 0
DATA BLOCKS = DATA BLOCKS+1
-> EOF IF L = 0
REPEAT
EOF:
WRITETMMT(FLAG); ! TM
-> ERRORTM UNLESS FLAG = 0
DIGIT1 = DATA BLOCKS//100
DIGIT2 = (DATA BLOCKS-DIGIT1*100)//10
DIGIT3 = DATA BLOCKS-(DIGIT1*100+DIGIT2*10)
EOF1(64) = DIGIT1+X'F0'
EOF1(65) = DIGIT2+X'F0'
EOF1(66) = DIGIT3+X'F0'
INTEGER(ADDR(EOF1(1))) = BLOCK COUNT+1
WRITEMT(ADDR(EOF1(1)),96,FLAG)
-> ERRORH UNLESS FLAG = 0
INTEGER(ADDR(EOF2(1))) = BLOCK COUNT+2
WRITEMT(ADDR(EOF2(1)),96,FLAG)
-> ERRORH UNLESS FLAG = 0
INTEGER(ADDR(UTL1(1))) = BLOCK COUNT+3
WRITEMT(ADDR(UTL1(1)),96,FLAG)
-> ERRORH UNLESS FLAG = 0
WRITETMMT(FLAG); ! TM
-> ERRORTM UNLESS FLAG = 0
BLOCK COUNT = BLOCK COUNT+4
NEWLINE
WRITE(DATA BLOCKS,1)
PRINTSTRING(" BLOCKS WRITTEN TO TAPE
AS ".OFILE." ")
IF INFILE = "T#SQSRCE" THEN PRINTSTRING(" (SOURCE)
") C
ELSE NEWLINE
-> LOOP
LAST:
WRITETMMT(FLAG); ! TM
-> ERRORTM UNLESS FLAG = 0
UNLOADMT
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
ERRORC:
PRINTSTRING("
CANNOT CONNECT ".INFILE." FLAG= ")
WRITE(FLAG,1)
UNLOADMT
NEWLINES(2)
STOP
!!
!!!
INTEGERFN FILETYPE
INTEGER FLAG
RECORD IN(INRFM)
CONNECT(INFILE,0,0,0,IN,FLAG)
IF FLAG # 0 START
PRINTSTRING("
CANNOT CONNECT ".INFILE." FLAG =")
WRITE(FLAG,1)
UNLOADMT
STOP
FINISH
RESULT = INTEGER(IN_CONAD+12)
END
END
ENDOFFILE