Trailing-Edge
-
PDP-10 Archives
-
AP-4178E-RM
-
swskit-sources/gtjfn.mac
There are 52 other files named gtjfn.mac in the archive. Click here to see a list.
;<3A.MONITOR>GTJFN.MAC.3, 14-May-78 14:28:46, Edit by MCLEAN
;TCO 1844 SPR 11294
;ADD GJFX51
;<3A.MONITOR>GTJFN.MAC.2, 5-May-78 12:51:29, EDIT BY MILLER
;MAKE CALLS TO @ATRD CORRECT
;<3.SM10-RELEASE-3>GTJFN.MAC.1, 16-Jan-78 08:08:18, EDIT BY MILLER
;BE SURE BYTE LOADED IN GCH IS 7-BIT ASCII
;<3-MONITOR>GTJFN.MAC.414, 10-Nov-77 12:16:51, EDIT BY MILLER
;USE SAWF TO REMEBER THAT A CONTROL-F WAS TYPED
;<3-MONITOR>GTJFN.MAC.413, 10-Nov-77 10:00:49, EDIT BY MILLER
;REARRANGE STATE TABLES TO MAKE COMMA A SEPARATE STATE
;<3-MONITOR>GTJFN.MAC.412, 8-Nov-77 09:42:50, EDIT BY MILLER
;PUT ESCAPE INTO TYPESCRIPT BUFFER IF CNTRL-F IS TYPED
;<3-MONITOR>GTJFN.MAC.411, 7-Nov-77 13:02:18, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-MONITOR>GTJFN.MAC.410, 12-Oct-77 13:48:43, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>GTJFN.MAC.409, 15-Sep-77 17:26:50, EDIT BY HURLEY
;FIX CHKACT TO ONLY CHECK ACCOUNT STRINGS ON DISK JFNS
;<3-MONITOR>GTJFN.MAC.408, 14-Sep-77 14:55:39, EDIT BY HURLEY
;MAKE IT POSSIBLE TO SPECIFY "DCN:-TASK-FOO;BD1234" (NOTE: NO EXTENTION)
;<3-MONITOR>GTJFN.MAC.407, 6-Sep-77 15:39:50, EDIT BY HURLEY
;MAKE ERRDO NOT DIE IF CALLED BEFORE TXT IS SET UP
;<3-MONITOR>GTJFN.MAC.406, 15-Aug-77 17:57:38, EDIT BY HURLEY
;MAKE DEFAULT DEVICE FROM LONG GTJFN SKIPPED IF A LOGICAL NAME TYPED
;<3-MONITOR>GTJFN.MAC.405, 27-Jul-77 09:30:20, EDIT BY HURLEY
;ZERO THE REMAINING BITS IN THE LAST WORD OF A STRING
;<3-MONITOR>GTJFN.MAC.404, 21-Jul-77 11:08:58, EDIT BY OPERATOR
;FIXED GTJFN SO THAT FAILURES FROM INSACT WORK CORRECTLY
;<3-MONITOR>GTJFN.MAC.403, 13-Jul-77 19:33:06, EDIT BY HURLEY
;<3-MONITOR>GTJFN.MAC.402, 13-Jul-77 16:41:33, Edit by MACK
;TCO 1822 - CHANGE ARGUMENTS TO CALLS TO INSACT AROUND ENDAL2:
;<3-MONITOR>GTJFN.MAC.401, 5-Jul-77 16:45:05, EDIT BY HURLEY
;<3-MONITOR>GTJFN.MAC.400, 27-Jun-77 17:34:00, Edit by MCLEAN
;<3-MONITOR>GTJFN.MAC.399, 27-Jun-77 13:47:55, Edit by HESS
;REMOVE REFS TO ACCTPT
;<3-MONITOR>GTJFN.MAC.398, 23-Jun-77 10:28:43, EDIT BY HURLEY
;MAKE DEFAULTED ACCOUNT STRINGS GET TRIMMED PROPERLY
;<2-PERF>GTJFN.MAC.368, 27-May-77 18:06:28, EDIT BY HURLEY
;<2-PERF>GTJFN.MAC.367, 26-May-77 15:03:54, EDIT BY HURLEY
;ADDED CONNECTED DIRECTORY NAME STRING TO JSB
;<3-MONITOR>GTJFN.MAC.396, 9-Jun-77 11:29:01, EDIT BY MILLER
;ADD ATTRIBUTES FOR DECNET FILE SPECS
;<3-MONITOR>GTJFN.MAC.395, 27-May-77 14:56:47, EDIT BY MILLER
;CLEAR FILDEV IN RELJFN
;<3-MONITOR>GTJFN.MAC.394, 12-May-77 16:07:40, EDIT BY MILLER
;CLEAR FILINP AND FILOUP IN JFN SET UP
;<3-MONITOR>GTJFN.MAC.393, 6-May-77 12:16:13, EDIT BY HURLEY
;<3-MONITOR>GTJFN.MAC.392, 2-May-77 20:33:01, EDIT BY BOSACK
;<3-MONITOR>GTJFN.MAC.391, 2-May-77 18:12:22, EDIT BY HURLEY
;TCO 1791 - ADD G1%RIE FUNCTION
;<3-MONITOR>GTJFN.MAC.390, 2-May-77 10:25:53, EDIT BY HURLEY
;MORE OF TCO 1781
;<3-MONITOR>GTJFN.MAC.389, 19-Apr-77 18:21:24, EDIT BY HURLEY
;TCO 1782 - CHECK IF COLLECTING A DIRECTORY WHEN ";" IS TYPED
;<3-MONITOR>GTJFN.MAC.388, 14-Apr-77 15:07:28, EDIT BY HURLEY
;TCO 1781 - ADD ATTRIBUTES
;<3-MONITOR>GTJFN.MAC.387, 24-Feb-77 12:05:52, EDIT BY MILLER
;FIX LOWER CASE IN DEFAULT STRINGS
;<3-MONITOR>GTJFN.MAC.386, 3-Feb-77 21:06:29, Edit by MCLEAN
;<3-MONITOR>GTJFN.MAC.385, 24-Jan-77 15:20:19, EDIT BY HURLEY
;ALLOW "DOTS" IN DIRECTORY NAMES
;<3-MONITOR>GTJFN.MAC.384, 20-Jan-77 22:11:50, EDIT BY HURLEY
;<3-MONITOR>GTJFN.MAC.383, 20-Jan-77 16:55:57, EDIT BY HURLEY
;<3-MONITOR>GTJFN.MAC.382, 20-Jan-77 15:43:14, EDIT BY HURLEY
;TCO 1718 - ADD MATCHING OF ACCOUNT STRINGS TO GTJFN AND GNJFN
;<3-MONITOR>GTJFN.MAC.381, 20-Jan-77 13:15:33, Edit by MCLEAN
;<3-MONITOR>GTJFN.MAC.380, 19-Jan-77 19:59:58, Edit by MCLEAN
;<3-MONITOR>GTJFN.MAC.379, 19-Jan-77 17:53:13, Edit by MCLEAN
;<3-MONITOR>GTJFN.MAC.378, 19-Jan-77 02:16:15, Edit by MCLEAN
;<3-MONITOR>GTJFN.MAC.377, 19-Jan-77 01:48:42, Edit by MCLEAN
;<3-MONITOR>GTJFN.MAC.376, 18-Jan-77 14:30:56, Edit by LCAMPBELL
;TCO 1715 - Fix defaulting of names or extensions with special characters
;<3-MONITOR>GTJFN.MAC.375, 18-Jan-77 13:55:17, Edit by MCLEAN
;<3-MONITOR>GTJFN.MAC.374, 17-Jan-77 15:50:39, Edit by MCLEAN
;<3-MONITOR>GTJFN.MAC.373, 17-Jan-77 15:44:15, Edit by MCLEAN
;TCO 1669 EXTENDED ADDRESSING (A BIG ONE)
;<3-MONITOR>GTJFN.MAC.372, 4-Jan-77 15:22:27, EDIT BY HELLIWELL
;PUT OLD STR UNIQUE CODE IN STKVAR IN .GNJFN
;<3-MONITOR>GTJFN.MAC.371, 27-Dec-76 17:32:53, EDIT BY HURLEY
;<3-MONITOR>GTJFN.MAC.370, 8-Dec-76 17:58:47, EDIT BY HURLEY
;<3-MONITOR>GTJFN.MAC.369, 8-Dec-76 16:25:16, Edit by HURLEY
;<3-MONITOR>GTJFN.MAC.368, 8-Dec-76 16:02:50, Edit by HURLEY
;<3-MONITOR>GTJFN.MAC.367, 8-Dec-76 15:58:14, Edit by HURLEY
;<3-MONITOR>GTJFN.MAC.366, 26-Nov-76 02:59:34, Edit by MCLEAN
;<2-MONITOR>GTJFN.MAC.364, 24-Nov-76 15:09:55, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.363, 17-Nov-76 16:14:45, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.362, 15-Nov-76 09:59:27, EDIT BY HELLIWELL
;FIX BUG IN TSTRB
;<2-MONITOR>GTJFN.MAC.361, 12-Nov-76 09:59:53, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.360, 11-Nov-76 18:46:55, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.359, 11-Nov-76 18:34:03, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.359, 11-Nov-76 17:56:23, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.358, 3-Nov-76 18:29:37, EDIT BY HALL
;<2-MONITOR>GTJFN.MAC.357, 3-Nov-76 14:04:38, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.356, 2-Nov-76 12:25:20, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.355, 31-Oct-76 15:51:12, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.354, 31-Oct-76 15:30:56, EDIT BY HURLEY
;FIX RECOGNITION TO WORK AFTER * ON FIELDS BEYOND EXTENTION
;<2-MONITOR>GTJFN.MAC.353, 25-Oct-76 13:43:09, EDIT BY HURLEY
;FIX HANDLING OF GJ%TMP
;<2-MONITOR>GTJFN.MAC.352, 22-Oct-76 16:09:40, EDIT BY HURLEY
;FIXED CHKDSK TO NOT CRASH WHEN STRUCTURE IS DISMOUNTED
;<2-MONITOR>GTJFN.MAC.351, 20-Oct-76 18:18:58, EDIT BY HURLEY
;DING ON AMBIGOUS DIRECTORY NAMES
;<2-MONITOR>GTJFN.MAC.350, 12-Oct-76 16:02:41, EDIT BY HURLEY
;ADD OKINT'S AFTER EACH CALL TO ENDTMP
;<2-MONITOR>GTJFN.MAC.349, 5-Oct-76 11:59:50, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.348, 4-Oct-76 15:09:19, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.347, 4-Oct-76 15:07:56, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.346, 4-Oct-76 15:05:18, EDIT BY HURLEY
;REMOVED CHECKING FOR NULL NAME. DIRECT DOES THAT ALREADY
;<2-MONITOR>GTJFN.MAC.345, 1-Oct-76 12:09:31, Edit by HESS
;<2-MONITOR>GTJFN.MAC.344, 30-Sep-76 16:03:44, Edit by HESS
;<2-MONITOR>GTJFN.MAC.343, 29-Sep-76 17:08:17, Edit by HESS
;CHANGE HANDLING OF STRUCTURE NUMBERS , REMOVE JSSTR REFS
;<2-MONITOR>GTJFN.MAC.342, 27-Sep-76 10:47:59, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.341, 24-Sep-76 17:04:29, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.340, 24-Sep-76 16:22:17, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.339, 22-Sep-76 16:31:56, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.338, 22-Sep-76 11:41:07, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.337, 20-Sep-76 18:48:18, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.336, 20-Sep-76 14:09:48, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.335, 20-Sep-76 12:22:14, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.334, 20-Sep-76 11:56:22, EDIT BY HURLEY
;MAKE THE DEFAULTING OF DIR'S WITH DIFFERENT DIR NUMBERS ON STR'S WORK
;<2-MONITOR>GTJFN.MAC.333, 15-Sep-76 18:40:12, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.332, 15-Sep-76 15:59:47, EDIT BY HURLEY
;TCO # 1528 - FIX THE "5 LOGICAL NAME" BUG
;<2-MONITOR>GTJFN.MAC.331, 14-Sep-76 17:53:37, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.330, 9-Sep-76 13:26:29, EDIT BY HURLEY
;TCO 1520 - DONT LOOK AT JOB LOGICAL NAMES ONCE A SYSTEM LN IS SEEN
;TCO 1519 - MAKE GTJFN SKIP OVER UNKNOWN DEVICE NAMES IN LOGICAL NAMES
;TCO 1517 - MAKE GJ%PHY LOOK AT SYSTEM LOGICAL NAMES
;TCO 1516 - ALLOW ;T TO BE SPECIFIED OTHER THAN AT END OF FILESPEC
;TCO 1515 - MAKE CONTROL-F WORK AFTER STARS IF FIELD IS NULL
;<2-MONITOR>GTJFN.MAC.329, 9-Sep-76 12:14:15, EDIT BY HURLEY
;<HESS>GTJFN.MAC.1, 25-Aug-76 15:06:29, Edit by HESS
;TCO 1496 - ADD AUTHOR/LAST-WRITER STRING SUPPORT
;<2-MONITOR>GTJFN.MAC.327, 19-Aug-76 16:41:31, Edit by HESS
;<2-MONITOR>GTJFN.MAC.326, 16-Aug-76 11:57:57, Edit by HESS
;REMOVE OLD FDB DEFINITION REFERENCES (FDBXXX SYMBOLS)
;<2-MONITOR>GTJFN.MAC.325, 13-Aug-76 13:32:43, EDIT BY CROSSLAND
;TCO # 1493 FIX FOR DOUBLE REPEAT ON CONTROL-R
;<2-MONITOR>GTJFN.MAC.324, 13-Aug-76 12:44:58, EDIT BY HALL
;CHANGED CALLS TO DIRCHK AND ACCCHK TO USE NEW BITS
;<2-MONITOR>GTJFN.MAC.323, 4-Aug-76 19:07:00, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.322, 4-Aug-76 15:02:46, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.321, 27-Jul-76 12:57:40, EDIT BY MILLER
;FIX NULL ATTRIBUTES
;<2-MONITOR>GTJFN.MAC.320, 24-Jul-76 15:00:22, EDIT BY HALL
;MISSED AN EDIT IN DEFDIR
;<2-MONITOR>GTJFN.MAC.319, 24-Jul-76 14:32:51, EDIT BY HALL
;IN DEFDIR CHANGED REFERENCE TO JOBDNO FOR CONNECTED DIRECTORY
;TO CALL TO GTCSCD
;<2-MONITOR>GTJFN.MAC.318, 22-Jul-76 16:07:40, EDIT BY MILLER
;FIX RECOGNITION AFTER * AT ENDLZ1
;<2-MONITOR>GTJFN.MAC.317, 19-Jul-76 09:44:47, EDIT BY MILLER
;<2-MONITOR>GTJFN.MAC.316, 19-Jul-76 09:23:34, EDIT BY MILLER
;<1MILLER>GTJFN.MAC.4, 8-Jul-76 19:53:04, EDIT BY MILLER
;PUT UNIQUE CODE IN JFN BLOCK
;<1MILLER>GTJFN.MAC.3, 8-Jul-76 19:41:09, EDIT BY MILLER
;FIX GNJFN TO RELEASE STR LOCK IF VERLUK FAILS
;<1MILLER>GTJFN.MAC.2, 6-Jul-76 14:22:46, EDIT BY MILLER
;<1MILLER>GTJFN.MAC.1, 6-Jul-76 11:44:59, EDIT BY MILLER
;CLEAR FILCOD IN ASGJFN
;<1B-MONITOR>GTJFN.MAC.311, 11-JUN-76 19:03:44, EDIT BY HURLEY
;REMOVED CODE FOR TCO 1372
;MORE TCO 1373
;<1B-MONITOR>GTJFN.MAC.310, 9-JUN-76 14:07:25, EDIT BY HURLEY
;TCO 1373 - MAKE GTJFN TYPE OUT .0 FOR THE VERSION WHEN APPROPRIATE
;TCO 1372 - MAKE GTJFN "DING" IF THE DEFAULTED EXTENSION IS NOT FOUND
;<2-MONITOR>GTJFN.MAC.7, 17-Jun-76 11:48:53, EDIT BY MILLER
;REMOVE SJFN. ADD MLJFN
;<1B-MONITOR>GTJFN.MAC.309, 25-MAY-76 11:22:55, EDIT BY MILLER
;TCO 1314. GDFTMP NEEDS TO CHECK LENGTH OF EXTANT STRING
;<1B-MONITOR>GTJFN.MAC.308, 17-MAY-76 16:17:55, EDIT BY MILLER
;TCO 1294. FIX ERRDO
;<2-MONITOR>GTJFN.MAC.5, 20-MAY-76 11:02:50, EDIT BY KIRSCHEN
;CHANGE RETURNS FROM DIRLUK, DOUBLE SKIP RETURN WAS DELETED
;<2-MONITOR>GTJFN.MAC.4, 19-MAY-76 09:53:14, EDIT BY KIRSCHEN
;ADD STRUCTURE NUMBER TO CALLS TO DIRLUK
;<2-MONITOR>GTJFN.MAC.3, 17-MAY-76 16:19:09, EDIT BY MILLER
;TCO 1294. FIX ERRDO
;<2-MONITOR>GTJFN.MAC.2, 14-MAY-76 14:29:39, EDIT BY HURLEY
;<2-MONITOR>GTJFN.MAC.1, 12-MAY-76 18:10:53, EDIT BY HURLEY
;TCO # 1289 - TURN DSK: INTO CONNECTED STRUCTURE NAME
;<1A-MONITOR>GTJFN.MAC.307, 1-APR-76 14:06:55, EDIT BY HURLEY
;TCO # 1232 - ALLOW WHEEL OR OPERATOR TO CREATE ALPHA-NUMERIC ACCTS.
;<1A-MONITOR>GTJFN.MAC.306, 30-MAR-76 20:41:46, EDIT BY OPERATOR
;TCO 1224. FIX DEFACT FOR STRING ACCOUNTSD
;<1A-MONITOR>GTJFN.MAC.305, 30-MAR-76 20:41:08, EDIT BY OPERATOR
;<1MONITOR>GTJFN.MAC.304, 26-MAR-76 11:04:46, EDIT BY MILLER
;<1MONITOR>GTJFN.MAC.303, 17-MAR-76 11:38:39, EDIT BY MILLER
;<1MONITOR>GTJFN.MAC.302, 17-MAR-76 11:19:35, EDIT BY MILLER
;TCO 1188. HONOR LIST ACCESS ON FIRST FILE IN GROUP
;<1MONITOR>GTJFN.MAC.301, 16-MAR-76 14:26:46, EDIT BY MILLER
;TCO 1180. FIX GNJFN WHEN NO NAME DEVICE IS STEPPED
;<1MONITOR>GTJFN.MAC.300, 14-MAR-76 11:19:08, EDIT BY MILLER
;TCO 1175. FIX RECDIR TO ALLOW RECOGNITION ON PARSE ONLY
;<1MONITOR>GTJFN.MAC.299, 10-MAR-76 15:56:38, EDIT BY MILLER
;TCO 1173. ALLOW NULL NAME IN PARSE ONLY
;<1MONITOR>GTJFN.MAC.298, 10-MAR-76 14:20:57, EDIT BY MILLER
;TCO 1172. CHECK FOR PARSE ONLY ON CONFIRMATION CODE
;<1MONITOR>GTJFN.MAC.297, 29-FEB-76 11:58:03, EDIT BY MILLER
;TCO 1092. FIX WILD CARD DIRS
;<2MONITOR>GTJFN.MAC.296, 12-FEB-76 19:25:17, EDIT BY MILLER
;MCO 1082. FIX BUFFER TRIMMER
;<2MONITOR>GTJFN.MAC.295, 10-FEB-76 11:22:15, EDIT BY MILLER
;MCO 1069. FIX RECOGNITION FOR DIRECTORY AFTER *
;<2MONITOR>GTJFN.MAC.294, 1-FEB-76 16:03:17, EDIT BY MILLER
;MCO 46. FIX REDFLT TO ALLOW 39 CHARACTERS
;<2MONITOR>GTJFN.MAC.293, 20-JAN-76 17:52:38, EDIT BY MILLER
;MCO #14 FIX NULL EXTENSION AFTER STARS
;<2MONITOR>GTJFN.MAC.292, 16-JAN-76 17:49:06, EDIT BY MURPHY
;<2MONITOR>GTJFN.MAC.291, 15-JAN-76 11:46:49, EDIT BY MILLER
;MCO # 4 FIX DEFAULT WILD DIRECTORY STRINGS
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 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
DEFINP==^D32*5 ;DEFAULT SIZE OF RDTXT BUFFER
MAXINP==<^D120-VARC>*5 ;MAX WORDS TO GET FOR TEXTI
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
SETZB F1,STS ; Clear f1 & sts
TQNE <NACCF>
TQO <FRKF>
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
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
XCTU [HRRZ B,11(D)] ;YES. GET ITS SIZE
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
UMOVE C,11(D) ;GET FLAG WORD
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
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
ERRLJF () ;BAD NEWS
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
JUMPL A,GTJFST ; IF A IS NEGATIVE, LOG NAM WAS STEPPED
JRST ERRDO ; OTHERWISE THIS IS A FATAL ERROR
; 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
;RETURNS +1: ILLEGAL USE OF STAR
; +2: OK, STRING NOW CONTAINS "PS"
STRDEV: MOVX B,WLDF ;CLEAR THE WILD FLAG
ANDCAM B,FLAGS(TXT)
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 [ MOVE B,A ; COPY RETURN STATUS FROM DIRLKX
MOVEI A,GJFX17 ; NO SUCH DIRECTORY, GO STEP LOGICAL NM
JUMPL B,R ; AMBIGUOUS
JRST STEPLN]
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 NO SUCH DIRECTORY AND IS 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
CAIN A,.PFACT ;ACCOUNT STRING?
JRST ENDEXA ;YES, GO STORE IT
CAIN A,.PFPRT ;PROTECTION FIELD?
JRST ENDEXP ;YES
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/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 ; NO
JRST DFDVL0 ; YES, LOOP BACK AND TRY FOR A DEVICE
MOVE A,DEFDVS ; GET BACK STRING POINTER
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 STRDEV ;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 ; NO
JRST DFDVL1 ; YES, LOOP BACK AND TRY FOR A DEVICE
MOVE A,DEFDVS ; GET STRING POINTER BACK AGAIN
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
MOVE B,1(A) ;GET FIRST WORD OF STRING
TRZ B,677 ;CLEAR OUT POSSIBLE GARBAGE BITS
CAME B,[ASCIZ/DSK/] ;IS THE NAME "DSK"?
CALL DFDVTY ;NO, THEN GO TYPE IT MAYBE
JFCL ;DFDVTY SKIPS SOMETIMES
MOVE A,DEFDVS ;GET BACK POINTER TO STRING
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
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
HLRZ B,DEV ;GET UNIT # (MAY BE STR #)
HRRZ D,DEV ;GET DISPATCH TABLE ADDRESS
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
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
; 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
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
; 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
; +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: 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 [ MOVE B,A ;COPY RETURN STATUS FROM DIRLKX
MOVEI A,GJFX17 ;NO SUCH DIRECTORY
TQNE <ASTF> ;SCAN ONLY?
JRST DEFDI3 ;YES. GO HANDLE IT
JUMPL B,R ;RETURN GJFX17 IF AMBIGUOUS RETURN FROM DIRLKX
JRST STEPLN] ;GO STEP LOGICAL NAME AND RETURN
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
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
;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: MOVE B,STODNL ;GET THE COUNT OF WORDS NEEDED
CALL ASGJFR ;GET A BLOCK FOR THE DIR NAME
RETBAD () ;COULD NOT GET ROOM
STOR A,FILDIR,(JFN) ;REMEMBER THIS STRING IN THE JFN BLOCK
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
JRST RFALSE
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 DFSTRV
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
IDIVI B,^D36/CCSIZE
LDB C,CPTAB(C)
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?
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
DELALL: TMSG </___
/>
NOINT
CALL RELJFN ; 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
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
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
JUMPL A,GTJFST ; RETRY THIS GTJFN, LN WAS STEPPED
JRST ERRDO] ; ERROR
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
JUMPL A,GTJFST ; LOGICAL NAME WAS STEPPED
JRST ERRDO] ; AN ERROR WAS ENCOUNTERED
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 ENDAL7
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
CAIN B,TERMS ;CONFIRMING CHAR?
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
MOVEI B,"_" ;YES. GET RID OF MESSAGE
CALL OUTCH1
JRST MRTEXT] ;AND GO GET SOME MORE INPUT
ERRLJF GJFX15 ; Improper confirmation
ENDAL2: TQNE <NEWVF,NEWF> ;NEW FILE OR NEW VERSION?
TQNE <ASTF>
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(