ALLOT * /--- FILE TYPE = E * /--- BLOCK IDENT 00 000 78/10/15 16.08 IDENT ALLOT TITLE ECS ALLOCATION * * CST * LIST F * LIST F * EXT ECSPRTY,ECSERR,XSHEADS * * * /--- BLOCK DEFINITION 00 000 78/10/14 20.15 TITLE DEFINITIONS * * * INAME BSSZ 4 LESSON NAME BUFFER TMPROUT BSS 2 SCRATCH BUFFER FOR ROUTER NAME * * ILESNUM EQU INFO LESSON NUMBER ECNEED EQU ILESNUM+1 AMOUNT ECS REQUESTED ECFREE1 EQU ECNEED+1 AMOUNT ECS FOUND IROUTER EQU ECFREE1+1 INITIAL ENTRY TO ROUTER FLAG ISYSFLG EQU IROUTER+1 SPECIAL LESSON FLAG ISITE EQU ISYSFLG+1 LOGICAL SITE NUMBER IINDX EQU ISITE+1 INDEX TO LOGICAL SITE ISTATN EQU IINDX+1 STATION NUMBER IALLOT EQU ISTATN+1 CM COPY OF *XALLOT* ENTRY ISITTAB EQU IALLOT+1 CM COPY OF *SITTAB* ENTRY * ADELTA EQU ISITTAB+SITEDIM ATYPE EQU ADELTA+1 AECS EQU ATYPE+1 AECSLOC EQU AECS+1 ASHIFT EQU AECSLOC+1 AHLTH EQU ASHIFT+1 ABIAS EQU AHLTH+1 ALLOTA EQU ABIAS+1 ATABLE EQU ALLOTA+3 ALNUMB EQU ATABLE+SITEDIM ALTYPE EQU ALNUMB+1 ALLTH EQU ALTYPE+1 ACALL EQU ALLTH+1 ABUFF EQU ACALL+1 ABUFF1 EQU ABUFF+LESHEAD * * * /--- BLOCK SSIGNI 00 000 79/07/26 00.12 TITLE -SSIGNI- * * * * -SSIGNI- * UPDATE ALLOCATION TABLES ON SIGN-IN TO LESSON * * ENTRY SSIGNI SSIGNI EQ * SA1 STATION CLEAR OVER ALLOTMENT BITS CALL CCLRBIT,OVRTAB1 CALL ALLOTI INITIALIZATIONS MX6 0 SA6 IROUTER INITIAL ENTRY TO ROUTER FLAG SA6 ISYSFLG SPECIAL LESSON FLAG SA6 TALLOT CLEAR STUDENT BANK WORD * * CHECK FOR INITIAL ENTRY TO ROUTER LESSON * CALL INROUTE PL X1,SI150 IF NOT ENTERING ROUTER SA1 TROUINF CHECK IF INITIAL ENTRY NG X1,SSIGNI EXIT MX6 1 BX6 X1+X6 SET INITIAL ENTRY BIT SA6 A1 SA6 IROUTER MARK INITIAL ENTRY TO ROUTER * * CHECK IF ENTERING SPECIAL SYSTEM LESSON * SI150 CALL AIDSLES CHECK FOR AIDS LESSON SX3 AUTHECS NG X1,SI152 CHARGE -AUTHECS- FOR AIDS CALL SYSLES1,TBLESAC NG X3,SI200 SI152 MX6 -1 MARK SPECIAL LESSON SA6 ISYSFLG BX6 X3 SAVE ECS CHARGE SA6 AECS * * CHARGE SITE BY AMOUNT SPECIFIED FOR SPECIAL LESSON * SA1 ILESUN SET UP LESSON NUMBER AX1 18 SX6 X1 SA6 ILESNUM CALL ACHARGE,1,ILESNUM,AECS EQ SI300 GO TO FINAL PROCESSING * * /--- BLOCK SSIGNI 00 000 79/10/28 19.26 * * CHARGE SITE FOR ECS NEEDED FOR LESSON * SI200 SA1 ILESUN SET UP LESSON NUMBER AX1 18 SX6 X1 SA6 ILESNUM CALL ACHARGE,0,ILESNUM,LSITCNT * * CHARGE SITE FOR ECS NEEDED FOR COMMON * CALL ACHARGE,2,(LESSCM+LCOMUSE),LSITCNT SA1 LESSCM+LCOMUSE SX6 X1 SAVE COMMON LESSON NUMBER SA6 TALLOT * * CHARGE SITE FOR ECS NEEDED FOR STORAGE * SA1 TBXSTOR SX1 X1 CHECK IF STORAGE BLOCK EXISTS ZR X1,SI240 CALL READLES,ABUFF,1 SA1 ABUFF COMPUTE LENGTH OF STORAGE SB1 X1 AX1 18 SX6 X1+B1 TOTAL LENGTH OF STORAGE BLOCK SA6 AECS EQ SI250 * SI240 SA1 LESSCM+LSTOUSE SX6 X1 CHECK IF ANY STORAGE REQUIRED ZR X6,SI241 SX6 X6+LPRMLTH ADD FOR LENGTH OF HEADER * SI241 BX3 X1 X3 = NUMBER OF LVARS AX3 LVARSH MX2 -10 BX3 -X2*X3 ZR X3,SI242 SB1 X3+LPRMLTH ADD FOR LTH OF HEADER SX6 X6+B1 ADD TO STORAGE * SI242 SA2 IROUTER ZR X2,SI245 CHECK IF ENTERING ROUTER AX1 18 SX1 X1 X1 = NUMBER OF ROUTER VARS REQ. ZR X1,SI245 (IF ANY) SB1 X1+LPRMLTH ADD HEADER LENGTH SX6 X6+B1 * SI245 ZR X6,SI300 SKIP IF NO STORAGE NEEDED SA6 AECS * SI250 CALL ACHARGE,3,AECS * * /--- BLOCK SSIGNI 00 000 77/11/25 13.57 * * SET UP SPECIAL CHARGE FOR AUTHOR * SI300 CALL CHKUSER CHECK IF AUTHOR OR STUDENT PL X6,SI320 MX0 -15 SA1 IALLOT COMPUTE TOTAL ECS FOR AUTHOR BX6 -X0*X1 MASK OFF CHARGE FOR LESSON AX1 15 BX2 -X0*X1 IX6 X2+X6 ADD CHARGE FOR COMMON AX1 15 BX2 -X0*X1 IX6 X2+X6 ADD CHARGE FOR STORAGE SX2 X6-AUTHECS PL X2,SI310 JUMP IF CHARGE HIGH ENOUGH BX6 -X2 SA6 AECS SET ADDITIONAL AMOUNT TO CHARGE CALL ACHARGE,3,AECS SA1 AECS GET AUTHOR ECS CHARGE LX1 18 EQ SI315 * SI310 SX1 0 AUTHOR ECS CHARGE = 0 SI315 SA2 TALLOT BX1 X1+X2 MX6 1 SET AUTHOR CHARGE BIT BX6 X1+X6 SA6 A2 1/1,23/0,18/AUTH ECS,18/COM NUM * * /--- BLOCK SSIGNI 00 000 77/11/25 13.52 * * SAVE *XALLOT* ENTRY FOR ROUTER IF INITIAL ENTRY * SI320 SA1 IROUTER CHECK INITIAL ENTRY TO ROUTER ZR X1,SI350 SA1 IALLOT SAVE *XALLOT* ENTRY OF ROUTER BX6 X1 SA6 TROUINF+1 SA1 TALLOT SX1 X1 GET COMMON LESSON NUMBER LX1 12 MX0 -18 FORM MASK FOR COMMON NUMBER LX0 12 SA2 TROUINF+2 BX2 X0*X2 CLEAR COMMON LESSON NUMBER BX6 X1+X2 SA6 A2 * * UPDATE ALLOCATION TABLES IN ECS * SI350 CALL ALLOTR RETURN INFO TO ECS SA1 IROUTER ZR X1,SI400 JUMP IF NOT INITIAL ENTRY MX0 15 SA1 IALLOT BX6 X0*X1 STRIP OFF ALL BUT SITE INDEX SA1 STATION SA2 AALLOT INDEX INTO *XALLOT* BUFFER IX0 X1+X2 WX6 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*) * * /--- BLOCK SSIGNI 00 000 80/12/09 14.44 * * CHECK IF LESSON SHOULD BE RESERVED AT THIS SITE * SI400 SA1 ISYSFLG CHECK FOR SPECIAL LESSON NZ X1,SSIGNI SA1 ILESUN BRING LESSON HEADER TO CM AX1 18 SX1 X1 GET LESSON NUMBER BX6 X1 SA6 ILESNUM SAVE LESSON NUMBER CALL READLES,ABUFF,LESHEAD SA1 ISITE LOGICAL SITE NUMBER CALL STSTBIT,(ABUFF+LSITTAB) NZ X6,SSIGNI EXIT IF LESSON ALREADY RESERVED SA1 ISITE CALL CHKBASE,ISITTAB IX5 X2-X1 X5 = WITHIN BASE ALLOTMENT FLAG BX4 X2 X4 = BASE ALLOTMENT SA1 ISITE SX2 2*NSRESV COMPUTE INDEX INTO TABLE DX1 X1*X2 SA2 ASITRES ECS ADDRESS OF RESERVE TABLE IX0 X1+X2 INDEX TO THIS SITE SA0 WORK + RE 2*NSRESV BRING TABLE TO CM RJ ECSPRTY * SA1 TBLESSN SEARCH TABLE FOR LESSON SB1 NSRESV B1 = INDEX IN RESERVE LIST * SI420 SB1 B1-1 END TEST NG B1,SSIGNI EXIT IF LESSON NOT IN LIST SA2 B1+WORK IX2 X1-X2 CHECK IF LESSON IN LIST NZ X2,SI420 * * CHECK IF SUFFICIENT ECS TO RESERVE LESSON * PL X5,SI460 JUMP IF WITHIN BASE ALLOTMENT MX5 0 INITIALIZE ECS RESERVED TOTAL MX7 -15 SB2 NSRESV INITIALIZE INDEX IN LIST * SI430 SB2 B2-1 END TEST NG B2,SI440 SA1 B2+WORK LOAD NEXT LESSON NAME ZR X1,SI430 SA1 B2+WORK+NSRESV LOAD ALLOTMENT WORD BX2 -X7*X1 MASK OFF LENGTH OF LESSON IX5 X2+X5 AX1 15 BX1 -X7*X1 MASK OFF LENGTH OF COMMON IX5 X1+X5 EQ SI430 * SI440 SA1 IALLOT ADD CHARGE FOR THIS LESSON BX2 -X7*X1 LESSON LENGTH IX5 X2+X5 AX1 15 COMMON LENGTH BX1 -X7*X1 IX5 X1+X5 IX1 X4-X5 CHECK IF AMOUNT OF RESERVED ECS NG X1,SSIGNI WITHIN BASE ALLOTMENT * * /--- BLOCK SSIGNI 00 000 76/12/11 14.22 * * UPDATE LESSON RESERVATION TABLE * SI460 MX2 15 FORM MASK TO EXCLUDE STORAGE LX2 60-15 SA1 IALLOT BX6 -X2*X1 PLANT ALLOTMENT WORD SA6 B1+WORK+NSRESV + WE 2*NSRESV UPDATE RESERVATION TABLE RJ ECSPRTY * * UPDATE LESSON HEADER TO MARK LESSON RESERVED * SA1 ISITE MARK LESSON IN USE AT SITE CALL SSETBIT,(ABUFF+LSITTAB) CALL ALTSC,ISITE,(ABUFF+LSITCNT),1 SA1 ILESNUM CALL READLES,0,0 GET ECS ADDRESS OF LESSON SA0 ABUFF + WE LESHEAD RE-WRITE LESSON HEADER RJ ECSPRTY CALL IOLESSN,ILESNUM,40B MARK UN-DELETABLE * * UPDATE COMMON HEADER TO MARK COMMON RESERVED * SA1 TALLOT COMMON LESSON NUMBER SX1 X1 ZR X1,SSIGNI EXIT IF NO COMMON CALL READLES,ABUFF,COMHEAD BX6 X0 SAVE ECS ADDRESS OF COMMON SA6 AECSLOC CALL ALTSC,ISITE,(ABUFF+LSITCNT),1 SA1 AECSLOC BX0 X1 ECS ADDRESS OF COMMON SA0 ABUFF + WE COMHEAD RE-WRITE COMMON HEADER RJ ECSPRTY EQ SSIGNI * * * /--- BLOCK SSIGNO 00 000 77/10/26 05.56 TITLE -SSIGNO- * * * * -SSIGNO- * UPDATE ALLOCATION TABLES ON EXIT FROM LESSON * * ENTRY SSIGNO SSIGNO EQ * SA1 STATION CLEAR OVER ALLOTMENT BITS CALL CCLRBIT,OVRTAB1 CALL ROUTNAM,TMPROUT CALL FCOMPAR,TBLESAC,TMPROUT ZR X6,SSIGNO IF EXIT FROM ROUTER CALL ALLOTI INITIALIZATIONS SA1 ILESUN AX1 18 SET UP LESSON NUMBER SX6 X1 SA6 ILESNUM * * CHECK IF EXIT FROM SPECIAL SYSTEM LESSON * CALL SYSLES1,TBLESAC NG X3,SO200 CALL ARELEAS,1,ILESNUM EQ SO300 * * RELEASE STUDENT FROM LESSON CHARGE * SO200 CALL ARELEAS,0,ILESNUM,LSITCNT * * RELEASE STUDENT FROM COMMON CHARGE * CALL ARELEAS,2,TALLOT,LSITCNT * * RELEASE STUDENT FROM STORAGE CHARGE * MX0 -15 SA1 IALLOT OBTAIN STORAGE CHARGE AMOUNT LX1 2*15 BX6 -X0*X1 SA6 AECS CALL ARELEAS,3,AECS * SO300 CALL ALLOTR RETURN INFO TO ECS MX6 0 SA6 TALLOT CLEAR STUDENT BANK WORD EQ SSIGNO * * * /--- BLOCK CSIGNO 00 000 78/10/23 20.51 TITLE -CSIGNO- * * -CSIGNO- * * UPDATE ALLOCATION TABLES WHEN EXITING FROM * STATIC COMMON (THAT IS, THE COMMON SET AT * CONDENSE TIME). THE COMMON NUMBER IS STORED * WHEN ATTACHED TO THE LESSON AT CONDENSE TIME * IN THE LOWER 18 BITS OF *TALLOT*. * * ENTRY CSIGNO * CSIGNO EQ * SA1 TALLOT USER ALLOCATION INFO SX1 X1 BOTTOM 18 BITS = COMMON NUMBER ZR X1,CSIGNO EXIT IF NO STATIC COMMON CALL ROUTNAM,TMPROUT CALL FCOMPAR,TBLESAC,TMPROUT ZR X6,CSIGNO IF EXIT FROM ROUTER CALL ALLOT,-1,TALLOT,LSITCNT MX6 -18 SA1 TALLOT INDICATE STATIC COMMON GONE BX6 X6*X1 BY ZEROING OUT COMMON NUMBER SA6 A1 EQ CSIGNO * /--- BLOCK RSIGNO 00 000 77/11/25 14.00 TITLE -RSIGNO- * * * * -RSIGNO- * FINAL EXIT FROM SYSTEM - SIGN OUT OF ROUTER LESSON * * ENTRY RSIGNO RSIGNO EQ * MX6 0 CLEAR LESSON NAME SA6 TBLESAC SA6 TBLESSN SA6 TTYPE CLEAR USER TYPE SA1 TROUINF SX6 X1 GET ROUTER LESSON NUMBER ZR X6,RSIGNO LX6 18 POSITION LESSON NUMBER SA6 ILESUN SA1 TROUINF+2 LX1 60-12 SX6 X1 SET COMMON LESSON NUMBER SA6 TALLOT MX0 -18 BX6 X0*X1 CLEAR COMMON LESSON NUMBER LX6 12 SA6 A1 SA1 STATION SA2 AALLOT SET UP *XALLOT* ENTRY IX0 X1+X2 SA0 TROUINF+1 SAVED *XALLOT* ENTRY + WE 1 RJ ECSPRTY CALL SSIGNO SIGN OUT OF ROUTER LESSON MX6 0 SA6 ILESUN CLEAR LESSON NUMBER SA6 TALLOT EQ RSIGNO * EJECT TITLE -RLESO- * * -RLESO- * * SIGN USER OUT OF CURRENT ROUTER, BUT CHECKS * FOR CURRENT LESSON .NE. CURRENT ROUTER. * ENTRY RLESO RLESO EQ * SA1 TROUINF ROUTER VAR INFO WORD SA2 ILESUN CURRENT LESSON / UNIT SX1 X1 X1 = ROUTER LESSON NUMBER AX2 18 SHIFT CURRENT LESSON NUMBER SX2 X2 X2 = CURRENT LESSON NUMBER IX6 X1-X2 CHECK FOR SAME LESSON ZR X1,RLESO --- NO ROUTER TO LEAVE NZ X6,RLESO2 --- DIFFERENT LESSONS SA6 TLNUM CLEAR *ILESUN* SAVER SA6 TBLESAC CLEAR CURRENT LESSON SA6 TBLESSN EQ RLESO3 --- CONTINUE WITH SIGNOUT RLESO2 SA2 A2 RESTORE *ILESUN* BX6 X2 AND SAVE IN TEMP. VAR SA6 TLNUM RLESO3 LX1 18 SHIFT ROUTER LESSON NUMBER BX6 X1 SA6 ILESUN MOVE TO *ILESUN* FOR -SSIGNO- SA1 TROUINF+2 ROUTER COMMON INFO WORD LX1 60-12 SX6 X1 X6 = COMMON LESSON NUMBER SA6 TALLOT MX0 -18 BX6 X0*X1 CLEAR COMMON LESSON NUMBER LX6 12 SA6 A1 SA1 STATION SA2 AALLOT SET UP *XALLOT* ENTRY IX0 X1+X2 SA0 TROUINF+1 SAVED *XALLOT* ENTRY + WE 1 RJ ECSPRTY * /--- BLOCK RSIGNO 00 000 77/11/25 14.00 CALL SSIGNO SIGN OUT OF ROUTER LESSON SA1 TLNUM RETRIEVE OLD *ILESUN* BX6 X1 SX7 B0 CLEAR *TALLOT* SA6 ILESUN SA7 TALLOT EQ RLESO TLNUM BSS 1 SAVE *ILESUN* OVER -SSIGNO- * * /--- BLOCK ALLOT 00 000 77/04/17 21.46 TITLE -ALLOT- * * * * -ALLOT- * CHARGE SITE FOR ENTRY OR RELEASE SITE FROM ECS * CHARGE ASSOCIATED WITH ENTRY * * ON ENTRY - B1 = 0 = ADD CHARGE TO SITE TOTAL * -1 = RELEASE SITE FROM CHARGE * B2 = ADDRESS OF LESSON NUMBER * B3 = BIAS TO SITE TABLE IN HEADER * * ENTRY ALLOT ALLOT EQ * SX6 B1 SAVE ARGUMENTS SA6 ALLOTA SX6 B2 SA6 ALLOTA+1 SX6 B3 SA6 ALLOTA+2 MX6 -1 MARK *INFO* BUFFER USED SA6 JJSTORE CALL ALLOTI INITIALIZE VARIABLES SA1 ALLOTA+1 LOAD ARGUMENTS SA2 ALLOTA+2 SA3 ALLOTA CHECK IF CHARGE OR RELEASE NG X3,ALLOT10 CALL ACHARGE,2,X1,X2 EQ ALLOT20 * ALLOT10 CALL ARELEAS,2,X1,X2 ALLOT20 CALL AUTHC ADJUST ECS CHARGE FOR AUTHOR CALL ALLOTR RETURN VARIABLES EQ ALLOT * * * /--- BLOCK ALLOTI/R 00 000 77/11/06 03.36 TITLE -ALLOTI- * * * * -ALLOTI- * INITIALIZES VARIABLES FOR ECS ACCOUNTING ACTIONS * * ON EXIT - *IALLOT* = XALLOT ENTRY FOR STATION * *IINDX* = INDEX IN *SITTAB* TABLE * *ISITE* = LOGICAL SITE NUMBER * *ISITTAB* = *SITTAB* TABLE ENTRY * *ASCALE* = ALLOTMENT SCALE FACTOR * * ALLOTI EQ * GETX ASCALE GET ECS ALLOTMENT SCALE FACTOR SA1 STATION READ XALLOT/SITTAB ENTRIES CALL READSIT,ISITTAB,SITEDIM BX6 X1 SA6 ISITE *ISITE* = LOGICAL SITE NUMBER BX6 X2 SA6 IINDX *IINDX* = BIAS WITHIN *SITTAB* EQ ALLOTI EXIT * * TITLE -ALLOTR- * * * * -ALLOTR- * RETURNS TO ECS THOSE VARIABLES LOADED BY -ALLOTI- * * ON EXIT - *XALLOT* ENTRY = *IALLOT* * *SITTAB* = *ISITTAB* * * ALLOTR EQ * * * UPDATE XALLOT TABLE ENTRY * SA1 STATION SA2 AALLOT IX0 X1+X2 INDEX INTO XALLOT BUFFER SA0 IALLOT + WE 1 UPDATE *XALLOT* RJ ECSPRTY * * UPDATE SITETAB TABLE ENTRY * SA1 ASITTAB ADDRESS OF SITE ECS TABLE SA2 IINDX IX0 X1+X2 SA0 ISITTAB + WE SITEDIM UPDATE *SITTAB* RJ ECSPRTY EQ ALLOTR EXIT * * * /--- BLOCK ACHARGE 00 000 78/10/14 19.51 TITLE -ACHARGE- * * * * -ACHARGE- * ON ENTRY - B1 = ENTRY TYPE CODE * 0 = LESSON * 1 = SPECIAL LESSON * 2 = COMMON OR SIMILAR TYPE * 3 = STORAGE OR SIMILAR TYPE * * FOR LESSON/COMMON TYPE ENTRIES - * B2 = ADDRESS OF LESSON NUMBER * B3 = BIAS TO SITE TABLE IN HEADER * * FOR SPECIAL LESSON TYPE ENTRIES - * B2 = ADDRESS OF LESSON NUMBER * B3 = ADDRESS OF AMOUNT TO CHARGE * (CHARGE IS FOR EACH STATION) * * FOR STORAGE TYPE ENTRIES - * B2 = ADDRESS OF LENGTH OF STORAGE * * ACHARGE EQ * MX6 0 SA6 ADELTA INITIALIZE CHANGE IN ECS USE SA6 ALNUMB INITIALIZE LESSON NUMBER SX6 B1 SAVE TYPE SA6 ATYPE JP B1+*+1 JUMP BY TYPE * + EQ AC100 LESSON + EQ AC200 SPECIAL LESSONS + EQ AC110 COMMON OR SIMILAR + EQ AC300 STORAGE OR SIMILAR * * * INITIALIZE FOR LESSON * AC100 MX6 0 SET SHIFT FOR LESSON SA6 ASHIFT EQ AC120 * * INITIALIZE FOR COMMON OR SIMILAR ENTRY * AC110 SX6 15 SET SHIFT FOR COMMON SA6 ASHIFT * * /--- BLOCK ACHARGE 00 000 78/10/14 19.49 * * OBTAIN HEADER FOR LESSON, COMMON OR SIMILAR ENTRY * AC120 SX6 B3 SAVE BIAS TO SITE TABLE SA6 ABIAS SA1 B2 X1 = LESSON NUMBER SX1 X1 ZR X1,ACHARGE BX6 X1 SAVE LESSON NUMBER SA6 ALNUMB CALL READLES,ABUFF,LPRMLTH BX6 X0 SAVE ECS ADDRESS OF HEADER SA6 AECSLOC MX1 12 SA2 ABUFF OBTAIN LESSON TYPE BX1 X1*X2 LX1 12 POSITION LESSON TYPE CODE SA2 X1+XSHEADS LOAD LENGTH OF LESSON HEADER SB1 X2 + RE B1 READ ENTIRE HEADER TO CM RJ ECSPRTY SX6 B1 SAVE LENGTH OF HEADER SA6 AHLTH * * COMPUTE LENGTH OF LESSON OR COMMON TYPE ENTRY * SA1 ABUFF SX6 X1 COMPUTE LENGTH OF ENTRY AX1 18 SX1 X1 IX6 X1+X6 SA6 AECS SA1 ATYPE CHECK IF LESSON NZ X1,AC140 * * /--- BLOCK ACHARGE 00 000 77/06/18 15.37 * * MAKE ENTRY IN STATION BIT TABLE FOR LESSON * SA1 STATION SET BIT FOR THIS STATION CALL SSETBIT,(ABUFF+LBITTAB) * * INCREMENT USER COUNT BY THIS SITE AND CHECK IF * ENTRY ALREADY IN USE AT THIS SITE * AC140 SA1 ABIAS LOAD BIAS TO SITE TABLE CALL ALTSC,ISITE,X1+ABUFF,1 SX0 X1-2 CHECK IF IN USE AT THIS SITE PL X0,AC150 SA1 AECS SET CHANGE IN ECS ALLOTMENT BX6 X1 SA6 ADELTA * AC150 SA1 AECSLOC GET ECS ADDRESS OF HEADER BX0 X1 SA1 AHLTH GET LENGTH OF HEADER SB1 X1 SA0 ABUFF + WE B1 RE-WRITE LESSON HEADER RJ ECSPRTY EQ AC500 * * /--- BLOCK ACHARGE 00 000 80/09/04 03.55 * * OBTAIN HEADER FOR SPECIAL LESSON ENTRY * AC200 SX6 2*15 SET SHIFT AS FOR STORAGE SA6 ASHIFT SA1 B3 SAVE AMOUNT TO CHARGE BX6 X1 SA6 AECS SA6 ADELTA SA1 B2 X1 = LESSON NUMBER SX1 X1 BX6 X1 SAVE LESSON NUMBER SA6 ALNUMB CALL READLES,ABUFF,LESHEAD BX6 X0 SAVE ECS ADDRESS OF HEADER SA6 AECSLOC * * INCREMENT USER COUNT BY THIS SITE * SA1 STATION SET BIT FOR THIS STATION CALL SSETBIT,(ABUFF+LBITTAB) CALL ALTSC,ISITE,(ABUFF+LSITCNT),1 SA1 AECSLOC GET ECS ADDRESS OF HEADER BX0 X1 SA0 ABUFF + WE LESHEAD RE-WRITE LESSON HEADER RJ ECSPRTY EQ AC500 * * * SET ECS LENGTH AND CHANGE FOR STORAGE TYPE ENTRY * AC300 SX6 2*15 SET SHIFT FOR STORAGE SA6 ASHIFT SA1 B2 GET LENGTH OF STORAGE SX6 X1 ZR X6,ACHARGE * SX1 77777B (X1) = MAX. POSSIBLE CHARGE IX1 X1-X6 SEE IF IN RANGE PL X1,AC310 --- IF OK SX6 77777B SET FOR MAX. POSSIBLE AC310 BSS 0 * SA6 AECS SA6 ADELTA SET CHANGE IN ECS USAGE * * /--- BLOCK ACHARGE 00 000 78/10/14 19.53 * * UPDATE AMOUNT OF ECS IN USE BY SITE (*ISITTAB*) * AC500 SA1 ADELTA X1 = CHANGE IN ECS USAGE ZR X1,AC510 MX0 -24 SA2 ISITTAB LOAD WORD CONTAINING ECS USAGE BX6 X0*X2 BX2 -X0*X2 MASK OFF CURRENT TOTAL IX1 X1+X2 ADD TO ECS USE FOR SITE BX6 X1+X6 SA6 A2 * * UPDATE ECS USE FOR THIS STATION (*IALLOT*) * AC510 MX0 -15 SA1 ASHIFT LOAD SHIFT COUNT SB1 X1 B1 = SHIFT WITHIN *IALLOT* SA1 IALLOT SA2 AECS ECS LENGTH OF THIS ENTRY LX0 X0,B1 LX2 X2,B1 BX6 X0*X1 MASK ALL BUT APPROPRIATE COUNT BX1 -X0*X1 IX1 X1+X2 ADD TO APPROPRIATE TOTAL BX1 -X0*X1 BX6 X1+X6 RE-COMBINE SA6 A1 EQ ACHARGE * * * /--- BLOCK ARELEAS 00 000 78/10/14 19.54 TITLE -ARELEAS- * * * * -ARELEAS- * ON ENTRY - B1 = ENTRY TYPE CODE * 0 = LESSON * 1 = SPECIAL LESSON * 2 = COMMON OR SIMILAR TYPE * 3 = STORAGE OR SIMILAR TYPE * * FOR LESSON/COMMON TYPE ENTRIES - * B2 = ADDRESS OF LESSON NUMBER * B3 = BIAS TO SITE TABLE IN HEADER * * FOR SPECIAL LESSON TYPE ENTRIES - * B2 = ADDRESS OF LESSON NUMBER * * FOR STORAGE TYPE ENTRIES - * B2 = ADDRESS OF LENGTH OF STORAGE * * ARELEAS EQ * MX6 0 SA6 ADELTA INITIALIZE CHANGE IN ECS USE SA6 ALNUMB INITIALIZE LESSON NUMBER SX6 B1 SAVE TYPE SA6 ATYPE JP B1+*+1 JUMP BY TYPE * + EQ AR100 LESSON + EQ AR200 SPECIAL LESSONS + EQ AR110 COMMON OR SIMILAR + EQ AR300 STORAGE OR SIMILAR * * * INITIALIZE FOR LESSON * AR100 MX6 0 SET SHIFT FOR LESSON SA6 ASHIFT MX0 -15 SA1 IALLOT OBTAIN LENGTH OF LESSON BX6 -X0*X1 SA6 AECS SA1 B2 X1 = LESSON NUMBER SX1 X1 NZ X1,AR120 CHECK IF LESSON STILL IN ECS EQ AR500 * * INITIALIZE FOR COMMON OR SIMILAR ENTRY * AR110 SX6 15 SET SHIFT FOR COMMON SA6 ASHIFT * * /--- BLOCK ARELEAS 00 000 78/10/14 19.55 * * OBTAIN HEADER FOR LESSON, COMMON OR SIMILAR ENTRY * AR120 SX6 B3 SAVE BIAS TO SITE TABLE SA6 ABIAS SA1 B2 X1 = LESSON NUMBER SX1 X1 ZR X1,ARELEAS BX6 X1 SAVE LESSON NUMBER SA6 ALNUMB CALL READLES,ABUFF,LPRMLTH BX6 X0 SAVE ECS ADDRESS OF HEADER SA6 AECSLOC MX1 12 SA2 ABUFF OBTAIN LESSON TYPE BX1 X1*X2 LX1 12 POSITION LESSON TYPE CODE SA2 X1+XSHEADS LOAD LENGTH OF LESSON HEADER SB1 X2 + RE B1 READ ENTIRE HEADER TO CM RJ ECSPRTY SX6 B1 SAVE LENGTH OF HEADER SA6 AHLTH * * COMPUTE LENGTH OF COMMON TYPE ENTRY * SA1 ASHIFT CHECK FOR LESSON ZR X1,AR140 SA1 ABUFF SX6 X1 COMPUTE LENGTH OF ENTRY AX1 18 SX1 X1 IX6 X1+X6 SA6 AECS * * DECREMENT USER COUNT BY THIS SITE AND CHECK IF * ENTRY STILL IN USE AT THIS SITE * * AR140 SA1 ATYPE CHECK IF LESSON NZ X1,AR145 SA1 STATION CLEAR BIT FOR THIS STATION CALL CCLRBIT,(ABUFF+LBITTAB) * AR145 SA1 ABIAS LOAD BIAS TO SITE TABLE CALL ALTSC,ISITE,X1+ABUFF,-1 NZ X1,AR150 CHECK IF STILL IN USE AT SITE SA1 AECS SET CHANGE IN ECS ALLOTMENT BX6 X1 SA6 ADELTA * AR150 SA1 AECSLOC GET ECS ADDRESS OF HEADER BX0 X1 SA1 AHLTH GET LENGTH OF HEADER SB1 X1 SA0 ABUFF + WE B1 RE-WRITE LESSON HEADER RJ ECSPRTY EQ AR500 * * /--- BLOCK ARELEAS 00 000 78/10/14 19.55 * * OBTAIN HEADER FOR SPECIAL LESSON ENTRY * AR200 SX6 2*15 SET SHIFT AS FOR STORAGE SA6 ASHIFT MX6 -15 SA1 IALLOT GET AMOUNT CHARGED FOR LESSON LX1 2*15 BX6 -X6*X1 SA6 AECS SA6 ADELTA SA1 B2 X1 = LESSON NUMBER SX1 X1 ZR X1,AR500 BX6 X1 SAVE LESSON NUMBER SA6 ALNUMB CALL READLES,ABUFF,LESHEAD BX6 X0 SAVE ECS ADDRESS OF HEADER SA6 AECSLOC * * DECREMENT USER COUNT BY THIS SITE * SA1 STATION CLEAR BIT FOR THIS STATION CALL CCLRBIT,(ABUFF+LBITTAB) CALL ALTSC,ISITE,(ABUFF+LSITCNT),-1 SA1 AECSLOC GET ECS ADDRESS OF HEADER BX0 X1 SA0 ABUFF + WE LESHEAD RE-WRITE LESSON HEADER RJ ECSPRTY EQ AR500 * * * SET ECS LENGTH AND CHANGE FOR STORAGE TYPE ENTRY * AR300 SX6 2*15 SET SHIFT FOR STORAGE SA6 ASHIFT SA1 B2 GET LENGTH OF STORAGE SX6 X1 ZR X6,ARELEAS SA6 AECS SA6 ADELTA SET CHANGE IN ECS USAGE * * /--- BLOCK ARELEAS 00 000 78/10/14 19.57 * * UPDATE AMOUNT OF ECS IN USE BY SITE (*ISITTAB*) * AR500 SA1 ADELTA CHANGE IN ECS USAGE ZR X1,AR510 MX0 -24 SA2 ISITTAB LOAD WORD CONTAINING ECS USAGE BX6 X0*X2 BX2 -X0*X2 MASK OFF CURRENT TOTAL IX1 X2-X1 DECREMENT ECS USE FOR SITE + PL X1,*+1 SX1 0 DONT ALLOW NEGATIVE LENGTH + BX6 X1+X6 SA6 A2 * * UPDATE ECS USE FOR THIS STATION (*IALLOT*) * AR510 MX0 -15 SA1 ASHIFT LOAD SHIFT COUNT SB1 X1 B1 = SHIFT WITHIN *IALLOT* SA1 IALLOT SA2 AECS ECS LENGTH OF THIS ENTRY LX0 X0,B1 LX2 X2,B1 BX6 X0*X1 MASK ALL BUT APPROPRIATE COUNT BX1 -X0*X1 IX1 X1-X2 SUBTRACT FROM APPROPRIATE TOTAL + PL X1,*+1 SX1 0 DONT ALLOW NEGATIVE TOTAL + BX1 -X0*X1 BX6 X1+X6 RE-COMBINE SA6 A1 EQ ARELEAS * * * /--- BLOCK AUTHC 00 000 77/11/20 15.54 TITLE -AUTHC- * * * * -AUTHC- * ADJUST ECS CHARGE FOR AUTHOR TO MAINTAIN MINIMUM * CHARGE OF *AUTHECS* * AUTHC EQ * SA1 TALLOT PL X1,AUTHC CHECK IF ANY AUTHOR CHARGE BX7 X1 LX7 60-18 X7 = *TALLOT* SB1 X7 ZR B1,AHC210 SB1 B0-B1 B1 = CHANGE IN SITE ECS USAGE * * COMPUTE NEW AUTHOR ECS CHARGE * AHC210 MX0 -15 X0 = MASK SA4 IALLOT X4 = *IALLOT* LX4 15+15 POSITION STORAGE/AUTHOR CHARGE BX5 -X0*X4 SX5 X5+B1 X5 = STORAGE CHARGE LX4 15 POSITION COMMON CHARGE BX2 -X0*X4 IX2 X2+X5 ADD TO TOTAL CHARGE LX4 15 POSITION LESSON CHARGE BX1 -X0*X4 IX2 X1+X2 X2 = TOTAL ECS CHARGE MX3 0 X3 = AUTHOR CHARGE SX1 X2-AUTHECS PL X1,AHC260 JUMP IF OVER MINIMUM CHARGE BX3 -X1 X3 = AUTHOR CHARGE SB1 X3+B1 ADJUST CHANGE IN SITE ECS TOTAL * * UPDATE *XALLOT* ENTRY IMAGE FOR THIS AUTHOR * AHC260 IX5 X3+X5 COMPUTE STORAGE+AUTHOR CHARGE LX4 15+15 POSITION STORAGE CHARGE FIELD BX4 X0*X4 BX6 X4+X5 ATTACH NEW STORAGE CHARGE LX6 15+15 SA6 A4 UPDATE *IALLOT* * * /--- BLOCK AUTHC 00 000 78/10/14 20.01 * * UPDATE AUTHOR ECS CHARGE IN *TALLOT* * MX0 -18 BX7 X0*X7 CLEAR OUT OLD AUTHOR CHARGE BX7 X3+X7 ATTACH NEW CHARGE LX7 18 SA7 TALLOT UPDATE *TALLOT* * * UPDATE SITE ECS USAGE TOTAL IN *SITTAB* * MX0 -24 SA1 ISITTAB LOAD SITE ECS USAGE WORD BX6 X0*X1 BX1 -X0*X1 MASK OFF CURRENT USAGE TOTAL SX2 B1 IX1 X1+X2 ADJUST SITE ECS USEAGE TOTAL + PL X1,*+1 DONT ALLOW NEGATIVE TOTAL SX1 0 + BX6 X1+X6 MERGE NEW USAGE TOTAL SA6 A1 EQ AUTHC * * * * /--- BLOCK READSIT 00 000 77/04/17 20.11 TITLE -READSIT- * * * * -READSIT- * READ SITE TABLE FOR INDICATED STATION * * ON ENTRY - X1 = STATION NUMBER * B1 = ADDRESS TO READ INTO * B2 = NUMBER OF WORDS TO READ * * LEAVES X0, A0, *IALLOT* APPROPRIATELY SET * RETURNS X1 = LOGICAL SITE NUMBER * X2 = BIAS TO SITE IN *SITTAB* * * REGISTERS CHANGED'; * A'; 0,1,2,3 * X'; 0,1,2,3 * B'; NONE * * ENTRY READSIT READSIT EQ * SA2 AALLOT IX0 X1+X2 SA0 IALLOT + RE 1 READ *XALLOT* ENTRY RJ ECSPRTY MX0 -15 SA1 A0 LOAD *XALLOT* ENTRY LX1 15 BX2 -X0*X1 X2 = BIAS WITHIN *SITTAB* SA3 ASITTAB IX0 X2+X3 INDEX INTO LOGICAL SITE TABLE SA0 B1 ADDRESS TO READ INTO * * CALCULATE LOGICAL SITE NUMBER BEFORE TEST/TRANSFER * PX1 X2 NX1 X1 CONVERT TO FLOATING SX3 SITEDIM PX3 X3 NX3 X3 FX1 X1/X3 X1 = LOGICAL SITE NUMBER UX1 X1,B1 LX1 X1,B1 * * TRANSFER REQUIRED NUMBER OF WORDS * LE B2,READSIT + RE B2 READ REQUIRED LENGTH RJ ECSPRTY EQ READSIT * * * /--- BLOCK TSTSITE 00 000 76/01/29 04.12 TITLE -TSTSITE- * * * * -TSTSITE- * CHECK TO SEE IF A TIMED BACK-OUT IN EFFECT FOR * THIS LOGICAL SITE * * ON RETURN - X6 = 0 NO BACKOUT * -1 BACKOUT IN EFFECT * * ENTRY TSTSITE TSTSITE EQ * SA1 AALLOT SA4 STATION INDEX INTO *XALLOT* BUFFER SX0 X4-LSTUD ZR X0,TSTS1 CHECK FOR CONSOLE IX0 X1+X4 SET ADDRESS TO *XALLOT* ENTRY RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*) MX0 15 BX1 X0*X1 LX1 15 POSITION INDEX IN SITE TABLE PX1 X1 NX1 X1 CONVERT TO FLOATING POINT SX2 SITEDIM PX2 X2 NX2 X2 FX1 X1/X2 COMPUTE LOGICAL SITE NUMBER UX1 X1,B1 LX1 X1,B1 CONVERT BACK TO INTEGER SA2 ASLOCK IX0 X1+X2 INDEX INTO SITE LOCK-OUT BUFFER + RE 1 READ SITE LOCK-OUT TABLE RJ ECSPRTY SA1 A0 ZR X1,TSTS1 EXIT IF NO SITE BACK-OUT MX7 18 BX2 X7*X1 MASK OFF BACK-OUT STATION NUM BX1 -X7*X1 MASK OFF BACK-OUT TIME LX2 18 CHECK IF THIS STATION INITIATED IX2 X2-X4 BACK-OUT ZR X2,TSTS1 SA2 SYSCLOK IX1 X2-X1 CHECK IF BACK-OUT TIME ELAPSED NG X1,TSTS2 SA0 =0 + WE 1 CLEAR OUT BACK-OUT TIME RJ ECSPRTY * TSTS1 MX6 0 MARK NO BACK-OUT IN PROCESS EQ TSTSITE * TSTS2 MX6 -1 MARK BACK-OUT IN PROCESS EQ TSTSITE * * * /--- BLOCK ENTER/EXIT 00 000 76/01/29 04.43 TITLE -SSENTER- * * * -SSENTER- * UPDATE ALLOCATION TABLES ON ENTRY TO -PLATO- * * ENTRY SSENTER SSENTER EQ * SA1 SCSITES RELATIVE ADDRESS OF TABLE SA3 STATION IX0 X1+X3 INDEX INTO SITE/STATION TABLE RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*) MX0 -12 BX1 -X0*X1 MASK OFF LOGICAL SITE NUMBER SX0 SITEDIM DX1 X0*X1 COMPUTE INDEX IN SITE TABLE MX0 -15 BX6 -X0*X1 LX6 60-15 POSITION INDEX IN SITE TABLE SA6 IALLOT SA2 AALLOT IX0 X2+X3 INDEX INTO *XALLOT* (INIT) WX6 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*) SA2 ASITTAB IX0 X1+X2 INDEX INTO SITE TABLE SA0 ISITTAB + RE SITEDIM READ SITE TABLE ENTRY RJ ECSPRTY BX1 X3 SET BIT FOR THIS STATION CALL SSETBIT,(ISITTAB+1) + WE SITEDIM REWRITE SITE TABLE ENTRY RJ ECSPRTY EQ SSENTER * * TITLE -SSEXIT- * * * -SSEXIT- * UPDATE ALLOCATION TABLES ON EXIT FROM -PLATO- * * ENTRY SSEXIT SSEXIT EQ * CALL ALLOTI LOAD ALLOTMENT TABLES TO CM MX6 0 SA6 IALLOT CLEAR *IALLOT* ENTRY SA1 STATION CLEAR BIT FOR THIS STATION CALL CCLRBIT,(ISITTAB+1) CALL ALLOTR RETURN TABLES TO ECS EQ SSEXIT * * * /--- BLOCK CHKECS 00 000 78/02/21 18.57 TITLE -CHKECS- * * * * -CHKECS- -CHKBASE- * GET ECS USEAGE AND ALLOCATION FOR THIS SITE * * ON RETURN - X1 = TOTAL ECS IN USE * X2 = AMOUNT ALLOTED TO SITE * * ENTRY CHKECS CHKECS EQ * CALL ALLOTI INITIALIZE VARIABLES SA1 ISITE CALL CHKBASE,ISITTAB GET BASE ALLOTMENT AND USE SA3 ASCALE ZR X3,CHKECS EXIT IF NO SCALE FACTOR PX2 X2 NX2 X2 CONVERT TO FLOATING POINT FX2 X2*X3 UX2 X2,B1 CONVERT SCALED ALLOTMENT LX2 X2,B1 EQ CHKECS * * * -CHKBASE- RETURNS THE BASE ECS ALLOTMENT IN X2 * ENTRY'; X1= LOGICAL SITE , B1= ADDRESS OF ECS SUM * FOR THIS SITE FROM *SITETABLE* * EXIT'; X1= CURRENT ECS IN USE * X2= BASE ECS * * ENTRY CHKBASE CHKBASE EQ * SA2 SCALLOT IX0 X1+X2 INDEX INTO SITE ALLOTMENT TABLE RX2 X0 (-RXX- 1 WD READ, MAY CHG *A2*) MX0 -24 SA3 B1 LOAD TOTAL SITE ECS USE BX1 -X0*X3 AMOUNT OF ECS IN USE BX2 -X0*X2 TOTAL ECS ALLOCATED TO SITE EQ CHKBASE * * * /--- BLOCK SSDELET 00 000 80/02/22 23.36 TITLE -SSDELET- * * * * -SSDELET- * CLEAN UP ALLOCATION TABLES FOR DELETED LESSON * * ON ENTRY - X1 = LESSON NUMBER * * ENTRY SSDELET SSDELET EQ * SX6 X1 SAVE LESSON NUMBER SA6 ALNUMB CALL READLES,ABUFF,LESHEAD ZR X0,SSDELET SX1 3 INCREMENT TO WD 4 OF LESNAM IX0 X0+X1 RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*) MX0 12 MASK FOR LESSON TYPE BX1 X0*X1 CHECK TYPE = TUTOR LESSON NZ X1,SSDELET * * COMPUTE LENGTH OF LESSON * SA1 ABUFF SX6 X1 COMPUTE TOTAL LENGTH OF LESSON AX1 18 SX1 X1 IX6 X1+X6 SA6 AECS SA6 ADELTA * * FIND ALL SITES REFERENCING THIS LESSON * MX6 -1 INITIALIZE SITE NUMBER SA6 ISITE * SD200 SA1 ISITE INCREMENT SITE NUMBER SX6 X1+1 SA6 A1 SX6 X6-XMAXSIT END TEST PL X6,SSDELET CALL GETSC,ISITE,(ABUFF+LSITCNT) ZR X1,SD200 CHECK IF THIS SITE USING LESSON * * /--- BLOCK SSDELET 00 000 78/10/14 20.22 * * READ *SITTAB* ENTRY FOR THIS SITE * SA1 ISITE LOGICAL SITE NUMBER SX2 SITEDIM DX1 X1*X2 COMPUTE INDEX WITHIN TABLE SA2 ASITTAB IX0 X1+X2 ECS ADDRESS OF *SITTAB* ENTRY RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*) * * SUBTRACT LENGTH OF LESSON FROM SITE ECS USE TOTAL * MX7 -24 MASK FOR ECS USE TOTAL BX6 X7*X1 MASK ALL BUT ECS TOTAL BX1 -X7*X1 SA2 AECS IX1 X1-X2 SUBTRACT FOR THIS LESSON + PL X1,*+1 SX1 0 DONT ALLOW NEGATIVE TOTAL + BX1 -X7*X1 BX6 X1+X6 RE-COMBINE SA6 ISITTAB WX6 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*) * EQ SD200 * * * /--- BLOCK CLEAREC 00 000 77/06/09 18.27 TITLE -CLEAREC- * * * * -CLEAREC- * OBTAIN ECS BY PRESSING -STOP1- ON AUTHORS AT THIS * SITE WHO ARE USING MORE THAN *AUTHECS* WORDS * * ON ENTRY - *LESINF* = AMOUNT OF ECS TO OBTAIN * * ENTRY CLEAREC CLEAREC EQ * SA1 LESINF SX6 X1+5000 AMOUNT OF ECS DESIRED SA6 ECNEED MX6 0 INITIALIZE ECS FREE TOTAL SA6 ECFREE1 CALL ALLOTI INITIALIZE SITE VARIABLES * * CHECK IF DELETION ENABLED AT THIS SITE * SA1 SCAUTH ADDRESS OF BIT TABLE IN ECS BX0 X1 SA0 WORK + RE LSITLTH BRING BIT TABLE TO CM RJ ECSPRTY SA1 ISITE CHECK BIT FOR THIS SITE CALL STSTBIT,WORK ZR X6,CLEAREC EXIT IF DELETION BIT NOT SET * * COMBINE SITE AND OVER ALLOTMENT TABLES * SB1 LBITLTH-1 * CC10 SA1 B1+OVRTAB1 NEXT WORD OF OVER TABLE SA2 B1+ISITTAB+1 WORD OF SITE TABLE BX6 X1*X2 STATIONS FOR THIS SITE SA6 B1+ATABLE SB1 B1-1 END TEST PL B1,CC10 * * UP TO 3 PASSES TO FIND THE ECS * SX6 =XEDBND1 PASS 1 LOWER LIMIT CALL CLEARIT PL X1,CLEAREC FOUND ENOUGH SX6 =XEDBND2 PASS 2 LOWER LIMIT CALL CLEARIT PL X1,CLEAREC NOW FOUND ENOUGH SX6 =XEDBND3 PASS 3 LOWER LIMIT CALL CLEARIT EQ CLEAREC RETURN REGARDLESS * * * * * -CLEARIT- * LOOP THROUGH SITE AND PRESS STOP1 ON AUTHORS * USING ABOVE CERTAIN ECS LIMITS * * ON ENTRY - X6 = LOWER ECS BOUNDARY * * ON EXIT - X1 = POSITIVE IF ENOUGH ECS OBTAINED * CLEARIT EQ * SA6 LOWBND SAVE LOWER BOUNDARY * * SEARCH FOR AUTHORS TO DELETE * CALL IBIT,ATABLE * CCLP CALL NEXTBIT GET NEXT STATION NUMBER NG X1,CLEARIT THIS PASS COMPLETE SX6 X1 SAVE STATION NUMBER SA6 ISTATN CDCIF IFNE CDC,0 SA2 AALLOT IX0 X6+X2 ECS ADDRESS FOR *XALLOT* ENTRY RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*) MX0 -15 * /--- BLOCK CLEAREC 00 000 79/04/06 12.29 BX7 -X0*X1 MASK OFF LENGTH OF LESSON AX1 15 BX2 -X0*X1 MASK OFF LENGTH OF COMMON IX7 X7+X2 COLLECT AMOUNT IN X7 AX1 15 BX1 -X0*X1 MASK OFF LENGTH OF STORAGE IX7 X7+X1 SA2 LOWBND IX2 X2-X7 PL X2,CCLP BELOW LOWER BOUNDARY SX7 X7-AUTHECS SUBTRACT AMOUNT LEFT TO AUTHOR SA7 ECSTOT SAVE TOTAL ECS OBTAINABLE CDCIF ENDIF CALL READSBK,INAME,ISTATN,(TBLESAC-SBSTART),2 * * * CHECK IF AUTHOR CAN BE BACKED OUT * SA2 INAME+1 SEE IF NON-DELETABLE LESSON ZR X2,CCLP CALL SYSLES,INAME (X3) = 0 IF NOT SYSTEM LESSON * = 1 IF *D1* ATTRIBUTE * = 2 IF *D2* ATTRIBUTE * = 3 IF *D3* ACTIVE * ZR X3,CC15 IF NORMAL DELETION OK SX3 X3-3 NG X3,CCLP IF DELETION-PROTECTED SA1 KSYS2 (X1) = *SYS2KEY* EQ CC18 GO PRESS KEY CC15 SA1 KSYS1 (X1) = *SYS1KEY* CC18 BX6 X1 (X6) = SPECIAL KEY NUMBER SA6 KEYTYPE CALL FINDLES,INAME,LESNUM SA1 LESNUM SEE IF LESSON IN ECS NG X1,CCLP CALL READLES,ABUFF,LESHEAD SB1 LBITLTH-1 * * CHECK IF STUDENTS USING SAME LESSON AT THIS SITE * CDCIF IFEQ CDC,0 CC20 SA1 B1+ATABLE AUTHORS-IN-LESSON TABLE SA2 B1+ABUFF+LBITTAB USERS IN LESSON BX2 -X1*X2 MASK OUT AUTHORS SA1 B1+ISITTAB+1 USERS IN THE SITE BX2 X1*X2 IN SITE AND IN LESSON NZ X2,CCLP STUDENTS IN SITE USING LESSON SB1 B1-1 PL B1,CC20 END TEST CDCIF ELSE MX7 0 CC20 SA1 B1+ISITTAB+1 USERS IN THE SITE SA2 B1+ABUFF+LBITTAB USERS IN LESSON BX6 X1*X2 IN SITE AND IN LESSON ZR X6,CC22 SA1 B1+ATABLE AUTHORS-IN-LESSON TABLE BX2 -X1*X6 MASK OUT AUTHORS NZ X2,CCLP STUDENTS IN SITE USING LESSON CX6 X6 IX7 X6+X7 ADD TO USER COUNT CC22 SB1 B1-1 PL B1,CC20 END TEST SX7 X7-4 PL X7,CCLP 4 OR MORE USERS CDCIF ENDIF CALL PRESKEY,KEYTYPE,ISTATN SA1 DELCNT SX6 X1+1 INCREMENT NUMBER OF DELETIONS SA6 A1 CDCIF IFNE CDC,0 * /--- BLOCK CLEAREC 00 000 79/04/06 12.29 * * ISSUE ACCOUNT FILE INFORMATION ABOUT USER DELETED * SA1 ISTATN STATION NUMBER SB1 1 RESTORE B1 FOR CDD CALL CDD MX5 6*6 BX5 -X5*X6 LX5 4*6 POSITION SX1 2RPD ADD PD AS FIRST 2 CHARACTERS LX1 8*6 BX5 X1+X5 PD + STSN SA1 ISITE LOGICAL SITE NUMBER CALL CDD MX7 6*6 BX6 -X7*X6 BX6 X6+X5 SA6 CDCMSG PD + STSN + LSIT SA1 INAME+1 LESSON NAME CALL LJUST,0,1R BX6 X1 SA6 CDCMSG+1 SA1 ECSTOT TOTAL ECS USE * /--- BLOCK CLEAREC 00 000 80/03/17 22.09 SB1 1 RESTORE B1 FOR CDD CALL CDD SA6 CDCMSG+2 CALL BALLOT X1 GETS BASE ALLOTMENT SB1 1 RESTORE B1 FOR CDD CALL CDD ITOA X1,X6 SA6 CDCMSG+3 CALL TMALLOT X1 GETS CURRENT ALLOTMENT SB1 1 RESTORE B1 FOR CDD CALL CDD ITOA X1,X6 SA6 CDCMSG+4 CALL TMUSE X1 GETS CURRENT USEAGE SB1 1 RESTORE B1 FOR CDD CALL CDD ITOA X1,X6 SA6 CDCMSG+5 SA1 EMAVL X1 GETS TOTAL ECS AVAILABLE SB1 1 RESTORE B1 FOR CDD CALL CDD ITOA X1,X6 SA6 CDCMSG+6 SA1 CLEAREC X1 GETS RJ PLANTED EQ ADDR LX1 30 RIGHT JUSTIFY ADDRESS MX2 -18 BX1 -X2*X1 ISOLATE RETURN ADDRESS CALL S=OTOA OTOA X1,X6 SA7 CDCMSG+7 ONLY BOTTOM 18/3 DIGITS NEEDED CALL S=LOG,CDCMSG,5 EQ BYMSG * CDCMSG BSS 8 * BYMSG BSS 0 CDCIF ENDIF * * ADD TO AMOUNT OF ECS OBTAINED * CDCIF IFEQ CDC,0 SA1 ABUFF SX6 X1 LENGTH OF LESSON CDCIF ELSE SA1 ECSTOT TOTAL ECS OBTAINED BX6 X1 CDCIF ENDIF SA1 ECFREE1 IX6 X1+X6 UPDATE TOTAL ECS OBTAINED SA6 A1 SA2 ECNEED IX2 X6-X2 SEE IF HAVE ENOUGH ECS NOW NG X2,CCLP EQ CLEARIT * * * KSYS1 VFD 60/SYS1KEY KSYS1 VFD 60/ADELKEY KSYS2 VFD 60/SYS2KEY KEYTYPE BSS 1 KEY TO BE PRESSED FOR DELETION LOWBND BSS 1 CURRENT DELETION PASS LIMIT ECSTOT BSS 1 ECS OBTAINABLE BY DELETING USER * ENTRY DELCNT DELCNT DATA 0 COUNT OF AUTHORS DELETED * * * /--- BLOCK SITE COUNT 00 000 76/01/27 18.45 TITLE SITE USER COUNT MANIPULATION * * * * -ALTSC- * INCREMENTS OR DECREMENTS USER COUNT BY SITE * * ON ENTRY - B1 = ADDRESS OF LOGICAL SITE NUMBER * B2 = ADDRESS OF USER COUNT TABLE * B3 = INCREMENT OR DECREMENT * * ON EXIT - X1 = NEW USER COUNT * * ENTRY ALTSC ALTSC EQ * SA1 B1 LOAD LOGICAL SITE NUMBER SB1 B2 SAVE ADDRESS OF COUNT TABLE CALL SCINDEX MX0 -9 SA1 X2+B1 LOAD PROPER WORD OF TABLE LX1 X1,B2 POSITION COUNT FOR THIS SITE BX6 X0*X1 BX1 -X0*X1 MASK OFF THIS COUNT SX1 X1+B3 INCREMENT OR DECREMENT + PL X1,*+1 SX1 0 DONT ALLOW NEGATIVE COUNT + BX1 -X0*X1 BX6 X1+X6 RE-COMBINE SB1 60 SB1 B1-B2 COMPUTE SHIFT COUNT LX6 X6,B1 SA6 A1 EQ ALTSC * * /--- BLOCK SITE COUNT 00 000 76/01/30 16.49 * * * * -GETSC- * OBTAINS COUNT OF USERS FOR THIS SITE AND LESSON * * ON ENTRY - B1 = ADDRESS OF LOGICAL SITE NUMBER * B2 = ADDRESS OF USER COUNT TABLE * * ON EXIT - X1 = USER COUNT * * GETSC EQ * SA1 B1 LOAD LOGICAL SITE NUMBER SB1 B2 SAVE ADDRESS OF COUNT TABLE CALL SCINDEX MX0 -9 SA1 X2+B1 LOAD PROPER WORD OF TABLE LX1 X1,B2 POSITION COUNT FOR THIS SITE BX1 -X0*X1 MASK OFF THIS COUNT EQ GETSC * * * * -SCINDEX- * ON ENTRY - X1 = LOGICAL SITE NUMBER * * ON EXIT - X2 = WORD COUNT * B2 = SHIFT COUNT * * SCINDEX EQ * PX2 X1 NX2 X2 CONVERT TO FLOATING POINT SA3 =6.0 FX2 X2/X3 COMPUTE WORD INDEX SA3 =0.01 FX2 X2+X3 AVOID ROUND-OFF ERROR NX2 X2 UX2 X2,B2 LX2 X2,B2 CONVERT BACK TO INTEGER SX3 6 DX3 X2*X3 IX3 X1-X3 COMPUTE REMAINDER SB2 X3+9 LX3 3 COMPUTE SHIFT COUNT SB2 X3+B2 EQ SCINDEX * * * /--- BLOCK BIT TABLES 00 000 76/01/27 17.03 TITLE BIT TABLE MANIPULATION * * * * -SSETBIT- * ON ENTRY - X1 = INDEX IN BIT TABLE * B1 = ADDRESS OF BIT TABLE * * MUST NOT DESTROY A0,X0 * * ENTRY SSETBIT SSETBIT EQ * RJ SSINDEX GET INDEX IN BIT TABLE SA2 X2+B1 LOAD PROPER WORD OF TABLE SX6 1 LX6 X6,B2 POSITION BIT BX6 X2+X6 SA6 A2 STORE TABLE WORD WITH BIT SET EQ SSETBIT * * * * -CCLRBIT- * ON ENTRY - X1 = INDEX IN BIT TABLE * B1 = ADDRESS OF BIT TABLE * * MUST NOT DESTROY A0,X0 * * ENTRY CCLRBIT CCLRBIT EQ * RJ SSINDEX COMPUTE INDEX IN BIT TABLE SA2 X2+B1 LOAD PROPER WORD MX6 -1 LX6 X6,B2 POSITION BIT BX6 X6*X2 SA6 A2 STORE WITH BIT CLEARED EQ CCLRBIT * * * * -STSTBIT- * ON ENTRY - X1 = INDEX IN BIT TABLE * B1 = ADDRESS OF BIT TABLE * * ON EXIT - X6 = -1 IF BIT SET * 0 IF BIT NOT SET * * ENTRY STSTBIT STSTBIT EQ * RJ SSINDEX GET INDEX IN BIT TABLE SA2 X2+B1 LOAD PROPER WORD OF TABLE SX6 1 LX6 X6,B2 POSITION BIT BX6 X2*X6 MASK PROPER BIT ZR X6,STSTBIT MX6 -1 MARK BIT SET EQ STSTBIT * * * /--- BLOCK BIT TABLES 00 000 78/02/27 20.40 * * * -SSINDEX- * ON ENTRY - X1 = INDEX IN BIT TABLE * * ON EXIT - X2 = WORD COUNT * B2 = SHIFT COUNT * * ENTRY SSINDEX SSINDEX EQ * PX2 X1 NX2 X2 CONVERT TO FLOATING POINT SA3 =60.0 FX2 X2/X3 COMPUTE WORD INDEX SA3 =0.01 FX2 X2+X3 AVOID ROUND-OFF ERROR NX2 X2 UX2 X2,B2 LX2 X2,B2 CONVERT BACK TO INTEGER SX3 60 DX3 X2*X3 IX3 X1-X3 COMPUTE REMAINDER SB2 X3 EQ SSINDEX * * * * -TABLTST- * LOGICAL AND OF TWO BIT TABLES * * ON ENTRY - B1 = ADDRESS OF 1ST BIT TABLE * B2 = ADDRESS OF 2ND BIT TABLE * * ON RETURN - X6 = 0 IF LOGICAL PRODUCT WAS ZERO * -1 IF LOGICAL PRODUCT NON-ZERO * * ENTRY TABLTST TABLTST EQ * MX6 0 PRE-SET SB3 LBITLTH-1 * TBTLP SA1 B3+B1 LOAD NEXT TABLE 1 ENTRY SA2 B3+B2 LOAD NEXT TABLE 2 ENTRY BX1 X1*X2 BX6 X1+X6 SB3 B3-1 END TEST PL B3,TBTLP NG X6,TBTX1 SEE IF LOGICAL PRODUCT ZERO ZR X6,TABLTST * TBTX1 MX6 -1 EQ TABLTST * * * * * -IBIT- INITIALIZES FOR -NEXTBIT- * ON ENTRY - B1 = ADDRESS OF BIT TABLE * * ENTRY IBIT IBIT EQ * SX6 B1 SET TABLE ADDRESS SA6 NA MX6 0 SA6 NS CLEAR WORD/SHIFT COUNTS SA6 NW EQ IBIT * * * * ENTRY NA,NS,NW USED BY -SITE- IN EXEC8 NA BSS 1 NS BSS 1 NW BSS 1 * * * /--- BLOCK BIT TABLES 00 000 78/12/31 03.29 * * * * -NEXTBIT- * FINDS NEXT LIT BIT OF STATION BIT TABLE * * ON ENTRY - *NA* = ADDRESS OF BIT TABLE * *NS* = SHIFT COUNT * *NW* = WORD COUNT * * ON RETURN - X1 = NEXT STATION NUMBER * -1 IF END OF BIT TABLE * ENTRY NEXTBIT * NEXTBIT EQ * SA1 NA SET TABLE ADDRESS SA0 X1 SA1 NS SET SHIFT COUNT SB1 X1 SA1 NW SET WORD BIAS SB2 X1 NG B2,NEND SX0 1 INITIALIZE MASK SB3 60 END TEST * NWLP SA1 A0+B2 LOAD NEXT WORD OF BITS NG X1,NBLP ZR X1,NWLP1 JUMP IF NO BITS NBLP LX2 X0,B1 BX2 X2*X1 MASK OFF NEXT BIT NZ X2,NFND SB1 B1+1 INCREMENT SHIFT COUNT LT B1,B3,NBLP NWLP1 SB1 B0 RE-INITIALIZE SHIFT COUNT SB2 B2+1 INCREMENT WORD COUNT SX1 B2-LBITLTH NG X1,NWLP * NEND MX1 -1 RETURN -1 FOR END OF TABLE NEND1 SX6 -1 SA6 NW EQ NEXTBIT * NFND SX0 B2 STATION NUMBER = 60*B2+B1 SX1 B3 DX0 X0*X1 SX1 X0+B1 RETURN X1 = STATION NUMBER SB1 B1+1 INCREMENT SHIFT COUNT LT B1,B3,NFND1 SB1 B0 RE-INITIALIZE SHIFT COUNT SB2 B2+1 ADVANCE TO NEXT WORD SB3 B2-LBITLTH NG B3,NFND1 EQ NEND1 * NFND1 SX6 B1 SAVE SHIFT COUNT SA6 NS SX6 B2 SAVE WORD COUNT SA6 NW EQ NEXTBIT * * END