PDP-10 Archive: 6-1-sources/init.bli from bb-h138e-bm_tops20_v6_1

Trailing-Edge - PDP-10 Archives - bb-h138e-bm_tops20_v6_1_distr - 6-1-sources/init.bli
There are 10 other files named init.bli in the archive. Click here to see a list.
 %TITLE 'INIT - initialize'
MODULE INIT (				! Initialize
		IDENT = '3-013'			! File: INIT.BLI Edit: CJG3013
		) =
BEGIN
!
!			  COPYRIGHT (c) 1981, 1985 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!		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:	EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
!	Initialize EDT
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: August 6, 1979
!
! MODIFIED BY:
!
! 1-001	- Original.  DJS 18-FEB-1981.  This module was created by
!	extracting routine EDT$$INIT  from module TINPUT.
! 1-002	- Regularized the headers and arranged to call EDT$$FATAL_IOERR  for I/O errors.  JBS 19-Feb-1981
! 1-003	- Changed from IO_STS and IO_FNF to IOFI_NFND .  JBS 19-Feb-1981
! 1-004	- Fixed module and file name.  JBS 04-Mar-1981
! 1-005	- Fix the file name.  JBS 11-Mar-1981
! 1-006	- Use new message codes.  JBS 04-Aug-1981
! 1-007	- Check for storage exhausted when defining the permanent buffers, and return
!	   a value rather than printing a message if the primary input file is not found.  JBS 16-Aug-1981
! 1-008 - Initialization moved from EDT$DATA to here.  STS 05-Nov-1981
! 1-009 - Add some initialization of the TBCB for the main buffer.  (a bug
!         surfaced where the cur_line was not zero.)  STS 13-Nov-1981
! 1-010 - Change this to initialize everything necessary for sharable
!	   image.  STS 17-Nov-1981
! 1-011	- Initialize the control C data by calling EDT$$CLR_CC.  JBS 29-Dec-1981
! 1-012 - Convert to fileio to open input file. STS 06-Jan-1982
! 1-013 - Remove reference to sys_prirab. STS 22-Jan-1982
! 1-014	- Autorepeat is initially on.  JBS 30-Jan-1982
! 1-015	- Initialize ENB_AUTRPT.  JBS 11-Feb-1982
! 1-016 - Use routine edt$workio to open workfile. STS 08-Feb-1982
! 1-017 - Initialize descriptor WF_DESC. STS 15-Feb-1982
! 1-018 - Add literals needed for callable EDT. STS 08-Mar-1982
! 1-019 - Initialize line number correctly. STS 10-Mar-1982
! 1-020	- Change CMD and JOU to OPTIONS.  JBS 18-Mar-1982
! 1-021	- The file I/O routine returns a status code.  Watch for EDT$_NONSTDFIL.
!	   JBS 26-Mar-1982
! 1-022	- Correct a typo in non-standard file handling.  JBS 27-Mar-1982
! 1-023	- Don't clear EIGHT_BIT.  JBS 05-Apr-1982
! 1-024 - Set up input file open flag. STS 07-Apr-1982
! 1-025	- Don't initialiaze the TBCBs -- now done by EDT$$GET_BUFPTR.  JBS 08-Apr-1982
! 1-026	- Initialize JOU_VALID.  JBS 09-Apr-1982
! 1-027	- Improve the message if the primary input file cannot be opened.  JBS 03-Jun-1982
! 1-028	- Pass the default file name in the RHB parameter.  JBS 15-Jun-1982
! 1-029 - Set CHM_FRST_ENTRY to 1 for callable EDT.  SMB 01-Jul-1982
! 1-030	- Initialize LASTMSG, remove CHM_FRST_ENTRY.  JBS 05-JUL-1982
! 1-031 - Take out reference to PRTC prompt. STS 07-Jul-1982
! 1-032 - Save original terminal width. STS 08-Jul-1982
! 1-033 - Change the line mode insert prompt.  SMB 14-Jul-1982
! 1-034	- Remove EDT$$A_STR_CMP.  JBS 19-Jul-1982
! 1-035 - Add initialization of select range. STS 06-Aug-1982
! 1-036 - Move open input file first and get out if not found and
!	    nocreate. STS 10-Aug-1982
! 1-037	- New implementation of defined keys.  JBS 12-Aug-1982
! 1-038 - Make use of the bit masks in the options word. STS 17-Aug-1982
! 1-039	- Fix up references to EDT$M_.  JBS 23-Aug-1982
! 1-040 - Zero out the help file open flag. STS 27-Aug-1982
! 1-041	- Call EDT$$INIT_IO.  JBS 27-Aug-1982
! 1-042	- Initialize EDT$$G_ENB_AUTRPT in the terminal initialization.  JBS 02-Sep-1982
! 1-043 - Initialize some screen structure globals.  SMB 10-Oct-1982
! 1-044	- Initialize the keypad translation table.  JBS 17-Oct-1982
! 1-045	- New handling of EDT$$G_SCR_REBUILD.  JBS 21-Oct-1982
! 1-046 - Make edt$$wf_desc static not dynamic descriptor. STS 11-Nov-1982
! 1-047	- Initialize EDT$$A_OLD_SEL.  JBS 02-Dec-1982
! 1-048	- Remove reference to EDT$$T_EXE_LNO.  JBS 14-Dec-1982
! 1-049	- Initialize EDT$$G_CS_LNO.  JBS 29-Dec-1982
! 1-050 - Initialize EDT$$G_TOP_SCREG, EDT$$G_BOT_SCREG.  SMB 11-Jan-1983
! 1-051	- Initialize EDT$$G_RECSCRUPD.  JBS 21-Jan-1983
! 1-052	- Add conditionals for WPS support.  JBS 10-Feb-1983
! 3-001 - Change CH$MOVE to EDT$$CPY_STR for TOPS so we get string ptrs.  GB 24-Jan-1983
! 3-002 - Initialise FMT_CUR with a real string ptr.  GB 3-Feb-1983
! 3-003 - Initialise prompt strings correctly.  GB 09-Feb-1983
! 3-004 - Modify call to EDT$$CALLFIO. CJG 19-Apr-1983
! 3-005 - Remove call to EDT$$INIT_IO. CJG 2-Jun-1983
! 3-006 - Remove call to EDT$$CALLFIO, and EDT$$CALLWIO. CJG 10-Jun-1983
! 3-007 - Remove <CR><LF> from front of default prompts. CJG 15-Jun-1983
! 3-008 - Change the way that filespecs are handled. CJG 22-Jun-1983
! 3-009 - Use CH$FILL to clear the data area. CJG 22-Jun-1983
! 3-010 - Call EDT$$PA_CMDLN here, after clearing database. CJG 27-Jun-1983
! 3-011 - Deal with the CREATE command (EDT$M_NEWFILE). CJG 12-Jul-1983
! 3-012 - Preset CTRL_T to 1. CJG 4-Jan-1984
! 3-013 - Add FMT_FREE to improve speed of format routines. CJG 11-Jan-1984
!--

