Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-11 - 43,50544/x10scn.r36
There is 1 other file named x10scn.r36 in the archive. Click here to see a list.
!
! SCAN File Specification Area
!

$FIELD	SCAN$FILE_SPEC	= SET
	SCAN$C_FXDEV	= [$SIXBIT(6)] ,		! device name (non-zero if any part of spec)
	SCAN$C_FXNAM	= [$SIXBIT(6)] ,		! file name (non-zero if name present)
	SCAN$V_FXNMM	= [$BYTES(4)] ,			! file name mask
	SCAN$Z_FXEXT	= [$BYTES(4)] ,			! included for compatibility - do not use
	    $OVERLAY( SCAN$Z_FXEXT )			! backup to redefine file extension field
	SCAN$C_FXEXT	= [$SIXBIT(3)] ,		! file extension
	SCAN$V_FXEXT	= [$BYTES(2)] ,			! file extension mask
	SCAN$G_FXMOD	= [$INTEGER] ,			! modifier word
	SCAN$V_FXMOM	= [$BYTES(4)] ,			! modifier mask
	SCAN$G_FXDIR	= [$INTEGER] ,			! directory word
	    $OVERLAY( SCAN$G_FXDIR )			! backup to redefine directory word
	SCAN$H_FXDIR2	= [$SHORT_INTEGER] ,		! programmer number
	SCAN$H_FXDIR1	= [$SHORT_INTEGER] ,		! project number
	SCAN$V_FXDIM	= [$BYTES(4)] ,			! directory mask
	SCAN$Z_FILLER	= [$SUB_BLOCK(11)] ,		! *** unspecified ***
	SCAN$G_FXBFR	= [$INTEGER] ,			! /BEFORE
	SCAN$G_FXSNC	= [$INTEGER] ,			! /SINCE
	SCAN$G_FXABF	= [$INTEGER] ,			! /ABEFORE
	SCAN$G_FXASN	= [$INTEGER] ,			! /ASINCE
	SCAN$G_FXFLI	= [$INTEGER] ,			! minimum file size (words)
	SCAN$G_FXFLM	= [$INTEGER] ,			! maximum file size (words)
	SCAN$G_FXEST	= [$INTEGER] ,			! /ESTIMATE
	SCAN$G_FXVER	= [$INTEGER]			! /VERSION
	TES;
LITERAL	SCAN$K_FXLEN	= $FIELD_SET_SIZE ;			! Length of file specification area

MACRO
    $SCAN_SPEC_INFO =
	BLOCK[ SCAN$K_FXLEN ]
	FIELD( SCAN$FILE_SPEC ) %;
!
! TOPS-10 SCAN Interface Macros
!

LINKAGE							! Define several SCAN routine linkages:
    $SCAN_P1_T1234 = PUSHJ ( REGISTER = 1 ) :		!    argument passed in register 1
	    LINKAGE_REGS( 15, 13, 0 )			!    ( stack, frame, return value )
	    NOPRESERVE( 1,2,3,4 )			!    SCAN temporary registers
	    PRESERVE( 0,5,6,7,8,9,10,11,12,14 ),	!    SCAN preserved registers

    $SCAN_G12 = PUSHJ :					!    no argument
	    GLOBAL( SWITCH_VALUE = 1,			!    global "switch value" register
			SWITCH_TABLE = 2 )		!    global "switch table address" register
	    LINKAGE_REGS( 15, 13, 0 )			!    ( stack, frame, return value )
	    PRESERVE( 0,3,4,5,6,7,8,9,10,11,12,14 ),	!    SCAN preserved registers

    $SCAN_G78 = PUSHJ :					!    no argument
	    GLOBAL( SWITCH_VALUE = 7,			!    global "switch value" register
			CHARACTER = 8 )			!    global "current character" register
	    LINKAGE_REGS( 15, 13, 0 )			!    ( stack, frame, return value )
	    PRESERVE( 0,1,2,3,4,5,6,9,10,11,12,14 ),	!    SCAN preserved registers

    $SCAN_G78_T1 = PUSHJ :				!    no argument
	    GLOBAL( SWITCH_VALUE = 7,			!    global "switch value" register
			CHARACTER = 8 )			!    global "current character" register
	    LINKAGE_REGS( 15, 13, 0 )			!    ( stack, frame, return value )
	    NOPRESERVE( 1 )				!    SCAN temporary register
	    PRESERVE( 0,2,3,4,5,6,9,10,11,12,14 ),	!    SCAN preserved registers

    $SCAN_G178_T234 = PUSHJ :				!    no argument
	    GLOBAL( KEYWORD_INFO = 1,			!    global "keyword table" register
			SWITCH_VALUE = 7,		!    global "switch value" register
			CHARACTER = 8 )			!    global "current character" register
	    LINKAGE_REGS( 15, 13, 0 )			!    ( stack, frame, return value )
	    NOPRESERVE( 2,3,4 )				!    SCAN temporary registers
	    PRESERVE( 0,5,6,9,10,11,12,14 ),		!    SCAN preserved registers

    $SCAN_G1 = PUSHJ :					!    no argument
	    GLOBAL( KEYWORD_INFO = 1 )			!    global "keyword indicator" register
	    LINKAGE_REGS( 15, 13, 0 )			!    ( stack, frame, return value )
	    PRESERVE( 0,2,3,4,5,6,7,8,9,10,11,12,14 );	!    Scan preserved registers


