COVLAY1
* /--- FILE TYPE = E
* /--- BLOCK IDENT 00 000 81/07/13 01.10
IDENT COVLAY1
LCC OVERLAY(1,1)
*
TITLE OVERLAYS FOR COMMAND READINS
*
*
CST
*
*
COVLY1$ OVFILE
*
*
EXT ECSPRTY,PUTCODE,ERRORC
EXT COMCONT,VARFIN,NXTLINE
EXT NKLEND,NKLIST,KEYTYPE
EXT CONDENS
EXT LNGUNIT
EXT ERRTAGS,ERRNAME,ERRSTOR
EXT ERR2MNY,ERR2FEW,ERRBAL
EXT ERRTERM,ERRUARG,ERRVTYP
*
* FOLLOWING FOR PACK
EXT VARDO1
*
* FOLLOWING FOR JUMPOUT,FROM
EXT COMPNAM,GETARGS,ENDPNT,UNITFLG
*
* FOLLOWING FOR DATA COMMANDS
EXT NXTNAM,GETLINE,DATAON=
EXT CALCODE,VARDO2,MRKLAST
EXT VARDO
*
*
* /--- BLOCK ENABLE 00 000 75/11/08 13.08
TITLE -ENABLE/DISABLE-
*
EXT SCANNER
*
ENABOV OVRLAY
SB1 ENTYPES START TABLE
SB2 ENEND END TABLE
MX5 60 FULL WORD MASK
RJ SCANNER
NZ X0,ERRNAME
ZR X6,=XERROBS --- IF -ENABLE (BLANK)-
EQ PUTCODE
*
*
ENTYPES VFD 60/8LORIENTAL
VFD 60/5LTOUCH
VFD 60/3LEXT
VFD 60/6LEXTMAP
VFD 60/6LSTREAM
ENEND BSS 1 HOLE FOR WORD CURRENTLY PROCESSING
*
ENDOV
* /--- BLOCK PAUSOV 00 000 76/01/26 22.16
TITLE GROUP/PAUSE/KEYTYPE COMMAND READ-INS
*
*
PAUSOV OVRLAY
SA1 OVARG1
ZR X1,PAUSEIN IF 0 THIS IS PAUSE COMMAND
SX2 X1-1
ZR X2,GROUPIN IF 1 THIS IS GROUP COMMAND
EQ KEYTYIN OTHERWISE KEYTYPE COMMAND
*
*
*
*
* /--- BLOCK TABLES 00 000 75/10/14 10.44
TITLE SYSTEM DEFINED GROUPS
*
*
* LOW 3 BITS OF LAST WORD ARE SPECIAL FLAGS -
*
* 3RD BIT = SET ONLY FOR KEYS=ALL
* 2ND = TOUCH
* 1ST = EXT
*
*
PURGMAC BITS
BITS MACRO A,B,C,D,E,F,G,H,I,J
VFD 1/A,1/B,1/C,1/D,1/E,1/F,1/G,1/H,1/I,1/J
ENDM
*
*
LIST G
*
G.ALPHA BITS 0,1,1,1,1,1,1,1,1,1 0-11
BITS 1,1,1,1,1,1,1,1,1,1 12-23
BITS 1,1,1,1,1,1,1,0,0,0 24-35
BITS 0,0,0,0,0,0,0,0,0,0 36-47
BITS 0,0,0,0,0,0,0,0,0,0 50-61
BITS 0,0,0,0,0,0,0,0,0,0 62-73
BITS 0,0,0,0,0,1,1,1,1,1 74-105
BITS 1,1,1,1,1,1,1,1,1,1 106-117
BITS 1,1,1,1,1,1,1,1,1,1 120-131
BITS 1,0,0,0,0,0,0,0,0,0 132-143
BITS 0,0,0,0,0,0,0,0,0,0 144-155
BITS 0,0,0,0,0,0,0,0,0,0 156-167
BSSZ 2
*
*
G.NUMER BITS 0,0,0,0,0,0,0,0,0,0 0-11
BITS 0,0,0,0,0,0,0,0,0,0 12-23
BITS 0,0,0,0,0,0,0,1,1,1 24-35
BITS 1,1,1,1,1,1,1,0,0,0 36-47
BITS 0,0,0,0,0,0,0,0,0,0 50-61
BITS 0,0,0,0,0,0,0,0,0,0 62-73
BSSZ 3
*
*
G.FUNCT BSSZ 2
BITS 0,0,0,0,0,0,0,0,1,1 170-201
BITS 1,1,1,1,1,1,1,1,1,1 202-213
BITS 1,1,1,1,1,1,1,1,1,1 214-225
BITS 1,1,1,1,1,1,1,1,1,1 226-237
BITS 1,1,1,1,1,1,1,1,1,1 240-251
BITS 1,1,1,1,1,1,1,1,1,0 252-263
BSSZ 1
*
* /--- BLOCK TABLES 00 000 75/10/14 10.45
*
G.EXT BSSZ 3
BITS 0,0,0,0,0,0,0,0,0,0 170-201
BITS 0,0,0,0,0,0,0,0,0,0 202-213
BITS 0,0,0,0,0,0,0,0,0,0 214-225
BITS 0,0,0,0,0,0,0,0,0,0 226-237
BITS 0,0,0,0,0,0,0,0,0,0 240-251
BITS 0,0,0,0,0,0,0,0,0,1 252-263
*
*
G.TOUCH BSSZ 3
BITS 0,0,0,0,0,0,0,0,0,0 170-201
BITS 0,0,0,0,0,0,0,0,0,0 202-213
BITS 0,0,0,0,0,0,0,0,0,0 214-225
BITS 0,0,0,0,0,0,0,0,0,0 226-237
BITS 0,0,0,0,0,0,0,0,0,0 240-251
BITS 0,0,0,0,0,0,0,0,1,0 252-263
*
*
G.ALL DATA -0,-0,-0,-0 ALL BITS SET
*
G.KEYSET DATA -0,-0,-0,-7 ALL KEYS EXCEPT FOR TOUCH/EXT
*
LIST *
*
*
GROUPS VFD 42/5LALPHA,18/G.ALPHA
+ VFD 42/7LNUMERIC,18/G.NUMER
+ VFD 42/5LFUNCT,18/G.FUNCT
+ VFD 42/3LEXT,18/G.EXT
+ VFD 42/5LTOUCH,18/G.TOUCH
+ VFD 42/3LALL,18/G.ALL
+ VFD 42/6LKEYSET,18/G.KEYSET
GEND DATA 0
*
*
* GRPDIM EQU 3
GRPDIM EQU 4
*
GROUP EQU WORK+1 GROUP BIT TABLE
GROUP1 EQU GROUP+GRPDIM GROUP BIT TABLE
GROUPS1 EQU GROUP1+GRPDIM GROUP NAME TABLE
GEND1 EQU GROUPS1+NKGROUP
*
*
* /--- BLOCK KEYLIST 00 000 78/12/13 01.48
TITLE -KEYLIST- COMMAND READIN
*
*
*
* -KEYLIST- COMMAND
* KEYLIST NAME,LIST OF KEYS
*
*
GROUPIN CALL LOADG LOAD -KEYLIST- NAME TABLE
*
* GET GROUP NAME AND CHECK IF LEGAL
*
CALL NXTNAME GET GROUP NAME ****
ZR X6,ERRNAME
SX1 X1-1R, CHECK DELIMITER
NZ X1,ERRTERM --- IF BAD DELIMITER
GRP1 MX0 -18 FORM MASK FOR 7 CHARACTERS
BX1 -X0*X6
NZ X1,ERRNAME LIMIT NAME TO 7 CHARACTERS
MX2 6
BX1 X2*X6 CHECK NAME AT LEAST TWO CHARS
LX1 6
SX1 X1-KUP CHECK IF FIRST CHAR IS SHIFT
+ NZ X1,*+1
AX2 6 EXTEND MASK
+ BX1 -X2*X6
ZR X1,ERRNAME ERROR IF NAME TOO SHORT
SA6 GNAME
*
* CHECK FOR DUPLICATE GROUP NAME
*
SA1 GROUPS1-1 INITIALIZE FOR SEARCH
MX7 0 INITIALIZE GROUP INDEX
*
GR20 SA1 A1+1 LOAD NEXT GROUP NAME
ZR X1,GR30
SX7 X7+1 ADVANCE GROUP INDEX
BX1 X1-X6 CHECK IF NAMES MATCH
NZ X1,GR20
EQ ERRNAME ERROR IF GROUP ALREADY EXISTS
*
* INITIALIZE FOR NEW GROUP
*
GR30 SX1 X7-NKGROUP CHECK FOR OVERFLOW
PL X1,ERR2MNY
SA7 GINDX SAVE INDEX TO GROUP
SB1 GRPDIM-1
MX7 0
*
GR35 SA7 B1+GROUP1 INITIALIZE GROUP BIT TABLE
SB1 B1-1
PL B1,GR35
*
* /--- BLOCK KEYLIST 00 000 81/01/07 19.36
*
* BUILD GROUP BIT TABLE
*
GR100 CALL NXT GET NEXT ENTRY
SB1 X1
JP B1+*+1
*
+ EQ GR900 END-OF-LINE
+ EQ GR200 KEY VALUE
+ EQ GR300 GROUP
+ EQ ERRGRUP SPECIFIC TOUCH
+ EQ ERRGRUP SPECIFIC EXT
+ EQ ERRGRUP EXPRESSION
*
*
* SET BIT IN GROUP TABLE FOR SPECIFIED KEY
*
GR200 SX1 X6 X1 = KEY VALUE
NG X1,ERRGRUP CHECK IF LEGAL KEY CODE
ZR X1,ERRGRUP
SX0 X1-60*GRPDIM
PL X0,ERRGRUP
CALL SSETBIT,GROUP1 SET BIT IN GROUP TABLE
EQ GR100
*
* MERGE SPECIFIED GROUP WITH NEW GROUP
*
GR300 SB1 GRPDIM-1 INITIALIZE FOR END TEST
SB2 X6 B2 = CM ADDRESS OF BIT TABLE
*
GR310 SA1 B1+B2 LOAD FROM SPECIFIED GROUP
SA2 B1+GROUP1 LOAD FROM GROUP BUILDING
BX6 X1+X2
SA6 A2
SB1 B1-1 END TEST
PL B1,GR310
EQ GR100
*
ERRGRUP SB1 85 ERROR IN GROUP NAME OR KEYCODE
EQ =XERR
*
* MAKE ENTRY IN GROUP NAME DIRECTORY AND WRITE
* COMPLETED GROUP BIT TABLE TO ECS
*
GR900 SA1 GINDX LOAD INDEX TO GROUP
SA2 GNAME LOAD GROUP NAME
BX6 X2
SA6 X1+GROUPS1 MAKE ENTRY IN GROUP NAME TABLE
SA2 AGROUP
BX0 X2 X0 = ADDRESS OF GROUP ECS AREA
SA0 GROUPS1
+ WE NKGROUP WRITE NAME TABLE BACK TO ECS
RJ ECSPRTY
SX2 NKGROUP
IX0 X0+X2 BIAS PAST NAME TABLE
SX2 GRPDIM
DX1 X1*X2 COMPUTE BIAS TO GROUP IN ECS
IX0 X0+X1
SA0 GROUP1
+ WE GRPDIM WRITE BIT TABLE TO ECS
RJ ECSPRTY
EQ NXTLINE EXIT
*
*
* /--- BLOCK PAUSE 00 000 81/01/07 19.36
TITLE -PAUSE- COMMAND READIN
*
*
*
* -PAUSE- COMMAND
* PAUSE FOR SPECIFIED TIME OR FOR STUDENT KEYPRESS
*
* THE -PAUSE- COMMAND MAY TAKE THE FOLLOWING FORMS -
* PAUSE
* PAUSE KEYS=LIST
* PAUSE N
* PAUSE N,KEYS=LIST
*
*
PAUSEIN MX6 0
SA6 PTYPE INITIALIZE PAUSE TYPE
SA6 PCODE INITIALIZE GETVAR CODE
SA6 PINX INITIALIZE XSTOR INDEX
***
SX6 =XPAUSE=
SA6 COMNUM
***
SA1 WORDPT
BX6 X1 SAVE POINTER TO FIRST CHARACTER
SA6 OLDPT
SA1 X1 CHECK IF NO TAG
ZR X1,PAUS900
*
* DETERMINE IF FIRST ENTRY IS TIME TO PAUSE OR
* BEGINNING OF KEY LIST
*
CALL NXTNAME GET FIRST ITEM OF TAG ****
SX0 X1-1R=
NZ X0,PAUS100 EXIT IF NOT *KEYS=*
SA1 KKEYS
BX1 X1-X6
NZ X1,PAUS100 EXIT IF NOT *KEYS=*
SX6 1
SA6 PTYPE TYPE 1 = PAUSE KEYS=LIST
EQ PAUS300
*
*
* EVALUATE TIME TO PAUSE EXPRESSION
*
PAUS100 SA1 OLDPT RESET *WORDPT* FOR COMPILE
BX6 X1
SA6 WORDPT
CALL COMPILE EVALUATE TIME EXPRESSION
BX6 X1
SA6 PCODE SAVE -GETVAR- CODE
SA1 LASTKEY LOAD TERMINATING CHARACTER
NZ X1,PAUS200 NEXT ENTRY MUST BE *KEYS=*
SX6 2
SA6 PTYPE TYPE 2 = PAUSE N
EQ PAUS900
*
* CHECK THAT KEY LIST BEGINS WITH *KEYS=*
*
PAUS200 CALL NXTNAME GET NEXT TAG ENTRY ****
SX0 X1-1R=
NZ X0,ERRTERM
SA1 KKEYS MUST BE *KEYS=*
BX1 X1-X6
NZ X1,ERRNAME
SX6 3 TYPE 3 = PAUSE N,KEYS=LIST
SA6 PTYPE
*
* /--- BLOCK PAUSE 00 000 78/08/02 15.16
*
* INITIALIZE FOR MAIN LOOP
*
PAUS300 CALL LOADG LOAD GROUP NAME DIRECTORY
SB1 GRPDIM-1
MX6 0
*
PAUS310 SA6 B1+GROUP1 INITIALIZE PAUSE BIT TABLE
SB1 B1-1
PL B1,PAUS310
SA1 PTYPE
SX2 X1-3 CHECK IF PAUSE WITH TIMING
NZ X2,PAUS500
SX1 TIMEUP SET BIT FOR -TIMEUP- KEY
CALL SSETBIT,GROUP1
*
*
* BUILD PAUSE BIT TABLE
*
PAUS500 CALL NXT GET NEXT ENTRY
SB1 X1
JP B1+*+1
*
+ EQ PAUS800 END-OF-LINE
+ EQ PAUS520 KEY VALUE
+ EQ PAUS540 GROUP
+ EQ ERRGRUP SPECIFIC TOUCH
+ EQ ERRGRUP SPECIFIC EXT
+ EQ ERRGRUP EXPRESSION
*
*
* SET BIT IN PAUSE BIT TABLE FOR SPECIFIED KEY
*
PAUS520 SX1 X6 X1 = KEY VALUE
NG X1,ERRGRUP CHECK IF LEGAL KEY CODE
ZR X1,ERRGRUP
SX0 X1-60*GRPDIM
PL X0,ERRGRUP
CALL SSETBIT,GROUP1 SET BIT IN GROUP TABLE
EQ PAUS500
*
* MERGE SPECIFIED GROUP WITH BIT TABLE
*
PAUS540 SB1 GRPDIM-1 INITIALIZE FOR END TEST
SB2 X6 B2 = CM ADDRESS OF BIT TABLE
*
* SPECIAL FUSSING SO THAT PAUSE KEYS=ALL,TOUCH DOES ENABLE
* TOUCH, WHILE PAUSE KEYS=ALL DOES NOT (BUT ACCEPTS TOUCH
* AND EXTERNAL BY MEANS OF THE ALL BIT IF PREVIOUS ENABLE)
*
SA1 B1+B2 LAST ENTRY OF GROUP
SX6 4 KEYS=ALL BIT
BX6 X6*X1
ZR X6,PAUS546 JUMP IF NOT KEYS=ALL
MX6 -2
BX1 X6*X1 MASK OUT TOUCH/EXT BITS
EQ PAUS546
*
PAUS545 SA1 B1+B2 LOAD FROM SPECIFIED GROUP
PAUS546 SA2 B1+GROUP1 LOAD FROM PAUSE BIT TABLE
BX6 X1+X2
SA6 A2
SB1 B1-1 END TEST
PL B1,PAUS545
EQ PAUS500
*
* /--- BLOCK PAUSE 00 000 76/01/12 13.48
*
* COPY COMPLETED BIT TABLE TO EXTRA STORAGE
*
PAUS800 SA1 INX GET POINTER IN EXTRA STORAGE
BX6 X1 SAVE POINTER
SA6 PINX
SX7 X1+GRPDIM ADVANCE POINTER
SA2 ICX
IX2 X7-X2 CHECK FOR OVERFLOW OF UNIT BUFF
PL X2,LNGUNIT
SA7 A1
SB1 GRPDIM-1
SA2 GROUP1-1 INITIALIZE FOR TRANSFER
*
PAUS810 SA2 A2+1 LOAD NEXT WORD OF BIT TABLE
BX6 X2
SA6 X1+INFO MOVE TO EXTRA STORAGE
SX1 X1+1
SB1 B1-1 END TEST
PL B1,PAUS810
*
* FORM -PAUSE- COMMAND WORD
*
PAUS900 SA1 PTYPE GET -PAUSE- TYPE CODE
SX6 X1+2000B ADD EXPONENT FOR UNPACK
LX6 60-12
SA2 PCODE ADD -GETVAR- CODE IF ANY
LX2 60-24-XCODEL
BX6 X2+X6
SA2 PINX ADD EXTRA STORAGE POINTER
LX2 60-24
BX6 X2+X6
EQ PUTCODE
*
*
* /--- BLOCK KEYTYPE 00 000 78/11/07 11.29
TITLE -KEYTYPE- COMMAND READIN
*
*
*
* -KEYTYPE- COMMAND
* SEARCHES LIST OF KEY CODES, GROUPS OR TOUCH/EXT
*
*
KEYTYIN CALL PUTCOMP EVALUATE RESULT VARIABLE
LX1 60-XCODEL
BX6 X1 SAVE -GETVAR- CODE
SA6 PCODE
CALL LOADG LOAD GROUP NAME TABLE
MX6 0
SA6 KINDX INITIALIZE NUMBER OF ENTRIES
*
KEY100 CALL NXT GET NEXT KEY LIST ENTRY
SB1 X1
JP B1+*+1
*
+ EQ KEY500 END-OF-LINE
+ EQ KEY120 KEY VALUE
+ EQ KEY140 GROUP
+ EQ KEY200 SPECIFIC TOUCH
+ EQ KEY300 SPECIFIC EXT
+ EQ KEY310 EXPRESSION
+ EQ KEY250 FINE-GRID TOUCH
*
*
* STORE KEY VALUE
*
KEY120 SA1 KINDX LOAD CURRENT NUMBER OF ENTRIES
SX7 X1+1
SX0 X7-101 CHECK FOR OVERFLOW
PL X0,ERR2MNY
SA7 A1
SA6 X1+SHOWOUT X6 = ENTRY TO STORE
EQ KEY100
*
* /--- BLOCK KEYTYPE 00 000 78/11/07 11.29
*
* PROCESS -GROUP- TYPE ENTRY
*
KEY140 SA1 INX LOAD POINTER IN EXTRA STORAGE
BX5 X1 X5 = POINTER TO BIT TABLE
SX7 X1+GRPDIM ADVANCE POINTER
SA2 ICX
IX2 X7-X2 CHECK FOR OVERFLOW OF UNIT BUFF
PL X2,LNGUNIT
SA7 A1
SB1 GRPDIM-1 INITIALIZE FOR MOVE LOOP
SA2 X6-1
KEY145 SA2 A2+1 LOAD NEXT WORD OF BIT TABLE
BX6 X2
SA6 X1+INFO MOVE TO EXTRA STORAGE
SX1 X1+1
SB1 B1-1 END TEST
PL B1,KEY145
SX6 X5+44000B X6 = ENTRY FOR GROUP
EQ KEY120
*
*
* PROCESS SPECIFIC TOUCH ENTRY
*
KEY200 CALL ARGSCAN EVALUATE ARGUMENTS
CALL LOADG RE-LOAD GROUP NAME TABLE
SA1 INX X1 = INDEX IN EXTRA STORAGE
SX0 X1+2
SA2 ICX
IX2 X0-X2 CHECK FOR OVERFLOW OF UNIT BUFF
PL X2,LNGUNIT
*
CALL TCHVARS PACK TOUCH LOCATION INFO
*
** 50000B = TOUCH (BIT 14 SET + NEXT 3 BITS (O2) + 0)
*
SX6 X1+50000B X6 = ENTRY FOR SPECIFIC EXT
EQ KEY120
*
*
* PROCESS SPECIFIC FGT ENTRY
*
KEY250 CALL ARGSCAN EVALUATE ARGUMENTS
CALL LOADG RE-LOAD GROUP NAME TABLE
SA1 INX X1 = INDEX IN EXTRA STORAGE
SX0 X1+2
SA2 ICX
IX2 X0-X2 CHECK FOR OVERFLOW OF UNIT BUFF
PL X2,LNGUNIT
*
CALL TCHVARS PACK TOUCH LOCATION INFO
*
** 64000B = FGT (BIT 14 SET + NEXT 3 BITS (O5) + 0)
*
SX6 X1+64000B X6 = ENTRY FOR SPECIFIC EXT
EQ KEY120
*
* /--- BLOCK KEYTYPE 00 000 78/11/07 11.31
*
* PROCESS SPECIFIC EXT OR EXPRESSION TYPE ENTRY
*
KEY300 SX6 54000B SET TYPE CODE = EXT
SA6 FTYPE
EQ KEY320
*
KEY310 SX6 60000B SET TYPE CODE = EXPRESSION
SA6 FTYPE
*
KEY320 CALL ARGSCAN EVALUATE ARGUMENTS
CALL LOADG RE-LOAD GROUP NAME TABLE
SA1 AINDX
SX0 X1-1 CHECK NUMBER OF ARGUMENTS = 1
NZ X0,ERRTAGS
SA1 INX LOAD INDEX IN EXTRA STORAGE
SX7 X1+1
SA2 ICX
IX2 X7-X2 CHECK FOR OVERFLOW OF UNIT BUFF
PL X2,LNGUNIT
SA7 A1 ADVANCE XSTOR INDEX
SA2 ACODES
LX2 60-XCODEL
BX6 X2 PLANT -GETVAR- CODE
SA6 X1+INFO
SA2 FTYPE LOAD TYPE CODE
IX6 X1+X2 X6 = EXT OR EXPRESSION ENTRY
EQ KEY120
*
*
* PACK UP KEY LIST AND FORM COMMAND WORD
*
KEY500 SA1 KINDX NUMBER OF ENTRIES IN LIST
ZR X1,ERR2FEW
MX6 0 PLANT FOR END TEST
SA6 X1+SHOWOUT
SA2 INX X2 = CURRENT XSTOR POINTER
BX5 X2 X5 = INITIAL XSTOR POINTER
SA4 ICX X4 = UNIT BUFFER END TEST
SA1 SHOWOUT-1
*
KEY520 MX6 0 CLEAR WORD BUILDING
SB1 60-15 INITIALIZE SHIFT COUNT
*
KEY530 SA1 A1+1 LOAD NEXT ENTRY IN LIST
LX1 X1,B1
BX6 X1+X6 MERGE WITH REST OF WORD
ZR X1,KEY540 END TEST
SB1 B1-15 DECREMENT SHIFT COUNT
PL B1,KEY530
SA6 X2+INFO STORE COMPLETED WORD
SX2 X2+1 ADVANCE EXTRA STORAGE POINTER
IX0 X2-X4
PL X0,LNGUNIT UNIT BUFFER SPACE CHECK
EQ KEY520
*
KEY540 SA6 X2+INFO STORE FINAL WORD
SX7 X2+1
IX0 X7-X4 UNIT BUFFER SPACE CHECK
PL X0,LNGUNIT
SA7 INX UPDATE EXTRA STORAGE POINTER
SA1 PCODE LOAD -GETVAR- CODE
LX5 60-XCODEL-12
BX6 X1+X5 ATTACH POINTER TO TABLE
EQ PUTCODE EXIT
*
*
* /--- BLOCK KEYTYPE 00 000 78/11/07 11.21
TITLE -TCHVARS-
*
* -TCHVARS-
* LOAD TOUCH -GETVAR- CODES INTO EXTRA STORAGE
* (USED BY *TOUCH* AND *FGT* OPTIONS FOR -KEYTYPE-)
*
TCHVARS EQ *
*
* DETERMINE IF COARSE OR FINE GRID ENTRY
* BY NUMBER OF ARGUMENTS. 1 OR 3 IS COARSE.
* 2 OR 4 IS FINE.
*
MX6 0 PRE-SET = COARSE GRID
SA4 AINDX X4 = NUMBER OF ARGUMENTS
LX4 59
NG X4,PCKVARS ODD, MUST BE 1 OR 3 (COARSE)
MX6 1 SET = FINE GRID
*
* PACK UP -GETVAR- CODES
*
PCKVARS SA2 ACODES
LX2 60-XCODEL
BX6 X2+X6
SA2 ACODES+1
LX2 60-2*XCODEL
BX6 X2+X6
SA2 ACODES+2
LX2 60-3*XCODEL
BX6 X2+X6
SA6 X1+INFO STORE FIRST 3 -GETVAR- CODES
SX7 X1+1
PL X6,TCOURSE IF COURSE GRID, NO MORE VARS
SA2 ACODES+3
LX2 60-XCODEL
BX6 X2
SA6 X7+INFO STORE LAST -GETVAR- CODE
SX7 X7+1
*
TCOURSE SA7 INX UPDATE INDEX IN EXTRA STORAGE
EQ TCHVARS
*
* /--- BLOCK ARGSCAN 00 000 78/12/13 01.52
TITLE -ARGSCAN-
*
*
*
* -ARGSCAN-
* EVALUATE ARGUMENT(S) FOR SPECIFIC TOUCH AND EXT
* ENTRIES. SEPARATORS MUST BE COMMAS
*
* RETURNS *AINDX* = NUMBER OF ARGUMENTS MUST BE
* .LE. 4
* *ACODES* = -GETVAR- CODES FOR ARGUMENTS
*
*
ARGSCAN EQ *
*
* SEARCH FOR BALANCED PARENS = END OF ARGUMENTS
*
MX0 0 X0 = NO SPECIAL TERMINATOR
SA1 WORDPT X1 = POINTER TO FIRST CHARACTER
CALL PSCAN FIND END OF ARGUMENT(S)
NZ B2,ERRBAL ERROR IF UNBALANCED PARENS
SA3 B1-1
SA3 X3+KEYTYPE CHECK ENDED WITH RIGHT PAREN
SX3 X3-OP)
NZ X3,ERRTERM
SX6 1R REPLACE RIGHT PAREN WITH SPACE
SA6 B1-1
SX6 A6 SAVE FOR END TEST
SA6 ENDPNT
SA1 WORDPT
SX6 X1+1 ADVANCE PAST LEFT PAREN
SA6 A1
MX6 0
SA6 AINDX INITIALIZE NUMBER OF ARGUMENTS
SB1 4
*
ARG20 SA6 B1+ACODES INITIALIZE -GETVAR- CODES
SB1 B1-1
PL B1,ARG20 END TEST
*
* /--- BLOCK ARGSCAN 00 000 81/01/07 18.42
*
* EVALUATE ARGUMENTS
*
ARG100 CALL COMPILE EVALUATE NEXT ARGUMENT
SA2 AINDX
SX0 X2-4 CHECK IF TOO MANY ARGUMENTS
PL X0,ERR2MNY
BX6 X1 STORE CURRENT -GETVAR- CODE
SA6 X2+ACODES
SA1 LASTKEY CHECK SEPARATOR
BX7 X1 STORE SEPARATOR
SA7 X2+ASEPS
SX6 X2+1 INCREMENT COUNTER
SA6 A2
SA2 WORDPT
SA3 ENDPNT
IX2 X2-X3
NG X2,ARG100 GET NEXT ARG
SX6 X6-1
ZR X6,ARGSCAN 1 ARG, NO SEP.
*
COMMAS SX6 X6-1
NG X6,ARGSCAN
SA1 X6+ASEPS
SX1 X1-1R,
ZR X1,COMMAS COMMA
EQ ERRTERM
*
*
*
AINDX EQU VARBUF
ENDPNT EQU AINDX+1
ACODES EQU ENDPNT+1
ASEPS EQU ACODES+5
*
*
* /--- BLOCK LOADG 00 000 76/06/07 15.08
TITLE -LOADG- LOAD GROUP NAME TABLE
*
*
*
* -LOADG-
* READ DIRECTORY TO AUTHOR DEFINED GROUPS FROM ECS
*
*
LOADG EQ *
SA1 AGROUP ADDRESS OF GROUP ECS
BX0 X1
SA0 GROUPS1
+ RE NKGROUP READ DIRECTORY
RJ ECSPRTY
MX7 0 CLEAR LAST WORD FOR END TEST
SA7 GEND1
EQ LOADG
*
*
* /--- BLOCK NXT 00 000 78/11/04 11.00
TITLE -NXT- OBTAIN NEXT KEY/GROUP ENTRY
*
*
*
* -NXT-
* OBTAINS NEXT KEY LIST ENTRY FOR GROUP, PAUSE AND
* KEYTYPE COMMANDS.
*
* RETURNS X1 = 0 IF END-OF-LINE
* 1 IF KEY VALUE
* 2 IF KEY GROUP
* 3 IF SPECIFIC TOUCH
* 4 IF SPECIFIC EXT
* 5 IF EXPRESSION
* 6 IF FINE-GRID TOUCH
*
* X6 = KEY VALUE OR ADDRESS OF GROUP TABLE
*
*
NXT EQ *
NXT1 SA1 WORDPT X1 = POINTER TO NEXT CHARACTER
SA2 X1 X2 = CURRENT CHARACTER
ZR X2,NXT20 EXIT IF END-OF-LINE
*
* CHECK FOR SIMPLE KEY OR SHIFTED KEY
*
BX5 X2 X5 = NAME BUILDING
BX6 X2 X6 = KEY CODE
SB1 60-6 B1 = SHIFT COUNT
SX0 X2-KUP CHECK IF SHIFTED CHARACTER
NZ X0,NXT10
SX1 X1+1 ADVANCE CHARACTER POINTER
SA2 X1
ZR X2,NXT20 EXIT IF END-OF-LINE
SB1 B1-6 ADJUST SHIFT COUNT
LX5 6
BX5 X2+X5 MERGE WITH SHIFT CODE
SX6 X2+100B CONVERT TO SHIFTED CHARACTER
*
* /--- BLOCK NXT 00 000 76/01/15 19.48
*
NXT10 SX1 X1+1 ADVANCE CHARACTER POINTER
SA2 X1
ZR X2,NXT15 EXIT IF END-OF-LINE
SA3 X2+KEYTYPE
SX0 X3-OPCOMMA CHECK FOR END OF ENTRY
NZ X0,NXT100 JUMP IF KEY NAME OR GROUP NAME
SX1 X1+1 ADVANCE CHARACTER POINTER
*
NXT15 SX7 X1 UPDATE *WORDPT*
SA7 WORDPT
SX1 1 1 = KEY CODE
EQ NXT
*
NXT20 SA2 NEXTCOM CHECK IF CONTINUED COMMAND
SA3 COMCONT
BX3 X3-X2
NZ X3,NXT25
CALL GETLINE READ NEXT LINE OF SOURCE
EQ NXT1
*
NXT25 MX1 0 0 = END-OF-LINE
EQ NXT
*
* CHECK FOR EXPRESSION
*
NXT100 MX3 -6
BX3 X3*X5 CHECK IF MORE THAN ONE CHAR
NZ X3,NXT108
SA3 X5+KEYTYPE CHECK TYPE OF FIRST CHARACTER
SX0 X3-OP(
NZ X0,NXT108
SX1 5 5 = EXPRESSION
EQ NXT
*
* /--- BLOCK NXT 00 000 76/07/25 07.43
*
* BUILD FUNCTION KEY NAME OR GROUP NAME
*
NXT105 LX5 6 MERGE NEXT CHARACTER OF NAME
BX5 X2+X5
SB1 B1-6 ADJUST SHIFT COUNT
ZR B1,ERRNAME
SX1 X1+1 ADVANCE CHARACTER POINTER
SA2 X1
ZR X2,NXT112 JUMP IF END-OF-LINE
*
NXT108 SA3 X2+KEYTYPE
SX0 X3-OPCOMMA CHECK FOR COMMA
ZR X0,NXT110
SX0 X3-OP( CHECK FOR LEFT PAREN
ZR X0,NXT200
EQ NXT105 MERGE THIS CHARACTER
*
NXT110 SX1 X1+1 ADVANCE CHARACTER POINTER
NXT112 SX7 X1
SA7 WORDPT
LX5 X5,B1 LEFT JUSTIFY KEY OR GROUP NAME
MX0 -18 X0 = MASK
BX1 -X0*X5 CHECK FOR LEGAL NAME
NZ X1,ERRNAME
*
* CHECK IF USER DEFINED GROUP
*
MX7 0
SA7 NKLEND PLANT FOR END TEST
SA7 GEND
SA7 GEND1
SA1 GROUPS1-1 INITIALIZE FOR SEARCH
SB1 NKGROUP-GRPDIM
*
NXT120 SA1 A1+1 LOAD NEXT GROUP NAME
ZR X1,NXT130
SB1 B1+GRPDIM ADVANCE BIAS IN GROUP TABLES
BX2 X0*X1
BX2 X2-X5 CHECK IF NAMES MATCH
NZ X2,NXT120
SA1 AGROUP
SX2 B1 BIAS TO SPECIFIED GROUP
IX0 X1+X2
SA0 GROUP CM ADDRESS FOR GROUP
+ RE GRPDIM READ GROUP TABLE TO CM
RJ ECSPRTY
SX1 2 2 = GROUP
SX6 A0 X6 = CM ADDRESS OF GROUP TABLE
EQ NXT
*
* /--- BLOCK NXT 00 000 78/11/07 10.02
*
* CHECK FOR SYSTEM DEFINED KEY NAME
*
NXT130 SB1 NKLIST
SA1 B1-1 INITIALIZE FOR SEARCH
MX0 -18 X0 = MASK
*
NXT135 SA1 A1+1 LOAD NEXT KEY NAME
ZR X1,NXT140
BX2 X0*X1
BX2 X2-X5 CHECK IF NAMES MATCH
NZ X2,NXT135
SX6 X1 X6 = KEY VALUE
SX1 1 1 = KEY CODE
EQ NXT
*
* CHECK FOR SYSTEM DEFINED GROUP
*
NXT140 SA1 GROUPS-1 INITIALIZE FOR SEARCH
*
NXT145 SA1 A1+1 LOAD NEXT GROUP NAME
ZR X1,ERRNAME ERROR IF UNRECOGNIZED NAME
BX2 X0*X1
BX2 X2-X5 CHECK IF NAMES MATCH
NZ X2,NXT145
SX6 X1 X6 = CM ADDRESS OF GROUP TABLE
SX1 2 2 = GROUP
EQ NXT
*
* IDENTIFY SPECIFIC TOUCH, EXT, OR FGT ENTRY
*
NXT200 SX6 X1 UPDATE *WORDPT*
SA6 WORDPT
LX5 X5,B1 LEFT JUSTIFY KEY OR GROUP NAME
SX1 3 TYPE = 3 = TOUCH
SA2 KTOUCH
BX2 X2-X5 CHECK IF *TOUCH*
ZR X2,NXT
SA2 KT CHECK IF *TOUCH* ABREVIATION
BX2 X2-X5
ZR X2,NXT
SX1 4 TYPE = 4 = EXT
SA2 KEXT
BX2 X2-X5 CHECK IF *EXT*
ZR X2,NXT
SX1 6 TYPE = 6 = FGT
SA2 KFGT
BX2 X2-X5 CHECK IF *FGT*
ZR X2,NXT
SA2 KF
BX2 X2-X5 CHECK IF *FGT* ABBREVIATION
ZR X2,NXT
EQ ERRNAME
*
*
TITLE STORAGE
*
*
GNAME BSS 1
GINDX BSS 1
KINDX EQU GINDX
FTYPE BSS 1
PTYPE BSS 1
PCODE BSS 1
PINX BSS 1
*
KKEYS DATA 4LKEYS
KTOUCH DATA 0LTOUCH
KT DATA 0LT
KEXT DATA 0LEXT
KFGT DATA 0LFGT
KF DATA 0LF
*
*
ENDOV
*
* /--- BLOCK DIN/DOUT 00 000 75/06/04 10.13
TITLE -DIN- / -DOUT- COMMANDS
*
*
*
* -DIN- AND -DOUT- COMMANDS
* 1ST ARGUMENT = DISK INFORMATION PACKAGE
* 2ND = NUMBER BLOCKS (OPTIONAL)
*
*
*
DABSOV OVRLAY
CALL SYSTEST CHECK FOR SYSTEM LESSON
CALL COMPILE
LX1 60-XCODEL POSITION -GETVAR- CODE
BX6 X1
SA6 VARBUF
SA1 LASTKEY CHECK ENDING CHARACTER
ZR X1,DABS100
CALL COMPILE GET CODE FOR NUMBER OF BLOCKS
LX1 60-XCODEL-XCODEL
*
DABS100 SA2 VARBUF LOAD FIRST -GETVAR- CODE
BX6 X1+X2
EQ PUTCODE
*
*
ENDOV
*
*
* /--- BLOCK CONDFIN 00 000 77/08/15 21.11
TITLE CONDFIN
*
* -CONDFIN-
* THIS ROUTINE SETS THE TERM AND DEFINE ENTRIES IN
* THE ULOC TABLE, AND WRITES THE EXTERNAL, UNAM, AND ULOC TABLES
* TO THE END OF THE LESSON BINARY.
* IT ALSO SETS *CONDPRM* UP WITH THE CONDENSE PARAMETERS.
*
*
* SEARCH FOR UNDEFINED UNITS
*
CFINOV OVRLAY
*
SX2 IEUNUM SWITCH UNALPHABETICIZED UNIT-NAME-TABLE
SA0 UNAME+X2 INTO PLACE OF ALPHABETICIZED
SA1 AUNAME GET ECS LOCATION
IX0 X1+X2 START AT INITIAL ENTRY UNIT
SA1 UNUMIN GET NUMBER OF UNITS IN LESSON
IX3 X1-X2 GET NUMBER TO SWITCH
SB1 X3
+ RE B1 SWITCH
RJ ECSPRTY
*
*
SB4 IEUNUM PRE-START OF AUTHOR UNITS
MX6 0
SA6 UNUMON SET FLAG FOR ERROR PLOTTING ROUTINE
SA6 LOCAL TURN OFF LOCALS PROCESSING
*
EULOOP0 SA1 UNUMIN
SB5 X1-1 B5 = NUMBER OF UNITS IN
*
EULOOP GE B4,B5,CNF1 JUMP IF DONE
SB4 B4+1
SA1 ULOC+B4 LOAD ULOC ENTRY
PL X1,EULOOP JUMP IF UNIT DEFINED
LX1 1
NG X1,EULOOP JUMP IF EXTERNAL UNIT
LX1 11
MX0 48
BX2 X0*X1 X2 = UNIT NAME
MX0 36
SA1 KTUNIT CHECK FOR -TUNIT-
BX1 X1-X2
BX1 X0*X1
NZ X1,CNFAA EXIT IF NOT 30/TUNIT,6/0
BX1 X2
AX1 12 POSITION -TUNIT- UNIT NUMBER
SX1 X1
ZR X1,CNFAA -TUNIT- NUMBER MUST BE NON-ZERO
NG X1,CNFAA
SA2 X1+UNITTAB X2 = UNIT NAME
* GET BLOCK AND LINE OF FIRST REFERENCE TO THIS UNIT
CNFAA SA1 AFUREF
SX6 B4
IX0 X6+X1
SA6 ITEMP SAVE B4
SA0 =XHEAD
RE 1
RJ =XECSPRTY
*
SB1 904 UNIT CANNOT BE FOUND
MX1 59 -1
SB2 X1
RJ =XRJERR2 X2 HAS UNIT NAME
*
SA1 ITEMP
SB4 X1 RESTORE B4
EQ EULOOP0
* /--- BLOCK CONDFIN2 00 000 77/09/17 16.43
*
CNF1 CALL MISAY CHECK FOR MISSING SAYLANG
SA1 SYSFLG JUMP IF SYSTEM LESSON
LX1 ZSLDSHF
NG X1,TRM1
SA1 COMREFF SEE IF TEMP VARIABLE REF
ZR X1,TRM1
SA1 CCOMLES SEE IF ANY -COMMON-
NZ X1,TRM1
SA1 XSTORL SEE IF ANY -STORAGE-
NZ X1,TRM1
SA1 CCOMX SEE IF ANY -COMMONX-
NZ X1,TRM1
SB1 100 *WARNING* TEMPORARY VARIABLE REFERENCES
SB2 -1
SX1 B0
SX2 B0
RJ =XRJERR2
EQ TRM1
* /--- BLOCK CONDFIN3 00 000 77/06/18 18.21
*
*
* READ TERM TABLE FROM ECS INTO INFO, AND ALPHABETIZE IT
*
TRM1 SA1 CONDPNT BUFFER POINTER
BX7 X1 SAVE
SA1 TERMS GET NUMBER OF TERMS
BX6 X1
SA6 INFO FIRST WORD OF TERM TABLE IS NUMBER OF TERMS
SB7 X1 NUMBER OF ENTRIES TO B7 FOR ECS READ
SA2 TERMEND ENDING ECS ADDRESS OF TERMS
SX0 X1-1
IX0 X2-X0 TERMS GO BACKWARDS INTO BUFFER
SA0 INFO+1
+ RE B7 READ TERM TABLE INTO CM
- RJ ECSPRTY
BX0 X7 RESET X0
SB1 INFO (B1) = ADDRESS OF TERM TABLE FOR CALL
RJ TSORT ALPHABETIZE TERM TABLE
*
* WRITE OUT FAKE UNIT 0 WHICH IS TERM TABLE
*
SA2 INFO NUMBER OF TABLE ENTRIES TO X2
SA0 A2 ADDRESS OF TERM TABLE FOR ECS
SX2 X2+1 LENGTH OF FAKE UNIT TO X2
SA1 CONBUFF ADDRESS OF CONDENSE BUFFER
IX6 X0-X1 BIAS TO TERM UNIT
LX6 ULOC2
BX6 X6+X2 UNIT LENGTH
LX6 ULOC3+ULOC4
BX6 X6+X2 AND THIS TOTAL LENGTH ALSO
LX6 60-ULOC1-ULOC2-ULOC3-ULOC4
SA6 ULOC STORE ENTRY AT UNIT ZERO OF UNIT LOC TABLE
CALL WRITECS WRITE OUT FAKE UNIT
*
SA1 KOTERM PUT PROPER NAME OF TERM IN UNIT-NAME TABLE
BX6 X1
SA6 UNAME TERM IS FIRST UNIT IN TABLE
*
* /--- BLOCK -CONDFIN 00 000 81/06/29 12.27
*
* WRITE OUT PPT-TUTOR UNIT TABLE = UNIT 3
* 1ST WORD OF UNIT =
* 1ST 6 BITS = UNUSED
* NEXT 9 = MAXIMUM NUMBER OF CHARACTERS
* NEXT 9 = 1ST PHYSICAL UNIT NUMBER
* NEXT 18 = DIMENSION OF VARIABLE AREA
* NEXT 18 = NUMBER UNITS
*
BX7 X0 SAVE X0
SA1 PUNITN GET NUMBER OF PPT UNITS
ZR X1,PPTFN1
SX1 X1+2 X1 = NUMBER OF TUNITS
SA2 NVBYTES GET NUMBER OF DEFINED BYTES
LX2 18
BX6 X1+X2
SA2 PISTU GET 1ST PHYSICAL TUNIT NUMBER
LX2 18+18
BX6 X2+X6
SA2 PCHRLIM GET CHARSET LIMIT
LX2 9+18+18
BX6 X2+X6
SA6 INFO SET 1ST WORD OF UNIT
*
SA2 ATEMPEC
BX0 X2 ADDRESS OF TEMP ECS BUFFER
SB1 X1
SA0 UNITTAB
+ WE B1 WRITE UNIT TABLE TO ECS
RJ ECSPRTY
SA0 INFO+1
+ RE B1 READ TABLE BACK TO *INFO*
RJ ECSPRTY
EQ PPTFN2
*
PPTFN1 MX6 0 CLEAR 1ST WORD OF UNIT
SA6 INFO
*
PPTFN2 SX5 X1+1 X5 = LENGTH OF UNIT
SA1 CONBUFF
IX6 X7-X1 GET RELATIVE ADDRESS OF UNIT
LX6 60-ULOC1 X6 = ULOC ENTRY FORMING
BX0 X7 X0 = ECS ADDRESS OF UNIT
SA0 INFO A0 = CM ADDRESS OF UNIT
BX2 X5 X2 = LENGTH OF UNIT
BX3 X5 FORM CM LENGTH FIELD
LX3 60-ULOC1-ULOC2
BX6 X3+X6
BX3 X5 FORM UNIT LENGTH FIELD
LX3 60-ULOC1-ULOC2-ULOC3-ULOC4
BX6 X3+X6
SA6 ULOC+3 SET ULOC TABLE ENTRY
CALL WRITECS WRITE FAKE UNIT TO BINARY
*
* /--- BLOCK -CONDFIN 00 000 81/06/29 12.30
*
* WRITE MICRO-TUTOR RELEASE LEVEL AND CENTRAL SYSTEM
* EXECUTION FLAG TO LESSON HEADER
*
BX7 X0 SAVE -X0-
SA7 SVX0
MX0 -6
SA1 MTREL GET MICRO-TUTOR RELEASE LEVEL
BX6 -X0*X1
LX6 60-6 POSITION RELEASE LEVEL
SA1 MTCENF
ZR X1,MTCF20 CHECK IF CENTRAL EXEC FLAG SET
SX1 1
LX1 60-7 POSITION FLAG FOR *LMTUTWD*
*
MTCF20 BX6 X1+X6 MERGE CENTRAL EXECUTION FLAG
SA6 ITEMP
SA1 CONBUFF GET FWA OF BINARY BUFFER
SX0 LMTUTWD BIAS TO MICRO-TUTOR WORD
IX0 X0+X1
SA0 A6
+ WE 1 WRITE OUT MICRO-TUTOR WORD
RJ ECSPRTY
*
* /--- BLOCK DEFINES 00 000 81/01/07 18.46
*
* WRITE OUT FAKE UNIT 1 WHICH IS DEFINE TABLE
*
RJ =XSETSET SET UP PARAMETERS FOR DSET
SA1 KCSTUD
BX6 X1 SEE IF SET -STUDENT- EXISTS
CALL FINDSET
NG B1,NODEFN JUMP IF NO SET -STUDENT-
RJ =XGETSET
SA1 NDEFN
SA2 TOKWRD
IX1 X1+X2 COMPUTE TOTAL LENGTH OF DEFINES
SX1 X1-UNITLTH+2 CHECK IF DEFINE SET TOO BIG
PL X1,DEFBIG
*
DEF2 SA2 ATEMPEC ADDRESS OF TEMPORARY ECS
SA1 AVAR ADDRESS OF DEFINED NAMES
SA3 NDEFN NUMBER OF DEFINED NAMES
SA0 VARS LOC OF BUFFER FOR MOVE
SB1 VARLONG LENGTH OF BUFFER FOR MOVE
IX6 X2+X3 DESTINATION OF NEXT MVECS
SA6 DESTAVE
RJ =XMVECS MOVE NAMES INTO BUFFER
*
SA1 ATOKEN SOURCE ECS ADDRESS
SA2 DESTAVE DESTINATION ECS ADDRESS
SA3 TOKWRD LENGTH OF MOVE
SA0 VARS LOC OF BUFFER FOR MOVE
SB1 VARLONG LENGTH OF BUFFER FOR MOVE
RJ =XMVECS MOVE TOKENS INTO BUFFER
SA1 TOKWRD
SB1 X1
SA2 NDEFN
SB1 B1+X2 LENGTH OF STUDENT DEFINE SET
SA3 ATEMPEC
BX0 X3
SA0 INFO+1 LEAVE ROOM FOR HEADER WORD
+ RE B1 READ IN ENTIRE SET
RJ ECSPRTY
SB4 B1+1 LENGTH OF SET+HEADER=UNITLEN
SB1 X2 NDEFN
SB2 X1 TOKWRD
* /--- BLOCK DEFINES 00 000 81/01/07 18.45
*
DEFXX SA2 SVX0
BX0 X2 RESTORE -X0-
SA2 CONBUFF ADDRESS OF CONDENSE BUFFER
IX6 X0-X2 BIAS TO DEFINE UNIT
LX6 ULOC2
SX2 B4 COMPUTE LENGTH OF DEFINE UNIT
BX6 X6+X2
LX6 ULOC3+ULOC4 POSITION ULOC ENTRY
BX6 X6+X2 AGAIN FOR TOTAL LENGTH
LX6 60-ULOC1-ULOC2-ULOC3-ULOC4
SA6 ULOC+1 AND ADD TO ULOC TABLE
SA1 KODEF GET PROPER NAME FOR THIS FAKE UNIT
BX7 X1
SA7 UNAME+1 DEFINE IS ALWAYS SECOND UNIT IN TABLES
SX7 B2 FORM HEADER WORD
LX7 18
SX1 B1 NUMBER OF DEFINES
BX7 X7+X1 ADD NUMBER OF TOKEN WORDS
SA1 NDEFU NUMBER OF UNITS (DIMENSIONS)
LX1 18+18
BX7 X1+X7 MERGE WITH REST OF HEADER WORD
SA7 INFO STORE HEADER WORD
SA0 A7
CALL WRITECS WRITE OUT UNIT
BX7 X0 PRESERVE X0
SA1 CONBUFF
SX2 LDEFNWD BIAS TO DEFINE INFO WORD
IX0 X1+X2
SA0 INFO
+ WE 1 WRITE DEFINE INFO WD TO HEADER
RJ ECSPRTY
BX0 X7 RESTORE X0
EQ COMWRT
DESTAVE BSS 1
*
DEFBIG SB1 101 STUDENT DEFINE SET TOO BIG
SB2 -1
SX1 B0
SX2 B0
RJ =XRJERR2
EQ NODEFN
*
NODEFN SB1 B0 CLEAR NAME COUNT
SB2 B1 CLEAR TOKEN WORD COUNT
SB4 1 ONE WORD FOR HEADER
MX6 0
SA6 NDEFU CLEAR DEFINED NAMES COUNT
EQ DEFXX WRITE OUT EMPTY UNIT
*
SVX0 BSS 1
* /--- BLOCK CONDFIN5 00 000 81/07/28 01.39
*
* WRITE LESSON TABLES
*
COMWRT SA0 UNAME
SA2 UNUMIN LENGTH OF UNIT TABLE TO X2
CALL WRITECS WRITE UNIT NAME TABLE
SA0 ULOC
CALL WRITECS WRITE UNIT LOC TABLE
SA3 CONBUFF ADDRESS OF CONDENSE BUFFER
IX7 X0-X3 LENGTH OF LESSON
SA7 CONDPNT STORE FOR ERRORS PAGE
IX6 X7-X2 BIAS TO ULOC TABLE
LX6 12
BX6 X6+X2 LENGTH OF ULOC TABLE
LX6 12
SA6 CONDPRM PUT INTO *CONDPRM* FOR RETURN
SX2 CBWARN CHECK FOR BIN SIZE WARNING
IX1 X2-X7
PL X1,CONDF2 JUMP IF NOT NEAR MAX LIMIT
SB1 102 *WARNING* BINARY ALMOST TOO LONG
SB2 -1
SX1 B0
SX2 B0
RJ =XRJERR2
*
* -ERRFIN- (GENERATE MAIN HEADER FOR ERROR BUFFER)
*
* 1ST WORD IS NUMBER OF ERRORS SAVED IN CEBUF
* 2ND WORD IS ACCOUNT NAME
* 3RD WORD IS LESSON NAME
* 4TH WORD IS 20/TOTAL NUMBER OF ERRORS
* 20/NUMBER OF UNITS
* 20/LESSON LENGTH
*
CONDF2 RJ =XEBH BUILD ERROR BUFFER HEADER
* /--- BLOCK CONSTAT 00 000 81/02/24 16.45
*
* FINISH UP COMMAND AND LESSON CONDENSING STATISTICS
*
SA1 TSCOMFG
PL X1,STATCFN STATISTICS ON = -1
CALL PSTCMS1 TAKE COMMAND STATS
STATCFN SB1 1
SA3 ACLSTAT ECS ADDR OF LESSON STAT BANK
BX0 X3
SA0 VARBUF TEMPORARY BUFFER
+ RE SCLESL LENGTH OF STATISTICS BANK
RJ =XECSPRTY
*
SX2 B1
SA1 A0+SCUNITS
IX6 X1+X2 ADD 1 TO NUMBER OF UNITS CONDENSED
SA2 CUNITS AND GET UNITS CONDENSED THIS LESSON
IX6 X6+X2
SA6 A1
*
SA1 A0+SCLINES
SA2 =XCLINES
IX6 X1+X2 ADD TO TOTAL LINES CONDENSED
SA6 A1
SX6 B0
SA6 A2 CLEAR CLINES
*
SA1 A0+SCNFIO
SA2 =XNFIOR ADD TO TOTAL FIO REQUESTS
IX6 X1+X2
BX7 X7-X7
SA6 A1
SA7 A2 CLEAR FIO REQUESTS
*
SA1 A0+SCNBRQ ADD TO TOTAL BINARY BUF INCR
SA2 =XWECSC
IX6 X1+X2
BX7 X7-X7
SA6 A1
SA7 A2 CLEAR REQUEST COUNT
SA1 A0+SCDSKS UPDATE DISK STATISTICS
SA2 =XNFIOR+1 COUNT I/O REQUESTS
IX6 X1+X2
SA6 A1
SA7 A2
SA1 A1+1 COUNT BLOCKS READ
SA2 A2+1
IX6 X1+X2
SA6 A1
SA7 A2
*
CALL S=CTIME,TWD GET CPU CLOCK
SB1 1 (B1) = 1
SA1 SYSCLOK
SA2 RTBEG
SA3 A0+SRMILS
IX2 X1-X2 (X2) = REAL TIME FOR CONDENSE
IX6 X2+X3
SA6 A3
SA1 TWD
SA3 CTBEG
SA4 A0+SCMILS
IX3 X1-X3 (X3) = CPU TIME FOR CONDENSE
IX6 X3+X4
SA6 A4
* /--- BLOCK CONSTAT 00 000 81/02/24 16.46
* PUSH DOWN STACK OF LAST 5 CONDENSE CPU TIMES
* SAVE RUNNING RATIO FOR STATS
LX3 30
IX3 X3+X2
SB2 5-2
BX6 X3 (X6) = CPU RATIO
STATFN0 SA1 CTIME+B2
IX6 X1+X6
BX7 X1
SA7 CTIME+1+B2
SB2 B2-B1
GE B2,STATFN0 IF MORE TO MOVE
BX7 X3
SA7 CTIME PUT NEW ENTRY ON TOP OF STACK
SA1 CONDN SAVE THIS CONDENSORS RATIO
SB2 X1+SCPUA
SA6 A0+B2
SA1 A0+CLESMAX
IX1 X1-X2
PL X1,STATFN1
BX6 X2
SA6 A1 REPLACE WITH NEW MAX TIME
SA1 LESSON GET LESSON NAME
BX6 X1
SA6 A0+CMAXNAM THIS LESSSON TOOK MAX CONDENSE TIME
*
*
STATFN1 SA1 A0+CLESMIN
ZR X1,STATFN2
IX1 X2-X1
PL X1,STATFN3
STATFN2 BX6 X2
SA6 A1 REPLACE WITH NEW MIN TIME
*
STATFN3 SA2 USEBCNT
ZR X2,STATFN9 EXIT IF NO -USE- COMMAND
*
SA1 A0+SCUSES
SA3 USEINFO
IX6 X1+X3 COUNT NUMBER OF FILES USE-D
SA6 A1
*
SA1 A0+SCUBLKS
IX6 X1+X2 X2 HOLDS USEBCNT
SA6 A1
*
SA1 A0+SCUNFIO USE FILE FIO REQUESTS
SA2 =XNFIOR+3
IX6 X1+X2 ADD USE FILE FIO REQUESTS
BX7 X7-X7
SA6 A1
SA7 A2 CLEAR USE FILE FIO REQUESTS
*
*
STATFN9 WE SCLESL
EQ =XECSPRTY
*
* /--- BLOCK (N)CONDFIN 00 000 81/01/16 13.37
*
* RETURN CONDENSE INFO TO PLATO
*
SA5 APLACOM (X5) = PLATO COMMUNICATION AREA
SX0 PC.INFO
IX0 X0+X5
SA0 CONDPRM RETURN CONDENSE INFO
+ WE 1
RJ ECSPRTY
*
SX0 PC.INF1
IX0 X0+X5
SA0 =XERRTOT WRITE OUT NUMBER CONDENSE ERRS
+ WE 1
RJ ECSPRTY
*
SX0 PC.INF2
IX0 X0+X5
SA0 =XZCONDOK WRITE OUT ZCONDOK FLAG
+ WE 1
RJ ECSPRTY
*
SX0 PC.COM
IX0 X0+X5
SA0 CCOMACT RETURN COMMON INFO
+ WE 5
RJ ECSPRTY
* COMBINE NUMBER OF STORAGE VARIABLES AND NUMBER
* OF ROUTER VARIABLES. SAVE FOR MERGING WITH
* THE ROUTER LESSON AND NC VARIABLES FLAGS.
SA2 RVARL NUMBER OF ROUTER VARIABLES
SA1 XSTORL NUMBER OF STORAGE VARIABLES
LX2 RVARSH POSITION ROUTER VAR BANK SIZE
BX0 X1+X2
SA1 LVARL SIZE OF LOCALS STACK
PL X1,LVARL1 IF LVARL IS SPECIFIED
*
MX1 0 MAKE SURE NO NEGATIVE VALUES
LVARL1 LX1 LVARSH POSITION LOCAL VAR STACK SIZE
BX0 X0+X1 10LVARL/18RVARL/18XSTORL
* /--- BLOCK CONDFIN 00 000 81/01/07 18.47
* GET AND POSITION ROUTER LESSON, -CCODE- COMMAND,
* AND NC VARIABLES FLAG FOR THE LESSON HEADER.
SA1 ROUTER ROUTER LESSON FLAG
LX1 RVARF
SA3 CCDFLG -CCODE- COMMAND
SA4 COMREFF NC VARIABLES
LX3 CCODEF
SX7 PC.FLAG
ZR X4,M200 IF NO NC VARIABLES
MX4 1
LX4 NCVARF-59
M200 BX6 X1+X3
BX6 X4+X6
BX6 X0+X6 MERGE ROUTER / STORAGE VARS LTH
* WRITE THE FLAGS, ROUTER VARIABLE LENGTH,
* STORAGE VARIABLE LENGTH AND LOCALS STACK SIZE.
IX0 X7+X5
WX6 X0
SX0 PC.DIR RETURN ADDRESS OF DIRECTORY
SA0 AFILEBF
IX0 X0+X5
WE 1
RJ ECSPRTY
SX0 PC.ERR RETURN ADDRESS OF ERROR BUFFER
SA0 ACEBUF
IX0 X0+X5
WE 1
RJ ECSPRTY
SX0 PC.USE
SA0 USEINFO WRITE USE FILE INFORMATION
IX0 X0+X5
WE USEINFL
RJ ECSPRTY
SX6 P.DONE SET PLATO REQUEST CODE
SA6 PLREQC
EQ CONDENS EXIT
*
* /--- BLOCK TSORT 00 000 81/01/07 18.48
*
*
* -TSORT-
* ROUTINE TO SORT TERM TABLE AT END OF LESSON READIN.
*
* DOES BUBBLE SORT TO PUT TERM TABLE IN ORDER OF ASCENDING
* NUMERICAL VALUE.
*
* AT ENTRY,
* (B1) = ADDRESS OF TERM TABLE
*
* TERM TABLE IS ARRANGED SUCH THAT--
* 1) FIRST ENTRY IS NUMBER OF TERMS
* 2) ALL FOLLOWING ENTRIES ARE TERMS
* TERMS ARE 8 CHARS, RIGHT JUSTIFIED.
* THE UPPER 12 BITS ARE THE UNIT NUMBER
* THAT THE TERM IS TO BRANCH TO.
*
* IN CASE OF DOUBLE TERMS, BRANCHING IS UNPREDICTABLE.
*
*
* THIS ROUTINE PRESERVES X0
*
*
*
TSORT EQ *
SA1 B1 LOAD NUMBER OF TERMS
ZR X1,TSORT EXIT NO TERMS
SB2 B1+1 ADDRESS OF FIRST ENTRY TO B2
SB1 1 UIC TO B1
SB7 X1-1 OFFSET OF LAST ENTRY TO B7
ZR B7,TSORT EXIT ONE TERM
MX7 12 MASK OFF UNIT POINTER
SB6 B1 SET MODIFY FLAG NON-ZERO
*
LOOP ZR B6,TSORT DONE IF NO MODIFICATION ON LAST PASS
SB3 B0
SB6 B0 RESET FLAG FOR NEXT PASS
*
PASS EQ B3,B7,LOOP IF END OF PASS, GO START NEXT ONE
SA1 B2+B3 LOAD TERM1
SB3 B3+B1
SA2 B2+B3 LOAD TERM2
BX3 -X7*X1
BX4 -X7*X2
IX5 X4-X3
PL X5,PASS IF TERMS IN INCREASING ORDER, GO ON TO NEXT
*
SB6 B6+B1 SET FLAG THAT MODIFICATION DONE THIS PASS
BX6 X2
SA6 A1 SWITCH TERMS TO CORRECT ORDER
BX6 X1
SA6 A2
EQ PASS GO DO NEXT SET
*
KCSTUD DATA 7LSTUDENT
KCZER DATA 0
KOTERM VFD 12/0,48/4LTERM
KODEF VFD 12/0,48/6LDEFINE
KTUNIT DATA 0LTUNIT
KBLANK DATA 10L BLANKS
DATA 0
*
ENDOV
* /--- BLOCK JMPFOV 00 000 81/01/28 03.57
TITLE -JUMPOUT-, -FROM-, -ARGS- COMMANDS
*
JMPFOV OVRLAY
SA1 OVARG1
SB3 X1
JP B3+*
*
+ EQ JMPO 1 = -JUMPOUT-
+ EQ FRM 2 = -FROM-
+ EQ ARGS 3 = -ARGS-
+ EQ FILED 4 = -FILEDIT-
* -FILEDIT- COMMAND IS CONDENSED AS -JUMPOUT- EXCEPT
* THAT THE BLANK-TAG FORM IS NOT ALLOWED.
FILED SA1 TAGCNT CHECK FOR BLANK TAG
NZ X1,JMP1 TREAT AS -JUMPOUT- IF > 0 TAGS
EQ =XERR2FEW CONDENSE ERROR IF BLANK TAG
****
*
* -JUMPOUT- COMMAND
* JUMP TO SPECIFIED UNIT OF ANOTHER LESSON
*
JMPO SA1 TAGCNT CHECK FOR BLANK TAG
ZR X1,JOUT0
JMP1 SX6 -1 FLAG -JUMPOUT- COMMAND
EQ JMPI
****
*
* -FROM- COMMAND
* DETERMINE WHICH LESSON LAST -JUMPOUT- WAS FROM
*
FRM SA1 TAGCNT CHECK FOR BLANK TAG
ZR X1,ERR2FEW
MX6 0 FLAG -FROM- COMMAND
*
*
JMPI SA6 JOTYPE REMEMBER COMMAND TYPE
SA1 NEXTCOM
SA2 COMCONT CHECK FOR CONTINUED COMMAND
BX2 X1-X2
ZR X2,JO100 MUST BE CONDITIONAL
*
SA1 WORDPT X1 = POINTER TO FIRST CHARACTER
MX0 0 NO SPECIAL TERMINATORS
CALL PSCAN FIND END OF FIRST TAG
NZ B2,ERRBAL ERROR IF UNBALANCED PARENS
NZ B3,ERRBAL ERROR IF UNBALANCED QUOTES
*
SX0 X1-1R; CHECK FOR CONDITIONAL COMMAND
NZ X0,JOUT1 JUMP IF SURE NOT
SA1 B1-1 DISCRIMINATE ; AND ';
SX0 X1-KUP
ZR X0,JOUT1
*
*
* /--- BLOCK JO100 00 000 81/01/12 17.56
*
* CONDITIONAL -JUMPOUT- / -FROM-
*
JO100 MX6 0 INITIALIZE NUMBER OF ENTRIES
SA6 NJNAM AND FLAG TO EXTRACT LITERALS
*
* EVALUATE FIRST ARGUMENT -- CONDITION / RETURN
*
SA1 JOTYPE
NZ X1,JO102 JUMP IF NOT -FROM- COMMAND
CALL PUTCOMP COMPILE CODE TO STORE INTO VAR
EQ JO103
*
JO102 CALL COMPILE EVALUATE EXPRESSION
JO103 MX6 1
LX1 60-XCODEL POSITION -GETVAR- CODE
BX6 X1+X6 SET SIGN BIT FOR CONDITIONAL
SA6 JGCODE PARTIAL COMMAND WORD
*
* LOOP THROUGH EACH SET OF [ACCOUNT';]LESSON[,UNIT][(ARGS)]
*
JO200 SA1 WORDPT
SA2 X1
ZR X2,JO300 CHECK IF AT EOL
*
CALL JOPARSE EVALUATE NEXT SET OF TAGS
*
* X1 = LAST TERMINATOR
*
JO250 SA2 NJNAM NUMBER OF ENTRIES
SX0 X2-200
PL X0,ERR2MNY -- EXIT IF OVERFLOW
SX7 X2+1
SA7 A2
LX2 1 X2 = OFFSET IN TABLE
*
SA3 JACCNAM FIRST WORD = ACCOUNT+LESSON
SA4 JLESNAM
LX3 XCODEL
BX6 X3+X4
SA6 X2+JMPBUFF
*
SA3 JUNIT SECOND WORD = UNIT + ARGS
SA4 JPARGFL
MX0 6 CHECK FOR LITERAL UNIT NAME
BX0 X0*X3
NZ X0,JO275
LX3 XCODEL SHIFT OVER IF NOT LITERAL
* /--- BLOCK JO275 00 000 81/01/20 01.19
*
* COME HERE WITH X1 = *LASTKEY*
*
JO275 BX6 X3+X4
SA6 X2+JMPBUFF+1
NZ X1,JO200 JUMP IF NOT END-OF-LINE
*
JO300 SA1 NEXTCOM CHECK FOR CONTINUED COMMAND
SA2 COMCONT
BX2 X1-X2
NZ X2,JO400 EXIT IF NOT CONTINUED
CALL GETLINE READ-IN NEXT LINE
EQ JO200
*
JO400 SA1 NJNAM NUMBER OF ENTRIES
LX1 1
SB1 X1 LENGTH OF LESSON/UNIT TABLE
SA1 ATEMPEC
BX0 X1 ADDRESS OF TEMP ECS BUFFER
SA0 JMPBUFF
+ WE B1 MOVE TO TEMP ECS BUFFER
RJ ECSPRTY
SA4 INX EXTRA STORAGE POINTER
SX7 X4+B1 UPDATE POINTER
SA7 A4
SA0 X4+INFO
+ RE B1 MOVE TABLE TO *INFO*
RJ ECSPRTY
SA1 JGCODE LOAD -GETVAR- CODE
LX4 60-XCODEL-12
BX6 X1+X4 MERGE CODE AND ADDRESS OF TABLE
SA2 NJNAM
SA3 JOTYPE
ZR X3,JO410 CHECK FOR -FROM- COMMAND
SX0 X2-2 MUST BE AT LEAST 2 ENTRIES
NG X0,ERR2FEW
*
JO410 LX2 60-XCODEL-24
BX6 X2+X6 ATTACH NUMBER OF ENTRIES
EQ PUTCODE
*
* /--- BLOCK JOUT0 00 000 81/01/20 02.56
*
* BLANK-TAG -JUMPOUT-
*
JOUT0 MX6 0
EQ PUTCODE
*
*
* UNCONDITIONAL -JUMPOUT-
*
JOUT1 SA1 JOTYPE CHECK FOR -FROM- COMMAND
ZR X1,FOLD
*
SX6 -1 LEAVE LITERALS IN XSTOR
SA6 NJNAM
CALL JOPARSE GET TAGS
SA1 LASTKEY CHECK TERMINATOR
NZ X1,ERR2MNY -- ERROR IF MORE TAGS
*
SA1 JACCNAM RETRIEVE TAGS
SA2 JLESNAM
SA3 JUNIT
SA4 JPARGFL
*
LX1 2*XCODEL FORM COMMAND WORD
LX2 1*XCODEL
BX6 X1+X2 X6 = ACCOUNT/LESSON CODES
*
MX0 6 FORM UNIT/ARGS WORD
BX0 X0*X3 CHECK FOR LITERAL UNIT NAME
NZ X0,JOUT1A
LX3 XCODEL SHIFT OVER IF NOT LITERAL
*
JOUT1A BX7 X3+X4 X7 = UNIT/ARGS WORD
ZR X7,PUTCODE -- EXIT IF NO UNIT OR ARGS
SA1 INX GET INDEX IN XSTOR
SA7 X1+INFO AND PUT UNIT/ARGS THERE
SX7 X1+1 X7 = [XSTOR+1]
SA7 A1 UPDATE INDEX
LX7 XCMNDL PUT POINTER INTO COMMAND WORD
BX6 X6+X7
EQ PUTCODE -- EXIT
*
* /--- BLOCK FOLD 00 000 81/01/15 04.45
*
* VARIABLE -FROM- COMMAND
*
FOLD CALL PUBERRS,FSFROM
*
MX6 0
SA6 JLESNAM PRESET COMMAND WORD
*
CALL COLONCK CHECK FOR ACCOUNT NAME
NZ X6,FOLD10 -- NO ACCOUNT NAME
CALL COMPILE GET ACCOUNT *GETVAR* CODE
NZ B1,ERRSTOR -- ERROR IF NOT STOREABLE
BX6 X1
LX6 60-XCODEL POSITION IT
SA1 INX
SX7 X1+1
SA6 X1+INFO PUT IT IN XSTOR
SA7 A1 AND UPDATE XSTOR POINTER
LX7 XCMNDL
SA7 JLESNAM STORE [XSTOR+1] OF ACCOUNT
*
FOLD10 CALL COMPILE GET LESSON -GETVAR- CODE
NZ B1,ERRSTOR
SA2 JLESNAM RECALL ACCOUNT ADDRESS (IF ANY)
LX1 60-XCODEL
BX6 X1+X2 X6 = COMMAND WORD
SA2 LASTKEY SEE IF EOL
ZR X2,PUTCODE JUMP IF ONLY ONE TAG
SA6 JLESNAM SAVE WHAT WE HAVE SO FAR
*
CALL COMPILE UNIT -GETVAR- CODE
NZ B1,ERRSTOR
SA2 JLESNAM
LX1 60-2*XCODEL
BX6 X1+X2 MERGE LESSON AND UNIT CODES
EQ PUTCODE
* /--- BLOCK JOPARSE 00 000 81/01/17 20.49
*
TITLE -JOPARSE-
*
* -JOPARSE- PROCESS NEXT SET OF TAGS
*
* OBTAINS THE NEXT ACCOUNT';LESSON,UNIT(ARGS)
*
* ENTER WITH
* *WORDPT* = START OF TAG SET
* *NJNAM* < 0 IF WANT *GETVAR* CODES
* >= 0 IF WANT LITERALS
*
* SETS'; *JACCNAM*, *JLESNAM*, *JUNIT*, *JPARGFL*
*
*
JOPARSE EQ *
*
* LOOK FOR ARGUMENTS -- SET *ENDPNT* IF FOUND
*
SB1 0 B1 = IF IN LESLIST REFERENCE
SX4 1R; X4 = PREVIOUS CHAR
MX5 0 X5 = PAREN DEPTH
MX6 -1 X6 = NO ARGUMENTS PRESENT
SA1 WORDPT
SA1 X1-1
*
JOP100 SA1 A1+1 EXAMINE NEXT CHAR
SX0 X1-1R
ZR X0,JOP100 SKIP SPACES
SA2 X1+KEYTYPE
SX0 X2-OP( CHECK FOR L-PAREN
ZR X0,JOP150
SX0 X2-OP) CHECK FOR R-PAREN
ZR X0,JOP160
SX0 X2-OPLT CHECK FOR LESS-THAN
ZR X0,JOP170
SX0 X2-OPGT CHECK FOR GREATER-THAN
ZR X0,JOP180
*
ZR X1,JOP200 STOP AT EOL
SX0 X1-1R; OR SEMI-COLON
NZ X0,JOP110
SX0 X4-KUP MAKE SURE NOT A COLON
NZ X0,JOP200
*
JOP110 BX4 X1 REMEMBER THIS CHARACTER
EQ JOP100 LOOP BACK
* /--- BLOCK JOPARSE 00 000 81/01/20 02.38
*
* HANDLE PARENS AND VARIABLE TAGS
*
JOP150 BSS 0 L-PAREN -- MIGHT BE ARGS
NZ X5,JOP155 NOT IF ALREADY IN PARENS
NZ B1,JOP155 OR IF IN LESLIST REFERENCE
SA2 X4+KEYTYPE OR IF FIRST CHAR IN NEW TAG
SX0 X2-OPCOMMA
ZR X0,JOP155
PL X6,ERRUARG -- ERROR IF ALREADY HAVE ARGS
SX7 1R, REPLACE PAREN WITH COMMA
SA7 A1
SX6 A1 X6 = START OF ARGS
JOP155 SX5 X5+1 INCREMENT PAREN DEPTH
EQ JOP110 LOOP BACK
*
JOP160 SX5 X5-1 DECREMENT PAREN DEPTH
NG X6,JOP110 AND LOOP BACK IF NOT IN ARGS
NZ X5,JOP110 OR IF PARENS NOT BALANCED
SX7 1R REPLACE PAREN WITH SPACE
SA7 A1
SX7 A7 MARK THIS AS END OF ARGUMENTS
SA7 ENDPNT
EQ JOP200 AND CEASE PRE-SCANNING
*
*
* HANDLE LESLIST REFERENCES
*
JOP170 NZ X5,JOP110 SKIP IF IN PARENS
SA2 X4+KEYTYPE CHECK PREVIOUS CHAR
SX0 X2-OPCOMMA
NZ X0,JOP110 SKIP IF NOT FIRST CHAR IN TAG
SB1 -1 MARK PROCESSING LESLIST
EQ JOP110
*
JOP180 NZ X5,JOP110 SKIP IF IN PARENS
SB1 0 MARK NOT PROCESSING LESLIST
EQ JOP110
* /--- BLOCK JOPARSE 00 000 81/01/20 02.42
*
* COME HERE HAVING FINISHED PARSING SET OF TAGS
*
JOP200 SA6 JPARGFL STORE ARGUMENTS FLAG
NZ X5,ERRBAL -- EXIT IF PARENS NOT BALANCED
*
* GET [ACCOUNT';]FILE *GETVAR* CODES
*
CALL ACCFILE,JACCNAM,0
*
ZR X1,ERR2FEW -- NO LESSON NAME
SX1 X1-1
NZ X1,JOP300 BRANCH IF ACCOUNT';LESSON
*
SA1 JLESNAM CHECK FOR LITERAL LESSON
SA2 NJNAM AND EXTRACT LITERAL IF NEEDED
CALL JLITEST,JLESNAM,X2
EQ JOP350
*
JOP300 SA1 JLESNAM CHECK FOR LITERAL LESSON
CALL JLITEST,JLESNAM,-1
*
JOP350 SA1 JACCNAM CHECK FOR LITERAL ACCOUNT
CALL JLITEST,JACCNAM,-1
*
SA1 LASTKEY X1 = *LASTKEY*
SX0 X1-1R, CHECK DELIMITER
NZ X0,JOP750 NO MORE TAGS IN THIS SET
*
SA1 JPARGFL CHECK FOR ARGUMENTS
NG X1,JOP400 NO ARGS -- GO FOR UNIT
SA2 WORDPT ARE WE AT ARGS YET'/
IX0 X2-X1
NG X0,JOP400 NOT YET AT ARGS -- GO FOR UNIT
MX6 0 MARK NO UNIT
SA6 JUNIT
EQ JOP500 GO GET ARGS
*
* /--- BLOCK JOPARSE 00 000 81/01/29 04.11
*
* GET UNIT NAME
*
JOP400 MX6 0 ZERO-FILL FOR *COMPNAM*
SA6 IFILL
CALL COMPNAM RETURNS X1 = *GETVAR* CODE
*
CALL JLITEST,JUNIT,0 GET LITERAL IF POSSIBLE
SA1 JUNIT MUST BE LESS THAN 9 CHARS
MX0 6 CHECK IF LITERAL
BX0 X0*X1
ZR X0,JOP450 NOT A LITERAL
MX0 6*8 CHECK IF TOO LONG
BX2 -X0*X1
ZR X2,JOP450 CONTINUE IF OK
BX6 X0*X1 PATCH IT
SA6 A1
*///
SB1 3 GIVE CONDENSE WARNING
CALL RJERNOZ
*///
*
JOP450 SA2 JPARGFL CHECK FOR ARGUMENTS
PL X2,JOP500 PROCESS IF PRESENT
SA1 LASTKEY X1 = *LASTKEY*
SX0 X1-1R, SHOULD BE NO MORE TAGS
ZR X0,ERR2MNY -- ERROR IF MORE TAGS IN SET
EQ JOP700 CONTINUE IF OK
*
* /--- BLOCK JOPARSE 00 000 81/01/28 02.48
*
* GET ARGUMENTS
*
JOP500 SA1 JOTYPE CHECK FOR -FROM-
ZR X1,ERRUARG -- ERROR IF ARGS ON -FROM-
MX6 0 MARK NOT -UNIT- OR -ARGS-
SA6 UNITFLG FOR *GETARGS* CALL
SA6 VARBUF AND PRESET NO ARGUMENTS
*
CALL GETARGS PROCESS ARGUMENTS
*
MX6 0 NO UNIT NUMBER
CALL APACK PACK UP ARGUMENTS
MX0 -10
BX6 -X0*X6 MASK OFF XSTOR POINTER
SA6 JPARGFL
*
SA1 LASTKEY X1 = *LASTKEY*
SX0 X1-1R, SHOULD BE NO MORE TAGS
ZR X0,ERRUARG -- ERROR IF MORE TAGS IN SET
*
* DONE PARSING TAGS -- *JPARGFL* IS EITHER
* [ADDRESS OF XSTOR] (HAD ARGS) OR [-1] (NO ARGS)
*
JOP700 SA2 JPARGFL *JPARGFL* = (XSTOR+1)
SX6 X2+1 [OR 0 IF NO ARGS ]
SA6 JPARGFL
EQ JOPARSE -- EXIT
*
*
* HAD ONLY [ACCOUNT';]LESSON
*
JOP750 SX6 B0+0 CLEAR UNIT NAME AND ARGS FLAG
SA6 JUNIT
SA6 JPARGFL
EQ JOPARSE -- EXIT
*
* /--- BLOCK JLITEST 00 000 81/01/12 15.52
*
TITLE -JLITEST-
*
* -JLITEST- TEST *GETVAR* CODE FOR LITERAL
*
* ON ENTRY --
* X1 = *GETVAR* CODE
* B1 = ADDRESS OF RESULT BUFFER
* B2 < 0 IF TO LEAVE RESULT AS *GETVAR* CODE
*
* ON EXIT --
* (BUFFER) = LITERAL OR *GETVAR* CODE
*
JLITEST EQ *
*
BX6 X1 X6 = GETVAR CODE
SA6 B1 INITIALIZE RESULT
AX1 XCODEAL LOOK AT TYPE
MX0 XCODEAL-XCODEL
BX1 -X0*X1
SX1 X1-1
NG X1,JLITEST SHORT LITERAL -- EXIT
ZR X1,JEXTRCT LONG LITERAL
*
* NON-LITERAL -JUMPOUT- REFERENCES ARE PUBLISHING ERRORS
*
CALL PUBERRS,FSJUMPO
EQ JLITEST -- EXIT
*
*
JEXTRCT NG B2,JLITEST -- EXIT IF SHOULD NOT EXTRACT
MX0 -XCODEAL GET XSTOR OFFSET
BX0 -X0*X6
SA1 INFO+X0 RECOVER LITERAL
MX6 6 TEST IF LEFT JUSTIFIED
BX6 X6*X1
ZR X6,JLITEST NOT LEFT JUSTIFIED LITERAL
BX6 X1 SAVE FOR STORING
SA1 INX SEE IF LAST ENTRY IN XSTOR
SX7 X1-1
IX0 X0-X7
NZ X0,JLITEST -- EXIT IF NOT
SA7 A1 UPDATE *INX*
SA6 B1 STORE IN RESULT BUFFER
EQ JLITEST -- EXIT
TITLE -ARGS- COMMAND
*
* -ARGS- COMMAND
*
* ACCEPT -JUMPOUT- ARGUMENTS
*
ARGS SA1 TAGCNT CHECK FOR BLANK TAG
ZR X1,ERR2FEW
*
SA1 WORDPT START AT BEGINNING OF TAG
SA2 X1
ARGEND SA2 A2+1 FIND END OF TAG
NZ X2,ARGEND
SX6 A2
SA6 ENDPNT STORE END OF TAG FIELD
SX6 1
SA6 UNITFLG MARK AS -ARGS- FOR *GETARGS*
MX6 0
SA6 VARBUF INITIALIZE ARGUMENT COUNT
*
CALL GETARGS PROCESS ARGUMENTS
*
MX6 0 NO UNIT NUMBER
CALL APACK PACK UP ARGUMENTS
MX0 -10 MASK OFF XSTOR POINTER
BX6 -X0*X6
LX6 48 POSITION IT
MX1 1 MARK AS EXPLICIT -ARGS-
BX6 X1+X6
EQ PUTCODE -- BUILD COMMAND WORD
*
* /--- BLOCK JLITEST 00 000 79/08/09 15.04
JOTYPE EQU INST+INSTLNG+10 -1=JUMPOUT, 0=FROM
NJNAM EQU JOTYPE+1 NUMBER OF TABLE ENTRIES
JGCODE EQU NJNAM+1 CONDITION CODE
JACCNAM EQU JGCODE+1 ACCOUNT *GETVAR* CODE
JLESNAM EQU JACCNAM+1 LESSON NAME / *GETVAR* CODE
JUNIT EQU JLESNAM+1 UNIT NAME / *GETVAR* CODE
JPARGFL EQU JUNIT+1 ARGUMENTS POINTER / FLAG
JMPBUFF EQU JPARGFL+1 TABLE OF ALTERNATIVE TAGS
*
*
ENDOV
* /--- BLOCK DATAON 00 000 81/01/07 18.49
TITLE OVERLAY FOR VARIOUS DATA COMMANDS
*
CDATAOV OVRLAY
*
SA1 OVARG1
SB3 X1 GET INDEX
JP B3+*
*
*
* NOTE THAT THESE LABELS ARE NOT THE
* ENTRY POINTS THAT THE COMMAND TABLE
* USES.
*
+ EQ DOFFIN -DATAOFF-
+ EQ DONIN -DATAON-
+ EQ AREAIN -AREA-
+ EQ OUTPIN -OUTPUT-
+ EQ OUTPLIN -OUTPUTL-
+ EQ RDDSIN -READSET-
+ EQ ERRNAME UNUSED
*
*
TITLE -DATAON- AND -DATAOFF- COMMANDS
*
*
* -DATAON- AND -DATAOFF- COMMANDS
*
DOFFIN MX6 1 SET BIT FOR -DATAOFF-
SA6 VARBUF
EQ DON10
*
*
DONIN SB1 FSDATON -DATAON- IS PUBLISH ERROR
RJ =XPUBERRS
MX6 0 SET FOR -DATAON-
SA6 VARBUF
*
DON10 MX6 0 CLEAR OPTION BITS
SA6 VARBUF+1
SA1 TAGCNT
ZR X1,DON90
*
DON20 CALL NXTNAME GET NEXT OPTION NAME TO X6****
ZR X6,DON70
MX0 -6
BX2 -X0*X6 SEE IF TOO MANY CHARACTERS
NZ X2,ERRNAME
SA6 ENDLST PLANT FOR END TEST
SA2 OPTLST-1
* /--- BLOCK DATAON 00 000 81/01/07 18.49
*
DON30 SA2 A2+1 LOAD NEXT OPTION NAME
BX3 X0*X2
BX3 X3-X6 SEE IF FOUND A MATCH
NZ X3,DON30
SB1 A2-ENDLST CHECK IF NOT LEGAL OPTION
PL B1,ERRNAME
SB1 A2-DSSYS CHECK IF SYSTEM LESSON TAG
LT B1,DON50 BRANCH IF NOT SYSTEM TAG
BX3 X1 X1 DESTROYED BY SYSTEST
CALL SYSTEST
BX1 X3 RESTORE X1
DON50 BX2 -X0*X2 MASK OFF SHIFT COUNT
SB1 X2
MX6 1
LX6 X6,B1 POSITION BIT FOR THIS OPTION
SA2 VARBUF+1
BX6 X2+X6 MERGE WITH REST OF BITS
SA6 A2
NZ X1,DON20 JUMP IF NOT END-OF-LINE
*
DON70 NZ X1,ERR2MNY ERROR IF NOT END-OF-LINE
SA1 NEXTCOM
SA2 COMCONT SEE IF CONTINUED COMMAND
BX2 X1-X2
NZ X2,DON90 JUMP IF NOT
CALL GETLINE
SA1 TAGCNT ERROR IF BLANK TAG
ZR X1,ERR2FEW
EQ DON20
*
DON90 SA1 VARBUF GET -DATAON- / -DATAOFF- FLAG
SA2 VARBUF+1 GET OPTION BITS
BX6 X1+X2
SX7 DATAON=
SA7 COMNUM SET COMMAND CODE
EQ PUTCODE
*
*
*
OPTLST VFD 54/4LAREA,6/DSAREA
+ VFD 54/6LOUTPUT,6/DSOUTP
+ VFD 54/2LOK,6/DSOK
+ VFD 54/2LNO,6/DSNO
+ VFD 54/8LUNREC NO,6/DSUNO
+ VFD 54/5LVOCAB,6/DSVOCAB
+ VFD 54/4LHELP,6/DSHELP
+ VFD 54/7LHELP NO,6/DSHELPN
+ VFD 54/4LTERM,6/DSTERM
+ VFD 54/7LTERM NO,6/DSTERMN
+ VFD 54/6LERRORS,6/DSXERR
+ VFD 54/6LSIGNIN,6/DSDATON
DSSYS VFD 54/8LNOSIGNIN,6/DSNODON NOTE -- THIS POINT
* AND BEYOND ARE FOR SYSTEM LESSONS ONLY
ENDLST BSS 1
*
* /--- BLOCK AREA 00 000 75/10/25 21.28
TITLE AREA
*
* -AREA- COMMAND
* DESIGNATES AREA OF LESSON FOR SUMARIZED DATA
*
*
AREAIN SA1 TAGCNT SEE IF ANY TAG
ZR X1,AIN1
MX6 0 SET TO ZERO FILL
SA6 IFILL
CALL COMPNAM
EQ CALCODE
*
AIN1 MX1 0 0 = SHORT INTEGER 0
EQ CALCODE
* /--- BLOCK OUTPUT 00 000 78/10/11 00.10
TITLE OUTPUT
*
* -OUTPUT- COMMAND
* OUTPUTS VARIABLES AND/OR TEXT AS STUDENT DATA
*
*
OUTPIN SB1 FSOUTP -OUTPUT- IS PUBLISH ERROR
RJ =XPUBERRS
SA1 TAGCNT SEE IF ANY TAG
ZR X1,ERR2FEW
MX6 0 INITIALIZE NUMBER OF ENTRIES
SA6 VARBUF
*
LP SA1 INX
SB2 X1 INITIALIZE XSTOR POINTER
SB3 B0 INITIALIZE WORD COUNT
SA1 WORDPT
SX7 X1-1 INITIALIZE CHARACTER POINTER
*
LP0 MX6 0 CLEAR WORD BUILDING
SB1 60 INITIALIZE SHIFT COUNT
*
LP1 SX7 X7+1 ADVANCE TO NEXT CHARACTER
SA1 X7
ZR X1,ENDLIN JUMP IF END-OF-LINE
SX2 X1-ACCESS
NZ X2,LP2 JUMP IF CANNOT BE -EMBED-
SA2 X7+1
SX2 X2-1R0 SEE IF -EMBED- (ACCESS 0)
ZR X2,EMBED
*
LP2 SB1 B1-6 COMPUTE SHIFT COUNT
LX1 X1,B1 POSITION THIS CHARACTER
BX6 X1+X6 MERGE WITH WORD BUILDING
NZ B1,LP1
SA6 B2+INFO STORE COMPLETED WORD
SB2 B2+1 ADVANCE XSTOR POINTER (INX)
SB3 B3+1 INCREMENT WORD COUNT
EQ LP0
*
EMBED ZR X6,EMB1 JUMP IF CURRENT WORD EMPTY
SA6 B2+INFO
SB2 B2+1 UPDATE XSTOR POINTER
SB3 B3+1 INCREMENT WORD COUNT
*
EMB1 SA1 X7+2 LOAD TYPE SPECIFIER (A,N,O,V)
MX6 0
SX2 X1-1RA SEE IF -A- ALPHA
ZR X2,EMB2
SX6 X6+1
SX2 X1-1RN SEE IF -N- INTEGER
ZR X2,EMB2
SX6 X6+1
SX2 X1-1RO SEE IF -O- OCTAL
ZR X2,EMB2
SX6 X6+1
SX2 X1-1RV SEE IF -V- FLOATING
ZR X2,EMB2
SX6 X6+1
SX2 X1-1RH SEE IF -H- HEXADECIMAL
ZR X2,EMB2
SX7 X7+2
SA7 WORDPT UPDATE *WORDPT*
SB1 154
EQ =XERR
*
EMB2 SA6 IWK SAVE TYPE SPECIFIER
SA1 X7+3
SX1 X1-1R, NEXT CHARACTER MUST BE COMMA
NZ X1,ERRTERM
SX7 X7+4
SA7 WORDPT UPDATE *WORDPT*
ZR B3,EMB3 JUMP IF NO WORDS IN ENTRY
SA1 VARBUF
SX7 X1+1 INCREMENT NUMBER OF ENTRIES
SA7 A1
SA1 INX BEGINNING INDEX OF TEXT
SX2 B3 NUMBER OF WORDS OF TEXT
LX2 9
BX6 X1+X2 MERGE INDEX AND WORD COUNT
* /--- BLOCK OUTPUT 00 000 78/10/11 00.10
SA6 X7+VARBUF
* /--- BLOCK EMB3 00 000 76/07/25 07.53
*
EMB3 SX7 B2 UPDATE XSTOR POINTER (INX)
SA7 INX
CALL COMPILE DECODE EXPRESSION
SA2 WORDPT
SA3 X2-2 MUST END WITH (ACCESS 1)
SX3 X3-ACCESS
NZ X3,ERRTERM
SA3 X2-1
SX3 X3-1R1
NZ X3,ERRTERM
MX0 -XCODEL
BX1 -X0*X1 -GETVAR- CODE
MX6 1
LX6 30 POSITION BIT FOR -EMBED-
BX6 X1+X6 MERGE BIT AND -GETVAR- CODE
SA1 IWK
LX1 XCODEL POSITION TYPE SPECIFIER
BX6 X1+X6
SA1 VARBUF
SX7 X1+1 INCREMENT NUMBER OF ENTRIES
SX1 X7-VARBUFL+2
PL X1,ERR2MNY ERROR IF TOO MANY ENTRIES
SA7 A1
SA6 X7+VARBUF STORE INFO FOR -EMBED-
EQ LP
*
ENDLIN ZR X6,ENDL1 JUMP IF NOTHING IN LAST WORD
SA6 B2+INFO
SB2 B2+1 ADVANCE XSTOR POINTER (INX)
SB3 B3+1 INCREMENT WORD COUNT
*
ENDL1 ZR B3,ENDL2 JUMP IF NOTHING IN LAST ENTRY
SA1 VARBUF
SX7 X1+1 INCREMENT NUMBER OF ENTRIES
SA7 A1
SA1 INX BEGINNING INDEX OF TEXT
SX2 B3 NUMBER OF WORDS OF TEXT
LX2 9
BX6 X1+X2 MERGE INDEX AND WORD COUNT
SA6 X7+VARBUF
*
ENDL2 SA1 VARBUF LOAD NUMBER OF ENTRIES
ZR X1,ERR2FEW
MX6 0 CLEAR LAST WORD
SA6 X1+VARBUF+1
SB3 B2 SAVE INDEX IN XSTOR
SB4 X1-1 PICK UP END TEST
SA2 VARBUF-1 INITIALIZE INDEX IN *VARBUF*
*
ENDL3 SA2 A2+2 LOAD NEXT -VARBUF- ENTRY
LX2 30
SA3 A2+1 LOAD NEXT -VARBUF- ENTRY
BX6 X2+X3
SA6 B2+INFO STORE NEXT TWO CODES
SB2 B2+1
SB4 B4-2 DECREMENT ENTRY COUNT
PL B4,ENDL3
SX6 B2 UPDATE XSTOR POINTER
SA6 INX
LX1 60-18 POSITION NUMBER OF ENTRIES
SX6 B3
LX6 60-18-18 POSITION INDEX IN XSTOR
BX6 X1+X6
EQ PUTCODE GO ATTACH COMMAND CODE
* /--- BLOCK OUTPUTL 00 000 76/07/25 07.53
TITLE OUTPUTL
*
* -OUTPUTL- COMMAND LABLED OUTPUT
*
* FIRST ARGUMENT = NAME (LABLE)
* 2ND ARGUMENT = STARTING VARIABLE TO OUTPUT
* 3RD ARGUMENT = NUMBER OF VARIABLES TO OUTPUT
*
*
OUTPLIN SB1 FSOUTPL -OUTPUTL- IS PUBLISH ERROR
RJ =XPUBERRS
MX6 0 ZERO FILL
SA6 IFILL
CALL COMPNAM FIRST ARGUMENT
BX6 X1
ZR B1,OUTPL1 JUMP IF STOREABLE
MX1 1
BX6 X1+X6
*
OUTPL1 SA6 VARBUF+1 SAVE -GETVAR- CODE
SX6 1
SA6 VARBUF NUMBER OF VARIABLES
CALL VARDO2 GET NEXT ARGUMENT
SA1 LASTKEY
ZR X1,OPL2 JUMP IF TWO ARGUMENT
CALL VARDO2 GET NEXT ARGUMENT
SA1 VARBUF+2
NG X1,ERRSTOR ERROR IF 2ND NOT STOREABLE
SX1 3
EQ VARFIN
*
OPL2 SA1 VARBUF+1 ERROR IF 1ST NOT STOREABLE
NG X1,ERRSTOR
MX6 1
LX6 XCODEL POSITION BIT TO FLAG 2 ARG
BX6 X1+X6
SA6 A1
SX1 2 PACK UP 2 VARIABLES
EQ VARFIN
*
*
IWK BSS 1
* /--- BLOCK READSET 00 000 76/07/25 07.53
TITLE READSET
*
* -READSET- COMMAND
*
* TWO, THREE, OR FOUR ARGUMENTS --
* 1ST IS ACCOUNT NAME
* 2ND IS FILE NAME
* 3RD IS CODEWORD
* 4TH IS RETURN VARIABLE
*
*
RDDSIN CALL ACCFILF GET ACCOUNT AND FILE NAME
ZR X1,ERR2FEW --- ERROR IF BLANK TAG
*
SA1 LASTKEY
ZR X1,MRKLAST --- DONE IF END OF LINE
CALL VARDO2 GET CODEWORD ARGUMENT
SA1 LASTKEY
ZR X1,MRKLAST --- DONE IF END OF LINE
CALL VARDO2 GET RETURN VARIABLE
NG X6,ERRSTOR --- ERROR IF NOT STOREABLE
SA1 LASTKEY
ZR X1,MRKLAST
EQ ERR2MNY
*
*
ENDOV
* /--- BLOCK READDIN 00 000 76/07/25 07.55
*
TITLE -READD- COMMAND READ DATA FROM DATAFILE
*
*
* FIRST ARG'; TYPE (OUTPUT, AREA, DATAOFF)
* SECOND ARG'; BUFFER
* THIRD ARG'; LENGTH
*
READDOV OVRLAY
CALL NXTNAME GET TYPE OF DATA ****
SB1 1
SA1 RDDLST-1 INITIALIZE FOR SEARCH
MX0 -6
RDDLIST SA1 A1+B1 GET NEXT ENTRY
SB3 A1-RDEND
PL B3,ERRTAGS NOT FOUND
BX2 X6-X1 SEE IF LEGAL TAG
BX2 X2*X0 MASK OFF LOWER 6 BITS
NZ X2,RDDLIST
BX6 -X0*X1 GET TYPE NUMBER
LX6 XCMNDL
SA6 RDDTEMP
CALL COMPILE GET BUFFER START
NZ B1,ERRSTOR ERROR IF NOT STOREABLE
LX1 -XCODEL
SA2 RDDTEMP
BX6 X2+X1
SA6 RDDTEMP
CALL COMPILE
SX1 X1
LX1 60-XCODEL-XCODEL
SA2 RDDTEMP
BX6 X2+X1
EQ PUTCODE
*
*
RDDLST VFD 54/4LAREA,6/1
+ VFD 54/7LOUTPUTL,6/2
+ VFD 54/7LSIGNOFF,6/3
RDEND BSS 1
*
RDDTEMP BSS 1
*
ENDOV
* /--- BLOCK NOTES 00 000 86/02/21 14.16
TITLE NOTES COMMAND
*
* NOTES COMMAND -- ACCESS TERM-COMMENTS UNDER
* PROGRAM CONTROL
*
* NO TAG CALL SYSLIB, COMMENTS MACHINERY
* 1 ARG CALL SYSLIB, PASSING NOTE TITLE
* 2 ARGS CALL SYSLIB, PASS BUFFER SPECIFIED
* IN FIRST ARG, FOR LENGTH 2ND ARG,
* FOR HEADER OF STUDENT COMMENT
* 3 ARGS THIRD ARGUMENT SPECIFIES NOTE TITLE
* 4 ARGS FOURTH ARGUMENT SPECIFIES LESSON NOTES
* FILE TO BE USED FOR THIS NOTE; SYSTEM
* LESSONS ONLY.
* (SEND) OPTIONAL KEYWORD ',SEND', MAY FOLLOW
* ABOVE ARGUMENTS; INDICATES THAT NOTE
* SHOULD BE AUTOMATICALLY SENT WITHOUT
* STUDENT INTERVENTION.
* (LESSON) SAME AS ',SEND',, EXCEPT FORCED TO GO
* LESSON NOTES FILE.
*
* FORMAT FOR COMMAND WORD --
* NEXT TO TOP BIT OF GETVAR1 = AUTO-SEND SELECTED
* TOP TWO BITS OF GETVAR1 SET = ',LESSON', AUTO-SEND
* NEXT TO TOP BIT OF GETVAR2 =
* NOTE TITLE TO BE PASSED (IF MORE THAN ONE
* ARGUMENT IS IN THE COMMAND)
*
* LAST GETVAR CODE MARKED USING -MRKLAST-
*
NNOTEOV OVRLAY
SA1 TAGCNT
MX6 0
ZR X1,PUTCODE NO ARGS MEANS SIMPLE CALL
*
CALL VARDO1
SA1 VARBUF+1 PICK UP THIS GETVAR CODE
NG X1,ERRSTOR MUST BE STORABLE
SA2 LASTKEY
ZR X2,MRKLAST ONLY ARGUMENT IS TITLE
* OTHERWISE, FIRST ARGUMENT IS BUFFER START
CALL VARDO2 GET NEXT ARGUMENT
* /--- BLOCK NOTES 00 000 86/02/21 14.17
*
RJ KEYWORD CHECK FOR SEND/LESSON
NZ X6,NOTES1 BRANCH IF NOT NULL ARGUMENT
SX7 B1
SA7 WORDPT UPDATE WORDPT
EQ NOTES2
*
NOTES1 CALL VARDO2 GET TITLE
SA1 VARBUF+3 PICK UP THIS GETVAR CODE
NG X1,ERRSTOR MUST BE STORABLE
SA1 VARBUF+2 MARK GETVAR CODE TO SHOW TITLE
MX6 1
LX6 XCODEL-1 POSITION TO NEXT TO TOP BIT
BX6 X6+X1 SET BIT OF GETVAR CODE
SA6 A1
RJ KEYWORD
*
NOTES2 CALL SYSTEST SYSTEM LESSONS ONLY
CALL ACCFILE,VARBUF+4,0
SA1 VARBUF GET NUMBER OF ARGUMENTS
SX6 X1+2 ADD 2 (ACCOUNT AND FILE NAME)
SA6 A1
RJ KEYWORD
EQ ERRTAGS ILLEGAL FIFTH TAG
*
KEYWORD EQ *
SA1 LASTKEY
ZR X1,MRKLAST EXIT IF LAST ARG
*
CALL NXTNAMP NEXT TAG W/O UPDATING WORDPT
ZR X6,KEYWORD RETURN IF NULL ARG
SA2 KSEND SEE IF LITERAL ',SEND',
MX7 1 PRESET FOR ',SEND',
LX7 XCODEL-1 NEXT TO TOP BIT
BX2 X6-X2
ZR X2,MARK
SA2 KLESSON SEE IF LITERAL ',LESSON',
MX7 2 SET FOR ',LESSON',
LX7 XCODEL
BX2 X6-X2
NZ X2,KEYWORD RETURN IF NEITHER
MARK NZ X1,ERRTAGS TERMINATOR MUST BE EOL
SA1 VARBUF+1 GET FIRST GETVAR CODE
BX7 X7+X1 SET BIT OF GETVAR CODE
SA7 A1
EQ MRKLAST --- EXIT
*
COMERR SB1 106 MUST BE N OR V VARIABLE
EQ =XERR
*
KSEND DATA 4LSEND
KLESSON DATA 6LLESSON
*
ENDOV
* /--- BLOCK INTLOK 00 000 81/01/07 18.50
TITLE -INTLOK- AND -INTCLR- COMMANDS
*
*
*
* -INTLOK- AND -INTCLR- COMMANDS
* ALLOW SYSTEM LESSONS TO ACCESS MULTI-EXECUTOR
* INTERLOCK TABLES
*
* INTLOK TYPE,INDEX,(WRITE)
* INTCLR TYPE,INDEX
*
INTLOKV OVRLAY
CALL SYSTEST CHECK SYSTEM LESSON
CALL NXTNAM GET TYPE ARGUMENT
ZR X6,ERRORC
MX0 42 X0 = MASK
SA1 ITTAB-1 A1 = READ REGISTER
*
INT120 SA1 A1+1 LOAD NEXT OPTION NAME
ZR X1,ERRORC
BX2 X1-X6
BX2 X0*X2 CHECK IF FOUND A MATCH
NZ X2,INT120
SX6 X1 PICK OFF TYPE CODE
SA6 VARBUF+1
*
CALL COMPILE EVALUATE INDEX EXPRESSION
BX6 X1
SA6 VARBUF+2
SA1 OVARG1 DETERMINE INTLOK/INTCLR
NZ X1,INT240
*
*
CALL NXTNAM GET READ/WRITE ARGUMENT
SA1 ITTAB1 (X1) = DEFAULT TYPE
ZR X6,INT170 IF NO ARGUMENT
MX0 42 X0 = MASK
SA1 ITTAB1-1 A1 = READ REGISTER
*
INT160 SA1 A1+1 LOAD NEXT OPTION NAME
ZR X1,ERRORC
BX2 X1-X6
BX2 X0*X2 CHECK IF FOUND A MATCH
NZ X2,INT160
INT170 SX6 X1 SET INTERLOCK TYPE
SA1 VARBUF+1
IX6 X1+X6 ADD TO INTERLOCK TYPE
SA6 A1
*
INT240 SX1 2 SET NUMBER OF *GETVAR* CODES
BX6 X1
SA6 VARBUF
EQ VARFIN COMPLETE COMMAND READ-IN
*
*
ITTAB VFD 42/0LX,18/0
VFD 60/0
ITTAB1 VFD 42/0LW,18/0
VFD 42/0LWRITE,18/0
VFD 60/0
*
ENDOV
*
*
* /--- BLOCK -ATTACH- 00 000 79/12/15 21.26
TITLE -ATTACH- COMMAND CONDENSE ROUTINE
*
* -ATTACH-
*
* ATTACH ACCOUNT';FILE
* ATTACH ACCOUNT';FILE,RO
* ATTACH ACCOUNT';FILE,(N1),CODEWORD
* ONLY IN SYSTEM LESSONS';
* ATTACH ACCOUNT';FILE,RW,CODEWORD,FILETYPE
*
*
ATCHOV OVRLAY
SA1 OVARG1 SEE WHICH COMMAND
SX0 X1-2
ZR X0,IOSPGO --- BRIF -IOSPECS-
SX0 X1-3
ZR X0,GETLGO --- BRIF -GETLINE-
*
* GET FILE AND ACCOUNT NAMES INTO VARBUF+1 AND VARBUF+2
*
CALL ACCFILF
ZR X1,ERR2FEW --- ERROR IF NO ARGUMENTS
SA2 LASTKEY SEE IF EOL
ZR X2,MRKLAST --- BRIF EOL ENCOUNTERED
*
* CHECK NEXT ARGUMENT FOR A LITERAL '7RO'7 OR '7RW'7
*
CALL NXTNAMP GET LITERAL TAG IN X6
ZR X6,ATT130 --- BRIF NOT A NAME
SB1 B7-3 POINT AT R IN RW OR RO
SA2 LITRO COMPARE FOR READ-ONLY
BX2 X6-X2
ZR X2,ATT110 --- BRIF SHOULD FAKE 0
SA2 LITRW COMPARE FOR READ-WRITE
BX2 X6-X2
ZR X2,ATT120 --- BRIF SHOULD FAKE -1
ATT130 CALL VARDO2 COMPILE THIS ARGUMENT
SA1 LASTKEY
ZR X1,MRKLAST --- MARK LAST TAG FOUND
EQ ATT250 --- GET CODEWORD ARGUMENT
LITRO DATA 2LRO
LITRW DATA 2LRW
*
* FAKE A 0 ARGUMENT FOR '7RO'7 LITERAL TAG
*
ATT110 SX6 1R0
SA6 B1 OVERWRITE R WITH 0
SA6 B1+1 OVERWRITE O WITH 0
EQ ATT130 --- DONE WITH KLUDGE
*
* FAKE A -1 ARGUMENT FOR '7RW'7 LITERAL TAG
*
ATT120 SX6 1R- SET UP LITERAL -
SX7 1R1 SET UP LITERAL 1
SA6 B1 OVERWRITE R WITH -
SA7 B1+1 OVERWRITE W WITH 1
EQ ATT130 --- DONE WITH KLUDGE
* /--- BLOCK -ATTACH- 00 000 78/08/01 09.28
*
* DONE WITH R/W TAG FIELD -- MRKLAST THE REST
*
ATT250 CALL VARDO2 COMPILE NEXT VAR TO VARBUF
SA1 LASTKEY
NZ X1,ATT250 CONTINUE IF NOT E-O-L
SA1 VARBUF+4 MARK CODEWORD AS INTEGER TYPE
MX7 60-XCODEL+XFBIT+1
BX7 -X7*X1 REMOVE I/F BIT FROM GETVAR CODE
SA7 A1
SA1 VARBUF READ NO. OF ARGS
SX0 X1-5 4 TAGS MAX FOR REGULAR LESS
NG X0,MRKLAST --- EXIT IF .LE. 4 TAGS
SX0 X1-6 5 TAGS MAX FOR SYSTEM LESSON
PL X0,ERR2MNY --- TOO MANY TAGS
CALL SYSTEST MUST BE SYSLESS FOR 5 TAGS
EQ MRKLAST --- EXIT THIS COMMAND
*
**
* /--- BLOCK -IOSPECS- 00 000 77/12/21 14.00
TITLE -IOSPECS- CONDENSE ROUTINE
*
* -IOSPECS-
*
* IOSPECS OPTION,OPTION,OPTION...
*
* ALL OPTIONS ARE LITERALS WHICH ARE DECODED HERE
* INTO BIT SHIFTS DEPENDING UPON THEIR POSITION
* IN THE OPTION TABLE BELOW. 'THE TOP OF THE TABLE
* IS THE TOP BIT IN THE COMMAND WORD, AND SO ON.
*
*
IOSPGO SB1 IOLITS B1 = START OF LITERAL TABLE
SB2 IOLEND B2 = END OF ABOVE TABLE
MX5 60 ALLOW UP TO 10 CHAR LITS
CALL SCANNER SCAN THE TAGS
ZR X0,PUTCODE --- BRIF TAGS ARE LEGAL
EQ ERRNAME --- EXIT IF BAD TAGS
IOLITS DATA 0LMODS
DATA 0LNOMODS
DATA 0LTRUNCATE
DATA 0LNOTRUNCATE
DATA 0LDELETED
DATA 0LNODELETED
IOLEND DATA 0
*
**
* /--- BLOCK -GETLINE- 00 000 77/11/10 17.46
TITLE -GETLINE- COMMAND CONDENSE ROUTINE
*
* -GETLINE-
*
* THE -GETLINE- COMMAND MUST HAVE EXACTLY THREE
* ARGUMENTS OF WHICH THE FIRST AND THIRD MUST
* BE STOREABLE.
*
*
GETLGO RJ VARDO COMMA SEPARATED VARIABLES
SA1 VARBUF+1 FIRST TAG MUST BE STOREABLE
NG X1,ERRSTOR
SA1 VARBUF+3 THIRD TAG MUST BE STOREABLE
NG X1,ERRSTOR
SX1 3
EQ VARFIN
*
**
ENDOV
* /--- BLOCK END 00 000 76/07/21 20.33
TITLE KERMIT COMMAND
*
* * * KERMIT OPEN,FILENAM,MODE
* FILENAM = N OR NC VARIABLE (7 WORDS)
* (FULL FILE NAME ON DOS DISK)
* MODE = '7WRITE'7 OR '7APPEND'7
* WRITE = OVERWRITE ENTIRE FILE
* APPEND = APPEND TO END OF FILE
*
* * * KERMIT CLOSE
*
* * * KERMIT SEND,STOWORD,BYTES,TYPE
* STOWORD = STARTING STO WORD ^$
* BYTES = NUM BYTES TO SEND
* (6-BIT CHARS IF TYPE
* EQUALS 6BIT)
* TYPE = BYTE FORMAT
* ASCII = ASCII 8-BIT
* TEXT = 6-BIT
*
* * * KERMIT RECEIVE,STOWORD,BYTES,TYPE,RETURN
* RETURN = NUMBER OF BYTES/6BIT
* ITEMS RECEIVED
*
KERMCOV OVRLAY
*
SA1 TAGCNT NUM CHARS IN TAG PORTION
ZR X1,ERR2FEW NO ARGS, BAD FORM OF COMMAND
*
CALL NXTNAME GET LITERAL TAG IN X6
ZR X6,ERRNAME --- BRIF NOT A NAME
SX0 0 DEFAULT TO '7OPEN'7
SX5 2 3 ARGS REQUIRED (2 COMMAS)
SA2 LOPEN SEE IF '7OPEN'7 OPTION
BX2 X6-X2 COMPARE
ZR X2,KARGSOK
SX0 1 DEFAULT TO '7CLOSE'7
SX5 0 1 ARGS REQUIRED (0 COMMAS)
SA2 LCLOSE SEE IF '7CLOSE'7 OPTION
BX2 X6-X2 COMPARE
ZR X2,KARGSOK
SX0 2 DEFAULT TO '7SEND'7
SX5 3 4 ARGS REQUIRED (3 COMMAS)
SA2 LSEND SEE IF '7SEND'7 OPTION
BX2 X6-X2 COMPAIRE
ZR X2,KARGSOK
SX0 3 DEFAULT TO '7RECEIVE'7
SX5 4 5 ARGS REQUIRED (4 COMMAS)
SA2 LRECVE SEE IF '7RECEIVE'7
BX2 X6-X2 COMPARE
ZR X2,KARGSOK
EQ ERRNAME INVALID TAG
*
* /--- BLOCK -KERMIT- 00 000 79/01/22 01.25
KARGSOK SA1 COMACNT NUM OF COMMAS IN TAGS
IX1 X1-X5 SEE IF WE HAVE REQUIRED TAGS
ZR X1,KRIGHT IF CORRECT NUMBER ARGS, GO ON
NG X1,ERR2FEW NOT ENOUGH ARGS
PL X1,ERR2MNY TOO MANY ARGS
KRIGHT BX6 X0 TRANSFER TO WRITE REGISTER
SA6 VARBUF+1
SX1 1 1 PACKAGE FOR '7CLOSE'7
SX6 X0-1 CHECK FOR '7RECEIVE'7
ZR X6,KDONE
CALL COMPILE GET NEXT ARG (VAR)
SA2 VARBUF+1 GET OP CODE
NZ X2,KSKIP1 NOT '7OPEN'7, SKIP
NZ B1,ERRSTOR ERROR IF NOT STOREABLE
KSKIP1 BX6 X1
SA6 VARBUF+2
NZ X2,KSKIP2 NOT '7OPEN'7, SKIP
* * * CHECK '7WRITE'7 OR '7APPEND'7 ON '7OPEN'7 COMMAND (3RD ARG)
CALL NXTNAME
ZR X6,ERRNAME --- BRIF NOT A NAME
SX0 0 DEFAULT TO '7WRITE'7
SA5 LWRITE
BX2 X5-X6
ZR X2,K3RDARG
SX0 1 DEFAULT TO '7APPEND'7
SA5 LAPPEND
BX2 X5-X6
ZR X2,K3RDARG
EQ ERRNAME
K3RDARG BX6 X0
SA6 VARBUF+3
SX1 3 3 PACKAGE FOR '7CLOSE'7
EQ KDONE
* /--- BLOCK -KERMIT- 00 000 79/01/22 01.29
KSKIP2 CALL COMPILE GET NUMBER OF BYTES/CHARS
BX6 X1
SA6 VARBUF+3
CALL NXTNAME
ZR X6,ERRNAME --- BRIF NOT A NAME
SX0 0 DEFAULT TO ASCII DATA
SA2 LASCII
BX2 X6-X2
ZR X2,KTYPE
SX0 1 DEFAULT TO TEXT DATA
SA2 LTEXT
BX2 X6-X2
ZR X2,KTYPE
EQ ERRNAME INVALID TAG
KTYPE BX6 X0
SA6 VARBUF+4
* SEE IF WE NEED TO CHECK FOR 5TH ARGUMENT
SA2 VARBUF+1 GET ORIGINAL OP CODE
SX2 X2-2 CHECK AGAINST *SEND* CODE
SX1 4 NUMBER OF 20-BIT PACKAGES
ZR X2,KDONE EXIT -- SAVE CODE
* COMPILE 5TH ARGUMENT (RECEIVE)
CALL COMPILE
NZ B1,ERRSTOR ERROR IF NOT STOREABLE
BX6 X1
SA6 VARBUF+5
SX1 5 NUMBER OF 20-BIT PACKAGES
KDONE BX6 X1 NUMBER PACKAGES EXPECTED
SA6 VARBUF SAVE NUMBER OF 20-BIT PACKAGES
EQ VARFIN EXIT -- SAVE CODE
*
LOPEN DATA 0LOPEN
LCLOSE DATA 0LCLOSE
LSEND DATA 0LSEND
LRECVE DATA 0LRECEIVE
LWRITE DATA 0LWRITE
LAPPEND DATA 0LAPPEND
LASCII DATA 0LASCII
LTEXT DATA 0LTEXT
*
ENDOV
* /--- BLOCK END 00 000 76/07/21 20.33
*
*
OVTABLE
*
*
END COVLY1$