EXTEND YOUR OLD RT11 BASIC.SAV ...

		WITH EXECUTABLE MODULES IN YOUR WORKSPACE !



Author : Marc HENRY de HASSONVILLE (mar 85)
UNIVERSITE DE LIEGE (HOPITAL DE BAVIERE)
LIEGE	(BELGUIM)





			  ABSTRACT

   Add executable modules ,(Subroutines writen in MACRO,FORTRAN..)
   in your BASIC 'workspace' , for special I/O or speed execution.
   Your subroutine callable in RT11 basic programs, must be linked 
   in .REL format ,and loaded in the workspace with a little basic 
   program. If you approve this possiblity you must patch  6 words
   in your BASIC.SAV file .This substitute the old SYS(6) fonction
   to your callable subroutine.



















	SUMMARY		1 INTRODUCTION
			2 IMPORTANT WITH PATCHED SYS(6)
			3 PATCH PROCEDURE
			4 TEST SYS(6)  BASIC SAMPLE
			5 PRACTICAL USE OF SYS(6)
			6 THE BASIC SUBROUTINE LOADER
			7 THE ASSEMBLER SUBROUTINE LOADER
			 APPENDIX A & B



								extbas 2
1)INTRODUCTION
  ============


Basic 11 users are limited with the basic instructions, the subroutines or
functions may never call special I/O routines ( ex: A/D converter... ) and 
must always be writen in basic (slow execution : FFT ,grapic computing..).

With the patched BASIC , special routines  writen  in the language of your
choice, may be  loaded in the BASIC workspace  and called with a Basic SYS
fonction.
The SYS(6) fonction was choosed , because this fonction (normaly check the
ctrl/C inputs ) is rarely used, and it's  binary code  is easy to find and
to patch. 

The  BASIC 11 interpreter store the  COMMON DIM area on the  top_memory of
the user workspace. ( only numerical DIMs ,never ASCII ). 
The  patched SYS fonction  will  call a  routine on the  top of the  Basic
workspace , and return the value of the register R0 in the fonction.
note:If R0 is not altered in your special routine , the SYS(6) return the
     absolute address of this routine entrypoint.

Your  routine must be linked in a  relocatable format, ( Link/FOREGROUND )
and  must be  loaded in  your  basic COMMON / DIM area with a little basic
utility ( SUBLOA.BAS ), or with a assembler utility ( SUBLOA.LRL ).

The high speed loader  'SUBLOA.LRL'  is practical for multiple subroutines
calls,   it take  more common space  but  it  give the  posibilty  to load
automatiquely subroutines like overlay facility ( see SBDEMO example ).

The advantages  of this  patched BASIC  in  comparaison  with  the  normal
assembler call's proposed in the DIGITAL basic 11 source are:  
	 1- Do n't need  rebuild  BASIC  interpreter.
	 2- Interpreter may be run with or without routines. ( More space
		than permanent assembler routines ). 
	 3- Easier to instal.
The 2 disavantages are :
	 1- The only way to pass argument from  basic program  to the  
		subroutine is via common.
	 2- no ASCII argument may be passed.




2)IMPORTANT WITH PATCHED SYS(6)
  =============================

Prejudiciable result occurs if you do n't care at this following points.

>SYS(6) move  PC at basic_top_memory -3 words.
  (if sys(4) is also patched, SYS(4) move PC at basic_top_memory -2 words.)
  May be sure that legal CPU instructions are on this memory position , and
  that the last instruction is RTS PC. (oct 207 ,dec 135.) 
>NEVER change R1,R5,and SP,(restore if needed)
  Basic use :     R1 for address character in the statement
		  R5 address of the basic_user_area (table)

In case of a  SYS(6)  fonction is called without any legal CPU instructions
 on the top_of_the_workspace ,the computer will be halt in ODT mode.
 Return at the basic with the following steps:
		nnnnnn		  ! ODT halt at nnnnnn
		@		  ! 
		nnnnnn/207<CR>	  ! enter RTS PC = 207  at the halt address
		@P		  ! enter P ,computer restart at nnnnnn


								extbas 3
3) PATCH PROCEDURE
   ===============

First make a copy of your BASIC.SAV and find the octal length number of blocs.
		.COPY BASIC.SAV BASICX.SAV
		.DIR/OCT BASICX
		 06-Feb-85 Octal
		BASICX.SAV	65  06-Feb-85
  
______________________________________________
A)SEARCH START ADDRESS OF THE SYS(6) FONCTION.