%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$INIT;

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

LIBRARY 'EDTSRC:SUPPORTS';

LIBRARY 'EDTSRC:KEYPADDEF';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!

LITERAL
    NO_SELECT = -1;

!
!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
%SBTTL 'EDT$$INIT  - Initialize EDT'

GLOBAL ROUTINE EDT$$INIT 			! Initialize EDT
    =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Initialize EDT
!
! FORMAL PARAMETERS:
!
!	NONE
!
! IMPLICIT INPUTS:
!
!	LNO_EMPTY
!	CUR_BUF
!	INP_NAM
!	IOFI_NFND
!
! IMPLICIT OUTPUTS:
!
!	Most of EDT's global variables
!
! ROUTINE VALUE:
!
!	0			Primary input file was not found
!	1			Primary input file was found
!	2			Primary input file does not have standard text format
!	3			Primary input file open failure or other fatal error--abort
!
! SIDE EFFECTS:
!
!	Initializes most variables.
!	Opens the work file and terminal.
!	Establishes the MAIN and PASTE buffers, or fails.
!	Any I/O errors are fatal.
!
!--

    BEGIN

    EXTERNAL ROUTINE
	EDT$FILEIO,
	EDT$$WF_OPN,
	EDT$$PA_CMDLN : NOVALUE,		! Parse the initial command line
	EDT$$FMT_MSG,
	EDT$$TI_OPN,
	EDT$$ALO_HEAP,				! allocate heap storage for strings
	EDT$$GET_BUFPTR,
	EDT$$FND_BUF,
	EDT$$NEW_BUF,
	EDT$$CLR_CC : NOVALUE,			! Clear control C state
	EDT$$FIOPN_ERR : NOVALUE;		! Report a file open error


    EXTERNAL LITERAL
	EDT$M_RECOVER,
	EDT$M_NOCREATE,
	EDT$M_NEWFILE,
	EDT$K_OPEN_INPUT,
	EDT$K_INPUT_FILE;

    EXTERNAL
	AAAAAA,				! First and last locations to clear
	ZZZZZZ,
	TOP_SCREG,			! Top of scrolling region
	BOT_SCREG,			! Bottom of scrolling regon
	LNO_EMPTY : LN_BLOCK,		! Empty record
	TOP_LN : LN_BLOCK,		! Top screen record
	LASTMSG,			! The last message printed
	WORKCOUNT,			! Working message flag
	MESSAGE_LINE,			! Line number for messages
	INPUT_OPN,			! input file open flag
	CUR_BUF : REF TBCB_BLOCK,	! Current text buffer control block.
	INP_NAM,			! Name of input file.
	PRV_BUF,			! Previous tbcb.
	PST_BUF,			! Paste buffer tbcb.
	EDIT_MOD,
	EDIT_DFLTMOD,
	SAV_CNT,
	PRV_LN,
	CTRL_T,
	NOS,
	SEA_BEG,
	RPT,
	FNF_MSGFLG,
	TRUN,
	TI_WID,
	SAV_TIWID,
	KPAD,
	WD_WRAP,
	SCLL_TOP,
	SCLL_BOT,
	SCR_LNS,
	CS_LNO,
	SCR_REBUILD,
	US_ENT : VECTOR,
	US_TXT : VECTOR,
	RCOV_MOD,
	DIR_MOD,
	SEL_POS,
	SUMRY,
	PARTYP,
	K_AUTRPT,
	WK_GRTSTBUK,
	FMT_CUR,
	FMT_FREE,
	FMT_WRRUT,
	PA_CURTOK,
	PMT_LINE : VECTOR,
