Retro1.org codex

EXEC1 
* /---   FILE TYPE = E
* /---   BLOCK      EXEC1      00 000   77/08/24  16.02 
          IDENT  EXEC1
          TITLE  EXEC1 --  EXECUTION-INTERPRETER
* 
*            THIS IS THE DRIVER FOR EXECUTION OF ALL
*         TUTOR COMMANDS. 
* 
* 
*         GET COMMON SYMBOL TABLE 
* 
          CST 
* 
* 
          TITLE  PLATO EXECUTION REGISTER CONVENTIONS 
* 
*         THE FOLLOWING REGISTERS ARE RESERVED DURING THIS
*         PROGRAM.  THEY MUST BE SAVED AND RESTORED IF ANY
*         SUBPROGRAM USES THEM. 
* 
*         A5 - ADDRESS OF COMMAND (X5 HOLDS COMMAND)
*         B4 - BASE ADDRESS OF STUDENT VARIABLES (V0) 
*         B5 - BASE ADDRESS OF EXTRA STORAGE
*         B6 - BASE ADDRESS OF COMMON VARIABLES 
*         B7 - STUDENT CONTINGENCY TYPE CODE
* 
* 
*         NCTYPE HOLDS CONTINGENCY (AS WELL AS B7)
* 
*         0 = UNIT-C
*         1 = ARROW-C 
*         2 = JUDGE-C 
*         3 = ANS-C 
*         4 = SEARCH-C
*         5 = TERM FOUND-C
*         6 = NEXT-NOW-C
*         7 = ALL-OK-C
*         8 = ARROW OK-C
*         9 = INITIAL LESSON ENTRY-C
* 
* /---   BLOCK      ENTRY      00 000   79/02/09  22.12 
          TITLE  ENTRY POINTS 
* 
* 
          ENTRY  BOUNDS,PROCESS,PROCO,PROC,GETN 
          ENTRY  VARCNT,GETCODX,ILOC
          ENTRY  VARADD,XDATA,YDATA,EXECSAV 
          ENTRY  CUNIT,GETTAG 
          ENTRY  GET2 
          ENTRY  GETN 
          ENTRY  GET2F
          ENTRY  XDATA
          ENTRY  YDATA
          ENTRY  DOC= 
          ENTRY  DO=
          ENTRY  JOINC= 
          ENTRY  DOR= 
          ENTRY  JOINR= 
 
*         ENTRY POINTS NEED BY WRITE STATEMENT
 
          ENTRY  WRITE5=
          ENTRY  WRITE6=
* 
          ENTRY  ARGS=,STORE=,ANSV=,WRONGV=,COMPUT= 
          ENTRY  TOUCHW=
* 
          ENTRY  WRONG=,WRONGC=   USED IN FILES ANSW1 
          ENTRY  WRONGA=     USED IN ANSW1
          ENTRY  MISCON=   IN FILE ANS1 
* 
* 
* /---   BLOCK      EXTERNAL   00 000   79/01/20  13.11 
          TITLE  EXTERNAL SYMBOL DEFINITIONS
* 
          EXT    EXCHNX 
          EXT    JOINX,JOINCX,ARGSX,JUMPXX,JUMPXC 
          EXT    IEUENDX
          EXT    GOTOX,GOTOCX,DOX,DOLX,DOFX,DOFLX 
          EXT    POSTCMS,TOOMUCH
          EXT    ERXUNUS,ERXCNUM,ERXDFIN,ERXBADL,ERXPOS 
          EXT    ERXSTN,ERXJOIN,ERXOVRT,ERXMXLC 
          EXT    ERXINDL
          EXT    FINDX,FINDAX,TSTBINX 
          EXT    BLOCKX,ADD1X,SUB1X 
          EXT    CODOUTX,COMMX,SCOMMX,TABX
          EXT    COPYX,JKEYX,DATEX,CLOCKX 
*          EXT    PLAYX,MIKEX,EXCHANX,CONDENX,DISKX 
          EXT    PLAYX,MIKEX,EXCHANX,CONDENX
          EXT    ENABLEX,DISABLX
          EXT    DELAYX,AFONTX
          EXT    CHECKX,NAMEX,GROUPX,DAYX,ZEROX,ZEROXX
          EXT    RESTX,ITOAX,EDITX
          EXT    BUMPX,CODEX
          EXT    SYSLESX,CONTROX    (EXEC2) 
          EXT    ERROROF,RETRNX,RETRNZ
          EXT    OKWORDX,NOWORDX,CPULIMX
          EXT    MODESEX,BITSOUX,ZFILLX,SIGNIX
          EXT    ASCIIX 
          EXT    LOGICX,STOPCHK,CCLRXX
          EXT    GETCX
          EXT    PAUSEX,PAUSEH
          EXT    COLLCTX     (LOGICX) 
          EXT    DRAWX,RDRAWX,GDRAWX    (EXEC2) 
          EXT    SETX 
          EXT    TWRTCX      *** NEW -WRITEC- COMMAND 
          EXT    WRSOUT      WRITE (KEYSIN) 
          EXT    MEMOUT      LOAD MEMORY (KEYSIN) 
          EXT    ARRPLT      PLOT SUPER BIG AND NICE ARROW (KEYSIN) 
          EXT    TUERASE     SIZED ERASE (LINWRT) 
          EXT    FAKEPLT     RESET X AND Y  (KEYSIN)
          EXT    FIRSTXY     GET STARTING ARROW X AND Y (KEYSIN)
          EXT    XYFIX       UPDATE X-Y AND SAVE FOR ANS-C (TUTOUT) 
          EXT    WIPE        ERASE ENTIRE ANSWER (KEYSIN) 
          EXT    LWIPE       LARGE CHARS ERASE
          EXT    SIZEX,ROTATEX   (LINWRT) 
          EXT    SIMPLOT     SIMULATE PLOTTING (SIMPLOT)
* 
          EXT    STORAGX
          EXT    CHARSET     (MICROX) 
          EXT    CHARTST     (MICROX) 
          EXT    RQPRINX
          EXT    CONDRQX
          EXT    OTOAX
          EXT    CLEANX 
* /---   BLOCK      EXTERNAL   00 000   79/01/20  13.23 
          EXT    SYSLOX,AREAX,READSEX 
          EXT    PACKRX 
          EXT    OUTDATX,OUTDATL,SCOREX,LSNX,LSNCX,STLSTAT
          EXT    OUTDATT
          EXT    READDX 
          EXT    GETCHRX
          EXT    REFONTX      (IOPUT) 
          EXT    GETUNIT,UNITGOB  (GETUNIT) 
          EXT    JOUTX
          EXT    LINWRT      LINE MODE OUTPUT (LINWRT)
          EXT    RCTOXY      USED BY TOUCH AND OTHERS (ARROW) 
          EXT    READRX,RDRINF   (DATAX)
          EXT    ATTACHX,DETACHX (FILEX)
          EXT    DATAINX,DATOUTX (FILEX)
          EXT    GETLINX,SETLINX (FILEX)
          EXT    IOSPECX         (FILEX)
          EXT    MATCHX      (ANSWER) 
          EXT    CLOSEX      (ANSWER) 
          EXT    SPECX       (ANSWER) 
          EXT    EXACTX      EXACT STRING MATCH (ANSWER)
          EXT    ANSXX       (ANSWER) 
          EXT    ANSDOS      (ANSWER) 
          EXT    WRONG       (ANSWER) 
          EXT    WRONGS      (ANSWER) 
          EXT    ANSVX       (ANSWER) 
          EXT    PANSKEY     (ANSWER) 
          EXT    ANSKEYX     (ANSWER) 
          EXT    CNCEPTX     CONCEPT JUDGER (ANSWER)
          EXT    LOADAX      (ANSWER) 
          EXT    WRONGVX     (ANSWER) 
          EXT    OPENX       (ANSWER) 
          EXT    STORENX     STORE NUMERIC (ANSWER) 
          EXT    GETWDX,GETMKX,COMPX,GETLOCX      (ANSWER)
          EXT    EXACTVX     (ANSWER) 
          EXT    EXACTCX     CONDITIONAL EXACT
          EXT    OKX         (ANSWER) 
          EXT    ANSEND      (ANSWER) 
          EXT    ANSMARK     (ANSWER) 
          EXT    JOVER       (ANSWER) 
* 
          EXT    SHOW        SHOW SUBROUTINE (EXEC2)
          EXT    SHOWT       SHOWT SUBROUTINE 
          EXT    SHOWZ       SHOWZ SUBROUTINE 
* 
          EXT    FGETVAR     VARIABLE EVALUATION ROUTINE (GETVAR) 
          EXT    NGETVAR     INTEGER GETVAR ROUTINE (GETVAR)
* 
          EXT    ECSPRTY     SYSTEM ECS PARITY ROUTINE (ECSPRT) 
          EXT    EXIT        EXIT FROM EXECUTION  (LOGIC) 
          EXT    PJUDGOO     INITIATE JUDGING (LOGIC) 
          EXT    OUTFLOW,FINISH 
          EXT    MOVEX       MOVE COMMAND (EXEC3) 
          EXT    TRANSX      TRANSFR COMMAND (EXEC3)
          EXT    KERMITX     KERMIT PROTOCOL (EXEC3)
          EXT    JMPOUTX     JUMPOUT (TUTORX) 
          EXT    FEDITX      FILEDIT (TUTORX) 
          EXT    FONTX       FONT (EXEC3) 
          EXT    STORAGX     STORAGE (TUTORX) 
          EXT    SIGNINX     SIGNIN (TUTORX)
          EXT    CONDENX     CONDENS (TUTORX) 
          EXT    EXCHANX     EXCHANGE (TUTORX)
          EXT    CCLEARX     CCLEAR (TUTORX)
* /---   BLOCK      EXTERNAL   00 000   78/12/18  21.19 
* 
          EXT    SETRX       SETRESV     DATAX
* 
*         NEW DISK SYSTEM COMMANDS IN FILE IOPUT
* 
          EXT    SETPACX           SET PACK NAME
          EXT    SETFILX           SET FILE INFO WORD 
          EXT    ATTCHPX,DETCHPX   ATTACH, DETACH FILE
          EXT    ATTFX,DETFX       ATTACHF,DETACHF
          EXT    READFX,WRITEFX    READF/WRITEF 
          EXT    RENAMFX           RENAME FILE
          EXT    RETYPFX           RETYPE FILE
          EXT    CREATEX,DESTROX   CREATE, DESTROY FILE 
          EXT    DREADX,DWRITEX    DISK I/O (RELATIVE)
          EXT    DINX,DOUTX,DSTATX
          EXT    DISKIX,DISKOX     DISK I/O BY SECTORS (ABSOLUTE) 
          EXT    DSKREAX,DSKWRIX   DISK I/O BY SECTORS (RELATIVE) 
*          EXT    DATASEX           DATASET 
          EXT    ATTCHX,DETCHX     ATTACH/DETACH FILES
* 
          EXT    MOUTX0            WRITE COMMAND
          EXT    MOUTIT            WRITE COMMAND
          EXT    MOUTX             WRITE COMMAND
          EXT    MOUTMX            WRITE COMMAND
          EXT    EWRITE            WRITE COMMAND
          EXT    EWRITEX           WRITE COMMAND
          EXT    OFFEBX            WRITE COMMAND
          EXT    NEXACTX     NEW EXACTC IN ANSWER 
* 
          EXT    STEPX
          EXT    RESIGNX     IN FILE LCOMND 
          EXT    OUTACC      IN MAIN (FOR USE BY -EXT-) 
* 
          EXT    MESSAGX
* 
          EXT    RETARGX     NEW -RETURN- COMMAND 
          EXT    DORX,JOINRX PSEUDO COMMANDS FOR RARGS
* 
          EXT    ANSAXXX     (ANSWERA)
          EXT    COLORXX     (EXEC7)
          EXT    TWINDOW     (GETVAR) 
* 
* /---   BLOCK      JUMP MACRO 00 000   79/03/21  21.25 
          TITLE  JUMP TABLE 
* 
*            'FOR COMMANDS WITH ONLY ONE BRANCH, THE BRANCH 
*         IS EXPLICITLY GIVEN IN THE BOTTOM 18 BITS OF THE
*         TABLE ENTRY.  'IF BRANCHES DIFFER WITH CONTINGENCY, 
*         THE BOTTOM 18 BITS POINT TO A SECONDARY BRANCH
*         TABLE.  'SEE BELOW FOR EXPLANATIONS REGARDING 
*         THE JUMPOV MACRO. 
* 
 JUMP     MACRO  NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L
 N1       MICRO  1,1, CONTG 
 N2       MICRO  2,1, CONTG 
 N3       MICRO  3,1, CONTG 
 N4       MICRO  4,1, CONTG 
 N5       MICRO  5,1, CONTG 
          VFD    1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2
 NN       SET    NN+1 
          ENDM
* 
*            JUMP1 AND ARG1 PERTAIN TO CONDENSE ROUTINE 
*         AND JUMP2 AND ARG2 TO THE EXECUTION ROUTINE.
*         'IN EACH CASE, IF JUMP IS ',CM', THEN ARG GIVES 
*         THE CENTRAL MEMORY ADDRESS OF THE PROCESSING
*         ROUTINE; OTHERWISE, JUMP IS THE OVERLAY NUMBER
*         AND ARG CONTAINS ANY ARGUMENT TO BE PASSED IT.
* 
 JUMPOV   MACRO  NAME,NAM,TYPE,JUMP1,ARG1,CONTG,JUMP2,ARG2
 N1       MICRO  1,1, CONTG 
 N2       MICRO  2,1, CONTG 
 N3       MICRO  3,1, CONTG 
 N4       MICRO  4,1, CONTG 
 N5       MICRO  5,1, CONTG 
          VFD    1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",10/0
          IFC    NE,*JUMP2*CM*
 DD       DECMIC JUMP2
          IF     DEF,D"DD"$,1 
          ERR                NON-EXECUTABLE OVERLAY 
          VFD    9/JUMP2,18/ARG2,18/PROCOV
          ELSE
          VFD    27/0,18/ARG2 
          ENDIF 
 N6       MICRO  3,8, NAME_=
 "N6"     EQU    NN 
 NN       SET    NN+1 
          ENDM
* 
 JUMPD    MACRO  NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L
 N1       MICRO  1,1, CONTG 
 N2       MICRO  2,1, CONTG 
 N3       MICRO  3,1, CONTG 
 N4       MICRO  4,1, CONTG 
 N5       MICRO  5,1, CONTG 
          VFD    1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2
 N6       MICRO  3,8, NAME_=
 "N6"     EQU    NN 
 NN       SET    NN+1 
          ENDM
* 
 JUMP*    MACRO  NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L
 N1       MICRO  1,1, CONTG 
 N2       MICRO  2,1, CONTG 
 N3       MICRO  3,1, CONTG 
 N4       MICRO  4,1, CONTG 
 N5       MICRO  5,1, CONTG 
          VFD    1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2
 NN       SET    NN+1 
          ENDM
* 
 JUMPD*   MACRO  NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L
 N1       MICRO  1,1, CONTG 
 N2       MICRO  2,1, CONTG 
 N3       MICRO  3,1, CONTG 
 N4       MICRO  4,1, CONTG 
 N5       MICRO  5,1, CONTG 
          VFD    1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2
 N6       MICRO  3,8, NAME_=
 "N6"     EQU    NN 
 NN       SET    NN+1 
          ENDM
* 
 JUMPF    MACRO 
          ENDM
* 
 JUMPI    MACRO 
          ENDM
* 
*         USED ONLY IN CONDENSOR FOR NON-EXECUTABLE 
*         COMMANDS IN OVERLAYS
* 
 JUMPIO   MACRO 
          ENDM
* 
* /---   BLOCK      JUMP MACRO 00 000   79/03/21  21.25 
 JUMPP    MACRO 
          ENDM
* 
* /---   BLOCK      JUMP MACRO 00 000   79/03/21  21.25 
 JUMPPO   MACRO 
          ENDM
* 
* 
* /---   BLOCK      RETPROC    00 000   78/04/02  03.16 
          TITLE  RETPROC -- RELOAD UNIT AFTER I/O COMMAND 
* 
* * *     UNFINISHED BUSINESS...
*         THIS MIGHT BE A BIT MESSY HERE UNTIL OTHER
*         PLACES ARE CLEANED UP.  THE IDEA IS THAT ALL
*         CHECKS FOR EXCESSIVE DISK ACCESSING SHOULD BE 
*         HERE.  PROBLEMS NEEDING WORK';
* 
*         NEEDS EXCESSIVE 'D'A'P'M CHECK...LIKE IOCHK...HERE AND
*         NOT ALL OVER THE PLACE. 
* 
* * *     RETPROC 
* 
*         ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS.
*         RETURN AFTER COMMANDS THAT DID DISK ACCESSES AND
*         THAT USED -SAVLES- (OR HAVE UNLOADED';  COMMON, 
*         STORAGE, ANSWER-JUDGING BUFFERS, UNIT, ETC.). 
*         -STOP1- KEY WILL BE CHECKED FOR.
*         EXCESSIVE PROCESSING WILL BE CHECKED FOR. 
* * * 
* 
          ENTRY  RETPROC
 RETPROC  CALL   RESTLES     RESTORE COMMON, UNIT, ETC
*                            INFO PREVIOUSLY SAVED BY 
*                            CALL TO SAVLES 
* /---   BLOCK      CKPROC     00 000   79/10/09  23.45 
          TITLE  CKPROC -- RETURN FROM INTERRUPT COMMANDS 
* 
* * *     CKPROC
* 
*         ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS.
*         RETURN AFTER COMMANDS THAT DO DISK ACCESSES.
*         -STOP1- KEY WILL BE CHECKED FOR.
*         TOO MUCH PROCESSING WILL BE CHECKED FOR.  THIS
*         CAN COME ABOUT WHEN SERIES OF COMMANDS INTERNALLY 
*         INTERRUPT (E.G., DISK ACCESSING) WITHOUT EVER 
*         CAUSING A TIME-SLICE EXCEEDED BUT USE ENUF CPU
*         TIME FREQUENTLY ENUF TO GO OVER THE ALLOWED TIPS. 
* 
* 
          ENTRY  CKPROC 
 CKPROC   BSS    0
          SA1    STFLAGS     SEE IF -STOP1- PRESSED SINCE 
          LX1    -ST1BIT     STARTED RUNNING IN THIS LESSON 
          NG     X1,CKPROCA 
          LX1    ST1BIT-SSBBIT  TEST IF BACKOUT IN PROGRESS 
          NG     X1,CKPROC2     (IN SPECIAL STOP1 LESSON) 
 
*         CHECK FOR UNPROCESSED OUTPUT IN THE PLATO TO
*         FORMAT BUFFERS.  IF YES, END THIS TIME SLICE. 
 
          SA1    OUTMOUT
          SA2    SUBMOUT
          IX1    X1-X2
          ZR     X1,CKPROC2  IF NO UNPROCESSED OUTPUT 
          CALL   TFIN        ELSE, END THIS TIMESLICE 
          EQ     CKPROC      TRY AGAIN
 
 CKPROCA  BSS    0
* 
          CALL   STOPCHK     X2=0 IF STOP1 HANDLING LESSON
          SX6    STOP1
          SA6    KEY         MAKE SURE KEY=STOP1
* 
          ZR     X2,CKPROC2  SEPARATE STOP1-LESSONS 
* 
          SA1    STFLAGS     SEE IF ALREADY IN FINISH UNIT
          LX1    60-FINBIT
          PL     X1,FINISH   --- BRANCH IF NOT FINISH UNIT
* 
          SA3    TDSKACC     IN FINISH UNIT 
          MX6    1           INCREMENT DISK ACCESS COUNT
          LX6    55 
          IX6    X3+X6
          SA6    A3 
          LX6    6
          MX3    54 
          BX3    -X3*X6 
          SX3    X3-10-1     NO MORE THAN 10 ACCESSES 
          PL     X3,ERXDFIN  CANNOT ALLOW MORE IN FINISH U
* 
 CKPROC2  CALL   COMPTIM     CHECK FOR TOO MUCH PROCESSING
          NG     B2,PROCESS  CONTINUE 
          EQ     XSL2        END IF TOO MUCH PROCESSING 
* /---   BLOCK      PROCESX    00 000   78/05/17  21.08 
          ENTRY  PROCESX
*         PROCESS RETURN FOR COMMANDS THAT SET EXECERR
*         ARG NUMBER
 PROCESX  SX6    0
          SA6    ERXARGN
          EQ     PROCESS
* /---   BLOCK      RETPRO     00 000   79/09/01  19.35 
          TITLE  RETPRO -- RELOAD UNIT AND CONTINUE 
* 
* * *     RETPROS,RETPRO
* 
*         ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS.
*         RETURN AFTER COMMANDS THAT USED -SAVLES- (OR HAVE 
*         UNLOADED'; COMMON,STORAGE,ANSWER-JUDGING BUFFERS, 
*         UNIT (MUST CALL GETUNIT),ETC.)
*         THOSE THAT INTERRUPTED SHOULD USE -RETPROS- TO
*         IMMEDIATELY CATCH ANY -STOP1- KEYS THE USER MAY 
*         HAVE PRESSED. 
* 
* * * 
* 
          ENTRY  RETPROS     SOME INTERRUPT HAS OCCURRED
*                            SO -STOP1- MUST BE CHECKED FOR.
 RETPROS  SA1    STFLAGS     SEE IF -STOP1- PRESSED 
          LX1    -ST1BIT
          PL     X1,RETPRO
          SX6    STOP1       MAKE SURE KEY=STOP1
          SA6    KEY
          CALL   STOPCHK     SEE IF LESSON HANDLES STOP1
          NZ     X2,FINISH   IF NOT, START FINISH UNIT
*          SA1    STFLAGS     CLEAR -STOP1- BIT FOR SYSTEM
*          MX6    1             LESSONS THAT HANDLE IT
*          LX6    ST1BIT
*          BX6    -X6*X1
*          SA6    A1
* 
          ENTRY  RETPRO 
 RETPRO   CALL   RESTLES     RESTORE COMMON, UNIT, ETC
*                            INFO PREVIOUSLY SAVED BY 
*                            CALL TO SAVLES 
*         ON TO PROCESS 
* /---   BLOCK      PROCESS    00 000   80/04/22  00.55 
          TITLE  PROCESS -- CHECK IF TIMESLICE OVER 
* 
* * *     PROCESS 
* 
*         ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS.
*         ENTRY AFTER COMMANDS THAT DO NOT DO ANY DISK
*         ACCESSES BUT ARE LONG ENOUGH IN PROCESSING (SAY 
*         OVER 0.1 MS) TO POSSIBLY CAUSE THE TIME-SLICE TO
*         BE EXCEEDED.  THE STANDARD RETURN FOR COMMANDS. 
* 
* 
          ENTRY  PROCESS
 PROCESS  SA1    XSLCLOK     GET RUNNING MS CLOCK 
          SA2    MAXCLOK     GET END OF TIME-SLICE
          IX2    X1-X2
          PL     X2,XXSLICE  EXIT IF TIME-SLICE OVER
* /---   BLOCK      PROC       00 000   80/04/22  00.56 
          TITLE  PROC -- EXECUTE NEXT COMMAND 
* 
* * *     PROC
* 
*         ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS 
*         ENTRY AFTER COMMANDS THAT TAKE PRACTICALLY NO 
*         PROCESSING TIME (SAY A FEW MICROSECONDS) AND MAKE 
*         NO DISK ACCESSES.  A WHOLE UNIT FULL OF THESE 
*         COMMANDS SHOULD NOT CONSUME A TIME-SLICE. 
* 
* * * 
          ENTRY  PROC,PROC1 
 PROC     SA1    SCOMFLG     STEP MODE OVERWRITES THIS WORD 
          NZ     X1,SPROC    SEE IF COMMAND STAT FLAG IS ON 
 PROC1    SA5    A5-1        LOAD NEXT COMMAND
          MX0    60-XCMNDL
          BX4    -X0*X5      GET ONLY COMMAND BITS
          SA1    X4+JTABLE   LOAD COMMAND TABLE ENTRY 
          SB1    X1          WHERE TO JUMP
          LX1    B7,X1       SHIFT TO PROPER CONTINGENCY BIT
          PL     X1,PROC1    IGNORE IF NOT VALID IN THIS CONTINGENCY
          JP     B1          JUMP TO EXECUTION ROUTINE
* 
* 
*         SPECIAL PROCESSOR FOR STATISTICS TAKING 
*         SAVES TIME IN NORMAL NON-STAT LOOP
* 
*         SEE ALSO -- TUTIM PROCESSING IN TUTORX
* 
 SPROC    PL     X1,SPROC1
          RJ     POSTCMS     TAKE COMMAND STAT IF FLAG SET
 SPROC1   SA5    A5-1        LOAD NEXT COMMAND
          MX0    60-XCMNDL
          BX4    -X0*X5      GET ONLY COMMAND BITS
          SA1    X4+JTABLE   LOAD COMMAND TABLE ENTRY 
          SB1    X1          WHERE TO JUMP
          LX1    B7,X1       SHIFT TO PROPER CONTINGENCY BIT
          PL     X1,SPROC1   IGNORE IF NOT VALID IN THIS CONTINGENCY
          BX6    X4 
          SA6    SCOMNUM     SAVE COMMAND NUMBER
          SA2    SCOMLES
          ZR     X2,SPROC1A  0 INDICATES ALL LESSONS
          SA3    TBLESSN
          BX2    X2-X3       SEE IF NEEDED FOR THIS LESSON
          NZ     X2,SPROC2   JUMP TO EXECUTION IF NOT NEEDED
 SPROC1A  SA2    XSLCLOK
          BX6    X2 
          SA6    SCOMBEG     SAVE BEGIN EXECUTION TIME
          SA2    SCOMFLG
          BX6    -X2         COMPLIMENT FLAG
          SA6    A2          SET COMMAND STATISTICS FLAG ON 
 SPROC2   JP     B1          JUMP TO EXECUTION ROUTINE
