.title subloa ; ; SUBROUTINE LOADER FOR PATCHED SYS(6) BASIC ; ; BASIC user reserve common spaces as follow ; ; part I) 187. Words for this loader code ; word 0 = define in basic program ; (length of SUBROUTINE file in blocs) ; word 1 = define in basic program ; (length of common data ,unloaded blocs) ; word 2 -> 5 = radix SUBROUTINE file name ; word 184. = if NOP (160.) load/execute subroutine ; else execute without loading ; ; part II) 256 * (SUBROUTINE file length) ; on the top of this part :256 W for IO ( lbuf ) ; on the bottom facultative common data area. ; (define size in word 1 of part I ) .enable lc .enable lsb .mcall .lookup,.readw,.close .mcall .print,.exit .list MEB .macro addr symbol,reg ;move symbol addr in reg (PIC mode) mov pc,reg add #symbol-.,reg .endm addr wcnt = 256. ; ***** internal buffer **** lbuff: .blkw wcnt ;internal load buffer ldbase: ; ****** change with basic user ******** brlsiz: .word 0 ;basic common size bellow this loadroutine (in bloc) dimsiz: .word 0. ; unload this lower part of the .brl routine ;common dim size in blocs relfil: .rad50 /dk SUBRL0brl/ ;rel input file ; **** EMT argblk **** area: .word 0 rdblcn: .word 0 ;lookup=relfil add ,readw=blocknumber buffad: .word 0 ; =buffer address bwcnt: .word wcnt ; =word count .word 0 ; **** saved address **** emtadd: .word 0 ;emtargblk address lbufad: .word 0 ;lbuff address comsta: .word 0 ;common start (basic common base) rloffs: .word 0 ;relocation offset (in loaded file) rlcblc: .word 0 .word 0 ; **** READ bloc routine **** rdw: .readw emtadd,#16,r3,#wcnt,r4 rts pc ; **** error messages *** space: .ascii /?common to small/<200> norel: .ascii /?no rel format/<200> lookp: .ascii /?open file err/<200> .even ; ***** error routine **** 79$: addr lookp,r0 br 100$ 78$: addr norel,r0 br 100$ 77$: addr space,r0 100$: .print .close #16 tstb (r1)+ ;set basic syntax error rts pc ; ; **** sub load program **** subloa: addr area,r0 ;R0= area addr in Position-Independent Code ! mov r0,emtadd ; save emtaddr addr relfil,r2 ;.brl name address ; .lookup r0,#16,r2 ; open chan 16 subroutine 'SUBRLn.BRL' ; MOV r0,%0 MOV #16+<1*^O400>,(0) MOV r2,2.(0) EMT ^O375 bcs 79$ addr lbuff,r3 ;internal load buff addr ->r3 mov r3,lbufad ; **** read bloc 0 **** clr r4 jsr pc,rdw ;.readw emtadd,#16,r3,#wcnt,#0 cmp #^rREL,60(r3) ;test rel format bne 78$ tst 56(r3) ;assure NO OVERLAY SUBROUTINES bne 78$ mov r3,r2 addr ldbase,r3 ;find basic user_common_base_address *** mov brlsiz,r0 ;r0 = basic common size in bloc swab r0 asl r0 ; in bytes size sub r0,r3 mov r3,comsta ;save basic commonbaseaddr mov 42(r2),r4 ; .brl stack value mov 40(r2),relsta ;save .brl start = commbase+relative start-stck sub r4,relsta add r3,relsta mov 62(r2),rlcblc ; relocbloc_start = lastreaddbloc +1 mov r3,rloffs sub r4,rloffs ;save rel offset for relocation computing mov 50(r2),r2 ;highaddr of relroutin sub r4,r2 cmp r2,r0 ; commonsize GE relroutine ? bge 77$ ; read rel soubroutine from bloc r4 to bloc rlocbloc-1 ; at basiccommon_addr r3 mov dimsiz,r4 swab r4 ;convert in bytes asl r4 add r4,r3 ;userbuffer_start + no loaded dim mov dimsiz,r4 1$: inc r4 cmp r4,rlcblc ;last read bloc? bge 2$ jsr pc,rdw ;.readw emtadd, ,r3, ,R4 add #wcnt*2,r3 ;follow userbuff br 1$ ; **** load reloc table **** ; rloffst=reloc_offset= baseadrr - .brl_start_stack ; r4=relocbloc ; let r3 to internal lbuff addr 2$: ; mov rdwadd,r2 mov lbufad,r3 ;restore lbuff addr jsr pc,rdw ;.readw emtadd, ,r3, ,R4 mov r3,r0 add #wcnt*2,r0 ;end of bloc 3$: cmp #-2.,(r3) ;end of reloc table beq 4$ mov (r3)+,r2 ;r2=relative offset in .brl(word) asl r2 add comsta,r2 mov (r3)+,r4 add rloffs,r4 ;r4=new absolut addr mov r4,(r2) ;mov new_abs_addr in the relative addr .brl cmp r0,r3 bgt 3$ br 2$ ;read next relocblock 4$: .close #16 101$: mov #770,sys6 ; set ' BR 0$ ' in sys6 start ; call the routine now ; the 9 words on the top_of_basic_workspace 0$: mov r1,-(sp) mov r5,-(sp) .word 4737 ;jsr PC, relsta: .word 0 ; .brl_subroutine_addr mov (sp)+,r5 mov (sp)+,r1 rts pc sys6: NOP ;if NOP -> LOAD ROUTINE ;if routine loaded -> sys6: BR 0$ ; = sys6 start, for .brl subroutine start br subloa ;(sys4 start) .word 0 .end sys6