!	PMT_KPD : VECTOR,
!	PMT_NOKPD : VECTOR,
	PMT_HCCHG : VECTOR,
	PMT_INS : VECTOR,
!	PMT_INSN : VECTOR,
	PMT_QUERY : VECTOR,
	FMT_BUF,
	EDT$$TI_WRLN,
	CMD_BUF,
	IOFI_NFND,			! 1 = open failed due to file not found
	WF_DESC : BLOCK [8],
	OPTIONS : BITVECTOR [36];	! Options bits, bit 0 = /RECOVER

    MESSAGES ((INSMEM, INPFILOPN));

    LOCAL
	LEN,
	NEW,
	RETURN_VALUE,
	IO_STS;

    RETURN_VALUE = 1;				! Assume success

!+
! Initialize a lot of variables. This is done by calling CH$FILL to
! copy zeros throughout the data area. (See DATA.BLI)
!-

    AAAAAA = 0;				! Clear the first word
    CH$FILL (0, ZZZZZZ - AAAAAA, CH$PTR (AAAAAA, 0, 36));

    WF_DESC [DSC$W_LENGTH] = 512;
    MOVELINE (LNO_EMPTY, TOP_LN);
    EDIT_MOD = LINE_MODE;
    EDIT_DFLTMOD = LINE_MODE;
    SAV_CNT = 3;
    WORKCOUNT = -1;			! No working message
    LASTMSG = 1;        	        ! No last message
    NOS = 1;
    SEA_BEG = 1;
    RPT = 1;
    TRUN = 1;
    KPAD = 1;
    CTRL_T = 1;
    TI_WID = 80;
    MESSAGE_LINE = 22;
    WD_WRAP = 256;
    SCLL_TOP = 7;
    SCLL_BOT = 14;
    SCR_LNS = 22;

