COVLAY2
* /--- FILE TYPE = E
* /--- BLOCK COVLAY2 00 000 81/07/28 02.24
IDENT COVLAY2
LCC OVERLAY(1,1)
*
TITLE ASSORTED OVERLAYS FOR CONDENSOR
*
*
CST
*
*
COVLY2$ OVFILE
*
*
* ERROR EXITS
EXT ERRTAGS,ERRNAME,ERRSTOR
EXT ERRXYTG,ERR2MNY,ERR2FEW
EXT ERRTERM,ERRUARG,ERRVTYP
EXT ERROUTR,ERRCNTD,ERRXORQ
EXT ERRBAL
* FOLLOWING EXTERNALS ARE FOR COMMON,COMMONX,STORAGE
EXT COMPILE,COMPNAM,LNGUNIT
EXT ERRORC,NXTNAM,NXTLINE
EXT SYSTEST,SYSONE
EXT VARFIN,PAUSE2,TWOBITS,TAGXACT
*
* FOLLOWING EXTERNALS FOR PUT, PUTD
EXT PUTCODE,PUT=
*
* FOLLOWING EXTERNALS FOR DRAW
EXT GETLINE,KEYTYPE,QUIKCMP,COMPSYM
EXT VARFINS,COMCONT
*
* FOLLOWING EXTERNALS FOR CHANGE COMMAND
EXT COMNAMS
EXT CONTEST,CONTAB IN FILE CONTENT
*
* FOLLOWING EXTERNALS FOR INITIALIZATIONS
EXT COMNAMS
EXT CSYMADD
EXT UERRSET
*
* FOLLOWING EXTERNALS FOR -WRITEC-
EXT BRVAR,CONV2,CONV3,CONUL4
*
* FOR INITIALIZATION
EXT CONTAB IN FILE CONTEN
*
*
* /--- BLOCK LIB(CALL) 00 000 79/02/07 16.14
TITLE LIBCALL AND CALL COMMANDS
*
LIBCOV OVRLAY
*
SA1 OVARG1
SB3 X1
JP B3+*+1
*
+ EQ LIBIN LIBCALL
+ EQ CALLIN CALL
*
* -LIBCALL- AND -CALL- COMMAND READIN
* FIRST ARGUMENT IS -SYSLIB- UNIT NAME
* MAY HAVE 3 MORE OPTIONAL ARGUMENTS
*
* -CALL- RESTRICTS COMMAND TO THE FOLLOWING
* -SYSLIB- UNITS';
* ASK, CALC, KERMIT, TALK, TIME
*
LIBIN RJ SYSTEST THIS IS THE ONLY CHECK
CALLIN MX6 0 PRE-CLEAR
SA6 VARBUF
SA6 VARBUF+2
SA6 VARBUF+3
SA6 VARBUF+4
CALL NXTNAM GET UNIT NAME
ZR X6,ERRNAME
MX0 8*6 UNIT NAME CANNOT EXCEED 8 CHARS
BX0 -X0*X6
NZ X0,ERRNAME
SA6 VARBUF+1 SAVE UNIT NAME
SA3 OVARG1 GET ARG FROM -COMNDS-
ZR X3,LIBCHK IF -LIBCALL-, SKIP
SA2 CASK FIRST TERM TO CHECK
SB3 5 NUMBER OF TERMS TO CHECK
LIBTERM BX2 X2-X6
ZR X2,LIBCHK IF EQUAL TO TERM NAME, OK
SB3 B3-1 DECREMENT CHECK
ZR B3,ERRNAME IF NOT VALID NAME, ERROR OUT
SA2 A2+1 GET NEXT TERM
EQ LIBTERM GO CHECK AGAIN
LIBCHK ZR X1,LIBCIN1 JUMP IF END-OF-LINE
ZR X3,LIBINLP IF -LIBCALL-, SKIP
SA2 CTALK GET *TALK* UNIT NAME
BX2 X2-X6 SEE IF *TALK* UNIT
ZR X2,LIBINLP IF *TALK*, SKIP
SA2 CKERMIT GET *KERMIT* UNIT NAME
BX2 X2-X6 SEE IF *KERMIT* UNIT
ZR X2,LIBINLP IF *KERMIT*, SKIP
EQ ERR2MNY TO MANY PARAMS PASSED
*
* /--- BLOCK LIB(CALL) 00 000 79/02/07 16.11
LIBINLP CALL COMPILE GET NEXT ARGUMENT
BX6 X1
SA2 VARBUF
SA6 X2+VARBUF+2
SA1 LASTKEY SEE IF END-OF-LINE
ZR X1,LIBCIN1
SX6 X2+1 INCREMENT NUMBER OF CODES
SA6 A2
SX6 X6-3 ALLOW THREE ARGUMENTS
NG X6,LIBINLP
EQ ERRTAGS
*
LIBCIN1 SA1 INX INDEX IN EXTRA STORAGE
SX6 X1+2
SA6 A1
SA2 VARBUF+1 MOVE UNIT NAME TO EXTRA STORAGE
BX6 X2
SA6 X1+INFO
SA2 VARBUF+2 -GETVAR- CODE FOR 1ST ARGUMENT
LX2 60-XCODEL
SA3 VARBUF+3 -GETVAR- CODE FOR 2ND ARGUMENT
LX3 60-XCODEL-XCODEL
BX6 X2+X3
SA2 VARBUF+4 -GETVAR- CODE FOR 3RD ARGUMENT
LX2 60-XCODEL-XCODEL-XCODEL
BX6 X2+X6
SA6 X1+INFO+1 MOVE TO EXTRA STORAGE
BX6 X1
LX6 XCMNDL POSITION INDEX IN XSTOR
EQ PUTCODE
*
CASK DATA 0LASK
CCALC DATA 0LCALC
CKERMIT DATA 0LKERMIT
CTALK DATA 0LTALK
CTIME DATA 0LTIME
*
ENDOV
* /--- BLOCK EXACTC 00 000 76/01/26 14.44
TITLE EXACTC
* -EXACTC-
* THIS READ-IN ROUTINE IS ESSENTIALLY THE ANCIENT
* READ-IN FOR THE ORIGINAL -WRITEC- COMMAND BEFORE
* EMBEDDING, ETC.
*
*
* FORMAT OF COMMAND WORD --
*
* TOP *XCODEL* BITS = -GETVAR- CODE FOR VARIABLE
* NEXT XX BITS = UNUSED
* NEXT 12 BITS = NUMBER OF ENTRIES IN TABLE
* NEXT 12 BITS = RELATIVE ADDRESS OF LAST WORD OF TABLE
* LAST *XCMNDL* BITS = COMMAND CODE NUMBER
*
*
* THE TABLE ENTRIES ARE IN BACK-TO-FRONT ORDER--I.E., THE LAST
* WORD OF THE TABLE CONTAINS THE INFO FOR THE FIRST ENTRIES.
* THERE ARE TWO ENTRIES PER WORD, EACH HOLDING THE FOLLOWING --
*
* TOP 12 BITS = RELATIVE ADDRESS OF FIRST WORD OF TEXT INFO
* NEXT 6 BITS = SHIFT COUNT TO POSITION 1ST CHAR AT LEFT
* NEXT 4 BITS = NUMBER OF CHARACTERS IN 1ST TEXT WORD
* NEXT 8 BITS = NUMBER OF CHARACTERS IN FOLLOWING WORDS
* /--- BLOCK EXACTC 00 000 76/07/24 21.29
*
*
WRITCOV OVRLAY
RJ COMPILE DECODE ONE VARIABLE
BX7 X1
LX7 60-XCODEL LEFT-ADJUST GETVAR CODE
SA7 BRVAR SAVE
* /--- BLOCK EXACTC 00 000 76/07/25 07.57
SA1 INX
BX6 X1
MX7 0
SA6 CONV2 RELATIVE STARTING ADDRESS OF TEXT
SA2 ICX
SX6 X2-1
SA6 WCTADR INITIALIZE TABLE ADDRESS POINTER
SA7 CONV3 NUMBER OF TABLE ENTRIES = 0
SA7 INFO+X1 CLEAR 1ST TEXT WORD
SA7 INFO+X6 CLEAR 1ST TABLE WORD
SX7 54
SA7 WCSHFT INITIALIZE SHIFT COUNT MARKER
SA2 LASTKEY
NZ X2,WRTCIN3 JUMP IF LINE NOT EXHAUSTED
*
WRTCIN1 SA3 NEXTCOM CHECK IF CONTINUATION
SA4 COMCONT
BX3 X3-X4
ZR X3,WRTCIN2 JUMP TO GET NEXT LINE IF CONTINUED
*
SA1 CONV3 X1 = NUMBER OF TABLE ENTRIES
ZR X1,ERR2FEW
SA2 WCTADR X2 = CURRENT RELATIVE TABLE ADDRESS
SA3 ICX X3 = NEXT RELATIVE ADDRESS FOLLOWING TABLE
SA4 CONV2 X4 = RELATIVE ADDRESS OF LAST WORD OF TEXT
SA1 INFO-1+X2 A1 = ADDRESS PRECEDING TABLE
SB2 INFO+X4 B2 = ADDRESS OF LAST WORD OF TEXT
IX3 X3-X2 X3 = LENGTH OF TABLE
SB3 B2+X3 B3 = END TEST FOR TRANSFER
WCTRANS SA1 A1+B1 MOVE TABLE AFTER TEXT
BX6 X1
SB2 B2+B1
SA6 B2
LT B2,B3,WCTRANS
SB2 INFO
SX7 B3-B2 X7 = RELATIVE ADDRESS OF LAST WORD OF TABLE
SA7 CONV2 STORE IN CONVENTIONAL LOCATION
SX6 X7 UPDATE EXTRA STORAGE POINTER
SA6 INX +++ NOTE +++ STANDARD EXIT INCREMENTS IT
SA4 COMNUM
BX6 X4 SET UP TO USE THIS COMMAND NUMBER
EQ CONUL4 --- EXIT VIA CONDITIONAL BRANCH PACK-UP
*
*
WRTCIN2 RJ GETLINE READ IN NEXT LINE
* /--- BLOCK EXACTC 00 000 76/01/26 14.44
WRTCIN3 SA2 WORDPT X2 = STARTING ADDRESS FOR TAG SEARCH
SA1 X2 X1 = 1ST CHARACTER OF TAG
ZR X1,WRTCIN1 JUMP TO LOOK FOR CONTINUATION IF BLANK LINE
*
WTCLOOP SB1 1 B1 = CONSTANT 1
SB3 6 B3 = SHIFT COUNT DECREMENT
SA3 LASTKEY GET EXPRESSION TERMINATOR
SB4 X3
* /--- BLOCK EXACTC 00 000 76/07/24 21.31
SB4 -B4 COMPLEMENT OF TERMINATOR
SA3 CONV2 X3 = RELATIVE ADDRESS OF CURRENT TEXT WORD
SA4 INFO+X3 X4 = CURRENT TEXT INFO WORD
SA5 WCSHFT
SB2 X5 B2 = SHIFT COUNT FOR NEXT CHARACTER
* /--- BLOCK EXACTC 00 000 76/07/24 21.02
WTC200 SA1 A1-B1 RESET FOR LOOP
WTCPACK SA1 A1+B1 X1 = NEXT CHARACTER
LX2 X1,B2
ZR X1,WTCFIN TEXT COMPLETE IF END-OF-LINE
SX6 X1+B4 COMPARE TERMINATOR
ZR X6,WTCFIN TEXT COMPLETE IF COMMA OR SEMICOLON
BX4 X4+X2 ADD CHARACTER TO CURRENT TEXT WORD
SB2 B2-B3
PL B2,WTCPACK JUMP TO CONTINUE IF NOT YET A FULL WORD
BX7 X4
SA7 A4 STORE COMPLETED WORD OF TEXT INFO
SX3 X3+1 INCREMENT TEXT STORAGE POINTER
SA4 A4+B1 INCREMENT TEXT WORD ADDRESS
MX4 0 CLEAR NEXT TEXT STORAGE WORD
SB2 54 RESET SHIFT COUNT
EQ WTCPACK
*
* /--- BLOCK EXACTC 00 000 76/01/26 14.44
WTCFIN BX7 X4
SA7 A4 STORE CURRENT TEXT INFO WORD
BX4 X3 X4 = CURRENT TEXT WORD ADDRESS
SA3 A3 X3 = ORIGINAL TEXT WORD ADDRESS
BX6 X4
SA6 A3 UPDATE ADDRESS OF CURRENT TEXT WORD
SX6 B2 X6 = CURRENT SHIFT COUNT (ORIGINAL IN X5)
SA6 A5 UPDATE SHIFT COUNT
BX7 X3 BEGIN BUILDING INFO PACKAGE IN X7
SX2 54
IX2 X2-X5 COMPUTE SHIFT COUNT NEEDED FOR EXECUTION
LX7 6
BX7 X7+X2 ADD SHIFT COUNT TO INFO PACKAGE
BX2 X5 BEGIN TRICKY EQUIVALENT OF DIVIDE BY 6
LX2 1 *2
IX5 X5+X2 *3
LX2 2 *8
IX5 X5+X2 *11
AX5 6 /64 X5 = ORIGINAL SHIFT COUNT / 6
BX2 X6 DO ANOTHER TRICKY DIVIDE
LX2 1
IX6 X6+X2
LX2 2
IX6 X6+X2
AX6 6 X6 = FINAL SHIFT COUNT / 6
IX4 X4-X3 X4 = FINAL STORAGE WORD POINTER - ORIGINAL
IX3 X5-X6 X3 = 1ST WORD CHAR COUNT IF ALL IN ONE WORD
ZR X4,WCSTOR JUMP IF ALL TEXT IN ONE WORD
BX2 X4
LX4 3 *8
LX2 1 *2
IX4 X4+X2 X4 = DIFFERENCE IN TEXT POINTERS * 10
* /--- BLOCK EXACTC 00 000 76/07/24 20.52
SX4 X4-1
IX4 X4-X6 X4 = COUNT OF CHARACTERS IN FOLLOWING WORDS
SX3 X5+B1 X3 = COUNT OF CHARACTERS IN 1ST WORD
WCSTOR LX7 4
BX7 X7+X3 ADD CHARACTER COUNT FOR 1ST WORD
LX7 8
BX7 X7+X4 ADD CHARACTER COUNT FOR FOLLOWING WORDS
SA2 WCTADR X2 = CURRENT TABLE ADDRESS
SA3 INFO+X2 X3 = CURRENT TABLE WORD
SA4 CONV3 X4 = CURRENT NUMBER OF TABLE ENTRIES
BX6 X3+X7 ADD NEW ENTRY
LX4 59
NG X4,WCODD JUMP OF ODD NUMBERED TABLE ENTRY
LX6 30 POSITION AT TOP
SA6 A3 STORE UPPER (EVEN) ENTRY
WCNEXT LX4 1
SX7 X4+B1 INCREMENT NUMBER OF TABLE ENTRIES
SA7 A4
ZR X1,WRTCIN1 JUMP IF AT END-OF-LINE
SA1 A1+B1
NZ X1,WTCLOOP JUMP TO MAIN LOOP IF NEXT CHAR NOT E-O-L
EQ WRTCIN1 OTHERWISE, CHECK FOR CONTINUATION
*
WCODD SA6 A3 STORE COMPLETED TABLE WORD (ODD ENTRY)
SX7 X2-1 DECREMENT TABLE ADDRESS
SA7 A2
MX6 0
SA6 A3-B1 CLEAR NEXT TABLE WORD
EQ WCNEXT
*
*
WCTADR BSS 1 CURRENT TABLE ADDRESS (RELATIVE)
WCSHFT BSS 1 SHIFT COUNT FOR NEXT CHARACTER
LFTFLG DATA 0 LEFT WRITING FLAG
*
ENDOV
* /--- BLOCK INITIAL-1 00 000 81/06/07 02.16
TITLE INITIALIZATIONS
*
EXT MESSBUF DAYFILE MESSAGE BUFFER
*
INITOV OVRLAY
SA5 APLACOM (X5) = COMMUNICATION AREA
SX0 PC.ACC
IX0 X0+X5
SA0 ACCOUNT
RE 2 READ ACCOUNT AND LESSON NAME
RJ ECSPRTY
MX0 6
SA1 LESSON CHECK FOR VALID LESSON NAME
BX1 X0*X1
ZR X1,CABORT2
SX0 PC.SYS
IX0 X0+X5
SA0 SYSFLG SYSTEM/NON-SYSTEM FLAG
+ RE 1
RJ ECSPRTY
SX0 PC.STOR PACKED DESCRIPTORS OF CONDEN
IX0 X0+X5 RETURN INFO
SA0 COPTION CONDENSOR OPTIONS
RE 1
RJ ECSPRTY
SX0 PC.SRCA
IX0 X0+X5
SA0 WORK
RE 2 READ SOURCE FILE NAME
RJ ECSPRTY
SX0 PC.BADR
IX0 X0+X5
SA0 CONBUFF ADDRESS OF BUFFER FOR BINARY
+ RE 1
RJ ECSPRTY
SX0 PC.BLTH
IX0 X0+X5
SA0 CBLTH LENGTH OF BINARY BUFFER
+ RE 1
RJ ECSPRTY
*
SA1 LESSON SET UP B-DISPLAY MESSAGE
BX7 X1
SA7 MESSBUF
CALL S=BMSG,MESSBUF
*
*
SA1 SYSCLOK STORE TIME AT START OF CONDENS
BX6 X1
SA6 RTBEG STORE REAL TIME CLOCK
CALL S=CTIME,CTBEG STORE CPU CLOCK
*
* SET UP FILE POINTERS / OPEN FILE
*
SB2 FREQ OPEN THE FILE
SA0 CBUF
SA1 AFILEBF
SA2 WORK RETRIEVE SOURCE FILE NAME
SA3 WORK+1 (TWO WORDS)
RJ =XOPEN
NZ X6,CABORT2 IF CANNOT OPEN FILE
SA1 COPTION SET CSTOADR = ECS ADDR OF USERS
* STORAGE FOR RETURN INFORMATION FROM CONDENSOR
BX2 X1
AX2 XCODEAL
MX3 -24
BX6 -X3*X2
SA6 CSTOADR
BX0 X6 ZERO OUT S1 (WHICH CONTAINS
* BUFFER LENGTH POINTERS)
ZR X6,NOCSTO UNLESS NO -STORAGE-
*
MX6 0
WX6 X0
NOCSTO BSS 0
BX6 X2 CSTOLEN = LENGTH OF STORAGE
AX6 24
SA6 CSTOLEN
* /--- BLOCK INITIAL-1 00 000 81/07/28 01.50
IX6 X6+X0 CSTOLWA = LWA OF STORAGE
SA6 CSTOLWA
*
* OPEN OPTION BITS INTO FULL WORDS FOR FAST
* CHECKS DURING CONDENSE
*
SB3 COPTNUM B3 = NUMBER OF OPTIONS
SB2 B0 B2 = OPTION POINTER
SB1 1 B1 = 1
MX2 -1
COPTLP BX6 -X2*X1 ISOLATE NEXT OPTION BIT
SA6 COPTS+B2 STORE IN NEXT OPTION ELEMENT
SB2 B2+B1
AX1 B1 POSTION NEXT OPTION BIT
NE B2,B3,COPTLP IF MORE OPTIONS BITS TO OPEN
*
*
*
* GET TRUE COPY OF COMMANDS AND HASH INFO INTO CM
*
SA1 CMNDTBL
BX0 X1
SA0 COMNAMS
SA1 CMNDINF
+ RE =XCOMNAML READ COMMAND NAME TABLE
RJ ECSPRTY
BX0 X1
SA0 =XCOMINFO
+ RE =XCOMINFL READ HASHED INFO TABLE
RJ ECSPRTY
*
*
* -ERRINIT- (INITIALIZE BUFFER POINTERS)
*
*
SA1 ACEBUF ABSOLUTE ADDRESS OF CEBUF
SX6 MAINHDL LENGTH OF MAIN HEADER
IX6 X1+X6
SA6 PCEBUF NEXT AVAILABLE LOC IN CEBUF
SX6 B0
SA6 ERRCNT
SA6 ERRTOT
SA6 ZCONDOK =0 NOTSET ZCONDOK,=1 SET IT
SX6 1
SA6 UBLKNM
SA6 ULINENM
RJ UERRSET INTIALIZE *HEAD* WORD
SX6 VARLIM-MAINHDL
SA6 LCEBUF SPACE LEFT FOR SUBROUTINES
*
SX7 0
SA7 TSPECS CLEAR SPECS FLAG
SA7 SAYFLAG CLEAR SAY FLAG
SA3 ACLSTAT
SX1 SCLESNS
IX0 X3+X1
SA0 SCONTMP READ FROM ECS,TOTAL NUMBER OF LESSON CONDEN
+ RE 1
RJ =XECSPRTY
SA1 SCONTMP
SX3 1
IX6 X1+X3 INCREMENT TOTAL COUNT
SA6 A1
+ WE 1 WRITE BACK IN ECS
RJ =XECSPRTY
* /--- BLOCK INITIAL-2 00 000 81/06/07 02.18
*
SA1 CONBUFF ADDRESS OF BINARY BUFFER
SX6 LESHEAD
IX0 X1+X6
SA0 ACCOUNT
WE 2 WRITE OUT LESSON/ACCOUNT NAMES
RJ ECSPRTY
SX7 2
IX6 X0+X7 POINT TO NEXT WORD IN ECS
SA6 CONDPNT INIT NEXT AVAIL WORD IN FORMING BINARY
*
SA1 AZERBUF ZEROED ECS BUFFER
BX0 X1
SA0 WORK
+ RE 1000
RJ ECSPRTY
SA1 AGROUP INITIALIZE -GROUP- TABLES
BX0 X1
+ WE 4*NKGROUP
RJ ECSPRTY
SX7 0 X7 = 0
SA7 ECSARGS NO ECS ARGS YET
SA7 UEFLAG CLEAR TO CURRENTLY DOING UNIT (NOT ENTRY)
SA7 CUNITS ZERO UNIT SO FAR
SA7 COMPNAM
SA7 CSYMADD
SA7 JJVOCU SET TO NO VOCABULARY YET
SA7 TERMS NUMBER OF TERMS IN LESSON RESET
SA7 NDEFN NUMBER OF DEFNS
SA7 NOUNIT NO UNIT COMMANDS YET
SA7 COMREFF
SA7 CCDFLG
SA7 CCOMX CLEAR -COMMONX- WORD
SA7 XSTORL CLEAR XSTOR LENGTH
SA7 RVARL CLEAR ROUTER VARIABLE LENGHT
SA7 LVARL CLEAR LOCALS STACK SIZE
SA7 LVARN CLEAR NUMBER OF LOCALS
SA7 LOCAL CLEAR LOCALS FLAG
SA7 CCOMLES SET TO NO COMMON
SA7 CCOMACT
SA7 CCOMNAM
SA7 CCOMLTH
SA7 CCOMBIT
SA7 USEBCNT NUMBER OF BLOCKS USED
SA7 =XPPTMF PPT COMMAND MESSAGE FLAG
*
SX6 VARS
SA6 PVARS BASE LOCATION FOR DEFINED NAMES
SX6 -1
SA6 SSSTOP SET START/STOP SWITCH
SA6 DSET INITIALIZE DEFINE SET NUMBER
SB1 1
SB2 TOKADDS DEFINE DIRECTORY INITIALIATIONS
SB3 NAMADDS
SB4 TOKLENS
SB5 NAMLENS
SB6 SETNAMS
SB7 -1 INITIALIZE NULL SET ALSO
SA1 ADEFNEC ADDR OF ECS DEFINE BUFFER
BX6 X1
SX1 DECSLTH LENGTH OF DEFINED BUFFER
IX6 X6+X1 (X6) = END OF ECS DEF BUFF + 1
MX7 0
*
* /--- BLOCK INITIAL-3 00 000 81/06/07 02.18
DFADLP BSS 0
SA6 B2+B7 TOKADDS
SA6 B3+B7 NAMADDS
SA7 B4+B7 TOKLENS
SA7 B5+B7 NAMLENS
SA7 B6+B7 SETNAMS
SA7 UNTLENS+B7 NUMBER OF DEFINED UNITS
SB7 B7+B1
SX5 B7-MAXSET
NZ X5,DFADLP
*
SA1 ADEFNEC ADDR OF ECS DEFINE BUFFER
BX6 X1
SA6 TOKADDS-1 NULL SET OPEN
*
* FAKE UNIT 0 = TERMS
* FAKE UNIT 1 = DEFNS
* FAKE UNIT 2 = JUDGING SYMBOLS
* UNIT 3 = INITIAL ENTRY UNIT
*
SA1 KOIEU GET PROPER NAME FOR INITIAL ENTRY UNIT
BX7 X1
SA7 UNAME+IEUNUM STORE AWAY IN UNIT-NAME-TABLE
SX6 IEUNUM X6 = UNIT NUMBER
SA0 A7
SA1 AUNAME AND WRITE OUT TO ECS-UNIT-NAME-TABLE
IX0 X1+X6
+ WE 1
RJ ECSPRTY
*
*
SA6 UNUMON SET UNIT WORKING ON POINTER
SA6 UNIT LAST UNIT OR ENTRY CONDENSED
MX7 1 SET TOP BIT TO MARK NOT IN
SA7 ULOC+X6
SX6 X6+1
SA6 UNUMIN COUNT OF UNITS PROCESSED
*
SA1 BLANK8
BX6 X1
SA6 =XOLDCMND INITIALIZE OLDCMND TO 8 BLANKS
*
* INITIALIZE FOR ENTRY UNIT
*
SX6 INFOLTH
SA6 ICX INITIALIZE COMMAND POINTER
SX7 0
SA7 INX EXTRA STORAGE POINTER
SA7 LOCARO ARROW LOCATION (*INFO* OFFSET)
SA7 =XCALCACT SET TO NO -CALC- ACTIVE
SA7 NGLOBAL NUMBER OF GLOBAL SYMBOLS
SA7 MAKESYM FOR FAKE STATEMENT LABELS
SA7 NDOOFF NUMBER OF DEFERRED -DOTO-
SA7 DOBFPNT -DOTO- ECS POINTER
SA7 NDEFERR NUMBER OF DEFERRED REFERENCES
SA7 =XNLABELS NUMBER OF LABELS
SA7 GSYMERR1 GLOBAL SYMBOL ERROR FLAGS
SA7 GSYMERR2
* /--- BLOCK INITIAL-4 00 000 76/11/11 01.38
*
* ZERO OUT ECS ENDINGS BUFFERS
*
SA1 AZERBUF GET ADDRESS OF ZERO BUFFER
BX0 X1
SA0 WORK
+ RE 80 ZERO OUT THE ENDINGS BUFFER
RJ ECSPRTY
SA1 XBEND ADDRESS OF ENDINGS BUFFER
BX0 X1
+ WE 80
RJ ECSPRTY
*
* GET TRUE COPY OF CHARACTER SYMBOL TABLE FOR CONTENT
*
SA0 CONTAB READ CONTENT SYMBOL TABLE TO CM BUFFER
SA1 ACONTAB GET ADDRESS OF ECS BUFFER
BX0 X1
+ RE 129 TWO 64-WORD TABLES + 1 INFO WORD
RJ ECSPRTY
*
MX6 0 CLEAR DUMMY UNIT FOR JUDGING SYMBOLS
SX2 JSYMNUM
SA6 UNAME+X2 HENCE USE SYSTEM SYMBOLS
SA6 ULOC+X2
*
*
* CHECK ECS COMMAND CONDEN STATISTICS INFO BANK AND
* SET ITS CM FLAG (TSCOMFG) ACCORDINGLY. SINCE TURN
* ON/OFF OF COMMAND CONDEN STATISTICS IS CHECKED HERE ONLY AT
* ENTRY (TO MINIMIZE OVERHEAD) IT DOES NOT TAKE EFFECT UNTIL
* NEXT START OF LESSON CONDENSING (OR FINISHING OF
* CONDENSING IN CASE OF TURNING OFF).
*
CSIST SA3 ACDSTAT (X3) = ECS ADDR OF STATS BUFFER
ZR X3,SETCFG1 EXIT IF NO STATS BUFFER
BX0 X3 (X0) = ECS ADDR OF STATS BUFFER
SA0 SCONTMP (A0) = ADDR OF CM COPY
RE SCOMNDH READ PARAMETERS FROM PLATO
RJ =XECSPRTY
SA1 SCONTMP+SCOMFG1 SEE IF STATS DESIRED
ZR X1,SETCFG1 IF NOT REQUESTED
SA1 SCONTMP+SCOMLES SEE IF FOR SPECIFIC LESSON
SX7 1
ZR X1,SETCFG2 IF 0, GET STATS FOR ALL LESSONS
CALL FCOMPAR,(SCONTMP+SCOMACT),ACCOUNT
ZR X6,SETCFG2 IF YES
SETCFG1 MX7 0 NO STATISTICS
SETCFG2 SA7 TSCOMFG SET CM FLAG ACCORDINGLY
ZR X7,INI300 IF NOT TAKING STATISTICS
SA1 SCONTMP+SCOMZER SEE IF SHOULD ZERO BUFFER
ZR X1,INI300 IF BUFFER NOT TO BE ZEROED
SA1 AZERBUF (X1) = ADDR OF ZERO ECS BUFFER
BX0 X1
SA0 ZBUFFER (A0) = ADDR OF CM SCRATCH SPACE
RE CMNDMAX ZERO CM BUFFER
RJ ECSPRTY
SX1 SCOMNDS (X1) = OFFSET TO STATS
IX0 X1+X3 (X0) = WHERE TO START ZEROING
WE CMNDMAX ZERO THE BUFFER
RJ ECSPRTY
* /--- BLOCK INITIAL-4 00 000 76/11/11 01.38
MX6 0
SX1 SCOMZER
IX1 X1+X3
WX6 X1 ZERO REQUEST TO ZERO BUFFER
SX1 SCOMNDN
IX1 X1+X3
WX6 X1 ZERO TOTAL COMMANDS
SX1 SCOMNDT
IX1 X1+X3
WX6 X1 ZERO TOTAL TIME
* GO THROUGH THE PRELIMINARY CHECKS AGAIN IN CASE
* PLATO CHANGED THE PARAMETERS WHILE THESE CHECKS
* WERE IN PROGRESS. OTHERWISE WE COULD TAKE STATS
* ON THE WRONG LESSON, AND THE BUFFER WOULD NOT BE
* CLEARED AGAIN.
EQ CSIST
* /--- BLOCK INITIAL 00 000 81/05/08 04.28
*
* INITIALIZE PPT-TUTOR BUFFERS/VARIABLES
*
INI300 MX6 0
SA6 PPTF MARK NOT CONDENSING PPT-TUTOR
SA6 CVUF MARK CALC OVERLAYS NOT ASSIGNED
SA6 PPTVERS INITIALIZE VERSION
SA6 PUNITN UNIT COUNTER
SA6 PISTU 1ST PHYSICAL UNIT NUMBER
SA6 IUNUM CURRENT UNIT NUMBER
SA6 PDEFNS NUMBER OF DEFINED NAMES
SA6 PSETNAM CURRENT DEFINE SET NAME
SA6 PVARSIZ CURRENT VARIABLE SIZE
SA6 NVBYTES NUMBER VARIABLE BYTES ALLOCATED
SA6 DEFP DEFINE BYTE/SHIFT/ADDR WORD
SX6 777B
SA6 PCHRLIM MARK CHARSET LIMIT NOT SET YET
SA1 AZERBUF X1 = ADDRESS OF ZEROED ECS BUFF
BX0 X1
SA0 UNITTAB+2
+ RE PUNITL PRE-ZERO UNIT NAME TABLE
RJ ECSPRTY
*
* /--- BLOCK INITIAL-5 00 000 81/06/29 12.33
*
* THE FOLLOWING CODE HANDLES THE SPECIAL
* PROCESSING REQUIRED ON FIRST READ OF A LESSON.
*
SX7 0
SA7 USEINFO CLEAR USE FILE COUNT
SA7 USEFLAG NOT PROCESSING -USE-D CODE
SA7 BLKCNT INITIALIZE BLKCNT AND LINECNT
SA7 LINECNT
SA7 STOPFLG ZERO MEANS *CSTART*
SA7 INDENT LAST LINE HAD NO INDENTING
SA7 PISTACK INITIALIZE STACK POINTER
SA7 ISTACK CLEAR FIRST ELEMENT OF STACK
SX6 -1
SA6 NEWBLK FIRST LINE MAY NOT BE INDENTED
SA0 CBUF BUFFER
SA1 AFILEBF
BX0 X1
RE BLKLTH DIRECTORY FOR CURRENT LESSON
RJ =XECSPRTY
*
* INITIALIZE MICRO-TUTOR RELEASE LEVEL FROM LESSON
* DIRECTORY
*
SX2 4 X2 = BIAS TO BASE OF INFO
SB2 X2+O.APRIV BIAS TO ACCESS PRIVILEGE WORD
SA1 A0+B2
LX1 60-OPV.MR+OPV.MRN-1
MX6 -6 FORM MASK FOR M-TUTOR RELEASE
BX6 -X6*X1 MASK OFF M-TUTOR RELEASE LEVEL
+ NZ X6,*+1
SX6 1 SET RELEASE 0 = RELEASE 1
+ SA6 MTREL INITIALZE RELEASE LEVEL
SX6 400B
BX6 X6*X1 SET M-TUTOR CENTRAL SYSTEM
SA6 MTCENF EXECUTION FLAG
SX6 200B SET THE CENTRAL MICRO PLATO FLAG
BX6 X1*X6
SA6 CMPF
*
*
* INITIALIZE FILE UPDATE LEVEL
*
SB2 X2+O.UPD8 OFFSET TO UPDATE LEVEL
SA1 A0+B2
SX6 X1-MINUPD8 CHECK FOR OBSOLESCENCE
NG X6,=XOBSFILE
BX6 X1
SA6 FLEVEL STORE FILE UPDATE LEVEL
*
* /--- BLOCK INITIAL-5 00 000 80/08/19 04.17
*
****** HOPEFULLY TEMPORARY CODE FOR PPT-COMMANDS
MX6 -1 MARK PPT-COMMANDS LEGAL
SA6 =XPPTACC
* GET ACCOUNT NAME OF FILE
SB2 X2+O.ACNAM OFFSET TO ACCOUNT NAME
SA1 A0+B2
MX7 42
BX7 X7*X1
* NON-SERVICE SYSTEMS
SA1 CSYSNAM
BX6 X1
SA1 PPTNAMS+0
BX1 X6-X1
NZ X1,PPTM2 IF NOT FSU SYSTEM
SA1 ACCNAMS+0 CHECK GOOD ACCOUNTS
BX1 X7-X1
ZR X1,PPTM1
SA1 ACCNAMS+1
BX1 X7-X1
ZR X1,PPTM1
SA1 ACCNAMS+2
BX1 X7-X1
ZR X1,PPTM1
EQ PPTM3
PPTM2 SA1 PPTNAMS+1
BX1 X6-X1
NZ X1,PPTM3 IF NOT UOFDEL SYSTEM
SA1 ACCNAMS+3
BX1 X7-X1
ZR X1,PPTM1
* ALLOW IN SYSTEM LESSONS AND SPECIAL LESSONS
PPTM3 SA1 SYSFLG
LX1 ZPPTSHF
NG X1,PPTM1
* MARK ILLEGAL ELSEWHERE
MX6 0
SA6 =XPPTACC
EQ PPTM1
* /--- BLOCK INITIAL-5 00 000 81/07/29 02.50
PPTNAMS DATA 3LFSU
DATA 3LDL1
ACCNAMS DATA 7LARAMEAU
DATA 6LAMUSIC
DATA 6LAUIMUS
DATA 6LUOFDEL
PPTM1 BSS 0
****** HOPEFULLY TEMPORARY CODE FOR PPT-COMMANDS
SA1 A0+1 GET TYPE WORD
SA2 ROUTYPE
BX2 X1-X2
MX6 0 PRESET NOT A ROUTER
NZ X2,SETROUT
SX6 1
*
SETROUT SA6 ROUTER SET ROUTER LESSON FLAG
SA1 A0+EXTRAI+51 GET SPECIAL TYPE WORD
SX2 APPTYPE
MX6 0 PRESET NOT AN APPLIC LESSON
MX0 -6 TYPE IN BOTTOM 6 BITS
BX1 -X0*X1 ISOLATE SPECIAL TYPE
IX1 X1-X2 TEST TYPE
NZ X1,SETAPPL
SX6 1
SETAPPL SA6 APPLESS SET APPLIC. LESSON FLAG
*
* SEE FILE GETLIN FOR MORE COMPLETE COMMENTS
* A5 = POINTS TO SOURCE WORD BEING PROCESSED
* B5 = BLOCK END TEST MARKER (ONE PAST LAST WORD)
*
SB1 1 -GETCMD- ASSUMES B1 SET
SB5 CBUF+1 B5 = END TEST MARKER
SA5 B5-1 SET TO FORCE READ OF NEXT BLOCK
CALL GETCMD GET 1ST COMMAND (SETS *IEND*)
SX6 A5
SA6 IST SAVE POINTER TO NEXT COMMAND
EQ NXTLINE
* /--- BLOCK -ABORTC- 00 000 81/06/07 03.07
CABORT2 SX6 1 1 = BAD LESSON NAME
SA6 IOBUFF
SA1 LESSON
BX6 X1
SA6 A6+1
RJ =XABORTC
EQ =XCONDENS
*
* /--- BLOCK FCOMPAR 00 000 80/07/14 15.01
TITLE -FCOMPAR- COMPARE FILE NAMES
*
* -FCOMPAR-
*
* COMPARES TWO 2-WORD FILE NAMES.
*
* THE ACCOUNT PORTION OF A FILE NAME STORED WITHIN
* PLATO HAS THE FOLLOWING FORMAT';
*
* 42/ACCOUNT NAME, 6/ATTRIBUTE FLAGS, 12/UNDEFINED
*
* THE TOP ATTRIBUTE FLAG INDICATES AN ORIGINAL (OLD-STYLE)
* FILE. THE OTHER ATTRIBUTES ARE NOT YET USED.
*
* THE SECOND NAME PASSED TO -FCOMPAR- MUST BE COMPLETE.
* I.E., FILE NAME, ACCOUNT NAME, AND ALL ATTRIBUTES
* MUST BE KNOWN. THE FIRST NAME MAY BE INCOMPLETE, BUT
* THE FILE NAME MUST BE SPECIFIED. IN ORDER FOR A
* MATCH TO BE INDICATED, ALL KNOWN PROPERTIES OF THE
* SECOND NAME MUST MATCH THOSE OF THE FIRST NAME.
* I.E., THE FILE NAMES MUST MATCH, THE ACCOUNT NAME OF
* THE SECOND FILE (IF NON-ZERO) MUST MATCH THE FIRST
* ACCOUNT NAME, AND ALL ATTRIBUTE FLAGS SET FOR THE
* SECOND NAME MUST ALSO BE SET FOR THE FIRST NAME.
*
* ENTRY - B1 = ADDRESS OF FIRST FILE NAME
* B2 = ADDRESS OF SECOND FILE NAME
*
* EXIT - X6 = 0 IF MATCH, NON-ZERO IF NOT
*
* USES - A1, A2
* X0, X1, X2, X6
*
* /--- BLOCK FCOMPAR 00 000 80/07/14 15.01
*
*
FCOMPAR EQ *
SA1 B1+1 LOAD FIRST FILE NAME
SA2 B2+1 LOAD SECOND FILE NAME
IX6 X1-X2 COMPARE
NZ X6,FCOMPAR --- EXIT IF NO MATCH
*
SA1 B1 X1 = FIRST ACCOUNT WORD
SA2 B2 X2 = SECOND ACCOUNT WORD
MX0 48 MASK FOR NAME + ATTRIBUTES
BX1 X0*X1 ELIMINATE JUNK IN LOW 12 BITS
BX2 X0*X2
BX6 X1-X2 COMPARE ACCOUNT WORDS
ZR X6,FCOMPAR --- EXACT MATCH
*
BX6 X1*X2 MASK ACCOUNT WORDS TOGETHER
BX6 X6-X1 COMPARE RESULT WITH 1ST WORD
NZ X6,FCOMPAR --- NO MATCH
*
MX0 42 MASK FOR ACCOUNT NAMES ONLY
BX6 X0*X1 1ST ACCOUNT NAME
ZR X6,FCOMPAR --- MATCH IF 1ST NAME IS ZERO
*
BX2 X0*X2 2ND ACCOUNT NAME
BX6 X6-X2 COMPARE NAMES
EQ FCOMPAR
*
*
*
BLANK8 VFD 60/55555555555555550000B TO INITIALIZE OLDCMND
ROUTYPE VFD 60/10LROUTER A
APPTYPE EQU 2 APPLICATION LESSON TYPE
EXTRAI EQU 4 OFFSET INTO DIRECTORY EXTRA INFO
KOIEU VFD 12/0,48/3RIEU
*
ZBUFFER OVDATA CMNDMAX
*
ENDOV
* /--- BLOCK LESLIST 00 000 77/03/19 17.00
*
*
TITLE -LESLIST- ORIENTED COMMANDS
*
*
LISTOV OVRLAY
SA1 OVARG1
SB3 X1
JP B3+*
*
+ EQ * UNUSED AS OF 3/14/77 --M4
+ EQ ADDLC
+ EQ LNAMEC
+ EQ FINDLC
*
*
*
* -ADDLST- COMMAND
* ADDS A LESSON NAME TO *LESLIST*
*
*
ADDLC SB1 FSADDLS -ADDLST- IS PUBLISH ERROR
RJ =XPUBERRS
RJ COMPILE EVALUATE NAME VARIABLE
NZ B1,ERRSTOR ERROR IF NOT STOREABLE
BX6 X1
LX6 60-XCODEL POSITION -GETVAR- CODE
SA2 LASTKEY
ZR X2,PUTCODE EXIT IF ONLY ONE ARGUMENT
MX2 1
BX6 X2+X6 SET BIT FOR TWO ARGUMENT
SA6 VARBUF
CALL COMPILE EVALUATE INDEX
LX1 60-XCODEL-XCODEL
SA2 VARBUF
BX6 X1+X2 MERGE -GETVAR- CODES
EQ PUTCODE
*
* /--- BLOCK LESLIST 00 000 76/07/25 07.58
*
*
* -LNAME- COMMAND
* RETURNS DISPLAY FORMATTED NAME FROM *LESLIST*
*
*
LNAMEC CALL COMPILE EVALUATE NAME VARIABLE
NZ B1,ERRSTOR MUST BE STOREABLE
LX1 60-XCODEL POSITION -GETVAR- CODE
BX6 X1
SA6 VARBUF
CALL COMPILE EVALUATE INDEX VARIABLE
LX1 60-XCODEL-XCODEL
SA2 VARBUF
BX6 X1+X2 COMBINE -GETVAR- CODES
EQ PUTCODE
*
*
*
* -FINDL- COMMAND
* CHECKS TO SEE IF LESSON IS ENTERED IN LESLIST
*
*
FINDLC CALL COMPILE GET FIRST ARGUMENT
NZ B1,ERRSTOR
BX6 X1 SAVE -GETVAR- CODE
SA6 VARBUF
CALL PUTCOMP COMPILE CODE TO STORE 2ND ARG
LX1 60-XCODEL-XCODEL
SA2 VARBUF LOAD FIRST -GETVAR- CODE
LX2 60-XCODEL
BX6 X1+X2 COMBINE -GETVAR-/-PUTVAR- CODES
EQ PUTCODE
*
*
*
ENDOV
* /--- BLOCK CHANGE 00 000 76/10/06 03.01
TITLE CHANGE
*
* CHANGE COMMAND---ONLY IN CONDENSOR
*
*
CHGOV OVRLAY
*
RJ NXTCH GET FIRST ENTITY
CHG1 ZR X6,ERRNAME
*
SA6 CHTABX STORE THIS WORD AT END OF SEARCH
SB1 1
SA4 CHTAB-1
*
CHLP SA4 A4+B1 FIND WHAT TYPE OF CHANGE COMMAND
BX2 X4-X6
NZ X2,CHLP LOOP THRU ALL POSSIBLILIES
SB1 A4-CHTAB GET INDEX
JP CHJP+B1 JUMP TO PROPER ROUTINE
*
CHJP EQ CHCMD COMMAND
EQ CHSYM SYMBOL
.CLANG IFGT CLANGS,1
EQ CHLANG LANGUAGE
EQ CHENDL PUT IN SET OF NEW LANGUAGE COMMANDS
.CLANG ENDIF
EQ ERRNAME NO FIND
*
CHTAB DATA 8LCOMMAND TUTOR COMMANDS
CHTABSL DATA 8LSYMBOL CHARACTER SYMBOLS IN JUDGING
.CLANG IFGT CLANGS,1
DATA 8LCOMMANDS CHANGE COMMANDS TO DIFFERENT LANGUAGE
DATA 8LENDCMNDS PUT IN NEW SET OF COMMAND FOR DIFF LANGUAGE
.CLANG ENDIF
CHTABX DATA 0
*
SPACE 6
* CHANGE COMMAND X TO Y
* CHANGE THE NORMAL NAME OF A TUTOR COMMAND
* TO SOMETHING ELSE FOR THIS CONDENSE
* WHERE X IS NORMAL TUTOR COMMAND AND Y IS NEW NAME
* (THE WORD -TO- IS OPTIONAL)
*
* /--- BLOCK CH-COMMAND 00 000 81/07/17 15.09
*
CHCMD RJ NXTCH GET NEXT WORD
ZR X6,ERRNAME
*
* CHCMD1 SA6 CHGTEMP
SA6 CHGTEMP NO DEFAULT CASE NOW.LAW7/18/76
RJ NXTCH GET NEXT ENTITY
ZR X6,ERRNAME
SA1 LTO =8LTO
BX2 X1-X6 FORMAT IS -CHANGE X TO Y
NZ X2,CHGIT BUT -CHANGE X Y - IS ALSO OK
RJ NXTCH GET NEXT ENTITY
ZR X6,ERRNAME
CHGIT SA2 CHGTEMP
* COME HERE WITH X2 AND X6 SET (I.E. CHANGE X2 TO X6).
*CALL MACROS
ADR MICRO 1,,/A0/ A0 = START OF HASH TABLE
COM MICRO 1,,/COMNAMS/
SA0 =XCOMINFO COMINFO IS HASH TABLE
LIST G
* LOCATE OLD NAME IN TABLE
HASH X2,X1,A3 X1 = HASH CODE FOR *FROM* NAME
FIND X2,X1,CHGITA,B2,X0,B1,B3,B4,A3
EQ ERRNAME ERROR IF NAME NOT FOUND
* MAKE SURE NEW NAME IS NOT IN TABLE
CHGITA HASH X6,X5,A3 X5 = HASH CODE FOR *TO* NAME
FIND X6,X5,ERRORC,B6,X4,B5,B3,B4,A3
* STORE NEW NAME IN NAME TABLE
SA6 =XCOMNAMS+B1
* REMOVE LINKS TO OLD HASH INFO
DELLINK B2,B3,X3,B4,B5,A4,A7
* ADD LINKS TO NEW HASH INFO
SB5 X5 HASH CODE FOR NEW NAME
ADDLINK B5,B3,X3,B7,A4,A7
*
SA2 UNUMON WARN THAT ALL CHANGE COMMANDS
SX3 IEUNUM MUST BE IN IEU
BX3 X2-X3
ZR X3,NXTLINE
SB1 69 ERROR NUMBER FOR -CONDERR-
RJ =XRJERR
EQ NXTLINE
*
NXTCH EQ * FIND THE NEXT ENTITY
SA1 WORDPT
SB1 X1
SB2 60
SB3 6
MX6 0
*
NXSK SA1 B1 SKIP LEADING SPACES
SX2 X1-1R SPACE
NZ X2,CNLL
SB1 B1+1
EQ NXSK
*
CNLL SA1 B1 LOAD NEXT CHAR
ZR X1,CNLL5
SB1 B1+1
SX2 X1-1R TEST FOR SPACE
ZR X2,CNLL5
SB2 B2-B3
GE B3,B2,ERRNAME BAD IF OVER 8 CHARS
LX1 X1,B2
BX6 X6+X1 ADD TO WORD-A-BUILDING
EQ CNLL
CNLL5 ZR X6,CNLL8
CNLL6 SB2 B2-B3 NOW FILL REST WITH SPACES TO 8 CHARS
GE B3,B2,CNLL8
SX1 1R SPACE
LX1 X1,B2
BX6 X6+X1
EQ CNLL6
CNLL8 SX7 B1
SA7 WORDPT
EQ NXTCH
*
LTO DATA 8LTO
LFTO VFD 60/75241755555555550000B (FONT)TO
CHGTEMP BSS 1 TEMP STORAGE
* /--- BLOCK CH-SYMBOL 00 000 78/02/13 22.38
TITLE CHANGE SYMBOL X TO Y
*
*
* CHANGE SYMBOL X TO Y
*
* ALTERS THE STANDARD JUDGING VALUES OF CHARACTERS
*
CHSYM SA2 UNUMON CHANGE SYMBOLS ONLY IN IEU
SX3 IEUNUM
BX3 X2-X3
NZ X3,CHSERR1
SA2 CONTEST THIS MUST BE FIRST SYMBOL CHANGE
SA3 CONTAB
BX3 X2-X3
NZ X3,CHSERR2
SA2 LESSON SET JUDGING SYMBOL FLAG TO THIS LESSON
BX6 X2
SA6 A3
SA2 COMMAND SAVE NAME OF THIS COMMAND FOR
BX6 X2 LATER TESTING OF CONTINUED ADDITIONAL
SA6 CHGNAME CHANGE COMMANDS ... THIS METHOD
* ALLOWS FOR -CHANGE CHANGE TO WOW-
CHSYM1 RJ NXTCH GET NEXT ENTITY
MX5 0 INITIALIZE FONT FLAG
RJ SYMBL GET FIRXT SYMBOL
BX4 X1 SAVE CHARACTER TO CHANGE
SB4 B2 AND SAVE SHIFT
*
RJ NXTCH GET NEXT ENTITY
SA1 LTO SEE IF -TO-
BX2 X1-X6
ZR X2,CHSYM3
SA1 LFTO SEE IF -(FONT)TO-
BX2 X1-X6
NZ X2,CHSYM4 IF NOT, TRY FOR SECOND SYMBOL
SX2 100B
BX5 X2-X5 TOGGLE FONT
*
CHSYM3 RJ NXTCH GET NEXT ENTITY
*
* /--- BLOCK CH-SYMBOL 00 000 77/12/07 12.19
CHSYM4 ZR X6,ERRNAME THERE MUST BE SOMETHING THERE
SA6 SYMTABX STORE INTO END OF SEARCH LIST
SA1 SYMTAB-1 INITIALIZE START
SB1 1
SYMLP SA1 A1+B1 LOAD SEARCH WORDS
BX2 X1-X6
NZ X2,SYMLP CONTINUE UNTIL FIND MATCH
SB1 A1-SYMTAB CALCULATE NUMBER MATCH
JP SYMJP+B1
SYMJP SX1 COPLET SET TO LETTER (CONSONANT)
EQ SYMDO
+ SX1 COPVOWL SET TO LETTER (VOWEL)
EQ SYMDO
+ SX1 COPPUNC SET TO MISC. PUNCTUATION
EQ SYMDO
+ SX1 COPPUWD SET TO PUNCTUATION AND WORD
EQ SYMDO
+ SX1 COPNULL SET TO NULL CODE
EQ SYMDO
+ SX1 COPDIAC SET TO DIACRITIC
EQ SYMDO
+ EQ CHSYM5 NO FIND...TRY DIRECT CHANGE
*
SYMTAB DATA 8LLETTER CHANGE TO LETTER (CONSONANT)
DATA 8LVOWEL CHANGE TO LETTER (VOWEL)
DATA 8LPUNC CHANGE TO PUNCTUATION
DATA 8LPUNCWORD CHANGE TO PUNC AND WORD
DATA 8LNULL CHANGE TO NULL CODE
DATA 8LDIACRIT CHANGE TO DIACRITIC CODE
SYMTABX DATA 0
*
SYMDO SA2 CONTAB+1+X4 GET OLD 15-BIT ENTRY
LX2 X2,B4 GET 15-BITS TO TOP
MX3 6
BX3 -X3*X2 BLANK OUT OPERATION CODE
LX1 54 GET NEW OP CODE
BX6 X1+X3 PUT NEW OP CODE WITH OLD INFO BITS
EQ CHSUB NOW FINISH SUBSTITUTION
*
*
CHSYM5 RJ SYMBL GET SECOND SYMBOL
*
SA2 CONTAB+1+X1 GET SUBSTITUTE WORD
LX6 X2,B2 SHIFT TO GET 15-BITS TO TOP
CHSUB MX7 15 NOW SUBSTITUTE NEW ENTITY FOR OLD
BX6 X6*X7 GET 15-BITS
SA4 X4+CONTAB+1 GET WORD TO CHANGE IN USER TABLE
SB3 60
SB4 B3-B4
LX7 X7,B4
LX6 X6,B4
BX4 -X7*X4 ZERO OUT CODE TO CHANGE
BX6 X4+X6 ADD NEW SYMBOL
SA6 A4 AND RESTORE IN CURRENT USER TABLE
* /--- BLOCK CH-SYMBOL 00 000 77/03/31 21.43
*
SA2 WORDPT MAKE SURE THAT THE LINE IS EXHAUSTED
SA2 X2
NZ X2,ERRTERM
*
CKSYMON SA1 NEXTCOM SEE IF NEXT COMMAND ANOTHER SYMBOL CHANGE
SA2 COMCONT TEST AGAIN A BLANK COMMAND
BX2 X1-X2
ZR X2,CHGOON
SA2 CHGNAME GET NAME OF CHANGE COMMAND
BX2 X1-X2
ZR X2,CHGOON
*
SA1 CONDPNT GET CURRENT READ-IN ECS POINTER
BX0 X1
SA0 CONTAB GET ADDRESS OF CHANGED JUDGING SYMBOLS
+ WE 129 PUT SYMBOLS OUT AS DUMMY UNIT
RJ ECSPRTY
SX2 129 LENGTH = 1 LABEL + 2-64 WORD TABLES
IX6 X1+X2 INCREMENT TO GET NEW LENGTH
SA6 A1 AND STORE NEW LENGTH
SA3 CONBUFF GET START OF CONDENSE BUFFER
IX6 X1-X3 GET RELATIVE START OF TABLE
LX6 ULOC2
BX6 X6+X2 PUT BIAS AND LENGTH TOGETHER
LX6 ULOC3+ULOC4
BX6 X6+X2 AND AGAIN FOR TOTAL LENGTH
LX6 60-ULOC1-ULOC2-ULOC3-ULOC4
SX3 JSYMNUM GET DUMMY UNIT NUMBER
SA6 ULOC+X3 STORE RELATIVE ADDRESS AS UNIT NAME
SA4 KJUDSYM SET UNIT NAME TO -JUDGESYM-
BX6 X4
SA6 UNAME+X3
EQ NXTLINE ONTO NEXT COMMAND
*
KJUDSYM VFD 12/0,48/8LJUDGESYM
*
CHGOON RJ GETLINE GET NEXT LINE
RJ NXTCH GET NEXT ENTITY
ZR X6,ERRNAME
SA2 CHTABSL SEE IF SYMBOL
BX2 X2-X6
ZR X2,CHSYM1 GO ONTO NEXT SYMBOL CHANGE
EQ CHG1 SEE IF ANOTHER TYPE OF CHANGE COMMAND
*
*
CHSERR1 SB1 67 ONLY IN IEU
EQ =XERR NO RETURN
*
CHSERR2 SB1 68 ALL SYMBOL CHANGES TOGETHER
EQ =XERR NO RETURN
* /--- BLOCK CH-SYMBOL 00 000 76/05/14 01.30
*
SPACE 6
* SYMBL...RETURNS X1 WITH CHARACTER FROM 0-127
* AND B2 WITH SHIFT TO 15-BIT PACKAGE
* SYMBOLS ARE CHECKED FOR LEGALITY
SYMBL EQ * GET NEXT SYMBOL
*
SA6 SYMBLD SEE IF SPECIAL WORD CASE
SA1 SYMBLT-1 PRE-SET FOR FIRST WORD TO SEARCH
SB1 1
*
SYMBLP SA1 A1+B1 GET NEXT WORD
BX2 X1-X6
NZ X2,SYMBLP LOOP UNTIL MATCH
SB1 A1-SYMBLT GET INDEX OF FOUND WORD
SA1 SYMBLTD+B1 GET INFO WORD
ZR X1,SYM0 ZERO MEANS TRY EXPLICIT CHARACTER OPTION
SB2 X1 SET SHIFT COUNT
AX1 30 AND SET CHARACTER
EQ SYMBL
*
SYMBLT DATA 8LSPACE TABLE OF SPECIAL WORDS OF INVISIBLE CHARS
DATA 8LSUP
DATA 8LSUB
DATA 8LSUPLOCK
DATA 8LSUBLOCK
DATA 8LBKSP
DATA 8LCR
*
DATA 8LFSPACE F=ALTERNATE FONT CASE
DATA 8LFSUP
DATA 8LFSUB
DATA 8LFSUPLOCK
DATA 8LFSUBLOCK
DATA 8LFBKSP
DATA 8LFCR
SYMBLD DATA 0 HOLDS PLANTED END TEST WORD
*
SYMBLTD VFD 30/55B,30/0 TABLE OF CHARACTER CODE AND SHIFT
VFD 30/67B,30/0 THAT IS IN ONE-ONE CORRESPONDENCE
VFD 30/66B,30/0 TO THE PREVIOUS TABLE
VFD 30/67B,30/15
VFD 30/66B,30/15
VFD 30/74B,30/0
VFD 30/71B,30/0
*
VFD 30/155B,30/0
VFD 30/167B,30/0
VFD 30/166B,30/0
VFD 30/167B,30/15
VFD 30/166B,30/15
VFD 30/174B,30/0
VFD 30/171B,30/0
DATA 0
* /--- BLOCK CH-SYMBOL 00 000 76/10/06 04.08
*
SYM0 SB2 B0 NO SHIFT OR ACCESS YET
MX0 54
*
SYM1 LX6 6 GET NEXT CHARACTER
BX1 -X0*X6
BX6 X0*X6 CLEAR OUT OF X6
ZR X1,SYMBLRR THERE MUST BE SOMETHING THERE
SX2 X1-FONT SEE IF FONT
NZ X2,SYM2
SX2 100B TOGGLE FONT
BX5 X5-X2
EQ SYM1
*
SYM2 SX2 X1-KUP SEE IF SHIFT CODE
NZ X2,SYM3
NZ B2,SYM2A SEE IF ACCESS-SHIFT
SB2 15 SET SHIFT SHIFT
EQ SYM1
SYM2A SX2 B2-30 MAKE SURE ONLY ACCESS BEFORE
NZ X2,SYMBLRR
SB2 45
EQ SYM1
*
SYM3 SX2 X1-ACCESS SEE IF ACCESS CODE
NZ X2,SYM4
SB2 30 SET FOR ACCESS SHIFT
EQ SYM1
*
SYM4 IX1 X1+X5 ADD IN FONT TOGGLE
*
SYM5 LX6 6 ONLY SPACES LEFT
BX2 -X0*X6
ZR X2,SYMBL
SX3 X2-1R
ZR X3,SYMBL
SX3 X2-FONT ALLOW FONT AND DO TOGGLE
NZ X3,SYMBLRR
SX2 100B
BX5 X5-X2
EQ SYM5
*
*
SYMBLRR SB1 66 SET TO SPECIAL MESSAGE
RJ =XRJERR
EQ CKSYMON AND CONTINUE TO NEXT LINE
*
CHGNAME BSS 1 THIS IS STORED INTO NEAR CHSYM
* /--- BLOCK CH-LANGS 00 000 76/10/07 00.57
.CLANG IFGT CLANGS,1
TITLE CHANGE COMMANDS TO LANGUAGEX
*
* CHANGE ENDCMNDS LANGUAGEX
*
CHENDL RJ NXTCH GET NAME OF LANGUAGE
ZR X6,ERRORC
*
SA3 LESSON
SA4 KS0LANG LEGAL ONLY IN LESSON S0LANG
BX4 X3-X4
NZ X4,ERRORC
SA4 ACCOUNT
LX4 42 SHIFT TO OLD-STYLE FLAG
PL X4,ERRORC MUST BE AN OLD-STYLE FILE
*
CHEND1 SA1 CMNDLGS GET ECS ADDRESS OF LANGUAGE NAMES
BX0 X1
SA0 CHWORK
SB1 1
SB2 CLANGS NUMBER OF POSSIBLE LANGUAGES
SX7 B1
MX2 0 BIAS TO THIS LANGUAGES TABLES
SX3 CMNDMAX
*
CHENDLP RE 1 GET LANGUAGE NAME
RJ ECSPRTY
SA4 A0
ZR X4,CHENDF SEE IF FIND EMPTY SPOT
BX4 X4-X6 SEE IF SHOULD CHANGE EXISTING TABLES
ZR X4,CHENDF
IX2 X2+X3 INCREMENT BIAS INTO TABLES
SB2 B2-B1
IX0 X0+X7 INCREMENT
NZ B2,CHENDLP
EQ ERRORC
*
CHENDF SA6 A0 NOW STORE AWAY NEW LANGUAGE NAME
+ WE B1
RJ ECSPRTY
SA1 CMNDTBL AND STORE AWAY CURRENT TABLES
IX0 X1+X2 WITH PROPER BIAS
SA0 COMNAMS
+ WE =XCOMNAML
RJ ECSPRTY
SA1 CMNDINF
IX0 X1+X2
SA0 =XCOMINFO
+ WE =XCOMINFL
RJ ECSPRTY
*
* NOW GET TRUE COPY OF COMMANDS AND HASH INFO INTO CM
* SO WE GO ON WITH FRESH ENGLISH TABLES
*
SA1 CMNDTBL
BX0 X1
SA0 COMNAMS
+ RE =XCOMNAML READ COMMAND NAME TABLE
RJ ECSPRTY
SA1 CMNDINF
BX0 X1
SA0 =XCOMINFO
+ RE =XCOMINFL READ HASHED INFO TABLE
RJ ECSPRTY
EQ NXTLINE AND ONTO NEXT LINE
*
*
CHWORK BSS 1
* /--- BLOCK CH-LANGS 00 000 76/10/06 23.15
TITLE CHANGE COMMANDS TO LANGUAGEX
*
CHLANG RJ NXTCH GET NEXT ENTITY
ZR X6,ERRORC
SA1 LTO SEE IF -TO-
BX2 X1-X6
NZ X2,CHLANG1
RJ NXTCH
ZR X6,ERRORC
*
* NOW SEARCH FOR DESIRED LANGUAGE NAME
*
CHLANG1 SA1 CMNDLGS GET ECS ADDRESS OF LANGUAGE NAMES
BX0 X1
SA0 CHWORK
SX7 1
MX2 0 BIAS TO THIS LANGUAGES TABLES
SX3 CMNDMAX
*
CHLANGL RE 1 GET NEXT LANGUAGE NAME
RJ ECSPRTY
SA4 A0
ZR X4,ERRORC CANNOT FIND NAME...ZERO GUARANTEED END TEST
BX4 X4-X6 SEE IF NAME LOOKING FOR
ZR X4,CHLANG3
IX2 X2+X3 INCREMENT BIAS INTO TABLES
IX0 X0+X7 INCREMENT
EQ CHLANGL
*
CHLANG3 SA1 CMNDTBL NOW GET TABLES FOR THIS LANGUAGE
IX0 X1+X2 WITH PROPER BIAS
SA0 COMNAMS
+ RE =XCOMNAML
RJ ECSPRTY
SA1 CMNDINF
IX0 X1+X2
SA0 =XCOMINFO
+ RE =XCOMINFL
RJ ECSPRTY
*
EQ NXTLINE NOW ON WITH NEW COMMANDS
.CLANG ENDIF
*
ENDOV
* /--- BLOCK DRAW 00 000 79/12/15 22.06
TITLE CONDENSE DRAW COMMANDS
*
* DRAW P1;P2;P3;P4 -OR- DRAW ;P1;P2;P3 WHICH IS
* EQUIVALENT TO DRAW WHERE;P1;P2;P3 . THIS CONTINUED
* DRAW IS FLAGGED WITH SIGN BIT OF COMMAND WORD.
* ALSO USED FOR GDRAW -- FROM -ORIGIN- AND SCALED.
* ALSO USED FOR RDRAW -- RELATIVE, ROTATED, AND SIZED.
* OVARG1 = 0 FOR DRAW
* 1 FOR GDRAW
* 2 FOR RDRAW
*
* THE VERTICES ARE PACKED UP INTO ONE OR TWO 20 BIT
* PACKAGES. THE FIRST TWO PACKAGES ARE IN THE COMMAND
* WORD, THE REST ARE IN EXTRA STORAGE. THE FIRST PACKAGE
* CONTAINS THE NUMBER OF PACKAGES.
* THE FIRST PACKAGE HAS LEFT BIT SET IF CONTINUED
* COMMAND, NEXT BIT SET IF ALL VERTICES ARE PACKED 9BIT
* CODES. REST OF PACKAGES ARE 2 BITS OF TYPE, 18 BITS
* OF GETVAR CODE. 2BIT TYPE CODE AS FOLLOWS';
* 00=COARSE GRID -GETVAR- CODE
* 01=FINE GRID -GETVAR- CODE (ONLY X-COORD MARKED)
* 10=18 BIT CODE IS 9BIT-X,9BIT-Y
* 11=SKIP
*
EXT RCTOXY
*
DRAWOV OVRLAY
SA2 WORDPT SKIP OVER LEADING BLANKS
SA1 X2-1
SX2 1R
SB1 1
DRAWC1 SA1 A1+B1 LOOK AT NEXT CHARACTER
IX7 X1-X2
ZR X7,DRAWC1 LOOP TILL NON BLANK
*
ZR X1,ERR2FEW IF NO TAGS
SX7 A1 X7 = NEW VALUE FOR WORDPT
MX6 0 ASSUME NOT CONTINUED DRAW
SX2 X1-KSEMIC
NZ X2,DRAWC2 IF NOT CONTINUED
SX7 X7+B1 MOVE WORDPT PAST TERMINATOR
MX6 1 CONTINUED DRAW
LX6 XCODEL
DRAWC2 SA6 TDRAW TYPE OF DRAW COMMAND
SA7 A2 UPDATE WORDPT
*
RJ CONDRAW GETVAR CODES INTO VARBUF
*
SA1 LASTYPE
NG X1,ERRXYTG -- ERROR, FINE X WITHOUT Y
ZR X1,DRAWC3 -- OK, COARSE GRID
* -SKIP- IS LAST TAG, BACKUP COUNTERS TO IGNORE IT
SA1 VARBUF NUMBER OF GETVAR CODES
SA2 VERTEX NUMBER OF VERTICES
SX6 X1-1
SX7 X2-1
SA6 A1
SA7 A2
DRAWC3 BSS 0
*
SA1 VERTEX
LX1 1 TWICE THE VERTICES
SX2 X1-SHAREL BUFFER FOR (X,Y) VALUES
PL X2,ERR2MNY NOT ENOUGH EXECUTION ROOM
*
SA4 VARBUF A4 HOLDS ADR OF FIRST 20 BIT PACKAGE
SX2 X1-2
SA1 TDRAW FLAG FOR FIRST ARG BLANK
NZ X2,DRAWIN2 JUMP IF MORE THAN ONE VERTEX
NZ X1,DRAWIN2 JUMP IF FIRST ARG BLANK
*
* IF ONLY ONE VERTEX, NEED TO DRAW A LINE FROM STARTING
* POINT TO ENDING POINT (THAT IS, A DOT). FOLLOWING
* CODE CAUSES PROBLEMS IF THE ARGUMENTS SPECIFYING THE
* DOT CONTAIN ASSIGNMENTS, FOR THE ASSIGNMENTS WILL BE
* /--- BLOCK DRAW 00 000 79/12/15 22.06
* EXECUTED TWICE. PROCEDURE SHOULD BE CHANGED.
*
SX2 X4-1
* /--- BLOCK DRAW 00 000 76/08/21 17.05
ZR X2,DDOTC JUMP IF COARSE SINGLE VERTEX
SA2 A4+1 MOCKUP DRAW X1,Y1;X1,Y1
BX7 X2
SA7 A4+3
SA2 A4+2
BX7 X2
SA7 A4+4
SX4 4
EQ DRAWIN2
DDOTC SA2 A4+1 MOCKUP DRAW RC1;RC1
BX7 X2
SA7 A4+2
SX4 2
DRAWIN2 SX2 X4+1 X2 HOLDS COUNT OF 20 BIT PACKAGES
BX4 X1+X4
SA1 SFFLAG FLAG FOR ALL PACKED TAGS
BX4 X4+X1
BX1 X2 ALLOW ANY NUMBER OF VARIABLES
RJ VARFINS USE STANDARD VARFIN PROCESSOR
EQ NXTLINE
*
* - - - - SUBROUTINE TO HANDLE DRAW COMMAND - - - -
* USES SEMICOLON FOR ARG TERMINATOR
* FORMAT IS -- DRAW P1;P2;P3;P4
* WHERE P2 MAY BE COARSE (1512) OR FINE (100,200).
*
* 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
*
* 20-BIT CODE FOR EACH VAR IS AS FOLLOWS--
* TOP 2 BITS'; 0=COARSE,1=FINE,2=PACKED FINE,3=SKIP
* LOWER 18 BITS -- GETVAR CODE OR PACKED FINE GRID
*
*
CONDRAW EQ *
MX6 0
SA6 VARBUF ZERO VARBUF(0) - NO VARS YET
SA6 VERTEX COUNT NUMBER OF VERTICES
SA6 LASTYPE INDICATE DONE WITH LAST VERTEX
SA1 OVARG1 0 IF WANT TO PACK (-DRAW-)
NZ X1,NOPACK
SX6 1
LX6 XCODEL-2 NEXT TO TOP BIT IF ALL PACKED
NOPACK SA6 SFFLAG WILL BE MERGED INTO CMND WORD
CDRAW RJ CONDRAW2 GET CODE FOR NEXT VARIABLE
SA1 WORDPT CHECK FOR END-OF-LINE
SA1 X1
NZ X1,CDRAW JUMP IF NOT EOL
SA1 NEXTCOM CHECK FOR CONTINUATION
SA2 COMCONT
BX3 X1-X2
NZ X3,CONDRAW --- EXIT IF NOT CONTINUED
RJ GETLINE READ IN NEXT LINE
EQ CDRAW
*
*
* /--- BLOCK DRAW 00 000 76/08/21 17.12
*
* - - - - SUBROUTINE TO GET NEXT VARIABLE - - - -
* USES STANDARD LEXICAL SEPARATORS
*
CONDRAW2 EQ *
CODRW0 BSS 0
SA1 WORDPT POINTER TO FIRST CHARACTER
SA1 X1
ZR X1,CONDRAW2 IF END-OF-LINE
SX2 X1-1R
NZ X2,CODRW1 IF NOT BLANK
SA1 WORDPT ADVANCE CHARACTER POINTER
SX6 X1+1
SA6 A1
EQ CODRW0
CODRW1 BSS 0
SA1 X1+KEYTYPE GET TYPE OF FIRST CHARACTER
NZ X1,CODRW2 JUMP IF NOT NUMERIC
CALL QUIKCMP FOR QUICK COMPILE OF NUMBER
EQ CODRW3
*
CODRW2 CALL COMPSYM,SKIP,1 WILL CHANGE CODE LATER
CODRW3 SA2 VARBUF X2 HOLDS CURRENT NO. OF ARGS
SX7 X2+1 X7 HOLDS NEW NO. OF ARGUMENTS
SX2 X7-VARBUFL SUBTRACT OFF SIZE OF VARBUF
PL X2,ERR2MNY EXIT IF READINBF FULL
SA7 A2 NEW VARIABLE COUNT IN VARBUF(0)
* X1=GETVAR CODE, X7=OFFSET IN VARBUF TO PLACE CODE
SA3 VERTEX COUNT VERTICES
SX6 X3+1
SA6 A3
*
SA2 LASTKEY CHECK FOR TERMINATOR TYPE
SX2 X2-1R,
SA4 LASTYPE PICK UP PREVIOUS GETVAR TYPE
BX0 X1
AX0 XCODEAL CHECK FOR -SKIP- OPTION
SX6 X0-7
NZ X6,CODRW4 IF NOT -SKIP- OPTION
*
* -SKIP- OPTION ---
ZR X2,ERRTERM COMMA MUST NOT FOLLOW SKIP
NZ X4,ERRXYTG -,SKIP- AND -SKIP;SKIP- ILLEGAL
* (IF ONLY WANT -,SKIP- ILLEGAL, MAKE IT -NG X4,ERRXYTG-)
SX6 1 INDICATE SKIP
SA6 A4
MX1 2 SKIP HAS TOP TWO BITS SET
LX1 XCODEL
EQ CODRW9
*
CODRW4 NZ X2,CODRW5 IF DOESNT TERMINATE WITH -,-
*
* NOT -SKIP-, AND TERMINATES WITH -,-
NG X4,ERRXYTG IF LAST WAS ALSO -X- COORD
MX6 -1 INDICATE X OF FINE GRID
SA6 A4
MX6 1
LX6 XCODEL-1 NEXT TO TOP BIT FOR X-COORD
BX1 X1+X6
EQ CODRW9
*
* /--- BLOCK DRAW 00 000 76/08/21 21.46
CODRW5 MX6 0
SA6 A4 INDICATE DONE WITH VERTEX
NG X4,CODRW6 IF LAST WAS -X- COORD
*
* CURRENT ARG IS COARSE GRID ---
SA2 OVARG1 = 1 FOR GDRAW
SX6 X2-1
ZR X6,ERRXYTG GDRAW CANNOT HAVE COARSE GRID
NZ X0,CODRW8 ALL DONE IF NOT SHORT LITERAL
NZ X2,CODRW9 C/F CONVERSION ONLY FOR DRAW
BX0 X7 SAVE POINTER INTO VARBUF
RJ RCTOXY X6=X, X7=Y, X0-X1 UNCHANGED
BX3 X7 Y-COORDINATE
BX7 X0 RESTORE VARBUF OFFSET
MX4 -9
BX0 X4*X6
NZ X0,CODRW8 IF WONT FIT IN 9 BITS
BX0 X4*X3
NZ X0,CODRW8 IF WONT FIT IN 9 BITS
LX6 9 THEY FIT, PACK THEM UP
BX1 X6+X3
MX6 1 INDICATE X-Y PACKED FORMAT
LX6 XCODEL
BX1 X1+X6
EQ CODRW9
*
* -Y- COORDINATE. SEE IF CAN PACK WITH -X- COORDINATE
CODRW6 SA2 VERTEX
SX6 X2-1
SA6 A2
NZ X0,CODRW8 NOPE, -Y- IS NOT SHORT LITERAL
SA2 OVARG1 0 FOR DRAW
NZ X2,CODRW8
SA2 VARBUF+X7-1 GETVAR CODE FOR -X- COORD
MX0 -18 IGNORE BIT 'I PUT ON
BX2 -X0*X2
MX4 -9 ONLY USE 9 BITS NOW
BX0 X4*X1
NZ X0,CODRW8 IF WONT FIT IN 9 BITS
BX0 X4*X2
NZ X0,CODRW8 IF WONT FIT IN 9 BITS
LX2 9 THEY FIT, PACK THEM UP
BX1 X1+X2
MX6 1 INDICATE X-Y PACKED FORMAT
LX6 XCODEL
BX1 X1+X6
SA2 VARBUF DECREMENT VARBUF COUNT
SX7 X2-1
SA7 A2
EQ CODRW9 AND OUTPUT
*
CODRW8 SX6 0 INDICATE NOT ALL PACKED UP
SA6 SFFLAG
*
CODRW9 BX6 X1
SA6 X7+VARBUF STORE IN NEXT LOC OF VARBUF
EQ CONDRAW2
*
LASTYPE BSS 1 -1=X OF FINE, 0=OK, 1=SKIP
TDRAW BSS 1 TEMP FOR DRAW COMMAND
VERTEX BSS 1 COUNT NUMBER OF VERTICES
SFFLAG BSS 1 FLAG FOR ALL PACKED UP
SKIP VFD 42/4LSKIP,1/1,17/0 -JUMP-TYPE GETVAR CODE
*
*
ENDOV
* /--- BLOCK PUT 00 000 76/07/25 08.08
TITLE PUT AND PUTD COMMANDS
PUTOV OVRLAY
*
SA1 OVARG1
SB3 X1
*
JP *+B3
*
+ EQ PUT
+ EQ PUTD
*
*********
*
* -PUT- (CODE=26)
*
*
PUT SA1 TAGCNT
ZR X1,ERR2FEW ERROR IF BLANK TAG
*
SB1 1
SX2 1R=
* ENTRY FOR PUT WITH DELIMITERS
PUTDENT SB2 B0 START SEARCH AT 2ND CHAR
VORN SB2 B2+B1
SA1 B2+TAG
ZR X1,ERRPUT WILL BE PUTS ON VARIABLES JUMP
IX3 X2-X1
NZ X3,VORN GO SEE IF EQUALS IS LATER
*
*
*
* B2=CHAR COUNTER
* B3=CHAR PER WORD COUNTER
* B7=XTRA STORAGE WORD COUNTER
*
* CONSTRUCT IN STRING
*
SA3 INX X3=XTRA STORAGE POINTER
BX6 X3
LX6 12 START COMMAND WORD WITH XTRA POINTER--INADD
LX2 54 LEFT JUSTIFY *=*
MX0 6
SB3 10 CHAR/WORD PRESET
SB2 B0
SB7 X3+INFO GET ABSOLUTE START OF XTRA STORAGE
SX3 B7 AND PUT IN X3
SB7 B0 SET OFFSET FROM HERE TO ZERO
SX7 B0 CLEAR X7
*
*
PEQLP SA1 B2+TAG LOAD CHAR
SB2 B2+B1
LX1 54 LEFT JUSTIFY
BX1 X1*X0 MAKE SURE THAT IS ONLY BITS
BX7 X1+X7 AND ADD TO EXISTING WORD
LX7 6 PUT IN RIGHT OF EXISTING WORD
SB3 B3-B1 CHAR/WORD DECREMENT
IX4 X2-X1
ZR X4,PEQJUS DONE IF *=* FOUND
NZ B3,PEQLP GO TILL WORD FULL
SA7 X3+B7 STORE FULL WORD
SB7 B7+B1
SB3 10 RESET CHAR/WORD
SX7 B0
EQ PEQLP GO DO NEXT WORD
*
*
PEQJUS ZR B3,PINLTH
LX7 6 LEFT JUSTIFY LAST WORD
SB3 B3-B1
EQ PEQJUS
PINLTH SX1 B7+B1
SA5 INX
IX1 X1+X5 POINTER TO OUTSTR IN 2ND BYTE
BX6 X6+X1 OF COMMAND WORD
LX6 12
* /--- BLOCK PUTD 00 000 76/07/25 08.27
SX1 B2-B1 X1=CHAR CNT-1 FOR *=*
BX6 X6+X1 3RD BYTE OF COMMAND WORD = INLTH
LX6 12
SA7 X3+B7 STORE LAST IN WORD
SB7 B7+B1
SB4 B2 SAVE INLTH+1 TO CALCULATE OUTLTH
SB3 10
SX7 B0
*
*
* CONSTRUCT OUT STRING
*
PUTSLP SA1 TAG+B2 LOAD CHAR
SB2 B2+B1
LX1 54
BX1 X1*X0 CLEAN EXTRANEOUS BITS
BX7 X1+X7
LX7 6
SB3 B3-B1
ZR X1,POUTJUS CHECK FOR ZERO TERMINATOR
NZ B3,PUTSLP LOOP IF WORD NOT FULL
SA7 X3+B7 STORE WORD
SX7 B0 CLEAR X7
SB7 B7+B1
SB3 10
EQ PUTSLP
*
*
POUTJUS ZR B3,POUTLTH
LX7 6
SB3 B3-B1
EQ POUTJUS
*
POUTLTH SA7 X3+B7 STORE LAST OUT WORD
SB7 B7+B1 SET INX TO POINT AT NEXT WORD
SA1 INX
SX2 B7
IX7 X1+X2
SA7 INX UPDATED INX STORED
SB2 B2-B1 SUTRACT ONE FOR TERMINATOR
SX1 B2-B4 OUTLTH TO X1
BX6 X6+X1 PUT OUTLTH IN COMMAND WORD
LX6 12
EQ PUTCODE GO TACK ON COMMAND CODE AND STORE
*
*****************
* -PUTD- COMMAND
*
* *PUTD*
PUTD SA1 TAGCNT
SB3 X1-4
NG B3,ERRPUT ERROR IF LESS THAN 4 CHARS IN TAG
SB3 X1-1
SB1 1 UNIVERSAL INCREMENT CONSTANT TO B1
*
SX6 PUT= *** NUMBER OF *PUT* COMMAND ***
SA6 COMNUM FAKE OUT PUTCODE
*
SA2 TAG LOAD FIRST DELIMITER
SA3 B3+TAG LOAD LAST DELIMITER
IX3 X2-X3
NZ X3,ERRPUT DELIMITER DISAGREEMENT ERROR
SX6 B0
SA6 A3 STORE FINAL ZERO OVER LAST DELIMITER
SB2 B1
*
PUTDLP SA1 B2+TAG LOAD CHAR
BX6 X1
SA6 A1-B1 AND STORE IT ONE BACK
SB2 B2+B1
NZ X6,PUTDLP
EQ PUTDENT DONE--FINAL ZERO FOUND
*
ERRPUT SB1 87
EQ =XERR
*
ENDOV
*
* /--- BLOCK COMMON 00 000 80/08/07 01.50
TITLE COMMON, STORAGE, ROUTVAR
*
*
COMMOV OVRLAY
SA1 OVARG1
SB3 X1
JP *+B3
*
+ EQ COMM -COMMON- (NON-EX)
+ EQ NONSYS -COMMONX-
+ EQ STOR -STORAGE-
+ EQ RVAR -ROUTVAR-
+ EQ SCOMX -SYSCOMX-
+ EQ LVAR -LVARS-
*
* /--- BLOCK COMMON 00 000 80/10/16 21.34
TITLE COMMON
*
* -COMMON- (NOT EXECUTEABLE)
*
* MAY HAVE ONE TO FIVE ARGUMENTS
*
* IF ONE ARGUMENT -
* SPECIAL COMMON IS SET UP - ECS RESIDENT ONLY
* ARGUMENT IS THE LENGTH
*
* IF MULTIPLE ARGUMENTS -
* 1ST ARGUMENT = ACCOUNT NAME
* 2ND ARGUMENT = LESSON NAME
* 3RD ARGUMENT = COMMON BLOCK NAME
* 4TH ARGUMENT = LENGTH OF COMMON
*
* LAST ARGUMENT MAY INDICATE SPECIAL OPTIONS
*
* SETS *CCOMACT* = ACCOUNT NAME
* *CCOMLES* = LESSON NAME
* *CCOMNAM* = COMMON NAME
* *CCOMLTH* = LENGTH OF COMMON
* *CCOMBIT* = SPECIAL OPTION BITS
*
COMM BSS 0
SA1 CCOMLES SEE IF ALREADY A COMMON
NZ X1,ERRCOMM ERROR IF SO
SA1 TAGCNT
ZR X1,ERR2FEW ERROR IF NO TAG
SA1 COMACNT
SX1 X1-2
NG X1,TEMPCOM
CALL ACCFILE,COMACT,-1 GET ACCOUNT;FILE
NZ X1,COMHAV JUMP IF LESSON SPECIFIED
SA1 ACCOUNT ACCOUNT OF THIS LESSON
SA2 LESSON NAME OF THIS LESSON
MX6 1
LX6 18 SET ORIGINAL FILE FLAG
BX6 X1+X6
BX7 X2
SA6 COMACT
SA7 COMLES
*
COMHAV BSS 0
RJ BLKNAM GET SECOND ARGUMENT
ZR X6,ERRNAME
SA6 COMNAM
RJ GETCLTH GET COMMON LENGTH
NZ X6,ERRNAME
BX7 X1
SX1 MAXCOM+1
IX1 X7-X1
NG X7,ERRNAME
ZR X7,ERRNAME
PL X1,ERRNAME
SA7 COMLTH
SA1 COMACNT
SX1 X1-3
NG X1,COMM3
EQ COMLAST PROCESS LAST ARGUMENT
* /--- BLOCK COMMON 00 000 80/08/16 18.25
*
TEMPCOM MX6 0 CLEAR 2ND WORD OF NAME
SA6 COMNAM
RJ GETCLTH GET LENGTH OF COMMON
NZ X6,ERRNAME
BX7 X1
SX1 TCLTH+1
IX1 X7-X1
NG X7,ERRNAME
ZR X7,ERRNAME
PL X1,ERRNAME
SA7 COMLTH
SA1 TMPCMNM LESSON NAME FOR TEMP COMMON
BX6 X1
SA6 COMLES
SA1 COMACNT
ZR X1,COMM3
*
COMLAST CALL NXTNAME GET OPTION NAME(S) ****
ZR X6,ERRNAME
SB1 B0
*
COMM1 SA1 B1+COMOLST LOAD NEXT OPTION NAME
ZR X1,ERRNAME
BX2 X6-X1 SEE IF NAMES MATCH
ZR X2,COMM2
SB1 B1+1
EQ COMM1 KEEP SEARCHING
*
COMM2 SA1 B1+COMBLST LOAD BIT PATTERN
SA2 COMBIT
BX6 X1+X2 MERGE COMMON OPTION BITS
SA6 A2
SA1 WORDPT
SA1 X1 LOAD ENDING CHARACTER
NZ X1,COMLAST
* TRANSFER ARGUMENTS TO GLOBAL VARIABLES
COMM3 SB1 1
SA1 COMACT
SA2 A1+B1 *COMLES*
BX6 X1
SA1 A2+B1 *COMNAM*
BX7 X2
SA6 CCOMACT
SA7 CCOMLES
SA2 A1+B1 *COMLTH*
BX6 X1
BX7 X2
SA1 A2+B1 *COMBIT*
SA6 CCOMNAM
SA7 CCOMLTH
BX6 X1
SA6 CCOMBIT
EQ NXTLINE
SPACE 3
* BLKNAM - GET BLOCK NAME FOR -COMMON-
BLKNXIT SX7 A1 UPDATE WORDPT
SA7 WORDPT
*
BLKNAM EQ *
SA1 WORDPT GET POINTER TO FIRST CHARACTER
*
BLKN100 SA2 X1 LOAD NEXT CHARACTER
SX0 X2-1R STRIP OFF LEADING SPACES
NZ X0,BLKN110
SX1 X1+1 ADVANCE CHARACTER POINTER
EQ BLKN100
*
* COLLECT CHARACTERS OF ALPHA LITERAL
*
BLKN110 SB1 60 INITIALIZE SHIFT
MX6 0 INITIALIZE WORD BUILDING
SA1 X1-1 INITIALIZE READ REGISTER
*
BLKN120 SA1 A1+1 LOAD NEXT CHARACTER
ZR X1,BLKNXIT IF END-OF-LINE
SA2 X1+KEYTYPE
SX0 X2-OPCOMMA CHECK IF COMMA
ZR X0,BLKN140
SB1 B1-6 DECREMENT SHIFT COUNT
PL B1,BLKN130
MX6 0 RETURN ZERO NAME FOR ERROR
EQ BLKNXIT
*
BLKN130 LX1 X1,B1 POSITION NEXT CHARACTER
BX6 X1+X6 MERGE WITH WORD BUILDING
EQ BLKN120
*
* /--- BLOCK COMMON 00 000 80/08/16 18.25
BLKN140 SX7 A1+1 UPDATE *WORDPT* FOR COMMA
SA7 WORDPT
EQ BLKNAM
* /--- BLOCK COMMON 00 000 80/08/07 01.54
SPACE 3
* GETCLTH - GET LENGTH FOR -COMMON-
*
GETCLTH EQ *
CALL COMPILE
BX5 X1 SAVE -GETVAR- CODE
MX6 0 SET NO ERROR
AX1 XCODEAL
MX0 -XCODEAL
ZR X1,GETCL1 JUMP IF SHORT LITERAL
SX2 X1-1
ZR X2,GETCL2 JUMP IF LONG INTEGER LITERAL
SX2 X1-9
ZR X2,GETCL3 JUMP IF FLOATING LITERAL
MX6 -1 ERROR RETURN
EQ GETCLTH
*
GETCL1 BX1 -X0*X5 MASK OFF SHORT LITERAL
EQ GETCLTH
*
GETCL2 BX1 -X0*X5
SA1 X1+INFO LOAD LONG LITERAL
EQ GETCLTH
*
GETCL3 BX1 -X0*X5
SA1 X1+INFO LOAD LONG LITERAL
SA2 HALF
PL X1,GETCL3A
BX2 -X2 SUB .5 IF ARGUMENT NEGATIVE
GETCL3A RX3 X1+X2
UX3 X3,B1 FIX THE ARGUMENT
LX3 X3,B1
MX6 0 ZERO FOR NO ERROR
IX1 X3+X6 CHANGE -0 TO +0
EQ GETCLTH
*
*
* THE ORDER OF THE FOLLOWING CELLS IS IMPORTANT
*
COMACT BSSZ 1
COMLES BSSZ 1
COMNAM BSSZ 1
COMLTH BSSZ 1
COMBIT BSSZ 1
*
*
COMOLST DATA 2LNL
DATA 2LRO
DATA 4LRONL
DATA 7LNO LOAD
DATA 9LREAD ONLY
DATA 0LCHECKPT
DATA 0
*
COMBLST VFD 12/4000B,48/0
+ VFD 12/2000B,48/0
+ VFD 12/6000B,48/0
+ VFD 12/4000B,48/0
+ VFD 12/2000B,48/0
+ VFD 12/1000B,48/0
*
*
HALF DATA .5
*
ERRCOMM SB1 86
EQ =XERR
*
* /--- BLOCK SYSCOMX 00 000 80/02/15 22.06
*
TITLE -SYSCOMX- COMMAND
* -SYSCOMX-
* EXECUTABLE -COMMON- COMMAND
*
SCOMX BSS 0
CALL SYSTEST SYSTEM LESSONS ONLY
SA1 TAGCNT
ZR X1,PAUSE2 SET SIGN BIT FOR BLANK TAG
SA1 CXDROP
CALL TAGXACT CHECK FOR ',DROP', TAG
NG X1,TWOBITS IF DROP, GO SET TOP 2 BITS
*
CALL FILEBLK GET ACCOUNT';FILE, BLOCK
*
SA1 LASTKEY CHECK FOR END-OF-LINE
ZR X1,COMX05
CALL COMPILE GET THIRD ARGUMENT (LENGTH)
*
COMX05 BX6 X1
SA6 VARBUF+4
SA1 LASTKEY CHECK FOR END-OF-LINE
ZR X1,COMX06
CALL COMPILE GET 4TH ARGUMENT (FILE TYPE)
COMX06 BX6 X1
SA6 VARBUF+5
SX6 5 5 ARGUMENTS IN BUFFER
SA6 VARBUF
SA1 LASTKEY MAKE SURE NO MORE ARGUMENTS
NZ X1,ERR2MNY
BX1 X6 5 ARGUMENTS LEGAL FOR VARFIN
EQ VARFIN -- EXIT TO PACK UP AND STORE
*
CXDROP DATA 4LDROP
*
* /--- BLOCK COMMONX 00 000 80/02/15 22.06
*
TITLE -COMMONX- CONDENSE ROUTINE
*
* ALLOWABLE FORMS ARE';
*
* COMMONX (BLANK TAG)
* COMMONX ACCOUNT';LESSON,BLOCK,LENGTH
* COMMONX ,BLOCK,LENGTH (THIS LESSON)
*
* NOTE--LENGTH ARGUMENT IS OPTIONAL.
*
NONSYS SX6 -1
SA6 CCOMX MARK COMMONX ENCOUNTERED
*
CALL FILEBLK GET ACCOUNT';FILE, BLOCK
ZR X1,PAUSE2 JUMP IF BLANK TAG
*
*
SA1 LASTKEY CHECK FOR END-OF-LINE
ZR X1,NS350 JUMP IF E-O-L
SA1 WORDPT X1 = POINTER TO NEXT CHARACTER
SA2 X1 GET NEXT CHARACTER
SX2 X2-1R, CHECK FOR COMMA
NZ X2,NS360 JUMP IF 3RD ARGUMENT NON-BLANK
SX6 X1+1 ADVANCE WORDPT
SA6 A1
*
NS350 MX6 0 SET LENGTH ARGUMENT 0
EQ NS400
*
NS360 CALL COMPILE GET THIRD ARGUMENT (LENGTH)
BX6 X1
* /--- BLOCK COMMONX 00 000 80/02/15 22.06
*
NS400 SA6 VARBUF+4
MX6 0 FAKE UP 5TH ARG (FILE TYPE)
SA6 VARBUF+5
SA1 LASTKEY SEE IF MORE ARGUMENTS
ZR X1,NS500 BLANK CODEWORD
*
SA1 WORDPT NEXT CHAR POINTER
SA2 X1 GET CHARACTER
SA2 X2+KEYTYPE CHECK FOR COMMA - NO CODE
SX0 X2-OPCOMMA
NZ X0,NS450 CODEWORD INCLUDED
SX6 X1+1 INCREMENT WORDPT
SA6 A1
MX1 0 PUT 0 FOR CODEWORD
EQ NS500
*
NS450 CALL COMPNAM GET CODEWORD
NS500 BX6 X1
SA6 VARBUF+6 STORE CODEWORD
*
*
* NOW SET OPTION BITS FOR READ ONLY, NO LOAD
*
MX7 0 CLEAR OPTION BITS
SA7 COMOPT
*
NS590 CALL NXTNAME GET OPTION NAME
ZR X6,NSFIN NO OPTIONS SPECIFIED
*
SB1 0
NS600 SA1 COMOLST+B1
ZR X1,ERRNAME NOT ON LIST
BX2 X6-X1 LOOK FOR MATCH
ZR X2,NS610 FOUND MATCH
SB1 B1+1
EQ NS600 KEEP LOOKING
*
NS610 SA1 COMOPT GET CURRENT OPTION BITS
SA2 B1+COMBLST GET NEW OPTION BITS
BX6 X2+X1 MERGE
SA6 A1 STORE
EQ NS590 SEE IF MORE OPTIONS
*
NSFIN SA1 COMOPT GET OPTION BITS
BX6 X1
LX6 12 SHIFT TO LOWER BITS
SA6 VARBUF+7 STORE BITS
SX6 7 SPECIFY 7 ARGUMENTS
SA6 VARBUF
BX1 X6 7 ARGUMENTS LEGAL FOR VARFIN
EQ VARFIN GO PACK UP AND STORE
*
COMOPT BSS 1 COMMON OPTION BITS
*
* /--- BLOCK LVARS 00 000 80/05/20 11.15
*
*
*
* -LVARS-
*
* SPECIFY NUMBER OF WORDS IN LOCAL VAR STACK
*
LVAR BSS 0
SA1 LVARL ONLY ONE -LVARS- COMMAND
NG X1,LVARERR -LVAR- ILLEGAL HERE
*
NZ X1,ERRCOMM
*
CALL GETCLTH
NG X6,ERRCOMM EXIT IF NOT LITERAL
*
NG X1,ERRCOMM OR 0 OR -
*
ZR X1,ERRCOMM
* GET MAXIMUM NUMBER OF LOCAL VARIABLES.
SX6 X1-LVMAX-1
PL X6,ERRCOMM
*
BX6 X1
SA6 LVARL SAVE SIZE OF LOCALS STACK
EQ NXTLINE
*
LVARERR SB1 774 ILLEGAL -LVAR-
EQ =XERR
* /--- BLOCK ++STORAGE 00 000 80/05/20 23.53
*
*
*
* -STORAGE- (CODE=128)
*
* SYSTEM LESSON EXECUTABLE COMMAND FORMAT --
*
* STORAGE (AMOUNT)
*
* USER LESSON COMMAND FORMAT, WHICH SETS INFO
* IN LESSON HEADER --
*
* STORAGE (AMOUNT)
* STORAGE (AMOUNT),EXACTLY
* STORAGE (AMOUNT),MINIMUM
*
*
STOR SA1 SYSFLG SEE IF SYSTEM LESSON
LX1 ZSLDSHF
NG X1,SYSONE IF YES
SA1 XSTORL
NZ X1,ERRCOMM ONE -STORAGE- PER LESSON
RJ GETCLTH GET LENGTH OF STORAGE
NZ X6,ERRCOMM IF NOT LITERAL
NG X1,ERRCOMM IF -
ZR X1,ERRCOMM IF 0
SX2 MAXSTO MAXIMUM STORAGE SIZE
IX2 X2-X1
NG X2,ERRCOMM IF TOO BIG
BX7 X1
SA7 XSTOTMP SAVE TEMPORARILY
SA1 LASTKEY SEE IF ADDITIONAL TAG
ZR X1,STOSET -- EXIT IF E-O-L (X7 = LENGTH)
SX1 X1-1R,
NZ X1,ERRCOMM -- ERROR IF NOT A COMMA
CALL NXTNAME GET TAG
ZR X6,ERRCOMM -- ERROR IF NOTHING THERE
SX7 4 ASSUME -EXACTLY- TAG
SA1 TCEXACT
BX1 X1-X6
ZR X1,STOGO
SA1 TCMIN OR MAYBE -MINIMUM-
BX1 X1-X6
NZ X1,ERRCOMM -- ERROR IF FUNNY TAG
SX7 2
STOGO LX7 SEXACTF-2 MOVE OPTION BITS TO LSTOUSE LOC
SA1 XSTOTMP
BX7 X1+X7 X7 = LENGTH PLUS OPTION BITS
*
* SAVE RESULTS -- X7 = LENGTH + OPTION BITS, AS
* WILL BE -OR-ED INTO *LSTOUSE*
*
STOSET SA7 XSTORL SAVE STORAGE LENGTH / FLAGS
EQ NXTLINE
*
TCEXACT DATA 7LEXACTLY
TCMIN DATA 7LMINIMUM
XSTOTMP BSS 1 SAVED STORAGE LENGTH
*
* /--- BLOCK ROUTVAR 00 000 76/07/25 08.34
*
*
*
* -ROUTVAR- COMMAND
* SPECIFIES NUMBER OF ROUTER VARIABLES (NR1-NR(N))
*
*
RVAR SA1 ROUTER SEE IF -ROUTER- LESSON
ZR X1,ERROUTR
SA1 RVARL ONLY ONE -ROUTVAR- COMMAND
NZ X1,ERRCOMM
CALL GETCLTH
NG X6,ERRCOMM EXIT IF NOT LITERAL
NG X1,ERRCOMM OR 0 OR -
ZR X1,ERRCOMM
SX6 RVARLIM+1
IX6 X1-X6 SEE IF TOO MANY VARIABLES
PL X6,ERRCOMM
BX6 X1
SA6 RVARL SAVE NUMBER OF ROUTER VARIABLES
EQ NXTLINE
*
ENDOV
* /--- BLOCK SORT 00 000 76/08/16 22.33
TITLE -SORT- / -SORTA- COMMAND READ-INS
*
*
*
* SORT LIST,LENGTH,INCREMENT,1ST BIT,NUM BITS,MASK
* LIST,INCREMENT
*
* SORTA LIST,LENGTH,INC,1ST CHAR,NUM CHARS,MASK
* LIST,INCREMENT
*
* MASK IS OPTIONAL. 'NOTE THAT MASK IS PUT IN THIRD WORD
* OF GVAR CODES, OUT OF ORDER.
*
*
SORTOV OVRLAY
SA1 WORDPT SAVE *WORDPT*
BX6 X1
SA6 OLDPT
MX6 0 PRE-SET ASSOCIATED LIST FLAG
SA6 SASSOC
SA6 SORTMSK SORT MASK
SA6 VARBUF+5
SA6 VARBUF+6
*
* EVALUATE LIST TYPE / LOCATION
*
CALL NXTNAM GET FIRST ENTRY
SX0 X1-1R,
NZ X0,SORT150 JUMP IF MAY BE CM BUFFER
MX0 42
SA1 SORTLST-1 SET UP FOR BUFFER TYPE SEARCH
*
SORT110 SA1 A1+1 LOAD NEXT LIST ENTRY
ZR X1,SORT150 CHECK IF CM BUFFER
BX2 X0*X1 MASK OFF BUFFER TYPE NAME
IX2 X2-X6
NZ X2,SORT110
SX6 X1 PICK UP BUFFER TYPE CODE
LX6 60-6
SA6 SORTWK
CALL COMPILE EVALUATE POSITION EXPRESSION
LX1 60-6-XCODEL POSITION -GETVAR- CODE
SA2 SORTWK
BX6 X1+X2 MERGE TYPE/POSITION
SA6 A2
SA1 LASTKEY MUST END WITH A SEMI-COLON
SX0 X1-KSEMIC
ZR X0,SORT200
EQ ERRORC
*
* /--- BLOCK SORT 00 000 76/08/16 22.56
*
SORT150 SA1 OLDPT RESTORE *WORDPT*
BX6 X1
SA6 WORDPT
CALL COMPILE EVALUATE BUFFER EXPRESSION
NZ B1,ERRSTOR ERROR IF NOT STOREABLE
BX6 X1
LX6 60-6-XCODEL POSITION -GETVAR- CODE
SA6 SORTWK
SA1 LASTKEY MUST END WITH A SEMI-COLON
SX0 X1-KSEMIC
NZ X0,ERRTERM
*
* PROCESS REMAINING ARGUMENTS
*
SORT200 CALL VARDO EVALUATE ARGUMENTS
SA1 VARBUF
SX1 X1-4 MUST BE 4 OR 5 TAGS
NG X1,ERR2FEW NOT ENOUGH TAGS
ZR X1,SORT210 EXACTLY 4 TAGS
*
SX1 X1-1
NZ X1,ERR2MNY TOO MANY TAGS
*
* PROCESS MASK GETVAR CODE
*
SA1 VARBUF+5
MX0 -XCODEL
BX6 -X0*X1 MASK OFF GETVAR CODE
ZR X6,ERRORC ERROR IF MASK IS ZERO ('.)
LX6 60-XCODEL LEFT JUST GVAR CODE
SA6 SORTMSK AND STORE IT
*
SX6 4
SA6 VARBUF THEN RESET VARBUF COUNTER
*
*
* CHECK IF COMMAND CONTINUED
*
SORT210 SA1 NEXTCOM
SA2 COMCONT SEE IF CONTINUED
BX2 X1-X2
NZ X2,SORT300
CALL GETLINE GET NEXT LINE OF TEXT
SA1 NEXTCOM
SA2 COMCONT SEE IF CONTINUED
BX2 X1-X2
ZR X2,ERRCNTD ERROR IF CONTINUED FURTHER
*
* PROCESS ASSOCIATED LIST TYPE / LOCATION
*
SA1 WORDPT SAVE *WORDPT*
BX6 X1
SA6 OLDPT
CALL NXTNAM GET FIRST ENTRY
SX0 X1-1R,
NZ X0,SORT250 JUMP IF MAY BE CM BUFFER
MX0 42
SA1 SORTLST-1 SET UP FOR BUFFER TYPE SEARCH
*
SORT220 SA1 A1+1 LOAD NEXT LIST ENTRY
ZR X1,SORT250 CHECK IF CM BUFFER
BX2 X0*X1 MASK OFF BUFFER TYPE NAME
IX2 X2-X6
NZ X2,SORT220
SX6 X1+40B PICK UP BUFFER TYPE CODE
SA6 SASSOC
CALL VARDO2 EVALUATE LOCATION ARGUMENT
EQ SORT260
*
* /--- BLOCK SORT 00 000 76/07/25 08.42
*
SORT250 SA1 OLDPT RESTORE *WORDPT*
BX6 X1
SA6 WORDPT
SX6 40B SET BUFFER TYPE CODE
SA6 SASSOC
CALL VARDO2 EVALUATE BUFFER EXPRESSION
SA1 VARBUF
SA1 X1+VARBUF LOAD BUFFER -GETVAR- CODE
NG X1,ERRSTOR MUST BE STORE-ABLE
*
SORT260 SA1 LASTKEY MUST END WITH A SEMI-COLON
SX0 X1-KSEMIC
NZ X0,ERRTERM
*
* EVALUATE ENTRY DIMENSION EXPRESSION
*
CALL VARDO2 EVALUATE DIMENSION EXPRESSION
SA1 LASTKEY
NZ X1,ERRTERM ERROR IF NOT END-OF-LINE
SA1 SORTWK
SA2 SASSOC ATTACH ASSOC BUFFER TYPE TO
LX2 XCMNDL COMMAND WORD
BX6 X1+X2
SA6 A1
*
* ATTACH INDEX IN XSTOR TO COMMAND WORD
*
SORT300 SA1 INX GET INDEX IN EXTRA STORAGE
BX6 X1
LX6 60-6-XCODEL-12 POSITION XSTOR INDEX
SA2 SORTWK
BX6 X2+X6 X6 = PARTIAL COMMAND WORD
*
* /--- BLOCK SORT 00 000 76/08/18 16.00
*
* PACK UP REMAINING -GETVAR- CODES
*
MX0 -XCODEL
SA2 VARBUF+1 LOAD LENGTH -GETVAR- CODE
SA3 VARBUF+2 LOAD INCREMENT -GETVAR- CODE
SA4 VARBUF+3 LOAD IST CHAR -GETVAR- CODE
BX2 -X0*X2
BX3 -X0*X3
BX4 -X0*X4
LX2 60-XCODEL POSITION -GETVAR- CODES
LX3 60-2*XCODEL
LX4 60-3*XCODEL
BX7 X2+X3 COMBINE -GETVAR- CODES
BX7 X4+X7
SA7 X1+INFO STORE 1ST XSTOR WORD
SA2 VARBUF+4 LOAD NUM CHARS -GETVAR- CODE
SA3 VARBUF+5 LOAD ASSOC BUFF -GETVAR- CODE
SA4 VARBUF+6 LOAD INCREMENT -GETVAR- CODE
BX2 -X0*X2
BX3 -X0*X3
BX4 -X0*X4
LX2 60-XCODEL POSITION -GETVAR- CODES
LX3 60-2*XCODEL
LX4 60-3*XCODEL
BX7 X2+X3 COMBINE -GETVAR- CODES
BX7 X4+X7
SA7 X1+INFO+1 STORE 2ND XSTOR WORD
*
SA2 SORTMSK GET MASK GETVAR CODE
BX7 X2
SA7 X1+INFO+2 AND STORE IT
*
SX7 X1+3
SA7 INX INCREMENT *INX*
SA1 ICX
IX1 X7-X1 CHECK FOR UNIT BUFFER OVERFLOW
PL X1,LNGUNIT
EQ PUTCODE EXIT
*
*
SORTLST VFD 42/0LSTORAGE,18/2
+ VFD 42/0LS,18/2
+ VFD 42/0LCOMMON,18/1
+ VFD 42/0LC,18/1
DATA 0
*
SORTWK BSS 1
SORTMSK BSS 1
SASSOC BSS 1
*
ENDOV
*
*
* /--- BLOCK TALKREQ 00 000 81/03/23 00.29
TITLE -TALKREQ- READIN
*
** -TALKREQ- (CODE=374)
*
* HANDLE TERM-TALK AND OTHER OUTPUT MASTER-SLAVE
* REQUESTS, USING PROCESS INTERLOCK *I.TALK* AND
* STATUS BUFFER *ATALK*
*
* TALKREQ [KEYWORD] $$ OWN STATN ACTION
* TALKREQ [KEYWORD],STATN $$ OTHER STATN ACTION
* TALKREQ STATUS,STATN,RETRN $$ OTHER STATN STATUS
*
* CERTAIN REQUESTS CAN ONLY BE PERFORMED ON YOUR
* OWN STATION; OTHERS CAN BE DONE TO ANY STATION;
* AND -STATUS- RETURNS THE STATUS TO A SPECIFIED
* VARIABLE.
*
* COMMAND WORD FORMAT --
* 20 / GETVAR CODE FOR STATN
* 20 / GETVAR CODE FOR BUFFER
* 11 / REQUEST TYPE
* 9 / -TALKREQ- COMMAND
*
*
TRQCOV OVRLAY
CALL SYSTEST SYSTEM LESSONS ONLY
*
* GET REQUEST TYPE KEYWORD
*
CALL NXTNAME
MX0 42 LIMIT TO 7 CHARACTERS
BX1 -X0*X6
NZ X1,ERRTAGS
*
* SEARCH FOR KEYWORD IN TABLE
*
SA1 TRQNAMS
TRQLP BX2 X0*X1 X2 = POSSIBLE KEYWORD
BX2 X2-X6 COMPARE
ZR X2,TRQFND -- FOUND IT
SA1 A1+1 GET NEXT KEYWORD
NZ X1,TRQLP AND LOOP UNTIL WE RUN OUT
EQ ERRTAGS -- ERROR EXIT IF NOT FOUND
*
* SAVE KEYWORD ORDINAL IN COMMAND WORD, AND
* CHECK FOR REQUIRED ARGUMENTS
*
TRQFND SX6 A1-TRQNAMS
LX6 XCMNDL PUT IN INFO POINTER FIELD
BX7 -X0*X1 ISOLATE KEYWORD TYPE (0,1,2)
ZR X7,TRQFIN TYPE 0 = KEYWORD ONLY
SA7 TRQATYP SAVE TYPE
SA6 TRQCMND SAVE BUILDING COMMAND
SA1 WORDPT CHECK FOR TAG PRESENT
SA1 X1
ZR X1,ERR2FEW -- IF NOT ENOUGH TAGS
* /--- BLOCK TALKREQ 00 000 81/04/19 16.56
*
* GET SECOND ARGUMENT (TARGET STATION)
*
CALL COMPILE
LX1 -XCODEL ALIGN AS TOP GETVAR CODE
SA2 TRQCMND
BX6 X1+X2 ADD IN TO COMMAND WORD
SA1 TRQATYP
SX1 X1-1 CHECK FOR TYPE 1 KEYWORD
ZR X1,TRQFIN -- DONE IF TYPE 1
SA6 TRQCMND SAVE BUILDING COMMAND
*
* GET THIRD ARGUMENT (WHERE APPLICABLE)
*
CALL COMPILE
NZ B1,ERRSTOR ARGUMENT MUST BE STOREABLE
LX1 60-XCODEL-XCODEL ALIGN AS 2ND GETVAR CODE
SA2 TRQCMND
BX6 X1+X2 ADD INTO COMMAND WORD
*
* COMPLETE -TALKREQ- READIN -- MAKE SURE NOTHING
* LEFT IN TAG. X6 = FINAL COMMAND WORD
*
TRQFIN SA1 WORDPT
SA1 X1 X1 = NEXT CHARACTER
NZ X1,ERR2MNY -- ERROR IF MORE IN TAG
EQ PUTCODE GO STORE COMMAND WORD
*
* KEYWORD TABLE
*
* EACH ENTRY IS OF THE FORM
*
* 42/KEYWORD
* 18/TYPE -- 0 = KEYWORD ONLY
* 1 = KEYWORD,STATN
* 2 = KEYWORD,STATN,BUFFER
*
* NOTE -- THIS TABLE MUST MATCH CORRESPONDING
* ==== EXECUTION-TIME TABLE IN -EXEC6-
*
TRQNAMS VFD 42/0LREQUEST,18/1 0
VFD 42/0LCANCEL,18/0 1
VFD 42/0LANSWER,18/0 2
VFD 42/0LSETSLIB,18/0 3
VFD 42/0LMONITOR,18/1 4
VFD 42/0LMASTER,18/1 5
VFD 42/0LTLK2MON,18/0 6
VFD 42/0LMON2TLK,18/0 7
VFD 42/0LSTATUS,18/1 8
VFD 42/0LJOIN,18/1 9
VFD 42/0LCONFER,18/1 10
VFD 42/0LPAGE,18/1 11
VFD 42/0LUNPAGE,18/1 12
VFD 42/0LPASS,18/1 13
DATA 0
*
* STORAGE
*
TRQCMND DATA 0 COMMAND WORD BEING BUILT
TRQATYP DATA 0 KEYWORD TYPE
ENDOV
* /--- BLOCK END 00 000 77/07/30 01.33
*
TITLE FONT COMMAND
*
FONTCOV OVRLAY
*
MX6 0 PRE-CLEAR
SA6 VARBUF+1
SA6 VARBUF+2
SA6 VARBUF+3
SX6 3 NUMBER OF ARGUMENTS FOR FONT
SA6 VARBUF
CALL NXTNAM GET FONT NAME
ZR X6,ERR2FEW IF NO TAGS, TOO FEW
MX0 8*6 FONT NAME CANNOT EXCEED 8 CHARS
BX0 -X0*X6
NZ X0,ERRNAME
SA2 FONTNAM FIRST TERM TO CHECK
SB3 NFONTS NUMBER OF FONTS TO CHECK
FONTLP1 BX2 X2-X6
ZR X2,FONTOK IF EQUAL TO FONT NAME, OK
SB3 B3-1 DECREMENT CHECK
ZR B3,ERRNAME IF NOT VALID NAME, ERROR OUT
SA2 A2+1 GET NEXT TERM
EQ FONTLP1 GO CHECK AGAIN
FONTOK SX6 B3 GET FONT SLOT NUMBER
SA6 VARBUF+1 SAVE FONT SLOT NUMBER
ZR X1,FONTDEF IF NO SEPARATOR, DEFAULT
CALL COMPILE GET NEXT ARGUMENT
BX6 X1 SAVE -GETVAR- CODE
SA6 VARBUF+2
SA2 LASTKEY SEE IF END-OF-LINE
ZR X2,FONTREG IF ONLY TWO PARAMS, DEFAULT
SX6 NMODES MAX EXTRA ARGS
SA6 FARGMAX SAVE MAX ARGS
FONTLP2 CALL NXTNAM GET LITERAL TAG IN X6
ZR X6,FONTGO IF END OF ARGS, GO STORE
BX0 X6 SAVE NAME IN *X0*
SA2 FARGMAX GET REMAINING ARG COUNT
SX6 X2-1 SUBTRACT ONE
SA6 A2 REPLACE IT
NG X6,ERR2MNY TOO MANY ARGUMENTS
SX1 1 SET BIT 0
SA2 FONTMOD FIRST MODE TO CHECK
SB3 NMODES NUMBER OF MODES TO CHECK
FONTLP3 BX2 X2-X0
ZR X2,FONTOK2 IF EQUAL TO FONT MODE, OK
SB3 B3-1 DECREMENT CHECK
ZR B3,ERRNAME IF NOT VALID NAME, ERROR OUT
SA2 A2+1 GET NEXT TERM
LX1 1 POSITION TO NEXT BIT
EQ FONTLP3 GO CHECK AGAIN
FONTOK2 SA2 VARBUF+3 GET CURRENT MODE WORD
BX0 X1*X2 SEE IF BIT ALREADY SET
NZ X0,ERR2MNY DUPLICATE TAG
BX6 X2+X1 SET BIT
SA6 A2 SAVE NEW SETTING
EQ FONTLP2
* /--- BLOCK FONT 00 000 79/07/19 23.36
FONTDEF SX6 0 DEFAULT FONT SIZE
SA6 VARBUF+2
FONTREG SX6 0 DEFAULT FONT MODE
SA6 VARBUF+3
FONTGO BSS 0
SA1 VARBUF GET NUMBER OF ARGS FOR -VARFIN-
EQ VARFIN GO PACK AND STORE ARGS
NFONTS EQU 19 NUMBER OF FONT SLOTS
FONTNAM BSS 0
DATA 0LMSSANS FONT 19
DATA 0LSCRIPT FONT 18
DATA 0LNTROMAN FONT 17
DATA 0LARIAL FONT 16
CON 0 FONT 15
CON 0 FONT 14
CON 0 FONT 13
CON 0 FONT 12
CON 0 FONT 11
CON 0 FONT 10
CON 0 FONT 9
CON 0 FONT 8
CON 0 FONT 7
DATA 0LCOURNEW FONT 6
DATA 0LCOURIER FONT 5
DATA 0LUOL816 FONT 4
DATA 0LUOL814 FONT 3
DATA 0LTERMINAL FONT 2
DATA 0LDEFAULT FONT 1
*
NMODES EQU 4
FONTMOD BSS 0
DATA 6LITALIC
DATA 4LBOLD
DATA 6LSTRIKE
DATA 7LUNDERLN
*
FARGMAX BSS 1 MAXIMUM ARGUMENT COUNT
*
ENDOV
* /--- BLOCK END 00 000 77/07/30 01.33
*
*
OVTABLE
*
*
END COVLY2$