Trailing-Edge
-
PDP-10 Archives
-
BB-M080E-SM
-
monitor-sources/gtjfn.mac
There are 52 other files named gtjfn.mac in the archive. Click here to see a list.
;Edit 3013 to GTJFN.MAC by PRATT on Mon 12-Sep-83, for SPR #17124
; Fix GJ%MSG problem which causes user confusion.
;Edit 3011 to GTJFN.MAC by TBOYLE on Wed 7-Sep-83, for SPR #17233
; Make DEFEXT: return GJFX23 error if it occurs.
;Edit 2945 by LOMARTIRE on Wed 6-Apr-83, for SPR #18751
; Do not output SYS: when escape first character hit.
; UPD ID= 58, FARK:<5-WORKING-SOURCES.MONITOR>GTJFN.MAC.2, 9-Jun-82 13:01:28 by DONAHUE
;Edit 2625 - Don't allocate CTRL/R buffer if string is from memory
; UPD ID= 478, SNARK:<5.MONITOR>GTJFN.MAC.18, 16-Feb-82 16:39:59 by GROUT
;Revision of TCO 5.1656 - fix typographical error
; UPD ID= 442, SNARK:<5.MONITOR>GTJFN.MAC.17, 26-Jan-82 10:02:43 by GROUT
;TCO 5.1656 - Don't expand existing DSK: if G1%SLN set
; UPD ID= 300, SNARK:<5.MONITOR>GTJFN.MAC.16, 28-Oct-81 11:33:19 by MURPHY
;Take out TCO 5.1415 because it affects external behaviour of GTJFN.
; UPD ID= 254, SNARK:<5.MONITOR>GTJFN.MAC.15, 12-Oct-81 11:41:35 by COBB
;TCO 5.1562 - Insert default fields when GJ%OFG (parse-only)
; UPD ID= 88, SNARK:<5.MONITOR>GTJFN.MAC.14, 4-Aug-81 09:33:39 by SCHMITT
;TCO 5.1441 - Check for stars allowed when defaulting .GJALL
; UPD ID= 34, SNARK:<5.MONITOR>GTJFN.MAC.13, 15-Jul-81 15:03:15 by SCHMITT
;TCO 5.1415 - Specify a JFN as parse only early so no FDB created
; UPD ID= 2210, SNARK:<5.MONITOR>GTJFN.MAC.12, 18-Jun-81 08:54:39 by SCHMITT
;A little more of TCO 5.1353
; UPD ID= 2102, SNARK:<5.MONITOR>GTJFN.MAC.10, 28-May-81 12:03:13 by SCHMITT
;Tco 5.1353 - Fix GNJFN when higher deleted version of file exists
; UPD ID= 1489, SNARK:<5.MONITOR>GTJFN.MAC.9, 25-Jan-81 20:33:21 by ZIMA
;TCO 5.1244 - Fix lost JFNs problem by ERJMPing TEXTI.
; UPD ID= 1486, SNARK:<5.MONITOR>GTJFN.MAC.8, 24-Jan-81 23:48:38 by ZIMA
;TCO 5.1241 - Fix ILPPT3 BUGHLTs caused by JFNRD on for short-form GTJFN.
; UPD ID= 1226, SNARK:<5.MONITOR>GTJFN.MAC.7, 3-Nov-80 16:37:00 by DONAHUE
;MORE 5.1164 - MOVE CHECK TO GTJF23+15 AND LITERAL AT ENDLZ1+3
; UPD ID= 1110, SNARK:<5.MONITOR>GTJFN.MAC.6, 2-Oct-80 14:01:00 by DONAHUE
;TCO 5.1164 - Check for logical name loop at SETDV1+2
; UPD ID= 727, SNARK:<5.MONITOR>GTJFN.MAC.5, 2-Jul-80 16:08:59 by SANICHARA
;TCO 5.1091 - Check for valid ASCII Char at REDFL1+3
; UPD ID= 718, SNARK:<5.MONITOR>GTJFN.MAC.4, 1-Jul-80 14:52:58 by LYONS
;TCO 5.1087 - make ^X echo in a GTJFN
; UPD ID= 706, SNARK:<5.MONITOR>GTJFN.MAC.3, 26-Jun-80 13:38:20 by SCHMITT
;TCO 5.1083 - BE NOINT WHILE JSSTLK IS LOCKED IN SETDEV
; UPD ID= 678, SNARK:<5.MONITOR>GTJFN.MAC.2, 19-Jun-80 15:14:03 by OSMAN
;tco 5.1070 - Prevent "Byte count too small" on DELETE of real long name
;<4.MONITOR>GTJFN.MAC.35, 15-Oct-79 16:19:01, Edit by SCHMITT
;TCO 4.2252 - HAVE GNJFN CLR IGDLF ONLY IF WANT LOWEST NON-DELETED VERSION
;<OSMAN.MON>GTJFN.MAC.1, 10-Sep-79 15:32:38, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>GTJFN.MAC.33, 3-Aug-79 11:48:18, EDIT BY DBELL
;MOVE CHECKING FOR G1%SLN TO A BETTER PLACE
;<4.MONITOR>GTJFN.MAC.32, 26-Jun-79 11:24:37, EDIT BY DBELL
;TCO 4.2311 - IMPLEMENT G1%SLN TO PREVENT EXPANSION OF LOGICAL NAMES
;<4.MONITOR>GTJFN.MAC.31, 12-Jun-79 08:30:50, EDIT BY MILLER
;DON'T CALL DEVAV IN SETDEV IF PARSE-ONLY
;<4.MONITOR>GTJFN.MAC.30, 6-Jun-79 19:05:17, EDIT BY DBELL
;REMOVE TCO 4.2252, IT CAUSED OTHER BUGS.
;<4.MONITOR>GTJFN.MAC.29, 30-May-79 11:49:34, EDIT BY DBELL
;TCO 4.2262 - SET GNJFF TO INDICATE A GNJFN IS BEING DONE
;<4.MONITOR>GTJFN.MAC.28, 29-May-79 16:09:19, EDIT BY KIRSCHEN
;REMOVE SPOOLED FILE FORMS ATTRIBUTE FROM ATTRIBUTE LIST
;<4.MONITOR>GTJFN.MAC.27, 18-May-79 11:26:26, EDIT BY DBELL
;TCO 4.2252 - HAVE GNJFN ONLY SET IGDLF IF WE WANT DELETED FILES.
;<4.MONITOR>GTJFN.MAC.26, 17-May-79 08:44:12, EDIT BY BLOUNT
;TAKE OFF-LINE OUT OF PRFXTB
;MERGE ARNIE'S CHANGES INTO SOURCES:
;<4.MONITOR>GTJFN.MAC.26, 19-Apr-79 14:33:41, EDIT BY MILLER
;<4.MONITOR>GTJFN.MAC.25, 19-Apr-79 14:26:24, EDIT BY MILLER
;FIX CODE AT DEFDI1 TO CHECK FOR ASTF
;<4.MONITOR>GTJFN.MAC.24, 12-Apr-79 17:20:38, EDIT BY MILLER
;MAKE PARSE ONLY WORK ON DEVICE NAMES
;<4.MONITOR>GTJFN.MAC.23, 21-Mar-79 12:43:16, EDIT BY BOSACK
;ADD MONUMENTS TO NOINTNESS IN CHKDSK AND CNVSIX HEADINGS
;<4.MONITOR>GTJFN.MAC.22, 15-Mar-79 14:25:30, EDIT BY KIRSCHEN
;FIX OKINT FREE SPACE ASSIGN AT STODN1
;<4.MONITOR>GTJFN.MAC.21, 15-Mar-79 13:31:37, EDIT BY DBELL
;TCO 4.2215 - CLEAR THE RIGHT FLAG WHEN DEFAULTING DSK*: AT DEFSDV
;<4.MONITOR>GTJFN.MAC.20, 6-Mar-79 10:13:40, EDIT BY MILLER
;<4.MONITOR>GTJFN.MAC.19, 5-Mar-79 13:15:55, EDIT BY MILLER
;CALL RELMT FROM RELJFN IF JFN IS ON AN MT
;<4.MONITOR>GTJFN.MAC.18, 4-Mar-79 17:24:47, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>GTJFN.MAC.17, 19-Feb-79 13:47:28, EDIT BY DBELL
;TCO 4.2193 - MAKE RECOGNITION OF DSK*: WORK PROPERLY AT DFDVTY
;<4.MONITOR>GTJFN.MAC.16, 11-Jan-79 10:30:01, EDIT BY MILLER
;<4.MONITOR>GTJFN.MAC.15, 10-Jan-79 10:36:16, EDIT BY MILLER
;BE SURE TO CLEAR NREC IN ENDEXT
;<4.MONITOR>GTJFN.MAC.14, 19-Dec-78 12:26:36, EDIT BY MILLER
;DON'T ALLOW GTJFN ON MTX: IF DEVICE ASSIGNED TO ANOTHER JOB
;<4.MONITOR>GTJFN.MAC.13, 15-Dec-78 12:51:43, EDIT BY MILLER
;<4.MONITOR>GTJFN.MAC.12, 15-Dec-78 12:50:00, EDIT BY MILLER
;MAKE SURE GNJFN ALWAYS UNLOCKS JFN AND GOES OKINT
;<4.MONITOR>GTJFN.MAC.11, 4-Dec-78 14:46:44, EDIT BY MILLER
;ZERO FILOFN IN ASGJFN
;<4.MONITOR>GTJFN.MAC.10, 23-Nov-78 21:58:14, EDIT BY ZIMA
;TCO 4.2097 - CHECK FOR DISK FILE JFN BEFORE GOING OKINT IN GNJFN
;<4.MONITOR>GTJFN.MAC.9, 16-NOV-78 14:11:46, Edit by KONEN
;ALLOW A PARSE-ONLY JFN FOR A FILE ON AN UNMOUNTED STR
;<KONEN>GTJFN.MAC.3, 31-Jul-78 11:19:46, Edit by KONEN
;DO NOT ALLOW A JFN FOR A FILE ON AN UNMOUNTED STRUCTURE
;INSTALLED ARCHIVE SYSTEM MODIFICATIONS, OFFLINE ATTRIBUTE
;<4.MONITOR>GTJFN.MAC.6, 17-Oct-78 10:00:40, EDIT BY MILLER
;CHANGE ACCESS TO TAPE-ACCESS
;<4.MONITOR>GTJFN.MAC.5, 16-Oct-78 17:40:57, EDIT BY DBELL
;TCO 4.2045 - ACCEPT COMMA AS CONFIRMATION CHAR AFTER RECOGNITION IS DONE
;<4.MONITOR>GTJFN.MAC.4, 13-Oct-78 11:01:56, EDIT BY MILLER
;ADD ACCESS ATTRIBUTE
;<4.MONITOR>GTJFN.MAC.3, 16-Aug-78 16:38:18, EDIT BY ENGEL
;FIX AT ENDAL2 FOR GJ%IFG AND GJ%OFG CASE
;<4.MONITOR>GTJFN.MAC.2, 7-Jul-78 15:14:26, Edit by HEMPHILL
;IF DIRECTORY LOOKUP FAILS IN DEFDI0, STEP STRUCTURE IF ALLOWED
;<4.MONITOR>GTJFN.MAC.1, 7-Jul-78 14;IF DIRECTORY LOOKUP FAILS IN ENDDI0, STEP STRUCTURE IF ALLOWED
SEARCH PROLOG
TTITLE GTJFN ; & gnjfn
SWAPCD
PNCATT==:";" ;PUNCTUATION FOR ATTRIBUTES
PNCVER==:"." ;PUNCTUATION FOR VERSION
PNCPFX==:":" ;PREFIX PUNCTUATION FOR ATTRIBUTES
WLDCHR==:"%" ; WILD CHARACTER
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;GENERAL DEFINITIONS FOR RDTXT PROCESSING
VARC==17 ;WORDS OF STACK NEEDED FOR RDTXT STUFF
STRPNT==0 ;OFFSET ON STACK FOR MAIN STRING POINTER
STRCNT==1 ;OFFSET FOR MAX CHARACTER COUNT
LDPNT==2 ;OFFSET FOR BYTE POINTER FOR ILDB'S
LDCNT==3 ;OFFSET FOR COUNT OF BYTES IN LDPNT STRING
ARGCNT==4 ;ARG COUNT FOR TEXT CALL
ARGFLG==5 ;FLAG WORD
ARGJFN==6 ;SOURCE,,DEST
CURPNT==7 ;CURRENT BUFFER POINTER
ARGDST==CURPNT ;STRING POINTER
CURCNT==10 ;CURRENT BYTE POINTER
ARGDC==CURCNT ;BYTE COUNT
ARGSTR==11 ;START OF BUFFER
ARGCR==12 ;^R BUFFER POINTER
STPCNT==13 ;LOGICAL NAME STEP COUNTER
FLAGS==14 ; LOCAL FLAG WORD
CNTWRD==15 ;MAX CHARACTER COUNT
PREFIX==16 ;VALUE OF ATTRIBUTE PREFIX
LOWBRK==COMMA ;LOWEST STATE FOR INTERESTING BREAK
;CHARACTERS
HGHBRK==ALTMOD ;HIGHEST STATE FOR INTERESTING BREAK
;CHARACTERS
MAXINP==<^D120-VARC>*5 ;MAX WORDS TO GET FOR TEXTI
DEFINP==MAXINP ;DEFAULT SIZE OF RDTXT BUFFER
LNHDRL==2 ;LENGTH OF LOGICAL NAME CHAIN BLOCK HDR
;SPECIAL AC DEFINITIONS USED HEREIN
DEFAC (TXT,P6) ;POINTER FOR RDTXT
DEFAC (E,Q3) ;POINTER TO USER PARAMETER BLOCK
DEFAC (STS,P1) ; LH-FILE STATUS, RH-MISC FLAGS
DEFAC (JFN,P2) ;THE CURRENT JFN
DEFAC (NUM,P3) ;USED AROUND GTJFN LOOP TO ACCUMULATE NUMBERS
DEFAC (DEV,P4) ;LH-DEVICE BITS, RH-DEVICE DISPATCH TABLE
DEFAC (F1,P5) ;MORE FLAGS FOR GTJFN AND LOOKUP ROUTINES
DEFINE TMSG(M)<
HRROI B,[ASCIZ M]
CALL TSTR1>
DEFINE CHOUT(C)<
MOVEI B,C
CALL OUTCH>
DEFINE ERRLJF(N,EXTRA)<
JRST [ EXTRA
IFDIF <N>,<>,<MOVEI A,N>
JRST ERRDO]>
; POINTERS TO THINGS IN JFN BLOCK
PFLMOD::POINT 4,FILSTS(JFN),35 ; MODE OF OPEN
PBYTPO::POINT 6,FILBYT(JFN),5 ; Points to "p" of file byte pointer
PBYTSZ::POINT 6,FILBYT(JFN),11 ; Points to "s" of file byte pointer
;DEFINITIONS OF ENTITIES IN THE TXT BLOCK
DEFSTR (PFXVAL,PREFIX(TXT),35,9) ;POINTER TO THE PREFIX VALUE
; Get a jfn for a file name
; Call: 1 ; E
; 2 ; String designator
; GTJFN
; Or
; LH(1) ; Flags (bit 17 = 1)
; RH(1) ; Default version
; 2 ; String designator or xwd infile,outfile
; GTJFN
; Return
; +1 error, in 1, error code
; +2 ok, in 1, the jfn for the file
; LH(E) ; Flags
; RH(E) ; Default version
; LH(E+1) ; Input jfn (377777 means none)
; RH(E+1) ; Output jfn (377777 means none)
; E+2 ; Default string pointer device
; E+3 ; Default string pointer directory
; E+4 ; Default string pointer name
; E+5 ; Default string pointer extension
; E+6 ; Default string pointer protection
; E+7 ; Default string pointer account
; E+10 ; Desired jfn if jfnf=1 (optional)
; E+11 ;ALTERNATE FLAGS,,COUNT (CONTROLLED BY JFNRD)
; E+12 ;RETURN BUFFER ADDRESS
; E+13 ;RETURN BUFFER ADDRESS SIZE IN WORDS
; E+14 ; ^R BUFFER(CONTROLLED BY G1%RBF)
; E+15 ; POINTER TO DESTINATION BUFFER
; E+16 ;POINTER TO ARBITRARY ATTRIBUTES BLOCK
; If a default string pointer is 0, then it is assumed unspecified
; If the lh of a default string pointer is 777777, 440700 is assumed
; Table of byte pointers for getting character class
; THIS TABLE IS ALSO USED BY LOGICAL NAME ROUTINES (LOGNAM)
CCSIZE==:5 ; Width of character class field
CCBPW==:^D36/CCSIZE
RADIX ^D10
Q==CCSIZE-1
CPTAB:: REPEAT ^D36/CCSIZE,<
POINT CCSIZE,CCTAB(B),Q
Q==Q+CCSIZE>
RADIX 8
; Character classification table
DEFINE CCN(C,N)<
REPEAT N,<CC1(C)>>
DEFINE CC1(C)<
QQ==QQ+CCSIZE
IFG QQ-^D35,<
QW
QW==0
QQ==CCSIZE-1>
QW==QW+<C>B<QQ>>
QQ==-1
QW==0
CCTAB: CC1(17) ; Null
CC1(17) ; Control-a
CCN 17,4 ; Control-b to e
CC1(6) ; Control-f
CCN 17,2 ; Control-g & h
CC1(5) ; TAB
CC1(7) ; LF
CC1(17) ; Control-k
CC1(7) ;CONTROL-L (FF)
CC1(34) ;CONTROL-M (CR)
CCN 17,4 ; Control-n - q
CC1(3) ; Control-r
CCN 17,2 ; Control-s, t
CC1 (2) ;CONT-U
CC1(16) ; Control-v
CC1(2) ; Control-w
CC1(17) ; Control-x
CC1(17) ; CONTROL-Y
CC1(7) ;CONTROL-Z
CC1(10) ; Alt-mode
CCN 17,3 ; 34-36
CC1(7) ; Eol
CC1(5) ; Space
CCN 7,3 ; ! " #
CC1(0) ; $
CC1(33) ; %
CC1 (17) ; &
CCN 7,3 ;' ( )
CC1(20) ; Asterisk
CC1(7) ; +
CC1(4) ; Comma
CC1(30) ; -
CC1(14) ; Dot
CC1(7) ; Slash
CCN 21,12 ; Digits
CC1(11) ; Colon
CC1(15) ; Semi-colon
CC1(12) ; <
CC1(7) ; =
CC1(13) ; >
CC1(32) ; ?
CC1(7) ; @
CC1(24) ; A
CCN 0,16 ; B - o
CC1(23) ; P
CCN 0,3 ; Q - s
CC1(22) ; T
CCN 0,6 ; U - z
CC1 (12) ; [
CC1 (17) ;\
CC1 (13) ; ]
CC1 (17) ; ^
CC1(0) ; _
CC1(17) ; Acute accent
CC1(27) ; Lower case a
CCN 1,16 ; Lower case b - o
CC1(26) ; Lower case p
CCN 1,3 ; Lower case q - s
CC1(25) ; Lower case t
CCN 1,6 ; Lower case u - z
CCN 17,4 ; Curly brackets vert bar complement
CC1(2) ; Rubout
QW
.GTJFN::MCENT ; Enter slow code
SETZ TXT, ; MARK THAT TXT IS NOT SET UP YET
MOVE E,A ; Set pointer to parameter block
TLNE E,777777 ; Lh is non-zero?
HRRI E,1 ; Point to ac's
HRRZ F1,E
XCTU [HLLZ F,0(F1)] ; Get flags from user
CAIN F1,1 ; Short form? (or doesn't matter case)
TQZ <JFNRD> ; Yes, GJ%XTN not allowed
SETZB F1,STS ; Clear f1 & sts
TQNE <NACCF>
TQO <FRKF>
;TQNE <OSTRF> ;TCO 5.1415 - IS THIS A PARSE ONLY JFN
;TQO <ASTF> ; YES, SAY SO
TLNE E,2 ; Is 2 a pointer
JRST GTJFZ ; No, skip the following
XCTU [HLRZ A,2] ; Get lh of byte pointer
HRLZI B,(<POINT 7,0>)
TRNN A,777777
XCTU [SETZM 2] ; Clear pointer if lh = 0
CAIN A,777777
XCTU [HLLM B,2] ; Put 7 bit byte into lh if -1
CAIE A,0 ; Does string pointer exist?
TQOA <STRF> ; Yes it does
GTJFZ: TQZ <STRF> ; No it does not
CALL INFTST
JRST GTJFZ1
RFCOC
PUSH P,B
PUSH P,C
RFMOD ;GET MODE BITS TOO
TXZ B,TT%OSP ;FORGET OUTPUT SUPPRESS
PUSH P,B ;SAVE THEM
TRZ B,3B29 ;CLEAR DATA MODE FIELD
TRO B,17B23+1B29 ;SET BREAK ON EVERYTHING
SFMOD ;AND PUT IT IN EFFECT
CALL SFCC0
GTJFZ1: TLNN E,777777 ; Can't specify jfn if short form
TQNN <JFNF> ; Is user trying to specify jfn?
JRST GTJF1 ; No.
HRRZ JFN,E
XCTU [SKIPL JFN,10(JFN)] ; Yes, get his version of jfn
CAIL JFN,MJFN
ERRLJF GJFX1,<MOVEM JFN,ERRSAV>
CAIE JFN,.PRIIN ;PRIMARY INPUT?
CAIN JFN,.PRIOU ;NO. PRIMARY OUTPUT?
ERRLJF GJFX1,<MOVEM JFN,ERRSAV> ;YES. CANT SPECIFY THAT JFN
GTJFZ2: NOINT
LOCK JFNLCK
GTJFZ3: CAML JFN,MAXJFN ; Above currently available jfn's?
JRST [ PUSH P,JFN ; Yes, sve this
MOVE JFN,MAXJFN
AOS MAXJFN
IMULI JFN,MLJFN
CALL RELJF2
POP P,JFN
JRST GTJFZ3]
IMULI JFN,MLJFN ;MAKE IT A USEABLE JFN
SKIPN FILSTS(JFN) ; Is this jfn free?
JRST [ JUMPE JFN,.+1 ;AND NOT 0?
CALL ASGJF1 ; Yes, assign it
JRST GTJF01]
UNLOCK JFNLCK
OKINT
TQNN <JFNAF>
ERRLJF GJFX2,<MOVEM JFN,ERRSAV>
GTJF1: CALL ASGJFN
ERRLJF(GJFX3) ; Jfn not available
GTJF01: CALL SETSTR ;SET STAR BITS IN STS CORRECTLY
TQNN <JFNRD> ;EXTENDED BLOCK GIVEN?
JRST USDFLT ;NO. USE DEFAULT BUFFER SIZE
HRRZ D,E
MOVX A,G1%IIN
XCTU [TDNE A,11(D)] ; Want to find invisible files?
TQO <IGIVF> ; Yes, flag that fact
XCTU [HRRZ A,11(D)] ;YES. GET SIZE OF EXTENDED BLOCK
CAIGE A,2 ;IS THERE A COUNT GIVEN?
JRST USDFLT ;NO. GO AROUND THE REST
XCTU [SKIPG B,13(D)] ;YES. IS IT NON-ZERO?
MOVEI B,DEFINP ;NO. USE THE DEFAULT
CAIGE A,3 ;HAVE A ^R BUFFER?
JRST USDFL1 ;NO. GO ON THEN
XCTU [SKIPN 14(D)] ;IS THERE A ^R BUFFER?
JRST USDFL1 ;NO. USE VALUE WE NOW HAVE
SKIPA B,[MAXINP] ;YES. USE MAXIMUM VALUE
USDFLT: MOVEI B,DEFINP ;NO.GET DEFAULT
USDFL1: CAILE B,MAXINP ;WITHIN REASONABLE BOUNDS?
MOVEI B,MAXINP ;NO. MAKE IT SO
USDFL2: PUSH P,B ;SAVE COUNT
IDIVI B,5 ;GET NUMBER OF WORDS
SKIPE C ;INTEGRAL NUMBER?
AOS B ;NO. GET ONE MORE WORD FOR THE SLOP
ADDI B,VARC+1 ;GET ADDITIONAL WORDS NEEDED
NOINT ;PRESERVE THE SANCTITY OF THE JSB
CALL ASGJFR ;GET SOME SPACE
JRST [ OKINT ;NOT THERE APPARENTLY
POP P,0(P) ;CLEAN UP THE STACK
ERRLJF (GJFX22)] ;GO COMPLAIN TO THE CALLER
; ..
;GTJFN...
MOVEI TXT,1(A) ;ESTABLISH ARG REGION
HRLI A,(<POINT 7,0,35>) ;MAKE IT A STRING POINTER
HRLM A,FILLNM(JFN) ;SAVE THE BLOCK ADDRESS FOR RELJFN
OKINT ;GOT IT. ALLOW INTERRUPTS
ADDI A,VARC ;TO BEGINNING OF STRING SPACE
HRRZ B,A
SETZM 1(B) ;INITIALIZE FIRST WORD OF STRING TO NULL
SETZM STRPNT(TXT) ;CLEAR RDTXT INPUT
SETZM FLAGS(TXT) ;CLEAR FLAGS
SETZM STPCNT(TXT) ;CLEAR LOGICAL NAME STEP COUNT
POP P,B ;RESTORE ORIGINAL BYTE COUNT
MOVEM B,STRCNT(TXT) ;SAVE IT
MOVEM A,ARGCR(TXT) ;^R BUFFER
TQNN <JFNRD> ;HAVE AN EXTENDED BLOCK?
JRST GJF00 ;NO
HRRZ D,E
UMOVE C,11(D) ;GET FLAG WORD
MOVX B,NOLOGF ;GET SUPPRESSION OF LOGICAL NAMES BIT
TXNE C,G1%SLN ;WANT THEM SUPPRESSED?
IORM B,FLAGS(TXT) ;YES, REMEMBER THAT
HRRZ B,C ;GET NUMBER OF EXTENDED WORDS
CAIGE B,3 ;INCLUDE A ^R BUFFER?
JRST GJF00 ;;NO.
XCTU [SKIPN B,14(D)] ;IS IT NON-ZERO?
JRST GJF00 ;NO. GO ON
PUSH P,[0] ;A TEST WORD ON THE STACK
PUSH P,[0] ;AND ANOTHER FOR THE MAIN STRING
MOVX A,RIEFLG ;SEE IF THIS IS A RETURN ON EMPTY CALL
TXNE C,G1%RIE ;...
IORM A,FLAGS(TXT) ;YES, REMEMBER THIS FOR LATER
TXNN C,G1%RBF ;IS ^R BUFFER CONTIGUOUS?
XCTU [SKIPN A,12(D)] ;IS THERE A BUFFER?
JRST GJF01 ;NO. GO ON
TLC A,-1 ;YES. MAKE IT A GOOD POINTER
TLCN A,-1
HRLI A,(<POINT 7,0>)
IBP A ;AND INCREMENT IT
CALL DBP ;DECREMENT
MOVEM A,0(P) ;SAVE FINAL POINTER
GJF01: TQNE <STRF> ;HAVE A STRING POINTER?
JRST [ UMOVE A,2 ;YES. GET IT
IBP A ;INCREMENT IT
CALL DBP ;AND DECREMENT IT
MOVEM A,-1(P) ;SAVE IT FOR TESTING
JRST .+1] ;AND GO INLINE
HRRZ A,E
UMOVE A,14(A) ;AND GET ^R POINTER
TLC A,-1 ;MAKE ^R POINTER VALID
TLCN A,-1
HRLI A,(<POINT 7,0>)
IBP A ;INCREMENT IT
CALL DBP ;AND DECREMENT IT
MOVE B,A ;AND PUT IT IN B
MOVE D,STRCNT(TXT) ;MAX BYTE COUNT
MOVE A,ARGCR(TXT) ;GET BACK MAIN POINTER
;**;[2625] Add 2 lines at GTJTP:-1L PED 9-JUN-82
TQNE <STRF> ;[2625] FROM A STRING IN MEMORY?
JRST GTJ02 ;[2625] YES - NO CTRL/R BUFFER
GTJTP: CAME B,-1(P) ;SAME AS MAIN POINTER?
CAMN B,0(P) ;AT THE END
JRST GTJ02 ;YES
XCTBU [ILDB C,B] ;GET A BYTE
JUMPE C,GTJ02 ;NULL ENDS BUFFER
SOSGE D ;MAKE SURE THIS ONE FITS
ERRLJF (GJFX51) ;IT DOESN'T
IDPB C,A ;COPY INTO MONITOR BUFFER
JRST GTJTP ;GO DO MORE
GTJ02: HRRZM D,STRCNT(TXT) ;BYTE SIZE
SUB P,BHC+2 ;CLEAN UP THE STACK
GJF00: MOVEM A,STRPNT(TXT) ;SAVE POINTER IN RDTXT AREA
MOVEM A,ARGSTR(TXT) ;START OF BUFFER
TQNN <JFNRD> ;HAVE EXTENDED ARGS?
JRST GTJF12 ;NO. GO ON
HRRZ D,E
XCTU [HRRZ C,11(D)] ;GET COUNT
CAIGE C,3 ;HAVE A ^R POINTER?
JRST GTJF12 ;NO. GO ON THEN
XCTU [SKIPE 14(D)] ;IS ^R BUFFER NON-ZERO?
XCTU [SKIPN C,13(D)] ;YES. IS COUNT NON-ZERO?
JRST GTJF12 ;NO. NO TRIMMING THEN
MOVEI B,5(C) ;ADD IN ONE WORD FOR GOOD MEASURE
CAML C,STRCNT(TXT) ;IS BUFFER TOO BIG?
JRST GTJF12 ;NO. GO ON
EXCH C,STRCNT(TXT) ;NEW COUNT
CAML B,C ;WORTH TRIMMING?
JRST GTJF12 ;NO. LEAVE IT ALONE
IDIVI B,5 ;YES. FOUND HOW BIG WE NEED IT IN WORDS
ADDI B,0(A) ;END OF THE BUFFER
HLRZ A,FILLNM(JFN) ;GET THE BLOCK
CALL TRMBLK ;TRIM IT TO ITS PROPER SIZE
GTJF12: CALL GTINPT ;JFNS FOR INPUT
MOVEM A,ARGJFN(TXT)
MOVEI A,6 ;NUMBER OF ARGS
MOVEM A,ARGCNT(TXT) ;TO ARG BLOCK
SETZM LDCNT(TXT) ;IN CASE WE HAVE A STRING
DMOVE A,STRPNT(TXT) ;SET UP CURRENT VALUES
DMOVEM A,CURPNT(TXT) ;"
GTJF0: CALL SETTMP ; Set up temporary string block
JRST ERRDO ; ERROR OCCURED DURING SETTMP
CALL INFTST ;IS THERE AN INPUT JFN?
JRST GTJF2 ;NO. GO READ STRING ONLY
;..
GTJF22: MOVE B,STRPNT(TXT) ;THE START OF IT ALL
MOVEM B,ARGDST(TXT) ;CURRENT BUFFER
MOVE C,STRCNT(TXT) ;STARTING COUNT
MOVEM C,ARGDC(TXT) ;CURRENT COUNT
MRTEXT: TQNN <STRF> ;HAVE A STRING?
JRST MRTXT1 ;NO. GO READ FILE
CALL GCH ;YES. GET THE BYTE
JRST GTJF23 ;STRING EXHAUSTED.
MOVEI B,0(A) ;MOVE THE BYTE
JRST MRTXT2 ;GO SEE IF IT IS A BREAK
;NOT A STRING. READ THE FILE
MRTXT1: HRLI C,(RD%JFN!RD%PUN!RD%BRK!RD%BEL!RD%BBG!RD%RND) ;FLAGS
HLLZM C,ARGFLG(TXT)
MOVEI A,ARGCNT(TXT) ;ARGUMENT BLOCK
TEXTI ;GO GET SOME INPUT
ERJMP [MOVE T1,LSTERR ;TRAP ERRORS (ERRLJF NOT GOOD ENOUGH)
JRST ERRDO] ; AND EXIT WITH ERROR, RELEASING JFN
HRRZ C,ARGDC(TXT)
HLL C,ARGFLG(TXT) ;GET THE FLAGS
TXNN C,RD%BTM ;FOUND A REAL BREAK CHARACTER?
JRST [ TRNN C,-1 ;COUNT EXHAUSTED?
ERRLJF GJFX51 ;YES. BOMB HIM OUT
HLRZ A,ARGJFN(TXT)
GTSTS ; SEE IF IT WAS AN EOF
TXNE B,GS%EOF ; IS IT?
ERRLJF (IOX4) ;YES. GO TELL HIM
TQNE <JFNRD> ;NO. ALTERNATE FLAG WORD?
CALL [ HRRZ D,E
UMOVE D,11(D) ;YES. GET IT
TXNE D,G1%RND ;DOES HE WANT CONTROL BACK?
ERRLJF(GJFX37) ;YES. HE WANT IT BACK
RET] ;GO BACK
BKJFN
JFCL ;TO GET THE BREAK
BIN ;GET IT
CAIN B,"R"-100 ;^R?
JRST [ CALL RETYPE ;YES. DO IT
JRST GTJF22] ;AND DONE
CALL DING ;NO. DING AT HIM
JRST GTJF22] ;AND DONE
LDB B,ARGDST(TXT) ;LOOK AT THE TERMINATOR
MRTXT2: IDIVI B,^D36/CCSIZE ;GET ITS CLASS
LDB B,CPTAB(C) ;""
CAIE B,ILLCHR ;ILLEGAL CHARACTER?
CAIN B,QBRK ;OR, A QUESTION MARK?
JRST GTJFST ;YES. BREAK ON THIS
CAIL B,LOWBRK ;AN ACTION BREAK CHARACTER?
CAILE B,HGHBRK ;MAYBE. HOW ABOUT THE HIGH END?
JRST MRTEXT
;..
;ENTER HERE ON A RETRY AFTER STEPPING A LOGICAL NAME
;..
GTJFST: MOVE A,STRPNT(TXT) ;YES IT IS INTERESTING
MOVEM A,LDPNT(TXT) ;WHERE TO START EXAMINING
MOVE A,STRCNT(TXT) ;THE COUNT
SUB A,CURCNT(TXT) ;CALCULATE NUMBER IN BUFFER
MOVEM A,LDCNT(TXT)
GTJF2: CALL GCH ; Get next character
GTJF23: JRST [ JUMPN A,ERRDO ; IF A NON-ZERO, ERROR
MOVE A,FLAGS(TXT)
TXNE A,RIEFLG ;RETURN ON EMPTY?
ERRLJF GJFX48 ;YES, DO NOT GO READ FROM JFNS
CALL INFTST ; SEE IF MORE TO COME FROM TTY
JRST ENDALL ;NO. GO END THE INPUT SEQUENCE
CALL CLRJFN ;CLEAR THE JFN BLOCK AND THE FLAGS
CALL SETTMP ;GET ANOTHER WORK AREA
JRST ERRDO ;ERROR IN SETTMP
JRST MRTEXT] ;GO CONTINUE COLLECTING TTY INPUT
TQZE <CNTVF> ; Control-v pending?
JRST [ CALL UCCH ; Yes, ignore any special meanings
JRST ERRDO ;ERROR DURING HANDLING OF THIS CHAR
JRST GTJF2]
MOVX B,SAWCR ;SEE IF JUST SAW A CR
TDNE B,FLAGS(TXT) ;DID WE?
JRST [ ANDCAM B,FLAGS(TXT) ;YES. TURN OFF BIT
CAIE A,.CHLFD ;IS THIS A LINE FEED?
ERRLJF(GJFX4) ;NO. ILLEGAL CHARACTER THEN
JRST .+1] ;YES. GO USE IT
MOVE B,A
IDIVI B,^D36/CCSIZE ; Prepare to get character class
LDB B,CPTAB(C) ; Get character class
CAIL B,ECHDTB-CHDTB
ERRLJF GJFX4,<MOVEM A,ERRSAV>
XCT CHDTB(B) ; Execute the dispatch table
SKIPN A ; IF NON-ZERO, THEN ERROR
JRST GTJF2 ; SUCCESSFUL HANDLING OF CHARACTER
JUMPG A,ERRDO ; IF A>0 FATAL ERROR
TQNE <ASTF> ; PARSE ONLY?
JRST ENDAL4 ; YES, IGNORE STEPPED LOGICAL NAME
JRST GTJFST ; LOGICAL NAME WAS STEPPED, RETRY
; Character dispatch table
CHDTB:
PHASE 0 ; MAKE OFFSETS RELATIVE TO 0
UPPER:! CALL UCCH ; (0) upper case letter
LOWER:! CALL LCCH ; (1) lower case letter
EDTCHR:! ; EDITING CHARACTERS
CONTU:! ERRLJF GJFX4,<MOVEM A,ERRSAV> ;(2) FOR CONT-U
CONTR:! ERRLJF GJFX4,<MOVEM A,ERRSAV> ;(3) FOR CONT-R
COMMA:! JRST ENDCNF ;(4) COMMA
SPACE:! JRST ENDALL ;(5) SPACE
CONTF:! CALL RECFLF ;(6) CONT-F
TERMS:! JRST ENDCNF ; (7) cr, lf, ff, tab, eol
ALTMOD:!JRST RECALL ; (10) alt-mode
CALL ENDDEV ; (11) colon
CALL BEGDIR ; (12) <
CALL ENDDIR ; (13) >
CALL ENDNAM ; (14) .
CALL ENDEXT ; (15) ;
TQOA <CNTVF> ; (16) control-v
ILLCHR:!ERRLJF GJFX4,<MOVEM A,ERRSAV> ; (17) illegal character
CALL STAR ; (20) asterisk
DIGITC:!CALL DIGIT ; (21) digits
UPPERT:!CALL TCH ; (22) t
UPPERP:!CALL PCH ; (23) p
UPPERA:!CALL ACH ; (24) a
LOWERT:!CALL LCTCH ; (25) lower case t
LOWERP:!CALL LCPCH ; (26) lower case p
LOWERA:!CALL LCACH ; (27) lower case a
MINUSC:!CALL MINUS ; (30) minus sign
ERRLJF GJFX4,<MOVEM A,ERRSAV> ; (31) ^X IS AN illegal character
QBRK:! ERRLJF (GJFX34) ; (32) ?
WILDC:! CALL QUEST ;(33) WILD CARD CHARACTER
CARRET:!CALL DOCR ; (34) CARRIAGE RETURN
DEPHASE ; END OF ADDRESS RELOCATION
ECHDTB:
; Continuation of gtjfn code
; Digits
DIGIT: MOVE C,FILCNT(JFN)
CAIGE C,MAXLC-5 ; STRING TO BE LONGER THAN 6 DIGITS?
JRST UCCH
TQNE <OCTF>
CAIGE A,"8"
TQNN <NUMFF> ; Or not collecting number
JRST UCCH ; Treat as letter
TQNE <STARF> ;SAW A STAR ALREADY?
RETBAD (GJFX4) ;YES. SYNTAX ERROR
MOVEI B,12
TQNE <OCTF>
MOVEI B,10
IMUL NUM,B ; Otherwise collect number
TQNN <NEGF>
ADDI NUM,-60(A)
TQNE <NEGF>
SUBI NUM,-60(A)
JRST LTR ; Also pack into string
; Simple characters
LCCH: SUBI A,40 ; Convert lower case to upper
UCCH: TQZ <NUMFF> ; Number is invalid now
TQZN <PRTFF> ;COLLECTING A PROTECTION FIELD?
JRST LTR ;NO
MOVX B,PREFXF ;YES, CHANGE IT TO AN ATTRIBUTE
IORM B,FLAGS(TXT) ;IT IS NOT A PROTECTION ANYMORE
MOVE B,FILCNT(JFN) ;WAS THIS THE FIRST CHARACTER?
CAME B,CNTWRD(TXT) ;ONLY PREFIXES WITH ALPHA AFTER P ALLOWED
RETBAD (GJFX40) ;ILLEGAL PREFIX
PUSH P,A ;PUT THE "P" INTO THE PREFIX STRING
MOVEI A,"P" ;SINCE IT WAS LEFT OFF BY PCH
CALL DPST ;PUT IT INTO THE STRING
RETBAD (,<POP P,0(P)>) ;ERROR OCCURED
POP P,A ;GET BACK CHARACTER AGAIN
LTR: TQNE <STARF>
JRST [ MOVX B,WLDF ;SET WILD BIT IN FLAGS
IORM B,FLAGS(TXT)
JRST .+1] ; AND GO INLINE
MOVX B,PREFXF ;SEE IF THIS IS THE FIRST CHAR OF
MOVX C,TMPFL ; WAS ;T TYPED?
TDNN C,FLAGS(TXT) ; ...
JRST LTR1 ; NO
ANDCAM C,FLAGS(TXT) ; YES, MARK THAT NOW GETTING A PREFIX
JRST LTR2
LTR1: TQZE <KEYFF> ; A PREFIX OF AN ATTRIBUTE
LTR2: IORM B,FLAGS(TXT) ;YES, REMEMBER THAT
DPST: SOSGE FILCNT(JFN)
JRST [ MOVEI A,GJFX5 ; ASSUME BIGGER THAN MAX VALUE
MOVE B,CNTWRD(TXT) ;GET MAX SIZE OF THIS FIELD
CAIN B,MAXSHT ;DOING SHORT FILE NAME?
MOVEI A,GJFX41 ;YES
CAIN B,MAXEXT ;DOING SHORT EXTENSION?
MOVEI A,GJFX42 ;YES
RET] ;AND GIVE BAD RETURN
IDPB A,FILOPT(JFN) ; Append character to string
RETSKP
; Letter a
ACH: TQZN <KEYFF> ; Are we looking for a key letter?
JRST UCCH ; No. treat same as other letter
ACH1: TQNE <ACTF> ; Already have account?
RETBAD GJFX12 ; Yes. syntax error
TQO <ACTFF> ; We are now collecting account number
TQZ <NUMFF> ; DO NOT ALLOW A NUMBER
TSTNUL: MOVE B,FILCNT(JFN) ;GET BYTES LEFT
CAME B,CNTWRD(TXT) ; NULL STRING?
RETBAD (GJFX4) ; NO. ILLEGAL BYTE THEN
RETSKP
LCACH: TQZN <KEYFF> ; Same as for upper case a above
JRST LCCH
JRST ACH1
; Letter p
PCH: TQZN <KEYFF> ; Are we looking for key letter?
JRST UCCH ; No. treat as for letter
PCH1: TQNE <PRTF> ; Already have protection?
RETBAD GJFX13 ; Yes, illegal syntax
TQO <PRTFF,NUMFF>
TQO <OCTF>
JRST TSTNUL ; MUST BE A NULL INPUT FIELD
LCPCH: TQZN <KEYFF>
JRST LCCH
JRST PCH1
; Letter t
TCH: TQZN <KEYFF> ; Looking for key?
JRST UCCH ; No. treat as letter
TCH1: TQOE <TMPTF> ;TYPED IN A ;T ALREADY?
RETBAD (GJFX43) ;YES, MORE THAN ONCE IS NOT ALLOWED
MOVX A,TMPFL ;YES, REMEMBER THAT ;T WAS TYPED
IORM A,FLAGS(TXT)
MOVEI A,"T" ;STORE THE "T" INTO THE STRING
CALLRET DPST ;IN CASE IT IS A PREFIX
LCTCH: TQZN <KEYFF>
JRST LCCH
JRST TCH1
; Minus sign
MINUS: JUMPN NUM,UCCH ; If any number has been typed
TQOE <NEGF>
JRST UCCH ; Or 2 minus signs, treat as letter
JRST LTR
;SAW A CARRIAGE RETURN IN THE STRING
DOCR: MOVX A,SAWCR ; REMEMEBER THIS
IORM A,FLAGS(TXT) ; A PLACE TO REMEMBER THIS
RETSKP ; AND DONE
; Device name terminator (:)
; The string in the block addressed by tmpptr
; Is taken as a device. if the device exists, the string is saved
; As the device name for this file.
; SKIP RETURNS with tmpptr reset to a null string
ENDDEV: STKVAR <ENDDVS>
MOVX B,PREFXF ;SEE IF THIS IS THE END OF A PREFIX
TDNE B,FLAGS(TXT) ;...
JRST ENDPFX ;YES, GO PARSE THE PREFIX
TQNN <PRTFF,ACTFF> ;ALREADY GETTING ACCOUNT OR PROTECTION?
JRST ENDDV2 ;NO
MOVE B,FILCNT(JFN) ;SEE IF THIS IS FIRST CHAR OF FIELD
CAME B,CNTWRD(TXT) ;IS COUNT STILL AT STARTING VALUE?
JRST ENDDV2 ;NO, NOT FIRST CHARACTER OF FIELD
MOVEI A,.PFACT ;FIND OUT WHICH ATTRIBUTE THIS IS
TQNE <PRTFF> ;PROTECTION?
MOVEI A,.PFPRT ;YES
MOVEM A,PREFIX(TXT) ;STORE THIS PREFIX VALUE
TQZ <PRTFF,ACTFF> ;CLEAR THE OLD BITS
MOVX A,ARBATF ;GETTING AN ARBITRARY ATTRIBUTE NOW
IORM A,FLAGS(TXT)
RETSKP ;DONE WITH "-" DELIMITER
ENDDV2: TQNE <DIRFF>
RETBAD(GJFX6)
TQOE <DEVF>
RETBAD (GJFX6) ; Device already specified (syntax)
CALL ENDSTR ; Terminate string, get lookup pointer
MOVEM A,ENDDVS ; SAVE STRING POINTER FOR LATER
TQZE <STARF> ; WAS A STAR OF SOME SORT TYPED?
JRST ENDSDV ; YES
CALL CHKLNM ; GO SEE IF THIS IS A LOGICAL NAME
JRST [ MOVE A,ENDDVS ;IF NO LOG NAME, GO LOOK UP DEVICE
JRST ENDDV0]
TQZ <DEVF> ; TURN OFF DEVICE FLAG SET FROM ABOVE
PUSH P,B ;SAVE INDEX
CALL ENDTMP ;CLOSE OUT THIS STRING
POP P,B ;GET BACK INDEX
MOVEI C,FILLNM(JFN) ;GET ADDRESS OF CHAIN POINTER WORD
MOVE D,STPCNT(TXT) ;GET CURRENT STEP COUNTER FOR CHAIN
CALL LNKLNM ;ADD THIS LOGICAL NAME TO CHAIN
JRST [ OKINT
RETBAD ()] ;PROBLEM OCCURED
OKINT ;UNDO WHAT ENDTMP DID
CALLRET SETTMP ;GET A NEW TEMPORARY STRING AND EXIT
ENDDV0: CALL SETDEV ; SET UP DEVICE INFORMATION
JRST STEPLN ; NO SUCH DEVICE
CALL ENDTMP ; Truncate block
CALL CHKDSK ; SEE IF THIS IS "DSK:"
RETBAD (,<OKINT>) ; COULD NOT GET JSB SPACE FOR STRING
HRLM A,FILDDN(JFN) ; Store as device name
OKINT
TQO <DEVTF> ; Remember that device was typed in
ENDDV1: CALLRET SETTMP ; Reset temp block and return
ENDSDV: CALL STRDEV ; SET UP FIRST STR IN LIST
RETBAD () ; ILLEGAL USE OF STAR
JRST ENDDV0 ; GO SET UP THIS STR
ENDPFX: ANDCAM B,FLAGS(TXT) ;CLEAR PREFIX FLAG
CALLRET GETPRE ;GO PARSE THE PREFIX
;ROUTINE TO CHECK THE SYNTAX OF STARED DEVICE FIELD
;ACCEPTS IN A/ STRING POINTER TO DEVICE NAME
; CALL STRDEV OR STRDVD
;RETURNS +1: ILLEGAL USE OF STAR
; +2: OK, STRING NOW CONTAINS "PS"
STRDVD: SKIPA B,[DWLDF] ;GET ONE TYPE OF WILD FLAG
STRDEV: MOVX B,WLDF ;OR ANOTHER TYPE
ANDCAM B,FLAGS(TXT) ;CLEAR IT
MOVE B,1(A) ;GET THE NAME OF THE DEVICE
CAME B,[ASCIZ/DSK*/] ;IS IT THE MAGIC VALUE?
RETBAD (GJFX31) ;NO, ILLEGAL USE OF STAR
MOVE B,[ASCIZ/PS/] ;START AT STRUCTURE 0
MOVEM B,1(A) ;STORE NEW STRING OVER OLD ONE
TQO <STRSF,STEPF> ;REMEMBER THAT THE DEVICE FIELD IS *
RETSKP ;AND EXIT WITH STRING POINTER IN A
; Directory name prefix (<)
; Sets dirff to remember that we are getting a directory name
BEGDIR: TQNN <DIRF> ; Already have directory?
TQOE <DIRFF> ; Or currently gettin one
RETBAD (GJFX7) ; Yes. syntax error
TQNN <NAMF> ; FOUND A NAME YET?
TQNE <EXTF> ; NO. FOUND AN EXTENSION YET?
RETBAD (GJFX7) ; YES. BAD SYNTAX THEN
MOVE B,FILCNT(JFN) ; GET BYTES LEFT IN BUFFER
CAME B,CNTWRD(TXT) ; NULL STRING?
RETBAD (GJFX4) ;NO TREAT IT AS ILLEGAL CHARACTER
MOVEI B,MAXLC ;ALLOW MAX COUNT ALWAYS
MOVEM B,FILCNT(JFN)
MOVEM B,CNTWRD(TXT) ;SAY SO
MOVX B,SWBRKT ;SAW "[" BIT
CAIE A,"<" ;ANGLE?
IORM B,FLAGS(TXT) ;NO. SET BIT
RETSKP
; Directory terminator (>)
; The string in tmpptr is taken as a directory name.
; If recognized, the corresponding directory number is saved
; As the directory number for this file.
; SKIP RETURNS with tmpptr reset to null
ENDDIR: TQZE <DIRFF> ; Were we collecting it?
TQOE <DIRF> ; And do we not yet have it?
RETBAD (GJFX8) ; No. error in syntax
TQNE <DEVF> ; Do we have a device yet?
JRST ENDDI0 ; YES, DONT GET ANOTHER
CALL DEFDEV ; No. default it first
JUMPN A,R ; IF FATAL ERROR, RETURN
ENDDI0: TQZE <STARF>
JRST STRDIR ; User typed <*>
CALL ENDSTR ; Terminate string, get lookup pointer
HRRZ B,FILDEV(JFN) ;SEE IF THIS IS A DISK
CAIN B,DSKDTB ;IF NOT, DONT CALL DIRLKX
TQNE <ASTF> ;DOING PARSE ONLY?
JRST ENDDI2 ;YES. DO IT THEN
LOAD B,FILUC,(JFN) ; GET STRUCTURE NUMBER
CALL DIRLKX ; Lookup directory (no recognition)
JRST ENDDI1 ; Failed
HRRM A,FILDDN(JFN) ; Save directory number
CALL ENDTMP ; TIE OFF THE DIRECTORY NAME STRING
STOR A,FILDIR,(JFN) ; SAVE IT IN THE JFN BLOCK
OKINT ; UNLOCK SINCE ENDTMP LEFT THINGS LOCKED
ENDDI3: TQO <DIRTF> ; Remember that directory was typed in
TQZE <DFSTF> ;WAS THIS A DEFAULT?
RETSKP ;YES. DON'T SET UP STRING AGAIN
CALLRET SETTMP ; Reset temp block and return
STRDIR: MOVE A,FLAGS(TXT) ; SEE IF A WILD MASK
TXZN A,WLDF ; IS IT?
JRST [ MOVE A,FILTMP(JFN)
HRLI A,10700 ; FORM SP
MOVEM A,FILOPT(JFN) ;MAKE THIS A NULL STRING
JRST STRDI2] ; GO PROCESS IT
WLDDIR: MOVEM A,FLAGS(TXT) ;YES. CLEAR FLAGS
CALL ENDTMP ; TIE OFF THE STRING
STOR A,FILDMS,(JFN) ; STORE MASK
OKINT ; ALLOW INTS AGAIN
STRDI2: TQO <STEPF,DIRSF> ;MAKE DIRECTORY STEP
SETZ A, ;START WITH FIRST NAME
CALL NAMLKX ;GO SET TO CORRECT FIRST DIRECTORY
MOVEI A,GJFX17 ;NO SUCH DIRECTORY
RETBAD() ;GIVE IT UP
TQO <DIRTF> ;REMEMBER SEEN A DIRECTORY
TQZE <DFSTF> ;WAS THIS A DEFAULT?
RETSKP ;YES. JUST RETURN THEN
CALLRET SETTMP ;AND DONE
;HERE IF DIRECTORY LOOKUP FAILED
ENDDI1: TQNN <STRSF> ; Did user request DSK*: ?
JRST [ MOVE B,A ; COPY RETURN STATUS FROM DIRLKX
MOVEI A,GJFX17 ; NO SUCH DIRECTORY, GO STEP LOGICAL NM
JUMPL B,R ; AMBIGUOUS
JRST STEPLN]
CALL ENDTMP ; Yes, tie off directory name string
STOR A,FILDIR,(JFN) ; Store the pointer
OKINT ; Allow ints which were disallowed in ENDTMP
CALL DEVSTP ; Step the device
JRST STEPLN ; Failed, try stepping the logical name
JRST ENDDI3 ; And go finish up
;HERE IF NON-DIRECTORY DEVICE OR SCAN ONLY
ENDDI2: CALL ENDTMP ; FINISH OFF THE STRING
HLLZS FILDDN(JFN) ; NO DIRECTORY NUMBER
STOR A,FILDIR,(JFN) ; STORE THE POINTER TO DIRECTORY STRING
OKINT ; ALLOW INTS
JRST ENDDI3 ; AND GO FINISH UP
; Name terminator (.)
; The string in tmpptr is taken as a file name.
; If found, the string is saved as the file name of this file.
; SKIP RETURNS with tmpptr reset to null
ENDNAM: TQNN <DIRFF> ;COLLECTING A DIRECTORY?
TQNE <ACTFF> ;COLLECTING AN ACCOUNT?
JRST DPST ;YES, PUT "." INTO STRING
MOVE C,FLAGS(TXT) ;COLLECTING A PREFIX OR ATTRIBUTE?
TXNE C,PREFXF!ARBATF ; IT MAY BE AN ACCOUNT STRING
JRST DPST ;YES, GO STORE THE "." IN THE STRING
TQNE <NAMF> ; Do we already have a name?
JRST [ TQNE <EXTF> ; HAVE AN EXTENSION YET?
RETBAD (GJFX9) ; YES. AN ERROR THEN
TQZ <KEYFF> ; NO. DON'T ALLOW KEY LETTERS
JRST ENDEX7] ; AND GO PARSE AN EXTENSION
TQO <EXTFF> ; SAY SAW A DOT
ENDNA3: TQO <NAMF> ; NO WE HAVE A NAME
TQNE <DIRF> ; Do we have a directory yet?
JRST ENDNA0 ; YES, GO USE ITK
CALL DEFDIR ; No. default it
JUMPN A,R ; RETURN IF FATAL ERROR
ENDNA0: TQZE <STARF>
JRST STARNM
CALL ENDSTR ; Terminate string, get lookup pointer
CALL NAMLKX ; Look up name without recognition
JRST STEPLN ; NO SUCH NAME, GO STEP LOGICAL NAME
RETBAD ; AMBIGUOUS NAME
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
CALL ENDTMP ; Truncate temp block
ENDNA1: HRLM A,FILNEN(JFN) ; Save as file name
OKINT
ENDNA2: TQO <NAMTF>
CALLRET SETTMP ; Reset temp block and return
STARNM: MOVE A,FLAGS(TXT) ; SEE IF A WILD MASK
TXZN A,WLDF ; IS IT?
JRST [ MOVE A,FILTMP(JFN)
HRLI A,10700 ; FORM SP
MOVEM A,FILOPT(JFN) ;MAKE A NULL STRING AGAIN
JRST STRNA2] ; GO PROCESS IT
WLDNAM: MOVEM A,FLAGS(TXT) ; YES. CLEAR FLAG
CALL ENDTMP ; TIE OFF STRING
STOR A,FILNMS,(JFN) ; PUT IN MASK POINTER
OKINT ; ALLOW INTS AGAIN
CALL SETTMP ; GET NEW TEMP BLOCK
RETBAD() ; FAILED
STRNA2: TQO <NAMSF,STEPF>
TQNE <ASTF> ; OUTPUT STARS?
JRST ENDNA2 ; YES. ALL DONE THEN
SETZ A,
CALL NAMLKX
JRST STEPLN ;NO SUCH FILE NAME, GO STEP LN
RETBAD ;AMBIGUOUS NAME
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
STRNA1: HRRZ A,FILTMP(JFN)
TQNE <ASTF> ; DOING OUTPUT START?
SETZM 1(A) ; YES. USE A NULL NAME THEN
NOINT
HLLZS FILTMP(JFN)
JRST ENDNA1
; Semicolon
; Control comes here when a semicolon appears in the input
; Input preceding the semicolon may be:
; 1. a file name if no name has yet been input
; 2. an extension if a name has been input, but no extension
; 3. a protection if neither 1 or 2, and the field was started with p
; 4. a version number if neither 1,2, or 3 and input was numeric
; 5. an account number/string if field was preceded by an a
; SKIP RETURNS with tmpptr reset to null, and keyff=1, numff=1,
ENDEXT: TQNE <DIRFF> ;COLLECTING A DIRECTORY?
RETBAD (GJFX4) ;YES, ILLEGAL CHARACTER
CALL TSTLNG ;ALLOWING LONG NAMES?
RETBAD (GJFX4) ;NO
ENDEX8: TQO <KEYFF> ; NEXT SCAN WILL LOOK FOR KEY LETTERS
TQNE <NAMF> ; Do we have a name yet?
JRST ENDEX7 ; YES, DONT DEFAULT ONE
CALL ENDNAM ; No. take input string as name
RETBAD ; ERROR DURING ENDNAM
TQO <NREC> ; NO RECOGNITION PLEASE
CALL DEFEXT ; FORCE A DEFAULT EXTENSION SO
; NULL WILL NOT WORK
JRST [ JUMPN A,R ;IF POS OR NEG, RETURN
JRST ENDEX7] ;NO DEFAULT, GO TRY NULL EXT
JRST ENDEX9 ; GO FINISH UP
ENDEX7: TQOE <EXTF> ; Do we have an extension yet?
JRST ENDEX1 ; Yes
MOVX A,VERFF ; VERSION FLAG
TQNN <KEYFF> ; WAS PUNC A DOT?
IORM A,FLAGS(TXT) ; YES. NOW COLLECTING A VERSION
TQZE <STARF>
JRST STREXT
CALL ENDSTR ; No, terminate, get lookup pointer
CALL EXTLKX ; Lookup extension without recognition
JRST STEPLN ; NO SUCH EXT, GO STEP LOGICAL NAME
RETBAD ; AMBIGUOUS EXT
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
CALL ENDTMP ; Truncate temp block
ENDEX6: HRRM A,FILNEN(JFN) ; Store as file extension
OKINT
ENDEX9: TQO <EXTTF> ; Remember that extension was typed in
TQZ <EXTFF>
ENDEX0: TQO <NUMFF> ; Looking for key letters or numbers
TQZ <OCTF>
CALLRET SETTMP ; Reset temp block and return
ENDEX1: TQZN <PRTFF> ; Were we collecting a protection
JRST ENDEX2 ; No
ENDEXP: SKIPL NUM ; Negative numbers are illegal
TQNN <NUMFF> ; Must be number for now
RETBAD (GJFX14) ; Illegal protection
TLO NUM,500000
MOVEM NUM,FILPRT(JFN)
TQO <PRTF,PRTTF> ; Have a protection and it was typed
JRST ENDEX0
STREXT: MOVE A,FLAGS(TXT) ; SEE IF A WILD MASK
TXZN A,WLDF ; IS IT?
JRST [ MOVE A,FILTMP(JFN) ;GET TEMP POINTER
HRLI A,10700 ;MAKE IT A SP
MOVEM A,FILOPT(JFN) ;MAKE THIS GUY NULL
JRST STREX1] ; GO PROCESS IT
WLDEXT: MOVEM A,FLAGS(TXT) ; YES. CLEAR FLAGS
CALL ENDTMP ; TIE OFF STRING
STOR A,FILEMS,(JFN) ; STORE MASK STRING
OKINT ; ALLOW INTS AGAIN
CALL SETTMP ; GET NEW TEMP POINTER
RETBAD() ; FAILED
STREX1: TQO <EXTSF,STEPF>
TQNE <ASTF> ; OUTPUT STARS?
JRST ENDEX9 ; YES. ALL DONE THEN
SETZ A,
CALL EXTLKX
JRST STEPLN ; NO SUCH EXT, STEP LOGICAL NAME
RETBAD ; AMBIGUOUS
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
HRRZ A,FILTMP(JFN)
TQNE <ASTF> ;DOING OUTPUT STARS?
SETZM 1(A) ;YES. USE NULL NAME
NOINT
HLLZS FILTMP(JFN)
JRST ENDEX6
ENDEX2: TQZN <ACTFF> ; Were we collecting an account
JRST ENDEX5 ; No
ENDEXA: CALL ENDSTR ; Account is a string
CALL ENDTMP
MOVEM A,FILACT(JFN) ; Save positive account block pointer
OKINT
TQNN <VERF> ; HAVE A VERSION YET?
JRST [ CALL DEFVER ; NO, GO GET ONE
RETBAD () ; FAILED
JRST .+1] ; HAVE A VERSION, CAN NOW CHECK ACCOUNT
CALL CHKACT ; SEE IF THE ACCOUNT STRING MATCHES
RETBAD (GJFX44) ; ACCOUNT STRING DOES NOT MATCH
TQO <ACTF,ACTTF>
JRST ENDEX0
ENDEX5: MOVX A,PREFXF ;GATHERING A PREFIX?
TDNE A,FLAGS(TXT) ;...
JRST ENDPRE ;YES
MOVX A,ARBATF ;GETTING AN ARBITRARY ATTRIBUTE?
TDNE A,FLAGS(TXT) ;...
JRST ENDARB ;YES
MOVX A,VERFF ; VERSION FLAG
MOVX B,TMPFL ; ;T FLAG
TDNN B,FLAGS(TXT) ;WAS THE LAST ATTRIBUTE TYPED A ;T?
TDNN A,FLAGS(TXT) ; NO, LOOKING FOR A VERSION?
JRST [ ANDCAM B,FLAGS(TXT) ;CLEAR ;T FLAG
MOVE A,CNTWRD(TXT)
SUB A,FILCNT(JFN)
JUMPE A,[CALLRET SETTMP] ;IF NULL FIELD, THEN OK
CAIE A,1 ;EXACTLY ONE CHAR ("T")?
RETBAD (GJFX40) ;NO. SYNTAX ERROR THEN
TQO <TMPFF> ;MARK THAT A TEMP FILE IS BEING MADE
CALLRET SETTMP] ;SET UP FOR NEXT ATTRIBUTE
TQNN <NUMFF> ; Was a number input?
RETBAD (GJFX10)
TQOE <VERF> ; And do we not yet have a version?
RETBAD (GJFX11) ; No. syntax error
TQZE <STARF>
JRST STRVER
SKIPN A,NUM
TQO <RVERF>
TLNE A,-1 ;SOMETHING IN LH OF VERSION?
TQNE <NEGF> ;YES. FOUND A NEGATIVE NUMBER?
SKIPA ;IS OKAY
RETBAD (GJFX20) ;VERSION # IS TOO BIG
CAMN A,[-1]
TQO <HVERF>
CAMN A,[-2]
TQO <LVERF>
CAMN A,[-3]
JRST STRVER
STRVR1: CALL VERLUK ; Lookup this version
JRST STEPLN ; GO TRY TO STEP LOGICAL NAME
HRRM A,FILVER(JFN)
MOVEM B,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
TQO <VERTF> ; Remember that version was input
JRST ENDEX0
STRVER: TQO <VERSF,STEPF>
MOVNI A,2 ;START WITH OLDEST VERSION
TQNE <ASTF> ;OUTPUT STARS?
SETZ A, ;YES. USE ZERO INSTEAD
JRST STRVR1
;END OF A PREFIX
ENDPRE: ANDCAM A,FLAGS(TXT) ;CLEAR PREFIX FLAG
CALL GETPRE ;GO PARSE THE PREFIX
RETBAD ;UNKNOWN PREFIX
ENDARB: MOVX A,ARBATF ;CLEAR ARBITRARY ATTRIBUTE FLAG
ANDCAM A,FLAGS(TXT)
MOVE A,PREFIX(TXT) ;GET THE PREFIX VALUE
ANDI A,PFXMSK ;ISOLATE PREFIX NO.
CAIN A,.PFACT ;ACCOUNT STRING?
JRST ENDEXA ;YES, GO STORE IT
CAIN A,.PFPRT ;PROTECTION FIELD?
JRST ENDEXP ;YES
CAIN A,.PFOFL ; Offline attribute?
JRST ENDEX0 ; Yes, ignore it here
CALL ENDSTR ;TIE OFF THE STRING
HRRZS A ;GET THE ADR OF THE STRING BLOCK
LOAD B,PFXVAL ;GET THE PREFIX VALUE
HRRZ C,DEV ;GET DISPATCH ADDRESS ONLY
CALL @ATRD(C) ;CHECK ITS LEGALITY
RETBAD ;NOT A LEGAL PREFIX FOR THIS DEVICE
CALL ENDTMP ;NOW STORE THE ATTRIBUTE
CALL LNKATR ;LINK THE STRING ON THE ATTRIBUTE CHAIN
OKINT ;ALLOW INTERRUPTS AGAIN (FROM ENDTMP)
JRST ENDEX0 ;GO FINISH UP
;ROUTINE TO PARSE A PREFIX
GETPRE: MOVX A,ARBATF ;MARK THAT NOW COLLECTING ARB ATTRIBUTE
IORM A,FLAGS(TXT) ;...
CALL ENDSTR ;TIE OFF THE STRING
HRLI A,(POINT 7,0,35) ;GET POINTER TO THE PREFIX
MOVE B,A ;SET UP FOR THE TABLE LOOKUP
MOVEI A,PRFXTB ;GET ADDRESS OF THE PREFIX TABLE
TBLUK ;LOOKUP THE PREFIX
ERJMP [MOVE A,LSTERR ;FAILED, GET THE ERROR CODE
RETBAD ()] ;AND GIVE THE FAILURE RETURN
TXNN B,TL%ABR!TL%EXM ;FOUND A MATCH?
RETBAD (GJFX40) ;NO, UNKNOWN PREFIX
HRRZ A,0(A) ;GET THE PREFIX VALUE
MOVEM A,PREFIX(TXT) ;SAVE IT AWAY UNTIL DATA FIELD ENTERED
LOAD A,PFXVAL ;GET PREFIX VALUE
CALL CHKATR ;SEE IF THIS HAS ALREADY BEEN ENTERED
RETBAD (GJFX45) ;YES, ILLEGAL TO ENTER SAME PREFIX TWICE
CALLRET SETTMP ;SET UP FOR DATA FIELD AND RETURN
;PREFIX TABLE - THIS TABLE MUST BE ALPHABETICAL
PRFXTB::PRFXTL-1,,PRFXTL ;TABLE IS IN TBLUK FORMAT
[ASCIZ/A/],,.PFACT ;ACCOUNT STRING
[ASCIZ /BDATA/],,.PFBOP ;NETWORK BINARY OPTIONAL DATA
[ASCIZ/BLOCK-LENGTH/],,.PFBLK ;MAGTAPE BLOCK LENGTH
[ASCIZ /BPASSWORD/],,.PFBPW ;NETWORK BINARY PASSWORD
[ASCIZ /CHARGE/],,.PFACN ;NETWORK ACCOUNT STRING
[ASCIZ/COPIES/],,.PFCOP ;SPOOLED FILE COPIES
[ASCIZ /DATA/],,.PFOPT ;NETWORK OPTIONAL DATA
[ASCIZ/EXPIRATION-DATE/],,.PFEXP ;MAGTAPE EXPRIATION DATE
[ASCIZ/FORMAT/],,.PFFMT ;MAGTAPE FORMAT
; [ASCIZ/FORMS/],,.PFFRM ;SPOOLED FILE FORMS
[ASCIZ/P/],,.PFPRT ;PROTECTION
[ASCIZ /PASSWORD/],,.PFPWD ;NETWORK PASSWORD STRING
[ASCIZ/POSITION/],,.PFPOS ;MAGTAPE POSITION
[ASCIZ/PREALLOCATE/],,.PFALC ;PREALLOCATE DISK SPACE
[ASCIZ/RECORD-LENGTH/],,.PFRLN ;MAGTAPE RECORD LENGTH
[ASCIZ /TAPE-ACCESS/],,.PFACC ;ACCESS CODE ON MT DEVICE
[ASCIZ/TEST/],,NOATRF ;TEST OF NOATRF FLAG
[ASCIZ /USERID/],,.PFUDT ;NETWORK USER I.D. STRING
PRFXTL==.-PRFXTB ;LENGTH OF PREFIX TABLE
; Default device
; Call: CALL DEFDEV
; Return
; +1 ; A=0 IF DEFAULTED DEVICE WAS DSK, OR NO OUTPUT DONE
; +2 ; IF DEVICE NAME WAS OUTPUT TO USER DURING RECGNITION
; Gets default device string from user or "dsk"
; And stores as the device for the file given in jfn
; Clobbers a,b,c,d
DEFDEV: STKVAR <DEFDVS,DEFDVI>
CALL GLNDEV ; GET LOGICAL NAME DEFAULT
SKIPA ; NONE EXISTS
JRST DEFDV0 ; GO USE THIS ONE
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,FILLNM(JFN) ;SEE IF THERE WAS A LOGICAL NAME TYPED
JUMPN A,DEFDV1 ;YES, DO NOT GET PROGRAM DEFAULT
;THIS IS A SPECIAL CASE TO MAKE
;"R SYS:LINK" WORK IF THE DEFINITION
;OF SYS: DOES NOT HAVE A STR SPECIFIED
HRRZ D,E
TLNN E,777777 ; No defaults if short form
XCTU [SKIPN A,2(D)] ; Get user's default pointer
JRST DEFDV1 ; None specified, use dsk
CALL REDFLT ; Copy the default string
RETBAD ; ERROR OCCURED DURING REDFLT
DEFDV0: TQZE <DFSTF>
JRST DEFSDV ;CHECK LEGALITY OF STAR IN DEVICE FIELD
DFDV0A: MOVEM A,DEFDVS ;SAVE STRING POINTER
CALL CHKLNM ; SEE IF THIS DEFAULT IS A LOGICAL NAME
SKIPA A,DEFDVS ;NO, GET BACK STRING POINTER
JRST DFDVL0 ; YES, LOOP BACK AND TRY FOR A DEVICE
CALL SETDEV ; SET UP DEVICE INFORMATION
JRST STEPLN ; NO SUCH DEVICE
NOINT
HLRZ A,FILTMP(JFN)
HRRZS FILTMP(JFN)
CALL CHKDSK ; SEE IF THIS IS "DSK:"
RETBAD (,<OKINT>) ; COULD NOT GET JSB SPACE FOR STRING
HRLM A,FILDDN(JFN) ;STORE STRING POINTER OF DEV
OKINT
TQO <DEVF>
HRRZ B,FILLNM(JFN) ;SEE IF THERE IS A LOGICAL NAME
JUMPN B,RFALSE ;IF YES, DONT TYPE ANYTHING OUT
CALLRET DFDVTY ;IF DOING RECOGNITION, TYPE OUT DEV NAM
DEFSDV: CALL STRDVD ;CHECK SYNTAX OF STAR IN DEVICE FIELD
RETBAD () ;ILLEGAL SYNTAX
JRST DFDV0A ;NOW HAVE THE FIRST DEVICE NAME
DEFDV1: MOVEI B,3 ; Need 3 words TO HOLD STR NAME
NOINT
CALL ASGJFR ; Of job storage
RETBAD (GJFX22,<OKINT>) ; No space available
HRLM A,FILDDN(JFN) ; The block is for the device name
OKINT
MOVE B,[ASCIZ /DSK/]
MOVEM B,1(A) ; The device is "dsk"
MOVEM A,DEFDVS ; SAVE STRING POINTER ADDRESS
CALL CHKLNM ; SEE IF THIS DEFAULT IS A LOGICAL NAME
SKIPA A,DEFDVS ;NO, GET STRING POINTER BACK AGAIN
JRST DFDVL1 ; YES, LOOP BACK AND TRY FOR A DEVICE
CALL SETDEV ; SET UP DEVICE INFORMATION
RETBAD () ; NO SUCH DEVICE
NOINT
MOVE A,DEFDVS ; GET NAME STRING POINTER
CALL CHKDSK ; SEE IF THIS IS "DSK:"
RETBAD (,<OKINT>) ; COULD NOT GET JSB SPACE FOR STRING
HRLM A,FILDDN(JFN) ; STORE NEW STRING POINTER
OKINT
TQO <DEVF>
JRST RFALSE ; RETURN WITH A=0
DFDVL0: NOINT ;PUT LOGICAL NAME STRING INTO FILLNM
HLRZ A,FILTMP(JFN) ;GET POINTER TO DEFAULT STRING
HRRZS FILTMP(JFN) ;CLEAR POINTER TO LN STRING IN FILTMP
JRST DFDVL2 ;GO STORE LOGICAL NAME
DFDVL1: NOINT ;PUT LOGICAL NAME STRING INTO FILLNM
HLRZ A,FILDDN(JFN) ;GET POINTER TO DEFAULT STRING
HRRZS FILDDN(JFN) ;CLEAR POINTER TO LN STRING IN FILTMP
DFDVL2: MOVEM A,DEFDVS ;SAVE POINTER TO STRING
MOVEM B,DEFDVI ;SAVE INDEX
;**;[2945] Delete 7 lines at DFDVL2:+2 DML 6-APR-83
;[2945] MOVE B,1(A) ;GET FIRST WORD OF STRING
;[2945] TRZ B,677 ;CLEAR OUT POSSIBLE GARBAGE BITS
;[2945] CAME B,[ASCIZ/DSK/] ;IS THE NAME "DSK"?
;[2945] CALL DFDVTY ;NO, THEN GO TYPE IT MAYBE
;[2945] JFCL ;DFDVTY SKIPS SOMETIMES
;[2945] MOVE A,DEFDVS ;GET BACK POINTER TO STRING
;[2945] MOVE B,DEFDVI ;GET BACK INDEX
MOVEI C,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
MOVE D,STPCNT(TXT) ;GET CURRENT STEP COUNTER
CALL LNKLNM ;ADD THIS LOGICAL NAME TO CHAIN
JRST [ OKINT
RETBAD ()] ;PROBLEM OCCURED
OKINT ;TURN ON INTERRUPTS AGAIN
CALL GLNDEV ;NOW GET PHYSICAL DEVICE
SKIPA ;THERE WASNT ONE
JRST DEFDV0 ;GO CHECK THIS ONE OUT
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
JRST DEFDV1 ;GO USE DSK
DFDVTY: MOVE C,FILCNT(JFN) ;MAKE SURE USER HADNT TYPED ANYTHING
TQNN <DIRFF> ;OR WASNT ENTERING A DIRECTORY
CAMGE C,CNTWRD(TXT) ;...
JRST RFALSE ;YES, DONT TYPE OUT DEV
TQNN <DIRF,NAMF> ;IF ALREADY SEEN A DIR OR A NAME
TQNE <NREC> ; OR RECOGNITION IS NOT BEING DONE
JRST RFALSE ;DONT TYPE OUT THE LOGICAL NAME
HRRZ B,FILLNM(JFN) ;IS THERE A LOGICAL NAME IN EFFECT?
JUMPN B,RFALSE ;IF YES, DONT TYPE OUT DEFAULT DEV
HRRZ B,A ;GET THE POINTER TO THE LOGICAL NAME
TQNE <STRSF> ;IS THIS THE WILD DEVICE?
MOVEI B,[ASCIZ/DSK*/]-1 ;YES, CHANGE TO PROPER STRING
CALL TSTRB ;GO TYPE IT OUT
CHOUT <":"> ;AND FOLLOW NAME WITH A COLON
TQO <DEVTF> ;MARK THAT DEV WAS TYPED OUT FOR RETYPE
RETSKP ;AND RETURN
;ROUTINE TO SET UP DEVICE INFORMATION
;ACCEPTS IN A/ STRING POINTER TO DEVICE NAME
; CALL SETDEV
;RETURNS +1: NO SUCH DEVICE, ERROR CODE IN A
; +2: OK - FILIDX(JFN) AND FILDEV(JFN) SET UP PROPERLY
SETDEV: STKVAR <SETDVT>
MOVEM A,SETDVT ; SAVE POINTER TO STRING
CALL DEVLUK ; Lookup device in device tables
JRST SETDV1 ; No such device
MOVE D,DEVCHR(B) ; GET DEVICE CHARACTERISTICS
TQNE <OLDNF> ; IS AN EXISTING FILE REQUIRED?
TXNE D,DV%IN ; YES, IS THIS DEVICE CAPABLE OF INPUT?
SKIPA ; YES, ALL IS OK
JRST [ MOVEI A,GJFX38 ; CANNOT GET OLD FILE ON OUTPUT ONLY DEV
JRST STEPLN] ; GO SEE IF LOGICAL NAME CAN BE STEPPED
HRRM B,FILIDX(JFN) ; STORE INDEX INTO DEVICE TABLES
MOVEM DEV,FILDEV(JFN) ; Value of lookup is initial fildev
HRRZ D,DEV ;GET DISPATCH TABLE ADDRESS
CAIN D,MTDTB ;IS THIS AN MT DEVICE?
TQNE <ASTF> ;YES. PARSE ONLY?
SKIPA ;DON'T DO DEVAV
JRST [ CALL DEVAV ;YES. CHECK IF AVAILABLE
RETBAD (OPNX7) ;NOT. GIVE ERROR THEN
JRST .+1] ;IT IS. PROCEED
HLRZ B,DEV ;GET UNIT # (MAY BE STR #)
CAIN D,DSKDTB ;IS THIS A DISK DEVICE?
CAIN B,-1 ;YES - SPECIFIC STRUCTURE?
RETSKP ;NO, ALL DONE
STOR C,FILUC,(JFN) ;STORE UNIQUE CODE IN JFN BLOCK
SETZ B, ;THIS JSB IS MAPPED
MOVE A,C ;MOVE UNIQUE CODE TO T1 FOR CHKMNT
TLO A,400000 ;ALLOW MOUNT ONLY BY THIS FORK
NOINT ;BE NOINT WHILE JSSTLK IS LOCKED
LOCK JSSTLK ;LOCK JSB STRUCTURE INFO LOCK
CALL CHKMNT ;DID USER MOUNT THIS STRUCTURE
JRST [ UNLOCK JSSTLK ; NO, FAIL
OKINT ;ALLOW INTERRUPTS NOW
TQNN <ASTF> ;PARSE-ONLY?
RETBAD ;NO
SETZ C, ;YES, STRUCTURE IS OK
HRRM C,FILIDX(JFN) ;CLEAR INDEX INTO DEVICE TABLES
STOR C,FILUC,(JFN) ;CLEAR UNIQUE CODE
MOVEM C,FILDEV(JFN) ;CLEAR DEVICE
RETSKP]
UNLOCK JSSTLK ;UNLOCK STR INFO LOCK IN JSB
OKINT ;ALLOW INTERRUPTS NOW
RETSKP ;RETURN SUCCESSFULLY
SETDV1: TQNE <ASTF> ; PARSE ONLY?
RETSKP ; YES, THEN DEVICE NAME IS OK
EXCH A,SETDVT ; SAVE ERROR CODE AND GET BACK POINTER
MOVEI B,FILLNM(JFN) ; NOW SEE IF THIS DEVICE IS ON LN CHAIN
CALL CHKCHN ; TO DETERMINE IF THIS IS A LN LOOP
SKIPA A,SETDVT ; NOT ON CHAIN, GET BACK ERROR CODE
MOVEI A,GJFX39 ; LOGICAL NAME LOOP
RETBAD ; RETURN WITH ERROR CODE IN A
;ROUTINE TO SEE IF DEVICE STRING IS "DSK:" AND TO CHANGE IT TO
; THE CONNECTED STRUCTURE IF IT IS "DSK:"
;ACCEPTS IN A/ LOOKUP POINTER TO DEVICE STRING
; MUST BE NOINT WHEN CALLED
; CALL CHKDSK
;RETURNS +1: ERROR, NO ROOM IN JSB FOR NEW STRING
; +2: NEW POINTER IN A, STRING WAS UPDATED TO STR NAME
; DEV AND FILDEV(JFN) MODIFIED APPROPRIATLY
CHKDSK: CAME DEV,[-1,,DSKDTB] ;IS THIS "DSK"?
RETSKP ;NO, NO CHANGE NEEDED
STKVAR <CHKDSN> ;SAVE NAME POINTER
MOVEM A,CHKDSN
MOVE B,FLAGS(TXT) ;GET FLAGS INTO B
TXNE B,NOLOGF ;ARE WE EXPANDING LOGICAL NAMES?
CALL CHKLN1 ;IF NOT, IS DSK: DEFINED?
JRST CHKDS1 ;NOLOGF CLEAR OR DSK: NOT DEFINED, TRANSLATE
MOVE A,CHKDSN ;DON'T TRANSLATE, RESTORE POINTER
RETSKP ;AND RETURN
CHKDS1: LOAD A,JSUC ;GET CONNECTED STR UNIQUE CODE
STOR A,FILUC,(JFN) ;PUT THIS IN THE JFN BLOCK
CALL CNVSTR ;CONVERT
RETBAD (GJFX16) ;NO SUCH DEVICE
HRL DEV,A ;UPDATE DEV WITH UNIT NUMBER
CALL ULKSTR
MOVE A,CHKDSN ;GET BACK THE NAME POINTER
MOVEM DEV,FILDEV(JFN) ;STORE IN JFN BLOCK
CALLRET CNVSIX ;CONVERT SIXBIT DEV NAME TO A STRING
;ROUTINE TO CHANGE THE DEVICE NAME TO THE CORRECT NAME FROM DEVTAB
;ACCEPTS IN A/ POINTER TO DEVICE NAME STRING
; MUST BE CALLED NOINT
; CALL CNVSIX
;RETURNS +1: NO ROOM TO EXPAND DEVICE NAME STRING
; +2: A/ POINTER TO NEW DEVICE NAME STRING
CNVSIX::HRRZ B,0(A) ;GET SIZE OF STRING
CAIGE B,3 ;LARGE ENOUGH FOR STRUCTURE NAME?
JRST [ HRRZ B,A ;NO, RETURN THIS STRING
MOVEI A,JSBFRE
CALL RELFRE
MOVEI B,3 ;NOW GET A NEW STRING
CALL ASGJFR ;TO HOLD STR NAME
RETBAD (GJFX32)
JRST .+1]
HLRZ C,FILDEV(JFN) ;GET STRUCTURE UNIT NUMBER
MOVE C,DEVNAM+DVXST0(C) ;GET SIXBIT NAME
MOVSI D,(POINT 7,0,35) ;SET UP STRING POINTER
HRR D,A ;TO NAME STRING BLOCK
CNVSX1: SETZ B, ;CLEAR OUT CHARACTER
LSHC B,6 ;GET NEXT CHARACTER
JUMPE B,CNVSX2 ;NULL MEANS DONE
ADDI B,40 ;MAKE CHARACTER ASCII
IDPB B,D ;STORE IN STRING
JRST CNVSX1 ;LOOP BACK FOR REST OF WORD
CNVSX2: IDPB B,D ;STORE NULL AT END
RETSKP ;AND EXIT WITH POINTER IN A
;ROUTINE TO CHECK IF A DEVICE NAME IS LOGICAL NAME
;ACCEPTS IN A/ POINTER TO NAME STRING TO BE CHECKED
; CALL CHKLNM
;RETURNS +1: NOT A LOGICAL NAME, OR LOGICAL NAMES NOT ALLOWED
; +2: STRING IS A LOGICAL NAME,
; B/ -1 = LOGICAL NAME AND IT IS ALREADY ON CHAIN
; 0 = JOB WID LOGICAL NAME
; +1 = SYSTEM LOGICAL NAME
CHKLNM: MOVE B,FLAGS(TXT) ;GET FLAGS
TXNE B,NOLOGF ;LOGICAL NAME EXPANSION SUPPRESSED?
RET ;YES, DO NOTHING
CHKLN1: STKVAR <CHKLNS,CHKLNB>
HRLI A,(POINT 7,0,35) ;SET UP A STRING POINTER TO NAME
MOVEM A,CHKLNS ;SAVE STRING POINTER
MOVEI B,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL CHKCHN ;CHECK IF THIS LN IS ON CHAIN
JRST CHKLN2 ;NOT ON CHAIN NOW
CAMGE C,STPCNT(TXT) ;IS THIS A NEW LOGICAL NAME
JRST CHKLN4 ;NO, GO SEE IF SHOULD BE ADDED TO CHAIN
JUMPG A,R ;IF THIS IS A SYSTEM LN, EXIT NOW
CHKLN3: MOVE A,CHKLNS ;GET BACK STRING POINTER
CALLRET LNLUKS ;CHECK FOR SYSTEM LOGICAL NAME
CHKLN2: MOVX A,SAWSLN ;HAVE WE SEEN A SYSTEM LOGICAL NAME YET?
TDNN A,FLAGS(TXT) ;...
TQNE <PHYOF> ;OR IS THIS PHYSICAL ONLY?
JRST CHKLN3 ;YES, ONLY LOOK A SYSTEM LOGICAL NAMES
MOVE A,CHKLNS ;GET STRING POINTER TO NAME
CALLRET LNLUKG ;SEE IF THIS IS EITHER FLAVOR OF LN
CHKLN4: MOVE C,STPCNT(TXT) ;GET CURRENT STEP COUNTER
STOR C,LNMSTP,(B) ;MARK THAT WE HAVE SEEN THIS LN DURING
; THIS STEP
SETO B, ;MARK THAT THIS SHOULD NOT BE PUT
RETSKP ; ON THE CHAIN AGAIN
;ROUTINE TO CHECK IF A LOGICAL NAME IS ON THE CHAIN ALREADY
;ACCEPTS IN A/ POINTER TO NAME STRING
; B/ ADDRESS OF CHAIN HEADER WORD
; CALL CHKCHN
;RETURNS +1: NOT ON CHAIN
; +2: ON CHAIN ALREADY,
; A/ INDEX OF LOGICAL NAME
; B/ ADDRESS OF CHAIN ELEMENT
; C/ STEP COUNTER OF THE LOGICAL NAME
CHKCHN::STKVAR <CHKCNP,CHKCNB>
HRLI A,(POINT 7,0,35) ;TURN ADDRESS INTO STRING POINTER
MOVEM A,CHKCNP ;SAVE POINTER TO STRING
HRRZ B,0(B) ;GET POINTER TO FIRST ELEMENT ON CHAIN
CHKCN0: JUMPE B,R ;IF NONE, RETURN
MOVEM B,CHKCNB ;SAVE POINTER TO NEXT LN BLOCK
LOAD A,LNMPNT,(B) ;GET POINTER TO NAME STRING
HRLI A,(POINT 7,0,35) ;MAKE IT INTO A STRING POINTER
MOVE B,CHKCNP ;GET POINTER TO NAME BEING CHECKED
CALL STRCMP ;COMPARE THE STRINGS
JRST CHKCN1 ;NO MATCH, CHECK DOWN CHAIN
MOVE B,CHKCNB ;GET ADDRESS OF THIS BLOCK
LOAD A,LNMIDX,(B) ;GET TYPE OF LOGICAL NAME
LOAD C,LNMSTP,(B) ;GET STEP COUNTER
RETSKP ;RETURN
CHKCN1: MOVE B,CHKCNB ;GET POINTER TO THIS BLOCK
LOAD B,LNMLNK,(B) ;STEP TO NEXT ONE
JRST CHKCN0 ;GO TRY NEXT ONE IN CHAIN
;ROUTINE TO LINK A LOGICAL NAME TO THE CHAIN
;ACCEPTS IN A/ STRING POINTER TO NAME
; B/ INDEX -1=DONT ADD TO CHAIN, 0=JOB WIDE, 1=SYSTEM
; C/ ADDRESS OF CHAIN HEADER WORD
; D/ STEP COUNTER OF THIS LOGICAL NAME
; CALL LNKLNM
;RETURNS +1: ERROR - CODE IN A
; +2: OK
LNKLNM::STKVAR <LNKLNP,LNKLNI,LNKLNC,LNKLNS>
HRRZM C,LNKLNC ;SAVE ADDRESS OF CHAIN HEADER
MOVX C,SAWSLN ;SET UP TO MARK SAWSLN
SKIPLE B ;IS THIS A SYSTEM LN?
IORM C,FLAGS(TXT) ;YES, REMEMBER WE HAVE SEEN IT
JUMPL B,LNKLN1 ;IF B = -1, DONT ADD THIS TO CHAIN
MOVEM A,LNKLNP ;SAVE POINTER TO NAME
MOVEM B,LNKLNI ;SAVE INDEX
MOVEM D,LNKLNS ;SAVE STEP COUNTER
MOVEI B,LNHDRL ;GET LENGTH OF HEADER
CALL ASGJFR ;GET SPACE FOR LN BLOCK HEADER
RETBAD ;ERROR
HRRZ B,@LNKLNC ;GET START OF CHAIN
STOR B,LNMLNK,(A) ;POINT TO THIS NEXT ELEMENT
MOVE B,LNKLNP ;GET POINTER TO NAME STRING
STOR B,LNMPNT,(A) ;SAVE POINTER TO STRING
MOVE B,LNKLNI ;GET INDEX
STOR B,LNMIDX,(A) ;SAVE INDEX
MOVE B,LNKLNS ;GET STEP COUNTER
STOR B,LNMSTP,(A) ;SAVE IT IN CHAIN ELEMENT
MOVEI B,0 ;CLEAR COUNT
STOR B,LNMCNT,(A)
HRRM A,@LNKLNC ;PUT THIS BLOCK ON THE CHAIN
RETSKP ;AND RETURN
LNKLN1: HRRZ B,A ;RELEASE THE STRING
MOVEI A,JSBFRE
CALL RELFRE
RETSKP ;AND EXIT
; Default directory
; Call: JFN
; CALL DEFDIR
; Returns
; +1 ; A=0 IF DEFAULTED DIR IS SAME AS CURRENT DIR,
; AND NO OUTPUT DONE
; +2 ; IF DIR WAS OUTPUT TO USER DURING RECOGNITION
; Clobbers a,b,c,d
DEFDIR: TQNE <DEVF>
JRST DEFDI2 ;ALREADY HAVE A DEVICE
CALL DEFDEV
JUMPN A,R ;IF ERROR, RETURN
DEFDI2: CALL GLNDIR ; SEE IF A LOGICAL NAME DEFAULT EXISTS
SKIPA ; NO
JRST DEFDI0 ; YES, USE IT
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default if short form
XCTU [SKIPN A,3(A)] ; Get default pointer
JRST DEFDI1 ; None specified
CALL REDFLT ; Copy default string
RETBAD ; ERROR DURING REDFLT
DEFDI0: TQNE <DFSTF>
JRST DFDRST ;GO HANDLE DEFAULTED STAR
HRRZ B,FILDEV(JFN) ;SEE IF THIS IS A DISK
CAIE B,DSKDTB ;IF NOT, DONT CALL DIRLKX
JRST DEFDI3 ;NOT A DISK
LOAD B,FILUC,(JFN) ;GET STRUCTURE NUMBER
CALL DIRLKX ; Look it up
JRST DEFDI7 ; Failed
HRRM A,FILDDN(JFN)
CALL GTCSCD ;GET CONNECTED STR,,DIRECTORY
LOAD B,FILUC,(JFN) ;GET THE UNIQUE CODE OF THIS STR
HRLZS B ;BUILD A STR/DIR NUMBER
HRR B,FILDDN(JFN) ;GET DEFAULT AGAIN
CAME A,B ;IS THIS THE SAME AS THE DEFAULT?
CALL DEFDIT ;NO, THEN TYPE OUT DIR NAME IF DOING RECOGNITION
SKIPA ; NOTHING HAS BEEN OUTPUT TO USER YET
AOS 0(P) ;SET UP FOR SKIP RETURN
DEFDI3: NOINT
HLRZ B,FILTMP(JFN)
STOR B,FILDIR,(JFN) ; SAVE THE NAME IN THE JFN BLOCK
HRRZS FILTMP(JFN)
OKINT
TQO <DIRF>
JRST RFALSE ;RETURN WITH A=0
DEFDI1: HRRZ A,FILDEV(JFN) ;GET DISPATCH ADDRESS
TQNN <ASTF> ;IS IT REAL JFN?
CAIE A,DSKDTB ;IS THIS THE DISK?
JRST DEFDI4 ;NO, DONT SET DIRECTORY NUMBER AND STRING
LOAD A,JSCDS ;GET POINTER TO NAME STRING IN JSB
JN JSCDF,,DEFDI5 ;IF VAILD, GO COPY IT TO FILDIR
CALL GTCSCD ;GET CONNECTED STRUCTURE CODE,,DIRECTORY
CALL GDIRST ;GET A POINTER TO THE DIR NAME
RETBAD () ;FAILED
CALL STORDN ;STORE THE DIR NAME STRING
RETBAD (,<CALL USTDIR>) ;FAILED
LOAD A,FILUC,(JFN) ;GET UNIQUE CODE OF THIS STR
LOAD B,CURUC ;GET CURRENT MAPPED DIR
CAMN A,B ;SAME STR?
JRST [ LOAD A,JSDIR ;GET CONNECTED DIR NUMBER
HRRM A,FILDDN(JFN) ;YES, SAVE DIR NUMBER IN JFN BLOCK
CALL USTDIR ;UNLOCK DIR
JRST DEFDI4] ;DONE
CALL USTDIR
DEFDI6: CALL SDIRN ;NOW GET THE DIR NUMBER FROM STRING
RETBAD () ;FAILED TO FIND DIR ON THIS STR
DEFDI4: TQO <DIRF>
JRST RFALSE
DEFDI5: CALL STORDN ;STORE THE STRING FROM JSB TO JFN BLOCK
RETBAD ;FAILED
LOAD A,FILUC,(JFN) ;GET UNIQUE CODE OF STRUCTURE
LOAD B,JSUC ;GET CONNECTED STR #
CAME A,B ;GETTING FILE FROM CONNECTED STR/DIR?
JRST DEFDI6 ;NO, MUST GO LOOK UP THE DIR NUMBER
LOAD A,JSDIR ;YES, CAN USE THE DIR # FROM JSB
HRRM A,FILDDN(JFN) ;STORE DIR NUMBER
JRST DEFDI4 ;GO EXIT
;HERE IF DIRECTORY LOOKUP FAILED
DEFDI7: TQNE <ASTF> ;SCAN ONLY?
JRST DEFDI3 ;YES. GO HANDLE IT
TQNN <STRSF> ; Can we step the structure?
JRST [ MOVE B,A ;COPY RETURN STATUS FROM DIRLKX
MOVEI A,GJFX17 ;NO SUCH DIRECTORY
JUMPL B,R ;RETURN GJFX17 IF AMBIGUOUS RETURN FROM DIRLKX
JRST STEPLN] ;GO STEP LOGICAL NAME AND RETURN
NOINT ; Yes. Disallow ints
HLRZ B,FILTMP(JFN)
STOR B,FILDIR,(JFN) ; SAVE THE NAME IN THE JFN BLOCK
HRRZS FILTMP(JFN)
OKINT
CALL DEVSTP ; Step the structure
JRST STEPLN ; Failed, try stepping the logical name
CALL GTCSCD ;GET CONNECTED STR,,DIRECTORY
LOAD B,FILUC,(JFN) ;GET THE UNIQUE CODE OF THIS STR
HRLZS B ;BUILD A STR/DIR NUMBER
HRR B,FILDDN(JFN) ;GET DEFAULT AGAIN
CAME A,B ;IS THIS THE SAME AS THE DEFAULT?
CALL DEFDIT ;NO, THEN TYPE OUT DIR NAME IF DOING RECOGNITION
SKIPA ; NOTHING HAS BEEN OUTPUT TO USER YET
AOS 0(P) ;SET UP FOR SKIP RETURN
TQO <DIRF>
JRST RFALSE ;RETURN WITH A=0
;ROUTINE TO PUT A DIR NAME STRING INTO THE JFN BLOCK
;ACCEPTS IN A/ POINTER TO DIRECTORY NAME BLOCK
; CALL STORDN
;RETURNS +1: FAILED TO GET SPACE FOR NAME OR NO SUCH DIR
; +2: OK, STRING POINTER PUT IN FILDIR(JFN)
STORDN::STKVAR <STODNA,STODNL>
SE1CAL
MOVEM A,STODNA ;SAVE THE POINTER
MOVE C,[POINT 7,0(A),34] ;SET UP STRING POINTER
MOVEI B,^D10 ;GET # OF WORDS NEEDED PLUS 1 FOR HEADER
STODN0: ILDB D,C ;GET NEXT CHAR
SKIPE D ;DONE?
AOJA B,STODN0 ;NO, COUNT UP CHARACTERS SEEN
IDIVI B,5 ;COUNT THE WORDS
MOVEM B,STODNL ;REMEMBER THE COUNT
LOAD C,FILDIR,(JFN) ;GET POINTER TO EXISTING NAME STRING
JUMPE C,STODN1 ;IF ANY
HRRZS D,0(C) ;GET ITS LENGTH
CAMN B,D ;IS IT LONG ENOUGH FOR THE NEW NAME?
JRST STODN2 ;YES, USE IT
MOVEI A,JSBFRE ;NO, RELEASE IT
MOVE B,C ;GET ADR OF STRING
CALL RELFRE ;RELEASE IT
STODN1: NOINT ;DO NOT PERMIT INTERRUPTS DURING THE ASSIGN
MOVE B,STODNL ;GET THE COUNT OF WORDS NEEDED
CALL ASGJFR ;GET A BLOCK FOR THE DIR NAME
RETBAD (,<OKINT>) ;COULD NOT GET ROOM
STOR A,FILDIR,(JFN) ;REMEMBER THIS STRING IN THE JFN BLOCK
OKINT ;PERMIT INTERRUPTS AGAIN
STODN2: MOVE D,STODNA ;GET BACK POINTER TO NAME STRING
MOVE B,[POINT 7,0(D),34] ;GET A BYTE POINTER TO NAME STRING
LOAD A,FILDIR,(JFN) ;SET UP BYTE POINTER TO STRING IN JSB
HRLI A,(POINT 7,0,34)
STODN3: ILDB C,B ;COPY THE STRING INTO THE JFN BLOCK
IDPB C,A
JUMPN C,STODN3 ;LOOP BACK UNTIL A NULL IS SEEN
RETSKP ;AND RETURN
;ROUTINE TO GET THE DIRECTORY # FROM STRING AND UPDATE FILDDN(JFN)
SDIRN:: SAVEP
HRRZ A,FILDEV(JFN) ;IS THIS THE DISK?
CAIE A,DSKDTB ;...
RETSKP ;NO, THEN RETURN OK
LOAD A,FILDIR,(JFN) ;GET POINTER TO THE DIRECTORY NAME
HRRZ B,0(A) ;GET LENGTH OF THE STRING
MOVNI B,-2(B) ;GET NUMBER OF FULL WORDS
HRL A,B ;SET UP LOOKUP POINTER
LOAD B,FILUC,(JFN) ;GET THE UNIQUE CODE OF STR
CALL DIRLKX ;GET THE DIRECTORY NUMBER
RETBAD (GJFX17) ;NO SUCH DIRECTORY
HRRM A,FILDDN(JFN) ;SAVE DIRECTORY NUMBER
RETSKP ;AND RETURN
DFDRST: STKVAR <DRSFIL>
MOVE A,FILOPT(JFN)
MOVEM A,DRSFIL ;SAVE POINTER
MOVE A,FLAGS(TXT) ; SEE IF WAS WILD
TXZN A,DWLDF ; WAS IT?
JRST DFDRS1 ; NO
MOVEM A,FLAGS(TXT) ;YES. CLEAR FLAG
NOINT ; NO INTS
HLRZ A,FILTMP(JFN) ; GET TEMP STRING
STOR A,FILDMS,(JFN) ; TO MASK FIELD
HRRZS FILTMP(JFN)
OKINT ; ALLOW INTS
DFDRS1: CALL STRDI2 ;GO HANDLE WILD DIRECTORY
RETBAD() ;NO GOOD
MOVE A,DRSFIL
MOVEM A,FILOPT(JFN) ;REASTORE POINTER
TQO <DIRF> ;LITE THE DIR FIELD SEEN
MOVE C,FILCNT(JFN) ;GET RESIDUE COUNT
TQNN <NAMF,NAMTF> ;ALREADY HAVE A NAME?
CAMGE C,CNTWRD(TXT) ;OR HAVE SOME CHARACTERS
JRST RFALSE ;YES. DON'T TYPE STAR
TQNE <NREC> ;DOING RECOGNITION?
JRST RFALSE ;NO, DONT TYPE STAR
CHOUT ("<") ; PUNCTUAUTION
LOAD B,FILDMS,(JFN) ; GET DIRECTORY MASK
CALL TYSTR1 ; GO DO THIS OR A STAR
JRST DEFDT2 ; AND GO WRAP UP
DEFDIT: MOVE C,FILCNT(JFN) ;CHECK IF TYPING IS OK NOW
TQNN <NAMF,NAMTF> ;IS THERE ALREADY A NAME SEEN?
CAMGE C,CNTWRD(TXT) ;NO, ARE THERE ANY CHARACTERS TYPED IN?
RET ;YES, THEN DONT TYPE OUT THE DIRECTORY
HRRZ B,FILLNM(JFN) ;IS THERE A LOGICAL NAME YET?
JUMPN B,R ;YES, DONT TYPE ANYTHING OUT
TQNE <NREC> ;DOING RECOGNITION
RET ;NO
TQZE <DIRFF> ;WAS "<" TYPED ALREADY?
JRST DEFDT1 ;YES, DONT TYPE IT AGAIN
CHOUT ("<") ;YES, TYPE DIRECTORY NAME
DEFDT1: HLRZ B,FILTMP(JFN) ;GET STRING WITH DIR NAME IN IT
CALL TSTRB ;TYPE OUT DIR NAME
DEFDT2: CHOUT (">") ;CLOSE WITH CLOSE ANGLE BRACKET
TQO <DIRTF> ;MARK THAT DIR WAS TYPED
RETSKP
; Default name
; Call: JFN, ETC.
; CALL DEFNAM
; Return
; +1 ; A=0 MEANS No default specified
; +2 ; If successful, the name specified is set as filnam
; Clobbers a,b,c,d
DEFNAM: TQNE <DIRF>
JRST DEFNA0 ;ALREADY HAVE A DIR
CALL DEFDIR
JUMPN A,R ;IF ERROR OCCURED, RETURN
DEFNA0: CALL GLNNAM ; GO GET A LOGICAL NAME DEFAULT
SKIPA ; THERE WAS NONE
JRST DEFNM1 ; FOUND ONE, GO USE IT
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default for short form
XCTU [SKIPN A,4(A)] ; Get user's default pointer
JRST RFALSE ; None specified
CALL REDFLT ; Read default string
RETBAD
DEFNM1: TQZE <DFSTF>
JRST DFSTRN
CALL NAMLKX ; Lookup name
JRST [ TQNE <NNAMF> ; NO NAME DEVICE?
JRST RFALSE ; YES, JUST RETURN
JRST STEPLN] ; NO SUCH NAME, STEP LOGICAL NAME
RETBAD () ; AMBIGUOUS NAME
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
NOINT
HLRZ B,FILTMP(JFN)
HRRZS FILTMP(JFN)
HRLM B,FILNEN(JFN)
OKINT
TQO <NAMF,NAMTF>
AOS (P)
TQNN <NREC>
HRLI B,(<POINT 7,0,34>) ; SET UP BYTE POINTER
CALL TSTRQ ; Output the default name
JRST RFALSE
DFSTRN: MOVE A,FLAGS(TXT) ; SEE IF A WILD MASK
TXZN A,DWLDF ; IS IT?
JRST DFSTR1 ; NO
MOVEM A,FLAGS(TXT) ; YES. CLEAR FLAG
NOINT
HLRZ A,FILTMP(JFN) ; GET DEFAULT POINTER
STOR A,FILNMS,(JFN) ; TO MASK
HRRZS FILTMP(JFN)
OKINT
DFSTR1: TQO <NAMSF,STEPF>
SETZ A,
CALL NAMLKX ;TRY * FOR NAME
JRST [ TQNE <NNAMF> ;FAILED, NO NAME DEVICE?
JRST RFALSE ;YES, OK
JRST STEPLN] ;NO, STEP LOGICAL NAME
RETBAD () ;AMBIGUOUS
MOVEM A,FILFDB(JFN) ;REMEMBER THE FDB ADDRESS
CALL STRNA1 ;FINISH UP
RETBAD ()
TQZ <EXTFF>
TQO <NAMF,NAMTF>
LOAD B,FILNMS,(JFN) ; NAME MASK
TQNN <NREC>
CALL TYSTR1 ; GO DO THIS OR A STAR
RETSKP
; Default extension
; Call: JFN, ETC.
; CALL DEFEXT
; Return
; +1 ; A=0 MEANS User default does not exist
; +2 ; Hunky dory, the string specified by the user becomes
; ; The extension
DEFEXT: CALL GETDEX ; GO GET DEFAULT EXTENSION STRING
RET ; NONE THERE
TQZE <DFSTF>
JRST DFSTRE
CALL EXTLKX ; Look it up
;**;[3011] REPLACE ONE LINE AT DEFEXT: + 5L WITH 3. TAB 7-SEP-83
;[3011] JRST RFALSE
JRST [ CAIE 1,GJFX23 ;[3011] SKIP IF DIRECTORY FULL
JRST RFALSE ;[3011] ELSE SAY NO MATCH.
RETBAD] ;[3011] RETURN AS ERROR
JRST RFALSE ; None such
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
NOINT
HLRZ B,FILTMP(JFN)
HRRZS FILTMP(JFN)
HRRM B,FILNEN(JFN)
OKINT
TQO <EXTF,EXTTF>
AOS (P)
TQNN <NREC>
TQNE <NNAMF>
JRST RFALSE
PUSH P,B
MOVEI B,"."
TQZN <EXTFF>
CALL OUTCH
POP P,B
HRLI B,(<POINT 7,0,34>) ; SET UP BYTE POINTER
CALL TSTRQ ; Output the default extension
TQNE <NVERF>
JRST RFALSE
CALL TSTLNG ;SEE IF LONG NAMES ALLOWED
JRST DFSTRR ;NO
CHOUT <PNCVER> ;OUTPUT THE PUNCTUATION
DFSTRR: CALL ENDEX0
RETBAD
JRST RFALSE
DFSTRE: MOVEI B,"."
TQON <EXTFF>
TQNE <NREC>
JRST DFSTE1
TQNN <NNAMF>
CALL OUTCH
DFSTE1: MOVE A,FLAGS(TXT) ; SEE IF WILD MASK
TXZN A,DWLDF ; IS IT?
JRST DFSTE2 ; NO
MOVEM A,FLAGS(TXT) ; YES. CLEAR FLAG
NOINT
HLRZ A,FILTMP(JFN) ; GET DEFAULT POINTER
STOR A,FILEMS,(JFN) ; TO MASK FIELD
HRRZS FILTMP(JFN) ; CLEAR OUT DEFAULT POINTER
OKINT
DFSTE2: CALL STREX1
RETBAD
TQO <EXTF> ;SAY SAW AN EXTENSION
LOAD B,FILEMS,(JFN) ;EXTENSION MASK
TQNN <NREC>
CALL TYSTR1 ; TYPE MASK OR STAR
TQNN <NREC>
TQNE <NVERF>
RETSKP
CALL TSTLNG ;ALLOWING LONG NAMES?
RETSKP ;NO
DFSTE3: CHOUT <PNCVER>
RETSKP
;ROUTINE TO GET THE DEFAULT EXTENSION STRING
;RETURNS +1: A=0 MEANS NO DEFAULT, A.NE.0 MEANS ERROR
; +2: STRING POINTER TO DEFAULT STRING IN A
GETDEX: CALL GLNEXT ; SEE IF A LOGICAL NAME DEFAULT EXISTS
SKIPA ; NONE FOUND
RETSKP ; GOT ONE
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default if short form
XCTU [SKIPN A,5(A)] ; Get user's default pointer
JRST RFALSE ; NONE THERE
CALLRET REDFLT ; Copy default string
; Default version
; Call: JFN ETC.
; CALL DEFVER
; Return
; +1 ; error
; +2 ; FOUND A VERSION
; Sets the file version number to the default specified by user
; Clobbers a,b,c,d
DEFVER: MOVEI A,0
TQNE <NVERF,NNAMF>
RETSKP
CALL GLNVER ;GET LOGICAL NAME DEFAULT IF ANY
JRST [ HRRZ A,E
XCTU [HRRE A,0(A)] ;NONE, Get USER DEFINED default version
JRST .+1]
TQNE <TMPFF>
SKIPE A ;TEMPORARY AND WANT "DEFAULT"?
JRST DEFVR1
MOVE A,JOBNO ; Default becomes job number for temp
ADDI A,^D100000
JRST DEFVR2 ;GO DO IT
DEFVR1: SKIPN A
TQNN <OUTPF>
JRST .+2
SOS A ; 0 default becomes -1 for output
CAMN A,[-3] ;-3 MEANS *
JRST [ TQNN <ASTAF> ;STARS ALLOWED?
TQNE <ASTF> ;* ALREADY SEEN?
SKIPA ;ALLOW IT
RETBAD (GJFX31) ;NO, GIVE AN ERROR NOW
JRST DFSTRV] ;YES, DEFAULT THE VERSION TO *
CAMN A,[-2] ;-2 MEANS LOWEST
TQO <LVERF>
CAMN A,[-1] ;-1 MEANS NEXT HIGHER
TQO <HVERF>
SKIPN A
TQO <RVERF>
DEFVR2: CALL VERLUK ; Extant?
JRST STEPLN ; NO, STEP THE LOGICAL NAME
HRRM A,FILVER(JFN)
MOVEM B,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
MOVE B,A
TQO <VERTF,VERF>
MOVX C,TMPFL!ATRF!ARBATF!PREFXF ;SEE IF ;T OR AN ATTRIBUTE WAS TYPED
TQNN <ACTF,PRTF> ;OR IF ;A OR ;P WERE TYPED
TDNE C,FLAGS(TXT)
RETSKP ;YES, DONT TYPE OUT RECOGNIZED VERSION #
TQNE <ACTFF,PRTFF> ;GETTING AN ACCOUNT OR PROTECTION?
RETSKP ;YES, DO NOT TYPE OUT VERSION #
TQNN <KEYFF> ;PRECEEDED BY A ";"?
TQNE <NREC>
RETSKP ;NO RECOGNITION
CALL TSTLNG ;LONG NAMES ALLOWED?
RETSKP ;NO. ALL DONE
TXNE F1,DIRSF!NAMSF!EXTSF!VERSF ;STAR TYPED?
TQNN <RVERF> ;AND MOST RECENT VERSION?
SKIPA ;NO
MOVEI B,0 ;YES, TYPE OUT .0 FOR VERSION #
CALL DNOUT
RETSKP
DFSTRV: CALL STRVER
RETBAD
TQO <VERTF,VERF>
TQNN <KEYFF> ;PRECEEDED BY A ;?
CALL TSTLNG ;LONG NAMES ALLOWED?
RETSKP ;NO. ALL DONE
TQNE <ACTFF,PRTFF> ;GETTING AN ACCOUNT OR PROTECTION?
RETSKP ;YES, DO NOT TYPE OUT VERSION #
TQNN <NREC>
CALL TYSTR
RETSKP
;DEFAULT THE ARBITRARY ATTRIBUTE FIELDS
;THIS ROUTINE ADDS ANY ARBITRARY ATTRIBUTES FROM THE LOGICAL
; NAME DEFINITION AND THEN ADDS ANY ATTRIBUTES FROM THE LONG
; FORM GTJFN BLOCK TO THE CHAIN OF ATTRIBUTES. IF ANY DUPLICATE
; ATTRIBUTES ARE FOUND, THEY ARE IGNORED.
;THIS ROUTINE IS CALLED AS THE LAST STEP OF THE GTJFN PROCESS
; TO GET ALL OF THE ATTRIBUTES DESTINED FOR THIS JFN
DEFATR: STKVAR <DEFATN,DEFATA>
SETZM DEFATN ;CLEAR THE ATTRIBUTE NUMBER TO 0
DEFAT1: MOVE A,DEFATN ;GET THE NUMBER OF THIS ATTRIBUTE
CALL GLNATR ;GET THE NEXT ATTRIBUTE FROM LOGICAL NAME
JRST DEFAT3 ;NONE LEFT
MOVEM A,PREFIX(TXT) ;STORE THE PREFIX VALUE
LOAD A,PFXVAL ;GET THE PREFIX VALUE
CALL CHKATR ;SEE IF THIS ONE IS ON CHAIN YET
JRST DEFAT2 ;YES, DO NOT ADD IT AGAIN
CALL ADDATR ;ADD THE ATTRIBUTE TO THE CHAIN
RETBAD () ;ILLEGAL ATTRIBUTE FOR THIS DEVICE
DEFAT2: AOS DEFATN ;STEP TO NEXT ATTRIBUTE
JRST DEFAT1 ;LOOP BACK FOR ALL LOGICAL NAME ATTRIBUTES
DEFAT3: TLNN E,-1 ;IS THIS A LONG FORM GTJFN
TQNN <JFNRD> ;YES, WAS LONGER FORM SPECIFIED?
RETSKP ;NO, THEN ALL DONE
XCTU [HRRZ A,11(E)] ;GET COUNT OF WORDS IN LONG BLOCK
CAIL A,.GJATR-11 ;IS THERE AN ARBITRARY ATTRIBUTE BLOCK?
XCTU [SKIPN A,.GJATR(E)] ;YES, IS IT NON-ZERO?
RETSKP ;NO, NOTHING MORE TO BE DONE
XCTU [SKIPG B,0(A)] ;SEE IF THERE ARE ANY ATTRIBUTES
RETSKP ;NO
MOVEM A,DEFATA ;SAVE ADDRESS OF ATTRIBUTE POINTERS
MOVEM B,DEFATN ;SAVE COUNT OF ATTRIBUTES
DEFAT4: AOS A,DEFATA ;GET ADDRESS OF NEXT ATTRIBUTE
SOSG DEFATN ;ANY MORE ATTRIBUTES?
RETSKP ;NO
UMOVE A,0(A) ;GET THE NEXT ATTRIBUTE
CALL REDPRE ;GET THE PREFIX
RETBAD ;FAILED
MOVEM B,PREFIX(TXT) ;STORE THE PREFIX VALUE
XCTBU [LDB B,A] ;GET THE TERMINATOR
SKIPN B ;ENDED WITH A NUL?
JRST [ SETO B, ;YES, BACK UP THE BYTE POINTER ONCE
ADJBP B,A ;SO THE DATA FIELD APPEARS TO BE NULL
MOVE A,B
JRST .+1]
CALL REDFLT ;NOW GO READ IN THE DATA PORTION
RETBAD ;SOMETHING WENT WRONG
LOAD A,PFXVAL ;GET THE PREFIX VALUE
CALL CHKATR ;SEE IF THIS IS ALREADY ON CHAIN
JRST DEFAT5 ;YES, DO NOT ADD IT AGAIN
CALL ADDATR ;PUT THIS ATTRIBUTE ON THE CHAIN
RETBAD () ;ILLEGAL ATTRIBUTE FOR THIS DEVICE
DEFAT5: JRST DEFAT4 ;LOOP BACK FOR ALL ATTRIBUTES IN BLOCK
;ROUTINE TO CHECK IF AN ATTRIBUTE IS ON THE CHAIN ALREADY
;ACCEPTS IN A/ PREFIX VALUE TO SEARCH FOR
;RETURNS +1: PREFIX IS ON THE CHAIN ALREADY
; +2: PREFIX IS NOT ON CHAIN
CHKATR: LOAD B,FILATL,(JFN) ;GET START OF CHAIN
CHKAT1: JUMPE B,RSKP ;IF AT END OF CHAIN, RETURN OK
LOAD C,PRFXV,(B) ;GET THE VALUE OF THIS PREFIX
CAMN A,C ;IS THIS A MATCH?
RET ;YES, RETURN +1
LOAD B,PRFXL,(B) ;STEP TO THE NEXT ITEM ON CHAIN
JRST CHKAT1 ;LOOP BACK FOR REST OF CHAIN
;ROUTINE TO ADD AN ATTRIBUTE TO THE CHAIN
;ACCEPTS IN LH OF FILTMP(JFN)/ DATA PORTION OF ATTRIBUTE
; PREFIX(TXT)/ VALUE OF THE PREFIX
;RETURNS +1: ILLEGAL ATTRIBUTE FOR THIS DEVICE
; +2: ATTRIBUTE IS ON CHAIN
ADDATR: HLRZ A,FILTMP(JFN) ;FIRST CHECK LEGALITY OF ATTRIBUTE
LOAD B,PFXVAL ;GET THE PREFIX VALUE
HRRZ C,DEV ;GET DISPATCH ADDRESS ONLY
CALL @ATRD(C) ;CALL DEVICE DEPENDENT MODULE FOR OK
RETBAD () ;ILLEGAL ATTRIBUTE FOR THIS DEVICE
NOINT ;DISALLOW INTERRUPTS
HLRZ A,FILTMP(JFN) ;PICK UP THE DATA STRING
HRRZS FILTMP(JFN) ;CLEAR POINTER TO TEMP STRING
CALL LNKATR ;LINK THIS ATTRIBUTE ONTO CHAIN
OKINT ;CAN ALLOW INTERRUPTS NOW
RETSKP ;ALL DONE
;ROUTINE TO LINK AN ATTRIBUTE ONTO THE ATTRIBUTE LIST
;ACCEPTS IN A/ ADDRESS OF STRING BLOCK OF DATA PROTION OF ATTRIBUTE
; PREFIX(TXT)/ PREFIX VALUE
;RETURNS +1: ALWAYS
LNKATR: LOAD B,FILATL,(JFN) ;GET POINTER TO FIRST ITEM ON LIST
STOR B,PRFXL,(A) ;MAKE NEW ITEM POINT DOWN THE CHAIN
MOVE B,PREFIX(TXT) ;GET PREFIX VALUE
STOR B,PRFXV,(A) ;PUT THIS VALUE IN HEADER
STOR A,FILATL,(JFN) ;PUT NEW ITEM ON CHAIN
MOVX C,ATRF ;MARK THAT AN ATTRIBUTE WAS SEEN
IORM C,FLAGS(TXT) ;THIS STOPS TYPE OUT OF THE VERSION #
RET
;ROUTINE TO READ AND PARSE A DEFAULT PREFIX STRING
;ACCEPTS IN A/ POINTER TO ATTRIBUTE STRING IN USER SPACE
;RETURNS +1: UNKNOWN PREFIX
; +2: A/ UPDATED STRING POINTER
; B/ PREFIX VALUE
REDPRE: STKVAR <REDPRB,<REDPRS,MAXLW>>
TLC A,-1 ;IS THIS ASCIZ POINTER
TLCN A,-1
HRLI A,(POINT 7,0) ;YES, SET UP BYTE POINTER
MOVEM A,REDPRB ;SAVE THE BYTE POINTER
MOVEI B,MAXLC ;GET COUNTER OF LENGTH OF MAX STRING
MOVE C,[POINT 7,REDPRS] ;GET POINTER TO TEMP STRING
REDPR1: XCTBU [ILDB A,REDPRB] ;GET NEXT CHARACTER OF PREFIX
CAIN A,PNCPFX ;IS THIS THE END OF THE PREFIX?
SETZ A, ;YES
CAIL A,"A"+40 ;LOWERCASE?
CAILE A,"Z"+40
SKIPA
SUBI A,40 ;YES, CONVERT IT TO UPPERCASE
IDPB A,C ;STORE THIS CHARACTER IN STRING
JUMPE A,REDPR2 ;DONE?
SOJG B,REDPR1 ;LOOP BACK FOR REST OF CHARACTERS
RETBAD (GJFX5) ;PREFIX TOO LONG
REDPR2: HRROI B,REDPRS ;GET POINTER TO START OF PREFIX STRING
MOVEI A,PRFXTB ;GET ADR OF PREFIX TABLE
TBLUK ;LOOKUP THE PREFIX
ERJMP [MOVE A,LSTERR ;GET THE ERROR CODE
RETBAD ()] ;AND RETURN
TXNN B,TL%ABR!TL%EXM ;FOUND ONE?
RETBAD (GJFX40) ;NO, UNKNOWN PREFIX
HRRZ B,0(A) ;GET THE PREFIX VALUE
MOVE A,REDPRB ;GET THE BYTE POINTER
RETSKP ;AND RETURN +2
; Default account
; Call: JFN ETC.
; CALL DEFACT
; Returns
; +1 ; ERROR
; +2 ; NO ERROR
; Sets filact to that specified by program
; Clobbers a,b,c,d
DEFACT: TQNE <NVERF,NNAMF>
RETSKP
CALL GLNACT ;SEE IF A LOGICAL NAME DEFAULT EXISTS
JRST DEFAC0 ; NONE EXISTS
JUMPL T2,DEFAC4 ; WAS THIS A STRING ACCOUNT NUMBER?
JRST DEFAC1 ; NO, STORE THIS NUMBER
DEFAC0: JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default if short form
XCTU [SKIPN A,7(A)] ; Get default account
RETSKP ; NonE specified
TLC A,-1
TLCE A,-1 ;LH IS -1?
TLNN A,777777 ; Lh = 0?
HRLI A,440700 ; Yes, set up 7 bit bytes
CAMG A,[6B2-1] ; String pointer?
CAMGE A,[5B2]
JRST DEFAC2 ; Yes
DEFAC1: CALL GDFTMP ;GET A BLOCK FOR THE STRING
RETBAD () ;NONE LEFT
MOVE B,A ;GET ACCOUNT NUMBER
TLZ B,700000 ;ZERO THE 5B2
MOVE A,C ;GET STRING POINTER
MOVEI C,12 ;DECIMAL NUMBER
NOUT ;TURN NUMBER INTO A STRING
RETBAD() ;FAILED
IBP A ;NOW TIE OFF THE STRING
MOVE B,A ;GET LAST WORD USED IN B
HLRZ A,FILTMP(JFN) ;GET START OF STRING
CALL TRMBLK ;TRIM IT
JRST DEFAC4 ;GO STORE STRING IN JFN BLOCK
DEFAC2: CALL REDFLT ; Copy string to temp block
RETBAD
DEFAC4: NOINT ; PROTECT THE JSB
HLRZ A,FILTMP(JFN) ; THE STRING POINTER
HRRZS FILTMP(JFN)
MOVEM A,FILACT(JFN)
OKINT
CALL CHKACT ; CHECK THAT THE ACCOUNT STRING MATCHES
RETBAD (GJFX44) ; IT DOESNT MATCH
TQO <ACTF>
RETSKP
; Default protection
; Call: JFN ETC.
; CALL DEFPRT
; Return
; +1 ; error
; +2 ; OK
; Sets the file protection to default specified by user or directory
; Clobbers a,b,c,d
DEFPRT: TQNE <NVERF,NNAMF>
RETSKP
CALL GLNPRT ; GET LOGICAL NAME DEFALUT PORTECTION
SKIPA ; NONE
JRST DEFPR1 ; USE THIS VALUE
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default if short form
XCTU [SKIPN A,6(A)] ; Get the default protection from user
RETSKP
DEFPR1: CAMG A,[6B2-1] ; Must be numeric
CAMGE A,[5B2]
JRST [ TLC A,-1
TLCE A,-1 ;LH =-1?
TLNN A,-1 ;OR LH=0
HRLI A,(POINT 7,) ;YES. USE DEFAULT
CALL REDFLT ; GET STRING
RETBAD ; ERROR
HLRZ A,FILTMP(JFN) ;GET STRING ADDRESS
TQO <OCTF> ; SAY LOOKING FOR OCTAL
CALL GETNUM ; TRY TO CONVERT TO NUMBER
RETBAD (GJFX14) ; ILLEGAL
MOVEM A,FILPRT(JFN) ;STASH IT AWAY
NOINT
HLRZ B,FILTMP(JFN) ;THE JSB SPACE
HRRZS FILTMP(JFN)
MOVEI A,JSBFRE
CALL RELFRE ;FREE THE BLOCK
OKINT
JRST DEFPR2] ;GO MARK IT
MOVEM A,FILPRT(JFN)
DEFPR2: TQO <PRTF>
RETSKP
;ROUTINE TO COLLECT A NUMBER FOR DEFACT AND DEFPRT
GETNUM: SETZ B, ;THE ACCUMLATOR
MOVEI D,11 ;ASSUME DECIMAL
TQNE <OCTF> ;WANT OCTAL?
MOVEI D,7 ;YES
TQZ <OCTF> ;RESTORE THIS
HRLI A,(<POINT 7,0,35>) ;SET UP THE STRING POINTER
GETNM2: ILDB C,A ;GET NEXT
JUMPE C,GETNM1 ;DONE
CAIL C,"0" ;POSSIBLY A DIGIT?
CAILE C,"0"(D) ;""
RET ;NO
IMULI B,1(D) ;SCALE ACCUMULATOR
ADDI B,-"0"(C) ;ADD IN THE DIGIT
JRST GETNM2 ;AND GO GET THE NEXT
GETNM1: TLNE B,-1 ;WITHIN BOUNDS?
RET ;NO
MOVEI A,0(B) ;YES
TLO A,(5B2) ;MAKE IT A NUMBER
RETSKP ;RETURN WITH THE NUMBER
; Copy default string
; Call: A ; A default string pointer
; CALL REDFLT
; Returns
; +1 ; ERROR
; +2 ; In a, a lookup pointer
; Copies the default string into a block addressed by lh(filtmp(jfn))
; Clobbers a,b,c,d
REDFLT: CALL GDFTMP ; GET A DEFAULT STRING POINTER IN C
RETBAD ()
MOVEI D,MAXLC
MOVEI B,0 ; Null byte if next instruction jumps
TQZ <DFSTF>
JUMPE A,REDFL2 ; No pointer
TLNE A,777777
JUMPGE A,REDFL7
CAML A,[-1B17]
HRLI A,440700
REDFL7: MOVE B,[XCTBU [ILDB B,A]] ;NEED TO GET IT MAPPED
REDFL0: STKVAR <XCTV,BYTSAV,STTSAV>
MOVEM B,XCTV ;SAVE INSTRUCTION TO GET BYTES
REDFL1: XCT XCTV ;GET A BYTE
MOVEM B,BYTSAV ;SAVE THE BYTE
MOVEM C,STTSAV ;SAVE THE POINTER
CALL GTCODE ;SEE IF VALID CHAR
RET ;NO
MOVE C,B ;GET THE BYTE INTO AC3
MOVE B,BYTSAV ;GET BACK THE BYTE
CAIN C,WILDC ; WILD CHARACTER?
JRST REDQST ; YES. GO DO IT
CAIN C,16 ; Character quote?
JRST REDFL3
CAIN C,20
JRST REDFST
CAIL C,21
CAILE C,27
CAIN C,30
JRST REDFL4
CAIN C,14 ; DOT?
JRST REDFL4 ; YES, DOT IS LEGAL IN DIR NAMES AND ACCOUNTS
CAILE C,1 ; A NON-ALPHA?
JRST [ SETZ B, ;YES, END OF STRING
AOS D ;ALLOW NULL TO BE STORED
JRST REDFL4] ; GO WRAP UP
CAIE D,MAXLC ; FIRST BYTE OF STRING?
TQNN <DFSTF> ; NO. ON A * FIELD?
JRST REDFL4 ; CANT BE WILD
MOVX C,DWLDF ; BECOMING WILD
IORM C,FLAGS(TXT) ; SAY SO
REDFL4: MOVE C,STTSAV ; RESTORE POINTER
CAIL B,"A"+40 ;LOWER CASE?
CAILE B,"Z"+40 ;MAYBE
SKIPA ;NO. DONT RAISE IT
TRZ B,40 ;YES. RAISE IT
REDFL2: SOSGE D ;ROOM FOR THIS ONE IN THE BUFFER?
RETBAD (GJFX5) ;NO. GIVE ERROR THEN
IDPB B,C
JUMPN B,REDFL1
REDFLE: HLRZ A,FILTMP(JFN)
MOVE B,C
CALL TRMBLK ; Trim the block and return excess
HLRZ A,FILTMP(JFN)
MOVN B,(A) ;GET NEG LENGTH OF BLOCK, I.E. -(NWDS+1)
HRLI A,2(B) ;SETUP -(NWORDS-1) IN LH
RETSKP
REDFL3: MOVE C,STTSAV ;RESTORE POINTER
XCT XCTV ;GET NEXT BYTE
JRST REDFL2
REDFST: MOVX C,DWLDF ; SEE IF IT IS BECOMING WILD
CAIE D,MAXLC ; IS IT?
IORM C,FLAGS(TXT) ; YES. SAY SO
STARB: TQNN <ASTAF> ; STARS ALLOWED?
TQNE <ASTF> ;* ALREADY SEEN?
SKIPA ;ALLOW IT
RETBAD (GJFX31) ; NO. GIVE APPROPRIATE ERROR
TQNE <OSTRF> ; OUTPUT STARS ?
TQO <ASTF> ; YES. SAY SO
TQO <DFSTF>
JRST REDFL4 ; AND GO INSERT IT
REDQST: MOVX C,DWLDF ; SAY SAW A WILD MASK
IORM C,FLAGS(TXT)
JRST STARB ; GO DO REST OF WILD LOGIC
GDFTMP: STKVAR <GDFTMT>
MOVEM A,GDFTMT ;SAVE AC A
HLRZ A,FILTMP(JFN)
JUMPN A,[HRRZ B,0(A) ;HAVE A STRING. SEE IF CORRECT LENGTH
CAIN B,MAXLW+1 ;HAS IT BEEN TRIMMED?
JRST GDFTM1 ;NO. USE IT THEN
MOVE B,A ;YES. MUST RELEASE IT
MOVEI A,JSBFRE ; BACK TO THE POOL
NOINT
HRRZS FILTMP(JFN); NO STRING NOW
CALL RELFRE ;FREE IT UP
OKINT ;ALLOW INTS AGAIN
JRST .+1] ;AND GO GET A NEW BLOCK
MOVEI B,MAXLW+1
NOINT
CALL ASGJFR
RETBAD (GJFX22,<OKINT>) ; Insufficient space
HRLM A,FILTMP(JFN)
OKINT
GDFTM1: HRLI A,(<POINT 7,0>)
AOS C,A
MOVE A,GDFTMT ;GET BACK ORIGINAL A
RETSKP ;GIVE SKIP RETURN
;ROUTINE TO COPY A LOGICAL NAME DEFAULT INTO THE DEFAULT STRING
;CALL:
; MOVE T1,ADR OF STRING TO BE COPIED
; CALL LNMCPY
;RETURNS +1: ERROR
; +2: OK
LNMCPY::STKVAR <LNMCPS> ;GET A WORK CELL
MOVEM T1,LNMCPS ;SAVE POINTER TO STRING TO BE COPIED
CALL GDFTMP ;GET A DEFAULT STRING TO COPY INTO
RETBAD ()
MOVE T1,LNMCPS ;RESTORE POINTER TO DEFAULT STRING
MOVEI D,MAXLC ;COUNT OF BYTES
SETZ B, ;IN CASE
CAMN T1,[-2] ;IS THIS A NULL STRING
JRST REDFL2 ;GO HANDLE NULL STRING
HRLI T1,(POINT 7,0,35) ;SET UP A STRING POINTER TO STRING
MOVE B,[ILDB B,A] ;USE LOCAL BYTE OPERATION
JRST REDFL0 ;GO COPY IT
;ROUTINE TO CHECK THAT AN ACCOUNT STRING IS OK
CHKACT: TQNN <ASTF> ;PARSE ONLY?
TXNE F1,STRSF!DIRSF!NAMSF!EXTSF!VERSF ;ANY STARS?
RETSKP ;YES, ACCOUNT STRING MUST BE OK
SKIPE FILACT(JFN) ;IS THERE AN ACCOUNT STRING?
TQNE <NEWF,NEWVF> ;YES, OLD FILE?
RETSKP ;NO, THEN OK
HRRZ A,FILDEV(JFN) ;SEE IF THIS IS THE DISK
CAIE A,DSKDTB ;...
RETSKP ;NOT A DISK, ALWAYS PROCEED
CALL GETFDB ;MAP IN THE FILE
RETBAD () ;FAILED
CALL COMACT ;SEE IF ACCOUNT STRING MATCHES
RETBAD (,<CALL USTDIR>) ;IT IS NOT A MATCH
CALL USTDIR ;MATCHED, UNLOCK THE DIR
RETSKP ;AND GIVE SUCCESSFUL RETURN
;ROUTINE TO COMPARE ACCOUNT STRINGS
;THIS ROUTINE ASSUMES DIR IS LOCKED
;ACCEPTS IN A/ ADR OF FDB OF FILE
; CALL COMACT
;RETURNS +1: NO MATCH
; +2: MATCHED, OR NO ACCOUNT STRING SPECIFIED IN JFN
COMACT: STKVAR <COMACP,<COMACS,3>>
SKIPN FILACT(JFN) ;WAS AN ACCOUNT STRING SPECIFIED?
RETSKP ;NO, THIS MATCHES ALL STRINGS
MOVE B,.FBACT(A) ;GET ACCOUNT STRING
CAMG B,[6B2-1] ;IS THIS A NUMBER?
CAMGE B,[5B2] ;...
JRST [ ADD B,DIRORA ;GET BASE ADR OF THE ACCOUNT STRING
ADDI B,.ACVAL ;POINT TO THE FIRST WORD OF THE STRING
JRST COMAC1]
TLZ B,700000 ;CLEAR THE 5B2 IN THE NUMBER
HRROI A,COMACS ;GET POINTER TO DESTINATION STRING
MOVEI C,12 ;DECIMAL
NOUT ;TRANSLATE NUMBER TO A STRING
RETBAD () ;FAILED
MOVEI B,COMACS ;GET ADR OF FIRST WORD OF STRING
COMAC1: MOVSI A,(<POINT 7,0(B)>) ;SET UP A POINTER TO THE STRING
MOVE C,FILACT(JFN) ;GET POINTER TO STRING IN JFN BLOCK
HRLI C,(POINT 7,0,34) ;..
MOVEM C,COMACP ;SAVE BYTE POINTER
COMAC2: ILDB D,A ;NOW COMPARE THE STRING
ILDB C,COMACP ;GET A CHARACTER FROM EACH STRING
CAME C,D ;MATCH?
RETBAD (GJFX44) ;NO, FAIL
SKIPN D ;END OF STRING?
JUMPE C,RSKP ;IF BOTH STRINGS ENDED, THEN MATCHED
SKIPE D ;IS D DONE AND C NOT DONE?
JUMPN C,COMAC2 ;NEITHER STRING DONE, CONTINUE LOOP
RETBAD (GJFX44) ;NO MATCH
; Recognize current field
; Called from gtjfn loop
; Decides which field was being input, and then attempts to recognize it
RECFLF: MOVX C,SAWF ;ENTRY FOR CNTRL-F TYPED
IORM C,FLAGS(TXT) ;REMEMBER WE SAW A RECOG CHARACTER
RECFLD: CALL BACKIT ;ZAP THE RECOGNITION CHARACTER
MOVE C,FILCNT(JFN) ;WAS ANYTHING TYPED?
CAMN C,CNTWRD(TXT)
JRST RECFL2 ;NO, THEN RECOGNITION CAN OCCUR
TXNE F1,DIRSF!NAMSF!EXTSF!VERSF!STARF
JRST DING ; Cannot recognize after *
RECFL2: TQNE <DIRFF> ; Find which field is being input
JRST RECDIR ; Directory name is
TQNE <EXTFF>
JRST RECEX0 ; Extension is
TQNN <NAMF>
JRST RECNA0 ; Recognize name
MOVE C,FILCNT(JFN)
CAME C,CNTWRD(TXT) ; SOMETHING TYPED, TREAT LIKE CONT-F
JRST RECFL1 ; Some thing typed, treat like cont-f
MOVE C,FLAGS(TXT) ; SEE IF GETTING AN ATTRIBUTE
TXNN C,ARBATF ; IF YES, THEN DING
TQNE <VERF>
JRST DING ; Can recognize no more
JRST DEFVER ; Default version
RECFL0: TQNE <DIRFF>
JRST RECDIR
TQNE <EXTFF>
JRST RECEXT
TQNN <NAMF>
JRST RECNA0
MOVE C,FLAGS(TXT) ;SEE IF PARSING A PREFIX
TXNE C,PREFXF ;...
JRST RECPRE ;YES, GO RECOGNIZE IT
MOVE D,FILCNT(JFN) ;SEE IF NOTHING TYPED YET
CAMN D,CNTWRD(TXT) ;...
TXNN C,ARBATF ;NOTHING TYPED YET, DOING AN ATTRIBUTE?
JRST ENDEXT ;NO, CAN GO FINISH DEFAULTING EVERYTHING
TQNN <NREC> ;RECOGNIZING?
JRST DING ;YES, CANNOT RECOGNIZE A NULL ATTRIBUTE
RETBAD (GJFX46) ;NULL ATTRIBUTE IS NOT ALLOWED
RECFL1: MOVE C,FLAGS(TXT) ;CHECK FOR AN ATTRIBUTE PREFIX
TXNE C,PREFXF ;...
JRST RECPRF ;GO RECOGNIZE PREFIX
CALLRET ENDEXT ;NO, GO FINISH THIS FIELD
; Recognize directory name
; Call: RH(FILTMP(JFN)) ; Pointer to string block to recognize
; FILOPT(JFN) ; Pointer to last character in string
; Flags norec, devf, dirf,dirff,dirtf are updated or used
; CALL RECDIR
; Return
; +1 ; A=0 MEANS Ambiguous
; +2 ; Ok
; Clobbers most everything
RECDIR: TQNE <DEVF>
JRST RECDI1 ;HAVE A DEV ALREADY
CALL DEFDEV ; Default device first
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
RECDI1: CALL ENDSTR ; Terminate string, get lookup pointer
PUSH P,FILOPT(JFN) ; Save filopt(jfn) for typing out tail
HRRZ B,FILDEV(JFN) ;SEE IF THIS IS A DISK
CAIE B,DSKDTB ;IF NOT, DONT CALL DIRLKX
JRST RECDI2 ; NOT A DISK
LOAD B,FILUC,(JFN) ; GET STRUCTURE NUMBER
MOVE C,FILOPT(JFN) ; COPY POINTER TO TAIL
CALL DIRLUK ; Lookup directory name get number
JRST [ JUMPL A,RECDI2 ; AMBIGUOUS
TQNE <ASTF> ; PARSE ONLY?
JRST RECDI2 ; YES. TREAT AS IF AMBIGUOUS THEN
POP P,FILOPT(JFN)
MOVEI A,GJFX17 ; NO SUCH DIRECTORY, STEP LOGICAL NAME
JRST STEPLN]
HRRM A,FILDDN(JFN) ; Store directory number
MOVEM B,FILOPT(JFN) ;SAVE UPDATED POINTER
CALL ENDTMP ;TIE OFF THE DIR NAME STRING
STOR A,FILDIR,(JFN) ;STORE IT IN THE JFN BLOCK
OKINT ;UNLOCK FROM ENDTMP
POP P,B
TQNN <NREC> ;WANT RECOGNITION?
JRST [ CALL TSTRQ ;YES. TYPE OUT REST OF NAME
CALL BRKOUT ;OUTPUT THE PUNCTUAUTION
JRST .+1] ;AND GO FINISH UP
TQO <DIRF,DIRTF>
TQZ <DIRFF>
CALLRET SETTMP ; Reset temp block and return
; HERE ON AMBIGUOUS RETURN FROM DIRLUK
RECDI2: MOVEM B,FILOPT(JFN) ;STORE UPDATED POINTER
POP P,B ;GET BACK POINTER TO UNTYPED TEXT
TQNE <NREC> ;DOING RECOGNITION?
JRST [ MOVEI A,GJFX17 ;NO, THEN NO DIRECTORY WAS FOUND
JRST STEPLN] ;GO SEE IF WE CAN STEP
CALL TSTRQ ;OUTPUT THE RECOGNIZED PORTION
CALLRET DING ;DING THE USER
;ROUTINE TO OUTPUT TERMINATING PUNCTUATION AFTER DIRECTORY
;RECOGNITION
BRKOUT: MOVEI B,">" ;DEFAULT PUNCTUAUTION
MOVX C,SWBRKT ;SAW "[" BIT
TDNE C,FLAGS(TXT) ;NEED TO OUTPUT A "]"
MOVEI B,"]" ;YES. SO DO IT
CALL OUTCH ;GO DO IT
RET ;AND DONE
; Recognize extension
; This routine operates in the same way as recdir described above
RECEXT: CALL RECEXX
JRST [ JUMPN A,R ;IF ERROR, RETURN NOW
MOVEI A,GJFX19 ;IF NO ERROR, STEP LOGICAL NAME
JRST STEPLN]
CALLRET DING
RETSKP
RECEXX: CALL ENDSTR ; Terminate string, get lookup pointer
PUSH P,FILOPT(JFN) ; Save filopt(jfn) for typing out tail
CALL EXTLUK ; Lookup extension
JRST [ POP P,FILOPT(JFN)
TQNE <OLDNF> ;IF OLD FILE DESIRED,
JRST RFALSE ;GO STEP LOGICAL NAME
TQNE <NREC> ;DOING RECOGNITION?
RETBAD ;NO, GO RETURN THE ERROR
RETSKP] ; RETURN AMBIG
JRST [ POP P,FILOPT(JFN)
RETSKP] ; Ambiguous
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
CALL ENDTMP ; Truncate temp string get pointer
HRRM A,FILNEN(JFN) ; Store as extension
OKINT
TQO <EXTF,EXTTF>
TQZ <EXTFF>
POP P,B
TQNN <NNAMF>
TQNE <NREC> ; Were we performing recognition?
JRST RECXX1 ; No. done
CALL TSTRQ ; Yes, output tail
TQNE <NVERF>
JRST RECXX1
CALL TSTLNG ;ALLOWING LONG NAMES?
JRST RECXX1 ;NO
CHOUT <PNCVER> ;AND THE PUNCTUATION
TQO <NUMFF> ; And act like the user did it
MOVX A,VERFF ; SAW VERSION . FLAG
IORM A,FLAGS(TXT) ; SAY SO
RECXX1: CALL SETTMP ; Reset temp block and return
RETBAD
AOS 0(P) ;GIVE DOUBLE SKIP RETURN
RETSKP
RECEX0: MOVE C,FILCNT(JFN)
CAME C,CNTWRD(TXT)
JRST RECEX1 ;HAVE PARTIAL STRING, GO RECOGNIZE
CALL DEFEXT ;TRY FOR DEFAULT VALUE FIRST
SKIPA
RETSKP
JUMPN A,R ;IF ERRORS, RETURN
CALL GETDEX ;SEE IF THERE IS A DEFAULT EXT
JRST [ JUMPN A,R ;IF ERROR, RETURN
JRST RECEX1] ;IF NO DEFAULT, GO TRY TO RECOGNIZE
MOVEI A,GJFX19 ;SEE IF LN CAN BE STEPPED
CALL STEPLN
JUMPL A,R ;IF STEPPED, RETURN
RETBAD ;COULD NOT, RETURN ERROR CODE
RECEX1: TQNE <ASTF> ;OUTPUT STARS?
JRST DING ;YES. ALWAYS AMBIGUOUS THEN
CALL RECEXX ;TRY TO RECOGNIZE
JRST [ JUMPN A,R ;IF ERROR, RETURN NOW
MOVEI A,GJFX19 ;EXTENSION NOT FOUND
RET]
JRST DING
RETSKP
; Recognize name
; This routine operates in the same way as recdir and recext above
RECNA0: TQNN <DEVF> ;SEEN A DEVICE YET?
JRST [ CALL DEFDEV ;NO, GO GET DEFAULTED DEVICE
SKIPA
RETSKP ;DEVICE NAME WAS RECOGNIZED, STOP HERE
JUMPE A,.+1 ;IF NO ERRORS, GO DEFAULT IN NAME
RETBAD ()] ;OTHERWISE, EXIT
TQNN <DIRF> ;SEEN A DIRECTORY YET?
JRST [ CALL DEFDIR ;NO, GO DEFAULT ONE
SKIPA
RETSKP ;DIR WAS RECOGNIZED, STOP HERE
JUMPE A,.+1 ;IF NO ERRORS CONTINUE ON
RETBAD ()] ;OTHERWISE EXIT
SETZ A, ;NO ERROR CONDITION
MOVE C,FILCNT(JFN) ;GET CHARACTERS FOUND
CAMN C,CNTWRD(TXT) ;FOUND ANY?
SKIPA ;ONLY DO DEFAULT
CALL RECNA1 ;HAVE DEV AND DIR, NOW TRY FOR NAME
JRST [ JUMPN A,R ;IF ERROR EXIT
MOVE C,FILCNT(JFN)
CAMN C,CNTWRD(TXT)
CALL DEFNAM
SKIPA
JRST .+1
JUMPE A,DING ;IF NO ERRORS, RING THE BELL
RETBAD ()]
TQNN <NREC> ;DOING RECOGNITION?
TQNE <NNAMF>
RETSKP ;NO, DONT TYPE OUT "."
CHOUT "."
TQO <EXTFF>
RETSKP
RECNAM: CALL RECNA1
SKIPA
RETSKP
JUMPE A,DING ;GO RING BELL IF NO ERROR
RETBAD ()
RECNA1: TQNE <DIRF>
JRST RECNA2 ;ALREADY HAVE A DIR
CALL DEFDIR ; Default directory
JUMPN A,R ; IF ERROR, RETURN
RECNA2: CALL ENDSTR ; Terminate string, get lookup pointer
PUSH P,FILOPT(JFN) ; Save filopt(jfn) for typing tail
CALL NAMLUK ; Lookup name in directory
JRST [ POP P,FILOPT(JFN)
TQNN <OLDNF> ;NEW FILES ALLOWED?
TQNE <NREC> ;AND TRYING TO RECOGNIZE?
JRST STEPLN ;YES, GO STEP LOGICAL NAME
JRST RFALSE] ;NO, RETURN AMBIG
JRST [ POP P,FILOPT(JFN)
JRST RFALSE] ; Ambiguous
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
CALL ENDTMP ; Truncate temp block, and get pointer
HRLM A,FILNEN(JFN) ; To put in file name
OKINT
TQO <NAMF,NAMTF>
POP P,B
TQNN <NNAMF>
TQNE <NREC>
SKIPA ; Setup new temp, and return
CALL TSTRQ ; Type remainder
CALLRET SETTMP
;ROUTINE TO RECOGNIZE THE PREFIX PORTION OF AN ATTRIBUTE FIELD
RECPRE: CALL RECPR0 ;GO TRY TO RECOGNIZE
JRST RECPRA ;AMBIGUOUS
MOVE A,PREFIX(TXT) ;GET PREFIX VALUE
TXNE A,NOATRF ;DOES THIS HAVE AN ARGUMENT?
JRST [ CALL ENDARB ;GO CLOSE OUT THIS ATTRIBUTE
RETBAD
JRST ENDEXT] ;GO RECOGNIZE THE OTHER FIELDS
TQNN <NREC> ;RECOGNIZING?
JRST DING ;YES, CAN GO NO FURTHER
RETBAD (GJFX46) ;NO, ATTRIBUTE VALUE REQUIRED
RECPRF: CALL RECPR0 ;GO TRY TO RECOGNIZE
JRST RECPRA ;FAILED OR AMBIGUOUS
MOVE A,PREFIX(TXT) ;SEE IF THIS HAS AN ATTRIBUTE VALUE
TXNN A,NOATRF ;...
RETSKP ;IT DOES, GO WAIT FOR ONE
CALLRET ENDARB ;IT DOESNT, CLOSE THIS PREFIX OUT
RECPRA: JUMPN A,R ;IF NON-ZERO, THEN ERROR CODE
TQNN <NREC> ;RECOGNIZING?
JRST DING ;YES, GIVE AMBIGUOUS RETURN
RETBAD (GJFX40) ;NO, UNKNOWN ATTRIBUTE
RECPR0: CALL ENDSTR ;TIE OFF THE PREFIX STRING
HRLI A,(POINT 7,0,35) ;GET POINTER TO THE FIRST CHAR
MOVE B,A ;SET UP FOR LOOKUP OF PREFIX
MOVEI A,PRFXTB ;GET POINTER TO PREFIX TABLE
TBLUK ;LOOKUP THE PREFIX
ERJMP [MOVE A,LSTERR ;GET THE ERROR CODE
RETBAD ()]
TXNN B,TL%ABR!TL%EXM ;FOUND A PREFIX?
JRST [ TXNE B,TL%AMB ;NO, AMBIGUOUS?
JRST RFALSE ;YES, GO DING
RETBAD (GJFX40)] ;NO, UNKNOWN ATTRIBUTE
HRRZ A,0(A) ;GET THE PREFIX VALUE
MOVEM A,PREFIX(TXT) ;SAVE IT AWAY
EXCH B,C ;GET POINTER TO REMAINDER OF PREFIX
TQNE <NREC> ;DOING RECOGNITION?
JRST RECPR1 ;NO, DONT OUTPUT THE REMAINDER OF STRING
TXNN C,TL%EXM ;EXACT MATCH?
CALL TSTRQ ;NO, TYPE OUT THE REMAINDER OF PREFIX
MOVEI B,PNCPFX ;FOLLOWED BY THE SEPERATOR
MOVE A,PREFIX(TXT) ;GET PREFIX VALUE
TXNN A,NOATRF ;ANY ATTRIBUTE VALUE?
CALL OUTCH ;YES, TYPE OUT THE PUNCTUATION
RECPR1: LOAD A,PFXVAL ;GET PREFIX VALUE
CALL CHKATR ;SEE IF ALREADY ON THE CHAIN
RETBAD (GJFX45) ;YES, ERROR
MOVX A,PREFXF ;CLEAR PREFIX FLAG
ANDCAM A,FLAGS(TXT)
MOVX A,ARBATF ;AND SET ATTRIBUTE FLAG
IORM A,FLAGS(TXT)
CALLRET SETTMP ;GO SET UP TO GET DATA FIELD
REPEAT 0,< ; Repeat zero historical code
DELALL: TMSG </___
/>
NOINT
CALL RELJFX ; Release jfn (to clear free storage)
CALL ASGJFN ; And reassign
RETBAD (GJFX3,<OKINT>) ; Should not happen, but in case
OKINT
HRRZ F1,E
XCTU [HLLZ F,0(F1)]
MOVEI F1,0
CALLRET SETTMP ; And start over
> ; End of REPEAT ZERO historical code
RETYPE: TMSG </
/>
SETZ C, ;A NULL
MOVE B,CURPNT(TXT) ; CURRENT TAIL POINTER
IDPB C,B ; TIE IT OFF
MOVE A,ARGCR(TXT) ;START OF IT ALL
PSOUT ; PRINT IT OUT
CALL SFCC0 ; BACK TO GTJFN STANDARDS
RET ;AND DONE
TYSTR1: SKIPN B ; NEED TO DO A STAR?
TYSTR: MOVEI B,[ASCIZ /*/]-1 ; YES
CALL TSTRB ; GO TYPE OUT WHAT IS IN B
RET
; Terminator seen, finish up
ENDCNF: TQOA <TCONF> ;SAW CONFIRMING TERMINATOR
ENDALL: TQZ <TCONF> ;SAW NON-CONFIRMING TERMINATOR
TQO <NREC> ; Suppress recognition
JRST ENDALZ
RECALL: CALL BACKIT ;ZAP THE RECOGNITION CHARACTER
MOVX A,SAWALT ;SAY SAW AN ALTODE
IORM A,FLAGS(TXT) ;REMEMBER THIS IN FLAG WORD
TQZ <TCONF> ;NO CONFIRMATION SO FAR
TQZ <NREC> ;INSURE WE WILL DO RECOGNITION
ENDALZ: TQNN <STARF>
JRST ENDLZ1
CALL [ TQNE <DIRFF> ;COLLECTING DIRECTORY?
JRST [ CALL ENDDIR ;YES. GO FINISH IT UP
RET ;FAILED
TQNN <NREC> ;DOING RECOGNITION?
CALL BRKOUT ;YES. OUTPUT TERMINATOR
RETSKP] ;DONE
TQNN <NAMF>
CALLRET ENDNA3
CALLRET ENDEX8]
JRST [ JUMPL A,GTJFST ; IF <0, LN WAS STEPPED
JRST ERRDO] ; ELSE, NO STEP
ENDLZ1: MOVE C,FILCNT(JFN)
TQNN <DIRFF> ;COLLECTING A DIRECTORY?
CAME C,CNTWRD(TXT) ; Is input string NON-null?
JRST [ TQNN <NREC> ;YES. DOING RECOGNITION?
TXNN F1,STRSF!DIRSF!NAMSF!EXTSF!VERSF ;YES. SEEN A STAR?
SKIPA ;NO. GO DO LOOKUP
CALL [ TQNE <EXTF> ;GOT EXTENTION FIELD YET?
RET ;YES, RECOGNITION AFTER EXT IS OK
CALL DING ;NO, RETURN AMBIGUOUS
MOVEI A,0
RETSKP]
CALL RECFL0
SKIPA
JRST .+1 ; FOUND ONE
JUMPE A,GTJF2 ; AMBIGUOUS
JUMPG A,ERRDO ; ERROR
TQNE <ASTF> ; PARSE ONLY?
JRST ENDAL4 ; YES, CONTINUE
JRST GTJFST] ; RETRY - LOGICAL NAME WAS STEPPED
MOVE C,FLAGS(TXT) ;SEE IF GETTING AN ATTRIBUTE
TXNE C,ARBATF ;...
JRST [ MOVEI A,GJFX46 ;YES
TQNE <NREC> ;RECOGNIZING?
JRST ERRDO ;NO, THEN GIVE AN ERROR RETURN
CALL DING ;YES, RING THE BELL
JRST GTJF2] ;AND GO BACK FOR THE ATTRIBUTE VALUE
TQNE <NAMF,NNAMF> ; Do we have a name?
JRST ENDAL0 ; Yes.
CALL DEFNAM ; No, try the default name
JRST [ JUMPL A,GTJFST ; LN WAS STEPPED, GO RETRY
JUMPG A,ERRDO ; ERROR OCCURED
CALL RECNAM ; NO DEFAULT, SEE IF A NO-NAME DEVICE
SKIPA
JRST ENDAL0 ; YES, THEN THROUGH WITH GTJFN JSYS
JUMPE A,GTJF2 ; GO GET MORE FROM USER
JUMPG A,ERRDO ; ERROR
TQNE <ASTF> ; PARSE ONLY?
JRST ENDAL4 ; YES - DON'T RETRY STEPPED LOGICAL NAME
JRST GTJFST] ; RETRY - LOGICAL NAME WAS STEPPED
ENDAL0: TQNE <EXTF,NNAMF> ; After all that, do we have ext?
JRST ENDAL4 ; Yes
MOVE C,FILCNT(JFN) ; IS THERE A PARTIAL STRING?
TQNN <EXTFF> ; SAW A DOT YET?
CAME C,CNTWRD(TXT) ; HAVE A PARTIAL STRING?
JRST ENDAL6 ; YES, GO USE IT
CALL DEFEXT ; NO, Attempt to default extension
JRST [ JUMPL A,GTJFST ;LOGICAL NAME WAS STEPPED
JUMPG A,ERRDO ;AN ERROR WAS ENCOUNTERED
JRST ENDAL6] ;OTHERWISE GO DEFAULT EXT
;..
;..
ENDAL4: TQNE <NNAMF> ; NO NAME DEVICE?
JRST ENDAL7 ; YES
TQNN <VERF> ; Do we have a version?
JRST [ CALL DEFVER ; No, default it
SKIPA ; ERROR
JRST .+1 ;FOUND A VERSION NUMBER
JUMPGE A,ERRDO ;ERROR
CALL STOALT ;LN WAS STEPPED, PUT ALTMODE BACK IF NEEDED
JRST ERRDO ;ERROR ENCOUNTERED
JRST GTJFST] ;GO REPROCESS THE COMMAND
TQNN <NEWF,NEWVF>
JRST [ TQNN <ASTF> ; Parse only?
JRST ENDAL7 ; No, Continue...
JRST .+1] ; Yes, check fields to insert
TQNN <PRTF> ; Do we have protection?
JRST [ CALL DEFPRT ; No, default it
JRST ERRDO
JRST .+1]
TQNN <ACTF> ; Do we have an account?
JRST [ CALL DEFACT ; No, default it
JRST ERRDO
JRST .+1]
ENDAL7: CALL DEFATR ;GET SET UP ANY DESIRED ATTRIBUTES
JRST ERRDO ;FAILED
REPEAT 0,< TQNE <RTYPF> ; User request retyping name?
JRST [ TMSG1 </
/>
SETZ C, ; USE DEFAULT FLAGS
HRRZ A,E
XCTU [HRRZ A,1(A)] ;OUTPUT JFN
TLNE E,777777
TLNE E,2
CAIN A,377777 ;NULL?
JRST .+1 ;MUST BE A NOOP
CALL JFNSM ;PRINT THE FILE NAME
JFCL
JRST .+1]> ;ALL DONE
ENDL77: TQNN <TCONF> ;ALREADY CONFIRMED?
TQNN <PONFF> ;OR NO PRINT REQUESTED?
JRST ENDAL3 ;YES, DON'T PRINT O.F., N.F., ETC.
TQNN <ASTF> ;NOT PARSE ONLY?
TQNE <NREC> ;RECOGNITION?
JRST ENDAL3 ;NO, NO MESSAGE
HRROI B,[ASCIZ / !Old file!/]
TQNN <NVERF>
HRROI B,[ASCIZ / !Old generation!/]
TQNE <NEWVF> ; Did we generate a new version?
HRROI B,[ASCIZ / !New generation!/]
TQNE <NEWF> ; Did we generate a new file
HRROI B,[ASCIZ / !New file!/]
TQNN <NNAMF>
JRST ENDAL9
HRROI B,[ASCIZ / !OK!/]
TQNE <CFRMF>
HRROI B,[ASCIZ / !Confirm!/]
;..
;..
ENDAL9: TXNN F1,DIRSF!NAMSF!EXTSF!VERSF
CALL [ TQNN <JFNRD> ;HAVE AN EXTENDED BLOCK?
CALLRET TSTR1 ;NO. PRINT BUT DON'T PUT IN BUFFER
HRRZ A,E
UMOVE A,11(A) ;YES. GET FLAGS
TQNN <CFRMF> ;WANT CONFIRMATION?
TXNN A,G1%RCM ;NO. WANT THE MESSAGE?
CALLRET TSTR1 ;DON'T PUT IN BUFFER
CALLRET TSTR] ;PUT IT IN THE BUFFER
ENDAL3: CALL INFTST ;SEE IF WE HAVE A FILE
JRST ENDAL2 ;NO. GIVE THIS UP
TQNN <TCONF> ;CONFIRMATION ALREADY GIVEN?
TQNN <CFRMF>
JRST ENDAL2 ; Or no confirmation requested
ENDL33: BIN ; Else read confirmation character
IDIVI B,^D36/CCSIZE
LDB B,CPTAB(C) ; Get character class
CAIN B,CARRET ; IGNORE?
JRST ENDL33 ;YES. GO GET ANOTHER
CAIN B,CONTR
JRST [ CALL RETYPE ; DO LOGICAL TYPE OUT
JRST ENDL77] ; GO DO CONFIRM AGAIN
CAIE B,SPACE ;SPACE
CAIN B,ALTMOD ;OR ESC?
JRST [ CALL DING ;DON'T CONFIRM, BUT DON'T ABORT EITHER
JRST ENDAL3] ;TRY AGAIN
CAIE B,COMMA ;CONFIRMATION CHARACTER?
CAIN B,TERMS ;IN EITHER CLASS
JRST ENDAL2 ; Is ok
CAIE B,CONTU
CAIN B,EDTCHR ; CHARACTER EDITING BYTE?
JRST [ BKJFN ; BACK UP THE INPUT
JFCL ;
CALL CLRJFN ;CLEAR OUT THE INPUT
CALL SETTMP ;GET SOME WORK SPACE
JRST ERRDO
TXNN F1,DIRSF!NAMSF!EXTSF!VERSF
TQNN <PONFF> ;PRINT REQUESTED?
JRST MRTEXT ;NO. GO ON
;**;[3013] Replace 2 lines with 1 line @ENDAL-2/<tab>+10 JMP Sep 12,83
CALL RETYPE ;[3013] RE-TYPE THE EDITED LINE
JRST MRTEXT] ;AND GO GET SOME MORE INPUT
ERRLJF GJFX15 ; Improper confirmation
ENDAL2: TQNE <NEWVF,NEWF> ;NEW FILE OR NEW VERSION?
SKIPN FILFDB(JFN) ;SET ACCOUNTING, ETC. IF FDB WAS CREATED
JRST ENDALS ;NO, DON'T INSERT PROTECTION, ETC. INTO DIRECTORY
PUSH P,E ; SAVE E
HRRZ E,DEV
TQNE <PRTF> ; Do we have a protection?
CALL @PLUKD(E) ; Insert it into the directory
TQNN <ACTF> ; Do we have an account string?
JRST [ NOINT ;AVOID INTERRUPTS WHILE FILACT IS FUDGED
MOVEI B,ACCTSR-1 ;POINT TO ACCOUNT STRING
MOVN A,ACCTSL
HRLI B,2(A) ;LOOKUP POINTER TO ACCOUNT
CALL @ALUKD(E)
JRST [ POP P,E ;ERROR
JRST ERRDO]
SETZM FILACT(JFN)
OKINT
JRST ENDALT]
MOVE B,FILACT(JFN)
HRRZ A,0(B) ;BLOCK LENGTH
SUBI A,2
MOVNS A
HRL B,A ;LOOKUP POINTER TO ACCOUNT
CALL @ALUKD(E) ; Yes, insert it into the directory
JRST [ POP P,E ;ERROR, RESTORE E
JRST ERRDO]
ENDALT: MOVX B,FB%TMP
TQNE <TMPTF,TMPFF> ; Is this file to be temp?
CALL @SLUKD(E)
HRRZ A,NLUKD(E) ;SEE IF REAL DISK FILE
POP P,E ;RESTORE E
CAIN A,MDDNAM ;...
CALL FDBINU ;YES - INIT NAME STRINGS IN FDB
ENDALS: CALL STRUSR ;RETURN FILE NAME TO THE USER
NOINT
MOVEI A,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL RELLNS ;RELEASE LOGICAL NAME CHAIN
MOVEI A,JSBFRE
TQNE <ASTF> ; SCAN ONLY?
JRST ENDLS1 ; YES. DON'T RELEASE ACCOUNT AND PROT
; STRINGS
SKIPLE B,FILPRT(JFN)
CALL RELFRE ; And protection
SETZM FILPRT(JFN) ; AND PROTECTION WORD
ENDLS1: HRRZ B,FILTMP(JFN)
SKIPE B
CALL RELFRE ; And temp
HLRZ B,FILTMP(JFN)
SKIPE B
CALL RELFRE
HLRZ B,FILLNM(JFN) ;RDTXT BUFFER
SKIPE B ;ONE AROUND?
CALL RELFRE ;YES. ZAP IT.
HRRZS FILLNM(JFN) ;CLEAR OUT POINTER TO RDTXT BUFFER
SETZM FILTMP(JFN)
SETZM FILOPT(JFN)
SETZM FILCNT(JFN)
AND STS,[XWD 100,0] ; Retain astf
IOR STS,FILSTS(JFN) ; Get rest of sts
TQZ <ASGF,FILINP,FILOUP>; CLEAR ASSIGN AND I/O FLAGS
TQO <NAMEF> ; Set name attached flag
TQNE <NACCF>
TQO <FRKF>
MOVEM STS,FILSTS(JFN)
OKINT
CALL INFTST
JRST ENDL55 ;NO INPUT FILE
POP P,B ;GET ORIGINAL JFN MODE WORD
SFMOD ;SET IT BACK
POP P,C
POP P,B
SFCOC
ENDL55: MOVE A,JFN ; GET JFN
IDIVI A,MLJFN ; CONVERT BACK TO USER INDEX
MOVE JFN,A ; PUT IT BACK IN JFN
TXNN F,ASTAF+OSTRF+RLHFF ;RETURN LH FLAGS?
JRST ENDA51 ;NO
TQNE <PRTTF> ;IF ;P SPECIFIED,
TQO <FXPRT> ;SAY SO
TQNE <ACTTF>
TQO <FXACT>
TQNE <TMPTF,TMPFF>
TQO <FXTMP>
HLL JFN,F1 ;GET FLAGS TO RETURN
TXZ JFN,STEPF+STARF+DFSTF+TCONF+EXTXF+IGIVF ;CLEAR FLAGS NOT RETURNED
TQNN <IGDLF>
TXO JFN,GJ%GND
TQNN <IGIVF>
TXO JFN,GJ%GIV ; Not seeing invisible files
ENDA51: UMOVEM JFN,1 ; Return jfn to user
TQNN <ASTF> ; REAL JFN?
TXNN JFN,STRSF!NAMSF!EXTSF!DIRSF!VERSF ;DOING ANY STARS?
SMRETN ; NO. RETURN NOW
HRRZS JFN ; GET ONLY JFN PART
CALL CHKJFN ; LOCK UP THE JFN
RETERR () ; SOMETHING BAD HAPPENED
SMRETN ; TTY AND STRING ALWAYS OK
SMRETN ; ""
HRRZ A,NLUKD(NUM) ;MAKE SURE THIS FILE HAS A REAL FDB
CAIE A,MDDNAM ;DOES IT?
JRST ENDL58 ;NO. RETURN NOW
CALL GETFDB ; FIND FDB FOR THE FILE
JRST ENDL56 ; NOT THERE. STEP IT THEN
PUSH P,A ; SAVE THE FDB ADDRESS
MOVX B,FC%DIR ; CHECK FOR LIST ACCESS
CALL ACCCHK ; DO IT
JRST ENDL57 ; NOT ACCESSIBLE. GO STEP IT
MOVE A,0(P) ; GET BACK THE FDB ADDRESS
CALL COMACT ; COMPARE THE ACCOUNT STRING
JRST ENDL57 ; DID NOT MATCH, GO STEP TO NEXT FILE
POP P,A ; CLEAN UP STACK
CALL USTDIR ; FREE UP DIR
ENDL58: CALL UNLCKF ; AND THE FILE
SMRETN ; RETURN GOOD
ENDL57: POP P,A ; CLEAN UP THE STACK
CALL USTDIR ; FREE UP DIR
ENDL56: CALL UNLCKF ; AND THE FILE
UMOVE A,A ; GET BACK JFN AND FLAGS
GNJFN ; STEP TO FIRST GOOD ONE
RETERR (GJFX32) ; NO MATCH
SMRETN ; FOUND IT
;HERE IF HAVE NO DEFAULT EXTENSION
ENDAL6: TQNE <NREC> ; NOT DOING RECOGNITION?
TQNN <EXTFF> ; AND SPECIFIED NULL EXTENSION?
SKIPA ; NO
JRST ENDL6A ; YES. LET HIM GET NULL EXTENSION THEN
MOVEI B,"."
TQNN <NNAMF>
TQNE <NREC>
JRST ENDL6B
TQON <EXTFF> ;EXTENSION STARTED YET?
CALL OUTCH ;NO, TYPE OUT A DOT
ENDL6B: CALL DEFEXT ;FIRST SEE IF DEFAULT EXISTS
SKIPA ;NO
JRST ENDAL4 ;YES. USE IT
JUMPN A,ERRDO ;IF BAD NEWS, BOMB OUT
CALL GETDEX ;GO SEE IF THERE IS A DEFAULT EXTENSION
JRST ENDL6C ;NONE SPECIFIED
MOVEI A,GJFX19 ;SET UP ERROR CODE
CALL STEPLN ;STEP TO NEXT LN
JUMPGE A,ERRDO ;FAILURE OR NO MORE LOGICAL NAMES
CALL STOALT ;GO PUT ALTMODE BACK IN BUFFER
JRST ERRDO ;ERROR OCCURED
JRST GTJFST ;GO START OVER AGAIN
ENDL6A: CALL RECEXX ;SEE IF AN EXT CAN BE RECOGNIZED
JRST [ JUMPL A,GTJFST ;LOGICAL NAME WAS STEPPED
JUMPG A,ERRDO ;AN ERROR WAS ENCOUNTERED
MOVEI A,GJFX19 ;SET UP ERROR CODE
CALL STEPLN ;STEP THE LOGICAL NAME IF ANY
JUMPL A,GTJFST ;LOGICAL NAME WAS STEPPED
JRST ERRDO] ;LOGICAL NAME NOT STEPPED, BOMB OUT
JRST [ CALL DING
JRST GTJF2]
JRST ENDAL4
ENDL6C: JUMPN A,ERRDO ;IF ERROR, GO BOMB OUT
TXNN F1,DIRSF!NAMSF ;THIS FOLLOWING A STAR?
JRST ENDL6A ;OTHERWISE GO RECOGNIZE
TQNE <NREC> ;DOING RECOGNITION?
ERRLJF (GJFX19) ;NO. GO COMPLAIN ABOUT THIS CASE THEN
CALL DING ;YES. REFUSE TO DO ANY MORE
JRST GTJF2 ;AND PROCEED IN-LINE
; Star typed
STAR: CALL DPST ; SAVE BYTE
RETBAD() ; CANT DO IT
TQNN <ASTF> ;* ALREADY SEEN?
TQNE <ASTAF>
SKIPA A,FILCNT(JFN) ;ALLOW IT
RETBAD (GJFX31) ; Illegal *
MOVE B,CNTWRD(TXT) ;GET MAX VALUE
CAIN A,-1(B) ; HAVE SOMETHING ALREADY?
TQNE <STARF> ; ALREADY SEENA STAR?
JRST [ MOVX A,WLDF ; YES. IT IS WILD THEN
IORM A,FLAGS(TXT) ;REMEMBER THIS
TQNE <NUMFF> ;COLLECTING A NUMBER?
RETBAD (GJFX4) ;YES. GIVE AN ERROR THEN
JRST .+1] ;PROCEED
STAR2: TQNE <OSTRF>
TQO <ASTF> ; Set * bit in sts
TQO <STARF>
RETSKP
QUEST: TQNE <NUMFF> ; FOR WILD CHARS. ON A NUMBER?
RETBAD (GJFX4) ; YES. ILLEGAL CHARACTER THEN
CALL DPST ; SAVE BYTE
RETBAD() ; NO ROOM
TQNN <ASTF> ;* ALREADY SEEN?
TQNE <ASTAF> ; STARS ALLOWED?
SKIPA ;ALLOW IT
RETBAD (GJFX31) ; NO. GIVE BAD RETURN
MOVX A,WLDF ; FOR FLAGS
IORM A,FLAGS(TXT) ;REMEMBER WILD CHAR SEEN
CALLRET STAR2 ; GO DO THE * STUFF
; Set up temp string block for this jfn
; Call: JFN IN JFN
; JSYS SETTMP
; Sets up filopt(jfn) and rh(filtmp(jfn)) and filcnt(jfn)
; Clobbers a,b,c
; Clears num
SETTMP: HRRZ A,FILTMP(JFN) ; Is block assigned?
JUMPN A,SETTM1 ; Yes, use it
MOVEI B,MAXLW+1
NOINT
CALL ASGJFR ; Assign a free storage area in psb
RETBAD (GJFX22,<OKINT>) ; No room
HRRM A,FILTMP(JFN) ; Save in tmpptr
OKINT
SETTM1: HRLI A,(<POINT 7,0,35>)
MOVEM A,FILOPT(JFN) ; Set filopt(jfn)
MOVEI A,MAXLC
CALL TSTLNG ;ALLOWING LONG NAMES
SKIPA ;NO
JRST SETTM2 ;YES
MOVEI A,MAXSHT ;GET MAX SIZE FOR A NAME THEN
TQNE <EXTFF> ;ABOUT TO COLLECT AN EXTENSION?
MOVEI A,MAXEXT ;YES. USE MAX SIZE OF AN EXTENSION THEN
SETTM2: MOVEM A,FILCNT(JFN)
MOVEM A,CNTWRD(TXT) ;REMEMBER THIS
MOVEI NUM,0 ; Clear number
TQZ <NEGF>
RETSKP
;ROUTINE TO PUT AN ALTMODE BACK INTO THE INPUT BUFFER
;RETURNS +1 IF ERROR
;RETURNS+2 WITH ALTMODE IN BUFFER IF RECOGNITION WAS BEING DONE
STOUAL: SKIPA A,[SAWALT!SAWF] ;LOOK FOR EITHER IF ENTERED HERE
STOALT: MOVX A,SAWALT ;SEE IF SAW AN ALTMODE
TDNN A,FLAGS(TXT) ;DID WE?
RETSKP ;NO, RETURN IMMEDIATELY
ANDCAM A,FLAGS(TXT) ;YES. TURN IT OFF NOW
LDB A,CURPNT(TXT) ;GET LAST CHAR IN BUFFER
CAIN A,.CHESC ;IS IT AN ALTMODE?
RETSKP ;YES, ALL THROUGH
MOVEI A,.CHESC ;NO, PUT AN ALTMODE IN
SOSG CURCNT(TXT) ;IF THERE IS ROOM
RETBAD (GJFX51) ;NO ROOM
IDPB A,CURPNT(TXT) ;PUT ALTMODE IN BUFFER
MOVEI B,0 ;END WITH NULL
MOVE C,CURPNT(TXT)
IDPB B,C ;DONT UPDATE BYTE POINTER
RETSKP ;AND EXIT
; Get character from string OR file
; Call: CALL GCH
; Return
; +1 ; No more input
; +2 ; Ok, in a, the character
; Clobbers b
GCH: SKIPG LDCNT(TXT) ; IF ANY CHARS IN BUFFER, GET THEM FIRST
TQNN <STRF> ; Does string exist?
JRST GCH1 ; No, get from file
XCTBUU [ILDB A,2] ; Get character increment byte ptr
JUMPE A,GCH2 ;AT THE END OF THE STRING?
SOSG CURCNT(TXT) ;YES. WILL THIS ONE FIT?
RETBAD (GJFX51) ;NO. TELL HIM
ANDI A,177 ;USE ONLY 7-BIT ASCII
IDPB A,CURPNT(TXT) ;YES. STASH IT AWAY
MOVEI B,0 ;PUT A NULL AT END
MOVE C,CURPNT(TXT) ;WITHOUT UPDATING THE POINTER
IDPB B,C
RETSKP ;AND FINISH UP
GCH2: TQZ <STRF> ; No more string input
GCH1: SOSGE LDCNT(TXT) ;MORE IN BUFFER?
JRST RFALSE ;NO. GO BACK
ILDB A,LDPNT(TXT) ;YES. GET THE NEXT BYTE
RETSKP ;AND RETURN THE BYTE
; Assign a jfn
; Call: CALL ASGJFN
; Return
; +1 ; Error none available
; +2 ; Ok, in jfn the jfn
; Clobbers jfn
ASGJFN: NOINT
LOCK JFNLCK
MOVN JFN,MAXJFN ; Get current max jfn
HRLZS JFN ; Form aobjn pointer
JRST ASGJF5 ;SKIP JFN 0
ASGJF0: SKIPN FILSTS(JFN)
JRST ASGJF3
ASGJF5: ADD JFN,[XWD 1,MLJFN]
JUMPL JFN,ASGJF0
ASGJF2: CAIL JFN,RJFN
JRST ASGJF4
SUB JFN,[XWD 1,0]
AOS MAXJFN
ASGJF3: HRRZ A,JFN
CAIE A,101*MLJFN
CAIN A,100*MLJFN
JRST ASGJF5 ; Primary io designator is skipped
AOS (P)
SETZM FILLNM(JFN)
ASGJF1: HRLI JFN,(ASGF)
HRRZ A,JFN ;GET ADDRESS ONLY
HLLZM JFN,FILSTS(A) ; Mark this jfn as assigned
HRRZS JFN
HRRZ A,FORKN ; Get fork number
HRLZM A,FILVER(JFN)
SETZM FILTMP(JFN)
SETZM FILDDN(JFN)
SETZM FILNEN(JFN)
SETZM FILACT(JFN)
HLLZS FILIDX(JFN)
SETZM FILMS1(JFN)
SETZM FILCOD(JFN) ;CLEAR UNIQUE CODE FIELD
SETZM FILOFN(JFN) ;CLEAR THIS WORD IN CASE DEVICE CARES
HRRZS FILMS2(JFN) ; CLEAR MASK WORDS
SETZM FILFDB(JFN) ; CLEAR FDB ADDRESS WORD
SETZRO FILDIR,(JFN) ; ZERO POINTER TO DIR STRING
SETZRO FILATL,(JFN)
SETOM FILLCK(JFN)
ASGJF4: UNLOCK JFNLCK
OKINT
RET
; Release jfn
; Call: IN JFN, JFN
; CALL RELJFN
; Clobbers a,b,c,d
RELJFN::CALL RELMT ;SEE IF NEED TO CLEAN UP MT DATA BASE
RELJFX: NOINT
LOCK JFNLCK
SKIPN A,FILSTS(JFN)
JRST RELJF4 ; Already released
TXNE A,ASGF ;WAS THIS JFN BEING ASSIGNED?
JRST RELJF0 ;YES, DONT CHECK SPOOLING
HRRZ A,FILIDX(JFN) ;SEE IF THIS IS A SPOOLED DEVICE
MOVE B,DEVCH1(A) ;GET CHARACTERISTICS OF ORIGINAL DEV
SKIPE SPIDTB+.SPQSR ;IS THERE A PID TO SEND TO?
TLNN B,(D1%SPL) ;YES, IS THIS A SPOOLED DEVICE?
JRST RELJF0 ;NO, DONT SEND ANY MESSAGES TO QUASAR
MOVE C,DEVCHR(A) ;SEE IF THIS IS AN INPUT DEVICE
HRRZ B,FILDEV(JFN) ;SEE IF THIS FILE WAS ACTUALLY OPENED
TLNN C,(DV%IN) ;IF AN INPUT DEVICE, DONT SEND MESSAGE
CAIE B,DSKDTB ;IF IT IS DSK, IT WAS OPENED
JRST RELJF0 ;NOT OPENED, DONT SEND MESSAGE
CALL GETFDB ;GET THE FDB MAPPED
JRST RELJF0 ;FOULED UP, DONT SEND MESSAGE
SE1CAL
MOVE T2,.FBBYV(T1) ;SET UP FOR MESSAGE
MOVE T3,.FBSIZ(T1) ;SPOOL MESSAGE HAS FBBYV AND FBSIZ
CALL USTDIR ;UNLOCK FROM GETFDB
MOVE T1,JFN ;SET UP FOR SENDING MESSGE
CALL SPLMES ;TELL QUASAR OF SPOOLED FILE
BUG(NOSPLM)
RELJF0: CALL RELJF3 ;RELEASE COMMON STUFF
TXNN B,TRNSF ;A TRANSITIONAL FILE?
TXNN B,ASGF ;WAS THIS BEING CREATED?
JRST RELJF4 ;NO. CANT BE A RDTXT BUFFER THEN
MOVEI A,FILLNM(JFN) ;GET ADDRESS OF LOGICAL NAME CHAIN
CALL RELLNS ;RELEASE LOGICAL NAME STRING
MOVEI A,JSBFRE ;SET UP TO RELEASE RDTXT BUFFER
HLRZ B,FILLNM(JFN)
SKIPE B ;A RDTXT BLOCK THERE?
CALL RELFRE ;YES. RELEASE IT
HRRZS FILLNM(JFN) ;CLEAR OUT RDTXT BUFFER POINTER
RELJF4: SETZM FILDEV(JFN) ;CLEAR THIS TO AVOID ANY CONFUSION
UNLOCK JFNLCK
OKINT
RET
;COMMON SUBROUTINE CALLED BY RELFJN AND CLRJFN TO CLEAN UP THE JFN
;BLOCK BEFORE RELEASING IT OR STARTING PARSE ALL OVER
RELJF3: MOVE A,FILSTS(JFN) ; GET STATUS BITS
TXNE A,NONXF ; IS THIS A NON-EXISTENT FDB
CALL DELJFB ; YES, GO DELETE FDB IF FILE IS NON-X
MOVEI A,JSBFRE ; COMMON RELEASE SUBROUTINE
HLRZ B,FILDDN(JFN)
SKIPE B
CALL RELFRE ; Release device string block
LOAD B,FILDIR,(JFN) ;SEE IF THERE IS A DIR NAME STRING
SKIPE B
CALL RELFRE ;YES, GO RELEASE IT
HLRZ B,FILNEN(JFN)
SKIPE B
CALL RELFRE ; Release name string block
HRRZ B,FILNEN(JFN)
SKIPE B
CALL RELFRE ; Release extension string block
LOAD B,FILDMS,(JFN) ; GET DIR WILD MASK
SKIPE B ; HAVE ONE?
CALL RELFRE ; YES. RELEASE IT
LOAD B,FILNMS,(JFN) ; NAME WILD MASK
SKIPE B ; HAVE ONE?
CALL RELFRE ; YES. RELEASE IT
LOAD B,FILEMS,(JFN) ; EXTENSION WILD MASK
SKIPE B ; HAVE ONE?
CALL RELFRE ; YES. RELEASE IT
SKIPLE B,FILACT(JFN) ;HAVE AN ACCOUNT STRING?
CALL RELFRE ; Release storage for account string
SETZ B, ; GET A ZERO
STOR B,FILDMS,(JFN) ; CLEAR DIR WILD MASK
STOR B,FILNMS,(JFN) ; CLEAR NAME WILD MASK
STOR B,FILEMS,(JFN) ; CLEAR EXTENSION WILD MASK
CALL RELATR ; GO RELEASE ATTRIBUTE LIST
MOVEI A,JSBFRE
MOVE B,FILSTS(JFN)
TXNN B,ASGF ; Was this jfn being assigned?
JRST [ SETZM FILLFW(JFN) ;NO. ZAP THIS WORD
TXNE B,ASTF ;SCAN ONLY?
JRST RELJF1 ;YES. CHECK FOR PROTECTION
JRST RELJF2] ;GO FINISH UP
HRRZ B,FILTMP(JFN)
SKIPE B
CALL RELFRE ; Release temp block
HLRZ B,FILTMP(JFN) ; RELEASE OTHER TEMP BLOCK
SKIPE B ; IF ANY
CALL RELFRE
SETZM FILTMP(JFN) ; CLEAR OUT POINTER TO WORD
RELJF1: SKIPLE B,FILPRT(JFN) ;HAVE A PROTECTION STRING?
CALL RELFRE ; Release space for protection block
RELJF2: SETZM FILDDN(JFN)
SETZM FILNEN(JFN)
SETZM FILPRT(JFN)
SETZM FILACT(JFN)
HLLZS FILIDX(JFN)
SETZM FILFDB(JFN) ;CLEAR FDB ADDRESS WORD
SETZRO FILDIR,(JFN) ;ZERO DIR NAME STRING AREA
MOVE B,FILSTS(JFN) ;SAVE THIS IN CASE IT IS NEEDED
SETZB STS,FILSTS(JFN)
SETOM FILLCK(JFN)
RET ;ALL DONE
RELATR: LOAD B,FILATL,(JFN) ;GET POINTER TO ATTRIBUTE LIST
JUMPE B,R ;IF EMPTY, THEN DONE
LOAD C,PRFXL,(B) ;GET POINTER TO NEXT ITEM ON LIST
STOR C,FILATL,(JFN) ;REMOVE FIRST ITEM FROM CHAIN
LOAD C,PRFXS,(B) ;GET SIZE OF BLOCK
MOVEM C,0(B) ;PUT SIZE IN FIRST WORD OF BLOCK
MOVEI A,JSBFRE
CALL RELFRE ;RELEASE THE BLOCK
JRST RELATR ;LOOP BACK TILL LIST IS EMPTY
;ROUTINE TO RELEASE LOGICAL NAME STRINGS
;ACCEPTS IN A/ ADDRESS OF CHAIN HEADER WORD
; CALL RELLNS
;RETURNS +1 ALWAYS
RELLNS::STKVAR <RELLNA>
HRRZM A,RELLNA ;SAVE POINTER TO CHAIN
RELLN1: CALL REL1LN ;GO RELEASE THE FIRST LOGICAL NAME BLOCK
RET ;ALL DONE
MOVE A,RELLNA ;LOOP BACK FOR ALL ELEMENTS
JRST RELLN1 ;LOOP BACK TILL ALL ARE RELEASED
;ROUTINE TO RELEASE THE FIRST LOGICAL NAME ON THE LIST
;ACCEPTS IN A/ ADDRESS OF CHAIN POINTER WORD
; CALL REL1LN
;RETURNS +1: NO MORE LOGICAL NAMES
; +2: OK
REL1LN::STKVAR <REL1LA>
HRRZM A,REL1LA ;SAVE ADDRESS OF CHAIN POINTER
HRRZ A,@REL1LA ;GET POINTER TO FIRST LN BLOCK
JUMPE A,R ;NO MORE
LOAD B,LNMPNT,(A) ;GET POINTER TO NAME STRING
MOVEI A,JSBFRE ;STORAGE CAME FROM JSB
CALL RELFRE ;RELEASE IT
HRRZ B,@REL1LA ;GET BACK POINTER TO BLOCK
LOAD C,LNMLNK,(B) ;GET POINTER TO NEXT BLOCK
HRRM C,@REL1LA ;UPDATE POINTER TO FIRST BLOCK
MOVEI C,LNHDRL ;GET LENGTH OF HEADER BLOCK
MOVEM C,0(B) ;FOR RELFRE
CALL RELFRE ;GIVE BACK SPACE FOR HEADER
RETSKP ;AND RETURN
; Terminate string
; Call: FILOPT(JFN) ; Addresses last byte of string
; RH(FILTMP(JFN)) ; Addresses beginning of string block
; CALL ENDSTR
; Returns with a null deposited on the end of the string and
; In a, a pointer to the string as required by the recognition routines
; Does not modify filopt(jfn), clobbers a,b
ENDSTR::MOVE A,FILOPT(JFN)
MOVEI B,0
IDPB B,A ; Append null to string
LDB B,[POINT 6,A,5] ; ZERO OUT THE REST OF THE WORD
SUBI B,^D35 ; GET NEGATIVE NUMBER OF BITS TO SAVE
MOVSI C,400000 ; BUILD A MASK OF BITS TO PRESERVE
ASH C,(B) ; BUILD MASK
HRRZ B,A ; GET ADDRESS OF LAST WORD
ANDM C,(B) ; ZERO THE LOW ORDER BITS IN THE WORD
SUB A,FILTMP(JFN)
MOVNI A,-1(A) ; Number of full words instring
HRL A,FILTMP(JFN)
MOVSS A ; Yields iowd # fuul words, first word
RET
; Trim temp storage block and return excess to free store pool
; Call: FILOPT(JFN) ; Addresses the last byte of the string
; RH(FILTMP(JFN)) ; Addresses the beginning of the string block
; CALL ENDTMP
; Returns in a, origin of the string block
; Deposits a null byte on the end of the string
; Returns excess storage in the block to free storage pool
; Clears rh(filtmp(jfn))
; Clobbers a,b,c,d
; Leaves psi off
ENDTMP: MOVEI B,0
IDPB B,FILOPT(JFN) ; Deposit a null on the end
HRRZ A,FILTMP(JFN) ; Origin of block
MOVE B,FILOPT(JFN)
CALL TRMBLK ; Trim excess from the block
NOINT
HRRZ A,FILTMP(JFN)
HLLZS FILTMP(JFN)
RET
; Trim excess from a block and return it to free storage
; Call: A ; Origin of the block
; RH(B) ; Last location in block used
; CALL TRMBLK
; Clobbers a,b,c,d
TRMBLK::MOVEI C,JSBFRE ;SET UP ARGUMENTS FOR TRIMER
CALLRET TRIMER ;DO THE TRIMMING
;ROUTINE TO TRIM THE UNUSED PART OF A BLOCK FROM A FREE STORAGE POOL
;ACCEPTS IN A/ ORIGIN OF BLOCK
; B/ LAST LOCATION USED
; C/ POOL TO WHICH THE REMAINDER IS TO BE RETURNED
; CALL TRIMER
;RETURNS +1 ALWAYS
TRIMER::MOVEI B,1(B) ; Loc of first unused word
HRRE D,(A) ; Original length of block
SUBI D,(B)
ADDI D,(A) ; Length of excess
JUMPLE D,CPOPJ ; No excess
NOINT
HRROM D,(B) ; Make residue into legit block
MOVNS D
ADDM D,(A) ; Shorten original block
MOVEI B,(B)
MOVE A,C ; GET ADDRESS OF POOL TO RELEASE INTO
CALL RELFRE ; Release the residue
OKINT
RET
; I-o routines for local use
; Call: B ; Pointer to string to be typed
; CALL TSTRB ; If b addresses a string block
; Or
; CALL TSTR ; If b address the first byte
; Outputs the string to the file specified in the call to gtjfn
; Clobbers a,b
TSTRQ: SETO A, ;REMEMBER TO DO QUOTEING
JRST TSTR0
TSTRB: HRLI B,(<POINT 7,0,34>) ;POINTER TO BEGINNING OF STRING
TSTR: MOVEI A,0 ;NO QUOTEING
TSTR0: STKVAR <TSTRA>
TLC B,-1 ;ASCIZ BYTE POINTER IN B?
TLCN B,-1 ;...
HRLI B,(POINT 7,0) ;YES, SET UP LEGAL BYTE POINTER
MOVEM A,TSTRA ;SAVE QUOTEING FLAG
MOVEM B,LDPNT(TXT) ;SAVE POINTER
SKIPG CURCNT(TXT) ;ANY ROOM LEFT?
JRST TSTR0C ;NO
TSTR0A: ILDB A,B ;GET NEXT CHAR
JUMPE A,TSTR0B ;NULL = DONE
SKIPE TSTRA ;DOING QUOTING?
CALL QUOCHK ;YES, SHOULD IT BE QUOTED?
JRST TSTR0D ;NO
MOVEI C,"V"-100 ;YES, PUT IN A ^V
IDPB C,CURPNT(TXT) ;QUOTE THIS CHARACTER
SOSG CURCNT(TXT) ;ENOUGH ROOM FOR ANOTHER CHARACTER
JRST TSTR0C ;NO
TSTR0D: IDPB A,CURPNT(TXT) ;STORE THE CHARACTER
SOSLE CURCNT(TXT) ;ANY MORE ROOM?
JRST TSTR0A ;YES, LOOP BACK FOR MORE
TSTR0B: MOVE B,CURPNT(TXT) ;AND END WITH A NULL
IDPB A,B
TSTR0C: MOVE B,LDPNT(TXT) ;RESTORE B
SETZM LDCNT(TXT) ;ZAP THE INPUT COUNT
TSTR1: HRRZ A,E
XCTU [HRRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
RET
MOVEI C,0
SOUT
RET
;ROUTINE TO CHECK IF A CHARACTER NEEDS QUOTING
;ACCEPTS IN A/ CHAR
;RETURNS +1: DO NOT QUOTE
; +2: QUOTE IT
QUOCHK: SAVET ;CLOBBERS NO ACS
MOVE B,A ;GET CHAR INTO B FOR CPTAB
IDIVI B,^D36/CCSIZE ;GET CLASS CODE
LDB B,CPTAB(C) ;GET CODE
CAIL B,ECHDTB-CHDTB ;LEGAL?
RET ;NO
MOVSI A,400000 ;NOW BUILD MASK
MOVNS B
LSH A,(B)
TXNE A,QUOMSK ;IS THIS A STANDARD CHARACTER?
RET ;YES, DO NOT QUOTE IT
RETSKP ;NO, QUOTE IT
QUOMSK==1B<UPPER>!1B<LOWER>!1B<DIGITC>!1B<UPPERT>!1B<UPPERP>!1B<UPPERA>!1B<LOWERT>!1B<LOWERP>!1B<LOWERA>!1B<MINUSC>
; Ding the bell
; Call: CALL DING
DING: HRRZ A,E
XCTU [HLRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
JRST RFALSE
MOVEI B,7 ; Fall into outch to type a bell
CALL OUTCH1 ;DONT INSERT IN USER'S STRING
JRST RFALSE
; Output character
; Call: B ; The character right justified
; CALL OUTCH
; Outputs the character on the file specified in the call to gtjfn
; Clobbers a-D
OUTCH: SKIPG CURCNT(TXT) ;ROOM LEFT IN USER'S STRING
JRST OUTCH1 ;NO, DONT PUT CHARACTERS IN STRING
IDPB B,CURPNT(TXT) ;PUT IT IN THE STRING
MOVE A,CURPNT(TXT) ;STORE A NULL AT END OF STRING
SETZ C,
SOSLE CURCNT(TXT) ;AND ADJUST THE COUNT
IDPB C,A ;ONLY STORE NULL IF ENOUGH ROOM
OUTCH1: HRRZ A,E
XCTU [HRRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
RET
BOUT
RET
INFTST: HRRZ A,E
XCTU [HLRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
RET
RETSKP
SFCCON: MOVE B,TTICB1
MOVE C,TTICB2 ;STANDARD SETTINGS
JRST SFCC
SFCC0: DMOVE B,[BYTE (2)1,1,1,1,1,1,0,2,1,2,2,1,2,2,1,1,1,1
BYTE (2)0,1,1,0,0,0,1,1,1,0,1,1,1,2]
SFCC: CALL INFTST
RET
SFCOC
RET
; Output number
; Call: B ; The number
; CALL DNOUT ; For decimal output
; Or
; CALL ONOUT ; For octal output
; Clobbers a,c
DNOUT: SKIPA C,[12]
ONOUT: MOVEI C,10
MOVE A,CURPNT(TXT) ;GET TAIL OF DATA
NOUT ;PUT NUMBER IN THE STRING
JFCL
MOVEM C,LDCNT(TXT) ;SAVE RADIX
MOVE C,CURPNT(TXT) ;GET START TO CALCULATE NUMBER TRANSFERRED
CMPAR: IBP C ;MOVE IT
SOS CURCNT(TXT) ;COUNT FIRST ONE
CAME C,A ;THERE YET?
JRST CMPAR ;NO. GO ON
NOUTA: MOVEM A,CURPNT(TXT) ;UPDATED TAIL POINTER
MOVE C,LDCNT(TXT) ;RESTORE RADIX
SETZM LDCNT(TXT) ;JUST TO BE SAFE
ANOUT: HRRZ A,E
XCTU [HRRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
RET
NOUT
RET
RET
; Process errors during gtjfn
; Call: A ; Error number
; JRST ERRDO
ERRDO: PUSH P,A ;SAVE ERROR CODE
JUMPE TXT,ERRDO2 ;IF TXT NOT SET UP, SKIP THESE STEPS
CALL STRUSR ;PUT DATA IN USER'S BUFFER
CALL RELJFX
ERRDO2: CALL INFTST
JRST ERRDO1 ;ALL DONE
MOVE D,0(P) ;ERROR CODE
MOVE P,MPP
ADD P,BHC+3 ;POINT TO SAVED WORDS
POP P,B ;RECOVER SAVED MODES
SFMOD
POP P,C
POP P,B
SFCOC
SKIPA A,D ;SET UP ERROR
ERRDO1: POP P,A ;ERROR CODE
RETERR () ;AND GO TO ERROR EXIT
;THESE ROUITNES ARE USED BY THE RDTXT FACILITIES IN GTJFN
BACKIT: MOVE A,CURPNT(TXT) ;TAIL POINTER
BKJFN ;MOVE OVER RECOGNITION CHARACYER
JFCL
MOVEM A,CURPNT(TXT) ;SAVE NEW POINTER
SOS LDCNT(TXT) ;ADJUST COUNT
AOS CURCNT(TXT) ;INCREASE COUNT
RET ;AND DONE
GTINPT: HRRZ A,E
XCTU [MOVE A,1(A)] ;GET JFN'S
RET ;AND DONE
;ROUTINE TO STEP A LOGICAL NAME TO NEXT SET OF DEFAULTS
STEPLN: TXNN F,GJ%NS ;USER WANT TO PREVENT SEARCHING?
TQNN <OLDNF> ;NO, MUST HAVE OLD-FILE-ONLY BIT ON
RET ;OTHERWISE CANNOT STEP LN
MOVE B,CURPNT(TXT) ;GET POINTER
ILDB C,B ;WAS POINTER BACKED UP
JUMPE C,STPLN1 ;IF NULL, POINTER WAS NOT BACKED UP
IBP CURPNT(TXT) ;STEP OVER CHARACTER
SOS CURCNT(TXT) ;BACK UP OVER TERMINATOR
STPLN1: PUSH P,A ;SAVE THE ERROR CODE
CALL LNSTEP ;STEP THE LOGICAL NAME
JRST PA1 ;NO MORE DEFINITION BLOCKS
CALL STOALT ;FIND LOST ALTMODE
JFCL
CALL CLRJFS ;CLEAR OUT JFN BLOCK (EXCEPT FILLNM)
HRROS 0(P) ;MAKE ERROR CODE NEGATIVE
AOS STPCNT(TXT) ;INCREMENT THE STEP COUNTER
CALL SETTMP ;GO GET A TEMPORARY STRING
MOVEM A,0(P) ;STORE THIS ERROR CODE INSTEAD
JRST PA1 ;AND RETURN
CLRJFS: NOINT ;ROUTINE TO CLR JFN ON LN STEP
LOCK JFNLCK
JRST CLRJF1 ;DONT CLEAR OUT LOGICAL NAME
CLRJFN: NOINT ;PREVENT INTERRUPTS
LOCK JFNLCK ;LOCK UP THE JFN'S
MOVEI A,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL RELLNS ;RELEASE LOGICAL NAME SPACE
CLRJF1: CALL RELJF3 ;CLEAR COMMON CELLS
CALL ASGJF1 ;REASSIGN THE JFN
HRRZ STS,E
XCTU [HLLZ F,0(STS)] ;GET BACK USER'S FLAGS
CAIN STS,1 ;SHORT FORM? (OR DOESN'T MATTER)
TQZ <JFNRD> ;YES, GJ%XTN IS NOT ALLOWED
SETZ STS, ;CLEAR PROCESSING FLAGS
AND F1,[STRF+IGIVF] ; Leave string flg & find invisible
CALL SETSTR ;SET STAR BITS IN STS
MOVX B,RIEFLG ;CLEAR THE APPROPRIATE FLAGS
ANDM B,FLAGS(TXT) ;ONLY THE TEMPORARY ONES
RET ;AND DONE
SETSTR: TQNE <OSTRF> ;OUTPUT STARS ALLOWED?
TQNE <ASTAF> ;YES. INPUT STARS TOO?
RET ;NO. DONT SET ANYTHING
TQO <ASTF> ;YES. ALLOW STARS
RET ;AND RETURN
STRUSR: TQNN <JFNRD> ;SPECIFYING A RETURN BUFFER?
RET ;NO. JUST GIVE UP THEN
CALL STOUAL ;PUT ESCAPE AT END IF APPROPRIATE
JFCL ;IT HAS TO WORK
HRRZ D,E
XCTU [HRRZ D,11(D)] ;GET NEW FLAG WORD
CAIGE D,1 ;ENOUGH WORDS IN NEW BLOCK?
RET ;NO. CANT COPY
HRRZ B,E
UMOVE B,12(B) ;YES. GET THE STRING
TLC B,-1
TLCN B,-1 ; A -1 IN THE LEFT HALF?
HRLI B,(<POINT 7,0>) ;YES. PUT IN GOOD LEFT HALF
MOVE C,STRCNT(TXT) ;GET INITIAL COUNT
SUB C,CURCNT(TXT) ;SUBTRACT CURRENT COUNT
JUMPE C,R ;IF NONE USED,NO COPY.
PUSH P,[0] ;ASSUME NO COUNT
CAIGE D,2 ;USED SOME. DID HE GIVE A COUNT?
JRST NOCNT ;NO. GO ON
HRRZ D,E
XCTU [SKIPG A,13(D)] ;YES. GET IT
JRST NOCNT ;BAD COUNT. DONT BELIEVE IT
SUB A,C ;CALCULATE BYTES LEFT IN HIS BUFFER
UMOVEM A,13(D) ;AND RETURN IT TO HIM
SKIPLE A ;ROOM FOR A NULL AT THE END?
AOS 0(P) ;YES. SAY SO
NOCNT: MOVE A,STRPNT(TXT) ;POINTER TO START OF TEXT
MOVBYT: ILDB D,A ;GET A BYTE
XCTBU [IDPB D,B] ;STORE IT IN HIS STRING
SOJG C,MOVBYT ;DO THEM ALL
HRRZ C,E
UMOVEM B,12(C) ;RETURN UPDATED POINTER
POP P,A ;THE FLAG
JUMPE A,R ;ROOM FOR A NULL?
SETZ D, ;YES
XCTBU [IDPB D,B] ;SO PUT IT IN
RET ;AND FINISHED
;ROUTINE TO SEE IF LONG NAMES ARE ALLOWED. PRESERVES ALL
;REGISTERS
TSTLNG: SAVET ;SAVE ALL TEMPS
TQNN <JFNRD> ;HAVE EXTENDED BLOCK
RETSKP ;NO. ALLOW LONG NAMES
HRRZ A,E
UMOVE A,11(A) ;YES. GET FLAGS
TXNN A,G1%NLN ;ALLOWED?
RETSKP ;YES
RET ;NO
; Get next jfn
; Call: LH(1) ; Flags dirsf...hverf
; RH(1) ; Jfn
; GNJFN
; Returns
; +1 ; Error, jfn not attached to name, no more names
; +2 ; Ok, the jfn refers to the next file in the directory
GNJMSK==STRSF+DIRSF+NAMSF+EXTSF+VERSF+RVERF+HVERF+LVERF+FXPRT+FXACT+FXTMP
; MASK OF BITS TO KEEP FROM USER'S AC1
.GNJFN::MCENT
STKVAR <OFILUC> ; OLD STR UNIQUE CODE
HRRZ JFN,1
CALL CHKJFN
RETERR()
JFCL
RETERR(DESX4)
TQNE <ASTF>
ERUNLK(DESX7) ; Output stars not allowed
TQNE <OPNF>
ERUNLK(OPNX1)
LOAD Q1,FILUC,(JFN) ;GET STRUCTURE UNIQUE CODE AT START
MOVEM Q1,OFILUC ; SAVE OLD STR UNIQUE CODE
XCTU [HLLZ F1,1]
AND F1,[GNJMSK] ;KEEP ONLY CERTAIN BITS FROM USER
TXO F1,GNJFF ;REMEMBER THIS IS A GNJFN
TXNE F1,NAMSF ;WANT TO STEP THE NAME?
JRST [ HLRZ A,FILNEN(JFN) ;YES. GET NAME STRING
CALL GNJFN3 ;GO MAKE SURE IS BIG ENOUGH
RETERR (GJFX22,<CALL UNLCKF>) ;NOT, AND NO MORE SPACE
HRLM A,FILNEN(JFN) ;NEW STRING POINTER
JRST .+1] ;AND DONE
TXNE F1,EXTSF ;WANT TO STEP THE EXTENSION?
JRST [ HRRZ A,FILNEN(JFN) ;YES. GET EXTENSION STRING
CALL GNJFN3 ;GO MAKE SURE IS BIG ENOUGH
RETERR (GJFX22,<CALL UNLCKF>) ;NOT BIG ENOUGH AND NO SPACE
HRRM A,FILNEN(JFN) ;NEW STRING
JRST .+1] ;DONE
TXO STS,ASGF!TRNSF ;MARK AS TRANSITIONAL
TXZ STS,NAMEF ;AND MAKE IT APPEAR UNASSIGNED
MOVEM STS,FILSTS(JFN) ;AND IN THE JFN AS WELL
CALL UNLCKF ;DO UNLOCK
GNJFN1: SETZM FILTMP(JFN)
SETZM FILPRT(JFN)
SETZM FILOPT(JFN)
TQO <STEPF>
TQO <IGIVF> ; Make sure we see invisible files
UMOVE A,1 ; GET USER FLAGS
MOVX F,IGDLF+OLDNF ;IGNORE DELETED + OLD FILES ONLY
HRRZ A,FILVER(JFN) ;GET CURRENT VERSION
TQNE <HVERF> ;NEW VERSION WANTED?
MOVNI A,1
TQNE <RVERF> ;MOST RECENT VERSION WANTED?
MOVNI A,0
TQNE <LVERF> ;LOWEST VERSION WANTED?
MOVNI A,2
TXNN F1,STRSF!DIRSF!NAMSF!EXTSF!VERSF
SKIPA A,[GNJFX1] ;WILL FAIL, GIVE PROPER RETURN
CALL VERLUK
RETERR(,<CAIL A,GJFX36 ;ONE OF THE FILE OR DIRECTORY ERRORS?
CAILE A,GJFX40 ;STILL?
MOVEI A,GNJFX1 ;NO. GIVE STANDARD MESSAGE
PUSH P,A ;SAVE ERROR CODE OVER RELJFN
CALL RELJFX ;RELEASE THE JFN
POP P,A>)
HRRM A,FILVER(JFN)
MOVEM B,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
HRRZ A,DEV
HRRZ A,NLUKD(A)
CAIE A,MDDNAM
JRST [ SETZ A,
JRST GNJFN2] ; Not fdb for non-mdd devices
CALL GETFDB
JRST GNJFN1
PUSH P,A
MOVX B,FC%DIR ;B/DIRECTORY-LIST ACCES
CALL ACCCHK
JRST [ CALL USTDIR
POP P,A
JRST GNJFN1]
MOVX B,DC%RD
CALL DIRCHK
JRST [ CALL USTDIR
POP P,A
JRST GNJFN1]
MOVE A,0(P) ;GET FDB ADDRESS BACK AGAIN
CALL COMACT ;SEE IF THE ACCOUNT STRING MATCHES
JRST [ CALL USTDIR ;IT DOESNT, STEP TO NEXT FILE
POP P,A
JRST GNJFN1]
POP P,A
MOVE A,.FBCTL(A)
CALL USTDIR
GNJFN2: UMOVE B,1
TLNN B,(1B12)
TXNN A,FB%DEL
JRST [ TLNN B,(1B13)
TXNE A,FB%DEL
JRST GNJFN1
JRST .+1]
TXNE B,GJ%GIV ; Ignore fact file invisible?
TXNN A,FB%INV ; No, is it invisible?
CAIA ; Taking or file visible
JRST GNJFN1 ; Invisible & not taking
NOINT ;PROTECT THINGS AGAIN
AOS FILLCK(JFN) ;GET THE LOCK
TXZ STS,ASGF!TRNSF ;MAKE IT A REAL JFN AGAIN
TXO STS,NAMEF ;SAY NAME IS NOW ASSIGNED
LOAD Q2,FILUC,(JFN) ;GET THE CURRENT STRUCTURE UNIQUE CODE
MOVE A,Q2 ;NOW LOCK THIS STRUCTURE
CALL CNVSTR ;...
JFCL ;IF DISMOUNTED, ERROR WILL BE SEEN LATER
HLRZ A,FILDDN(JFN) ;NOW UPDATE THE DEVICE NAME STRING
CAMN Q2,OFILUC ;DID IT GET CHANGED DURING THIS GNJFN?
JRST GNJFN4 ;NO (WILL NOT CHANGE FOR NON-STRUCTURE DEVICES)
CALL CNVSIX ;GO UPDATE THE DEV NAME STRING
RETERR(,<PUSH P,A ;FAILED TO GET SPACE, SAVE ERROR CODE
CALL RELJFX
CALL UNLCKF
POP P,A>)
HRLM A,FILDDN(JFN) ;SAVE NEW STRING POINTER TO DEVICE
GNJFN4: CALL UNLCKF ;RELEASE JFN AND STR LOCK
SETZ A,
CAME Q1,Q2 ;DID THE STR CHANGE DURING THIS CALL?
TXO T1,GN%STR ;YES, TELL THE USER OF THIS CHANGE
TQNE <DIRXF>
TXO T1,GN%DIR ;NOTE DIRECTORY CHANGED
TQNE <NAMXF>
TXO T1,GN%NAM ;NOTE NAME CHANGED
TQNE <EXTXF>
TXO T1,GN%EXT ;NOTE EXTENSION CHANGED
XCTU [HLLM A,1]
SMRETN
;ROUTINE TO MAKE SURE JSB STRING POINTED TO BY A IS BIG ENOUGH TO
;BE STEPPED. IF NOT, IT WILL ATTEMPT TO GET ANOTHER ONE OF THE
;PROPER SIZE AND COPY THE CURRENT INFO INTO IT.
;ACCEPTS:
; A/ JSB STRING ADDRESS
;RETURNS:
; +1/ FAILED. INPUT AREA NOT LARGE ENOUGH AND NO MORE JSB
; SPACE
; +2/ SUCCESS. A= NEW AREA
GNJFN3: STKVAR <SVPNTR,SVNEW> ;SOME WORK CELLS
JUMPE A,R ;IF NO BUFFER, ERROR
HRRZ B,0(A) ;GET CURRENT SIZE
CAIN B,MAXLW+1 ;LARG ENOUGH?
RETSKP ;YES. ALL DONE
MOVEI B,MAXLW+1 ;NO. MUST GET ONE OF PROPER SIZE
MOVEM A,SVPNTR ;SAVE INPUT
CALL ASGJFR ;GET SOME SPACE
RET ;NONE THERE.
MOVEM A,SVNEW ;SAVE NEW AREA
HRL A,SVPNTR ;GET OLD POINTER
AOBJN A,.+1 ;INCREMENT BOTH
MOVE B,SVPNTR ;OLD AREA
HRRZ C,0(B) ;LENGTH OF OLD AREA
ADDI C,-2(A) ;WHERE THE BLT SHOULD END
BLT A,0(C) ;MOVE NAME
MOVEI A,JSBFRE ;THE BLOCK HEADER
CALL RELFRE ;RELEASE IT
MOVE A,SVNEW ;THE NEW BLOCK
RETSKP ;DONE
TNXEND
END