Trailing-Edge
-
PDP-10 Archives
-
TOPS-20_V6.1_DECnetSrc_7-23-85
-
mcb/vnp36/rtxt.bli
There are 2 other files named rtxt.bli in the archive. Click here to see a list.
!<DECNET20-V3P0.TKB-VNP.VNPV3>RTXT.BLI.61 13-Feb-81 14:05:05, Edit by SROBINSON
!<DECNET20-V3P0.TKB-VNP.VNPV3>RTXT.BLI.45, 1-Jul-80 08:14:07, Edit by SROBINSON
!<DECNET20-V3P0.TKB-VNP.VNPV3>RTXT.BLI.11, 15-Apr-80 07:05:34, Edit by SROBINSON
!<DECNET20-V3P0.TKB-VNP.VNPV3>RTXT.BLI.2, 14-Apr-80 07:52:48, Edit by SROBINSON
MODULE RTXT ( !READ TEXT FILES
IDENT = 'X3.1'
) =
BEGIN !ident 3.1 12oct81
!
!
!
! COPYRIGHT (c) 1980, 1981, 1982
! DIGITAL EQUIPMENT CORPORATION
! Maynard, Massachusetts
!
! 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.
!
!++
! FACILITY: MCB System Configuration Facility, VNP-20
!
! ABSTRACT:
!
!
! THIS MODULE READS THE TEXT FILES, CETAB.MAC AND THE .DAT FILES,
! STORING THE INFORMATION FOR THE REST OF VNP20 TO PROCESS.
!
!
! ENVIRONMENT: TOPS-20 USER MODE
!
! AUTHOR: J. SAUTER, CREATION DATE: 05-JUN-78
! Scott G. Robinson, 14-APR-80
!
! MODIFIED BY:
!
! , : VERSION
! 01 -
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
RCET : NOVALUE, !READ CETAB.MAC
CLASS, !CLASSIFY A CHARACTER
SCAN : NOVALUE, !SCAN NEXT ATOM
R_SYS : NOVALUE, !READ SYS$DF LINE
R_MEM : NOVALUE, !READ MEM$DF LINE
R_PRC : NOVALUE, !READ PRC$DF LINE
R_SLT : NOVALUE, !READ SLT$DF LINE
R_LLC : NOVALUE, !READ LLC$DF LINE
R_DEV : NOVALUE, !READ DEV$DF LINE
R_CTL : NOVALUE, !READ CTL$DF LINE
R_UNT : NOVALUE, !READ UNT$DF LINE
R_TRB : NOVALUE, !Read TRB$DF Line
R_TSK : NOVALUE, !READ TSK$DF LINE
R_DRV : NOVALUE, !Read DRV$DF Line
R_END : NOVALUE; !READ END$DF LINE
!
! INCLUDE FILES:
!
LIBRARY 'VNPLIB';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
LITERAL
DEBUG = 0;
!
! OFFSETS INTO 'RESULT', THE ARRAY RETURNED BY SCAN.
!
LITERAL
RESULT_TYPE = 0, !TYPE FIELD
RESULT_VALUE = 1; !VALUE FIELD
!
! VALUES OF THE TYPE FIELD
!
LITERAL
RT_NAME = 1, !VALUE IS TEXT OF NAME
RT_NUMBER = 2, !VALUE IS NUMBER (UNSIGNED)
RT_SPECIAL = 3; !VALUE IS SPECIAL CHAR (-1 IS EOL)
!
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
OPEN, !OPEN A FILE
CLOSE : NOVALUE, !CLOSE A FILE
INPUT, !READ FROM A FILE
OUTPUT : NOVALUE, !OUTPUT TO A FILE
BLD_CHAIN, !ADD AN ITEM TO A CHAIN
GETBLK, !GET A BLOCK OF STORAGE
ERROR : NOVALUE, !SIGNAL PROGRAMMING ERROR
ERRMSG : NOVALUE, !ERROR MESSAGE
PCRLF : NOVALUE, !PRINT CRLF
OUTNUM : NOVALUE, !PRINT NUMBER
OUTSTR : NOVALUE; !PRINT A STRING
GLOBAL ROUTINE RCET (FILE_CHAN, FILE_PTR, VALUES) : NOVALUE = !READ CETAB.MAC
!++
! FUNCTIONAL DESCRIPTION:
!
! READ CETAB.MAC FOR VNP20, AND STORE ITS VALUES.
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - CHANNEL NUMBER ON WHICH TO READ CETAB.MAC
! FILE_PTR - FILE BLOCK WITH CETAB.MAC FILLED IN.
! VALUES - BLOCK IN WHICH TO STORE RESULTS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! FILLS THE 'VALUES' BLOCK WITH STUFF READ FROM CETAB.MAC
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS CETAB.MAC
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'RCET');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
LOOK_DONE,
NAME,
RESULT : VECTOR [20],
SAVE_CHAR,
SUBR,
VAL_POINTER;
IF (OPEN (.FILE_CHAN, FILE_PTR [FILE_NAME], 1, 0, UPLIT (%ASCIZ'TXT')) NEQ 0)
THEN
BEGIN !SUCCESSFUL INPUT OPEN
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTSTR (1, UPLIT (%ASCIZ'----- OPEN CETAB.MAC'));
END; !DEBUG
!
! INITIALIZE THE CHAIN TO THE LLCS
!
VALUES [LLC_CHAIN] = 0;
!
! LOOK FOR SYS$DF MACRO
!
SAVE_CHAR = -1;
LOOK_DONE = 0;
WHILE (.LOOK_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, SAVE_CHAR, RESULT);
IF ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] EQL %C';'))
THEN
!SKIP A COMMENT
DO
SCAN (.FILE_CHAN, .FILE_PTR, SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
IF ((.RESULT [RESULT_TYPE] EQL RT_NAME) AND !
(CH$EQL (7, CH$PTR (RESULT [RESULT_VALUE]), 7, CH$PTR (UPLIT (%ASCIZ'SYS$DF')))))
THEN
LOOK_DONE = 1
ELSE !NOT SYS$DF, SKIP TO NEXT LINE
DO
SCAN (.FILE_CHAN, .FILE_PTR, SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
IF ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] EQL -2))
THEN
LOOK_DONE = -1;
END;
IF (.LOOK_DONE LEQ 0)
THEN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
R_SYS (.FILE_CHAN, .FILE_PTR, SAVE_CHAR, .VALUES);
!
! EACH LINE OF CETAB.MAC, UP TO THE END$DF LINE, IS TO BE
! PROCESSED.
!
LOOK_DONE = 0;
WHILE (.LOOK_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, SAVE_CHAR, RESULT);
IF ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] EQL %C';'))
THEN
!SKIP A COMMENT LINE
DO
SCAN (.FILE_CHAN, .FILE_PTR, SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0))
ELSE
BEGIN
!
! THE RESULT VECTOR CONTAINS THE MACRO NAME
!
IF (.RESULT [RESULT_TYPE] NEQ RT_NAME)
THEN
BEGIN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
LOOK_DONE = -1;
END
ELSE
BEGIN
!
! COMPUTE A NUMBER BASED ON THE NAME, SO WE CAN DISPATCH ON IT.
!
NAME = CH$RCHAR (CH$PTR (RESULT [RESULT_VALUE], 0)) + !
(256*CH$RCHAR (CH$PTR (RESULT [RESULT_VALUE], 1))) + !
(65536*CH$RCHAR (CH$PTR (RESULT [RESULT_VALUE], 2)));
IF (CH$NEQ (4, CH$PTR (RESULT [RESULT_VALUE], 3), !
4, CH$PTR (UPLIT (%ASCIZ'$DF'))))
THEN
BEGIN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
LOOK_DONE = -1;
END
ELSE
BEGIN
!
! DISPATCH ON THE NAME
!
SUBR = (SELECTONE .NAME OF
SET
[%C'M' + (256*%C'E') + (65536*%C'M')] : R_MEM;
[%C'C' + (256*%C'T') + (65536*%C'L')] : R_CTL;
[%C'U' + (256*%C'N') + (65536*%C'T')] : R_UNT;
[%C'P' + (256*%C'R') + (65536*%C'C')] : R_PRC;
[%C'S' + (256*%C'L') + (65536*%C'T')] : R_SLT;
[%C'L' + (256*%C'L') + (65536*%C'C')] : R_LLC;
[%C'D' + (256*%C'E') + (65536*%C'V')] : R_DEV;
[%C'T' + (256*%C'R') + (65536*%C'B')] : R_TRB;
[%C'T' + (256*%C'S') + (65536*%C'K')] : R_TSK;
[%C'D' + (256*%C'R') + (65536*%C'V')] : R_DRV;
[%C'E' + (256*%C'N') + (65536*%C'D')] : R_END;
[OTHERWISE] : 0;
TES);
IF (.SUBR EQL 0)
THEN
BEGIN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
LOOK_DONE = -1;
END
ELSE
BEGIN
(.SUBR) (.FILE_CHAN, .FILE_PTR, SAVE_CHAR, .VALUES);
IF (.SUBR EQL R_END) THEN LOOK_DONE = 1;
END;
END;
END;
END;
END;
END;
CLOSE (.FILE_CHAN);
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTSTR (1, UPLIT (%ASCIZ'----- CLOSE CETAB.MAC'));
END; !DEBUG
END;
END; !OF RCET
ROUTINE CLASS (CHAR) = !CLASSIFY A CHARACTER
!++
! FUNCTIONAL DESCRIPTION:
!
! CLASSIFY A CHARACTER AS TO ALPHABETIC, NUMERIC, SPECIAL OR CONTROL/DEL.
!
! FORMAL PARAMETERS:
!
! CHAR - THE CHARACTER TO CLASSIFY
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! 1 = ALPHABETIC, 2 = NUMERIC, 3 = SPECIAL, 4 = CONTROL OR DEL
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'CLASS');
SELECTONE .CHAR OF
SET
[%C'A' TO %C'Z', %C'a' TO %C'z', %C'$', %C'.'] :
1; !ALPHABETIC (INCLUDING $ AND .)
[%C'0' TO %C'9'] :
2; !NUMERIC
[%C'!', !
%C'"', !
%C'#', !
%C'%', !
%C'&', !
%O'47', !SINGLE QUOTE
%C'(', !
%C')', !
%C'*', !
%C'+', !
%C',', !
%C'-', !
%C'/', !
%C':', !
%C';', !
%C'<', !
%C'=', !
%C'>', !
%C'?', !
%C'@', !
%C'[', !
%C'\', !
%C']', !
%C'^', !
%C'_', !
%C'`', !
%C'{', !
%C'|', !
%C'}', !
%C'~'] :
3; !SPECIAL (BUT NEITHER $ NOR .)
[OTHERWISE] :
4; !CONTROL AND DEL
TES
END;
ROUTINE SCAN (FILE_CHAN, FILE_PTR, SAVE_CHAR, RESULT) : NOVALUE = !SCAN NEXT ATOM
!++
! FUNCTIONAL DESCRIPTION:
!
! SCAN NEXT ATOM (NAME, NUMBER, SPECIAL CHAR) FROM THE FILE
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - CHANNEL NUMBER ON WHICH TO READ
! FILE_PTR - FILE BLOCK WITH FILE NAME FILLED IN
! SAVE_CHAR - ADDRESS OF CHARACTER SAVED FROM LAST CALL.
! SET TO -1 ON FIRST CALL.
! RESULT - VECTOR INTO WHICH TO STORE RESULTS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! FILLS THE 'RESULT' ARRAY WITH THE NEXT ATOM SCANNED
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS THE SPECIFIED FILE
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'SCAN-TEXT-FILE');
MAP
FILE_PTR : REF FILE_BLOCK,
RESULT : REF VECTOR;
LOCAL
CHAR,
SCAN_DONE,
DECIMAL_NUM,
OCTAL_NUM,
SCAN_POINTER;
!
! CLASSIFY ATOM BASED ON FIRST CHARACTER. LEADING BLANKS,
! TABS, CARRIAGE RETURNS AND FORM FEEDS ARE SKIPPED.
!
CHAR = ..SAVE_CHAR;
IF (.CHAR EQL -2)
THEN
ERROR (UPLIT (%ASCIZ'EOF IGNORED IN SCAN'))
ELSE
BEGIN
IF (.CHAR LSS 0) THEN CHAR = INPUT (.FILE_CHAN);
WHILE ((.CHAR EQL %O'40') OR (.CHAR EQL %O'11') OR (.CHAR EQL %O'15') OR (.CHAR EQL %O'14')) DO
CHAR = INPUT (.FILE_CHAN);
IF (.CHAR LSS 0)
THEN
BEGIN !END OF FILE
RESULT [RESULT_TYPE] = 3;
RESULT [RESULT_VALUE] = -2;
.SAVE_CHAR = -2;
END
ELSE
BEGIN !NOT END OF FILE
CASE CLASS (.CHAR) FROM 1 TO 4 OF
SET
[1] : !ALPHABETIC (INCLUDES $ AND .)
BEGIN
RESULT [RESULT_TYPE] = 1;
SCAN_POINTER = CH$PTR (RESULT [RESULT_VALUE], -1);
DO
BEGIN
CH$A_WCHAR (.CHAR, SCAN_POINTER);
CHAR = INPUT (.FILE_CHAN);
END
UNTIL (CLASS (.CHAR) GTR 2);
CH$A_WCHAR (0, SCAN_POINTER); !TERMINATE WITH NULL
.SAVE_CHAR = .CHAR;
END;
[2] : !NUMERIC
BEGIN
RESULT [RESULT_TYPE] = 2;
OCTAL_NUM = 0;
DECIMAL_NUM = 0;
DO
BEGIN
OCTAL_NUM = (.OCTAL_NUM*8) + (.CHAR - %C'0');
DECIMAL_NUM = (.DECIMAL_NUM*10) + (.CHAR - %C'0');
CHAR = INPUT (.FILE_CHAN);
END
UNTIL (CLASS (.CHAR) NEQ 2);
IF (.CHAR EQL %C'.')
THEN
BEGIN !NUMBER SPECIFIED AS DECIMAL
RESULT [RESULT_VALUE] = .DECIMAL_NUM;
.SAVE_CHAR = -1;
END
ELSE
BEGIN
RESULT [RESULT_VALUE] = .OCTAL_NUM;
.SAVE_CHAR = .CHAR;
END;
END;
[3] : !SPECIAL CHARACTER
BEGIN
RESULT [RESULT_TYPE] = 3;
RESULT [RESULT_VALUE] = .CHAR;
.SAVE_CHAR = -1;
END;
[4] : !CONTROL CHARACTER
BEGIN
RESULT [RESULT_TYPE] = 3;
RESULT [RESULT_VALUE] = -1;
.SAVE_CHAR = -1;
END;
TES;
END;
IF (DEBUG GEQ 1)
THEN
BEGIN !DEBUG
PCRLF (1);
OUTSTR (1, UPLIT (%ASCIZ' SCAN: TYPE ='));
OUTNUM (1, .RESULT [RESULT_TYPE], 8, 0);
OUTSTR (1, UPLIT (%ASCIZ', VALUE ='));
CASE .RESULT [RESULT_TYPE] FROM 1 TO 3 OF
SET
[1] : !NAME
OUTSTR (1, RESULT [RESULT_VALUE]);
[2] : !NUMBER, PRINT IN DECIMAL
OUTNUM (1, .RESULT [RESULT_VALUE], 10, 0);
[3] : !SPECIAL CHARACTER
BEGIN
IF (.RESULT [RESULT_VALUE] LSS 0)
THEN
OUTNUM (1, .RESULT [RESULT_VALUE], 10, 0)
ELSE
OUTPUT (1, .RESULT [RESULT_VALUE]);
END;
TES;
END; !DEBUG
END;
END; !OF SCAN
ROUTINE R_SYS (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !READ SYS$DF LINE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ AND PROCESS THE SYS$DF LINE OF CETAB.MAC
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - CHANNEL NUMBER ON WHICH TO READ
! FILE_PTR - FILE BLOCK WITH FILE NAME FILLED IN
! SAVE_CHAR - ADDRESS OF CHARACTER SAVED FROM LAST CALL TO SCAN
! VALUES - BLOCK INTO WHICH TO STORE RESULTS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS THE REMAINDER OF THE LINE FROM CETAB.MAC
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-SYS$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
RESULT : VECTOR [20],
VAL_POINTER;
!
! SCAN EACH ARGUMENT OF SYS$DF, PUTTING IT INTO THE 'VALUES' BLOCK.
!
VAL_POINTER = 1;
WHILE (.VAL_POINTER LEQ 2) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
CASE .VAL_POINTER FROM 1 TO 2 OF
SET
[1] : !Node Name
BEGIN
IF (.RESULT [RESULT_TYPE] NEQ RT_NAME)
THEN
ERRMSG (0, 24, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
CH$MOVE (LEN_NODE_NAME, CH$PTR (RESULT [RESULT_VALUE]), CH$PTR (VALUES [NODNAM]));
END;
[2] : !Node Address
BEGIN
IF (.RESULT [RESULT_TYPE] NEQ RT_NUMBER)
THEN
ERRMSG (0, 24, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
VALUES [NODNM] = .RESULT [RESULT_VALUE];
END;
TES;
VAL_POINTER = .VAL_POINTER + 1;
IF (.VAL_POINTER LEQ 2)
THEN
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF ((.RESULT [RESULT_TYPE] NEQ RT_SPECIAL) OR (.RESULT [RESULT_VALUE] NEQ %C','))
THEN
ERRMSG (0,
24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
END;
END;
!
! FINISHED WITH SYS$DF, SKIP TO END OF LINE
!
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_SYS
ROUTINE R_MEM (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !READ BUF$DF LINE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ AND PROCESS THE MEM$DF LINE OF CETAB.MAC
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - CHANNEL NUMBER ON WHICH TO READ
! FILE_PTR - FILE BLOCK WITH FILE NAME FILLED IN
! SAVE_CHAR - ADDRESS OF CHARACTER SAVED FROM LAST CALL TO SCAN
! VALUES - BLOCK INTO WHICH TO STORE RESULTS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS THE REMAINDER OF THE LINE FROM CETAB.MAC
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-MEM$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
RESULT : VECTOR [20],
VAL_POINTER;
!
! SCAN EACH ARGUMENT OF MEM$DF, PUTTING IT INTO THE 'VALUES' BLOCK.
!
VAL_POINTER = 1;
WHILE (.VAL_POINTER LEQ 2) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF (.RESULT [RESULT_TYPE] NEQ RT_NUMBER)
THEN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
BEGIN
CASE .VAL_POINTER FROM 1 TO 2 OF
SET
[1] :
VALUES [DSR] = .RESULT [RESULT_VALUE];
[2] :
VALUES [COR] = .RESULT [RESULT_VALUE];
TES;
VAL_POINTER = .VAL_POINTER + 1;
IF (.VAL_POINTER LEQ 2)
THEN
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF ((.RESULT [RESULT_TYPE] NEQ RT_SPECIAL) OR (.RESULT [RESULT_VALUE] NEQ %C','))
THEN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
END;
END;
END;
!
! FINISHED WITH MEM$DF, SKIP TO END OF LINE
!
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_MEM
ROUTINE R_PRC (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !Read PRC$DF Line
!++
! FUNCTIONAL DESCRIPTION:
!
! Read and process the PRC$DF line of CETAB.MAC
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - Channel Number On Which To Read
! FILE_PTR - File Block With File Name Filled In
! SAVE_CHAR - Address Of Character Saved From Last Call To Scan
! VALUES - Block Into Which To Store Results
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! Chain of MCB Process blocks added to VALUES[MCB_CHAIN]
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! Reads the remainder of the line from CETAB.MAC
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-PRC$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
RESULT : VECTOR [20],
VAL_POINTER,
CHAR,
SCAN_DONE,
STR_PTR,
MCB_PTR : REF VNPMCB_BLOCK;
!
! Get a block to put the process information
!
IF ((MCB_PTR = GETBLK (VNPMCB_TYP, VNPMCB_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
IF ((VALUES [MCB_CHAIN] = BLD_CHAIN (.VALUES, .VALUES [MCB_CHAIN], .MCB_PTR)) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
!
! Scan the PRC$DF line building a chain of MCB process names linked to
! VALUES[MCB_CHAIN].
!
VAL_POINTER = 1;
SCAN_DONE = 0;
WHILE ((.VAL_POINTER LEQ 2) AND (.SCAN_DONE EQL 0)) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF (.RESULT [RESULT_TYPE] NEQ RT_NAME)
THEN
ERRMSG (0, 24, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
BEGIN
CASE .VAL_POINTER FROM 1 TO 2 OF
SET
[1] : !The process name
CH$MOVE (LEN_MCB_NAME, CH$PTR (RESULT [RESULT_VALUE]),
CH$PTR (MCB_PTR [PROCESS_NAME]));
[2] : !The device driver name
CH$MOVE (LEN_MCB_DRV, CH$PTR (RESULT [RESULT_VALUE]),
CH$PTR (MCB_PTR [DEVICE_NAME]));
TES;
END;
VAL_POINTER = .VAL_POINTER + 1;
IF (.VAL_POINTER LEQ 2)
THEN
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0))
THEN
SCAN_DONE = 1
ELSE
IF ((.RESULT [RESULT_TYPE] NEQ RT_SPECIAL) OR (.RESULT [RESULT_VALUE] NEQ %C','))
THEN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
END;
END;
END;
!
! Read to End of PRC$DF Line
!
IF (.SCAN_DONE EQL 0)
THEN
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_PRC
ROUTINE R_SLT (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !READ SLT$DF LINE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ AND PROCESS THE SLT$DF LINE OF CETAB.MAC
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - CHANNEL NUMBER ON WHICH TO READ
! FILE_PTR - FILE BLOCK WITH FILE NAME FILLED IN
! SAVE_CHAR - ADDRESS OF CHARACTER SAVED FROM LAST CALL TO SCAN
! VALUES - BLOCK INTO WHICH TO STORE RESULTS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS THE REMAINDER OF THE LINE FROM CETAB.MAC
! AND GETS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-SLT$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
SLT_PTR : REF SLT_BLOCK,
RESULT : VECTOR [20],
VAL_POINTER,
SCAN_DONE,
SEARCH_DONE;
!
! ALLOCATE AN SLT BLOCK AND LINK IT IN WITH THE OTHERS, IF ANY.
!
IF ((SLT_PTR = GETBLK (SLT_TYP, SLT_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
IF ((VALUES [SLT_CHAIN] = BLD_CHAIN (.VALUES, .VALUES [SLT_CHAIN], .SLT_PTR)) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
VALUES [SLTNUM] = .VALUES [SLTNUM] + 1;
VAL_POINTER = 1;
SCAN_DONE = 0;
WHILE (.SCAN_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0))
THEN
SCAN_DONE = -1
ELSE
BEGIN
IF ((.RESULT [RESULT_TYPE] NEQ RT_SPECIAL) OR (.RESULT [RESULT_VALUE] NEQ %C','))
THEN
BEGIN
CASE .VAL_POINTER FROM 1 TO 8 OF
SET
[1] : !LLC NAME
BEGIN
IF (.RESULT [RESULT_TYPE] NEQ RT_NAME)
THEN
ERRMSG (0, 24, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
CH$MOVE (4, CH$PTR (RESULT [RESULT_VALUE]), CH$PTR (SLT_PTR [SLT_LLC]));
END;
[2] : !DLC NAME
BEGIN
IF (.RESULT [RESULT_TYPE] NEQ RT_NAME)
THEN
ERRMSG (0, 24, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
CH$MOVE (4, CH$PTR (RESULT [RESULT_VALUE]), CH$PTR (SLT_PTR [SLT_DLC]));
END;
[3] : !DEV NAME
BEGIN
IF (.RESULT [RESULT_TYPE] NEQ RT_NAME)
THEN
ERRMSG (0, 24, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
CH$MOVE (4, CH$PTR (RESULT [RESULT_VALUE]), CH$PTR (SLT_PTR [SLT_DEV]));
END;
[4] : !CONTROLLER NUMBER
BEGIN
IF (.RESULT [RESULT_TYPE] NEQ RT_NUMBER)
THEN
ERRMSG (0, 24, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
SLT_PTR [SLT_CTL] = .RESULT [RESULT_VALUE];
END;
[5] : !UNIT NUMBER
BEGIN
IF (.RESULT [RESULT_TYPE] NEQ RT_NUMBER)
THEN
ERRMSG (0, 24, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
SLT_PTR [SLT_UNT] = .RESULT [RESULT_VALUE];
END;
[6] : !TRIBUTARY NUMBER
BEGIN
IF (.RESULT [RESULT_TYPE] NEQ RT_NUMBER)
THEN
IF (.RESULT [RESULT_TYPE] NEQ RT_SPECIAL)
THEN
ERRMSG (0, 24,
ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
SLT_PTR [SLT_TRB] = -1
ELSE
SLT_PTR [SLT_TRB] = .RESULT [RESULT_VALUE];
END;
[7] :
; !FLAGS, IGNORE.
[8] :
; !"ENABLE", IGNORE.
[OUTRANGE] :
BEGIN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
SCAN_DONE = 1;
END;
TES;
!
! SCAN FOR THE NEXT COMMA
!
SEARCH_DONE = 0;
WHILE (.SEARCH_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF (.RESULT [RESULT_TYPE] EQL RT_SPECIAL)
THEN
IF (.RESULT [RESULT_VALUE] LSS 0)
THEN
SEARCH_DONE = -1
ELSE
IF (.RESULT [RESULT_VALUE] EQL %C',') THEN SEARCH_DONE = 1;
END;
IF (.SEARCH_DONE LSS 0) THEN SCAN_DONE = .SEARCH_DONE;
END;
END;
VAL_POINTER = .VAL_POINTER + 1;
END;
END;
!
! SAVE POINTER TO THE SLT BLOCK FOR THE STA$DF SCANNER
!
VALUES [CURRENT_SLT] = .SLT_PTR;
!
! FINISHED WITH SLT$DF, SKIP TO END OF LINE
!
IF (.SCAN_DONE GTR 0)
THEN
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_SLT
ROUTINE R_LLC (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !READ LLC$DF LINE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ AND PROCESS THE LLC$DF LINE OF CETAB.MAC
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - CHANNEL NUMBER ON WHICH TO READ
! FILE_PTR - FILE BLOCK WITH FILE NAME FILLED IN
! SAVE_CHAR - ADDRESS OF CHARACTER SAVED FROM LAST CALL TO SCAN
! VALUES - BLOCK INTO WHICH TO STORE RESULTS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS THE REMAINDER OF THE LINE FROM CETAB.MAC
! AND GETS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-LLC$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
LLC_PTR : REF LLC_BLOCK,
RESULT : VECTOR [20],
VAL_POINTER,
SCAN_DONE,
SEARCH_DONE;
!
! ALLOCATE AN LLC BLOCK AND LINK IT IN WITH THE OTHERS, IF ANY.
!
IF ((LLC_PTR = GETBLK (LLC_TYP, LLC_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
IF ((VALUES [LLC_CHAIN] = BLD_CHAIN (.VALUES, .VALUES [LLC_CHAIN], .LLC_PTR)) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF (.RESULT [RESULT_TYPE] NEQ RT_NAME)
THEN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
CH$MOVE (4, CH$PTR (RESULT [RESULT_VALUE]), CH$PTR (LLC_PTR [LLC_NAME]));
END;
!
! FINISHED WITH LLC$DF, SKIP TO END OF LINE
!
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_LLC
ROUTINE R_DEV (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !READ DEV$DF LINE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ AND PROCESS THE DEV$DF LINE OF CETAB.MAC
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - CHANNEL NUMBER ON WHICH TO READ
! FILE_PTR - FILE BLOCK WITH FILE NAME FILLED IN
! SAVE_CHAR - ADDRESS OF CHARACTER SAVED FROM LAST CALL TO SCAN
! VALUES - BLOCK INTO WHICH TO STORE RESULTS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS THE REMAINDER OF THE LINE FROM CETAB.MAC
! AND GETS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-DEV$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
DEV_PTR : REF DEV_BLOCK,
RESULT : VECTOR [20],
VAL_POINTER,
SCAN_DONE,
SEARCH_DONE;
!
! ALLOCATE A DEV BLOCK AND LINK IT IN WITH THE OTHERS, IF ANY.
!
IF ((DEV_PTR = GETBLK (DEV_TYP, DEV_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
IF ((VALUES [DEV_CHAIN] = BLD_CHAIN (.VALUES, .VALUES [DEV_CHAIN], .DEV_PTR)) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF (.RESULT [RESULT_TYPE] NEQ RT_NAME)
THEN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
CH$MOVE (4, CH$PTR (RESULT [RESULT_VALUE]), CH$PTR (DEV_PTR [DEV_NAME]));
END;
!
! SAVE POINTER TO DEV FOR UNT$DF AND CNT$DF SCANNERS
!
VALUES [CURRENT_DEV] = .DEV_PTR;
!
! FINISHED WITH DEV$DF, SKIP TO END OF LINE
!
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_DEV
ROUTINE R_CTL (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !READ CTL$DF LINE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ AND PROCESS THE CTL$DF LINE OF CETAB.MAC
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - CHANNEL NUMBER ON WHICH TO READ
! FILE_PTR - FILE BLOCK WITH FILE NAME FILLED IN
! SAVE_CHAR - ADDRESS OF CHARACTER SAVED FROM LAST CALL TO SCAN
! VALUES - BLOCK INTO WHICH TO STORE RESULTS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS THE REMAINDER OF THE LINE FROM CETAB.MAC
! AND GETS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-CTL$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
CTL_PTR : REF CTL_BLOCK,
DEV_PTR : REF DEV_BLOCK,
RESULT : VECTOR [20],
VAL_POINTER,
SCAN_DONE,
SEARCH_DONE;
!
! FETCH A POINTER TO THE LAST DEV BLOCK
!
DEV_PTR = .VALUES [CURRENT_DEV];
DEV_PTR [DEV_NUM_OF_CTLS] = .DEV_PTR [DEV_NUM_OF_CTLS] + 1;
!
! ALLOCATE A CTL BLOCK AND LINK IT IN WITH THE OTHERS, IF ANY.
!
IF ((CTL_PTR = GETBLK (CTL_TYP, CTL_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
IF ((DEV_PTR [DEV_CTL] = BLD_CHAIN (.DEV_PTR, .DEV_PTR [DEV_CTL], .CTL_PTR)) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
VAL_POINTER = 1;
SCAN_DONE = 0;
WHILE (.SCAN_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0))
THEN
SCAN_DONE = -1
ELSE
BEGIN
IF ((.RESULT [RESULT_TYPE] NEQ RT_SPECIAL) OR (.RESULT [RESULT_VALUE] NEQ %C','))
THEN
BEGIN
IF (.RESULT [RESULT_TYPE] EQL RT_NUMBER)
THEN
BEGIN
CASE .VAL_POINTER FROM 1 TO 9 OF
SET
[1] : !CONTROLLER NUMBER
CTL_PTR [CTL_CONT] = .RESULT [RESULT_VALUE];
[2] : !Parameter word 0
CTL_PTR [CTL_PAR_0] = .RESULT [RESULT_VALUE];
[3] : !Parameter word 1
CTL_PTR [CTL_PAR_1] = .RESULT [RESULT_VALUE];
[4] : !Parameter word 2
CTL_PTR [CTL_PAR_2] = .RESULT [RESULT_VALUE];
[5] : !Parameter word 3
CTL_PTR [CTL_PAR_3] = .RESULT [RESULT_VALUE];
[6] : !Parameter word 4
CTL_PTR [CTL_PAR_4] = .RESULT [RESULT_VALUE];
[7] : !Parameter word 5
CTL_PTR [CTL_PAR_5] = .RESULT [RESULT_VALUE];
[8] : !Parameter word 6
CTL_PTR [CTL_PAR_6] = .RESULT [RESULT_VALUE];
[9] : !Parameter word 7
CTL_PTR [CTL_PAR_7] = .RESULT [RESULT_VALUE];
[OUTRANGE] :
BEGIN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
SCAN_DONE = 1;
END;
TES;
END
ELSE
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
!
! SCAN FOR THE NEXT COMMA
!
SEARCH_DONE = 0;
WHILE (.SEARCH_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF (.RESULT [RESULT_TYPE] EQL RT_SPECIAL)
THEN
IF (.RESULT [RESULT_VALUE] LSS 0)
THEN
SEARCH_DONE = -1
ELSE
IF (.RESULT [RESULT_VALUE] EQL %C',') THEN SEARCH_DONE = 1;
END;
IF (.SEARCH_DONE LSS 0) THEN SCAN_DONE = .SEARCH_DONE;
END;
END;
VAL_POINTER = .VAL_POINTER + 1;
END;
END;
!
! STORE POINTER TO DEV BLOCK, FOR REDUNDENCY
!
CTL_PTR [CTL_DEV] = .DEV_PTR;
!
! SAVE POINTER TO CTL FOR UNT$DF SCANNER
!
VALUES [CURRENT_CTL] = .CTL_PTR;
!
! FINISHED WITH CTL$DF, SKIP TO END OF LINE
!
IF (.SCAN_DONE GTR 0)
THEN
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_CTL
ROUTINE R_UNT (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !READ UNT$DF LINE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ AND PROCESS THE UNT$DF LINE OF CETAB.MAC
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - CHANNEL NUMBER ON WHICH TO READ
! FILE_PTR - FILE BLOCK WITH FILE NAME FILLED IN
! SAVE_CHAR - ADDRESS OF CHARACTER SAVED FROM LAST CALL TO SCAN
! VALUES - BLOCK INTO WHICH TO STORE RESULTS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS THE REMAINDER OF THE LINE FROM CETAB.MAC
! AND GETS STORAGE FROM THE FREE LIST
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-UNT$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
UNT_PTR : REF UNT_BLOCK,
CTL_PTR : REF CTL_BLOCK,
DEV_PTR : REF DEV_BLOCK,
RESULT : VECTOR [20],
VAL_POINTER,
SCAN_DONE,
SEARCH_DONE;
!
! FETCH POINTERS TO THE LAST DEV AND CTL BLOCKS
!
DEV_PTR = .VALUES [CURRENT_DEV];
CTL_PTR = .VALUES [CURRENT_CTL];
!
! ALLOCATE A UNT BLOCK AND LINK IT IN WITH THE OTHERS, IF ANY.
!
IF ((UNT_PTR = GETBLK (UNT_TYP, UNT_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
IF ((CTL_PTR [CTL_UNT] = BLD_CHAIN (.CTL_PTR, .CTL_PTR [CTL_UNT], .UNT_PTR)) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
CTL_PTR [CTL_NUM_OF_UNTS] = .CTL_PTR [CTL_NUM_OF_UNTS] + 1;
VAL_POINTER = 1;
SCAN_DONE = 0;
WHILE (.SCAN_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0))
THEN
SCAN_DONE = -1
ELSE
BEGIN
IF ((.RESULT [RESULT_TYPE] NEQ RT_SPECIAL) OR (.RESULT [RESULT_VALUE] NEQ %C','))
THEN
BEGIN
IF (.RESULT [RESULT_TYPE] EQL RT_NUMBER)
THEN
BEGIN
CASE .VAL_POINTER FROM 1 TO 9 OF
SET
[1] : !UNIT NUMBER
UNT_PTR [UNT_UNIT] = .RESULT [RESULT_VALUE];
[2] : !Parameter word 0
UNT_PTR [UNT_PAR_0] = .RESULT [RESULT_VALUE];
[3] : !Parameter word 1
UNT_PTR [UNT_PAR_1] = .RESULT [RESULT_VALUE];
[4] : !Parameter word 2
UNT_PTR [UNT_PAR_2] = .RESULT [RESULT_VALUE];
[5] : !Parameter word 3
UNT_PTR [UNT_PAR_3] = .RESULT [RESULT_VALUE];
[6] : !Parameter word 4
UNT_PTR [UNT_PAR_4] = .RESULT [RESULT_VALUE];
[7] : !Parameter word 5
UNT_PTR [UNT_PAR_5] = .RESULT [RESULT_VALUE];
[8] : !Parameter word 6
UNT_PTR [UNT_PAR_6] = .RESULT [RESULT_VALUE];
[9] : !Parameter word 7
UNT_PTR [UNT_PAR_7] = .RESULT [RESULT_VALUE];
[OUTRANGE] :
BEGIN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
SCAN_DONE = 1;
END;
TES;
END
ELSE
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
!
! SCAN FOR THE NEXT COMMA
!
SEARCH_DONE = 0;
WHILE (.SEARCH_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF (.RESULT [RESULT_TYPE] EQL RT_SPECIAL)
THEN
IF (.RESULT [RESULT_VALUE] LSS 0)
THEN
SEARCH_DONE = -1
ELSE
IF (.RESULT [RESULT_VALUE] EQL %C',') THEN SEARCH_DONE = 1;
END;
IF (.SEARCH_DONE LSS 0) THEN SCAN_DONE = .SEARCH_DONE;
END;
END;
VAL_POINTER = .VAL_POINTER + 1;
END;
END;
!
! STORE POINTERS TO DEV AND CTL BLOCKS, FOR REDUNDENCY
!
UNT_PTR [UNT_DEV] = .DEV_PTR;
UNT_PTR [UNT_CTL] = .CTL_PTR;
!
! Store current unit block address for TRB$DF processing
!
VALUES [CURRENT_UNT] = .UNT_PTR;
!
! FINISHED WITH UNT$DF, SKIP TO END OF LINE
!
IF (.SCAN_DONE GTR 0)
THEN
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_UNT
ROUTINE R_TRB (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !Read TRB$DF Line
!++
! FUNCTIONAL DESCRIPTION:
!
! Read and process the TRB$DF line
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - Channel Number On Which To Read
! FILE_PTR - File Block With File Name Filled In
! SAVE_CHAR - Address Of Character Saved From Last Call To Scan
! VALUES - Block Into Which To Store Results
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! Reads the remainder of the line from CETAB.MAC
! and gets storage from the free list
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-TRB$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
TRB_PTR : REF TRB_BLOCK,
UNT_PTR : REF UNT_BLOCK,
RESULT : VECTOR [20],
VAL_POINTER,
SCAN_DONE,
SEARCH_DONE;
!
! Get the Pointer to the current UNT Block, which represents where
! this tributary applies.
!
UNT_PTR = .VALUES [CURRENT_UNT];
!
! Allocate a TRB Block and link it to others on this UNT
!
IF ((TRB_PTR = GETBLK (TRB_TYP, TRB_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
IF ((UNT_PTR [UNT_TRB] = BLD_CHAIN (.UNT_PTR, .UNT_PTR [UNT_TRB], .TRB_PTR)) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
VAL_POINTER = 1;
SCAN_DONE = 0;
UNT_PTR [UNT_NUM_OF_TRBS] = .UNT_PTR [UNT_NUM_OF_TRBS] + 1;
WHILE (.SCAN_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0))
THEN
SCAN_DONE = -1
ELSE
BEGIN
IF ((.RESULT [RESULT_TYPE] NEQ RT_SPECIAL) OR (.RESULT [RESULT_VALUE] NEQ %C','))
THEN
BEGIN
IF (.RESULT [RESULT_TYPE] EQL RT_NUMBER)
THEN
BEGIN
CASE .VAL_POINTER FROM 1 TO 9 OF
SET
[1] : !Logical Station Number
TRB_PTR [TRB_LADDR] = .RESULT [RESULT_VALUE];
[2] : !Tributary Parameter 0
TRB_PTR [TRB_PAR_0] = .RESULT [RESULT_VALUE];
[3] : !Tributary Parameter 1
TRB_PTR [TRB_PAR_1] = .RESULT [RESULT_VALUE];
[4] : !Tributary Parameter 2
TRB_PTR [TRB_PAR_2] = .RESULT [RESULT_VALUE];
[5] : !Tributary Parameter 3
TRB_PTR [TRB_PAR_3] = .RESULT [RESULT_VALUE];
[6] : !Tributary Parameter 4
TRB_PTR [TRB_PAR_4] = .RESULT [RESULT_VALUE];
[7] : !Tributary Parameter 5
TRB_PTR [TRB_PAR_5] = .RESULT [RESULT_VALUE];
[8] : !Tributary Parameter 6
TRB_PTR [TRB_PAR_6] = .RESULT [RESULT_VALUE];
[9] : !Tributary Parameter 7
TRB_PTR [TRB_PAR_7] = .RESULT [RESULT_VALUE];
[OUTRANGE] :
BEGIN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
SCAN_DONE = 1;
END;
TES;
END
ELSE
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0, 0, 0);
!
! SCAN FOR THE NEXT COMMA
!
SEARCH_DONE = 0;
WHILE (.SEARCH_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF (.RESULT [RESULT_TYPE] EQL RT_SPECIAL)
THEN
IF (.RESULT [RESULT_VALUE] LSS 0)
THEN
SEARCH_DONE = -1
ELSE
IF (.RESULT [RESULT_VALUE] EQL %C',') THEN SEARCH_DONE = 1;
END;
IF (.SEARCH_DONE LSS 0) THEN SCAN_DONE = .SEARCH_DONE;
END;
END;
VAL_POINTER = .VAL_POINTER + 1;
END;
END;
!
! Finished with TRB$DF, Skip to end of line
!
IF (.SCAN_DONE GTR 0)
THEN
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_TRB
ROUTINE R_TSK (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !Read TSK$DF Line
!++
! FUNCTIONAL DESCRIPTION:
!
! Read and process the TSK$DF line of CETAB.MAC
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - Channel Number on which to read
! FILE_PTR - File Block with File Name filled in
! SAVE_CHAR - Address of Character Saved from Last Call To SCAN
! VALUES - Block into which to store results
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! Reads the remainder of the line from CETAB.MAC
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-TSK$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
SCAN_DONE,
SEARCH_DONE,
RESULT : VECTOR [20],
VAL_POINTER,
CHAR,
STR_PTR,
TSKB_PTR : REF VNPTSK_BLOCK;
!
! Allocate a VNPTSK Block and link it in with others
!
IF ((TSKB_PTR = GETBLK (VNPTSK_TYP, VNPTSK_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
IF ((VALUES [TSK_CHAIN] = BLD_CHAIN (.VALUES, .VALUES [TSK_CHAIN], .TSKB_PTR)) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
!
! Store type of VNPTSK block this is:
!
TSKB_PTR [TSK_TYPE] = TSK_TASK_TYPE;
!
! Scan each argument of TSK$DF and store in VNPTSK Block
!
VAL_POINTER = 1;
SCAN_DONE = 0;
WHILE (.SCAN_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF ((.RESULT [RESULT_TYPE] NEQ RT_SPECIAL) OR (.RESULT [RESULT_VALUE] NEQ %C','))
THEN
BEGIN
CASE .VAL_POINTER FROM 1 TO 2 OF
SET
[1] : !Main Task Name
BEGIN
IF (.RESULT [RESULT_TYPE] NEQ RT_NAME)
THEN
ERRMSG (0, 24, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
CH$MOVE (LEN_TSK_NAME, CH$PTR (RESULT [RESULT_VALUE]),
CH$PTR (TSKB_PTR [TSK_NAME]));
END;
[2] : !Time to run task
BEGIN
IF (.RESULT [RESULT_TYPE] NEQ RT_NUMBER)
THEN
ERRMSG (0, 24, ROUTINE_NAME,
FILE_PTR [FILE_NAME], 0, 0, 0)
ELSE
TSKB_PTR [TSK_TIME] = .RESULT [RESULT_VALUE];
END;
TES;
!
! Scan for the next comma
!
SEARCH_DONE = 0;
WHILE (.SEARCH_DONE EQL 0) DO
BEGIN
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF (.RESULT [RESULT_TYPE] EQL RT_SPECIAL)
THEN
IF (.RESULT [RESULT_VALUE] LSS 0)
THEN
SEARCH_DONE = -1
ELSE
IF (.RESULT [RESULT_VALUE] EQL %C',') THEN SEARCH_DONE = 1;
END;
IF (.SEARCH_DONE LSS 0) THEN SCAN_DONE = .SEARCH_DONE;
VAL_POINTER = .VAL_POINTER + 1;
END;
END;
END;
!
! Finished with TSK$DF, Skip to end of line
!
IF (.SCAN_DONE GTR 0)
THEN
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_TSK
ROUTINE R_DRV (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !Read DRV$DF Line
!++
! FUNCTIONAL DESCRIPTION:
!
! Read DRV$DF line and process definition
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - Channel Number on Which to Read
! FILE_PTR - File Block With File Name Filled In
! SAVE_CHAR - Address of Character Saved From Last Call to SCAN
! VALUES - Block Into Which to Store Results
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! Reads the remainder of the line from CETAB.MAC
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-DRV$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
SEARCH_DONE,
RESULT : VECTOR [20],
VAL_POINTER,
CHAR,
TSKB_PTR : REF VNPTSK_BLOCK;
!
! Allocate an VNPTSK Block and link it in with others
!
IF ((TSKB_PTR = GETBLK (VNPTSK_TYP, VNPTSK_LEN)) EQL 0)
THEN
ERRMSG (0, 1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
IF ((VALUES [TSK_CHAIN] = BLD_CHAIN (.VALUES, .VALUES [TSK_CHAIN], .TSKB_PTR)) EQL 0)
THEN
ERRMSG (0,
1, ROUTINE_NAME, 0, 0, 0, 0)
ELSE
BEGIN
!
! Store type of VNPTSK block this is:
!
TSKB_PTR [TSK_TYPE] = TSK_DRIVER_TYPE;
!
! DRV$DF has only a single argument, the two character driver name
!
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT);
IF (.RESULT [RESULT_TYPE] NEQ RT_NAME)
THEN
ERRMSG (0, 24, ROUTINE_NAME, FILE_PTR [FILE_NAME], 0,
0, 0)
ELSE
CH$MOVE (LEN_DRV_NAME, CH$PTR (RESULT [RESULT_VALUE]), CH$PTR (TSKB_PTR [TSK_NAME]));
END;
!
! Finished with DRV$DF, Skip to end of line
!
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_DRV
ROUTINE R_END (FILE_CHAN, FILE_PTR, SAVE_CHAR, VALUES) : NOVALUE = !READ END$DF LINE
!++
! FUNCTIONAL DESCRIPTION:
!
! READ AND PROCESS THE END$DF LINE OF CETAB.MAC
!
! FORMAL PARAMETERS:
!
! FILE_CHAN - CHANNEL NUMBER ON WHICH TO READ
! FILE_PTR - FILE BLOCK WITH FILE NAME FILLED IN
! SAVE_CHAR - ADDRESS OF CHARACTER SAVED FROM LAST CALL TO SCAN
! VALUES - BLOCK INTO WHICH TO STORE RESULTS
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! READS THE REMAINDER OF THE LINE FROM CETAB.MAC
!
!--
BEGIN
BIND
ROUTINE_NAME = UPLIT (%ASCIZ'READ-END$DF');
MAP
FILE_PTR : REF FILE_BLOCK,
VALUES : REF VNPVAL_BLOCK;
LOCAL
RESULT : VECTOR [20],
VAL_POINTER;
!
! THERE ARE NO PARAMETERS ON THIS LINE
!
!
! FINISHED WITH END$DF, SKIP TO END OF LINE
!
DO
SCAN (.FILE_CHAN, .FILE_PTR, .SAVE_CHAR, RESULT)
UNTIL ((.RESULT [RESULT_TYPE] EQL RT_SPECIAL) AND (.RESULT [RESULT_VALUE] LSS 0));
END; !OF R_END
END
ELUDOM
! Local Modes:
! Comment Column:36
! Comment Start:!
! Mode:Fundamental
! Auto Save Mode:2