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