10! OUTPUT 2 USING "#,K";"<lf>REN<cr>INDENT<cr>RE-STORE ""PLOT5_0""<cr>"
20 !
30 ! This is a copy of the Pascal source code used to make the CSUB.
40 ! $SYSPROG ON$
50 ! $STACKCHECK OFF$
60 ! $IOCHECK OFF$
70 ! $OVFLCHECK OFF$
80 ! $RANGE OFF$
90 ! $DEBUG OFF$
100! $LINES 55$
110! $PAGEWIDTH 80$
120!
130! $FLOAT_HDW TEST$
140!
150! MODULE PLOTCSUBS;
160! {
170! PARAGON: /USERS/SUTTON/RAMBO/CSUBS/PLOTCSUBS.TEXT
180! 14 MAY 86
190!
200! }
210!
220! $SEARCH '/SYSTEMS/BASIC4/CSUBS/CSUBDECL', 'MYBINASM'$
230! IMPORT csubdecl, {for BASIC type defs like BINTVALTYPE}
240! mybinasm; {for binior, binand, set_bits }
250!
260! EXPORT
270! TYPE ar0_type = PACKED ARRAY[0..262143] OF REAL;
280! xy_point = RECORD xp,yp :REAL; END;
290! ar_plot_type = PACKED ARRAY[0..32767] OF xy_point;
300! header_record = RECORD h_offset,h_scale_factor,ovld,h_log_multiplier,
310! h_zero_value, d6, d7, d8, d9, d10 :REAL; END;
320! ar_header_type= PACKED ARRAY[1..1000] OF header_record;
330!
340!
350! PROCEDURE Plot_make_y(
360! data_buffer_dope: DIMENTRYPTR; VAR data_buffer: ar0_type;
370! data_header_dope: DIMENTRYPTR; VAR data_header: ar_header_type;
380! plot_array_dope: DIMENTRYPTR; VAR plot_array: ar_plot_type;
390! VAR buf_num, start_bin, stop_bin, Do_log_y, offset, scale_factor: REAL);
400!
410! IMPLEMENT
420!
430! CONST do_debug=false;
440!
450!
460!
470! PROCEDURE Plot_make_y(
480! data_buffer_dope: DIMENTRYPTR; VAR data_buffer: ar0_type;
490! data_header_dope: DIMENTRYPTR; VAR data_header: ar_header_type;
500! plot_array_dope: DIMENTRYPTR; VAR plot_array: ar_plot_type;
510! VAR buf_num, start_bin, stop_bin, do_log_y, offset, scale_factor: REAL);
520!
530! {This CSUB prepares data for plotting by filling a plot array that
540! can be plotted with one PLOT command in BASIC. It extracts one block
550! of data from Data_buffer() and puts it into Plot_array(). If needed,
560! it computes the log to the base 10 using a quick algorithm.
570!
580! Note: although data_buffer elements are REAL numbers in BASIC, this
590! procedure interprets them as INTEGERS and uses the exponent
600! and 4 bits of the mantissa to compute a quick but not real accurate
610! log. It runs about 10 times faster than a basic FOR loop with LGT
620!
630! For maximum speed, this code has seperate DO loops for several cases.
640!
650! This assumes the following floating point format (see BASIC
660! Programing techniques, Data Storage chapter):
670! word0 word1 word2 word3
680! or
690! lword0 lword1
700! where the bits in word0 are:
710! (mantissa sign), (exponent msb), ... (exp lsb),(mant msb), ..(mant fsb)
720! and fsb=fourth most sig bit
730! }
740!
750! TYPE log_table_type = ARRAY[0..1023] OF REAL;
760! real_record_type = RECORD
770! lword0, lword1 :INTEGER;
780! {msb ... lsb}
790! END;
800!
810! {special type to access real number as 2 integers to do
820! quick log using exponent and mantissa}
830!
840! CONST lgt_of_2 = 0.301029996;
850! ln_of_10 = 2.302585093;
860! two_to_the_20th = 1048576;
870! two_to_the_10th = 1024;
880! exp_mask = binary('0111111111110000'); {just do DIV 2^20}
890! mant_mask = binary('00000000000011111111111111111111');
900! {log_table is a look up table to speed up the log function
910! the first (0ith) element is = LGT(1 + 0/1024),
920! the second is = LGT(1 + 1/1024), ...}
930!
940! log_table=log_table_type[ $INCLUDE 'LOG_TABLE.ASC'$
950! ];
960!
970! VAR
980! b_offset :INTEGER; {index offset for Data_buffer[]}
990! p_offset :BINTVALTYPE; {index offset for Plot_array[]}
1000! buf_num_i :BINTVALTYPE; {Which buffer of Data_buffer[]}
1010! x :BINTVALTYPE; {x axis value or bin number}
1020! x_stop :BINTVALTYPE;
1030! xpon :INTEGER; {exponent of floating point number}
1040! mant :INTEGER; {mantissa}
1050! y_r :REAL; {y axis value interpreted as a real number}
1060! y_i :^real_record_type; {y_r interpreted as 2 32 bit integers}
1070! zero_value :REAL; {for log of zero}
1080! log_multiplier :REAL; {one element of Data_header}
1090!
1100! BEGIN
1110! {get pointer to foil type checking}
1120! y_i := ADDR(y_r);
1130!
1140! buf_num_i:=ROUND(buf_num);
1150!
1160! {figure out b_offset, or what index of data_buffer to start at}
1170! b_offset := (buf_num_i - data_buffer_dope^.bound[1].low)*
1180! data_buffer_dope^.bound[2].length
1190! - data_buffer_dope^.bound[2].low;
1200!
1210! {figuer out p_offset, or where to find start_bin in plot_array}
1220! p_offset := - plot_array_dope^.bound[1].low;
1230!
1240! x_stop := ROUND(stop_bin);
1250!
1260! offset := data_header[buf_num_i].h_offset;
1270! scale_factor := data_header[buf_num_i].h_scale_factor;
1280! log_multiplier := data_header[buf_num_i].h_log_multiplier;
1290! IF do_log_y<>0 THEN log_multiplier:=1.0;
1300!
1310! IF log_multiplier =0 THEN BEGIN {linear ---}
1320! FOR x:=ROUND(start_bin) TO x_stop DO
1330! plot_array[x+p_offset].yp:=data_buffer[x+b_offset]
1340! ;
1350! {offset and scale factor are passed on to be done at plot window}
1360! END ELSE BEGIN {log ------}
1370! zero_value := data_header[buf_num_i].h_zero_value;
1380! zero_value := (zero_value-offset)/scale_factor;
1390! IF zero_value>1.0E-200 THEN zero_value:= LN(zero_value)/ln_of_10;
1400!
1410! IF log_multiplier>0 THEN BEGIN {+log ------}
1420! FOR x:=ROUND(start_bin) TO x_stop DO BEGIN
1430! y_r:= (data_buffer[x+b_offset]-offset)/scale_factor;
1440! IF y_r>1.0E-200 THEN BEGIN {IF >0 }
1450! xpon := (y_i^.lword0 DIV two_to_the_20th) -1023;
1460! mant := binand(mant_mask,y_i^.lword0) DIV two_to_the_10th;
1470! plot_array[x+p_offset].yp:=lgt_of_2*xpon + log_table[mant];
1480! END ELSE { <=0 }
1490! plot_array[x+p_offset].yp:=zero_value;
1500! END; {FOR}
1510! offset:=0.0;
1520! scale_factor:=1/log_multiplier;
1530! END ELSE BEGIN {-log ------}
1540! FOR x:=ROUND(start_bin) TO x_stop DO BEGIN
1550! y_r:= (data_buffer[x+b_offset]-offset)/scale_factor;
1560! IF y_r>1.0E-200 THEN BEGIN {IF >0 }
1570! xpon := (y_i^.lword0 DIV two_to_the_20th) -1023;
1580! mant := binand(mant_mask,y_i^.lword0) DIV two_to_the_10th;
1590! plot_array[x+p_offset].yp:=-(lgt_of_2*xpon + log_table[mant]);
1600! END ELSE { <=0 }
1610! plot_array[x+p_offset].yp:=-zero_value;
1620! END; {FOR}
1630! offset:=0.0;
1640! scale_factor:=-1/log_multiplier;
1650! END; {IF log_multiplier>0}
1660! END; {IF linear ELSE log}
1670! END; {PROCEDURE Plot_make_y}
1680!
1690! END. {module PLOTCSUBS}
1700!
1710!
1720! MNAME MYBINASM
1730! SRC MODULE MYBINASM;
1740! SRC IMPORT csubdecl;
1750! SRC EXPORT
1760! SRC FUNCTION bit_set (v: INTEGER;
1770! SRC b: INTEGER) : BOOLEAN;
1780! SRC FUNCTION binand (X: INTEGER;
1790! SRC Y: INTEGER) : INTEGER;
1800! SRC FUNCTION binior (X: INTEGER;
1810! SRC Y: INTEGER) : INTEGER;
1820! SRC END;
1830! DEF MYBINASM_MYBINASM
1840! DEF MYBINASM_BIT_SET
1850! DEF MYBINASM_BINAND
1860! DEF MYBINASM_BINIOR
1870! * Chris S. 3-Feb-86
1880! * module initialization
1890! MYBINASM_MYBINASM EQU *
1900! RTS
1910! *
1920! * bit test
1930! MYBINASM_BIT_SET EQU *
1940! MOVEA.L (SP)+,A0 save return addr
1950! MOVE.L (SP)+,D0 get bit#
1960! MOVE.L (SP)+,D1 get first parm
1970! CLR.B D2 clear indicator
1980! BTST D0,D1 test bit
1990! BEQ.S BITT_EXIT
2000! MOVEQ #1,D2 if bit set set indicator
2010! BITT_EXIT MOVE.B D2,(SP) push result
2020! JMP (A0) return
2030! *
2040! * binary and
2050! MYBINASM_BINAND EQU *
2060! MOVEA.L (SP)+,A0 save return addr
2070! MOVE.L (SP)+,D0 get last parm
2080! MOVE.L (SP)+,D1 get first parm
2090! AND.L D0,D1 perform AND
2100! MOVE.L D1,(SP) push result
2110! JMP (A0) return
2120! *
2130! * binary inclusive or
2140! MYBINASM_BINIOR EQU *
2150! MOVEA.L (SP)+,A0 save return addr
2160! MOVE.L (SP)+,D0 get last parm
2170! MOVE.L (SP)+,D1 get first parm
2180! OR.L D0,D1 perform OR
2190! MOVE.L D1,(SP) push result
2200! JMP (A0) return
2210!
2220! *
2230! *
2240! END
2250!
2260!
2270 !
2280 END
2290 !************************************************************************
2300 CSUB Plot_make_y(Data_buffer(*),Data_header(*),Plot_array(*),Buf_num,Start_bin,Stop_bin,Do_log_y,Offset,Scale_factor)
2310 SUB Plot_csub_doc
2320 !The above is a compiled sub that
2330 !can be deleted if it causes a configuration error. There should be
2340 !another non-CSUB copy that does the same function, except
2350 !2 to 10 times slower. Execute "DELSUB Plot_make_y" once to
2360 !delete the CSUB.
2370 !A copy of the Pascal source code (stored as BASIC comments) is in
2380 !the file PLOT5_0.
2390 SUBEND