* 
* 
* /---   BLOCK      PROCO      00 000   78/04/02  03.02 
          TITLE  PROCO -- RETURN FROM OUTPUT COMMANDS 
* 
* * *     PROCO 
* 
*         RETURN FOR COMMANDS THAT PUT OUTPUT INTO -MOUT- 
*         IT CHECKS WHETHER -MOUT- IS GETTING FULL AND
*         DOES AN INTERRUPT IF SO.  THIS RETURN AVOIDS
*         HAVING ALL THESE COMMANDS DO THIS TEST SOMEWHERE. 
* 
* * * 
          ENTRY  PROCO
 PROCO    SA1    AOUTLOC
          SX1    X1-AOUTLTH/2 
          PL     X1,PCO10    CHECK ACTION REQ BUFFER FILLING
*         IF THIS IS A DSN SITE CHECK IF TOO MUCH OUTPUT
*         IN MOUT BUFFER SO THAT PARCEL BUFFER OVERFLOW 
*         WILL NOT OCCUR WHEN THE DSN OUTPUT SLOWS UP.
DSNMOUT   SA1    STATION
          AX1    5
          SA2    AFRAMID
          IX0    X1+X2
          RX2    X0 
          SB2    X2 
          SB1    DSN0FOD
          LT     B2,B1,NAMMOUT
          SB1    B1+MXDSN 
          GE     B2,B1,NAMMOUT
          SA1    MOUTLOC
          SX1    X1-MOUTDSN 
          EQ     PCO05
 
*         DO THE SAME IF NAM SITE 
 
 NAMMOUT  SB1    NAM0FOD
          LT     B2,B1,CIUMOUT
          SB1    B1+MXNAM 
          GE     B2,B1,CIUMOUT
          SA1    MOUTLOC
          SX1    X1-MOUTNAM 
          EQ     PCO05
 
*         OTHERWISE ITS A CIU SITE
 
 CIUMOUT  SA1    MOUTLOC
          SX1    X1-MOUT200 
 PCO05    PL     X1,PCO10    CHECK IF *MOUT* BUFFER FILLING 
 CHKPRC   SA1    PARCLCNT 
          SX1    X1-PRCLIM   CHECK FOR TOO MUCH ACCUMULATED 
          NG     X1,PROCESS 
* 
 PCO10    SA1    INARGS 
          NZ     X1,PROC     EXIT IF ARGUMENTS IN HAND
          SA1    TBITS
          LX1    BRKBIT      CHECK IF AUTO-BREAK SURPRESSED 
          NG     X1,PROCESS 
          SA1    INEMBED     CHECK IF EMBEDDED WRITE
          ZR     X1,XXSLICE 
          CALL   WINTRP      INTERRUPT
          EQ     PROCESS
* /---   BLOCK      PROCOV     00 000   78/04/02  03.01 
          TITLE  PROCOV -- LOAD COMMAND OVERLAY AND EXECUTE 
* 
*         -PROCOV-
* 
*         LOAD THE COMMAND EXECUTION OVERLAY AND BEGIN
*         EXECUTION.
* 
*         A1 = ADDRESS OF JUMP TABLE ENTRY
* 
* 
 PROCOV   SA1    A1          RE-LOAD COMMAND TABLE ENTRY
          LX1    -36         SHIFT OVERLAY ARG TO TOP 18
          BX6    X1 
          AX6    -18         EXTEND SIGN BIT OVER WORD
* 
*         SOME COMMANDS ENTER HERE WITH (X6) = ARGUMENT 
*         AND (X1) = OVERLAY NUMBER 
* 
 PROCOV1  SA6    OVARG1 
          MX7    -9 
          BX7    -X7*X1      MASK OFF OVERLAY NUMBER
          MX6    0
          SA6    =XOVRSTAK   CLEAR OVERLAY STACK
          CALL   EXECOV0     LOAD AND EXECUTE OVERLAY (X7)
          EQ     ERXOVRT     OVERLAY SHOULD NOT RETURN HERE 
* /---   BLOCK      XXSLICE    00 000   80/04/22  00.57 
          TITLE  XXSLICE -- END TIME SLICE
* 
 XXSLICE  SA1    INEMBED
          NZ     X1,PROC     EXIT IF IN EMBEDDED WRITE
          SA1    INARGS 
          NZ     X1,PROC     EXIT IF ARGUMENTS IN HAND
          SA1    TBITS
          LX1    BRKBIT 
          NG     X1,TOOMUCH  JUMP IF AUTO-BREAK SUPPRESSED
* 
* 
          ENTRY  XSLICE 
* 
 XSLICE   SA1    SCOMFLG
          PL     X1,XSL2     JUMP IF NO STATISTICS
          CALL   POSTCMS     TAKE COMMAND STATISTICS
* 
 XSL2     CALL   TFIN        END THIS TIME SLICE
          EQ     PROCESS
* 
* 
* 
          TITLE  PRE-CHECK FOR OUTPUT COMMANDS
* 
* 
*         -OPRECHK- 
* 
          ENTRY  OPRECHK
 OPRECHK  EQ     *
          SA1    RSIZE
          ZR     X1,OPRE1    IF SIZE NOT 0
          SA1    MOUTLOC
          SX2    X1-MOUT200 
          PL     X2,OPREWT   JUMP IF MUCH OUTPUT
* 
 OPRE1    SA1    XSLCLOK     GET CPU USE CLOCK
          SA2    MAXCLOK     GET END OF TIME SLICE
          IX2    X1-X2
          NG     X2,OPRECHK 
* 
* 
 OPREWT   SA1    TBITS
          LX1    BRKBIT      CHECK IF AUTO-BREAK SUPPRESSED 
          NG     X1,OPRECHK 
          SA5    A5+1        BACKSPACE COMMAND POINTER
          EQ     XXSLICE
* 
* 
          TITLE  COMMAND JUMP TABLE 
* 
* 
*                COMMAND JUMP TABLE 
*         THE TOP NTH BIT OF THE WORD IF SET MEANS THE COMMAND IS VALID 
*         IN CONTINGENCY *N*. THE BOTTOM 18 BITS HOLD THE BRANCH ADDRESS
* 
* 
* 
* 
          ENTRY  JTABLE 
 JTABLE   BSS    0
* 
          NOREF  NN 
 NN       SET    0           DEFINE NAMES 
 
* 
          LIST   X,G
*CALL      COMNDS 
* 
*         ALLOW A FEW EXTRA ENTRIES SO NEW COMMANDS MAY 
*         BE ADDED TO CONDENSOR WITHOUT REQUIRING A 
*         RE-ASSEMBLY OF EXEC1
* 
          JUMP*  UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS 
          JUMP*  UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS 
          JUMP*  UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS 
          JUMP*  UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS 
          JUMP*  UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS 
* 
          LIST   *
 
          ENTRY  CREATE=
 DESTRY=  EQU    DESTROY= 
          ENTRY  DESTRY=
 RENAMF=  EQU    RENAMEF= 
          ENTRY  RENAMF=
 RETYPF=  EQU    RETYPEF= 
          ENTRY  RETYPF=
 SYSFIL=  EQU    SYSFILE= 
          ENTRY  SYSFIL=
 
* /---   BLOCK      SECONDARY  00 000   78/08/14  00.46 
          TITLE  SECONDARY BRANCHING
* 
          ENTRY  UNIT=
 COMPUT=  EQU    COMPUTE= 
* 
* 
          ENTRY  UNITJ
* 
 UNITJ    SA1    THELPF      CHECK IF IN ON-PAGE HELP 
          NZ     X1,UNITXH
          SA1    JOIN 
 UNITJ0   NZ     X1,UNJOIN   UNJOIN IF IN JOIN
          JP     B7+*+1 
 +        EQ     EXIT 
 +        EQ     UNITAX1
 +        EQ     ANSEND 
+         SX6    EXIT 
-         EQ     CIA
 +        EQ     UNITSX1
* 
 ENDARJ   ZR     B7,PROCESS  NO PROCESSING YET IN UNIT-C
          JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     ANSEND 
 +        EQ     ANSMARK
 +        EQ     ENDARRX
* 
 ARROWJ   ZR     B7,ARROWX
          JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     ANSEND 
+         SX6    ARROWX 
-         EQ     CIA
 +        EQ     ARROWX 
 ARROWFJ  ZR     B7,ARROWFX 
          JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     ANSEND 
+         SX6    ARROWFX
-         EQ     CIA
 +        EQ     ARROWFX
 JARROWJ  ZR     B7,JARROWX 
          JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     ANSEND 
+         SX6    JARROWX
-         EQ     CIA
* 
 STOREJ   JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     STORE
 +        EQ     ANSMARK
 CLOSEJ   JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     CLOSEX 
 +        EQ     ANSMARK
 PUTJ     JP     B7+* 
+         EQ     UNITAX1
+         EQ     PUTX 
+         EQ     ANSMARK
 SPECSJ   JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     SPECX
 +        EQ     ANSMARK
 EXACTJ   JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     EXACTX 
 +        EQ     ANSMARK
 STOREAJ  JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     STOREAX
 +        EQ     ANSMARK
* /---   BLOCK      -SECONDARY 00 000   79/10/28  21.50 
 ANSVJP   JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     ANSVX
 +        EQ     ANSMARK
 CONCEPTJ JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     CNCEPTX
 +        EQ     ANSMARK
 TOUCHJ   JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     TOUCHX 
 +        EQ     ANSMARK
 LOADAJ   JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     LOADAX 
 +        EQ     ANSMARK
 WRONGVJ  JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     WRONGVX
 +        EQ     ANSMARK
 ANSKEYJ  JP     B7+* 
 +        EQ     PANSKEY
 +        EQ     ANSKEYX
 +        EQ     ANSMARK
 OPENJ    JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     OPENX
 +        EQ     ANSMARK
 OKJ      JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     OKX
 +        EQ     ANSMARK
 STORENJ  JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     STORENX
 +        EQ     ANSMARK
 EXACTVJ  JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     EXACTVX
 +        EQ     ANSMARK
 BUMPJ    JP     B7+* 
 +        EQ     UNITAX1
 +        EQ     BUMPX
 +        EQ     ANSMARK
 ORJ      JP     B7+*-1 
          EQ     DECANSCT     DECREMENT ANSCNT IF STILL IN JUDGE-C
*         THE FOLLOWING IS TO MAKE SURE THE COMMAND WHICH 
*         FOLLOWS THE -OR- IS A JUDGING COMMAND.
          SA1    A5-1        GET NEXT COMMAND WORD
          MX0    60-XCMNDL
          BX1    -X0*X1      COMMAND BITS 
          SA2    X1+JTABLE
          MX0    5
          BX2    X0*X2       MASK OFF CONTINGENCY BITS
          LX2    5
          SX2    X2-16B      CHECK IF JUDGING COMMAND 
          NZ     X2,PROCESS  IGNORE THIS COMMAND IF NOT 
          SA5    A1          SKIP NEXT COMMAND
          EQ     PROCESS
* 
 DECANSCT SA3    TANSCNT     DECREMENT ANSWER COUNTER 
          SX7    X3-1 
          SA7    A3 
          EQ     PROCESS
* 
 EXCJ     JP     B7+* 
+         EQ     UNITAX1
+         EQ     EXACTCX
+         EQ     ANSMARK
 PUTVJ    JP     B7+* 
+         EQ     UNITAX1
+         EQ     PUTVX
+         EQ     ANSMARK
 XMATCH   JP     B7+* 
+         EQ     UNITAX1
+         EQ     XMATCHX
+         EQ     ANSMARK
 XANS     JP     B7+* 
+         EQ     UNITAX1
+         EQ     XANSX
+         EQ     ANSMARK
* /---   BLOCK      SECONDARY  00 000   78/08/14  00.47 
 ANSCX    JP     B7+* 
+         EQ     UNITAX1
+         EQ     ANSCXX 
+         EQ     ANSMARK
 XANSA    JP     B7+* 
+         EQ     UNITAX1
+         EQ     XANSAX 
+         EQ     ANSMARK
* /---   BLOCK      GET2       00 000   74/09/05  15.53 
          TITLE  GENERAL TWO AND MULTI-VARIABLE PROCESSORS
*            GENERAL ROUTINE TO DECODE TWO VARIABLES WHOSE
*         GETVAR CODES ARE PACKED IN THE TOP 2*XCODEL BITS
*         OF THE COMMAND WORD.  THE RESULTANT VALUES ARE
*         STORED IN *XDATA* AND *YDATA* ON EXIT.
*         ALSO THE FIRST ARG IS IN X1 AND X6, SECOND IN X7. 
* 
 GET2     EQ     *
          NGETVAR 
          BX7    X1 
          SA7    XDATA
          SA5    A5          RETRIEVE COMMAND WORD
          LX5    XCODEL      MOVE 2ND VARIABLE TO TOP 
          NGETVAR 
          BX7    X1 
          SA7    YDATA
          SA1    XDATA
          BX6    X1          RETURN VALUES IN X1-X6, X7 
          EQ     GET2 
* 
* 
*         SUBROUTINE TO GET TWO FLOATING POINT VARIABLES
* 
 GET2F    EQ     *
          BX6    X5          SAVE X5 IN CASE IS XSTOR WD
          SA6    VARBUF+9 
          FGETVAR 
          BX7    X1 
          SA7    XDATA
          SA1    VARBUF+9    RETRIEVE COMMAND WORD
          BX5    X1          POSITION FOR GETVAR
          LX5    XCODEL      MOVE 2ND VARIABLE TO TOP 
          FGETVAR 
          BX7    X1 
          SA7    YDATA
          EQ     GET2F
* 
 XDATA    BSS    1
 YDATA    BSS    1
* 
* 
*            GENERAL ROUTINE TO DECODE MORE THAN TWO VARIABLES.  THE
*         FIRST TWO VARIABLE CODES ARE ASSUMED PACKED IN THE TOP
*         2*XCODEL BITS OF THE COMMAND WORD.  THE REMAINING BITS OF 
*         THE COMMAND WORD NOT USED BY THE COMMAND NUMBER ARE ASSUMED 
*         TO POINT TO THE STARTING EXTRA STORAGE ADDRESS WHERE THE
*         REMAINING VARIABLE CODES ARE STORED.
* 
*            ENTER WITH X6 = NUMBER OF VARIABLES TO BE DECODED.  ON EXIT
*         THE VECTOR *VARBUF* WILL CONTAIN THE ROUNDED INTEGER VALUES.
* 
 GETN     EQ     *
          RJ     GETCODX     GETVAR CODES IN VARBUF 
          SX6    VARBUF 
          SA6    VARADD      INITIALIZE CURRENT VARIABLE ADDRESS
          SA1    X6 
          BX5    X1 
 GETN2    NGETVAR            ROUNDS TO INTEGER IN X1
          SA2    VARADD      X2 = CURRENT *VARBUF* ADDRESS
          BX7    X1 
          SA7    X2          REPLACE VARIABLE CODE WITH VALUE 
          SA1    VARCNT 
          SX6    X1-1        DECREMENT COUNT OF VARIABLES TO BE DECODED 
          ZR     X6,GETN     --- EXIT IF ALL VARIABLES DECODED
          SA6    A1 
          SX7    X2+1        INCREMENT *VARBUF* ADDRESS 
          SA7    A2 
          SA1    X7          X1 = NEXT VARIABLE CODE WORD 
          BX5    X1 
          EQ     GETN2
* 
* 
* 
* /---   BLOCK      GETCODX    00 000   80/02/07  02.32 
 GETCODX  EQ     *
          SA6    VARCNT      SAVE VARIABLE COUNT
          SB1    1           B1 = 1 
          SB3    X6          B3 = COUNT 
          BX7    X5 
          SA7    VARBUF      STORE WITH 1ST VARIABLE CODE LEFT-JUSTIFIED
          LX7    XCODEL 
          SA7    VARBUF+1    STORE WITH 2ND VARIABLE CODE LEFT-JUSTIFIED
          LX7    60-XCMNDL-XCODEL 
          MX0    2*XCODEL+XCMNDL
          BX7    -X0*X7      X7 = EXTRA STORAGE POINTER 
          SA1    B5+X7       X1 = 1ST WORD OF EXTRA STORAGE 
          SB2    B1+B1       B2 = CURRENT STORAGE INDEX (2) 
 GETCOD1  BX6    X1 
          SA6    VARBUF+B2
          SB2    B2+B1
          LX6    XCODEL 
          SA6    VARBUF+B2
          SB2    B2+B1
          LX6    XCODEL 
          SA6    VARBUF+B2
          SB2    B2+B1
          SA1    A1+B1       X1 = NEXT EXTRA STORAGE WORD 
          LT     B2,B3,GETCOD1 CONTINUE IF ANOTHER WORD REQUIRED
          EQ     GETCODX
* 
 VARCNT   BSS    1           NUMBER OF VARIABLES TO DECODE
 VARADD   BSS    1           CURRENT *VARBUF* ADDRESS BEING PROCESSED 
* /---   BLOCK      CHKSET/DEF 00 000   80/03/11  23.54 
 
          TITLE  CHKSET -- SET RECORD CHECKPOINTING STATUS
* 
* *       CHKSET
* * 
* *       IF CHECKPOINTING IS ALLOWED, SET BIT IN *TRECBIT* 
* *       THAT WILL PERMIT LESSON *CHECKPT* TO RETURN THE 
* *       SIGNON RECORD TO DISK 
* 
 
          ENTRY  CHKSET 
          EXT    TCHECK      IN FILE GETVAR 
 
 CHKSET   EQ     *
          CALL   TCHECK      (X1) = -1 IF CHECKPOINTING OK
          SA2    TRECBIT     (X2) = VARIOUS FLAGS 
          MX0    1
          LX0    60-CKPTSHF  POSITION CHECKPOINTING BIT 
          PL     X1,CHKOFF   --- IF CHECKPOINTING OFF 
          BX6    X2+X0       TURN CHECKPOINTING ON
          SA6    A2 
          EQ     CHKSET 
 
 CHKOFF   BX6    -X0*X2      TURN CHECKPOINTING OFF 
          SA6    A2 
          EQ     CHKSET 
 
 
          TITLE  CHKDEF -- REVERT TO DEFAULT CHECKPT STATUS 
* 
* *       CHKDEF
* * 
* *       UPON EXIT FROM A NON-SYSTEM LESSON, REVERT TO 
* *       THE DEFAULT CHECKPOINTING STATUS AS SPECIFIED 
* *       BY THE ROUTER LESSON (OR BY LESSON *PLATO* IF 
* *       THE USER IS UNROUTED); INSTRUCTORS ALWAYS REVERT
* *       TO THE DEFAULT CHECKPOINGINT STATUS 
* 
 
          ENTRY  CHKDEF 
 
 CHKDEF   EQ     *
          SA1    TTYPE       (X1) = USER TYPE 
          SA2    TYPETAB+UT.INST
          BX1    X1-X2       CHECK IF INSTRUCTOR
          ZR     X1,CHKDEF1  --- IF INSTRUCTOR
          SA1    LESSCM+LSTOUSE 
          NG     X1,CHKDEF   --- DO NOTHING IF SYSTEM LESSON
 CHKDEF1  SA1    TRECBIT     (X1) = VARIOUS FLAGS 
          BX6    X1          SAVE COPY IN X6
          LX1    DCHKSHF     SHIFT CHECKPT DEFAULT TO SIGN
          MX0    1
          BX1    X0*X1       (X1) = CHECKPT DEFAULT 
          LX0    60-CCHKSHF  SHIFT TO CURRENT CHECKPT STATUS
          BX6    -X0*X6      CLEAR CURRENT CHECKPT STATUS 
          LX1    60-CCHKSHF 
          BX6    X1+X6       AND RESET TO CHECKPT DEFAULT 
          SA6    A1 
          CALL   CHKSET      SET OVERALL CHECKPT STATUS 
          EQ     CHKDEF 
* /---   BLOCK      -WHERE-    00 000   80/02/07  02.34 
* 
          TITLE  WHERE, WHERE(F)
*         -WHERE-  (CODE=0) 
* 
*            SINGLE VARIABLE (ROW-COLUMN POSITION) WHERE. 
* 
 WHEREX   NG     X5,WHRCON   JUMP IF PRE-CONVERTED
          NGETVAR            ROUNDS TO INTEGER IN X1
          RJ     RCTOXY      GET INTO FINE GRID 
 WHRXX    MX0    -18         LIMIT NX AND NY TO 18 BITS 
          BX6    -X0*X6 
          BX7    -X0*X7 
          SA6    NX          UPDATE WHEREX
          SA7    NY          AND WHEREY 
          MX0    -9          POSITION ON SCREEN 
          BX6    -X0*X6 
          BX7    -X0*X7 
          SA6    TBMARG      SET X-MARGIN 
          LX6    9           SHIFT X UP 9 BITS
          BX1    X6+X7       COMBINE WITH Y 
          BX4    X1 
          LX4    7+3         POSITION X/Y MARGIN FOR SIZE 
          MX0    -18
          LX0    7+3         POSITION MASK
          SA2    TBWRITE
          BX2    X0*X2       CLEAR OUT OLD X/Y MARGIN 
          BX6    X2+X4
          SA6    A2          SET NEW X/Y MARGIN 
          OUTCODE WFMCODE     FINE WHERE THAT SETS MARGINS
          EQ     PROC 
* 
 WHRCON   LX5    10          POSITION X COORDINATE
          MX0    -9 
          BX6    -X0*X5 
          LX5    9           POSITION Y COORDINATE
          BX7    -X0*X5 
          EQ     WHRXX
* 
* 
*         -WHERE(F)-  (CODE=1)
* 
*            TWO VARIABLE (FINE GRID) WHERE.
* 
 WHEREFX  RJ     GET2        GET VALUES OF 2 VARIABLES
          EQ     WHRXX
* 
* 
* /---   BLOCK      ATNM/UNIT  00 000   76/07/04  21.27 
* 
*         -ATNM- = -AT- WHICH USES OLD MARGINS
* 
 ATNMX    NG     X5,ATNM2    JUMP IF PRE-CONVERTED
          NGETVAR            ROUNDS TO INTEGER IN X1
          RJ     RCTOXY      GET INTO FINE GRID 
 ATNM1    MX0    -18
          BX6    -X0*X6      LIMIT X AND Y TO 18 BITS 
          BX7    -X0*X7 
          SA6    NX          STORE NX 
          SA7    NY          STORE NY 
          MX0    -9 
          BX6    -X0*X6 
          BX7    -X0*X7      SCREEN SETTING CAN ONLY HAVE 9 
          LX6    9           SHIFT X UP 9 BITS
          BX1    X6+X7       COMBINE WITH Y 
          OUTCODE WFCODE      FINE WHERE DOES NOT SET MARGIN
          EQ     PROC 
* 
 ATNM2    LX5    10          POSITION X COORDINATE
          MX0    -9 
          BX6    -X0*X5 
          LX5    9           POSITION Y COORDINATE
          BX7    -X0*X5 
          EQ     ATNM1
* 
* 
*         -ATNM(F)- 
* 
*            TWO VARIABLE (FINE GRID) AT--USES OLD MARGIN 
* 
 ATNMFX   RJ     GET2        GET VALUES OF 2 VARIABLES
          EQ     ATNM1
* 
* /---   BLOCK      UNIT       00 000   79/05/16  16.00 
* 
          TITLE  UNIT 
*         -UNIT-  (CODE=3)
* 
*         ARROW CONTINGENCY 
* 
          ENTRY  UNITAX1
* 
 UNITAX1  SA2    TBITS       CHECK TYPE OF ARROW
          SA1    TIARROW     FOR NORMAL ARROW 
          LX2    ARRTPBT     SET IF ARROWA
          PL     X2,UNITAXX  IF ARROW 
          SA1    TIARROWA 
 
 UNITAXX  ZR     X1,UNITAX2  IF NO -IARROW/A- UNIT
          LX1    60-12       SET UP UNIT NUMBER FOR -JOIN-
          BX7    X1          SAVE UNIT NUMBER 
          MX0    1           SET UP MASK FOR -IARROW- BIT 
          LX0    -IARRBIT 
          SA1    TBITS       WORD CONTAINING -IARROW- BIT 
          BX6    X0*X1
          NZ     X6,UNITAX2  JUMP IF UNIT ALREADY EXECUTED
          BX6    X0+X1
          SA6    A1          SET BIT TO MARK UNIT EXECUTED
          SA5    A5+1        BACK UP FOR RETURN FROM JOIN 
          BX5    X7          UNIT IN X5 
          EQ     JOINX
 
 UNITAX2  SA1    TBARROW
          MX0    -18         MASK OFF X/Y COORDS
          BX1    -X0*X1      GET X/Y COORDINATES
          OUTCODE WFMCODE    RESET -AT- FOR ARROW 
 
          SA1    LIMIT       GET -LONG- FOR ARROW 
          CALL   CLIENT,4500B,X1  SEND -ARROW- EXT + LONG 
 
          SA1    TBARROW
          PL     X1,UNITAX3  IF ARROW ALREADY PLOTTED, SKIP 
          MX0    1           SET UP FOR NEGATIVE MASK 
          BX6    -X0*X1      CLEAR PLOT BIT 
          SA6    A1          SAVE IT
          OUTARR             PLOT ARROW 
 
*         START INPUT AT ARROW BY GOING INTO *JUDGEC* STATE 
 
 UNITAX3  SB7    XJUDGEC     ENTER JUDGE-C
          EQ     EXIT 
* 
*         SEARCH CONTINGENCY
* 
 UNITSX1  SB7    XALLOKC     SET TO ALL-OK-CONTINGENCY
          SA1    TLVLESS
          ZR     X1,EXIT     IF NO LVARS, EXIT
* 
          SA5    A5+1        BACK UP A COMMAND
          EQ     ENDARRX
