Trailing-Edge
-
PDP-10 Archives
-
BB-R595B-SM_11-9-85
-
mcb/utilities/lbrsys.b36
There is 1 other file named lbrsys.b36 in the archive. Click here to see a list.
MODULE LBRSYS ( !System dependant functions
IDENT = '001040',
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: LBR20 - Librarian Utility
!
! ABSTRACT:
!
!
! This module contains routines to do system dependant functions.
! This includes I/O, command processing, and information access.
!
!
! ENVIRONMENT: TOPS20
!
! AUTHOR: ALAN D. PECKHAM, CREATION DATE: 19-MAY-80
!
! MODIFIED BY:
!
! Alan D. Peckham, : VERSION 01
! 01 - Restructure file positioning to refer to block/offset.
! Add "get file position" function (FILPOS).
! 02 - Add COMPRESS function to command parser.
! 03 - Add FAST switch.
! 04 - Add support for RG (replace global) switch.
!--
!
! 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 'LBRCOM'; !LBR 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] %,
BASE_FLAG =
MY_FLAGS [1] %,
CMD_FUNCTION (function, link, cmd_data, default, help, mask) =
VECTOR [%IF %NULL (mask) %THEN 4 %ELSE 5 %FI]
INITIAL ( FLD (function, CM_FNC)
%IF NOT %NULL (link)
%THEN +FLD (link,CM_LST)
%FI
%IF NOT %NULL (help)
%THEN +CM_HPP+CM_SDH
%FI
%IF NOT %NULL (mask)
%THEN +CM_BRK
%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
%IF NOT %NULL (mask)
%THEN ,mask
%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 (0 + MASK_WORD (0, 31, %REMOVE (chars)) XOR -1,
0 + MASK_WORD (32, 63, %REMOVE (chars)) XOR -1,
0 + MASK_WORD (64, 95, %REMOVE (chars)) XOR -1,
0 + MASK_WORD (96, 127, %REMOVE (chars)) XOR -1) %,
MASK_WORD (low_char, high_char) [char] =
%IF ((%C char GEQ low_char) AND (%C char LEQ high_char))
%THEN 1^(35 + low_char - %C char)
%ELSE 0
%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_RAD50 (LINK, DEFAULT, HELP) =
CMD_FUNCTION ($CMFLD,LINK,,DEFAULT,HELP,
CMD_DATA_MASK ((%EXPLODE ('ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$.')))) %,
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) %;
MACRO
BIT_NUMBER (p1, p2, p3, p4) =
p2 %;
!
! EQUATED SYMBOLS:
!
MACRO
F_JFN =
0, 0, 18, 0 %;
LITERAL
F_LENGTH = 1;
LITERAL
CMD_ATOM_MAX = 40, !Maximum atom length.
CMD_INPUT_MAX = 133, !Maximum command length.
JFN_NAME_MAX = 40, !Maximum file name length.
SWT_CMD = %O'770000',
SWT_MIN = 0,
SWT_FLAG_OFF = 0,
SWT_FLAG_ON = 1,
SWT_LIST = 2,
SWT_CREATE = 3,
SWT_DE = 4,
SWT_DG = 5,
SWT_COMPRESS = 6,
SWT_MAX = 6,
SWT_VAL = %O'007777';
BIND
FLAG_OFF = FLD (SWT_FLAG_OFF, SWT_CMD),
FLAG_ON = FLD (SWT_FLAG_ON, SWT_CMD),
S_LIST = FLD (SWT_LIST, SWT_CMD),
S_COMPRESS = FLD (SWT_COMPRESS, SWT_CMD),
S_CREATE = FLD (SWT_CREATE, SWT_CMD),
S_DE = FLD (SWT_DE, SWT_CMD),
S_DG = FLD (SWT_DG, SWT_CMD);
!
! 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_LIB_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 [LBR_MAX_FILES, F_LENGTH] INITIAL (REP LBR_MAX_FILES*F_LENGTH OF (0)),
FUNCTION, !Current function
MY_FLAGS : BITVECTOR [16],
RSCAN_FLAG;
!
! Command parser tables
!
FORWARD
CO2 : VECTOR [4],
CO3 : VECTOR [4],
CO4 : VECTOR [4],
CO5 : VECTOR [4],
CO6 : VECTOR [4],
CO7 : VECTOR [4],
CR2 : VECTOR [4],
CR3 : VECTOR [4],
CR4 : VECTOR [4],
CR5 : VECTOR [4],
CR6 : VECTOR [4],
DE2 : VECTOR [5],
DG2 : VECTOR [5],
EOL : VECTOR [4],
FI2 : VECTOR [4],
FI3 : VECTOR [4],
FI4 : VECTOR [4],
FN1 : VECTOR [4],
FN2 : VECTOR [4],
FN3 : VECTOR [4],
FN4 : VECTOR [4],
LI2 : VECTOR [4];
OWN
FN1 : CMD_INITIALIZE,
FN2 : CMD_FILE (FN3, CH$PTR (DEF_LIB_FILE), 'library file'),
FN3 : CMD_SWITCHES (EOL, (
('EXIT', M_EXIT + FLAG_ON), !
('HELP', M_HELP + FLAG_ON), !
('VERSION', M_VERSION + FLAG_ON) !
)),
FN4 : CMD_SWITCHES (FI2, (
('COMPRESS:', S_COMPRESS), !
('CREATE:', S_CREATE), !
('DELETE:', S_DE), !
('DG:', S_DG), !
('EPT', M_NOEPT + FLAG_OFF), !
('EXIT', M_EXIT + FLAG_ON), !
('FAST', M_FAST + FLAG_ON), !
('FULL', M_LIST_HEADERS + FLAG_ON), !
('HELP', M_HELP + FLAG_ON), !
('INSERT', M_REPLACE + FLAG_OFF), !
('LE', M_LIST_ENTRIES + FLAG_ON), !
('LISTING:', S_LIST), !
('NOEPT', M_NOEPT + FLAG_ON), !
('NORG', M_RG + FLAG_OFF), !
('NOSS', M_SS + FLAG_OFF), !
('REPLACE', M_REPLACE + FLAG_ON), !
('RG', M_RG + FLAG_ON), !
('SS', M_SS + FLAG_ON), !
('VERSION', M_VERSION + FLAG_ON), !
('WIDE', M_WIDE + FLAG_ON) !
)),
FI2 : CMD_FILE (EOL,, 'object file'),
FI3 : CMD_SWITCHES (FI4, (
('EPT', BIT_NUMBER (F_NOEPT) + FLAG_OFF), !
('INSERT', BIT_NUMBER (F_REPLACE) + FLAG_OFF), !
('NOEPT', BIT_NUMBER (F_NOEPT) + FLAG_ON), !
('NORG', BIT_NUMBER (F_RG) + FLAG_OFF), !
('NOSS', BIT_NUMBER (F_SS) + FLAG_OFF), !
('REPLACE', BIT_NUMBER (F_REPLACE) + FLAG_ON), !
('RG', BIT_NUMBER (F_RG) + FLAG_ON), !
('SS', BIT_NUMBER (F_SS) + FLAG_ON) !
)),
FI4 : CMD_COMMA (EOL),
LI2 : CMD_FILE (, CH$ASCIZ ('TTY:'), 'listing file'),
CO2 : CMD_NUMBER (, 10,, 'size of file in blocks'),
CO3 : CMD_TOKEN (CO7, ':', CH$ASCIZ (':')),
CO4 : CMD_NUMBER (, 10,, 'maximum entry points'),
CO5 : CMD_TOKEN (CO7, ':', CH$ASCIZ (':')),
CO6 : CMD_NUMBER (, 10,, 'maximum modules'),
CO7 : CMD_FILE (EOL,, 'library file'),
CR2 : CMD_NUMBER (, 10, CH$ASCIZ ('100'), 'size of file in blocks'),
CR3 : CMD_TOKEN (FN4, ':', CH$ASCIZ (':')),
CR4 : CMD_NUMBER (, 10, CH$ASCIZ ('512'), 'maximum entry points'),
CR5 : CMD_TOKEN (FN4, ':', CH$ASCIZ (':')),
CR6 : CMD_NUMBER (, 10, CH$ASCIZ ('256'), 'maximum modules'),
DE2 : CMD_RAD50 (,, 'module name'),
DG2 : CMD_RAD50 (,, 'entry point'),
EOL : CMD_CONFIRM ();
!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
$CAT5; !Convert ASCII to RAD50.
EXTERNAL
FLAGS : BITVECTOR [M_MAX_BITS],
GBLNAM : BLOCKVECTOR [LBR_MAX_GLOBAL_DELETES, 2],
GBLNUM,
LIBBLK, !Dump file block.
LSTBLK, !Listing file block.
MODNAM : BLOCKVECTOR [LBR_MAX_MODULE_DELETES, 2],
MODNUM,
NUMEPT,
NUMMNT,
OBJBLK : VECTOR [LBR_MAX_OBJ],
OBJFLG : BLOCKVECTOR [LBR_MAX_OBJ, F_MAX],
OBJNUM,
SIZFIL,
TTYBLK; !Terminal block.
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 LBR_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;
BIND
LIB_FILE_TYPE = CH$ASCIZ ('OLB'),
LST_FILE_TYPE = CH$ASCIZ ('LST'),
OBJ_FILE_TYPE = CH$ASCIZ ('OBJ');
!+
! Check for a command in the rescan buffer.
!-
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, %CHARCOUNT (PROMPT, '>'));
!+
! 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 /EX to the end so as to avoid re-prompt
!-
CH$MOVE (6, CH$ASCIZ ('/EX', %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, CO7] :
BEGIN
CMD_JFN [$GJGEN] = $GJDEF;
CMD_JFN [$GJNAM] = 0;
CMD_JFN [$GJEXT] = LIB_FILE_TYPE;
END;
[LI2] :
BEGIN
CMD_JFN [$GJGEN] = GJ_FOU + $GJDEF;
CMD_JFN [$GJNAM] = CH$PTR (DEF_LST_NAME);
CMD_JFN [$GJEXT] = LST_FILE_TYPE;
END;
[FN4, FI2] :
BEGIN
CMD_JFN [$GJGEN] = GJ_OLD + $GJDEF;
CMD_JFN [$GJNAM] = 0;
CMD_JFN [$GJEXT] = OBJ_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 .POINTR (.FUNCTION, CM_FNC) EQL $CMFIL
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
REGISTERS (1, 2, 3);
AC3 = 0;
AC2 = $FHSLF^18 + %O'777777';
AC1 = $PRIOU;
JSYS (2, ERSTR, AC1, AC2, AC3);
FUNCTION = FN1;
END;
[.POINTR (COMND_FLAGS, CM_RPT)] :
INIT_PARSE ();
[OTHERWISE] :
SELECTONEA .COMND_USED OF
SET
[CO2] :
BEGIN
SIZFIL = .COMND_DATA <0, 16>;
FUNCTION = CO3;
END;
[CO3] :
FUNCTION = CO4;
[CO4] :
BEGIN
NUMEPT = .COMND_DATA <0, 16>;
FUNCTION = CO5;
END;
[CO5] :
FUNCTION = CO6;
[CO6] :
BEGIN
NUMMNT = .COMND_DATA <0, 16>;
FUNCTION = CO7;
END;
[CO7] :
0;
[CR2] :
BEGIN
SIZFIL = .COMND_DATA <0, 16>;
FUNCTION = CR3;
END;
[CR3] :
FUNCTION = CR4;
[CR4] :
BEGIN
NUMEPT = .COMND_DATA <0, 16>;
FUNCTION = CR5;
END;
[CR5] :
FUNCTION = CR6;
[CR6] :
BEGIN
NUMMNT = .COMND_DATA <0, 16>;
FUNCTION = FN4;
END;
[DE2] :
BEGIN
LOCAL
PTR;
FUNCTION = FN4;
PTR = CH$PTR (CMD_ATOM);
MODNAM [.MODNUM, 0, 0, 16, 0] = $CAT5 (PTR, 1);
MODNAM [.MODNUM, 1, 0, 16, 0] = $CAT5 (PTR, 1);
IF CH$RCHAR (.PTR) EQL 0
THEN
MODNUM = .MODNUM + 1
ELSE
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ ('? improper module name', %CHAR (13, 10));
JSYS (0, PSOUT, AC1);
FUNCTION = FN1;
END;
END;
[DG2] :
BEGIN
LOCAL
PTR;
FUNCTION = FN4;
PTR = CH$PTR (CMD_ATOM);
GBLNAM [.GBLNUM, 0, 0, 16, 0] = $CAT5 (PTR, 1);
GBLNAM [.GBLNUM, 1, 0, 16, 0] = $CAT5 (PTR, 1);
IF CH$RCHAR (.PTR) EQL 0
THEN
GBLNUM = .GBLNUM + 1
ELSE
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ ('? improper entry point name', %CHAR (13, 10));
JSYS (0, PSOUT, AC1);
FUNCTION = FN1;
END;
END;
[EOL] :
FUNCTION = 0;
[FI2] :
BEGIN
OBJNUM = .OBJNUM + 1;
CLOSE (OBJBLK [.OBJNUM - 1]);
IF NOT ALLOCATE_FILBLK (OBJBLK [.OBJNUM - 1]) THEN RETURN FALSE;
BLOCK [.OBJBLK [.OBJNUM - 1], F_JFN] = .COMND_DATA;
OBJFLG [.OBJNUM - 1, F_SS] = .FLAGS [M_SS];
OBJFLG [.OBJNUM - 1, F_REPLACE] = .FLAGS [M_REPLACE];
OBJFLG [.OBJNUM - 1, F_NOEPT] = .FLAGS [M_NOEPT];
FUNCTION = FI3;
END;
[FI3] :
BEGIN
BIND
SWITCH_CMD = .POINTR ((.COMND_DATA), SWT_CMD),
SWITCH_VAL = .POINTR ((.COMND_DATA), SWT_VAL);
CASE SWITCH_CMD FROM SWT_MIN TO SWT_MAX OF
SET
[SWT_FLAG_OFF] :
OBJFLG [.OBJNUM - 1, 0, .SWITCH_VAL, 1, 0] = 0;
[SWT_FLAG_ON] :
OBJFLG [.OBJNUM - 1, 0, .SWITCH_VAL, 1, 0] = 1;
[INRANGE] :
0;
TES;
END;
[FI4] :
FUNCTION = FI2;
[FN1] :
INIT_PARSE ();
[FN2] :
BEGIN
CLOSE (LIBBLK);
IF NOT ALLOCATE_FILBLK (LIBBLK) THEN RETURN FALSE;
BLOCK [.LIBBLK, F_JFN] = .COMND_DATA;
BEGIN
REGISTERS (1, 2, 3, 4);
AC3 = FLD ($JSAOF, JS_TYP);
AC2 = .BLOCK [.LIBBLK, F_JFN];
AC1 = CH$PTR (CMD_ATOM);
JSYS (0, JFNS, AC1, AC2, AC3, AC4);
AC3 = 0;
AC2 = .BLOCK [.LIBBLK, F_JFN];
AC1 = CH$PTR (DEF_LIB_FILE);
JSYS (0, JFNS, AC1, AC2, AC3, AC4);
CH$WCHAR (0, .AC1);
END;
DUMP_FLAG = 1;
IF .DEF_LST_NAME EQL 0
THEN
BEGIN
REGISTERS (1, 2, 3, 4);
AC3 = FLD ($JSAOF, JS_NAM);
AC2 = .BLOCK [.LIBBLK, F_JFN];
AC1 = CH$PTR (DEF_LST_NAME);
JSYS (0, JFNS, AC1, AC2, AC3, AC4);
END;
FUNCTION = FN4;
END;
[FN3, FN4] :
BEGIN
BIND
SWITCH_CMD = .POINTR ((.COMND_DATA), SWT_CMD),
SWITCH_VAL = .POINTR ((.COMND_DATA), SWT_VAL);
FUNCTION = .COMND_USED;
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_LIST] :
BEGIN
FLAGS [M_LIST] = 1;
FUNCTION = (IF .POINTR (COMND_FLAGS, CM_SWT) THEN LI2 ELSE FN4);
END;
[SWT_COMPRESS] :
BEGIN
FLAGS [M_COMPRESS] = 1;
NUMEPT = -1;
NUMMNT = -1;
SIZFIL = -1;
FUNCTION = (IF .POINTR (COMND_FLAGS, CM_SWT) THEN CO2 ELSE CO7);
END;
[SWT_CREATE] :
BEGIN
FLAGS [M_CREATE] = 1;
NUMEPT = 512;
NUMMNT = 256;
SIZFIL = 100;
FUNCTION = (IF .POINTR (COMND_FLAGS, CM_SWT) THEN CR2 ELSE FN4);
END;
[SWT_DE] :
IF NOT .POINTR (COMND_FLAGS, CM_SWT)
THEN
FUNCTION = FN4
ELSE
IF .MODNUM LSS LBR_MAX_MODULE_DELETES
THEN
FUNCTION = DE2
ELSE
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ ('? too many modules', %CHAR (13, 10));
JSYS (0, PSOUT, AC1);
FUNCTION = FN1;
END;
[SWT_DG] :
IF NOT .POINTR (COMND_FLAGS, CM_SWT)
THEN
FUNCTION = FN4
ELSE
IF .GBLNUM LSS LBR_MAX_GLOBAL_DELETES
THEN
FUNCTION = DG2
ELSE
BEGIN
REGISTERS (1);
AC1 = CH$ASCIZ ('? too many global symbols', %CHAR (13, 10));
JSYS (0, PSOUT, AC1);
FUNCTION = FN1;
END;
TES;
END;
[LI2] :
BEGIN
CLOSE (LSTBLK);
IF NOT ALLOCATE_FILBLK (LSTBLK) THEN RETURN FALSE;
BLOCK [.LSTBLK, F_JFN] = .COMND_DATA;
FUNCTION = FN4;
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] : 0;
[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
OBJNUM = 0;
MODNUM = 0;
GBLNUM = 0;
DEF_LST_NAME = 0;
FLAGS = 0;
MY_FLAGS = 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