MACRO							! Define SCAN routine names
    SCAN$ISCAN = %NAME( '.ISCAN' ) %,			! $SCAN_P1_T1234 linkage
    SCAN$MNRET = %NAME( '.MNRET' ) %,
    SCAN$NAME = %NAME( '.NAME' ) %,			! $SCAN_G178_T234 linkage
    SCAN$OCTNC = %NAME( '.OCTNC' ) %,			! $SCAN_G78 linkage
    SCAN$OSCAN = %NAME( '.OSCAN' ) %,			! $SCAN_P1_T1234 linkage
    SCAN$SIXSC = %NAME( '.SIXSC' ) %,			! $SCAN_G78_T1 linkage
    SCAN$SIXSW = %NAME( '.SIXSW' ) %,			! $SCAN_G78_T1 linkage
    SCAN$SWASQ = %NAME( '.SWASQ' ) %,
    SCAN$SWDEC = %NAME( '.SWDEC' ) %,
    SCAN$SWFIL = %NAME( '.SWFIL' ) %,
    SCAN$SWOCT = %NAME( '.SWOCT' ) %,
    SCAN$TIAUC = %NAME( '.TIAUC' ) %,			! $SCAN_G78 linkage
    SCAN$TISQT = %NAME( '.TISQT' ) %,			! $SCAN_G78 linkage
    SCAN$TSCAN = %NAME( '.TSCAN' ) %,			! $SCAN_P1_T1234 linkage

							! Define SCAN global symbols
    SCAN$NMUL = %NAME( '.NMUL' ) %,
    SCAN$NMUE = %NAME( '.NMUE' ) %,
    SCAN$LASWD = %NAME( '.LASWD' ) %,
    SCAN$QUOTE = %NAME( '.QUOTE' ) %,
    SCAN$TFCHR = %NAME( '.TFCHR' ) %;


MACRO
    $SCAN_ERROR( type ) =
	BEGIN
	%IF NOT %DECLARED( KEYWORD_INFO )
	%THEN
	    GLOBAL REGISTER
		KEYWORD_INFO = 1;
	%FI
	EXTERNAL ROUTINE
	    %NAME( 'E.', type ) : $SCAN_G1 NOVALUE;
	%NAME( 'E.', type )();
	END %;


LITERAL
							! SCAN switch table flags:
    SCAN$M_FS_NFS = 1^(17-0),				!    this switch is never part of a file-spec
    SCAN$M_FS_LRG = 1^(17-1),				!    the max and default values are 0 or > 2**17
    SCAN$M_FS_NUE = 1^(17-2),				!    no user exit on this switch
    SCAN$M_FS_VRQ = 1^(17-3),				!    value required
    SCAN$M_FS_OBV = 1^(17-4),				!    OR bit values to right half
    SCAN$M_FS_NOS = 1^(17-5),				!    switch takes "NO" prefix (internal for $SCAN_SN macro only)
    SCAN$M_FS_NCM = 1^(17-6),				!    switch does not constitute a command

							! SCAN ISCAN option flags:
    SCAN$M_FS_ICL = 1^(17-17),				!    ignore special command-line handling

							! SCAN TSCAN option flags:
    SCAN$M_FS_MOT = 1^(35-18),				!    multiple output specs possible
    SCAN$M_FS_MIO = 1^(35-19),				!    mixed input and output specs

    SCAN$M_0 = 0;					! Needed for ISCAN and TSCAN FLAGS=0