* /---   BLOCK      UNIT       00 000   80/03/27  17.23 
* 
*     'N'E'W -- INCLUDES CORRECTION TO FIX NEXTNOW/TIMEL
*            INTERACTION PROBLEM
* 
*         ON-PAGE HELP
* 
          ENTRY  UNITXH 
 UNITXH   SA1    JOIN        GET CURRENT JOIN DEPTH 
          NZ     X1,UNJOIN   BACK OUT ONE JOIN LEVEL
          JP     B7+*+1 
* 
+         EQ     UXH10       UNIT-C 
+         EQ     UNITAX1     ARROW-C
+         EQ     ANSEND      JUDGE-C
+         EQ     ANSMARK     ANSWER-C 
+         EQ     UXH10       SEARCH-C 
* 
* 
 UXH10    SB1    JOINLTH     LENGTH OF JOIN STACK 
 UHJ      SA1    B1+HJOIN    LOAD SAVED JOIN STACK ENTRY
          BX6    X1 
          SA6    B1+JOIN     RESTORE JOIN STACK 
          SB1    B1-1 
          PL     B1,UHJ      END TEST 
          SX6    X6          X6 = JOIN STACK POINTER ONLY 
          SA6    A6 
          AX1    18          X1 = LVAR STACK POINTER
          SA2    TLVLESS     RESTORE LVAR STACK POINTER 
          AX2    18 
          LX2    18 
          BX6    X1+X2
          SA6    A2 
* 
          SA4    THELPF      LOAD ON-PAGE-HELP FLAG 
          MX6    0
          SA6    A4          CLEAR FLAG 
          BX6    X4 
          MX0    -6 
          SA6    ILOC        SAVE ON-PAGE-HELP FLAG 
          BX1    -X0*X4      MASK OFF OLD CONTINGENCY 
          SB7    X1 
          BX1    X4          GET ARROW ENCOUNTERED FLAG 
          LX1    2
          PL     X1,UH150    JUMP IF NO ARROW ENCOUNTERED 
          SB1    B7-XUNITC   CHECK IF WERE IN UNIT-C
          ZR     B1,UH100 
          SB1    B7-XNEXTLK  OR NEXTNOW-C 
          ZR     B1,UH100 
* 
          SA2    JOIN        LOAD CURRENT JOIN LEVEL
          ZR     X2,UNERR1   SUPPOSED TO BE A JOIN STACK
          SX7    X2-1        BACK-UP ONE JOIN LEVEL 
          SA7    A2 
 UH60     MX0    -12
          SA1    X7+JOINL    JOIN STACK ENTRY OF ARROW
          BX4    X0*X1       MASK ALL BUT COMMAND BIAS
          BX1    -X0*X1 
          SX1    X1-1        BACK-UP COMMAND PTR BY ONE 
          NG     X1,UNERR2   SHOULD BE A COMND FOLLOWING
*                            EXECERR USES X1
          BX4    X4+X1       RE-ATTACH COMMAND BIAS 
          SB7    XUNITC      RE-SET TO UNIT-C 
          EQ     UNJOIN1     GO TO RE-EXECUTE ARROW COMMAND 
* 
* /---   BLOCK      UNIT       00 000   79/05/05  22.48 
* 
*     'N'E'W -- INCLUDES CORRECTION TO FIX NEXTNOW/TIMEL
*            INTERACTION PROBLEM
* 
 
* 
 UH100    SA1    TBARROW     CHECK IF ANY ARROW TO ERASE
          ZR     X1,UH150 
          MX6    0           CLEAR OUT ARROW FLAG 
          SA6    A1 
          SA3    INHIBS      CHECK FOR -INHIBIT ARRPLT- 
          LX3    ARRSHIF
          NG     X3,UH150 
          OUTCODE WFCODE     OUTPUT WHERE 
          OUTARR E           ERASE ARROW
* 
 UH150    SB1    B7-XNEXTLK  IF IN NEXTNOW-C, 
          ZR     B1,UH170    GO BACK TO ORIGINAL COMMAND
          SA1    ILOC 
          LX1    1           POSITION -PAUSE- BIT 
          PL     X1,UH200    JUMP IF HELPOP NOT FROM PAUSE
          SB1    B7-XUNITC
          ZR     B1,UH170    JUMP IF WERE IN UNIT-C 
          MX6    0
          SA6    JOIN        CLEAR JOIN STACK POINTER 
          SB1    B7-XANSC    ANSWER-C 
          ZR     B1,JEXITX
          SB1    B7-XARROWC  ARROW-C
          ZR     B1,UNITAX1 
          EQ     WRONGC      ALL ELSE ARE ERRORS
* 
* 
 UH170    SX7    JOINLTH-1   SET TO LAST WORD OF JOIN STACK 
          EQ     UH60        GO TO RE-EXECUTE THE ORIGINAL PAUSE COMMAND
* 
* 
 UH200    JP     B7+*+1 
* 
+         EQ     UH300       UNIT-C 
+         EQ     WRONGC      ARROW-C
+         EQ     JEXITX      JUDGE-C
+         EQ     UH300       ANSWER-C 
+         EQ     WRONGC      SEARCH-C 
+         EQ     WRONGC      *** UNUSED *** 
+         EQ     WRONGC      NEXT-NOW-C (SHOULDNT GET HERE) 
+         EQ     UH300       ALL-OK-C 
+         EQ     WRONGC      *** UNUSED *** 
+         EQ     WRONGC      INITIAL-ENTRY-C
* 
* 
 UH300    MX6    0
          SA6    JOIN        CLEAR JOIN STACK POINTER 
          EQ     EXIT 
* 
 WRONGC   SX1    B7 
          EXECERR 907        *WRONG CONTINGENCY*
* 
 UNERR1   EXECERR 916        NO JOIN STACK
* 
*         EXECERR USES X1 
 UNERR2   EXECERR 917        BAD COMND POINTER AFTER UNJOIN 
* /---   BLOCK      WRITE      00 000   75/12/09  15.04 
          TITLE  WRITE AND CALC 
* 
* 
*         TUTOR WRITE ROUTINE 
*         B1 = ADDRESS OF WRITE INFO
*         B2 = ADDRESS OF CHARACTER COUNT 
* 
          ENTRY  TUTWRT 
 TUTWRTT  RJ     WRSOUT      OUTPUT WRITING NORMAL SIZE 
 TUTWRT   EQ     *
          SA1    RSIZE
          ZR     X1,TUTWRTT  IF SIZE 0
          MX6    -7-3 
          SA2    TBWRITE     CLEAR SIZE WRITE INFO
          BX6    X6*X2
          SA6    A2 
          RJ     LINWRT 
          EQ     TUTWRT 
* 
* 
*         -CALC-  (CODE=4)
* 
 CALC     AX5    60-XCODEL   PERFORM THE CALC 
          SB1    X5+B5
          SB3    PROCESS
          JP     B1          GO DO CALC 
* 
* 
* /---   BLOCK      CUNIT      00 000   73/00/00  00.00 
          TITLE  -CUNIT-
* 
* 
*         -CUNIT- 
*         GENERAL ROUTINE TO LOCATE UNIT FOR CONDITIONAL COMMANDS.
*         ON EXIT            B1 = VALUE OF CONDITION INDEX
* 
          ENTRY  CUNIT
 CUNIT    EQ     *
          NGETVAR            ROUNDS TO INTEGER IN X1
          PL     X1,CUNIT1   IF NEGATIVE, MAKE -1 
          ZR     X1,CUNIT1   PREVENT -0 FROM TAKING NEGATIVE BRANCH 
          SX1    -1 
 CUNIT1   SX0    1
          IX1    X1+X0       MAKE SO GOES FROM 0 TO N-1 
          SA5    A5          RELOAD COMMAND WORD
          RJ     CUNIT1A
          EQ     CUNIT
* 
          ENTRY  CUNIT1A
 CUNIT1A  EQ     *           ENTRY WITH X1 = NORMALIZED COND
* AND A/X5 = COMMAND WORD 
          MX0    48          SET FOR 12 BIT MASK
          AX5    XCMNDL 
          BX2    -X0*X5      X2 = NUMBER OF ENTRIES IN TABLE
          AX5    12 
          BX3    -X0*X5      X3 = RELATIVE START OF TABLE 
          SB2    B5+X3       B2 = ABSOLUTE START OF TABLE 
          MX0    58          MASK TO EXTRACT 2 BITS OF INFO 
          IX3    X1-X2       SEE IF NUMBER IN BOUNDS
          NG     X3,CUNIT2   JUMP IF OK 
          SX1    X2-1        ELSE SET FOR LAST ENTRY
 CUNIT2   BX2    -X0*X1      X2 = INTRA-WORD POSITION 
          SB1    X1-1        B1 = -1 TO N-2 
          BX3    X2 
          LX2    4           *16
          IX3    X2-X3       *15
          SB3    X3          B3 = SHIFT COUNT 
          AX1    2           GET WORD BIAS (4-15 BIT PACKS/WORD)
          SA3    X1+B2       X3 = PACKED WORD 
          LX5    X3,B3       POSITION CORRECT 15 BIT PACKAGE AT TOP 
          LX5    3           ONLY 12 BITS OF UNIT INFO
          PL     X5,CUNIT1A    EXIT IF NORMAL UNIT
* 
          MX0    12 
          BX3    X0*X5       MASK OFF UNIT NUMBER 
          LX3    12 
          SX0    X3-UNXNUM
          ZR     X0,PROCESS  JUMP IF SPECIAL UNIT -X- 
          SX0    X3-UNQNUM
          NZ     X0,CUNIT1A  EXIT IF NOT UNIT -Q- 
* 
          MX5    0           CLEAR UNIT NUMBER
          EQ     CUNIT1A
* 
* 
* /---   BLOCK      JLPACK     00 000   76/05/14  03.08 
          TITLE  JLPACK 
* 
*         PACK UP JOIN LIST INFO INTO X6
* 
          ENTRY  JLPACK 
* 
 JLPACK   EQ     *
          SA4    ILESUN      LESSON AND UNIT NUMBERS
          LX4    12 
          SB1    A5 
          SX3    B5-B1       COMMAND BIAS 
          BX6    X3+X4       COMBINE
          PL     X6,JLPACK   --- RETURN IF ALL OK 
          SA1    333333B     /// ELSE BOMB OFF ///
* /---   BLOCK      UNJOIN     00 000   80/08/09  02.18 
          TITLE  UNJOIN 
* 
* 
*         BACK OUT OF ONE JOIN
* 
          ENTRY  UNJOIN 
* 
 UNJOIN   SA1    JOIN        GET JOIN COUNT 
          SX6    X1-1        SUBTRACT ONE 
          SA6    A1          AND PUT BACK 
          SA4    JOINL+X6    GET LIST WORD
* 
* 
*         UNJOIN USING CONTENTS OF X4 
* 
          ENTRY  UNJOIN1
* 
 UNJOIN1  MX0    48 
          BX3    -X0*X4      PICK OFF COMMAND BIAS
          SB3    X3          FOR UNITGOB
          LX4    12          SHIFT OFF CONDITIONAL INDEX
          AX4    24          AND COMMAND BIAS 
          BX6    X4 
          SA6    ILESUN      CURRENT LESSON POINTER 
* 
*         SET LOCAL VAR POP FLAG IN STUDENT BANK
* 
          SA4    TLVLESS     LOCAL VAR LESSON + SP
          ZR     X4,UNITGOB  IF NO LOCALS 
* 
          MX0    1           SIGN BIT = POP FLAG
          BX6    X0+X4       ADD FLAG TO WORD 
          SA6    A4          STORE IN STUDENT BANK
          EQ     UNITGOB     GO EXECUTE TUTOR UNIT WITH B3 SET
* 
          ENTRY  UNJXX
 UNJXX    BSS    1
* /---   BLOCK      STORE      00 000   80/04/22  00.59 
          TITLE  STORE (AND STOREU) 
*         -STORE-  (CODE=10)  AND -STOREU-
* 
 USTORE   BSS    1           SAVE SECOND ARG OF STOREU
* 
 STORE    SA1    XSLCLOK     SAVE TIME ON ENTRY 
          BX6    X1 
          SA6    STORTIM
          BX7    X5 
          LX7    XCODEL      SECOND ARG AT TOP
          MX6    XCODEL 
          BX7    X6*X7       SAVE SECOND ARG
          SA7    USTORE 
          SA1    JJSTORE     CHECK WHETHER STUDENT ANS ALREADY COMPILED 
          PL     X1,STREADY  JUMP IF ALREADY COMPILED 
          SX1    X1+1        JJSTORE=-1 IF NOT COMPILED 
          ZR     X1,STORE1
* JJSTORE = -2 MEANS STUDENT ANS WILL NOT COMPILE.
* FORMOK CONTAINS WHATEVER WAS LEFT IN IT FROM LAST 
* COMPILATION ATTEMPT.
 STORNO   SB7    XANSC       PUT INTO ANSWER CONTINGENCY
          SX7    1
          SA7    TJUDGED     SET JUDGMENT=NO (UNIVERSAL)
          MX7    0           SET ANSCNT=0 
          SA7    TANSCNT
          EQ     PROCESS
 STORE1   SX7    JUDGE       INITIALIZE STRING ADDRESS
          SA7    WORDPT 
          MX7    0           ZERO INX TO BEGIN EXTRA STORAGE IN INFO
          SA7    INX
* 
          EXT    GETNDFU
* 
          RJ     GETNDFU     GET NDEFU INITIALIZED
          SA1    NDEFU
          SX7    -2          NO UNIT DIMENSIONS 
          ZR     X1,STORE1B  JUMP IF NO UNITS 
          SX7    -1          KEEP TRACK OF UNIT DIMENSIONS
 STORE1B  SA7    NUNITS 
          CALL   QUIKCMP     GENERATE MACHINE CODE IN INFO
*         GETVAR CODE RETURNED IN X1
*         WILL EXIT THROUGH -CALCERR- IF COMPILATION ERROR
*       LEX CALLS POSTOR TO RESTORE PRESENT UNIT IF STUDENT 
*           DEFINE SET WAS BROUGHT INTO CM
          BX7    X1          SAVE GETVAR CODE FOR POSSIBLE RE-USE 
          SA7    JJSTORE
          SA5    A5          RESTORE X5 
* /---   BLOCK      STORE      00 000   80/04/22  00.58 
 STREADY  SA2    USTORE      CHECK FOR -STOREU- COMMAND 
          ZR     X2,STREDY2 
          BX5    X2 
          FGETVAR            SET A1 TO STOREU ARRAY 
          SA0    UADS 
          SA2    ATEMPEC
          BX0    X2 
          SA2    NDEFU       LENGTH OF UNITS ARRAY
          SB3    X2 
+         WE     B3 
          RJ     ECSPRTY
          SA0    A1 
          SX1    B3          LENGTH TO CHECK
          RJ     BOUNDS      USES B1 AND B2 
+         RE     B3 
          RJ     ECSPRTY
          SA5    A5          RESTORE X5 
 STREDY2  SA1    JJSTORE
          LX5    XFBIT       I/F BIT OF -GETVAR- CODE TO TOP
          BX2    X5          PRESERVE IN X2 FOR LATER TEST
          LX1    60-XCODEL   LEFT-ADJUST -GETVAR- CODE
          BX5    X1          MOVE TO REQUIRED X5
          SB1    A5 
          SX7    B5-B1       SAVE COMMAND BIAS
          SA7    OLDB5
          MX7    59          FORM -1
          SA7    TFORMOK     SET OK--WILL BE SET ZERO IF EXEC ERROR 
          SB5    INFO        SET UP B5 FOR EXTRA STORAGE IN INFO
          NG     X2,FLTSTOR  JUMP IF FLOATING POINT 
          NGETVAR            ROUND TO INTEGER 
          BX7    X1 
          SA7    STORVAL     SAVE RESULT
          RJ     POSTOR2
          SA1    STORVAL
          BX6    X1 
          NPUTVAR            STORE
          EQ     STOTIME
* 
 FLTSTOR  FGETVAR            EVALUATE STUDENT EXPRESSION
          BX7    X1          VALUE RETURNED IN X1 
          SA7    STORVAL     SAVE VALUE 
          RJ     POSTOR2
          SA1    STORVAL
          BX6    X1 
          FPUTVAR            STORE
 STOTIME  SA1    XSLCLOK     SEE IF TOO MUCH PROCESSING GOING ON
          SA2    STORTIM
          IX2    X1-X2       COMPUTE TIME REQ TO COMPILE
          SX7    30          MAXIMUM ELAPSED TIME 
          PX7    X7          FLOAT IT 
          NX7    X7 
          SA1    CPSPD       SCALE BY CPU-SPEED FACTOR
          FX1    X7/X1
          UX1,B1 X1 
          LX1    B1 
          IX2    X2-X1
          NG     X2,PROCESS  IF LESS THAN 30 MILLISECONDS 
          SX7    16 
          SA7    TFORMOK     TIME-SLICE ERROR, LONG COMPILE 
          EQ     STORNO 
* 
 STORTIM  BSS    1
* 
* 
* /---   BLOCK      POSTOR     00 000   77/07/20  12.31 
* 
*         -POSTOR-
*         USED TO RESTORE A5 - B5 AFTER COMPILATION 
* 
          ENTRY  POSTOR 
* 
 POSTOR   EQ     *
          SA5    ILESUN      LOAD LESSON/UNIT NUMBERS 
          CALL   GETUNIT
          SA1    OLDB5       LOAD COMMAND BIAS
          MX6    59          -1 
          SA6    A1 
          SB1    X1 
          SA5    B5-B1       RELOAD COMMAND WORD
          EQ     POSTOR 
* 
 POSTOR2  EQ     *           RESTORE X5/B5'; UNIT ALREADY IN
          SA1    OLDB5       LOAD COMMAND BIAS
          MX6    59          -1 
          SA6    A1 
          SA5    A5          RESTORE X5 
          SB5    X1 
          SB5    A5+B5
          EQ     POSTOR2
* 
* 
* 
 EXECSAV  BSS    1
* 
* 
          ENTRY  CSPREAD     ALSO USED BY -COMPUTE- 
* 
 CSPREAD  EQ     *           STRING STARTS AT A0, CHAR COUNT IN X1
*CHECK STRING BOUNDS AND SPREAD PACKED CHARS INTO SHOWOUT 
          SX2    CSPWDS+1    ALLOW 100 CHARS
          IX2    X1-X2       CHECK FOR POSSIBLE SHOW BUFFER OVERFLOW
          PL     X2,CSERXMX  101 SPREAD CHARS IS TOO MUCH 
*                            EXECERR USES X1
          RJ     WORDS       CHECK STORE BOUNDS 
          SB3    X1          END CHECK
          SB1    1
          SA1    A0-B1       INITIALIZE READING REGISTER
          SA7    SHOWOUT-1   INITIALIZE WRITING REGISTER
          MX0    54          MASK FOR CHAR
 STORA0   SB2    10          CHARS PER WORD 
          SA1    A1+B1       GET NEXT WORD
 STORA1   LX1    6           RIGHT-ADJUST NEXT CHAR 
          BX7    -X0*X1      PICK OUT CHAR
          SA7    A7+B1       ADD CHAR TO BUFFER 
          SB3    B3-B1       COUNT CHARACTERS 
          ZR     B3,STORA2
          SB2    B2-B1       COUNT CHARS PER WORD 
          NZ     B2,STORA1
          EQ     STORA0      GET NEXT WORD
 STORA2   MX7    0           TERMINATE WITH 0 CHAR----END OF LINE 
          SA7    A7+B1
          SX7    SHOWOUT     INITIALIZE WORDPT
          SA7    WORDPT 
          EQ     CSPREAD
* 
 CSERXMX  SX2    CSPWDS      MAXIMUM LIMIT
          EQ     ERXMXLC     MAXIMUM CHAR LIMIT EXCEEDED
* 
 STORVAL  BSS    1           STUDENT RESULT TO STORE
 CSPWDS   EQU    100         NUMBER OF CHARS MAX
* 
* 
* /---   BLOCK      ARROW      00 000   76/07/24  21.53 
          TITLE  ARROW AND ARROW(F) 
*         -ARROW-  (CODE=11)
* 
*            SINGLE VARIABLE (ROW-COLUMN POSITION) ARROW. 
*         SETS STARTING SCREEN POSITION FOR ENTRY OF
*         STUDENT ANSWER AND INITIALIZES ANSWER STORAGE 
*         POINTERS. 
* 
* 
* 
 ARROWX   SA1    THELPF      CHECK IF IN ON-PAGE HELP STATE 
          ZR     X1,AWX1
          RJ     ARROWUH
 AWX1     NGETVAR            ROUNDS TO INTEGER IN X1
          RJ     RCTOXY      GET INTO X AND Y 
 ARROWXX  MX0    -9          FORCE LEGAL SCREEN POSITION
          BX6    -X0*X6 
          BX7    -X0*X7 
          LX6    9
          BX7    X6+X7       PACK UP THIS X AND Y 
          OUTCODE WFCODE     OUTPUT WHERE 
          MX2    1           SET TOP BIT -- NOT PLOTTED 
          BX7    X7+X2
          SA1    TBARROW     SEE IF ANY PRIOR ARROW TO ERASE
          SA7    A1          SET FINE GRID ARROW POSITION 
          ZR     X1,ARR25    IF ZERO, THIS IS FIRST ARROW 
          SA3    INHIBS      READ THE INHIBIT FLAG WORD 
          LX3    ARRSHIF     SHIFT IT TO THE SIGN BIT 
          NG     X3,ARR25    DONT BOTHER IF NO ARROW PLOTTED
          OUTCODE WFCODE     OUTPUT WHERE 
          OUTARR E           ERASE ARROW
* /---   BLOCK      ARROW      00 000   80/08/04  22.56 
* 
 ARR25    SA5    A5          GET COMMAND
          MX2    -XCMNDL
          BX2    -X2*X5 
          MX1    60          SET TO ARROWA
          SX2    X2-ARROWA= 
          ZR     X2,ARR26    IF ARROWA
          SX2    X2-1 
          ZR     X2,ARR26    IF ARROWA FINE GIRD
          MX1    0           FOR NORMAL ARROW 
 ARR26    SA2    TBITS       BIT IN TBITS 
          MX6    1
          LX6    -ARRTPBT    SET TYPE OF ARROW BIT(1=ARROWA)
          BX1    X1*X6       PICK BIT 
          BX2    -X6*X2      CLEAR BIT
          BX6    X1+X2
          SA6    A2 
 
          SB7    XARROWC     SET TO ARROW-C 
          SA1    TBITS
          MX6    1
          LX6    -JUDGBIT 
          BX6    -X6*X1      JUDGING BIT = 0 FOR ARROW
          SA6    A1 
          SA1    RSIZE       SAVE SIZE
          SA2    ROTATE      AND ROTATE 
          BX6    X1 
          BX7    X2 
          SA6    TBSIZE 
          SA7    TBROTATE 
          SA3    TBEDIT      CLEAR ANY EDIT FEATURE 
          MX6    36+1 
          LX6    36 
          BX6    -X6*X3 
          SA6    A3 
          NZ     X6,ARROWED  JUMP IF EDIT BUFFER ALREADY SET
          SX6    ANSINF+ANSLIM/2   MIDDLE OF ANS BUFFER 
          LX6    36 
          SA6    A3          INITIALIZE TBEDIT
 ARROWED  MX6    0           CLEAR COPY OPTION
          MX0    2
          SA6    TBCOPY 
          SA6    TJKEYS      CLEAR JKEY SPECIFICATIONS
          SA6    TWCOUNT     CLEAR WORD COUNT 
          SA6    TBLDATA+1   CLEAR DATA FLAGS 
          SA3    TBMICRO     CLEAR MICRO SWITCHES 
          BX6    -X0*X3 
          SA6    A3 
* /---   BLOCK      ARROWEXT   00 000   78/12/18  21.20 
* 
* 
          CLRFBIT ENABLT     TOUCH
* 
*         SAVE JOIN STRUCTURE AT ARROW
* 
          RJ     JLPACK      PACK UP JOIN INFO IN X6
          SB1    1           B1 = CONSTANT 1
          SA1    JOIN 
          SX0    X1-JOINLTH  CHECK IF TOO DEEP IN JOINS 
          PL     X0,ERXJOIN  --- ERROR EXIT 
          SA6    AJOIN+1+X1  STORE AWAY THIS JOIN (THE ARROW) 
          SB2    X1          B2 = CURRENT JOIN DEPTH
          SX6    X1+B1       INCREMENT JOIN COUNT BY 1
          SA6    AJOIN       AND STORE AWAY THE NEW JOIN COUNT
          ZR     B2,AJDN     DONE IF NO OTHER JOINS 
 AJSAVE   SA1    A1+B1       BRING UP NEXT JOIN WORD
          BX6    X1 
          SA6    A6+B1       STORE IN ARROW JOIN WORD 
          SB2    B2-B1
          NZ     B2,AJSAVE
          EQ     AJDN 
* 
          SX7    X1+B1       ADD ONE TO JOIN COUNTER
          SA7    A1          STORE NEW COUNT
          SA7    AJOIN       SET ARROW JOIN MARKER
          SA6    JOIN+X7     SAVE THE JOIN INFO FOR ARROW 
* 
 AJDN     SA1    TLVLESS     SEE IF LOCAL VAR LESSON
          ZR     X1,AJDN5    IF NO LOCAL VARS 
* 
          SX6    X1          SAVE LOCAL VARIABLE SP 
          SA2    LVUCNT      X2 = LVARS IN ARROW UNIT 
          IX6    X6+X2
          SA1    AJOIN       WITH ARROW JOIN SP 
          LX6    18 
          BX6    X6+X1
          SA6    A1 
          MX6    0           PSEUDO MAIN UNIT 
          SA6    JOIN 
 AJDN5    SX6    MAXLONG/2   HALF MAX LONG TO ALLOW EDIT
          SA6    LIMIT
          SX6    ANSINF      SET TO POINT TO ANSWER BUFFER
          SA6    TBINPUT
          SX6    0
          SA6    LONG        SET INPUT TO ZERO
          SA6    TBANSWT     MARK NO ANS-C WRITING
          SA6    THELPWT     MARK NO ON-PAGE-HELP WRITING 
          SX7    2
          SA7    TJUDGED     SET JUDGMENT=UNJUDGED
