Trailing-Edge
-
PDP-10 Archives
-
tops20_version7_0_monitor_sources_clock
-
monitor-sources/gtjfn.mac
There are 52 other files named gtjfn.mac in the archive. Click here to see a list.
; UPD ID= 8524, RIP:<7.MONITOR>GTJFN.MAC.11, 9-Feb-88 15:52:44 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 8413, RIP:<7.MONITOR>GTJFN.MAC.10, 4-Feb-88 12:08:17 by GSCOTT
;TCO 7.1210 - Set NOSPLM normally not dumpable.
; UPD ID= 8332, RIP:<7.MONITOR>GTJFN.MAC.9, 31-Dec-87 08:39:23 by RASPUZZI
;More of TCO 7.1168 - Apparently, .CHWL1 is not defined in a useful place
; like MONSYM. Add it here so GTJFN will compile.
; UPD ID= 8331, RIP:<7.MONITOR>GTJFN.MAC.8, 29-Dec-87 11:14:44 by RASPUZZI
;TCO 7.1168 - Prevent ASTJFN BUGHLTs by making GTJFN understand that a
; file spec like "foo.boo;*" is illegal. It never worked and
; and it never will.
; UPD ID= 223, RIP:<7.MONITOR>GTJFN.MAC.7, 28-Oct-87 14:14:09 by MCCOLLUM
;TCO 7.1095 - Make SETDEV handle parse-only the way it always used to.
; UPD ID= 177, RIP:<7.MONITOR>GTJFN.MAC.6, 21-Oct-87 16:55:41 by MCCOLLUM
;TCO 7.1078 - Don't clear JSUC for parse-only JFNs in SETDEV
; UPD ID= 140, RIP:<7.MONITOR>GTJFN.MAC.5, 25-Sep-87 11:17:24 by GSCOTT
;TCO 7.1064 - That fine VANISH routine broke labeled tapes, it should only
; check to see if the "old" file exists if it is on disk. Clean up pagination.
; UPD ID= 127, RIP:<7.MONITOR>GTJFN.MAC.4, 23-Sep-87 15:44:16 by MCCOLLUM
;TCO 7.1063 - Make GTJFN% check for STRX10 in SETDEV
; UPD ID= 26, RIP:<7.MONITOR>GTJFN.MAC.3, 29-Jun-87 16:36:43 by RASPUZZI
;TCO 7.1014 - Implement partial file recognition.
; *** Edit 7420 to GTJFN.MAC by RASPUZZI on 6-Mar-87
; Prevent GTJFN% from ITRAPping by modifying edit 7300
; *** Edit 7415 to GTJFN.MAC by RASPUZZI on 10-Feb-87
; Teach routine GCH that "-" CRLF is a continuation of a line and not part of
; the file specification
; *** Edit 7408 to GTJFN.MAC by RASPUZZI on 31-Dec-86, for SPR #21410
; Prevent RELRNG BUGCHKs by cleaning up the RELJFN code and putting back SETZMs
; that edit 7371 moved.
; *** Edit 7401 to GTJFN.MAC by KKLEINER on 20-Nov-86
; At LCCH, don't upper-case characters if we are parsing a userid, password,
; account, or optional data file attribute.
; *** Edit 7393 to GTJFN.MAC by RASPUZZI on 18-Nov-86, for SPR #21272
; Finally, restore the use of VANISH and wit for more things to break.
; *** Edit 7386 to GTJFN.MAC by MCCOLLUM on 23-Oct-86
; At ENDALS, make sure FILPRT is > 0, but only supply RH to RELFRE
; *** Edit 7385 to GTJFN.MAC by MCCOLLUM on 22-Oct-86
; Use only left half of FILPRT when release free space in ENDALS
; *** Edit 7384 to GTJFN.MAC by MCCOLLUM on 15-Oct-86, for SPR #21288
; Add ASGF2 to FILST1. This bit should ALWAYS shadow the state of ASGF in
; FILSTS
; *** Edit 7383 to GTJFN.MAC by RASPUZZI on 15-Oct-86
; Remove call to VANISH. It still doesn't want to work with DUMPER
; *** Edit 7381 to GTJFN.MAC by RASPUZZI on 14-Oct-86
; Prevent PSINSKs and NOSKTRs by not letting VANISH leave us CSKED
; *** Edit 7380 to GTJFN.MAC by RASPUZZI on 10-Oct-86, for SPR #21272
; Save trashed AC before calling VERLUK
; *** Edit 7379 to GTJFN.MAC by RASPUZZI on 9-Oct-86, for SPR #21272
; Prevent CSKBUG BUGHLTs by not jumping to GNFAIL from IFNSK.
; *** Edit 7377 to GTJFN.MAC by RASPUZZI on 7-Oct-86, for SPR #21272
; Reinstall edit 7371 with nice things so it works.
; *** Edit 7373 to GTJFN.MAC by RASPUZZI on 3-Oct-86
; Remove edit 7371 until it works 100%.
; *** Edit 7371 to GTJFN.MAC by RASPUZZI on 30-Sep-86, for SPR #21272
; Prevent ILMNRFs by checking to see if current file exists before actually
; doing a GNJFN%.
; *** Edit 7345 to GTJFN.MAC by MCCOLLUM on 30-Jul-86, for SPR #21341
; Call ASGJFN in USRJFN if the user-supplied JFN is used and .GJALT specified
; *** Edit 7300 to GTJFN.MAC by RASPUZZI on 23-May-86, for SPR #21241
; Stop MONNEJ BUGCHKs by putting in missing ERJMPs
; *** Edit 7298 to GTJFN.MAC by RASPUZZI on 22-May-86
; Add code to make the .GJNOD function work when an extended block is passed
; *** Edit 7206 to GTJFN.MAC by WAGNER on 4-Dec-85, for SPR #20941
; Fix RELRNG bughlts caused by trying to release non-existant temp storage.
; There is no temp storage when a JFN is transitional.
; *** Edit 7194 to GTJFN.MAC by LOMARTIRE on 15-Nov-85 (TCO none)
; Remove edit 7135 because of bad side effects
; Edit 7135 to GTJFN.MAC by LOMARTIRE on 15-Aug-85, for SPR #15670 (TCO 6-1-1520)
; Allow JFNS% to return connected directory on parse-only JFNs
; UPD ID= 2263, SNARK:<6.1.MONITOR>GTJFN.MAC.59, 21-Jun-85 12:20:23 by LOMARTIRE
;More TCO 6.1.1292 - Remove code added at GNJFN1 until better solution found
; UPD ID= 2235, SNARK:<6.1.MONITOR>GTJFN.MAC.58, 18-Jun-85 16:35:03 by MOSER
;TCO 6.1.1459 - RETURN CORRECT ERRORS - LOGICAL NAME LOOP ETC FROM SETDEV
; UPD ID= 2214, SNARK:<6.1.MONITOR>GTJFN.MAC.57, 11-Jun-85 15:31:44 by MCCOLLUM
;TCO 6.1.1442 - Only save FILOPT in STRDVD if we came in through STRDEV
; UPD ID= 2207, SNARK:<6.1.MONITOR>GTJFN.MAC.56, 7-Jun-85 08:47:37 by LOMARTIRE
;TCO 6.1.1394 - Make extension recognition work again as in 5.1
; UPD ID= 2204, SNARK:<6.1.MONITOR>GTJFN.MAC.55, 5-Jun-85 21:07:23 by PALMIERI
;TCO 6.1.1433 Allow wildcards in filespec when doing parse only network JFNs
; UPD ID= 2081, SNARK:<6.1.MONITOR>GTJFN.MAC.54, 3-Jun-85 14:40:45 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 1881, SNARK:<6.1.MONITOR>GTJFN.MAC.53, 4-May-85 12:55:45 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1784, SNARK:<6.1.MONITOR>APRSRV.MAC.196, 23-Apr-85 12:40:03 by MCCOLLUM
; UPD ID= 1699, SNARK:<6.1.MONITOR>GTJFN.MAC.52, 29-Mar-85 15:28:28 by MCCOLLUM
;TCO 6.1.1296 - Save FILOPT in RECNA0 before calling DEFDEV
; UPD ID= 1694, SNARK:<6.1.MONITOR>GTJFN.MAC.51, 28-Mar-85 12:42:30 by LOMARTIRE
;TCO 6.1.1292 - Make GNJFN handle deleted files better
; UPD ID= 1659, SNARK:<6.1.MONITOR>GTJFN.MAC.50, 20-Mar-85 14:52:12 by LOMARTIRE
;TCO 6.1.1279 - Prevent ILLUUO from bad byte pointer passed in to GTJFN
; UPD ID= 1654, SNARK:<6.1.MONITOR>GTJFN.MAC.49, 18-Mar-85 16:59:05 by PALMIERI
;TCO 6.1.1276 Allow wildcard for nodename for parse only JFN's
; UPD ID= 1622, SNARK:<6.1.MONITOR>GTJFN.MAC.48, 12-Mar-85 15:54:36 by LOMARTIRE
;More TCO 6.1.1222 - Make sure length of string is always counted correctly
; UPD ID= 1580, SNARK:<6.1.MONITOR>GTJFN.MAC.47, 4-Mar-85 07:42:40 by LOMARTIRE
;TCO 6.1.1222 - Make G1%NLN work correctly when recognition used
; UPD ID= 1431, SNARK:<6.1.MONITOR>GTJFN.MAC.46, 31-Jan-85 10:56:25 by LOMARTIRE
;TCO 6.1.1143 - Make system wide logicals search job then system wide tables
; UPD ID= 1402, SNARK:<6.1.MONITOR>GTJFN.MAC.45, 24-Jan-85 16:45:04 by LOMARTIRE
;TCO 6.1.1121 - Prevent ILMNRF in RECDIR with parse-only JFN no-match
;UPD ID= 1257, SNARK:<6.1.MONITOR>GTJFN.MAC.44, 2-Jan-85 11:09:20 by PAETZOLD
;More TCO 6.1.1101 - Change the way the FILOPT calculation is done.
; UPD ID= 1255, SNARK:<6.1.MONITOR>GTJFN.MAC.43, 1-Jan-85 18:39:43 by PAETZOLD
;More TCO 6.1.1101 - Put back GNJFN3 call in STRDEV.
; UPD ID= 1252, SNARK:<6.1.MONITOR>GTJFN.MAC.42, 1-Jan-85 15:24:29 by PAETZOLD
;TCO 6.1.1101 - Make STRDEV prevent device name block overtrimming.
; UPD ID= 5019, SNARK:<6.MONITOR>GTJFN.MAC.41, 26-Oct-84 13:51:40 by LOMARTIRE
;TCO 6.2261 - Return GJFX24 not STRX09 when device expansion fails for log name
; UPD ID= 4809, SNARK:<6.MONITOR>GTJFN.MAC.40, 17-Sep-84 10:01:12 by PURRETTA
;Update copyright notice
; UPD ID= 4801, SNARK:<6.MONITOR>GTJFN.MAC.39, 13-Sep-84 12:01:04 by PAETZOLD
;More TCO 6.2190 - Make DSK*: when it is the default device.
; UPD ID= 4737, SNARK:<6.MONITOR>GTJFN.MAC.38, 24-Aug-84 09:39:46 by PAETZOLD
;TCO 6.2190 - Fix DSK*: to work when PS is not named PS:.
; UPD ID= 4142, SNARK:<6.MONITOR>GTJFN.MAC.36, 25-Apr-84 16:06:34 by CJOHNSON
; Temporarily remove edit for TCO 6.1976 - it was crashing
; UPD ID= 3799, SNARK:<6.MONITOR>GTJFN.MAC.34, 29-Feb-84 01:42:58 by TGRADY
; Implement Global Job numbers
; - In DEFVER, user Global job number in GBLJNO to create Temp file version #
;
; UPD ID= 3784, SNARK:<6.MONITOR>GTJFN.MAC.33, 28-Feb-84 13:31:36 by CJOHNSON
;TCO 6.1976 - Make STRDEV determine the name of the p.s., rather than assume PS
; UPD ID= 3485, SNARK:<6.MONITOR>GTJFN.MAC.32, 20-Jan-84 07:44:26 by MCINTEE
;Still more TCO 6.1030 - allow node names for parse-only filespecs
; UPD ID= 3258, SNARK:<6.MONITOR>GTJFN.MAC.31, 6-Dec-83 09:51:58 by MOSER
;TCO 6.1833 - PREVENT CRASH WHEN PARSE ONLY AND ATTRIBUTES
; UPD ID= 2989, SNARK:<6.MONITOR>GTJFN.MAC.30, 5-Oct-83 14:48:23 by PAETZOLD
;TCO 6.1817 - Reset FILST1 as well as FILSTS in ASGJFN
; UPD ID= 2957, SNARK:<6.MONITOR>GTJFN.MAC.29, 28-Sep-83 16:51:43 by MOSER
;TCO 6.1810 - DON'T EXPAND DSK: IF G1%SLN SET
; UPD ID= 2888, SNARK:<6.MONITOR>GTJFN.MAC.26, 12-Sep-83 12:37:09 by PRATT
;TCO 6.1795 - Fix problem with GJ%MSG which causes user confusion @ENDAL2-2
; UPD ID= 2881, SNARK:<6.MONITOR>GTJFN.MAC.25, 8-Sep-83 09:59:47 by TBOYLE
;More TCO 6.1743 - fix typo, change .ENDIF to ENDIF.
; UPD ID= 2880, SNARK:<6.MONITOR>GTJFN.MAC.24, 7-Sep-83 12:59:32 by TBOYLE
;TCO 6.1743 - Make DEFEXT: return GJFX23 if it occurs.
; UPD ID= 2866, SNARK:<6.MONITOR>GTJFN.MAC.23, 24-Aug-83 08:17:22 by MCINTEE
;More TCO 6.1226 - In ASGJFN, clear the word FILST1
; UPD ID= 2772, SNARK:<6.MONITOR>GTJFN.MAC.22, 27-Jul-83 13:30:54 by MCINTEE
;More TCO 6.1030 - Better error message for node names in file specs
; UPD ID= 2295, SNARK:<6.MONITOR>GTJFN.MAC.21, 16-Apr-83 19:17:23 by PAETZOLD
;TCO 6.1557 - TCP Merge - Delete old edit history - Update copyright.
; UPD ID= 2146, SNARK:<6.MONITOR>GTJFN.MAC.20, 4-Apr-83 13:23:27 by MCINTEE
;More TCO 6.1030 - Node names in file spec not in 6.0
; UPD ID= 2106, SNARK:<6.MONITOR>GTJFN.MAC.19, 28-Mar-83 17:48:44 by MURPHY
;Minor cleanup - use ERJMPR instead of explicit load from LSTERR.
; UPD ID= 1596, SNARK:<6.MONITOR>GTJFN.MAC.16, 29-Dec-82 10:41:01 by DONAHUE
;TCO 6.1159 - Don't allocate CTRL/R buffer if string is from memory
; UPD ID= 1272, SNARK:<6.MONITOR>GTJFN.MAC.15, 4-Oct-82 12:42:21 by MCINTEE
;TCO 6.1030 - Add call to DIMLNK near end of .GTJFN
; UPD ID= 1125, SNARK:<6.MONITOR>GTJFN.MAC.14, 31-Aug-82 12:43:00 by MCINTEE
;TCO 6.1243 - Change all occurrences of ENDSTR to ENDSTX
; UPD ID= 1090, SNARK:<6.MONITOR>GTJFN.MAC.13, 18-Aug-82 08:10:38 by PAETZOLD
;More TCO 6.1219 - Use FILDEV from the JFN as COMND does not have DEV set up
; UPD ID= 1080, SNARK:<6.MONITOR>GTJFN.MAC.12, 11-Aug-82 15:59:45 by PAETZOLD
;One more time TCO 6.1219 - Do not use P3 as it is DEFAC'ed out
; UPD ID= 1079, SNARK:<6.MONITOR>GTJFN.MAC.11, 11-Aug-82 13:29:59 by PAETZOLD
;More TCO 6.1219 - Use P3 instead of DEV in RELJFN as DEV might have unit
; numbers in the left half
; UPD ID= 1078, SNARK:<6.MONITOR>GTJFN.MAC.10, 11-Aug-82 10:33:15 by PAETZOLD
;More TCO 6.1219 - Handle case where DEV not set in RLJFD call in RELJFN
; UPD ID= 1065, SNARK:<6.MONITOR>GTJFN.MAC.9, 9-Aug-82 16:19:49 by PAETZOLD
;TCO 6.1219 - Make RELJFN dispatch to RLJFD
; UPD ID= 979, SNARK:<6.MONITOR>GTJFN.MAC.8, 7-Jul-82 16:11:28 by MCINTEE
;More TCO 6.1143 - NFT: strikes again
; UPD ID= 963, SNARK:<6.MONITOR>GTJFN.MAC.7, 28-Jun-82 14:53:52 by MCINTEE
;More TCO 6.1030 - initialize FLLNK in JFN block
; UPD ID= 893, SNARK:<6.MONITOR>GTJFN.MAC.6, 9-Jun-82 22:56:45 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 882, SNARK:<6.MONITOR>GTJFN.MAC.5, 9-Jun-82 15:53:31 by MCINTEE
;TCO 6.1030 - change some MDDOKs to DSKOK.
; UPD ID= 855, SNARK:<6.MONITOR>GTJFN.MAC.4, 7-Jun-82 08:17:22 by MCINTEE
;TCO 6.1030 : node name parsing - recognition fix
; UPD ID= 780, SNARK:<6.MONITOR>GTJFN.MAC.3, 24-May-82 11:32:33 by MCINTEE
;more TCO 6.1143 & fix up disallowing of NFT: in file specs
; UPD ID= 773, SNARK:<6.MONITOR>GTJFN.MAC.2, 20-May-82 10:09:52 by MCINTEE
;TCO 6.1143 - Add in "local files specs only" to long form GTJFN - G1%LOC
; UPD ID= 300, SNARK:<6.MONITOR>GTJFN.MAC.13, 14-Jan-82 09:00:34 by MCINTEE
;TCO 6.1055 - GJ%NOD flag returned if node name in file spec
; UPD ID= 290, SNARK:<6.MONITOR>GTJFN.MAC.12, 10-Jan-82 15:36:07 by GROUT
;TCO 5.1656: If G1%SLN set, don't expand DSK:
; UPD ID= 284, SNARK:<6.MONITOR>GTJFN.MAC.11, 8-Jan-82 14:50:05 by MURPHY
;Restore COC words correctly (bug from code reorg)
; UPD ID= 268, SNARK:<6.MONITOR>GTJFN.MAC.10, 23-Dec-81 15:46:00 by MCINTEE
;Node name parsing : -1 in LH of FILDEV (No units on this "device")
; UPD ID= 262, SNARK:<6.MONITOR>GTJFN.MAC.9, 16-Dec-81 16:23:14 by MCINTEE
;Node name parsing - disallow wildcards & recognition and fix bugs
;Disallow use of NFT: in file spec
; UPD ID= 202, SNARK:<6.MONITOR>GTJFN.MAC.8, 10-Nov-81 12:20:27 by MURPHY
;TAKE OUT TCO 5.1415
; UPD ID= 181, SNARK:<6.MONITOR>GTJFN.MAC.7, 3-Nov-81 13:20:47 by MCINTEE
;Node name parsing - Call SETTMP after parsing the node part
; UPD ID= 140, SNARK:<6.MONITOR>GTJFN.MAC.6, 19-Oct-81 16:00:22 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 124, SNARK:<6.MONITOR>GTJFN.MAC.5, 19-Oct-81 09:51:37 by MCINTEE
;Fix error returns for node name parsing
; UPD ID= 107, SNARK:<6.MONITOR>GTJFN.MAC.4, 14-Oct-81 23:45:30 by MURPHY
;Fix bugs from node parsing
; UPD ID= 100, SNARK:<6.MONITOR>GTJFN.MAC.2, 12-Oct-81 11:58:31 by COBB
;tco 5.1562 - Insert default fields when called parse-only (GJ%OFG)
;NODE NAME PARSING
;PUT SOURCE INTO M60:
; UPD ID= 88, SNARK:<5.MONITOR>GTJFN.MAC.14, 4-Aug-81 09:33:39 by SCHMITT
;TCO 5.1441 - Check for stars allowed when defaulting .GJALL
; UPD ID= 34, SNARK:<5.MONITOR>GTJFN.MAC.13, 15-Jul-81 15:03:15 by SCHMITT
;TCO 5.1415 - Specify a JFN as parse only early so no FDB created
; UPD ID= 2210, SNARK:<5.MONITOR>GTJFN.MAC.12, 18-Jun-81 08:54:39 by SCHMITT
;A little more of TCO 5.1353
; UPD ID= 2102, SNARK:<5.MONITOR>GTJFN.MAC.10, 28-May-81 12:03:13 by SCHMITT
;Tco 5.1353 - Fix GNJFN when higher deleted version of file exists
;CLEAN UP CODE, SOME STEPS TOWARD PARSING NODE NAMES AS NODE::
; UPD ID= 1489, SNARK:<5.MONITOR>GTJFN.MAC.9, 25-Jan-81 20:33:21 by ZIMA
;TCO 5.1244 - Fix lost JFNs problem by ERJMPing TEXTI.
; UPD ID= 1486, SNARK:<5.MONITOR>GTJFN.MAC.8, 24-Jan-81 23:48:38 by ZIMA
;TCO 5.1241 - Fix ILPPT3 BUGHLTs caused by JFNRD on for short-form GTJFN.
; UPD ID= 1226, SNARK:<5.MONITOR>GTJFN.MAC.7, 3-Nov-80 16:37:00 by DONAHUE
;MORE 5.1164 - MOVE CHECK TO GTJF23+15 AND LITERAL AT ENDLZ1+3
; UPD ID= 1110, SNARK:<5.MONITOR>GTJFN.MAC.6, 2-Oct-80 14:01:00 by DONAHUE
;TCO 5.1164 - Check for logical name loop at SETDV1+2
; UPD ID= 727, SNARK:<5.MONITOR>GTJFN.MAC.5, 2-Jul-80 16:08:59 by SANICHARA
;TCO 5.1091 - Check for valid ASCII Char at REDFL1+3
; UPD ID= 718, SNARK:<5.MONITOR>GTJFN.MAC.4, 1-Jul-80 14:52:58 by LYONS
;TCO 5.1087 - make ^X echo in a GTJFN
; UPD ID= 706, SNARK:<5.MONITOR>GTJFN.MAC.3, 26-Jun-80 13:38:20 by SCHMITT
;TCO 5.1083 - BE NOINT WHILE JSSTLK IS LOCKED IN SETDEV
; UPD ID= 678, SNARK:<5.MONITOR>GTJFN.MAC.2, 19-Jun-80 15:14:03 by OSMAN
;tco 5.1070 - Prevent "Byte count too small" on DELETE of real long name
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH PROLOG
TTITLE GTJFN ; & gnjfn
SWAPCD
PNCATT==:";" ;PUNCTUATION FOR ATTRIBUTES
PNCVER==:"." ;PUNCTUATION FOR VERSION
PNCPFX==:":" ;PREFIX PUNCTUATION FOR ATTRIBUTES
WLDCHR==:"%" ; WILD CHARACTER
PNCNOD==:":" ;PUNCTUATION FOR NODE (DIGRAPH)
.CHWL1==:"*" ;[7.1168] The other wildcard character
;GENERAL DEFINITIONS FOR RDTXT PROCESSING
;OFFSETS IN BLOCK FOR RDTXT
STRPNT==0 ;MAIN STRING POINTER
STRCNT==1 ;MAX CHARACTER COUNT
LDPNT==2 ;BYTE POINTER FOR ILDB'S
LDCNT==3 ;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
VARC==17 ;WORDS NEEDED FOR RDTXT STUFF
LOWBRK==COMMA ;LOWEST STATE FOR INTERESTING BREAK
;CHARACTERS
HGHBRK==ALTMOD ;HIGHEST STATE FOR INTERESTING BREAK
;CHARACTERS
MAXINP==<^D120-VARC>*5 ;MAX WORDS TO GET FOR TEXTI
DEFINP==MAXINP ;DEFAULT SIZE OF RDTXT BUFFER
LNHDRL==2 ;LENGTH OF LOGICAL NAME CHAIN BLOCK HDR
;SPECIAL AC DEFINITIONS USED HEREIN
DEFAC (TMP,Q1) ;Temporary AC
DEFAC (TXT,Q2) ;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
PBYTSZ::POINT 6,FILBYT(JFN),11 ; Points to "s" of file byte pointer
PFLMOD::POINT 4,FILSTS(JFN),35 ; MODE OF OPEN
;DEFINITIONS OF ENTITIES IN THE TXT BLOCK
DEFSTR (PFXVAL,PREFIX(TXT),35,9) ;POINTER TO THE PREFIX VALUE
MSKSTR WLDF,FLAGS(TXT),1B0 ; STRING IS A WILD MASK
MSKSTR DWLDF,FLAGS(TXT),1B1 ; DEFAULT STRING IS WILD
MSKSTR VERFF,FLAGS(TXT),1B2 ;COLLECTING A VERSION
MSKSTR SAWALT,FLAGS(TXT),1B3 ;SAW AN ALTMODE WHILE SCANNING
MSKSTR SWBRKT,FLAGS(TXT),1B4 ;SAW A SQUARE BRACKET FOR DIRECTORY
MSKSTR SAWCR,FLAGS(TXT),1B5 ;SAW A CR
MSKSTR SAWSLN,FLAGS(TXT),1B6 ;SAW A SYSTEM LOGICAL NAME
MSKSTR TMPFL,FLAGS(TXT),1B7 ;LAST ATTRIBUTE WAS ;T
MSKSTR PREFXF,FLAGS(TXT),1B8 ;GATHERING A PREFIX OF AN ATTRIBUTE
MSKSTR ARBATF,FLAGS(TXT),1B9 ;GATHERING THE DATA PART OF AN ATTRIBUTE
MSKSTR ATRF,FLAGS(TXT),1B10 ;HAVE SEEN AN ATTRIBUTE
MSKSTR RIEFLG,FLAGS(TXT),1B11 ;RETURN ON EMPTY FLAG
MSKSTR SAWF,FLAGS(TXT),1B12 ;SAW A CONTROL-F
MSKSTR NOLOGF,FLAGS(TXT),1B13 ;DON'T USE LOGICAL NAMES
MSKSTR COLNF,FLAGS(TXT),1B14 ;LAST CHAR WAS A COLON
MSKSTR CNTVF,FLAGS(TXT),1B15 ;CONTROL-V TYPED
MSKSTR SAWSEM,FLAGS(TXT),1B16 ;[7.1168] Saw a semi-colon
; 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
; .GJGEN LH(E) ; Flags
; RH(E) ; Default version
; .GJSRC LH(E+1) ; Input jfn (377777 means none)
; RH(E+1) ; Output jfn (377777 means none)
; .GJDEV E+2 ; Default string pointer device
; .GJDIR E+3 ; Default string pointer directory
; .GJNAM E+4 ; Default string pointer name
; .GJEXT E+5 ; Default string pointer extension
; .GJPRO E+6 ; Default string pointer protection
; .GJACT E+7 ; Default string pointer account
; .GJJFN E+10 ; Desired jfn if jfnf=1 (optional)
; .GJF2 E+11 ;ALTERNATE FLAGS,,COUNT (CONTROLLED BY JFNRD)
; .GJCPP E+12 ;RETURN BUFFER ADDRESS
; .GJCPC E+13 ;RETURN BUFFER ADDRESS SIZE IN WORDS
; .GJRTY E+14 ; ^R BUFFER(CONTROLLED BY G1%RBF)
; .GJBFP E+15 ; POINTER TO DESTINATION BUFFER
; .GJATR E+16 ;POINTER TO ARBITRARY ATTRIBUTES BLOCK
; .GJNOD E+17 ; Default string pointer node name
; 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(ILLCHR) ; Null
CC1(ILLCHR) ; Control-a
CCN ILLCHR,4 ; Control-b to e
CC1(CONTF) ; Control-f
CCN ILLCHR,2 ; Control-g & h
CC1(SPACE) ; TAB
CC1(TERMS) ; LF
CC1(ILLCHR) ; Control-k
CC1(TERMS) ;CONTROL-L (FF)
CC1(CARRET) ;CONTROL-M (CR)
CCN ILLCHR,4 ; Control-n - q
CC1(CONTR) ; Control-r
CCN ILLCHR,2 ; Control-s, t
CC1 (CONTU) ;CONT-U
CC1($QUOT) ; Control-v
CC1(CONTU) ; Control-w
CC1(ILLCHR) ; Control-x
CC1(ILLCHR) ; CONTROL-Y
CC1(TERMS) ;CONTROL-Z
CC1(ALTMOD) ; Alt-mode
CCN ILLCHR,3 ; 34-36
CC1(TERMS) ; Eol
CC1(SPACE) ; Space
CCN TERMS,3 ; ! " #
CC1(UPPER) ; $
CC1(WILDC) ; %
CC1 (ILLCHR) ; &
CCN TERMS,3 ;' ( )
CC1($STAR) ; Asterisk
CC1(TERMS) ; +
CC1(COMMA) ; Comma
CC1(MINUSC) ; -
CC1($DOT) ; Dot
CC1(TERMS) ; Slash
CCN DIGITC,12 ; Digits
;..
;..
CC1($COLON) ; Colon
CC1($SEMIC) ; Semi-colon
CC1($LANG) ; <
CC1(TERMS) ; =
CC1($RANG) ; >
CC1(QBRK) ; ?
CC1(TERMS) ; @
CC1(UPPERA) ; A
CCN UPPER,16 ; B - o
CC1(UPPERP) ; P
CCN UPPER,3 ; Q - s
CC1(UPPERT) ; T
CCN UPPER,6 ; U - z
CC1 ($LANG) ; [
CC1 (ILLCHR) ;\
CC1 ($RANG) ; ]
CC1 (ILLCHR) ; ^
CC1(UPPER) ; _
CC1(ILLCHR) ; Acute accent
CC1(LOWERA) ; Lower case a
CCN LOWER,16 ; Lower case b - o
CC1(LOWERP) ; Lower case p
CCN LOWER,3 ; Lower case q - s
CC1(LOWERT) ; Lower case t
CCN LOWER,6 ; Lower case u - z
CCN ILLCHR,4 ; Curly brackets vert bar complement
CC1(CONTU) ; Rubout
QW
; 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
$COLON::!CALL ENDDEV ; (11) colon
$LANG::!CALL BEGDIR ; (12) <
$RANG::!CALL ENDDIR ; (13) >
$DOT::! CALL ENDNAM ; (14) .
$SEMIC::!CALL ENDEXT ; (15) ;
$QUOT::!CALL QUOTCH ; (16) control-v
ILLCHR::!ERRLJF GJFX4,<MOVEM A,ERRSAV> ; (17) illegal character
$STAR::!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
$CTRLX::!ERRLJF GJFX4,<MOVEM A,ERRSAV> ; (31) ^X IS AN illegal character
QBRK::! CALL QUEST ;[7.1014] (32) ?
WILDC::!CALL PCENT ;[7.1014] (33) Wildcard character
CARRET::!CALL DOCR ; (34) CARRIAGE RETURN
$NODEP::!CALL ENDNOD ; (35) NODE PUNCTUATION
DEPHASE ; END OF ADDRESS RELOCATION
ECHDTB:
;THE JSYS
;START WITH A LOT OF INITIALIZATION
.GTJFN::MCENT ; Enter slow code
TRVAR <INFMOD,<INFCOC,2>,BKGCH,LDPTMP,LDCTMP,CRPTMP,CRCTMP> ;[7.1014]
;INFMOD - SAVED RFMOD OF INPUT FILE IF ANY
;INFCOC - SAVED RFCOC OF INPUT FILE IF ANY
;BKGCH - BACKED UP CHARACTER FROM GCH
;These next four locations are used to preserve the
;TEXTI% context when GTJFN% is processing a "?"
;LDPTMP - Byte pointer used by ILDB's
;LDCTMP - Count of bytes in above string
;CRPTMP - Current byte pointer
;CRCTMP - Count of bytes in above byte pointer
SETZB TXT,BKGCH ; 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,.GJGEN(F1)] ; Get flags from user
CAIN F1,1 ; Short form? (or doesn't matter case)
TQZ <JFNRD> ; Yes, GJ%XTN not allowed
SETZB F1,STS ; Clear f1 & sts
TQNE <NACCF>
TQO <FRKF>
TXNE E,GJ%FNS ; 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 SETINF ;SETUP FILES IF NECESSARY
TLNN E,777777 ; Can't specify jfn if short form
TQNN <JFNF> ; Is user trying to specify jfn?
IFSKP.
CALL USRJFN ;YES, SET IT UP
ELSE.
CALL ASGJFN ;GET A FREE JFN
ERRLJF(GJFX3) ; Jfn not available
ENDIF.
CALL SETSTR ;SET STAR BITS IN STS CORRECTLY
TQNN <JFNRD> ;EXTENDED BLOCK GIVEN?
JRST USDFLT ;NO. USE DEFAULT BUFFER SIZE
HRRZ D,E
MOVX A,G1%IIN
XCTU [TDNE A,.GJF2(D)] ; Want to find invisible files?
TQO <IGIVF> ; Yes, flag that fact
XCTU [HRRZ A,.GJF2(D)] ;YES. GET SIZE OF EXTENDED BLOCK
CAIGE A,.GJCPC-.GJF2 ;IS THERE A COUNT GIVEN?
JRST USDFLT ;NO. GO AROUND THE REST
XCTU [SKIPG B,.GJCPC(D)] ;YES. IS IT NON-ZERO?
MOVEI B,DEFINP ;NO. USE THE DEFAULT
CAIGE A,.GJRTY-.GJF2 ;HAVE A ^R BUFFER?
JRST USDFL1 ;NO. GO ON THEN
XCTU [SKIPN .GJRTY(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
;INITIALIZATION CONTINUES...SETUP BLOCK TO BE USED BY RDTXT FOR INPUT
;EDITING OF TEXT BEFORE WE PARSE IT. SETUP ^R BUFFERS, ETC.
CALL SRDTXT ;SETUP RDTXT BLOCK
MOVEM B,STRCNT(TXT) ;SAVE IT
MOVEM A,ARGCR(TXT) ;^R BUFFER
TQNN <JFNRD> ;HAVE AN EXTENDED BLOCK?
JRST GJF00 ;NO
HRRZ D,E
UMOVE C,.GJF2(D) ;GET FLAG WORD
MOVX B,NOLOGF ;GET SUPPRESSION OF LOGICAL NAMES BIT
TXNE C,G1%SLN ;WANT THEM SUPPRESSED?
IORM B,FLAGS(TXT) ;YES, REMEMBER THAT
HRRZ B,C ;GET NUMBER OF EXTENDED WORDS
CAIL B,.GJRTY-.GJF2 ;INCLUDE A ^R BUFFER?
XCTU [SKIPN B,.GJRTY(D)] ;IS IT NON-ZERO?
IFSKP. <
CALL RTYSET> ;YES, SET IT UP
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,.GJF2(D)] ;GET COUNT
CAIGE C,.GJRTY-.GJF2 ;HAVE A ^R POINTER?
JRST GTJF12 ;NO. GO ON THEN
XCTU [SKIPE .GJRTY(D)] ;IS ^R BUFFER NON-ZERO?
XCTU [SKIPN C,.GJCPC(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) ;"
; ..
; ****
;END OF SETUP OF RDTXT STUFF
; ****
;DO SOME REAL GTJFN WORK - I.E., GET AND PARSE CHARACTERS
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
ERJMPR ERRDO ;ERR CODE TO A AND ERROR
HRRZ C,ARGDC(TXT)
HLL C,ARGFLG(TXT) ;GET THE FLAGS
TXNE C,RD%BTM ;FOUND A REAL BREAK CHARACTER?
IFSKP.
TRNN C,-1 ;NO, 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,.GJF2(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
ENDIF.
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: SKIPE A,BKGCH ;BACKED UP CHAR?
IFSKP.
CALL GCH ; NO, Get next character
JRST GTJF23 ;NO MORE
ELSE.
SETZM BKGCH ;CLEAR LOCAL CHAR BFR
ENDIF.
TMNN <SAWSEM> ;[7.1168] Did we just see a semi-colon?
IFSKP. ;[7.1168] If so,
CAIE A,.CHWL1 ;[7.1168] Is it followed with a *?
IFSKP. ;[7.1168] If so,
MOVEI A,GJFX40 ;[7.1168] Say undefined attribute
JRST ERRDO ;[7.1168] And clean up
ENDIF. ;[7.1168]
ENDIF. ;[7.1168]
TMNE <CNTVF> ; Control-v pending?
JRST [ SETZRO CNTVF
CALL UCCH ; Yes, ignore any special meanings
JRST ERRDO ;ERROR DURING HANDLING OF THIS CHAR
JRST GTJF2]
;..
;..
MOVX B,SAWSEM ;[7.1168] Check if a semi-colon was typed
CAIE A,.CHSEM ;[7.1168] Was it?
IFSKP. ;[7.1168] If so,
IORM B,FLAGS(TXT) ;[7.1168] Say we have seen a semi colon
ELSE. ;[7.1168]
ANDCAM B,FLAGS(TXT) ;[7.1168] No semi colon this time
ENDIF. ;[7.1168]
MOVX B,SAWCR ;SEE IF JUST SAW A CR
TDNN B,FLAGS(TXT) ;DID WE?
IFSKP.
ANDCAM B,FLAGS(TXT) ;YES. TURN OFF BIT
CAIE A,.CHLFD ;IS THIS A LINE FEED?
ERRLJF(GJFX4) ;NO. ILLEGAL CHARACTER THEN
ENDIF.
IFQN. COLNF ;PREV CHAR WAS COLON?
SETZRO COLNF ;YES, NOW HAVE
CAIE A,PNCNOD ; NODE PUNCTUATION?
IFSKP.
TQNN <ASTF> ;YES. PARSE ONLY ?
ERRLJF(GJFX55) ;NO. ILLEGAL.
MOVEI B,$NODEP ;YES, FAKE USUAL DISPATCH
ELSE.
MOVEM A,BKGCH ;NO, SAVE THIS CHAR
MOVEI B,$COLON ;HANDLE SINGLE COLON
ENDIF.
ELSE.
CAIE A,PNCNOD ;POSSIBLE NODE DIGRAPH?
IFSKP.
SETONE COLNF ;YES, MUST SEE WHAT FOLLOWS
JRST GTJF2
ENDIF.
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>
ENDIF.
GTJF21: XCT CHDTB(B) ; Execute the dispatch table
SKIPN A ; IF NON-ZERO, THEN ERROR
JRST GTJF2 ; SUCCESSFUL HANDLING OF CHARACTER
JUMPG A,ERRDO ; IF A>0 FATAL ERROR
TQNE <ASTF> ; PARSE ONLY?
JRST ENDAL4 ; YES, IGNORE STEPPED LOGICAL NAME
JRST GTJFST ; LOGICAL NAME WAS STEPPED, RETRY
;MAIN STRING EXHAUSTED
GTJF23: JUMPN A,ERRDO ; IF A NON-ZERO, ERROR
IFQN. COLNF ;COLON LAST SEEN?
SETZRO COLNF ;YES, CLEAR IT
MOVEI B,$COLON
JRST GTJF21 ;HANDLE IT
ENDIF.
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
;QUOTE CHARACTER
QUOTCH: SETONE CNTVF ;SET FLAG FOR NEXT CHAR
RETSKP
; 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: MOVX B,ARBATF ;[7401]Are we collecting an attribute
TDNN B,FLAGS(TXT) ;[7401] argument now?
JRST LCCH1 ;[7401]No, go ahead and convert to uppercase
MOVE B,PREFIX(TXT) ;[7401]Yes, find out which attribute
CAIE B,.PFPWD ;[7401]Is it a password?
CAIN B,.PFUDT ;[7401]Or a userid?
JRST UCCH ;[7401]Yes, so don't uppercase it
CAIE B,.PFACN ;[7401]The same goes for network account
CAIN B,.PFOPT ;[7401]Or the optional data
JRST UCCH ;[7401]Yes, so don't uppercase it
LCCH1: SUBI A,40 ;[7401] 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: TQNN <STARF> ;SAW STAR?
IFSKP.
MOVX B,WLDF ;YES, SET WILD BIT IN FLAGS
IORM B,FLAGS(TXT)
ENDIF.
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
;NODE NAME TERMINATOR (::)
ENDNOD: TQNN DIRFF
TQNE <DEVF,DIRF,NAMF,EXTF> ;MUST BE THE FIRST FIELD
RETBAD GJFX54
CALL ENDSTX ;TERMINATE STRING
CALL ENDTMP ;SAVE THE STRING
STOR A,FLNOD,(JFN)
CALL ENDNDX ;LOOK UP NODE NAME & SETUP JFN BLOCK
RETBAD() ;ERROR, RETURN
CALLRET SETTMP ;RESET TEMP BLOCK & RETURN
;DEFAULT THE NODE NAME IF GIVEN
DEFNOD: CALL GLNNOD ;SEE IF DEFAULT FROM LOGICAL NAME
IFNSK.
JUMPN A,R ;NO, QUIT IF HARD ERROR
TXNN E,-1B17 ;[7298] Have JFN block?
TQNN JFNRD ;EXTENDED JFN BLOCK?
RETSKP ;NO, DEFAULT NODE NOT PROVIDED
XCTU [HRRZ A,.GJF2(E)];[7298] Get count in extended GTJFN block
CAIE A,.GJNOD-.GJF2 ;[7298] Is there a word there for .GJNOD?
RETSKP ;[7298] No, so let's return quietly
HRRZ D,E
XCTU [SKIPN A,.GJNOD(D)] ;SEE IF STRING HERE
RETSKP ;NO
CALL REDFLT ;YES, COPY IT
RETBAD
ENDIF.
NOINT
LOAD A,FLTSD,(JFN) ;GET TEMP STRING
SETZRO FLTSD,(JFN)
STOR A,FLNOD,(JFN) ;SAVE IT AS NODE
ENDNDX: TQNN <JFNRD> ;Long form GTJFN ?
IFSKP.
BLOCK. ;yes. this block exits +1 on error, +2 on
; success
SAVEAC <A,B> ;grab ACs
MOVX A,G1%LOC ;is local
HRRZ B,E ; files only
XCTU [TDNE A,.GJF2(B)] ; flag set ?
RET ;yes. exit block with error
RETSKP ;no. exit block success
ENDBK.
RETBAD (GJFX6) ;return the error that we used to.
ENDIF.
CALL NODLUK ;SEE IF A VALID NODE NAME
RETBAD () ;NOT VALID, PASS ALONG ERROR MESSAGE
OKINT ;MATCH ENDTMP
SETONE NODEF ;HAVE A NODE NOW
MOVEI B,NFTIDX ;IMPLIES DEVICE NFT
STOR B,FLDVX,(JFN) ;SAVE DEVICE INDEX
HRRZ DEV,DEVDSP(B) ;SET UP FILDEV - RH IS DEVICE DISPATCH
HRLI DEV,-1 ; LH IS -1, MEANS DEVICE HAS NO UNITS
MOVEM DEV,FILDEV(JFN)
SETONE FLLNK,(JFN) ;initialize link index
RETSKP
; 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> ;DIRECTORY ALREADY SPECIFIED?
RETBAD(GJFX6) ;YES, LOSE
TQOE <DEVF>
RETBAD (GJFX6) ; Device already specified (syntax)
TQNE NODEF ;HAVE SEEN NODE?
IFSKP.
CALL DEFNOD ;NO, TRY FOR DEFAULT
RET ;SOME KIND OF HARD FAILURE
ENDIF.
CALL ENDSTX ; Terminate string, get lookup pointer
MOVEM T1,ENDDVS ;SAVE STRING POINTER
TQZE <STARF> ; WAS A STAR OF SOME SORT TYPED?
JRST ENDSDV ; YES
TQNE NODEF ;HAVE NODE NOW?
JRST ENDDV0 ;YES
CALL CHKLNM ; GO SEE IF THIS IS A LOGICAL NAME
JRST ENDDV3 ;NO, GO LOOK UP DEVICE
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 LNKLGJ ;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
ENDDV3: MOVE T1,ENDDVS ;RESTORE STRING POINTER
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: TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed?
RETBAD (GJFX31) ;[7.1014] No give bad return
CALL STRDEV ; SET UP FIRST STR IN LIST
RETBAD () ; ILLEGAL USE OF STAR
MOVEM T1,ENDDVS ; SAVE POSSIBLY ALTERED BLOCK POINTER
JRST ENDDV0 ; GO SET UP THIS STR
ENDPFX: ANDCAM B,FLAGS(TXT) ;CLEAR PREFIX FLAG
CALLRET GETPRE ;GO PARSE THE PREFIX
;ROUTINE TO CHECK THE SYNTAX OF STARED DEVICE FIELD
;ACCEPTS IN A/ STRING POINTER TO DEVICE NAME
; CALL STRDEV OR STRDVD
;RETURNS +1: ILLEGAL USE OF STAR
; +2: OK, STRING NOW CONTAINS "PS"
STRDVD: TRVAR <DEFFLG>
SETOM DEFFLG ;FLAG THAT WE'RE DEFAULTING
MOVE B,[DWLDF] ;GET ONE TYPE OF WILD FLAG
JRST STRDE1 ;JOIN COMMON CODE
STRDEV: TRVAR <DEFFLG>
SETZM DEFFLG ;NOT DEFAULTING
MOVX B,WLDF ;OR ANOTHER TYPE
STRDE1: STKVAR <LPTR,DPTR> ;TEMPS FOR DSK*
ANDCAM B,FLAGS(TXT) ;CLEAR IT
MOVE B,1(A) ;GET THE NAME OF THE DEVICE
CAME B,[ASCIZ/DSK*/] ;IS IT THE MAGIC VALUE?
RETBAD (GJFX31) ;NO, ILLEGAL USE OF STAR
NOINT ;MAKE SURE ASGFRE DOES NOT GET UPSET
CALL GNJFN3 ;MAKE SURE WE HAVE AN UNTRIMMED BLOCK
RETBAD (,<OKINT>) ;FROM THE JSB, PASS DOWN FREE SPACE ERROR
OKINT
MOVX T2,<POINT 7,> ;GET BYTE POINTER LEFT HALF
HRRI T2,1(T1) ;GET THE ADDRESS OF THE BLOCK
MOVEM T2,DPTR ;SAVE THE TARGET POINTER
MOVX T2,<POINT 6,> ;GET SIXBIT BYTE POINTER
HRR T2,STRTAB+PSNUM ;GET ADR OF SDB FOR PS
MOVEM T2,LPTR ;SAVE THE SOURCE POINTER
MOVEI T3,6 ;SIX CHARACTERS
STRDE9: ;SIXBIT TO ASCII LOOP
ILDB T2,LPTR ;GET A BYTE
SKIPN T2 ;NULL?
JRST STRD10 ;YES
ADDI T2,40 ;CONVERT TO ASCII
IDPB T2,DPTR ;STORE THE ASCII
SOJG T3,STRDE9 ;LOOP FOR ALL SIX CHARS OR UNTIL NULL
STRD10: ;HERE WHEN ALL CHARS CONVERTED
SETZ T2, ;GET A NULL BYTE
IDPB T2,DPTR ;SAVE THE NULL BYTE
MOVEI T2,2(T1) ;DETERMINE A REASONABLE END OF THE BLOCK
SKIPN DEFFLG ;SET FILOPT IF NOT DEFAULTING
HRRM T2,FILOPT(JFN) ;MAKE SURE THIS BLOCK DOES NOT GET OVERTRIMMED
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 ENDSTX ; Terminate string, get lookup pointer
BLCAL. MDDOK,<<FILDEV(JFN)>> ;A MULTIPLE DIR DEVICE?
IFSKP.
TQNE <ASTF> ;YES, DOING PARSE ONLY?
ANSKP.
LOAD B,FLUC,(JFN) ;GET STRUCTURE CODE
CALL DIRLKX ;NO, Lookup directory (no recognition)
JRST ENDDI1 ; Failed
STOR A,FLDNO,(JFN) ; Save directory number
ELSE.
SETZRO FLDNO,(JFN) ; NO DIRECTORY NUMBER
ENDIF.
CALL ENDTMP ; TIE OFF THE DIRECTORY NAME STRING
STOR A,FLDIR,(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: TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed?
RETBAD (GJFX31) ;[7.1014] No, give bad return
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,FLDMS,(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
RETBAD GJFX17 ;NO SUCH DIRECTORY
TQO <DIRTF> ;REMEMBER SEEN A DIRECTORY
TQZE <DFSTF> ;WAS THIS A DEFAULT?
RETSKP ;YES. JUST RETURN THEN
CALLRET SETTMP ;AND DONE
;HERE IF DIRECTORY LOOKUP FAILED
ENDDI1: TQNN <STRSF> ; Did user request DSK*: ?
JRST [ MOVE B,A ; COPY RETURN STATUS FROM DIRLKX
MOVEI A,GJFX17 ; NO SUCH DIRECTORY, GO STEP LOGICAL NM
JUMPL B,R ; AMBIGUOUS
JRST STEPLN]
CALL ENDTMP ; Yes, tie off directory name string
STOR A,FLDIR,(JFN) ; Store the pointer
OKINT ; Allow ints which were disallowed in ENDTMP
CALL DEVSTP ; Step the device
JRST STEPLN ; Failed, try stepping the logical name
JRST ENDDI3 ; And go finish up
; 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
;ENTER HERE FROM RECALL
ENDNA3: TQO <NAMF> ; NO WE HAVE A NAME
TQNE <DIRF> ; Do we have a directory yet?
IFSKP.
CALL DEFDIR ; No. default it
JUMPN A,R ; RETURN IF FATAL ERROR
ENDIF.
TQZE <STARF>
JRST STARNM
CALL ENDSTX ; Terminate string, get lookup pointer
CALL NAMLKX ; Look up name without recognition
JRST STEPLN ; NO SUCH NAME, GO STEP LOGICAL 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: TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed?
RETBAD (GJFX31) ;[7.1014] No give bad return
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,FLNMS,(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
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
;ENTER HERE FROM RECALL
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 ENDSTX ; No, terminate, get lookup pointer
CALL EXTLKX ; Lookup extension without recognition
JRST STEPLN ; NO SUCH EXT, GO STEP LOGICAL NAME
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: TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed
RETBAD (GJFX31) ;[7.1014] No, give bad return
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,FLEMS,(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
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 ENDSTX ; Account is a string
CALL ENDTMP
MOVEM A,FILACT(JFN) ; Save positive account block pointer
OKINT
TQNE <VERF> ; HAVE A VERSION YET?
IFSKP.
CALL DEFVER ; NO, GO GET ONE
RETBAD () ; FAILED
ENDIF.
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?
IFNSK.
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
ENDIF.
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?
IFSKP. < ;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 GTVER ;[7.1014] (/A) Lookup this version
JRST STEPLN ; GO TRY TO STEP LOGICAL NAME
MOVX B,VERFF ;[7.1014] No longer looking for version after
ANDCAM B,FLAGS(TXT) ;[7.1014] we have obtained one
JRST ENDEX0
STRVER: TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed?
RETBAD (GJFX31) ;[7.1014] Nope
TQO <VERSF,STEPF>
MOVNI A,2 ;START WITH OLDEST VERSION
TQNE <ASTF> ;OUTPUT STARS?
SETZ A, ;YES. USE ZERO INSTEAD
JRST STRVR1
;END OF A PREFIX
ENDPRE: ANDCAM A,FLAGS(TXT) ;CLEAR PREFIX FLAG
CALL GETPRE ;GO PARSE THE PREFIX
RETBAD ;UNKNOWN PREFIX
ENDARB: MOVX A,ARBATF ;CLEAR ARBITRARY ATTRIBUTE FLAG
ANDCAM A,FLAGS(TXT)
MOVE A,PREFIX(TXT) ;GET THE PREFIX VALUE
ANDI A,PFXMSK ;ISOLATE PREFIX NO.
CAIN A,.PFACT ;ACCOUNT STRING?
JRST ENDEXA ;YES, GO STORE IT
CAIN A,.PFPRT ;PROTECTION FIELD?
JRST ENDEXP ;YES
CAIN A,.PFOFL ; Offline attribute?
JRST ENDEX0 ; Yes, ignore it here
CALL ENDSTX ;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
SKIPN C ;IS THERE A DEVICE?
RETBAD (GJFX40) ;NO. INVALID ATTRIBUTES
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 ENDSTX ;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
ERJMPR [RETBAD ()] ;ERROR CODE TO T1 AND RETURN FAIL
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/COMPARTMENTS/],,.PFTCM ;TCP COMPARTMENT DATA
[ASCIZ/CONNECTION/],,.PFTCN ;TCP CONNECTION MODE
[ASCIZ/COPIES/],,.PFCOP ;SPOOLED FILE COPIES
[ASCIZ /DATA/],,.PFOPT ;NETWORK OPTIONAL DATA
[ASCIZ/EXPIRATION-DATE/],,.PFEXP ;MAGTAPE EXPRIATION DATE
[ASCIZ/FOREIGN-HOST/],,.PFTFH ;TCP FOREIGN HOST
[ASCIZ/FORMAT/],,.PFFMT ;MAGTAPE FORMAT
; [ASCIZ/FORMS/],,.PFFRM ;SPOOLED FILE FORMS
[ASCIZ/HANDLING-RESTRICTIONS/],,.PFTHR ;TCP HANDLING PARAMETERS
[ASCIZ/LOCAL-HOST/],,.PFTLH ;TCP LOCAL HOST NUMBER
[ASCIZ/P/],,.PFPRT ;PROTECTION
[ASCIZ /PASSWORD/],,.PFPWD ;NETWORK PASSWORD STRING
[ASCIZ/PERSIST/],,.PFTPR ;TCP PERSISTANCE PARAMETERS
[ASCIZ/POSITION/],,.PFPOS ;MAGTAPE POSITION
[ASCIZ/PREALLOCATE/],,.PFALC ;PREALLOCATE DISK SPACE
[ASCIZ/RECORD-LENGTH/],,.PFRLN ;MAGTAPE RECORD LENGTH
[ASCIZ/SECURITY/],,.PFTSC ;TCP SECURITY PARAMETERS
[ASCIZ /TAPE-ACCESS/],,.PFACC ;ACCESS CODE ON MT DEVICE
[ASCIZ/TEST/],,NOATRF ;TEST OF NOATRF FLAG
[ASCIZ/TIMEOUT/],,.PFTTM ;TCP TIMEOUT PARAMETERS
[ASCIZ/TRANSMISSION-CONTROL/],,.PFTTC ;TCP TRANSMISSION CONTROL PARAMETERS
[ASCIZ/TYPE-OF-SERVICE/],,.PFTTS ;TCP TYPE OF SERVICE PARAMETERS
[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>
TQNE NODEF ;HAVE NODE?
IFSKP.
CALL DEFNOD ;NO, TRY FOR DEFAULT
RET ;HARD ERROR
ENDIF.
CALL GLNDEV ; GET LOGICAL NAME DEFAULT
IFSKP. <
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,.GJDEV(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
STOR A,FLTSD,(JFN) ;IN CASE STRDVD CHANGED IT
TQNE NODEF ;HAVE NODE NOW?
IFSKP.
CALL CHKLNM ;NO, SEE IF THIS DEFAULT IS A LOGICAL NAME
SKIPA A,DEFDVS ;NO, GET BACK STRING POINTER
JRST DFDVL0 ; YES, LOOP BACK AND TRY FOR A DEVICE
ENDIF.
CALL SETDEV ; SET UP DEVICE INFORMATION
IFNSK. ;No such device
CAIN A,STRX09 ;STRUCTURE MOUNT ERROR?
MOVEI A,GJFX24 ;YES, RETURN MORE CORRECT ERROR CODE
JRST STEPLN ;Step logical name
ENDIF.
NOINT
LOAD A,FLTSD,(JFN)
SETZRO FLTSD,(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>
CALLRET DFDVTY ;IF DOING RECOGNITION, TYPE OUT DEV NAM
DEFSDV: CALL STRDVD ;CHECK SYNTAX OF STAR IN DEVICE FIELD
RETBAD () ;ILLEGAL SYNTAX
JRST DFDV0A ;NOW HAVE THE FIRST DEVICE NAME
DEFDV1: MOVEI B,3 ; Need 3 words TO HOLD STR NAME
NOINT
CALL ASGJFR ; Of job storage
RETBAD (GJFX22,<OKINT>) ; No space available
HRLM A,FILDDN(JFN) ; The block is for the device name
OKINT
MOVE B,[ASCIZ /DSK/]
MOVEM B,1(A) ; The device is "dsk"
MOVEM A,DEFDVS ; SAVE STRING POINTER ADDRESS
CALL CHKLNM ; SEE IF THIS DEFAULT IS A LOGICAL NAME
SKIPA A,DEFDVS ;NO, GET STRING POINTER BACK AGAIN
JRST DFDVL1 ; YES, LOOP BACK AND TRY FOR A DEVICE
CALL SETDEV ; SET UP DEVICE INFORMATION
RETBAD () ; NO SUCH DEVICE
NOINT
MOVE A,DEFDVS ; GET NAME STRING POINTER
CALL CHKDSK ; SEE IF THIS IS "DSK:"
RETBAD (,<OKINT>) ; COULD NOT GET JSB SPACE FOR STRING
HRLM A,FILDDN(JFN) ; STORE NEW STRING POINTER
OKINT
TQO <DEVF>
JRST RFALSE ; RETURN WITH A=0
DFDVL0: NOINT ;PUT LOGICAL NAME STRING INTO FILLNM
LOAD A,FLTSD,(JFN) ;GET POINTER TO DEFAULT STRING
SETZRO FLTSD,(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
REPEAT 0,< ;NEVER WANT TO TYPE DEFAULTED DEVICE FIELD
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
> ;END REPEAT 0
MOVEI C,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
MOVE D,STPCNT(TXT) ;GET CURRENT STEP COUNTER
CALL LNKLGJ ;ADD THIS LOGICAL NAME TO CHAIN
JRST [ OKINT
RETBAD ()] ;PROBLEM OCCURED
OKINT ;TURN ON INTERRUPTS AGAIN
CALL GLNDEV ;NOW GET PHYSICAL DEVICE
IFSKP. <
JRST DEFDV0> ;GO CHECK THIS ONE OUT
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
JRST DEFDV1 ;GO USE DSK
DFDVTY: MOVE C,FILCNT(JFN) ;MAKE SURE USER HADNT TYPED ANYTHING
TQNN <DIRFF> ;OR WASNT ENTERING A DIRECTORY
CAMGE C,CNTWRD(TXT) ;...
JRST RFALSE ;YES, DONT TYPE OUT DEV
TQNN <DIRF,NAMF> ;IF ALREADY SEEN A DIR OR A NAME
TQNE <NREC> ; OR RECOGNITION IS NOT BEING DONE
JRST RFALSE ;DONT TYPE OUT THE LOGICAL NAME
HRRZ B,FILLNM(JFN) ;IS THERE A LOGICAL NAME IN EFFECT?
JUMPN B,RFALSE ;IF YES, DONT TYPE OUT DEFAULT DEV
HRRZ B,A ;GET THE POINTER TO THE LOGICAL NAME
TQNE <STRSF> ;IS THIS THE WILD DEVICE?
MOVEI B,[ASCIZ/DSK*/]-1 ;YES, CHANGE TO PROPER STRING
CALL TSTRB ;GO TYPE IT OUT
CHOUT <":"> ;AND FOLLOW NAME WITH A COLON
TQO <DEVTF> ;MARK THAT DEV WAS TYPED OUT FOR RETYPE
RETSKP ;AND RETURN
;ROUTINE TO SET UP DEVICE INFORMATION
;ACCEPTS IN A/ STRING POINTER TO DEVICE NAME
; CALL SETDEV
;RETURNS +1: NO SUCH DEVICE, ERROR CODE IN A
; +2: OK - FILIDX(JFN) AND FILDEV(JFN) SET UP PROPERLY
SETDEV: STKVAR <SETDVT>
TQNE NODEF ; HAVE SEEN NODE?
RETSKP ; YES, DEVICE FIELD NOT CHECKED
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?
IFSKP.
MOVEI A,GJFX38 ; CANNOT GET OLD FILE ON OUTPUT ONLY DEV
JRST STEPLN ; GO SEE IF LOGICAL NAME CAN BE STEPPED
ENDIF.
HRRM B,FILIDX(JFN) ; STORE INDEX INTO DEVICE TABLES
MOVEM DEV,FILDEV(JFN) ; Value of lookup is initial fildev
HRRZ D,DEV ;GET DISPATCH TABLE ADDRESS
CAIN D,MTDTB ;IS THIS AN MT DEVICE?
TQNE <ASTF> ;YES. PARSE ONLY?
IFSKP.
CALL DEVAV ;YES. CHECK IF AVAILABLE
RETBAD (OPNX7) ;NOT. GIVE ERROR THEN
ENDIF.
BLCAL. DSKOK,<DEV> ;SEE IF DISK
RETSKP ;ISN'T
HLRZ B,DEV ;GET UNIT # (MAY BE STR #)
CAIN B,-1 ;YES - SPECIFIC STRUCTURE?
RETSKP ;NO, ALL DONE
STOR C,FLUC,(JFN) ;STORE UNIQUE CODE IN JFN BLOCK
;..
;..
SETZ B, ;THIS JSB IS MAPPED
MOVE A,C ;MOVE UNIQUE CODE TO T1 FOR CHKMNT
TLO A,400000 ;ALLOW MOUNT ONLY BY THIS FORK
NOINT ;BE NOINT WHILE JSSTLK IS LOCKED
LOCK JSSTLK ;LOCK JSB STRUCTURE INFO LOCK
CALL CHKMNT ;[7.1063](T1,T2/T1)Did user mount this structure
IFNSK. ;[7.1063]If not...
UNLOCK JSSTLK ;[7.1063]Unlock structure info lock in JSB
OKINT ;[7.1063]Allow interrupts now
TQNN <ASTF> ;[7.1095]Parse-only?
RETBAD () ;[7.1095]Return the error
SETZ C, ;[7.1095]Yes, structure is ok
HRRM C,FILIDX(JFN) ;[7.1095]Clear index into device tables
STOR C,FLUC,(JFN) ;[7.1095]Clear unique code
MOVEM C,FILDEV(JFN) ;[7.1095]Clear device
RETSKP ;[7.1095]Return success
ENDIF. ;[7.1063]
UNLOCK JSSTLK ;[7.1063]Unlock structure info lock in JSB
OKINT ;[7.1063]Allow interrupts now
LOAD A,STR,(JFN) ;[7.1063]Get structure number
CALL CKSTOF ;[7.1063](T1/T1)Is structure offline?
RETBAD () ;[7.1063]Return "Structure is offline"
RETSKP ;[7.1063]Return +2 to caller
;NO SUCH DEVICE
SETDV1: TQNE <ASTF> ; PARSE ONLY?
RETSKP ; YES, THEN DEVICE NAME IS OK
EXCH A,SETDVT ; SAVE ERROR CODE AND GET BACK POINTER
MOVEI B,FILLNM(JFN) ; NOW SEE IF THIS DEVICE IS ON LN CHAIN
CALL CHKCHN ; TO DETERMINE IF THIS IS A LN LOOP
SKIPA A,SETDVT ; NOT ON CHAIN, GET BACK ERROR CODE
MOVEI A,GJFX39 ; LOGICAL NAME LOOP
RETBAD ; RETURN WITH ERROR CODE IN A
;ROUTINE TO SEE IF DEVICE STRING IS "DSK:" AND TO CHANGE IT TO
; THE CONNECTED STRUCTURE IF IT IS "DSK:"
;ACCEPTS IN A/ LOOKUP POINTER TO DEVICE STRING
; MUST BE NOINT WHEN CALLED
; CALL CHKDSK
;RETURNS +1: ERROR, NO ROOM IN JSB FOR NEW STRING
; +2: NEW POINTER IN A, STRING WAS UPDATED TO STR NAME
; DEV AND FILDEV(JFN) MODIFIED APPROPRIATLY
CHKDSK: TLC DEV,-1 ;LH IS -1?
TLCE DEV,-1
RETSKP ;NO, ALREADY HAVE SPECIFIC STR
STKVAR <CHKDSN> ;SAVE NAME POINTER
MOVEM A,CHKDSN
BLCAL. DSKOK,<DEV> ;SEE IF REAL DISK
RETSKP ;ISN'T
MOVE B,FLAGS(TXT) ;GET FLAGS INTO B
TXNE B,NOLOGF ;ARE WE EXPANDING LOGICAL NAMES?
; CALL CHKLN1 ;TCO 6.1810;IF NOT, IS DSK: DEFINED?
SKIPA ;TCO 6.1810 NEVER EXPAND IF NOLOGF
JRST CHKDS1 ;NOLOGF CLEAR OR DSK: NOT DEFINED, TRANSLATE
MOVE A,CHKDSN ;DON'T TRANSLATE, RESTORE POINTER
RETSKP ;AND RETURN
CHKDS1: LOAD A,JSUC ;GET CONNECTED STR UNIQUE CODE
STOR A,FLUC,(JFN) ;PUT THIS IN THE JFN BLOCK
CALL CNVSTR ;CONVERT
RETBAD (GJFX16) ;NO SUCH DEVICE
HRL DEV,A ;UPDATE DEV WITH UNIT NUMBER
CALL ULKSTR
MOVE A,CHKDSN ;GET BACK THE NAME POINTER
MOVEM DEV,FILDEV(JFN) ;STORE IN JFN BLOCK
CALLRET CNVSIX ;CONVERT SIXBIT DEV NAME TO A STRING
;ROUTINE TO CHANGE THE DEVICE NAME TO THE CORRECT NAME FROM DEVTAB
;ACCEPTS IN A/ POINTER TO DEVICE NAME STRING
; MUST BE CALLED NOINT
; CALL CNVSIX
;RETURNS +1: NO ROOM TO EXPAND DEVICE NAME STRING
; +2: A/ POINTER TO NEW DEVICE NAME STRING
CNVSIX::HRRZ B,0(A) ;GET SIZE OF STRING
CAIL B,3 ;LARGE ENOUGH FOR STRUCTURE NAME?
IFSKP.
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)
ENDIF.
HLRZ C,FILDEV(JFN) ;GET STRUCTURE UNIT NUMBER
MOVE C,DEVNAM+DVXST0(C) ;GET SIXBIT NAME
MOVSI D,(POINT 7,0,35) ;SET UP STRING POINTER
HRR D,A ;TO NAME STRING BLOCK
CNVSX1: SETZ B, ;CLEAR OUT CHARACTER
LSHC B,6 ;GET NEXT CHARACTER
JUMPE B,CNVSX2 ;NULL MEANS DONE
ADDI B,40 ;MAKE CHARACTER ASCII
IDPB B,D ;STORE IN STRING
JRST CNVSX1 ;LOOP BACK FOR REST OF WORD
CNVSX2: IDPB B,D ;STORE NULL AT END
RETSKP ;AND EXIT WITH POINTER IN A
;ROUTINE TO CHECK IF A DEVICE NAME IS LOGICAL NAME
;ACCEPTS IN A/ POINTER TO NAME STRING TO BE CHECKED
; CALL CHKLNM
;RETURNS +1: NOT A LOGICAL NAME, OR LOGICAL NAMES NOT ALLOWED
; +2: STRING IS A LOGICAL NAME,
; B/ -1 = LOGICAL NAME AND IT IS ALREADY ON CHAIN
; 0 = JOB WID LOGICAL NAME
; +1 = SYSTEM LOGICAL NAME
CHKLNM: MOVE B,FLAGS(TXT) ;GET FLAGS
TXNE B,NOLOGF ;LOGICAL NAME EXPANSION SUPPRESSED?
RET ;YES, DO NOTHING
CHKLN1: STKVAR <CHKLNS,CHKLNB>
HRLI A,(POINT 7,0,35) ;SET UP A STRING POINTER TO NAME
MOVEM A,CHKLNS ;SAVE STRING POINTER
MOVEI B,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL CHKCHN ;CHECK IF THIS LN IS ON CHAIN
JRST CHKLN2 ;NOT ON CHAIN NOW
CAMGE C,STPCNT(TXT) ;IS THIS A NEW LOGICAL NAME
JRST CHKLN4 ;NO, GO SEE IF SHOULD BE ADDED TO CHAIN
JUMPG A,R ;IF THIS IS A SYSTEM LN, EXIT NOW
CHKLN3: MOVE A,CHKLNS ;GET BACK STRING POINTER
CALLRET LNLUKS ;CHECK FOR SYSTEM LOGICAL NAME
CHKLN2: TQNE <PHYOF> ;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
;LNKLGJ - LOCAL VARIENT FOR GTJFN, SETS FLAGS
LNKLGJ: IFG. B ;SYSTEM LN?
SETONE SAWSLN ;YES, NOTE HAVE SEEN IT
ENDIF.
;.. ;FALL INTO COMMON ROUTINE
LNKLNM::STKVAR <LNKLNP,LNKLNI,LNKLNC,LNKLNS>
HRRZM C,LNKLNC ;SAVE ADDRESS OF CHAIN HEADER
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
IFSKP. <
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,.GJDIR(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
BLCAL. MDDOK,<<FILDEV(JFN)>> ;A MULTIPLE DIR DEVICE?
JRST DEFDI3 ;NO
LOAD B,FLUC,(JFN) ;GET STRUCTURE NUMBER
CALL DIRLKX ; Look it up
JRST DEFDI7 ; Failed
HRRM A,FILDDN(JFN)
CALL GTCSCD ;GET CONNECTED STR,,DIRECTORY
LOAD B,FLUC,(JFN) ;GET THE UNIQUE CODE OF THIS STR
HRLZS B ;BUILD A STR/DIR NUMBER
HRR B,FILDDN(JFN) ;GET DEFAULT AGAIN
CAMN A,B ;IS THIS THE SAME AS THE DEFAULT?
IFSKP.
CALL DEFDIT ;NO, THEN TYPE OUT DIR NAME IF DOING RECOGNITION
IFSKP. <AOS 0(P)> ;DO SKIP RETURN
ENDIF.
DEFDI3: NOINT
LOAD B,FLTSD,(JFN)
STOR B,FLDIR,(JFN) ; SAVE THE NAME IN THE JFN BLOCK
SETZRO FLTSD,(JFN)
OKINT
TQO <DIRF>
JRST RFALSE ;RETURN WITH A=0
DEFDI1: BLCAL. DSKOK,<<FILDEV(JFN)>> ;REAL DISK?
SKIPA ;NO
TQNE <ASTF> ;IS IT REAL JFN?
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 FLDIR
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,FLUC,(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,FLUC,(JFN) ;GET UNIQUE CODE OF STRUCTURE
LOAD B,JSUC ;GET CONNECTED STR #
CAME A,B ;GETTING FILE FROM CONNECTED STR/DIR?
JRST DEFDI6 ;NO, MUST GO LOOK UP THE DIR NUMBER
LOAD A,JSDIR ;YES, CAN USE THE DIR # FROM JSB
HRRM A,FILDDN(JFN) ;STORE DIR NUMBER
JRST DEFDI4 ;GO EXIT
;HERE IF DIRECTORY LOOKUP FAILED
DEFDI7: TQNE <ASTF> ;SCAN ONLY?
JRST DEFDI3 ;YES. GO HANDLE IT
TQNN <STRSF> ; Can we step the structure?
JRST [ MOVE B,A ;COPY RETURN STATUS FROM DIRLKX
MOVEI A,GJFX17 ;NO SUCH DIRECTORY
JUMPL B,R ;RETURN GJFX17 IF AMBIGUOUS RETURN FROM DIRLKX
JRST STEPLN] ;GO STEP LOGICAL NAME AND RETURN
NOINT ; Yes. Disallow ints
LOAD B,FLTSD,(JFN)
STOR B,FLDIR,(JFN) ; SAVE THE NAME IN THE JFN BLOCK
SETZRO FLTSD,(JFN)
OKINT
CALL DEVSTP ; Step the structure
JRST STEPLN ; Failed, try stepping the logical name
CALL GTCSCD ;GET CONNECTED STR,,DIRECTORY
LOAD B,FLUC,(JFN) ;GET THE UNIQUE CODE OF THIS STR
HRLZS B ;BUILD A STR/DIR NUMBER
HRR B,FILDDN(JFN) ;GET DEFAULT AGAIN
CAME A,B ;IS THIS THE SAME AS THE DEFAULT?
CALL DEFDIT ;NO, THEN TYPE OUT DIR NAME IF DOING RECOGNITION
SKIPA ; NOTHING HAS BEEN OUTPUT TO USER YET
AOS 0(P) ;SET UP FOR SKIP RETURN
TQO <DIRF>
JRST RFALSE ;RETURN WITH A=0
;ROUTINE TO PUT A DIR NAME STRING INTO THE JFN BLOCK
;ACCEPTS IN A/ POINTER TO DIRECTORY NAME BLOCK
; CALL STORDN
;RETURNS +1: FAILED TO GET SPACE FOR NAME OR NO SUCH DIR
; +2: OK, STRING POINTER PUT IN FLDIR(JFN)
STORDN::STKVAR <STODNA,STODNL>
EA.ENT
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,FLDIR,(JFN) ;GET POINTER TO EXISTING NAME STRING
JUMPE C,STODN1 ;IF ANY
HRRZS D,0(C) ;GET ITS LENGTH
CAMN B,D ;IS IT LONG ENOUGH FOR THE NEW NAME?
JRST STODN2 ;YES, USE IT
MOVEI A,JSBFRE ;NO, RELEASE IT
MOVE B,C ;GET ADR OF STRING
CALL RELFRE ;RELEASE IT
STODN1: NOINT ;DO NOT PERMIT INTERRUPTS DURING THE ASSIGN
MOVE B,STODNL ;GET THE COUNT OF WORDS NEEDED
CALL ASGJFR ;GET A BLOCK FOR THE DIR NAME
RETBAD (,<OKINT>) ;COULD NOT GET ROOM
STOR A,FLDIR,(JFN) ;REMEMBER THIS STRING IN THE JFN BLOCK
OKINT ;PERMIT INTERRUPTS AGAIN
STODN2: MOVE D,STODNA ;GET BACK POINTER TO NAME STRING
MOVE B,[POINT 7,0(D),34] ;GET A BYTE POINTER TO NAME STRING
LOAD A,FLDIR,(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:: BLCAL. MDDOK,<<FILDEV(JFN)>> ;A MULTIPLE DIR DEVICE?
RETSKP ;NO, THEN RETURN OK
SAVEP
LOAD A,FLDIR,(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,FLUC,(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
LOAD A,FLTSD,(JFN) ; GET TEMP STRING
STOR A,FLDMS,(JFN) ; TO MASK FIELD
SETZRO FLTSD,(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,FLDMS,(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: LOAD B,FLTSD,(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
IFSKP. <
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,.GJNAM(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
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
NOINT
LOAD B,FLTSD,(JFN)
SETZRO FLTSD,(JFN)
HRLM B,FILNEN(JFN)
OKINT
TQO <NAMF,NAMTF>
TQNN <NREC>
HRLI B,(<POINT 7,0,34>) ; SET UP BYTE POINTER
CALL TSTRQC ;(B) Output the default name
RETBAD() ;Error - invalid field length
AOS (P) ;Adjust for skip return
JRST RFALSE ;Return with A set to zero
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
LOAD A,FLTSD,(JFN) ; GET DEFAULT POINTER
STOR A,FLNMS,(JFN) ; TO MASK
SETZRO FLTSD,(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
MOVEM A,FILFDB(JFN) ;REMEMBER THE FDB ADDRESS
CALL STRNA1 ;FINISH UP
RETBAD ()
TQZ <EXTFF>
TQO <NAMF,NAMTF>
LOAD B,FLNMS,(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
IFNSK.
CAIE 1,GJFX23 ; DIRECTORY FULL?
JRST RFALSE ; NO, THEN SAY NO MATCH
RETBAD ; YES, THEN TELL CALLER THE REAL ERROR
ENDIF.
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
NOINT
LOAD B,FLTSD,(JFN)
SETZRO FLTSD,(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
SOS (P) ;Do not assume success return yet
CALL TSTRQC ;(B) Output the default extension
RETBAD() ;Error - invalid field length
AOS (P) ;Success so readjust for skip return
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
LOAD A,FLTSD,(JFN) ; GET DEFAULT POINTER
STOR A,FLEMS,(JFN) ; TO MASK FIELD
SETZRO FLTSD,(JFN) ; CLEAR OUT DEFAULT POINTER
OKINT
DFSTE2: CALL STREX1
RETBAD
TQO <EXTF> ;SAY SAW AN EXTENSION
LOAD B,FLEMS,(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
IFSKP. <
RETSKP> ; GOT ONE
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default if short form
XCTU [SKIPN A,.GJEXT(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
IFNSK.
HRRZ A,E
XCTU [HRRE A,.GJGEN(A)] ;NONE, Get USER DEFINED default version
ENDIF.
TQNE <TMPFF>
SKIPE A ;TEMPORARY AND WANT "DEFAULT"?
JRST DEFVR1
MOVE A,GBLJNO ; Default becomes global job number for temp
ADDI A,^D100000
JRST DEFVR2 ;GO DO IT
DEFVR1: SKIPN A
TQNN <OUTPF>
IFSKP. <
SOS A> ; 0 default becomes -1 for output
CAMN A,[-3] ;-3 MEANS *
IFNSK. ;[7.1014]
TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed?
TQNE <ASTF> ;[7.1014] * already seen?
SKIPA ;[7.1014] Allow it
RETBAD (GJFX31) ;[7.1014] No, give an error now
JRST DFSTRV ;[7.1014] Yes, default the version to *
ENDIF. ;[7.1014]
CAMN A,[-2] ;-2 MEANS LOWEST
TQO <LVERF>
CAMN A,[-1] ;-1 MEANS NEXT HIGHER
TQO <HVERF>
SKIPN A
TQO <RVERF>
;..
;..
DEFVR2: CALL GTVER ;[7.1014] (/A) Extant?
JRST STEPLN ;[7.1014] No, step logical name
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?
IFSKP. <
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
IFE. B ;ENDED WITH A NUL?
SETO B, ;YES, BACK UP THE BYTE POINTER ONCE
ADJBP B,A ;SO THE DATA FIELD APPEARS TO BE NULL
MOVE A,B
ENDIF.
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,FLATL,(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: LOAD A,FLTSD,(JFN) ;FIRST CHECK LEGALITY OF ATTRIBUTE
LOAD B,PFXVAL ;GET THE PREFIX VALUE
HRRZ C,DEV ;GET DISPATCH ADDRESS ONLY
SKIPN C ;IS THERE A DEVICE?
RETBAD (GJFX40) ;NO. INVALID ATTRIBUTES
CALL @ATRD(C) ;CALL DEVICE DEPENDENT MODULE FOR OK
RETBAD () ;ILLEGAL ATTRIBUTE FOR THIS DEVICE
NOINT ;DISALLOW INTERRUPTS
LOAD A,FLTSD,(JFN) ;PICK UP THE DATA STRING
SETZRO FLTSD,(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,FLATL,(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,FLATL,(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
IFSKP. <
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
ERJMPR [RETBAD ()] ;ERR CODE TO T1 AND RETURN FAIL
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,.GJACT(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
LOAD A,FLTSD,(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
LOAD A,FLTSD,(JFN) ; THE STRING POINTER
SETZRO FLTSD,(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
IFSKP. <
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,.GJPRO(A)] ; Get the default protection from user
RETSKP
DEFPR1: CAMG A,[6B2-1] ; Must be numeric
CAMGE A,[5B2]
IFSKP.
MOVEM A,FILPRT(JFN) ;NOT A STRING, SAVE IT AS IS
ELSE.
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
LOAD A,FLTSD,(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
LOAD B,FLTSD,(JFN) ;THE JSB SPACE
SETZRO FLTSD,(JFN)
MOVEI A,JSBFRE
CALL RELFRE ;FREE THE BLOCK
OKINT
ENDIF.
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 FLTSD (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: SAVEAC <TMP> ;Save the temporary AC
STKVAR <BYTSAV,STTSAV>
MOVEM B,TMP ;Save instruction to get bytes
REDFL1: XCT TMP ;Get a byte
MOVEM B,BYTSAV ;SAVE THE BYTE
MOVEM C,STTSAV ;SAVE THE POINTER
CALL GTCODE ;SEE IF VALID CHAR
RET ;NO
MOVE C,B ;GET THE BYTE INTO AC3
MOVE B,BYTSAV ;GET BACK THE BYTE
CAIN C,WILDC ; WILD CHARACTER?
JRST REDQST ; YES. GO DO IT
CAIN C,$QUOT ; Character quote?
JRST REDFL3
CAIN C,$STAR ;STAR?
JRST REDFST
CAIL C,DIGITC
CAILE C,LOWERA
CAIN C,MINUSC ;LOWER CASE LETTER OR MINUS?
JRST REDFL4 ;YES
CAIN C,$DOT ; DOT?
JRST REDFL4 ; YES, DOT IS LEGAL IN DIR NAMES AND ACCOUNTS
CAILE C,LOWER ; 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
IFSKP. <
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: LOAD A,FLTSD,(JFN)
MOVE B,C
CALL TRMBLK ; Trim the block and return excess
LOAD A,FLTSD,(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 TMP ;Get next byte
JRST REDFL2
REDFST: MOVX C,DWLDF ; SEE IF IT IS BECOMING WILD
CAIE D,MAXLC ; IS IT?
IORM C,FLAGS(TXT) ; YES. SAY SO
STARB: TQNN <ASTAF> ; STARS ALLOWED?
TQNE <ASTF> ;* ALREADY SEEN?
IFSKP. <
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
LOAD A,FLTSD,(JFN)
IFN. 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
SETZRO FLTSD,(JFN) ; NO STRING NOW
CALL RELFRE ;FREE IT UP
OKINT ;ALLOW INTS AGAIN
ENDIF.
MOVEI B,MAXLW+1
NOINT
CALL ASGJFR
RETBAD (GJFX22,<OKINT>) ; Insufficient space
STOR A,FLTSD,(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
BLCAL. DSKOK,<<FILDEV(JFN)>> ;DISK?
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 ENDSTX ; Terminate string, get lookup pointer
PUSH P,FILOPT(JFN) ; Save filopt(jfn) for typing out tail
BLCAL. MDDOK,<<FILDEV(JFN)>> ;A MULTIPLE DIR DEVICE?
JRST RECDI3 ; No. Do not update FILOPT for JFN
LOAD B,FLUC,(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 RECDI3 ; Yes. Do not update FILOPT for JFN
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,FLDIR,(JFN) ;STORE IT IN THE JFN BLOCK
OKINT ;UNLOCK FROM ENDTMP
POP P,B
TQNE <NREC> ;WANT RECOGNITION?
IFSKP.
CALL TSTRQ ;YES. TYPE OUT REST OF NAME
CALL BRKOUT ;OUTPUT THE PUNCTUAUTION
ENDIF.
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
RECDI3: 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 [ JN AMBGF,,DING ;IF AMBIGUOUS...
JUMPN A,R ;IF ERROR, RETURN NOW
MOVEI A,GJFX19 ;IF NO ERROR, STEP LOGICAL NAME
JRST STEPLN]
RETSKP
RECEXX: CALL ENDSTX ; Terminate string, get lookup pointer
PUSH P,FILOPT(JFN) ; Save filopt(jfn) for typing out tail
CALL EXTLUK ; Lookup extension
IFNSK. ;[7.1014] Extension lookup failed
POP P,FILOPT(JFN) ;[7.1014] Get FILOPT back
IFQN. AMBGF ;[7.1014] If ambiguous, recognize what we can
MOVE B,FILOPT(JFN) ;[7.1014] Our work string
CALL TSTRQ ;[7.1014] (B/) Do the work
RET ;[7.1014] Pass error back
ENDIF. ;[7.1014]
TQNE <OLDNF> ;[7.1014] If old file desired,
JRST RFALSE ;[7.1014] Go step logical name
RET ;[7.1014] Else return
ENDIF. ;[7.1014]
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 TSTRQC ;(B) Yes, output tail
RETBAD() ;Error - invalid field length
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
RETSKP
RECEX0: MOVE C,FILCNT(JFN)
CAME C,CNTWRD(TXT)
JRST RECEX1 ;HAVE PARTIAL STRING, GO RECOGNIZE
CALL DEFEXT ;TRY FOR DEFAULT VALUE FIRST
IFSKP. <
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 [ JN AMBGF,,DING ;IF AMBIGUOUS
JUMPN A,R ;IF ERROR, RETURN NOW
MOVEI A,GJFX19 ;EXTENSION NOT FOUND
RET]
RETSKP
; Recognize name
; This routine operates in the same way as recdir and recext above
RECNA0: TQNE <DEVF> ;SEEN A DEVICE YET?
IFSKP.
CALL DEFDEV ;NO, GO GET DEFAULTED DEVICE
IFSKP. <
RETSKP> ;DEVICE NAME WAS RECOGNIZED, STOP HERE
JUMPN A,[RETBAD ()] ;IF ERROR, EXIT
ENDIF.
TQNE <DIRF> ;SEEN A DIRECTORY YET?
IFSKP.
CALL DEFDIR ;NO, GO DEFAULT ONE
IFSKP. <
RETSKP> ;DIR WAS RECOGNIZED, STOP HERE
JUMPN A,[RETBAD ()] ;OTHERWISE EXIT
ENDIF.
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
IFNSK.
JUMPN A,R ;IF ERROR EXIT
MOVE C,FILCNT(JFN)
CAMN C,CNTWRD(TXT)
CALL DEFNAM
IFNSK.
JUMPE A,DING ;IF NO ERRORS, RING THE BELL
RETBAD ()
ENDIF.
ENDIF.
TQNN <NREC> ;DOING RECOGNITION?
TQNE <NNAMF>
RETSKP ;NO, DONT TYPE OUT "."
CHOUT "."
TQO <EXTFF>
RETSKP
RECNAM: CALL RECNA1
IFSKP. <
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 ENDSTX ; Terminate string, get lookup pointer
PUSH P,FILOPT(JFN) ; Save filopt(jfn) for typing tail
CALL NAMLUK ; Lookup name in directory
IFNSK. ;[7.1014] Name lookup failed
POP P,FILOPT(JFN) ;[7.1014] Get FILOPT back
IFQN. AMBGF ;[7.1014] If ambiguous,
MOVE B,FILOPT(JFN) ;[7.1014] Get working string
CALL TSTRQ ;[7.1014] (B/) Recognize all that we can
JRST RFALSE ;[7.1014] The return ambiguous
ENDIF. ;[7.1014]
TQNN <OLDNF> ;[7.1014] New files allowed?
TQNE <NREC> ;[7.1014] And trying to recognize?
JRST STEPLN ;[7.1014] Yes, go step logical name
JRST RFALSE ;[7.1014] No, return ambiguous
ENDIF.
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>
IFSKP.
CALL TSTRQC ;(B) Type remainder
RETBAD() ;Error - invalid field length
ENDIF.
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 ENDSTX ;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
ERJMPR [RETBAD ()] ;ERR CODE TO A AND RETURN FAIL
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
RETYPE: TMSG </
/>
SETZ C, ;A NULL
MOVE B,CURPNT(TXT) ; CURRENT TAIL POINTER
IDPB C,B ; TIE IT OFF
MOVE A,ARGCR(TXT) ;START OF IT ALL
PSOUT ; PRINT IT OUT
CALL SFCC0 ; BACK TO GTJFN STANDARDS
RET ;AND DONE
TYSTR1: SKIPN B ; NEED TO DO A STAR?
TYSTR: MOVEI B,[ASCIZ /*/]-1 ; YES
CALL TSTRB ; GO TYPE OUT WHAT IS IN B
RET
; Terminator seen, finish up
ENDCNF: TQOA <TCONF> ;SAW CONFIRMING TERMINATOR
ENDALL: TQZ <TCONF> ;SAW NON-CONFIRMING TERMINATOR
TQO <NREC> ; Suppress recognition
JRST ENDALZ
RECALL: CALL BACKIT ;ZAP THE RECOGNITION CHARACTER
MOVX A,SAWALT ;SAY SAW AN ALTODE
IORM A,FLAGS(TXT) ;REMEMBER THIS IN FLAG WORD
TQZ <TCONF> ;NO CONFIRMATION SO FAR
TQZ <NREC> ;INSURE WE WILL DO RECOGNITION
ENDALZ: HRRZ A,FILDEV(JFN) ;Disallow use of device NFT: -
CAIN A,NFTDTB ; using device NFT AND
TQNE NODEF ; no node in file spec ?
IFSKP.
TQNE <ASTF> ;yes. parse only ?
IFSKP.
MOVEI T1,GJFX16 ;no. force failure. (NO SUCH DEVICE)
JRST ERRDO
ENDIF.
SETZM FILDEV(JFN) ;yes. clear device field in JFN block
ENDIF.
TQNN <STARF>
IFSKP.
CALL [ TQNE <DIRFF> ;COLLECTING DIRECTORY?
IFSKP.
TQNN <NAMF>
CALLRET ENDNA3
CALLRET ENDEX8
ELSE.
CALL ENDDIR ;YES. GO FINISH IT UP
RET ;FAILED
TQNN <NREC> ;DOING RECOGNITION?
CALL BRKOUT ;YES. OUTPUT TERMINATOR
RETSKP ;DONE
ENDIF.]
JRST [ JUMPL A,GTJFST ; IF <0, LN WAS STEPPED
JRST ERRDO] ; ELSE, NO STEP
ENDIF.
;..
;..
MOVE C,FILCNT(JFN)
TQNN <DIRFF> ;COLLECTING A DIRECTORY?
CAME C,CNTWRD(TXT) ; Is input string NON-null?
IFNSK.
TQNN <NREC> ;YES. DOING RECOGNITION?
TXNN F1,STRSF!DIRSF!NAMSF!EXTSF!VERSF ;YES. SEEN A STAR?
IFSKP.
TQNE <EXTF> ;YES, GOT EXTENTION FIELD YET?
IFSKP.
CALL DING ;NO, RETURN AMBIGUOUS
MOVEI A,0
JRST GTJF2
ENDIF.
ENDIF.
CALL RECFL0
IFNSK.
JUMPE A,GTJF2 ; AMBIGUOUS
JUMPG A,ERRDO ; ERROR
TQNE <ASTF> ; PARSE ONLY?
JRST ENDAL4 ; YES, CONTINUE
JRST GTJFST ; RETRY - LOGICAL NAME WAS STEPPED
ENDIF.
ENDIF.
;..
;..
MOVE C,FLAGS(TXT) ;SEE IF GETTING AN ATTRIBUTE
TXNN C,ARBATF ;...
IFSKP.
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
ENDIF.
TQNE <NAMF,NNAMF> ; Do we have a name?
IFSKP.
CALL DEFNAM ; No, try the default name
IFNSK.
JUMPL A,GTJFST ; LN WAS STEPPED, GO RETRY
JUMPG A,ERRDO ; ERROR OCCURED
CALL RECNAM ; NO DEFAULT, SEE IF A NO-NAME DEVICE
IFNSK.
JUMPE A,GTJF2 ; GO GET MORE FROM USER
JUMPG A,ERRDO ; ERROR
TQNE <ASTF> ; PARSE ONLY?
JRST ENDAL4 ; YES - DON'T RETRY STEPPED LOGICAL NAME
JRST GTJFST ; RETRY - LOGICAL NAME WAS STEPPED
ENDIF.
ENDIF.
ENDIF.
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
TQNE <VERF> ; Do we have a version?
IFSKP.
CALL DEFVER ; No, default it
IFNSK.
JUMPGE A,ERRDO ;ERROR
CALL STOALT ;LN WAS STEPPED, PUT ALTMODE BACK IF NEEDED
JRST ERRDO ;ERROR ENCOUNTERED
JRST GTJFST ;GO REPROCESS THE COMMAND
ENDIF.
ENDIF.
TQNE <NEWF,NEWVF>
IFSKP.
TQNN <ASTF> ; Parse-only?
JRST ENDAL7 ; No, continue
ENDIF.
TQNE <PRTF> ; Do we have protection?
IFSKP.
CALL DEFPRT ; No, default it
JRST ERRDO
ENDIF.
TQNE <ACTF> ; Do we have an account?
IFSKP.
CALL DEFACT ; No, default it
JRST ERRDO
ENDIF.
ENDAL7: CALL DEFATR ;GET SET UP ANY DESIRED ATTRIBUTES
JRST ERRDO ;FAILED
ENDL77: TQNN <TCONF> ;ALREADY CONFIRMED?
TQNN <PONFF> ;OR NO PRINT REQUESTED?
JRST ENDAL3 ;YES, DON'T PRINT O.F., N.F., ETC.
TQNN <ASTF> ;NOT PARSE ONLY?
TQNE <NREC> ;RECOGNITION?
JRST ENDAL3 ;NO, NO MESSAGE
HRROI B,[ASCIZ / !Old file!/]
TQNN <NVERF>
HRROI B,[ASCIZ / !Old generation!/]
TQNE <NEWVF> ; Did we generate a new version?
HRROI B,[ASCIZ / !New generation!/]
TQNE <NEWF> ; Did we generate a new file
HRROI B,[ASCIZ / !New file!/]
TQNN <NNAMF>
JRST ENDAL9
HRROI B,[ASCIZ / !OK!/]
TQNE <CFRMF>
HRROI B,[ASCIZ / !Confirm!/]
;..
;..
ENDAL9: TXNN F1,DIRSF!NAMSF!EXTSF!VERSF
CALL [ TQNN <JFNRD> ;HAVE AN EXTENDED BLOCK?
CALLRET TSTR1 ;NO. PRINT BUT DON'T PUT IN BUFFER
HRRZ A,E
UMOVE A,11(A) ;YES. GET FLAGS
TQNN <CFRMF> ;WANT CONFIRMATION?
TXNN A,G1%RCM ;NO. WANT THE MESSAGE?
CALLRET TSTR1 ;DON'T PUT IN BUFFER
CALLRET TSTR] ;PUT IT IN THE BUFFER
ENDAL3: CALL INFTST ;SEE IF WE HAVE A FILE
JRST ENDAL2 ;NO. GIVE THIS UP
TQNN <TCONF> ;CONFIRMATION ALREADY GIVEN?
TQNN <CFRMF>
JRST ENDAL2 ; Or no confirmation requested
ENDL33: BIN ; Else read confirmation character
IDIVI B,^D36/CCSIZE
LDB B,CPTAB(C) ; Get character class
CAIN B,CARRET ; IGNORE?
JRST ENDL33 ;YES. GO GET ANOTHER
CAIN B,CONTR
JRST [ CALL RETYPE ; DO LOGICAL TYPE OUT
JRST ENDL77] ; GO DO CONFIRM AGAIN
CAIE B,SPACE ;SPACE
CAIN B,ALTMOD ;OR ESC?
JRST [ CALL DING ;DON'T CONFIRM, BUT DON'T ABORT EITHER
JRST ENDAL3] ;TRY AGAIN
CAIE B,COMMA ;CONFIRMATION CHARACTER?
CAIN B,TERMS ;IN EITHER CLASS
JRST ENDAL2 ; Is ok
CAIE B,CONTU
CAIN B,EDTCHR ; CHARACTER EDITING BYTE?
IFSKP. <
ERRLJF GJFX15> ; Improper confirmation
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
CALL RETYPE ;RETYPE EDITED FILESPEC
JRST MRTEXT ;AND GO GET SOME MORE INPUT
ENDAL2: TQNE <NEWVF,NEWF> ;NEW FILE OR NEW VERSION?
SKIPN FILFDB(JFN) ;SET ACCOUNTING, ETC. IF FDB WAS CREATED
JRST ENDALS ;NO, DON'T INSERT PROTECTION, ETC. INTO DIRECTORY
PUSH P,E ; SAVE E
HRRZ E,DEV
TQNE <PRTF> ; Do we have a protection?
CALL @PLUKD(E) ; Insert it into the directory
TQNE <ACTF> ; Do we have an account string?
IFSKP.
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
ENDIF.
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,E ;SEE IF REAL DISK
POP P,E ;RESTORE E
BLCAL. DSKOK,<A> ;REAL DISK?
IFSKP. <
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
SETZM FILPRT(JFN) ; AND PROTECTION WORD
ENDLS1: HRRZ B,FILTMP(JFN)
SKIPE B
CALL RELFRE ; And temp
LOAD B,FLTSD,(JFN)
SKIPE B
CALL RELFRE
HLRZ B,FILLNM(JFN) ;RDTXT BUFFER
SKIPE B ;ONE AROUND?
CALL RELFRE ;YES. ZAP IT.
HRRZS FILLNM(JFN) ;CLEAR OUT POINTER TO RDTXT BUFFER
SETZM FILTMP(JFN)
SETZM FILOPT(JFN)
SETZM FILCNT(JFN)
AND STS,[XWD 100,0] ; Retain astf
IOR STS,FILSTS(JFN) ; Get rest of sts
TQZ <ASGF,FILINP,FILOUP>; CLEAR ASSIGN AND I/O FLAGS
TQO <NAMEF> ; Set name attached flag
TQNE <NACCF>
TQO <FRKF>
MOVEM STS,FILSTS(JFN)
SETZRO ASGF2,(JFN) ;[7384]CLEAR ASGF SHADOW BIT
OKINT
CALL ENDINF ;RESTORE INPUT FILES
MOVE A,JFN ; GET JFN
IDIVI A,MLJFN ; CONVERT BACK TO USER INDEX
MOVE JFN,A ; PUT IT BACK IN JFN
TXNN F,ASTAF+OSTRF+RLHFF ;RETURN LH FLAGS?
JRST ENDA51 ;NO
TQNE <PRTTF> ;IF ;P SPECIFIED,
TQO <FXPRT> ;SAY SO
TQNE <ACTTF>
TQO <FXACT>
TQNE <TMPTF,TMPFF>
TQO <FXTMP>
HLL JFN,F1 ;GET FLAGS TO RETURN
TXZ JFN,STEPF+STARF+DFSTF+TCONF+EXTXF+IGIVF ;CLEAR FLAGS NOT RETURNED
TQNN <IGDLF>
TXO JFN,GJ%GND ; Not seeing deleted files
TQNN <IGIVF>
TXO JFN,GJ%GIV ; Not seeing invisible files
TQNE NODEF
TXO JFN,GJ%NOD ; Saw a node name in file spec
;..
;..
ENDA51: TQNN <OSTRF> ;Real file
TQNN <NODEF> ; AND saw node name ?
IFSKP.
CALL DIMLNK ;yes. establish link to remote FAL
JRST ERRDO ;failure.
ENDIF.
UMOVEM JFN,1 ; Return jfn to user
TQNN <ASTF> ; REAL JFN?
TXNN JFN,STRSF!NAMSF!EXTSF!DIRSF!VERSF ;DOING ANY STARS?
SMRETN ; NO. RETURN NOW
HRRZS JFN ; GET ONLY JFN PART
CALL CHKJFN ; LOCK UP THE JFN
RETERR () ; SOMETHING BAD HAPPENED
SMRETN ; TTY AND STRING ALWAYS OK
SMRETN ; ""
BLCAL. DSKOK,<NUM> ;SEE IF REAL FDB PRESENT, i.e. real disk
JRST ENDL58 ;ISN'T
CALL GETFDB ; FIND FDB FOR THE FILE
JRST ENDL56 ; NOT THERE. STEP IT THEN
PUSH P,A ; SAVE THE FDB ADDRESS
MOVX B,FC%DIR ; CHECK FOR LIST ACCESS
CALL ACCCHK ; DO IT
JRST ENDL57 ; NOT ACCESSIBLE. GO STEP IT
MOVE A,0(P) ; GET BACK THE FDB ADDRESS
CALL COMACT ; COMPARE THE ACCOUNT STRING
JRST ENDL57 ; DID NOT MATCH, GO STEP TO NEXT FILE
POP P,A ; CLEAN UP STACK
CALL USTDIR ; FREE UP DIR
ENDL58: CALL UNLCKF ; AND THE FILE
SMRETN ; RETURN GOOD
ENDL57: POP P,A ; CLEAN UP THE STACK
CALL USTDIR ; FREE UP DIR
ENDL56: CALL UNLCKF ; AND THE FILE
UMOVE A,A ; GET BACK JFN AND FLAGS
GNJFN ; STEP TO FIRST GOOD ONE
RETERR (GJFX32) ; NO MATCH
SMRETN ; FOUND IT
;HERE IF HAVE NO DEFAULT EXTENSION
ENDAL6: TQNE <NREC> ; NOT DOING RECOGNITION?
TQNN <EXTFF> ; AND SPECIFIED NULL EXTENSION?
IFSKP. <
JRST ENDL6A> ; YES. LET HIM GET NULL EXTENSION THEN
MOVEI B,"."
TQNN <NNAMF>
TQNE <NREC>
JRST ENDL6B
TQON <EXTFF> ;EXTENSION STARTED YET?
CALL OUTCH ;NO, TYPE OUT A DOT
ENDL6B: CALL DEFEXT ;FIRST SEE IF DEFAULT EXISTS
IFSKP. <
JRST ENDAL4> ;YES. USE IT
JUMPN A,ERRDO ;IF BAD NEWS, BOMB OUT
CALL GETDEX ;GO SEE IF THERE IS A DEFAULT EXTENSION
JRST ENDL6C ;NONE SPECIFIED
MOVEI A,GJFX19 ;SET UP ERROR CODE
CALL STEPLN ;STEP TO NEXT LN
JUMPGE A,ERRDO ;FAILURE OR NO MORE LOGICAL NAMES
CALL STOALT ;GO PUT ALTMODE BACK IN BUFFER
JRST ERRDO ;ERROR OCCURED
JRST GTJFST ;GO START OVER AGAIN
ENDL6A: CALL RECEXX ;SEE IF AN EXT CAN BE RECOGNIZED
IFSKP. <
JRST ENDAL4>
IFQN. AMBGF ;NO, FAILURE OR AMBIGUOUS
CALL DING ;AMBIGUOUS, DING AND TRY FOR MORE
JRST GTJF2
ENDIF.
JUMPL A,GTJFST ;LOGICAL NAME WAS STEPPED
JUMPG A,ERRDO ;AN ERROR WAS ENCOUNTERED
MOVEI A,GJFX19 ;SET UP ERROR CODE
CALL STEPLN ;STEP THE LOGICAL NAME IF ANY
JUMPL A,GTJFST ;LOGICAL NAME WAS STEPPED
JRST ERRDO ;LOGICAL NAME NOT STEPPED, BOMB OUT
ENDL6C: JUMPN A,ERRDO ;IF ERROR, GO BOMB OUT
TXNN F1,DIRSF!NAMSF ;THIS FOLLOWING A STAR?
JRST ENDL6A ;OTHERWISE GO RECOGNIZE
TQNE <NREC> ;DOING RECOGNITION?
ERRLJF (GJFX19) ;NO. GO COMPLAIN ABOUT THIS CASE THEN
CALL DING ;YES. REFUSE TO DO ANY MORE
JRST GTJF2 ;AND PROCEED IN-LINE
; Star typed
STAR: CALL DPST ; SAVE BYTE
RETBAD() ; CANT DO IT
MOVE A,FILCNT(JFN) ;[7.1014] Allow *'s so *? can give directory listing
MOVE B,CNTWRD(TXT) ;GET MAX VALUE
CAIN A,-1(B) ; HAVE SOMETHING ALREADY?
TQNE <STARF> ; ALREADY SEENA STAR?
IFNSK.
MOVX A,WLDF ; YES. IT IS WILD THEN
IORM A,FLAGS(TXT) ;REMEMBER THIS
TQNE <NUMFF> ;COLLECTING A NUMBER?
RETBAD (GJFX4) ;YES. GIVE AN ERROR THEN
ENDIF.
STAR2: TQNE <OSTRF>
TQO <ASTF> ; Set * bit in sts
TQO <STARF>
RETSKP
PCENT: TQNE <NUMFF> ;[7.1014] FOR WILD CHARS. ON A NUMBER?
RETBAD (GJFX4) ; YES. ILLEGAL CHARACTER THEN
CALL DPST ; SAVE BYTE
RETBAD() ; NO ROOM
MOVX A,WLDF ; FOR FLAGS
IORM A,FLAGS(TXT) ;REMEMBER WILD CHAR SEEN
CALLRET STAR2 ; GO DO THE * STUFF
;[7.1014]
; The following routines handle user question mark input. This is entered
; from the input char dispatch table. If the input is NIL, this will return
; immediately. Otherwise, list the candidates for the field currently being
; entered if no previous field had a wild card. If no candidates are found,
; break with GJFX34. Scan for candidates is terminated on last one.
;
;QUEST - Routine dispatched to when "?" is seen.
;
; Called with:
; TEXTI% context setup
; CALL through dispatch table when "?" is seen
;
; Returns:
; +1 - Always
QUEST: MOVE A,CURCNT(TXT) ;Get current string
AOS A ;Move one past (should be a null)
CAML A,STRCNT(TXT) ;Was "?" first thing typed?
ERRLJF GJFX34 ;Yes, then break on it
TQNE <OSTRF> ;GJ%OFG, parse only?
TQNE <ASTAF> ;GJ%IFG, normal indexable bit?
SKIPA ;No to either
ERRLJF GJFX34 ;GJ%OFG and not GJ%IFG, this prevents a loop
CALL INFTST ;(/A) Test for no input JFN
ERRLJF GJFX34 ;None so break out now
MOVEI A,.CHNUL ;Erase the "?"...
DPB A,CURPNT(TXT) ;...by overwriting it with a null
MOVE B,LDPNT(TXT) ;Save TEXTI% context by putting
MOVEM B,LDPTMP ; these variables in the TRVAR
MOVE B,LDCNT(TXT)
MOVEM B,LDCTMP
MOVE B,CURPNT(TXT)
MOVEM B,CRPTMP
MOVE B,CURCNT(TXT)
MOVEM B,CRCTMP
TQNN <DEVF> ;Device specified
CALL DEFDEV ;(/DEV) No, so get default
HRRZ B,FILDEV(JFN) ;Has to be some flavor of DSK:
CAIE B,DSKDTB ;On disk?
JRST QUEST2 ;Nope, ding user and restart
TQO <NREC> ;Turn off recognition
TQNE <EXTFF> ;Extension being specified?
CALLRET QEXTN ;Yes
TQNN <NAMF> ;Name specified?
CALLRET QNAM ;No, must be entering it
TQNN <VERF> ;Version specified?
CALLRET QVER ;No, must be entering it
JRST QUEST3 ;Must be in STR or DIR field, no help
QUEST2: CALL DING ;(/) Can't help in any later fields
QUEST3: MOVE A,CRCTMP ;Now restore TEXTI% context from TRVAR
MOVEM A,CURCNT(TXT)
MOVE A,CRPTMP
MOVEM A,CURPNT(TXT)
MOVE A,LDCTMP
MOVEM A,LDCNT(TXT)
MOVE A,LDPTMP
MOVEM A,LDPNT(TXT)
MOVE A,MPP ;Get saved stack pointer
MOVE A,0(A) ;Find out what is there
TXNE A,IMCFLG ;Last call internal?
ERRLJF (GJFX34) ;Yes, return illegal "?" error to COMND%
CALL RETYPE ;(/) Retype the input text
CALL BACKIT ;(/) Backup over the NUL (was the "?")
; CALLRET RESCAN ;Re-establish TEXTI% context
;RESCAN - Routine to initiate a rescan of the user's input.
;The JFN block is initialized.
;
; Call with:
; TESTI% arguments setup
; CALL RESCAN
;
; Returns:
; +1 - Error,
; A/ Error code
; +2 - Success, String retyped on screen
RESCAN: STKVAR <TMPFLN> ;Save TEXTI% buffer here
NOINT ;Touching sensitive things
HLRZ A,FILLNM(JFN) ;Preserve TEXTI% buffer info
MOVEM A,TMPFLN ; in this location
HRRZS FILLNM(JFN) ;Now make believe it isn't there
CALL RELJFN ;(JFN/) Go cleanup
CALL ASGJFN ;(/JFN) Go get another JFN
IFNSK.
MOVEI A,JSBFRE ;None left
SKIPE B,TMPFLN ;If there is something to release,
CALL RELFRE ;(B/) The release it
ERRLJF GJFX3 ;Return error to user
ENDIF.
MOVE A,TMPFLN ;Setup old retype stuff
HRLM A,FILLNM(JFN)
OKINT ;Now we can be interrupted
XCTU [HLLZ F,0(E)] ;Get user flags again
SETZ F1, ; and clear others
MOVE A,STRPNT(TXT) ;Reinitialize pointer to input string
MOVEM A,LDPNT(TXT)
SETZM LDCNT(TXT) ;Zap input count
CALL SETTMP ;(JFN/) Get another temp block and continue
RETBAD() ;Something is wrong
RETSKP ;Return to GCH loop
;[7.1014]
;QNAM - Routine that is called when a question mark has been entered
;in the file name part of the file spec. This routine is the first
;step when printing out a list of candidates for the name field.
;
; Call with:
; TEXTI% arguments setup
; CALLRET QNAM
;
; Returns:
; JRST QUEST3 - When finished
QNAM: TQNN <DIRSF> ;Any directory *'s?
CALL QSNAM ;(/) No, append star and find first file
IFSKP. ;If first one found
DO. ;Loop through all candidates
LOAD A,FLNSB,(JFN) ;Print this name
CALL QNXTL ;(A/) Do the printing
CALL QVNAM0 ;(A/) Now look for next name
EXIT. ;No more, retype
LOOP. ;Do next candidate
ENDDO.
ENDIF.
JRST QUEST3 ;No directory match
;[7.1014]
;QEXTN - Routine that is called when a question mark has been entered
;in the extension part of the file spec. This routine is the first
;step when printing out a list of candidates for the extension field.
;
; Call with:
; TEXTI% arguments setup
; CALLRET QEXTN
;
; Returns:
; JRST QUEST3 - When finished
QEXTN: TQNN <DIRSF,NAMSF> ;Any directory or name *'s?
CALL QSEXT ;(/) No, append star and find first file
IFSKP. ;If first one found
DO.
LOAD A,FLESB,(JFN) ;Print this name
MOVE B,1(A) ;Look at the first word of the string
TLNE B,774000 ;Is first character a NUL?
IFSKP. ;It is null
MOVEI A,[ASCIZ /[Null]/] ;It is, so make dummy entry
SOS A ;Set up as string block
ENDIF.
CALL QNXTL ;(A/) Print out string
CALL QVEXT0 ;(A/) Now look for next extension
EXIT. ;None left, retype
LOOP. ;Do next candidate
ENDDO.
ENDIF.
JRST QUEST3 ;Stars somewhere or no match
;[7.1014]
;QVER - Routine that is called when a question mark has been entered
;in the version part of the file spec. This routine is the first
;step when printing out a list of candidates for the version field.
;
; Call with:
; TEXTI% arguments setup
; CALLRET QVER
;
; Returns:
; JRST QUEST3 - When finished
QVER: TQNN <DIRSF,NAMSF,EXTSF> ;Any dir, name, or extension *'s?
CALL QSVER ;(/) No, make it a star and find first file
IFSKP. ;If found first file
DO. ;Now loop through all versions
TMSG </
/> ;Make it neat
LOAD B,FLVNO,(JFN) ;Get version number
CALL DNOUT ;(B/) Print decimal version
CALL QVVER0 ;(/) Now get next version
EXIT. ;None left, retype
LOOP. ;Do next version
ENDDO.
ENDIF.
JRST QUEST3 ;Stars seen or no match
;[7.1014]
;The following routines are for stepping the name, ext and version fields
;and assuring that at least one file is accessible with the new field
;value.
;
; Called with:
; no arguments
; CALL QVNAM (to find first one)
; CALL QVNAM0 (when current name is being stepped)
; or
; CALL QVEXT (to find first one)
; CALL QVEXT0 (when stepping current extension)
; or
; CALL QVVER (to find first one)
; CALL QVVER0 (when stepping current version)
;
; Returns:
; +1 - No file found
; A/ Error code
; +2 - Success, file found
; With FLNSB(JFN) setup or
; With FLESB(JFN) setup or
; With FLVNO(JFN) setup
QVNAM: SETZ A, ;Find first name in this directory
JRST QVNAM1
QVNAM0: LOAD A,FLNSB,(JFN) ;Step the current name
CALL LKPTR ;(A/A) Need a lookup ptr
QVNAM1: TQO <NAMSF,STEPF> ;Flag that we are stepping
CALL NAMLKX ;(A/A,B) Find next name
RETBAD() ;Match is impossible
NOINT ;Match found
HRRZ A,FILTMP(JFN) ;Got one, exchange old name block
LOAD B,FLNSB,(JFN) ; and new one
STOR A,FLNSB,(JFN)
HRRM B,FILTMP(JFN)
OKINT ;Done touching sensitive areas
CALL SETTMP ;(JFN/) Now reinitialize FILTMP ptr
RETBAD() ;Error
CALL QVEXT ;(/) Now look for acceptable extension and version
JRST QVNAM0 ;None for this name, step it
RETSKP ;Got one, return
; Step extension field
QVEXT: SETZ A, ;Find first extension, this name
JRST QVEXT1
QVEXT0: LOAD A,FLESB,(JFN) ;Step current extension
CALL LKPTR ;(A/A) Need a lookup pointer
QVEXT1: TQO <EXTSF,STEPF> ;Note that we are stepping
CALL EXTLKX ;(A/A,B) Find next one
RETBAD() ;Pass error back
NOINT ;Can't be interrupted
HRRZ A,FILTMP(JFN) ;Got file, exchange old ext block
LOAD B,FLESB,(JFN) ; and new one
STOR A,FLESB,(JFN)
HRRM B,FILTMP(JFN)
OKINT ;Back to normal
CALL SETTMP ;(JFN/) Reinitialize FILTMP
RETBAD() ;Error
CALL QVVER ;(/) Now look for acceptable version
JRST QVEXT0 ;None for this ext, step to next
RETSKP ;Got one
; Step version field
QVVER: SETZ A, ;Find the first version
JRST QVVER1
QVVER0: LOAD A,FLVNO,(JFN) ;Step current version
QVVER1: TQO <VERSF,STEPF> ;Note stepping version
CALL GTVER ;(A/) Find next one and check access
RETBAD() ;There ain't one
RETSKP ;Found one
;GTVER - Routine to locate a file version
;
; Call with:
; A/ Desired version number
; Assumes F, F1, DEV, JFN, & STS are setup
; CALL GTVER
;
; Returns:
; +1 - Error, file not found
; +2 - Success,
; A/ version number
GTVER: HRRZ B,DEV ;Get device
HRRZ B,NLUKD(B) ;Check for some flavor of DSK:
CAIN B,MDDNAM ;If not MDD device,
JRST GTVER1 ; don't call USTDIR
CALL VERLUK ;(B/B) Find file but don't lock
RET ;Not found, return to caller
GTVER0: TQO <VERF,VERTF> ;Show version found
HRRM A,FILVER(JFN) ;And put it in JFN block in JSB
RETSKP ;Done
GTVER1: CALL VERLKX ;(B/B) Lookup requested version
RET ;Not there
MOVEM B,FILFDB(JFN) ;Remember FDB address
TQNE <ASTF> ;If output stars, then nothing really done
JRST GTVER0 ;Save the version and return
MOVE A,B ;Copy FDB address
PUSH P,.FBGEN(A) ;Save version number too
TQNE <DIRSF,NAMSF,EXTSF,VERSF> ;Stepping anything?
TQNE <NEWF,NEWVF> ;New file or version?
JRST GTVER2 ;New file or not stepping
MOVX B,FC%DIR ;Flag
CALL ACCCHK ;(A,B/) No, do directory list access check
JRST GTVER3 ;Bad news, see if we can try another
GTVER2: TQO <VERF,VERTF> ;Show version found and typed
POP P,A ;Recover version number
HLRZS A
STOR A,FLVNO,(JFN) ;And store it
CALL USTDIR ;(/) OK, release the directory
RETSKP ;And return
GTVER3: CALL USTDIR ;(/) Invalid access, release the directory
POP P,A ;Recover version
HLRZS A
TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;Stepping anything?
RET ;No, just return
TQO <STEPF> ;Yes, step to next file
TQNE <RVERF> ; after installing right target version
SETZ A, ;Get highest version only
TQNE <HVERF> ;Highest only?
MOVEI A,-1 ;No, want all
TQNE <LVERF> ;Lowest only?
MOVEI A,-2 ;Yes, flag it
JRST GTVER ;Now go try it
;[7.1014]
;QSNAM, QSEXT, QSVER - Routines that append a * to the field currently
;being entered and fakes *'s for the remaining fields. It aids in
;the "?" when parsing a file. There are 3 entry points as noted below.
;
; Call with:
; no arguments
; CALL QSNAM - name being entered (returns nam*.*.*)
; CALL QSEXT - extension being entered (returns nam.ext*.*)
; CALL QSVER - version being entered (returns nam.ext.*)
;
; Returns:
; +1 - Error, no files can be recognized
; +2 - Fake input fields setup
QSNAM: CALL QSTAR ;(/) Stuff a * in name
CALL ENDNAM ;(/) Punctuate name field with "."
RET ;Couldn't do it
QSEXT: CALL QSTAR ;(/) Stuff * in extension
CALL ENDEX7 ;(/) Punctuate this field
RET ;Shucks
QSVER: CALL QSTAR ;(/) Jam a * in version
CALL ENDEX7 ;(/) and find version
RET ;Non-existant
RETSKP ;Done
;[7.1014]
;QSTAR - This routine stuffs a * in for the user (aids in "?" whilest
;parsing a filename).
;
; Call with:
; partial input in TEXTI% buffers
; CALL QSTAR
;
; Returns:
; +1 - Always, * stuffed in input buffers & old file flag set
QSTAR: MOVEI A,"*" ;This character
TQO <STARF> ;Note * seen
CALL LTR ;(A/) Put * in FILTMP and set WLDF
RETBAD() ;Couldn't do it
TQO <ASTAF,OLDNF> ;* allowed, old file only
TQZ <OUTPF,NEWNF> ;Old files only!
TQZ <ASTF> ;Clear bit possibly set due to OSTRF
RET ;Fini
;[7.1014]
;QNXTL - Routine to print out a candidate string
;
; Call with:
; A/ Address of string block
; CALL QNXTL
;
; Returns:
; +1 - Always
;
; Clobbers A,B,C
QNXTL: STKVAR <TMPA> ;Place to save A
MOVEM A,TMPA ;Hold onto address of string block
TMSG </
/> ;Neatness counts
MOVE B,TMPA ;Retrieve address of string block
HRROI B,1(B) ;Now convert it into string pointer
CALLRET TSTR1 ;Output string, but don't put in buffer
;[7.1014]
;LKPTR - Routine to compute a lookup pointer for a string block
;
; Call with:
; A/ Address of block
; CALL LKPTR
;
; Returns:
; +1 - Always with A/ lookup pointer (-# words,,first word-1)
;
; Clobbers A,B,C
LKPTR: HRRZI B,1(A) ;Address of start of string
HRLI B,(POINT 7,) ;Make it a pointer
LKPTR0: ILDB C,B ;Find end of string
JUMPN C,LKPTR0
HRRZ C,A ;Start of block
SUBI C,-1(B) ;-Number of words
HRL A,C ;Make A and IOWD
RET ;And away we go
; Set up temp string block for this jfn
; Call: JFN IN JFN
; JSYS SETTMP
; Sets up filopt(jfn) and rh(filtmp(jfn)) and filcnt(jfn)
; Clobbers a,b,c
; Clears num
SETTMP: HRRZ A,FILTMP(JFN) ; Is block assigned?
JUMPN A,SETTM1 ; Yes, use it
MOVEI B,MAXLW+1
NOINT
CALL ASGJFR ; Assign a free storage area in psb
RETBAD (GJFX22,<OKINT>) ; No room
HRRM A,FILTMP(JFN) ; Save in tmpptr
OKINT
SETTM1: HRLI A,(<POINT 7,0,35>)
MOVEM A,FILOPT(JFN) ; Set filopt(jfn)
MOVEI A,MAXLC
CALL TSTLNG ;ALLOWING LONG NAMES
IFNSK. ;IF NOT,
MOVEI A,MAXSHT ;GET MAX SIZE FOR A NAME THEN
TQNE <EXTFF> ;ABOUT TO COLLECT AN EXTENSION?
MOVEI A,MAXEXT ;YES. USE MAX SIZE OF AN EXTENSION THEN
ENDIF.
MOVEM A,FILCNT(JFN)
MOVEM A,CNTWRD(TXT) ;REMEMBER THIS
MOVEI NUM,0 ; Clear number
TQZ <NEGF>
RETSKP
;ROUTINE TO PUT AN ALTMODE BACK INTO THE INPUT BUFFER
;RETURNS +1 IF ERROR
;RETURNS+2 WITH ALTMODE IN BUFFER IF RECOGNITION WAS BEING DONE
STOUAL: SKIPA A,[SAWALT!SAWF] ;LOOK FOR EITHER IF ENTERED HERE
STOALT: MOVX A,SAWALT ;SEE IF SAW AN ALTMODE
TDNN A,FLAGS(TXT) ;DID WE?
RETSKP ;NO, RETURN IMMEDIATELY
ANDCAM A,FLAGS(TXT) ;YES. TURN IT OFF NOW
LDB A,CURPNT(TXT) ;GET LAST CHAR IN BUFFER
CAIN A,.CHESC ;IS IT AN ALTMODE?
RETSKP ;YES, ALL THROUGH
MOVEI A,.CHESC ;NO, PUT AN ALTMODE IN
SOSG CURCNT(TXT) ;IF THERE IS ROOM
RETBAD (GJFX51) ;NO ROOM
IDPB A,CURPNT(TXT) ;PUT ALTMODE IN BUFFER
MOVEI B,0 ;END WITH NULL
MOVE C,CURPNT(TXT)
IDPB B,C ;DONT UPDATE BYTE POINTER
RETSKP ;AND EXIT
; Get character from string OR file
; Call: CALL GCH
; Return
; +1 ; No more input
; +2 ; Ok, in a, the character
; Clobbers b
GCH: SKIPG LDCNT(TXT) ; IF ANY CHARS IN BUFFER, GET THEM FIRST
TQNN <STRF> ; Does string exist?
JRST GCH1 ; No, get from file
XCTBUU [ILDB A,2] ; Get character increment byte ptr
JUMPE A,GCH2 ;AT THE END OF THE STRING?
ANDI A,177 ;USE ONLY 7-BIT ASCII
CAIN A,"-" ;[7415] Are we in line continuation?
IFNSK. ;[7415] Possibly...
UMOVE B,2 ;[7415] Preserve the byte pointer from user
XCTBUU [ILDB A,2] ;[7415] Get next character
CAIN A,.CHLFD ;[7415] Is it a line feed?
JRST GCH ;[7415] We have continuation, ignore the continuation characters
CAIN A,.CHCRT ;[7415] How about a CR then LF?
IFNSK. ;[7415] Saw CR...
XCTBUU [ILDB A,2] ;[7415] ...now eat LF
JRST GCH ;[7415] And continue
ENDIF. ;[7415] End of -CRLF combination
UMOVEM B,2 ;[7415] Put user's byte pointer back
MOVEI A,"-" ;[7415] And restore the right character
ENDIF. ;[7415] End line continuation
SOSG CURCNT(TXT) ;[7415] Will this character fit?
RETBAD (GJFX51) ;[7415] No. Tell the user
IDPB A,CURPNT(TXT) ;YES. STASH IT AWAY
MOVEI B,0 ;PUT A NULL AT END
MOVE C,CURPNT(TXT) ;WITHOUT UPDATING THE POINTER
IDPB B,C
RETSKP ;AND FINISH UP
GCH2: TQZ <STRF> ; No more string input
GCH1: SOSGE LDCNT(TXT) ;MORE IN BUFFER?
JRST RFALSE ;NO. GO BACK
ILDB A,LDPNT(TXT) ;YES. GET THE NEXT BYTE
RETSKP ;AND RETURN THE BYTE
;SETUP RDTXT BLOCK
SRDTXT: 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
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
RET
;SETUP INTERNAL ^R BUFFER
RTYSET: STKVAR <RTY0P,RTY1P>
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,.GJCPP(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,RTY0P ;SAVE FINAL POINTER
GJF01: TQNN <STRF> ;HAVE A STRING POINTER?
IFSKP.
UMOVE A,2 ;YES. GET IT
IBP A ;INCREMENT IT
CALL DBP ;AND DECREMENT IT
MOVEM A,RTY1P ;SAVE IT FOR TESTING
ENDIF.
HRRZ A,E
UMOVE A,.GJRTY(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
TQNE <STRF> ;FROM A STRING IN MEMORY
JRST GTJ02 ;YES - NO CTRL/R BUFFER
GTJTP: CAME B,RTY1P ;SAME AS MAIN POINTER?
CAMN B,RTY0P ;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
RET
;SETUP USER-PROVIDED JFN
USRJFN: 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: CAMGE JFN,MAXJFN ; Above currently available jfn's?
IFSKP.
PUSH P,JFN ; Yes, sve this
MOVE JFN,MAXJFN
AOS MAXJFN
IMULI JFN,MLJFN
CALL RELJF2
POP P,JFN
JRST GTJFZ3
ENDIF.
IMULI JFN,MLJFN ;MAKE IT A USEABLE JFN
SKIPN FILSTS(JFN) ; Is this jfn free?
CAIN JFN,0 ;AND NOT 0?
IFSKP.
CALL ASGJF1 ; Yes, assign it
ELSE.
UNLOCK JFNLCK ;[7345]ALREADY IN USE. UNLOCK THE JFN
OKINT ;[7345]AND GO OKINT
TQNN <JFNAF> ;[7345]DOES USER WANT TO ASSIGN AN ALTERNATE?
ERRLJF GJFX2,<MOVEM JFN,ERRSAV> ;[7345]NO. THEN PUNT
CALL ASGJFN ;[7345](/JFN)YES. GET A DIFFERENT JFN
ERRLJF(GJFX3) ;[7345]COULDN'T. SAY NO MORE JFNS
ENDIF.
RET
; Assign a jfn
; Call: CALL ASGJFN
; Return
; +1 ; Error none available
; +2 ; Ok, in jfn the jfn
; Clobbers jfn
ASGJFN: NOINT
LOCK JFNLCK
MOVN JFN,MAXJFN ; Get current max jfn
HRLZS JFN ; Form aobjn pointer
JRST ASGJF5 ;SKIP JFN 0
ASGJF0: SKIPN FILSTS(JFN)
JRST ASGJF3
ASGJF5: ADD JFN,[XWD 1,MLJFN]
JUMPL JFN,ASGJF0
ASGJF2: CAIL JFN,RJFN
JRST ASGJF4
SUB JFN,[XWD 1,0]
AOS MAXJFN
ASGJF3: HRRZ A,JFN
CAIE A,101*MLJFN
CAIN A,100*MLJFN
JRST ASGJF5 ; Primary io designator is skipped
AOS (P)
SETZM FILLNM(JFN)
ASGJF1: HRLI JFN,(ASGF)
HRRZ A,JFN ;GET ADDRESS ONLY
HLLZM JFN,FILSTS(A) ; Mark this jfn as assigned
HRRZS JFN
SETZM FILST1(JFN) ;RESET FLAGS IN FILST1
SETONE ASGF2,(JFN) ;[7384]AND LIGHT ASGF SHADOW BIT
HRRZ A,FORKN ; Get fork number
HRLZM A,FILVER(JFN)
SETZM FILTMP(JFN)
SETZM FILDDN(JFN)
SETZM FILNEN(JFN)
SETZM FILACT(JFN)
SETZM FILNND(JFN)
HLLZS FILIDX(JFN)
SETZM FILMS1(JFN)
SETZM FILCOD(JFN) ;CLEAR UNIQUE CODE FIELD
SETZM FILOFN(JFN) ;CLEAR THIS WORD IN CASE DEVICE CARES
HRRZS FILMS2(JFN) ; CLEAR MASK WORDS
SETZM FILFDB(JFN) ; CLEAR FDB ADDRESS WORD
SETZRO FLDIR,(JFN) ; ZERO POINTER TO DIR STRING
SETZRO FLATL,(JFN)
SETOM FILLCK(JFN)
ASGJF4: UNLOCK JFNLCK
OKINT
RET
; Release jfn
; Call: IN JFN, JFN
; CALL RELJFN
; Clobbers a,b,c,d
RELJFN::
RELJFX:
NOINT
LOCK JFNLCK
SKIPN A,FILSTS(JFN) ;ALLREADY RELEASED?
JRST RELJF4 ;yes Already released
HRRZ A,FILDEV(JFN) ;GET THE DISPATCH ADDRESS FROM THE JFN
SKIPE A ;DEVICE DISPATCH SET?
CALL @RLJFD(A) ;YES...RELEASE ANY DEVICE SPECIFIC STORAGE
NOP ;IGNORE NON-SKIP RETURN
MOVE A,FILSTS(JFN) ;GET THE STATUS AGAIN
MOVE B,FILST1(JFN) ;[7384]GET MORE STATUS BITS
TXNE A,ASGF ;[7384]WAS THIS JFN BEING ASSIGNED?
TXNN B,ASGF2 ;[7384]BE SURE ASGF IS LIT, NOT BLKF
SKIPA ;[7384]JFN IS NOT BEING ASSIGNED
JRST RELJF0 ;YES, DONT CHECK SPOOLING
HRRZ A,FILIDX(JFN) ;SEE IF THIS IS A SPOOLED DEVICE
MOVE B,DEVCH1(A) ;GET CHARACTERISTICS OF ORIGINAL DEV
SKIPE SPIDTB+.SPQSR ;IS THERE A PID TO SEND TO?
TLNN B,(D1%SPL) ;YES, IS THIS A SPOOLED DEVICE?
JRST RELJF0 ;NO, DONT SEND ANY MESSAGES TO QUASAR
MOVE C,DEVCHR(A) ;SEE IF THIS IS AN INPUT DEVICE
BLCAL. DSKOK,<<FILDEV(JFN)>> ;REAL DISK?
SKIPA ;NO
TLNE C,(DV%IN) ;IF AN INPUT DEVICE, DONT SEND MESSAGE
JRST RELJF0 ;NOT OPENED, DONT SEND MESSAGE
CALL GETFDB ;GET THE FDB MAPPED
JRST RELJF0 ;FOULED UP, DONT SEND MESSAGE
EA.ENT
MOVE T2,.FBBYV(T1) ;SET UP FOR MESSAGE
MOVE T3,.FBSIZ(T1) ;SPOOL MESSAGE HAS FBBYV AND FBSIZ
CALL USTDIR ;UNLOCK FROM GETFDB
MOVE T1,JFN ;SET UP FOR SENDING MESSGE
CALL SPLMES ;TELL QUASAR OF SPOOLED FILE
BUG.(CHK,NOSPLM,GTJFN,SOFT,<RELJFN - Could not send spool message to QUASAR>,,<
Cause: Could not tell QUASAR of spooled file for output.
Action: See if QUASAR is running and check to see that the system has some
IPCF free space available.
>,,<DB%NND>) ;[7.1210]
RELJF0: CALL RELJF3 ;RELEASE COMMON STUFF
TXNE B,TRNSF ;[7384]A TRANSITIONAL FILE?
JRST RELJF4 ;[7384]NO
MOVE A,FILST1(JFN) ;[7384]GET SECOND STATUS WORD
TXNE B,ASGF ;[7384]WAS THIS BEING CREATED?
TXNN A,ASGF2 ;[7384]MAKE SURE ASGF IS LIT, NOT BLKF
JRST RELJF4 ;NO. CANT BE A RDTXT BUFFER THEN
MOVEI A,FILLNM(JFN) ;GET ADDRESS OF LOGICAL NAME CHAIN
CALL RELLNS ;RELEASE LOGICAL NAME STRING
MOVEI A,JSBFRE ;SET UP TO RELEASE RDTXT BUFFER
HLRZ B,FILLNM(JFN)
SKIPE B ;A RDTXT BLOCK THERE?
CALL RELFRE ;YES. RELEASE IT
HRRZS FILLNM(JFN) ;CLEAR OUT RDTXT BUFFER POINTER
RELJF4: SETZM FILDEV(JFN) ;CLEAR THIS TO AVOID ANY CONFUSION
UNLOCK JFNLCK
OKINT
RET
;COMMON SUBROUTINE CALLED BY RELFJN AND CLRJFN TO CLEAN UP THE JFN
;BLOCK BEFORE RELEASING IT OR STARTING PARSE ALL OVER
RELJF3: MOVE A,FILSTS(JFN) ; GET STATUS BITS
TXNE A,NONXF ; IS THIS A NON-EXISTENT FDB
CALL DELJFB ; YES, GO DELETE FDB IF FILE IS NON-X
MOVEI A,JSBFRE ; COMMON RELEASE SUBROUTINE
LOAD B,FLNOD,(JFN) ;RELEASE NODE IF ANY
SKIPE B
CALL RELFRE
HLRZ B,FILDDN(JFN)
SKIPE B
CALL RELFRE ; Release device string block
LOAD B,FLDIR,(JFN) ;SEE IF THERE IS A DIR NAME STRING
SKIPE B
CALL RELFRE ;YES, GO RELEASE IT
HLRZ B,FILNEN(JFN)
SKIPE B
CALL RELFRE ; Release name string block
HRRZ B,FILNEN(JFN)
SKIPE B
CALL RELFRE ; Release extension string block
LOAD B,FLDMS,(JFN) ; GET DIR WILD MASK
SKIPE B ; HAVE ONE?
CALL RELFRE ; YES. RELEASE IT
LOAD B,FLNMS,(JFN) ; NAME WILD MASK
SKIPE B ; HAVE ONE?
CALL RELFRE ; YES. RELEASE IT
LOAD B,FLEMS,(JFN) ; EXTENSION WILD MASK
SKIPE B ; HAVE ONE?
CALL RELFRE ; YES. RELEASE IT
SKIPLE B,FILACT(JFN) ;HAVE AN ACCOUNT STRING?
CALL RELFRE ; Release storage for account string
SETZ B, ; GET A ZERO
STOR B,FLDMS,(JFN) ; CLEAR DIR WILD MASK
STOR B,FLNMS,(JFN) ; CLEAR NAME WILD MASK
STOR B,FLEMS,(JFN) ; CLEAR EXTENSION WILD MASK
CALL RELATR ; GO RELEASE ATTRIBUTE LIST
MOVEI A,JSBFRE
MOVE B,FILSTS(JFN)
MOVE C,FILST1(JFN) ;[7384]GET ADDITIONAL STATUS BITS
TXNE B,ASGF ;[7384] Was this jfn being assigned?
TXNN C,ASGF2 ;[7384]MAKE SURE ASGF LIT, NOT BLKF
IFNSK. ;[7408]
SETZM FILLFW(JFN) ;[7408] No. Zap this word
JRST RELJF2 ;[7408] Go finish up
ENDIF. ;[7408]
TXNE B,TRNSF ;[7206] WAS THIS JFN TRANSITIONAL?
JRST RELJF2 ;[7206][7408] Yes, no TEMP block to release
;..
;..
HRRZ B,FILTMP(JFN)
SKIPE B
CALL RELFRE ; Release temp block
LOAD B,FLTSD,(JFN) ; RELEASE OTHER TEMP BLOCK
SKIPE B ; IF ANY
CALL RELFRE
SETZM FILTMP(JFN) ; CLEAR OUT POINTER TO WORD
RELJF2: SETZM FILDDN(JFN)
SETZM FILNEN(JFN)
SETZM FILPRT(JFN)
SETZM FILACT(JFN)
HLLZS FILIDX(JFN)
SETZM FILFDB(JFN) ;CLEAR FDB ADDRESS WORD
SETZRO FLDIR,(JFN) ;ZERO DIR NAME STRING AREA
MOVE B,FILSTS(JFN) ;SAVE THIS IN CASE IT IS NEEDED
SETZB STS,FILSTS(JFN)
SETOM FILLCK(JFN)
RET ;ALL DONE
RELATR: LOAD B,FLATL,(JFN) ;GET POINTER TO ATTRIBUTE LIST
JUMPE B,R ;IF EMPTY, THEN DONE
LOAD C,PRFXL,(B) ;GET POINTER TO NEXT ITEM ON LIST
STOR C,FLATL,(JFN) ;REMOVE FIRST ITEM FROM CHAIN
LOAD C,PRFXS,(B) ;GET SIZE OF BLOCK
MOVEM C,0(B) ;PUT SIZE IN FIRST WORD OF BLOCK
MOVEI A,JSBFRE
CALL RELFRE ;RELEASE THE BLOCK
JRST RELATR ;LOOP BACK TILL LIST IS EMPTY
;ROUTINE TO RELEASE LOGICAL NAME STRINGS
;ACCEPTS IN A/ ADDRESS OF CHAIN HEADER WORD
; CALL RELLNS
;RETURNS +1 ALWAYS
RELLNS::STKVAR <RELLNA>
HRRZM A,RELLNA ;SAVE POINTER TO CHAIN
RELLN1: CALL REL1LN ;GO RELEASE THE FIRST LOGICAL NAME BLOCK
RET ;ALL DONE
MOVE A,RELLNA ;LOOP BACK FOR ALL ELEMENTS
JRST RELLN1 ;LOOP BACK TILL ALL ARE RELEASED
;ROUTINE TO RELEASE THE FIRST LOGICAL NAME ON THE LIST
;ACCEPTS IN A/ ADDRESS OF CHAIN POINTER WORD
; CALL REL1LN
;RETURNS +1: NO MORE LOGICAL NAMES
; +2: OK
REL1LN::STKVAR <REL1LA>
HRRZM A,REL1LA ;SAVE ADDRESS OF CHAIN POINTER
HRRZ A,@REL1LA ;GET POINTER TO FIRST LN BLOCK
JUMPE A,R ;NO MORE
LOAD B,LNMPNT,(A) ;GET POINTER TO NAME STRING
MOVEI A,JSBFRE ;STORAGE CAME FROM JSB
CALL RELFRE ;RELEASE IT
HRRZ B,@REL1LA ;GET BACK POINTER TO BLOCK
LOAD C,LNMLNK,(B) ;GET POINTER TO NEXT BLOCK
HRRM C,@REL1LA ;UPDATE POINTER TO FIRST BLOCK
MOVEI C,LNHDRL ;GET LENGTH OF HEADER BLOCK
MOVEM C,0(B) ;FOR RELFRE
CALL RELFRE ;GIVE BACK SPACE FOR HEADER
RETSKP ;AND RETURN
; Terminate string
; Call: FILOPT(JFN) ; Addresses last byte of string
; RH(FILTMP(JFN)) ; Addresses beginning of string block
; CALL ENDSTX
; Returns with a null deposited on the end of the string and
; In a, a pointer to the string as required by the recognition routines
; Does not modify filopt(jfn), clobbers a,b
ENDSTX::MOVE A,FILOPT(JFN)
MOVEI B,0
IDPB B,A ; Append null to string
LDB B,[POINT 6,A,5] ; ZERO OUT THE REST OF THE WORD
SUBI B,^D35 ; GET NEGATIVE NUMBER OF BITS TO SAVE
MOVSI C,400000 ; BUILD A MASK OF BITS TO PRESERVE
ASH C,(B) ; BUILD MASK
HRRZ B,A ; GET ADDRESS OF LAST WORD
ANDM C,(B) ; ZERO THE LOW ORDER BITS IN THE WORD
SUB A,FILTMP(JFN)
MOVNI A,-1(A) ; Number of full words instring
HRL A,FILTMP(JFN)
MOVSS A ; Yields iowd # fuul words, first word
RET
; Trim temp storage block and return excess to free store pool
; Call: FILOPT(JFN) ; Addresses the last byte of the string
; RH(FILTMP(JFN)) ; Addresses the beginning of the string block
; CALL ENDTMP
; Returns in a, origin of the string block
; Deposits a null byte on the end of the string
; Returns excess storage in the block to free storage pool
; Clears rh(filtmp(jfn))
; Clobbers a,b,c,d
; Leaves psi off
ENDTMP: MOVEI B,0
IDPB B,FILOPT(JFN) ; Deposit a null on the end
HRRZ A,FILTMP(JFN) ; Origin of block
MOVE B,FILOPT(JFN)
CALL TRMBLK ; Trim excess from the block
NOINT
HRRZ A,FILTMP(JFN)
HLLZS FILTMP(JFN)
RET
; Trim excess from a block and return it to free storage
; Call: A ; Origin of the block
; RH(B) ; Last location in block used
; CALL TRMBLK
; Clobbers a,b,c,d
TRMBLK::MOVEI C,JSBFRE ;SET UP ARGUMENTS FOR TRIMER
CALLRET TRIMER ;DO THE TRIMMING
;ROUTINE TO TRIM THE UNUSED PART OF A BLOCK FROM A FREE STORAGE POOL
;ACCEPTS IN A/ ORIGIN OF BLOCK
; B/ LAST LOCATION USED
; C/ POOL TO WHICH THE REMAINDER IS TO BE RETURNED
; CALL TRIMER
;RETURNS +1 ALWAYS
TRIMER::MOVEI B,1(B) ; Loc of first unused word
HRRE D,(A) ; Original length of block
SUBI D,(B)
ADDI D,(A) ; Length of excess
JUMPLE D,CPOPJ ; No excess
NOINT
HRROM D,(B) ; Make residue into legit block
MOVNS D
ADDM D,(A) ; Shorten original block
MOVEI B,(B)
MOVE A,C ; GET ADDRESS OF POOL TO RELEASE INTO
CALL RELFRE ; Release the residue
OKINT
RET
; I-o routines for local use
; Call: B ; Pointer to string to be typed
; CALL TSTRB ; If b addresses a string block
; Or
; CALL TSTR ; If b address the first byte
; Outputs the string to the file specified in the call to gtjfn
; Clobbers A,B,C
;
;Returns: +1: Always
;
; CALL TSTRQC
;
;Accepts: B/ Address of first byte of remainder of string to be typed
;
;This routine is used by DEFNAM, DEFEXT, RECNAM, and RECEXT to insure
;that the field which is being recognized is of a valid length. This is
;only of interest when G1%NLN is set in the GTJFN call (no long names).
;Clobbers A,B,C.
;
;Return: +1: Error - field is too long (G1%NLN is in effect)
; +2: Success
TSTRQC: CALL LENOK ;(/A) Check on length of field
RETBAD() ;Invalid length - return error
CALL TSTRQ ;(B) Length is ok - complete field
RETSKP ;Return success
TSTRQ: SETO A, ;REMEMBER TO DO QUOTEING
JRST TSTR0
TSTRB: HRLI B,(<POINT 7,0,34>) ;POINTER TO BEGINNING OF STRING
TSTR: MOVEI A,0 ;NO QUOTEING
TSTR0: STKVAR <TSTRA>
TLC B,-1 ;ASCIZ BYTE POINTER IN B?
TLCN B,-1 ;...
HRLI B,(POINT 7,0) ;YES, SET UP LEGAL BYTE POINTER
MOVEM A,TSTRA ;SAVE QUOTEING FLAG
MOVEM B,LDPNT(TXT) ;SAVE POINTER
SKIPG CURCNT(TXT) ;ANY ROOM LEFT?
JRST TSTR0C ;NO
;..
;..
TSTR0A: ILDB A,B ;GET NEXT CHAR
JUMPE A,TSTR0B ;NULL = DONE
SKIPE TSTRA ;DOING QUOTING?
CALL QUOCHK ;YES, SHOULD IT BE QUOTED?
JRST TSTR0D ;NO
MOVEI C,"V"-100 ;YES, PUT IN A ^V
IDPB C,CURPNT(TXT) ;QUOTE THIS CHARACTER
SOSG CURCNT(TXT) ;ENOUGH ROOM FOR ANOTHER CHARACTER
JRST TSTR0C ;NO
TSTR0D: IDPB A,CURPNT(TXT) ;STORE THE CHARACTER
SOSLE CURCNT(TXT) ;ANY MORE ROOM?
JRST TSTR0A ;YES, LOOP BACK FOR MORE
TSTR0B: MOVE B,CURPNT(TXT) ;AND END WITH A NULL
IDPB A,B
TSTR0C: MOVE B,LDPNT(TXT) ;RESTORE B
SETZM LDCNT(TXT) ;ZAP THE INPUT COUNT
TSTR1: HRRZ A,E
XCTU [HRRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
RET
MOVEI C,0
SOUT
ERJMP R ;[7300][7420] Catch JSYS error
RET
;LENOK - Routine to check the length of the field being output.
;It is needed for GTJFN calls with G1%NLN set and recognition is being
;performed. We must check the length of the field we are returning to
;insure that it is not "long". This routine is only needed when
;recognition is used on the filename or extension before the maximum
;number of allowable characters is entered. Otherwise, the
;code at DPST handles the invalid field length.
;
;Returns: +1: Invalid length - error code is in A
; +2: Length is valid
;
;Uses registers A,C, and D. Preserves B.
LENOK: CALL TSTLNG ;Are long names allowed?
IFSKP. ;Yes
RETSKP ;Nothing more to do then
ENDIF.
LOAD C,FLNSB,(JFN) ;Get the pointer to the file name
TQNE <EXTF> ;Parsing an extension?
LOAD C,FLESB,(JFN) ;Yes, so get to pointer to the extension
HRLI C,(<POINT 7,0,34>) ;Point to the first character
SETZM D ;Init character counter
DO.
ILDB A,C ;Get a character
JUMPE A,LENOK1 ;No more to get
AOS D ;Count the character
JRST TOP. ;Get another one
ENDDO.
LENOK1: MOVEI C,MAXSHT ;Get max size for a name
MOVEI A,GJFX41 ;Get correct error code
TQNN <EXTF> ;Parsing an extension?
IFSKP. ;Yes
MOVEI C,MAXEXT ;Use max size of an extension then
MOVEI A,GJFX42 ;And get correct error code
ENDIF.
CAMLE D,C ;Are we over the limit?
RET ;Yes, return the error code
RETSKP ;Not over the limit - return success
;ROUTINE TO CHECK IF A CHARACTER NEEDS QUOTING
;ACCEPTS IN A/ CHAR
;RETURNS +1: DO NOT QUOTE
; +2: QUOTE IT
QUOCHK: SAVET ;CLOBBERS NO ACS
MOVE B,A ;GET CHAR INTO B FOR CPTAB
IDIVI B,^D36/CCSIZE ;GET CLASS CODE
LDB B,CPTAB(C) ;GET CODE
CAIL B,ECHDTB-CHDTB ;LEGAL?
RET ;NO
MOVSI A,400000 ;NOW BUILD MASK
MOVNS B
LSH A,(B)
TXNE A,QUOMSK ;IS THIS A STANDARD CHARACTER?
RET ;YES, DO NOT QUOTE IT
RETSKP ;NO, QUOTE IT
QUOMSK==1B<UPPER>!1B<LOWER>!1B<DIGITC>!1B<UPPERT>!1B<UPPERP>!1B<UPPERA>!1B<LOWERT>!1B<LOWERP>!1B<LOWERA>!1B<MINUSC>
; Ding the bell
; Call: CALL DING
DING: HRRZ A,E
XCTU [HLRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
JRST RFALSE
MOVEI B,7 ; Fall into outch to type a bell
CALL OUTCH1 ;DONT INSERT IN USER'S STRING
JRST RFALSE
; Output character
; Call: B ; The character right justified
; CALL OUTCH
; Outputs the character on the file specified in the call to gtjfn
; Clobbers a-D
OUTCH: SKIPG CURCNT(TXT) ;ROOM LEFT IN USER'S STRING
JRST OUTCH1 ;NO, DONT PUT CHARACTERS IN STRING
IDPB B,CURPNT(TXT) ;PUT IT IN THE STRING
MOVE A,CURPNT(TXT) ;STORE A NULL AT END OF STRING
SETZ C,
SOSLE CURCNT(TXT) ;AND ADJUST THE COUNT
IDPB C,A ;ONLY STORE NULL IF ENOUGH ROOM
OUTCH1: HRRZ A,E
XCTU [HRRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
RET
BOUT
ERJMP R ;[7300][7420] Catch JSYS error
RET
;TEST FOR INPUT STRING COMING FROM A FILE
; RETURN +1: NOT COMING FROM FILE
; +2: COMING FROM FILE, A/ JFN
INFTST: HRRZ A,E
XCTU [HLRZ A,.GJSRC(A)]
TXNE E,-1B17 ;FULL BLOCK?
TXNE E,GJ%FNS ;NO, JFN'S SUPPLIED?
CAIN A,.NULIO ;AND NULL?
RET ;NOT FILE
RETSKP ;FILE
;SET MODES ON INPUT FILE IF THERE IS ONE
SETINF: CALL INFTST
JRST GTJFZ1
RFCOC
DMOVEM B,INFCOC
RFMOD ;GET MODE BITS TOO
TXZ B,TT%OSP ;FORGET OUTPUT SUPPRESS
MOVEM B,INFMOD
TRZ B,3B29 ;CLEAR DATA MODE FIELD
TRO B,17B23+1B29 ;SET BREAK ON EVERYTHING
SFMOD ;AND PUT IT IN EFFECT
CALL SFCC0
GTJFZ1: RET
;RESTORE INFILE MODES WHEN LEAVING GTJFN
ENDINF: CALL INFTST
JRST ENDL55 ;NO INPUT FILE
MOVE B,INFMOD
SFMOD ;SET IT BACK
DMOVE B,INFCOC
SFCOC
ENDL55: RET
SFCCON: MOVE B,TTICB1
MOVE C,TTICB2 ;STANDARD SETTINGS
JRST SFCC
SFCC0: DMOVE B,[BYTE (2)1,1,1,1,1,1,0,2,1,2,2,1,2,2,1,1,1,1
BYTE (2)0,1,1,0,0,0,1,1,1,0,1,1,1,2]
SFCC: CALL INFTST
RET
SFCOC
RET
; Output number
; Call: B ; The number
; CALL DNOUT ; For decimal output
; Or
; CALL ONOUT ; For octal output
; Clobbers a,c
DNOUT: SKIPA C,[12]
ONOUT: MOVEI C,10
MOVE A,CURPNT(TXT) ;GET TAIL OF DATA
NOUT ;PUT NUMBER IN THE STRING
JFCL
MOVEM C,LDCNT(TXT) ;SAVE RADIX
MOVE C,CURPNT(TXT) ;GET START TO CALCULATE NUMBER TRANSFERRED
CMPAR: IBP C ;MOVE IT
SOS CURCNT(TXT) ;COUNT FIRST ONE
CAME C,A ;THERE YET?
JRST CMPAR ;NO. GO ON
NOUTA: MOVEM A,CURPNT(TXT) ;UPDATED TAIL POINTER
MOVE C,LDCNT(TXT) ;RESTORE RADIX
SETZM LDCNT(TXT) ;JUST TO BE SAFE
ANOUT: HRRZ A,E
XCTU [HRRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
RET
NOUT
ERJMP R ;[7300][7420] Catch JSYS error
RET
; Process errors during gtjfn
; Call: A ; Error number
; JRST ERRDO
ERRDO: PUSH P,A ;SAVE ERROR CODE
JUMPE TXT,ERRDO2 ;IF TXT NOT SET UP, SKIP THESE STEPS
CALL STRUSR ;PUT DATA IN USER'S BUFFER
CALL RELJFX
ERRDO2: CALL ENDINF ;RESTORE TTY MODES
POP P,A ;ERROR CODE
RETERR () ;AND GO TO ERROR EXIT
;THESE ROUITNES ARE USED BY THE RDTXT FACILITIES IN GTJFN
BACKIT: SETO A, ;[7.1014] Move over recognition character
ADJBP A,CURPNT(TXT) ;[7.1014] Tail pointer
MOVEM A,CURPNT(TXT) ;SAVE NEW POINTER
SOS LDCNT(TXT) ;ADJUST COUNT
AOS CURCNT(TXT) ;INCREASE COUNT
RET ;AND DONE
GTINPT: HRRZ A,E
XCTU [MOVE A,1(A)] ;GET JFN'S
RET ;AND DONE
;ROUTINE TO STEP A LOGICAL NAME TO NEXT SET OF DEFAULTS
STEPLN: TXNN F,GJ%NS ;USER WANT TO PREVENT SEARCHING?
TQNN <OLDNF> ;NO, MUST HAVE OLD-FILE-ONLY BIT ON
RET ;OTHERWISE CANNOT STEP LN
MOVE B,CURPNT(TXT) ;GET POINTER
ILDB C,B ;WAS POINTER BACKED UP
JUMPE C,STPLN1 ;IF NULL, POINTER WAS NOT BACKED UP
IBP CURPNT(TXT) ;STEP OVER CHARACTER
SOS CURCNT(TXT) ;BACK UP OVER TERMINATOR
STPLN1: PUSH P,A ;SAVE THE ERROR CODE
CALL LNSTEP ;STEP THE LOGICAL NAME
JRST PA1 ;NO MORE DEFINITION BLOCKS
CALL STOALT ;FIND LOST ALTMODE
JFCL
CALL CLRJFS ;CLEAR OUT JFN BLOCK (EXCEPT FILLNM)
HRROS 0(P) ;MAKE ERROR CODE NEGATIVE
AOS STPCNT(TXT) ;INCREMENT THE STEP COUNTER
CALL SETTMP ;GO GET A TEMPORARY STRING
MOVEM A,0(P) ;STORE THIS ERROR CODE INSTEAD
JRST PA1 ;AND RETURN
CLRJFS: NOINT ;ROUTINE TO CLR JFN ON LN STEP
LOCK JFNLCK
JRST CLRJF1 ;DONT CLEAR OUT LOGICAL NAME
CLRJFN: NOINT ;PREVENT INTERRUPTS
LOCK JFNLCK ;LOCK UP THE JFN'S
MOVEI A,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL RELLNS ;RELEASE LOGICAL NAME SPACE
CLRJF1: CALL RELJF3 ;CLEAR COMMON CELLS
CALL ASGJF1 ;REASSIGN THE JFN
HRRZ STS,E
XCTU [HLLZ F,0(STS)] ;GET BACK USER'S FLAGS
CAIN STS,1 ;SHORT FORM? (OR DOESN'T MATTER)
TQZ <JFNRD> ;YES, GJ%XTN IS NOT ALLOWED
SETZ STS, ;CLEAR PROCESSING FLAGS
AND F1,[STRF+IGIVF] ; Leave string flg & find invisible
CALL SETSTR ;SET STAR BITS IN STS
MOVX B,RIEFLG ;CLEAR THE APPROPRIATE FLAGS
ANDM B,FLAGS(TXT) ;ONLY THE TEMPORARY ONES
RET ;AND DONE
SETSTR: TQNE <OSTRF> ;OUTPUT STARS ALLOWED?
TQNE <ASTAF> ;YES. INPUT STARS TOO?
RET ;NO. DONT SET ANYTHING
TQO <ASTF> ;YES. ALLOW STARS
RET ;AND RETURN
STRUSR: TQNN <JFNRD> ;SPECIFYING A RETURN BUFFER?
RET ;NO. JUST GIVE UP THEN
CALL STOUAL ;PUT ESCAPE AT END IF APPROPRIATE
JFCL ;IT HAS TO WORK
HRRZ D,E
XCTU [HRRZ D,11(D)] ;GET NEW FLAG WORD
CAIGE D,1 ;ENOUGH WORDS IN NEW BLOCK?
RET ;NO. CANT COPY
HRRZ B,E
UMOVE B,12(B) ;YES. GET THE STRING
TLC B,-1
TLCN B,-1 ; A -1 IN THE LEFT HALF?
HRLI B,(<POINT 7,0>) ;YES. PUT IN GOOD LEFT HALF
MOVE C,STRCNT(TXT) ;GET INITIAL COUNT
SUB C,CURCNT(TXT) ;SUBTRACT CURRENT COUNT
JUMPE C,R ;IF NONE USED,NO COPY.
PUSH P,[0] ;ASSUME NO COUNT
CAIGE D,2 ;USED SOME. DID HE GIVE A COUNT?
JRST NOCNT ;NO. GO ON
HRRZ D,E
XCTU [SKIPG A,13(D)] ;YES. GET IT
JRST NOCNT ;BAD COUNT. DONT BELIEVE IT
SUB A,C ;CALCULATE BYTES LEFT IN HIS BUFFER
UMOVEM A,13(D) ;AND RETURN IT TO HIM
SKIPLE A ;ROOM FOR A NULL AT THE END?
AOS 0(P) ;YES. SAY SO
NOCNT: MOVE A,STRPNT(TXT) ;POINTER TO START OF TEXT
MOVBYT: ILDB D,A ;GET A BYTE
XCTBU [IDPB D,B] ;STORE IT IN HIS STRING
SOJG C,MOVBYT ;DO THEM ALL
HRRZ C,E
UMOVEM B,12(C) ;RETURN UPDATED POINTER
POP P,A ;THE FLAG
JUMPE A,R ;ROOM FOR A NULL?
SETZ D, ;YES
XCTBU [IDPB D,B] ;SO PUT IT IN
RET ;AND FINISHED
;ROUTINE TO SEE IF LONG NAMES ARE ALLOWED. PRESERVES ALL
;REGISTERS
TSTLNG: SAVET ;SAVE ALL TEMPS
TQNN <JFNRD> ;HAVE EXTENDED BLOCK
RETSKP ;NO. ALLOW LONG NAMES
HRRZ A,E
UMOVE A,11(A) ;YES. GET FLAGS
TXNN A,G1%NLN ;ALLOWED?
RETSKP ;YES
RET ;NO
ENDTV. ;END TRVAR AT .GTJFN ENTRY
; Get next jfn
; Call: LH(1) ; Flags dirsf...hverf
; RH(1) ; Jfn
; GNJFN
; Returns
; +1 ; Error, jfn not attached to name, no more names
; +2 ; Ok, the jfn refers to the next file in the directory
GNJMSK==STRSF+DIRSF+NAMSF+EXTSF+VERSF+RVERF+HVERF+LVERF+FXPRT+FXACT+FXTMP
; MASK OF BITS TO KEEP FROM USER'S AC1
.GNJFN::MCENT
ACVAR <JQ1,JQ2>
STKVAR <OFILUC,VERNUM> ;[7380] Old STR unique code and version
HRRZ JFN,1
CALL CHKJFN
RETERR()
JFCL
RETERR(DESX4)
TQNE <ASTF>
ERUNLK(DESX7) ; Output stars not allowed
TQNE <OPNF>
ERUNLK(OPNX1)
LOAD JQ1,FLUC,(JFN) ;GET STRUCTURE UNIQUE CODE AT START
MOVEM JQ1,OFILUC ; SAVE OLD STR UNIQUE CODE
XCTU [HLLZ F1,1]
AND F1,[GNJMSK] ;KEEP ONLY CERTAIN BITS FROM USER
TXO F1,GNJFF ;REMEMBER THIS IS A GNJFN
TXNN F1,NAMSF ;WANT TO STEP THE NAME?
IFSKP.
HLRZ A,FILNEN(JFN) ;YES. GET NAME STRING
CALL GNJFN3 ;GO MAKE SURE IS BIG ENOUGH
RETERR (GJFX22,<CALL UNLCKF>) ;NOT, AND NO MORE SPACE
HRLM A,FILNEN(JFN) ;NEW STRING POINTER
ENDIF.
TXNN F1,EXTSF ;WANT TO STEP THE EXTENSION?
IFSKP.
HRRZ A,FILNEN(JFN) ;YES. GET EXTENSION STRING
CALL GNJFN3 ;GO MAKE SURE IS BIG ENOUGH
RETERR (GJFX22,<CALL UNLCKF>) ;NOT BIG ENOUGH AND NO SPACE
HRRM A,FILNEN(JFN) ;NEW STRING
ENDIF.
TXO STS,ASGF!TRNSF ;MARK AS TRANSITIONAL
TXZ STS,NAMEF ;AND MAKE IT APPEAR UNASSIGNED
MOVEM STS,FILSTS(JFN) ;AND IN THE JFN AS WELL
SETONE ASGF2,(JFN) ;[7384]LIGHT ASGF SHADOW BIT AS WELL
CALL UNLCKF ;DO UNLOCK
;..
;..
GNJFN1: SETZM FILTMP(JFN) ;[7408]
SETZM FILPRT(JFN) ;[7408]
SETZM FILOPT(JFN) ;[7408]
TQO <STEPF>
TQO <IGIVF> ; Make sure we see invisible files
UMOVE A,1 ; GET USER FLAGS
MOVX F,IGDLF+OLDNF ;Assume Ignore Deleted + Old Files Only
; TXNE A,GJ%GND ;Were deleted files considered?
; MOVX F,OLDNF ;No, so do not allow them to be found
HRRZ A,FILVER(JFN) ;GET CURRENT VERSION
TQNE <HVERF> ;NEW VERSION WANTED?
MOVNI A,1
TQNE <RVERF> ;MOST RECENT VERSION WANTED?
MOVNI A,0
TQNE <LVERF> ;LOWEST VERSION WANTED?
MOVNI A,2
TXNN F1,STRSF!DIRSF!NAMSF!EXTSF!VERSF
IFNSK. ;[7371]
MOVEI A,GNJFX1 ;[7371] Will fail, give proper return
JRST GNFAIL ;[7371]
ENDIF. ;[7371]
MOVEM A,VERNUM ;[7380] Save version number
CALL VANISH ;[7393] (JFN/T1) Did file disappear on us?
RETERR(,<PUSH P,A ;[7393] Save error code
CALL RELJFX ;[7393] (/T1) Release JFN
POP P,A>) ;[7393] Tell user the error
SETZM FILTMP(JFN) ;[7371]
SETZM FILPRT(JFN) ;[7371]
SETZM FILOPT(JFN) ;[7371]
MOVE A,VERNUM ;[7380]
CALL VERLUK
GNFAIL: RETERR(,<CAIL A,GJFX36 ;ONE OF THE FILE OR DIRECTORY ERRORS?
CAILE A,GJFX40 ;STILL?
MOVEI A,GNJFX1 ;NO. GIVE STANDARD MESSAGE
PUSH P,A ;SAVE ERROR CODE OVER RELJFN
CALL RELJFX ;RELEASE THE JFN
POP P,A>)
;..
;..
HRRM A,FILVER(JFN)
MOVEM B,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
BLCAL. DSKOK,<DEV> ;SEE IF REAL FDB
JRST GNJFN2 ;ISN'T
CALL GETFDB
JRST GNJFN1
PUSH P,A
MOVX B,FC%DIR ;B/DIRECTORY-LIST ACCES
CALL ACCCHK
JRST [ CALL USTDIR
POP P,A
JRST GNJFN1]
MOVX B,DC%RD
CALL DIRCHK
JRST [ CALL USTDIR
POP P,A
JRST GNJFN1]
MOVE A,0(P) ;GET FDB ADDRESS BACK AGAIN
CALL COMACT ;SEE IF THE ACCOUNT STRING MATCHES
JRST [ CALL USTDIR ;IT DOESNT, STEP TO NEXT FILE
POP P,A
JRST GNJFN1]
POP P,A
MOVE A,.FBCTL(A)
CALL USTDIR
;..
;..
GNJFN2: UMOVE B,1
TLNN B,(1B12)
TXNN A,FB%DEL
IFNSK.
TLNN B,(1B13)
TXNE A,FB%DEL
JRST GNJFN1
ENDIF.
TXNE B,GJ%GIV ; Ignore fact file invisible?
TXNN A,FB%INV ; No, is it invisible?
IFSKP. < ; Taking or file visible
JRST GNJFN1> ; Invisible & not taking
NOINT ;PROTECT THINGS AGAIN
AOS FILLCK(JFN) ;GET THE LOCK
TXZ STS,ASGF!TRNSF ;MAKE IT A REAL JFN AGAIN
TXO STS,NAMEF ;SAY NAME IS NOW ASSIGNED
LOAD JQ2,FLUC,(JFN) ;GET THE CURRENT STRUCTURE UNIQUE CODE
MOVE A,JQ2 ;NOW LOCK THIS STRUCTURE
CALL CNVSTR ;...
JFCL ;IF DISMOUNTED, ERROR WILL BE SEEN LATER
HLRZ A,FILDDN(JFN) ;NOW UPDATE THE DEVICE NAME STRING
CAMN JQ2,OFILUC ;DID IT GET CHANGED DURING THIS GNJFN?
JRST GNJFN4 ;NO (WILL NOT CHANGE FOR NON-STRUCTURE DEVICES)
CALL CNVSIX ;GO UPDATE THE DEV NAME STRING
RETERR(,<PUSH P,A ;FAILED TO GET SPACE, SAVE ERROR CODE
CALL RELJFX
CALL UNLCKF
POP P,A>)
HRLM A,FILDDN(JFN) ;SAVE NEW STRING POINTER TO DEVICE
GNJFN4: SETZRO ASGF2,(JFN) ;[7384]CLEAR ASGF SHADOW BIT
;[7384]CALL TO UNLCKF WILL CLEAR ASGF
CALL UNLCKF ;RELEASE JFN AND STR LOCK
SETZ A,
CAME JQ1,JQ2 ;DID THE STR CHANGE DURING THIS CALL?
TXO T1,GN%STR ;YES, TELL THE USER OF THIS CHANGE
TQNE <DIRXF>
TXO T1,GN%DIR ;NOTE DIRECTORY CHANGED
TQNE <NAMXF>
TXO T1,GN%NAM ;NOTE NAME CHANGED
TQNE <EXTXF>
TXO T1,GN%EXT ;NOTE EXTENSION CHANGED
XCTU [HLLM A,1]
SMRETN
;ROUTINE TO MAKE SURE JSB STRING POINTED TO BY A IS BIG ENOUGH TO
;BE STEPPED. IF NOT, IT WILL ATTEMPT TO GET ANOTHER ONE OF THE
;PROPER SIZE AND COPY THE CURRENT INFO INTO IT.
;ACCEPTS:
; A/ JSB STRING ADDRESS
;RETURNS:
; +1/ FAILED. INPUT AREA NOT LARGE ENOUGH AND NO MORE JSB
; SPACE
; +2/ SUCCESS. A= NEW AREA
GNJFN3: STKVAR <SVPNTR,SVNEW> ;SOME WORK CELLS
JUMPE A,R ;IF NO BUFFER, ERROR
HRRZ B,0(A) ;GET CURRENT SIZE
CAIN B,MAXLW+1 ;LARG ENOUGH?
RETSKP ;YES. ALL DONE
MOVEI B,MAXLW+1 ;NO. MUST GET ONE OF PROPER SIZE
MOVEM A,SVPNTR ;SAVE INPUT
CALL ASGJFR ;GET SOME SPACE
RET ;NONE THERE.
MOVEM A,SVNEW ;SAVE NEW AREA
HRL A,SVPNTR ;GET OLD POINTER
AOBJN A,.+1 ;INCREMENT BOTH
MOVE B,SVPNTR ;OLD AREA
HRRZ C,0(B) ;LENGTH OF OLD AREA
ADDI C,-2(A) ;WHERE THE BLT SHOULD END
BLT A,0(C) ;MOVE NAME
MOVEI A,JSBFRE ;THE BLOCK HEADER
CALL RELFRE ;RELEASE IT
MOVE A,SVNEW ;THE NEW BLOCK
RETSKP ;DONE
;[7371]
;This routine is called before GNJFN% does its thing. It checks
;to see if the file that we are stepping off of has gone away.
;It could have disappeared via an untimely RENAME or it could
;have been deleted and expunged. Neither of which is good because
;the LOOKUP routines expect the file to still exist. If this file
;does not exist, then the LOOKUP routines will not set up FILOPT
;correctly and when directories are stepped, we will either hang in
;an infinite loop or we will cause an ILMNRF (because of FILOPT).
;
;Accepts:
; JFN/ JFN of file to check for existance.
;
;Returns:
; +1 if the file in the JFN block of the JSB pointed to by JFN
; is no longer there.
; T1/ Error code
;
; +2 if the file still exists
VANISH: EA.ENT ;[7371] Be in section 0/1
STKVAR <OLDFLG> ;[7371] Keep flags and (TXT) for later
HRRZ T1,FILDEV(JFN) ;[7.1064] Has to be some flavor of DSK:
CAIE T1,DSKDTB ;[7.1064] Is this JFN on a disk file?
RETSKP ;[7.1064] Nope, return OK
MOVEM F1,OLDFLG ;[7371] Put them here
TXZ F1,<GNJFF!DIRSF!ASTF!STRSF!NAMSF!EXTSF!VERSF!STEPF> ;[7393] Don't step anything
HRRZ T1,FILVER(JFN) ;[7393] Get version number
CALL VERLUK ;[7393] (T1/T2) Find that file
JRST GONE ;[7393] It ain't there
MOVE F1,OLDFLG ;[7371] Get flags back
RETSKP ;[7371] And continue, file is still here
GONE: MOVEI T1,GNJFX2 ;[7371] Return vanished file error
RET ;[7371]
ENDAV.
TNXEND
END