;<FOONEX>FILEJS.MAC;13 18-Mar-81 19:51:36, Edit by MMCM ; SUMEX ERJMP/ERCAL changes ;DSK:<FOONEX>FILEJS.MAC;12 10-Sep-80 19:58:20, Edit by DANG ; Removed FDBENV; does not exist in batblk monitor ;DSK:<134-TENEX>FILEJS.MAC;9 10-Aug-80 17:36:55, Edit by DANG ; Temporarily removed ARPAN access check ;DSK:<134-TENEX>FILEJS.MAC;8 14-Mar-80 16:59:01, Edit by PETERS ; Fix CAPMSK reference to extern ;DSK:<134-TENEX>FILEJS.MAC;7 19-Feb-80 18:43:37, Edit by FRENCH ;ADDED CHECK FOR ARPAN PRIVY BIT IN .OPENF FOR NET: OPENS ;<134-TENEX>FILEJS.MAC;5 19-Feb-80 12:23:20 EDIT BY PETERS ; Added bug fixes from ISI ;<134-TENEX>FILEJS.MAC;4 16-Sep-79 18:32:17 EDIT BY PETERS ;<134-TENEX>FILEJS.MAC;3 16-May-78 15:50:23 EDIT BY PETERS ;<134-TENEX>FILEJS.MAC;2 29-NOV-77 19:52:37 EDIT BY PETERS ;<135-TENEX>FILEJS.MAC;7 12-DEC-75 10:50:09 EDIT BY PLUMMER ; REMOVE UNUSED EXTERN GRPNM ;<134-TENEX>FILEJS.MAC;6 28-AUG-75 17:12:48 EDIT BY ALLEN ; UNLOCK DIRLCKS MUST NOW SPECIFICALLY REQUEST RELEASE OF HIQ ;<134-TENEX>FILEJS.MAC;5 20-JUN-75 07:39:33 EDIT BY TOMLINSON ; PERMIT WRITERS TO CHFDB RH OF FDBUSE (SHARE COUNT) ;<134-TENEX>FILEJS.MAC;4 28-APR-75 15:06:20 EDIT BY CLEMENTS ;<134-TENEX>FILEJS.MAC;3 28-APR-75 12:18:36 EDIT BY CLEMENTS ;<134-TENEX>FILEJS.MAC;2 28-APR-75 11:35:45 EDIT BY CLEMENTS ;<134-TENEX>FILEJS.MAC;1 8-APR-75 18:47:39 EDIT BY CLEMENTS ; SEPARATED FROM JSYS.MAC ;<134-TENEX>JSYS.MAC;248 27-MAR-75 13:26:51 EDIT BY CALVIN ; Use ASGJFR rather than ASGFRE - ;<134-TENEX>JSYS.MAC;247 26-MAR-75 20:44:27 EDIT BY CALVIN ; a few more fixes to accounting stuff... ;<134-TENEX>JSYS.MAC;246 26-MAR-75 12:08:58 EDIT BY PLUMMER ; DELNF CHECKS ACCESS BEFORE DELETING. DELNF SKIPS TMP AND UND FILES. ;<134-TENEX>JSYS.MAC;249 21-MAR-75 14:13:27 EDIT BY CALVIN ; DON'T CLOBBER HDRS FROM ASGFRE ;<134-TENEX>JSYS.MAC;248 20-MAR-75 21:07:21 EDIT BY CALVIN ; FIXED UP RLS2 & RLS1 ;<134-TENEX>JSYS.MAC;246 20-MAR-75 11:11:16 EDIT BY CALVIN ; Use ASGFRE rather than stack in VACCT, GDACC & ATGRP. Added ; NOSKED & OKSKED to GACTJ so job can't disappear ;<134-TENEX>JSYS.MAC;245 3-MAR-75 19:34:43 EDIT BY TOMLINSON ; LOCK DIRLCK BEFORE JUMP TO CRNWWIP ;<134-TENEX>JSYS.MAC;244 28-JAN-75 13:24:47 EDIT BY CLEMENTS ; ALLOW CRJOB TO SUPPRESS PASSWORD CHECK AND/OR UPDATING OF ; LAST LOGIN DATE IN LOGIN JSYS. ;<134-TENEX>JSYS.MAC;243 24-JAN-75 13:12:58 EDIT BY CLEMENTS ; EXPAND LGNPAR TO TWO WORDS. STORE LAST LOGIN DATE IN SECOND. ;<134-TENEX>JSYS.MAC;242 7-JAN-75 14:34:05 EDIT BY CALVIN ; FIXED STRING ACCOUNT BUG AT SETAC2 ;<133-TENEX>JSYS.MAC;241 2-JAN-75 11:15:17 EDIT BY CALVIN ; Changed check for non-exsistant job in GACTJ SEARCH STENEX,PROLOG TITLE FILEJS SUBTTL R.S.Tomlinson SWAPCD EXTERN STRDTB,MENTR,MRETN,BUGCHK,BUGHLT,MSTKOV,ITRAP,PRIMRY,MRTNE1,MRETNE EXTERN PFILPC,ZERO,MINUS1,LSTERR,ERRSAV,CAPENB EXTERN PBYTSZ,PBYTPO EXTERN NDEV IFDEF NETN,<EXTERN NVTDET,NTSIBE,NETDTB,NETNAM> EXTERN CTRLTT,EDISMS EXTERN ACCCHK,CPYDIR,DIRCHK,DIRLUK,DIRLUU,GDIRST,GETDDB,GETFDB,HSHLUK EXTERN DEVCHR,DEVDSP,DEVLCK,DEVLUK,DEVNAM,DEVUNT EXTERN INIBLK,INSACT,MAPDIR,MDDNAM,SETDIR,SETMSK,USTDIR EXTERN ASGDFR,ASGJFR,ASGPAG,ASGFRE,GCDIR,RELDFR,RELFRE,RELPAG EXTERN CPYFU1,CPYFUS,CPYTUS,RESAC,SAVAC,XPAND EXTERN DOINT,BOUTN,BYTOUA,CCSIZE,CHKJFN,CPOPJ,CPTAB,DBP,DISGET EXTERN DSKDTB,TTYDTB,JFNOFN,JFNOF1,OFNJFN,OFNJFX IFDEF DTAN,<EXTERN DTADTB> IFDEF LPTN,<EXTERN LPTDTB> EXTERN NEWWND,NOUTX,RELJFN,SKPRET,BHC,UNLCKF,JOBPT EXTERN FORKX,SETLF1,TTFRKP,MAPINF,RLJBFK,SUPERP,SKIIF EXTERN FFORK1,RFORK1 EXTERN FKJOB EXTERN ACCIFG USE SWAPPC EXTERN NXTDMP ; Zero to dump open files EXTERN MAPFKH ; Maps over a fork handle EXTERN SKIIFA ; Skips if fork(a) < fork(b) EXTERN ACCTPT ; Login account string pointer or number EXTERN ACCTSR ; Account string storage EXTERN LOGONM ; Dlm's logon message typer EXTERN LOGCJM ; Type change job number on logtty EXTERN LGCJM0 ; Log in EFACT file, but not on LOGTTY EXTERN JOBRT ; Job runtime table EXTERN CONSTO ; Console time on word EXTERN MJRSTF ; Thing to execute to leave fast jsys code LS(FACTSW) ; Fact switches JS(ACCTSL) EXTERN JOBDIR EXTERN FKDIR EXTERN FKGRPS ; Groups to which user of fork group belongs EXTERN TODCLK ; Time since system start in msec EXTERN SKIIF ; Skip if forkn in a is inferior or equal to self JS(MODES) ; Ddbmod word from login JS(PASFCT) ; Password failure counter EXTERN TTBKPT ; Routine to backup tty pointer one character EXTERN JOBPMF ; Jfn of pmf EXTERN MRPT ; Read page table EXTERN SETPT ; Map manipulator routine EXTERN MSPACS ; Set access of a page EXTERN FKHPTN ; Converts fork handle to ptn EXTERN PTNFKH ; Converts ptn to fork handle EXTERN SETLFK,DELOFN EXTERN TTCIBF,TTCOBF,TTSIBE,TTDIBE,TTSOBE,TTSOBF,TTDOBE,TTGTBS,TTSTBS EXTERN TTRMOD,TTSMOD,TTRPOS,TTSPOS,TTRCOC,TTSCOC,TTSTI,TTILIN,TTSOBF EXTERN SYSIFG,LOGBUF,.LGOUT ; Logging stuff EXTERN SYSFK ; Table of job forks EXTERN NORMTF,TTICB1,TTICB2,TAB81,TAB82 ; Tty modes ; Entries to this section INTERN BOUTA,NOUTXX ; Error macro definitions DEFINE ERUNLK(ERRORN,EXTRA)< JRST [ EXTRA IFDIF <ERRORN>,<>,<MOVEI A,ERRORN> JRST ERUNLD]> DEFINE ERR(ERRORN,EXTRA)< JRST [ EXTRA IFDIF <ERRORN>,<>,<MOVEI A,ERRORN> JRST ERRD]> DEFINE ERABRT(ERRORN,EXTRA)< JRST [ EXTRA IFDIF <ERRORN>,<>,<MOVEI A,ERRORN> JRST ERABRD]> ERUNLD::PUSH P,A MOVEM A,LSTERR PUSHJ P,UNLCKF XCTMU [POP P,1] JRST MRTNE1 ERRD:: UMOVEM A,1 MOVEM A,LSTERR JRST MRTNE1 ERABRD::MOVEM A,LSTERR JRST ITRAP ; Open a file ; Call: 1 ; Job file number ; 2(0-5) ; Byte size ; 2(6-9) ; Data mode ; RH(2) ; Access flags (see jsys manual or filsts description) ; OPENF ; Return ; +1 ; Cannot open file, error code in 1 ; +2 ; Successful .OPENF::JSYS MENTR ; Become slow, save ac's MOVE JFN,1 ; Get jfn PUSHJ P,CHKJFN ; What kind of designator is this? ERR() ; Garbage designator JFCL JRST OPENFZ ; Tty and byte pointer etc. are good TEST(NE,OPNF) ERUNLK OPNX1 ; Already open TEST(NE,ASTF) ERUNLK(DESX7) ; Output stars not allowed UMOVE B,2 ; Get access bits LDB A,[POINT 6,B,5] ; Get byte size CAILE A,^D36 ERUNLK SFBSX2 DPB A,PBYTSZ ; Store as byte size of pointer repeat 0,< ;+++ IFDEF NETN,< MOVEI A,NETDTB ; NET: DISPATCH TABLE CAIN A,(DEV) ; IS IT? JRST [ MOVE A,CAPMSK## ; YES-CHECK IF ALLOWED MOVE B,CAPENB TRNN B,WHEEL!OPER TRNE A,ARPAN JRST .+1 ; OK - CONTINUE ERUNLK (OPNX21)] ; CAN'T DO IT >;END IFDEF NETN > MOVNI A,NDEV ; Movsi a,-ndev the hard way... HRLZS A HRRZ B,DEVDSP(A) CAIE B,0(DEV) AOBJN A,.-2 MOVE C,DEVCHR(A) UMOVE B,2 LDB A,[POINT 4,B,9] MOVN D,A ROT C,-1(D) JUMPGE C,[ERUNLK(OPNX14)] ; Illegal mode HRRM A,FILSTS(JFN) HRR STS,A ANDCM STS,[XWD READF!WRTF!XCTF!RNDF!ASPF!CALLF!LONGF!EOFF!ERRF!HLTF!WNDF!ENDF!SIZF,777760] ANDI B,774000 ; Ignore bits user cant set TRZE B,400000 ; Bit 18 = 1? TRO B,HLTF ; Yes, move it down to hltf TLO STS,(B) ; Put user's bits into sts UMOVE B,2 ANDI B,17B28 IORI STS,(B) OPNFOK: SETZM FILCNT(JFN) PUSHJ P,@OPEND(DEV) ; Call the device dependent routine JRST OPENR ; Cannot open TEST(O,OPNF) ; Success MOVSI B,1 HLLM B,FILLFW(JFN) OPENFZ: AOS (P) PUSHJ P,UNLCKF JRST MRETN OPENR: CAIE A,OPNX9 ERUNLK() HRRZ B,DEV IFDEF LPTN,< CAIN B,LPTDTB TRO STS,1B26> TRNN STS,1B28 TRNN STS,1B26 ERUNLK() PUSHJ P,UNLCKF SETZM INTDF XCT INTDFF MOVEI A,"[" PBOUT MOVEI A,101 UMOVE B,1 MOVEI C,0 JFNS HRROI A,[ASCIZ / Busy-/] PSOUT OPENR1: MOVEI A,^D3000 DISMS UMOVE A,A UMOVE 2,2 TRO B,1B28 JSYS 21 JRST OPENR1 UMOVEM 1,1 HRROI 1,[ASCIZ /Go] /] PSOUT JRST SKMRTN ; Close a file ; Call: RH(1) ; Jfn ; 1(0) ; If 1 do not release jfn ; CLOSF ; Returns ; +1 ; Cannot close ; +2 ; Ok .CLOSF::JSYS MENTR CAMN 1,MINUS1 ; -1 means all JRST CLZALL HRRZ JFN,1 PUSHJ P,CLZF ERR() ; Can't close, reason in a XCTUU [SKIPL 1] ; Don't release jfn TEST(NE,OPNF) ; Or still open? JRST SKMRTN ; Yes. all done. PUSHJ P,RELJFN ; No, release jfn. JRST SKMRTN CLZALL: MOVE A,[1B2+400000] CLZFF JRST SKMRTN CLZF:: MOVEI A,CLSX2 HRRZ B,PRIMRY CAME JFN,JOBPMF CAMN JFN,B POPJ P, HLRZ B,PRIMRY CAME JFN,B PUSHJ P,CHKJFN POPJ P, ; Garbage JFCL JRST SKPRET ; Byte and tty always succeeds TEST(NN,OPNF) JRST [ MOVEI A,CLSX1 JRST UNLCKF] CAIL JFN,RJFN JRST CLZF2 ; SPECIAL DESIGNATOR MOVSI B,1 ANDCAB B,FILLFW(JFN) TLNE B,777777 JRST CLZF2 PUSHJ P,@CLOSD(DEV) ; Call device dependent stuff JRST UNLCKF TEST(Z,OPNF) CLZF2: AOS (P) JRST UNLCKF ; Release jfn ; Call: 1 ; Jfn ; RLJFN ; Returns ; +1 ; Error ; +2 ; Success ; Cannot release jfn if being assigned unless this same process as ; Assigner, and not at interrupt level .RLJFN::JSYS MENTR CAMN 1,MINUS1 ; Release all JRST RLALL HRRZ JFN,1 PUSHJ P,RLJF ERR() JRST SKMRTN RLALL: MOVE A,[1B3+400000] ; DON'T CLOSE/THIS FORK CLZFF JRST SKMRTN RLJF: PUSH P,JFN HRRZS JFN PUSHJ P,CHKJFN JRST RLJF1 ; Garbage jfn JFCL JRST [ MOVEI A,DESX4 ; Tty or byte illegal JRST RLJF3] TEST(NE,OPNF) JRST [ MOVEI A,OPNX1 ; File is open JRST RLJF4] RLJF2: PUSHJ P,RELJFN ; Finally we can release it AOSA -1(P) RLJF4: PUSHJ P,UNLCKF RLJF3: POP P,JFN POPJ P, RLJF1: CAIE A,DESX3 ; Is no name attached to this jfn? JRST RLJF3 ; Some other error HLRZ B,FILVER(JFN) ; Get fork number of originator PUSH P,A HRRZ A,SYSFK(B) ; Fork still exists? CAIN A,-1 JRST [ POP P,A JRST RLJF2 ] ; No, ok to release POP P,A CAME B,FORKN ; Is it me? JRST RLJF3 ; No SKIPE PSIBIP ; Test if pi in progress JRST RLJF3 ; Yes JRST RLJF2 ; No pi in progress, ok to release ; Close files given fork handle ; Call: RH(1) ; Fork handle ; B0(1) ; Not below the fork(s) specified ; B1(1) ; Not at the fork(s) specified ; B2(1) ; Close only (no release) ; B3(1) ; Release only (no close) ; B4(1) ; Unrestrict file ; B5(1) ; Close regardless of map count ; CLZFF ; Return ; +1 ; Always ; Traps if fork handle is bad .CLZFF::JSYS MENTR HRRZS A PUSHJ P,MAPFKH ; Call routine to map over the fork hdl PUSHJ P,CLZFF1 ; Call this for each fork JRST MRETN CLZFF1: MOVN JFN,MAXJFN HRLZS JFN CLZFF2: HLRZ B,PRIMRY CAIN B,(JFN) JRST CLZFF3 ; Don't affect primary files HRRZ B,PRIMRY CAIN B,(JFN) JRST CLZFF3 MOVE B,JOBPMF CAIN B,(JFN) JRST CLZFF3 ; Or pmf PUSH P,JFN PUSH P,1 HRRZS 1,JFN LSH 1,SJFN SKIPL FILLCK(1) JRST CLZFF4 PUSHJ P,CHKJFN ; See if this jfn is in use JRST CLZFF8 ; No name check for asgf JRST CLZFF4 ; Should not happen JRST CLZFF4 MOVSI B,777777 TEST(NE,OPNF) ; If file is open TDNE B,FILLFW(JFN) ; And map count is zero SKIPA JRST CLZFF5 ; Then it's ok to close it HLRZ B,FILVER(JFN) MOVE A,(P) CAMN B,A ; Was this jfn created by this fork JRST [ UMOVE C,1 TLNE C,(1B1) ; Are we to close files at the fork? JRST CLZFF7 ; No, skip this jfn JRST CLZFF5] ; Yes, do it EXCH A,B PUSHJ P,SKIIFA ; Skip if fork(a) < fork(b) JRST CLZFF7 CLZFF5: UMOVE C,1 TLNE C,(1B4) ; Un restrict this file? TEST(Z,FRKF) ; Yes TEST(NE,OPNF) TLNE C,(1B3) JRST CLZFF6 MOVSI B,1 ANDCAB B,FILLFW(JFN) TLNN C,(1B5) TLNN B,777777 CLZFFC: PUSHJ P,@CLOSD(DEV) JRST CLZFF7 TEST(Z,OPNF) CLZFF6: UMOVE C,1 TEST(NN,OPNF) TLNE C,(1B2) JRST CLZFF7 CLZFF9: PUSHJ P,RELJFN JRST CLZFF4 CLZFF7: CAIN A,IOX5 ; IO error? JRST [ TEST(Z,ERRF) ; IGNORE ERROR JRST CLZFFC] PUSHJ P,UNLCKF CLZFF4: POP P,1 POP P,JFN CLZFF3: AOBJN JFN,CLZFF2 POPJ P, CLZFF8: CAIE A,DESX3 JRST CLZFF4 ; ?? HLRZ B,FILVER(JFN) PUSH P,A HRRZ A,SYSFK(B) CAIN A,-1 ; Fork still exists? JRST [ POP P,A JRST CLZFF9 ] ; No POP P,A CAME B,FORKN JRST CLZFF4 SKIPE PSIBIP JRST CLZFF4 JRST CLZFF9 ; Reset jsys ; Call: RESET ; Closes all files, resets tty status etc .RESET::JSYS MENTR MOVNI A,4 KFORK ; Kill all inferior forks SKIPGE CTRLTT JRST RSTFK ; Skip tty reset if not ctrltt MOVEI A,101 MOVE B,NORMTF ; Normal modes SFMOD MOVE B,JOBNO ; GET THE CONTROLLING TTY OF THIS JOB HLRE B,JOBPT(B) ; .. JUMPL B,RSTFK ; IN CASE JUST DETACHED LDB D,TTYFFC## ; GET FORMFEED BITS OF TOP FORK MOVE B,TTICB1 MOVE C,TTICB2 ; Normal cc modes SKIPE FORKN ; AND UNLESS THIS IS TOP FORK, DPB D,[POINT 2,B,25] ; SET FF BITS IN THIS FORK SFCOC MOVE B,TAB81 ; 8 chars/tab MOVE C,TAB82 MOVE D,B STABS RSTFK: MOVEI A,400000 CIS DIR MOVEI 2,0 STIW MOVNI 2,1 DIC MOVEI 1,400000 CLZFF RWSET ;RELEASE WORKING SET SETZB 2,3 SCVEC SETOM JTLCK ; Clear JSYS trap lock SETZM JTTRW ; Clear trap word MOVSI 1,77 ; Clear JSYS trap PSI channel HLLM 1,JTMNW ; And JTMNOF flag JRST MRETN ; Get open file status ; Call: 1 ; Jfn ; GTSTS ; Return ; +1 ; 1 ; Status word as in filsts .GTSTS::NOINT JUMPL 1,GTST1 CAML 1,MAXJFN JRST GTST1 LSH 1,SJFN AOSE FILLCK(1) JRST GTST2 EXCH 2,FILSTS(1) TLNN 2,NAMEF JRST [ MOVEM 2,FILSTS(1) SETZ 2, JRST GTST0] MOVEM 2,FILSTS(1) GTST0: SETOM FILLCK(1) LSH 1,-SJFN OKINT XCT MJRSTF GTST2: LSH 1,-SJFN GTST1: OKINT JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN JRST GTSTS1 ; Illegal, return 0 JRST GTSTS2 ; Illegal, return 0 JRST GTSTS2 ; Illegal, return 0 PUSHJ P,UNLCKF UMOVEM STS,2 JRST MRETN GTSTS2: PUSHJ P,UNLCKF GTSTS1: XCTUU [SETZM 2] JRST MRTNE1 ; Set status ; Call: 1 ; Jfn ; 2 ; New status ; STSTS ; Returns ; +1 ; Erro2 ; +2 ; Ok (only errf, hltf, and frkf can be changed) .STSTS::JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN ERR() ; Bad jfn JFCL ERR(DESX4) ; Tty and byte bad UMOVE A,2 ; Get new status ANDCA A,[XWD ERRF!HLTF!FRKF,0] TDZ STS,A PUSHJ P,UNLCKF JRST SKMRTN ; Get device status ; Call: 1 ; Jfn ; GDSTS ; Returns ; +1 ; Error ; +2 ; Ok .GDSTS::JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN ERABRT() JFCL ERABRT(DESX4) MOVE A,STS ANDI A,17 PUSHJ P,@GDSTD(DEV) UMOVEM A,2 JRST UNL## ; Set device status ; Call: 1 ; Jfn ; SDSTS ; Returns ; +1 ; Always unless traps .SDSTS::JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN ERABRT() JFCL ERABRT(DESX4) UMOVE A,2 TEST(NE,OPNF) PUSHJ P,@SDSTD(DEV) JRST UNL ; Delete file ; Call: 1 ; Jfn ; DELF ; Return ; +1 ; Error, cannot delete ; +2 ; Success .DELF:: JSYS MENTR ; Become slow HRRZ JFN,1 PUSHJ P,CHKJFN ; Check it out JRST GBGJFN JFCL ERUNLK DESX4 ; Tty or byte illegal TEST(NE,ASTF) ERUNLK(DESX7) ; Output stars not allowed PUSHJ P,@DELD(DEV) ; Call device dependent routine ERUNLK() ; Couldn't delete UMOVE A,1 TLNE A,777777 JRST DELF1 TEST(NN,OPNF) JRST [ PUSHJ P,RELJFN JRST SKMRTN] DELF1: PUSHJ P,UNLCKF JRST SKMRTN ; Rename file ; Call: 1 ; Jfn 1 ; 2 ; Jfn 2 ; RNAMF ; Return ; +1 ; Error ; +2 ; Ok .RNAMF::JSYS MENTR CAMN 1,2 JRST SKMRTN HRRZ JFN,1 PUSHJ P,CHKJFN ERR() JFCL ERR(DESX4) ; Cannot rename tty or byte TEST(NE,ASTF) ERUNLK(DESX7) TEST(NE,OPNF) ERUNLK(OPNX1) ; File must not be open PUSH P,JFN PUSH P,DEV UMOVE JFN,2 HRRZS JFN PUSHJ P,CHKJFN ; Check the second jfn ERUNLK(,<POP P,DEV POP P,JFN>) JFCL ERUNLK(DESX4,<POP P,DEV POP P,JFN>) TEST(NE,ASTF) ERUNLK(DESX7,<PUSHJ P,UNLCKF POP P,DEV POP P,JFN>) TEST(NE,OPNF) ERUNLK(OPNX1,<PUSHJ P,UNLCKF POP P,DEV POP P,JFN>) POP P,A CAME A,DEV ; Can only rename on the same device ERUNLK(RNAMX1,<PUSHJ P,UNLCKF POP P,JFN>) MOVE A,(P) PUSH P,JFN PUSHJ P,@REND(DEV) ERUNLK(,<POP P,JFN PUSHJ P,UNLCKF POP P,JFN>) POP P,JFN PUSHJ P,UNLCKF POP P,JFN UMOVE 1,1 ; SOURCE DESIGNATOR TLNE 1,-1 ; DON'T RELEASE IF INDEXABLE FH JRST [ CALL UNLCKF ; JUST UNLOCK IT JRST SKMRTN] ; AND RETURN SUCCESS PUSHJ P,RELJFN JRST SKMRTN ; Convert jfn to string ; Call: 1 ; Jfn ; 2 ; String pointer ; 3 ; Format specification (see jsys manual) .JFNS:: JSYS MENTR HRRZ JFN,2 PUSHJ P,CHKJFN ERABRT() JFCL ERABRT(DESX4) PUSHJ P,UNLCKF UMOVE A,1 TLNN A,777777 JRST JFNSZ ; Not byte pointer TLC A,777777 TLCN A,777777 HRLI A,440700 ; -1 in lh, fill in SETZ B, XCTBU [IDPB B,A] ; Deposit initial null in case JFNSZ: XCTUM [HLLZ F1,2] XCTUU [SKIPN E,3] MOVE E,[BYTE (3)2,2,1,1,2,0,0(1)1(4)0(5)0,11] HLRZ A,FILDDN(JFN) ; Get pointer to device block MOVN B,(A) HRLI A,-2(B) PUSHJ P,DEVLUK MOVEI A,0 TLNE A,(1B2) TROA E,100 TRZ E,100 TLNE A,(1B4) TROA E,200 TRZ E,200 HLRZ A,FILDDN(JFN) MOVE C,1(A) ; The first word of the device name ANDCMI C,377 ; Get rid of low byte LDB D,[POINT 3,E,2] ; Get format control byte for device PUSHJ P,TAB4 CAIN D,2 ; If it is suppress system default CAME C,[ASCIZ /DSK/] ; And the device is dsk, then skip CAIN D,0 ; Or if control is "no print" JRST JFNS0 ; Don't print PUSHJ P,JFNSS ; Output the string in a MOVEI B,":" PUSHJ P,PUNCT JFNS0: HRRZ A,FILDDN(JFN) ; Get directory number LDB D,[POINT 3,E,5] ; And format control PUSHJ P,TAB4 ; Tab before field if desired TEST(NE,DIRSF) JRST JFNS0A MOVE B,FORKX SKIPGE B,FKDIR(B) MOVE B,FKDIR(B) ; B=conn dir,,user dir HLRZS B CAIN D,2 ; If suppressing default, CAME A,B ; And it is default JFNS0A: CAIN D,0 ; Or if no print is wanted JRST JFNS1 ; Then don't print MOVEI B,"<" PUSHJ P,PUNCT ; Print punctuation if desired TEST(NE,DIRSF) JRST [ PUSHJ P,JFSTAR JRST JFNS0B] HRRZ A,FILDDN(JFN) PUSHJ P,GDIRST ; Get string for this number BUG(HLT,<JFNS: GDIRST CANNOT FIND STRING FOR DIRECTORY.>) UNLOCK DIRLCK,,HIQ PUSHJ P,JFNSS ; Copy string to output OKINT JFNS0B: MOVEI B,">" PUSHJ P,PUNCT ; And output terminating punct JFNS1: HLRZ A,FILNEN(JFN) ; Get location of file name block LDB D,[POINT 3,E,8] ; And output control PUSHJ P,TAB4 ; Tab before field if required JUMPE D,JFNS2 ; No print wanted TEST(NE,NAMSF) JRST [ PUSHJ P,JFSTAR JRST JFNS2] PUSHJ P,JFNSS ; Copy string to output JFNS2: HRRZ A,FILNEN(JFN) ; Get location of extension block LDB D,[POINT 3,E,11] ; And output control PUSHJ P,TAB4 ; Tab before field if required JUMPE D,JFNS3 ; No print wanted MOVEI B,"." TRNE E,100 PUSHJ P,PUNCT ; Output punctuation if desired TEST(NE,EXTSF) JRST [ PUSHJ P,JFSTAR JRST JFNS3] PUSHJ P,JFNSS ; Copy to output JFNS3: HRRZ A,FILVER(JFN) ; Get version number LDB D,[POINT 3,E,14] ; And output control PUSHJ P,TAB4 ; Tab before field if required JUMPE D,JFNS4 ; No print wanted TRNN E,200 JRST JFNS4 MOVEI B,";" PUSHJ P,PUNCT MOVE B,A MOVEI C,12 TEST(NE,VERSF) JRST [ PUSHJ P,JFSTAR JRST MRETN] TEST(NE,RVERF) MOVNI B,0 TEST(NE,HVERF) MOVNI B,1 TEST(NE,LVERF) MOVNI B,2 PUSHJ P,NOUTXX JFNS4: TEST(NE,ASTF) JRST MRETN HRRZ A,NLUKD(DEV) IFDEF NETN,< CAIN A,NETNAM JRST JFNSNT> CAIN A,MDDNAM PUSHJ P,GETFDB ; Get a pointer to the fdb JRST MRTNE1 PUSH P,FDBREF(A) PUSH P,FDBWRT(A) PUSH P,FDBCRV(A) LDB B,PFILPC PUSH P,B PUSH P,FDBCTL(A) MOVE B,FDBACT(A) ; Get account SETZ C, ; 0 words of string TLNN B,-1 ; String account? JRST [ HRRZ C,DIRORG(B); Get length of string block SUBI C,2 ; Skip header and share count HRL C,C ; To both halves MOVEI D,1(P) ; Where to put string on stack HRLI D,DIRORG+2(B); Where to get string from HRR B,P ; Point to just before string on stack ADD P,C ; Bump to beyond string JUMPGE P,MSTKOV BLT D,0(P) ; Blt onto stack JRST .+1] PUSH P,C ; Save size of string PUSH P,B ; And account or pointer PUSH P,DIRDPW PUSH P,FDBPRT(A) PUSHJ P,USTDIR ; Unlock directory (done with it) LDB D,[POINT 3,E,17] PUSHJ P,TAB4 MOVE B,0(P) CAIN D,2 CAME B,-1(P) CAIN D,0 JRST JFNS5 MOVEI B,";" PUSHJ P,PUNCT MOVEI B,"P" PUSHJ P,PUNCT MOVE A,0(P) ; Get protection MOVEI C,10 PUSHJ P,JFNSN JFNS5: SUB P,[XWD 2,2] ; Flush protection and def prot LDB D,[POINT 3,E,20] PUSHJ P,TAB4 JUMPE D,JFNS6 MOVEI B,";" PUSHJ P,PUNCT MOVEI B,"A" PUSHJ P,PUNCT MOVE A,(P) ; Get account or pointer MOVEI C,^D10 PUSHJ P,JFNSN JFNS6: SUB P,[XWD 1,1] ; Flush account or pointer POP P,C ; Get size of saved string SUB P,C ; Flush string from stack LDB D,[POINT 1,E,21] POP P,B TLNE B,FDBTMP CAIN D,0 JRST JFNS7 MOVEI B,";" PUSHJ P,PUNCT MOVEI B,"T" PUSHJ P,BOUTA JFNS7: LDB D,[POINT 1,E,22] PUSHJ P,JFNCOM PUSHJ P,TAB4 JUMPE D,JFNS8 MOVE B,0(P) MOVEI C,^D10 PUSHJ P,NOUTXX JFNS8: SUB P,[XWD 1,1] POP P,B TRNE E,1B23 PUSHJ P,JFNDAT PUSHJ P,TAB4 POP P,B TRNE E,1B24 PUSHJ P,JFNDAT PUSHJ P,TAB4 POP P,B TRNE E,1B25 PUSHJ P,JFNDAT JFCL JRST MRETN IFDEF NETN,< JFNSNT: MOVE B,JOBNO ADDI B,^D100000 HRRZ A,FILVER(JFN) CAME A,B JRST MRETN MOVEI B,";" PUSHJ P,PUNCT MOVEI B,"T" PUSHJ P,PUNCT JRST MRETN> JFNSN: JUMPG A,JFNSS ; Copy to output MOVE B,A TLZ B,700000 NOUTXX: PUSH P,JFN PUSH P,DEV PUSH P,STS PUSH P,F1 PUSH P,E PUSH P,D PUSH P,F PUSH P,C PUSH P,B PUSHJ P,NOUTX JFCL POP P,B POP P,C POP P,F POP P,D POP P,E POP P,F1 POP P,STS POP P,DEV POP P,JFN POPJ P, JFNDAT: PUSH P,B MOVEI D,1 PUSHJ P,JFNCOM PUSHJ P,TAB4 POP P,B PUSH P,A SETZ C, HRROI A,1(P) ADD P,[XWD 4,4] ODTIM MOVEI C,-3(P) HRLI C,(<POINT 7,0>) JFNDA1: ILDB B,C JUMPE B,[SUB P,[XWD 4,4] POP P,A POPJ P,] PUSHJ P,BOUTN JRST JFNDA1 JFNCOM: MOVEI B,"," CAIE D,0 TRNN E,10 POPJ P, JRST BOUTA JFSTAR: MOVEI B,"*" JRST BOUTA PUNCT: TRNE E,1 JRST BOUTA POPJ P, TAB4: MOVEI B,11 TRNE E,2 CAIG D,0 TRNE E,4 TRON E,40 POPJ P, BOUTA: JRST BOUTN JFNSS:: MOVE C,A HRLI C,(<POINT 7,0,35>) JFNSS1: ILDB B,C JUMPE B,CPOPJ PUSH P,C ; Prepare to compute char class PUSH P,B ; IDIVI B,^D36/CCSIZE ; Ccsize and cptab and char type MOVEI B,^D36 ; Have to do it the hard way cause IDIVI B,CCSIZE ; Macro can't divide externals MOVE C,B MOVE B,0(P) IDIV B,C ; And finally the real divide LDB B,CPTAB(B+1) ; are found in gtjfn.fai JUMPE B,NTSPC ; 0 clas is normal alphas CAIE B,32 ; CAPITAL "S" (NOT SPECIAL)? CAIN B,30 ; Minus sign not special JRST NTSPC ; NOT SPECIAL CAIL B,21 ; Digits, CAPITAL T, P, OR A CAILE B,24 JRST [ MOVEI B,"V"-100 ; Special char PUSHJ P,BOUTA ; Prefix with control-v JRST NTSPC] NTSPC: POP P,B POP P,C PUSHJ P,BOUTA JRST JFNSS1 ; Get size of file ; Call: 1 ; Jfn ; SIZEF ; Return ; +1 ; Error, cannot get size of file ; +2 ; Success ; 1 ; Size in bytes ; 2 ; Size in pages .SIZEF::JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN JRST GBGJFN JFCL ERUNLK DESX4 TEST(NE,ASTF) ERUNLK(DESX7) HRRZ B,DEV ; Get dispatch address MOVEI A,DESX8 CAIE B,DSKDTB ERUNLK() PUSHJ P,GETFDB ; Get pointer to fdb ERUNLK OPNX2 LDB B,PFILPC ; Get number of pages MOVE A,FDBSIZ(A) ; And length UMOVEM A,2 UMOVEM B,3 PUSHJ P,USTDIR PUSHJ P,UNLCKF JRST SKMRTN GBGJFN::UMOVEM A,1 JRST MRTNE1 ; Backup file pointer by 1 byte ; Call: 1 JFN ; BKJFN ; Returns ; +1 ; Error, cannot backup this designator ; +2 ; Ok. .BKJFN::JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN ERR() JRST BKJTTY JRST BKJBYT HRRZ A,DEV CAIN A,TTYDTB ; Tty? JRST BKJTT1 TEST(NN,OPNF) ERR(DESX5,<PUSHJ P,UNLCKF>) MOVE A,FILBYN(JFN) SOJL A,[ERR(SFPTX3,<PUSHJ P,UNLCKF>)] PUSHJ P,SFBNR ERR(,<PUSHJ P,UNLCKF>) PUSHJ P,UNLCKF JRST SKMRTN BKJTT1: PUSHJ P,UNLCKF BKJTTY: HLRZ 2,DEV PUSHJ P,TTBKPT ERR(BKJFX1) JRST SKMRTN BKJBYT: CAIE DEV,STRDTB JRST SKMRTN MOVE A,JFN PUSHJ P,DBP UMOVEM A,1 SKMRTN::MOVE P,MPP AOS (P) JRST MRETN ; Read file byte number ; Call: 1 ; Jfn ; RFPTR ; Return ; +1 ; Error ; +2 ; Success ; 2 ; File byte number .RFPTR::JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN ERR() JFCL ERR(DESX4) TEST(NN,OPNF) ERUNLK(DESX5) MOVE A,FILBYN(JFN) UMOVEM A,2 PUSHJ P,UNLCKF JRST SKMRTN ; Set file byte number ; Call: 1 ; Job file number ; 2 ; Byte number ; SFPTR ; Return ; +1 ; Error ; +2 ; Successful .SFPTR::JSYS MENTR ; Become slow etc. MOVE JFN,1 PUSHJ P,CHKJFN ; Find out what we are dealing with ERR() JFCL ERR(DESX4) ; Tty, byte pointer, etc. illegal TEST(NN,OPNF) ERUNLK(CLSX1) UMOVE A,2 PUSHJ P,SFBNR ; Set the byte number ERUNLK() AOS (P) ; Skip return PUSHJ P,UNLCKF JRST MRETN ; Set file byte number common code ; Call: A ; Byte number ; PUSHJ P,SFBNR ; Return ; +1 ; Error of some sort, error number in a ; +2 ; Success ; Clobbers most temps SFBNR:: TEST(NN,RNDF) JRST [ MOVEI A,SFPTX2 POPJ P,] ; Illegal to reset pointer for this file CAMN A,MINUS1 MOVE A,FILLEN(JFN) ; Set to end of file if -1 JUMPL A,[MOVEI A,SFPTX3 POPJ P,] ; Illegal byte number MOVEM A,FILBYN(JFN) TEST(Z,EOFF) CAML A,FILLEN(JFN) TEST(O,EOFF) HRRZ B,FILDEV(JFN) ; Only call NEWWND CAIN B,DSKDTB ; For disk files PUSHJ P,NEWWND ; Set window pointers AOS (P) POPJ P, NFBSZ:: MOVEI C,^D36 IDIVM C,A ; Number of bytes per word MOVEI C,^D36 IDIV C,B ; New number of bytes per word PUSH P,C IMUL C,FILBYN(JFN) ; Adjust byte number IDIV C,A CAIE C+1,0 AOS C MOVEM C,FILBYN(JFN) POP P,C IMUL C,FILLEN(JFN) ; And adjust file length IDIV C,A CAIE C+1,0 AOS C MOVEM C,FILLEN(JFN) DPB B,PBYTSZ ; Deposit new byte size POPJ P, ; Read file byte size ; Call: 1 ; Jfn ; RFBSZ .RFBSZ::JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN ERABRT() JFCL ERABRT(DESX4) TEST(NN,OPNF) ERABRT(DESX5,<PUSHJ P,UNLCKF>) LDB A,PBYTSZ UMOVEM A,2 PUSHJ P,UNLCKF JRST MRETN ; Set file byte size jsys ; Call: 1 ; Job file number ; 2 ; Byte size (1 to 36) ; SFBSZ ; Return ; +1 ; Error number in a ; +2 ; Success .SFBSZ::JSYS MENTR MOVE JFN,1 PUSHJ P,CHKJFN ERABRT() JFCL ERABRT(DESX4) ; Tty, byte pointer, etc. illegal TEST(NN,OPNF) ERABRT(CLSX1,<PUSHJ P,UNLCKF>) XCTUU [SKIPLE B,2] CAILE B,^D36 ERABRT(SFBSX2,<PUSHJ P,UNLCKF>) ; Illegal byte size TEST(NE,SIZF) ERABRT(SFBSX1,<PUSHJ P,UNLCKF>) ; Illegal to change byte size LDB A,PBYTSZ ; Get previous byte size PUSHJ P,NFBSZ HRRZ B,FILDEV(JFN) ; Only call NEWWND CAIN B,DSKDTB ; For disk files PUSHJ P,NEWWND ; Recompute window pointers PUSHJ P,UNLCKF ; Unlock file JRST MRETN ; Swap jfn's ; Call: 1 ; Jfn 1 ; 2 ; Jfn 2 ; SWJFN .SWJFN::JSYS MENTR CAME 1,JOBPMF ; Neither file had CAMN 2,JOBPMF ; Better be JOBPMF ERABRT(DESX1) ; Else lose... MOVE JFN,1 PUSHJ P,CHKJFN JRST ERABRD JFCL ERABRT(DESX4) PUSH P,JFN UMOVE JFN,2 PUSHJ P,CHKJFN ERABRT(,<POP P,JFN MOVE DEV,FILDEV(JFN) PUSHJ P,UNLCKF>) JFCL ERABRT(DESX4,<POP P,JFN MOVE DEV,FILDEV(JFN) PUSHJ P,UNLCKF>) POP P,A MOVEI B,[FILBYT FILBYN FILLEN FILCNT FILWND FILSTS FILDEV FILOFN FILLFW FILDDN FILNEN FILVER FILDNW FILEXW] HRLI B,-^D12 HRLI A,D HRLI JFN,D SWJFNL: MOVE D,(B) MOVE C,@JFN EXCH C,@A MOVEM C,@JFN AOBJN B,SWJFNL SETOM FILLCK(JFN) SETOM FILLCK(A) JRST MRETN ; Get fdb entry ; Call: 1 JFN ; LH(2) ; Number of words to read ; RH(2) ; First word to read ; 3 ; Location to store words ; GTJFN .GTFDB::JSYS MENTR UMOVE A,2 HLRZ B,A ; Get count HRRZS A ; Offset CAIL A,FDBLEN ERABRT(GFDBX1) ; Offset too big ADD A,B CAIE B,0 ; 0 words illegal CAILE A,FDBLEN ERABRT(GFDBX2) ; Count too big UMOVE JFN,1 PUSHJ P,CHKJFN ; Check the jfn ERABRT() ; Garbage JFCL ERABRT(DESX4) ; Tty or byte illegal TEST(NE,ASTF) ERABRT(DESX7,<PUSHJ P,UNLCKF>) HRRZ A,NLUKD(DEV) ; Get name lookup dispatch CAIE A,MDDNAM ; Must be mddnam ERABRT(GFDBX1,<PUSHJ P,UNLCKF>) ; Cannot read fdb for device PUSHJ P,GETFDB ; Get pointer to the fdb ERABRT(DESX3,<PUSHJ P,UNLCKF>) UMOVE B,2 ADDI A,(B) ; Offset pointer to fd UMOVE C,3 ; To address HRL C,A ; From address HLRZS B ; Count ADDI B,(C) ; Last address+1 XCTMU [BLT C,-1(B)] PUSHJ P,USTDIR PUSHJ P,UNLCKF JRST MRETN ; Change fdb ; Call: LH(1) ; Offset ; RH(1) ; Jfn ; 2 ; Mask ; 3 ; Data ; CHFDB .CHFDB::JSYS MENTR UMOVE A,1 HRRZ JFN,A HLRZS A CAIL A,FDBLEN ERABRT(CFDBX1) ; Offset too big PUSHJ P,CHKJFN ; Check jfn ERABRT() ; Garbage JFCL ERABRT(DESX4) ; Tty or byte illegal TEST(NE,ASTF) ERABRT(DESX7,<PUSHJ P,UNLCKF>) HRRZ A,NLUKD(DEV) CAIE A,MDDNAM ERABRT(CFDBX1,<PUSHJ P,UNLCKF>) ; No fdb for non mdd devices PUSHJ P,GETFDB ; Get the fdb ERABRT(DESX3,<PUSHJ P,UNLCKF>) XCTUU [HLRZ D,1] PUSH P,A ; Save fdb loc UMOVE B,2 ; Mask ANDCM B,WRTR(D) ; Writer bits? JUMPN B,CHFDB1 ; No, check owner and wheel TEST(NE,WRTF) ; Yes, was file opened for write? JRST CHFDB2 ; Yes, allow change HRLI A,100000 ; No, check for write access PUSHJ P,ACCCHK JRST CHFDB3 ; No write access, still ok if owner JRST CHFDB2 ; Ok, go ahead CHFDB1: ANDCM B,OWNER(D) JUMPN B,CHFDB4 ; Requires mor than owner status CHFDB3: MOVSI A,XCTF PUSHJ P,DIRCHK ; Check if we have owner rights JRST CHFDB5 JRST CHFDB2 CHFDB4: ANDCM B,WOPR(D) JUMPN B,CHFDB6 ; Can't be done CHFDB5: MOVE B,CAPENB TRNE B,WHEEL!OPER JRST CHFDB2 CHFDB6: MOVEI A,CFDBX2 PUSHJ P,USTDIR PUSHJ P,UNLCKF JRST ERABRD CHFDB2: POP P,A ADD A,D UMOVE C,3 ; Data MOVE B,(A) ; Old data UMOVE D,2 ; Mask AND C,D ; Retain masked bits of new data ANDCM B,D ; Flush bits to be replaced from old IOR B,C MOVEM B,(A) PUSHJ P,USTDIR PUSHJ P,UNLCKF JRST MRETN ; Access tables for chfdb WRTR: 0 0 0 0 0 0 0,,777777 ; PERMIT CHANGING USE COUNT 0 0 007700000000 777777777777 0 0 0 0 0 0 0 0 0 777777777777 OWNER: 0 ; Header FDBTMP!FDBDEL!FDBNXF!FDBSUB!FDBUND!FDBKEP!FDBEPH,,0 ; FDBCTL 0 ; Fdbext 0 ; Fdbadr 000000,,777777 ; Fdbprt 0 ; Fdbcre 777777,,000000 ; Fdbuse 0 ; Fdbver 0 ; Fdbact 777700,,000000 ; Fdbbyv (byte size and # backups) 777777,,777777 ; Fdbsiz 0 ; Fdbcrv 0 ; Fdbwrt 0 ; Fdbref 0 ; Fdbcnt 310000000000 ; Backup (ALLOW ARCHIVE FLAGS - BSYS) 0 0 0 0 777777777777 ; Fdbusw WOPR: 0 ; Header FDBPRM,,0 ; FDBCTL 0 0 0 777777777777 ; Creation date 0 0 0 0 0 777777777777 ; Fdbcrv 777777777777 ; Fdbwrt 777777777777 ; Fdbref 777777777777 ; Fdbcnt 777777777777 777777777777 777777777777 777777777777 777777777777 0 ; String to directory ; Call: 1 ; Positive for no recognition ; 2 ; Source designato$ ; STDIR ; Return ; +1 ; No match ; +2 ; Ambiguous ; +3 ; Unique match .STDIR::JSYS MENTR ; UMOVE A,1 ; NOT NECESSARY..BUT LOGICAL UMOVE B,3 ; DEVICE DESIGNATOR IF ANY PUSHJ P,SETUNT## ERR() UMOVE A,2 ; STRING POINTER PUSHJ P,CPYFUS JRST MRTNE1 PUSH P,[MAXLC##] ; Save place for FILCNT (FILOPT-FILCNT=2) PUSH P,A ; Save location of the temp block PUSH P,B ; Save string pointer to tail ; MOVEI JFN,-FILOPT(P) ; Set jfn so filopt(jfn) refers to pdl MOVNI JFN,FILOPT ; Gotta do it the hard way ADD JFN,P HRRZS JFN XCTUU [SKIPL 1] TEST(OA,NREC) TEST(Z,NREC) PUSHJ P,DIRLUK SOS -3(P) ; Undo one skip JRST STDIR1 XCTUU [EXCH A,1] ; Return the directory number JUMPGE A,STDIR4 ; If no recognition, then no tail to copy UMOVE A,2 ; Get the user's pointer MOVE B,-1(P) ; Get temp block location PUSHJ P,CPYTUS STDIR4: UMOVE A,1 ; Get the directory number back PUSHJ P,GETDDB BUG(HLT,<STDIR: GETDDB FAILED WHEN DIRLUK DIDN'T.>) MOVE A,DDBMOD(A) XCTUU [HLLM A,1] PUSHJ P,USTDIR MOVEI A,MRETN ; Success return routine AOSA -3(P) ; Return +3 STDIR1: MOVEI A,MRTNE1 ; Error return routine AOS -3(P) MOVEM A,-2(P) ; Save return routine adr SUB P,BHC+1 ; Clear str ptr to tail POP P,B ; Recover temp block location MOVEI A,JSBFRE PUSHJ P,RELFRE POP P,A ; a _ return routine adr JRST 0(A) ; Directory number to string conversion ; Call: 1 ; Sink designator ; 2 ; Directory number ; DIRST ; Return ; +1 ; Error ; +2 ; Ok .DIRST::JSYS MENTR UMOVE A,2 ; DIRNUM & BIT UMOVE B,3 PUSHJ P,SETUNT ERR() XCTUU [HRRZ A,2] PUSHJ P,GDIRST JRST MRTNE1 UNLOCK DIRLCK,,HIQ PUSHJ P,JFNSS AOS (P) JRST MRETN END ;OF FILEJS.MAC