Trailing-Edge
-
PDP-10 Archives
-
BB-4157F-BM_1983
-
fortran/ots-debugger/forchr.mac
There are 23 other files named forchr.mac in the archive. Click here to see a list.
SEARCH FORPRM
TV FORCHR Character routines ,7(3261)
SUBTTL BL/AHM/TFV/CKS/RVM 4-Feb-83
;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, 1983
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.
***** End Revision History *****
\
PRGEND
TITLE CHSFN. Character statement function assignment
SEARCH 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, 1983
; 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
;
SLEN==2 ;Source length
SPTR==3 ;Source byte pointer
; 4 Second word of source byte pointer is unused
DLEN==5 ;Destination length
DPTR==6 ;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 DLEN,@(L) ;Load destination descriptor
EXCH DLEN,DPTR ;Put in order for MOVSLJ
PUSHJ P,CLR35% ;Clear bit 35 of destination
DMOVE SLEN,@1(L) ;Load source descriptor
EXCH SLEN,SPTR ;Put in order for MOVSLJ
EXTEND SLEN,[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 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, 1983
; 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:
;
DLEN==5 ;Destination length
DPTR==6 ;Destination byte pointer
; L Argument list pointer
; P Stack pointer
HELLO (CHSFC.) ;[3034] Beginning of CHSFC. routine
PUSHJ P,SAVAC% ;[3034] Save registers
DMOVE DLEN,@(L) ;Load destination descriptor
EXCH DLEN,DPTR ;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
SEARCH FORPRM
FSRCH
SEGMENT CODE
EXTERN CHALC%, CHMRK., CHUNW., OVRLP% ;[3130]
EXTERN SAVAC%, RESAC% ;[3261]
;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, 1983
; CHASN. will perform character assignments in which the
; right-hand side is an expression. If MOVSLJ handled overlap
; this would perform a direct MOVSLJ and return. Instead a check
; is done for overlap. The destination is a variable. Registers
; are not saved and restored since the compiler treats this as a
; call node.
;
; The algorithm is:
;
; save ac's [3261]
; check for overlap
; if overlap
; then
; call CHMRK.
; compute size of result in characters
; call CHALC% to allocate the dynamic space
; do the concatenations to the dynamic space
; do a MOVSLJ to the destination
; call CHUNW. to deallocate the dynamic space
; else
; do a MOVSLJ to the destination
; restore ac's [3261]
;
; To call CHASN.:
;
; XMOVEI L,ARGBLK
; PUSHJ P,CHASN.
;
; -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
;
; T0 -1 for overlap; 0 for no overlap
; T1 Number of words in result
SLEN==2 ;Source length
SPTR==3 ;Source byte pointer
; 4 Second word of source byte pointer is unused
DLEN==5 ;Destination length
DPTR==6 ;Destination byte pointer
; 7 Second word of destination byte pointer is unused
; L Argument list pointer
; P Stack pointer
HELLO (CHASN.) ;Beginning of CHASN. routine
PUSHJ P,SAVAC% ;[3261] Save AC's
PUSHJ P,OVRLP% ;Test for overlap
JUMPE T0,NOOVRL ;No overlap
; Overlap case - first move to dynamic space then move back to actual
; destination
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 DLEN,@(L) ;Load destination descriptor
EXCH DLEN,DPTR ;Put in order for MOVSLJ
PUSHJ P,CHALC% ;[3130] Allocate dynamic space
MOVEM DPTR,SVDPTR ;[3130] Save destination pointer
DMOVE SLEN,@1(L) ;Load source descriptor
EXCH SLEN,SPTR ;Put in order for MOVSLJ
EXTEND SLEN,[MOVSLJ
" "] ;Move string with blank filling
JFCL ;Truncation is allowed
; Move string to actual destination
MOVE SPTR,SVDPTR ;Move from dynamic space
DMOVE DLEN,@(L) ;Load destination descriptor
EXCH DLEN,DPTR ;Put in order for MOVSLJ
MOVE SLEN,DLEN ;Load source length
EXTEND SLEN,[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
PJRST RESAC% ;[3261] Restore AC's and return
; No overlap case - move string directly to destination
NOOVRL:
DMOVE DLEN,@(L) ;Load destination descriptor
EXCH DLEN,DPTR ;Put in order for MOVSLJ
DMOVE SLEN,@1(L) ;Load source descriptor
EXCH SLEN,SPTR ;Put in order for MOVSLJ
EXTEND SLEN,[MOVSLJ
" "] ;Move string with blank filling
JFCL ;Truncation is allowed
PJRST RESAC% ;[3261] Restore AC's and 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 DPTR
MARK: BLOCK 1 ;[3130] Holds the mark for unwinding
PRGEND
TITLE CONCA. Character concatenation assignment
SEARCH FORPRM
FSRCH
SEGMENT CODE
EXTERN CHALC%, CHMRK., CHUNW., CONC%, OVRLP% ;[3130]
EXTERN SAVAC%, RESAC% ;[3261]
;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, 1983
; CONCA. will perform character assignments in which the
; right-hand-side is a concatenation. A check is done for
; overlap. The destination is a variable. Registers are not
; saved and restored since the compiler treats this as a call
; node.
;
; The algorithm is:
;
; save AC's [3261]
; check for overlap
; if overlap
; then
; call CHMRK.
; compute size of result in characters
; call CHALC% to allocate the dynamic space
; do the concatenations to the dynamic space
; do a MOVSLJ to the destination
; call CHUNW. to deallocate the dynamic space
; else
; do the concatenations to the destination
; restore AC's and return [3261]
;
; To call CONCA.:
;
; XMOVEI L,ARGBLK
; PUSHJ P,CONCA.
;
; -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:
; 2 through 7 are used by MOVSLJ
;
; T0 -1 for overlap; 0 for no overlap
; T1 Number of words in result
SLEN==2 ;Source length
SPTR==3 ;Source byte pointer
; 4 Second word of source byte pointer is unused
DLEN==5 ;Destination length
DPTR==6 ;Destination byte pointer
; 7 Second word of destination byte pointer is unused
; L Argument list pointer
; P Stack pointer
HELLO (CONCA.) ;Beginning of CONCA. routine
PUSHJ P,SAVAC% ;[3261] Save AC's
PUSHJ P,OVRLP% ;Test for overlap
JUMPE T0,NOOVRL ;No overlap
; Overlap case - first move to dynamic space then move back to actual
; destination
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 DLEN,@(L) ;Load destination descriptor
EXCH DLEN,DPTR ;Put in order for MOVSLJ
PUSHJ P,CHALC% ;[3130] Allocate dynamic space
MOVEM DPTR,SVDPTR ;[3130] Save destination pointer
; Move string to dynamic space
PUSHJ P,CONC% ;Do multiple source concatenation
; Move string to actual destination
MOVE SPTR,SVDPTR ;Move from dynamic space
DMOVE DLEN,@(L) ;Load destination descriptor
EXCH DLEN,DPTR ;Put in order for MOVSLJ
MOVE SLEN,DLEN ;Load source length
EXTEND SLEN,[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
PJRST RESAC% ;[3261] Restore AC's and return
; No overlap case - move string directly to destination
NOOVRL:
DMOVE DLEN,@(L) ;Load destination descriptor
EXCH DLEN,DPTR ;Put in order for MOVSLJ
PUSHJ P,CONC% ;Do a multiple source concatenation
PJRST RESAC% ;[3261] Restore AC's and 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 DPTR
MARK: BLOCK 1 ;[3130] Holds the mark for unwinding
PRGEND
TITLE CONCF. Fixed length concatenation
SEARCH 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, 1983
; 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:
;
DLEN==5 ;Destination length
DPTR==6 ;Destination byte pointer
; L Argument list pointer
; P Stack pointer
HELLO (CONCF.) ;Beginning of CONCF. routine
PUSHJ P,SAVAC% ;Save registers
DMOVE DLEN,@(L) ;Load destination descriptor
EXCH DLEN,DPTR ;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 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, 1983
; 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
;
DLEN==5 ;Destination length
DPTR==6 ;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 DLEN, ;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 DLEN,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 DLEN,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 DLEN,1(CARG) ;Store destination count
MOVE DPTR,@(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 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, 1983
; 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:
;
DLEN==5 ;Destination length
DPTR==6 ;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 DLEN, ;[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 DLEN,1(CARG) ;[3130] Add source count
ADDI LL,1 ;[3242] Point to next arg
AOBJN CNT,SIZLUP ;[3242] Get next count
PUSHJ P,CHALC% ;[3130] Allocate dynamic space for the result
EXCH DLEN,DPTR ;[3130] Put in descriptor order
DMOVEM DLEN,@(L) ;[3130] Save in .Q variable in argument list
EXCH DLEN,DPTR ;[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
SEARCH 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, 1983
; 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,-62(AC) ;;[3242] Add alignment from P&S
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 CLR35% Clear bit 35 of destination
SEARCH 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, 1983
; CLR35% clears bit 35 in the destination words for a
; concatenation operation. It is passed the byte pointer to the
; destination in DPTR and the length of the destination in
; characters in DLEN.
;
;Register usage:
;
; T1 Number of words in result
DLEN==5 ;Destination length - setup by caller
DPTR==6 ;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,DLEN ;Length of destination
ADDI T1,IBPW - 1 ;Round up to a full word
IDIVI T1,IBPW ;Number of bytes per word
MOVE LL,DPTR ;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 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, 1983
; CONC% is the common concatenation routine. It is passed the
; destination byte pointer in DPTR and the destination length in
; DLEN. It scans the argument list to pickup the source byte
; pointers and lengths.
;Register usage:
; 2 through 7 are used by MOVSLJ
;
SLEN==2 ;Source length
SPTR==3 ;Source byte pointer
; 4 Second word of source byte pointer is unused
DLEN==5 ;Destination length - setup by caller
DPTR==6 ;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,DLEN ;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 SLEN,@(LL) ;Load source descriptor
EXCH SLEN,SPTR ;Put in order for MOVSLJ
MOVE DLEN,SLEN ;Move source without filling
CAML DLEN,DREM ;Enough space remaining
MOVE DLEN,DREM ;No - only fill up remainder
SUB DREM,DLEN ;Update remainder
EXTEND SLEN,[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 SLEN ;No source
MOVE DLEN,DREM ;Remaining dest
EXTEND SLEN,[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, 1983
; 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 FORPRM
FSRCH
SEGMENT CODE
;Register usage:
;
; T0 type of comparison to perform
; T1 unused
LEN1==2 ;First operand length
PTR1==3 ;First operand byte pointer
; 4 ;Second word of first operand byte pointer is unused
LEN2==5 ;Second operand length
PTR2==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 LEN1,SAVACS ;[3204] Save LEN1, PTR1
DMOVEM LEN1+2,SAVACS+2 ;[3204] Save PTR1+1, LEN2
DMOVEM LEN1+4,SAVACS+4 ;[3204] Save PTR2, PTR2+1
DMOVE LEN1,@(L) ;First descriptor
EXCH LEN1,PTR1 ;reverse the order
DMOVE LEN2,@1(L) ;Second descriptor
EXCH LEN2,PTR2 ;Reverse the order
JUMPLE LEN1,BADLEN ;Test for illegal length
JUMPLE LEN2,BADLEN ;Test for illegal length
TLNN LEN1,(777B8) ;[3243] Forbidden field non-zero ?
TLNE LEN2,(777B8) ;[3243] Forbidden field non-zero ?
JRST BADLEN ;[3243] Yes, complain
EXTEND LEN1,(T1) ;Do the comparison
TDZA T0,T0 ;Set value = false
SETO T0, ;Set value = true
DMOVE LEN1,SAVACS ;[3204] Restore LEN1, PTR1
DMOVE LEN1+2,SAVACS+2 ;[3204] Restore PTR1+1, LEN2
DMOVE LEN1+4,SAVACS+4 ;[3204] Restore PTR2, PTR2+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 LEN1
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, 1983
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, 1983
SEARCH 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, 1983
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, 1983
SEARCH 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, 1983
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, 1983
SEARCH 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, 1983
NOSYM
ENTRY INDEX
EXTERN INDEX.
INDEX=INDEX.
PRGEND
TITLE INDEX.
SEARCH 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, 1983
; 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 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, 1983
; 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
SEARCH FORPRM
FSRCH
SALL
SEGMENT CODE
EXTERN FUNCT.,ABORT.,CHRPT.
ENTRY CHALC%
;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, 1983
; CHMRK. - to "mark" the current character stack pointer, which is
; merely placing the current pointer into the variable (usually a
; .QNNNN) specified by the 1st and only arg. All registers are
; preserved.
;
; Calling sequence:
;
; XMOVEI 16,nM
; PUSHJ 17,CHMRK.
;
; -1,,0
; nM: IFIW 2,.Qnnnn
;
HELLO (CHMRK.)
MOVEM T1,SAVET1 ;SAVE T1
SKIPN T1,CHRPT. ;GET THE CURRENT CHAR STACK PNTR
PUSHJ P,ALCMRK ;IF NONE, ALLOCATE SOME SPACE, ADDR IN T1
MOVEM T1,@(L) ;SAVE THE POINTER
MOVE T1,SAVET1 ;RESTORE T1
POPJ P,
ALCMRK: MOVEI T1,FN%COR ;GET CORE AT ANY PLACE
MOVEM T1,FCODE
MOVEI T1,ICHRSZ ;START WITH A LARGE BLOCK
MOVEM T1,CSIZE
MOVEM L,SAVEL ;SAVE ARG PNTR
XMOVEI L,CHBLK
PUSHJ P,FUNCT. ;GET THE CORE
MOVE L,SAVEL ;RESTORE ARG PNTR
SKIPE FNSTAT ;CHECK IF SUCCESSFUL
$FCALL NCA,ABORT. ;NO CORE AVAILABLE
MOVE T1,CADDR ;GET ADDR OF CORE
MOVEM T1,CHRPT. ;SAVE IT
ADD T1,CSIZE ;GET TOP ADDR+1
MOVEM T1,CHRTOP ;SAVE IT
PUSHJ P,CHRCLR ;CLEAR THE CORE AREA
MOVE T1,CADDR ;GET THE BASE ADDR AGAIN FOR RETURN
POPJ P,
; 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
POPJ P,
; CHALC% - to allocate some space for a character temporary on the
; character stack. Used by CONCA., CHASN., and CONCD.. It is
; passed the length to allocate in characters in DLEN and returns
; the byte pointer to the allocate space in DPTR. All other
; registers are preserved.
;
;Register usage:
;
; T1 Scratch register
; T2 Scratch register
; T3 Scratch register
DLEN==5 ;Destination length - setup by caller
DPTR==6 ;Destination byte pointer - setup by caller
; L Original argument list pointer
; P Stack pointer
CHALC%: SKIPN CHRPT. ;ANY STACK ALLOCATED YET?
$FCALL NCS,ABORT. ;NO. COMPILER ERROR
MOVEM DLEN,SVDLEN ;[3130] SAVE DESIRED SIZE
ADDI DLEN,IBPW-1 ;[3130] ROUND UP
IDIVI DLEN,IBPW ;[3130] GET WORDS
ADD DLEN,CHRPT. ;[3130] ADD TO CURRENT POINTER
CAMGE DLEN,CHRTOP ;[3130] BEYOND ALOOCATED SPACE?
JRST CHRET ;NO
MOVEM DLEN,NEWPNT ;[3130] SAVE NEW DESIRED CHRPT
SUB DLEN,CHRTOP ;[3130] GET # WORDS BEYOND THOSE ALLOCATED
ADDI DLEN,CHMSIZ ;[3130] PLUS SOME MORE (defined in FORPRM)
MOVEM DLEN,CSIZE ;[3130] SAVE FOR FUNCT. CALL
MOVE DLEN,CHRTOP ;[3130] SETUP FOR F.GAD
MOVEM DLEN,CADDR ;[3130]
MOVEI DLEN,FN%GAD ;[3130]
MOVEM DLEN,FCODE ;[3130]
MOVEM L,SAVEL ;SAVE ARG PNTR
XMOVEI L,CHBLK
PUSHJ P,FUNCT. ;GET LOWSEG CORE AT CURRENT ADDR
MOVE L,SAVEL ;RESTORE ARG PNTR
SKIPE FNSTAT ;DID WE SUCCEED?
$FCALL NCA,ABORT. ;NO. NO CORE AVAILABLE
PUSHJ P,CHRCLR ;CLEAR THE CORE AREA
MOVE DLEN,CSIZE ;[3130] GET SIZE ALLOCATED
ADDM DLEN,CHRTOP ;[3130] SAVE NEW TOP ADDR
MOVE DLEN,NEWPNT ;[3130] GET NEW POINTER
CHRET: EXCH DLEN,CHRPT. ;[3130] SAVE NEW CURRENT POINTER, GET OLD ONE
MOVE DPTR,DLEN ;[3130] MOVE POINTER TO DPTR
$BLDBP DPTR ;[3130] CREATE A BYTE POINTER
MOVE DLEN,SVDLEN ;[3130] RESTORE DLEN
POPJ P,
;CLEAR THE CORE AREA
CHRCLR: DMOVEM T1,SAVET1 ;SAVE T1, T2
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
DMOVE T1,SAVET1 ;RESTORE T1, T2
POPJ P,
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
DMOVE T1,SAVET1 ;RESTORE T1, T2
POPJ P,
-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
FCODE: BLOCK 1 ;FUNCT. CODE
FNSTAT: BLOCK 1 ;STATUS (0=OK)
CADDR: BLOCK 1 ;ADDR OF CORE
CSIZE: BLOCK 1 ;SIZE OF CORE AREA
SAVET1: BLOCK 2 ;T1, T2 SAVE
SAVET3: BLOCK 1 ;T3 SAVE
SVDLEN: BLOCK 1 ;[3130] DLEN SAVE
SAVEL: BLOCK 1 ;FOR ARG POINTER
NEWPNT: BLOCK 1 ;FOR CURPT. AFTER FUNCT. CALL
CHRTOP: BLOCK 1 ;LAST ALLOCATED ADDRESS + 1
END