!+
! Set scrolling boundaries to 99 to ensure that they get set the
! first time thru change mode.
!-

    TOP_SCREG = 99;
    BOT_SCREG = 99;
    PRV_LN = 999;
    SEL_POS = NO_SELECT;
    SCR_REBUILD = 1;
    CS_LNO = -1;
    DIR_MOD = 1;
    SUMRY = 1;
    PARTYP = 1;
    K_AUTRPT = 1;
    WK_GRTSTBUK = 1;
    PA_CURTOK = CMD_BUF;

!+
! Parse the initial command line and set recovery mode accordingly.
!-

    EDT$$PA_CMDLN ();
    RCOV_MOD = ((.OPTIONS AND EDT$M_RECOVER) NEQ 0);

!+
! Open the terminal.  If it fails, abort.
!-

    EDT$$TI_OPN ();

!+
! Attempt open first
!-

    FNF_MSGFLG = 1;
    FMT_CUR = CH$PTR (FMT_BUF,, BYTE_SIZE);
    FMT_FREE = FMT_BUFLEN;
    FMT_WRRUT = EDT$$TI_WRLN;
    EDT$$CLR_CC ();

!+
! Make sure the command wasn't CREATE file/NOCREATE
!-

    IF ((.OPTIONS AND EDT$M_NEWFILE) EQL 0)
    THEN
	BEGIN

	IF ((.OPTIONS AND EDT$M_NOCREATE) NEQ 0)
	THEN
	    BEGIN
	    IO_STS = 0;
	    IOFI_NFND = 1;			! Pretend not found error
	    END

!+
! Open the input file if not CREATE command.
!-

	ELSE
	    IO_STS = EDT$FILEIO (EDT$K_OPEN_INPUT, EDT$K_INPUT_FILE, INP_NAM);

	IF ( NOT .IO_STS)
	THEN
	    BEGIN

	    IF .IOFI_NFND
	    THEN
		BEGIN
		RETURN_VALUE = 0;
		IF ((.OPTIONS AND EDT$M_NOCREATE) NEQ 0) THEN RETURN (0);
		END
	    ELSE
		BEGIN
		EDT$$FIOPN_ERR (EDT$_INPFILOPN, INP_NAM);
		RETURN_VALUE = 3;
		END;

	    END
	ELSE
	    INPUT_OPN = 1;			! indicate input file open

	END;

!+
! Set the default prompts. Note that leading <CR><LF> is not needed on TOPS-20.
!-

    PMT_LINE [0] = 1;
    CH$MOVE (1, CH$PTR (UPLIT (%STRING ('*'))),
		CH$PTR (PMT_LINE [1],, BYTE_SIZE));

    PMT_HCCHG [0] = 2;
    CH$MOVE (2, CH$PTR (UPLIT (%STRING ('C', '*'))),
		CH$PTR (PMT_HCCHG [1],, BYTE_SIZE));

    PMT_INS [0] = 12;
    CH$MOVE (12, CH$PTR (UPLIT (%STRING ('            '))),
		 CH$PTR (PMT_INS [1],, BYTE_SIZE));

!   PMT_INSN [0] = 0;
!   PMT_INSN [1] = 0;

    PMT_QUERY [0] = 1;
    CH$MOVE (1, CH$PTR (UPLIT (%STRING ('?'))),
		CH$PTR (PMT_QUERY [1],, BYTE_SIZE));

!   PMT_KPD = 0;
!   PMT_NOKPD = 0;

