CONTEN
* /--- FILE TYPE = E
* /--- BLOCK BLANK 00 000 76/05/11 23.52
*
* LONG-RANGE PROBLEMS ******************************************
*
* WORD(FONT)SP/ SHOULD BE ALLOWED...IT SOLVES THE
* INFORMATIONAL PROBLEM O HAVING FONT AS LAST CHAR
* OF BASE WORD
*
*
* THE EXPONENT ROUTINE DOES NOT HANDLE PARENTHESES
* SO -2.3**3.5 IS -(2.3**3.5)
*
* LOCKING SUP IN NUMBERS PROBABLY NOT RIGHT IN ALTERNATE FONT
*
*
* MAYBE PROBLEM WITH SPECS ALPHXNUM IN WORDS IF NUMBER
* IS PRECEEDED BY SUP/SUB
*
*
************************************************************************
* /--- BLOCK INFO 00 000 77/12/17 14.18
IDENT CONTENT
*
CST
*
TITLE CONTENT
*
* THIS ROUTINE IS USED BY BOTH THE CONDENSER AND
* THE EXECUTER...SO BE DOUBLY CAREFUL...
*
*
*
ENTRY CONTENT
*
* ON ENTRY...A1 SHOULD BE INITIALIZED TO ADDRESS OF PREVIOUS
* CHARACTER (I.E., +1 WILL BE CURRENT CHARACTER TO LOOK AT)
*
*
* THE NEXT WORD OR NUMBER IS FOUND IN A CHARACTER
* STRING AND FORMED INTO A CHARACTER STRING CONTENT WORD
* USED FOR CHECKING IF TWO WORDS/NUMBERS ARE THE SAME OR
* SLIGHTLY DIFFERENT FROM ONE ANOTHER.
*
*
* ON EXIT...
*
**********
* X1 HOLDS STOPPING OPERATION CODE
* A1 HOLDS ADDRESS OF LAST 6-BIT CHARACTER CODE
* PRODUCING STOPPING OPERATION
*
**********
* X6 IS THE CONTENT WORD
*
* 0...UNUSED (FOR HASH SEARCHES)
* 1-3...NUMBER OF VOWELS
* 4-7...NUMBER OF CONSONANTS
* 8-59...CONTENT BITS
*
**********
* X7 IS HASH (=0 IF NOTHING CONTENTED)
*
* 0...UNUSED (FOR HASH SEARCHES)
* 1...0=WORD, 1=NUMBER
* 2-16...WORD HASH, OR 2=SIGN BIT OF NUMBER
* 17-22...FIRST LETTER
* 23-25...NUMBER OF CONSONANT/VOWEL PAIRS
* 26...CAPITALIZATION BIT
* 27-59...ZERO
*
* /--- BLOCK FIRST 00 000 78/01/07 18.46
SPACE 6
CONTENT EQ *
*
*
SX6 B5 SAVE B5
MX7 0
SA6 CBSAVE
SA7 CSSTEMP CLEAR TEMPORARY SUP/SUB BIAS
*
*
FIRST RJ GETOP GET NEXT OPERATION CODE
JP B2+FIRTAB
FIRTAB EQ CONOUT 0.END OF LINE
EQ CL1 1.LETTERS (CONSONANTS)
EQ CL1 2.LETTERS (VOWELS)
EQ CL1 3.DIACRITIC...HANDLE AS LETTER HERE
EQ CLN 4.NUMBERS (0-9)
+ SX4 1
EQ FIRSS 5.SUPERSCRIPT
+ SX4 -1
EQ FIRSS 6.SUBSCRIPT
EQ CL1 7.BACKSPACE
EQ CONOUT 8.CARRIAGE RETURN
MX0 0 SET UNARY SIGN TO PLUS
EQ SIGNPM 9.+
MX0 -0 SET UNARY SIGN TO MINUS
EQ SIGNPM 10.-
EQ CONOUT 11.*
EQ CONOUT 12./
EQ FIRST 13. SPACE...JUST INCREMENT OVER IT
EQ CONOUT 14.,
EQ FIRPER 15..PERIOD
EQ CONOUT 16.;
EQ CONOUT 17.(
EQ CONOUT 18.)
EQ CONOUT 19.<
EQ CONOUT 20.>
EQ CONOUT 21.=
EQ CONOUT 22. START EMBED
EQ CONOUT 23. END EMBED
EQ CONOUT 24. MISC PUNCTUATIONS
EQ CL1 25. PUNC AND WORD
*
*
* STARTING WITH A NUMBER
CLN SA3 TSPECS
LX3 ALLWDS SEE IF SPECS ALLWORDS
MX0 0 CLEAR UNARY MINUS FLAG
NG X3,CL1 GO TO WORD CONTENTER
EQ CNUM ELSE, GO TO NUMBER CONTENTER
*
*
* SEE IF DECIMAL POINT OR PERIOD
FIRPER SA3 TSPECS
LX3 ALLWDS SEE IF SPECS ALLWORDS
MX0 0 CLEAR UNARY SIGN TO PLUS
NG X3,CONOUT
RJ GETOPN GET THE NEXT OPERATION CODE
SX7 B3-COPNUM
ZR X7,CNUM SEE IF NUMBER
EQ CONOUT ELSE A PERIOD
*
* /--- BLOCK FIRST 00 000 77/12/08 15.19
*
*
FIRSS LX2 7 SEE IF LOCKING SUP/SUB
NG X2,FIRSS1
SA3 CSSTEMP LOAD TEMPORARY
EQ FIRSS2
FIRSS1 SA3 CSSPERM LOAD PERMANANT
FIRSS2 IX6 X3+X4 ADD NEW TO ON-GOING
SA6 A3
EQ FIRST AND ONTO NEXT LETTER
*
* SEE IF + - PART OF A NUMBER
SIGNPM SA3 TSPECS
LX3 ALLWDS SEE IF SPECS ALLWORDS
NG X3,CL1
RJ GETOPN GET THE NEXT OPERATION CODE
SX7 B3-COPNUM
ZR X7,SIGNPM1 SEE IF NUMBER
SX7 B3-COPPER
NZ X7,CONOUT ELSE EXIT
SX6 A1 SAVE A1
SA1 A3 SET BY LAST GETOPN
RJ GETOPN GET NEXT OPERATION CODE
SA1 X6 RESTORE
SX7 B3-COPNUM
NZ X7,CONOUT EXIT IF NOT NUMBER
SIGNPM1 SX6 A0+1 SAVE STARTING CHARACTER ADDRESS
SA6 CFIRST
RJ GETOP NOW MOVE TO THE NEXT OPERATION
EQ CNUM1
*
*
* /--- BLOCK LETTERS 00 000 78/01/04 00.48
*
* CONTENT A WORD...FIRST LETTER ENTERS HERE
CL1 SX6 A0+1 SAVE STARTING CHARACTER ADDRESS
SA6 CFIRST
*
* IFEQ *F,2 ONLY FOR CONDENSOR
CONDEN
SA3 FONTFLG GET CURRENT FONT FLAG
BX7 X3 SAVE STARTING FONT FLAG FOR USE IN ENDINGS
SA7 EFSTART
ENDIF
*
SA3 CBITHF GET CONTENT BITS FLIP/FLOP WORD
BX5 X3 **** X5 SET UNTIL DONE PROCESSING WORD
*
MX0 0 CLEAR FIRST LETTER,CAP BIT,ETC
MX6 0 CLEAR ALL CONTENT BITS
*
SA3 CSSPERM GET SUP/SUB BIAS
SA4 CSSTEMP
IX7 X3+X4 AND INITIALIZE HASH
NG X7,CL1A POS MUST DIFFER FROM NEG SO THAT 60 TO 15
LX7 7 BIT HASH SMASH RETAINS DIFFERENCE
CL1A SA6 A4 AND CLEAR TEMP
*
LX2 8 SET CAP BIT
MX3 59
BX0 -X3*X2
BX2 X3*X2 AND CLEAR IT OUT
*
LX2 7 GET CHARACTER BITS
MX3 51 AND FONT AND ACCESS
BX2 -X3*X2 MASK OFF ALL OTHER BITS
BX1 X2 SAVE IN X1 FOR POSSIBLE USE AT CC1
LX2 4 SAVE THE FIRST LETTER AND FONT AND ACCESS
BX0 X2+X0
* AND OTHER 4 BITS ARE -DIFF- INTO HASH LATER
SB1 B0 INITIALIZE CONSONANT COUNTER
SB4 B0 INITIALIZE VOWEL COUNTER
*
SX2 B2-COPPUWD SEE IF PUNCTUATION AND WORD
NZ X2,CL2
SB2 COPLET SET TO LETTER OPERATION FOR OTHERS
SB5 A1 SAVE AS ENDING ADDRESS
SB6 X1 SAVE AS LAST CHARACTER
RJ GETOPN GET NEXT SYMBOL
SX2 B3-COPASTR SEE IF PHRASE MARKER
NZ X2,CLOOPX EXIT IF NOT
RJ GETOP MOVE AHEAD TO POINT AT PHRASE
EQ CLOOPX
*
CL2 SX2 B2-COPVOWL
NZ X2,CC1 SEPARATE CON/VOW
* /--- BLOCK LETTERS 00 000 78/01/04 01.09
*
* START WITH A VOWEL
CV1 SB4 B4+1 INCREMENT VOWEL COUNT
*
RJ CRJ GET NEXT CHARACTER
*
SX2 B2-COPVOWL
ZR X2,CV1 SEPARATE CON/VOW
*
* SET A BIT FOR FIRST CONSONANT IN WORD STARTING WITH VOWELS
MX3 58
BX2 -X3*X1 GET BYTE INDEX
LX2 3 TIMES 8
SB3 X2
BX2 X1
AX2 2 GET WORD INDEX
MX3 57
BX2 -X3*X2 MASK TO 8 POSSIBILITIES
SA2 CVBITS2+X2 GET WORD WITH 4 ENTRIES
LX2 X2,B3
AX2 52 GET ENTRY DESIRED
SB3 X2
MX2 1
LX2 X2,B3 GET BIT INTO POSITION
BX6 X6+X2 ADD BIT TO CONTENT BITS
*
*
CC1 SB1 B1+1 INCREMENT CONSONANT COUNT
SB3 X1 SAVE FOR POSSIBLE C/V CASE
*
RJ CRJ GET NEXT CHARACTER
*
SX2 B2-COPVOWL
NZ X2,CC1 SEPARATE CON/VOW
*
*
*
SX0 X0+10000B INCREMENT COUNT OF C/V PAIRS
*
* SET CONSONANT/VOWEL BIT HERE
MX3 58
SX4 B3 GET PREVIOUS CONSONANT
BX2 -X3*X4 GET BYTE INDEX
LX2 3 TIMES 8
SB3 X2
AX4 2 GET WORD INDEX
MX3 57
BX2 -X3*X4 MASK TO 8 POSSIBILITIES
SA2 CVBITS+X2 GET WORD WITH 4 ENTRIES
LX2 X2,B3
AX2 52 GET ENTRY DESIRED
SB3 X2
MX2 1
LX2 X2,B3 GET BIT INTO POSITION
BX6 X6+X2 ADD BIT TO CONTENT BITS
*
CVV1 SB4 B4+1 INCREMENT VOWEL COUNT
*
RJ CRJ GET NEXT CHARACTER
*
SX2 B2-COPVOWL
NZ X2,CC1 SEPARATE CON/VOW
EQ CVV1 ELSE TO VOWEL AGAIN
*
*
CRJF SA3 CSSPERM GET PERMANANT SUP/SUB BIAS
SA4 CSSTEMP GET TEMPORARY SUP/SUB BIAS
IX3 X3+X4 ADD TOGETHER TO GET TOTAL BIAS
NG X3,CRJF0A POS MUST DIFFER FROM NEG SO THAT 60 TO 15
LX3 7 BIT HASH SMASH RETAINS DIFFERENCE
CRJF0A BX7 X7-X3 ADD THIS NUMBER TO HASH
BX3 X6 SAVE X6
MX6 0 CLEAR TEMPORARY SUP/SUB BIAS
SA6 A4
BX6 X3
* /--- BLOCK CRJ 00 000 77/12/08 15.42
*
LX2 15 GET CHARACTER BITS LOWER
MX3 51 FONT-SHIFT-ACCESS-6 BIT CHAR CODE
BX1 -X3*X2
LX7 11 JIGGLE HASH
BX7 X7-X1 ADD NEW CHARACTER TO HASH
MX3 1 NOW SET CONTENT BIT FOR THIS CHAR
NG X5,CRJF1 GET LEFT-RIGHT TOGGLE
LX3 26
CRJF1 SB5 X1
LX4 X3,B5 SHIFT CONTENT BIT TO UNIQUE SPOT
BX6 X6+X4 ADD NEW CONTENT BIT
LX5 1 MOVE LEFT-RIGHT TOGGLE DOWN ONE
* EXIT
*
CRJ EQ * GET NEXT CHARACTER FOR WORD CONTENTING
SB5 A1 SAVE THIS ADDRESS AS POSSIBLE ENDING ADDRS
SB6 X1 SAVE LAST CHARACTER FOR END
CRJJP RJ GETOP GET NEXT OPERATION CODE
JP B2+CRJT JUMP INTO SYMBOL ACTION TABLE
*
CRJT EQ CLOOPX 0.END OF LINE
EQ CRJF 1.LETTERS (CONSONANT)
EQ CRJF 2.LETTERS (VOWEL)
EQ CNOVAL 3.DIACRITIC...OF LITTLE SPELLING VALUE
EQ CRJNUM 4.NUMBERS (0-9)
+ SX4 1 SUP IS INCREMENT
EQ CRJSS 5.SUPERSCRIPT
+ SX4 -1 SUB IS DECREMENT
EQ CRJSS 6.SUBSCRIPT
EQ CRJF 7.BACKSPACE
EQ CLOOPX 8.CARRIAGE RETURN
EQ CRJPM 9.+
EQ CRJPM 10.-
EQ CLOOPX 11.* (COULD BE PHRASE SYMBOL)
EQ CLOOPX 12./
EQ CLOOPX 13. SPACE
EQ CLOOPX 14.,
EQ CLOOPX 15..PERIOD
EQ CLOOPX 16.;
EQ CLOOPX 17.(
EQ CLOOPX 18.)
EQ CLOOPX 19.<
EQ CLOOPX 20.>
EQ CLOOPX 21.=
EQ CLOOPX 22. START EMBED
EQ CLOOPX 23. END EMBED
EQ CLOOPX 24. MISC. PUNCT MARKS
EQ CRJPUWD 25. PUNC AND WORD
*
*
* /--- BLOCK NEXTCHAR 00 000 77/12/08 15.20
*
CRJPUWD SB2 COPLET PUNC AND WORD...SET TO LETTER FOR OTHERS
SA1 A0 RESET TO DO THIS AGAIN
EQ CLOOPX EXIT
*
*
CRJNUM SA3 TSPECS SEE IF LETTER/NUMBER BOUNDARY
LX3 ALNUM ACTS AS A PUNCTUATION
PL X3,CRJF BRANCH IF LETTER/NUMBER NOT A PUNCTUATION
*
SA1 A0 REFIX A1 TO POINT JUST BEFORE LAST SYMBOL
EQ CLOOPX AND EXIT WORD BUILDING LOOP
*
*
*
CRJSS LX2 7 SEE IF LOCKING SUP/SUB
NG X2,CRJSS1
SA3 CSSTEMP LOAD TEMPORARY
EQ CRJSS2
CRJSS1 SA3 CSSPERM LOAD PERMANANT
CRJSS2 BX2 X6 SAVE X6
IX6 X3+X4 ADD IN NEW CHANGE
SA6 A3
BX6 X2
* SPECIAL SINCE THIS MIGHT BE END OF WORD
* IN WHICH CASE, JUST IGNORE
EQ CRJJP THEN BACK INTO TABLE
*
* /--- BLOCK NEXTCHAR 00 000 78/01/04 01.09
*
* DIACRITIC...CHARACTERS OF LITTLE SPELLING
* VALUE...JUST ADD TO HASH.
CNOVAL SA3 CSSPERM GET PERMANANT SUP/SUB BIAS
SA4 CSSTEMP GET TEMPORARY SUP/SUB BIAS
IX3 X3+X4 ADD TOGETHER TO GET TOTAL BIAS
NG X3,CNOVAL1 POS MUST DIFFER FROM NEG SO THAT 60 TO 15
LX3 7 BIT HASH SMASH RETAINS DIFFERENCE
CNOVAL1 BX7 X7-X3 ADD THIS NUMBER TO HASH
BX3 X6 SAVE X6
MX6 0 CLEAR TEMPORARY SUP/SUB BIAS
SA6 A4
BX6 X3
*
LX2 15 GET CHARACTER BITS LOWER
MX3 51 FONT-SHIFT-ACCESS-6 BIT CHAR CODE
BX1 -X3*X2
LX7 11 JIGGLE HASH
BX7 X7-X1 ADD NEW CHARACTER TO HASH
*
SB5 A1 SAVE THIS ADDRESS AS POSSIBLE END
EQ CRJJP ON TO NEXT SYMBOL
*
*
CRJPM SA0 B3 SAVE B3...SEE IF + - AT END LETTERS
RJ GETOPN
SX3 B3
SB3 A0 RESTORE
ZR X3,CRJF
SX4 X3-COPNUM EXIT IF LETTER FOLLOWS
PL X4,CRJF IF NOT, THEN CONTINUE
** EQ CLOOPX ELSE STOP WORD BUILDING
*
*
CLOOPX SA0 B5 PUT END ADDRESS OF LAST SYMBOL INTO A0
* SINCE THAT IS WHERE THE FOLLOWING
* EXPECTS IT AND THE FOLLOWING WILL BE
* RE-WRITTEN SHORTLY ANYWAY...
MX3 58 NOW ADD SPECIAL BIT FOR LAST LETTER
SX4 B6 GET LAST CHARACTER AGAIN
BX2 -X3*X4 GET BYTE INDEX
LX2 3 TIMES 8
SB3 X2
AX4 2 GET WORD INDEX
MX3 57
BX2 -X3*X4 MASK TO 8 POSSIBILITIES
SA2 CVBITS2+X2 GET WORD WITH 4 ENTIRES
LX2 X2,B3
AX2 52 GET ENTRY DESIRED
SB3 X2
MX2 1
LX2 X2,B3 GET BIT INTO POSITION
BX6 X6+X2 ADD BIT TO CONTENT BITS
*
SX2 B4 NOW SAVE VOWEL COUNT
SB4 B4-8 SEE IF OVERFLOW FIELD
NG B4,VOK
SX2 7
* /--- BLOCK LETEND 00 000 78/01/07 18.47
VOK LX2 56 POSITION
BX0 X0+X2
*
SX2 B1 SAVE CONSONENT COUNT
SB1 B1-16 SEE IF OVERFLOW FIELD
NG B1,COK
SX2 15
COK LX2 52
BX0 X0+X2
*
*
*
MX3 8 NOW SHAPE UP FINAL X6
BX2 X3*X6
BX6 -X3*X6
LX2 8
BX6 X6-X2
BX2 X3*X0 GET VOWEL AND CONSONENT COUNTS
BX6 X6+X2 X6 NOW READY
BX0 -X3*X0 CLEAR C AND V COUNTS FROM X0
*
*
* TURN HASH INTO A 15 BIT ENTITY
BX3 X7 GET 30 BIT HASH
LX7 30
BX3 X3-X7
BX7 X3 GET 15 BIT HASH
LX7 15
BX3 X3-X7
MX4 45
BX3 -X4*X3 NOW HAVE 15 BITS OF HASH
*
MX4 48 GET C/V COUNT
BX2 X4*X0
BX0 -X4*X0 CLEAR OUT
AX2 11 POSITION
MX4 56
BX4 X4*X2
ZR X4,CXAV MUST FIT IN 3 BITS
SX2 16B
CXAV BX0 X0+X2
*
LX3 10
BX7 X3-X0 DIFF SINCE FIRST LETTER MIGHT
* CONTAIN FONT AND ACCESS BITS
LX7 33 X7 NOW HAS HASH-INFO WORD
*
*
CDONE2 SX1 B2 PUT LAST OPERATION CODE INTO X1
* A1 HOLDS ADDRESS OF LAST CHARACTER
SA2 CBSAVE RESTORE B5
SB5 X2
*
EQ CONTENT
*
*
CONOUT MX7 0 SET TO NOTHING CONTENTED
EQ CDONE2
* /--- BLOCK TABLES 00 000 78/08/16 16.03
*
*
*
ENTRY CFIRST
CFIRST BSS 1 ADDRESS OF FIRST REAL CHARACTER
*
*
ENTRY FONTFLG
FONTFLG BSS 1 BIT 100B TOGGLED TO KEEP TRACK OF FONT
* INITIALIZED TO ZERO AT WORDGET IN PLATO
* AT GETLINE IN CONDENSOR
* AT COMPARE IN ANSW1
*
* IFEQ *F,2
CONDEN
ENTRY EFSTART FLAG USED FOR FONT OF BASE WORD IN ENDINGS
EFSTART BSS 1
ENDIF
*
*
*
* CONSONANT/VOWEL BITS
CVBITS VFD 8/0,8/0,8/49,8/43,28/0 -ABC
VFD 8/17,8/0,8/37,8/39,28/0 DEFG
VFD 8/52,8/0,8/38,8/29,28/0 HIJK
VFD 8/50,8/7,8/24,8/0,28/0 LMNO
VFD 8/11,8/33,8/10,8/43,28/0 PQRS
VFD 8/26,8/0,8/32,8/22,28/0 TUVW
VFD 8/30,8/0,8/36,8/0,28/0 XYZ0
VFD 8/0,8/0,8/0,8/0,28/0
*
* MISCELLANEOUS BITS
CVBITS2 VFD 8/0,8/11,8/23,8/22,28/0 -ABC
VFD 8/36,8/25,8/43,8/49,28/0 DEFG
VFD 8/7,8/37,8/6,8/33,28/0 HIJK
VFD 8/30,8/2,8/42,8/29,28/0 LMNO
VFD 8/17,8/29,8/47,8/51,28/0 PQRS
VFD 8/21,8/48,8/27,8/30,28/0 TUVW
VFD 8/37,8/16,8/2,8/0,28/0 XYZ0
VFD 8/0,8/0,8/0,8/0,28/0
*
*
* CONTENT BIT TOGGLE...TELLS WHICH SIDE
* OF CONTENT WORD BITS ARE BEING ADDED
CBITHF DATA 70176007770007770000B 3-5-6-7-9-9...
*
CSSTEMP BSS 1 TEMPORARY SUP/SUB BIAS
ENTRY CSSPERM INITIALIZED BY GETLINE AND WORDGET
* AT COMPARE IN ANSW1
CSSPERM BSS 1 PERMANANT SUP/SUB BIAS
*
* /--- BLOCK NUMBER 00 000 76/07/23 01.22
*
TITLE NUMBERS
*
CNUM SX6 A0+1 SAVE FIRST CHARACTER
SA6 CFIRST
CNUM1 MX6 0 CLEAR NUMBER A-BUILDING
RJ CNUMR GET FIRST ARGUMENT
*
* NOW SEE WHAT NEXT OPERATION IS
SX7 B2-COPPLUS CHECK FOR +-*/
NG X7,CNUMEND JUMP IF NOT +-*/
SA7 CNUMOP SAVE OPCODE
AX7 2 +-*/ GIVES 0,1,2,3 IN X7
NZ X7,CNUMEND JUMP IF NOT +-*/
*
RJ GETOPN GET NEXT OPERATION .. NOT ADVANCING
*
SX7 B3-COPPER CHECK FOR DECIMAL POINT
NZ X7,CNUM2 IF NOT CHECK FOR NUMBER
SX0 A1 SAVE A1
SA1 A3 SET A1 TO LAST CHAR OF LAST GETOPN
RJ GETOPN GET ANOTHER OPERATION .. NOT ADVANCING
SA1 X0 RESTORE A1
*
CNUM2 SX7 B3-COPNUM SEE IF NUMBER
NZ X7,CNUMEND IF NOT NUMBER THEN FINISHED
SA6 FSTARG SAVE FIRST NUMBER
MX6 0 CLEAR NUMBER A-BUILDING
MX0 0 NO FURTHER UNARY MINUS
RJ GETOP REALLY GET NEXT OPERATION
RJ CNUMR GET SECOND ARGUMENT
*
+ SA3 CNUMOP PICK UP OPERATION CODE
SB4 X3 STORE IT IN B4
SA3 FSTARG PICK UP FIRST ARGUMENT
JP PERFORM+B4 JUMP TO APROPOS ARITHMETIC
*
*
PERFORM FX6 X3+X6 PLUS
NX6 X6 NORMALIZE ADDITION
EQ LSTCHEK
+ FX6 X3-X6 MINUS
NX6 X6 NORMALIZE SUBTRACTION
EQ LSTCHEK
+ FX6 X3*X6 MULTIPLY
EQ LSTCHEK
+ FX6 X3/X6 DIVIDE
EQ LSTCHEK
*
* MAKE LAST CHECK THAT THERE IS NO 3RD NUMERICAL ARG.
LSTCHEK SX7 B2-COPPLUS SEE IF ANOTHER NUMERICAL OPERATION
NG X7,CNUMEND
AX7 2
NZ X7,CNUMEND JUMP IF NOT +-*/
*
RJ GETOPN GET NEXT OPERATION .. NOT ADVANCING
*
*
* IFEQ *F,2 SPECIAL FOR CONDENSE ERROR TO AUTHOR
CONDEN
SX7 B2-COPNUM
NZ X2,CNUMEND JUMP IF NOT NUMERICAL
EXT ERRORC
EQ ERRORC ERROR IN READIN
ENDIF
*
* /--- BLOCK NUM BUILD 00 000 77/11/30 20.38
CNUMEND MX7 1
BX3 X6*X7 GET SIGN BIT
BX6 -X7*X6 KILL ANY SIGN BIT IN -CONTENT- WORD
AX3 1
BX7 X3+X7 AND SET TOP BIT IN -HASH- WORD
LX7 59 LEAVE TOP BIT ZERO FOR BINARY CHOP TO WORK
SX2 B2-COPPUWD SEE IF RAN INTO PUNCWORD
NZ X2,CNUMED2
SB2 COPLET MAKE LIKE LETTER FOR OTHERS
SA1 A0 RESET A1 SO REDO THIS ONE AGAIN
EQ CDONE2
CNUMED2 SX2 B2-COPCR SEE IF RAN INTO A WORD
PL X2,CDONE2
SA1 A0 THEN MUST RESET A1 BACK CHAR
EQ CDONE2 FINISH UP
*
*
TITLE NUMBER BUILDER
* NUMBER BUILDING LOOP
CNUMR EQ *
SX7 B2-COPPER CHECK FOR INITIAL DECIMAL PT.
ZR X7,CNUMF JUMP IF FRACTION
SA3 =10.0
BX7 X3
CNUMR1 AX2 45 GET INTEGER VALUE
SX2 X2-1R0 REDUCE FROM DISPLAY CODE
PX2 X2
NX2 X2
FX6 X7*X6 10X6
FX6 X2+X6 ADD IN NEW DIGIT
NX6 X6
RJ GETOP GET NEXT OPERATION
SX3 B2-COPNUM SEE IF NUMBER
ZR X3,CNUMR1
SX3 B2-COPPER SEE IF DECIMAL POINT
NZ X3,CNUMSUP
*
CNUMF SA4 =1.0 SET X4 TO 1.0
MX7 0 COLLECT FRACTION IN X7
CNUMF1 RJ GETOP GET NEXT OPERATION
SX3 B2-COPNUM SEE IF A NUMBER
NZ X3,CNUMDUN
AX2 45 GET THE INTEGER VALUE
SX2 X2-1R0 REDUCE FROM DISPLAY CODE
PX2 X2 FLOAT NEW DIGIT
NX2 X2
SA3 =10.0
FX7 X3*X7 10X7
FX7 X7+X2 ADD IN NEW DIGIT
NX7 X7
FX4 X3*X4 10X4
EQ CNUMF1
*
CNUMDUN FX7 X7/X4 DIVIDE BY TENS
FX6 X6+X7 ADD INTEGER AND DECIMAL PARTS TOGETHER
NX6 X6 NORMALIZE RESULT
*
* CHECK FOR SUPERSCRIPT';
*
CNUMSUP SX7 B2-COPSUP SEE IF LAST CHARACTER A SUPERSCRIPT
ZR X7,CSUPER
*
*
BX6 X6-X0 X0=0 NORMALLY, BUT X0=-0 FOR UNARY MINUS
EQ CNUMR EXIT
* /--- BLOCK EXPONENTS 00 000 76/02/05 15.20
*
*
*
* CONSTRUCT EXPONENT
*
*
CSUPER AX2 60-8 GET SHIFT-SUPER BIT TO BOTTOM
SB4 X2 STORE IN B4 AS FLAG
SA6 BASEN STORE BASE NUMBER
BX6 X0 STORE SIGN OF BASE NUMBER
SA6 BASSGN
MX6 0 CLEAR EXPONENT
MX0 0 CLEAR SIGN
EQ CSUP0
*
CSUP00 NZ B4,CSUP0 JUMP IF LOCKING SUP
RJ GETOP GET NEXT OPERATION
SX7 B2-COPSUP IS IT A SUPERSCRIPT
NZ X7,CXEXIT IF NOT DONT DO EXPONENTIATION
CSUP0 RJ GETOP GET NEXT OPERATION
SX7 B2-COPNEG IS IT A UNARY MINUS
NZ X7,CSUP1
BX0 -X0 TOGGLE UNARY MINUS SWITCH
EQ CSUP00
CSUP1 SX7 B2-COPPLUS IS IT A UNARY PLUS
ZR X7,CSUP00 ARE THERE MORE + OR -
*
SX7 B2-COPPER CHECK FOR INITIAL DECIMAL POINT
ZR X7,CEXPF JUMP IF FRACTION
SX7 B2-COPNUM
NZ X7,CXEXIT IF NOT NUMBER DONT DO EXPONENTIATION
*
CSUP2 AX2 45 GET INTEGER VALUE
SX2 X2-1R0 REDUCE FROM DISPLAY CODE
LX6 1 MULTIPLY BY 2
BX3 X6
LX6 2 MULTIPLY BY 8
IX6 X6+X3 ADD UP PARTS
IX6 X6+X2 ADD IN THIS DIGIT
RJ GETOP GET NEXT OPERATION
NZ B4,CSUP3 JUMP IF LOCKING EXPONENT
SX7 B2-COPSUP IS IT A SUPERSCRIPT
NZ X7,CEXPACK IF NOT GO PACK UP EXPONENT
RJ GETOP GET NEXT OPERATION
CSUP3 SX7 B2-COPNUM SEE IF A NUMBER
ZR X7,CSUP2 IF A NUMBER, LOOP
CEXPACK PX6 X6 PACK I TO F
NX6 X6 NORMALIZE
SX7 B2-COPPER SEE IF DECIMAL POINT
NZ X7,CDOEXP IF NOT GO DO THE EXPONENTIATION
* /--- BLOCK EXPONTS2 00 000 76/02/05 15.21
*
* FRACTIONAL PART OF EXPONENT
*
CEXPF SX4 1 SET X4 TO 1 (FRAC PLACE COUNT)
MX7 0 CLEAR FRAC PART OF EXPONENT
CEXPF1 RJ GETOP GET NEXT OPERATION
NZ B4,CEXPF2 JUMP IF LOCKING SUPERSCRIPT
SX3 B2-COPSUP IS IT A SUPERSCRIPT
NZ X3,CEXFDON IF NOT GO PACK UP EXPONENT
RJ GETOP GET NEXT CHARACTER
CEXPF2 SX3 B2-COPNUM SEE IF A NUMBER
NZ X3,CEXFDON IF NOT A NUMBER, EXIT
AX2 45 GET INTEGER VALUE
SX2 X2-1R0 REDUCE FROM DISPLAY CODE
LX7 1 MULTIPLY OLD BY 10
BX3 X7
LX7 2
IX7 X7+X3
IX7 X7+X2 ADD IN THIS DIGIT
*
LX4 1 MULTIPLY X4 BY 10
BX3 X4
LX4 2
IX4 X4+X3
EQ CEXPF1
*
CEXFDON PX7 X7 PACK I TO F
NX7 X7 NORMALIZE
PX4 X4 PACK A TO F
NX4 X4 NORMALIZE
FX7 X7/X4 DIVIDE BY TENS
FX6 X6+X7 ADD INTEGER AND DECIMAL PARTS TOGETHER
NX6 X6 NORMALIZE RESULT
* /--- BLOCK EXPONTS3 00 000 75/11/25 00.48
*
* NOTE'; EXPONENTIATION ROUTINE WILL SAVE
* X7,X6,X5,X4,X3,X0
* CLOBBERS B1,A6,A7
* TEXPX USES A1-A4,X0-X7,B1-B3; SAVES X7-X3,X0,B3
*
CDOEXP BX6 X6-X0 GET SIGN OF EXPONENT RIGHT
SX7 A1 SAVE LAST CHAR POSITION
LX7 40
SX3 B2 SAVE LAST OPERATION
LX3 20
BX7 X3+X7
SX3 B4 SAVE LOCKING SUP FLAG
BX7 X3+X7
SA1 BASEN PUT BASE NUMBER IN X1
BX2 X6 PUT EXPONENT IN X2
CALL EXPON GO AND DO EXPONENTIATION
*
+ BX6 X1 PUT RESULT IN X6
SB4 X7 RESTORE LOCKING-SUP FLAG
AX7 20
SB2 X7 RESTORE LAST OPERATION
AX7 20
SA1 X7 RESTORE CHARACTER STRING ADDRESS
SA2 BASSGN PICK UP SIGN OF BASE NUMBER
BX6 X6-X2 GET SIGN OF NUMBER RIGHT
ZR B4,CNUMR IF NOT SUP1, DONT BUMP SUB1
*
* GET RID OF TRAILING SUB1
*
SX7 B2-COPSUB SEE IF LAST OP A SUBSCRIPT
NZ X7,CNUMR EXIT IF NOT
RJ GETOP ADVANCE OVER THIS OPERATION
EQ CNUMR EXIT
*
* EXIT WITHOUT DOING EXPONENTIATION IF
* EXPONENT IS NOT A NUMBER
*
CXEXIT SA2 BASEN PICK UP BASE NUMBER
SA3 BASSGN PICK UP ITS SIGN
BX6 X2-X3 GET NUMBER INTO X6
EQ CNUMR
*
* NOTE'; IF EXPONENT TURNS OUT NOT TO BE A
* NUMBER SHOULD ONE BACK UP OVER SUPERSCRIPT
* BEFORE RETURNING NUMBER...
*
*
*
CNUMOP BSS 1 OPCODE +-*/ 0,1,2,3
FSTARG BSS 1 FIRST ARGUMENT IN A+B
BASEN BSS 1 BASE NUMBER FOR EXPONENTIATION
BASSGN BSS 1 SIGN OF BASE NUMBER
CBSAVE BSS 1 SAVE B4 AND B5
*
* /--- BLOCK EXPON 00 000 76/07/23 01.40
*
TITLE EXPONENTIATION ROUTINE
*
XP CONDEN
*
EXPON EQ *
SA7 SVBUF SAVE X7
BX7 X2 B IN X2, A IN X1 FOR A**B
BX0 X2
SA7 EXPONT SAVE THE EXPONENT
SX7 B0
SA7 SIGN CLEAR THE SIGN
ZR X1,OK 0**B=0
PL X1,POSITIV BASE IS POSITIVE
BX1 -X1 USE ABS VALUE OF BASE
UX2 B1,X0 FIX THE EXPONENT, (-F1)**N OK FOR N INTEGER
LX3 B1,X2
PX2 X3
NX2 X2
BX2 X2-X0 COMPARE TRUNCATED WITH ORIGINAL EXPONENT
NZ X2,EXPERR MUST BE THE SAME
PL X3,ODDEVEN
BX3 -X3 LOOK AT ABS VALUE OF EXPONENT
ODDEVEN MX0 59 CHECK FOR PARITY O EXPONENT
BX7 -X0*X3
SA7 SIGN IF ODD, NEGATIVE RESULT
POSITIV RJ TLNX CALL NATURAL LOG ROUTINE
SA2 EXPONT RECALL EXPONENT
RX1 X1*X2 LN(A**B)=B*LN(A)
RJ TEXPX CALL EXPONENT ROUTINE
OK SA2 SVBUF RESTORE X7
BX7 X2
SA2 SIGN ATTACH APPROPRIATE SIGN
ZR X2,EXPON
BX1 -X1 ELSE MAKE NEGATIVE
EQ EXPON
*
*
EXPONT BSS 1 SAVE THE EXPONENT
SIGN BSS 1 0 FOR POS, 1 FOR NEG BASE
SVBUF BSS 1 SAVE X7
*
*
EXPERR SA1 =10LEXPONENT
EQ ERRORC
* /--- BLOCK TEXP 00 000 75/11/21 21.36
*
*
*USES REGISTERS X0-X7,A1-A4,B1-B3
*
*TEXP TUTOR VERSION OF EXP FUNCTION.
*JP TO TEXP WITH VALUE IN X1.
*RETURN WITH RESULT IN X1.
*
TEXPX EQ *
*
* TOOK OUT SAVE HERE
*
BX0 X1 WORK ON IT IN X0
OR X0,HUGEX
ID X0,TEXPX EXP(0/0) IS 0/0
SA1 XMAX GET XMAX
MX5 0
SB1 1
SA3 A1+B1 GET XMIN
FX7 X1-X0 XMAX-X
SA2 A3+B1 GET LOG2(E)
FX1 X0-X3 X-XMIN
PX4 X5
BX7 X7-X1 SIGN OF (XMAX-X)*(X-XMIN)
FX6 X2*X0 X*LOG2(E)
NG X7,HUGEX TEST FOR ARG OUT OF (XMIN,XMAX) RANGE
FX7 X4+X6
DX6 X4+X6
RX7 X7+X6 N IS NOW AN INTEGER WITH A 2000 EXPONENT
NX6 B0,X7 NORMALIZE N FOR RANGE REDUCTION
SA4 A2+B1 LOG(2) UPPER
SA3 A4+B1 LOG(2) LOWER
FX5 X6*X4 N*LOG(2) UPPER
FX1 X6*X3 N*LOG(2) LOWER
FX6 X0-X5
NX2 B0,X6
DX0 X0-X5
FX1 X0-X1
FX0 X2+X1
NX5 B0,X0 FINAL VALUE OF X
SB4 X7 PICK UP N
RX7 X5*X5
SA1 A3+B1 C1=420.0
SA2 A1+B1 C0=15120.0
FX6 X1*X7 CC1*Z
FX3 X7*X7 Z**2
RX0 X6+X2 C1*Z+C0
SA1 A2+B1 C3=28.0
FX6 X1*X7 C3*Z
RX0 X0+X3 C1*Z+C0+Z*Z=B
SA2 A1+B1 C4=2520.0
FX3 X5*X0 X*B
RX2 X6+X2 C4+C3*Z
FX4 X7*X2 Z*T
FX1 X0+X0 2*B
RX6 X1-X3 2*B-X*B
RX1 X6+X4 Z*T+2*B-X*B=DENOM
NX1 B0,X1
RX7 X5/X1 TERM1=X/DENOM
RX4 X3-X4 X*B-Z*T=TERM2
RX3 X7*X4 Q=TERM1*TERM2
SA1 A2+B1 LOAD 1.0
FX2 X1+X5
DX0 X1+X5
NX2 B0,X2
FX4 X2+X3
DX7 X2+X3
RX7 X0+X7
RX6 X4+X7
* /--- BLOCK TEXP 00 000 75/12/11 16.00
UX7 B1,X6
SB4 B4+B1
PX1 B4,X6 RETURN RESULT IN X1
NX1 X1
EQ TEXPX
* TOOK OUT RESTORE HERE
HUGEX MX1 11 CREATE 3777......
LX1 59
PL X0,TEXPX EXP(1/0) IS 1/0
MX1 0 BUT EXP(-1/0) IS 0
EQ TEXPX
* TOOK OUT RESTORE
ERR EQ ERRORC
*
* DANGER...THE FOLLOWING OFTEN ARE USED WITHOUT DIRECT REFERENCE
*
XMAX DATA 741.67
XMIN DATA -675.82
LOG2E DATA 17205612507312256030B
LOG2U DATA 17175427102775750000B
LOG2L DATA 16530717363257117073B
C1 DATA 420.0
C0 DATA 15120.0
C3 DATA 28.0
C4 DATA 2520.0
ONE DATA 1.0
* /--- BLOCK TLNLOG 00 000 75/11/21 21.36
*
*
*USES REGISTERS X0-X7,A1-A4,B1-B3
*
*TUTOR LN AND LOG FUNCTIONS.
*JP TO TLN OR TLOG WITH ARGUMENT
*IN X1. RETURN WITH
*RESULT IN X1.
*
* TOOK OUT TLOGX
*
TLNX EQ *
* TOOK OUT SAVE
MX6 -1 FLAG BASE E LN
RJ LNLOG
EQ TLNX
*
LNLOG EQ *
SA6 FLAG SAVE LOG TYPE
ZR X1,ERR1 ARGUMENT IN X1
NG X1,ERR2
ID X1,LNLOG LOG(0/0) IS 0/0
OR X1,LNLOG LOG(1/0) IS 1/0
SA2 SQ2 1.414...*2.47
UX7 B4,X1
SB3 -47 TRY K=-47
SB1 1
IX6 X7-X2
NG X6,GL
SB3 B3-B1 NEED K=-48
GL PX7 B3,X7 FORM W=2.K*C
SA4 A2+B1 LOAD 1.0
FX0 X7-X4 (W-1.0)
NX2 B0,X0
DX0 X7-X4
RX0 X2+X0
RX2 X7+X4
RX0 X0/X2
FX7 X0*X0 Z=T*T
SA1 A4+B1 D0
SA2 A1+B1 D1
SA3 A2+B1 D2
FX6 X7*X2 Z*D1
FX4 X7*X7 Z*Z
FX1 X1+X6 D0+Z*D1
FX6 X4*X3 D2*Z*Z
FX5 X4*X7 Z**3
SA2 A3+B1 D3
FX1 X1+X6 D0+D1*Z+D2*Z*Z
FX3 X5*X2 D3*Z**3
FX1 X1+X3 TOTAL DENOMINATOR
NX5 B0,X1
FX6 X0/X5
SA2 A2+B1 C1
SA1 A2+B1 C2
FX7 X7*X2 C1*Z
FX4 X1*X4 C2*Z**2
FX3 X3+X3 2*C3*Z**3
FX0 X0+X0 2*T
FX5 X7+X3 ADD C1*Z
* /--- BLOCK TLNLOG 00 000 76/07/23 01.40
SX3 B4-B3
FX5 X5+X4 ADD C2*Z**2
PX1 X3
FX7 X6*X5 FINAL TERM OF Q
NX4 B0,X1
SA3 A1+B1 LOG(2.0)
SA2 A3+B1
FX6 X4*X3
FX5 X0-X7
FX1 X4*X2
DX4 X0-X7
NX5 B0,X5
RX4 X5+X4
RX4 X4+X1
RX4 X4+X6
NX1 B0,X4 RETURN RESULT IN X1
SA3 FLAG GET LOG TYPE
NZ X3,LNLOG
SA2 A2+B1 LOAD LOG10(E)
RX1 X1*X2 RETURN RESULT IN X1
NX1 X1
* TOOK OUT RESTORE
EQ LNLOG
ERR1 EQ ERR
ERR2 EQ ERR
*
SQ2 DATA 5520236314774736B
DATA 1.0 USED IN SEQUENCE WITH SQ2, ETC.
D0 DATA 10395.0
D1 DATA 60421030456556304033B
D2 DATA 17344525326347004201B
D3 DATA -230.419130393980937
C11 DATA 60431166777777776772B
C2 DATA 17345152701555267627B
LOGE2 DATA 17175427102775750000B
DATA 16530717363257110000B
LOG10 DATA 17166745573052233450B
FLAG DATA 0 LN/LOG10 FLAG
*
XP ENDIF
* /--- BLOCK CTABLE 00 000 77/12/08 17.05
TITLE CHARACTER DEFINITION TABLE
*
* CHARACTER DEFINITION TABLE...
*
* TABLE CONSISTS OF 4 15-BIT PARTS
* PART 1...NORMAL 6-BIT CODES
* PART 2...SHIFT CODES (12-BIT)
* PART 3...ACCESS CODES (12-BIT)
* PART 3...ACCESS-SHIFT CODES (18 BIT)
*
* THE 15 BITS ARE THE SAME FOR EACH PART...
* FIRST A 6 BIT OPERATION CODE
* THEN A FONT BIT
* THEN A SHIFT BIT
* THEN AN ACCESS BIT
* FOLLOWED BY A 6 BIT FIELD USED BY LETTERS TO
* CONTAIN THE 6 BIT LETTER CODE OR
* USED BY NUMBERS TO CONTAIN THEIR INTEGER VALUE
*
* THE OPERATION CODES ARE...
* 0=END OF LINE
* 1=LETTERS (CONSONANTS) THEN FONT,SHIFT,ACCESS,CHAR BITS
* 2=LETTERS (VOWELS) (DITTO)
* 3=DIACRITIC...LETTER OF LITTLE VALUE IN SPELLING
* 4=NUMBERS (BOTTOM BITS CONTAIN DISPLAY CODE VALUE)
* 5=SUPERSCRIPT, 6=SUBSCRIPT, 7=BACKSPACE, 8=CR
* 9=+, 10=-, 11=* AND MULTIPLY, 12=/ AND DIVIDE
* 13=SPACE, 14=,(COMMA)
* 15=. (PERIOD), 16=; AND UNI-DELIMITER, 17=(, 18=), 19=<, 20=>
* 21==(EQUAL)
* 22=START EMBED, 23=END EMBED
* 24=MISC PUNCTS
* 25=PUNCWORD
*
* THE FOLLOWING OPERATIONS ARE INVISIBLE OUTSIDE -GETOP-
* 40=FONT TOGGLE
* 41=SHIFT CODE
* 42=ACCESS CODE
* 43=ACCESS-SHIFT CODE
* 44=NULL OPS
* 45=CR (MUST SET TO BASE FONT, THEN VALUE TO COPCR)
* 46=UNI-DELIM (SET TO BASE FONT, THEN VALUE TO COPSEMI)
*
*
* FOR A TEMPORARY FIX, THE ACCESS-CONSONANT CODES HAVE
* BEEN SET UP AS VOWELS...SO THAT THEY CAN BE DISTINGUISHED
* FROM THE NORMAL LETTERS WHEN IN FIRST CHARACTER POSITION.
* ONE SHOULD BE ABLE TO UNDO THIS FIX WHEN THE HASH LOOP
* IS REMOVED/CHANGED AT -LL-
*
*
* /--- BLOCK CTABLE 00 000 78/01/17 14.51
ENTRY CONTEST
CONTEST DATA 6RSYSTEM NAME OF SYSTEM CTABLE
*
***NOTE***
* THE FOLLOWING 129 WORDS MAY BE OVERWRITTEN BY
* SOME PARTICULAR USERS CHOICE OF DEFINITIONS.
* SEE THE ECS COPY -XCONTAB- FOR THE UNALTERED
* SYSTEM COPY
*
ENTRY CONTAB
CONTAB DATA 6RSYSTEM NAME OF TABLE CURRENTLY IN CTABLE
*
* STANDARD SHIFT ACCESS SHIFT-ACCESS
*
CTABLE VFD 15/00000B,15/00000B,15/00000B,15/00000B END OF LINE
VFD 15/02001B,15/02201B,15/01101B,15/01301B A
VFD 15/01002B,15/01202B,15/01102B,15/01302B B
VFD 15/01003B,15/01203B,15/03103B,15/01303B C
VFD 15/01004B,15/01204B,15/01104B,15/01304B D
VFD 15/02005B,15/02205B,15/03105B,15/01305B E
VFD 15/01006B,15/01206B,15/01106B,15/01306B F
VFD 15/01007B,15/01207B,15/02107B,15/02307B G
VFD 15/01010B,15/01210B,15/02110B,15/02310B H
VFD 15/02011B,15/02211B,15/01111B,15/01311B I
VFD 15/01012B,15/01212B,15/02112B,15/02312B J
VFD 15/01013B,15/01213B,15/02113B,15/02313B K
VFD 15/01014B,15/01214B,15/01114B,15/01314B L
VFD 15/01015B,15/01215B,15/01115B,15/01315B M
VFD 15/01016B,15/01216B,15/03116B,15/01316B N
VFD 15/02017B,15/02217B,15/01117B,15/01317B O
VFD 15/01020B,15/01220B,15/01120B,15/01320B P
VFD 15/01021B,15/01221B,15/03121B,15/01321B Q
VFD 15/01022B,15/01222B,15/01122B,15/01322B R
VFD 15/01023B,15/01223B,15/01123B,15/01323B S
VFD 15/01024B,15/01224B,15/01124B,15/01324B T
VFD 15/02025B,15/02225B,15/03125B,15/01325B U
VFD 15/01026B,15/01226B,15/03126B,15/01326B V
VFD 15/01027B,15/01227B,15/01127B,15/01327B W
VFD 15/01030B,15/01230B,15/03130B,15/01330B X
VFD 15/02031B,15/02231B,15/02131B,15/02331B Y
VFD 15/01032B,15/01232B,15/01132B,15/01332B Z
* /--- BLOCK CTABLE 00 000 80/08/06 19.48
* SHIFT-0, SHIFT-1, SHIFT-5 ARE FOR LEFTWARD WRITING --
* MADE NULL CHARS FOR ANSWER JUDGING.
* THE SAME GOES FOR ACCESS,SHIFT-0 THROUGH 7...THE COLORS
* STANDARD SHIFT ACCESS SHIFT-ACCESS
VFD 15/04033B,15/54233B,15/26133B,15/54333B 0,NULL,EMBED
VFD 15/04034B,15/54234B,15/27134B,15/54334B 1,NULL,EMBED
VFD 15/04035B,15/01235B,15/01135B,15/54335B 2,,,NULL
VFD 15/04036B,15/01236B,15/01136B,15/54336B 3,,,NULL
VFD 15/04037B,15/01237B,15/01137B,15/54337B 4,,,NULL
VFD 15/04040B,15/54240B,15/01140B,15/54340B 5,NULL,,NULL
VFD 15/04041B,15/01241B,15/01141B,15/54341B 6,,,NULL
VFD 15/04042B,15/03242B,15/01142B,15/54342B 7,,,NULL
VFD 15/04043B,15/54243B,15/01143B,15/01343B 8
VFD 15/04044B,15/54244B,15/01144B,15/01344B 9
VFD 15/11045B,15/01245B,15/01145B,15/01345B +
VFD 15/12046B,15/01246B,15/01146B,15/01346B -
VFD 15/13047B,15/54247B,15/01147B,15/01347B * FONT TAB
VFD 15/14050B,15/30250B,15/01150B,15/01350B /,QUEST,
VFD 15/21051B,15/54251B,15/01151B,15/01351B ( ALL CAPS
VFD 15/22052B,15/01252B,15/01152B,15/01352B )
VFD 15/30053B,15/01253B,15/01153B,15/01353B $
VFD 15/25054B,15/01254B,15/01154B,15/01354B =
VFD 15/15055B,15/01255B,15/01155B,15/01355B SP
VFD 15/16056B,15/01256B,15/56156B,15/01356B , ,UNI-DELM,
VFD 15/17057B,15/30257B,15/01157B,15/01357B PERIOD,EXCLM
VFD 15/14060B,15/01260B,15/01160B,15/01360B DIVIDE
VFD 15/30061B,15/54261B,15/30161B,15/01361B [ ORIENT
VFD 15/30062B,15/54262B,15/30162B,15/01362B ] ORIENT
VFD 15/01063B,15/54263B,15/01163B,15/01363B % ORIENT
VFD 15/13064B,15/01264B,15/01164B,15/01364B MULTIPLY
VFD 15/30065B,15/01265B,15/01165B,15/01365B ASSIGN
VFD 15/06066B,15/06266B,15/06166B,15/06366B SUB
VFD 15/05067B,15/05267B,15/05167B,15/05367B SUP
VFD 15/51070B,15/54270B,15/53170B,15/54370B SHIFT
VFD 15/55071B,15/55271B,15/55171B,15/55371B CR
VFD 15/23072B,15/54272B,15/01172B,15/01372B < ORIENT
VFD 15/24073B,15/54273B,15/01173B,15/01373B > ORIENT
VFD 15/07074B,15/07274B,15/07174B,15/07374B BKSP
VFD 15/50075B,15/50275B,15/50175B,15/50375B FONT
VFD 15/52076B,15/54276B,15/54176B,15/54376B ACCESS
VFD 15/20077B,15/30277B,15/01177B,15/01377B SEMIC, COLN
*
*
* /--- BLOCK CTABLEF 00 000 78/01/17 14.52
*
* STANDARD SHIFT ACCESS SHIFT-ACCESS
*
CTABLEF VFD 15/00000B,15/00000B,15/00000B,15/00000B END OF LINE
VFD 15/02401B,15/02601B,15/01501B,15/01701B A
VFD 15/01402B,15/01602B,15/01502B,15/01702B B
VFD 15/01403B,15/01603B,15/01503B,15/01703B C
VFD 15/01404B,15/01604B,15/01504B,15/01704B D
VFD 15/02405B,15/02605B,15/01505B,15/01705B E
VFD 15/01406B,15/01606B,15/01506B,15/01706B F
VFD 15/01407B,15/01607B,15/02507B,15/02707B G
VFD 15/01410B,15/01610B,15/02510B,15/02710B H
VFD 15/02411B,15/02611B,15/01511B,15/01711B I
VFD 15/01412B,15/01612B,15/02512B,15/02712B J
VFD 15/01413B,15/01613B,15/02513B,15/02713B K
VFD 15/01414B,15/01614B,15/01514B,15/01714B L
VFD 15/01415B,15/01615B,15/01515B,15/01715B M
VFD 15/01416B,15/01616B,15/01516B,15/01716B N
VFD 15/02417B,15/02617B,15/01517B,15/01717B O
VFD 15/01420B,15/01620B,15/01520B,15/01720B P
VFD 15/01421B,15/01621B,15/01521B,15/01721B Q
VFD 15/01422B,15/01622B,15/01522B,15/01722B R
VFD 15/01423B,15/01623B,15/01523B,15/01723B S
VFD 15/01424B,15/01624B,15/01524B,15/01724B T
VFD 15/02425B,15/02625B,15/01525B,15/01725B U
VFD 15/01426B,15/01626B,15/01526B,15/01726B V
VFD 15/01427B,15/01627B,15/01527B,15/01727B W
VFD 15/01430B,15/01630B,15/01530B,15/01730B X
VFD 15/02431B,15/02631B,15/02531B,15/02731B Y
VFD 15/01432B,15/01632B,15/01532B,15/01732B Z
* /--- BLOCK CTABLEF 00 000 78/02/11 13.15
* SHIFT-0, SHIFT-1, SHIFT-5 ARE FOR LEFTWARD WRITING --
* MADE NULL CHARS FOR ANSWER JUDGING.
*
* STANDARD SHIFT ACCESS SHIFT-ACCESS
*
VFD 15/01433B,15/54633B,15/03533B,15/01733B 0
VFD 15/01434B,15/54634B,15/03534B,15/01734B 1
VFD 15/01435B,15/01635B,15/03535B,15/01735B 2
VFD 15/01436B,15/01636B,15/03536B,15/01736B 3
VFD 15/01437B,15/01637B,15/03537B,15/01737B 4
VFD 15/01440B,15/54640B,15/03540B,15/01740B
VFD 15/01441B,15/01641B,15/03541B,15/01741B
VFD 15/01442B,15/01642B,15/03542B,15/01742B
VFD 15/01443B,15/01643B,15/03543B,15/01743B
VFD 15/01444B,15/01644B,15/03544B,15/01744B 9
VFD 15/30445B,15/01645B,15/01545B,15/01745B +
VFD 15/30446B,15/01646B,15/01546B,15/01746B -
VFD 15/13447B,15/01647B,15/01547B,15/01747B *
VFD 15/14450B,15/30650B,15/01550B,15/01750B / QUEST
VFD 15/21451B,15/01651B,15/01551B,15/01751B (
VFD 15/22452B,15/01652B,15/01552B,15/01752B )
VFD 15/30453B,15/01653B,15/01553B,15/01753B $
VFD 15/30454B,15/01654B,15/01554B,15/01754B =
VFD 15/15455B,15/01655B,15/01555B,15/01755B SP
VFD 15/16456B,15/01656B,15/56556B,15/01756B ,,UNI-DELM
VFD 15/17457B,15/30657B,15/01557B,15/01757B PERIOD,EXCLM
VFD 15/30460B,15/01660B,15/01560B,15/01760B DIVIDE
VFD 15/30461B,15/01661B,15/01561B,15/01761B [
VFD 15/30462B,15/01662B,15/01562B,15/01762B ]
VFD 15/01463B,15/01663B,15/01563B,15/01763B PERCENT
VFD 15/30464B,15/01664B,15/01564B,15/01764B MULTIPLY
VFD 15/30465B,15/01665B,15/01565B,15/01765B ASSIGN
VFD 15/06466B,15/06666B,15/06566B,15/06766B SUB
VFD 15/05467B,15/05667B,15/05567B,15/05767B SUP
VFD 15/51470B,15/54670B,15/53570B,15/54770B SHIFT
VFD 15/55471B,15/55671B,15/55571B,15/55771B CR
VFD 15/23472B,15/01672B,15/01572B,15/01772B <
VFD 15/24473B,15/01673B,15/01573B,15/01773B >
VFD 15/07474B,15/07674B,15/07574B,15/07774B BKSP
VFD 15/50475B,15/50675B,15/50575B,15/50775B FONT
VFD 15/52476B,15/54676B,15/54576B,15/54776B ACCESS
VFD 15/20477B,15/30677B,15/01577B,15/01777B ; COLON
*
* /--- BLOCK GETOP 00 000 77/12/07 16.03
* GETOP PICKS UP A 6-BIT CHAR FROM A1, UPDATES A1, DELIVERS
* 6-BIT OPCODE IN B2 LOWER, 9-BIT CHAR IN X2 UPPER. 'VARIOUS
* FONT/ACC FLAGS GET UPDATED.
*
*
ENTRY GETOP
GETOP EQ * GET NEXT OPERATION CODE
SB2 0
SA0 A1 SAVE ADDRESS OF END OF LAST CHARACTER
GETOP1 SA1 A1+1 GET NEXT CHARACTER
SA2 FONTFLG GET NORMAL OR FONT TABLE
IX2 X1+X2
SA2 CTABLE+X2 GET TABLE ENTRY
LX2 B2,X2 GET PROPER CODE FIELD
MX1 6 MAKE MASK FOR OPERATION CODE
BX1 X1*X2 GET OPERATION CODE
BX2 X1-X2 CLEAR OP CODE FROM X2
LX1 6
SB2 X1 GET OPERATION CODE INTO B2
SX1 X1-50B SEE IF SPECIAL GETOP FUNCTION
NG X1,GETOP
SB2 X1
*
JP B2+GETOPFT DO SPECIAL FUNCTION
GETOPFT SB2 0 FONT
EQ GETOPF
+ SB2 15 SHIFT
EQ GETOP1
+ SB2 30 ACCESS
EQ GETOP1
+ SB2 45 ACCESS-SHIFT
EQ GETOP1
+ SB2 0 NULL OPERATION
EQ GETOP1
+ SB2 COPCR SET TO CARRIAGE RETURN
EQ GETOPCR
+ SB2 COPSEMI SET TO SEMICOLON RETURN
EQ GETOPNI
*
GETOPF SA2 FONTFLG FONT...TOGGLE BIT
BX1 X7 SAVE CONTENTS OF X7
SX7 100B
BX7 X2-X7
SA7 A2
BX7 X1 RESTORE X7
SA0 A1 AND UPDATE LAST CHARACTER ADDRESS
EQ GETOP1
*
GETOPCR BX1 X7 SAVE X7
MX7 0 CLEAR TO BASE FONT
SA7 FONTFLG
BX7 X1 RESTORE
EQ GETOP
*
GETOPNI BX1 X7 SAVE X7 UNI-DELIMETER
MX7 0 CLEAR TO BASE FONT
SA7 FONTFLG
BX7 X1 RESTORE
EQ GETOP
* /--- BLOCK GETOP 00 000 76/10/19 12.28
* GETOPN IS LIKE GETOP, BUT A1 IS NOT ADVANCED, AND
* FONT/ACC FLAGS ARE NOT UPDATED. GETOPN IS USED TO LOOK
* AHEAD ONE CHAR WHEN NECESSARY.
*
*
CONDEN
ENTRY GETOPN
ENDIF
GETOPN EQ * GET NEXT OPERATION CODE
SA3 A1 GET ADDRESS OF LAST CHARACTER
SB3 0
GETOPN1 SA3 A3+1 GET NEXT CHARACTER
SA4 FONTFLG GET NORMAL OR FONT TABLE
IX4 X3+X4
SA4 CTABLE+X4 GET TABLE ENTRY
LX4 B3,X4 GET PROPER CODE FIELD-- NORMAL,SHIFT,ACCESS
MX3 6 MAKE MASK FOR OPERATION CODE
BX3 X3*X4 GET OPERATION CODE
BX4 X3-X4 CLEAR OP CODE FROM X2
LX3 6
SB3 X3 GET OPERATION CODE IN B3
SX3 X3-50B
NG X3,GETOPN
SB3 X3
*
JP B3+GETPNFT DO SPECIAL FUNCTION
GETPNFT SB3 0 FONT...DO NOT GO OVER AT THIS TIME
EQ GETOPN
+ SB3 15 SHIFT
EQ GETOPN1
+ SB3 30 ACCESS
EQ GETOPN1
+ SB3 45 ACCESS-SHIFT
EQ GETOPN1
+ SB3 0 NULL OPERATION...DO NOT GO OVER
EQ GETOPN
+ SB3 0 DO NOT GO OVER CR AT THIS TIME
EQ GETOPN
+ SB3 0 DO NOT GO OVER UNI-DELIM AT THIS TIME
EQ GETOPN
*
*
END