Retro1.org codex

User Tools

Site Tools

Trace: • COVLAY1
plato:source:plaopl:covlay1

Table of Contents

COVLAY1

Table Of Contents

  • [00007] OVERLAYS FOR COMMAND READINS
  • [00038] -ENABLE/DISABLE-
  • [00061] GROUP/PAUSE/KEYTYPE COMMAND READ-INS
  • [00075] SYSTEM DEFINED GROUPS
  • [00173] -KEYLIST- COMMAND READIN
  • [00292] -PAUSE- COMMAND READIN
  • [00463] -KEYTYPE- COMMAND READIN
  • [00630] -TCHVARS-
  • [00672] -ARGSCAN-
  • [00750] -LOADG- LOAD GROUP NAME TABLE
  • [00770] -NXT- OBTAIN NEXT KEY/GROUP ENTRY
  • [00953] STORAGE
  • [00975] -DIN- / -DOUT- COMMANDS
  • [01005] CONDFIN
  • [01624] -JUMPOUT-, -FROM-, -ARGS- COMMANDS
  • [01853] -JOPARSE-
  • [02047] -JLITEST-
  • [02091] -ARGS- COMMAND
  • [02135] OVERLAY FOR VARIOUS DATA COMMANDS
  • [02157] -DATAON- AND -DATAOFF- COMMANDS
  • [02242] AREA
  • [02258] OUTPUT
  • [02407] OUTPUTL
  • [02450] READSET
  • [02479] -READD- COMMAND READ DATA FROM DATAFILE
  • [02523] NOTES COMMAND
  • [02621] -INTLOK- AND -INTCLR- COMMANDS
  • [02687] -ATTACH- COMMAND CONDENSE ROUTINE
  • [02781] -IOSPECS- CONDENSE ROUTINE
  • [02813] -GETLINE- COMMAND CONDENSE ROUTINE
  • [02836] KERMIT COMMAND

Source Code