* 
          ZERO   ANSINF,ANSLIM    ZERO ANSWER BUFFER
          CALL   AREAINC,0,0  **** DATA ****
          SA1    THELPF 
          NZ     X1,ARR40    JUMP IF IN ON-PAGE-HELP
          MX6    18 
          SA2    TBNARGS     CLEAR OUT -PHELP- COUNTER
          BX6    -X6*X2 
          SA6    A2 
* /---   BLOCK      ARROW      00 000   77/03/19  20.35 
* 
 ARR40    SA2    CLRBITS     CLEAR VARIOUS BITS IN TBITS
          SA1    TBITS
          BX6    -X2*X1 
          SA6    A1 
          SA1    TBARROW     ALL NORMAL ARROWS ARE PLOTTED
          SA2    TBWRITE
          MX3    -18
          BX6    X3*X2       CLEAR OLD MARGIN 
          BX6    X1+X6       SET NEW MARGIN 
          SA6    A2 
          OUTP   WFCODE      HERE.  SYSTEM ARROWS USE ARRPLT
          SA1    TBARROW     GET ARROW COORDINATES
          MX3    -9 
          BX7    -X3*X1      PICK NY
          AX1    9
          BX6    -X3*X1      PICK NX
          SA6    TBMARG      SET MARGIN 
          NG     X2,ARR42 
          SX6    X6+10B      IF PLOTTING ARROW
          BX6    -X3*X6 
 ARR42    SA6    NX          UPDATE NX, NY
          SA7    NY 
          SA2    INHIBS 
          LX2    ARRSHIF     CHECK INHIBIT ARROW BIT
          PL     X2,PROCESS  IF ARROW NOT INHIBITED 
 
*         CLEAR ARROW PLOT BECAUSE OF -INHIBIT ARROW- 
 
          SA1    TBARROW     GET -ARROW- INFO 
          MX0    1           SET UP FOR NEGATIVE MASK 
          BX7    -X0*X1      CLEAR ',PLOT', FLAG
          SA7    A1          SAVE IT
          EQ     PROCESS     CONTINUE 
 
*         BITS TO CLEAR IARROW, IARROWA, AND QUIT IN TBITS
*         -CLRBITS- TELLS WHICH OF THE BITS OF -TBITS-
*         ARE TO BE CLEARED AT EACH NEW ARROW.
 
 CLRBITS  BSS    0
          POS    60-IARRBIT 
          VFD    1/1         SET IARRBIT
          POS    60-QUITBIT 
          VFD    1/1         SET QUIT BIT 
*          POS    60-MTABBIT
*          VFD    1/1         CLEAR MICRO-TAB BIT 
          POS    0
          BSS    0           FORCE WORD OUT 
* /---   BLOCK      ARROWFX    00 000   78/02/14  11.07 
* 
* 
*         -ARROW(F)-  (CODE=12) 
* 
*            TWO VARIABLE (FINE GRID) ARROW.
* 
* 
 ARROWFX  SA1    THELPF      CHECK IF IN ON-PAGE HELP STATE 
          ZR     X1,AWX2
          RJ     ARROWUH
 AWX2     RJ     GET2        GET X AND Y
          EQ     ARROWXX
* 
* 
* 
 ARROWUH  EQ     *
          BX2    X1          CHECK IF ALREADY ANOTHER ARROW 
          LX2    2
          NG     X2,ARROWUH        EXIT IF WAS ANOTHER
          MX6    1
          LX6    58          POSITION ARROW ENCOUNTERED BIT 
          BX6    X1+X6
          SA6    A1          MARK ARROW ENCOUNTERED 
          MX6    0
          SA6    TBANSWT     MARK NO ANS-C WRITING
          SA6    THELPWT     MARK NO ON-PAGE-HELP WRITING 
          SA1    TBARROW
          ZR     X1,ARROWUH 
          SA1    NX          SAVE CURRENT X/Y POSITION
          LX1    18 
          SA2    NY 
          BX6    X1+X2
          SA6    TBINTSV+5
          CALL   OFFIT       ERASE ANSWER MARK-UP 
          SA5    A5 
          SA1    RSIZE       SEE IF LARGE SIZE CHARACTERS 
          NZ     X1,AWUH100 
          CALL   WIPE 
          CALL   OFFOKNO     ERASE OK OR NO 
          EQ     AWUH200
* 
 AWUH100  SA2    ARROWUH
          BX6    X2          SAVE RETURN ADDRESS
*         TBINTSV+0 - TBINTSV+3 ARE RESERVED FOR -LWIPE-
          SA6    TBINTSV+4
          CALL   LWIPE
          SA1    TBINTSV+4   RESTORE RETURN ADDRESS 
          BX6    X1 
          SA6    ARROWUH
* 
 AWUH200  SA1    TBINTSV+5   LOAD NX/NY 
          MX0    -9 
          BX6    -X0*X1      RESTORE NY 
          SA6    NY 
          AX1    18 
          BX6    -X0*X1 
          SA6    NX          RESTORE NX 
          EQ     ARROWUH
* 
* 
 ACHARA   TITLE  SET THE ARROW CHARACTER FOR -ARROWA- 
* 
*    NAME OF COMMAND HAS BEEN CHANGED TO -ARHEADA-
* 
*         SET UP USER ARROW CHARACTER FOR ARROWA
* 
* 
 
 
 
 ACHARAX  AX5    XCMNDL      GET BIAS 
          SA1    B5+X5
          MX0    30 
          SA2    ARRCHRS     UPPER 30 BITS FOR NORMAL ARROW 
*          LX1    30          POSITION FIRST 5 CHARS LOWER
          BX6    X0*X2       PICK NORMAL ARROW
          BX1    -X0*X1      CLEAN UP USER ARROW
          BX6    X1+X6
          SA6    A2 
          EQ     PROCESS
* /---   BLOCK      JARROW     00 000   80/08/04  20.22 
          TITLE  JARROW 
* 
*         JARROW
* 
*            'MARKER FOR INITIATING JUDGING WITHOUT AN
*         ARROW.
* 
 JARROWX  CALL   NOJBUF      MAKE SURE DO NOT HAVE ECS JUDGE BUF
* 
          INTLOK X,I.JUDG,W 
          SA1    AJBSTAT     (X1) = EM FWA OF JBUFF STATS 
          BX0    X1 
          SA0    JBUFCNT
+         RE     4
          RJ     ECSPRTY
          SA2    A0          NUMBER JUDGE BUFFERS IN USE
          SX1    JBANKS      MAXIMUM POSSIBLE 
          IX2    X2-X1
          NG     X2,JARR1    IF ONE LEFT
          SA1    JMAXCNT     UP OVERFLOW COUNT
          SX6    1
          IX6    X1+X6
          SA6    A1 
+         WE     4
          RJ     ECSPRTY
          INTCLR X,I.JUDG 
          EQ     RETRNZ      RE-DO COMMAND A LITTLE LATER 
* 
 JARR1    BSS    0
          INTCLR X,I.JUDG 
          SX6    0
          SA6    TBARROW     CLEAR SCREEN POSITION FOR ARROW
          SA6    LONG        GUARANTEE CHAR COUNT = 0 
          SA1    TBITS
          MX6    1
          LX6    -JUDGBIT 
          BX6    X1+X6       JUDGING BIT = 1 FOR JARROW 
          SA6    A1 
* 
*         SAVE CURRENT SIZE AND ROTATE SO THAT THE RESTORE
*         THAT OCCURS AT VARIOUS EXITS IS OK. 
* 
          SA1    RSIZE
          SA2    ROTATE 
          BX6    X1 
          BX7    X2 
          SA6    TBSIZE 
          SA7    TBROTATE 
* /---   BLOCK      JARROW     00 000   80/08/04  20.22 
* 
*         SAVE CURRENT JOIN STRUCTURE (USE STACK FOR ARROW) 
* 
          RJ     JLPACK      PACK UP JOIN INFO IN X6
          SB1    1           B1 = CONSTANT 1
          SA1    JOIN 
          SX0    X1-JOINLTH  CHECK IF TOO DEEP IN JOINS 
          PL     X0,ERXJOIN  --- ERROR EXIT 
* 
          SA6    AJOIN+1+X1  STORE AWAY INFO (THE JARROW) 
          SB2    X1          B2 = CURRENT JOIN COUNT
          SX6    X1+B1       INCREMENT JOIN COUNT BY 1
          SA6    AJOIN       STORE THE NEW JOIN COUNT 
          ZR     B2,JAGO     --- GO ON LIKE REJUDGE 
          MX7    0
          SA7    A1          CLEAR CURRENT JOIN COUNT 
 JSAVE    SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          SB2    B2-B1
          NZ     B2,JSAVE 
          EQ     JAGO        --- GO ON LIKE REJUDGE 
* 
          SX7    X1+B1       ADD ONE TO JOIN COUNTER
          SA7    A1          STORE NEW COUNT
          SA7    AJOIN       SET JARROW JOIN MARKER 
          SA6    JOIN+X7     SAVE THE JOIN INFO FOR JARROW
 JAGO     SA1    TLVLESS     SEE IF LOCAL VARS LESSON 
          ZR     X1,PJUDGOO  --- GO ON LIKE REJUDGE 
* 
          SX6    X1          SAVE LOCALS SP 
          SA2    LVUCNT      X2 = LVARS IN ARROW UNIT 
          IX6    X6+X2
          SA1    AJOIN       WITH ARROW JOIN SP 
          LX6    18 
          BX6    X6+X1
          SA6    A1 
          MX6    0           PSEUDO MAIN UNIT 
          SA6    JOIN 
          EQ     PJUDGOO     --- GO ON LIKE REJUDGE 
* /---   BLOCK      JARROW     00 000   77/08/19  00.52 
* 
* /---   BLOCK      ENDARROW   00 000   79/06/06  02.32 
          TITLE  ENDARROW 
*         ENDARROW   (CODE=40)
* 
*            'THE ONLY PROCESSING NEEDED HERE IS TO ERASE 
*         THE PREVIOUS ARROW, IF ANY, AND CLEAR SOME
*         STATUS INFORMATION. 
* 
* 
 ENDARRX  BSS    0
 
*         END ARROW EXECUTION.
 
          RJ     EAE
 
          EQ     PROCESS     EXIT 
 
 CIA      SPACE  4,10 
**        CIA - CHECK INHIBIT ARETURN.
* 
*         IF -INHIBIT ARETURN- BIT IS SET, END ARROW
*         EXECUTION AND CONTINUE.  OTHERWISE, PROCESS 
*         NORMALLY. 
* 
*         ENTRY  (X6) = NEXT EXECUTION ADDRESS IF INHIBIT 
*                       ARROW IS IN EFFECT. 
 
 CIA      BSS    0           ENTRY
 
*         CHECK FOR -INHIBIT ARROW-.
 
          SA1    INHIBS 
          LX1    ARETSHF
          PL     X1,ANSMARK  IF NO -INHIBIT ARETURN-. 
 
*         END ARROW EXECUTION AND CONTUNUE. 
 
          SA6    CIAA        SAVE RETURN ADDRESS
 
          RJ     EAE         END ARROW EXECUTION
 
          SA1    CIAA        (X1) = NEXT ADDRESS
          SB1    X1 
          JP     B1          CONTINUE 
 
 CIAA     BSS    1           RETURN ADDRESS 
 
 
 EAE      SPACE  4,10 
**        EAE - END ARROW EXECUTION.
* 
*         ERASE THE PREVIOUS ARROW AND CLEAR STATUS INFO. 
 
 
 EAE      PS                 ENTRY / EXIT 
 
          SB7    XUNITC      SET TO UNIT-C
          CALL   NOJBUF      DROP JUDGE BUFFERS 
 
 
*         ERASE THE ARROW IF NECESSARY. 
 
          SA1    TBARROW
          ZR     X1,EAE1     IF NO ARROW TO ERASE 
 
          MX6    0
          SA6    A1 
          SA3    INHIBS 
          LX3    ARRSHIF
          NG     X3,EAE1     IF NO ARROW TO ERASE 
 
          OUTCODE WFCODE
          OUTARR E           ERASE ARROW
 
*         CLEAR STATUS INFORMATION. 
 
 EAE1     SX6    0
          SA6    TBANSWT     CLEAR ANS-C ERASE
          SA1    TBLDATA+1
          MX0    -9 
          BX6    -X0*X1 
          SA6    A1          CLEAR *NTRIES* 
          CLRFBIT ENABLT     TOUCH
 
          EQ     EAE         RETURN 
 
* /---   BLOCK      LONG/MARKU 00 000   81/02/28  20.29 
          TITLE  -LONG- 
*         -LONG-  (CODE=17) 
* 
 LONGX    NGETVAR            ROUNDS TO INTEGER IN X1
          NG     X1,ERXBADL  ERROR IF NEGATIVE
*                            EXECERR USES X1
          BX7    X1 
          SA7    LIMIT
          SX1    MAXLONG+1
          IX1    X7-X1
          PL     X1,LERXMAX 
*                            EXECERR USES X7, X1
          SX1    MAXLONG/2+1
          IX1    X7-X1
          NG     X1,PROC
          SA1    TBEDIT      LONG GT MAXLONG/2---CHECK FOR EDIT BUFFER
          AX1    36          ADDRESS OF EDIT BUFFER 
          ZR     X1,PROC
          SB1    X1 
          SB2    STUDVAR
          GE     B1,B2,PROC 
          MX7    0           WAS IN ANS BUFFER, SO CLEAR
          SA7    A1          TBEDIT=0 
          EQ     PROC 
* 
 LERXMAX  BX1    X7 
          SX2    MAXLONG
          EQ     ERXMXLC
* 
* 
 MARKUPY  NGETVAR            MARKUP-Y BIAS
          MX6    48 
          BX6    -X6*X1      LIMIT TO BOTTOM 12 BITS
* 
*          SA6    TMARKUY     RESET ERROR MARKUP BIAS 
* 
          LX6    48          SHIFT TO TOP OF WORD 
          SA1    TBWHERE     (X1)=12/MARKUP Y BIAS,48/OTHER 
          MX0    12 
          BX7    -X0*X1      CLEAR OUT OLD MARKUP Y BIAS
          BX7    X6+X7       MERGE WITH NEW 
          SA7    A1          STORE
          EQ     PROC 
* /---   BLOCK      EXT        00 000   80/08/22  02.06 
* 
 EXTMUCH  EXECERR 124        TOO MANY -EXT-S IN FINISH UNIT 
* 
*         CHECK IF WE ARE IN A FINISH UNIT.  IF NOT,
*         RETURN X2=0.  OTHERWISE, INCREMENT -EXT-
*         COUNT AND RETURN X2^=0.  EXEC ERROR IF TOO
*         MANY -EXT-S OR WHATEVER.
*         THIS ROUTINE MAY NOT DESTROY X1.
* 
          ENTRY  TESTFIN
 TESTFIN  PS
          SA2    STFLAGS
          MX0    1
          LX0    FINBIT 
          BX2    X0*X2       TEST FINISH UNIT FLAG
          ZR     X2,TESTFIN  --- IF NOT 
          SA2    AUTKEY 
          LX2    60-18-18-6  BRING -EXT- COUNT DOWN 
          MX0    -12
          BX6    -X0*X2 
          SX6    X6+1        INCREMENT COUNT
          BX2    X0*X2       CLEAR OLD COUNT
          SX0    X6-21       CHECK AGAINST LIMIT OF 20
          PL     X0,EXTMUCH  --- IF TOO MUCH
          BX6    X6+X2       RECOMBINE STUFF
          LX6    18+18+6     POSITION BACK
          SA6    A2          STORE BACK 
          MX6    0
          SA6    MOUTLOC     DISCARD ANY PENDING OUTPUT 
          MX2    -1          FLAG FINISH UNIT 
          EQ     TESTFIN
* /---   BLOCK      CATCH/LOCK 00 000   79/08/18  19.00 
          TITLE  -LOCK- 
*         -LOCK-   (CODE=196) 
*         FIRST ARG....STATION NUMBER 
*         SECOND ARG...WORD TO STUFF INTO LOCK BUFFER 
 LOCKX    RJ     GET2        GET TWO ARGS 
          NG     X1,ERXSTN   STATION NUMBER IN X1,X6
*                            EXECERR USES X1
          SX2    NUMSTAT
          IX2    X1-X2
          PL     X2,ERXSTN
*                            EXECERR USES X1
          SA7    ITEMP
          SA2    ALOCK       ADDRESS OF *LOCK* BUFFER 
          IX0    X1+X2
          SA0    A7 
+         WE     1           REWRITE ENTRY
          RJ     ECSPRTY
          EQ     PROC 
* /---   BLOCK      CALCC      00 000   78/05/18  21.45 
          TITLE  CALCC AND CALCS
*         -CALCC-  (CODE=34)
* 
*            CONDITIONAL CALC.  COMMA SEPARATED EXPRESSIONS 
*         ARE COMPUTATIONS. 
* 
 CALCC    LX5    XCODEL      GET 2ND PACKAGE
          NGETVAR 1 
          SX6    X1+3        BIAS PROPERLY
          SA6    ERXARGN     SET EXECERR ARGUMENT NUMBER
          SB2    -2          ARG. FOR CALCCJ
          RJ     CALCCJ      ACQUIRE APPROPRIATE GTVAR CODE IN X5 
          NG     X5,PROCESX  EXIT IF NO-OP
          FGETVAR            DO CORRECT CALCULATION 
          EQ     PROCESX
* 
 ILOC     BSS    2           FOR TEMP USE BY ANY INDIVIDUAL COMMAND 
* 
* 
*         -CALCS-  (CODE=35)
* 
*            COMMA SEPARATED EXPRESSIONS ARE (1) STORAGE
*         VARIABLE AND THEREAFTER THE VALUES TO BE STORED 
*         IN THE VARIABLE.
* 
 CALCSX   LX5    XCODEL      GET 2ND PACKAGE
          NGETVAR 1 
          SX6    X1+4        BIAS PROPERLY
          SA6    ERXARGN     SET EXECERR ARGUMENT NUMBER
          SB2    -1          ARG. FOR CALCCJ
          RJ     CALCCJ      ACQUIRE GETVAR CODE
          NG     X5,PROCESX  EXIT IF NO-OP
          SA4    A5          RESTORE COMMAND WORD 
          AX4    XCMNDL 
          MX2    2*XCODEL+XCMNDL
          BX2    -X2*X4 
          SA4    X2+B5       GET FIRST XSTO WORD
          BX6    X4 
          SA6    ILOC        SAVE STORAGE ADDRESS GETVAR CODE 
          LX4    XFBIT       CHECK FOR STORE INTO I OR F VARIABLE 
          PL     X4,IGVAR    JUMP IF INTEGER STORE
          FGETVAR            GET ADR OF WHERE TO STORE RESULT 
          EQ     IGVAR2 
* 
 IGVAR    NGETVAR            GET ROUNDED RESULT 
 IGVAR2   SA2    ILOC        GET STORAGE GETVAR CODE
          BX5    X2 
          LX2    XFBIT       POSITION I/F BIT 
          BX6    X1 
          NG     X2,IGVARF   JUMP IF FLOATING POINT 
          NPUTVAR 2          STORE
          EQ     PROCESX
* 
 IGVARF   FPUTVAR 
          EQ     PROCESX
* 
* 
*         SUBROUTINE FOR CALCS AND CALCC COMMANDS 
* 
*         SET B2=-1 FOR CALCS COMMAND 
*         SET B2=-2 FOR CALCC COMMAND 
*         SET X1= VALUE OF CONDITIONAL VAR
* 
*         DOES CORRECT CONDITIONAL CALC AND RETURNS RESULT IN X1
* 
*         COMMAND WORD CONTAINS ARGUMENT COUNT (XCODEL BITS), 
*         CONDITIONAL VAR (XCODEL BITS),
*         EXTRA STORAGE POINTER (60-2*XCODEL-XCMNDL BITS), AND
*         THE COMMAND NO. (XCMNDL BITS).
* 
* 
*         ****NOTE**** READIN MUST GUARANTEE AT LEAST 
*               2 VARS FOR CALCC, 3 FOR CALCS.
* 
* /---   BLOCK      CALCCJ     00 000   76/05/17  20.58 
 CALCCJ   EQ     *
          MX2    0
          IX1    X1+X2       TREAT -0 AS +0 
          SA5    A5 
          AX5    XCMNDL      SHIFT OUT COMMAND NO.
          MX2    2*XCODEL+XCMNDL
          BX2    -X2*X5      X2 HOLDS X-STO POINTER 
          SB1    1           B1 HOLDS INCREMENT OF 1
          NG     X1,CALCCJA  USE FIRST X-STO WORD IF NEG. 
          SB3    -3          B3 HOLDS INCREMENT OF -3 
          SB2    B2+B1       B2 HOLDS -1 FOR CALCC, 0 FOR CALCS 
          SX4    B2 
          AX5    60-XCODEL-XCMNDL   GET NO. OF VARS 
          IX5    X5-X4
          SX5    X5-4        X5 HOLDS END TEST VALUE
+         IX4    X5-X1       TEST IF PAST MAXIMUM 
          PL     X4,*+1      JUMP IF CONDITIONAL VAR IS IN RANGE
          BX1    X5          X1 HOLDS MAXIMUM VALUE 
+         SB2    B2+X1       B2 HOLDS WHICH VAR PACKAGE TO GET
          LE     B2,CALCCJA  JUMP IF X2 HOLDS CORRECT X-STO POINTER 
+         SB2    B2+B3       DECREMENT BY 3 
          SX2    X2+B1       INCREMENT X-STO POINTER
          GT     B2,* 
 CALCCJA  SA4    X2+B5       CORRECT X-STO WORD TO X4 
          NE     B2,*+1      B2=0 IF THIRD PACKAGE NEEDED 
          LX4    2*XCODEL    THIRD PACKAGE TO TOP OF X4 
+         SB2    B2+B1
          NE     B2,*+1      B2=-1 IF 2ND PACKAGE NEEDED
          LX4    XCODEL      SHIFT TO 2ND PACKAGE OF WORD 
+         BX5    X4          MOVE TO X5 FOR GETVAR
          EQ     CALCCJ      RETURN WITH X5 SET DO CALL GETVAR
* /---   BLOCK      LVCNTU     00 000   80/11/04  23.22 
* 
*         -LVCNTU-
* 
*         RETRIEVE NUMBER OF LOCAL VARIABLES FROM ULOC
*         ON ENTRY X4 = LESSON/UNIT 
*         ON EXIT  X4 = NUMBER OF LOCAL VARS
* 
*         USES A/0,4,5
* 
*         -EXIT- PROCESSING DEPENDS ON X1 AND X2 NOT
*         BEING CHANGED BY THIS ROUTINE.
* 
          ENTRY  LVCNTU 
 LVCNTU   EQ     *
          SX4    X4          UNIT INFO ONLY 
          SA5    ECSULOC     GET ADDRESS OF -ULOC- TABLE
          IX0    X4+X5       INDEX TO THIS UNIT 
          RX4    X0          (-RXX- 1 WD READ, MAY CHG *A4*)
          AX4    60-ULOC1-ULOC2-ULOC3-ULOC4-ULOC5 
          MX0    -ULOC5 
          BX4    -X0*X4      GET NUMBER OF LOCALS IN UNIT 
          EQ     LVCNTU 
* 
* /---   BLOCK      ERASE      00 000   80/08/11  02.16 
          TITLE  ERASE
*         -ERASE-  (CODE=36)
* 
*         -ERASE N1- ERASES N1 CHARS IF N1 +, NONE IF N1=0
*           DOES FULL-SCREEN ERASE IF N1 IS NEGATIVE. 
*         -ERASE N1,N2- ERASES N1 CHARS ON NEXT N2 LINES
*         -ERASE BLANK- PRODUCES FULL-SCREEN ERASE, 
*         -ERASE ABORT- DOES F.S. ERASE AND ALSO ABORTS 
*           OUTPUT PENDING IN MOUT BUFFER.
* 
 ERASEX   NG     X5,ERASEFS  TAG EITHER BLANK OR -ABORT-
          NGETVAR            ROUNDS TO INTEGER IN X1
          SX5    0           FLAG FOR NO ABORT OUTPUT 
          ZR     X1,PROC     --- IGNORE IF ZERO 
          NG     X1,ERASEFS  FS ERASE DONT ABORT OUTPUT 
          SA2    RSIZE
          NZ     X2,ERASEX2  IF NOT SIZE 0
          BX6    X1 
          SA6    XDATA       SAVE NUMBER OF SPACES
          SA2    A5 
          LX2    XCODEL      2D ARG CODE AT LEFT
          MX0    XCODEL 
          BX2    X0*X2       ISOLATE 2D ARG 
          NZ     X2,ERASEY   JUMP IF WAS A 2D ARGUMENT
          LX1    3           SPACES * 8 
          SA3    NX          CURRENT X POSITION 
          IX1    X1+X3       NEW X POSITION 
          SX2    X1-513      CHECK FOR OVERFLOW 
          MX1    0           SET LINE COUNT TO ZER
          NG     X2,ERASEY1  JUMP IF NO OVERFLOW
          SA1    XDATA
* 
 ERASEX0  OUTCODE ERSCODE     OUTPUT THE ERASE
          EQ     ERASEY2
* 
*         FULL SCREEN ERASE HAS +-0 TAG IN OUTPUT CODE
 ERASEFS  LX5    1           SECOND BIT SET IF ABORTS 
          AX5    59          EXTEND SIGN FOR ABORT FLAG 
*          SETXBIT EXTOFF     UPDATE *STFLAGS* NO EXT INPUT 
*         CLEAR ENABLE TOUCH,PAUSE=TOUCH,PAUSE=EXT
          CLRFBIT ENABLT,ENABLPT,ENABLPX
          CALL   DWECOLR     RESET SBANK WE/COLOR TO DEFAULT
          BX1    X5          -0 FOR ABORT, 0 FOR NO ABORT 
          EQ     ERASEX0
