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