AUTLOAD
* /--- FILE TYPE = E
* /--- BLOCK AUTLOAD 00 000 79/01/04 09.05
IDENT AUTLOAD
TITLE AUTOLOAD
*
* GET COMMON SYMBOL TABLE
*
CST
*
*
EXT ECSPRTY
EXT ECSERRB
EXT LSNADDR
*
LOADFLG BSSZ 1
*
*
* /--- BLOCK CSINIT 00 000 79/02/09 13.53
TITLE -CSINIT- INITIALIZATIONS
*
*
* -CSINIT-
* INITIALIZE STORAGE/COMMON LOADING
*
*
ENTRY CSINIT
CSINIT EQ *
MX6 0 PRE-SET
SA6 TCOMSET
SA6 TCOMSET+1
SA6 TCOMSET+2
SA6 TSTOSET
SA6 TSTOSET+1
SA6 TSTOSET+2
CALL INROUTE
PL X1,CSINIT0 IF NOT IN ROUTER LESSON
SA1 TBRVNUM
ZR X1,CSINIT1 JUMP IF NO ROUTER VARIABLES
MX6 1
BX6 X1+X6 SET ROUTER VARIABLE LOAD BIT
SA6 A1
EQ CSINIT1
*
CSINIT0 MX6 1 CLEAR ROUTER VARIABLE LOAD BIT
SA1 TBRVNUM
BX6 -X6*X1
SA6 A1
*
CSINIT1 SA1 TBCOMLS
ZR X1,CSINIT JUMP IF NO COMMON
NG X1,CSINIT JUMP IF NO AUTO-LOADING
SX1 X1
CALL READLES,WORK,1
SA2 WORK
SX2 X2 GET LENGTH OF COMMON
* WHEN NC VAR LIMIT WAS CHANGED FROM 1500 TO 3000, HAD TO
* KEEP THE ORIGINAL VALUE 1500 SINCE PREVIOUS LESSONS
* DEPENDED ON THAT VALUE FOR LOADING COMMON AND STORAGE.
* IF THIS CHECK WAS NOT CHANGED, LESSONS USING 1501-3000
* WORD COMMONS WOULD AUTOLOAD, WHEN THEY WERE DESIGNED
* NOT TO AUTOLOAD (BECAUSE AT THAT TIME THE LIMIT WAS
* 1500). CHECK 1500 INSTEAD OF *NCVRLIM*. CMH 08/02/94
SB1 X2-1500-1
PL B1,CSINIT JUMP IF TOO LONG TO LOAD
LX2 18+18
SX6 NCVRBUF STARTING ADDRESS FOR NCVARS
BX6 X2+X6 FORM *TCOMSET* ENTRY
SA6 TCOMSET
EQ CSINIT
*
* /--- BLOCK CSLOAD 00 000 79/01/04 14.32
TITLE -CSLOAD- LOAD RVARS,LVARS,NCVARS,JBUFFS
*
*
* -CSLOAD-
* AUTOMATIC LOADING OF RVARS, LVARS, AND NCVARS
* ALSO LOADS JUDGING BUFFERS IF NEEDED
*
* USES'; A0,A1,A2,A3,A6,A7
* X0,X1,X2,X3,X4,X6,X7
* B1,B2,B3
*
*
*
ENTRY CSLOAD
CSLOAD EQ *
SX6 -1 SET CSU LOADED
SA6 LOADFLG
IFNE DDEBUG,0,1
SA6 =XCSFLG
*
SA1 TBRVNUM ROUTER VARIABLES LESSON NUMBER
PL X1,LLOAD SIGN BIT = IN-ROUTER FLAG
SX2 X1 GET LESSON NUMBER
SX3 2 BIAS FOR HEADER
CALL LESSADD
AX1 18 GET NUMBER OF VARIABLES
SB1 X1
BX0 X7 ECS ADDRESS OF VARIABLES
SA0 RVARBUF
+ RE B1 LOAD ROUTER VARIABLES
RJ ECSR
*
LLOAD SA1 TLVLESS LOCAL VAR LESSON WORD
ZR X1,CLOAD IF NO LOCALS
* THE NEXT 5 LINES MAY BE UNNECESSARY SINCE THEY
* ARE DONE IN PINITX
AX1 18 MOVE LESSON NUMBER
SX2 X1 STRIP LESSON NUMBER
SX3 LVHEAD HEADER LENGTH
RJ LESSADD GET ADDRESS INTO X7
SA7 =XLVECSAD
CALL LVLOAD,1 LOAD LOCAL VARS FOR THIS UNIT
*
CLOAD MX6 0 ZERO MAX NC VARS LOADED
SA6 MAXLOAD
CALL LOADCS LOAD COMMON/STORAGE
SA1 MAXLOAD SEE IF ANY COM/STO LOADED
ZR X1,CSJUDG IF NONE LOADED, DONT CHANGE
BX6 X1
SA6 LASTUSE UPDATE LAST USED WORD COUNT
*
CSJUDG CALL LOADJDG LOAD JUDGE BUFF TO CM/RELEASE
*
EQ CSLOAD -- EXIT
*
*
ENTRY MAXLOAD
MAXLOAD BSS 1 MAXIMUM NC VARS LOADED ON SLICE
*
ENTRY LASTUSE
LASTUSE BSS 1 MAX NC VARS LAST USED
*
* /--- BLOCK LOADCS 00 000 79/02/16 20.44
TITLE -LOADCS- LOAD COMMON/STORAGE
*
*
* -LOADCS-
* AUTOMATIC LOADING OF COMMON AND STORAGE
*
ENTRY LOADCS
LOADCS EQ * ENTRY/EXIT
*
SA1 TCOMSET
ZR X1,SLOAD JUMP IF NO COMMON AUTO-LOAD
SA3 TBCOMLS
SX2 X3 PICK OFF LESSON NUMBER
ZR X2,SLOAD JUMP IF NO COMMON
SX3 COMHEAD
CALL LESSADD GET ADDRESS OF COMMON LESSON
* TEMPORARY TRAP TO VERIFY COMMON ASSIGNED TO
* THIS EXECUTOR
SX3 COMHEAD-LCMLOC
IX0 X7-X3
RX2 X0
SA3 EXID
AX2 18
SX2 X2
BX2 X2-X3
NZ X2,"CRASH" IF COMMON NOT ON THIS EXECUTOR
* END OF TRAP
*
* X1 = 6/0, 18/LENGTH, 18/ECS, 18/CM
* X7 = ECS ADDRESS
* IN LINE TO SAVE TIME
*
CALL LOADCOM
*
SA1 TCOMSET+1
ZR X1,SLOAD JUMP IF NO MORE COMMON LOADS
*
CALL LOADCOM
*
SA1 TCOMSET+2
ZR X1,SLOAD JUMP IF NO MORE COMMON LOADS
*
CALL LOADCOM
*
* /--- BLOCK LOADCS 00 000 79/09/14 10.06
SLOAD SA1 TSTOSET
ZR X1,LOADCS -- EXIT IF NO STORAGE TO LOAD
SA2 TBXSTOR STORAGE LESSON NUMBER
ZR X2,LOADCS -- EXIT IF NO STORAGE TO LOAD
SX3 2 BIAS FOR STORAGE HEADER
CALL LESSADD
*
CALL LOADSTO
*
SA1 TSTOSET+1
ZR X1,LOADCS -- EXIT IF NO MORE LOADS
*
CALL LOADSTO
*
SA1 TSTOSET+2
ZR X1,LOADCS -- EXIT IF NO THIRD LOAD
*
CALL LOADSTO
*
EQ LOADCS --- EXIT
*
***
*
* LOADCOM - LOAD COMMON MEMORY
*
LOADCOM EQ * ENTRY/EXIT
CALL LOADSET
+ RE B1
RJ ECSC
EQ LOADCOM -- EXIT
*
***
*
* LOADSTO - LOAD STORAGE MEMORY
*
LOADSTO EQ * ENTRY/EXIT
CALL LOADSET
+ RE B1
RJ ECSS
EQ LOADSTO -- EXIT
***
*
* LOADSET - SET COMMON/STORAGE MEMORY POINTERS
*
LOADSET EQ * ENTRY/EXIT
SA0 X1 PICK OFF CM ADDRESS
AX1 18
SX2 X1 PICK OFF ECS BIAS
AX1 18
SB1 X1 PICK OFF LENGTH TO LOAD
IX0 X2+X7
SX2 A0+B1 FIND LAST NC WORD IN BUFFER
SX6 NCVRBUF START OF NC WORD BUFFER
IX6 X2-X6 FIND TRUE LAST NC WORD
SA1 MAXLOAD SEE IF MAX NC VAR LOADED
IX2 X1-X6 LARGER'/
PL X2,LOADSET BRIF -- IF NO CHANGE, EXIT
SA6 A1 SAVE NEW SIZE
*
EQ LOADSET -- EXIT
*
* /--- BLOCK LOADJDG 00 000 79/02/14 00.13
*
*********************************************** LOADJDG
* RETURN ECS JUDGE BUFFER TO POOL AND SET CENTRAL
* MEMORY JUDGING BUFFERS FROM IT.
*
ENTRY LOADJDG
LOADJDG EQ * ENTRY/EXIT
*
SA1 TJUGBUF SEE IF HAVE AN ECS JUDGE BUFFER
SX1 X1
ZR X1,LOADJDG --- EXIT IF NONE
PL X1,RETJ1
*
SX6 0
SA6 TJUGBUF
EQ LOADJDG --- EXIT
RETJ1 BSS 0
*
* RESTORE ALL BUFFERS SAVED IN ECS
*
SX6 0 FIRST, CLEAN LOTS OF FLAGS
SA6 JUDGE THEY MAY BE RESET BY FOLLOWING
SA6 JJSBUFA
SA6 JJCONPK
SA6 JJFBUF
SX7 -1
SA7 JJSTORE MUST SET HERE FOR CHAR COUNT=0
*
SA1 TJUGBUF X1 HOLDS THE BUFFER ASSIGNED
SA2 XJBANKS GET ECS ADDRESS OF START OF BUFFER
SX1 X1-1 NOW CALCULATE STARTING ECS ADDRESS OF BUF
SX3 JBXSAVE
IX0 X1*X3 RELATIVE START
IX0 X2+X0 ABSOLUTE START
*
SA1 TJCOUNT CHARACTER COUNT
ZR X1,RETJBO IF ZERO, SKIP LOADING BUFFERS
*
JTOTAL SET 0
*
SX7 1 X7 = CONSTANT 1
*
SA0 JUDGE GET CHARACTERS INTO CM
SB1 X1
SX2 X1-JJALIM-1 SEE IF CAN DO WITHOUT UNPACKING
PL X2,RETPACK
*
****************************************************** JUDGE
*
+ RE B1 READ-IN JUDGE CHARACTERS
RJ ECSPRTY
IX0 X0+X1
*
MX6 0
SA6 B1+JUDGE ZERO OUT EXTRA CHARACTER
* /--- BLOCK RETJBUF 00 000 76/05/26 15.51
*
***************************************************** JJCHAR
*
RET3 SA0 JJCHAR READ IN COUNT CORRESPONDENCE
+ RE B1
RJ ECSPRTY
IX0 X0+X1
EQ RETBEST
*
*
****************************************************** JUDGE
*
JTOTAL SET JTOTAL+JJALIM
RETPACK SX3 10 10 CHARACTERS PACKED PER WORD
SB2 0 INDEX INTO -JUDGE-
SB3 0 PACKED WORD IN -WORK-
SX2 B1-1 NUMBER OF CHARACTERS MINUS 1
MX4 54 6 BIT MASK
*
SA0 JJHBUF READ IN THE PACKED BUFFER
+ RE JJALIM MAXIMUM POSSIBLE LENGTH
RJ ECSPRTY
*
SA1 A0 BRING UP FIRST 10 CHARS
*
RETP1 LX1 6
BX6 -X4*X1 GET 6-BIT CHARACTER
SA6 JUDGE+B2 STORE THIS CHARACTER
SB2 B2+X7 ADD ONE
IX3 X3-X7 SUBTRACT ONE
NZ X3,RETP1 DO 10 AT ONCE
*
SB3 B3+X7 ADD ONE
SX3 10
IX2 X2-X3
SA1 JJHBUF+B3 GET NEXT 10 CHARACTERS
PL X2,RETP1
*
SX1 B3
IX0 X0+X1
*
MX6 0
SA6 B1+JUDGE ZERO OUT EXTRA CHARACTER
*
*
***************************************************** JJCHAR
*
JTOTAL SET JTOTAL+JJCLIM
RET4 SX3 6 6 COUNTS PACKED PER WORD
SB2 0 INDEX INTO -JJCHAR-
SB3 0 PACKED COUNTS IN -WORK-
SX2 B1-1 NUMBER OF CHARACTERS MINUS 1
MX4 51 9 BIT MASK
*
SA0 JJHBUF
+ RE JJCLIM MAXIMUM POSSIBLE LENGTH
RJ ECSPRTY
*
SA1 A0 BRING UP FIRST 6 COUNTS
LX1 6 GET FIRST COUNT TO TOP
*
RETP2 LX1 9
BX6 -X4*X1 GET 6-BIT CHARACTER
SA6 JJCHAR+B2 STORE THIS COUNT
SB2 B2+X7 ADD ONE
IX3 X3-X7 SUBTRACT ONE
NZ X3,RETP2 DO 6 AT ONCE
*
SB3 B3+X7 ADD ONE
SX3 6
IX2 X2-X3
SA1 JJHBUF+B3 GET NEXT 6 COUNTS
LX1 6 AND FIRST TO TOP
PL X2,RETP2
*
SX1 B3
IX0 X0+X1
* /--- BLOCK RETJBUF 00 000 79/02/09 10.05
*
*
**************************************************** JJSBUFA
*
JTOTAL SET JTOTAL+JJINF
JTOTAL SET JTOTAL+JJSENB
RETBEST SA0 JJSBUFA SET BEST JUDGING BUFFER
+ RE JJINF+JJSENB
RJ ECSPRTY
*
SX1 JJINF+JJSENB
IX0 X0+X1
*
*
******************************************************* JJXY
*
JTOTAL SET JTOTAL+JJSENB
SA0 JJXY SET TO WORD-CHARACTER COUNT
+ RE JJSENB
RJ ECSPRTY
SX1 JJSENB
IX0 X0+X1
*
*
**************************************************** JJSTORE
*
JTOTAL SET JTOTAL+1
RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
BX6 X1
SA6 JJSTORE
IX0 X0+X7 ADD ONE
* CHECK FOR -2, IN WHICH CASE IT CAN NOT BE COMPILED
SX2 X1-2
ZR X2,RETJBO THEN LEAVE IT -2
SX6 -1 ELSE SET IT TO UN-COMPILED
SA6 A6 RE-STORE *JJSTORE*
*
*
*
IFGE JTOTAL,JBXSAVE,1 SEE IF NOT ENOUGH SPACE IN ECS BUFR
ERR
* IF THE ABOVE ERROR OCCURS, YOU MUST INCREASE
* THE LENGTH PARAMETER *JBXSAVE* IN FILE PLATXT.
*
*
RETJBO SA1 TJUGBUF
CALL RJBUF RETURN JUDGE BUFFER
MX6 59 FLAG MIGHT NEED BUFFER AGAIN
SA6 TJUGBUF
*
EQ LOADJDG --- EXIT
* /--- BLOCK ECSX 00 000 76/05/26 16.20
TITLE ECSERRS
*
* ECS PARITY ERROR HANDLING -
*
ECSR EQ * ERROR IN ROUTER VARIABLES
RJ ECSERRB MUST IMMEDIATELY FOLLOW ECSR
SA1 TBRVNUM
EQ ECSX
*
ECSC EQ * ERROR IN ROUTER VARIABLES
RJ ECSERRB MUST IMMEDIATELY FOLLOW ECSR
SA1 TBCOMLS ERROR IN COMMON VARIABLES
EQ ECSX
*
ECSS EQ * ERROR IN ROUTER VARIABLES
RJ ECSERRB MUST IMMEDIATELY FOLLOW ECSR
SA1 TBXSTOR ERROR IN STORAGE VARIABLES
EQ ECSX
*
*
ECSX MX6 0 CLEAR OUT POINTER TO LESSON
SA6 A1
SX6 X1 PICK UP LESSON NUMBER
SA6 LESNUM
CALL IOLESSN,LESNUM,0400B PIN LESSON IN ECS
SA1 LESNUM
CALL LSNADDR GET ECS ADDR OF *LESNAM* ENTRY
SA0 ECSNAM
+ WE 2 DESTROY LESSON NAME
RJ ECSPRTY
MX6 0 CLEAR LESSON / ROUTER FLAGS
SA6 ILESUN
SA6 TROUINF
SA6 TROUINF+2
CALL FAIL,3 ABORT THIS STUDENT
*
*
ECSNAM DATA 10L//ECSERR//
DATA 10L//ECSERR//
*
*
* /--- BLOCK RLOAD 00 000 78/12/18 20.47
TITLE RLOAD
*
*
* -RLOAD- LOAD ROUTER VARIABLES
*
* CALLED FROM ONE PLACE IN -LESSONS-
*
*
ENTRY RLOAD
RLOAD EQ *
ZERO RVARBUF,RVARLIM PRE-ZERO BUFFER
SA1 TBRVNUM ROUTER VARIABLES LESSON NUMBER
SX2 X1 GET LESSON NUMBER
ZR X2,RLOAD
SX3 2 BIAS FOR HEADER
CALL LESSADD
AX1 18 GET NUMBER OF VARIABLES
SB1 X1
BX0 X7 ECS ADDRESS OF VARIABLES
SA0 RVARBUF
+ RE B1 LOAD ROUTER VARIABLES
RJ ECSR
EQ RLOAD
*
*
* /--- BLOCK + LVLOAD 00 000 85/11/20 07.51
*
* -LVLOAD- LOAD LOCAL VARIABLES
*
* ENTER'; B1 = -1 UNLOAD, 1 LOAD
* EXIT'; X2 = 0 IF NONE LOADED, ELSE UNDEFINED
* CALLED FROM CSLOAD, CSULOAD, JOIN, UNJOIN
*
ENTRY LVLOAD
*
LVLOAD EQ *
SA1 TLVLESS LOAD LOCAL VAR LESSON NUMBER
SA2 LVUCNT NUMBER IN CURRENT UNIT
ZR X2,LVLOAD1 SKIP ERR CHK IF NO LVARS IN UNIT
ZR X1,BADLV ERROR IF NO LOCALS BUFFER
LVLOAD1 SB2 X2 B2 = NUMBER OF LVARS IN UNIT
SX6 X1 X6 = CURRENT STACK POINTER
ZR X2,LVLOAD QUIT IF NO LVARS IN UNIT
SA2 =XLVECSAD GET ECS ADDRESS OF LV BUFFER
IX0 X2+X6 ECS ADDR OF CURRENT UNITS LVARS
SA0 LVARBUF CM LOCAL VARS BUFFER
NG B1,LVULOAD UNLOAD IF B1 = -1
+ RE B2 LOAD LOCAL VARS
RJ ECSPRTY
EQ LVLOAD
*
LVULOAD WE B2 UNLOAD LOCAL VARS
RJ ECSPRTY
EQ LVLOAD
*
BADLV SA1 ILESUN GET CURRENT UNIT INFO
SA2 ECSULOC X2 = ECS ADDR. OF -ULOC- TABLE
SX1 X1 X1 = UNIT NUMBER ONLY
IX0 X1+X2 X0 = ECS ADDR. OF THIS -ULOC- ENTRY
RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
BX6 X1
SA6 =XWORK SAVE IT FOR LATER
EXECERR 45 LOCALS SI, STACK NO
* /--- BLOCK CSULOAD 00 000 79/01/04 14.33
TITLE -CSULOAD- UNLOAD RVARS,LVARS,NCVARS,JBUFFS
*
*
* -CSULOAD-
* AUTOMATIC UNLOADING OF RVARS,LVARS, AND NCVARS
*
* USES'; A0,A1,A2,A3,A6
* X0,X1,X2,X3,X6,X7
* B1,B2,B3
*
*
ENTRY CSULOAD
CSULOAD EQ *
SX6 0 CLEAR LOADED FLAG
SA6 LOADFLG
IFNE DDEBUG,0,3
SA1 =XCSFLG
ZR X1,"CRASH" IF CONSECUTIVE UNLOADS
*
+ SA1 TBRVNUM ROUTER VARIABLES LESSON NUMBER
PL X1,LULOAD SIGN BIT = IN-ROUTER FLAG
SX2 X1 GET LESSON NUMBER
SX3 2 BIAS FOR HEADER
CALL LESSADD
AX1 18 GET NUMBER OF VARIABLES
SB1 X1
BX0 X7 ECS ADDRESS OF VARIABLES
SA0 RVARBUF
+ WE B1 UNLOAD ROUTER VARIABLES
RJ ECSPRTY
*
LULOAD SA1 TLVLESS LOCAL VAR LESSON WORD
ZR X1,CULOAD IF NO LOCALS
CALL LVLOAD,-1 UNLOAD LOCAL VARIABLES
*
CULOAD CALL ULOADCS UNLOAD COMMON AND STORAGE
CSUJUDG CALL SAVEJDG SAVE JUDGE BUFFERS (IF ANY)
*
EQ CSULOAD -- EXIT
*
* /--- BLOCK ULOADCS 00 000 79/02/14 11.50
TITLE -ULOADCS- UNLOAD COMMON AND STORAGE
*
*
* -CSULOAD-
* AUTOMATIC UNLOADING OF COMMON AND STORAGE
*
ENTRY ULOADCS
ULOADCS EQ * ENTRY/EXIT
*
SA1 TCOMSET
ZR X1,SULOAD JUMP IF NO COMMON AUTO-LOAD
SA3 TBCOMLS
SX2 X3 PICK OFF LESSON NUMBER
ZR X2,SULOAD JUMP IF NO COMMON
LX3 1
NG X3,SULOAD JUMP IF READ-ONLY COMMON
SX3 COMHEAD
CALL LESSADD GET ADDRESS OF COMMON LESSON
*
* IN LINE FOR SPEED
*
CALL UNLOAD
*
SA1 TCOMSET+1
ZR X1,SULOAD
*
CALL UNLOAD
*
SA1 TCOMSET+2
ZR X1,SULOAD
*
CALL UNLOAD
*
SULOAD SA1 TSTOSET
ZR X1,ULOADCS -- EXIT IF NO STORAGE TO LOAD
SA2 TBXSTOR STORAGE LESSON NUMBER
ZR X2,ULOADCS -- EXIT IF NO STORAGE
SX3 2 BIAS FOR STORAGE HEADER
CALL LESSADD
*
CALL UNLOAD
*
SA1 TSTOSET+1
ZR X1,ULOADCS -- EXIT IF NO SECOND LOAD
*
CALL UNLOAD
*
SA1 TSTOSET+2
ZR X1,ULOADCS -- EXIT IF NO THIRD LOAD
*
CALL UNLOAD
*
EQ ULOADCS --- EXIT
*
***
*
* UNLOAD - UNLOAD COMMON/STORAGE MEMORY
*
UNLOAD EQ * ENTRY/EXIT
SA0 X1 PICK OFF CM ADDRESS
AX1 18
SX2 X1 PICK OFF ECS BIAS
AX1 18
SB1 X1 PICK OFF LENGTH TO UNLOAD
IX0 X2+X7
+ WE B1
RJ ECSPRTY
EQ UNLOAD -- RETURN
*
* /--- BLOCK SAVEJDG 00 000 79/02/14 00.12
*
************************************************* SAVEJDG
* GET ECS JUDGE BUFFER AND SAVE CENTRAL MEMORY
* JUDGING BUFFERS IN IT.
*
*
ENTRY SAVEJDG
SAVEJDG EQ *
SA1 TJUGBUF SEE IF NEED TO SAVE JUDGE BUFFS
SX1 X1
ZR X1,SAVEJDG NO NEED FOR ECS JUDGE BUFFERS
PL X1,GETJBX ALREADY HAVE A BUFFER
CALL GJBUF ALLOCATE A JUDGE BUFFER
NG X6,NJBMSG IF NONE AVAILABLE
SA6 TJUGBUF SET STUDENT BANK FLAG
SX1 X6 PUT BUFFER NUMBER INTO X1
*
*
* SEND ALL BUFFERS TO BE SAVED TO ECS
* X1 HOLDS BUFFER ASSIGNED FOR USE
*
* THE OPERATIONS IN THIS PART OF GETJBUF MUST BE
* DUPLICATED IN REVERSE IN RETJBUF (IN THIS FILE)
*
GETJBX SA2 XJBANKS GET ECS ADDR OF START OF BUFFER
*********************************************
* TRAP A FAULTY JUDGE BUFFER NUMBER
SX3 JBANKS NUMBER OF BUFFERS
IX3 X3-X1
NG X3,"CRASH" NUMBER .GT. MAX ALLOWED
*********************************************
SX1 X1-1 NOW CALC STARTING ECS ADDR
SX3 JBXSAVE
IX0 X1*X3 RELATIVE START
IX0 X2+X0 ABSOLUTE START
*
SA1 TJCOUNT CHARACTER COUNT
ZR X1,SAVEJDG --- EXIT IF ZERO, NOTHING TO DO
*
* JUST IN CASE PAUSE DOES NOT OCCUR NEED TO KILL
* ALL BUFFERS SINCE JJHBUF MIGHT BE DESTROYED
*
SX6 0
SA6 JJFBUF
* /--- BLOCK GETJBUF 00 000 76/05/26 15.56
*
*
SX7 1 X7 = CONSTANT 1
SA0 JUDGE SEND CHARACTERS OUT
SB1 X1
SX2 X1-JJALIM-1 SEE IF CAN DO WITHOUT PACKING
PL X2,GETPACK
*
****************************************************** JUDGE
*
+ WE B1 WRITE JUDGE CHARACTERS TO ECS
RJ ECSPRTY
IX0 X0+X1
*
*
***************************************************** JJCHAR
*
SA0 JJCHAR SEND OUT COUNT CORRESPONDENCE
+ WE B1
RJ ECSPRTY
IX0 X0+X1
EQ GETBEST
*
*
****************************************************** JUDGE
*
GETPACK MX6 0 PACK UP THE JUDGE CHARACTERS
SX3 10 PACK UP 10 CHARACTERS PER WORD
SB2 0 INDEX INTO -JUDGE-
SB3 0 PACKED WORD IN -WORK-
SX2 B1-1 NUMBER OF CHARACTERS MINUS 1
*
GETP1 LX6 6
SA1 JUDGE+B2 GET NEXT CHARACTER
BX6 X6+X1 PACK
SB2 B2+X7 ADD ONE
IX3 X3-X7 SUBTRACT ONE
NZ X3,GETP1 DO 10 AT ONCE
*
SA6 JUDGE+B3 PUT AWAY PACKED CHARS IN WORK BUFFER
SB3 B3+X7 ADD ONE
MX6 0
SX3 10
IX2 X2-X3
PL X2,GETP1
*
SA0 JUDGE
+ WE B3 PUT INTO ECS
RJ ECSPRTY
SX1 B3
IX0 X0+X1
*
*
***************************************************** JJCHAR
*
MX6 0 PACK UP THE JJCHAR COUNT
SX3 6 PACK UP 6 9-BIT COUNTS PER WORD
SB2 0 INDEX INTO -JJCHAR-
SB3 0 PACKED WORD IN -WORK-
SX2 B1-1 NUMBER OF CHARACTERS MINUS 1
*
GETP2 LX6 9 SHIFT 9 BITS
SA1 JJCHAR+B2 GET NEXT COUNT
BX6 X6+X1 PACK
SB2 B2+X7 ADD ONE
IX3 X3-X7 SUBTRACT ONE
NZ X3,GETP2 DO 6 AT ONCE
*
SA6 JUDGE+B3 PUT AWAY PACKED CHARS IN WORK BUFFER
SB3 B3+X7 ADD ONE
MX6 0
SX3 6
IX2 X2-X3
PL X2,GETP2
*
+ WE B3 PUT INTO ECS
RJ ECSPRTY
SX1 B3
IX0 X0+X1
* /--- BLOCK GETJBUF 00 000 79/02/09 10.13
*
*
**************************************************** JJSBUFA
*
GETBEST SA0 JJSBUFA SEND OUT JUDGING BUFFER
*
GETB2 WE JJINF+JJSENB
RJ ECSPRTY
SX1 JJINF+JJSENB
IX0 X0+X1
*
*
******************************************************* JJXY
*
SA0 JJXY SET TO WORD-CHARACTER COUNT
+ WE JJSENB
RJ ECSPRTY
SX1 JJSENB
IX0 X0+X1
*
*
**************************************************** JJSTORE
*
SA1 JJSTORE SAVE STORE FLAG
WX1 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*)
IX0 X0+X7 ADD ONE
*
*
EQ SAVEJDG --- EXIT
* /--- BLOCK LESSADD 00 000 78/02/20 23.59
*
TITLE LESADD
* ON ENTRY - X2 = LESSON NUMBER
* X3 = BIAS WITHIN LESSON
*
* ON EXIT - X7 = ECS ADDRESS
*
ENTRY LESSADD
*
LESSADD EQ *
LX2 2 LESSON NUMBER
SX0 X2+3 BIAS TO ECS ADDRESS
SA2 ALESNAM
IX0 X0+X2 INDEX INTO *LESNAM*
RX2 X0 (-RXX- 1 WD READ, MAY CHG *A2*)
MX7 -24
BX7 -X7*X2 MASK OFF ECS ADDRESS
ZR X7,"CRASH" -- TRAP FOR EM ADDR = 0
IX7 X7+X3 ELSE, ADD BIAS
EQ LESSADD -- EXIT SUBROUTINE
*
* /--- BLOCK RESVREL 00 000 76/05/26 15.53
TITLE -RESVREL-
*
*
*
* -RESVREL-
* CLEAR LESSON AND COMMON INITIALIZATION FLAGS AND
* COMMON RESERVATION FLAG IF SET TO THIS STATION
*
*
ENTRY RESVREL
RESVREL EQ *
SA1 STATION GET STATION NUMBER
SX5 X1+1
SA1 ILESUN
AX1 18 POSITION LESSON NUMBER
ZR X1,RVR300
CALL READLES,INFO,(LINTLOK+1)
SA1 INFO+LINTLOK
SX2 X1 PICK OFF STATION NUMBER
ZR X2,RVR300
IX2 X2-X5 CHECK IF THIS STATION
NZ X2,RVR300
MX6 -18
BX6 X6*X1 CLEAR LESSON INITIALIZATION
SA6 A1
SX1 LINTLOK BIAS TO INTERLOCK WORD
IX0 X0+X1
* RE-WRITE INTERLOCK WORD
WX6 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*)
*
RVR300 SA2 TBCOMLS
SX1 X2 GET COMMON LESSON NUMBER
ZR X1,RESVREL
CALL READLES,INFO,(LINTLOK+1)
MX7 0
SA1 INFO+LINTLOK
SX2 X1 PICK OFF STATION NUMBER
ZR X2,RVR350
IX2 X2-X5 CHECK IF THIS STATION
NZ X2,RVR350
MX7 -18
BX1 X7*X1 CLEAR LESSON INITIALIZATION
*
RVR350 BX2 X1 GET INTERLOCK WORD
AX2 18
SX2 X2 GET STATION NUMBER
ZR X2,RVR400
IX2 X2-X5 CHECK IF THIS STATION
NZ X2,RVR400
MX7 -18 SET UP MASK FOR RESERVE FLAG
LX7 18
BX1 X7*X1 CLEAR COMMON RESERVATION FLAG
*
RVR400 ZR X7,RESVREL EXIT IF NO CHANGES
BX6 X1
SA6 A1
SX1 LINTLOK BIAS TO INTERLOCK WORD
IX0 X0+X1
* RE-WRITE INTERLOCK WORD
WX6 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*)
EQ RESVREL
* /--- BLOCK NOJBUF 00 000 76/05/26 15.53
TITLE NOJBUF
*
* MAKE FOR NO ECS JUDGE BUFFER
*
* USES A - 1,6
* X - 1,6
* B - NONE
*
* CALLS - RJBUF.
*
*
ENTRY NOJBUF
*
NOJBUF EQ *
SA1 TJUGBUF GET BANK FLAG
SX1 X1
ZR X1,NOJBUF
NG X1,NOJBUF1
CALL RJBUF RETURN JUDGE BUFFER TO POOL
NOJBUF1 MX6 0
SA6 TJUGBUF SET FOR NO JUDGE BUFFER
EQ NOJBUF
* /--- BLOCK GJBUF 00 000 83/07/27 09.22
GJBUF SPACE 5,11
** GJBUF - ALLOCATE A JUDGE BUFFER
*
* USES A - 0,1,2,6
* X - 0,1,2,6
* B - 1,2
*
* EXIT - (X6) = JUDGE BUFFER ALLOCATED
* -1 IF NONE AVAILABLE
*
* ANOTHER USE OF THE NORMALIZING BIT-TABLE ALGOR.
*
* NOTE THAT ALTHOUGH THE MAX NUMBER OF BUFFERS IS
* 48 IN /PLATXT/, THIS GIZMO IS BUILT TO HANDLE
* A MULTI-WORD TABLE ENDING WITH A ZERO WORD.
*
ENTRY GJBUF
GJBUF PS
INTLOK X,I.JUDG,W
SA1 AJBUFFU (X1) = EM FWA OF JBUFF USE BITS
BX0 X1
SA0 JBUFBIT
+ RE JBITLEN
RJ ECSPRTY
SA1 AJBSTAT READ STATISTICS WORDS TOO
BX0 X1
SA0 JBUFCNT
+ RE 4
RJ ECSPRTY
SA1 JBUFBIT (X1) = BITS OF ALLOCATED BUFFER
* SEARCH FOR AVAILABLE BUFFER
GET2 BSS 0
NG X1,"CRASH" -- SHOULD NEVER HAVE NEG. ENTRY
NX2 X1 FIND FIRST FREE BUFFER
NZ X2,GET3 IF AVAILABLE BUFFERS
SA1 A1+1 GET NEXT 48 BITS
NZ X1,GET2 IF MORE WORDS IN TABLE
INTCLR X,I.JUDG
MX6 -1 SET RETURN TO *NONE FOUND*
EQ GJBUF
GET3 UX2,B2 X2 UNPACK NORMALIZED FORM
* (B2) = JUDGE BUFFER NUMBER
UX2,B1 X1 UNPACK UNNORMALIZED FORM
* (B1) = UNSHIFTED EXPONENT
SB1 B1-B2 (B1) = SHIFT COUNT
MX6 1 1/1, 59/0
LX6 48 12/0, 1/1, 47/0
AX6 B1,X6 SHIFT 1 TO BUFFER POSITION
BX2 X6*X1 SAVE CURRENT STATUS OF BUFFER
BX6 -X6*X1 CLEAR OUT THIS BIT
SA6 A1 STORE UPDATED FLAGS
ZR X2,"CRASH" -- BUFFER WAS ALREADY ON LOAN
SA1 JBUFCNT INCREMENT PEOPLE JUDGING
SA2 JMAXBUF
SX6 X1+1
SA6 A1
IX2 X2-X6
PL X2,GET4 IF NOT NEW MAXIMUM
SA6 A2
GET4 WE 4 UPDATE STATISTICS WORDS
RJ ECSPRTY
SA1 AJBUFFU UPDATE BIT MAP WORD(S)
BX0 X1
SA0 JBUFBIT
+ WE JBITLEN
RJ ECSPRTY
INTCLR X,I.JUDG MUST SAVE B2
SX6 B2 (X6) = BUFFER NUMBER
EQ GJBUF EXIT
*
* /--- BLOCK RJBUF 00 000 78/12/15 08.33
RJBUF SPACE 5,11
** RJBUF - RETURN JUDGE BUFFER TO POOL
*
* USES A - 0,1,2,6
* X - 0,1,2,6
* B - 1,2
*
* ENTRY - (X1) = JUDGE BUFFER TO RETURN
ENTRY RJBUF
RJBUF PS
SX7 X1 SAVE JUDGE BUFFER NUMBER
NG X7,"CRASH"
ZR X7,"CRASH"
INTLOK X,I.JUDG,W MUST SAVE X7
SX1 X7 RESTORE JUDGE BUFFER NUMBER
SA2 AJBUFFU
BX0 X2 (X0) = EM FWA OF JBUFF USE BITS
SA0 JBUFBIT (A0) = CM FWA OF JBUFF USE BITS
+ RE JBITLEN GET JBUFF ALLOCATED BITS
RJ ECSPRTY
SA2 AJBSTAT READ STATISTICS WORDS TOO
BX0 X2
SA0 JBUFCNT
+ RE 4
RJ ECSPRTY
SA2 JBUFCNT DECREMENT PEOPLE JUDGING
SX6 X2-1
NG X6,"CRASH" -- OOPS, GAINED A BUFFER
SA6 A2
* SET JBUFBIT TO INDICATE BUFFER RETURNED
SB1 B0
RET1 SX1 X1-49 SEE WHAT WORD BIT IS IN
NG X1,RET2
SB1 B1+1
SX1 X1+1
EQ RET1
RET2 SB2 X1+49 GET SHIFT COUNT
MX6 1
LX6 B2,X6 SHIFT BIT
SA1 JBUFBIT+B1 LOAD BIT WORD
BX2 X1*X6 SAVE CURRENT STATUS OF BIT
BX6 X1+X6 THEN SET THE BIT
SA6 A1 AND STORE
+ WE 4 UPDATE STATISTICS WORDS
RJ ECSPRTY
SA1 AJBUFFU UPDATE BIT MAP
BX0 X1
SA0 JBUFBIT
+ WE JBITLEN GET JBUFF ALLOCATED BITS
RJ ECSPRTY
INTCLR X,I.JUDG MUST SAVE X2
NZ X2,"CRASH" -- WE ALREADY HAD THIS BUFFER
EQ RJBUF EXIT
*
SPACE 3
** NJBMSG - ISSUE ERROR MESSAGE AND ABORT.
ENTRY NJBMSG
NJBMSG CALL S=MSG,NJBMSGA
EXECERR 54 SYSTEM ERROR - NO JUDGE BUFFER
*
NJBMSGA DIS ,*NO JUDGE BUFFERS AVAILABLE.*
*
* /--- BLOCK ENDX 00 000 78/12/15 08.33
END