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; !OUR NODE NUMBER, AS AN INTEGER A = _NDRNN; !FUNCTION CODE:RETURN NODE NAME A = 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 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 = DSKCHR_LEN; !Length of the block AC = 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 = %O'56'; !Item 56, %CNYER AC = %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 = .N; N = UTIME (.TIME); END; [UDATE$PLUS]: BEGIN N = 0; !Start clean on the day frac. N =.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 = .G$NOW; !Take current day IF (N = UTIME (.TIME)) LSS .G$NOW THEN N = .N + 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 MOD 7; !What day is it now? N = .G$NOW + ((.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 = 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 = UTIME (.TIME); !Start at the desired hour, N = .G$NOW + 1 ! of tomorrow. END; [UDATE$TODAY]: BEGIN IF TRANGE (.TIME) THEN RETURN -1; !Check the time of day. N = UTIME (.TIME); !Start at the desired hour, N = .G$NOW ! 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 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