* 
 ERASEX2  RJ     TUERASE     GO ERASE BIG CHARACTERS
          EQ     PROCO
* 
 ERASEY   BX5    X2 
          NGETVAR            X1_LINES 
          SX2    X1-1 
          NG     X2,PROC     IGNORE IF LINES < 1
          SX2    X1-33
          NG     X2,ERASEY1  IF LINES>32
          SX1    32          ONLY ERASE 32 LINES
 ERASEY1  SA4    XDATA       GET NUMBER OF SPACES 
          LX4    18          POSITION CHARACTER COUNT 
          BX1    X1+X4       COMBINE LINE AND CHAR. COUNTS
          OUTCODE BERCODE    ERASE SPACES IN 1ST TAG
* 
 ERASEY2  BSS    0
          SA1    NX          RESET TERMINAL TO ORIGINAL 
          SA2    NY             POSITION. 
          LX1    9
          BX1    X1+X2       COMBINE X,Y
          OUTCODE WFCODE     PUT CODE IN MOUT BUFFER. 
          EQ     PROCO
 
* /---   BLOCK      ERASE      00 000   79/04/23  01.21 
* 
*         -DWECOLR- 
* 
*         SET MODE TO WRITE AND OUTPUT CURRENT DEFAULT
*         FOREGROUND AND BACKGROUND COLORS AS SPECIFIED 
*         IN STATION BANK LOCATION *COLORS*.
*         J R SCHRAMM        83/03/04 
* 
          ENTRY  DWECOLR
 DWECOLR  EQ     *
          MX6    -3          FORM MASK FOR CURRENT MODE 
          LX6    6
          SA1    TBNARGS
          BX6    X6*X1       CLEAR OLD MODE 
          SX1    300B        MODE WRITE 
          BX6    X6+X1
          SA6    A1          STORE MODE WRITE IN *TBNARGS*
          EQ     DWECOLR     -> EXIT
 
          ENTRY  OUTCOLR
 OUTCOLR  EQ     *
* 
*         SEND COLORS TO COLOR TERMINAL 
* 
*         ENTER'; X1 = COLORS -- 12/0,24/BGND COLOR,24/FGND COLOR 
* 
          BX6    X1          (X6) = BGND/FGND COLORS
          SA6    XCOLORS     SAVE EXECUTOR COLOR SETTINGS 
          MX0    -24         COLOR MASK 
          BX1    -X0*X1      X1 = FOREGROUND COLOR
          AX6    24D         MOVE BGND COLOR TO LOW ORDER 
          BX3    -X0*X6      X3 = BACKGROUND COLOR
          MX0    1
          LX0    25D         X0 = BACKGROUND FLAG 
          BX3    X0+X3       ADD COLOR + FLAG 
          OUTCODE RBGCODE    SEND FOREGROUND (X3 PRESERVED) 
          BX1    X3          X1 = BACKGROUND COLOR
          OUTCODE RBGCODE    SEND BACKGROUND COLOR
          EQ     OUTCOLR     -> EXIT
 
* /---   BLOCK      DOT        00 000   77/06/06  20.54 
* 
*         -DOT-  (CODE=44)
* 
*            SINGLE VARIABLE (ROW-COLUMN POSITION) DOT. 
* 
 DOTX     NGETVAR            ROUNDS TO INTEGER IN X1
          RJ     RCTOXY      GET INTO X -Y FORMAT 
          BX1    X6 
          EQ     DOTFXX 
* 
* 
* /---   BLOCK      PLOT, CHAR 00 000   79/01/19  19.45 
*         -DOT(F)-  (CODE=45) 
* 
*            TWO VARIABLE (FINE GRID) DOT.
* 
 DOTFX    RJ     GET2        GET VALUES OF 2 VARIABLES
**NXNY FIXED**
 DOTFXX   MX0    -9 
          BX1    -X0*X1 
          BX7    -X0*X7 
          SA6    NX          UPDATE NX,NY 
          SA7    NY 
          LX1    9           SHIFT UP 9 
          BX1    X1+X7       COMBINE WITH Y 
          OUTCODE DFCODE
          EQ     PROCO
* 
* 
          TITLE  PLOT AND CHAR
*         -PLOT-  (CODE=260)
* 
*            THE TAG SPECIFIES THE NUMBER (0-127) OF THE LOADABLE 
*         CHARACTER TO BE PLOTTED.  NUMBERS 0-62 REFERENCE CHARACTER
*         MEMORY 2, 64-126 REFERENCE CHARACTER MEMORY 3.
* 
*            SPECIAL ADDITION--RWB
*         NUMBERS 128-191 REFERENCE CHAR MEM 0
*         NUMBERS 192-255 REFERENCE CHAR MEM 1
* 
 PLOTX    NGETVAR            ROUNDS TO INTEGER IN X1
          BX2    X1 
          AX2    8           *** CHANGED TO 8 FROM 7-RWB
***       NOTE.  IF YOU CHANGE THE 8 BITS, YOU WILL HAVE
***       TO CHANGE THE EXECUTION ERROR MESSAGE 
          NZ     X2,PLERXLMT DO NOT ALLOW OVER 8 BITS 
          NG     X2,PLERXLMT DO NOT ALLOW NEGATIVE VALUES 
          OUTCODE PLTCODE 
          SA1    NX          UPDATE NX
          SX2    8
          IX1    X1+X2
          MX7    51 
          BX7    -X7*X1      9-BIT NX 
          SA7    A1 
          EQ     PROCO
**NXNY FIX NEEDED ABOVE** 
* 
 PLERXLMT EXECERR 92         EXCEEDING 8 BIT LIMIT
* 
* 
*         -CHAR-  (CODE=48) 
* 
*            LOAD CHARACTER INTO CHARACTER MEMORY.
* 
 CHARX    SX6    9           NUMBER OF VARIABLES TO DECODE
          RJ     GETN        GET 9 VALUES 
          SA4    VARBUF 
          X      MTCHRV,1,X4       PROCESSING FOR PPT-TUTOR 
          SA1    VARBUF      GET CHARACTER NUMBER 
          LX1    3           MULTIPLY BY 8 TO GET MEMORY ADDRESS
          BX6    X1 
          SA6    A1 
          SB1    A1 
          SB2    VARBUF+1 
          RJ     MEMOUT      MEMORY LOAD REQUEST TO OUTPUT BUFFER 
          SA1    INHIBS 
          LX1    CCLRSHF     SEE IF SHOULD CLEAR CHARSET FLAGS
          NG     X1,PROCO 
          SX6    0           FLAG NO CHARACTER SET LOADED 
          SA6    TBCSETA
          SA6    TBCSET 
          SA6    TBCSET+1 
          EQ     PROCO
* /---   BLOCK      END,MODE   00 000   76/11/09  09.40 
          TITLE  -END-    -MODE-
* 
* 
*         -END-     (CODE=112)
* 
 ENDX     NG     X5,ENDLES   JUMP IF END LESSON 
          SA1    TBASE       SEE WHETHER IN HELP SEQUENCE 
          ZR     X1,PROCESS  IGNORE IF NOT IN HELP
          BX6    X1          ELSE SET TBNEXT
          SA6    TNEXT
          EQ     UNITJ
* 
 ENDLES   SA1    ILESUN      PRESENT LESSON AND UNIT POINTERS 
          MX0    42 
          BX6    X0*X1       LESSON NUMBER
          SA6    TNEXT       SET TO UNIT ZERO 
          MX0    5
          SA2    TBSCORE
          BX6    -X0*X2      CLEAR OUT OLD *LDONE* INFO 
          SX2    1           SET FOR -COMPLETED-
          LX2    -5          PUT IN UPPER 5 BITS
          BX2    X0*X2       LIMIT TO 5 BITS
          BX6    X6+X2       ADD IN TO *TBSCORE*
          SA6    TBSCORE
          EQ     UNITJ
* 
* 
*         -MODE-  (CODE=50) 
* 
*            SELECTS TERMINAL WRITE/ERASE FUNCTION. 
* 
 MODECX   CALL   GETTAG      CONDITIONAL CASE, GET TAG
 MODEX    LX5    XJDGL       TOP XJDGL BITS OF COMMAND WORD= W/E FUN. 
          MX0    60-XJDGL 
          BX1    -X0*X5 
          SX2    X1-7 
          PL     X2,PROC     --- EXIT IF -X- OPTION 
* 
          SX2    X1-4        CHECK IF XOR MODE
          NZ     X2,MCWS0    NO, SO SKIP TERMINAL CHECK 
          SX0    X1          SAVE MODE VALUE
* 
* TWINDOW USES X1 AND X2
* 
          RJ     TWINDOW     CHECK IF TERM SUPPORTS XOR 
          NZ     X1,MCWS2    XOR OK 
          SX1    1           XOR NOT SUPPORTED, SET REWRITE 
          EQ     MCWS0
 MCWS2    SX1    X0          RESTORE X1 
* 
 MCWS0    MX0    -3 
          LX0    6           POSITION MASK
          SA2    TBNARGS
          BX6    X0*X2       CLEAR OUT OLD MODE 
          BX2    X1 
          LX2    6           POSITION NEW TERMINAL MODE 
          BX6    X2+X6
          SA6    A2          SAVE IN *TBNARGS*
          OUTCODE WEFCODE 
          EQ     PROCO
* /---   BLOCK      INHIBIT    00 000   77/04/28  23.56 
          TITLE  INHIBIT
*         -INHIBIT-  (CODE=66)
* 
*            INHIBITS CERTAIN STANDARD TUTOR FEATURES.
*         (FULL SCREEN ERASE, ANS-C ERASE, SHOWING ARROW) 
* 
 INHIBX   MX0    -XCMNDL     MASK OUT COMMAND NUMBER
          BX5    X0*X5       RETAIN ONLY INHIBIT BITS 
          MX2    LNGSHIF-1   MASK FOR INHIBIT BITS ONLY 
          BX2    -X2
          SA1    INHIBS      READ UP THE OLD INHIBS FLAG WORD 
          SB2    ICLRSHIF    CHECK CLEAR BEFORE SET 
          LX3    X5,B2
          PL     X3,INHIBX1 
          BX1    X2*X1       CLEAR FIRST
 INHIBX1  BX6    X5+X1       COMBINE NEW WITH OLD FLAGS 
          NZ     X5,INHIBX2  JUMP IF NON-BLANK INHIBIT
          BX6    X2*X6       BLANK CLEARS INHIBIT OR FORCE BITS 
 INHIBX2  SA6    A1          PUT IT BACK IN INHIBS
          EQ     PROC 
* 
* 
*         -FORCE- COMMAND 
* 
*         LIKE INHIBIT BUT IN A POSITIVE WAY
* 
 FORCEX   MX0    -XCMNDL
          BX5    X0*X5
          LX5    -LNGSHIF    TO ADJUST FOR MULTIPLE USE OF -INHIBS- 
          MX2    LNGSHIF-1   MASK FOR INHIBIT BITS ONLY 
          SA1    INHIBS      READ UP THE OLD INHIBS FLAG WORD 
          SB2    FCLRSHIF    CHECK CLEAR BEFORE SET 
          LX3    X5,B2
          PL     X3,INHIBX1 
          BX1    X2*X1       CLEAR FIRST
          EQ     INHIBX1
* /---   BLOCK      STOREA     00 000   76/06/14  22.33 
          TITLE  STOREA 
*         -STOREA-  (CODE=68) 
* 
*            STORES ALPHANUMERIC CHARACTER STRING FROM JUDGE BUFFER.
* 
 STOREAX  NGETVAR            GET STORAGE ADDRESS
          SX6    A1          SAVE ADDRESS 
          SA6    EXECSAV
          SA5    A5          RESTORE COMMAND WORD 
          LX5    XCODEL 
          NGETVAR            X1 = NUMBER OF CHARS REQUESTED 
          ZR     X1,PROCESS  --- EXIT IF NO CHARS 
          SA2    EXECSAV
          SA0    X2          PICK UP ADDRESS
          RJ     WORDS       CHECK STORE BOUNDS 
          SB1    1
          SB3    X1-1        CHARS-1
          SA2    JUDGE-1     A2 = ADDRESS OF STUDENT CHARS
          SA3    TJCOUNT     X3 = COUNT OF STUDENT CHARS
          SX6    0           (NEEDED IN CASE NO CHARS)
          SB2    10          (NEEDED IN CASE NO CHARS)
          ZR     X3,STA3     JUMP IF NO STUDENT CHARS 
          BX1    -X1         X1 = -(CHARS REQUESTED)
          IX4    X3+X1       X4 = STUDENT CHAR COUNT - CHARS REQUESTED
          PL     X4,STA2     JUMP IF STUDENT CHAR COUNT GREATER OR EQUAL
          BX1    -X3         X1 = -(STUDENT CHAR COUNT) 
 STA1     SX6    0           CLEAR CHAR ACCUMULATING WORD 
          SB2    10          B2 = CHARS LEFT TO GO IN WORD
 STA2     SA2    A2+B1       X2 = NEXT STUDENT CHAR 
          LX6    6
          BX6    X6+X2
          SB2    B2-B1       DECREMENT COUNT OF CHARS TO PUT IN WORD
          SB3    B3-B1       DECREMENT COUNT OF CHARS REQUESTED 
          SX1    X1+B1       INCREMENT END TEST MARKER
          PL     X1,STA3     JUMP IF AT END 
          NZ     B2,STA2     JUMP IF WORD NOT COMPLETE
          SA6    A0          STORE PACKED CHARACTER STRING
          SA0    A0+B1       INCREMENT STORAGE ADDRESS
          EQ     STA1        INITIALIZE FOR NEXT WORD 
 STA3     ZR     B2,STA5     JUMP IF WORD COMPLETE
          MX2    0           NEW ZERO FILL
 STA4     LX6    6
          BX6    X6+X2
          SB3    B3-B1       DECREMENT COUNT OF CHARS REQUESTED 
          SB2    B2-B1       DECREMENT COUNT OF CHARS TO PUT IN WORD
          NZ     B2,STA4
 STA5     SA6    A0          STORE NEXT WORD
          NG     B3,PROCESS  --- EXIT IF DONE 
          MX6    0           ZERO FILL
 STA6     SA6    A6+1 
          SB3    B3-10
          PL     B3,STA6
          EQ     PROCESS     --- EXIT 
* /---   BLOCK      SHOWA      00 000   77/07/20  13.47 
          TITLE  SHOWA
*         -SHOWA- 
* 
*            SHOWS VARIABLE(S) IN ALPHANUMERIC FORM.
* 
*         SHOWA  EXPR[,LENGTH]
* 
*         INTERNALLY, THERE ARE TWO CASES.  IF EXPR IS
*         NON-STORABLE (IN THE SENSE USED BY COMPILE), THEN 
*         THE 60-BIT VALUE RETURNED BY GETVAR IS USED AS
*         THE DATA TO DISPLAY, AND LENGTH MUST BE ^<10. 
*         IF EXPR IS STORABLE, THEN EXPR IS INTERPRETED AS
*         THE FIRST WORD OF A STRING WHICH CAN POTENTIALLY
*         EXTEND OVER MULTIPLE WORDS. 
* 
*         IN THE LATTER CASE, ARRAYSEGV PRESENTS A PROBLEM
*         BECAUSE IT IS CONSIDERED STORABLE BY THE REST OF
*         THE CONDENSOR, YET IT SHOULD BEHAVE AS A SEGMENT
*         RATHER THAN A STRING.  A KLUDGE IS USED TO HANDLE 
*         ARRAYSEGV PROPERLY. 
* 
 SHOWAX   SX6    0
          SA6    ARAYFLG     PREPARE FOR ARRAY CHECK
          SA6    SHOWVAL     PRE-CLEAR FOR LITERAL CHECK
          SA6    STORFLG     SHOW NOT STORABLE
          MX0    1
          BX5    -X0*X5      MASK OFF STORABLE BIT
          NGETVAR            PROCESS FIRST SHOWA ARGUMENT 
          SA5    A5 
          NG     X5,SHALIT   --- IF FIRST ARG NON-STORABLE
          SA2    A1          KLUDGE TO DISTINGUISH ARRAYSEGV
          BX2    X2-X1
          NZ     X2,SHALIT   --- IF ARRAYSEGV 
          MX6    -1 
          SA6    STORFLG
          SX6    A1          (X6) = ADDRESS OF FIRST ARG
          EQ     SHARENT
 
*         SHOW LITERAL (NON-STORABLE 60-BIT EXPRESSION) 
 
 SHALIT   NG     X1,SHOWA01 
          ZR     X1,PROCO    --- IF EXPR=0, NOTHING TO SHOW 
 SHOWA01  BX6    X1 
          SA6    SHOWVAL
          SX6    A6 
 
*         PROCESS LENGTH ARGUMENT AND BOUNDS CHECK IT.
 
 SHARENT  SA6    EXECSAV     ADDRESS IN EXECSAV 
          SA5    A5          READ COMMAND WORD
          LX5    XCODEL 
          NGETVAR            SECOND ARGUMENT
          ZR     X1,PROCESS  --- IF LENGTH = 0
          SA2    EXECSAV     (X2) = ADDRESS OF STRING 
          SA3    ARAYFLG
          NZ     X3,SHAREN1  --- IF ARRAY SHOWA 
          SA3    STORFLG
          ZR     X3,SHAREN1  --- IF NON-STORABLE
 
          SA0    X2          PICK UP ADDRESS
          RJ     WORDS       CHECK ADDRESS BOUNDS 
          SB1    A0          ADDRESS OF STRING
          EQ     SHAREN2     MORE COMMON CODE 
* 
 SHAREN1  SB1    X2          SET B1 TO STRING ADDRESS 
          NG     X1,ERXBADL 
          SX2    11          LIMIT TO 10 CHARACTERS 
          IX2    X1-X2
          PL     X2,SHERXARR CANNOT SHOWA MORE THAN 10
*                            CHARS WITH ARRAY SHOWA 
*                            EXECERR USES X1
* /---   BLOCK      SHOWA      00 000   77/07/20  13.46 
 SHAREN2  BX6    X1          SAVE NCHARS IN X1 FOR XYFIX
          SA6    NCHAR       PLANT COUNT, SAVE X6 FOR LATER 
          SB2    A6          ADDRESS OF CHARACTER COUNT 
          SA4    ARAYFLG
          NZ     X4,ASHOWA
          SA5    A5          RE-FETCH 
          LX5    2*XCODEL 
          NG     X5,SHOWAS   CHECK FOR EMBEDDED SHOWA(S)
          RJ     XYFIX
          EQ     SHOWAW 
* 
          EXT    ASHOW2,ASHOWIN,ARAYFLG 
          EXT    ASHOWEF
* 
 ASHOWA   SA3    SHOWA1      PLANT EQ ASHOW2 IN LOOP
          BX1    X4          X1 MUST BE ARAYFLG 
          SA6    ASHOWEF     SAVE FORMAT IN X6
          SX6    2           FLAG FOR NGETVAR ADDR
          EQ     ASHOWIN     SETUP LOOP 
* 
 SHOWA1   EQ     SHOWA2 
 SHOWA2   SA1    ASHOWEF     X1 USED IN XYFIX 
          BX6    X1 
          SA6    NCHAR       RESTORE CHARCOUNT
          SB2    A6          PTR TO COUNT 
          EQ     ASHOW2 
* 
 SHOWAS   SX7    B1          SAVE B1
          SA7    SHOWOUT
          SX7    B2 
          SA7    SHOWOUT+1   SAVE B2
          SA1    RSIZE
          NZ     X1,SHOWAW   IF NOT SIZE 0
          RJ     SIMPLOT     UPDATE NX, NY CORRECTLY
          SA2    SHOWOUT     RESTORE B1 
          SB1    X2 
          SA2    SHOWOUT+1   RESTORE B2 
          SB2    X2 
          EQ     SHOWAW 
* /---   BLOCK      SHOWA      00 000   80/04/22  01.00 
* 
 SHOWAW   SA1    SHOWVAL     CHECK FOR LITERAL SHOW 
          NG     X1,SW110    CHECK FOR -0 
          ZR     X1,SW120 
* 
 SW110    CALL   TUTWRT      SHOW LITERAL 
          EQ     PROCO
* 
 SW120    SA1    RSIZE       CHECK IF SIZED WRITTING
          NZ     X1,SW200 
          SA4    B2          LOAD CHARACTER COUNT 
          SX1    X4+9        ROUND FOR WORD COUNT 
          PX1    X1 
          SA2    TENTH
          FX1    X1*X2       COMPUTE WORD COUNT 
          SX1    X1 
          SA2    MOUTLOC
          IX1    X1+X2       CHECK IF ROOM IN *MOUT* BUFFER 
          SX1    X1-MOUTLTH+1 
          NG     X1,SW150    JUMP IF ENOUGH ROOM
          SX6    B1 
          SA6    SHARE+1     SAVE POINTER TO TEXT 
          SX6    X4 
          SA6    SHARE+2     SAVE CHARACTER COUNT 
          CALL   WINTRP      INTERRUPT
          SA1    SHARE+1
          SB1    X1          RESTORE POINTER TO TEXT
          SB2    SHARE+2     RESTORE POINTER TO CHAR COUNT
* 
 SW150    CALL   WRSOUT      OUTPUT TO *MOUT* BUFFER
          EQ     PROCO
* 
 SW200    MX6    -7-3 
          SA2    TBWRITE     CLEAR SIZE WRITE INFO
          BX6    X6*X2
          SA6    A2 
          SX6    B1          X6 = POINTER TO NEXT TEXT WORD 
          SA6    SHARE+2
          SA1    B2 
          BX7    X1          X7 = CHARACTER COUNTER 
          SA7    SHARE+1
* 
 SW210    SA1    MOUTLOC     SEE HOW MUCH OUTPUT SO FAR 
          SX1    X1-MOUT200 
          PL     X1,SW250 
          SA1    XSLCLOK     GET CPU USE CLOCK
          SA2    MAXCLOK
          IX2    X1-X2
          PL     X2,SW250 
* 
          SA1    PARCLCNT    SEE IF TOO MUCH CUMULATIVE 
          SX1    X1-PRCLIM
          PL     X1,SW250 
          SB1    X6          POINTER TO NEXT WORD OF TEXT 
          SB2    =10         PRE-SET CHARACTER COUNT
          SX0    X7-11       CHECK NUMBER CHARS LEFT TO DO
+         PL     X0,*+1 
          SB2    SHARE+1     SPECIAL FOR LAST WORD
+         CALL   LINWRT 
          SA1    SHARE+1
          SX7    X1-10       UPDATE CHARACTER COUNT 
          NG     X7,PROCO 
          SA7    A1 
          SA1    SHARE+2
          SX6    X1+1        UPDATE TEXT POINTER
          SA6    A1 
          EQ     SW210
* 
 SW250    CALL   WINTRP      INTERRUPT
          SA1    SHARE+1
          SX7    X1          RESTORE X7 = CHARACTER COUNT 
          SA1    SHARE+2
          SX6    X1          RESTORE X6 = POINTER TO TEXT 
          EQ     SW210
* 
* 
 SHERXARR EXECERR 93         TRYING TO SHOWA MORE THAN 10 
*                            CHARS PER ARRAY ELEMENT
 STORFLG  DATA   0
* /---   BLOCK      SHOWK      00 000   80/04/22  01.00 
 SHOWK    TITLE  -SHOWK-
* 
*         -SHOWK- 
* 
*         ARGUMENT = INTERNAL KEY CODE. 
* 
*         DISPLAYS THE APPROPRIATE STRING, IF ANY, FOR THE
*         GIVEN KEY CODE AND TERMINAL TYPE.  IF KEY CODE IS 
*         NOT WITHIN THE RANGE OF THE TABLE, BUT IS A 
*         DISPLAYABLE KEY, IT WILL BE PLOTTED.  OTHERWISE,
*         NOTHING WILL BE SHOWN.  THE VALUES IN THIS TABLE
*         CAN BE EDITED USING LESSON *S0TTYPE*. 
 
          ENTRY  SKPACK      ENTRY FROM -PACK- COMMAND
 
 SKPACK   EQ     *           ENTRY/EXIT FOR -PACK- COMMAND
          MX7    1
          EQ     SHOWK10
 
 SHOWKX   MX7    0           ENTRY FOR -SHOWK- EXECUTION
 SHOWK10  SA7    SKPTYPE     FLAG TO INDICATE CALLER
          NGETVAR            (X1) = INTERNAL KEY CODE 
          BX7    X1 
          SA7    SHKKEY      SAVE INTERNAL KEY CODE 
          SX7    -1          DEFAULT TO NO COLOR SET
          SA1    SKPTYPE     SEE IF -SHOWK- OR -PACK- 
          NZ     X1,SHOWK13  IF NOT -SHOWK-, SKIP 
          LX5    XCODEL      SHIFT TO NEXT PARAM
          SX7    -1          DEFAULT TO NO COLOR SET
          NG     X5,SHOWK13  IF NEGATIVE, NO COLOR PASSED 
          NGETVAR 
          BX7    X1 
 SHOWK13  SA7    SHKCOLR     SAVE COLOR TO DISPLAY KEY
          SA1    SHKKEY      RESTORE *X1* 
          NG     X1,SHOWK70  IF NEGATIVE VALUE, IGNORE
          SB3    6           CHECK FOR 70XX KEY CODE
          AX3    X1,B3
          SX2    X3-70B 
          NZ     X2,SHOWK15  IF NOT 70XX KEY CODE 
          SX1    X1-6700B    CONVERT TO INTERNAL CODE 
 
 SHOWK15  BX7    X1          SAVE FOR LATER 
          SA7    SHOWKEY
          SA1    TTPARAM+1   (X1) = 48/OTHER,12/TERM. CLASS 
          MX0    -12
          BX3    -X0*X1      (X3) = TERMINAL CLASS ORDINAL
          SX1    TTWPTT      CALCULATE OFFSET IN TABLE
          IX2    X1*X3       (X2) = START OF PARAMETERS 
          SX1    X2+TTPARMW  (X1) = START OF POINTERS 
          SA2    ATTPARM     (X2) = EM KEY TABLE ADDRESS
          NG     X2,SHOWK50  IF COMMON NOT LOADED, RETURN 
          IX6    X1+X2       (X6) = KEY TABLE ENTRY ADDRESS 
          SA6    SHOWTAB     SAVE ENTRY ADDRESS 
 
