; 0001 0 ! ; 0002 0 %TITLE 'Mandelbrot compute' ; 0003 0 MODULE compute (MAIN = compute, ; 0004 0 IDENT = 'V001-1' ! File: compute.bli ; 0005 0 ) = ; 0006 1 BEGIN ; 0007 1 ; 0008 1 !++ ; 0009 1 ! ; 0010 1 ! FACILITY: DECUS pre-symposium seminar 'BLISS for Macro users' examples ; 0011 1 ! ; 0012 1 ! This routine will show the use of: ; 0013 1 ! ; 0014 1 ! Run-time library routines ; 0015 1 ! System services ; 0016 1 ! RMS ; 0017 1 ! Keyword macro ; 0018 1 ! Simple macro ; 0019 1 ! Require file ; 0020 1 ! Library file ; 0021 1 ! Builtins ; 0022 1 ! Floating point computation ; 0023 1 ! INCR loops ; 0024 1 ! OWN storage ; 0025 1 ! BLOCK ; 0026 1 ! VECTOR ; 0027 1 ! ASCID ; 0028 1 ! PLIT ; 0029 1 ! ; 0030 1 ! ABSTRACT: This program will compute an image of a specified region of ; 0031 1 ! the Mandelbrot set, and write it to a file. The user must specify ; 0032 1 ! the center point, and scale in floating point format. To help ; 0033 1 ! make this program output device independent, the user must also ; 0034 1 ! specify the dimensions of the image in pixels, as well as the ; 0035 1 ! pixel size in bytes, and the maximum pixel value. This will allow ; 0036 1 ! this program to create image files for several different types of ; 0037 1 ! devices, each with it's own display program. ; 0038 1 ! ; 0039 1 ! The first block in the file contains the header which contains ; 0040 1 ! information on the image contained within the file. Using this ; 0041 1 ! information, a display program can be written to display the image ; 0042 1 ! on any graphics device. ; 0043 1 ! ; 0044 1 ! The image starts in block 2, and is stored in row order. The size ; 0045 1 ! of each row, and the number of rows is contained within the header. ; 0046 1 ! This file has no RMS record attributes, it is simply organized as a ; 0047 1 ! series of 512 byte blocks. ; 0048 1 ! ; 0049 1 ! ENVIRONMENT: VAX/VMS, user mode ; 0050 1 ! ; 0051 1 ! AUTHOR: Brian K Catlin ; 0052 1 ! ; 0053 1 ! CREATED: 11-MAY-1988 ; 0054 1 ! ; 0055 1 ! MODIFICATION ; 0056 1 ! HISTORY: ; 0057 1 ! ; 0058 1 ! V001-1 BKC001 Brian K Catlin 11-MAY-1988 ; 0059 1 ! Original version ; 0060 1 ! ; 0061 1 !-- ; 0062 1 ; 0064 1 %SBTTL 'Declarations' ; 0065 1 ; 0066 1 !+ ; 0067 1 ! SWITCHES: ; 0068 1 !- ; 0069 1 ; 0070 1 SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); ; 0071 1 ; 0072 1 !+ ; 0073 1 ! LINKAGE/GLOBAL REGISTERS: ; 0074 1 !- ; 0075 1 ; 0076 1 ! None. ; 0077 1 ; 0078 1 !+ ; 0079 1 ! LINKAGES: ; 0080 1 !- ; 0081 1 ; 0082 1 ! None. ; 0083 1 ; 0084 1 !+ ; 0085 1 ! TABLE OF CONTENTS: ; 0086 1 ! ; 0087 1 ! compute This is the main entry point of the program. User parameters ; 0088 1 ! are read, the output file is created, the main compute loop ; 0089 1 ! is run, and finally, the output file is written. ; 0090 1 ! ; 0091 1 ! get_input Display a prompt to the user on the terminal, and wait for a ; 0092 1 ! response. Convert the user input from text to either double ; 0093 1 ! precision floating, or an integer longword. ; 0094 1 ! ; 0095 1 ! compute_value Do the actual work of computing the Mandelbrot value for a ; 0096 1 ! given point in the picture. ; 0097 1 !- ; 0098 1 ; 0099 1 FORWARD ROUTINE ; 0100 1 compute, ; 0101 1 get_input, ; 0102 1 compute_value; ; 0103 1 ; 0104 1 !+ ; 0105 1 ! INCLUDE FILES: ; 0106 1 ! ; 0107 1 !- ; 0108 1 ; 0109 1 LIBRARY 'SYS$LIBRARY:LIB'; ! VMS executive macros/symbols ; 0110 1 ; 0111 1 LIBRARY 'USR$LIBRARY:USRLIB'; ! User Definitions. ; 0112 1 ; 0113 1 REQUIRE 'STRUCTS'; ! Header definitions ; 0153 1 ; 0154 1 !+ ; 0155 1 ! MACROS: ; 0156 1 !- ; 0157 1 ; 0158 1 MACRO ; 0159 1 ; 0160 1 !+ ; 0161 1 ! Find first whitespace character (space, tab, cr, lf, vt, nul) ; 0162 1 !- ; 0163 1 ; M 0164 1 _find_whitespace (string) = ; M 0165 1 BEGIN ; M 0166 1 ; M 0167 1 LOCAL ; M 0168 1 i : LONG INITIAL (0); ; M 0169 1 ; M 0170 1 BIND ; M 0171 1 line = .string [dsc$a_pointer] : VECTOR [, BYTE]; ; M 0172 1 ; M 0173 1 WHILE ( NOT (_cvt_is_white (.line [.i]) OR _cvt_is_mechan (.line [.i])) AND (.i LSSU .string [ ; M 0174 1 dsc$w_length])) DO ; M 0175 1 i = .i + 1; ; M 0176 1 ; M 0177 1 .i ; M 0178 1 END ; 0179 1 %; ; 0180 1 ; 0181 1 !+ ; 0182 1 ! FIELDS: ; 0183 1 !- ; 0184 1 ; 0185 1 ! None. ; 0186 1 ; 0187 1 !+ ; 0188 1 ! STRUCTURES: ; 0189 1 !- ; 0190 1 ; 0191 1 OWN ; 0192 1 pixel_size : LONG; ; 0193 1 ; 0194 1 STRUCTURE ; 0195 1 variable_item [i; ] = ; 0196 1 variable_item<.pixel_size*8*i, .pixel_size*8>; ; 0197 1 ; 0198 1 !+ ; 0199 1 ! PSECTS: ; 0200 1 !- ; 0201 1 ; 0202 1 ! None. ; 0203 1 ; 0204 1 !+ ; 0205 1 ! EQUATED SYMBOLS: ; 0206 1 !- ; 0207 1 ; 0208 1 LITERAL ; 0209 1 float = 1, ! Specify to GET_INPUT to return a floating value ; 0210 1 integer = 0; ! Specify to GET_INPUT to return an integer value ; 0211 1 ; 0212 1 !+ ; 0213 1 ! OWN (R/O) STORAGE: ; 0214 1 !- ; 0215 1 ; 0216 1 ! None. ; 0217 1 ; 0218 1 !+ ; 0219 1 ! OWN (R/W) STORAGE: ; 0220 1 !- ; 0221 1 ; 0222 1 OWN ; 0223 1 upper_limit : LONG; ! Maximum pixel value ; 0224 1 ; 0225 1 !+ ; 0226 1 ! BUILTIN DECLARATIONS: ; 0227 1 !- ; 0228 1 ; 0229 1 BUILTIN ; 0230 1 CVTDL, ! Convert Double to Long ; 0231 1 CVTLD, ! Convert Long to Double ; 0232 1 ADDD, ! Double precision add ; 0233 1 DIVD, ! Double precision divide ; 0234 1 MULD, ! Double precision multiply ; 0235 1 SUBD; ! Double precision subtract ; 0236 1 ; 0237 1 !+ ; 0238 1 ! EXTERNAL ROUTINES: ; 0239 1 ! ; 0240 1 ! LIB$GET_INPUT Get input from the user ; 0241 1 ! LIB$GET_VM_PAGE Allocate some pages of virtual memory ; 0242 1 ! LIB$FREE_VM Release some pages of virtual memory ; 0243 1 ! OTS$CVT_TI_L Convert a text integer to a longword ; 0244 1 ! OTS$CVT_T_D Convert a text D floating number to D floating ; 0245 1 ! STR$FREE1_DX Free the storage associated with a dynamic descriptor ; 0246 1 !- ; 0247 1 ; 0248 1 EXTERNAL ROUTINE ; 0249 1 lib$get_input, ; 0250 1 lib$get_vm_page, ; 0251 1 lib$free_vm_page, ; 0252 1 ots$cvt_ti_l, ; 0253 1 ots$cvt_t_d, ; 0254 1 str$free1_dx; ; 0255 1 ; 0256 1 !+ ; 0257 1 ! EXTERNAL REFERENCES: ; 0258 1 !- ; 0259 1 ; 0260 1 ! None. ; 0262 1 %SBTTL 'COMPUTE - Main entry point for this program' ; 0263 1 ROUTINE compute = ; 0264 1 ; 0265 1 !++ ; 0266 1 ! ; 0267 1 ! FUNCTIONAL DESCRIPTION: ; 0268 1 ! ; 0269 1 ! CALLING SEQUENCE: ; 0270 1 ! ; 0271 1 ! main () Called by VMS as the entry point of this program ; 0272 1 ! ; 0273 1 ! LINKAGE: ; 0274 1 ! ; 0275 1 ! CALL ; 0276 1 ! ; 0277 1 ! FORMAL PARAMETERS: ; 0278 1 ! ; 0279 1 ! None. ; 0280 1 ! ; 0281 1 ! IMPLICIT INPUTS: ; 0282 1 ! ; 0283 1 ! None. ; 0284 1 ! ; 0285 1 ! IMPLICIT OUTPUTS: ; 0286 1 ! ; 0287 1 ! None. ; 0288 1 ! ; 0289 1 ! COMPLETION CODES: ; 0290 1 ! ; 0291 1 ! SS$_NORMAL Normal successful completion. ; 0292 1 ! ; 0293 1 ! SIDE AFFECTS: ; 0294 1 ! ; 0295 1 ! Output file is created ; 0296 1 ! ; 0297 1 !-- ; 0298 1 ; 0299 2 BEGIN ; 0300 2 ; 0301 2 LOCAL ; 0302 2 status : LONG, ! Generic status ; 0303 2 center_r : VECTOR [2, LONG], ! Real part of center point, double floating ; 0304 2 center_i : VECTOR [2, LONG], ! Imaginary part of center point, double floating ; 0305 2 scale_r : VECTOR [2, LONG], ! Real part of scale, double floating ; 0306 2 scale_i : VECTOR [2, LONG], ! Imaginary part of scale, double floating ; 0307 2 top_left_r : VECTOR [2, LONG], ! Real part of top_left point of screen ; 0308 2 top_left_i : VECTOR [2, LONG], ! Imaginary part of top_left point of screen ; 0309 2 point_r : VECTOR [2, LONG], ! Real part of current point being computed ; 0310 2 point_i : VECTOR [2, LONG], ! Imaginary part of current point being computed ; 0311 2 j_f : VECTOR [2, LONG], ! Double floating loop index ; 0312 2 i_f : VECTOR [2, LONG], ! Double floating loop index ; 0313 2 h_step_f : VECTOR [2, LONG], ! Double floating horizontal step amount ; 0314 2 v_step_f : VECTOR [2, LONG], ! Double floating vertical step amount ; 0315 2 h_size : LONG, ! Horizontal size of image in pixels ; 0316 2 v_size : LONG, ! Vertical size of image in pixels ; 0317 2 h_size_f : VECTOR [2, LONG], ! Horizontal size of image in pixels, double floating ; 0318 2 v_size_f : VECTOR [2, LONG], ! Vertical size of image in pixels, double floating ; 0319 2 fab : $fab_decl, ! File Access Block ; 0320 2 rab : $rab_decl, ! Record Access Block ; 0321 2 num_blocks : LONG, ! Number of blocks in file ; 0322 2 index : LONG, ! index variable ; 0323 2 screen : REF variable_item, ! Pointer to screen array ; 0324 2 header : REF BLOCK [, BYTE] FIELD (hdr_hdrdef_fieldset), ! Pointer to header block ; 0325 2 file_name : _string_desc (class = d); ! Name of file to create ; 0326 2 ; 0327 2 !+ ; 0328 2 ! Ask user for controlling parameters ; 0329 2 !- ; 0330 2 ; 0331 3 IF NOT (status = lib$get_input (file_name, %ASCID'File name > ')) ! ; 0332 2 THEN ; 0333 2 SIGNAL (.status); ; 0334 2 ; 0335 2 file_name [dsc$w_length] = _find_whitespace (file_name); ! Trim off white space ; 0336 2 ; 0337 2 DO ; 0338 2 get_input (%ASCID'Bytes per pixel > ', pixel_size, integer) ; 0339 2 UNTIL ((.pixel_size GEQU 1) AND (.pixel_size LEQU 4)); ; 0340 2 ; 0341 2 DO ; 0342 2 get_input (%ASCID'Max pixel value > ', upper_limit, integer) ; 0343 2 UNTIL ((.upper_limit GEQU 1) AND (.upper_limit LEQU (2^(.pixel_size*8)) - 1)); ; 0344 2 ; 0345 2 get_input (%ASCID'Center_r > ', center_r, float); ; 0346 2 get_input (%ASCID'Center_i > ', center_i, float); ; 0347 2 get_input (%ASCID'Scale_r > ', scale_r, float); ; 0348 2 get_input (%ASCID'Scale_i > ', scale_i, float); ; 0349 2 get_input (%ASCID'Horizontal size > ', h_size, integer); ; 0350 2 get_input (%ASCID'Vertical size > ', v_size, integer); ; 0351 2 ; 0352 2 !+ ; 0353 2 ! Grab some heap the size of the screen image to be computed ; 0354 2 !- ; 0355 2 ; 0356 2 num_blocks = (((.h_size*.v_size*.pixel_size) + 511)/512) + 1; ; 0357 2 ; 0358 3 IF NOT (status = lib$get_vm_page (num_blocks, header)) ! Allocate some virtual memory ; 0359 2 THEN ; 0360 2 SIGNAL (.status); ; 0361 2 ; 0362 2 CH$FILL (0, .num_blocks*512, header [0, 0, 0, 0]); ! Clear to zero ; 0363 2 screen = header [0, 0, 0, 0] + 512; ! Point SCREEN to screen memory area ; 0364 2 ; 0365 2 !+ ; 0366 2 ! Fill in the header ; 0367 2 !- ; 0368 2 ; 0369 2 header [hdr_l_version] = hdr_k_version; ; 0370 2 header [hdr_f_center_r] = .center_r; ; 0371 2 header [hdr_f_center_i] = .center_i; ; 0372 2 header [hdr_f_scale_r] = .scale_r; ; 0373 2 header [hdr_f_scale_i] = .scale_i; ; 0374 2 header [hdr_l_hsize] = .h_size; ; 0375 2 header [hdr_l_vsize] = .v_size; ; 0376 2 header [hdr_l_pixel_size] = .pixel_size; ; 0377 2 header [hdr_l_max_value] = .upper_limit; ; 0378 2 ; 0379 3 IF NOT (status = $gettim (timadr = header [hdr_q_time])) ! Get current system time/date ; 0380 2 THEN ; 0381 2 SIGNAL (.status); ; 0382 2 ; 0383 2 !+ ; 0384 2 ! Declare the output file ; 0385 2 !- ; 0386 2 ; P 0387 2 $fab_init (fab = fab, ! Address of File Access Block ; P 0388 2 fna = .file_name [dsc$a_pointer], ! Address of file name ; P 0389 2 fns = .file_name [dsc$w_length], ! Length of file name ; P 0390 2 dnm = '.pic', ! Default file name ; P 0391 2 alq = .num_blocks, ! Allocation size ; P 0392 2 fac = put, ! File access - PUT ; P 0393 2 fop = sqo, ! File operations - Sequential ; P 0394 2 org = seq, ! File organization - Sequential ; P 0395 2 rfm = fix, ! Record format - Fixed ; 0396 2 mrs = 512); ! Maximum record size ; 0397 2 ! ; P 0398 2 $rab_init (rab = rab, ! Address of Record Access Block ; P 0399 2 fab = fab, ! Address of File Access Block ; P 0400 2 rac = seq, ! Record access - Sequential ; P 0401 2 rop = wbh, ! Record operations - Write behind ; P 0402 2 rsz = 512, ! Record size ; 0403 2 rbf = header [0, 0, 0, 0]); ! Record buffer ; 0404 2 ; 0405 2 !+ ; 0406 2 ! Create and open the output file ; 0407 2 !- ; 0408 2 ; 0409 3 IF NOT (status = $create (fab = fab)) ! Create the file ; 0410 2 THEN ; 0411 2 SIGNAL (.fab [fab$l_sts], .fab [fab$l_stv]); ; 0412 2 ; 0413 3 IF NOT (status = $connect (rab = rab)) ! Connect record stream ; 0414 2 THEN ; 0415 2 SIGNAL (.rab [rab$l_sts], .rab [rab$l_stv]); ; 0416 2 ; 0417 2 !+ ; 0418 2 ! Compute the left side coordinates ; 0419 2 !- ; 0420 2 ; 0421 2 CVTLD (h_size, h_size_f); ! Convert hsize to double floating ; 0422 2 CVTLD (v_size, v_size_f); ! Convert vsize to double floating ; 0423 2 ! ; 0424 2 SUBD (scale_r, center_r, top_left_r); ! top_left_r = center_r - scale_r ; 0425 2 ADDD (scale_i, center_i, top_left_i); ! top_left_i = center_i + scale_i ; 0426 2 ! ; 0427 2 MULD (PLIT (%D'2.0'), scale_r, h_step_f); ! h_step_f = scale_r * 2 ; 0428 2 DIVD (h_size_f, h_step_f, h_step_f); ! h_step_f = h_step_f / h_size ; 0429 2 ! ; 0430 2 MULD (PLIT (%D'2.0'), scale_i, v_step_f); ! v_step_f = scale_i * 2 ; 0431 2 DIVD (v_size_f, v_step_f, v_step_f); ! v_step_f = v_step_f / v_size ; 0432 2 ; 0433 2 !+ ; 0434 2 ! Loop through the entire screen image (h_size * v_size) and determine ; 0435 2 ! if each pixel is part of the Mandelbrot set ; 0436 2 !- ; 0437 2 ; 0438 2 INCR i FROM 0 TO .v_size - 1 DO ; 0439 2 ; 0440 2 INCR j FROM 0 TO .h_size - 1 DO ; 0441 3 BEGIN ; 0442 3 CVTLD (j, j_f); ! j_f = FLOAT ( j ) ; 0443 3 MULD (j_f, h_step_f, point_r); ! point_r = h_step_f * j_f ; 0444 3 ADDD (top_left_r, point_r, point_r);! point_r = point_r + top_left_r ; 0445 3 ! ; 0446 3 CVTLD (i, i_f); ! i_f = FLOAT ( i ) ; 0447 3 MULD (i_f, v_step_f, point_i); ! point_i = v_step_f * i_f ; 0448 3 SUBD (point_i, top_left_i, point_i);! point_i = top_left_i - point_i ; 0449 3 ! ; 0450 3 index = .i*.h_size + .j; ! Point to screen element we are computing ; 0451 3 screen [.index] = compute_value (point_r [0], point_i [0]); ! Compute this pixel's value ; 0452 2 END; ; 0453 2 ; 0454 2 !+ ; 0455 2 ! Write out the screen image, one block at a time ; 0456 2 !- ; 0457 2 ; 0458 2 INCR j FROM 0 TO .num_blocks - 1 DO ; 0459 3 BEGIN ; 0460 3 ; 0461 4 IF NOT (status = $put (rab = rab)) ! Write a block ; 0462 3 THEN ; 0463 3 SIGNAL (.rab [rab$l_sts], .rab [rab$l_stv]); ; 0464 3 ; 0465 3 rab [rab$l_rbf] = .rab [rab$l_rbf] + 512; ! Point to next block ; 0466 2 END; ; 0467 2 ; 0468 2 !+ ; 0469 2 ! Disconnect from the file, and close it ; 0470 2 !- ; 0471 2 ; 0472 3 IF NOT (status = $disconnect (rab = rab)) ! Disconnect record stream ; 0473 2 THEN ; 0474 2 SIGNAL (.rab [rab$l_sts], .rab [rab$l_stv]); ; 0475 2 ; 0476 3 IF NOT (status = $close (fab = fab)) ! Close file ; 0477 2 THEN ; 0478 2 SIGNAL (.fab [fab$l_sts], .fab [fab$l_stv]); ; 0479 2 ; 0480 2 ss$_normal ! Routine value ; 0481 1 END; ! End of routine COMPUTE .TITLE COMPUTE Mandelbrot compute .IDENT \V001-1\ .PSECT $OWN$,NOEXE,2 ;PIXEL_SIZE U.4: .BLKB 4 ; 00000 ;UPPER_LIMIT U.5: .BLKB 4 ; 00004 .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAB: .ASCII \File name > \ ; 6D 61 6E 20 65 6C 69 46 00000 ; 20 3E 20 65 00008 P.AAA: .LONG 17694732 ; 010E000C 0000C .ADDRESS P.AAB ; 00000000' 00010 P.AAD: .ASCII \Bytes per pixel > \<0><0> ; 65 70 20 73 65 74 79 42 00014 ; 20 6C 65 78 69 70 20 72 0001C ; 00 00 20 3E 00024 P.AAC: .LONG 17694738 ; 010E0012 00028 .ADDRESS P.AAD ; 00000000' 0002C P.AAF: .ASCII \Max pixel value > \<0><0> ; 65 78 69 70 20 78 61 4D 00030 ; 20 65 75 6C 61 76 20 6C 00038 ; 00 00 20 3E 00040 P.AAE: .LONG 17694738 ; 010E0012 00044 .ADDRESS P.AAF ; 00000000' 00048 P.AAH: .ASCII \Center_r > \<0> ; 72 5F 72 65 74 6E 65 43 0004C ; 00 20 3E 20 00054 P.AAG: .LONG 17694731 ; 010E000B 00058 .ADDRESS P.AAH ; 00000000' 0005C P.AAJ: .ASCII \Center_i > \<0> ; 69 5F 72 65 74 6E 65 43 00060 ; 00 20 3E 20 00068 P.AAI: .LONG 17694731 ; 010E000B 0006C .ADDRESS P.AAJ ; 00000000' 00070 P.AAL: .ASCII \Scale_r > \<0><0> ; 20 72 5F 65 6C 61 63 53 00074 ; 00 00 20 3E 0007C P.AAK: .LONG 17694730 ; 010E000A 00080 .ADDRESS P.AAL ; 00000000' 00084 P.AAN: .ASCII \Scale_i > \<0><0> ; 20 69 5F 65 6C 61 63 53 00088 ; 00 00 20 3E 00090 P.AAM: .LONG 17694730 ; 010E000A 00094 .ADDRESS P.AAN ; 00000000' 00098 P.AAP: .ASCII \Horizontal size > \<0><0> ; 74 6E 6F 7A 69 72 6F 48 0009C ; 20 65 7A 69 73 20 6C 61 000A4 ; 00 00 20 3E 000AC P.AAO: .LONG 17694738 ; 010E0012 000B0 .ADDRESS P.AAP ; 00000000' 000B4 P.AAR: .ASCII \Vertical size > \ ; 6C 61 63 69 74 72 65 56 000B8 ; 20 3E 20 65 7A 69 73 20 000C0 P.AAQ: .LONG 17694736 ; 010E0010 000C8 .ADDRESS P.AAR ; 00000000' 000CC P.AAS: .ASCII \.pic\ ; 63 69 70 2E 000D0 .LONG 2 ; 00000002 000D4 P.AAT: .LONG ^X00004100, ^X00000000 ; 00000000 00004100 000D8 .LONG 2 ; 00000002 000E0 P.AAU: .LONG ^X00004100, ^X00000000 ; 00000000 00004100 000E4 .EXTRN LIB$GET_INPUT, LIB$GET_VM_PAGE, LIB$FREE_VM_PAGE, OTS$CVT_TI_L, OTS$CVT_T_D, STR$FREE1_DX .EXTRN SYS$GETTIM, SYS$CREATE, SYS$CONNECT, SYS$PUT, SYS$DISCONNECT, SYS$CLOSE .PSECT $CODE$,NOWRT,2 ;COMPUTE U.1: .WORD ^M ;Save R2,R3,R4,R5,R6,R7,R8,R9,R10 0263 07FC 00000 MOVAB -284(SP), SP ;-284(SP), SP 5E FEE4 CE 9E 00002 MOVL #34471936, 16(SP) ;#34471936, FILE_NAME 0325 10 AE 020E0000 8F D0 00007 CLRL 20(SP) ;FILE_NAME+4 14 AE D4 0000F PUSHAB W^P.AAA ;P.AAA 0331 0000' CF 9F 00012 PUSHAB 20(SP) ;FILE_NAME 14 AE 9F 00016 CALLS #2, G^LIB$GET_INPUT ;#2, LIB$GET_INPUT 00000000G 00 02 FB 00019 MOVL R0, R10 ;R0, STATUS 5A 50 D0 00020 BLBS R10, 1$ ;STATUS, 1$ 09 5A E8 00023 PUSHL R10 ;STATUS 0333 5A DD 00026 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL 00000000G 00 01 FB 00028 1$: CLRL R0 ;I 0335 50 D4 0002F BRB 3$ ;3$ 02 11 00031 2$: INCL R0 ;I 50 D6 00033 3$: MOVZBL @20(SP)[R0], R1 ;@FILE_NAME+4[I], R1 51 14 BE40 9A 00035 CLRL R2 ;R2 52 D4 0003A CMPB R1, #9 ;R1, #9 09 51 91 0003C BNEQ 4$ ;4$ 04 12 0003F INCL R2 ;R2 52 D6 00041 BRB 5$ ;5$ 28 11 00043 4$: CMPB R1, #32 ;R1, #32 20 51 91 00045 BEQL 5$ ;5$ 23 13 00048 TSTL R1 ;R1 51 D5 0004A BEQL 5$ ;5$ 1F 13 0004C CMPB R1, #7 ;R1, #7 07 51 91 0004E BEQL 5$ ;5$ 1A 13 00051 BLBS R2, 5$ ;R2, 5$ 17 52 E8 00053 CMPB R1, #10 ;R1, #10 0A 51 91 00056 BEQL 5$ ;5$ 12 13 00059 CMPB R1, #12 ;R1, #12 0C 51 91 0005B BEQL 5$ ;5$ 0D 13 0005E CMPB R1, #13 ;R1, #13 0D 51 91 00060 BEQL 5$ ;5$ 08 13 00063 CMPZV #0, #16, 16(SP), R0 ;#0, #16, FILE_NAME, I 10 00 ED 00065 ; 50 10 AE 00068 BGTRU 2$ ;2$ C6 1A 0006B 5$: MOVW R0, 16(SP) ;I, FILE_NAME 10 AE 50 B0 0006D 6$: CLRL -(SP) ;-(SP) 0338 7E D4 00071 PUSHAB W^U.4 ;U.4 0000' CF 9F 00073 PUSHAB W^P.AAC ;P.AAC 0000' CF 9F 00077 CALLS #3, W^U.2 ;#3, U.2 0000V CF 03 FB 0007B TSTL W^U.4 ;U.4 0339 0000' CF D5 00080 BEQL 6$ ;6$ EB 13 00084 CMPL W^U.4, #4 ;U.4, #4 04 0000' CF D1 00086 BGTRU 6$ ;6$ E4 1A 0008B 7$: CLRL -(SP) ;-(SP) 0342 7E D4 0008D PUSHAB W^U.5 ;U.5 0000' CF 9F 0008F PUSHAB W^P.AAE ;P.AAE 0000' CF 9F 00093 CALLS #3, W^U.2 ;#3, U.2 0000V CF 03 FB 00097 TSTL W^U.5 ;U.5 0343 0000' CF D5 0009C BEQL 7$ ;7$ EB 13 000A0 ASHL #3, W^U.4, R0 ;#3, U.4, R0 0000' CF 03 78 000A2 ; 50 000A7 ASHL R0, #2, R0 ;R0, #2, R0 02 50 78 000A8 ; 50 000AB DECL R0 ;R0 50 D7 000AC CMPL W^U.5, R0 ;U.5, R0 50 0000' CF D1 000AE BGTRU 7$ ;7$ D8 1A 000B3 PUSHL #1 ;#1 0345 01 DD 000B5 PUSHAB -8(FP) ;CENTER_R F8 AD 9F 000B7 PUSHAB W^P.AAG ;P.AAG 0000' CF 9F 000BA CALLS #3, W^U.2 ;#3, U.2 0000V CF 03 FB 000BE PUSHL #1 ;#1 0346 01 DD 000C3 PUSHAB -16(FP) ;CENTER_I F0 AD 9F 000C5 PUSHAB W^P.AAI ;P.AAI 0000' CF 9F 000C8 CALLS #3, W^U.2 ;#3, U.2 0000V CF 03 FB 000CC PUSHL #1 ;#1 0347 01 DD 000D1 PUSHAB -24(FP) ;SCALE_R E8 AD 9F 000D3 PUSHAB W^P.AAK ;P.AAK 0000' CF 9F 000D6 CALLS #3, W^U.2 ;#3, U.2 0000V CF 03 FB 000DA PUSHL #1 ;#1 0348 01 DD 000DF PUSHAB -32(FP) ;SCALE_I E0 AD 9F 000E1 PUSHAB W^P.AAM ;P.AAM 0000' CF 9F 000E4 CALLS #3, W^U.2 ;#3, U.2 0000V CF 03 FB 000E8 CLRL -(SP) ;-(SP) 0349 7E D4 000ED PUSHAB 4(SP) ;H_SIZE 04 AE 9F 000EF PUSHAB W^P.AAO ;P.AAO 0000' CF 9F 000F2 CALLS #3, W^U.2 ;#3, U.2 0000V CF 03 FB 000F6 CLRL -(SP) ;-(SP) 0350 7E D4 000FB PUSHAB 8(SP) ;V_SIZE 08 AE 9F 000FD PUSHAB W^P.AAQ ;P.AAQ 0000' CF 9F 00100 CALLS #3, W^U.2 ;#3, U.2 0000V CF 03 FB 00104 MULL3 4(SP), (SP), R0 ;V_SIZE, H_SIZE, R0 0356 6E 04 AE C5 00109 ; 50 0010D MULL2 W^U.4, R0 ;U.4, R0 50 0000' CF C4 0010E MOVAB 511(R0), R0 ;511(R0), R0 50 01FF C0 9E 00113 DIVL2 #512, R0 ;#512, R0 50 00000200 8F C6 00118 MOVAB 1(R0), 12(SP) ;1(R0), NUM_BLOCKS 0C AE 01 A0 9E 0011F PUSHAB 8(SP) ;HEADER 0358 08 AE 9F 00124 PUSHAB 16(SP) ;NUM_BLOCKS 10 AE 9F 00127 CALLS #2, G^LIB$GET_VM_PAGE ;#2, LIB$GET_VM_PAGE 00000000G 00 02 FB 0012A MOVL R0, R10 ;R0, STATUS 5A 50 D0 00131 BLBS R10, 8$ ;STATUS, 8$ 09 5A E8 00134 PUSHL R10 ;STATUS 0360 5A DD 00137 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL 00000000G 00 01 FB 00139 8$: ASHL #9, 12(SP), R0 ;#9, NUM_BLOCKS, R0 0362 0C AE 09 78 00140 ; 50 00144 MOVL 8(SP), R7 ;HEADER, R7 57 08 AE D0 00145 MOVC5 #0, (SP), #0, R0, (R7) ;#0, (SP), #0, R0, (R7) 6E 00 2C 00149 ; 50 00 0014C ; 67 0014E MOVAB 512(R7), R6 ;512(R7), SCREEN 0363 56 0200 C7 9E 0014F MOVL #1, (R7) ;#1, (R7) 0369 67 01 D0 00154 MOVL -8(FP), 4(R7) ;CENTER_R, 4(R7) 0370 04 A7 F8 AD D0 00157 MOVL -16(FP), 8(R7) ;CENTER_I, 8(R7) 0371 08 A7 F0 AD D0 0015C MOVL -24(FP), 12(R7) ;SCALE_R, 12(R7) 0372 0C A7 E8 AD D0 00161 MOVL -32(FP), 16(R7) ;SCALE_I, 16(R7) 0373 10 A7 E0 AD D0 00166 MOVQ (SP), 20(R7) ;H_SIZE, 20(R7) 0374 14 A7 6E 7D 0016B MOVQ W^U.4, 36(R7) ;U.4, 36(R7) 0376 24 A7 0000' CF 7D 0016F PUSHAB 28(R7) ;28(R7) 0379 1C A7 9F 00175 CALLS #1, G^SYS$GETTIM ;#1, SYS$GETTIM 00000000G 00 01 FB 00178 MOVL R0, R10 ;R0, STATUS 5A 50 D0 0017F BLBS R10, 9$ ;STATUS, 9$ 09 5A E8 00182 PUSHL R10 ;STATUS 0381 5A DD 00185 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL 00000000G 00 01 FB 00187 9$: MOVC5 #0, (SP), #0, #80, 92(SP) ;#0, (SP), #0, #80, $RMS_PTR 0396 6E 00 2C 0018E ; 0050 8F 00 00191 ; 5C AE 00195 MOVW #20483, 92(SP) ;#20483, $RMS_PTR 5C AE 5003 8F B0 00197 MOVZBL #64, 96(SP) ;#64, $RMS_PTR+4 60 AE 40 8F 9A 0019D MOVL 12(SP), 108(SP) ;NUM_BLOCKS, $RMS_PTR+16 6C AE 0C AE D0 001A2 MOVB #1, 114(SP) ;#1, $RMS_PTR+22 72 AE 01 90 001A7 CLRB 121(SP) ;$RMS_PTR+29 79 AE 94 001AB MOVB #1, 123(SP) ;#1, $RMS_PTR+31 7B AE 01 90 001AE MOVL 20(SP), 136(SP) ;FILE_NAME+4, $RMS_PTR+44 0088 CE 14 AE D0 001B2 MOVAB W^P.AAS, 140(SP) ;P.AAS, $RMS_PTR+48 008C CE 0000' CF 9E 001B8 MOVB 16(SP), -140(FP) ;FILE_NAME, $RMS_PTR+52 FF74 CD 10 AE 90 001BF MOVB #4, -139(FP) ;#4, $RMS_PTR+53 FF75 CD 04 90 001C5 MOVW #512, -138(FP) ;#512, $RMS_PTR+54 FF76 CD 0200 8F B0 001CA MOVC5 #0, (SP), #0, #68, 24(SP) ;#0, (SP), #0, #68, $RMS_PTR 0403 6E 00 2C 001D1 ; 0044 8F 00 001D4 ; 18 AE 001D8 MOVW #17409, 24(SP) ;#17409, $RMS_PTR 18 AE 4401 8F B0 001DA MOVZWL #1024, 28(SP) ;#1024, $RMS_PTR+4 1C AE 0400 8F 3C 001E0 CLRB 54(SP) ;$RMS_PTR+30 36 AE 94 001E6 MOVW #512, 58(SP) ;#512, $RMS_PTR+34 3A AE 0200 8F B0 001E9 MOVL R7, 64(SP) ;R7, $RMS_PTR+40 40 AE 57 D0 001EF MOVAB 92(SP), 84(SP) ;FAB, $RMS_PTR+60 54 AE 5C AE 9E 001F3 PUSHAB 92(SP) ;FAB 0409 5C AE 9F 001F8 CALLS #1, G^SYS$CREATE ;#1, SYS$CREATE 00000000G 00 01 FB 001FB MOVL R0, R10 ;R0, STATUS 5A 50 D0 00202 BLBS R10, 10$ ;STATUS, 10$ 0D 5A E8 00205 PUSHL 104(SP) ;FAB+12 0411 68 AE DD 00208 PUSHL 104(SP) ;FAB+8 68 AE DD 0020B CALLS #2, G^LIB$SIGNAL ;#2, LIB$SIGNAL 00000000G 00 02 FB 0020E 10$: PUSHAB 24(SP) ;RAB 0413 18 AE 9F 00215 CALLS #1, G^SYS$CONNECT ;#1, SYS$CONNECT 00000000G 00 01 FB 00218 MOVL R0, R10 ;R0, STATUS 5A 50 D0 0021F BLBS R10, 11$ ;STATUS, 11$ 0D 5A E8 00222 PUSHL 36(SP) ;RAB+12 0415 24 AE DD 00225 PUSHL 36(SP) ;RAB+8 24 AE DD 00228 CALLS #2, G^LIB$SIGNAL ;#2, LIB$SIGNAL 00000000G 00 02 FB 0022B 11$: CVTLD (SP), -104(FP) ;H_SIZE, H_SIZE_F 0421 98 AD 6E 6E 00232 CVTLD 4(SP), -112(FP) ;V_SIZE, V_SIZE_F 0422 90 AD 04 AE 6E 00236 SUBD3 -24(FP), -8(FP), -40(FP) ;SCALE_R, CENTER_R, TOP_LEFT_R 0424 F8 AD E8 AD 63 0023B ; D8 AD 00240 ADDD3 -32(FP), -16(FP), -48(FP) ;SCALE_I, CENTER_I, TOP_LEFT_I 0425 F0 AD E0 AD 61 00242 ; D0 AD 00247 MULD3 W^P.AAT, -24(FP), -88(FP) ;P.AAT, SCALE_R, H_STEP_F 0427 E8 AD 0000' CF 65 00249 ; A8 AD 0024F DIVD2 -104(FP), -88(FP) ;H_SIZE_F, H_STEP_F 0428 A8 AD 98 AD 66 00251 MULD3 W^P.AAU, -32(FP), -96(FP) ;P.AAU, SCALE_I, V_STEP_F 0430 E0 AD 0000' CF 65 00256 ; A0 AD 0025C DIVD2 -112(FP), -96(FP) ;V_SIZE_F, V_STEP_F 0431 A0 AD 90 AD 66 0025E SUBL3 #1, (SP), R9 ;#1, H_SIZE, R9 0440 6E 01 C3 00263 ; 59 00266 MNEGL #1, R2 ;#1, I 0451 52 01 CE 00267 BRB 15$ ;15$ 4D 11 0026A 12$: MULL3 (SP), R2, R7 ;H_SIZE, I, R7 0450 52 6E C5 0026C ; 57 0026F MNEGL #1, R3 ;#1, J 53 01 CE 00270 BRB 14$ ;14$ 40 11 00273 13$: CVTLD R3, -72(FP) ;J, J_F 0442 B8 AD 53 6E 00275 MULD3 -72(FP), -88(FP), -56(FP) ;J_F, H_STEP_F, POINT_R 0443 A8 AD B8 AD 65 00279 ; C8 AD 0027E ADDD2 -40(FP), -56(FP) ;TOP_LEFT_R, POINT_R 0444 C8 AD D8 AD 60 00280 CVTLD R2, -80(FP) ;I, I_F 0446 B0 AD 52 6E 00285 MULD3 -80(FP), -96(FP), -64(FP) ;I_F, V_STEP_F, POINT_I 0447 A0 AD B0 AD 65 00289 ; C0 AD 0028E SUBD3 -64(FP), -48(FP), -64(FP) ;POINT_I, TOP_LEFT_I, POINT_I 0448 D0 AD C0 AD 63 00290 ; C0 AD 00295 ADDL3 R3, R7, R8 ;J, R7, INDEX 0450 57 53 C1 00297 ; 58 0029A ASHL #3, W^U.4, R4 ;#3, U.4, R4 0451 0000' CF 03 78 0029B ; 54 002A0 MULL3 R8, R4, R5 ;INDEX, R4, R5 54 58 C5 002A1 ; 55 002A4 PUSHAB -64(FP) ;POINT_I C0 AD 9F 002A5 PUSHAB -56(FP) ;POINT_R C8 AD 9F 002A8 CALLS #2, W^U.3 ;#2, U.3 0000V CF 02 FB 002AB INSV R0, R5, R4, (R6) ;R0, R5, R4, (SCREEN) 55 50 F0 002B0 ; 66 54 002B3 14$: AOBLEQ R9, R3, 13$ ;R9, J, 13$ 53 59 F3 002B5 ; BC 002B8 15$: AOBLSS 4(SP), R2, 12$ ;V_SIZE, I, 12$ 0440 52 04 AE F2 002B9 ; AE 002BD MNEGL #1, R2 ;#1, J 0458 52 01 CE 002BE BRB 18$ ;18$ 25 11 002C1 16$: PUSHAB 24(SP) ;RAB 0461 18 AE 9F 002C3 CALLS #1, G^SYS$PUT ;#1, SYS$PUT 00000000G 00 01 FB 002C6 MOVL R0, R10 ;R0, STATUS 5A 50 D0 002CD BLBS R10, 17$ ;STATUS, 17$ 0D 5A E8 002D0 PUSHL 36(SP) ;RAB+12 0463 24 AE DD 002D3 PUSHL 36(SP) ;RAB+8 24 AE DD 002D6 CALLS #2, G^LIB$SIGNAL ;#2, LIB$SIGNAL 00000000G 00 02 FB 002D9 17$: ADDL2 #512, 64(SP) ;#512, RAB+40 0465 40 AE 00000200 8F C0 002E0 18$: AOBLSS 12(SP), R2, 16$ ;NUM_BLOCKS, J, 16$ 52 0C AE F2 002E8 ; D6 002EC PUSHAB 24(SP) ;RAB 0472 18 AE 9F 002ED CALLS #1, G^SYS$DISCONNECT ;#1, SYS$DISCONNECT 00000000G 00 01 FB 002F0 MOVL R0, R10 ;R0, STATUS 5A 50 D0 002F7 BLBS R10, 19$ ;STATUS, 19$ 0D 5A E8 002FA PUSHL 36(SP) ;RAB+12 0474 24 AE DD 002FD PUSHL 36(SP) ;RAB+8 24 AE DD 00300 CALLS #2, G^LIB$SIGNAL ;#2, LIB$SIGNAL 00000000G 00 02 FB 00303 19$: PUSHAB 92(SP) ;FAB 0476 5C AE 9F 0030A CALLS #1, G^SYS$CLOSE ;#1, SYS$CLOSE 00000000G 00 01 FB 0030D MOVL R0, R10 ;R0, STATUS 5A 50 D0 00314 BLBS R10, 20$ ;STATUS, 20$ 0D 5A E8 00317 PUSHL 104(SP) ;FAB+12 0478 68 AE DD 0031A PUSHL 104(SP) ;FAB+8 68 AE DD 0031D CALLS #2, G^LIB$SIGNAL ;#2, LIB$SIGNAL 00000000G 00 02 FB 00320 20$: MOVL #1, R0 ;#1, R0 0481 50 01 D0 00327 RET ; 04 0032A ; Routine Size: 811 bytes, Routine Base: $CODE$ + 0000 ; 0483 1 %SBTTL 'GET_INPUT - Get input parameters' ; 0484 1 ROUTINE get_input (prompt_desc, variable, type) = ; 0485 1 ; 0486 1 !++ ; 0487 1 ! ; 0488 1 ! FUNCTIONAL DESCRIPTION: ; 0489 1 ! ; 0490 1 ! This routine is the generic input routine for this module. The user ; 0491 1 ! passes the address of a descriptor which contains the prompt string ; 0492 1 ! to display to the user, the address of where to store the converted ; 0493 1 ! output, and the data type - integer longword, or double floating. ; 0494 1 ! ; 0495 1 ! CALLING SEQUENCE: ; 0496 1 ! ; 0497 1 ! status.wlc.v = get_input (prompt_desc, variable, type) ; 0498 1 ! ; 0499 1 ! FORMAL PARAMETERS: ; 0500 1 ! ; 0501 1 ! prompt_desc Address of descriptor pointing to message to prompt user for input ; 0502 1 ! variable Address of where to place converted input from user ; 0503 1 ! type What type of conversion to do: ; 0504 1 ! 0 Longword integer ; 0505 1 ! 1 Double precision floating point ; 0506 1 ! ; 0507 1 ! IMPLICIT INPUTS: ; 0508 1 ! ; 0509 1 ! None. ; 0510 1 ! ; 0511 1 ! IMPLICIT OUTPUTS: ; 0512 1 ! ; 0513 1 ! Whatever VARIABLE points to will be modified ; 0514 1 ! ; 0515 1 ! COMPLETION CODES: ; 0516 1 ! ; 0517 1 ! SS$_NORMAL Normal successful completion. ; 0518 1 ! ; 0519 1 ! SIDE AFFECTS: ; 0520 1 ! ; 0521 1 ! None. ; 0522 1 ! ; 0523 1 !-- ; 0524 1 ; 0525 2 BEGIN ; 0526 2 ; 0527 2 MAP ; 0528 2 prompt_desc : REF BLOCK [, BYTE], ! String descriptor passed by user ; 0529 2 variable : REF VECTOR [, BYTE]; ! Address of where to put value ; 0530 2 ; 0531 2 LOCAL ; 0532 2 status : LONG, ! Generic status ; 0533 2 old_len : WORD, ! Original length of string ; 0534 2 com_desc : _string_desc (class = d); ! String descriptor for input from user ; 0535 2 ; 0536 2 !+ ; 0537 2 ! Ask the user for input ; 0538 2 !- ; 0539 2 ; 0540 3 IF NOT (status = lib$get_input (com_desc, .prompt_desc)) ! ; 0541 2 THEN ; 0542 2 SIGNAL (.status); ; 0543 2 ; 0544 2 !+ ; 0545 2 ! Skip anything after the first whitespace character ; 0546 2 !- ; 0547 2 ; 0548 2 old_len = .com_desc [dsc$w_length]; ; 0549 2 com_desc [dsc$w_length] = _find_whitespace (com_desc); ; 0550 2 ; 0551 2 !+ ; 0552 2 ! Convert the response to the correct data type; double precision floating ; 0553 2 ! or integer ; 0554 2 !- ; 0555 2 ; 0556 3 IF (.type EQLU float) ; 0557 2 THEN ; 0558 3 BEGIN ; 0559 3 ; 0560 4 IF NOT (status = ots$cvt_t_d (com_desc, .variable)) ! Double precision floating ; 0561 3 THEN ; 0562 3 SIGNAL (.status); ; 0563 3 ; 0564 3 END ; 0565 2 ELSE ; 0566 2 ; 0567 3 IF NOT (status = ots$cvt_ti_l (com_desc, .variable)) ! Integer longword ; 0568 2 THEN ; 0569 2 SIGNAL (.status); ; 0570 2 ; 0571 2 !+ ; 0572 2 ! Free the storage associated with the dynamic descriptor ; 0573 2 !- ; 0574 2 ; 0575 2 com_desc [dsc$w_length] = .old_len; ! Set original string length ; 0576 2 ; 0577 3 IF NOT (status = str$free1_dx (com_desc)) ! Free the string ; 0578 2 THEN ; 0579 2 SIGNAL (.status); ; 0580 2 ; 0581 2 ss$_normal ! Routine value ; 0582 1 END; ! End of routine GET_INPUT ;GET_INPUT U.2: .WORD ^M ;Save R2,R3,R4 0484 001C 00000 SUBL2 #4, SP ;#4, SP 5E 04 C2 00002 PUSHL #34471936 ;#34471936 0534 020E0000 8F DD 00005 CLRL 4(SP) ;COM_DESC+4 04 AE D4 0000B PUSHL 4(AP) ;PROMPT_DESC 0540 04 AC DD 0000E PUSHAB 4(SP) ;COM_DESC 04 AE 9F 00011 CALLS #2, G^LIB$GET_INPUT ;#2, LIB$GET_INPUT 00000000G 00 02 FB 00014 MOVL R0, R3 ;R0, STATUS 53 50 D0 0001B BLBS R3, 1$ ;STATUS, 1$ 09 53 E8 0001E PUSHL R3 ;STATUS 0542 53 DD 00021 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL 00000000G 00 01 FB 00023 1$: MOVW (SP), R4 ;COM_DESC, OLD_LEN 0548 54 6E B0 0002A CLRL R1 ;I 0549 51 D4 0002D BRB 3$ ;3$ 02 11 0002F 2$: INCL R1 ;I 51 D6 00031 3$: MOVZBL @4(SP)[R1], R0 ;@COM_DESC+4[I], R0 50 04 BE41 9A 00033 CLRL R2 ;R2 52 D4 00038 CMPB R0, #9 ;R0, #9 09 50 91 0003A BNEQ 4$ ;4$ 04 12 0003D INCL R2 ;R2 52 D6 0003F BRB 5$ ;5$ 27 11 00041 4$: CMPB R0, #32 ;R0, #32 20 50 91 00043 BEQL 5$ ;5$ 22 13 00046 TSTL R0 ;R0 50 D5 00048 BEQL 5$ ;5$ 1E 13 0004A CMPB R0, #7 ;R0, #7 07 50 91 0004C BEQL 5$ ;5$ 19 13 0004F BLBS R2, 5$ ;R2, 5$ 16 52 E8 00051 CMPB R0, #10 ;R0, #10 0A 50 91 00054 BEQL 5$ ;5$ 11 13 00057 CMPB R0, #12 ;R0, #12 0C 50 91 00059 BEQL 5$ ;5$ 0C 13 0005C CMPB R0, #13 ;R0, #13 0D 50 91 0005E BEQL 5$ ;5$ 07 13 00061 CMPZV #0, #16, (SP), R1 ;#0, #16, COM_DESC, I 10 00 ED 00063 ; 51 6E 00066 BGTRU 2$ ;2$ C7 1A 00068 5$: MOVW R1, (SP) ;I, COM_DESC 6E 51 B0 0006A CMPL 12(AP), #1 ;TYPE, #1 0556 01 0C AC D1 0006D BNEQ 6$ ;6$ 0F 12 00071 PUSHL 8(AP) ;VARIABLE 0560 08 AC DD 00073 PUSHAB 4(SP) ;COM_DESC 04 AE 9F 00076 CALLS #2, G^OTS$CVT_T_D ;#2, OTS$CVT_T_D 00000000G 00 02 FB 00079 BRB 7$ ;7$ 0D 11 00080 6$: PUSHL 8(AP) ;VARIABLE 0567 08 AC DD 00082 PUSHAB 4(SP) ;COM_DESC 04 AE 9F 00085 CALLS #2, G^OTS$CVT_TI_L ;#2, OTS$CVT_TI_L 00000000G 00 02 FB 00088 7$: MOVL R0, R3 ;R0, STATUS 53 50 D0 0008F BLBS R3, 8$ ;STATUS, 8$ 09 53 E8 00092 PUSHL R3 ;STATUS 0569 53 DD 00095 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL 00000000G 00 01 FB 00097 8$: MOVW R4, (SP) ;OLD_LEN, COM_DESC 0575 6E 54 B0 0009E PUSHL SP ;SP 0577 5E DD 000A1 CALLS #1, G^STR$FREE1_DX ;#1, STR$FREE1_DX 00000000G 00 01 FB 000A3 MOVL R0, R3 ;R0, STATUS 53 50 D0 000AA BLBS R3, 9$ ;STATUS, 9$ 09 53 E8 000AD PUSHL R3 ;STATUS 0579 53 DD 000B0 CALLS #1, G^LIB$SIGNAL ;#1, LIB$SIGNAL 00000000G 00 01 FB 000B2 9$: MOVL #1, R0 ;#1, R0 0582 50 01 D0 000B9 RET ; 04 000BC ; Routine Size: 189 bytes, Routine Base: $CODE$ + 032B ; 0584 1 %SBTTL 'COMPUTE_VALUE - Compute the mandelbrot value of the passed point' ; 0585 1 ROUTINE compute_value (point_r, point_i) = ; 0586 1 ; 0587 1 !++ ; 0588 1 ! ; 0589 1 ! FUNCTIONAL DESCRIPTION: ; 0590 1 ! ; 0591 1 ! This routine will compute the Mandelbrot value for a given point, and ; 0592 1 ! return it as the value of this routine. ; 0593 1 ! ; 0594 1 ! CALLING SEQUENCE: ; 0595 1 ! ; 0596 1 ! status.wlc.v = compute (point_r, point_i) ; 0597 1 ! ; 0598 1 ! FORMAL PARAMETERS: ; 0599 1 ! ; 0600 1 ! point_r Real part of point to compute ; 0601 1 ! point_i Imaginary part of point to compute ; 0602 1 ! ; 0603 1 ! IMPLICIT INPUTS: ; 0604 1 ! ; 0605 1 ! upper_limit Maximum pixel value ; 0606 1 ! ; 0607 1 ! IMPLICIT OUTPUTS: ; 0608 1 ! ; 0609 1 ! None. ; 0610 1 ! ; 0611 1 ! COMPLETION STATUS: ; 0612 1 ! ; 0613 1 ! This routine returns the Mandelbrot value of the passed point ; 0614 1 ! ; 0615 1 ! SIDE AFFECTS: ; 0616 1 ! ; 0617 1 ! None. ; 0618 1 ! ; 0619 1 !-- ; 0620 1 ; 0621 2 BEGIN ; 0622 2 ; 0623 2 MAP ; 0624 2 point_r : REF VECTOR [8, BYTE], ! Real part of point to compute ; 0625 2 point_i : REF VECTOR [8, BYTE]; ! Imaginary part of point to compute ; 0626 2 ; 0627 2 LOCAL ; 0628 2 z_r : VECTOR [8, BYTE] INITIAL (%D'0'), ; 0629 2 z_i : VECTOR [8, BYTE] INITIAL (%D'0'), ; 0630 2 z_rs : VECTOR [8, BYTE], ; 0631 2 z_is : VECTOR [8, BYTE], ; 0632 2 z_ris : VECTOR [8, BYTE], ; 0633 2 z_cnt : LONG, ; 0634 2 count : LONG INITIAL (0); ; 0635 2 ; 0636 2 MULD (z_r [0], z_r [0], z_rs [0]); ! z_rs = z_r * z_r ; 0637 2 MULD (z_i [0], z_i [0], z_is [0]); ! z_is = z_i * z_i ; 0638 2 ADDD (z_rs [0], z_is [0], z_ris [0]); ! z_ris = z_rs + z_is ; 0639 2 CVTDL (z_ris [0], z_cnt); ! z_cnt = INT ( z_ris ) ; 0640 2 ; 0641 2 WHILE ((.count LSS .upper_limit) AND (.z_cnt LSS 4)) DO ; 0642 3 BEGIN ; 0643 3 MULD (z_r [0], z_i [0], z_i [0]); ! z_i = z_i * z_r ; 0644 3 MULD (PLIT (%D'2.0'), z_i [0], z_i [0]); ! z_i = z_i * 2 ; 0645 3 ADDD (z_i [0], point_i [0], z_i [0]); ! z_i = z_i * point_i ; 0646 3 SUBD (z_is [0], z_rs [0], z_r [0]); ! z_r = z_is - z_rs ; 0647 3 ADDD (z_r [0], point_r [0], z_r [0]); ! z_r = z_r + point_r ; 0648 3 ! ; 0649 3 MULD (z_r [0], z_r [0], z_rs [0]); ! z_rs = z_r * z_r ; 0650 3 MULD (z_i [0], z_i [0], z_is [0]); ! z_is = z_i * z_i ; 0651 3 ADDD (z_rs [0], z_is [0], z_ris [0]); ! z_ris = z_rs + z_is ; 0652 3 CVTDL (z_ris [0], z_cnt); ! z_cnt = INT ( z_ris ) ; 0653 3 ! ; 0654 3 count = .count + 1; ; 0655 2 END; ; 0656 2 ; 0657 2 .count ; 0658 1 END; ! End of routine COMPUTE_VALUE .PSECT $PLIT$,NOWRT,NOEXE,2 .LONG 2 ; 00000002 000EC P.AAV: .LONG ^X00004100, ^X00000000 ; 00000000 00004100 000F0 .PSECT $CODE$,NOWRT,2 ;COMPUTE_VALUE U.3: .WORD ^M<> ;Save nothing 0585 0000 00000 CLRQ -(SP) ;Z_R 0621 7E 7C 00002 CLRQ -(SP) ;Z_I 7E 7C 00004 CLRL R0 ;COUNT 50 D4 00006 MULD3 8(SP), 8(SP), -(SP) ;Z_R, Z_R, Z_RS 0636 08 AE 08 AE 65 00008 ; 7E 0000D MULD3 8(SP), 8(SP), -(SP) ;Z_I, Z_I, Z_IS 0637 08 AE 08 AE 65 0000E ; 7E 00013 ADDD3 8(SP), (SP), -(SP) ;Z_RS, Z_IS, Z_RIS 0638 6E 08 AE 61 00014 ; 7E 00018 CVTDL (SP), R1 ;Z_RIS, Z_CNT 0639 51 6E 6A 00019 BRB 2$ ;2$ 0647 35 11 0001C 1$: MULD2 32(SP), 24(SP) ;Z_R, Z_I 0643 18 AE 20 AE 64 0001E MULD2 W^P.AAV, 24(SP) ;P.AAV, Z_I 0644 18 AE 0000' CF 64 00023 ADDD2 @8(AP), 24(SP) ;@POINT_I, Z_I 0645 18 AE 08 BC 60 00029 SUBD3 8(SP), 16(SP), 32(SP) ;Z_IS, Z_RS, Z_R 0646 10 AE 08 AE 63 0002E ; 20 AE 00033 ADDD2 @4(AP), 32(SP) ;@POINT_R, Z_R 0647 20 AE 04 BC 60 00035 MULD3 32(SP), 32(SP), 16(SP) ;Z_R, Z_R, Z_RS 0649 20 AE 20 AE 65 0003A ; 10 AE 0003F MULD3 24(SP), 24(SP), 8(SP) ;Z_I, Z_I, Z_IS 0650 18 AE 18 AE 65 00041 ; 08 AE 00046 ADDD3 16(SP), 8(SP), (SP) ;Z_RS, Z_IS, Z_RIS 0651 08 AE 10 AE 61 00048 ; 6E 0004D CVTDL (SP), R1 ;Z_RIS, Z_CNT 0652 51 6E 6A 0004E INCL R0 ;COUNT 0654 50 D6 00051 2$: CMPL R0, W^U.5 ;COUNT, U.5 0641 0000' CF 50 D1 00053 BGEQ 3$ ;3$ 05 18 00058 CMPL R1, #4 ;Z_CNT, #4 04 51 D1 0005A BLSS 1$ ;1$ BF 19 0005D 3$: RET ; 0658 04 0005F ; Routine Size: 96 bytes, Routine Base: $CODE$ + 03E8 ; 0659 1 END ! End of module COMPUTE ; 0660 1 ; 0661 0 ELUDOM .EXTRN LIB$SIGNAL ; PSECT SUMMARY ; ; Name Bytes Attributes ; ; $OWN$ 8 NOVEC, WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $PLIT$ 248 NOVEC,NOWRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $CODE$ 1096 NOVEC,NOWRT, RD , EXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; Library Statistics ; ; -------- Symbols -------- Pages Processing ; File Total Loaded Percent Mapped Time ; ; SYS$SYSROOT:[SYSLIB]LIB.L32;6 21522 86 0 1156 00:02.2 ; DUA0:[NEW_USRLIB]USRLIB.L32;1 234 11 4 29 00:00.7 ; COMMAND QUALIFIERS ; BLIS/LIS=COMPUTE.MAR/SOU=NOHEAD/MACH=(ASS,UNI)/OPT=(SPEED,LEV=3) COMPUTE ; Compilation Complete .END U.1