IDENT ALOCBLK ERR VV HAS IT 5/25/71 * * ECS ACTIONS CONTAINED IN THIS CODE * NEWUN CHANGE THE UNIQUE NAME OF AN OBJECT * CCCLOA CREATE CAPABILITY FOR NTH OBJECT ON AB * DSPAB DISPLAY ALLOCATION BLOCK * DELAB DELETE ALLOCATION BLOCK * DONAT MOVE ECS SPACE BETWEEN ALLOCATION BLOCKS * MOVCP MOVE CP TIME BETWEEN ALLOCATION BLOCKS * MOVMT MOVE MOT SLOTS BETWEEN ALLOCATION BLOCKS * DSPOB DISPLAY OBJECT IN ECS * DSPAL DISPLAY ALLOCATOR CONSTANTS * INCHR INCREMENT CHARGE RATE FOR ECS SPACE * INMTR INCREMENT DISCONT ECS CHARGE METER * GRAB STEAL ECS SPACE FROM AN AB * CRALB CREATE AN ALLOCATION BLOCK * * EXTERNAL SUBROUTINES CONTAINED HEREIN * MAKEOBJ MAKES ALL PROPER ECS OBJECTS IN ECS * MKOBJ SLIGHTLY DIFFERENT VERSION OF MAKEOBJ * DELOBJ DLELTES OBJECTS FROM ECS * RTRNFIL DELETES FILE POINTER AND DATA BLOCKS FROM ECS * FUNDX7 CHARGES AN AB FOR FILE POINTER AND DATA BLOCKS * ALLOC FINDS SPACE IN ECS FOR OBJECTS * REALLOC CHANGES SIZE OF ECS OBJECTS * FREE RELEASES ECS SPACE OCCUPIED BY AN OBJECT * COMPACT COMPACTS ECS * OBJSIZ DELIVERS OBJECT SIZE OF ECS OBJECT * BKPTR DELIVERS BACKPOINTER FROM ECS OBJECT * CHGPTR DELIVERS BACKPOINTER FROM ECS OBJECT AND * INSERTS NEW BACKPOINTER * * INTERNAL SUBROUTINES HEREIN * ABREAD READS AN AB INTO CM, CHECKING UNIQUE NAME * CHARG UPDATES CHARGE METERS OF AN AB IN CM * FATSON READS TWO ABS AND CHECKS THAT ONE IS THE * FATHER OF THE OTHER * RELAT READS TWO ABS AND CHECKS THAT A THIRD IS * THEIR COMMON ANCESTOR * TITLE ALLOCATION MECHANISM EXT DISASTR,EC.FINF,EC.ABPC,E.ERROR EC.FINFO EQU EC.FINF . DAMN 7-CHARACTER EXTERNALS EC.ABPCK EQU EC.ABPC . DAMN 7-CHARACTER EXTERNALS EXT S.MOTER,S.UNERR ECSMAC XTEXT PROCSYM XTEXT INTSYS XTEXT CBLOCK MICRO 1,,*/ALLOC/* ENTRY IP.AWDS,IP.DAEC,GT.PTRB,GT.NRMB LIST X ALOCSYM XTEXT TYPES XTEXT LIST -X TITLE CONTROL MACROS * * THESE MACROS ARE USED TO INDICATE WHERE CERTAIN * LOCKOUTS MAY BE NEEDED IN THE FUTURE. * THE ADDRESS INDICATES THE FUNCTION OF THE LOCKOUT- * * ALLOCBLK WILL PREVENT ANOTHER CPU FROM USING * ANY ALLOCATION BLOCKS OR THE EC.ABPCK * INFORMATION * * FCHAIN WILL PREVENT ANOTHER CPU FROM USING THE * FREE SPACE INFO (EC.APACK) * RESERVE MACRO ENDM DUMMY MACRO RELEASE MACRO ENDM RECS MACRO A RE A RJ =XE.ECS RECS ENDM WECS MACRO A WE A RJ =XE.ECS WECS ENDM * * THIS MACRO WAS KLUDGED IN TO DO ARITHMETIC ON 30-BIT * +OR- FIELDS WHEN I STUPIDLY AGREED TO CHANGE THE DISCIPLINE * ON THE IN USE FIELDS FOR DAVE * * EXAMPLE: * INCUSE F,D,S,ER1,ER2 * F = NUMBER OF X REG CONTAINING INITIAL RESERVED, IN USE * D = NUMBER OF X REG CONTAINING INCREMENT, +OR- 60 BITS * S = NUMBER OF X REG TO BE USED FOR SCRATCH * ER1 IS A LABEL WHERE CONTROL WILL RETURN IF NEW IN USE * WOULD EXCEED RESERVED, X6 = -EXCESS * ER2 IS A LABEL WHERE CONTROL WILL RETURN IF THE NEW IN USE * FIELD WOULD BE OUT OF BOUNDS * X6 CONTAINS NEW RESERVED, IN USE AT END OF MACRO * INCUSE MACRO F,D,S,ER1,ER2 MX_S 30 BX6 -X_S*X_F LX6 30 AX6 30 AX_F 30 IX6 X6+X_D IX_S X_F-X6 NG X_S,ER1 BX_S X6 AX_S IP.SLIM NZ X_S,ER2 MX_S 30 BX6 -X_S*X6 LX_F 30 BX_F X_S*X_F BX6 X6+X_F INCUSE ENDM TITLE TEMPORARY STORAGE AND DISPLAY STUFF * * THIS PSEUDO-TEMPORARY STORAGE AND DISPLAY AREA IS * NOT A HAPPY ARRANGEMENT, BUT IT WILL HAVE TO DO FOR * THE MOMENT * ENTRY L.SPACE,L.SLOP,L.NFBLK,L.NBLKS,L.BADMP,L.COMPC ENTRY L.CLAST,L.CTOTL FINFO BSS FS.SIZE . CM SPACE FOR FRE INFO * * THESE FOUR NUMBERS ARE DISPLAYED ON THE M SCREEN * L.SPACE EQU FINFO+FS.SPACE L.SLOP EQU FINFO+FS.SLOP L.NFBLK EQU FINFO+FS.NFBLK L.NBLKS EQU FINFO+FS.NBLKS COMPTMP BSSZ 3 . SPACE FOR COMPACTOR STUFF L.BADMP EQU COMPTMP+1 . BAD MAP COUNT FOR DISPLAY L.COMPC EQU COMPTMP+2 . COMPACTION COUNT FOR DISPLAY L.CLAST BSSZ 1 . TIME OF LAST COMPACTION DITTO L.CTOTL BSSZ 1 . TOTAL COMPACTION TIME FOR DISPLAY TEMP1 BSSZ 10 . TEMPORARY KLUDGE KLUDGE KLUDGE TEMP2 BSSZ 10 . SIMILARLY * * LOCAL STORAGE FOR ONE AB * S.ABLOCK BSS AB.SIZE * * A PLACE FOR NEWLY-FORMED CAPABILITIES TO SIT * ENTRY CAPAB CAPAB BSS 2 TITLE ERROR ROUTINES * ERRNUMS XTEXT * FUNDERR SX7 E.NOECS . NOT ENUF RESERVED SPACE FOR EQ CL6 . PROPOSED OBJECT NOTTHERE SX7 E.NOABLK . ALLOCATION BLOCK MISSING CL6 SX6 E.ABLOCK EQ E.ERROR * * MISCELLANEOUS DISASTR S * * CALLED BY FREE * FREEER RJ DISASTR . BLOCK BEING FREED CLAIMED TO BE * . FREE ALREADY BSLOP RJ DISASTR . SLOP FIELD IN BLOCK BEING FREED IS TOO LARGE SPCERR RJ DISASTR . ALLOCATORS SPACE ACCOUNTING IS HAD BLKFR RJ DISASTR . THE NEXT CONTIGUOUS BLOCK THOUGHT THAT * . THE BLOCK BEING FREED WAS ALREADY FREE * * CALLED BY ALLOC * ATERR RJ DISASTR . ALLOCATOR TYPE ILLEGAL IN FUND BLKBTS RJ DISASTR . WHEN A FREE BLOCK DISAPPEARED, * . THE BLOCK BITS IN THE NEXT BLOCK WERE WRONG * * CALLED BY MAKEOBJ * MOTERR RJ DISASTR . MOT FULL UNERR RJ DISASTR . UNIQUE NAME > OF = 2**38-1 * * CALLED BY DELOBJ * ERRDEL RJ DISASTR . OBJECT TO BE DESTROYED GONE ALREADY * * USED EVERYWHERE * FIELDER RJ DISASTR . 1)IN USE WENT UP PAST LIMIT BUT * NOT PAST RESERVED * 2)IN USE WENT DOWN AND NOW EXCEEDS * RESERVED * . 3) IN USE WENT DOWN OUT OF SIGHT TITLE READ ALLOCATION BLOCK * * THIS ROUTINE READS THE ALLOCATION BLOCK SPECIFIED * BY X5 AT ENTRY INTO THE BUFFER SPECIFIED IN A0 * AT ENTRY. * * PARAMETERS: * A0- A(BUFFER FOR AB) * X5- 2ND WORD OF CAPABILITY FOR AB * B5- RETURN LINK * * DONT CHANGE REGISTER USAGE (ESPECIALLY PRESERVE B4) * ABREAD SX0 X5 . MOT INDEX OF AB MX2 39 RECS 1 SA1 A0 . CHECK UNIQUE NAME, GET ECS ADR BX6 X1-X5 BX6 X2*X6 BX0 -X2*X1 RECS AB.SIZE . READ THE AB NZ X6,NOTTHERE . SORRY, AB GONE JP B5 TITLE INCREMENT CHARGE METER * THIS ROUTINE UPDATES THE CHARGE METERS AND TIME OF LAST * BILL IN THE AB SITTING IN THE BUFFER SPECIFIED IN A0 * AT ENTRY * * PARAMETERS: * A0- A(BUFFER WHERE AB IS SITTING) * B5- RETURN LINK * * MUST PRESERVE X0,X7 * CHARG SA1 A0+AB.TIML . GET CHARGE RATE, OLD TIME MX5 30 BX3 -X5*X1 . CHARGE RATE TO X3 AX1 30 . TIME OF LAST BILL TO LOW X1 SA4 =XS.MASTR . CURRENT TIME AX4 10 . REDUCE TO MMS/1024 LX4 30 . POSITION TO UPDATE TIME FIELD BX6 X4+X3 . FORM NEW TIME, CHARGE RATE WORD SA6 A1 LX4 30 IX4 X4-X1 . CALCULATE INTERVAL SINCE LAST CHARGE LX3 30 . SIGN EXTENSION AX3 30 PX3 X3 . PREPARE CHARGE RATE TO MULTIPLY PX4 X4 . PREPARE TIME INTERVAL DX3 X3*X4 . CHARGE INCREMENT FOR REG SPACE UX3 X3 SA2 A0+AB.CTS . INCREMENT CONTINUOUS CHARGE METER IX6 X2+X3 SA6 A2 SA2 A0+AB.DTS . INCREMENT DISCONTINUOUS CHARGE METER IX6 X2+X3 SA6 A2 SA3 A0+AB.MCHG . COMPUTE CHARGE INC FOR M CLOCKS LX3 30 . DUMP XTRA BITS, EXTEND SIGN AX3 30 PX3 X3 DX3 X4*X3 UX3 X3 SA2 A0+AB.MCTS . INCREMENT CONT M METER IX6 X2+X3 SA6 A2 SA2 A0+AB.MDTS . INCREMENT DISCONT M METER IX6 X2+X3 SA6 A2 JP B5 . EXIT TITLE M A K E O B J ENTRY MAKEOBJ * * THIS ROUTINE CONSTRUCTS "REAL" OBJECTS (IE, IT DOES NOT CONSTRUCT * FILE POINTER AND DATA BLOCKS). IT GETS AN MOT SLOT AND UNIQUE NAME * FOR THE OBJECT, FUNDS IT, AND CALLS ALLOC TO FIND SPACE. IT * SETS UP THE SECOND HEADER WORD AND FIXES UP THE CHAIN IN THE * ALLOCATION BLOCK. IT CONSTRUCTS A CAPABILITY FOR THE OBJECT * * PARAMETERS TO MKOBJ - * * X1 = OBJECT SIZE * B4 = RETURN LINK * X5 = 2ND WORD OF CAPABILITY FOR ALLOCATION BLOCK * X7 = ALLOCATOR TYPE * * PARAMETERS TO MAKEOBJ ARE SAME EXCEPT - * B2 = OBJECT SIZE INSTEAD OF X1 * * RETURNS - * A CAPABILITY FOR THE OBJECT IN CAPAB * X5 = PTR TO FIRST (USABLE) WORD OF OBJECT * * CALLS , ALLOC (COMPACT) * * TEMPORARIES USED - TEMP1 THROUGH TEMP1+2 * - S.ABLOCK THRU S.ABLOCK+AB.SIZE-1 * - TEMP2 * * LOCAL STORAGE - CAPAB, CAPAB+1 * * ENTRY COMPATIBLE WITH OLD USAGE * MAKEOBJ SX1 B2 . MOVE SIZE TO X1 * * LOCK ALLOCATION BLOCKS AND MOT STUFF * ECSSUB MKOBJ,BUFB RESERVE ALLOCBLK SB6 X7 . PRESERVE TYPE SX7 IP.AWDS . ADD ALLOCATORS SURCHARGE IX7 X1+X7 * * X7 = FUND SIZE OF OBJECT * * READ THE OWNING AB * SB5 MKOBJ3 . RETURN LINK BX6 X1 . PRESERVE THE FUND SIZE TO EXIT WITH SA6 TEMP2 SA0 S.ABLOCK . ADDRESS FOR AB EQ ABREAD * * X0 = ECS ADDRESS OF ALLOCATION BLOCK AT EXIT * AND S.ABLOCK CONTAINS ALLOCATION BLOCK AT EXIT * * READ THE MOT PACKAGE AND GET A SLOT AND UNIQUE NAME FOR THE OBJECT * MKOBJ3 SA4 S.ABLOCK+AB.MOT . GET NUMBER OF MOT SLOTS AVAILABLE SX2 1 . TO THIS AB AND SEE IF IT HAS ONE INCUSE 4,2,3,KLUDGE1,FIELDER KLUDGE1 BSS 0 . NOSLOT SA6 A4 SA4 S.ABLOCK+AB.ECS . INCREMENT IN USE FIELD INCUSE 4,7,3,FUNDERR,FIELDER SA6 A4 SB5 X5 . PRESERVE MOT OF AB BX4 X0 . PRESERVE ECS A(AB) SX0 EC.ABPCK SA0 TEMP1+1 RECS 2 . READ MOT STUFF SA5 A0 . GET MOT HEAD (IN X5 FOR ALLOC) SA2 A0+1 . GET UN FOR THIS OBJECT BX0 X5 ZR X0,MOTERR . MOT IS FULL, TOO BAD SX6 1 . ADVANCE UN IX6 X2+X6 SA6 A2 LX2 21 . POSITION UN FOR MOT ENTRY AX6 38 . TEST UN OVERFLOW????????? RECS 1 . READ MOT, UPDATES MOT HEAD NZ X6,UNERR . TOO MANY UNS SX0 EC.ABPCK * * RESTORE THE MOT PACKAGE AND WRITE A SKELETON MOT FOR THE NEW OBJ * WECS 2 BX6 X2 . WRITE THE UN IN THE MOT FOR THIS OBJ SA6 A0+0 BX0 X5 WECS 1 * * STORE THE SECOND WORD OF THE CAPABILITY FOR THE NEW OBJ * BX6 X6+X0 . COMBINE UN, MOT SA6 CAPAB+1 * * TWIDDLE THE POINTERS IN THE AB (AND SET UP THE SECOND HEADER WORD FOR THE * NEW OBJ READY FOR SUBSEQUENT WRITING) * SA1 S.ABLOCK+AB.CHAIN SB2 X1 . SAVE FOR LATER TESTING NZ X1,MKOBJ10 . OBJECTS ALREADY EXIST ON THIS AB BX1 X5 . SET THE HEAD POINTER TO THE NEW OBJ LX1 30 BX1 X1+X5 . SET THE TAIL POINTER TO THE NEW OBJ * * SET UP THE SECOND HEADER WORD FOR THE OBJ * MKOBJ10 MX6 30 BX2 -X6*X1 . ISOLATE TAIL FOR PREV AX1 30 LX1 18 . POSITION HEAD FOR NEXT BX2 X1+X2 LX1 12 . REPOSITION HEAD FOR AB BX6 X1+X5 . SET NEW OBJ AS TAIL FOR AB SA6 A1 SA0 S.ABLOCK BX0 X4 . RECOVER ECS A (AB) WECS AB.SIZE . WRITE UPDATED AB SX1 B5 . RECOVER MOT OF AB LX1 36 . POSITION IT BX2 X1+X2 . STICK IT IN HEADER WORD SX1 B6 . RECOVER TYPE LX1 54 BX6 X2+X1 SA6 CAPAB . SAVE SECOND HEADER WORD TEMPORARILY EQ B2,B0,MKOBJ6 . SKIP TO ALLOC CALL IF 1ST OBJ * * FIX THE HEAD OBJECTS PREV POINTER * MX4 59 . -1 MX3 39 LX2 60-18 . GET MOT FOR HEAD SX0 X2 RECS 1 SA1 A0 BX0 -X3*X1 . ISOLATE PTR IX0 X0+X4 . THE HEADER PRECEDS THE PTR WORD BY 1 MX4 42 RECS 1 . READ SECOND HEADER WORD SA1 A0 BX1 X4*X1 . WIPE OUT OLD PTR BX6 X1+X5 . INSERT MOT OF CURRENT OBJ SA6 A1 WECS 1 * * FIX THE (OLD) TAIL OBJECTS NEXT POINTER * LX2 18 SX0 X2 RECS 1 . READ MOT OF OLD TAIL OBJ SA1 A0 BX0 -X3*X1 MX4 59 IX0 X0+X4 RECS 1 . READ UP 2ND HEADER WORD SA1 A0 LX1 60-18 MX4 42 BX1 X4*X1 BX6 X1+X5 LX6 18 SA6 A0 WECS 1 * * CALL ALLOC TO FIND FREE SPACE FOR THE OBJECT, SET THE POINTER, * WRITE THE FIRST HEADER WORD, AND ZERO THE REST OF THE OBJECT * MKOBJ6 SB2 B0 . ALLOCATOR TYPE SB7 MKOBJ7 . RETLINK EQ ALLOC * * X3 = A(BLOCK) AT EXIT * MKOBJ7 MX1 59 IX0 X3-X1 . WRITE 2ND HEADER WORD SA0 CAPAB WECS 1 * * FIX UP CAPAB, SET X5 = A(OBJECT), AND EXIT * IX5 X0-X1 . ADVANCE TO A(OBJECT) MX6 42 SA1 B6+TYPECODE . GET CAPABILITY TYPE BX6 X6+X1 .COMBINE OPTION BITS, TYPE SA1 TEMP2 . RETRIEVE OBJECT SIZE FOR CALLER *KLUDGEKLUDGEKLUDGE SB2 X1 . COMPATIBLE WITH OLD ENTRY SA6 CAPAB JP B4 * * ERROR ROUTINES * NOSLOT SX7 E.NOSLOT . AB HAS NO AVAILABLE MOT SLOTS EQ CL6 ENDSUB MKOBJ,BUFB TYPECODE BSS NUMTYPES MACRO TYPES,ATT,TT ORG TYPECODE+AT.ATT VFD 60/T.TT ENDM PROC TYPES PROC CLIST TYPES CLIST FILE TYPES FILE OPER TYPES OPER EVCH TYPES EVCH ALBK TYPES ALLOC ORG TYPECODE+NUMTYPES TITLE D E L O B J ENTRY DELOBJ * * PARAMETERS - * X5 = 2ND WORD OF CAPABILITY FOR OBJECT * B7 = RETURN LINK * * RETURNS NOTHING * * CALLS FREE * * TEMPORARIES USED - USERB1 - USERB1+2 * TEMP1 - TEMP1+2 * S.ABLOCK - S.ABLOCK+AB.SIZE-1 * * FIRST, THE MOT FOR THE OBJECT IS TURNED OFF AND * THE MOT SLOT RELEASED. * THEN THE AB CHAIN POINTERS TO THE OBJECT ARE REVAMPED. * THEN THE OBJECT IS FREED. * FINALLY, IT IS DEFUNDED. * * * LOCK THE ALLOCATORS INFO AND READ IT IN * ECSSUB DLOBJ,BUFB RESERVE ALLOCBLK * * READ AND CHECK THE MOT FOR THE OBJECT * SX0 X5 SA0 B1 MX7 60-21 BX3 X5-X0 . UN TO X3 RECS 1 . READ MOT SA2 A0 BX1 X7*X2 BX3 X3-X1 . CHECK UNIQUE NAMES BX6 X0 . SAVE MOT NZ X3,ERRDEL . OBJECT GONE SHOULD BE ERROR, * . NOT DISASTER IF 2 CPUS SX0 EC.ABPCK . OLD MOT HEAD RECS 1 SA1 A0+0 . SAVE OLD MOT HEAD SA6 A0 . SET CURRENT SLOT AS NEW MOT HEAD BX5 -X7*X2 . A(OBJECT) WECS 1 BX0 X6 . SET NEWLY RELEASED SLOT BX6 X1 . TO OLD HEAD PTR SA6 A0 SB3 X0 . SAVE MOT OF OBJECT FOR A WHILE WECS 1 * * READ UP OBJECT HEADER * SX0 IP.AWDS IX0 X5-X0 . GIVES A(BLOCK) BX5 -X7*X0 . PRESERVE A(BLOCK) FOR FREE RECS 2 . READ HEADER WORDS SA1 A0+1 SB4 X1 . PREV PTR AX1 18 SB5 X1 . NEXT PTR AX1 18 * * READ OWNING AB, ADJUST AB CHAIN WORD IF REQUIRED * SX0 X1 . MOT OF AB RECS 1 . READ MOT OF AB TO WHICH OBJ IS CHARGED SA1 A0 BX6 -X7*X1 SA6 B1+2 . PRESERVE A(OBJECT) OF AB FOR LATER BX0 X6 SA0 S.ABLOCK RECS AB.SIZE . READ AB SB6 B4 . PREV PTR SA1 A0+AB.CHAIN . PICK UP CHAIN WORD MX6 0 . ZERO FOR CHAIN WORD EQ B4,B3,DELOB8.9 . IF PREV = THIS OBJ, ALL GONE SB2 X1 . IF THIS OBJ IS THE TAIL, FIX IT SB2 B2-B3 EQ B2,B0,DELOB8.8 LX1 30 SB2 X1 NE B2,B3,DELOB9 . SKIP IF NOT HEAD EITHER SB2 30 . FIX UP HEAD PTR SB4 B5 DELOB8.8 BX1 X7*X1 . PRESERVES TAIL/HEAD SX6 B4 BX6 X1+X6 . REPLACE HEAD/TAIL WITH NEXT/PREV LX6 B2,X6 . REPOSITION DELOB8.9 SA6 A1 ZR X6,DELOB11 . NO PTR'S TO BEND * * BENT THE PREV PTR IN NEXT * DELOB9 SX3 -IP.AWDS+1 SX0 B5 . MOT OF NEXT OBJ SA0 B1 RECS 1 SA1 A0 BX0 -X7*X1 IX0 X0+X3 . GIVES A(CHAIN WORD) MX4 42 RECS 1 SA1 A0 BX6 X4*X1 . WIPE OLD PREV PTR SX2 B6 . NICE NEW PREV PTR BX6 X6+X2 SA6 A1 WECS 1 . WRITE UPDATED WORD * * BEND THE NEXT PTR IN PREV * SX0 B6 . MOT OF PREV RECS 1 SA1 A0 BX0 -X7*X1 IX0 X0+X3 . CORRECT TO A(CHAIN WORD) RECS 1 SA1 A0 LX1 60-18 . POSITION NEXT PTR BX6 X4*X1 . WIPE OLD PTR SX2 B5 . NICE NEW PTR BX6 X6+X2 LX6 18 . REPOSITION WORD SA6 A1 . WRITE NEW NEXT PTR IN PREV WECS 1 * * FREE THE OBJECT * DELOB11 SB3 DELOB14 JP FREE * * RETURN SPACE, MOT SLOT * FREE LEFT FUND SIZE OF OBJECT IN X1 * DELOB14 SA0 S.ABLOCK SA2 A0+AB.MOT . RETURN MOT SLOT TO AB MX0 59 INCUSE 2,0,5,KLUDGE,FIELDER KLUDGE BSS 0 . FIELDER SA6 A2 SA2 A0+AB.ECS BX1 -X1 INCUSE 2,1,5,FIELDER,FIELDER SA6 A2 SA5 B1+2 . RETIREVE ECS A(AB) BX0 X5 WECS AB.SIZE . WRITE OUT UPDATED AB RELEASE ALLOCBLK JP B7 . EXIT ENDSUB DLOBJ,BUFB DELOBJ EQU DLOBJ TITLE R T R N F I L ENTRY RTRNFIL * ROUTINE TO DELETE A FILE POINTER OR DATA BLOCK * PARAMETERS: * B7 RETURN LINK * X5 ALLOC BLOCK CAPABILITY * X6 ABSOLUTE ECS ADDRESS OF POINTER * * PRESERVES B4 * * CALLS ABREAD, FREE * * TEMPORARIES USED TEMP1 THRU TEMP1+2 * S.ABLOCK THRU S.ABLOCK+AB.SIZE-1 * TEMP2 * ECSSUB RTNFL,BUFB BX0 X6 BX6 X5 . SAVE MOT AF AB SA0 FINFO . READ UP POINTER RECS 1 SA6 TEMP2 SA1 A0 MX6 39 BX1 -X6*X1 SX5 IP.AWDS IX5 X1-X5 . GET A(BLOCK) FOR FREE SB3 RTRN1 JP FREE . FREE THE OBJECT * * NOW DEFUND IT * RTRN1 BX7 -X1 . FREE LEFT THE FUND SIZE IN X1 SA5 TEMP2 . RETRIEVE MOT OF AB SB5 RTRN2 RESERVE ALLOCBLK SA0 S.ABLOCK . READ AB INTO S.ABLOCK JP ABREAD RTRN2 SA2 A0+AB.ECS INCUSE 2,7,1,FIELDER,FIELDER SA6 A2 . UPDATE IN USE FIELD WECS AB.SIZE RELEASE ALLOCBLK JP B7 . EXIT ENDSUB RTNFL,BUFB RTRNFIL EQU RTNFL TITLE FUNDX7 * * THIS ROUTINE IS USED BY THE FILE CODE TO MAKE SURE * THAT ALL THE POINTER BLOCKS AND THE DATA BLOCK * BEING CREATED CAN BE AFFORDED BY THE FILES AB. * * PARAMETERS: * B3- RETURN LINK * X7- SPACE REQUIRED * X5- 2ND WORD OF CAP FOR ALLOCATION BLOCK * * B2,B4,B6,B7 ARE SAVED * ENTRY FUNDX7 FUNDX7 RESERVE ALLOCBLK SB5 FUNDX71 SA0 S.ABLOCK EQ ABREAD . READ THE ALLOCATION BLOCK FUNDX71 SA2 A0+AB.ECS . GET THE SPACE WORD INCUSE 2,7,5,FUNDERR,FIELDER SA6 A2 . UPDATE IN USE FIELD WECS AB.SIZE . WRITE THE UPDATED AB RELEASE ALLOCBLK JP B3 . EXIT TITLE A L L O C ENTRY ALLOC * THIS ROUTINE HANDLES FINDING SPACE IN THE FREE * CHAIN FOR BLOCKS. IT SETS A POINTER TO THE SPACE * IT FINDS, WRITES THE FIRST HEADER WORD FOR THE * NEW BLOCK AND CLEARS THE REMAINDER, COMPACTS IF * NECESSARY, ETC. * * PARAMETERS - * * X5 = ECS ADDRESS OF WORD TO POINT TO NEW OBJECT * ( THIS WORD IS RETURNED TO THE CALLER, * UPDATED IF COMPACTIFICATION OCCURRED) * X7 = FUND SIZE OF OBJECT * B7 = RETURN LINK * B2 = COMPACTION TYPE, 0 FOR NORMAL BLOCK * 1 FOR FILE PTR BLOCK * 2 FOR DAE BLOCK * 3 NOT ASSIGNED YET * OTHERS ILLEGAL * * RETURNS - * * X3 = A(BLOCK) * X5 = A(POINTER WORD) * * PRESERVES B4,B6 * * * CALLS COMPACT * * TEMPORARIES USED - TEMP1 TO TEMP1+2 * * * * RESERVE FREE SPACE INFO AND READ IT IN * ECSSUB ALLOC,BUFA RESERVE FCHAIN SA0 FINFO SX0 EC.FINFO RECS FS.SIZE * * * SEARCH THE FREE CHAIN FOR A BIG ENUF BLOCK * ALOC3 SB3 2 GE B2,B3,ATERR . WHO CALLED WITH ILLEGAL AT? SA1 FINFO+FS.FPTR BX6 X1 . KEEP HEAD OF FREE CHAIN FOR END TEST MX2 30 SA0 TEMP1 BX0 X1 ALOC3.2 RECS 2 . READ FB HEADER WORDS SA1 A0 BX3 -X2*X1 IX4 X3-X7 AX1 30 . GET POINTER TO NEXT FB * * X4 = SIZE LEFT IN FB IF THIS OBJECT IS PUT IN * PL X4,ALOC3.5 . ITS BIG ENUG IX3 X6-X1 . SEE IF THIS IS WHERE WE CAME IN BX0 X1 NZ X3,ALOC3.2 . TRY THE NEXT ONE * * THERE WASNT A BIG ENUF BLOCK, CALL COMPACTOR * SB3 ALLOC . RETLINK JP COMPACT * * KNUTH SAYS TO SET THE NEXT BLOCK TO START THE SEARCH * NEXT TIME, AND THATS JUST WHAT WEVE BEEN FORCED TO DO * ALOC3.5 BX6 X1 . SET NEW HEAD OF FREE CHAIN SA6 FINFO+FS.FPTR * * UPDATE NUMBEROF BLOCKS * SA1 FINFO+FS.NBLKS SX6 X1+1 SA6 A1 * * DECREMENT AVAILABLE SPACE, INCREASE SPACE IN USE * SA1 FINFO+FS.USED IX6 X1+X7 SA6 A1 SA1 FINFO+FS.SPACE IX6 X1-X7 SA6 A1 NG X6,SPCERR . THATS REALLY BAD SX6 IP.MINBK-1 . SEE IF THE BLOCK IS BIG ENUF TO IX6 X6-X4 . SURVIVE SA1 A0 . FIX UP A1,X1 TO FB TRAILER PL X6,ALOC5 . NO, WELL HAVE TO DO IT IN. * * WRITE NEW SIZE FIELD IN FB TRAILER * IX6 X1-X7 . RECALCULATE NEW FB SIZE SA6 A0 WECS 1 * * WRITE NEW HEADER FOR FB * IX0 X0-X4 . A(NEW HEADER WORD), ALMOST MX6 1 BX6 X6+X4 . COMBINE FREE BIT AND SIZE SA6 A0 SX6 2 IX0 X0+X6 . THERE NOW * * SLOP WORD TO ZERO * BX4 X4-X4 WECS 1 * * X3 = A(BLOCK) * ALOC12 IX3 X0-X7 * * RESTORE AND RELEASE FREE CHAIN INFO * SX0 EC.FINFO SA0 FINFO WECS FS.SIZE RELEASE FCHAIN * * SET THE REQUIRED POINTER WORD * MX6 39 BX0 -X6*X5 . ELIMINATE POSSIBLE JUNK RECS 1 SA1 A0 . GET PTR WORD BX6 X6*X1 . BLOT OUT JUNK BX6 X6+X3 . STICK IN PTR SX2 2 IX6 X6+X2 . GIVES A(OBJECT) SA6 A0 WECS 1 * * SET UP FIRST HEADER WORD FOR NEW OBJECT AND WRITE IT * LX0 21 . POSITION BACK POINTER BX6 X0+X7 . COMBINE WITH SIZE LX4 42 . POSITION SLOP BX6 X4+X6 SX4 B2 . POSITION COMPACTION TYPE LX4 42+IP.SLOP BX6 X6+X4 SA6 A0 BX0 X3 WECS 1 * * CLEAR REMAINDER OF BLOCK ( INCLUDING ANY SLOP) * SX6 1 IX7 X7-X6 . BUGGER THE COUNT IX0 X0+X6 . BUGGER THE STARTING ADDRESS SB2 NUMZRO SA0 BLKZRO SX6 B2 ALOC14 IX7 X7-X6 NG X7,ALOC14.2 WECS B2 . WRITE A BLOCK OF ZEROS IX0 X0+X6 . ADVANCE THE ADDRESS EQ ALOC14 ALOC14.2 SB2 X7+B2 . GET COUNT FOR LAST FRAGMENT WECS B2 * * EXIT * JP B7 * *STUFF * NUMZRO EQU 20 BLKZRO BSSZ NUMZRO * * DECHAIN THE FB AND JUGGLE EVERYTHING * * * TAKE THIS BLOCK OUT OF THE FREE CHAIN * ALOC5 BX6 X2*X1 . SAVE NPTR IN X6 BX3 X0 . SAVE A(CURRENT FREE BLOCK) SX0 1 . WRITE NEW PPTR IN NEXT FB SA0 A0+1 AX1 30 . NPTR TO READ NEXT FB IX0 X1+X0 WECS 1 SA1 A0 . GET PPTR BX0 X1 RECS 1 . GET NPTR WORD FROM PREV BLOCK SA1 A0 . SUBSTITUTE THE NPTR FROM BX1 -X2*X1 . THE BLOCK BEING LIQUIDATED BX6 X6+X1 SA6 A1 WECS 1 * * UPDATE THE NUMBER OF FREE BLOCKS * SA1 FINFO+FS.NFBLK SX6 X1-1 SA6 A1 * * UPDATE SLOP * SA1 FINFO+FS.SLOP IX6 X1+X4 SA6 A1 * * UPDATE FREE SPACE * SA1 FINFO+FS.SPACE IX6 X1-X4 SA6 A1 * * TELL THE NEXT CONTIGUOUS BLOCK THAT THE PRECEDING BLOCK * IS NO LONGER FREE * SX0 2 IX0 X0+X3 RECS 1 . READ THE FIRST HEADER WORD SA1 A0 MX3 2 . ERASE THE PRECEDING BLOCK FREE BIT BX6 -X3*X1 SA6 A1 WECS 1 AX1 58 . SEE IF THOSE BLOCK BITS WERE OK SX1 X1-1 NZ X1,BLKBTS . HORRORS * * CALCULATE BLOCK SIZE IN X7 * IX7 X7+X4 . FUND SIZE + SLOP EQ ALOC12 . BACK TO THE MAIN STREAM ENDSUB ALLOC,BUFA TITLE R E A L L O C ENTRY REALLOC EXT EC.RTMP,I.LOCK * PARAMETERS * X1 = CHANGE IN SIZE (MAY BE NEGATIVE) * X2 = MOT FOR OBJECT * X6 = RETURN LINK * * CALLS ALLOC (COMPACT), FREE * * TEMPORARIES USED - TEMP1 THRU TEMP1+2 * TEMP2 THRU TEMP2+6 * S.ABLOCK - S.ABLOCK+AB.SIZE-1 * * CANT BE USED FOR BLOCKS OF ALLOCATOR TYPE NOT EQUAL 0 * * * * TEMPORARY NAMES * R.RET EQU TEMP2 . RETURN LINK R.OBMOT EQU TEMP2+1 . A(OBJECT MOT SLOT) R.DEL EQU TEMP2+2 . CHANGE IN SIZE R.ABLK EQU TEMP2+3 . ECS A(BLOCK) R.HDR EQU TEMP2+4 . TWO WORDS, OBJECT HEADER R.OFS EQU TEMP2+6 . OLD FUND SIZE * * * LOCK AB STUFF, SAVE ENTRY PARAMS * ECSSUB REALC,BUFB RESERVE ALLOCBLK SA6 R.RET SX6 X2 . PRESERVE MOT OF OBJECT BX7 X1 . PRESERVE SIZE CHANGE SA6 R.OBMOT SA7 R.DEL * * READ OBJECT HEADER WORDS * SX0 X2 SA0 R.HDR . READ MOT FOR OBJECT MX3 39 RECS 1 SA4 A0 BX0 -X3*X4 SX4 IP.AWDS . CALCULATE A(BLOCK) IX0 X0-X4 BX6 X0 . PRESERVE A(BLOCK) SA6 R.ABLK RECS 2 . READ HEADER WORDS * * GET HOLD OF THE LIABLE AB AND FUND THE INCREASE * SA2 A0+1 AX2 36 SX0 X2 . GIVES MOT OF AB SA0 S.ABLOCK RECS 1 SA2 A0 . GET A(AB) BX0 -X3*X2 RECS AB.SIZE . READ AB SA2 S.ABLOCK+AB.ECS INCUSE 2,1,3,FUNDERR,FIELDER SA6 A2 . UPDATE IN USE FIELD * * CHECK OUT SLOP AVAILABLE AT END OF BLOCK * SA3 R.HDR . FETCH 1ST HEADER WORD MX4 60-IP.SLOP SA0 A3 LX3 18 BX6 -X4*X3 . SLOP TO X6 BX3 X4*X3 . BLOT OUT OLD SLOP IX5 X6-X7 . JP IF NOT ENUF SLOP TO COVER NG X5,REAL3 . THE DAMAGE * * WE CAN SIMPLY ADJUST THE SLOP (UNLESS THE SLOP FIELD OVERFLOWS) * BX4 X5 . PRESERVE NEW SLOP AX5 IP.SLOP-1 SA1 R.ABLK . RETRIEVE A(BLOCK) BX0 X1 ZR X5,REAL2 . SKIP IF NO SLOP OVERFLOW BX7 X3 . PUT IN ZERO SLOP LX7 42 . REPOSITION WORD IX7 X7-X4 . BLOCK IS NOW SMALLER BY NEW SLOP SIZE SA7 A3 WECS 1 . WRITE UPDATED HEADER WORD * * CONSTRUCT A PHONY BLOCK OUT OF THE SLOP AND USE FREE * TO RETURN IT TO THE FREE CHAIN * MX3 39 BX3 -X3*X7 . BLOCK SIZE IX0 X0+X3 . GET A(SLOP) = A(BLOCK)+BLOCKSIZE,NEW BX7 X4 . FABRICATE PHONY BLOCK HEADER SA7 A0 BX5 X0 . SAVE PHONY BLOCK ADDR FOR FREE WECS 1 . WRITE THE PHONY HEADER RESERVE FCHAIN SA0 FINFO . FIX UP THE ALOCATOR INFORMATION SX0 EC.FINFO . TO ACCOUNT FOR THE FUNNY GOINGS RECS FS.SIZE . ON SA3 FINFO+FS.NBLKS SX7 X3+1 . COUNT ONE FOR OUR PHONY OBJECT SA7 A3 SA3 FINFO+FS.SLOP IX7 X3-X6 . THE SLOP IS NOW GONE SA7 A3 SA3 FINFO+FS.USED IX7 X3+X6 . AND LOOKS (TEMPORARILY) LIKE SA7 A3 . USED SPACE WECS FS.SIZE RELEASE FCHAIN SB3 REALX . RETURN THE SLOP TO THE FREE CHAIN JP FREE * * JUGGLE THE FREE CHAIN ACCOUNTING VIS-A-VIS THE NEW SLOP * REAL2 BX7 X3+X4 . STICK IN NEW SLOP LX7 42 . POSITION WORD SA7 A3+0 . STORE FOR TO SRITE OUT WECS 1 RESERVE FCHAIN SA0 FINFO SX0 EC.FINFO RECS FS.SIZE . READ THE FREE INFO SA2 R.DEL . RETRIEVE THE INCREASE SA3 FINFO+FS.SLOP IX7 X3-X2 . UPDATE GLOBAL SLOP SA7 A3 SA3 FINFO+FS.USED IX7 X3+X2 . UPDATE IN USE SA7 A3 WECS FS.SIZE RELEASE FCHAIN * * * WRITE OUT THE OWNING AB, * RELEASE ALLOCATOR STUFF, RETRIEVE XIT AND XIT * REALX SA1 R.HDR+1 . GET A(MOT FOR AB) AX1 36 SA0 A1 SX0 X1 MX2 39 RECS 1 SA1 A0 BX0 -X2*X1 SA0 S.ABLOCK SA1 R.RET . RETRIEVE EXIT SB7 X1 WECS AB.SIZE . WRITE OUT UPDATED AB RELEASE ALLOCBLK JP B7 . XIT * * THE OBJECT MUST BE REALLOCATED TO GET ENUF SPACE * REAL3 MX4 39 LX3 60-18 BX3 -X4*X3 . BLOCK SIZE TO X3 IX6 X3-X6 . FUND SIZE TO X6 SA6 R.OFS SX3 IP.PAD IX7 X6+X7 . NEW FUND SIZE IX6 X3-X6 . IF THE OLD OBJECT ISNT LARGER THAN PL X6,REAL9 . THE PAD, PROCEED SA2 S.ABLOCK+AB.ECS BX5 -X6 . SEE IF THE AB CAN HANDLE THE DUPLICATION INCUSE 2,5,3,REAL11,FIELDER * * CALL ALLOC TO FIND A BIG ENUF SPOT * REAL9 SX5 EC.RTMP . PLACE FOR PTR TO BE SET SB2 B0+0 . COMPACTION TYPE (ONLY PROCESSES AND + SB7 *+1 . OPERATIONS CHANGE SIZE) JP ALLOC * * MOVE THE STUFF FORM THE OLD LOC TO THE NEW LOC * * X3 = A(BLOCK) AFTER ALLOC * SA5 R.OBMOT . REREAD THE OBJECT MOT SA0 MOVBUF SX0 X5 . (CAUSE IT MAY HAVE MOVED) MX7 39 SA7 I.LOCK . OBJECT IN BAD SHAPE - PREVENT INTERRUPTS RECS 1 SA1 A0 BX4 -X7*X1 . A(OBJECT) BX6 X7*X1 . SAVE UN FOR LATER BX0 X3 . READ THE NEW OBJECT HEADER RECS 1 SA1 A0 LX1 60-21 . POSITION BACK PTR BX1 X7*X1 . ELIMINATE FALSE PTR BX7 X1+X5 . INSERT MOT OF OBJECT LX7 21 . REPOSITION SA7 A0 SX2 1 WECS 1 . WRITE SHINY NEW BACK PTR SA1 R.OFS . OLD FUND SIZE FOR TALLY IX3 X3+X2 . X3 = TO BX6 X6+X3 . NEW MOT ENTRY, EXCEPT FOR 1 IX6 X6+X2 . THERE NOW BX7 X4 . SAVE A(OLD OBJECT) IX4 X4-X2 . X4 = FROM IX1 X1-X2 . X1 = COUNT SX2 NUMMOV SB2 X2+0 REAL10 IX1 X1-X2 . DECREASE COUNT BX0 X4 PL X1,*+2 . SKIP IF LOTS TO MOVE SB2 X1+NUMMOV . SUBSTITUTE COUNT FOR FINAL MOVE RECS B2 . READ FROM OLD OBJ BX0 X3 IX3 X3+X2 IX4 X4+X2 WECS B2 . WRITE IN NEW OBJ PL X1,REAL10 . LOOP * * SET THE MOT PTR TO THE NEW INCARNATION * BX0 X5 SA6 A0 WECS 1 . WRITE NEW MOT FOR OBJECT SX6 0 . UNLOCK INTERRUPTS SA6 I.LOCK * * FREE THE OLD VERSION OF THE OBJECT * SX5 IP.AWDS IX5 X7-X5 . CALCULATE A(BLOCK) + SB3 REALX JP FREE * * AB COULDNT STAND DUPLICATION THAT THE PAD COULDNT HANDLE * REAL11 SX7 E.NORLC EQ CL6 * * A MOVE BUFFER OCCUPIES WHATEVER IS LEFT OF THE BUFFER * MOVBUF BSS 0 NUMMOV EQU BUFB+BUFB.S-MOVBUF IFLT NUMMOV,20B,1 ERR OH, COME ON BSS NUMMOV ENDSUB REALC,BUFB REALLOC EQU REALC TITLE F R E E * THIS IS THE BASIC SYSTEM FREE ROUTINE * PARAMETERS: * X5 = A(BLOCK) * B3 = RETURN LINK * * AT EXIT - * X1 = FUND SIZE OF BLOCK JUST LIBERATED * * * B4 AND B7 ARE PRESERVED * * TEMPORARIES USED - TEMP1 TO TEMP1+2 * * * * RESERVE THE FREE SPACE INFO AND READ IT IN * ECSSUB FREE,BUFA RESERVE FCHAIN SA0 FINFO . READ THE FREE INFO SX0 EC.FINFO RECS FS.SIZE * * READ THE OBJECT HEADER * MX2 39 SA0 TEMP1 BX0 -X2*X5 * * X0 = A(BLOCK) * RECS 1 . READ OBJECT HEADER * * UPDATE NUMBER OF BLOCKS, FREE SPACE, SLOP, IN USE, AND CHECK TOTAL * SA1 FINFO+FS.NBLKS . DECREMENT NUMBER OF BLOCKS SX6 X1-1 SA6 A1 SA1 A0 . GET FIRST HEADER WORD NG X1,FREEER . SHOULDNT ALREADY BE FREE! SA4 FINFO+FS.SPACE BX3 -X2*X1 . GET BLOCK SIZE * * X3 = BLOCK SIZE * IX7 X3+X4 . INCREMENT FREE SPACE SA7 A4 SA2 FINFO+FS.SLOP .GET SLOP AX1 42+IP.SLOP-18 . GET AT HIGH BIT OF SLOP FIELD SX4 X1 . CHECK LEGALITY OF SLOP FIELD NG X4,BSLOP . SHOULDNT BE THAT BIG AX4 18-IP.SLOP . SLOP IN BLOCK IX6 X3-X4 . SAVE FUND SIZE FOR TO EXIT WITH SA6 TEMP1+2 IX6 X2-X4 . SLOP := SLOP - SLOP IN BLOCK SA6 A2 IX7 X7+X6 . GIVES FREE SPACE+SLOP SA2 FINFO+FS.USED IX6 X2-X3 IX6 X6+X4 . IN USE := IN USE -(BLOCK SIZE - SLOP) SA6 A2 IX7 X7+X6 . FREE SPACE + SLOP + IN USE = TOTAL??? SA2 FINFO+FS.TOTAL IX2 X2-X7 NZ X2,SPCERR . HORRORS * * IF THE PRECEDING CONTIGUOUS BLOCK IS FREE, REMOVE IT FROM * THE FREE CHAIN , ADD ITS SPACE TO THE SIZE OF THE * BLOCK BEING LIBERATED, AND SUBSTITUE ITS STARTING ADDRESS * FOR THE STARTING ADDRESS OF THE BLOCK BEING LIBERATED. * LX1 1+42+IP.SLOP-18 . GET PRECEDING BLK IND BIT PL X1,FREE10 . ITS NOT FREE SX1 2 IX0 X0-X1 RECS 2 . READ FREE BLOCK TRAILER IX0 X0+X1 . RESTORE X0 SA1 A0 MX2 30 BX4 -X2*X1 . GET BLOCK SIZE IX5 X0-X4 . GET ADDRESS OF BEGINNING OF FREE BLOCK * * X5 = A(PREC BLOCK) * IX3 X3+X4 . GET COMBINED BLOCK SIZE * * X3 = SIZE OF COMBINED BLOCKS * AX1 30 . GET NEXT POINTER BX6 X1 . USE AS NEW HEAD OF FREE CHAIN SA6 FINFO+FS.FPTR SX4 1 IX0 X1+X4 . GIVES A(PPTR WORD) IN NEXT BLOCK SA0 A0+1 . A(PPTR WORD) IN THIS FB WECS 1 . BEND PPTR IN NEXT BLOCK SA4 A0 . GET PPTR BX0 X4 RECS 1 . READ NPTR WORD OF PREVIOUS BLOCK SA1 A0 . STICK THE NPTR FROM THE DEFUNCT BLOCK LX6 30 . INTO THE PREVIOUS BLOCK BX1 -X2*X1 . PRESERVE SIZE FIELD BX6 X1+X6 SA6 A0 WECS 1 * * DECREMENT FREE BLOCK COUNT * SA1 FINFO+FS.NFBLK SX6 X1-1 SA6 A1 BX0 X5 . GET X0 CURRENT AGAIN (=A(BLOCK)) * * IF THE FOLLOWING CONTIGUOUS OBJECT IS FREE, JUST ADD * THE SIZE OF THE LIBERATED OBJECT ( AND MAYBE ITS PREDECESSOR) * TO THE SIZE OF THE FOLLOWING BLOCK * FREE10 IX0 X0+X3 RECS 1 . GET THE BLOCK BITS FROM THE FOLLOWING SA1 A0 . OBJECT PL X1,FREE13 . ITS NOT FREE IX6 X1+X3 . FORM NEW HEADER FOR THE FB SA6 A0 . AND WRITE IT AT THE NEW HEAD IX0 X0-X3 . OF THE FB WECS 1 LX1 1 NG X1,BLKFR . SHOULDNT HAPPEN MX2 30 BX6 -X2*X6 . GET THE TRAILER WORD FROM TO FB IX0 X0+X6 . AND UPDATE ITS SIZE SX4 2 IX0 X0-X4 RECS 1 SA1 A0 BX1 X2*X1 BX6 X1+X6 SA6 A0 WECS 1 * * WRITE OUT THE UPDATED FREE INFO AND RELEASE IT * FREE12 SA0 FINFO SX0 EC.FINFO WECS FS.SIZE RELEASE FCHAIN SA1 TEMP1+2 . GET FUND SIZE FOR CALLER JP B3 . EXIT * * MAKE A NEW FREE BLOCK OUT OF THE LIBERATED OBJECT AND PUT IT AT THE * HEAD OF THE FREE CHAIN * FREE13 MX2 1 LX1 1 NG X1,BLKFR . SHOULDNT HAPPEN * * SET PRECEDING CONTIG OBJECT FREE BIT IN NEXT CONTIG OBJECT * BX6 X1+X2 LX6 59 SA6 A0 WECS 1 * * READ THE HEAD OBJECT ON THE FREE CHAIN AND BEND ITS PPTR TO THE * * NEW OBJECT * SA1 FINFO+FS.FPTR SX5 2 . PUT THE NEW FB AT THE HEAD OF THE CHAIN IX7 X0-X5 . GIVES A(TRAILER) FOR NEW FB SA7 A1 . SET NEW HEAD OF FREE CHAIN SX0 1 IX0 X1+X0 . A(PPRT WORD) IN OLD HEAD SA0 TEMP1+1 RECS 1 . SAVE THE PPTR FOR THE NEW BLOCK SA0 A1 WECS 1 . WRITE NEW PPTR IN OLD HEAD * * WRITE THE TRAILER FOR THE NEW FB * LX1 30 . COMBINE SIZE WITH NPTR FOR NEW FB BX6 X1+X3 SA6 TEMP1 SA0 A6 BX0 X7 . A(NEW FB TRAILER) WECS 2 * * WRITE THE HEADER FOR THE NEW BLOCK * IX0 X0-X3 . A(HEADER) = A(TRAILER)-SIZE+2 IX0 X0+X5 BX6 X2+X3 . COMBINE BLOCK FREE BIT WITH SIZE SA6 A0 WECS 1 * * BEND THE NPTR IN THE TAIL FB TO POINT TO THE NEW FB * SA1 TEMP1+1 BX0 X1 RECS 1 . READ HEADER OF TAIL FB SA1 A0 MX2 30 BX1 -X2*X1 . SAVE SIZE FIELD SA2 FINFO+FS.FPTR LX2 30 BX6 X2+X1 . . STICK IN NEW NPTR SA6 A0 WECS 1 * * TALLY THE NEW FB * SA1 FINFO+FS.NFBLK SX6 X1+1 SA6 A1 EQ FREE12 . GO EXIT ENDSUB FREE,BUFA TITLE CHANGE UNIQUE NAME * NEWUN CHANGES THE UNIQUE NAME OF AN OBJECT * IF THE OBJECT IS A FILE WHICH HAS A BLOCK IN A MAP, * THE GLOBAL BADMAP COUNT IS INCREMENTED BY 1. * PARAMETER * AP1 C: OBJECT WHOSE NAME IS TO BE CHANGED * AP2 D: INDEX IN C-LIST FOR NEW CAP * WHOSE UNIQUE NAME IS TO BE CHANGED * ECSCODE NEWUN * * READ MOT AND SEE IF THE OBJECT IS STILL AROUND * SA1 B1+P.PARAM+1 . UN, MOT OF OBJECT SX0 X1 SA0 B1 RECS 1 . READ MOT MX3 39 SA2 A0 . SEE IF UNS MATCH BX6 X2-X1 BX6 X3*X6 BX7 X0 . WHATS THIS FOR NZ X6,OBJGONE * * GET A NEW UN * RESERVE ALLOCBLK SA0 A0+2 . READ NEXT UN FROM ECS SX0 EC.ABPCK+1 RECS 1 SA4 A0 . NEW UN FOR THIS OBJECT MX5 59 . -1 IX6 X4-X5 . ADVANCE UN SA6 A0 AX6 38 . CHECK UN OVERFLOW NZ X6,S.UNERR . UN OVERFLOW DISASTER WECS 1 . WRITE UPDATED UN * * PUT THE NEW UN IN THE MOT ENTRY * BX0 X7 . RETRIEVE A(MOT SLOT) BX6 -X3*X2 . DELETE OLD UN LX4 21 . POSITION NEW ONE BX6 X6+X4 SA6 A0 WECS 1 . WRITE NEW MOT ENTRY * * NEW UN IN CAPABILITY * BX7 X4+X7 . COMBINE NEW UN, MOT SA7 A1 SB6 NEWUN1 . EXIT FROM PUTCAP SA1 B1+P.PARAM+2 . CAPABILITY INDEX SB5 B1+P.PARAM . A(CAP) IN CM EQ =XPUTCAP * * NOW CHECK WHETHER THE OBJECT IS A FILE OR NOT * NEWUN1 BX3 -X3*X2 . HOW DID X2 SURVIVE ALL THAT TIME SX1 IP.AWDS-1 IX0 X3-X1 . GET A(HEADER WORD) SA0 B1 RECS 1 . READ HEADER WORD SA1 A0 PL X1,SYSRET . WHEW. ITS NOT A FILE. SB7 SYSRET . OH AGONY. WHAT IF ITS IN A MAP. EQ =XREFZ . (THE GARBAGE COUNT GETS INCREMENTED, * . THATS WHAT) OBJGONE SX6 E.MISCE * SX7 E.MISSOB EQ E.ERROR ENDECS NEWUN TITLE D O N A T E TITLE C C C L O A * CCCLOA CONSTRUCTS THE COMPLETE CAPABILITY FOR THE NTH OBJECT * ASSOCIATED WITH A GIVEN ALLOCATION BLOCK * IT FRETURNS IF THERE ARE LESS THAN N OBJECTS * PARAMEYERS: AP1: C: ALLOCATION BLOCK * AP2: D: INDEX INTO FULL C-LIST * AP3: D: INDEX OF OBJECT ECSCODE CCCLO EXT SYSFRET CCCLOA SA1 B1+P.PARAM+1 SX0 X1 SA0 B1 RECS 1 FETCH MOT ENTRY OF ALLOC BK SA2 A0 MX5 39 BX1 X1-X2 BX7 X1*X5 NZ X7,NOTTHERE . UN'S DONT MATCH; AB GONE BX0 -X5*X2 ADDRESS OF ALLOC BK MX1 59 -1 SX4 -IP.AWDS+1 . OFFSET OF OBJECT HEADER WORD SX3 AB.CHAIN IX0 X0+X3 AB.CHAIN RECS 1 SA3 A0 ZR X3,SYSFRET . NO OBJECTS ON AB SX7 X3 LATEST OBJECT ADDED TO AB CHAIN SA2 B1+P.PARAM+3 .COUNT LX3 30 . POSITION HEAD OBJECT NG X2,ERR202 .NEGATIVE COUNT IX2 X2+X1 . CORRECT TALLY (0=1) CC1 IX2 X2+X1 SX0 X3 . MOT OF NEXT OBJECT ON CHAIN NG X2,CC2 . THIS IS THE ONE BX6 X7-X0 .COMPARE WITH TAIL RECS 1 SA3 A0+0 BX3 -X5*X3 .POINTER IX0 X3+X4 .ADDRESS OF HEADER RECS 1 SA3 A0 AX3 18 . POSITION NEXT POINTER NZ X6,CC1 .LOOP IF LIST NOT EXHAUSTED EQ SYSFRET .COUNT .GT. NUMBER OF OBJECTS CC2 RECS 1 SA3 A0 .MOT ENTRY OF DESIRED OBJECT BX7 X3*X5 UNIQUE NAME BX7 X7+X0 2ND WORD OF CAPABILITY BX0 -X5*X3 ECS ADDRESS OF OBJECT IX0 X0+X1 ADDRESS OF HEADER WORD MX3 6 SA7 B1+1 RECS 1 FETCH OBJ HEADER SA2 A0 BX2 X2*X3 LX2 6 TYPECODE SB5 B1 TEMPORARY FOR CAPABILITY SA2 X2+TYPECODE LOOK UP TYPECODE IN TABLE MX6 42 . ALL OPTION BITS BX6 X2+X6 1ST WORD OF CAPABILITY SA6 B1 SA1 B1+P.PARAM+2 X1 INDEX WHERE CAPABILITY WILL GO SB6 SYSRET RETURN FROM PUTCAP EQ =XPUTCAP ERR202 SX1 2 SX7 E.NEGPAR LX1 18 BX7 X1+X7 SX6 E.PARMS EQ E.ERROR ENDECS CCCLO TITLE INFAMOUS COMPACTOR * * B3 = RETLINK * * PRESERVES B1,B2,B3,B4,B6,B7,X5,X7 AND B0 * * X5 IS PRESERVED IN THE FOLLOWING, VERY SPECIAL, SENSE - * THE CONTENTS OF X5 ARE TAKEN AS THE ADDRESS OF A WORD * IN ECS. !IF THIS WORD IS MOVED DURING COMPACTION, THE * NEW ADDRESS IS RETURNED IN X5. * * ENTRY COMPACT EXT I.LOCK,I.WAIT,S.MASTR,S.CHARG COMPACT SA0 =XBUFA . FREE SPACE IN LOW CORE BUFFERS SX0 =XPARMBUF WECS COMPSIZ ECSSUB COMP0,BUFA SA1 S.MASTR . READ TIME AT BEGINNING OF COMPACTION BX6 X1 SA6 L.CLAST . SET FOR DISPLAY AND LATER USE SA0 FINFO . READ FREE INFO SX0 EC.FINFO RECS FS.SIZE SA0 COMPTMP . READ COMPACTOR INFO SX0 =XEC.FLOR RECS 3 SA1 A0+1 . ADVANCE GARBCNT AND SET SX2 1 . COMPACTION IN PROGRESS FLAG MX6 1 IX1 X1+X2 BX6 X6+X1 SA6 A1 SA1 A1+1 . ADVANCE THE REAL COUNT IX6 X1+X2 . OFCOMPACTIONS SA6 A1 WECS 3 . SO ANOTHER CPU CAN SEE THEM! SA1 A0 . TAKE STARTING ADDRESS FOR SPACE SA0 MBUFF . NICE MOVE BUFFER BX0 X1 . SEARCH MX6 0 . CLEAR THE AMOUNT OF SPACE SA6 INHAND . CURRENTLY IN HAND BX6 X5 . SAVE THE POINTER TO THE SA6 PTRPTR . WORD THE GUY THINKS HE KNOWS SA6 PTRPTRT . THE LOCATION OF SA7 TEMPX7 . YEH, YEH. AND X7 SX7 B6 . SAVE RETLINK SX6 B4 . ETC MX4 42 . GET RID OF REDUNDANT SIGN BITS BX7 -X4*X7 BX6 -X4*X6 LX7 18 BX7 X7+X6 SX6 B3 LX7 18 BX7 X7+X6 SA7 TEMPB SX6 1 SA6 I.LOCK . LOCK OUT INTERRUPTS * * BEGINNING IN THE MIDDLE, WE HAVE, * X0 = A(SOME BLOCK), NOT PFB1 * INHAND = 0 * I.LOCK IS SET (NON-ZERO) * * * * REGISTER USAGE IS ROUGHLY LIKE * X1 = FROM * X2 = TO * X4 = MX4 39 * * FIND FIRST AVAILABLE SPACE, FREE BLOCK OR BLOCK WITH SLOP * SB3 COMP1 . EXIT FROM RUNINT LOOP MX5 IP.SLOP . MASK FOR ISOLATION OF SLOP FIELD LX5 60-18+IP.SLOP . PROPERLY POSITIONED MX4 39 . PERMANENT MASK FOR SIZE FIELDS COMP1 RECS 1 . READ BLOCK HEADER SA3 A0 NG X3,COMP4.0 . AHAH - A FREE BLOCK BX6 X5*X3 . ISOLATE SLOP NZ X6,COMP4.00 . JUMP IF SLOP HERE BX6 -X4*X3 . ISOLATE BLOCK SIZE IX0 X0+X6 . ADVANCE A(BLOCK) TO NEXT BLOCK ZR X6,DISAS . MAYBE DONT DO THIS SA3 I.WAIT . CHECK FOR PENDING INTERRUPT ZR X3,COMP1 . NO, KEEP SEARCHING * * WAIT FOR A PENDING INTERRUPT TO OCCUR * COMP2 MX6 0 . UNLOCK INTERUPTS SA6 I.LOCK SB5 I.PAUSE . DELAY TIME ALLOWED FOR INTERRUPTS COMP3 SA3 I.WAIT . SEE IF STILL WAITING SB5 B5-1 EQ B5,B0,DISAS . INTERRUPT DIDNT OCCUR FAST ENUF NZ X3,COMP3 . JUMP IF STILL WAITING * * YES, FOLKS, AT SOME DATE FAR IN THE FUTURE, WE MAY * HAVE TO CHECK FOR SPEED FREAKS AT THIS POINT, BUT * RIGHT NOW, WE HAVE TO SETTLE FOR THESE SYMBOLIC * JOLLIES: * SA3 I.COOL . AFTER AN INTERRUPT, * NZ X3,OHOH . SOMEBODY WANTS TO RUN REAL BAD * * AFTER THAT, OHOH WILL PROBABLY TRANSFER TO A WELL * KNOWN PLACE OR THE ADDRESS SPECIFIED IN I.COOL OR * SOMETHING. * SX6 1 .RELOCK INTERRUPTS SA6 I.LOCK JP B3 . BACK TO COMPACTIONINGIFYING * * SET UP TO START MOVING WHEN THE FIRST AVAILABLE SPACE WAS SLOP * COMP4.00 BX1 X0 . SET UP FROM BX2 X1 . AND TO ADDRESSES SA3 PTRPTRT . IF WERE ALREADY PAST THE POINTER, IX3 X3-X2 . WE DONT HAVE TO RELOCATE IT. PL X3,COMP7 . BUT WERE NOT BX6 X2 . HOORAY, TURN OFF THE LATER TESTING LX6 21 . BY PUTTING IN A RATHER LARGE ADDRESS SA6 A3 EQ COMP7 . NOW GO TO THE MOVE LOOP * * SET UP TO START MOVING WHEN THE FIRST AVAILABLE SPACE WAS A FB * COMP4.0 BX2 X0 . SET UP TO ADDRESS SA5 PTRPTRT . SEE SIMILAR MANIPULATIONS ABOVE IX5 X5-X2 PL X5,*+2 + BX6 X2 LX6 21 SA6 A5+0 * * DECHAIN A FREE BLOCK * * X0 = A(FREE BLOCK HEADER) * X4 = MX4 39 * X3 = FB HEADER WORD * COMP4 BX6 -X4*X3 . BLOCK SIZE SA3 INHAND . ADD BLOCK SIZE TO SPACE IN HAND IX7 X6+X3 SA7 A3 IX1 X0+X6 . A(NEXT BLOCK) SX0 2 . GET A(FB TRAILER) IX0 X1-X0 RECS 2 . READ TRAILER SA3 FINFO+FS.NFBLK . ONE LESS FB SX7 X3-1 SA7 A3 SA3 FINFO+FS.SPACE . AND LESS FREE SPACE IX7 X3-X6 SA7 A3 * SA3 A0 . BEND PPTR IN NEXT FB BX5 X4*X3 . 39 BITS IS AS GOOD AS 30 AX3 30 BX7 X3 . SET NEW HEAD OF FREE CHAIN SX0 1 IX0 X0+X3 SA0 A0+1 WECS 1 . WRITE NEW PPTR SA7 FINFO+FS.FPTR SA3 A0 . BEND NPTR IN PREVIOUS FB BX0 X3 RECS 1 . READ OLD PPTR WORD SA3 A0 . PRESERVE SIZE FIELD BX6 -X4*X3 BX6 X6+X5 . STICK IN NEW NPTR SA6 A0 WECS 1 . WRITE NEW NPTR SA0 A0-1 . RESTORE THE ALL-IMPORTANT REGISTER * * READ HEADER FROM NEXT BLOCK * BX0 X1 . READ BLOCK HEADER COMP7 RECS IP.AWDS SA3 A0 . HEADER WORD NG X3,TWOFB . CONSECUTIVE FBS DISASTER COMP5 BX7 -X4*X3 . BLOCK SIZE ZR X7,COMPL . BETTER BE PFB2 BX6 X3 . SAVE IT AX3 21 . GET BACK POINTER * * UPDATE POINTER TO THIS BLOCK * BX0 -X4*X3 . READ POINTER RECS 1 SX7 IP.AWDS IX7 X7+X2 . NEW A(OBJECT) SA3 A0 BX3 X4*X3 . OUT WITH THE OLD, BX7 X7+X3 . IN WITH THE NEW SA7 A3 WECS 1 . WRITE NEW POINTER WORD * * ELIMINATE SLOP FROM BLOCK * BX0 X6 . SAVE IT AGAIN?? AX0 IP.SLOP+24 SX0 X0 . ISOLATE SLOP NG X0,BIGSLOP . CANT BE THAT MUCH AX0 18-IP.SLOP . POSITION SLOP SB3 X0 . PRESERVE SLOP FOR LATER ZR X0,COMP6 . SKIP IF NO SLOP IX6 X6-X0 . REMOVE SLOP FROM BLOCK SIZE SA3 FINFO+FS.SLOP . ACCOUNT FOR THE SLOP IX7 X3-X0 SA7 A3 NG X7,LOST . OH DEAR SA3 INHAND . AND ADD IT TO SPACE IN HAND IX7 X0+X3 SA7 A3 LX0 42 . ELIMINATE SLOP FIELD IX6 X6-X0 * * FINISH REVAMPING BLOCK HEADER * COMP6 MX7 2 BX6 -X7*X6 . CLEAR BLOCK BITS SA6 A0 . STORE NEW HEADER BX7 -X4*X6 . SAVE BLOCK SIZE FOR MOVE LOOP BX0 X2 . WIRTE HEADER WORDS WECS IP.AWDS * * CHECK FOR HIDEOUS SPECIAL BLOCK TYPES * LX6 18-IP.SLOP-2 NG X6,DAESTUFF . FUDGE A DAE BLOCK LX6 1 SB5 I.1MOVE+100 . VALUE FOR TO SKIP POINTER STUFF + PL X6,*+1 . SKIP IF NOT FILE PTR BLOCK SB5 0 . VALUE TO DO POINTER STUFF SB4 1 . WORKS AS INCR FOR PTR BLOCKS SA3 A0+1 . BUT IF ITS A FILE DESCRIPTOR, PL X3,COMP6.1 . (WHICH THIS ONE ISNT) SB4 I.1MOVE+100 . WE ONLY WANT TO RELOCATE SB5 0 . ONE POINTER * * ACCOUNT FOR WORDS MOVED AND INITIALIZE LOOP * COMP6.1 SB6 I.1MOVE . SIZE OF MOVE BUFFER SX3 IP.AWDS . ACCOUNT FOR HEADER WORDS ALREADY MOVED IX7 X3-X7 . CHANGE SIGN OF TALLY IX1 X1+X3 IX2 X2+X3 SX3 B6 * * MOVE LOOP * COMP8 BX0 X1 IX7 X7+X3 . TALLY SX3 IP.AWDS . FOR USE IN POINTER LOOP BELOW + NG X7,*+1 . SKIP IF LOTS TO MOVE BX5 -X7 SB6 X5+B6 . SUBSTITUTE COUNT FOR LAST MOVE RECS B6 GE B5,B6,COMP10 . SKIP IF NO PTRS TO RELOCATE * * RELOCATE BACK POINTERS TO THIS (FILE) POINTER BLOCK * SA0 JUNK . AVOID CLOBBERING PTR BLOCK COMP9 SA5 MBUFF+B5 . GET A(BLOCK POINTED TO) ZR X5,COMP9.1 . SKIP IF NO POINTER NG X5,COMP9.1 . SKIP IF END MARKER BX0 -X4*X5 IX0 X0-X3 RECS 1 . READ WORD WHICH BACK POINTS HERE SX6 B5 . COMPUTE NEW ECS ADDR OF POINTER WORD IX6 X2+X6 SA5 A0 . PICK UP BACK POINTER WORD LX5 60-21 BX5 X4*X5 . OUT WITH THE OLD, BX6 X6+X5 . IN WITH THE NEW LX6 21 . REPOSITION SA6 A0 WECS 1 . WRITE NEW BACK POINTER WORD COMP9.1 SB5 B5+B4 . ADVANCE POINTER TALLY LT B5,B6,COMP9 SB5 B0+0 . RESET COUNT FOR NEXT TIME SA0 MBUFF . RESTORE ALL-IMPORTANT REG * * COMP10 BX0 X2 SX3 B6 IX1 X1+X3 ADVANCE ADDRESSES IX2 X2+X3 WECS B6 . MOVE THE WORDS NG X7,COMP8 * * SEE IF WE JUST MOVED THE BLOCK CONTAINING THE POOR CALLERS POINTER * (AND TELL HIM IF WE DID) * SA3 PTRPTRT IX6 X3-X1 PL X6,COMP12 . NO, WE DIDNT JUST PASS IT IX6 X1-X2 . THIS IS HOW FAR DOWN IT MOVED IX6 X3-X6 . SO NOW ITS HERE SA6 PTRPTR LX6 21 . TRY TO AVOID MULTIPLE, EMBARRASING SA6 A3 . RELOCATIONS COMP12 SX0 B3 . ADVANCE PAST ANY SLOP AT END OF BLOCK IX1 X1+X0 SA3 I.WAIT . SEE IF INTERRUPT PENDING SB3 COMP11 NZ X3,COMP2 COMP11 BX0 X1 RECS IP.AWDS . READ NEXT OBJECT HEADER SA3 A0 PL X3,COMP5 . ITS ANOTHER BLOCK TO MOVE EQ COMP4 . ITS A FB TO DECHAIN * * NOW WEVE FOUND AN OBJECT OF SIZE 0, AND IF ITS PFB2, * WERE IN GOOD SHAPE. * COMPL RECS 3 . READ UP THE WHOLE OBJECT TO HAVE SA5 A0+1 . A GOOD LOOK AT IT MX6 1 . SET UP A PRECEDING BLOCK FREE BIT LX6 60-1 BX3 -X6*X3 . TURN OFF THAT BIR IN PFB2 HEADER BX5 X5-X3 . FOR COMPARISON PURPOSES NZ X5,LOST . THIS IS NOT PFB2 BX6 X3+X6 . SET PRECEDING BLOCK FREE BIT SA6 A0 WECS 1 . REFURBISH PFB2 SA5 A5+1 . ON E MORE CHECK - NPTR AND PPTR LX5 30 IX6 X5-X3 . SHOULD BOTH POINT TO PFB1 NZ X6,LOST SA3 INHAND MX6 1 BX6 X6+X3 . PREPARE THE HEADER FOR THE NEW FB SA6 A0 BX0 X2 WECS 1 . AND WRITE IT OUT SA2 FINFO+FS.FPTR SX0 1 * * BEND THE PPTR IN THE HEAD FB TO POINT TO THE NEW FB * IX0 X2+X0 RECS 1 . READ PPTR WORD FROM HAED FB SX6 2 . CALCULATE A(TRAILER) FOR NEW FB * X6 = A(TRAILER) OF NEW FB IX6 X1-X6 SA1 A0 . SAVE PPTR FOR TO BEND TAIL FB SA6 A1 WECS 1 . WRITE NEW PPTR IN (OLD) HEAD BX0 X1 BX7 X1 . SAVE PPTR FOR NEW FB SA7 A0+1 * * BEND THE NPTR IN THE TAIL FB TO POINT TO THE NEW FB * RECS 1 . READ NPTR WORD FROM TAIL FB SA1 A0 BX7 -X4*X1 . PRESERVE THE SIZE FIELD LX6 30 BX7 X6+X7 . STICK IN NEW NPTR LX6 30 SA7 A0 WECS 1 . WRITE UPDATED NPTR WORD * * SET UP FIRST TRAILER WORD FOR NEW FB * (THE SECOND ONE IS ALREADY THERE) * BX7 X4*X1 . USE NPTR FORM OLD TAIL BX7 X7+X3 . STICK IN SIZE SA7 A0 BX0 X6 WECS 2 . WRITE NEW FB TRAILER * * COUNT THE NEW FB AND SET IT AS THE HEAD OF THE FREE CHAIN * SA6 FINFO+FS.FPTR SA1 FINFO+FS.NFBLK NZ X1,LOST . ANOTHER FIRE VANCE IN 71 KLUDGE SX7 X1+1 SA7 A1 SA1 FINFO+FS.SPACE . SET UP NEW FREE SPACE NZ X1,LOST . YET ANOTHER IX7 X1+X3 SA7 A1 * * RESTORE THE COMPACTING CONSTANTS, ETC. * SA1 COMPTMP+1 . CLEAR THE COMPACTING IN PROGRESS MX7 1 . FLAG BX7 -X7*X1 SA7 A1 SX0 EC.FLOR SA0 COMPTMP WECS 3 . WRITE THE STUFF OUT SX0 EC.FINFO SA0 FINFO . WRITE THE FREE STUFF OUT WECS FS.SIZE SA5 TEMPX7 BX7 X5 SA5 TEMPB . GET RETLINK SB3 X5 . ETC AX5 18 SB4 X5 AX5 18 SB6 X5 SA5 PTRPTR * * CALCULATE TIME SPENT COMPACTING. ADD TO TOTAL COMPACTION TIME * AND SUBTRACT FROM CHARGE CLOCK (SO USER WON'T BE CHARGED). * SA1 S.MASTR SA2 L.CLAST IX1 X1-X2 . TIME CONSUMED SA2 L.CTOTL . INCREMENT TOTAL COMPACTION TIME IX6 X2+X1 SA6 A2 SA2 S.CHARG . DECREMENT CHARGE CLOCK IX6 X2-X1 SA6 A2 EQ COMP00 . HOP OUT OF THE BUFFER * * MISCELLANEOUS COMPACTOR DISASTERS * BIGSLOP RJ DISASTR LOST RJ DISASTR DAESTUFF RJ DISASTR DISAS RJ DISASTR TWOFB RJ DISASTR * I.1MOVE EQU 100B MBUFF BSSZ I.1MOVE * * TEMPORARY STORAGE * INHAND BSSZ 1 PTRPTR BSSZ 1 PTRPTRT BSSZ 1 TEMPX7 BSSZ 1 . YOU GUESSED IT TEMPB BSSZ 1 . OOOOOOOHHH, NNNOOOOOOOO JUNK BSSZ 1 . TEMP FOR FILE PTR RELOCATION COMPSIZ EQU *+1-BUFA . BUFFER SPACE REQD FOR COMPACTOR IFGT COMPSIZ,P.PBUFL,1 ERR COMPACTOR TOO LARGE FOR PARMBUF * * * UNFORTUNATELY, ENDSUB CHECKS AGAINST THE BUFFER LENGTH AND * THE COMPACTOR RUNS INTO SEVERAL BUFFERS, SO HERE WE STIRE ECSSUB * OUT LONGHAND WITH THE APPROPRIATE CHECK. * BSS 0 L.COMP0 EQU *-BUFA IFGT L.COMP0,BUFA.S+BUFB.S,1 ERR COMPACTOR TOO LARGE FOR CM BUFFERS USE * COMP0 SA0 BUFA SX0 0 RECS L.COMP0 EQ BUFA * END OF PSEUDO-MACRO SPACE 5 COMP00 SA0 BUFA . RESTORE CODE TO LOW CORE BUFFERS SX0 PARMBUF RECS COMPSIZ JP B3 . RETURN TO CALLER TITLE DISPLAY AN ALLOCATION BLOCK * * THE AB.SIZE WORDS OF THE INDICATED AB ARE COPIED INTO * THE CALLERS ADDRESS SPACE. NONE ARE TRANSFERED IF HIS * FL WOULD BE EXCEEDED. * * PARAMETERS - * AP1 C: ALLOCATION BLOCK TO BE DISPLAYED * AP2 D: PTR TO BUFFER * AP3 D: BUFFER SIZE * ECSCODE DSPAB DSPAB SB7 DSPAB1 . CHECK OUT THE BUFFER HE OFFERED SA1 B1+P.PARAM+3 SB6 X1+0 SA1 B1+P.PARAM+2 EQ =XCHKPTR * * CHKPTR PROVIDES A0=A(BUFFER) * DSPAB1 RESERVE ALLOCBLK SB7 A0 . PRESERVE A(BUFFER) SA0 S.ABLOCK . PLACE FOR AB SA5 B1+P.PARAM+1 . AB CAP TO X5 FO ABREAD SB5 DSPAB2 EQ ABREAD . READ THE AB DSPAB2 SB5 DSPAB3 EQ CHARG . UPDATE THE CHARGE METERS DSPAB3 WECS AB.SIZE . WRITE OUT THE UPDATED AB SB5 AB.SIZE SA1 B1+P.PARAM+3 SB6 X1 . GET SIZE OF PROFERED BUFFER LE B5,B6,DSPAB4 SB5 B6 . USE BUFFER SIZE IF LESS THAN AB SIZE DSPAB4 SA0 B7 . RETRIEVE A(BUFFER) RECS B5 . GIVE HIM THE GOODS RELEASE ALLOCBLK EQ SYSRET ENDECS DSPAB TITLE DESTROY AN ALLOCATION BLOCK * * IF OBJECTS ARE CHARGED TO THE AB, THE ACTION F-RETURNS. * IF NOT, ITS RESOURCES ARE RETURNED TO ITS * FATHER AND IT IS DESTROYED * * PARAMETERS - * AP1 C:ALLOCATION BLOCK TO BE DESTROYED * ECSCODE DELAB RESERVE ALLOCBLK SA5 B1+P.PARAM+1 . AB CAP FOR ABREAD * X5 USED BY DELOBJ BELOW SB5 DELAB1 SA0 S.ABLOCK EQ ABREAD . READ THE AB INTO S.ABLOCK DELAB1 SA1 S.ABLOCK+AB.CHAIN NZ X1,SYSFRET . F-RETURN IF AB HAS CHILDREN SX1 IP.AWDS-1 IX0 X0-X1 SA0 B1 RECS 1 . READ HEADER WORD SA1 A0+0 AX1 36 . GET MOT OF OWNING AB SX0 X1 RECS 1 . READ MOT OF FATHER SA1 A0+0 MX0 39 BX0 -X0*X1 RECS AB.SIZE . READ FATHER SA1 S.ABLOCK+AB.ECS MX3 30 BX2 -X3*X1 . ISOLATE IN USE LX2 30 AX2 30 . SIGN EXTENSION AX1 30 IX1 X2-X1 . DIFFERENCE IS WHATS AVAILABLE SA2 A0+AB.ECS . RETURN RESERVED SPACE INCUSE 2,1,4,FIELDER,FIELDER SA6 A2 SA1 S.ABLOCK+AB.CPAVL . RETURN CP TIME AVAILABLE SA2 S.ABLOCK+AB.CPUSD IX1 X2-X1 . RESERVED-USED IS WHATS AVAILABLE SA2 A0+AB.CPUSD IX6 X2-X1 . RETURN TIME NO LONGER COMMITTED SA6 A2 . TO SON AB SA1 S.ABLOCK+AB.MOT BX2 -X3*X1 . ISOLATE IN USE LX2 30 AX2 30 . SIGN EXTENSION AX1 30 IX1 X2-X1 . RETURN THE DIFFERENCE SA2 A0+AB.MOT . RETURN MOT SLOTS INCUSE 2,1,4,KLUDGE2,FIELDER KLUDGE2 BSS 0 . FIELDER SA6 A2 WECS AB.SIZE . WRITE OUT UPDATED FATHER RELEASE ALLOCBLK SB7 SYSRET EQ DELOBJ . DESTROY THE AB AND EXIT ENDECS DELAB TITLE TRANSFER RESERVED SPACE FROM ONE AB TO ANOTHER * * DONATE MOVES SPACE FROM ON AB AND GIVES IT TO ANOTHER. * ONE AB MUST BE THE FATHER OF THE OTHER, OR THEY MUST * BE THE SAME AB. * IF THE DONOR CANT AFFORD THE REQUESTED AMOUNT, THE REQUEST * IS REDUCED TO THE AMOUNT HE CAN AFFORD BEFORE THE TRANSFER * TAKES PLACE; THIS CONDITIN IS SIGNALLED BY AN F-RETURN * WITH THE AMOUNT ACTUALLY TRANSFERED RETURNED IN X6. * * PARAMETERS - * AP1 C: DONOR ALLOCATION BLOCK * AP2 C: DONEE ALLOCATION BLOCK * AP3 D:CHARGED SPACE TO BE TRANSFERED, MUST BE + * * DONATION = MIN(AP3,AMOUNT DONOR CAN AFFORD) * IF FATHER = DONOR, DONATION = DONATION ELSE DONATION = -DONATION * FATHER IN USE = FATHER IN USE + DONATION * SON RESERVED = SON RESERVED + DONATION * SON CHARGE RATE = CHARGE RATE + DONATION * * ECSCODE DONAT RESERVE ALLOCBLK . RESERVE ALLOCATION BLOCKS * * GET DONOR AND DONEE AND CHECK THEM OUT * SB7 DONAT1 EQ FATSON * * FIX UP FATHER ECS WORD * DONAT1 SB7 SYSRET . ASSUME NORMAL EXIT DONAT3 SA3 B5+IP.AWDS-1+AB.ECS . ECS WORD OF FATHER MX4 30 BX6 -X4*X3 . ISOLATE IN USE LX6 30 . SIGN EXTENSION AX6 30 IX6 X6+X1 . PROPSED IN USE AX3 30 . RESERVED FOR COMPARE IX5 X3-X6 . CAN HE STAND IT? NG X5,DONAT2 . SORRY, HE CANT BX5 X6 . DID THE FIELD GET OUT OF HAND? AX5 IP.SLIM NZ X5,DONAT5 . SORRY, IT DID LX3 30 . REPOSITION RES BX6 -X4*X6 . ELIMINATE XTRA SIGN BITS BX3 X4*X3 BX6 X6+X3 . PROPOSED ECS WORD FOR FATHER * * FIX UP SON ECS WORD * SA3 B2+IP.AWDS-1+AB.ECS . ECS WORD OF SON BX7 -X4*X3 . ISOLATE IN USE LX7 30 . SIGN EXTENSION AX7 30 AX3 30 . ISOLATE RESERVED IX3 X3+X1 . PROPOSED RESERVED IX5 X3-X7 . CAN HE STAND IT? NG X5,DONAT4 . NO BX5 X3 . DID THE FIELD GET OUT OF HAND? AX5 IP.SLIM NZ X5,DONAT5 . YES LX3 30 . REPOSITION RES BX7 -X4*X7 . ELIMINATE XTRA SIGN BITS BX3 X4*X3 BX7 X7+X3 . PROPOSED ECS WORD FOR SON SA7 A3 . SET SON ECS WORD SA6 B5+IP.AWDS-1+AB.ECS . SET FATHER ECS WORD BX6 X1 . ACTUAL AMOUNT MOVED TO X6 SA6 B1+P.TEMP1 . SAVE FOR LATER PL X6,DONAT6 . BX6 -X1 . OOPS, SIGN WAS CHANGED DONAT6 SA6 B1+P.XPACK+14 . CURRENTLY RETURNED IN X6 * * INCREMENT SON CHARGE RATE * (FIRST, INCREMENT CHARGE METERS) * BX7 X2 . SAVE ECS A(DONEE) SB5 DONAT7 . RETLINK SA0 B2+IP.AWDS-1 . WHERE SON IS EQ CHARG DONAT7 SA5 B2+IP.AWDS-1+AB.TIML . WORD WITH CHARGE RATE MX4 30 BX6 X4*X5 . SAVE TIME OF LAST BILL BX5 -X4*X5 . ISOLATE CHARGE RATE LX5 30 . SIGN EXTENSION AX5 30 SA1 B1+P.TEMP1 . RETRIEVE INC FOR CRG RATE IX5 X5+X1 . PROPOSED CHARGE RATE BX4 -X4*X5 . ELIMINATE XTRA SIGN BITS AX5 IP.SLIM . DID THE FIELD GET OUT OF HAND? NZ X5,DONAT5 . YES BX6 X4+X6 . RECOMBINE FIELDS SA6 A5 * * REWRITE DONEE AND DONOR ABS * SA0 B1+IP.AWDS-1+AB.SIZE WECS AB.SIZE+IP.AWDS-1 SA0 B1+IP.AWDS-1 BX0 X7 WECS AB.SIZE RELEASE ALLOCBLK JP B7 . TAKE APPROPRIATE EXIT * * CUT THE DONATION, IT WAS TOO LARGE * DONAT4 BX5 -X5 . REVERSE X5 CAUSE X1 IS NEG DONAT2 IX1 X1+X5 . DECREASE THE DONATION TO WHAT SB7 SYSFRET . THE TRAFFIC WILL BEAR AND TAKE EQ DONAT3 . AN F-RETURN * * ONE OF THE FIELDS IN ONE OF THE ABS GOT OUT OF HAND * DONAT5 SX5 1 . ASSUME DONOR SB7 A3-IP.AWDS+1-AB.ECS EQ B7,B1,DONAT5.1 . RIGHT ON SX5 2 . NO, DONEE IS FOULED UP DONAT5.1 LX5 18 SX7 E.CRGER BX7 X5+X7 SX6 E.ABLOCK EQ E.ERROR ENDECS DONAT TITLE FATSON * * THIS ROUTINE READS THE DONOR AND DONEE ALLOCATION BLOCKS * FOR THE RESERVED SPACE, CP TIME, AND MOT SLOT TRANSFER * ROUTINES. IT MAKES SURE BOTH BLOCKS EXIST AND THAT ONE IS * THE FATHER OF THE OTHER. IT LEAVES THEM IN CM AND * LEAVES VARIOUS REGISTERS SET TO WRITE THEM OUT AGAIN. * IF THE BLOCKS ARE IDENTICAL, IT DOES A NORMAL RETURN * TO THE USER * * AT EXIT * X1 = DONATION (OR -DONATION IF SON IS DONOR) * B2 = CM A(SON) * B5 = CM A(FATHER) * X2 = ECS A(DONOR) * X0 = ECS A(DONEE) * B1 = CM A(DONOR) * A0 = CM A(DONEE) * DONOR IS AT B1 * DONEE IS AT B1+AB.SIZE+IP.AWDS-1 * * ECSSUB FATSO,BUFA * * READ DONOR * SA1 B1+P.PARAM+1 SX0 X1 . DONOR MOT SA0 B1 RECS 1 SB2 X0 * B2 = DONOR MOT SA2 A0 BX3 X1-X2 MX7 39 BX3 X7*X3 BX2 -X7*X2 * X2 = ECS A(DONOR) SX5 IP.AWDS-1 . READ DONOR, INCLUDING HEADER WORD SB3 B0 . CLUE AS TO OFFENDER NZ X3,FATSON2 . SORRY, DONOR GONE IX0 X2-X5 RECS AB.SIZE+IP.AWDS-1 * * READ DONEE * SA0 A0+AB.SIZE+IP.AWDS-1 SA3 B1+P.PARAM+3 . READ DONEE MOT SX0 X3 SB4 X0 SB3 1 . NEW OFFENDER CLUE * B4 = MOT OF DONEE RECS 1 SA4 A0 CHECK UNIQUE NAME BX6 X4-X3 BX6 X7*X6 NZ X6,FATSON2 . SORRY, DONEE GONE * * IF SAME AB (B2 = B4), WE ARE DONE * EQ B2,B4,SYSRET BX4 -X7*X4 IX0 X4-X5 * X0 = ECS A(DONEE)-IP.AWDS+1 RECS AB.SIZE+IP.AWDS-1 . READ DONEE, INCLUDING HEADER * * SEE IF ONE IS THE FATHER OF THE OTHER * SA3 A0 . GET MOT OF FATHER OF DONEE AX3 36 SB3 X3 EQ B3,B2,FATSON1 . OK, DONOR IS FATHER OF DONEE SA3 B1 . GET MOT OF FATHER OF DONOR AX3 36 SB3 X3 EQ B3,B4,FATSON1 . OK, DONEE IS FATHER OF DONOR SX7 E.FATSON . TROUBLE WITH FATHER/SON RELATIONSHIP EQ CL6 FATSON1 SA1 B1+P.PARAM+4 . ALL DONATIONS ARE + NG X1,FATSON3 . (IS THIS ONE???) * * SET UP B5=FATHER, B2=SON * SB5 B1 . FATHER IS DONOR (PROVISIONALLY) SB2 A0 . SON IS DONEE (PROVISIONALLY) NE B3,B4,FATSON4 . SKIP IF FATHER IS DONOR SB5 A0 . FATHER IS DONEE SB2 B1 . SON IS DONOR BX1 -X1 . AND THE DONATION GOES IN REVERSE FATSON4 JP B7 * * FATSON2 SX6 B3+1 . INDEX OF OFFENDER SX7 E.NOABLK LX6 18 BX7 X6+X7 SX6 E.ABLOCK EQ E.ERROR FATSON3 SX7 E.NEGPAR SX6 3 LX6 18 BX7 X6+X7 SX6 E.PARMS EQ E.ERROR ENDSUB FATSO,BUFA FATSON EQU FATSO TITLE TRANSFER CP TIME FROM ONE AB TO ANOTHER * * MOVCP TRANSFERS CP TIME FORM ON AB TO ANOTHER. ONE MUST * BE THE FATHER OF THE OTHER (UNLESS THEY ARE THE SAME AB), * AND THE DONOR MUST HAVE ENUF TO COVER THE DONATION * * PARAMETERS: * AP1 C:DONOR ALLOCATION BLOCK * AP2 C:DONEE ALLOCATION BLOCK * AP3 D:CP MICRO-SECONDS TO TRANSFER, MUST BE + * * IF FATHER = DONOR DONATION = DONATION ELSE DONATION = -DONATION * FATHER CP USED = CP USED + DONATION * SON CP AVIL = CP AVIL + DONATION * * ECSCODE MOVCP RESERVE ALLOCBLK * * GET THE AB'S AND CHECK THEM OUT * SB7 MOVCP1 EQ FATSON * * FIX UP FATHER CP USED WORD * MOVCP1 SA3 B5+IP.AWDS-1+AB.CPUSD IX6 X3+X1 . FATHERS CP USED WORD SA6 A3 SA3 B5+IP.AWDS-1+AB.CPAVL IX3 X3-X6 NG X3,MOVCP2 . SORRY, NOT ENUF TO COVER DONATION * * FIX UP SONS CP AVAIL WORD * SA3 B2+IP.AWDS-1+AB.CPAVL IX6 X3+X1 SA6 A3 SA3 B2+IP.AWDS-1+AB.CPUSD IX3 X6-X3 NG X3,MOVCP2 . SORRY, NOT ENUF TO COVER DONATION * * REWRITE DONEE AND DONOR AND EXIT * WECS AB.SIZE+IP.AWDS-1 SA0 B1+IP.AWDS-1 BX0 X2 WECS AB.SIZE RELEASE ALLOCBLK EQ SYSRET * * MOVCP2 SX7 E.NOCP EQ CL6 ENDECS MOVCP TITLE TRANSFER MOT SLOTS FROM ONE AB TO ANOTHER * * MOVMT IS LIKE DONAT EXCEPT THAT IT TRANSFERS MOT SLOTS. * ECSCODE MOVMT RESERVE ALLOCBLK SB7 MOVMT1 EQ FATSON * * FIX UP FATHERS MOT SLOT WORD * MOVMT1 SB7 SYSRET . ASSUME NORMAL EXIT MOVMT3 SA3 B5+IP.AWDS-1+AB.MOT . MOT WORD OF FATHER MX4 30 BX6 -X4*X3 . ISOLATE IN USE LX6 30 . SIGN EXTENSION AX6 30 IX6 X6+X1 . PROPOSED IN USE AX3 30 . RESERVED FOR COMPARE IX5 X3-X6 . CAN HE STAND IT? NG X5,KLUDGE3 . SORRY HE CANT KLUDGE3 BSS 0 . MOVMT2 BX5 X6 . DID THE FIELD GET OUT OF HAND? AX5 IP.SLIM NZ X5,MOVMT5 . SORRY, IT DID LX3 30 . REPOSITION RES BX6 -X4*X6 . ELIMINATE XTRA SIGN BITS BX3 X4*X3 BX6 X6+X3 . PROSPOSED MOT WORD FOR FATHER * * FIX UP SON MOT WORD * SA3 B2+IP.AWDS-1+AB.MOT . MOT WORD OF SON BX7 -X4*X3 . ISOLATE IN USE LX7 30 . SIGN EXTENSION AX7 30 AX3 30 . ISOLATE RESERVED IX3 X3+X1 . PROPOSED RESERVED IX5 X3-X7 . CAN HE STAND IT? NG X5,KLUDGE4 . NO KLUDGE4 BSS 0 . MOVMT4 BX5 X3 . DID THE FIELD GET OUT OF HAND? AX5 IP.SLIM NZ X5,MOVMT5 . YES LX3 30 . REPOSITION RES BX7 -X4*X7 . ELIMINATE XTRA SIGN BITS BX3 X4*X3 BX7 X7+X3 . PROPOSED MOT WORD FOR SON SA7 A3 . SET SON MOT WORD SA6 B5+IP.AWDS-1+AB.MOT . SET FATHER MOT WORD * * INCREMENT SON CHARGE RATE * SA5 A3+AB.MCHG-AB.MOT . GET MOT CHARGE RATE BX5 -X4*X5 . ISOLATE CHARGE RATE LX5 30 . SIGN EXTENSION AX5 30 IX5 X5+X1 . PROPOSED CHARGE RATE BX6 -X4*X5 . ELIMINATE XTRA SIGN BITS AX5 IP.SLIM . DID THE FIELD GET OUT OF HAND? NZ X5,MOVMT5 . YES SA6 A5 * * REWRITE DONEE AND DONOR ABS * WECS AB.SIZE+IP.AWDS-1 SA0 B1+IP.AWDS-1 BX0 X2 WECS AB.SIZE RELEASE ALLOCBLK BX6 X1 . ACTUAL AMOUNT MOVED TO X6 PL X6,MOVMT6 BX6 -X1 . OOPS, SIGN WAS CHANGED MOVMT6 SA6 B1+P.XPACK+14 . CURRENTLY RETURNED IN X6 JP B7 . TAKE APPROPRIATE EXIT * * CUT THE MOVMTION, IT WAS TOO LARGE * MOVMT4 BX5 -X5 . REVERSE X5 CAUSE X1 IS NEG MOVMT2 IX1 X1+X5 . DECREASE THE DONATION TO WHAT SB7 SYSFRET . THE TRAFFIC WILL BEAR AND TAKE EQ MOVMT3 . AN F-RETURN * * ONE OF THE FIELDS IN ONE OF THE ABS GOT OUT OF HAND * MOVMT5 SX5 1 . ASSUME DONOR SB7 A3-IP.AWDS+1-AB.ECS EQ B7,B1,MOVMT5.1 . RIGHT ON SX5 2 . NO, DONEE IS FOULED UP MOVMT5.1 LX5 18 SX7 E.CRGER BX7 X5+X7 SX6 E.ABLOCK EQ E.ERROR ENDECS MOVMT TITLE DISPLAY OBJECT * * PARAMETERS - * AP1: C: OBJECT TO BE DISPLAYED * AP2: D: POINTER TO BUFFER * AP3: D: D LENGTH OF BUFFER * * RETURNS - * BUFFER+0 MOT OF OBJECT, EVEN IF ITS GONE * BUFFER+1,2 LAST TWO WORDS OF PREVIOUS OBJECT * BUFFER+3,4 OBJECT HEADER * BUFFER+5 FIRST WORD OF NEXT OBJECT * BUFFER+6,... WORDS FORM OBJECT UP TO BUFFER CAPACITY * ECSCODE DSPOB SA1 B1+P.PARAM+2 . PTR TO BUFFER SA3 B1+P.PARAM+3 . SIZE OF BUFFER SB6 X3 SB7 DSPOB1 JP =XCHKPTR . CHECK LEGALITY OF BUFFER DSPOB1 SA1 B1+P.PARAM+1 SX0 X1 . MOT OF OBJECT SB6 X3 . SIZE OF BUFFER RECS 1 . HE GETS THE MOT NO MATTER WHAT SB6 B6-5 LE B6,B0,SYSRET SA3 A0 BX1 X1-X3 * * TRY THE DONATION * MX2 39 BX1 X2*X1 NZ X1,SYSRET . OBJECT NO LONGER THERE BX3 -X2*X3 . ADDR OF OBJECT SA0 A0+1 SX0 -4 IX0 X0+X3 . A(LAST 2 WDS OF PREV OBJECT) RECS 4 . LAST WDS OF PREVOBJ, FIRST WORDS OF THIS OBJ SB6 B6-1 LE B6,B0,SYSRET SA1 A0+2 . GET BLOCK SIZE SX3 2 IX4 X3+X0 BX1 -X2*X1 IX0 X4+X1 SA0 A0+4 RECS 1 . 1ST WORD OF NEXT OBJECT IX0 X4+X3 . A(OBJECT) SA0 A0+1 SB2 X1-2 LE B2,B6,DSPOB2 + SB2 B6 . MIN(REMAINING BUFFER, REMAINIG OBJECT) AX1 18 . BEAUTIFUL. USES BUF SIZE WHEN OBJECT NZ X1,* . IS OBSCENELY LARGE DSPOB2 RECS B2 EQ SYSRET ENDECS DSPOB TITLE DISPLAY ALLOCATOR * * PARAMETERS - * AP1 D: PTR TO BUFFER * AP2 D: BUFFER SIZE * * RETURNS THE CURRENT ALLOCATORS CONSTANTS AND POINTERS * DESCRIBING THE STATE OF ECS. SEE ECS MAP FOR DETAILS. * THE FIRST CELL RETURNED IS EC.FLOR. * ECSCODE DSPAL SA1 B1+P.PARAM+1 . CHECK OUT BUFFER POINTER SB6 X1+0 SA1 B1+P.PARAM SB7 DSPALC1 EQ =XCHKPTR DSPALC1 SX0 =XEC.FLOR . A0 SET BY CHKPTR TO ABSOLUTE A(BUFFER) SB5 14 . SIZE OF ALLOCATOR STUFF LE B5,B6,DSPALC2 SB5 B6 . USE BUFFER SIZE IF SMALLER DSPALC2 RECS B5 . GIVE HIM THE GOODS EQ SYSRET ENDECS DSPAL TITLE INCREMENT CHARGE RATE IN ALLOCATION BLOCK * * PARAMETERS - * AP1 C: ALLOCATION BLOCK * AP2 D: INCREMENT, MAY BE + OR - * * THE CHARGE RATE IN THE INDICATED AB IS INCREMENTED BY THE * SPECIFIED AMOUNT. THE RESULTING CHARGE RATE MUST BE * GE 0 AND LT 2**30 * ECSCODE INCHR RESERVE ALLOCBLK SA0 S.ABLOCK . READ THE AB IN QUESTION SA5 B1+P.PARAM+1 SB5 INCHR1 EQ ABREAD INCHR1 SB5 INCHR2 . UPDATE THE CHARGE METERS EQ CHARG INCHR2 SA1 B1+P.PARAM+2 . GET INCREMENT SA2 A0+AB.TIML . GET WORD WITH CHARGE RATE MX3 30 BX6 X3*X2 LX2 30 . SIGN EXTENSION AX2 30 IX2 X2+X1 . NEW CHARGE RATE BX3 -X3*X2 BX6 X6+X3 . RECOMBINE WITH TIME AX2 IP.SLIM NZ X2,INCHR3 . CANT BE TOO BIG SA6 A2+0 WECS AB.SIZE . UPDATE AB IN ECS RELEASE ALLOCBLK EQ SYSRET * * INCHR3 SX7 E.CRGER . RATE MUST BE NON-NEGATIVE AND LESS EQ CL6 . THAN 2**30 ENDECS INCHR TITLE INCREMENT CHARGE METER * * INMTR ALTERS THE DISCONTINUOUS CHARGE METER IN THE * SPECIFIED AB BY THE SPECIFIED AMOUNT * * PARAMETERS - * AP1 C: ALLOCATION BLOCK * AP2 D: INCREMENT, + OR - * ECSCODE INMTR RESERVE ALLOCBLK SA0 S.ABLOCK SA5 B1+P.PARAM+1 SB5 INMTR1 EQ ABREAD . READ THE AB IN QUESTION INMTR1 SA1 A0+AB.DTS SA2 B1+P.PARAM+2 IX6 X1+X2 SA6 A1+0 WECS AB.SIZE RELEASE ALLOCBLK JP SYSRET ENDECS INMTR TITLE STEAL SPACE FROM AN AB AND GIVE IT TO ANOTHER * * GRAB INCREASES THE ECS IN USE FIELD OF THE VICTIM BY * THE REQUESTED AMOUNT, UNLESS THE RESULTING IN USE WOULD * EXCEED HIS RESERVED FIELD (THEN F-RETURN WITH * NO SPACE MOVED). IT DECREASES THE IN USE * IN THE ROBBER (UNLESS IN USE WOULD BE ABSURDLY SMALL, * THEN E.GREDY ERROR) * * PARAMETERS - * AP1 C: VICTIM ALLOCATION BLOCK * AP2 C: ROBBER ALLOCATION BLOCK * AP3 C: COMMON ANCESTOR OF 1 AND 2 * AP4 D: AMOUNT TO BE STOLEN, >=0 * * IF VICTIM IN USE + AP3 .GT. RESERVED, F-RETURN ELSE * VICTIM IN USE = IN USE + AP4 * ROBBER IN USE = IN USE - AP4 * ECSCODE GRAB RESERVE ALLOCBLK . RESERVE ALLOCATION BLOCKS * * READ VICTIM AND ROBBER * SB7 GRAB1 . AND CHECK SUPPOSED ANCESTOR EQ RELAT * * SEE IF VICTIM CAN STAND IT ( YOU CANT GET BLOOD * OUT OF A TURNIP, YOU KNOW). * GRAB1 SA3 B1+P.PARAM+6 . PROPOSED HAUL NG X3,GRAB4 . NONO SA1 B1+AB.ECS . INCREMENT VICTIM IN USE INCUSE 1,3,2,SYSFRET,GRAB2 SA6 A1 * * GIVE THE TAKE TO THE ROBBER * SA1 B1+AB.SIZE+1+AB.ECS . ROBBER ECS WORD BX3 -X3 . DECREMENT ROBBER FIELD INCUSE 1,3,2,GRAB2,GRAB3 SA6 A1 LX6 30 AX6 30+IP.SLIM-1 + PL X6,*+1 . FIELD STILL BIG ENUF NZ X6,GRAB3 . NOT BIG ENUF SA0 B1+AB.SIZE+1 SA1 A0+AB.SIZE BX0 X1 WECS AB.SIZE . WRITE OUT ROBBER SA1 B1+AB.SIZE BX0 X1 SA0 B1 WECS AB.SIZE . WRITE OUT VICTIM RELEASE ALLOCBLK EQ SYSRET * * PROBLEMS * GRAB3 SX6 E.ABLOCK . ROBBER IN USE GOT TOO SMALL SX7 E.GREDY EQ E.ERROR GRAB4 SX6 E.PARMS . NEGATIVE DONATION SX7 E.NEGPAR EQ E.ERROR GRAB2 EQU FIELDER . DISASTER ENDECS GRAB TITLE READ 2 ABS AND CHECK COMMON ANCESTOR * * THIS ROUTINE DOES THE DIRTY WORK FOR GRAB AND GRABM: READS * AP1 INTO B1 FOLLOWED BY ITS ECS ADDRESS AND AP2 INTO * B1+AB.SIZE+1 FOLLOWED BY ITS ECS ADDRESS. IT CHECKS THAT * AP3 IS THEIR COMMON ANCESTOR. * ERROR IF AP1 OR AP2 IS GONE OR IF AP3 NOT THEIR COMMON ANCESTOR * ECSSUB RELAT,BUFA * * LOOP INITILAIZATION * SA5 B1+P.PARAM+5 SX7 X5 . GET MOT OF PROPOSED COMMON ANCESTOR SX3 IP.AWDS . CONSTANTS USED THROUGHOUT MX2 39 SB2 -1 . TALLY SA0 B1 . PLACE FOR AP1 SA5 B1+P.PARAM+1 . MOT OF AP1 * * LOOP * RELAT1 SX0 X5 . READ MOT RECS 1 SA1 A0 BX6 X1-X5 BX6 X2*X6 . CHECK UNIQUE NAMES NZ X6,RELAT4 . AB IS GONE BX0 -X2*X1 READ THE AB BX6 X0 RECS AB.SIZE SA6 A0+AB.SIZE . SAVE ECS A(AB) * * SEE IF AP3 IS AN ANCESTOR * SA0 A0+AB.SIZE+1 SX0 X5 . MOT OF CURRENT AB RELAT2 IX1 X0-X7 . CHECK AGAINST PROPOSED ANCESTOR ZR X1,RELAT3 . FOUND IT RECS 1 . READ MOT OF CURRENT AB SA1 A0+0 BX0 -X2*X1 IX0 X0-X3 . READ HEADER WORDS OF CURRENT AB RECS IP.AWDS SA1 A0+1 . WORD WITH OWNING AB POINTER AX1 36 SX0 X1 . CURRENT AB _ OWNER OF CURRENT AB NZ X0,RELAT2 . CONTINUE UNTIL MAB, THEN FAILURE SX6 B2+2 . GET ERROR NUMBER MODIFIER LX6 18 SX7 E.NOTAN BX7 X6+X7 SX6 E.ABLOCK EQ E.ERROR * * BOTTOM OF LOOP * RELAT3 SB2 B2+1 . ADVANCE TO NEXT BLOCK SA5 A5+2 . MOT OF AP2 LE B2,B0,RELAT1 . PROCESS AP2 JP B7 * * AB GONE * RELAT4 SX6 B2+2 LX6 18 SX7 E.NOABLK SX6 E.ABLOCK EQ E.ERROR ENDSUB RELAT,BUFA TITLE DELIVER OBJECT SIZE * * THIS LITTLE ROUTINE INFORMS THE CALLER OF THE OBJECT * SIZE (NOT THE FUND SIZE OR BLOCK SIZE) OF THE BLOCK * SPECIFIED BY X0 AT ENTRY. * * PARAMETERS - * X0 = A(OBJECT) * B3 = RETURN LINK * * RETURNS - * X2 = OBJECT SIZE * * ONLY MESSES UP (A0),A4,X4, AND NATURALLY X2. * * TEMPORARIES USED - TEMP2 * ENTRY OBJSIZ OBJSIZ SX4 IP.AWDS IX0 X0-X4 . READ THE OBJECT HEADER WORD RECS 1 IX0 X0+X4 . RESTORE X0 SA4 A0 . GET HEADER MX2 39 BX2 -X2*X4 . GET BLOCK SIZE AX4 42+IP.SLOP-18 SX4 X4 . CHECK LEGALITY OF SLOP FIELD NG X4,BSLOP . SHOULDNT BE THAT BIG AX4 18-IP.SLOP . GIVES SLOP IX2 X2-X4 . GIVES FUND SIZE SX4 IP.AWDS IX2 X2-X4 . GIVES OBJECT SIZE JP B3 . EXIT TITLE DELIVER BACK POINTER * * THIS ROUTINE DELIVERS THE BACKPOINTER FROM THE * BLOCK SPECIFIED AT ENTRY * * PARAMETERS * X0 = A(OBJECT) * B6 = RETURN LINK * * RETURNS - * X1 = BACKPOINTER * * ONLY MESSES UP (A0),X0,A4,X4, AND NATURALLY X1 * ENTRY BKPTR BKPTR SX4 IP.AWDS IX0 X0-X4 . GIVES A(BLOCK) MX1 60-21 RECS 1 SA4 A0+0 AX4 21 . BKPTR TO LOW X4 BX1 -X1*X4 . ELIMINATE OTHER STUFF JP B6 TITLE DELIVER OLD BACK POINTER AND SUBSTITUTE NEW ONE * * PARAMETERS - * X3 = A(OBJECT) * X5 = NEW BACK POINTER * B4 = RETURN LINK * * RETURNS - * X7 = OLD BACK POINTER * * ONLY MESSES UP (A0),X0,A1,X1,X7 * ENTRY CHGPTR CHGPTR SX0 IP.AWDS MX7 60-21 BX3 -X7*X3 . ELIMINATE JUNK BX5 -X7*X5 . ELIMINATE JUNK IX0 X3-X0 . GIVES A(BLOCK) RECS 1 SA1 A0 LX1 60-21 . POSITION BACK PONTER BX7 X7*X1 . ELIMINATE OLD PTR BX7 X7+X5 . SUBSTITUTE NEW ONE LX7 21 . REPOSITION SA7 A0 WECS 1 MX7 60-21 BX7 -X7*X1 . GET OLD PTR JP B4 TITLE ALLOCATION BLOCK CREATION INTSYS XTEXT PROCSYM XTEXT * * ECS ACTION TO CREATE AN ALLOCATION BLOCK * THE BLOCK IS INITIALLY 0, EXCEPT THAT THE TIME OF * LAST BILL FIELD IS SET TO THE CURRENT TIME * * AP1 - CAPABILITY FOR ALLOCATION BLOCK TO BE CHARGED * AP2 - C-LIST INDEX WHERE CAP FOR CREATED AB IS TO BE RETURNED * * * * ECSCODE CRALB EXT SYSRET,PUTCAP CREALBK SA1 B1+P.PARAM+2 . CHECK OUT C-LIST INDEX SB7 CREALBK1 JP =XCAPCHK CREALBK1 SB2 AB.SIZE . MAKE THE NEW ALLOCATION BLOCK SX7 AT.ALBK SA5 B1+P.PARAM+1 SB4 CREALBK2 JP MAKEOBJ CREALBK2 SA1 S.MASTR . GET MASTER CLOCK TO INITIALIZE AX1 10 . TIME OF LAST BILL FIELD LX1 30 . POSITION SCALED TIME BX6 X1 SX0 AB.TIML . WRITE THE TIME/LIMIT WORD IX0 X5+X0 SA6 B1+0 SA0 B1+0 WECS 1 SB5 CAPAB . DELIVER THE CAPABILITY FOR THE NEW AB SA1 B1+P.PARAM+2 SB6 SYSRET . AND EXIT JP PUTCAP ENDECS CRALB TITLE DESTROY ALLOCATION BLOCK END