The SYS fonctions  are optional  functions and its binary code are always in 
 the last 5 blocs of the BASIC.SAV file.

You have two way's for searching SYS(6).

  1>for RT11 V4 or later.
     SYS(6) is next the exit fonction SYS(4).
     This function call .EXIT (EMT 350) in the BYE routine.
     Find .EXIT as follow ...
		R SIPP
		BASICX.SAV/A
		Base?	0
		Offset?	0
		  Base		Offset	  Old	New?
		   000000	000000	000000	;S
		Search for?	 104350
		Start?		 1000
		End?		 65000
		Found at nnnnnn
            BYE routine start at nnnnnn -12
            find call BYE in the 5 last blocs
		  Base		Offset	  Old	New?
		   000000	000000	000000	;S
		Search for?	 nnnnnn-12
		Start?		 60000
		End?		 65000
		Found at mmmmmm
            SYS(4) start at mmmmmm-2
            and SYS(6) start at mmmmmm+2

  2> The second way to find SYS(6) is ,to dump the last 5 blocs of BASIC.SAV
     and search at the binary sequence :
		 5065 , 54 , 4737 , xxxxxx ,1030xx , 5265 , 54
     The position of this sequence is at approximately 340 octal bytes after
     the ascii "NONAME" position. 


______________
B)PATCH SYS(6)

Use PATCH utility , or SIPP if you have a RT11 V4 or later.
patch at sys(6) start : offset = octal bloc number * 1000
					+ sys(6)_start offset in the bloc

  OLD			   NEW			new program 

 005065 CLR 54(R5)        16500  MOV 10(r5),r0	!mov basic_top_memory > R0
 000054		             10
 004737	JSR PC,@#tst^C   166500  SUB 54(r5),r0	!subtract arg_val(=6) from R0
 0xxxxx		             54
 1030xx	BCC sysend	   4710  JSR PC,r0	!call subroutine start on  R0
 005265	INC 54(R5)	  10065  MOV r0,54(54)	!mov R0 > in int._stor 54(R5)
 000054			     54
 0004xx	BR  sysend				!note: basic return the value 
						!   of 54(r5) in the function
				

								extbas 4
4)TEST SYS(6) ( BASIC SAMPLE )
  ============================

!10 rem Find the SYS(6) routine start address
!10 COMMON A%(2)
!20 A%(0)=135. \ REM (= RTS PC ="207)
!30 PRINT "A%(0) absolute address =";SYS(6)



5)PRACTICAL USE OF SYS(6)
  =======================

____________________________
A)WRITE A FORTRAN SUBROUTINE
!	subroutine aquis
!	common	/comdim/n(256)
!
!	call print ('AQUIS ROUTINE')
!	do	10 i=1,256
!10	n(i)=i
!
!C	other statement 
!C	 .. but not TYPE,FORMAT...
!C	 only math and syslib routines
!
!	return
!	end

______________________________________
B)LOCATE COMDIM WITH A MACRO INTERFACE
!	.title comdim
!	.psect	comdim,rw,d,gbl,rel,ovr
!comdim::	.blkw	256.
!	.end

__________________
C)BUILD SUBROUTINE
!fortran aquis
!macro	comdim
	build 'COMDIM' at bottom of the routine file = 
					      start of basic data common erea.
!LINK/FOR/EXE:AQUIS.BRL/TRAN COMDIM,AQUIS
!Transfer symbol? AQUIS

____________________________________________
D) LOAD 'AQUIS.BRL' IN YOUR BASICX WORKSPACE
with the SUBLOA basic program.
Run and test the first 256 words of C%(),
			call SYS(6), and control the C%() again.
!r basicx
!all
!run SUBLOA
!enter routine File_name ? AQUIS.BRL
!STOP at line 400
!
!FOR I=0 TO 255 \ PRINT C%(I); \ NEXT I
!I=SYS(6)
!FOR I=0 TO 255 \ PRINT C%(I); \ NEXT I



								extbas 5
6)THE BASIC SUBROUTINE LOADER
  ===========================

