! %TITLE 'Mandelbrot compute' MODULE compute (MAIN = compute, IDENT = 'V002-0' ! File: COMPUTE.BLI ) = BEGIN !++ ! ! FACILITY: DECUS pre-symposium seminar 'BLISS for Macro users' examples ! ! This routine will show the use of: ! ! Run-time library routines ! System services ! RMS ! Keyword macro ! Simple macro ! Require file ! Library file ! Builtins ! Floating point computation ! INCR loops ! OWN storage ! BLOCK ! VECTOR ! ASCID ! PLIT ! ! ABSTRACT: This program will compute an image of a specified region of ! the Mandelbrot set, and write it to a file. The user must specify ! the center point, and scale in floating point format. To help ! make this program output device independent, the user must also ! specify the dimensions of the image in pixels, as well as the ! pixel size in bytes, and the maximum pixel value. This will allow ! this program to create image files for several different types of ! devices, each with it's own display program. ! ! The first block in the file contains the r_header which contains ! information on the image contained within the file. Using this ! information, a display program can be written to display the image ! on any graphics device. ! ! The image starts in block 2, and is stored in row order. The size ! of each row, and the number of rows is contained within the r_header. ! This file has no RMS record attributes, it is simply organized as a ! series of 512 byte blocks. ! ! ENVIRONMENT: VAX/VMS, user mode ! ! AUTHOR: Brian K Catlin ! ! CREATED: 11-MAY-1988 ! ! MODIFICATION ! HISTORY: ! ! V002-0 Brian K Catlin 4-MAY-1990 ! Cleanup for submission to DECUS ! ! V001-1 Brian K Catlin 11-MAY-1988 ! Original version ! !-- %SBTTL 'Declarations' !+ ! SWITCHES: !- SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); !+ ! LINKAGE/GLOBAL REGISTERS: !- ! None. !+ ! LINKAGES: !- ! None. !+ ! TABLE OF CONTENTS: ! ! compute This is the main entry point of the program. User parameters ! are read, the output file is created, the main compute loop ! is run, and finally, the output file is written. ! ! get_input Display a prompt to the user on the terminal, and wait for a ! response. Convert the user input from text to either double ! precision floating, or an integer longword. ! ! compute_value Do the actual work of computing the Mandelbrot value for a ! given point in the picture. !- FORWARD ROUTINE compute, get_input, compute_value; !+ ! INCLUDE FILES: ! !- LIBRARY 'SYS$LIBRARY:LIB'; ! VMS executive macros/symbols LIBRARY 'USR_LIBRARY:USRLIB'; ! User Definitions. REQUIRE 'STRUCTS'; ! r_header definitions !+ ! MACROS: !- MACRO !+ ! Find first whitespace character (space, tab, cr, lf, vt, nul) !- _find_whitespace (dsc_string) = BEGIN LOCAL i : LONG INITIAL (0); BIND ab_line = .dsc_string [dsc$a_pointer] : VECTOR [, BYTE]; WHILE ( NOT (_cvt_is_white (.ab_line [.i]) OR _cvt_is_mechan (.ab_line [.i])) AND (.i LSSU .dsc_string [dsc$w_length])) DO BEGIN i = .i + 1; END; .i END %; !+ ! FIELDS: !- ! None. !+ ! STRUCTURES: !- OWN l_pixel_size : LONG; STRUCTURE variable_item [i; ] = variable_item<.l_pixel_size*8*i, .l_pixel_size*8>; !+ ! PSECTS: !- ! None. !+ ! EQUATED SYMBOLS: !- LITERAL k_float = 1, ! Specify to GET_INPUT to return a floating value k_integer = 0; ! Specify to GET_INPUT to return an integer value !+ ! OWN (R/O) STORAGE: !- ! None. !+ ! OWN (R/W) STORAGE: !- OWN l_upper_limit : LONG; ! Maximum pixel value !+ ! BUILTIN DECLARATIONS: !- BUILTIN CVTDL, ! Convert Double to Long CVTLD, ! Convert Long to Double ADDD, ! Double precision add DIVD, ! Double precision divide MULD, ! Double precision multiply SUBD; ! Double precision subtract !+ ! EXTERNAL ROUTINES: ! ! LIB$GET_INPUT Get input from the user ! LIB$GET_VM_PAGE Allocate some pages of virtual memory ! LIB$FREE_VM Release some pages of virtual memory ! OTS$CVT_TI_L Convert a text integer to a longword ! OTS$CVT_T_D Convert a text D floating number to D floating ! STR$FREE1_DX Free the storage associated with a dynamic descriptor !- EXTERNAL ROUTINE lib$get_input, lib$get_vm_page, lib$free_vm_page, ots$cvt_ti_l, ots$cvt_t_d, str$free1_dx; !+ ! EXTERNAL REFERENCES: !- ! None. %SBTTL 'COMPUTE - Main entry point for this program' ROUTINE compute = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! CALLING SEQUENCE: ! ! main () Called by VMS as the entry point of this program ! ! LINKAGE: ! ! CALL ! ! FORMAL PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! SS$_NORMAL Normal successful completion. ! ! SIDE AFFECTS: ! ! Output file is created ! !-- BEGIN LOCAL d_center_i : VECTOR [2, LONG], ! Imaginary part of center point, double floating d_center_r : VECTOR [2, LONG], ! Real part of center point, double floating d_h_size : VECTOR [2, LONG], ! Horizontal size of image in pixels, double floating d_h_step : VECTOR [2, LONG], ! Double floating horizontal step amount d_i : VECTOR [2, LONG], ! Double floating loop l_index d_j : VECTOR [2, LONG], ! Double floating loop l_index d_point_i : VECTOR [2, LONG], ! Imaginary part of current point being computed d_point_r : VECTOR [2, LONG], ! Real part of current point being computed d_scale_i : VECTOR [2, LONG], ! Imaginary part of scale, double floating d_scale_r : VECTOR [2, LONG], ! Real part of scale, double floating d_top_left_i : VECTOR [2, LONG], ! Imaginary part of top_left point of r_screen d_top_left_r : VECTOR [2, LONG], ! Real part of top_left point of r_screen d_v_size : VECTOR [2, LONG], ! Vertical size of image in pixels, double floating d_v_step : VECTOR [2, LONG], ! Double floating vertical step amount dsc_file_name : _string_desc (class = d), ! Name of file to create l_h_size : LONG, ! Horizontal size of image in pixels l_index : LONG, ! Index variable l_num_blocks : LONG, ! Number of blocks in file l_status : LONG, ! Generic l_status l_v_size : LONG, ! Vertical size of image in pixels r_fab : $fab_decl, ! File Access Block r_header : REF hdrdef, ! Pointer to r_header block r_rab : $rab_decl, ! Record Access Block r_screen : REF variable_item; ! Pointer to r_screen array !+ ! Ask user for controlling parameters !- IF (l_status = lib$get_input (dsc_file_name [0, 0, 0, 0], %ASCID'File name > ')) THEN BEGIN !+ ! Trim off white space !- dsc_file_name [dsc$w_length] = _find_whitespace (dsc_file_name); !+ ! Ask for the number of bytes per pixel. Loop until we get a valid response !- DO BEGIN get_input (%ASCID'Bytes per pixel > ', l_pixel_size, k_integer); END UNTIL ((.l_pixel_size GEQU 1) AND (.l_pixel_size LEQU 4)); !+ ! Ask for the upper limit on the pixel value. Loop until we get a valid response !- DO BEGIN get_input (%ASCID'Max pixel value > ', l_upper_limit, k_integer); END UNTIL ((.l_upper_limit GEQU 1) AND (.l_upper_limit LEQU (2^(.l_pixel_size*8)) - 1)); !+ ! Get the rest of the inputs !- get_input (%ASCID'd_center_r > ', d_center_r, k_float); get_input (%ASCID'd_center_i > ', d_center_i, k_float); get_input (%ASCID'd_scale_r > ', d_scale_r, k_float); get_input (%ASCID'd_scale_i > ', d_scale_i, k_float); get_input (%ASCID'Horizontal size > ', l_h_size, k_integer); get_input (%ASCID'Vertical size > ', l_v_size, k_integer); !+ ! Grab some heap the size of the r_screen image to be computed !- l_num_blocks = (((.l_h_size*.l_v_size*.l_pixel_size) + 511)/512) + 1; !+ ! Allocate some virtual memory !- IF (l_status = lib$get_vm_page (l_num_blocks, r_header)) THEN BEGIN CH$FILL (0, .l_num_blocks*512, r_header [0, 0, 0, 0]); ! Clear to zero r_screen = r_header [0, 0, 0, 0] + 512; ! Point r_screen to r_screen memory area !+ ! Fill in the header !- r_header [hdr_l_version] = hdr_k_version; r_header [hdr_f_center_r] = .d_center_r; r_header [hdr_f_center_i] = .d_center_i; r_header [hdr_f_scale_r] = .d_scale_r; r_header [hdr_f_scale_i] = .d_scale_i; r_header [hdr_l_hsize] = .l_h_size; r_header [hdr_l_vsize] = .l_v_size; r_header [hdr_l_pixel_size] = .l_pixel_size; r_header [hdr_l_max_value] = .l_upper_limit; !+ ! Get current system time/date !- IF (l_status = $gettim (timadr = r_header [hdr_q_time])) THEN BEGIN !+ ! Declare the output file !- $fab_init (fab = r_fab, ! Address of File Access Block fna = .dsc_file_name [dsc$a_pointer], ! Address of file name fns = .dsc_file_name [dsc$w_length], ! Length of file name dnm = '.pic', ! Default file name alq = .l_num_blocks, ! Allocation size fac = put, ! File access - PUT fop = sqo, ! File operations - Sequential org = seq, ! File organization - Sequential rfm = fix, ! Record format - Fixed mrs = 512); ! Maximum record size ! $rab_init (rab = r_rab, ! Address of Record Access Block fab = r_fab, ! Address of File Access Block rac = seq, ! Record access - Sequential rop = wbh, ! Record operations - Write behind rsz = 512, ! Record size rbf = r_header [0, 0, 0, 0]); ! Record buffer !+ ! Create and open the output file !- IF (l_status = $create (fab = r_fab [0, 0, 0, 0])) THEN BEGIN !+ ! Connect record stream !- IF (l_status = $connect (rab = r_rab [0, 0, 0, 0])) THEN BEGIN !+ ! Compute the left side coordinates !- CVTLD (l_h_size, d_h_size); ! Convert hsize to double floating CVTLD (l_v_size, d_v_size); ! Convert vsize to double floating ! SUBD (d_scale_r, d_center_r, d_top_left_r); ! d_top_left_r = d_center_r - d_scale_r ADDD (d_scale_i, d_center_i, d_top_left_i); ! d_top_left_i = d_center_i + d_scale_i ! MULD (PLIT (%D'2.0'), d_scale_r, d_h_step); ! d_h_step = d_scale_r * 2 DIVD (d_h_size, d_h_step, d_h_step); ! d_h_step = d_h_step / l_h_size ! MULD (PLIT (%D'2.0'), d_scale_i, d_v_step); ! d_v_step = d_scale_i * 2 DIVD (d_v_size, d_v_step, d_v_step); ! d_v_step = d_v_step / l_v_size !+ ! Loop through the entire screen image (l_h_size * l_v_size) and determine ! if each pixel is part of the Mandelbrot set !- INCR i FROM 0 TO .l_v_size - 1 DO BEGIN INCR j FROM 0 TO .l_h_size - 1 DO BEGIN CVTLD (j, d_j); ! d_j = FLOAT ( j ) MULD (d_j, d_h_step, d_point_r); ! d_point_r = d_h_step * d_j ADDD (d_top_left_r, d_point_r, d_point_r); ! d_point_r = d_point_r + d_top_left_r ! CVTLD (i, d_i); ! d_i = FLOAT ( i ) MULD (d_i, d_v_step, d_point_i); ! d_point_i = d_v_step * d_i SUBD (d_point_i, d_top_left_i, d_point_i); ! d_point_i = d_top_left_i - d_point_i ! l_index = .i*.l_h_size + .j; ! Point to r_screen element we are computing r_screen [.l_index] = compute_value (d_point_r [0], d_point_i [0]); ! Compute this pixel's value END; END; !+ ! Write out the r_screen image, one block at a time !- INCR j FROM 0 TO .l_num_blocks - 1 DO BEGIN IF (l_status = $put (rab = r_rab [0, 0, 0, 0])) THEN BEGIN r_rab [rab$l_rbf] = .r_rab [rab$l_rbf] + 512; ! Point to next block END ELSE BEGIN !+ ! Error writing a block !- SIGNAL (.r_rab [rab$l_sts], .r_rab [rab$l_stv]); END; END; !+ ! Disconnect from the file, and close it !- IF (l_status = $disconnect (rab = r_rab [0, 0, 0, 0])) THEN BEGIN IF NOT (l_status = $close (fab = r_fab [0, 0, 0, 0])) THEN SIGNAL (.r_fab [fab$l_sts], .r_fab [fab$l_stv]); END ELSE BEGIN !+ ! Error disconnecting from file !- SIGNAL (.r_rab [rab$l_sts], .r_rab [rab$l_stv]); END; END ELSE BEGIN !+ ! Error connecting to the output file !- SIGNAL (.r_rab [rab$l_sts], .r_rab [rab$l_stv]); END; END ELSE BEGIN !+ ! Error creating the output file !- SIGNAL (.r_fab [fab$l_sts], .r_fab [fab$l_stv]); END; END ELSE BEGIN !+ ! Error getting time !- SIGNAL (.l_status); END; END ELSE BEGIN !+ ! Error allocating virtual memory !- SIGNAL (.l_status); END; END ELSE BEGIN !+ ! Error getting file name from user !- SIGNAL (.l_status); END; RETURN (.l_status); ! Routine value END; ! End of routine COMPUTE %SBTTL 'GET_INPUT - Get input parameters' ROUTINE get_input (dsc_prompt, al_variable, type) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine is the generic input routine for this module. The user ! passes the address of a descriptor which contains the prompt string ! to display to the user, the address of where to store the converted ! output, and the data type - integer longword, or double floating. ! ! CALLING SEQUENCE: ! ! status.wlc.v = get_input (dsc_prompt, al_variable, type) ! ! FORMAL PARAMETERS: ! ! dsc_prompt Address of descriptor pointing to message to prompt user for input ! al_variable Address of where to place converted input from user ! type What type of conversion to do: ! 0 Longword integer ! 1 Double precision floating point ! ! IMPLICIT INPUTS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! Whatever al_variable points to will be modified ! ! COMPLETION CODES: ! ! SS$_NORMAL Normal successful completion. ! ! SIDE AFFECTS: ! ! None. ! !-- BEGIN MAP dsc_prompt : REF BLOCK [, BYTE], ! String descriptor passed by user al_variable : REF VECTOR [, BYTE]; ! Address of where to put value LOCAL l_status : LONG, ! Generic l_status w_old_len : WORD, ! Original length of string dsc_com : _string_desc (class = d); ! String descriptor for input from user !+ ! Ask the user for input !- IF (l_status = lib$get_input (dsc_com, .dsc_prompt)) THEN BEGIN !+ ! Skip anything after the first whitespace character !- w_old_len = .dsc_com [dsc$w_length]; dsc_com [dsc$w_length] = _find_whitespace (dsc_com); !+ ! Convert the response to the correct data type; double precision floating ! or integer !- IF (.type EQLU k_float) THEN BEGIN IF NOT (l_status = ots$cvt_t_d (dsc_com, .al_variable)) ! Double precision floating THEN SIGNAL (.l_status); END ELSE IF NOT (l_status = ots$cvt_ti_l (dsc_com, .al_variable)) ! Integer longword THEN SIGNAL (.l_status); !+ ! Free the storage associated with the dynamic descriptor !- dsc_com [dsc$w_length] = .w_old_len; ! Set original string length IF NOT (l_status = str$free1_dx (dsc_com)) ! Free the string THEN SIGNAL (.l_status); END ELSE BEGIN !+ ! Error getting input !- SIGNAL (.l_status); END; RETURN (.l_status); ! Routine value END; ! End of routine GET_INPUT %SBTTL 'COMPUTE_VALUE - Compute the mandelbrot value of the passed point' ROUTINE compute_value (d_point_r, d_point_i) = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine will compute the Mandelbrot value for a given point, and ! return it as the value of this routine. ! ! CALLING SEQUENCE: ! ! l_status.wlc.v = compute (d_point_r, d_point_i) ! ! FORMAL PARAMETERS: ! ! d_point_r Real part of point to compute ! d_point_i Imaginary part of point to compute ! ! IMPLICIT INPUTS: ! ! l_upper_limit Maximum pixel value ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION l_status: ! ! This routine returns the Mandelbrot value of the passed point ! ! SIDE AFFECTS: ! ! None. ! !-- BEGIN MAP d_point_r : REF VECTOR [8, BYTE], ! Real part of point to compute d_point_i : REF VECTOR [8, BYTE]; ! Imaginary part of point to compute LOCAL d_z_r : VECTOR [8, BYTE] INITIAL (%D'0'), d_z_i : VECTOR [8, BYTE] INITIAL (%D'0'), d_z_rs : VECTOR [8, BYTE], d_z_is : VECTOR [8, BYTE], d_z_ris : VECTOR [8, BYTE], l_z_cnt : LONG, l_count : LONG INITIAL (0); MULD (d_z_r [0], d_z_r [0], d_z_rs [0]); ! d_z_rs = d_z_r * d_z_r MULD (d_z_i [0], d_z_i [0], d_z_is [0]); ! d_z_is = d_z_i * d_z_i ADDD (d_z_rs [0], d_z_is [0], d_z_ris [0]); ! d_z_ris = d_z_rs + d_z_is CVTDL (d_z_ris [0], l_z_cnt); ! l_z_cnt = INT ( d_z_ris ) WHILE ((.l_count LSS .l_upper_limit) AND (.l_z_cnt LSS 4)) DO BEGIN MULD (d_z_r [0], d_z_i [0], d_z_i [0]); ! d_z_i = d_z_i * d_z_r MULD (PLIT (%D'2.0'), d_z_i [0], d_z_i [0]); ! d_z_i = d_z_i * 2 ADDD (d_z_i [0], d_point_i [0], d_z_i [0]); ! d_z_i = d_z_i * d_point_i SUBD (d_z_is [0], d_z_rs [0], d_z_r [0]); ! d_z_r = d_z_is - d_z_rs ADDD (d_z_r [0], d_point_r [0], d_z_r [0]); ! d_z_r = d_z_r + d_point_r ! MULD (d_z_r [0], d_z_r [0], d_z_rs [0]); ! d_z_rs = d_z_r * d_z_r MULD (d_z_i [0], d_z_i [0], d_z_is [0]); ! d_z_is = d_z_i * d_z_i ADDD (d_z_rs [0], d_z_is [0], d_z_ris [0]); ! d_z_ris = d_z_rs + d_z_is CVTDL (d_z_ris [0], l_z_cnt); ! l_z_cnt = INT ( d_z_ris ) ! l_count = .l_count + 1; END; .l_count END; ! End of routine COMPUTE_VALUE END ! End of module COMPUTE ELUDOM