Trailing-Edge
-
PDP-10 Archives
-
DECNET-20_V2.1_2020_7-20-82
-
decnet/nft.mac
There are 24 other files named nft.mac in the archive. Click here to see a list.
TITLE NFT Network file transfer utility for TOPS20 DECNET
SUBTTL D. Oran - P.J. Taylor 16-May-80
;
;
;
; COPYRIGHT (c) 1978,1979,1980 BY
; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MA.
;
; 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 WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC ;Get Galaxy symbols
PROLOG (NFT)
SEARCH DAPSYM ;Get DAPLIB symbols
;Version Information
NFTVER==2 ;MAJOR VERSION OF NFT
NFTMIN==0 ;MINOR VERSION OF NFT
NFTEDT==100 ;EDIT LEVEL
NFTWHO==0 ;WHO LAST EDITED (0=DEC DEVELOPMENT)
GLOB DAPEDT
VNFT==<VRSN.(NFT)>+DAPEDT ;Get the version level
SUBTTL Table of contents
; TABLE OF CONTENTS FOR NFT
;
;
; SECTION PAGE
; 1. D. Oran - P.J. Taylor 9-May-79.......................... 1
; 2. Table of contents......................................... 2
; 3. Revision History.......................................... 3
; 4. Constants and assembly parameters......................... 4
; 5. LOCAL MACROS.............................................. 5
; 6. Job version and entry vector.............................. 6
; 7. Initialization blocks..................................... 6
; 8. MAIN ENTRY POINT AND INITIALIZATION....................... 7
; 9. Parser and Command dispatch............................... 8
; 10. DELETE DIRECTORY SUBMIT and TYPE commands................. 13
; 11. REMFIL Common parsing routine for remote filespec........ 14
; 12. REMRTN Common Co-routine for DELETE SUBMIT and TYPE commands 15
; 13. DIRRTN Co-routine for Directory command.................. 16
; 14. OUTDEF Routine to default output file name................ 17
; 15. HELP and EXIT commands.................................... 18
; 16. INFORMATION command dispatch.............................. 19
; 17. Information about DECNET.................................. 20
; 18. Information about DEFAULTS................................ 21
; 19. SET defaults command...................................... 22
; 20. PARFIL Routine to parse a network file specification..... 24
; 21. PARNOD Routine to parse NODE::........................... 25
; 22. PARSWS Routine to parse switches......................... 26
; 23. Switch processors......................................... 27
; 24. OSTYPE Switch processor................................... 28
; 25. GETUSR routine to ensure we have a user,account and password 29
; 26. HLPUSR Routine to display access information for a node.. 30
; 28. TAKE command.............................................. 31
; 29. OUTNAM Routine to generate output file spec.............. 32
; 30. OUTFLG Routine to set flags per what user typed.......... 33
; 31. Routine to build destination string from wild information. 34
; 32. CHKWLD Routine to validate wild construction............. 35
; 33. FILDEF Routine to setup GTJFN file defaults.............. 36
; 34. CPYFLD ROUTINE TO COPY A STRING UNTIL BREAK CHARACTER.... 37
; 35. CHKPTR Routine to fix -1 type pointers................... 39
; 36. DAPOPN Routine to Open logical link...................... 40
; 37. DAPFNC Routine to perform one DAP function............... 41
; 38. COMMAND ERROR SUBROUTINES................................. 42
; 39. CMDINI Command parsing initialization routine............ 44
; 40. Command field parsing routines............................ 4
; 41. Command parsing error and reparse routines................ 46
; 42. GENERAL SUBROUTINES....................................... 47
; 43. NODGET Routine to build node recognition table........... 48
; 44. NODADD Routine to add an entry to node table............. 49
; 45. PSIINI Software interrupt system initialization.......... 50
; 46. Interrupt service routines................................ 50
; 47. Interrupt tables.......................................... 51
; 48. Pure Data storage......................................... 52
; 49. Impure storage............................................ 53
SUBTTL Revision History
COMMENT \
Edit Comment
0020 First field test of NFT version 2(20)
0021 Don't allow wild cards in remote retrieval
0022 MOVE QUOTED STRING TO FIRST CHOICE FOR REMOTE FILE SPEC.
THIS DISABLES RECOGNITION FOR ONE CHARCTER AFTER THE NODE.
Include DAPLIB version with NFT's version.
0023 FIX FILE BREAK TO ACCEPT <>; IN CASE GTJFN FAILS FOR BUMB
DEVICE NOT KNOWN TO THIS NODE DURING REMOTE FILE PARSING.
0024 ADD FILDEF ROUTINE TO SETUP GTJFN BLOCK DEFAULTS FROM
AN ASCIZ STRING.
0025 Fix a bug in OUTFLG that caused copy to fail when only
output device was specified.
0026 Fix a bug in switch parsing on copy to proceed to output
filespec if a space is typed after input filespec.
0027 Add directory code to display protection, filesize and
last update time
0030 Add interrupt cause to calls to D$INTR so it doesn't have
to interrogate link status for each interrupt
0031 Don't set GJ%OLD for file parsing in COPY (FROM)
0032 Add TYPE command.
0033 Remove GETUSR call from SET DEFAULT command
0034 Copy name on co-routine call from DAPLIB
0035 Impliment wild card remote file access and fix various bugs
0036 Fix connected directory structure bug so typing the local
node is transparent
0037 Change record format calling arguments to allow all DAP
record and file attributes to be passed.
0040 Remove reference to D$ERRS and use G1%SLN to suppress logical
name expansion for parsing remote filespeces
0041 Make Account, User and Password valid switches for all commands
which access remote files.
0042 Fix bug to allow actual remote filespec to be displayed for directory
and copy commands if it is known
0043 Fix bug to allow directory file names greater than 39 characters.
0044 Clear valid bits on password, user-id and account if connect to remote
node fails because of invalid password or invalid user-id.
0045 Fix bug in wild logic which cause *.%36 (TO) *.%36.-1 to fail.
*** Changes for DECnet-20 V3.0 begin here ***
0046 Add code to support PRINT command.
0047 Fix a bug in calls to D$CLOS which produced an invalid disconnect
reason code to be sent.
0050 Change all interrupt processing to use level 1 and make LEV1PC
global so it may be accessed in D$INTR.
0051 Add ^O trapping to type command to abort current file
being typed.
0052 Make node table dynamic to prevent illegal instruction traps.
0053 Save DSTFIL across call to DAPOPN so we don't loose track
of device and directory on wild card storage.
0054 Don't loose track of destination directory and device when
doing wild retrieves.
*** Engineering responsibility changes hands here ***
0055 Don't loose the destination file spec when calling CHKPTR.
This solves a class of problems in which the file is copied
to the wrong structure or directory.
0056 Don't leave out fields in the destination file spec.
Also, always generate file name and file type for
destination file. Again this solves problems concerning
files being copied to the wrong structure, directory, or
with a bad file name.
0057 Print error message when a bad switch is typed.
0060 Allow underscore, and dollar sign in user identification,
account field, and password. Some remotes allow such characters.
0061 Implement wildcards for tops-10, rsts, ias, amd 11m when
ppn or ; before generation is specified.
0062 Treat a file spec with the local node name as remote if both
files are local.
This resolves the problem of local node file access using NFT.
Without this change a user who had valid accounting info
to access a local directory was refused access because his
job didn't have local access privleges.
0063 Error messages for many things are very unclear.
Error messages for bad node name, file name or accounting
switches improved.
0064 The default for account and userid should be null. A null
password should be allowed. The help text should
be available for account userid and password.
0065 Allow all file names to be greater than 6 characters in length.
0066 When doing a DIR command, give a new node, volume, and
directory heading whenever either volume or directory
change.
0067 If the last written date is not provided print the
creation date.
0070 Add support for poor man's routing.
0071 The code which reads NFT.INIT uses code from the TAKE
command. Any error within this code can produce bad
error messages or a fatal NFT error.
0072 The code which displays INFO DECNET never marks nodes
offline if their status changes.
0073 The INFO DECNET code used the stack for the NODE temp
storage. If the number of available nodes is high, this
is too small. Listing should be alphabetical and neat.
0074 The Default file name routine FILGET parsed a device field
and stopped on $-_. These characters are valid logical name
characters on TOPS-20 and on remote systems. Allow them.
0075 Add status message when ^A is typed.
0076 In an effort to make security better, print a warning message
whenever a password is found in a command file which allows
read access to the world.
0077 Warn the user if NFT makes assumptions about the nodes
in file specifications.
0100 If the comnd JSYS gets a very unexpected error, NFT can
loop forever repeating the JSYS.
\ ;end revision history
SUBTTL Constants and assembly parameters
;[0075] Externals
EXTERNAL PMRFLG,.DNINI,MESIN,MESOUT,LOCJFN,PAGFLG,PAGNUM
EXTERNAL LLSTAT
GLOB DATEND ;End of impure data
;Constants
XP DAPLNK,1 ;Request 1 logical link
XP DEBUGW,135 ;DEBUGW
XP MAXNOD,^D128 ;Starting size of node table
ND PDLEN,400 ;Size of our stack
XP GJFSIZ,20 ;Size of the GTJFN block
XP FILSIZ,40 ;Maximum size of a file name
XP NAMSIZ,20 ;Size of name string storage
XP FFSPEC,111110B17+JS%PAF ;Full file spec expansion
;Interrupt channel assignments
XP .ICCNO,0 ;Control-O channel
XP .ICCDN,1 ;Connect/Disconnect
XP .ICDAV,2 ;Data available
XP .ICIMA,3 ;Interrupt message
;Node data offsets
PHASE 0
ND$NAM: BLOCK 2 ;NODE NAME STRING
ND$STA: BLOCK 1 ;NODE STATUS
ND$OST: BLOCK 1 ;NODE OPERATING SYSTEM TYPE
ND$DEV: BLOCK NAMSIZ ;DEFAULT DEVICE FOR NODE
ND$USR: BLOCK NAMSIZ ;NODE USER STRING
ND$ACT: BLOCK NAMSIZ ;NODE ACCOUNT STRING
ND$PSW: BLOCK NAMSIZ ;NODE PASSWORD STRING
ND$LEN==. ;ALLOCATION PER NODE
DEPHASE
;Daplib function block definitions
MSKSTR DPFNC,FNCBLK+.DFFLG,DF%ACC ;Dap function
MSKSTR DPLNK,FNCBLK+.DFFLG,DF%LNK ;Dap link
MSKSTR DPLFA,FNCBLK+.DFLFA,-1 ;Dap local file attribs
MSKSTR DPLFS,FNCBLK+.DFLFS,-1 ;Dap local filespec
MSKSTR DPRTN,FNCBLK+.DFRTN,-1 ;Dap called co-routine
MSKSTR DPRFA,FNCBLK+.DFRFA,-1 ;Dap remote file attribs
MSKSTR DPRFS,FNCBLK+.DFRFS,-1 ;Pointer to remote file
SUBTTL LOCAL MACROS
DEFINE TXT(TEXT) <POINT 7,[ASCIZ\TEXT\]>
DEFINE $FD(NAME) <
XWD 10,0
ASCIZ\NAME\>
;REPARS PARSE ERROR MACRO
DEFINE REPARS (MESSAGE) <
JRST [MOVX S1,TXT(MESSAGE)
JRST .REPAR]>
;MACRO TO PROMPT FOR COMMAND
DEFINE PROMPT (MESSAGE) <
$CALL [MOVX S1,TXT(MESSAGE)
PJRST DPROMPT]
> ;END OF PROMPT DEFINITION
;MACRO TO PRINT GUIDEWORDS
DEFINE NOISE (SHT) <
$CALL [MOVEI S1,[EXP FLD(.CMNOI,CM%FNC),TXT(SHT)]
PJRST RFIELD]
> ;END OF NOISE DEFINITION
;MACRO TO REQUIRE CONFIRMATION
DEFINE CONFRM <
$CALL [MOVEI S1,[FLD(.CMCFM,CM%FNC)]
PJRST RFIELD]
> ;END OF CONFRM DEFINITION
;MACRO TO MAKE TABLE ENTRY
DEFINE T (WORD,ADDRES) <
IFB <ADDRES>,<[ASCIZ /WORD/],,.'WORD>
IFNB <ADDRES>,<[ASCIZ /WORD/],,ADDRES>>
;MACRO TO MAKE SWITCH TABLE ENTRY
DEFINE SW (TXT) <[ASCIZ/TXT/],,.SW'TXT>
DEFINE SV (TXT) <[ASCIZ/TXT:/],,.SW'TXT>
SUBTTL Job version and entry vector
LOC 137 ;SET THE VERSION
.JBVER: EXP VNFT
RELOC 0
; ENTRY VECTOR DEFINITION
ENTVEC: JRST NFT ;MAIN ENTRY POINT
JRST REE ;REENTER ENTRY POINT
EXP VNFT ;VERSION OF NFT PROGRAM
SUBTTL Initialization blocks
IB: $BUILD (IB.SZ)
$SET (IB.PRG,,'NFT ') ;Set program name
$SET (IB.OUT,,LOGCHR) ;DEFAULT TEXT OUTPUT ROUTINE
$SET (IB.INT,,<LEVTAB,,CHNTAB>)
$EOB
DAPIB: $BUILD (.DISIZ) ;Dap initialization block
$SET (.DIFLG,DI%CNT,1) ;Request 1 link
$EOB
SUBTTL MAIN ENTRY POINT AND INITIALIZATION
NFT: RESET
MOVE P,[IOWD PDLEN,PDL] ;SET UP STACK
SETZM DATORG ;Clear impure storage
MOVE S1,[DATORG,,DATORG+1] ; Our first location thru
BLT S1,DATEND-1 ; Last location of DAP storage
SKIPN PMRFLG ;[70]
JRST NOPMR ;[70]
MOVEI S1,CONBLK ;[70]
$CALL .DNINI ;[70]INITIALIZE PMR TABLES
$FATAL (Error during initialization of PMR tables) ;[70]
NOPMR: MOVEI S1,IB.SZ
MOVEI S2,IB
$CALL I%INIT ;GET THE LIBRARY
$CALL PSIINI ;INITIALIZE PSI SYSTEM
MOVX S1,TXT(FAL)
SKIPE DEBUGW
MOVX S1,TXT(FAL-DEBUG)
$TEXT (<-1,,OBJNAM>,<^Q/S1/^0>) ;BECOME FAL
MOVEI S1,.DISIZ
MOVEI S2,DAPIB
$CALL D$INIT ;Init DAPLIB
$CALL NODGET ;BUILD NODE TABLE
JRST DOCMD ;Start processing commands
SUBTTL Parser and Command dispatch
REE: MOVE P,[IOWD PDLEN,PDL] ;REENTER ADDRESS
SKIPN TAKFLG ;DOING A TAKE?
JRST PARSER ;NO..JUST PROCESS COMMANDS
JRST CMDEOF ;YES..FORCE TERMINATION
DOCMD: $CALL CMDINI ;DISPLAY AND INITIALIZE
JUMPF PARSER
$CALL CLRGJF ;CLEAR JFN BLOCK
MOVX S1,GJ%OLD ;File must exist
MOVEM S1,GJFBLK ;SAVE FOR GTJFN
MOVE S1,LOCNOD
HRROI S1,ND$USR(S1) ;Point to logged in directory
MOVEM S1,.GJDIR+GJFBLK ;Save in GTFJN block
MOVEI S1,GJFBLK ;Point to block
MOVX S2,TXT(PS:NFT.INIT) ;Get initialization file name
GTJFN
ERJMP PARSER
MOVEM S1,CMDJFN ;Save JFN
SETZ T4, ;Clear display flag
$CALL TAKINI ;[0071]Take the file
SETZM INIFLG ;[0071]Clear the NFT.INIT flag
PARSER: $CALL CNODIS ;TURN OF ^O PROCESSING
HRROI S1,PRMPT ;YES..SET THE PROMPT
$CALL DPROMPT ;INITIAL SBK
$CALL RELJFN ;RELEASE UNOPEN JFN'S
$CALL RELNOD ;Release temporary nodes
MOVEI S1,KEYFDB ;POINT TO COMMAND WORDS
$CALL RFIELD ;PARSE COMMAND WORD
HRRZ T1,(S2) ;Save routine address
MOVEI S1,FNCSIZ ;Get size of function area
MOVEI S2,FNCBEG ;Point to it
$CALL .ZCHNK ;Clear it
$CALL TAKTST ;Display command if doing take
$CALL 0(T1) ;Call proper processor
JRST PARSER
KEYFDB: FLD(.CMKEY,CM%FNC+CM%BRK) ;KEYWORD FUNCTION
CMDTBL ;FROM COMMAND TABLE
0
0
CMDBRK
CMDBRK: 777777,,777760 ;Break on all control
777773,,777760 ;Allow /
400000,,000760 ;Allow A-Z
400000,,000760 ;Allow Lower case a-z
CMDTBL: CMDSIZ-1,, CMDSIZ ;CURRENT,,MAX SIZE OF COMMAND TABLE
T (COPY) ;COPY (FROM) (TO)
T (DELETE) ;DELETE (REMOTE FILES)
T (DIRECTORY) ;DIRECTORY (OF REMOTE FILES)
T (EXIT) ;EXIT TO MONITOR
T (HELP) ;OUTPUT HELP MESSAGE
T (INFORMATION)
T (PRINT) ;PRINT REMOTE FILE
T (SET) ;SET MODES COMMAND
T (SUBMIT) ;SUBMIT (REMOTE FILES)
T (TAKE) ;TAKE (COMMAND FROM) FILESPEC
[CM%FW+CM%INV
ASCIZ /TRACE/],,.TRACE ;TRACE (MESSAGES) invisible command
T (TYPE) ;TYPE (REMOTE FILES)
CMDSIZ== .-CMDTBL
SUBTTL COPY command
.COPY: STKVAR <<SRCDEF,DEFSIZ>> ;TEMP AREA TO SAVE DEFAULTS
NOISE (FROM)
MOVEI S1,CPYRTN ;Get co-routine address
STORE S1,,DPRTN ;Save for D$FUNC
$CALL CLRGJF ;CLEAR JFN BLOCK
MOVX S1,GJ%IFG+GJ%OLD ;Allow wild cards
MOVEM S1,GJFBLK
HRROI S1,SRCNAM ;Place to store node stuff
HRROI S2,SRCFIL ;Place to store file string
MOVX T1,TXT(input filespec)
SETZM SRCPFL ;[0061] ALLOW CONVERSION
$CALL PARFIL ;Get a file spec
MOVEM S1,SRCNOD ;Save source node
MOVEM S2,SRCJFN ;Save source JFN
MOVX S2,TXT(input file switches) ;Get help text
$CALL PARSWS ;Look for switches if any
JUMPF [MOVX S1,TXT(?Illegal switch:) ;[0057]Give error message...
$CALL TSTCOL ;[0057]...for bad switches
$CALL TYPATM ;[0057]
$CALL RELJFN ;[0057]
JRST CMDER1] ;[0057]
MOVE S1,FILATT ;Get file format switches
MOVEM S1,SRCSWS ;Save as source switches
HRLI S1,DEFBEG ;GET SOURCE ADDRESS
HRRI S1,SRCDEF ;GET DEST ADDRESS
BLT S1,DEFSIZ-1+SRCDEF ;SAVE THE DEFAUTLS
NOISE (TO)
HRROI S1,SRCFIL ;POINT TO SOURCE NAME
MOVX S2,GJ%OFG+GJ%FOU+GJ%IFG+GJ%MSG ;ALLOW WILD CARDS
$CALL FILDEF ;SET UP OUTPUT NAME DEFAULTS
SETZM GJFBLK+.GJDEV ;DON'T DEFAULT DEVICE
SETZM GJFBLK+.GJDIR ;OR DIRECTORY
HRROI S1,DSTNAM ;Place to store dest node name
HRROI S2,DSTFIL ;Place to store dest file name
MOVX T1,TXT(output filespec)
SETZM DSTPFL ;[0061]ALLOW CONVERSION
$CALL PARFIL ;Get a filespec
MOVEM S1,DSTNOD ;Save destination node
MOVEM S2,DSTJFN ;Save destination JFN
MOVX S2,TXT(output file switches) ;Get help text
$CALL PARSWS ;LOOK FOR OPTIONAL SWITCHES
JUMPF [MOVX S1,TXT(?Illegal switch:) ;[0057]Give error messages...
$CALL TSTCOL ;[0057]...for bad switches
$CALL TYPATM ;[0057]
$CALL RELJFN ;[0057]
JRST CMDER1] ;[0057]
MOVE S1,FILATT ;Get file format switches
MOVEM S1,DSTSWS ;Save for destination file
CONFRM
COPY40: SETOM NAMFLG ;Say name is not displayed
SKIPN SRCNOD ;[0062]IF BOTH SOURCE...
SKIPE DSTNOD ;[0062]...AND DEST ARE UNTYPED
JRST COPY45 ;[0062]
MOVE S1,LOCNOD ;[0062]THEN MARK DEST AS REMOTE
MOVEM S1,DSTNOD ;[0062]
$TEXT (,<%No remote node specified, assuming destination file is remote>) ;[77]
COPY45: SKIPN SRCNOD ;Source node local
JRST COPY60 ;Yes..send the files
SKIPN DSTNOD ;Destination node local
JRST COPY70 ;Yes..recieve a file
MOVE S1,LOCNOD ;[0062]
CAMN S1,SRCNOD ;[0062]SOURCE REALLY LOCAL?
JRST [SETZM SRCNOD ;[0062]
$TEXT (,<%No local node specified, assuming source file is local>) ;[77]
JRST COPY40] ;[0062]
CAMN S1,DSTNOD ;[0062]DEST REALLY LOCAL?
JRST [SETZM DSTNOD ;[0062]
$TEXT (,<%No local node specified, assuming destination file is local>) ;[77]
JRST COPY40] ;[0062]
REPARS (Remote to Remote transfers not supported)
;COPY60 Routine to send files to remote node
COPY60: SETOM SNDFLG ;Remember we are sending
MOVX S1,AF$CRE ;Function is create remote file
STORE S1,,DPFNC
MOVEI S1,DAPLNK ;Get requested link
STORE S1,,DPLNK ;Save it
MOVE S1,SRCSWS ;Get source switches
STORE S1,,DPLFA ;Save local file attributes
HRROI S1,SRCFIL ;Point to local filespec
STORE S1,,DPLFS ;Save for D$FUNC
MOVE S1,DSTSWS ;Get destination file switches
STORE S1,,DPRFA ;Save remote file attributes
HRROI S1,DSTFIL ;Point to dest file name
STORE S1,,DPRFS ;Save for D$FUNC
MOVE S1,[POINT 7,DSTFIL] ;Check what user typed
$CALL OUTFLG
DMOVEM S1,DSTFLG ;Save for call to OUTNAM
MOVE S1,SRCJFN ;GET SOURCE JFN
SKIPE S2,DSTNOD ;Get destination node
$CALL NODOFF ;Mark node off-line
MOVEM S2,REMNOD ;Save for call to GETUSR
MOVE S1,SRCJFN ;Get source JFN
TXNN S1,GJ%DEV+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;Wild cards?
JRST COPY61 ;No..Check for output wild cards
SKIPE S1,DSTJFN ;Must have Destination JFN
TXNN S1,GJ%DEV+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;and must be wild
JRST WLDERR
COPY61: MOVE S1,[DSTFIL,,TMPFIL] ;HACK TO SAVE DST ACROSS
BLT S1,TMPFIL+FILSIZ-1 ;CALLS TO DAP OPEN
COPY62: HRROI S1,SRCFIL ;Point to source file storage
HRRZ S2,SRCJFN ;Expand without wild cards
MOVX T1,FFSPEC
JFNS ;Get current file name
MOVE S1,[TMPFIL,,DSTFIL]
BLT S1,DSTFIL+FILSIZ-1
COPY63: DMOVE S1,DSTFLG ;Get dest pointer and flags
$CALL OUTNAM ;Yes..Get output filename
JUMPF WLDERR ;Bad wild cards
SKIPE DSTNOD ;Expand file name if local
JRST COPY64 ;No..don't expand local name
MOVX S1,GJ%SHT+GJ%FOU
HRROI S2,DSTFIL
$CALL NAMEXT
COPY64: $CALL DAPOPN ;Make sure link is OPEN
MOVEI S1,DSTFIL ;[0061]DEST STRING
SKIPE DSTPFL ;[0061]NEED RECONVERSION?
$CALL RESNAM ;YES
$CALL DAPFNC ;Do the function
MOVE S1,SRCJFN ;Get source JFN
GNJFN ;Do the next file
JRST DAPCLS ;Finish up
MOVE S1,REMNOD ;Get pointer to remote node
HRRZ S1,ND$OST(S1) ;Get system type
CAIN S1,.OSRXM ;RSX?
$CALL DAPCLS ;Yes..close link each time
JRST COPY62 ;Do the next file
;COPY70 Routine to recieve files from remote node
COPY70: SETZM SNDFLG ;Remember we are recieving
MOVX S1,AF$OPN ;Function is read remote file
STORE S1,,DPFNC
MOVEI S1,DAPLNK ;Get requested link
STORE S1,,DPLNK ;Save it
MOVE S1,SRCSWS ;Get source file switches
STORE S1,,DPRFA ;Save remote file attributes
HRROI S1,SRCFIL ;Point to source file name
STORE S1,,DPRFS ;Save for D$FUNC
SKIPE SRCNOD ;Source node local?
JRST COPY72 ;No..dont expand file name
MOVX S1,GJ%SHT+GJ%OLD+GJ%IFG ;Get JFN flags
HRROI S2,SRCFIL ;Point to destination
$CALL NAMEXT ;Expand the name
COPY72: MOVE S1,[POINT 7,DSTFIL] ;Point to user input
$CALL OUTFLG ;Find out what they typed
DMOVEM S1,DSTFLG ;Save for call to OUTNAM
MOVE S1,DSTSWS ;Get destination switches
STORE S1,,DPLFA ;Save local file attributes
HRROI S1,DSTFIL ;Point to destination file name
STORE S1,,DPLFS ;Save as local filespec
SKIPE S2,SRCNOD ;Get source node
$CALL NODOFF ;Mark node off-line
MOVEM S2,REMNOD ;Save for Call to GETUSR
HRLI S1,SRCDEF ;Reclaim source defaults
HRRI S1,DEFBEG
BLT S1,DEFSIZ-1+DEFBEG ;For GETUSR
DMOVE S1,DSTFLG ;Get destination flags
MOVE T1,DSTJFN ;GET DESTINATION JFN
TXO S2,GJ%DIR ;[0054]ALWAYS GET DIR TO MAKE
;[0054]LOGICAL NAMES WORK
$CALL OUTNAM ;Yes..Generate output filename
JUMPF WLDERR ;Bad wild cards
MOVX S1,GJ%SHT+GJ%FOU ;File for output
HRROI S2,DSTFIL
$CALL NAMEXT ;Expand output file name
JFCL ;Don't care if this fails
$CALL DAPOPN ;Make sure link is open
MOVEI S1,SRCFIL ;[0061]ADDRESS OF SOURCE FILE STRING
SKIPE SRCPFL ;[0061]NEED RECONVERSION?
$CALL RESNAM ;[0061]YES
$CALL DAPFNC
JRST DAPCLS
CPYRTN: CAIN S1,.DMACK ;ACK FOR ACCESS?
PJRST CPYACK ;Yes..check for file display
CAIN S1,.DMACP ;ACCESS COMPLETE?
JRST CPYACP ;Yes..display [OK]
SUBI S1,.DMNAM ;Try for name message
TRNE S1,-1
$RETT ;Return for all else
$CALL SAVNAM ;Store name
SKIPT SNDFLG ;Sending files?
JRST CPYRCV ;No..must be recieving
JRST CPYSND ;Yes..setup proper text
CPYACK: AOSE NAMFLG ;File text displayed?
$RETT ;Yes..just return
SKIPE S1,SRCNOD ;Source node local?
$TEXT (,^T/@S1/::^A) ;no..display it
$TEXT (,^T/SRCFIL/^T/FROMTO/^A);Display source file
SKIPE S1,DSTNOD ;Destination node local?
$TEXT (,^T/@S1/::^A) ;no..display it
$TEXT (,^T/DSTFIL/^A) ;Display destination file
$RETT
CPYACP: $TEXT (, [OK]) ;Display OK
SETOM NAMFLG ;Say name is not displayed
$RETT ;Return
CPYSND: TLNE S1,NA$FSP ;Actual remote filespec?
$TEXT (<-1,,DSTFIL>,<^Q/S2/^0>) ;Yes..save as destination file
SKIPN S1 ;Expanded local filespec?
$TEXT (<-1,,SRCFIL>,<^Q/S2/^0>) ;Yes..save as source file
$RETT
CPYRCV: TLNE S1,NA$FSP ;Actual remote filespec?
$TEXT (<-1,,SRCFIL>,<^Q/S2/^0>) ;Yes..save as source file
SKIPN S1 ;Expaned local filespec?
$TEXT (<-1,,DSTFIL>,<^Q/S2/^0>) ;Yes..save as destination file
TLNN S1,NA$FNM ;Doing wild operation?
$RETT ;No..just return
$TEXT (<-1,,SRCFIL>,^T/VOLNAM/^T/DIRNAM/^T/FILNAM/^0)
SKIPL NAMFLG ;Name displayed?
$CALL CPYACP ;Yes..display [ok]
PUSH P,P2 ;[0061]Convert names supplied...
MOVE S1,[POINT 7,SRCFIL] ;[0061]...in a name message
MOVEI P2,SRCFIL ;[0061]
$CALL COVNAM ;[0061]
POP P,P2 ;[0061]
MOVX S1,GJ%SHT+GJ%OFG ;Get parse only JFN for name
HRROI S2,SRCFIL
GTJFN
ERJMP CPYNA1 ;Try file name only
JRST CPYNA2 ;Generate output filename
CPYNA1: MOVX S1,GJ%SHT+GJ%OFG
HRROI S2,FILNAM
GTJFN
ERJMP .RETF ;Fail if JFN not assigned
CPYNA2: HRRZM S1,REMJFN ;Save JFN for OUTNAM
HRROI S1,DSTFIL ;Generate destination name
MOVX S2,GJ%NAM+GJ%EXT+GJ%VER ;[0054]
MOVE T1,DSTFLG+1 ;See what caller typed
ANDX T1,GJ%DEV+GJ%DIR
IOR S2,T1 ;Generate required fields
PUSH P,S1 ;[54]SAVE ACS
PUSH P,S2 ;[54]
PUSH P,T1 ;[54]
PUSH P,T2 ;[54]
MOVE S2,DSTJFN ;[54]DOES THIS FILE SPEC...
MOVX T1,FLD(1,JS%DIR) ;[54]HAVE A DIR FIELD?
SETZ T2, ;[54]
JFNS ;[54]
POP P,T2 ;[54]
POP P,T1 ;[54]
POP P,S2 ;[54]
CAME S1,[-1,,DSTFIL] ;[54]
TXO S2,GJ%DIR ;[0054]ALWAYS GET DIR TO MAKE
;[0054]LOGICAL NAMES WORK
POP P,S1 ;[54]
$CALL OUTNAM ;Generate output name
MOVX S1,GJ%SHT+GJ%FOU ;File for output
HRROI S2,DSTFIL ;Store in DSTFIL
$CALL NAMEXT ;Expand the name
MOVE S1,REMJFN
RLJFN ;Release the JFN
ERJMP .+1
SETZM REMJFN ;Null the JFN
MOVEI S1,SRCFIL ;[0061]
SKIPE SRCPFL ;[0061]Need reconversion?
$CALL RESNAM ;[0061]Yes, reconvert file name
$RET ;Return True/false per OUTNAM
SUBTTL DELETE DIRECTORY SUBMIT TRACE and TYPE commands
.DELET: NOISE (REMOTE FILES)
MOVX S1,AF$ERA ;Function is delete remote files
MOVEI S2,REMRTN ;General Co-routine
MOVX T1,TXT<> ;No default name or extenstion
MOVX T2,GJ%IFG+GJ%OLD ;Allow wild cards
JRST REMFIL ;Enter common Code
.DIREC: NOISE (OF REMOTE FILES)
MOVX S1,AF$DIR ;Function is directory
MOVEI S2,DIRRTN ;Directory Co-routine
MOVX T1,TXT(*.*) ;Default name and ext
MOVX T2,GJ%IFG+GJ%OLD+.GJALL ;Wild and * for version
JRST REMFIL ;Enter common code
.PRINT: NOISE (REMOTE FILES) ;Function is print remote files
MOVX S1,AF$PRN ;At remote node
MOVEI S2,REMRTN
MOVX T1,TXT()
MOVX T2,GJ%IFG+GJ%OLD
JRST REMFIL
.SUBMI: NOISE (REMOTE FILES)
MOVX S1,AF$EXE ;Function is submit remote files
MOVEI S2,REMRTN ;General Co-routine
MOVX T1,TXT(.CTL) ;Default extention is .CTL
MOVX T2,GJ%IFG+GJ%OLD ;Allow wild cards
JRST REMFIL ;Enter common code
.TRACE: NOISE (DAP MESSAGES)
CONFRM
MOVEI S1,.PRIOU
MOVEM S1,DAPIB+.DIMSG ;Store for output
MOVEI S1,.DISIZ
MOVEI S2,DAPIB
$CALL D$INIT ;Re-initialize DAPLIB
$RETT
.TYPE: NOISE (REMOTE FILES)
MOVX S1,AF$TYP ;Function is type remote files
MOVEI S2,TYPRTN ;General Co-routine
MOVX T1,TXT() ;No default name or extenstion
MOVX T2,GJ%IFG+GJ%OLD ;Allow wild cards
SETOM CNOFLG ;Request control O processing
JRST REMFIL ;Enter common code
SUBTTL REMFIL Common parsing routine for remote filespec
REMFSW: FLD(.CMCFM,CM%FNC)+REMFS1
REMFS1: FLD(.CMSWI,CM%FNC)
REMSWS
REMSWS: REMSIZ,,REMSIZ
SV (ACCOUNT)
SV (PASSWORD)
SV (USER)
REMSIZ==.-REMSWS-1
REMFIL: STORE S1,,DPFNC ;Save requested function
STORE S2,,DPRTN ;Save for D$FUNC
MOVEI S1,DAPLNK ;Get requested link
STORE S1,,DPLNK ;Save it
DMOVE S1,T1 ;Get Defaults
$CALL FILDEF ;Set them up
HRROI S1,SRCNAM ;Point to destination for NODE
HRROI S2,SRCFIL ;Point to destination for file
MOVX T1,TXT(remote filespec)
$CALL PARFIL ;Parse a file spec
MOVEM S1,SRCNOD ;Save source node
MOVEM S2,SRCJFN ;Save JFN
MOVEI S1,SRCFIL ;[0061]
SKIPE SRCPFL ;[0061]WAS FILE NAME CHANGED?
$CALL RESNAM ;[0061]RESTORE TRUE FILE NAME
REMF20: MOVEI S1,REMFSW ;Point to Delete switches
$CALL RFIELD
CAIN T2,.CMCFM ;Parse a confirm?
JRST REMF30 ;Yes..go finish up
HRRZ S2,0(S2) ;No..must be a switch
PUSHJ P,0(S2) ;Call the processor
JRST REMF20 ;Look for confirm
REMF30: SETZM NAMFLG ;Say name not yet displayed
SETZM VOLNAM ;Null volume name
SETZM DIRNAM ;Null directory name
SETZM FILNAM ;Null file name
SETZM FILSPC ;Null file spec
SETZM FILNAM ;Say file name is missing
SKIPE S2,SRCNOD ;Get source node
$CALL NODOFF ;Mark node off-line
MOVEM S2,REMNOD ;Save for Call to GETUSR
HRROI S1,SRCFIL ;Point to file name
STORE S1,,DPRFS ;Save for D$FUNC
MOVE S2,SRCJFN ;Get source JFN
MOVX T1,FFSPEC ;Do full name expansion if local
SKIPN SRCNOD
JFNS
REMF40: SKIPF CNOFLG ;Want control O interrupts?
$CALL CNOENA ;Yes..enable them
$CALL DAPOPN ;Make sure link is open
$CALL DAPFNC ;Do the function
JRST DAPCLS ;Finish up nicely
SUBTTL DIRRTN Co-routine for Directory command
;DIRRTN is called from DAPLIB durring function execution
;ACCEPTS S1/ [Flags],,DAP message
; S2/ [Arguments]
DIRRTN: CAIE S1,.DMATT ;Attributes?
CAIN S1,.DMACK ; Or ACK?
JRST DIRATT ;Yes..process it
SUBI S1,.DMNAM ;Try for name message
TRNE S1,-1 ;Is it some type of name?
$RETT ;No..just return
$CALL SAVNAM ;Yes..store the pointer
TLNN S1,NA$DIR ;[0066]DIRECTORY NAME?
SKIPE NAMFLG ;[0066]OR VOL NAME?
JRST DOHDR ;[0066]YES
TLNE S1,NA$VOL ;[0066]VOL NAME?
SETOM NAMFLG ;[0066]FLAG IT FOR NEXT TIME
$RETT ;No..just return
DOHDR: $TEXT (,^M^J ^T/@REMNOD/::^T/VOLNAM/^T/DIRNAM/)
SETZM NAMFLG ;[0066]CLEAR VOL NAME SEEN FLAG
$RETT
;DIRATT is called with address of remote files FDB in S2
DIRATT: SKIPN FILNAM ;Was filename returned?
$TEXT (<-1,,FILNAM>,<^T/SRCFIL/^0>)
$TEXT (<-1,,DIRTXT>,<^T/FILNAM/;P^O6L/.FBPRT(S2)/^0>)
$TEXT (<-1,,DIRTX1>,<^D4R /.FBBYV(S2),FB%PGC/ ^D/.FBSIZ(S2)/(^D/.FBBYV(S2),FB%BSZ/)^0>)
$TEXT (,<^T30L /DIRTXT/^T15L /DIRTX1/^A>)
SKIPN .FBWRT(S2) ;[67]
JRST DIRAT1 ;[67]
$TEXT (,< ^H/.FBWRT(S2)/^A>) ;Yes..display it
$TEXT (,) ;Do final crlf
$RETT
DIRAT1: SKIPE .FBCRV(S2) ;[67]
$TEXT (,< ^H/.FBCRV(S2)/^A>) ;[67]
$TEXT (,) ;[67]
$RETT ;[67]
SUBTTL REMRTN Common Co-routine for DELETE and SUBMIT commands
;ACCEPTS S1/ [Flags],,msg type
; S2/ [Argument pointer]
REMRTN: CAIN S1,.DMACP ;Access complete?
PJRST REMACP ;Yes..process it
SUBI S1,.DMNAM ;Check for name function
TRNE S1,-1 ;Was it?
$RETT ;No..just return
REMNAM: $CALL SAVNAM ;Yes..store the pointers
TLNE S1,NA$FNM ;File name?
JRST REMFNM ;Yes..process it
TLNN S1,NA$FSP ;File spec?
$RETT ;No..just return
SKIPN DIRNAM ;Wild operation?
SKIPE FILNAM
$RETT ;Yes..ignore NA$FSP
SKIPE NAMFLG ;Been here before?
$CALL REMSOK ;Yes..display previous [OK]
$TEXT (,^T/@REMNOD/::^Q/S2/^A);No..type the filespec
SETOM NAMFLG ;Say weve been here before
$RETT ;And return
REMFNM: SKIPE NAMFLG ;Been here before?
$CALL REMSOK ;Yes..display [OK]
$TEXT (,^T/@REMNOD/::^T/VOLNAM/^T/DIRNAM/^T/FILNAM/^A)
SETOM NAMFLG ;Say weve been here before
$RETT
REMACP: SKIPE NAMFLG ;Has name been displayed?
JRST REMSOK ;Yes..display final OK
$TEXT (,^T/@REMNOD/::^T/SRCFIL/^A) ;No..display original name
REMSOK: $TEXT (, [OK]) ;Display ok message
SETZM NAMFLG ;Ready for next name display
$RETT
SUBTTL TYPRTN Co-routine for TYPE command
;ACCEPTS S1/ [Flags],,msg type
; S2/ [Argument pointer]
TYPRTN: SUBI S1,.DMNAM ;Check for name function
TRNE S1,-1 ;Was it?
$RETT ;No..just return
TYPNAM: $CALL SAVNAM ;Yes..store the pointers
TLNN S1,NA$FNM ;File name?
$RETT ;No..just return
SKIPF CNOFLG ;Trapping Control-O?
$CALL SUPOFF ;Yes..turn suppress bit off
$CALL TYPCRL ;Type CRLF if needed
$TEXT (, ^T/@REMNOD/::^T/VOLNAM/^T/DIRNAM/^T/FILNAM/^M^J)
SETOM NAMFLG ;Say name has been displayed
$RETT
TYPCRL: SKIPN NAMFLG ;Has name been displayed?
$RETT ;No..Just return
$TEXT ;Yes..display CRLF
$RETT
;SAVNAM is called with S1 containing flag indicating type of name msg
; S2 containing pointer to the asciz name string
SAVNAM: DMOVE T2,S1 ;Save flags and pointer
SETZ S1, ;Clear destination pointer
TLNE T2,NA$VOL ;Is it structure?
HRROI S1,VOLNAM ;Yes..store in volume name
TLNE T2,NA$DIR ;Directory?
HRROI S1,DIRNAM ;Yes..store in directory name
TLNE T2,NA$FNM ;File name?
HRROI S1,FILNAM ;Yes..store in filename
TLNE T2,NA$FSP ;Full file spec?
HRROI S1,FILSPC ;Yes..store in filespec
SKIPE S1 ;Destination specified?
$CALL STOSTR ;Yes..store the name
DMOVE S1,T2 ;Restore flags and pointer
$RETT ;Return
SUBTTL OUTDEF Routine to default output file name
OUTDEF: $CALL CLRGJF ;Clear file parse block
SKIPN S1,SRCJFN ;Source JFN given?
$RETT ;No..just return
MOVE T4,[-3,,1] ;Set up for <Dir>nam.ext
TXNN S1,GJ%DIR ;Directory have wild cards?
AOBJN T4,.+1 ;No..skip it
MOVX S1,GJ%FOU+GJ%OFG ;Allow wild + file for output
MOVEM S1,GJFBLK+.GJGEN ;Store the flags
OUTD.1: HLLZ S1,FSTRT(T4) ;GET FIELD
MOVE T1,FFLDT(T4) ;Get the offset of bits
HRRO S1,FSTRT(T4) ;POINT TO DESTINATION FOR STRING
MOVEM S1,GJFBLK+.GJDEV(T4) ;STORE THE POINTER
MOVE S2,SRCJFN ;PICK UP SOURCE JFN
JFNS ;Copy spec from souce
OUTD.4: AOBJN T4,OUTD.1 ;NEXT FIELD
$RETT
FSTRT: GJ%DEV+DEFDEV ;DEVICE STRING STORAGE
GJ%DIR+DEFDIR ;DIRECTORY STRING STORAGE
GJ%NAM+DEFNAM ;FILENAME STRING STORAGE
GJ%EXT+DEFEXT ;EXTENTION STRING STORAGE
GJ%VER+DEFVER ;VERSION STRING STORAGE
FFLDT: FLD(.JSAOF,JS%DEV) ;JFNS PRINT DEVICE
FLD(.JSAOF,JS%DIR) ;JFNS PRNT DIR
NIFLD==.-FFLDT ;NUMBER OF INPUT FIELDS
FLD(.JSAOF,JS%NAM) ;JFNS PRINT NAME
FLD(.JSAOF,JS%TYP) ;JFNS PRINT EXTENTION
FLD(.JSAOF,JS%GEN) ;JFNS PRINT VERSION
NFFLD=.-FFLDT ;NUMBER OF OUTPUT FIELDS
SUBTTL HELP and EXIT commands
; EXIT COMMAND
.EXIT: NOISE (TO MONITOR)
CONFRM
HALTF ;Exit to monitor
$RETT ;Return to parser if continued
; HELP COMMAND
HLPFOB: $BUILD (FOB.SZ)
$SET (FOB.FD,,[$FD(HLP:NFT.HLP)])
$SET (FOB.CW,FB.BSZ,7)
$SET (FOB.CW,FB.LSN,1)
$EOB
.HELP: NOISE (WITH NFT)
CONFRM
STKVAR <HLPIFN> ;IFN FOR HELP FILE
DMOVE S1,[EXP FOB.SZ,HLPFOB] ;POINT TO FILE INFO
$CALL F%IOPN ;OPEN THE FILE
JUMPF NOHELP
MOVEM S1,HLPIFN ;STORE THE IFN
HELP1: MOVE S1,HLPIFN
$CALL F%IBYT
JUMPF HELP2 ;FINISHED ON EOF
HRRZ S1,SBK+.CMIOJ ;GET OUTPUT JFN
BOUT
JRST HELP1 ;FINISH THE FILE
HELP2: MOVE S1,HLPIFN ;GET THE IFN
$CALL F%REL ;CLOSE THE FILE
$RETT ;And return
;HERE ON ERROR WITH HELP FILE
NOHELP: MOVX S1,TXT(No HELP available)
$CALL K%SOUT ;DUMP THE MESSAGE
$RETF ;GO PARSE NEXT COMMAND
SUBTTL INFORMATION command dispatch
.INFOR: NOISE (ABOUT)
MOVEI S1,INFFDB ;INFORMATION KEYTAB
$CALL CFIELD ;Get keyword and confirmation
HRRZ S2,(S2) ;GET DISPATCH ADDRESS
PUSHJ P,0(S2) ;CALL THE ROUTINE
$RETT ;RETURN TO CALLER
INFFDB: FLD(.CMKEY,CM%FNC)+CM%DPP ;DEFAULT POINTER
INFTBL ;KEYWORD TABLE
0 ;HELP
TXT (DECNET) ;Default is INF DECNET
INFTBL: INFSIZ,,INFSIZ
T (DECNET,INFDNT) ;Information about DECNET
T (DEFAULTS,INFDEF) ;Information about DEFAUTLS
INFSIZ==.-INFTBL-1
SUBTTL Information about DECNET
INFDNT: $SAVE <P1,P2,P3> ;[0073]
$CALL NODGET ;GET CURRENT NODE INFO
JUMPF [$TEXT (,<?Error getting list of available nodes>)
$RETF]
MOVE P2,NODTBL ;[0073]
HLRZ P1,0(P2) ;[0073]TABLE SIZE
JUMPE P1,INFDN2 ;[0073]EMPTY TABLE
ADDI P2,1 ;[0073]
INFDN1: HRRZ S2,0(P2) ;[0073]
MOVE S1,ND$STA(S2) ; AND IT'S STATUS
CAIN S1,.NDSON ;IS IT ONLINE?
JRST INFDN3 ;YES..TELL THEM
ADDI P2,1 ;[0073]
SUBI P1,1 ;[0073]
JUMPE P1,INFDN2 ;[0073]
JRST INFDN1 ;[0073]
INFDN2: $TEXT (,< No DECNET nodes are accessible>)
$RETF ;RETURN FAILURE
INFDN3: $TEXT (,< Accessible DECNET nodes are: ^A>)
MOVEI P3,5 ;[0073]
JRST INFDN5
INFDN4: MOVE S1,ND$STA(S2) ;GET NODE STATUS
CAIE S1,.NDSON ;IS IT ON LINE?
JRST INFDN6 ;NO..CHECK THE NEXT
$TEXT (,< ^A>) ;YES..DISPLAY A COMMA
SOSG P3 ;[0073]
JRST [$TEXT ;[0073]
MOVEI P3,^D9 ;[0073]
JRST .+1] ;[0073]
INFDN5: $TEXT (,<^T/ND$NAM(S2)/^A>) ;DISPLAY THE NODE NAME
INFDN6: ADDI P2,1 ;[0073]
SUBI P1,1 ;[0073]
JUMPE P1,INFDN7 ;[0073]END OF LIST
HRRZ S2,0(P2) ;[0073]
JRST INFDN4 ;[0073]
JUMPT INFDN4 ;PROCESS IT
INFDN7: $TEXT ;DISPLAY A CRLF
$RETT ;AND RETURN
SUBTTL Information about DEFAULTS
INFDEF: MOVE S1,NODLST ;POINT TO NODE LIST
$CALL L%FIRST ;POINT TO FIRST ENTRY
INFDE1: JUMPF .RETT ;QUIT AT END OF LIST
MOVE S1,S2 ;PUT ADDRESS IN S1
$CALL INFNOD ;DISPLAY THE DEFAULTS
MOVE S1,NODLST ;POINT TO NODE LIST
$CALL L%NEXT ;GET THE NEXT ENTRY
JRST INFDE1 ;LOOP THRU THEM ALL
;INFNOD Routine to display node and user information
;ACCEPTS S1/ Base of node data
;RETURNS TRUE Information has been displayed
INFNOD: MOVEI S2,1B35 ;Get String valid bit
TDNN S2,ND$USR(S1) ;User or account string valid?
TDNE S2,ND$ACT(S1)
JRST INFNO1 ;Yes..display the info
SKIPN ND$OST(S1) ;OSTYPE Specified?
$RETT ;No..just return
INFNO1: $TEXT (,<Node ^T/ND$NAM(S1)/::^A>) ;DISPLAY THE NODE NAME
TDNE S2,ND$USR(S1) ;Display only valid defaults
$TEXT (,</USER:^T/ND$USR(S1)/^A>) ;YES..DISPLAY IT
TDNE S2,ND$ACT(S1) ;Display only valid defaults
$TEXT (,</ACCOUNT:^T/ND$ACT(S1)/^A>) ;YES..DISPLAY IT
SKIPE ND$OST(S1) ;OSTYPE KNOWN?
$TEXT (,</OSTYPE:^Q/ND$OST(S1),LHMASK/^A>) ;YES..DISPLAY IT
$TEXT ;CRLF
$RETT ;NO..JUST RETURN
SUBTTL SET defaults command
.SET: MOVEI S1,SETFDB ;KEYWORD -- DEFAULT
$CALL PARSE ;PARSE THE KEYWORD
SKIPT ;PARSE OK?
REPARS (Invalid set command) ;NO..ERROR
HRRZ S2,(S2) ;GET DISPATCH ADDRESS
PUSHJ P,0(S2) ;DO THE ROUTINE
$RETT
SEDEFA: $SAVE <P1,P2>
NOISE (FOR NODE)
HRROI S1,SRCNAM ;Point to node text
MOVX S2,TXT(NODE::) ;Get help text
$CALL PARNOD
SKIPN S1 ;Node specified?
MOVE S1,LOCNOD ;No..use local node
MOVEM S1,SRCNOD ;Save as source node
MOVE P1,S1 ;Save for OSTYPE switch
SETZM P2 ;Clear count of switches specified
SEDEF1: MOVEI S1,DEFASW ;POINT TO OUR SWITCH FDB
$CALL RFIELD ;PARSE THE FIELD
CAIN T2,.CMCFM ;PARSE CONFIRMATION?
JRST SEDEF2 ;YES..FINISH UP
HRRZ S2,(S2) ;NO..GET PROCESSOR ADDRESS
PUSHJ P,0(S2) ;CALL THE PROCESSOR
AOJA P2,SEDEF1 ;LOOK FOR CONFIRM
SEDEF2: JUMPE P2,[MOVEI S2,1 ;Any switches specified?
ANDCAM S2,REMUSR ;NO..CLEAR VALID BIT FOR USER
ANDCAM S2,REMACT ;CLEAR VALID BIT FOR ACCOUNT
ANDCAM S2,REMPSW ;CLEAR VALID BIT FOR PASSWORD
JRST .+1]
MOVE S1,SRCNOD ;Get address of source node
MOVEI S2,.NDSOF ;Get off-line status
SKIPGE ND$STA(S1) ;Status already known?
MOVEM S2,ND$STA(S1) ;No..assume off-line
HRLI S2,REMUSR ;Copy defaults obtained from switches
HRRI S2,ND$USR(S1)
MOVE S1,S2
BLT S1,DEFSIZ-1(S2)
$RETT
DEFASW: FLD(.CMCFM,CM%FNC)+DEFAS1 ;CONFIRM OR SWITCH
DEFAS1: FLD(.CMSWI,CM%FNC) ;PARSE SWITCHES
DEFSWS ;FILE SWITCH TABLE
DEFSWS: XWD DFSSIZ,DFSSIZ ;DEFAULT SWITCH TABLE SIZE
SV (ACCOUNT)
SV (OSTYPE)
SV (PASSWORD)
SV (USER)
DFSSIZ==.-DEFSWS-1
SETFDB: FLD(.CMKEY,CM%FNC)+CM%DPP ;DEFAULT POINTER PRESENT
SETTBL ;SET KEYWORD TABLE
0 ;NO HELP
TXT (DEFAULTS) ;DEFAULT IS "DEFAULT"
SETTBL: SETSIZ,,SETSIZ
T (DEFAULTS,SEDEFA)
SETSIZ==.-SETTBL-1
SUBTTL PARFIL Routine to parse a network file specification
;ACCEPTS S1/ Destination pointer for node string
; S2/ Destination pointer for file spec string
; T1/ Pointer to help text for this parse
; GJFBLK/ Flags and defaults established
;RETURNS TRUE S1/ Address of node data if node exists
; or 0 if node wasn't typed or local node was specified
; or -1 if a new node was typed
; S2/ JFN acquired on behalf of the filespec
; or 0 if no JFN was obtained
P%%PPN==1B1 ;We saw [P,PN]
P%%GEN==1B2 ;We saw ;GEN
PARFIL: $SAVE <P1,P2,P3,P4> ;Save some Ac's
DMOVE P1,S1 ;Save calling pointers
MOVEM T1,CMDFDB+.CMHLP ;Save help pointer
MOVE T1,FILFDB+.CMFLG ;Get our file function
MOVEM T1,CMDFDB+.CMFLG ;Save it for COMND
PARFI1: MOVEI S1,CMDFDB ;Point to our FDB
$CALL RFLDE ;Try for a file
JUMPT PARFI5 ;We found a local file
JUMPE P1,CMDERR ;The file must be remote
MOVE T1,SBK+.CMPTR ;Get pointer to characters
MOVE T2,SBK+.CMINC ;Get unparsed count
MOVE T3,[POINT 7,ATMBUF] ;Point to destination
MOVEI T4,^D6 ;Allow six characters
PARFI2: $CALL PARFI9 ;Get character
CAIE S1," " ;Ignore spaces and tabs
CAIN S1,.CHTAB
JRST PARFI2 ;Back for more
SKIPA ;We have the character
PARFI3: $CALL PARFI9 ;Get character
CAIN S1,":" ;Node terminator?
JRST PARFI4 ;Yes..go check for next ":"
IDPB S1,T3 ;No..store the character
CAIL S1,"0" ;Check proper node syntax
CAILE S1,"9"
SKIPA ;Not numeric..check alpha
JRST PARFIX ;[0063]Back for next character
CAIL S1,"a" ;Upper case?
SUBI S1,40 ;Convert it to upper
CAIL S1,"A" ;has to be alpha
CAILE S1,"Z"
PJRST BADNOD ;[0063]
PARFIX: SOJGE T4,PARFI3 ;[0063]Back for rest of node
PJRST BADNOD ;[0063]
PARFI4: $CALL PARFI9 ;Get next character
CAIE S1,":" ;Second delimiter for NODE::?
PJRST BADNOD ;[0063]
SETZ S1, ;Get a null
IDPB S1,T3 ;Terminate atom
MOVEM T1,SBK+.CMPTR ;We've just parsed the node
MOVEM T2,SBK+.CMINC ;Save count of unparsed chars
$CALL PARNO1 ;Get the node index
MOVE P1,S1 ;[0062]Remember node index for return
MOVE S1,FILFDB ;[0062]GET REMOTE FILE SPEC
MOVEM S1,CMDFDB+.CMFLG ;Save for PARSE
MOVE S1,GJFBLK ;Get starting flags
TXZ S1,GJ%IFG+GJ%OLD+GJ%MSG ;Clear wild input flag
TXO S1,GJ%OFG ;Get parse only flag
MOVEM S1,GJFBLK ;Save for next parse
PARFI6: MOVX S1,G1%SLN ;Suppress logical name expansion
IORM S1,GJFBLK+.GJF2 ;Set for GTJFN
MOVE S1,SBK+.CMPTR ;[0061]
$CALL COVNAM ;[0061]Convert non-20 style file names
MOVEI S1,CMDFDB ;[0061]
$CALL RFLDE ;[0061]Now parse it as a 20 filename
JUMPF [HRROI S1,[ASCIZ/
?Syntax error in remote file name - /]
PSOUT ;[0063]
MOVEI S1,.PRIOU ;[0063]
MOVE S2,[.FHSLF,,-1] ;[0063]
SETZ T1, ;[0063]
ERSTR ;[0063]PRINT LAST ERROR IN THIS PROCESS
JFCL ;[0063]
JFCL ;[0063]
HRROI S1,[ASCIZ /
/]
PSOUT ;[0063]
JRST CMDER1] ;[0063]
SKIPA ;Remember, we parsed a node!
PARFI5: SETZ P1, ;We parsed local node
MOVE S1,P2 ;Get file destination pointer
MOVE P2,S2 ;Save JFN for return
$CALL STOATM
MOVE S1,P1 ;[0062]
SKIPN P1 ;Parse a node?
$CALL PARNO2 ;Yes..copy local defaults
DMOVE S1,P1 ;Return node and JFN
$RETT ;Hurray..we've got it
PARFI9: ILDB S1,T1 ;Get next comnd byte
SOS T2 ;Decr unparsed count
$RET ;Return
BADNOD: HRROI S1,[ASCIZ /
?Syntax error in node name or error in local file specification
(/]
PSOUT ;[0063]
MOVEI S1,.PRIOU ;[0063]
MOVE S2,[.FHSLF,,-1] ;[0063]
SETZ T1, ;[0063]
ERSTR ;[0063]LAST ERROR IN THIS PROCESS
JFCL ;[0063]
JFCL ;[0063]
HRROI S1,[ASCIZ /)
/]
PSOUT ;[0063]
JRST CMDER1 ;[0063]
FILFDB: FLD(.CMFIL,CM%FNC)+CM%SDH+CM%HPP ;LOCAL FILESPEC
SUBTTL COVNAM Routine to make a file spec TOPS-20 compatible
; This entire routine is part of edit 0061
;ACCEPTS S1/ Pointer to file spec string
; P2/ ADDRESS OF DESTINATION STRING
;RETURN S1/ SAME POINTER TO UPDATED FILE SPEC STRING
; -1(P2)/ BITS SET TO SHOW ANY CHANGES MADE
COVNAM: $SAVE <S2,T1>
MOVE S2,S1 ;STRING POINTER
SETZ S1, ;FLAG WORD
CN.0: ILDB T1,S2 ;GET A BYTE
CAIE T1,"/"
SKIPN T1
JRST [MOVEM S1,-1(P2) ;SAVE THE BITS
$RETT] ;RETURN
CAIE T1,";" ;SEMI COLON?
JRST CN.1 ;NO
TXO S1,P%%GEN ;SEMI SEEN
MOVEI T1,"." ;CONVERT TO...
DPB T1,S2 ;A PERIOD
CN.1: CAIE T1,"," ;SEEN A COMMA?
JRST CN.0 ;NO
TXO S1,P%%PPN ;SET THE FLAG
MOVEI T1,"-" ;CONVERT TO A DASH
DPB T1,S2
JRST CN.0
SUBTTL RESNAM Routine to restore file spec to original condition
; This entire routine is part of edit 0061
;ACCEPTS S1/ ADDRESS OF STRING
;RETURNS S1/ ADDRESS OF UPDATED STRING
RESNAM: $SAVE <S2,T1>
MOVE S2,-1(S1) ;GET FLAG BITS
HLL S1,[POINT 7,0] ;MAKE A BYTE POINTER
RN.2: ILDB T1,S1 ;GET A BYTE
CAIE T1,"/"
SKIPN T1 ;END OF STRING?
$RETT ;YES
CAIE T1,"[" ;DIRECTORY?
CAIN T1,"<" ;?
JRST RN.0 ;YES
CAIE T1,"." ;PERIOD?
JRST RN.2 ;NO
RN.3: ILDB T1,S1 ;GET A BYTE
CAIE T1,"/"
SKIPN T1 ;END OF STRING?
$RETT ;YES, RETURN
CAIE T1,"." ;YES, IT MUST BE THE VERSION
JRST RN.3 ;NOT VERSION, KEEP LOOKING
MOVEI T1,";" ;TURN . INTO ;
TXNE S2,P%%GEN ;WAS A ; TURNED INTO A DOT?
DPB T1,S1 ;YES, TURN IT BACK
$RETT
RN.0: MOVEI T1,"[" ;ALWAYS USE SQUARE BRACKETS
DPB T1,S1 ;CHANGE < TO [
RN.1: ILDB T1,S1 ;GET A BYTE
CAIE T1,"]" ;WAS IT END OF DIR NAME?
CAIN T1,">"
JRST [MOVEI T1,"]" ;YES, MAKE IT A SQUARE BRACKET
DPB T1,S1
JRST RN.2]
CAIE T1,"-" ;WAS IT A DASH?
JRST RN.1 ;NO, KEEP LOOKING
MOVEI T1,"," ;TURN . INTO ,
TXNE S2,P%%PPN ;WAS A , TURNED INTO A DOT?
DPB T1,S1 ;YES, RESTORE IT
JRST RN.1
SUBTTL PARNOD Routine to parse NODE::
;ACCEPTS S1/ Pointer to destination for parsed node string
; S2/ Pointer to help text
;RETURNS TRUE S1/ Address of node data
; or 0 if local node specified
; FALSE S1/ 0 (local node implied)
PARNOD: $SAVE <P1> ;Preserve an AC
MOVE P1,S1 ;Save destination pointer
MOVEM S2,CMDFDB+.CMHLP ;Save help pointer
MOVE S2,NODFDB+.CMFLG ;Get Node function
TXO S2,CM%HPP+CM%SDH ;Say help is here
MOVEM S2,CMDFDB+.CMFLG ;Save the function word
MOVEI S1,CMDFDB ;Point to our FDB
$CALL RFLDE ;Parse the field
JUMPF [SETZ S1, ;[0062]No node was parsed
JRST PARNO2] ;[0062]
PARNO1: MOVE S1,P1 ;Get destination pointer
$CALL STOATM ;Save the parsed node
MOVE S1,NODTBL ;Point to node table
MOVE S2,P1 ;Get destination pointer
$CALL S%TBLK ;Look for it
TXNN S2,TL%EXM ;Is it there?
JRST [MOVE S1,P1 ;Point to node name
$CALL NODADD ;Add it to table
JRST .+1] ;Continue
HRRZ S1,0(S1) ;Yes..return node data address
PARNO2: SKIPN S2,S1 ;Local node?
MOVE S2,LOCNOD ;Yes..get local defaults
HRLI S2,ND$USR(S2) ;Point to node defaults
HRRI S2,DEFBEG ;Point to destination
BLT S2,DEFBEG+DEFSIZ-1 ;Copy the defaults
$RET ;Return True if node parsed
NODFDB: FLD(.CMNOD,CM%FNC)+CM%SDH+CM%PO
SUBTTL PARSWS Routine to parse switches
PARSWS: SETZM FILATT ;CLEAR FILE FORMAT SWITCHES
MOVE S1,SWTFDB ;POINT TO SWITCH FDB
MOVEM S1,CMDFDB ;Store in private FDB
MOVE S1,SWTFDB+.CMDAT ;Get table address
MOVEM S1,CMDFDB+.CMDAT ;Save for parse
MOVEM S2,CMDFDB+.CMHLP ;Save help pointer
PARSW1: MOVEI S1,CMDFDB ;Point to our FDB
MOVE S2,SBK+.CMPTR ;Get pointer to next character
ILDB S2,S2 ;Get it
CAIE S2,"/" ;Beginning of a switch?
$RETT ;No..just return
PARSW2: $CALL RFLDE ;PARSE A FIELD
JUMPF .RETF ;RETURN IF NO PARSE
CAIE T2,.CMSWI ;WAS IT A SWITCH?
$RETT ;NO..RETURN
HRRZ S2,0(S2) ;YES..GET PROCESSOR ADDRESS
PUSHJ P,0(S2) ;CALL THE PROCESSOR
JRST PARSW1 ;Back for more switches
SWTFDB: FLD(.CMSWI,CM%FNC)+CM%HPP+REMFS1 ;PARSE SWITCHES
FILSWS ;FILE SWITCH TABLE
;HELP SUPPLIED BY CALLER
FILSWS: SWSSIZ,,SWSSIZ
SW (ASCII)
SV (FIXED)
SW (IMAGE)
SW (MACY11)
SV (VARIABLE)
SWSSIZ==.-FILSWS-1
SUBTTL Switch processors
.SWACC: MOVEI S2,1 ;Clear account valid bit
ANDCAM S2,REMACT
TXNN S1,CM%SWT ;TERMINATED BY A COLON?
$RETT ;No..return and prompt for it
IORM S2,REMACT ;Yes..whatever we parse is valid
MOVEI S1,ACT001 ;PARSE ACCOUNT
PUSH P,SBK+.CMCNT ;[0063]
$CALL PARSE
JUMPF [POP P,S1
REPARS (Invalid account string)]
POP P,S1 ;[0063]
SUB S1,SBK+.CMCNT ;[0063] SIZE OF STRING
CAILE S1,^D39 ;[0063]TOO LONG?
JRST [REPARS (Length of account string exceeds 39 characters)]
HRROI S1,REMACT ;POINT TO DESTINATION
$CALL STOATM ;STORE THE ATOM
$RETT ;AND RETURN
.SWPAS: SETZM REMPSW ;Clear password value
TXNN S1,CM%SWT ;Switch terminator?
$RETT ;No..return and prompt for it
MOVEI S1,PSW001 ;[0064]Yes..point to password function
PUSH P,SBK+.CMCNT ;[0063]
$CALL PARSE
JUMPF [POP P,S1
REPARS (Invalid password)]
POP P,S1 ;[0063]
SUB S1,SBK+.CMCNT ;[0063]LENGTH OF STRING
CAILE S1,^D39 ;[0063]TOO LONG?
JRST [REPARS (Length of password string exceeds 39 characters)]
HRROI S1,REMPSW ;Point to password storage
$CALL STOATM ;Save the string
MOVEI S1,1 ;Get valid bit
IORM S1,REMPSW ;Yes..set the valid bit
SKIPE PASFLG ;[76]PASSWORD UNSECURE?
$TEXT (,<%Password found in command or NFT.INIT file which has world read access>) ;[76]
$RETT ;Return
.SWUSE: MOVEI S2,1 ;Clear user valid bit
ANDCAM S2,REMUSR
andcam s2,rempsw ;
TXNN S1,CM%SWT ;TERMINATED BY A COLON?
$RETT ;No..return and prompt for it
IORM S2,REMUSR ;Yes..user is valid
MOVEI S1,USR001 ;[0064]
PUSH P,SBK+.CMCNT ;[0063]
$CALL PARSE
JUMPF [POP P,S1
REPARS (Invalid userid)]
POP P,S1 ;[0063]
SUB S1,SBK+.CMCNT ;[0063]
CAILE S1,^D39 ;[0063]TOO LONG?
JRST [REPARS (Length of userid string exceeds 39 characters)]
HRROI S1,REMUSR ;POINT TO DESTINATION
$CALL STOATM ;STORE THE ATOM
$RETT
.SWASC: MOVX S2,DT$ASC ;ASCII MODE
STORE S2,FILATT,DF%DAT ;STORE THE MODE
TXNE S1,CM%SWT ;COLON?
REPARS (Invalid switch terminator)
$RETT
.SWFIX: MOVX S2,FB$FIX ;FIXED LENGTH RECORD FORMAT
STORE S2,FILATT,DF%RFM ;STORE THE FORMAT
TXNN S1,CM%SWT ;TERMINATED WITH A COLON?
$RETT ;NO..USE THE DEFAULT
MOVEI S1,FRLFDB ;PARSE RECORD LENGTH
$CALL PARSE
JUMPF [REPARS (Invalid record length)]
STORE S2,FILATT,DF%MRS ;Store maximum record size
$RETT
.SWIMA: MOVX S2,DT$IMA ;IMAGE MODE
STORE S2,FILATT,DF%DAT ;Store the mode
TXNE S1,CM%SWT ;COLON?
REPARS (Invalid switch terminator)
$RETT
.SWMAC: MOVX S2,FB$MCY ;MACY11 MODE
STORE S2,FILATT,DF%RAT ;STORE THE RECORD ATTRIBUTE
TXNE S1,CM%SWT ;COLON?
REPARS (Invalid switch terminator)
$RETT
.SWVAR: MOVX S2,FB$VAR ;VARIABLE LENGTH RECORD FORMAT
STORE S2,FILATT,DF%RFM ;Store the record format
TXNN S1,CM%SWT ;TERMINATED BY A COLON?
$RETT ;NO..USE DEFAULT
MOVEI S1,VRLFDB ;PARSE VARIABLE RECORD LENGTH
$CALL PARSE
JUMPF [REPARS (Invalid record length)]
STORE S2,FILATT,DF%MRS ;Store maximum record size
$RETT
CONT. (SWITCH)
ACTFDB: FLD(.CMCFM,CM%FNC)+CM%SDH+ACT001
0
0
0 ;[0064]
ACT001: FLD(.CMFLD,CM%FNC)+CM%BRK+CM%HPP
USRBRK ;For .CMUQS (if REL3A)
TXT(Account designator for remote system)
0
USRBRK
USRFDB: FLD(.CMCFM,CM%FNC)+CM%SDH+USR001
0
0
0
USR001: FLD(.CMFLD,CM%FNC)+CM%HPP+CM%BRK
USRBRK ;For .CMUQS (if REL3A)
TXT(User name or identification for remote system)
0
USRBRK
PSWFDB: FLD(.CMCFM,CM%FNC)+CM%SDH+PSW001
0
0
0
PSW001: FLD(.CMFLD,CM%FNC)+CM%HPP+CM%BRK
USRBRK ;For .CMUQS (if REL3A)
TXT(Password required to access remote system)
0
USRBRK
USRBRK: 777777,,777760 ;BREAK ON ALL CONTROL
745504,,001760 ;[0060] allow dollar sign
400000,,000240 ;[0060] allow underscore
400000,,000760
FRLFDB: FLD(.CMNUM,CM%FNC)+CM%SDH+CM%HPP+CM%DPP
^D10 ;RADIX
TXT (Record length)
TXT (512) ;DEFAULT
VRLFDB: FLD(.CMNUM,CM%FNC)+CM%SDH+CM%HPP+CM%DPP
^D10 ;RADIX
TXT (Maximum record length) ;HELP
TXT (512) ;DEFAULT
SUBTTL OSTYPE Switch processor
.SWOST: SETZM ND$OST(P1) ;CLEAR OSTYPE
TXNN S1,CM%SWT ;SWITCH TERMINATOR?
$RETT ;NO..JUST RETURN
MOVEI S1,OSTFDB ;POINT TO OSTYPE FUNCTION BLOCK
$CALL RFIELD
MOVE S2,0(S2) ;GET OSTYPE
MOVEM S2,ND$OST(P1) ;SAVE IT
$RETT
OSTFDB: FLD(.CMKEY,CM%FNC)+CM%DPP+CM%HPP
OSTTBL ;POINT TO TYPE TABLE
TXT(System type) ;HELP TEXT
TXT(TOPS20) ;DEFAULT TO TOPS20
OSTTBL: XWD OSTSIZ,OSTSIZ ;ARGUMENTS FOR /OSTYPE
T (IAS,.OSIAS) ;Operating system type
; T (OS-8,.OSOS8)
T (RSTS,.OSRST)
T (RSX11,.OSRXM)
T (RT11,.OSRT)
T (TOPS10,.OSTP10)
T (TOPS20,.OSTP20)
T (VMS,.OSVAX)
OSTSIZ==.-OSTTBL-1
SUBTTL GETUSR routine to ensure we have a user,account and password
GETUSR: $SAVE <P1,SBK+.CMIOJ> ;Preserve an AC and JFNs
MOVE S1,LOCNOD
SKIPG REMNOD ;Remote node given?
MOVEM S1,REMNOD
MOVEI P1,1 ;Get string valid bit
AND P1,REMUSR ;Test all strings for valid bit
AND P1,REMACT
AND P1,REMPSW
JUMPN P1,.RETT ;All strings valid?
GETUS1: $CALL HLPUSR ;No..display access info prompt
MOVE S1,[.PRIIN,,.PRIOU] ;Must come from TTY
MOVEM S1,SBK+.CMIOJ ;Tell comnd
$CALL CMDINI ;Init cmd for this level
JUMPF .RETF ;False return on EOF
MOVEI P1,1 ;Get string valid bit
TDNE P1,REMUSR ;Is user specified?
JRST GETUS2 ;Yes..check account
PROMPT (User: )
MOVEI S1,USRFDB
SETZM ATMBUF ;[0064]
PUSH P,SBK+.CMCNT ;[0063]
$CALL PARSE
JUMPF [POP P,S1 ;[0063]
REPARS (Invalid userid)]
POP P,S1 ;[0063]
SUB S1,SBK+.CMCNT ;[0063]Length of string
PUSH P,S1 ;[0063]
CAIE T2,.CMCFM ;[0064]CONFIRMED?
CONFRM
POP P,S1 ;[0063]
CAILE S1,^D39 ;[0063]is string too long?
JRST [REPARS (Length of userid string exceeds 39 characters)]
HRROI S1,REMUSR ;Point to destination
$CALL STOATM ;Store the userid
IORM P1,REMUSR ;Set valid bit
ANDCAM P1,REMPSW ;Clear password valid bit
GETUS2: TDNE P1,REMACT ;Is account specified?
JRST GETUS3 ;Yes..check password
PROMPT (Account: ) ;YES..GET ACCOUNT STRING
MOVEI S1,ACTFDB
SETZM ATMBUF ;Clear account string
PUSH P,SBK+.CMCNT ;[0063]
$CALL PARSE
JUMPF [POP P,S1 ;[0063]
REPARS (Invalid account string)]
POP P,S1 ;[0063]
SUB S1,SBK+.CMCNT ;[0063]Length of string
PUSH P,S1 ;[0063]
CAIE T2,.CMCFM ;Confirmed?
CONFRM ;No..get confirmation
POP P,S1 ;[0063]
CAILE S1,^D39 ;[0063]Is string too long?
JRST [REPARS (Length of account string exceeds 39 characters)]
HRROI S1,REMACT ;Point to destination
$CALL STOATM ;Store the account
IORM P1,REMACT ;Set the valid bit
GETUS3: TDNE P1,REMPSW ;Is password specified?
JRST GETUS4 ;Yes..exit
$CALL TSTCOL
PROMPT (Password: )
$CALL ECHOOF
MOVEI S1,PSWFDB
SETZM ATMBUF ;[0064]
PUSH P,SBK+.CMCNT ;[0063]
$CALL PARSE
JUMPF [POP P,S1 ;[0063]
$CALL ECHOON ;BAD PARSE..RESTORE ECHOS
REPARS (Invalid password)]
POP P,S1 ;[0063]
SUB S1,SBK+.CMCNT ;[0063]Length of string
PUSH P,S1 ;[0063]
CAIE T2,.CMCFM ;[0064]CONFIRMED?
CONFRM
$CALL ECHOON
$CALL TSTCOL
POP P,S1 ;[0063]
CAILE S1,^D39 ;[0063]Is string too long?
JRST [REPARS (Length of password string exceeds 39 characters)]
HRROI S1,REMPSW ;Point to destination
$CALL STOATM ;Copy the string
IORM P1,REMPSW ;Set the valid bit
GETUS4: MOVE S1,REMNOD ;Point to remote node data
HRLI S2,REMUSR ;Copy defaults obtained from prompt
HRRI S2,ND$USR(S1)
BLT S2,DEFSIZ-1+ND$USR(S1)
$RETT
SUBTTL HLPUSR Routine to display access information for a node
HLPUSR: $TEXT (T%TTY,<Access information for node ^T/@REMNOD/::^A>)
MOVEI S1,1B35 ;Get string valid bit
TDNE S1,REMUSR ;Display only valid strings
$TEXT (T%TTY,</USER:^T/REMUSR/^A>)
TDNE S1,REMACT
$TEXT (T%TTY,</ACCOUNT:^T/REMACT/^A>)
$TEXT (T%TTY,<>) ;Send a CRLF
$RETT
SUBTTL TAKE command
.TAKE: NOISE (COMMANDS FROM)
SETZ T4, ;SET DEFAULT TO NOECHO
$CALL CLRGJF ;GO CLEAR GTJFN BLOCK
MOVX S1,GJ%OLD ;GET EXISTING FILE FLAG
MOVEM S1,GJFBLK+.GJGEN ;STORE GTJFN FLAGS
HRROI S1,[ASCIZ/CMD/] ;GET DEFAULT FILE TYPE FIELD
MOVEM S1,GJFBLK+.GJEXT ;STORE DEFAULT EXTENSION
MOVEI S1,TAK010 ;PARSE FILE SPEC
$CALL RFIELD
CAIN T2,.CMFIL ;PARSE A FILE SPEC?
JRST TAKE10 ;Yes..Save input JFN
JRST CMDEOF ;NO..TERMINATE THIS COMMAND FILE
; HERE ON A GOOD INPUT FILE SPEC
TAKE10: MOVEM S2,CMDJFN ;SAVE INPUT JFN FOR COMMANDS
NOISE (LOGGING OUTPUT ON)
$CALL CLRGJF ;GO CLEAR GTJFN BLOCK USED BY COMND JSYS
MOVX S1,GJ%FOU ;GET FLAG SAYING FILEIS FOR OUTPUT USE
MOVEM S1,GJFBLK+.GJGEN ;SAVE GTJFN FLAGS
SETZM SRCFIL ;INITIALIZE FILENAME BUFFER
HRROI S1,SRCFIL ;GET POINTER TO WHERE FILENAME IS TO GO
MOVE S2,CMDJFN ;GET INPUT JFN
MOVX T1,<FLD(.JSAOF,JS%NAM)> ;GET FLAG BITS SAYING OUTPUT NAME ONLY
JFNS ;GET FILE NAME OF INPUT FILE
HRROI S1,SRCFIL ;GET A POINTER TO FILE NAME FOR INPUT
MOVEM S1,GJFBLK+.GJNAM ;STORE DEFAULT NAME OF OUTPUT FILE
HRROI S1,[ASCIZ/LOG/] ;GET DEFAULT FILE TYPE OF OUTPUT FILE
MOVEM S1,GJFBLK+.GJEXT ;STORE DEFAULT EXTENSION
SETZM LOGJFN ;CLEAR LOG JFN
MOVEI S1,TAK020 ;PARSE FILE SPEC OR CONFIRM
$CALL RFIELD
CAIN T2,.CMCFM ;PARSE CONFIRM?
JRST TAKE25 ;YES..FINISH UP
CAIN T2,.CMSWI ;PARSE A SWITCH
JRST TAKE22 ;YES..GO PROCESS IT
MOVEM S2,LOGJFN ;SAVE LOGGIN FILE JFN
TAKE20: MOVEI S1,TAK040 ;PARSE CONFIRM OR SWITCHES
$CALL RFIELD
CAIN T2,.CMCFM ;PARSE CONFIRM?
JRST TAKE25 ;YES..FINISH UP
TAKE22: HRRZ S2,0(S2) ;NO..MUST BE SWITCH
PUSHJ P,0(S2) ;CALL THE PROCESSOR
JRST TAKE20 ;GET CONFIRMATION
CONT. (Take command)
; OPEN INPUT AND OUTPUT FILES
TAKINI: SETOM INIFLG ;[0071]Now taking NFT.INIT
TAKE25: MOVE S1,CMDJFN ;GET INPUT JFN
MOVE S2,[7B5+OF%RD] ;7 BIT BYTES, READ ACCESS
OPENF ;OPEN INPUT FILE
JRST [SKIPN INIFLG ;[0071]
REPARS (Cannot OPEN command file)
$TEXT (,<?Cannot OPEN PS:NFT.INIT>)
$TEXT (,)
$RETF] ;RETURN FAIL
SKIPE S1,LOGJFN ;GET OUTPUT JFN
CAIN S1,.PRIOU ;STILL PRIMARY OUTPUT JFN ?
JRST TAKE30 ;NO OUTPUT JFN, GO ON
DVCHR ;Get log device characteristics
LOAD S1,S2,DV%TYP ;Extract device type
CAIE S1,.DVDSK ;Device DSK:?
SETZ T4, ;No..clear display flag
MOVE S1,LOGJFN ;Get logfile JFN
MOVE S2,[7B5+OF%APP] ;7 BIT BYTES, WRITE ACCESS
OPENF ;OPEN OUTPUT FILE
REPARS (Cannot OPEN logging file)
; NOW SAVE NEW JFN'S AND RETURN TO PARSER
TAKE30: $SAVE <SBK+.CMIOJ,LOGJFN,DSPFLG,PASFLG> ;[76]STACK CURRENT STUFF
SETZB S1,T1 ;[76]
MOVE S2,CMDJFN ;[76]JFN OF COMMAND FILE
RCDIR ;[76]DIR NUM THAT CMD FILE IS IN
ERJMP PASOK ;[76]IGNORE ERRORS
MOVEI S1,^D9 ;[76]
MOVEM S1,TMPFIL+.CDLEN ;[76]
SETZM TMPFIL+.CDPSW ;[76]
MOVE S1,T1 ;[76]
MOVEI S2,TMPFIL ;[76]
SETZ T1, ;[76]
GTDIR ;[76]PROT OF THAT DIR
ERJMP PASOK ;[76]IGNORE ERRORS
MOVE S1,TMPFIL+.CDDPT ;[76]
TRNN S1,40 ;[76]WORLD ACCESS TO DIR?
JRST PASOK ;[76]NO, NO PROBLEM
MOVE S1,CMDJFN ;[76]
MOVE S2,[1,,.FBPRT] ;[76]
MOVEI T1,T2 ;[76]
GTFDB ;[76]
ERJMP PASOK ;[76]IGNORE ERRORS
SETOM PASFLG ;[76]ASSUME WORLD HAS READ ACCESS
;[76]TO DIR AND FILE
TRNN T2,40 ;[76]DOES WORLD HAVE READ ACCESS?
PASOK: SETZM PASFLG ;[76]NO
MOVEM T4,DSPFLG ;SAVE ECHO/NOECHO VALUE
HRRZ S1,SBK+.CMIOJ ;GET CURRENT OUTPUT JFN
SKIPN LOGJFN ;GET OUTPUT JFN IF ANY
MOVEM S1,LOGJFN ;SAVE CURRENT JFN FOR OUTPUT
HRR S1,LOGJFN ;GET OUTPUT JFN
HRL S1,CMDJFN ;GET INPUT JFN
EXCH S1,SBK+.CMIOJ ;SAVE NEW JFN'S AND GET OLD
HRRZM S1,LOGJFN ;SAVE OLD OUTPUT JFN
AOS TAKFLG ;BUMP TAKE LEVEL
$CALL CMDINI ;STACK THIS LEVEL
JUMPF TAKE40 ;CLOSE FILES AND RETURN ON EOF
JRST PARSER ;BACK FOR SOME MORE COMMANDS
TAKE40: HLRZ S1,SBK+.CMIOJ ;GET INPUT JFN
CLOSF
JFCL
HRRZ S1,SBK+.CMIOJ ;GET OUTPUT JFN
CAME S1,LOGJFN ;SAME AS BEFORE?
CLOSF ;NO..CLOSE THE FILE
JFCL ;YES..DON'T CLOSE IT
SOS TAKFLG ;DECR TAKE LEVEL
$RETT
CONT. (Take command)
TAK010: FLD(.CMFIL,CM%FNC)+TAK015 ;CMD FILE FDB
TAK015: FLD(.CMCFM,CM%FNC)+CM%HPP+CM%SDH
0
TXT(Carriage return to terminate current command file)
TAK020: FLD(.CMCFM,CM%FNC)+TAK030 ;CONFIRM, FILE OR SWITCH
TAK030: FLD(.CMFIL,CM%FNC)+TAK050
TAK040: FLD(.CMCFM,CM%FNC)+TAK050 ;CONFIRM OR SWITCHES
TAK050: FLD(.CMSWI,CM%FNC)
TAKSWS
TAKSWS: TAKSIZ,,TAKSIZ
SW (DISPLAY)
SW (NODISPLAY)
TAKSIZ==.-TAKSWS-1
.SWDIS: SETOM T4 ;SET DISPLAY FLAG
$RETT
.SWNOD: SETZM T4 ;CLEAR DISPLAY FLAG
$RETT
SUBTTL OUTNAM Routine to generate output file spec
;ACCEPTS S1/ Pointer to destination string
; S2/ Requested field flags (GJ%DIR etc)
;RETURNS TRUE Output file name stored
; FALSE Illegal wild card syntax
OUTNAM: $SAVE <P1> ;Preserve an ac
STKVAR <DSTPTR,DSTFLD,<SRCWLD,8>,<SRCFLD,8>,<DSTWLD,8>>
MOVE P1,S1 ;Copy destination pointer
MOVEI S1,[EXP P1,0] ;Make sure it's a valid pointer
$CALL CHKPTR
MOVEM P1,DSTPTR ;Save destination pointer
TXNN S2,GJ%DIR+GJ%EXT+GJ%VER ;Any flags set?
OR S2,[GJ%NAM] ;[0056]Request name
OR S2,[GJ%EXT] ;[0056]Always request extension
MOVEM S2,DSTFLD ;Save requested fields
SKIPE S1,SRCJFN ;Must have source JFN
SKIPN S2,DSTJFN ;And destination JFN
$RETF ;Else fail
MOVE S1,DSTJFN ;Get destination JFN
TDZ S1,DSTFLD ;Clear common flags
TXNE S1,GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER
$RETF ;Too many wild destination flags
MOVE S1,SRCJFN ;Get wild source flags
TDZ S1,DSTFLD ;Clear common flags
TXNE S1,GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER
$RETF ;Too many wild source fields
MOVSI P1,-NFFLD ;Get count of requested fields
OUTN1: HLLZ T2,FSTRT(P1) ;Get bit for field
TDNN T2,DSTFLD ;This field requested?
JRST OUTN4 ;No..on to next field
HLRZ S2,PNCTAB(P1) ;Yes..get prefix punctuation
SKIPE S2 ;Don't store null
IDPB S2,DSTPTR ;Store it
TDNN T2,DSTJFN ;Is this field wild?
JRST OUTN2 ;No..just store dest field
HRROI S1,SRCWLD ;Point to wild source field
MOVE S2,SRCJFN ;Get wild source JFN
MOVE T1,FFLDT(P1) ;Get bits for this field
JFNS ;Store the field
HRROI S1,SRCFLD ;Point to source field
SKIPN S2,REMJFN ;Get remote JFN (via Name msg)
HRRZ S2,SRCJFN ;Else use non-wild source JFN
JFNS
HRROI S1,DSTWLD ;Point to wild dest field
MOVE S2,DSTJFN
JFNS
CONT. (OUTNAM)
HRROI S1,SRCWLD ;Setup for wild call
HRROI S2,SRCFLD
HRROI T1,DSTWLD
MOVE T2,DSTPTR
$CALL WILD
JUMPF .RETF ;Return if false
MOVEM T2,DSTPTR ;Save updated pointer
JRST OUTN3 ;Store suffix punctuation
OUTN2: MOVE S1,DSTPTR ;Get output pointer
MOVE S2,DSTJFN
HLLZ T1,FFLDT(P1) ;Get bits for this field
JFNS
MOVEM S1,DSTPTR ;Save updated pointer
OUTN3: LDB S1,DSTPTR ;[0056]GET THE LAST SAVED BYTE
CAIE S1,"<" ;[0056]WAS IT BEGINNING OF DIRECTORY?
JRST OUTN25 ;[0056]NO, GO ON
HRREI S1,-1 ;[0056]-1
ADJBP S1,DSTPTR ;[0056]MOVE BACK ONE BYTE
MOVEM S1,DSTPTR ;[0056]RESTORE THE NEW POINTER
JRST OUTN4 ;[0056]
OUTN25: HRRZ S2,PNCTAB(P1) ;Get suffix punctuation
SKIPE S2 ;Don't store null
IDPB S2,DSTPTR ;Store it
OUTN4: AOBJN P1,OUTN1 ;On to next field
MOVE T1,DSTPTR ;Return updated pointer
$RETT
PNCTAB: BYTE(18) 0,":" ;Device prefix,suffix
BYTE(18) "<",">" ;Directory prefix suffix
BYTE(18) 0,0 ;Name prefix,suffix
BYTE(18) "." ;Extension prefix
BYTE(18) "." ;Generation prefix
SUBTTL NAMEXT Routine to expand full file name
;Accepts S1/ GTJFN flags
; S2/ Pointer to name string storage
;Returns Expanded local file name stored per S2
NAMEXT: MOVE T4,S2 ;Save pointer to destination
GTJFN ;Get full JFN for name
ERJMP .RETF
MOVE S2,S1 ;JFN to S2
MOVE S1,T4 ;Destination to S1
MOVX T1,FFSPEC ;Get full expansion flags
JFNS ;Expand the name
MOVE S1,S2 ;JFN to S1
RLJFN ;Release it
ERJMP .RETF
$RETT
SUBTTL OUTFLG Routine to set flags per what user typed
;ACCEPTS S1/ Pointer to file string
;RETURNS S1/ Updated pointer
; S2/ Flags set per user input
OUTFLG: MOVE T2,S1 ;Copy original pointer
MOVX S2,GJ%NAM+GJ%EXT ;Require name and extension
ILDB T1,T2 ;Get character
JUMPE T1,.RETT ;Return on null
TXZA S2,GJ%EXT ;Clear extention flag
OUTFL1: ILDB T1,T2 ;Get next byte
JUMPE T1,.RETT ;Return on null
CAIN T1,":" ;Was it a device terminator?
JRST [TXO S2,GJ%DEV ;Yes..set the flag
JRST OUTFL1] ;Get next character
CAIE T1,"<" ;Was it a directory
CAIN T1,"["
JRST OUTFL3 ;Yes..get the field
CAIE T1,"." ;Was it extension or generation?
JRST OUTFL1 ;No..get next character
TXO S2,GJ%EXT ;Set extension flag
OUTFL2: ILDB T1,T2 ;Get next byte
JUMPE T1,.RETT ;Return
CAIN T1,"." ;Generation?
TXO S2,GJ%VER ;Yes..set the flag
JRST OUTFL2 ;Back for next character
OUTFL3: ILDB T1,T2 ;Get next character of directory
JUMPE T1,.RETF ;Fail on null
CAIE T1,">" ;Terminator?
CAIN T1,"]"
TXOA S2,GJ%DIR ;Yes..Say they typed directory
JRST OUTFL3 ;No..finish directory
JRST OUTFL1 ;Back for rest of name
SUBTTL Routine to build destination string from wild information
;WILD Build destination string
;CALL S1/ Wild source string pointer
; S2/ Source string pointer
; T1/ Wild destination string pointer
; T2/ Destination string pointer
WILD:: $SAVE <P1,P2,P3,P4> ;PRESERVE SOME ACS
TRVAR <DSTSIZ,DSTTRM,<SRCTRM,8>> ;TEMP VARIABLES
DMOVE P1,S1 ;SAVE SOURCE STUFF
DMOVE P3,T1 ;SAVE DEST STUFF
MOVEI S1,[EXP P1,P2,P3,P4,0] ;Get list of pointers
$CALL CHKPTR ;Make real pointers
MOVE S1,P1 ;Get wild source pointer
MOVE S2,P3 ;Get wild dest pointer
$CALL CHKWLD ;Check construction
JUMPF .RETF ;Fail now if bad construction
JUMPN T2,WILD1 ;Was dst-msk = "*"
MOVE S1,P2 ;Yes..point to src-str
MOVE S2,P4 ; point to dst-str
$CALL CPYSTR ;Copy the field
MOVE T2,S2 ;Return updated pointers
MOVE S2,S1
MOVE S1,P1
MOVE T1,P3
$RETT ;Return
WILD1: MOVE S1,P3 ;Point to dst-msk
MOVE S2,P4 ;Point to dst-str
$CALL CPYSTR ;Copy the field
MOVE P4,S2 ;Save the dst-str pointer
$CALL MSKSIZ ;Get mask size
MOVE P3,S1 ;Save the dst-msk pointer
MOVEM S2,DSTSIZ ;Save it
MOVEM T1,DSTTRM ;Save terminating character
WILD2: ILDB T1,P1 ;Get src-msk byte
ILDB T2,P2 ;Get src-str byte
CAMN T1,T2 ;Match?
JUMPN T1,WILD2 ;Yes..find first non-match
MOVE S1,P2 ;Get src-str pointer
$CALL DPB ;Decrement it
MOVE P2,S1 ;Put it back
MOVE S1,P1 ;Get src-mask pointer
$CALL DPB ;Decrement the pointer
$CALL MSKSIZ ;Get src-msk size
CAMLE S2,DSTSIZ ;Fit into dst-msk?
$RETF ;No..give up
MOVE P1,S1 ;Save src-msk pointer
MOVE S1,P2 ;Get src-str pointer
SETZ T2, ;Clear count
CONT. (WILD)
WILD3: ILDB S2,S1 ;Get byte from src-str
CAMN S2,T1 ;Terminator?
JRST WILD4 ;Yes..copy src-msk terminator
IDPB S2,P4 ;No..put it in dst-str
AOJA T2,WILD3 ;Find terminator
WILD4: $CALL DPB ;Decrement src-str pointer
MOVE P2,S1 ;Put it back
MOVE S1,P1 ;Get src-msk pointer
MOVE S2,[POINT 7,SRCTRM] ;Yes..copy the terminator string
$CALL CPYSTR ;Copy termination string
MOVE P1,S1 ;Save src-msk pointer
WILD5: MOVE S1,[POINT 7,SRCTRM] ;Point to src-msk terminator
MOVE S2,P2 ;Point to src-str
STCMP ;Look for terminator string
SKIPE S1 ;Exact match
TXNE S1,SC%SUB ; or subset?
JRST WILD6 ;Yes..we found it
ILDB T1,P2 ;No..copy src-str byte
JUMPE T1,WILD7 ;Exit on null src-str byte
IDPB T1,P4 ; to dst-str
AOJA T2,WILD5 ;Try again for a match
WILD6: MOVE P2,S2 ;Save src-str pointer
WILD7: MOVE S1,P2 ;Decrement source string pointer
$CALL DPB
MOVE P2,S1 ;Put it back
HRRZ S1,DSTSIZ ;Get min dst-msk size
HLRZ S2,DSTSIZ ;Get max dst-msk size
CAML T2,S1 ;Check range
CAMLE T2,S2
$RETF ;Bad..fail
MOVE T2,P4 ;Get pointer to dest
SETZ T1, ;Get a null
IDPB T1,T2 ;Ensure a null
SKIPE DSTTRM ;At end of destination?
JRST WILD1 ;No..process next field
DMOVE S1,P1 ;Yes..Return updated pointers
DMOVE T1,P3
$RETT
SUBTTL CHKWLD Routine to validate wild construction
;CALL S1/ Source wild pointer
; S2/ Destination wild pointer
;RETURN TRUE Valid construction
; FALSE Invalid construction
CHKWLD: $SAVE <P1,P2,P3,P4>
DMOVE P1,S1 ;Save the pointers
SETZ T2,
CHKW1: ILDB T1,P2 ;Get destination byte
JUMPE T1,CHKW2 ;Onward on null
CAIE T1,"*"
CAIN T1,"%"
JRST CHKW2 ;Onward on wild
AOJA T2,CHKW1 ;Look for wild card or null
CHKW2: MOVE S1,P2 ;Get destination pointer
$CALL DPB ;Decrement it
$CALL MSKSIZ ;Get mask size
MOVE P2,S1 ;Save updated pointer
DMOVE P3,S2 ;Save size and terminator
JUMPN T2,CHKW3 ;Onward if any characters seen
CAMN S2,[377,,0] ;Was wild card "*"
JUMPE T1,.RETT ; and terminator null?
CHKW3: ILDB T1,P1 ;Get source byte
JUMPE T1,CHKW4 ;Onward on null
CAIE T1,"*"
CAIN T1,"%"
JRST CHKW4 ;Onward on wild card
AOJA T2,CHKW3
CHKW4: MOVE S1,P1 ;Get source pointer
$CALL DPB ;Decrement it
$CALL MSKSIZ ;Get the size
CAMLE S2,P3 ;Will source always fit dest?
$RETF ;No..fail now
MOVE P1,S1 ;Save updated pointer
SKIPE T1 ;Src term null
JRST [JUMPN P4,CHKW1 ;Look for the end
$RETF] ;Not the same number of wilds
SKIPE P4 ;Dest term null
$RETF ;Not the same number of wilds
$RETT
SUBTTL FILDEF Routine to setup GTJFN file defaults
;CALL S1/ POINTER TO SOURCE STRING
; S2/ FLAGS TO STORE IN GTJFN BLOCK
;RETURNS S1/ UPDATED POINTER
; S2/ FLAGS INDICATING WHAT WAS PARSED
FILDEF: $SAVE <P1,P2> ;PRESERVE SOME AC'S
TLC S1,-1 ;FIX -1 TYPE POINTERS
TLCN S1,-1
HRLI S1,(POINT 7)
DMOVE P1,S1 ;PRESERVE CALLING ARGS
$CALL CLRGJF ;CLEAR GTJFN BLOCK
EXCH P2,GJFBLK+.GJGEN ;STORE CALLING FLAGS
MOVE S1,P1 ;GET CALLING POINTER
HRROI S2,DEFDEV ;POINT TO DEVICE STORAGE
MOVEI T1,DEVBRK ;POINT TO BREAK SET
$CALL CPYFLD ;COPY THE DEVICE
CAIE T1,":" ;PROPER TERMIEATION?
JRST FILDE1 ;NO..TRY DIRECTORY
TXO P2,GJ%DEV ;YES..SET DEVICE FLAG
HRROI S2,DEFDEV ;POINT TO STRING
MOVEM S2,GJFBLK+.GJDEV ;STORE FOR GTJFN
SKIPA P1,S1 ;SAVE UPDATED POINTER
FILDE1: MOVE S1,P1 ;GET CALLING POINTER
ILDB S2,S1 ;GET FIRST BYTE
SETZ T1, ;CLEAR BREAK ADDRESS
CAIE S2,"<" ;LOOK LIKE DIRECTORY?
CAIN S2,"[" ;OR UIC?
MOVEI T1,DIRBRK ;YES..POINT TO DIR BREAK SET
JUMPE T1,FILDE2 ;NO..ON TO CHECK FILENAME
HRROI S2,DEFDIR ;POINT TO DIRECTORY STORAGE
$CALL CPYFLD ;YES..PARSE IT
CAIE T1,">" ;UIC OR DIRECTORY TERMINATOR?
CAIN T1,"]"
SKIPA ;YES..SAY WE PARSED DIRECTORY
$RETF ;WE TRIED, BUT LOST
TXO P2,GJ%DIR ;SET DIRECTORY FLAG
HRROI S2,DEFDIR ;POINT TO DIRECTORY STORAGE
MOVEM S2,GJFBLK+.GJDIR ;SAVE FOR GTJFN
SKIPA P1,S1 ;SAVE UPDATED POINTER
FILDE2: MOVE S1,P1 ;GET UPDATED POINTER
HRROI S2,DEFNAM ;POINT TO DEFAULT NAME STORAGE
MOVEI T1,NAMBRK ;POINT TO NAME BREAK SET
$CALL CPYFLD ;COPY THE FIELD
SKIPN DEFNAM ;ANYTHING STORED?
JRST FILDE3 ;NO..CHECK EXTENTION
TXO P2,GJ%NAM ;SET NAME FLAG
HRROI S2,DEFNAM ;POINT TO STORAGE
MOVEM S2,GJFBLK+.GJNAM ;SAVE FOR GTJFN
CONT. (FILDEF routine)
FILDE3: CAIE T1,"." ;EXTENTION PREFIX?
JRST FILDE4 ;NO..CHECK GENERATION
HRROI S2,DEFEXT ;POINT TO DEFAULT EXT STORAGE
MOVEI T1,NAMBRK ;SAME AS NAME
$CALL CPYFLD ;STORE IT
TXO P2,GJ%EXT ;SAY WE PARSED EXTENTION
HRROI S2,DEFEXT ;POINT TO IT
MOVEM S2,GJFBLK+.GJEXT ;SAVE FOR GTJFN
FILDE4: CAIE T1,"." ;VERSION PREFIX?
CAIN T1,";" ;(FOR VAX)
SKIPA ;YES..
JRST FILDE5 ;NO..CHECK PROPER TERMINATION
HRROI S2,DEFVER ;POINT TO DEFAULT VER STORAGE
MOVEI T1,NUMBRK ;POINT TO NUMBER BREAK SET
$CALL CPYFLD ;COPY THE FIELD
SKIPN DEFVER ;ANYTHING PARSED?
JRST FILDE5 ;NO..CHECK TERMINATION
TXO P2,GJ%VER ;SAY WE PARSED IT
FILDE5: MOVE S2,P2 ;RETURN PARSED FLAGS
CAIE T1,0 ;NULL TERMINATOR
CAIN T1,";" ;OR ATTRIBUTES?
$RETT ;YES..RETURN SUCCESS
$RETF ;NO..FAIL
DEVBRK: 777777,,777760 ;BREAK ON ALL CONTROL
757754,,001760 ;[0074]ALLOW 0-9 $-
400000,,000740 ;[0074]ALLOW A-Z _
400000,,000760 ;ALLOW LC A-Z
DIRBRK: 777777,,777760 ;BREAK ON ALL CONTROL
747504,,001760 ;ALLOW $%*,-. 0-9
400000,,000740 ;ALLOW A-Z _
400000,,000760 ;ALLOW LC A-Z
NAMBRK: 777777,,777760 ;BREAK ON ALL CONTROL
747554,,001760 ;ALLOW $%*- 0-9
400000,,000740 ;ALLOW A-Z _
400000,,000760 ;ALLOW LC A-Z
NUMBRK: 777777,,777760 ;BREAK ON ALL CONTROL
777774,,001760 ;ALLOW 0-9
0
0
SUBTTL CPYFLD ROUTINE TO COPY A STRING UNTIL BREAK CHARACTER
;CALL S1/ SOURCE POINTER
; S2/ DESTINATION POINTER
; T1/ ADDRESS OF BREAK TABLE
;RETURNS S1/ UPDATED POINTER
; S2/ UPDATED POINTER
; T1/ BREAK CHARACTER
CPYFLD: TLC S1,-1 ;FIX -1 TYPE POINTERS
TLCN S1,-1
HRLI S1,(POINT 7)
TLC S2,-1
TLCN S2,-1
HRLI S2,(POINT 7)
HRR T4,T1 ;GET ADDRESS OF BREAK SET
HRLI T4,T2 ;MAKE IT INDEXED BY T2
CPYFL1: ILDB T1,S1 ;GET A SOURCE BYTE
MOVE T2,T1 ;GET A COPY OF IT
IDIVI T2,40 ;GET BREAK WORD,,BIT
MOVE T3,BITS(T3) ;GET PROPER BIT MASK
TDNE T3,@T4 ;BREAK CHARACTER?
JRST CPYFL2 ;YES..RETURN NOW
IDPB T1,S2 ;NO..STORE THE CHARACTER
JRST CPYFL1 ;BACK FOR NEXT CHARACTER
CPYFL2: MOVE T2,S2 ;COPY DEST POINTER
SETZ T3, ;GET A NULL
IDPB T3,T2 ;TERMINATE WITH A NULL
$RETT ;RETURN TO CALLER
;BIT TABLE FOR CPYFLD BREAK CHARACTER CHECKING
XX==0
BITS: LSTOF.
REPEAT ^D36,<
EXP 1B<XX>
XX==XX+1>
LSTON.
;CPYSTR Routine to copy a string until mask character
;CALL S1/ Source pointer
; S2/ Destination pointer
;RETURN S1/ Updated pointer
; S2/ Updated pointer
; T1/ String terminator character
CPYSTR: ILDB T1,S1 ;GET THE CHARACTER
JUMPE T1,CPYS1 ;TERMINATE ON NULL
CAIE T1,"*" ;MASK CHARACTER?
CAIN T1,"%"
JRST CPYS1 ;YES..RETURN CORRECT POINTER
IDPB T1,S2 ;NO..STORE CHARACTER
JRST CPYSTR ;LOOP UNTIL MASK FOUND
CPYS1: $SAVE <T1,T2> ;Save terminator and T2
$CALL DPB ;BACK UP SOURCE POINTER
MOVE T2,S2 ;GET DESTINATION POINTER
SETZ T1, ;GET A NULL
IDPB T1,T2 ;TERMINATE DEST STRING
JRST .RETT ;RETURN TO CALLER
;MSKSIZ Return the mask limits
;CALL S1/ Pointer to mask
;RETURN S1/ Updated pointer
; S2/ max length,,min length
; T1/ Mask terminator character
MSKSIZ: SETZ S2, ;CLEAR THE COUNT
MSKS1: ILDB T1,S1 ;GET A BYTE FROM STRING
JUMPE T1,MSKS2 ;EXIT IF NULL FOUND
CAIN T1,"*" ;IS IT A WILD MASK CHARACTER?
HRLI S2,377 ;YES..MAKE SIZE MAXIMUM
CAIN T1,"%" ;IS IT CHARACTER MASK?
AOJA S2,MSKS1 ;YES..ADJ MIN LENGTH
CAIN T1,"*" ;WAS IT A WILD MASK CHARACTER?
JRST MSKS1 ;YES..GET NEXT CHARACTER
MSKS2: TLNN S2,377 ;WAS "*" SEEN?
HRL S2,S2 ;NO.. MAX==MIN
DPB: SOS S1 ;DECREMENT BYTE POINTER
IBP S1
IBP S1
IBP S1
IBP S1
JRST .RETT ;RETURN TO CALLER
SUBTTL CHKPTR Routine to fix -1 type pointers
;ACCEPTS S1/ Address of list of pointer address
;RETURNS TRUE Pointers are valid pointers
CHKPTR: $SAVE <S2> ;[0055]
SKIPN S2,(S1) ;Get pointer address
$RETT ;Return on 0 address
MOVE T1,@S2 ;Get the pointer
TLC T1,-1 ;Is LH = 0
TLCN T1,-1 ; or -1 ?
HRLI T1,(POINT 7,0) ;Yes..make full word pointer
HRRI T1,@T1 ;Remove indexing and indirect
TLZ T1,37 ;Clear the bits
MOVEM T1,@S2 ;Store the pointer
AOJA S1,CHKPTR ;Do next pointer
SUBTTL DAPOPN Routine to Open logical link
DAPIOB: $BUILD (.DOSIZ) ;Dap link open block
$SET (.DOFLG,DO%LNK,DAPLNK) ;Request first link
$SET (.DOFLG,DO%PSI,1) ;Use PSI
$SET (.DOFLG,DO%WCN,1) ;Wait for connection
$SET (.DOPSI,DO%CDN,.ICCDN) ;Connect/Disconnect channel
$SET (.DOPSI,DO%DAV,.ICDAV) ;Data available
$SET (.DOPSI,DO%INA,.ICIMA) ;Interrupt message
$SET (.DOOBJ,,<POINT 7,OBJNAM>) ;Requested object
$SET (.DOUSR,,<POINT 7,REMUSR>) ;User string
$SET (.DOPSW,,<POINT 7,REMPSW>) ;Password string
$SET (.DOACT,,<POINT 7,REMACT>) ;Account string
$EOB
DAPOPN: MOVEI S1,DAPLNK ;Get proper index
$CALL D$STAT ;Get the status
JUMPF DAPO20 ;Go open it
$RETT ;All is well
DAPO10: MOVEI S1,DAPLNK ;Get link index
MOVEI S2,[EXP .DCX42] ;Confirm DI request
$CALL D$CLOS
DAPO20: $CALL GETUSR ;Get missing info
MOVE S1,[DAPIOB,,DAPOB] ;Move initial parameters
BLT S1,DAPOB+.DOSIZ-1 ; to Dap open block
HRRO S1,REMNOD ;Get pointer to remote node
MOVEM S1,DAPOB+.DONOD ;Store in open block
MOVEI S1,.DOSIZ ;Get size of open block
MOVEI S2,DAPOB
$CALL D$OPEN ;Open the link
JUMPF DAPERR ;Display failure
MOVE S1,REMNOD ;Point to node data
MOVX S2,.NDSON ;Indicate node is accessible
MOVEM S2,ND$STA(S1)
$RETT ;Return sucess
DAPERR: MOVEI S1,DAPLNK ;Get link status
$CALL D$STAT
ANDX S1,777777 ;Get disconnect reason
MOVE S2,REMNOD ;Point to remote node data
MOVEI T1,1 ;Get string valid bit
CAIN S1,.DCX34 ;Was it bad user or password?
JRST [ANDCAM T1,ND$USR(S2) ;Yes..clear user valid
ANDCAM T1,ND$PSW(S2) ;Clear password valid
JRST DAPER1]
CAIN S1,.DCX36 ;Was it bad account?
ANDCAM T1,ND$ACT(S2) ;Yes..clear account valid.
DAPER1: JRST CMDER1 ;FORCE REPARSE
SUBTTL DAPFNC Routine to perform one DAP function
;ACCEPTS S1/ address of initial function block
;RETURNS TRUE Function accomplished
;RETURNS FALSE Error during function
DAPFNC: MOVEI S1,.DFSIZ ;Get size of function block
MOVEI S2,FNCBLK ;Point to it
$CALL D$FUNC ;PERFORM FUNCTION
JUMPF DAPERR ;Report DAP error
$RETT ;Return success
WLDERR: REPARS (Invalid use of wild cards)
DAPCLS: MOVEI S1,DAPLNK ;Get the link index
MOVEI S2,[EXP .DCX0] ;Normal close
$CALL D$CLOS
$RETT ;GIVE GOOD RETURN
SUBTTL COMMAND ERROR SUBROUTINES
; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED
TSTCOL: $SAVE <S1,S2> ;PRESERVE ACS ACROSS CALL
HRRZ S1,SBK+.CMIOJ ;GET OUTPUT JFN
RFPOS ;READ FILE POSITION
HRRZ S2,S2 ;KEEP JUST THE COLUMN POSITION
JUMPE S2,.RETF ;IF AT COLUMN 1 DO NOT OUTPUT CRLF
MOVEI S2,.CHCRT ;Get crlf
BOUT ;Out put it
MOVEI S2,.CHLFD ;Get line feed
BOUT ;Out put it
$RETT ;RETURN TO WHENCE WE CAME ...
; ROUTINE TO OUTPUT THE JSYS MESSAGE ON AN ERROR FROM A GTJFN OR OPENF
;
; CALL: CALL PUTERR
;RETURNS TRUE ALWAYS
PUTERR: $TEXT (,<^E/[-2]/>) ;Display last error
$RETF ;RETURN TO WHENCE WE CAME ...
; ROUTINE TO OUTPUT PROPER STUFF WHILE DOING A TAKE
; CALL: CALL TAKTST
;RETURNS TRUE ALWAYS
TAKTST: SKIPE TAKFLG ;Doing a TAKE?
SKIPN DSPFLG ; and displaying output?
$RETT ;No..just return
$TEXT (,<^Q/DPRMPT/^T/CMDBUF/^A>) ;Yes..Log command
$RETT
LOGCHR: CAIE S1,"?" ;Error character?
CAIN S1,"%" ; or warning character?
$CALL [$SAVE <S1,S2,T1>
$CALL SUPOFF ;Yes..clear output suppression
$CALL CHKPOS ;do <CRLF> if needed
$RETT] ;Continue
LOGCH1: AOS LOGPOS ;Increment position
CAIN S1,.CHCRT ;Carriage return?
SETOM LOGPOS ;Yes..reset position
MOVE S2,S1 ;Put character in S2
HRRZ S1,SBK+.CMIOJ ;Get output JFN
BOUT ;Write the character
CAIE S1,.PRIOU ;Primary output?
SKIPN DSPFLG ; not displaying take stuff?
$RETT ;Yes..just return
MOVEI S1,.PRIOU ;Display on terminal for take
BOUT
$RETT
CHKPOS: SKIPG LOGPOS ;At column 0?
$RETT ;Yes..just return
$SAVE <S1> ;No..save calling character
MOVEI S1,.CHCRT ;Send a carriage return
$CALL LOGCH1
MOVEI S1,.CHLFD ;Send a line feed
$CALL LOGCH1
$RETT ;RETTurn original character
;TYPATM - ROUTINE TO TYPE THE CONTENTS OF THE ATOM BUFFER
;
;ACCEPTS IN S1/ POINTER TO ASCIZ PREFIX STRING TO BE TYPED
; CALL TYPATM
;RETURNS TRUE ALWAYS
TYPATM: $TEXT (T%TTY,<^Q/S1/ "^T/ATMBUF/">)
$RETT
;STOATM - ROUTINE TO COPY ATOM
;STOSTR - ROUTINE TO COPY AN ASCIZ STRING
;ACCEPTS S1/ DESTINATION DESIGNATOR
; S2/ SOURCE DESIGNATOR (STOSTR ONLY)
;RETURNS TRUE
STOATM: HRROI S2,ATMBUF ;POINT TO ATOM
STOSTR: SETZ T1, ;TERMINATE ON NULL
SOUT
$RETT
SUBTTL CMDINI Command parsing initialization routine
;ALWAYS CALL THIS ROUTINE AT A LESS-THAN-OR-EQUALLY NESTED LOCATION
;WITHIN THE PROGRAM IN COMPARISON WITH ANY SUBSEQUENT CALL TO THE COMND
;JSYS EXECUTION ROUTINES
CMDINI: POP P,T1 ;REMEMBER EOF ADDRESS
CAMG P,CMDFRM ;NEED TO SAVE CONTEXT?
JRST CMDIN1 ;NO..JUST SAVE EOF STUFF
$SAVE <CMDFRM,CMDPDL,SBK+.CMRTY,REPADR,EOFADR,NOPRMT>
STKVAR <<SAVACS,20>> ;SAVE THE CONTEXT AC'S
HRLI S1,CMDACS
HRRI S1,SAVACS
BLT S1,17+SAVACS
HLRZ S1,CMDPDL ;GET SAVED STACK SIZE
ADD S1,CMDPDL ;OFFSET SAVED WORDS
HRRZM S1,CMDPDL ;SET SAVE STACK SIZE TO ZERO
HLRZ S2,S1
PUSH P,[CMDIN2] ;SAVE FIXUP ADDRESS
CMDIN1: MOVEM T1,EOFADR ;SAVE EOF ADDRESS
MOVEM P,CMDFRM ;REMEMBER BEGINNING OF STACK
MOVEI S1,REPAR ;REPARSE ADDRESS
MOVEM S1,SBK+.CMFLG
MOVEI S1,CMDPDL+1
SKIPN CMDPDL ;FIRST PASS
MOVEM S1,CMDPDL ;YES..INIT CMD STACK STORAGE
MOVE S1,[.PRIIN,,.PRIOU]
SKIPN SBK+.CMIOJ
MOVEM S1,SBK+.CMIOJ ;STORE THE JFN'S
HLRZ S1,SBK+.CMIOJ ;GET INPUT JFN
DVCHR ;FIND OUT WHAT IT IS
LOAD S2,S2,DV%TYP ;GET DEVICE TYPE
SETOM NOPRMT ;ASSUME NULL PROMPT
CAIE S2,.DVTTY ;IS IT TTY?
CAIN S2,.DVPTY ; OR PTY?
SETZM NOPRMT ;YES..WE NEED THE PROMPT
PUSH P,EOFADR ;RETURN TO CALLER
JRST CMDIN3 ;INIT SBK AND RETURN
;HERE TO RESTORE PREVIOUS CONTEXT
CMDIN2: HRLI S1,SAVACS
HRRI S1,CMDACS
BLT S1,CMDACS+17 ;RESTORE THEM ALL
CMDIN3: MOVX S1,<POINT 7,CMDBUF> ;POINTER TO COMMAND BUFFER
MOVEM S1,SBK+.CMBFP
MOVEM S1,SBK+.CMPTR ;POINTER TO NEXT FIELD
MOVEI S1,CMDBLN*5 ;ROOM FOR TYPIN
MOVEM S1,SBK+.CMCNT
SETZM SBK+.CMINC ;NO UNPARSED CHARACTERS YET
MOVX S1,<POINT 7,ATMBUF> ;POINTER TO ATOM BUFFER
MOVEM S1,SBK+.CMABP
MOVEI S1,ATMBLN*5
MOVEM S1,SBK+.CMABC ;ROOM IN ATOM BUFFER
MOVEI S1,GJFBLK ;POINTER TO JFN BLOCK
MOVEM S1,SBK+.CMGJB
$RETT
SUBTTL Command field parsing routines
;COME HERE TO PROMPT FOR NEW COMMAND OR NEW PROMPT LINE OF COMMAND.
;CALL THIS ROUTINE WITH POINTER TO PROMPT IN S1, OR 0 IF NO PROMPT.
DPROMP: MOVEM S1,DPRMPT ;SAVE PROMPT POINTER FOR TAKTST
SKIPN NOPRMT ;WANT ANY PROMPT?
CAIN S1,0 ;YES..ANY PROMPT SPECIFIED?
HRROI S1,[0] ;NO, POINT TO A NULL STRING
MOVEM S1,SBK+.CMRTY ;SAVE POINTER TO PROMPT
POP P,REPADR ;REMEMBER REPARSE ADDRESS
DMOVEM 0,CMDACS+0 ;SAVE AC'S
MOVE 1,[2,,CMDACS+2]
BLT 1,CMDACS+17
HRL S1,CMDFRM ;SAVE FROM BOTTOM OF STACK
HRR S1,CMDPDL ;MOVE DATA TO COMND PDL AREA
HRRZ S2,P ;SEE WHERE TOP OF STACK IS NOW
SUB S2,CMDFRM ;CALCULATE NUMBER OF WORDS
HRLM S2,CMDPDL ;SAVE SIZE OF SAVED STACK
BLT S1,CMDPDL(S2) ;SAVE THE STACK
PUSH P,REPADR ;MAKE STACK LIKE IT WAS
MOVEI S1,[FLD(.CMINI,CM%FNC)] ;TYPE PROMPT
$CALL RFIELD ;YES..DO IT
$RETT ;RETURN TO CALLER
;READ A FIELD ROUTINE. GIVE IT ADDRESS OF FUNCTION BLOCK IN A.
;JRSTS TO CMDERR IF ERROR. S1 AND S2 WILL HAVE
;RESULT OF COMND JSYS IN THEM.
RFIELD: $CALL RFLDE ;READ FIELT2, SKIP IF SUCCESS
JUMPF CMDERR ;FAILED, GO PROCESS ERROR
$RETT ;SUCCESS
;ROUTINE TO READ A FIELD AND SKIP IFF SUCCESSFUL. S1,S2, AND C WILL HAVE
;RESULT OF COMND JSYS IN THEM UPON RETURN.
PARSE:
RFLDE: MOVE S2,S1 ;PUT FUNCTION BLOCK POINTER IN B
MOVEI S1,SBK ;POINTER TO STATE BLOCK IN A
COMND ;READ FIELD OF COMND
ERJMP [HLRZ S1,SBK+.CMIOJ ;[100]
GTSTS ;[100]
TXNE S2,GS%EOF ;[100]
JRST CMDEOF ;[100]EOF
$TEXT (,<?Command JSYS failed, type CONTINUE to try again>)
;[100]
HALTF ;[100]
JRST CMDEOF] ;[100]
TXNE S1,CM%NOP ;DID COMMAND PARSE CORRECTLY?
$RETF ;NO SINGLE RETURN
LOAD T2,.CMFNP(T1),CM%FNC ;GET THE PARSED FUNCTION
$RETT ;YES, SKIP RETURN
CMDEOF: HLRZ S1,SBK+.CMIOJ ;GET COMND INPUT JFN
GTSTS ;READ THE STATUS
MOVE P,CMDFRM ;RESTORE FRAME
PUSH P,EOFADR ;RETURN FALSE AFTER CMDINI
SETZ S1, ;CLEAR ERROR REASON
TXNN S2,GS%EOF ;WAS ERROR EOF?
$RETF ;NO..JUST RETURN ERROR
$RETE (EOF) ;YES..RETURN EOF
;READ A FIELD AND REQUIRE CARRIAGE RETURN AFTER IT FOR CONFIRMATION
CFIELD: STKVAR <<VALUES,2>>
$CALL RFIELD ;READ THE FIELD
DMOVEM S1,VALUES ;SAVE DATA FROM FIELD
CONFRM ;GET CONFIRMATION
DMOVE S1,VALUES ;GET VALUES OF FIELD
$RETT ;RETURN TO CALLER
SUBTTL Command parsing error and reparse routines
.REPAR: $CALL TSTCOL ;CRLF IF NEEDED
$TEXT (T%TTY,<?^T/0(S1)/>) ;DISPLAY MESSAGE
$CALL RELJFN
JRST CMDER1 ;BACK TO THE BEGINNING
;GET HERE ON COMND JSYS ERROR. LET USER TRY AGAIN.
MESLN==30
CMDERR: STKVAR <<ERMES,MESLN>>
HRROI S1,ERMES ;POINT TO MESSAGE AREA
MOVE S2,[.FHSLF,,-1] ;OURSELF, MOST RECENT ERROR
MOVSI T1,-MESLN*5 ;MAXIMUM STRING WE'VE ROOM FOR
ERSTR ;GET ERROR STRING
JFCL
JFCL ;UNEXPECTED ERRORS
HRROI S1,ERMES ;POINT AT STRING
ESOUT ;PRINT IT IN STANDARD MANNER
;...
;COME HERE TO LET USER FIX HIS ERROR (BY TYPING ^H) OR ISSUE ANOTHER
;COMMAND
;PRINT ERROR MESSAGE BEFORE TRANSFERRING HERE
;...
CMDER1: SKIPN TAKFLG ;ARE WE IN A TAKE
JRST CMDER2 ;NO..JUST REPARSE
HLRZ S1,SBK+.CMIOJ ;GET INPUT JFN
CAIN S1,.PRIIN ;READING FROM TERMINAL?
JRST CMDER2 ;YES..JUST REPARS
$CALL TSTCOL ;BACK TO FIRST COLUMN
SKIPN INIFLG ;[0071]
$TEXT (T%TTY,<?Error during take file, aborting TAKE command>)
SKIPE INIFLG ;[0071]
$TEXT (T%TTY,<?Error processing PS:NFT.INIT, aborting processing>)
JRST CMDEOF ;Force exit from take
CMDER2: SOS REPADR ;MODIFY REPARSE ADDRESS SO REPROMPT HAPPENS
JRST REPAR
;PLACE TO TRANSFER IF USER EDITS PREVIOUSLY PARSED FIELDS
REPAR: MOVE P,CMDACS+P ;RESTORE P FOR SIZE CALCULATION
HRL S1,CMDPDL ;RESTORE STACK FROM SAVED STACK
HRR S1,CMDFRM ;COPY TO BOTTOM OF STACK
BLT S1,(P) ;RESTORE THE STACK
MOVSI 16,CMDACS ;MAKE BLT POINTER
BLT 16,16 ;RESTORE REST OF AC'S
JRSTF @REPADR ;BACK TO END OF PROMPT CALL
SUBTTL GENERAL SUBROUTINES
; ROUTINE TO CLEAR GTJFN BLOCK USED BY COMND JSYS
;
; CALL: CALL CLRGJF
CLRGJF: MOVE S1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD OF BLOCK
BLT S1,GJFBLK+GJFLEN-1 ;CLEAR GTJFN BLOCK
MOVE S1,[.NULIO,,.NULIO] ;GET NULL IO DEVICE
MOVEM S1,.GJSRC+GJFBLK ;SAVE IT
$RETT ;RETURN TO WHENCE WE CAME ...
;RELJFN QUICKY ROUTINE TO RELEASE ALL NON-OPEN JFNS
;ACCEPTS NO ARGUMENTS
;RETURNS TRUE ALWAYS
RELJFN::MOVX S1,CZ%NCL!.FHSLF ;RELEASE ALL NON-OPEN JFNS
CLZFF
$RETT ;RETURN
;ECHOON AND ECHOOF - ROUTINES TO TURN ECHOING ON AND OFF
;ACCEPTS NO ARGUMENTS
;RETURNS TRUE ALWAYS
ECHOON: SKIPA T1,[TXO S2,TT%ECO] ;GET INSTRUCTION
ECHOOF: MOVE T1,[TXZ S2,TT%ECO] ;OR OTHER ONE
MOVEI S1,.PRIIN ;PRIMARY INPUT
RFMOD ;READ STATUS OF TERMINAL
XCT T1 ;TURN ON OR OFF ECHO BIT
SFMOD ;SET TERMINAL TO NEW STATUS
$RETT ;RETURN
SUBTTL NODGET Routine to build node recognition table
NODGET: $SAVE <P1,P2> ;PRESERVE SOME AC'S
MOVEI S1,2 ;[0073]
$CALL M%AQNP ;[0073]GET 2 PAGES
LSH S1,11 ;[0073]
MOVE T2,S1 ;[0073]SAVE ADDRESS OF PAGE
SKIPE NODTBL ;FIRST TIME HERE?
JRST NODGE1 ;NO..SKIP CREATION STUFF
SETZM 0(T2) ;[0073]
HRLI S1,0(T2) ;[0073]CLEAR NODE DATA BASE
HRRI S1,1(T2) ;[0073]
BLT S1,^D1023(T2) ;[0073]
$CALL L%CLST ;YES..CREATE THE NODE LIST
MOVEM S1,NODLST ;SAVE THE INDEX
MOVEI S1,.NDGLN ;GET LOCAL HOST NAME
MOVEI S2,0(T2) ;[0073]POINT TO ARG BLOCK
HRROI T1,DEFNOD
MOVEM T1,.NDNOD(S2) ;STORE POINTER IN BLOCK
NODE
ERJMP [MOVEI S1,2 ;[0073]
MOVE S2,T2 ;[0073]
LSH S2,-11 ;[0073]
$CALL M%RLNP ;[0073]
$RETF]
HRROI S1,DEFNOD ;Point to the name
PUSH P,T2 ;[0073]
$CALL NODADD ;Add local node to table
POP P,T2 ;[0073]
MOVEM S2,LOCNOD ;SAVE THE ENTRY ADDRESS
NODGE1: MOVE S2,NODTBL ;[0072]NODE TABLE
HLRZ S1,0(S2) ;[0072]COUNT OF ENTRIES
JUMPE S1,NODGE3 ;[0072]NONE THERE?
NODGE2: AOS S2 ;[0072]POINT AT NEXT ENTRY
HLRZ T1,0(S2) ;[0072]POINT TO ENTRY
PUSH P,T2 ;[0072]
MOVEI T2,.NDSOF ;[0072]GET OFFLINE STATUS
MOVEM T2,ND$STA(T1) ;[0072]SET IT OFFLINE
POP P,T2 ;[0072]
SOSE S1 ;[0072] ANY MORE?
JRST NODGE2 ;[0072] YES, KEEP GOING
NODGE3: MOVEI S1,^D1023 ;[0073]GET ARGBLK LENGTH
MOVEM S1,0(T2) ;[0073]SAVE FOR NODE JSYS
MOVEI S1,.NDGNT ;GET THE FUNCTION
MOVEI S2,0(T2) ;[0073]AND ADDR OF ARG BLOCK
NODE ;READ THE NAMES
ERJMP [MOVEI S1,2 ;[0073]
MOVE S2,T2 ;[0073]
LSH S2,-11 ;[0073]
$CALL M%RLNP ;[0073]
$RETF]
HLLZ P1,.NDNND(T2) ;[0073]GET COUNT OF NODES
MOVN P1,P1 ;NEGATE IT
HRRI P1,.NDBK1(T2) ;[0073]GET ADDRESS OF FIRST BLOCK
NODGE4: MOVE P2,(P1) ;GET CURRENT BLOCK ADDRESS IN P2
MOVE S1,NODTBL ;POINT TO NODE TABLE
MOVE S2,.NDNAM(P2) ;GET POINTER TO NAME STRING
TBLUK ;FIND THE NODE
TXNE S2,TL%NOM+TL%AMB ;AMBIGUOUS OR NO MATCH?
JRST [MOVE S1,.NDNAM(P2) ;YES..ADD IT TO THE TABLE
PUSH P,T2 ;[0073]
$CALL NODADD
POP P,T2 ;[0073]
JRST .+1] ;FINISH ALL THE REST
MOVE S1,(S1) ;YES -- GET NODE INFO ADDRESS
MOVE S2,.NDSTA(P2) ;Get on or off-line status
MOVEM S2,ND$STA(S1) ;Store it
AOBJN P1,NODGE4 ;DO ALL NODES
MOVEI S1,2 ;[0073]
MOVE S2,T2 ;[0073]
LSH S2,-11 ;[0073]
$CALL M%RLNP ;[0073]
$RETT ;RETURN
SUBTTL NODADD Routine to add an entry to node table
;ACCEPTS S1/ pointer to node name string to be added
;RETURNS S1/ address of table entry
; S2/ address of node data
NODADD: $SAVE <P1> ;REMEMBER CALLING ARG
MOVE P1,S1
MOVE S1,NODLST ;GET NODE LIST INDEX
MOVEI S2,ND$LEN ;GET REQUIRED SIZE FOR ENTRY
$CALL L%CENT ;CREATE AN ENTRY
MOVE T4,S2 ;REMEMBER ENTRY ADDRESS
HRROI S1,ND$NAM(S2) ;POINT TO STORAGE FOR STRING
MOVE S2,P1 ;GET POINTER TO NAME
$CALL STOSTR ;COPY THE NAME
$CALL NODEXP ;CHECK TABLE SIZE
MOVE S2,T4 ;GET ENTRY ADDRESS
HRLI S2,ND$NAM(S2) ;POINT TO NAME STRING
MOVE S1,NODTBL
TBADD ;ADD IT TO TABLE
MOVE P1,S1 ;REMEMBER WHERE IT WENT
SKIPN T3,LOCNOD ;Is this the local node?
JRST NODAD1 ;Yes..get local defaults
SETOM ND$STA(T4) ;No..Mark temporary status
HRROI S1,ND$USR(T4) ;Copy local default USER
HRROI S2,ND$USR(T3) ;...
$CALL STOSTR
HRROI S1,ND$ACT(T4) ;Copy local default ACCOUNT
HRROI S2,ND$ACT(T3) ;...
$CALL STOSTR
JRST NODAD2 ;Return Node entry address
NODAD1: MOVE S1,[[ASCIZ/TOPS20/],,.OSTP20] ;Get local defaults
MOVEM S1,ND$OST(T4) ;Set TOPS10 ostype
GJINF ;Get user number
MOVE S2,S1 ;Store user name
HRROI S1,ND$USR(T4) ;...
DIRST ;...
ERJMP .+2
AOS ND$USR(T4) ;Set user valid
SETO S1, ;Get account string
HRROI S2,ND$ACT(T4) ;Store account string
GACCT ;...
ERJMP .+2
AOS ND$ACT(T4) ;Set account valid
NODAD2: MOVE S1,P1 ;Return Node entry address
HRRZ S2,0(S1) ;Return Node data address
$RETT
NODEXP: SKIPN S1,NODTBL ;Have a node table yet?
JRST NODEX1 ;No..go create one
HRRZ S1,@NODTBL ;Get maximum entry count
HLRZ S2,@NODTBL ;Get actual entry count
CAME S1,S2 ;Is table full?
$RETT ;No..just return
NODEX1: ADDI S1,MAXNOD+1 ;Yes..get more room
$CALL M%GMEM
MOVE TF,NODTBL ;Save source address
SUBI S1,1 ;Say MAXNOD entries allowed
MOVEM S1,0(S2) ;Store in table header
MOVEM S2,NODTBL ;Save new pointer
JUMPF TF,NODEX2 ;Return if no previous table
HLRZ S1,@TF ;Get current entry count
HRLM S1,@NODTBL ;Save in new table
HRL S2,TF ;Get source,,dest
AOBJP S2,.+1 ;Point past header
ADD S1,S2 ;Get final destination address
BLT S2,0(S1) ;Copy the table
HRRZ S1,@TF ;Get old table size
ADDI S1,1 ;Plus header word
MOVE S2,TF ;Get old table address
$CALL M%RMEM ;Release the memory
NODEX2: $RETT
SUBTTL RELNOD Routine to delete temporary node info
;Accepts No arguments
RELNOD: MOVE S1,NODLST ;Position to first list entry
$CALL L%FIRST
JUMPT RELNO2
$RETT
RELNO1: MOVE S1,NODLST ;Position to next list entry
$CALL L%NEXT
JUMPF .RETT ;Return on last entry
RELNO2: SKIPGE ND$STA(S2) ;Node data termporary?
$CALL DELNOD ;Yes..delete the entry
JRST RELNO1 ;Check all list entries
SUBTTL DELNOD Routine to delete node entry
;Accepts S2/ Address of node data
DELNOD: MOVE S1,NODTBL ;Get table entry address
HRROI S2,ND$NAM(S2)
TBLUK
TXNN S2,TL%EXM ;Find it?
$RETF ;No..return failure
MOVE S2,S1 ;Delete table entry
MOVE S1,NODTBL
TBDEL
MOVE S1,NODLST ;Delete list entry
$CALL L%DENT
$RETT
SUBTTL NODOFF Put node in off-line status
;Accepts S2/ Address of node data
NODOFF: MOVEI S1,.NDSOF ;Get off-line status
MOVEM S1,ND$STA(S2)
$RETT
SUBTTL PSIINI Software interrupt system initialization
PSIINI: MOVEI S1,.FHSLF ;Initialize for me
MOVE S2,[LEVTAB,,CHNTAB] ;Point to tables
SIR
MOVE S1,[.TICCA,,4] ;[0075]
ATI ;[0075]
MOVEI S1,.FHSLF ;[0075]
MOVX S2,1B<.ICCDN>!1B<.ICDAV>!1B<.ICIMA>!1B<.ICCNO>!1B4 ;[0075]
AIC ;Turn on selected channels
EIR ;Enable requests
$RETT
CNOENA: SETOM CNOFLG ;We are processing control O
MOVE S1,[.CHCNO,,.ICCNO] ;Get control O channel
ATI ;Attatch it
$RETT
CNODIS: SETZM CNOFLG ;No control O processing
MOVEI S1,.CHCNO ;Get control O character
DTI ;Detatch it
SUPOFF: HRRZ S1,SBK+.CMIOJ ;Clear suppress output flag
RFMOD
TXZ S2,TT%OSP
SFMOD
$RETT
SUBTTL Interrupt service routines
INTCTA: $BGINT 2 ;[0075]
MOVE T1,LLSTAT ;[0075]
TXNN T1,MO%CON ;[0075]LINK CONNECTED?
JRST [$TEXT (,<[No logical link established]>) ;[0075]
$DEBRK] ;[0075]
$TEXT (,<[^D/MESIN/ messages received, ^D/MESOUT/ messages sent^A>)
HRRZ S1,LOCJFN ;[0075]
GTSTS ;[0075]
TXNE S2,GS%OPN ;[0075]FILE OPEN?
SKIPN PAGFLG ;[0075]DISK FILE USING PMAPS
JRST [$TEXT (,<]>) ;[0075]NO
$DEBRK] ;[0075]
$TEXT (,<, local file open at page ^D/PAGNUM/]>) ;[0075]
$DEBRK
INTCNO: $BGINT 1
SKIPT CNOFLG ;Processing control-O?
JRST INTCN1 ;No..just debrk
HRRZ S1,SBK+.CMIOJ ;Get output JFN
RFMOD
TXCE S2,TT%OSP ;Already suppressing?
JRST [SFMOD ;Yes..compliment the state
JRST INTCN1] ;And proceed
CFOBF ;No..clear output buffer
$TEXT (,< ^^O...>) ;Say we did it
SFMOD ;Suppress output
MOVEI S1,DAPLNK ;Get link index
MOVEI S2,.DIACP ;Force access complete
$CALL D$INTR
INTCN1: $DEBRK
INTCDN: $BGINT 1
MOVEI S1,DAPLNK ;Get link index
MOVEI S2,.DICDN ;Get interrupt cause
$CALL D$INTR
$DEBRK
INTDAV: $BGINT 1
MOVEI S1,DAPLNK ;Get link index
MOVEI S2,.DIDAV ;Get interrupt cause
$CALL D$INTR
$DEBRK
INTINA: $BGINT 1
MOVEI S1,DAPLNK ;Get the link index
MOVEI S2,.DIINA ;Get interrupt cause
$CALL D$INTR
$DEBRK
SUBTTL Literals
FROMTO: ASCIZ / => / ;LITERAL TO SHOW FILE FROM, TO
PRMPT: ASCIZ /NFT>/ ;PROMPT FOR COMMANDS
LSTOF. ;Expand the literals
LIT
LSTON.
SUBTTL Interrupt tables
.PSECT DATA ;Load into impure storage
LEVTAB: LEV1PC
LEV2PC ;[0075]
EXP 0
;INTERRUPT CHANNELS
RADIX 5+5
CHNTAB:
ICHESC: 1,,INTCNO ;Control-O channel
ICHCDN: 1,,INTCDN ;Connect/Disconnect
ICHDAV: 1,,INTDAV ;Data available
ICHINA: 1,,INTINA ;Interrupt message
ICH004: 2,,INTCTA ;[0075]^A
ICH005: BLOCK 1 ;ASSIGNABLE CHANNEL 5
ICHAOV: BLOCK 1 ;ARITHMETIC OVERFLOW
ICHFOV: BLOCK 1 ;FLOATING OVERFLOW
ICH008: BLOCK 1 ;RESERVED
ICHPOV: BLOCK 1 ;PDL OVERFLOW
ICHEOF: BLOCK 1 ;END OF FILE
ICHDAE: BLOCK 1 ;DATA ERROR
ICHQTA: BLOCK 1 ;QUOTA EXCEEDED
ICH013: BLOCK 1 ;RESERVED
ICHTOD: BLOCK 1 ;TIME OF DAY (RESERVED)
ICHILI: BLOCK 1 ;ILLEG INSTRUCTION
ICHIRD: BLOCK 1 ;ILLEGAL READ
ICHIWR: BLOCK 1 ;ILLEGAL WRITE
ICHIEX: BLOCK 1 ;ILLEGAL EXECUTE (RESERVED)
ICHIFT: BLOCK 1 ;INFERIOR FORK TERMINATION
ICHMSE: BLOCK 1 ;MACHINE SIZE EXCEEDED
ICHTRU: BLOCK 1 ;TRAP TO USER (RESERVED)
ICHNXP: BLOCK 1 ;NONEXISTENT PAGE REFERENCED
ICH023: BLOCK 1 ;ASSIGNABLE CHANNEL 23
ICH024: BLOCK 1 ;ASSIGNABLE CHANNEL 24
ICH025: BLOCK 1 ;ASSIGNABLE CHANNEL 25
ICH026: BLOCK 1 ;ASSIGNABLE CHANNEL 26
ICH027: BLOCK 1 ;ASSIGNABLE CHANNEL 27
ICH028: BLOCK 1 ;ASSIGNABLE CHANNEL 28
ICH029: BLOCK 1 ;ASSIGNABLE CHANNEL 29
ICH030: BLOCK 1 ;ASSIGNABLE CHANNEL 30
ICH031: BLOCK 1 ;ASSIGNABLE CHANNEL 31
ICH032: BLOCK 1 ;ASSIGNABLE CHANNEL 32
ICH033: BLOCK 1 ;ASSIGNABLE CHANNEL 33
ICH034: BLOCK 1 ;ASSIGNABLE CHANNEL 34
ICH035: BLOCK 1 ;ASSIGNABLE CHANNEL 35
RADIX 8
.ENDPS DATA
SUBTTL Impure storage
.PSECT DATA
DEFINE $DATA (NAME,SIZE<1>) <
NAME: BLOCK SIZE
..LOC==.>
;Command parsing storage
CMDBLN==:<^D80*6>/5+1 ;ROOM FOR SIX LINE COMMAND
ATMBLN==:CMDBLN
DATORG: ;Start of impure storage to be cleared
$DATA CONBLK,14 ;[70]
$DATA CMDBUF,CMDBLN
$DATA CMDACS,20 ;SAVED AC'S FROM BEGINNING OF COMMAND LINE
$DATA EOFADR,1 ;EOF DISPATCH ADDRESS
$DATA ATMBUF,ATMBLN ;HOLDS LAST PARSED FIELD
$DATA SBK,20 ;COMND JSYS STATE BLOCK
$DATA REPADR,1 ;Reparse address for comnd
$DATA CMDFRM,1 ;Frame pointer for parse routines
$DATA CMDPDL,PDLEN ;ROOM TO SAVE PDL
$DATA CMDFDB,5 ;Temporary FDB used by PARFIL
;Interrupt PC locations
$GDATA LEV1PC,1 ;RETURN PC FOR INTERRUPT LEVEL 1
$GDATA LEV2PC,1 ;[0075]RETURN PC FOR LEV 2 INT
$DATA LOCNOD,1 ;LOCAL NODE TABLE ENTRY
$DATA DEFNOD,2 ;Default node name
$DATA OBJNAM,NAMSIZ ;Object name text
$DATA FNCBEG,0 ;Start of parsing area
$DATA FNCBLK,.DFSIZ ;Dap function block
$DATA SRCNOD,1 ;SOURCE NODE TABLE ENTRY
$DATA SRCNAM,2 ;Source node name
$DATA SRCJFN,1 ;SOURCE FILE JFN
$DATA SRCPFL,1 ;NON TOPS-20 FILE SPEC FLAG
$DATA SRCFIL,FILSIZ ;SOURCE FILE NAME STRING
$DATA SRCSWS,1 ;SOURCE FILE SWITCHES
$DATA DSTFLG,2 ;DESTINATION BLOCK POINTER
$DATA DSTNOD,1 ;DESTINATION NODE TABLE ENTRY
$DATA DSTNAM,2 ;Destination node name
$DATA DSTJFN,1 ;DESTINATION FILE JFN
$DATA DSTPFL,1 ;NON TOPS-20 FILE SPEC FLAG
$DATA DSTFIL,FILSIZ ;DESTINATION FILE NAME STRING
$DATA TMPFIL,FILSIZ ;TEMPORARY SAVE FOR DESTINATION FILE
$DATA DSTSWS,1 ;DESTINATION FILE SWITCHES
$DATA REMNOD,1 ;Remote node data address
$DATA REMJFN,1 ;Remote JFN from Name message
$DATA NODHLP,5 ;Node help string
$DATA DEFBEG,0 ;* Order must agree with mode *
$DATA REMUSR,NAMSIZ ;Remote user name
$DATA REMACT,NAMSIZ ;Remote account string
$DATA REMPSW,NAMSIZ ;Remote password string
DEFSIZ==.-DEFBEG ;Size of default save area
$DATA REMOPD,NAMSIZ ;Remote optional data
$DATA FILATT,1 ;File attribute switches
$DATA GJFBLK,GJFSIZ ;GTJFN BLOCK FOR COMND JSYS
$DATA DEFDEV,NAMSIZ ;DEFAULT OUTPUT DEVICE STORAGE
$DATA DEFDIR,NAMSIZ ;DEFAULT DIRECTORY STRING
$DATA DEFNAM,NAMSIZ ;DEFAULT FILENAME STORAGE
$DATA DEFEXT,NAMSIZ ;DEFAULT EXTENSION STORAGE
$DATA DEFVER,NAMSIZ ;DEFAULT VERSION STORAGE
GJFLEN==.-GJFBLK ;LENGTH TO CLEAR FOR CLRGJF
$DATA CNOFLG,1 ;-1 if Control-O being trapped
$DATA NAMFLG,1 ;-1 If file name displayed
$DATA SNDFLG,1 ;-1 if sending files to remote node
$DATA VOLNAM,8 ;Pointer to current volume name
$DATA DIRNAM,8 ;Pointer to current direct name
$DATA FILNAM,8 ;Pointer to current file name
$DATA FILSPC,^D20 ;Pointer to current filespec
FNCSIZ==.-FNCBEG ;SIZE OF COPY AREA
$DATA DIRTXT,^D40 ;Storage for NAME;PROTECTION
$DATA DIRTX1,^D20 ;Storage for n nnnn(n)
$DATA PDL,PDLEN ;PUSH DOWN POINTER
$DATA CMDJFN,1 ;INPUT JFN FOR TAKE COMMAND
$DATA LOGJFN,1 ;OUTPUT JFN FOR TAKE COMMAND
$DATA LOGPOS,1 ;Current logfile (or terminal) position
$DATA INIFLG,1 ;[0071]NON-ZERO IF READING NFT.INIT
$DATA TAKFLG,1 ;NON-ZERO IF PROCESSING INDIRECT FILE
$DATA DSPFLG,1 ;NON-ZERO IF DISPLAYING TAKE
$DATA PASFLG,1 ;[76]-1 IF COMMAND FILE HAS WORLD READ ACCESS
$DATA NOPRMT,1 ;NON-ZERO IF NULL PROMPT WANTED
$DATA DPRMPT,1 ;PROMPT POINTER
$DATA DAPOB,.DOSIZ ;Dap Open block
;Node data base storage
$DATA NODLST,1 ;NODE LIST INDEX
$DATA NODTBL,1 ;Address of node recognition table
$DATA NFTEND,0 ;End of impure storage
.ENDPS DATA ;Back to normal storage
END <3,,ENTVEC>