Google
 

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