plato:source:plaopl:condc
Table of Contents
CONDC
Table Of Contents
- [00023] CONDC1 CPU-TUTOR CONDENSOR
- [00024] ENTRY
- [00090] EXT
- [00108] -NXTLINE- MAIN LOOP
- [00221] STANDARD COMMAND WORD STORAGE EXITS
- [00290] NO ARGUMENT STANDARD READIN
- [00322] ONE ARGUMENT STANDARD READINS
- [00383] TWO ARGUMENT STANDARD READINS
- [00441] ONE OR TWO ARGUMENT STANDARD READINS
- [00559] THREE ARGUMENT STANDARD READINS
- [00606] READIN OF SYSTEM COMMANDS
- [00676] SCANNER ROUTINE
- [00752] CASE-SENSITIVE SCANNER ROUTINE
- [00833] -DEBLANK- STRIP LEADING SPACES
- [00860] CHECK FOR EXACT TAG MATCH
- [00889] -COLONCK- CHECK FOR COLON AS NEXT SEPARATOR
- [00926] CONDENS
- [01017] -AT- COMMAND
- [01117] UNAMX
- [01239] -SLIDE- AND -ALTFONT-
- [01289] FINIS
- [01324] CHAR, END, AND MODE
- [01364] -BACKGND- -FOREGND-
- [01435] SHOWA, SHOWO, AND SHOWH CONDENSE
- [01486] TEMPORARY KLUDGE FORM OF -GROUP-
- [01543] -ANSV- COMMAND READ-IN
- [01571] PUTV
- [01599] OK,NO,IGNORE,STORAGE,GETCHAR
- [01637] CHARSET LINESET MICRO
- [01724] PPTMESS - ISSUE *PPT* ERROR MESSAGE.
- [01772] CONDENSOR OVERLAY CALLS
- [01820] -NXTNAM-
- [01923] -ACCFILE- GET ACCOUNT AND FILE NAMES
- [02197] TERM
- [02263] GENERAL SUBROUTINES FOR PROCESSING VARIABLES
- [02678] ABORTCON–ABORT CONDENSE
- [02743] TUTOR COMMAND STATISTICS
- [02794] WRITECS - WRITE NEXT BLOCK OF BINARY TO ECS
- [03234] -APACK-
- [03291] -GETARGS-
- [03372] -DUMP- COMMAND
- [03403] TABC
- [03404] CENTRAL SUBOV TABLE
- [03507] CENTRAL CONDENSE COMMAND NAME TABLE
- [03658] READ-IN JUMP TABLE
Source Code
- CONDC.txt
- CONDC
- * /--- FILE TYPE = E
- * /--- BLOCK INIT 00 000 81/08/05 21.27
- IDENT CONDC
- LCC OVERLAY(1,0,O=OVERLAY)
- CST
- *
- *
- * CALL EITHER INITIAL ENTRY OR MTUTOR FINISH
- *
- CONDC LEVEL LEVEL0
- + EQ INITC INITIAL ENTRY
- + EQ =XCONDFIN FINISH UP AFTER MICROTUTOR
- INITC X INITOV ENDS UP JUMPING TO NXTLINE
- END CONDC
- * /--- BLOCK ENTRY 00 000 81/07/16 09.27
- IDENT CONDC1
- TITLE CONDC1 CPU-TUTOR CONDENSOR
- TITLE ENTRY
- CST
- *
- * ENTRY POINTS
- *
- ENTRY SEPCMAS
- ENTRY VARDO
- ENTRY VARDO1
- ENTRY VARDO2
- ENTRY VARDOR
- ENTRY PUTDO2
- ENTRY SYSTEST
- ENTRY VARFIN
- ENTRY VARFINM
- ENTRY MRKLAST
- ENTRY VARFINS
- ENTRY VARDOC
- ENTRY VARDOCL
- ENTRY VARFEM
- ENTRY VARLEX
- ENTRY VARONE
- ENTRY NOARG
- ENTRY VARSEP
- ENTRY CSTO
- ENTRY NXTLINE
- ENTRY NXTC
- ENTRY SHOWAGO
- ENTRY ATGO
- ENTRY PAUSE2
- ENTRY ONETWO1,NOTAG
- * FOLLOWING FOR PACK OVERLAY
- ENTRY CONV2,BRVAR,CONUL4
- ENTRY CONV3
- ENTRY RGIN
- * /--- BLOCK ENTRY 00 000 81/07/16 01.47
- * ENTRIES FOR TABC
- ENTRY SONE2IN,SEEDC,MASTORC,CALCCIN,OKIN
- ENTRY AFONTC,ONEARG,PUTVC,ONEPUT,ONESTOR
- ENTRY ANSUIN,ANSVIN,ONE2C,ONE2IN,ONE2IN0
- ENTRY SYSONEP,SYSONES,CKPTC,OUTPTIN,SYSTRI
- ENTRY SYSTWO,ATIN,FORGNDI,AUDIOC,TEXTIN
- ENTRY TWOARG,GETCHRC,SAYCIN,BCKGNDI,BLOCKIN
- ENTRY BLOCKIN,GETMKC,USEEC,RECRDIN,SHOWHC
- ENTRY PERMIN,SSTARIN,GROUPIN,TERMC,PLAYC
- ENTRY PPTRUNC,CHECKIN,CHARIN,CHARTST
- ENTRY NOIN,PPTADDC,NAMEC,PPTOUTC,CODOUTC
- ENTRY COLLCTC,ENDIN,TERMOPC,TWOSTOR,LLISTIN
- ENTRY WRGUIN,CREATEC,EXTC,COMPARC,SLIDEC
- ENTRY SLISTIN,SAYLGIN,CSETIN,MDBITIN,CONDNIN
- ENTRY ONE0,ERASEC,SHOWAIN,SYSLOIN,ONETWO
- ENTRY WRTNSIN,SAYIN,REMOVLC,IGIN,SHOWOC
- ENTRY HASHIN
- * EXTERNALS FOR TABC
- EXT OVRLAYS
- EXT ERASEC=
- EXT BACKG=
- EXT WRONGV=
- EXT ANSV=
- EXT OK=
- EXT FINIS=
- EXT HOLFIN
- EXT COMNAMS
- EXT COMINFO
- * /--- BLOCK EXT 00 000 81/07/16 04.07
- TITLE EXT
- *
- * EXTERNAL SYMBOLS
- *
- EXT KEYTYPE
- EXT ERRORC
- EXT ABORTC
- EXT GETLINE ROUTINE TO GET NEXT LINE OF TUTOR CODE
- *
- * EXTERNS IN COND
- EXT OLDCMND
- EXT CLINES
- * /--- BLOCK VARS 00 000 81/07/14 14.31
- ENTRY COMCONT
- *
- COMCONT VFD 60/8L BLANK FOR CONTINUED COMMAND
- COMCONF VFD 60/8L\ \ FOR RUSSIAN (1-FONT,7-SPACES)
- * /--- BLOCK NXTLINE 00 000 81/07/17 15.04
- TITLE -NXTLINE- MAIN LOOP
- *
- NXTLINE BSS 0 PROCESS NEXT LINE OF LESSON
- *///
- SA1 TMPCMNM HE WHO TRIES TO TRASH MY CELL
- SA2 TMPTRAP WILL JUST BE TOLD TO GO TO HELL
- BX1 X1-X2 IF THINGS DONT JIVE,
- ZR X1,NLTMPOK THE BOMB WILL DROP
- PS BY MEANS OF THIS HERE PROGRAM STOP
- TMPTRAP DATA 8L*TEMPCOM
- NLTMPOK BSS 0
- *///
- SA1 TSCOMFG
- PL X1,NXTLIN JUMP IF STAT OFF
- RJ PSTCMS1 TAKE COMMAND STATISTICS
- NXTLIN RJ GETLINE GET NEXT LINE--*WORDPT*=1ST TAG CHAR ADDR.
- NXTC SA2 COMMAND X2 = CURRENT COMMAND NAME
- SA3 COMCONT SEE IF IT IS A BLANK (CONTINUED COMMAND)
- SA4 COMCONF SEE IF A FONT CONTINUED
- BX3 X2-X3
- BX4 X2-X4
- + ZR X3,*+1 SEE IF CONTINUED COMMAND
- NZ X4,NXTCOM NOT EQUAL MEANS NEW COMMAND
- SA2 OLDCMND GET PREVIOUS COMMAND NAME
- NXTCOM SA1 CLINES COMMANDS PROCESSED THIS LESSON
- SX6 X1+1 INCREMENT COUNT
- SA6 A1
- *
- LIST X,G
- *
- *CALL MACROS
- *
- ADR MICRO 1,,/A0/ A0 = START OF HASH TABLE
- COM MICRO 1,,/B2/ B2 = START OF COMNAMS FOR FIND
- SA0 COMINFO COMINFO IS HASH TABLE
- *
- * HASH THE COMMAND NAME
- *
- HASH X2,X0,A1 X2 = CURRENT COMMAND (HOLERITH)
- *
- * FIND COMMAND IN NAME TABLE
- *
- SB2 COMNAMS
- FIND X2,X0,NXTCOMA,B1,X5,B5,B3,B4,A1
- *
- LIST *
- *
- * TREAT POSSIBLE STATEMENT LABEL EXACTLY LIKE -CALC-
- *
- SA5 LABINFO X5 = LABEL INFO
- UX5,B5 X5 B5 = INDEX FOR STATISTICS
- LX5 16 POSITION PROPERLY
- EQ NXTCOMB
- * COMMAND NAME WAS FOUND
- NXTCOMA BX6 X2
- SA6 OLDCMND SAVE COMMAND NAME
- LX5 16 BIT SET IF COMMAND MAY NOT BE INDENTED
- * /--- BLOCK NXTLINE2 00 000 81/07/13 20.33
- * X5 HOLDS COMMAND INFO
- * B5 HOLDS NAME TABLE INDEX (FOR STATISTICS)
- *
- * CHECK IF THIS COMMAND CAN BE INDENTED
- NXTCOMB SA1 INDENT INDENT COUNT FOR THIS LINE
- SA2 PISTACK POINTER TO TOP OF INDENT STACK
- ZR X1,NXTCOMC OK IF NOT INDENTED
- NG X5,NOINDT ERROR IF CAN'7T HAVE INDENTING
- * VERIFY THAT THIS COMMAND IS INDENTED PROPERLY
- NXTCOMC LX5 -1 BIT SET IF COMMAND DOES ITS OWN VERIFYING
- IX2 X2-X1 COMPARE INDENT AND STACK LEVELS
- ZR X2,NXTCOMF JUMP IF INDENTING IS CORRECT
- NG X5,NXTCOMF JUMP IF SPECIAL COMMAND
- RJ =XCHKIND OUTPUT ERROR MESSAGES AND FIX THE STACK UP
- * CHECK IF NEED TO TERMINATE THE CALC
- NXTCOMF LX5 -1 BIT SET IF CALC-TYPE COMMAND
- SA1 =XCALCACT
- ZR X1,NXTCOMG JUMP IF NO CALC IS ACTIVE
- NG X5,NXTCOMG JUMP IF CALC-TYPE COMMAND
- RJ =XENDCALC TERMINATE CALC (SAVES X5,B5)
- NXTCOMG LX5 34 POSITION COMMAND INFO
- UX5,B1 X5 COMMAND NUMBER TO B1
- SX6 B1
- SB1 X5 B1 = JUMP ADDRESS
- SA6 COMNUM SAVE COMMAND NUMBER IN COMNUM
- SA1 TSCOMFG
- ZR X1,NXTCOMH IF NO STATISTICS
- SX6 B5
- SA6 SCOMNUM SAVE COMMAND NUMBER FOR STAT
- MX6 59
- SA6 A1 SET COMMAND STAT FLAG TO -1(ON)
- SA2 SYSCLOK
- BX6 X2
- SA6 SCOMBEG SAVE BEGIN COMMAND CONDENSING TIME
- *
- NXTCOMH NG B1,NXTCOMI IF OVERLAY CALL
- JP B1
- *
- * LOAD AND EXECUTE OVERLAY
- *
- NXTCOMI MX7 0 CLEAR OVERLAY STACK POINTER
- SA7 =XOVRSTAK
- SX7 B1
- MX2 -8
- BX6 -X2*X7 (X6)=OVERLAY ARGUMENT
- SA6 OVARG1
- AX7 9
- BX7 -X2*X7 (X7)=OVERLAY NUMBER
- SX7 X7+OVRLAYS RESTORE PROPER VALUE
- CALL EXECOV0 EXECUTE OVERLAY
- EQ ERRORC FOR THOSE WHO RETURN ON ERRORS
- *
- ENTRY LABINFO
- LABINFO DATA 0 HOLDS INFO FOR STATEMENT LABEL
- * /--- BLOCK STANDARDS 00 000 80/12/26 14.26
- TITLE STANDARD COMMAND WORD STORAGE EXITS
- *
- *
- * THE -CALCODE- ENTRY POINT ASSUMES THAT THE
- * -GETVAR- OR -PUTVAR- CODE IS IN X1. THIS CODE
- * IS MOVED TO THE TOP *XCODEL* BITS AND ADDED TO
- * THE COMMAND CODE NUMBER, WITH THE RESULT STORED
- * AS THE COMMAND WORD.
- *
- ENTRY CALCODE
- *
- CALCODE MX0 -XCODEL ONLY WANT -GETVAR- CODE
- BX6 -X0*X1
- LX6 -XCODEL LEFT-ADJUST -GETVAR- CODE
- *
- *
- *
- * THE -PUTCODE- ENTRY POINT ADDS THE COMMAND CODE
- * NUMBER TO THE CONTENTS OF REGISTER X6 AND STORES
- * THE RESULT AS THE COMMAND WORD.
- *
- ENTRY PUTCODE
- *
- PUTCODE SA1 COMNUM X1 = COMMAND NUMBER
- BX6 X6+X1 ADD REMAINDER OF COMMAND WORD
- *
- *
- * THE -ALTCODE- ENTRY POINT PROVIDES AN EXIT
- * BRANCH ADDRESS FOR USE BY COMMANDS THAT EMPLOY AN
- * ALTERNATE COMMAND CODE NUMBER. THE COMPLETED
- * COMMAND WORD IS ASSUMED TO BE IN X6.
- *
- ENTRY ALTCODE
- *
- ALTCODE SA1 ICX X1 = CURRENT CODES INDEX
- SX7 X1-1 DECREMENT CODES COUNT
- SA7 A1
- SA6 INFO+X7 STORE COMMAND WORD
- EQ NXTLINE
- *
- *
- * THE -ALTCOD1- ENTRY POINT IS THE SAME AS
- * THE -ALTCODE- ENTRY POINT, EXCEPT IT ASSUMES
- * A CALL TO -GETLINE- HAS ALREADY BEEN DONE
- *
- ENTRY ALTCOD1
- ALTCOD1 SA1 ICX X1 = CURRENT CODES INDEX
- SX7 X1-1 DECREMENT CODES COUNT
- SA7 A1
- SA6 INFO+X7 STORE COMMAND WORD
- EQ NXTC
- *
- *
- * THE PUTTWO ENTRY POINT ASSUMES TWO -GETVAR-
- * CODES IN X1 AND X2. THEY ARE MOVED UP AND
- * COMBINED WITH THE COMMAND NUMBER TO FORM
- * THE COMMAND WORD.
- *
- ENTRY PUTTWO
- *
- PUTTWO MX0 -XCODEL
- BX6 -X0*X1
- LX6 -XCODEL LEFT POSITION FIRST CODE
- BX2 -X0*X2
- LX2 -2*XCODEL
- BX6 X6+X2 .OR. IN SECOND CODE
- EQ PUTCODE
- *
- * /--- BLOCK STANDARDS 00 000 80/12/26 14.26
- TITLE NO ARGUMENT STANDARD READIN
- *
- * THE FOLLOWING IS A STANDARD READIN FOR
- * COMMANDS WITH EXACTLY NO ARGUMENTS.
- *
- ENTRY SYSNO
- *
- SYSNO RJ SYSTEST
- NOARG RJ NOTAG BE SURE THERE IS NO TAG
- SX6 0 COMMAND NUMBER ONLY
- EQ PUTCODE --- GO TO STORE COMMAND
- *
- *
- * 'ROUTINE TO CHECK THERE IS NO TAG (OR ONLY
- * SPACES IN THE TAG). 'EXITS TO ERRORC OTHERWISE.
- *
- NOTAG EQ *
- SA1 TAGCNT
- ZR X1,NOTAG --- OK IF NO TAG AT ALL
- *
- * ONLY ALLOW SPACES TO FOLLOW COMMAND
- *
- SA1 WORDPT PICK UP POINTER TO TAG
- SA1 X1 GET FIRST CHARACTER OF TAG
- NOTAG1 SX2 X1-1R IF SPACE THEN IGNORE
- NZ X2,NOTAG2 NON-SPACE, NEXT CHECK IF EOL
- SA1 A1+1 GET NEXT CHARACTER
- EQ NOTAG1 LOOP TILL NOT A SPACE
- *
- NOTAG2 ZR X1,NOTAG --- OK IF EOL
- EQ ERR2MNY --- OTHERWISE AN ERROR
- * /--- BLOCK ONEARG 00 000 77/09/03 11.49
- TITLE ONE ARGUMENT STANDARD READINS
- *
- * THE FOLLOWING IS A STANDARD READIN FOR
- * COMMANDS WITH EXACTLY ONE ARGUMENT.
- *
- ENTRY SYSONE
- *
- SYSONE RJ SYSTEST CHECK IF REAL SYSTEM LESSON
- *
- ONEARG CALL COMPILE COMPILE -GETVAR- CODE
- SA2 LASTKEY
- NZ X2,ERR2MNY ONLY ALLOW ONE ARGUMENT
- EQ CALCODE
- *
- *
- * SAME AS -ONEARG- BUT CHECKS STOREABILITY
- *
- SYSONES RJ SYSTEST SEE IF SYSTEM LESSON
- ONESTOR CALL COMPILE COMPILE -GETVAR- CODE
- NZ B1,ERRSTOR MUST BE STOREABLE
- SA2 LASTKEY
- NZ X2,ERR2MNY ONLY ALLOW ONE ARGUMENT
- EQ CALCODE
- *
- *
- * THIS IS A GENERAL ONE-ARGUMENT, STOREABLE READIN
- * FOR USE BY A COMMAND DOING A FPUTVAR OR NPUTVAR
- * AT EXECUTION TIME.
- *
- ONEPUT CALL PUTCOMP COMPILE -PUTVAR- CODE
- SA2 LASTKEY
- NZ X2,ERR2MNY ALLOW ONLY ONE ARGUMENT
- EQ CALCODE
- *
- *
- * THIS IS A STANDARD READIN FOR COMMANDS THAT MAY
- * HAVE NONE OR EXACTLY ONE ARGUMENT. IF NO TAG,
- * THE SIGN BIT OF THE COMMAND WORD IS SET.
- *
- * USED BY
- * -CHECK-
- * -EXIT-
- * -SCORE-
- * -ROTATE-
- * -PAINT-
- *
- ** PAUSE2 ALSO USED BY -ERASE-, -POLAR-, -TIME-,
- ** -EDIT- AND -ONE2IN0-.
- CHECKIN RJ SYSTEST ONLY SYSTEM LESSONS CAN USE
- ONE0 SA1 TAGCNT SEE IF BLANK TAG
- NZ X1,ONEARG IF NOT, TREAT NORMALLY
- PAUSE2 MX6 1 SIGN BIT NEGATIVE FOR BLANK TAG
- *(NO GETVAR CODE SETS THE SIGN BIT OF THE COMMAND WORD.)
- EQ PUTCODE NOW ADD COMMAND CODE AND STORE
- *
- ENTRY TWOBITS
- * SET TOP 2 BITS OF COMMAND WORD.
- * USED BY ERASE AND COMMONX.
- TWOBITS MX6 2
- EQ PUTCODE ADD COMMAND CODE AND STORE
- * /--- BLOCK TWOARG 00 000 80/07/12 03.59
- TITLE TWO ARGUMENT STANDARD READINS
- *
- * THE FOLLOWING IS A STANDARD READIN FOR
- * COMMANDS WITH EXACTLY TWO ARGUMENTS.
- *
- SYSTWO RJ SYSTEST FOR 2 ARG SYSTEM COMMANDS
- TWOARG RJ TWODO GET TWO ARGS
- EQ PUTTWO COMPLETE COMMAND WORD
- *
- *
- *
- * TWO ARGUMENTS, FIRST MUST BE STOREABLE
- *
- * USED BY -COLLECT-, -TEXT-, -OUTPUTT-, -TEKTRON-
- *
- ENTRY COLLCTC
- *
- OUTPTIN RJ SYSTEST
- COLLCTC RJ TWODO GET TWO ARGS
- NG X1,ERRSTOR FIRST ARG MUST BE STOREABLE
- EQ PUTTWO COMPLETE COMMAND WORD
- *
- *
- *
- * TWO ARGUMENTS, SECOND MUST BE STOREABLE
- *
- * USED BY -GETMARK- AND -SYSLOC-
- *
- SYSLOIN RJ SYSTEST FOR SYSTEM COMMANDS
- GETMKC RJ TWODO GET TWO ARGS
- NG X2,ERRSTOR SECOND ARG MUST BE STOREABLE
- EQ PUTTWO COMPLETE COMMAND WORD
- *
- *
- * TWO ARGUMENTS -- BOTH MUST BE STOREABLE
- *
- * USED BY -RECNAME- (155)
- *
- TWOSTOR RJ TWODO GET TWO ARGS
- NG X1,ERRSTOR FIRST ARG MUST BE STOREABLE
- NG X2,ERRSTOR SECOND ARG MUST BE STOREABLE
- EQ PUTTWO COMPLETE COMMAND WORD
- *
- *
- *
- * COMPILE ARGUMENTS, CHECK FOR EXACTLY TWO
- * EXIT WITH GETVAR WORDS IN X1,X2
- *
- TWODO EQ *
- RJ VARDO COMMA SEPARATED VARIABLES
- SA1 VARBUF GET NO. OF VARIABLES
- SX2 X1-2
- NG X2,ERR2FEW
- NZ X2,ERR2MNY MUST BE TWO TAGS
- SA1 VARBUF+1 GET FIRST CODE
- SA2 VARBUF+2 GET SECOND CODE
- EQ TWODO
- * /--- BLOCK ONETWO 00 000 76/07/17 05.45
- TITLE ONE OR TWO ARGUMENT STANDARD READINS
- *
- * THE FOLLOWING IS A STANDARD READIN FOR
- * COMMANDS WITH ONE OR TWO ARGUMENTS.
- * IF THERE ARE TWO ARGUMENTS, THE FOLLOWING
- * COMMAND NUMBER IS USED.
- *
- * 'CURRENTLY USED BY THE FOLLOWING COMMANDS --
- *
- * -ARROW- (CODE=11 OR 12)
- * -DOT- (CODE=44 OR 45)
- *
- SONETWO CALL SYSTEST
- ONETWO RJ VARDO COMMA SEPARATED VARIABLES
- ONETWO1 SA1 VARBUF+1 *** FROM ARROWC
- MX0 -XCODEL
- BX6 -X0*X1 GET 1ST -GETVAR- CODE
- LX6 -XCODEL PLACE IN FIRST POSITION
- SA1 VARBUF X1 = NUMBER OF VARIABLES
- SX1 X1-2
- NG X1,PUTCODE DONE IF ONE TAG--CODE IN X6
- NZ X1,ERR2MNY ERROR IF MORE THAN 2 TAGS
- SA2 VARBUF+2 GET SECOND -GETVAR- CODE
- ONETWOA BX2 -X0*X2 *** FROM PERMIN
- LX2 -2*XCODEL
- BX6 X6+X2 PLACE IN SECOND POSITION
- SA1 COMNUM
- SX1 X1+1 ADVANCE TO NEXT COMMAND
- BX6 X6+X1
- EQ ALTCODE AND STORE COMMAND WORD
- *
- *
- * SAME AS -ONETWO- BUT SECOND ARG MUST BE STOREABLE
- *
- * 'CURRENTLY USED BY THE FOLLOWING COMMANDS --
- *
- * -SETPERM- (CODE=60 OR 61)
- * -REMOVE- (CODE=64 OR 65)
- *
- PERMIN RJ VARDO COMMA SEPARATED VARIABLES
- SA1 VARBUF+1 GET FIRST -GETVAR- CODE
- MX0 -XCODEL
- BX6 -X0*X1
- LX6 -XCODEL PLACE IN FIRST POSITION
- SA1 VARBUF X1 = NUMBER OF VARIABLES
- SX1 X1-2
- NG X1,PUTCODE DONE IF ONE TAG--CODE IN X6
- NZ X1,ERR2MNY ERROR IF MORE THAN 2 TAGS
- SA2 VARBUF+2 GET SECOND -GETVAR- CODE
- NG X2,ERRSTOR MUST BE STOREABLE
- EQ ONETWOA FINISH PROCESSING
- EJECT
- * /--- BLOCK ONETWO 00 000 77/09/10 18.29
- *
- * THE FOLLOWING IS A STANDARD READIN FOR
- * COMMANDS WITH ONE OR TWO ARGUMENTS.
- * IF THERE IS ONLY ONE ARGUMENT, THE TOP
- * BIT OF THE SECOND TAG FIELD IS SET.
- *
- SONE2IN RJ SYSTEST
- ONE2IN MX6 1 SET UP FLAG FOR 2ND ARG
- LX6 XCODEL
- SA6 VARBUF+2
- RJ VARDO
- SA1 VARBUF PICK NUMBER OF ARGS FOUND
- ZR X1,ERR2FEW
- SX2 X1-3
- PL X2,ERR2MNY
- EQ VARFIN
- *
- * THE FOLLOWING IS A STANDARD READIN FOR
- * COMMANDS WITH NONE, ONE, OR TWO ARGUMENTS.
- * IF NO ARGUMENTS, THE SIGN BIT OF THE COMMAND
- * WORD IS SET. IF ONLY ONE ARG, THE SIGN BIT
- * OF THE SECOND TAG FIELD IS SET.
- *
- * -RORIGIN- -GORIGIN- -RAT- -RATNM- -SIZE-
- * -PPTRUN- -PPTADDR-
- *
- ENTRY SYS012
- SYS012 RJ SYSTEST CHECK FOR SYSTEM LESSON
- ONE2IN0 SA1 TAGCNT
- ZR X1,PAUSE2
- EQ ONE2IN
- *
- * THE FOLLOWING IS A STANDARD READIN FOR
- * COMMANDS WITH NONE, ONE, OR TWO ARGUMENTS.
- * IF NO ARGUMENTS, THE SIGN BIT OF THE COMMAND
- * WORD IS SET. IF ONLY ONE ARG, THE SECOND
- * IS CODED AS 0 (GETVAR CODE=0, GETVAR RETURNS 0).
- *
- * -ERASE- (CODE=36)
- * -POLAR- (CODE=187)
- * -TIME- (CODE=257)
- *
- * ERASEIN SA1 TAGCNT X1 = CHARS IN TAG
- * ZR X1,PAUSE2 IF BLANK TAG, SET SIGN BIT
- * EQ SCALIN 1OR2 ARGS (2D=0 IF OMITTED)
- *
- * /--- BLOCK ONE2C 00 000 80/08/04 10.29
- *
- * FOLLOWING IS A STANDARD READING FOR COMMANDS
- * WITH NONE, ONE OR TWO ARGUMENTS
- * IF NONE, SIGN BIT OF COMMAND WORD IS SET
- * IF ONLY ONE, SECOND ARGUMENT FIELD IS ZEROED
- * USED BY -ERASE- -POLAR- -TIME-
- *
- ONE2C SA1 TAGCNT
- ZR X1,PAUSE2 IF BLANK TAG, SET SIGN BIT
- RJ VARDO COMPILE ARGUMENTS
- SA1 VARBUF GET NUMBER COMPILED
- SX2 X1-2
- ZR X2,VARFIN IF TWO, GO COMPILE THEM
- PL X2,ERR2MNY ERROR IF MORE THAN 2
- SA1 VARBUF+1 GET FIRST ARG
- EQ CALCODE GO PACK UP ONE ARG, 2D=0
- *
- * /--- BLOCK TRIARG 00 000 79/12/15 01.18
- TITLE THREE ARGUMENT STANDARD READINS
- *
- * THE FOLLOWING IS A STANDARD READIN FOR
- * COMMANDS WITH EXACTLY THREE ARGUMENTS.
- *
- ENTRY STRIARG
- STRIARG RJ SYSTEST SYSTEM LESSONS ONLY
- TRIARG RJ VARDO COMMA SEPARATED VARIABLES
- SX1 3 MUST BE EXACTLY 3 ARGUMENTS
- EQ VARFIN PACK AND STORE TAGFIELDS
- *
- *
- * -TRIARGS- CHECK FIRST ARG STOREABLE
- *
- SYSTRI CALL SYSTEST SYSTEM LESSONS ONLY
- TRIARGS RJ VARDO COMMA SEPARATED VARIABLES
- SA1 VARBUF+1 FIRST TAG MUST BE STOREABLE
- NG X1,ERRSTOR
- SX1 3
- EQ VARFIN
- *
- *
- * SAME AS -TRIARGS- BUT FIRST AND SECOND ARGS
- * MUST BE STOREABLE.
- *
- * CURRENTLY USED BY -BLOCK- COMMAND (CODE=102)
- *
- BLOCKIN RJ VARDO COMMA SEPARATED VARIABLES
- SA1 VARBUF+1 FIRST TAG MUST BE STOREABLE
- NG X1,ERRSTOR
- SA1 VARBUF+2 SECOND TAG MUST BE STOREABLE
- NG X1,ERRSTOR
- SX1 3
- EQ VARFIN
- *
- *
- *
- * SAME AS -TRIARG- BUT THIRD ARG MUST BE STOREABLE
- *
- * USED BY -COMPARE- COMMAND
- *
- COMPARC RJ VARDO COMMA SEPARATED VARIABLES
- SA1 VARBUF+3 THIRD ARG MUST BE STOREABLE
- NG X1,ERRSTOR
- SX1 3
- EQ VARFIN
- * /--- BLOCK SYSIN 00 000 80/02/02 01.18
- TITLE READIN OF SYSTEM COMMANDS
- *
- *
- * SYSTEM COMMAND WITH ONE NAME AS ARGUMENT
- *
- SYSONEN CALL SYSTEST SEE IF SYSTEM LESSON
- CALL COMPNAM
- EQ CALCODE
- *
- *
- * COMMANDS WITH ONE ACCOUNT';FILE NAME AS TAG
- *
- ENTRY ONEFILE,SYSONEF
- *
- SYSONEF CALL SYSTEST SEE IF SYSTEM LESSON
- ONEFILE CALL ACCFILF GET FILE NAME
- ZR X1,ERR2FEW ERROR IF BLANK TAG
- SX1 2 2 ARGUMENTS LEGAL
- SA2 LASTKEY
- ZR X2,VARFIN
- EQ ERR2MNY ERROR IF EXTRA ARGUMENTS
- *
- *
- * COMMANDS WITH ONE ACCOUNT';FILE NAME AS TAG
- * WHICH ALSO ALLOW A BLANK TAG
- *
- ENTRY ONEFILB
- *
- ONEFILB CALL ACCFILF GET FILE NAME
- ZR X1,PAUSE2 EXIT IF BLANK TAG
- SX1 2 2 ARGUMENTS LEGAL
- SA2 LASTKEY
- ZR X2,VARFIN
- EQ ERR2MNY ERROR IF EXTRA ARGUMENTS
- *
- *
- * SPECIAL FOR SETPACK--POSSIBLE BLANK TAG
- *
- SYSONEP RJ SYSTEST SEE IF SYSTEM LESSON
- SA1 TAGCNT BLANK TAG CHECK
- ZR X1,CALCODE JUST USE THE 0
- CALL COMPILE
- EQ CALCODE
- *
- * CREATE COMMAND
- *
- CREATEC RJ SYSTEST
- CALL VARDO1 GET FIRST ARG
- CALL VARDO2 GET SECOND ARG
- CALL NXTNAM GET THIRD ARG, IF ONE
- MX3 0 CLEAR THIRD TAG FLAG
- ZR X6,CCRT0 IF NO THIRD TAG
- *
- * THIRD TAG (IF ONE) MUST BE STRING '7NPDWRITE'7
- *
- SA1 =8LNPDWRITE
- BX2 X1-X6
- NZ X2,ERRORC THIRD TAG WAS GARBAGE
- *
- MX3 1 SET TOP BIT OF GVAR IF THIRDARG
- LX3 XCODEL
- *
- CCRT0 SA1 VARBUF+1 GET FIRST GVAR CODE
- BX1 X1+X3 AND MERGE WITH THIRD ARG FLAG
- *
- SA2 VARBUF+2 AND GET SECOND ARG
- EQ PUTTWO COMPLETE COMMAND WORD
- *
- *
- * /--- BLOCK SCANNER 00 000 75/10/30 02.14
- TITLE SCANNER ROUTINE
- * FINDS RECOGNIZED WORDS IN TAG FIELD AND SETS CORRESPONDING
- * BITS IN X6, X0 RETURNED ZERO IF ALL OK.
- * THIS ROUTINE SCANS ALL THE WAY TO THE END-OF-LINE,
- * WITH THE IDENTIFIED WORDS ENTERED IN THE BIT TABLE IN X6
- *
- * CALLING ROUTINE MUST HAVE SET UP FOLLOWING
- * B1=FIRST OF LIST OF RECOGNIZED WORDS
- * B2=SCRATCH LOCATION AT END OF SAID LIST
- * X5=MASK TO BE APPLIED TO TABLE WORDS
- *
- ENTRY SCANNER
- *
- *
- SCANNER EQ * FOR RETURN JUMP ENTRY
- * /--- BLOCK SCANNER 00 000 75/10/30 03.16
- SB7 1 STORE A CONSTANT ONE
- SB4 B2-B1 PUT THE LIST LNTH IN B4
- MX0 0 CLEAR ERROR FLAG
- MX6 0 CLEAR ALL BITS IN WORDS FOUND
- MX4 1 SET UP FOR SHIFT BIT
- SB6 60 SET UP FOR FIRST OF 60 WORDS
- SA1 TAG-1 INITIALIZE TO BEFORE FIRST CH
- *
- SCA MX7 0 CLEAR WORD ACCUMULATOR
- SB5 60 INITIALIZE SHIFT FOR END
- SCANL SA1 A1+B7 GET NEXT CHARACTER
- ZR X1,SCANNER TEST FOR END OF LINE
- SX2 X1-1R+ ACCEPT LETTERS AND NUMBERS ONLY
- NG X2,SCBUILD
- SX2 X1-1R TEST FOR SPACES
- ZR X2,SCANL
- SX2 X1-1R, TEST OF COMMA
- ZR X2,SCANL
- EQ SCERR ANYTHING ELSE AN ERROR
- *
- SCBUILD LX7 6 SHIFT WORD A BUILDING
- BX7 X7+X1 ADD THIS NEW CHARACTER IN
- SB5 B5-6 DECREMENT END SHIFT COUNT
- NG B5,SCERR TEST FOR OVER 10 CHARACTERS
- SA1 A1+B7 GET NEXT CHARACTER
- *
- ZR X1,SCBLD1 TEST FOR END OF LINE
- SX2 X1-1R+ TEST FOR LETTERS AND NUMBERS
- NG X2,SCBUILD THEN BUILD UP WORD
- SX2 X1-1R, TEST FOR COMMA PUNC
- ZR X2,SCBLD1
- SX2 X1-1R SPACES ALSO PUNCTUATION
- NZ X2,SCERR ANYTHING ELSE AN ERROR
- SCBLD1 LX7 B5,X7 SHIFT WORD INTO TOP-NOTCH SHAPE
- BX7 X5*X7 APPLY MASK TO GUARANTEE HIT
- SA7 B2 STORE IN END SCRATCH WORD
- SA3 B1-B7 SET A3 TO POINT TO START OF SEARCH WORD LST
- *
- SCNLOOP SA3 A3+B7 GET NEXT WORD
- BX3 X5*X3 MASK IT
- BX3 X3-X7
- NZ X3,SCNLOOP SEE IF FOUND MATCH
- *
- SB5 A3-B1 HOW FAR INTO LIST
- EQ B5,B4,SCERR TEST FOR NO FIND
- SB5 B6-B5 SET UP SHIFT
- LX3 B5,X4 MOVE BIT SETTER
- BX6 X6+X3 SET AN X6 BIT
- ZR X1,SCANNER SEE IF DONE
- EQ SCA
- *
- SCERR MX0 59 SET ERROR FLAG
- ZR X1,SCANNER TEST IF DONE
- SX2 X1-1R, SEE IF AT COMMA
- ZR X2,SCA ON TO NEXT WORD
- SX2 X1-1R SPACE ALSO PUNC
- ZR X2,SCA
- SA1 A1+B7 GET NEXT CHARACTER
- EQ SCERR LOOP OVER ALL ELSE
- * /--- BLOCK CSSCAN 00 000 75/10/04 11.47
- TITLE CASE-SENSITIVE SCANNER ROUTINE
- * FINDS RECOGNIZED WORDS IN TAG FIELD AND SETS CORRESPONDING
- * BITS IN X6, X0 RETURNED ZERO IF ALL OK.
- * THIS ROUTINE SCANS ALL THE WAY TO THE END-OF-LINE,
- * WITH THE IDENTIFIED WORDS ENTERED IN THE BIT TABLE IN X6
- *
- * CALLING ROUTINE MUST HAVE SET UP FOLLOWING
- * B1=FIRST OF LIST OF RECOGNIZED WORDS
- * B2=SCRATCH LOCATION AT END OF SAID LIST
- * X5=MASK TO BE APPLIED TO TABLE WORDS
- *
- ENTRY CSSCAN
- *
- *
- CSSCAN EQ * FOR RETURN JUMP ENTRY
- * /--- BLOCK CSSCAN 00 000 75/10/04 12.07
- SB7 1 STORE A CONSTANT ONE
- SB4 B2-B1 PUT THE LIST LNTH IN B4
- MX0 0 CLEAR ERROR FLAG
- MX6 0 CLEAR ALL BITS IN WORDS FOUND
- MX4 1 SET UP FOR SHIFT BIT
- SB6 60 SET UP FOR FIRST OF 60 WORDS
- SA1 TAG-1 INITIALIZE TO BEFORE FIRST CH
- *
- CSA MX7 0 CLEAR WORD ACCUMULATOR
- SB5 60 INITIALIZE SHIFT FOR END
- CSCANL SA1 A1+B7 GET NEXT CHARACTER
- ZR X1,CSSCAN TEST FOR END OF LINE
- SX2 X1-KUP
- ZR X2,CSBUILD OK IF UPPER CASE
- SX2 X1-1R+ ACCEPT LETTERS AND NUMBERS ONLY
- NG X2,CSBUILD
- SX2 X1-1R TEST FOR SPACES
- ZR X2,CSCANL
- SX2 X1-1R, TEST OF COMMA
- ZR X2,CSCANL
- EQ CSERR ANYTHING ELSE AN ERROR
- *
- CSBUILD LX7 6 SHIFT WORD A BUILDING
- BX7 X7+X1 ADD THIS NEW CHARACTER IN
- SB5 B5-6 DECREMENT END SHIFT COUNT
- NG B5,CSERR TEST FOR OVER 10 CHARACTERS
- SA1 A1+B7 GET NEXT CHARACTER
- *
- ZR X1,CSBLD1 TEST FOR END OF LINE
- SX2 X1-KUP
- ZR X2,CSBUILD OK IF UPPER CASE
- SX2 X1-1R+ TEST FOR LETTERS AND NUMBERS
- NG X2,CSBUILD THEN BUILD UP WORD
- SX2 X1-1R, TEST FOR COMMA PUNC
- ZR X2,CSBLD1
- SX2 X1-1R SPACES ALSO PUNCTUATION
- NZ X2,CSERR ANYTHING ELSE AN ERROR
- CSBLD1 LX7 B5,X7 SHIFT WORD INTO TOP-NOTCH SHAPE
- BX7 X5*X7 APPLY MASK TO GUARANTEE HIT
- SA7 B2 STORE IN END SCRATCH WORD
- SA3 B1-B7 SET A3 TO POINT TO START OF SEARCH WORD LST
- *
- * /--- BLOCK CSSCAN 00 000 75/10/04 12.04
- CSNLOOP SA3 A3+B7 GET NEXT WORD
- BX3 X5*X3 MASK IT
- BX3 X3-X7
- NZ X3,CSNLOOP SEE IF FOUND MATCH
- *
- SB5 A3-B1 HOW FAR INTO LIST
- EQ B5,B4,CSERR TEST FOR NO FIND
- SB5 B6-B5 SET UP SHIFT
- LX3 B5,X4 MOVE BIT SETTER
- BX6 X6+X3 SET AN X6 BIT
- ZR X1,CSSCAN SEE IF DONE
- EQ CSA
- *
- CSERR MX0 59 SET ERROR FLAG
- ZR X1,CSSCAN TEST IF DONE
- SX2 X1-1R, SEE IF AT COMMA
- ZR X2,CSA ON TO NEXT WORD
- SX2 X1-1R SPACE ALSO PUNC
- ZR X2,CSA
- SA1 A1+B7 GET NEXT CHARACTER
- EQ CSERR LOOP OVER ALL ELSE
- * /--- BLOCK DEBLANK 00 000 80/10/02 03.23
- TITLE -DEBLANK- STRIP LEADING SPACES
- *
- * -DEBLANK-
- *
- * MOVE CHARACTER POINTER PAST SPACE CHARACTERS
- *
- * ON ENTRY -- *WORDPT* SET
- *
- * ON EXIT -- *WORDPT* SET TO FIRST NON-BLANK CHAR
- * A1 = *WORDPT*
- * X1 = CONTENTS OF *WORDPT*
- * X2 = FIRST NON-BLANK CHAR
- *
- * USES -- (A1,A2,A6) (X1,X2,X3,X6)
- *
- DEBLANK EQ *
- SA1 WORDPT X1 = CHAR POINTER
- DOBLP SA2 X1 X2 = THIS CHARACTER
- SX3 X2-1R IS IT A SPACE
- NZ X3,DEBLANK -- EXIT IF NOT
- SX1 X1+1
- BX6 X1 ADVANCE CHAR POINTER
- SA6 A1
- EQ DOBLP AND LOOK AT NEXT CHAR
- *
- * /--- BLOCK TAGXACT 00 000 76/09/13 13.33
- TITLE CHECK FOR EXACT TAG MATCH
- *
- ENTRY TAGXACT
- *
- * CHECKS WHETHER TAG CONSISTS SOLELY AND EXACTLY OF A
- * SPECIFIED CHARACTER STRING. ENTER WITH COMPARISON
- * STRING LEFT-ADJUSTED AND ZERO-FILLED IN X1. (MAY BE UP
- * TO 9 CHARACTERS.)
- * ON EXIT, X1 = -1 IF MATCH, 0 IF NO MATCH.
- *
- * ALTERS A2, X0,X1,X2,X3,X4
- *
- TAGXACT EQ *
- SA2 TAG GET FIRST CHAR OF TAG
- MX0 -6 MASK FOR BOTTOM CHAR
- TXLOOP LX1 6 POSITION NEXT CHARACTER
- BX3 -X0*X1 CHAR FROM STRING IN X3
- BX4 X2-X3 COMPARE WITH CHAR FROM TAG
- NZ X4,TXNO FAILS IF NO MATCH
- ZR X3,TXYES DONE IF 00 CHARACTER
- SA2 A2+1 GET NEXT TAG CHARACTER
- EQ TXLOOP
- *
- TXNO MX1 0 NO MATCH
- EQ TAGXACT
- *
- TXYES MX1 -1 MATCH
- EQ TAGXACT
- *
- TITLE -COLONCK- CHECK FOR COLON AS NEXT SEPARATOR
- *
- *
- * -COLONCK-
- *
- * CHECKS WHETHER SEPARATOR FOLLOWING NEXT ARGUMENT
- * IS A COLON AND, IF SO, CONVERTS IT TO A SEMICOLON
- * FOLLOWED BY A BLANK.
- *
- * ENTER *WORDPT* SET
- *
- * EXIT (X6) = 0 IF NEXT SEPARATOR IS A COLON
- * (X6) .NE. 0 IF SOME OTHER SEPARATOR
- *
- * USES ALL
- *
- * CALLS PSCAN
- *
- ENTRY COLONCK
- COLONCK EQ *
- SA1 WORDPT GET POINTER TO NEXT CHARACTER
- SX0 0 NO SPECIAL TERMINATOR
- CALL PSCAN FIND END OF NEXT ARGUMENT
- SX6 X1-KSEMIC SEE IF ENDED ON SEMICOLON
- NZ X6,COLONCK EXIT IF NOT A SEMICOLON
- SA3 B1-1 (X3) = PREVIOUS CHARACTER
- SX6 X3-KUP SEE IF SHIFT CODE
- NZ X6,COLONCK EXIT IF NOT A COLON
- SX7 KSEMIC
- SA7 A3+ CHANGE SHIFT TO SEMICOLON
- SX7 1R
- SA7 A3+1 CHANGE SEMICOLON TO BLANK
- EQ COLONCK
- * /--- BLOCK CONDENS 00 000 81/07/10 01.03
- *
- TITLE CONDENS
- * CONDENS ACCOUNT';LESSON,KEYWORDS
- *
- CONDNIN CALL SYSTEST SYSTEM LESSONS ONLY
- CALL ACCFILF GET ACCOUNT';FILE NAMES
- ZR X1,ERR2FEW ERROR IF BLANK TAG
- SX6 0
- SA6 CONDMAP PRESET TO NO KEY WORDS
- SA1 LASTKEY
- CONDKW ZR X1,COND1 JUMP IF NO KEY WORDS
- *
- RJ =XNXTNAME
- ZR X6,=XERRNAME IF NO KEY WORD THERE
- *
- SB1 B0 POINT TO FIRST KEY WORD
- SB2 CKWEND-CKW NUMBER OF KEY WORDS
- CKWLP SA1 CKW+B1 X1 = NEXT KEY WORD
- IX1 X6-X1
- ZR X1,CONDMP IF MATCHED KEY WORD
- *
- SB1 B1+1
- NE B1,B2,CKWLP IF STILL MORE TO SEARCH
- *
- EQ =XERRNAME UNRECOGNIZED KEYWORD
- *
- CONDMP SA1 CONDMAP TURN ON CONDENSOR OPTION BIT
- SX2 1
- LX2 B1
- BX6 X1+X2
- SA6 A1
- SA1 WORDPT
- SA1 X1 X1 = NEXT CHARACTER
- EQ CONDKW LOOP BACK FOR MORE KEYWORDS
- *
- COND1 SX1 3 3 ARGUMENTS LEGAL
- SX6 X1+
- SA6 VARBUF
- EQ VARFIN
- *
- CONDMAP EQU VARBUF+3 KEYWORD BITMAP IS 3RD ARGUMENT
- *
- *
- *
- * -MASTOR- COMMAND
- *
- MASTORC CALL SYSTST1 SPECIAL SYSTEM LESSONS ONLY
- EQ ONESTOR
- *
- *
- * -SYSTEST- SYSTEM LESSON CHECK
- *
- ENTRY SYSTEST
- SYSTEST EQ *
- SA1 SYSFLG CHECK IF SYSTEM LESSON
- LX1 ZSLDSHF
- NG X1,SYSTEST IF YES
- EQ ERRORC ERROR IF NOT
- *
- *
- * CHECK IF LESSON CAN WRITE ECS/CM
- *
- ENTRY SYSTST1
- SYSTST1 EQ *
- CALL SYSTEST CHECK IF SYSTEM LESSON
- SA1 SYSFLG
- LX1 ZWLDSHF
- NG X1,SYSTST1
- EQ ERRORC
- *
- *
- * /--- BLOCK +ERASE 00 000 80/10/02 02.52
- *
- * -ERASE- (CODE=36)
- *
- * -ERASE BLANK- SETS TOP BIT,
- * -ERASE N1,N2- RETURNS 2ARG, -ERASE N1- 2D IS 0
- * -ERASE ABORT- SETS TOP TWO BITS
- *
- ERASEC SA1 TAG FIRST TAG CHAR
- ZR X1,PAUSE2 BLANKTAG(F.S.ERASE) SETS TOPBIT
- *
- * CHECK FOR -ABORT-
- *
- SA1 ERABORT
- RJ TAGXACT SEE IF ',ABORT', TAG
- NG X1,TWOBITS IF ABORT, SET TOP 2 BITS
- EQ ONE2C --- ELSE SET UP ARGS
- *
- ERABORT DATA 5LABORT
- *
- * /--- BLOCK AT, COMMA 00 000 76/07/30 23.42
- TITLE -AT- COMMAND
- *
- * -AT- COMMAND
- *
- ATIN RJ ATGO
- EQ PUTCODE
- *
- ATGO EQ * ENTRY/EXIT LINE
- CALL VARDO DECODE ONE OR TWO VARIABLES
- SA2 VARBUF
- SX2 X2-1 CHECK FOR 1 VARIABLE
- NZ X2,ONETWOB
- MX0 -XCODEL
- SA1 VARBUF+1 LOAD -GETVAR- CODE
- BX1 -X0*X1
- MX0 -XCODEAL MASK FOR ADDRESS PORTION
- BX2 X0*X1 MUST BE SHORT LITERAL
- NZ X2,ONETWOB
- CALL RCTOXY CONVERT TO FINE GRID
- MX0 -9
- BX1 X6+X7 MERGE X AND Y POSITIONS
- BX1 X0*X1
- NZ X1,ERRXYTG ERROR IF ILLEGAL POSITION
- LX6 60-10
- LX7 60-10-9
- MX1 1
- BX6 X6+X1 MERGE SIGN BIT AND X POSITION
- BX6 X6+X7 ATTACH Y POSITION
- EQ ATGO RETURN TO STORE COMMAND WORD
- *
- ONETWOB SB1 -1 CONSTANT
- SA1 VARBUF ONETWOB CALLED FROM TWO PLACES IN ATGO
- SA2 A1-B1 VARBUF+1
- MX0 60-XCODEL TO PICK UP LOWEST 20 BITS
- BX6 -X0*X2
- LX6 60-XCODEL SHIFT INTO PLACE
- SX1 X1+B1
- ZR X1,ATGO ONE ARG--TO (PUTCODE)
- SX1 X1+B1 N-2
- NZ X1,ERRTAGS NEITHER 1 OR 2
- SA2 A2-B1 VARBUF+2
- BX2 -X0*X2
- LX2 60-2*XCODEL
- BX6 X6+X2
- SA1 COMNUM
- SX7 X1+1
- SA7 A1
- EQ ATGO NOT SUBROUTINED, AS ONLY ATGO
- * USES THIS CODE...
- * /--- BLOCK ARROW 00 000 80/12/26 14.29
- *
- ENTRY NOINDT
- NOINDT SB1 76 UNIT, ENTRY, ARROW, ENDARROW
- EQ =XERR MAY NOT BE INDENTED
- *
- * 'ROUTINE TO SET PROPER OFFSET INTO ARROW COMMAND.
- *
- *
- ENTRY SETARO
- *
- SETARO EQ *
- SA1 LOCARO X1 = LOCATION OF ARROW COMMAND
- ZR X1,SETARO5 IF NO PRECEDING -ARROW-
- *
- SA2 LVARL X2 = LOCAL VAR STACK LENGTH
- SX2 X2-1
- NG X2,SETARO3 IF NO LOCALS IN LESSON
- *
- SX2 X2+1 RESTORE X2 IN CASE NO ERROR
- ZR B1,NOEARRO IF MISSING -ENDARROW-
- *
- SETARO3 BX7 X2 LVARL.LT.0 IF -LVARS- ILLEGAL
- SA7 A2
- SA2 INFO+X1 X2 = ARROW COMMAND WORD
- SX6 INFOLTH
- SA3 ICX INDEX TO COMMAND BEFORE THIS
- IX6 X6-X3 RELATIVE COMMAND BIAS
- LX6 XCMNDL
- BX6 X2+X6 ADD POINTER TO ARROW COMMAND
- SA6 A2 RESTORE
- MX7 0
- SA7 A1 CLEAR ARROW LOCATION
- EQ SETARO --- EXIT
- SETARO5 ZR B1,SETARO IF NO -ARROW-/-ENDARROW-
- *
- SA2 LVARL
- SX2 X2-1
- NG X2,SETARO IF NO LOCALS IN LESSON
- *
- SB1 771 MISSING -ARROW-
- RJ =XRJERR
- EQ SETARO
- *
- NOEARRO MX7 0 MISSING -ENDARROW-
- SA7 A1
- SB1 772 MISSING -ENDARROW-
- RJ =XRJERR
- EQ SETARO
- * /--- BLOCK UNAMX 00 000 80/12/26 14.30
- *
- TITLE UNAMX
- *
- *
- * -UNAMX-
- * SUBROUTINE TO FIND UNIT OR ADD TO *UNAM* TABLE
- * ENTER WITH UNIT NAME IN X6
- *
- * RETURNS WITH NAME IN X1 AND UNIT NUMBER IN X6
- *
- *
- ENTRY UNAMX
- UNAMX EQ *
- SA3 UNUMIN LENGTH OF TABLE
- SX5 X3-IEUNUM NUMBER OF UNITS
- SB5 UNAME+IEUNUM SET BASE ADDRESS FOR SEARCH
- SB3 48
- SB4 X5 SAVE
- SB6 B5 SAVE
- MX7 12
- MX0 59 *** USED BOTH AS MASK AND -1
- SB1 1
- EQ ULOOK
- *
- UBEFORE SB5 A1+B1 RAISE BASE ADDRESS
- NZ X4,ULOOK JUMP IF ODD LENGTH TABLE
- IX5 X5+X0 ELSE SUBTRACT 1 FROM LENGTH
- ULOOK ZR X5,UNOTIN JUMP IF NOT IN TABLE
- BX4 -X0*X5 SAVE BOTTOM BIT
- AX5 1 NARROW SEARCH
- SA1 X5+B5 LOAD ENTRY
- BX2 -X7*X1 CLEAR TOP 12 BITS
- IX2 X2-X6
- NG X2,UBEFORE JUMP IF BEFORE WHERE NAME WOULD BE
- NZ X2,ULOOK JUMP IF AFTER
- AX6 B3,X1 X6 = UNIT NUMBER
- EQ UNAMX
- *
- UNOTIN BX1 X6 X1 = UNIT NAME
- SX7 X3+B1
- SX0 X7-UTABLTH
- PL X0,ERR2MNU ERROR EXIT IF BUFFER FULL
- SA7 A3 ELSE ADD 1 TO LENGTH
- BX6 X3 X6 = UNIT NUMBER
- SA3 LVARL
- NZ X3,UNOTIN1 IF LVARL ALREADY SET
- *
- MX2 6 X2 = MASK FOR TOP CHARACTER
- LX2 60-12
- BX2 X1*X2 X2 = TOP CHARACTER
- ZR X2,UNOTIN1 IF PSEUDO UNIT
- *
- MX7 -1 FLAG -LVARS- ILLEGAL NOW
- SA7 A3
- * /--- BLOCK UNAMX 00 000 80/12/26 14.31
- UNOTIN1 BSS 0
- *
- * SAVE LINE AND BLOCK OF WHERE FIRST REFERENCE OCCURRED
- SA0 UUTEMP
- SA2 LINENUM
- LX7 X2,B3 LEFT SHIFT 48
- SA2 BLKNUM
- BX7 X7+X2 COMBINE BLOCK AND LINE NUMBERS
- LX7 36 POSITION
- SA7 A0
- SA2 AFUREF FIRST UNIT REFERENCE BUFFER
- IX0 X2+X6 ADD UNIT NUMBER
- WE 1
- RJ =XECSPRTY
- *
- SA2 ATEMPEC ADDRESS OF TEMPORARY ECS BUFFER
- BX0 X2
- SA0 B5 WHERE ENTRY SHOULD GO IN TABLE
- SB7 B5-B6
- SB4 B4-B7 NUMBER OF UNITS AFTER IN TABLE
- + WE B4 WRITE REST OF TABLE
- RJ =XECSPRTY
- SA0 A0+B1 RAISE ADDRESS
- LX7 X6,B3 POSITION UNIT NUMBER
- BX7 X7+X1 ADD UNIT NAME
- SA7 B5 PUT THIS WORD IN NAME TABLE
- + RE B4 AND READ REST OF TABLE BACK
- RJ =XECSPRTY
- *
- MX7 1
- BX7 X7+X1 ADD UNIT NAME
- SA7 ULOC+X6 SET ULOC TO SHOW UNIT NOT IN
- *
- BX7 X1 GET UNIT NAME
- SA7 UUTEMP
- SA0 A7 FORM NON-ALPHABETIZED TABLE
- SA2 AUNAME GET ADDRESS OF TABLE IN ECS
- IX0 X2+X6 NOW HAVE UNIT ENTRY
- + WE 1 WRITE OUT UNIT NAME
- RJ ECSPRTY
- EQ UNAMX
- *
- UUTEMP BSS 1
- *
- * DONE--PACK UP COMMAND WORD
- *
- * -WRITEC- COMMAND EXITS HERE WITH X6 SET
- *
- CONUL4 SA1 BRVAR X1 = -GETVAR- CODE, LEFT-ADJUSTED
- SA2 CONV2 X2 = START OF UNIT TABLE
- SA3 CONV3 X3 = NUMBER OF ENTRIES IN TABLE
- SA4 INX INCREMENT EXTRA STORAGE POINTER
- SX7 X4+1
- SA7 A4
- LX2 XCMNDL+12 POSITION TABLE START
- LX3 XCMNDL POSITION NUMBER OF ENTRIES
- BX6 X6+X1
- BX6 X6+X2
- BX6 X6+X3
- EQ ALTCODE --- EXIT TO STORE COMPLETED COMMAND WORD
- *
- *
- BRVAR BSS 1
- CONV2 BSS 1 START OF TABLE OF CONDITIONAL UNITS
- CONV3 BSS 1 COUNT OF UNITS IN TABLE
- CONV4 BSS 1 SHIFT FOR NEXT UNIT PACK
- *
- * /--- BLOCK SLIDE 00 000 79/08/06 01.09
- TITLE -SLIDE- AND -ALTFONT-
- *
- * -SLIDE- COMMAND
- *
- *
- SLIDEC SB1 FSSLIDE -SLIDE- PUBLISH ERROR
- RJ =XPUBERRS
- CALL COMPSYM,SLDCON,1
- EQ CALCODE
- *
- SLDCON VFD 42/7LNOSLIDE,18/1400B
- *
- *
- *
- * -ALTFONT- COMMAND
- *
- *
- AFONTC CALL COMPSYM,ALTNMS,4
- EQ CALCODE
- *
- ALTNMS VFD 42/6LNORMAL,18/0
- + VFD 42/3LALT,18/1
- ONOFF VFD 42/2LON,18/1
- + VFD 42/3LOFF,18/0
- UPDATE VFD 42/6LUPDATE,18/2
- *
- *
- *
- * -CHECKPT- COMMAND
- *
- *
- CKPTC CALL COMPSYM,ONOFF,2
- EQ CALCODE
- *
- *
- * -WRITENS- COMMAND
- *
- WRTNSIN CALL SYSTEST
- CALL COMPSYM,ONOFF,3
- EQ CALCODE
- *
- *
- * /--- BLOCK CALCCIN 00 000 79/12/15 01.18
- *
- * -CALCC- (CODE=34)
- *
- *
- CALCCIN RJ VARDO1 GET FIRST VARIABLE
- X COVL3,13 EXECUTE OVERLAY
- * /--- BLOCK FINIS 00 000 81/07/20 21.38
- TITLE FINIS
- *
- * FINIS (CODE=50)
- *
- * END OF LESSON PROCESSING
- *
- *
- FINISC X JOINOV,6
- * RETURNS TO EXECUTE CONDFIN
- *
- *
- * SET TERM, DEFINE AND COMMON ENTRIES IN THE ULOC
- * TABLE AND WRITE THE EXTERNAL, UNAM AND ULOC TABLES
- * TO THE END OF THE LESSON BINARY. ALSO SETS
- * *CONDPRM* UP WITH THE CONDENSE PARAMETERS AND
- * SEARCHES FOR UNDEFINED UNITS
- *
- ENTRY CONDFIN
- CONDFIN EXEC CFINOV (IN COVLAY1)
- ENTRY MTINIT
- MTINIT BSS 0
- SA1 CMPF SEE IF CMP LESSON
- ZR X1,MTINIT1 IF NOT CMP DONT NOTIFY
- * NOTIFY EXECUTOR WE ARE CONDENSING A CMP LESSON
- SX6 P.CMP PLATO REQUEST CODE FOR CMP
- SA1 APLACOM (X1) = PLATO COMUNICATION AREA
- SX0 PLREQF
- IX0 X0+X1
- WX6 X0 WRITE REQUEST
- MTINIT1 EXEC JOINOV,7 FINISH UP, JUMP TO MTLOAD
- * /--- BLOCK CHAR 00 000 78/07/18 21.51
- TITLE CHAR, END, AND MODE
- * -CHAR- (CODE=47)
- *
- * THE TAG SPECIFIES THE CHARACTER NUMBER (0-127) AND THE
- * 8 DATA WORDS OF 16 BITS EACH COMPOSING THE CHARACTER.
- *
- CHARIN RJ VARDOC CONTINUED COMMA SEPARATED VARIABLES
- SX1 9 9 VARIABLES REQUIRED
- EQ VARFIN PACK UP VARIABLES AND STORE
- *
- *
- *
- * -END- COMMAND (CODE=49)
- *
- ENDIN SA1 TAG X1 = 1ST CHAR OF TAG
- MX6 0 0 FOR SIMPLE END
- ZR X1,PUTCODE JUMP IF NO ARGUMENT (SIMPLE END COMMAND)
- *
- CALL NXTNAME GET TAG *****
- BX1 X6 GET TAG INTO X1
- MX6 0
- SA2 =4LHELP
- BX2 X2-X1 CHECK FOR -HELP-
- ZR X2,PUTCODE SAME AS BLANK TAG
- SA2 =6LLESSON
- BX2 X2-X1 CHECK FOR -LESSON-
- NZ X2,ERRNAME JUMP IF NOT LEGAL TAG
- MX6 1 SET SIGN BIT IF END LESSON
- EQ PUTCODE
- *
- *
- * -MODE- (CODES=51 AND 52)
- *
- * THE LEGAL TAGS ARE THE WORDS -WRITE-,
- * -REWRITE-, -ERASE-, AND -X-.
- *
- *
- * MODEIN SX7 0
- * SA7 JDORMD SET FOR -MODE- COMMAND
- * EQ JUDGEST --- USE ROUTINE SHARED WITH -JUDGE- COMMAN
- TITLE -BACKGND- -FOREGND-
- *
- *
- *
- * -BACKGND- -FOREGND-
- * SPECIFY BACKGROUND OR FOREGROUND PROCESSING MODE
- *
- *
- FORGNDI MX6 0 CLEAR BACKGROUND BIT
- EQ BCKG10
- *
- BCKGNDI MX6 1 SET BACKGROUND BIT
- *
- BCKG10 SX7 BACKG= SET COMMAND CODE
- SA7 COMNUM
- EQ PUTCODE
- *
- *
- * /--- BLOCK SEED/HASH 00 000 86/05/27 13.54
- *
- * -SEED- COMMAND READ-IN
- * SPECIFIES VARIABLE TO BE USED AS SEED FOR
- * RANDOM NUMBER GENERATOR; BLANK TAG FOR STANDARD
- * SYSTEM SEED WORD.
- *
- SEEDC SA1 TAGCNT
- ZR X1,PAUSE2 SET SIGN BIT IF NO TAG
- EQ ONESTOR ELSE ONE STOREABLE ARG
- *
- *
- * -HASH- COMMAND READ-IN
- * FORMAT IS'; HASH INPUT<,OUTPUT,PRIME>
- * IF *OUTPUT* IS OMITED, *INPUT* MUST BE STOREABLE.
- * *OUTPUT* MUST BE STOREABLE IF SPECIFIED.
- * *PRIME* IS EITHER KEYWORD <PASSWORD> OR SYMBOL.
- *
- HASHIN RJ VARDO1 INIT AND GET FIRST TAG
- SA1 LASTKEY CHECK FOR MORE TAGS
- NZ X1,HASH2 -- IF MORE TAGS
- NG X6,ERRSTOR -- IF ONLY TAG, MUST BE STORABL
- EQ MRKLAST -- ELSE OK, EXIT
- HASH2 BSS 0
- RJ VARDO2 GET SECOND TAG
- NG X6,ERRSTOR -- MUST BE STOREABLE
- SA1 LASTKEY CHECK FOR OPTIONAL TAG
- ZR X1,MRKLAST -- 2-TAG FORMAT, EXIT
- SA1 SYSFLG CHECK FOR SYSTEM LESSON
- LX1 ZSLDSHF
- PL X1,HASH3 -- NOT A SYSTEM LESSON
- RJ NXTNAMP GET THE NEXT TOKEN
- SA2 HASHKEY LITERAL STRING *PASSWORD*
- MX1 48 MASK TO 8 CHARACTERS
- BX2 X2-X6 COMPARE
- BX2 X1*X2
- NZ X2,HASH3 -- NOT *PASSWORD* KEYWORD
- SA1 VARBUF+2 RETRIEVE SECOND VAR CODE
- MX6 1 SET 2ND OF TOP TWO BITS TO
- LX6 XCODEL-1 INDICATE *PASSWORD* KEYWORD
- BX6 X1+X6
- SA6 A1 REWRITE WORD IN VARBUF
- EQ MRKLAST -- EXIT
- HASH3 BSS 0
- RJ VARDO2 GET THIRD TAG
- SA1 LASTKEY
- NZ X1,ERR2MNY -- TOO MANY ARGUMENTS
- EQ MRKLAST -- EXIT
- *
- HASHKEY DATA 8LPASSWORD KEYWORD FOR SIGNON PASSWORDS
- *
- *
- * /--- BLOCK SHOWA,O,H 00 000 78/09/02 00.28
- TITLE SHOWA, SHOWO, AND SHOWH CONDENSE
- *
- EXT ARAYFLG
- *
- *
- SHOWAIN SB1 FSSHOWA -SHOWA- TEXT
- RJ =XPUBTEXT
- SX7 10 SET DEFAULT
- RJ SHOWAGO
- EQ PUTCODE
- *
- SHOWOC SX7 21 DEFAULT=21
- RJ SHOWAGO
- MX0 1
- BX6 -X0*X6 CLEAR LITERAL FLAG FOR SHOWO
- EQ PUTCODE
- *
- SHOWHC SX7 16 DEFAULT=16
- RJ SHOWAGO
- MX0 1
- BX6 -X0*X6 CLEAR LITERAL FLAG FOR SHOWH
- EQ PUTCODE
- *
- SHOWAGO EQ * ENTRY/EXIT LINE
- SX6 1
- SA6 ARAYFLG ALLOW -SHOW ARRAY-
- SA7 OPTAO SAVE DEFAULT
- RJ VARDO
- SB1 -1
- SA1 VARBUF
- SA2 A1-B1 VARBUF+1
- BX3 X2 CHECK FOR LITERALS
- MX0 61-XCODEL+XFBIT MASK OUT I/F BIT
- BX2 -X0*X2
- LX2 60-XCODEL SHIFT INTO PLACE
- MX0 1
- BX0 X0*X3 PRESERVE STOREABLILITY FLAG
- BX2 X0+X2 FLAG BY SETTING SIGN BIT
- SX1 X1+B1 NUMBER OF ARGS -1
- SA3 OPTAO
- ZR X1,SHOWA2
- SX1 X1+B1
- NZ X1,ERR2MNY MUST BE ONE OR TWO ARGS
- SA3 A2-B1 VARBUF+2
- MX0 60-XCODEL
- BX3 -X0*X3
- SHOWA2 LX3 60-2*XCODEL
- BX6 X2+X3
- EQ SHOWAGO
- OPTAO EQU VARBUF+3 NO MORE THAN TWO ARGUMENTS
- * /--- BLOCK GROUP TEMP 00 000 83/06/13 11.03
- TITLE TEMPORARY KLUDGE FORM OF -GROUP-
- *
- GROUPIN SB1 FSGROUP -GROUP- PUBLISH WARNING
- RJ =XPUBWARN
- RJ NXTNAMP GET FIRST WORD IN TAG
- SA1 INDENT INDENT COUNT FOR THIS LINE
- SA2 PISTACK POINTER TO TOP OF INDENT STACK
- IX2 X2-X1 COMPARE INDENT AND STACK LEVELS
- ZR X2,ONESTOR CONDENSE AS -COURSE- COMMAND
- CALL CHKIND OUTPUT ERROR MESSAGES AND FIX THE STACK UP
- EQ ONESTOR CONTINUE CONDENSE
- *
- *
- REMOVLC SB1 FSREMOV -REMOVL- PUBLISH ERROR
- RJ =XPUBERRS
- EQ ONEARG
- *
- NAMEC SB1 FSNAME -NAME- PUBLISH WARNING
- RJ =XPUBWARN
- EQ ONESTOR
- *
- PLAYC SB1 FSPLAY -PLAY- PUBLISH ERROR
- RJ =XPUBERRS
- EQ TRIARG
- *
- RECRDIN SB1 FSRECOR -RECORD- PUBLISH ERROR
- RJ =XPUBERRS
- EQ TRIARG
- *
- CODOUTC SB1 FSCODEO -CODEOUT- PUBLISH ERROR
- RJ =XPUBERRS
- EQ ONEARG
- *
- AUDIOC SB1 FSAUDIO -AUDIO- PUBLISH ERROR
- RJ =XPUBERRS
- EQ ONEARG
- *
- EXTC SB1 FSEXT -EXT- PUBLISH ERROR
- RJ =XPUBERRS
- EQ ONE2IN
- *
- TEXTIN SB1 FSTEXT -TEXT- TEXT
- RJ =XPUBTEXT
- *
- * PROCESS VARIABLE (2 OR 3) TAGS
- *
- + RJ VARDO
- SA1 VARBUF+1 CHECK FIRST ARG
- NG X1,ERRSTOR MUST BE STOREABLE LOCATION
- SA1 VARBUF GET NUMBER OF ARGS
- SX2 X1-2 2 ARGS IS OK
- ZR X2,MRKLAST
- SX2 X1-3 3 ARGS IS OK
- ZR X2,MRKLAST
- EQ ERRTAGS WRONG NUMBER OF TAGS
- *
- * /--- BLOCK ANSV 00 000 79/01/05 02.19
- TITLE -ANSV- COMMAND READ-IN
- *
- *
- *
- * -ANSV- COMMAND READ-IN
- *
- * FORMAT OF COMMAND WORD -
- * TOP *XCODEL* BITS = -GETVAR- CODE FOR ANSWER
- * NEXT *XCODEL* BITS = -GETVAR- CODE FOR TOLERANCE
- * NEXT 1 BIT = 0/1 FOR ABS/PERCENT TOLERANCE
- * NEXT XX BITS = UNUSED BY -ANSV-
- * (FOR -ANSU-, THESE BITS ARE A POINTER+1 TO
- * THE DIMENSION ARRAY. POINTER HAS 1 ADDED TO
- * IT TO INSURE IT BE NZ, TO DISTINGUISH ANSU.)
- * LAST *XCMNDL* BITS = COMMAND CODE NUMBER
- *
- *
- EXT COMPILU COMPILE UNIT DIMENSIONS
- WRGUIN SX6 WRONGV= WRONGU SAME COMND NUM AS WRONGV
- EQ ANSVIN0
- *
- ANSUIN SX6 ANSV= ANSU SAME COMMAND NUM AS ANSV
- EQ ANSVIN0
- *
- ANSVIN MX6 0
- ANSVIN0 SA6 OVARG2 NZ FOR -ANSU-/-WRONGU-
- X COVL3,4
- * /--- BLOCK PUTV 00 000 81/07/08 03.30
- TITLE PUTV
- * -PUTV- (CODE=210)
- *
- * 1ST TAG ENTRY = STARTING VARIABLE FOR CHAR
- * STRING TO SEARCH FOR, 2ND TAG ENTRY = NUMBER
- * OF CHARS, 3RD TAG ENTRY = STARTING VARIABLE
- * FOR REPLACEMENT CHAR STRING, 4TH TAG ENTRY =
- * NUMBER OF CHARS IN IT.
- * FIRST AND THIRD TAGS MUST BE VARIABLES
- *
- PUTVC RJ VARDO COMMA SEPARATED VARIABLES
- SA1 VARBUF+1
- NG X1,ERRSTOR IF FIRST TAG NOT A VARIABLE
- SA1 VARBUF+3
- NG X1,ERRSTOR IF THIRD TAG NOT A VARIABLE
- SX1 4 MUST BE 4 VARIABLES
- EQ VARFIN
- *
- *
- SSTARIN SX6 FINIS=
- SA6 COMNUM SET TO *FINIS* COMMAND NUMBER
- SA1 HOLFIN
- BX6 X1
- SA6 COMMAND
- EQ FINISC TREAT LIKE *FINIS*
- *
- *
- * /--- BLOCK OK 00 000 79/12/15 01.18
- TITLE OK,NO,IGNORE,STORAGE,GETCHAR
- * -OK- (CODE=127)
- *
- OKIN SX6 1 SET TO -OK- CODE
- *
- OKINN SX1 OK= NUMBER OF -OK- COMMAND
- LX6 XCMNDL UP OVER COMMAND CODE
- BX6 X1+X6 COMBINE COMMAND CODE WITH SPECIFIER
- SA1 TAG
- ZR X1,ALTCODE JUMP IF BLANK TAG
- EQ ERR2MNY ELSE ERROR
- *
- * THE -NO- AND -IGNORE- COMMANDS USE THE SAME
- * COMMAND CODE NUMBER AS THE -OK- COMMAND.
- *
- NOIN SX6 2 SET TO -NO- CODE
- EQ OKINN
- *
- IGIN SX6 3 SET TO -IGNORE- CODE
- EQ OKINN
- * -REGSTATE- COMMAND.
- RGIN RJ SYSTEST CHECK IF SYSTEM LESSON
- SX6 4 SET TO -REGSTATE- CODE
- EQ OKINN
- *
- *
- * -GETCHAR- COMMAND
- *
- GETCHRC CALL SYSTEST SYSTEM LESSONS ONLY
- CALL FILEBLK GET ACCOUNT, FILE, BLOCK
- CALL VARDOR GET LAST ARGUMENT
- SA1 VARBUF+4
- NG X1,ERRSTOR 4TH ARGUMENT MUST BE STOREABLE
- SX1 4 4 ARGUMENTS LEGAL
- EQ VARFIN
- * /--- BLOCK CSETIN 00 000 80/02/02 01.18
- TITLE CHARSET LINESET MICRO
- *
- *
- *
- * ROUTINE FOR COMMANDS WITH TAGS THAT SPECIFY
- * A LESSON AND BLOCK NAME ONLY, AND ALSO ALLOW
- * BLANK TAGS.
- *
- * USED BY CHARSET, LINESET, MICRO
- *
- *
- CSETIN BSS 0
- CALL FILEBLK GET LESSON AND BLOCK NAME
- ZR X1,PAUSE2 IF BLANK TAG
- SA2 LASTKEY
- ZR X2,VARFIN IF END OF LINE
- EQ ERR2MNY ERROR IF MORE THAN 2 ARGUMENTS
- *
- *
- *
- * ROUTINE FOR COMMANDS WITH TAGS THAT SPECIFY
- * A LESSON AND BLOCK NAME ONLY. BLANK TAGS
- * ARE NOT ALLOWED.
- *
- * USED BY CHARTST
- *
- *
- CHARTST CALL FILEBLK GET LESSON AND BLOCK NAME
- ZR X1,ERR2FEW ERROR IF BLANK TAG
- SA2 LASTKEY
- ZR X2,VARFIN IF END OF LINE
- EQ ERR2MNY ERROR IF MORE THAN 2 ARGUMENTS
- *
- * /--- BLOCK CSETIN 00 000 80/02/02 01.18
- *
- *
- * -LESLIST- AND -SYSLIST- COMMANDS
- *
- * FIRST TWO ARGUMENTS SPECIFY LESSON AND BLOCK NAME
- * OPTIONAL THIRD ARGUMENT SPECIFIES CODEWORD
- *
- SLISTIN CALL SYSTEST -SYSLIST- COMMAND
- *
- LLISTIN BSS 0 LESLIST, SYSLIST
- CALL FILEBLK GET LESSON AND BLOCK NAME
- ZR X1,PAUSE2 IF BLANK TAG
- SA2 LASTKEY
- ZR X2,MRKLAST IF ONLY 2 ARGUMENTS
- CALL VARDO2 GET CODEWORD ARGUMENT
- SA2 LASTKEY
- ZR X2,MRKLAST
- EQ ERR2MNY ERROR IF MORE THAN 3 ARGUMENTS
- *
- * -USE- *** WARNING *** THIS IS ONLY
- * FOR DISCARDING BAD -USE- COMMANDS
- *
- * THE ACTUAL PROCESSING FOR -USE- IS DONE IN
- * GETLINE,USEC
- *
- USEEC EQ NXTLINE IGNORE BAD -USE- COMMAND
- *
- *
- * /--- BLOCK PPT 00 000 79/12/15 01.18
- * THE CONDENSE ROUTINES FOR OTHER *PPT* TYPE COM-
- * MANDS ARE IN OVERLAY *PPTC*.
- * -MODESET- AND -BITSOUT-
- MDBITIN RJ PPTMESS
- EQ ONEARG
- * -PPTOUT-
- PPTOUTC RJ PPTMESS
- X COV4A,7 EXECUTE OVERLAY
- * -PPTADDR-
- PPTADDC RJ PPTMESS
- EQ ONE2IN0
- * -PPTRUN-
- PPTRUNC RJ PPTMESS
- EQ ONE2IN0
- ** PPTMESS - ISSUE *PPT* ERROR MESSAGE.
- *
- * THE FIRST CHECK FOR ACCESS TO *PPT* COMMANDS IS
- * IN THE INITIALIZATION ROUTINES IN *COVLAY2*. THE
- * *PPTACC* FLAG IS SET AT THAT TIME.
- *
- * IF ACCESS IS ALLOWED, A WARNING MESSAGE IS ISSUED
- * AT THE FIRST OCCURANCE OF A PROGRAMMABLE TERMINAL
- * COMMAND, UNLESS THE LESSON HAS THE *SYS* OR *PPT*
- * ATTRIBUTE MARKED IN DECK *SYSLESS*.
- *
- * ENTRY (PPTACC) = -1 IF LESSON CAN USE PPT COMDS;
- * = 0 OTHERWISE.
- * (PPTMF) = 0 IF PPT WARNING MESSAGE HAS NOT
- * BEEN ISSUED YET;
- * = -1 OTHERWISE.
- * (SYSFLG) = WORD WITH *PPT* ATTRIBUTE BIT.
- *
- * ERROR TO *ERRORC* IF (PPTACC) = 0.
- *
- * CALLS RJERR.
- ENTRY PPTMESS
- PPTMESS PS
- SA1 PPTACC CHECK PPT ACCESS FLAG
- PL X1,ERRORC IF NOT ALLOWED
- SA1 PPTMF
- NZ X1,PPTMESS IF PPT MESSAGE ALREADY ISSUED
- MX6 -1
- SA6 A1
- * NOTE - LESSONS WITH THE *SYS* ATTRIBUTE ALWAYS
- * HAVE THE *PPT* ATTRIBUTE, SO ONLY THE *PPT* BIT
- * NEEDS TO BE CHECKED.
- SA1 SYSFLG
- LX1 ZPPTSHF SHIFT *PPT* BIT INTO POSITION
- NG X1,PPTMESS IF LESSON HAS *PPT* ATTRIBUTE
- SB1 767
- RJ =XRJERR ISSUE THE PPT WARNING MESSAGE
- EQ PPTMESS
- ENTRY PPTACC,PPTMF
- PPTACC BSS 1 *PPT* COMMAND ACCESS FLAG
- PPTMF BSS 1 *PPT* WARNING MESSAGE FLAG
- * /--- BLOCK OVERLAYS 00 000 79/12/15 01.18
- TITLE CONDENSOR OVERLAY CALLS
- *
- * -SAY-
- *
- SAYIN SB1 FSSAY -SAY- PUBLISH ERROR
- RJ =XPUBERRS
- .SAYCMD IFNE SAYASSM,0
- SA1 SAYFLAG
- SX6 2 TO SET OVARG1 IN PCIN100
- SAYIN1 SA3 SAYFLAG COLLECT OLD VALUE FROM SAYFLAG
- SX7 1 PUT A 1 IN X7
- BX3 X3+X7 LOGICAL SUM SAYFLAG W/ BIT0 SET
- SX7 X3 ONLY 6,7 CAN WRITE CM
- SA7 A1 NEW VALUE OUT TO SAYFLAG
- SA6 OVARG1
- X PACKOV USE -PACK- SUBCONDENSOR
- EQ ERRORC
- .SAYCMD ELSE
- SAYIN1 EQ =XNXTLINE IGNORE THIS COMMAND
- .SAYCMD ENDIF
- *
- SAYCIN SB1 FSSAY -SAY- PUBLISH ERROR
- RJ =XPUBERRS
- .SAYCMD IFNE SAYASSM,0
- SA1 SAYFLAG
- SX6 3 TO SET OVARG1 IN PCIN100
- .SAYCMD ENDIF
- EQ SAYIN1
- *
- * -SAYLANG-
- *
- .SAYCMD IFNE SAYASSM,0
- SAYLGIN SX6 1 SAYLANG
- SA1 SAYFLAG COLLECT CURRENT VALUE IN X1
- SX7 2 MARK PRESENCE
- BX7 X1+X7 MERGE LOGICALLY
- SA7 A1 SHIP BACK OUT INTO SAYFLAG
- SA1 TAG SEE IF BLANK TAG
- NZ X1,TAGOVIN
- MX6 0 BLANK SAYLANG
- EQ PUTCODE
- *
- TAGOVIN SA6 OVARG1
- X TAGOV
- .SAYCMD ELSE
- SAYLGIN EQ SAYIN1
- .SAYCMD ENDIF
- * /--- BLOCK NXTNAM 00 000 80/12/26 14.34
- TITLE -NXTNAM-
- *
- * -NXTNAM-
- *
- * ON EXIT,
- * X6 = NEXT TAG ENTRY (ZERO-FILLED)
- * X1 = SEPARATOR CHARACTER
- * X2 = SEPARATOR TYPE CODE (SEE LEX)
- *
- * WORDPT WILL POINT TO NEXT CHARACTER AFTER TAG
- *
- * ERROR CONDITIONS';
- * MORE THAN 10 CHARACTERS--X1 IS SET TO
- * 11TH CHAR, X2 IS SET TO KEYTYPE OR
- * ELSE IS SET TO 0 (BLANK AND BACKSPACE).
- *
- ENTRY NXTNAM
- *
- NXTNAM EQ *
- CALL NXTNAMP GET NEXT TAG W/O WORDPT UPDATE
- SX7 B1 B1 HAS UPDATED WORDPT ADDRESS
- SA7 WORDPT UPDATE WORDPT
- EQ NXTNAM --- EXIT
- *
- *
- * -NXTNAMP-
- *
- * OBTAINS THE NEXT TAG (OR 10 CHARACTERS, WHICHEVER
- * COMES FIRST) WITHOUT UPDATING THE CURRENT LINE
- * POINTER, WORDPT.
- *
- * ON EXIT,
- * B1 = POINTER TO NEXT CHARACTER AFTER TAG
- * X6 = NEXT TAG ENTRY (ZERO-FILLED)
- * X1 = SEPARATOR CHARACTER
- * X2 = SEPARATOR TYPE CODE (SEE LEX)
- * B7 = POINTER TO FIRST CHAR OF NEXT TAG (IF THERE)
- *
- * ERROR CONDITIONS';
- * MORE THAN 10 CHARACTERS--X1 IS SET TO
- * 11TH CHAR, X2 IS SET TO KEYTYPE OR
- * ELSE IS SET TO 0 (BLANK AND BACKSPACE).
- *
- ENTRY NXTNAMP
- *
- NXTNAMP EQ *
- SA1 WORDPT POINTER TO NEXT CHAR
- MX6 0
- SB1 X1
- SB2 60 INITIALIZE SHIFT
- SB7 1 CONSTANT
- *
- SKPSP SA1 B1 SKIP LEADING SPACES
- SX2 X1-1R CODE FOR SPACE
- NZ X2,NNLOOP JUMP IF NOT A SPACE
- SB1 B1+1
- EQ SKPSP
- *
- NNLOOP SA1 B1 LOAD NEXT CHARACTER
- SB1 B1+B7
- SX2 X1-1R ALLOW EMBEDDED SPACES
- ZR X2,NLL2
- SX2 X1-KBKSP
- ZR X2,NLL2
- SA2 X1+KEYTYPE GET CHARACTER TYPE
- SX3 X2-1
- PL X3,NNDONE JUMP IF SEPARATOR
- * /--- BLOCK NXTNAM 00 000 80/12/26 14.34
- *
- NLL2 SB2 B2-6
- NG B2,NBADN EXIT IF NAME TOO BIG
- LX1 X1,B2 POSITION CHAR
- BX6 X6+X1 ADD TO WORD BUILDING
- EQ NNLOOP
- *
- NNDONE SB7 B1 FOR ROUTINES WHICH NEED EOL
- NZ X1,NXTNAMP --- EXIT IF NOT END-OF-LINE
- SB1 B1-1 BACKUP BEFORE END-OF-LINE
- EQ NXTNAMP --- EXIT
- *
- NBADN MX6 0 RETURN A 0 NAME
- EQ NNDONE
- *
- *
- * -NXTNAME-
- * GETS NEXT NAME IN X6, SEPARATOR CODE/TYPE IN X1,X2
- * REMOVES EXTRA SPACES FROM END OF NXTNAM
- *
- ENTRY NXTNAME
- NXTNAME EQ *
- RJ NXTNAM SEE ABOVE
- LT B2,B0,NXTNAME EXIT IF TOO LONG
- NXTNAM2 MX7 -6 MASK FOR 1 CHAR
- LX7 X7,B2 SHIFT TO LAST CHAR POSITION
- SX3 1R SPACE
- LX3 X3,B2 ALSO SHIFT
- BX0 -X7*X6 EXTRACT CHAR
- IX3 X3-X0 TEST FOR SPACE
- NZ X3,NXTNAME EXIT IF NOT
- BX6 X7*X6 CLEAR OUT SPACE
- SB2 B2+6 SHIFT FOR PREVIOUS CHAR
- EQ NXTNAM2 TRY AGAIN
- * /--- BLOCK FILEACC 00 000 80/12/26 10.44
- TITLE -ACCFILE- GET ACCOUNT AND FILE NAMES
- *
- * -ACCFILE-
- *
- * ROUTINE TO GET ACCOUNT AND FILE ARGUMENTS.
- * ENTER'; B1 = ADDRESS OF TWO-WORD BUFFER WHERE
- * GETVAR CODES WILL BE STORED
- * B2 INDICATES HOW TAGS SHOULD BE INTERPRETED
- * = -1 IF ONLY LITERALS ALLOWED (FOR CONDENSE-TIME COMMANDS)
- * 0 IF NAMES INTERPRETED AS LITERALS
- * 1 IF NORMAL TUTOR EXPRESSIONS
- *
- * RETURN INFORMATION CONSISTS OF EITHER GETVAR CODES
- * (IF B2 = 0 OR 1) OR ACTUAL NAMES (IF B2 = -1). ACCOUNT
- * IS STORED IN THE FIRST WORD OF THE RETURN BUFFER, FILE
- * IN THE SECOND WORD. ZEROES ARE RETURNED FOR BLANK
- * ARGUMENTS.
- *
- * EXIT'; X1 = NUMBER OF EXPLICIT ARGUMENTS FOUND
- * 0 IF BLANK TAG
- * 1 IF FILE NAME ONLY
- * 2 IF ACCOUNT';FILE OR LESLIST REFERENCE
- *
- * WARNING -- THE -RECORDS- AND -ATTACHF- COMMANDS
- * HAVE THEIR OWN ROUTINES FOR CONDENSING FILE NAMES.
- *
- * /--- BLOCK FILEACC 00 000 80/12/26 10.45
- *
- ENTRY ACCFILE
- ACCFILE EQ *
- SX6 B1
- SA6 ACFOUT SAVE ADDRESS OF RETURN BUFFER
- SX6 B2
- SA6 ACFLIT SAVE LITERALS FLAG
- *
- * SKIP LEADING SPACES
- *
- SB1 1 SET UP INCREMENT FOR LOOPS
- SA1 WORDPT X1 = ADDRESS OF NEXT CHARACTER
- SX6 X1-1
- ACF10 SX6 X6+B1 POINT TO NEXT CHARACTER
- SA2 X6 (X2) = NEXT CHARACTER
- SX0 X2-1R CHECK FOR BLANK
- ZR X0,ACF10 LOOP TO SKIP LEADING SPACES
- *
- ZR X2,ACF45 JUMP IF END OF LINE
- SA3 X2+KEYTYPE
- SX0 X3-OPCOMMA CHECK FOR SEPARATOR
- ZR X0,ACF40 JUMP IF SEPARATOR
- * LOG EXTERNAL REFERENCE FOR -CONDENS- COMMAND
- SA6 WORDPT SAVE CHARACTER POINTER
- SB2 TAG POINTER TO START OF LINE
- SB1 X6
- SB1 B1-B2 (B1) = RELATIVE CHAR POSITION
- SB2 CEXTS CODE FOR EXTERNAL REFERENCE
- CALL PLOGLIN LOG THIS LINE
- SA3 ACFLIT RETRIEVE LITERALS FLAG
- NG X3,ACF20 SKIP LESLIST CHECK IF LITERALS ONLY
- SA1 WORDPT RETRIEVE POINTER
- SA2 X1+ (X2) = CURRENT CHARACTER
- SX0 X2-KLT CHECK FOR LESLIST BRACKET
- ZR X0,ACFLL JUMP IF LESLIST REFERENCE
- *
- * CHECK FOR COLON (INDICATES ACCOUNT ARG IS PRESENT)
- *
- ACF20 CALL COLONCK
- NZ X6,ACF30 IF ACCOUNT NOT SPECIFIED
- *
- *////// TEMPORARY -- ACCOUNT NAME LEGAL ONLY IN SYSTEM LESSONS
- SA1 SYSFLG
- LX1 ZSLDSHF
- PL X1,ERRNAME ERROR IF NOT SYSTEM LESSON
- *////// END TEMPORARY
- RJ ACFNAM COMPILE ACCOUNT NAME
- RJ ACCFILC CONVERT SPECIAL ACCOUNT NAMES
- SA1 ACFOUT X1 = ADDRESS OF RETURN BUFFER
- SA6 X1 STORE ACCOUNT GETVAR CODE
- *
- RJ ACFNAM COMPILE FILE NAME
- SA1 ACFOUT ADDRESS OF RETURN BUFFER
- SA6 X1+1 STORE FILE IN SECOND WORD
- *
- SX1 2 2 ARGUMENTS FOUND
- EQ ACCFILE
- * /--- BLOCK FILEACC 00 000 80/12/26 10.46
- *
- * ACCOUNT NAME BLANK
- *
- ACF30 RJ ACFNAM GET FILE NAME
- SA1 ACFOUT ADDRESS OF RETURN BUFFER
- SA6 X1+1 STORE IN SECOND WORD
- MX6 0 SET ACCOUNT NAME TO ZERO
- RJ ACCFILC CONVERT ACCOUNT NAME
- SA6 X1
- *
- SX1 1 1 ARGUMENT FOUND
- EQ ACCFILE
- *
- * ACCOUNT AND FILE BOTH BLANK
- *
- ACF40 SX6 X6+1 ADVANCE PAST SEPARATOR
- SA6 WORDPT
- ACF45 BX6 X2 GET LAST CHARACTER EXAMINED
- SA6 LASTKEY UPDATE *LASTKEY*
- SA1 ACFOUT ADDRESS OF RETURN BUFFER
- MX6 0
- SA6 X1 STORE TWO ZERO CODES
- SA6 X1+1
- SX1 0 NO ARGUMENTS
- EQ ACCFILE
- *
- * LESLIST REFERENCE -- STORE LESLIST INDEX AS FIRST GETVAR
- * CODE AND SPECIAL LESLIST INDICATOR AS SECOND GETVAR CODE
- *
- ACFLL SX1 X1+1 ADVANCE PAST LEFT BRACKET
- BX6 X1
- SA6 WORDPT
- SX0 KGT SCAN FOR RIGHT BRACKET
- CALL PSCAN
- SX0 X1-KGT
- NZ X0,ERRTERM ERROR IF NO RIGHT BRACKET
- SX6 1R
- SA6 B1 BLANK OUT RIGHT BRACKET
- CALL COMPILE COMPILE LESLIST INDEX
- BX6 X1
- SA1 ACFOUT ADDRESS OF RETURN BUFFER
- SA6 X1 STORE GETVAR CODE FOR INDEX
- SA1 ACFLLC X1 = SPECIAL LESLIST INDICATOR
- BX6 X1
- SA6 A6+1
- *
- SX1 2 PRETEND 2 ARGUMENTS FOUND
- EQ ACCFILE
- *
- *
- ACFLLC VFD 60/LLCODE SPECIAL GETVAR CODE FOR LESLISTS
- ACFOUT BSS 1 SAVED ADDRESS OF RETURN BUFFER
- ACFLIT BSS 1 LITERALS FLAG
- *
- * /--- BLOCK FILEACC 00 000 80/12/26 10.47
- *
- *
- * ROUTINE CALLED BY -ACCFILE- TO COMPILE A NAME
- * CALLS NXTNAM, COMPNAM, OR COMPILE BASED ON THE
- * VALUE OF THE LITERALS FLAG. NAME OR GETVAR CODE
- * IS RETURNED IN X6.
- *
- ACFNAM EQ *
- SA1 ACFLIT RETRIEVE LITERALS FLAG
- NG X1,ACFNAM1 JUMP IF LITERALS ONLY
- ZR X1,ACFNAM2 JUMP IF LITERAL OR EXPRESSION
- *
- CALL COMPILE NORMAL EXPRESSION
- BX6 X1
- EQ ACFNAM
- *
- ACFNAM1 CALL NXTNAM LITERALS ONLY (RETURN NAME)
- EQ ACFNAM
- *
- ACFNAM2 SX6 0 ZERO FILL NAME
- SA6 IFILL
- CALL COMPNAM LITERAL OR EXPRESSION
- BX6 X1
- EQ ACFNAM
- *
- * /--- BLOCK FILEACC 00 000 80/12/26 10.47
- *
- *
- * -ACCFILC-
- *
- * CONVERTS SPECIAL ACCOUNT NAMES TO A USEABLE FORM.
- * KEYWORD *'LESSON* IS CONVERTED TO THE ACCOUNT OF THE
- * CURRENT LESSON. KEYWORD *'OLD* IS CONVERTED TO A
- * NULL ACCOUNT NAME WITH THE ORIGINAL FILE FLAG SET.
- * ACCOUNT NAMES LONGER THAN 7 CHARACTERS ARE CONVERTED
- * TO ZERO.
- *
- * CONVERSIONS ARE DONE ONLY IF *ACCFILE* IS CALLED
- * IN LITERALS-ONLY MODE.
- *
- * ENTER'; X6 = ACCOUNT SPECIFIED BY USER
- * EXIT'; X6 = CONVERTED ACCOUNT NAME
- *
- * A SIMILAR ROUTINE BY THE SAME NAME EXISTS IN EXEC1.
- *
- ACCFILC EQ *
- SA2 ACFLIT GET LITERALS FLAG
- PL X2,ACCFILC EXIT IF GENERATING GETVAR CODES
- *
- ZR X6,ACFOLD FOR NOW, ZERO MEANS OLD-STYLE
- SA2 AKOLD KEYWORD OLD
- IX2 X6-X2
- ZR X2,ACFOLD
- *
- SA2 AKLESS KEYWORD LESSON
- IX2 X6-X2
- ZR X2,ACFLES
- *
- MX2 -18
- BX2 -X2*X6 LOOK AT LOWER 18 BITS
- ZR X2,ACCFILC OKAY IF LOW 18 BITS ZERO
- SX6 0 DO NOT ALLOW MORE THAN 7 CHARS
- EQ ACCFILC
- *
- ACFOLD MX6 1
- LX6 18 SET ORIGINAL FILE FLAG
- EQ ACCFILC
- *
- ACFLES SA1 ACCOUNT ACCOUNT OF CURRENT LESSON
- BX6 X1
- EQ ACCFILC
- *
- *
- AKOLD DATA 0L'OLD FOR OLD-STYLE FILE REFERENCES
- AKLESS DATA 0L'LESSON FOR ACCOUNT OF CURRENT LESSON
- *
- * /--- BLOCK FILEACC 00 000 80/12/26 10.48
- *
- *
- * -ACCFILF-
- *
- * ROUTINE TO GET ACCOUNT AND FILE NAMES FROM FIRST
- * TWO ARGUMENTS OF A COMMAND. INITIALIZES *VARBUF*
- * AND STORES GETVAR CODES IN FIRST TWO WORDS.
- *
- ENTRY ACCFILF
- ACCFILF EQ *
- SX6 2 2 ARGUMENTS
- SA6 VARBUF
- CALL ACCFILE,VARBUF+1,0
- EQ ACCFILF
- *
- *
- * -FILEBLK-
- *
- * ROUTINE TO GET ACCOUNT, FILE, AND BLOCK NAMES
- * FROM FIRST 3 ARGUMENTS OF A COMMAND. INITIALIZES
- * *VARBUF* AND STORES GETVAR CODES IN FIRST THREE
- * WORDS.
- *
- * EXIT'; X1 = NUMBER OF ARGUMENTS
- * 0 IF BLANK TAG
- * 3 IF NON-BLANK
- *
- ENTRY FILEBLK
- FILEBLK EQ *
- CALL ACCFILE,VARBUF+1,0
- SA2 LASTKEY CHECK FOR END OF LINE
- ZR X2,FBEOL JUMP IF SO
- *
- CALL COMPNAM COMPILE BLOCK NAME
- *
- FILEB1 BX6 X1
- SA6 VARBUF+3 STORE GETVAR CODE
- SX1 3 INDICATE 3 ARGUMENTS
- BX6 X1
- SA6 VARBUF
- EQ FILEBLK
- *
- FBEOL ZR X1,FILEBLK EXIT IF BLANK TAG (X1 SET BY ACCFILE)
- SX1 X1-2 SEE IF 2 ARGUMENTS FOUND IN ACCFILE
- ZR X1,ERR2FEW ERROR IF SO
- *
- * IF ONLY ONE ARGUMENT IT MUST BE BLOCK NAME
- *
- SA1 VARBUF+2 GET FILE CODE RETURNED BY ACCFILE
- MX6 0
- SA6 A1 ZERO FILE NAME ARGUMENT
- EQ FILEB1
- *
- * /--- BLOCK TERM 00 000 76/07/17 06.20
- TITLE TERM
- * TERM (NOT AN EXECUTABLE COMMAND--BUILDS TABLE)
- *
- * TERM KEEPS TABLE BACKWARDS IN ECS (TERMBUF)
- *
- NOWTERM BSS 1
- TERMFLG BSS 1 TOP BIT = 1 IF TERMOP
- *
- *
- TERMOPC MX6 1 TOP BIT FLAG FOR TERMOP
- EQ TERMC1
- *
- TERMC MX6 0 CLEAR TOP BIT FLAG FOR TERM
- *
- TERMC1 SA6 TERMFLG
- SB1 FSTERM -TERM- IS PUBLISH ERROR
- RJ =XPUBERRS
- *
- SA1 TAGCNT X1 = TAG LENGTH
- SB1 X1-9
- PL B1,ERRNAME --- ERROR IF MORE THAN 8 CHARS
- SB1 1 B1 = CONSTANT 1
- SA5 TERMS PRESENT NUMBER OF TERMS TO X5
- * BOUNDS CHECK TO BE MADE HERE IF DIFFERENT BUFFER USED
- SX7 X5+B1
- SX6 X7-MAXTERM
- PL X6,TERMERR --- ERROR IF TOO MANY TERMS
- SA7 A5 STORE NEW TABLE LENGTH
- MX6 0 PRE-CLEAR TERM NAME
- ZR X1,TERMC2 CATCH-ALL TERM IF NO TAG
- SB2 0
- *
- TERMLP SA1 TAG+B2 LOAD CHAR
- LX6 6
- BX6 X6+X1 ADD ON CHAR
- SB2 B2+B1
- NZ X1,TERMLP
- SB3 10
- TLLP LX6 6
- SB2 B2+B1
- NE B2,B3,TLLP LEFT JUSTIFY TERM
- *
- * SET UP UNIT NUMBER TO BRANCH TO WHEN TERM USED.
- *
- TERMC2 SA1 UNUMON
- BX6 X6+X1 ADD ON UNIT NUM
- LX6 -12 12 UNIT BITS TO TOP
- SA2 TERMFLG TOP BIT FLAG FOR TERMOP
- BX6 X6+X2
- SA6 NOWTERM PREPARE FOR SINGLE ECS WRITE
- SA2 TERMEND ADDRESS OF END OF BUFFER
- IX0 X2-X5
- SA0 A6
- + WE 1 WRITE OUT SINGLE TERM
- RJ ECSPRTY
- EQ NXTLINE
- *
- *
- TERMERR SX6 1 FLAG ERROR MESSAGE PRESENT
- SA6 TFORMOK
- SA1 =10LTOO MANY
- BX6 X1
- SA6 CERROR1
- SB1 51 TOO MANY
- EQ =XERR
- * /--- BLOCK VARDO 00 000 79/12/15 01.18
- TITLE GENERAL SUBROUTINES FOR PROCESSING VARIABLES
- * - - - - SUBROUTINE TO HANDLE MULTIPLE VARIABLES - - - - - - - - - - -
- * USES STANDARD LEXICAL SEPARATORS
- *
- * VARBUF(0) RETURNED WITH NUMBER OF VARIABLES
- * VARBUF(N) RETURNED WITH -GETVAR- CODE FOR NTH VARIABLE
- *
- * ****NOTE**** WORDPT IS ASSUMED TO POINT TO
- * THE CHAR TO PROCESS FIRST.
- *
- * THE SUBROUTINE VARFIN WILL HANDLE THE PACKING UP OF THESE VARS
- *
- * 60-BIT CODE FOR EACH VAR IS CONSTRUCTED AS FOLLOWS--
- * (1) TOP BIT -- SET IF EXPRESSION CANNOT BE STORED INTO
- * (2) LOWER 20 BITS -- CODE COMPILE RETURNS (-GETVAR- CODE)
- *
- VARDO EQ *
- SX6 0
- SA6 VARBUF ZERO VARBUF(0) TO NO VARS PRESENT
- VARDOL RJ VARDO2 COMPILE NEXT VAR TO VARBUF ARRAY
- SA1 LASTKEY
- NZ X1,VARDOL CONTINUE IF NOT E-O-L
- EQ VARDO
- *
- *
- *
- * - - - - SUBROUTINE TO GET REMAINING VARIABLES - - - - - - - - - - -
- * SAME AS VARDO BUT ASSUMES THAT ONE OR MORE
- * ARGUMENTS HAVE ALREADY BEEN COMPILED INTO VARBUF.
- *
- VARDOR EQ *
- VARDOR1 SA1 LASTKEY
- ZR X1,VARDOR EXIT IF END OF LINE
- RJ VARDO2 COMPILE NEXT ARGUMENT
- EQ VARDOR1
- *
- * /--- BLOCK VARDOC 00 000 79/01/18 04.20
- *
- *
- *
- * - - - - SUBROUTINE FOR CONTINUED READ OF MULTIPLE VARIABLES - - - - -
- * USES STANDARD LEXICAL SEPARATORS
- *
- VARDOC EQ *
- SX6 0
- SA6 VARBUF ZERO VARBUF(0) TO NO VARS PRESENT
- VARDOCL SA1 WORDPT X1 = POINTER TO NEXT CHARACTER OF TAG
- SA2 X1
- ZR X2,VARDOCN JUMP IF AT END-OF-LINE
- RJ VARDO2 GET CODE FOR NEXT VARIABLE
- EQ VARDOCL
- VARDOCN SA1 NEXTCOM CHECK FOR CONTINUATION
- SA2 COMCONT
- BX3 X1-X2
- NZ X3,VARDOC --- EXIT IF NOT CONTINUED
- RJ GETLINE READ IN NEXT LINE
- EQ VARDOCL
- *
- *
- *
- * - - - - SUBROUTINE TO GET FIRST VARIABLE - - - - - - - - - - - - - - -
- * USES STANDARD LEXICAL SEPARATORS
- *
- VARDO1 EQ *
- SX6 0
- SA6 VARBUF ZERO VARBUF(0) TO NO VARS PRESENT
- RJ VARDO2 GET CODE FOR STORAGE VARIABLE
- EQ VARDO1 RETURN
- *
- *
- *
- * - - - - SUBROUTINE TO GET NEXT VARIABLE - - - - - - - - - - - - - - -
- * USES STANDARD LEXICAL SEPARATORS
- *
- ENTRY VARDO2
- VARDO2 EQ *
- RJ COMPILE GET CODE FOR STRING IN X1 AND B1
- RJ VARDO2A
- EQ VARDO2
- *
- VARDO2A EQ *
- SA2 VARBUF X2 HOLDS CURRENT NO. OF ARGUMENTS
- SX7 X2+1 X7 HOLDS NEW NO. OF ARGUMENTS
- SX2 X7-VARBUFL SUBTRACT OFF SIZE OF VARBUF
- PL X2,ERR2MNY EXIT IF READINBF FULL
- ZR B1,VARDO2E JUMP IF VAR IS STOREABLE
- MX0 1
- BX1 X1+X0 SET TOP BIT OF CODE IF NOT STOREABLE
- VARDO2E SA7 A2 STORE NEW VAR COUNT IN VARBUF(0)
- BX6 X1 MOVE -GETVAR- CODE TO X6
- SB6 A2 MOVE ADR OF VARBUF
- SA6 B6+X7 STORE IN NEXT LOC OF VARBUF
- EQ VARDO2A
- *
- PUTDO2 EQ *
- RJ PUTCOMP
- RJ VARDO2A
- EQ PUTDO2
- *
- * /--- BLOCK VARFIN 00 000 77/01/24 20.50
- *
- * - - - - ROUTINE TO HANDLE PACKING OF VARBUF VARS - - - - - - - - - - -
- *
- * ON ENTRY, SET X1 TO THE NUMBER OF VARS LEGAL FOR THIS COMMAND
- *
- * THE COMMAND WORD IS AS FOLLOWS --
- * 20 BITS -- FIRST VAR
- * 20 BITS -- SECOND VAR
- * 11 BITS -- EXTRA STORAGE POINTER
- * 9 BITS -- COMMAND NUMBER
- *
- * THE REMAINING VARS (IF ANY) ARE PACKED THREE PER
- * WORD IN EXTRA STORAGE
- *
- VARFIN SA2 VARBUF X2 HOLDS NO. OF 20 BIT PACKAGES
- SA4 VARBUF+1 A4 HOLDS ADR. OF FIRST 20 BIT PACKAGE
- RJ VARFINS
- EQ NXTLINE
- *
- * THE MAIN SUBROUTINE
- * ****NOTE**** OTHER THINGS ENTER HERE WITH X1,X2, AND A4 SET
- VARFINS EQ *
- SB2 X2 B2 HOLDS VAR COUNT
- BX2 X1-X2
- NZ X2,ERRTAGS ERROR IF NOT CORRECT NO. OF VARS
- SB5 1 UNIVERSAL INCREMENT CONSTANT TO B5
- MX0 60-XCODEL X0 HOLDS 40 BIT MASK
- BX3 -X0*X4 CLEAR TOP BITS OF FIRST VAR
- SA4 A4+B5 GET SECOND VAR
- BX4 -X0*X4
- LX3 60-XCODEL POSITION FIRST VAR
- LX4 60-2*XCODEL POSITION SECOND VAR
- BX6 X3+X4
- SB4 B5+B5 B4 HOLDS COUNT OF TWO
- SA2 INX NEXT FREE LOC OF EXTRA STORAGE
- LX2 XCMNDL POSITION LEFT OF COMMAND CODE
- BX6 X6+X2 X2 HOLDS POINTER TO NEXT EXTRA STORAGE WORD
- RJ CSTO STORE COMMAND WORD (USES A1,B1,X1,A6,B6,X6)
- VARFINT SB2 B2-3 DECREMENT VAR COUNT
- LT B2,VARFINS DONE IF LESS THAN THREE VARS
- VARFINL SA4 A4+B5 A4 STILL POINTS TO PREVIOUS VAR
- BX4 -X0*X4 X0 STILL HOLDS 40 BIT MASK
- LX6 XCODEL SHIFT PREVIOUS VAR(S) UP
- BX6 X0*X6
- BX6 X6+X4 X6 HOLDS PACKED UP VARS
- SB4 B4-B5 DECREMENT BY ONE FOR END TEST
- PL B4,VARFINL JUMP IF THIS WORD NOT FULL YET
- SA2 INX GET EXTRA STORAGE POINTER
- SA6 INFO+X2 STORE EXTRA STORAGE WORD
- SB4 B5+B5
- SX7 X2+B5
- SA7 INX UPDATE EXTRA STORAGE POINTER
- EQ VARFINT
- *
- *
- *
- * - - - - ROUTINE TO PACK UP VARS WITH A CHAR COUNT - - - - - - - - - -
- *
- * INSERTS AN ADDITIONAL FIRST 20 BIT PACKAGE CONTAINING
- * VARBUF(0) (I.E. THE NO. OF VARS).
- *
- VARFINM SA4 VARBUF A4 HOLDS ADR OF FIRST 20 BIT PACKAGE
- SX2 X4+1 X2 HOLDS COUNT OF 20 BIT PACKAGES
- SX1 X2 ALLOW ANY NUMBER OF VARIABLES
- RJ VARFINS USE STANDARD VARFIN PROCESSOR
- EQ NXTLINE
- * /--- BLOCK MRKLAST 00 000 76/11/17 21.32
- *
- *
- * - - - - ROUTINE TO PACK UP VARS WITH LAST ONE MARKED - - - - - -
- *
- * MARKS THE LAST 20 BIT PACKAGE BY SETTING THE TOP
- * BIT OF THE GETVAR CODE. ANY NUMBER OF ARGUMENTS
- * ARE LEGAL (NO CHECKING IS DONE). SHOULD BE USED
- * FOR COMMANDS WITH OPTIONAL TAGS. CHECKING FOR NUMBER
- * OF VALID ARGUMENTS SHOULD BE DONE IN THE READIN.
- *
- MRKLAST SA1 VARBUF
- SA2 VARBUF+X1 GET LAST ARGUMENT
- MX3 1
- LX3 XCODEL TOP BIT OF GETVAR CODE
- BX6 X3+X2
- SA6 A2 LAST ARGUMENT MARKED
- EQ VARFIN FINISH WITH X1 = NO. ARGS VALID
- *
- *
- * /--- BLOCK VARLEX 00 000 76/11/17 17.16
- EJECT
- * - - - - SUBROUTINE TO DO NON-STANDARD LEXICAL SEARCH FOR VARS - - - -
- *
- * VARSEP AND VARONE MUST BE SET AS IN VARONE
- * VARONET RETURNED WITH ADDRESS OF ENDING SEP
- * VARONES HOLDS THE SEPARATOR FOUND (0 IF E-O-L)
- *
- VARLEX EQ *
- SA2 WORDPT X2 HOLDS ADR OF CHAR NOW WORKING ON
- SB2 1 B2 HOLDS INCREMENT OF ONE
- SX2 X2-1 DECREMENT CHAR POINTER INITIALLY
- VARONEL SX2 X2+B2 INCREMENT X2 TO NEXT CHAR
- SA1 X2 X1 HOLDS NEXT CHAR
- ZR X1,VARONEG JUMP IF E-O-L
- VARSEP DATA 0 ****ARGUMENT****, CHECKS IF X1 HOLDS SEP.
- VARONED NZ X1,VARONEL NOT A SEP., CONTINUE SEARCHING
- SA1 X2 SEPARATOR TO X1
- VARONEG SX7 X1
- SA7 VARONES SAVE ENDING SEPARATOR IN VARONES
- SX7 X2 MOVE ADR OF SEPARATOR
- SA7 VARONET SAVE ADR OF ENDING SEPARATOR IN VARONET
- EQ VARLEX
- *
- *
- *
- * - - - - SUBROUTINE TO COMPILE A SINGLE VAR AFTER USING -VARLEX - - -
- *
- * TO INITIALIZE --
- * 1. SET VARBUF(0) TO NO. OF VARS ALREADY IN READINBF
- * 2. SET VARSEP TO INDICATE THE SEPARATOR(S) DESIRED
- * 3. SET WORDPT TO THE ADR OF THE FIRST CHAR IN STRING
- *
- * EACH CALL OF VARONE DOES THE FOLLOWING --
- * 1. INCREMENTS VARBUF(0) BY ONE
- * 2. USES VARSEP TO DETERMINE THE END OF THE NEXT STRING
- * (VARSEP MUST BE A WORD OF INSTRUCTIONS WHICH SETS
- * X1 TO ZERO IF THE CONTENTS OF X1 IS A TERMINATOR)
- * (ZERO IS AN AUTOMATIC TERMINATOR)
- * (A1,B1,X1,A6,B6,X6 ARE THE ONLY REGISTERS WHICH
- * VARSEP MAY DESTROY)
- * 3. SENDS THAT STRING TO COMPILE FOR CODING
- * 4. UPDATES WORDPT TO ADDRESS OF CHAR FOLLOWING TERMINATOR
- * 5. STORES -GETVAR- CODE IN VARBUF(VARBUF(0))
- * 6. RETURNS LASTKEY WITH TERMINATOR
- *
- VARONE EQ *
- SA1 VARONET ADDRESS OF ENDING CHAR
- SX7 1R, COMMA IS END-OF-LINE FOR COMPILE
- SA7 X1
- RJ VARDO2
- SA2 VARONET X2 HOLDS ADDRESS OF ENDING SEPARATOR
- SA1 VARONES X1 HOLDS ENDING SEPARATOR
- BX7 X1
- SA7 X2 RESTORE ORIGINAL CHAR
- SA7 LASTKEY ALSO PUT INTO LASTKEY
- EQ VARONE
- *
- VARONES BSS 1 TEMP STORAGE FOR LASTKEY
- VARONET BSS 1 TEMP STORAGE FOR POINTER TO SEPARATOR
- *
- *
- *
- *
- * - - - - VARIOUS VALUES FOR VARSEP FOLLOW - - - - - - - - - - - - - - -
- * /--- BLOCK VARFEM 00 000 76/07/17 06.21
- *
- SEPCMAS RJ SEPCMAS1 COMMA OR ASSIGNMENT ARROW WILL TERMINATE
- SEPCMAS1 EQ *
- SX1 X1-1R,
- ZR X1,SEPCMAS1 EXIT IF CHAR IS COMMA
- SX1 X1+1R,-KASSIGN
- EQ SEPCMAS1
- *
- *
- *
- * - - - - SUBROUTINE TO STORE COMMAND WORD - - - - - - - - - - - - - - -
- *
- * WILL ONLY DESTROY (A1,B1,X1,A6,B6,X6)
- *
- * ASSUMES X6 TO HOLD COMMAND WORD, LOWER 10 BITS ZERO
- *
- * ATTACHES COMNUM TO X6 AND DECREMENTS ICX
- * STORES X6 IN INFO(ICX)
- *
- CSTO EQ *
- SA1 COMNUM GET COMMAND NUMBER
- BX6 X6+X1
- SA1 ICX POINTS TO PREVIOUS COMMAND WORD
- SA6 INFO-1+X1 STORE IN NEXT OPEN SPACE
- SX6 X1-1
- SA6 A1 STORE NEW COMMAND POINTER VALUE
- EQ CSTO
- *
- * ROUTINE TO DO FOR EMBEDDABLE COMMANDS WHAT
- * VARFIN DOES FOR NORMAL COMMANDS
- * NOTE THAT ON ENTRY, X1=NUMBER OF ARGUMENTS DESIRED
- *
- *
- VARFEM EQ * ENTRY/EXIT LINE
- SA2 VARBUF X2 HOLDS NO. OF 20 BIT PACKAGES
- SB5 1 UNIVERSAL INCREMENT CONSTANT TO B5
- SA4 A2+B5 A4 HOLDS ADR. OF FIRST 20 BIT PACKAGE
- SB2 X2 B2 HOLDS VAR COUNT
- BX2 X1-X2
- NZ X2,ERRTAGS ERROR IF NOT CORRECT NO. OF VARS
- MX0 60-XCODEL X0 HOLDS 40 BIT MASK
- BX3 -X0*X4 CLEAR TOP BITS OF FIRST VAR
- SA4 A4+B5 GET SECOND VAR
- BX4 -X0*X4
- LX3 60-XCODEL POSITION FIRST VAR
- LX4 60-2*XCODEL POSITION SECOND VAR
- BX6 X3+X4
- SB4 B5+B5 B4 HOLDS COUNT OF TWO
- SA2 INX NEXT FREE LOC OF EXTRA STORAGE
- LX2 XCMNDL POSITION LEFT OF COMMAND CODE
- BX6 X6+X2 X2 HOLDS POINTER TO NEXT EXTRA STORAGE WORD
- * COMMAND WORD STORED BY CALL-OR
- VARFEMT SB2 B2-3 DECREMENT VAR COUNT
- LT B2,VARFEM DONE IF LESS THAN THREE VARS
- VARFEML SA4 A4+B5 A4 STILL POINTS TO PREVIOUS VAR
- BX4 -X0*X4 X0 STILL HOLDS 40 BIT MASK
- LX7 XCODEL SHIFT PREVIOUS VAR(S) UP
- BX7 X0*X7
- BX7 X7+X4 X7 HOLDS PACKED UP VARS
- SB4 B4-B5 DECREMENT BY ONE FOR END TEST
- PL B4,VARFEML JUMP IF THIS WORD NOT FULL YET
- SA2 INX GET EXTRA STORAGE POINTER
- SA7 INFO+X2 STORE EXTRA STORAGE WORD
- SB4 B5+B5
- SX7 X2+B5
- SA7 INX UPDATE EXTRA STORAGE POINTER
- EQ VARFEMT
- * /--- BLOCK NEWERROR 00 000 80/09/14 14.57
- *
- * NEW STANDARD ERROR EXITS FOR ALL CONDENSE ROUTINES
- *
- ENTRY ERRTAGS,ERRNAME,ERRSTOR
- ENTRY ERRXYTG,ERR2MNY,ERR2FEW,ERR2MNU
- ENTRY ERRTERM,ERRUARG,ERRVTYP
- ENTRY ERROBS,ERROUTR,ERRCNTD
- ENTRY ERRXORQ,ERRBAL,FIPERR
- *
- ERROBS SB1 0 OBSOLETE COMMAND
- EQ =XERR
- ERRTAGS SB1 2 WRONG NUMBER TAG FIELDS
- EQ =XERR
- ERRNAME SB1 3 UNRECOGNIZABLE NAME OR TOO LONG
- EQ =XERR
- ERRSTOR SB1 4 ERROR IN TYPE OF STORE VARIABLE
- EQ =XERR
- ERRXYTG SB1 5 ERROR IN COARSE/FINE XY TAG
- EQ =XERR
- ERR2MNY SB1 6 TOO MANY TAGS FOR COMMAND FORM
- EQ =XERR
- ERR2FEW SB1 7 NOT ENOUGH TAGS FOR COMMANDFORM
- EQ =XERR
- ERRTERM SB1 8 WRONG TERMINATOR TYPE ,FOR; ETC
- EQ =XERR
- ERRUARG SB1 9 UNIT ARGUMENTS DONT MATCH
- EQ =XERR
- ERRVTYP SB1 10 WRONG VARIABLE TYPE, IE
- EQ =XERR VC NOT V OR V NOT N
- *
- FIPERR SB1 44 BAD FILE INFO PACKET
- EQ =XERR
- *
- ERRXORQ SB1 72
- EQ =XERR
- ERROUTR SB1 79 ILLEGAL REF TO ROUTER (OR NONE)
- EQ =XERR
- ERRCNTD SB1 80 COMND NOT (OR SHOULD BE) CONTD.
- EQ =XERR
- ERRBAL SB1 84 UNBALANCED PARENS OR QUOTES
- EQ =XERR
- ERR2MNU SB1 105 TOO MANY UNIT NAMES (OVER 400)
- EQ =XERR
- *
- *
- * /--- BLOCK ULONG 00 000 75/10/09 10.23
- *
- *
- * -ULONG-
- * CHECK FOR UNIT TOO LONG - GIVE WARNING
- *
- ENTRY ULONG
- ULONG EQ *
- SA1 INX EXTRA STORAGE POINTER
- SA2 ICX COMMAND STORAGE POINTER
- IX1 X1-X2 CHECK FOR UNIT TOO LONG
- PL X1,LNGUNIT FATAL ERROR EXIT
- * SX1 X1+25
- SX1 X1+10 UNITLTH-10 = WARNING LIMIT
- NG X1,ULONG
- SA1 UNUMON SEE IF IN IEU
- SX1 X1-IEUNUM
- ZR X1,LNGUNIT JUST ABORT
- CALL UNNAM GET CURRENT UNIT NAME
- NG X1,LNGUNIT ABORT IF BAD UNIT NAME
- LX6 12
- BX5 X6 UERRSET PRESERVES -X5-
- CALL UERRSET SET EDIT CONNECTION TO GO TO UNIT COMMAND
- SB1 900 *WARNING* UNIT ALMOST TOO LONG
- BX2 X5 SAVE UNIT NAME
- MX1 -1 DON'7T SAVE COMMAND NAME
- SB2 X1 NO BAD LINE TO SAVE
- RJ =XRJERR2 STORE ERROR INFO
- EQ ULONG
- *
- *
- * -MISAY-
- * CHECK FOR MISSING -SAYLANG- IF SAY(S) PRESENT
- *
- ENTRY MISAY
- MISAY EQ *
- .SAYCMD IFNE SAYASSM,0
- SA3 SAYFLAG PUT VALUE OF SAYFLAG IN X3
- ZR X3,MISAY IF NO SAY(LANG) COMNDS, RETURN
- SX3 X3-1 AREN'7T INTERESTED IF SAY THERE
- NZ X3,MISAY MUST HAVE BEEN A SAYLANG
- SB1 117 ',MISSING SAYLANG COMMAND',
- SB2 -1
- SX1 B0
- SX2 B0
- RJ =XRJERR2 STORE ERROR INFORMATION
- .SAYCMD ENDIF
- EQ MISAY
- *
- * /--- BLOCK ABORTCON 00 000 81/06/15 11.44
- TITLE ABORTCON--ABORT CONDENSE
- *
- *
- * TAG TOO LONG--PRESUMABLY NOT A SOURCE FILE
- *
- ENTRY BADTAG
- *
- BADTAG SX6 14
- EQ ABORTCON
- *
- *
- * UNIT NAME TABLE FULL BUT IEU ONLY REAL ONE
- *
- ENTRY BADIEU
- BADIEU SX6 42
- EQ ABORTCON
- *
- *
- * OBSOLETE LESSON -- MUST BE CONVERTED FIRST
- *
- ENTRY OBSFILE
- OBSFILE SX6 29 ERROR CODE
- SA6 IOBUFF
- EQ ABORT3
- *
- * UNIT TOO LONG TO CONDENSE
- *
- ENTRY LNGUNIT
- *
- LNGUNIT SX6 6
- EQ ABORTCON
- *
- *
- * TOO MANY BLOCKS BEING -USE-D
- *
- ENTRY TMNYUSE
- TMNYUSE SX6 30
- EQ ABORTCON
- *
- * ABORT CONDENSE
- *
- ABORTCON SA6 IOBUFF
- * FIND THE UNIT NAME
- CALL UNNAM
- LX6 12
- SA6 IOBUFF+1 STORE EXTRA INFORMATION
- ABORT2 SA3 ACLSTAT
- SX1 ABTCLES
- IX0 X1+X3 ECS ADDR OF STAT WORD
- SA0 SCONTMP
- + RE 1
- RJ =XECSPRTY
- SA1 A0
- SX2 1
- IX6 X1+X2 INC NUMBER OF ABORTED CONDENSING
- SA6 A1
- + WE 1 WRITE BACK IN ECS
- RJ =XECSPRTY
- SA1 TSCOMFG COMMAND STATISTICS
- PL X1,ABORT3
- BX6 X2 TURN OFF FLAG TEMP
- SA6 A1 DONT INCLUDE IN STATISTICS
- ABORT3 RJ =XABORTC
- EQ =XCONDENS
- * /--- BLOCK TUTOR COMM 00 000 80/12/26 14.07
- TITLE TUTOR COMMAND STATISTICS
- * ENTER THIS SUBROUTINE ONLY WHEN TSCOMFG IS -1, TO RECORD
- * STATISTICS ON EACH TUTOR COMMAND, ITS CONDENSING TIME AND
- * FREQUENCY COUNT.
- * ALL STATISTICS ARE KEPT IN ECS BANK CNDSTAT.
- * THE ROUTINE ASSUMES THAT THE COMMAND NUMBER IS IN SCOMNUM AND
- * CONDENSING BEGIN TIME (MSEC.) IN SCOMBEG.
- * TSCOMFG IS SET TO 1 UPON EXIT FROM THIS ROUTINE.
- *
- *
- ENTRY PSTCMS1
- *
- PSTCMS1 EQ *
- SX6 1
- SA6 TSCOMFG RESET FLAG TO 1
- SA3 ACDSTAT ADDR OF CNDSTAT IN ECS
- SX1 SCOMNDN
- IX0 X1+X3
- SA0 SCONTMP
- + RE 2 REAC TOTAL COUNT AND TOTAL TIME FROM ECS
- RJ =XECSPRTY
- SA1 A0 TOTAL COUNT
- IX6 X1+X6
- SA6 A1 INCREMENT TOTAL COUNT
- SA1 SYSCLOK
- SA2 SCOMBEG
- IX2 X1-X2 CURRENT TIME - BEGIN TIME
- SA1 A0+1 TOTAL TIME
- IX6 X1+X2
- SA6 A1 UPDATE TOTAL TIME
- + WE 2 WRITE BACK ECS,TOTAL COUNT AND TIME
- RJ =XECSPRTY
- SX1 SCOMNDS COMMAND NUMBER
- IX0 X1+X3
- SA1 SCOMNUM
- IX0 X0+X1 ECS LOC OF STATISTICS WORD FOR THIS COMMAND
- + RE 1 READ FROM ECS
- RJ =XECSPRTY
- SA1 A0 LOAD COMMAND STATISTICS WORD
- IX2 X1+X2 ADD TO PROCESS TIME
- MX3 1
- LX3 31
- IX6 X2+X3 INC ITS COMMAND COUNT BY 1
- SA6 A1
- + WE 1 WRITE BACK IN ECS
- RJ =XECSPRTY
- EQ PSTCMS1
- *
- * /--- BLOCK WRITECS 00 000 85/03/25 11.54
- *
- SPACE 5,11
- ** WRITECS - WRITE NEXT BLOCK OF BINARY TO ECS
- *
- * ENTRY - (X0) - ECS ADDRESS TO WRITE TO
- * (A0) - CM ADDRESS TO WRITE FROM
- * (X2) - NUMBER OF WORDS TO WRITE
- *
- * EXIT - (X0) - NEXT ECS ADDRESS TO WRITE TO
- *
- * MUST SAVE CONTENTS OF A - 0,1,6
- * X - 1,3,4,6
- * B - NONE
- *
- * (USED IN *UWRITE*/COVLAY4)
- ENTRY WRITECS
- WRITECS EQ *
- WECS1 SA5 CONBUFF (X5) = ADDRESS OF CONDEN BUFFER
- IX7 X0-X5
- SA5 CBLTH (X5) = LENGTH OF BUFFER
- IX7 X7-X5
- IX7 X7+X2
- PL X7,WECS2 IF OVERFLOWING BUFFER
- SB7 X2 SET LENGTH OF WRITE
- WE B7
- RJ ECSPRTY
- IX0 X0+X2 INCREMENT ECS ADDRESS
- EQ WRITECS
- * RATHER THAN ALLOCATE MAX SIZE BUFFER FOR BINARY,
- * WE TRY ROUGHLY 1/4 THEN 1/2 THEN FULL SIZE.
- WECS2 SX7 X5-CBLTH2 CHECK FOR 1/2 SIZE
- PL X7,WECS2.1 -- .GE. 1/2 SIZE
- SX7 CBLTH2 ELSE FIRST PASS, TRY 1/2
- EQ WECS2.3
- WECS2.1 NZ X7,WECS2.2 -- ALREADY AT MAX SIZE, ERROR
- SX7 CBINMAX ELSE, TRY MAX SIZE
- EQ WECS2.3
- WECS2.2 SX6 15 THIRD PASS - *BINARY TOO BIG*
- EQ ABORTCON
- * /--- BLOCK WRITECS 00 000 85/03/25 11.48
- * REQUEST A LARGER CONDENSE BUFFER
- WECS2.3 BSS 0
- SA7 CBLTH STORE DESIRED BUFFER LENGTH
- SB7 1
- SX7 A0 SAVE A0
- SA7 WECSA
- BX7 X0 SAVE X0
- SA7 A7+B7
- SX7 A6 SAVE A6
- SA7 A7+B7
- SA6 A7+B7 SAVE X6
- SX7 A1 SAVE A1
- BX6 X1 SAVE X1
- SA7 A6+B7
- SA6 A7+B7
- BX6 X3 SAVE X3
- BX7 X4 SAVE X4
- SA6 A6+B7
- SA7 A6+B7
- * MUST SAVE X2 BECAUSE *SYSTEM* MACRO IN *S=WAIT* USES
- * THAT REGISTER. CONTAINS LENGTH OF EM WRITE.
- BX6 X2
- SA6 A7+B7
- * SET THE RETRY COUNTER.
- SX6 3
- WECS2.5 SA6 WECSD
- * BUILD THE REQUEST.
- MX6 1 MOVE LESSON REQUEST = 1
- SA5 CONBUFF (X5) = ORIGINAL BUFFER ADDRESS
- SA1 CBLTH
- BX7 X1 (X7) = REQUESTED BUFFER LENGTH
- SA1 CONDN BIAS TO THIS CONDENSORS WORD
- SX0 X1+COECRQ
- LX5 24
- LX6 -11
- BX7 X7+X6
- BX7 X7+X5
- SA7 WECSB SET REQUEST WORD
- SA0 A7
- SA1 WECSC INCREMENT ECS MOVE COUNT
- SX6 X1+B7
- SA6 A1
- WE 1
- RJ ECSPRTY
- WECS3 SX7 B1 SAVE B1 OVER S=WAIT
- CALL S=WAIT,15 WAIT A BIT
- SB1 X7 RESTORE B1
- RE 1
- RJ ECSPRTY
- SA5 A0
- PL X5,WECS3 IF NOT COMPLETE
- * /--- BLOCK WRITECS 00 000 85/03/25 11.50
- * CHECK IF MOVE ACTUALLY OCCURRED.
- MX7 -24
- BX7 -X7*X5 (X7) = NEW EM ADDRESS
- NZ X7,WECS5 IF MOVE OCCURRED
- * UPDATE RETRY COUNTER.
- SA1 WECSD
- SX6 X1-1
- PL X6,WECS2.5 IF SHOULD TRY AGAIN
- * UNABLE TO GET THE LARGER BINARY BUFFER.
- * ABORT THIS CONDENSE.
- CALL S=MSG,(=C* EM REQUEST FAILURE.*)
- SX6 3 NO ECS AVAILABLE
- EQ ABORTCON
- WECS5 SA5 CONBUFF
- IX0 X7-X5 (X0) = DISTANCE OF MOVE
- SA7 A5
- SA5 WECSA RESTORE A0
- SB7 1
- SA0 X5
- SA5 A5+B7 UPDATE X0 TO NEW ADDRESS
- IX0 X5+X0
- SA5 A5+B7 RESTORE A6
- SA1 X5
- BX6 X1
- SA6 A1
- SA5 A5+B7 RESTORE X6
- BX6 X5
- SA5 A5+B7 RESTORE A1
- SA1 X5
- SA5 A5+B7 RESTORE X1
- BX1 X5
- SA5 A5+B7
- BX3 X5
- SA5 A5+B7
- BX4 X5
- SA5 A5+B7
- BX2 X5
- EQ WECS1 WRITE AGAIN
- WECSA BSS 9 SAVE AREA (A0,X0,A6,X6,A1,X1,X3,X4,X2)
- WECSB DATA 0 ECS REQUEST WORD
- ENTRY WECSC
- WECSC DATA 0 NUMBER OF TIMES MOVE REQUESTED
- WECSD BSS 1 MOVE EM RETRY COUNTER
- *
- * /--- BLOCK PUBERRS 00 000 80/12/26 14.13
- *
- *
- * -PUBERRS-
- *
- * STORE ERROR ORDINAL,LESSON,BLOCK,LINE
- * IN USERS STORAGE
- *
- * ON ENTRY B1 = PUBLISH ERROR NUMBER
- * ON EXIT PUBLISH ERROR IS LOGGED
- *
- * USES ALL REGISTERS
- *
- ENTRY PUBERRS
- PUBERRS EQ *
- SB2 CPUBE B2 = BUFFER NUMBER
- RJ =XPLOGLIN
- EQ PUBERRS
- *
- * -PUBWARN-
- *
- * STORE ERROR ORDINAL,LESSON,BLOCK,LINE
- * IN USERS STORAGE
- *
- * ON ENTRY B1 = PUBLISH WARNING NUMBER
- * ON EXIT PUBLISH WARNING IS LOGGED
- *
- * USES ALL REGISTERS
- *
- ENTRY PUBWARN
- PUBWARN EQ *
- SB2 CPUBW B2 = BUFFER NUMBER
- RJ =XPLOGLIN
- EQ PUBWARN
- *
- *
- * -PUBTEXT-
- *
- * STORE TEXT ORDINAL,LESSON,BLOCK,LINE
- * IN USERS STORAGE
- *
- * ON ENTRY B1 = TEXT COMMAND NUMBER
- * ON EXIT TEXT POSITION IS LOGGED
- *
- * USES ALL REGISTERS
- *
- ENTRY PUBTEXT
- PUBTEXT EQ *
- SB2 CTEXT B2 = BUFFER NUMBER
- RJ =XPLOGLIN
- EQ PUBTEXT
- *
- *
- *
- * -PLOGLIN-
- *
- * LOG ERROR/FILE/BLOCK/LINE NUMBER IN STORAGE BUFFER
- *
- * ON ENTRY B1 = PUBLISH ERROR TYPE
- * B2 = BUFFER NUMBER
- *
- PLOGLIN EQ *
- SA1 COPTS+B2 X1 = PUBLISH ERROR RETURN FLAG
- ZR X1,PLOGLIN
- *
- SX6 B1 LOG TYPE
- SA6 TEMP
- SA0 A6
- SB1 B2 B1 = BUFFER NUMBER
- RJ APNDSTO APPEND CM(A0) TO BUFFER B1
- RJ =XLOGLINE LOG FILE/LOGICAL BLOCK/LINE
- EQ PLOGLIN
- *
- * /--- BLOCK UNITLOC 00 000 81/07/28 03.42
- *
- * -UNITLOC-
- *
- * APPEND UNIT NAME/FILE/BLOCK/LINE TO CUNTS BUFFER
- *
- * ON ENTRY, X6 = UNIT NUMBER
- * ON EXIT, X6 IS PRESERVED
- *
- ENTRY UNITLOC
- UNITLOC EQ *
- SA1 COPTS+CUNTS
- ZR X1,UNITLOC IF -UNITS- OPTION NOT SELECTED
- *
- SA6 SVX6 SAVE X6
- RJ =XUNNAMX6 X6 = UNIT NAME
- NG X1,*+40000B KILL CONDENSOR IF BAD UNIT NUM
- SA6 TEMP
- SA0 A6
- SB1 CUNTS
- RJ =XAPNDSTO APPEND UNIT NAME
- RJ =XLOGLINE APPEND FILE/BLOCK/LINE
- SA1 SVX6
- BX6 X1 RESTORE X6
- EQ UNITLOC
- *
- SVX6 BSS 1 SAVE X6 FROM UNIT CONDENSOR
- *
- TEMP BSS 1
- *
- *
- * -LOGLINE-
- *
- * LOG FILE/BLOCK/LINE NUMBER IN STORAGE BUFFER
- *
- * ON ENTRY
- * B1 = BUFFER NUMBER
- *
- ENTRY LOGLINE
- LOGLINE EQ *
- SA0 TACCT ACCOUNT OF TAG
- RJ APNDSTO
- SA0 TFILE FILE OF TAG
- RJ APNDSTO
- SA1 TBLOCK BLOCK OF TAG
- SA2 TLINE LINE OF TAG
- LX1 18 18BLOCK/18LINE
- BX6 X1+X2
- SA6 TEMP
- SA0 A6
- RJ APNDSTO
- EQ LOGLINE
- *
- * /--- BLOCK APNDSTO 00 000 80/12/26 14.11
- *
- * -APNDSTO-
- *
- * APPEND A WORD TO BUFFER IN USER STORAGE
- *
- * ON ENTRY
- * B1 = BUFFER ORDINAL
- * A0 = CM ADDRESS OF WORD TO APPEND
- *
- * ON EXIT
- *
- * B1 IS PRESERVED
- *
- * IF THE BUFFER FOR THE ORDINAL IN B1 DOES NOT EXIST
- * THE BUFFER IS CREATED. THE DATA STRUCTURE IS';
- *
- * S1 = 6UNUSED/18OVFLMAP/18OVFLCOUNT/18BUFFCOUNT
- * S2 TO S(S1+1) = 24UNUSED/18BUFFORDINAL/18BUFFLEN
- * S(S1+2) TO S(LSTORAG) = CONTENTS OF BUFFERS
- *
- ENTRY APNDSTO
- APNDSTO EQ *
- SX6 A0 SAVE A0
- SA6 SAVEA0
- SB7 B1 B7 = BUFFER ORDINAL
- SB2 B0 B2 = LENGTH ALL BUFFERS
- SB3 B0 B3 = LENGTH UP TO BUFFER B7
- SB4 B0 B4 = INDEX TO BUFFER B7 POINTER
- SB5 B0 B5 = BUFFER POINTER INDEX
- SA1 CSTOADR X1 = ECS ADDRESS OF STORAGE
- ZR X1,APNDSTO INTEGRITY CHECK
- *
- RX2 X1
- SB6 X2 B6 = NUMBER OF BUFFERS
- APND10 SB5 B5+1
- GT B5,B6,APND20 IF ALL BUFFER POINTERS SCANNED
- *
- SX2 B5 X2 = BUFFER POINTER
- IX2 X2+X1
- RX2 X2
- SX3 X2 X3 = BUFFER LENGTH
- SB2 B2+X3 B2 = TOTAL LENGTH
- AX2 18
- SB1 X2 B1 = ORDINAL OF THIS BUFFER
- NE B1,B7,APND10 IF NOT LOOKING FOR THIS BUFFER
- *
- SB4 B5
- SB3 B2
- EQ APND10
- *
- APND20 NZ B4,APND30 IF BUFFER ALREADY EXISTS
- *
- BX7 X1 X7 = ADDR OF STORAGE
- SX2 B5
- IX1 X1+X2 X1 = SOURCE OF MOVE
- BX6 X1 SAVE X1
- SX2 1
- IX2 X2+X1 X2 = DESTINATION OF MOVE
- SX3 B2 X3 = LENGTH OF MOVE
- SA4 CSTOLWA X4 = LWA+1 OF BUFFER
- RJ =XOPENECS OPEN BUFFER IN ECS
- NG X5,APND40 IF NO ROOM TO APPEND WORD
- *
- BX1 X6 RESTORE X1
- SX6 B7 X6 = BUFFER ORDINAL
- LX6 18
- WX6 X1 ADD NEW BUFFER POINTER
- SB3 B2 POINT TO END OF LAST BUFFER
- SB4 B5
- * /--- BLOCK APNDSTO 00 000 81/07/08 01.17
- BX1 X7 RESTORE X1
- RX2 X1 X2 = CURRENT NUMBER OF BUFFERS
- SX3 1
- IX6 X2+X3 INCREMENT NUMBER OF BUFFERS
- SB6 X6 B6 = NUMBER OF BUFFERS
- WX6 X1
- APND30 SX2 B6+1
- SX2 X2+B3 STORAGE LOC FOR NEW ENTRY
- IX1 X1+X2 X1 = ADDR FOR NEW WORD
- BX7 X1 SAVE X1
- SX2 1
- IX2 X2+X1 X2 = NEXT BUFFER ADDRES
- SB1 B2-B3
- SX3 B1 X3 = LENGTH OF FOLLOWING SPACE
- SA4 CSTOLWA X4 = LWA+1 OF STORAGE
- RJ =XOPENECS
- NG X5,APND40 IF NO MORE ROOM
- *
- SA1 SAVEA0 RESTORE A0
- SA0 X1
- BX0 X7
- WE 1
- RJ ECSPRTY
- SA1 CSTOADR INCREMENT BUFFER LENGTH
- SX2 B4
- IX0 X1+X2
- RX1 X0
- SX2 1
- IX6 X1+X2
- WX6 X0
- SB1 B7 RESTORE B1
- EQ APNDSTO
- *
- APND40 SA1 CSTOADR MARK BUFFER OVERFLOW
- RX2 X1 X2 = S1
- SX3 1
- LX3 18
- IX6 X3+X2 INCREMENT OVERFLOW COUNT
- LX3 18
- LX3 B7
- BX6 X3+X6 MARK BUFFER(B7) OVERFLOW
- WX6 X1
- SB1 B7 RESTORE B1
- EQ APNDSTO
- *
- SAVEA0 BSS 1
- * /--- BLOCK TAGSAVE 00 000 73/11/10 23.19
- *
- *
- *
- * -TAGSAVE- -TAGREST-
- * SAVE AND RESTORE *TAGCNT* AND *TAG* BUFFER
- *
- *
- ENTRY TAGSAVE
- TAGSAVE EQ *
- SA1 TAGCNT LENGTH OF TAG
- SB1 X1
- BX6 X1 SAVE
- SA6 SAVTLTH
- SA1 ATAGECS
- BX0 X1 ECS TAG SAVE AREA
- SA0 TAG
- + WE B1 WRITE TAG TO ECS
- RJ ECSPRTY
- EQ TAGSAVE
- *
- *
- ENTRY TAGREST
- TAGREST EQ *
- SA1 SAVTLTH RESTORE TAG LENGTH
- BX6 X1
- SA6 TAGCNT
- SB1 X1
- SA1 ATAGECS ECS ADDRESS OF SAVED TAG
- BX0 X1
- SA0 TAG
- + RE B1 READ BACK INTO *TAG* BUFFER
- RJ ECSPRTY
- EQ TAGREST
- *
- SAVTLTH BSS 1
- *
- *
- * /--- BLOCK APACK 00 000 73/00/00 00.00
- TITLE -APACK-
- *
- *
- * -APACK-
- * PACKS UP NUMBER OF ARGUMENTS, UNIT NUMBER AND
- * -GETVAR- CODES FOR ARGUMENTS
- *
- * ENTER WITH UNIT NUMBER IN X6
- * RETURNS WITH X6 = CODE FOR UNIT WITH ARGUMENTS
- *
- *
- ENTRY APACK
- APACK EQ *
- SA1 VARBUF NUMBER OF ARGUMENTS
- ZR X1,APACK
- SB1 X1
- LX1 10
- BX6 X1+X6 COMBINE WITH UNIT NUMBER
- LX6 40 POSITION FIRST 20 BIT CODE
- SA4 INX
- SX7 X4 UNIT EXTRA STORAGE POINTER
- MX0 -XCODEL
- SB2 20 INITIALIZE SHIFT COUNT
- *
- APLP SB1 B1-1 DECREMENT ARGUMENT COUNT
- NG B1,APLP1
- SA1 A1+1 LOAD NEXT -GETVAR- CODE
- BX1 -X0*X1
- LX1 X1,B2 POSITION -GETVAR- CODE
- BX6 X1+X6
- SB2 B2-20 DECREMENT SHIFT COUNT
- PL B2,APLP
- *
- APLP1 SA6 X7+INFO STORE COMPLETED WORD
- SX7 X7+1
- SB2 40 RE-INITIALIZE SHIFT COUNT
- MX6 0
- PL B1,APLP
- SX6 4000B CODE FOR UNIT WITH ARGUMENTS
- BX6 X4+X6
- SA7 INX UPDATE EXTRA STORAGE POINTER
- EQ APACK
- *
- *
- ENTRY AUNUM
- ENTRY UARGS,ENDPNT,UNITFLG
- *
- UARGS BSS 1
- UNITFLG BSS 1 SPECIAL FLAG FOR -UNIT- COMMAND
- ENTRY ENDPNT REFERENCED IN JOINOV
- ENDPNT BSS 1 POINTER TO END OF ARGUMENTS
- *
- AUNUM BSS 1
- ENTRY ARGKEY
- ARGKEY BSS 1 TERMINATOR KEY FOR ARGS
- *
- * /--- BLOCK GETARGS 00 000 80/03/28 00.20
- TITLE -GETARGS-
- *
- * -GETARGS-
- * PROCESS ARGUMENTS OF UNIT
- *
- * ENTER WITH *VARBUF* INITIALIZED TO ZERO
- *
- * ON EXIT --
- * *VARBUF(0)* = NUMBER OF ARGUMENTS
- * *VARBUF(N)* = -GETVAR- CODES
- *
- ENTRY GETARGS
- GETARGS EQ *
- *
- GETLP SA1 WORDPT POINTER TO NEXT CHARACTER
- SA1 X1
- *
- GET0 SX2 X1-1R CHECK FOR SPACE
- NZ X2,GET1
- SA1 A1+1 GET NEXT CHARACTER
- EQ GET0
- *
- GET1 SA2 X1+KEYTYPE GET CHARACTER TYPE
- SX3 X2-EOL
- ZR X3,GET2 JUMP IF END-OF-LINE
- SX3 X2-OPCOMMA
- NZ X3,GET3 GO COMPILE IF NOT COMMA
- SA1 A1+1 ADVANCE CHARACTER POINTER
- *
- GET2 SX7 A1
- SA7 WORDPT UPDATE *WORDPT*
- SX7 X1
- SA7 LASTKEY AND *LASTKEY*
- SA1 UNITFLG
- NZ X1,ERRSTOR ERROR IF -UNIT- OR -ARGS-
- MX1 1
- LX1 20 SET UP SPECIAL 20 BIT CODE
- MX7 1
- BX7 X1+X7 TOP BIT FOR NON-STOREABLE
- SA1 VARBUF
- SX6 X1+1 ADVANCE *VARBUF* POINTER
- SA6 A1
- SA7 X6+VARBUF STORE SPECIAL CODE
- EQ GET4
- *
- GET3 SX7 A1 UPDATE *WORDPT*
- SA7 WORDPT
- SA1 UNITFLG SEE IF -UNIT- COMMAND
- ZR X1,GET3A
- CALL PUTDO2 EVALUATE VARIABLE
- EQ GET4
- *
- GET3A CALL VARDO2 EVALUATE NEXT ARGUMENT
- GET4 SA1 VARBUF GET ARGUMENT COUNT
- SX1 X1-UARGMAX-1
- PL X1,ERRUARG ERROR IF TOO MANY ARGUMENTS
- SA1 WORDPT
- SA2 ENDPNT SEE IF AT END OF ARGUMENTS YET
- IX1 X1-X2
- PL X1,GETARGS IF AT END OF ARGUMENTS
- *
- SA2 LASTKEY
- SX2 X2-1R;
- NZ X2,GETLP IF NICE DELIMITER
- *
- SA1 BDLIM
- BX7 X1
- SA7 CERROR1 STORE MESSAGE
- SB1 99 ORDINAL FOR BAD DELIMITER ERROR
- SA1 CMNDTMP SAVED COMMAND NAME
- ZR X1,=XERR IF NONE SAVED, NORMAL ERROR
- *
- RJ =XRJERR
- MX6 0 NO ARGUMENTS
- SA6 VARBUF
- EQ GETARGS
- *
- BDLIM DATA 10LBAD DELIM
- ENTRY CMNDTMP
- CMNDTMP DATA 0 SAVE CMND NAME FOR UNIT ARGS
- * /--- BLOCK DUMP 00 000 79/12/10 11.40
- TITLE -DUMP- COMMAND
- *
- *
- * -DUMP- COMMAND
- * BOMB CONDENSOR
- *
- ENTRY DUMPIN
- DUMPIN CALL SYSTEST MUST BE SYSTEM LESSON
- MX6 0
- SA6 ITEMP
- SA6 ITEMP+1
- SA1 APLACOM
- SX0 1
- IX0 X1+X0
- SA0 ITEMP
- + WE 2
- RJ ECSPRTY
- BX0 X1
- SA0 =3 3 = ABNORMAL TERMINATION
- + WE 1
- RJ ECSPRTY
- SA1 -1
- *
- *
- * /--- BLOCK END 00 000 81/07/17 12.12
- *
- *
- *
- END
- * /--- BLOCK TABC 00 000 81/07/14 00.08
- IDENT TABC
- TITLE TABC
- TITLE CENTRAL SUBOV TABLE
- CST
- * /--- BLOCK ENTRY 00 000 81/07/10 00.54
- * ENTRIES FOR CONDC
- ENTRY OK=,ANSV=,FINIS=,BACKG=
- ENTRY HOLFIN,WRONGV=
- * /--- BLOCK COVLAY 00 000 81/07/14 00.04
- *
- *
- ENTRY OVRLAYS FOR OFFSET IN COMMAND TABLE
- OVRLAYS BSS 0
- *
- * COVLAY1
- *
- SUBOV ENABOV
- SUBOV PAUSOV
- SUBOV DABSOV
- SUBOV CFINOV
- SUBOV JMPFOV -JUMPOUT- AND -FROM-
- SUBOV CDATAOV VARIOUS DATA COMMANDS
- SUBOV READDOV -READD-
- * SUBOV NOTEOV
- SUBOV NNOTEOV
- SUBOV INTLOKV
- SUBOV ATCHOV -ATTACH- AND -DETACH- COMMANDS
- SUBOV KERMCOV KERMIT PROTOCOL
- *
- * GRAFSC
- *
- SUBOV GRAFOV
- *
- * ANSIN
- *
- SUBOV ANSOV
- *
- * DEFINE
- *
- SUBOV DEFOV
- SUBOV SEGOV
- *
- * COVLAY2
- *
- SUBOV LIBCOV LIBCALL/CALL COMMANDS
- SUBOV WRITCOV -WRITEC-
- SUBOV INITOV INITS FOR EACH CONDENSE
- SUBOV LISTOV LESLIST ORIENTED COMMANDS
- SUBOV CHGOV -CHANGE- COMMAND
- SUBOV DRAWOV -DRAW-
- SUBOV PUTOV -PUT- AND -PUTD-
- SUBOV COMMOV -COMMON- -STORAGE- -ROUTVAR-
- SUBOV SORTOV -SORT-
- SUBOV TRQCOV -TALKREQ-
- SUBOV FONTCOV -FONT-
- *
- * ANSWIN
- *
- SUBOV ANSWOV
- *
- * TOUCHOV
- *
- SUBOV TOUCHOV -TOUCH-
- *
- *
- * COVLAY3
- *
- SUBOV PACKOV -PACK-
- SUBOV SETROV SETRESV
- SUBOV SUBMOV -SUBMITM-
- SUBOV FINDSOV -FINDS-
- SUBOV INSRTOV -INSERTS-/-DELETES-
- SUBOV COVL3
- SUBOV TSLINKC
- SUBOV IPCC IPC / CHARACNV COMMANDS
- SUBOV NSETOV NAMESET COMMAND READINS
- SUBOV COVL3B VARIOUS COMMAND READINS
- SUBOV KEYWDOV -ATTACHF-
- *
- * RECORDC
- SUBOV RECOV RECORDS COMMAND
- *
- * SITEC
- SUBOV SITEOV -SITE- COMMANDS
- SUBOV STATIOV -STATION- COMMANDS
- SUBOV NSITEOV -NSITE/SUBSITE/NSTAT- COMMANDS
- *
- * PPTC
- SUBOV PPTOV -PPT- COMMANDS
- SUBOV MTUTOV CPU MICROTUTOR COMMANDS
- *
- * COVLAY4
- SUBOV COV4 ASSORTED COMMANDS
- SUBOV COV4A MORE ASSORTED COMMANDS
- SUBOV JOINOV
- SUBOV ACCOV ACCESS COMMAND OVERLAYS
- SUBOV COV4B
- *
- * CWRITE
- SUBOV CWRTOV
- *
- * TAGOV
- SUBOV TAGOV
- * /--- BLOCK COMNDS 00 000 81/07/13 20.32
- TITLE CENTRAL CONDENSE COMMAND NAME TABLE
- *
- * THE FOLLOWING TABLE CONTAINS AN ORDERED LIST OF
- * ALL THE LEGAL TUTOR COMMANDS.
- *
- *
- * EXAMPLE OF CONSTRUCTION OF JUMP TABLE --
- *JUMP MACRO 8LSTORE,STORE,2,ONEPUT,01110,STOREJ
- * NAME,DISPLAY NAME,TYPE,CONDENSOR,CONTINGENCIES,EXECUTOR
- *
- *
- * FOR COMMANDS WITH ONLY ONE BRANCH, THE BRANCH
- * IS EXPLICITLY GIVEN IN THE BOTTOM 18 BITS OF THE
- * TABLE ENTRY.
- *
- JUMP MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2
- VFD 60/NAME
- JMP1 RMT
- + VFD 12/0,13/0,5/TYPE,12/0,18/=X_JUMP1
- JMP1 RMT
- NN SET NN+1 COUNTER FOR COMMAND NUMBER
- MM SET MM+1 COUNTER FOR REAL COMMANDS
- 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
- VFD 60/NAME
- NAM MICRO 3,8, NAME_=
- "NAM" EQU NN
- JMP1 RMT
- IFC EQ,*JUMP1*CM*
- VFD 12/0,13/0,5/TYPE,12/0,18/=X_ARG1
- ELSE
- + VFD 12/0,13/0,5/TYPE,12/0
- VFD 1/1,8/JUMP1-OVRLAYS,1/0,8/ARG1
- ENDIF
- JMP1 RMT
- NN SET NN+1 COUNTER FOR COMMAND NUMBER
- MM SET MM+1 COUNTER FOR REAL COMMANDS
- ENDM
- *
- * JUMPD PERMITS REFERENCING THIS COMMAND NUMBER
- *
- JUMPD MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2
- VFD 60/NAME
- NAM MICRO 3,8, NAME_=
- "NAM" EQU NN
- JMP1 RMT
- + VFD 12/0,13/0,5/TYPE,12/0,18/=X_JUMP1
- JMP1 RMT
- NN SET NN+1 COUNTER FOR COMMAND NUMBER
- MM SET MM+1 COUNTER FOR REAL COMMANDS
- ENDM
- * /--- BLOCK COMNDS 00 000 81/07/14 10.58
- *
- * JUMP* HOLDS A COMMAND NUMBER SLOT OPEN BUT THE COMMAND
- * NAME CANNOT ACTUALLY BE MATCHED (E.G., GOTOC)
- *
- JUMP* MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2
- NM MICRO 3,5,/NAME /
- VFD 6/0,54/5L"NM"
- JMP1 RMT
- + VFD 60/0
- JMP1 RMT
- NN SET NN+1 COUNTER FOR COMMAND NUMBER
- ENDM
- *
- * JUMPD* IS COMBINATION OF JUMPD AND JUMP*
- *
- JUMPD* MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2
- NM MICRO 3,5,/NAME /
- VFD 6/0,54/5L"NM"
- NAM MICRO 3,8, NAME_=
- "NAM" EQU NN
- JMP1 RMT
- + VFD 60/0
- JMP1 RMT
- NN SET NN+1 COUNTER FOR COMMAND NUMBER
- ENDM
- *
- * END THE JUMP TABLE
- *
- JUMPF MACRO
- LIST -L
- DUP 512-NN
- JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERRORX
- ENDD
- LIST *
- ENDM
- *
- * USED FOR NON-EXECUTABLE COMMANDS WHICH ARE IN CM
- *
- JUMPI MACRO NAME,TYPE,JUMP1
- VFD 60/NAME
- JMP1 RMT
- + VFD 12/0,13/0,5/TYPE,12/0,18/=X_JUMP1
- JMP1 RMT
- NN SET NN+1 COUNTER FOR COMMAND NUMBER
- MM SET MM+1 COUNTER FOR REAL COMMANDS
- ENDM
- *
- * USED FOR NON-EXECUTABLE COMMANDS IN OVERLAYS
- *
- JUMPIO MACRO NAME,TYPE,JUMP1,ARG1
- VFD 60/NAME
- JMP1 RMT
- + VFD 12/0,13/0,5/TYPE,12/0
- VFD 1/1,8/JUMP1-OVRLAYS,1/0,8/ARG1
- JMP1 RMT
- NN SET NN+1
- MM SET MM+1
- ENDM
- *
- * /--- BLOCK COMNDS 00 000 81/07/14 00.07
- ENTRY COMNAMS
- *
- COMNAMS BSS 0
- *
- NOREF NN,MM
- NN SET 0 COMMAND NUMBER COUNTER
- MM SET 0 REAL COMMAND COUNTER
- *
- LIST X,G
- *
- *CALL COMNDS
- *
- LIST *
- *
- *
- ***** END OF TABLE OF REAL COMMANDS *********
- *
- *
- ENTRY COMNAML,COMINFL
- COMNAML EQU *-COMNAMS LENGTH OF NAME TABLE
- COMINFL EQU 513 LENGTH OF INFO TABLE (2&N+1)
- *
- 2 ERRNG CMNDMAX-COMNAML FOR PECULIAR ERROR TEST..
- * DUE TO ECS TABLE FOR TRUE COMMAND TABLE BEING IN
- * EXECUTER CONTROL POINT...WHICH SEE...THIS WILL
- * AUTOMATICALLY GIVE AN ERROR WHEN THE BUFFER IS
- * TOO SMALL FOR CONDENSOR CONTROL POINT.
- 2 ERRNG COMINFL-1-MM LEAVE ONE FREE WORD AT END OF COMINFO
- 2 ERRNG COMNAML-COMINFL ASSUME COMNAML IS NOT SMALLER
- *
- *
- TITLE READ-IN JUMP TABLE
- * FORMAT OF INFO TABLE WORDS (COMINFO)
- * 12 BITS -- LINK TO NEXT WORD WITH THIS HASH NUMBER
- * 1 BIT -- SET IF THIS IS FIRST WORD OF HASH CHAIN
- * 1 BIT -- SET IF THIS IS AN ELSE-TYPE COMMAND
- * 1 BIT -- SET IF THIS IS A CALC-TYPE COMMAND
- * 1 BIT -- SET IF INDENTING IS ALLOWED AFTER THIS COMMAND
- * 1 BIT -- SET IF THIS COMMAND MAY NOT BE INDENTED
- * 1 BIT -- FLAG FOR CONTINUED COMMAND
- * 12 BITS -- INDEX TO NAME TABLE FOR THIS COMMAND
- * 18 BITS -- ADDRESS OF CONDENSE ROUTINE
- * -- FOR OVERLAYED COMMANDS, THIS FIELD
- * CONTAINS THE OVERLAY NUMBER AND AN
- * ARGUMENT FOR THE OVERLAY.
- * 12 BITS -- COMMAND NUMBER FOR THIS COMMAND
- * THE COMMAND NUMBER AND INDEX TO NAME TABLE FIELDS
- * ARE INITIALIZED IN FILE DEFCCOM.
- SPACE 1
- ENTRY COMINFO
- COMINFO BSS 0
- LOC 0 DEFINE COMMAND NAMES
- LIST M,G
- JMP1 HERE
- LIST *
- LOC *O RETURN TO ORIGIN COUNTER
- * /--- BLOCK COMNDS 00 000 81/07/14 00.07
- *
- *
- DATOT= EQU DATAOUT= NO 8 CHAR EXTERNAL SYMBOLS
- IFERR= EQU IFERROR=
- ZAT= EQU AT=+1 FOR EMBEDDED AT (LOADER PROB)
- SHOWS= EQU SHOW=
- BACKG= EQU BACKGND=
- ARHDA= EQU ARHEADA=
- *
- ENTRY BRKCMD
- ENTRY CALCNAM
- ENTRY HOLDEFN
- ENTRY USENAM
- ENTRY UNITNAM,UNITPNM,ENTRYNM
- ENTRY STPSNAM
- ENTRY STRTNAM
- ENTRY STOPNAM
- ENTRY MTUTNAM
- ENTRY DATAON=,IEUEND=
- ENTRY PAUSE=
- ENTRY KERMIT=
- ENTRY WRITE0=
- ENTRY WRITE1=
- ENTRY WRITE2=
- ENTRY WRITE3=
- ENTRY WRITE4=
- ENTRY WRITEC=
- ENTRY SHOW=
- ENTRY SHOWS=
- ENTRY SHOWT=
- ENTRY SHOWA=
- ENTRY SHOWO=
- ENTRY SHOWH=
- ENTRY SHOWE=
- ENTRY SHOWZ=
- ENTRY SHOWK=
- ENTRY HIDDEN=
- ENTRY ZAT=
- ENTRY ATNM=
- ENTRY SIZE=
- ENTRY ROTATE=
- ENTRY STORE=
- ENTRY ARHDA= $$ ARHEADA= IS TOO LONG
- ENTRY UNITOP=
- ENTRY ARGS=,CALC=
- ENTRY DO=,DOJ=,DOC=,JOIN=,JOINC=,JDO=
- *
- * FOLLOWING FOR PUT OVERLAY
- ENTRY PUT=
- ENTRY MISCON= NEEDED TO SEPARATE CONCEPT/MISCON IN ANSIN
- * FOR -DATAOUT- OVERLAY
- ENTRY DATOT=
- * FOR -IFERROR- OVERLAY
- ENTRY IFERR=
- ENTRY DOR=
- ENTRY JOINR=
- ENTRY STOP1=
- ENTRY COLOR=
- END
plato/source/plaopl/condc.txt · Last modified: 2023/08/05 18:54 by Site Administrator