Module SEDT ( Ident = '1.0-2', %Title 'DCL interface to Screen EDiTor' Main = SEDT$MAIN ) = Begin Macro Version_Number = 'T1.0-2' %; Psect Plit = $PLIT$ ( addressing_mode( long_relative ) ); !+++ ! ! Abstract: ! ! This module is the DCL interface to the callable screen editor. ! ! Author: ! ! Ralph R. Swick, ECS Technical Support, MRO3-2/E11 ! 24-Feb-83 ! !--- Library 'Sys$Library:Starlet'; Library 'Sys$Library:Tpamac'; External routine Lib$Attach: addressing_mode( general ), Lib$Get_Foreign: addressing_mode( general ), Lib$Get_Symbol: addressing_mode( general ), Lib$Set_Symbol: addressing_mode( general ), Lib$Tparse: addressing_mode( general ), Str$Upcase: addressing_mode( general ), SEDT: addressing_mode( general ), SEDTpurg: addressing_mode( general ), SEDTrest: addressing_mode( general ); %Sbttl 'Command Description' !++ ! ! SEDT [filespec] ! [/OUTPUT=filespec] ! [/TERMINAL_TYPE=VT52 | VT100 | VK100 | VT102 ! VT200 | IDENTIFY] ! !-- %Sbttl 'Table of Contents' Forward routine Identify_Terminal, SEDT$Main, SEDT$_Set_Recover, SEDT$_Store_Terminal; %Sbttl 'Constants' Literal Input_buffer_size = 512, ! maximum length of mailbox msg TTY_buffer_size = 24; ! maximum length of inquire terminal type response Macro Escape = %Char(27) %; Macro CSI = %Char(155) %; Macro Type( string, length, carriage_control ) = $Qiow( chan = .tty_channel, func = io$_writevblk, %If %Null( length ) %Then p1 = uplit( string ), p2 = %CharCount( string ) %Else p1 = string, p2 = length %Fi %If not %Null( carriage_control ) %Then , p4 = carriage_control %Fi ) %; %Sbttl 'Literals and Structures' External literal ! Message numbers Lib$_syntaxerr; Field iosb = set iosb$w_status = [0, 0, 16, 0], iosb$w_termoffset = [0, 16, 16, 0], iosb$w_termchar = [1, 0, 16, 0], iosb$w_termlen = [1, 16, 16, 0], iosb$l_senderid = [1, 0, 32, 0], iosb$b_termchar = [1, 0, 8, 0] tes; Literal iosb_length = 2; Literal Sedt$_continue = 1, Terminal_ident = -1, Terminal_vt52 = 0, Terminal_vt100 = 1, Terminal_vt200 = 4, Terminal_vt102 = 3, Terminal_vt125 = 1, Terminal_vk100 = 2; %Sbttl 'OWN storage' Psect Own = $OWN$ ( addressing_mode( long_relative ) ); Own Input_Buffer: block[input_buffer_size, byte], Command_file_desc: block[8, byte] preset( [dsc$w_length] = 0, [dsc$a_pointer] = input_buffer ), Entire_workingset: vector[2, long] preset( [0] = 0, [1] = %x'7fffffff' ), File_Access_Block: $Fab(), Input_desc: block[8, byte] preset( [dsc$w_length] = 0, [dsc$a_pointer] = input_buffer ), Input_length: word, Input_Upcase_buffer: block[input_buffer_size, byte], Input_file_desc: block[8, byte], Make_Subprocess: initial( 0 ), Output_file_desc: block[8, byte] preset( [dsc$w_length] = 0, [dsc$a_pointer] = input_buffer ), Parent_pid, Spawned_pid, Spawned_process: initial( 0 ), Recover_Flag: initial( 0 ), Terminal_type: initial( terminal_ident ); %Sbttl 'Parser state table' $Init_State( Command_State, Command_Keywords ); $State( Command_PreOption_State, ( (file_specification), , , , Input_file_desc ), ( (command_option),Command_PreOption_State ), ( tpa$_eos, tpa$_exit ) ); $State( Command_PostOption_State, ( tpa$_eos, tpa$_exit ), ( (command_option), Command_PostOption_State ) ); $State( Command_Option, ( '/' ) ); $State( , ( 'COMMAND', Option_Command_State ), ( 'OUTPUT', Option_Output_State ), ( 'PARENT', Option_Parent_State , , 1, Spawned_Process ), ( 'TERMINAL_TYPE', Option_Terminal_State ), ( 'RECOVER', Tpa$_Exit, SEDT$_Set_Recover, , , 1) ); $State( Option_Command_State, ( '=' ), ( ':' ) ); $State( , ( (file_specification), tpa$_exit, , , Command_File_desc ) ); $State( Option_Output_State, ( '=' ), ( ':' ) ); $State( , ( (file_specification), tpa$_exit, , , Output_File_desc ) ); $State( Option_Parent_State, ( '=' ), ( ':' ) ); $State( , ( tpa$_hex, tpa$_exit, , , Parent_pid ) ); $State( Option_Terminal_State, ( '=' ), ( ':' ) ); $State( , ( 'IDENTIFY', tpa$_exit, SEDT$_Store_Terminal, , , Terminal_ident ), ( 'VT102', tpa$_exit, SEDT$_Store_Terminal, , , Terminal_vt102 ), ( 'VK100', tpa$_exit, SEDT$_Store_Terminal, , , Terminal_vk100 ), ( 'VT100', tpa$_exit, SEDT$_Store_Terminal, , , Terminal_vt100 ), ( 'VT200', tpa$_exit, SEDT$_Store_Terminal, , , Terminal_vt200 ), ( 'VT125', tpa$_exit, SEDT$_Store_Terminal, , , Terminal_vt125 ), ( 'VT52', tpa$_exit, SEDT$_Store_Terminal, , , Terminal_vt52 ) ); Require 'tpafile.req'; %Sbttl 'SEDT$Main' Routine SEDT$Main = !++ ! ! Functional Description: ! ! This is the SEDT entry point. Everything happens here. ! ! Inputs: ! ! Foreign command line from DCL. ! ! Outputs: ! ! none. ! ! Side effects: ! ! Calls SEDT. ! !-- Begin Local Status, Tparse_block: block[tpa$c_length0, byte]; Input_desc[dsc$b_class] = dsc$k_dtype_z; Input_desc[dsc$w_length] = input_buffer_size; Input_desc[dsc$a_pointer] = input_buffer; If not (status = Lib$Get_Foreign( Input_Desc, $descriptor( '$_File: ' ), Input_length ) ) then $Exit( code = .status ); Tparse_block[tpa$l_count] = tpa$k_count0; Tparse_block[tpa$l_options] = tpa$m_abbrev; Tparse_block[tpa$l_stringcnt] = .input_length; Tparse_block[tpa$l_stringptr] = input_upcase_buffer; Str$Upcase( tparse_block[tpa$l_stringcnt], input_desc); If not( status = Lib$tparse( tparse_block, command_state, command_keywords ) ) then If .status eqlu lib$_syntaxerr then begin Local Message_vector: vector[2, long], TTY_channel; Message_vector[0] = 2; Message_vector[1] =.status; $Putmsg( msgvec = message_vector ); $Assign( chan = tty_channel, devnam = $descriptor( 'SYS$COMMAND:' ) ); Type( input_buffer, .tparse_block[tpa$l_tokenptr] - input_upcase_buffer, %x'00010000' ); Type( '\' ); Type( .tparse_block[tpa$l_tokenptr] - input_upcase_buffer + input_buffer, .tparse_block[tpa$l_tokencnt] ); Type( '\' ); Type( .tparse_block[tpa$l_tokenptr] - input_upcase_buffer + input_buffer + .tparse_block[tpa$l_tokencnt], .tparse_block[tpa$l_stringcnt] - .tparse_block[tpa$l_tokencnt], %x'01000000' ); $Exit( code = lib$_syntaxerr + sts$m_inhib_msg ) end else $Exit( code = .status ); If .input_file_desc[dsc$w_length] neq 0 then begin File_Access_Block[fab$b_fns] = (.input_file_desc[dsc$w_length])<0,8>; File_Access_Block[fab$l_fna] = .input_file_desc[dsc$a_pointer]; If not (status = $Parse( fab = file_access_block ) ) then $Exit( code = .status ) end; If .output_file_desc[dsc$w_length] neq 0 then begin File_Access_Block[fab$b_fns] = (.output_file_desc[dsc$w_length])<0,8>; File_Access_Block[fab$l_fna] = .output_file_desc[dsc$a_pointer]; If not (status = $Parse( fab = file_access_block ) ) then $Exit( code = .status ) end; If .command_file_desc[dsc$w_length] neq 0 then begin File_Access_Block[fab$b_fns] = (.command_file_desc[dsc$w_length])<0,8>; File_Access_Block[fab$l_fna] = .command_file_desc[dsc$a_pointer]; If not (status = $Parse( fab = file_access_block ) ) then $Exit( code = .status ) end; If .terminal_type eql terminal_ident then Identify_Terminal(); Status = Sedt( input_file_desc[dsc$w_length], ( If .input_file_desc[dsc$w_length] gtr 0 then .input_file_desc[dsc$a_pointer] else input_buffer ), output_file_desc[dsc$w_length], .output_file_desc[dsc$a_pointer], terminal_type, command_file_desc[dsc$w_length], .command_file_desc[dsc$a_pointer], Recover_Flag ); While .spawned_process and .status eql sedt$_continue Do begin $Purgws( inadr = entire_workingset ); If not (status = Lib$Attach( parent_pid ) ) then $Exit( code = .status ); input_file_desc[dsc$w_length]=0; output_file_desc[dsc$w_length]=0; command_file_desc[dsc$w_length]=0; recover_flag=0; Status = Sedtrest( input_file_desc[dsc$w_length], ( If .input_file_desc[dsc$w_length] gtr 0 then .input_file_desc[dsc$a_pointer] else input_buffer ), output_file_desc[dsc$w_length], .output_file_desc[dsc$a_pointer], command_file_desc[dsc$w_length], .command_file_desc[dsc$a_pointer] ) end; Sedtpurg() end; %Sbttl 'Identify_Terminal' Routine Identify_Terminal = !++ ! ! Functional Description: ! ! Inquires terminal type. ! ! Inputs: ! ! none. ! ! Outputs: ! ! Terminal_Type ! ! Side effects: ! ! Clears terminal type-ahead buffer. ! !-- Begin Local Status, TTY_buffer: block[tty_buffer_size, byte], TTY_channel, TTY_iosb: block[iosb_length, long] field( iosb ); If not( status = $Assign( chan = tty_channel, devnam = $descriptor( 'SYS$COMMAND' ) ) ) then $Exit( code = .status ); $Qiow( chan = .tty_channel, func = io$_readvblk+io$m_noecho+io$m_timed, p1 = tty_buffer, p2 = tty_buffer_size, p3 = 0 ); ! Clear any type-ahead If ( ss$_timeout neq $Qiow( chan = .tty_channel, func = io$_readprompt+io$m_escape+io$m_noecho+io$m_timed, iosb = tty_iosb, p1 = tty_buffer, p2 = tty_buffer_size, p3 = 2, p5 = uplit( %String( Escape, 'Z' ) ), p6 = 2 ) ) then If ch$eql( 3, uplit( %string( Escape, '/Z' ) ), min( 3, .tty_iosb[iosb$w_termlen] ) , tty_buffer+.tty_iosb[iosb$w_termoffset], %x'20' ) then begin Terminal_type = terminal_vt52; $Dassgn( chan = .tty_channel ); Return ss$_normal end; $Qiow( chan = .tty_channel, func = io$_readprompt+io$m_escape+io$m_noecho+io$m_timed, iosb = tty_iosb, p1 = tty_buffer, p2 = tty_buffer_size, p3 = 2, p5 = uplit( %String( Escape, '[c' ) ),! Inquire terminal type p6 = 3 ); If ch$eql( 7, uplit( %string( Escape, '[?5;0c' ) ), min( 7, .tty_iosb[iosb$w_termlen] ) , tty_buffer+.tty_iosb[iosb$w_termoffset], %x'20' ) then Terminal_type = terminal_vk100 else If ch$eql( 5, uplit( %string( Escape, '[?1;' ) ), min( 5, .tty_iosb[iosb$w_termlen] ) , tty_buffer+.tty_iosb[iosb$w_termoffset], %x'20' ) and .(tty_buffer + .tty_iosb[iosb$w_termoffset] + .tty_iosb[iosb$w_termlen] - 1)<0,8> eql 'c' then Terminal_type = terminal_vt100 else If ch$eql( 6, uplit( %string( Escape, '[?62;' ) ), min( 6, .tty_iosb[iosb$w_termlen] ) , tty_buffer+.tty_iosb[iosb$w_termoffset], %x'20' ) and .(tty_buffer + .tty_iosb[iosb$w_termoffset] + .tty_iosb[iosb$w_termlen] - 1)<0,8> eql 'c' then Terminal_type = terminal_vt200 else If ch$eql( 5, uplit( %string( CSI, '?62;' ) ), min( 5, .tty_iosb[iosb$w_termlen] ) , tty_buffer+.tty_iosb[iosb$w_termoffset], %x'20' ) and .(tty_buffer + .tty_iosb[iosb$w_termoffset] + .tty_iosb[iosb$w_termlen] - 1)<0,8> eql 'c' then Terminal_type = terminal_vt200 else If ch$eql( 6, uplit( %string( Escape, '[?12;' ) ), min( 6, .tty_iosb[iosb$w_termlen] ) , tty_buffer+.tty_iosb[iosb$w_termoffset], %x'20' ) and .(tty_buffer + .tty_iosb[iosb$w_termoffset] + .tty_iosb[iosb$w_termlen] - 1)<0,8> eql 'c' then Terminal_type = terminal_vt125 else If ch$eql( 4, uplit( %string( Escape, '[?6' ) ), min( 4, .tty_iosb[iosb$w_termlen] ) , tty_buffer+.tty_iosb[iosb$w_termoffset], %x'20' ) and .(tty_buffer + .tty_iosb[iosb$w_termoffset] + .tty_iosb[iosb$w_termlen] - 1)<0,8> eql 'c' then Terminal_type = terminal_vt102; $Dassgn( chan = .tty_channel ); ss$_normal end; %Sbttl 'SEDT$_Store_Terminal' Routine SEDT$_Store_Terminal = !++ ! ! Functional Description: ! ! Stores the parameter passed by Tparse into Terminal_Type ! ! Inputs: ! ! ap: pointer to Tparse parameter block ! ! Outputs: ! ! Terminal_Type modified. ! ! Side effects: ! ! None. ! !-- Begin Builtin AP; Map AP: ref block[, byte]; Terminal_type = .ap[tpa$l_param]; ss$_normal end; %Sbttl 'SEDT$_Set_Recover' Routine SEDT$_Set_Recover = !++ ! ! Functional Description: ! ! Stores the parameter passed by Tparse into Recover_Flag ! ! Inputs: ! ! ap: pointer to Tparse parameter block ! ! Outputs: ! ! Recover_Flag modified. ! ! Side effects: ! ! None. ! !-- Begin Builtin AP; Map AP: ref block[, byte]; Recover_Flag = .ap[tpa$l_param]; ss$_normal end; end Eludom