COVLAY1.txt 
  1. COVLAY1 
  2. * /---   FILE TYPE = E
  3. * /---   BLOCK      IDENT      00 000   81/07/13  01.10 
  4.           IDENT  COVLAY1
  5.           LCC    OVERLAY(1,1) 
  6. * 
  7.           TITLE  OVERLAYS FOR COMMAND READINS 
  8. * 
  9. * 
  10.           CST 
  11. * 
  12. * 
  13.  COVLY1$  OVFILE
  14. * 
  15. * 
  16.           EXT    ECSPRTY,PUTCODE,ERRORC 
  17.           EXT    COMCONT,VARFIN,NXTLINE 
  18.           EXT    NKLEND,NKLIST,KEYTYPE
  19.           EXT    CONDENS
  20.           EXT    LNGUNIT
  21.           EXT    ERRTAGS,ERRNAME,ERRSTOR
  22.           EXT    ERR2MNY,ERR2FEW,ERRBAL 
  23.           EXT    ERRTERM,ERRUARG,ERRVTYP
  24. * 
  25. *         FOLLOWING FOR PACK
  26.           EXT    VARDO1 
  27. * 
  28. *         FOLLOWING FOR JUMPOUT,FROM
  29.           EXT    COMPNAM,GETARGS,ENDPNT,UNITFLG 
  30. * 
  31. *         FOLLOWING FOR DATA COMMANDS 
  32.           EXT    NXTNAM,GETLINE,DATAON= 
  33.           EXT    CALCODE,VARDO2,MRKLAST 
  34.           EXT    VARDO
  35. * 
  36. * 
  37. * /---   BLOCK      ENABLE     00 000   75/11/08  13.08 
  38.           TITLE  -ENABLE/DISABLE- 
  39. * 
  40.           EXT    SCANNER
  41. * 
  42.  ENABOV   OVRLAY
  43.           SB1    ENTYPES     START TABLE
  44.           SB2    ENEND       END TABLE
  45.           MX5    60          FULL WORD MASK 
  46.           RJ     SCANNER
  47.           NZ     X0,ERRNAME 
  48.           ZR     X6,=XERROBS --- IF -ENABLE (BLANK)-
  49.           EQ     PUTCODE
  50. * 
  51. * 
  52.  ENTYPES  VFD    60/8LORIENTAL
  53.           VFD    60/5LTOUCH 
  54.           VFD    60/3LEXT 
  55.           VFD    60/6LEXTMAP
  56.           VFD    60/6LSTREAM
  57.  ENEND    BSS    1                HOLE FOR WORD CURRENTLY PROCESSING
  58. * 
  59.           ENDOV 
  60. * /---   BLOCK      PAUSOV     00 000   76/01/26  22.16 
  61.           TITLE  GROUP/PAUSE/KEYTYPE COMMAND READ-INS 
  62. * 
  63. * 
  64.  PAUSOV   OVRLAY
  65.           SA1    OVARG1 
  66.           ZR     X1,PAUSEIN  IF 0 THIS IS PAUSE COMMAND 
  67.           SX2    X1-1 
  68.           ZR     X2,GROUPIN  IF 1 THIS IS GROUP COMMAND 
  69.           EQ     KEYTYIN     OTHERWISE KEYTYPE COMMAND
  70. * 
  71. * 
  72. * 
  73. * 
  74. * /---   BLOCK      TABLES     00 000   75/10/14  10.44 
  75.           TITLE  SYSTEM DEFINED GROUPS
  76. * 
  77. * 
  78. *         LOW 3 BITS OF LAST WORD ARE SPECIAL FLAGS - 
  79. * 
  80. *         3RD BIT = SET ONLY FOR KEYS=ALL 
  81. *         2ND     = TOUCH 
  82. *         1ST     = EXT 
  83. * 
  84. * 
  85.           PURGMAC BITS
  86.  BITS     MACRO  A,B,C,D,E,F,G,H,I,J
  87.           VFD    1/A,1/B,1/C,1/D,1/E,1/F,1/G,1/H,1/I,1/J
  88.           ENDM
  89. * 
  90. * 
  91.           LIST   G
  92. * 
  93.  G.ALPHA  BITS   0,1,1,1,1,1,1,1,1,1    0-11
  94.           BITS   1,1,1,1,1,1,1,1,1,1    12-23 
  95.           BITS   1,1,1,1,1,1,1,0,0,0    24-35 
  96.           BITS   0,0,0,0,0,0,0,0,0,0    36-47 
  97.           BITS   0,0,0,0,0,0,0,0,0,0    50-61 
  98.           BITS   0,0,0,0,0,0,0,0,0,0    62-73 
  99.           BITS   0,0,0,0,0,1,1,1,1,1    74-105
  100.           BITS   1,1,1,1,1,1,1,1,1,1    106-117 
  101.           BITS   1,1,1,1,1,1,1,1,1,1    120-131 
  102.           BITS   1,0,0,0,0,0,0,0,0,0    132-143 
  103.           BITS   0,0,0,0,0,0,0,0,0,0    144-155 
  104.           BITS   0,0,0,0,0,0,0,0,0,0    156-167 
  105.           BSSZ   2
  106. * 
  107. * 
  108.  G.NUMER  BITS   0,0,0,0,0,0,0,0,0,0    0-11
  109.           BITS   0,0,0,0,0,0,0,0,0,0    12-23 
  110.           BITS   0,0,0,0,0,0,0,1,1,1    24-35 
  111.           BITS   1,1,1,1,1,1,1,0,0,0    36-47 
  112.           BITS   0,0,0,0,0,0,0,0,0,0    50-61 
  113.           BITS   0,0,0,0,0,0,0,0,0,0    62-73 
  114.           BSSZ   3
  115. * 
  116. * 
  117.  G.FUNCT  BSSZ   2
  118.           BITS   0,0,0,0,0,0,0,0,1,1    170-201 
  119.           BITS   1,1,1,1,1,1,1,1,1,1    202-213 
  120.           BITS   1,1,1,1,1,1,1,1,1,1    214-225 
  121.           BITS   1,1,1,1,1,1,1,1,1,1    226-237 
  122.           BITS   1,1,1,1,1,1,1,1,1,1    240-251 
  123.           BITS   1,1,1,1,1,1,1,1,1,0    252-263 
  124.           BSSZ   1
  125. * 
  126. * /---   BLOCK      TABLES     00 000   75/10/14  10.45 
  127. * 
  128.  G.EXT    BSSZ   3
  129.           BITS   0,0,0,0,0,0,0,0,0,0    170-201 
  130.           BITS   0,0,0,0,0,0,0,0,0,0    202-213 
  131.           BITS   0,0,0,0,0,0,0,0,0,0    214-225 
  132.           BITS   0,0,0,0,0,0,0,0,0,0    226-237 
  133.           BITS   0,0,0,0,0,0,0,0,0,0    240-251 
  134.           BITS   0,0,0,0,0,0,0,0,0,1    252-263 
  135. * 
  136. * 
  137.  G.TOUCH  BSSZ   3
  138.           BITS   0,0,0,0,0,0,0,0,0,0    170-201 
  139.           BITS   0,0,0,0,0,0,0,0,0,0    202-213 
  140.           BITS   0,0,0,0,0,0,0,0,0,0    214-225 
  141.           BITS   0,0,0,0,0,0,0,0,0,0    226-237 
  142.           BITS   0,0,0,0,0,0,0,0,0,0    240-251 
  143.           BITS   0,0,0,0,0,0,0,0,1,0    252-263 
  144. * 
  145. * 
  146.  G.ALL    DATA   -0,-0,-0,-0    ALL BITS SET
  147. * 
  148.  G.KEYSET DATA   -0,-0,-0,-7  ALL KEYS EXCEPT FOR TOUCH/EXT 
  149. * 
  150.           LIST   *
  151. * 
  152. * 
  153.  GROUPS   VFD    42/5LALPHA,18/G.ALPHA
  154. +         VFD    42/7LNUMERIC,18/G.NUMER
  155. +         VFD    42/5LFUNCT,18/G.FUNCT
  156. +         VFD    42/3LEXT,18/G.EXT
  157. +         VFD    42/5LTOUCH,18/G.TOUCH
  158. +         VFD    42/3LALL,18/G.ALL
  159. +         VFD    42/6LKEYSET,18/G.KEYSET
  160.  GEND     DATA   0
  161. * 
  162. * 
  163. * GRPDIM   EQU    3 
  164.  GRPDIM   EQU    4
  165. * 
  166.  GROUP    EQU    WORK+1           GROUP BIT TABLE 
  167.  GROUP1   EQU    GROUP+GRPDIM     GROUP BIT TABLE 
  168.  GROUPS1  EQU    GROUP1+GRPDIM    GROUP NAME TABLE
  169.  GEND1    EQU    GROUPS1+NKGROUP
  170. * 
  171. * 
  172. * /---   BLOCK      KEYLIST    00 000   78/12/13  01.48 
  173.           TITLE  -KEYLIST- COMMAND READIN 
  174. * 
  175. * 
  176. * 
  177. *         -KEYLIST- COMMAND 
  178. *         KEYLIST NAME,LIST OF KEYS 
  179. * 
  180. * 
  181.  GROUPIN  CALL   LOADG       LOAD -KEYLIST- NAME TABLE
  182. * 
  183. *         GET GROUP NAME AND CHECK IF LEGAL 
  184. * 
  185.           CALL   NXTNAME      GET GROUP NAME **** 
  186.           ZR     X6,ERRNAME 
  187.           SX1    X1-1R,      CHECK DELIMITER
  188.           NZ     X1,ERRTERM  --- IF BAD DELIMITER 
  189.  GRP1     MX0    -18         FORM MASK FOR 7 CHARACTERS 
  190.           BX1    -X0*X6 
  191.           NZ     X1,ERRNAME   LIMIT NAME TO 7 CHARACTERS
  192.           MX2    6
  193.           BX1    X2*X6       CHECK NAME AT LEAST TWO CHARS
  194.           LX1    6
  195.           SX1    X1-KUP      CHECK IF FIRST CHAR IS SHIFT 
  196. +         NZ     X1,*+1 
  197.           AX2    6           EXTEND MASK
  198. +         BX1    -X2*X6 
  199.           ZR     X1,ERRNAME   ERROR IF NAME TOO SHORT 
  200.           SA6    GNAME
  201. * 
  202. *         CHECK FOR DUPLICATE GROUP NAME
  203. * 
  204.           SA1    GROUPS1-1   INITIALIZE FOR SEARCH
  205.           MX7    0           INITIALIZE GROUP INDEX 
  206. * 
  207.  GR20     SA1    A1+1        LOAD NEXT GROUP NAME 
  208.           ZR     X1,GR30
  209.           SX7    X7+1        ADVANCE GROUP INDEX
  210.           BX1    X1-X6       CHECK IF NAMES MATCH 
  211.           NZ     X1,GR20
  212.           EQ     ERRNAME      ERROR IF GROUP ALREADY EXISTS 
  213. * 
  214. *         INITIALIZE FOR NEW GROUP
  215. * 
  216.  GR30     SX1    X7-NKGROUP  CHECK FOR OVERFLOW 
  217.           PL     X1,ERR2MNY 
  218.           SA7    GINDX       SAVE INDEX TO GROUP
  219.           SB1    GRPDIM-1 
  220.           MX7    0
  221. * 
  222.  GR35     SA7    B1+GROUP1   INITIALIZE GROUP BIT TABLE 
  223.           SB1    B1-1 
  224.           PL     B1,GR35
  225. * 
  226. * /---   BLOCK      KEYLIST    00 000   81/01/07  19.36 
  227. * 
  228. *         BUILD GROUP BIT TABLE 
  229. * 
  230.  GR100    CALL   NXT         GET NEXT ENTRY 
  231.           SB1    X1 
  232.           JP     B1+*+1 
  233. * 
  234. +         EQ     GR900       END-OF-LINE
  235. +         EQ     GR200       KEY VALUE
  236. +         EQ     GR300       GROUP
  237. +         EQ     ERRGRUP      SPECIFIC TOUCH
  238. +         EQ     ERRGRUP      SPECIFIC EXT
  239. +         EQ     ERRGRUP      EXPRESSION
  240. * 
  241. * 
  242. *         SET BIT IN GROUP TABLE FOR SPECIFIED KEY
  243. * 
  244.  GR200    SX1    X6          X1 = KEY VALUE 
  245.           NG     X1,ERRGRUP   CHECK IF LEGAL KEY CODE 
  246.           ZR     X1,ERRGRUP 
  247.           SX0    X1-60*GRPDIM 
  248.           PL     X0,ERRGRUP 
  249.           CALL   SSETBIT,GROUP1   SET BIT IN GROUP TABLE
  250.           EQ     GR100
  251. * 
  252. *         MERGE SPECIFIED GROUP WITH NEW GROUP
  253. * 
  254.  GR300    SB1    GRPDIM-1    INITIALIZE FOR END TEST
  255.           SB2    X6          B2 = CM ADDRESS OF BIT TABLE 
  256. * 
  257.  GR310    SA1    B1+B2       LOAD FROM SPECIFIED GROUP
  258.           SA2    B1+GROUP1   LOAD FROM GROUP BUILDING 
  259.           BX6    X1+X2
  260.           SA6    A2 
  261.           SB1    B1-1        END TEST 
  262.           PL     B1,GR310 
  263.           EQ     GR100
  264. * 
  265.  ERRGRUP  SB1    85          ERROR IN GROUP NAME OR KEYCODE 
  266.           EQ     =XERR
  267. * 
  268. *         MAKE ENTRY IN GROUP NAME DIRECTORY AND WRITE
  269. *         COMPLETED GROUP BIT TABLE TO ECS
  270. * 
  271.  GR900    SA1    GINDX       LOAD INDEX TO GROUP
  272.           SA2    GNAME       LOAD GROUP NAME
  273.           BX6    X2 
  274.           SA6    X1+GROUPS1  MAKE ENTRY IN GROUP NAME TABLE 
  275.           SA2    AGROUP 
  276.           BX0    X2          X0 = ADDRESS OF GROUP ECS AREA 
  277.           SA0    GROUPS1
  278. +         WE     NKGROUP     WRITE NAME TABLE BACK TO ECS 
  279.           RJ     ECSPRTY
  280.           SX2    NKGROUP
  281.           IX0    X0+X2       BIAS PAST NAME TABLE 
  282.           SX2    GRPDIM 
  283.           DX1    X1*X2       COMPUTE BIAS TO GROUP IN ECS 
  284.           IX0    X0+X1
  285.           SA0    GROUP1 
  286. +         WE     GRPDIM      WRITE BIT TABLE TO ECS 
  287.           RJ     ECSPRTY
  288.           EQ     NXTLINE     EXIT 
  289. * 
  290. * 
  291. * /---   BLOCK      PAUSE      00 000   81/01/07  19.36 
  292.           TITLE  -PAUSE- COMMAND READIN 
  293. * 
  294. * 
  295. * 
  296. *         -PAUSE- COMMAND 
  297. *         PAUSE FOR SPECIFIED TIME OR FOR STUDENT KEYPRESS
  298. * 
  299. *         THE -PAUSE- COMMAND MAY TAKE THE FOLLOWING FORMS -
  300. *         PAUSE 
  301. *         PAUSE  KEYS=LIST
  302. *         PAUSE  N
  303. *         PAUSE  N,KEYS=LIST
  304. * 
  305. * 
  306.  PAUSEIN  MX6    0
  307.           SA6    PTYPE       INITIALIZE PAUSE TYPE
  308.           SA6    PCODE       INITIALIZE GETVAR CODE 
  309.           SA6    PINX        INITIALIZE XSTOR INDEX 
  310. *** 
  311.           SX6    =XPAUSE= 
  312.           SA6    COMNUM 
  313. *** 
  314.           SA1    WORDPT 
  315.           BX6    X1          SAVE POINTER TO FIRST CHARACTER
  316.           SA6    OLDPT
  317.           SA1    X1          CHECK IF NO TAG
  318.           ZR     X1,PAUS900 
  319. * 
  320. *         DETERMINE IF FIRST ENTRY IS TIME TO PAUSE OR
  321. *         BEGINNING OF KEY LIST 
  322. * 
  323.           CALL   NXTNAME      GET FIRST ITEM OF TAG ****
  324.           SX0    X1-1R= 
  325.           NZ     X0,PAUS100  EXIT IF NOT *KEYS=*
  326.           SA1    KKEYS
  327.           BX1    X1-X6
  328.           NZ     X1,PAUS100  EXIT IF NOT *KEYS=*
  329.           SX6    1
  330.           SA6    PTYPE       TYPE 1 = PAUSE  KEYS=LIST
  331.           EQ     PAUS300
  332. * 
  333. * 
  334. *         EVALUATE TIME TO PAUSE EXPRESSION 
  335. * 
  336.  PAUS100  SA1    OLDPT       RESET *WORDPT* FOR COMPILE 
  337.           BX6    X1 
  338.           SA6    WORDPT 
  339.           CALL   COMPILE     EVALUATE TIME EXPRESSION 
  340.           BX6    X1 
  341.           SA6    PCODE       SAVE -GETVAR- CODE 
  342.           SA1    LASTKEY     LOAD TERMINATING CHARACTER 
  343.           NZ     X1,PAUS200  NEXT ENTRY MUST BE *KEYS=* 
  344.           SX6    2
  345.           SA6    PTYPE       TYPE 2 = PAUSE  N
  346.           EQ     PAUS900
  347. * 
  348. *         CHECK THAT KEY LIST BEGINS WITH *KEYS=* 
  349. * 
  350.  PAUS200  CALL   NXTNAME      GET NEXT TAG ENTRY **** 
  351.           SX0    X1-1R= 
  352.           NZ     X0,ERRTERM 
  353.           SA1    KKEYS       MUST BE *KEYS=*
  354.           BX1    X1-X6
  355.           NZ     X1,ERRNAME 
  356.           SX6    3           TYPE 3 = PAUSE  N,KEYS=LIST
  357.           SA6    PTYPE
  358. * 
  359. * /---   BLOCK      PAUSE      00 000   78/08/02  15.16 
  360. * 
  361. *         INITIALIZE FOR MAIN LOOP
  362. * 
  363.  PAUS300  CALL   LOADG       LOAD GROUP NAME DIRECTORY
  364.           SB1    GRPDIM-1 
  365.           MX6    0
  366. * 
  367.  PAUS310  SA6    B1+GROUP1   INITIALIZE PAUSE BIT TABLE 
  368.           SB1    B1-1 
  369.           PL     B1,PAUS310 
  370.           SA1    PTYPE
  371.           SX2    X1-3        CHECK IF PAUSE WITH TIMING 
  372.           NZ     X2,PAUS500 
  373.           SX1    TIMEUP      SET BIT FOR -TIMEUP- KEY 
  374.           CALL   SSETBIT,GROUP1 
  375. * 
  376. * 
  377. *         BUILD PAUSE BIT TABLE 
  378. * 
  379.  PAUS500  CALL   NXT         GET NEXT ENTRY 
  380.           SB1    X1 
  381.           JP     B1+*+1 
  382. * 
  383. +         EQ     PAUS800     END-OF-LINE
  384. +         EQ     PAUS520     KEY VALUE
  385. +         EQ     PAUS540     GROUP
  386. +         EQ     ERRGRUP      SPECIFIC TOUCH
  387. +         EQ     ERRGRUP      SPECIFIC EXT
  388. +         EQ     ERRGRUP      EXPRESSION
  389. * 
  390. * 
  391. *         SET BIT IN PAUSE BIT TABLE FOR SPECIFIED KEY
  392. * 
  393.  PAUS520  SX1    X6          X1 = KEY VALUE 
  394.           NG     X1,ERRGRUP   CHECK IF LEGAL KEY CODE 
  395.           ZR     X1,ERRGRUP 
  396.           SX0    X1-60*GRPDIM 
  397.           PL     X0,ERRGRUP 
  398.           CALL   SSETBIT,GROUP1   SET BIT IN GROUP TABLE
  399.           EQ     PAUS500
  400. * 
  401. *         MERGE SPECIFIED GROUP WITH BIT TABLE
  402. * 
  403.  PAUS540  SB1    GRPDIM-1    INITIALIZE FOR END TEST
  404.           SB2    X6          B2 = CM ADDRESS OF BIT TABLE 
  405. * 
  406. * SPECIAL FUSSING SO THAT PAUSE KEYS=ALL,TOUCH DOES ENABLE
  407. * TOUCH, WHILE PAUSE KEYS=ALL DOES NOT (BUT ACCEPTS TOUCH 
  408. * AND EXTERNAL BY MEANS OF THE ALL BIT IF PREVIOUS ENABLE)
  409. * 
  410.           SA1    B1+B2       LAST ENTRY OF GROUP
  411.           SX6    4           KEYS=ALL BIT 
  412.           BX6    X6*X1
  413.           ZR     X6,PAUS546  JUMP IF NOT KEYS=ALL 
  414.           MX6    -2 
  415.           BX1    X6*X1       MASK OUT TOUCH/EXT BITS
  416.           EQ     PAUS546
  417. * 
  418.  PAUS545  SA1    B1+B2       LOAD FROM SPECIFIED GROUP
  419.  PAUS546  SA2    B1+GROUP1   LOAD FROM PAUSE BIT TABLE
  420.           BX6    X1+X2
  421.           SA6    A2 
  422.           SB1    B1-1        END TEST 
  423.           PL     B1,PAUS545 
  424.           EQ     PAUS500
  425. * 
  426. * /---   BLOCK      PAUSE      00 000   76/01/12  13.48 
  427. * 
  428. *         COPY COMPLETED BIT TABLE TO EXTRA STORAGE 
  429. * 
  430.  PAUS800  SA1    INX         GET POINTER IN EXTRA STORAGE 
  431.           BX6    X1          SAVE POINTER 
  432.           SA6    PINX 
  433.           SX7    X1+GRPDIM   ADVANCE POINTER
  434.           SA2    ICX
  435.           IX2    X7-X2       CHECK FOR OVERFLOW OF UNIT BUFF
  436.           PL     X2,LNGUNIT 
  437.           SA7    A1 
  438.           SB1    GRPDIM-1 
  439.           SA2    GROUP1-1    INITIALIZE FOR TRANSFER
  440. * 
  441.  PAUS810  SA2    A2+1        LOAD NEXT WORD OF BIT TABLE
  442.           BX6    X2 
  443.           SA6    X1+INFO     MOVE TO EXTRA STORAGE
  444.           SX1    X1+1 
  445.           SB1    B1-1        END TEST 
  446.           PL     B1,PAUS810 
  447. * 
  448. *         FORM -PAUSE- COMMAND WORD 
  449. * 
  450.  PAUS900  SA1    PTYPE       GET -PAUSE- TYPE CODE
  451.           SX6    X1+2000B    ADD EXPONENT FOR UNPACK
  452.           LX6    60-12
  453.           SA2    PCODE       ADD -GETVAR- CODE IF ANY 
  454.           LX2    60-24-XCODEL 
  455.           BX6    X2+X6
  456.           SA2    PINX        ADD EXTRA STORAGE POINTER
  457.           LX2    60-24
  458.           BX6    X2+X6
  459.           EQ     PUTCODE
  460. * 
  461. * 
  462. * /---   BLOCK      KEYTYPE    00 000   78/11/07  11.29 
  463.           TITLE  -KEYTYPE- COMMAND READIN 
  464. * 
  465. * 
  466. * 
  467. *         -KEYTYPE- COMMAND 
  468. *         SEARCHES LIST OF KEY CODES, GROUPS OR TOUCH/EXT 
  469. * 
  470. * 
  471.  KEYTYIN  CALL   PUTCOMP     EVALUATE RESULT VARIABLE 
  472.           LX1    60-XCODEL
  473.           BX6    X1          SAVE -GETVAR- CODE 
  474.           SA6    PCODE
  475.           CALL   LOADG       LOAD GROUP NAME TABLE
  476.           MX6    0
  477.           SA6    KINDX       INITIALIZE NUMBER OF ENTRIES 
  478. * 
  479.  KEY100   CALL   NXT         GET NEXT KEY LIST ENTRY
  480.           SB1    X1 
  481.           JP     B1+*+1 
  482. * 
  483. +         EQ     KEY500      END-OF-LINE
  484. +         EQ     KEY120      KEY VALUE
  485. +         EQ     KEY140      GROUP
  486. +         EQ     KEY200      SPECIFIC TOUCH 
  487. +         EQ     KEY300      SPECIFIC EXT 
  488. +         EQ     KEY310      EXPRESSION 
  489. +         EQ     KEY250      FINE-GRID TOUCH
  490. * 
  491. * 
  492. *         STORE KEY VALUE 
  493. * 
  494.  KEY120   SA1    KINDX       LOAD CURRENT NUMBER OF ENTRIES 
  495.           SX7    X1+1 
  496.           SX0    X7-101      CHECK FOR OVERFLOW 
  497.           PL     X0,ERR2MNY 
  498.           SA7    A1 
  499.           SA6    X1+SHOWOUT  X6 = ENTRY TO STORE
  500.           EQ     KEY100 
  501. * 
  502. * /---   BLOCK      KEYTYPE    00 000   78/11/07  11.29 
  503. * 
  504. *         PROCESS -GROUP- TYPE ENTRY
  505. * 
  506.  KEY140   SA1    INX         LOAD POINTER IN EXTRA STORAGE
  507.           BX5    X1          X5 = POINTER TO BIT TABLE
  508.           SX7    X1+GRPDIM   ADVANCE POINTER
  509.           SA2    ICX
  510.           IX2    X7-X2       CHECK FOR OVERFLOW OF UNIT BUFF
  511.           PL     X2,LNGUNIT 
  512.           SA7    A1 
  513.           SB1    GRPDIM-1    INITIALIZE FOR MOVE LOOP 
  514.           SA2    X6-1 
  515.  
  516.  KEY145   SA2    A2+1        LOAD NEXT WORD OF BIT TABLE
  517.           BX6    X2 
  518.           SA6    X1+INFO     MOVE TO EXTRA STORAGE
  519.           SX1    X1+1 
  520.           SB1    B1-1        END TEST 
  521.           PL     B1,KEY145
  522.           SX6    X5+44000B   X6 = ENTRY FOR GROUP 
  523.           EQ     KEY120 
  524. * 
  525. * 
  526. *         PROCESS SPECIFIC TOUCH ENTRY
  527. * 
  528.  KEY200   CALL   ARGSCAN     EVALUATE ARGUMENTS 
  529.           CALL   LOADG       RE-LOAD GROUP NAME TABLE 
  530.           SA1    INX         X1 = INDEX IN EXTRA STORAGE
  531.           SX0    X1+2 
  532.           SA2    ICX
  533.           IX2    X0-X2       CHECK FOR OVERFLOW OF UNIT BUFF
  534.           PL     X2,LNGUNIT 
  535. * 
  536.           CALL   TCHVARS     PACK TOUCH LOCATION INFO 
  537. * 
  538. **  50000B = TOUCH (BIT 14 SET + NEXT 3 BITS (O2) + 0)
  539. * 
  540.           SX6    X1+50000B   X6 = ENTRY FOR SPECIFIC EXT
  541.           EQ     KEY120 
  542. * 
  543. * 
  544. *         PROCESS SPECIFIC FGT ENTRY
  545. * 
  546.  KEY250   CALL   ARGSCAN     EVALUATE ARGUMENTS 
  547.           CALL   LOADG       RE-LOAD GROUP NAME TABLE 
  548.           SA1    INX         X1 = INDEX IN EXTRA STORAGE
  549.           SX0    X1+2 
  550.           SA2    ICX
  551.           IX2    X0-X2       CHECK FOR OVERFLOW OF UNIT BUFF
  552.           PL     X2,LNGUNIT 
  553. * 
  554.           CALL   TCHVARS     PACK TOUCH LOCATION INFO 
  555. * 
  556. **  64000B = FGT (BIT 14 SET + NEXT 3 BITS (O5) + 0)
  557. * 
  558.           SX6    X1+64000B   X6 = ENTRY FOR SPECIFIC EXT
  559.           EQ     KEY120 
  560. * 
  561. * /---   BLOCK      KEYTYPE    00 000   78/11/07  11.31 
  562. * 
  563. *         PROCESS SPECIFIC EXT OR EXPRESSION TYPE ENTRY 
  564. * 
  565.  KEY300   SX6    54000B      SET TYPE CODE = EXT
  566.           SA6    FTYPE
  567.           EQ     KEY320 
  568. * 
  569.  KEY310   SX6    60000B      SET TYPE CODE = EXPRESSION 
  570.           SA6    FTYPE
  571. * 
  572.  KEY320   CALL   ARGSCAN     EVALUATE ARGUMENTS 
  573.           CALL   LOADG       RE-LOAD GROUP NAME TABLE 
  574.           SA1    AINDX
  575.           SX0    X1-1        CHECK NUMBER OF ARGUMENTS = 1
  576.           NZ     X0,ERRTAGS 
  577.           SA1    INX         LOAD INDEX IN EXTRA STORAGE
  578.           SX7    X1+1 
  579.           SA2    ICX
  580.           IX2    X7-X2       CHECK FOR OVERFLOW OF UNIT BUFF
  581.           PL     X2,LNGUNIT 
  582.           SA7    A1          ADVANCE XSTOR INDEX
  583.           SA2    ACODES 
  584.           LX2    60-XCODEL
  585.           BX6    X2          PLANT -GETVAR- CODE
  586.           SA6    X1+INFO
  587.           SA2    FTYPE       LOAD TYPE CODE 
  588.           IX6    X1+X2       X6 = EXT OR EXPRESSION ENTRY 
  589.           EQ     KEY120 
  590. * 
  591. * 
  592. *         PACK UP KEY LIST AND FORM COMMAND WORD
  593. * 
  594.  KEY500   SA1    KINDX       NUMBER OF ENTRIES IN LIST
  595.           ZR     X1,ERR2FEW 
  596.           MX6    0           PLANT FOR END TEST 
  597.           SA6    X1+SHOWOUT 
  598.           SA2    INX         X2 = CURRENT XSTOR POINTER 
  599.           BX5    X2          X5 = INITIAL XSTOR POINTER 
  600.           SA4    ICX         X4 = UNIT BUFFER END TEST
  601.           SA1    SHOWOUT-1
  602. * 
  603.  KEY520   MX6    0           CLEAR WORD BUILDING
  604.           SB1    60-15       INITIALIZE SHIFT COUNT 
  605. * 
  606.  KEY530   SA1    A1+1        LOAD NEXT ENTRY IN LIST
  607.           LX1    X1,B1
  608.           BX6    X1+X6       MERGE WITH REST OF WORD
  609.           ZR     X1,KEY540   END TEST 
  610.           SB1    B1-15       DECREMENT SHIFT COUNT
  611.           PL     B1,KEY530
  612.           SA6    X2+INFO     STORE COMPLETED WORD 
  613.           SX2    X2+1        ADVANCE EXTRA STORAGE POINTER
  614.           IX0    X2-X4
  615.           PL     X0,LNGUNIT  UNIT BUFFER SPACE CHECK
  616.           EQ     KEY520 
  617. * 
  618.  KEY540   SA6    X2+INFO     STORE FINAL WORD 
  619.           SX7    X2+1 
  620.           IX0    X7-X4       UNIT BUFFER SPACE CHECK
  621.           PL     X0,LNGUNIT 
  622.           SA7    INX         UPDATE EXTRA STORAGE POINTER 
  623.           SA1    PCODE       LOAD -GETVAR- CODE 
  624.           LX5    60-XCODEL-12 
  625.           BX6    X1+X5       ATTACH POINTER TO TABLE
  626.           EQ     PUTCODE     EXIT 
  627. * 
  628. * 
  629. * /---   BLOCK      KEYTYPE    00 000   78/11/07  11.21 
  630.           TITLE  -TCHVARS-
  631. * 
  632. *         -TCHVARS- 
  633. *         LOAD TOUCH -GETVAR- CODES INTO EXTRA STORAGE
  634. *         (USED BY *TOUCH* AND *FGT* OPTIONS FOR -KEYTYPE-) 
  635. * 
  636.  TCHVARS  EQ     *
  637. * 
  638. *         DETERMINE IF COARSE OR FINE GRID ENTRY
  639. *         BY NUMBER OF ARGUMENTS.  1 OR 3 IS COARSE.
  640. *         2 OR 4 IS FINE. 
  641. * 
  642.           MX6    0           PRE-SET = COARSE GRID
  643.           SA4    AINDX       X4 = NUMBER OF ARGUMENTS 
  644.           LX4    59 
  645.           NG     X4,PCKVARS  ODD, MUST BE 1 OR 3 (COARSE) 
  646.           MX6    1           SET = FINE GRID
  647. * 
  648. *         PACK UP -GETVAR- CODES
  649. * 
  650.  PCKVARS  SA2    ACODES 
  651.           LX2    60-XCODEL
  652.           BX6    X2+X6
  653.           SA2    ACODES+1 
  654.           LX2    60-2*XCODEL
  655.           BX6    X2+X6
  656.           SA2    ACODES+2 
  657.           LX2    60-3*XCODEL
  658.           BX6    X2+X6
  659.           SA6    X1+INFO     STORE FIRST 3 -GETVAR- CODES 
  660.           SX7    X1+1 
  661.           PL     X6,TCOURSE  IF COURSE GRID, NO MORE VARS 
  662.           SA2    ACODES+3 
  663.           LX2    60-XCODEL
  664.           BX6    X2 
  665.           SA6    X7+INFO     STORE LAST -GETVAR- CODE 
  666.           SX7    X7+1 
  667. * 
  668.  TCOURSE  SA7    INX         UPDATE INDEX IN EXTRA STORAGE
  669.           EQ     TCHVARS
  670. * 
  671. * /---   BLOCK      ARGSCAN    00 000   78/12/13  01.52 
  672.           TITLE  -ARGSCAN-
  673. * 
  674. * 
  675. * 
  676. *         -ARGSCAN- 
  677. *         EVALUATE ARGUMENT(S) FOR SPECIFIC TOUCH AND EXT 
  678. *         ENTRIES.  SEPARATORS MUST BE COMMAS 
  679. * 
  680. *         RETURNS *AINDX*  = NUMBER OF ARGUMENTS MUST BE
  681. *                            .LE. 4 
  682. *                 *ACODES* = -GETVAR- CODES FOR ARGUMENTS 
  683. * 
  684. * 
  685.  ARGSCAN  EQ     *
  686. * 
  687. *         SEARCH FOR BALANCED PARENS = END OF ARGUMENTS 
  688. * 
  689.           MX0    0           X0 = NO SPECIAL TERMINATOR 
  690.           SA1    WORDPT      X1 = POINTER TO FIRST CHARACTER
  691.           CALL   PSCAN       FIND END OF ARGUMENT(S)
  692.           NZ     B2,ERRBAL    ERROR IF UNBALANCED PARENS
  693.           SA3    B1-1 
  694.           SA3    X3+KEYTYPE  CHECK ENDED WITH RIGHT PAREN 
  695.           SX3    X3-OP) 
  696.           NZ     X3,ERRTERM 
  697.           SX6    1R          REPLACE RIGHT PAREN WITH SPACE 
  698.           SA6    B1-1 
  699.           SX6    A6          SAVE FOR END TEST
  700.           SA6    ENDPNT 
  701.           SA1    WORDPT 
  702.           SX6    X1+1        ADVANCE PAST LEFT PAREN
  703.           SA6    A1 
  704.           MX6    0
  705.           SA6    AINDX       INITIALIZE NUMBER OF ARGUMENTS 
  706.           SB1    4
  707. * 
  708.  ARG20    SA6    B1+ACODES   INITIALIZE -GETVAR- CODES
  709.           SB1    B1-1 
  710.           PL     B1,ARG20    END TEST 
  711. * 
  712. * /---   BLOCK      ARGSCAN    00 000   81/01/07  18.42 
  713. * 
  714. *         EVALUATE ARGUMENTS
  715. * 
  716.  ARG100   CALL   COMPILE     EVALUATE NEXT ARGUMENT 
  717.           SA2    AINDX
  718.           SX0    X2-4        CHECK IF TOO MANY ARGUMENTS
  719.           PL     X0,ERR2MNY 
  720.           BX6    X1          STORE CURRENT -GETVAR- CODE
  721.           SA6    X2+ACODES
  722.           SA1    LASTKEY     CHECK SEPARATOR
  723.           BX7    X1          STORE SEPARATOR
  724.           SA7    X2+ASEPS 
  725.           SX6    X2+1        INCREMENT COUNTER
  726.           SA6    A2 
  727.           SA2    WORDPT 
  728.           SA3    ENDPNT 
  729.           IX2    X2-X3
  730.           NG     X2,ARG100   GET NEXT ARG 
  731.           SX6    X6-1 
  732.           ZR     X6,ARGSCAN  1 ARG, NO SEP. 
  733. * 
  734.  COMMAS   SX6    X6-1 
  735.           NG     X6,ARGSCAN 
  736.           SA1    X6+ASEPS 
  737.           SX1    X1-1R, 
  738.           ZR     X1,COMMAS   COMMA
  739.           EQ     ERRTERM
  740. * 
  741. * 
  742. * 
  743.  AINDX    EQU    VARBUF 
  744.  ENDPNT   EQU    AINDX+1
  745.  ACODES   EQU    ENDPNT+1 
  746.  ASEPS    EQU    ACODES+5 
  747. * 
  748. * 
  749. * /---   BLOCK      LOADG      00 000   76/06/07  15.08 
  750.           TITLE  -LOADG-     LOAD GROUP NAME TABLE
  751. * 
  752. * 
  753. * 
  754. *         -LOADG- 
  755. *         READ DIRECTORY TO AUTHOR DEFINED GROUPS FROM ECS
  756. * 
  757. * 
  758.  LOADG    EQ     *
  759.           SA1    AGROUP      ADDRESS OF GROUP ECS 
  760.           BX0    X1 
  761.           SA0    GROUPS1
  762. +         RE     NKGROUP     READ DIRECTORY 
  763.           RJ     ECSPRTY
  764.           MX7    0           CLEAR LAST WORD FOR END TEST 
  765.           SA7    GEND1
  766.           EQ     LOADG
  767. * 
  768. * 
  769. * /---   BLOCK      NXT        00 000   78/11/04  11.00 
  770.           TITLE  -NXT-       OBTAIN NEXT KEY/GROUP ENTRY
  771. * 
  772. * 
  773. * 
  774. *         -NXT- 
  775. *         OBTAINS NEXT KEY LIST ENTRY FOR GROUP, PAUSE AND
  776. *         KEYTYPE COMMANDS. 
  777. * 
  778. *         RETURNS X1 = 0  IF END-OF-LINE
  779. *                      1  IF KEY VALUE
  780. *                      2  IF KEY GROUP
  781. *                      3  IF SPECIFIC TOUCH 
  782. *                      4  IF SPECIFIC EXT 
  783. *                      5  IF EXPRESSION 
  784. *                      6  IF FINE-GRID TOUCH
  785. * 
  786. *                 X6 = KEY VALUE OR ADDRESS OF GROUP TABLE
  787. * 
  788. * 
  789.  NXT      EQ     *
  790.  NXT1     SA1    WORDPT      X1 = POINTER TO NEXT CHARACTER 
  791.           SA2    X1          X2 = CURRENT CHARACTER 
  792.           ZR     X2,NXT20    EXIT IF END-OF-LINE
  793. * 
  794. *         CHECK FOR SIMPLE KEY OR SHIFTED KEY 
  795. * 
  796.           BX5    X2          X5 = NAME BUILDING 
  797.           BX6    X2          X6 = KEY CODE
  798.           SB1    60-6        B1 = SHIFT COUNT 
  799.           SX0    X2-KUP      CHECK IF SHIFTED CHARACTER 
  800.           NZ     X0,NXT10 
  801.           SX1    X1+1        ADVANCE CHARACTER POINTER
  802.           SA2    X1 
  803.           ZR     X2,NXT20    EXIT IF END-OF-LINE
  804.           SB1    B1-6        ADJUST SHIFT COUNT 
  805.           LX5    6
  806.           BX5    X2+X5       MERGE WITH SHIFT CODE
  807.           SX6    X2+100B     CONVERT TO SHIFTED CHARACTER 
  808. * 
  809. * /---   BLOCK      NXT        00 000   76/01/15  19.48 
  810. * 
  811.  NXT10    SX1    X1+1        ADVANCE CHARACTER POINTER
  812.           SA2    X1 
  813.           ZR     X2,NXT15    EXIT IF END-OF-LINE
  814.           SA3    X2+KEYTYPE 
  815.           SX0    X3-OPCOMMA  CHECK FOR END OF ENTRY 
  816.           NZ     X0,NXT100   JUMP IF KEY NAME OR GROUP NAME 
  817.           SX1    X1+1        ADVANCE CHARACTER POINTER
  818. * 
  819.  NXT15    SX7    X1          UPDATE *WORDPT*
  820.           SA7    WORDPT 
  821.           SX1    1           1 = KEY CODE 
  822.           EQ     NXT
  823. * 
  824.  NXT20    SA2    NEXTCOM     CHECK IF CONTINUED COMMAND 
  825.           SA3    COMCONT
  826.           BX3    X3-X2
  827.           NZ     X3,NXT25 
  828.           CALL   GETLINE     READ NEXT LINE OF SOURCE 
  829.           EQ     NXT1 
  830. * 
  831.  NXT25    MX1    0           0 = END-OF-LINE
  832.           EQ     NXT
  833. * 
  834. *         CHECK FOR EXPRESSION
  835. * 
  836.  NXT100   MX3    -6 
  837.           BX3    X3*X5       CHECK IF MORE THAN ONE CHAR
  838.           NZ     X3,NXT108
  839.           SA3    X5+KEYTYPE  CHECK TYPE OF FIRST CHARACTER
  840.           SX0    X3-OP( 
  841.           NZ     X0,NXT108
  842.           SX1    5           5 = EXPRESSION 
  843.           EQ     NXT
  844. * 
  845. * /---   BLOCK      NXT        00 000   76/07/25  07.43 
  846. * 
  847. *         BUILD FUNCTION KEY NAME OR GROUP NAME 
  848. * 
  849.  NXT105   LX5    6           MERGE NEXT CHARACTER OF NAME 
  850.           BX5    X2+X5
  851.           SB1    B1-6        ADJUST SHIFT COUNT 
  852.           ZR     B1,ERRNAME 
  853.           SX1    X1+1        ADVANCE CHARACTER POINTER
  854.           SA2    X1 
  855.           ZR     X2,NXT112   JUMP IF END-OF-LINE
  856. * 
  857.  NXT108   SA3    X2+KEYTYPE 
  858.           SX0    X3-OPCOMMA  CHECK FOR COMMA
  859.           ZR     X0,NXT110
  860.           SX0    X3-OP(      CHECK FOR LEFT PAREN 
  861.           ZR     X0,NXT200
  862.           EQ     NXT105      MERGE THIS CHARACTER 
  863. * 
  864.  NXT110   SX1    X1+1        ADVANCE CHARACTER POINTER
  865.  NXT112   SX7    X1 
  866.           SA7    WORDPT 
  867.           LX5    X5,B1       LEFT JUSTIFY KEY OR GROUP NAME 
  868.           MX0    -18         X0 = MASK
  869.           BX1    -X0*X5      CHECK FOR LEGAL NAME 
  870.           NZ     X1,ERRNAME 
  871. * 
  872. *         CHECK IF USER DEFINED GROUP 
  873. * 
  874.           MX7    0
  875.           SA7    NKLEND      PLANT FOR END TEST 
  876.           SA7    GEND 
  877.           SA7    GEND1
  878.           SA1    GROUPS1-1   INITIALIZE FOR SEARCH
  879.           SB1    NKGROUP-GRPDIM 
  880. * 
  881.  NXT120   SA1    A1+1        LOAD NEXT GROUP NAME 
  882.           ZR     X1,NXT130
  883.           SB1    B1+GRPDIM   ADVANCE BIAS IN GROUP TABLES 
  884.           BX2    X0*X1
  885.           BX2    X2-X5       CHECK IF NAMES MATCH 
  886.           NZ     X2,NXT120
  887.           SA1    AGROUP 
  888.           SX2    B1          BIAS TO SPECIFIED GROUP
  889.           IX0    X1+X2
  890.           SA0    GROUP       CM ADDRESS FOR GROUP 
  891. +         RE     GRPDIM      READ GROUP TABLE TO CM 
  892.           RJ     ECSPRTY
  893.           SX1    2           2 = GROUP
  894.           SX6    A0          X6 = CM ADDRESS OF GROUP TABLE 
  895.           EQ     NXT
  896. * 
  897. * /---   BLOCK      NXT        00 000   78/11/07  10.02 
  898. * 
  899. *         CHECK FOR SYSTEM DEFINED KEY NAME 
  900. * 
  901.  NXT130   SB1    NKLIST 
  902.           SA1    B1-1        INITIALIZE FOR SEARCH
  903.           MX0    -18         X0 = MASK
  904. * 
  905.  NXT135   SA1    A1+1        LOAD NEXT KEY NAME 
  906.           ZR     X1,NXT140
  907.           BX2    X0*X1
  908.           BX2    X2-X5       CHECK IF NAMES MATCH 
  909.           NZ     X2,NXT135
  910.           SX6    X1          X6 = KEY VALUE 
  911.           SX1    1           1 = KEY CODE 
  912.           EQ     NXT
  913. * 
  914. *         CHECK FOR SYSTEM DEFINED GROUP
  915. * 
  916.  NXT140   SA1    GROUPS-1    INITIALIZE FOR SEARCH
  917. * 
  918.  NXT145   SA1    A1+1        LOAD NEXT GROUP NAME 
  919.           ZR     X1,ERRNAME   ERROR IF UNRECOGNIZED NAME
  920.           BX2    X0*X1
  921.           BX2    X2-X5       CHECK IF NAMES MATCH 
  922.           NZ     X2,NXT145
  923.           SX6    X1          X6 = CM ADDRESS OF GROUP TABLE 
  924.           SX1    2           2 = GROUP
  925.           EQ     NXT
  926. * 
  927. *         IDENTIFY SPECIFIC TOUCH, EXT, OR FGT ENTRY
  928. * 
  929.  NXT200   SX6    X1          UPDATE *WORDPT*
  930.           SA6    WORDPT 
  931.           LX5    X5,B1       LEFT JUSTIFY KEY OR GROUP NAME 
  932.           SX1    3           TYPE = 3 = TOUCH 
  933.           SA2    KTOUCH 
  934.           BX2    X2-X5       CHECK IF *TOUCH* 
  935.           ZR     X2,NXT 
  936.           SA2    KT          CHECK IF *TOUCH* ABREVIATION 
  937.           BX2    X2-X5
  938.           ZR     X2,NXT 
  939.           SX1    4           TYPE = 4 = EXT 
  940.           SA2    KEXT 
  941.           BX2    X2-X5       CHECK IF *EXT* 
  942.           ZR     X2,NXT 
  943.           SX1    6           TYPE = 6 = FGT 
  944.           SA2    KFGT 
  945.           BX2    X2-X5       CHECK IF *FGT* 
  946.           ZR     X2,NXT 
  947.           SA2    KF 
  948.           BX2    X2-X5       CHECK IF *FGT* ABBREVIATION
  949.           ZR     X2,NXT 
  950.           EQ     ERRNAME
  951. * 
  952. * 
  953.           TITLE  STORAGE
  954. * 
  955. * 
  956.  GNAME    BSS    1
  957.  GINDX    BSS    1
  958.  KINDX    EQU    GINDX
  959.  FTYPE    BSS    1
  960.  PTYPE    BSS    1
  961.  PCODE    BSS    1
  962.  PINX     BSS    1
  963. * 
  964.  KKEYS    DATA   4LKEYS 
  965.  KTOUCH   DATA   0LTOUCH
  966.  KT       DATA   0LT
  967.  KEXT     DATA   0LEXT
  968.  KFGT     DATA   0LFGT
  969.  KF       DATA   0LF
  970. * 
  971. * 
  972.           ENDOV 
  973. * 
  974. * /---   BLOCK      DIN/DOUT   00 000   75/06/04  10.13 
  975.           TITLE  -DIN- / -DOUT- COMMANDS
  976. * 
  977. * 
  978. * 
  979. *         -DIN- AND -DOUT- COMMANDS 
  980. *         1ST ARGUMENT = DISK INFORMATION PACKAGE 
  981. *         2ND          = NUMBER BLOCKS  (OPTIONAL)
  982. * 
  983. * 
  984. * 
  985.  DABSOV   OVRLAY
  986.           CALL   SYSTEST     CHECK FOR SYSTEM LESSON
  987.           CALL   COMPILE
  988.           LX1    60-XCODEL   POSITION -GETVAR- CODE 
  989.           BX6    X1 
  990.           SA6    VARBUF 
  991.           SA1    LASTKEY     CHECK ENDING CHARACTER 
  992.           ZR     X1,DABS100 
  993.           CALL   COMPILE     GET CODE FOR NUMBER OF BLOCKS
  994.           LX1    60-XCODEL-XCODEL 
  995. * 
  996.  DABS100  SA2    VARBUF      LOAD FIRST -GETVAR- CODE 
  997.           BX6    X1+X2
  998.           EQ     PUTCODE
  999. * 
  1000. * 
  1001.           ENDOV 
  1002. * 
  1003. * 
  1004. * /---   BLOCK      CONDFIN    00 000   77/08/15  21.11 
  1005.           TITLE  CONDFIN
  1006. * 
  1007. *         -CONDFIN- 
  1008. *         THIS ROUTINE SETS THE TERM AND DEFINE ENTRIES IN
  1009. *         THE ULOC TABLE, AND WRITES THE EXTERNAL, UNAM, AND ULOC TABLES
  1010. *         TO THE END OF THE LESSON BINARY.
  1011. *         IT ALSO SETS *CONDPRM* UP WITH THE CONDENSE PARAMETERS. 
  1012. * 
  1013. * 
  1014. *         SEARCH FOR UNDEFINED UNITS
  1015. * 
  1016.  CFINOV   OVRLAY
  1017. * 
  1018.           SX2    IEUNUM      SWITCH UNALPHABETICIZED UNIT-NAME-TABLE
  1019.           SA0    UNAME+X2      INTO PLACE OF ALPHABETICIZED 
  1020.           SA1    AUNAME      GET ECS LOCATION 
  1021.           IX0    X1+X2         START AT INITIAL ENTRY UNIT
  1022.           SA1    UNUMIN      GET NUMBER OF UNITS IN LESSON
  1023.           IX3    X1-X2       GET NUMBER TO SWITCH 
  1024.           SB1    X3 
  1025. +         RE     B1          SWITCH 
  1026.           RJ     ECSPRTY
  1027. * 
  1028. * 
  1029.           SB4    IEUNUM      PRE-START OF AUTHOR UNITS
  1030.           MX6    0
  1031.           SA6    UNUMON      SET FLAG FOR ERROR PLOTTING ROUTINE
  1032.           SA6    LOCAL      TURN OFF LOCALS PROCESSING
  1033. * 
  1034.  EULOOP0  SA1    UNUMIN 
  1035.           SB5    X1-1        B5 = NUMBER OF UNITS IN
  1036. * 
  1037.  EULOOP   GE     B4,B5,CNF1  JUMP IF DONE 
  1038.           SB4    B4+1 
  1039.           SA1    ULOC+B4     LOAD ULOC ENTRY
  1040.           PL     X1,EULOOP   JUMP IF UNIT DEFINED 
  1041.           LX1    1
  1042.           NG     X1,EULOOP   JUMP IF EXTERNAL UNIT
  1043.           LX1    11 
  1044.           MX0    48 
  1045.           BX2    X0*X1       X2 = UNIT NAME 
  1046.           MX0    36 
  1047.           SA1    KTUNIT      CHECK FOR -TUNIT-
  1048.           BX1    X1-X2
  1049.           BX1    X0*X1
  1050.           NZ     X1,CNFAA    EXIT IF NOT 30/TUNIT,6/0 
  1051.           BX1    X2 
  1052.           AX1    12          POSITION -TUNIT- UNIT NUMBER 
  1053.           SX1    X1 
  1054.           ZR     X1,CNFAA    -TUNIT- NUMBER MUST BE NON-ZERO
  1055.           NG     X1,CNFAA 
  1056.           SA2    X1+UNITTAB  X2 = UNIT NAME 
  1057. *   GET BLOCK AND LINE OF FIRST REFERENCE TO THIS UNIT
  1058.  CNFAA    SA1    AFUREF 
  1059.           SX6    B4 
  1060.           IX0    X6+X1
  1061.           SA6    ITEMP       SAVE B4
  1062.           SA0    =XHEAD 
  1063.           RE     1
  1064.           RJ     =XECSPRTY
  1065. * 
  1066.           SB1    904         UNIT CANNOT BE FOUND 
  1067.           MX1    59          -1 
  1068.           SB2    X1 
  1069.           RJ     =XRJERR2    X2 HAS UNIT NAME 
  1070. * 
  1071.           SA1    ITEMP
  1072.           SB4    X1          RESTORE B4 
  1073.           EQ     EULOOP0
  1074. * /---   BLOCK      CONDFIN2   00 000   77/09/17  16.43 
  1075. * 
  1076.  CNF1     CALL   MISAY       CHECK FOR MISSING SAYLANG
  1077.           SA1    SYSFLG      JUMP IF SYSTEM LESSON
  1078.           LX1    ZSLDSHF
  1079.           NG     X1,TRM1
  1080.           SA1    COMREFF     SEE IF TEMP VARIABLE REF 
  1081.           ZR     X1,TRM1
  1082.           SA1    CCOMLES     SEE IF ANY -COMMON-
  1083.           NZ     X1,TRM1
  1084.           SA1    XSTORL      SEE IF ANY -STORAGE- 
  1085.           NZ     X1,TRM1
  1086.           SA1    CCOMX       SEE IF ANY -COMMONX- 
  1087.           NZ     X1,TRM1
  1088.           SB1    100         *WARNING* TEMPORARY VARIABLE REFERENCES
  1089.           SB2    -1 
  1090.           SX1    B0 
  1091.           SX2    B0 
  1092.           RJ     =XRJERR2 
  1093.           EQ     TRM1 
  1094. * /---   BLOCK      CONDFIN3   00 000   77/06/18  18.21 
  1095. * 
  1096. * 
  1097. *     READ TERM TABLE FROM ECS INTO INFO, AND ALPHABETIZE IT
  1098. * 
  1099.  TRM1     SA1    CONDPNT     BUFFER POINTER 
  1100.           BX7    X1          SAVE 
  1101.           SA1    TERMS       GET NUMBER OF TERMS
  1102.           BX6    X1 
  1103.           SA6    INFO        FIRST WORD OF TERM TABLE IS NUMBER OF TERMS
  1104.           SB7    X1          NUMBER OF ENTRIES TO B7 FOR ECS READ 
  1105.           SA2    TERMEND     ENDING ECS ADDRESS OF TERMS
  1106.           SX0    X1-1 
  1107.           IX0    X2-X0       TERMS GO BACKWARDS INTO BUFFER 
  1108.           SA0    INFO+1 
  1109.  +        RE     B7          READ TERM TABLE INTO CM
  1110.  -        RJ     ECSPRTY
  1111.           BX0    X7          RESET X0 
  1112.           SB1    INFO        (B1) = ADDRESS OF TERM TABLE FOR CALL
  1113.           RJ     TSORT       ALPHABETIZE TERM TABLE 
  1114. * 
  1115. *     WRITE OUT FAKE UNIT 0 WHICH IS TERM TABLE 
  1116. * 
  1117.           SA2    INFO        NUMBER OF TABLE ENTRIES TO X2
  1118.           SA0    A2          ADDRESS OF TERM TABLE FOR ECS
  1119.           SX2    X2+1        LENGTH OF FAKE UNIT TO X2
  1120.           SA1    CONBUFF     ADDRESS OF CONDENSE BUFFER 
  1121.           IX6    X0-X1       BIAS TO TERM UNIT
  1122.           LX6    ULOC2
  1123.           BX6    X6+X2       UNIT LENGTH
  1124.           LX6    ULOC3+ULOC4
  1125.           BX6    X6+X2       AND THIS TOTAL LENGTH ALSO 
  1126.           LX6    60-ULOC1-ULOC2-ULOC3-ULOC4 
  1127.           SA6    ULOC        STORE ENTRY AT UNIT ZERO OF UNIT LOC TABLE 
  1128.           CALL   WRITECS     WRITE OUT FAKE UNIT
  1129. * 
  1130.           SA1    KOTERM      PUT PROPER NAME OF TERM IN UNIT-NAME TABLE 
  1131.           BX6    X1 
  1132.           SA6    UNAME       TERM IS FIRST UNIT IN TABLE
  1133. * 
  1134. * /---   BLOCK      -CONDFIN   00 000   81/06/29  12.27 
  1135. * 
  1136. *         WRITE OUT PPT-TUTOR UNIT TABLE = UNIT 3 
  1137. *         1ST WORD OF UNIT =
  1138. *            1ST   6 BITS = UNUSED
  1139. *            NEXT  9      = MAXIMUM NUMBER OF CHARACTERS
  1140. *            NEXT  9      = 1ST PHYSICAL UNIT NUMBER
  1141. *            NEXT 18      = DIMENSION OF VARIABLE AREA
  1142. *            NEXT 18      = NUMBER UNITS
  1143. * 
  1144.           BX7    X0          SAVE X0
  1145.           SA1    PUNITN      GET NUMBER OF PPT UNITS
  1146.           ZR     X1,PPTFN1
  1147.           SX1    X1+2        X1 = NUMBER OF TUNITS
  1148.           SA2    NVBYTES     GET NUMBER OF DEFINED BYTES
  1149.           LX2    18 
  1150.           BX6    X1+X2
  1151.           SA2    PISTU       GET 1ST PHYSICAL TUNIT NUMBER
  1152.           LX2    18+18
  1153.           BX6    X2+X6
  1154.           SA2    PCHRLIM     GET CHARSET LIMIT
  1155.           LX2    9+18+18
  1156.           BX6    X2+X6
  1157.           SA6    INFO        SET 1ST WORD OF UNIT 
  1158. * 
  1159.           SA2    ATEMPEC
  1160.           BX0    X2          ADDRESS OF TEMP ECS BUFFER 
  1161.           SB1    X1 
  1162.           SA0    UNITTAB
  1163. +         WE     B1          WRITE UNIT TABLE TO ECS
  1164.           RJ     ECSPRTY
  1165.           SA0    INFO+1 
  1166. +         RE     B1          READ TABLE BACK TO *INFO*
  1167.           RJ     ECSPRTY
  1168.           EQ     PPTFN2 
  1169. * 
  1170.  PPTFN1   MX6    0           CLEAR 1ST WORD OF UNIT 
  1171.           SA6    INFO 
  1172. * 
  1173.  PPTFN2   SX5    X1+1        X5 = LENGTH OF UNIT
  1174.           SA1    CONBUFF
  1175.           IX6    X7-X1       GET RELATIVE ADDRESS OF UNIT 
  1176.           LX6    60-ULOC1    X6 = ULOC ENTRY FORMING
  1177.           BX0    X7          X0 = ECS ADDRESS OF UNIT 
  1178.           SA0    INFO        A0 = CM  ADDRESS OF UNIT 
  1179.           BX2    X5          X2 = LENGTH OF UNIT
  1180.           BX3    X5          FORM CM LENGTH FIELD 
  1181.           LX3    60-ULOC1-ULOC2 
  1182.           BX6    X3+X6
  1183.           BX3    X5          FORM UNIT LENGTH FIELD 
  1184.           LX3    60-ULOC1-ULOC2-ULOC3-ULOC4 
  1185.           BX6    X3+X6
  1186.           SA6    ULOC+3      SET ULOC TABLE ENTRY 
  1187.           CALL   WRITECS     WRITE FAKE UNIT TO BINARY
  1188. * 
  1189. * /---   BLOCK      -CONDFIN   00 000   81/06/29  12.30 
  1190. * 
  1191. *         WRITE MICRO-TUTOR RELEASE LEVEL AND CENTRAL SYSTEM
  1192. *         EXECUTION FLAG TO LESSON HEADER 
  1193. * 
  1194.           BX7    X0          SAVE -X0-
  1195.           SA7    SVX0 
  1196.           MX0    -6 
  1197.           SA1    MTREL       GET MICRO-TUTOR RELEASE LEVEL
  1198.           BX6    -X0*X1 
  1199.           LX6    60-6        POSITION RELEASE LEVEL 
  1200.           SA1    MTCENF 
  1201.           ZR     X1,MTCF20   CHECK IF CENTRAL EXEC FLAG SET 
  1202.           SX1    1
  1203.           LX1    60-7        POSITION FLAG FOR *LMTUTWD*
  1204. * 
  1205.  MTCF20   BX6    X1+X6       MERGE CENTRAL EXECUTION FLAG 
  1206.           SA6    ITEMP
  1207.           SA1    CONBUFF     GET FWA OF BINARY BUFFER 
  1208.           SX0    LMTUTWD     BIAS TO MICRO-TUTOR WORD 
  1209.           IX0    X0+X1
  1210.           SA0    A6 
  1211. +         WE     1           WRITE OUT MICRO-TUTOR WORD 
  1212.           RJ     ECSPRTY
  1213. * 
  1214. * /---   BLOCK      DEFINES    00 000   81/01/07  18.46 
  1215. * 
  1216. *     WRITE OUT FAKE UNIT 1 WHICH IS DEFINE TABLE 
  1217. * 
  1218.           RJ     =XSETSET    SET UP PARAMETERS FOR DSET 
  1219.           SA1    KCSTUD 
  1220.           BX6    X1          SEE IF SET -STUDENT- EXISTS
  1221.           CALL   FINDSET
  1222.           NG     B1,NODEFN   JUMP IF NO SET -STUDENT- 
  1223.           RJ     =XGETSET 
  1224.           SA1    NDEFN
  1225.           SA2    TOKWRD 
  1226.           IX1    X1+X2       COMPUTE TOTAL LENGTH OF DEFINES
  1227.           SX1    X1-UNITLTH+2  CHECK IF DEFINE SET TOO BIG
  1228.           PL     X1,DEFBIG
  1229. * 
  1230.  DEF2     SA2    ATEMPEC     ADDRESS OF TEMPORARY ECS 
  1231.           SA1    AVAR        ADDRESS OF DEFINED NAMES 
  1232.           SA3    NDEFN       NUMBER OF DEFINED NAMES
  1233.           SA0    VARS        LOC OF BUFFER FOR MOVE 
  1234.           SB1    VARLONG     LENGTH OF BUFFER FOR MOVE
  1235.           IX6    X2+X3       DESTINATION OF NEXT MVECS
  1236.           SA6    DESTAVE
  1237.           RJ     =XMVECS     MOVE NAMES INTO BUFFER 
  1238. * 
  1239.           SA1    ATOKEN      SOURCE ECS ADDRESS 
  1240.           SA2    DESTAVE     DESTINATION ECS ADDRESS
  1241.           SA3    TOKWRD      LENGTH OF MOVE 
  1242.           SA0    VARS        LOC OF BUFFER FOR MOVE 
  1243.           SB1    VARLONG     LENGTH OF BUFFER FOR MOVE
  1244.           RJ     =XMVECS     MOVE TOKENS INTO BUFFER
  1245.           SA1    TOKWRD 
  1246.           SB1    X1 
  1247.           SA2    NDEFN
  1248.           SB1    B1+X2       LENGTH OF STUDENT DEFINE SET 
  1249.           SA3    ATEMPEC
  1250.           BX0    X3 
  1251.           SA0    INFO+1      LEAVE ROOM FOR HEADER WORD 
  1252. +         RE     B1          READ IN ENTIRE SET 
  1253.           RJ     ECSPRTY
  1254.           SB4    B1+1        LENGTH OF SET+HEADER=UNITLEN 
  1255.           SB1    X2          NDEFN
  1256.           SB2    X1          TOKWRD 
  1257. * /---   BLOCK      DEFINES    00 000   81/01/07  18.45 
  1258. * 
  1259.  DEFXX    SA2    SVX0 
  1260.           BX0    X2          RESTORE -X0- 
  1261.           SA2    CONBUFF     ADDRESS OF CONDENSE BUFFER 
  1262.           IX6    X0-X2       BIAS TO DEFINE UNIT
  1263.           LX6    ULOC2
  1264.           SX2    B4          COMPUTE LENGTH OF DEFINE UNIT
  1265.           BX6    X6+X2
  1266.           LX6    ULOC3+ULOC4          POSITION ULOC ENTRY 
  1267.           BX6    X6+X2       AGAIN FOR TOTAL LENGTH 
  1268.           LX6    60-ULOC1-ULOC2-ULOC3-ULOC4 
  1269.           SA6    ULOC+1      AND ADD TO ULOC TABLE
  1270.           SA1    KODEF       GET PROPER NAME FOR THIS FAKE UNIT 
  1271.           BX7    X1 
  1272.           SA7    UNAME+1     DEFINE IS ALWAYS SECOND UNIT IN TABLES 
  1273.           SX7    B2          FORM HEADER WORD 
  1274.           LX7    18 
  1275.           SX1    B1          NUMBER OF DEFINES
  1276.           BX7    X7+X1       ADD NUMBER OF TOKEN WORDS
  1277.           SA1    NDEFU       NUMBER OF UNITS (DIMENSIONS) 
  1278.           LX1    18+18
  1279.           BX7    X1+X7       MERGE WITH REST OF HEADER WORD 
  1280.           SA7    INFO        STORE HEADER WORD
  1281.           SA0    A7 
  1282.           CALL   WRITECS     WRITE OUT UNIT 
  1283.           BX7    X0          PRESERVE X0
  1284.           SA1    CONBUFF
  1285.           SX2    LDEFNWD     BIAS TO DEFINE INFO WORD 
  1286.           IX0    X1+X2
  1287.           SA0    INFO 
  1288. +         WE     1           WRITE DEFINE INFO WD TO HEADER 
  1289.           RJ     ECSPRTY
  1290.           BX0    X7          RESTORE X0 
  1291.           EQ     COMWRT 
  1292.  DESTAVE  BSS    1
  1293. * 
  1294.  DEFBIG   SB1    101         STUDENT DEFINE SET TOO BIG 
  1295.           SB2    -1 
  1296.           SX1    B0 
  1297.           SX2    B0 
  1298.           RJ     =XRJERR2 
  1299.           EQ     NODEFN 
  1300. * 
  1301.  NODEFN   SB1    B0          CLEAR NAME COUNT 
  1302.           SB2    B1          CLEAR TOKEN WORD COUNT 
  1303.           SB4    1           ONE WORD FOR HEADER
  1304.           MX6    0
  1305.           SA6    NDEFU       CLEAR DEFINED NAMES COUNT
  1306.           EQ     DEFXX       WRITE OUT EMPTY UNIT 
  1307. * 
  1308.  SVX0     BSS    1
  1309. * /---   BLOCK      CONDFIN5   00 000   81/07/28  01.39 
  1310. * 
  1311. *      WRITE LESSON TABLES
  1312. * 
  1313.  COMWRT   SA0    UNAME
  1314.           SA2    UNUMIN      LENGTH OF UNIT TABLE TO X2 
  1315.           CALL   WRITECS     WRITE UNIT NAME TABLE
  1316.           SA0    ULOC 
  1317.           CALL   WRITECS     WRITE UNIT LOC TABLE 
  1318.           SA3    CONBUFF     ADDRESS OF CONDENSE BUFFER 
  1319.           IX7    X0-X3       LENGTH OF LESSON 
  1320.           SA7    CONDPNT     STORE FOR ERRORS PAGE
  1321.           IX6    X7-X2       BIAS TO ULOC TABLE 
  1322.           LX6    12 
  1323.           BX6    X6+X2       LENGTH OF ULOC TABLE 
  1324.           LX6    12 
  1325.           SA6    CONDPRM     PUT INTO *CONDPRM* FOR RETURN
  1326.           SX2    CBWARN      CHECK FOR BIN SIZE WARNING 
  1327.           IX1    X2-X7
  1328.           PL     X1,CONDF2   JUMP IF NOT NEAR MAX LIMIT 
  1329.           SB1    102        *WARNING* BINARY ALMOST TOO LONG
  1330.           SB2    -1 
  1331.           SX1    B0 
  1332.           SX2    B0 
  1333.           RJ     =XRJERR2 
  1334. * 
  1335. *         -ERRFIN-   (GENERATE MAIN HEADER FOR ERROR BUFFER)
  1336. * 
  1337. *         1ST WORD IS NUMBER OF ERRORS SAVED IN CEBUF 
  1338. *         2ND WORD IS ACCOUNT NAME
  1339. *         3RD WORD IS LESSON NAME 
  1340. *         4TH WORD IS 20/TOTAL NUMBER OF ERRORS 
  1341. *                     20/NUMBER OF UNITS
  1342. *                     20/LESSON LENGTH
  1343. * 
  1344.  CONDF2   RJ     =XEBH       BUILD ERROR BUFFER HEADER
  1345. * /---   BLOCK      CONSTAT    00 000   81/02/24  16.45 
  1346. * 
  1347. *         FINISH UP COMMAND AND LESSON CONDENSING STATISTICS
  1348. * 
  1349.           SA1    TSCOMFG
  1350.           PL     X1,STATCFN  STATISTICS ON = -1 
  1351.           CALL   PSTCMS1     TAKE COMMAND STATS 
  1352.  STATCFN  SB1    1
  1353.           SA3    ACLSTAT     ECS ADDR OF LESSON STAT BANK 
  1354.           BX0    X3 
  1355.           SA0    VARBUF      TEMPORARY BUFFER 
  1356. +         RE     SCLESL      LENGTH OF STATISTICS BANK
  1357.           RJ     =XECSPRTY
  1358. * 
  1359.           SX2    B1 
  1360.           SA1    A0+SCUNITS 
  1361.           IX6    X1+X2       ADD 1 TO NUMBER OF UNITS CONDENSED 
  1362.           SA2    CUNITS      AND GET UNITS CONDENSED THIS LESSON
  1363.           IX6    X6+X2
  1364.           SA6    A1 
  1365. * 
  1366.           SA1    A0+SCLINES 
  1367.           SA2    =XCLINES 
  1368.           IX6    X1+X2       ADD TO TOTAL LINES CONDENSED 
  1369.           SA6    A1 
  1370.           SX6    B0 
  1371.           SA6    A2          CLEAR CLINES 
  1372. * 
  1373.           SA1    A0+SCNFIO
  1374.           SA2    =XNFIOR     ADD TO TOTAL FIO REQUESTS
  1375.           IX6    X1+X2
  1376.           BX7    X7-X7
  1377.           SA6    A1 
  1378.           SA7    A2          CLEAR FIO REQUESTS 
  1379. * 
  1380.           SA1    A0+SCNBRQ   ADD TO TOTAL BINARY BUF INCR 
  1381.           SA2    =XWECSC
  1382.           IX6    X1+X2
  1383.           BX7    X7-X7
  1384.           SA6    A1 
  1385.           SA7    A2          CLEAR REQUEST COUNT
  1386.           SA1    A0+SCDSKS   UPDATE DISK STATISTICS 
  1387.           SA2    =XNFIOR+1   COUNT I/O REQUESTS 
  1388.           IX6    X1+X2
  1389.           SA6    A1 
  1390.           SA7    A2 
  1391.           SA1    A1+1        COUNT BLOCKS READ
  1392.           SA2    A2+1 
  1393.           IX6    X1+X2
  1394.           SA6    A1 
  1395.           SA7    A2 
  1396. * 
  1397.           CALL   S=CTIME,TWD  GET CPU CLOCK 
  1398.           SB1    1           (B1) = 1 
  1399.           SA1    SYSCLOK
  1400.           SA2    RTBEG
  1401.           SA3    A0+SRMILS
  1402.           IX2    X1-X2       (X2) = REAL TIME FOR CONDENSE
  1403.           IX6    X2+X3
  1404.           SA6    A3 
  1405.  
  1406.           SA1    TWD
  1407.           SA3    CTBEG
  1408.           SA4    A0+SCMILS
  1409.           IX3    X1-X3       (X3) = CPU TIME FOR CONDENSE 
  1410.           IX6    X3+X4
  1411.           SA6    A4 
  1412. * /---   BLOCK      CONSTAT    00 000   81/02/24  16.46 
  1413.  
  1414. *         PUSH DOWN STACK OF LAST 5 CONDENSE CPU TIMES
  1415. *         SAVE RUNNING RATIO FOR STATS
  1416.  
  1417.           LX3    30 
  1418.           IX3    X3+X2
  1419.           SB2    5-2
  1420.           BX6    X3          (X6) = CPU RATIO 
  1421.  STATFN0  SA1    CTIME+B2 
  1422.           IX6    X1+X6
  1423.           BX7    X1 
  1424.           SA7    CTIME+1+B2 
  1425.           SB2    B2-B1
  1426.           GE     B2,STATFN0  IF MORE TO MOVE
  1427.           BX7    X3 
  1428.           SA7    CTIME       PUT NEW ENTRY ON TOP OF STACK
  1429.           SA1    CONDN       SAVE THIS CONDENSORS RATIO 
  1430.           SB2    X1+SCPUA 
  1431.           SA6    A0+B2
  1432.           SA1    A0+CLESMAX 
  1433.           IX1    X1-X2
  1434.           PL     X1,STATFN1 
  1435.           BX6    X2 
  1436.           SA6    A1          REPLACE WITH NEW MAX TIME
  1437.           SA1    LESSON      GET LESSON NAME
  1438.           BX6    X1 
  1439.           SA6    A0+CMAXNAM  THIS LESSSON TOOK MAX CONDENSE TIME
  1440. * 
  1441. * 
  1442.  STATFN1  SA1    A0+CLESMIN 
  1443.           ZR     X1,STATFN2 
  1444.           IX1    X2-X1
  1445.           PL     X1,STATFN3 
  1446.  STATFN2  BX6    X2 
  1447.           SA6    A1          REPLACE WITH NEW MIN TIME
  1448. * 
  1449.  STATFN3  SA2    USEBCNT
  1450.           ZR     X2,STATFN9  EXIT IF NO -USE- COMMAND 
  1451. * 
  1452.           SA1    A0+SCUSES
  1453.           SA3    USEINFO
  1454.           IX6    X1+X3       COUNT NUMBER OF FILES USE-D
  1455.           SA6    A1 
  1456. * 
  1457.           SA1    A0+SCUBLKS 
  1458.           IX6    X1+X2       X2 HOLDS USEBCNT 
  1459.           SA6    A1 
  1460. * 
  1461.           SA1    A0+SCUNFIO  USE FILE FIO REQUESTS
  1462.           SA2    =XNFIOR+3
  1463.           IX6    X1+X2       ADD USE FILE FIO REQUESTS
  1464.           BX7    X7-X7
  1465.           SA6    A1 
  1466.           SA7    A2          CLEAR USE FILE FIO REQUESTS
  1467. * 
  1468. * 
  1469.  STATFN9  WE     SCLESL 
  1470.           EQ     =XECSPRTY
  1471. * 
  1472. * /---   BLOCK      (N)CONDFIN 00 000   81/01/16  13.37 
  1473. * 
  1474. *         RETURN CONDENSE INFO TO PLATO 
  1475. * 
  1476.           SA5    APLACOM     (X5) = PLATO COMMUNICATION AREA
  1477.           SX0    PC.INFO
  1478.           IX0    X0+X5
  1479.           SA0    CONDPRM     RETURN CONDENSE INFO 
  1480. +         WE     1
  1481.           RJ     ECSPRTY
  1482. * 
  1483.           SX0    PC.INF1
  1484.           IX0    X0+X5
  1485.           SA0    =XERRTOT    WRITE OUT NUMBER CONDENSE ERRS 
  1486. +         WE     1
  1487.           RJ     ECSPRTY
  1488. * 
  1489.           SX0    PC.INF2
  1490.           IX0    X0+X5
  1491.           SA0    =XZCONDOK   WRITE OUT ZCONDOK FLAG 
  1492. +         WE     1
  1493.           RJ     ECSPRTY
  1494. * 
  1495.           SX0    PC.COM 
  1496.           IX0    X0+X5
  1497.           SA0    CCOMACT     RETURN COMMON INFO 
  1498. +         WE     5
  1499.           RJ     ECSPRTY
  1500.  
  1501. *         COMBINE NUMBER OF STORAGE VARIABLES AND NUMBER
  1502. *         OF ROUTER VARIABLES.  SAVE FOR MERGING WITH 
  1503. *         THE ROUTER LESSON AND NC VARIABLES FLAGS. 
  1504.  
  1505.           SA2    RVARL       NUMBER OF ROUTER VARIABLES 
  1506.           SA1    XSTORL      NUMBER OF STORAGE VARIABLES
  1507.           LX2    RVARSH      POSITION ROUTER VAR BANK SIZE
  1508.           BX0    X1+X2
  1509.           SA1    LVARL       SIZE OF LOCALS STACK 
  1510.           PL     X1,LVARL1   IF LVARL IS SPECIFIED
  1511. * 
  1512.           MX1    0           MAKE SURE NO NEGATIVE VALUES 
  1513.  LVARL1   LX1    LVARSH      POSITION LOCAL VAR STACK SIZE
  1514.           BX0    X0+X1       10LVARL/18RVARL/18XSTORL 
  1515. * /---   BLOCK      CONDFIN    00 000   81/01/07  18.47 
  1516.  
  1517. *         GET AND POSITION ROUTER LESSON, -CCODE- COMMAND,
  1518. *         AND NC VARIABLES FLAG FOR THE LESSON HEADER.
  1519.  
  1520.           SA1    ROUTER      ROUTER LESSON FLAG 
  1521.           LX1    RVARF
  1522.           SA3    CCDFLG      -CCODE- COMMAND
  1523.           SA4    COMREFF     NC VARIABLES 
  1524.           LX3    CCODEF 
  1525.           SX7    PC.FLAG
  1526.           ZR     X4,M200     IF NO NC VARIABLES 
  1527.           MX4    1
  1528.           LX4    NCVARF-59
  1529.  M200     BX6    X1+X3
  1530.           BX6    X4+X6
  1531.           BX6    X0+X6       MERGE ROUTER / STORAGE VARS LTH
  1532.  
  1533. *         WRITE THE FLAGS, ROUTER VARIABLE LENGTH,
  1534. *         STORAGE VARIABLE LENGTH AND LOCALS STACK SIZE.
  1535.  
  1536.           IX0    X7+X5
  1537.           WX6    X0 
  1538.  
  1539.           SX0    PC.DIR      RETURN ADDRESS OF DIRECTORY
  1540.           SA0    AFILEBF
  1541.           IX0    X0+X5
  1542.           WE     1
  1543.           RJ     ECSPRTY
  1544.           SX0    PC.ERR      RETURN ADDRESS OF ERROR BUFFER 
  1545.           SA0    ACEBUF 
  1546.           IX0    X0+X5
  1547.           WE     1
  1548.           RJ     ECSPRTY
  1549.           SX0    PC.USE 
  1550.           SA0    USEINFO     WRITE USE FILE INFORMATION 
  1551.           IX0    X0+X5
  1552.           WE     USEINFL
  1553.           RJ     ECSPRTY
  1554.           SX6    P.DONE      SET PLATO REQUEST CODE 
  1555.           SA6    PLREQC 
  1556.           EQ     CONDENS     EXIT 
  1557. * 
  1558. * /---   BLOCK      TSORT      00 000   81/01/07  18.48 
  1559. * 
  1560. * 
  1561. *         -TSORT- 
  1562. *         ROUTINE TO SORT TERM TABLE AT END OF LESSON READIN. 
  1563. * 
  1564. *         DOES BUBBLE SORT TO PUT TERM TABLE IN ORDER OF ASCENDING
  1565. *         NUMERICAL VALUE.
  1566. * 
  1567. *         AT ENTRY, 
  1568. *            (B1) = ADDRESS OF TERM TABLE 
  1569. * 
  1570. *         TERM TABLE IS ARRANGED SUCH THAT--
  1571. *            1) FIRST ENTRY IS NUMBER OF TERMS
  1572. *            2) ALL FOLLOWING ENTRIES ARE TERMS 
  1573. *         TERMS ARE 8 CHARS, RIGHT JUSTIFIED. 
  1574. *         THE UPPER 12 BITS ARE THE UNIT NUMBER 
  1575. *         THAT THE TERM IS TO BRANCH TO.
  1576. * 
  1577. *         IN CASE OF DOUBLE TERMS, BRANCHING IS UNPREDICTABLE.
  1578. * 
  1579. * 
  1580. *         THIS ROUTINE PRESERVES X0 
  1581. * 
  1582. * 
  1583. * 
  1584.  TSORT    EQ     *
  1585.           SA1    B1          LOAD NUMBER OF TERMS 
  1586.           ZR     X1,TSORT    EXIT NO TERMS
  1587.           SB2    B1+1        ADDRESS OF FIRST ENTRY TO B2 
  1588.           SB1    1           UIC TO B1
  1589.           SB7    X1-1        OFFSET OF LAST ENTRY TO B7 
  1590.           ZR     B7,TSORT    EXIT ONE TERM
  1591.           MX7    12          MASK OFF UNIT POINTER
  1592.           SB6    B1          SET MODIFY FLAG NON-ZERO 
  1593. * 
  1594.  LOOP     ZR     B6,TSORT    DONE IF NO MODIFICATION ON LAST PASS 
  1595.           SB3    B0 
  1596.           SB6    B0          RESET FLAG FOR NEXT PASS 
  1597. * 
  1598.  PASS     EQ     B3,B7,LOOP  IF END OF PASS, GO START NEXT ONE
  1599.           SA1    B2+B3       LOAD TERM1 
  1600.           SB3    B3+B1
  1601.           SA2    B2+B3       LOAD TERM2 
  1602.           BX3    -X7*X1 
  1603.           BX4    -X7*X2 
  1604.           IX5    X4-X3
  1605.           PL     X5,PASS     IF TERMS IN INCREASING ORDER, GO ON TO NEXT
  1606. * 
  1607.           SB6    B6+B1       SET FLAG THAT MODIFICATION DONE THIS PASS
  1608.           BX6    X2 
  1609.           SA6    A1          SWITCH TERMS TO CORRECT ORDER
  1610.           BX6    X1 
  1611.           SA6    A2 
  1612.           EQ     PASS        GO DO NEXT SET 
  1613. * 
  1614.  KCSTUD   DATA   7LSTUDENT
  1615.  KCZER    DATA   0
  1616.  KOTERM   VFD    12/0,48/4LTERM 
  1617.  KODEF    VFD    12/0,48/6LDEFINE 
  1618.  KTUNIT   DATA   0LTUNIT
  1619.  KBLANK   DATA   10L               BLANKS 
  1620.           DATA   0
  1621. * 
  1622.           ENDOV 
  1623. * /---   BLOCK      JMPFOV     00 000   81/01/28  03.57 
  1624.           TITLE  -JUMPOUT-, -FROM-, -ARGS- COMMANDS 
  1625. * 
  1626.  JMPFOV   OVRLAY
  1627.           SA1    OVARG1 
  1628.           SB3    X1 
  1629.           JP     B3+* 
  1630. * 
  1631. +         EQ     JMPO        1 = -JUMPOUT-
  1632. +         EQ     FRM         2 = -FROM- 
  1633. +         EQ     ARGS        3 = -ARGS- 
  1634. +         EQ     FILED       4 = -FILEDIT-
  1635.  
  1636. *         -FILEDIT- COMMAND IS CONDENSED AS -JUMPOUT- EXCEPT
  1637. *         THAT THE BLANK-TAG FORM IS NOT ALLOWED. 
  1638.  
  1639.  FILED    SA1    TAGCNT      CHECK FOR BLANK TAG
  1640.           NZ     X1,JMP1     TREAT AS -JUMPOUT- IF > 0 TAGS 
  1641.           EQ     =XERR2FEW   CONDENSE ERROR IF BLANK TAG
  1642. ****
  1643. * 
  1644. *         -JUMPOUT- COMMAND 
  1645. *         JUMP TO SPECIFIED UNIT OF ANOTHER LESSON
  1646. * 
  1647.  JMPO     SA1    TAGCNT      CHECK FOR BLANK TAG
  1648.           ZR     X1,JOUT0 
  1649.  JMP1     SX6    -1          FLAG -JUMPOUT- COMMAND 
  1650.           EQ     JMPI 
  1651. ****
  1652. * 
  1653. *         -FROM- COMMAND
  1654. *         DETERMINE WHICH LESSON LAST -JUMPOUT- WAS FROM
  1655. * 
  1656.  FRM      SA1    TAGCNT      CHECK FOR BLANK TAG
  1657.           ZR     X1,ERR2FEW 
  1658.           MX6    0           FLAG -FROM- COMMAND
  1659. * 
  1660. * 
  1661.  JMPI     SA6    JOTYPE      REMEMBER COMMAND TYPE
  1662.           SA1    NEXTCOM
  1663.           SA2    COMCONT     CHECK FOR CONTINUED COMMAND
  1664.           BX2    X1-X2
  1665.           ZR     X2,JO100    MUST BE CONDITIONAL
  1666. * 
  1667.           SA1    WORDPT      X1 = POINTER TO FIRST CHARACTER
  1668.           MX0    0           NO SPECIAL TERMINATORS 
  1669.           CALL   PSCAN       FIND END OF FIRST TAG
  1670.           NZ     B2,ERRBAL   ERROR IF UNBALANCED PARENS 
  1671.           NZ     B3,ERRBAL   ERROR IF UNBALANCED QUOTES 
  1672. * 
  1673.           SX0    X1-1R;      CHECK FOR CONDITIONAL COMMAND
  1674.           NZ     X0,JOUT1    JUMP IF SURE NOT 
  1675.           SA1    B1-1        DISCRIMINATE ; AND ';
  1676.           SX0    X1-KUP 
  1677.           ZR     X0,JOUT1 
  1678. * 
  1679. * 
  1680. * /---   BLOCK      JO100      00 000   81/01/12  17.56 
  1681. * 
  1682. *         CONDITIONAL -JUMPOUT- / -FROM-
  1683. * 
  1684.  JO100    MX6    0           INITIALIZE NUMBER OF ENTRIES 
  1685.           SA6    NJNAM       AND FLAG TO EXTRACT LITERALS 
  1686. * 
  1687. * EVALUATE FIRST ARGUMENT -- CONDITION / RETURN 
  1688. * 
  1689.           SA1    JOTYPE 
  1690.           NZ     X1,JO102    JUMP IF NOT -FROM- COMMAND 
  1691.           CALL   PUTCOMP     COMPILE CODE TO STORE INTO VAR 
  1692.           EQ     JO103
  1693. * 
  1694.  JO102    CALL   COMPILE     EVALUATE EXPRESSION
  1695.  JO103    MX6    1
  1696.           LX1    60-XCODEL   POSITION -GETVAR- CODE 
  1697.           BX6    X1+X6       SET SIGN BIT FOR CONDITIONAL 
  1698.           SA6    JGCODE      PARTIAL COMMAND WORD 
  1699. * 
  1700. * LOOP THROUGH EACH SET OF [ACCOUNT';]LESSON[,UNIT][(ARGS)] 
  1701. * 
  1702.  JO200    SA1    WORDPT 
  1703.           SA2    X1 
  1704.           ZR     X2,JO300    CHECK IF AT EOL
  1705. * 
  1706.           CALL   JOPARSE     EVALUATE NEXT SET OF TAGS
  1707. * 
  1708. *         X1 = LAST TERMINATOR
  1709. * 
  1710.  JO250    SA2    NJNAM       NUMBER OF ENTRIES
  1711.           SX0    X2-200 
  1712.           PL     X0,ERR2MNY  -- EXIT IF OVERFLOW
  1713.           SX7    X2+1 
  1714.           SA7    A2 
  1715.           LX2    1           X2 = OFFSET IN TABLE 
  1716. * 
  1717.           SA3    JACCNAM     FIRST WORD = ACCOUNT+LESSON
  1718.           SA4    JLESNAM
  1719.           LX3    XCODEL 
  1720.           BX6    X3+X4
  1721.           SA6    X2+JMPBUFF 
  1722. * 
  1723.           SA3    JUNIT       SECOND WORD = UNIT + ARGS
  1724.           SA4    JPARGFL
  1725.           MX0    6           CHECK FOR LITERAL UNIT NAME
  1726.           BX0    X0*X3
  1727.           NZ     X0,JO275 
  1728.           LX3    XCODEL      SHIFT OVER IF NOT LITERAL
  1729. * /---   BLOCK      JO275      00 000   81/01/20  01.19 
  1730. * 
  1731. *         COME HERE WITH X1 = *LASTKEY* 
  1732. * 
  1733.  JO275    BX6    X3+X4
  1734.           SA6    X2+JMPBUFF+1 
  1735.           NZ     X1,JO200    JUMP IF NOT END-OF-LINE
  1736. * 
  1737.  JO300    SA1    NEXTCOM     CHECK FOR CONTINUED COMMAND
  1738.           SA2    COMCONT
  1739.           BX2    X1-X2
  1740.           NZ     X2,JO400    EXIT IF NOT CONTINUED
  1741.           CALL   GETLINE     READ-IN NEXT LINE
  1742.           EQ     JO200
  1743. * 
  1744.  JO400    SA1    NJNAM       NUMBER OF ENTRIES
  1745.           LX1    1
  1746.           SB1    X1          LENGTH OF LESSON/UNIT TABLE
  1747.           SA1    ATEMPEC
  1748.           BX0    X1          ADDRESS OF TEMP ECS BUFFER 
  1749.           SA0    JMPBUFF
  1750. +         WE     B1          MOVE TO TEMP ECS BUFFER
  1751.           RJ     ECSPRTY
  1752.           SA4    INX         EXTRA STORAGE POINTER
  1753.           SX7    X4+B1       UPDATE POINTER 
  1754.           SA7    A4 
  1755.           SA0    X4+INFO
  1756. +         RE     B1          MOVE TABLE TO *INFO* 
  1757.           RJ     ECSPRTY
  1758.           SA1    JGCODE      LOAD -GETVAR- CODE 
  1759.           LX4    60-XCODEL-12 
  1760.           BX6    X1+X4       MERGE CODE AND ADDRESS OF TABLE
  1761.           SA2    NJNAM
  1762.           SA3    JOTYPE 
  1763.           ZR     X3,JO410    CHECK FOR -FROM- COMMAND 
  1764.           SX0    X2-2        MUST BE AT LEAST 2 ENTRIES 
  1765.           NG     X0,ERR2FEW 
  1766. * 
  1767.  JO410    LX2    60-XCODEL-24 
  1768.           BX6    X2+X6       ATTACH NUMBER OF ENTRIES 
  1769.           EQ     PUTCODE
  1770. * 
  1771. * /---   BLOCK      JOUT0      00 000   81/01/20  02.56 
  1772. * 
  1773. *         BLANK-TAG -JUMPOUT- 
  1774. * 
  1775.  JOUT0    MX6    0
  1776.           EQ     PUTCODE
  1777. * 
  1778. * 
  1779. *         UNCONDITIONAL -JUMPOUT- 
  1780. * 
  1781.  JOUT1    SA1    JOTYPE      CHECK FOR  -FROM- COMMAND
  1782.           ZR     X1,FOLD
  1783. * 
  1784.           SX6    -1          LEAVE LITERALS IN XSTOR
  1785.           SA6    NJNAM
  1786.           CALL   JOPARSE     GET TAGS 
  1787.           SA1    LASTKEY     CHECK TERMINATOR 
  1788.           NZ     X1,ERR2MNY  -- ERROR IF MORE TAGS
  1789. * 
  1790.           SA1    JACCNAM     RETRIEVE TAGS
  1791.           SA2    JLESNAM
  1792.           SA3    JUNIT
  1793.           SA4    JPARGFL
  1794. * 
  1795.           LX1    2*XCODEL    FORM COMMAND WORD
  1796.           LX2    1*XCODEL 
  1797.           BX6    X1+X2       X6 = ACCOUNT/LESSON CODES
  1798. * 
  1799.           MX0    6           FORM UNIT/ARGS WORD
  1800.           BX0    X0*X3       CHECK FOR LITERAL UNIT NAME
  1801.           NZ     X0,JOUT1A
  1802.           LX3    XCODEL      SHIFT OVER IF NOT LITERAL
  1803. * 
  1804.  JOUT1A   BX7    X3+X4       X7 = UNIT/ARGS WORD
  1805.           ZR     X7,PUTCODE  -- EXIT IF NO UNIT OR ARGS 
  1806.           SA1    INX         GET INDEX IN XSTOR 
  1807.           SA7    X1+INFO     AND PUT UNIT/ARGS THERE
  1808.           SX7    X1+1        X7 = [XSTOR+1] 
  1809.           SA7    A1          UPDATE INDEX 
  1810.           LX7    XCMNDL      PUT POINTER INTO COMMAND WORD
  1811.           BX6    X6+X7
  1812.           EQ     PUTCODE     -- EXIT
  1813. * 
  1814. * /---   BLOCK      FOLD       00 000   81/01/15  04.45 
  1815. * 
  1816. *         VARIABLE -FROM- COMMAND 
  1817. * 
  1818.  FOLD     CALL   PUBERRS,FSFROM 
  1819. * 
  1820.           MX6    0
  1821.           SA6    JLESNAM     PRESET COMMAND WORD
  1822. * 
  1823.           CALL   COLONCK     CHECK FOR ACCOUNT NAME 
  1824.           NZ     X6,FOLD10   -- NO ACCOUNT NAME 
  1825.           CALL   COMPILE     GET ACCOUNT *GETVAR* CODE
  1826.           NZ     B1,ERRSTOR  -- ERROR IF NOT STOREABLE
  1827.           BX6    X1 
  1828.           LX6    60-XCODEL   POSITION IT
  1829.           SA1    INX
  1830.           SX7    X1+1 
  1831.           SA6    X1+INFO     PUT IT IN XSTOR
  1832.           SA7    A1          AND UPDATE XSTOR POINTER 
  1833.           LX7    XCMNDL 
  1834.           SA7    JLESNAM     STORE [XSTOR+1] OF ACCOUNT 
  1835. * 
  1836.  FOLD10   CALL   COMPILE     GET LESSON -GETVAR- CODE 
  1837.           NZ     B1,ERRSTOR 
  1838.           SA2    JLESNAM     RECALL ACCOUNT ADDRESS (IF ANY)
  1839.           LX1    60-XCODEL
  1840.           BX6    X1+X2       X6 = COMMAND WORD
  1841.           SA2    LASTKEY     SEE IF EOL 
  1842.           ZR     X2,PUTCODE  JUMP IF ONLY ONE TAG 
  1843.           SA6    JLESNAM     SAVE WHAT WE HAVE SO FAR 
  1844. * 
  1845.           CALL   COMPILE     UNIT -GETVAR- CODE 
  1846.           NZ     B1,ERRSTOR 
  1847.           SA2    JLESNAM
  1848.           LX1    60-2*XCODEL
  1849.           BX6    X1+X2       MERGE LESSON AND UNIT CODES
  1850.           EQ     PUTCODE
  1851. * /---   BLOCK      JOPARSE    00 000   81/01/17  20.49 
  1852. * 
  1853.           TITLE  -JOPARSE-
  1854. * 
  1855. *         -JOPARSE-          PROCESS NEXT SET OF TAGS 
  1856. * 
  1857. *         OBTAINS THE NEXT   ACCOUNT';LESSON,UNIT(ARGS) 
  1858. * 
  1859. *         ENTER WITH
  1860. *                *WORDPT*    = START OF TAG SET 
  1861. *                *NJNAM*     < 0 IF WANT *GETVAR* CODES 
  1862. *                           >= 0 IF WANT LITERALS 
  1863. * 
  1864. *         SETS';  *JACCNAM*, *JLESNAM*, *JUNIT*, *JPARGFL*
  1865. * 
  1866. * 
  1867.  JOPARSE  EQ     *
  1868. * 
  1869. *         LOOK FOR ARGUMENTS -- SET *ENDPNT* IF FOUND 
  1870. * 
  1871.           SB1    0           B1 = IF IN LESLIST REFERENCE 
  1872.           SX4    1R;         X4 = PREVIOUS CHAR 
  1873.           MX5    0           X5 = PAREN DEPTH 
  1874.           MX6    -1          X6 = NO ARGUMENTS PRESENT
  1875.           SA1    WORDPT 
  1876.           SA1    X1-1 
  1877. * 
  1878.  JOP100   SA1    A1+1        EXAMINE NEXT CHAR
  1879.           SX0    X1-1R
  1880.           ZR     X0,JOP100   SKIP SPACES
  1881.           SA2    X1+KEYTYPE 
  1882.           SX0    X2-OP(      CHECK FOR L-PAREN
  1883.           ZR     X0,JOP150
  1884.           SX0    X2-OP)      CHECK FOR R-PAREN
  1885.           ZR     X0,JOP160
  1886.           SX0    X2-OPLT     CHECK FOR LESS-THAN
  1887.           ZR     X0,JOP170
  1888.           SX0    X2-OPGT     CHECK FOR GREATER-THAN 
  1889.           ZR     X0,JOP180
  1890. * 
  1891.           ZR     X1,JOP200   STOP AT EOL
  1892.           SX0    X1-1R;        OR SEMI-COLON
  1893.           NZ     X0,JOP110
  1894.           SX0    X4-KUP      MAKE SURE NOT A COLON
  1895.           NZ     X0,JOP200
  1896. * 
  1897.  JOP110   BX4    X1          REMEMBER THIS CHARACTER
  1898.           EQ     JOP100      LOOP BACK
  1899. * /---   BLOCK      JOPARSE    00 000   81/01/20  02.38 
  1900. * 
  1901. *         HANDLE PARENS AND VARIABLE TAGS 
  1902. * 
  1903.  JOP150   BSS    0           L-PAREN -- MIGHT BE ARGS 
  1904.           NZ     X5,JOP155   NOT IF ALREADY IN PARENS 
  1905.           NZ     B1,JOP155     OR IF IN LESLIST REFERENCE 
  1906.           SA2    X4+KEYTYPE    OR IF FIRST CHAR IN NEW TAG
  1907.           SX0    X2-OPCOMMA 
  1908.           ZR     X0,JOP155
  1909.           PL     X6,ERRUARG  -- ERROR IF ALREADY HAVE ARGS
  1910.           SX7    1R,         REPLACE PAREN WITH COMMA 
  1911.           SA7    A1 
  1912.           SX6    A1          X6 = START OF ARGS 
  1913.  JOP155   SX5    X5+1        INCREMENT PAREN DEPTH
  1914.           EQ     JOP110      LOOP BACK
  1915. * 
  1916.  JOP160   SX5    X5-1        DECREMENT PAREN DEPTH
  1917.           NG     X6,JOP110   AND LOOP BACK IF NOT IN ARGS 
  1918.           NZ     X5,JOP110    OR IF PARENS NOT BALANCED 
  1919.           SX7    1R          REPLACE PAREN WITH SPACE 
  1920.           SA7    A1 
  1921.           SX7    A7          MARK THIS AS END OF ARGUMENTS
  1922.           SA7    ENDPNT 
  1923.           EQ     JOP200      AND CEASE PRE-SCANNING 
  1924. * 
  1925. * 
  1926. *         HANDLE LESLIST REFERENCES 
  1927. * 
  1928.  JOP170   NZ     X5,JOP110   SKIP IF IN PARENS
  1929.           SA2    X4+KEYTYPE  CHECK PREVIOUS CHAR
  1930.           SX0    X2-OPCOMMA 
  1931.           NZ     X0,JOP110   SKIP IF NOT FIRST CHAR IN TAG
  1932.           SB1    -1          MARK PROCESSING LESLIST
  1933.           EQ     JOP110 
  1934. * 
  1935.  JOP180   NZ     X5,JOP110   SKIP IF IN PARENS
  1936.           SB1    0           MARK NOT PROCESSING LESLIST
  1937.           EQ     JOP110 
  1938. * /---   BLOCK      JOPARSE    00 000   81/01/20  02.42 
  1939. * 
  1940. *         COME HERE HAVING FINISHED PARSING SET OF TAGS 
  1941. * 
  1942.  JOP200   SA6    JPARGFL     STORE ARGUMENTS FLAG 
  1943.           NZ     X5,ERRBAL   -- EXIT IF PARENS NOT BALANCED 
  1944. * 
  1945. *         GET [ACCOUNT';]FILE *GETVAR* CODES
  1946. * 
  1947.           CALL   ACCFILE,JACCNAM,0
  1948. * 
  1949.           ZR     X1,ERR2FEW  -- NO LESSON NAME
  1950.           SX1    X1-1 
  1951.           NZ     X1,JOP300   BRANCH IF ACCOUNT';LESSON
  1952. * 
  1953.           SA1    JLESNAM     CHECK FOR LITERAL LESSON 
  1954.           SA2    NJNAM       AND EXTRACT LITERAL IF NEEDED
  1955.           CALL   JLITEST,JLESNAM,X2 
  1956.           EQ     JOP350 
  1957. * 
  1958.  JOP300   SA1    JLESNAM     CHECK FOR LITERAL LESSON 
  1959.           CALL   JLITEST,JLESNAM,-1 
  1960. * 
  1961.  JOP350   SA1    JACCNAM     CHECK FOR LITERAL ACCOUNT
  1962.           CALL   JLITEST,JACCNAM,-1 
  1963. * 
  1964.           SA1    LASTKEY     X1 = *LASTKEY* 
  1965.           SX0    X1-1R,      CHECK DELIMITER
  1966.           NZ     X0,JOP750   NO MORE TAGS IN THIS SET 
  1967. * 
  1968.           SA1    JPARGFL     CHECK FOR ARGUMENTS
  1969.           NG     X1,JOP400   NO ARGS -- GO FOR UNIT 
  1970.           SA2    WORDPT      ARE WE AT ARGS YET'/ 
  1971.           IX0    X2-X1
  1972.           NG     X0,JOP400   NOT YET AT ARGS -- GO FOR UNIT 
  1973.           MX6    0           MARK NO UNIT 
  1974.           SA6    JUNIT
  1975.           EQ     JOP500      GO GET ARGS
  1976. * 
  1977. * /---   BLOCK      JOPARSE    00 000   81/01/29  04.11 
  1978. * 
  1979. *         GET UNIT NAME 
  1980. * 
  1981.  JOP400   MX6    0           ZERO-FILL FOR *COMPNAM*
  1982.           SA6    IFILL
  1983.           CALL   COMPNAM     RETURNS X1 = *GETVAR* CODE 
  1984. * 
  1985.           CALL   JLITEST,JUNIT,0    GET LITERAL IF POSSIBLE 
  1986.           SA1    JUNIT       MUST BE LESS THAN 9 CHARS
  1987.           MX0    6           CHECK IF LITERAL 
  1988.           BX0    X0*X1
  1989.           ZR     X0,JOP450   NOT A LITERAL
  1990.           MX0    6*8         CHECK IF TOO LONG
  1991.           BX2    -X0*X1 
  1992.           ZR     X2,JOP450   CONTINUE IF OK 
  1993.           BX6    X0*X1       PATCH IT 
  1994.           SA6    A1 
  1995. *///
  1996.           SB1    3           GIVE CONDENSE WARNING
  1997.           CALL   RJERNOZ
  1998. *///
  1999. * 
  2000.  JOP450   SA2    JPARGFL     CHECK FOR ARGUMENTS
  2001.           PL     X2,JOP500   PROCESS IF PRESENT 
  2002.           SA1    LASTKEY     X1 = *LASTKEY* 
  2003.           SX0    X1-1R,      SHOULD BE NO MORE TAGS 
  2004.           ZR     X0,ERR2MNY  -- ERROR IF MORE TAGS IN SET 
  2005.           EQ     JOP700      CONTINUE IF OK 
  2006. * 
  2007. * /---   BLOCK      JOPARSE    00 000   81/01/28  02.48 
  2008. * 
  2009. *         GET ARGUMENTS 
  2010. * 
  2011.  JOP500   SA1    JOTYPE      CHECK FOR -FROM- 
  2012.           ZR     X1,ERRUARG  -- ERROR IF ARGS ON -FROM- 
  2013.           MX6    0           MARK NOT -UNIT- OR -ARGS-
  2014.           SA6    UNITFLG     FOR *GETARGS* CALL 
  2015.           SA6    VARBUF      AND PRESET NO ARGUMENTS
  2016. * 
  2017.           CALL   GETARGS     PROCESS ARGUMENTS
  2018. * 
  2019.           MX6    0           NO UNIT NUMBER 
  2020.           CALL   APACK       PACK UP ARGUMENTS
  2021.           MX0    -10
  2022.           BX6    -X0*X6      MASK OFF XSTOR POINTER 
  2023.           SA6    JPARGFL
  2024. * 
  2025.           SA1    LASTKEY     X1 = *LASTKEY* 
  2026.           SX0    X1-1R,      SHOULD BE NO MORE TAGS 
  2027.           ZR     X0,ERRUARG  -- ERROR IF MORE TAGS IN SET 
  2028. * 
  2029. *         DONE PARSING TAGS -- *JPARGFL* IS EITHER
  2030. *         [ADDRESS OF XSTOR] (HAD ARGS)  OR  [-1] (NO ARGS) 
  2031. * 
  2032.  JOP700   SA2    JPARGFL     *JPARGFL* = (XSTOR+1)
  2033.           SX6    X2+1        [OR 0 IF NO ARGS ] 
  2034.           SA6    JPARGFL
  2035.           EQ     JOPARSE -- EXIT
  2036. * 
  2037. * 
  2038. *         HAD ONLY [ACCOUNT';]LESSON
  2039. * 
  2040.  JOP750   SX6    B0+0        CLEAR UNIT NAME AND ARGS FLAG
  2041.           SA6    JUNIT
  2042.           SA6    JPARGFL
  2043.           EQ     JOPARSE     -- EXIT
  2044. * 
  2045. * /---   BLOCK      JLITEST    00 000   81/01/12  15.52 
  2046. * 
  2047.           TITLE  -JLITEST-
  2048. * 
  2049. *         -JLITEST-          TEST *GETVAR* CODE FOR LITERAL 
  2050. * 
  2051. *         ON ENTRY -- 
  2052. *                X1 = *GETVAR* CODE 
  2053. *                B1 = ADDRESS OF RESULT BUFFER
  2054. *                B2 < 0 IF TO LEAVE RESULT AS *GETVAR* CODE 
  2055. * 
  2056. *         ON EXIT --
  2057. *          (BUFFER) = LITERAL OR *GETVAR* CODE
  2058. * 
  2059.  JLITEST  EQ     *
  2060. * 
  2061.           BX6    X1          X6 = GETVAR CODE 
  2062.           SA6    B1          INITIALIZE RESULT
  2063.           AX1    XCODEAL     LOOK AT TYPE 
  2064.           MX0    XCODEAL-XCODEL 
  2065.           BX1    -X0*X1 
  2066.           SX1    X1-1 
  2067.           NG     X1,JLITEST  SHORT LITERAL -- EXIT
  2068.           ZR     X1,JEXTRCT  LONG LITERAL 
  2069. * 
  2070. * NON-LITERAL -JUMPOUT- REFERENCES ARE PUBLISHING ERRORS
  2071. * 
  2072.           CALL   PUBERRS,FSJUMPO
  2073.           EQ     JLITEST     -- EXIT
  2074. * 
  2075. * 
  2076.  JEXTRCT  NG     B2,JLITEST  -- EXIT IF SHOULD NOT EXTRACT
  2077.           MX0    -XCODEAL    GET XSTOR OFFSET 
  2078.           BX0    -X0*X6 
  2079.           SA1    INFO+X0     RECOVER LITERAL
  2080.           MX6    6           TEST IF LEFT JUSTIFIED 
  2081.           BX6    X6*X1
  2082.           ZR     X6,JLITEST  NOT LEFT JUSTIFIED LITERAL 
  2083.           BX6    X1          SAVE FOR STORING 
  2084.           SA1    INX         SEE IF LAST ENTRY IN XSTOR 
  2085.           SX7    X1-1 
  2086.           IX0    X0-X7
  2087.           NZ     X0,JLITEST  -- EXIT IF NOT 
  2088.           SA7    A1          UPDATE *INX* 
  2089.           SA6    B1          STORE IN RESULT BUFFER 
  2090.           EQ     JLITEST     -- EXIT
  2091.           TITLE  -ARGS- COMMAND 
  2092. * 
  2093. *         -ARGS- COMMAND
  2094. * 
  2095. *         ACCEPT -JUMPOUT- ARGUMENTS
  2096. * 
  2097.  ARGS     SA1    TAGCNT      CHECK FOR BLANK TAG
  2098.           ZR     X1,ERR2FEW 
  2099. * 
  2100.           SA1    WORDPT      START AT BEGINNING OF TAG
  2101.           SA2    X1 
  2102.  ARGEND   SA2    A2+1        FIND END OF TAG
  2103.           NZ     X2,ARGEND
  2104.           SX6    A2 
  2105.           SA6    ENDPNT      STORE END OF TAG FIELD 
  2106.           SX6    1
  2107.           SA6    UNITFLG     MARK AS -ARGS- FOR *GETARGS* 
  2108.           MX6    0
  2109.           SA6    VARBUF      INITIALIZE ARGUMENT COUNT
  2110. * 
  2111.           CALL   GETARGS     PROCESS ARGUMENTS
  2112. * 
  2113.           MX6    0           NO UNIT NUMBER 
  2114.           CALL   APACK       PACK UP ARGUMENTS
  2115.           MX0    -10         MASK OFF XSTOR POINTER 
  2116.           BX6    -X0*X6 
  2117.           LX6    48          POSITION IT
  2118.           MX1    1           MARK AS EXPLICIT -ARGS-
  2119.           BX6    X1+X6
  2120.           EQ     PUTCODE     -- BUILD COMMAND WORD
  2121. * 
  2122. * /---   BLOCK      JLITEST    00 000   79/08/09  15.04 
  2123.  JOTYPE   EQU    INST+INSTLNG+10  -1=JUMPOUT, 0=FROM
  2124.  NJNAM    EQU    JOTYPE+1    NUMBER OF TABLE ENTRIES
  2125.  JGCODE   EQU    NJNAM+1     CONDITION CODE 
  2126.  JACCNAM  EQU    JGCODE+1    ACCOUNT *GETVAR* CODE
  2127.  JLESNAM  EQU    JACCNAM+1   LESSON NAME / *GETVAR* CODE
  2128.  JUNIT    EQU    JLESNAM+1   UNIT   NAME / *GETVAR* CODE
  2129.  JPARGFL  EQU    JUNIT+1     ARGUMENTS POINTER / FLAG 
  2130.  JMPBUFF  EQU    JPARGFL+1   TABLE OF ALTERNATIVE TAGS
  2131. * 
  2132. * 
  2133.           ENDOV 
  2134. * /---   BLOCK      DATAON     00 000   81/01/07  18.49 
  2135.           TITLE  OVERLAY FOR VARIOUS DATA COMMANDS
  2136. * 
  2137.  CDATAOV  OVRLAY
  2138. * 
  2139.           SA1    OVARG1 
  2140.           SB3    X1          GET INDEX
  2141.           JP     B3+* 
  2142. * 
  2143. * 
  2144. *         NOTE THAT THESE LABELS ARE NOT THE
  2145. *         ENTRY POINTS THAT THE COMMAND TABLE 
  2146. *         USES. 
  2147. * 
  2148. +         EQ     DOFFIN      -DATAOFF-
  2149. +         EQ     DONIN       -DATAON- 
  2150. +         EQ     AREAIN      -AREA- 
  2151. +         EQ     OUTPIN      -OUTPUT- 
  2152. +         EQ     OUTPLIN     -OUTPUTL-
  2153. +         EQ     RDDSIN      -READSET-
  2154. +         EQ     ERRNAME      UNUSED
  2155. * 
  2156. * 
  2157.           TITLE  -DATAON- AND -DATAOFF- COMMANDS
  2158. * 
  2159. * 
  2160. *         -DATAON- AND -DATAOFF- COMMANDS 
  2161. * 
  2162.  DOFFIN   MX6    1           SET BIT FOR -DATAOFF-
  2163.           SA6    VARBUF 
  2164.           EQ     DON10
  2165. * 
  2166. * 
  2167.  DONIN    SB1    FSDATON     -DATAON- IS PUBLISH ERROR
  2168.           RJ     =XPUBERRS
  2169.           MX6    0           SET FOR -DATAON- 
  2170.           SA6    VARBUF 
  2171. * 
  2172.  DON10    MX6    0           CLEAR OPTION BITS
  2173.           SA6    VARBUF+1 
  2174.           SA1    TAGCNT 
  2175.           ZR     X1,DON90 
  2176. * 
  2177.  DON20    CALL   NXTNAME      GET NEXT OPTION NAME TO X6****
  2178.           ZR     X6,DON70 
  2179.           MX0    -6 
  2180.           BX2    -X0*X6      SEE IF TOO MANY CHARACTERS 
  2181.           NZ     X2,ERRNAME 
  2182.           SA6    ENDLST      PLANT FOR END TEST 
  2183.           SA2    OPTLST-1 
  2184. * /---   BLOCK      DATAON     00 000   81/01/07  18.49 
  2185. * 
  2186.  DON30    SA2    A2+1        LOAD NEXT OPTION NAME
  2187.           BX3    X0*X2
  2188.           BX3    X3-X6       SEE IF FOUND A MATCH 
  2189.           NZ     X3,DON30 
  2190.           SB1    A2-ENDLST   CHECK IF NOT LEGAL OPTION
  2191.           PL     B1,ERRNAME 
  2192.           SB1    A2-DSSYS    CHECK IF SYSTEM LESSON TAG 
  2193.           LT     B1,DON50    BRANCH IF NOT SYSTEM TAG 
  2194.           BX3    X1          X1 DESTROYED BY SYSTEST
  2195.           CALL   SYSTEST
  2196.           BX1    X3          RESTORE X1 
  2197.  DON50    BX2    -X0*X2      MASK OFF SHIFT COUNT 
  2198.           SB1    X2 
  2199.           MX6    1
  2200.           LX6    X6,B1       POSITION BIT FOR THIS OPTION 
  2201.           SA2    VARBUF+1 
  2202.           BX6    X2+X6       MERGE WITH REST OF BITS
  2203.           SA6    A2 
  2204.           NZ     X1,DON20    JUMP IF NOT END-OF-LINE
  2205. * 
  2206.  DON70    NZ     X1,ERR2MNY   ERROR IF NOT END-OF-LINE
  2207.           SA1    NEXTCOM
  2208.           SA2    COMCONT     SEE IF CONTINUED COMMAND 
  2209.           BX2    X1-X2
  2210.           NZ     X2,DON90    JUMP IF NOT
  2211.           CALL   GETLINE
  2212.           SA1    TAGCNT      ERROR IF BLANK TAG 
  2213.           ZR     X1,ERR2FEW 
  2214.           EQ     DON20
  2215. * 
  2216.  DON90    SA1    VARBUF      GET -DATAON- / -DATAOFF- FLAG
  2217.           SA2    VARBUF+1    GET OPTION BITS
  2218.           BX6    X1+X2
  2219.           SX7    DATAON=
  2220.           SA7    COMNUM      SET COMMAND CODE 
  2221.           EQ     PUTCODE
  2222. * 
  2223. * 
  2224. * 
  2225.  OPTLST   VFD    54/4LAREA,6/DSAREA 
  2226. +         VFD    54/6LOUTPUT,6/DSOUTP 
  2227. +         VFD    54/2LOK,6/DSOK 
  2228. +         VFD    54/2LNO,6/DSNO 
  2229. +         VFD    54/8LUNREC NO,6/DSUNO
  2230. +         VFD    54/5LVOCAB,6/DSVOCAB 
  2231. +         VFD    54/4LHELP,6/DSHELP 
  2232. +         VFD    54/7LHELP NO,6/DSHELPN 
  2233. +         VFD    54/4LTERM,6/DSTERM 
  2234. +         VFD    54/7LTERM NO,6/DSTERMN 
  2235. +         VFD    54/6LERRORS,6/DSXERR 
  2236. +         VFD    54/6LSIGNIN,6/DSDATON
  2237.  DSSYS    VFD    54/8LNOSIGNIN,6/DSNODON  NOTE -- THIS POINT
  2238. *                AND BEYOND ARE FOR SYSTEM LESSONS ONLY 
  2239.  ENDLST   BSS    1
  2240. * 
  2241. * /---   BLOCK      AREA       00 000   75/10/25  21.28 
  2242.           TITLE  AREA 
  2243. * 
  2244. *         -AREA- COMMAND
  2245. *         DESIGNATES AREA OF LESSON FOR SUMARIZED DATA
  2246. * 
  2247. * 
  2248.  AREAIN   SA1    TAGCNT      SEE IF ANY TAG 
  2249.           ZR     X1,AIN1
  2250.           MX6    0           SET TO ZERO FILL 
  2251.           SA6    IFILL
  2252.           CALL   COMPNAM
  2253.           EQ     CALCODE
  2254. * 
  2255.  AIN1     MX1    0           0 = SHORT INTEGER 0
  2256.           EQ     CALCODE
  2257. * /---   BLOCK      OUTPUT     00 000   78/10/11  00.10 
  2258.           TITLE  OUTPUT 
  2259. * 
  2260. *         -OUTPUT- COMMAND
  2261. *         OUTPUTS VARIABLES AND/OR TEXT AS STUDENT DATA 
  2262. * 
  2263. * 
  2264.  OUTPIN   SB1    FSOUTP      -OUTPUT- IS PUBLISH ERROR
  2265.           RJ     =XPUBERRS
  2266.           SA1    TAGCNT      SEE IF ANY TAG 
  2267.           ZR     X1,ERR2FEW 
  2268.           MX6    0           INITIALIZE NUMBER OF ENTRIES 
  2269.           SA6    VARBUF 
  2270. * 
  2271.  LP       SA1    INX
  2272.           SB2    X1          INITIALIZE XSTOR POINTER 
  2273.           SB3    B0          INITIALIZE WORD COUNT
  2274.           SA1    WORDPT 
  2275.           SX7    X1-1        INITIALIZE CHARACTER POINTER 
  2276. * 
  2277.  LP0      MX6    0           CLEAR WORD BUILDING
  2278.           SB1    60          INITIALIZE SHIFT COUNT 
  2279. * 
  2280.  LP1      SX7    X7+1        ADVANCE TO NEXT CHARACTER
  2281.           SA1    X7 
  2282.           ZR     X1,ENDLIN   JUMP IF END-OF-LINE
  2283.           SX2    X1-ACCESS
  2284.           NZ     X2,LP2      JUMP IF CANNOT BE -EMBED-
  2285.           SA2    X7+1 
  2286.           SX2    X2-1R0      SEE IF -EMBED-  (ACCESS 0) 
  2287.           ZR     X2,EMBED 
  2288. * 
  2289.  LP2      SB1    B1-6        COMPUTE SHIFT COUNT
  2290.           LX1    X1,B1       POSITION THIS CHARACTER
  2291.           BX6    X1+X6       MERGE WITH WORD BUILDING 
  2292.           NZ     B1,LP1 
  2293.           SA6    B2+INFO     STORE COMPLETED WORD 
  2294.           SB2    B2+1        ADVANCE XSTOR POINTER (INX)
  2295.           SB3    B3+1        INCREMENT WORD COUNT 
  2296.           EQ     LP0
  2297. * 
  2298.  EMBED    ZR     X6,EMB1     JUMP IF CURRENT WORD EMPTY 
  2299.           SA6    B2+INFO
  2300.           SB2    B2+1        UPDATE XSTOR POINTER 
  2301.           SB3    B3+1        INCREMENT WORD COUNT 
  2302. * 
  2303.  EMB1     SA1    X7+2        LOAD TYPE SPECIFIER (A,N,O,V)
  2304.           MX6    0
  2305.           SX2    X1-1RA      SEE IF -A-  ALPHA
  2306.           ZR     X2,EMB2
  2307.           SX6    X6+1 
  2308.           SX2    X1-1RN      SEE IF -N-  INTEGER
  2309.           ZR     X2,EMB2
  2310.           SX6    X6+1 
  2311.           SX2    X1-1RO      SEE IF -O-  OCTAL
  2312.           ZR     X2,EMB2
  2313.           SX6    X6+1 
  2314.           SX2    X1-1RV      SEE IF -V-  FLOATING 
  2315.           ZR     X2,EMB2
  2316.           SX6    X6+1 
  2317.           SX2    X1-1RH      SEE IF -H-  HEXADECIMAL
  2318.           ZR     X2,EMB2
  2319.           SX7    X7+2 
  2320.           SA7    WORDPT      UPDATE *WORDPT*
  2321.           SB1    154
  2322.           EQ     =XERR
  2323. * 
  2324.  EMB2     SA6    IWK         SAVE TYPE SPECIFIER
  2325.           SA1    X7+3 
  2326.           SX1    X1-1R,      NEXT CHARACTER MUST BE COMMA 
  2327.           NZ     X1,ERRTERM 
  2328.           SX7    X7+4 
  2329.           SA7    WORDPT      UPDATE *WORDPT*
  2330.           ZR     B3,EMB3     JUMP IF NO WORDS IN ENTRY
  2331.           SA1    VARBUF 
  2332.           SX7    X1+1        INCREMENT NUMBER OF ENTRIES
  2333.           SA7    A1 
  2334.           SA1    INX         BEGINNING INDEX OF TEXT
  2335.           SX2    B3          NUMBER OF WORDS OF TEXT
  2336.           LX2    9
  2337.           BX6    X1+X2       MERGE INDEX AND WORD COUNT 
  2338. * /---   BLOCK      OUTPUT     00 000   78/10/11  00.10 
  2339.           SA6    X7+VARBUF
  2340. * /---   BLOCK      EMB3       00 000   76/07/25  07.53 
  2341. * 
  2342.  EMB3     SX7    B2          UPDATE XSTOR POINTER  (INX)
  2343.           SA7    INX
  2344.           CALL   COMPILE     DECODE EXPRESSION
  2345.           SA2    WORDPT 
  2346.           SA3    X2-2        MUST END WITH (ACCESS 1) 
  2347.           SX3    X3-ACCESS
  2348.           NZ     X3,ERRTERM 
  2349.           SA3    X2-1 
  2350.           SX3    X3-1R1 
  2351.           NZ     X3,ERRTERM 
  2352.           MX0    -XCODEL
  2353.           BX1    -X0*X1      -GETVAR- CODE
  2354.           MX6    1
  2355.           LX6    30          POSITION BIT FOR -EMBED- 
  2356.           BX6    X1+X6       MERGE BIT AND -GETVAR- CODE
  2357.           SA1    IWK
  2358.           LX1    XCODEL      POSITION TYPE SPECIFIER
  2359.           BX6    X1+X6
  2360.           SA1    VARBUF 
  2361.           SX7    X1+1        INCREMENT NUMBER OF ENTRIES
  2362.           SX1    X7-VARBUFL+2 
  2363.           PL     X1,ERR2MNY   ERROR IF TOO MANY ENTRIES 
  2364.           SA7    A1 
  2365.           SA6    X7+VARBUF   STORE INFO FOR -EMBED- 
  2366.           EQ     LP 
  2367. * 
  2368.  ENDLIN   ZR     X6,ENDL1    JUMP IF NOTHING IN LAST WORD 
  2369.           SA6    B2+INFO
  2370.           SB2    B2+1        ADVANCE XSTOR POINTER  (INX) 
  2371.           SB3    B3+1        INCREMENT WORD COUNT 
  2372. * 
  2373.  ENDL1    ZR     B3,ENDL2    JUMP IF NOTHING IN LAST ENTRY
  2374.           SA1    VARBUF 
  2375.           SX7    X1+1        INCREMENT NUMBER OF ENTRIES
  2376.           SA7    A1 
  2377.           SA1    INX         BEGINNING INDEX OF TEXT
  2378.           SX2    B3          NUMBER OF WORDS OF TEXT
  2379.           LX2    9
  2380.           BX6    X1+X2       MERGE INDEX AND WORD COUNT 
  2381.           SA6    X7+VARBUF
  2382. * 
  2383.  ENDL2    SA1    VARBUF      LOAD NUMBER OF ENTRIES 
  2384.           ZR     X1,ERR2FEW 
  2385.           MX6    0           CLEAR LAST WORD
  2386.           SA6    X1+VARBUF+1
  2387.           SB3    B2          SAVE INDEX IN XSTOR
  2388.           SB4    X1-1        PICK UP END TEST 
  2389.           SA2    VARBUF-1    INITIALIZE INDEX IN *VARBUF* 
  2390. * 
  2391.  ENDL3    SA2    A2+2        LOAD NEXT -VARBUF- ENTRY 
  2392.           LX2    30 
  2393.           SA3    A2+1        LOAD NEXT -VARBUF- ENTRY 
  2394.           BX6    X2+X3
  2395.           SA6    B2+INFO     STORE NEXT TWO CODES 
  2396.           SB2    B2+1 
  2397.           SB4    B4-2        DECREMENT ENTRY COUNT
  2398.           PL     B4,ENDL3 
  2399.           SX6    B2          UPDATE XSTOR POINTER 
  2400.           SA6    INX
  2401.           LX1    60-18       POSITION NUMBER OF ENTRIES 
  2402.           SX6    B3 
  2403.           LX6    60-18-18    POSITION INDEX IN XSTOR
  2404.           BX6    X1+X6
  2405.           EQ     PUTCODE     GO ATTACH COMMAND CODE 
  2406. * /---   BLOCK      OUTPUTL    00 000   76/07/25  07.53 
  2407.           TITLE  OUTPUTL
  2408. * 
  2409. *         -OUTPUTL- COMMAND      LABLED OUTPUT
  2410. * 
  2411. *         FIRST ARGUMENT = NAME (LABLE) 
  2412. *         2ND   ARGUMENT = STARTING VARIABLE TO OUTPUT
  2413. *         3RD   ARGUMENT = NUMBER OF VARIABLES TO OUTPUT
  2414. * 
  2415. * 
  2416.  OUTPLIN  SB1    FSOUTPL     -OUTPUTL- IS PUBLISH ERROR 
  2417.           RJ     =XPUBERRS
  2418.           MX6    0           ZERO FILL
  2419.           SA6    IFILL
  2420.           CALL   COMPNAM     FIRST ARGUMENT 
  2421.           BX6    X1 
  2422.           ZR     B1,OUTPL1   JUMP IF STOREABLE
  2423.           MX1    1
  2424.           BX6    X1+X6
  2425. * 
  2426.  OUTPL1   SA6    VARBUF+1    SAVE -GETVAR- CODE 
  2427.           SX6    1
  2428.           SA6    VARBUF      NUMBER OF VARIABLES
  2429.           CALL   VARDO2      GET NEXT ARGUMENT
  2430.           SA1    LASTKEY
  2431.           ZR     X1,OPL2     JUMP IF TWO ARGUMENT 
  2432.           CALL   VARDO2      GET NEXT ARGUMENT
  2433.           SA1    VARBUF+2 
  2434.           NG     X1,ERRSTOR   ERROR IF 2ND NOT STOREABLE
  2435.           SX1    3
  2436.           EQ     VARFIN 
  2437. * 
  2438.  OPL2     SA1    VARBUF+1    ERROR IF 1ST NOT STOREABLE 
  2439.           NG     X1,ERRSTOR 
  2440.           MX6    1
  2441.           LX6    XCODEL      POSITION BIT TO FLAG 2 ARG 
  2442.           BX6    X1+X6
  2443.           SA6    A1 
  2444.           SX1    2           PACK UP 2 VARIABLES
  2445.           EQ     VARFIN 
  2446. * 
  2447. * 
  2448.  IWK      BSS    1
  2449. * /---   BLOCK      READSET    00 000   76/07/25  07.53 
  2450.           TITLE  READSET
  2451. * 
  2452. *         -READSET- COMMAND 
  2453. * 
  2454. *         TWO, THREE, OR FOUR ARGUMENTS --
  2455. *            1ST IS ACCOUNT NAME
  2456. *            2ND IS FILE NAME 
  2457. *            3RD IS CODEWORD
  2458. *            4TH IS RETURN VARIABLE 
  2459. * 
  2460. * 
  2461.  RDDSIN   CALL   ACCFILF     GET ACCOUNT AND FILE NAME
  2462.           ZR     X1,ERR2FEW  --- ERROR IF BLANK TAG 
  2463. * 
  2464.           SA1    LASTKEY
  2465.           ZR     X1,MRKLAST  --- DONE IF END OF LINE
  2466.           CALL   VARDO2      GET CODEWORD ARGUMENT
  2467.           SA1    LASTKEY
  2468.           ZR     X1,MRKLAST  --- DONE IF END OF LINE
  2469.           CALL   VARDO2      GET RETURN VARIABLE
  2470.           NG     X6,ERRSTOR  --- ERROR IF NOT STOREABLE 
  2471.           SA1    LASTKEY
  2472.           ZR     X1,MRKLAST 
  2473.           EQ     ERR2MNY
  2474. * 
  2475. * 
  2476.           ENDOV 
  2477. * /---   BLOCK      READDIN    00 000   76/07/25  07.55 
  2478. * 
  2479.           TITLE  -READD- COMMAND   READ DATA FROM DATAFILE
  2480. * 
  2481. * 
  2482. *         FIRST ARG'; TYPE (OUTPUT, AREA, DATAOFF)
  2483. *         SECOND ARG';  BUFFER
  2484. *         THIRD ARG'; LENGTH
  2485. * 
  2486.  READDOV  OVRLAY
  2487.           CALL   NXTNAME      GET TYPE OF DATA **** 
  2488.           SB1    1
  2489.           SA1    RDDLST-1    INITIALIZE FOR SEARCH
  2490.           MX0    -6 
  2491.  RDDLIST  SA1    A1+B1       GET NEXT ENTRY 
  2492.           SB3    A1-RDEND 
  2493.           PL     B3,ERRTAGS   NOT FOUND 
  2494.           BX2    X6-X1       SEE IF LEGAL TAG 
  2495.           BX2    X2*X0       MASK OFF LOWER 6 BITS
  2496.           NZ     X2,RDDLIST 
  2497.           BX6    -X0*X1      GET TYPE NUMBER
  2498.           LX6    XCMNDL 
  2499.           SA6    RDDTEMP
  2500.           CALL   COMPILE     GET BUFFER START 
  2501.           NZ     B1,ERRSTOR   ERROR IF NOT STOREABLE
  2502.           LX1    -XCODEL
  2503.           SA2    RDDTEMP
  2504.           BX6    X2+X1
  2505.           SA6    RDDTEMP
  2506.           CALL   COMPILE
  2507.           SX1    X1 
  2508.           LX1    60-XCODEL-XCODEL 
  2509.           SA2    RDDTEMP
  2510.           BX6    X2+X1
  2511.           EQ     PUTCODE
  2512. * 
  2513. * 
  2514.  RDDLST   VFD    54/4LAREA,6/1
  2515. +         VFD    54/7LOUTPUTL,6/2 
  2516. +         VFD    54/7LSIGNOFF,6/3 
  2517.  RDEND    BSS    1
  2518. * 
  2519.  RDDTEMP  BSS    1
  2520. * 
  2521.           ENDOV 
  2522. * /---   BLOCK      NOTES      00 000   86/02/21  14.16 
  2523.           TITLE  NOTES COMMAND
  2524. * 
  2525. *         NOTES COMMAND -- ACCESS TERM-COMMENTS UNDER 
  2526. *         PROGRAM CONTROL 
  2527. * 
  2528. *         NO TAG      CALL SYSLIB, COMMENTS MACHINERY 
  2529. *         1 ARG       CALL SYSLIB, PASSING NOTE TITLE 
  2530. *         2 ARGS      CALL SYSLIB, PASS BUFFER SPECIFIED
  2531. *                     IN FIRST ARG, FOR LENGTH 2ND ARG, 
  2532. *                     FOR HEADER OF STUDENT COMMENT 
  2533. *         3 ARGS      THIRD ARGUMENT SPECIFIES NOTE TITLE 
  2534. *         4 ARGS      FOURTH ARGUMENT SPECIFIES LESSON NOTES
  2535. *                     FILE TO BE USED FOR THIS NOTE; SYSTEM 
  2536. *                     LESSONS ONLY. 
  2537. *         (SEND)      OPTIONAL KEYWORD ',SEND', MAY FOLLOW
  2538. *                     ABOVE ARGUMENTS; INDICATES THAT NOTE
  2539. *                     SHOULD BE AUTOMATICALLY SENT WITHOUT
  2540. *                     STUDENT INTERVENTION. 
  2541. *         (LESSON)    SAME AS ',SEND',, EXCEPT FORCED TO GO 
  2542. *                     LESSON NOTES FILE.
  2543. * 
  2544. *         FORMAT FOR COMMAND WORD --
  2545. *           NEXT TO TOP BIT OF GETVAR1 = AUTO-SEND SELECTED 
  2546. *           TOP TWO BITS OF GETVAR1 SET = ',LESSON', AUTO-SEND
  2547. *           NEXT TO TOP BIT OF GETVAR2 =
  2548. *                NOTE TITLE TO BE PASSED (IF MORE THAN ONE
  2549. *                ARGUMENT IS IN THE COMMAND)
  2550. * 
  2551. *         LAST GETVAR CODE MARKED USING -MRKLAST- 
  2552. * 
  2553.  NNOTEOV  OVRLAY
  2554.           SA1    TAGCNT 
  2555.           MX6    0
  2556.           ZR     X1,PUTCODE  NO ARGS MEANS SIMPLE CALL
  2557. * 
  2558.           CALL   VARDO1 
  2559.           SA1    VARBUF+1    PICK UP THIS GETVAR CODE 
  2560.           NG     X1,ERRSTOR  MUST BE STORABLE 
  2561.           SA2    LASTKEY
  2562.           ZR     X2,MRKLAST  ONLY ARGUMENT IS TITLE 
  2563. *  OTHERWISE, FIRST ARGUMENT IS BUFFER START
  2564.           CALL   VARDO2      GET NEXT ARGUMENT
  2565. * /---   BLOCK      NOTES      00 000   86/02/21  14.17 
  2566. * 
  2567.           RJ     KEYWORD     CHECK FOR SEND/LESSON
  2568.           NZ     X6,NOTES1   BRANCH IF NOT NULL ARGUMENT
  2569.           SX7    B1 
  2570.           SA7    WORDPT      UPDATE WORDPT
  2571.           EQ     NOTES2 
  2572. * 
  2573.  NOTES1   CALL   VARDO2      GET TITLE
  2574.           SA1    VARBUF+3    PICK UP THIS GETVAR CODE 
  2575.           NG     X1,ERRSTOR  MUST BE STORABLE 
  2576.           SA1    VARBUF+2    MARK GETVAR CODE TO SHOW TITLE 
  2577.           MX6    1
  2578.           LX6    XCODEL-1    POSITION TO NEXT TO TOP BIT
  2579.           BX6    X6+X1       SET BIT OF GETVAR CODE 
  2580.           SA6    A1 
  2581.           RJ     KEYWORD
  2582. * 
  2583.  NOTES2   CALL   SYSTEST     SYSTEM LESSONS ONLY
  2584.           CALL   ACCFILE,VARBUF+4,0 
  2585.           SA1    VARBUF      GET NUMBER OF ARGUMENTS
  2586.           SX6    X1+2        ADD 2 (ACCOUNT AND FILE NAME)
  2587.           SA6    A1 
  2588.           RJ     KEYWORD
  2589.           EQ     ERRTAGS     ILLEGAL FIFTH TAG
  2590. * 
  2591.  KEYWORD  EQ     *
  2592.           SA1    LASTKEY
  2593.           ZR     X1,MRKLAST  EXIT IF LAST ARG 
  2594. * 
  2595.           CALL   NXTNAMP     NEXT TAG W/O UPDATING WORDPT 
  2596.           ZR     X6,KEYWORD  RETURN IF NULL ARG 
  2597.           SA2    KSEND       SEE IF LITERAL ',SEND',
  2598.           MX7    1           PRESET FOR ',SEND',
  2599.           LX7    XCODEL-1    NEXT TO TOP BIT
  2600.           BX2    X6-X2
  2601.           ZR     X2,MARK
  2602.           SA2    KLESSON     SEE IF LITERAL ',LESSON',
  2603.           MX7    2           SET FOR ',LESSON', 
  2604.           LX7    XCODEL 
  2605.           BX2    X6-X2
  2606.           NZ     X2,KEYWORD  RETURN IF NEITHER
  2607.  MARK     NZ     X1,ERRTAGS  TERMINATOR MUST BE EOL 
  2608.           SA1    VARBUF+1    GET FIRST GETVAR CODE
  2609.           BX7    X7+X1       SET BIT OF GETVAR CODE 
  2610.           SA7    A1 
  2611.           EQ     MRKLAST     --- EXIT 
  2612. * 
  2613.  COMERR   SB1    106         MUST BE N OR V VARIABLE
  2614.           EQ     =XERR
  2615. * 
  2616.  KSEND    DATA   4LSEND 
  2617.  KLESSON  DATA   6LLESSON 
  2618. * 
  2619.           ENDOV 
  2620. * /---   BLOCK      INTLOK     00 000   81/01/07  18.50 
  2621.           TITLE  -INTLOK- AND -INTCLR- COMMANDS 
  2622. * 
  2623. * 
  2624. * 
  2625. *         -INTLOK- AND -INTCLR- COMMANDS
  2626. *         ALLOW SYSTEM LESSONS TO ACCESS MULTI-EXECUTOR 
  2627. *         INTERLOCK TABLES
  2628. * 
  2629. *         INTLOK TYPE,INDEX,(WRITE) 
  2630. *         INTCLR TYPE,INDEX 
  2631. * 
  2632.  INTLOKV  OVRLAY
  2633.           CALL   SYSTEST     CHECK SYSTEM LESSON
  2634.           CALL   NXTNAM      GET TYPE ARGUMENT
  2635.           ZR     X6,ERRORC
  2636.           MX0    42          X0 = MASK
  2637.           SA1    ITTAB-1     A1 = READ REGISTER 
  2638. * 
  2639.  INT120   SA1    A1+1        LOAD NEXT OPTION NAME
  2640.           ZR     X1,ERRORC
  2641.           BX2    X1-X6
  2642.           BX2    X0*X2       CHECK IF FOUND A MATCH 
  2643.           NZ     X2,INT120
  2644.           SX6    X1          PICK OFF TYPE CODE 
  2645.           SA6    VARBUF+1 
  2646. * 
  2647.           CALL   COMPILE     EVALUATE INDEX EXPRESSION
  2648.           BX6    X1 
  2649.           SA6    VARBUF+2 
  2650.           SA1    OVARG1      DETERMINE INTLOK/INTCLR
  2651.           NZ     X1,INT240
  2652. * 
  2653. * 
  2654.           CALL   NXTNAM      GET READ/WRITE ARGUMENT
  2655.           SA1    ITTAB1      (X1) = DEFAULT TYPE
  2656.           ZR     X6,INT170   IF NO ARGUMENT 
  2657.           MX0    42          X0 = MASK
  2658.           SA1    ITTAB1-1    A1 = READ REGISTER 
  2659. * 
  2660.  INT160   SA1    A1+1        LOAD NEXT OPTION NAME
  2661.           ZR     X1,ERRORC
  2662.           BX2    X1-X6
  2663.           BX2    X0*X2       CHECK IF FOUND A MATCH 
  2664.           NZ     X2,INT160
  2665.  INT170   SX6    X1          SET INTERLOCK TYPE 
  2666.           SA1    VARBUF+1 
  2667.           IX6    X1+X6       ADD TO INTERLOCK TYPE
  2668.           SA6    A1 
  2669. * 
  2670.  INT240   SX1    2           SET NUMBER OF *GETVAR* CODES 
  2671.           BX6    X1 
  2672.           SA6    VARBUF 
  2673.           EQ     VARFIN      COMPLETE COMMAND READ-IN 
  2674. * 
  2675. * 
  2676.  ITTAB    VFD    42/0LX,18/0
  2677.           VFD    60/0 
  2678.  
  2679.  ITTAB1   VFD    42/0LW,18/0
  2680.           VFD    42/0LWRITE,18/0
  2681.           VFD    60/0 
  2682. * 
  2683.           ENDOV 
  2684. * 
  2685. * 
  2686. * /---   BLOCK      -ATTACH-   00 000   79/12/15  21.26 
  2687.           TITLE  -ATTACH- COMMAND CONDENSE ROUTINE
  2688. * 
  2689. *         -ATTACH-
  2690. * 
  2691. *         ATTACH ACCOUNT';FILE
  2692. *         ATTACH ACCOUNT';FILE,RO 
  2693. *         ATTACH ACCOUNT';FILE,(N1),CODEWORD
  2694. * ONLY IN SYSTEM LESSONS';
  2695. *         ATTACH ACCOUNT';FILE,RW,CODEWORD,FILETYPE 
  2696. * 
  2697. * 
  2698.  ATCHOV   OVRLAY
  2699.           SA1    OVARG1      SEE WHICH COMMAND
  2700.           SX0    X1-2 
  2701.           ZR     X0,IOSPGO   --- BRIF -IOSPECS- 
  2702.           SX0    X1-3 
  2703.           ZR     X0,GETLGO   --- BRIF -GETLINE- 
  2704.  
  2705. * 
  2706. * GET FILE AND ACCOUNT NAMES INTO VARBUF+1 AND VARBUF+2 
  2707. * 
  2708.  
  2709.           CALL   ACCFILF
  2710.           ZR     X1,ERR2FEW  --- ERROR IF NO ARGUMENTS
  2711.  
  2712.           SA2    LASTKEY     SEE IF EOL 
  2713.           ZR     X2,MRKLAST  --- BRIF EOL ENCOUNTERED 
  2714.  
  2715. * 
  2716. * CHECK NEXT ARGUMENT FOR A LITERAL '7RO'7 OR '7RW'7
  2717. * 
  2718.  
  2719.           CALL   NXTNAMP     GET LITERAL TAG IN X6
  2720.           ZR     X6,ATT130   --- BRIF NOT A NAME
  2721.           SB1    B7-3        POINT AT R IN RW OR RO 
  2722.           SA2    LITRO       COMPARE FOR READ-ONLY
  2723.           BX2    X6-X2
  2724.           ZR     X2,ATT110   --- BRIF SHOULD FAKE 0 
  2725.           SA2    LITRW       COMPARE FOR READ-WRITE 
  2726.           BX2    X6-X2
  2727.           ZR     X2,ATT120   --- BRIF SHOULD FAKE -1
  2728.  
  2729.  ATT130   CALL   VARDO2      COMPILE THIS ARGUMENT
  2730.           SA1    LASTKEY
  2731.           ZR     X1,MRKLAST  --- MARK LAST TAG FOUND
  2732.           EQ     ATT250      --- GET CODEWORD ARGUMENT
  2733.  
  2734.  LITRO    DATA   2LRO 
  2735.  LITRW    DATA   2LRW 
  2736.  
  2737. * 
  2738. * FAKE A 0 ARGUMENT FOR '7RO'7 LITERAL TAG
  2739. * 
  2740.  
  2741.  ATT110   SX6    1R0
  2742.           SA6    B1          OVERWRITE R WITH 0 
  2743.           SA6    B1+1        OVERWRITE O WITH 0 
  2744.           EQ     ATT130      --- DONE WITH KLUDGE 
  2745.  
  2746. * 
  2747. * FAKE A -1 ARGUMENT FOR '7RW'7 LITERAL TAG 
  2748. * 
  2749.  
  2750.  ATT120   SX6    1R-         SET UP LITERAL - 
  2751.           SX7    1R1         SET UP LITERAL 1 
  2752.           SA6    B1          OVERWRITE R WITH - 
  2753.           SA7    B1+1        OVERWRITE W WITH 1 
  2754.           EQ     ATT130      --- DONE WITH KLUDGE 
  2755.  
  2756. * /---   BLOCK      -ATTACH-   00 000   78/08/01  09.28 
  2757. * 
  2758. * DONE WITH R/W TAG FIELD -- MRKLAST THE REST 
  2759. * 
  2760.  
  2761.  ATT250   CALL   VARDO2      COMPILE NEXT VAR TO VARBUF 
  2762.           SA1    LASTKEY
  2763.           NZ     X1,ATT250   CONTINUE IF NOT E-O-L
  2764.  
  2765.           SA1    VARBUF+4    MARK CODEWORD AS INTEGER TYPE
  2766.           MX7    60-XCODEL+XFBIT+1
  2767.           BX7    -X7*X1      REMOVE I/F BIT FROM GETVAR CODE
  2768.           SA7    A1 
  2769.  
  2770.           SA1    VARBUF      READ NO. OF ARGS 
  2771.           SX0    X1-5        4 TAGS MAX FOR REGULAR LESS
  2772.           NG     X0,MRKLAST  --- EXIT IF .LE. 4 TAGS
  2773.           SX0    X1-6        5 TAGS MAX FOR SYSTEM LESSON 
  2774.           PL     X0,ERR2MNY  --- TOO MANY TAGS
  2775.           CALL   SYSTEST     MUST BE SYSLESS FOR 5 TAGS 
  2776.  
  2777.           EQ     MRKLAST     --- EXIT THIS COMMAND
  2778. * 
  2779. **
  2780. * /---   BLOCK      -IOSPECS-  00 000   77/12/21  14.00 
  2781.           TITLE  -IOSPECS- CONDENSE ROUTINE 
  2782. * 
  2783. *         -IOSPECS- 
  2784. * 
  2785. *         IOSPECS  OPTION,OPTION,OPTION...
  2786. * 
  2787. *         ALL OPTIONS ARE LITERALS WHICH ARE DECODED HERE 
  2788. *         INTO BIT SHIFTS DEPENDING UPON THEIR POSITION 
  2789. *         IN THE OPTION TABLE BELOW.  'THE TOP OF THE TABLE 
  2790. *         IS THE TOP BIT IN THE COMMAND WORD, AND SO ON.
  2791. * 
  2792. * 
  2793.  
  2794.  IOSPGO   SB1    IOLITS      B1 = START OF LITERAL TABLE
  2795.           SB2    IOLEND      B2 = END OF ABOVE TABLE
  2796.           MX5    60          ALLOW UP TO 10 CHAR LITS 
  2797.  
  2798.           CALL   SCANNER     SCAN THE TAGS
  2799.  
  2800.           ZR     X0,PUTCODE  --- BRIF TAGS ARE LEGAL
  2801.           EQ     ERRNAME     --- EXIT IF BAD TAGS 
  2802.  
  2803.  IOLITS   DATA   0LMODS 
  2804.           DATA   0LNOMODS 
  2805.           DATA   0LTRUNCATE 
  2806.           DATA   0LNOTRUNCATE 
  2807.           DATA   0LDELETED
  2808.           DATA   0LNODELETED
  2809.  IOLEND   DATA   0
  2810. * 
  2811. **
  2812. * /---   BLOCK      -GETLINE-  00 000   77/11/10  17.46 
  2813.           TITLE  -GETLINE- COMMAND CONDENSE ROUTINE 
  2814. * 
  2815. *         -GETLINE- 
  2816. * 
  2817. *         THE -GETLINE- COMMAND MUST HAVE EXACTLY THREE 
  2818. *         ARGUMENTS OF WHICH THE FIRST AND THIRD MUST 
  2819. *         BE STOREABLE. 
  2820. * 
  2821. * 
  2822.  
  2823.  GETLGO   RJ     VARDO       COMMA SEPARATED VARIABLES
  2824.           SA1    VARBUF+1    FIRST TAG MUST BE STOREABLE
  2825.           NG     X1,ERRSTOR 
  2826.           SA1    VARBUF+3    THIRD TAG MUST BE STOREABLE
  2827.           NG     X1,ERRSTOR 
  2828.           SX1    3
  2829.           EQ     VARFIN 
  2830.  
  2831. * 
  2832. **
  2833.  
  2834.           ENDOV 
  2835. * /---   BLOCK      END        00 000   76/07/21  20.33 
  2836.           TITLE  KERMIT COMMAND 
  2837. * 
  2838. * * *     KERMIT  OPEN,FILENAM,MODE 
  2839. *                 FILENAM = N OR NC VARIABLE (7 WORDS)
  2840. *                           (FULL FILE NAME ON DOS DISK)
  2841. *                 MODE    = '7WRITE'7 OR '7APPEND'7 
  2842. *                            WRITE  = OVERWRITE ENTIRE FILE 
  2843. *                            APPEND = APPEND TO END OF FILE 
  2844. * 
  2845. * * *     KERMIT  CLOSE 
  2846. * 
  2847. * * *     KERMIT  SEND,STOWORD,BYTES,TYPE 
  2848. *                            STOWORD = STARTING STO WORD ^$ 
  2849. *                            BYTES   = NUM BYTES TO SEND
  2850. *                                      (6-BIT CHARS IF TYPE 
  2851. *                                       EQUALS 6BIT)
  2852. *                            TYPE    = BYTE FORMAT
  2853. *                                      ASCII = ASCII 8-BIT
  2854. *                                      TEXT  = 6-BIT
  2855. * 
  2856. * * *     KERMIT  RECEIVE,STOWORD,BYTES,TYPE,RETURN 
  2857. *                            RETURN = NUMBER OF BYTES/6BIT
  2858. *                                     ITEMS RECEIVED
  2859. * 
  2860.  KERMCOV  OVRLAY
  2861. * 
  2862.           SA1    TAGCNT      NUM CHARS IN TAG PORTION 
  2863.           ZR     X1,ERR2FEW  NO ARGS, BAD FORM OF COMMAND 
  2864. * 
  2865.           CALL   NXTNAME     GET LITERAL TAG IN X6
  2866.           ZR     X6,ERRNAME  --- BRIF NOT A NAME
  2867.           SX0    0           DEFAULT TO '7OPEN'7
  2868.           SX5    2           3 ARGS REQUIRED (2 COMMAS) 
  2869.           SA2    LOPEN       SEE IF '7OPEN'7 OPTION 
  2870.           BX2    X6-X2       COMPARE
  2871.           ZR     X2,KARGSOK 
  2872.           SX0    1           DEFAULT TO '7CLOSE'7 
  2873.           SX5    0           1 ARGS REQUIRED (0 COMMAS) 
  2874.           SA2    LCLOSE      SEE IF '7CLOSE'7 OPTION
  2875.           BX2    X6-X2       COMPARE
  2876.           ZR     X2,KARGSOK 
  2877.           SX0    2           DEFAULT TO '7SEND'7
  2878.           SX5    3           4 ARGS REQUIRED (3 COMMAS) 
  2879.           SA2    LSEND       SEE IF '7SEND'7 OPTION 
  2880.           BX2    X6-X2       COMPAIRE 
  2881.           ZR     X2,KARGSOK 
  2882.           SX0    3           DEFAULT TO '7RECEIVE'7 
  2883.           SX5    4           5 ARGS REQUIRED (4 COMMAS) 
  2884.           SA2    LRECVE      SEE IF '7RECEIVE'7 
  2885.           BX2    X6-X2       COMPARE
  2886.           ZR     X2,KARGSOK 
  2887.           EQ     ERRNAME     INVALID TAG
  2888. * 
  2889. * /---   BLOCK      -KERMIT-   00 000   79/01/22  01.25 
  2890.  KARGSOK  SA1    COMACNT     NUM OF COMMAS IN TAGS
  2891.           IX1    X1-X5       SEE IF WE HAVE REQUIRED TAGS 
  2892.           ZR     X1,KRIGHT   IF CORRECT NUMBER ARGS, GO ON
  2893.           NG     X1,ERR2FEW  NOT ENOUGH ARGS
  2894.           PL     X1,ERR2MNY  TOO MANY ARGS
  2895.  
  2896.  KRIGHT   BX6    X0          TRANSFER TO WRITE REGISTER 
  2897.           SA6    VARBUF+1 
  2898.           SX1    1           1 PACKAGE FOR '7CLOSE'7
  2899.           SX6    X0-1        CHECK FOR '7RECEIVE'7
  2900.           ZR     X6,KDONE 
  2901.           CALL   COMPILE     GET NEXT ARG (VAR) 
  2902.           SA2    VARBUF+1    GET OP CODE
  2903.           NZ     X2,KSKIP1   NOT '7OPEN'7, SKIP 
  2904.           NZ     B1,ERRSTOR  ERROR IF NOT STOREABLE 
  2905.  KSKIP1   BX6    X1 
  2906.           SA6    VARBUF+2 
  2907.           NZ     X2,KSKIP2   NOT '7OPEN'7, SKIP 
  2908.  
  2909. * * *  CHECK '7WRITE'7 OR '7APPEND'7 ON '7OPEN'7 COMMAND (3RD ARG)
  2910.           CALL   NXTNAME
  2911.           ZR     X6,ERRNAME  --- BRIF NOT A NAME
  2912.           SX0    0           DEFAULT TO '7WRITE'7 
  2913.           SA5    LWRITE 
  2914.           BX2    X5-X6
  2915.           ZR     X2,K3RDARG 
  2916.           SX0    1           DEFAULT TO '7APPEND'7
  2917.           SA5    LAPPEND
  2918.           BX2    X5-X6
  2919.           ZR     X2,K3RDARG 
  2920.           EQ     ERRNAME
  2921.  
  2922.  K3RDARG  BX6    X0 
  2923.           SA6    VARBUF+3 
  2924.           SX1    3           3 PACKAGE FOR '7CLOSE'7
  2925.           EQ     KDONE
  2926.  
  2927. * /---   BLOCK      -KERMIT-   00 000   79/01/22  01.29 
  2928.  KSKIP2   CALL   COMPILE     GET NUMBER OF BYTES/CHARS
  2929.           BX6    X1 
  2930.           SA6    VARBUF+3 
  2931.  
  2932.           CALL   NXTNAME
  2933.           ZR     X6,ERRNAME  --- BRIF NOT A NAME
  2934.           SX0    0           DEFAULT TO ASCII DATA
  2935.           SA2    LASCII 
  2936.           BX2    X6-X2
  2937.           ZR     X2,KTYPE 
  2938.           SX0    1           DEFAULT TO TEXT DATA 
  2939.           SA2    LTEXT
  2940.           BX2    X6-X2
  2941.           ZR     X2,KTYPE 
  2942.           EQ     ERRNAME     INVALID TAG
  2943.  
  2944.  KTYPE    BX6    X0 
  2945.           SA6    VARBUF+4 
  2946.  
  2947. *         SEE IF WE NEED TO CHECK FOR 5TH ARGUMENT
  2948.  
  2949.           SA2    VARBUF+1    GET ORIGINAL OP CODE 
  2950.           SX2    X2-2        CHECK AGAINST *SEND* CODE
  2951.           SX1    4           NUMBER OF 20-BIT PACKAGES
  2952.           ZR     X2,KDONE    EXIT -- SAVE CODE
  2953.  
  2954. *         COMPILE 5TH ARGUMENT (RECEIVE)
  2955.  
  2956.           CALL   COMPILE
  2957.           NZ     B1,ERRSTOR   ERROR IF NOT STOREABLE
  2958.           BX6    X1 
  2959.           SA6    VARBUF+5 
  2960.           SX1    5           NUMBER OF 20-BIT PACKAGES
  2961.  
  2962.  KDONE    BX6    X1          NUMBER PACKAGES EXPECTED 
  2963.           SA6    VARBUF      SAVE NUMBER OF 20-BIT PACKAGES 
  2964.           EQ     VARFIN      EXIT  -- SAVE CODE 
  2965. * 
  2966.  LOPEN    DATA   0LOPEN 
  2967.  LCLOSE   DATA   0LCLOSE
  2968.  LSEND    DATA   0LSEND 
  2969.  LRECVE   DATA   0LRECEIVE
  2970.  
  2971.  LWRITE   DATA   0LWRITE
  2972.  LAPPEND  DATA   0LAPPEND 
  2973.  
  2974.  LASCII   DATA   0LASCII
  2975.  LTEXT    DATA   0LTEXT 
  2976. * 
  2977.           ENDOV 
  2978. * /---   BLOCK      END        00 000   76/07/21  20.33 
  2979. * 
  2980. * 
  2981.           OVTABLE 
  2982. * 
  2983. * 
  2984.           END    COVLY1$
plato/source/plaopl/covlay1.txt · Last modified: 2023/08/05 18:54 by Site Administrator