Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50512/io10.b36
There are no other files named io10.b36 in the archive.
MODULE IO10 ( !TOPS-10 I/O INTERFACE FOR RMCOPY
IDENT = '1'
) =
BEGIN
! COPYRIGHT (C) 1978
! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A SINGLE
! COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION OF THE
! ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANY OTHER COPISE THEREOF,
! MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
! EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE
! TERMS. TITLE TO AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES
! REMAIN IN DEC.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
! AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
! CORPORATION.
!
! DEC ASSUMES NO RESPONSIBLILTY FOR THE USE OR RELIABILITY OF ITS
! SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
!
!++
! FACILITY:
! RMCOPY FOR TOPS-10 ONLY
!
! ABSTRACT:
! This module provides the hooks for doing command string I/O,
! indirect command file reading, node name checking,
! terminal message printing, file access checking, and QUASAR interface.
!
! ENVIRONMENT:
! TOPS-10
!
! AUTHOR: Dave Cornelius, CREATION DATE: December, 1977
!
! MODIFIED BY:
! Dave Cornelius, 03-Jan-78: VERSION
! 01 - Move in OWNs for INIT_INDIRECT and GET_INPUT_STRIN
! 21-Mar-78 Dave Cornelius
! 02 - Make OWNS into GLOBALS so MAIN10 can initialize them
! Add command rescan capabilities to GET_TTY_CHAR
! 03 - 03-May-78 Dave Cornelius
! Added protection address to CHK_ACCESS
! Added GETPATH routine
! 04 - 11-May-78 Dave Cornelius
! Included RELEASE calls after FBINI
! calls in CHK_ACCESS
! 05 - 17-May-78 Dave Cornelius
! Added UDATE routine
! 06 - 19-Jun-78 Dave Cornelius
! Made CHK_ACCESS take a pointer to a block, instead
! of 8 args.
! 07 - 14-Aug-78 Cleared GISIIC problems by clearing CCLFLG on any exit
! from GET_INPUT_STRING.
! 10 - 16-Aug-78 fixed 1, 2 digit years on absolute dates in UDATE
! 11 - Make version printer do .JBCST
!--
!
!
! CONDITIONAL COMPILATION:
!
COMPILETIME FTNETSPL=((%VARIANT AND 2) NEQ 0);
!Turn on if being compiled for NETSPL, off for RMCOPY
!VARIANT:400 to supress the messages that follow
%IF (%VARIANT AND %O'400') EQL 0 %THEN
%IF FTNETSPL
%THEN %INFORM ('IO10 for NETSPL')
%ELSE %INFORM ('IO10 for RMCOPY')
%FI
%FI;
! TABLE OF CONTENTS:
!
! GET_LOCAL_NODEI return the name of the node we are running on
! UNSIXIT (local routine) converts SIXBIT to ASCII
! CHK_ACCESS see if the user can access a file a certain way
! GET_INPUT_STRIN get the next command line
! INIT_INDIRECT open a file for command string reading
! GETPATH find the user's ppn and path
! UDATE Make a universal date-time word
! MSGERROR dump a message on the user's terminal
! GETVRS Convert .JBREL to ASCII
! GETVRS Convert LCG Version # to ASCII
FORWARD ROUTINE
GET_LOCAL_NODEI,
UNSIXIT;
%IF NOT FTNETSPL %THEN
FORWARD ROUTINE
CHK_ACCESS,
GET_INPUT_STRIN,
INIT_INDIRECT,
GETPATH,
UDATE;
%FI
FORWARD ROUTINE
MSGERROR:NOVALUE,
GETVRS,
CVTVRS; !
!
! DEFINITION LIBRARY FILES:
!
%IF FTNETSPL
%THEN LIBRARY 'INTR'; !For File-block fields and some macros
%ELSE
LIBRARY 'IPCF';
LIBRARY 'RMCOPY'; !The interface to the system-independent portion
%FI
!
! MACROS:
!
!
! EQUATED SYMBOLS:
!
!
! OWN STORAGE:
!
!For communication between INIT_INDIRECT and GET_INPUT_STRIN
OWN FB$INDIRECT:FILE_BLOCK;
GLOBAL G$INEO:BLOCK[1];
GLOBAL G$ININ:BLOCK[1];
!
! EXTERNAL REFERENCES:
!
!EXTERNAL ROUTINE
EXTERNAL ROUTINE FPARSE,FBINI,FILOP; !Andy's routines from IO.B36
EXTERNAL ROUTINE BINA; !Andy's Byte In routine
EXTERNAL ROUTINE WRNUMA; !To convert numbers to ASCII
%IF NOT FTNETSPL %THEN
EXTERNAL CCLPTR, CCLFLG; !A pointer to CCL text, and
EXTERNAL ROUTINE PATH,WRSIXA,RELEASE; !GETPATH needs these to get
!data and for conversion
EXTERNAL G$NOW; !The universal date/time
!of the time of the run.
!(needed by UDATE)
%FI
!A flag that ptr is valid
MODULE_NAME_IS[IO10]
VERSION[1] EDIT[3] DATE[05,MAY,78]
GLOBAL ROUTINE GET_LOCAL_NODEI (POINTERADR, MAXCOUNT)=
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine is used to obtain the name of the system on
! which RMCOPY is running. This information is useful for
! checking validity of user requests. The routine finds out the local
! node id by first finding out the node number of the site
! on which this process is running, and then converting the
! node number to a SIXBIT node name. The central site is
! obtained by requesting the node number of the device CTY.
!
! FORMAL PARAMETERS:
!
! POINTERADR - The address of a character sequence pointer where the ID is to be placed.
!
! MAXCOUNT - The maximum number of characters which may be written
! using the pointer specified by POINTERADR.
!
! IMPLICIT INPUTS:
!
! maximum value of MAXCOUNT is specified by routine UNSIXIT
!
! IMPLICIT OUTPUTS:
!
! The node name is placed using the POINTER.
!
! ROUTINE VALUE:
!
! if > or = to 0, this is the number of characters that were written
! into the sequence. (The sequence is NOT null terminated.)
! if < 0, then one of the UUOs failed.
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
!UUO SYMBOL DEFINITIONS
LITERAL NODE_ = %O'157', !NODE. = CALLI 157
WHERE = %O'63', !WHERE = CALLI 63
_NDRNN = %O'2', !FUNCTION CODE FOR NODE. UUO
ARGLSTLEN = 2; !LENGTH OF OUR LIST FOR NODE.
REGISTER A; !FOR UUO USAGE
LOCAL NODEBLOCK:VECTOR[ARGLSTLEN];
A = %SIXBIT 'CTY ';
IF CALLI (A, WHERE) THEN
BEGIN
NODEBLOCK[0] = ARGLSTLEN; !MARK LENGTH OF BLOCK
NODEBLOCK[1] = .A<RH>; !OUR NODE NUMBER, AS AN INTEGER
A<LH> = _NDRNN; !FUNCTION CODE:RETURN NODE NAME
A<RH> = NODEBLOCK[0]; !ADRS OF ARG LIST
IF CALLI (A, NODE_)
THEN
BEGIN
NODEBLOCK[0] = .A; !SAVE THE SIXBIT NAME
UNSIXIT (%REF (CH$PTR(NODEBLOCK[0], 0, 6)),
.POINTERADR,
.MAXCOUNT)
END
ELSE
G_L_N$FAI !NODE. UUO FAILED
END
ELSE
G_L_N$FAI !WHERE UUO FAILED
END;
ROUTINE UNSIXIT (SIXPTRADR, SEVENPTRADR, MAXCHARS)=
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine converts a SIXBIT string to a seven bit ASCII string.
!
! FORMAL PARAMETERS:
!
! SIXPTRADR - The address of a pointer to the first char of the SIXBIT sequence
!
! SEVENPTRADR - The address of a pointer to the first character of the ASCII destination
! sequence.
!
! MAXCHARS - The max number of chars which may be written in the destination.
!
! IMPLICIT INPUTS:
!
! This routine never converts more than 6 SIXBIT chars, thus the implied
! maximum value of MAXCHARS is 6.
! The SIXBIT string to be converted is input via the SIXPTR parameter.
!
! IMPLICIT OUTPUTS:
!
! The ASCII string is written out using the SEVENPTR parameter.
! The pointer specified by SEVENPTRADR is updated to the character
! position following the last character written.
! The pointer specified by SIXPTRADR will point somewhere near the
! end of the SIXBIT sequence converted.
!
! ROUTINE VALUE:
!
! The number of characters converted, always > or = 0.
!
! SIDE EFFECTS:
!
! none
!
!--
BEGIN
LOCAL CHAR; !HOLDS CHARACTER BEING MUNCHED
LOCAL CHARSDONE; !COUNTS HOW MANY CHARS WE CONVERTED
MAXCHARS = (IF .MAXCHARS LSS 6 THEN .MAXCHARS ELSE 6);
INCR CHARSDONE FROM 0 TO .MAXCHARS - 1 DO
BEGIN
CHAR = CH$RCHAR_A(.SIXPTRADR);
IF .CHAR EQL 0 THEN RETURN .CHARSDONE;
CH$WCHAR_A (.CHAR + %O'40', .SEVENPTRADR);
END;
RETURN .CHARSDONE
END;
%IF NOT FTNETSPL %THEN !NETSPL does not use this
GLOBAL ROUTINE CHK_ACCESS (CHK_PTR)=
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine is used to determine if the current user is allowed
! access of some type to a certain file. The routine also determines the
! name of the file structure containing the file, and returns it to the caller.
! The routine makes sure the specified device is a disk, and disallows access
! to a file which is not on disk. Most of the processing
! is handled by the CHKACC UUO, but since that UUO operates
! on the file's protection, a LOOKUP is done to get the file's protection.
! If the LOOKUP fails because the file does not exists, then the
! only possible access the routine could allow is write. In that case,
! the routine tries to ENTER the file, and if successful, CLOSEs it
! immediately, throwing away the new (just ENTERed) copy of the file.
! The protection of the file (or the system standard) is returned to the
! caller. The size of the file in blocks is returned
! in the SIZ slot of the argument block.
!
! FORMAL PARAMETERS:
!
! CHK_ACCESS takes a pointer to a block of 10 parameters.
! The parameters are Bound below, to portions of the arg block
!
! FILPTR - a 7-bit pointer to an
! ASCIZ char sequence describing the file.
! This pointer is not moved.
!
! DEVPTR - A 7-bit pointer where the structure
! name should be stored.
! This pointer is not moved.
!
! DEVCOUNT - A place to store the
! number of characters written into the DEVPTR.
!
! MAXCOUNT - The maximum number of characters which can be stored at
! the DEVPTR.
!
! PRO - A place in which to store the file's protection
!
! SIZ - A place in which to store the file's size in blocks
!
! ACCESSTYPE - a code for the type of access desired (see list below)
!
! PATHPTR - A 7-bit pointer where the path specification (ppn + sfds)
! should be stored.
! This pointer is not moved.
!
! PATHMAX - The maximum number of chars which can be stored at the
! PATHPTR.
!
! PATHCOUNT - A place in which to store the number of characters
! written using the PATHPTR.
!
! IMPLICIT INPUTS:
!
! maximum value of MAXCOUNT is specified by routine UNSIXIT
!
! IMPLICIT OUTPUTS:
!
! The structure name is written back to the caller using the DEVPTR
!
! The size of the device name is written into the DEVCOUNT field.
!
! The file's protection is written into PRO
!
! The size of the file is written into SIZ
!
! The path spec is written back to the caller using the PATHPTR
!
! The size of the path is written into the PATHCOUNT field.
!
! ROUTINE VALUE:
!
! < 0 ... an error. See RMCOPY.REQ for details
!
! SIDE EFFECTS:
!
! None
!
!--
BEGIN
! Define the argument passed.
MAP CHK_PTR : REF CHK$ARGBLK;
! And Bind names to all the args passed in the block
BIND FILPTR = CHK_PTR [CHK$SPEC$PTR],
DEVPTR = CHK_PTR [CHK$DEV$PTR],
DEVCOUNT = CHK_PTR [CHK$DEV$CNT],
MAXCOUNT = CHK_PTR [CHK$DEV$MAX],
PRO = CHK_PTR [CHK$PRO],
SIZ = CHK_PTR [CHK$LIM],
ACCESSTYPE = CHK_PTR [CHK$ACCESS$VAL],
PATHPTR = CHK_PTR [CHK$PATH$PTR],
PATHMAX = CHK_PTR [CHK$PATH$MAX],
PATHCOUNT = CHK_PTR [CHK$PATH$CNT];
!Valid access types defined in RMCOPY.REQ
!Error codes returned by CHK_ACCESS defined in RMCOPY.REQ
!The UUO number for GETPPN (return running PPN in AC)
LITERAL GETPPN = %O'24';
!The UUO number of CHKACC
LITERAL CHKACC = %O'100';
!CHKACC UUO function codes
LITERAL _ACCPR = %O'0', !Change file's protection
_ACREN = %O'1', !Rename the file
_ACWRI = %O'2', !Write the file
_ACUPD = %O'3', !Update the file (old-style mode)
_ACAPP = %O'4', !Append to the file
_ACRED = %O'5', !Read the file
_ACEXO = %O'6', !Execute the file
_ACCRE = %O'7', !Create the file in the UFD
!(SFD's do not appear to be included here!!)
_ACSRC = %O'10'; !Read the directory as a file
!FILOP function codes
LITERAL _FORED = %O'1', !FILOP. function code (read file)
_FOCRE = %O'2', !Create file
_FOWRT = %O'3', !Write file
_FOSAU = %O'4', !Single access update
_FOMAU = %O'5', !Multiple access update
_FOAPP = %O'6', !Append
_FOCLS = %O'7', !Close
_FOURB = %O'10', !Checkpoint
_FOUSI = %O'11', !USETI
_FOUSO = %O'12', !USETO
_FORNM = %O'13', !Rename
_FODLT = %O'14', !Delete
_FOPRE = %O'15'; !Preallocate
!The UUO number of DSKCHR
LITERAL DSKCHR = %O'45';
PHASE(0);
FIELD DSKCHR_FIELD =
SET
DFF[DC$NAM,THISWORD,WRD], !The unit name. UUO also seems to take channel # here, too
DFF[DC$UFT,NEXTWORD,WRD],
DFF[DC$FCT,NEXTWORD,WRD],
DFF[DC$UNT,NEXTWORD,WRD],
DFF[DC$SNM,NEXTWORD,WRD] !The str name is returned here
TES;
LITERAL DSKCHR_LEN = 5; !All we need is the structure name
MACRO DSKCHR_BLOCK = BLOCK [DSKCHR_LEN] FIELD (DSKCHR_FIELD) %;
LOCAL T$PATHPTR; !Hold the passed pointer value.
LOCAL T$FILPTR; !Used as a local (updated)
LOCAL T$DEVPTR; !Same as above
!The pointers in the block are NOT moved
LOCAL DSK_BLOCK : DSKCHR_BLOCK;
LOCAL FB:FILE_BLOCK;
LOCAL FBPTR:REF FILE_BLOCK;
LOCAL PARSECODE; !For the code returned from the parser
LOCAL SIXP; !To hold a SIXBIT conversion pointer
LOCAL FILOP_CODE; !Holds the value returned by the FILOP routine
REGISTER AC; !For UUOs.
LITERAL DEVCHR = %O'4'; !The CALLI code for DEVCHR UUO
MACRO DV_DSK = 34,1%; !Bit returned by DEVCHR indicating disk device
LITERAL TOPS10_W$PER$BL = 128; !# Words per disk block on TOPS10
!The CHK_ERR macro allows easy exit with the active file block
MACRO CHK_ERR (ERRCOD) = (RELEASE (FB) ; RETURN ERRCOD) % ;
!Take no chances on char count overflow
IF .MAXCOUNT LSS 6 THEN RETURN CHK_AC$CCO;
IF .PATHMAX LSS (6+1+6+SFDMAX*(6+1)-1) THEN RETURN CHK_AC$CCO;
T$PATHPTR = .PATHPTR; !Copy the pointer (so we may move it thru the string)
T$FILPTR = .FILPTR; !Copy the file spec pointer for the same reason
T$DEVPTR = .DEVPTR; !... and copy the device pointer
FBPTR=FB; !Aim the pointer at the block
FBINI (.FBPTR); !Clean out the block
! Give operator his privs (AWN)
FB[FILE$GODLY]=1;
CALLI(AC,GETPPN); !Get our PPN
FB[FILE$ALIAS]=.AC; !Put in file block (AS IF...)
! *** Any exit from this point on MUST do a RELEASE first
FB [FILE$I_NBUFF] = FB [FILE$O_NBUFF] = 0; !Don't allocate buffers
FB[FILE$PF_NODE_A]=0; !NO nodeid is allowed on this spec !!
! Try to decode the file string into the file block
! If we can't decode it, say no access allowed
PARSECODE = FPARSE (.FBPTR, T$FILPTR);
IF .PARSECODE NEQ WIN THEN CHK_ERR (CHK_AC$DND);
AC = .FB [FILE$DEVICE]; !SIXBIT device name.
CALLI (AC, DEVCHR); !Ask for the characteristics bits
IF .AC<DV_DSK> NEQ 1 !Is it a disk?
THEN CHK_ERR (CHK_AC$DND); !Nope, too bad!!
FB [FILE$FUNCTION] = _FORED;
IF (FILOP_CODE = FILOP (.FBPTR)) NEQ WIN THEN
IF ((.ACCESSTYPE EQL CHK_AC$WRI) OR (.ACCESSTYPE EQL CHK_AC$APN))
AND (((.FILOP_CODE) ^ -3) EQL FILFNF) THEN
BEGIN !LOOKUP gave 'File-Not-Found', but we want to write (or append)
FB [FILE$FUNCTION] = _FOCRE; !Non-Superseding ENTER
IF FILOP (.FBPTR) NEQ WIN
THEN !We could neither lookup nor enter the file
CHK_ERR (CHK_AC$NAK)
ELSE !File didn't exist, but we can write it
!So, mark new file for deletion
FB [FILE$MODE] = %O'40';!40 Says close,
!throw away new file.
END
ELSE !Couldn't LOOKUP, but we must, since CHKACC UUO,
! requires protection field
IF (.FILOP_CODE ^ -3) EQL FILFNF
THEN CHK_ERR (CHK_AC$FNF)
ELSE CHK_ERR (CHK_AC$NAK)
ELSE !We now know the file exists; see if we can perform the desired function
IF .ACCESSTYPE NEQ CHK_AC$REA THEN
!If the file can be LOOKed UP, then don't do anything else, if
! all we wanted to do was read it.
BEGIN
LOCAL CHKBLK:BLOCK[3]; !3-word UUO param block
!Define a mapping from CHK_ACCESS codes to CHKACC UUO codes
BIND CHKMAP = UPLIT ( _ACRED, !CHK_AC$REA (can never be used)
_ACWRI, !CHK_AC$WRI
_ACAPP, !CHK_AC$APN
_ACREN, !CHK_AC$DLE
_ACREN !CHK_AC$RDL (read and delete)
);
MAP CHKMAP:VECTOR[5];
CHKBLK [0,RH] = .FB [FILE$PROTECTION];
CHKBLK [0,LH] = .CHKMAP [.ACCESSTYPE];
CHKBLK [1,WRD] = .FB [FILE$PPN];
CALLI (AC,GETPPN);
CHKBLK [2,WRD] = .AC;
AC = CHKBLK [0,WRD];
IF NOT CALLI (AC, CHKACC) THEN CHK_ERR (CHK_AC$NAK);
IF .AC NEQ 0 THEN CHK_ERR (CHK_AC$NAK);
END;
!Find the structure name associated with this file
DSK_BLOCK [DC$NAM] = .FB [FILE$CHANNEL]; !Aim at the open channel
AC<LH> = DSKCHR_LEN; !Length of the block
AC<RH> = DSK_BLOCK; !Aim at the block
IF NOT CALLI (AC,DSKCHR) THEN CHK_ERR (CHK_AC$DND);
PRO = .FB [FILE$PROTECTION]; !Give the prot to caller
SIZ = (.FB [FILE$SIZE] + TOPS10_W$PER$BL - 1)
/ TOPS10_W$PER$BL; !Give # blocks, too
SIXP = CH$PTR (DSK_BLOCK [DC$SNM], 0, 6); !DSKCHR returns dev name here
DEVCOUNT = UNSIXIT (SIXP, T$DEVPTR, .MAXCOUNT);!Convert the device name
WRNUMA (.FB [FILE$PROJECT], 8, T$PATHPTR);
CH$WCHAR_A(%C',',T$PATHPTR);
WRNUMA (.FB [FILE$PROGRAMMER], 8, T$PATHPTR);
INCR S FROM FB [FILE$SFD] TO FB [FILE$SFD] + SFDMAX DO
BEGIN
IF ..S EQL 0 THEN EXITLOOP;
CH$WCHAR_A(%C',', T$PATHPTR);
WRSIXA (..S, T$PATHPTR);
END;
PATHCOUNT = CH$DIFF (.T$PATHPTR, .PATHPTR);
RELEASE (FB);
END;
!Still NOT FTNETSPL...
GLOBAL ROUTINE GET_INPUT_STRIN (CHANNEL, PTRADR, MAXLENGTH)=
!++
!
! FUNCTIONAL DESCRIPTION:
!
! This routine is the means by which RMCOPY obtains single lines of
! text from the command streams. There are 2 such streams. One is
! for terminal-like input (such as CCL, TMPCOR on the -10), and
! the other is the indirect-file channel. (Mnemonics for these channels
! are defined in RMCOPY.REQ) This routine converts lowercase characters
! to uppercase, and recognizes break characters.
! The break characters are never returned to the caller, but
! this routine stops scanning when one is detected. (carriage returns preceeding
! line-feeds are removed.)
! This routine does NOT handle the '-' or /MORE switch to
! signal that more input is desired on this line. The caller must
! arrange to detect and concatenate such requests.
! This routine shares a few globals with INIT_INDIRECT.
!
! FORMAL PARAMETERS:
!
! CHANNEL - specifies terminal or indirect file (see RMCOPY.REQ for mnemonics)
! PTRADR - address of a character pointer which may be used to store
! the incoming line
! MAXCHAR - the maximum number of characters which may be stored using PTRADR
!
! IMPLICIT INPUTS:
!
! This routine senses the switches
! FB$INDIRECT - the file block for the indirect file
! G$INEO (the indirect file end-of-file flag), and
! G$ININ (the indirect file 'initialized' flag)
!
! IMPLICIT OUTPUTS:
!
! This routine may set
! G$INEO (the end-of-file flag) if it reaches the end of the indirect file
!
! ROUTINE VALUE:
!
! a value greater than of equal to zero indicates the number of
! characters read in.
! a value less than zero (see RMCOPY.REQ for mnemonics) indicates
! an error condition.
!
! SIDE EFFECTS:
!
! This routine flushes nulls (octal 0). Any illegal characters
! (as defined by the CHRMAP) are noted on the terminal, and bypassed.
! Some fields (eg pointers) of FB$INDIRECT are moved
! The CCLFLG is cleared.
!
!--
BEGIN
BUILTIN MACHOP;
LITERAL TTCALL = %O'051';
MACRO INCHWL(ADR)=MACHOP (TTCALL,4,ADR) %;
MACRO RET(VAL)=(CCLFLG=0;RETURN(VAL)) %; !Always clear CCLFLG before returning.
!!! MACRO OUTC(ADR)=MACHOP (TTCALL,1,ADR) %;
LITERAL CR = %O'15'; !A carriage return
LOCAL N; !Number of characters stored so far
LOCAL C; !A character holder
LOCAL CHAR_CODE; !holds bits and codes describing the current char
!Define the bit patterns in the map entries
LITERAL CHOK = 0; !This character is 'ok', ie allowed
LITERAL CHEOL = %O'1'; !This character marks end of line
LITERAL CHLC = %O'2'; !This character is a lowercase alpha
LITERAL CHILL = %O'4'; !This cahr is illegal in the command string
LITERAL CHPRINT = %O'10'; !This char is readable when printed
BIND CHAR_MAP = UPLIT (
REP 7 OF (CHILL), !null thru ^F
CHEOL, !^G
CHILL, !backspace
CHOK, !tab allowed
REP 4 OF (CHEOL), !LF, VT, FF, CR
REP 12 OF (CHILL), !^N thru ^X
REP 2 OF (CHEOL), !^Z, escape
REP 4 OF (CHILL), !^\ thru ^_
REP 8*8+1 OF (CHOK+CHPRINT), !space thru grave
REP 26+3 OF (CHLC+CHPRINT), !lowercase alphas
CHEOL, !~(tilde) is old alt
CHILL !rubout illegal
):VECTOR[128];
ROUTINE GET_TTY_CHAR =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
! This routine reads one character from the users tty.
!
! FORMAL PARAMETERS:
! none
!
! IMPLICIT INPUTS:
! the user's type-in, perhaps as rescanned
! The CCLFLG, and the CCLPTR
!
! IMPLICIT OUTPUTS:
! The CCLPTR may be moved
!
! ROUTINE VALUE:
! the next character that the user typed
!
! SIDE EFFECTS:
! this routine bypasses carriage returns
!
!--
REGISTER C;
IF .CCLFLG NEQ 0 THEN CH$RCHAR_A (CCLPTR) ELSE
BEGIN
INCHWL (C);
IF .C EQL CR THEN INCHWL (C); !Return the LF if we hit CR
.C
END
END;
ROUTINE GET_IDIR_CHAR =
BEGIN
!++
!
! FUNCTIONAL DESCRIPTION:
! This routine returns the next character from
! the indirect command file.
!
!
! FORMAL PARAMETERS:
! none
!
! IMPLICIT INPUTS:
! FB$INDIRECT - the file block for the indirect file
! G$INEO - the end of file flag
! G$ININ - the initialized flag
!
! IMPLICIT OUTPUTS:
! G$INEO - is set if end of file is encountered
!
! ROUTINE VALUE:
! >=0, this is the next character
! <0, one of the error codes from RMCOPY.REQ
!
! SIDE EFFECTS:
! some fields (eg pointers) of FB$INDIRECT are moved
!
!--
MACRO NEWPTR=CH$PTR(T) %; !A fresh pointer to T
LOCAL PTR; !Aimed at T, passed to BINA
LOCAL T; !Holds one packed char
LOCAL C; !Holds one unpacked char
LOCAL ERRTMP; !Holds BINA's retun value
!DO read-character UNTIL we-see-a-nice-one
DO BEGIN
IF NOT .G$ININ THEN RETURN G_I_S$CNI;
IF .G$INEO THEN RETURN G_I_S$EOF;
PTR = NEWPTR; !Aim at T
IF (ERRTMP = BINA (FB$INDIRECT, PTR)) NEQ WIN THEN
IF (.ERRTMP ^ -3) EQL ENDFILE THEN
BEGIN
G$INEO = 1; !Mark EOF on the indirect chnl
RETURN G_I_S$EOF;
END
ELSE RETURN G_I_S$IER;
PTR = NEWPTR;
C = CH$RCHAR_A (PTR); !Read the char
END UNTIL (.C NEQ CR) AND (.C NEQ 0);
.C
END;
! ***** end of the declarations section of GET_INPUT_STRIN
!Here is the body of the routine
N = 0; !Start with no work done
WHILE 1 DO
BEGIN
C = (SELECTONE .CHANNEL OF SET
[G_I_S$CHTTY]: GET_TTY_CHAR();
[G_I_S$CHIND]: GET_IDIR_CHAR();
[OTHERWISE]: RET (G_I_S$ILC)
TES);
!Now we have a character or an error code
!If we see an error right away, then pass it up to the caller
IF .N EQL 0 AND (.C LSS 0) THEN RET (.C);
!If we hit error or EOF before EOL, return what we have now,
! and save the error or EOF for the next call
IF .C LSS 0 THEN C = CR;
!Now we have a char.. get the info bits on it
CHAR_CODE = .CHAR_MAP [.C];
IF (.CHAR_CODE AND CHEOL) NEQ 0 THEN RET (.N);
IF (.CHAR_CODE AND CHILL) NEQ 0 THEN
BEGIN !This is the pretty error noter
TYPE ('%RMCIIC Ignoring illegal character (');
IF (.CHAR_CODE AND CHPRINT) NEQ 0 THEN OUTC (C)
ELSE BEGIN
LOCAL ERRTXT:BLOCK[CH$ALLOCATION(4)];
LOCAL ERRPTR;
ERRPTR = CH$PTR (ERRTXT);
TYPE (%ASCIZ 'octal code: ');
WRNUMA (.C, 8, ERRPTR);
CH$WCHAR_A (0,ERRPTR);
TSTR (ERRTXT)
END;
TYPE (')');
TYPE (CRLF);
END
ELSE
BEGIN
!Check for buffer overflow before converting
! to uppercase and writing in buffer.
IF .N GEQ .MAXLENGTH THEN RET (G_I_S$CCO);
IF (.CHAR_CODE AND CHLC) NEQ 0 THEN C = .C - %O'40';
CH$WCHAR_A (.C, .PTRADR);
N = .N + 1
END
END
END;
!Still NOT FTNETSPL...
GLOBAL ROUTINE INIT_INDIRECT (PTR)=
!++
!
! FUNCTIONAL DESCRIPTION:
! This routine sets up the file block for the indirect command file.
! The file spec is parsed into the fileblock, then opened for reading.
! A check for ascii data mode in the extended lookup block is made.
! The routine will not allow reading from a binary (of any flavor) file.
!
! FORMAL PARAMETERS:
!
! PTR - the address of a character sequence pointer
! to an ASCIZ string describing the file spec.
!
! IMPLICIT INPUTS:
!
! none
!
! IMPLICIT OUTPUTS:
!
! The FB$INDIRECT file block is filled with the file-spec information
! and OPENed for reading
! G$INEO - (the end-of-file flag) is cleared
! G$ININ - (the 'initialized' flag) is set.
!
! ROUTINE VALUE:
!
! The values returned by the routine are described in RMCOPY.REQ
!
! SIDE EFFECTS:
!
!
!
!--
BEGIN
LOCAL T;
FBINI (FB$INDIRECT); !Start with a clean fileblock
IF (T = FPARSE (FB$INDIRECT, PTR)) NEQ WIN THEN RETURN INI_IN$BFS;
IF (T = OPEN_R (FB$INDIRECT)) NEQ WIN THEN
RETURN SELECTONE ((.T)^-3) OF SET
[FILFNF]: INI_IN$FNF; !File not found
[FILPRT]: INI_IN$PRF; !Protection failure
[OTHERWISE]: INI_IN$FNF;
TES;
IF NOT( (.FB$INDIRECT [FILE$WMODE] EQL _IOASC) OR !Insist on ascii data file
(.FB$INDIRECT [FILE$WMODE] EQL _IOASL)) THEN RETURN INI_IN$IDM;
G$ININ = 1; !Mark that the file is inited
G$INEO = 0; !Clear the EOF flag, too
INI_IN$OK !All is fine
END;
!Still if NOT FTNETSPL...
GLOBAL ROUTINE GETPATH (PPNADR, MAX1, SFDADR, MAX2) = !
!++
! FUNCTIONAL DESCRIPTION:
! This routine does a path UUO to determine where the user currently
! wants files read from and written to.
! It returns the ASCII conversion of the octal p,pn using the
! pointer whose address is passed in PPNADR. It returns
! The description of the sfd portion of the path (excludes
! p,pn) using the pointer whose address is passed in SFDADR.
! The p,pn are converted to octal, and the sfd names
! (if any) are converted as SIXBIT. If there are no SFDs
! in the current user's path, NO data is written using SFDADR.
! The SFD names are separated, but not terminated by, commas.
! The strings are not returned as ASCIZ.
!
! FORMAL PARAMETERS:
!
! PPNADR - the address of a 7 bit ASCII pointer which will
! be bumped and used to write the p,pn
! MAX1 - the maximum number of characters which may be written
! using the pointer at PPNADR
! SFDADR - the address of a 7 bit ASCII pointer which will
! be bumped and used to write the sfd string.
! MAX2 - the maximum number of characters which may be written
! using the pointer at SFDADR
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! The p, pn and sfd string are written into the caller's space
!
! ROUTINE VALUE:
!
! GETPATH$OK - all is well
!
! GETPATH$FAIL - Not enough room at one of the pointers
!
! SIDE EFFECTS:
!
! The pointers are advanced so the caller may determine the size
! of the strings written
!
!--
BEGIN
LOCAL
FILBLK : FILE_BLOCK; !
IF (.MAX1 LSS 6+1+6) OR !No room for P,PN
(.MAX2 LSS ((6+1)*SFDMAX)-1) !No room for SFDs
THEN RETURN GETPATH$FAIL;
FBINI (FILBLK); !Start clean
FILBLK [FILE$PATH_FUN] = _PTFRD;!Path function: read
PATH (FILBLK);
WRNUMA (.FILBLK [FILE$PROJECT], 8, .PPNADR);
CH$WCHAR_A (%C',', .PPNADR);
WRNUMA (.FILBLK [FILE$PROGRAMMER], 8, .PPNADR);
INCR S FROM FILBLK [FILE$SFD] TO (FILBLK [FILE$SFD]) + SFDMAX DO
BEGIN
IF ..S EQL 0 THEN EXITLOOP;
IF .S NEQ FILBLK [FILE$SFD] THEN
CH$WCHAR_A(%C',',.SFDADR); !Write comma, unless first time
WRSIXA (..S, .SFDADR); !Write out the SFD's
END;
RELEASE (FILBLK);
RETURN GETPATH$OK;
END;
!Still if NOT FTNETSPL...
GLOBAL ROUTINE UDATE (ARGTYPE, TIME, DAY, MONTH, YEAR)= !
!++
! FUNCTIONAL DESCRIPTION:
! This routine converts 5 numbers representing the 24 hr time,
! Julian day, month, year into the Universal date time format.
! Several options are available. The date/time may be specified
! as and absolute date, or as a realtive date.
!
! FORMAL PARAMETERS:
!
! argtype - a code representing the kind of date desired.
! The legal codes are:
! UDATE$ABS - absoulte date/time
! UDATE$PLUS - +minutes, and +days from NOW
! UDATE$HHMM - The date/time next time clock hits HHMM
! UDATE$DAY - a day of the week (1=Sun, 7=Sat)
! UDATE$TOMRW - tomorrow
! UDATE$TODAY - after some time today
! time - The time of day in minutes (since midnight)
! day - The day in the month (from 1 to 31)
! month - The month of the year (from 1 for Jan to 12 for Dec)
! year - Either 1, 2, or 4 digits of the year
! eg: 7, 77, 1977
!
! IMPLICIT INPUTS:
!
! G$NOW, the current universal date/time
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! The Universal date-time format. (Left half is days since
! Nov 17, 1858, Right half is fractional days).
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
LOCAL
LEAP_FLAG;
LOCAL N, K;
LOCAL LOCYEAR; !The local year of the system
REGISTER AC; !For the GETTAB for LOCYEAR
MACRO MONTHS =
X(31, JAN) !JAN
X(28, FEB) !FEB
X(31, MAR) !MAR
X(30, APR) !APR
X(31, MAY) !MAY
X(30, JUN) !JUN
X(31, JUL) !JUL
X(31, AUG) !AUG
X(30, SEP) !SEP
X(31, OCT) !OCT
X(30, NOV) !NOV
X(31, DEC) !DEC
% ;
COMPILETIME SUM = 0;
COMPILETIME INDEX = 0;
MACRO X (DUM, NAME) = %ASSIGN (INDEX, INDEX + 1)
COMPILETIME NAME = INDEX; %;
%ASSIGN (INDEX, 0)
MONTHS !Generate the month literals
UNDECLARE %QUOTE X;
MACRO X (N,DUM) = SUM %ASSIGN (SUM, SUM + N)
%ASSIGN (INDEX, INDEX + 1)
%IF INDEX NEQ 12 %THEN , %FI %;
%ASSIGN (SUM, 0)
%ASSIGN (INDEX, 0)
BIND MONTAB = UPLIT (MONTHS); !Generate a running sum table
MAP MONTAB : VECTOR [12];
UNDECLARE %QUOTE X;
MACRO X (N, DUM) = N
%ASSIGN (INDEX, INDEX + 1)
%IF INDEX NEQ 12 %THEN , %FI %;
%ASSIGN (INDEX, 0)
BIND MONSIZ = UPLIT (MONTHS); !Generate an individual size table
MAP MONSIZ : VECTOR [12];
!TRANGE tells if the # minutes is illegal
MACRO TRANGE (TIME) = ((TIME LSS 0) OR (TIME GTR 23*60+59)) %;
!UTIME converts # minutes to days in LH, fractional days in RH
MACRO UTIME (TIME) = TIME * %O'1000000' / (60 *24) %;
LITERAL DAY_ONE = 18,
MONTH_ONE = NOV,
YEAR_ONE = 1858;
LITERAL BASE_YEAR = 1501;
LITERAL Z = YEAR_ONE - BASE_YEAR;
AC<LH> = %O'56'; !Item 56, %CNYER
AC<RH> = %O'11'; !Table 11, .GTCNF
CALLI (AC, %O'41'); !Get 1978 in AC
LOCYEAR = .AC; !Store in local
!First, make the year a real Julian year
IF .YEAR EQL 0 THEN YEAR = .LOCYEAR
ELSE
IF .YEAR LSS 10 THEN
YEAR = (.LOCYEAR / 10) * 10 + .YEAR
ELSE
IF .YEAR LSS 100 THEN
YEAR = (.LOCYEAR /100) * 100 + .YEAR;
SELECTONE .ARGTYPE OF SET
[UDATE$ABS]:
BEGIN
IF (.YEAR LEQ YEAR_ONE) OR (.YEAR GEQ 2021) THEN RETURN -1;
IF (.MONTH LSS JAN) OR (.MONTH GTR DEC) THEN RETURN -1;
IF TRANGE (.TIME) THEN RETURN -1;
LEAP_FLAG = ((.YEAR MOD 4) EQL 0)
AND (((.YEAR MOD 100) NEQ 0)
OR ((.YEAR MOD 400) EQL 0));
IF (.DAY GTR .MONSIZ [.MONTH - 1]) AND
((.MONTH NEQ FEB)
OR (.DAY NEQ 29)
OR NOT .LEAP_FLAG)
THEN RETURN -1;
K = (.YEAR - BASE_YEAR);
! Z = (1858 - BASE_YEAR); !Z has been redefined as a literal
N = (.K - Z) * 365
+ (.K / 4) - (Z / 4)
- (.K / 100) + (Z / 100)
+ (.K / 400) - (Z / 400)
+ .MONTAB [.MONTH - 1] - .MONTAB [MONTH_ONE - 1]
+ .DAY - 1 - (DAY_ONE - 1)
+ (IF .LEAP_FLAG AND (.MONTH GTR FEB)
THEN 1
ELSE 0);
N<LH> = .N<RH>;
N<RH> = UTIME (.TIME);
END;
[UDATE$PLUS]:
BEGIN
N<RH> = 0; !Start clean on the day frac.
N<LH> =.DAY;
N = .N + UTIME (.TIME); !add on converted minutes
!(may overflow to LH)
N = .N + .G$NOW; !Add to current time
END;
[UDATE$HHMM]:
BEGIN
IF TRANGE (.TIME) THEN RETURN -1;
N<LH> = .G$NOW<LH>; !Take current day
IF (N<RH> = UTIME (.TIME)) LSS .G$NOW<RH>
THEN N<LH> = .N<LH> + 1;!Advance to next day,
! if time has gone by today
END;
[UDATE$DAY]:
BEGIN
IF TRANGE (.TIME) THEN RETURN -1;
IF (.DAY LSS UDATE$SUN) OR (.DAY GTR UDATE$SAT)
THEN RETURN -1;
DAY = (.DAY + 3) MOD 7; !Convert from Sun = 1 to Wed = 0
N = .G$NOW<LH> MOD 7; !What day is it now?
N<LH> = .G$NOW<LH> + ((.DAY - .N + 7) MOD 7);
!.DAY-.N gives #days from
!today to desired day.
!+7)mod 7 tells how many till
!next occurrence of desired day.
N<RH> = UTIME (.TIME); !Start at the desired hour of the day
END;
[UDATE$TOMRW]:
BEGIN
IF TRANGE (.TIME) THEN RETURN -1; !Check the time of day.
N<RH> = UTIME (.TIME); !Start at the desired hour,
N<LH> = .G$NOW<LH> + 1 ! of tomorrow.
END;
[UDATE$TODAY]:
BEGIN
IF TRANGE (.TIME) THEN RETURN -1; !Check the time of day.
N<RH> = UTIME (.TIME); !Start at the desired hour,
N<LH> = .G$NOW<LH> ! of today.
END;
[OTHERWISE]:
RETURN -1
TES;
IF .N LSS .G$NOW THEN N = .G$NOW; !Never allow times in the past
.N
END;
%FI !End of NOT FTNETSPL
GLOBAL ROUTINE MSGERROR (POINTER, SEV) :NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
! This routine simply dumps the string from POINTER to the
! controlling terminal. The routine may also add ? or % or [ ]
! to the string depending on the severity code so that
! controlling processes (eg BATCON) can recognize the error.
! The routine also allows new-line control for non-error messages
!
! FORMAL PARAMETERS:
!
! POINTER - a character sequence pointer to an ASCIZ string.
! The string must be ASCIZ!
! SEV - a code (see RMCOPY.REQ) describing the urgency of the error
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! The message goes to the terminal
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
BUILTIN MACHOP;
LOCAL CHAR
; !
IF (.SEV AND PRECRLFBIT) NEQ 0 THEN
TYPE (CRLF);
SELECTONE .SEV<0,5> OF SET
[S$WARN,S$WARN_HOLD]: OUTC (UPLIT (%C'%') );
[S$COMMENT]: OUTC (UPLIT (%C'[') );
[S$SEVERE,S$SEVERE_HOLD]: %IF FTNETSPL
%THEN TYPE('%%')
%ELSE OUTC (UPLIT (%C'?') )
!NETSPL reserves "?" for things
!that make it crash
%FI;
TES;
!Type the prefix (NETxxx or RMCxxx) if we were given one
!in the first 3 character positions of SEV
IF .SEV<LH> NEQ 0 THEN
BEGIN
TYPE(PPREFIX); !Include appropriate prefix
TSTR(SEV); !And secondary prefix
TYPE(' ');
END;
! We would like to use OUTSTR here, but we cannot,
! since the POINTER is not guaranteed to be on a word boundary.
WHILE (CHAR = CH$RCHAR_A (POINTER)) NEQ 0 DO OUTC (CHAR);
IF .SEV<0,5> EQL S$COMMENT THEN OUTC (PLIT (%C']') );
IF (.SEV AND POSTCRLFBIT) NEQ 0 THEN
TYPE (CRLF);
END;
GLOBAL ROUTINE GETVRS (PTR, MAXCHAR) = !Read and convert version from
!++
! FUNCTIONAL DESCRIPTION:
!
! Routine reads loc 137 and converts it to an ASCII string
!
! FORMAL PARAMETERS:
!
! PTR - A char seq ptr
! MAXCHAR - Max # of chars we can write in there
!
! IMPLICIT INPUTS:
!
! The contents of .JBVER (loc 137)
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! >0 ==> the number of chars written
! <0 ==> not enough space in MAXCHAR
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
LITERAL
JBVER=%O'137',
JBCST=%O'136';
LOCAL C;
C=CVTVRS(.JBVER,.PTR,.MAXCHAR); !Do regular version # first
IF (.C LSS 0) !Didn't fit?
OR (.JBCST EQL 0) !No customer version #?
THEN RETURN .C;
PTR=CH$PLUS(.PTR,.C); !Skip over this stuff
CH$WCHAR_A(%C'/',PTR); !Separate with a slash
.C+CVTVRS(.JBCST,.PTR,(.MAXCHAR-.C))+1 !Do customer version
END; !GETVRS
GLOBAL ROUTINE CVTVRS (V, PTR, MAXCHAR) = !convert LCG version #
!++
! FUNCTIONAL DESCRIPTION:
!
! Routine converts LCG version # to an ASCII string
!
! FORMAL PARAMETERS:
!
! V - an LCG version #
! PTR - A char seq ptr
! MAXCHAR - Max # of chars we can write in there
!
! IMPLICIT INPUTS:
!
! None
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! >0 ==> the number of chars written
! <0 ==> not enough space in MAXCHAR
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
!Define the fields of .JBVER
FIELD VERS = SET
MAJV = [0,24,9,0],
MINV = [0,18,6,0],
NEDIT = [0,0,18,0],
WHO = [0,33,3,0]
TES;
MAP V:BLOCK[1] FIELD (VERS);
LOCAL
X1, X2,
TEMPPTR; !An advancing pointer
TEMPPTR = .PTR;
IF .MAXCHAR LSS 3+ 2+1+ 6+1+1+ 1 THEN RETURN -1;
!MAJ+MIN+(+EDIT+)+-+MODIF
IF (.V[MAJV] NEQ 0) OR (.V[MINV] EQL 0)
THEN WRNUMA (.V[MAJV], 8, TEMPPTR); !Spit out the major version
IF (X1 = .V[MINV]) NEQ 0 THEN
BEGIN !If there is a minor,
! convert and spit it too
X1 = .X1 - 1;
X2 = .X1 / 26;
X1 = .X1 MOD 26;
IF .X2 NEQ 0 THEN CH$WCHAR_A ((%C'A'-1) + .X2, TEMPPTR);
CH$WCHAR_A (%C'A' + .X1, TEMPPTR);
END;
IF (X1 = .V[NEDIT]) NEQ 0 THEN
BEGIN !If there is an edit,
! convert and output it too
CH$WCHAR_A (%C'(', TEMPPTR);
WRNUMA (.X1, 8, TEMPPTR);
CH$WCHAR_A (%C')', TEMPPTR);
END;
IF (X1 = .V[WHO]) NEQ 0 THEN
BEGIN !If there is a modifier,
! output it too
CH$WCHAR_A (%C'-', TEMPPTR);
WRNUMA (.X1, 8, TEMPPTR);
END;
CH$DIFF (.TEMPPTR, .PTR) !Return the number of chars done
!PTR was NOT moved,
!TEMPPTR was moved
END; !CVTVRS
END ELUDOM