!TITLE Manipulating User records and Indexes !<DACCEPT ! %externalintegerfn DACCEPT(%string(31)FILE INDEX, FILE, NEWNAME, ! %integer FSYS) ! ! This procedure causes the transfer to the caller's main file index of ! file FILE belonging to file index FILE INDEX on disc-pack FSYS. The ! file must previously have been "offered to" the caller of this ! procedure, using procedure DOFFER. The file is named NEWNAME under its ! new ownership, but NEWNAME and FILE may be identical names. !> ! ! ! CONSTINTEGER ALLOW IC INTS = X'FFFFF7FF' CONSTINTEGER BASEFILE SEG = 32 CONSTINTEGER BATCH = 2; ! reason for STARTP CONSTINTEGER CHERSH = 16; ! CODES CONSTINTEGER CLODACT=8 CONSTINTEGER CODE AD = X'00080000'; ! LOCAL 2 CONSTINTEGER DAPINSPERSEC = 3300000 CONSTINTEGER DEFAULT BMAX = 1 CONSTINTEGER DEFAULT IMAX = 1 CONSTINTEGER DEFAULT MAXFILE = 1024; ! 1megabyte CONSTINTEGER DEFAULT MAXKB = X'8000'; ! 32 megabytes CONSTINTEGER DEFAULT TMAX = 1 CONSTINTEGER DIRCODE SEG = 2 CONSTINTEGER DIRDACT = 5; ! special director async messages CONSTINTEGER DLOG = 8; ! route PRINTSTRING to DIRLOG CONSTINTEGER DT = 1; ! DATE and TIME required in PRINSTRING CONSTINTEGER EPAGE SIZE = 4 CONSTINTEGER ERCC = 1 CONSTINTEGER EX = 5 CONSTINTEGER FORK = 5 CONSTINTEGER GLAD = X'000C0000'; ! LOCAL 3 CONSTINTEGER INTDACT = 1; ! INT: messages from supervisor CONSTINTEGER INTER = 0; ! reason for STARTP CONSTINTEGER INVI = X'80308030' CONSTINTEGER KENT = 0 CONSTINTEGER LEAVE = 8 CONSTINTEGER LOG = 2; ! route PRINTSTRING to MAINLOG CONSTINTEGER LOUAD = X'00800000' ! 32 << 18 CONSTINTEGER MAXM1 = 3 CONSTINTEGER NEWSTART = 4; ! reason from STARTP CONSTINTEGER NO = 0 CONSTINTEGER NOARCH = 128; ! CODES CONSTINTEGER NORMAL STACK SEG = 4 CONSTINTEGER NULDACT = 6; ! Null activity CONSTINTEGER OFFER = 2; ! CODES CONSTINTEGER OLDGE = 4; !CODES2 CONSTINTEGER PON AND CONTINUE = 6 CONSTINTEGER PON AND SUSPEND = 7 CONSTINTEGER PRIVAT = 32; ! CODES CONSTINTEGER READ ACR = 5 CONSTINTEGER REC SEP = 30; !ISO record separator CONSTINTEGER RESDACT = 2; ! resume messages from user process CONSTINTEGER SCTAB SEG = 8 CONSTINTEGER SIG LOOP STOP = 31 CONSTINTEGER SITE = KENT CONSTINTEGER SYNC1 TYPE = 1 CONSTINTEGER TEMPFI = 4; ! CODES CONSTINTEGER TEMPFS = 12 CONSTINTEGER TOP AS ACT = 9 CONSTINTEGER TOPEI = 22 CONSTINTEGER TOP I VALUE = 2 CONSTINTEGER TXTDACT = 3; ! text messages in file, P1 = start/finish CONSTINTEGER UHIDACT = 4; ! uninhibit async messages CONSTINTEGER UNAVA = 1; ! CODES CONSTINTEGER USEDACT = 7 CONSTINTEGER VEC128 = X'38000000' CONSTINTEGER VIOLAT = 64; ! CODES CONSTINTEGER VTEMPF = 8; ! CODES CONSTINTEGER WR = 3 CONSTINTEGER WRCONN = 1; ! CODES2 CONSTINTEGER WRSH = 11; ! WRITE, READ AND SHARED CONSTINTEGER WRTOF = 4; ! route PRINTSTRING to private log file CONSTINTEGER YES = 1 ! ! CONSTSTRINGNAME DATE = X'80C0003F' CONSTSTRINGNAME TIME = X'80C0004B' ! CONSTSTRING (29)EXECP = "FTRANSDIRECTVOLUMSPOOLRMAILER" ! ! EXTERNALINTEGER ACCTSA EXTERNALINTEGER AEXPRESS = 0 EXTERNALINTEGER AIOSTAT EXTERNALINTEGER AQD EXTERNALINTEGER AREVS EXTERNALINTEGER ASYNC INHIB = 100 EXTERNALINTEGER BLKSI EXTERNALINTEGER CBTA0 EXTERNALINTEGER CBTASL0 EXTERNALINTEGER DAP STATE EXTERNALINTEGER D CALLERS ACR; ! SET BY FN IN2 EXTERNALINTEGER D CALLERS PSR EXTERNALINTEGER DDVSN; ! FORMAT IS FSYS<<18 ! DIRVSN EXTERNALINTEGER DEFAULT SS ACR = 10 EXTERNALINTEGER DEPTH EXTERNALINTEGER DINSTRS EXTERNALINTEGER DIRFLAG EXTERNALINTEGER DIRFN EXTERNALINTEGER DIRLEVEL EXTERNALINTEGER DIRLOGAD = 0; ! ADDR OF DIRLOG EXTERNALINTEGER DIRMON EXTERNALINTEGER DIROUTP0 EXTERNALINTEGER D TRYING = -1; ! SET FROM INDEX IN DIRECTOR AT START UP EXTERNALINTEGER ENDSST EXTERNALINTEGER FACILITYA; ! set to seg<<18+32 or 0 EXTERNALINTEGER FILE1AD = 0; ! ADDR OF USERS LOGFILE EXTERNALINTEGER FSYS WARN = 0 EXTERNALINTEGER GOT SEMA = 0 EXTERNALINTEGER HISEG EXTERNALINTEGER HOTTOPA = 0; ! address of Hot Top array EXTERNALINTEGER HOTTOPN = 0; ! records 0:N, where n = 2**p - 1 EXTERNALINTEGER INVOC; ! >= 0 EXTERNALINTEGER LOG ACTION EXTERNALINTEGER OUTPAD EXTERNALINTEGER OWNIND EXTERNALINTEGER PAGEMON EXTERNALINTEGER PROCESS EXTERNALINTEGER PROCFSYS = -1 EXTERNALINTEGER PROC1 LNB = 0; ! used in PROCESS1 EXTERNALINTEGER SAINDAD EXTERNALINTEGER SCTIAD EXTERNALINTEGER SELECTED FSYS EXTERNALINTEGER SEMADDRHELD = 0 EXTERNALINTEGER SEMANOHELD = 0 EXTERNALINTEGER SESSINSTRS = 0 EXTERNALINTEGER SESSKIC = X'0FFFFFFF' EXTERNALINTEGER SIGMO = 0 EXTERNALINTEGER SIGOUTP0 EXTERNALINTEGER SRCE ID = 5000; ! ARBITRARY NUMBER TO INCREMENT FOR SORCE IN EACH PON AND SUSPEND EXTERNALINTEGER SST0 EXTERNALINTEGER SUPLVN S START EXTERNALINTEGER TAPES CLAIMED EXTERNALINTEGER WORKBASE EXTERNALBYTEINTEGERARRAY FSYS USECOUNT(0:99) ! ! ! EXTERNALSTRING (23)LOUTPSTATE EXTERNALSTRING ( 6)PROCUSER = "" EXTERNALSTRING (18)SELECTED INDEX EXTERNALSTRING (127)SELECTED NODE EXTERNALSTRING (15)VSN ! ! RECORDFORMAT C ACF(LONGINTEGER MUSECS, INTEGER PTRNS, KINSTRS) RECORDFORMAT C AINFF(STRING (11)NAME, INTEGER NKB, STRING (8)DATE, STRING (6)TAPE, C INTEGER CHAP,FLAGS); ! 40 BYTES RECORDFORMAT C CBTF(INTEGER DA, HALFINTEGER AMTX, BYTEINTEGER TAGS, LINK) RECORDFORMAT C DRF(INTEGER DR0, DR1) RECORDFORMAT C FHDRF(INTEGER NEXTFREEBYTE,TXTRELST,MAXBYTES,ZERO, C SEMA,DATE,NEXTCYCLIC,READ TO) RECORDFORMAT C IOSTATF(INTEGER IAD, STRING (15)INTMESS, C INTEGER INBUFLEN, OUTBUFLEN, INSTREAM, OUTSTREAM) RECORDFORMAT C MAGF(STRING (6)TSN, INTEGER SNO) RECORDFORMAT C OBJF(INTEGER NEXTFREEBYTE, CODERELST, GLARELST, LDRELST) RECORDFORMAT C OINFF(STRING (11) NAME,INTEGER SP12,NKB, C BYTEINTEGER ARCH,CODES, C CCT,OWNP,EEP,USE,CODES2,SSBYTE,FLAGS,POOL,DAYNO,SP31) RECORDFORMAT RF(INTEGER LNB,PSR,PC,SSR,SF,IT,IC,LTB, C XNB,B,DR0,DR1,A0,A1,A2,A3,INSTRAD,PROCDEF) RECORDFORMAT C SCTHDRF(INTEGER HORIZ VECTOR BOUND, SCTRELST, IDENS ARRAY RELST, C DT STAMP, STRING (15)FIXUP DATE, INTEGER ENDF) RECORDFORMAT C SCTIF(INTEGER DR0, DR1); ! horizontal, I-vector, format RECORDFORMAT C SCTJF(INTEGER TYPE, ACR, DRDR0, DRDR1); ! vertical, J-vector, format RECORDFORMAT C SPOOF(INTEGER VSN, FSYS, STRING (6)USER, SPARE1, INTEGER IDENT,KINSTRS,STRING (31) JOB DOC FILE, STRING (15)JOBNAME, INTEGER PRIORITY, DECKS, DRIVES, OUTPUT LIMIT, DAPSECS, INTEGER OUT, STRING (15)OUTNAME, INTEGER DAP NO) ! ! OUT: 0, 1 to a devcie ! 2, 3 to a file ! 4 to be destroyed ! OUTNAME name of queue or file RECORDFORMAT C STE(INTEGER APFLIM, USERA) INCLUDE "PD22S_C03FORMATS" ROUTINESPEC COMMS CLOSEDOWN INTEGERFNSPEC NEWAFIND2(INTEGER AFINDAD, STRINGNAME FILE, STRING (11)DATE, INTEGER TYPE) INTEGERFNSPEC NEWAINDA(STRING (6)USER, INTEGER FSYS, INTEGERNAME AFINDAD) EXTERNALINTEGERFNSPEC NEWFILEPERM(INTEGER FINDAD, RECORD (FDF)NAME FD, STRING (6)USER) EXTERNALINTEGERFNSPEC NEWFIND(INTEGER FINDAD, DA, STRINGNAME FILE) EXTERNALINTEGERFNSPEC SETFILEINDEX(STRING (6)USER, STRING (11)NAME, INTEGER FSYS, SIZE, NPD, NFD, FINDAD) ! ! ! ! ! ! ! INTEGERFNSPEC C APP(INTEGERNAME SEMA) EXTERNALINTEGERFNSPEC C AV(INTEGER FSYS, TYPE) ROUTINESPEC C AVV(INTEGERNAME SEMA) EXTERNALINTEGERFNSPEC C BAD PAGE(INTEGER TYPE, FSYS, BITNO) EXTERNALINTEGERFNSPEC C CONSEG(STRING (31)FILE, INTEGER FSYS, INTEGERNAME GAP) EXTERNALROUTINESPEC C DAP INTERFACE(INTEGER ACT) EXTERNALROUTINESPEC C DCHAIN(INTEGER SEG,DSTRY) EXTERNALINTEGERFNSPEC C DCHSIZE(STRING (6)USER, STRING (11)FILE, INTEGER FSYS, NEWKB) EXTERNALINTEGERFNSPEC C DCONNECTI(STRING (31)FULL, INTEGER FSYS, MODE, APF, C INTEGERNAME SEG,GAP) EXTERNALINTEGERFNSPEC C DCREATEF(STRING (31)FULL, INTEGER FSYS, NKB, ALLOC, LEAVE, C INTEGERNAME DA) EXTERNALINTEGERFNSPEC C DDAYNUMBER INTEGERFNSPEC C DDELAY(INTEGER N) EXTERNALINTEGERFNSPEC C DDESTROYF(STRING (31)FULL, INTEGER FSYS, DEALLOC) EXTERNALINTEGERFNSPEC C DDISCONNECTI(STRING (31)FULL, INTEGER FSYS, LO) EXTERNALROUTINESPEC C DDUMP(INTEGER A,B,C,D) EXTERNALROUTINESPEC C DERR2(STRING (31) S,INTEGER FN, ERR) INTEGERFNSPEC C DISABLE STREAM(INTEGERNAME CURSOR, INTEGER STREAM, REASON) EXTERNALINTEGERFNSPEC C DISCSEG CONNECT(INTEGER FSYS,SITE,SEG,APF,EPGS,FLAGS) INTEGERFNSPEC C DMESSAGE2(STRING (255)USER, INTEGERNAME LEN, INTEGER ACT, FSYS, INVOC, ADR) EXTERNALINTEGERFNSPEC C DMON(STRING (255)S) EXTERNALROUTINESPEC C DOPERR(STRING (15)TXT,INTEGER FN,RES) EXTERNALROUTINESPEC C DOPER2(STRING (255)S) ROUTINESPEC C DOUTI(RECORD (PARMF)NAME P) INTEGERFNSPEC C DPON3(STRING (6)USER, RECORD (PARMF)NAME P, INTEGER INVOC, MSGTYPE, OUTNO) ROUTINESPEC C DRESUME(INTEGER LNB, PC, ADR18) INTEGERFNSPEC C DSFI(STRING (6)USER, INTEGER FSYS, TYPE, SET, ADR) EXTERNALROUTINESPEC C DSTOP(INTEGER REASON) INTEGERFNSPEC C DTRANSFER(STRING (31)USER1, USER2, FILE1, FILE2, INTEGER FSYS1, FSYS2, TYPE) EXTERNALROUTINESPEC C EMPTY DVM EXTERNALINTEGERFNSPEC C EQUAL(STRINGNAME NAME1, NAME2) INTEGERFNSPEC C FILE INDEX PERM(STRING (31)INDEX, INTEGER FSYS) EXTERNALROUTINESPEC C FILL(INTEGER LENGTH, FROM, FILLER) EXTERNALROUTINESPEC C FILL STACK ENTS(INTEGER INDAD, STRING (3)SUFF) EXTERNALINTEGERFNSPEC C FINDA(STRING (31)INDEX, INTEGERNAME FSYS, FINDAD, INTEGER TYPE) EXTERNALINTEGERFNSPEC C FUNDS(INTEGERNAME GPINDAD,INTEGER INDAD) EXTERNALINTEGERFNSPEC C GETIC EXTERNALROUTINESPEC C GIVEAPF(INTEGERNAME SAPF, NOTDRUM, SLAVEBIT, INTEGER SEG) EXTERNALINTEGERFNSPEC C HINDA(STRING (6)USER, INTEGERNAME FSYS, INDAD, INTEGER TYPE) EXTERNALSTRINGFNSPEC C HTOS(INTEGER I, PL) EXTERNALROUTINESPEC C INIT CBT EXTERNALINTEGERFNSPEC C IN2(INTEGER FN) EXTERNALSTRINGFNSPEC C ITOS(INTEGER I) EXTERNALROUTINESPEC C IUPDATE(INTEGER MODE, NEWCOUNT) EXTERNALINTEGERFNSPEC C MAP FILE INDEX(STRINGNAME INDEX, INTEGERNAME FSYS, FINDAD, STRING (31)TXT) EXTERNALROUTINESPEC C MOVE(INTEGER LEN, FROM, TO) EXTERNALROUTINESPEC C NCODE(INTEGER PC) EXTERNALINTEGERFNSPEC C OUT(INTEGER FLAG, STRING (63)TEMPLATE) EXTERNALINTEGERFNSPEC C PACKDT EXTERNALINTEGERFNSPEC C PP(INTEGER SEMADDR,SEMANO,STRING (63)S) EXTERNALROUTINESPEC C PREC(STRING (255)S, RECORD (PARMF)NAME P, INTEGER N) EXTERNALROUTINESPEC C PRHEX(INTEGER I) EXTERNALROUTINESPEC C PRINTMP(INTEGER SEG1,SEG2) EXTERNALROUTINESPEC C PROCESS1(INTEGER A, B) EXTERNALINTEGERFNSPEC C SCONNECT(INTEGER SEG,STARTP,LEN,CALLAPF,NEWCOPY,NOTDRUM,NOTSLAVED,FS) EXTERNALROUTINESPEC C SETSTOP EXTERNALINTEGERFNSPEC C SHOW USECOUNT(INTEGER FSYS, SOURCE, CNSL) EXTERNALINTEGERFNSPEC C SST(INTEGER N) EXTERNALINTEGERFNSPEC C STOI(STRING (255)S) EXTERNALINTEGERFNSPEC C STRING TO FILE(INTEGER LEN, ADR, FAD) EXTERNALINTEGERFNSPEC C SYSAD(INTEGER KEY, FSYS) EXTERNALINTEGERFNSPEC C SYSBASE(INTEGERNAME SYSTEM START, INTEGER FSYS) EXTERNALINTEGERFNSPEC C VAL(INTEGER ADR,LEN,WR,PSR) EXTERNALROUTINESPEC C VV(INTEGER SEMADDR, SEMANO) EXTERNALROUTINESPEC C WRS(STRING (255)S) EXTERNALROUTINESPEC C WRSS(STRING (255)S1, S2) EXTERNALROUTINESPEC C WRSN(STRING (255)S, INTEGER N) EXTERNALROUTINESPEC C WRSNT(STRING (255)S, INTEGER N, T) EXTERNALROUTINESPEC C WRS3N(STRING (255)S1, S2, S3, INTEGER N) ! OWNSTRING (18)SINDEX OWNINTEGER SFSYS, SRES, SFINDAD OWNBYTEINTEGERARRAY DEFHOTTOP(0:383); ! 16*24 OWNINTEGER DIRSITE OWNINTEGER UINHAD = -1 OWNINTEGER ACALLDR0 = -1 OWNINTEGER ACALLDR1 = -1 OWNINTEGER ACALLXNB = -1 OWNINTEGER ACALLPSR = -1 OWNINTEGER CALLDR0 = 0 OWNINTEGER CALLDR1 = 0 OWNINTEGER CALLXNB = 0 OWNINTEGER CALLPSR = X'00F00000'; ! DEFAULT UNTIL PRIME CONTINGENCY CALLED OWNINTEGER ONTRAP = 0 OWNINTEGER VSERR = 0 OWNINTEGER RESUMEWAIT = 0 OWNINTEGER RESUMESTACK = 0 ! EXTERNALRECORD (FDF)LAST FD; ! LAST FD FOUND EXTERNALRECORD (PARMF)LOUTP; ! LAST RECORD OUTD ! CONSTRECORD (UINFF)NAME UINF = 9<<18 ! OWNRECORD (RF)RESUMEREGS OWNRECORD (PARMF)SAVE DIROUTP ! ! OWNRECORD (IOSTATF)NAME IOSTAT ! ! OWNINTEGER INBUFA,INBUFLEN,OUTBUFA,OUTBUFLEN OWNINTEGERARRAY ENABLED(0:1) OWNRECORD (CBTF)ARRAYFORMAT CBTAF(0:512) OWNRECORD (CBTF)ARRAYNAME CBTA OWNRECORD (STE)ARRAYFORMAT STF(0:127) OWNRECORD (STE)ARRAYNAME ST ! CONSTINTEGER TOPENT = 3 OWNRECORD (MAGF)ARRAY CLAIMED(0:3) EXTRINSICRECORD (DRF)ARRAY DRS LOCKED(0:2) ! ! !----------------------------------------------------------------------- ! EXTERNALROUTINE UCTRANSLATE(INTEGER ADR, LEN) INTEGER A A = INTEGER(X'80C0008F') + 512 *LDTB_X'18000100' *LDA_A *CYD_0 *LDA_ADR *LDB_LEN *TTR_L =DR END ; ! OF UCTRANSLATE ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN S11OK(STRINGNAME FILE) INTEGER J,CH, L ! ! RESULT = 0 GOOD ! 18 BAD ! L = LENGTH(FILE) RESULT = 18 UNLESS 0 < L < 12 ! UCTRANSLATE(ADDR(FILE)+1, L); ! retain case of letters CYCLE J=1,1,L CH=BYTEINTEGER(ADDR(FILE)+J) RESULT = 18 UNLESS C CH = '#' ORC 'A' <= CH <= 'Z' ORC 'a' <= CH <= 'z' ORC '0' <= CH <= '9' REPEAT RESULT = 0 END ; ! S11OK ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN UNOK(STRINGNAME USER) INTEGER J, CH RESULT = 11 UNLESS LENGTH(USER) = 6 UCTRANSLATE(ADDR(USER)+1, 6) CYCLE J = 1, 1, 6 CH = CHARNO(USER, J) RESULT = 11 UNLESS 'A' <= CH <= 'Z' OR '0' <= CH <= '9' REPEAT RESULT = 0 END ; ! UNOK ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN UIO(STRING (31)USER, STRINGNAME UNAME, INAME, INDEX) ! ! checks, UCTs and resolves USER, supplies PROCUSER as default ! INTEGER J J = 0 INAME = "" UNAME = USER UNLESS USER -> UNAME . (ISEP) . INAME ! IF UNAME = "" C THEN UNAME = PROCUSER C ELSE START J = UNOK(UNAME) -> OUT UNLESS J = 0 FINISH INDEX = UNAME ! UNLESS INAME = "" START J = S11OK(INAME) INDEX = INDEX . ISEP . INAME FINISH OUT: RESULT = J END ; ! UIO ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN UFO(STRING (31)USER, FILE, STRINGNAME UNAME, INAME, FNAME, INDEX, FULL) ! ! Combines and then resolves USER and FILE into ! user [:index] and file ! does UC translate and supplies PROCUSER as default user ! INTEGER J STRING (255)W IF FILE -> W . (".") . FNAME C THEN W = USER . W C ELSE W = USER AND FNAME = FILE ! J = UIO(W, UNAME, INAME, INDEX) -> OUT UNLESS J = 0 ! J = S11OK(FNAME) FULL = INDEX . "." . FNAME OUT: RESULT = J END ; ! UFO ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN CREATE AND CONNECT(STRING (31)FULL, INTEGER FSYS, NKB, ALLOC, MODE, APF, INTEGERNAME SEG, GAP) INTEGER J, DA J = DCREATEF(FULL, FSYS, NKB, ALLOC, LEAVE, DA) RESULT = J IF 0 # J # 16 J = DCONNECTI(FULL, FSYS, MODE, APF, SEG, GAP) J = 0 IF J = 34 RESULT = J END ; ! CREATE AND CONNECT ! !----------------------------------------------------------------------- ! INCLUDE "PD22S_B06MESS" INCLUDE "PD22S_B09IO" EXTERNALINTEGERFN ASYNC MSG(STRING (6) USER, INTEGER INVOC,DACT,P1,P3) RECORD (PARMF)NAME P LONGLONGREAL LONGLONGREAL INTEGER LRAD,J,CH LRAD=ADDR(LONGLONGREAL) CYCLE J=0,1,15 IF J<=6 THEN CH=BYTEINTEGER(ADDR(USER)+J) ELSE CH=0 IF J=7 THEN CH=INVOC; ! incarnation number ! for sync1 msgs, RH end of ACC to be 1 ! SYNC2 2 ! ASYNC 3 CH=3 IF J=15; ! async msg BYTEINTEGER(LRAD+J)<-CH REPEAT P==RECORD(OUTPAD) P=0 P_DEST=X'FFFF0000' ! DACT P_P1=P1 P_P3=P3 *LSQ_LONGLONGREAL *OUT_6; ! pon and continue IF P_DEST=0 THEN RESULT =61; ! process not present RESULT =0 END ; ! ASYNC MSG ! !----------------------------------------------------------------------- ! EXTERNALROUTINE CYCINIT(INTEGER FAD, MAXBYTES) RECORD (FHDRF)NAME H H == RECORD(FAD) H = 0 H_NEXTFREEBYTE = 32 H_TXTRELST = 32 H_NEXTCYCLIC = 32 H_MAXBYTES = MAXBYTES H_READ TO = 32 END ; ! CYCINIT ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN TXTMESS(STRING (6)USER, RECORD (PARMF)NAME P, INTEGER SYNC, INVOC, TXTLEN, TXTAD, FSYS, SACT) ! ! ! Used by : ! DMESSAGE ! DSPOOL ! BROADCAST and D/MSG ! SPOOL LOGFILE (D/PRINT) ! ! ! SYNC determines message type ! SACT = 0: do a "DOUT" (and wait) ! # 0: do a "DPON" (and continue). Used by SPOOL LOGFILE and CHECKSTART. INTEGER SEG,FAD,GAP,I,J,INDAD,DIR ACR, PONTYPE INTEGER NKB, ALLOC, MODE, APF INTEGER SEMADR, SEMANO, TELLREJ STRING (6)FROM STRING (31)FULL RECORD (FHDRF)NAME CYCH RECORD (FF)NAME F RECORD (HF)NAME H *LSS_(1); ! PSR *ST_J DIR ACR=(J>>20)&15 ! FULL = USER . ".#MSG" NKB = 4 ALLOC = X'0B000051'; ! EEP = 11, zero MODE = WRSH APF = DIRACR << 4 ! 15 SEG = 0 GAP = 0 J = CREATE AND CONNECT(FULL, FSYS, NKB, ALLOC, C MODE, APF, SEG, GAP) RESULT = J UNLESS J = 0 ! FAD = SEG << 18 CYCH == RECORD(FAD) ! J = HINDA(USER, FSYS, INDAD, 0) RESULT = J UNLESS J = 0 ! H == RECORD(INDAD) F == RECORD(INDAD + 512) TELLREJ = H_TELLREJ SEMADR = ADDR(H_MSGSEMA) SEMANO = (1<<31) ! F_SEMANO ! IF TELLREJ & 1 > 0 AND DTRYING = 0 C THEN RESULT =48; ! destination user requires TELL messages to be ! rejected (except from executive processes). ! Top bit in SEMANO is set: ! 1 to give a semano different from the index semano, to be used ! conventionally for the #MSG file, and ! 2 to indicate 'not-express' to the semaphore routine, PP. ! Arguably we could use (say) the disc address of the file page (i.e. ! the page containing the sema), but then we'd need a call of DGETDA. J = PP(SEMADR, SEMANO,"TXTMESS: ".USER) -> OUT UNLESS J = 0 ! CYCLE {double up any rec seps in text} I = 0 WHILE I < TXTLEN CYCLE EXIT IF BYTEINTEGER(TXTAD + I) = REC SEP I = I + 1 REPEAT ! J = STRING TO FILE(I, TXTAD, FAD) IF I > 0 EXIT UNLESS I < TXTLEN ! J = (REC SEP << 8) ! REC SEP J = STRING TO FILE(2, ADDR(J)+2, FAD) TXTAD = TXTAD + I + 1 TXTLEN = TXTLEN - I - 1 REPEAT ! J = REC SEP << 8 J = STRING TO FILE(2, ADDR(J)+2, FAD) {terminate with RS + null} ! now see how the message is to be signalled. ! Send an async (txt) msg if SYNC is zero, else a sync1-type message to P_DEST SRCE ID = (SRCE ID + 1) & X'FFFF' P_SRCE = SACT ! FROM = PROCUSER MOVE(6, TXTAD + 2, ADDR(FROM) + 1) IF SYNC = 2; ! from DSUBMIT P_S = FROM ! P_P3 = SYNC P_P4 = SACT STRING(ADDR(P_P5)) = USER; ! these 3 items for info only ! ! ! ! IF SACT=0 ITS FROM DSPOOL THE IDEA IS TO HOLD ! THE MSG SEMA FOR A SHORT A TIME AS POSSIBLE ! IT DOES NOT SEEM NECESSARY TO KEEP IT UNTIL ! A REPLY HAS BEEN RECEIVED IF SYNC = 0 C THEN J = ASYNC MSG(USER, INVOC, TXT DACT, 0, 0) C ELSE START PON TYPE = PON AND CONTINUE; ! ON SYNC1 PON TYPE = 8 AND P_SRCE=SRCE ID IF SACT = 0; ! PON AND CONTINUE ON SYNC2 J = DPON3I(USER, P, INVOC, SYNC1 TYPE, PON TYPE) FINISH VV(SEMADR, SEMANO) IF J = 0 AND SACT = 0 # SYNC START ; ! J # 0 means 61 - process N/A, so doing a DPOFF causes a hang DPOFF2(P, SRCE ID) J = P_P1 FINISH ! OUT: I = DDISCONNECTI(FULL, FSYS, 1) RESULT =J END ; ! TXTMESS ! !----------------------------------------------------------------------- ! EXTERNALROUTINE ATTU(STRINGNAME S) STRING (255) T T="**".PROCUSER.TOSTRING(7)." ".DATE." ".TIME LENGTH(T)=LENGTH(T)-3 S<-T.": ".S END ; ! ATTU ! !----------------------------------------------------------------------- ! INTEGERFN RDCIRC(INTEGERNAME LEN,INTEGER FA1,ADR) ! reads from circular file FA1 from "read to" to ! next record separator or to "NEXTCYCLIC". resets ! "read to" according to what's taken. ! at DR, setting LEN to be N. of bytes moved ! places data (so far as possible) into file FA2, from "NEXTFREEBYTE" ! up to a max of "MAXBYTES". ! INTEGER NEXT1,RELST1,MAXB1,ZER1,NEXTCYC,READTO,CH,TOP,LAST,ADR0 RECORD (FHDRF)NAME H1 H1 == RECORD(FA1) CYCINIT(FA1, 4096) IF H1_MAXBYTES = 0 NEXT1 = H1_NEXTFREEBYTE RELST1 = H1_TXTRELST MAXB1 = H1_MAXBYTES ZER1 = H1_ZERO NEXTCYC = H1_NEXTCYCLIC READTO = H1_READTO ! RESULT = 1 UNLESS 16 <= RELST1 <= MAXB1 ANDC RELST1 <= NEXT1 <= MAXB1 ANDC (READTO=0 OR RELST1 <= READTO <= MAXB1) ANDC RELST1 <= NEXTCYC <= MAXB1 ANDC ZER1 = 0 ! H1_READTO = RELST1 IF READTO = 0 AND RELST1 # NEXT1 TOP = ADR + LEN ADR0 = ADR LAST = -1 WHILE H1_READTO # NEXTCYC AND ADR < TOP CYCLE CH = BYTEINTEGER(FA1+H1_READTO) H1_READTO = H1_READTO + 1 H1_READTO = RELST1 IF H1_READ TO >= MAXB1 ! IF LAST = REC SEP START EXIT IF CH # REC SEP LAST = -1 FINISH ELSE START LAST = CH FINISH BYTEINTEGER(ADR) = CH ADR = ADR + 1 UNLESS LAST = REC SEP REPEAT LEN = ADR - ADR0 RESULT = 0 END ; ! RDCIRC ! !----------------------------------------------------------------------- ! EXTERNALROUTINE NOT SO FAST INTEGER J OWNINTEGER INCREASING = 1 RETURN UNLESS DTRYING = 0 J = DDELAY(INCREASING) INCREASING = INCREASING + 4 END ; ! NOT SO FAST ! !----------------------------------------------------------------------- ! INTEGERFN DSPOOLBODY(STRING (6)TO, RECORD (PARMF)NAME P, INTEGER LEN, ADR) INTEGER L, FLAG BYTEINTEGERARRAY MSG(0:2050) FLAG = 45 - > OUT IF VAL(ADR,LEN,0,0) = 0 ! FLAG = 8 -> OUT IF LEN > 2000; ! relatively arb, but to keep it within an EPAGE (size of #MSG file) ! MSG(0) = 0 ATTU(STRING(ADDR(MSG(0)))) L = MSG(0) MOVE(LEN, ADR, ADDR(MSG(L+1))) P_DEST = X'FFFF0016' FLAG = TXTMESS(TO, P, 1, 0, L+LEN, ADDR(MSG(1)), -1, 0); ! 1=SYNC SIG,0=INVOC,-1=FSYS OUT: RESULT = FLAG END ; ! DSPOOLBODY ! !----------------------------------------------------------------------- ! EXTERNALROUTINE FILE FOR HOTTOP(INTEGER INVOC) INTEGER J, SEG, GAP, DIRWRITEAPF STRING (31)FULL *LSS_(LNB +1) *ST_J J = (J & X'00F00000') >> 16 DIRWRITEAPF = J ! 15 ! FULL = "#HOTTOP" FULL = "VOLUMS.#DHOTTOP" IF PROCUSER = "DIRECT" FULL = FULL . ITOS(INVOC) ! SEG = 11 GAP = 0 J = CREATE AND CONNECT(FULL, -1, 4, (3<<24)+64+16+8+1, C 3, DIRWRITEAPF, SEG, GAP); ! EEP=3, ZERO, VTEMP & ALLOC ! IF J = 0 START HOTTOPA = SEG << 18 + 32 HOTTOPN = 127 WRS("HOTTOP FILE SETUP") FINISH END ; ! FILE FOR HOTTOP ! !----------------------------------------------------------------------- ! ROUTINE ENTER SUBSYSTEM(INTEGER CODEADR, SPACE, SSACR) INTEGER DISPLAD, STAKAD *STLN_DISPLAD; ! Now enter the Basefile STAKAD = (DISPLAD & X'FFFC0000') + SPACE; ! 'space' bytes up from start of seg INTEGER(STAKAD+20) = UINF_SCT DATE INTEGER(STAKAD+24) = ADDR(UINF) INTEGER(DISPLAD) = STAKAD INTEGER(DISPLAD+4) = (INTEGER(DISPLAD+4)&X'FF0BFFFF') ! (SSACR << 20) ! IF PROCUSER = "ENGINR" START INTEGER(DISPLAD+4) = INTEGER(DISPLAD+4) ! X'00040000'; ! set priv bit *LSS_(3); ! PICK UP SSR *OR_X'01800000'; ! DGW AND ISR *ST_(3); ! PUT BACK WITH DGW AND ISR BITS SET FINISH ! *LSS_(3) *AND_X'FFBFFFFF' *ST_(3); ! Temp, but has been there for many a yonk. ! INTEGER(DISPLAD+8) = CODEADR INTEGER(STAKAD) = STAKAD *EXIT_0 END ; ! ENTER SUBSYSTEM ! !----------------------------------------------------------------------- ! ROUTINE PREPARE TO ENTER(INTEGER CODEADR, SSACR) CONSTINTEGER SPACE = X'6000' BYTEINTEGERARRAY DUMMY(1 : SPACE) ENTER SUBSYSTEM(CODEADR, SPACE, SSACR) END ; ! PREPARE TO ENTER ! !----------------------------------------------------------------------- ! EXTERNALROUTINE DIRECTOR(RECORD (PARMF)NAME P) INTEGER J,K,BASEFAD,PFSYS,BGLASEG,SSACR,ACR HERE INTEGER DIRDISC,GAP,WKSEG,SITE,SSAPF,DIR RW APF INTEGER DIR WRITE APF INTEGER SCT REL EPG,SCT BLOCKAD,TRIED BASEF, TRIED DEF SS INTEGER CELL, DA STRING (3)SSUFF STRING (8) USER STRING (255) S STRING (31) BASEFILE,FILE STRING (14)DIRLOG ! RECORD (DIRCOMF)NAME DIRCOM RECORD (SCTHDRF)NAME SCTHDR RECORD (SCTIF)ARRAYFORMAT SCTIAF(0:TOP I VALUE) RECORD (SCTIF)ARRAYNAME SCTI ! ! Mac wants an SSN+1 integer to contain session kistructions (this is of ! course different from AICREVS). ! USE LAST WORD OF ACCTS RECORD ! ! INTEGER WKGAP, ACOUNT, BITS RECORD (LOGFHDF)NAME LOGH RECORD (PROCDATF)ARRAYNAME PROCLIST CONSTSTRING (14)FULL = "VOLUMS.#LOGMAP" CONSTSTRING (7)ARRAY SITEN(1:2) = "SUBSYS", "STUDENT" ! RECORD (HF)NAME NIH RECORD (OBJF)NAME H,HC RECORD (PARMF)NAME SIGP RECORD (ACF)NAME ACCTS ! ! Initial values in ! DIROUTP RECORD : SIGOUTP RECORD : ! DEST : S pare" LST LENGTH (NO. OF LOCAL SEGMENTS) ! SRCE : EPAGE SIZE<<16 ! MAX "CBT" BLKSI (EPAGES) ADDR(SST(0)) ! P1 : PROC NO ADDR(CBTASL) ! P2 : USERNAME STRING ADDR(CBTA(0)) ! P3 : - DITTO - ADDR(ACCT RECORD) ! P4 : ADDR(SIGOUTP) ADDR(IC REVOLUTIONS) ! P5 : ADDR(SCTI(0)) (THE HORIZONTAL VECTOR) ADDR(IOSTATUS) ! P6 : DACT ON ASYNC SNO ON WHICH FE HL CTL MSGS ARE TO ARRIVE RECORD (SPOOF)NAME SPOOH ! ! !----------------------------------------------------------------------- ! ROUTINE FAIL(STRING (13)S, INTEGER RES) ! ! With the new FE software (Sept 81), this routine must not be called after ! the process' i/o comms streams have been connected. The FE can accept these ! messages for the terminal on DIRECT's output stream only while the process' ! i/o streams are not connected. Also, this routine must not be called before ! the UINF file has been connected! ! RECORD (PARMF)P INTEGER J P = 0 P_P2 = UINF_STREAM ID ! IF UINF_REASON = INTER START P_DEST = X'FFFF0000' ! (UINF_PSLOT << 8) ! 18; ! PR(18) in process 1 STRING(ADDR(P_P3)) = S P_P6 = RES J = DPON3I("DIRECT", P, 0, SYNC1 TYPE, PON AND CONTINUE) FINISH DOPER2("LOGON " . S . ITOS(RES)) DSTOP(21) END ; ! FAIL ! !----------------------------------------------------------------------- ! DIRLOG = "VOLUMS.#DIRLOG" DIRLEVEL = 0 FACILITYA = 0 DIROUTP0=ADDR(P) OUTPAD=DIROUTP0 ! EPAGE SIZE=P_SRCE>>16 BLKSI=P_SRCE&X'FFFF' PROCESS=P_P1 USER=STRING(ADDR(P_P2)) PROCUSER=USER INVOC=P_P3&255 SIGOUTP0=P_P4 SCTIAD=P_P5 ! ASYNC DACT=P_P6 SIGP==RECORD(SIGOUTP0) HISEG=SIGP_DEST - 1 SST0=SIGP_SRCE CBTASL0=SIGP_P1 CBTA0=SIGP_P2 ACCTSA=SIGP_P3 ACCTS==RECORD(ACCTSA) AREVS=SIGP_P4 AIOSTAT=SIGP_P5 AEXPRESS = SIGP_P6; ! ADDR(EXPRESS) ! *LSS_(LNB +1) *ST_ACR HERE ACR HERE = (ACR HERE & X'00F00000') >> 20 DIR RW APF = (ACR HERE << 4) ! ACR HERE DIR WRITE APF = (ACR HERE << 4) ! X'F' ! CBTA == ARRAY(CBTA0, CBTAF) ST == ARRAY(0, STF) INIT CBT HOTTOPA = ADDR(DEFHOTTOP(0)) HOTTOPN = 15 ! PROCFSYS = CBTA(SST(3))_DA >> 24 J = CBTA(SST(2))_DA DIRSITE = J << 8 >> 8 DDVSN = (J - X'200') >> 6 DIRDISC = DDVSN >> 18 HC == RECORD(DIRCODE SEG << 18) LOG ACTION = DT ! LOG ! J = SYSBASE(SUPLVN S START, COM_SUPLVN) DOPER2("SYSBASE fails") UNLESS J = 0 ! ! !------------------------------ CONNECT SCTABLE ------------------------------- ! SCT REL EPG = HC_LDRELST >> 12 FILE = "SCT" J = DISCSEGCONNECT(DIRDISC,DIRSITE+SCTRELEPG,SCTABSEG,X'00F', (64 - SCT REL EPG),32) -> STOP UNLESS J = 0 ! SCT BLOCK AD = (SCTABSEG << 18) + (HC_LDRELST & 4095) SCT HDR == RECORD(SCT BLOCK AD) SCTI == ARRAY(SCTIAD, SCTIAF) SCTI(0) = 0 SCTI(2) = 0 SCTI(1)_DR0 = VEC128 ! SCT HDR_HORIZ VECTOR BOUND; ! TOP J VALUE, PLUS ONE SCTI(1)_DR1 = SCT BLOCK AD + SCT HDR_SCT RELST ! THERE ARE TWO PAGES OF SCT + IDEN/I,J-VALUES PRECEDING GLAP (AND PG-ALIGNED) ! ! GET DATE AND TIME OF DIRECTOR FIXUP OUT OF SCTABLE HEADER VSN = SCT HDR_FIXUP DATE ! !---------------------------------------------------------------------- ! IF USER = "DIRECT" OR USER = "FCHECK" START ! LCSTK 4 DSTK 51 UINF 1 DGLA 4 SIGSTK 4 CELL = SST(4) CBTA(CELL)_LINK = 0 SITE = CBTA(CELL)_DA; ! address of director stack ! IF USER = "DIRECT" START WORKBASE = (((SITE<<8)>>8) + 63) & (-64) FINISH ! J = SCONNECT(4, SITE+32, 19, DIR RW APF, 1, 0, 0, 128); ! newcopy,drum,slaved,continuation DOPERR("DIRECTOR STK", 2, J) UNLESS J = 0 ! J = SCONNECT(9, SITE+51, 1, DIR RW APF, 1, 0, 0, 0) DOPERR("DIR UINF", 2, J) UNLESS J = 0 ! J = SCONNECT(6, SITE+56, 4, DIR RW APF, 1, 1, 0, 0); ! newcopy,notdrum,slaved DOPER2("SIG STK FLAG ".ITOS(J)) UNLESS J = 0 ! PROCESS1(0, 0) FINISH ! !------------------------------------------------------------------------------- ! FILE = "HINDA" PFSYS = PROCFSYS J = HINDA(USER, PFSYS, OWNIND, 0) -> STOP UNLESS J = 0 IUPDATE(-2, 0); ! init index accounting entries for session ! SSUFF = ITOS(INVOC) ! WKSEG = 14 GAP = 0 K = DCONNECTI(DIRLOG, -1, WRSH, (DIR WRITE APF>>4<<4)!(DEFAULT SSACR-1), WKSEG, GAP) IF K = 0 START DIRLOGAD = WKSEG << 18 LOG ACTION = DT ! DLOG FINISH ELSE DOPERR("DIRLOG", 2, K) ! NIH == RECORD(OWNIND) DTRYING = NIH_TRYING DIRMON = NIH_DIRMON NIH_DIRMON = 0 ! SSACR = NIH_ACR SSACR = DEFAULT SSACR UNLESS 0 < SSACR <= 15 ! FILE FOR HOTTOP(INVOC) IF PROCUSER = "SPOOLR" ! ! !-------------------- CONNECT UINF FILE ----------------------- ! FILE = "#UINFI".SSUFF WKSEG = ADDR(UINF) >> 18 GAP = 0 J = DCONNECTI(FILE, PFSYS, WRSH, DIR WRITE APF, WKSEG, GAP) -> STOP UNLESS J = 0 IUPDATE(-3, 0); ! allow entries to the iupdate file now UINF seg connected ! UINF now available UINF_ASYNC DEST = (COM_ASYNC DEST + PROCESS) << 16 UINF_SYNC1 DEST = (COM_SYNC1 DEST + PROCESS) << 16 UINF_SYNC2 DEST = (COM_SYNC2 DEST + PROCESS) << 16 DIRCOM == RECORD(SYSAD(DIRCOMKEY, -1)) ! !--------------------------------- Batch -------------------------------- ! IF UINF_REASON = BATCH START FILE = "SPOOLR." . UINF_SPOOLRFILE WKSEG = 0 GAP = 0 J = DCONNECTI(FILE, PROCFSYS, 1, DIRWRITEAPF, WKSEG, GAP) -> STOP UNLESS J = 0 SPOOH == RECORD(WKSEG << 18) ! Note that no-one is currently putting any limit on this value, ! i.e. the user can make it as large as he likes. Decision needed sometime. SESSKIC = SPOOH_KINSTRS WRSNT("Seconds=", SESSKIC//COM_KINSTRS, 5) ! UINF_JOBDOCFILE = SPOOH_JOB DOC FILE UINF_JOBNAME = SPOOH_JOBNAME UINF_PRIORITY = SPOOH_PRIORITY UINF_DECKS = SPOOH_DECKS WRSNT(",Decks=", UINF_DECKS, 5) UNLESS UINF_DECKS = 0 UINF_DRIVES = SPOOH_DRIVES WRSNT(",Drives=", UINF_DRIVES, 5) UNLESS UINF_DRIVES = 0 UINF_OUTPUT LIMIT = SPOOH_OUTPUT LIMIT ! UINF_DAPSECS = SPOOH_DAPSECS UINF_DAP NO = SPOOH_DAP NO UINF_DAPINSTRS = 0 DAP INTERFACE(2) IF UINF_DAPSECS > 0; ! its a DAP job ! UINF_OUT = SPOOH_OUT UINF_OUTNAME = SPOOH_OUTNAME NEWLINE ! J = DDISCONNECTI(FILE, PROCFSYS, 3); ! DISCONNECT AND DESTROY FINISH ! !----------------------------------------------------------------------- ! FILL STACK ENTS(OWNIND, SSUFF) ! FAIL("BAD PRIV", 0) UNLESS DTRYING & X'08080808' = 0 ! !--------------------CREATE AND CONNECT CONTINGENCY STACK (LOCAL 6) --- ! FILE = "#SIGSTK".SSUFF J = DCREATEF(FILE,PFSYS,32,5,6,DA); ! TEMPFI, ALLOC FAIL(FILE, J) UNLESS J = 0 OR J = 16 DCHAIN(6, 0); ! THROW AWAY TEMP SEG 6 GAP = 0 WKSEG = 6 J = DCONNECTI(FILE,PFSYS,WR,DIRWRITEAPF,WKSEG,GAP) FAIL(FILE, J) UNLESS J = 0 PROCESS1(0, 0) IF USER->("DIREC").S; ! testing new version of DIRECT process ! !--------- CONNECT BASEFILE --------- ! SITE = X'380'; ! used in calculating UINF_BASEFILE TRIED BASEF = NO TRIED DEF SS = NO BITS = 0 SSAPF = X'100' ! (SSACR <<4) ! SSACR WKSEG = BASE FILE SEG ! UNLESS UINF_REASON = BATCH START BASEFILE <- NIH_TESTSS -> TRY BASEF IF BASEFILE = "" NIH_TESTSS = "" -> TRY CONNECT FINISH ! BASEFILE <- NIH_BATCHSS -> TRY CONNECT UNLESS BASEFILE = "" TRY BASEF: TRIED BASEF = YES BASEFILE <- NIH_BASEFILE -> DEFAULT BASE IF BASEFILE = "" TRY CONNECT: IF BASEFILE = "#STUDENT" START BASEFILE = DIRCOM_DEFAULT STUDENT SITE = X'400' -> CONNECT SITE IF BASEFILE = "" FINISH ! GAP = 0 J = DCONNECTI(BASEFILE, -1, EX!X'100', SSAPF, WKSEG, GAP) IF J = 0 START IF EXECP -> (PROCUSER) START DOPER2(PROCUSER . ": ". BASEFILE) FINISH -> BASEF CONNECTED FINISH DOPER2( BASEFILE) DOPERR("BASEF", 2, J) -> TRY BASEF IF TRIED BASEF = NO ! IF PROCUSER = "VIEWER" ORC PROCUSER = "HORTIH" ORC PROCUSER = "LIBRAR" C THEN FAIL("No Service", 0) ! DEFAULT BASE: BASEFILE = "" SITE = X'300' IF USER = "VOLUMS" SITE = X'340' IF USER = "MAILER" SITE = X'480' IF USER = "SPOOLR" SITE = X'4C0' IF USER = "FTRANS" ! IF SITE = X'380' AND TRIED DEF SS = NO START TRIED DEF SS = YES BASEFILE = DIRCOM_DEFAULT SUBSYS -> TRY CONNECT UNLESS BASEFILE = "" FINISH CONNECT SITE: K = 0 S = USER ! IF X'380' <= SITE <= X'400' START BITS = SITE >> 9; ! ie 1 or 2 K = 32; ! anticipate multiple use of these sites ACOUNT = ADDR(DIRCOM_SUBSYS SITE COUNT) ACOUNT = ACOUNT + 24 IF BITS = 2 S = SITEN(BITS) FINISH ! SITE = SITE + SUPLVN S START ! J = DISCSEG CONNECT(DIRDISC, SITE, WKSEG, X'100' ! SSACR, 64, K); ! exec and read FAIL(S, J) UNLESS J = 0 ! BASEFAD = BASEFILE SEG << 18; ! now check if more than one segment H == RECORD(BASEFAD) GAP = 1 IF H_NEXTFREEBYTE > X'40000' START WKSEG = WKSEG + 1 GAP = GAP + 1 J = DISCSEG CONNECT(DIRDISC, SITE + X'40', WKSEG, X'100' ! SSACR, 64, K); ! exec and read FAIL(S, J) UNLESS J = 0 FINISH ! IF K = 0 START DOPER2(PROCUSER . " on site X'" . HTOS(SITE, 3)) FINISH ELSE START *LXN_ACOUNT *INCT_(XNB +0) ! FINISH BASEF CONNECTED: UINF_PROCNO = PROCESS; ! set up various items in UINF UINF_MARK = 1 UINF_SESS IC LIM = SESSKIC; ! thousands of instructions UINF_SCT BLOCK AD = SCT BLOCK AD UINF_SCIDENSAD = SCT BLOCK AD + SCT HDR_IDENS ARRAY RELST UINF_SCIDENS = SCT HDR_HORIZ VECTOR BOUND - 1; ! number of system call ids UINF_AIOSTAT = AIOSTAT UINF_SCT DATE = SCT HDR_DT STAMP UINF_AACCT REC = ACCTSA UINF_AIC REVS = AREVS ! IF BASEFILE = "" START BASEFILE = "S#DISC.SITEX" . HTOS(SITE, 3) FINISH ! UINF_BASEFILE = BASEFILE UINF_HISEG = HISEG ! WKSEG = 0 WKGAP = 0 J = DCONNECTI(FULL, -1, 11, 0, WKSEG, WKGAP) IF J = 0 START LOGH == RECORD(WKSEG<<18 + X'10000') PROCLIST == LOGH_PROCLIST PROCLIST(UINF_PSLOT)_SITE = BITS J = DDISCONNECTI(FULL, -1, 0) FINISH BASEFAD = BASEFILE SEG << 18 H == RECORD(BASEFAD) BGLASEG = BASEFILESEG + GAP ! !--------- CREATE AND CONNECT BGLA --------- FILE = "#BGLA".SSUFF ! J = DDESTROYF(FILE, PFSYS, 7) ! J = DCREATEF(FILE, PFSYS, 256, 5, 7, DA); ! TEMPFILE FAIL(FILE, J) UNLESS J = 0 WKSEG = BGLASEG GAP = 0 J = DCONNECTI(FILE, PFSYS, WR, SSAPF, WKSEG, GAP) FAIL(FILE, J) UNLESS J = 0 ! !--------------------Connect Directors' monitoring file------------------------------- ! ! IF THE USER HAS HIS OWN LOGFILE, ! THIS IS USED ELSE DIRLOG, IF ! NEITHER OF THESE IS AVAILABLE ! MAINLOG IS USED. NOTE THAT ! DIRLOG IS 2 SEGMENTS LONG AND ! SEGMENT 16 MUST NOT BE OVERWRITTEN!!!!!!! ! ! Connect local logfile if it exists S = NIH_LOGFILE UNLESS S = "" START J = DDISCONNECTI(DIRLOG,-1,1) DIRLOGAD = 0 LOGACTION = DT ! LOG WKSEG = 14 GAP = 2; ! have only allowed TWO segments J = DCONNECTI(S,PFSYS,WRSH,SSAPF,WKSEG,GAP) IF J = 0 START LOG ACTION = WRTOF ! DT FILE1AD = WKSEG << 18 WRS("NEWSESSION") FINISH ELSE START DERR2(S, 2, J) WKSEG = 14 GAP = 0 J = DCONNECTI(DIRLOG, -1, WRSH, (DIR WRITE APF>>4<<4)!(DEFAULT SSACR-1), WKSEG, GAP) IF J = 0 START DIRLOGAD = WKSEG << 18 LOG ACTION = DT ! DLOG FINISH ELSE DOPERR("DIRLOG", 2, J) FINISH FINISH ! ! ! ! !---------------------------------------------------------------------- ! ! K = 0 ! GAP = 0 ! J = CREATE AND CONNECT("VOLUMS.FCOUNT", -1, 4, %C ! (3<<24) + 64 + 16 + 1, WRSH, SSAPF, %C ! K, GAP) ! %IF J = 0 %START ! FACILITYA = K << 18 + 32 ! %FINISH ! ! ! UNLESS DDVSN&3 = 0 START J = COM_SUPVSN WRSS("Supervisor ", STRING(ADDR(J))) PRINTSTRING("Director VSN "); WRSN(VSN, DDVSN&3) WRSN("Sload disc ", DDVSN>>18) FINISH !------------------------------- Interactive -------------------------- J = UINF_REASON IF J = INTER OR J = NEWSTART OR J = FORK START ! Interactive startup - connect console streams FILE = "T#IT" . SSUFF; ! clear buffer, not done at create for speed WKSEG = 0; ! (new-copy connect) GAP = 0 J = DCONNECTI(FILE, PFSYS,16!WR, DIRWRITEAPF, WKSEG,GAP) FAIL(FILE, J) UNLESS J = 0 J = DDISCONNECTI(FILE, PFSYS, 0) FAIL(FILE, J) UNLESS J = 0 ! -> MAP IF UINF_REASON = FORK; ! can connect streams only once ! ! ! The FAIL routine must not be called after this point. ! (see note in the routine) ! K = 0 AGAIN: J=CONNECT STREAM(0,UINF_ASYNC DEST ! 1) C ! CONNECT STREAM(1,UINF_SYNC2 DEST) IF J#0=K START J=DISABLE STREAM(J,0,4); ! IGNORE FLAG J=DISABLE STREAM(J,1,4); ! IGNORE FLAG J=DISCONNECT STREAM(0); ! IGNORE FLAG J=DISCONNECT STREAM(1); ! IGNORE FLAG K=1 -> AGAIN FINISH DOPERR("TERMINAL I/O", 2,J) UNLESS J = 0 FINISH MAP: IOSTAT == RECORD(AIOSTAT) IOSTAT_INSTREAM = UINF_INSTREAM IOSTAT_OUTSTREAM = UINF_OUTSTREAM ! PREPARE TO ENTER(BASEFAD + H_CODERELST, SSACR) STOP: DOPERR(FILE, 2, J); ! catastrophic failure DSTOP(22) END ; ! DIRECTOR ! !----------------------------------------------------------------------- ! integerfn NEWCHK PERM SPACE(record (FF)name F, record (FDF)name FD) ! To be called before changing a file from "TEMP" to "PERMANENT". ! Checks whether the effect is to exceed permanent filespace limit ! (result 83). If OK, result 0. integer NKB,PERM SPACE,MAXKB if FD_CODES&TEMPFS=0 then result =0; ! no problem NKB=FD_PGS << 2 PERM SPACE=F_TOTKB-F_TEMPKB MAXKB=F_MAXKB MAXKB=DEFAULT MAXKB if MAXKB=0 if PERM SPACE+NKB>MAXKB then result =83; ! filespace limit exceeded. result =0 end ; ! CHK PERM SPACE ! !----------------------------------------------------------------------- ! externalintegerfn DPERMISSIONI( c string (18)OWNERINDEX, USER, c string (8)DATE, c string (11)FILE, c integer FSYS, TYPE, ADRPRM) integer ARCHIVE,SET CHKSUM, IP integer I, N, A, NPD integer J,MAXP,FINDAD,POK,NQS,PRM,CH,FLAG STRING (18)UNAME, INAME, IND byteintegername LINK ! 9876543210 constinteger SET USED=B'0000101111' constinteger SET CSUM=B'1011101110'; ! WHETHER TO RESET CHECKSUMFOR ARCHIVE INDEX record (FDF)name FL record (FF)name F record (PDF)name PD record (FDF)arrayname FDS record (PDF)arrayname PDS integername ARCH SEMA switch DP(0:11) conststring (5)FN = "DPERM" SET CHKSUM = 0 ! FLAG = UIO(OWNERINDEX, UNAME, INAME, IND) -> OUT UNLESS FLAG = 0 ! IP = 0 IP = FILE INDEX PERM(IND, FSYS) IF TYPE = 26 ! FLAG = FINDA(IND, FSYS, FINDAD, 0) -> OUT UNLESS FLAG = 0 ! F==RECORD(FINDAD) ! if TYPE<16 start ARCHIVE = 0 FLAG = PP(ADDR(F_SEMA),F_SEMANO,FN) -> OUT unless FLAG = 0 finish else start TYPE=TYPE - 16 ARCHIVE=1 ARCH SEMA==F_ASEMA; ! in the main index FLAG=NEWAINDA(IND,FSYS,FINDAD); ! replace FINDAD with addr of arch file index -> OUT UNLESS FLAG = 0 F == RECORD(FINDAD); ! remap to appropriate #ARCH ! SET CHKSUM=(1<<TYPE) & SET CSUM if SET CHKSUM#0 start FLAG=APP(ARCH SEMA) -> OUT UNLESS FLAG = 0 finish finish ! FLAG = 8 -> VOUT unless 0 <= TYPE <= 11 PDS == ARRAY(FINDAD+F_PDSTART, PDSF) NPD = (F_SDSTART - F_PDSTART) // PDSIZE ! unless 6<=TYPE<=9 or TYPE > 10 start ; ! file relevant -> VOUT IF ARCHIVE # 0 = TYPE; ! OWNP NOT STORED FOR #ARCH FILES FLAG = S11OK(FILE) -> VOUT UNLESS FLAG = 0 ! if ARCHIVE=0 C then J=NEWFIND(FINDAD,0,FILE) c else J=NEWAFIND2(FINDAD,FILE,DATE,0) ! FLAG=32 -> VOUT IF J = 0; ! NOT EXIST ! FDS == ARRAY(FINDAD+F_FDSTART, FDSF) FL==FDS(J) ! FLAG=20; ! file on offer ! Not allowed to alter permission list for a file while the file ! is on offer, because DOFFER uses the permission list. if archive = 0 and FL_CODES&OFFER#0 and (TYPE=2 or TYPE=3 or TYPE=5) c then -> VOUT ! finish ! ! NQS = -1; ! error value -> BAD unless LENGTH(USER) = 6 UCTRANSLATE(ADDR(USER)+1, 6) N = 0 cycle J = 1, 1, 6 CH = BYTEINTEGER(ADDR(USER) + J) N = N + 1 if CH = '?' -> BAD unless '0'<=CH<='9' or 'A'<=CH<='Z' or CH='?' repeat NQS = N; ! number of queries BAD: POK=0 if 0<=ADRPRM<=7 or (0<=ADRPRM<=15 and TYPE<=1) start POK = 1 ADRPRM = ADRPRM ! 1 IF ADRPRM & 6 > 0 FINISH ! if (1<<TYPE)&SET USED#0 and ARCHIVE=0 start ! SET WRITTEN-TO BIT AND CLEAR TEMPFI BITS. ! (THIS CAN GET DONE EVEN THOUGH SOME FAILURE MIGHT OCCUR ! BELOW PREVENTING THE PERMISSION BEING SET OR WITHDRAWN) ! Check permanent filespace allocation, before making permanent. FLAG=NEWCHK PERM SPACE(F, FL) if FLAG#0 then -> VOUT FL_ARCH=FL_ARCH ! 5 unless FL_CODES & TEMPFS = NO start F_TEMPFILES = F_TEMPFILES - 1 F_TEMPKB = F_TEMPKB - FL_PGS << 2 FL_CODES = FL_CODES & (¬TEMPFS) finish finish FLAG=46 -> DP(TYPE) ! DP(0): if POK=0 then -> VOUT; ! set OWNP FL_OWNP=ADRPRM -> DDONE ! DP(1): if POK=0 then -> VOUT; ! set EEP FL_EEP=ADRPRM -> DDONE ! DP(2): ! PUT USER IN LIST FOR FILE -> DP(1) if NQS = 6 LINK == FL_PHEAD MAXP = 16; ! max no of perms in file list -> DP6 DP(6): ! PUT USER IN LIST FOR INDEX -> VOUT if ADRPRM&2 > 0 and DTRYING << 23 >= 0 -> DP(11) if NQS = 6 LINK == F_FIPHEAD MAXP = 15; ! max for index list, leave one 'space' for F_EEP DP6: -> VOUT if POK = 0 -> VOUT if NQS < 0 ! N = 0 WHILE 0 < LINK <= NPD AND N < MAXP CYCLE PD == PDS(LINK) IF PD_NAME = USER START ; ! found PD_PERM = ADRPRM; ! set new permission -> DDONE FINISH LINK == PD_LINK N = N + 1 REPEAT ! FLAG = 49; ! permission list full -> VOUT IF LINK > 0 OR N >= MAXP ! FLAG = 17; ! insufficient pds cycle I = 1, 1, NPD PD == PDS(I) if PD_NAME = "" start PD_NAME = USER PD_PERM = ADRPRM PD_LINK = 0 LINK = I FLAG = 0 exit finish repeat -> VOUT ! DP(3): ! REMOVE USER FROM LIST FOR FILE LINK == FL_PHEAD -> DP7 DP(7): ! REMOVE USER FROM LIST FOR INDEX F_EEP = 0 AND -> DDONE IF NQS = 6 LINK == F_FIPHEAD DP7: -> VOUT if NQS < 0 ! FLAG = 50; ! user not in list N = 0 WHILE 0 < LINK <= NPD AND N < 16 CYCLE PD == PDS(LINK) IF PD_NAME = USER START LINK = PD_LINK PD = 0 -> DDONE FINISH LINK == PD_LINK N = N + 1 REPEAT -> VOUT ! DP(4): ! GIVE LIST FOR FILE FLAG=45 if VAL(ADRPRM,16 + 16*8,1,DCALLERS PSR)=0 then -> VOUT INTEGER(ADRPRM+4)=FL_OWNP INTEGER(ADRPRM+8)=FL_EEP J = FL_PHEAD -> DP8 ! DP(8): ! GIVE LIST FOR INDEX INTEGER(ADRPRM + 4) = 7 INTEGER(ADRPRM + 8) = F_EEP J = F_FIPHEAD DP8: INTEGER(ADRPRM+12) = 0; ! spare A = ADRPRM + 16 N = 0 while NPD >= J > 0 cycle PD == PDS(J) STRING(A) = PD_NAME BYTEINTEGER(A+7) = PD_PERM A = A + 8 J = PD_LINK N = N + 1 exit if N > 15 repeat ! IF TYPE = 8 AND F_EEP > 0 START ; ! TEMP ************ STRING(A) = "??????" BYTEINTEGER(A+7) = F_EEP A = A + 8 N = N + 1 FINISH ! INTEGER(ADRPRM) = A - ADRPRM -> DDONE ! DP(5): ! DESTROY LIST FOR FILE LINK == FL_PHEAD -> DP9 DP(9): ! DESTROY LIST FOR INDEX LINK == F_FIPHEAD DP9: while NPD >= LINK > 0 cycle PD == PDS(LINK) LINK = PD_LINK PD = 0 repeat LINK = 0 unless LINK = 0 -> DDONE ! DP(10): ! GIVE PERMITTED ACCESS MODES OF USER TO FILE if NQS#0 then -> VOUT; ! no ?'s allowed if USER=UNAME start PRM=FL_OWNP & 7; ! REMOVE "DESTROY-INHIBIT" BIT if ARCHIVE#0 then PRM=7; ! OWNP NOT STORED FOR ARCHIVE FILES -> GIVEP finish PRM = NEWFILEPERM(FINDAD, FL, USER) GIVEP: IF PRM = -1 START IF ARCHIVE = 0 C THEN PRM = F_EEP & 7 C ELSE PRM = IP FINISH PRM = PRM ! 1 IF PRM & 6 > 0 FLAG=45 if VAL(ADRPRM,4,1,DCALLERS PSR)=0 then -> VOUT INTEGER(ADRPRM)=PRM -> DDONE DP(11): ! set index EEP -> VOUT IF POK = 0 -> VOUT IF ADRPRM & 2 > 0 AND DTRYING <<23 >= 0 F_EEP = ADRPRM DDONE: FLAG=0 VOUT: if SET CHKSUM#0 start FLAG=NEWAINDA("", J, J) if FLAG = 0 AVV(ARCH SEMA) finish VV(ADDR(F_SEMA), F_SEMANO) if ARCHIVE=0 OUT: result =flag end ; ! DPERMISSIONI ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN FILE INDEX PERM(STRING (31)INDEX, INTEGER FSYS) ! RESULT IS PROCUSERS WHOLE INDEX ! PERMISSION TO INDEX ON FSYS INTEGER I, J, K, ADR, N, CH, AP RECORDFORMAT RF(STRING (6)USER, BYTEINTEGER PRM) RECORD (RF)NAME R BYTEINTEGERARRAY A(0:143) ADR = ADDR(A(0)) J = DPERMISSIONI(INDEX, PROCUSER, "", "", FSYS, 8, ADR) RESULT = 0 UNLESS J = 0 ! N = INTEGER(ADR) RESULT = 0 UNLESS N > 16 ! AP = ADDR(PROCUSER) ! CYCLE I = 0, 1, 1 CYCLE J = ADR+16, 8, ADR+N-8 R == RECORD(J) IF I = 0 START RESULT = R_PRM IF R_USER = PROCUSER FINISH ELSE START CYCLE K = 1, 1, 6 CH = BYTEINTEGER(J+K) -> NOT THIS ONE UNLESS CH = '?' OR C CH = BYTEINTEGER(AP+K) REPEAT RESULT = R_PRM FINISH NOT THIS ONE: REPEAT REPEAT RESULT = 0 END ; ! FILE INDEX PERM ! !----------------------------------------------------------------------- ! ! Functions for password encryption on EMAS 2900 - Gordon Brebner, Feb 1982. ! ! ! EXTERNALINTEGERFN ENCRYPT(INTEGER MODE, STRING (63)PASS, LONGINTEGERNAME E, INTEGERNAME K, DT) ! ! MODE = 0 compare supplied PASS and K with E ! 1 return E, K and DT ! ! Computes the function f(key) = p(key) mod P, where P = 2^64-a. ! The function p is the following polynomial : ! x^n0 + x^n1*c1 + x^3*c2 + x^2*c3 + x*c4 + c5 ! The parameter "key" is an unsigned 64 bit quantity. ! For more details about why this function is useful, see a paper by Purdy ! in CACM 17 (August 1974) 442 - 445. ! constlonginteger a = 59 constlonginteger n0 = 1<<24-3, n1 = 1<<24-63 constlonginteger c1 = -83, c2 = -179, c3 = -257, c4 = -323, c5 = -363 INTEGER J, FLAG, W, OLD LONGINTEGER L STRING (255)S, S1 BYTEINTEGERNAME B longintegerfn add(longinteger u, y) ! Adds two unsigned 64 bit integers together modulo 2^64-a. integer flag *lb_0 *lss_u+4 *uad_y+4 *st_y+4 *lss_u *jcc_8, <nc> *uad_1 *jcc_8, <nc> *adb_1 nc:*uad_y *st_y *jcc_8,<on> *adb_1 on:*stb_flag y = y+a if flag # 0 or -a <= y <= -1 result = y end longintegerfn emul(integer w, z) ! Multiplies two unsigned 32 bit integers together. longinteger r *lss_w *imyd_z *st_r if w < 0 start *lss_r *uad_z *st_r finish if z < 0 start *lss_r *uad_w *st_r finish result = r end longintegerfn mod(longinteger u) ! Returns a 64 bit unsigned integer modulo 2^64-a. u = u+a if -a <= u <= -1 result = u end longintegerfn lsh(longinteger u) ! Multiplies a 64 bit unsigned integer by 2^32 modulo 2^64-a. result = add(emul(a, integer(addr(u))), u<<32) end longintegerfn mul(longinteger u, y) ! Multiplies two unsigned 64 bit integers together modulo 2^64-a. integername ul, uh, yl, yh ul == integer(addr(u)+4); uh == integer(addr(u)) yl == integer(addr(y)+4); yh == integer(addr(y)) result = add(lsh(add(lsh(mod(emul(uh, yh))), add(mod(emul(uh, yl)), mod(emul(ul, yh))))), mod(emul(ul, yl))) end longintegerfn exp(longinteger p, integer n) ! Raises an unsigned 64 bit integer p to a 32 bit ! unsigned integer power n modulo 2^64-a. longinteger r result = 1 if n = 0 r = 0 while n # 0 cycle if n & 1 > 0 start if r = 0 c then r = p c else r = mul(r, p) finish p = mul(p, p) n = n>>1 repeat result = r end ! ! ! RESULT = 8 IF MODE = 0 AND E = 0; ! zero always fails to check ! IF MODE = 0 AND E >> 31 = 1 START ; ! checking old pass RESULT = 8 UNLESS LENGTH(PASS) = 4 UCTRANSLATE(ADDR(PASS)+1, 4) ! L = E *LSD_L *STUH_B *ST_OLD OLD = OLD !! (-1) W = 4 S = STRING(ADDR(W) + 3) UCTRANSLATE(ADDR(S)+1, 4) RESULT = 8 UNLESS PASS = S RESULT = 0 FINISH ! IF MODE = 1 START *RRTC_0 *STUH_B *ST_J K = J FINISH ! S1 = " " CHARNO(S1, 1) = K & 255 S = PASS . S1 UCTRANSLATE(ADDR(S)+1, LENGTH(S)) S = S . S WHILE LENGTH(S) < 32 W = K *LSS_W *LUH_0 *ST_L B == BYTEINTEGER(ADDR(L) + 7) ! CYCLE J = 1, 1, 32 *LSD_L *ROT_5 *ST_L B = (B + CHARNO(S, J)) & 255 REPEAT ! L = MOD(L) L = add(mul(exp(L, n1), add(exp(L, n0-n1), c1)), add(mul(L, add(mul(L, add(mul(L, c2), c3)), c4)), c5)) ! FLAG = 0 IF MODE = 0 START ; ! checking IF E >> 32 = 0 START ; ! single length *LSD_L *AND_X'000000007FFFFFFF' *ST_L FINISH FLAG = 8 UNLESS E = L FINISH ELSE E = L AND DT = PACKDT; ! return double length value ! RESULT = FLAG END ; ! ENCRYPT ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN D SET PASSWORD(STRING (6)USER, INTEGER FSYS, WHICH, STRING (63)OLD, NEW) INTEGER J, INDAD, DT, TRUNC RECORD (HF)NAME H J = IN2(8) -> OUT UNLESS J = 0 ! J = UNOK(USER) -> OUT UNLESS J = 0 ! J = 8 -> OUT IF OLD = "" -> OUT IF NEW = "" ! TRUNC = 0; ! give warning if password longer than 11 and will be trunc TRUNC = 19 AND LENGTH(NEW) = 11 IF LENGTH(NEW) > 11 ! J = HINDA(USER, FSYS, INDAD, 0) -> OUT UNLESS J = 0 ! H == RECORD(INDAD) J = 93 -> OUT UNLESS PROCUSER = "DIRECT" OR UINF_REASON < 2 -> OK IF USER = PROCUSER -> OK IF DTRYING << 21 < 0 -> OUT IF H_BASEFILE = "" -> OUT UNLESS CHARNO(USER, 4) = 'U' -> OUT UNLESS PROCUSER = H_SUPERVISOR OK: J = ENCRYPT(0, OLD, H_DWSP, H_DWSPK, DT) IF J = 0 START IF WHICH = 0 C THEN J = ENCRYPT(1, NEW, H_DWSP, H_DWSPK, H_DWSPDT) C ELSE J = ENCRYPT(1, NEW, H_BWSP, H_BWSPK, H_BWSPDT) H_PASSFAILS = 0 FINISH OUT: J = TRUNC IF J = 0 RESULT = OUT(J, "SII") END ; ! DSETPASSWORD ! !----------------------------------------------------------------------- ! EXTERNALINTEGERFN MOVE SECTION(INTEGER FSYS1, STARTP1, FSYS2, STARTP2, EPGS) INTEGER FROMDEV, FSYS, BITNO, RELPAGE, MOVE FLAG, RW, FAIL INTEGER J INTEGERNAME F, PAGE RECORD (PARMF)NAME Q RECORD (PARMF)P UNLESS STARTP1>>19 = 0 AND STARTP2>>19 = 0 START WRSNT("MVSC P1", STARTP1, 6) WRSNT(" P2", STARTP2, 2) RESULT = 25 FINISH ! FROM DEV = 2; ! disc IF FSYS1 = -1 START FROMDEV = 5; ! "LP" STARTP1 = 0 FINISH ! ! OUT TO LOCAL CONTROLLER TO CHECK THAT THE BLOCK WHOSE START PAGE IS ! "PAGE" IS NOT STILL ACTIVE. THIS IS BECAUSE AN ORDINARY DISCONNECT DOES ! NOT WAIT UNTIL ALL PAGE-OUTS ARE COMPLETE. ! But we suppress this check for UNPRG, so that we can unprg active software ! without messages. This is indicated by the TOP BIT being set in FSYS1. ! (This feature is used only by function DPRGP). ! J = 0 F == FSYS1 PAGE == STARTP1 L: UNLESS F = -1 START IF F < 0 C THEN F = F & 255 C {remove top bit} ELSE START Q == RECORD(OUTPAD) Q = 0 Q_DEST = (F << 24) ! PAGE *OUT_17 UNLESS Q_DEST = 0 START WRSN("MVSC BLOCK STILL ACTIVE", Q_DEST) RESULT = 25 FINISH FINISH FINISH ! IF J = 0 START J = 1 F == FSYS2 PAGE == STARTP2 -> L FINISH ! P = 0 P_DEST = X'00240000' P_P1 = X'00020000' ! (FROMDEV<<24) ! EPGS P_P2 = FSYS1 P_P3 = STARTP1 P_P4 = FSYS2 P_P5 = STARTP2 P_P6 = M'MVSC' IF EPGS < 5 C THEN DOUT11I(P) C ELSE DOUTI(P) MOVE FLAG = P_P1 !*********************************************************************** ! About the BULK MOVER: ! CALLED ON SERVICE 36 TO TRANSFERS GROUPS OF PAGES BETWEEN * ! FAST DEVICES. REPLIES ARE ON SERVICE 37. * ! FAST DEVICE TYPES ARE:- * ! DEV=1 DRUM (SPECIFIED AS SERVICE & PAGE IN AMEM ) * ! DEV=2 DISCFILE (SPECIFIED AS [MNEMONIC OR LVN] & PAGE) * ! DEV=3 ARCHTAPE (SPECIFIED AS SERVICE(PREPOSND BY VOLUMS)) * ! DEV=4 TAPE (SPECIFIED AS STRING(6)LAB,BYTE CHAP NO) * ! DEV=5 FUNNY (READS GIVE ZERO PAGE,WRITES IN HEX TO LP) * ! DEV=6 SINK (THROWS AWAY INPUT FOR TAPE CHECKING) * ! * ! CAN HANDLE UP TO FOUR MOVES AT A TIME. EACH MOVE USES * ! ONE BUFFER AND APART FROM CLEARS ONLY HAS ONE TRANSFER * ! OUTSTANDING AT ANY ONE TIME TIME. * ! ALL WRITES ARE CHECKED BY RE-READING * ! Failure flags (returned in P_P1) are as follows (at least * ! for moves to/from disc): * ! * ! P_P1 = RW<<24 ! FAIL<<16 ! RELPAGE * ! * ! where RW = 1 means a READ failed * ! 2 means a WRITE failed. * ! FAIL = flag from PDISC: * ! 1 = transferred with errors (i.e. cyclic * ! check fails) * ! 2 = request rejected * ! 3 = transfer not effected (e.g. flagged * ! track encountered) * ! and RELPAGE = relative page no of failing page, counting * ! first page of request as one. * !********************************************************************** RESULT = 0 IF MOVE FLAG = 0 ! RW=MOVE FLAG>>24 FAIL=(MOVE FLAG>>16) & 255 RELPAGE=MOVE FLAG&X'FFFF' IF ((RW=1 AND FSYS1>=0) OR RW=2) AND (FAIL=1 OR FAIL=3) START IF RW=1 START FSYS=FSYS1 BITNO=STARTP1 FINISH ELSE START FSYS=FSYS2 BITNO=STARTP2 FINISH FAIL=BAD PAGE(1,FSYS,BITNO + RELPAGE - 1) FINISH RESULT = 25 END ; ! MOVE SECTION ! !----------------------------------------------------------------------- ! INCLUDE "PD22S_B04CONT" ROUTINE REF LOCK(RECORD (PARMF)NAME Q, INTEGER ADR, LEN) INTEGER K,DUM,EPAGE BYTES,TIMES RECORD (PARMF)NAME P TIMES=0 P==RECORD(OUTPAD) UNTIL (TIMES>4 OR P_DEST#-1) CYCLE ! NOW REFERENCE ALL THE PAGES EPAGE BYTES=EPAGE SIZE<<10 K=ADR & (¬(EPAGE BYTES - 1)) WHILE K<ADR+LEN CYCLE DUM=BYTEINTEGER(K) K=K+EPAGE BYTES REPEAT P=Q *OUT_25; ! SPECIAL PON AND SUSPEND TIMES=TIMES+1 REPEAT Q=P END ; ! REF LOCK ! !----------------------------------------------------------------------- ! INCLUDE "PD22S_B07ARCHIVE" EXTERNALINTEGERFN DACCEPT(STRING (31)FILE INDEX, FILE, NEWNAME, INTEGER FSYS) RESULT =DTRANSFER(FILE INDEX,PROCUSER,FILE,NEWNAME,FSYS,PROCFSYS,0) END ; ! DACCEPT ! !----------------------------------------------------------------------- ! !<DCHECKBPASS externalintegerfn D CHECK BPASS(string (6)USER, string (63)BPASS, integer FSYS) ! ! This procedure allows a privileged process to check that a supplied ! background password corresponds to the version in the index for USER ! on FSYS. Result is zero if password is correct. !> INTEGER INDAD, J, DT RECORD (HF)NAME H J = IN2(8) -> OUT UNLESS J = 0 ! J = UNOK(USER) -> OUT UNLESS J = 0 ! J = 93 -> OUT UNLESS DTRYING << 22 < 0 ! J = HINDA(USER, FSYS, INDAD, 0) -> OUT UNLESS J = 0 ! H == RECORD(INDAD) J = ENCRYPT(0, BPASS, H_BWSP, H_BWSPK, DT) J = 96 UNLESS J = 0 OUT: RESULT = OUT(J, "S") END ; ! D CHECK BPASS ! !----------------------------------------------------------------------- ! !<DDELAY externalintegerfn DDELAY(integer N) ! ! This procedure checks that 1 <= N <= 7200. If it is not, result 8 is ! returned. Otherwise, the process is suspended for N seconds and then ! returns with result 0 !> INTEGER J RECORD (PARMF)NAME P REAL Z J = IN2(14) -> OUT UNLESS J = 0 ! J = 8 -> OUT UNLESS 1 <= N <= 7200 Z = N Z = (Z*1000000) / (1024*1024) IF N > 20 N = INT(Z) ! P == RECORD(OUTPAD) ! UNTIL P_DEST = 0 CYCLE P_DEST = 0 *OUT_6; ! accept and discard outstanding msgs REPEAT ! P = 0 P_DEST = X'A0002'; ! single kick P_P1 = UINF_SYNC1DEST P_P2 = N *OUT_5 ! J = 0 OUT: RESULT = OUT(J, "I") END ; ! DDELAY ! !----------------------------------------------------------------------- ! !<DDONATE externalintegerfn DDONATE(string (6)USER, integer FSYS, UNITS) ! ! Allows a process owner, who has no group holder, to transfer some of ! his funds to USER on FSYS or, if USER has a group holder, to the group ! holder. !> INTEGER J, INDAD RECORD (HF)NAME NH, ONH INTEGERNAME INUTS, ONUTS STRING (6)GP J = IN2(19) -> OUT UNLESS J = 0 ! J = UNOK(USER) -> OUT UNLESS J = 0 ! ONH == RECORD(OWNIND) ! J = 60; ! this user not allowed, as he uses somebody else's units -> OUT IF ONH_GPHOLDR # "" ONUTS == ONH_INUTS ! UNITS=0 IF UNITS<0 IF UNITS>ONUTS THEN UNITS=ONUTS ! J = 8 -> OUT IF UNITS < 1 ! J = HINDA(USER, FSYS, INDAD, 0) -> OUT UNLESS J = 0 ! GP = "" NH == RECORD(INDAD) INUTS == NH_INUTS GP = NH_GPHOLDR ! IF GP # "" START FSYS = -1 J = HINDA(GP, FSYS, INDAD, 0) -> OUT UNLESS J = 0 NH == RECORD(INDAD) AND INUTS == NH_INUTS FINISH ! ONUTS=ONUTS-UNITS INUTS=INUTS+UNITS ! WRS3N("DONATE", USER, GP, UNITS) ! J=0 OUT: RESULT = OUT(J, "SII") END ; ! DDONATE ! !----------------------------------------------------------------------- ! !<DEXECMESS externalintegerfn DEXECMESS(string (6)USER, integer SACT, LEN, ADR) ! ! Checks that the message held at ADR of length LEN is readable and ! not > 2000 characters. Adds a prefix of ! **user.bel.date.time ! to the message then sends it to USER on the SYNC1 service, act X16. ! Control returns to the sending process immediately, the result being ! 0 successful ! 8 LEN invalid ! 45 message not readable ! 61 no process belonging to user !> ! ! INTEGER J, L BYTEINTEGERARRAY MSG(0:2050) RECORD (PARMF)P J = IN2(25) -> OUT UNLESS J = 0 ! J = UNOK(USER) -> OUT UNLESS J = 0 ! J = 8 -> OUT UNLESS 0 < LEN < 2000 ! J = 45 -> OUT IF VAL(ADR, LEN, 0, 0) = 0 ! MSG(0) = 0 ATTU(STRING(ADDR(MSG(0)))) L = MSG(0) MOVE(LEN, ADR, ADDR(MSG(L+1))) ! P_DEST = X'FFFF0016' J = TXTMESS(USER, P, 1, 0, L+LEN, ADDR(MSG(1)), -1, SACT) OUT: RESULT = OUT(J, "S") END ; ! DEXECMESS ! !----------------------------------------------------------------------- ! !<DFILENAMES externalintegerfn DFILENAMES(string (18)FILE INDEX, record (OINFF)arrayname INFS, integername FILENO, MAXREC, NFILES, integer FSYS, TYPE) ! ! This procedure delivers, in the record array INFS (which should be ! declared (0:n)), a sequence of records describing the on-line files ! (for TYPE=0), archived files (for TYPE=1) or backed-up files (for ! TYPE=2) belonging to file index FILE INDEX on fsys FSYS (or -1 if not ! known). ! ! MAXREC is set by the caller to specify the maximum number of records he ! is prepared to accept in the array INFS, and is set by Director to be ! the number of records actually returned. ! ! NFILES is set by Director to be the number of files actually held on ! on-line storage or on archive storage, depending on the value of TYPE. ! ! FILENO is used only for TYPE=1. Filenames are stored in chronological ! order (by archive date). FILENO is set by the caller to specify the ! "file-number" from which descriptions are to be returned, zero ! represents the most recently archived file. (The intention here is to ! allow the caller to receive subsets of descriptions of a possibly very ! large number of files.) ! ! The format of the records delivered in the array INF is as follows: ! ! For on-line files (32 bytes) ! %string(11)NAME, %integer SP12, KBYTES, %byteinteger ARCH, CODES, ! CCT, OWNP, EEP, USE, CODES2, SSBYTE, FLAGS, POOL, DAYNO, SP31) ! ! and for archived files (40 bytes) ! %string(11)NAME, %integer KBYTES, %string(8)DATE, %string(6)TAPE, ! %integer CHAPTER, FLAGS) ! ! TAPE and CHAPTER are returned null to unprivileged callers. !> ! ! ! constinteger A INF LEN = 40; ! BYTES constinteger O INF LEN = 32 constinteger W = 1 record (OINFF)name INF ! integer J, FINDAD, SWITCH, LFILENO, IP, FP integer NFD, I integer NGIVEN, TB, K, GLOBAL STRING (18)UNA, INA, IND record (FF)name F record (FDF)arrayname FDS RECORD (FDF)NAME FL CONSTSTRING (11)FN = "Dfilenames " J = IN2(26) -> RES UNLESS J = 0 ! SWITCH = MAXREC >> 31 MAXREC = (MAXREC << 1) >> 1 ! J = 8 -> RES UNLESS 0 <= TYPE <= 2 -> RES UNLESS 0 < MAXREC <= X'10000' ! J = UIO(FILE INDEX, UNA, INA, IND) -> RES UNLESS J = 0 ! J = 45 K = AINFLEN K = OINFLEN IF TYPE = 0 K = K * MAXREC TB = X'18000000' + K *LDA_INFS+4 *LDTB_TB *VAL_(LNB +1) *JCC_3,<RES> *LD_INFS+8 *VAL_(LNB +1) *JCC_3,<RES> -> RES UNLESS VAL(ADDR(FILENO), 4, 1, D CALLERS PSR) = YES -> RES UNLESS VAL(ADDR(MAXREC), 4, 1, D CALLERS PSR) = YES -> RES UNLESS VAL(ADDR(NFILES), 4, 1, D CALLERS PSR) = YES -> RES UNLESS VAL(ADDR(INFS(0)),K,W,DCALLERS PSR) = YES ! GLOBAL = NO; ! checking now to see if caller has unqualified access GLOBAL = YES IF UNA = PROCUSER OR DTRYING << 23 < 0 ! J = FINDA(IND, FSYS, FINDAD, 0) -> RES UNLESS J = 0 ! NFILES = 0 ! UNLESS TYPE=0 start J = AFILENAMES(IND, INFS, FILENO, MAXREC, NFILES, FSYS, TYPE - 1, GLOBAL) -> RES FINISH ! LFILENO = FILENO LFILENO = 0 IF SWITCH = 0 ! NGIVEN = 0 F == RECORD(FINDAD) J = PP(ADDR(F_SEMA),F_SEMANO,FN) -> RES UNLESS J = 0 ! NFD = (F_SIZE << 9 - F_FDSTART) // FDSIZE FDS == ARRAY(FINDAD + F_FDSTART, FDSF) IP = F_EEP & 7 cycle I = 1, 1, NFD FL == FDS(I) exit if FL_NAME = ""; ! never used FP = NEWFILEPERM(FINDAD, FL, PROCUSER) IF FL_NAME # ".NULL" ANDC FL_CODES2 & OLDGE = 0 ANDC (GLOBAL = YES OR FP > 0 OR (FP < 0 AND IP > 0)) C START NFILES = NFILES + 1; ! count good and relevant names if NFILES > LFILENO ANDC NGIVEN < MAXREC C start ; ! can supply another name INF == INFS(NGIVEN) INF = 0 INF_NAME = FL_NAME INF_NKB = FL_PGS<<2 INF_ARCH = FL_ARCH INF_CODES = FL_CODES INF_CCT = FL_CCT INF_OWNP = FL_OWNP INF_EEP = FL_EEP INF_USE = FL_USE INF_CODES2 = FL_CODES2 INF_SSBYTE = FL_SSBYTE INF_DAYNO = FL_DAYNO NGIVEN = NGIVEN + 1 finish finish repeat MAXREC = NGIVEN VV(ADDR(F_SEMA), F_SEMANO) RES: RESULT = OUT(J, "S----JJJII") END ; ! DFILENAMES ! !----------------------------------------------------------------------- ! !<DFINFO externalintegerfn DFINFO(string (31)FILE INDEX, FILE, integer FSYS, ADR) ! ! This procedure returns detailed information about the attributes of ! file FILE belonging to file index FILE INDEX on disc-pack FSYS, in a ! record written to address ADR. ! ! A caller of the procedure having no permitted access to the file will ! receive an error result of 32, as though the file did not exist. ! ! The format of the record returned is: ! recordformat DFINFOF(integer NKB, RUP, EEP, APF, USE, ARCH, FSYS, CONSEG, CCT, CODES, byteinteger SP1, DAYNO, POOL, CODES2, integer SSBYTE, string (6)OFFER) ! ! where ! NKB the number of Kbytes (physical file size) ! RUP the caller's permitted access modes ! EEP the general access permission ! APF 1-4-4 bits, right-justified, giving respectively the Execute, ! Write and Read fields of APF, if the file is connected in ! this VM ! USE the current number of users of the file ! ARCH the value of the archive byte for the file (see procedure ! DFSTATUS) ! FSYS disc-pack number on which the file resides ! CONSEG the segment number at which the file is connected in the ! caller's VM, zero if not connected ! CCT the number of times the file has been connected since this ! field was last zeroed (see procedure DFSTATUS) ! CODES information for privileged processes ! SP1 spare ! DAYNO Day number when file last connected ! POOL ! CODES2 information for internal use ! SSBYTE information for the subsystem's exclusive use ! OFFER the username to which the file has been offered, otherwise ! null !> RECORD (DFINFOF)NAME FIF integer J,GAP,FLAG,PRM,NS, NPD, SEG integer FINDAD string (6) ON OFFER TO STRING (31)UNAME, INAME, FNAME, INDEX, FULL record (FF)name F record (FDF)name FL record (FDF)arrayname FDS record (PDF)arrayname PDS conststring (7)FN = "DFINFO " FLAG=IN2(27) -> OUT UNLESS FLAG = 0 ! FLAG = UFO(FILE INDEX, FILE, UNAME, INAME, FNAME, INDEX, FULL) -> OUT UNLESS FLAG = 0 ! FLAG = MAP FILE INDEX(INDEX, FSYS, FINDAD, FN) -> OUT IF FLAG > 0 ! F == RECORD(FINDAD) FDS == ARRAY(FINDAD + F_FDSTART, FDSF) PDS == ARRAY(FINDAD + F_PDSTART, PDSF) NPD = (F_SDSTART - F_PDSTART) // PDSIZE FLAG = 32; ! not exist or no access J = NEWFIND(FINDAD, 0, FNAME) -> VOUT if J = 0 FL == FDS(J) PRM = NEWFILE PERM(FINDAD, FL, PROCUSER) IF PRM = -1 START PRM = F_EEP & 7 PRM = PRM ! 1 IF PRM & 6 > 0 FINISH ON OFFER TO="" if FL_CODES&OFFER#0 start J = FL_PHEAD ON OFFER TO = PDS(J)_NAME if NPD >= J > 0 finish if PRM=0 and ON OFFER TO#PROCUSER start -> VOUT unless DTRYING << 23 < 0 finish ! FIF==RECORD(ADR) FIF=0 FIF_NKB=FL_PGS << 2 FIF_RUP=PRM FIF_EEP=FL_EEP FIF_USE=FL_USE FIF_ARCH=FL_ARCH FIF_FSYS=FSYS ! Drop top bit from CONSEG, which if set indicates thast the file ! is not to be disconnected (except at DSTOP), nor changed in ! size or access. SEG = CONSEG(FULL,FSYS,GAP)<<1>>1; FIF_CONSEG = SEG if SEG>0 then GIVE APF(FIF_APF,J,NS,SEG) FIF_CCT=FL_CCT FIF_CODES=FL_CODES FIF_DAYNO=FL_DAYNO FIF_CODES2=FL_CODES2 FIF_SSBYTE=FL_SSBYTE FIF_OFFER=ON OFFER TO FLAG=0 VOUT: VV(ADDR(F_SEMA), F_SEMANO) OUT: RESULT = OUT(FLAG, "SSI") END ; ! DFINFO ! !----------------------------------------------------------------------- ! !<DFSTATUS externalintegerfn DFSTATUS(string (31)FILE INDEX, FILE, integer FSYS, ACT, VALUE) ! ! This procedure is supplied to enable the attributes of file FILE ! belonging to file index FILE INDEX on disc-pack FSYS to be modified, ! as follows. ! ! Parameter VALUE is for use by the archive/backup program (ACT=13), ! and by the subsystem (ACT=18), otherwise it should be set to zero. ! ! ACT ACTION ! ! 0 HAZARD Remove CHERISHed attribute ! ! 1 CHERISH Make subject to automatic System back-up procedures ! Note: If the file is one of ! SS#DIR, SS#OPT or SS#PROFILE ! then the 'archive-inhibit' bit is also set. ! Similarly, the 'archive-inhibit' bit is ! cleared by HAZARD for these files. ! ! 2 UNARCHIVE Remove the "to-be-archived" attribute ! ! 3 ARCHIVE Mark the file for removal from on-line to archive ! storage. ! ! 4 NOT TEMP Remove the "temporary" attribute. ! ! 5 TEMPFI Mark the file as "temporary", that is, to be ! destroyed when the process belonging to the file ! owner stops (if the file is connected at that ! time), or at system start-up. ! ! 6 VTEMPFI Mark the file as "very temporary", that is, to be ! destroyed when it is disconnected from the owner's ! VM. ! ! 7 NOT PRIVATE May now be written to magnetic tape either for ! back-up or archive. May be called only by ! privileged programs. ! ! 8 PRIVATE Not to be written to magnetic tape either for ! back-up or archive. May be called only by ! privileged programs. ! ! 9 SET CCT Set the connect count for the file to VALUE. ! ! 10 ARCH Operation 0 (PRIVILEGED). ! Shift ARCH byte usage bits (2**3 to 2**6 ! inclusive) left one place. If A is the resulting ! value of the ARCH byte, set bit 2**7 if ! (A>>2)&B'11111' = VALUE. ! ! 11 ARCH Operation 1 (PRIVILEGED). ! Set currently-being-backed-up bit (bit 2**1 in ! ARCH byte), unless the file is currently connected ! in write mode, when error result 52 is given. ! ! 12 ARCH Operation 2 (PRIVILEGED). ! Clear currently-being-backed-up bit (2**1) and ! has-been-connected-in-write-mode bit (2**0). ! ! 13 ARCH Operation 3 (PRIVILEGED). ! Set archive byte to be bottom 8 bits of VALUE and ! clear the UNAVAilable bit in CODES. ! ! 14 ARCH Operation 4 (PRIVILEGED). ! Clear the UNAVAilable and privacy VIOLATed bits in ! CODES. Used by the back-up and archive programs ! when the file has been read in from magnetic tape. ! ! 15 CLR USE Clear file use-count and WRITE-CONNECTED status ! (PRIVILEGED). ! ! 16 CLR NOARCH Clear archive-inhibit bit in CODES. PRIVILEGED - ! for System ! ! 17 SET NOARCH Set archive-inhibit bit in CODES. Library use ! ! 18 SSBYTE Set SSBYTE to be the bottom 8 bits of VALUE (byte ! for a subsystem's exclusive use). ! ! 19 ARCH Operation 5 (PRIVILEGED). ! Set the WRCONN bit in CODES2. Used to prevent any ! user connecting the file in write mode during ! back-up or archive. ! ! 20 ARCH Operation 6 (PRIVILEGED). ! Clear the WRCONN bit in CODES2. Used when back-up ! is complete. ! ! 21 DAYNO Set DAYNO to bottom 8 bits of VALUE !> ! ! Structure of the 'ARCH' byte: ! 2**0 file has been connected W ! 1 file is being backed up ! 2 file has been connected ! 3 usage over last 4 'periods' ! 4 " " " " ! 5 " " " " ! 6 " " " " ! 7 file to be archived ! integer J, K, FINDAD, FLAG, FKB, CODES STRING (255)A, B STRING (31)UNAME, INAME, FNAME, INDEX, FULL switch DF(0:21) record (FDF)name FL record (FF)name F record (FDF)arrayname FDS ! ! 3322222222221111111111 ! 10987654321098765432109876543210 constinteger PRIVFLAGS=B'00000000001110111111110110000000' constinteger SET USED =B'00000000000001000000001000000010' ! CONSTSTRING (26)NOTTOBEARCHIVED = " SS#DIR SS#OPT SS#PROFILE " conststring (9)FN = "DFSTATUS " FLAG=IN2(28) -> OUT UNLESS FLAG = 0 ! FLAG=8 -> OUT UNLESS 0<=ACT<=21 ! FLAG = UFO(FILE INDEX, FILE, UNAME, INAME, FNAME, INDEX, FULL) -> OUT UNLESS FLAG = 0 ! FLAG = 93 J = DTRYING << 23 -> OUT IF (1<<ACT)&PRIVFLAGS#0 AND J >= 0 ! IF UNAME # PROCUSER START -> OUT UNLESS J < 0 OR FILE INDEX PERM(INDEX, FSYS) & 2 > 0 FINISH ! FLAG = MAP FILE INDEX(INDEX, FSYS, FINDAD, FN) -> OUT IF FLAG > 0 F == RECORD(FINDAD) ! FLAG = 32 J = NEWFIND(FINDAD, 0, FNAME) -> VOUT if J = 0 FDS == ARRAY(FINDAD + F_FDSTART, FDSF) FL == FDS(J) ! UCTRANSLATE(ADDR(FNAME)+1, LENGTH(FNAME)); ! for the 'NOT TO BE ARCH' test FKB=FL_PGS << 2 CODES = FL_CODES FLAG = 0 -> DF(ACT) ! ! ! DF(0): !HAZARD unless CODES & CHERSH = NO start ! was cherished CODES = CODES - CHERSH F_CHERFILES = F_CHERFILES - 1 F_CHERKB = F_CHERKB - FKB IF NOT TO BE ARCHIVED -> (" " . FNAME . " ") START CODES = CODES & (¬NOARCH) FINISH finish -> DFR DF(1): ! CHERISH if CODES & CHERSH = NO start ! not cherished CODES = CODES ! CHERSH F_CHERFILES = F_CHERFILES + 1 F_CHERKB = F_CHERKB + FKB IF NOT TO BE ARCHIVED -> (" " . FNAME . " ") START CODES = CODES ! NOARCH FINISH finish -> DFR DF(2): ! CLR ARCHIVE BIT FL_ARCH=FL_ARCH & 127 -> DFR DF(3): ! SET ARCHIVE BIT FL_ARCH=FL_ARCH ! 128 -> DFR DF(4): ! CLR TEMPFILE BITS ! Check first that permanent filespace allocation will not be exceeded. unless CODES & TEMPFS = NO start ! temporary FLAG = NEWCHKPERMSPACE(F, FL) -> DFR unless FLAG = 0 F_TEMPFILES = F_TEMPFILES - 1 F_TEMPKB = F_TEMPKB - FKB CODES = CODES & (¬TEMPFS) finish -> DFR DF(5): ! SET TEMPFILE BIT if FL_OWNP&8#0 then FLAG=51 and -> DFR; ! "INHIBIT-DESTROY" BIT if CODES & TEMPFS = NO start ! not temp yet F_TEMPFILES = F_TEMPFILES + 1 F_TEMPKB = F_TEMPKB + FKB finish CODES = CODES ! TEMPFI -> DFR DF(6): ! SET VTEMPFILE BIT if FL_OWNP&8#0 then FLAG=51 and -> DFR; ! "INHIBIT-DESTROY" BIT if CODES & TEMPFS = NO start ! not temp yet F_TEMPFILES = F_TEMPFILES + 1 F_TEMPKB = F_TEMPKB + FKB finish CODES=CODES ! VTEMPF -> DFR DF(7): ! PRIVILEGED. CLEAR 'PRIVATE' BIT CODES=CODES & (¬PRIVAT) -> DFR DF(8): ! PRIVILEGED. SET 'PRIVATE' BIT CODES=CODES ! PRIVAT -> DFR DF(9): ! SET CONNECT COUNT BYTE FL_CCT<-VALUE -> DFR DF(10): ! PRIVILEGED. ARCH 0. SHIFT BITS ! J to be new value of 4 periods' use-bits without the ARCHIVE bit. ! K to be the bits other than the 4 period bits & current bit, and bit ! 2**7 is set additionally if J>>2 matches VALUE. J=((FL_ARCH & B'01111100') <<1) & B'01111111' K=FL_ARCH & B'10000011' if J>>2=VALUE then K=K ! X'80' FL_ARCH=J ! K -> DFR DF(11): ! PRIVILEGED. ARCH 1. SET "CURRENTLY-BEING-BACKED-UP" BIT if CODES&WRCONN#0 then FLAG=52 and -> DFR FL_ARCH=FL_ARCH ! 2; ! FILE-IS-BEING-BACKED-UP -> DFR DF(12): ! PRIVILEGED. CLEAR "CURRENTLY-BEING-BACKED-UP' BIT FL_ARCH=FL_ARCH & (¬3) -> DFR DF(13): ! PRIVILEGED. ARCH 3. SET WHOLE ARCHIVE BYTE. FL_ARCH<-VALUE CODES=CODES & (¬UNAVA) -> DFR DF(14): ! PRIVILEGED. ARCH 4. CLEAR UNAVAILABLE AND VIOLAT BITS CODES=CODES & (¬(VIOLAT ! UNAVA)) -> DFR DF(15): ! PRIVILEGED. CLEAR USE AND WRCONN (LOCAL EMERGENCIES) FL_USE=0 FL_CODES2=(FL_CODES2&(¬WRCONN)) -> DFR DF(16): ! PRIVILEGED. CLEAR 'NOARCHIVE' BIT CODES=CODES & (¬NOARCH) -> DFR DF(17): ! PRIVILEGED. SET 'NOARCHIVE' BIT. CODES=CODES ! NOARCH -> DFR DF(18): ! SET SSBYTE FL_SSBYTE<-VALUE -> DFR DF(19): ! PRIVILEGED. ARCH 5. SET 'WRITE-CONNECTED' BIT if FL_CODES2 & WRCONN#0 then FLAG=52 and -> DFR; ! ALREADY SET FL_CODES2=FL_CODES2 ! WRCONN -> DFR DF(20): ! PRIVILEGED. ARCH 6. CLEAR 'WRITE-CONNECTED' BIT FL_CODES2=FL_CODES2 & (¬WRCONN) -> DFR DF(21): ! PRIVILEGED, set DAYNO to bottom byte of VALUE FL_DAYNO <- VALUE DFR: FL_CODES = CODES FL_ARCH=FL_ARCH ! 5 if (1<<ACT)&SET USED#0 VOUT: VV(ADDR(F_SEMA), F_SEMANO) OUT: RESULT = OUT(FLAG, "SSII") END ; ! DFSTATUS ! !----------------------------------------------------------------------- ! !<DFSYS externalintegerfn DFSYS(string (31)FILE INDEX, integername FSYS) ! ! This procedure is used to determine on which disc pack a user's FILE ! INDEX resides. If FSYS is set to -1 before the procedure is called, ! it is set with the first disc-pack number on which FILE INDEX is ! found. If FSYS is set non-negative, only that disc-pack number is ! searched. If FILE INDEX is not found, FSYS is unchanged. !> INTEGER FINDAD, FLAG, INFSYS, OUTFSYS, J STRING (31)UNAME, INAME, IND FLAG = IN2(29) -> RES UNLESS FLAG = 0 ! FLAG = UIO(FILE INDEX, UNAME, INAME, IND) -> RES UNLESS FLAG = 0 ! FLAG = 45 INFSYS = -2 OUTFSYS = -2 -> RES IF VAL(ADDR(FSYS), 4, 1, DCALLERS PSR) = 0 INFSYS = FSYS OUTFSYS = INFSYS ! FLAG = 8 -> RES IF INFSYS < -1 OR INFSYS > 99 FLAG = FINDA(IND, OUTFSYS, FINDAD, 0) FSYS = OUTFSYS IF FLAG = 0 ! RES: ! If any FSYS is closing, ! see if any index segment on a closing FSYS is connected in this VM. ! If so, empty the Director (index area) VM (and empty the HOTTOP). ! IF FSYS WARN#0 START CYCLE J = 0, 1, 99 IF FSYS USECOUNT(J) # 0 = AV(J,0) C THEN EMPTY DVM AND EXIT REPEAT FINISH ! RESULT = OUT(FLAG, "SJ") END ; ! DFSYS ! !----------------------------------------------------------------------- ! !<DLOCK externalintegerfn DLOCK(integer ADR, LEN, longintegername STB) ! ! This privileged procedure is used exceptionally to lock down areas ! of virtual memory in main store for short durations. ADR and LEN ! determine the extent of virtual storage to be made resident. ! ! On successful return STB contains a word-pair which may be used as a ! local segment table base for specially created local segment and ! page tables describing the locked-down area. This word-pair may be ! passed, for example, to the GPC routine to achieve a "private" data ! transfer to or from the locked-down area. ! ! Up to 3 separate non-overlapping areas may be simultaneously locked ! by repeated calls of this procedure. Exceptionally it may not be ! possible for the locking to be effected, for example if the System ! is unusually busy or if little main store is available, in this ! case result 68 is given. !> INTEGER STB0,STB1 INTEGER J,FLAG RECORD (DRF)NAME ENTRY RECORD (PARMF)Q FLAG = IN2(35) -> OUT UNLESS FLAG = 0 ! FLAG = 93 -> OUT UNLESS DTRYING << 13 < 0 ! FLAG = 8 -> OUT UNLESS ADR>0 AND 0<LEN <=2<<18; ! arb limit of 2 segs length ! CYCLE J=0,1,2 -> GOT E IF DRS LOCKED(J)_DR0=0 REPEAT FLAG=82; ! MAX AREAS LOCKED -> OUT GOTE: ENTRY==DRS LOCKED(J) ! FLAG=45; ! AREA NOT AVAILABLE IF VAL(ADR,LEN,1,DCALLERS PSR)=0 THEN -> OUT; ! AREA NOT AVAIABLE -> OUT IF VAL(ADDR(STB), 8, 1, DCALLERS PSR) = 0 Q = 0 Q_P1=1; ! LOCK Q_P5=X'18000000' ! LEN Q_P6=ADR ! We reference all the pages in the data area, to get them into ! main store. If they are not still there at the time of the OUT 25, then ! P_DEST will be set to -1, and we try again, up to four times (say). LOUTP=Q LOUTP STATE="DLOCK" REF LOCK(Q,ADR,LEN) LOUTP STATE="DLOCK exit" ! FLAG=68; ! LOCKDOWN FAILS IF Q_DEST=-1 THEN -> OUT; ! LOCK-DOWN FAILS ! STB0=Q_P5 STB1=Q_P6 STB=(LENGTHENI(STB0)<<32) ! STB1 ENTRY_DR0=X'18000000' ! LEN ENTRY_DR1=ADR FLAG=0 OUT: RESULT = OUT(FLAG, "XI") END ; ! DLOCK ! !----------------------------------------------------------------------- ! !<DLOWERACR externalintegerfn DLOWER ACR(integer NEWACR) ! ! This privileged procedure (currently accessible from ACR 4) enables ! the calling procedure to acquire a lower ACR (>0) and optionally to ! acquire PRIV (bit 2**4 set in parameter NEWACR) and/or DGW and ISR ! in SSR (bit 2**5 set in NEWACR). !> INTEGER CALLERS ACR, LNBHERE, PRIV, DGW INTEGERNAME CALLERS PSR WORD CONSTINTEGER DGW AND ISR = X'1800000'; ! diagnostic write and image store read DIRFN = 44 PRIV = NEWACR & 16 << 14; ! ie X'00040000' DGW = NEWACR&32 NEWACR = (NEWACR&(¬(16+32))) << 20 *STLN_LNBHERE CALLERS PSR WORD == INTEGER(LNBHERE+4) CALLERS ACR = CALLERS PSR WORD<<8>>28<<20 RESULT = 8 UNLESS 0<NEWACR<=CALLERS ACR ! CALLERS PSR WORD = (CALLERS PSR WORD&X'FF0FFFFF') ! NEWACR ! PRIV ! IF DGW#0 START *LSS_(3); ! PICK UP SSR *OR_DGW AND ISR *ST_(3); ! PUT BACK WITH DGW AND ISR BITS SET FINISH ! RESULT = 0 END ; ! DLOWER ACR ! !----------------------------------------------------------------------- ! INCLUDE "PD22S_B10TAPES" !<DMAIL externalintegerfn DMAIL(record (PARMF)name P, integer LEN, ADR) ! ! Like DSPOOL but for MAILER, see below !> INTEGER FLAG FLAG = IN2(39) -> OUT UNLESS FLAG = 0 ! FLAG = DSPOOLBODY("MAILER", P, LEN, ADR) OUT: RESULT = OUT(FLAG, "") END ; ! DMAIL ! !----------------------------------------------------------------------- ! !<DMESSAGE externalintegerfn DMESSAGE(string (255)USER, integername LEN, integer ACT, FSYS, ADR) ! ! This is identical to a call of DMESSAGE2 with INVOC = 0 !> INTEGER J J = IN2(40) -> OUT UNLESS J = 0 ! J = DMESSAGE2(USER,LEN,ACT,0,FSYS,ADR); ! INVOC ZERO OUT: RESULT = OUT(J, "") END ; ! DMESSAGE ! !----------------------------------------------------------------------- ! !<DMESSAGE2 externalintegerfn DMESSAGE2(string (255)USER, integername LEN, integer ACT, INVOC, FSYS, ADR) ! ! ACT=0 Delivers to ADR the next message sent to this user process. ! LEN should be previously set to the maximum length you are ! prepared to accept, it is set by the procedure to the ! number of bytes returned. LEN will be set to zero if no ! further messages are available. ! ! ACT=1 Sends message (ADR, LEN) to USER on FSYS. INVOC is the ! invocation number of the paged process to which the message ! is to be notified. Currently LEN is restricted to 2000 bytes. ! Result 61 from this call means that a process belonging to ! USER is not currently present (but the message goes into his ! file anyway). ! ! ACT=2 Determines whether USER on FSYS currently has a process of ! invocation number INVOC. Result 61 if not, else zero. !> ! ! Used by TELL and shouldnt be used to send things to SPOOLR ! ! ACT = 0 deliver next message to ADR. LEN is limit of area ! result 45 if area invalid, and len is set to no o fbytes passed. ! act = 1 send message (ADR,LEN) to user on disc FSYS. RECORD (PARMF) P; ! DUMMY, NOT REQ FOR ASYNC TXT MESS SWITCH DM(0:2) INTEGER L,J,SEG,GAP,FAD,FLAG,DIR ACR,TYPE INTEGER NKB, ALLOC, MODE, APF BYTEINTEGERARRAY MSG(0:2050) STRINGNAME S FLAG = IN2(41) -> DMFLAG UNLESS FLAG = 0 ! FLAG=8 -> DMFLAG UNLESS 0 <= ACT <= 2 UNLESS PROCUSER = "VOLUMS" START ; ! reject tell's to exec procs -> DMFLAG IF ACT > 0 AND EXECP -> (USER) FINISH ! FLAG = 11 -> DMFLAG IF ACT > 0 # UNOK(USER) ! *LSS_(1); ! PSR *ST_J DIR ACR=(J>>20)&15 FLAG=45 -> DM(ACT) DM(0): ! deliver next message -> DMFLAG IF VAL(ADDR(LEN), 4, 1, D CALLERS PSR) = NO -> DMFLAG IF VAL(ADR, LEN, 1, D CALLERS PSR) = NO ! NKB = 4 ALLOC = X'0B000051' MODE = WRSH APF = DIRACR << 4 ! 15 SEG = 0 GAP = 0 FLAG = CREATE AND CONNECT("#MSG", FSYS, NKB, ALLOC, C MODE, APF, SEG, GAP) FLAG = 86 AND -> DMFLAG UNLESS FLAG = 0 ! FAD=SEG<<18 FLAG=RDCIRC(LEN,FAD,ADR) -> DMFLAG DM(1): ! send message (adr,len) to user -> DMFLAG IF VAL(ADDR(LEN), 4, 0, 0) = 0 IF VAL(ADR,LEN,0,0)=0 THEN -> DMFLAG FLAG=8 IF LEN>2000 THEN -> DMFLAG; ! relatively arb, but to keep it within an EPAGE (size of #MSG file) S == STRING(ADDR(MSG(0))) S = " " S = "" IF USER = "SPOOLR" ATTU(S) L = LENGTH(S) MOVE(LEN, ADR, ADDR(S) + L + 1) P = 0 P_DEST = X'FFFF0016' TYPE = 0; ! ASYNC TYPE = 1 IF USER = "SPOOLR"; ! SYNC - THESE STATEMENTS UNTIL "DSPOOL" IN USE FLAG = TXTMESS(USER, P, TYPE, INVOC, L+LEN, ADDR(MSG(1)), FSYS, 0) -> DM2 IF TYPE = 0 -> DMFLAG DM(2): ! is user present ? ! WE RECKON TO TEST USER'S SFI HERE, TO CHECK WHETHER YOU'RE ALLOWED TO KNOW.. FLAG=ASYNC MSG(USER,INVOC,NULDACT,0,0) DM2: IF SITE = ERCC START NOT SO FAST; ! my friend ! FINISH DMFLAG: RESULT = OUT(FLAG, "S--I") END ; ! DMESSAGE2 ! !----------------------------------------------------------------------- ! !<DOFFER externalintegerfn DOFFER(string (31)FILE INDEX, OFFERTO, FILE, integer FSYS) ! ! This procedure causes file FILE belonging to file index FILE INDEX on ! disc-pack FSYS to be marked as being "on offer" to user OFFERTO. The ! file may not be connected in any virtual memory either at the time of ! the call of this procedure or subsequently while the file is on offer. ! The procedure DACCEPT is used by user OFFERTO to accept the file. A ! file may be on offer to at most one user. ! ! An offer may be withdrawn by calling this procedure with OFFERTO set ! as a null string. !> integer NPD, FINDAD integer J,FLAG STRING (31)UNAME1, INAME1, FNAME1, INDEX1, FULL1 record (FDF)name FL record (FF)name F record (FDF)arrayname FDS record (PDF)arrayname PDS record (PDF)name PD ! conststring (7)FN = "DOFFER " FLAG=IN2(53) -> OUT UNLESS FLAG = 0 ! FLAG = UFO(FILE INDEX, FILE, UNAME1, INAME1, FNAME1, INDEX1, FULL1) -> OUT UNLESS FLAG = 0 ! -> POK IF UNAME1 = PROCUSER -> POK IF DTRYING << 6 < 0 -> POK IF FILE INDEX PERM(INDEX1, FSYS) & 2 > 0 FLAG=93 -> OUT POK: FLAG = MAP FILE INDEX(INDEX1, FSYS, FINDAD, FN) -> OUT IF FLAG > 0 F == RECORD(FINDAD) ! FLAG = 32 J = NEWFIND(FINDAD, 0, FILE) -> VOUT if J = 0 FDS == ARRAY(FINDAD + F_FDSTART, FDSF) PDS == ARRAY(FINDAD+F_PDSTART, PDSF) FL == FDS(J) ! if OFFERTO="" start FLAG=0 if FL_CODES&OFFER=0 then -> VOUT PD == PDS(FL_PHEAD); ! remove first permission FL_PHEAD = PD_LINK PD = 0 FL_CODES=FL_CODES & (¬OFFER) -> VOUT finish ! FLAG=20 if FL_CODES&OFFER#0 then -> VOUT; ! ALREADY ON OFFER ! FLAG=5 if FL_CODES&VIOLAT#0 then -> VOUT ! FLAG=42; ! FILE CONNECTED unless FL_USE=0 then -> VOUT ! FLAG = UNOK(OFFER TO) -> VOUT UNLESS FLAG = 0 ! NPD = (F_SDSTART - F_PDSTART) // PDSIZE cycle J = 1, 1, NPD; ! look for a free PD PD == PDS(J) if PD_NAME = "" start ; ! found a free one PD_NAME = OFFER TO PD_PERM = 1 PD_LINK = FL_PHEAD FL_PHEAD = J; ! link in new PD FL_CODES = FL_CODES ! OFFER FLAG = 0 -> VOUT finish repeat FLAG = 17; ! no free PD VOUT: VV(ADDR(F_SEMA), F_SEMANO) OUT: RESULT = OUT(FLAG, "SSSI") END ; ! DOFFER ! !----------------------------------------------------------------------- ! !<DPERMISSION externalintegerfn DPERMISSION(string (31)FILE INDEX, USER, string (8)DATE, string (11)FILE, integer FSYS, TYPE, ADRPRM) ! ! This procedure allows the caller to set access permissions, or specific ! preventions, for file connection to individual users, groups of users ! or to all users to file FILE belonging to file index FILE INDEX. It ! also allows a caller to determine the modes (if any) in which he may ! access the file. ! ! TYPE determines the service required of the procedure: ! ! TYPE Action ! ! 0 set OWNP (not for files on archive storage) ! 1 set EEP ! 2 put USER into the file list (see "Use of file ! access permissions", below) ! 3 remove USER from file list ! 4 return the file list ! 5 destroy the file list ! 6 put USER into the index list (see "Use of file ! access permissions", below) ! 7 remove USER from the index list ! 8 return the index list ! 9 destroy the index list ! 10 give modes of access available to USER for FILE ! 11 set EEP for the file index as a whole ! ! TYPEs 0 to 9 and 11 are available only to the file owner and to ! privileged processes. For TYPE 10, ADRPRM (see below) should be the ! address of an integer into which the access permission of USER to the ! file is returned. If USER has no access to the file, error result 32 ! will be returned from the function, as though the file did not exist. ! If the file is on archive storage, TYPE should be set to 16 plus the ! above values to obtain the equivalent effects. ! ! ADRPRM is either the permission being attached to the file, bit ! values interpreted as follows: ! ! all bits zero prevent access ! 2**0 allow READ access ! 2**1 allow WRITE access not allowed for files ! 2**2 allow EXECUTE access on archive storage ! 2**3 If TYPE = 0, prevent the file from being ! destroyed by e.g. DDESTROY, DDISCONNECT (and ! destroy). ! or, except for type 10, it is the address of an area into which access ! permission information is to be written ! ! %recordformat(%integer BYTES RETURNED, OWNP, EEP, SPARE, ! %record(EF)%array INDIV PRMS(0:15)) ! ! and EF is ! %recordformat EF(%string(6)USER, %byteinteger PERMISSION) ! ! where: ! ! BYTES indicates the amount of data returned. ! RETURNED ! ! OWNP is the file owner's own permission to the file, or the ! requesting user's "net" permission if the caller of the ! procedure is not the file owner (see "Use of file access ! permissions", below). ! ! EEP is the general (all users) access permission to the file ! ("everyone else's permission"). ! ! UPRM The PERMISSION values in the sub-records are those ! for the corresponding users or groups of users denoted by ! USER. Up to 16 such permissions may be attached to a ! file. ! ! Use of file access permissions ! ! The general scheme for permissions is as follows. With each file ! there are associated: ! ! OWNP the permission of the owner of the file to access it ! ! EEP everyone else's permission to access it (other than users ! whose names are explicitly or implicitly attached to the ! file) ! ! INDIV PRMS a list of up to 16 items describing permissions for ! individual users, e.g. ERCC00, or groups of users, e.g. ! ERCC?? (specifying all usernames of which the first four ! characters are "ERCC") ! ! In addition, a user may attach a similar list of up to 16 items to ! his file index as a whole and an EEP for the file index. These ! permissions apply to any file described in the index along with those ! attached to that particular file. ! In determining the mode or modes in which a particular user may access ! a file, the following rules apply: ! ! 1. If the user is the file owner then OWNP applies. ! ! 2. Otherwise, if the user's name appears explicitly in the list for ! the file, the corresponding permission applies. ! ! 3. Otherwise, if the user's name is a member of a group of users ! represented by a list item for the file, the corresponding ! permission applies. ! ! 4. Otherwise EEP applies if greater than zero. ! ! 5. Otherwise, if the user's name appears explicitly in the list for ! the index, the corresponding permission applies. ! ! 6. Otherwise, if the user's name is a member of a group of users ! represented by a list item for the index, the corresponding ! permission applies. ! ! 7. Otherwise, everybody else's permission to the file index applies. ! ! In the event of a user's name appearing more than once (implicitly) ! within groups specified in a single list, the actual list item to be ! selected to give the permission should be regarded as indeterminate. !> INTEGER FLAG, IP STRING (31)UNAME, INAME, INDEX FLAG = IN2(60) ->OUT UNLESS FLAG = 0 ! FLAG = UIO(FILE INDEX, UNAME, INAME, INDEX) -> OUT UNLESS FLAG = 0 ! -> POK IF UNAME = PROCUSER -> POK IF TYPE = 10 -> POK IF TYPE = 26 -> POK IF DTRYING << 23 < 0 IP = FILE INDEX PERM(INDEX, FSYS) -> POK IF IP & 2 > 0 -> POK IF (TYPE=4 OR TYPE=8) AND IP & 1 > 0 ! FLAG = 93 -> OUT POK: FLAG = DPERMISSIONI(INDEX, USER, DATE, FILE, C FSYS, TYPE, ADRPRM) ! OUT: RESULT = OUT(FLAG, "SSSSII") END ; ! DPERMISSION ! !----------------------------------------------------------------------- ! !<DSFI externalintegerfn DSFI(string (31)FILE INDEX, integer FSYS, TYPE, SET, ADR) ! ! This procedure is used to set or read information in file index FILE ! INDEX (or user record in some cases) on disc-pack FSYS. TYPE specifies ! which data item is to be referenced (see list below). SET must be 1 ! to write the data item into the index, or 0 to read the item from the ! index. ADR is the address of an area, which must be available in write ! or read mode, to or from which the data item is to be transferred. ! ! TYPE Data item Data type & size ! ! 0 BASEFILE name (the file to be connected ! and entered at process start-up) string(18) ! ! 1 DELIVERY information (to identify string(31) ! slow-device output requested by the ! index owner) ! ! 2 CONTROLFILE name (a file for use by the ! subsystem for retaining control information) string(18) ! ! 3 ADDRTELE address and telephone number of user string(63) ! ! 4 INDEX USE (may not be reset) ! Gives (in successive integers from ADR): ! a) number of files ! b) number of file descriptors currently in use ! c) number of free file descriptors ! d) index size (Kbytes) ! e) Number of section descriptors (SDs) ! f) Number of free section descriptors ! g) Number of permission descriptors (PDs) ! h) Number of free permission descriptors integer(x8) ! ! 5 Foreground and background passwords ! (reading is a privileged operation), a zero ! value means "do not change" integer(x2) ! ! 6 Date last logged-in: (Y-70)<<9 ! (M<<5) ! D and ! date last started (non-interactive) (same) ! (may not be reset) integer(x2) ! ! 7 ACR level at which the process owning this ! index is to run (may be set only by privileged ! processes) integer ! ! 8 Director Version (may be set only by privileged ! processes) integer(x2) ! ! 9 ARCHIVE INDEX USE (may not be reset) ! Gives (in successive integers from ADR): ! a) number of archived files ! b) number of archived Kbytes ! c) number of backed-up files ! d) number of backed-up Kbytes ! e) index size (Kbytes) ! f) number of file descriptors ! g) number of free file descriptors ! h) number of permission descriptors ! i) number of free permission descriptors integer(x9) ! ! 10 Stack size (Kbytes) integer ! ! 11 Limit for total size of all files in disc ! storage (Kbytes) (may be set only by privileged ! processes integer ! ! 12 Maximum file size (Kbytes) (may be set only by ! privileged processes) integer ! ! 13 Current numbers of interactive and batch ! processes, respectively, for the user (may ! not be reset) integer(x2) ! ! 14 Process concurrency limits (may be set only ! by privileged processes). The three words ! denote respectively the maximum number of ! interactive, batch and total processes which ! may be concurrently running for the user. ! (Setting the fields to -1 implies using ! the default values, currently 1, 1 and 1.) integer(x3) ! ! 15 When bit 2**0 is set, TELL messages to the ! index owner are rejected with flag 48. integer ! ! 16 Set Director monitor level (may be set only ! by privileged processes) integer(x2) ! ! 17 Set SIGNAL monitor level (may be set only ! by privileged processes) integer ! ! 18 Initials and surnames of user (may ! be set only by privileged processes) string(31) ! ! 19 Director monitor file string(11) ! ! 20 Thousands of instructions executed, interactive ! and batch modes (may be reset only by ! privileged processes) integer(x2) ! ! 21 Thousands of instructions executed (current ! session only) integer ! ! 22 Thousands of instructions executed in Director ! procedures (current process session only) ! (may not be reset) integer ! ! 23 Page-turns, interactive and batch modes ! (may be reset only by privileged processes) integer(x2) ! ! 24 Page-turns (current process session only) integer ! ! 25 Thousands of bytes output to slow-devices ! (local or remote) (may be reset only by ! privileged processes) integer ! ! 26 Thousands of bytes input from slow-devices ! (local or remote) (may be reset only by ! privileged processes) integer ! ! 27 Milliseconds of OCP time used, interactive ! and batch modes (may be reset only by ! privileged processes) integer(x2) ! ! 28 Milliseconds of OCP time used (current ! session only) integer ! ! 29 Seconds of interactive terminal connect time ! (may be reset only by privileged processes) integer ! ! 30 No. of disc files, total disc Kbytes, no. of ! cherished files, total cherished Kbytes, no. ! of temporary files, total temporary Kbytes ! (cannot be reset) integer(x6) ! ! 31 No. of archive files, total archive Kbytes integer(x2) ! ! 32 Interactive session length in minutes integer ! 0 or 5 <= x <= 240 ! ! 33 Funds integer ! ! 34 The FSYS of the Group Holder of the index integer ! owners funds, if he has a GH ! ! 35 Test BASEFILE name string(18) ! ! 36 Batch BASEFILE name string(18) ! ! 37 Group Holder of funds for scarce resources string(6) ! ! 38 Privileges integer ! ! 39 Default LP string(15) ! ! 40 Dates passwords last changed integer(x2) ! (may not be reset) ! ! 41 Password data integer(x8) ! ! 42 Get accounting data integer(x16) ! ! 43 Mail count integer ! (may be reset only by privileged processes) ! ! 44 Supervisor string(6) ! ! 45 Secure record about 512 bytes ! ! 46 Gateway access id string(15) ! ! 47 File index attributes byte ! ! 48 User type byte !> ! THIS FUNCTION SETS (SET=1) OR GIVES (SET=0) FILE INDEX HEADER ! INFORMATION. ADR POINTS TO ADDRESS OF OR FOR THE INFORMATION ! TO BE TRANSFERRED. ! TYPE SPECIFIES THE DATA ITEM REQUIRED TO BE REFERENCED. ! ! A BIT IS SET IN SETFLAGS IF THE CORRESPONDING 'TYPE' MAY BE 'SET' ! ONLY BY A PRIVILEGED CALLER. ! A bit is set in LENFLAGS if the first byte of a string parameter input ! under the "set" option is to be checked according to corresponding ! entry from array VLEN. VLEN also used to VAL user area. CONSTLONGINTEGER SETFLAGS = X'1DA632E9B7D80' CONSTLONGINTEGER LENFLAGS = X'050B8000C000F' CONSTLONGINTEGER H ONLY = X'15BFF3FFFE5EF' CONSTLONGINTEGER UCT = X'050B800080005'; ! input string to be UC translated CONSTINTEGER TOP GET = 48 CONSTBYTEINTEGERARRAY VLEN(0:TOPGET)= C 19, 32, 19, 64, 48, 8, 8, 4, 8, 48, C 4, 4, 4, 8, 12, 4, 8, 4, 32, 12, C 8, 4, 4, 8, 4, 4, 4, 8, 4, 4, C 24, 8, 4, 4, 4, 19, 19, 7, 4, 16, C 8, 32, 68, 4, 7,255, 16, 4, 4 constbyteintegerarray NI(0:TOPGET) = c 0, 0, 0, 0,12, 2, 1, 1, 2,12, c 1, 1, 1, 2, 3, 1, 2, 1, 0, 0, c 2, 1, 1, 2, 1, 1, 1, 2, 1, 1, c 6, 2, 1, 1, 1, 0, 0, 0, 1, 0, C 2, 0,17, 1, 0, 1, 0, 1, 1 ! 0 = string ! n = number of integers to be reported if 'dmonning' CONSTLONGINTEGER JMS = X'141DD76000' integer TOPA integer J, FLAG, LEN, INDAD, FINDAD, IP integer NFD, NSD, NPD, N, A, AKB, B, BKB LONGINTEGER L STRING (18)W STRING (31)UNA, INA, IND switch DGET,DSET(0:TOPGET) RECORD (FF)NAME AF RECORD (AFDF)ARRAYNAME AFDS record (FDF)arrayname FDS RECORD (PDF)ARRAYNAME PDS integerarrayname SDS integername I0, I1 stringname S0 record (HF)name H record (FF)name F record (ACF)name ACCTS conststring (5)FN = "DSFI " ! ! ! FLAG=IN2(78) -> OUT UNLESS FLAG = 0 ! FLAG = UIO(FILE INDEX, UNA, INA, IND) -> OUT UNLESS FLAG = 0 ! FLAG=8 -> OUT UNLESS 0<=SET<=1 AND 0<=TYPE<=TOPGET ! FLAG = 45 LEN=VLEN(TYPE) J=VAL(ADR,LEN,1-SET,DCALLERS PSR) -> OUT IF J=0; ! user area not accessible ! IP = FILE INDEX PERM(IND, FSYS); ! done here because of sema FLAG = MAP FILE INDEX(IND, FSYS, FINDAD, FN) -> OUT IF FLAG > 0 F == RECORD(FINDAD) ! I0 == INTEGER(ADR) I1 == INTEGER(ADR+4) S0 == STRING(ADR) ! IF (H ONLY >> TYPE) & 1 = 1 START FLAG = 8 -> VOUT UNLESS INA = "" INDAD = FINDAD - 512 H == RECORD(INDAD) FINISH ! ACCTS==RECORD(ACCTSA) ! FLAG=93 -> POK IF DTRYING << 21 < 0; ! the gods can do anything -> VOUT IF ((SET=YES AND (SETFLAGS >> TYPE) & 1 = YES) OR C (SET=NO AND TYPE=41) OR C (SET=NO AND TYPE=5)) -> SUPER IF SET = YES AND TYPE = 18; ! surnames are funny -> POK IF UNA = PROCUSER -> POK IF IP & 2 > 0 -> POK IF SET = NO AND IP & 1 > 0 SUPER: -> VOUT UNLESS (H ONLY >> TYPE) & 1 = 1; ! because we don't have H mapped -> VOUT UNLESS PROCUSER = H_SUPERVISOR; ! for course supervisors -> VOUT IF H_BASEFILE = "" -> VOUT UNLESS CHARNO(UNA, 4) = 'U' POK: FLAG = 8; ! invalid parameter -> DGET(TYPE) IF SET = 0 -> VOUT IF (LENFLAGS >> TYPE) & 1 = 1 and LENGTH(S0) >= VLEN(TYPE) UNLESS S0 = "" OR (UCT>>TYPE) & 1 = 0 START W = S0 {need to UCT but must first copy the data to a writeable} S0 == W { bit of store. Have already checked its length} UCTRANSLATE(ADDR(S0)+1, LENGTH(S0)) FINISH -> DSET(TYPE) DONE: FLAG=0 DSET(*): DGET(*): VOUT: VV(ADDR(F_SEMA), F_SEMANO) OUT: unless DIRMON = NO start PRINTSTRING(FN) PRINTSTRING(IND) WRITE(TYPE, 1) ! if SET = 0 = FLAG start ; ! report values to be returned if NI(TYPE) = 0 c then PRINTSTRING(" ".S0) c else start TOPA = ADR + (NI(TYPE) - 1) * 4 cycle J = ADR, 4, TOPA WRITE(INTEGER(J), 1) repeat finish finish else start WRITE(SET, 1) finish IF FLAG = 0 C THEN WRS(" OK") C ELSE WRSN(" RES =", FLAG) finish result = OUT(flag, "NIL") ! ! ! integerfn EN(stringname S) string (255)W, X, Y W = S0 W = X . Y while W -> X . (" ") . Y; ! remove any newline characters S <- W RESULT = 0 end ! ! ! DGET(0): S0 = H_BASEFILE; -> DONE DSET(0): FLAG=EN(H_BASEFILE) if DTRYING << 19 < 0; -> VOUT DGET(1): S0 = H_DELIVERY; -> DONE DSET(1): FLAG=EN(H_DELIVERY); -> VOUT DGET(2): S0 = H_STARTF; -> DONE DSET(2): FLAG=EN(H_STARTF) if DTRYING << 19 < 0; -> VOUT DGET(3): S0 = H_DATA; -> DONE DSET(3): FLAG=EN(H_DATA); -> VOUT DGET(4): ! INDEX USE I0 = F_FILES ! NFD = (F_SIZE << 9 - F_FDSTART) // FDSIZE N = 0; ! to count FDs in use FDS == ARRAY(FINDAD + F_FDSTART, FDSF) cycle J = 1, 1, NFD exit if FDS(J)_NAME = "" N = N + 1 unless FDS(J)_NAME = ".NULL" repeat I1 = N; ! FDs in use INTEGER(ADR+8) = NFD - N; ! FDs available INTEGER(ADR+12) = (F_SIZE+1) >> 1; ! INDEX SIZE (KBYTES) ! NSD = (F_FDSTART - F_SDSTART) >> 2 SDS == ARRAY(FINDAD + F_SDSTART, SDSF) INTEGER(ADR+16) = NSD N = 0 cycle J = 1, 1, NSD N = N + 1 if SDS(J) = 0 repeat INTEGER(ADR+20) = N; ! number of free SDs ! NPD = (F_SDSTART - F_PDSTART)//PDSIZE PDS == ARRAY(FINDAD + F_PDSTART, PDSF) N = 0 CYCLE J = 1, 1, NPD N = N + 1 IF PDS(J)_NAME = "" REPEAT INTEGER(ADR+24) = NPD INTEGER(ADR+28) = N INTEGER(ADR+32)=0 INTEGER(ADR+36)=0 INTEGER(ADR+40)=0 INTEGER(ADR+44)=0 -> DONE DGET(5): ! PASSWORDS L = H_DWSP L = L & X'7FFFFFFF' UNLESS L >> 32 = 0 *LSS_L+4 *ST_J I0 = J !! (-1) ! L = H_BWSP L = L & X'7FFFFFFF' UNLESS L >> 32 = 0 *LSS_L+4 *ST_J I1 = J !! (-1) -> DONE DSET(5): ! PASSWORDS ! J = NO; ! FORE PASS TO BE SET ONLY BY DIRECT & NON-BACK JOB if PROCUSER = "DIRECT" c then J = YES c else start J = YES if UINF_REASON < 2 finish ! if J = YES start H_PASSFAILS = 0 J = I0 unless J = 0 start J = J !! (-1) *LSS_J *LUH_0 *ST_L H_DWSP = L H_DWSPDT = PACKDT finish finish ! J = I1 unless J = 0 start J = J !! (-1) *LSS_J *LUH_0 *ST_L H_BWSP = L H_BWSPDT = PACKDT finish -> DONE DGET(6): ! LAST LOGON I0=H_LAST LOG ON I1 = H_LAST NON INT START -> DONE DGET(7): ! ACR I0=H_ACR I0=DEFAULT SSACR if I0=0 -> DONE DSET(7): ! ACR FLAG = 93 -> VOUT unless DTRYING << 24 < 0 H_ACR=I0 H_ACR=0 if H_ACR=DEFAULT SSACR -> DONE DGET(8): ! DIRVSN I0=H_DIRVSN I1=DDVSN -> DONE DSET(8): ! DIRVSN unless 0<=I0<=7 or I0=255 then -> VOUT H_DIRVSN=I0 -> DONE DGET(9): ! ARCHIVE INDEX DATA VV(ADDR(F_SEMA), F_SEMANO) ! FLAG = NEWAINDA(IND, FSYS, INDAD) -> OUT unless FLAG = 0 ! AF == RECORD(INDAD); ! #ARCH of course NFD = (AF_MAXFILE - AF_FDSTART) // FDSIZE AFDS == ARRAY(INDAD+AF_FDSTART, AFDSF) NPD = (AF_SDSTART - AF_PDSTART) // PDSIZE PDS == ARRAY(INDAD + AF_PDSTART, PDSF) ! A = 0; ! count archived files AKB = 0; ! and KB B = 0; ! count backed up files BKB = 0 CYCLE J = 1, 1, NFD S0 == AFDS(J)_NAME EXIT IF S0 = "" UNLESS S0 = ".NULL" START N = AFDS(J)_PGS << 2; ! NKB IF AFDS(J)_TYPE = 0 START ; ! arch A = A + 1 AKB = AKB + N FINISH ELSE START B = B + 1; ! backed up BKB = BKB + N FINISH FINISH REPEAT ! H_ATOTKB = AKB; ! this will get done when #ARCH disconnected ! H_AFILES = A ! AF_FILES0 = A AF_CHERKB = AKB AF_FILES1 = B AF_TEMPKB = BKB ! I0 = A I1 = AKB INTEGER(ADR + 8) = B INTEGER(ADR + 12) = BKB INTEGER(ADR + 16) = (AF_MAXFILE) >> 10 INTEGER(ADR + 20) = NFD INTEGER(ADR + 24) = NFD - (A + B) ! N = 0 CYCLE J = 1, 1, NPD N = N + 1 IF PDS(J)_NAME = "" REPEAT INTEGER(ADR + 28) = NPD INTEGER(ADR + 32) = N J = NEWAINDA("", 0, J); ! disconnect #ARCH INTEGER(ADR+36)=0 INTEGER(ADR+40)=0 INTEGER(ADR+44)=0 -> OUT DGET(10): I0=H_STKKB -> DONE DSET(10): -> VOUT unless I0=0 or 12<=I0<=255 H_STKKB=I0 -> DONE DGET(11): I0=F_MAXKB if I0=0 then I0=DEFAULT MAXKB -> DONE DSET(11): F_MAXKB=I0 -> DONE DGET(12): I0=F_MAXFILE if I0=0 then I0=DEFAULT MAXFILE -> DONE DSET(12): FLAG=8 if I0<64 then -> VOUT; ! MIN 64K F_MAXFILE=I0 -> DONE DGET(13): ! NOS. OF INTER, BATCH AND TOTAL PROCESSES I0=H_IUSE I1=H_BUSE -> DONE DSET(13): ! NOS OF INTER AND BATCH PROCS (EMERGENCY ONLY) H_IUSE<-I0 H_BUSE<-I1 -> DONE DGET(14): ! PROCESS CONCURRENCY LIMITS I0=H_IMAX I0=DEFAULT IMAX if I0=255 I1=H_BMAX I1=DEFAULT BMAX if I1=255 J=H_TMAX J=DEFAULT TMAX if J=255 INTEGER(ADR+8)=J -> DONE DSET(14): ! PROCESS CONCURRENCY LIMITS H_IMAX<-I0 H_BMAX<-I1 H_TMAX<-INTEGER(ADR+8) -> DONE DGET(15): I0 = H_TELLREJ -> DONE DSET(15): H_TELLREJ = I0 -> DONE DGET(16): I0 = H_DIRMON -> DONE DSET(16): H_DIRMON=I0 -> DONE DGET(17): I0 = H_SIGMON I1 = 0 -> DONE DSET(17): H_SIGMON<-I0 -> DONE DGET(18): ! INITIALS AND SURNAME S0 = H_SURNAME -> DONE DSET(18): ! INITIALS AND SURNAME FLAG=EN(H_SURNAME) -> VOUT DGET(19): ! LOGFILE NAME S0 = H_LOGFILE -> DONE DSET(19): ! LOGFILE NAME FLAG=EN(H_LOGFILE) -> VOUT !------------------------ PROCESS METERING ENTRIES --------------- DGET(20): I0=H_IINSTRS I1=H_BINSTRS -> DONE DSET(20): H_IINSTRS=I0 H_BINSTRS=I1 -> DONE DGET(21): I0=SESSINSTRS -> DONE DGET(22): INTEGER(ADR)=DINSTRS -> DONE DGET(23): I0=H_IPTRNS I1=H_BPTRNS -> DONE DSET(23): H_IPTRNS=I0 H_BPTRNS=I1 -> DONE DGET(24): I0=ACCTS_PTRNS -> DONE DGET(25): I0=H_NKBOUT -> DONE DSET(25): H_NKBOUT=I0 -> DONE DGET(26): I0=H_NKBIN -> DONE DSET(26): H_NKBIN=I0 -> DONE DGET(27): I0=H_IMSECS I1=H_BMSECS -> DONE DSET(27): H_IMSECS=I0 H_BMSECS=I1 -> DONE DGET(28): I0=ACCTS_MUSECS//1000 -> DONE DGET(29): I0=H_CONNECTT -> DONE DSET(29): H_CONNECTT=I0 -> DONE DGET(30): ! these fields are set by ! CCK CHSIZE DPERM ! DFSTAT CREATE DESTROY ! RENAME NEWGEN DISCONNECT I0=F_FILES INTEGER(ADR+4)=F_TOTKB INTEGER(ADR+8)=F_CHERFILES INTEGER(ADR+12)=F_CHERKB INTEGER(ADR+16)=F_TEMPFILES INTEGER(ADR+20)=F_TEMPKB -> DONE DGET(31): I0 = F_AFILES I1 = F_ATOTKB -> DONE DGET(32): ! interactive session length (minutes) I0=H_ISESSM -> DONE DSET(32): ! interactive session length (minutes) unless I0=0 or 5<=I0<=240 then -> VOUT; ! up to 4 hours only H_ISESSM=I0 -> DONE DGET(33): ! scarcity ration VV(ADDR(F_SEMA), F_SEMANO) I0=FUNDS(J,INDAD) FLAG = 0 -> OUT DSET(33): ! scarcity ration H_INUTS=I0 -> DONE DGET(34): ! GPFSYS I0 = H_GPFSYS -> DONE DSET(35): ! test subsystem FLAG=EN(H_TESTSS) if DTRYING << 19 < 0 -> VOUT DGET(35): ! test subsystem S0 = H_TESTSS -> DONE DSET(36): ! batch subsystem FLAG=EN(H_BATCHSS) if DTRYING << 19 < 0 -> VOUT DGET(36): ! batch subsystem S0 = H_BATCHSS -> DONE DGET(37): ! group holder of scarcity ration S0 = H_GPHOLDR -> DONE DSET(37): ! group holder of scarcity ration FLAG=EN(H_GPHOLDR) -> VOUT DGET(38): I0 = H_TRYING -> DONE DSET(38): FLAG = 93 -> VOUT unless DTRYING << 14 < 0 ! DOPER2(PROCUSER." sets PRIV for ".UNA." to ".HTOS(I0,8)) UNLESS I0 = 0 ! H_TRYING = I0 -> DONE DGET(39): S0 = H_DEFAULTLP -> DONE DSET(39): FLAG = EN(H_DEFAULTLP) -> VOUT DGET(40): I0 = H_DWSPDT I1 = H_BWSPDT -> DONE DGET(41): ! password info LONGINTEGER(ADR) = H_DWSP LONGINTEGER(ADR+8) = H_BWSP INTEGER(ADR+16) = H_DWSPK INTEGER(ADR+20) = H_BWSPK INTEGER(ADR+24) = H_DWSPDT INTEGER(ADR+28) = H_BWSPDT -> DONE DSET(41): H_DWSP = LONGINTEGER(ADR) H_BWSP = LONGINTEGER(ADR+8) H_DWSPK = INTEGER(ADR+16) H_BWSPK = INTEGER(ADR+20) H_DWSPDT = INTEGER(ADR+24) H_BWSPDT = INTEGER(ADR+28) -> DONE DSET(42): ! Read, and possibly clear, ACCOUNTS data DGET(42): FILL(68, ADR, 0) UNLESS INA = "" ! INTEGER(ADR+36) = F_AFILES INTEGER(ADR+40) = F_ATOTKB INTEGER(ADR+44) = F_FILES INTEGER(ADR+48) = F_TOTKB INTEGER(ADR+52) = F_CHERFILES INTEGER(ADR+56) = F_CHERKB INTEGER(ADR+64) = F_DAY42 -> DONE UNLESS INA = "" ! INDAD = FINDAD - 512 H == RECORD(INDAD) ! I0 = H_IINSTRS I1 = H_BINSTRS INTEGER(ADR+8) = H_IPTRNS INTEGER(ADR+12) = H_BPTRNS INTEGER(ADR+16) = H_NKBOUT INTEGER(ADR+20) = H_NKBIN INTEGER(ADR+24) = H_IMSECS INTEGER(ADR+28) = H_BMSECS INTEGER(ADR+32) = H_CONNECTT INTEGER(ADR+60) = H_DAPSECS ! -> DONE IF SET = 0 ! H_IINSTRS = 0 H_BINSTRS = 0 H_IPTRNS = 0 H_BPTRNS = 0 H_NKBOUT = 0 H_NKBIN = 0 H_IMSECS = 0 H_BMSECS = 0 H_CONNECTT = 0 H_DAPSECS = 0 ! F_DAY42 = DDAYNUMBER & 255 ! -> DONE DSET(43): H_MAIL COUNT = I0 -> DONE DGET(43): I0 = H_MAIL COUNT -> DONE DSET(44): ! Supervisor FLAG = EN(H_SUPERVISOR) -> VOUT DGET(44): S0 = H_SUPERVISOR -> DONE DSET(46): FLAG = EN(H_GATEWAY ACCESS ID) -> VOUT DGET(46): S0 = H_GATEWAY ACCESS ID -> DONE DSET(47): F_ATTRIBUTES = I0 -> DONE DGET(47): I0 = F_ATTRIBUTES -> DONE DSET(48): H_TYPE = I0 -> DONE DGET(48): I0 = H_TYPE -> DONE end ; ! DSFI ! !----------------------------------------------------------------------- ! !<DSPOOL externalintegerfn DSPOOL(record (PARMF)name P, integer LEN, ADR) ! ! This procedure transmits a spool request message to the Spooler ! process. ADR and LEN describe the text to be transmitted. ! ! The result of the function is 61 if the Spooler process is not ! available, or 0 if the request was successful. If Spooler was ! available, the record P contains reply information from Spooler on ! return. ! ! P1 is zero for a successful request, and P2 gives the Spooler's unique ! identifier for the document. Error messages from Spooler, in P1, are in the ! range 201-236, as follows: ! 201 Bad Parameters ! 202 No Such Queue ! 203 Queue Full ! 204 All Queues Full ! 205 Not In Queue ! 206 User Not Known ! 207 No Files In Queue ! 208 File Not Valid ! 209 No Free Document Descriptors ! 210 Not Enough Privilege ! 211 Invalid Password ! 212 Invalid Filename ! 213 Invalid Descriptor ! 214 Command Not Known ! 215 Invalid Username ! 216 Username Not Specified ! 217 Not Available From A Process ! 218 Invalid Length ! 219 Document Destination Not Specified ! 220 Invalid Destination ! 221 Invalid Source ! 222 Invalid Name ! 223 Invalid Delivery ! 224 Invalid Time ! 225 Invalid Priority ! 226 Invalid Copies ! 227 Invalid Forms ! 228 Invalid Mode ! 229 Invalid Order ! 230 Invalid Start ! 231 Invalid Rerun ! 232 Invalid Tapes ! 233 Invalid Discs ! 234 Invalid Start After ! 235 Invalid Fsys ! 236 SPOOLR File Create Fails ! In the event of a syntax error in the message, P3 is the offset from ! ADR of the offending character. !> INTEGER FLAG, E CONSTINTEGER TOPEXEC = 5 CONSTSTRING (6)ARRAY EXEC(2 : TOPEXEC) = C "VOLUMS", "SPOOLR", "MAILER", "FTRANS" FLAG = IN2(79) -> OUT UNLESS FLAG = 0 ! FLAG = 8 E = LEN >> 24 E = 3 IF E = 0 -> OUT UNLESS 2 <= E <= TOPEXEC ! FLAG = DSPOOLBODY(EXEC(E), P, LEN & X'FFFFFF', ADR) OUT: RESULT = OUT(FLAG, "") END ; ! DSPOOL ! !----------------------------------------------------------------------- ! !<DSUBMIT externalintegerfn DSUBMIT(record (PARMF)name P, integer LEN, ADR, SACT, string (6)USER) ! ! Allows a privileged caller to submit a batch job for user USER. !> INTEGER J BYTEINTEGERARRAY M(0:2050) STRINGNAME S BYTEINTEGERNAME L J = IN2(79) -> OUT UNLESS J = 0 ! J = 93 -> OUT UNLESS DTRYING << 6 < 0 ! J = 45 -> OUT IF VAL(ADR, LEN, 0, 0) = 0 ! J = 8 -> OUT IF LEN > 2000 ! J = UNOK(USER) -> OUT UNLESS J = 0 ! S == STRING(ADDR(M(0))) L == BYTEINTEGER(ADDR(M(0))) ! S = "**".USER.TOSTRING(7)." ".DATE." ".TIME L = L - 3 S = S . ": " MOVE(LEN, ADR, ADDR(M(L+1))) ! P_DEST = X'FFFF0016' J = TXTMESS("SPOOLR", P, 2, 0, L+LEN, ADDR(M(1)), -1, SACT) OUT: WRS3N("DSUBMIT", USER, "RES", J) RESULT = OUT(J, "") END ; ! DSUBMIT ! !----------------------------------------------------------------------- ! !<DTRANSFER externalintegerfn DTRANSFER(string (31)FILE INDEX1, FILE INDEX2, FILE1, FILE2, integer FSYS1, FSYS2, TYPE) ! ! This procedure transfers FILE1 belonging to file index FILE INDEX1 on ! FSYS1 to the ownership of file index FILE INDEX2 on FSYS2 under name ! FILE2. ! ! TYPE = 0 'accepts' a file which has been 'offered'. This call ! is non-privileged. ! 1 a privileged call to transfer a file. ! 2 like 1, but, in addition, forces a re-allocation of the ! disc space. ! 3 a privileged call to copy the file. ! 4 as 3 but works even when file connected W (for test purposes) !> INTEGER FLAG, MOVEDATA, STATE INTEGER NKB,J,CHERISH STATUS INTEGER PAGS INTEGER TRIED, DA INTEGER EP, NP INTEGER FINDAD1, FINDAD2, DA1, DA2, LINK1, LINK2 STRING (31)UNA1, INA1, FNA1, INDEX1, FULL1 STRING (31)UNA2, INA2, FNA2, INDEX2, FULL2 RECORD (FDF)NAME FD1, FD2 RECORD (FF)NAME F1, F2 RECORD (FDF)ARRAYNAME FDS1, FDS2 RECORD (PDF)ARRAYNAME PDS1 INTEGERARRAYNAME SDS1, SDS2 INTEGERNAME SD1, SD2 CONSTSTRING (10)FN = "DTRANSFER " ! ! ! STATE = 0; ! 1 = PP1 done ! 2 = FD1 marked UNAVA ! 4 = FILE2 has been created ! ! FLAG=IN2(83) -> OUT UNLESS FLAG = 0 ! FLAG = UFO(FILE INDEX1, FILE1, UNA1, INA1, FNA1, INDEX1, FULL1) -> OUT UNLESS FLAG = 0 ! FLAG = UFO(FILE INDEX2, FILE2, UNA2, INA2, FNA2, INDEX2, FULL2) -> OUT UNLESS FLAG = 0 ! -> POK IF DTRYING << 6 < 0 IF TYPE = 0 START ; ! accept -> POK IF UNA2 = PROCUSER -> POK IF FILE INDEX PERM(INDEX2, FSYS2) & 2 > 0 FINISH FLAG = 93 -> OUT POK: ! FLAG=8 -> OUT UNLESS 0 <= TYPE <= 4 UNLESS -1<=FSYS1 AND FSYS2>=0 THEN -> OUT ! FLAG = MAP FILE INDEX(INDEX1, FSYS1, FINDAD1, FN); ! P1P1P1P1P1P1P1P1P1P1 -> OUT UNLESS FLAG = 0 F1 == RECORD(FINDAD1) STATE = 1 ! FLAG = 32 J = NEWFIND(FINDAD1, 0, FNA1) -> OUT IF J = 0 FDS1 == ARRAY(FINDAD1 + F1_FDSTART, FDSF) PDS1 == ARRAY(FINDAD1 + F1_PDSTART, PDSF) SDS1 == ARRAY(FINDAD1 + F1_SDSTART, SDSF) FD1 == FDS1(J) SD1 == FD1_SD IF TYPE = 0 START -> OUT UNLESS FD1_CODES&OFFER#0 ANDC PDS1(FD1_PHEAD)_NAME = UNA2 FINISH ! FLAG = 5 -> OUT UNLESS FD1_CODES & (UNAVA!VIOLAT) = 0 ! FLAG = 42 -> OUT UNLESS FD1_USE = 0 ORC (TYPE = 3 AND FD1_CODES2 & WRCONN = 0) ORC TYPE = 4 ! FD1_CODES = FD1_CODES ! UNAVA CHERISH STATUS = FD1_CODES & CHERSH PAGS = FD1_PGS VV(ADDR(F1_SEMA), F1_SEMANO); ! V1V1V1V1V1V1V1V1V1V1 STATE = 2 NKB=PAGS << 2 ! MOVEDATA = 0 MOVEDATA = 1 IF FSYS1 # FSYS2 OR TYPE > 1 ! ! TRIED = 0 TRY AGAIN: TRIED = TRIED + 1 -> OUT IF TRIED > 10; ! FLAG set to 25 by Move Section ! FLAG=DCREATEF(FULL2,FSYS2,NKB,MOVEDATA!2,LEAVE,DA); ! FD2 left 'UNAVA' -> OUT UNLESS FLAG = 0 STATE = STATE ! 4 ! FLAG = MAP FILE INDEX(INDEX2, FSYS2, FINDAD2, FN); ! P2P2P2P2P2P2P2P2P2P2 -> OUT UNLESS FLAG = 0 ! F2 == RECORD(FINDAD2) FDS2 == ARRAY(FINDAD2 + F2_FDSTART, FDSF) SDS2 == ARRAY(FINDAD2 + F2_SDSTART, SDSF) ! FLAG = 32 J = NEWFIND(FINDAD2, 0, FNA2) IF J = 0 START WRS("Dtransfer can't find " . FNA2) -> OUT FINISH FLAG = 0 ! FD2 == FDS2(J) SD2 == FD2_SD VV(ADDR(F2_SEMA), F2_SEMANO); ! V2V2V2V2V2V2V2V2V2V2 ! EP = PAGS WHILE EP > 0 CYCLE NP = EP NP = 32 IF NP > 32 EP = EP - NP ! DA1 = SD1 << 13 >> 13 AND LINK1 = SD1 >> 19 DA2 = SD2 << 13 >> 13 AND LINK2 = SD2 >> 19 ! IF MOVEDATA = 0 START SD1 = (LINK1 << 19) ! ((-1) >> 13) SD2 = LINK2 << 19 ! DA1 FINISH ELSE START FLAG = MOVE SECTION((1<<31)!FSYS1, DA1, FSYS2, DA2, NP) IF FLAG # 0 START J = DDESTROYF(FULL2, FSYS2, 2) STATE = STATE & (¬4) -> TRY AGAIN FINISH FINISH ! EXIT IF EP = 0; ! appear to have finished ! SD1 == SDS1(LINK1) SD2 == SDS2(LINK2) REPEAT ! FD2_ARCH = FD1_ARCH ! 5; ! file has been connected W FD2_CODES = CHERISH STATUS STATE = STATE & (¬4) ! UNLESS TYPE = 3 OR TYPE = 4 START J = DDESTROYF(FULL1, FSYS1, 2) STATE = 0 FINISH OUT: VV(ADDR(F1_SEMA), F1_SEMANO) IF STATE & 1 > 0 FD1_CODES = FD1_CODES & (¬UNAVA) IF STATE & 2 > 0 J = DDESTROYF(FULL2, FSYS2, 2) IF STATE & 4 > 0 RESULT = OUT(FLAG, "SSSSIII") END ; ! DTRANSFER ! !----------------------------------------------------------------------- ! !<DUNLOCK externalintegerfn DUNLOCK(integer ADR) ! ! This privileged procedure unlocks an area of virtual memory, identified ! by its start virtual address ADR, previously locked by a call of ! procedure DLOCK. !> INTEGER J,FLAG RECORD (DRF)NAME DR LOCKED RECORD (PARMF)Q FLAG = IN2(84) -> OUT UNLESS FLAG = 0 ! FLAG=8 IF ADR<=0 THEN -> OUT CYCLE J=0,1,2 IF DRS LOCKED(J)_DR1=ADR THEN -> GOTU REPEAT FLAG = 79; ! NOT LOCKED -> OUT GOTU: DR LOCKED==DRS LOCKED(J) Q=0 Q_P1=-1; ! UNLOCK Q_P5=DR LOCKED_DR0 Q_P6=ADR LOUTP=Q LOUTP STATE="DUNLOCK" REF LOCK(Q,ADR,DR LOCKED_DR0<<8>>8) LOUTP STATE="DUNLOCK exit" IF Q_DEST=0 THEN DR LOCKED=0; ! free to lock another FLAG=Q_DEST OUT: RESULT = OUT(FLAG, "X") END ; ! DUNLOCK ! !----------------------------------------------------------------------- ! ENDOFFILE