*         CHECK RANGE OF KEY AND CALCULATE OFFSET IN POINTER
*         TABLE.
 
          SX2    X7-KDIV     SEE IF .LT. MINIMUM
          NG     X2,SHOWK45  IF NO STRING FOR THIS CODE 
          SX2    X7-TAB-1    SEE IF .GT. MAXIMUM
          PL     X2,SHOWK45  IF NO STRING FOR THIS CODE 
          SX2    X7-KSEMIC-1
          PL     X2,SHOWK20  IF NOT IN LOWER RANGE
          SX6    X7-KDIV     (X6) = OFFSET IN POINTER TABLE 
          EQ     SHOWK30     GET POINTER
 
 SHOWK20  SX2    X7-KUNDER   SEE IF IN UPPER RANGE
          NG     X2,SHOWK45  IF NO STRING FOR THIS CODE 
          SX6    X7-KUNDER+KSEMIC-KDIV+1  (X6) = OFFSET 
 
* /---   BLOCK      SHOWK      00 000   83/09/14  08.42 
*         GET POINTER AND SEE IF DEFAULT OR ALTERNATE KEY 
*         NAME IS TO BE PLOTTED.
 
 SHOWK30  SX3    TTPPW
          PX1    X6          PREPARE FOR FLOATING DIVIDE
          PX2    X3 
          NX1    X1          (X1) = POINTER OFFSET
          NX2    X2          (X2) = POINTERS PER WORD 
          FX5    X1/X2       (X5) = FLOATING WORD OFFSET
          UX5    X5,B2       RETURN TO INTEGER
          LX5    B2          (X5) = INTEGER WORD OFFSET 
          IX3    X5*X3
          IX4    X6-X3       (X4) = REMAINDER 
          SX3    TTWIDTH
          SX4    X4+1 
          IX3    X3*X4       (X3) = SHIFT COUNT 
 
          SA1    SHOWTAB     (X1) = START OF TABLE ENTRY
          IX0    X1+X5       (X0) = WORD FROM TABLE ENTRY 
          RX1    X0          (-RXX- 1 WD READ, MAY CHG *A1*)
          SB2    X3 
          LX1    B2          SHIFT POINTER TO LOWER BITS
          MX0    -TTWIDTH 
          BX2    -X0*X1      (X2) = POINTER 
          ZR     X2,SHOWK35  IF DEFAULT STRING
 
*         GET ALTERNATE STRING FROM EM. 
 
          SX2    X2-1        ORDINAL OF 1 = OFFSET OF ZERO
          LX2    1           COMPENSATE FOR 2-WORD ENTRIES
          SA1    ATTPARM     (X1) = START OF EM TABLE 
          SX2    X2+TTALT    (X2) = OFFSET TO STRING
          IX0    X1+X2
          SA0    SKTEMP 
+         RE     2
          RJ     ECSPRTY
          EQ     SHOWK37     PLOT STRING
 
*         GET DEFAULT STRING FROM EM. 
 
* /---   BLOCK      SHOWK      00 000   83/09/14  08.59 
 SHOWK35  LX6    1           (X6) = ENTRY ORDINAL * 2 
          SX2    X6+TTDEFLT  (X2) = OFFSET TO DEFAULT STRING
          SA1    ATTPARM     (X1) = START OF EM TABLE 
          IX0    X1+X2       (X0) = ADDRESS OF STRING IN EM 
          SA0    SKTEMP 
+         RE     2
          RJ     ECSPRTY
 
*         PLOT OR -PACK- THE ALTERNATE OR DEFAULT STRING. 
 
 SHOWK37  SA1    SKTEMP      CHECK FOR 1ST CHARACTER = 00 
          MX0    6
          BX2    X0*X1       (X2) = 6/1ST CHAR, 54/0
          NZ     X2,SHOWK38  IF NOT ENCODED *SHIFT-*
          SX3    1R-         REPLACE 00 WITH HYPHEN 
          LX3    54 
          BX6    X3+X1
          SA6    SKTEMP      SAVE UPDATED WORD
          SX7    30D         (X7) = STRING LENGTH 
          SB3    0           (B3) = OFFSET FROM SKSHIFT 
          SA7    SKCHARS     SAVE STRING LENGTH 
          EQ     SHOWK39
 
 SHOWK38  SX7    20D         (X7) = STRING LENGTH 
          SB3    1           (B3) = OFFSET FROM SKSHIFT 
          SA7    SKCHARS     SAVE STRING LENGTH 
 
* /---   BLOCK      SHOWK      00 000   80/03/01  11.03 
 SHOWK39  SA2    SKPTYPE     CHECK COMMAND TYPE 
          NG     X2,SHOWK40  IF -PACK- COMMAND
 
          SA1    SHKCOLR     GET COLOR OF FUNCTION KEY
          NG     X1,SHOK39Y  IF NO COLOR SPECIFIED
          MX0    36          SEE IF COLOR OVERFLOWS 
          BX0    X0*X1
          ZR     X0,SHOK39X  IF COLOR OK, SEND IT OUT 
          SX6    -1          NOTE COLOR NOT SENT
          SA6    A1          RESTORE NEW VALUE
          EQ     SHOK39Y     CONTINUE 
 
 SHOK39X  MX0    -3          MODE 
          SA2    TBNARGS
          AX2    6           POSITION TERMINAL W/E MODE 
          BX2    -X0*X2 
          SX2    X2-2        SEE IF -MODE  ERASE- 
          ZR     X2,SHOK39Y  IF ERASE, DONT CHANGE COLOR
 
          OUTCODE RBGCODE    12/0,24/COLOR,24/RBGCODE 
 
 SHOK39Y  SX6    B3          SAVE OFFSET
          SA6    SKOFF
          SB1    SKSHIFT+B3  (B1) = ADDRESS OF STRING 
          SB2    SKCHARS     (B2) = ADDRESS OF CHAR COUNT 
          SA1    RSIZE
          NZ     X1,SHOK39A  IF SIZE NOT ZERO 
          RJ     SIMPLOT
          SA1    SKOFF
          SB1    SKSHIFT+X1  (B1) = ADDRESS OF STRING 
          SB2    SKCHARS     (B2) = ADDRESS OF CHAR COUNT 
 
 SHOK39A  CALL   TUTWRT      WRITE THE STRING 
 
 SHOK39B  SA1    SHKCOLR     GET COLOR OF FUNCTION KEY
          NG     X1,PROCO    IF NO COLOR SPECIFIED
 
          SA1    XCOLORS     EXECUTOR COLOR SETTINGS
 
          MX0    -3          MODE 
          SA2    TBNARGS
          AX2    6           POSITION TERMINAL W/E MODE 
          BX2    -X0*X2 
          SX2    X2-2        SEE IF -MODE  ERASE- 
          ZR     X2,PROCO    IF ERASE, GO TO PROCESS
          MX0    -24D 
          BX1    -X0*X1      X1 = FOREGROUND COLOR
          OUTCODE RBGCODE    12/0,24/COLOR,24/RBGCODE 
          EQ     PROCO       RETURN 
 
 SHOWK40  SA1    SKSHIFT+B3  (A1) = ADDRESS OF STRING 
          SA2    SKCHARS     (X2) = CHARACTER COUNT 
          SB2    X2          (B2) = CHARACTER COUNT 
          SB3    -1          INDICATE JUMP TO *PACK2A*
          EQ     SKPACK      RETURN 
 
* /---   BLOCK      SHOWK      00 000   83/09/07  09.36 
*         PLOT OR -PACK- KEY WHICH HAS NO STRING, CONVERTING
*         FROM INTERNAL TO EXTERNAL CODE, IF NECESSARY. 
 
 SHOWK45  SB3    6
          SA1    SHOWKEY     (X1) = INTERNAL KEY CODE 
          AX2    X1,B3       SEE WHAT CONVERSION NEEDED 
          ZR     X2,SHOWK60  IF 00XX CODE 
          SX3    X2-70B 
          ZR     X3,SHOWK50  IF 70XX CODE 
          SX3    X2-1 
          NZ     X3,SHOWK70  IF NOT 01XX CODE, GIVE UP
          SX1    X1+6700B    CONVERT 01XX CODE TO EXTERNAL
 SHOWK50  LX1    59-11       (X1) = 12/EXTERNAL CODE, 48/0
          SX7    2           (X7) = CHARACTER COUNT 
          EQ     SHOWK65     PLOT KEY 
 
 SHOWK60  LX1    59-5        (X1) = 6/KEY CODE, 54/0
          SX7    1           (X7) = CHARACTER COUNT 
 
 SHOWK65  SA2    SKPTYPE     CHECK FOR COMMAND TYPE 
          BX6    X1          (X6) = SHIFTED KEY CODE
          SA7    SKCHARS
          SA6    SHOWKEY
          NG     X2,SHOWK67  IF -PACK- COMMAND
          SB1    A6          (B1) = ADDRESS OF CHARACTER
          SB2    A7          (B2) = ADDRESS OF CHAR COUNT 
          SA1    RSIZE
          NZ     X1,SHOK65A  IF SIZE NOT ZERO 
          RJ     SIMPLOT
          SB1    SHOWKEY     (B1) = ADDRESS OF CHARACTER
          SB2    SKCHARS     (B2) = ADDRESS OF CHAR COUNT 
 SHOK65A  CALL   TUTWRT      WRITE THE CHARACTER
          EQ     PROCO       RETURN 
 
 SHOWK67  SA1    SHOWKEY     (A1) = ADDRESS OF CHARACTER
          SB2    X7          (B2) = CHARACTER COUNT 
          SB3    -1          INDICATE JUMP TO *PACK2A*
          EQ     SKPACK      RETURN 
 
*         FOR KEYS WHICH CANNOT BE PLOTTED, AND WHICH HAVE
*         NO STRINGS ATTACHED, RETURN AFTER DOING NOTHING.
 
 SHOWK70  SA1    SKPTYPE     DETERMINE RETURN DESTINATION 
          PL     X1,PROC     IF NOT PROCESSING -PACK- 
          SB3    0           INDICATE JUMP TO *PACK1A*
          EQ     SKPACK      RETURN 
 
*         MISCELLANEOUS VARIABLES.
 
 SHOWKEY  BSS    1           INTERNAL KEY CODE
 SHOWTAB  BSS    1           TABLE ENTRY ADDRESS
 SKSHIFT  DATA   0L'S'H'I'F'T 
 SKTEMP   BSS    2           USED FOR EM READS
 SKPTYPE  BSS    1           NEGATIVE IF -PACK- COMMAND 
 SKCHARS  BSS    1           NUMBER OF CHARACTERS TO PLOT 
 SKOFF    BSS    1
 SHKKEY   BSS    1           INTERNAL KEY TO BE SHOWN 
 SHKCOLR  BSS    1           COLOR TO DISPLAY KEY IN
* 
* /---   BLOCK      -TEXT-     00 000   83/09/07  09.37 
          TITLE  -TEXT- COMMAND 
**        TEXT COMMAND PROCESSING.
* 
*         FORMAT';    TEXT   BUFFER,LENGTH <,LINES> 
* 
*         WHERE'; BUFFER = INPUT TEXT BUFFER ADDRESS
*                LENGTH = LENGTH OF BUFFER IN WORDS,
*                LINES = MAX NO. OF LOGICAL '# PHYSICAL LINES 
*                         TO BE DISPLAYED (OPTIONAL). 
* 
*         THE PRESENCE OF THE *LINES* TAG IS REFERRED TO AS 
*         THE NEW FORMAT, W/O *LINES* AS THE OLD FORMAT.
* 
*         THE OLD FORMAT DISPLAYS THE ENTIRE BUFFER.
* 
*         THE NEW FORMAT INVOKES *SIMPLOT* TO SIMULATE THE
*         PLOTTING OF EACH LINE, TO CHECK FOR THE PHYSICAL
*         (SCREEN) BOUNDARY.  ONLY THE NEW FORMAT SETS
*                ZRETURN = -1 = DISPLAYED ENTIRE BUFFER.
*                           0 = DISPLAYED NOTHING.
*                          +N = DISPLAYED *N* WORDS.
* 
* 
* 
*         NEED TO SET A LIMIT ON THE MAXIMUM LINE LENGTH, 
*         OTHERWISE WE COULD BE DEADLOCKED WAITING TO PLACE 
*         IT IN *MOUT* (IF IT WAS LARGER THAN *MOUTLTH*,
*         FOR INSTANCE).  NOTE THAT WE'7LL TRY TO PUT LARGER
*         LINES IN, BUT IF WE RUN OUT OF ROOM, WE'7LL JUST
*         HEAVE WHAT WE'7VE GOT INTO *MOUT*.
* 
*         THIS IS PERFECTLY OK FOR THE OLD VERSION, BUT 
*         WILL COUNT THE PARTIAL LINE AS A LOGICAL LINE 
*         IN THE NEW VERSION. 
* 
*         ALL THESE NUMBERS ARE ARBITRARY AT THIS TIME. 
* 
 MAXLINE  EQU    50          MAX LTH OF A LOG. LINE (WORDS) 
 MXMXL.   SET    MOUTLTH/8   FRAC OF MOUT FOR SINGLE LINE 
          ERRNG  MXMXL.-MAXLINE  MOUTLTH MAY BE TOO SMALL 
 
* 
*         DATA CELL DEFINITIONS.
* 
 TXTYPE   EQU    TBINTSV+0   OLD/NEW FORMAT FLAG + LINE CNT 
 TXBADDR  EQU    TXTYPE+1    CURRENT INPUT TEXT BUFFER ADDR 
 TXSTART  EQU    TXBADDR+1   ORIG. INPUT TEXT BUFFER ADDR 
 TXTLTH   EQU    TXSTART+1   INPUT TEXT LENGTH IN WORDS 
 TXLLINE  EQU    TXTLTH+1    MAX NO. OF LOGICAL LINES 
 TXYTARG  EQU    TXLLINE+1   LOWER BOUND FOR Y SCREEN POS.
 TXMHDR   EQU    TXYTARG+1   ORIG MOUTLOC = INDEX TO HEADER 
 TXSAVB2  EQU    TXMHDR+1    CELL TO SAVE B2 ACROSS SIMPLOT 
* 
* /---   BLOCK      TEXT INIT  00 000   83/09/07  09.37 
 
 TEXTX    BSS    0           ENTRY POINT FOR -TEXT- COMMAND 
          SX6    3           MAXIMUM NUMBER OF ARGS (TAGS)
          CALL   GETARGS     MOVE ARGS TO VARBUF, GET COUNT 
          SX6    X6-3        CHECK FOR OLD/NEW FORMAT 
          SA6    TXTYPE      -1 FOR OLD, 0 FOR NEW (SIMPLOT)
          NG     X6,OTEXT0   -- DON'7T SET *ZRETURN* IF OLD 
          SA6    TRETURN     ZRETURN=0 = NOTHING DISPLAYED
 OTEXT0   BSS    0
 
          SA1    VARBUF      GET FIRST ARG -- BUFFER ADDRESS
          BX5    X1          MOVE TO X5 FOR GETVAR
          NGETVAR 
          SX6    A1          SAVE ADDRESS OF BUFFER 
          SA6    TXBADDR     MOVING POINTER 
          SA6    TXSTART     CONSTANT 
 
          SA1    VARBUF+1    GET SECOND ARG = LENGTH OF TEXT
          BX5    X1 
          NGETVAR 
          NG     X1,PROCESS  -- NEGATIVE LENGTH 
          ZR     X1,PROCESS  -- ZERO LENGTH 
          BX6    X1          SAVE TEXT LENGTH (WORDS) 
          SA6    TXTLTH 
 
          SA2    TXBADDR     GET BUFFER ADDRESS 
          SA0    X2          A0=ADDR, X1=LTH
          CALL   BOUNDS      CHECK BUFFER VALIDITY
 
          SA1    TXTYPE      CHECK OLD/NEW FORMAT 
          NG     X1,TXGO     -- OLD FORMAT ALL SET
          SA1    VARBUF+2    ELSE GET THIRD ARG = MAX LINES 
          BX5    X1 
          NGETVAR 
          SX6    X1          USE 18-BIT ARITHMETIC
          NG     X6,OTEXT1   -- NEGATIVE LINE COUNT 
          ZR     X6,OTEXT1   -- ZERO LINE COUNT 
          SA6    TXLLINE     SAVE AS MAX LOGICAL LINES ALSO 
          SA1    NY          GET CURRENT Y SCREEN POSITION
          LX6    4           LOG. LINES * 16 = DELTA Y
          IX6    X1-X6       CURRENT - DELTA = Y TARGET 
          PL     X6,TXDY0    -- STORE VALUE IF POSITIVE 
          SX6    0           ELSE USE 0 AS LOWER BOUND
 TXDY0    BSS    0
          SA6    TXYTARG     STORE LOWER BOUND FOR *NY* 
          EQ     TXGO        -- ALL SET, LET '7ER RIP 
* 
 OTEXT1   BSS    0
          MX6    -1 
          SA6    TXTYPE      PROCESS AS OLD FORMAT -TEXT- 
          SA6    TRETURN     AND SET ZRETURN TO *ALL DONE*
 
 TXGO     BSS    0           ARGUMENTS SET, FIRE AWAY 
          CALL   TXMIN       SET UP FOR *MOUT* (B1=1 TOO) 
 
* /---   BLOCK      TEXT LOOP  00 000   83/09/07  09.46 
* 
*         GET NEXT LINE TO BE DISPLAYED.  (OUTER LOOP)
*         NOTE THAT ALL THE INFORMATION IS READ FROM
*         *TBINTSV* CELLS AND THE CURRENT *MOUTLOC* SINCE 
*         WE MAY HAVE INTERRUPTED (*MOUT* WAS FULL).
* 
 TXLINE   BSS    0
          SA2    MOUTLOC     CURRENT INDEX INTO *MOUT*
          SX1    MOUTLTH     TOTAL LENGTH OF *MOUT* 
          IX1    X1-X2       SUBTRACT CURRENT FROM TOTAL
          SB3    X1          B3 = REMAINING WORDS IN *MOUT* 
          SB2    B3-B1       SO WE CAN CHECK FOR ZR/NG
          MX0    -12D        MASK FOR END-OF-LINE BYTE
          NG     B2,TXINTRP  -- NO ROOM LEFT IN *MOUT*
          SX3    X2+MOUT     X3 = ADDR OF NEXT WD IN *MOUT* 
          SX4    KCR         X4 = CARRIAGE RETURN 
          SA2    TXBADDR     X2 = INPUT TEXT BUFFER ADDRESS 
          SA1    TXTLTH 
          SB4    X1          B4 = REMAINING WDS OF INPUT
          SB2    B0          B2 = WORD INDEX INTO LINE
 
* 
*         GET NEXT WORD OF LINE (INNER LOOP). 
*         EVERYTHING HERE IS IN REGISTERS, SO YOU CAN'7T
*         COME HERE FROM ANYWHERE BUT TXLINE. 
* 
 TXWORD   BSS    0
          SA1    X2+B2       READ (LINE ADDR + INDEX) 
          SB3    B3-B1       DECREMENT WORDS LEFT IN *MOUT* 
          SB4    B4-B1       DECREMENT WORDS LEFT TO DISPLAY
          BX5    -X0*X1      MASK OF END-OF-LINE BYTE 
          NZ     X5,TXWD1    -- BRIF NOT END-OF-LINE
          BX1    X1+X4       ELSE INSERT CARRIAGE RETURN
 TXWD1    BSS    0
          BX6    X1          MOVE WORD TO STORE REGISTER
          SA6    X3+B2       STORE IN *MOUT*
          SB2    B2+B1       INCREMENT LINE INDEX (LENGTH)
          ZR     X5,TXEOB    -- BRIF END-OF-LINE
          ZR     B4,TXEOB    -- BRIF END-OF-BUFFER
          NZ     B3,TXWORD   -- BRIF STILL ROOM IN *MOUT* 
 
          SX1    B2-MAXLINE  CHECK FOR HUGE LINE LENGTH 
          PL     X1,TXEOB    -- TREAT IT AS A LOGICAL LINE
 
 TXINTRP  BSS    0           WAIT FOR *MOUT* TO BE FLUSHED
          CALL   TXMOUT      SET UP *MOUT* HEADER 
          CALL   WINTRP      INTERRUPT FOR DISPLAY
          CALL   TXMIN       INITIALIZE FOR *MOUT*
 
          EQ     TXLINE      -- TRY SAME LINE AGAIN 
 
* /---   BLOCK      TEXT EOB   00 000   83/09/07  09.39 
* 
*         END-OF-LINE OR END-OF-BUFFER  (NO DIFFERENCE).
*         WE HAVE NOT UPDATED ANY OF THE POINTERS YET,
*         SO WE CAN SKIP THIS LINE AFTER SIMPLOTTING
*         SIMPLY BY JUMPING TO THE EXIT PROCESSING. 
* 
 TXEOB    BSS    0
          SA1    TXTYPE      OLD/NEW -TEXT- FORMAT
          NG     X1,OTEXT2   -- BRIF IF NOT SIMPLOTTING 
 
          SX6    B2          SAVE B2 ACROSS SIMPLOT 
          SA6    TXSAVB2
          SB2    B2+B2       B2*2 
          LX6    3           B2*8 
          SB2    X6+B2       B2*10 = NO. OF CHARACTERS
 
          SA1    MOUTLOC     CURRENT POSITION IN *MOUT* 
          SB1    X1+MOUT     = STARTING POSITION OF LINE
 
          CALL   TEXTSTR     *** SIMPLOT LINE *** 
 
          SB1    1           RESTORE B1 
          SA1    TXSAVB2     RESTORE B2 
          SB2    X1 
 
          MX1    -9          MASK X,Y TO 9 BITS 
          BX3    -X1*X3      VALUE OF *NX* IF LINE PLOTTED
          BX4    -X1*X4      VALUE OF *NY* IF LINE PLOTTED
 
          SA1    TXTYPE      ABUSE OLD/NEW -TEXT- FLAG
          ZR     X1,TXFIRST  -- ALWAYS PLOT FIRST LINE
 
          SA1    TXYTARG     LOWER BOUND FOR *NY* 
          IX1    X4-X1       SUBTRACT TARGET FROM NEW 
          NG     X1,TXEND    -- BRIF RUNS BELOW *Y* TARGET
 
* 
*         UPDATE NX,NY (*WHERE*) IN STUDENT BANK. 
*         THIS IS CRITICAL, OR SIMPLOT WILL NOT SEE 
*         THE ACCUMULATION OF LINES.  WHEN SKIPPING,
*         THESE MUST NOT BE UPDATED OR IT WILL SEEM 
*         THAT A PHANTOM LINE HAS BEEN PLOTTED. 
* 
 TXFIRST  BSS    0
          BX6    X3 
          SA6    NX 
          BX6    X4 
          SA6    NY 
 
* /---   BLOCK      TEXT END   00 000   83/09/07  09.38 
* 
*         GOING TO DISPLAY THIS LINE, UPDATE POINTERS 
* 
 OTEXT2   BSS    0
          SA1    MOUTLOC     INCREMENT *MOUTLOC*
          SX6    X1+B2
          SA6    A1 
 
          SA1    TXBADDR     INCR INPUT TEXT BUFFER ADDR
          SX6    X1+B2
          SA6    A1 
 
          SA1    TXTLTH      DECREMENT REMAINING TEXT 
          SX6    B2 
          IX6    X1-X6
          SA6    A1 
          ZR     X6,TXEND    -- NO TEXT REMAINING 
 
* 
*         IF NEW FORMAT, COUNT LOGICAL LINES AND CHECK
*         FOR MAX LOGICAL LINES.  (DONE HERE BECAUSE
*         FIRST LINE MUST ALWAYS BE DISPLAYED)
* 
          SA1    TXTYPE      GET OLD/NEW FLAG (LOG. LINE) 
          NG     X1,TXLINE   -- CONTINUE PLOTTING IF OLD
          SX6    X1+B1       ELSE INCR FLAG AS LOGICAL
          SA6    A1          LINE COUNTER 
          SA1    TXLLINE     MAX NO. OF LOGICAL LINES 
          IX1    X6-X1       COMPARE WITH CURRENT COUNT 
          NG     X1,TXLINE   -- NOT AT LIMIT, CONTINUE
 
* 
*         THAT'7S ALL FOLKS, FINISH IT UP AND EXIT. 
* 
 TXEND    BSS    0
          CALL   TXMOUT      SET UP *MOUT* HEADER 
 
          SA1    TXTYPE      CHECK FOR OLD/NEW FORMAT 
          NG     X1,PROCO    -- IF OLD, JUST EXIT W/OUTPUT
 
          MX6    -1          PREPARE FOR *ALL DONE* RETURN
          SA1    TXTLTH      GET LENGTH OF REMAINING TEXT 
          ZR     X1,TXDONE   -- NONE LEFT, SHOW *ALL DONE*
          SA1    TXBADDR     ELSE FIND OUT HOW MUCH WAS 
          SA2    TXSTART     BY COMPARING CURRENT-START 
          IX6    X1-X2       NUMBER OF WORDS OUTPUT 
 TXDONE   BSS    0
          SA6    TRETURN     SET *ZRETURN*
          EQ     PROCO       -- EXIT WITH OUTPUT
* 
* 
* 
* /---   BLOCK      TEXT SUBR  00 000   83/09/07  09.39 
 
