constinteger amdahl = 369, xa = 371
INCLUDE "TARGET"
if TARGET = 2900 start { machine specific constants }
constinteger line len = 41 {for oper screen driving}
constinteger MAX LINE = 132
conststringname DATE = X'80C0003F'
conststringname TIME = X'80C0004B'
constinteger SEG SHIFT = 18
constinteger uinf seg = 9
finish { 2900 }
!
if TARGET = 370 start
constinteger SEG SHIFT = 16
finish
!
if TARGET = XA or TARGET = AMDAHL start
constinteger SEG SHIFT = 20
finish
!
unless TARGET = 2900 start
constinteger line len = 40 {for oper screen driving}
constinteger com seg = 31
conststringname DATE = COM SEG << SEG SHIFT + X'3B'
conststringname TIME = COM SEG << SEG SHIFT + X'47'
constinteger MAX LINE = 80 { for convenience on terminals }
constinteger uinf seg = 239
finish
!TITLE Connecting configuration database
!
! %externalroutine READ FT CONFIG ( %string(6) INFILE OWNER, OUTFILE OWNER,
! %integer IN FSYS, OUT FSYS, %string(11) INFILE, OUTFILE,
! %integername lines, database conad, POINTERS ADDR)
!
! This routine attempts to connect the file <OUTFILE OWNER.OUTFILE> on
!fsys <OUT FSYS>, which has been created by the routine INT SPOOL CONFIG. The
!various connect address are passed back.
!
!>
!--------------------------------------------------------------------------------------------------------------!
! READ FT CONFIG
! by Jeremy Gibbons & modified for service by J.H.
! Version No : 2.5
!--------------------------------------------------------------------------------------------------------------!
externalroutine READ FT CONFIG(string (6) INFILE OWNER, OUTFILE OWNER, integer IN FSYS, OUT FSYS,
string (11) INFILE, OUTFILE,
integername lines, database conad, pointers addr)
! Routine to be called from FTRANS to connect the configuration database.
! The various connect addresses are passed back to the calling routine.
externalintegerfnspec current packed dt
IF TARGET = 2900 start
externalstringfnspec DERRS(integer FLAG)
externalintegerfnspec dpermission(string (6) owner,user,
string (8) date, string (11) file, integer fsys,type,perm)
externalintegerfnspec DCONNECT(string (6) USER, string (11) FILE, integer FSYS, MODE, APF,
integername SEG, GAP)
externalintegerfnspec DTRANSFER(string (6) user1, user2,
string (11) file, newname, integer fsys1, fsys2, type)
externalintegerfnspec DDESTROY(string (6) user, string (11) file,
string (8) date, integer fsys, type)
externalintegerfnspec DRENAME(string (6) USER, string (11) OLDNAME, NEWNAME, integer FSYS)
externalintegerfnspec DNEWGEN(string (6) USER, string (11) FILE, NEWGEN OF FILE, integer FSYS)
externalintegerfnspec DDISCONNECT(string (6) USER, string (11) FILE, integer FSYS, DESTROY)
finish else start {non 2900}
EXTERNALINTEGERFNSPEC DCONNECT(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, MODE, SEG, GAP)
EXTERNALINTEGERFNSPEC DDESTROY(STRINGNAME FILE INDEX, FILE, DATE, INTEGERNAME FSYS, TYPE)
EXTERNALINTEGERFNSPEC DDISCONNECT(STRINGNAME FILE INDEX, FILE, INTEGERNAME FSYS, DSTRY)
EXTERNALINTEGERFNSPEC DFLAG(INTEGERNAME FLAG, STRINGNAME TXT)
EXTERNALINTEGERFNSPEC DNEWGEN(STRINGNAME FILE INDEX, FILE, NEWGEN, INTEGERNAME FSYS)
EXTERNALINTEGERFNSPEC DPERMISSION(STRINGNAME FILE INDEX, C
USER, DATE, FILE, INTEGERNAME FSYS, TYPE, ADR)
EXTERNALINTEGERFNSPEC DRENAME(STRINGNAME FILE INDEX, OLDNAME, NEWNAME, INTEGERNAME FSYS)
EXTERNALINTEGERFNSPEC DTRANSFER(STRINGNAME FILE INDEX1, FILE INDEX2, FILE1, C
FILE2, INTEGERNAME FSYS1, FSYS2, TYPE)
finish
constbyteinteger R= B'00000001',
W = B'00000010',
SHARED = B'00001000' ; ! Flags for CONNECT mode
constinteger amdahl = 369, xa = 371
conststring (11) temp outfile = "TEMPCFILE"
conststring (1) SNL= "
"
constinteger max fsys = 99
constinteger hash length = 1023
constinteger doesnt exist = 32
integer FLAG, SEG, GAP, i, j, CONAD, old stns, new stns, newgenning required
recordformat FHF(integer END, START, SIZE, TYPE, SPARE, DATETIME,halfinteger QUEUES, REMOTES, STREAMS, STATIONS)
! Format of file header
!*
record format pointers f(integer link list displ, ftp table displ, queues, queue entry size,
queue displ, queue name displ, streams, stream entry size, stream displ, remotes,
remote entry size, remote displ, remote name displ, stations, station entry size, station displ,
control entry, station addresses displ,guest entry, byte integer array discs(0:max fsys),
string (63) dead letters, this full host, integer expanded address displ, integer array hash t(0:hash length))
record format FTP station f(byte integer max lines ,
byteinteger status, byteinteger service ,
byteinteger connect retry ptr, fep,
address type, accounting,
byteinteger q lines ,
integer limit , integer last call, last response,
(integer system loaded or integer in service),
integer connect attempts, connect retry time, integer array ispare(0:4),
integer seconds, bytes,
integer last q response by us,
p transfers, q transfers, p kb, q kb, p mail, q mail, integer name, shortest name,
integerarray address(1:4), integer pss entry, integer mail, integer ftp,
integer description, (integer queue or integer route), integer flags,
byteintegerarray string space(0 : 375){decrement this if more fields added, keep to 512 total})
!*
record (ftp station f)arrayformat ftpsf(1:512)
record (ftp station f)arrayname old stations, new stations
!*
! Format of pointers at head of file
record (FHF) name FILE HEADER
record (POINTERS F) name POINTERS; ! Map records onto file
!--------------------------------------------------------------------------------------------------------------!
!--------------------------------------------------------------------------------------------------------------!
!--------------------------------------------------------------------------------------------------------------!
stringfn errs(integer flag)
integer i; string (63) error
if TARGET = 2900 then result = derrs(flag) else START
i = dflag(flag,error)
result = error
FINISH
end
newgenning required = 0
LINES = 0
flag = ddestroy(outfile owner,temp outfile,"",out fsys,0)
unless flag = 0 or flag = 32 then printstring("****FTRAN-DB FAULT****". c
snl."DDESTROY ".temp outfile." fails ".errs(flag).snl) else start
flag = dtransfer(infile owner,outfile owner,infile,temp outfile, c
in fsys,out fsys,3) {copy}
if flag # 0 then printstring("****FTRAN-DB FAULT****".snl. c
snl."DTRANSFER ".infileowner.".".infile." to ".tempoutfile. c
" fails ".errs(flag).snl) else start
flag = drename(outfile owner,temp outfile,outfile,out fsys)
if flag # 0 start
!NOTE
!IMPORTANT
!If the format of the STATION array is changed then the Next
!start up must be performed with CFILE deleted.
!
!If we are to newgen on an old copy then get the stats from it first.
printstring("Copying Statistics.".snl)
seg = 0; gap = 0
if TARGET # 2900 then flag = dconnect(outfile owner,outfile, c
outfsys,R!W!SHARED,seg,gap) else c
flag = dconnect(outfile owner,outfile,outfsys,R!W!SHARED,0,seg,gap)
if flag # 0 then printstring("Cannot access old database ".errs(flag).snl) c
else start
conad = seg<<seg shift
file header == record(conad)
pointers == record(conad+file header_start)
old stns = pointers_stations
old stations == array(conad+pointers_station displ,ftpsf)
seg = 0; gap = 0
if TARGET # 2900 then flag = dconnect(outfile owner,temp outfile, c
outfsys,R!W,seg,gap) else c
flag = dconnect(outfile owner,temp outfile,outfsys,R!W,0,seg,gap)
if flag # 0 then printstring("DISASTER, cannot connect TEMPOUTFILE ".errs(flag).snl) c
and return
conad = seg<<seg shift
file header == record(conad)
pointers == record(conad+file header_start)
new stns = pointers_stations
new stations == array(conad+pointers_station displ,ftpsf)
if new stns # old stns then printstring("Station count change".snl)
cycle i = 1,1,old stns
cycle j = 1,1,new stns
if string(addr(old stations(i)_string space(0)) + c
old stations(i)_shortest name) = string(addr(new stations(j)_ c
string space(0)) + new stations(j)_shortest name) start
new stations(j)_last call = old stations(i)_last call
new stations(j)_in service = old stations(i)_in service
new stations(j)_last response = old stations(i)_last response
new stations(j)_connect attempts = old stations(i)_connect attempts
new stations(j)_last q response by us = c
old stations(i)_last q response by us
new stations(j)_P transfers = old stations(i)_P transfers
new stations(j)_Q transfers = old stations(i)_Q transfers
new stations(j)_P kb = old stations(i)_P kb
new stations(j)_Q kb = old stations(i)_Q kb
new stations(j)_P mail = old stations(i)_P mail
new stations(j)_Q mail = old stations(i)_Q mail
new stations(j)_bytes = old stations(i)_bytes
new stations(j)_seconds = old stations(i)_seconds
exit
finish
repeat
repeat
cycle i = 1,1,new stns
j = current packed dt
if new stations(i)_in service = 0 start
printstring("New station ".string(addr(new stations(i)_string c
space(0)) + new stations(i)_shortest name).snl)
new stations(i)_in service = j
finish
repeat
finish
flag = ddisconnect(outfile owner,outfile,outfsys,0)
flag = ddisconnect(outfile owner,temp outfile,outfsys,0)
flag = dnewgen(outfile owner,outfile, temp outfile,out fsys)
printstring("Newgen required".snl)
newgenning required = 1
finish
if flag # 0 then printstring("****FTRAN-DB FAULT****".snl. c
"DRENAME/DNEWGEN ".temp outfile." to ".outfile." fails ".errs(flag). c
snl) else start
SEG = 0
GAP = 0; ! Any segment, any gap
if TARGET # 2900 then flag = dconnect(outfile owner, outfile, c
outfsys,R!W!SHARED,seg,gap) else c
FLAG = DCONNECT(OUTFILE OWNER, OUTFILE, OUT FSYS, R ! W ! SHARED, 0, SEG, GAP)
if FLAG = 0 then start ; ! File was successfully connected
CONAD = SEG << seg shift; ! Change SEG to a virtual address
integer(conad+28) = x'F0F0F0F0' { to identify new format CFILE}
FILE HEADER == RECORD(CONAD)
POINTERS == RECORD(CONAD + FILE HEADER_START)
Pointers addr = conad + file header_start
Database conad = conad
if newgenning required = 0 start
j = current packed dt
new stations == array(conad + pointers_station displ,ftpsf)
cycle i = 1,1,pointers_stations
new stations(i)_in service = j
repeat
finish
lines = pointers_streams
flag = dpermission(outfile owner,"","",outfile,out fsys,1,r)
if flag # 0 then printstring("DISASTER..FAILED TO SET CFILE PERMISSION".snl)
return { ok we have the FTRANS database connected.}
finish else PRINT STRING("****FTRAN-DB FAULT****".snl. c
"Failed to connect ".OUTFILE OWNER.".".OUTFILE." : ".ERRS(FLAG).SNL)
finish
finish
finish
end ; ! of externalroutine READ SPOOL CONFIG
endoffile