!***********************************************************************
!*
!* Utility program to copy the 'tail end' of a file
!*
!* R.D.Eager UKC MCMLXXXII
!*
!***********************************************************************
!
CONSTANTINTEGER VERSION = 2; ! Major version number
CONSTINTEGER EDIT = 0; ! Edit number within major version
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
CONSTANTINTEGER NO = 0, YES = 1
CONSTANTINTEGER CHARS = 0, LINES = 1
CONSTANTINTEGER SSCHARFILETYPE = 3
CONSTANTINTEGER HDSIZE = 32; ! Size of a file header
CONSTANTSTRING (1) SNL = "
"
CONSTANTINTEGER KEYMAX = 5; ! Number of parameter keywords
CONSTANTSTRING (8)ARRAY KEYS(1:KEYMAX) = C
"INPUT",
"OUTPUT",
"POSITION",
"UNITS",
"VERSION"
!
!
!***********************************************************************
!*
!* Record formats
!*
!***********************************************************************
!
RECORDFORMAT HF(INTEGER DATAEND,DATASTART,FILESIZE,FILETYPE,C
SUM,DATETIME,FORMAT,RECORDS)
RECORDFORMAT RF(INTEGER CONAD,FILETYPE,DATASTART,DATAEND)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
SYSTEMROUTINESPEC CONNECT(STRING (31) FILE,INTEGER MODE,HOLE,C
PROT,RECORD (RF)NAME R,INTEGERNAME FLAG)
SYSTEMINTEGERFUNCTIONSPEC DEVCODE(STRING (16) DEVICE)
SYSTEMROUTINESPEC DISCONNECT(STRING (31) FILE,INTEGERNAME FLAG)
SYSTEMSTRINGFUNCTIONSPEC FAILUREMESSAGE(INTEGER MESS)
SYSTEMSTRINGFUNCTIONSPEC ITOS(INTEGER N)
SYSTEMROUTINESPEC MOVE(INTEGER LENGTH,FROM,TO)
SYSTEMSTRINGFUNCTIONSPEC NEXTTEMP
SYSTEMROUTINESPEC OUTFILE(STRING (31) FILE,INTEGER SIZE,HOLE,C
PROT,INTEGERNAME CONAD,FLAG)
SYSTEMINTEGERFUNCTIONSPEC PSTOI(STRING (63) S)
SYSTEMROUTINESPEC SENDFILE(STRING (31) FILE,STRING (16) DEVICE,C
STRING (11) NAME,INTEGER COPIES,FORMS,C
INTEGERNAME FLAG)
SYSTEMROUTINESPEC SETFNAME(STRING (63) S)
EXTERNALROUTINESPEC SET RETURN CODE(INTEGER I)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
INTEGERFUNCTION 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
!
!
INTEGERFUNCTION PARAMDECODE(STRING (255) PARAM,INTEGER PMAX,C
STRINGARRAYNAME KEYS,PARS)
INTEGER I,PNUM,PN,RES,C,PARPTR,PARLENG
STRING (255) WKSP
!
INTEGERFUNCTION FINDKEY
INTEGER F,I
!
IF LENGTH(WKSP) = 0 THEN RESULT = -2; ! Missing keyword
F = 0
FOR I = 1,1,PMAX CYCLE
IF MATCHSTRINGS(WKSP,KEYS(I)) = YES THEN START
UNLESS F = 0 THEN RESULT = -1
F = I
FINISH
REPEAT
RESULT = F
END ; ! of FINDKEY
!
INTEGERFUNCTION 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
!
FOR I = 1,1,PMAX CYCLE
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
!
!
ROUTINE FAIL(INTEGER N)
PRINTSTRING(SNL."TAIL fails - ".FAILUREMESSAGE(N))
SET RETURN CODE(N)
STOP
END ; ! of FAIL
!
!
INTEGERFUNCTION YES OR NO(STRINGNAME S,INTEGER KEYNO)
INTEGER REPLY
!
REPLY = NO
IF S # "" THEN START
IF MATCHSTRINGS(S,"YES") = YES THEN REPLY = YES ELSE START
UNLESS MATCHSTRINGS(S,"NO") = YES THEN START
SETFNAME(KEYS(KEYNO))
FAIL(326); ! Invalid value for parameter
FINISH
FINISH
FINISH
RESULT = REPLY
END ; ! of YES OR NO
!
!
!***********************************************************************
!*
!* T A I L
!*
!***********************************************************************
!
EXTERNALROUTINE TAIL(STRING (255) S)
INTEGER FLAG,I,J,UNITS,SPOOL,PTR,SIZE,OUTCONAD,SIGN
INTEGER GVERSION,POSITION,CONAD
STRINGNAME FILE,OUT,PS,US,VS
STRING (15) DEVICE
STRING (255)ARRAY OPTIONS(1:KEYMAX)
RECORD (RF) RR
RECORD (HF)NAME OUTHD
!
SET RETURN CODE(1000); ! In case of catastrophic failure
FLAG = PARAMDECODE(S,KEYMAX,KEYS,OPTIONS)
IF FLAG # 0 THEN FAIL(FLAG)
FILE == OPTIONS(1)
OUT == OPTIONS(2)
PS == OPTIONS(3)
US == OPTIONS(4)
VS == OPTIONS(5)
!
FAIL(263) IF FILE = ""; ! Wrong number of parameters
OUT = ".OUT" IF OUT = ""
PS = "-22" IF PS = ""
POSITION = -1
SIGN = CHARNO(PS,1)
IF SIGN = '+' OR SIGN = '-' THEN START
IF LENGTH(PS) > 1 THEN START
POSITION = PSTOI(SUBSTRING(PS,2,LENGTH(PS)))
FINISH
FINISH ELSE START
SIGN = '+'
POSITION = PSTOI(PS)
FINISH
IF POSITION < 0 THEN START
SETFNAME(KEYS(3))
FAIL(326); ! Invalid value for parameter
FINISH
!
UNITS = LINES
IF US # "" THEN START
IF MATCHSTRINGS(US,"CHARACTERS") = YES THEN START
UNITS = CHARS
FINISH ELSE START
UNLESS MATCHSTRINGS(US,"LINES") = YES THEN START
SETFNAME(KEYS(4))
FAIL(326); ! Invalid value for parameter
FINISH
FINISH
FINISH
!
GVERSION = YES OR NO(VS,5)
IF GVERSION = YES THEN START
PRINTSTRING("Version: E".ITOS(VERSION).".".ITOS(EDIT).SNL)
FINISH
!
CONNECT(FILE,1,0,0,RR,FLAG)
IF FLAG # 0 THEN FAIL(FLAG)
IF RR_FILETYPE # SSCHARFILETYPE THEN START
SETFNAME(FILE)
FAIL(267); ! Invalid filetype
FINISH
CONAD = RR_CONAD
!
IF UNITS = CHARS THEN START
IF SIGN = '+' THEN START
IF POSITION = 0 THEN POSITION = 1
PTR = RR_DATASTART + POSITION - 1
IF PTR > RR_DATAEND THEN PTR = RR_DATAEND
FINISH ELSE START
PTR = RR_DATAEND - POSITION
IF PTR < RR_DATASTART THEN PTR = RR_DATASTART
FINISH
PTR = PTR + CONAD
FINISH ELSE START
IF SIGN = '+' THEN START
PTR = CONAD + RR_DATASTART
J = CONAD + RR_DATAEND
WHILE PTR < J AND POSITION > 1 CYCLE
IF BYTEINTEGER(PTR) = NL THEN START
POSITION = POSITION - 1
FINISH
PTR = PTR + 1
REPEAT
PTR = PTR - 1
FINISH ELSE START
PTR = CONAD + RR_DATAEND
IF PTR > CONAD + RR_DATASTART THEN START
IF BYTEINTEGER(PTR-1) = NL THEN PTR = PTR - 1
! In case last line is incomplete
FINISH
J = CONAD + RR_DATASTART
WHILE PTR > J AND POSITION > 0 CYCLE
PTR = PTR - 1
IF BYTEINTEGER(PTR) = NL THEN START
POSITION = POSITION - 1
FINISH
REPEAT
FINISH
PTR = PTR + 1
FINISH
SIZE = RR_DATAEND - PTR + CONAD
!
IF SIZE > 0 THEN START
IF OUT = ".OUT" THEN START
FOR I = PTR,1,CONAD + RR_DATAEND - 1 CYCLE
PRINTSYMBOL(BYTEINTEGER(I))
REPEAT
FINISH ELSE START
IF CHARNO(OUT,1) = '.' THEN START
IF DEVCODE(OUT) <= 0 THEN START
! Illegal, or .TEMP, or .NULL
SETFNAME(OUT)
FAIL(264); ! Invalid device code
FINISH
SPOOL = 1; DEVICE = OUT
OUT = "T#".NEXTTEMP
FINISH ELSE SPOOL = 0
OUTFILE(OUT,SIZE+HDSIZE,0,0,OUTCONAD,FLAG)
IF FLAG # 0 THEN FAIL(FLAG)
OUTHD == RECORD(OUTCONAD)
OUTHD_FILETYPE = SSCHARFILETYPE
MOVE(SIZE,PTR,OUTCONAD+OUTHD_DATASTART)
OUTHD_DATAEND = OUTHD_DATASTART + SIZE
DISCONNECT(OUT,FLAG)
IF SPOOL = 1 THEN START
SENDFILE(OUT,DEVICE,"TAILLIST",0,0,FLAG)
IF FLAG # 0 THEN FAIL(FLAG)
FINISH
FINISH
FINISH
SET RETURN CODE(0)
END ; ! of TAIL
ENDOFFILE