Trailing-Edge
-
PDP-10 Archives
-
BB-D480C-SB_1981
-
formem.mac
There are 11 other files named formem.mac in the archive. Click here to see a list.
SEARCH FORPRM
TV FORMEM MEMORY MANAGEMENT,6(2033)
SUBTTL CHRIS SMITH/CKS
;COPYRIGHT (C) 1981 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
COMMENT \
***** Begin Revision History *****
1100 CKS 5-Jun-79
New for version 6
1160 CKS 9-Oct-80 Q1244
When memory fills up, scrounge pages from STARTP going upward.
1275 DAW 20-Feb-81
Return whole 30-bit address of memory at %GTBLK
1410 JLC 07-Apr-81
Change %MVBLK to return new size in T3.
1464 DAW 12-May-81
Error messages.
1466 CKS 18-May-81
Add TOPS-20 PSI interface
1510 BL 4-Jun-81 Q10-06197
Fix IllMemRef bug due to all pages being initialized as existing.
1523 JLC 04-Jul-81
1022 interface. Rerouted all core expansion and contraction
requests through one routine (EXPADR), called indirectly
through %EXPNT, with the desired expansion value in %DESHG.
Made all references to .JBFF indirect through %JBFPT.
1527 JLC/BL 09-Jul-81
Fixes to BL's code (VMDDT fix), removal of some crocks.
1531 JLC 10-Jul-81
Integrated %GTPGS for below and above page 600. Restricted
page use to below 775.
1542 JLC 17-Jul-81
Fixed %MVBLK for slightly changed calling sequence in FORIO.
1633 JLC 24-Aug-81
Cleaned up some comments that were misleading
1667 JLC 9-Sep-81
One-word patch at GETLP+11 makes lowseg core request work.
1727 JLC 18-Sep-81
Another fix to low-core memory manager. Free-list was one word off.
1740 JLC 23-Sep-81
Yet more fixes to low segment memory manager. Fixed so that
free-list memory is included in larger requests if the
free-list memory is at .JBFF.
1756 JLC 1-Oct-81
Fix ots memory manager. For GTPGS, start at STARTP minus number
of pages desired, and go down. Then at TRYHRD, start at STARTP+1
minus number of pages desired and go up.
1773 DAW 8-Oct-81
Change name of error code "CMU" to "IEM", for "internal error in
memory manager".
2015 DAW 20-Oct-81
AC T1 was being smashed in CREPG (TOPS-10).
2025 JLC 26-Oct-81
Fix LSTRIM for the 1022 folks - we were using a non-transparent
subroutine.
2033 JLC 19-Nov-81
Incorrect calling sequence for %MVBLK.
Don't smash LH(back-link) in %FREBLK, it is useful for debugging.
***** End Revision History *****
\
SUBTTL OTS MEMORY MANAGER
ENTRY ALCOR%,DECOR%,%FUNCT
INTERN %MEMINI
INTERN %GTBLK,%FREBLK,%MVBLK
INTERN %GTPGS,%FREPGS
INTERN %LPAGE,%JBFPT,%DESHG,%EXPNT,%PTAB
EXTERN %POPJ,%POPJ1,%POPJ2,%SAVE1,%SAVE2,%SAVE3,%SAVE4,%SAVE
EXTERN I.XSIR,%LEVTAB,%CHNTAB
EXTERN I.RUNTM,U.ACS
IF10,< EXTERN I.DEV,I.FILE,I.PPN >
EXTERN %ALCHN,%DECHN,%ABORT,%HALT
IFN FTSHR,<EXTERN Z.DATA >
SEGMENT CODE
COMMENT &
FOROTS dynamic memory is allocated in pages starting at STARTP (the highest
usable page), growing downward. Memory for overlays is allocated at .JBREL,
growing upward. If the two segments meet, the user is out of memory.
The memory from STARTP up to page TOPP will be used when the rest of memory is
full. This memory is also used by SORT, RMS, and DDT, and conflicts can occur.
The conflicts are preferable to the alternative, giving up and exiting.
Memory is strung together in blocks, chained in a doubly linked list. Both
allocated and free blocks are on the list. All blocks are consecutive, so the
%FREBLK routine can examine the previous and next blocks to see if they should
be coalesced with the block being freed.
Each block is preceded by a two-word header with forward and backward links, a
flag telling whether the block is allocated or free, and the size of the block
if it is free. The list is terminated by a zero word.
To facilitate debugging, the unused left half of the second word of an
allocated block header is set to the return address in the routine that
allocated the block. This helps find routines that fail to free their blocks.
&
;FORMAT OF BLOCK HEADER
HFLNK==0 ;(LH) -1 IF BLOCK ALLOCATED, 0 IF FREE
;(RH) LINK TO FOLLOWING BLOCK
HSIZE==1 ;(LH) SIZE OF BLOCK IF FREE, ELSE
; RETURN ADDRESS IN ALLOCATING ROUTINE
HBLNK==1 ;(RH) LINK TO PRECEDING BLOCK
HLEN==2 ;LENGTH OF BLOCK HEADER
M==10 ;FREE BLOCK WHICH IS WITHIN M WORDS
;OF DESIRED SIZE IS CONSIDERED EXACT FIT
;(MUST BE AT LEAST HLEN)
;THIS IS PART OF THE 1022 INTERFACE
;ALL REFERENCES TO .JBFF ARE INDIRECT REFERENCES THROUGH JBFPNT, WHICH IS
;SET TO .JBFF IN %MEMINI. 1022 WILL, BEHIND OUR BACKS, CHANGE THE CONTENTS
;OF JBFPNT. LSEXP, THE "CORE UUO" SIMULATOR, IS HANDLED IN A SIMILAR
;FASHION.
DEFINE JOBFF <@%JBFPT>
DEFINE LSEXP <@%EXPNT>
;ROUTINE TO GET A BLOCK OF MEMORY
;ARGS: T1 = LENGTH OF BLOCK
;RETURN: T1 = ADDRESS OF BLOCK, CLEARED TO ZERO
%GTBLK: PUSHJ P,GTBLKX ;TRY IT
; ERR (MFU,999,105,?,Memory full,,%ABORT)
$ECALL MFU,%ABORT
MOVE T2,(P) ;GET RETURN ADDRESS OFF STACK
HRLM T2,-1(T1) ;STORE IN BLOCK HEADER FOR DEBUGGING
POPJ P,
GTBLKX: MOVE T4,FREPTR ;POINT TO START OF LIST
SETOM WRAP ;FLAG NO WRAPAROUND YET
GBSRCH: SKIPGE T4,(T4) ;GET LINK TO NEXT BLOCK. IS IT FREE?
JRST GBSRCH ;NO, KEEP LOOKING
JUMPE T4,GBEOL ;ZERO MEANS END OF LIST, GO WRAP AROUND
HRRZ T2,HBLNK(T4) ;GET START ADDRESS OF THE FREE BLOCK
HLRZ T3,HSIZE(T2) ;GET SIZE OF FREE BLOCK
CAIGE T3,(T1) ;IS IT BIG ENOUGH?
JRST GBSRCH ;NO, KEEP LOOKING
GOTBLK: CAIG T3,M(T1) ;IS SIZE CLOSE ENOUGH?
JRST GBFIT ;YES, DON'T SPLIT BLOCK
SUBI T3,HLEN(T1) ;COMPUTE LENGTH OF REMAINING FREE BLOCK
HRLM T3,HSIZE(T2) ;STORE IN HEADER
ADDI T3,HLEN(T2) ;GET START ADDRESS OF ALLOCATED BLOCK
HRROM T4,HFLNK(T3) ;FIX UP POINTERS
HRRZM T2,HBLNK(T3)
HRRZM T3,HFLNK(T2)
HRRM T3,HBLNK(T4)
MOVEM T2,FREPTR ;START NEXT SEARCH AT NEW FREE BLOCK
MOVEI T1,HLEN(T3) ;GET ADDRESS OF NEW ALLOCATED BLOCK
JRST GBZERO ;GO CLEAR NEW BLOCK, RETURN
GBFIT: HRROM T4,HFLNK(T2) ;JUST MARK WHOLE BLOCK ALLOCATED
MOVEM T4,FREPTR ;START NEXT SEARCH AT FOLLOWING BLOCK
MOVEI T1,HLEN(T2) ;POINT TO BLOCK
GBZERO: MOVSI T2,(T1) ;MAKE BLT POINTER TO CLEAR BLOCK
HRRI T2,1(T1)
SETZM (T1) ;CLEAR FIRST WORD
CAILE T4,(T2) ;CHECK FOR 1-WORD BLOCK
BLT T2,-1(T4) ;CLEAR REST OF BLOCK
XMOVEI T1,(T1) ;Section number in left half
JRST %POPJ1 ;SUCCESS RETURN
GBEOL: HRRZ T4,BEGPTR ;RESET FREE POINTER TO START OF LIST
MOVEM T4,FREPTR
AOSG WRAP ;ALREADY LOOKED THROUGH WHOLE LIST?
JRST GBSRCH ;NO, DO SO
STKVAR <SAVET,NP> ;ALLOCATE SPACE ON STACK
MOVEM T1,SAVET ;SAVE T1
MOVEI T1,2*HLEN+777(T1) ;ADD IN 2 HEADERS, ROUND UP TO PAGE BOUND
LSH T1,-9 ;CONVERT TO PAGES
MOVEM T1,NP ;SAVE PAGES TO ALLOCATE
PUSHJ P,%GTPGS ;GET SOME PAGES
JRST [UNSTK ;CAN'T, GIVE ERROR RETURN
POPJ P,]
MOVE T2,NP ;GET LENGTH IN PAGES
LSHC T1,9 ;CONVERT ADDRESS, LENGTH TO WORDS
ADDI T2,(T1) ;GET END+1 ADDRESS OF NEW CORE
HRRZ T3,BEGPTR ;GET POINTER TO START OF OLD CORE
CAIE T2,(T3) ;NEW CORE CONTIGUOUS WITH OLD?
JRST GBHOLE ;NO, GO HANDLE HOLE
MOVEI T4,(T2) ;COPY END ADDRESS OF NEW CORE
SKIPLE HFLNK(T4) ;CONTIGUOUS WITH A FREE BLOCK?
HRRZ T4,HFLNK(T4) ;YES, CONSIDER NEW CORE ENDING AT END OF FREE BLOCK
JRST GBCONT ;CONTINUE BELOW
GBHOLE: MOVEI T4,-HLEN(T2) ;MAKE HOLE LOOK LIKE PERMANENTLY ALLOCATED BLOCK
HRROM T3,HFLNK(T4) ;SET FORWARD LINK OF HOLE
HRRM T4,HBLNK(T3) ;SET BACKWARD LINK
GBCONT: HRROM T1,BEGPTR ;NEW START OF LIST IS START OF NEW CORE
MOVEM T1,FREPTR ;ALSO START NEXT SEARCH THERE
HRRZM T4,HFLNK(T1) ;POINT FREE BLOCK TO ITS SUCCESSOR
HRRZM T1,HBLNK(T4) ;POINT SUCCESSOR BACK TO NEW FREE BLOCK
MOVEI T3,BEGPTR ;POINT FREE BLOCK BACK TO LIST HEAD
HRRZM T3,HBLNK(T1)
MOVEI T3,(T4) ;COMPUTE LENGTH OF FREE BLOCK
SUBI T3,HLEN(T1)
MOVEI T2,(T1) ;PUT POINTER TO FREE BLOCK IN RIGHT AC
MOVE T1,SAVET ;RESTORE T1
UNSTK ;RESTORE P
JRST GOTBLK ;DONE, RETURN TO MAIN CODE
;ROUTINE TO FREE A BLOCK OF MEMORY
;ARGS: T1 = ADDRESS OF BLOCK TO BE FREED (AS RETURNED BY %GTBLK)
%FREBLK:
JUMPE T1,[$SNH] ;BAD CALL IF ARG=0
HRRZ T2,HBLNK-HLEN(T1) ;POINT TO PREDECESSOR BLOCK
HRRZ T3,HFLNK-HLEN(T1) ;POINT TO SUCCESSOR BLOCK
HRRZ T4,HFLNK(T2) ;GET FWD LINK OF PREDECESSOR
CAIE T4,-HLEN(T1) ;DOES IT POINT TO CURRENT BLOCK?
; ERR (IEM,,,?,Core messed up,,%HALT) ;NO, FATAL ERROR
$ECALL IEM,%HALT ;No, fatal error
HRRZ T4,HBLNK(T3) ;GET BACK LINK OF SUCCESSOR
CAIE T4,-HLEN(T1) ;CHECK IT
$ECALL IEM,%HALT ;WRONG, ERROR
SKIPGE HFLNK(T2) ;IF PREDECESSOR IS FREE, POINT TO IT
HRRZ T2,HFLNK(T2) ; ELSE POINT TO BLOCK BEING FREED
SKIPLE HFLNK(T3) ;IF SUCCESSOR IS FREE, POINT TO ITS SUCCESSOR
HRRZ T3,HFLNK(T3)
HRRZM T3,HFLNK(T2) ;FIX POINTERS
HRRM T2,HBLNK(T3) ;(LH = return address of GTBLK caller..)
CAMGE T2,FREPTR ;DOES FREPTR POINT TO INTERIOR OF NEW BLOCK?
CAMG T3,FREPTR
JRST .+2 ;NO, OK
MOVEM T2,FREPTR ;MAKE SURE FREPTR POINTS TO START OF SOME BLOCK
SUBI T3,HLEN(T2) ;COMPUTE LENGTH OF NEW FREE BLOCK
HRLM T3,HSIZE(T2) ;STORE IN BLOCK HEADER
JUMPG T3,%POPJ ;AND RETURN
$ECALL IEM,%HALT ;Unless size was negative or zero
;ROUTINE TO MOVE A CORE BLOCK INTO A BIGGER BLOCK
;ARGS: T1 = OLD ADDRESS
; T2 = OLD LENGTH
; T3 = NEW LENGTH
;RETURN: T1 = NEW ADDRESS
; T2 = END+1 ADDR OF OLD DATA IN NEW BLOCK (I.E. NEW ADDR + OLD LENGTH)
; T3 = NEW LENGTH (FOR CONVENIENCE IN EXPRB)
%MVBLK:
STKVAR <NLEN,OLEN,OADR> ;SPACE FOR NEW LENGTH, OLD LENGTH, ADDRESS
EXCH T1,T3 ;GET NEW LENGTH IN T1, OLD ADDR IN T3
MOVEM T1,NLEN ;SAVE NEW LENGTH FOR LATER
DMOVEM T2,OLEN ;SAVE T2-T3
PUSHJ P,%GTBLK ;GET NEW BLOCK
MOVE T2,OLEN ;GET OLD LENGTH BACK
HRLZ T3,OADR ;GET OLD ADDRESS IN LH
HRRI T3,(T1) ;NEW ADDRESS IN RH
ADDI T2,(T1) ;NEW ADDRESS + OLD LENGTH
BLT T3,-1(T2) ;MOVE OLD DATA TO NEW BLOCK
EXCH T1,OADR ;SAVE NEW ADDRESS, GET OLD ADDRESS
MOVEM T2,OLEN ;SAVE NEW END+1 ADDRESS ON STACK
PUSHJ P,%FREBLK ;FREE OLD BLOCK
POP P,T1 ;GET STUFF TO RETURN OFF STACK
POP P,T2
POP P,T3 ;RETURN NEW LENGTH IN T3
POPJ P, ;DONE
;ROUTINE TO FIND AND ALLOCATE CONSECUTIVE PAGES OF MEMORY
;ARGS: T1 = NUMBER OF PAGES TO GET
;RETURN: T1 = PAGE NUMBER OF FIRST PAGE
;NONSKIP RETURN IF CAN'T, SKIP IF OK
%GTPGS: PUSHJ P,%SAVE3 ;SAVE P ACS
MOVEI P1,STARTP ;START LOOKING AT THE TOP OF FOROTS DATA AREA
SUBI P1,-1(T1) ;MINUS # PAGES DESIRED
MOVEI P2,(T1) ;SET NUMBER OF PAGES TO GET
GETPLP: MOVEI T1,1 ;GET PAGE-ALLOCATED BIT
PUSHJ P,DOPGS ;MOVE BIT THROUGH PAGE BIT MAP
TDNN T1,PTAB(T2) ;SEE IF PAGES ARE ALL NOT ALLOCATED
JRST TRYRET ;ALL FREE, FINE
SOJGE P1,GETPLP ;SOME PAGE ALLOCATED, TRY AGAIN
;HERE WHEN REQUEST CAN'T BE SATISFIED USING PAGES 0 THROUGH STARTP.
;LOOK FROM STARTP+1 TO 777 FOR ENOUGH CONSECUTIVE PAGES.
TRYHRD: MOVEI P1,STARTP+1 ;START AT PAGE 600
SUBI P1,-1(P2) ;TAKE IN # PAGES DESIRED
TRYLP2: MOVEI T1,(P1) ;COPY TEST PAGE BOTTOM
ADDI T1,-1(P2) ;GET TOP PAGE DESIRED
CAILE T1,777 ;AT TOP OF MEMORY?
POPJ P, ;YES, GIVE UP
MOVEI T1,1 ;GET PAGE-ALLOCATED BIT
PUSHJ P,DOPGS ;MOVE BIT THROUGH PAGE BIT MAP
TDNN T1,PTAB(T2) ;SEE IF PAGES ARE ALL NOT ALLOCATED
JRST TRYRET ;ALL FREE, FINE
AOJA P1,TRYLP2 ;SOME PAGE ALLOCATED, TRY AGAIN
TRYRET: PUSHJ P,CREPGX ;CREATE THE PAGES
POPJ P, ;CAN'T, TOO BAD
MOVEI T1,(P1) ;RETURN STARTING PAGE TO CALLER
OR T1,PAGSEC ;In current section
JRST %POPJ1 ;SUCCESS
;ROUTINE TO FREE PAGES
;ARGS: T1 = FIRST PAGE
; T2 = NUMBER OF PAGES
;ON RETURN, PAGES ARE MARKED FREE IN BIT MAP
%FREPGS:
PUSHJ P,%SAVE2 ;SAVE P1-P2
DMOVE P1,T1 ;PUT ARGS IN RIGHT ACS
SUB P1,PAGSEC ;Get relative page # in section
MOVEI T1,1 ;GET PAGE-ALLOCATED BIT
PUSHJ P,DOPGS ;MOVE BIT THROUGH BIT MAP
ANDCAM T1,PTAB(T2) ;MARK PAGE FREE
POPJ P, ;DONE
;ROUTINE TO CREATE PAGES
;ARGS: P1 = FIRST PAGE TO ALLOCATE
; P2 = NUMBER OF PAGES TO ALLOCATE
;ERROR RETURN IF PAGES ARE ALLREADY ALLOCATED
;OR (10 ONLY) IF PAGES CAN'T BE CREATED (CORE LIMIT EXCEEDED OR SOMETHING)
CREPGS: MOVEI T1,1 ;GET PAGE-ALLOCATED BIT
PUSHJ P,DOPGS ;MOVE THROUGH BIT MAP
TDNN T1,PTAB(T2) ;ARE PAGES ALREADY ALLOCATED?
JRST CREPGX ;ALL FREE, FINE
POPJ P, ;SOME PAGE ALLOCATED, ERROR
CREPGX: ;ENTRY POINT FOR PAGES ALREADY CHECKED
IF20,<
DMOVE T1,P1 ;TOUCH THE PAGE
LSH T1,9
XMOVEI T1,(T1) ;In current section
CR20LP: SKIP (T1) ;TO CREATE IT
ADDI T1,1000
SOJG T2,CR20LP
>;END IF20
IF10,<
PUSHJ P,%SAVE4 ;SAVE P1-P4
MOVEI P3,(P1) ;INITIALIZE P3, NUMBER OF PAGE BEING CREATED
MOVE P4,[-PLEN,,1] ;GET AOBJN POINTER TO PAGE. BLOCK
MOVEI T1,2 ;GET PAGE-EXISTS BIT
PUSHJ P,DOPGS ;MOVE BIT THROUGH BIT MAP
PUSHJ P,CREPG ;GO CREATE PAGE IF IT DOESN'T EXIST
JRST .+2 ;CREATED OK, SKIP
POPJ P, ;COULDN'T CREATE THEM, ERROR RETURN
TRNE P4,-2 ;IF ARG BLOCK IS NONEMPTY,
PUSHJ P,PGUUO ;DO FINAL UUO
JRST .+2 ;WORKED, FINE
POPJ P, ;DIDN'T WORK, ERROR RETURN
>
MOVEI T1,3 ;GET PAGE-ALLOCATED AND PAGE-EXISTS BITS
PUSHJ P,DOPGS ;MOVE THROUGH BIT MAP
IORM T1,PTAB(T2) ;MARK PAGE EXISTING AND ALLOCATED
JRST %POPJ1 ;SUCCESS RETURN
IF10,<
;ROUTINE TO CREATE A PAGE IF NECESSARY
;CALLED FROM INSIDE DOPGS, SO MUST BE CAREFUL
;ARGS: T1, T2 = BIT AND OFFSET FROM DOPGS
; (TO CHECK IF PAGE IS MARKED NONEXISTENT IN BIT MAP)
; P3 = PAGE NUMBER TO CREATE
; P4 = AOBJN POINTER TO PAGE. ARG BLOCK
;RETURN: P1-P2, T1-T4 UNCHANGED
; P3, P4 UPDATED FOR NEXT ITERATION OF DOPGS
;NONSKIP RETURN IF PAGE CREATED OK
;SKIP RETURN (TO TERMINATE DOPGS) IF PAGE COULDN'T BE CREATED
CREPG: TDNE T1,PTAB(T2) ;DOES PAGE EXIST ALREADY?
AOJA P3,%POPJ ;YES, FINE
HLL P3,VRTBIT ;SET PA.GCD IF WANT A VIRTUAL PAGE
MOVEM P3,PBLK(P4) ;PUT PAGE NUMBER IN ARG BLOCK
ADDI P3,1 ;INCREMENT FOR NEXT TIME
AOBJN P4,%POPJ ;RETURN IF BLOCK NOT FULL YET
PGUUO: SUBI P4,1 ;UNDO EXTRA INCREMENT FROM AOBJN
HRRZM P4,PBLK ;STORE COUNT WORD
PGUUO1: MOVE P4,[.PAGCD,,PBLK] ;POINT TO ARG BLOCK
PAGE. P4, ;TRY TO CREATE PAGES
JRST VIRT ;DIDN'T WORK, GO TRY TO GO VIRTUAL
MOVE P4,[-PLEN,,1] ;RESET AOBJN POINTER
POPJ P, ;DONE
VIRTER: MOVE T1,PBLK+1 ;T1:= page number (for ERR call)
; ERR (CCP,999,106,?,Can't create page $O (PAGE. error $O),<T1,P4>)
$ECALL CCP,%ABORT ;"?Can't create page n"
VIRT: CAIN P4,PAGNX% ;NO VIRTUAL PRIVS?
JRST %POPJ1 ;YES, GIVE UP ON CREATING PAGE
CAIE P4,PAGLE% ;Skip if "Core limit exceeded"
JRST VIRTER ;NO, all other errors are fatal
SKIPE VRTBIT ;ALREADY WENT VIRTUAL?
JRST %POPJ1 ;YES, GIVE UP. PAGE CAN'T BE CREATED
MOVSI T0,(PA.GCD) ;GET VIRTUAL BIT
MOVEM T0,VRTBIT ;SET FOR FUTURE CALLS
MOVE P4,[-PLEN,,1] ;MAKE AOBJN POINTER TO PAGE. ARG BLOCK
HLLM T0,PBLK(P4) ;PUT BIT INTO ARG BLOCK
AOBJN P4,.-1
SKIPE .JBPFH ;PFH ALREADY READ IN, OR USER PFH?
JRST PGUUO1 ;YES, WONDERFUL, GO TRY AGAIN
;NOW THE TRICK IS TO MAKE ROOM FOR THE PAGE FAULT HANDLER. PHYSICAL
;MEMORY IS FULL, BUT THE PFH MUST RESIDE IN PHYSICAL MEMORY. THEREFORE
;PAGE OUT 1 OR 2 PAGES TO MAKE ROOM FOR IT. THEN TOUCH ONE OF THE
;PAGED-OUT PAGES TO FORCE THE MONITOR TO READ IN THE PFH NOW. THE ONLY
;PURPOSE FOR THAT IS TO CATCH MONITOR AND FOROTS BUGS HERE, NOT IN SOME
;RANDOM MEMORY REFERENCE SOMEWHERE ELSE.
STKVAR <SAVEP,,PCNT> ;ALLOCATE SOME TEMP VARIABLES
DMOVEM P1,SAVEP ;SAVE P1-P2
SETOM PCNT ;PCNT WILL GO POSITIVE AFTER 2 PAGES
MOVEI P2,1 ;FIRST PAGE NUMBER IS 1
VIRTLP: TRNE P2,777000 ;PAGE NUMBER OVER 1000?
JRST VRTRET ;YES, RAN OUT OF PAGES. NICE TRY
MOVSI P1,.PAGCA ;SET TO CHECK PAGE ACCESS BITS
HRRI P1,(P2) ;PUT IN PAGE NUMBER
PAGE. P1, ;GET BITS FOR THE PAGE
$SNH ;Shouldn't fail
TXNE P1,PA.GNE+PA.GPO+PA.GCP ;CHECK EXISTING PAGE, IN CORE, CAN BE PAGED OUT
AOJA P2,VIRTLP ;NO DICE, TRY NEXT PAGE
MOVE P4,[.PAGIO,,P1] ;POINT TO ARG BLOCK
MOVEI P1,1 ;SET COUNT WORD TO 1
TXO P2,PA.GAF ;SET TO PAGE THE PAGE OUT
PAGE. P4, ;DO IT
JRST VRTRET ;DIDN'T MAKE IT, GIVE UP
AOSG PCNT ;INCREMENT COUNT OF PAGES WE'VE DONE
AOJA P2,VIRTLP ;NOT ENOUGH YET, LOOP
LSH P2,9 ;CONVERT PAGE NUMBER TO ADDRESS
SKIP (P2) ;READ IN PFH
VRTRET: DMOVE P1,SAVEP ;RESTORE P1-P2
UNSTK ;RESTORE P
JRST PGUUO1 ;GO TRY UUO AGAIN
>;END IF10
;ROUTINE TO DESTROY PAGES
;ARGS: P1 = FIRST PAGE TO DESTROY
; P2 = NUMBER OF PAGES TO DESTROY
;ON RETURN, PAGES ARE GONE
KILPGS:
IF20,<
SETO T1, ;UNMAP THE PAGES
MOVSI T2,.FHSLF ;FROM THIS FORK
HRRI T2,(P1) ;STARTING AT GIVEN PAGE NUMBER
MOVSI T3,(PM%CNT) ;WE ARE GIVING A COUNT
HRRI T3,(P2) ;WHICH IS IN P2
PMAP% ;DESTROY THE PAGES
>
IF10,<
STKVAR <SAVEP,> ;SAVE P1-P2
DMOVEM P1,SAVEP
KILLP: MOVE T1,[-PLEN,,1] ;GET AOBJN POINTER TO PAGE. BLOCK
HRLI P1,(PA.GAF) ;SET TO DESTROY THE PAGES
KILLP1: MOVEM P1,PBLK(T1) ;PUT PAGE NUMBER IN BLOCK
ADDI P1,1 ;INCREMENT PAGE NUMBER
SOJLE P2,EKILLP ;IF COUNT HIT 0, DONE
AOBJN T1,KILLP1 ;KEEP GOING UNTIL BLOCK FILLS UP
SUBI T1,1 ;UNDO EXTRA INCREMENT FROM AOBJN
EKILLP: HRRZM T1,PBLK ;SET COUNT IN ARG BLOCK
MOVE T1,[.PAGCD,,PBLK] ;SET TO DESTROY PAGES
MOVE T2,PBLK+1 ;Get page number incase error
PAGE. T1, ;DO IT
; ERR (CDP,999,106,?,<Can't destroy page $O (PAGE. error $O)>,<T2,T1>)
$ECALL CDP,%ABORT
JUMPG P2,KILLP ;IF MORE LEFT TO DO, DO THEM
DMOVE P1,SAVEP ;RESTORE P1-P2
UNSTK
>
MOVEI T1,3 ;GET BOTH BITS
PUSHJ P,DOPGS ;MOVE T1 THROUGH BITS IN PTAB
ANDCAM T1,PTAB(T2) ;MARK PAGES FREE AND NONEXISTENT
POPJ P, ;DONE
;ROUTINE TO HANDLE PAGE BIT MAP
;CALL:
; MOVEI P1,FIRSTPAGE ;FIRST PAGE TO DO
; MOVEI P2,NPAGES ;NUMBER OF PAGES TO DO
; MOVEI T1,N ;BIT PATTERN
; PUSHJ P,DOPGS ;MOVE IT THROUGH BIT MAP
; INST T1,PTAB(T2) ;ANY INSTRUCTION
; <INST DIDN'T SKIP, EVER>
; <INST SKIPPED, AT LEAST ONCE>
;
;THE INSTRUCTION AFTER THE CALL IS EXECUTED REPEATEDLY WITH T1
;CONTAINING THE ORIGINAL BIT PATTERN, SHIFTED OVER APPROPRIATELY, AND
;T2 CONTAINING THE APPROPRIATE INDEX INTO PTAB. IF THE INSTRUCTION
;SKIPS, CONTROL RETURNS FROM DOPGS IMMEDIATELY; IF IT NEVER SKIPS,
;THE INSTRUCTION IS EXECUTED FOR ALL PAGES FROM P1 TO P1+P2-1.
DOPGS: STKVAR <FIRSTP,NP,BITPAT> ;ALLOCATE SPACE ON STACK
DMOVEM P1,FIRSTP ;SAVE FIRST PAGE, NUMBER OF PAGES
MOVEM T1,BITPAT ;SAVE BIT PATTERN
IDIVI P1,^D18 ;GET BYTE POS WITHIN WORD
LSH P2,1 ;BYTES ARE 2 BITS LONG
LSH T1,(P2) ;MOVE BIT PATTERN TO RIGHT POSITION
MOVEI T2,(P1) ;GET OFFSET WITHIN TABLE
MOVE P2,NP ;GET COUNT BACK
JRST DOPLP1 ;START AT BEGINNING
DOPLP: LSH T1,2 ;MOVE BIT PATTERN OVER
JUMPN T1,DOPLP1 ;LOOP IF STILL IN WORD
MOVE T1,BITPAT ;RESET T1 TO BEGINNING OF NEXT WORD
ADDI T2,1 ;BUMP INDEX TO NEXT WORD
DOPLP1: SOJL P2,DOPRET ;QUIT WHEN DONE
XCT @-.L(P) ;DO THE INSTRUCTION
JRST DOPLP ;NONSKIP
AOS -.L(P) ;PASS ON SKIP RETURN
DOPRET: DMOVE P1,FIRSTP ;RESTORE P1-P2
UNSTK ;RESTORE P
JRST %POPJ1 ;RETURN, SKIPPING OVER INST
;ROUTINE TO INITIALIZE MEMORY
;CALLED FROM INIT. ON PROGRAM START OR RESTART
;PUTS MEMORY INTO A KNOWN, CONSISTENT STATE BY DELETING ALL
;PAGES IT DOESN'T LIKE. IT LIKES PAGES BELOW .JBFF, PAGES
;BETWEEN RH(.JBHRL)-LH(.JBHRL)+1 AND RH(.JBHRL), PAGES IN FOROTS,
;AND PAGES ABOVE STARTP. ALL OTHERS GO.
;ALSO SETS UP FREE LIST POINTERS BEGPTR, FREPTR, AND FLBEG,
;AND THE PAGE BIT MAP PTAB.
%MEMINI:
PUSHJ P,%SAVE4 ;SAVE P1-P4
XMOVEI T2,. ;Get section number
HLRZ T2,T2
LSH T2,^D9 ;Get page # to "OR"
MOVEM T2,PAGSEC ;Page # of start of this section
MOVEI T1,.JBFF ;SETUP .JBFF PNTR
MOVEM T1,%JBFPT
XMOVEI T1,EXPADR ;SETUP ADDR OF MEMORY EXPANDER/CONTRACTOR
MOVEM T1,%EXPNT
SETZM EOL ;MAKE A ZERO TO END FREE LIST
MOVEI T1,EOL ;POINT TO THE ZERO
MOVEM T1,FREPTR ;START SEARCHING THERE
HRROM T1,BEGPTR ;IT'S ALSO START OF FREE LIST
SETZM FLBEG ;NO LOW SEG FREE LIST YET
IF10,<
SETZM VRTBIT ;START BY TRYING FOR PHYSICAL PAGES
>
;BL; Change at %MEMINI+7
MOVE T1,[252525,,252525] ;INIT TO '010101....010101'
MOVEM T1,PTAB ;PAGE BIT TABLE = ALL UAVAILABLE & NONEXISTENT
; SETOM PTAB ;SET PAGE BIT TABLE TO ALL UNAVAILABLE
MOVE T1,[PTAB,,PTAB+1]
BLT T1,PTAB+^D28
MOVE P1,JOBFF ;GET END+1 OF LOW SEGMENT
ADDI P1,777 ;ROUND UP TO A PAGE BOUNDARY
LSH P1,-9 ;GET FIRST PAGE AFTER LOW SEGMENT
MOVEM P1,LPAGE ;SAVE IT FOR LOW SEG CORE ALLOCATION
;PTAB NOW HAS ALL PAGES MARKED AS UNAVAILABLE. GO THROUGH IT, PAGE
;BY PAGE, AND MARK EACH PAGE AVAILABLE IF IT PASSES ALL THE TESTS.
;THE LOOP GOES FROM .JBFF TO PAGE TOPP, CHECKING EACH PAGE TO SEE IF
;IT'S IN THE DATA AREA OR IN FOROTS OR IN VMDDT OR IN THE PFH OR IN
;THE SYMBOL TABLE.
MINILP: CAILE P1,760 ;HAVE WE HIT TOP OF OUR CORE?
POPJ P,
HRRZ T1,.JBHRL ;GET HS BREAK
MOVEI T2,(T1) ;COPY IT
HLRZ T3,.JBHRL ;GET HS LENGTH
SUBI T1,-1(T3) ;SUBTRACT, GIVING HS ORIGIN
JUMPL T1,CHKDAT ;NO HS. CHECK DATA AREA
PUSHJ P,INUSCK ;CHECK FOR IN USE
AOJA P1,MINILP ;IN USE. DON'T BOTHER
CHKDAT:
IFN FTSHR,<
CAIG P1,Z.DATA/1000
CAIGE P1,F.CODE/1000 ;IS PAGE IN FOROTS?
JRST CHKSYM ;NO
AOJA P1,MINILP ;YES, LEAVE IT
>
CHKSYM: HRRZ T1,.JBSYM ;SYMBOL TABLE ADDR
MOVEI T2,(T1) ;COPY IT
HLRE T3,.JBSYM ;NEG COUNT
SUB T2,T3 ;GET HIGH ADDR+1
SOJL T2,CHKDDT ;IF NEG, NO SYMBOLS
PUSHJ P,INUSCK ;PAGE IN SYMBOL TABLE?
AOJA P1,MINILP ;YES, LEAVE IT
CHKDDT: HRRZ T1,.JBDDT ;DDT ADDR
JUMPE T1,CHKPFH ;NO DDT. GO CHECK PFH
HLRZ T2,.JBDDT ;HIGH ADDR
PUSHJ P,INUSCK ;PAGE IN DDT?
AOJA P1,MINILP ;YES, LEAVE IT
CHKPFH: HRRZ T1,.JBPFH ;PFH ADDR
MOVEI T2,(T1) ;COPY IT
HLRE T3,.JBPFH ;NEG COUNT
SUB T2,T3 ;GET HIGH ADDR+1
SOJL T2,PAGOK ;NO PFH IF NEG
PUSHJ P,INUSCK ;PAGE IN PFH?
AOJA P1,MINILP ;YES, LEAVE IT
PAGOK: MOVEI T1,(P1) ;COPY PAGE NUMBER FOR CHKNEX
MOVEI P2,1 ;SET LENGTH OF 1 PAGE
PUSHJ P,CHKNEX ;SEE IF PAGE EXISTS
PUSHJ P,KILPGS ;YES, MAKE IT NOT EXIST
MOVEI T1,3 ;MARK PAGE AVAILABLE AND NONEXISTENT
PUSHJ P,DOPGS ;SHIFT T1 TO RIGHT PLACE IN BIT MAP
ANDCAM T1,PTAB(T2)
AOJA P1,MINILP ;LOOP ON TO NEXT PAGE
;ROUTINE TO CHECK IF PAGE IS WITHIN GIVEN BOUNDARIES
;
; CALLED WITH LOW ADDR IN T1, HIGH ADDR IN T2, PAGE NUMBER IN P1
; SKIP RETURN IF PAGE IS FREE
INUSCK: LSH T1,-9 ;TO PAGE
LSH T2,-9 ;TO PAGE
CAMG P1,T2 ;PAGE IN USE?
CAMGE P1,T1
JRST %POPJ1 ;NO
POPJ P, ;YES
;ROUTINE TO CHECK IF A PAGE EXISTS
;ARGS: T1 = PAGE NUMBER
;SKIP RETURN IF PAGE IS NONEXISTENT
IF20,<
CHKNEX: HRLI T1,.FHSLF ;THIS FORK, PAGE NUMBER IS IN T1
RPACS% ;READ PAGE ACCESS
TXNN T2,P1%PEX ;CHECK PAGE-EXISTS BIT (IN RH SO UNWRITTEN
; FILE PAGES ARE CONSIDERED TO EXIST)
AOS (P) ;PAGE NONEXISTENT
POPJ P, ;PAGE EXISTS
>
IF10,<
CHKNEX: HRLI T1,.PAGCA ;CHECK ACCESS
PAGE. T1, ;TO PAGE NUMBER IN T1
$SNH ;SHOULD NEVER FAIL
TXNE T1,PA.GNE ;CHECK PAGE-NONEXISTENT BIT
AOS (P) ;PAGE NONEXISTENT
POPJ P, ;PAGE EXISTS
>
SEGMENT DATA
BEGPTR: BLOCK 1 ;POINTER TO START OF LIST
FREPTR: BLOCK 1 ;POINTER TO BLOCK TO START SEARCH AT
EOL: BLOCK 2 ;THE ZERO WORD AT END OF LIST
WRAP: BLOCK 1 ;-1 IF FIRST PASS THROUGH LIST
PAGSEC: BLOCK 1 ;Page # of start of this section
%PTAB:
PTAB: BLOCK ^D29 ;THE BIT TABLE
;2 BITS PER PAGE. 01 MEANS PAGE ALLOCATED
; 10 MEANS PAGE EXISTS
;PAGE 0 IS RIGHT 2 BITS OF FIRST WORD
IF10,<
PBLK: BLOCK 1 ;ARG COUNT WORD
BLOCK PLEN ;ARGS
VRTBIT: BLOCK 1 ;0 IF TRYING FOR PHYSICAL PAGES,
; PA.GCD IF TRYING FOR VIRTUAL PAGES
>
SUBTTL OVERLAY (LOW SEGMENT) MEMORY MANAGER
SEGMENT CODE
COMMENT &
"Low segment" in these routines means the pages between 0 and .JBREL which
are used to hold the root segment and all of the user's overlays. Note that
in the strict TOPS-10 sense, the low segment is these pages and also the
pages at the top of core with the OTS free storage and data in them.
The free list for the low segment is kept in one contiguous block of memory
in OTS free core. Each word in the list gives the start and end address of
one block of free memory, the start address in the left half and the end
address + 1 in the right half. The list is in increasing order on address.
All blocks are disjoint and not contiguous.
The free list table is pointed to by FLBEG and its length is in FLLEN. The
maximum size of the free list is determined by the size of the table; this
number is in FLMAX.
&
;ROUTINE TO MARK A BLOCK OF THE LOW SEG "ALLOCATED"
;ARGS: T1 = ADDRESS OF BEGINNING OF BLOCK
; T2 = ADDRESS OF END+1 OF BLOCK
;NONSKIP RETURN: NOT ENOUGH MEMORY
;1 SKIP: BLOCK ALREADY ALLOCATED OR OVERLAPS ALLOCATED BLOCK
;2 SKIPS: OK, BLOCK ALLOCATED
LSGET: PUSHJ P,%SAVE4 ;SAVE P1-P4
SKIPN P3,FLBEG ;POINT TO START OF FREE LIST
PUSHJ P,LSINIT ;NONE YET, GO MAKE ONE
MOVE P4,FLLEN ;GET LENGTH OF FREE LIST
GETLP: SOJGE P4,EXPRET ;IF ONE THERE, WE'RE OK
CAMGE T2,JOBFF ;TRYING TO ALLOCATE BELOW .JBFF?
JRST %POPJ1 ;YES. ALREADY ALLOCATED
MOVEM T1,DESLOW ;SAVE T1,T2 FOR EXPAND ROUTINE
MOVEM T2,DESHGH
PUSHJ P,LSEXP ;GO EXPAND CORE
POPJ P, ;NON-SKIP MEANS CAN'T (INSUFFICIENT MEMORY)
MOVE T1,DESLOW ;RESTORE T1,T2
MOVE T2,DESHGH
MOVE P2,T2 ;COPY HIGH ADDR + 1
ADDI P2,777 ;ROUND END+1 UP TO MULTIPLE OF 1000
TRZ P2,777
HRRZ P1,-1(P3) ;GET END+1 OF TOP EXISTING FREE BLOCK
CAML P1,JOBFF ;DOES BLOCK END AT .JBFF?
SOJA P3,EXPMRG ;YES, MERGE IN THE NEW CORE WITH TOP BLOCK
MOVE P1,JOBFF ;NO, NEW CORE IS A NEW FREE BLOCK
PUSHJ P,BLTUP ;MOVE LIST UP TO MAKE ROOM FOR NEW BLOCK
HRLZM P1,(P3) ;STORE START ADDRESS OF NEW FREE BLOCK
EXPMRG: HRRM P2,(P3) ;STORE NEW END+1 ADDRESS OF FREE BLOCK
MOVEM P2,JOBFF ;STORE UPDATED .JBFF
ADDI P2,777 ;WANT PAGE BEYOND ALLOCATED CORE
IF20,< TRZ P2,777 ;MAKE IT A PAGE
MOVEI P1,-1(P2) ;TOPS-10 PROGS NEED .JBREL, SO KEEP IT RIGHT
MOVEM P1,.JBREL >
LSH P2,-9 ;GET HIGHEST PAGE + 1 THAT WE ALLOCATED
MOVEM P2,LPAGE ;REMEMBER IT
EXPRET: HLRZ P1,(P3) ;GET BEG ADRESS OF A FREE BLOCK
HRRZ P2,(P3) ;GET END+1
CAIGE P2,(T2) ;DOES FREE BLOCK END BEFORE ALLOCATED BLOCK?
AOJA P3,GETLP ;YES, SEARCH FOR ONE WITH HIGH ENOUGH END ADDR
CAILE P1,(T1) ;DOES FREE BLOCK START AFTER ALLOCATED BLOCK?
JRST %POPJ1 ;YES, ALREADY ALLOCATED
MOVEI T3,(P2) ;CALCULATE MAX SIZE OF BLOCK ALLOCATABLE
SUBI T3,(T1) ; AT THIS ADDRESS FOR FUNCT.
MOVEM T3,BLKSIZ
CAIE P1,(T1) ;DO BLOCKS BEGIN AT SAME PLACE?
JRST GECHK ;YES, GO COMPARE END POINTERS
CAIE P2,(T2) ;DO BLOCKS END AT SAME PLACE?
JRST GTOP ;NO, ALLOCATE TOP PART OF BLOCK
;BLOCK TO BE ALLOCATED IS ALL OF AN EXISTING FREE BLOCK
GALL: PUSHJ P,BLTDWN ;ALLOCATE WHOLE BLOCK BY REMOVING IT
JRST %POPJ2 ; COMPLETELY FROM THE FREE LIST
;BLOCK TO BE ALLOCATED IS TOP OF AN EXISTING FREE BLOCK
GTOP: HRLM T2,(P3) ;END ADDRESS OF ALLOCATED BLOCK IS NEW
JRST %POPJ2 ; START ADDRESS OF FREE BLOCK
GECHK: CAIE P2,(T2) ;DO BLOCKS END AT SAME PLACE?
JRST GMIDDL ;NO, ALLOCATE CHUNK FROM MIDDLE
;BLOCK TO BE ALLOCATED IS BOTTOM OF AN EXISTING FREE BLOCK
GBOT: HRRM T1,(P3) ;START ADDRESS OF ALLOCATED BLOCK IS NEW
JRST %POPJ2 ; END ADDRESS OF FREE BLOCK
;BLOCK TO BE ALLOCATED IS IN MIDDLE OF AN EXISTING FREE BLOCK
GMIDDL: PUSHJ P,BLTUP ;MAKE A HOLE IN THE FREE LIST
HRRM T1,(P3) ;SET NEW END ADDRESS
HRLM T2,1(P3) ;AND NEW START ADDRESS
JRST %POPJ2 ;DONE
;HERE WHEN LOW SEG MUST BE EXPANDED TO ALLOCATE CORE. FAKE A CORE UUO
EXPADR: MOVE T2,DESHGH ;GET DESIRED HIGH ADDR
MOVE P1,LPAGE ;GET HIGHEST PAGE NUMBER IN LOW SEG
MOVEI P2,777(T2) ;ROUND TOP ADDRESS TO ALLOCATE UP TO A PAGE
LSH P2,-9 ;GIVING TOP PAGE TO ALLOCATE
SUBI P2,(P1) ;COMPUTE NUMBER OF PAGES TO CREATE
JUMPE P2,%POPJ1 ;IF NONE, SKIP
JUMPL P2,DEALC ;CORE HAS TO BE REDUCED
PUSHJ P,CREPGS ;CREATE THE PAGES
POPJ P, ;INSUFFICIENT MEMORY
JRST %POPJ1 ;OK. DONE
DEALC: ADD P1,P2 ;GET LOWEST PAGE TO KILL
MOVM P2,P2 ;MAKE COUNT POSITIVE
PUSHJ P,KILPGS ;KILL THE PAGES
JRST %POPJ1 ;SKIP RETURN, LIKE ABOVE
LSINIT: STKVAR <SAVET,> ;ALLOCATE SPACE ON STACK
DMOVEM T1,SAVET ;SAVE T1-T2
MOVEI T1,FLSIZE+1 ;GET INITIAL SIZE OF FREE LIST BLOCK
PUSHJ P,%GTBLK ;GET CORE FOR FREE LIST
MOVEI P3,1(T1) ;PUT IN RIGHT AC
MOVEM P3,FLBEG ;SAVE START ADDRESS
SETZM FLLEN ;TABLE HAS ZERO LENGTH INITIALLY
SETZM -1(P3) ;MAKE A FAKE FREE BLOCK STARTING AT 0 AND
; ENDING AT 0 FOR BOUNDARY CONDITION IN LSFREE
MOVEI T1,FLSIZE ;SET FLMAX
MOVEM T1,FLMAX
DMOVE T1,SAVET ;RESTORE T1-T2
UNSTK ;FIX STACK
POPJ P, ;ALL DONE
;ROUTINE TO MARK A BLOCK IN THE LOW SEGMENT "FREE"
;ARGS: T1 = BEG ADDRESS
; T2 = END+1 ADDRESS
;NONSKIP RETURN IF BLOCK WASN'T ALLOCATED, ELSE SKIP RETURN
LSFREE: PUSHJ P,%SAVE4 ;SAVE P1-P4
SKIPN P3,FLBEG ;POINT TO FREE LIST
POPJ P, ;NONE SET UP, ERROR RETURN
SKIPA P4,FLLEN ;GET LENGTH OF FREE LIST
FREELP: ADDI P3,1 ;BUMP TO NEXT ENTRY IN FREE LIST
SOJL P4,FREEFF ;END OF FREE LIST, GO CHECK .JBFF
HRRZ P1,-1(P3) ;GET START ADDRESS OF ALLOCATED BLOCK
HLRZ P2,(P3) ;GET END ADDRESS OF SAME ALLOCATED BLOCK
CAIGE P2,(T2) ;DOES ALLOCATED BLOCK END BEFORE FREE BLOCK?
JRST FREELP ;YES, SEARCH FOR ONE WITH HIGH ENOUGH END ADR
CAILE P1,(T1) ;DOES ALLOCATED BLOCK START AFTER FREE BLOCK?
POPJ P, ;YES, FREE BLOCK IS ALREADY FREE
CAIE P1,(T1) ;DO BLOCKS START AT SAME PLACE?
JRST FECHK ;NO, GO COMPARE END POINTERS
CAIE P2,(T2) ;DO BLOCKS START AT SAME PLACE?
JRST FTOP ;NO, FREE TOP PART OF BLOCK
;BLOCK TO BE FREED IS ALL OF AN EXISTING ALLOCATED BLOCK
HRRZ T2,(P3) ;SAVE POINTER TO END OF FREE BLOCK
PUSHJ P,BLTDWN ;REMOVE FREE BLOCK FROM LIST
; HRRM T2,-1(P3) ;COMBINE PREVIOUS AND FOLLOWING FREE BLOCKS
; JRST %POPJ1 ;BLOCK FREED
;BLOCK TO BE FREED IS TOP OF AN EXISTING FREE BLOCK
FTOP: HRRM T2,-1(P3) ;NEW START ADDRESS OF FOLLOWING FREE BLOCK
JRST %POPJ1 ; IS START ADDRESS OF BLOCK BEING FREED
FECHK: CAIE P2,(T2) ;DO BLOCKS END AT SAME PLACE?
JRST FMIDDL ;NO, FREE BLOCK IN MIDDLE
;BLOCK TO BE FREED IS BOTTOM OF AN EXISTING ALLOCATED BLOCK
FBOT: HRLM T1,(P3) ;NEW END ADDRESS OF FREE BLOCK IS START
JRST %POPJ1 ; ADDRESS OF BLOCK BEING FREED
;BLOCK TO BE FREED IS IN MIDDLE OF AN EXISTING ALLOCATED BLOCK
FMIDDL: PUSHJ P,BLTUP ;MAKE A HOLE IN THE FREE LIST
HRLM T1,(P3) ;PUT A NEW ENTRY IN THE LIST
HRRM T2,(P3)
JRST %POPJ1 ;BLOCK FREED
;HERE WHEN USER FREES A BLOCK ABOVE THE TOP EXISTING FREE BLOCK.
;SEE IF IT IS BELOW .JBFF AND IF SO, FREE IT
FREEFF: CAMLE T2,JOBFF ;TRYING TO FREE BLOCK ABOVE .JBFF?
POPJ P, ;YES, ALREADY FREE
SUBI P3,1 ;POINT TO TOP EXISTING FREE BLOCK
HRRZ P1,(P3) ;GET END ADDRESS OF TOP BLOCK
CAILE P1,(T1) ;DOES IT END AFTER THE ONE USER IS FREEING?
POPJ P, ;YES, USER'S BLOCK IS ALREADY FREE
CAIE P1,(T1) ;IS USER'S BLOCK CONTIGUOUS WITH TOP BLOCK?
JRST FNEW ;NO, GO CREATE NEW ENTRY IN FREE LIST
HRRM T2,(P3) ;MERGE FREE BLOCKS TOGETHER
JRST %POPJ1 ;RETURN
FNEW: PUSHJ P,BLTUP ;MAKE NEW ENTRY IN FREE LIST
HRLZM T1,1(P3) ;BEG ADDRESS IS IN T1
HRRM T2,1(P3) ;END+1 ADDRESS IS IN T2
JRST %POPJ1 ;ALL DONE
;ROUTINE TO LOCATE A FREE BLOCK OF SUFFICIENT SIZE
;ARGS: T2 = SIZE OF BLOCK TO FIND
;RETURN: T1 = ADDRESS OF A BLOCK TO ALLOCATE
; T2 UNCHANGED
LSFIND: PUSHJ P,%SAVE4 ;SAVE P1-P4
MOVE T1,JOBFF ;IF ALL ELSE FAILS, ALLOCATE AT .JBFF
SKIPN P3,FLBEG ;POINT TO FREE LIST
POPJ P, ;NO FREE LIST, USE .JBFF
MOVE P4,FLLEN ;GET LENGTH OF LIST
FINDLP: SOJL P4,TOPCOR ;NO NEXT ENTRY, CHECK LAST ENTRY
HLRZ P1,(P3) ;GET START OF FREE BLOCK
HRRZ P2,(P3) ;AND END+1
SUBI P2,(P1) ;COMPUTE LENGTH
CAIGE P2,(T2) ;BIG ENOUGH?
AOJA P3,FINDLP ;NO, KEEP LOOKING
MOVEI T1,(P1) ;PUT ADDRESS IN RIGHT AC
POPJ P, ;RETURN
TOPCOR: HRRZ P1,-1(P3) ;GET TOP+1 OF LAST FREE BLOCK
CAMN P1,JOBFF ;IS IT .JBFF?
HLRZ T1,-1(P3) ;YES. USE BOTTOM OF BLOCK AS BASE LOC
POPJ P,
;ROUTINE TO CUT BACK THE LOW SEG SIZE TO MINIMUM
;NO ARGS
LSTRIM: PUSHJ P,%SAVE2 ;SAVE P1-P2
MOVE P1,JOBFF ;GET HIGHEST ADDRESS WE NEED TO KEEP
SKIPG T1,FLLEN ;GET FREE LIST LENGTH
JRST CALEXP ;NO FREE LIST, USE .JBFF
ADD T1,FLBEG ;POINT TO END OF FREE LIST
HRRZ T2,-1(T1) ;GET END+1 ADDRESS OF TOP FREE BLOCK
CAIGE T2,(P1) ;DOES TOP BLOCK END AT .JBFF?
JRST CALEXP ;NO, CUT BACK TO .JBFF
HLRZ P1,-1(T1) ;CUT BACK TO START OF TOP FREE BLOCK
SOS FLLEN ;DELETE BLOCK FROM FREE LIST
CALEXP: MOVEM P1,DESHGH ;TELL LSEXP WE WANT TO SHRINK
PUSHJ P,LSEXP
JFCL ;WILL ALWAYS SKIP RETURN
TRIMFF: MOVE P1,DESHGH ;GET NEW HIGH ADDR
MOVEM P1,JOBFF ;STORE NEW .JBFF
ADDI P1,777 ;ROUND UP TO PAGE NUMBER
IF20,< TRZ P1,777 ;ON TOPS-20, STORE .JBREL TOO
MOVEI P2,-1(P1) ; FOR OLD PROGS
MOVEM P2,.JBREL >
LSH P1,-9 ;GET FIRST PAGE GIVEN BACK
MOVEM P1,LPAGE ;STORE NEW HIGHEST PAGE+1
POPJ P, ;DONE
;ROUTINES TO EXPAND AND CONTRACT THE FREE LIST
;ARGS: P3 = ADDRESS IN LIST TO EXPAND OR CONTRACT AT
;RETURN: P3 UNCHANGED, T1-T4 UNCHANGED
;TO BE PRECISE:
;
; BEFORE BLTUP BLTDWN
;
; !-------------! !-------------! !-------------!
; ! ! ! ! ! ! <-- FLBEG
; ! ! ! ! ! !
; ! ! ! ! ! !
; !------!------! !------!------! !------!------!
; ! B1 ! E1 ! ! B1 ! E1 ! ! B1 ! E1 !
; !------!------! !------!------! !------!------!
; ! B2 ! E2 ! ! B2 ! E2 ! ! B3 ! E3 ! <-- P3
; !------!------! !------!------! !------!------!
; ! B3 ! E3 ! ! B2 ! E2 ! ! !
; !------!------! !------!------! ! !
; ! ! ! B3 ! E3 ! ! !
; ! ! !------!------! ! !
; ! ! ! ! !-------------!
; ! ! ! !
; !-------------! ! !
; ! !
; !-------------!
BLTDWN: STKVAR <SAVET,> ;ALLOCATE SPACE ON STACK
DMOVEM T1,SAVET ;SAVE T1-T2
SOSG T1,FLLEN ;DECREMENT LS TABLE LENGTH
JRST BLTRET ;ZERO LENGTH, ALL DONE
ADD T1,FLBEG ;COMPUTE END+1 OF TABLE
MOVSI T2,1(P3) ;SET BLT FROM ADDRESS
HRRI T2,(P3) ;AND BLT TO ADDRESS
CAILE T1,(T2) ;CHECK FOR 1-WORD TABLE
BLT T2,-1(T1) ;MOVE THE TABLE DOWN ONE
JRST BLTRET ;ALL DONE
BLTUP: STKVAR <SAVET,> ;ALLOCATE SPACE ON STACK
DMOVEM T1,SAVET ;SAVE T1-T2
AOS T1,FLLEN ;INCREMENT TABLE LENGTH
CAMLE T1,FLMAX ;IN BOUNDS?
PUSHJ P,BLTEXP ;NO, GO MOVE TO BIGGER TABLE
ADD T1,FLBEG ;COMPUTE END+1 OF NEW TABLE
MOVEI T2,-2(T1) ;GET END ADDR OF OLD TABLE
SUBI T2,(P3) ;COMPUTE LENGTH-1 WE NEED TO POP
HRLI T1,400000(T2) ;PUT INTO POP POINTER
HRRI T1,-2(T1) ;MAKE RH OF POINTER
POP T1,1(T1) ;BACKWARDS BLT
JUMPL T1,.-1
BLTRET: DMOVE T1,SAVET ;RESTORE T1-T2
UNSTK
POPJ P, ;ALL DONE
;HERE WHEN FREE LIST TABLE FILLS UP
;MOVE THE FREE LIST INTO A BIGGER BLOCK. FIX ALL POINTERS INTO THE FREE LIST
;TO POINT TO THE NEW BLOCK. (THE ONLY THINGS THAT POINT TO THE FREE LIST ARE
;FLBEG AND P3.)
BLTEXP: STKVAR <SAVET,> ;ALLOCATE SPACE ON STACK
DMOVEM T3,SAVET ;SAVE T3-T4
MOVE T2,FLMAX ;GET OLD LENGTH OF TABLE
MOVEI T3,FLSIZE(T2) ;GET NEW LENGTH
MOVEM T3,FLMAX ;SAVE NEW LENGTH
MOVE T1,FLBEG ;GET OLD ADDRESS
ADDI T3,1 ;FIX THINGS UP BECAUSE OF PHANTOM 0 WORD
ADDI T2,1 ; BEFORE START OF LIST. IT'S THERE BECAUSE
SUBI T1,1 ; LSFREE USES -1(P3) SOMETIMES
SUBI P3,(T1) ;UNRELOCATE P3
PUSHJ P,%MVBLK ;MOVE TABLE TO BIGGER BLOCK
ADDI P3,(T1) ;RERELOCATE P3
ADDI T1,1 ;SKIP PAST PHANTOM 0 WORD AT START OF TABLE
MOVEM T1,FLBEG ;STORE NEW ADDRESS OF TABLE
MOVE T1,FLLEN ;RESTORE T1
DMOVE T3,SAVET ;RESTORE T3-T4
UNSTK ;FIX UP STACK POINTER
POPJ P, ;RETURN
SEGMENT DATA
FLBEG: BLOCK 1 ;START ADDRESS OF LS FREE STORAGE TABLE
FLLEN: BLOCK 1 ;LENGTH
FLMAX: BLOCK 1 ;MAX LENGTH
%EXPNT: BLOCK 1 ;ADDRESS OF "CORE UUO" SIMULATOR
%JBFPT: BLOCK 1 ;ADDRESS OF .JBFF
%LPAGE:
LPAGE: BLOCK 1 ;HIGHEST PAGE + 1 ALLOCATED IN LOW SEG
DESLOW: BLOCK 1 ;BOTTOM OF DESIRED BLOCK
%DESHG:
DESHGH: BLOCK 1 ;TOP OF DESIRED BLOCK
BLKSIZ: BLOCK 1 ;MAX SIZE OF ALLOCATABLE BLOCK FROM LSGET
SUBTTL ALCOR. AND DECOR.
SEGMENT CODE
;ROUTINES TO PROVIDE STANDARD INTERFACE TO FOROTS CORE MANAGEMENT FOR
;MACRO PROGRAMS. STANDARD FORTRAN CALLING SEQUENCE, WITH ONE ARGUMENT
;POINTED TO BY AC 16. RESULT RETURNED IN AC 0.
;ALCOR. ALLOCATE A BLOCK OF CORE
;ARG: SIZE TO ALLOCATE
;RETURN: AC 0 = ADDRESS OF BLOCK, OR -1 IF NONE AVAILABLE
'ALCOR.'
ALCOR%: PUSHJ P,%SAVE ;SAVE USER'S ACS
MOVE T1,@(L) ;GET NUMBER OF WORDS TO ALLOCATE
PUSHJ P,GTBLKX ;ALLOCATE A BLOCK
SETO T1, ;NONE AVAILABLE
MOVEM T1,U.ACS+0 ;GIVE ADDRESS TO USER
JUMPL T1,%POPJ ;DONE NOW IF ERROR
MOVE T2,-1(P) ;GET RETURN ADDRESS OFF STACK
HRLM T2,-1(T1) ;STORE IN BLOCK HEADER FOR DEBUGGING
POPJ P, ;RETURN
;DECOR. DEALLOCATE A BLOCK OF CORE
;ARG: ADDRESS OF BLOCK
'DECOR.'
DECOR%: PUSHJ P,%SAVE ;SAVE USER'S ACS
MOVE T1,@(L) ;GET ADDRESS OF BLOCK
PJRST %FREBLK ;FREE IT AND RETURN
SUBTTL FUNCT.
SEGMENT CODE
;GENERAL-PURPOSE OTS INTERFACE. USES STANDARD FORTRAN CALLING SEQUENCE,
;WITH ARG BLOCK POINTED TO BY AC 16. THE FIRST THREE ARGS ARE STANDARD,
;THE REST ARE FUNCTION-SPECIFIC. THIS ROUTINE DOES NOT CHECK THAT IT IS
;GIVEN THE CORRECT NUMBER OF ARGUMENTS, OR THAT THEY HAVE THE CORRECT TYPE.
;FUNCT. ARGS
FN==0 ;FUNCTION CODE
ERRPFX==1 ;3-CHAR PREFIX FOR ERRORS, ASCIZ
STATUS==2 ;RETURNED STATUS, NONZERO MEANS ERROR
ARG1==3 ;FUNCTION-DEPENDENT ARGS
ARG2==4
ARG3==5
;FUNCTION DISPATCH TABLE
FDISP: EXP F.ILL ;0 ILLEGAL
EXP F.GAD ;1 GET LS MEMORY AT ADDRESS
EXP F.COR ;2 GET LS MEMORY ANYWHERE
EXP F.RAD ;3 RETURN LS MEMORY
EXP F.GCH ;4 GET I/O CHANNEL
EXP F.RCH ;5 RETURN I/O CHANNEL
EXP F.GOT ;6 GET OTS MEMORY
EXP F.ROT ;7 RETURN OTS MEMORY
EXP F.RNT ;10 GET INITIAL RUNTIME
EXP F.IFS ;11 GET INITIAL RUN FILESPEC
EXP F.CBC ;12 CUT BACK LS TO MINIMUM
EXP F.RRS ;13 READ RETAIN STATUS (DBMS)
EXP F.WRS ;14 WRITE RETAIN STATUS (DBMS)
EXP F.GPG ;15 GET PAGES
EXP F.RPG ;16 RETURN PAGES
EXP F.GPSI ;17 GET TOPS-20 PSI CHANNEL
EXP F.RPSI ;20 RETURN TOPS-20 PSI CHANNEL
LDISP==.-FDISP-1 ;MAX LEGAL FUNCTION CODE
;HERE IT IS
'FUNCT.'
%FUNCT: PUSHJ P,%SAVE ;SAVE USER'S ACS
SKIPLE T1,@FN(L) ;GET FUNCTION CODE
CAILE T1,LDISP ;LEGAL?
SETZ T1, ;NO, SET TO ILLEGAL FUNCTION
JRST @FDISP(T1) ;DISPATCH
;FUNCTION 0: ILLEGAL
;
;RETURNS STATUS -1 (NOT IMPLEMENTED)
F.ILL: SETOM @STATUS(L) ;SET RETURN STATUS TO -1
POPJ P, ;AND RETURN
;FUNCTION 1: GET LOW SEGMENT MEMORY AT GIVEN ADDRESS
;
;ARG1: ADDRESS
;ARG2: SIZE
;
;RETURNS STATUS 0 IF ALLOCATED OK
; 1 IF INSUFFICIENT MEMORY
; 2 IF ALREADY ALLOCATED AT THAT ADDRESS
; 3 IF ARGUMENT ERROR
F.GAD: MOVE T1,@ARG1(L) ;GET ADDRESS
SKIPG T2,@ARG2(L) ;AND LENGTH
JRST GADX ;NEGATIVE LENGTH MEANS GET BIG BLOCK
ADD T2,T1 ;COMPUTE END+1 OF REQUESTED CORE
TLNN T1,-1 ;CHECK FOR REASONABLE ADDRESS
TLNE T2,-1 ;AND LENGTH
JRST ERR3 ;JUNK CALL, REJECT IT
PUSHJ P,LSGET ;ALLOCATE THE CORE
JRST ERR1 ;NOT ENOUGH MEMORY
JRST ERR2 ;ALREADY ALLOCATED
JRST OKRET ;ALLOCATED
GADX: AOJN T2,ERR3 ;ONLY LEGAL NEGATIVE ARG IS -1
MOVEI T2,1(T1) ;TRY TO ALLOCATE 1 WORD
DMOVEM T1,DTEMP ;SAVE BEG AND END+1 OF BLOCK
PUSHJ P,LSGET ;TRY FOR 1 WORD AT GIVEN ADDRESS
JRST ERR1 ;NOT ENOUGH MEMORY
JRST ERR2 ;ALREADY ALLOCATED
DMOVE T1,DTEMP ;GET BEG AND END+1 OF THE WORD
PUSHJ P,LSFREE ;FREE THE 1 WORD
$SNH ;Not allocated, internal error
MOVE T1,DTEMP ;GET ADDRESS
MOVE T2,BLKSIZ ;AND SIZE, RETURNED BY FIRST LSGET
MOVEM T2,@ARG2(L) ;GIVE ALLOCATED LENGTH TO USER
ADDI T2,(T1) ;COMPUTE END+1 OF BLOCK
PUSHJ P,LSGET ;ALLOCATE MAX SPACE
$SNH ;Not enough memory
$SNH ;Already allocated
JRST OKRET ;ALL OK
;FUNTION 2: GET LOW SEGMENT MEMORY AT ANY ADDRESS
;
;ARG2: SIZE
;
;RETURNS ARG1 = ADDRESS OF ALLOCATED MEMORY
; STATUS 0 IF ALLOCATED OK
; 1 IF INSUFFICIENT MEMORY
; 3 IF ARGUMENT ERROR
F.COR: SKIPLE T2,@ARG2(L) ;GET SIZE
TLNE T2,-1 ;CHECK IT
JRST ERR3 ;WRONG
PUSHJ P,LSFIND ;FIND A SPOT WITH ENOUGH SPACE
ADD T2,T1 ;COMPUTE END+1 OF CORE TO ALLOCATE
PUSHJ P,LSGET ;ALLOCATE IT
JRST ERR1 ;NOT ENOUGH MEMORY
$SNH ;Already allocated, internal error
MOVEM T1,@ARG1(L) ;STORE ADDRESS FOR CALLER
JRST OKRET ;RETURN
;FUNCTION 3: RETURN LOW SEGMENT MEMORY
;
;ARG1: ADDRESS
;ARG2: SIZE
;
;RETURNS STATUS 0 IF DEALLOCATED OK
; 1 IF MEMORY WASN'T ALLOCATED
; 3 IF ARGUMENT ERROR
F.RAD: MOVE T1,@ARG1(L) ;GET ADDRESS
SKIPG T2,@ARG2(L) ;AND SIZE
JRST ERR3 ;ILLEGAL SIZE
ADD T2,T1 ;COMPUTE END+1 OF CORE TO FREE
TLNN T1,-1 ;CHECK ARGS
TLNE T2,-1
JRST ERR3 ;BAD
PUSHJ P,LSFREE ;DEALLOCATE BLOCK
JRST ERR1 ;WASN'T ALLOCATED
JRST OKRET ;OK, RETURN
;FUNCTION 4: GET I/O CHANNEL
;
;RETURNS ARG1 = CHANNEL NUMBER
; STATUS 0 IF CHANNEL ALLOCATED OK
; 1 IF NO CHANNEL AVAILABLE (OR TOPS-20)
F.GCH: SETZ T1, ;REQUEST ANY AVAILABLE CHANNEL
PUSHJ P,%ALCHN ;ALLOCATE CHANNEL
JRST ERR1 ;NONE AVAILABLE
MOVEM T1,@ARG1(L) ;GIVE TO USER
JRST OKRET ;OK, RET
;FUNCTION 5: RETURN I/O CHANNEL
;
;ARG1: CHANNEL NUMBER
;
;RETURNS STATUS 0 IF DEALLOCATED OK
; 1 IF CHANNEL WASN'T ALLOCATED
F.RCH: MOVE T1,@ARG1(L) ;GET CHANNEL NUMBER
TDNN T1,[-20] ;ERROR IF ARG NOT IN 0-17
PUSHJ P,%DECHN ;FREE THE CHANNEL
JRST ERR1 ;WASN'T ALLOCATED
JRST OKRET ;OK
;FUNCTION 6: GET MEMORY FROM OTS LIST
;
;ARG2: SIZE
;
;RETURNS ARG1 = ADDRESS OF ALLOCATED MEMORY
; STATUS 0 IF ALLOCATED OK
; 1 IF NOT ENOUGH MEMORY
; 3 IF ARGUMENT ERROR
F.GOT: SKIPLE T1,@ARG2(L) ;GET SIZE
TLNE T1,-1 ;CHECK FOR LEGALITY
JRST ERR3 ;BAD ARG
PUSHJ P,GTBLKX ;GET IT
JRST ERR1 ;NOT ENOUGH MEMORY
MOVEM T1,@ARG1(L) ;TELL USER THE ADDRESS
MOVE T2,-1(P) ;GET RETURN ADDRESS OFF STACK
HRLM T2,-1(T1) ;STORE IN BLOCK HEADER FOR DEBUGGING
JRST OKRET ;OK
;FUNTION 7: RETURN MEMORY TO OTS LIST
;
;ARG1: ADDRESS
;ARG2: SIZE
;
;RETURNS STATUS 0 IF DEALLOCATED OK
; 1 IF WASN'T ALLOCATED
; 3 IF ARGUMENT ERROR
F.ROT: SKIPLE T1,@ARG1(L) ;GET ADDRESS
TLNE T1,-1 ;CHECK
JRST ERR3 ;BAD
PUSHJ P,%FREBLK ;FREE BLOCK
JRST OKRET ;OK
;FUNCTION 10: GET PROGRAM INITIAL RUNTIME
;
;RETURNS ARG1 = JOB (FORK) RUNTIME WHEN PROGRAM STARTED, IN MILLISECONDS
; STATUS 0, ALWAYS
F.RNT: MOVE T1,I.RUNTM ;GET RUNTIME
MOVEM T1,@ARG1(L) ;RETURN IT TO USER
JRST OKRET ;RETURN
;FUNCTION 11: GET RUN FILESPEC (TOPS-10 ONLY)
;
;RETURNS ARG1 = DEVICE, SIXBIT
; ARG2 = FILENAME, SIXBIT
; ARG3 = PPN
; STATUS 0, ALWAYS
IF20,<
F.IFS==F.ILL ;NO RUNTIME FILESPEC AVAILABLE ON 20
>
IF10,<
F.IFS: MOVE T1,I.DEV ;GET DEVICE
MOVEM T1,@ARG1(L)
MOVE T1,I.FILE ;AND FILENAME
MOVEM T1,@ARG2(L)
MOVE T1,I.PPN ;AND PPN
MOVEM T1,@ARG3(L)
JRST OKRET ;OK, RET
>
;FUNCTION 12: CUT BACK CORE TO MINIMUM
;
;RETURNS STATUS 0 ALWAYS, WITH LOW SEG SHRUNK IF POSSIBLE
F.CBC: PUSHJ P,LSTRIM ;TRIM LS SIZE, IF POSSIBLE
JRST OKRET ;RETURN OK ALWAYS
;FUNCTIONS 13-14: READ AND WRITE RETAIN STATUS (RESERVED FOR DBMS)
;
;RETURNS ARG1 = 0
; STATUS 0, ALWAYS
F.RRS:
F.WRS: SETZM @ARG1(L) ;SET ARG TO ZERO
JRST OKRET ;OK RETURN
;FUNCTION 15: GET PAGES
;
;ARG2: SIZE TO BE ALLOCATED, WORDS
;
;RETURNS ARG1 = ADDRESS OF ALLOCATED MEMORY, ON PAGE BOUNDARY
; STATUS 0 IF ALLOCATED OK
; 1 IF NOT ENOUGH MEMORY
; 3 IF ARGUMENT ERROR
F.GPG: SKIPG T1,@ARG2(L) ;GET SIZE
JRST ERR3 ;BAD ARG
ADDI T1,777 ;ROUND UP TO NUMBER OF PAGES
LSH T1,-9 ;CONVERT WORDS TO PAGES
TDNE T1,[777777777000] ;CHECK
JRST ERR3 ;BAD ARG
PUSHJ P,%GTPGS ;ALLOCATE SOME PAGES
JRST ERR1 ;NOT ENOUGH MEMORY
LSH T1,9 ;CONVERT PAGE NUMBER TO WORD ADDRESS
MOVEM T1,@ARG1(L) ;GIVE TO CALLER
JRST OKRET ;OK
;FUNCTION 16: RETURN PAGES
;
;ARG1: ADDRESS (WORD)
;ARG2: SIZE (WORDS)
;
;RETURNS STATUS 0 IF DEALLOCATED OK
; 1 IF WASN'T ALLOCATED
; 3 IF ARGUMENT ERROR
F.RPG: MOVE T1,@ARG1(L) ;GET ADDRESS
SKIPG T2,@ARG2(L) ;AND SIZE
JRST ERR3 ;BAD SIZE, ERROR
ADDI T2,777 ;ROUND SIZE UP TO MULTIPLE OF 1 PAGE
LSH T1,-9 ;CONVERT ADDRESS TO PAGE
LSH T2,-9 ;CONVERT SIZE
TDNN T1,[777777777000] ;RANGE CHECK
TDNE T2,[777777777000]
JRST ERR3 ;BAD
PUSHJ P,%FREPGS ;FREE THE PAGES
JRST OKRET ;OK
;FUNCTION 17: GET TOPS-20 PSI CHANNEL
;
;ARG1: CHANNEL NUMBER, OR -1 TO ALLOCATE ANY USER-ASSIGNABLE CHANNEL
;ARG2: LEVEL NUMBER
;ARG3: ADDRESS OF INTERRUPT ROUTINE
;
;RETURNS ARG1 = CHANNEL NUMBER ALLOCATED (IF -1 WAS SENT)
; STATUS 0 IF OK
; 1 IF CHANNEL WAS ALREADY ASSIGNED
; 2 IF NO FREE CHANNELS
; 3 IF ARGUMENT ERROR
;
;THIS ENTRY POINT PROVIDES ONLY CONTROLLED ACCESS TO THE PSI TABLES.
;IT WILL ARRANGE THAT THE TABLES EXIST AND THAT SIR AND EIR HAVE BEEN DONE
;BUT DOES NOT DO AIC OR ANY OTHER JSYS NECESSARY TO SET UP THE CHANNEL (ATI
;OR MTOPR, FOR EXAMPLE).
F.GPSI: SKIPL T1,@ARG1(L) ;GET CHANNEL NUMBER
JRST GPSI1
PUSHJ P,GETPSI ;ALLOCATE A USER-ASSIGNABLE PSI CHANNEL
JRST ERR2 ;CAN'T
GPSI1: CAIL T1,^D36 ;IN RANGE?
JRST ERR3 ;NO, BAD ARG
SKIPE %CHNTAB(T1) ;CHANNEL IN USE?
JRST ERR1 ;YES, ERROR
SKIPLE T2,@ARG2(L) ;GET PSI LEVEL
CAILE T2,3 ;RANGE CHECK
JRST ERR3 ;BAD
MOVE T3,@ARG3(L) ;GET ADDRESS
SKIPN I.XSIR ;SIR FORMAT TABLES?
MOVEI T4,-1 ;YES, ADDRESS MUST FIT IN 18 BITS
SKIPE I.XSIR ;XSIR FORMAT TABLES?
MOVEI T4,770000 ;YES, ADDRESS MUST FIT IN 30 BITS
TLNE T3,(T4) ;DOES ADDRESS FIT?
JRST ERR3 ;DOESN'T, BAD ARGUMENT
SKIPGE @ARG1(L) ;RETURN CHANNEL TO USER
MOVEM T1,@ARG1(L)
MOVEM T3,%CHNTAB(T1) ;STORE LEVEL AND ADDRESS IN TABLE
SKIPN I.XSIR ;SIR FORMAT?
HRLM T2,%CHNTAB(T1) ;YES
SKIPE I.XSIR ;XSIR FORMAT?
DPB T2,[POINT 6,%CHNTAB(T1),5] ;YES
JRST OKRET ;OK
;FUNCTION 20: RETURN TOPS-20 PSI CHANNEL
;
;ARG1: CHANNEL NUMBER
;
;RETURNS STATUS 0 IF OK
; 1 IF CHANNEL WASN'T IN USE
; 3 IF ARGUMENT ERROR
;
;THIS ENTRY POINT PROVIDES ONLY CONTROLLED ACCESS TO THE PSI TABLES.
;IT DOES NOT DO DIC OR ANY OTHER JSYS NECESSARY TO RELEASE A CHANNEL,
;IT JUST CLEARS THE LEVEL AND INTERRUPT ADDRESS FIELDS IN CHNTAB.
F.RPSI: SKIPL T1,@ARG1(L) ;GET ARG
CAIL T1,^D36 ;RANGE CHECK
JRST ERR3 ;BAD
SKIPN %CHNTAB(T1) ;CHANNEL IN USE?
JRST ERR1 ;NO
SETZM %CHNTAB(T1) ;MARK CHANNEL FREE
JRST OKRET ;OK
;ROUTINE TO FIND A FREE PSI CHANNEL
;RETURNS T1 = CHANNEL NUMBER, IN 0:5 OR 23:35, THE USER-ASSIGNABLE CHANNELS
GETPSI: MOVSI T1,-6 ;TRY 0-5 FIRST
PUSHJ P,GPSIX
JRST %POPJ1 ;WON, RETURN
MOVE T1,[-^D13,,^D23] ;NOW 23-35
PUSHJ P,GPSIX
JRST %POPJ1 ;SUCCEED
POPJ P, ;FAIL
GPSIX: SKIPE %CHNTAB(T1) ;TRY ONE
AOBJN T1,.-1
JUMPGE T1,%POPJ1 ;IF WE RAN OUT, FAILURE RETURN
MOVEI T1,(T1) ;CLEAR COUNT OUT OF LH
POPJ P, ;SUCCESS RETURN
;EXIT ROUTINES
OKRET: JSP T1,ERRX ;NORMAL RETURN
ERR1: JSP T1,ERRX ;ERROR RETURNS
ERR2: JSP T1,ERRX
ERR3: JSP T1,ERRX
ERRX: SUBI T1,ERR1 ;CONVERT TO ERROR NUMBER
HRRZM T1,@STATUS(L) ;STORE FOR USER
POPJ P, ;RETURN
SEGMENT DATA
DTEMP: BLOCK 2 ;TEMP DOUBLEWORD
PURGE $SEG$
END