Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/cobfun.mac
There are 8 other files named cobfun.mac in the archive. Click here to see a list.
; UPD ID= 3167 on 10/14/80 at 3:24 PM by NIXON
TITLE COBFUN FOR LIBOL V12C
SUBTTL D. M. NIXON/ACK/DZN/DSB
SEARCH COPYRT
SALL
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1977, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
SEARCH INTERM,UUOSYM
SEARCH LBLPRM
IFN TOPS20, SEARCH MONSYM,MACSYM
SALL
SUBTTL REVISION HISTORY
;INTERN COBOL WHO WHAT
;
;017 1025 JEH If CORPT. zero, don't try to free core
;016 1002 DMN/JM Make CBC work when CORPT. goes 0 but overlays
; still exit
;
;V12B *****
;
;001 DMN Creation
;002 ACK Modifications to allow overlays in V6.
;003 ACK Add routines FUNGOT and FUNROT for V10.
;004 400 Changed GCH routineeee to get channel 0 last.
;005 SCC Added (reserved) 2 entry points for DBMS usage.
;006 472 JM Use PAGE. UUOs if they exist in FUNCBC.
;007 512 MDL Prevent MCS page pool from disappearing.
;010 514 DZN Check OTS list too in FUNCBC.
;011 DMN Add function to get memory on page boundary
;012 DSB Change routines to make page bound 'CORE GET'
; work and to fix other bugs.
;013 DMN Add function to return memory on page boundary
; to be compatible with FOROTS for DBMS.
;014 652 DMN Make CBC routine work with SORT 4C when all buffers have been returned.
;015 1002 DMN/JM Make CBC work when CORPT. goes 0 but overlays
; still exist
SUBTTL DEFINE SYMBOLS
TWOSEG 400000
.COPYRIGHT ;Put standard copyright statement in REL file
SALL
;ACCUMULATORS
T0=0 ;HOLDS STATUS
T1=1
T2=2
T3=3
T4=4
T5=5
P1=6 ;POINTER TO ARGS
L=16 ;POINTER TO ARG LIST
P=17 ;PUSHDOWN POINTER
DEFINE FUNDIR,<
FNCTN ILL ;0; ILLEGAL FUNCTION
FNCTN GAD ;1; GET CORE AT ADDRESS
FNCTN COR ;2; GET CORE FROM ANY ADDRESS
FNCTN RAD ;3; RETURN CORE AT ADDRESS
FNCTN GCH ;4; GET A CHANNEL
FNCTN RCH ;5; RETURN A CHANNEL
FNCTN GOT ;6; GET CORE FROM OTS LIST
FNCTN ROT ;7; RETURN CORE TO OTS LIST
FNCTN RNT ;10; GET RUNTIME FROM OTS
FNCTN IFS ;11; GET DEV:FILE[PPN] FROM OTS
FNCTN CBC ;12; CUT BACK CORE
FNCTN RRS ;13; READ RETAIN STATUS (MAY EVENTUALLY INVOLVE MORE)
FNCTN WRS ;14; WRITE RETAIN STATUS (DITTO)
FNCTN PAG ;15; GET CORE ON PAGE BOUNDARY
FNCTN RPG ;16; RETURN MEMORY ON A PAGE BOUNDARY
>
FUN.ZZ==0
DEFINE FNCTN(A),<
JRST FUN'A ;DEFINE DISPATCH TO PROCESSING ROUTINE
FUN.ZZ==FUN.ZZ+1 ;COUNT NUMBER OF ENTRIES IN TABLE
>
FUNDSP: FUNDIR ;DEFINE DISPATCH TABLE
SUBTTL FUNCTION DISPATCH
ENTRY FUNCT.
;CALLS TO FUNCT. CONFORM TO THE DEC STANDARD CALLING SEQUENCE
;
;THE ARG LIST HAS THE GENERAL FORM
;
; -ARG COUNT,,0
; ARGBLK: TYPE,,[FUNCTION]
; TYPE,,[ERROR CODE]
; TYPE,,[STATUS]
; TYPE,,[ARG1]
; TYPE,,[ARG2]
; TYPE,,[ARG3]
;
DEFINE FUNBLK,<
FUNARG FUN,IND
FUNARG ERR,IND
FUNARG STS,IND
FUNARG RG1,IND
FUNARG RG2,IND
FUNARG RG3,IND
>
FUN.YY==0
DEFINE FUNARG(A,B)<
FN.'A==FUN.YY ;SET INDEX INTO ARGBLK
FUN.YY==FUN.YY+1 ;COUNT ENTRIES IN ARGBLK
>
FUNBLK ;DEFINE ARGBLK SYMBOLS
SIXBIT /FUNCT./ ;FOR TRACE
FUNCT.: PUSHJ P,.SAVE ;SAVE REGISTERS
SETZ P1,0 ;LOCATE THE FUNCTION CODE
PUSHJ P,FUNADR ;LOCATE THE FUNCTION CODE
SKIPL P1,0(P1) ;LOAD THE ARGUMENT
CAIL P1,FUN.ZZ ;IS THE FUNCTION DEFINED?
SETZ P1,0 ;DEFAULT TO ILLEGAL FUNCTION
PUSHJ P,@FUNDSP(P1) ;DISPATCH TO FUNCTION ROUTINE
MOVEI P1,FN.STS ;LOCATE STATUS ARGUMENT
PUSHJ P,FUNADR ;LOCATE STATUS ARGUMENT
MOVEM T0,0(P1) ;STORE STATUS ARGUMENT
POPJ P, ;RETURN
SUBTTL FUNCTION ILL - ILLEGAL FUNCTION
;FUNCTION ILL - ILLEGAL FUNCTION
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARGBLK IS IGNORED
;ALWAYS RETURNS STATUS -1
FUNILL: SETO T0, ;SET ILLEGAL FUNCTION
POPJ P, ;RETURN TO USER
SUBTTL FUNCTION GAD - GET CORE AT SPECIFIED ADDRESS
;FUNCTION GAD - GET CORE AT ADDRESS
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: ADDRESS TO ALLOCATE CORE AT
;ARG2: SIZE OF BLOCK TO ALLOCATE
;
;STATUS 0: CORE ALLOCATED
;STATUS 1: NOT ENOUGH CORE IN SYSTEM
;STATUS 2: CANNOT ALLOCATE AT SPECIFIED LOCATION
;STATUS 3: ILLEGAL ARGUMENTS
FUNGAD: PUSHJ P,G2ARGS ;GO GET THE ARGS.
JUMPN T0,CPOPJ ;BAD ARGS, LEAVE.
; (T4) = ADDRESS OF FIRST LOCATION WANTED.
; (T5) = ADDRESS OF LAST LOCATION WANTED.
SKIPN T1,HLOVL.## ;IS THIS THE FIRST TIME?
PUSHJ P,SETHLO ;YES, GO SET UP HLOVL.
HLRZ T2,T1 ;(T2) = HIGHEST POSSIBLE FREE CORE LOC.
HRRZI T1,(T1) ;(T1) = LOWEST POSSIBLE FREE CORE LOC.
CAILE T1,(T4) ;DOES HE WANT CORE BELOW THE LOWEST?
JRST FUNST2 ;YES, WELL HE CAN'T HAVE IT - ERROR.
CAIGE T2,(T5) ;DOES HE WANT CORE ABOVE THE HIGHEST?
PUSHJ P,XPAND ;YES, GO TRY TO GET SOME MORE.
MOVEI T1,CORPT.## ;GET THE ADDRESS OF THE POINTER TO THE
; FIRST BLOCK.
PUSHJ P,GADLST ;GO TRY TO GET THE SPACE.
JRST FUNST2 ;CAN'T - RETURN A STATUS OF 2.
FUNGAH: SETZB T0,(T4) ;CLEAR FIRST WORD AND RETURN A STATUS OF 0.
POPJ P, ;RETURN
SUBTTL ROUTINE TO GET CORE (FROM A FREE CORE LIST) AT A SPECIFIED ADDRESS.
COMMENT \*************************
CALL:
PUSHJ P,GADLST
ENTRY CONDITIONS:
(T1) = ADDRESS OF POINTER TO A FREE CORE LIST.
(T4) = STARTING ADDRESS OF BLOCK WANTED
(T5) = ADDRESS OF LAST WORD IN BLOCK WANTED
EXIT CONDITIONS:
(T1), (T2), (T3) DESTROYED
(T4), (T5) UNCHANGED
IF THE CORE HAS BEEN ALLOCATED IT HAS BEEN REMOVED FROM THE
FREE CORE LIST AND THE RETURN IS TO CALL+2.
IF THE CORE CAN NOT BE ALLOCATED THE FREE CORE LIST IS UNCHANGED
AND THE RETURN IS TO CALL+1.
************************\
GADLST:
GADLS1: HRRZ T2,(T1) ;GET ADR OF NEXT BLOCK OF FREE CORE.
JUMPE T2,CPOPJ ;IF THERE IS NO MORE RETURN.
CAIGE T4,(T2) ;COULD THE BLOCK WE WANT STILL BE ON
; THE LIST?
POPJ P, ;NO WAY, ERROR RETURN.
HLRZ T3,(T2) ;GET THE ADR OF THE LAST LOC IN THIS BLOCK.
CAILE T5,(T3) ;IS THE LAST LOC WE WANT IN THIS BLOCK?
SKIPA T1,T2 ;NO, CURRENT BLOCK BECOMES PTR TO NEXT.
AOSA (P) ;BUMP RETURN ADDRESS.
JRST GADLS1 ;GO LOOK AT THE NEXT BLOCK.
;WE COME HERE WHEN WE KNOW THAT THE CORE WE WANT IS IN THE CURRENT BLOCK.
;STATE OF THINGS:
; (T1) = ADR OF PTR TO CURRENT BLOCK.
; (T2) = ADR OF CURRENT BLOCK.
; (T3) = LAST LOCATION OF CURRENT BLOCK.
; (T4), (T5) HAVE NOT BEEN CHANGED.
HRL T1,(T2) ;GET THE PTR TO THE NEXT BLOCK.
CAIE T2,(T4) ;START ALLOCATION AT THE FIRST WORD?
SOJA T4,GADLS3 ;NO, FORM THE ADR OF THE NEW LAST LOC
; AND GO BREAK UP THE BLOCK.
HLRM T1,(T1) ;DELINK THE BLOCK.
GADLS4: CAIE T3,(T5) ;END THE ALLOCATION AT THE LAST WORD.
AOJA T5,GADLS2 ;NO, GO FORM A NEW BLOCK AND LINK IT IN.
POPJ P, ;RETURN.
;HERE WE ADD A NEW BLOCK, WHICH IS THE LAST PART OF THE CURRENT BLOCK.
GADLS2: HRRM T5,(T1) ;SET THE POINTER TO THE NEW BLOCK.
HLRM T1,(T5) ;SET THE PTR TO NEXT IN THE NEW BLOCK.
HRLM T3,(T5) ;SET THE LAST LOC IN THE NEW BLOCK.
SOJA T5,CPOPJ ;RESTORE T5 AND RETURN.
;HERE WE ALLOCATE PART OF THE CURRENT BLOCK NOT BEGINNING AT THE
; FIRST LOCATION.
GADLS3: HRLM T4,(T2) ;SET THE NEW LAST LOCATION IN THE
; CURRENT BLOCK.
HRRI T1,(T2) ;SET THE CURRENT BLOCK AS THE POINTER
; TO THE CURRENT BLOCK. (HUH?)
AOJA T4,GADLS4 ;RESTORE THE ADR OF THE FIRST WORD
; ALLOCATED AND GO SEE IF WE WANT ALL OF
; THE REMAINDER OF THE BLOCK.
SUBTTL FUNCTION COR - GET CORE AT ANY ADDRESS
;FUNCTION COR - GET CORE FROM ANY ADDRESS
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: ADDRESS OF BLOCK ALLOCATED
;ARG2: SIZE OF BLOCK TO ALLOCATE
;
;STATUS 0: CORE ALLOCATED
;STATUS 1: NOT ENOUGH CORE IN SYSTEM
;STATUS 3: ILLEGAL ARGUMENT
FUNCOR: PUSHJ P,FUNRG2 ;LOCATE SECOND ARGUMENT
SKIPLE T5,0(P1) ;LOAD SIZE OF BLOCK
TLNE T5,-1 ;POSITIVE 18 BIT ADDRESS
JRST FUNST3 ;ILLEGAL ARGUMENT
; (T5) = NUMBER OF WORDS TO ALLOCATE.
SKIPN HLOVL.## ;IS THE OVERLAY FREE CORE LIST SET UP?
JRST FUNST1 ;NO, WE CAN'T GET IT THEN.
MOVEI T1,CORPT.## ;POINT AT THE OVERLAY FREE CORE LIST.
PUSHJ P,CORLST ;TRY TO GET THE CORE.
SKIPA T1,.JBREL## ;CAN'T, GO TRY EXPANDING.
JRST FUNCRD ;GOT IT, RETURN.
MOVEI T4,(T5) ;SAVE THE NUMBER OF WORDS TO GET.
ADDI T5,(T1) ;WHAT THE NEW .JBREL SHOULD BE.
PUSHJ P,XPAND ;GO GET MORE CORE.
MOVEI T5,(T4) ;RESTORE THE NUMBER OF WORDS TO GET.
MOVEI T1,CORPT.## ;POINT AT THE OVERLAY'S FREE CORE LIST.
PUSHJ P,CORLST ;TRY TO GET IT NOW.
JRST FUNST1 ;IF WE CAN'T GET IT NOW WE NEVER CAN.
FUNCRD: PUSHJ P,FUNRG1 ;LOCATE THE FIRST ARG.
MOVEM T4,(P1) ;TELL CALLER WHERE HIS CORE IS.
JRST FUNGAH ;GO CLEAR THE FIRST WORD, AND RETURN
; A STATUS OF ZERO.
SUBTTL GET CORE (FROM A FREE CORE LIST) AT ANY ADDRESS.
COMMENT \***********************
CALL:
PUSHJ P,CORLST
ENTRY CONDITIONS:
(T1) = ADDRESS OF POINTER TO A FREE CORE LIST.
(T5) = NUMBER OF WORDS WANTED
EXIT CONDITIONS:
(T1), (T2), (T3) DESTROYED
(T4) ADDRESS OF WHERE WE GOT THE CORE.
(T5) UNCHANGED
IF THE CORE WAS ALLOCATED, THE RETURN IS TO CALL+2 AND THE
FREE CORE LIST HAS BEEN UPDATED.
IF THE CORE CAN NOT BE ALLOCATED THE RETURN IS TO CALL+1 AND
THE FREE CORE LIST IS UNCHANGED.
************************\
CORLST:
CORLS1: HRRZ T2,(T1) ;GET ADR OF THIS BLOCK OF FREE CORE.
JUMPE T2,CPOPJ ;IF THER ARE NO MORE, LEAVE.
HLRZ T3,(T2) ;GET LAST LOC OF THIS BLOCK OF FREE CORE.
SUBI T3,-1(T2) ;FORM THE LENGTH OF THE BLOCK.
CAIGE T3,(T5) ;IS THIS BLOCK BIG ENOUGH?
SKIPA T1,T2 ;NO, GET PTR TO NEXT.
AOSA (P) ;YES, SET RETURN ADR.
JRST CORLS1 ;GO LOOK AT THE NEXT BLOCK.
;WE FOUND A BLOCK BIG ENOUGH.
;STATE OF THINGS:
; (T1) = ADR OF PTR TO THIS BLOCK
; (T2) = ADR OF THIS BLOCK
; (T3) = SIZE OF THIS BLOCK
; (T4), (T5) HAVE NOT BEEN CHANGED.
HRRZI T4,(T2) ;SET RETURN PARAMETER.
HRL T1,(T2) ;GET ADR OF NEXT BLOCK.
HLRM T1,(T1) ;DELINK THE BLOCK.
CAIN T3,(T5) ;DOES HE WANT THE WHOLE BLOCK?
POPJ P, ;YES, RETURN.
;WE HAVE TO PUT PART OF THE BLOCK BACK ON THE LIST.
ADDI T3,-1(T2) ;FORM ADR OF THE LAST LOC OF THE NEW BLOCK.
ADDI T2,(T5) ;FORM ADR OF THE FIRST LOC OF THE NEW BLOCK.
HRRM T2,(T1) ;LINK THE NEW BLOCK IN THE LIST.
HRLM T3,(T2) ;PUT THE LAST LOC OF THE NEW BLOCK IN IT.
HLRM T1,(T2) ;SET THE LINK TO NEXT.
POPJ P, ;RETURN.
SUBTTL ROUTINE TO INITIALIZE HLOVL.
SETHLO: CAMGE T4,.JBFF## ;DO WE WANT CORE BELOW .JBFF?
JRST SETHL1 ;YES, CAN'T HAVE IT.
HRRI T1,(T4) ;HIGHEST LOCATION IN OVERLAY AREA.
HRLI T1,-1(T4) ;LOWEST LOCATION IN OVERLAY AREA.
MOVEM T1,HLOVL.## ;SET UP HLOVL.
POPJ P, ;RETURN.
SETHL1: POP P,0 ;POP OFF THE RETURN.
JRST FUNST3 ;GIVE AN ILLEGAL ARGUMENT STATUS.
SUBTTL FUNCTION RAD - RETURN CORE AT ADDRESS
;FUNCTION RAD - RETURN CORE AT ADDRESS
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: ADDRESS OF BLOCK TO BE RETURNED
;ARG2: SIZE OF BLOCK TO BE RETURNED
;
;STATUS 0: CORE DEALLOCATED
;STATUS 1: CORE NOT DEALLOCATABLE
;STATUS 3: ILLEGAL ARGUMENT
FUNRAD: MOVE T1,HLOVL.## ;HIGH,,LOW LIMITS.
PUSHJ P,R2ARGS ;GO GET THE ARGS AND CHECK THEM.
JUMPE T0,FUNRAH ;OK, GO TRY TO RETURN THE CORE.
TLNN T4,-1 ;IF THE VALUES AREN'T
TLNE T5,-1 ; REASONABLE,
JRST FUNST1 ;ERROR
;THE CORE ISN'T IN THE OVERLAY AREA, SEE IF IN THE OTS AREA.
MOVE T1,HLOTC.## ;HIGH,,LOW LIMITS.
HLRZ T2,T1
CAIL T4,(T1) ;IF THE START ADDRESS IS BELOW THE
CAILE T5,(T2) ; LOWEST ADDRESS OR THE END ADDRESS IS
JRST FUNST1 ; ABOVE THE HIGHEST ADDRESS, THE ARGS
; ARE BAD, RETURN.
SETZ T0, ;CLEAR THE STATUS.
JRST FUNRTB ;GO TRY TO RETURN THE CORE TO THE OTS LIST.
FUNRAH: MOVEI T1,CORPT.## ;GET THE ADDR OF THE PTR TO THE
; FIRST BLOCK.
PUSHJ P,RADLST ;GO RETURN THE CORE.
JRST FUNST1 ;CAN'T EVEN GIVE IT AWAY - ERROR.
JRST FUNST0 ;ALL IS WELL
SUBTTL RETURN CORE TO A FREE CORE LIST.
COMMENT \***********************
CALL:
PUSHJ P,RADLST
ENTRY CONDITIONS:
(T1) = ADDRESS OF POINTER TO A FREE CORE LIST.
(T4) = ADDRESS OF FIRST LOCATION TO BE RETURNED
(T5) = ADDRESS OF LAST LOCATION TO BE RETURNED
EXIT CONDITIONS:
(T1), (T2), (T3) DESTROYED
(T4), (T5) UNCHANGED
IF THE CORE WAS DEALLOCATED THE RETURN IS TO CALL+2 AND THE
FREE CORE LIST IS UPDATED.
IF THE CORE WAS NOT DEALLOCATED BECAUSE IT (OR PART OF IT
WAS ALREADY ON THE FREE CORE LIST) THE RETURN IS TO CALL+1 AND THE
FREE CORE LIST IS UNCHANGED.
***********************\
RADLST: CAILE T4,(T5) ;IF THE LAST LOCATION IS LOWER
POPJ P, ; THE FIRST LOCATION, RETURN.
RADLS1: HRRZ T2,(T1) ;GET THE ADR OF THIS BLOCK.
JUMPE T2,RADLS5 ;IF ZERO ADD IT AT THE END OF THE LIST.
CAIL T2,(T4) ;DOES IT GO AFTER THE CURRENT BLOCK?
JRST RADLS2 ;NO, GO SEE IF IT GOES AFTER THE
; PRECEEDING BLOCK.
HRRZI T1,(T2) ;MAKE THIS THE PTR TO NEXT.
JRST RADLS1 ;AND LOOP.
;THE BLOCK TO BE ADDED GOES BEFORE THE CURRENT BLOCK.
RADLS2: HLRZ T3,(T1) ;GET THE LAST ADR OF THE PREVIOUS BLOCK.
CAILE T4,(T3) ;IF THE FIRST ADDRESS OF THEBLOCK
CAIL T5,(T2) ; TO BE ADDED IS LESS THAN THE LAST
; ADR OF THE PREVIOUS BLOCK OR
; THE LAST ADDRESS IS GREATER THAN
; THE FIRST ADDRESS OF THE NEXT BLOCK
POPJ P, ; IT IS AN ERROR.
; ..
; ..
;ALL IS WELL. LINK THIS BLOCK IN.
HRRM T4,(T1) ;PREVIOUS POINTS TO THIS.
HRLM T5,(T4) ;SET LAST ADR IN THIS BLOCK.
HRRM T2,(T4) ;SET PTR TO NEXT.
;SEE IF WE CAN COMBINE BLOCKS.
;STATE OF THINGS:
; (T1) = ADR OF PREVIOUS
; (T2) = ADR OF NEXT
; (T4) = ADR OF CURRENT
CAIE T2,1(T5) ;CAN WE MERGE THIS WITH THE NEXT?
JRST RADLS3 ;NO, GO SEE ABOUT THE PREVIOUS.
MOVE T3,(T2) ;LAST LOC,,PTR TO NEXT
MOVEM T3,(T4) ;THEY ARE MERGED.
SETZM (T2) ;KEEP THE CORE CLEAN.
RADLS3: CAIE T4,(T5) ;CLEAN UP THE CORE.
SETZM 1(T4)
CAIG T5,1(T4)
JRST RADLS4
HRLI T3,1(T4)
HRRI T3,2(T4)
BLT T3,(T5)
RADLS4: HLRZ T3,(T1) ;GET ADR OF PREVIOUS BLOCK.
AOS (P) ;UPDATE THE RETURN ADR.
CAIE T4,1(T3) ;CAN WE MERGE WITH THE PREVIOUS BLOCK?
POPJ P, ;NO, RETURN.
MOVE T3,(T4) ;LAST LOC,,PTR TO NEXT
MOVEM T3,(T1) ;THEY ARE MERGED.
SETZM (T4) ;KEEP OUR CORE CLEAN.
POPJ P, ;RETURN.
;COME HERE TO ADD THE BLOCK AT THE END OF THE LIST.
RADLS5: HRLZM T5,(T4) ;LAST ADR OF BLOC,,0
HRRM T4,(T1) ;SET PTR TO THIS BLOCK.
JRST RADLS3 ;GO SEE IF WE CAN MERGE WITH PREVIOUS.
SUBTTL FUNCTION GCH - GET AN I/O CHANNEL
;FUNCTION GCH - GET AN I/O CHANNEL
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: CHANNEL # ALLOCATED
;ARG2: IGNORED
;
;STATUS 0: CHANNEL ALLOCATED
;STATUS 1: NO CHANNELS AVAILABLE
FUNGCH: PUSHJ P,FUNRG1 ;LOCATE ARG1
SKIPN T1,OPNCH.## ;[400] ANY CHANNELS LEFT?
JRST FUNST1 ;NO CHANNELS AVAILABLE
TLZ T1,400000 ;[400] SAVE CHANNEL 0 FOR LAST
JFFO T1,.+1 ;[400] GET CHANNEL NUMBER
MOVSI T1,400000 ;[400] SET BIT TO SHIFT
MOVN T3,T2 ;[400] SET TO SHIFT RIGHT
LSH T1,(T3) ;[400] POSITION BIT
ANDCAM T1,OPNCH.## ;[400] SET CHANNEL AS UNAVAILABLE
HRRZM T2,0(P1) ;[400] STORE CHANNEL #
JRST FUNST0 ;[400] SET RETURN STATUS, SUCCESSFUL AND RETURN
SUBTTL FUNCTION RCH - RETURN AN I/O CHANNEL
;FUNCTION RCH - RETURN AN I/O CHANNEL
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: CHANNEL # TO BE RETURNED
;ARG2: IGNORED
;
;STATUS 0: CHANNEL RETURNED
;STATUS 1: INVALID OR NON-USER CHANNEL
FUNRCH: PUSHJ P,FUNRG1 ;LOCATE ARG1
SKIPL T1,(P1) ;[400] LOAD CHANNEL #
CAILE T1,17 ;MUST BE BETWEEN 0 AND 20
JRST FUNST1 ;CANNOT RETURN
MOVN T1,T1 ;SHIFT TO THE RIGHT
MOVSI T0,(1B0) ;MASK BIT
LSH T0,(T1) ;POSITION THE MASK
ORM T0,OPNCH.## ;MAKES THE CHANNEL AVAILABLE
TDZA T0,T0 ;SET STATUS TO 0
FUNST1: MOVEI T0,1 ;SET STATUS TO 1
POPJ P,
SUBTTL FUNCTION GOT - GET CORE FROM OTS LIST
;FUNCTION GOT - GET CORE FROM OTS LIST
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: ADDRESS OF BLOCK ALLOCATED
;ARG2: SIZE OF BLOCK TO ALLOCATE
;
;STATUS 0: CORE ALLOCATED
;STATUS 1: NOT ENOUGH CORE IN SYSTEM
;STATUS 2: CAN NOT ALLOCATE AT SPECIFIED ADDRESS
;STATUS 3: ILLEGAL ARGUMENT
FUNGOT: PUSHJ P,FUNRG2 ;PICK UP THE SECOND ARG.
SKIPLE T5,(P1) ;IF IT IS LESS THAN 1 OR IT IS
TLNE T5,-1 ; TOO BIG,
JRST FUNST3 ; COMPLAIN.
HRRZI T1,OTCPT.## ;POINT AT THE OTS FREE CORE LIST.
PUSHJ P,CORLST ;GO TRY TO GET THE CORE.
CAIA ;CAN'T, TRY EXPANDING.
JRST FUNCRD ;GOT IT, GO RETURN ITS ADDR AND RETURN.
PUSHJ P,MORMEM ;FIT REQUEST INTO AVAILABLE MEMORY
JRST FUNST1 ; NO MORE ROOM
JRST FUNST2 ; NO ROOM UNDER OVERLAY AREA
JRST FUNGOT ; GOT IT--RESTART THE PROCESS
;FUNCTION PAG - GET CORE FROM OTS LIST ON A PAGE BOUNDARY
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: ADDRESS OF BLOCK ALLOCATED
;ARG2: SIZE OF BLOCK TO ALLOCATE
;
;STATUS 0: CORE ALLOCATED
;STATUS 1: NOT ENOUGH CORE IN SYSTEM
;STATUS 3: ILLEGAL ARGUMENT
FUNPAG: PUSHJ P,FUNRG2 ;LOCATE SECOND ARGUMENT
SKIPG T5,0(P1) ;LOAD SIZE OF BLOCK.
JRST FUNST3 ;0 LENGTH.
ADDI T5,777 ;[DSB-4]GET MORE AND THEN PAGE ALIGN
TLNE T5,-1 ;[DSB-4] TOO BIG.
JRST FUNST3 ;ILLEGAL ARGUMENT
; (T5) = NUMBER OF WORDS TO ALLOCATE.
HRRZI T1,OTCPT. ;POINT AT THE OTS FREE CORE LIST.
PUSHJ P,CORLST ;GO TRY TO GET THE CORE.
SKIPA ;[DSB-4]CAN'T, TRY EXPANDING.
JRST FUNP50 ;GOT THE MEMORY--MAKE IT PAGE ALIGNED.
PUSHJ P,MORMEM ;[DSB-4]NOT ENOUGH MEMORY--GET SOME MORE
JRST FUNST1 ; NOT ENOUGH
JRST FUNST2 ; NOT ENOUGH ON OTS LIST BEFORE OVERLAY
JRST FUNPAG ;GOT IT--RESTART.
FUNP50: ;HAVE THE MEMORY--TRIM TO PAGE BOUNDRY
SUBI T5,777 ;SIZE AFTER TRIMMING
PUSH P,T5 ; THIS IS THE PROPER ALLOCATION AMOUNT..
PUSH P,T4 ;SAVE ADDRESS OF ALLOCATED MEMORY.
PUSH P,[0] ;SAVE AMOUNT OF ANTERIOR TRIM.
TRZN T4,777 ;IF ON A PAGE BOUNDRY
JRST FUNP60 ; THEN NO NEED TO TRIM LOWER BOUND
MOVEI T3,1000(T4) ;GET PAGE BOUNDRY WITHIN ALLOCATED RANGE
POP P,T2 ;RESTORE GUESSED AMOUNT OF FRONTAL TRIM
POP P,T4 ; AND THE ALLOCATED MEMORY ADDRESS.
PUSH P,T3 ;SAVE INSTEAD THE PAGE ALIGNED ADDRESS.
MOVEI T5,-1(T3) ;LAST ADDRESS TO TRIM.
SUBI T3,(T4) ;DETERMINE HOW MUCH TO TRIM OFF FRONTAL.
PUSH P,T3 ;AND SAVE TRIM AMOUNT.
PUSHJ P,RADLST ;RESTORE THIS AREA (T4)-(T5) TO FREE LIST.
JRST [POP P,0 ;IF WE CAN'T--TROUBLE
POP P,0
POP P,0
JRST FUNST1]
; ..
; ..
FUNP60:
POP P,T3 ;RESTORE AMOUNT TRIMED OFF.
MOVEI T2,777 ;GREATEST AMOUNT OF TRIM
SUBI T2,(T3) ;AMOUNT LEFT TO TRIM OFF POSTERIOR.
JUMPE T2,FUNP70 ;NONE TO TRIM.
MOVE T4,(P) ;ADDRESS OF REGION ALLOCATED.
MOVE T5,-1(P) ;ACTUAL AMOUNT ALLOCATED.
ADDI T4,(T5) ;ADDRESS TO START TRIM.
MOVEI T5,(T4)
ADDI T5,-1(T2) ;LAST ADDRESS TO TRIM.
PUSHJ P,RADLST ;FREE THIS MEMORY
JRST [POP P,0 ;IF FAILS--THEN TROUBLE
POP P,0
JRST FUNST1]
FUNP70:
POP P,T4 ;ADDRESS OF PAGE ALIGNED MEMORY
POP P,T5 ;SIZE OF MEMORY
JRST FUNCRD ;WE ARE DONE
SUBTTL FUNCTIONS ROT & RPG - RETURN CORE TO OTS LIST
;FUNCTION ROT - RETURN CORE TO OTS LIST
;FUNCTION RPG - RETURN CORE TO OTS LIST ON PAGE BOUNDARY
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: ADDRESS OF BLOCK TO BE RETURNED
;ARG2: SIZE OF BLOCK TO BE RETURNED
;
;STATUS 0: CORE DEALLOCATED
;STATUS 1: CORE NOT DEALLOCATABLE
;STATUS 3: ILLEGAL ARGUMENT
FUNRPG:
FUNROT: MOVE T1,HLOTC.## ;HIGH,,LOW LIMITS.
PUSHJ P,R2ARGS ;GO GET THE ARGS AND CHECK THEM.
JUMPN T0,FUNRAD ;IT ISN'T IN THE OTS LIST, GO SEE IF
; IT'S IN THE OVERLAY LIST.
; (T4) = ADDRESS OF FIRST LOCATION TO RETURN.
; (T5) = ADDRESS OF LAST LOCATION TO RETURN.
FUNRTB: MOVEI T1,OTCPT.## ;POINT AT THE LIST.
PUSHJ P,RADLST ;RETURN THE CORE.
JRST FUNST1 ;CAN'T, COMPLAIN.
;DETERMINE IF WE CAN RESET .JBFF (MAY BE IMPORTANT FOR OVERLAYS)
MOVEI T1,OTCPT.## ;ADDRESS OF FREE CORE LIST
HRRZ T2,(T1) ;ADDRESS OF FIRST FREE BLOCK.
JUMPE T2,FUNRTL ;JUMP IF NO FREE MEMORY.
FUNRTD: HRRZ T3,(T2) ;GET ADDR OF FOLLOWING BLOCK.
JUMPE T3,FUNRTH ;THIS IS THE ONE TO RETURN.
MOVEI T1,(T2) ;(T1)=PTR TO BLOCK N.
MOVEI T2,(T3) ;(T2)=PTR TO BLOCK N+1.
JRST FUNRTD ;GO LOOK FOR BLOCK N+2.
FUNRTH: ;T1 POINTS TO PREVIOUS BLOCK.
;T2 POINTS TO CURRENT BLOCK.
HLRZ T5,(T2) ;GET LAST ADDRESS IN CURRENT BLOCK.
HRRZ T3,.JBFF ; AND ADDRESS OF FIRST FREE LOCATION.
CAIE T3,1(T5) ;IF THESE ARE NOT CONSECUTIVE
POPJ P, ; THEN WE CANNOT CUT BACK .JBFF.
MOVEI T4,-1(T2) ;GET HIGHEST MEMORY ADDRESS ALLOCATED.
HRRM T2,.JBFF## ;THE NEW .JBFF
HRLM T4,HLOTC.## ;THE NEW UPPER LIMIT.
HLLZS (T1) ;ZERO THE LINK.
FUNRTL: MOVE T1,HLOTC.## ;GET THE HIGH AND LOW LIMITS.
HLRZ T2,T1
CAIL T2,(T1) ;IF THE HIGH LIMIT IS ABOVE
POPJ P, ; THE LOW LIMIT, RETURN.
SETZM HLOTC.## ;CLEAR THE LIMITS AND THE
SETZM OTCPT.## ; POINTER.
POPJ P, ;RETURN
SUBTTL FUNCTION RNT - RETURN INITIAL RUNTIME FROM OTS
;FUNCTION RNT - RETURN INITIAL RUNTIME FROM OTS
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: RUNTIME FROM OTS
;ARG2: IGNORED
;
;STATUS 0: RUNTIME RETURNED
;STATUS 1: RUNTIME NOT AVAILABLE
FUNRNT: PUSHJ P,FUNRG1 ;LOCATE FIRST ARG
MOVE T1,RUN.TM## ;GET RUNTIME FROM OTS
MOVEM T1,(P1) ;STORE
JRST FUNST0 ;RETURN OK
SUBTTL FUNCTION IFS - RETURN INITIAL DEV:FILE[PPN] FROM OTS
;FUNCTION IFS - RETURN INITIAL DEV:FILE[PPN] FROM OTS
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: DEV:
;ARG2: FILE NAME
;ARG3: [PPN] OR <0,,PATH POINTER>
;
;STATUS 0: INITIAL FILE SPEC RETURNED
;STATUS 1: INITIAL FILE SPEC NOT AVAILABLE
FUNIFS: PUSHJ P,FUNRG1 ;LOCATE FIRST ARG
SKIPN T1,RN.DEV## ;GET DEVICE
MOVSI T1,'DSK' ;ASSUME DSK
MOVEM T1,(P1) ;STORE
PUSHJ P,FUNRG2 ;LOCATE SECOND ARG
MOVE T1,RN.NAM## ;GET NAME
JUMPN T1,.+4 ;OK
HRROI T1,3 ;TRY GETTAB
GETTAB T1, ;IF NOT IN ACCS
JRST FUNST1 ;GIVE ERROR RETURN
MOVEM T1,(P1) ;STORE
MOVEI P1,FN.RG3 ;LOCATE THIRD ARG
PUSHJ P,FUNADR
MOVE T1,RN.PPN## ;GET PPN
MOVEM T1,(P1) ;STORE
JRST FUNST0 ;RETURN OK
SUBTTL FUNCTION CBC - CUT BACK CORE
;FUNCTION CBC - CUT BACK CORE
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1: IGNORED
;ARG2: IGNORED
;
;STATUS 0: ALWAYS
FUNCBC: ;[M1002]
SKIPN HLOVL.## ;[1002] ARE OVERLAYS IN USE?
;[D1102] SKIPN CORPT.## ;[514] ANY MORE CORE IN THE OVERLAY LIST?
JRST TRYOTS ;[514] NO--TRY IN THE OTS LIST THEN
SKIPN CORPT. ;[1025] IS THERE ANY FREE CORE?
JRST FUNST0 ;[1025] NO
MOVEI T1,CORPT.## ;[514] YES--GET OVERLAY LIST HEAD ADDR,
MOVEI T4,HLOVL.## ;[514] LIMITS OF OVERLAY AREA
JRST FUNCB1 ;[514] AND GO FIND LAST BLOCK IN LIST
TRYOTS: MOVE T1,.JBFF ;[652] LOAD HIGHEST ADDRESS IN USE INCASE NO LIST
MOVEI T4,HLOTC.## ;[514] GET LIMITS OF OTS AREA POINTER
SKIPN OTCPT.## ;[514] ANY CORE IN THE OTS LIST?
JRST FUNCB5 ;[652] [514] NO, DELETE ANY PAGES ABOVE .JBFF
MOVEI T1,OTCPT.## ;[514] YES--GET OTS LIST HEAD ADDR,
; JRST FUNCB1 ;[514] AND GO FIND LAST BLOCK IN LIST
FUNCB1: HRRZ T2,(T1) ;[514] GET ADDR OF FIRST BLOCK IN LIST
HRRZ T3,(T2) ;[514] GET ADDR OF FOLLOWING BLOCK (IF ANY)
JUMPE T3,FUNCB2 ;[514] NO MORE--T2 HAS ADDR OF LAST BLOCK
MOVEI T1,(T2) ;[514] (T1) = POINTER TO BLOCK N
MOVEI T2,(T3) ;[514] (T2) = POINTER TO BLOCK N+1
JRST .-4 ;[514] LOOP 'TIL WE FIND LAST BLOCK
;HERE WHEN WE FIND THE LAST BLOCK. ACS:
; (T1) = ADDR OF POINTER TO LAST BLOCK. POINTER GETS ZEROED LATER.
; (T2) = ADDR OF LAST BLOCK. UNLINK IT AND TRY TO GIVE ITS CORE BACK TO MONITOR.
; (T4) = ADDR OF HL???. WORD.
FUNCB2: HLRZ T3,(T2) ;[514] GET ADDR OF LAST WORD IN BLOCK
HLRZ T5,(T4) ;[514] GET HIGHEST ADDR WE'RE MANAGING
CAIE T3,(T5) ;[514] IF NOT THE SAME THEN
JRST FUNST0 ;[514] SOMEONE'S ABOVE US, SO CAN'T SHRINK
MOVEI T3,-1(T2) ;[514] SAME--GET ADDR OF LAST WORD TO KEEP
HRLM T3,(T4) ;[514] MAKE THAT THE HIGHEST ADDR WE'RE MANAGING
HLLZS (T1) ;[514] UNLINK LAST BLOCK AS PRELUDE TO SHRINKING
; JRST FUNCB3 ;[514] NOW GO TRY TO SHRINK
;HERE WHEN WE'RE READY TO TRY TO SHRINK. IF ENTIRE MANAGED AREA WENT AWAY, WE
;MIGHT BE ABLE TO SQUEEZE OUT SOME MORE CORE. BUT IF A SORT IS IN PROGRESS, JUST
;UPDATE ALL RELEVENT POINTERS AND DON'T RETURN THE CORE. ACS:
; (T4) = ADDR OF HL???. BLOCK.
FUNCB3: HLRZ T1,(T4) ;[514] GET HIGHEST ADDR WE'RE MANAGING
HRRZ T2,(T4) ;[514] GET LOWEST ADDR WE'RE MANAGING
CAIL T1,(T2) ;[514] HIGHEST .LT. LOWEST?
JRST FUNCB4 ;[514] NO--JUST FREE TO ADDR IN T1
SETZM (T4) ;[514] YES--WE JUST EMPTIED AN ENTIRE AREA
CAIE T4,HLOVL.## ;[514] ARE WE WORKING IN THE OVERLAY AREA?
JRST FUNCB4 ;[514] NO--JUST FREE TO ADDR IN T1
HRRZ T1,.JBFF## ;[514] YES--FREE ONLY TO C(.JBFF)-1
SUBI T1,1 ;[514] ..
FUNCB4: CAIE T4,HLOTC.## ;[514] ARE WE WORKING IN THE OTS AREA?
JRST FUNCB5 ;[514] NO--WE ARE ALL SET TO SHRINK
HRRZM T1,.JBFF## ;[514] YES--FIX UP NEW .JBFF
AOS .JBFF## ;[514] BUT MAKE SURE IT'S FIRST-FREE STYLE
;[514] GO FREE SOME CORE
FUNCB5:
IFE TOPS20,<
;HERE AT LAST TO RETURN SOME CORE TO THE MONITOR. IF PAGING EXISTS (PAGE. UUO),
;THEN KILL THE PAGES OFF MANUALLY TO PRESERVE ANY 'FLOATING' LOW SEGMENT PAGES.
;OTHERWISE JUST USE A GOOD OLD CORE UUO. ACS:
; (T1) = ADDR OF LAST WORD WE WANT TO KEEP. C(.JBREL) IS END OF AREA WE WILL RETURN.
HRLZI T2,.PAGCA ;[514] SIMPLE FUNCTION TO TEST WHETHER
PAGE. T2, ;[514] PAGE. UUO EXISTS HERE
JRST FUNCB8 ;[514] DOESN'T--GO USE CORE UUO
LSH T1,-^D9 ;[514] DOES--TURN ADDR INTO ITS PAGE NUMBER
ADD T1,[PA.GAF!1] ;[514] SET DESTROY FUNC AND DON'T KILL THIS PAGE
HRRZ T2,.JBREL## ;[514] GET LAST PAGE TO KILL
LSH T2,-^D9 ;[514] ..
FUNCB9: MOVSI T3,-17 ;[514] -<<LENGTH OF PAGTBL>-1>
FUNCB6: CAIGE T2,(T1) ;[514] SCANNED ALL PAGES YET?
JRST FUNCB7 ;[514] YES--GO PROCESS LAST PARTIAL BLOCK
MOVEM T1,PAGTBL##+1(T3) ;[514] NO--STORE NEXT PAGE NUMBER IN BLOCK
ADDI T1,1 ;[514] ADVANCE TO NEXT PAGE
AOBJN T3,FUNCB6 ;[514] LOOP 'TIL BLOCK FILLS UP
HRRZM T3,PAGTBL## ;[514] BLOCK FULL--PROCESS IT
MOVE T4,[.PAGCD,,PAGTBL##] ;[514] ..
PAGE. T4, ;[514] ..
TRN ;[514] WE TRIED
JRST FUNCB9 ;[514] GO FILL BLOCK AGAIN
;WE MAY HAVE A PARTIAL BLOCK OF PAGE-DESTROY REQUESTS TO FINISH.
FUNCB7: TRNN T3,-1 ;[514] ANYTHING LEFT OVER IN BLOCK?
JRST FUNST0 ;[514] NO--ALL DONE
HRRZM T3,PAGTBL## ;[514] PROCESS THE LEFT-OVERS
MOVE T4,[.PAGCD,,PAGTBL##] ;[514] ..
PAGE. T4, ;[514] ..
TRN ;[514] WE TRIED
JRST FUNST0 ;[514] ALL DONE
FUNCB8:
>;END IFE TOPS20
;DON'T HAVE PAGE. UUO--USE CORE UUO.
CORE T1, ;[514] SHRINK
TRN ;[514] WE TRIED
JRST FUNST0 ;[514] ALL DONE
SUBTTL FUNCTIONS RRS/WRS -- MANIPULATE RETAIN/FREE STATUS
;CALL: MOVEI 16,[ARGBLK]
; PUSHJ 17,FUNCT.
;
;ARG1(RRS): INPUT IGNORED, OUTPUT=# OF RECS RETAINED BY OTS
;ARG2(RRS): IGNORED
;
;ARG1(WRS): # OF RESOURCES RETAINED BY DBMS
;ARG2(WRS): IGNORED
;
;STATUS: 0 ALWAYS
FUNRRS:
PUSHJ P,FUNRG1 ;LOCATE 1ST ARG
MOVE T1,SU.RR## ;SET BY LSU
MOVEM T1,0(P1) ;RETURN IT TO CALLER
JRST FUNST0 ;ALWAYS RETURN SUCCESS
FUNWRS:
PUSHJ P,FUNRG1
MOVE T1,0(P1) ;THIS TIME, SET THE LIBOL VAR
MOVEM T1,SU.DBR## ;I.E. DATA BASE RETAINS
JRST FUNST0
SUBTTL USEFUL FUNCTIONS
;.SAVE -- SUBROUTINE TO SAVE ALL USED ACCS EXCEPT T0 AND T1
;CALL: PUSHJ P,.SAVE
;RETURN POPJ RESTORES ALL ACCS SAVED
.SAVE: EXCH T2,(P) ;SAVE T2, GET CALLER PC
PUSH P,T3 ;SAVE T3
PUSH P,T4 ;SAVE T4
PUSH P,T5 ;SAVE T5
PUSH P,P1 ;SAVE P1
PUSH P,.+3 ;SAVE RETURN POINT
HRLI T2,-4(P) ;GET ADDRESS WHERE T2 IS SAVED
JRA T2,(T2) ;RETURN, RESTORING T2
CAI . ;JUST RETURN
POP P,P1 ;RESTORE P1
POP P,T5 ;RESTORE T5
POP P,T4 ;RESTORE T4
POP P,T3 ;RESTORE T3
POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
SUBTTL MORMEM -- OTS MEMORY EXPANSION ROUTINE
COMMENT /*************************
FUNCTION:
WHEN THERE IS NOT ENOUGH MEMORY ON THE OTS FREE LIST,
THIS ROUTINE IS CALLED TO ACQUIRE THE MEMORY BY ADJUSTING
.JBFF AND .JBREL. ONCE ACQUIRED, THE FREE MEMORY IS
PUT ONTO THE FREE LIST (VIA A CALL TO RADLST) AND THUS
A SUCCESSFUL EXECUTION OF THIS ROUTINE SHOULD BE FOLLOWED
BY SETTING UP THE ARGUMENTS FOR AND CALLING CORLST.
THIS ROUTINES CHECKS FOR THE OVERLAY BOUNDRY AND WILL
NOT ALLOW MEMORY TO BE ALLOCATED ABOVE IT.
CALL:
PUSHJ P,MORMEM
ENTRY CONDITIONS:
(T5) = SIZE OF AREA WANTED
EXIT CONDITIONS:
(T1) (T2) (T3) DESTROYED
(T4) (T5) DESTROYED
RETURNS:
CALL +1 NOT ENOUGH MEMORY AVAILABLE
CALL +2 BAD ERROR -- COULD NOT RELEASE NEW MEMORY
CALL +3 MEMORY ACQUIRED AND PUT ON OTS FREE LIST,
IT IS APPROPRIATE TO RESTART THE
ENTIRE PROCESS (CALLING CORLST)
**********************/
MORMEM: ; MEMORY NOT AVAILABLE ON CORLIST--ADD MORE TO IT
HRRZ T4,.JBFF ;FIRST FREE LOCATION AVAILABLE
MOVEI T3,(T4) ;PLACE 'WORKING' VALUE HERE
ADDI T3,(T5) ;COMPUTE NEXT FREE STARTING AREA
SKIPE T2,HLOVL.## ;IF OVERLAY AREA ESTABLISHED
CAIL T3,(T2) ; AND THIS TAKES SOME OF SPACE
JUMPN T2,CPOPJ1 ; THEN GIVE ERROR RETURN
MOVEI T5,-1(T3) ;COMPUTE LAST LOCATION DESIRED
CAMG T5,.JBREL ;IF WE CAN PROVIDE THIS
JRST MORM50 ; THEN DO NOT EXPAND FURTHER
MOVEI T1,(T5) ; ELSE SAVE ENDING VALUE AND
CORE T1, ; TRY A GET SOME MORE MEMORY.
POPJ P, ;COULD NOT GET MEMORY -- ERROR RETURN
MORM50:
SKIPN HLOTC.## ;IF CORE TABLE NOT SET UP YET
HRRM T4,HLOTC.## ; THEN LOWER BOUND IS CURRENT (.JBFF)
HRLM T5,HLOTC.## ;UPPER BOUND IS NEW VALUE.
HRRM T3,.JBFF ;NEW FIRST FREE LOCATION.
MOVEI T1,OTCPT.## ;SET UP THE ADDRESS OF THE FREE LIST
PUSHJ P,RADLST ; AND FREE THIS MEMORY.
JRST CPOPJ1 ;COULD NOT FREE IT --THIS IS REAL TROUBLE.
AOS (P) ;DO DOUBLE SKIP WHEN OK.
CPOPJ1: AOS (P) ; DO SINGLE SKIP WHEN INTO OVERLAY AREA.
CPOPJ: POPJ P,
SUBTTL XPAND - CORE ROUTINE
COMMENT \*************************
CALL:
PUSHJ P,XPAND
ENTRY CONDITIONS:
(T5) = ADDRESS OF HIGHEST LOCATION WANTED.
EXIT CONDITIONS:
(T1), (T2), (T3) DESTROYED
(T4), (T5) UNCHANGED
IF WE GOT THE CORE IT IS NOW LINKED INTO THE FREE CORE LIST
AND WE RETURN TO CALL+1.
IF WE DIDN'T GET THE CORE WE RETURN TO FUNST1.
***********************\
XPAND: PUSH P,T4 ;SAVE T4
PUSH P,T5 ; AND T5.
;ASK FOR MORE CORE.
MOVE T4,.JBREL## ;GET THE CURRENT END OF CORE.
CAIL T4,(T5) ;DO WE REALLY NEED TO ASK?
JRST XPAND3 ;NO, THEN DON'T.
CORE T5, ;ASK FOR IT.
JRST XPAND4 ;HE WON'T GIVE IT TO US.
;WE GOT THE CORE.
HLRZ T4,HLOVL.## ;END OF WHAT WE HAD.
MOVEI T4,1(T4) ;START OF WHAT WE GOT.
MOVE T5,(P) ;END OF WHAT WE GOT.
XPAND1: HRRZI T1,CORPT.## ;GET THE POINTER TO THE FREE CORE LIST.
PUSHJ P,RADLST ;GO LINK IT IN THE FREE CORE LIST.
JRST XPAND4 ;CAN'T. OH BOY, ARE WE IN TROUBLE.
HRLM T5,HLOVL.## ;ADJUST HLOVL. TO POINT AT THE NEW END
; OF FREE CORE.
POP P,T5 ;RESTORE T5 AND
POP P,T4 ; T4.
POPJ P, ;RETURN.
;COME HERE IF THE CORE IS ALREADY THERE BUT NOT IN THE OVERLAY AREA.
XPAND3: MOVEI T5,(T4) ;LAST LOC.
HLRZ T4,HLOVL.## ;FIRST LOC LESS 1.
AOJA T4,XPAND1 ;GO LINK IT IN.
;COME HERE IF WE CAN'T GET THE CORE.
XPAND4: POP P,T5 ;RESTORE T5 AND
POP P,T4 ; T4.
POP P,T3 ;GET RID OF THE RETURN ADR.
JRST FUNST1 ;RETURN AN ERROR STATUS.
SUBTTL ROUTINES TO SET UP AND CHECK ARGS FOR GET AND RETURN CORE ROUTINES.
COMMENT \************************
CALL:
PUSHJ P,G2ARGS
ENTRY CONDITIONS:
NONE.
EXIT CONDITIONS:
(T0) = STATUS.
(T1), (T2), (T3) UNCHANGED
(T4) = ADDRESS OF FIRST LOCATION WANTED.
(T5) = ADDRESS OF LAST LOCATION WANTED.
RETURN IS ALWAYS TO CALL+1.
***********************\
G2ARGS: SETZI T0, ;CLEAR THE STATUS.
PUSHJ P,FUNRG1 ;LOCATE FIRST ARGUMENT
SKIPLE T4,0(P1) ;LOAD ADDRESS WANTED
TLNE T4,-1 ;POSITIVE 18 BITS ADDRESS
JRST FUNST3 ;ILLEGAL ARGUMENT
PUSHJ P,FUNRG2 ;LOCATE SECOND ARGUMENT
MOVM T5,0(P1) ;LOAD SIZE WANTED - MAY BE NEGATIVE
; BECAUSE OF THE FORTRAN HACK.
MOVEM T5,0(P1) ;TELL THE CALLER HOW MUCH YOU ARE
; GOING TO GIVE HIM.
ADDI T5,-1(T4) ;COMPUTE LAST BLOCK ADR
TLNE T5,-1 ;GREATER THAN 256 K
JRST FUNST3 ;ILLEGAL ARGUMENT
POPJ P, ;RETURN.
COMMENT \************************
CALL:
PUSHJ P,R2ARGS
ENTRY CONDITIONS:
(T1) = UPPER LIMIT,,LOWER LIMIT
EXIT CONDITIONS:
(T0) = STATUS
(T1) DESTROYED
(T2), (T3) UNCHANGED
(T4) = ADDRESS OF FIRST LOCATION TO BE RETURNED.
(T5) = ADDRESS OF LAST LOCATION TO BE RETURNED.
RETURN IS ALWAYS TO CALL+1.
***********************\
R2ARGS: SETZI T0, ;CLEAR THE STATUS.
PUSHJ P,FUNRG1 ;LOCATE FIRST ARGUMENT
SKIPLE T4,0(P1) ;LOAD CORE ADR
TLNN T4,-1 ;POSITIVE 18 BIT ADDRESS
CAIGE T4,(T1) ;LEAGAL ADDRESS
MOVEI T0,3 ;ILLEGAL ARGUMENT
PUSHJ P,FUNRG2 ;LOCATE SECOND ARGUMENT
SKIPLE T5,0(P1) ;LOAD CORE SIZE
TLNE T5,-1 ;POSITIVE 18 BIT ADDRESS
JRST FUNST3 ;ILLEGAL ARGUMENT
HLRZ T1,T1 ;LOAD LAST LEGAL ADR
ADDI T5,-1(T4) ;COMPUTE LAST ADR IN BLOCK
TLNN T5,-1 ;POSITIVE 18 BIT ADDRESS
CAILE T5,0(T1) ;LEGAL ADDRESS
JRST FUNST3 ;ILLEGAL ARGUMENT
IFN TOPS20,< ;DELETE THE PAGE IF WHOLE PAGE BEING RETURNED
TRNE T4,777 ;SKIP IF STARTS AT PAGE BOUNDARY
POPJ P, ;NO, JUST RETURN
TRC T5,777 ;SEE IF ENDS AT PAGE BOUNDARY
TRCE T5,777
POPJ P, ;NO, JUST RETURN
PUSH P,1 ;SAVE ACS USED BY PMAP
PUSH P,2
PUSH P,3
SETO 1, ;-1 TO REMOVE PAGES
MOVE 2,T4 ;GET STARTING ADDRESS
LSH 2,-^D9 ;FIND STARTING PAGE NUMBER
HRLI 2,.FHSLF ;PROCESS HANDLE
MOVE 3,0(P1) ;GET SIZE TO RETURN
LSH 3,-^D9 ;CONVERT TO # OF PAGES
TXO 3,PM%CNT ;SPECIFY REPEAT COUNT
PMAP% ;REMOVE THE PAGES..
ERJMP .+1 ;IGNORE ERRORS
POP P,3 ;RESTORE ACS USED BY PMAP
POP P,2
POP P,1
>;END IFN TOPS20
POPJ P, ;RETURN.
SUBTTL ARGBLK MANIPULATION ROUTINES
;FUNADR - RETURN ADR OF ARGUMENT
;CALL: MOVEI P1,OFFSET IN ARGBLK
; PUSHJ P,FUNADR
; (RETURN)
;
; RETURN ADR IN P1
;
FUNRG2: SKIPA P1,FUNAD1 ;LOAD ARG2 OFFSET
FUNRG1: MOVEI P1,FN.RG1 ;LOAD ARG1 OFFSET
FUNADR: ADDI P1,(L) ;OFFSET ARGBLK
MOVE P1,@P1 ;GET ADDRESS
FUNAD1: POPJ P,FN.RG2 ;RETURN
SUBTTL ROUTINES TO SET THE STATUS AND RETURN.
FUNST0: TDZA T0,T0 ;SET STATUS 0
FUNST2: MOVEI T0,2 ;SET STATUS 2
POPJ P, ;RETURN
FUNST3: MOVEI T0,3 ;SET STATUS 3
POPJ P, ;RETURN
END