Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0172/blft20.bli
There is 1 other file named blft20.bli in the archive. Click here to see a list.
!<BLF/lowercase_user>
!<BLF/uppercase_key>
!<BLF/macro>
MODULE cli20 ( !
IDENT = '8.3',
ENVIRONMENT (bliss36c_ots) ,
LINKAGE (bliss36c)
) =
BEGIN
!++
! Facility: BLISS Formatter
!
! Abstract: This module contains the command scanner for PRETTY,
! running under TOPS-20.
!
!
! Environment: XPORT/TOPS-20
!
!
! REVISION HISTORY
!
! 5-Feb-82 TT Output and listing file extensions weren't
! being defaulted if only file names were
! explicitly supplied.
!
! 15-Feb-82 TT Add code that prints nothing unless user
! has specified /LOG. While I was here, cleaned
! up a lot of extra code about files. Instead
! of explicitly moving character strings, use
! Xport IOB parameters to pick up various
! defaults and the like.
!
! 25-Feb-82 TT Moved anouncement of version to here from
! Format. Format hasn't parsed the command line
! at the point it was outputting, so you couldn't
! tell whether or not /LOG had been specified.
! The parse in here checks. Also, we can verify
! the the message is output only once much easier
! when the code resides here.
!
! END OF REVISION HISTORY
!--
!<BLF/PAGE>
!++
!
! Extended description:
!
! 'CLI$OPEN' is the main entry point, and is called from FORMAT.
! PARSE_ATOM is called by cli$open to parse the next field on the command line.
! The possibilities are given in cmdfdb_fdb, and the switches are listed in
! switab. PARSE_ATOM makes calls on lower level routines to perform certain
! actions. In most cases, PARSE_ATOM returns the status (normal, endcmd,
! reparse, or noparse) that was returned from a lower level routine, or
! inferred from a call on the COMND JSYS. 'Normal' status is used when an
! input has been correctly parsed. 'Endcmd' is used when the COMND JSYS
! returns a CMCFM status, meaning the user typed a carriage return.
! 'Reparse' is returned when the user has backspaced over input that has been
! already correctly parsed, in which case, the line is completely reparsed.
! 'Noparse' status is returned when the COMND JSYS fails to parse the given
! input. Typing a backspace (^H) will cause the line to be reparsed up to,
! but not including, the atom that caused the error.
!
!--
!<BLF/PAGE>
!
! Table of contents:
!
FORWARD ROUTINE
cli$open, ! Command scanner
cmd_msg : NOVALUE, ! Command line message
init_line : NOVALUE, ! Init everything
new_outfil, ! Parse a new OUTPUT file spec
parse_atom, ! Parse next on command line
process_switch : NOVALUE, ! Handle switch contents
reparse_setup : NOVALUE, ! Init for automatic reparse
setup : NOVALUE; ! Init COMND JSYS
!
! Include files:
!
LIBRARY 'MONSYM';
UNDECLARE $CHLFD, $CHCRT; ! Monsym/Tendef each declare these.
LIBRARY 'TENDEF';
REQUIRE 'BLFMAC.REQ';
!<BLF/PAGE>
!
!
! Macros:
!
MACRO
clearcore (baseadr, lenth) =
setcore (baseadr, lenth, 0) %;
MACRO
movecore (src, dst, lenth) =
%IF %BLISS (BLISS36)
%THEN
BEGIN
BUILTIN
machop;
LITERAL
blt = %O'251';
REGISTER
rqqq,
sqqq;
rqqq<18, 18> = (src);
rqqq<0, 18> = (dst);
sqqq = (dst) + (lenth);
machop (blt, rqqq, -1, sqqq)
END
%ELSE
CH$MOVE ((lenth)*%UPVAL, src, dst)
%FI
%;
MACRO
setcore (baseadr, lenth, const) =
%IF %BLISS (BLISS36)
%THEN
BEGIN
BUILTIN
machop;
LITERAL
blt = %O'251';
REGISTER
rqqq,
sqqq;
sqqq = (baseadr);
(.sqqq) = (const);
IF (lenth) NEQ 1
THEN
BEGIN
rqqq<18, 18> = .sqqq<0, 18>;
rqqq<0, 18> = .sqqq<0, 18>;
rqqq = .rqqq + 1;
sqqq = .sqqq + (lenth);
machop (blt, rqqq, -1, sqqq);
END;
END
%ELSE
CH$FILL (const, (lenth)*%UPVAL, baseadr)
%FI
%;
!<BLF/page>
MACRO
haltf_jsys =
BEGIN
BUILTIN
jsys;
jsys (0, haltf);
END
%;
MACRO
jsys_macro (code_, jsys_num, ac1, ac2, ac3, ac4, ac5) =
BEGIN
REGISTER
R1 = 1,
R2 = 2,
R3 = 3,
R4 = 4,
R5 = 5;
LOCAL
val;
BUILTIN
jsys;
%IF NOT %NULL (ac1)
%THEN
R1 = .ac1;
%FI
%IF NOT %NULL (ac2)
%THEN
R2 = .ac2;
%FI
%IF NOT %NULL (ac3)
%THEN
R3 = .ac3;
%FI
%IF NOT %NULL (ac4)
%THEN
R4 = .ac4;
%FI
%IF NOT %NULL (ac5)
%THEN
R5 = .ac5;
%FI
val = jsys ((code_), (jsys_num), R1, R2, R3, R4, R5);
%IF NOT %NULL (ac1)
%THEN
%IF %DECLARED (ac1)
%THEN
ac1 = .R1;
%FI
%FI
%IF NOT %NULL (ac2)
%THEN
%IF %DECLARED (ac2)
%THEN
ac2 = .R2;
%FI
%FI
%IF NOT %NULL (ac3)
%THEN
%IF %DECLARED (ac3)
%THEN
ac3 = .R3;
%FI
%FI
%IF NOT %NULL (ac4)
%THEN
%IF %DECLARED (ac4)
%THEN
ac4 = .R4;
%FI
%FI
%IF NOT %NULL (ac5)
%THEN
%IF %DECLARED (ac5)
%THEN
ac5 = .R5;
%FI
%FI
.val
END
%;
MACRO
rh (addr) =
(addr)<0, 18> %,
lh (addr) =
(addr)<18, 18> %;
MACRO
mask (o, p, s, e) =
((1^s) - 1)^p %;
MACRO
tb (str, cod) =
(UPLIT (%ASCIZ str)^18) OR cod %;
!<BLF/page>
!
! Equated symbols:
!
LITERAL
true = 1 EQL 1,
false = 1 NEQ 1;
LITERAL
!+
! Status codes returned from routines using COMND JSYS
!-
normal = 0, ! Correct parse
noparse = 1, ! Incorrect parse
reparse = 2, ! User backspaced over correctly parsed prefix
endcmd = 3; ! User typed carriage return
LITERAL
in = 0,
out = 1;
LITERAL
filename_length = 50,
fnl = CH$ALLOCATION (filename_length),
len_cmd_buf = 132;
!
! Own storage:
!
OWN
cmd_blk : VECTOR [$cmgjb + 1]; ! Command state block
! Cf. TOPS-20 Monitor Calls Manual, p. 3-25
OWN
exited : INITIAL (false), ! Set to true if /EXIT switch found
in_length : INITIAL (0),
in_filespec : VECTOR [fnl],
out_length : INITIAL (0),
out_filespec : VECTOR [fnl],
list_length : INITIAL (0),
list_filespec : VECTOR [fnl];
GLOBAL
in_okay,
out_okay,
log_flag,
list_okay;
OWN
cmd_buf : VECTOR [CH$ALLOCATION (len_cmd_buf)], ! Command line buffer
cmd_abf : VECTOR [CH$ALLOCATION (len_cmd_buf)], ! Command atom buffer
cmd_gjb : VECTOR [$gjbfp + 1], ! GTJFN block
defname : VECTOR [fnl], ! Default name
def_ext : VECTOR [CH$ALLOCATION (3)] INITIAL ('BLI'); ! Default extension
LITERAL
num_sw = 5, ! Count of following switches
sw_exit = 1,
sw_list = 2,
sw_output = 3,
sw_log = 4,
sw_nolog = 5;
OWN
!++
! NOTE: The entries in this table must be in alphabetical order
! to guarantee that COMND jsys does a complete table search.
!--
switab : VECTOR [num_sw + 1] INITIAL (
num_sw^18 OR num_sw + 1, !
tb ('EXIT', sw_exit), !
tb ('LISTING:', sw_list), !
tb ('LOG', sw_log),
tb ('NOLOG', sw_nolog),
tb ('OUTPUT:', sw_output));
!<BLF/PAGE>
OWN
!+
! COMND JSYS Function descriptor blocks
!-
cmdfd4_fdb : flddb$ (typ = $cmcfm),
cmdfd3_fdb : flddb$ (typ = $cmcma, lst = cmdfd4_fdb),
cmdfd2_fdb : flddb$ (typ = $cmswi, data = switab, lst = cmdfd3_fdb),
cmdfdb_fdb : flddb$ (typ = $cmfil, flgs = cm_sdh, hlpm = 'Input file specification', lst = cmdfd2_fdb),
cmfil_fdb : flddb$ (typ = $cmfil),
cmini_fdb : flddb$ (typ = $cmini),
!+
! Output file function descriptor blocks
!-
out_fdb : flddb$ (typ = $cmfil, flgs = cm_sdh, hlpm = 'Output file specification'),
lst_fdb : flddb$ (typ = $cmfil, flgs = cm_sdh, hlpm = 'Listing file specification');
GLOBAL
in_iob : $xpo_iob (),
out_iob : $xpo_iob (),
list_iob : $xpo_iob (),
req_iob : $xpo_iob (),
tty_iob : $xpo_iob ();
EXTERNAL ROUTINE
xiob,
lst$file : NOVALUE,
out$file : NOVALUE;
GLOBAL ROUTINE cli$open = !
!++
! Functional description:
!
! This routine is called from FORMAT to parse
! a TOPS-20 command line.
!
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! 0 = open O.K., 1 = ctrl-z (in effect) was detected
!
! Side effects:
!
! None
!
!--
BEGIN
OWN
once : INITIAL (FALSE);
IF .exited
THEN
BEGIN
exited = false;
haltf_jsys;
END;
init_line (); ! Initialize state
log_flag = false;
WHILE 1 DO
CASE parse_atom () FROM normal TO endcmd OF
SET
[endcmd] :
BEGIN
IF .log_flag AND NOT .once
THEN
BEGIN
msg ('PRETTY version 8.2');
once = true;
END;
in_okay = out_okay = list_okay = false;
$xpo_iob_init (
file_spec = (.in_length, CH$PTR (in_filespec)),
default = '.BLI',
options = input,
iob = in_iob);
IF $xpo_open (iob = in_iob,
failure = 0)
THEN
in_okay = true
ELSE
BEGIN
msg ('? Cannot open input file');
RETURN true;
END;
! ALWAYS output on the /20. Default is to the input file.
$xpo_iob_init (
file_spec = (.out_length, CH$PTR (out_filespec)),
related = in_iob [iob$t_resultant],
options = output,
iob = out_iob);
IF $xpo_open (iob = out_iob,
failure = 0)
THEN
out_okay = true
ELSE
BEGIN
msg ('? Cannot open output file');
RETURN true;
END;
IF .list_length GTR 0
THEN
BEGIN
$xpo_iob_init (
file_spec = (.list_length, CH$PTR (list_filespec)),
related = in_iob [iob$t_resultant],
default = '.LST',
options = output,
iob = list_iob);
IF $xpo_open (iob = list_iob,
failure = 0)
THEN
list_okay = true
ELSE
BEGIN
msg ('? Cannot open listing file');
RETURN true;
END
END;
out$file (true);
lst$file (.list_length);
RETURN false; ! False means no ctrl-z
END;
[reparse] : ! User backspaced over parsed input
reparse_setup ();
[noparse] : ! Error in command line
setup ();
[normal] : ! Try for another one
;
TES;
END; ! End of routine 'CLI$OPEN'
ROUTINE cmd_msg (amsg) : NOVALUE =
!++
! Functional description:
!
! This routine prints out to the primary output device, the
! ASCIZ string AMSG.
!
! Formal parameters:
!
! AMSG - Character pointer to an ASCIZ string.
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
LOCAL
t1,
t2; !
t1 = $priou;
jsys_macro (0, rfpos, t1, t2);
IF .t2 NEQ 0
THEN
BEGIN
t1 = CH$PTR (UPLIT (%ASCIZ %CHAR (13, 10)));
jsys_macro (0, psout, t1);
END;
t1 = CH$PTR (UPLIT (%ASCIZ'? Command syntax error: '));
jsys_macro (0, psout, t1);
t1 = .amsg;
jsys_macro (0, psout, t1);
t1 = CH$PTR (UPLIT (%ASCIZ %CHAR (13, 10))); ! CRLF
jsys_macro (0, psout, t1);
END; ! End of routine 'CMD_MSG'
ROUTINE init_line : NOVALUE = !
!++
! Functional description:
!
! Initialize the command state block for the COMND JSYS
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! cmd_blk
!
! Routine value:
!
! None
!
! Side effects:
!
! Prompt user
!
!--
BEGIN
cmd_blk [$cmflg] = 0;
cmd_blk [$cmioj] = $priin^18 + $priou; ! I/O to primary channels
cmd_blk [$cmrty] = CH$PTR (UPLIT (%ASCIZ'BLF>')); ! Prompt
cmd_blk [$cmbfp] = CH$PTR (cmd_buf); ! Command buffer
cmd_blk [$cmptr] = CH$PTR (cmd_buf); ! Next field
cmd_blk [$cmcnt] = len_cmd_buf; ! Length of buffer
cmd_blk [$cmabc] = len_cmd_buf; ! Atom buffer length
cmd_blk [$cmabp] = CH$PTR (cmd_abf); ! Atom buffer
cmd_blk [$cminc] = 0; ! Number of unparsed characters
cmd_blk [$cmgjb] = cmd_gjb; ! Get JFN block
setup (); ! Do CMINI function
END; ! End of routine 'INIT_LINE'
ROUTINE new_outfil (comnd_sts, flags, ext, fdb, glob_spec) =
!++
! Functional description:
!
! This routine is called to parse a file spec following
! a ":" for a number of switches. The file is assumed
! to be a new output file.
!
! Formal parameters:
!
! COMND_STS - status returned from last COMND JSYS call
! FLAGS - identify which option recognized
! EXT - default file extension to be used for recognition
! FDB - function descriptor block to COMND JSYS
! GLOB_SPEC - address of buffer to hold filespec
!
! Implicit inputs:
!
! DEFNAME
! DEF_EXT
!
! Implicit outputs:
!
!
! Routine value:
!
! ENDCMD - Command completed
! NOPARSE - User error in command line
! REPARSE - User backspaced over already parsed input
! NORMAL - Processed a legal atom
!
! Side effects:
!
! None
!
!--
BEGIN
LOCAL
t1,
t2,
t3;
IF (.comnd_sts AND (cm_swt OR cm_esc)) EQL 0 THEN RETURN normal;
!+
! Colon was seen. Clear GTJFN block,
! Issue COMND JSYS to get filename, copy file spec
! into appropriate global location.
!-
clearcore (cmd_gjb, $gjbfp + 1);
cmd_gjb [$gjgen] = gj_fou; ! *** CHECK THIS FOR ERROR ***
IF .defname NEQ 0 THEN cmd_gjb [$gjnam] = CH$PTR (defname);
cmd_gjb [$gjext] = CH$PTR (.ext);
t1 = cmd_blk;
t2 = .fdb;
jsys_macro (0, comnd, t1, t2, t3);
IF (.t1 AND cm_rpt) NEQ 0 THEN RETURN reparse;
IF (.t1 AND cm_nop) NEQ 0
THEN
BEGIN
cmd_msg (CH$PTR (UPLIT (%ASCIZ'Expecting file spec following switch')));
RETURN noparse;
END;
movecore (cmd_abf, .glob_spec, fnl);
RETURN normal;
END; ! End of routine 'NEW_OUTFIL'
ROUTINE parse_atom = !
!++
! Functional description:
!
! Here the next file specification, comma, switch, or confirmation
! is expected. The handling of input files is somewhat complex:
! The initial COMND is done with GJ%OLD set so that
! recognition is possible. If this call fails, then we will
! retry with GJ%OFG set to accept any syntactically valid
! file specification.
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! ENDCMD - Command completed
! NOPARSE - User error in command line
! REPARSE - User backspaced over already parsed input
! NORMAL - Processed a legal atom
!
! Side effects:
!
! None
!
!--
!<BLF/PAGE>
BEGIN
LOCAL
t1, ! Each t models a register
t2,
t3,
t4,
function_code,
flags;
clearcore (cmd_gjb, $gjbfp + 1);
cmd_gjb [$gjgen] = gj_old;
t1 = cmd_blk;
t2 = cmdfdb_fdb; ! Function descriptor block
jsys_macro (0, comnd, t1, t2, t3);
IF (.t1 AND cm_rpt) NEQ 0 THEN RETURN reparse; ! Reparse needed
IF (.t1 AND cm_nop) NEQ 0
THEN
BEGIN ! Parse failed
LOCAL
p; ! Current input pointer
!+
! Obtain current input pointer. Noparse if pointer hasn't moved
! (THIS IS TEMPORARY HACK DUE TO BUG IN COMND JSYS)
!-
p = .cmd_blk [$cmptr];
clearcore (cmd_gjb, $gjbfp + 1);
cmd_gjb [$gjgen] = gj_ofg; ! Parse only
t1 = cmd_blk;
t2 = cmfil_fdb;
jsys_macro (0, comnd, t1, t2, t3);
IF ((.t1 AND cm_nop) NEQ 0) OR ! Parse failed or
(.p EQL .cmd_blk [$cmptr]) ! Pointer hasn't advanced
THEN
BEGIN
cmd_msg (CH$PTR (UPLIT (%ASCIZ'Expecting file spec, switch, comma, or CR')));
RETURN noparse;
END;
END; ! Parse failed
!<BLF/PAGE>
!+
! Legal input has been parsed. Dispatch to
! appropriate handler. Obtain the function code
! from the function descriptor block that matched
! the parsed input.
!-
function_code = .pointr ((.t3 + $cmfnp), cm_fnc);
SELECTONE .function_code OF
SET
[$cmcma] :
!+
! Comma. No action
!-
RETURN normal;
[$cmcfm] :
!+
! Confirmation
!
! Error if no input file spec. Otherwise,
! Release JFN's since files will be opened elsewhere.
! Apply defaults to unspecified switches.
!-
BEGIN ! Confirmation
IF .in_length EQL 0
THEN
BEGIN
IF .exited
THEN
BEGIN
exited = false;
haltf_jsys;
END
ELSE
BEGIN
cmd_msg (CH$PTR (UPLIT (%ASCIZ'No input files')));
END;
init_line (); ! Start again
RETURN normal;
END;
t1 = -1;
!+
! It is just possible that this rljfn might fail...
!-
jsys_macro (-1, rljfn, t1);
RETURN endcmd;
END;
[$cmswi] :
!+
! switch : either /OUTPUT: or /LISTING:
! (followed by a filename)
!-
process_switch (.t2, .t1);
[$cmfil] :
!+
! Process the file spec. If this is the input file spec,
! save the filename to establish the default filenames
! for the listing and output files.
!-
BEGIN
IF .defname EQL 0
THEN
BEGIN
t1 = CH$PTR (defname); ! T2 contains the JFN
t3 = fld ($jsaof, js_nam);
jsys_macro (0, jfns, t1, t2, t3);
t1 = CH$PTR (def_ext);
t3 = fld ($jsaof, js_typ);
jsys_macro (0, jfns, t1, t2, t3);
END;
movecore (cmd_abf, in_filespec, fnl);
in_length = filename_length; ! ASCIZ, so actual length not needed
RETURN normal;
END;
TES;
END; ! End of routine 'PARSE_ATOM'
ROUTINE process_switch (action_ptr, comnd_sts) : NOVALUE = !
!++
! Functional description:
!
! Called to perform all actions associated with a switch
!
! Formal parameters:
!
! ACTION_PTR - represents the switch to be processed
! a pointer to an entry in SWITAB
! COMND_STS - Status returned from COMND JSYS
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! ENDCMD - command completed
! NOPARSE - user error in command line
! REPARSE - user backspaced over already parsed input
! NORMAL - processed a legal atom
!
! Side effects:
!
! None
!
!--
BEGIN
LOCAL
function_code, ! action to be performed
t1,
t2,
t3;
CASE .rh (.action_ptr) FROM sw_exit TO num_sw OF
SET
[sw_output] :
!+
! Processor for /OUTPUT switch
!-
BEGIN
out_length = fnl;
IF .def_ext EQL 0 THEN CH$MOVE (4, CH$PTR (UPLIT (%ASCIZ'BLI')), CH$PTR (def_ext));
RETURN new_outfil (.comnd_sts, sw_output, def_ext, out_fdb, out_filespec);
END;
[sw_list] :
!+
! Processor for /LISTING switch
!-
BEGIN
list_length = fnl;
RETURN new_outfil (.comnd_sts, sw_list, UPLIT (%ASCIZ'LST'), lst_fdb, list_filespec);
END;
[sw_exit] :
BEGIN
exited = true;
RETURN normal;
END;
[sw_log] :
BEGIN
log_flag = true;
RETURN normal;
END;
[sw_nolog] :
BEGIN
log_flag = false;
RETURN normal;
END;
TES;
END; ! End of routine 'PROCESS_SWITCH'
ROUTINE reparse_setup : NOVALUE = !
!++
! Functional description:
!
! Set up to start the command line.
! Come here if the user backspaces over text already
! parsed, and reparse the line.
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
LOCAL
t1;
t1 = -1;
IF NOT jsys_macro (-1, rljfn, t1) THEN RETURN true; ! Quit
def_ext = defname = 0; ! Clear default filenameand ext
in_length = 0;
clearcore (in_filespec, fnl);
out_length = 0;
clearcore (out_filespec, fnl);
list_length = 0;
clearcore (list_filespec, fnl);
exited = false;
END; ! End of routine 'REPARSE_SETUP'
ROUTINE setup : NOVALUE =
!+
! Functional description:
!
! Come here to initialize for COMND JSYS.
! Also, we have to reinitialize each time the
! user makes an error typing the command line.
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
LOCAL
t1,
t2,
t3;
t1 = cmd_blk;
t2 = cmini_fdb;
jsys_macro (0, comnd, t1, t2, t3);
reparse_setup (); ! Prepare to reparse command line
END; ! End of routine 'SETUP'
%SBTTL 'Last page of CLI20.BLI'
END ! End of module CLI20
ELUDOM