10 rem SUBLOA.BAS 	executable with patched BASIC
10 rem 
10 rem    C1%(9)= special call routine with save/restore R1,R5
10 rem    C%( minimum routinelength ) store assembler routine
10 rem    C% = length of common + 7 { 7= pos -1 of the calling start C1%(7)}
10 rem			******************************************
10 rem 			*  call sys(6) start topmem-3 = C1%(7)   *
10 rem 			* routine start must be loaded in C1%(3) *
10 rem 			******************************************
10 rem
10 COMMON C1%(9),C%(2000) \ C%=2001+7
10 COMMON C1%(9),C%(2000) \ C%=2001+7
100 rem
100 rem -------	read .rel file -----------------------------------
100 rem
100 PRINT 'enter routine File_name';\ INPUT A$
100 PRINT 'enter routine File_name';\ INPUT A$
110 OPEN A$ FOR INPUT AS FILE #1 \ DIM #1,A%(20479)
110 OPEN A$ FOR INPUT AS FILE #1 \ DIM #1,A%(20479)
120 rem
120 rem		test the radix REL word of the input file 
120 IF A%(24)<>29012 THEN PRINT "NOT '.REL' FORMAT" \ STOP
120 IF A%(24)<>29012 THEN PRINT "NOT '.REL' FORMAT" \ STOP
150 rem
150 rem 	load .rel file
150 rem		routine length in bytes = A%(20) - A%(17)
150 rem				Highest_memory_add. - Initial_Stack_offset
150 rem	     note : preserve the old values of the data_part of your DIM with
150 rem 	a for_next starting at your data_length (150 FOR I%=256% ...)
150 rem
150 FOR I%=0 TO (A%(20)-A%(17)+1%)/2% \ C%(I%)=A%(256%+I%) \ NEXT I%
150 FOR I%=0 TO (A%(20)-A%(17)+1%)/2% \ C%(I%)=A%(256%+I%) \ NEXT I%
200 rem
200 rem -------	reclocation of the direct addressed variables -----
200 rem
200 rem   first SYS6 with C1%(7)=rts pc -> C1%(7)=memoryaddress
200 rem 	I%=reloc_table_start (note end of table = -2)
200 rem 	I1%=reloc_offset = C%()start_stackoffset
200 rem
200 I%=A%(25)*256%
200 I%=A%(25)*256%
210 C1%(7)=135 \ I1%=SYS(6)-(C%*2%)-A%(17)
210 C1%(7)=135 \ I1%=SYS(6)-(C%*2%)-A%(17)
220 IF A%(I%)<>-2% THEN C%(A%(I%))=A%(I%+1%)+I1% \ I%=I%+2% \ GO TO 220
220 IF A%(I%)<>-2% THEN C%(A%(I%))=A%(I%+1%)+I1% \ I%=I%+2% \ GO TO 220
250 rem
250 rem -------	*** read call_routine program (data)*** -----------
250 rem		this special call save/restore R1 and R5 data
250 rem			0 mov R1,-(SP) 		!push R1
250 rem 		1 mov R5,-(SP)		!push R5
250 rem 		2 jsr PC,		!call routine
250 rem			3 	** routine_start **
250 rem 		4 mov (SP)+,R5 		!pop R5
250 rem 		5 mov (SP)+,R1		!pop R1
250 rem 		6 rts
250 rem   sys(6) entry> 7 br Set_save_restore_start -> C1%(0)
250 rem 		8 eventual sys4 entry (branch to other routine)
250 rem 		9 =0
250 DATA 4198 ,4454 ,2527 ,0 ,5509 ,5505 ,135 ,504 ,135 ,0
250 DATA 4198 ,4454 ,2527 ,0 ,5509 ,5505 ,135 ,504 ,135 ,0
260 FOR I%=0 TO 9% \ READ C1%(I%) \ NEXT I%
260 FOR I%=0 TO 9% \ READ C1%(I%) \ NEXT I%
270 rem
270 rem	---- Let the absolute routine_start_address in C1%(3) -----
270 rem		  = reloc_offset + subroutine_start_address A%(16)
270 rem
270 C1%(3)=I1%+A%(16)
270 C1%(3)=I1%+A%(16)
300 rem
300 rem	----- Optional : If any .EXIT found ,change to RETURN PC --
300 rem
300 FOR I=0 TO (A%(20)-A%(17)+1%)/2%
300 FOR I=0 TO (A%(20)-A%(17)+1%)/2%
310 IF C%(I)=-30488 THEN C%(I)=135 \ PRINT 'found .EXIT  at';I
310 IF C%(I)=-30488 THEN C%(I)=135 \ PRINT 'found .EXIT  at';I
320 NEXT I
320 NEXT I
400 rem
400 STOP
400 STOP
								extbas 6
7)THE ASSEMBLER SUBROUTINE LOADER
  ===============================
