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