!+
! Allocate some VM for the string such as page and end text and entity specifications
!-

    LEN = 10;

    IF EDT$$ALO_HEAP (LEN, US_TXT [0])	! end text
    THEN
	BEGIN
	.US_TXT [0] = .LEN - 5;
	CH$MOVE (.LEN - 5, CH$PTR (UPLIT (%STRING ('[EOB]'))),
		CH$PTR (.US_TXT [0] + 1,, BYTE_SIZE));
	END
    ELSE
	BEGIN
	EDT$$FMT_MSG (EDT$_INSMEM);
	RETURN (3);
	END;

    LEN = 9;

    IF EDT$$ALO_HEAP (LEN, US_TXT [1])	! page text
    THEN
	BEGIN
	.US_TXT [1] = .LEN - 5;
	CH$MOVE (.LEN - 5, CH$PTR (UPLIT (%STRING ('<FF>'))),
		CH$PTR (.US_TXT [1] + 1,, BYTE_SIZE));
	END
    ELSE
	BEGIN
	EDT$$FMT_MSG (EDT$_INSMEM);
	RETURN (3);
	END;

    LEN = 11;

    IF EDT$$ALO_HEAP (LEN, US_ENT [0])	! word entity
    THEN
	BEGIN
	.US_ENT [0] = .LEN - 5;
	CH$MOVE (.LEN - 5, CH$PTR (UPLIT (%STRING (' ', %CHAR( 9, 10, 11, 12, 13)))),
		CH$PTR (.US_ENT [0] + 1,, BYTE_SIZE));
	END
    ELSE
	BEGIN
	EDT$$FMT_MSG (EDT$_INSMEM);
	RETURN (3);
	END;

    LEN = 8;

    IF EDT$$ALO_HEAP (LEN, US_ENT [1])	! sent entity
    THEN
	BEGIN
	.US_ENT [1] = .LEN - 5;
	CH$MOVE (.LEN - 5, CH$PTR (UPLIT (%STRING ('.', '!', '?'))),
		CH$PTR (.US_ENT [1] + 1,, BYTE_SIZE));
	END
    ELSE
	BEGIN
	EDT$$FMT_MSG (EDT$_INSMEM);
	RETURN (3);
	END;

    LEN = 7;

    IF EDT$$ALO_HEAP (LEN, US_ENT [2])	! sect entity
    THEN
	BEGIN
	.US_ENT [2] = .LEN - 5;
	CH$MOVE (.LEN - 5, CH$PTR (UPLIT (%CHAR (13, 13))),
		CH$PTR (.US_ENT [2] + 1,, BYTE_SIZE));
	END
    ELSE
	BEGIN
	EDT$$FMT_MSG (EDT$_INSMEM);
	RETURN (3);
	END;

    LEN = 6;

    IF EDT$$ALO_HEAP (LEN, US_ENT [3])	! page entity
    THEN
	BEGIN
	.US_ENT [3] = .LEN - 5;
	CH$MOVE (.LEN - 5, CH$PTR (UPLIT (%CHAR (12))),
		CH$PTR (.US_ENT [3] + 1,, BYTE_SIZE));
	END
    ELSE
	BEGIN
	EDT$$FMT_MSG (EDT$_INSMEM);
	RETURN (3);
	END;

!+
! Save the terminal width gotten from the operating system
!-

    SAV_TIWID = .TI_WID;

!+
! Open the workfile.  If it fails, abort.
!-

    EDT$$WF_OPN ();

!+
! Open the paste text buffer.
!-

    IF ( NOT EDT$$FND_BUF (CH$PTR (UPLIT ('PASTE')), 5))
    THEN
	BEGIN
	EDT$$FMT_MSG (EDT$_INSMEM);
	RETURN (3);
	END;

    PST_BUF = .CUR_BUF;

!+
! And the MAIN text buffer.
!-

    IF ( NOT EDT$$GET_BUFPTR (CH$PTR (UPLIT ('MAIN')), 4, CUR_BUF, NEW))
    THEN
	BEGIN
	EDT$$FMT_MSG (EDT$_INSMEM);
	RETURN (3);
	END;

    PRV_BUF = .CUR_BUF;

    IF .INPUT_OPN THEN CUR_BUF [TBCB_INPUT_RAB] = 1;

    EDT$$NEW_BUF ();

    RETURN (.RETURN_VALUE);
    END;					! of routine EDT$$INIT


END
ELUDOM