Trailing-Edge
-
PDP-10 Archives
-
steco_19840320_1er_E35
-
10,5676/teco/source/tecmem.mac
There are 3 other files named tecmem.mac in the archive. Click here to see a list.
SUBTTL Introduction
; Copyright (c) 1979, 1980, 1981 Stevens Institute of Technology,
; Hoboken, New Jersey 07030.
; This software may be used and copied provided that this copyright notice
;is included, and provided that copies of all modifications are sent to:
;
; TECO Project
; Computer Center
; Stevens Institute of Technology
; Castle Point Station
; Hoboken, New Jersey 07030
;
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by Stevens Institute of
; Technology.
; Search needed universals
SEARCH TECUNV ; TECO universal file
; Generate the prologue
TECVER==200 ; Major version number
TECMIN==1 ; Minor version number
TECEDT==1150 ; Edit level
TECWHO==0 ; Last editor
PROLOGUE(MEM,<TECO Memory management>) ; Generate the TITLE and other stuff
SUBTTL Table of Contents
;+
;.pag.lit
; Table of Contents for TECMEM - Memory management
;
;
; Section Page
; 1. Introduction . . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision History . . . . . . . . . . . . . . . . . . . 3
; 4. M$INIT - Initialize the memory management. . . . . . . 4
; 5. M$ZBLK - Allocate a zero block of core . . . . . . . . 5
; 6. M$GBLK - Routine to allocate a core block. . . . . . . 6
; 7. M$GTXT - Routine to get a text block . . . . . . . . . 7
; 8. M$RBLK - Return a core block . . . . . . . . . . . . . 8
; 9. M$XPND - Expand the end of the editing buffer. . . . . 9
; 10. M$SRNK - Routine to shrink a buffer. . . . . . . . . . 13
; 11. M$INSS - Routine to insert a string into a buffer. . . 14
; 12. M$USEB - Routine to add a user to a block. . . . . . . 15
; 13. M$RELB - Routine to delete a user from a block . . . . 16
; 14. M$CFRE - Check the free counts of text blocks. . . . . 17
; 15. FNDBLK - Routine to find a given size block. . . . . . 18
; 16. M$CBLK - Routine to create a block of the given size . 19
; 17. M$GC - Perform a garbage collection. . . . . . . . . . 20
; 18. M$MSTR - Routine to move a string. . . . . . . . . . . 23
; 19. FIXPTR - Routine to fix up text buffer pointers. . . . 25
; 20. Low segment. . . . . . . . . . . . . . . . . . . . . . 26
; 21. End of TECMEM. . . . . . . . . . . . . . . . . . . . . 27
;.end lit.pag
;-
SUBTTL Revision History
COMMENT |
1000 Start of this version
1022 By: Nick Bush On: 14-August-1980
Fix M$XPND to avoid overwriting the block after the one being
expanded (yet again). Also really avoid this problem by putting
in the code for a POP loop when inserting multiples of 5
characters.
Modules: TECMEM
1032 By: Robert McQueen On: 22-August-1980
Make TECMEM assemble for KI-10s.
Modules: TECUNV,TECMEM
1045 By: Robert McQueen On: 15-October-1980
Output files where getting 1b35 on. M$XP.8 (POP loop) moved too many words
and was moving the text buffer header into the editing buffer. If the
number of characters that were being inserted were then less then 20. the
bit (1B35) would not be cleared.
Modules: TECMEM
1106 By: Nick Bush On: 13-May-1981
Improve screen updating for times when the new screen has portions which
are identical with the old. This will also fix most cases of wrapped
around lines on the top of the section of the screen.
Also fix some random /MODE:DUMP bugs.
Modules: TECUNV,TECVID,TECCMD,TECECM,TECUUO,TECMEM
1111 By: Nick Bush On: 9-July-1981
Don't do 18-bit arithmetic on memory sizes, so we don't turn a request
for 1000000 words into something less, and thereby miss the error.
Modules: TECMEM
1125 By: Robert McQueen On: 29-September-1981
- Make symbol table entries movable blocks.
- Use the new linked list processing.
- Initial work to make TECSYM run in non-zero section.
Modules: TECUNV,TECECM,TECSYM,TECMEM
Start of Version 200A(1126)
1127 By: Nick Bush@SIT, Robert C. McQueen@SIT On: 15-October-1981
Add the following new features:
- String arguments. {...} is a string argument.
- Make I take them, = and == return them.
- Implement the FC command to define immediate command tables
- Implement the E? command to return various items.
- Start doing some work so that TECO will work on TOPS-20
- Start doing some work so that TECO some day may run in a section
besides zero.
Modules: TECUNV,TECERR,TECPRS,TECCMD,TECSRH,TECMEM,TECUUO,TECECM,TECMVM,TECCOM,TECINI
1132 By: Nick Bush On: 10-December-1981
1) Add Q-register data types for the sake of FC(Q-reg)SAVE$ and
FC(Q-reg)RESTORE$ commands.
2) Fix FC(q-reg)REPLACE$ to correctly replace the ALWAYS and OTHER options.
Modules: TECUNV,TECCMD,TECECM,TECMEM,TECPRS,TECMVM
1150 By: Nick Bush On: 23-March-1982
Fix CPYCTB to correctly handle copying only one CND. It was returning
the new CND it had created when it returned.
Modules: TECMEM
|
SUBTTL M$INIT - Initialize the memory management
$CODE ; Code PSECT
;+
;.hl1 M$INIT
;This routine will initialize the memory management. It assumes that it is
;one of the first routines called on start up.
;.literal
;
; Usage:
; PUSHJ P,M$INIT ; Initialize memory management
; (Return) ; Always return
;.end literal
;-
M$INIT: MOVE T2,.JBFF ; Get the first free location
MOVEM T2,FSTBLK ; Save it for the get-a-block routines
ADDX T2,.BKLEN+1+D.MINC ; Need at least one dummy block
CAMG T2,.JBREL ; Have enough already?
JRST M$IN.0 ; Yes, don't need more
MOVE T1,.JBFF ; Get this again
ADR2PG T1 ; Convert this to a page number
ADR2PG T2 ; And this too
SUB T2,T1 ; Compute the number of pages needed
ADDI T1,1 ; First page to do
PUSHJ P,M$CPGS ; Create the pages
ERROR E.COR ; Can't, give up
M$IN.0: MOVE T1,.JBREL ; Get the end of core
AOJ T1, ; Bump it
MOVEM T1,.JBFF ; And save it for expansion
MOVE T1,FSTBLK ; Get the pointer back
ZERO. T2,BLKFLG,(T1) ; Clear the flags
ZERO. T2,BLKNXT,(T1) ; And the next field
MOVE T2,.JBREL ; Get the end of core
SUB T2,T1 ; And get the number of words in this block
AOJ T2, ; Plus one
STOR. T2,BLKSIZ,(T1) ; . . .
STORI. .BTJNK,T2,BLKTYP,(T1) ; Store the block type
BITON T2,BF.LST,.BKFLG(T1) ; Flag this is the last block
MOVX T1,D.CMDS ; Get the default size of the command buffer
PUSHJ P,M$GTXT ; Get the block
XMOVEI T2,CMDBUF ; Get the address we want to point to this one
PUSHJ P,M$USEB ; And set the pointer
BITON T1,QR$UPD,$QRFLG+CMDBUF ; Flag this will need forced update first time
ZERO. ,QRGPDB,+CMDBUF ; No previously displayed buffer
MOVEI T1,5 ; Get 5 chars
PUSHJ P,M$GTXT ; Get the buffer
MOVEI T2,TTIBUF ; Get the QRg address
PUSHJ P,M$USEB ; Point to the buffer
MOVEI T1,5 ; Get 5 chars
PUSHJ P,M$GTXT ; Get the buffer
MOVEI T2,ERRQRG ; Get the QRg address
PUSHJ P,M$USEB ; Point to the buffer
BITON T1,QR$UPD,$QRFLG+ERRQRG ; Flag this will need forced update first time
ZERO. ,QRGPDB,+ERRQRG ; No previously displayed buffer
BITON T1,QR$UPD,$QRFLG+TXTBUF ; Flag this will need forced update first time
BITON T1,QR$UPD,$QRFLG+QRGIDX(.) ; Flag this will need forced update first time
ZERO. ,QRGPDB,+TXTBUF ; No previous buffer
ZERO. ,QRGPDB,+QRGIDX(.) ; No previous here either
MOVX T1,$DTTXT ; Get the type of the Q-reg's
STOR. T1,QRGDTP,+TXTBUF ; And store it
STOR. T1,QRGDTP,+QTAB+QRGIDX(.) ; Here also
STOR. T1,QRGDTP,+CMDBUF ; And here
STOR. T1,QRGDTP,+ERRQRG ; And here
STOR. T1,QRGDTP,+TTIBUF ; And for the terminal input buffer
MOVX T1,$DTNUM ; Have a value in COMMAND-PROMPT initially
STOR. T1,QRGDTP,+CPMQRG ; Store the data-type
MOVX T1,"*" ; Get the value of an asterisk
STOR. T1,QRGVAL,+CPMQRG ; And store it
MOVX T1,D.TXTS ; Get the initial size of the text buffer
PUSHJ P,M$GTXT ; Get a block
MOVEI T2,$QRTPT+TXTBUF ; Get the address
PUSHJ P,M$USEB ; Set the reference
MOVEI T2,QTAB+QRGIDX(.) ; Get the address of Q-reg .
MOVEM T2,CUREDT ; Save the current QRG
PJRST M$USEB ; . . .
SUBTTL M$MCOR - Move a section of core up or down
;+
;.hl1 M$MCOR
;This routine will move a section of memory up or down a specified number
;of words.
;.literal
;
; Usage:
; T1/ Number of words to move
; T2/ Starting address
; T3/ Ending address
; PUSHJ P,M$MCOR
; (Return)
;
;.end literal
;-
IFN FTXADR,<
M$MCOR: JUMPE T1,.POPJ ; If nothing just return
EXTEND T1,[XBLT] ; Very simple
POPJ P, ; Return to the caller
>; End of IFN FTXADR
IFE FTXADR,<
M$MCOR: JUMPE T1,.POPJ ; Moving nothing?
JUMPL T1,MCOR.0 ; Moving down, must POP
HRL T3,T2 ; Build the BLT pointer
ADDI T1,-1(T3) ; Compute the final address
BLT T3,(T1) ; Move the core
POPJ P, ; Return to the caller
; Here if we have to move the memory up the hard way. We will use a POP
; loop to move the information
MCOR.0: SUB T3,T2 ; Get the offset from the source to the destination
SOJ T2, ; Get the last word we are interested in
MOVN T1,T1 ; Get the magnitude of the count
SOJ T1, ; Minus one for the correct POP loop count
HRL T2,T1 ; Get the count
HRLI T3,(POP T2,(T2)) ; Build the instruction to execute
TXCN T2,1B0 ; Turn on the sign bit
XCT T3 ; Move a word
JUMPL T2,.-1 ; Loop until done
POPJ P, ; Return with the block moved
>; End of IFE FTXADR
SUBTTL M$ZBLK - Allocate a zero block of core
;+
;.HL1 M$ZBLK
;This routine will allocate a core block for the caller. It will then
;clear the block for the caller. This is mainly used for the video
;processing routines that require a null block of core.
;.literal
;
; Usage:
; MOVE T1,Number.of.words
; MOVEI T2,.BTxxx ; The block type
; PUSHJ P,M$ZBLK ; Allocate the core block
; (Return) ; Always return here
;
; Returns:
; T1 - Address of the core block
;.end literal
;-
IFE FTXADR,<
M$ZBLK: $SAVE <P1> ; Save P1
MOVE P1,T1 ; Copy the number of words
PUSHJ P,M$GBLK ; Allocate the block
MOVEI T2,1(T1) ; Start building the BLT
HRLI T2,(T1) ; . . .
ADD P1,T1 ; Compute the final address
SETZM (T1) ; Clear the first word
BLT T2,-1(P1) ; Clear the block
POPJ P, ; Return to the caller
>; End of IFE FTXADR
IFN FTXADR,<
M$ZBLK: $SAVE <P1,P2,P3> ; Save a few registers
MOVE P1,T1 ; Copy the size of the block
SOJ P1, ; Decrement
PUSHJ P,M$GBLK ; Allocate a block of memory
MOVE P2,T1 ; Get the address of the block
AOS P3,P2 ; Get the address to move to
SETZM (P2) ; Clear the first word
EXTEND P1,[XBLT] ; Clear the block of memory
POPJ P, ; Return to the caller
>; End of IFN FTXADR
SUBTTL M$GBLK - Routine to allocate a core block
;+
;.Hl1 M$GBLK
;This routine will allocate a core block for the caller. It may move core
;around.
;.literal
;
; Usage:
; MOVE T1,Number.of.words
; MOVEI T2,.BTxxx ; The block type
; PUSHJ P,M$GBLK ; Allocate the core block
; (Return) ; Always return if core block gotten
;
; Returns:
; T1 - Address of the core block
;.end literal
;-
M$GBLK: $SAVE <P1,P2> ; Save some ac's
IFN FTDEBUG,<
SKIPE T1 ; Zero words?
TXNE T1,LH.ALF ; Too many words?
STOPCD TMW,<Too many words requested>
SKIPL T2 ; Bad block type?
CAXLE T2,.BTMAX ; . . .
STOPCD BBR,<Bad block type requested>
> ; End of IFN FTDEBUG
ADDX T1,.BKLEN ; Add the overhead
DMOVE P1,T1 ; Move the args to a safe place
PUSHJ P,FNDBLK ; Go find a block large enough
JRST M$GB.1 ; Found it
PUSHJ P,M$GC ; Go garbege collect
PUSHJ P,FNDBLK ; Try again
JRST M$GB.1 ; Got one
MOVE T1,P1 ; Get the size
PUSHJ P,M$CBLK ; Create a block
M$GB.1: STOR. P2,BLKTYP,(T1) ; Store the type
LOAD. P2,BLKSIZ,(T1) ; Get the size of the block we found
STOR. P1,BLKSIZ,(T1) ; Store the new size
SUB P2,P1 ; Get the size of what's left
ADD P1,T1 ; Get the new block address
JUMPE P2,M$GB.2 ; If nothing, just return
BITOFF T2,BK.FLG,.BKFLG(P1) ; Clear the flags
STORI. .BTJNK,T2,BLKTYP,(P1) ; Flag this is a junk block
STOR. P2,BLKSIZ,(P1) ; Store the size
LOAD. T2,BLKNXT,(T1) ; Get the old next pointer
STOR. T2,BLKNXT,(P1) ; And store it
ZERO. T2,BLKNXT,(T1) ; Clear the old one
MOVX T2,BF.LST ; Get the flag to copy
TDNE T2,.BKFLG(T1) ; Last page?
IORM T2,.BKFLG(P1) ; Yes, flag it
ANDCAM T2,.BKFLG(T1) ; Clear the old flag
M$GB.2:
IFN FTDEBUG,<
IFE FTXADR,<
HRLI T2,.BKLEN(T1) ; Set up the BLT pointer
HRRI T2,.BKLEN+1(T1) ; To clear the block
SETZM -1(T2) ; Clear the first word
CAIE P1,(T2) ; Only one word
BLT T2,-1(P1) ; Clear the block
>; End of IFE FTXADR
IFN FTXADR<
$SAVE <P3> ; Need another register
XMOVEI P2,.BKLEN(T1) ; Get the first address
AOS P3,P2 ; Get the address of the next
SETZM (T2) ; Clear the first
CAMN P1,P3 ; Finished?
JRST M$GB.3 ; Yes, skip this
SUB P1,P3 ; Determine the number of words
EXTEND P1,[XBLT] ; Clear the block
M$GB.3:
>; End of IFN FTXADR
>; End of IFN FTDEBUG
ADDX T1,.BKLEN ; Point to first data word
IFN FTDEBUG,<
CFXE. T2,BLKTYP,-.BKLEN(T1),.BTTXT ; Don't check if this is a text block
PUSHJ P,M$CFRE ; Check the free blocks and junk
>; End of IFN FTDEBUG
POPJ P, ; No, return the address
SUBTTL M$GTXT - Routine to get a text block
;+
;.Hl1 M$GTXT
; This routine will allocate a text core block. It calls M$GBLK to
;do the actual work.
;.b
;.literal
; MOVEI T1,Number.of.chars
; PUSHJ P,M$GTXT
; (Return, T1= address of buffer)
;
;.end literal
;.b
; Note: M$USEB must be called with the buffer and pointer addresses after
;this to set up the pointer list properly.
;-
M$GTXT: IDIVI T1,5 ; Make it the number of words we need
JUMPE T2,.+2 ; Need a partial?
AOJ T1, ; Yes, count it
MOVX T2,.BTTXT ; Get the block type
ADDX T1,.BKTLN-.BKLEN ; Add the overhead in
PUSHJ P,M$ZBLK ; Get the block
SUBX T1,.BKLEN ; Point to the real first word
LOAD. T2,BLKSIZ,(T1) ; Get the size
SUBX T2,.BKTLN ; Minus the header
IMULI T2,5 ; Make it the number of chars
STOR. T2,BLKFRE,(T1) ; Store the number
ZERO. T2,BLKTFL,(T1) ; Clear the flags
ZERO. ,BLKADR,(T1) ; Clear the pointer word
ZERO. ,BLKPT,(T1) ; And the "PT" offset
ZERO. ,BLKEND,(T1) ; And "Z"
STORI. .INFIN,T2,BLKFST,(T1) ; Flag nothing modified
STORI. .MINFI,T2,BLKLST,(T1) ; . . .
ZERO. ,BLKOED,(T1) ; And the old end is zero
XMOVEI T2,.BKTLN(T1) ; Get the address of the first data word
TXO T2,<POINT 7,> ; Build the byte pointer
STOR. T2,BLKPTR,(T1) ; And store it
POPJ P, ; And return
SUBTTL M$RBLK - Return a core block
;+
;.HL1 M$RBLK
;This routine will return a core block to the free core storage.
;.literal
;
; Usage:
; MOVE T1,Address.of.core.block(first data word)
; PUSHJ P,M$RBLK
; (Return)
;.end literal
;-
DELBLK: $SAVE <P1,P2,P3> ; Save a few registers
JRST DBLK.0 ; Enter the common loop
M$RBLK: $SAVE <P1,P2,P3> ; Save some working room
SUBX T1,.BKLEN ; Take off the header
DBLK.0: MOVE P1,T1 ; And get the address
LOAD. P2,BLKSIZ,(P1) ; Get the size
MOVE P3,T1 ; Copy the address here also
MOVX T1,BF.LST ; Is this the last block on a page?
TDNE T1,.BKFLG(P1) ; . . .
JRST M$RB.1 ; Yes, don't check for next block
IFN FTDEBUG,<
JUMPG P2,.+2 ; Skip if length okay
STOPCD RZB,<M$RBLK found a zero length block>
> ; End of IFN FTDEBUG
ADD P3,P2 ; No, get the address of the next block
CFXE. T1,BLKTYP,(P3),.BTJNK ; Is it a junk block?
JRST M$RB.1 ; No, can't concatenate them
LOAD. T1,BLKSIZ,(P3) ; Yes, concatenate this one with the new one
ADD T1,P2 ; . . .
STOR. T1,BLKSIZ,(P1) ; Store the new size
LOAD. T1,BLKNXT,(P3) ; Get the next page pointer
STOR. T1,BLKNXT,(P1) ; Store it
LOAD T1,.BKFLG(P3),BF.LST ; Get the last flag
STOR T1,.BKFLG(P1),BF.LST ; Store it
M$RB.1: STORI. .BTJNK,T1,BLKTYP,(P1) ; Save the block type
IFN FTDEBUG,<
PUSHJ P,M$CFRE ; Check the text blocks
>; End of IFN FTDEBUG
POPJ P, ; And return
SUBTTL M$XPND - Expand the end of the editing buffer
;+
;.HL1 M$XPND
;This routine will expand the end of the editing buffer by N characters.
;It will allocate more core if the core is required.
;.literal
;
; Usage:
; MOVE T1,Address.of.buffer
; MOVEI T2,Number.of.characters
; MOVEI T3,Offset.of.pointer
; PUSHJ P,M$XPND
; (Return)
;.end literal
;-
M$XPND:
IFN FTDEBUG,<
PUSHJ P,M$CFRE ; Check the text blocks out
>; End of IFN FTDEBUG
JUMPE T2,.POPJ ; Just return if nothing to insert
$SAVE <P1,P2,P3,P4> ; Save some ac's
DMOVE P1,T1 ; Get the args
MOVE P3,T3 ; . . .
LOAD. T1,BLKFRE,(P1) ; Get the number of free characters
CAML T1,P2 ; Have enough free?
JRST M$XP.2 ; Yes, go make the room in the buffer
MOVE T2,P2 ; Get the number of characters being added
SUB T2,T1 ; And determine the actual additonal needed
ADDX T2,5 ; Plus a little working room
IDIVX T2,5 ; Get the number of words
MOVE T1,P1 ; Get the address of the block to expand
PUSHJ P,M$APPD ; Add the space to this block
JRST M$XP.1 ; It was moved, we need to copy the data
IMULX T2,5 ; Get the number of characters we added
LOAD. T1,BLKFRE,(P1) ; And get the previous free
ADD T1,T2 ; Get the amount free now
STOR. T1,BLKFRE,(P1) ; Store it back
JRST M$XP.2 ; And go move the text down
; Here if the block had to be moved somewhere else in order to expand it.
;We must copy the text.
;Enter with:
; T1/ Address of old buffer
; T2/ Number of words just appended to the buffer
; T3/ Address of new buffer
; P2/ Number of characters we need to insert
; P3/ Offset to where to insert first character
;
M$XP.1: MOVE P1,T1 ; Get the address of the old block(may have moved)
MOVE P4,T3 ; Get the address of the new block
LOAD. T2,BLKSIZ,(P4) ; Get the new block size
SUBX T2,.BKTLN ; Compute the amount that is really text
IMULX T2,5 ; Compute the number of characters in that
SUB T2,.BKEND(P1) ; Minus were the text ends
SUB T2,P2 ; And minus the amount needed gives the new free
STOR. T2,BLKFRE,(P4) ; Store the number free in the new block
LOAD. T2,BLKPTR,(P1) ; Get the old byte pointer
SUB T2,P1 ; Make it a relative pointer
ADD T2,P4 ; And back to the new absolute pointer
STOR. T2,BLKPTR,(P4) ; And save the new pointer
XMOVEI T1,.BKTLN(P1) ; Get the source pointer
TXO T1,<POINT 7,> ; Make into a byte pointer
XMOVEI T2,.BKTLN(P4) ; Get where to put the string
TXO T2,<POINT 7,> ; Set up the pointer
MOVE T3,P3 ; Get the number of characters to move
PUSHJ P,M$MSTR ; Move the string
LOAD. T1,BLKPT,(P1) ; Get the old point
STOR. T1,BLKPT,(P4) ; And store it
LOAD. T1,BLKEND,(P1) ; Get the old end
ADD T1,P2 ; Get the number of chars total
STOR. T1,BLKEND,(P4) ; Store it
MOVE T1,P3 ; Get the place the caller wants a gap
BLDBPT (T1,(P1)) ; Build the byte pointer
MOVE T2,P2 ; Get the place to put it
ADD T2,P3 ; . . .
BLDBPT (T2,(P4)) ; Build the destination byte pointer
LOAD. T3,BLKEND,(P1) ; Get the old end
SUB T3,P3 ; Get the number to move
PUSHJ P,M$MSTR ; Move the rest of the string
LOAD. T1,BLKTFL,(P1) ; Get the old flags
STOR. T1,BLKTFL,(P4) ; Store them
LOAD. T1,BLKFDI,(P1) ; Get the input FDB address
STOR. T1,BLKFDI,(P4) ; Store it
LOAD. T1,BLKFDO,(P1) ; Get the output FDB address
STOR. T1,BLKFDO,(P4) ; Store it
LOAD. T1,BLKTMP,(P1) ; Get the rename FDB address
STOR. T1,BLKTMP,(P4) ; Store it
LOAD. T1,BLKCOL,(P1) ; Get the old column
STOR. T1,BLKCOL,(P4) ; And copy it
LOAD. T1,BLKOED,(P1) ; Get the old end
STOR. T1,BLKOED,(P4) ; Save it
LOAD. T1,BLKFST,(P1) ; And the first
STOR. T1,BLKFST,(P4) ; . . .
LOAD. T1,BLKLST,(P1) ; And the last change
STOR. T1,BLKLST,(P4) ; . . .
XMOVEI T1,.BKLEN(P1) ; Get the address of the first word past the header
PUSHJ P,M$RBLK ; And return the old block
MOVE T1,P4 ; Get the address of the new block
IFN FTDEBUG,<
PUSHJ P,M$CFRE ; Check the number free
>; End of IFN FTDEBUG
POPJ P, ; And return it to the caller
; Here if we can leave the string where it is.
M$XP.2: CFMN. ,BLKEND,(P1),P3 ; Expanding from the end of the buffer?
JRST M$XP.4 ; Yes, skip this
MOVE T1,P2 ; Get the amount being
IDIVI T1,5 ; Check if inserting multiple of 5 chars
JUMPE T2,M$XP.8 ; If so, we can use the POP loop
MOVX T1,<POINT 0,-1(T3),^D34> ; Get the initial byte pointer
MOVEM T1,XPNPTR ; Store it
XMOVEI P4,1(P) ; Get the address of the code
IFN FTKL,ADJSP P,NEXLP ; Make room on the stack for the routine
IFN FTKI,ADD P,[XWD NEXLP,NEXLP] ; Adjust the stack
HRLI T1,EXLP ; Get the address
HRRI T1,(P4) ; And where to put it
BLT T1,(P) ; Put the code on the stack
HRRM P4,EXLP.5(P4) ; Store the address for the loop
MOVE T3,P3 ; Get the pointer
IDIVI T3,5 ; Make word/char index
ADDI T3,.BKTLN(P1) ; Make it an abs address
HRRM T3,EXLP.1(P4) ; Save the address
MOVNI T4,-5(T4) ; Make the size for the final store
IMULI T4,7 ; Mul by the number of bits per character
STOR T4,XPNPTR,BP.SFL ; Store the item in the size field
MOVE T1,P2 ; Get the amount to move
IDIVI T1,5 ; Make it the number of words/chars
IMULI T2,-7 ; remainder times seven for number of bits
HRRM T2,EXLP.2(P4) ; Store the amount to shift
ADDI T2,^D35 ; Get the amount left to shift the rest
MOVN T2,T2 ; Make it positive
HRRM T2,EXLP.4(P4) ; Store it
ADDI T1,1(T3) ; Increment
HRRM T1,EXLP.3(P4) ; Store the address to store to
; Now calculate the number of times we must loop
LOAD. T3,BLKEND,(P1) ; Get the end
IDIVI T3,5 ; Convert to word/char
MOVE T1,P3 ; Get the address of the first one
IDIVI T1,5 ; Make it the word address
SUB T3,T1 ; And make the number of words to move
LOAD. T1,BLKEND,(P1) ; Get the end back
ADD T1,P2 ; Make the new end
IDIVI T1,5 ; And check if we are rotating out of the last word
JUMPN T2,M$XP.7 ; Zero chars extra here?
MOVEI T2,5 ; Yes, make that five as well
JUMPN T4,M$XP.7 ; Also zero chars left after old end?
SOJ T3, ; Yes, need one less loop iteration
M$XP.7: CAILE T4,(T2) ; Will we be shifting it out?
ADDI T3,1 ; Yes, need one more
MOVE T2,@EXLP.1(P4) ; Compute the address
JRST EXLP.5(P4) ; Enter the loop
; The following is the code used to move characters up.
;
;LP: MOVE T1,<PT/5>(T3) ; Get a word
; ROT T1,-1 ; Get rid of the extra bit
; ROTC T1,-7*<# chars to insert>/5 ; Move chars down into T2
; MOVEM T2,<<PT/5>+<# chars to insert>/5>(T3)
; ROTC T1,-<35-7*<# chars to insert>/5>
; SOJGE T3,LP ; Loop for <<END/5>-<PT/5>> + 1 if
; ; REM(<<# to insert>+END>/5) > REM(PT/5)
;
EXLP: PHASE 0 ; Code for moving text up
EXLP.1:!MOVE T1,.-.(T3) ; Get the low order portion
ROT T1,-1 ; Shift to get rid of the extra bit
EXLP.2:!ROTC T1,.-. ; Move into the other word
TXZ T2,1 ; Make sure the random bit is off
EXLP.3:!MOVEM T2,.-.(T3) ; Store the word
EXLP.4:!ROTC T1,.-. ; Rotate the rest of the way
EXLP.5:!SOJGE T3,.-. ; Loop until done
JRST M$XP.3 ; Continue on
DEPHASE ; Back to real addresses
NEXLP==.-EXLP ; Length of the loop
; Here to use the POP loop to move the text. This is only when
;a multiple of 5 characters are being inserted. Enter with the
;number of words being inserted in T1.
M$XP.8: HRLI T1,(POP T2,(T2)) ; Get the instruction into the AC
LOAD. T2,BLKEND,(P1) ; Get the old end
SOJ T2, ; Minus one
IDIVI T2,5 ; Convert to word offset
MOVE T3,P3 ; Get the PT where the insert is
SOJ T3, ; Account for starting at 0
IDIVI T3,5 ; And make the word offset to it
MOVE T4,T2 ; Get a copy of the address
SUB T4,T3 ; Get the number of words we are moving
ADDI T2,.BKTLN(P1) ; Point to the first word to move
HRLI T2,(T4) ; Set up counter portion of stack pointer
TXCN T2,1B0 ; . . .
XCT T1 ; And move the text
JUMPL T2,.-1 ; . . .
JRST M$XP.4 ; All done, go fix up the header
M$XP.3: PORTAL .+1 ; In case of EXO
HRRZ T3,EXLP.2(P4) ; Get the number
ROTC T1,^D35(T3) ; Move the characters around
HRRZ T3,EXLP.3(P4) ; Get the address to deposit into
DPB T1,XPNPTR ; Store the information
IFN FTDEBUG,<
SETZM XPNPTR ; Clear the pointer to prevent MUP stopcodes
> ; End of IFN FTDEBUG
ADJSP P,-NEXLP ; Fix the stack pointer
M$XP.4: LOAD. T1,BLKEND,(P1) ; Get the end
ADD T1,P2 ; Plus the new char
STOR. T1,BLKEND,(P1) ; And store the new end
MOVE T1,P1 ; Get the address of the buffer back
LOAD. T2,BLKFRE,(P1) ; Fix up the number free
SUB T2,P2 ; . . .
STOR. T2,BLKFRE,(P1) ; . . .
IFN FTDEBUG,<
PUSHJ P,M$CFRE ; Check the text blocks
>; End of IFN FTDEBUG
POPJ P, ; And return it to the caller
SUBTTL M$XMOV - Routine to expand a movable block
;+
;.hl1 M$XMOV
; This routine is called to expand a general movable block. This type
;of block is only pointed to be the TPT list, and contains no data which
;is address dependent. Therefore it can be easily moved if necessary in order
;to expand it.
;.lit
;
; Usage:
; LOAD. T1,TPTADR,address.of.TPT to block
; MOVE T2,Number of words to expand
; MOVE T3,Index to first word to move down
; PUSHJ P,M$XMOV
; (return here always, T1= address of block (may have changed))
;
;.end lit
;-
M$XMOV: JUMPE T2,.POPJ ; All done if nothing
IFN FTDEBUG,<
PUSHJ P,M$CFRE ; Check things out
> ; End of IFN FTDEBUG
$SAVE <P1,P2,P3,P4> ; Save some ac's to use
MOVE P1,T1 ; Get the address of the block
DMOVE P2,T2 ; Get how much to expand and where
LOAD. P4,BLKSIZ,(T1) ; Get the size of the block
LOAD. T4,BLKFRW,(T1) ; And the number of free words
SUB P4,T4 ; Get the actual size of the block
PUSHJ P,M$APPD ; Append some space to the block
JRST MXMO.M ; Block was moved, we must move the contents
CAML P3,P4 ; Have something to move?
POPJ P, ; No, all done
MOVE P1,T1 ; Get the new address
MOVE T2,P4 ; Get the size of the block
ADD T2,P1 ; Point to the last word
MOVE T1,P3 ; Get the offset to the insertion point
SUB T1,P4 ; And get the number of words to move (negative)
MOVE T3,T2 ; Get a copy of the old address
ADD T3,P2 ; And determine the new address
PUSHJ P,M$MCOR ; Move the data
MOVE T1,P1 ; Get the address of the buffer back
POPJ P, ; And return
; Here if the call to M$APPD caused the block to be moved.
; Ac usage on entry:
; T1/ Old.block.address
; T2/ Number of words being inserted
; T3/ New.block.address
; P3/ Offset to insertion
MXMO.M: DMOVE P1,T1 ; Get the returned values
MOVE P4,T3 ; . . .
MOVE T1,P3 ; Get the offset to the first word
SUBX T1,.BKMLN ; Minus the overhead
XMOVEI T2,.BKMLN(P1) ; Get the starting address
XMOVEI T3,.BKMLN(P4) ; And the new address
PUSHJ P,M$MCOR ; Move the data
LOAD. T1,BLKSIZ,(P1) ; Get the size of the old block
LOAD. T2,BLKFRW,(P1) ; And the number of free words
SUB T1,T2 ; Determine the size that was in use
SUB T1,P3 ; And the amount past the insert position
XMOVEI T2,.BKMLN(P1) ; Get the starting address
ADD T2,P3 ; . . .
XMOVEI T3,.BKMLN(P4) ; And the new address
ADD T3,P3 ; . . .
ADD T3,P2 ; . . .
PUSHJ P,M$MCOR ; Move the data
XMOVEI T1,.BKLEN(P1) ; Get the address of the first word past the header
PUSHJ P,M$RBLK ; And return the old block
MOVE T1,P4 ; Get the new address
POPJ P, ; And return
SUBTTL M$APPD - Routine to append to a movable block
;+
;.hl1 M$APPD
; This routine will append space to a movable block. It may be called
;for any type of movable block.
;.lit
;
; Usage:
; T1/ Address of block
; T2/ Number of words to expand
; T3/ Data to be passed to subroutine in ac P3
; PUSHJ P,M$APPD
; (non-skip return, block was moved, new address in T1)
; (skip return, block was not moved, block address still in T1)
;
;.end lit
; On the non-skip return, the ac's will be as follows:
;.lit
;
; T1/ Address of old block
; T2/ Number of words being expanded
; T3/ Address of new block
;
;.end lit
;-
M$APPD: JUMPE T2,.POPJ ; Just return if nothing to add
$SAVE <P1,P2,P3> ; Save some ac's
DMOVE P1,T1 ; And copy the arguments
IFN FTDEBUG,<
PUSHJ P,M$CFRE ; Check out the block list
> ; End of IFN FTDEBUG
MAPP.0: LOAD. T2,BLKFRW,(P1) ; Get the amount free in this block
CAMGE T2,P2 ; Have enough?
JRST MAPP.1 ; No, must look for more
SUB T2,P2 ; Yes, decrement the count of free words
STOR. T2,BLKFRW,(P1) ; Store it back
ADD T2,P2 ; Get the old amount free back
LOAD. T3,BLKSIZ,(P1) ; And get the size
SUB T3,T2 ; Get the amount actually used
MOVE T1,P2 ; Get the amount to clear
MOVE T2,P1 ; And get the address to start at
ADD T2,T3 ; . . .
PUSHJ P,.ZCHNK ; Clear it out
DMOVE T1,P1 ; Get the address back
PJRST .POPJ1 ; And give the skip return
; Here if the block does not contain enough free space to allow for
;expansion. Check if the next block is free, and try again.
MAPP.1: MOVX T3,BF.LST ; Check if the last block here
TDNE T3,.BKFLG(P1) ; Is it?
JRST MAPP.L ; Yes, go handle it
LOAD. T1,BLKSIZ,(P1) ; No, get the size of this block
ADD T1,P1 ; And determine the address of the next
CFXE. T3,BLKTYP,(T1),.BTJNK ; Is it junk?
JRST MAPP.2 ; No, must do things the hard way
LOAD. T3,BLKSIZ,(T1) ; Yes, get the size
ADD T2,T3 ; Determine the new amount free
LOAD. T4,BLKSIZ,(P1) ; Get the size of the current block
ADD T3,T4 ; And make the new total
STOR. T3,BLKSIZ,(P1) ; Store in the new size
STOR. T2,BLKFRW,(P1) ; And number of free words
LOAD. T3,BLKNXT,(T1) ; Get the next page address
STOR. T3,BLKNXT,(P1) ; Copy it
LOAD T3,.BKFLG(T1),BF.LST ; Get the last block flag
STOR T3,.BKFLG(P1),BF.LST ; Store it
JRST MAPP.0 ; And check if we have enough
; Here if the block is at the end of core. We can just add the memory to
;our address space (maybe), and make it part of this block.
MAPP.L: LOAD. T1,BLKSIZ,(P1) ; Get the size of the block
LOAD. T2,BLKFRW,(P1) ; And the amount free
SUB T1,T2 ; Get the number of words in use
ADD T1,P2 ; Get the number we will want
ADD T1,P1 ; And get the new final address +1
MOVE T2,T1 ; Get a copy
SOJ T2, ; Minus one to be the address we really want
CAMG T2,.JBREL ; Need to expand at all?
JRST MAPP.M ; No, go do it
CAIL T2,HIGH## ; Will this overlap with the high segment?
ERROR E.COR ; Yes, punt
ADR2PG T2 ; Make this a page number
LOAD. T1,BLKSIZ,(P1) ; Get the size of the block
ADD T1,P1 ; Point to the end of the block
SUBI T1,1 ; Point to the last word in the block
ADR2PG T1 ; Make this a page number
SUB T2,T1 ; Compute the number of pages to allocate
ADDI T1,1 ; Point to the first page we are allocating
PUSHJ P,M$CPGS ; Create the pages
ERROR E.COR ; Failed
MOVE T1,.JBREL ; Get the new end of core
AOJ T1, ; Plus one to point at first free past end
MAPP.M: MOVEM T1,.JBFF ; No, store new first free
SUB T1,P1 ; Get the new size of the block
LOAD. T2,BLKSIZ,(P1) ; Get the old size
STOR. T1,BLKSIZ,(P1) ; And store the new size
SUB T1,T2 ; Get the amount we are adding
LOAD. T2,BLKFRW,(P1) ; Get the current number free
ADD T2,T1 ; Get the new amount
STOR. T2,BLKFRW,(P1) ; Store it
JRST MAPP.0 ; Go try again
; Here if we need to move the block somewhere else in order to expand it.
;Get a new block large enough for the entire amount needed.
MAPP.2: ADJSP XS,$XSCLN ; Allocate the pointer
STORI. $XEMEM,T1,XSBTYP,(XS) ; Store the type
XMOVEI T2,$XSBUF(XS) ; Get the address of the pointer
MOVE T1,P1 ; And of the buffer
IFN FTDEBUG,SETZM (T2) ; Clear the point so we don't punt
PUSHJ P,M$USEB ; Set up the pointer
LOAD. T1,BLKSIZ,(P1) ; Get the current size of the block
LOAD. T2,BLKFRW,(P1) ; And the amount free
SUB T1,T2 ; Get the actual size
ADD T1,P2 ; And determine the amount we need
LOAD. T2,BLKTYP,(P1) ; Get the correct block type
SUBX T1,.BKLEN ; Take off the overhead (M$GBLK adds it back)
PUSHJ P,M$ZBLK ; And get a block
SUBX T1,.BKLEN ; Get the actual address
MOVE P3,T1 ; Get the address of the new block
LOAD. P1,TPTADR,+$XSBUF(XS) ; And the address of the old
XMOVEI T1,$XSBUF(XS) ; Get the address of the pointer
PUSHJ P,M$RELB ; Release the pointer
ADJSP XS,-$XSCLN ; Remove the junk from the stack
MOVE T1,P3 ; Get the address of the new block
LOAD. T2,BLKADR,(P1) ; Get the address of the TPT's
STOR. T2,BLKADR,(T1) ; Store in the new block
PUSHJ P,FIXPTR ; Fix them up
ZERO. ,BLKADR,(P1) ; Clear the TPT address in the old block
DMOVE T1,P1 ; Get the return values
MOVE T3,P3 ; . . .
POPJ P, ; And return
SUBTTL M$SRNK - Routine to shrink a buffer
;+
;.HL1 M$SRNK
; This routine will shrink a text buffer by removing a number of characters
;from just after the pointer. It will move the characters from the end of the
;buffer down.
;.b
;.literal
; Usage:
; MOVE T1,Text.buffer.address
; MOVE T2,Number.of.characters
; MOVE T3,Offset.for.pointer
; PUSHJ P,M$SRNK
; (return here)
;.end literal
;-
M$SRNK:
JUMPE T2,.POPJ ; Just return if nothing to do
IFN FTDEBUG,<
PUSHJ P,M$CFRE ; Check the text blocks
>; End of IFN FTDEBUG
$SAVE <P1,P2,P3,P4> ; Save some room to work
DMOVE P1,T1 ; Copy the address and number of chars
MOVE P3,T3 ; Get the pointer
ADD T2,T3 ; Get the destinaion
IDIVI T2,5 ; And make the byte pointer
HLL T2,BTAB-1(T3) ; . . .
ADDX T1,.BKTLN ; Point to the text
ADD T1,T2 ; Make the byte pointer
MOVE T2,P3 ; And the pointer to start at
IDIVI T2,5 ; Convert to index plus byte number
HLL T2,BTAB-1(T3) ; Make the byte pointer
ADDI T2,.BKTLN(P1) ; Point to the place to move to
LOAD. T3,BLKEND,(P1) ; Get the end pointer
SUB T3,P3 ; Get the number of chars to move
SUB T3,P2 ; Don't need to move the ones we are deleting
PUSHJ P,M$MSTR ; Move the string
LOAD. T1,BLKEND,(P1) ; Calculate the new end
SUB T1,P2 ; . . .
STOR. T1,BLKEND,(P1) ; And save it
LOAD. T1,BLKFRE,(P1) ; Get the number of free chars already there
ADD T1,P2 ; Plus the number deleted
STOR. T1,BLKFRE,(P1) ; Save the new free char count
IFN FTDEBUG,<
PUSHJ P,M$CFRE ; Check the text blocks
>; End of IFN FTDEBUG
CAXGE T1,D.MXFR ; More than the max we want to leave here?
POPJ P, ; Return if not too many free
IDIVI T1,5 ; Get the number of words we can steal
STOR. T2,BLKFRE,(P1) ; Save the new free count
LOAD. T2,BLKSIZ,(P1) ; Get the size
SUB T2,T1 ; Make the new size
STOR. T2,BLKSIZ,(P1) ; Store the size
ADD T2,P1 ; Point to the new block
STORI. .BTJNK,T3,BLKTYP,(T2) ; Store the block type
STOR. T1,BLKSIZ,(T2) ; Save the size
LOAD. T1,BLKNXT,(P1) ; Get the next pointer
STOR. T1,BLKNXT,(T2) ; Store it
ZERO. T1,BLKFLG,(T2) ; Clear the flags
MOVX T1,BF.LST ; Get the last in page bit
TDNE T1,.BKFLG(P1) ; Is the old one the last?
IORM T1,.BKFLG(T2) ; Yes, now the new one is
ANDCAM T1,.BKFLG(P1) ; Clear the last bit in case
IFN FTDEBUG,<
PUSHJ P,M$CFRE ; Check the text blocks
>; End of IFN FTDEBUG
POPJ P, ; Return
SUBTTL M$ACHR - Subroutine to append a character to a buffer
;+
;.hl1 M$ACHR
; This routine is used to append a single character to the a buffer.
;.lit
;
; Usage:
; MOVEI CH,Character
; MOVEI T1,TPT.address
; PUSHJ P,M$ACHR
; (Return here)
;
;.end lit
;-
M$ACHR: $SAVE <P1,P2> ; Save P1/2
MOVE P1,T1 ; Get the address of the TPT
LOAD. P2,TPTADR,(P1) ; Get the address of the buffer
SOSGE .BKFRE(P2) ; Any characters free
JRST MACH.1 ; No, need to expand it first
INCR. ,BLKPT,(P2) ; Increment the count of characters
LOAD. T1,BLKEND,(P2) ; Get the current end
INCR. ,BLKEND,(P2) ; And increment it
BLDBPT (T1,(P2)) ; Build a byte pointer
IDPB CH,T1 ; Store the character
POPJ P, ; And return
; Here if the block needs to be expanded.
MACH.1: ZERO. ,BLKFRE,(P2) ; Reset the free count
MOVE T1,P2 ; Get the address of the buffer
MOVEI T2,1 ; One character
LOAD. T3,BLKEND,(P2) ; At the end of the buffer
PUSHJ P,M$XPND ; Expand it
LOAD. T2,BLKEND,(T1) ; Get the new end
STOR. T2,BLKPT,(T1) ; Fix up PT
SOJ T2, ; Make it the previous character
BLDBPT (T2,(T1)) ; Build the pointer
IDPB CH,T2 ; Store the character
POPJ P, ; And return
SUBTTL M$INSS - Routine to insert a string into a buffer
;+
;.Hl1 M$INSS
; This routine will copy a string into a buffer.
;.b
;.literal
; Usage:
; MOVE T1,Source.byte.pointer
; MOVE T2,Source.byte.count
; MOVE T3,Text.buffer.address
; MOVE T4,Address.of.TPT.pointer.for.source (or zero if source will not move)
; PUSHJ P,M$INSS
; (return here, T1=Offset to end of new string within buffer)
;.end literal
;-
M$INSS: $SAVE <P1,P2,P3,P4> ; Save the Px ac's
DMOVE P1,T1 ; And copy the args
DMOVE P3,T3 ; . . .
JUMPE P4,M$IN.1 ; Source may move?
LOAD. T1,TPTADR,(P4) ; Yes, get the address of the buffer
SUBI P1,(T1) ; And make the byte pointer relative to the start of the buffer
M$IN.1: MOVE T1,T3 ; Set up to expand the buffer
LOAD. T3,BLKPT,(P3) ; Get the place to insert the string
PUSHJ P,M$XPND ; Do it
MOVE P3,T1 ; Update the buffer address
JUMPE P4,M$IN.2 ; Need to fix the byte pointer back?
LOAD. T1,TPTADR,(P4) ; Yes, get the address
ADDI P1,(T1) ; And fix it
M$IN.2: MOVE T1,P1 ; Get the source byte pointer
LOAD. T2,BLKPT,(P3) ; Get the place to insert at
IDIVI T2,5 ; Convert to word index and position within word
ADDI T2,.BKTLN(P3) ; Make the address
HLL T2,BTAB-1(T3) ; Set the other half of the byte pointer
MOVE T3,P2 ; Get the character count
PUSHJ P,M$MSTR ; Move the string
LOAD. T1,BLKPT,(P3) ; Get the pointer
ADD T1,P2 ; Plus the string length gives new pointer
POPJ P, ; Return it
SUBTTL M$USEB - Routine to add a user to a block
;+
;.Hl1 M$USEB
; This routine is called to add a pointer to a block.
;.b
;.literal
; Usage:
; MOVE T1,Text.buffer.address
; MOVE T2,Pointer.address
; PUSHJ P,M$USEB
; (return here) ; Pointer now pointing at the text buffer
;.end literal
;-
M$USEB: $SAVE <P1> ; Save P1
IFN FTDEBUG,<
SKIPE (T2) ; Have something here already?
STOPCD MUP,<Multiple use of text pointer>
> ; End of IFN FTDEBUG
STOR. T1,TPTADR,(T2) ; Save the buffer address in the pointer
LOAD. P1,BLKADR,(T1) ; Get the address of the pointer list
STOR. T2,BLKADR,(T1) ; Store the new one
STOR. P1,TPTNXT,(T2) ; And store the next pointer
POPJ P, ; Return
SUBTTL M$RELB - Routine to delete a user from a block
;+
;.Hl1 M$RELB and M$RTPT
; These routines are called to remove a pointer to a block. M$RELB
;will also delete the block if there are no pointers left that point
;to it.
;.b
;.literal
; Usage:
; MOVE T1,Pointer.address
; PUSHJ P,M$RELB
; (return here) ; Pointer now zero
;.end literal
;-
M$RTPT: TDZA T2,T2 ; Flag to not return the block
M$RELB: SETO T2, ; Flag to return the block if no one left
$SAVE <P1,P2,P3> ; Save P1/P2
MOVE P3,T2 ; Save the flag
MOVE P1,T1 ; Save the args
LOAD. P2,TPTADR,(P1) ; Get the address of the text buffer
LOAD. T1,BLKADR,(P2) ; Get the address of the first block
SETZ T2, ; Clear the last pointer
M$RE.1: CAMN T1,P1 ; Is this the right pointer?
JRST M$RE.2 ; Yes
MOVE T2,T1 ; Remember the last pointer
LOAD. T1,TPTNXT,(T1) ; And get the next one
IFE FTDEBUG,JRST M$RE.1 ; Loop until we find it
IFN FTDEBUG,<
JUMPN T1,M$RE.1 ; Check if pointer is okay
STOPCD PTZ,<Text pointer pointing to zero>
> ; End of IFN FTDEBUG
M$RE.2: LOAD. T1,TPTNXT,(P1) ; Get the next pointer from the callers
ZERO. ,TPTADR,(P1) ; Clear the pointer
ZERO. ,TPTNXT,(P1) ; . . .
JUMPE T2,M$RE.3 ; Need to fix the block itself?
STOR. T1,TPTNXT,(T2) ; No, fix the next pointer on the previous one
POPJ P, ; Return
; Here if the pointer in the text block needs to be fixed. Check if we can
;delete this block.
M$RE.3: STOR. T1,BLKADR,(P2) ; Update the block pointer
JUMPN T1,.POPJ ; If we have a real pointer, just return
JUMPE P3,.POPJ ; Return if M$RTPT entry point
MOVE T1,P2 ; Get the address to delete
LOAD. T2,BLKTYP,(P2) ; Get the block type
PJRST @RLBTBL(T2) ; And return the block
; Table of routines to return blocks
TABDEF RLB,.BT,<IFIW DBLK.0>
TABENT SYM,<IFIW DSYM.0> ; Delete a symbol table entry
TABENT TXT,<IFIW DTXT.0>
TABENT CND,<IFIW DCND.0>
TABENT CTB,<IFIW DCTB.0>
TABEND
SUBTTL Linked list -- M$ULNK - Routine to unlink a block
;+
;.hl1 M$ULNK
;This routine will unlink a block from a linked list. It will return the
;address of the block that was unlinked.
;.literal
;
; Usage:
; T1/ Address of the block to unlink
; T2/ Offset to the LNK pointers
; PUSHJ P,M$ULNK
; (Return)
;
; On return:
; T1/ Address of the block that was unlinked.
;
;.end literal
;-
M$ULNK: PUSHJ P,UNLINK ; Unlink the block
LOAD. T2,BLKTYP,(T1) ; Get the block type
PJRST @RBKTBL(T2) ; Go release the block
; Table of routines to return blocks
TABDEF RBK,.BT,<IFIW DELBLK>
TABENT SYM,<IFIW DELSYM> ; Delete a symbol table entry
TABENT TXT,<IFIW DELTXT> ; Delete a text block
TABENT CND,<IFIW DELCND>
TABENT CTB,<IFIW M$DCTB>
TABEND
SUBTTL Linked list -- M$MLNK - Move an item from one list to another
;+
;.hl1 M$MLNK
;This rutine will move a block rom one linked list to another. It will
;first unlink the block from the first list then it will link it into the
;other.
;.literal
;
; Usage:
; T1/ Address o the block to move
; T2/ Offset of the LNK pinter to unlink from
; T3/ Address of block to link in before
; T4/ Offset of the new LNK pointers
; PUSHJ P,M$MLNK
; (Return)
;
; On return:
; - Block linked in
;
;.end literal
;-
M$MLNK: PUSHJ P,UNLINK ; Unlink this block from the list
MOVE T2,T4 ; Get the new LNK offset
FALL M$LINK ; Fall into M$LINK
SUBTTL Linked list -- M$LINK - Routine to add a block to a linked list
;+
;.HL1 M$LINK
; This routine will link in a block into a linked list. It will set up
;the forward and back pointers correctly.
;.literal
;
; Usage:
; T1/ Address of block to link in
; T2/ Offset to the LNK pointers
; T3/ Address of block to link in before
; PUSHJ P,M$LINK
; (Return)
;
; On return:
; T1/ Address of the blocked listed in
;
;.end literal
;-
M$LINK: MOVE T4,T1 ; Copy this address
ADD T4,T2 ; Point to the link pointers
STOR. T3,LNKPRV,(T4) ; Store the pointer to the previous
ADD T3,T2 ; Point to the link pointers
PUSH P,T3 ; Save the address of the pointer
LOAD. T3,LNKNXT,(T3) ; Get the address of the next
STOR. T3,LNKNXT,(T4) ; Point to that too
POP P,T4 ; Get the pointer address back
STOR. T1,LNKNXT,(T4) ; And store the new next pointer
JUMPE T3,.POPJ ; Return if end of list
ADD T3,T2 ; Point to the LNK word
STOR. T1,LNKPRV,(T3) ; Store the pointers
POPJ P, ; Return to the caller
SUBTTL Linked list -- UNLINK - General unlink this block routine
;+
;.hl1 UNLINK
;This routine will unlink a block from the list that it currently is attached
;to. It will not smash any registers.
;.literal
;
; Usage:
; T1/ Block address
; T2/ LNK pointers offset
; PUSHJ P,UNLINK
; (return)
;
; On return:
; - Block unlinked, all registers preserved.
;
;.end literal
;-
UNLINK: $SAVE <T1,T2,T3,T4> ; Save Tn over this call
ADD T1,T2 ; Get the address of the pointers
LOAD. T3,LNKPRV,(T1) ; Get the address of the previous block
JUMPE T3,[STOPCD PBH,<Previous block is the header>]
ADD T3,T2 ; Point to the links
LOAD. T4,LNKNXT,(T1) ; Get the address of the next block
STOR. T4,LNKNXT,(T3) ; Store the pointer to the next
ZERO. ,LNKNXT,(T1) ; Clear out the old info
ZERO. ,LNKPRV,(T1) ; . . .
JUMPE T4,.POPJ ; Just return if no next to fix
ADD T4,T2 ; Point to the offset
SUB T3,T2 ; Get the address we are supposed to store
STOR. T3,LNKPRV,(T4) ; No, Store the pointer this way too
POPJ P, ; Return to the caller
SUBTTL M$CFRE - Check the free counts of text blocks
;+
;.HL1 M$CFRE
;This routine will check the text blocks to see if they contain valid
;character counts.
;.literal
;
; Usage:
; PUSHJ P,M$CFRE
; (Return)
;
;.end literal
;-
IFN FTDEBUG,<
M$CFRE: PUSH P,[EXP M$CF.2] ; Save the exit routine address
$SAVE <T1,P1,P2,P3,P4> ; Save some ac's
MOVE P1,FSTBLK ; Get the address of the first block
MOVEI T1,FSTBLK ; Flag we are working from first block
M$CF.1: SKIPN (P1) ; Bad block?
STOPCD BLS,<Block list screwed up>
LOAD. P2,BLKTYP,(P1) ; Get the block type
CAXLE P2,.BTMAX ; Reasonable value?
STOPCD BTO,<Block type out of range>
CAXE P2,.BTTXT ; Is this a text block?
JRST M$CF.0 ; No - Skip to the next block
LOAD. P2,BLKFRE,(P1) ; Get the number of characters that are free
LOAD. P3,BLKEND,(P1) ; Get the number at the end
ADD P2,P3 ; Add to get the total in the block
LOAD. P3,BLKSIZ,(P1) ; Get the size of the block
SUBX P3,.BKTLN ; Minus the overhead words
LOAD. P4,BLKFRW,(P1) ; Get the number of free words here as well
SUB P3,P4 ; And get the amount actually in use
IMULX P3,5 ; Mul by 5 to get the number of characters
CAME P2,P3 ; Which should match the calculated
STOPCD BSM,<Block size messed up>
M$CF.0: MOVX P2,BF.LST ; Check for the last block
TDNE P2,.BKFLG(P1) ; Is this the last block ?
POPJ P, ; And return
LOAD. P2,BLKSIZ,(P1) ; Get the block size again
SKIPN P2 ; Is it ok?
STOPCD CFB,<M$CFRE found a zero block>
MOVE T1,P1 ; Remember this block in case it messes up next
ADD P1,P2 ; Point to the next block
JRST M$CF.1 ; Loop for the next block
; Here when we have done the whole list. This means that everthing is fine
;and we should remember where we came from. We will save the entire stack
;context to make back tracking easier (a little expensive in space, but it
;should save some debugging time).
M$CF.2: MOVEM 0,CFRSAC ; Save ac 0
MOVE 0,[XWD 1,CFRSAC+1] ; And set up to save the rest
BLT 0,CFRSAC+17 ; Save them all
MOVE 0,P ; Get the current stack pointer
SUBI 0,PDL ; Make it the offset
ADDI 0,CFRPDL ; And convert to our saved copy
MOVEM 0,CFRSAC+P ; Save it that way
MOVE 0,[XWD PDL,CFRPDL] ; Set up to copy the stack
BLT 0,CFRPDL+D.PDLL-1 ; Copy the whole stack
MOVE 0,CFRSAC ; Restore 0
POPJ P, ; And return
>; End of IFN FTDEBUG
SUBTTL FNDBLK - Routine to find a given size block
;+
;.hl1 FNDBLK
; This routine will find a junk block of at least the given size.
;.b
;.literal
; Usage:
; MOVEI P1,Number.of.words
; PUSHJ P,FNDBLK ; Find the block
; (Return with T1= address of block)
;
;.end literal
;-
FNDBLK: MOVE T1,FSTBLK ; Get the pointer to the first block
FNDB.0: CFXE. T2,BLKTYP,(T1),.BTJNK ; Junk block?
JRST FNDB.1 ; No, try the next
LOAD. T2,BLKSIZ,(T1) ; Yes, get the size
CAML T2,P1 ; Large enough?
POPJ P, ; And return
; Here to advance to the next block
FNDB.1: MOVX T3,BF.LST ; Is this the last block on a page?
TDNE T3,.BKFLG(T1) ; . . .
JRST FNDB.2 ; No, get next block on this page
LOAD. T2,BLKSIZ,(T1) ; Get the size
IFN FTDEBUG,<
JUMPG T2,.+2 ; Size okay?
STOPCD FZB,<FNDBLK found a zero length block>
> ; End of IFN FTDEBUG
ADD T1,T2 ; Point to the next block
JRST FNDB.0 ; And try this one
FNDB.2: LOAD. T1,BLKNXT,(T1) ; Yes, get the next page number
JUMPE T1,.POPJ1 ; Give not found return
PG2ADR T1 ; Convert to an address
JRST FNDB.0 ; Go try this block
SUBTTL M$CBLK - Routine to create a block of the given size
;+
;.Hl1 M$CBLK
; This routine will request core from the monitor and create a block
;of the given size. Any extra core will be made into a junk block.
;.b
;.literal
; Usage:
; MOVEI P1,Number.of.words
; PUSHJ P,M$CBLK
; (return, T1= address of block)
;
;.end literal
;-
M$CBLK: MOVE T1,FSTBLK ; Get the address of the first block
MOVX T2,BF.LST ; Get the last on page flag
M$CB.0: TDNE T2,.BKFLG(T1) ; Is this the last block before a hole?
JRST M$CB.1 ; Yes, get the next block
LOAD. T3,BLKSIZ,(T1) ; No, get the size
IFN FTDEBUG,<
JUMPG T3,.+2 ; Skip if size is valid
STOPCD CZB,<M$CBLK found a zero length block>
> ; End of IFN FTDEBUG
ADD T1,T3 ; And point to the next
JRST M$CB.0 ; Loop
M$CB.1: LOAD. T3,BLKNXT,(T1) ; Get the next page number
JUMPE T3,M$CB.2 ; No next page, this is the last block
PG2ADR T3 ; Convert to an address
MOVE T1,T3 ; And copy it
JRST M$CB.0 ; Go through this page
M$CB.2: PUSH P,T1 ; Save the block address
CFXE. T2,BLKTYP,(T1),.BTJNK ; Is this a junk block?
MOVE T1,.JBFF ; No, use the end of core
MOVE T2,T1 ; Copy the address of the block
ADD T1,P1 ; Get the final address we need
ADDX T1,.BKLEN ; . . .
CAMG T1,.JBREL ; Can we already address this?
JRST M$CB.3 ; Yes, just go use it
IFE FTXADR,<
TXNE T1,LH.ALF ; Falling into left half?
ERROR E.COR ; Yes, give up
>; End of IFE FTXADR
PUSH P,T2 ; Save this register
ADR2PG T1 ; Make this a page number
MOVE T2,.JBREL ; Get the end of core
ADR2PG T2 ; Convert this to a page number
EXCH T1,T2 ; Move this into each other
SUB T2,T1 ; Compute the number of pages
ADDI T1,1 ; Account for the boundary
PUSHJ P,M$CPGS ; Create the pages
ERROR E.COR ; Punt
POP P,T2 ; Get the block address back
M$CB.3: EXCH T2,(P) ; Save on the stack
BITOFF T1,BF.LST,.BKFLG(T2) ; Clear the last block bit
POP P,T2 ; And restore T2
ZERO. T1,BLKNXT,(T2) ; Clear the next pointer
ZERO. T1,BLKFLG,(T2) ; And the flags
MOVE T1,P1 ; Get the size
AOJ T1, ; Bump it
STOR. T1,BLKSIZ,(T2) ; Store the size
EXCH T1,T2 ; Swap the size and address
ADD T2,T1 ; Get the address of the next block
MOVE T3,.JBREL ; Get the end of core
AOJ T3, ; Plus one
MOVEM T3,.JBFF ; Save as first free
SUB T3,T2 ; Get the number left
JUMPL T3,M$CB.4 ; Any left?
STOR. T3,BLKSIZ,(T2) ; Yes, store it
ZERO. T3,BLKFLG,(T2) ; clear the flags
ZERO. T3,BLKNXT,(T2) ; And the next pointer
BITON T3,BF.LST,.BKFLG(T2) ; Flag this is the last page
STORI. .BTJNK,T3,BLKTYP,(T2) ; Flag this is free
POPJ P, ; And return
M$CB.4: BITON T2,BF.LST,.BKFLG(T1) ; Flag this is the last block
POPJ P, ; Return
SUBTTL M$GC -- Main loop
;+
;.hl1 M$GC
;This routine will garbage collect all of the junk blocks into one position.
;This routine is hell on a paging system.
;.literal
;
; Usage:
; PUSHJ P,M$GC
; (Return)
;
;.end literal
;-
M$GC: $SAVE <P1,P2,P3> ; Save a few registers
IFN FTDEBUG,PUSHJ P,M$CFRE ; Make sure all is ok
MOVE P3,FSTBLK ; Start with the first block
SETZB P1,P2 ; No junk block and size
; The following is the main loop in the GC processor
M$GC.0: LOAD. T1,BLKTYP,(P3) ; Get the block type of this
JUMPN P1,M$GC.1 ; Have a junk block already?
; Here if we don't have a previous junk block. Just dispatch on the block
; type to determine what we should do.
SKIPE T2,GCTBL(T1) ; Have a routine to call?
PUSHJ P,(T2) ; Call the routine
JRST M$GC.N ; Advance to the next routine
; Here if there was a junk block before this block.
M$GC.1: SKIPN T2,GCJTBL(T1) ; Have a routine to call
MOVE T2,[EXP IFIW!GCJOTH] ; No, use the default
PUSHJ P,(T2) ; Call the processing routine
FALL M$GC.N ; Advance to the next block
; Here to determine if there is a next block to process
M$GC.N: MOVX T1,BF.LST ; End of this list?
TDNE T1,.BKFLG(P3) ; . . .
IFE FTDEBUG,POPJ P, ; Yes, All done
IFN FTDEBUG,PJRST M$CFRE ; When done, check things out again
LOAD. T1,BLKSIZ,(P3) ; Get the size of the block
ADD P3,T1 ; Point to the next block
JRST M$GC.0 ; Loop and process
SUBTTL M$GC -- Dispatch tables
; The following dispatch table is for the processing of a block if the
; previous block was not a junk block.
TABDEF GC,.BT
TABENT TXT,<IFIW GCTXT> ; Text blocks
TABENT JNK,<IFIW GCJNK> ; Junk blocks
TABENT CTB,<IFIW GCCTB> ; Command tables
TABENT CND,<IFIW GCCND> ; Command nodes
TABENT MOV,<IFIW GCMOV> ; General movable block
TABENT SYM,<IFIW GCSYM> ; Symbol table entries
TABEND
; The following dispatch table is for the processing of a block if the
; previous block was a junk block
TABDEF GCJ,.BT
TABENT TXT,<IFIW GCJTXT> ; Text blocks
TABENT JNK,<IFIW GCJJNK> ; Junk blocks
TABENT CTB,<IFIW GCJCTB> ; Command tables
TABENT CND,<IFIW GCJCND> ; Command nodes
TABENT MOV,<IFIW GCJMOV> ; General movable block
TABENT SYM,<IFIW GCJSYM> ; Symbol table entries
TABEND
SUBTTL M$GC -- Previous not junk -- GCJNK - Junk block
;+
;.hl2 GCJNK
;This routine will process a junk block if the previous block was not a
;junk block.
;-
GCJNK: MOVE P1,P3 ; Point to the junk block
LOAD. P2,BLKSIZ,(P1) ; Get the size of it
POPJ P, ; Return so that we can advance to the
; next block
SUBTTL M$GC -- Previous not junk -- GCMOV - General movable block
SUBTTL M$GC -- Previous not junk -- GCCTB - Command table
SUBTTL M$GC -- Previous not junk -- GCCND - Command node
SUBTTL M$GC -- Previous not junk -- GCSYM - Symbol table entry
;+
;.HL1 GCMOV, GCCTB, GCCND, GCSYM
;This routines are all the same. They will create a junk block after the
;current block if possible.
;-
GCMOV:
GCCTB:
GCCND:
GCSYM: LOAD. T2,BLKFRW,(P3) ; Get the number of words free
CAXL T2,D.MXFW ; Too many free?
JRST GCSPLT ; Yes, split the block
TXNE F,F.ECMD ; EC command ?
SKIPG T2 ; And at least one word?
POPJ P, ; No, Just return
JRST GCSPLT ; Split the block
SUBTTL M$GC -- Previous not junk -- GCTXT - Text block
;+
;.hl2 GCTXT
;This routine will process a text block if the previous block was not a
;junk block. This routine will determine if we should split the block
;into two different blocks because of a large number of characters free.
;-
GCTXT: LOAD. T2,BLKFRE,(P3) ; Get the number of characters free
LOAD. T3,BLKFRW,(P3) ; Get the number of free words
IMULX T3,5 ; Compute the numbe of characters
ADD T2,T3 ; . . .
CAXL T2,D.MXFR ; Too many?
JRST GCTX.0 ; Yes, split the block
TXNE F,F.ECMD ; Process an EC command?
CAIGE T2,5 ; More than one word free?
POPJ P, ; Don't split this block
; Here if we are going to split this block.
GCTX.0: IDIVI T2,5 ; Yes, T3 has number chars free
STOR. T3,BLKFRE,(P3) ; Store the new free count
; Here to split the blocks
GCSPLT: ZERO. ,BLKFRW,(P3) ; Clear this
LOAD. T1,BLKSIZ,(P3) ; Get the oodl size
SUB T1,T2 ; Make the new size
STOR. T1,BLKSIZ,(P3) ; . . .
ADD T1,P3 ; Make the pointer to the new block
STORI. .BTJNK,T3,BLKTYP,(T1) ; Store the type
STOR. T2,BLKSIZ,(T1) ; Store the size
LOAD. T2,BLKNXT,(P3) ; Get the old next pointer
STOR. T2,BLKNXT,(T1) ; And save it
ZERO. T2,BLKFLG,(T1) ; Clear the flags
MOVX T2,BF.LST ; Get the flag to check
TDNE T2,.BKFLG(P3) ; Was this the last block on the page?
IORM T2,.BKFLG(T1) ; Yes, flag it
ANDCAM T2,.BKFLG(P3) ; And clear the old flag
ZERO. T3,BLKNXT,(T1) ; Clear the old next pointer
POPJ P, ; Return
SUBTTL M$GC -- Previous junk -- Junk block
;+
;.hl2 GCJJNK
;This routine will combine two junk blocks into one. We have found two
;junk blocks back to back.
;-
GCJJNK: LOAD. T1,BLKFLG,(P3) ; Get the flags
STOR. T1,BLKFLG,(P1) ; Store the flags
LOAD. T1,BLKSIZ,(P3) ; Get the size
ADD P2,T1 ; Compute the new size
STOR. P2,BLKSIZ,(P1) ; Store it back
LOAD. T1,BLKNXT,(P3) ; Get the pointer to the next
STOR. T1,BLKNXT,(P1) ; Store it
MOVE P3,P1 ; Start at this junk block to advance
POPJ P, ; Return to the caller
SUBTTL M$GC -- Previous junk -- Text block
;+
;.hl2 GCJTXT
;This routine will handle the case of a junk block before a text block. The
;text block will be moved over top of the junk block and the junk block
;recreated behind the junk block.
;-
GCJTXT: MOVN T1,P2 ; Get the size
ADDM T1,.BKPTR(P3) ; Update the byte pointer
PUSHJ P,MOVBLK ; Move the blocks
JRST GCTXT ; Determine if we should split it
SUBTTL M$GC -- Previous block junk -- Command table
;+
;.hl2 GCJCTB
;This routine will process the finding of a command table after a junk
;block.
;-
GCJCTB: MOVE T1,P1 ; Get the new address
MOVE T2,P3 ; Get the link address
MOVX T3,$CTCTB ; Get the offset to the pointers
PUSHJ P,FIXLNK ; Fix up the linked list
MOVE T2,P3 ; Get the next linked list
MOVX T3,$CTSTK ; Get the offset
PUSHJ P,FIXLNK ; FIx it up too
ADDX T1,$CTCND-$CNCND ; Point to the right place
XMOVEI T2,$CTCND-$CNCND(P3) ; And the command node list
MOVX T3,$CNCND ; Get the offset to the pointer
PUSHJ P,FIXLNK ; . . .
XMOVEI T1,$CTCMD(P1) ; Get the new address for the TPT
XMOVEI T2,$CTCMD(P3) ; Get the TPT pointer
PUSHJ P,FIXTPT ; Fix up that address
XMOVEI T1,$CTTPT(P1) ; Get the new address
XMOVEI T2,$CTTPT(P3) ; Get the always pointer
PUSHJ P,FIXTPT ; Yes, fix it up
PUSHJ P,MOVBLK ; Move the block up
POPJ P, ; Return to the caller
SUBTTL M$GC -- Previous block junk -- Command node
;+
;.hl2 GCJCND
;This routine will handle the case of finding a command node block before
;a junk block. This routine will move the command node block down over
;the junk block and recreate the junk block after the command node block.
;This routine will adjust the pointers in the command node block.
;-
GCJCND: $SAVE <P4> ; Save a register
MOVE T1,P1 ; Get the new address
MOVE T2,P3 ; Point to the linked list word
MOVX T3,$CNCND ; Get the offset
PUSHJ P,FIXLNK ; Fix the linked list pointer
MOVSI P4,-^D128 ; Get the AOBJN pointer
XMOVEI T4,$CNBYT(P3) ; Get the address of the information
TXO T4,<POINT 9,> ; Build the byte pointer
PUSH P,T4 ; Save it on the stack
MOVE T2,P3 ; Get the old address
GCJC.1: ILDB T4,(P) ; Get the information type
TXNN T4,CB$TRN ; Is this a transition?
JRST GCJC.0 ; No, skip this
PUSHJ P,GCJC.C ; Check for previous pointers
JRST GCJC.0 ; There was one, skip this
XMOVEI T1,$CNINF(P1) ; Get the new address
XMOVEI T2,$CNINF(P3) ; Get the address of the info
ANDX T4,CB$IDX ; Keep only the index
IMULX T4,$CILEN ; Mult by the length of each item
ADD T1,T4 ; Make the actual new address
ADD T2,T4 ; Plus the offset
LOAD. T3,TPTADR,(T2) ; Get where this points
PUSHJ P,FIXTPT ; Defined and a transition
GCJC.0: AOBJN P4,GCJC.1 ; Loop for all the items
POP P,(P) ; Remove the byte pointer
PUSHJ P,MOVBLK ; Move this memory block
POPJ P, ; Return to the caller
; Here to check for previous items with the same info
GCJC.C: XMOVEI T1,$CNBYT(P3) ; Set up a pointer
TXO T1,<POINT 9,> ; Make the pointer
GCJC.2: ILDB T2,T1 ; Get the byte
CAMN T1,-1(P) ; Hit the last byte we want to see yet?
PJRST .POPJ1 ; Yes, give no match return
CAME T2,T4 ; Same index?
JRST GCJC.2 ; No, try again
POPJ P, ; Yes, return
SUBTTL M$GC -- Previous junk -- Symbol table entry
;+
;.hl2 GCJSYM
;This routine will handle moving a symbol table entry.
;-
GCJSYM: MOVE T1,P1 ; Get the new address
MOVE T2,P3 ; Get the LNK field
MOVX T3,$SYLNK ; Get the offset to the pointer
PUSHJ P,FIXLNK ; Fix up the pointers
MOVE T2,P3 ; Get the LNK field
MOVX T3,$SYNXT ; Get the offset to the link pointers
PUSHJ P,FIXLNK ; Fix up the pointers here too
XMOVEI T1,$SYTPT(P1) ; Get the new TPT address
XMOVEI T2,$SYTPT(P3) ; Get the TPT address
PUSHJ P,FIXTPT ; No, fix up the TPT pointers also
PUSHJ P,MOVBLK ; Move the symbol table entry
POPJ P, ; Return to the caller
SUBTTL M$GC -- Previous junk -- General movable block
;+
;.hl2 GCJMOV
; This routine will handle a general movable block after a junk block. It will
;move the block over the junk block.
;-
GCJMOV: PUSHJ P,MOVBLK ; Move the block
POPJ P, ; And return
SUBTTL M$GC -- Previous junk -- All others
;+
;.hl2 GCJOTH
;This routine will handle the other process for having a junk block
;before a non-movable block.
;-
GCJOTH: SETZB P1,P2 ; Clear the pointers
POPJ P, ; And forget about moving this
SUBTTL M$GC -- MOVBLK - Move a block up
;+
;.hl2 MOVBLK
;This routine will move a block of memory up. It will then create a junk
;block after the block that was moved up.
;.lit
;
; Usage:
; MOVE P1,New.address
; MOVE P2,Distance being moved
; MOVE P3,New.address
; PUSHJ P,MOVBLK
; (return here always)
;
;.end lit
;-
MOVBLK:
IFN FTXADR,<
LOAD. T1,BLKSIZ,(P3) ; Get the size to move
MOVE T2,P1 ; Get the address to move to
MOVE T3,P3 ; Get the from address
EXTEND T1,[XBLT] ; Move the memory
>; End of IFN FTXADR
IFE FTXADR,<
HRR T1,P1 ; Build the BLT pointer
HRL T1,P3 ; Build From,,To addresses
LOAD. T2,BLKSIZ,(P3) ; Get the number of words to move
ADDI T2,-1(P1) ; Compute the final address
BLT T1,(T2) ; Move the block
>; End of IFE FTXADR
MOVE T1,P1 ; Get the new address
LOAD. T2,BLKADR,(T1) ; Get the address of the list
PUSHJ P,FIXPTR ; Fix all the TPT pointers
LOAD. T2,BLKSIZ,(P1) ; Determine the address of the new junk
ADD T2,P1 ; block
STORI. .BTJNK,T1,BLKTYP,(T2) ; Note that it is a junk block
STOR. P2,BLKSIZ,(T2) ; Store the size of the block
SETZ T1, ; Clear this so we can move fields
LOAD. T3,BLKNXT,(P1) ; Get the next pointer
STOR. T1,BLKNXT,(P1) ; Zero old field
STOR. T3,BLKNXT,(T2) ; Update new block
STOR. T1,BLKFLG,(T2) ; Clear out the flags in the junk block
MOVX T3,BF.LST ; Get the last on page flag
TDNE T3,.BKFLG(P1) ; Is it on?
IORM T3,.BKFLG(T2) ; Yes, flag in new junk block
ANDCAM T3,.BKFLG(P1) ; And turn off the flag
MOVE P3,P1 ; Point to this as the current block
SETZB P1,P2 ; Clear the 'junk' block address and size
POPJ P, ; Return to the caller
SUBTTL M$GC -- Subroutines -- FIXTPT - Fix up TPTNXT pointer
;+
;.hl2 FIXTPT
;This routine will fixup a TPT next pointer. It will loop through the list
;of TPTs until it finds the block that points at the block we just moved.
;It will then update the pointer to the new address of the block.
;.literal
;
; Usage:
; T1/ Address of new TPT
; T2/ Address of the old TPT
; PUSHJ P,FIXTPT
; (return)
;
; On return:
; - TPTNXT pointer to this block updated.
;-
FIXTPT: LOAD. T4,TPTADR,(T2) ; Get the address of the start
JUMPE T4,.POPJ ; Nothing to fix if no pointer
LOAD. T4,BLKADR,(T4) ; Get the address of the first TPT
SETZ T3, ; Set up the previous address
FIXT.0: CAMN T4,T2 ; Is this the block?
JRST FIXT.1 ; Yes, update the pointer
MOVE T3,T4 ; Update the old pointer
LOAD. T4,TPTNXT,(T3) ; Get the address of the next block
JUMPN T4,FIXT.0 ; Loop until we find it
STOPCD MTN,<Missing TPT next pointer>
FIXT.1: JUMPE T3,FIXT.2 ; Are we pointed at by the BLK?
STOR. T1,TPTNXT,(T3) ; Update the pointer to the new address
POPJ P, ; Return to the caller
FIXT.2: LOAD. T3,TPTADR,(T2) ; Get the address of the data
STOR. T1,BLKADR,(T3) ; And store the new address
POPJ P, ; And return
SUBTTL M$GC -- Subroutines -- FIXLNK - Fix up linked list pointers
;+
;.hl2 FIXLNK
;This routine will fix up the linked list pointers for a block.
;.literal
;
; Usage:
; T1/ New block address
; T2/ Address of the LNK block in the block
; T3/ Offset to link pointers within block
; PUSHJ P,FIXLNK
; (return)
;
; On return:
; - Linked list pointers point to the new block
;
;.end literal
;-
FIXLNK: PUSH P,T3 ; Save the offset
MOVE T4,T2 ; Get the old address
ADD T4,T3 ; And point to the old block
LOAD. T3,LNKPRV,(T4) ; Get the previous block address
JUMPE T3,FLNK.1 ; If nothing to fix, skip it
ADD T3,(P) ; Point to the link block
STOR. T1,LNKNXT,(T3) ; Point to the new block
FLNK.1: LOAD. T3,LNKNXT,(T4) ; Get the next pointer
JUMPE T3,FLNK.2 ; Is there one?
ADD T3,(P) ; Point to the link block
STOR. T1,LNKPRV,(T3) ; Make sure it points to the previous
FLNK.2: POP P,T3 ; Remove the offset
POPJ P, ; Give a good return
SUBTTL M$MSTR - Routine to move a string
;+
;.Hl1 M$MSTR
; This routine will move a string. It will move the string as fast as
;possible, by doing some special checks.
;.b
;.literal
; Usage:
; MOVE T1,Source.byte.pointer
; MOVE T2,Destination.byte.pointer
; MOVE T3,Byte.count
; PUSHJ P,M$MSTR
; (Return)
;.end literal
;-
M$MSTR:
JUMPE T3,.POPJ ; Return if there is nothing to move
$SAVE <P1,P2,P3,P4,CH> ; Save the Px ac's
LOAD T4,T2,BP.PFL ; Get the position of the destination
CAXN T4,^D36 ; Word aligned?
CAXGE T3,4*5 ; Enough to make it worth it??
JRST .+2 ; No, move by LDB/DPB
JRST MVST.1 ; Yes, go check for BLT
MVST.2: ILDB CH,T1 ; Get a char
IDPB CH,T2 ; Store it
SOJLE T3,.popj ; Return if done
TXNE T2,<INSVL.(74,BP.PFL)> ; Word aligned yet?
JRST MVST.2 ; No, loop
CAXGE T3,4*5 ; Have at least 4 words to do?
JRST MVST.2 ; No, not worth the set up time
JRST MVST.3 ; Go move the text
; Here for special case of destination being on a word boundary
MVST.1: HRLI T2,(POINT 7,,34) ; . . .
SOJ T2, ; . . .
LOAD T4,T1,BP.PFL ; Get the other position
CAXE T4,^D36 ; Special position?
JRST MVST.3 ; No
HRLI T1,(POINT 7,,34) ; Yes, fix it as well
SOJ T1, ; . . .
; Here when destination byte pointer has been word aligned
MVST.3: DMOVE P1,T1 ; Get the byte pointers in a safer place
MOVE T1,T3 ; Set up for full word move
IDIVI T1,5 ; Compute the number of full words to moe
MOVE T3,T2 ; Store the remainder of characters
LOAD P3,P1,BP.PFL ; Get the position field now
CAXN P3,1 ; Source also on word boundary ?
JRST MVST.4 ; Yes - Go do BLT
; Here if we must do the move/rotate/movem loop
MOVN P4,P3 ; Get the negative
SUBI P3,1 ; P3 = P-1
ADDI P4,^D36 ; P4 = 36-P
ADDM T1,P2 ; Update the pointers
ADDM T1,P1 ; . . .
MOVN T4,T1 ; Set up negative count for loop
MOVEI T2,1(P) ; Get the address of the next free stack word
IFN FTKL,ADJSP P,NMVLP ; Allocate stack space for the loop
IFN FTKI,ADD P,[XWD NMVLP,NMVLP] ; Move the stack down
MOVSI T1,MVLP ; Copy move loop onto the stack
HRR T1,T2 ; . . .
BLT T1,(P) ; Move it
HRRM P1,MVLP0(T2) ; Store the source address
HRRM P2,MVLPA(T2) ; Store the destination address
HRRM T2,MVLPC(T2) ; Fill in loop address to AOJL
MOVE T1,@MVLP0(T2) ; Get first partial source word
LSH T1,-1 ; Right justify it
JRST MVLPC(T2) ; Jump into the loop
; Full word character move loop. This is moved onto the stack and addresses
; are then filled in
MVLP: PHASE 0 ; Phased code
MVLP0:! MOVE T2,.-.(T4) ; Get the first part of the source word
ROTC T1,(P4) ; Shift left to complete destination word
LSH T1,1 ; Left justify destination characters
MVLPA:! MOVEM T1,.-.(T4) ; Store te destination word
ROTC T1,(P3) ; Shift the remainder of the source word
MVLPC:! AOJLE T4,.-. ; Count words and loop
JRST MVST2 ; Loop done, jump off stack
DEPHASE ; End of the phased code
NMVLP==.-MVLP ; Number of words in loop
; The loop returns here from stack when done
MVST2: PORTAL .+1 ; EXO entry back from stack
ADJSP P,-NMVLP ; Remove the stack space
JUMPLE T3,.POPJ ; Continue processing if any characters left
DMOVE T1,P1 ; Reset the byte pointers
JRST MVST.2 ; And move the rest of the characters
; Here to do the special case of moving aligned source and destination
MVST.4: HRLZ T2,P1 ; Get the source address
HRR T2,P2 ; And the destination
ADDX T2,<XWD 1,1> ; Make both to point first word
ADDM T1,P1 ; Update the sorce pointer
ADDM T1,P2 ; And the destination pointer
BLT T2,(P2) ; Move the words until last word of destination
DMOVE T1,P1 ; Reset into T1/T2
JUMPG T3,MVST.2 ; If any character remaining, go do them
POPJ P, ; Else return
SUBTTL TXT routines -- DELTXT - Delete a text block
;+
;.HL2 DELTXT
; This routine will delete a text block. It will close all files assocaiated
;with it and return all memory associated with the block.
;.lit
;
; Usage:
; T1/ Address of block
; PUSHJ P,DELTXT
; (return)
;
;.end lit
;-
DELTXT: $SAVE <P1> ; Save P1
DTXT.0: MOVE P1,T1 ; Get a copy of the block address
DTXT.1: MOVE T1,P1 ; Get the address back
SETZ T2, ; Do an EX type close
SETO T3, ; No reenter's allowed.
PUSHJ P,CLSFIL ; Close any files from it
JRST DTXT.1 ; No reenter's, try again
MOVE T1,P1 ; get the address again
PUSHJ P,S$TAGC ; And clean up the tags for this buffer
MOVE T1,P1 ; Get the address back
ADDX T1,.BKLEN ; Make it the data word address
PJRST M$RBLK ; And return the block
SUBTTL Delete block routines -- DELSYM - Delete a symbol table entry
;+
;.hl2 DELSYM
;This routine will check to see if a symbol table entry can be deleted.
;-
DELSYM: $SAVE <P1,P2,P3> ; Save a few registers
DSYM.0: MOVE P1,T1 ; Copy the block address
CFXE. T1,BLKADR,(P1),0 ; Anyone point at this at all?
POPJ P, ; Yes, Can't return it
CFXE. ,LNKPRV,+$SYNXT(P1),0 ; Still in a linked list?
POPJ P, ; Yes, Can't return it
CFXE. ,LNKNXT,+$SYNXT(P1),0 ; . . .
POPJ P, ; . . .
CFXE. ,LNKPRV,+$SYLNK(P1),0 ; . . .
POPJ P, ; Return
CFXE. ,LNKNXT,+$SYLNK(P1),0 ; . . .
POPJ P, ; Return
CFXE. T1,TPTADR,+$SYTPT(P1),0 ; Still point at something?
POPJ P, ; Yes, Can't return this yet
MOVE T1,P1 ; Get the address back
PJRST DBLK.0 ; Return the block
SUBTTL CND/CTB routines -- M$DCTB - Delete a command table
;+
;.hl2 M$DCTB
;This routine will delete the current command table. All memory blocks
;associated with the current command table will be returned to memory
;management.
;.literal
;
; Usage:
; T1/ Address of a command table
; PUSHJ P,M$DCTB
; (Return)
;
; On return:
; - Command table returned
;
;.end literal
;-
M$DCTB: $SAVE <P1> ; Save a register
DCTB.0: MOVE P1,T1 ; Copy for the moment
CFXE. T1,BLKADR,(P1),0 ; Anyone point at this at all?
POPJ P, ; Yes, can't return it
CFXE. ,LNKPRV,+$CTSTK(P1),0 ; This zero?
POPJ P, ; No, Just return someone else points to it
CFXE. ,LNKNXT,+$CTSTK(P1),0 ; This zero?
POPJ P, ; No, We are pointing to someone else
CFXE. ,LNKPRV,+$CTCTB(P1),0 ; This zero too?
POPJ P, ; No, still in a command table
CFXE. ,LNKNXT,+$CTCTB(P1),0 ; Really returnable?
POPJ P, ; No, Just return
FRAME. <<DELTPT,$TPLEN>> ; Allocate a temp TPT
MOVE T1,P1 ; Get the address of the CTB back
XMOVEI T2,DELTPT ; Point to it
IFN FTDEBUG,SETZM DELTPT ; Clear the pointer out
PUSHJ P,M$USEB ; Make sure it doesn't go away
XMOVEI T1,$CTTPT(P1) ; Point to the TPT for the text buffer
PUSHJ P,M$RELB ; Release the block
LOAD. P1,TPTADR,+DELTPT ; Get the CTB address again
XMOVEI T1,$CTCMD(P1) ; Point to the first command CND
PUSHJ P,M$RELB ; Release it
; Here to delete the CNDs
DCTB.3: LOAD. P1,TPTADR,+DELTPT ; Get the CTB address again
LOAD. T1,LNKNXT,+$CTCND(P1) ; Get the address of the first CND
JUMPE T1,DCTB.1 ; Finished if nothing else
MOVX T2,$CNCND ; Get the offset
PUSHJ P,M$ULNK ; Unlink this item
JRST DCTB.3 ; Loop for all of the CNDs
DCTB.1: LOAD. T1,TPTADR,+DELTPT ; Get the address of the block
ADDX T1,.BKLEN ; Advance the pointer to something RBLK likes
PJRST M$RBLK ; Return the block
SUBTTL CND/CTB routines -- DELCND - Delete a CND block
;+
;.HL2 DELCND
;Delete a command node block. This routine will loop through all of the
;pointers and call M$RELB for all the text pointers.
;.literal
;
; Usage:
; T1/ Address of the CND block
; PUSHJ P,DELCND
; (Return)
;
;.end literal
;-
DELCND: $SAVE <P1,P2,P3> ; Save P1 to P3
DCND.0: MOVE P1,T1 ; Copy the address
CFXE. T1,BLKADR,(P1),0 ; Anyone still pointing at this?
POPJ P, ; Return
CFXE. ,LNKNXT,+$CNCND(P1),0 ; Is this block still linked?
POPJ P, ; Yes, Can't return it yet
CFXE. ,LNKPRV,+$CNCND(P1),0 ; . ..
POPJ P, ; Something points to this, return
XMOVEI P2,$CNBYT(P1) ; Get the address of the start of the
; bytes of information
TXO P2,<$POINT (9)> ; Build the byte pointer
MOVX P3,^D128 ; Max number of bytes
DCND.2: ILDB T1,P2 ; Get a byte from the table
TXNN T1,CB$TRN ; Is this a transition?
JRST DCND.1 ; No, try the next
ANDX T1,CB$IDX ; Yes, keep the index
IMULX T1,$CILEN ; Make this the info index
ADD T1,P1 ; Point to the address
ADDX T1,$CNINF+$CITRN ; . . .
SKIPE (T1) ; If already remove, forget it
PUSHJ P,M$RELB ; Release the pointer
DCND.1: SOJG P3,DCND.2 ; Loop for all bytes
MOVE T1,P1 ; Get the address again
ADDX T1,.BKLEN ; Advance to normal position
PUSHJ P,M$RBLK ; Return the block
POPJ P, ; Return to the caller
SUBTTL CND/CTB routines -- CPYCTB - Copy the command table
;+
;.hl2 CPYCTB
;This routine will copy the current command table. It will return the address
;to the start of the command table. The command table that is copied will
;be given on the call to the routine.
;.literal
;
; Usage:
; T1/ Address of the command table to copy
; PUSHJ P,CPYCTB
; (Return)
;
; On return:
; T1/ Address of the new command table.
;
;.end literal
;.hl1 M$CPCN
; This routine will copy only the marked set of CND's in a CND list.
;This routine has much code in common with CPYCTB.
;.lit
;
; Usage:
; T1/ Address of a CND in the list
; PUSHJ P,M$CPCN
; (return)
;
; On return:
; T1/ Address of new CND corresponding to CND routine was called with
;.end lit
;-
DEFINE PSHTPT(ADDRESS)<
IFIDN <ADDRESS><T1><PUSH P,T1> ;; Save T1
ALCXSB (MEM,CLN) ;; Allocate the space
IFN FTDEBUG,<
SETZM $XSBUF+$TPADR(XS) ;; Clear the address
>;; End of IFN FTDEBUG
IFIDN <ADDRESS><T1><POP P,T1> ;; Restore it
IFDIF <ADDRESS><T1><LOAD T1,ADDRESS> ;; Get the item
XMOVEI T2,$XSBUF(XS) ;; Get the address
PUSHJ P,M$USEB ;; Link this in
>; End of PSHTPT macro definition
DEFINE POPTPT(REG)<
IFNB <REG><
LOAD. REG,TPTADR,+$XSBUF(XS) ;; Get the address into the register
IFIDN <T1><REG><PUSH P,T1> ;; Save the register if needed
>;; End of IFNB <REG>
XMOVEI T1,$XSBUF(XS) ;; Point to the pointer
PUSHJ P,M$RTPT ;; Release the pointer
IFNB <REG><
IFIDN <T1><REG><POP P,T1> ;; Restore the register
>;; End of IFNB <REG>
$ADJSP XS,-$XSCLN ;; Unwind the stack
>; End of POPTPT
CPYCTB: TDZA T2,T2 ; Flag to do all CND's
M$CPCN: MOVX T2,CN$MRK ; Flag to do only marked CND's
$SAVE <P1,P2,P3,P4,A1> ; Save a few registers
MOVE A1,T2 ; Copy the flag
STKTPS (<<T1,SAVCTB>,<,SAVCT1>>) ; Save the CTB
XMOVEI P4,SAVCTB ; Get the address to it
LOAD. P1,TPTADR,+SAVCTB ; Get the address of the CTB (or CND)
JUMPE A1,CPYC.C ; If we already have the CTB, go start
XMOVEI P4,SAVCT1 ; Get the address of the address of the CTB
CPYC.D: LOAD. T1,LNKPRV,+$CNCND(P1) ; Otherwise, back up to the previous
JUMPE T1,[ADDX P1,$CNCND-$CTCND ; Fix the offset to point at the CTB
MOVE T1,P1 ; Get a copy
XMOVEI T2,SAVCT1 ; And get a copy of the pointer
PUSHJ P,M$USEB ; Set it up
JRST CPYC.C] ; And go join common code
MOVE P1,T1 ; Otherwise copy the address
JRST CPYC.D ; And try again
CPYC.C: PSHTPT (<$LKNXT+$CTCND(P1),LK$NXT>) ; Save the address of the first CND
SETZM NUMCND ; Clear the CND count
; Make a copy of all the CNDs.
CPYC.0: LOAD. T1,TPTADR,+$XSBUF(XS) ; Get the address of the saved CND
TDNN A1,$CNFLG(T1) ; Want this block?
JUMPN A1,CPYC.7 ; Maybe not, unless all wanted
AOS NUMCND ; Count the CND
LOAD. T1,CNDEND,(T1) ; Get the size of the block
SUBX T1,.BKLEN ; Remove the header from the length
MOVX T2,.BTCND ; Allocate a CND
PUSHJ P,M$ZBLK ; Allocate a zero block
SUBX T1,.BKLEN ; Point to the header
MOVE P1,T1 ; Copy the address
LOAD. P2,TPTADR,+$XSBUF(XS) ; Get the old address again
XMOVEI T1,$XSBUF(XS) ; Point to the TPT
PUSHJ P,M$RELB ; Release the block
MOVE T1,P1 ; Get the address
XMOVEI T2,$XSBUF(XS) ; Point to the area again
PUSHJ P,M$USEB ; Make a TPT to this block
LOAD. T1,LNKNXT,+$CNCND(P2) ; Get the addrss of the next item
JUMPE T1,CPYC.1 ; Jump if this is zero
PSHTPT (<T1>) ; Save the TPT address on the stack
JRST CPYC.0 ; Loop back
; Here to skip this CND and go on to the next
CPYC.7: MOVE P2,T1 ; Get the address of the CND
XMOVEI T1,$XSBUF(XS) ; And the address of the pointer
PUSHJ P,M$RELB ; Release the pointer
LOAD. T1,LNKNXT,+$CNCND(P2) ; Advance to the next CND
JUMPE T1,CPYC.8 ; If none left, remove last XS item
XMOVEI T2,$XSBUF(XS) ; Otherwise set up XS again
PUSHJ P,M$USEB ; To point at this CND
JRST CPYC.0 ; And try again
CPYC.8: $ADJSP XS,-$XSCLN ; Remove the pointer
; Here when all the CNDs have a new copy on the XS stack.
CPYC.1: JUMPN A1,CPYC.9 ; Skip the text and CTB if only some CND's
LOAD. T1,TPTADR,(P4) ; Get the address of the block
LOAD. T1,TPTADR,+$CTTPT(T1) ; Get the address of the text block
LOAD. T1,BLKEND,(T1) ; Get the number of characters inuse
PUSHJ P,M$GTXT ; Get me a virgin text buffer
PSHTPT (T1) ; Save the TPT
MOVE T3,T1 ; Copy the address
LOAD. T1,TPTADR,(P4) ; Get the address of the block
XMOVEI T4,$CTTPT(T1) ; Get the TPT address
LOAD. T1,TPTADR,+$CTTPT(T1) ; Get the text block address
LOAD. T2,BLKEND,(T1) ; Get the number of characters
ADDX T1,.BKTLN ; Point to the start of the text
TXO T1,<$POINT (7,,)> ; Fill in the byte pointer
PUSHJ P,M$INSS ; Move the string over
; Make a copy of the CTB
MOVX T1,$CTLEN ; Get the length of a CTB
MOVX T2,.BTCTB ; Get the block type
PUSHJ P,M$ZBLK ; Allocate a zero block
SUBX T1,.BKLEN ; Point to the block header
MOVE P2,T1 ; Copy this to a safer place
LOAD. P3,TPTADR,(P4) ; Get the old CTB address
POPTPT (T1) ; Restore the TPT from the stack
XMOVEI T2,$CTTPT(P2) ; Point to the place to line it in
PUSHJ P,M$USEB ; Link it in
DEFINE STICK(A)<
LOAD. T1,'A',(P3) ;; Get the old item
STOR. T1,'A',(P2) ;; Store into the new item
>; End of STICK macro definition
STICK CTBFLG ; Copy the flags
STICK CTBATY ; Copy the ALWAYS command type
STICK CTBALN ; Copy the ALWAYS command length
STICK CTBALW ; Copy the ALWAYS character address
STICK CTBOTY ; Copy the OTHER command type
STICK CTBOLN ; Copy the OTHER command length
STICK CTBOTH ; Copy the OTHER character address
; Now make two lists of the CND addresses on the main stack
; unwinding the information that was pushed on the XS stack.
CPYC.9: MOVE T1,NUMCND ; Get the number of CND's
LSH T1,1 ; Multiply by two
XMOVEI T2,1(P) ; Get the start of the address
IFN FTKL,<
ADJSP P,(T1) ; Allocate the space on the stack
>; End of IFN FTKL
IFN FTKI,<
HRL T1,T1 ; Make this length,,length
ADD P,T1 ; Allocate the space
JUMPGE P,[MOVEI T1,. ; Mark the place
JRST TRPPDL] ; Handle the stack trap
HRRZS T1 ; Clear the length half
>; End of IFN FTKI
PUSHJ P,.ZCHNK ; Clear the stack
IFE FTXADR,<
TXO T2,<INSVL.(P1,IW.IDX)> ; Build the index
>; End of IFE FTXADR
IFN FTXADR,<
TXO T2,<INSVL.(P1,GW.IDX)> ; Build the index
>; End of IFN FTXADR
MOVEM T2,OLDCND ; Store the old CND pointer
ADD T2,NUMCND ; Add in the number of CNDs
MOVEM T2,NEWCND ; Store that pointer two
; Now we have the space allocated for the old CND list and the new CND lists.
; The first thing that we must do is to copy the old CNDs into the block.
LOAD. T1,TPTADR,(P4) ; Get the old CND address
LOAD. T1,LNKNXT,+$CTCND(T1) ; Get the address of the first CND
SETZ P1, ; Initialize the index
CPYC.2: TDNN A1,$CNFLG(T1) ; Want this one?
JUMPN A1,CPYC.A ; No, unless doing all of them
MOVEM T1,@OLDCND ; Store the address
AOJ P1, ; Point to the next one
CPYC.A: LOAD. T1,LNKNXT,+$CNCND(T1) ; Get the address of the next
JUMPN T1,CPYC.2 ; Loop for all the items
; How build the new CND lists.
MOVE P1,NUMCND ; Get the number of CNDs
CPYC.3: SOJL P1,CPYC.4 ; Finished?
POPTPT (T4) ; No, Remove a TPT from the stack
MOVEM T4,@NEWCND ; Store the new CND address
JRST CPYC.3 ; Loop for all the CNDs
; Here when the lists of CNDs have been created.
; Now copy from one to another.
CPYC.4: MOVN P1,NUMCND ; Get minus the number of CNDs
MOVSI P1,(P1) ; Make this a local AOBJN pointer
MOVE T1,@OLDCND ; Get the OLD CND address
MOVE T2,@NEWCND ; Get the new CND address
PUSHJ P,CPYCND ; Copy the CNDs
; Here to loop for all of the CNDs
MOVE T2,@NEWCND ; Get the new CND address again
CPYC.5: MOVE P4,T2 ; Copy the CND address
AOBJP P1,CPYC.6 ; Finished?
MOVE T1,@OLDCND ; No, Get the next old CND
MOVE T2,@NEWCND ; And the next new CND
PUSHJ P,CPYCND ; Copy from the old to the new
MOVE T2,@NEWCND ; Get the address again
STOR. T2,LNKNXT,+$CNCND(P4) ; Store the pointer
STOR. P4,LNKPRV,+$CNCND(T2) ; . . .
JRST CPYC.5 ; Loop for all the CNDs
; Here after all the CNDs have been copied. Now find the address of the
; first CND in the old CND list and fix up the item into the new list.
CPYC.6: JUMPN A1,CPYC.B ; If only specific CND's, skip this
LOAD. T1,LNKNXT,+$CTCND(P3) ; Get the address of the first
PUSHJ P,FNDCND ; Find the matching CND
STOR. T1,LNKNXT,+$CTCND(P2) ; Store it
XMOVEI T2,$CTCND-$CNCND(P2) ; Get the address
STOR. T2,LNKPRV,+$CNCND(T1) ; Store the address of the previous
LOAD. T1,TPTADR,+$CTCMD(P3) ; Get the address of the first
PUSHJ P,FNDCND ; Find the new CND address
XMOVEI T2,$CTCMD(P2) ; Place to store this
PUSHJ P,M$USEB ; Make this pointer in use
MOVE T1,NUMCND ; Get the number of CNDs
LSH T1,1 ; Double this, we have twice that many
IFN FTKL,<
MOVNS T1 ; Negate this
ADJSP P,(T1) ; Remove the space on the stack
>; End of IFN FTKL
IFN FTKI,<
HRL T1,T1 ; Make this length,,length
SUB P,T1 ; Remove the space from the stack
>; End of IFN FTKI
MOVE T1,P2 ; Return the CTB address
POPJ P, ; Return to the caller
; Here if we have only copied specific CTB's. We must find out the address
;of the copy of the CND we were given as an argument
CPYC.B: LOAD. T1,TPTADR,+SAVCTB ; Get the address of the CND
PUSHJ P,FNDCND ; And determine the new address
MOVE P1,T1 ; Save it for a moment
XMOVEI T1,SAVCTB ; Release the original CND
PUSHJ P,M$RELB ; . . .
LOAD. P2,LNKPRV,+$CNCND(P1) ; Get the previous CND address
JUMPE P2,CPYC.G ; If none, all is fine
CPYC.F: LOAD. T3,LNKPRV,+$CNCND(P2) ; Get the previous address
JUMPE T3,CPYC.E ; Have one?
MOVE P2,T3 ; Yes, get the address
JRST CPYC.F ; And try again
CPYC.E: MOVX T2,$CNCND ; Otherwise get the offset
MOVE T3,P2 ; Get the address of the block to link in before
MOVX T4,$CNCND ; And get the address
PUSHJ P,M$MLNK ; And move the CND to the start of the list
CPYC.G: MOVE T1,NUMCND ; Get the number of CND's we copied
ASH T1,1 ; Mult by two
IFN FTKL,<
MOVN T1,T1 ; Get the amount to remove
ADJSP P,(T1) ; And do it
> ; End of IFN FTKL
IFN FTKI,<
HRL T1,T1 ; Set up the amount to subtract
SUB P,T1 ; And do it
> ; End of IFN FTKI
MOVE T1,P1 ; Get the address of the new CND
POPJ P, ; And return
SUBTTL CND/CTB routines -- CPYCND - Copy a node block
;+
;.hl2 CPYCND
;This routine will copy a node block. This is a routine that is used in
;the command tables.
;.literal
;
; Usage:
; T1/ Old CND
; T2/ New CND
; PUSHJ P,CPYCND
; (Return)
;
; On return:
; - New CND information filled in from the old CND.
;
;.end literal
;-
CPYCND: $SAVE <P1,P2,P3> ; Save three registers
DMOVE P1,T1 ; Copy the arguments
MOVEI T1,$CNINF-$CNEND ; Number of words to copy
XMOVEI T2,$CNEND(P1) ; Old address
XMOVEI T3,$CNEND(P2) ; New address
PUSHJ P,M$MCOR ; Copy CND blocks
XMOVEI T4,$CNBYT(P1) ; Get address of info
TXO T4,<POINT 9> ; Build a byte pointer
MOVX P3,^D128 ; Get the number of times to loop
CCND.0: ILDB T3,T4 ; Get the info type
TXNN T3,CB$TRN ; Is this a transfer?
JRST CCND.1 ; No, might be an execute
ANDX T3,CB$IDX ; Keep only the index
IMULX T3,$CILEN ; No. of bytes from block
PUSH P,T3 ; Save no. for later
ADD T3,P1 ; Compute old address
LOAD. T1,TPTADR,+$CITRN+$CNINF(T3) ; Get floating pointer
PUSHJ P,FNDCND ; Make new floating pointer
POP P,T3 ; Get no. of bytes
XMOVEI T2,$CNINF+$CITRN(P2) ; Get address
ADD T2,T3 ; Plus no. of bytes offset
SKIPN $TPADR(T2) ; Has this already been done?
PUSHJ P,M$USEB ; Copy info
JRST CCND.2 ; Get more bytes
CCND.1: TXNN T3,CB$XCT ; Execute?
JRST CCND.2 ; No, not defined
ANDX T3,CB$IDX ; Keep only the index
IMULX T3,$CILEN ; No. of bytes from block
MOVE T2,T3 ; Copy it
ADD T3,P1 ; Old address
ADD T2,P2 ; New address
LOAD. T1,CINCAD,+$CNINF(T3) ; Copy from oLOADd
STOR. T1,CINCAD,+$CNINF(T2) ; Copy to new
LOAD. T1,CINCTY,+$CNINF(T3) ; Copy from old
STOR. T1,CINCTY,+$CNINF(T2) ; Copy to new
LOAD. T1,CINCLN,+$CNINF(T3) ; Copy from old
STOR. T1,CINCLN,+$CNINF(T2) ; Copy to new
CCND.2: SOJG P3,CCND.0 ; Loop for all items in $CNBYT
POPJ P, ; Return to caller
SUBTTL CND/CTB routines -- FNDCND - Find a CND
;+
;.hl2 FNDCND
;This routine will find an old CND in the lists and return the address
;of the new CND.
;.literal
;
; Usage:
; T1/ Address of the OLD CND
; PUSHJ P,FNDCND
; (Return)
;
; On return:
; T1/ Address of the new CND
;
;.end literal
;-
FNDCND: $SAVE <P1> ; Save a register
MOVN P1,NUMCND ; Get the number of CNDs
MOVSI P1,(P1) ; Make this an AOBJx pointer
CAME T1,@OLDCND ; Is this the old CND?
AOBJN P1,.-1 ; No, Loop until found
JUMPGE P1,[STOPCD LCN,<Lost a CND>]
MOVE T1,@NEWCND ; Return the new CND
POPJ P, ; Return to the caller
SUBTTL FIXPTR - Routine to fix up text buffer pointers
;+
;.hl1 FIXPTR
; This routine will change all of the pointers to a text buffer to a new
;value. It is used when a buffer is moved.
;.b
;.literal
; Usage:
; MOVE T1,New.buffer.address
; MOVE T2,Address of pointer list
; PUSHJ P,FIXPTR
; (Return)
;.end literal
;-
FIXPTR: JUMPE T2,.POPJ ; Nothing to fix if no pointer
FIXP.0: STOR. T1,TPTADR,(T2) ; Store the new address
LOAD. T2,TPTNXT,(T2) ; Get the next pointer
JUMPN T2,FIXP.0 ; And loop until end of list
POPJ P, ; And return
SUBTTL Page processing -- Find a free page
;+
;.hl1 M$FFPG
;This routine will find a free page in the working set that has the
;attributes that are in register T1.
;.literal
;
; Usage:
; T1/ Attributes
; PUSHJ P,M$FFPG
; (Return)
;
; On return:
; T1/ Page number of the page that matches
;
;.end literal
;-
M$FFPG:
SUBTTL Page processing -- Find n free pages
;+
;.hl1 M$FNFP
;This routine will find n free pages. It will determine the type of pages
;to find by the attributes that are specified in register T1.
;.literal
;
; Usage:
; T1/ Attributes
; T2/ Number of pages
; PUSHJ P,M$FNFP
; (Return)
;
; On return:
; T1/ Page number of the first page that matches
;
;.end literal
;-
M$FNFP:
SUBTTL Page processing -- Release one page
;+
;.HL1 M$RELP
;This routine will release one page of memory. It will destroy the page
;so that it doesn't exist.
;.literal
;
; Usage:
; T1/ Page number
; PUSHJ P,M$RELB
; (Return)
;
; On return:
; - Page released
;
;.end literal
;-
M$RELP:
IFN FTDEBUG,<
PUSHJ P,CHKPAG ; Check for valid page number
>; End of IFN FTDEBUG
MOVEI T2,1 ; Just one page
EXCH T1,T2 ; Move into the right places
FALL M$RLNP ; Fall into the general routine
SUBTTL Page processing -- Release N pages
;+
;.hl1 M$RLNP
;This routine will release N pages. It is called by the upper level
;memory management processing.
;.literal
;
; Usage:
; T1/ Number of pages
; T2/ First page number to releae
; PUSHJ P,M$RLNP
; (Return)
;
; On return:
; - Pages releaed
;
;.end literal
;-
M$RLNP:
IFN FTDEBUG,<
PUSHJ P,CHKPAG ; Range check the page number
PUSH P,T1 ; Save this
ADD T1,T2 ; Add in the total number
SUBI T1,1 ; Back up one
PUSHJ P,CHKPAG ; Validate this page number
POP P,T1 ; Get the page number back
>; End of IFN FTDEBUG
TOPS10,<
MOVN T2,T2 ; Make this minus the number of
; pages to create
MOVE T3,T1 ; Get the page number
TXO T3,PA.GAF ; Make this go away
MOVX T1,<XWD .PAGCD,T2> ; Get the function
RLNP.1: PAGE. T1, ; Create the pages
SKIPA ; Failed, skip this
JRST .POPJ1 ; Give a good return
; Here if the PAGE. UUO has failed. Determine if we should try to create
; the page on disk.
CAXE T1,PAGLE% ; Limit exceeded?
POPJ P, ; No, Bad
TXOE T3,PA.GCD ; Create it on disk then
POPJ P, ; Already tried that.
JRST RLNP.1 ; Try again
>; End of TOPS10 conditional
SUBTTL Page processing -- Create one specific page
;+
;.hl1 M$CPAG
;This routine will acquire 1 page from the operating system. This
;routine is called from the upper level memory management processing.
;.literal
;
; Usage:
; T1/ Page number to create
; PUSHJ P,M$CPAG
; (Failure return)
; (Successful return)
;
; On a failure return:
; T1/ PAGE. error code (TOPS-10 only)
;
; On a good return:
; - page created.
;
;.END LITERAL
;-
M$CPAG: MOVEI T2,1 ; Just create one page
FALL M$CPGS ; Fall into the next routine
SUBTTL Page processing -- Acquire N pages
;+
;.hl1 M$CPGS
;This routine will acquire N pages from the operating system. This
;routine is called from upper level memory management processing and
;from once only processing.
;.literal
;
; Usage:
; T1/ Page number of the first page
; T2/ Number of pages to allocate
; PUSHJ P,M$CPGS
; (Failure return)
; (Success return)
;
; On a failure return:
; T1/ PAGE. error code (TOPS-10 only)
;
; On a good return:
; - page created.
;
;.end literal
; This routine will attempt to create the pages on disk if it is not
;possible to create them in core.
;.end literal
;-
M$CPGS:
IFN FTDEBUG,<
PUSHJ P,CHKPAG ; Range check the page number
PUSH P,T1 ; Save this
ADD T1,T2 ; Add in the total number
SUBI T1,1 ; Back up one
PUSHJ P,CHKPAG ; Validate this page number
POP P,T1 ; Get the page number back
>; End of IFN FTDEBUG
TOPS10<
MOVN T2,T2 ; Make this minus the number of
; pages to create
MOVE T3,T1 ; Get the page number
CPGS.1: MOVX T1,<XWD .PAGCD,T2> ; Get the function
PAGE. T1, ; Create the pages
SKIPA ; Failed, skip this
JRST .POPJ1 ; Give a good return
; Here if the PAGE. UUO has failed. Determine if we should try to create
; the page on disk.
CAXE T1,PAGLE% ; Limit exceeded?
POPJ P, ; No, Bad
TXOE T3,PA.GCD ; Create it on disk then
POPJ P, ; Already tried that.
JRST CPGS.1 ; Try again
>; End of TOPS10 conditional
SUBTTL Page processing -- Check for a valid page number
;+
;.hl1 CHKPAG
;This routine is a debugging routine to validate the page number that is
;in T1. This routine will stopcode if the page number is invalid.
;.literal
;
; Usage:
; T1/ Page number
; PUSHJ P,CHKPAG
; (Return)
;
; On return:
; - Page number if valid
;
;.end literal
;-
IFN FTDEBUG,<
CHKPAG: CAIGE T1,1000 ; Is this valid?
POPJ P, ; Yes, just return
STOPCD IPN,<Invalid page number>
>; End of IFN FTDEBUG
SUBTTL Low segment
$IMPURE ; Data PSECT
LOWVER(MEM,2) ; Define the low segment version
IFN FTDEBUG,< ; Debugging storage
CFRSAC: BLOCK 20 ; AC's from last valid call to M$CFRE
CFRPDL: BLOCK D.PDLL ; PDL from last valid call to M$CFRE
> ; End of IFN FTDEBUG
FSTBLK: BLOCK 1 ; Pointer to first core block
CMDBUF: BLOCK $QRLEN ; Address of core block for command buffer
CPMQRG: BLOCK $QRLEN ; Default prompt
XPNPTR: BLOCK 1 ; Temp pointer for M$XPND
; CPYCTB and CPYCND data areas.
OLDCND: BLOCK 1 ; Indirect pointer to old CNDs
NEWCND: BLOCK 1 ; Indirect pointer to the new CNDs
NUMCND: BLOCK 1 ; Number of CNDs in the lists
SUBTTL End of TECMEM
END ; End of TECMEM