MACRO
    SCAN$LH_RH( lh, rh ) =
	%IF %LENGTH LSS 2
	%THEN
	    lh
	%ELSE
	    lh^18 + (rh AND %O'777777')
	%FI %,


    SCAN$IOWD( lh, rh ) =
	%IF %LENGTH GEQ 2
	%THEN
	    -lh^18 + (rh-1 AND %O'777777')
	%ELSE
	    lh
	    %IF lh NEQ 0
	    %THEN
		%WARN( 'Keyword value "', lh, '" is invalid' )
	    %FI
	%FI %,


    SCAN$LIST( list ) =
	INITIAL( SCAN$LH_RH( %LENGTH, UPLIT( SCAN$PLIT( list, %REMAINING ) ) ) ) %,


    SCAN$PLIT[ item ] =
	SCAN$LH_RH( %REMOVE( item ) ) %,


    SCAN$REQUIRED( name, value ) =
	%IF %NULL( value )
	%THEN
	    %WARN( name, '= parameter must be specified')
	%FI %,


    SCAN$SIX_SIX[ text ] =
	%SIXBIT %EXACTSTRING( 6, %C' ', text ) %,


    SCAN$FLAGS( flag_name ) [] =
	%IF %COUNT NEQ 0
	%THEN
	    OR
	%FI
	%NAME( 'SCAN$M_', flag_name )
	SCAN$FLAGS( %REMAINING ) %;


KEYWORDMACRO
    $ISCAN_LIST(
	command_list=(0,0),				! length and address of monitor command list or 0
	ccl_name=0,					! CCL name (6-bit) or 0 (no CCL mode)
	ccl_offset=UPLIT(0),				! address of starting offset or 0
	char_output=0,					! address of character typeout routine or 0
	char_input=0,					! address of character input routine or 0
	indirect_block=(0,0),				! length and address of indirect file block or 0
	monitor_return=0,				! address of monitor return routine or 0
	prompt=0,					! address of prompt routine or 0
	flags=0						! flags
	) =

	SCAN$LIST(
		SCAN$IOWD( %REMOVE( command_list ) ),	! word 0
		( ccl_offset, ccl_name ),		! word 1
		( char_input, char_output ),		! word 2
		indirect_block,				! word 3
		( prompt, monitor_return ),		! word 4
		( SCAN$FLAGS(%REMOVE(flags)), 0 ) ) %,	! word 5


    $TSCAN_LIST(
	switch_table,					! name of the switch table
	help_string,					! address of help string
	help_routine,					! address of help routine
	clear_all=0,					! address of routine to clear all answers or 0
	clear_file=0,					! address of routine to clear file answers or 0
	input_area,					! address of routine to allocate input file area
	output_area,					! address of routine to allocate output area
	memorize_sticky=0,				! address of routine to memorize sticky defaults or 0
	apply_sticky=0,					! address of routine to apply sticky defaults or 0
	clear_sticky=0,					! address of routine to clear sticky defaults or 0
	flags=0,					! SCAN control flags
	store_values=0					! address of routine to store switch values or 0
	) =

	SCAN$REQUIRED( %QUOTE SWITCH_TABLE, switch_table )
	SCAN$REQUIRED( %QUOTE INPUT_AREA, input_area )
	SCAN$REQUIRED( %QUOTE OUTPUT_AREA, output_area )

	%IF NOT %NULL( help_string ) AND NOT %NULL( help_routine )
	%THEN
	    %WARN(' HELP_STRING= and HELP_ROUTINE= parameters are mutually exclusive' )
	%FI

	SCAN$LIST(
	    %IF %IDENTICAL( switch_table, 0 )
	    %THEN
		(0,0), (0,0), (0,0),			! words 0, 1 and 2
	    %ELSE
		SCAN$IOWD( %NAME(switch_table,'_L'),	! word 0
		    %NAME(switch_table,'_N') ),		!
		( %NAME(switch_table,'_D'),		! word 1
		    %NAME(switch_table,'_M') ),		!
		( 0, %NAME(switch_table,'_P') ),	! word 2
	    %FI

	    %IF %NULL(help_string) AND %NULL(help_routine)
	    %THEN
		(0,0),					! word 3
	    %ELSE
		%IF NOT %NULL(help_string)
		%THEN
		    ( 1, help_string ),			! word 3
		%ELSE
		    %IF help_routine EQL -1
		    %THEN
			(-1,-1),			! word 3
		    %ELSE
			( 2, help_routine ),		! word 3
		    %FI
		%FI
	    %FI

		( clear_all, clear_file ),		! word 4
		( input_area, output_area ),		! word 5
		( memorize_sticky, apply_sticky ),	! word 6
		( clear_sticky,				! word 7
		    SCAN$FLAGS( %REMOVE( flags ) ) ),	!
		( 0, store_values ) ) %,		! word 8


    $OSCAN_LIST(
	switch_table,					! name of the switch table
	help_string,					! address of help string
	help_routine,					! address of help routine
	option_name=(0,0)				! option name (6-bit) or 0 (program name) or
	) =
							!    length and address of option names list or 0

	SCAN$REQUIRED( %QUOTE SWITCH_TABLE, switch_table )

	%IF NOT %NULL( help_string ) AND NOT %NULL( help_routine )
	%THEN
	    %WARN(' HELP_STRING= and HELP_ROUTINE= parameters are mutually exclusive' )
	%FI

	SCAN$LIST(
		SCAN$IOWD( %NAME(switch_table,'_L'),	! word 0
		    %NAME(switch_table,'_N') ),		!
		( %NAME(switch_table,'_D'),		! word 1
		    %NAME(switch_table,'_M') ),		!
		( 0, %NAME(switch_table,'_P') ),	! word 2

	    %IF %NULL(help_string) AND %NULL(help_routine)
	    %THEN
		(0,0),					! word 3
	    %ELSE
		%IF NOT %NULL(help_string)
		%THEN
		    ( 1, help_string ),			! word 3
		%ELSE
		    %IF help_routine EQL -1
		    %THEN
			(-1,-1),			! word 3
		    %ELSE
			( 2, help_routine ),		! word 3
		    %FI
		%FI
	    %FI

		option_name ) %;			! word 4


