!*********************************************************************** !* !* Program to write a VOLUMS-format tape !* !* Adapted from ERCC program !* R.D. Eager University of Kent MCMLXXX !* !*********************************************************************** ! CONSTINTEGER VERSION = 2; ! Major version number CONSTINTEGER EDIT = 0; ! Edit number within major version ! !*********************************************************************** !* !* Constants !* !*********************************************************************** ! CONSTINTEGER NO = 0, YES = 1 CONSTINTEGER LISTCHAN = 80; ! Channel for listing of files written CONSTINTEGER MAXCHAP = 5000; ! Max number of chapters on a tape CONSTSTRING (1) SNL = " " CONSTINTEGER KEYMAX = 5; ! Number of parameter keywords CONSTSTRING (9)ARRAY KEYS(1:KEYMAX) = C "TAPE", "STARTCHAP", "LISTING", "TYPE", "VERSION" ! !*********************************************************************** !* !* Record formats !* !*********************************************************************** ! RECORDFORMAT FRF(INTEGER CONAD,FILETYPE,DATASTART,DATAEND,C SIZE,RUP,EEP,MODE,USERS,ARCH,STRING (6) TRAN,C STRING (8) DATE,TIME,INTEGER COUNT,SPARE1,SPARE2) RECORDFORMAT HF(INTEGER DATAEND,DATASTART,FILESIZE,FILETYPE,C SUM,DATETIME,FORMAT,RECORDS) RECORDFORMAT HPF(STRING (6) TAPENAME,USERNAME,STRING (15) FILENAME,C STRING (8) DATE,TIME,TYPE,BYTEINTEGER SPARE0,C SPARE1,SPARE2,INTEGER CHAPTER,EPAGES,FSYS,PERMS,C OWN,EEP,ARCH,CODES,SSBYTE,CCT,SPARE3,SPARE4,SPARE5,C RECORDS,STRING (6) OFFERED TO) RECORDFORMAT RF(INTEGER CONAD,FILETYPE,DATASTART,DATAEND) ! ! !*********************************************************************** !* !* Subsystem references !* !*********************************************************************** ! SYSTEMROUTINESPEC CONNECT(STRING (31) FILE,INTEGER MODE,HOLE,C PROT,RECORDNAME R,INTEGERNAME FLAG) EXTERNALSTRINGFNSPEC DATE SYSTEMROUTINESPEC DISCONNECT(STRING (31) FILE,INTEGERNAME FLAG) SYSTEMSTRINGFNSPEC FAILUREMESSAGE(INTEGER MESS) SYSTEMROUTINESPEC FILL(INTEGER LENGTH,FROM,FILLER) SYSTEMROUTINESPEC FINFO(STRING (31) FILE,INTEGER MODE,C RECORDNAME FR,INTEGERNAME FLAG) SYSTEMSTRINGFNSPEC ITOS(INTEGER N) SYSTEMROUTINESPEC MOVE(INTEGER LENGTH,FROM,TO) EXTERNALINTEGERFNSPEC OUTPOS EXTERNALROUTINESPEC PROMPT(STRING (255) S) SYSTEMINTEGERFNSPEC PSTOI(STRING (63) S) SYSTEMROUTINESPEC SETFNAME(STRING (63) S) EXTERNALROUTINESPEC SET RETURN CODE(INTEGER I) EXTERNALSTRINGFNSPEC TIME EXTERNALSTRINGFNSPEC UINFS(INTEGER ENTRY) ! EXTERNALROUTINESPEC DEFINE(STRING (255) S) ! ! !*********************************************************************** !* !* Magnetic tape interface routines !* !*********************************************************************** ! EXTERNALROUTINESPEC ASKMT(STRING (7) VOL,INTEGERNAME FLAG) EXTERNALROUTINESPEC REWINDMT EXTERNALROUTINESPEC SKIPTMMT(INTEGER N) EXTERNALROUTINESPEC SKIPMT(INTEGER N) EXTERNALROUTINESPEC WRITEMT(INTEGER AD,LEN,INTEGERNAME FLAG) EXTERNALROUTINESPEC WRITETMMT(INTEGERNAME FLAG) EXTERNALROUTINESPEC UNLOADMT ! ! !*********************************************************************** !* !* Service routines !* !*********************************************************************** ! INTEGERFN MATCHSTRINGS(STRINGNAME A,STRING (255) B) INTEGER L ! L = LENGTH(A) IF LENGTH(B) < L THEN RESULT = 0 LENGTH(B) = L IF A = B THEN RESULT = YES ELSE RESULT = NO END ; ! of MATCHSTRINGS ! ! INTEGERFN PARAMDECODE(STRING (255) PARAM,INTEGER PMAX,C STRINGARRAYNAME KEYS,PARS) INTEGER I,PNUM,PN,RES,C,PARPTR,PARLENG STRING (255) WKSP ! INTEGERFN FINDKEY INTEGER F,I ! IF LENGTH(WKSP) = 0 THEN RESULT = -2; ! Missing keyword F = 0 CYCLE I = 1,1,PMAX IF MATCHSTRINGS(WKSP,KEYS(I)) = YES THEN START UNLESS F = 0 THEN RESULT = -1 F = I FINISH REPEAT RESULT = F END ; ! of FINDKEY ! INTEGERFN GETPAR INTEGER C,INPR ! INPR = 0 WKSP = "" ! CYCLE PARPTR = PARPTR + 1 IF PARPTR > PARLENG THEN RESULT = -1 C = CHARNO(PARAM,PARPTR) IF C = ',' OR C = '=' THEN RESULT = C WKSP = WKSP.TOSTRING(C) REPEAT END ; ! of GETPAR ! CYCLE I = 1,1,PMAX PARS(I) = ""; ! Initialise REPEAT PARPTR = 0 PNUM = 1 PARLENG = LENGTH(PARAM) ! CYCLE C = GETPAR RES = 0 IF C # '=' THEN START PN = PNUM FINISH ELSE START PN = FINDKEY IF PN = 0 THEN RES = 322; ! Unknown keyword IF PN = -1 THEN RES = 321; ! Ambiguous keyword IF PN = -2 THEN RES = 325; ! Missing keyword C = GETPAR IF C = '=' THEN RES = 320; ! Format error FINISH IF PN > PMAX THEN RES = 323; ! Too many parameters IF RES = 0 THEN START IF WKSP # "" # PARS(PN) THEN RES = 324 ! Duplicated parameter PARS(PN) = WKSP FINISH IF RES # 0 THEN RESULT = RES IF C = -1 THEN RESULT = 0; ! Finished, all OK PNUM = PNUM + 1 REPEAT END ; ! of PARAMDECODE ! ! STRING (63)FN SPECMESSAGE(INTEGER N) SWITCH MES(1000:1001) ! -> MES(N) ! MES(1000): RESULT = "Failed to claim tape" MES(1001): RESULT = "Tape write error" END ; ! of SPECMESSAGE ! ! ROUTINE FAIL(INTEGER N) SELECTOUTPUT(0) PRINTSTRING(SNL."WRITEVTAPE fails - ") IF N < 1000 THEN START PRINTSTRING(FAILUREMESSAGE(N)) FINISH ELSE START PRINTSTRING(SPECMESSAGE(N).SNL) FINISH SET RETURN CODE(N) STOP END ; ! of FAIL ! ! ROUTINE READLINE(STRINGNAME S) INTEGER C ! S = "" CYCLE CYCLE READSYMBOL(C) EXIT IF C = NL S <- S.TOSTRING(C) REPEAT ! WHILE LENGTH(S) > 0 CYCLE C = CHARNO(S,LENGTH(S)) EXIT UNLESS C = ' ' LENGTH(S) = LENGTH(S) - 1 REPEAT ! EXIT UNLESS LENGTH(S) = 0 REPEAT END ; ! of READLINE ! ! ROUTINE WARN(STRING (255) S) SELECTOUTPUT(0) PRINTSTRING(S) SELECTOUTPUT(LISTCHAN) PRINTSTRING(S) END ; ! of WARN ! ! ROUTINE FIXUSER(STRINGNAME S) IF LENGTH(S) < 8 OR CHARNO(S,7) # '.' THEN START S <- UINFS(1).".".S FINISH END ; ! of FIXUSER ! ! !*********************************************************************** !* !* W R I T E V T A P E !* !*********************************************************************** ! EXTERNALROUTINE WRITEVTAPE(STRING (255) PARMS) STRINGNAME VOL,CS,OUT,TYPE,VS INTEGER AD,FLAG,STARTCHAP,CHAPTER,CONAD,EPAGES,REMAINDER,FAILURES,PD,I INTEGER NBYTES STRING (6) USER STRING (63) LINE,INPUT,OUTPUT,FILE,WORK RECORD FR(FRF) RECORD RR(RF) RECORDNAME R(HF) RECORDNAME H(HPF) STRING (255)ARRAY OPTIONS(1:KEYMAX) BYTEINTEGERARRAY BUF(0:4095) ! SET RETURN CODE(1000); ! In case of catastrophic failure FLAG = PARAMDECODE(PARMS,KEYMAX,KEYS,OPTIONS) IF FLAG # 0 THEN FAIL(FLAG) VOL == OPTIONS(1) CS == OPTIONS(2) OUT == OPTIONS(3) TYPE == OPTIONS(4) VS == OPTIONS(5) ! IF VOL = "" THEN FAIL(263); ! Wrong number of parameters UNLESS 1 <= LENGTH(VOL) <= 6 THEN START SETFNAME(KEYS(1)) FAIL(326); ! Invalid value for TAPE parameter FINISH ! IF CS # "" THEN START ; ! Starting chapter specified STARTCHAP = PSTOI(CS) UNLESS 1 <= STARTCHAP <= MAXCHAP THEN START SETFNAME(KEYS(2)) FAIL(326); ! Invalid value for STARTCHAP parameter FINISH FINISH ELSE STARTCHAP = 1 ! IF OUT = "" THEN OUT = "T#LIST" ! IF TYPE = "" THEN TYPE = "TRANSFER" UNLESS 1 <= LENGTH(TYPE) <= 8 THEN START SETFNAME(KEYS(4)) FAIL(326); ! Invalid value for TYPE parameter FINISH ! IF VS # "" THEN START IF MATCHSTRINGS(VS,"NO") = NO THEN START IF MATCHSTRINGS(VS,"YES") = YES THEN START PRINTSTRING("Version: E".ITOS(VERSION).".".ITOS(EDIT).SNL) FINISH ELSE START SETFNAME(KEYS(5)) FAIL(326); ! Invalid value for VERSION parameter FINISH FINISH FINISH ! ASKMT(VOL."*",FLAG) IF FLAG # 0 THEN START SETFNAME(VOL) FAIL(1000) FINISH REWINDMT ! AD = ADDR(BUF(0)) H == RECORD(AD) ! DEFINE(ITOS(LISTCHAN).",".OUT) SELECTOUTPUT(LISTCHAN) NEWLINES(2) PRINTSTRING("EMAS 2900 VTAPE written at ".TIME." on ".DATE.C " - volume label ".VOL) NEWLINES(2) ! IF STARTCHAP = 1 THEN START SKIPMT(1); ! Skip volume label WRITETMMT(FLAG) -> TAPEERR IF FLAG # 0 FINISH ELSE SKIPTMMT(STARTCHAP) ! CHAPTER = STARTCHAP - 1 FAILURES = 0 CYCLE PROMPT("File: ") READLINE(LINE) EXIT IF LINE = ".END" IF CHARNO(LINE,LENGTH(LINE)) = ')' THEN START LENGTH(LINE) = LENGTH(LINE) - 1 UNLESS LINE -> INPUT.("(").OUTPUT THEN START LINE <- LINE.")" WARN(LINE.SNL) WARN("Wrong format - use 'file' or 'file(newfile)'".SNL) FAILURES = FAILURES + 1 CONTINUE FINISH FINISH ELSE START INPUT = LINE OUTPUT = LINE FINISH FIXUSER(OUTPUT) IF OUTPUT -> USER.(".").LINE.("_").WORK THEN START OUTPUT = USER.".".WORK; ! Remove any pdfile name FINISH FIXUSER(INPUT) IF INPUT -> LINE.("_") THEN START PD = YES FINISH ELSE START LINE = INPUT PD = NO FINISH FINFO(LINE,1,FR,FLAG) IF FLAG = 0 THEN START CONNECT(INPUT,1,0,0,RR,FLAG) FINISH IF FLAG # 0 THEN START WARN("Warning - ".FAILUREMESSAGE(FLAG)) FAILURES = FAILURES + 1 CONTINUE FINISH CONAD = RR_CONAD R == RECORD(CONAD) EPAGES = (R_DATAEND+4095)//4096 REMAINDER = R_DATAEND - (EPAGES-1)*4096; ! Length of information in last epage ! ! Set up header page ! CHAPTER = CHAPTER + 1 FILL(4096,AD,0); ! Clear page H_TAPENAME = VOL H_USERNAME = FROMSTRING(OUTPUT,1,6) H_FILENAME = FROMSTRING(OUTPUT,8,LENGTH(OUTPUT)) H_DATE = DATE H_TIME = TIME H_TYPE = TYPE H_CHAPTER = CHAPTER H_EPAGES = EPAGES H_FSYS = -1 H_PERMS = 1; ! Permissions are included H_OWN = FR_RUP; ! Take from input file H_EEP = FR_EEP; ! Take from input file ! ! Write the header page ! WRITEMT(AD,4096,FLAG) -> TAPEERR IF FLAG # 0 ! ! Copy the file itself ! CYCLE I = 1,1,EPAGES IF I = EPAGES AND REMAINDER # 0 AND PD = YES THEN START NBYTES = REMAINDER; ! Last and incomplete page of pdfile member FILL(4096,AD,0); ! Clear buffer page FINISH ELSE NBYTES = 4096 MOVE(NBYTES,CONAD+4096*(I-1),AD) WRITEMT(AD,4096,FLAG) -> TAPEERR IF FLAG # 0 REPEAT ! WRITETMMT(FLAG) ! -> TAPEERR IF FLAG # 0 PRINTSTRING(INPUT) SPACES(32-OUTPOS) PRINTSTRING("written as ".OUTPUT) SPACES(62-OUTPOS) PRINTSTRING(" Chapter =") WRITE(CHAPTER,1) SPACES(79-OUTPOS) PRINTSTRING(" Pages =") WRITE(EPAGES,1) NEWLINE DISCONNECT(INPUT,FLAG) REPEAT ! WRITETMMT(FLAG); ! Double tape mark to terminate -> TAPEERR IF FLAG # 0 ! SELECTOUTPUT(0) CLOSE STREAM(LISTCHAN) IF FAILURES # 0 THEN START PRINTSTRING(ITOS(FAILURES)." file") IF FAILURES # 1 THEN PRINTSYMBOL('s') PRINTSTRING(" failed to transfer".SNL) FINISH PRINTSTRING("Tape written".SNL) UNLOADMT SET RETURN CODE(-FAILURES) STOP ! TAPEERR: ! UNLOADMT FAIL(1001); ! Tape write error END ; ! of VTAPE ENDOFFILE