! ! ! 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 !-- ! !++ ! ! 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. ! !-- ! ! ! 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'; ! ! ! ! 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 %; ! 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 %; ! ! ! 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)); ! 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 ! !-- ! 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 ! !+ ! 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