MACRO
    $SCAN_KEYS( switch_name ) =
	SCAN$KEYS( switch_name, %REMOVE( %REMAINING ) ) %,


    SCAN$KEYS( switch_name ) =
	OWN
	    %NAME( switch_name, '_T' ) :
		VECTOR[ %LENGTH-1 ]
		INITIAL( SCAN$SIX_SIX( %REMAINING  ) );

	LITERAL
	    %NAME( switch_name, '_L' ) = %LENGTH-1; %,


    $SCAN_TABLE( table_name ) =

	LITERAL
	    %NAME( table_name, '_L' ) = %LENGTH-1;

	OWN
	    %NAME( table_name, '_N' ) :  VECTOR[ %LENGTH-1 ]
		INITIAL( SCAN$TABLE( 1, %REMAINING ) ),
	    %NAME( table_name, '_P' ) :  VECTOR[ %LENGTH-1 ]
		INITIAL( SCAN$TABLE( 2, %REMAINING ) ),
	    %NAME( table_name, '_M' ) :  VECTOR[ %LENGTH-1 ]
		INITIAL( SCAN$TABLE( 3, %REMAINING ) ),
	    %NAME( table_name, '_D' ) :  VECTOR[ %LENGTH-1 ]
		INITIAL( SCAN$TABLE( 4, %REMAINING ) ); %,


    SCAN$TABLE( table_number ) [ table_entry ] =
	%NAME( 'SCAN$TABLE', table_number ) ( %REMOVE( table_entry ) ) %,


    SCAN$TABLE1( switch_name, processor, result, default, max_value, flags ) =
	SCAN$SIX_SIX( switch_name ) %,


    SCAN$TABLE2( switch_name, processor, result, default, max_value, flags ) =
	CH$PTR( result, 1, 36 ) %,


    SCAN$TABLE3( switch_name, processor, result, default, max_value, flags ) =
	SCAN$LH_RH( max_value, processor ) %,


    SCAN$TABLE4( switch_name, processor, result, default, max_value, flags ) =
	SCAN$LH_RH( ( SCAN$FLAGS( %REMOVE( flags ) ) ), default ) %;


KEYWORDMACRO
    $SCAN_SP( switch, result, processor, flags ) =
	( switch, processor, result,
	    %IF %DECLARED(%NAME('PD_',switch))
	    %THEN
		%NAME('PD_',switch),
	    %ELSE
		0,
	    %FI
	    %IF %DECLARED(%NAME('MX_',switch))
	    %THEN
		%NAME('MX_',switch),
	    %ELSE
		0,
	    %FI
	 flags ) %,

    $SCAN_SS( switch, result, value, flags ) =
	( switch, 0, result, value, 0, flags ) %,

    $SCAN_SN( switch, result, flags ) =
	( switch, 0, result, 0, 0, ( FS_NOS, %REMOVE( flags ) ) ) %;