**        TXMIN - INIT FOR OUTPUT.
* 
*         PREPARE TO COPY LINES TO THE *MOUT* BUFFER
*         BY SAVING THE CURRENT *MOUTLOC*, WHICH WILL 
*         BE THE HEADER LOCATION (SEE TXMOUT).  ALSO
*         INITIALIZES B1=1. 
* 
 TXMIN    PS                 ENTRY/EXIT 
          SB1    1           B1 = CONSTANT B1 
          SA1    MOUTLOC     GET CURRENT *MOUT* INDEX 
          BX6    X1 
          SA6    TXMHDR      SAVE AS INDEX TO HEADER
          SX6    X1+B1       INCREMENT PAST HEADER WORD 
          SA6    A1          REWRITE *MOUTLOC*
          EQ     TXMIN       -- EXIT
* 
* 
 
 
**        TXMOUT - COMPLETE OUTPUT. 
* 
*         CONSISTS MOSTLY OF COUNTING NUMBER OF WORDS 
*         PLACED IN *MOUT* AND CHECKING FOR ZERO WORDS. 
*         IF ZERO, MOUTLOC IS RESET TO WHAT IT WAS ON 
*         ENTRY, AS IF WE HAD NEVER BEEN HERE.  IF NOT
*         ZERO, THE NUMBER OF CHARACTERS IS COMPUTED
*         AND PLACED IN THE HEADER IN *MOUT*. 
* 
 TXMOUT0  BSS    0           IF NOTHING OUTPUT
          SX6    X2          ORIGINAL VALUE OF *MOUTLOC*
          SA6    A1          RESET IT 
 
 TXMOUT   PS                 ENTRY/EXIT 
          SA1    MOUTLOC     GET CURRENT *MOUT* INDEX 
          SA2    TXMHDR      GET INDEX TO HEADER IN *MOUT*
          IX6    X1-X2       NUMBER OF WORDS WE'7VE OUTPUT
          SX6    X6-1        MINUS ONE WORD FOR THE HEADER
          ZR     X6,TXMOUT0  -- NOTHING OUTPUT YET
          LX6    1           NUMBER OF WORDS OUTPUT * 2 
          BX1    X6 
          LX1    2           (NWORDS*2)*4 = (NWORDS*8)
          IX6    X1+X6       (*8)+(*2) = NUMBER OF CHARS
          SX1    WRSCODE     MOUT CMND = WRITE, STD FONT
          LX6    24D         SHIFT NCHARS TO PARAM FIELD
          BX6    X1+X6       MERGE NCHARS AND WRSCODE 
          SA6    X2+MOUT     WRITE HEADER TO *MOUT* 
          EQ     TXMOUT      -- EXIT
* 
* 
* /---   BLOCK      TEXTN TABL 00 000   77/07/20  13.06 
* 
*  TABLE FOR TEXTN COMMAND
* FIRST 6 CHARS = BORDER RETURN AND LINE NUMBER 
* NEXT  2 CHARS = MONTH/DAY CHARACTERS (LEADING 0)
* NEXT  2 CHARS = YEAR SINCE 1973 (5 BITS, GOES TO 2004)
* 
          ENTRY  SHLN0       USED IN FILE *FILEX* 
 SHLN0    DATA   76655555555533334236B    ACCESS-ASSIGN-4SP 
          DATA   76655534555533344237B    ACCESS-ASSIGN-NUM1-NUM2-SP-SP 
          DATA   76655535555533354240B
          DATA   76655536555533364241B
          DATA   76655537555533374242B
          DATA   76655540555533404243B
          DATA   76655541555533414244B
          DATA   76655542555533424333B
          DATA   76655543555533434334B
          DATA   76655544555533444335B
          DATA   76653433555534334336B     10 -- 1983 
          DATA   76653434555534344337B
          DATA   76653435555534354340B
          DATA   76653436555534364341B
          DATA   76653437555534374342B
          DATA   76653440555534404343B
          DATA   76653441555534414344B
          DATA   76653442555534424433B
          DATA   76653443555534434434B
          DATA   76653444555534444435B
          DATA   76653533555535334436B     20 -- 1993 
          DATA   76653534555535344437B
          DATA   76653535555535354440B
          DATA   76653536555535364441B
          DATA   76653537555535374442B
          DATA   76653540555535404443B
          DATA   76653541555535414444B        1999
          DATA   76653542555535423333B        2000
          DATA   76653543555535433334B
          DATA   76653544555535443335B
          DATA   76653633555536333336B     30 -- 2003 
          DATA   76653634555536343337B     31 -- 2004 
* 
* /---   BLOCK      GETARGS    00 000   78/03/03  02.41 
* 
*         -GETARGS- 
* 
*         ROUTINE TO UNPACK ALL GETVAR CODES FOR A
*         COMMAND INTO *VARBUF* FOR COMMANDS WHICH
*         USE ROUTINE *MRKLAST* TO MARK OFF THE LAST
*         GETVAR CODE OF A VARIABLE-ARGUMENT COMMAND
* 
*         ON ENTRY'; X6 = MAXIMUM NUMBER DESIRED
*                   X5 = COMMAND WORD 
*         ON EXIT '; X6 = NUMBER OF ARGUMENTS FOUND 
* 
* 
          ENTRY  GETARGS
* 
 GETARGS  EQ     *
          SB3    X6          B3 = NUMBER OF ARGS TO GET 
          SB1    1           B1 = 1 
          BX6    X5 
          SB2    B0          B2 = CURRENT VARBUF BIAS 
          NG     X6,MRKFND   IF NEGATIVE THEN MARK IS FOUND 
          SA6    VARBUF      STORE WITH 1ST VAR CODE LJUST
          SB2    B1          BIAS = 1 
          LX6    XCODEL 
          NG     X6,MRKFND   IF NEGATIVE THEN MARK IS FOUND 
          SA6    VARBUF+1    STORE WITH 2ND VAR CODE LJUST
          SB2    B2+B1       BIAS = 2 
          LX6    60-XCMNDL-XCODEL 
          MX0    2*XCODEL+XCMNDL
          BX6    -X0*X6      X6 = EXTRA STORAGE POINTER 
          SA1    B5+X6       X1 = 1ST WORD OF EXTRA STORAGE 
 GETARG1  BX6    X1 
          NG     X6,MRKFND   IF NEGATIVE THEN MARK IS FOUND 
          SA6    VARBUF+B2
          SB2    B2+B1       NEXT ARGUMENT
          LX6    XCODEL 
          NG     X6,MRKFND   IF NEGATIVE THEN MARK IS FOUND 
          SA6    VARBUF+B2
          SB2    B2+B1       NEXT ARGUMENT
          LX6    XCODEL 
          NG     X6,MRKFND   IF NEGATIVE THEN MARK IS FOUND 
          SA6    VARBUF+B2
          SB2    B2+B1       NEXT ARGUMENT
          SA1    A1+B1       X1 = NEXT EXTRA STORAGE WORD 
          LT     B2,B3,GETARG1  LOOP IF MORE TO GO... 
 MRKFND   MX0    1           FORM SIGN BIT MASK 
          BX6    -X0*X6      MASK TOP BIT OFF GETVAR CODE 
          SA6    VARBUF+B2   STORE THE UNMARKED CODE
          SX6    B2+B1       CURRENT COUNT OF ARGUMENTS 
          EQ     GETARGS
* 
* /---   BLOCK      WORDS      00 000   80/07/19  22.18 
*** 
*** NEW BOUNDS ROUTINES THAT USE X1 AS LENGTH PARAMETER 
*** 
*** 
          TITLE  BOUNDS CHECKERS
* 
*         WORDS (PERFORMS BOUNDS CHECK USING CHAR COUNT)
* 
*         ON ENTRY--
*            A0 = INITIAL ADDRESS 
*            X1 = CHARACTER POSITION OR COUNT 
*         ON EXIT-- 
*            B1 = ADDRESS OF LAST WORD + 1
*            A2,B2,X0,X2 ARE DESTROYED
*            ** WARNING **  MOVE COMMAND USES THE CURRENT 
*               VALUE OF X0 RETURNED (N-1)(1/10)
* 
          ENTRY  WORDS
* 
 WORDS    EQ     *
          NG     X1,ERXPOS   --- IF NEGATIVE POSITION/COUNT 
          ZR     X1,ERXPOS   --- IF ZERO POSITION/COUNT 
          SB1    X1 
          AX1    18          CHECK FOR LENGTH > 18 BITS 
          NZ     X1,BOUERR0  RECONSTRUCT X1 FOR EXECERR 
          SX0    B1-1        X0 = NCHARS-1
          SA2    TENTH       TO GET (N-1)/10
          PX0    X0 
          FX0    X0*X2       X0=(N-1)*(1/10) AND SOME GARBAGE EXPONENT
          SX1    X0+1        ADD 1 FOR CORRECT LENGTH 
          SX2    B1          SAVE ORIGINAL X1 
          RJ     BOUNDS      CHECK ADDRESS BOUNDS 
          BX1    X2          RESTORE X1 
          EQ     WORDS
* /---   BLOCK      BOUNDS     00 000   79/02/09  12.13 
* 
*         BOUNDS (CHECKS BOUNDS USING LENGTH IN WORDS)
* 
*         ON ENTRY--
*            A0 = INITIAL ADDRESS 
*            X1 = LENGTH (IN WORDS) 
*         ON EXIT-- 
*            B1 = FINAL ADDRESS + 1 
*            B2,B3,B4 ARE DESTROYED 
* 
*            A0 DETERMINES WHETHER STUDENT OR COMMON. 
*         NOTE THAT TUTOR WILL INSURE THAT A0 IS IN 
*         BOUNDS, BUT WITH A LONG LENGTH A USER CAN 
*         PRODUCE AN END ADDRESS WHICH IS NEGATIVE. 
* 
          ENTRY  BOUNDS 
* 
 BOUNDS   EQ     *
          NG     X1,ERXBADL  --- ERROR IF NEGATIVE LENGTH 
          SB1    X1 
          NG     B1,ERXBADL  --- ERROR IF NEGATIVE LENGTH 
          AX1    18          CHECK FOR LENGTH > 18 BITS 
          NZ     X1,BOUERR0 
          SX1    B1          RESTORE X1 
* 
          SB2    NCVRBUF     STARTING ADDR FOR NC VARS
          SB1    A0+B1       B1 = 1ST ADDRESS AFTER END 
          SB2    A0-B2       CHECK STUDENT, ROUTER OR COMMON
          NG     B1,BOUERR1  --- ERROR IF BAD ADDRESS 
          PL     B2,CBOUND   COMMON VARS ARE AFTER LOCALS 
          SB2    LVARBUF
          SB2    A0-B2       CHECK IF LOCAL VARIABLES 
          PL     B2,LBOUND   LOCAL VARS ARE AFTER ROUTER
          SB2    RVARBUF
          SB2    A0-B2       CHECK FOR STUDENT OR ROUTER
          PL     B2,RBOUND   ROUTER VARS ARE AFTER STUDENT
          SB2    STUDVAR
          SB2    A0-B2       CHECK IF STUDENT 
          NG     B2,BOUERR2  --- ERROR IF NOT STUDENT 
* 
*         'STUDENT VARIABLE BOUNDS CHECKING 
          SB2    STUDVAR+VARLIM 
          LE     B1,B2,BOUNDS 
* 
          SB2    STUDVAR
          SX3    VARLIM      MAXIMUM LIMIT OF VARIABLES 
          SA4    =7LSTUDENT 
          EQ     BOUERR      --- ERROR EXIT IF OUT-OF-BOUNDS
* 
 RBOUND   SB2    RVARBUF+RVARLIM
          LE     B1,B2,BOUNDS 
* 
          SB2    RVARBUF
          SX3    RVARLIM     MAXIMUM LIMIT OF VARIABLES 
          SA4    =6LROUTER
          EQ     BOUERR      --- ERROR EXIT IF OUT-OF-BOUNDS
* 
 LBOUND   SB3    X1          SAVE X1
          SB4    A1          SAVE A1
          SA1    LVUCNT      X1 = NUM LV IN THIS UNIT 
          SB2    X1+LVARBUF  B2 = ADDR OF WORD AFTER LVARS
          SA1    B4          RESTORE A1 
          SX1    B3          RESTORE X1 
          LE     B1,B2,BOUNDS 
* 
          SB2    LVARBUF
          SA3    LVUCNT      X3 = LVARS IN THIS UNIT
          SA4    =5LLOCAL 
          EQ     BOUERR      --- ERROR EXIT IF OUT-OF-BOUNDS
* 
 CBOUND   SB2    NCVRBUF+NCVRLIM
          LE     B1,B2,BOUNDS 
* 
          SB2    NCVRBUF     STARTING ADDR FOR NC VARS
          SX3    NCVRLIM     MAX LIMIT OF CM COMMON 
          SA4    =5LNC/VC 
* /---   BLOCK      BOUNDS     00 000   80/03/23  04.46 
 BOUERR   SX1    A0-B2       STARTING LOCATION
          SX1    X1+1        START AT N1, NOT N0
          SB2    A0 
          SX2    B1-B2       LENGTH 
          EXECERR 52
* 
 BOUERR2  SX1    B2 
          EQ     ERXINDL     INDEX TOO LOW
 BOUERR1  SX1    B1 
          EQ     ERXINDL     INDEX TOO LOW
* 
 BOUERR0  LX1    18          RECONSTRUCT X1 
          SX2    B1          BOTTOM 18 BITS 
          BX1    X1+X2       MERGE
          EQ     ERXBADL
* /---   BLOCK      JUDGE      00 000   78/07/18  14.43 
          TITLE  JUDGE AND JUDGE* 
*         -JUDGE-  (CODE=70)
* 
*            'MODIFIES JUDGMENT OR CONDITIONS OF JUDGING. 
*         'THE TOP *XJDGL* BITS OF THE COMMAND WORD HOLD THE
*         NUMBER OF THE JUDGE TYPE.  'THE FOLLOWING TAGS ARE
*         CURRENTLY PERMITTED-- 
*            OK 
*            WRONG
*            NO 
*            CONTINUE 
*            IGNORE 
*            EXIT 
*            REJUDGE
*            X
*            OKQUIT 
*            NOQUIT 
*            QUIT 
* 
* 
 JUDGECX  CALL   GETTAG      CONDITIONAL JUDGE...GET TAG
 JUDGEX   SA1    TBITS       DO NOT ALLOW -JUDGE- IN ERASE-UNIT-CONTNGY 
          LX1    ERSUBIT
          NG     X1,JERXERU  --- EXECUTION ERROR IF SO
          LX5    XJDGL
          MX0    -XJDGL 
          BX5    -X0*X5      EXTRACT CODE 
          SB2    X5 
          JP     JXTAB+B2    JUMP THROUGH TABLE TO PROPER ROUTINE 
* 
 JXTAB    EQ     JOKX        0  OK
          EQ     JWRONGX     1  NO (SPECIFIC) 
          EQ     JNOX        2  NO (UNIVERSAL)
          EQ     JCONTX      3  CONTINUE
          EQ     JIGNRX      4  IGNORE
          EQ     JEXITX      5  EXIT
          EQ     PJUDGOO     6  REJUDGE 
          EQ     PROCESS     7  X 
          EQ     JOKQ        8  OKQUIT
          EQ     JNOQ        9  NOQUIT
          EQ     JQUIT       10 QUIT
* 
* 
 JOKX     SX6    -1          SET JUDGMENT=OK
          SA6    TJUDGED
          SA6    TANSOK      SET ANSOK TRUE 
          EQ     PROCESS
* 
 JWRONGX  SX6    0           SET JUDGMENT=NO (SPECIFIC) 
          SA6    TJUDGED
          SA6    TANSOK      SET ANSOK FALSE
          SA6    JJSBUFA     KILL ANY JUDGEMENT ON WORDS
          EQ     PROCESS
* 
 JNOX     SX6    1           SET JUDGMENT=NO (UNIVERSAL)
          SA6    TJUDGED
          SX6    0
          SA6    TANSOK      SET ANSOK FALSE
          SA6    JJSBUFA     KILL ANY JUDGEMENT ON WORDS
          EQ     PROCESS
* 
 JCONTX   SB7    XJUDGEC     SWITCH TO JUDGE-C LEAVING BUFFERS INTACT 
          SX7    -1 
          SA7    JJSTORE     FLAG NO COMPILED CODE
          EQ     PROCESS
* 
 JERXERU  EXECERR 90         -JUDGE- NOT ALLOWED IN ERASEU
* /---   BLOCK      JIGNRX     00 000   78/11/08  20.44 
* 
* 
          ENTRY  JIGNRX      USED BY IGNORE COMMAND 
* 
 JIGNRX   CALL   ARESET      RESTORE ARROW SIZE AND ROTATE
          SA1    TBITS
          LX1    JUDGBIT
          NG     X1,JOVER    --- EXIT IF JARROW TYPE JUDGING
          SB7    XJUDGEC     SET TO JUDGE CONTINGENCY 
          SX6    0
          SA6    TJUDGED     SPECIFIC -NO-
*** FOLLOWING LINE ADDED 3/15/76--'R'W'B
          SA6    TBANSWT     MARK NO ANS-C WRITING (HELPOPS)
          CALL   ANSDAT 
          SA1    RSIZE
          NZ     X1,JJ1      IF NOT SIZE 0
*         *TBPAUSE* = NEGATIVE IF PAUSE ENCOUNTERED 
*                   = *MOUTLOC* OF OK/NO IF NO PAUSE
          SA1    TBPAUSE     SEE IF PASSED THROUGH A PAUSE
          NG     X1,JJ1 
          ZR     X1,JJ1 
          SA1    LONG        SEE IF JUDGING FORCED
          SA2    LIMIT
          IX3    X1-X2
          NG     X3,JJ1 
          SX3    X2-1 
          NZ     X3,JJ1      EXIT IF NOT LONG 1 
          SX3    X1-3 
          PL     X3,JJ1      EXIT IF MORE THAN 2 CHARS
          SA3    INHIBS 
          LX3    FNTSHIF     CHECK FOR -FORCE FONT- 
          NG     X3,JJ1 
          SA3    KEY
          SX3    X3-FUNKEY   CHECK IF REALLY A LETTER 
          PL     X3,JJ1      (FOR JUDGE EXIT CASES) 
          SA2    INHIBS 
          LX2    FTESHIF     SEE IF FORCE FIRSTERASE IN OPERATION 
          NG     X2,JJ1 
          MX6    0           CLEAR OUT -MOUT- 
          SA6    MOUT        CLEAR  -AT-
          SA6    MOUT+1      CLEAR DIRECTION
          SA6    MOUT+2 
          SA6    MOUT+3 
          SA6    MOUT+4 
          SA6    MOUT+5 
          SA6    MOUT+6 
          SA6    A1          ALSO ZERO -LONG- 
          EQ     EXIT 
* 
 JJ1      SA1    RSIZE
          NZ     X1,JJ2      IF NOT SIZE 0
          RJ     WIPE 
          EQ     EXIT 
* 
 JJ2      RJ     LWIPE
          EQ     EXIT 
* /---   BLOCK      JEXITX     00 000   78/11/08  20.47 
* 
*  NOTE--THE CODE FOR -JUDGE EXIT- IS ALSO JUMPED TO AT THE 
*  END OF -HELPOP- UNITS (AT ARROWS) AND -ERASEU- UNITS, SO 
*  ANY CHANGES TO -JUDGE EXIT- WILL ALSO AFFECT -HELPOP-S 
*  AND -ERASEU-S
* 
          ENTRY  JEXITX 
* 
 JEXITX   CALL   ARESET      RESTORE ARROW SIZE AND ROTATE
          SA1    TBITS
          LX1    JUDGBIT
          NG     X1,JOVER    --- EXIT IF JARROW TYPE JUDGING
          SB7    XJUDGEC     SWITCH TO JUDGE-C
          CALL   SETLC       SET SCREEN LOC TO LAST CHAR
          CALL   ANSDAT 
          EQ     EXIT        AND EXIT LEAVING ANS INTACT
* 
* 
 JOKQ     SX6    -1          OKQUIT 
          SA6    TJUDGED
          SA6    TANSOK 
          EQ     ANSMARK
* 
 JNOQ     SX6    1           NOQUIT 
          SA6    TJUDGED
          MX6    0
          SA6    TANSOK 
          EQ     ANSMARK
* 
 JQUIT    MX6    1           SET UP -QUIT- BIT
          LX6    -QUITBIT 
          SA1    TBITS
          BX6    X1+X6       SET -QUIT- BIT 
          SA6    A1 
          EQ     ANSMARK
* /---   BLOCK      LANG       00 000   79/08/13  08.09 
          TITLE  LANG 
*         -LANG- COMMAND
*         SETS -ZLANG- FOR APPROPRIATE LANGUAGE 
* 
 LANGXC   CALL   GETTAG      CONDITIONAL -LANG- 
 LANGX    NG     X5,PROCESS  SKIP IF X-OPTION 
          LX5    1           ADJUST FOR 1 BIT LESS THEN NORM
          MX2    LANGBTN     LANGUAGE BITS FIELD LENGTH 
          BX6    X5*X2       CLEAR OFF OTHER BITS 
          LX2    LANGBTS     MOVE BITS TO RIGHT PLACE 
          LX6    LANGBTS
          SA1    STFLAG1     GET FLAG WORD
          BX1    -X2*X1      CLEAR OUT OLD LANG SETTING 
          BX6    X6+X1       PUT IN NEW LANG SETTING
          SA6    A1          STORE
          EQ     PROCESS     ON TO NEXT COMMAND 
* 
* 
*       GETTAG IS USED FOR GETTING THE SPECIFIC VALUE 
*       FOR THE CONDITIONAL COMMANDS... 
*                LANG,SAYLANG,MODE,JUDGE,LESSON 
* 
* 
 GETTAG   EQ     *
* 
          NGETVAR            EVALUATE CONDITION 
*                            ROUNDS TO INTEGER IN -X1-
* 
* 
          PL     X1,GETTAG1 
          ZR     X1,GETTAG1  TREAT -0 AS +0 
          SX1    -1          IF NEGATIVE, MAKE -1 
 GETTAG1  SX0    1
          IX1    X1+X0       ADJUST VALUE TO RANGE FROM 0 TO N-1
          SA5    A5          RETRIEVE COMMAND WORD
          MX0    48          X0 = MASK TO LIMIT INFO TO 12 BITS 
          AX5    XCMNDL 
          BX2    -X0*X5      X2 = NUMBER OF ENTRIES IN TABLE
          AX5    12 
          BX3    -X0*X5      X3 = RELATIVE START OF TABLE 
          SB2    B5+X3       B2 = ABSOLUTE START OF TABLE 
          IX3    X1-X2       SEE IF NUMBER IN BOUNDS
          NG     X3,GETTAG2  JUMP IF OK 
          SX1    X2-1        ELSE SET FOR LAST ENTRY
 GETTAG2  SB1    1           B1 = CONSTANT 1
          SX2    XJDGL
          DX1    X1*X2       X1= TOTAL SHIFT COUNT REQUIRED 
          SB2    B2-B1       DECREMENT BEFORE STARTING LOOP 
          SX2    60 
 GETTAG3  IX1    X1-X2
          SB2    B2+B1       ADVANCE WORD ADDRESS 
          PL     X1,GETTAG3  JUMP IF NOT IN THIS WORD 
          IX1    X1+X2       RESTORE FINAL SHIFT COUNT
          SA3    B2          X3 = WORD HOLDING CODE 
          SB2    X1          B2 = SHIFT COUNT 
          LX5    X3,B2       POSITION PROPER CODE AT TOP
          EQ     GETTAG      RETURN 
* /---   BLOCK      NEXTNOW    00 000   79/05/05  22.49 
          TITLE  NEXTNOW
* 
*     'N'E'W -- INCLUDES CORRECTION TO FIX NEXTNOW/TIMEL
*            INTERACTION PROBLEM
* 
 
* 
* 
*         -NEXTNOW- (CODE=73,74*) 
* 
 NXTLKCX  RJ     CUNIT       GET CONDITIONAL UNIT 
 NXTLKX   AX5    48          NEXTNOW UNIT NUMBER
          SA1    ILESUN      LOAD PRESENT LESSON AND UNIT POINTERS
          MX0    42 
          BX1    X0*X1       LESSON NUMBER
          BX6    X1+X5       COMBINE
          SA6    TNEXT       STORE IN NEXT UNIT POINTER 
* 
*         SAVE CURRENT LESSON/UNIT/COMMAND POINTER FOR
*         RE-EXECUTION FOLLOWING A -TIMEL- BRANCH THAT
*         MIGHT BREAK THROUGH THE -NEXTNOW-.
* 
          RJ     JLPACK 
          SA6    AJOIN+JOINLTH  SAVE IN ARROW JSTACK SO IT
*                               IS COPIED CORRECTLY 
* 
          SX1    B7-XANSC    SEE WHAT CONTINGENCY NOW IN
          SB7    XNEXTLK     SET TO NEXT-NOW-C
          NZ     X1,EXIT     EXIT IF NOT IN ANS-C 
          MX7    0
          SA7    TSPLOC      CLEAR SPECS POINTER
          EQ     ANSMARK     IF IN ANS-C GO ON TO MARK UP ANSWER
* /---   BLOCK      KEY BRANCH 00 000   76/07/02  23.18 
          TITLE  KEY BRANCHING COMMANDS 
* 
 NEXTCX   RJ     CUNIT       GET CONDITIONAL UNIT 
 NEXTX    SB1    TNEXT       SET NEXT KEY BRANCH
          EQ     TSTUFF 
* 
 NEXT1CX  RJ     CUNIT
 NEXT1X   SB1    TNEXT1      SET NEXT1 KEY BRANCH 
          EQ     TSTUFF 
* 
 BACKCX   RJ     CUNIT
 BACKX    SB1    TBACK       SET BACK KEY BRANCH
          EQ     TSTUFF 
* 
 BACK1CX  RJ     CUNIT
 BACK1X   SB1    TBACK1      SET BACK1 KEY BRANCH 
          EQ     TSTUFF 
