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