2! OUTPUT 2 USING "#,K";"<lf>INDENT<cr>RE-STORE ""ICODE""<cr>"
3 ! Rev 1.1: Fixed #3 in SUB Icode_debug.
5 !
6 END
8 ! PAGE ->
10 !************************************************************************
12 !
14 Icode_icode:SUB Icode_icode
16 !
18 ! This subroutine is used to initialize the ICODE file. As you can see
20 ! there is not much to initialize.
22 !
24 SUBEND
26 !
28 Icode_assemble:DEF FNIcode_assemble(Source$(*),INTEGER Object(*),INTEGER Info_info,Info$(*),INTEGER Enable_list_arg,List$(*))
30 !
32 !
34 ! This subprogram 'Icode_assemble', is used to translate ICODE assembly
36 ! language programs into object code that can be run in the HP3565S HP-IB
38 ! module. The ICODE assembly language is defined in the ICODE section of
40 ! demo programs manual.
42 !
44 ! ==> Assembler activation:
46 !
48 ! Error_count=FNIcode_assemble(Source$(*),INTEGER Object(*)
50 ! INTEGER Info_info,Info$(*),INTEGER Enable_list_arg
52 ! List$(*))
54 !
56 ! Source$(*): Input - Holds ICODE source code. Each line of Source$
58 ! contains one line of source code. Instructions
60 ! with large parameter list may use more than one
62 ! line by using a continuation line. The first
64 ! character of a continuation line must be a '.'.
66 ! The Source$ index must start at 0.
68 ! The length the string elements in Source$ is
70 ! defined by the user.
72 ! Assembly will start at the beginning of Source$
74 ! and continue until the end of Source$ is found,
76 ! or until a line containing 'EL_COMPLETO' is
78 ! found. If 'EL_COMPLETO' is used to terminate
80 ! assembly, then Source$ is REDIMed to the actual
82 ! size of the source program.
84 ! Object(*): Output - Holds assembled ICODE object code.
86 ! The Object index must start at 0.
88 ! Object(*) is REDIMed to the size of the object
90 ! code.
92 ! Note that Info_info=2 will increase the size
94 ! object array by 1 element for each assembled
96 ! instruction.
98 ! Info_info: Input - Determines what information the assembler
100! should put in the Info$(*) array.
102! 0 - Info$(*) is not accessed.
104! 1 - Info$(*) is filled with information
106! to be used by 'Icode_dld', 'Icode_ext_id'
108! and 'Icode_def_ext'.
110! 2 - Info$(*) is filled with information as
112! if Info_info=1, and filled with info
114! to be used by the 'Icode_debug'.
116! Info_info=2 will also cause 'c_nop's to
118! be insert in between each instruction.
120! This is used by the debugger to set break
122! points. Note that this will increase the
124! size of the object code and also the size
126! of the listing output if enabled.
128! This mode may be used during program
130! development.
132! Info$(*): Output - Holds information to be used by other ICODE
134! file subprograms.
136! The Info$ index must start at 0.
138! If Info_info=0, then Info$(*) is unaffected.
140! If Info_info<>0 then Info$(*) string elements
142! must be 40 characters long.
144! If Info_info=1 then Info$(*) must have 6 lines
146! + one line for each DEFBLK_SP,DEFBLK_MAIN or
148! DEFBLK_EXT.
150! If Info_info=2 then Info$(*) must have as many
152! lines as in Info_info=1 + 4 + one line for each
154! DEFBLK_VAR, DEFBLK_CON, VAR, + one line for
156! each label, + one line for each 10 instructions.
158! Enable_list_arg: Input - If 0, then List$(*) will not be accessed.
160! If 1, then List$(*) will be filled with the
162! assembly listing.
164! List$(*): Output - Holds the assembly listing.
166! The number of elements and the length of each
168! string in List$ is defined by the user.
170! The List$ index must start at 0.
172! List$ string elements should be 15 chars
174! longer than the string elements in Source(*).
176! The number of elements in List$ should be
178! ABOUT 2 to 4 times the number of lines in
180! Source$(*). Note that Info_info=2 will cause
182! the assembler to insert 'c_nop's in between
184! each instruction. These 'c_nop's will show
186! up in List$. List$ will be REDIMed to the size
188! required to host the assembly listing
190!
192! ==> Example assembler activation:
194!
196! The following is an example of how the assemble an in line ICODE program.
198!
200! 110 Icode_program:!
202! 120 DATA " err_abrt_count 5"
204! 130 DATA " err_disp_lines 3"
206! 140 DATA " var loop_ptr 0 "
208! 150 DATA " const loop_max 10 ! loop 10 times"
210! 160 DATA " "
212! 170 DATA "loop_begin: f_signal loop_ptr
214! 180 DATA " v_add loop_ptr,loop_ptr,1 ! inc ptr"
216! 190 DATA " c_beq loop_begin loop_ptr "
218! 200 DATA ". loop_max "
220! 210 DATA " c_end "
222! 220 DATA "el_completo"
224! .
226! .
228! 500 DIM Source$(0:200)[80],List$(0:400)[120],Source_line$[80]
230! 510 INTEGER Object(0:300),Info_info,Enable_list,Prog_id,Error_count
232! .
234! 600 Source_ptr=-1
236! 610 RESTORE Icode_program
238! 620 REPEAT
240! 630 READ Source_line$
242! 640 Source_ptr=source_ptr+1
244! 650 Source$(Source_ptr)=Source_line$
246! 660 UNTIL Source_line="el_completo"
248! 670 !
250! 680 Info_info=2 ! Enable auto allocate vars and debugger
252! 690 Enable_list=1 ! Enable listing
254! 700 !
256! 710 Error_count=FNIcode_assemble(Source$(*),Object(*),Info_info,Info$(*)
258! Enable_list,List$(*))
260! 720 IF Error_count<>0 THEN
262! 730 OUTPUT CRT; "Errors during assembly. Program paused"
264! 740 PAUSE
266! 750 END IF
268! 760 Prog_id=FNIcode_dld(Object(*),Info_info,Info$(*)) ! download prog
270! 770 IF Prog_id<=0 THEN
272! 780 OUTPUT CRT; "Couldn't download ICODE program. Program paused."
274! 790 PAUSE
276! 800 END IF
278! 810 FNHw_cmd("PROG "&Prog_id) ! start ICODE program
280! .
282! .
284!
286! ==> Listing format: (all values in Hex)
288!
290! OBJ ASM ASM SOURCE CODE
292! ADDR VALU VALU
294!
296! 0004 0000 0004 var loop_ptr 0
298! 000A const loop_max 10 ! loop 10 times
300!
302! 0006 003D <c_nop>
304! 0007 0012,FFFE loop_begin: f_signal loop_ptr ! send loop ptr
306! 0009 003D <c_nop>
308! 000A 0047,FFFE v_add loop_ptr,loop_ptr,1 ! inc ptr
310! 000C FFFE,0001
312! 000E 003D <c_nop>
314! 000F 0039,0000 c_beq loop_begin loop_ptr
316! 0011 0006,FFFE . loop_max
318! 0013 000A
320! 0014 003D <c_nop>
322! 0015 0030 c_end
324! 0016 003D <c_nop>
326!
328! The array List$ will be filled the the assembly listing if the input
330! parameter List_enable is non zero. The listing has the following format:
332! + The first column of the listing indicates the hex address into the
334! object array.
336! + The second and third columns are the data values inserted into the
338! Object array.
340! + The rest of the line is the source code
342! + Lines that contain <c_nop> are inserted by the assembler for use by
344! the debugger in setting break points. These <c_nop>s would not be e
346! if Info_info were equal to 0 or 1.
348!
350! ==> Source code format general:
352!
354! The source code passed to the assembler through Source$(*) has two
356! sections. The first section is the pseudo-op section, and the second
358! section is the main assembly section. Most of the syntax is similar
360! to that of a standard assembler. Some global notes follow:
362! + All parameter fields that require a numerical field may be in
364! decimal or in hex. Hex numbers are specified by a "$" directly
366! before the hex number.
368! + All characters after the first occurrence of an '!' on any line
370! will be treated as comments.
372! + Parameter list elements may be delimited by either a space or by
374! a comma. Between the opcode and the parameter list must be a
376! space.
378! + This is a one pass assembler. Labels are the only type of symbol
380! that may be referenced before the symbol is defined.
382! + Once a CONST has been defined, the CONST symbol may be used any
384! place a numerical field is used.
386! + All symbols may be up to 16 characters long and are case
388! insensitive. The first character in a symbol must be a letter.
390! The rest should be letters, numbers or an underscore. Other
392! characters may not generate an error. User beware.
394! + Symbols may be larger than 16 characters but only the first 16
396! are significant. It would be best to make sure that all symbols
398! are <= 16 characters in length.
400! + ***** NOTE: When a new symbol is defined (Variable name, *****
402! ***** Block name, etc ), NO checking is done to make *****
404! ***** sure that the symbol is not already defined. *****
406! ***** When a reference is made to a duplicate symbol,*****
408! ***** it is undefined as to which one will be *****
410! ***** referenced. *****
412! + Below is a list of characters with special meaning.
414! - '$' used to indicate a hex number.
416! - '^' used to reference a header block.
418! - '@' used to reference a variable through indirection.
420! - ':' used as a label terminator.
422! - ''' used to delimit a string parameter.
424! - '!' used to indicate the beginning of a comment.
426! - ',' used to delimit two parameters.
428! - '.' used to indicate a continuation line.
430!
432!
434! ==> Pseudo-op section:
436!
438! The pseudo-op section of a program begins at the beginning of Source(*)
440! and continues until the end-of-program is found or until the first main
442! assembly instruction is found. Below is a description of each pseudo-op
444! pseudo-op.
446!
448!
450! ERR_ABRT_COUNT <error count>
452!
454! This pseudo-op is used to tell the assembler how many errors should
456! cause the assembler to stop assembling. By default, this value is
458! four.
460!
462! ERR_DISP_LINES <# lines to disp before error>
464!
466! This pseudo-op is used to tell the assembler how many source lines
468! before an instruction with an error should be displayed on the CRT.
470! By default, this value is two.
472!
474! VAR <variable_name> <init value>
476!
478! This pseudo-op is used to define and initialize an ICODE variable.
480! The <init value> field may be a CONST only if the constant has
482! already been defined. To initialize one variable to the variable
484! number of another variable (which must already be defined) do as
486! follows:
488!
490! 20 DATA " var first_var 100 "
492! 30 DATA " var second_var @first_var"
494!
496! In the above example, if 'first_var' is variable number 5, then
498! 'second_var' will be initialized to 5. Note that 'first_var' must
500! be defined before it may be used to initialize another variable.
502! This may be useful if indirect variable accesses are being used.
504!
506!
508! CONST <const name> <const value>
510!
512! This pseudo-op is used to define a constant. A constant symbol may
514! be used any place an immediate parameter (floating point or integer)
516! can be used once the CONST has been defined. If the constant is
518! given a floating point value, and is used is a place that requires
520! an integer (most of the time), the value used is INT(const_val).
522! i.e. the floating point number is truncated.
524!
526! DEFBLK_CON <block_name> <block_id>
528!
530! This pseudo-op is used to define a block id if the block id is known
532! at assembly time.
534!
536! DEFBLK_VAR <block_name> <block_id_var_init_value>
538!
540! This pseudo-op is used to define a block id where the block id will be
542! put in a variable. An init value must be specified even though the
544! variable need not contain the actual block id until runtime.
546!
548! DEFBLK_EXT <block_name>
550!
552 ! This pseudo-op is used to define a block name symbol within the ICODE
554! program, but let the actual binding of the block name to the block id
556! be done external to the assembly process. To bind a block id to the
558! block symbol, the function 'FNIcode_def_ext' need be used. This may
560! be useful if the block type (MAIN or SP) or size is not known at
562! assembly time. This is also useful if multiple ICODE programs wish
564! to share the same block. Through the used of 'FNIcode_def_ext', the
566! user may allocate their own block and then bind it to <block_name> or
568! tell 'FNIcode_def_ext' the block type and size, and have 'FNIcode_dld'
570! allocate the block at runtime. To access the header block that may be
572! associated with <block_name> a 'hat' may be placed in from of the
574! <block_name> in the ICODE program. i.e. ^fft_blk_name
576!
578! DEFBLK_SP <block_name> <blk_size> <hblk_size>
580!
582! This pseudo-op is used to define an HP-IB module SP data RAM block
584 ! for the assembly process and have the downloader allocate the block
586 ! at runtime. For assembly, only the block size and the header block
588 ! size need be known. 'FNIcode_dld' will allocate and bind the correct
590 ! block id to <block_name>. To access the header block that may be
592 ! associated with <block_name> a 'hat' may be placed in from of the
594 ! <block_name> in the ICODE program. i.e. ^fft_blk_name
596 !
598 ! DEFBLK_MAIN <block_name> <blk_size> <hblk_size>
600 !
602 ! This pseudo-op is used to define an HP-IB module MAIN data RAM block
604 ! for the assembly process and have the downloader allocate the block
606 ! at runtime. For assembly, only the block size and the header block
608 ! size need be known. 'FNIcode_dld' will allocate and bind the correct
610 ! block id to <block_name>. To access the header block that may be
612 ! associated with <block_name> a 'hat' may be placed in front of the
614 ! <block_name> in the ICODE program. i.e. ^fft_blk_name
616 !
618 ! LBL_TBL_SIZE <label_table_size>
620 !
622 ! This pseudo-op is used to define the size of the label table size.
624 ! When the assembler comes across a label definition, its name and
626 ! location are placed in this table. Therefore, the label table must
628 ! have one entry for each label in the ICODE program. By default,
630 ! the label table has 50 entries.
632 !
634 ! FORLBL_TBL_SIZE <forward_label_table_size>
636!
638 ! This pseudo-op is used to define the size of the forward reference
640 ! label table. When the assembler comes across a label reference to
642 ! a label that has not been defined yet, an entry is made in this
644 ! table. Note that there may be more than one entry for a single
646 ! label definition. When the label is defined, entry(s) referring
648 ! to the defined label are removed. Since the size of this table
650 ! is not a function of the number of labels, but rather the number
652 ! of undefined forward references outstanding at one time, it is
654 ! a little harder to choose the correct table size. By default, the
656 ! forward reference label table has 100 entries.
658!
660 ! ==> Main assembly section:
662!
664 ! This is the section of the ICODE program that contain the executable
666 ! instructions defined in the HP3565S ICODE manual. The syntax is
668 ! similar to that of a 'normal' assembler. Some general rules are as
670 ! follows:
672 ! + Each instruction must begin on a new line. Instructions with
674 ! parameter lists that require more than one line may use
676 ! continuation lines. A continuation line must have a '.' as
678 ! the first character on that line. Continuation across symbol
680 ! boundaries is not allowed.
682 ! + Too define a label, the label must be the first symbol on the
684 ! line. The label is terminated with an ':'. More than one
686 ! label may be used to point to one place in the ICODE program,
688 ! but each label must be on a separate line.
690 ! + Between the opcode and the parameter list must be a space.
692 ! No comma.
694 ! + Between the parameter list elements may be commas or spaces.
696 ! + Below is some example ICODE source code. This code is NOT
698 ! meant to mean anything program wise. It is meant to show
700 ! some of the basic constructs used in ICODE instructions.
702 !
704 ! 210 DATA "label1: f_signal first_variable ! this is a comment "
706 ! 220 DATA " f_sync "
708 ! 230 DATA "label2: ! label2 and label3 are equivalent"
710 ! 240 DATA "label3: v_add loop_ptr loop_ptr 1 "
712 ! 250 DATA " c_beq exit_prog,loop_ptr,10 "
714 ! 260 DATA " v_mult loop_index ! "
716 ! 270 DATA ". loop_ptr 10 !this is a continuation line"
718 ! 370 DATA " c_goto label1 "
720 !
722 ! + The HP3565S ICODE documentation says that a string parameter
724 ! is preceeded by the length of the string. To specify a string
726 ! parameter, the string need only be enclosed in single quotes
728 ! '''. The assembler will deal with the length field.
730 ! + If it is desired to enter immediate data into the ICODE
732 ! program, then the ASM_OFF directive may be used. The ASM_OFF
734 ! directive is of the form:
736 !
738 ! ASM_OFF <parm_count> <parm1>,...,<parmn>
740 !
742 ! <parm_count> is used to specify how many parameters follow.
744 ! Each parameter is evaluated (immediate, variable, or const)
746 ! and placed in the object array. The ASM_OFF directive may
748 ! not be embedded in another instructions parameter list.
750 !
752 Icode_asm_start: !
754 DIM Line$[255],Opcode$[20],Label$[20],Disp_line$[100],Version$[10]
756 DIM Arg$[20],Variable$[20],Inst_info$[255]
758 INTEGER Asm_loop_done,Def_loop_done,Line_ptr,I,J,K,Enable_list
760 REAL Real_temp,Arg,Max_32_int,Min_32_int,Max_16_int,Min_16_int
762 INTEGER Int_temp,Int_hi,Int_lo,Add_object
764 INTEGER Source_last,Object_last
766 INTEGER Old_forlbl_last
768 INTEGER Info_inst_base,Info_inst_cnt,Inst_cnt
770 DIM Error_string$[100],Block_name$[20]
772 DIM Repeat_str$[512]
774 !
776 ! Let's do some initialization
778 !
780 Icode_version: !
782 Version$="1.0"
784 Disp_line$="ICODE Assembler version "&Version$&" "
786 DISP Disp_line$;" Initializing."
788 !
790 Source_size=SIZE(Source$,1)
792 Object_size=SIZE(Object,1)
794 Info_size=SIZE(Info$,1)
796 List_size=SIZE(List$,1)
798 !
800 Lbl_tbl_size=50 ! default label table size
802 Forlbl_tbl_size=100 ! default forward reference label tbl size
804 Err_abrt_count=4 ! default error count to abort assembly
806 Err_disp_lines=2 ! default # lines to disp when error is found
808 !
810 Error_count=0
812 Missing_arg=0
814 !
816 ! Init table pointers. Pointers point to last entry used.
818 Last_alloc_var=1 ! first var allocated will be var 2
820 Vars_allocated=0
822 Source_last=-1
824 Object_last=-1
826 Old_object_last=-1
828 List_last=-1
830 !
832 Max_32_int=(2^31)-1
834 Min_32_int=-(2^31)
836 Max_16_int=(2^15)-1
838 Min_16_int=-(2^15)
840 !
842 MAT List$= ("")
844 MAT Info$= ("")
846 !
848 ! Check out parameter arrays to see if they are indexed correctly
850 !
852 IF BASE(Object,1)<>0 THEN
854 Error_string$="Object(*) index must start at zero"
856 GOSUB Icode_init_err
858 END IF
860 IF BASE(Source$,1)<>0 THEN
862 Error_string$="Source(*) index must start at zero"
864 GOSUB Icode_init_err
866 END IF
868 IF Enable_list_arg THEN
870 IF BASE(List$,1)<>0 THEN
872 Error_string$="Listing array index must start at zero"
874 GOSUB Icode_init_err
876 END IF
878 ON ERROR GOTO Icode_list_lerr !List$(*) must be at least 80 chars wide
880 List$(0)=RPT$(" ",80) ! Even though List$ elements have 80
882 List$(0)="" ! chars doesn't mean that they are
884 IF 0 THEN ! large enough.
886 Icode_list_lerr:OFF ERROR
888 Error_string$="List$(*) elements should be GREATER than 80 chars"
890 Enable_list=0
892 GOSUB Icode_init_err
894 END IF
896 END IF
898 !
900 GOSUB Icode_chk_info ! Check Info$(*) for correct dimensions
902 !
904 ! Do Pre-pass. Go through pseudo-op section of ICODE program and
906 ! find out how large tables must be.
908 !
910 Var_tbl_size=0
912 Blkvar_tbl_size=0
914 Blkext_tbl_size=0
916 Blkcon_tbl_size=0
918 Const_tbl_size=0
920 !
922 DISP Disp_line$;" Doing Pre-pass."
924 Icode_def_loop: ! Pre-pass: Just get table size info
926 Enable_list=0 ! Disable listing for pre-pass.
928 Def_loop_done=0
930 REPEAT
932 GOSUB Icode_next_line
934 GOSUB Icode_skip_lbl
936 GOSUB Icode_get_opcod
938 GOSUB Icode_init_inst
940 SELECT Opcode$
942 CASE "VAR"
944 Var_tbl_size=Var_tbl_size+1
946 CASE "DEFBLK_VAR"
948 Blkvar_tbl_size=Blkvar_tbl_size+1
950 CASE "DEFBLK_SP","DEFBLK_MAIN","DEFBLK_EXT"
952 Blkext_tbl_size=Blkext_tbl_size+2
954 CASE "DEFBLK_CON"
956 Blkcon_tbl_size=Blkcon_tbl_size+1
958 CASE "CONST"
960 Const_tbl_size=Const_tbl_size+1
962 CASE "DEF_END"
964 Def_loop_done=1
966 CASE "LBL_TBL_SIZE"
968 Enable_const=1
970 GOSUB Icode_get_arg
972 IF Missing_arg THEN
974 Error_string$="Missing LBL_TBL_SIZE parameter"
976 GOSUB Icode_err
978 ELSE
980 IF Arg>0 AND Arg<32767 THEN
982 Lbl_tbl_size=Arg
984 ELSE
986 Error_string$="Invalid LBL_TBL_SIZE specification - '"&VAL$(Arg)&"'"
988 GOSUB Icode_err
990 END IF
992 END IF
994 CASE "FORLBL_TBL_SIZE"
996 Enable_const=1
998 GOSUB Icode_get_arg
1000 IF Missing_arg THEN
1002 Error_string$="Missing FORLBL_TBL_SIZE parameter"
1004 GOSUB Icode_err
1006 ELSE
1008 IF Arg>0 AND Arg<32767 THEN
1010 Forlbl_tbl_size=Arg
1012 ELSE
1014 Error_string$="Invalid FORLBL_TBL_SIZE specification - '"&VAL$(Arg)&"'"
1016 GOSUB Icode_err
1018 END IF
1020 END IF
1022 CASE "ERR_ABRT_COUNT"
1024 Enable_const=1
1026 GOSUB Icode_get_arg
1028 IF Missing_arg THEN
1030 Error_string$="Missing ERR_ABRT_COUNT parameter"
1032 GOSUB Icode_err
1034 ELSE
1036 IF Arg>0 AND Arg<1000 THEN
1038 Err_abrt_count=Arg
1040 ELSE
1042 Error_string$="Invalid ERR_ABRT_COUNT specification - '"&VAL$(Arg)&"'"
1044 GOSUB Icode_err
1046 END IF
1048 END IF
1050 CASE "ERR_DISP_LINES"
1052 Enable_const=1
1054 GOSUB Icode_get_arg
1056 IF Missing_arg THEN
1058 Error_string$="Missing ERR_DISP_LINES parameter"
1060 GOSUB Icode_err
1062 ELSE
1064 IF Arg>=0 AND Arg<100 THEN
1066 Err_disp_lines=Arg
1068 ELSE
1070 Error_string$="Invalid ERR_DISP_LINES specification - '"&VAL$(Arg)&"'"
1072 GOSUB Icode_err
1074 END IF
1076 END IF
1078 CASE ELSE
1080 CALL Icode_inst_str(Opcode$,Inst_info$)
1082 IF Inst_info$<>"-1" OR Opcode$="EL_COMPLETO" THEN Def_loop_done=1
1084 END SELECT
1086 GOSUB Icode_next_inst
1088 UNTIL Def_loop_done
1090 !
1092 Enable_list=Enable_list_arg ! Enable listing of so desired
1094 !
1096 GOSUB Icode_alloc_tbl ! Allocate all internal tables
1098 !
1100 Source_last=-1 ! reset pointer into source array
1102 List_last=-1 ! and listing array
1104 !
1106 ! Allocate variable space. Variable space needs to be allocated
1108 ! for all VAR, DEFBLK_VAR, DEFBLK_SP, DEFBLK_MAIN, and DEFBLK_EXT
1110 ! pseudo-ops. Don't forget, variables start at 2.
1112 DISP Disp_line$;" Allocating variable space."
1114 Icode_alloc_var:!
1116 Vars_allocated=Var_tbl_size+Blkvar_tbl_size+Blkext_tbl_size+2
1118 IF Vars_allocated<>0 THEN ! allocate room in ICODE prog for vars
1120 Object(0)=49 ! insert c_goto around variable space
1122 Object(1)=0 ! programs can't be greater than 32K
1124 Real_temp=Vars_allocated*2
1126 IF Real_temp>=Object_size THEN
1128 Error_string$="Object code array too small for required variable space"
1130 GOSUB Icode_fatal_err
1132 END IF
1134 Object(2)=Real_temp
1136 FOR I=3 TO Real_temp-1 ! Set all vars to 0. Dont' really need
1138 Object(I)=0 ! to do this.
1140 NEXT I
1142 Object_last=Real_temp-1
1144 END IF
1146 !
1148 ! Insert listing header into List$(*)
1150 !
1152 IF Enable_list THEN
1154 List_last=List_last+1
1156 IF List_last<List_size THEN
1158 ON ERROR GOTO Icode_list_len
1160 List$(List_last)="ICODE Assembler version "&Version$&". Assembled "&DATE$(TIMEDATE)&" "&TIME$(TIMEDATE)
1162 OFF ERROR
1164 IF 0 THEN
1166 Icode_list_len:OFF ERROR
1168 Error_string$="Listing lines need to be longer"
1170 Enable_list=0
1172 GOSUB Icode_fatal_err
1174 END IF
1176 ELSE
1178 Error_string$="Listing table overflow"
1180 GOSUB Icode_fatal_err
1182 END IF
1184 END IF
1186 !
1188 IF Info_info=2 THEN
1190 !
1192 ! For each instruction, an entry is made into Info$(*). Each entry
1194 ! consists of the address of the opcode and the source$(*) line
1196 ! index. Only need for the debugger. i.e. Info_info=2
1198 !
1200 Info_inst_base=Info_hdr_size
1202 Inst_cnt=0
1204 END IF
1206 !
1208 IF Enable_list_arg THEN
1210 DISP Disp_line$;" Assembling. Listing Enabled"
1212 ELSE
1214 DISP Disp_line$;" Assembling."
1216 END IF
1218 !
1220 ! This loop assembles the pseudo-op section of the ICODE program.
1222 ! This loop is terminated when a non-pseudo-op instruction is
1224 ! found.
1226 !
1228 Icode_tbl_loop:!
1230 Tbl_loop_done=0
1232 REPEAT
1234 GOSUB Icode_next_line ! find next instruction
1236 GOSUB Icode_skip_lbl ! don't really want to look at labels
1238 GOSUB Icode_get_opcod ! get Opcode$
1240 GOSUB Icode_init_inst ! Init ptrs for listing and errs
1242 SELECT Opcode$
1244 Icode_var:!
1246 CASE "VAR"
1248 Enable_const=0 ! Variable name may not be a CONST
1250 GOSUB Icode_get_arg ! returns Arg$, Arg, and Missing_arg
1252 IF Missing_arg OR Arg$="" THEN
1254 Error_string$="Missing variable name"
1256 GOSUB Icode_err
1258 ELSE
1260 Variable$=Arg$
1262 Enable_const=1 ! Init value may be a CONST
1264 GOSUB Icode_get_arg
1266 IF Missing_arg THEN
1268 Error_string$="Missing or invalid variable init value"
1270 GOSUB Icode_err
1272 ELSE
1274 IF Arg>Max_32_int OR Arg<Min_32_int THEN
1276 Error_string$="Invalid variable init value - '"&VAL$(Arg)&"'"
1278 GOSUB Icode_err
1280 ELSE
1282 IF Arg$[1;1]="@" THEN ! Is init val another variables var number
1284 Var_pos=FNIcode_search(Var_name$(*),Var_last,Arg$[2])
1286 IF Var_pos=-1 THEN
1288 Error_string$="Undefined variable reference - '"&Arg$[2]&"'"
1290 GOSUB Icode_err
1292 ELSE
1294 Arg=Var_num(Var_pos)
1296 END IF
1298 ELSE
1300 IF Arg$<>"" THEN
1302 Error_string$="Invalid variable init value - '"&Arg$&"'"
1304 GOSUB Icode_err
1306 END IF
1308 END IF
1310 END IF
1312 END IF
1314 IF Error_string$="" THEN
1316 Var_last=Var_last+1
1318 Last_alloc_var=Last_alloc_var+1
1320 Var_name$(Var_last)=Variable$
1322 Var_num(Var_last)=Last_alloc_var
1324 Lib_32_to_16(Arg,Int_hi,Int_lo)
1326 Object(Last_alloc_var*2)=Int_hi
1328 Object(Last_alloc_var*2+1)=Int_lo
1330 IF Enable_list THEN
1332 List$(Old_list_last)[1;15]=IVAL$(Last_alloc_var*2,16)&" "&IVAL$(Int_hi,16)&","&IVAL$(Int_lo,16)
1334 END IF
1336 END IF
1338 END IF
1340 Defblk_var:!
1342 CASE "DEFBLK_VAR"
1344 Enable_const=0 ! Block name may not be a CONST
1346 GOSUB Icode_get_arg ! returns Arg$, Arg and Missing_arg
1348 IF Missing_arg OR LEN(Arg$)=0 THEN
1350 Error_string$="Missing DEFBLK_VAR block name"
1352 GOSUB Icode_err
1354 ELSE
1356 Block_name$=Arg$
1358 Enable_const=1 ! Init value may be a CONST
1360 GOSUB Icode_get_arg
1362 IF Missing_arg OR Arg$<>"" THEN
1364 Error_string$="Missing or invalid DEFBLK_VAR init value"
1366 GOSUB Icode_err
1368 ELSE
1370 IF Arg>Max_32_int OR Arg<Min_32_int THEN
1372 Error_string$="Invalid DEFBLK_VAR init value - '"&VAL$(Arg)&"'"
1374 GOSUB Icode_err
1376 ELSE
1378 Blkvar_last=Blkvar_last+1
1380 Last_alloc_var=Last_alloc_var+1
1382 Blkvar_name$(Blkvar_last)=Block_name$
1384 Blkvar_id(Blkvar_last)=Last_alloc_var
1386 CALL Lib_32_to_16(Arg,Int_hi,Int_lo)
1388 Object(Last_alloc_var*2)=Int_hi
1390 Object(Last_alloc_var*2+1)=Int_lo
1392 IF Enable_list THEN
1394 List$(List_last)[1;15]=IVAL$(Last_alloc_var*2,16)&" "&IVAL$(Int_hi,16)&","&IVAL$(Int_lo,16)
1396 END IF
1398 END IF
1400 END IF
1402 END IF
1404 !
1406 Defblk_con:!
1408 CASE "DEFBLK_CON"
1410 Enable_const=0 ! Block_name may not be a CONST
1412 GOSUB Icode_get_arg ! returns Token$ and Error_flag
1414 IF Missing_arg OR LEN(Arg$)=0 THEN
1416 Error_string$="Missing DEFBLK_CON block name"
1418 GOSUB Icode_err
1420 ELSE
1422 Block_name$=Arg$
1424 Enable_const=1 ! block_id may be a CONST
1426 GOSUB Icode_get_arg
1428 IF Missing_arg OR Arg$<>"" THEN
1430 Error_string$="Missing or invalid DEFBLK_CON constant value"
1432 GOSUB Icode_err
1434 ELSE
1436 IF (Arg<=0 OR Arg>=32768) THEN
1438 Error_string$="Illegal DEFBLK_CON init value"
1440 GOSUB Icode_err
1442 ELSE
1444 IF Error_string$="" THEN
1446 Blkcon_last=Blkcon_last+1
1448 Blkcon_name$(Blkcon_last)=Block_name$
1450 Blkcon_id(Blkcon_last)=Arg
1452 IF Enable_list THEN List$(Old_list_last)[6;4]=IVAL$((Arg),16)
1454 END IF
1456 END IF
1458 END IF
1460 END IF
1462 !
1464 Defblk_main:!
1466 Defblk_sp:!
1468 CASE "DEFBLK_SP","DEFBLK_MAIN"
1470 IF Info_info=0 THEN
1472 Error_string$="Can't use "&Opcode$&" without Info$ array"
1474 GOSUB Icode_err
1476 ELSE
1478 Block_type=1
1480 IF Opcode$[8]="SP" THEN Block_type=2
1482 Enable_const=0 ! Block_name may not be a CONST
1484 GOSUB Icode_get_arg ! returns Arg$, Arg, and Missing_arg
1486 IF Missing_arg OR LEN(Arg$)=0 THEN
1488 Error_string$="Missing "&Opcode$&" block name"
1490 GOSUB Icode_err
1492 ELSE
1494 Block_name$=Arg$
1496 Enable_const=1 ! block_size may be a CONST
1498 GOSUB Icode_get_arg
1500 IF Missing_arg OR Arg$<>"" OR Arg<=0 OR Arg>Max_32_int THEN
1502 Error_string$="Missing or invalid "&Opcode$&" block size"
1504 GOSUB Icode_err
1506 ELSE
1508 Block_size=Arg
1510 Blkext_last=Blkext_last+1
1512 Last_alloc_var=Last_alloc_var+2
1514 Enable_const=1 ! header_block_size may be a CONST
1516 GOSUB Icode_get_arg
1518 IF Missing_arg OR Arg$<>"" OR Arg<0 THEN
1520 Error_string$="Missing or invalid "&Opcode$&" header size"
1522 GOSUB Icode_err
1524 ELSE
1526 Header_size=Arg
1528 END IF
1530 Blkext_name$(Blkext_last)=Block_name$
1532 Blkext_id(Blkext_last)=(Last_alloc_var-1)
1534 Blkext_type(Blkext_last)=Block_type
1536 Blkext_size(Blkext_last)=Block_size
1538 Blkext_hsize(Blkext_last)=Header_size
1540 IF Enable_list THEN
1542 List$(Old_list_last)[1;14]=IVAL$((Last_alloc_var-1)*2,16)&" ****,****"
1544 END IF
1546 END IF
1548 END IF
1550 END IF
1552 !
1554 Defblk_ext:!
1556 CASE "DEFBLK_EXT"
1558 Enable_const=0 ! block_name may not be a CONST
1560 GOSUB Icode_get_arg ! returns Arg$, Arg, and Missing_arg
1562 IF Missing_arg OR LEN(Arg$)=0 THEN
1564 Error_string$="Missing DEFBLK_EXT block name"
1566 GOSUB Icode_err
1568 ELSE
1570 Blkext_last=Blkext_last+1
1572 Last_alloc_var=Last_alloc_var+2
1574 Blkext_name$(Blkext_last)=Arg$
1576 Blkext_id(Blkext_last)=(Last_alloc_var-1)
1578 Blkext_type(Blkext_last)=0
1580 Blkext_size(Blkext_last)=-1
1582 Blkext_hsize(Blkext_last)=-1
1584 IF Enable_list THEN
1586 List$(Old_list_last)[1;14]=IVAL$((Last_alloc_var-1)*2,16)&" ****,****"
1588 END IF
1590 END IF
1592 !
1594 Const:!
1596 CASE "CONST"
1598 DIM Constant_name$[16]
1600 Enable_const=0 ! New CONST_name may not be a CONST
1602 GOSUB Icode_get_arg ! returns Arg$, Arg, and Missing_arg
1604 IF Missing_arg OR LEN(Arg$)=0 THEN
1606 Error_string$="Missing CONST constant name"
1608 GOSUB Icode_err
1610 ELSE
1612 Constant_name$=Arg$
1614 Enable_const=1 ! CONST value may be a CONST
1616 GOSUB Icode_get_arg
1618 IF Missing_arg OR LEN(Arg$)<>0 OR Arg<Min_32_int OR Arg>Max_32_int THEN
1620 Error_string$="Missing or invalid CONST constant value"
1622 GOSUB Icode_err
1624 ELSE
1626 Const_last=Const_last+1
1628 Const_name$(Const_last)=Constant_name$
1630 Const_val(Const_last)=Arg
1632 IF Enable_list THEN
1633 Lib_32_to_16(Arg,Int_hi,Int_lo)
1634 List$(Old_list_last)[6;9]=IVAL$(Int_hi,16)&","&IVAL$(Int_lo,16)
1635 END IF
1637 END IF
1638 END IF
1639 CASE "ERR_ABRT_COUNT","ERR_DISP_LINES","LBL_TBL_SIZE","FORLBL_TBL_SIZE"
1640 GOSUB Icode_get_arg ! This is a dummy get arg
1642 CASE "DEF_END"
1644 Tbl_loop_done=1
1646 CASE ELSE
1648 CALL Icode_inst_str(Opcode$,Inst_info$)
1650 IF Inst_info$<>"-1" OR Opcode$="EL_COMPLETO" OR Opcode$="ASM_OFF" THEN
1652 Tbl_loop_done=1
1654 GOSUB Icode_back_line
1656 ELSE
1658 IF POS(Opcode$,",")<>0 THEN
1660 Error_string$="Unexpected comma - '"&Opcode$[1,MIN(20,LEN(Opcode$))]&"'"
1662 ELSE
1664 Error_string$="Undefined pseudo-op - '"&Opcode$[1,MIN(20,LEN(Opcode$))]&"'"
1666 END IF
1668 Enable_list=0
1670 GOSUB Icode_fatal_err
1672 END IF
1674 END SELECT
1676 IF Error_string$="" AND Line$<>"" AND NOT Tbl_loop_done THEN
1678 Error_string$="Extraneous argument - '"&Line$[1,MIN(20,LEN(Line$))]&"'"
1680 GOSUB Icode_err
1682 END IF
1684 Here:!
1686 Error_string$=""
1688 UNTIL Tbl_loop_done
1690 !
1692 ! This is the main assembly loop
1694 !
1696 Icode_asm_loop:!
1698 Asm_loop_done=0
1700 REPEAT
1702 Error_string$=""
1704 !
1706 GOSUB Icode_next_line
1708 !
1710 IF Line$="EL_COMPLETO" THEN
1712 Asm_loop_done=1
1714 ELSE
1716 !
1718 IF Info_info=2 THEN GOSUB Icode_insrt_nop
1720 !
1722 IF Line$[1;1]="." THEN
1724 Error_string$="Not expecting continuation line"
1726 GOSUB Icode_err
1728 ELSE
1730 GOSUB Icode_check_lbl ! check for line label
1732 GOSUB Icode_get_opcod ! returns Opcode$
1734 GOSUB Icode_init_inst ! init ptrs for listing and errs
1736 !
1738 ! Get information about instruction. Opcode and parameters.
1740 !
1742 CALL Icode_inst_str(Opcode$,Inst_info$)
1744 Opcode_num=VAL(Inst_info$)
1746 !
1748 IF Opcode_num=-1 THEN
1750 IF Opcode$="ASM_OFF" THEN
1752 IF Info_info=2 THEN GOSUB Icode_info_isrt
1754 GOSUB Icode_asm_off
1756 GOSUB Icode_end_inst
1758 IF Error_string$="" AND Line$<>"" THEN
1760 Error_string$="Extraneous argument - '"&Line$[1,MIN(20,LEN(Line$))]&"'"
1762 GOSUB Icode_err
1764 END IF
1766 ELSE
1768 Error_string$="Undefined Opcode - '"&Opcode$[1,MIN(20,LEN(Opcode$))]&"'"
1770 GOSUB Icode_err
1772 END IF
1774 END IF
1776 !
1778 IF Opcode_num<>-1 THEN
1780 Add_object=Opcode_num ! add opcode to object array
1782 GOSUB Icode_add_obj
1784 !
1786 ! Put address of opcode and source line # into Info$(*).
1788 !
1790 IF Info_info=2 THEN GOSUB Icode_info_isrt
1792 !
1794 IF Error_string$="" THEN
1796 Inst_info_ptr=POS(Inst_info$," ") ! skip opcode field
1798 IF Inst_info_ptr<>0 THEN
1800 REPEAT
1802 Inst_info_ptr=Inst_info_ptr+1 ! look at next parm char
1804 SELECT Inst_info$[Inst_info_ptr;1]
1806 CASE "L" ! Label
1808 GOSUB Icode_get_label
1810 CASE "P"
1812 GOSUB Icode_get_param ! 16 bit immediate integer
1814 CASE "B" ! CONST or VAR
1816 GOSUB Icode_get_block ! DEFBLK_xxxx
1818 CASE "V"
1820 GOSUB Icode_get_var
1822 CASE "I" ! 32 bit immediate integer
1824 GOSUB Icode_get_int ! or CONST
1826 CASE "S" ! 'String'
1828 GOSUB Icode_get_str
1830 CASE "F" ! Floating point
1832 GOSUB Icode_get_float
1834 CASE "M" ! 16 bit immediate integer
1836 GOSUB Icode_get_immed
1838 CASE "R" ! Instruction has a repeating
1840 GOSUB Icode_rpt_str ! field.
1842 CASE "@" ! Instruction has more than one
1844 GOSUB Icode_mlty_inst ! form depending on last field.
1846 END SELECT
1848 UNTIL Inst_info_ptr=LEN(Inst_info$)
1850 !
1852 IF Error_string$="" AND Line$<>"" THEN
1854 Error_string$="Extraneous argument - '"&Line$[1,MIN(20,LEN(Line$))]&"'"
1856 GOSUB Icode_err
1858 END IF
1860 END IF
1862 END IF
1864 GOSUB Icode_end_inst
1866 END IF ! If Opcode_num<>-1
1868 END IF
1870 END IF
1872 UNTIL Asm_loop_done
1874 !
1876 ! See if there are any unresolved forward references.
1878 !
1880 GOSUB Icode_forlbl_ck
1882 !
1884 Object_last=Object_last+1 ! HP-IB module needs extra word in prog block
1886 !
1888 GOSUB Icode_fill_info ! Fill Info$(*) with tons of stuff
1890 GOSUB Icode_asm_exit ! Final clean up and exit
1892 !
1894 ! ************ Assembler GOSUB Subroutines ***********************
1896 !
1898 Icode_subs:!
1900 IF 0 THEN
1902 !
1904 ! This subroutine is used to repeat a section of the instruction info
1906 ! string. The substring between the parameter code 'R' and the next
1908 ! '!' is repeated <count> times. <count> is specified by the last
1910 ! 16 bit value places in the object array.
1912 !
1914 Icode_rpt_str:!
1916 Repeat_count=Object(Object_last)
1918 IF Repeat_count<0 THEN
1920 Error_string$="Variable reference in immediate parameter field"
1922 GOSUB Icode_err
1924 ELSE
1926 Num_parms=POS(Inst_info$[Inst_info_ptr+1],"!")-1
1928 Repeat_str$=Inst_info$[Inst_info_ptr+1;Num_parms]
1930 Inst_info$=Inst_info$[1,Inst_info_ptr]&RPT$(Repeat_str$,Repeat_count)&Inst_info$[Inst_info_ptr+Num_parms+2]
1932 END IF
1934 RETURN
1936 !
1938 ! This subroutine is used to select a section of the instruction
1940 ! parameter string. When the first '@' is found, the last value
1942 ! added to Object(*) is used as a select value. The select value
1944 ! is used to select a section of the instruction parameter string.
1946 ! The section to be used is delimited by '@<select_value>' and
1948 ! the next '@' or end of string.
1950 !
1952 Icode_mlty_inst:!
1954 Rel_ptr=POS(Inst_info$[Inst_info_ptr],VAL$(Object(Object_last)))
1956 IF Rel_ptr=0 THEN
1958 Error_string$="Invalid f_ready_ram <monitor> field"
1960 GOSUB Icode_err
1962 ELSE
1964 Inst_info$=Inst_info$[Inst_info_ptr+Rel_ptr-1]
1966 Inst_info_ptr=1
1968 Rel_ptr=POS(Inst_info$,"@")
1970 IF Rel_ptr<>0 THEN Inst_info$=Inst_info$[1,Rel_ptr-1]
1972 END IF
1974 RETURN
1976 !
1978 ! This subroutine is used to insert information about the current
1980 ! instruction into Info$(*). The current opcode number and
1982 ! opcode Source(*) address are inserted into Info$(*). This is
1984 ! used by the debugger. This subroutine is only called if
1986 ! Info_info=2
1988 !
1990 Icode_info_isrt:!
1992 ON ERROR GOTO Icode_isrt_err
1994 OUTPUT Temp$ USING "#,W,W";Old_object_last+1,Old_source_last
1996 Info$(Info_inst_base+Inst_cnt DIV 10)[((Inst_cnt MOD 10)*4)+1;4]=Temp$
1998 Inst_cnt=Inst_cnt+1
2000 !
2002 IF 0 THEN
2004 Icode_isrt_err:!
2006 Error_string$="Info$ array not large enough"
2008 GOSUB Icode_fatal_err
2010 END IF
2012 !
2014 OFF ERROR
2016 RETURN
2018 !
2020 ! This subroutine is used to insert a c_nop before each user
2022 ! instruction. The debugger needs this. This subroutine should
2024 ! only be called if Info_info=2.
2026 !
2028 Icode_insrt_nop:!
2030 IF Enable_list THEN
2032 List_last=List_last+1
2034 IF List_last>=List_size THEN
2036 Error_string$="Listing table overflow"
2038 GOSUB Icode_fatal_err
2040 ELSE
2042 List$(List_last)=RPT$(" ",15)&RPT$(" ",15)&"<c_nop>"
2044 END IF
2046 END IF
2048 GOSUB Icode_init_inst
2050 Add_object=61 ! insert c_nop
2052 GOSUB Icode_add_obj
2054 RETURN
2056 !
2058 ! This instruction is used to init listing and error pointers
2060 ! to a new instruction state.
2062 !
2064 Icode_init_inst:!
2066 INTEGER Use_left_field,Add_stars
2068 Use_left_field=1
2070 Add_stars=0
2072 List_ptr=List_last
2074 Old_object_last=Object_last
2076 Old_source_last=Source_last
2078 Old_list_last=List_last
2080 Old_forlbl_last=Forlbl_last
2082 Error_string$=""
2084 RETURN
2086 !
2088 ! This subroutine is used to clean up the List_last pointer after
2090 ! an instruction has been assembled. List_ptr is used by the
2092 ! Icode_add_obj subroutine to insert parameter values into the
2094 ! listing. The Icode_next_line subroutine uses List_last.
2096 !
2098 Icode_end_inst:!
2100 IF Enable_list THEN
2102 IF Use_left_field THEN
2104 IF List_ptr-1>List_last THEN List_last=List_ptr-1
2106 ELSE
2108 IF List_ptr>List_last THEN List_last=List_ptr
2110 END IF
2112 END IF
2114 RETURN
2116 !
2118 ! Input parameter: INTEGER Add_object, INTEGER Add_stars
2120 !
2122 ! This subroutine is used to add a opcode or parameter value to
2124 ! the object array. This routine also puts this value into the
2126 ! listing. If Add_stars is set, then '****' is put into the listing
2128 ! instead of the Add_object value.
2130 !
2132 Icode_add_obj:!
2134 Object_last=Object_last+1
2136 IF Object_last>=Object_size THEN
2138 Error_string$="Object(*) array overflow"
2140 GOSUB Icode_fatal_err
2142 END IF
2144 Object(Object_last)=Add_object
2146 IF Enable_list THEN
2148 IF List_ptr>=List_size THEN
2150 Error_string$="Listing table overflow"
2152 GOSUB Icode_fatal_err
2154 List_last=List_size-2
2156 ELSE
2158 IF Use_left_field THEN
2160 List$(List_ptr)[1;4]=IVAL$(Object_last,16)
2162 IF Add_stars THEN
2164 List$(List_ptr)[5;5]=" ****"
2166 ELSE
2168 List$(List_ptr)[5;5]=" "&IVAL$(Add_object,16)
2170 END IF
2172 Use_left_field=0
2174 ELSE
2176 IF Add_stars THEN
2178 List$(List_ptr)[10;5]=",****"
2180 ELSE
2182 List$(List_ptr)[10;5]=","&IVAL$(Add_object,16)
2184 END IF
2186 List_ptr=List_ptr+1
2188 Use_left_field=1
2190 END IF
2192 END IF
2194 END IF
2196 RETURN
2198 !
2200 ! This subroutine is called when an error occurs initialization.
2202 !
2204 Icode_init_err:!
2206 OUTPUT CRT
2208 FOR I=MAX(0,Source_last-Err_disp_lines) TO MIN(Source_last,Source_size-1)
2210 OUTPUT CRT;Source$(I)
2212 NEXT I
2214 GOSUB Icode_fatal_err
2216 RETURN
2218 !
2220 ! This subroutine is called when an error causes the assembler
2222 ! to quit assembling.
2224 !
2226 Icode_fatal_err:!
2228 Error_count=Error_count+1
2230 Enable_list=Enable_list_arg
2232 IF Enable_list THEN
2234 ON ERROR GOTO Icode_err_skip
2236 List_last=List_last+1
2238 IF List_last<List_size-1 THEN
2240 List$(List_last)="***** FATAL ERROR: "&Error_string$&" *****"
2242 ELSE
2244 List_last=List_size-2
2246 List$(MAX(0,List_last))="***** FATAL ERROR: "&Error_string$&" *****"
2248 END IF
2250 OFF ERROR
2252 END IF
2254 Icode_err_skip:Enable_list=0
2256 OFF ERROR
2258 OUTPUT CRT;"***** FATAL ERROR: "&Error_string$;" *****"
2260 GOTO Icode_asm_exit
2262 RETURN
2264 !
2266 ! This routine is called when routine error occurs.
2268 !
2270 Icode_err:!
2272 Error_count=Error_count+1
2274 !
2276 Object_last=Old_object_last ! reset Object(*) ptr
2278 Forlbl_last=Old_forlbl_last ! reset forward reference ptr
2280 !
2282 Use_left_field=1
2284 Add_object=-1 ! overwrite opcode with -1
2286 GOSUB Icode_add_obj
2288 !
2290 Inst_info_ptr=LEN(Inst_info$) ! don't get any more parms
2292 !
2294 IF Enable_list THEN ! clean up listing
2296 List$(Old_list_last)[6,15]="FFFF "
2298 FOR I=Old_list_last+1 TO List_last
2300 List$(I)[1;15]=RPT$(" ",15)
2302 NEXT I
2304 List_last=List_last+1
2306 List$(List_last)=RPT$(" ",15)&"***** ERROR: "&Error_string$&" *****"
2308 END IF
2310 !
2312 ! Print out section of source code on CRT
2314 !
2316 OUTPUT CRT
2318 FOR I=MAX(Old_source_last-Err_disp_lines,0) TO MIN(Source_last,Source_size-1)
2320 OUTPUT CRT;Source$(I)
2322 NEXT I
2324 OUTPUT CRT;"***** ERROR: ";Error_string$;" *****"
2326 !
2328 IF Error_count>Err_abrt_count THEN ! See if there are too many errors
2330 Error_string$="ICODE program has many problems"
2332 GOSUB Icode_fatal_err
2334 ELSE
2336 GOSUB Icode_next_inst
2338 END IF
2340 RETURN
2342 !
2344 ! This subroutine is used to find the next line with a new
2346 ! instruction on it.
2348 !
2350 Icode_next_inst:!
2352 REPEAT
2354 GOSUB Icode_next_line
2356 UNTIL Line$[1,1]<>"."
2358 GOSUB Icode_back_line
2360 RETURN
2362 !
2364 ! This subroutine is used by the pre-pass to skip labels.
2366 ! Labels are looked at in the main assembly loop.
2368 !
2370 Icode_skip_lbl:!
2372 Line_ptr=POS(Line$[1,17],":")
2374 IF Line_ptr<>0 THEN Line$=TRIM$(Line$[Line_ptr+1])
2376 RETURN
2378 !
2380 ! This subroutine is used to see if the current line has a label
2382 ! on it. If it does, then it is added to the label table. Then
2384 ! the forward reference table is searched. Each instance of a
2386 ! forward reference to the newly found label is then resolved.
2388 !
2390 Icode_check_lbl:! check for label in line$
2392 REPEAT
2394 Line_ptr=POS(Line$[1,17],":")
2396 IF Line_ptr<>0 THEN ! looks like we have a label
2398 !
2400 Label$=Line$[1,Line_ptr-1]
2402 Line$=TRIM$(Line$[Line_ptr+1])
2404 !
2406 Lbl_last=Lbl_last+1
2408 IF Lbl_last<Lbl_tbl_size THEN
2410 Lbl_name$(Lbl_last)=Label$
2412 !
2414 ! If Info_info=2 then the label must point to the c_nop
2416 ! that was inserted before this instruction.
2418 !
2420 IF Info_info=2 THEN
2422 Lbl_loc(Lbl_last)=Object_last
2424 Lbl_src_loc(Lbl_last)=Source_last
2426 ELSE
2428 Lbl_loc(Lbl_last)=Object_last+1
2430 END IF
2432 ELSE
2434 Error_string$="Label table overflow"
2436 GOSUB Icode_fatal_err
2438 RETURN
2440 END IF
2442 !
2444 ! Now, resolve all unresolved references to this label
2446 !
2448 REPEAT
2450 Forlbl_pos=FNIcode_search(Forlbl_name$(*),Forlbl_last,Label$)
2452 IF Forlbl_pos<>-1 THEN
2454 !
2456 ! Found forward reference to this label. Resolve it.
2458 !
2460 Int_hi=0 ! hi word must be zero
2462 Int_lo=Lbl_loc(Lbl_last) ! use same addr as put in lbl table
2464 Object(Forlbl_loc(Forlbl_pos))=Int_hi ! Addr hi
2466 Object(Forlbl_loc(Forlbl_pos)+1)=Int_lo ! Addr lo
2468 !
2470 ! Move last element in forward reference list into this pos
2472 !
2474 Forlbl_name$(Forlbl_pos)=Forlbl_name$(Forlbl_last)
2476 Forlbl_loc(Forlbl_pos)=Forlbl_loc(Forlbl_last)
2478 !
2480 IF Enable_list THEN ! Must also fill in listing.
2482 IF Forlbl_list_lft(Forlbl_pos) THEN
2484 List$(Forlbl_list_pos(Forlbl_pos))[6;9]=IVAL$(Int_hi,16)&","&IVAL$(Int_lo,16)
2486 ELSE
2488 List$(Forlbl_list_pos(Forlbl_pos))[10;5]=","&IVAL$(Int_hi,16)
2490 List$(Forlbl_list_pos(Forlbl_pos)+1)[6;4]=IVAL$(Int_lo,16)
2492 END IF
2494 Forlbl_list_lft(Forlbl_pos)=Forlbl_list_lft(Forlbl_last)
2496 Forlbl_list_pos(Forlbl_pos)=Forlbl_list_pos(Forlbl_last)
2498 END IF
2500 Forlbl_last=Forlbl_last-1 ! One less forward reference now
2502 END IF
2504 UNTIL Forlbl_pos=-1
2506 END IF
2508 !
2510 ! If label was only thing on line, then we still need to check for
2512 ! a label on the next line.
2514 IF Line$="" THEN
2516 IF Enable_list THEN List$(List_last)[1;4]=IVAL$(Object_last+1,16)
2518 GOSUB Icode_next_line
2520 Line_ptr=POS(Line$[1,17],":")
2522 END IF
2524 UNTIL Line$<>"" AND Line$<>"EL_COMPLETO" AND Line_ptr=0
2526 RETURN
2528 !
2530 ! This subroutine is used to get Opcode$ out of the current input
2532 ! line.
2534 !
2536 Icode_get_opcod:!
2538 Line_ptr=POS(Line$," ")
2540 IF Line_ptr=0 THEN
2542 Opcode$=Line$[1,MIN(20,LEN(Line$))]
2544 Line$=""
2546 ELSE
2548 Opcode$=Line$[1,MIN(Line_ptr-1,20)]
2550 Line$=TRIM$(Line$[Line_ptr+1])
2552 END IF
2554 RETURN
2556 !
2558 ! This subroutine is used when the next parameter in the current
2560 ! instruction is an ICODE address (c_goto label_name). Note that
2562 ! must be a string. i.e. not absolute jumps.
2564 !
2566 Icode_get_label:!
2568 Enable_const=0 ! Label field may not be a CONST
2570 GOSUB Icode_get_arg
2572 IF Arg$="" THEN
2574 Error_string$="Missing label specification"
2576 GOSUB Icode_err
2578 ELSE
2580 !
2582 ! Search label table
2584 !
2586 Lbl_pos=FNIcode_search(Lbl_name$(*),Lbl_last,Arg$)
2588 IF Lbl_pos<>-1 THEN ! found it
2590 Add_object=0
2592 GOSUB Icode_add_obj
2594 Add_object=Lbl_loc(Lbl_pos)
2596 GOSUB Icode_add_obj
2598 ELSE
2600 Forlbl_last=Forlbl_last+1 ! insert in forward reference table
2602 Forlbl_name$(Forlbl_last)=Arg$
2604 Forlbl_loc(Forlbl_last)=Object_last+1
2606 IF Enable_list THEN
2608 Forlbl_list_pos(Forlbl_last)=List_ptr
2610 Forlbl_list_lft(Forlbl_last)=Use_left_field
2612 END IF
2614 Add_stars=1 ! put stars in listing until this
2616 Add_object=0 ! reference is resolved.
2618 GOSUB Icode_add_obj
2620 Add_object=0
2622 GOSUB Icode_add_obj
2624 Add_stars=0
2626 END IF
2628 END IF
2630 RETURN
2632 !
2634 ! Input: Enable_const
2636 ! Output: Arg$, REAL Arg, INTEGER Missing_arg
2638 !
2640 ! This routine is used to get the next parameter from the Source$(*)
2642 ! array. The next parameter may be on the current line or on a
2644 ! continuation line. The next parameter may be terminated by a
2646 ! space, comma or an end-of-line. If the parameter is itself a
2648 ! numerical value, either decimal or hex ($<hex_num>), then Arg is
2650 ! set to the value and Arg$="". If the parameter isn't a numerical
2652 ! value then Arg is undefined and Arg$ is set the the parameter
2654 ! string. If Enable_const is active, then the CONST table is searched
2656 ! to see if Arg$ is defined.
2658 !
2660 Icode_get_arg: ! returns Arg$, Arg and Missing_arg
2662 Missing_arg=0
2664 WHILE Line$=""
2666 GOSUB Get_cont_line ! returns Line$ and Missing_arg
2668 END WHILE
2670 IF Missing_arg THEN
2672 Arg$=""
2674 Arg=-1
2676 ELSE
2678 Line_ptr=POS(Line$,",") ! Is there a comma delimiter
2680 IF Line_ptr=0 THEN ! Nope
2682 Line_ptr=POS(Line$," ")
2684 IF Line_ptr=0 THEN
2686 Arg$=Line$
2688 Line$=""
2690 ELSE
2692 Arg$=Line$[1,MIN(16,Line_ptr-1)]
2694 Line$=TRIM$(Line$[Line_ptr+1])
2696 END IF
2698 ELSE ! Yup
2700 Int_temp=POS(Line$," ") ! Now see if there is a space between
2702 ! the end of the param and the comma.
2704 IF Int_temp<>0 THEN Line_ptr=MIN(Int_temp,Line_ptr) ! Yes
2706 Arg$=TRIM$(Line$[1,MIN(16,Line_ptr-1)])
2708 IF Arg$="" THEN
2710 Missing_arg=1
2712 ELSE
2714 IF Line$[Line_ptr;1]="," THEN ! Remove Arg$ from Line$
2716 Line$=TRIM$(Line$[Line_ptr+1])
2718 ELSE
2720 Line$=TRIM$(Line$[Line_ptr+1])
2722 IF Line$[1,1]="," THEN Line$=TRIM$(Line$[2])
2724 END IF
2726 END IF
2728 END IF
2730 ! See if Arg$ has a
2732 CALL Icode_eval_str(Arg$,Arg,Missing_arg) ! numerical value.
2734 IF Arg$<>"" AND Enable_const THEN
2736 Const_pos=FNIcode_search(Const_name$(*),Const_last,Arg$)
2738 IF Const_pos<>-1 THEN
2740 Arg=Const_val(Const_pos)
2742 Arg$=""
2744 END IF
2746 END IF
2748 END IF
2750 RETURN
2752 !
2754 ! Output: Line$, Missing_arg
2756 !
2758 ! This subroutine is used to get a continuation line from the Source$(*)
2760 ! array. If the next line isn't a continuation line (first non space
2762 ! char on line must be '.'), then Missing_arg is set true.
2764 !
2766 Get_cont_line:!
2768 INTEGER Done_cont_line
2770 Done_cont_line=0
2772 REPEAT
2774 GOSUB Icode_next_line ! returns Line$ and Skipped_lines
2776 IF Line$[1,1]<>"." OR Skipped_lines>0 THEN
2778 Missing_arg=1
2780 GOSUB Icode_back_line
2782 Done_cont_line=1
2784 ELSE
2786 Line$=TRIM$(Line$[2])
2788 IF LEN(Line$)>=1 THEN Done_cont_line=1
2790 END IF
2792 UNTIL Done_cont_line
2794 RETURN
2796 !
2798 ! This subroutine is used to move back one line in the Source$(*)
2800 ! array and the List$(*) array.
2802 !
2804 Icode_back_line:!
2806 Source_last=Source_last-1
2808 IF Enable_list THEN
2810 List$(List_last)=""
2812 List_last=List_last-1
2814 END IF
2816 RETURN
2818 !
2820 ! Output: Line$ and Skipped_lines
2822 !
2824 ! This subroutine is used to get the next source line. It check
2826 ! to see when the end of the Source$(*) array has been found. If
2828 ! so, then Line$="EL_COMPLETO".
2830 !
2832 Icode_next_line:!
2834 INTEGER Skipped_lines
2836 Skipped_lines=-1
2838 REPEAT
2840 Skipped_lines=Skipped_lines+1
2842 Source_last=Source_last+1
2844 IF Source_last>=Source_size THEN
2846 Line$="EL_COMPLETO"
2848 ELSE
2850 Line$=Source$(Source_last)
2852 END IF
2854 ! Insert line into List$(*)
2856 IF Enable_list THEN
2858 List_last=List_last+1
2860 IF List_last>=List_size THEN
2862 List_last=List_size-2
2864 Error_string$="Listing table overflow"
2866 GOSUB Icode_fatal_err
2868 END IF
2870 List_line_len=LEN(List$(List_last))
2872 ON ERROR GOTO Icode_lstr_smal ! List$ elements may be too small
2874 IF List_line_len=0 THEN
2876 List$(List_last)=RPT$(" ",15)&Line$
2878 ELSE
2880 IF List_line_len<=15 THEN List$(List_last)=List$(List_last)&RPT$(" ",15-List_line_len)&Line$
2882 END IF
2884 OFF ERROR
2886 END IF
2888 !
2890 ! Strip off comments. This assumes no '!' inside string parameter.
2892 ! Also, convert everything to upper case.
2894 !
2896 Line_ptr=POS(Line$,"!")
2898 IF Line_ptr<>0 THEN
2900 Line$=UPC$(TRIM$(Line$[1,Line_ptr-1]))
2902 ELSE
2904 Line$=UPC$(TRIM$(Line$))
2906 END IF
2908 UNTIL LEN(Line$)<>0
2910 ! If an error occurs during the assignment of
2912 IF 0 THEN ! Line$ to List$( ), then a jump is made to
2914 Icode_lstr_smal:OFF ERROR ! this section of code.
2916 Error_string$="List$(*) lines need to be longer"
2918 GOSUB Icode_fatal_err
2920 END IF
2922 RETURN
2924 !
2926 Icode_asm_off: ! This routine is used to put semi-unassembled
2928 INTEGER Arg_count ! data into the program. The first field after
2930 INTEGER Current_arg ! ASM_OFF is the count and must be immediate,
2932 Enable_const=1 ! or CONST The next <count> fields must be
2934 GOSUB Icode_get_arg ! immediate, CONST, VAR.
2936 IF Missing_arg THEN
2938 Error_string$="Expecting ASM_OFF parameter count"
2940 GOSUB Icode_err
2942 RETURN
2944 END IF
2946 IF Arg$<>"" THEN
2948 Error_string$="ASM_OFF parameter count must be immediate"
2950 GOSUB Icode_err
2952 RETURN
2954 END IF
2956 IF Arg<1 OR Arg>100 THEN
2958 Error_string$="Invalid ASM_OFF parameter count field"
2960 GOSUB Icode_err
2962 RETURN
2964 END IF
2966 Arg_count=Arg
2968 FOR Current_arg=1 TO Arg_count
2970 Enable_const=1
2972 GOSUB Icode_get_arg
2974 IF Missing_arg THEN
2976 Error_string$="Expecting ASM_OFF parameter"
2978 GOSUB Icode_err
2980 RETURN
2982 END IF
2984 IF Arg$<>"" THEN ! and VARs may also be in the data stream.
2986 IF Arg$[1;1]="@" THEN
2988 Var_pos=FNIcode_search(Var_name$(*),Var_last,Arg$[2])
2990 IF Var_pos<>-1 THEN
2992 Arg=-(Var_num(Var_pos)+16384)
2994 ELSE
2996 Error_string$="Indirect variable undefined - '"&Arg$[2]&"'"
2998 GOSUB Icode_err
3000 RETURN
3002 END IF
3004 ELSE
3006 Var_pos=FNIcode_search(Var_name$(*),Var_last,Arg$)
3008 IF Var_pos<>-1 THEN
3010 Arg=-Var_num(Var_pos)
3012 ELSE
3014 Error_string$="Undefined symbol - '"&Arg$&"'"
3016 GOSUB Icode_err
3018 RETURN
3020 END IF
3022 END IF
3024 END IF
3026 IF Arg>Max_16_int OR Arg<Min_16_int THEN
3028 Error_string$="Invalid ASM_OFF parameter value - '"&VAL$(Arg)&"'"
3030 GOSUB Icode_err
3032 RETURN
3034 END IF
3036 Add_object=Arg
3038 GOSUB Icode_add_obj
3040 NEXT Current_arg
3042 RETURN
3044 !
3046 ! This subroutine is used to assemble a 32 bit integer parameter from
3048 ! from the source code. The parameter must be a CONST reference or
3050 ! an immediate in line value.
3052 !
3054 Icode_get_int:!
3056 Enable_const=1
3058 GOSUB Icode_get_arg
3060 IF Missing_arg THEN
3062 Error_string$="Missing 32 bit integer parameter"
3064 GOSUB Icode_err
3066 RETURN
3068 END IF
3070 IF Arg$<>"" THEN
3072 Error_string$="Undefined CONST - '"&Arg$&"'"
3074 GOSUB Icode_err
3076 RETURN
3078 END IF
3080 IF Arg>Max_32_int OR Arg<Min_32_int THEN
3082 Error_string$="Invaid integer parameter - '"&VAL$(Arg)&"'"
3084 GOSUB Icode_err
3086 RETURN
3088 END IF
3090 CALL Lib_32_to_16(Arg,Int_hi,Int_lo)
3092 Add_object=Int_hi
3094 GOSUB Icode_add_obj
3096 Add_object=Int_lo
3098 GOSUB Icode_add_obj
3100 RETURN
3102 !
3104 ! This subroutine is used to assemble a 16 bit integer parameter from
3106 ! from the source code. The parameter must be a CONST reference or
3108 ! an immediate in line value.
3110 !
3112 Icode_get_immed:!
3114 Enable_const=1
3116 GOSUB Icode_get_arg
3118 IF Missing_arg THEN
3120 Error_string$="Missing immediate data parameter"
3122 GOSUB Icode_err
3124 RETURN
3126 END IF
3128 IF Arg$<>"" OR Arg>Max_16_int OR Arg<Min_16_int THEN
3130 IF Arg$<>"" THEN
3132 Error_string$="Invalid immediate parameter - '"&Arg$[1,MIN(20,LEN(Arg$))]&"'"
3134 ELSE
3136 Error_string$="Invalid immediate parameter - '"&VAL$(Arg)&"'"
3138 END IF
3140 GOSUB Icode_err
3142 RETURN
3144 END IF
3146 Add_object=Arg
3148 GOSUB Icode_add_obj
3150 RETURN
3152 !
3154 ! This subroutine is used to assemble an immediate floating point
3156 ! number from the source code. Number may also be a CONST
3158 !
3160 Icode_get_float:!
3162 INTEGER I1,I2,I3,I4
3164 Enable_const=1
3166 GOSUB Icode_get_arg
3168 IF Missing_arg THEN
3170 Error_string$="Missing floating point parameter"
3172 GOSUB Icode_err
3174 RETURN
3176 END IF
3178 IF Arg$<>"" THEN
3180 Error_string$="Undefined floating point CONST - '"&Arg$&"'"
3182 GOSUB Icode_err
3184 RETURN
3186 END IF
3188 CALL Lib_float_to_64(Arg,I1,I2,I3,I4)
3190 Add_object=I1
3192 GOSUB Icode_add_obj
3194 Add_object=I2
3196 GOSUB Icode_add_obj
3198 Add_object=I3
3200 GOSUB Icode_add_obj
3202 Add_object=I4
3204 GOSUB Icode_add_obj
3206 RETURN
3208 !
3210 ! This routine is used to assemble a string parameter. This string
3212 ! must be between single quotes. ICODE instructions that call for
3214 ! a string parameter also call for a string length word. The
3216 ! assembler will count the length of the string and insert the string
3218 ! length field for the user.
3220 !
3222 Icode_get_str:!
3224 INTEGER Str_len
3226 Missing_arg=0
3228 WHILE Line$=""
3230 GOSUB Get_cont_line
3232 END WHILE
3234 IF Missing_arg THEN
3236 Error_string$="Missing string parameter"
3238 GOSUB Icode_err
3240 RETURN
3242 END IF
3244 IF Line$[1;1]<>"'" THEN
3246 Error_string$="Missing first ' in string parameter"
3248 GOSUB Icode_err
3250 ELSE
3252 Line$=Line$[2]
3254 Str_len=POS(Line$,"'")
3256 IF Str_len=0 THEN
3258 Error_string$="Missing second ' in string parameter"
3260 GOSUB Icode_err
3262 ELSE
3264 Str_len=Str_len-1
3266 Arg$=Line$[1,Str_len]
3268 Line$=Line$[Str_len+2]
3270 IF Str_len MOD 2=1 THEN
3272 Arg$=Arg$&" " ! string should fall on word boundary
3274 Str_len=Str_len+1
3276 END IF
3278 Add_object=Str_len
3280 GOSUB Icode_add_obj
3282 FOR I=1 TO Str_len STEP 2
3284 Add_object=256*NUM(Arg$[I])+NUM(Arg$[I+1])
3286 GOSUB Icode_add_obj
3288 NEXT I
3290 END IF
3292 END IF
3294 RETURN
3296 !
3298 ! This subroutine is used to assemble a 'general' parameter.
3300 ! General means that it can be immediate, CONST or VAR.
3302 !
3304 Icode_get_param:!
3306 Enable_const=1
3308 GOSUB Icode_get_arg
3310 IF Missing_arg THEN
3312 Error_string$="Missing parameter"
3314 GOSUB Icode_err
3316 RETURN
3318 END IF
3320 IF Arg$<>"" THEN
3322 IF Arg$[1;1]="@" THEN
3324 Var_pos=FNIcode_search(Var_name$(*),Var_last,Arg$[2])
3326 IF Var_pos=-1 THEN
3328 Error_string$="Undefined indirect variable - '"&Arg$[2]&"'"
3330 GOSUB Icode_err
3332 RETURN
3334 END IF
3336 Arg=-(Var_num(Var_pos)+16384)
3338 ELSE
3340 Var_pos=FNIcode_search(Var_name$(*),Var_last,Arg$)
3342 IF Var_pos<>-1 THEN
3344 Arg=-Var_num(Var_pos)
3346 ELSE
3348 Error_string$="Undefined parameter symbol - '"&Arg$&"'"
3350 GOSUB Icode_err
3352 RETURN
3354 END IF
3356 END IF
3358 END IF ! IF 0 THEN
3360 IF Arg>Max_16_int OR Arg<Min_16_int THEN
3362 Error_string$="Invalid parameter value - '"&VAL$(Arg)&"'"
3364 GOSUB Icode_err
3366 RETURN
3368 END IF
3370 Add_object=Arg
3372 GOSUB Icode_add_obj
3374 RETURN
3376 !
3378 ! This subroutine is used to assemble a block id parameter.
3380 ! The block may be DEFBLK_VAR, DEFBLK_CON, DEFBLK_SP, DEFBLK_MAIN
3382 ! or DEFBLK_EXT.
3384 !
3386 Icode_get_block:!
3388 INTEGER Blk_id_arg,Blk_index
3390 Enable_const=0
3392 GOSUB Icode_get_arg
3394 IF Arg$="" THEN
3396 Error_string$="Illegal immediate block specification"
3398 GOSUB Icode_err
3400 ELSE
3402 IF Arg$[1;1]="^" THEN
3404 Blk_index=FNIcode_search(Blkext_name$(*),Blkext_last,Arg$[2])
3406 IF Blk_index=-1 THEN
3408 IF FNIcode_search(Blkvar_name$(*),Blkvar_last,Arg$[2])<>-1 OR FNIcode_search(Blkcon_name$(*),Blkcon_last,Arg$[2])<>-1 THEN
3410 Error_string$="'"&Arg$[2]&"' is not of auto allocate class"
3412 GOSUB Icode_err
3414 ELSE
3416 Error_string$="Undefined auto allocate block - '"&Arg$[2]&"'"
3418 GOSUB Icode_err
3420 END IF
3422 ELSE
3424 IF Blkext_hsize(Blk_index)=0 THEN
3426 Error_string$="No header allocated for '"&Arg$[2]&"'"
3428 GOSUB Icode_err
3430 ELSE
3432 Blk_id_arg=-(Blkext_id(Blk_index)+1)
3434 END IF
3436 END IF
3438 ELSE
3440 Blk_index=FNIcode_search(Blkext_name$(*),Blkext_last,Arg$)
3442 IF Blk_index<>-1 THEN
3444 Blk_id_arg=-Blkext_id(Blk_index)
3446 ELSE
3448 Blk_index=FNIcode_search(Blkvar_name$(*),Blkvar_last,Arg$)
3450 IF Blk_index<>-1 THEN
3452 Blk_id_arg=-Blkvar_id(Blk_index)
3454 ELSE
3456 Blk_index=FNIcode_search(Blkcon_name$(*),Blkcon_last,Arg$)
3458 IF Blk_index<>-1 THEN
3460 Blk_id_arg=Blkcon_id(Blk_index)
3462 ELSE
3464 Error_string$="Undefined block - '"&Arg$&"'"
3466 GOSUB Icode_err
3468 RETURN
3470 END IF
3472 END IF
3474 END IF
3476 END IF
3478 END IF
3480 Add_object=Blk_id_arg
3482 GOSUB Icode_add_obj
3484 RETURN
3486 !
3488 ! This subroutine is used to assemble a variable reference parameter.
3490 ! A DEFBLK_VAR parameter may also be used in this field.
3492 !
3494 Icode_get_var:!
3496 Enable_const=0
3498 GOSUB Icode_get_arg
3500 IF Arg$<>"" THEN
3502 IF Arg$[1;1]="@" THEN ! Is this an indirect variable
3504 Var_pos=FNIcode_search(Var_name$(*),Var_last,Arg$[2])
3506 IF Var_pos=-1 THEN
3508 Error_string$="Undefined indirect variable - '"&Arg$[2]&"'"
3510 GOSUB Icode_err
3512 ELSE
3514 Arg=-(Var_num(Var_pos)+16384)
3516 END IF
3518 ELSE
3520 Var_pos=FNIcode_search(Var_name$(*),Var_last,Arg$)
3522 IF Var_pos<>-1 THEN
3524 Arg=-Var_num(Var_pos)
3526 ELSE
3528 IF Arg$[1;1]="^" THEN ! Header block
3530 Blkext_pos=FNIcode_search(Blkext_name$(*),Blkext_last,Arg$[2])
3532 IF Blkext_pos<>-1 THEN
3534 IF Blkext_hsize(Blkext_pos)>0 THEN
3536 Arg=Blkext_id(Blkext_pos)+1
3538 ELSE
3540 Error_string$="No header block allocated for '"&Arg$[2]&"'"
3542 GOSUB Icode_err
3544 END IF
3546 ELSE
3548 Error_string$="'"&Arg$[2]&"' not of auto allocate class"
3550 GOSUB Icode_err
3552 END IF
3554 ELSE
3556 Blkext_pos=FNIcode_search(Blkext_name$(*),Blkext_last,Arg$)
3558 IF Blkext_pos<>-1 THEN
3560 Arg=-Blkext_id(Blkext_pos)
3562 ELSE
3564 Blkvar_pos=FNIcode_search(Blkvar_name$(*),Blkvar_last,Arg$)
3566 IF Blkvar_pos<>-1 THEN
3568 Arg=-Blkvar_id(Blkvar_pos)
3570 ELSE
3572 Error_string$="Undefined variable - '"&Arg$&"'"
3574 GOSUB Icode_err
3576 END IF
3578 END IF
3580 END IF
3582 END IF
3584 END IF
3585 ELSE
3586 Error_string$="Immediate parameter in variable reference field"
3587 GOSUB Icode_err
3589 END IF
3590 Add_object=Arg
3591 GOSUB Icode_add_obj
3592 RETURN
3594 !
3596 ! This subroutine is used to allocate all the internal tables
3598 ! needed by the assembler.
3600 !
3602 Icode_alloc_tbl:!
3604 Lbl_last=-1
3606 ALLOCATE Lbl_name$(0:MAX(Lbl_tbl_size-1,0))[16],INTEGER Lbl_loc(0:MAX(Lbl_tbl_size-1,0))
3608 IF Info_info=2 THEN ALLOCATE INTEGER Lbl_src_loc(0:MAX(Lbl_tbl_size-1,0))
3610 Var_last=-1
3612 ALLOCATE Var_name$(0:MAX(Var_tbl_size-1,0))[16],INTEGER Var_num(0:MAX(Var_tbl_size-1,0))
3614 Forlbl_last=-1
3616 ALLOCATE Forlbl_name$(0:MAX(Forlbl_tbl_size-1,0))[16],INTEGER Forlbl_loc(0:MAX(Forlbl_tbl_size-1,0))
3618 IF Enable_list THEN ALLOCATE INTEGER Forlbl_list_pos(0:MAX(Forlbl_tbl_size-1,0)),INTEGER Forlbl_list_lft(0:MAX(Forlbl_tbl_size-1,0))
3620 Blkvar_last=-1
3622 ALLOCATE Blkvar_name$(0:MAX(Blkvar_tbl_size-1,0))[16],INTEGER Blkvar_id(0:MAX(Blkvar_tbl_size-1,0))
3624 Blkext_last=-1
3626 ALLOCATE Blkext_name$(0:MAX(Blkext_tbl_size-1,0))[16],INTEGER Blkext_id(0:MAX(Blkext_tbl_size-1,0))
3628 ALLOCATE INTEGER Blkext_type(0:MAX(Blkext_tbl_size-1,0))
3630 ALLOCATE Blkext_hsize(0:MAX(Blkext_tbl_size-1,0)),Blkext_size(0:MAX(Blkext_tbl_size-1,0))
3632 Blkcon_last=-1
3634 ALLOCATE Blkcon_name$(0:MAX(Blkcon_tbl_size-1,0))[16],INTEGER Blkcon_id(0:MAX(Blkcon_tbl_size-1,0))
3636 Const_last=-1
3638 ALLOCATE Const_name$(0:MAX(Const_tbl_size-1,0))[16],Const_val(0:MAX(Const_tbl_size-1,0))
3640 RETURN
3642 !
3644 ! This subroutine is used to do some checks on Info$(*) to make sure
3646 ! that it is of the correct size.
3648 !
3650 Icode_chk_info:!
3652 Info_hdr_size=6
3654 IF Info_info>0 THEN
3656 IF Info_size<Info_hdr_size THEN
3658 Error_string$="Info$ array < "&VAL$(Info_hdr_size)&" elements"
3660 GOSUB Icode_init_err
3662 END IF
3664 IF BASE(Info$,1)<>0 THEN
3666 Error_string$="Info$(*) index must start at zero"
3668 GOSUB Icode_init_err
3670 END IF
3672 ON ERROR GOTO Icode_info_smal ! Each line must be 40 chars long
3674 FOR I=1 TO Info_hdr_size
3676 Info$(I)=RPT$(" ",40)
3678 NEXT I
3680 OFF ERROR
3682 IF 0 THEN
3684 Icode_info_smal:OFF ERROR
3686 Error_string$="Info$(*) string elements < 40 chars"
3688 GOSUB Icode_init_err
3690 END IF
3692 END IF
3694 RETURN
3696 !
3698 Icode_fill_info:!
3700!
3702! This subroutine is used to fill the Info$(*) array after all
3704! source code has been assembled will lots of little things
3706! that the debugger, downloader, etc... need to know.
3708!
3710! Info$(*) format:
3712!
3714! char->0 1 2 3 4
3716! line 1234567890123456789012345678901234567890
3718! 0 < a >< b >< c >< d >< e >
3720! 1 < i >< j >< k >< l >
3722! 2 < q >< r >< s >< t >
3724! 3 < x >< y >< z >
3726! 4 < F >< G >< H >
3728! 5 < I >< J >
3730! .
3732! k < Inst_info table >
3734! .
3736! .
3738! i < Blkext table >
3740! .
3742! .
3744! q < blkvar table >
3746! .
3748! .
3750! x < Blkcon table >
3752! .
3754! .
3756! F < Var table >
3758! .
3760! .
3762! I < Lbl table >
3764! .
3766! .
3768! z < Debugger history queue space >
3770! .
3772! a: Info_info
3774! b: ICODE program id
3776! c: Info$(*) header size (6)
3778! d: Info_size
3780! e: # of vars reserved. For VAR, DEFBLK_VAR, etc...
3782!
3784! i: Start of Blkext table in Info$(*)
3786! j: # of Blkext table lines in Info$(*)
3788! k: Object_size
3790! l: Source_size
3792!
3794! q: Start of Blkvar table in Info$(*)
3796! r: # of Blkvar table lines in Info$(*)
3798! s: Start of Instruction table in Info$(*)
3800! t: # of Instructions in Info$(*). NOT # of instruction lines.
3802!
3804! x: Start of Blkcon table in Info$(*)
3806! y: # of Blkcon table lines in Info$(*)
3808! z: Start of 3 lines in Info$(*) reserved for debugger history queue
3810!
3812! F: Start of var table in Info$(*)
3814! G: # of var table lines in Info$(*)
3816! H: Object(*) address of last set break point. Used by debugger.
3818!
3820! I: Start of label table in Info$(*)
3822! J: # of label table lines in Info$(*)
3824!
3826! Inst_info table: Each line may have information about a maximum of 10
3828! assembled instructions. Information about a single
3830! instruction consists of 4 bytes. These bytes are in
3832! binary format with the first 2 bytes indicating the
3834! object address and the second 2 bytes indicating the
3836! source address.
3838!
3840! Blkext table: Each line has information about one DEFBLK_SP,DEFBLK_MAIN
3842! or DEFBLK_EXT user defined block. Chars 1 through 16 are
3844! the block name, char 17 is a mode byte, chars 18 through
3846! 22 hold the variable number, chars 23 through 28 hold
3848! the block size, chars 29 through 34 hold the header block
3850! size, and chars 35 through 39 hold the block id. The
3852! mode byte indicates the block type and whether or not
3854! the downloader should allocate this block at download
3856! time. Mode codes are as follows:
3858! 0 - undefined yet
3860! 1 - MAIN auto allocate block
3862! 2 - SP auto allocate block
3864! 3 - MAIN user allocate block
3866! 4 - SP user allocate block
3868!
3870! Blkvar table: Each line has information about one DEFBLK_VAR block.
3872! Characters 1 through 16 hold the block name and chars
3874! 17 through 21 hold the variable number that contains the
3876! block id.
3878!
3880! Blkcon table: Each line has information about one DEFBLK_CON block.
3882! Characters 1 through 16 hold the block name and chars
3884! 17 through 21 hold the block id.
3886!
3888! Var table: Each line has information about one VARiable. Characters
3890! 1 through 16 hold the variable name and chars 17 through
3892! 21 hold the variable number.
3894!
3896! Lbl table: Each line has information about one label. Characters
3898! 1 through 16 hold the label name and chars 17 through 21
3900! hold the label source address.
3902!
3904! Debugger history queue space: These 3 lines are used as storage space
3906! by the debugger. The first line contains
3908! 2 fields. Chars 1 through 5 hold the
3910! Hist_fifo_ptr and chars 6 through 10 hold
3912! Hist_fifo_wrap. The second line contains
3914! the ICODE history object address list.
3916! This list can hold up to 20 two byte
3918! binary entries. The third line contains
3920! the ICODE history opcode list. This list
3922! can also hold up to 20 two byte binary
3924! entries. This list is used to hold the
3926! ICODE history queue. See IHQ? HP-IB
3928! command.
3930!
3932!
3934 IF Info_info<>0 THEN
3936 !
3938 ! Find out how many lines need to be in Info$(*)
3940 !
3942 IF Info_info=1 THEN Lines_needed=Blkext_last+1+Info_hdr_size
3944 !
3946 IF Info_info=2 THEN
3948 Info_inst_cnt=Inst_cnt DIV 10
3950 IF Inst_cnt MOD 10<>0 THEN Info_inst_cnt=Info_inst_cnt+1
3952 Lines_needed=MAX(Blkext_last,0)+MAX(Blkvar_last,0)+MAX(Blkcon_last,0)+MAX(Var_last,0)+MAX(Lbl_last,0)+MAX(Info_hdr_size,0)+6+Info_inst_cnt
3954 Lines_needed=Lines_needed+3 ! Debugger needs this space
3956 END IF ! to keep the history list
3958 !
3960 IF Lines_needed>Info_size THEN
3962 Error_string$="Info$ array not large enough"
3964 GOSUB Icode_fatal_err
3966 END IF
3968 !
3970 REDIM Info$(0:Lines_needed-1)
3972 !
3974 ! Get indexes into Info$(*) where each table will go
3976 !
3978 Blkext_infostrt=Info_hdr_size+Info_inst_cnt
3980 Blkvar_infostrt=Blkext_infostrt+Blkext_last+1
3982 Blkcon_infostrt=Blkvar_infostrt+Blkvar_last+1
3984 Var_infostrt=Blkcon_infostrt+Blkcon_last+1
3986 Lbl_infostrt=Var_infostrt+Var_last+1
3988 !
3990 ! Start filling in Info$(*) with info.
3992 !
3994 IF Info_info=2 THEN
3996 Dbg_infostrt=Lbl_infostrt+Lbl_last+1 !Reserve 3 lines for hist
3998 ! table used by debugger.
4000 Info$(Dbg_infostrt)[1,5]=VAL$(-1) ! Init Hist_fifo_ptr
4002 Info$(Dbg_infostrt)[6,10]=VAL$(0) ! Init Hist_fifo_wrap
4004 Info$(Dbg_infostrt+1)=RPT$(" ",40)
4006 Info$(Dbg_infostrt+2)=RPT$(" ",40)
4008 END IF
4010 !
4012 Info$(0)[1,5]=VAL$(Info_info)
4014 Info$(0)[6,10]=VAL$(-1)
4016 Info$(0)[11,15]=VAL$(Info_hdr_size)
4018 Info$(0)[16,20]=VAL$(Lines_needed)
4020 Info$(0)[21,25]=VAL$(Vars_allocated)
4022 !
4024 IF Blkext_last=-1 THEN
4026 Info$(1)[1,5]=VAL$(0)
4028 ELSE
4030 Info$(1)[1,5]=VAL$(Blkext_infostrt)
4032 END IF
4034 Info$(1)[6,10]=VAL$(Blkext_last+1)
4036 Info$(1)[11,15]=VAL$(Object_last+1)
4038 Info$(1)[16,20]=VAL$(Source_last)
4040 !
4042 IF Info_info=1 THEN
4044 FOR I=2 TO 5
4046 Info$(I)[1,5]=VAL$(0)
4048 Info$(I)[6,10]=VAL$(0)
4050 NEXT I
4052 ELSE
4054 Info$(2)[1,5]=VAL$(Blkvar_infostrt)
4056 Info$(2)[6,10]=VAL$(Blkvar_last+1)
4058 Info$(2)[11,15]=VAL$(Info_inst_base)
4060 Info$(2)[16,20]=VAL$(Inst_cnt)
4062 Info$(3)[1,5]=VAL$(Blkcon_infostrt)
4064 Info$(3)[6,10]=VAL$(Blkcon_last+1)
4066 Info$(3)[11,15]=VAL$(Dbg_infostrt) ! used by debugger
4068 Info$(4)[1,5]=VAL$(Var_infostrt)
4070 Info$(4)[6,10]=VAL$(Var_last+1)
4072 Info$(4)[11,15]=VAL$(-1) ! used by debugger to
4074 Info$(5)[1,5]=VAL$(Lbl_infostrt)
4076 Info$(5)[6,10]=VAL$(Lbl_last+1)
4078 Info$(5)[11;1]=VAL$(0) ! Disp_vars_hex = 0
4080 Info$(5)[12;1]=VAL$(0) ! disp_blks_hex = 0
4082 END IF
4084 !
4086 ! Fill in externally allocated block table
4088 !
4090 Blkext_ptr=-1
4092 FOR I=Blkext_infostrt TO Blkext_infostrt+Blkext_last
4094 Blkext_ptr=Blkext_ptr+1
4096 Info$(I)[1,16]=Blkext_name$(Blkext_ptr)
4098 Info$(I)[17;1]=VAL$(Blkext_type(Blkext_ptr))
4100 Info$(I)[18,22]=VAL$(Blkext_id(Blkext_ptr))
4102 Info$(I)[23,28]=VAL$(Blkext_size(Blkext_ptr))
4104 Info$(I)[29,34]=VAL$(Blkext_hsize(Blkext_ptr))
4106 NEXT I
4108 !
4110 IF Info_info=2 THEN
4112 !
4114 ! Fill in DEFBLK_VAR table
4116 !
4118 Blkvar_ptr=-1
4120 FOR I=Blkvar_infostrt TO Blkvar_infostrt+Blkvar_last
4122 Blkvar_ptr=Blkvar_ptr+1
4124 Info$(I)[1,16]=Blkvar_name$(Blkvar_ptr)
4126 Info$(I)[17,21]=VAL$(Blkvar_id(Blkvar_ptr))
4128 NEXT I
4130 !
4132 ! Fill in DEFBLK_CON table
4134 !
4136 Blkcon_ptr=-1
4138 FOR I=Blkcon_infostrt TO Blkcon_infostrt+Blkcon_last
4140 Blkcon_ptr=Blkcon_ptr+1
4142 Info$(I)[1,16]=Blkcon_name$(Blkcon_ptr)
4144 Info$(I)[17,21]=VAL$(Blkcon_id(Blkcon_ptr))
4146 NEXT I
4148 !
4150 ! Fill in variable table
4152 !
4154 Var_ptr=-1
4156 FOR I=Var_infostrt TO Var_infostrt+Var_last
4158 Var_ptr=Var_ptr+1
4160 Info$(I)[1,16]=Var_name$(Var_ptr)
4162 Info$(I)[17,21]=VAL$(Var_num(Var_ptr))
4164 NEXT I
4166 !
4168 ! Fill in label table
4170 !
4172 Lbl_ptr=-1
4174 FOR I=Lbl_infostrt TO Lbl_infostrt+Lbl_last
4176 Lbl_ptr=Lbl_ptr+1
4178 Info$(I)[1,16]=Lbl_name$(Lbl_ptr)
4180 Info$(I)[17,21]=VAL$(Lbl_loc(Lbl_ptr))
4182 Info$(I)[22,26]=VAL$(Lbl_src_loc(Lbl_ptr))
4184 NEXT I
4186 END IF ! If info_info=2 then
4188 END IF ! If Info_info<>0 then
4190 RETURN
4192 !
4194 Icode_forlbl_ck: ! See if there are any unresolved forward references
4196 IF Forlbl_last>-1 THEN
4198 FOR I=0 TO Forlbl_last
4200 Error_string$="ERROR: Undefined label - '"&Forlbl_name$(I)&"'"
4202 OUTPUT CRT;Error_string$
4204 Error_count=Error_count+1
4206 IF Enable_list THEN
4208 List_last=List_last+1
4210 List$(MAX(0,MIN(List_last,List_size-1)))=RPT$(" ",15)&"***** "&Error_string$&" *****"
4212 END IF
4214 NEXT I
4216 END IF
4218 RETURN
4220 !
4222 Icode_asm_exit: ! This routine is used to exit the assembler
4224 Disp_line$="ICODE assembly complete. "
4226 IF Error_count=0 THEN
4228 Disp_line$=Disp_line$&"No errors. "&VAL$(Source_last)&" source lines. "&VAL$(Object_last+1)&" object words."
4230 ELSE
4232 BEEP
4234 IF Error_count=1 THEN
4236 Disp_line$=Disp_line$&VAL$(Error_count)&" error."
4238 ELSE
4240 Disp_line$=Disp_line$&VAL$(Error_count)&" errors."
4242 IF Error_count>20 THEN Disp_line$=Disp_line$&" ICODE program needs work"
4244 END IF
4246 END IF
4248 DISP Disp_line$
4250 IF Enable_list THEN
4252 List_last=List_last+1
4254 List$(MIN(List_last,List_size-1))=Disp_line$
4256 END IF
4258 REDIM List$(0:MAX(0,MIN(List_last,List_size-1)))
4260 IF Error_count=0 THEN
4262 REDIM Source$(0:MAX(Source_last-1,0))
4264 REDIM Object(0:MAX(Object_last,0))
4266 END IF
4268 !
4270 IF Error_count<>0 THEN
4272 ON ERROR GOTO Icode_who_cares
4274 REDIM Info$(0:0)
4276 Info$(0)="9"
4278 Icode_who_cares:IF 0 THEN A=1
4280 OFF ERROR
4282 END IF
4284 !
4286 RETURN Error_count
4288 END IF ! GOSUBS IF 0 THEN
4290 !
4292 FNEND ! Icode_assemble
4294 !
4296 Icode_search:DEF FNIcode_search(Search_array$(*),Array_last,Search_key$)
4298!
4300! This function is used by the assembler to search a table and return
4302! an index into that table indicating where the search key was found.
4304! <Search_array$> is the array to be searched. <Array_last> is the last
4306! element in <Search_array$> that should be checked. <Search_key$> is
4308! what should be found in <Search_array$>. If <Search_key$> is found
4310! in <Search_array$> then the index into <Search_array$> is returned
4312! in the function result, else -1 is returned.
4314!
4316 INTEGER I,Int_array_last
4318 Int_array_last=Array_last
4320 IF Int_array_last>=0 THEN
4322 FOR I=0 TO Int_array_last
4324 IF Search_key$=Search_array$(I) THEN RETURN I
4326 NEXT I
4328 END IF
4330 RETURN -1
4332 FNEND
4334 !
4336 Icode_inst_str:SUB Icode_inst_str(Opcode$,Inst_info$)
4338!
4340! This function is used by the assembler to translate an opcode mnemonic
4342! (did you know that mnemonically is a word?) into an instruction
4344! information string. The instruction information string contains
4346! the opcode number and a list of code which tell the assembler what
4348! parameters must follow. If the opcode mnemonic (who was the first
4350! person to spell mnemonic?) is undefined, then "-1" is returned.
4352! See the main assembly loop in the assembler for details on what the
4354! parameter codes mean.
4356!
4358 SELECT Opcode$[1;2]
4360 CASE "C_"
4362 SELECT Opcode$[3]
4364 CASE "BEQ"
4366 Inst_info$="57 LPP"
4368 CASE "BGE"
4370 Inst_info$="59 LPP"
4372 CASE "BGT"
4374 Inst_info$="60 LPP"
4376 CASE "BITSET"
4378 Inst_info$="54 LPP"
4380 CASE "BLE"
4382 Inst_info$="56 LPP"
4384 CASE "BLT"
4386 Inst_info$="55 LPP"
4388 CASE "BNE"
4390 Inst_info$="58 LPP"
4392 CASE "END"
4394 Inst_info$="48"
4396 CASE "GOSUB"
4398 Inst_info$="50 L"
4400 CASE "GOTO"
4402 Inst_info$="49 L"
4404 CASE "NOP"
4406 Inst_info$="61"
4408 CASE "RTS"
4410 Inst_info$="51"
4412 CASE "SP_BEQ"
4414 Inst_info$="52 LP"
4416 CASE "SP_BNE"
4418 Inst_info$="53 LP"
4420 CASE ELSE
4422 Inst_info$="-1"
4424 END SELECT
4426 CASE "F_"
4428 SELECT Opcode$[3]
4430 CASE "ASSERT_TRIG"
4432 Inst_info$="22"
4434 CASE "BLK_MC68000"
4436 Inst_info$="32 BPMRBP!"
4438 CASE "COPY_BLOCK"
4440 Inst_info$="14 BB"
4442 CASE "EXEC"
4444 Inst_info$="134 P"
4446 CASE "FAST_AVG_ADD"
4448 Inst_info$="126 BPBPPP"
4450 CASE "FAST_AVG_DIV"
4452 Inst_info$="127 BPBPPP"
4454 CASE "FAST_AVG_INIT"
4456 Inst_info$="124 BPPPPP"
4458 CASE "FLOAT_ADD"
4460 Inst_info$="86 BPBPBPP"
4462 CASE "FLOAT_AVG"
4464 Inst_info$="132 BPBPPP"
4466 CASE "FLOAT_CCONST"
4468 Inst_info$="107 BPPFF"
4470 CASE "FLOAT_CDIV"
4472 Inst_info$="101 BPBPBPP"
4474 CASE "FLOAT_CMULT"
4476 Inst_info$="98 BPBPBPP"
4478 CASE "FLOAT_CONJ"
4480 Inst_info$="116 BPBPP"
4482 CASE "FLOAT_CONST"
4484 Inst_info$="104 BPPF"
4486 CASE "FLOAT_EXTREMAL"
4488 Inst_info$="120 BPBPP"
4490 CASE "FLOAT_DINTRLVE"
4492 Inst_info$="45 BPBPBPP"
4494 CASE "FLOAT_DIV"
4496 Inst_info$="95 BPBPBPP"
4498 CASE "FLOAT_INTRLVE"
4500 Inst_info$="83 BPBPBPP"
4502 CASE "FLOAT_LOG10"
4504 Inst_info$="125 BPBPP"
4506 CASE "FLOAT_MULT"
4508 Inst_info$="92 BPBPBPP"
4510 CASE "FLOAT_PHASE"
4512 Inst_info$="119 BPBPP"
4514 CASE "FLOAT_SQRT"
4516 Inst_info$="122 BPBPP"
4518 CASE "FLOAT_SUB"
4520 Inst_info$="89 BPBPBPP"
4522 CASE "FLOAT_TO_INT"
4524 Inst_info$="113 BPBPP"
4526 CASE "FLOAT_TO_SHORT"
4528 Inst_info$="112 BPBPP"
4530 CASE "FLOAT_WINGEN"
4532 Inst_info$="138 BPPMRF!"
4534 CASE "FLOAT_XYPOW"
4536 Inst_info$="128 BPBPBPP"
4538 CASE "GET_ASCII"
4540 Inst_info$="27 PMRV!"
4542 CASE "GET_GBL_STA","GET_GLB_STA"
4544 Inst_info$="30 V"
4546 CASE "GET_HDW_STATUS"
4548 Inst_info$="29 PV"
4550 CASE "GET_SIG"
4552 Inst_info$="46 V"
4554 CASE "GET_SRQ_MASK"
4556 Inst_info$="63 V"
4558 CASE "GET_STA"
4560 Inst_info$="15 V"
4562 CASE "GET_STATUS"
4564 Inst_info$="28 PV"
4566 CASE "GET_STC"
4568 Inst_info$="16 V"
4570 CASE "GLB_COMMAND"
4572 Inst_info$="24 PS"
4574 CASE "GLB_CONTROL"
4576 Inst_info$="26 V"
4578 CASE "HPIB_COMMAND"
4580 Inst_info$="17 S"
4582 CASE "INPUT_DATA"
4584 Inst_info$="1 PBPP"
4586 CASE "INT_TO_FLOAT"
4588 Inst_info$="111 BPBPP"
4590 CASE "INT_TO_SHORT"
4592 Inst_info$="110 BPBPP"
4594 CASE "KEEP_READY_RAM"
4596 Inst_info$="66"
4598 CASE "LOAD_PROG"
4600 Inst_info$="42 BP"
4602 CASE "LOAD_SP_ALGS"
4604 Inst_info$="47 P"
4606 CASE "MC68000"
4608 Inst_info$="31 IMRBP!"
4610 CASE "MOD_COMMAND"
4612 Inst_info$="23 PS"
4614 CASE "MOD_CONTROL"
4616 Inst_info$="25 PV"
4618 CASE "MOVE_BLOCK"
4620 Inst_info$="13 BPBPP"
4622 CASE "OFF_INT"
4624 Inst_info$="38"
4626 CASE "ON_IRQ"
4628 Inst_info$="35 L"
4630 CASE "ON_SHUTDOWN"
4632 Inst_info$="37 L"
4634 CASE "ON_SP"
4636 Inst_info$="36 L"
4638 CASE "ON_SRQ"
4640 Inst_info$="34 L"
4642 CASE "OUTPUT_DATA"
4644 Inst_info$="2 PBPP"
4646 CASE "PAUSE"
4648 Inst_info$="133"
4650 CASE "POLL_MODULE"
4652 Inst_info$="39 PV"
4654 CASE "READ_DISC"
4656 Inst_info$="5 BPPPPPPPV"
4658 CASE "READ_ROM"
4660 Inst_info$="136 PV"
4662 CASE "READ_SP_STAT"
4664 Inst_info$="118 V"
4666 CASE "READY_DISC"
4668 Inst_info$="7 PPPPPBPBPV"
4670 CASE "READY_RAM"
4672 Inst_info$="8 M@0BPPPMRP!@1BPBPV"
4674 CASE "RECEIVE_DATA"
4676 Inst_info$="3 BPP"
4678 CASE "RELEASE_BUS"
4680 Inst_info$="41 P"
4682 CASE "REQUEST_BUS"
4684 Inst_info$="40"
4686 CASE "SAMPLE"
4688 Inst_info$="137 BPBPPPP"
4690 CASE "SEND_DATA"
4692 Inst_info$="4 BPP"
4694 CASE "SET_EXP_DEF"
4696 Inst_info$="129 PPPP"
4698 CASE "SET_SRQ_MASK"
4700 Inst_info$="64 P"
4702 CASE "SET_WORK_ID"
4704 Inst_info$="139 B"
4706 CASE "SHORT_ADD"
4708 Inst_info$="84 BPBPBPP"
4710 CASE "SHORT_CCONST"
4712 Inst_info$="105 BPPPPP"
4714 CASE "SHORT_CDIV"
4716 Inst_info$="99 BPBPBPP"
4718 CASE "SHORT_CMULT"
4720 Inst_info$="96 BPBPBPP"
4722 CASE "SHORT_CONJ"
4724 Inst_info$="114 BPBPP"
4726 CASE "SHORT_CONST"
4728 Inst_info$="102 BPPPP"
4730 CASE "SHORT_DINTRLVE"
4732 Inst_info$="43 BPBPBPP"
4734 CASE "SHORT_DIV"
4736 Inst_info$="93 BPBPBPP"
4738 CASE "SHORT_INTRLVE"
4740 Inst_info$="81 BPBPBPP"
4742 CASE "SHORT_MULT"
4744 Inst_info$="90 BPBPBPP"
4746 CASE "SHORT_NORM"
4748 Inst_info$="135 BPP"
4750 CASE "SHORT_SUB"
4752 Inst_info$="87 BPBPBPP"
4754 CASE "SHORT_TO_FLOAT"
4756 Inst_info$="109 BPBPP"
4758 CASE "SHORT_TO_INT"
4760 Inst_info$="108 BPBPP"
4762 CASE "SIG_PROC"
4764 Inst_info$="0 PMRM!MRBP!"
4766 CASE "SIGNAL"
4768 Inst_info$="18 P"
4770 CASE "STORE_PROG"
4772 Inst_info$="62 BPPP"
4774 CASE "SYNC"
4776 Inst_info$="33"
4778 CASE "SYNC_TIME"
4780 Inst_info$="130 P"
4782 CASE "THRUPUT"
4784 Inst_info$="9 PP"
4786 CASE "TRIG_SEQ"
4788 Inst_info$="10"
4790 CASE "TRIG_SEQ_TIME"
4792 Inst_info$="121 P"
4794 CASE "UNASSERT_TRIG"
4796 Inst_info$="21"
4798 CASE "UNDEFINED"
4800 Inst_info$="44"
4802 CASE "WAIT_FOR_SIG"
4804 Inst_info$="19 V"
4806 CASE "WAIT_TO_SIG"
4808 Inst_info$="65 P"
4810 CASE "WAIT_SRQ"
4812 Inst_info$="20"
4814 CASE "WRITE_DISC"
4816 Inst_info$="6 BPPPPPPPV"
4818 CASE "WRITE_ROM"
4820 Inst_info$="123 PP"
4822 CASE "WRITE_SP_CNTL"
4824 Inst_info$="117 P"
4826 CASE "XFER_TO_HOST"
4828 Inst_info$="11 PP"
4830 CASE "XFER_TO_MOD"
4832 Inst_info$="12 PP"
4834 CASE ELSE
4836 Inst_info$="-1"
4838 END SELECT
4840 CASE "V_"
4842 SELECT Opcode$[3]
4844 CASE "ADD"
4846 Inst_info$="71 PPV"
4848 CASE "AND"
4850 Inst_info$="68 PPV"
4852 CASE "CEQUATE"
4854 Inst_info$="75 IV"
4856 CASE "DIV"
4858 Inst_info$="74 PPV"
4860 CASE "GET16_INDEXED"
4862 Inst_info$="77 BPV"
4864 CASE "GET32_INDEXED"
4866 Inst_info$="78 BPV"
4868 CASE "MODULO"
4870 Inst_info$="70 PPV"
4872 CASE "MULT"
4874 Inst_info$="73 PPV"
4876 CASE "NOT"
4878 Inst_info$="67 PV"
4880 CASE "OR"
4882 Inst_info$="69 PPV"
4884 CASE "PUT16_INDEXED"
4886 Inst_info$="79 BPV"
4888 CASE "PUT32_INDEXED"
4890 Inst_info$="80 BPV"
4892 CASE "SUB"
4894 Inst_info$="72 PPV"
4896 CASE "VEQUATE"
4898 Inst_info$="76 VV"
4900 CASE ELSE
4902 Inst_info$="-1"
4904 END SELECT
4906 CASE ELSE
4908 Inst_info$="-1"
4910 END SELECT
4912 SUBEND
4914 !
4916 Icode_eval_str:SUB Icode_eval_str(Str$,Str_val,Str_error)
4918!
4920! This subprogram is used to evaluate a string into a numerical quantity.
4922! <Str$> is the input string and its numerical value (if there is one) is
4924! returned in <Str_val>. This will work on decimal and hex numbers. Hex
4926! numbers must be preceeded by a '$'. If <Str$> can not be converted
4928! into a number then <Str_error> is set to 1. <Str_error> is also set
4930! to 1 if <Str$>="".
4932!
4934 Str_error=0
4936 ON ERROR GOTO Icode_no_value
4938 IF Str$="" THEN
4940 Str_error=1
4942 ELSE
4944 IF Str$[1;1]="$" THEN
4946 Str_val=DVAL(Str$[2],16)
4948 Str$=""
4950 ELSE
4952 Str_val=VAL(Str$)
4954 Str$=""
4956 END IF
4958 END IF
4960 IF 0 THEN
4962 Icode_no_value:Str_val=-1
4964 END IF
4966 OFF ERROR
4968 SUBEND
4970 !
4972 Icode_dld:DEF FNIcode_dld(INTEGER Object(*),INTEGER Enable_info,Info$(*))
4974!
4976! This function is used to allocate an ICODE program block, allocate
4978! some types of data blocks, and download the ICODE program into its
4980! program block. <Object(*)> is the assembled ICODE program.
4982! <Enable_info> is a flag which enables the downloader to search <Info$>
4984! for unallocated blocks. If <Enable_info> is non-zero, then <Info$> is
4986! searched for all DEFBLK_SP and DEFBLK_MAIN block types. These blocks
4988! are then allocated. Also, DEFBLK_EXT block types that have been
4990! flagged by 'FNIcode_def_ext' to be allocated by the downloader are
4992! allocated. To find out the block id of any block, 'FNIcode_ext_id'
4994! may be used after the ICODE program has been downloaded. If
4996! <Enable_info> is zero, then no blocks are allocated (except the ICODE
4998! program block). Returned in the function result is the block id of
5000! the ICODE program. If an error occurs, then an error message is
5002! displayed and a -1 is returned as the function result.
5004!
5006 DIM Line$[40],Error_string$[100],Temp$[20]
5008 Object_size=SIZE(Object,1)
5010 IF NOT FNIcode_info_ok(Info$(*),Error_string$) THEN GOTO Icode_dld_err
5012 !
5014 IF Enable_info THEN
5016 ON ERROR GOTO Icode_info_bad
5018 Blkext_strt=VAL(Info$(1)[1,5])
5020 Blkext_cnt=VAL(Info$(1)[6,10])
5022 FOR I=Blkext_strt TO Blkext_strt+Blkext_cnt-1
5024 Line$=Info$(I)
5026 Block_type=VAL(Line$[17;1])
5028 IF Block_type=0 THEN
5030 Error_string$="Block '"&TRIM$(Line$[1,16])&"' not allocated"
5032 GOTO Icode_dld_err
5034 RETURN -1
5036 ELSE
5038 Var_number=VAL(Line$[18,22])
5040 Block_size=VAL(Line$[23,28])
5042 Hblock_size=VAL(Line$[29,34])
5044 IF Var_number<0 OR Var_number>32767 THEN GOTO Icode_info_bad
5046 IF Block_size<0 THEN GOTO Icode_info_bad
5048 IF Hblock_size<0 THEN Icode_info_bad
5050 IF Block_type=1 OR Block_type=2 THEN
5052 OFF ERROR
5054 IF Block_type=1 THEN
5056 Temp$=FNHw_cmd_rsp$("NEW "&VAL$(Block_size)&","&VAL$(Hblock_size)&";NEW?",3)
5058 ELSE
5060 Temp$=FNHw_cmd_rsp$("SNEW "&VAL$(Block_size)&","&VAL$(Hblock_size)&";NEW?",3)
5062 END IF
5064 IF FNHw_io_error THEN GOTO Icode_hw_io_err
5066 ON ERROR GOTO Icode_info_bad
5068 Block_id=VAL(Temp$)
5070 IF Block_id=-1 THEN GOTO Icode_id_bad
5072 IF Block_id>32767 THEN GOTO Icode_info_bad
5074 Info$(I)[35,39]=VAL$(Block_id)
5076 ELSE
5078 Block_id=VAL(Info$(I)[35,39])
5080 END IF
5082 Var_base=Var_number*2
5084 ON ERROR GOTO Icode_obj_bad
5086 Object(Var_base)=0
5088 Object(Var_base+1)=Block_id
5090 IF Hblock_size>0 THEN
5092 Object(Var_base+2)=0
5094 Object(Var_base+3)=Block_id+1
5096 END IF
5098 END IF
5100 NEXT I
5102 END IF
5104 !
5106 OFF ERROR
5108 Temp$=FNHw_cmd_rsp$("NEW "&VAL$(SIZE(Object,1))&";NEW?",3)
5110 IF FNHw_io_error THEN GOTO Icode_hw_io_err
5112 Prog_id=VAL(Temp$)
5114 IF Prog_id=-1 THEN
5116 Error_string$="Can not allocate program block"
5118 GOTO Icode_dld_err
5120 END IF
5122 !
5124 Hw_write_blk(Prog_id,Object(*),5)
5126 IF FNHw_io_error THEN GOTO Icode_hw_io_err
5128 !
5130 IF Enable_info THEN
5132 Info$(0)[6,10]=VAL$(Prog_id)
5134 END IF
5136 !
5138 RETURN Prog_id
5140 !
5142 IF 0 THEN
5144 Icode_obj_bad:!
5146 Error_string$="Object(*) access error"
5148 GOTO Icode_dld_err
5150 Icode_id_bad:!
5152 Error_string$="Could not allocate block data block"
5154 GOTO Icode_dld_err
5156 Icode_hw_io_err:!
5158 Error_string$="Hardware I/O timeout error"
5160 GOTO Icode_dld_err
5162 Icode_info_bad:!
5164 Error_string$="Info$ array format error"
5166 GOTO Icode_dld_err
5168 Icode_dld_err:OFF ERROR
5170 Icode_exec_err("Icode_dld: "&Error_string$)
5172 RETURN -1
5174 END IF
5176 FNEND
5178 !
5180 Icode_ext_id:DEF FNIcode_ext_id(Block_name$,Info$(*))
5182!
5184! This function is used to get the id of an ICODE defined block. Since
5186! auto allocate blocks are not allocated until download time, this function
5188! will not return valid data until the ICODE program has been downloaded.
5190! The block name is specified by <Block_name$> and the block id is returned
5192! in the function result. If there is an error (block not allocated yet,
5194! etc), then -1 will be returned.
5196!
5198 DIM Error_string$[100]
5200 IF FNIcode_info_ok(Info$(*),Error_string$) THEN
5202 Info_pos=VAL(Info$(1)[1,5])
5204 Info_max=Info_pos+VAL(Info$(1)[6,10])-1
5206 Block_name$=UPC$(TRIM$(Block_name$))
5208 WHILE Info_pos<=Info_max
5210 IF Block_name$[1;1]="^" THEN
5212 IF Block_name$[2]=TRIM$(Info$(Info_pos)[1,16]) THEN
5214 IF VAL(Info$(Info_pos)[29,34])>0 THEN
5216 Auto_id=VAL(Info$(Info_pos)[35,39])
5217 RETURN Auto_id
5219 ELSE
5220 Icode_exec_err("Icode_ext_id: No header block allocated")
5222 RETURN -1
5224 END IF
5226 END IF
5228 ELSE
5230 IF Block_name$=TRIM$(Info$(Info_pos)[1,16]) THEN
5232 Auto_id=VAL(Info$(Info_pos)[35,39])
5234 RETURN Auto_id
5236 END IF
5238 END IF
5240 Info_pos=Info_pos+1
5242 END WHILE
5244 ELSE
5246 Icode_exec_err("Icode_ext_id: "&Error_string$)
5248 RETURN -1
5250 END IF
5252 RETURN -1
5254 FNEND
5256 !
5258 Icode_info_ok:DEF FNIcode_info_ok(Info$(*),Error_string$)
5260!
5262! This function is used (not by the assembler) to see if the Info$ array
5264! is of the correct format. This routine is here because every ICODE
5266! file subprogram that accesses <Info$> needs to make sure that it does
5268! not bomb out because the user didn't pass in the correct array.
5270! Returned in the function result is a 1 if <Info$> seems ok. If a
5272! problem is found with <Info$> then <Error_string$> is used to return
5274! an error string.
5276!
5278 DIM Line$[40]
5280 !
5282 Error_string$=""
5284 !
5286 IF BASE(Info$,1)<>0 THEN ! Check index
5288 Error_string$="Info$ index must start at zero"
5290 RETURN 0
5292 END IF
5294 !
5296 ON ERROR GOTO Icode_str_smal
5298 Line$[1;40]=Info$(0) ! make sure 40 chars wide
5300 Info$(0)=RPT$(" ",40)
5302 Info$(0)=Line$
5304 !
5306 ! Check info_info field
5308 !
5310 ON ERROR GOTO Icode_info_bad
5312 Info_info=VAL(Line$[1,5])
5314 IF Info_info<0 OR Info_info>2 THEN GOTO Icode_info_bad
5316 !
5318 Header_size_chk=VAL(Info$(0)[11,15]) ! get header size
5320 !
5322 ! Now see if size make sense.
5324 !
5326 Total_size=VAL(Info$(0)[16,20])
5328 IF SIZE(Info$,1)<Header_size_chk OR SIZE(Info$,1)<Total_size THEN
5330 Error_string$="Info$ format error - Info$ too small"
5332 RETURN 0
5334 END IF
5336 !
5338 RETURN 1
5340 !
5342 IF 0 THEN
5344 Icode_info_bad:Error_string$="Info$ format error"
5346 RETURN 0
5348 Icode_str_smal:Error_string$="Info$ format error - < 40 chars"
5350 RETURN 0
5352 END IF
5354 FNEND
5356 !
5358 Icode_exec_err:SUB Icode_exec_err(Error_string$)
5360!
5362! This function is used to display an error message on the screen.
5364! The screen is cleared, the error message is displayed, this routine
5366! then waits 3 seconds and returns.
5368!
5370 BEEP
5372 OUTPUT CRT;""
5374 OUTPUT CRT
5376 OUTPUT CRT;"*** ";Error_string$;" ***"
5378 OUTPUT CRT
5380 WAIT 3
5382 SUBEND
5384 !
5386 Icode_def_ext:DEF FNIcode_def_ext(Block_name$,Use_main_ram,Block_size,Hblock_size,Block_id,Info$(*))
5388!
5390! This function is used to bind a DEFBLK_EXT block name with a block id.
5392! The block to be bound is specified by <Block_name$>. If the block is
5394! an HP3565S HP-IB module MAIN data RAM block, then <Use_main_ram> should
5396! be non-zero. If the block is to reside in SP data RAM, then
5398! <Use_main_ram> should be zero. <Info$(*)> is the information array
5400! that was filled with all sorts of information from the assembler. There
5402! are two modes this function can be used in. If <Block_id> is <= 0
5404! then mode 1 is used. In mode 1, <Block_size> and <Hblock_size> define
5406! the sizes of the data block and header data block. These blocks will
5408! be allocated for the user by the downloader (FNIcode_dld).
5410! If <block_id> > 0 then mode 2 is used. In mode 2, the user has already
5412! allocated the block and is just telling the downloader what the
5414! block id is. In mode 2, <Block_size> and <Hblock_size> must also
5416! contain the size of the data block and header block. In either
5418! case, the function result will be the block id of block specified.
5420! If an error occurs during the execution of this function, then an
5422! error message is displayed, and a -1 is returned as the function
5424! result. Note that this function should be used after the program is
5426! is assembled and before the program is downloaded.
5428!
5430 DIM Line$[40],Error_string$[40]
5432 INTEGER Found_match
5434 IF LEN(Block_name$)>16 THEN
5436 Icode_exec_err("Icode_def_ext: Block_name$ parameter string too long")
5438 RETURN -1
5440 END IF
5442 IF Block_size<0 THEN
5444 Icode_exec_err("Icode_def_ext: Invalid Block_size parameter")
5446 RETURN -1
5448 END IF
5450 IF Hblock_size<0 THEN
5452 Icode_exec_err("Icode_def_ext: Invalid header block size parameter")
5454 RETURN -1
5456 END IF
5458 IF Block_id<0 THEN
5460 Icode_exec_err("Icode_def_ext: Invalid Block_id parameter")
5462 RETURN -1
5464 END IF
5466 IF FNIcode_info_ok(Info$(*),Error_string$) THEN
5468 Block_name$=UPC$(TRIM$(Block_name$))
5470 Info_pos=VAL(Info$(1)[1,5])
5472 Info_max=Info_pos+VAL(Info$(1)[6,10])
5474 Found_match=0
5476 WHILE Info_pos<Info_max AND NOT Found_match
5478 IF Block_name$=TRIM$(Info$(Info_pos)[1,16]) THEN
5480 Found_match=1
5482 IF Block_id=0 THEN
5484 IF Use_main_ram THEN
5486 Temp$=FNHw_cmd_rsp$("NEW "&VAL$(Block_size)&","&VAL$(Hblock_size)&";NEW?",3)
5488 ELSE
5490 Temp$=FNHw_cmd_rsp$("SNEW "&VAL$(Block_size)&","&VAL$(Hblock_size)&";NEW?",3)
5492 END IF ! Use_main_ram
5494 IF FNHw_io_error THEN
5496 Icode_exec_err("Icode_def_ext: I/O error on block allocation")
5498 RETURN -1
5500 ELSE
5502 Block_id=VAL(Temp$)
5504 IF Block_id=-1 THEN
5506 Icode_exec_err("Icode_def_ext: HP-IB module won't allocate block")
5508 RETURN -1
5510 END IF
5512 Line$=Info$(Info_pos)
5514 IF Use_main_ram THEN
5516 Line$[17;1]="3"
5518 ELSE
5520 Line$[17;1]="4"
5522 END IF
5524 IF Line$[17;1]="1" OR Line$[17;1]="2" THEN
5526 Icode_exec_err("Icode_def_ext: Can't redefine auto allocate blocks")
5528 RETURN -1
5530 END IF
5532 END IF
5534 ELSE
5536 Line$=Info$(Info_pos)
5538 IF Line$[17;1]="1" OR Line$[17;1]="2" THEN
5540 Icode_exec_err("Icode_def_ext: Can't redefine auto allocate blocks")
5542 RETURN -1
5544 ELSE
5546 IF Use_main_ram THEN
5548 Line$[17;1]="3"
5550 ELSE
5552 Line$[17;1]="4"
5554 END IF
5556 END IF
5558 END IF ! IF Block_id<=0
5560 Line$[23,28]=VAL$(Block_size)
5562 Line$[29,34]=VAL$(Hblock_size)
5564 Line$[35,39]=VAL$(Block_id)
5566 Info$(Info_pos)=Line$
5568 END IF
5570 Info_pos=Info_pos+1
5572 END WHILE
5574 IF NOT Found_match THEN
5576 Icode_exec_err("Icode_def_ext: Undefined Block_name - '"&Block_name$&"'")
5578 RETURN -1
5580 END IF
5582 ELSE
5584 Icode_exec_err("Icode_def_ext: "&Error_string$)
5586 RETURN -1
5588 END IF
5590 RETURN Block_id
5592 FNEND ! Icode_def_ext
5594 !
5596 Icode_debug:SUB Icode_debug(INTEGER Debug_mode,Info$(*),OPTIONAL Source$(*))
5598!
5600! This subprogram is used to HELP debug an ICODE program. With this
5602! debugger the user can trace program execution, examine data blocks,
5604! set break points, single step, examine source code, and activate the
5606! command interpreter in the DIAG file. <Debug_mode> is an input
5608! parameter that determines when and if the debugger should enter an
5610! interactive debug mode. If <Debug_mode> = 0 then the debugger will
5612! enter interactive debug mode if the ICODE program is not running or
5614! is paused. Otherwise, the debugger will exit. If <Debug_mode> = 1,
5616! then the debugger will wait until the ICODE program is not running
5618! or is paused, then it will enter an interactive debug mode. If
5620! <Debug_mode> = 2 then the debugger will immediately enter an interactive
5622! debug mode. Once in interactive mode, the debugger is exited through
5624! a soft key. <Info$> must be present. <Source$> is an optional
5626! parameter which, when present, must contain the original source code.
5628!
5630! NOTE: For information on format of Info$ array, see ICODE assembler
5632! Icode_fill_info routine.
5634!
5636!
5638! The best way to learn about the debugger is to use it. Notice I didn't
5640! say that its operation was obvious. The following are some special
5642! notes that are not obvious:
5644! + If the debugger can detect an error before talking with the
5646! hardware, then an error message is displayed and execution
5648! continues. If an error is detected by the hardware, then an
5650! error message is displayed, and the BASIC program paused. When
5652! continued, the BASIC program (debugger) will exit.
5654! + In source display mode, lines may be specified by line number or by
5656! label. Also, there are some pre-defined labels that refer to the
5658! first line ('START' or 'BEGIN') and the last line ('STOP' or 'END').
5660! + Only one break point may be set at one time.
5662! + Single stepping clears a previously set break point.
5664! + If a break point is set for line x, then the ICODE program will
5666! break just before line x is executed.
5668! + To specify a block, the name or block id may be used.
5670 !
5672 INTEGER Info_info,Prog_id,Obj_size
5674 INTEGER Null_flag,Error_flag,X_disp_count,Disp_cnt,Count
5676 INTEGER S_height,S_width,S_disp_height,Icode_inactive,Icode_paused
5678 REAL I
5680 DIM Error_string$[100]
5682 DIM Ver_str$[50],Mode_str$[80],Temp$[255],State_str$[20]
5684 INTEGER Temp_int,Int_temp
5686 REAL Temp_real,Real_temp
5688 !
5690 ! Initialize display line stuff
5692 !
5694 OUTPUT CRT
5696 Ver_str$="ICODE Dbgr. Ver 1.0 "
5698 DISP Ver_str$;" Initializing."
5700 !
5702 ! Deal with Debug_mode
5704 !
5706 SELECT Debug_mode
5708 CASE 0
5710 GOSUB Icode_state
5712 IF NOT Icode_inactive AND NOT Icode_paused THEN SUBEXIT
5714 GOSUB Icode_do_debug
5716 CASE 1
5718 GOSUB Icode_state
5720 IF NOT Icode_inactive AND NOT Icode_paused THEN DISP Ver_str$&" Waiting for ICODE to pause"
5722 GOSUB Icode_wait_paus
5724 GOSUB Icode_do_debug
5726 CASE 2
5728 GOSUB Icode_do_debug
5730 CASE ELSE
5732 Error_string$="Invalid Debug_mode value"
5734 GOTO Icode_dbg_err
5736 END SELECT
5737 GOTO Icode_dbg_exit ! clean up Info$(*) stuff and get out
5739 !
5740 ! This routine is used to wait until the ICODE program is paused or
5742 ! not running.
5744 !
5746 Icode_wait_paus:!
5748 INTEGER First_flag
5750 First_flag=1
5752 REPEAT
5754 IF NOT First_flag THEN WAIT .8 ! don't want HP-IB module spending
5756 First_flag=0 ! all its time responding to queries
5758 GOSUB Icode_state
5760 UNTIL Icode_inactive OR Icode_paused
5762 RETURN
5764 !
5766 ! Output: Icode_inactive and Icode_paused
5768 !
5770 ! This routine is used to get the current ICODE program state. If
5772 ! the ICODE program is currently not running, then Icode_inactive is
5774 ! set to 1, otherwise 0. If the ICODE program is currently paused,
5776 ! then Icode_paused is set to 1, otherwise 0. Note that the state
5778 ! of the ICODE program can change between the time this routine is
5780 ! called and the time the caller acts on the info returned by this
5782 ! routine.
5784 !
5786 Icode_state:!
5788 DIM Hpib_stat_str$[50]
5790 WAIT .2
5792 Temp$=FNHw_cmd_rsp$("STC?",5)
5794 IF FNHw_io_error THEN
5796 Error_string$="Hardware I/O timeout error"
5798 GOTO Icode_dbg_err
5800 END IF
5802 Hpib_stat_str$=FNHw_stat_2_str$(VAL(Temp$))
5804 Icode_inactive=POS(Hpib_stat_str$,"PRG")<>0
5806 Icode_paused=POS(Hpib_stat_str$,"UPP")<>0
5808 RETURN
5810 !
5812 ! This routine is used to exit the debugger
5814 !
5816 Icode_dbg_exit:!
5818 GOSUB Icode_put_ihist ! put history back in Info$(*)
5820 GOSUB Icode_put_ibkpt ! put break point info back in Info$(*)
5822 SUBEXIT
5824 !
5826 ! Output: State_str$
5828 !
5830 ! This routine is used to get a string that indicates the state of
5832 ! the ICODE program.
5834 !
5836 Icode_state_str:!
5838 GOSUB Icode_state
5840 IF Icode_paused THEN
5842 State_str$="ICODE paused."
5844 ELSE
5846 IF Icode_inactive THEN
5848 State_str$="ICODE inactive."
5850 ELSE
5852 State_str$="ICODE running."
5854 END IF
5856 END IF
5858 RETURN
5860 !
5862 ! ********************** Interactive Debug Loop ******************
5864 !
5866 ! This is the main interactive debug loop. It prompts the user to
5868 ! select which mode the user wishes to enter. The functions at
5870 ! this main level are as follows:
5872 ! 1 - Go into variable menu.
5874 ! 2 - Go into data block menu.
5876 ! 3 - Go into source code menu.
5878 ! 4 - Display ICODE execution history.
5880 ! 5 - Go into ICODE program control menu.
5882 ! 6 - Go into DIAG command interpreter.
5884 ! 7 - CONTinue ICODE program.
5886 ! 8 - Return from debugger
5888 !
5890 INTEGER Debug_loop_done
5892 !
5894 Icode_do_debug:!
5896 GOSUB Icode_dbg_init
5898 Debug_loop_done=0
5900 REPEAT
5902 ON KEY 0 LABEL "" GOSUB Icode_dbg_dmy
5904 ON KEY 1 LABEL FNUser_keylabel$("Vars") CALL User_key1isr
5906 ON KEY 2 LABEL FNUser_keylabel$("Blocks") CALL User_key2isr
5908 ON KEY 3 LABEL FNUser_keylabel$("Source") CALL User_key3isr
5910 ON KEY 4 LABEL FNUser_keylabel$("History") CALL User_key4isr
5912 ON KEY 5 LABEL FNUser_keylabel$("Prgm Cntrl") CALL User_key5isr
5914 ON KEY 6 LABEL FNUser_keylabel$("Cmnd Intrp") CALL User_key6isr
5916 ON KEY 7 LABEL FNUser_keylabel$("Cont") CALL User_key7isr
5918 ON KEY 8 LABEL FNUser_keylabel$("Exit") CALL User_key8isr
5920 ON KEY 9 LABEL "" GOSUB Icode_dbg_dmy
5922 REPEAT
5924 GOSUB Icode_state_str ! Get State_str$
5926 Mode_str$=Ver_str$&" "&State_str$&" MAIN menu. Enter softkey."
5928 DISP Mode_str$
5930 UNTIL FNUser_key_press
5932 SELECT FNUser_get_key
5934 CASE 1 ! Variable mode
5936 GOSUB Icode_vars
5938 CASE 2 ! Display block mode
5940 GOSUB Icode_blks
5942 CASE 3 ! Display source code mode
5944 GOSUB Icode_src
5946 CASE 4 ! Display ICODE execution history
5948 GOSUB Icode_hist
5950 CASE 5 ! ICODE program control mode
5952 GOSUB Icode_trc
5954 CASE 6
5956 Diag_comint ! Diagnostics Command Interpreter
5958 CASE 7
5960 GOSUB Icode_cont ! CONTinue ICODE program
5962 CASE 8
5964 Debug_loop_done=1 ! Exit debugger
5966 END SELECT
5968 UNTIL Debug_loop_done
5972 DISP
5974 RETURN
5976 !
5978 ! ********************** Variable mode *******************************
5980 !
5982 ! This section handles all variable functions. The user is prompted
5984 ! to select a variable function. The functions at this level are as
5986 ! follows:
5988 ! 1 - Display all variables. If the variables require more than
5990 ! one screen full, then go into full screen mode.
5992 ! 2 - Display some variables. User specifies start variable
5994 ! and count.
5996 ! 3 - Modify variable. User specifies variable name and new
5998 ! value.
6000 ! 4 - Undefined.
6002 ! 5 - Toggle variable display mode between decimal and hex.
6004 ! 6 - Undefined.
6006 ! 7 - Undefined.
6008 ! 8 - Return to main menu.
6010 !
6012 INTEGER Done_vars_loop,Disp_vars_hex
6014 INTEGER Var_disp_strt,Var_disp_cnt,Var_disp_last,Var_disp_ptr
6016 INTEGER Var_info_strt,Var_info_last,Var_info_cnt,Vars_allocated
6018 INTEGER Var_num,Var_ptr,Var_set_value
6020 INTEGER Int_hi,Int_lo
6022 REAL Var_val
6024 DIM Var_name$[20]
6026 !
6028 Icode_vars:!
6030 IF Var_info_cnt=0 THEN
6032 BEEP
6034 DISP " ***** No variables to operate on *****"
6036 WAIT 3
6038 ELSE
6040 Done_vars_loop=0
6042 REPEAT
6044 ON KEY 1 LABEL FNUser_keylabel$("Disp All") CALL User_key1isr
6046 ON KEY 2 LABEL FNUser_keylabel$("Disp Some") CALL User_key2isr
6048 ON KEY 3 LABEL FNUser_keylabel$("Modify") CALL User_key3isr
6050 ON KEY 4 LABEL FNUser_keylabel$("") CALL User_key4isr
6052 IF Disp_vars_hex THEN
6054 ON KEY 5 LABEL FNUser_keylabel$("Decimal") CALL User_key5isr
6056 ELSE
6058 ON KEY 5 LABEL FNUser_keylabel$("Hex") CALL User_key5isr
6060 END IF
6062 ON KEY 6 LABEL FNUser_keylabel$("") CALL User_key6isr
6064 ON KEY 7 LABEL FNUser_keylabel$("") CALL User_key7isr
6066 ON KEY 8 LABEL FNUser_keylabel$("Return") CALL User_key8isr
6068 REPEAT
6070 GOSUB Icode_state_str
6072 Mode_str$=Ver_str$&" "&State_str$&" VARIABLE menu."
6074 DISP Mode_str$&" Enter softkey."
6076 UNTIL FNUser_key_press
6078 SELECT FNUser_get_key
6080 CASE 1 ! disp all vars
6082 GOSUB Icode_all_vars
6084 CASE 2 ! disp some vars
6086 GOSUB Icode_some_vars
6088 CASE 3 ! modify var
6090 GOSUB Icode_mod_var
6092 CASE 4
6094 CASE 5 ! toggle variable display mode
6096 Disp_vars_hex=NOT Disp_vars_hex
6098 CASE 6,7
6100 CASE 8 ! Return to main menu
6102 Done_vars_loop=1
6104 END SELECT
6106 UNTIL Done_vars_loop
6108 END IF
6110 RETURN
6112 !
6114 ! This routine is used if the user only wants to display a small
6116 ! number of variables on the screen at once. This may be useful
6118 ! if the user wishes to look at two types of information on the
6120 ! same screen at once.
6122 !
6124 Icode_some_vars:!
6126 Mode_str$=Ver_str$&" VARIABLE disp mode."
6128 !
6130 CALL Icode_inpt_str(Mode_str$&" Enter start variable name:",Var_name$)
6132 IF Var_name$="" THEN RETURN
6134 !
6136 GOSUB Icode_scan_vars ! uses Var_name$, returns Var_ptr
6138 IF Var_ptr=0 THEN
6140 BEEP
6142 DISP "***** Undefined variable reference - '"&Var_name$&"' *****"
6144 WAIT 3
6146 RETURN
6148 END IF
6150 !
6152 CALL Icode_inpt_num(Mode_str$&" Enter # of variables to disp:",Var_disp_cnt,Null_flag,Error_flag)
6154 !
6156 IF Null_flag OR Error_flag THEN RETURN
6158 !
6160 IF Var_ptr+Var_disp_cnt>Var_info_strt+Var_info_cnt THEN
6162 BEEP
6164 DISP "***** variable display count too large *****"
6166 WAIT 3
6168 ELSE
6170 Var_disp_strt=Var_ptr
6172 Var_disp_stop=Var_disp_strt+Var_disp_cnt-1
6174 GOSUB Icode_disp_vars ! pass Var_disp_strt and Var_disp_stop
6176 END IF
6178 RETURN
6180 !
6182 ! This routine is used to modify a variable. The user must specify
6184 ! a variable name and its new value.
6186 !
6188 Icode_mod_var:!
6190 GOSUB Icode_state ! returns Icode_inactive & Icode_paused
6192 IF NOT Icode_inactive AND NOT Icode_paused THEN
6194 BEEP
6196 DISP "***** Can't modify variables while ICODE running *****"
6198 WAIT 3
6200 RETURN
6202 END IF
6204 !
6206 Mode_str$=Ver_str$&" VARIABLE modify mode."
6208 CALL Icode_inpt_str(Mode_str$&" Enter variable name:",Var_name$)
6210 !
6212 IF Var_name$="" THEN RETURN
6214 !
6216 GOSUB Icode_scan_vars ! returns Var_ptr from Var_name$
6218 IF Var_ptr=0 THEN
6220 BEEP
6222 DISP "***** Undefined variable reference - '"&Var_name$&"' *****"
6224 WAIT 3
6226 RETURN
6228 END IF
6230 !
6232 CALL Icode_inpt_num(Mode_str$&" Enter variable value:",Var_set_value,Null_flag,Error_flag)
6234 IF Error_flag THEN RETURN
6236 IF Null_flag THEN
6238 OUTPUT CRT
6240 OUTPUT CRT;"NO variables modified."
6242 ELSE
6244 GOSUB Icode_r_varvals ! read variables out of ICODE program
6246 !
6248 Var_num=VAL(Info$(Var_ptr)[17,21]) ! get variable number from Info$
6250 !
6252 OUTPUT CRT
6254 IF Disp_vars_hex THEN
6256 OUTPUT CRT;"$";DVAL$(Var_set_value,16);" ==> ";TRIM$(Var_name$)
6258 ELSE
6260 OUTPUT CRT;Var_set_value;" ==> ";TRIM$(Var_name$)
6262 END IF
6264 !
6266 CALL Lib_32_to_16((Var_set_value),Int_hi,Int_lo)
6268 Var_values(Var_num*2)=Int_hi
6270 Var_values(Var_num*2+1)=Int_lo
6272 !
6274 GOSUB Icode_w_varvals ! restore var values to ICODE program
6276 END IF
6278 RETURN
6280 !
6282 ! Input: Var_name$ Output: Var_ptr
6284 !
6286 ! This routine is used to search though Info$ and find where
6288 ! <Var_name$> is in Info$. Returned is a pointer into Info$
6290 !
6292 Icode_scan_vars:!
6294 Var_name$=UPC$(TRIM$(Var_name$))
6296 Var_ptr=Var_info_strt-1
6298 Var_info_last=Var_info_strt+Var_info_cnt-1
6300 LOOP
6302 Var_ptr=Var_ptr+1
6304 EXIT IF Var_ptr>Var_info_last
6306 EXIT IF Var_name$=TRIM$(Info$(Var_ptr)[1,16])
6308 END LOOP
6310 IF Var_ptr>Var_info_last THEN Var_ptr=0
6312 RETURN
6314 !
6316 ! This routine is used to display all variables. First it sees if
6318 ! all the variables will fit on one screen. If they will, then the
6320 ! display routine is called to display all the variables. If all
6322 ! variables will not fit on one screen, then a variable display
6324 ! screen mode is entered.
6326 !
6328 Icode_all_vars: ! Display all variables
6330 INTEGER Done_avars_loop
6332 X_disp_count=S_width DIV 30
6334 S_disp_height=S_height-11
6336 !
6338 ! Can we fit all variables on the screen at once?
6340 !
6342 IF X_disp_count*(S_disp_height)>=Var_info_cnt THEN
6344 Var_disp_strt=Var_info_strt ! Yes
6346 Var_disp_stop=Var_info_last
6348 GOSUB Icode_disp_vars
6350 ELSE ! No
6352 !
6354 ! This is the variable display full screen mode. From here the
6356 ! user can look at any portion of the variable table.
6358 !
6360 Done_avars_loop=0
6362 GOSUB Icode_win_vars
6364 REPEAT
6366 ON KEY 1 LABEL FNUser_keylabel$("Prev Page") CALL User_key1isr
6368 ON KEY 2 LABEL FNUser_keylabel$("Next Page") CALL User_key2isr
6370 ON KEY 3 LABEL FNUser_keylabel$("Prev Line") CALL User_key3isr
6372 ON KEY 4 LABEL FNUser_keylabel$("Next Line") CALL User_key4isr
6374 ON KEY 5 LABEL FNUser_keylabel$("Begin") CALL User_key5isr
6376 ON KEY 6 LABEL FNUser_keylabel$("End") CALL User_key6isr
6378 ON KEY 7 LABEL FNUser_keylabel$("") CALL User_key7isr
6380 ON KEY 8 LABEL FNUser_keylabel$("Return") CALL User_key8isr
6382 REPEAT
6384 GOSUB Icode_state_str
6386 Mode_str$=Ver_str$&" "&State_str$&" VARIABLE disp menu."
6388 DISP Mode_str$&" Enter softkey."
6390 UNTIL FNUser_key_press
6392 SELECT FNUser_get_key
6394 CASE 1
6396 Var_disp_strt=Var_disp_strt-((S_disp_height-5)*X_disp_count)
6398 GOSUB Icode_win_vars
6400 CASE 2
6402 Var_disp_strt=Var_disp_strt+((S_disp_height-5)*X_disp_count)
6404 GOSUB Icode_win_vars
6406 CASE 3
6408 Var_disp_strt=Var_disp_strt-(X_disp_count)
6410 GOSUB Icode_win_vars
6412 CASE 4
6414 Var_disp_strt=Var_disp_strt+(X_disp_count)
6416 GOSUB Icode_win_vars
6418 CASE 5
6420 Var_disp_strt=Var_info_strt
6422 GOSUB Icode_win_vars
6424 CASE 6
6426 Var_disp_strt=Var_info_last
6428 GOSUB Icode_win_vars
6430 CASE 7
6432 CASE 8 ! Return to main menu
6434 Done_avars_loop=1
6436 END SELECT
6438 UNTIL Done_avars_loop
6440 END IF
6442 RETURN
6444 !
6446 ! Input: Var_disp_strt
6448 !
6450 ! This routine is used to select a section of the variable table
6452 ! for display. From <Var_disp_strt> this routine will assign
6454 ! <Var_disp_strt> and <Var_disp_stop> so they point into Info$ to
6456 ! valid variable lines and so they get as many variables on the
6458 ! screen as possible. This routine also calls the display routine.
6460 !
6462 Icode_win_vars: ! Var_disp_strt is parameter
6464 Var_disp_strt=MAX(Var_info_strt,Var_disp_strt)
6466 Var_disp_strt=MIN(Var_info_last,Var_disp_strt)
6468 Var_disp_stop=MIN(Var_info_last,Var_disp_strt+(S_disp_height*X_disp_count)-1)
6470 IF Var_disp_stop=Var_info_last THEN Var_disp_strt=MAX(Var_info_strt,Var_disp_stop-(S_disp_height*X_disp_count)+1)
6472 User_clr_scr
6474 GOSUB Icode_disp_vars
6476 RETURN
6478 !
6480 ! Input: Var_disp_strt and Var_disp_stop
6482 !
6484 ! This routine is used to display a section of the variable table.
6486 !
6488 Icode_disp_vars:!
6490 IF Var_disp_stop>=Var_disp_strt THEN
6492 GOSUB Icode_r_varvals
6494 Var_disp_cnt=Var_disp_stop-Var_disp_strt+1
6496 OUTPUT CRT
6498 OUTPUT CRT;" >>>> Variable Listing. Listing";Var_disp_cnt;" out of";Var_info_cnt;" <<<<"
6500 X_disp_count=S_width DIV 30
6502 GOSUB Icode_r_varvals
6504 OUTPUT CRT;"|";
6506 Var_disp_ptr=Var_disp_strt
6508 IF Disp_vars_hex THEN
6510 FOR I=1 TO MIN(X_disp_count,Var_disp_cnt)
6512 OUTPUT CRT USING "#,16A,1X,1X,8A,1A";"Name","Value","|"
6514 NEXT I
6516 OUTPUT CRT
6518 OUTPUT CRT;"|";
6520 FOR I=1 TO MIN(X_disp_count,Var_disp_cnt)
6522 OUTPUT CRT USING "#,16A,1A,9A,1A";RPT$("-",16),"+",RPT$("-",9),"|"
6524 NEXT I
6526 ELSE
6528 FOR I=1 TO MIN(X_disp_count,Var_disp_cnt)
6530 OUTPUT CRT USING "#,16A,1X,11A,1A";"Name"," Value ","|"
6532 NEXT I
6534 OUTPUT CRT
6536 OUTPUT CRT;"|";
6538 FOR I=1 TO MIN(X_disp_count,Var_disp_cnt)
6540 OUTPUT CRT USING "#,16A,1A,11A,1A";RPT$("-",16),"+",RPT$("-",11),"|"
6542 NEXT I
6544 END IF
6546 OUTPUT CRT
6548 WHILE Var_disp_ptr<=Var_disp_stop
6550 OUTPUT CRT;"|";
6552 FOR I=1 TO X_disp_count
6554 IF Var_disp_ptr<=Var_disp_stop THEN
6556 Var_num=VAL(Info$(Var_disp_ptr)[17,21])
6558 Int_hi=Var_values(Var_num*2)
6560 Int_lo=Var_values(Var_num*2+1)
6562 CALL Lib_16_to_32(Int_hi,Int_lo,Var_val)
6564 IF Disp_vars_hex THEN
6566 OUTPUT CRT USING "#,16A,1X,1A,8A,1A";Info$(Var_disp_ptr)[1,16];"$";DVAL$(Var_val,16),"|"
6568 ELSE
6570 OUTPUT CRT USING "#,16A,1X,11D,1A";Info$(Var_disp_ptr)[1,16],Var_val,"|"
6572 END IF
6574 Var_disp_ptr=Var_disp_ptr+1
6576 END IF
6578 NEXT I
6580 OUTPUT CRT
6582 END WHILE
6584 END IF
6586 RETURN
6588 !
6590 ! This routine is used to read all variable values form the ICODE
6592 ! program.
6594 !
6596 Icode_r_varvals:!
6598 Hw_read_blk((Prog_id),Var_values(*),5)
6600 GOSUB Icode_hw_err_ck
6602 RETURN
6604 !
6606 ! This routine is used to restore all variable values to the ICODE
6608 ! program.
6610 !
6612 Icode_w_varvals:!
6614 Hw_write_blk((Prog_id),Var_values(*),5)
6616 GOSUB Icode_hw_err_ck
6618 RETURN
6620 !
6622 ! This routine is used to initialize the variable section of the
6624 ! debugger.
6626 !
6628 Icode_vars_init:!
6630 Disp_vars_hex=VAL(Info$(5)[11;1]) ! disp in hex or decimal
6632 !
6634 ! Get info on variable table in Info$(*)
6636 !
6638 Var_info_strt=VAL(Info$(4)[1,5])
6640 Var_info_cnt=VAL(Info$(4)[6,10])
6642 Var_info_last=Var_info_strt+Var_info_cnt-1
6644 !
6646 ! Need array to store variable in
6648 !
6650 Vars_allocated=VAL(Info$(0)[21,25])
6652 ALLOCATE INTEGER Var_values(0:(Vars_allocated*2)-1)
6654 !
6656 RETURN
6658 !
6660 ! *************************** Begin Blocks **********************
6662 !
6664 ! This section of the debugger enables the user to examine the
6666 ! list of data blocks, or the data blocks themselves.
6668 ! 1 - Display block.
6670 ! 2 - Display block names and block id's.
6672 ! 3 -
6674 ! 4 -
6676 ! 5 -
6678 ! 6 -
6680 ! 7 -
6682 ! 8 - Return to main menu.
6684 !
6686 INTEGER Done_blks_loop,Block_id,Disp_blks_form,Blk_ptr,Key_pressed
6688 INTEGER Blk_disp_strt,Blk_disp_cnt,Blk_disp_stop,Blk_infostrt,Blk_infolast
6690 INTEGER Blkext_infostrt,Blkext_infocnt,Blkext_infolast
6692 INTEGER Blkvar_infostrt,Blkvar_infocnt,Blkvar_infolast
6694 INTEGER Blkcon_infostrt,Blkcon_infocnt,Blkcon_infolast
6696 INTEGER Block_addr,Block_offset,Block_disp_cnt,Block_ptr,Not_a_num_flag
6698 DIM Block_name$[20]
6700 !
6702 Icode_blks:!
6704 Done_blks_loop=0
6706 REPEAT
6708 ON KEY 0 LABEL "" GOSUB Icode_dbg_dmy
6710 ON KEY 1 LABEL FNUser_keylabel$("Disp Block") CALL User_key1isr
6712 ON KEY 2 LABEL FNUser_keylabel$("Block Names") CALL User_key2isr
6714 ON KEY 3 LABEL FNUser_keylabel$("") CALL User_key3isr
6716 ON KEY 4 LABEL FNUser_keylabel$("Full Screen") CALL User_key4isr
6718 SELECT Disp_blks_form
6720 CASE 0 ! currently in decimal
6722 ON KEY 5 LABEL FNUser_keylabel$("Hex") CALL User_key5isr
6724 ON KEY 6 LABEL FNUser_keylabel$("Float") CALL User_key6isr
6726 CASE 1 ! currently in hex
6728 ON KEY 5 LABEL FNUser_keylabel$("Decimal") CALL User_key5isr
6730 ON KEY 6 LABEL FNUser_keylabel$("Float") CALL User_key6isr
6732 CASE 2 ! currently in floating point
6734 ON KEY 5 LABEL FNUser_keylabel$("Decimal") CALL User_key5isr
6736 ON KEY 6 LABEL FNUser_keylabel$("Hex") CALL User_key6isr
6738 END SELECT
6740 ON KEY 7 LABEL FNUser_keylabel$("") CALL User_key7isr
6742 ON KEY 8 LABEL FNUser_keylabel$("Return") CALL User_key8isr
6744 ON KEY 9 LABEL "" GOSUB Icode_dbg_dmy
6746 REPEAT
6748 GOSUB Icode_state_str
6750 Mode_str$=Ver_str$&" "&State_str$&" BLOCK menu."
6752 DISP Mode_str$;" Enter softkey."
6754 UNTIL FNUser_key_press
6756 SELECT FNUser_get_key
6758 CASE 1
6760 GOSUB Icode_disp_ublk ! display user specified block
6762 CASE 2
6764 Blk_disp_strt=Blkext_infostrt
6766 IF Blk_disp_strt=0 THEN Blk_disp_strt=Blkvar_infostrt
6768 IF Blk_disp_strt=0 THEN Blk_disp_strt=Blkcon_infostrt
6770 Blk_disp_cnt=Blkext_infocnt+Blkvar_infocnt+Blkcon_infocnt
6772 GOSUB Icode_list_blks
6774 CASE 3
6776 CASE 4
6778 GOSUB Icode_fs_blk
6780 CASE 5
6782 Key_pressed=5
6784 GOSUB Icode_blks_newf
6786 CASE 6
6788 Key_pressed=6
6790 GOSUB Icode_blks_newf
6792 CASE 7
6794 CASE 8
6796 Done_blks_loop=1
6798 END SELECT
6800 UNTIL Done_blks_loop
6802 RETURN
6804 !
6806 ! This routine is used to display a block. The user must specify
6808 ! a block name (or id), an offset into the block, and a count. Now,
6810 ! the section of the block specified by the user is displayed on the
6812 ! CRT There is no scrolling. This should be changed.
6814 !
6816 Icode_disp_ublk: ! display user specified block
6818 !
6820 ! Get block name
6822 !
6824 Mode_str$=Ver_str$&" "&State_str$&" Disp BLOCK menu."
6826 Icode_inpt_num(Mode_str$&" Enter disp block name:",Block_id,Null_flag,Error_flag,Block_name$)
6828 !
6830 ! If numerical value was entered, then it must have been a block id
6832 ! else it must have been a block name.
6834 !
6836 IF Block_name$="" THEN
6838 IF Null_flag OR Error_flag THEN RETURN !return on null entry
6840 IF Block_id<=0 OR Block_id>=32767 THEN
6842 BEEP
6844 DISP "***** Invalid block id entry *****"
6846 WAIT 3
6848 RETURN
6850 END IF
6852 Block_name$=VAL$(Block_id) ! need this for disp header.
6854 ELSE
6856 GOSUB Icode_blk_ptr ! returns Blk_ptr from Block_name$
6858 IF Blk_ptr=-1 THEN RETURN
6860 GOSUB Icode_blk_id ! returns Block_id from Blk_ptr
6862 END IF
6864 !
6866 ! Now get block offset
6868 !
6870 Icode_inpt_num(Mode_str$&" Enter disp block offset:",Block_offset,Null_flag,Error_flag)
6872 IF Block_offset<0 OR Block_offset>=32767 THEN
6874 BEEP
6876 DISP "***** Invalid Block_offset parameter *****"
6878 WAIT 3
6880 RETURN
6882 END IF
6884 !
6886 IF Null_flag OR Error_flag THEN RETURN
6888 !
6890 ! Now get block disp count
6892 !
6894 Icode_inpt_num(Mode_str$&" Enter disp count:",Block_disp_cnt,Null_flag,Error_flag)
6896 IF Null_flag OR Error_flag OR Block_disp_cnt=0 THEN RETURN
6898 IF Block_disp_cnt<0 OR Block_disp_cnt>32767 THEN
6900 BEEP
6902 DISP "***** Invalid Block_count parameter *****"
6904 WAIT 3
6906 RETURN
6908 END IF
6910 Block_size=Block_disp_cnt
6912 !
6914 ! 4 words per point if display form is floating point
6916 !
6918 IF Disp_blks_form=2 THEN Block_size=Block_size*4
6920 Block_size=Block_size+Block_offset
6922 IF Block_size>32767 THEN
6924 BEEP
6926 DISP "***** Too many words to read back from HP-IB module *****"
6928 WAIT 3
6930 RETURN
6932 END IF
6934 !
6936 ! Lets get the block from the hardware
6938 !
6940 ALLOCATE INTEGER Block(0:Block_size-1)
6942 DISP "Getting block ..."
6944 Hw_read_blk((Block_id),Block(*),5) ! get block from HP-IB module
6946 IF FNHw_io_error THEN
6948 BEEP
6950 DISP "***** Unable to read block from hardware *****"
6952 WAIT 3
6954 ELSE
6956 GOSUB Icode_disp_blk ! display block
6958 END IF
6960 !
6962 DEALLOCATE Block(*)
6964 RETURN
6966 !
6968 Icode_fs_blk:!
6970 !
6972 ! Get block name
6974 !
6976 Mode_str$=Ver_str$&" "&State_str$&" Disp BLOCK menu."
6978 Icode_inpt_num(Mode_str$&" Enter disp block name:",Block_id,Null_flag,Error_flag,Block_name$)
6980 !
6982 ! If numerical value was entered, then it must have been a block id
6984 ! else it must have been a block name.
6986 !
6988 IF Block_name$="" THEN
6990 IF Null_flag OR Error_flag THEN RETURN !return on null entry
6992 IF Block_id<=0 OR Block_id>=32767 THEN
6994 BEEP
6996 DISP "***** Invalid block id entry *****"
6998 WAIT 3
7000 RETURN
7002 END IF
7004 Block_name$=VAL$(Block_id) ! need this for disp header.
7006 ELSE
7008 GOSUB Icode_blk_ptr ! returns Blk_ptr from Block_name$
7010 IF Blk_ptr=-1 THEN RETURN
7012 GOSUB Icode_blk_id ! returns Block_id from Blk_ptr
7014 END IF
7016 !
7018 ! Now get block size
7020 !
7022 Icode_inpt_num(Mode_str$&" Enter block size:",Int_temp,Null_flag,Error_flag)
7024 IF Null_flag OR Error_flag OR Int_temp=0 THEN RETURN
7026 IF Int_temp<0 OR Int_temp>32767 THEN
7028 BEEP
7030 DISP "***** Invalid Block_size parameter *****"
7032 WAIT 3
7034 RETURN
7036 END IF
7038 Block_size=Int_temp
7040 !
7042 ! Lets get the block from the hardware
7044 !
7046 ALLOCATE INTEGER Block(0:Block_size-1)
7048 DISP "Getting block ..."
7050 Hw_read_blk((Block_id),Block(*),5) ! get block from HP-IB module
7052 IF FNHw_io_error THEN
7054 BEEP
7056 DISP "***** Unable to read block from hardware *****"
7058 WAIT 3
7060 ELSE
7062 INTEGER Done_blkfs_loop
7064 S_disp_height=S_height-11
7066 Block_offset=0
7068 GOSUB Icode_win_blk
7070 Done_blkfs_loop=0
7072 REPEAT
7074 ON KEY 0 LABEL "" GOSUB Icode_dbg_dmy
7076 ON KEY 1 LABEL FNUser_keylabel$("Prev Page") CALL User_key1isr
7078 ON KEY 2 LABEL FNUser_keylabel$("Next Page") CALL User_key2isr
7080 ON KEY 3 LABEL FNUser_keylabel$("Prev Line") CALL User_key3isr
7082 ON KEY 4 LABEL FNUser_keylabel$("Next Line") CALL User_key4isr
7084 ON KEY 5 LABEL FNUser_keylabel$("Offset") CALL User_key5isr
7086 ON KEY 6 LABEL FNUser_keylabel$(" ") CALL User_key6isr
7088 ON KEY 7 LABEL FNUser_keylabel$("") CALL User_key7isr
7090 ON KEY 8 LABEL FNUser_keylabel$("Return") CALL User_key8isr
7092 ON KEY 9 LABEL "" GOSUB Icode_dbg_dmy
7094 REPEAT
7096 GOSUB Icode_state_str
7098 Mode_str$=Ver_str$&" "&State_str$&" BLOCK disp mode."
7100 DISP Mode_str$;" Enter softkey."
7102 UNTIL FNUser_key_press
7104 SELECT FNUser_get_key
7106 CASE 1
7108 Block_offset=Block_offset-(Elmnts_per_line*Elmnt_size*(S_disp_height-5))
7110 GOSUB Icode_win_blk
7112 CASE 2
7114 Block_offset=Block_offset+(Elmnts_per_line*Elmnt_size*(S_disp_height-5))
7116 GOSUB Icode_win_blk
7118 CASE 3
7120 Block_offset=Block_offset-(Elmnts_per_line*Elmnt_size)
7122 GOSUB Icode_win_blk
7124 CASE 4
7126 Block_offset=Block_offset+(Elmnts_per_line*Elmnt_size)
7128 GOSUB Icode_win_blk
7130 CASE 5
7132 Icode_inpt_num(Mode_str$&" Enter new offset:",Int_temp,Null_flag,Error_flag)
7134 IF NOT Null_flag AND NOT Error_flag THEN
7136 Block_offset=Int_temp
7138 GOSUB Icode_win_blk
7140 END IF
7142 CASE 6
7144 CASE 7
7146 CASE 8
7148 Done_blkfs_loop=1
7150 END SELECT
7152 UNTIL Done_blkfs_loop
7154 END IF
7156 !
7158 DEALLOCATE Block(*)
7160 RETURN
7162 !
7164 Icode_win_blk:!
7166 INTEGER Elmnt_size,Elmnts_per_line
7168 IF Disp_blks_form<>2 THEN
7170 Elmnt_size=1
7172 Elmnts_per_line=8
7174 ELSE
7176 Elmnt_size=4
7178 IF (S_width-7) DIV 20>=4 THEN
7180 Elmnts_per_line=4
7182 ELSE
7184 Elmnts_per_line=2
7186 END IF
7188 END IF
7190 Block_offset=MAX(0,Block_offset)
7192 Block_offset=MIN(SIZE(Block,1)-Elmnt_size,Block_offset)
7194 Block_disp_cnt=SIZE(Block,1)-Block_offset DIV Elmnt_size
7196 Block_disp_cnt=MIN(Block_disp_cnt,S_disp_height*Elmnts_per_line)
7198 User_clr_scr
7200 GOSUB Icode_disp_blk
7202 RETURN
7204 !
7206 ! Input: Block(*),Block_offset and Block_disp_cnt
7208 !
7210 ! This routine is used to display the contents of <block> on the CRT.
7212 ! The block is displayed starting at <block_offset>. <Block_disp_cnt>
7214 ! points are written to the CRT. There is no scrolling. Blocks can be
7216 ! be displayed in decimal, hex or floating point formats.
7218 !
7220 Icode_disp_blk: ! display Block(*) starting at block_disp_strt
7222 Block_disp_ptr=Block_offset
7224 OUTPUT CRT
7226 SELECT Disp_blks_form
7228 CASE 0 ! Decimal
7230 OUTPUT CRT;" >>> Block: '";Block_name$;"' Display type: Decimal <<<<"
7232 OUTPUT CRT USING "#,7A";"|Offst|"
7234 FOR I=0 TO 7
7236 OUTPUT CRT USING "#,4X,1D,2X";I
7238 NEXT I
7240 OUTPUT CRT;"| Ascii"
7242 OUTPUT CRT;"|-----+";RPT$("-------",7);"-------+----------------"
7244 REPEAT
7246 OUTPUT CRT USING "#,1A, 5D,1A ";"|",Block_disp_ptr,"| "
7248 X_disp_count=MIN(Block_disp_cnt,8)
7250 FOR I=0 TO X_disp_count-1
7252 OUTPUT CRT USING "#,6D,1X";Block(Block_disp_ptr+I)
7254 NEXT I
7256 OUTPUT CRT;RPT$(" ",MAX(0,8-X_disp_count));
7258 OUTPUT CRT;" ";
7260 FOR I=0 TO X_disp_count-1
7262 OUTPUT CRT;FNIcode_asc_str$(Block(Block_disp_ptr+I));
7264 NEXT I
7266 OUTPUT CRT
7268 Block_disp_ptr=Block_disp_ptr+X_disp_count
7270 Block_disp_cnt=Block_disp_cnt-X_disp_count
7272 UNTIL Block_disp_cnt=0
7274 CASE 1 ! Hex
7276 OUTPUT CRT;" >>> Block: '";Block_name$;"' Display type: Hex <<<<"
7278 OUTPUT CRT USING "#,7A";"|Offst| "
7280 FOR I=0 TO 7
7282 OUTPUT CRT USING "#,2X,1D,3X";I
7284 NEXT I
7286 OUTPUT CRT;"| Ascii"
7288 OUTPUT CRT;"|-----+-";RPT$("------",7);"-----+------------------"
7290 REPEAT
7292 OUTPUT CRT USING "#,2A,4A,2A";"|$",IVAL$(Block_disp_ptr,16),"| "
7294 X_disp_count=MIN(Block_disp_cnt,8)
7296 FOR I=0 TO X_disp_count-1
7298 OUTPUT CRT USING "#,4A,2X";IVAL$(Block(Block_disp_ptr+I),16)
7300 NEXT I
7302 OUTPUT CRT;RPT$(" ",MAX(0,8-X_disp_count));
7304 OUTPUT CRT;" ";
7306 FOR I=0 TO X_disp_count-1
7308 OUTPUT CRT;FNIcode_asc_str$(Block(Block_disp_ptr+I));
7310 NEXT I
7312 OUTPUT CRT
7314 Block_disp_ptr=Block_disp_ptr+X_disp_count
7316 Block_disp_cnt=Block_disp_cnt-X_disp_count
7318 UNTIL Block_disp_cnt=0
7320 CASE 2 ! Floating Point
7322 OUTPUT CRT;" >>> Block: '";Block_name$;"' Display type: Floating point <<<<"
7324 OUTPUT CRT USING "#,7A";"|Offst|"
7326 X_disp_count=(S_width-7) DIV 20
7328 IF X_disp_count>=4 THEN
7330 X_disp_count=4
7332 ELSE
7334 X_disp_count=2
7336 END IF
7338 FOR I=0 TO X_disp_count-1
7340 OUTPUT CRT USING "#,9X,2D,9X";I
7342 NEXT I
7344 OUTPUT CRT;"|"
7346 OUTPUT CRT;"|-----+";RPT$("--------------------",X_disp_count);"|"
7348 REPEAT
7350 OUTPUT CRT USING "#,1A, 5D,1A ";"|",Block_disp_ptr,"| "
7352 X_disp_count=MIN(Block_disp_cnt,X_disp_count)
7354 FOR I=0 TO X_disp_count-1
7356 Lib_64_to_float(Block(Block_disp_ptr),Block(Block_disp_ptr+1),Block(Block_disp_ptr+2),Block(Block_disp_ptr+3),Real_temp,Not_a_num_flag)
7358 IF Not_a_num_flag THEN
7360 OUTPUT CRT;" Not a number ";
7362 ELSE
7364 OUTPUT CRT USING "#,MZ.DDDDDDDDDDDESZZZ,1X";Real_temp
7366 END IF
7368 Block_disp_ptr=Block_disp_ptr+4
7370 Block_disp_cnt=Block_disp_cnt-1
7372 NEXT I
7374 OUTPUT CRT
7376 UNTIL Block_disp_cnt=0
7378 END SELECT
7380 RETURN
7382 !
7384 ! Input: Key_pressed Output: Disp_blks_form
7386 !
7388 ! This routine is used to change the block display format.
7390 !
7392 Icode_blks_newf: ! new block display format
7394 SELECT Disp_blks_form
7396 CASE 0
7398 IF Key_pressed=5 THEN Disp_blks_form=1
7400 IF Key_pressed=6 THEN Disp_blks_form=2
7402 CASE 1
7404 IF Key_pressed=5 THEN Disp_blks_form=0
7406 IF Key_pressed=6 THEN Disp_blks_form=2
7408 CASE 2
7410 IF Key_pressed=5 THEN Disp_blks_form=0
7412 IF Key_pressed=6 THEN Disp_blks_form=1
7414 END SELECT
7416 RETURN
7418 !
7420 ! This routine is used to display the list of block names and their
7422 ! current id's on the CRT. There is no scrolling here either.
7424 !
7426 Icode_list_blks: ! Blk_disp_strt and Blk_disp_cnt are parameters
7428 IF Blk_disp_cnt<>0 THEN
7430 !
7432 GOSUB Icode_r_varvals ! read variable table. Need this because some
7434 ! block id's are in variables.
7436 X_disp_count=S_width DIV 24
7438 OUTPUT CRT
7440 OUTPUT CRT;"|";
7442 FOR I=1 TO X_disp_count
7444 OUTPUT CRT USING "#,16A,1X,5A,1A";"Block name"," Id ","|"
7446 NEXT I
7448 OUTPUT CRT
7450 OUTPUT CRT;"|";
7452 FOR I=1 TO X_disp_count
7454 OUTPUT CRT USING "#,16A,1A,5A,1A";RPT$("-",16),"+",RPT$("-",5),"|"
7456 NEXT I
7458 OUTPUT CRT
7460 Blk_ptr=Blk_disp_strt
7462 Blk_disp_stop=Blk_ptr+Blk_disp_cnt-1
7464 Count=0
7466 WHILE Blk_ptr<=Blk_disp_stop
7468 IF Count MOD X_disp_count=0 THEN OUTPUT CRT;"|";
7470 GOSUB Icode_blk_id ! get Block_id from blk_ptr
7472 OUTPUT CRT USING "#,16A,1X,5D,1A";Info$(Blk_ptr)[1,16],Block_id,"|"
7474 Blk_ptr=Blk_ptr+1
7476 Count=Count+1
7478 IF Count MOD X_disp_count=0 THEN OUTPUT CRT
7480 END WHILE
7482 OUTPUT CRT
7484 END IF
7486 RETURN
7488 !
7490 ! Input: Block_name$ Output: Block_ptr
7492 !
7494 ! This routine is used to search Info$ for the line that contains
7496 ! the information about <block_name$>. Returned is a pointer into
7498 ! Info$.
7500 !
7502 Icode_blk_ptr:!
7504 FOR Blk_ptr=Blk_infostrt TO Blk_infolast
7506 IF Block_name$=TRIM$(Info$(Blk_ptr)[1,16]) THEN RETURN
7508 NEXT Blk_ptr
7510 BEEP
7512 DISP "***** Undefined block name - '";Block_name$;"' *****"
7514 WAIT 3
7516 Blk_ptr=-1
7518 RETURN
7520 !
7522 ! Input: Blk_ptr Output: Block_id
7524 !
7526 ! This routine is used to get the current block id of the block
7528 ! pointed to by <Blk_ptr>. <Blk_ptr> points into Info$.
7530 !
7532 Icode_blk_id: ! Returns Block_id from Blk_ptr
7534 SELECT Blk_ptr
7536 CASE <=Blkext_infolast ! ext block
7538 Block_id=VAL(Info$(Blk_ptr)[35,39])
7540 CASE <=Blkvar_infolast ! var block
7542 GOSUB Icode_r_varvals
7544 Var_num=VAL(Info$(Blk_ptr)[17,21])
7546 Int_hi=Var_values(Var_num*2) ! this should be 0
7548 Int_lo=Var_values(Var_num*2+1)
7550 Block_id=Int_lo
7552 CASE <=Blkcon_infolast ! con block
7554 Block_id=VAL(Info$(Blk_ptr)[17,21])
7556 CASE ELSE
7558 BEEP
7560 DISP "***** Illegal block id - '";Block_id;"' *****"
7562 WAIT 3
7564 Block_id=-1
7566 END SELECT
7568 RETURN
7570 !
7572 ! This routine is used to initialize the block section of the debugger.
7574 !
7576 Icode_blks_init:!
7578 Disp_blks_form=VAL(Info$(5)[12;1])
7580 !
7582 Blk_infostrt=-1 ! points to beginning of the first block table
7584 Blk_infolast=-1 ! points to the end of the last block table
7586 !
7588 ! Pull out information about DEFBLK_SP/DEFBLK_MAIN/DEFBLK_EXT table
7590 ! from Info$
7592 !
7594 Blkext_infostrt=VAL(Info$(1)[1,5])
7596 Blkext_infocnt=VAL(Info$(1)[6,10])
7598 Blkext_infolast=Blkext_infostrt+Blkext_infocnt-1
7600 IF Blkext_infocnt<>0 THEN
7602 Blk_infostrt=Blkext_infostrt
7604 Blk_infolast=Blkext_infolast
7606 END IF
7608 !
7610 ! Pull out information about DEFBLK_VAR table from Info$
7612 !
7614 Blkvar_infostrt=VAL(Info$(2)[1,5])
7616 Blkvar_infocnt=VAL(Info$(2)[6,10])
7618 Blkvar_infolast=Blkvar_infostrt+Blkvar_infocnt-1
7620 IF Blkvar_infocnt<>0 THEN
7622 IF Blk_infostrt=-1 THEN Blk_infostrt=Blkvar_infostrt
7624 Blk_infolast=Blkvar_infolast
7626 END IF
7628 !
7630 ! Pull out information about DEFBLK_CON table from Info$
7632 !
7634 Blkcon_infostrt=VAL(Info$(3)[1,5])
7636 Blkcon_infocnt=VAL(Info$(3)[6,10])
7638 Blkcon_infolast=Blkcon_infostrt+Blkcon_infocnt-1
7640 IF Blkcon_infocnt<>0 THEN
7642 IF Blk_infostrt=-1 THEN Blk_infostrt=Blkcon_infostrt
7644 Blk_infolast=Blkcon_infolast
7646 END IF
7648 RETURN
7650 !
7652 ! **************************** SOURCE **************************
7654 !
7656 ! This routine is used to display source code. Obviously, the
7658 ! source code can not be displayed unless the optional parameter
7660 ! <Source$> was passed into the debugger. Most of the functions
7662 ! of the source section of the debugger can be used to display
7664 ! only a small section of the ICODE program. This may be useful
7666 ! if the user wishes to display two, or more, types of information
7668 ! on the CRT. The functions provided in the source menu are as
7670 ! follows:
7672 ! 1 - Display source. User specifies start line and stop line.
7674 ! 2 - Display source. User specifies start line and count.
7676 ! 3 - Display source. User specifies stop line and count.
7678 ! 4 - Display source. User specifies center line and count.
7680 ! 5 - Display label list. No scrolling.
7682 ! 6 - Enter full screen source display mode.
7684 ! 7 -
7686 ! 8 - Return to main menu.
7688 !
7690 INTEGER Done_src_loop,Src_present,Src_size
7692 INTEGER Lbl_infostrt,Lbl_infolast,Lbl_infocnt
7694 INTEGER Lbl_disp_ptr,Lbl_disp_strt,Lbl_disp_stop,Lbl_disp_cnt
7696 INTEGER Src_disp_strt,Src_disp_stop,Src_disp_cnt,Src_disp_cent
7698 INTEGER Lbl_ptr,Lbl_obj_addr,Lbl_src_addr
7700 INTEGER Src_addr,Obj_addr,Test_obj_addr,Test_src_addr
7702 INTEGER Info_inst_strt,Info_inst_cnt,Inst_cnt
7704 INTEGER F_pause,C_nop
7706 DIM Label_name$[20]
7708 !
7710 Icode_src:!
7712 IF Src_present THEN
7714 GOSUB Icode_do_src
7716 ELSE
7718 BEEP
7720 OUTPUT CRT
7722 OUTPUT CRT;"*** Source(*) code not passed to debugger ***"
7724 END IF
7726 RETURN
7728 !
7730 Icode_do_src:!
7732 Done_src_loop=0
7734 REPEAT
7736 ON KEY 0 LABEL "" GOSUB Icode_dbg_dmy
7738 ON KEY 1 LABEL FNUser_keylabel$("Line to Line") CALL User_key1isr
7740 ON KEY 2 LABEL FNUser_keylabel$("After Line") CALL User_key2isr
7742 ON KEY 3 LABEL FNUser_keylabel$("Before Line") CALL User_key3isr
7744 ON KEY 4 LABEL FNUser_keylabel$("About Line") CALL User_key4isr
7746 ON KEY 5 LABEL FNUser_keylabel$("List Labels") CALL User_key5isr
7748 ON KEY 6 LABEL FNUser_keylabel$("Full Screen") CALL User_key6isr
7750 ON KEY 7 LABEL FNUser_keylabel$("") CALL User_key7isr
7752 ON KEY 8 LABEL FNUser_keylabel$("Return") CALL User_key8isr
7754 ON KEY 9 LABEL "" GOSUB Icode_dbg_dmy
7756 REPEAT
7758 GOSUB Icode_state_str
7760 Mode_str$=Ver_str$&" "&State_str$&" SCREEN disp mode."
7762 DISP Mode_str$;" Enter softkey."
7764 UNTIL FNUser_key_press
7766 SELECT FNUser_get_key
7768 CASE 1 ! point to point
7770 GOSUB Icode_src_ltol
7772 CASE 2 ! after line
7774 GOSUB Icode_src_aftr
7776 CASE 3 ! before line
7778 GOSUB Icode_src_bef
7780 CASE 4 ! about line
7782 GOSUB Icode_src_abt
7784 CASE 5 ! List line
7786 Lbl_disp_strt=Lbl_infostrt
7788 Lbl_disp_stop=Lbl_disp_strt+Lbl_infocnt-1
7790 GOSUB Icode_disp_lbls
7792 CASE 6
7794 GOSUB Icode_src_fs
7796 CASE 7
7798 CASE 8
7800 Done_src_loop=1
7802 END SELECT
7804 UNTIL Done_src_loop
7806 RETURN
7808 !
7810 ! This routine is used to handle full screen source display mode.
7812 ! From here the user can scroll through their source code.
7814 !
7816 Icode_src_fs:!
7818 INTEGER Done_fs_loop,Fs_disp_strt
7820 S_disp_height=S_height-9
7822 GOSUB Icode_disp_fs
7824 Done_fs_loop=0
7826 REPEAT
7828 ON KEY 0 LABEL "" GOSUB Icode_dbg_dmy
7830 ON KEY 1 LABEL FNUser_keylabel$("Prev Page") CALL User_key1isr
7832 ON KEY 2 LABEL FNUser_keylabel$("Next Page") CALL User_key2isr
7834 ON KEY 3 LABEL FNUser_keylabel$("Prev Line") CALL User_key3isr
7836 ON KEY 4 LABEL FNUser_keylabel$("Next Line") CALL User_key4isr
7838 ON KEY 5 LABEL FNUser_keylabel$("Begin") CALL User_key5isr
7840 ON KEY 6 LABEL FNUser_keylabel$("End") CALL User_key6isr
7842 ON KEY 7 LABEL FNUser_keylabel$("") CALL User_key7isr
7844 ON KEY 8 LABEL FNUser_keylabel$("Return") CALL User_key8isr
7846 ON KEY 9 LABEL "" GOSUB Icode_dbg_dmy
7848 REPEAT
7850 GOSUB Icode_state_str
7852 Mode_str$=Ver_str$&" "&State_str$&" SOURCE disp mode."
7854 DISP Mode_str$;" Enter softkey."
7856 UNTIL FNUser_key_press
7858 SELECT FNUser_get_key
7860 CASE 1
7862 Src_disp_strt=Src_disp_strt-(S_disp_height-5)
7864 GOSUB Icode_disp_fs
7866 CASE 2
7868 Src_disp_strt=Src_disp_strt+(S_disp_height-5)
7870 GOSUB Icode_disp_fs
7872 CASE 3
7874 Src_disp_strt=Src_disp_strt-1
7876 GOSUB Icode_disp_fs
7878 CASE 4
7880 Src_disp_strt=Src_disp_strt+1
7882 GOSUB Icode_disp_fs
7884 CASE 5
7886 Src_disp_strt=0
7888 GOSUB Icode_disp_fs
7890 CASE 6
7892 Src_disp_strt=32767
7894 GOSUB Icode_disp_fs
7896 CASE 7
7898 CASE 8
7900 Done_fs_loop=1
7902 END SELECT
7904 UNTIL Done_fs_loop
7906 RETURN
7908 !
7910 ! Input: Src_disp_strt
7912 !
7914 ! This routine is used to display a screen of source code on the CRT.
7916 ! Given <src_disp_strt> this routine will map <src_disp_strt> and
7918 ! <src_disp_stop> into valid ranges. Also, making sure to use as
7920 ! much of the CRT as possible. Then the source display routine is
7922 ! called.
7924 !
7926 Icode_disp_fs:!
7928 Src_disp_strt=MAX(0,Src_disp_strt)
7930 Src_disp_strt=MIN(Src_size-1,Src_disp_strt)
7932 Src_disp_stop=MIN(Src_size-1,(Src_disp_strt+0.)+S_disp_height-1)
7934 IF Src_disp_stop=Src_size-1 THEN Src_disp_strt=MAX(0,Src_disp_stop-S_disp_height+1)
7936 User_clr_scr
7938 GOSUB Icode_disp_src
7940 RETURN
7942 !
7944 ! This routine is used to display source code with the user specifying
7946 ! a start line and a stop line.
7948 !
7950 Icode_src_ltol:!
7952 Icode_inpt_num(Mode_str$&" Enter start disp line:",Src_disp_strt,Null_flag,Error_flag,Label_name$)
7954 IF Label_name$<>"" THEN
7956 GOSUB Icode_lbl_srca ! returns Lbl_src_addr from Label_name$
7958 IF Label_name$="STOP" OR Label_name$="END" THEN
7960 GOSUB Icode_src_lerr
7962 Src_disp_strt=-1
7964 ELSE
7966 Src_disp_strt=Lbl_src_addr
7968 END IF
7970 ELSE
7972 IF Null_flag OR Error_flag THEN
7974 Src_disp_strt=-1
7976 ELSE
7978 IF Src_disp_strt<0 OR Src_disp_strt>Src_size-1 THEN
7980 GOSUB Icode_src_lerr
7982 Src_disp_strt=-1
7984 END IF
7986 END IF
7988 END IF
7990 IF Src_disp_strt<>-1 THEN
7992 Icode_inpt_num(Mode_str$&" Enter stop disp line:",Src_disp_stop,Null_flag,Error_flag,Label_name$)
7994 IF Label_name$<>"" THEN
7996 GOSUB Icode_lbl_srca ! returns Lbl_src_addr from Label_name$
7998 IF Label_name$="START" OR Label_name$="BEGIN" THEN
8000 GOSUB Icode_src_lerr
8002 Src_disp_stop=-1
8004 ELSE
8006 Src_disp_stop=Lbl_src_addr
8008 END IF
8010 ELSE
8012 IF Null_flag OR Error_flag THEN Src_disp_stop=-1
8014 END IF
8016 IF Src_disp_stop<>-1 THEN
8018 GOSUB Icode_disp_src
8020 END IF
8022 END IF
8024 RETURN
8026 !
8028 ! This routine is used to display source code with the user specifying
8030 ! a start line and a count.
8032 !
8034 Icode_src_aftr:!
8036 Icode_inpt_num(Mode_str$&" Enter start disp line:",Src_disp_strt,Null_flag,Error_flag,Label_name$)
8038 IF Label_name$<>"" THEN
8040 GOSUB Icode_lbl_srca ! returns Lbl_src_addr from Label_name$
8042 IF Label_name$="STOP" OR Label_name$="END" THEN
8044 GOSUB Icode_src_lerr
8046 Src_disp_strt=-1
8048 ELSE
8050 Src_disp_strt=Lbl_src_addr
8052 IF Src_disp_strt<0 OR Src_disp_strt>Src_size-1 THEN
8054 GOSUB Icode_src_lerr
8056 Src_disp_strt=-1
8058 END IF
8060 END IF
8062 ELSE
8064 IF Null_flag OR Error_flag THEN
8066 Src_disp_strt=-1
8068 ELSE
8070 IF Src_disp_strt<0 OR Src_disp_stop>Src_size-1 THEN
8072 GOSUB Icode_src_lerr
8074 Src_disp_strt=-1
8076 END IF
8078 END IF
8080 END IF
8082 IF Src_disp_strt>=0 THEN
8084 Icode_inpt_num(Mode_str$&" Enter # of disp lines:",Src_disp_cnt,Null_flag,Error_flag)
8086 IF NOT Null_flag AND NOT Error_flag THEN
8088 Src_disp_stop=Src_disp_strt+Src_disp_cnt-1
8090 GOSUB Icode_disp_src
8092 END IF
8094 END IF
8096 RETURN
8098 !
8100 ! This routine is used to display source code with the user specifying
8102 ! the last line and a count.
8104 !
8106 Icode_src_bef:!
8108 Icode_inpt_num(Mode_str$&" Enter last disp line:",Src_disp_stop,Null_flag,Error_flag,Label_name$)
8110 IF Label_name$<>"" THEN
8112 GOSUB Icode_lbl_srca ! returns Lbl_src_addr from Label_name$
8114 IF Label_name$="BEGIN" OR Label_name$="START" THEN
8116 GOSUB Icode_src_lerr
8118 Src_disp_stop=-1
8120 ELSE
8122 Src_disp_stop=Lbl_src_addr
8124 IF Src_disp_stop<0 OR Src_disp_stop>Src_size-1 THEN
8126 GOSUB Icode_src_lerr
8128 Src_disp_strt=-1
8130 END IF
8132 END IF
8134 ELSE
8136 IF Null_flag OR Error_flag THEN
8138 Src_disp_stop=-1
8140 ELSE
8142 IF Src_disp_stop<0 OR Src_disp_stop>Src_size-1 THEN
8144 GOSUB Icode_src_lerr
8146 Src_disp_stop=-1
8148 END IF
8150 END IF
8152 END IF
8154 IF Src_disp_stop<>-1 THEN
8156 Icode_inpt_num(Mode_str$&" Enter # of disp lines:",Src_disp_cnt,Null_flag,Error_flag)
8158 IF NOT Null_flag AND NOT Error_flag THEN
8160 Src_disp_strt=Src_disp_stop-Src_disp_cnt+1
8162 GOSUB Icode_disp_src
8164 END IF
8166 END IF
8168 RETURN
8170 !
8172 ! This routine is used to display source code with the user specifying
8174 ! a center line and a count.
8176 !
8178 Icode_src_abt:!
8180 Icode_inpt_num(Mode_str$&" Enter center disp line:",Src_disp_cent,Null_flag,Error_flag,Label_name$)
8182 IF Label_name$<>"" THEN
8184 GOSUB Icode_lbl_srca ! returns Lbl_src_addr from Label_name$
8186 IF Label_name$="BEGIN" OR Label_name$="START" THEN
8188 GOSUB Icode_src_lerr
8190 Src_disp_cent=-1
8192 ELSE
8194 Src_disp_cent=Lbl_src_addr
8196 END IF
8198 ELSE
8200 IF Null_flag OR Error_flag THEN
8202 Src_disp_cent=-1
8204 END IF
8206 END IF
8208 IF Src_disp_cent<>-1 THEN
8210 Icode_inpt_num(Mode_str$&" Enter # of disp lines:",Src_disp_cnt,Null_flag,Error_flag)
8212 IF NOT Null_flag AND NOT Error_flag THEN
8214 Src_disp_strt=Src_disp_cent-Src_disp_cnt DIV 2
8216 Src_disp_stop=Src_disp_cent+Src_disp_cnt DIV 2
8218 GOSUB Icode_disp_src
8220 END IF
8222 END IF
8224 RETURN
8226 !
8228 ! Input: Lbl_disp_strt and Lbl_disp_stop
8230 !
8232 ! This routine is used to display a section of the label table.
8234 ! Currently, only the entire label table is displayed.
8236 !
8238 Icode_disp_lbls:!
8240 OUTPUT CRT
8242 Lbl_disp_cnt=Lbl_disp_stop-Lbl_disp_strt+1
8244 OUTPUT CRT;">>>> Label Listing. ";Lbl_disp_cnt;" label(s) present. <<<<"
8246 IF Lbl_disp_cnt>0 THEN
8248 X_disp_count=MIN(S_width DIV 25,Lbl_disp_cnt)
8250 OUTPUT CRT;"|";
8252 FOR I=1 TO X_disp_count
8254 OUTPUT CRT USING "#,16A,1X,5A,1A";"Label Name","Offst","|"
8256 NEXT I
8258 OUTPUT CRT
8260 OUTPUT CRT;"|";
8262 FOR I=1 TO X_disp_count
8264 OUTPUT CRT USING "#,16A,1A,5A,1A";RPT$("-",16),"+",RPT$("-",5),"|"
8266 NEXT I
8268 OUTPUT CRT
8270 Lbl_disp_ptr=Lbl_disp_strt
8272 Disp_cnt=0
8274 REPEAT
8276 IF Disp_cnt MOD X_disp_count=0 THEN OUTPUT CRT;"|";
8278 OUTPUT CRT USING "#,16A,1X,1A,4A,1A";Info$(Lbl_disp_ptr)[1,16],"$",IVAL$(VAL(Info$(Lbl_disp_ptr)[17,21]),16),"|"
8280 Disp_cnt=Disp_cnt+1
8282 IF Disp_cnt MOD X_disp_count=0 THEN OUTPUT CRT
8284 Lbl_disp_ptr=Lbl_disp_ptr+1
8286 UNTIL Lbl_disp_ptr>Lbl_disp_stop
8288 IF Disp_cnt MOD X_disp_count<>0 THEN OUTPUT CRT
8290 END IF
8292 RETURN
8294 !
8296 ! Input: Src_disp_strt and Src_disp_stop
8298 !
8300 ! This routine is used to display a section of the source code to the
8302 ! CRT.
8304 !
8306 Icode_disp_src: ! Src_disp_strt and Src_disp_stop are parameters
8308 Src_disp_strt=MAX(0,Src_disp_strt)
8310 Src_disp_stop=MIN(Src_size-1,Src_disp_stop)
8312 OUTPUT CRT
8314 OUTPUT CRT;">>>> Source Listing. Lines ";Src_disp_strt;" through ";Src_disp_stop;". <<<<"
8316 FOR I=Src_disp_strt TO Src_disp_stop
8318 OUTPUT CRT USING "5D,1X,K";I,Source$(I)
8320 NEXT I
8322 RETURN
8324 !
8326 ! Input: Label_name$ Output: Lbl_src_addr
8328 !
8330 ! This routine is used to translate a label name into the corresponding
8332 ! source code address.
8334 !
8336 Icode_lbl_srca:!
8338 GOSUB Icode_lbl_ptr
8340 Lbl_src_addr=-1
8342 IF Lbl_ptr=-1 THEN
8344 IF Label_name$="BEGIN" OR Label_name$="START" THEN Lbl_src_addr=0
8346 IF Label_name$="END" OR Label_name$="STOP" THEN Lbl_src_addr=Src_size-1
8348 IF Lbl_src_addr=-1 THEN
8350 BEEP
8352 DISP "***** Undefined label reference - '";Label_name$;"' *****"
8354 WAIT 3
8356 END IF
8358 ELSE
8360 Lbl_src_addr=VAL(Info$(Lbl_ptr)[22,26])
8362 END IF
8364 RETURN
8366 !
8368 ! Input: Label_name$ Output: Lbl_obj_addr
8370 !
8372 ! This routine is used to translate a label_name into the corresponding
8374 ! object code address.
8376 !
8378 Icode_lbl_obja:!
8380 GOSUB Icode_lbl_ptr
8382 IF Lbl_ptr=-1 THEN
8384 IF Label_name$="BEGIN" OR Label_name$="START" THEN Lbl_obj_addr=0
8386 IF Label_name$="END" OR Label_name$="STOP" THEN Lbl_obj_addr=Obj_size-1
8388 Lbl_obj_addr=-1
8390 ELSE
8392 Lbl_obj_addr=VAL(Info$(Lbl_ptr)[17,21])
8394 END IF
8396 RETURN
8398 !
8400 ! Input: Label_name$ Output: Lbl_ptr
8402 !
8404 ! This routine is used to translate a label name into a pointer into
8406 ! Info$ for the corresponding label.
8408 !
8410 Icode_lbl_ptr: ! Returns Lbl_ptr from Label_name$
8412 IF Lbl_infocnt<>0 THEN
8414 FOR Lbl_ptr=Lbl_infostrt TO Lbl_infolast
8416 IF Label_name$=TRIM$(Info$(Lbl_ptr)[1,16]) THEN RETURN
8418 NEXT Lbl_ptr
8420 END IF
8422 Lbl_ptr=-1
8424 RETURN
8426 !
8428 ! No comment
8430 !
8432 Icode_src_lerr:!
8434 BEEP
8436 DISP "***** Invalid Source$(*) line parameter *****"
8438 WAIT 3
8440 RETURN
8442 !
8444 ! Input: Src_addr Output: Obj_addr
8446 !
8448 ! This routine is used to translate an object address into the
8450 ! corresponding source code address.
8452 !
8454 Icode_src_2_obj:!
8456 Info_ptr=Info_inst_strt
8458 FOR Inst_ptr=0 TO Inst_cnt-1
8460 IF Inst_ptr MOD 10=0 THEN
8462 Temp$=Info$(Info_ptr)
8464 Info_ptr=Info_ptr+1
8466 END IF
8468 ENTER Temp$ USING "#,W,W";Obj_addr,Test_src_addr
8470 IF Test_src_addr=Src_addr THEN RETURN
8472 Temp$=Temp$[5]
8474 NEXT Inst_ptr
8476 Obj_addr=-1
8478 RETURN
8480 !
8482 ! Input: Src_addr Output: Obj_addr
8484 !
8486 ! This routine is used to translate a source code address into an
8488 ! object code address.
8490 !
8492 Icode_obj_2_src:!
8494 Info_ptr=Info_inst_strt
8496 FOR Inst_ptr=0 TO Inst_cnt-1
8498 IF Inst_ptr MOD 10=0 THEN
8500 Temp$=Info$(Info_ptr)
8502 Info_ptr=Info_ptr+1
8504 END IF
8506 ENTER Temp$ USING "#,W,W";Test_obj_addr,Src_addr
8508 IF Test_obj_addr=Obj_addr THEN RETURN
8510 Temp$=Temp$[5]
8512 NEXT Inst_ptr
8514 Src_addr=-1
8516 RETURN
8518 !
8520 ! This routine is used to initialize the source code section of the
8522 ! debugger.
8524 !
8526 Icode_src_init:!
8528 Fs_disp_ptr=-1
8530 !
8532 Lbl_infostrt=VAL(Info$(5)[1,5])
8534 Lbl_infocnt=VAL(Info$(5)[6,10])
8536 Lbl_infolast=Lbl_infostrt+Lbl_infocnt-1
8538 !
8540 ! Get pointers into Info$ where the instruction table is. The
8542 ! instruction table has an entry for each instruction. Each entry
8544 ! has info about source code address and object code address.
8546 !
8548 Info_inst_strt=VAL(Info$(2)[11,15]) ! get source code info
8550 Inst_cnt=VAL(Info$(2)[16,20]) ! from Info$
8552 Info_inst_cnt=Inst_cnt DIV 10
8554 !
8556 Src_size=VAL(Info$(1)[16,20])
8558 !
8560 Src_present=0
8562 IF NPAR=3 THEN
8564 Src_present=1
8566 IF SIZE(Source$,1)<>Src_size THEN
8568 Error_string$="Info$(*) format error. Invaid SIZE(Source$(*))."
8570 GOSUB Icode_dbg_err
8572 END IF
8574 END IF
8576 RETURN
8578 !
8580 ! *********************** HISTORY *****************************
8582 !
8584 ! This section of the debugger will display the ICODE history on
8586 ! the CRT.
8588 !
8590 INTEGER Hist_fifo_ptr,Hist_fifo_wrap,Info_hist_strt,Hist_str_ptr
8592 INTEGER Hist_addr(0:19),Hist_opcode(0:19)
8594 INTEGER Hist_disp_ptr,Hist_disp_cnt
8596 !
8598 Icode_hist: !
8600 GOSUB Icode_updt_hist ! update history
8602 GOSUB Icode_disp_hist ! display history
8604 RETURN
8606 !
8608 Icode_rst_hist: ! initialize history queue to null
8610 Hist_fifo_ptr=-1
8612 Hist_fifo_wrap=0
8614 RETURN
8616 !
8618 ! This subroutine is used to retrieve a stored history queue form the
8620 ! Info$(*) array.
8622 !
8624 Icode_get_ihist:!
8626 Info_hist_strt=VAL(Info$(3)[11,15])
8628 !
8630 Hist_fifo_ptr=VAL(Info$(Info_hist_strt)[1,5])
8632 Hist_fifo_wrap=VAL(Info$(Info_hist_strt)[6,10])
8634 Temp$=Info$(Info_hist_strt+1)
8636 FOR I=0 TO 19
8638 ENTER Temp$ USING "#,W";Hist_addr(I)
8640 Temp$=Temp$[3]
8642 NEXT I
8644 Temp$=Info$(Info_hist_strt+2)
8646 FOR I=0 TO 19
8648 ENTER Temp$ USING "#,W";Hist_opcode(I)
8650 Temp$=Temp$[3]
8652 NEXT I
8654 RETURN
8656 !
8658 ! This subroutine is used to put the debugger's internal ICODE history
8660 ! queue in Info$. This enables the user to exit the debugger, then
8662 ! re-enter the debugger and still have an accurate history queue.
8664 !
8666 Icode_put_ihist: ! put history queue in Info$(*)
8668 Info$(Info_hist_strt)[1,5]=VAL$(Hist_fifo_ptr)
8670 Info$(Info_hist_strt)[6,10]=VAL$(Hist_fifo_wrap)
8672 Info$(Info_hist_strt+1)=""
8674 FOR I=0 TO 19
8676 OUTPUT Temp$ USING "#,W";Hist_addr(I)
8678 Info$(Info_hist_strt+1)=Info$(Info_hist_strt+1)&Temp$
8680 NEXT I
8682 Info$(Info_hist_strt+2)=""
8684 FOR I=0 TO 19
8686 OUTPUT Temp$ USING "#,W";Hist_opcode(I)
8688 Info$(Info_hist_strt+2)=Info$(Info_hist_strt+2)&Temp$
8690 NEXT I
8692 RETURN
8694 !
8696 ! This subroutine is used to update the history queue internal to
8698 ! the debugger from the HP-IB module using the IHQ? command.
8700 !
8702 Icode_updt_hist:!
8704 Temp$=TRIM$(FNHw_cmd_rsp$("ihq?",3))
8706 GOSUB Icode_hw_err_ck
8708 WHILE Temp$<>""
8710 Hist_fifo_ptr=Hist_fifo_ptr+1
8712 IF Hist_fifo_ptr=20 THEN
8714 Hist_fifo_ptr=0
8716 Hist_fifo_wrap=1
8718 END IF
8720 Hist_addr(Hist_fifo_ptr)=VAL(Temp$)
8722 Temp$=Temp$[POS(Temp$,",")+1]
8724 Hist_opcode(Hist_fifo_ptr)=VAL(Temp$)
8726 Hist_str_ptr=POS(Temp$,",")
8728 IF Hist_str_ptr=0 THEN Hist_str_ptr=LEN(Temp$)
8730 Temp$=Temp$[Hist_str_ptr+1]
8732 END WHILE
8734 RETURN
8736 !
8738 ! This subroutine is used to display the history queue.
8740 !
8742 Icode_disp_hist: ! disp history queue
8744 IF Hist_fifo_ptr=-1 THEN
8746 OUTPUT CRT
8748 OUTPUT CRT;">>>> NO history <<<<"
8750 ELSE
8752 IF Hist_fifo_wrap THEN
8754 Hist_disp_ptr=Hist_fifo_ptr+1
8755 IF Hist_disp_ptr=20 THEN Hist_disp_ptr=0
8757 Hist_disp_cnt=20
8758 ELSE
8760 Hist_disp_ptr=0
8762 Hist_disp_cnt=Hist_fifo_ptr+1
8764 END IF
8766 IF 0 THEN
8768 Int_temp=Hist_disp_cnt-S_height-9
8770 IF Int_temp>0 THEN
8772 Hist_disp_ptr=(Hist_disp_ptr+Int_temp) MOD 20
8774 Hist_disp_cnt=Hist_disp_cnt-Int_temp
8776 END IF
8778 END IF
8780 OUTPUT CRT
8782 OUTPUT CRT USING "1A,4A,1A,5A,1A,K";"|"," OBJ","|"," SRCE","|"," SOURCE LINE"
8784 OUTPUT CRT USING "5A,1A,5A,1A,68A";"-----","+","-----","+",RPT$("-",68)
8786 REPEAT
8788 Obj_addr=Hist_addr(Hist_disp_ptr)
8790 IF Obj_addr=0 THEN ! Is it the assembler inserted c_goto
8792 ! around the variable table?
8794 OUTPUT CRT USING "1A,4A,1X,5X,1X,K";"$",IVAL$(Hist_addr(Hist_disp_ptr),16),RPT$(" ",15)&"<c_goto>"
8796 ELSE
8798 GOSUB Icode_obj_2_src ! returns Src_addr from Obj_addr
8800 IF Src_addr>0 THEN ! Is it assembler inserted inst
8802 ! used for break points?
8804 ! Must be a regular old instruction
8806 IF Src_present THEN
8808 OUTPUT CRT USING "1A,4A,1X,5D,1X,K";"$",IVAL$(Hist_addr(Hist_disp_ptr),16),Src_addr,Source$(Src_addr)
8810 ELSE
8812 OUTPUT CRT USING "1A,4A,1X,5X,1X,6D";"$",IVAL$(Hist_addr(Hist_disp_ptr),16),Hist_opcode(Hist_disp_ptr)
8814 END IF
8816 END IF
8818 END IF
8820 Hist_disp_ptr=Hist_disp_ptr+1
8822 IF Hist_disp_ptr=20 THEN Hist_disp_ptr=0
8824 Hist_disp_cnt=Hist_disp_cnt-1
8826 UNTIL Hist_disp_cnt=0
8828 END IF
8830 RETURN
8832 IF Inst_cnt MOD 10<>0 THEN Info_inst_cnt=Info_inst_cnt+1
8834 RETURN
8836 !
8838 Icode_hist_init: ! this routine initializes the history debugger code.
8840 GOSUB Icode_get_ihist
8842 RETURN
8844 !
8846 ! ****************************** TRACE *****************************
8848 !
8850 ! This section of code handles the ICODE program control.
8852 !
8854 ! ******************************************************************
8856 !
8858 INTEGER Trace_loop_done,Bkpt_new_addr,Bkpt_obj_addr
8860 INTEGER Cng_from,Cng_to
8862 !
8864 Icode_trc:!
8866 Trace_loop_done=0
8868 REPEAT
8870 ON KEY 0 LABEL "" GOSUB Icode_dbg_dmy
8872 ON KEY 1 LABEL FNUser_keylabel$("Single Step") CALL User_key1isr
8874 ON KEY 2 LABEL FNUser_keylabel$("Set Break Pt") CALL User_key2isr
8876 ON KEY 3 LABEL FNUser_keylabel$("Clr Break Pt") CALL User_key3isr
8878 ON KEY 4 LABEL FNUser_keylabel$("History") CALL User_key4isr
8880 ON KEY 5 LABEL FNUser_keylabel$("Cont") CALL User_key5isr
8882 ON KEY 6 LABEL FNUser_keylabel$("Pause") CALL User_key6isr
8884 ON KEY 7 LABEL FNUser_keylabel$("Restart") CALL User_key7isr
8886 ON KEY 8 LABEL FNUser_keylabel$("Return") CALL User_key8isr
8888 ON KEY 9 LABEL "" GOSUB Icode_dbg_dmy
8890 REPEAT
8892 GOSUB Icode_state_str ! Get State_str$
8894 Mode_str$=Ver_str$&" "&State_str$&" TRACE menu."
8896 DISP Mode_str$&" Enter softkey."
8898 UNTIL FNUser_key_press
8900 SELECT FNUser_get_key
8902 CASE 1
8904 GOSUB Icode_sngl_step
8906 CASE 2
8908 GOSUB Icode_set_ubkpt ! set user break point
8910 CASE 3
8912 GOSUB Icode_clr_bkpt
8914 CASE 4
8916 GOSUB Icode_hist
8918 CASE 5
8920 GOSUB Icode_cont
8922 CASE 6
8924 GOSUB Icode_pause
8926 CASE 7
8928 GOSUB Icode_rst_hist
8930 Hw_dev_clear(5)
8932 GOSUB Icode_hw_err_ck
8934 Hw_cmd("abrt;prog "&VAL$(Prog_id),5)
8936 GOSUB Icode_hw_err_ck
8938 OUTPUT CRT
8940 OUTPUT CRT;"ICODE program reset and restarted"
8942 CASE 8
8944 Trace_loop_done=1
8946 END SELECT
8948 UNTIL Trace_loop_done
8950 DISP
8952 RETURN
8954 !
8956 ! This subroutine is used to continue a PAUSed ICODE program. If the
8958 ! ICODE program is not paused, then an error is generated.
8960 !
8962 ! NOTE: There is a chance that the ICODE program could be continued
8964 ! in between the time the program state is checked and the time
8966 ! the CONT command is sent. If this happens, then the HP-IB
8968 ! module will generate an error. This will abort the ICODE
8970 ! program. Oops!!!!!!!!!!!!!!!
8972 !
8974 Icode_cont: ! continue ICODE program
8976 GOSUB Icode_state ! returns Icode_active and Icode_paused
8978 IF Icode_paused THEN
8980 Hw_cmd("cont",3)
8982 GOSUB Icode_hw_err_ck
8984 ELSE
8986 BEEP
8988 DISP "ICODE program not paused"
8990 WAIT 3
8992 END IF
8994 RETURN
8996 !
8998 ! This subroutine is used to PAUS a running program. If the ICODE
9000 ! program is already paused or not running then an error is generated.
9002 !
9004 ! NOTE: There is a chance that the ICODE program may pause in between
9006 ! the time its state is checked and the time the PAUS is sent to
9008 ! the HP-IB module. If this happens, an HP-IB module error will
9010 ! be generated. This will also abort the ICODE program. Oops!!!!
9012 !
9014 Icode_pause:!
9016 GOSUB Icode_state ! returns Icode_paused
9018 IF Icode_paused OR Icode_inactive THEN
9020 BEEP
9022 DISP "ICODE program not running"
9024 WAIT 3
9026 ELSE
9028 Hw_cmd("paus",3)
9030 GOSUB Icode_hw_err_ck
9032 END IF
9034 RETURN
9036 !
9038 ! This subroutine is used to single step one ICODE instruction.
9040 ! This is done by changing all c_nop's into f_pauses. Sending out
9042 ! a CONT, and then changing all f_pause's, back into c_nop's. Note
9044 ! that this will clear a break point if one is set.
9046 !
9048 Icode_sngl_step:!
9050 GOSUB Icode_clr_bkpt
9052 GOSUB Icode_state ! returns Icode_inactive and Icode_paused
9054 IF NOT Icode_inactive AND NOT Icode_paused THEN
9056 BEEP
9058 DISP "ICODE program not paused"
9060 WAIT 3
9062 ELSE
9064 DISP "Doing Single Step ..."
9066 Cng_from=C_nop
9068 Cng_to=F_pause
9070 GOSUB Icode_cng_all
9072 IF Icode_inactive THEN
9074 GOSUB Icode_rst_hist
9076 Hw_cmd("prog "&VAL$(Prog_id),3)
9078 ELSE
9080 Hw_cmd("cont",3)
9082 END IF
9084 GOSUB Icode_hw_err_ck
9086 Cng_from=F_pause
9088 Cng_to=C_nop
9090 REPEAT
9092 GOSUB Icode_state ! returns Icode_inactive and Icode_paused
9094 UNTIL Icode_paused OR Icode_inactive
9096 GOSUB Icode_cng_all
9098 END IF
9100 RETURN
9102 !
9104 ! Input: Cng_from,Cng_to
9106 !
9108 ! This subroutine is used to change all assembler inserted c_nop's into
9110 ! f_pause's or change all debugger f_pauses' back into c_nop's.
9112 !
9114 Icode_cng_all:!
9116 ALLOCATE INTEGER Object(0:Obj_size-1)
9118 Hw_read_blk((Prog_id),Object(*),3)
9120 GOSUB Icode_hw_err_ck
9122 Info_ptr=Info_inst_strt
9124 FOR Inst_ptr=0 TO Inst_cnt-1
9126 IF Inst_ptr MOD 10=0 THEN
9128 Temp$=Info$(Info_ptr)
9130 Info_ptr=Info_ptr+1
9132 END IF
9134 ENTER Temp$ USING "#,W,W";Obj_addr,Int_temp
9136 IF Object(Obj_addr-1)=Cng_from THEN
9138 Object(Obj_addr-1)=Cng_to
9140 END IF
9142 Temp$=Temp$[5]
9144 NEXT Inst_ptr
9146 Hw_write_blk((Prog_id),Object(*),3)
9148 GOSUB Icode_hw_err_ck
9150 DEALLOCATE Object(*)
9152 RETURN
9154 !
9156 ! Input: Bkpt_new_addr
9158 !
9160 ! This routine is used to set a break point. First a previously set
9162 ! break point is cleared. Then, the ICODE program is checked to make
9164 ! sure that there is a c_nop where the break point is to be set. If
9166 ! not, than an error is generated. Else, the break point is set.
9168 !
9170 Icode_set_bkpt:!
9172 GOSUB Icode_clr_bkpt
9174 ALLOCATE INTEGER Object(0:Bkpt_new_addr)
9176 Hw_read_blk((Prog_id),Object(*),3)
9178 GOSUB Icode_hw_err_ck
9180 IF Object(Bkpt_new_addr)<>C_nop THEN
9182 BEEP
9184 OUTPUT CRT
9186 OUTPUT CRT;"Can NOT set break point"
9188 DISP "Couldn't find c_nop to overwrite with break point"
9190 WAIT 3
9192 ELSE
9194 Object(Bkpt_new_addr)=F_pause ! Overwrite assembler inserted c_nop
9196 Bkpt_obj_addr=Bkpt_new_addr
9198 Hw_write_blk((Prog_id),Object(*),3)
9200 GOSUB Icode_hw_err_ck
9202 END IF
9204 DEALLOCATE Object(*)
9206 RETURN
9208 Icode_clr_bkpt: ! Clears current break point
9210 IF Bkpt_obj_addr<>-1 THEN
9212 ALLOCATE INTEGER Object(0:Bkpt_obj_addr)
9214 Hw_read_blk((Prog_id),Object(*),3)
9216 GOSUB Icode_hw_err_ck
9218 IF Object(Bkpt_obj_addr)=F_pause THEN
9220 Object(Bkpt_obj_addr)=C_nop
9222 Bkpt_obj_addr=-1
9224 Hw_write_blk((Prog_id),Object(*),3)
9226 GOSUB Icode_hw_err_ck
9228 OUTPUT CRT
9230 OUTPUT CRT;"Break point cleared"
9232 END IF
9234 DEALLOCATE Object(*)
9236 END IF
9238 RETURN
9240 !
9242 ! This subroutine is used to prompt the user for a break point spot
9244 ! and then set the break point. The break point may be specified by
9246 ! a label name or a source code line number.
9248 !
9250 Icode_set_ubkpt: ! set user break point
9252 Icode_inpt_num(Mode_str$&" Enter break point line:",Src_addr,Null_flag,Error_flag,Label_name$)
9254 IF Label_name$="" THEN
9256 IF Null_flag OR Error_flag THEN
9258 OUTPUT CRT
9260 OUTPUT CRT;"NO break point set"
9262 ELSE
9264 GOSUB Icode_src_2_obj ! returns obj_addr from src_addr
9266 Bkpt_new_addr=Obj_addr-1
9268 IF Bkpt_new_addr<0 OR Bkpt_new_addr>Obj_size THEN
9270 BEEP
9272 DISP "***** Invalid break point entry *****"
9274 WAIT 3
9276 OUTPUT CRT
9278 OUTPUT CRT;"NO break point set"
9280 ELSE
9282 GOSUB Icode_set_bkpt
9284 END IF
9286 END IF
9288 ELSE
9290 GOSUB Icode_lbl_obja ! returns Lbl_obj_addr from Label_name$
9292 IF Lbl_obj_addr<>-1 THEN
9294 Bkpt_new_addr=Lbl_obj_addr
9296 GOSUB Icode_set_bkpt
9298 ELSE
9300 BEEP
9302 DISP "***** Invalid label name entry *****"
9304 WAIT 3
9306 OUTPUT CRT
9308 OUTPUT CRT;"NO break point set"
9310 END IF
9312 END IF
9314 RETURN
9316 !
9318 Icode_get_ibkpt:! ! get break point info from Info$(*)
9320 Bkpt_obj_addr=VAL(Info$(4)[11,15])
9322 RETURN
9324 !
9326 Icode_put_ibkpt:! ! put break point info in Info$(*)
9328 Info$(4)[11,15]=VAL$(Bkpt_obj_addr)
9330 RETURN
9332 !
9334 Icode_trc_init: ! This subroutine is used to init the program control
9336 C_nop=61 ! section of the debugger
9338 F_pause=133
9340 GOSUB Icode_get_ibkpt
9342 RETURN
9344 !
9346 ! ********************** INIT ***********************************
9348 !
9350 ! This subroutine is used to initialize the debugger for debug mode.
9352 ! For format of Info$(*), see assembler documentation.
9354 !
9356 ! *********************************************************************
9358 !
9360 Icode_dbg_init:!
9362 IF NOT FNIcode_info_ok(Info$(*),Error_string$) THEN GOSUB Icode_dbg_err
9364 !
9366 ON ERROR GOTO Icode_dbg_ierr ! If error, then assume it is an
9368 ! Info$ format error.
9370 Info_info=VAL(Info$(0)[1,5]) ! What was Info_info during assembly
9372 IF Info_info<>2 THEN
9374 Error_string$="ICODE program not assembled with Info_info = 2"
9376 GOTO Icode_dbg_err
9378 END IF
9380 !
9382 Prog_id=VAL(Info$(0)[6,10])
9384 IF Prog_id=-1 THEN
9386 Error_string$="ICODE program not downloaded"
9388 GOTO Icode_dbg_err
9390 END IF
9392 !
9394 GOSUB Icode_blks_init ! init display block code
9396 GOSUB Icode_vars_init ! init variable code
9398 GOSUB Icode_src_init ! init display source code
9400 GOSUB Icode_hist_init ! init history code
9402 GOSUB Icode_trc_init ! init program control code
9404 !
9406 Obj_size=VAL(Info$(1)[11,15])
9408 !
9410 OFF ERROR
9412 !
9414 ! During the initialization of the debugger, Info$(*) is access many
9416 ! times. If an error occurs during this section of code, then it is
9418 ! assumed, that the problem is with the format of Info$(*). This
9420 ! should not happen unless there is an assembler/debugger (never), or
9422 ! the user has screwed around with the Info$(*) array.
9424 !
9426 IF 0 THEN
9428 Icode_dbg_ierr:OFF ERROR
9430 Error_string$="Invalid Info$(*) array format"
9432 GOSUB Icode_dbg_err
9434 END IF
9436 !
9438 S_width=FNLib_crt_width
9440 S_height=FNLib_crt_height
9442 !
9444 RETURN ! Icode_dbg_init
9446 !
9448 ! This subroutine is used to see if the last I/O with the HP3565S
9450 ! went well. If not then an error is displayed to the user and
9452 ! the debugger is exited.
9454 !
9456 Icode_hw_err_ck:!
9458 IF FNHw_io_error THEN
9460 Error_string$="Hardware I/O timeout error."
9462 GOTO Icode_dbg_err ! control will never be returned to the caller
9464 END IF
9466 RETURN
9468 !
9470 ! Input: Error_string$
9472 !
9474 ! This subroutine is used if a really bad thing happens to the
9476 ! debugger. Note that this routine will pause the running BASIC
9478 ! program, and if continued, exit the debugger.
9480 !
9482 Icode_dbg_err:!
9484 Icode_exec_err("Icode_debug: "&Error_string$)
9486 DISP "Debugger says 'OOPS' - hit <continue> to exit Icode_debug"
9488 PAUSE
9490 DISP
9492 SUBEXIT
9494 RETURN
9496 !
9498 ! This subroutine is used by the soft key routines. If an unused
9500 ! key is pressed, this this routine is called.
9502 !
9504 Icode_dbg_dmy:RETURN
9506 !
9508 SUBEND ! end if Icode_debug
9510 !
9512 Icode_inpt_num:SUB Icode_inpt_num(Prompt_string$,INTEGER Inpt_num,Null_flag,Error_flag,OPTIONAL Inpt_str$)
9514!
9516! This subprogram is used by the debugger to enter an integer number.
9518! The user is prompted with the string parameter Prompt_string$. If the
9520! user does not enter a string (just hit return), then Null_flag is set
9522! true. If an error occurs during input, then Error_flag is set true.
9524! If the string entered by the user is not a valid decimal or hex number,
9526! and the OPTIONAL parameter Inpt_str$ is present, then Inpt_str$ is
9528! returns with the user input string.
9530!
9532 DIM Temp$[100]
9534 Error_flag=0
9536 Null_flag=0
9538 IF NPAR=5 THEN Inpt_str$=""
9540 DISP Prompt_string$;
9542 LINPUT "",Temp$
9544 Temp$=TRIM$(Temp$)
9546 IF Temp$="" THEN
9548 Null_flag=1
9550 ELSE
9552 ON ERROR GOTO Icode_dbg_oops
9554 IF Temp$[1,1]="$" THEN
9556 Inpt_num=DVAL(Temp$[2],16)
9558 ELSE
9560 Inpt_num=VAL(Temp$)
9562 END IF
9564 IF 0 THEN
9566 Icode_dbg_oops:!
9568 IF NPAR=5 THEN
9570 Inpt_str$=UPC$(TRIM$(Temp$))
9572 Error_flag=1
9574 ELSE
9576 Error_flag=1
9578 Inpt_num=0
9580 BEEP
9582 DISP "***** Invalid numerical entry *****"
9584 WAIT 3
9586 END IF
9588 END IF
9590 OFF ERROR
9592 END IF
9594 SUBEND
9596 !
9598 Icode_inpt_str:SUB Icode_inpt_str(Prompt_string$,Inpt_str$)
9600!
9602! This subprogram is used to prompt the user and enter a string from the
9604! user. The user is prompted with Prompt_string$ and the caller is
9606! returned Inpt_str$.
9608!
9610 DISP Prompt_string$;
9612 LINPUT "",Inpt_str$
9614 Inpt_str$=UPC$(TRIM$(Inpt_str$))
9616 SUBEND
9618 !
9620 Icode_asc_str:DEF FNIcode_asc_str$(INTEGER Sixteen_bit_num)
9622!
9624! This function is used to convert a 16 bit integer into two characters.
9626! The Hi and Lo order bits are each converted into their ascii
9628! ascii representation. An ascii representation of a control or non
9630! printable character is replaces with a '.'.
9632!
9634 DIM Temp$[2]
9636 INTEGER Hi,Lo
9638 Hi=Sixteen_bit_num DIV 256
9640 Lo=Sixteen_bit_num MOD 256
9642 IF Hi>=32 AND Hi<=126 THEN
9644 Temp$=CHR$(Hi)
9646 ELSE
9648 Temp$="."
9650 END IF
9652 IF Lo>=32 AND Lo<=126 THEN
9654 Temp$[2]=CHR$(Lo)
9656 ELSE
9658 Temp$[2]="."
9660 END IF
9662 RETURN Temp$
9664 FNEND