Trailing-Edge
-
PDP-10 Archives
-
BB-X117B-SB_1986
-
10,7/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) DIGITAL EQUIPMENT CORPORATION 1980,1981,1982,1986. ALL RIGHTS RESERVED.
!
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT 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