Trailing-Edge
-
PDP-10 Archives
-
BB-P363B-SM_1985
-
mcb/mcbda/mdasys.b36
There are no other files named mdasys.b36 in the archive.
MODULE MDASYS ( !System dependant I/O
IDENT = '003030',
LANGUAGE (BLISS36)
) =
BEGIN
!
!
!
! 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: MDA - MCB Dump Analyzer
!
! ABSTRACT:
!
!
! This module contains routines to do system dependant I/O.
!
!
! ENVIRONMENT: TOPS20
!
! AUTHOR: ALAN D. PECKHAM, CREATION DATE: 5-SEP-78
!
! MODIFIED BY:
!
! Alan D. Peckham, 2-Jul-80 : VERSION 3
! 01 - Update for MCB V3.0
! 02 - Remove interpret switch.
! 03 - Fix defaulting of list file not to interfere with dump file.
!--
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
ALLOCATE_FILBLK, !Allocate a file block.
ASSOCIATE, !Associate filename with control block.
CLOSE : NOVALUE, !Close a file.
CMD, !Get a user command.
FILDT, !Return the file creation date in ASCII.
FILNM, !Convert a file name to ASCII.
FILPOS, !Get the current file position.
GETFIL, !Get data from a file opened for input.
GETTIM : NOVALUE, !Get the current time.
INIT_PARSE : NOVALUE, !Initialize for command parse.
OPEN, !Open a file.
POSFIL : NOVALUE, !Set the current position within the file.
PUTFIL : NOVALUE, !Put a string to a file opened for output.
RELEASE_FILBLK : NOVALUE; !Release a file block.
!
! INCLUDE FILES
!
LIBRARY 'MDACOM'; !MDA common definitions.
REQUIRE 'BLI:MONSYM.R36'; !Define the TOPS20 monitor symbols.
BUILTIN
JSYS; !Define the JSYS machine specific function.
!
! MACROS:
!
MACRO
REGISTERS [ACN] =
REGISTER %NAME('AC',ACN) = ACN %,
DUMP_FLAG =
MY_FLAGS[0] %,
CMD_FUNCTION (FUNCTION, LINK, CMD_DATA, DEFAULT, HELP) =
VECTOR[4]
INITIAL( FLD(FUNCTION,CM_FNC)
%IF NOT %NULL(LINK)
%THEN +FLD(LINK,CM_LST)
%FI
%IF NOT %NULL(HELP)
%THEN +CM_HPP
%FI
%IF NOT %NULL(DEFAULT)
%THEN +CM_DPP
%FI,
%IF NOT %NULL(CMD_DATA)
%THEN CMD_DATA
%ELSE 0
%FI,
%IF %NULL(HELP)
%THEN 0
%ELSE CH$ASCIZ(HELP)
%FI,
%IF %NULL(DEFAULT)
%THEN 0
%ELSE DEFAULT
%FI
) %,
CMD_DATA_STRING (STRING) =
CH$ASCIZ(STRING) %,
CMD_DATA_KEYS (TABLE) =
UPLIT( KEY_COUNT(%REMOVE(TABLE)), KEY_STR_SET(%REMOVE(TABLE)) ) %,
KEY_COUNT (ARGS) =
(%LENGTH)^18+%LENGTH %,
KEY_STR_SET [PAIR] =
KEY( %REMOVE(PAIR) ) %,
KEY (TEXT) [VALUE] =
UPLIT(%ASCIZ %STRING(TEXT))^18+VALUE %,
CMD_DATA_MASK (CHARS) =
UPLIT(MASK_WORD(0, 31, %REMOVE(CHARS)) + 0,
MASK_WORD(32, 63, %REMOVE(CHARS)) + 0,
MASK_WORD(64, 95, %REMOVE(CHARS)) + 0,
MASK_WORD(96, 127, %REMOVE(CHARS)) + 0) %,
MASK_WORD (LOW_CHAR, HIGH_CHAR) [CHAR] =
%IF ((CHAR GEQ LOW_CHAR) AND (CHAR LEQ HIGH_CHAR))
%THEN 1^(35+LOW_CHAR-CHAR)
%FI %,
CMD_COMMA (LINK) =
CMD_FUNCTION($CMCMA,LINK) %,
CMD_CONFIRM (LINK) =
CMD_FUNCTION($CMCFM,LINK) %,
CMD_DIRECTORY (LINK, HELP) =
CMD_FUNCTION($CMDIR,LINK,,,HELP) %,
CMD_FILE (LINK, DEFAULT, HELP) =
CMD_FUNCTION($CMFIL,LINK,,DEFAULT,HELP) %,
CMD_FIELD (LINK) =
CMD_FUNCTION($CMFLD,LINK) %,
CMD_INITIALIZE =
CMD_FUNCTION($CMINI) %,
CMD_INPUT_FILE (LINK, STRING, DEFAULT, HELP) =
CMD_FUNCTION($CMIFI,LINK,STRING,DEFAULT,HELP) %,
CMD_KEYWORDS (LINK, TABLE, DEFAULT, HELP) =
CMD_FUNCTION($CMKEY,LINK,CMD_DATA_KEYS(TABLE),DEFAULT,HELP) %,
CMD_NOISE (LINK, STRING, DEFAULT, HELP) =
CMD_FUNCTION($CMNOI,LINK,CMD_DATA_STRING(STRING),DEFAULT,HELP) %,
CMD_NUMBER (LINK, RADIX, DEFAULT, HELP) =
CMD_FUNCTION($CMNUM,LINK,RADIX,DEFAULT,HELP) %,
CMD_QUOTED_STR (LINK, DEFAULT, HELP) =
CMD_FUNCTION($CMQST, LINK,, DEFAULT, HELP) %,
CMD_STRING (LINK, STRING, DEFAULT, HELP) =
CMD_FUNCTION($CMTOK,LINK,CMD_DATA_STRING(STRING),DEFAULT,HELP) %,
CMD_SWITCHES (LINK, TABLE, DEFAULT, HELP) =
CMD_FUNCTION($CMSWI,LINK,CMD_DATA_KEYS(TABLE),DEFAULT,HELP) %,
CMD_TOKEN (LINK, STRING, DEFAULT, HELP) =
CMD_FUNCTION($CMTOK,LINK,CMD_DATA_STRING(STRING),DEFAULT,HELP) %;
!
! EQUATED SYMBOLS:
!
MACRO
F_JFN =
0, 0, 18, 0 %,
F_DIRECTORY =
1, 0, 36, 0 %;
LITERAL
F_LENGTH = 2;
LITERAL
CMD_ATOM_MAX = 60, !Maximum atom length.
CMD_INPUT_MAX = 200, !Maximum command length.
JFN_NAME_MAX = 60, !Maximum file name length.
SWT_CMD = %O'770000',
SWT_MIN = 0,
SWT_FLAG_OFF = 0,
SWT_FLAG_ON = 1,
SWT_FLAGS_OFF = 2,
SWT_FLAGS_ON = 3,
SWT_KEYS = 4,
SWT_LIST = 5,
SWT_STBS = 6,
SWT_TASK = 7,
SWT_PROCESS = 8,
SWT_DUMP = 9,
SWT_MAX = 9,
SWT_VAL = %O'007777';
!
! OWN STORAGE:
!
OWN
CMD_ATOM : CH$SEQUENCE (CMD_ATOM_MAX),
CMD_INPUT : CH$SEQUENCE (CMD_INPUT_MAX + %CHARCOUNT (PROMPT, '>')) INITIAL (%STRING (PROMPT, '>')),
CMD_JFN : VECTOR [14] INITIAL ( REP 14 OF (0)),
CMD_STATE_BLK : VECTOR [10] INITIAL (CM_RAI, $PRIIN^18 + $PRIOU,
CH$PTR(CMD_INPUT,0),CH$PTR(CMD_INPUT,%CHARCOUNT (PROMPT, '>')),
CH$PTR(CMD_INPUT, %CHARCOUNT (PROMPT, '>')),CMD_INPUT_MAX - %CHARCOUNT (PROMPT, '>'),0,
CH$PTR(CMD_ATOM,0),CMD_ATOM_MAX,
CMD_JFN),
DEF_DMP_FILE : CH$SEQUENCE (JFN_NAME_MAX) INITIAL ( REP CH$ALLOCATION (JFN_NAME_MAX) OF (0)),
DEF_LST_NAME : CH$SEQUENCE (JFN_NAME_MAX) INITIAL ( REP CH$ALLOCATION (JFN_NAME_MAX) OF (0)),
FILBLK : BLOCKVECTOR [MDA_MAX_FILES, F_LENGTH] INITIAL (REP MDA_MAX_FILES*F_LENGTH OF (0)),
FUNCTION, !Current function
MY_FLAGS : BITVECTOR [16],
! STB_SAVE,
RSCAN_FLAG,
SUB_FUNCTION;
FORWARD
FN1 : VECTOR [4],
FN2 : VECTOR [4],
FN3 : VECTOR [4],
FN4 : VECTOR [4],
FN5 : VECTOR [4],
! FN6 : VECTOR [4],
FN7 : VECTOR [4],
FN8 : VECTOR [4],
FN9 : VECTOR [4],
FN10 : VECTOR [4],
FN11 : VECTOR [4],
FN12 : VECTOR [4],
! FN13 : VECTOR [4],
FN14 : VECTOR [4],
FN15 : VECTOR [4],
FN16 : VECTOR [4];
BIND
FLAG_OFF = FLD (SWT_FLAG_OFF, SWT_CMD),
FLAG_ON = FLD (SWT_FLAG_ON, SWT_CMD),
FLAGS_OFF = FLD (SWT_FLAGS_OFF, SWT_CMD),
FLAGS_ON = FLD (SWT_FLAGS_ON, SWT_CMD),
FLAG_SET = UPLIT (
1^M_RSX_ATL + 1^M_RSX_CTXT + 1^M_RSX_HDR + 1^M_RSX_PARS + 1^M_RSX_POOL,
0,
1^M_RSX_ATL + 1^M_RSX_CTXT + 1^M_RSX_HDR + 1^M_RSX_PARS + 1^M_RSX_POOL,
1^M_RSX_CTXT + 1^M_RSX_CLQ + 1^M_RSX_DEV + 1^M_RSX_HDR + 1^M_RSX_PARS +
1^M_RSX_PCBS + 1^M_RSX_POOL + 1^M_RSX_STD + 1^M_RSX_DUMP,
0,
1^M_RSX_CTXT + 1^M_RSX_CLQ + 1^M_RSX_DEV + 1^M_RSX_HDR + 1^M_RSX_PARS +
1^M_RSX_PCBS + 1^M_RSX_POOL + 1^M_RSX_STD + 1^M_RSX_DUMP) : VECTOR [6],
M_RSX_STA = 0,
M_CEX_STA = 1,
M_STA = 2,
M_RSX_ALL = 3,
M_CEX_ALL = 4,
M_ALL = 5,
KEY_SET = UPLIT (FN8, FN9) : VECTOR [2],
K_RSX = 0 + FLD (SWT_KEYS, SWT_CMD),
K_CEX = 1 + FLD (SWT_KEYS, SWT_CMD),
S_LIST = FLD (SWT_LIST, SWT_CMD),
S_STBS = FLD (SWT_STBS, SWT_CMD),
S_TASK = FLD (SWT_TASK, SWT_CMD),
S_PROCESS = FLD (SWT_PROCESS, SWT_CMD),
S_DUMP = FLD (SWT_DUMP, SWT_CMD);
OWN
FN1 : CMD_INITIALIZE,
FN2 : CMD_FILE (FN3, CH$PTR (DEF_DMP_FILE)),
FN3 : CMD_SWITCHES (FN4,
(('ALL', M_ALL + FLAGS_ON), !
('ANALYZE', M_ANALYZE + FLAG_ON), !
('CEX:', K_CEX), !
('DUMP:', S_DUMP), !
('EXIT', M_EXIT + FLAG_ON), !
('HELP', M_HELP + FLAG_ON), !
('LISTING:', S_LIST), !
! ('PROCESS:', S_PROCESS), !
('RSX:', K_RSX), !
('STANDARD', M_STA + FLAGS_ON), !
! ('SYMBOLS:', S_STBS), !
('TASK:', S_TASK), !
('VERSION', M_VERSION + FLAG_ON), !
('WIDE', M_WIDE + FLAG_ON) !
)),
FN4 : CMD_CONFIRM (),
FN5 : CMD_FILE (),
! FN6 : CMD_DIRECTORY (),
FN7 : CMD_STRING (, '('),
FN8 : CMD_KEYWORDS (,
(('ALL', M_RSX_ALL + FLAGS_ON), !
('ATL', M_RSX_ATL + FLAG_ON), !
('CLOCK-QUEUE', M_RSX_CLQ + FLAG_ON), !
('CONTEXT', M_RSX_CTXT + FLAG_ON), !
('DEVICES', M_RSX_DEV + FLAG_ON), !
('DUMP', M_RSX_DUMP + FLAG_ON), !
('FXD', M_RSX_FXD + FLAG_ON), !
('HEADERS', M_RSX_HDR + FLAG_ON), !
('PARTITIONS', M_RSX_PARS + FLAG_ON), !
('PCBS', M_RSX_PCBS + FLAG_ON), !
('POOL', M_RSX_POOL + FLAG_ON), !
('STANDARD', M_RSX_STA + FLAGS_ON), !
('STD', M_RSX_STD + FLAG_ON) !
)),
FN9 : CMD_KEYWORDS (,
(('ALL', M_CEX_ALL + FLAGS_ON), !
('BUFFERS', M_CEX_BUFS + FLAG_ON), !
('CONTEXT', M_CEX_CTXT + FLAG_ON), !
('DUMP', M_CEX_DUMP + FLAG_ON), !
('FREE', M_CEX_FREE + FLAG_ON), !
! ('INTERPRET', M_CEX_INTERPRET + FLAG_ON), !
('PDVS', M_CEX_PDVS + FLAG_ON), !
('POOL', M_CEX_POOL + FLAG_ON), !
('SLTS', M_CEX_SLTS + FLAG_ON), !
('STANDARD', M_CEX_STA + FLAGS_ON) !
)),
FN10 : CMD_COMMA (FN11),
FN11 : CMD_STRING (, ')'),
FN12 : CMD_QUOTED_STR (,, 'task name'),
! FN13 : CMD_QUOTED_STR (,, 'process name'),
FN14 : CMD_NUMBER (, 8,, 'lower physical address limit'),
FN15 : CMD_TOKEN (, ':'),
FN16 : CMD_NUMBER (, 8,, 'upper physical address limit');
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
$CAT5; !Convert ASCII to RAD50.
EXTERNAL
TSKCNT,
TSKLST : BLOCKVECTOR [MDA_MAX_TSKS, 2],
PRCCNT,
PRCLST : BLOCKVECTOR [MDA_MAX_PRCS, 1],
DMPCNT,
DMPLST : BLOCKVECTOR [MDA_MAX_DMPS, 4],
DMPBLK, !Dump file block.
DMPOFF, !Dump file offset.
LSTBLK, !Listing file block.
STBBLK, !Symbol table file block.
FLAGS : BITVECTOR [M_MAX_BITS];
ROUTINE ALLOCATE_FILBLK (FILPTR) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
IF ..FILPTR EQL 0
THEN
BEGIN
INCR INDEX FROM 0 TO MDA_MAX_FILES - 1 DO
IF .FILBLK [.INDEX, F_JFN] EQL 0
THEN
BEGIN
.FILPTR = FILBLK [.INDEX, F_JFN];
RETURN TRUE
END;
FALSE
END
ELSE
TRUE; !OF ALLOCATE_FILBLK
GLOBAL ROUTINE ASSOCIATE (FILPTR, FILE_NAME_PTR, EXT_PTR) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
OWN
JFN_BLOCK : VECTOR [9],
JFN_DIRECTORY : CH$SEQUENCE (40);
JFN_BLOCK [$GJGEN] = GJ_OLD + $GJDEF;
JFN_BLOCK [$GJSRC] = $NULIO^18 + $NULIO;
JFN_BLOCK [$GJDEV] = 0;
JFN_BLOCK [$GJDIR] = 0;
JFN_BLOCK [$GJNAM] = 0;
JFN_BLOCK [$GJEXT] = .EXT_PTR;
JFN_BLOCK [$GJPRO] = 0;
JFN_BLOCK [$GJACT] = 0;
JFN_BLOCK [$GJJFN] = 0;
IF NOT ALLOCATE_FILBLK (.FILPTR) THEN RETURN FALSE;
BEGIN
REGISTERS (1, 2, 3);
AC2 = .FILE_NAME_PTR;
AC1 = JFN_BLOCK;
AC3 = JSYS (1, GTJFN, AC1, AC2);
IF .AC3 NEQ 1 THEN RETURN FALSE;
BLOCK [..FILPTR, F_JFN] = .AC1<0, 18>;
END;
TRUE
END; !OF ASSOCIATE
GLOBAL ROUTINE CLOSE (FILPTR) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
IF ..FILPTR NEQ 0
THEN
BEGIN
BEGIN
REGISTERS (1);
AC1 = .BLOCK [..FILPTR, F_JFN];
IF JSYS (1, CLOSF, AC1) NEQ 1
THEN
BEGIN
AC1 = .BLOCK [..FILPTR, F_JFN];
JSYS (1, RLJFN, AC1);
END;
END;
BLOCK [..FILPTR, F_JFN] = 0;
.FILPTR = 0;
END; !OF CLOSE
GLOBAL ROUTINE CMD =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LOCAL
COMND_FLAGS, !Returned flags from the COMND JSYS.
COMND_USED,
COMND_DATA,
CMPTR_SAVE; !Save the beginning of the field.
BIND
DMP_FILE_TYPE = CH$ASCIZ ('DMP'),
LST_FILE_TYPE = CH$ASCIZ ('LST');
!+
! Check for a command in the rescan buffer.
!-
! STB_SAVE = .STBDIR;
RSCAN_FLAG =
BEGIN
LOCAL
CMD_LEN;
IF
BEGIN
REGISTERS (1);
AC1 = $RSINI;
CMD_LEN = (IF JSYS (1, RSCAN, AC1) THEN .AC1 ELSE 0)
END
NEQ 0
THEN
BEGIN
LOCAL
TEMP;
BIND
CMD_PTR = CH$PTR (CMD_INPUT, 6);
!+
! Get a copy of the rescan line to see if it has valid
! information in it.
!-
BEGIN
REGISTERS (1, 2, 3);
AC3 = .CMD_LEN;
AC2 = CMD_PTR;
AC1 = $CTTRM;
JSYS (0, SIN, AC1, AC2, AC3);
TEMP = .AC2;
END;
!+
! Now change lower case to upper case for comparisons
! and chop off cr/lf if present.
!-
BEGIN
LOCAL
CHR,
CNT,
PTR;
PTR = CMD_PTR;
CMD_LEN = 0;
WHILE (CHR = CH$RCHAR (.PTR)) GEQ %C' ' DO
BEGIN
IF (.CHR GEQ %C'a') AND (.CHR LEQ %C'z') THEN CH$WCHAR (.CHR - %C'a' + %C'A', .PTR);
PTR = CH$PLUS (.PTR, 1);
CMD_LEN = .CMD_LEN + 1;
END;
END;
!+
! If not RUN or START then must have good stuff.
!-
IF NOT CH$FAIL (TEMP = CH$FIND_CH (39, CMD_PTR, %C' ')) AND NOT CH$FAIL (TEMP = CH$FIND_NOT_CH (4,
.TEMP, %C' ')) AND NOT CH$EQL (4, CH$ASCII ('RUN '), 4, CMD_PTR, %C' ') AND NOT CH$EQL (6,
CH$ASCII ('START '), 6, CMD_PTR, %C' ')
THEN
BEGIN
!+
! Append a /E to the end so as to avoid re-prompt
!-
CH$MOVE (5, CH$ASCIZ ('/E', %CHAR (13, 10)), CH$PLUS (CMD_PTR, .CMD_LEN));
!+
! Now re-insert the line back into the rescan buffer and
! redirect input to it instead of primary input.
!-
CMD_STATE_BLK [$CMIOJ] = $CTTRM^18 + $NULIO;
BEGIN
REGISTERS (1, 2, 3);
AC1 = .TEMP;
JSYS (1, RSCAN, AC1);
AC1 = $RSINI;
JSYS (1, RSCAN, AC1)
END
END
ELSE
FALSE
END
ELSE
FALSE
END;
!+
! Now parse the command line.
!-
FUNCTION = FN1;
DO
BEGIN
SELECTA .FUNCTION<0, 18> OF
SET
[FN2] :
BEGIN
CMD_JFN [$GJGEN] = GJ_OLD + $GJDEF;
CMD_JFN [$GJNAM] = 0;
CMD_JFN [$GJEXT] = DMP_FILE_TYPE;
END;
[FN5] :
BEGIN
CMD_JFN [$GJGEN] = GJ_FOU + $GJDEF;
CMD_JFN [$GJNAM] = CH$PTR (DEF_LST_NAME);
CMD_JFN [$GJEXT] = LST_FILE_TYPE;
END;
TES;
BEGIN
REGISTERS (1, 2, 3);
AC1 = CMD_STATE_BLK;
AC2 = .FUNCTION;
JSYS (0, COMND, AC1, AC2, AC3);
COMND_FLAGS = .AC1;
COMND_DATA = .AC2;
COMND_USED = .AC3<0, 18>;
END;
SELECTONE 1 OF
SET
[.POINTR (COMND_FLAGS, CM_NOP)] :
IF .COMND_USED EQLA FN5
THEN
BEGIN
LOCAL
BLK_PTR;
INCRA BLK_PTR FROM CMD_JFN [0] TO CMD_JFN [14] DO
.BLK_PTR = 0;
CMD_JFN [$GJGEN] = GJ_OFG;
END
ELSE
BEGIN
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ (%CHAR (13, 10), '?MCBDA - ');
JSYS (0, PSOUT, AC1);
END;
BEGIN
REGISTERS (1, 2, 3);
AC3 = 0;
AC2 = $FHSLF^18 + %O'777777';
AC1 = $PRIOU;
JSYS (2, ERSTR, AC1, AC2, AC3);
FUNCTION = FN1;
END;
END;
[.POINTR (COMND_FLAGS, CM_RPT)] :
INIT_PARSE ();
[OTHERWISE] :
SELECTONEA .COMND_USED OF
SET
[FN1] :
INIT_PARSE ();
[FN2] :
BEGIN
CLOSE (DMPBLK);
IF NOT ALLOCATE_FILBLK (DMPBLK) THEN RETURN FALSE;
BLOCK [.DMPBLK, F_JFN] = .COMND_DATA;
BEGIN
REGISTERS (1, 2, 3, 4);
AC3 = FLD ($JSAOF, JS_TYP);
AC2 = .BLOCK [.DMPBLK, F_JFN];
AC1 = CH$PTR (CMD_ATOM);
JSYS (0, JFNS, AC1, AC2, AC3, AC4);
AC3 = 0;
AC2 = .BLOCK [.DMPBLK, F_JFN];
AC1 = CH$PTR (DEF_DMP_FILE);
JSYS (0, JFNS, AC1, AC2, AC3, AC4);
CH$WCHAR (0, .AC1);
END;
DMPOFF = (IF CH$EQL (3, CH$PTR (CMD_ATOM), 3, CH$ASCII ('SYS'), 0)
THEN 3 ELSE 1);
DUMP_FLAG = 1;
IF .DEF_LST_NAME EQL 0
THEN
BEGIN
REGISTERS (1, 2, 3, 4);
AC3 = FLD ($JSAOF, JS_NAM);
AC2 = .BLOCK [.DMPBLK, F_JFN];
AC1 = CH$PTR (DEF_LST_NAME);
JSYS (0, JFNS, AC1, AC2, AC3, AC4);
END;
FUNCTION = FN3;
END;
[FN3, FN8, FN9] :
BEGIN
BIND
SWITCH_CMD = .POINTR ((.COMND_DATA), SWT_CMD),
SWITCH_VAL = .POINTR ((.COMND_DATA), SWT_VAL);
FUNCTION = (IF .DEF_LST_NAME [0] EQL 0 THEN FN2 ELSE FN3);
CASE SWITCH_CMD FROM SWT_MIN TO SWT_MAX OF
SET
[SWT_FLAG_OFF] :
FLAGS [SWITCH_VAL] = 0;
[SWT_FLAG_ON] :
FLAGS [SWITCH_VAL] = 1;
[SWT_FLAGS_OFF] :
FLAGS = .FLAGS AND .FLAG_SET [SWITCH_VAL];
[SWT_FLAGS_ON] :
FLAGS = .FLAGS OR .FLAG_SET [SWITCH_VAL];
[SWT_KEYS] :
IF .POINTR (COMND_FLAGS, CM_SWT)
THEN
BEGIN
BIND
FNK = .KEY_SET [SWITCH_VAL];
FUNCTION = FN7;
POINTR ((FN7 + $CMFLG), CM_LST) = FNK;
POINTR ((FNK + $CMFLG), CM_LST) = 0;
END;
[SWT_LIST] :
BEGIN
FUNCTION = FN5;
END;
! [SWT_STBS] :
! FUNCTION = FN6;
[SWT_TASK] :
IF .TSKCNT LSS MDA_MAX_TSKS
THEN
FUNCTION = FN12
ELSE
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ ('? too many tasks', %CHAR (13, 10));
JSYS (0, PSOUT, AC1);
FUNCTION = FN1;
END;
! [SWT_PROCESS] :
!
! IF .PRCCNT LSS MDA_MAX_PRCS
! THEN
! FUNCTION = FN13
! ELSE
! BEGIN
! REGISTERS (1);
! AC1 = CH$ASCIZ ('? too many processes', %CHAR (13, 10));
! JSYS (0, PSOUT, AC1);
! FUNCTION = FN1;
! END;
[SWT_DUMP] :
IF .DMPCNT LSS MDA_MAX_DMPS
THEN
FUNCTION = FN14
ELSE
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ ('? too many dump ranges', %CHAR (13, 10));
JSYS (0, PSOUT, AC1);
FUNCTION = FN1;
END;
[INRANGE] :
NO_OPERATION;
TES;
IF .SUB_FUNCTION NEQ 0 THEN FUNCTION = FN10;
END;
[FN4] :
FUNCTION = 0;
[FN5] :
BEGIN
CLOSE (LSTBLK);
IF NOT ALLOCATE_FILBLK (LSTBLK) THEN RETURN FALSE;
BLOCK [.LSTBLK, F_JFN] = .COMND_DATA;
FUNCTION = (IF .DEF_LST_NAME [0] EQL 0 THEN FN2 ELSE FN3);
END;
! [FN6] :
! BEGIN
! STBDIR = .COMND_DATA;
! FUNCTION = (IF .DEF_LST_NAME [0] EQL 0 THEN FN2 ELSE FN3);
! END;
[FN7] :
BEGIN
SUB_FUNCTION = .POINTR (.FUNCTION, CM_LST);
FUNCTION = .SUB_FUNCTION;
POINTR (.FUNCTION, CM_LST) = 0;
END;
[FN10] :
FUNCTION = .SUB_FUNCTION;
[FN11] :
BEGIN
SUB_FUNCTION = 0;
FUNCTION = (IF .DEF_LST_NAME [0] EQL 0 THEN FN2 ELSE FN3);
END;
[FN12] :
BEGIN
LOCAL
PTR;
FUNCTION = (IF .DEF_LST_NAME [0] EQL 0 THEN FN2 ELSE FN3);
PTR = CH$PTR (CMD_ATOM);
TSKLST [.TSKCNT, 0, 0, 16, 0] = $CAT5 (PTR, 1);
TSKLST [.TSKCNT, 1, 0, 16, 0] = $CAT5 (PTR, 1);
IF CH$RCHAR (.PTR) EQL 0
THEN
TSKCNT = .TSKCNT + 1
ELSE
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ ('? improper task name', %CHAR (13, 10));
JSYS (0, PSOUT, AC1);
FUNCTION = FN1;
END;
END;
! [FN13] :
! BEGIN
!
! LOCAL
! PTR;
!
! FUNCTION = (IF .DEF_LST_NAME [0] EQL 0 THEN FN2 ELSE FN3);
! PTR = CH$PTR (CMD_ATOM);
! PRCLST [.PRCCNT, 0, 0, 16, 0] = $CAT5 (PTR, 1);
!
! IF CH$RCHAR (.PTR) EQL 0
! THEN
! PRCCNT = .PRCCNT + 1
! ELSE
! BEGIN
! REGISTERS (1);
! AC1 = CH$ASCIZ ('? improper process name', %CHAR (13, 10));
! JSYS (0, PSOUT, AC1);
! FUNCTION = FN1;
! END;
!
! END;
[FN14] :
IF .COMND_DATA<18, 18> NEQ 0
THEN
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ ('? invalid physical address');
JSYS (0, PSOUT, AC1);
FUNCTION = FN1;
END
ELSE
BEGIN
DMPLST [.DMPCNT, 0, 0, 2, 0] = .COMND_DATA<16, 2>;
DMPLST [.DMPCNT, 1, 0, 16, 0] = .COMND_DATA<0, 16>;
FUNCTION = FN15;
END;
[FN15] :
FUNCTION = FN16;
[FN16] :
IF .COMND_DATA<18, 18> NEQ 0
THEN
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ ('? invalid physical address');
JSYS (0, PSOUT, AC1);
FUNCTION = FN1;
END
ELSE
IF .COMND_DATA<0, 18> LEQU .DMPLST [.DMPCNT, 0, 0, 18, 0]
THEN
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ ('? invalid range');
JSYS (0, PSOUT, AC1);
FUNCTION = FN1;
END
ELSE
BEGIN
DMPLST [.DMPCNT, 2, 0, 2, 0] = .COMND_DATA<16, 2>;
DMPLST [.DMPCNT, 3, 0, 16, 0] = .COMND_DATA<0, 16>;
DMPCNT = .DMPCNT + 1;
FUNCTION = (IF .DEF_LST_NAME [0] EQL 0 THEN FN2 ELSE FN3);
END;
TES;
TES;
END
WHILE .FUNCTION NEQ 0;
IF .LSTBLK NEQ 0
THEN
BEGIN
REGISTERS (1, 2, 3);
AC1 = .BLOCK [.LSTBLK, F_JFN];
JSYS (0, DVCHR, AC1, AC2, AC3);
SELECTONE .POINTR (AC2, DV_TYP) OF
SET
[$DVTTY, $DVPTY] : NO_OPERATION;
[OTHERWISE] : FLAGS [M_WIDE] = 1;
TES;
END;
.DUMP_FLAG
END; !OF CMD
GLOBAL ROUTINE FILDT (BUF_PTR_ADR, PAT_PTR_ADR, PRM_LST_ADR_ADR) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
REGISTERS (1, 2, 3, 4);
LOCAL
BUF_PTR_INI,
FILPTR,
PRM_LIST : REF VECTOR;
PRM_LIST = ..PRM_LST_ADR_ADR;
FILPTR = .PRM_LIST [0];
.PRM_LST_ADR_ADR = PRM_LIST [1];
AC1 = (BUF_PTR_INI = ..BUF_PTR_ADR);
AC2 = .BLOCK [..FILPTR, F_JFN];
AC3 = FLD ($JSAOF, JS_CDR);
AC4 = 0;
JSYS (0, JFNS, AC1, AC2, AC3, AC4);
.BUF_PTR_ADR = .AC1;
CH$DIFF (..BUF_PTR_ADR, .BUF_PTR_INI)
END; !End of FILDT
GLOBAL ROUTINE FILNM (BUF_PTR_ADR, PAT_PTR_ADR, PRM_LST_ADR_ADR) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
REGISTERS (1, 2, 3, 4);
LOCAL
BUF_PTR_INI,
FILPTR,
PRM_LIST : REF VECTOR;
PRM_LIST = ..PRM_LST_ADR_ADR;
FILPTR = .PRM_LIST [0];
.PRM_LST_ADR_ADR = PRM_LIST [1];
AC1 = (BUF_PTR_INI = ..BUF_PTR_ADR);
AC2 = .BLOCK [..FILPTR, F_JFN];
AC3 = FLD ($JSAOF, JS_DEV) + FLD ($JSAOF, JS_DIR) + FLD ($JSAOF, JS_NAM) + FLD ($JSAOF, JS_TYP) + FLD (
$JSAOF, JS_GEN) + JS_PAF;
AC4 = 0;
JSYS (0, JFNS, AC1, AC2, AC3, AC4);
.BUF_PTR_ADR = .AC1;
CH$DIFF (..BUF_PTR_ADR, .BUF_PTR_INI)
END; !End of FILNM
GLOBAL ROUTINE FILPOS (FILPTR, FBLOCK_ADR, OFFSET_ADR) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LITERAL
BLOCK_SIZE = 512;
LOCAL
POSITION;
BEGIN
REGISTERS (1, 2);
AC1 = .BLOCK [..FILPTR, F_JFN];
IF JSYS (1, RFPTR, AC1, AC2) NEQ 1 THEN RETURN FALSE;
POSITION = .AC2;
END;
.FBLOCK_ADR = .POSITION^1/BLOCK_SIZE + 1;
.OFFSET_ADR = .POSITION^1 MOD BLOCK_SIZE;
TRUE
END; !OF FILPOS
ROUTINE INIT_PARSE : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
! STBDIR = (IF .STB_SAVE NEQ 0 THEN .STB_SAVE ELSE
! BEGIN
! REGISTERS (1, 2, 3, 4);
! JSYS (0, GJINF, AC1, AC2, AC3, AC4);
! .AC2
! END);
CLOSE (LSTBLK);
TSKCNT = 0;
PRCCNT = 0;
DMPCNT = 0;
DEF_LST_NAME = 0;
FLAGS = 0;
MY_FLAGS = 0;
SUB_FUNCTION = 0;
FUNCTION = (SELECTONE .RSCAN_FLAG OF
SET
[0] : FN2;
[1] : (RSCAN_FLAG = 2; FN2);
[2] : (FLAGS [M_EXIT] = 1; 0);
TES);
END; !End of INIT_PARSE
GLOBAL ROUTINE GETFIL (FILPTR, BUFFER_PTR, LENGTH) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
REGISTERS (1, 2, 3, 4);
AC1 = .BLOCK [..FILPTR, F_JFN]; !Pick up the JFN
AC2 = .BUFFER_PTR;
AC3 = -.LENGTH;
JSYS (0, SIN, AC1, AC2, AC3, AC4); !read in a 18 bit byte
.LENGTH + .AC3 !and trim to 16 bits.
END; !OF GETFIL
GLOBAL ROUTINE GETTIM (TIME_BLOCK) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
! FORMAL PARAMETERS:
!
! .TIME_BLOCK !Address of 8 word block
! !to receive date and time.
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
MAP
TIME_BLOCK : REF VECTOR [8];
REGISTERS (1, 2, 3, 4);
AC4 = IC_ADS;
AC2 = -1;
JSYS (0, ODCNV, AC1, AC2, AC3, AC4);
TIME_BLOCK [0] = .AC2<18, 16> - 1900;
TIME_BLOCK [1] = .AC2<0, 16> + 1;
TIME_BLOCK [2] = .AC3<18, 16> + 1;
TIME_BLOCK [3] = (.AC4<0, 18>/(60*60)) MOD 24;
TIME_BLOCK [4] = (.AC4<0, 18>/60) MOD 60;
TIME_BLOCK [5] = (.AC4<0, 18>) MOD 60;
TIME_BLOCK [6] = 0;
TIME_BLOCK [7] = 0;
END; !End of GETTIM
GLOBAL ROUTINE OPEN (FILPTR, ACCESS, MODE) =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
BIND
ACCESS_TYPE = UPLIT (OF_RD, OF_WR, OF_RD + OF_WR, OF_RD + OF_WR, OF_RD + OF_WR) : VECTOR [5],
MODE_TYPE = UPLIT (FLD (7, OF_BSZ), FLD (18, OF_BSZ)) : VECTOR [2];
LOCAL
FLAG_WORD;
FLAG_WORD = .ACCESS_TYPE [.ACCESS] + .MODE_TYPE [.MODE];
IF ..FILPTR EQL 0
THEN
BEGIN
IF NOT ALLOCATE_FILBLK (.FILPTR) THEN RETURN FALSE;
IF .POINTR (FLAG_WORD, OF_WR)
THEN
BLOCK [..FILPTR, F_JFN] = $PRIOU
ELSE
BLOCK [..FILPTR, F_JFN] = $PRIIN;
END;
BEGIN
REGISTERS (1, 2);
AC1 = .BLOCK [..FILPTR, F_JFN]; !Set the JFN
AC2 = .FLAG_WORD; !Set access and block if not available.
IF .AC1 NEQ $PRIIN AND .AC1 NEQ $PRIOU AND JSYS (1, OPENF, AC1, AC2) NEQ 1 THEN RETURN FALSE;
END;
!and try to open it.
TRUE
END; !OF OPEN
GLOBAL ROUTINE POSFIL (FILPTR, FBLOCK, OFFSET) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
LITERAL
BLOCK_SIZE = 512;
LOCAL
POSITION;
POSITION = ((.FBLOCK - 1)*BLOCK_SIZE + .OFFSET)^-1;
BEGIN
REGISTERS (1, 2);
AC2 = .POSITION;
AC1 = .BLOCK [..FILPTR, F_JFN];
JSYS (1, SFPTR, AC1, AC2);
END;
END; !OF POSFIL
GLOBAL ROUTINE PUTFIL (FILPTR, TEXT_PTR, LENGTH) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! TEXT_PTR !POINTER TO TEXT STRING TO PRINT
! LENGTH !LENGTH OF TEXT
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
BEGIN
REGISTERS (1, 2, 3);
IF .LENGTH NEQ 0
THEN
BEGIN
AC1 = .BLOCK [..FILPTR, F_JFN]; !Set the JFN
AC2 = .TEXT_PTR; !a pointer to the string
AC3 = -.LENGTH; !the length of the string
JSYS (0, SOUT, AC1, AC2, AC3); !and send it on its way.
END;
END; !OF PUTFIL
ROUTINE RELEASE_FILBLK (FILPTR) : NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
!
!
!
!
! FORMAL PARAMETERS:
!
! NONE
!
! IMPLICIT INPUTS:
!
! NONE
!
! IMPLICIT OUTPUTS:
!
! NONE
!
! ROUTINE VALUE:
!
! NONE
!
! SIDE EFFECTS
!
! NONE
!
!--
IF ..FILPTR NEQ 0
THEN
BEGIN
IF .BLOCK [..FILPTR, F_JFN] NEQ 0
THEN
CLOSE (.FILPTR);
.FILPTR = 0;
END; !OF RELEASE_FILBLK
END
ELUDOM