With the assembler subroutine loader (SUBLOA.LRL) the SYS(6) function load
and  relocate  your subroutines  renamed  SUBRL0.BRL to SUBRL9.BRL in your
basic workspace . 
Next SYS(6) save R1-R5 , execute your routine ,restore R1-R5 and return to
BASIC with the value of R0.

The using of this LOADER need  2  BASIC  COMMONs parts :
	1> 186 words for the SUBLOA.LRL binary code
		(the SUBLOA is writen in Position indepandant code)
	2> minimum SUBRLn.BRL file length  ( 'm' blocs * 256 words )
		The 255 top words are used as I/O buffer
	  	the 'n' lower blocs of this part may be used as common data

___________________________________________________________________________
MEMORY MAP OF THE 3 COMMONs PARTS USED WITH THE ASSEMBLER SUBROUTINE LOADER

   |		| word: 177777  
 ==+------------|
   |186		| TOP of Basic workspace
 C |  5 	| (facultative sys(4) entry)  -> branch LOADER
   |  4		| SYS(6) entry : NOP  or branch SUBR     |
   |  3		| \                              |       |
   |  2		|      RETURN to Basic           |       |
   |  1 	|   Restore R5 R1                |       |
 O |  0		|      CALL SUBROUTINE ----------+-------+---------.
   |179		|   Save R1 R5                   |       |         |
   |  8		| /			<--------'       |         |
     ^                                                   |         |
   | !		|	LOAD SUB CODE                    |         |
 M | !                                  <----------------'         |
   |  5    BRL	| \                                                |
   |  4    RL0	| Radix SUBRoutine file name                       |
   |  3    SUB	|  (note : value of RL0 +1 to +9 = RL1 to RL9      |
   |  2    DK	| /                                                |
 M |  1  n value| (n blocs) COMMON DATA space                      |
   |  0  m value| (m blocs) COMMON SUBROUTINE CODE space           |
   +------------+                                                  |
   |255	m	| \                                                |
   | !	!	   I/O BUFFER (for Bloc 0 and Relocation Blocs)    |
 O | 0	!	| /                                                |
   + - -!- - - -|                                                  |
   |    !	| \                                                |
   |    !	   SUBROUTINE CODE                                 |
   |    !       | /                     <--------------------------'
 N | - -! - - - |
   | n  !	| \
   | !  !	|  COMMON DATA
   | 0  0	| /
 ==+------------|
   |		
   |	     basic user program
   |

__________________________________
EXECUTION OF THE SUBLOA.LRL LOADER 

	1 OPEN SUBRoutine.BRL			  if error -> ?open file err
	2 Load Bloc 0 in IO buffer
	3 Test radix 'REL'			  if error -> ?no rel format
	4 Test Common space (len of 'm')	  if error -> ?common to small
	5 Find SUBRoutine start address
	6 Load SUBRoutine (except common DATA len 'n')
	7 Load RELOCATION table in IO buffer and execute relocation
	8 Change the 'NOP' instruction  of the SYS(6) entry 
						     to BRANCH to SUBRoutine
	9 Save R1/R5 ,Execute the SUBRoutine ,Restore R1/R5 

On error , SUBLOA.LRL print ?MESSAGE and return to BASIC with <SYNTAX ERROR>
								extbas 7
______________________
ASSEMBLER LOADER USING

	The SBDEMO.BAS use this technique and compare two same routines
					writen in BASIC  and in  FORTRAN.

> Define 2 common parts
	10 COMMON L%(186),C%(2559)

> Load de subloader in the first common :  L%()
	20 OPEN 'SUBLOA.LRL' FOR INPUT AS FILE #1 \ DIM #1,S%(255)
	22 FOR I%=1% TO 186% \ L%(I%)=S%(I%) \ NEXT I% \ CLOSE #1

> Define the common len in bloc ( subroutine code space : C%()/256 )
	50 L%(0)=10

> Define len preserved for common data in the first 512 bytes of C%()
	60 L%(1)=1	

> For multiple subroutines store 'RL0' part of the 'DK:SUBRL0.BRL' radix name
  and add 1 to 9 of this value like follow ... ('RL0' is stored in L4% )
		If L%(4)=L4%    then SYS(6) load/execute SUBRL0.BRL
		If L%(4)=L4%+1% then SYS(6) load/execute SUBRL1.BRL
		...
		If L%(4)=L4%+9% then SYS(6) load/execute SUBRL9.BRL
	70 L4%=L%(4) \	rem L%(2)->L%(5)=radixDK:SUBRL0.BRL 

> CALL YOUR SUBROUTINE WITH SYS(6)

     New SYS(6) execute immediatly the subroutine (without reload).

     A new load is executed with
		define L%(4) -> choice of SUBRL0.BRL to SUBRL9.BRL
		set L%(184)=160 -> change BRANCH SUBROUTINE to NOP instruction
		call SYS(6)
	30010 L%(4)=L4%+L% \ L%(184)=160 \ L6%=SYS(6) \ RETURN


			====================

_________________________
SUBLOA.LRL ERROR MESSAGES

SUBLOA stops for 3 errors (return internal message + basic <SYNTAX ERROR>)
	1) ?open file err   = SUBRL#.BRL not found
	2) ?no rel format   = subroutine not linked with /FOREGROUND
				or subroutine including overlay's
	3) ?common to small = common size to small 
			length of SUBRL# code > L%(0) COMMON size (in Bytes)

		=========================================
								extbas 8
  APPENDIX A
  ==========

   ADDRESSES OF INTEREST	(ref : RT11 Software support)
   =====================

