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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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,?,,,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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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,?,,,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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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, 1987 ;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