plato:source:plaopl:autload
Table of Contents
AUTLOAD
Table Of Contents
- [00005] AUTOLOAD
- [00020] -CSINIT- INITIALIZATIONS
- [00073] -CSLOAD- LOAD RVARS,LVARS,NCVARS,JBUFFS
- [00136] -LOADCS- LOAD COMMON/STORAGE
- [00434] ECSERRS
- [00476] RLOAD
- [00540] -CSULOAD- UNLOAD RVARS,LVARS,NCVARS,JBUFFS
- [00581] -ULOADCS- UNLOAD COMMON AND STORAGE
- [00812] LESADD
- [00833] -RESVREL-
- [00895] NOJBUF
- [00919] GJBUF - ALLOCATE A JUDGE BUFFER
- [00995] RJBUF - RETURN JUDGE BUFFER TO POOL
- [01055] NJBMSG - ISSUE ERROR MESSAGE AND ABORT.
Source Code
- AUTLOAD.txt
- 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
plato/source/plaopl/autload.txt · Last modified: 2023/08/05 18:54 by Site Administrator