* 
 STOPCX   RJ     CUNIT
 STOPX    SB1    TSTOP       SET STOP KEY BRANCH
          EQ     TSTUFF 
* 
 STOP1CX  RJ     CUNIT
 STOP1X   SB1    TSTOP1      SET STOP1 KEY BRANCH 
          EQ     TSTUFF 
* 
* 
 HELPCX   RJ     CUNIT
 HELPX    SB1    THELP       SET HELP KEY BRANCH
          EQ     TSTUFF 
* 
 HELP1CX  RJ     CUNIT
 HELP1X   SB1    THELP1      SET HELP1 KEY BRANCH 
          EQ     TSTUFF 
* 
 LABCX    RJ     CUNIT
 LABX     SB1    TLAB        SET LAB KEY BRANCH 
          EQ     TSTUFF 
* 
 LAB1CX   RJ     CUNIT
 LAB1X    SB1    TLAB1       SET LAB1 KEY BRANCH
          EQ     TSTUFF 
* 
 DATACX   RJ     CUNIT
 DATAX    SB1    TDATA       SET DATA KEY BRANCH
          EQ     TSTUFF 
* 
 DATA1CX  RJ     CUNIT
 DATA1X   SB1    TDATA1      SET DATA1 KEY BRANCH 
          EQ     TSTUFF 
* 
* 
 BASECX   RJ     CUNIT
 BASEX    SB1    TBASE       SET BASE UNIT
          EQ     TSTUFF 
* 
* 
 FINISCX  RJ     CUNIT
 FINISHX  SB1    TFINISH     SET FINISH UNIT
          EQ     TSTUFF 
* 
* 
 IMAINCX  RJ     CUNIT
 IMAINX   SB1    TIMAIN 
          EQ     TSTUFF 
* 
 IARROCX  RJ     CUNIT
 IARROWX  SB1    TIARROW
          EQ     TSTUFF 
* 
 IARROCAX RJ     CUNIT
 IARROWAX SB1    TIARROWA 
          EQ     TSTUFF 
* 
 EARROCX  RJ     CUNIT
 EARROWX  SB1    TEARROW
          EQ     TSTUFF 
* 
* 
 ERASUCX  RJ     CUNIT
 ERASUX   SB1    TERASE 
          EQ     TSTUFF 
* /---   BLOCK      KEY BRANCH 00 000   78/02/17  13.47 
* 
* 
 HELPOCX  RJ     CUNIT
 HELPOPX  SB1    THELP
          EQ     TSTUFF1
* 
 HLP1OCX  RJ     CUNIT
 HELP1OX  SB1    THELP1 
          EQ     TSTUFF1
* 
* 
 LABOPCX  RJ     CUNIT
 LABOPX   SB1    TLAB 
          EQ     TSTUFF1
* 
 LAB1OCX  RJ     CUNIT
 LAB1OPX  SB1    TLAB1
          EQ     TSTUFF1
* 
* 
 DATAOCX  RJ     CUNIT
 DATAOPX  SB1    TDATA
          EQ     TSTUFF1
* 
 DAT1OCX  RJ     CUNIT
 DATA1OX  SB1    TDATA1 
          EQ     TSTUFF1
* 
* 
 NEXTOCX  RJ     CUNIT
 NEXTOPX  SB1    TNEXT
          EQ     TSTUFF1
* 
 NXT1OCX  RJ     CUNIT
 NEXT1OX  SB1    TNEXT1 
          EQ     TSTUFF1
* 
* 
 BACKOCX  RJ     CUNIT
 BACKOPX  SB1    TBACK
          EQ     TSTUFF1
* 
 BCK1OCX  RJ     CUNIT
 BACK1OX  SB1    TBACK1 
          EQ     TSTUFF1
* 
 IFERRCX  RJ     CUNIT       IFERROR COMMAND
 IFERRX   SB1    ERRUNIT
          EQ     TSTUFF 
* 
* 
* 
 TSTUFF1  MX0    1           SET ON-PAGE UNIT BIT 
          EQ     TSTUFF2
* 
 TSTUFF   MX0    0           NOT ON-PAGE UNIT 
          EQ     TSTUFF2
* 
 TSTUFF2  AX5    48          POINTER UNIT NUMBER
          ZR     X5,TBZERO   CLEAR POINTER IF UNIT 0
          NG     X5,TBZERO   NO SPECIAL UNITS HERE
          BX5    X0+X5
          MX0    42 
          SA1    ILESUN      LOAD PRESENT LESSON AND UNIT POINTERS
          BX1    X0*X1       LESSON NUMBER
          BX6    X1+X5       COMBINE
          SA6    B1          AND STORE IN SPECIFIED WORD
* 
          BX1    X5 
          CALL   UEXIST      SEE IF UNIT REALLY EXISTS
          NG     X6,PROC
* 
 TBZERO   MX6    0           CLEAR POINTER
          SA6    B1          STORE
          EQ     PROC        --- RETURN 
* /---   BLOCK      ANSWERC    00 000   76/10/12  17.29 
          TITLE  ANSWERC/WRONGC 
* 
 ANSCXX   NGETVAR            OBTAINS CONDITION AND ROUNDS TO INTEGER
          PL     X1,ASC1     CLEAR UP NEGATIVE OUT OF BOUNDS
          ZR     X1,ASC1     TREAT -0 AS +0 
          SX1    -1          MAKE ALL NEGATIVES -1
 ASC1     SX0    1
          IX1    X1+X0       MAKE RANGE GO FROM 0 TO N+1
          MX0    48 
          SA5    A5          MAKE SURE HAVE COMMAND WORD
          AX5    12 
          BX2    -X0*X5      GET NUMBER OF ENTRIES IN TABLE 
          AX5    12 
          BX3    -X0*X5      GET RELATIVE START OF TABLE
          SB2    B5+X3       ABSOLUTE START OF TABLE
          IX3    X1-X2       SEE IF MAXIMUM NUMBER IN BOUNDS
          NG     X3,ANSC2 
          SX1    X2-1        IF NOT, SET TO END OF TABLE
 ANSC2    SA1    B2+X1       GET TABLE ENTRY
          BX5    X1          MAKE LIKE ANSWER CASE
          PL     X5,ASC9     IF REAL, PROCESS LIKE ANSWER COMMAND 
*                            NEGATIVE FLAGS NULL CASE 
          SA3    TANSCNT     IF NULL, MUST INCREMENT ANSWER COMMAND 
          SX7    X3+1           COUNTER 
          SA7    A3 
          EQ     PROCESS     AND THEN EXIT
* 
 ASC9     X      NANSOV 
* 
* /---   BLOCK      SAY        00 000   78/07/18  22.32 
* 
 .SAYCMD  IFNE   SAYASSM,0
 NSAYX    SX6    2           -SAY-
 NSAYX1   SA1    TBNARGS
          LX1    51          POSITION LANGUAGE NUMBER LOWER 
          MX0    54 
          BX7    -X0*X1      EXTRACT LANGUAGE NUMBER
          ZR     X7,PROCESS  0 MEANS IGNORE 
          SA7    OVARG2      SAVE HERE FOR RETURN 
          SA1    MOUTLOC     SEE IF MOUT HAS 100 WORDS LEFT 
          SX1    X1-MOUTLTH+100 
          PL     X1,RETRNZ   END TIME SLICE (BACK UP A5)
          SA6    OVARG1 
          EXEC   EXEC8,PACKOV 
* 
 NSAYCX   SX6    3           -SAYC- 
          EQ     NSAYX1 
* 
* PACK ROUTINES RETURN HERE WITH OVARG1=CHAR COUNT, STRING
* STARTING AT INFO+0, ENDING WITH ZERO. 
 .SAYCMD  ENDIF 
          ENTRY  NSAYDO 
 .SAYCMD  IFNE   SAYASSM,0
 NSAYDO   SA1    OVARG2 
          SX2    X1-1 
          ZR     X2,NSAYWES  OVARG2=1 FOR WES (WORLD ENGLISH SPELLING)
          SX2    X1-2 
          ZR     X2,NSAYESP     =2 FOR ESPERANTO
          SX2    X1-3 
          ZR     X2,NSAYIPA     =3 FOR IPA
          SX2    X1-4 
          ZR     X2,NSAYSP      =4 FOR SPANISH
          EQ     PROCESS     **ADD MORE LANGUAGES HERE**
 NSAYWES  EXEC   SAYX,WSAYOV
 NSAYESP  EXEC   SAYX,ESAYOV
 NSAYIPA  EXEC   SAYX,IPSAYOV 
 NSAYSP   EXEC   SAYX,SSAYOV
* 
*PT  78/7/17
* SAYLX    AX5    2*XCODEL    GET LANGUAGE NUMBER (<64) 
*PT 
 SAYLXC   CALL   GETTAG      CONDITIONAL CASE 
 SAYLX    NG     X5,PROCESS  SEE IF -X- OPTION
          MX0    XJDGL
          BX5    X0*X5       CLEAR OFF OTHER BITS 
          LX5    XJDGL
*PT 
          SA1    TBNARGS
          LX1    51          POSITION LANGUAGE NUMBER LOWER 
          MX0    54 
          BX6    X0*X1       DELETE OLD NUMBER
          BX6    X6+X5       INSERT NEW NUMBER
          LX6    9           REPOSITION 
          SA6    A1 
 .SAYCMD  ELSE
 NSAYX    BSS    0
 NSAYCX   BSS    0
 NSAYDO   BSS    0
 SAYLXC   BSS    0
 SAYLX    BSS    0
 .SAYCMD  ENDIF 
          EQ     PROCESS
* /---   BLOCK      OVERLAYS   00 000   80/02/10  05.10 
* 
*         -INITIAL*-
* 
 INIT1X   SX6    1
          SX1    INITXOV
          EQ     PROCOV1
* 
*         -PUT-  -PUTV- 
* 
 PUTX     MX6    0
 PUTX1    SX1    PUTOV
          EQ     PROCOV1
* 
 PUTVX    SX6    1
          EQ     PUTX1
* 
*         -SEARCH-
* 
 SEARCHX  MX6    0           MARK FIRST CALL TO OVERLAY 
 SEARCH1  SA6    OVARG1 
          X      SEARCHO
          CALL   TFIN        INTERUPT 
          MX6    -1          MARK NOT FIRST CALL
          EQ     SEARCH1
* 
*         -SORTA-  -SORT- 
* 
*         RETURN TO -TEKTRON- COMMAND AFTER INTERRUPT 
* 
          ENTRY  TEKBRK 
 TEKBRK   CALL   TFIN 
          SX1    TEKTROV
          SX6    1           VALUE FOR *OVARG1* 
          EQ     PROCOV1
* 
 SORTAX   MX6    0           -SORTA-
          EQ     SORT1
* 
 SORTX    SX6    1           -SORT- 
 SORT1    SA6    OVARG1 
          X      SORTOV 
          CALL   TFIN        INTERRUPT
          SX6    2
          EQ     SORT1
* 
*         RETURN TO -LLFIND- OVERLAY AFTER INTERRUPT
* 
          ENTRY  LLFBRK 
 LLFBRK   CALL   TFIN 
          SX1    LLFIND 
          EQ     PROCOV1
* 
*         -COMPUTE-  (LEVEL 1 OVERLAY)
*         -SETSITE-  (LEVEL 1 OVERLAY)
*         -MATCH- 
*         -ANSWER-
*         -CONTAIN- 
*         -CANT-
*         -DISCARD- 
* 
 COMPUTX  X      COMPTOV
* 
 SETSITX  X      SETSIOV
* 
 XMATCHX  SX1    NMATOV 
          EQ     PROCOV1
* 
 XANSX    SX1    NANSOV 
          EQ     PROCOV1
* 
 XANSAX   SX1    ANSAOV 
          EQ     PROCOV1
* 
*         -MARKUP-
* 
 MARKUPX  SA1    TBERRMK     ONLY NEGATIVE MEANS HOLDMARK 
          NG     X1,MARKXXX 
          SA1    TSPECS      OTHERWISE, CLEAR -SPECS HOLDMARK- BIT
          MX6    1           SO MARKUP APPEARS NORMALLY...THE 
          LX6    60-HOLDMK     MARKUP COMMAND OVER-RIDES ANY
          BX6    -X6*X1        -SPECS HOLDMARK- ENCOUNTERED 
          SA6    A1 
          EQ     PROCESS
* 
 MARKXXX  SX1    MARKUP      DELAYED MARKUP OF ANSWER 
          EQ     PROCOV1
* 
*         -TOUCH(W)-
* 
 TOUCHX   SX1    TOUCHOV
          EQ     PROCOV1
*///
* 
*         -SUBMITM- 
* 
* /---   BLOCK      OVERLAYS   00 000   81/04/30  21.55 
 SUBXX    SX6    1                 -SUBMITX-
          SA6    OVARG1 
 SUBX10   X      SUBTMOV
          CALL   XSTOR,SBXNAM,BLKLTH    ALLOCATE ECS
          EQ     SUBX10 
* 
* 
*         -NOBREAK- 
* 
 NBREAKX  X      INTLOKV,2
* 
* 
* *       -RECORDS RESTORE- 
* 
          ENTRY  RESTREC
          EXT    AREAOUT
 RESTREC  CALL   AREAOUT
          SA5    A5          RESTORE CURRENT COMMAND WORD 
          X      RECORDS,1   FINISH -RECORDS RESTORE- 
* 
*         VARIOUS GRAPHING COMMANDS 
* 
*         -AXES-  (FINE GRID) 
*         -BOUNDS-  (FINE GRID) 
* 
 AXESXF   SX6    3
          EQ     BOUND1 
* 
 BOUNDXF  SX6    24 
 BOUND1   SX1    GRAFSOV
          EQ     PROCOV1
* 
*         INTERRUPT ROUTINES FOR GRAPHING OVERLAYS
* 
          ENTRY  GRAFINT
          ENTRY  LABLINT
          ENTRY  BARINT 
 
 GRAFINT  RJ     TFIN        FUNCT INTERRUPT
          SX6    23 
          EQ     BOUND1 
* 
* 
 LABLINT  RJ     TFIN        LABEL INTERRUPT
          SX6    25 
          EQ     BOUND1 
* 
* 
 BARINT   RJ     TFIN        BAR INTERRUPT
          SX6    1
          SX1    GRAF2OV
          EQ     PROCOV1
* 
* 
* /---   BLOCK      PPTX1      00 000   77/09/15  20.04 
          TITLE  PLATO PROGRAMMABLE TERMINAL COMMANDS 
* 
*         VARIOUS PPT-RELATED COMMANDS
* 
 PPTA     SA6    OVARG1 
          X      PPT1OV 
          CALL   TFIN        INTERRUPT PROCESSING 
          BX6    X1          PASS X1 AS AN ARGUMENT 
          SA6    OVARG2 
          MX6    0
          EQ     PPTA 
* 
 PPTADRX  SX6    1
          EQ     PPTA 
* 
 PPTDATX  SX6    2
          EQ     PPTA 
* 
 PPTRUNX  SX6    3
          EQ     PPTA 
* 
 EXTOUTX  SX6    4
          EQ     PPTA 
* 
 PPTOUTX  SX6    5
          EQ     PPTA 
* 
 PPTHLTX  SX6    6
          EQ     PPTA 
* /---   BLOCK      PPTX2      00 000   80/02/06  05.21 
* 
 PPTB     SA6    OVARG1 
          X      PPT2OV 
          CALL   TFIN        INTERRUPT PROCESSING 
 PPTRTNX  BX6    X1          PASS X1 AS AN ARGUMENT 
          SA6    OVARG2 
          MX6    0
          EQ     PPTB 
* 
 PPTLDX   SX6    1
          EQ     PPTB 
* 
 PPTTSTX  SX6    2
          EQ     PPTB 
* 
 PPTCLRX  SX6    3
          EQ     PPTB 
* 
* 
*         -ASMBIT-
*         SET FLAG TO MARK ASSEMBLY LANGUAGE PROGRAM MAY
*         HAVE BEEN EXECUTED - CAUSES -CLEAR- KEY TO ACT
*         AS -STOP1- KEY
* 
          ENTRY  ASMBIT 
 ASMBIT   EQ     *
          MX6    1
          LX6    ASMPBIT     POSITION ASSEMBLY PROG BIT 
          SA1    STFLAG1
          BX6    X1+X6       SET BIT IN STATION BANK
          SA6    A1 
          EQ     ASMBIT 
* 
**
* /---   BLOCK      LIBXXXX    00 000   82/06/28  10.43 
          TITLE  LIBCALL/LIBRET EXECUTION.
 
*         SET UP -SYSLIB- CALL.  UNIT NAME RETURNED 
*         IN (OVARG1).
 
 LIBCALX  X      LIBCALL     PROCESS COMMAND ARGUMENTS
          CALL   SYSLIB,OVARG1,-1 
          SX6    B1 
          SA6    TRETURN     STORE ERROR STATUS 
          EQ     =XPROCESS
 
 LIBRETX  X      LIBRET 
          EQ     PROCESS
 
 
          TITLE  LOADMX - LOAD ORIENTAL MODULE TO TERMINAL. 
**        LOADMX - LOAD ORIENTAL MODULE INTO TERMINAL.
* 
*         WORKS JUST LIKE *NTOSYS* IN DECK TUTORX.
* 
 
 LOADMX   CALL   SYSLIB,KLOADM,-1 
          EQ     =XRETRNX    FORCE TIME-SLICE AND EXIT
 
 KLOADM   DATA   5LLOADM
 
 
* 
*         -SUBMITX- BUFFER -- LESNAM TABLE ENTRY. 
* 
 SBXNAM   DATA   0           -SUBMITX- BUFFER NAME
          DATA   0LSUBMITX
+         VFD    60/6RBUFFER
+         VFD    12/1,48/0
* 
* /---   BLOCK      OUTPUT     00 000   79/04/23  10.06 
          SPACE  3
***       OUTARRX            OUTPUT ARROW 
* 
*         PLOTS THE ARROW FOR TUTOR LESSONS.
*         SHOULD NOT BE USED TO PLOT ARROWS FOR SYSTEM
*         CALLS (LIKE IN SYSLIB FOR TERM ETC.)
* 
          ENTRY  OUTARRX
 OUTARRX  EQ     *           ENTRY/EXIT 
          SA1    TBITS       CHECK ARROW/ARROWA 
          LX1    ARRTPBT
          SA3    ARRCHRS     GET ARROW
          SX2    5           PLOT 5 CHARS 
          PL     X1,OUTARRL  IF ARROW 
          LX3    30 
 OUTARRL  SA4    INHIBS 
          LX4    BLDSHIF     CHECK FOR BOLD 
          PL     X4,OUTARRM 
          MX4    30 
          BX3    X3*X4       CLEAN UP CHARS 
          SX4    KUP*100B+1R8 
          BX3    X3+X4
          LX3    -12
          SX2    7
 OUTARRM  SA4    MOUTLOC
          SX6    X4+2        INCREMENT OUTPUT POINTER 
          SA6    A4          NO OVERFLOW TESTS MADE 
          LX2    24          SHIFT COUNT UP 
          EQ     OUTARRX     -- EXIT
 
 
          SPACE  3
***       OUTNX              OUTPUT WITH TRUNCATION 
* 
*         IDENTICAL TO -OUTPUT- EXCEPT THAT IN
*         CASE OF OVERFLOW THE CODE IS SIMPLY 
*         NOT PUT INTO THE OUTPUT BUFFER (RATHER THAN 
*         BRANCHING TO AN ERROR EXIT) AND PROCESSING
*         CONTINUES.
* 
*            'USES REGISTERS X1,X2,X6 AND A2,A6.
* 
          ENTRY  OUTNX
 OUTNX    EQ     *           ENTRY/EXIT 
          SA2    MOUTLOC
          SX6    X2-MOUTLTH 
          PL     X6,OUTNX    -- RETURN
          SX6    X2+1 
          SA6    A2 
          MX6    36          SETS *MOUT* CHECK OK (NEG) 
          LX1    24 
          BX1    X1*X6
          EQ     OUTNX       -- EXIT
 
 
* /---   BLOCK      OUTPUT     00 000   79/04/23  10.06 
          SPACE  3
***       OUTPX              OUTPUT WITHOUT OVERFLOW CHECKS 
* 
*         IDENTICAL TO -OUTPUT- EXCEPT THAT NO
*         OVERFLOW CHECK IS MADE AND NO MASKING 
*         IS DONE FOR PROTECTION.  'FOR USE WHEN
*         EVERYTHING IS KNOWN TO BE OK. 
* 
*            'USES REGISTERS X1,X2,X6 AND A2,A6.
* 
          ENTRY  OUTPX
 OUTPX    EQ     *           ENTRY/EXIT 
          SA2    MOUTLOC
          SX6    X2+1 
          SA6    A2 
          LX1    24 
          EQ     OUTPX       -- EXIT
 
 
          SPACE  3
***       OUTPUTX            OUTPUT DATA TO FORMATTER 
* 
*            'EXPECTS X1 TO HOLD PARAMETER INFO TO COMBINE
*         WITH THE OUTPUT CODE -ARG- AND PUTS THE RESULTANT 
*         CODE INTO THE OUTPUT BUFFER *MOUT*. 
* 
*            'THE FOLLOWING REGISTERS ARE USED--
*         X1,X2,X6 AND A2,A6 (X1 IS SHIFTED UP 24 BITS
*         BY THIS ROUTINE). 
* 
          ENTRY  OUTPUTX
 OUTPUTX  EQ     *           ENTRY/EXIT 
          RJ     OUTCODX     SEND OUTPUT CODE 
          EQ     OUTPUTX     -- EXIT
 
 
          SPACE  3
***       OUTCODX            OUTPUT CODE TO FORMATTER 
* 
          ENTRY  OUTCODX
 OUTCODX  EQ     *           ENTRY/EXIT 
          SA2    MOUTLOC
          SX6    X2-MOUTLTH 
          PL     X6,=XERROROF 
          SX6    X2+1 
          SA6    A2 
          MX6    36 
          LX1    24 
          BX1    X1*X6
          EQ     OUTCODX      -- EXIT 
 
          SPACE  3
***       OUTPTWX            OUTPUT WORD TO FORMATTER 
* 
*         OUTPUT A WORD TO THE FORMATTER. 
* 
*         X2 HOLDS CHAR. COUNT TO OUTPUT (LESS THAN 11) 
*         X3 HOLDS CHARS TO OUTPUT (LEFT JUSTIFIED) 
* 
          ENTRY  OUTPTWX
 OUTPTWX  EQ     *           ENTRY/EXIT 
          SA4    MOUTLOC
          SX6    X4+2 
          SA6    A4 
          LX2    24 
          SX6    20000B+WRTCODE 
          BX6    X2+X6
          SA6    MOUT+X4
          BX6    X3 
          SA6    A6+1 
          EQ     OUTPTWX     -- EXIT
 
* /---   BLOCK      END        00 000   79/04/22  03.56 
          TITLE  SEND EXT CODES TO CLIENT SOFTWARE
***       CLIENT  -  SENDS EXT CODES TO CLIENT SOFTWARE 
* 
*         USES A - 1
*              B - 1,2
*              X - 0,1
* 
*         INPUT'; B1 = EXT CODE 
*                B2 = VALUE TO BE ADDED TO EXT
* 
* 
          ENTRY  CLIENT 
 CLIENT   EQ     *           ENTRY/EXIT 
          SA1    STFLAG1     GET TERMINAL INFO WORD 
          MX0    -TTBTN      SET MASK FOR TERM TYPE FIELD 
          LX1    TTBTN-TTBTS  POSITION TERM TYPE FIELD
          BX0    -X0*X1      GET TERM TYPE
          SX0    X0-ASCTYPE  SEE IF ASCII TERM (ZTTTYPE=12) 
          NZ     X0,CLIENT   IF NOT ASCII, EXIT 
          SA1    BANKADD     GET WORD HOLDING TERM SUBTYPE
          MX0    -TSBTN      SET MASK TO GET DATA 
          LX1    TSBTN-TSBTS  POSITION DATA TO END OF WORD
          BX1    -X0*X1      MASK OUT TERM SUBTYPE
          SX0    X1-SBTWIN   SEE IF WINDOWS TERMINAL
          ZR     X0,CLIENT1  SEND -EXT- CODE
          SX0    X1-SBTMAC   SEE IF MACINTOSH SYSTEM
          ZR     X0,CLIENT1  SEND -EXT- CODE
          EQ     CLIENT      -- RETURN
 
 CLIENT1  SX1    B1          -EXT- CODE 
          SX1    X1+B2       ADD ADDITIONAL VALUE TO -EXT-
          OUTCODE EXTCODE    OUTPUT CODE TO FORMATTER 
          EQ     CLIENT      RETURN 
* 
* /---   BLOCK      END        00 000   79/04/22  03.56 
          TITLE  MACRO ROUTINES 
***       GETSEG - GET SEGMENT FROM 15-BIT SEGMENT ARAY 
* 
*         ROUTINE USED BY *DISKFIO*, *FILEX*, *NAMEX* 
*                         *RECORDX*, AND *RESERV* 
* 
          ENTRY  GETSEG 
 GETSEG   EQ     *           ENTRY/EXIT 
          SX7    X1-1        RECORD NUMBER RELATIVE TO ZERO 
          MX6    -2 
          BX2    -X6*X7      GET LOWER 2 BITS OF REC. NO. 
          SX6    15 
          IX6    X2*X6       0,15,30,45 
          AX7    2           GET BIAS TO RAT WORD 
          SX2    45 
          IX6    X2-X6       45,30,15,0 
          SB1    X7 
          SA2    A0+B1       GET ALLOCATION WORD
          SB1    X6          RETURN SHIFT COUNT TO CALLER 
          AX2    X2,B1       NEXT POINTER TO LOWER 15 BITS
          MX7    -15
          BX2    -X7*X2      EXTRACT NEXT RECORD NUMBER 
          EQ     GETSEG      -- RETURN
* 
* /---   BLOCK      END        00 000   79/04/22  03.56 
* 
          END