- Summary of description of a Relocatable file format :

in Bloc 0	: Load information			       (in SUBLOA.BAS)
			40 Program's relative start address	  = A%(16)
			42 Initial stack location		  = A%(17)
			50 Program's high limit			  = A%(20)
			60 radix50 'REL'			  = A%(24)
			62 relative start of relocation block 	  = A%(25)

Bloc 1 to n	: Program n blocs			   from A%(256) to
					          A%(256 + (A%(20)-A%(17))/2 )

Bloc n+1 to end : Relocation table ->			   start > A%(25)*256
			Relative word offset		    = A%( A%(25)*256 )
			original contents		    = A%(1+A%(25)*256)
			Relative word offset		    = A%(2+A%(25)*256)
			original contents		    = ...
				.
				.
			    -2 = end

	------------------------------------------------------------

	|---------------------|		** MEMORY MAP **
highmem 	I/O Page      |
	|---------------------|
	|	RMON	      |
	|   ------------------|
	|loaded handlers      |
	|---------------------|
	~     USR / KMON      |
        |~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~|<- sys(6) entry point
	|w	common	      |
	|o		      |
	|r		      |
	|k		      |
	|s		      |
	|p		      |
	|a		      |
	|c	user prog.    |
	|e 		      |	ON BASIC SYS ROUTINES R5 -> user_area_table
	|---------------------| 		      R1 -> statement pointer
	|	|	|     |	
	| 	 overlay      | offsets in user_area_table :
	|     root   BASIC    |		10 high limit of user memory
1000	|_____________________|		54 (60 in double precision basic)
	| stack		      |		   integer storage
	|		      |
	|		      |
500	|---------------------|
	| interrupt vectors   |
60	|---------------------|
	|    sys com area     |
40	|---------------------|
	|     Trap vectors    |
0	|_____________________|

		========================================
								extbas 9


APPENDIX B
==========		* OPTIONAL PATCHING *


_________
1> SYS(4)

For a second routine entry point you may patch SYS(4). Only NOP patch change
the  routine startpoint because the  SYS(6)  patched program subtract argval
from TOP_OF_BASIC_MEMORY, and argval=4 for sys(4) or 6 for sys(6). 
	
patch at sys(4) start (=SYS(6) start -2 words)
  OLD			   NEW
 000137	JMP @#BYE	    240  NOP
 0xxxxx			    240  NOP



__________________________________________________
2> OTHER INTERESTING PATCH IS THE SYS(1) FONCTION.

The SYS(1) Fonction reads a single character from the keyboard and takes on 
 the numeric ASCII code value of the character.

BUT ! It does not accept any characters without the RETURN key.

A new patch may be change this so that any input character is immediately
 accepted and returned with the sys(1) function.

SYS(1) function start approximativly at 30 octal bytes before sys(6) .

Find the old sequence and patch it with this new instructions:

OLD				NEW				program
 16546	mov nnn(r5),-(sp)	5000	clr r0
   nnn				52737	bis #10100,@#44	   !set TT single-char
  5065	clr nnn(r5)		10100			   ! bit 6 + 12 of JSW
   nnn				44
  4767	jsr pc,getchar		104340	EMT 340		   !.TTYIN r0
xxxxxx				103776	 bcs .-2
103775	bcs .-3			42737	bic #10100,@#44    !reset JSW bits
 12665	mov (sp)+,nnn(r5)	10100
   nnn				44
	br sysend

============================================ good luck ! =====================
								 Marc (mar 85)
���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������