!**DELSTART
!*
!*****RECORDFORMATS****
!*
!*
RECORDFORMAT DIRINFF(STRING (6) USER, C
STRING (31) BATCHFILE, C
INTEGER MARK, FSYS, PROCNO, ISUFF, REASON, BATCHID, C
SESSICLIM, SCIDENSAD, SCIDENS, OPERNO, AIOSTAT, SCDATE, C
SYNC1DEST, SYNC2DEST, ASYNCDEST, AACCTREC, AICREVS, C
STRING (15) BATCHIDEN)
RECORDFORMAT PDHF(INTEGER DATAEND, DATASTART, SIZE, FILETYPE, C
SUM, DATETIME, ADIR, COUNT)
RECORDFORMAT PDF(INTEGER START, STRING (11) NAME, C
INTEGER HOLE, S5, S6, S7)
RECORDFORMAT SIGDATAF(INTEGER PC, LNB, CLASS, SUBCLASS, C
INTEGERARRAY A(0 : 17))
RECORDFORMAT DFF(INTEGER NKB, RUP, EEP, MODE, USE, ARCH, FSYS, C
CONSEG, CCT, CODES, CODES2, SSBYTE, STRING (6) TRAN)
RECORDFORMAT RF(INTEGER CONAD, FILETYPE, DATASTART, DATAEND)
RECORDFORMAT HF(INTEGER DATAEND, DATASTART, FILESIZE, FILETYPE, C
SUM, DATETIME, FORMAT, RECORDS)
RECORDFORMAT FRF(INTEGER CONAD, FILETYPE, DATASTART, DATEND, C
SIZE, RUP, EEP, MODE, USERS, ARCH, C
STRING (6) TRAN, STRING (8) DATE, TIME, C
INTEGER COUNT, SPARE1, SPARE2)
RECORDFORMAT CONFF(STRING (18) FILE, C
INTEGER CONAD, SIZE, HOLE, MODE, USE)
!*****SPECS OF DIRECTOR ROUTINES*****
EXTERNALINTEGERFNSPEC DMESSAGE(STRING (6) USER, C
INTEGERNAME LEN, INTEGER ACT, FSYS, ADR)
EXTERNALINTEGERFNSPEC DASYNCINH(INTEGER MODE, ATW)
EXTERNALROUTINESPEC DMONITOR(INTEGER I)
EXTERNALROUTINESPEC DRESUME(INTEGER LNB, PC, AD18)
EXTERNALINTEGERFNSPEC DFSTATUS(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, ACT, VALUE)
ROUTINESPEC FINFO(STRING (31) FILE, INTEGER MODE, C
RECORDNAME FR, INTEGERNAME FLAG)
EXTERNALINTEGERFNSPEC READID(INTEGER AD)
EXTERNALINTEGERFNSPEC DSFI(STRING (6) USER, C
INTEGER FSYS, TYPE, SET, ADR)
EXTERNALINTEGERFNSPEC DSETIC(INTEGER KI)
! %EXTERNALINTEGERFNSPEC DNEWGEN(%STRING (6) USER, %C
STRING (11) FILE, NEWGEN OF FILE, INTEGER FSYS)
EXTERNALINTEGERFNSPEC DPERMISSION( C
STRING (6) OWNER, USER, STRING (8) DATE, C
STRING (11) FILE, INTEGER FSYS, TYPE, ADRPRM)
EXTERNALINTEGERFNSPEC DCHSIZE(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, NEWSIZE KB)
EXTERNALROUTINESPEC DSTOP(INTEGER REASON)
EXTERNALINTEGERFNSPEC DCREATE(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, NKB, TYPE)
EXTERNALINTEGERFNSPEC DDESTROY(STRING (6) USER, C
STRING (11) FILE, STRING (6) DATE, INTEGER FSYS, TYPE)
EXTERNALINTEGERFNSPEC DDISCONNECT(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, DESTROYMODE)
! %EXTERNALINTEGERFNSPEC DRENAME(%STRING (6) USER, %C
STRING (11) OLD, NEW, INTEGER FSYS)
EXTERNALINTEGERFNSPEC DFINFO(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, ADDR)
EXTERNALINTEGERFNSPEC DCONNECT(STRING (6) USER, C
STRING (11) FILE, INTEGER FSYS, MODE, APF, C
INTEGERNAME SEG, GAP)
! %EXTERNALINTEGERFNSPEC DOFFER(%STRING (6) USER, TO, %C
STRING (11) FILE, INTEGER FSYS)
! %EXTERNALINTEGERFNSPEC DACCEPT(%STRING (6) USER, %C
STRING (11) FILE, NEWNAME, INTEGER FSYS)
!*
!*
!********SPECS OF SYSTEMROUTINES ELSEWHERE IN SUBSYSTEM*****
!*
!*
SYSTEMSTRINGFNSPEC ITOS(INTEGER N)
SYSTEMROUTINESPEC PHEX(INTEGER I)
SYSTEMROUTINESPEC CONSOLE(INTEGER EP, INTEGERNAME P1, P2)
SYSTEMROUTINESPEC CONTROL
!*
!*
!*****SPECS FOR ROUTINES IN THIS FILE****
!*
!*
!*
ROUTINESPEC CONMEMBER(STRING (31) FILE, C
STRING (11) MEMBER, INTEGER PROTECTION, C
RECORDNAME R, INTEGERNAME FLAG)
ROUTINESPEC DISCONNECT(STRING (31) FILE, INTEGERNAME FLAG)
!*
!*
!****CONSTANTS********
!*
!*
EXTERNALINTEGER SSDATELINKED = 0; !PROPER VALUE IN GLOBALS
CONSTSTRING (4)LAST="}{|~"; !UNLIKELY PATTERN
CONSTSTRING (6) SPOOLERNAME = "SPOOLR"
CONSTINTEGER OPTFILESIZE=4096
CONSTINTEGERNAME KIPS=X'80C000C0'
CONSTINTEGER MAXCONF = 63
CONSTINTEGERARRAY HEX(0 : 15) = C
'0', '1', '2', '3', '4', '5', '6', C
'7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'
CONSTINTEGER SSPDFILETYPE = 6
CONSTINTEGER SSTEMPDIRSIZE = X'4000'; !SIZE OF SESSION DIRECTORY
!MUST BE CONSISTENT WITH COMMAND 'MAKEBASEFILE'
CONSTINTEGER TEMPMARKER = X'40000000'
CONSTINTEGER FILESIZEALLOC = 4096; !SIZE IN BYTES OF FILE SIZE
! ALLOCATIONS
CONSTINTEGER APDATE = X'80C0003F'; !ADDR(PUBLIC_DATE)
CONSTINTEGER APTIME = X'80C0004B'; !ADDR(PUBLIC_TIME)
CONSTINTEGER ATRANS = X'80C0008F'; !ADDR OF ITOE AND ETOI TABLES
CONSTINTEGER SEGSIZE = X'40000'
CONSTINTEGER SEGSHIFT = 18; !SHIFT TO GIVE SEGMENTS
CONSTINTEGER ABASEFILE = X'00800000'; !START OF BASEFILE AT SEG 32
CONSTINTEGER MAXSIGLEVEL = 6
CONSTINTEGER KSHIFT = 10; !SHIFT BYTES TO KBYTES
!*
!*
!*
!*****EXTERNAL VARIABLES*****
!*
!*
EXTERNALINTEGER ASSCOM
EXTERNALINTEGERARRAY SAVEIDATA(-2 : 20,0:3);!TO HOLD INTERRUPT DATA
EXTERNALINTEGER SSADEFOPT; !ADDRESS OF DEFAULT OPTION FILE
EXTERNALINTEGER BENCHMARK; !IF SET THEN SUPPRESS OUTPUT TO .LP AND
!START PROCESS FROM MANAGR.F1SCRIPT IF STARTED FROM OPER
EXTERNALINTEGER INTINPROGRESS = 1; !SET WHEN INT:A OR INT: C OCCURRS
EXTERNALINTEGER AIOSTAT; !ADDRESS OF IOSTAT RECORD
EXTERNALINTEGER SSADIRINF; !ADDRESS OF DIRECTOR RECORD
EXTERNALINTEGER INHIBITSPOOLER
EXTERNALINTEGER SSASESSDIR; !ADDRESS OF SESSION DIR
EXTERNALINTEGER SAVEIDPOINTER
EXTERNALRECORDARRAY CONF(0 : 63)(CONFF)
EXTERNALINTEGERARRAY SSCOMREG(0 : 60)
EXTERNALINTEGER SSINITWORKSIZE = X'40000'
EXTERNALINTEGER SSMAXWORKSIZE = X'100000'
EXTERNALINTEGER SSINHIBIT, SSINTCOUNT; !THESE TWO MUST STAY TOGETHER
EXTERNALINTEGER DIRDISCON = 1; !SET TO 1 WHEN DIRECTORY DISCONNECTED
EXTERNALINTEGER SSMAXFSIZE; !MAXIMUM FILE SIZE ALLOWED
EXTERNALINTEGER SSATEMPDIR; !ADDRESS OF TEMPORARY DIRECTORY
EXTERNALINTEGER SSCURBGLA; !CURRENT TOP OF BGLA
EXTERNALINTEGER SSMAXBGLA; !LAST BYTE OF BGLA
EXTERNALINTEGER SSSCCOUNT
EXTERNALINTEGER SSSCTABLE; !ADDRESS OF SCTABLE
EXTERNALINTEGER SSOPERNO; !NO OF OPER STARTED FROM
EXTERNALINTEGER SSREASON; !REASON FOR STARTING
! 0=INTERACTIVE
!1=STARTED FROM OPER. 2=BATCH
EXTERNALINTEGER SSOWNFSYS; !FSYS FOR THIS USER
EXTERNALSTRING (1) SSSUFFIX; !ADDED TO NAMES OF TEMP FILES
EXTERNALSTRING (6) SSOWNER
EXTERNALSTRING (40) SSFNAME; !NAME FOR PSYSMES
!*
!*
!**DELEND
!******OWNS******
!*
!*
OWNINTEGER CURFSYS
OWNSTRING (6) CURFOWNER
OWNSTRING (11) CURFNAME
OWNSTRING (18) CURFILE
OWNSTRING (11) CURMEMBER
OWNINTEGER ABGLA; !START OF BGLA
OWNSTRING (31) BASEFILE
OWNRECORDARRAY SIGDATA(1 : 6)(SIGDATAF)
!CURRENT MAX OF 4
OWNINTEGER LATEST; !IMPOSSIBLE VALUE
!*
!***END OF DECLARATIONS
!*
!*
!*
SYSTEMINTEGERFN DIRTOSS(INTEGER FLAG)
!RESULT IS SUBSYSTEM FAULT
! NUMBER EQUIV TO DIRECTOR
! FAULT NO
CONSTBYTEINTEGERARRAY DSS(1 : 52) = C
1, 2, 3, 4, 5, 173, 7, 8, C
174, 175,
11, 12, 13, 14, 176, 119, 176, 120, 19, 173,
21, 22, 23, 177, 178, 26, 27, 28, 29, 30,
177, 118, 179, 34, 35, 176, 203, 156, 156, 178,
180, 178, 176, 44, 45, 46, 47, 48, 181, 182,
183, 52
CONSTINTEGER MAXDSS = 52
IF FLAG = 0 THEN RESULT = 0; !MOST LIKELY RESULT
IF 1 <= FLAG <= MAXDSS THEN START
FLAG = DSS(FLAG)
IF FLAG < 100 THEN FLAG = FLAG+500 ELSE FLAG = FLAG+100
!DIRECTOR FAILURES 501-599
FINISH ELSE FLAG = FLAG+500
RESULT = FLAG
END ; !OF DIRTOSS
!***********************************************************************
!* *
!* THESE FUNCTIONS ALL USE A PACKED FORMAT OF DATE AND TIME OF THE *
!* FOLLOWING FORM. BITS ARE NUMBERED FROM 31 (MOST SIGNIFICANT) TO *
!* 0 (LEAST SIGNIFICANT) *
!* BITS USE *
!* 31-26 YEAR-70 (VALID FOR 1970-2033) *
!* 25-22 MONTH *
!* 21-17 DAY *
!* 16-12 HOUR *
!* 11- 6 MINUTE *
!* 5- 0 SECOND *
!* *
!***********************************************************************
INTEGERFN I2(INTEGER AD)
!AD POINTS TO THE FIRST OF A PAIR OF DECIMAL CHARACTERS. THE RESULT
!IS THE NUMERIC VALUE OF THE CHAS
RESULT = 10*(BYTEINTEGER(AD)&X'F')+(BYTEINTEGER(AD+1)&X'F')
END ; !OF I2
INTEGERFN PACKDATE(STRING (8) DATE)
INTEGER AD
AD = ADDR(DATE)
RESULT = ((I2(AD+7)-70)<<26)!(I2(AD+4)<<22)!(I2(AD+1)<<17)
END ; !OF PACKDATE
INTEGERFN PACKDATEANDTIME(STRING (8) DATE, TIME)
INTEGER AT
AT = ADDR(TIME)
RESULT = PACKDATE(DATE)!(I2(AT+1)<<12)!(I2(AT+4)<<6)!(I2( C
AT+7))
END ; !OF PACKDATEANDTIME
SYSTEMINTEGERFN ROUNDUP(INTEGER N, ROUND)
!RESULT IS N ROUNDED UP TO
! MULTIPLE OF ROUND >=N
ROUND = ROUND-1
RESULT = (N+ROUND)&(¬ROUND); ! AND WITH NOT ROUND
END ; !OF ROUNDUP
SYSTEMROUTINE MOVE(INTEGER LENGTH, FROM, TO)
*LB_LENGTH
*JAT_14,<L99>
*LDTB_X'18000000'
*LDB_B
*LDA_FROM
*CYD_0
*LDA_TO
*MV_L =DR
L99:
END ; !OF MOVE
SYSTEMROUTINE FILL(INTEGER LENGTH, FROM, FILLER)
*LB_LENGTH
*JAT_14,<L99>; !RETURN IF LENGTH<=0
*LDTB_X'18000000'
*LDB_B
*LDA_FROM
*LB_FILLER
*MVL_L =DR
L99:
END ; !OF FILL
SYSTEMROUTINE ITOE(INTEGER AD, L)
INTEGER J
J = SSCOMREG(12); !ADDR OF ITOE TABLE IN PUBLIC SEGMENT
*LB_L
*JAT_14,<L99>
*LDTB_X'18000000'
*LDB_B
*LDA_AD
*LSS_J
*LUH_X'18000100'
*TTR_L =DR
L99:
END ; !OF ITOE
SYSTEMROUTINE ETOI(INTEGER AD, L)
INTEGER J
J = SSCOMREG(11); !ADDR OF ETOI TABLE IN PUBLIC SEGMENT
*LB_L
*JAT_14,<L99>
*LDTB_X'18000000'
*LDB_B
*LDA_AD
*LSS_J
*LUH_X'18000100'
*TTR_L =DR
L99:
END ; !OF ETOI
SYSTEMROUTINE ALLOW INTERRUPTS
INTEGER I
SSINHIBIT = 0; !TO ALLOW INTERRUPTS AGAIN
WHILE SSINTCOUNT > 0 THEN I = DASYNCINH(1,0);!TAKE ANY OUTSTANDING ONES
END ; !OF ALLOW INTERRUPTS
SYSTEMROUTINE SIGNAL(INTEGER EP, P1, P2, INTEGERNAME FLAG)
RECORDNAME D(SIGDATAF)
INTEGERNAME SIGLEVEL
INTEGER LNB, AD18, PC, I
SWITCH SW(-1 : 6)
FLAG = 0; !DEFAULT
SIGLEVEL == SSCOMREG(34)
UNLESS -1 <= EP <= 6 THEN FLAG = 1 AND -> ERR
-> SW(EP)
SW(-1):
SW(0):
UNLESS 0 <= SIGLEVEL < MAXSIGLEVEL THEN FLAG = 1 AND -> ERR
!SIGNAL STACK FULL
SIGLEVEL = SIGLEVEL+1
D == SIGDATA(SIGLEVEL)
D_PC = P1; !PROGRAM COUNTER
D_LNB = P2; !LOCAL NAME BASE
-> ERR
SW(1): !UNSTACK
UNLESS 0 < SIGLEVEL <= MAXSIGLEVEL THEN FLAG = 1 AND -> ERR
IF P1 = 0 THEN SIGLEVEL = SIGLEVEL-1 ELSE SIGLEVEL = 0
-> ERR
SW(2): !SIGNAL ERROR AT CURRENT LLEVEL
IF MAXSIGLEVEL >= SIGLEVEL > 0 C
THEN I = SIGLEVEL AND SIGLEVEL = SIGLEVEL-1 C
ELSE DSTOP(101)
!SIGNAL STACK EMPTY
-> COMMON
SW(3):
UNLESS 0 < SIGLEVEL <= MAXSIGLEVEL THEN DSTOP(102)
!NO CONTS STACKED
I = 1; !SIGNAL AT OUTER LEVEL
COMMON:
D == SIGDATA(I)
LATEST = I; !POINTS TO LAST USED LEVEL
*STLN_LNB; !STORE LOCAL NAME BASE
D_CLASS = P1; !CLASS OF ERROR
D_SUBCLASS = P2
IF P1 > 70 START ; !SOFTWARE GEN FAULT
D_A(0) = INTEGER(LNB); !OLD LNB
D_A(2) = INTEGER(LNB+8); !OLD PC
FINISH
PC = D_PC
LNB = D_LNB
AD18 = ADDR(D_CLASS)
DRESUME(LNB,PC,AD18)
DSTOP(117); !SHOULD NEVER GET HERE
SW(4): !REPEAT LAST CONTINGENCY
IF SIGLEVEL # LATEST > 0 C
THEN MOVE(72,ADDR(SIGDATA(LATEST)_CLASS),ADDR(SIGDATA( C
SIGLEVEL)_CLASS))
SIGLEVEL = SIGLEVEL-1
-> COMMON
SW(5):
MONITOR
STOP
SW(6):
INTEGER(P1) = SIGLEVEL
ERR:
END ; !OF SIGNAL
SYSTEMROUTINE DIRTRAP(INTEGER CLASS, SUBCLASS)
INTEGER FLAG, LNB, SIGNALAT
INTEGERARRAY IDATA(0 : 17)
INTEGERNAME SIGLEVEL
RECORDNAME D(SIGDATAF)
SIGNALAT = 2; !NORMALLY SIGNALAT CURRENT LEVEL
SIGLEVEL == SSCOMREG(34)
UNLESS 0 < SIGLEVEL <= MAXSIGLEVEL THEN DSTOP(103)
FLAG = READID(ADDR(IDATA(0))); !READ INTERRUPT DATA
! NOW FRIG DISPLAY FOR THIS
! ROUTINE BECAUSE IT MIGHT BE
! USED
!BY ONCOND IN NDIAGS
*STLN_LNB; !CURRENT LNB
INTEGER(LNB+4) = X'E1000000'!(IDATA(1)&X'FFFFFF')
!CODE DESCRIPTOR WITH PART OF PSR
IF CLASS = 64 START ; !IC OVERFLOW
FLAG = DSETIC(30000); !GET 1 MIN NOW
FINISH
IF CLASS = 65 START ; !INTERRUPT FROM USER
IF SUBCLASS = 'Y' THEN DSTOP(113)
!INT:Y - GENERATED BY FEP TO
! CAUSE LOG-OFF
IF INTINPROGRESS#0 THEN ->CONTINUE
IF SUBCLASS='T' START
INTINPROGRESS=1
CONSOLE(12,FLAG,FLAG)
INTINPROGRESS=0
->CONTINUE
FINISH
IF ('Q' # SUBCLASS # 'A' AND SUBCLASS # 'C') THEN ->CONTINUE
!IGNORE SINGLE CHAR INTS
! APART FROM A,C AND Q PROTEM
!IGNORE EVEN THEM IF INT:A OR INT:C STILL BEING HANDLED
IF SUBCLASS # 'Q' START
SIGNALAT = 3; !INT:A AND INT:C AT OUTER LEVEL
INTINPROGRESS = 1; !TO INDICATE THAT AN INT:A OR AN INT:C IS BEING HANDLED
FINISH
FINISH
IF CLASS = 66 START ; !MESSAGE FROM OPERATOR
CONSOLE(6,FLAG,FLAG); !SEND CONSOLE OUTPUT REQUEST
DRESUME(0,0,ADDR(IDATA(0))); !GO ON WHERE WE LEFT OFF
FINISH
IF SIGNALAT = 2 START
D == SIGDATA(SIGLEVEL); !MOVE IDATA TO ARRAY
MOVE(72,ADDR(IDATA(0)),ADDR(D_A(0)))
MOVE(72,ADDR(IDATA(0)),ADDR(SAVEIDATA(0,SAVEIDPOINTER)))
!MOVE INTO SAVEIDATA
SAVEIDATA(-2,SAVEIDPOINTER) = CLASS
SAVEIDATA(-1,SAVEIDPOINTER) = SUBCLASS
MOVE(9,APTIME,ADDR(SAVEIDATA(18,SAVEIDPOINTER)))
!PUT TIME INTO RECORD
SAVEIDPOINTER = (SAVEIDPOINTER+1)&3
FINISH
SIGNAL(SIGNALAT,CLASS,SUBCLASS,FLAG)
CONTINUE:
DRESUME(0,0,ADDR(IDATA(0))); !GO ON WHERE INTERRUPTED
END ; !OF DIRTRAP
SYSTEMROUTINE QUIT
!CALL DIRECTOR STOP TO STOP
! PROCESS
DSTOP(100)
END ; !OF QUIT
SYSTEMINTEGERFN CHECKFILENAME(STRING (31) FILE, INTEGER TYPE)
!CHECKS FILENAME ACCORDING TO
! TYPE
!2**0 OWN FILE - STD NAME
!2**1 ANY FILE - STD NAME
!2**2 ANY NAME (INCLUDING #)
!2**3 PD MEMBERNAME
!IF OK PUTS OWNER AND NAME
! BACK IN CUFOWNER,CURFNAME
! AND CURFILE
! WITH NO CHANCE OF CAPACITY
! EXCEEDED
INTEGER I, CHAR, LENN
STRING (18) OWNER, NAME, MEMBER
IF FILE = LAST THEN RESULT = 0; !CURRENT FILE
IF LENGTH(FILE) > 30 THEN RESULT = 220
!INVALID FILENAME
IF FILE -> FILE.("_").MEMBER START
!FILE INCLUDES MEMBERNAME
IF TYPE&8 # 8 THEN RESULT = 269
!ILLEGAL USE OF PDFILE MEMBER
FINISH ELSE MEMBER = ""
IF LENGTH(FILE) > 18 THEN RESULT = 220
!INVALID FILENAME
UNLESS FILE -> OWNER.(".").NAME C
THEN OWNER = SSOWNER AND NAME = FILE
IF LENGTH(OWNER) # 6 THEN SSFNAME=OWNER AND RESULT = 201
!INVALID OWNER
LENN = LENGTH(NAME)
IF 2 <= LENN AND CHARNO(NAME,1) = 'T' C
AND CHARNO(NAME,2) = '#' THEN NAME = NAME.SSSUFFIX
!T# NAME MUST HAVE PROC SUFFIX APPENDED -
!THIS AUTOMATICALLY DEALS WITH MULTIPLE LOG-ONS TO SAME USER
UNLESS 1 <= LENN <= 11 THEN RESULT = 220
!INVALID FILENAME
!INVALID NAME
! %IF TYPE&2 = 0 %AND OWNER # SSOWNER %THEN %RESULT = 258
!NOT OWN FILE
IF TYPE&1 = 0 AND OWNER = SSOWNER THEN RESULT = 259
!OWN FILE NOT ALLOWED
I = 1
WHILE I < LENN CYCLE ; !LOOK FOR VALID CHAS
I = I+1
CHAR = CHARNO(NAME,I)
UNLESS 'A' <= CHAR <= 'Z' OR '0' <= CHAR <= '9' C
OR (TYPE&4 = 4 AND CHAR = '#') THEN RESULT = 220
!INVALID FILENAME
REPEAT
IF MEMBER # "" START
LENN = LENGTH(MEMBER)
UNLESS 1 <= LENN <= 11 THEN SSFNAME=MEMBER AND RESULT = 270
!INVALID MEMBER
I = 1
WHILE I < LENN CYCLE
I = I+1
CHAR = CHARNO(MEMBER,I)
UNLESS 'A' <= CHAR <= 'Z' OR '0' <= CHAR <= '9' C
THEN SSFNAME=MEMBER AND RESULT = 270
REPEAT
FINISH
CURFOWNER = OWNER
CURFNAME = NAME
CURFILE = OWNER.".".NAME; !RETURN FILE IN STANDARD FORM
CURMEMBER = MEMBER
IF CURFOWNER = SSOWNER THEN CURFSYS = SSOWNFSYS C
ELSE CURFSYS = -1
RESULT = 0
END ; !OF CHECKFILENAME
INTEGERFN HASHFN(STRING (31) FILENAME)
!RETURNS VALUE IN THE RANGE
! 0-MAXCONF FOR FINDING ENTRY IN THE
!CONNECTED FILE TABLE. A
! BETTER ALGORITH COULD BE
! DEVISED.
INTEGER EIGHTH, LASTCHAR
EIGHTH = CHARNO(FILENAME,8); !FIRST CHAR OF FILENAME(AFTER
! USER.)
LASTCHAR = CHARNO(FILENAME,LENGTH(FILENAME))
RESULT = ((EIGHTH&7)!(LASTCHAR<<3))&MAXCONF
END ; !OF HASHFN
INTEGERFN FINDFN(STRING (31) FILE, INTEGERNAME POS)
!LOOK FOR FILE IN CONF. SET
! POS TO POSITION OR TO POSITION
!OF HOLE IF NOT FOUND.
! RESULT=0 IF FOUND
!IF FILENAME IS "EMPTY" THEN
! POSITION CAN BE RE-USED. IT HAS
!TO BE LEFT LIKE THIS TO
! PREVENT A SEARCH CHAIN
! BEING BROKEN
INTEGER EMPTY, STARTPOS
STRING (31) HOLDFILE
EMPTY = -1; !IMPOSSIBLE VALUE
POS = HASHFN(FILE)
STARTPOS = POS
CYCLE
HOLDFILE = CONF(POS)_FILE
IF HOLDFILE = FILE THEN RESULT = 0
IF HOLDFILE = "" START ; !GOT TO END OF CHAIN
IF EMPTY # -1 THEN POS = EMPTY
RESULT = 1; !FILE NOT FOUND - POS POINTS
! TO FREE HOLE
FINISH
IF HOLDFILE = "EMPTY" AND EMPTY = -1 THEN EMPTY = POS
!FIRST EMPTY CELL IN CHAIN
POS = (POS+1)&MAXCONF; !WRAP ROUND AT TOP OF CONF
IF POS = STARTPOS START ; !GONE RIGHT ROUND
IF EMPTY = -1 THEN RESULT = 310; !TOO MANY FILES CONNECTED
POS = EMPTY; !USE FIRST EMPTY HOLE FOUND
RESULT = 1; !FILE NOT CONNECTED
FINISH
REPEAT
END ; !OF FINDFN
ROUTINE CLEARFN(INTEGER POS)
!CLEARS OUT ENTRY POS IN ARRAYCONF. ALSO CLEARS ANY PRECEEDING
! "EMPTY" SLOTS IF THE NEXT ONE IS EMPTY. USED BY DISCONNECT,
!CHANGEFILESIZE AND CHANGEACCESS.
RECORDNAME CUR(CONFF)
CUR == CONF(POS)
CUR = 0
IF CONF((POS+1)&MAXCONF)_FILE = "" START
CYCLE ; !NOW CLEAR ANY REMAINING
! "EMPTY" CELLS
POS = (POS-1)&MAXCONF; !NEXT LOWER - WITH WRAP ROUND
EXIT IF CONF(POS)_FILE # "EMPTY"
CONF(POS) = 0; !NOW SAFE TO CLEAR IT OUT
REPEAT
FINISH ELSE CUR_FILE = "EMPTY"
!TO KEEP CHAIN TOGETHER
END ; !OF CLEARFN
SYSTEMSTRINGFN CONFILE(INTEGER AD)
!RETURNS NAME OF FILE
! CONNECTED AT VIRTUAL
! ADDRESS "AD"
!ELSE NULL STRING
STRING (18) RES
INTEGER P
RECORDNAME CUR(CONFF)
CYCLE P = 0,1,MAXCONF; !CYCLE THROUGH CONNECTED FILE
! TABLE
CUR == CONF(P)
IF CUR_CONAD <= AD < CUR_CONAD+CUR_SIZE START
IF CUR_FILE = "EMPTY" THEN EXIT
RES = CUR_FILE; !THE NAME OF THE CONNECTED FILE
IF LENGTH(RES) > 8 AND FROMSTRING(RES,8,9) = "T#" C
THEN LENGTH(RES) = LENGTH(RES)-1
!TRUNCATE SUFFIX
RESULT = RES
FINISH
REPEAT
RESULT = ""; !NO FILE THERE
END ; !OF CONFILE
SYSTEMROUTINE SETUSE(STRING (31) FILE, INTEGER MODE, VALUE)
!***********************************************************************
!* *
!* This routine is used to modify the USE field in the CONNECT record: *
!* Mode=0 Set use to value *
!* Mode=1 Add 1 to use Mode=-1 Subtract 1 from use *
!* *
!***********************************************************************
RECORDNAME CUR(CONFF)
INTEGER POS, FLAG
FLAG = CHECKFILENAME(FILE,15); !ANY INCLUDING PD MEMBER
-> ERR IF FLAG # 0; !INVALID FILENAME
FLAG = FINDFN(CURFILE,POS)
-> ERR IF FLAG # 0; !NOT CONNECTED
CUR == CONF(POS)
IF MODE = 0 THEN CUR_USE = VALUE AND -> ERR;!USE VALUE PROVIDED
IF MODE = 1 THEN CUR_USE = CUR_USE+1 AND -> ERR
!ADD ONE
IF MODE = -1 AND CUR_USE > 0 THEN CUR_USE = CUR_USE-1
!SUBTRACT ONE
ERR:
END ; !OF SETUSE
SYSTEMROUTINE CONNECT(STRING (31) FILE, C
INTEGER MODE, HOLE, PROT, RECORDNAME R, INTEGERNAME FLAG)
RECORDNAME H(HF); !FILE HEADER
RECORDNAME CUR(CONFF)
RECORD FR(FRF)
RECORDSPEC R(RF)
INTEGER CONSEG, POS
R = 0; !CLEAR OUT RECORD
FLAG = CHECKFILENAME(FILE,15); !ANY FILE NAME INCLUDING PD
! MEMBER
-> ERR IF FLAG # 0
IF CURMEMBER # "" START ; !MEMBER OF PDFILE
IF MODE&1 = 1 THEN FLAG = 271 AND -> ERR
!ATTEMPT TO WRITE TO MEMBER
! OF PDFILE
CONMEMBER(CURFILE,CURMEMBER,PROT,R,FLAG)
-> ERR
FINISH
!LOOK IN TABLE OF CURRENTLY
! CONNECTED FILES
FLAG = FINDFN(CURFILE,POS); !0=FILE ALREADY CONNECTED
-> ERR IF FLAG > 1; !0=CONNECTED,1=NOT CONNECTED, >1 FAILURE
CUR == CONF(POS)
IF PROT&X'80' # 0 THEN CURFSYS = (PROT>>8)&X'FF'
!USER HAS SPECIFIED FILE SYSTEM
IF FLAG # 0 START ; !FILE NOT CONNECTED SO CONNECT IT
FINFO(LAST,0,FR,FLAG); !GET FILEINFO TO GET SIZE
-> ERR IF FLAG # 0; !FINFO FAILS
HOLE = ROUNDUP(HOLE,SEGSIZE)>>SEGSHIFT
!HOLE IN SEGMENTS
CONSEG = 0; !ALLOW DIRECTOR TO CHOOSE HOLE
IF CURFNAME = "T#US".SSSUFFIX THEN MODE = MODE!X'80'
!TEMP
SSINHIBIT = 1; !HOLD OFF INTERRUPTS
FLAG = DCONNECT(CURFOWNER,CURFNAME,CURFSYS,MODE!1,0, C
CONSEG,HOLE)
!ALWAYS INCLUDE READ PROTEM
FLAG = DIRTOSS(FLAG)
IF FLAG # 0 THEN SSFNAME = CURFILE AND -> ERR
CUR = 0
CUR_FILE = CURFILE
CUR_SIZE = FR_SIZE; !PHYSICAL SIZE FROM FINFO RECORD
CUR_CONAD = CONSEG<<SEGSHIFT
!CONNECT ADDRESS
CUR_HOLE = HOLE<<SEGSHIFT
CUR_MODE = MODE!1; !ALWAYS INCLUDE READ
CUR_USE = 0
FINISH ELSE START
!MUST BE CONNECTED ALREADY -
! CHECK MODE AND HOLE
IF 0 # MODE&X'F' # CUR_MODE&X'F' OR HOLE > CUR_HOLE START
!ONLY COMPARE SIGNIF.MODES
DISCONNECT(LAST,FLAG); !NO CHANGE ACCESS AVAILABLE YET
-> ERR IF FLAG # 0
CONNECT(LAST,MODE,HOLE,PROT,R,FLAG)
!RECONNECT
-> ERR
FINISH
FINISH
! MODE AND HOLE OK - NOW MOVE
! INFO FROM CUR INTO RECORD R
R_CONAD = CUR_CONAD; !CONNECT ADDRESS
H == RECORD(CUR_CONAD); !MAP H ONTO FILE HEADER
R_FILETYPE = H_FILETYPE
R_FILETYPE = 3 IF H_FILETYPE = 0
R_DATASTART = H_DATASTART
R_DATAEND = H_DATAEND
CUR_USE = CUR_USE!(PROT&X'7F'); !SIMPLE PROTECTION FACILITY
IF MODE&2 = 2 AND H_DATASTART >= 32 START
!EXPLICIT CONNECT IN WRITE MODE
!AND HEADER AT LEAST 32 BYTES
! LONG
H_DATETIME = PACKDATEANDTIME(STRING(APDATE),STRING( C
APTIME))
FINISH
ERR:
ALLOW INTERRUPTS
END ; !OF CONNECT
SYSTEMROUTINE FINFO(STRING (31) FILE, INTEGER MODE, C
RECORDNAME FR, INTEGERNAME FLAG)
RECORD DF(DFF)
RECORDSPEC FR(FRF)
FLAG = CHECKFILENAME(FILE,7); !ANY FILENAME
-> ERR IF FLAG # 0
FR = 0; !CLEAR WHOLE RECORD
IF MODE = 1 START ; !MUST CONNECT
CONNECT(LAST,0,0,0,FR,FLAG)
!ANY MODE
-> ERR IF FLAG # 0
FINISH
FLAG = DFINFO(CURFOWNER,CURFNAME,CURFSYS,ADDR(DF))
FLAG = DIRTOSS(FLAG)
-> ERR IF FLAG # 0
!FILL IN INFO FROM DFINFO CALL
FR_SIZE = DF_NKB<<KSHIFT; !PHYSICAL SIZE IN BYTES
FR_RUP = DF_RUP; !REQUESTING USERS PERMISSION
FR_EEP = DF_EEP; !EVERYONE ELSE"S PERMISSION
FR_MODE = DF_MODE; !CONNECT MODE
FR_CONAD = DF_CONSEG<<SEGSHIFT
!CONNECT ADDRESS
FR_USERS = DF_USE
FR_ARCH = (DF_ARCH&X'80')!((DF_CODES&X'10')>>4)
!ARCHIVE WORD
!WITH CHERISH BIT IN 2**0
FR_TRAN = DF_TRAN; !ON OFFER TO
ERR:
IF FLAG # 0 THEN SSFNAME = CURFILE
END ; !OF FINFO
SYSTEMROUTINE DISCONNECT(STRING (31) FILE, INTEGERNAME FLAG)
RECORDNAME CUR(CONFF)
INTEGER POS
FLAG = CHECKFILENAME(FILE,7); !ANY FILE
-> ERR IF FLAG # 0
FLAG = FINDFN(CURFILE,POS)
IF FLAG = 0 START ; !FILE IS CONNECTED
CUR == CONF(POS)
IF INTEGER(CUR_CONAD+12) = 2 THEN DIRDISCON = 1
!TO WARN LOADER THAT A DIRECTORY HAS BEEN DISCONNECTED
IF CUR_USE#0 THEN FLAG = 266 AND -> ERR
!NEVER DISCONNECT
SSINHIBIT = 1; !HOLD OFF INTERRUPTS
FLAG = DDISCONNECT(CURFOWNER,CURFNAME,CURFSYS,0)
FLAG = DIRTOSS(FLAG)
CLEARFN(POS); !CLEAR IT OUT OF ARRAY CONF
FINISH ELSE FLAG = 256 AND SSFNAME = CURFILE
!FILE NOT CONNECTED
ERR:
ALLOW INTERRUPTS
END ; !OF DISCONNECT
SYSTEMROUTINE SDISCONNECT(STRING (31) FILE, C
INTEGER FSYS, INTEGERNAME FLAG)
!***********************************************************************
!* *
!* SDISCONNECT provided for JOBBER and JOURNAL allows for *
!* disconnection of a particular file on a particular FSYS. It is *
!* used in conjunction with a facility in CONNECT which allows the *
!* user to specify the FSYS of the file he wishes to connect. *
!* *
!***********************************************************************
FLAG = CHECKFILENAME(FILE,7); !ANY FILE
-> ERR IF FLAG # 0
CURFSYS = FSYS; !USER SUPPLIES FSYS
DISCONNECT(LAST,FLAG); !TO ENSURE USE OF CORRECT CURFSYS
ERR:
END ; !OF SDISCONNECT
SYSTEMROUTINE DESTROY(STRING (31) FILE, INTEGERNAME FLAG)
FLAG = CHECKFILENAME(FILE,5); !ANY OWN FILE
-> ERR IF FLAG # 0
DISCONNECT(LAST,FLAG); !IGNORE FLAG AT PRESENT
FLAG = DDESTROY(CURFOWNER,CURFNAME,"",CURFSYS,0)
FLAG = DIRTOSS(FLAG)
ERR:
IF FLAG # 0 THEN SSFNAME = CURFILE
END ; !OF DESTROY
! %SYSTEMROUTINE RENAME(%STRING (31) FILE, NEWFILE, %C
! %INTEGERNAME FLAG)
! %STRING (11) NEWNAME
! FLAG = CHECKFILENAME(NEWFILE,5)
! !CHECK NEWNAME FIRST
! -> ERR %IF FLAG # 0
! NEWNAME = CURFNAME; !HOLD NEWNAME
! FLAG = CHECKFILENAME(FILE,5); !NOW CHECK OLD NAME
! -> ERR %IF FLAG # 0
! DISCONNECT(LAST,FLAG); !IGNORE FLAG PROTEM
! FLAG = DRENAME(CURFOWNER,CURFNAME,NEWNAME,CURFSYS)
! FLAG = DIRTOSS(FLAG)
! ERR:
!
! %END; !OF RENAME
!
! %SYSTEMROUTINE NEWGEN(%STRING (31) FILE, NEWFILE, %C
! %INTEGERNAME FLAG)
! %STRING (11) NEWNAME
! FLAG = CHECKFILENAME(NEWFILE,5)
! !CHECK NEWNAME FIRST
! -> ERR %IF FLAG # 0
! DISCONNECT(LAST,FLAG); !TRY AND DISCONNECT - IGNORE FLAG
! NEWNAME = CURFNAME; !HOLD NEWNAME
! FLAG = CHECKFILENAME(FILE,5)
! -> ERR %IF FLAG # 0
! DISCONNECT(LAST,FLAG); !MUST DISCONNECT IF CONNECTED
! -> ERR %UNLESS FLAG = 0 %OR FLAG = 256
! !OK OR NOT CONNECTED
! FLAG = DNEWGEN(CURFOWNER,NEWNAME,CURFNAME,CURFSYS)
! FLAG = DIRTOSS(FLAG)
! ERR:
!
! %END; !OF NEWGEN
!
! %SYSTEMROUTINE OFFER(%STRING (31) FILE, %C
! %STRING (6) TO, %INTEGERNAME FLAG)
! FLAG = CHECKFILENAME(FILE,5)
! -> ERR %IF FLAG # 0
! DISCONNECT(LAST,FLAG); !IGNORE FLAG
! FLAG = DOFFER(CURFOWNER,TO,CURFNAME,CURFSYS)
! FLAG = DIRTOSS(FLAG)
! ERR:
!
! %END; !OF OFFER
!
! %SYSTEMROUTINE ACCEPT(%STRING (31) FILE, NEWNAME, %C
! %INTEGERNAME FLAG)
! %STRING (6) OWNER
! %STRING (11) NAME
! %INTEGER FSYS
! FLAG = CHECKFILENAME(FILE,6); !ANY NAME EXCEPT OWN
! -> ERR %IF FLAG # 0
! OWNER = CURFOWNER
! NAME = CURFNAME; !HOLD FOR USE IN CALL OF DACCEPT
! FSYS = CURFSYS
! %IF NEWNAME # "" %START; !NEW NAME TO BE GIVEN TO FILE
! FLAG = CHECKFILENAME(NEWNAME,5)
! !ANY OWN FILE
! -> ERR %IF FLAG # 0
! %FINISH
! NEWNAME = CURFNAME; !PROTEM - DEFAULT VALUE OF
! ! NEWNAME IS SAME AS ORIGINAL
! ! CURFNAME
! FLAG = DACCEPT(OWNER,NAME,NEWNAME,FSYS)
! FLAG = DIRTOSS(FLAG)
! ERR:
!
! %END; !OF ACCEPT
SYSTEMROUTINE FSTATUS(STRING (31)FILE, INTEGER ACT, VALUE C
INTEGERNAME FLAG)
FLAG = CHECKFILENAME(FILE,5); !ANY OWN FILE
-> ERR IF FLAG # 0
FLAG = DFSTATUS(SSOWNER,CURFNAME,SSOWNFSYS,ACT,VALUE)
FLAG = DIRTOSS(FLAG)
ERR:
IF FLAG#0 THEN SSFNAME=FILE
END ; !OF FSTATUS
SYSTEMROUTINE PERMIT(STRING (31) FILE, C
STRING (6) USER, INTEGER MODE, INTEGERNAME FLAG)
INTEGER TYPE
IF FILE # "" START ; !PERMIT 1 FILE
FLAG = CHECKFILENAME(FILE,5)
!ANY OWN FILE
-> ERR IF FLAG # 0
FILE = CURFNAME; !FILE USED IN CALL OF DPERMISSION
IF USER = SSOWNER THEN TYPE = 0 AND -> TYPESET
!SET OWNP
IF USER = "" THEN TYPE = 1 AND -> TYPESET
!SET EEP
IF MODE >= 0 THEN TYPE = 2 AND -> TYPESET
!ADD USER TO LIST
TYPE = 3; !REMOVE USER FROM LIST
TYPESET:
FINISH ELSE START ; !WHOLE INDEX PERMISSION
IF MODE >= 0 THEN TYPE = 6 ELSE TYPE = 7
!ADD OR REMOVE PERMISSION
FINISH
FLAG = DPERMISSION(SSOWNER,USER,"",FILE,SSOWNFSYS,TYPE,MODE)
FLAG = DIRTOSS(FLAG)
ERR:
END
! SET OWNP
SYSTEMROUTINE CHANGEACCESS(STRING (31) FILE, C
INTEGER MODE, INTEGERNAME FLAG)
INTEGER CURMODE, POS, GAP, CONSEG, I
RECORDNAME CUR(CONFF)
FLAG = CHECKFILENAME(FILE,7); !ANY FILE
-> ERR IF FLAG # 0
FLAG = FINDFN(CURFILE,POS); !FIND IT IN CONNECTED FILE TABLE
IF FLAG # 0 THEN FLAG = 256 AND -> ERR;!NOT CONNECTED
CUR == CONF(POS)
CURMODE = CUR_MODE
CONSEG = CUR_CONAD>>SEGSHIFT; !CURRENT CONNECT SEGMENT
GAP = CUR_HOLE>>SEGSHIFT; !CURRENT CONNECT HOLE
IF CURMODE&X'F' = MODE&X'F' THEN -> ERR;!CURRENT MODE OK
SSINHIBIT = 1; !HOLD OFF INTERRUPTS
FLAG = DDISCONNECT(CURFOWNER,CURFNAME,CURFSYS,0)
-> ERR IF FLAG # 0
FLAG = DCONNECT(CURFOWNER,CURFNAME,CURFSYS,MODE,0,CONSEG, C
GAP)
FLAG = DIRTOSS(FLAG)
!IF NOT OK THEN RE-CONNECT WITH ORIGINAL MODE
IF FLAG # 0 START
I = DCONNECT(CURFOWNER,CURFNAME,CURFSYS,CURMODE&X'F',0, C
CONSEG,GAP)
IF FLAG # 0 THEN CLEARFN(POS); !CORRECT TABLE IF UNABLE TO RE-CONNECT
-> ERR
FINISH
CUR_MODE = MODE
ERR:
ALLOW INTERRUPTS
END ; !OF CHANGEACCESS
SYSTEMROUTINE CHANGEFILESIZE(STRING (31)FILE, INTEGER NEWSIZE, C
INTEGERNAME FLAG)
INTEGER NEWKSIZE, POS, HOLDFLAG, GAP, CONSEG
RECORDNAME CUR(CONFF)
RECORD FR(FRF)
NEWSIZE = ROUNDUP(NEWSIZE,FILESIZEALLOC)
NEWKSIZE = NEWSIZE>>KSHIFT; !NUMBER OF KBYTES TO ALTER
!NEW SIZE IN KB
FLAG = CHECKFILENAME(FILE,5); !ANY OWN FILE
-> ERR IF FLAG # 0
FINFO(LAST,0,FR,FLAG)
-> ERR IF FLAG # 0
IF NEWKSIZE = FR_SIZE>>KSHIFT THEN -> ERR
!SIZE OK - RETURN
IF FR_CONAD = 0 START ; !NOT CONNECTED
FLAG = DCHSIZE(CURFOWNER,CURFNAME,CURFSYS,NEWKSIZE)
FLAG = DIRTOSS(FLAG)
-> ERR
FINISH
!FILE MUST BE CONNECTED -
! HAVE TO DO TEMPORARY DISCONNECT
FLAG = FINDFN(CURFILE,POS); !FIND POS IN TABLE
CUR == CONF(POS)
IF NEWSIZE > CUR_HOLE THEN FLAG = 261 AND -> ERR
!HOLE TOO SMALL
SSINHIBIT = 1; !HOLD OFF INTERRUPTS
FLAG = DDISCONNECT(CURFOWNER,CURFNAME,CURFSYS,0)
!CANNOT USE DISCONNECT -
! MIGHT BE PREVENTED
-> ERR IF FLAG # 0
FLAG = DCHSIZE(CURFOWNER,CURFNAME,CURFSYS,NEWKSIZE)
HOLDFLAG = DIRTOSS(FLAG); !NEEDED LATER
CONSEG = CUR_CONAD>>SEGSHIFT
GAP = CUR_HOLE>>SEGSHIFT
FLAG = DCONNECT(CURFOWNER,CURFNAME,CURFSYS,CUR_MODE&X'F',0, C
CONSEG,GAP)
!OR OUT NEW-COPY IF PRESENT
IF FLAG # 0 THEN CLEARFN(POS); !CORRECT TABLE IF UNABLE TO RE-CONNECT
FLAG = DIRTOSS(FLAG)
-> ERR IF FLAG # 0; !CANNOT RE-CONNECT
CUR_SIZE = NEWSIZE
FLAG = HOLDFLAG
-> ERR IF FLAG # 0
ERR:
ALLOW INTERRUPTS
END ; !OF CHANGEFILESIZE
SYSTEMROUTINE TRIM(STRING (31) FILE, INTEGERNAME FLAG)
RECORD RR(RF)
INTEGER SIZE
CONNECT(FILE,3,0,0,RR,FLAG)
-> ERR IF FLAG # 0
SIZE = RR_DATAEND
CHANGEFILESIZE(FILE,SIZE,FLAG)
-> ERR IF FLAG # 0
IF INTEGER(RR_CONAD+12) <= 16 C
THEN INTEGER(RR_CONAD+8) = ROUNDUP(SIZE,FILESIZEALLOC)
!DONT ALTER 3RD WORD OF
! OBJECT FILES PROTEM
ERR:
END ; !OF TRIM
SYSTEMROUTINE OUTFILE(STRING (31) FILE, INTEGER FILESIZE, HOLE, C
PROT, INTEGERNAME CONAD, FLAG)
!APPROPRIATE SIZE AND
! CONNECTS IT IN WRITE MODE.
RECORD FR(FRF)
RECORDNAME H(HF)
RECORD R(RF)
INTEGER POS, CURSIZE, PSIZE, TYPE, ATLEAST
RECORDNAME CUR(CONFF)
STRING (11) REST
IF FILESIZE < 0 THEN FILESIZE = -FILESIZE C
AND ATLEAST = 1 ELSE ATLEAST = 0
!NEGATIVE SIZE MEANS CREATE AT LEAST THIS SIZE
!TREAT NEG SIZE AS POS.
FLAG = CHECKFILENAME(FILE,5); !OWN FILE ANY NAME
-> ERR IF FLAG # 0
UNLESS 'A'<=CHARNO(CURFNAME,1)<='Z'C
THEN FLAG=220 AND ->ERR
!INVALID NEW FILENAME
PSIZE = ROUNDUP(FILESIZE,FILESIZEALLOC)
!PHYSICAL SIZE
IF PROT&TEMPMARKER # 0 OR CURFNAME -> ("T#").REST C
THEN TYPE = 1 ELSE TYPE = 0
!TYPE=1 IS TEMP FILE
FLAG = FINDFN(CURFILE,POS)
CUR == CONF(POS)
IF FLAG = 0 THEN CURSIZE = CUR_SIZE ELSE START
FINFO(LAST,0,FR,FLAG); !SEE IF IT EXISTS
IF FLAG = 0 THEN CURSIZE = FR_SIZE
!IT DOES
FINISH
IF FLAG = 0 START
IF CURSIZE # PSIZE THEN START
!WRONG SIZE
IF CURSIZE < PSIZE OR (TYPE = 0 = ATLEAST) START
!MUST CHANGE SIZE BECAUSE EITHER
!TOO SMALL OR (PERMANENT FILE AND PRECISE SIZE REQUESTED)
CHANGEFILESIZE(LAST,PSIZE,FLAG)
!CHANGE SIZE IF NEC
IF FLAG = 261 START ; !VM HOLE TOO SMALL
DISCONNECT(LAST,FLAG)
!MUST DISCONNECT IT
-> ERR IF FLAG # 0
CHANGEFILESIZE(LAST,PSIZE,FLAG)
!TRY AGAIN
FINISH
-> ERR IF FLAG # 0
FINISH
FINISH
FINISH ELSE START ; !DOES NOT EXIST SO CREATE IT
FLAG = DCREATE(CURFOWNER,CURFNAME,CURFSYS,PSIZE>>KSHIFT, C
TYPE)
FLAG = DIRTOSS(FLAG)
-> ERR IF FLAG # 0
! *** INSERT BEGINS
! %IF CURFOWNER#SSOWNER %START
! FLAG=DPERMISSION(CURFOWNER,SSOWNER,"",CURFNAME,CURFSYS,1,3)
! FLAG=DIRTOSS(FLAG)
! ->ERR %IF FLAG#0
! %FINISH
! *** INSERT ENDS
FINISH
CONNECT(LAST,19,HOLE,PROT,R,FLAG)
!READ-WRITE-NEWCOPY
!MUST BE RIGHT ONE
-> ERR IF FLAG # 0
CONAD = R_CONAD
H == RECORD(CONAD)
H = 0; !CLEAR IT OUT
H_DATAEND = 32; !DEFAULT
H_DATASTART = 32
H_FILESIZE = PSIZE
H_DATETIME = PACKDATEANDTIME(STRING(APDATE),STRING(APTIME))
ERR:
END ; !OF OUTFILE
SYSTEMROUTINE MODPDFILE(INTEGER EP, C
STRING (31) PDFILE, STRING (11) MEMBER, C
STRING (31) INFILE, INTEGERNAME FLAG)
!THIS ROUTINE PROVIDES
! SERVICES FOR MODIFYING PD FILES
! EP=1 INSERT
! EP=2 REMOVE
! EP=3 RENAME
! EP=4 CREATE PDFILE
INTEGER I, FILELENGTH, BASE, NEWSIZE, ADIR, OLDSIZE, OLDLENGTH
INTEGER LEN, NEWSTART, NEWLENGTH
STRING (6) OWNER
SWITCH SW(1 : 4)
RECORD PDR, FR(RF)
RECORDNAME PD(PDF)
RECORDNAME PDH(PDHF)
ROUTINE BMOVE(INTEGER LENGTH, FROM, TO)
INTEGER I
RETURN IF LENGTH <= 0
IF FROM > TO OR FROM+LENGTH <= TO START
!SAFE TO USE NORMAL MOVE - NO
! OVERLAP
MOVE(LENGTH,FROM,TO)
FINISH ELSE START ; !FIELDS OVERLAP
CYCLE I = LENGTH-1,-1,0
BYTEINTEGER(TO+I) = BYTEINTEGER(FROM+I)
REPEAT
FINISH
END ; !OF BMOVE
INTEGERFN CHECKMEMBERNAME(STRING (11) S)
!CHECKS THAT MEMBER HAS
! STANDARD NAME
INTEGER I
SSFNAME = S; !FOR FAILURE MESSAGE
RESULT = 270 UNLESS 1 <= LENGTH(S) <= 11 C
AND 'A' <= CHARNO(S,1) <= 'Z'
I = 1
WHILE I < LENGTH(S) CYCLE
I = I+1
RESULT = 270 UNLESS 'A' <= CHARNO(S,I) <= 'Z' C
OR '0' <= CHARNO(S,I) <= '9'
REPEAT
RESULT = 0; !O.K.
END ; !OF CHECKMEMBERNAME
BASE = 0
UNLESS 1 <= EP <= 4 THEN FLAG = -1 AND -> ERR
IF EP <= 3 START
!NOW CONNECT PD FILE IN WRITE
! MODE
IF PDFILE -> OWNER.(".").PDFILE AND OWNER # SSOWNER START
FLAG = 258; !ILLEGAL USE OF ANOTHER"S FILE
-> ERR
FINISH
CONNECT(PDFILE,3,0,0,PDR,FLAG)
-> ERR IF FLAG # 0
IF PDR_FILETYPE # SSPDFILETYPE C
THEN FLAG = 286 AND -> ERR
!NOT A PD FILE
BASE = PDR_CONAD
PDH == RECORD(BASE)
ADIR = PDH_ADIR+BASE; !ABS ADDR OF DIRECTORY
FINISH
-> SW(EP)
SW(1): !INSERT FILE
FLAG = CHECKMEMBERNAME(MEMBER)
-> ERR IF FLAG # 0
CONNECT(INFILE,0,0,0,FR,FLAG)
!CONNECT FILE TO BE INSERTED
IF FLAG # 0 THEN -> ERR
FILELENGTH = (FR_DATAEND+7)&X'FFFFF8'
!DW ALIGN
IF FILELENGTH < 16 THEN FILELENGTH = 16
!MINIMUM LENGTH
!CHECK THAT MEMBER NOT
! ALREADY THERE
I = 0
WHILE I < PDH_COUNT CYCLE
PD == RECORD(ADIR+I*32)
IF PD_NAME = MEMBER THEN FLAG = 287 AND -> ERR
!ALREADY THERE
I = I+1
REPEAT
OLDLENGTH = PDR_DATAEND
OLDSIZE = ROUNDUP(OLDLENGTH,FILESIZEALLOC)
NEWLENGTH = OLDLENGTH+FILELENGTH+32
!ALLOW FOR NEW FILE AND DIR ENTRY
IF NEWLENGTH > OLDSIZE START ; !GREATER THAN PHYSICAL SIZE
CONNECT(PDFILE,3,NEWLENGTH,0,PDR,FLAG)
!RE-CONNECT - IN CASE NEEDS
!MORE ROOM
-> ERR IF FLAG # 0
CHANGEFILESIZE(PDFILE,NEWLENGTH,FLAG)
-> ERR IF FLAG # 0
NEWSIZE = ROUNDUP(NEWLENGTH,FILESIZEALLOC)
!NEW PHYSICAL SIZE
BASE = PDR_CONAD
PDH == RECORD(BASE); !RE-MAP - MIGHT HAVE MOVED
PDH_SIZE = NEWSIZE; !NEW PHYSICAL SIZE
ADIR = PDH_ADIR+BASE
FINISH
SSINHIBIT = 1
PDH_DATAEND = NEWLENGTH
BMOVE(32*PDH_COUNT,ADIR,ADIR+FILELENGTH)
!NOT SAFE TO USE MOVE- MIGHT
! OVERLAP
NEWSTART = ADIR; !FILE GOES TO EXISTING START
! OF DIRECTORY
PDH_ADIR = PDH_ADIR+FILELENGTH
ADIR = PDH_ADIR+BASE
MOVE(FILELENGTH,FR_CONAD,NEWSTART)
!MOVE IN FILE
PD == RECORD(ADIR+32*PDH_COUNT)
!NEW DIRECTORY RECORD
PD = 0; !CLEAR IT
PD_NAME = MEMBER
PD_START = NEWSTART-BASE; !OFFSET OF START
PDH_COUNT = PDH_COUNT+1; !INCREMENT COUNTER
-> ERR
SW(2): !DELETE MEMBER
I = 0
SSINHIBIT = 1
WHILE I < PDH_COUNT CYCLE
PD == RECORD(ADIR+I*32)
IF PD_NAME = MEMBER THEN -> MEMBER FOUND
I = I+1
REPEAT
SSFNAME = MEMBER
FLAG = 288; !MEMBER NOT FOUND
-> ERR
MEMBER FOUND:
FILELENGTH = (INTEGER(BASE+PD_START)+7)&X'FFFFF8'
IF FILELENGTH < 16 THEN FILELENGTH = 16
!DW ROUND
I = I+1
WHILE I < PDH_COUNT CYCLE
PD == RECORD(ADIR+I*32)
LEN = (INTEGER(BASE+PD_START)+7)&X'FFFFF8'
IF LEN < 16 THEN LEN = 16; !MINIMUM LENGTH OF FILE
MOVE(LEN,BASE+PD_START,BASE+PD_START-FILELENGTH)
PD_START = PD_START-FILELENGTH
MOVE(32,ADIR+I*32,ADIR+(I-1)*32)
!MOVE RECORD DOWN A PLACE
I = I+1
REPEAT
PDH_COUNT = PDH_COUNT-1
MOVE(32*PDH_COUNT,ADIR,ADIR-FILELENGTH)
!MOVE DIR BACK
PDH_ADIR = PDH_ADIR-FILELENGTH
PDH_DATAEND = PDH_DATAEND-(FILELENGTH+32)
TRIM(PDFILE,FLAG)
-> ERR
SW(3): !RENAME (MEMBER,FILE)
FLAG = CHECKMEMBERNAME(INFILE)
-> ERR IF FLAG # 0
I = 0
WHILE I < PDH_COUNT CYCLE
PD == RECORD(ADIR+I*32)
IF PD_NAME = INFILE THEN FLAG = 90 AND -> ERR
I = I+1
REPEAT
I = 0
WHILE I < PDH_COUNT CYCLE
PD == RECORD(ADIR+I*32)
IF PD_NAME = MEMBER THEN PD_NAME = INFILE AND -> ERR
I = I+1
REPEAT
SSFNAME = MEMBER
FLAG = 288; !MEMBER NOT FOUND
-> ERR
SW(4): !CREATE EMPTY PDFILE
OUTFILE(PDFILE,4096,4096,0,BASE,FLAG)
-> ERR IF FLAG # 0
PDH == RECORD(BASE)
PDH_FILETYPE = 6; !TYPE=PARTITIONED
PDH_ADIR = 32; !START OF DIRECTORY
PDH_COUNT = 0; !NO MEMBERS
-> ERR
ERR:
ALLOW INTERRUPTS
END ; !OF MODPDFILE
ROUTINE CONMEMBER(STRING (31) FILE, C
STRING (11) MEMBER, INTEGER PROTECTION, C
RECORDNAME R, INTEGERNAME FLAG)
!***********************************************************************
!* *
!* THIS ROUTINE IS USED TO CONNECT A MEMBER OF A PARTITIONED FILE *
!* AND RETURNS IN RECORD R THE DETAILS OF THE MEMBER. NOTE THAT *
!* ONLY THE FOLLOWING FIELDS REFER TO THE MEMBER ITSELF - CONAD, *
!* SIZE, FILETYPE, DATASTART, DATAEND. ALL THE OTHER FIELDS REFER *
!* TO THE PD FILE. *
!* *
!***********************************************************************
INTEGER I, P
RECORDSPEC R(RF)
RECORDNAME PDH(PDHF)
RECORDNAME PD(PDF)
CONNECT(FILE,0,0,PROTECTION,R,FLAG); !CONNECT WITH NO PROTECTION
-> ERR IF FLAG # 0
IF R_FILETYPE # SSPDFILETYPE THEN FLAG = 286 AND -> ERR
!NOT A PD FILE
PDH == RECORD(R_CONAD)
!NOW LOOK FOR REQUIRED MEMBER
I = 0
P = PDH_ADIR+R_CONAD; !START OF DIRECTORY
WHILE I < PDH_COUNT CYCLE
PD == RECORD(P+I*32)
IF PD_NAME = MEMBER THEN -> MEMBER FOUND
I = I+1
REPEAT
SSFNAME = MEMBER
FLAG = 288; !MEMBER NOT FOUND
-> ERR
MEMBER FOUND:
R_CONAD = R_CONAD+PD_START; !ABS ADDR OF MEMBER
R_DATASTART = INTEGER(R_CONAD+4)
R_DATAEND = INTEGER(R_CONAD)
R_FILETYPE = INTEGER(R_CONAD+12)
!TYPE
IF R_FILETYPE = 0 THEN R_FILETYPE = 3
ERR:
END ; !OF CONMEMBER
ROUTINE FILLSYSTEMCALLS(INTEGER SCTABLE, COUNT)
!***********************************************************************
!* *
!*THIS VERSION CHANGED 17.8.78 FOR NEW FORMAT OBJECT FILES *
!* THIS ROUTINE FILLS IN THE SYSTEM CALL DESCRIPTORS IN THE BGLA *
!* USING INFORMATION IN A TABLE AT SCTABLE. THE INFORMATION *
!* CONSISTS OF AN I AND J VALUE FOR EACH OF THE DIRECTOR ROUTINES *
!* WHICH CAN BE ACCESSED BY SYSTEM CALL. *
!* *
!***********************************************************************
RECORDFORMAT TABF(STRING (31) NAME, INTEGER I, J)
RECORDARRAYFORMAT TABLEF(1 : COUNT)(TABF)
RECORDARRAYNAME TABLE(TABF)
RECORDFORMAT EPREFF(INTEGER LINK, REFLOC, STRING (31) IDEN)
RECORDNAME EPREF(EPREFF)
INTEGER LD, LOC, LINK, P, ABGLA
ABGLA = ABASEFILE+((INTEGER(ABASEFILE)+X'3FFFF')& C
X'FFFC0000')
!BASEGLA STARTS AT FIRST FREE SEG BEYOND BASEFILE
TABLE == ARRAY(SCTABLE,TABLEF); !MAP ARRAY TABLE ONTO THE TABLE
LD = ABASEFILE+INTEGER(ABASEFILE+24);!START OF BASE LOAD DATA
LINK = INTEGER(LD+28); !TOP OF EPREF LIST
WHILE LINK # 0 CYCLE
EPREF == RECORD(LINK+ABASEFILE); !MAP EACH REF ONTO EPREF
CYCLE P = 1,1,COUNT; !LOOK THROUGH SCTABLE
IF TABLE(P)_NAME = EPREF_IDEN START
LOC = (EPREF_REFLOC&X'FFFFFF')+ABGLA; !ASSUME IN GLA (NOT PLT)
INTEGER(LOC) = X'E3000000'!TABLE(P)_I
!SYS CALL DESCRIPTOR
INTEGER(LOC+4) = TABLE(P)_J
!SECOND WORD
EXIT
FINISH
REPEAT
LINK = EPREF_LINK
REPEAT
END ; !OF FIL SYSTEM CALLS
SYSTEMROUTINE SSINIT(INTEGER MARK, ADIRINF)
!THIS IS THE INITIALISATION
! ROUTINE FOR THE SUBSYSTEM.
! IT IS ENTERED
!ONCE FROM SSLDR AT THE START
! OF A SESSION
INTEGER FLAG, I, POS, BASEHOLE, BGLALEN, AOFM
RECORDNAME DIRINF(DIRINFF)
RECORDNAME CUR(CONFF)
ROUTINE CALL CONTROL
INTEGER LNB
*STLN_LNB; !PUT LNB FOR THIS ROUTINE INTO I
SSCOMREG(36) = LNB; !AND STORE IN COMREG 36
CONTROL; !CALL SS CODE
!IF FAILURE THEN EFFECTIVELY
! RETURN FROM THIS ROUTINE
END ; !OF CALL CONTROL
DIRINF == RECORD(ADIRINF); !DIRECTOR INFO RECORD
BASEHOLE = ROUNDUP(INTEGER(ABASEFILE),SEGSIZE)
!HOLE FOR BASEFILE
AOFM = ABASEFILE+INTEGER(ABASEFILE+28); !ADDRESS OF OBJECT FILE MAP
BGLALEN = INTEGER(AOFM+20)+INTEGER(AOFM+56); !LENGTH OF AREA 2(GLA)+LENGTH OF AREA 5(UST)
ABGLA = ABASEFILE+BASEHOLE; !BGLA STARTS AT NEXT SEGMENT
SSCOMREG(35) = ABGLA; !ADDRESS OF BGLA
SSOWNER = DIRINF_USER; !EXTRACT INFO FROM DIRINF
SSOWNFSYS = DIRINF_FSYS
SSREASON = DIRINF_REASON
SSOPERNO = DIRINF_OPERNO
AIOSTAT = DIRINF_AIOSTAT
SSSUFFIX = TOSTRING(DIRINF_ISUFF)
!CHAR TO BE ADDED TO END OF
! TEMP FILENAMES
SSSCTABLE = DIRINF_SCIDENSAD
SSSCCOUNT = DIRINF_SCIDENS
SSADIRINF = ADIRINF
IF DIRINF_SCDATE # SSDATELINKED C
THEN FILLSYSTEMCALLS(SSSCTABLE,SSSCCOUNT)
!ONLY NEED TO FILL IF RUNNING ON DIFFERENT DIRECTOR
FLAG = DSFI(SSOWNER,SSOWNFSYS,0,0,ADDR(BASEFILE))
!GET NAME OF BASEFILE
IF BASEFILE = "" THEN BASEFILE = "#SUBSYS"
!DEFAULT NAME
FLAG = DSFI(SSOWNER,SSOWNFSYS,12,0,ADDR(SSMAXFSIZE))
SSMAXFSIZE = SSMAXFSIZE<<10; !MAXIMUM FILE SIZE IN BYTES
FLAG = FINDFN(BASEFILE,POS)
CUR == CONF(POS)
CUR_FILE = BASEFILE; !PUT NAME IN TABLE
CUR_SIZE = ROUNDUP(INTEGER(ABASEFILE),FILESIZEALLOC)
CUR_CONAD = ABASEFILE; !ADDRESS OF BASEFILE
CUR_HOLE = BASEHOLE
CUR_USE = 8; !NEVER DISCONNECT
!PUT SS#BGLA INTO CONF TABLE
FLAG = FINDFN(SSOWNER.".T#BGLA",POS)
CUR == CONF(POS)
CUR_FILE = SSOWNER.".T#BGLA"
CUR_CONAD = ABGLA
CUR_HOLE = SEGSIZE
CUR_SIZE = SEGSIZE
CUR_USE = 8; !NEVER DISCONNECT
SSASESSDIR = ABASEFILE+INTEGER(ABASEFILE)-SSTEMPDIRSIZE
SSADEFOPT=SSASESSDIR-OPTFILESIZE; !ADDRESS OF DEFAULT OPTION FILE
SSATEMPDIR = ABGLA+BGLALEN; !ADDR OF SESSION DIRECTORY
SSCURBGLA = SSATEMPDIR+SSTEMPDIRSIZE
SSMAXBGLA = ABGLA+SEGSIZE-1; !LAST BYTE IN BGLA
SSCOMREG(11) = INTEGER(ATRANS)+256; !ADDRESS OF ETOI TABLE
ASSCOM=ADDR(SSCOMREG(0)) ;! LET JOBBER SEE COMREGS
SSCOMREG(12) = INTEGER(ATRANS); !ADDRESS OF ITOE TABLE
I = DSETIC(4000000); !LARGE DEFAULT TIME LIMIT
CALL CONTROL; !THIS IS SUBSYSTEM
DSTOP(104); !IN CASE WE GET BACK HERE
END ; !OF SSINIT
SYSTEMROUTINE SETWORK(INTEGERNAME AD, FLAG)
!ON ENTRY AD CONTAINS LENGTH REQUIRED
INTEGER CONAD
! ADDRESS IN AD
OWNINTEGER CURLENGTH
IF AD < SSINITWORKSIZE THEN AD = SSINITWORKSIZE
!MINIMUM SIZE
IF AD > SSMAXWORKSIZE THEN AD = SSMAXWORKSIZE
!MAX SIZE
IF AD <= CURLENGTH START
AD = SSCOMREG(14)
INTEGER(AD) = 32; !FILL IN HEADER AGAIN LEST IT HAS BEEN CORRUPTED
INTEGER(AD+4) = 32
INTEGER(AD+8) = CURLENGTH
INTEGER(AD+12) = 0
FLAG = 0
FINISH ELSE START
OUTFILE("T#WRK",AD,X'100000',TEMPMARKER,CONAD,FLAG)
!UNIQUE NAME FOR THIS PROCESS
IF FLAG = 0 START
SSCOMREG(14) = CONAD
CURLENGTH = AD
AD = CONAD
FINISH
FINISH
END ; !OF SETWORK
SYSTEMLONGREALFN CPUTIME
INTEGER RES, FLAG
FLAG = DSFI(SSOWNER,SSOWNFSYS,21,0,ADDR(RES))
RESULT = RES/KIPS; !TIME IN SECONDS
END ; !OF CPUTIME
EXTERNALINTEGERFN PAGETURNS
INTEGER FLAG
INTEGERARRAY HOLD(1 : 8)
FLAG = DSFI(SSOWNER,SSOWNFSYS,24,0,ADDR(HOLD(1)))
!PAGETURNS THIS SESSION
RESULT = HOLD(1)
END ; !OF PAGETURNS
SYSTEMINTEGERMAP COMREG(INTEGER I)
RESULT == SSCOMREG(I)
END ; !OF COMREG
EXTERNALSTRINGFN DATE
RESULT = STRING(APDATE)
END ; !OF DATE
EXTERNALSTRINGFN TIME
RESULT = STRING(APTIME)
END ; !OF TIME
SYSTEMSTRINGFN NEXTTEMP
OWNINTEGER SEQ
SEQ = SEQ+1
RESULT = TOSTRING(HEX((SEQ>>8)&X'F')).TOSTRING(HEX((SEQ>>4)& C
X'F')).TOSTRING(HEX(SEQ&X'F'))
END ; !OF NEXTTEMP
SYSTEMROUTINE SENDFILE(STRING (31) FILE, C
STRING (8) DEVICE, INTEGER COPIES, FORMS, C
INTEGERNAME FLAG)
STRING (8) HOLD DEVICE
CONSTBYTEINTEGERARRAY PARITY(0 : 127) = C
0,129,130,3,132,5,6,135,136,9,10,139,12,141,142,15,
144,17,18,147,20,149,150,23,24,153,154,27,156,29,30,159,
160,33,34,163,36,165,166,39,40,169,170,43,172,45,46,175,
48,177,178,51,180,53,54,183,184,57,58,187,60,189,190,63,
192,65,66,195,68,197,198,71,72,201,202,75,204,77,78,207,
80,209,210,83,212,85,86,215,216,89,90,219,92,221,222,95,
96,225,226,99,228,101,102,231,232,105,106,235,108,237,238,111,
240,113,114,243,116,245,246,119,120,249,250,123,252,125,126,255
RECORD RR(RF)
INTEGER I, LEN, DATALENGTH
STRING (4) DEPT
STRING (255) MESSAGE
IF BENCHMARK # 0 START ; !BENCHMARK JOB - DELETE FILE
DESTROY(FILE,FLAG)
FLAG = 0
-> ERR
FINISH
HOLDDEVICE = DEVICE
IF DEVICE -> (".").DEVICE THEN START
FINISH
FLAG = CHECKFILENAME(FILE,5); !ANY OWN FILE
-> ERR IF FLAG # 0
CONNECT(LAST,0,0,0,RR,FLAG); !TO GET LENGTH
-> ERR IF FLAG # 0
DATALENGTH = RR_DATAEND-RR_DATASTART
IF DATALENGTH <= 0 THEN DESTROY(FILE,FLAG) AND -> ERR
!EMPTY FILE
DISCONNECT(LAST,FLAG)
-> ERR IF FLAG # 0
IF DEVICE = "SGP" THEN DEVICE = "GP" AND FORMS = 1
MESSAGE = "DOCUMENT SRCE=".CURFNAME.",DEST=".DEVICE. C
",START=".ITOS(RR_DATASTART).",LENGTH=".ITOS(DATALENGTH)
IF FORMS # 0 THEN MESSAGE = MESSAGE.",FORMS=".ITOS(FORMS)
IF COPIES # 0 THEN MESSAGE = MESSAGE.",COPIES=".ITOS( C
COPIES)
LEN = LENGTH(MESSAGE)
IF INHIBITSPOOLER = 0 START
FLAG = DMESSAGE(SPOOLERNAME,LEN,1,-1,ADDR(MESSAGE)+1)
FINISH ELSE START
PRINTSTRING(MESSAGE)
FLAG = 1001
FINISH
IF FLAG # 0 START
IF FLAG = 202 THEN FLAG = 264 C
AND SSFNAME = HOLDDEVICE ELSE FLAG = DIRTOSS(FLAG)
!**PROTEM CONVERT INVALID DEVICE CODE - OTHERWISE DIRECTOR FAULT
!THE PREVIOUS LINE SHOULD BE ALTERED TO ACCOMODATE OTHER SPOOLR FAULTS
FINISH
ERR:
END ; !OF SENDFILE
ENDOFFILE