.Title VIRT -- Fast Virtual Support .Enabl lc ;+ ; ; VIRT -- Fast "Virtual Array" package for PDP-11 Fortran ; ; Author: Gary L. Maxwell ; National Strong Motion Data Center ; Branch of Engineering Seismology and Geology ; U.S. Geological Survey ; 345 Middlefield Road, Mailstop 977 ; Menlo Park, California 94025 ; ; Version: Y01 ; Support: RSX-11M/M-Plus ; ; This module contains the following routines which are required ; in any use of this package: ; ; CRWIND -- Create Address Window ; MPWIND -- Map Address Window ; $CALSZ -- Calculate size of Window ; ;- .Macro Assume a,b .if nb .if ne a-b .Error ; is not equal to .endc .iff .if ne a .Error ; is not equal to zero .endc .endc .endm Assume .Mcall rdbdf$,wdbdf$ rdbdf$ ; Define Region Definition Block offsets wdbdf$ ; Define Window Definition Block offsets .Mcall craw$s,map$s ac0 = %0 ac1 = %1 Assume R.GID .psect $code,ro,i ;+ ; ; Subroutine CRWIND (VIRT, irdb, iwdb, ierr, iunits, idim1, idim2, ...) ; ; CRWIND -- Create and prepare virtual window ; ; This routine initializes the Window Definition Block, and associates ; a virtual window and its characteristics with an existing region. ; ; All existing windows which overlap the window specified by VIRT and the ; units and dimension arguments are unmapped and eliminated. Note that ; the task region may not be overlapped, since it may not be unmapped! ; ; This call must precede calls to MPVIRT! This routine does NOT map ; the window created. ; ; VIRT Base of virtual array (on a 4 KW boundary) ; ; irdb Region Definition Block, initialized by CRVIRT or ASVIRT ; ; iwdb Window Definition Block, defined as INTEGER*2 iwdb(8). ; ; ierr Output status - 1 - Successful ; <0 - Unsuccessful, contains DSW ; ; iunits Is the number of bytes in each array element (1, 2, 4, etc.) ; ; idim1...idimn ; Is the dimensions of the window array. This routine calculates ; the size of the window, and uses this size to calculate ; map offsets in future calls to MPVIRT (if no such information ; is supplied to MPVIRT). ;- VIRT = 2 IRDB = 4 IWDB = 6 IERR = 10 IUNITS = 12 IDIM1 = 14 ARGOFF = 4 ; Number of arguments to skip to "iunits" Crwind:: mov #ie.alg,@IERR(r5) ; Assume parameter problems mov IWDB(r5),r3 ; Get address of WDB mov r3,r1 ; Copy the address mov VIRT(r5),r2 ; Get base of virtual array ash #-5,r2 ; Put APR bias in low part of high byte bic #^C<7*400>,r2 ; Save APR base in high byte mov r2,(r1)+ ; Save in WDB clr (r1)+ ; Clear base address movb (r5),r4 ; Get number parameters in call sub #ARGOFF,r4 ; Calculate no. dimensions ble 95$ ; Must be there! mov r5,-(sp) ; Save argument pointer add #IUNITS,r5 ; Point to first dimension call $Calsz ; Calculate window size mov (sp)+,r5 ; Restore argument pointer mov r0,(r1)+ ; Save the size in WDB bcs 95$ ; Window size too large bit #7,r0 ; Is it on a 512. byte boundary? bne 95$ ; If ne no - that's a problem mov @IRDB(r5),(r1)+ ; Set the region ID clr (r1)+ ; Clear region offset clr (r1)+ ; Clear map length mov #,(r1)+ ; Init status clr (r1)+ ; Clear send/receive buffer address craw$s r3 ; Create Address Window mov $dsw,@IERR(r5) ; Save return status 95$: return ; Return to caller ;+ ; ; Integer Function MPVIRT (iwdb, ierr, index [, iunits, idim1, idim2, ...] ) ; ; Map an address window to a part of a dynamic region. ; ; This routine unmaps the window (if already mapped), and attempts to remap ; the window to the specified offset in the region. ; ; Note: Although this routine will automatically map the window to the region ; previously associated by calling CRWIND, another region may be mapped ; instead. To do this, the region ID for the desired region must be ; stored in the Window Definition Block; e.g.: ; ; iwdb(4) = irdb(1) ! Set different Region to map ; ; See the Executive Reference Manual for details. ; ; iwdb Is the Window Definition Block ; ; ierr Return status: 1 - successful ; <0 - unsuccessful, set to $DSW ; ; index Specifies the offset into the region to start mapping. The ; offset is scaled by the size of the virtual window. If index=0, ; then mapping occurs at the start of the region. Otherwise, ; offset = (index * window_size) ; ; iunits, idim1...idimn (if present) ; Describe the size of the virtual window. If present, the size ; of the virtual window is calculated and replaces any window ; size set previously by a call to CRWIND or MPVIRT. If not ; present, the current window size in the WDB is used. ; ; MPVIRT returns as the value of the function the value of "ierr" so that ; MPVIRT calls may be embedded in a boolean function to check for ; errors. ;- IWDB = 2 IERR = 4 INDEX = 6 IUNITS = 10 ARGOFF = 3 ; Number of arguments to skip to "iunits" Mpvirt:: mov #IE.ALG,@IERR(r5) ; Assume alignment problems mov IWDB(r5),r3 ; Get WDB movb (r5),r4 ; Get number of arguments sub #ARGOFF,r4 ; See if window dimensions there ble 10$ ; If le no - use current window mov r5,-(sp) ; Save argument pointer add #IUNITS,r5 ; Point to first argument call $Calsz ; Calculate window size mov r0,W.NSIZ(r3) ; Save window size mov (sp)+,r5 ; Restore argument pointer bcs 95$ ; Window size too large bit #7,r0 ; Is window size on 512. byte boundary? bne 95$ ; If ne no, bad params 10$: mov W.NSIZ(r3),r0 ; Get the window size mul @INDEX(r5),r0 ; Calculate offset into region tst r0 ; Overflow past 16 bits? bne 95$ ; Yes, indeed mov r1,W.NOFF(r3) ; Store region offset clr W.NLEN(r3) ; Have exec figure out length to map map$s r3 ; Map the region mov $dsw,@IERR(r5) ; Store return status 95$: mov @IERR(r5),r0 ; Store function result return ; And return to caller ;+ ; ; $Calsz -- Calculate size of virtual window ; ; Input: R5 (argument pointer) set to first operand pointer. ; R4 contains count of operands to manipulate ; ; Output: Carry clear - valid window size returned in R0 ; Carry set - Overflow occurred (window too large) ;- $Calsz:: seti ; Set I*2 format setd ; Set double real format ldcid @(r5)+,ac0 ; Preload first operand br 20$ ; Branch into loop 10$: ldcid @(r5)+,ac1 ; Load next operand mulf ac1,ac0 ; Form next result 20$: sob r4,10$ ; Continue loop ldcid #64.,ac1 ; Get divisor divf ac1,ac0 ; Get window size in 64. byte blocks stcdi ac0,r0 ; Get the result cfcc ; Copy floating condition codes return ; And return to caller .end