Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_Alpha_31-jul-86
-
forchr.mac
There are 23 other files named forchr.mac in the archive. Click here to see a list.
SEARCH MTHPRM,FORPRM
TV FORCHR Character routines, 10(4106)
SUBTTL BL/AHM/TFV/CKS/RVM/PLB/TJK/CDM/MRB 2-Feb-84
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
COMMENT \
***** Begin Revision History *****
***** Begin Version 7 *****
3011 AHM 3-Nov-81
Put CPRINT in a separate module.
3013 AHM 4-Nov-81
Define Lxy. to be the same as CH.xy. until CH.xy. is removed from
the compiler.
3032 AHM 11-Dec-81
Put in a preliminary version of the CHAR and LEN functions. Also
delete the definitions of CH.yx. since they are not generated by
the compiler anymore.
3034 TFV 5-Jan-82
Add routines CHSFN. and CHSFC. to FORCHR.MAC for character
statement functions. They save and restore the ACs. A character
statement function is turned into either a call to CHSFN. (the
subroutine form of CHASN.) or a call to CHSFC. (the subroutine
form of CONCA.). CHSFC. is used if the character expression
has concatenations at its top level, CHSFN. is used for all
other character expressions. Also fix CONCA. and CHASN. so they
don't save and restore the ACs since they are also subroutine
subprograms. Also rework FORCHR.MAC so that it uses the HELLO
and GOODBYE macros, has the right copyright notices, and
PRGEND's. This will make it compatible with the rest of the
library.
3067 TFV 5-Mar-82
Add routine CONCM. to do concatenations with a known maximum
length. It will check the length of the result and give an
error if the specified maximum is exceeded. Finally write
CONCL. to compute the length of concatenations. It fills in the
length in characters into the first argument descriptor (the
descriptor for the result) and returns the length in words in
AC1.
3070 TFV 24-Mar-82
Rework the algorithms for the concatenation routines to speed
them up. Add register declarations. Cleanup other routines as
needed. Reorder the routines to be functionally grouped.
3071 BL 30-Mar-82
Install missing TWOSEG 400000 pseudo-ops.
3122 JLC 14-May-82
Remove CPRINT. Add CHRSTK, the character stack handler.
3130 TFV 9-Jun-82
Changes for dynamic concatenations. Make CHALC% be an
internal routine used to allocate dynamic character space.
Modify CONCA., CHASN., and CONCD. to use CHALC% to allocate
dynamic character space. Also add calls to CHMRK. and CHUNW. in
CONCA. and CHASN. for the overlap case.
3145 AHM 8-Jul-82
Mend fencepost after CHRCLR which cleared one location too
many in the dynamic character stack array with an XBLT. Also,
remove a dot by changing a MOVE to an XMOVEI to evaluate the
destination address for the XBLT.
3204 AHM 1-Nov-82
Save and restore AC+2 and AC+5 of the AC block used by the
CMPSxy instruction in COMPAR in RELAT. They are smashed
during interrupts when using one word global byte pointers.
3242 AHM 28-Dec-82
Rework AOBJN loops in CONCM., CONCD., OVRLP%, CLR35% and CONC%
so that character manipulation works with multiple sections of
code. Also, change the CHADDR macro in OVRLP% so that it
handles OWGBPs and section local byte pointers. Finally,
make SAVAC%/RESAC% work in non-zero sections.
3243 AHM 29-Dec-82 QAR 10-03062
Make COMPAR check for lengths with 777B8 non-zero as well as
zero lengths so that ?FRSICE is printed instead of ?Illegal
instruction at user PC.
3261 RVM 4-Feb-83
Make CHASN. and CONCA. save and restore AC's. Originally, it
was thought these routines did not need to save AC's as calls
to these routines were treated as subroutine calls by the
compiler. But, the compiler did not realize that a FUNCTION
subprogram should save its AC's if it contained calls to these
routines.
***** Begin Version 10 *****
4011 PLB 27-May-83
Fix CHADDR macro used in OVRLP% to work with OWGBPs,
required adding a second 'MAGIC' table.
4023 JLC 29-Jun-83
Put CHRPT. at the end of this file as a separate module.
4075 TJK 2-Feb-84
Add routines CASNM., CASNN., and CASNO. to replace CHASN.,
which is now obsolete, and rewrite CHASN. to call CASNM. Also
add routines CNCAM., CNCAN., and CNCAO. to replace CONCA.,
which is now obsolete, and rewrite CONCA. to call CNCAM.
Also fix a bug in the CHADDR macro in OVRLP% which resulted in
the character addresses of one word global byte pointers being
calculated as one less than the corresponding character
addresses of local byte pointers. This also allowed the
removal of the MAGIC2 table added in edit 4011.
4100 MRB 9-Feb-84
Added code to do compatibility flagging in FORLIB. Outputs
a warning message for usage of non compatible language features
like character string overlap.
4101 CDM 16-Feb-84
Create and expand the character stack differently when running
in extended addressing. Give the stack its own section(s) so
that it has plenty of room. Also add user subroutine ALCCHR.
Kill uneeded locals SVDLEN, SAVET1, NEWPNT. Rename CHALC% to
%CHALC to insure no overlap with future monitor symbols. Rename
register DLEN to CHLEN and move into FORPRM (DLEN already exists
in FORPRM).
4105 JLC 29-Feb-84
Remove CHLEN and DPTR from FORPRM, as they should not have been
defined in the first place. Use FOROTS/FORLIB AC conventions:
CHLEN becomes T5, DPTR becomes P1. Change references to LEN1,
PTR1, LEN2, and PTR2 to T2, T3, T5, and P1. Change references
to LEN1+n (!) to their appropriate FORLIB AC usage.
4106 JLC 2-Mar-84
Do some more AC standardization.
***** End V10 Development *****
***** End Revision History *****
\
PRGEND
TITLE CHSFN. Character statement function assignment
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN CLR35%, RESAC%, SAVAC%
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
; CHSFN. is called by character statement functions to perform the
; assignment of the function value. If the value expression has
; concatenation at its top level, the routine CHSFC. is called
; instead. CHSFN. has only two arguments and the destination is
; a .Qnnnn variable. Overlap never occurs.
;
; The algorithm is:
;
; save the ac's
; clear bit 35 of the destination words
; do a MOVSLJ
; restore the ac's
;
; To call CHSFN.:
;
; XMOVEI L,ARGBLK
; PUSHJ P,CHSFN.
;
; -2,,0
; ARGBLK: IFIW 15,ADESC
; IFIW 15,BDESC
;
; ADESC: byte pointer to destination address
; destination length
;
; BDESC: byte pointer to source address
; source length
;
;Register usage:
; 2 through 7 are used by MOVSLJ
;
; 2 Source length
; 3 Source byte pointer
; 4 Second word of source byte pointer is unused
; T5 Destination length
; P1 Destination byte pointer
; 7 Second word of destination byte pointer is unused
; L Argument list pointer
; P Stack pointer
HELLO (CHSFN.) ;[3034] Beginning of CHSFN. routine
PUSHJ P,SAVAC% ;[3034] Save registers
DMOVE T5,@(L) ;Load destination descriptor
EXCH T5,P1 ;Put in order for MOVSLJ
PUSHJ P,CLR35% ;Clear bit 35 of destination
DMOVE T2,@1(L) ;Load source descriptor
EXCH T2,T3 ;Put in order for MOVSLJ
EXTEND T2,[MOVSLJ
" "] ;Move string with blank filling
JFCL ;Truncation is allowed
PJRST RESAC% ;[3034] Restore ac's and return to user routine
PRGEND
TITLE CHSFC. Character statement function concatenation assignment
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN CLR35%, CONC%, RESAC%, SAVAC%
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
; CHSFC. is called by character statement functions to perform the
; assignment of the function value if the value expression has
; concatenation at its top level. In all other cases the routine
; CHSFN. is called instead. The destination is a .Qnnnn
; variable. Overlap never occurs.
;
; The algorithm is:
;
; save the ac's
; clear bit 35 of the destination words
; do the concatenations
; restore the ac's
;
; To call CHSFC.:
;
; XMOVEI L,ARGBLK
; PUSHJ P,CHSFC.
;
; -N,,0
; ARGBLK: IFIW 15,ADESC
; IFIW 15,BDESC
; ... ........
; IFIW 15,NDESC
;
; ADESC: byte pointer to destination address
; destination length
;
; BDESC: byte pointer to first source address
; first source length
; ......................
; ......................
; NDESC: byte pointer to nth-1 source address
; nth-1 source length
;
;Register usage:
;
; T5 Destination length
; P1 Destination byte pointer
; L Argument list pointer
; P Stack pointer
HELLO (CHSFC.) ;[3034] Beginning of CHSFC. routine
PUSHJ P,SAVAC% ;[3034] Save registers
DMOVE T5,@(L) ;Load destination descriptor
EXCH T5,P1 ;Put in order for MOVSLJ
PUSHJ P,CLR35% ;Clear bit 35 of destination
PUSHJ P,CONC% ;Do a multiple source concatenation
PJRST RESAC% ;[3034] Restore acs and return to user program
PRGEND
TITLE CHASN. - Character assignment (OBSOLETE)
SUBTTL */TJK 2-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine performs character assignment of a single source
; string with potential overlap. It is now obsolete (it is
; replaced by CASNM., CASNN., and CASNO.). It saves ACs, calls
; CASNM. to assign the destination string to the source string,
; and restores ACs and returns. The routine still exists for
; compatibility only. No calls to it are generated by the
; current version of the compiler.
;
; CALLING SEQUENCE:
;
; CALL CHASN.(CHDEST,CHSRC)
;
; INPUT PARAMETERS:
;
; CHSRC Source string
;
; IMPLICIT INPUTS:
;
; None
;
; OUTPUT PARAMETERS:
;
; CHDEST Destination string
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; None
;
;--
;[4075] Rewritten
;Register usage:
;
; L Argument list pointer
; P Stack pointer
;
; This routines preserves registers
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN CASNM., SAVAC%, RESAC%
HELLO (CHASN.) ;Beginning of CHASN. routine
PUSHJ P,SAVAC% ;[3261] Save AC's
PUSHJ P,CASNM. ;[4075] Perform the assignment
PJRST RESAC% ;[3261] Restore AC's and return
PRGEND
TITLE CASNM. - Character assignment with potential overlap
SUBTTL Thomas J. Karzes/TJK 2-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine performs character assignment of a single source
; string with potential overlap. It is equivalent to CHASN.
; except it doesn't preserve ACs. All it does is call OVRLP% to
; check for overlap, then calls CASNN. if there's no overlap and
; CASNO. if there is overlap.
;
; CALLING SEQUENCE:
;
; CALL CASNM.(CHDEST,CHSRC)
;
; INPUT PARAMETERS:
;
; CHSRC Source string
;
; IMPLICIT INPUTS:
;
; None
;
; OUTPUT PARAMETERS:
;
; CHDEST Destination string
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; None
;
;--
;[4075] New routine
;Register usage:
;
; T0 -1 for overlap; 0 for no overlap
; L Argument list pointer
; P Stack pointer
;
; Other register are smashed by routines which are called.
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN CASNN., CASNO., OVRLP%, FLG77., ANSOVL
HELLO (CASNM.) ;Beginning of CASNM. routine
SKIPE [FLG77.] ;Is ANSI compatbility flagging on ?
PUSHJ P, ANSOVL ;[4100]Yes call routine to check for overlap.
PUSHJ P,OVRLP% ;Test for overlap
JUMPE T0,CASNN. ;No overlap, PJRST to CASNN.
PJRST CASNO. ;Overlap, PJRST to CASNO.
PRGEND
TITLE CASNN. - Character assignment with no overlap
SUBTTL Thomas J. Karzes/TJK 2-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine performs character assignment of a single source
; string with no overlap. All it does is set up the ACs, do a
; MOVSLJ, and return. ACs are not preserved. Most of the code
; was taken from the original CHASN. routine.
;
; CALLING SEQUENCE:
;
; CALL CASNN.(CHDEST,CHSRC)
;
; INPUT PARAMETERS:
;
; CHSRC Source string
;
; IMPLICIT INPUTS:
;
; None
;
; OUTPUT PARAMETERS:
;
; CHDEST Destination string
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; None
;
;--
;[4075] New routine
;Register usage:
; 2 through 7 are used by MOVSLJ
;
; 2 ;Source length
; 3 ;Source byte pointer
; 4 Second word of source byte pointer is unused
; T5 Destination length
; P1 Destination byte pointer
; 7 Second word of destination byte pointer is unused
; L Argument list pointer
; P Stack pointer
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
HELLO (CASNN.) ;Beginning of CASNN. routine
DMOVE T5,@(L) ;Load destination descriptor
EXCH T5,P1 ;Put in order for MOVSLJ
DMOVE T2,@1(L) ;Load source descriptor
EXCH T2,T3 ;Put in order for MOVSLJ
EXTEND T2,[MOVSLJ
" "] ;Move string with blank filling
JFCL ;Truncation is allowed
GOODBYE ;Return
PRGEND
TITLE CASNO. - Character assignment with known overlap
SUBTTL Thomas J. Karzes/TJK 2-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine performs character assignment of a single source
; string with known overlap. To handle the overlap, the source
; string is first moved to dynamic space, then from the dynamic
; space to the destination. The algorithm is:
;
; call CHMRK. to save the current character stack pointer
; call %CHALC to allocate the dynamic space
; do a MOVSLJ from the source string to the dynamic space
; do a MOVSLJ from the dynamic space to the destination string
; call CHUNW. to deallocate the dynamic space
;
; ACs are not preserved. Most of the code was taken from the
; original CHASN. routine.
;
; CALLING SEQUENCE:
;
; CALL CASNO.(CHDEST,CHSRC)
;
; INPUT PARAMETERS:
;
; CHSRC Source string
;
; IMPLICIT INPUTS:
;
; None
;
; OUTPUT PARAMETERS:
;
; CHDEST Destination string
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; None
;
;--
;[4075] New routine
;Register usage:
; 2 through 7 are used by MOVSLJ
;
; 2 ;Source length
; 3 ;Source byte pointer
; 4 Second word of source byte pointer is unused
; T5 Destination length
; P1 Destination byte pointer
; 7 Second word of destination byte pointer is unused
; L Argument list pointer
; P Stack pointer
;
; Other register may be smashed by routines which are called.
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN %CHALC, CHMRK., CHUNW.
HELLO (CASNO.) ;Beginning of CASNO. routine
MOVEM L,SAVEL ;[3130] Save L
XMOVEI L,CHARGL ;[3130] Load new L for CHMRK. call
PUSHJ P,CHMRK. ;[3130] Mark the dynamic space
MOVE L,SAVEL ;[3130] Load L
DMOVE T5,@(L) ;Load destination descriptor
EXCH T5,P1 ;Put in order for MOVSLJ
PUSHJ P,%CHALC ;[4101] Allocate dynamic space
MOVEM P1,SVDPTR ;[3130] Save destination pointer
DMOVE T2,@1(L) ;Load source descriptor
EXCH T2,T3 ;Put in order for MOVSLJ
EXTEND T2,[MOVSLJ
" "] ;Move string with blank filling
JFCL ;Truncation is allowed
; Move string to actual destination
MOVE T3,SVDPTR ;Move from dynamic space
DMOVE T5,@(L) ;Load destination descriptor
EXCH T5,P1 ;Put in order for MOVSLJ
MOVE T2,T5 ;Load source length
EXTEND T2,[MOVSLJ
" "] ;Move string with blank filling
JFCL ;Truncation is allowed
; Deallocate dynamic space
XMOVEI L,CHARGL ;[3130] Load L for CHUNW. call
PUSHJ P,CHUNW. ;[3130] Call CHUNW.
MOVE L,SAVEL ;[3130] Restore old L
GOODBYE ;Return
-1,,0 ;[3130] Argument list count
CHARGL: IFIW TP%SPO,MARK ;[3130] Argument list for CHMRK./CHUNW. calls
SEGMENT DATA
SAVEL: BLOCK 1 ;[3130] Saved register L
SVDPTR: BLOCK 1 ;[3130] Saved P1
MARK: BLOCK 1 ;[3130] Holds the mark for unwinding
PRGEND
TITLE CONCA. - Character concatenation assignment (OBSOLETE)
SUBTTL */TJK 2-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine performs character assignment with potential
; overlap in which the source is a concatenation. It is now
; obsolete (it is replaced by CNCAM., CNCAN., and CNCAO.). It
; saves ACs, calls CNCAM. to assign the destination strings to
; the source string, and restores ACs and returns. The routine
; still exists for compatibility only. No calls to it are
; generated by the current version of the compiler.
;
; CALLING SEQUENCE:
;
; CALL CONCA.(CHDEST,CHSRC1,...,CHSRCN)
;
; INPUT PARAMETERS:
;
; CHSRC1 First source string
; ... ...
; CHSRCN Last (Nth) source string
;
; IMPLICIT INPUTS:
;
; None
;
; OUTPUT PARAMETERS:
;
; CHDEST Destination string
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; None
;
;--
;[4075] Rewritten
;Register usage:
;
; L Argument list pointer
; P Stack pointer
;
; This routines preserves registers
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN CNCAM., SAVAC%, RESAC%
HELLO (CONCA.) ;Beginning of CONCA. routine
PUSHJ P,SAVAC% ;[3261] Save AC's
PUSHJ P,CNCAM. ;[4075] Perform the assignment
PJRST RESAC% ;[3261] Restore AC's and return
PRGEND
TITLE CNCAM. - Character concat assignment with potential overlap
SUBTTL Thomas J. Karzes/TJK 2-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine performs character assignment with potential
; overlap in which the source is a concatenation. It is
; equivalent to CONCA. except it doesn't preserve ACs. All it
; does is call OVRLP% to check for overlap, then calls CNCAN. if
; there's no overlap and CNCAO. if there is overlap.
;
; CALLING SEQUENCE:
;
; CALL CNCAM.(CHDEST,CHSRC1,...,CHSRCN)
;
; INPUT PARAMETERS:
;
; CHSRC1 First source string
; ... ...
; CHSRCN Last (Nth) source string
;
; IMPLICIT INPUTS:
;
; None
;
; OUTPUT PARAMETERS:
;
; CHDEST Destination string
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; None
;
;--
;[4075] New routine
;Register usage:
;
; T0 -1 for overlap; 0 for no overlap
; L Argument list pointer
; P Stack pointer
;
; Other register are smashed by routines which are called.
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN CNCAN., CNCAO., OVRLP%, FLG77., ANSOVL
HELLO (CNCAM.) ;Beginning of CNCAM. routine
SKIPE [FLG77.] ;Is ANSI compatbility flagging on ?
PUSHJ P, ANSOVL ;[4100]Yes call routine to check for overlap.
PUSHJ P,OVRLP% ;Test for overlap
JUMPE T0,CNCAN. ;No overlap, PJRST to CNCAN.
PJRST CNCAO. ;Overlap, PJRST to CNCAO.
PRGEND
TITLE CNCAN. - Character concat assignment with no overlap
SUBTTL Thomas J. Karzes/TJK 2-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine performs character assignment with no overlap in
; which the source is a concatenation. All it does is set up
; the destination ACs, call CONC% to move the source strings to
; the destination, and return. ACs are not preserved. Most of
; the code was taken from the original CONCA. routine.
;
; CALLING SEQUENCE:
;
; CALL CNCAN.(CHDEST,CHSRC1,...,CHSRCN)
;
; INPUT PARAMETERS:
;
; CHSRC1 First source string
; ... ...
; CHSRCN Last (Nth) source string
;
; IMPLICIT INPUTS:
;
; None
;
; OUTPUT PARAMETERS:
;
; CHDEST Destination string
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; None
;
;--
;[4075] New routine
;Register usage:
;
; T5 Destination length
; P1 Destination byte pointer
; L Argument list pointer
; P Stack pointer
;
; Other register are smashed by routines which are called.
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN CONC%
HELLO (CNCAN.) ;Beginning of CNCAN. routine
DMOVE T5,@(L) ;Load destination descriptor
EXCH T5,P1 ;Put in order for MOVSLJ
PJRST CONC% ;Do a multiple source concatenation and return
PRGEND
TITLE CNCAO. - Character concat assignment with known overlap
SUBTTL Thomas J. Karzes/TJK 2-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine performs character assignment with known overlap
; in which the source is a concatenation. To handle the
; overlap, the source strings are first concatenated into
; dynamic space, then moved from the dynamic space to the
; destination. The algorithm is:
;
; call CHMRK. to save the current character stack pointer
; call %CHALC to allocate the dynamic space
; call CONC% to concat the source strings into the dynamic space
; do a MOVSLJ from the dynamic space to the destination string
; call CHUNW. to deallocate the dynamic space
;
; ACs are not preserved. Most of the code was taken from the
; original CONCA. routine.
;
; CALLING SEQUENCE:
;
; CALL CNCAO.(CHDEST,CHSRC1,...,CHSRCN)
;
; INPUT PARAMETERS:
;
; CHSRC1 First source string
; ... ...
; CHSRCN Last (Nth) source string
;
; IMPLICIT INPUTS:
;
; None
;
; OUTPUT PARAMETERS:
;
; CHDEST Destination string
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; None
;
;--
;[4075] New routine
;Register usage:
; 2 through 7 are used by MOVSLJ
;
; 2 ;Source length
; 3 ;Source byte pointer
; 4 Second word of source byte pointer is unused
; T5 Destination length
; P1 Destination byte pointer
; 7 Second word of destination byte pointer is unused
; L Argument list pointer
; P Stack pointer
;
; Other register may be smashed by routines which are called.
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN %CHALC, CHMRK., CHUNW., CONC%
HELLO (CNCAO.) ;Beginning of CNCAO. routine
MOVEM L,SAVEL ;[3130] Save L
XMOVEI L,CHARGL ;[3130] Load new L for CHMRK. call
PUSHJ P,CHMRK. ;[3130] Mark the dynamic space
MOVE L,SAVEL ;[3130] Load L
DMOVE T5,@(L) ;Load destination descriptor
EXCH T5,P1 ;Put in order for MOVSLJ
PUSHJ P,%CHALC ;[4101] Allocate dynamic space
MOVEM P1,SVDPTR ;[3130] Save destination pointer
; Move string to dynamic space
PUSHJ P,CONC% ;Do multiple source concatenation
; Move string to actual destination
MOVE T3,SVDPTR ;Move from dynamic space
DMOVE T5,@(L) ;Load destination descriptor
EXCH T5,P1 ;Put in order for MOVSLJ
MOVE T2,T5 ;Load source length
EXTEND T2,[MOVSLJ
" "] ;Move string with blank filling
JFCL ;Truncation is allowed
; Deallocate dynamic space
XMOVEI L,CHARGL ;[3130] Load L for CHUNW. call
PUSHJ P,CHUNW. ;[3130] Call CHUNW.
MOVE L,SAVEL ;[3130] Restore old L
GOODBYE ;Return
-1,,0 ;[3130] Argument list count
CHARGL: IFIW TP%SPO,MARK ;[3130] Argument list for CHMRK./CHUNW. calls
SEGMENT DATA
SAVEL: BLOCK 1 ;[3130] Saved register L
SVDPTR: BLOCK 1 ;[3130] Saved P1
MARK: BLOCK 1 ;[3130] Holds the mark for unwinding
PRGEND
TITLE CONCF. Fixed length concatenation
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN CLR35%, CONC%, RESAC%, SAVAC%
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
; CONCF. will concatenate a series of source strings to a
; .Qnnnn variable. The destination has a fixed length known
; at compile time. Overlap never occurs.
;
; The algorithm is:
;
; save the ac's
; clear bit 35 of the destination words
; do the concatenations
; restore the ac's
;
; To call CONCF.:
;
; XMOVEI L,ARGBLK
; PUSHJ P,CONCF.
;
; -N,,0
; ARGBLK: IFIW 15,ADESC
; IFIW 15,BDESC
; ... ........
; IFIW 15,NDESC
;
; ADESC: byte pointer to destination address
; destination length
;
; BDESC: byte pointer to first source address
; first source length
; ......................
; ......................
; NDESC: byte pointer to nth-1 source address
; nth-1 source length
;
;Register usage:
;
; T5 Destination length
; P1 Destination byte pointer
; L Argument list pointer
; P Stack pointer
HELLO (CONCF.) ;Beginning of CONCF. routine
PUSHJ P,SAVAC% ;Save registers
DMOVE T5,@(L) ;Load destination descriptor
EXCH T5,P1 ;Put in order for MOVSLJ
PUSHJ P,CLR35% ;Clear bit 35 of destination words
PUSHJ P,CONC% ;Do the multiple source concatenation
PJRST RESAC% ;Restore registers and return
PRGEND
TITLE CONCM. Known maximum length concatenation
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN CLR35%, CONC%, RESAC%, SAVAC%
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
; CONCM. will concatenate a series of source strings to a
; destination .Qnnnn variable. The length of the destination
; string is computed by adding the lengths of the source strings.
; If the actual length exceeds the length in the descriptor for
; the result, a fatal abort occurs. The actual length of the
; result is stored into the destination descriptor. Overlap never
; occurs
;
; The algorithm is:
;
; save the ac's
; compute the size of the result
; test for result larger than expected and give an error
; clear bit 35 of the destination words
; do the concatenations
; restore the ac's
;
; To call CONCM.:
;
; XMOVEI L,ARGBLK
; PUSHJ P,CONCM.
;
; -N,,0
; ARGBLK: IFIW 15,ADESC
; IFIW 15,BDESC
; ... ........
; IFIW 15,NDESC
; ADESC: byte pointer to destination address
; maximum length for the result - the actual length is returned
;
; BDESC: byte pointer to first source address
; first source length
; ......................
; ......................
; NDESC: byte pointer to nth-1 source address
; nth-1 source length
;
;Register usage:
; 2 through 7 are used by MOVSLJ
;
; T5 Destination length
; P1 Destination byte pointer
CARG==12 ;Pointer to current argument
LL==13 ;Copy of argument list pointer for loop
CNT==14 ;[3242] Count AC for AOBJN loop
; L Argument list pointer
; P Stack pointer
HELLO (CONCM.) ;Beginning of CONCM. routine
PUSHJ P,SAVAC% ;Save registers
SETZ T5, ;Initialize destination length
XMOVEI LL,1(L) ;[3242] Point to second entry in argument block
HLLZ CNT,-1(L) ;[3242] Number of arguments
AOBJN CNT,SIZLUP ;[3242] Don't count the destination descriptor
SIZLUP: XMOVEI CARG,@(LL) ;Get next descriptor address
ADD T5,1(CARG) ;Add source count
ADDI LL,1 ;[3242] Point to next arg
AOBJN CNT,SIZLUP ;[3242] Get next size
CONSIZ: XMOVEI CARG,@(L) ;Address of destination pointer
CAMLE T5,1(CARG) ;Compare the actual length with the descriptor
;Abort if actual length .GT. descriptor length
$FCALL CLE,ABORT.##
; LERR (LIB,?,<Concatenation result larger than expected>,,ABORT.##)
MOVEM T5,1(CARG) ;Store destination count
MOVE P1,@(L) ;Load destination pointer
PUSHJ P,CLR35% ;Clear bit 35 of destination words
PUSHJ P,CONC% ;Do the multiple source concatenation
PJRST RESAC% ;Restore registers and return
PRGEND
TITLE CONCD. Dynamic length concatenation
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
EXTERN %CHALC, CONC%, RESAC%, SAVAC%
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
; CONCD. will concatenate a series of source strings to a
; destination string in dynamic storage. The length of the
; destination is computed at run-time by calling CONCL. The
; destination is a .Qnnnn variable. Overlap never occurs.
;
; The algorithm is:
;
; save the ac's
; compute size of result in characters
; call %CHALC to allocate the dynamic space
; do the concatenations to the dynamic space
; restore the ac's
;
; Before CONCD. is called:
;
; Allocate enough stack space to accommodate the result. CONCD.
; will not pad, truncate, or check for overlap.
;
; To call CONCD.:
;
; XMOVEI L,ARGBLK
; PUSHJ P,CONCD.
;
; -N,,0
; ARGBLK: IFIW 15,ADESC
; IFIW 15,BDESC
; ... ........
; ... ........
; IFIW 15,NDESC
;
; ADESC: byte pointer to destination address
; destination length
;
; BDESC: byte pointer to first source address
; first source length
; ......................
; ......................
; NDESC: byte pointer to nth-1 source address
; nth-1 source length
;
;Register usage:
;
; T5 Destination length
; P1 Destination byte pointer
CARG==12 ;Pointer to current argument
LL==13 ;Copy of argument list pointer for loop
CNT==14 ;[3242] Count AC for AOBJN loop
; L Argument list pointer
; P Stack pointer
HELLO (CONCD.) ;Beginning of CONCD. routine
PUSHJ P,SAVAC% ;Save registers
SETZ T5, ;[3130] Initialize destination length
XMOVEI LL,1(L) ;[3242] Move argument block address
HLLZ CNT,-1(L) ;[3242] Number of arguments
AOBJN CNT,SIZLUP ;[3242] Don't count the destination descriptor
SIZLUP: XMOVEI CARG,@(LL) ;[3130] Get next descriptor address
ADD T5,1(CARG) ;[3130] Add source count
ADDI LL,1 ;[3242] Point to next arg
AOBJN CNT,SIZLUP ;[3242] Get next count
PUSHJ P,%CHALC ;[4101] Allocate dynamic space for the result
EXCH T5,P1 ;[3130] Put in descriptor order
DMOVEM T5,@(L) ;[3130] Save in .Q variable in argument list
EXCH T5,P1 ;[3130] Put in MOVSLJ order
PUSHJ P,CONC% ;Do the multiple source concatenation
PJRST RESAC% ;Restore registers and return
PRGEND
TITLE OVRLP% Check for overlap
SUBTTL */AHM/PLB/TJK
SEARCH MTHPRM,FORPRM
SEGMENT CODE
ENTRY OVRLP%
SALL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
; OVRLP% checks to see if any destination byte will be used as a
; source after it has been written into. Several source strings
; will be moved into the destination. If any source byte comes
; from the part of the destination that is already written into,
; we have overlap.
;
; Consider what happens when the first source string has 5
; characters in it:
;
; destination =================
; first 5 chars of dest .....============
;
; ok ----- (S + len .LE. D)
; overlap -----
; ok ----- (S .GE. D)
; ok ----- (S .GE. D)
;
;
; Now if a 3 character string is moved into the destination:
;
; first L chars of dest +++++...=========
;
; ok --- (S + len .LE. D0)
; overlap ---
; overlap ---
; ok --- (S .GE. D)
;
;
; Looking at the above pictures, it is clear that
;
; if S = source start address
; D = destination start address
; D0 = start address of entire destination string
; len = number of characters to be moved
;
; There will be no overlap moving the source string into the
; destination buffer if and only if
;
; S .GE. D (source start is right of destination start)
; or
; S + len .LE. D0 (source end is left of entire destination string)
;Register usage:
SPT==T1 ;Source pointer
SA==2 ;Source address
SLN==3 ;Source length - shares with DPT
DPT==3 ;Destination pointer - shares with SLN
DA==4 ;Destination address
DBEG==5 ;Beginning of entire destination string
LL==13 ;Copy of argument list pointer for loop
CNT==14 ;[3242] Count AC for AOBJN loop
SECX5==15 ;[3242] Our section number times 5
; Macro to convert 7-bit byte pointer in AC to character address.
; Destroys AC, leaves result in AC + 1
DEFINE CHADDR (AC,%END) <
JUMPL AC,[ ;; "ILDB type" one word local byte pointer ?
TLNE AC,200000 ;;[3242] No, OWGBP or 440700 ?
JRST [ ;;[3242] Its a OWGBP
LSHC AC,-^D30 ;;[3242] Put addr in AC+1
LSH AC+1,-^D6 ;;[3242] Right justify the addr
IMULI AC+1,5 ;;[3242] Change character addr
ADDI AC+1,-61(AC) ;;[4075] Add alignment
JRST %END] ;;[3242] All done
ADD AC,[010700000000-440700000000-1] ;; Change 440700,,FOO
JRST .+1] ;; to 010700,,FOO-1
MULI AC,5 ;; Change to character address
SUB AC+1,MAGIC(AC) ;; Remove vestiges of P and S fields
ADD AC+1,SECX5 ;;[3242] Insert our section number
%END: ;;[3242] Come from OWGBP computation
> ;end CHADDR
MAGIC: 054300000000-5
104300000000-4
134300000000-3
164300000000-2
214300000000-1
OVRLP%: XMOVEI SECX5,. ;[3242] Get our address
TRZ SECX5,-1 ;[3242] Leave just the section number
IMULI SECX5,5 ;[3242] Change to a character address
XMOVEI LL,1(L) ;[3242] Point to second entry in argument block
HLLZ CNT,-1(L) ;[3242] Number of arguments
MOVE DPT,@(L) ;[3242] Get destination pointer
CHADDR DPT ;Convert to character address
;DPT is never used again!!!
MOVEM DA,DBEG ;Save beginning of entire destination
JRST ENDLP
LP: DMOVE SPT,@(LL) ;Get source pointer, source length
MOVEM SA,SLN ;Save source length
CHADDR SPT ;Convert to character address
CAML SA,DA ;Ok if source starts after or at start
; of destination
JRST ELP ;No overlap
ADD SA,SLN ;Add source length, get end + 1 of source
CAMLE SA,DBEG ;Ok if source ends before start of destination
JRST OV ;Overlap
ELP: ADD DA,SLN ;Add source length to destination, get end + 1
; of destination
ADDI LL,1 ;[3242] Point to next arg
ENDLP: AOBJN CNT,LP ;[3242] Go test next source
TDZA T0,T0 ;No overlap - return 0
OV: SETO T0, ;Overlap - return -1
POPJ P, ;Return to library routine
PRGEND
TITLE ANSOVL - Check for ANSI overlap in character strings
SUBTTL Mike Boucher/MRB
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++ ;[4100]This is a new routine
; FUNCTIONAL DESCRIPTION
;
; This routine will check for overlap between the source string and
; the destination string. Checks to see if part of the destination
; string will be used as the source. Several source strings can be
; moved into the destination. If any source byte comes from the
; destination we have overlap. If an overlap condition occurs a
; warning error will be displayed.
;
; if S = source start address
; D = destination start address
; len = number of characters to be moved
;
; Consider the following examples:
;
; String =============
; 1- Source ===== (S + len .LE. D) = No Overlap
; Dest =====
; 2- Source ===== (S .GE. D + len) = No Overlap
; Dest =====
; 3- Source ===== (S + len .GT. D) = Overlap
; Dest =====
; 4- Source ===== (S .LT. D + len) = Overlap
; Dest =====
;
; CALLING SEQUENCE
;
; SKIPE %FLIDX
; PUSHJ P, ANSOVL
;
; INPUT PARAMETERS
;
; None
;
; IMPLICIT INPUTS
;
; S = source start address
; D = destination start address
; D0 = start address of entire destination string
; len = number of characters to be moved
;
;
; OUTPUT PARAMETERS
;
; None
;
; IMPLICIT OUTPUTS
;
; None
;
; SIDE EFFECTS
;
; May output an warning message.
;
;--
SEARCH MTHPRM,FORPRM
SEGMENT CODE
ENTRY ANSOVL
EXTERN FLGON.
SALL
;Register usage:
SPT==T1 ;Source pointer
SBEG==2 ;Source address
SEND==3 ;Source length - shares with DPT
DPT==3 ;Destination pointer - shares with SLN
DBEG==4 ;Destination address
DEND==5 ;Beginning of entire destination string
LL==13 ;Copy of argument list pointer for loop
CNT==14 ;[3242] Count AC for AOBJN loop
SECX5==15 ;[3242] Our section number times 5
; Macro to convert 7-bit byte pointer in AC to character address.
; Destroys AC, leaves result in AC + 1. This macro is copied from OVRLP%
DEFINE CHADDR (AC,%END) <
JUMPL AC,[ ;; "ILDB type" one word local byte pointer ?
TLNE AC,200000 ;;[3242] No, OWGBP or 440700 ?
JRST [ ;;[3242] Its a OWGBP
LSHC AC,-^D30 ;;[3242] Put addr in AC+1
LSH AC+1,-^D6 ;;[3242] Right justify the addr
IMULI AC+1,5 ;;[3242] Change character addr
ADDI AC+1,-61(AC) ;;[4075] Add alignment
JRST %END] ;;[3242] All done
ADD AC,[010700000000-440700000000-1] ;; Change 440700,,FOO
JRST .+1] ;; to 010700,,FOO-1
MULI AC,5 ;; Change to character address
SUB AC+1,MAGIC(AC) ;; Remove vestiges of P and S fields
ADD AC+1,SECX5 ;;[3242] Insert our section number
%END: ;;[3242] Come from OWGBP computation
> ;end CHADDR
MAGIC: 054300000000-5
104300000000-4
134300000000-3
164300000000-2
214300000000-1
ANSOVL: XMOVEI SECX5,. ;Get our address
TRZ SECX5,-1 ;Leave just the section number
IMULI SECX5,5 ;Change to a character address
XMOVEI LL,1(L) ;Point to second entry in argument block
HLLZ CNT,-1(L) ;Number of arguments
DMOVE DPT,@(L) ;Fetch destination byte pointer and len
MOVEM DBEG,DEND ;move len to DEND
CHADDR DPT ;Convert byte poinnter to chr addr
;DBEG contains begining addr of dest
ADD DEND,DBEG ;Calc end (plus 1) address of dest
JRST ENDLP
LOOP: ;Loop for each source
DMOVE SPT,@(LL) ;Get source pointer, source length
MOVEM SBEG,SEND ;Save source length
CHADDR SPT ;Convert to character address
ADD SEND,SBEG ;Add source length, get end + 1 of source
CAMG SEND,DBEG ;If source ends before start of destination
JRST NOOV ; No Overlap.
; -- OR --
CAML SBEG,DEND ;If source starts after destination ends
JRST NOOV ; then No Overlap.
JRST OV ; else there is overlap.
NOOV: ADDI LL,1 ;Point to next source
ENDLP: AOBJN CNT,LOOP ;Go test next source
POPJ P, ;No overflow, Return
OV: MOVEI T1,VAXIDX+ANSIDX;Flag this as an incompatibility for both.
SKIPE [FLGON.] ;Is VAX compatbility flagging on ?
$FCALL CFO ;Yes; display the compatibility message
POPJ P, ;Return to library routine
PRGEND ;End of routine ANSOVL
TITLE CLR35% Clear bit 35 of destination
SEARCH MTHPRM,FORPRM
SEGMENT CODE
ENTRY CLR35%
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
; CLR35% clears bit 35 in the destination words for a
; concatenation operation. It is passed the byte pointer to the
; destination in P1 and the length of the destination in
; characters in T5.
;
;Register usage:
;
; T1 Number of words in result
; T5 Destination length - setup by caller
; P1 Destination byte pointer - setup by caller
LL==13 ;Pointer to the word to clear
; L Original argument list pointer
; P Stack pointer
CLR35%: MOVE T1,T5 ;Length of destination
ADDI T1,IBPW - 1 ;Round up to a full word
IDIVI T1,IBPW ;Number of bytes per word
MOVE LL,P1 ;Address of destination
IBP LL ;Point at first actual character
HLRZ T2,LL ;Get left half of byte pointer
CAIL T2,450000 ;One word global byte pointer ?
TLZA LL,770000 ;[3242] Yes, mask out the P&S bits
HRLI LL,(IFIW) ;[3242] No, make into local index
MOVEI T2,1 ;Only touch bit 35
CLEAR: ANDCAM T2,0(LL) ;Clear bit 35
AOJ LL, ;[3242] Point to next word
SOJG T1,CLEAR ;[3242] Go do more
POPJ P, ;Return
PRGEND
TITLE CONC% Common code for concatenations
SEARCH MTHPRM,FORPRM
SEGMENT CODE
ENTRY CONC%
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
; CONC% is the common concatenation routine. It is passed the
; destination byte pointer in P1 and the destination length in
; T5. It scans the argument list to pickup the source byte
; pointers and lengths.
;Register usage:
; 2 through 7 are used by MOVSLJ
;
; T2==2 ;Source length
; T3==3 ;Source byte pointer
; 4 Second word of source byte pointer is unused
; T5 Destination length - setup by caller
; P1 Destination byte pointer - setup by caller
; 7 Second word of destination byte pointer is unused
DREM==11 ;Number of unused characters in destination
LL==13 ;Local argument list pointer to AOBJN
CNT==14 ;[3242] Count AC for AOBJN loop
; L Argument list pointer
; P Stack pointer
CONC%: MOVE DREM,T5 ;Init remainder count
XMOVEI LL,1(L) ;[3242] Point to second entry in argument block
HLLZ CNT,-1(L) ;[3242] Number of arguments
AOBJN CNT,ARGLUP ;[3242] Don't count the destination descriptor
ARGLUP: DMOVE T2,@(LL) ;Load source descriptor
EXCH T2,T3 ;Put in order for MOVSLJ
MOVE T5,T2 ;Move source without filling
CAML T5,DREM ;Enough space remaining
MOVE T5,DREM ;No - only fill up remainder
SUB DREM,T5 ;Update remainder
EXTEND T2,[MOVSLJ
" "] ;Do the move without filling
JFCL ; Source was greater than destination, continue
JUMPLE DREM,CNCBYE ;No more destination - done
ADDI LL,1 ;[3242] Point to next arg
AOBJN CNT,ARGLUP ;[3242] Get next count
SETZM T2 ;No source
MOVE T5,DREM ;Remaining dest
EXTEND T2,[MOVSLJ
" "] ;Move string, space fill
JFCL ;No truncation expected here
CNCBYE: POPJ P, ;Return
PRGEND
TITLE RELAT. Character relationals
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
; Relationals perform byte-by-byte comparisons, left-justified,
; of two character strings, with the shorter string effectively
; padded with spaces to the length of the longer. Returns with
; T0=-1 if the relation specified is true, T0=0 if the relation
; is false.
;
; To call a relational:
;
; XMOVEI L,ARGBLK
; PUSHJ P,Lxx.
;
; -N,,0
; ARGBLK: IFIW 15,ADESC
; IFIW 15,BDESC
;
; ADESC: byte pointer to first source address
; first source length
; BDESC: byte pointer to second source address
; second source length
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
;Register usage:
;
; T0 type of comparison to perform
; T1 unused
;; T2==2 ;First operand length
;; T3==3 ;First operand byte pointer
; 4 ;Second word of first operand byte pointer is unused
; T5==5 ;Second operand length
; P1==6 ;Second operand byte pointer
; 7 ;Second word of Second operand byte pointer is unused
; L Argument list pointer
; P Stack pointer
HELLO (LEQ.) ;Beginning of LEQ. routine
;[3013] Library routine name
JSP T1,COMPAR ;Do the comparison
CMPSE
" "
" "
HELLO (LNE.) ;Beginning of LNE. routine
;[3013] Library routine name
JSP T1,COMPAR ;Do the comparison
CMPSN
" "
" "
HELLO (LLT.) ;Beginning of LLT. routine
;[3013] Library routine name
JSP T1,COMPAR ;Do the comparison
CMPSL
" "
" "
HELLO (LLE.) ;Beginning of LLE. routine
;[3013] Library routine name
JSP T1,COMPAR ;Do the comparison
CMPSLE
" "
" "
HELLO (LGT.) ;Beginning of LGT. routine
;[3013] Library routine name
JSP T1,COMPAR ;Do the comparison
CMPSG
" "
" "
HELLO (LGE.) ;Beginning of LGE. routine
;[3013] Library routine name
JSP T1,COMPAR ;Do the comparison
CMPSGE
" "
" "
COMPAR: DMOVEM T2,SAVACS ;[3204] Save T2, T3
DMOVEM T4,SAVACS+2 ;[3204] Save T4, T5
DMOVEM P1,SAVACS+4 ;[3204] Save P1, P1+1
DMOVE T2,@(L) ;First descriptor
EXCH T2,T3 ;reverse the order
DMOVE T5,@1(L) ;Second descriptor
EXCH T5,P1 ;Reverse the order
JUMPLE T2,BADLEN ;Test for illegal length
JUMPLE T5,BADLEN ;Test for illegal length
TLNN T2,(777B8) ;[3243] Forbidden field non-zero ?
TLNE T5,(777B8) ;[3243] Forbidden field non-zero ?
JRST BADLEN ;[3243] Yes, complain
EXTEND T2,(T1) ;Do the comparison
TDZA T0,T0 ;Set value = false
SETO T0, ;Set value = true
DMOVE T2,SAVACS ;[3204] Restore T2, T3
DMOVE T4,SAVACS+2 ;[3204] Restore T4, T5
DMOVE P1,SAVACS+4 ;[3204] Restore P1, P1+1
GOODBYE ;Return
BADLEN:
$FCALL ICE,ABORT.##
; LERR (LIB,?,<Illegal length character expression>,,ABORT.##)
SEGMENT DATA
SAVACS: BLOCK 6 ;[3204] For saving the 6 ACs starting at T2
PRGEND
TITLE CHAR Integer to character conversion
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
NOSYM
ENTRY CHAR
EXTERN CHAR.
CHAR=CHAR.
PRGEND
TITLE CHAR.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
SEARCH MTHPRM,FORPRM
SEGMENT CODE
SALL
HELLO (CHAR,.) ;[3032] Integer to character type conversion
;CH = CHAR(I)
MOVE T0,@0(L) ;Get copy of byte pointer to smash
MOVE T1,@1(L) ;Get the integer value we want to characterize
IDPB T1,T0 ;Store into the string
GOODBYE ;Return
PRGEND
TITLE ICHAR Character to integer conversion
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
NOSYM
ENTRY ICHAR
EXTERN ICHAR.
ICHAR=ICHAR.
PRGEND
TITLE ICHAR.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
SEARCH MTHPRM,FORPRM
SEGMENT CODE
SALL
HELLO (ICHAR,.)
MOVE T0,@(L) ;Get byte pointer
ILDB T0,T0 ;Get first character of character variable
GOODBYE ;Return
PRGEND
TITLE LEN Length of character expresssion function
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
NOSYM
ENTRY LEN
EXTERN LEN.
LEN=LEN.
PRGEND
TITLE LEN.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
SEARCH MTHPRM,FORPRM
SEGMENT CODE
SALL
HELLO (LEN,.) ;[3032] Length of a character entity
;I = LEN(CH)
XMOVEI T1,@(L) ;Get address of character desciptor
MOVE T0,1(T1) ;Fetch length word
GOODBYE ;Return
PRGEND
TITLE INDEX Index of substring within character expression
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
NOSYM
ENTRY INDEX
EXTERN INDEX.
INDEX=INDEX.
PRGEND
TITLE INDEX.
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1982, 1986
;ALL RIGHTS RESERVED.
; INDEX is a Fortran library function to return the location of a
; substring in a target string, or 0 if the substring does not
; occur.
;
; To call INDEX:
;
; XMOVEI 16,ARGBLK
; PUSHJ 17,INDEX.
;
; ARGBLK:
; IFIW 15,target descriptor
; IFIW 15,substring descriptor
;
; Target is the string in which the substring is being looked for.
; Called in Fortran as a function: INDEX(target,substring)
;
; Algorithm checks the first letter of the substring vs a single letter
; of the target to see if they match. If they do, it then compares the
; for the rest of the length of the substring. It continues this way,
; moving down the target, until it either finds the position in the
; target that matches the substring, or it becomes impossible to do so.
; The location of the substring in the target is returned, or if not
; findable, 0.
T5==5
T6==6
T7==7
T10==10
T11==11
T12==12
T13==13
T14=14
EXTERN SAVAC%,RESAC%
; T0 = Displacement into target
; (number of times through LOOP)
; T1 = *Size of substring
; T2 = *BP of substring
; T3 = * unused
; T4 = *Size of substring
; T5 = *BP of target
; T6 = * unused
; T7 = Target BP for next character
; T10 = Length of target left to compare
; T11 = 1st char of substring
; T12 = 1st char of target
; T13 = Substring BP
; T14 = Substring length - 1
;
; * = Used in compare string instruction
HELLO (INDEX,.) ;Entry to INDEX function
PUSHJ P,SAVAC% ; Save ac's
; Get the information needed from the arguments passed.
DMOVE T7,@0(L) ;T7=BP of target string
;T10=Length of target string
DMOVE T13,@1(L) ;T13=BP of substring
;T14=Length of substring
SOJ T14, ;Subtract one
ILDB T11,T13 ;1st char of substring
;(T13 now points to 2nd character of substring)
SETZ T0, ;Zero count of times through loop
; Loop through as long as there is enough target string to compare.
LOOP: CAML T14,T10 ;Is there enough target to compare?
JRST NOTFND ; No, return 0
AOJ T0, ;Add 1 to current displacement in target
; Compare the 1st letter of the substring and the 1st letter at the
; current place in the target.
ILDB T12,T7 ;Next char of target
CAME T11,T12 ;1st letters equal?
SOJA T10,LOOP ;Length of target left
; The single characters are equal. Compare the remaining length of the
; substring to target now. If the the substing is only one character
; (T14=0), then we've matched the substring; return.
JUMPE T14,RESAC% ;Only one character, it was found.
MOVE T1,T14 ;Size of substring
MOVE T2,T13 ;BP for substring
MOVE T4,T14 ;Size of target (same as substring)
MOVE T5,T7 ;BP for target
EXTEND T1,[CMPSE ;Compare substring to target
" " ;Fill with spaces
" "] ;Fill with spaces
SOJA T10,LOOP ;Length of target left
;Not equal, If at first you don't succeed...
PJRST RESAC% ;Restore saved AC's and return to caller.
;Finis, the substring was found in the target
NOTFND: SETZ T0, ;Not found, return 0
PJRST RESAC% ;Restore saved AC's and return to caller.
PRGEND
TITLE SAVAC%-RESAC% Save and restore registers routine
SEARCH MTHPRM,FORPRM
FSRCH
SEGMENT CODE
ENTRY SAVAC%, RESAC%
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
; SAVAC% is used in conjunction with RESAC%. SAVAC% should be the
; first stack operation performed by the string sub-routine.
; SAVAC% saves registers 2-15 on the stack, beginning at the
; location pointed to by the stack- pointer. SAVAC% returns with
; all registers intact except T1 & P.
;
; Upon completion of string operation, a PJRST to RESAC% restores
; registers 2-15 and POPJ's to next higher-level caller.
FIRST==2 ;[3242] First AC to save
LAST==15 ;[3242] Last AC to save
SAVAC%: MOVEM LAST,ACS+LAST ;[3242] Save LAST
MOVE LAST,[FIRST,,ACS+FIRST] ;[3242] Point to the start of the block
BLT LAST,ACS+LAST-1 ;[3242] Save FIRST:LAST-1
POPJ P, ;[3242] Return to library routine
RESAC%: MOVS LAST,[FIRST,,ACS+FIRST] ;[3242] Point to the AC save block
BLT LAST,LAST ;[3242] Restore FIRST:LAST
GOODBYE ;Return to user routine
SEGMENT DATA
ACS==.-FIRST
BLOCK LAST-FIRST+1 ;[3242] Place to save the ACs
SEGMENT CODE
PRGEND
TITLE CHRSTK - Character stack routines
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;ALL RIGHTS RESERVED.
;***********************************************************************
; Dynamic character stack manipulation. Variables used in manipulation:
;
; %CHBOT Points to the bottom (beginning) of the character stack.
;
; CHRPT. Points to where to allocate on the stack next. Below
; this is being used, and above this is not. This value
; is saved in the user's program (.Qnnnn) before a
; character operation to unwind the stack with afterwards.
;
; %CHTOP Points to the top (end) of the physical character stack.
; Any memory beyond this may belong to someone else, and
; must be allocated to the stack.
;
;
; ^ ^
; %CHTOP -> | Not alloc |
; +-------------+
; | Not used |
; CHRPT. -> | |
; + - - - - - - +
; | Char data |
; %CHBOT -> | |
; +-------------+
;
;(See definitions in CHRPTR module for more complete description.)
;***********************************************************************
SEARCH MTHPRM,FORPRM
FSRCH
SALL
SEGMENT CODE
;External symbols
EXTERN ABORT., %CHBOT, CHRPT., %CHTOP
EXTERN FUNCT., RESAC%, SAVAC%
;Routines defined below
ENTRY %CHALC, %CREST, %EXPST
SUBTTL CHMRK. - Mark the character stack
;++
; FUNCTIONAL DESCRIPTION:
;
; CHMRK. - Marks (saves) where the current character stack pointer
; is and may create the character stack by calling %CREST. The
; current pointer is saved into the variable (usually a .Qnnnn)
; specified by the 1st and only arg. All registers are preserved.
;
; CALLING SEQUENCE:
;
; Called from code generated by the Fortran compiler;
;
; CALL CHMRK.(.Qnnnn)
;
; INPUT PARAMETERS:
;
; None
;
; IMPLICIT INPUTS:
;
; CHRPT. Current pointer for where to next store char data
;
; OUTPUT PARAMETERS:
;
; .Qnnnn Where to store CHRPT. before it's used.
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; At end of this routine, may allocate memory (sections or pages)
; for the character stack.
;
;--
;[4101] Rewritten
; ECHSIZ is the number of words for creating character
; stack. Make character stack one section
; for extended addressing. 0 .LT. size
; .LE. 0,,777760 will default to
; allocating one section of stack space,
; due to algorithm used.
HELLO (CHMRK.)
PUSH P,T1 ;Save AC's
PUSH P,T5
SKIPE CHRPT. ;Does stack already exist?
JRST CHRET ;Yes, "mark" and return
;Determine which default size to use.
MOVEI T5,ICHRSZ ;Non extended default size
XMOVEI T1,0 ;Get section number for AC 0
SKIPE T1 ;Non zero section?
MOVX T5,ECHSIZ ;Yes, need different size for non-zero section
PUSHJ P,%CREST ;Create stack
CHRET: MOVE T1,CHRPT. ;Get current pointer
MOVEM T1,@(L) ;Save the pointer in user's .Qnnnn
POP P,T5 ;Restore AC's
POP P,T1
GOODBYE ;Return
; CHUNW. - to "unwind" the stack pointer, which is merely placing
; the value given by the 1st and only arg into the current
; character stack pointer. All registers are preserved.
;
; Calling sequence:
;
; XMOVEI 16,nM
; PUSHJ 17,CHUNW.
;
; -1,,0
; nM: IFIW 2,.Qnnnn
;
HELLO (CHUNW.)
PUSH P,@(L) ;GET THE UNWOUND PNTR
POP P,CHRPT. ;SAVE IT
GOODBYE
SUBTTL %CHALC - Allocate space on the character stack
;++
; FUNCTIONAL DESCRIPTION:
;
; %CHALC - Allocates room for a character temporary on the
; character stack. Called primarily by the concatenation and
; character assignment routines.
;
; CALLING SEQUENCE:
;
; MOVE T5,[Size]
; PUSHJ P,%CHALC
;
; INPUT PARAMETERS:
;
; T5 Integer length to allocate in characters
;
; IMPLICIT INPUTS:
;
; CHRPT. Current pointer for where to next store char data
;
; OUTPUT PARAMETERS:
;
; P1 The byte pointer to the allocated space
;
; IMPLICIT OUTPUTS:
;
; CHRPT. Current pointer for where to next store char data
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; May allocate memory (pages/sections) to expand character stack.
;
;--
;[4101] Rewritten
;
;Register usage:
;
; T1 Scratch register
; T2 Scratch register
; T3 Scratch register
; T5 Destination length - setup by caller
; P1 Destination byte pointer - returned to caller
; L Original argument list pointer
; P Stack pointer
%CHALC: SKIPN CHRPT. ;Any stack allocated yet?
$FCALL NCS,ABORT. ;No. Compiler error!!
PUSH P,T5 ;Save AC
;Convert characters to words.
ADDI T5,IBPW-1 ;[3130] Round up to next word boundary
IDIVI T5,IBPW ;[3130] Convert from charcters to words
; If P1 .NE. P1 (non adjacent
; registers), then we have to save
; P1, since the remainder goes here.
;See if we have enough space already without expanding the
;stack.
MOVE P1,T5 ;Copy desired length
ADD P1,CHRPT. ;Add current pointer
CAMLE P1,%CHTOP ;Beyond allocated space?
PUSHJ P, %EXPST ;Expand the stack
MOVE P1,CHRPT. ;Copy current pointer
$BLDBP P1 ;[3130] Create a byte pointer to beginning
;[3130] of area allocated
ADDM T5,CHRPT. ;Calculate new CHRPT. value.
;Set CHRPT. beyond what was asked for.
POP P,T5 ;Restore AC
POPJ P,
SUBTTL CHRCLR - Clears character data space
;++
; FUNCTIONAL DESCRIPTION:
;
; Routine clears the core area between CADDR and CADDR+CSIZE
;
; CALLING SEQUENCE:
;
; Set CADDR and CSIZE
; PUSHJ P,CHRCLR
;
; INPUT PARAMETERS:
;
; None
;
; IMPLICIT INPUTS:
;
; CADDR Start of memory to zero.
; CSIZE Size of memory to zero.
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; Memory is zeroed.
;
;--
CHRCLR: PUSH P,T1 ;[4101] Save T1
PUSH P,T2 ;[4101]
MOVE T1,CADDR ;GET BASE ADDR
TLNN T1,-1 ;EXTENDED SECTION?
JRST ZBLT ;NO. CLEAR WITH BLT
MOVE T1,CSIZE ;GET SIZE
SUBI T1,1 ;[3145] Move n-1 words to clear n words
MOVEM T3,SAVET3 ;SAVE T3
MOVE T2,CADDR ;GET BOTTOM ADDR AGAIN
SETZM (T2) ;CLEAR 1ST WORD
XMOVEI T3,1(T2) ;[3145] Get "TO" address
EXTEND T1,[XBLT] ;CLEAR THE CORE AREA
MOVE T3,SAVET3 ;RESTORE T3
JRST CLRET ;[4101] Return
ZBLT: SETZM (T1) ;CLEAR THE FIRST WORD
HRLI T2,(T1) ;CREATE BLT PNTR
HRRI T2,1(T1)
ADD T1,CSIZE
BLT T2,-1(T1) ;CLEAR THE CORE AREA
CLRET: POP P,T2 ;[4101] RESTORE T1, T2
POP P,T1 ;[4101]
POPJ P,
SUBTTL %CREST - Creates the character stack
;++
; FUNCTIONAL DESCRIPTION:
;
; Creates the character stack (if not done already). The size of
; the stack is set to the size passed by the caller (or bigger).
;
; When running under extended addressing, we allocate the stack in
; whole unique sections (no one else using them). The first
; section we try for is section 1. If section 1 is free, then we
; must NOT allocate the first 20 (octal) words of it, since the
; AC's are kept in 1,,0 through 1,,17 for any program running in a
; non-zero section.
;
; CALLING SEQUENCE:
;
; MOVE T5,[Length in words]
; PUSHJ P,%CREST
;
; INPUT PARAMETERS:
;
; T5 Length of the stack to create in words
;
; IMPLICIT INPUTS:
;
; CHRPT. Current pointer for where to next store char data
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; CHRPT. Current pointer for where to next store char data
; %CHBOT Points to the bottom of the char stack
; %CHTOP Points to the end of the character stack
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; Memory is assigned to the user's program. This may map sections
; to the user, or allocate pages.
;
;--
;[4101] new routine
%CREST: SKIPE CHRPT. ;Does the stack exist already?
POPJ P, ;Yes, nothing to do, so return.
IF20,<
; Whether we're running in section 0 determines what kind of
; character stack to build.
XMOVEI T1,0 ;Get section # AC 0 is in
JUMPE T1,ALCMRK ;Jump if section zero
;Running in non zero section. Calculate the number of sections
;needed. We allocate the stack in multiples of sections only.
;
;Register usage:
;
;T0 Number of sections needed
;T1,T2,T3 Scratch
;T4 Number of sections remaining (T0 decremented)
;T5 [sections,,words] size to create stack
;P1 Section number being tried
;P2 Set to 1 if we need to allocate another section in order
; to avoid the AC's in section one. This is used later to
; decide how many sections we got.
; Calculate the number of sections we need.
CRNZER: PUSHJ P,SAVAC% ;Save AC's
MOVE T0,T5 ;Copy # words needed
ADDI T0,777777 ;Round up to the next section number
; (If not [n,,0], then round up.)
HLRZ T0,T0 ;Move to get the number of sections.
CAILE T0,36 ;Can't possibly ask for more than 36 sections.
; Must be running in one, section 0 is
; not available, and 40-2 = 36 (base 8).
$FCALL CCS,ABORT. ;Error - Not enough free sections for
; creating character stack
SETZB P1,P2 ;Start at section 1 (one is added in loop)
; Don't need an additional section to
; save the AC's in section 1 - yet.
MOVE T4,T0 ;Copy # sections needed (to decrement in loop)
;The first section is section one right now. Since we ask for
;full sections, make sure the size would not include the AC's,
;since the AC's are in section 1 when running in a non-zero
;section. If so, then ask for another section, only when
;starting at section 1. (If section 1 is not the first in the
;character stack, then everything's fine.)
;Check the right half of the orginal length requested. The
;length in words has the number of sections in the left half and
;the partial sections in the right ([sections,,words]). If right
;half is:
; o zero (the caller asked for a whole number of sections)
; o greater than (1000000 - 20) (base 8)
;then what we've decided to give includes the AC's and we need
;another section.
HRRZ T2,T5 ;Number of words requested by caller
JUMPE T2,CRPTAC ;If .EQ. 0, then we need to protect AC's
CAIG T2,777760 ;.GT. largest number of words not
; including AC's?
JRST CRLOOP ;No, section's ok
;We need another section. Add one to the local count of how
;many sections we need. If there aren't enough starting with
;section 1, then this will be set back to the old original
;number, since we won't need to protect the AC's.
CRPTAC: ADDI T4,1 ;Need one more section (for this pass
; through the loop)
MOVEI P2,1 ;This is a flag for later that we need
; an extra section, because of the need
; to avoid the AC's
;Loop through sections 1 through 37 (if necessary), trying to
;get the number of contiguous sections specified by caller. Get
;them one section each time through the loop. Stop when the
;"needed number" (in T4) is decremented to 0. Start over again
;if we can't get enough contiguous sections.
CRLOOP: ADDI P1,1 ;Next contiguous section to try
HRR T1,P1 ;1/[,,Section Number]
HRLI T1,.FHSLF ;1/[Fork Handle,,section number]
RSMAP% ;Ask montitor if this section's mapped
;(Call changes T1, T2)
$FJCAL IJE,ABORT. ;Internal Forots JSYS Error
AOJE T1,CRCONT ;Is return value -1? (Page free?)
; If so, then ok, continue to see if we
; need more sections.
;Start over with a new first section, searching for the number
;of sections needed. Must reset values.
CRNEXT: MOVE T4,T0 ;Restore # of needed sections
SETZ P2, ;We are not starting at section 1,
; so we don't need to avoid the AC's
;Check if we can get the needed number of sections out of what
;is left (could be hopeless).
;((Section #) + (needed # of sections) .LE. 40)
MOVE T2,T0 ;# of needed sections
ADD T2,P1 ;(Section #) + (needed # of sections)
CAIGE T2,40 ;Is the proposed top of stack .GT. 40?
; (this allocates 37, not 40.)
JRST CRLOOP ;No, continue with getting sections
$FCALL CCS,ABORT. ;Error - Not enough free sections for
; creating character stack
CRCONT: SOJG T4,CRLOOP ;One less section needed.
; If we need more sections (.GT.0) then
; loop again
;Got all the sections we need! Set up globals, map the sections
;to us, and return to caller.
; P1 is the last section number mapped.
ADD T0,P2 ;Add an extra section if starting at
; section one and having to avoid the AC's
ADDI P1,1 ;Get the section above that last mapped
HRLZM P1,%CHTOP ;This is the top, where to expand stack
; from next
MOVE T2,P1 ;Copy top of stack
SUB T2,T0 ;Bottom = (Top) - (# sections)
HRLZ T1,T2 ;[Section number,,]
CAIN T2,1 ;If first is section one
ADDI T1,20 ; then eliminate the registers from the bottom
; of the stack.
MOVEM T1,%CHBOT ;Save bottom section
MOVEM T1,CHRPT. ;Current pointer, where to put data next time
;Map the sections to us.
SETZ T1, ;1/Create the section!
HRLI T2,.FHSLF ;2/[Fork Handle,,section number]
MOVX T3,SM%RD!SM%WR ;3/[Access Flags,,]
HRR T3,T0 ;3/[access flags,,Count of Sections]
SMAP% ;Map our section(s)
$FJCAL IJE,ABORT. ;Internal Forots JSYS Error
PJRST RESAC% ;Restore AC's and return
> ;End IF20
; Section zero. Call the ots for memory.
ALCMRK: PUSH P,T1 ;Save AC
MOVEI T1,FN%COR ;Get core any place
MOVEM T1,FCODE
MOVE T1,T5 ;Size of core to get
MOVEM T1,CSIZE
MOVEM L,SAVEL ;Save arg pointer
XMOVEI L,CHBLK
PUSHJ P,FUNCT. ;Get the core
MOVE L,SAVEL ;Restore arg pntr
SKIPE FNSTAT ;Check if successful
$FCALL CCS,ABORT. ;Error - Not enough free sections for
; creating character stack
MOVE T1,CADDR ;Get Addr of core
MOVEM T1,CHRPT. ;Save it
MOVEM T1,%CHBOT ;Save bottom of stack
ADD T1,CSIZE ;Get top ADDR+1
MOVEM T1,%CHTOP ;Save top of stack
PUSHJ P,CHRCLR ;Clear (zero) the core area
POP P,T1 ;Restore AC
POPJ P, ;Return to caller
SUBTTL %EXPST - Expand the character stack
;++
; FUNCTIONAL DESCRIPTION:
;
; Expand the existing character stack, if needed, to have the size
; specified by the caller in free stack space. (If we have enough
; now, don't bother!)
;
; The words must be available otherwise a fatal error occurs,
; since it is assumed that the user MUST have the memory
; requested.
;
; CALLING SEQUENCE:
;
; MOVE T5,[Size]
; PUSHJ P,%EXPST
;
; INPUT PARAMETERS:
;
; T5 Length to insure free on the stack.
;
; IMPLICIT INPUTS:
;
; CHRPT. Current pointer for where to next store char data
; %CHTOP Points to the end of the character stack
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; %CHTOP Points to the end of the character stack
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; Additional sections may be mapped to the user.
;
;--
;[4101] New routine
%EXPST: ;See if we have enough space already without expanding the
;stack.
MOVE T0,T5 ;Copy desired length
ADD T0,CHRPT. ;Add current pointer
CAMG T0,%CHTOP ;Beyond allocated space?
POPJ P, ;No, have enough now.
IF20,<
;Need to expand the stack. Must do it differently depending on
;whether we are running in a non-zero section.
XMOVEI T1,0 ;Get section number for AC 0
JUMPE T1,EXZER ;Branch if section zero
;Running in a non zero section. Get the added needed number of
;contiguous sections.
;T0 is the top of the region we need, and is beyond %CHTOP
;(CHRPT. + T5).
PUSHJ P,SAVAC% ;Save registers
SUB T0,%CHTOP ;Subtract top of stack to get number of
; words needed.
ADDI T0,777777 ;Round up to next section boundary
HLRZ T0,T0 ;Get the number of full sections needed
MOVE T4,T0 ;Make a copy of the number of sections
; needed. Will be decremented in loop.
HLRZ T3,%CHTOP ;Which section to start mapping at
;Loop to get the section(s) needed. If the RSMAP% succeeds, then
;SMAP% them, else give an error message.
;Register usage:
;
;T0 Master copy of the number of sections needed
;T1, T2 Scratch, needed for RSMAP%
;T3 Section number that we're trying. Incremented in loop.
;T4 Local copy of the number of sections needed. Is decremented
; in loop
;T5 Size that the caller asked for in words
EXLOOP: CAILE T3,37 ;Section number .LE. 37?
$FCALL ECS,ABORT. ;Error - Not enough memory for expanding
; character stack
MOVE T1,T3 ;1/[,,Section Number]
HRLI T1,.FHSLF ;1/[Fork Handle,,section number]
RSMAP% ;Ask montitor if this section's mapped
;(Call changes T1, T2)
$FJCAL IJE,ABORT. ;Internal Forots JSYS Error
AOJN T1,EXERR ;Is return value -1?
; If not, then we can't get enough sections.
ADDI T3,1 ;Next section number to get
SOJG T4,EXLOOP ;If we need more sections (count.GT.0)
; then loop again
;No one's using the section(s) yet, Map the section to us!
SETZ T1, ;1/Create a section!
HLRZ T2,%CHTOP ;2/[,,Section Number]
HRLI T2,.FHSLF ;2/[Fork Handle,,section number]
MOVX T3,SM%RD!SM%WR ;3/[Access Flags,,]
HRR T3,T0 ;3/[access flags,,Count of Sections]
SMAP% ;Map our section(s)
$FJCAL IJE,ABORT. ;Internal Forots JSYS Error
HRLZ T0,T0 ;Current top of stack's section
ADDM T0,%CHTOP ;Current + Size to expand = New top section
PJRST RESAC% ;Restore regs and return
> ; End IF20
;Running in Section 0. Get memory from the ots.
EXZER: PUSH P,T5 ;Save AC
ADDI T5,CHMSIZ ;[3130] Add a minimum length
MOVEM T5,CSIZE ;[3130] Save for FUNCT. call
MOVE T5,%CHTOP ;[3130] Setup for F.GAD
MOVEM T5,CADDR ;[3130]
MOVEI T5,FN%GAD ;[3130] Get memory at specific address
MOVEM T5,FCODE ;[3130]
MOVEM L,SAVEL ;Save arg pointer
XMOVEI L,CHBLK ;Argument block for call
PUSHJ P,FUNCT. ;Get lowseg core at current addr
MOVE L,SAVEL ;Restore argument pointer
SKIPE FNSTAT ;Did we succeed?
EXERR: $FCALL ECS,ABORT. ;Error - Not enough memory for
; expanding character stack
PUSHJ P,CHRCLR ;Clear the core area
MOVE T5,CSIZE ;[3130] Get size allocated
ADDM T5,%CHTOP ;[3130] Save new top addr
POP P,T5 ;Restore AC
POPJ P, ;Return
; Argument list for calling FUNCT.
-5,,0
CHBLK: IFIW TP%INT,FCODE
IFIW TP%LIT,[ASCIZ |FRS|] ;WE'RE CALLING FUNCT. FROM FORLIB
IFIW TP%INT,FNSTAT
IFIW TP%INT,CADDR
IFIW TP%INT,CSIZE
SEGMENT DATA
; Locations for calling FUNCT., referenced in arglist CHBLK
FCODE: BLOCK 1 ;FUNCT. CODE
FNSTAT: BLOCK 1 ;STATUS (0=OK)
CADDR: BLOCK 1 ;ADDR OF CORE
CSIZE: BLOCK 1 ;SIZE OF CORE AREA
; Save locations.
SAVET3: BLOCK 1 ;T3 SAVE
SAVEL: BLOCK 1 ;FOR ARG POINTER
SEGMENT CODE
PRGEND
TITLE KCHST. - Kills the character stack
SUBTTL CDM 24-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++
; FUNCTIONAL DESCRIPTION:
;
; Kill any remnants of the character stack at the beginning of
; execution of a program. This must be done in case the program
; is restarted.
;
; If sections were allocated to this program (running extended)
; before, they are returned so that this execution may reuse the
; memory.
;
; CALLING SEQUENCE:
;
; PUSHJ P,KCHST.
;
; INPUT PARAMETERS:
;
; None
;
; IMPLICIT INPUTS:
;
; Zeroed:
;
; %CHBOT Points to the bottom of the char stack
; CHRPT. Current pointer for where to next store char data
; %CHTOP Points to the end of the character stack
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; %CHBOT Points to the bottom of the char stack
; CHRPT. Current pointer for where to next store char data
; %CHTOP Points to the end of the character stack
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; Any sections taken up by a character stack are unmapped.
; AC's are not saved.
;
;--
;[4101] New routine
SEARCH MTHPRM,FORPRM
FSRCH
SALL
SEGMENT CODE
EXTERN CHRPT., %CHBOT, %CHTOP, ABORT.
ENTRY KCHST.
KCHST.: SKIPN CHRPT. ;Has anything been allocated?
POPJ P, ;No, Nothing to unmap.
IF20,<
XMOVEI T1,0 ;Get section number we're running in.
JUMPE T1,KCHZER ;Jump if in section 0.
;Non-zero section. Unmap the section(s).
SETO T1, ;1/"Return the memory"
HLRZ T2,%CHBOT ;2/[,,Section number]
HLRZ T3,%CHTOP ;Top of stack
SUB T3,T2 ;3/(Top - Bottom)=number of sections
HRLI T2,.FHSLF ;2/[Fork Handle,,section number]
SMAP% ;Unmap the sections
$FJCAL IJE,ABORT. ;Internal Forots JSYS Error
> ;End IF20
KCHZER: SETZM CHRPT. ;Clear the character stack pntr
SETZM %CHBOT
SETZM %CHTOP
KRET: POPJ P, ;Return
PRGEND
TITLE CHRPTR - Character stack pointers
SUBTTL JLC/CDM 24-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983, 1986
;ALL RIGHTS RESERVED.
;++
; This is the non-executable storage area for the pointers into
; the character stack. They are in their own module, so that no
; one referencing them is forced to load all the stack
; manipulation routines also.
;--
SEARCH MTHPRM,FORPRM
FSRCH
SALL
SEGMENT CODE
ENTRY %CHBOT, CHRPT., %CHTOP
SEGMENT DATA
; ^ ^
; %CHTOP -> | Not alloc |
; +---------------------+
; | Not used (yet) |
; CHRPT. -> | |
; + - - - - - - - - - - +
; | Char data |
; %CHBOT -> | |
; +---------------------+
CHRPT.: BLOCK 1 ;Points to where to allocate on the existing
;stack next. The area below this is being used
;to store character data, and above this is not
;(yet). This value is saved in the user's
;program (.Qnnnn) before a character operation,
;so that an unwind of the stack can be done
;afterwards.
;This is the traditional variable to test if the
;stack exists. The stack does not exist if this
;pointer is zero. PASCAL uses this variable to
;check the existance of our stack.
%CHTOP: BLOCK 1 ;[4101] Points to the top (end) of the physical
;[4101] character stack. Any space above this
;[4101] must be allocated to the stack before it
;[4101] can be used.
;[4101] For extended addressing, this point to
;[4101] memory on a section boundary (n,,0).
%CHBOT: BLOCK 1 ;[4101] Bottom of the character stack. Where it
;[4101] starts, where to deallocate it from if
;[4101] necessary.
;[4101] For extended addressing, if the stack
;[4101] starts at section one, then this points
;[4101] to 1,,20 to insure that the AC's (stored
;[4101] in section 1) are never used in the
;[4101] stack. Otherwise this points to a
;[4101] section boundary (n,,0).
PRGEND
TITLE ALCCHR - User routine to allocate on the character stack
SUBTTL CDM 24-Feb-84
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1986
;ALL RIGHTS RESERVED.
;++
; FUNCTIONAL DESCRIPTION:
;
; User callable subroutine to set the amount of free space on the
; character stack. If the stack exists, then we may may have to
; expand to have enough free space on it. Otherwise we create the
; stack to have the passed amount of space.
;
; CALLING SEQUENCE:
;
; CALL ALCCHR(ISIZE)
;
; INPUT PARAMETERS:
;
; ISIZE Integer size in characters for creating / expanding the
; stack.
;
; IMPLICIT INPUTS:
;
; CHRPT. Current pointer for where to next store char data
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; Memory may be mapped/allocated to the user.
; Does not save AC's
;
;--
;[4101] New
SEARCH MTHPRM,FORPRM
FSRCH
SALL
EXTERN ABORT., CHRPT., %CREST, %EXPST
EXTERN RESAC%, SAVAC%
SEGMENT CODE
HELLO (ALCCHR)
;Error check. Check if we have positive number of characters.
MOVE T5,@0(L) ;Caller's argument
SKIPG T5 ;Argument .GT. 0?
$FCALL ALZ,ABORT. ;No, Error with argument
;Convert character size to word size.
ADDI T5,IBPW-1 ;Round up to nearest word boundary
IDIVI T5,IBPW ;Divide by characters per word to
; get words (Zaps P1)
;Create or expand the stack depending on whether the stack
;already exists.
SKIPE CHRPT. ;Does the stack exist?
PJRST %EXPST ;Yes, Expand existing stack and return
PJRST %CREST ;No, Create the stack and return
END