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 ! 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 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 ) 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)