Retro1.org codex

User Tools

Site Tools

Trace: • COVLAY4
plato:source:plaopl:covlay4

Table of Contents

COVLAY4

Table Of Contents

  • [00007] OVERLAYS FOR COMMAND READINS
  • [00038] -COV4- COMMAND OVERLAY
  • [00076] -STOLOAD- AND -COMLOAD-
  • [00139] -ABORT- COMMAND
  • [00200] -SEND-
  • [00333] MSRQKEY - TABLE OF -MASREQ- KEYWORDS.
  • [00369] MASREQC - PROCESS -MASREQ- COMMAND.
  • [00452] -RESERVE- / -RELEASE- COMMANDS
  • [00576] READ-IN FOR -SYSDATA- COMMAND
  • [00625] READ-IN FOR -FBIT- COMMAND
  • [00649] -TESTBIN-
  • [00667] ADD1, SUB1, ZERO AND ZERO* COMMANDS
  • [00729] -ALLOW-
  • [00764] -PERMIT-
  • [00792] -STEP-
  • [00805] -LESSIN- COMMAND
  • [00829] -INDENT- COMMAND READIN
  • [00878] -TEKTRON-
  • [00903] -REPLACE- COMMAND READIN
  • [00980] -SET- COMMAND
  • [01133] -COV4A- VARIOUS COMMAND READINS
  • [01151] -COPY-
  • [01216] STOREU
  • [01255] -BUMP-
  • [01283] MOVE
  • [01314] CIRCLE
  • [01340] -EXTOUT-
  • [01363] STOREA
  • [01394] ACCESS, SYSACC COMMAND READINS
  • [01440] ACCESS COMMAND.
  • [01557] -JOIN-, -JUMP-, -DO- COMMANDS
  • [01589] -JUMPIN-
  • [01768] -GOTO- COMMAND
  • [01918] -DO- COMMAND
  • [02217] UNIT
  • [02395] -UWRITE-
  • [02501] -UNAMA-
  • [02519] -UNAM1-
  • [02608] -UNAM2-
  • [02686] FINIS
  • [02742] COMPLETE PREVIOUS CPU UNIT
  • [02792] ENTRY
  • [02845] -INITIAL- COMMAND
  • [02889] -ROUTE-
  • [02985] TIMER, TIMEL
  • [03140] ARROW
  • [03195] EXACT
  • [03248] -FIND-
  • [03278] -FINDALL-

Source Code

COVLAY4.txt 
  1. COVLAY4 
  2. * /---   FILE TYPE = E
  3. * /---   BLOCK      COVLAY4    00 000   75/10/04  11.48 
  4.           IDENT  COVLAY4
  5.           LCC    OVERLAY(1,1) 
  6. * 
  7.           TITLE  OVERLAYS FOR COMMAND READINS 
  8. * 
  9. * 
  10.           CST 
  11. * 
  12. * 
  13.           EXT    ERRORC,PUTCODE,DATAON=,CALCODE 
  14.           EXT    COMCONT,VARFIN,NXTLINE,ALTCODE 
  15.           EXT    ECSPRTY,KEYTYPE,NKLIST,NKLEND
  16.           EXT    LNGUNIT,COMPNAM,SCANNER,UARGS,CSSCAN 
  17.           EXT    UNIT=,ARG=,DO=,DOJ=,DOC=,UNITOP= 
  18.           EXT    STORE= 
  19.           EXT    JOIN=,JOINC=,JDO=,IEUEND=
  20.           EXT    ITFFTI,DOVTYPE,ERRCALL 
  21.           EXT    PSCAN,PAUSE2 
  22.           EXT    PUTTWO 
  23.           EXT    ERRTAGS,ERRNAME,ERRSTOR
  24.           EXT    ERRXYTG,ERR2MNY,ERR2FEW
  25.           EXT    ERRTERM,ERRUARG,ERRVTYP
  26.           EXT    ERROUTR,ERRCNTD,ERRXORQ
  27.           EXT    ERRBAL 
  28.           EXT    NOINDT,UDONE 
  29.           EXT    ONETWO1,NOTAG,ERR
  30.           EXT    MRKLAST
  31.           EXT    RJERNOZ
  32. * 
  33. * 
  34.  COVLY4$  OVFILE
  35. * 
  36. * 
  37. * /---   BLOCK      COV4       00 000   80/06/24  21.42 
  38.           TITLE  -COV4-      COMMAND OVERLAY
  39. * 
  40. * 
  41. * 
  42.  COV4     OVRLAY
  43.           SA1    OVARG1      GET ARGUMENT 
  44.           SB1    X1 
  45.           JP     B1+*+1 
  46. * 
  47. +         EQ     SLOADIN     0  = -STOLOAD- 
  48. +         EQ     ABORTIN     1  = -ABORT- 
  49. +         EQ     CLEANC      2  = -CLEAN- 
  50. +         EQ     SENDC       3  = -SEND-
  51. +         EQ     MASREQC     4  = -MASREQ-
  52. +         EQ     RESERVC     5  = -RESERVE- 
  53. +         EQ     SYSDIN      6  = -SYSDATA- 
  54. +         EQ     FBITIN      7  = -FBIT-
  55. +         EQ     ADD1IN      8  = -ADD1-
  56. +         EQ     ZEROC       9  = -ZERO-
  57. +         EQ     *           10 = UNUSED
  58. +         EQ     ALLOWC      11 = -ALLOW- 
  59. +         EQ     STEPC       12 = -STEP-
  60. +         EQ     LESSINC     13 = -LESSIN-
  61. +         EQ     *           14 = UNUSED
  62. +         EQ     *           15 = UNUSED
  63. +         EQ     INDENTC     16 = -INDENT-
  64. +         EQ     SETIN       17 = -SET- 
  65. +         EQ     TEKTRON     18 = -TEKTRON- 
  66. +         EQ     REPLACC     19 = -REPLACE- 
  67. +         EQ     GETCDIN     20 = -GETCODE- 
  68. +         EQ     PERMITC     21 = -PERMIT-
  69. +         EQ     TSTBINC     22 = -TESTBIN- 
  70. +         EQ     LBC         23 = -FINDLB-, -DELLB-, -SYSABRT-
  71. +         EQ     ADDLBC      24 = -ADDLB- 
  72. +         EQ     ERRORC 
  73. * 
  74. * 
  75. * /---   BLOCK      -STOLOAD-  00 000   77/04/24  20.48 
  76.           TITLE  -STOLOAD- AND -COMLOAD-
  77. * 
  78. * 
  79. * 
  80. *         -STOLOAD- AND -COMLOAD- COMMANDS
  81. * 
  82. * 
  83.  SLOADIN  MX6    0
  84.           SA1    TAGCNT      SEE IF BLANK TAG 
  85.           ZR     X1,SLBLANK 
  86.           SA6    NCONT       CLEAR CONTINUE COUNT 
  87.           SA6    VARBUF+1    FIRST IS NUMBER OF LOADS 
  88.           SA6    VARBUF+2    SECOND IS UNUSED 
  89.           SX6    2
  90.           SA6    VARBUF      INITIALIZE VARIABLE COUNT
  91. * 
  92.  SLOLP    CALL   VARDO2      GET FIRST VARIABLE 
  93.           SA1    VARBUF 
  94.           SA2    X1+VARBUF   LOAD -GETVAR- CODE 
  95.           NG     X2,ERRSTOR   EXIT IF NOT STOREABLE 
  96.           MX0    -3 
  97.           AX2    XCODEAL     POSITION TYPE CODE 
  98.           BX2    -X0*X2 
  99.           SX2    X2-2        SEE IF STUDENT BANK REFERENCE
  100.           ZR     X2,SLERR2
  101.           CALL   VARDO2      GET NEXT TWO VARIABLES 
  102.           CALL   VARDO2 
  103.           SA1    LASTKEY
  104.           NZ     X1,ERR2MNY   MUST BE E-O-L 
  105.           SA1    NEXTCOM
  106.           SA2    COMCONT     SEE IF CONTINUED 
  107.           BX2    X1-X2
  108.           ZR     X2,ISSCONT  JUMP IF CONTINUED
  109.           SA1    NCONT
  110.           SX6    X1+1        NUMBER OF LOAD SELECTIONS
  111.           SA6    VARBUF+1 
  112.           SA1    VARBUF      NUMBER OF -GETVAR- CODES 
  113.           EQ     VARFIN      PACK UP -GETVAR- CODES 
  114. * 
  115.  ISSCONT  CALL   GETLINE     GET NEXT LINE OF COMMAND 
  116.           SA1    NCONT
  117.           SX2    X1-2        SEE IF TOO MANY CONTINUES
  118.           PL     X2,SLERR1
  119.           SX6    X1+1 
  120.           SA6    A1 
  121.           EQ     SLOLP
  122. * 
  123.  SLBLANK  SA1    NEXTCOM     SEE IF CONTINUED 
  124.           SA2    COMCONT
  125.           BX2    X1-X2
  126.           ZR     X2,ERRCNTD   ERROR IF CONTINUED
  127.           EQ     PUTCODE
  128. * 
  129.  SLERR1   SB1    49          TOO MANY 
  130.           EQ     =XERR
  131. * 
  132.  SLERR2   SB1    50          NOT COMMON 
  133.           EQ     =XERR
  134. * 
  135.  NCONT    BSS    1
  136. * 
  137. * 
  138. * /---   BLOCK      ABORT      00 000   80/02/15  22.08 
  139.           TITLE  -ABORT- COMMAND
  140. * 
  141. * 
  142. *         -ABORT- COMMAND 
  143. *         ABORT VARIOUS SYSTEM FUNCTIONS
  144. * 
  145. * 
  146.  ABORTIN  SB1    ABLIST 
  147.           SB2    ABEND
  148.           MX5    60 
  149.           RJ     SCANNER
  150.           ZR     X0,PUTCODE 
  151.           EQ     ERRNAME
  152. * 
  153.  ABLIST   VFD    60/6LCOMMON
  154.           VFD    60/6LRECORD
  155.           VFD    60/9LAUTOCHECK 
  156.           VFD    60/7LLESLIST 
  157.  ABEND    BSS    1
  158. * 
  159. * 
  160. * 
  161. *         CONDENSE ROUTINE FOR LESSON BUFFER COMMANDS 
  162. *         USED BY -FINDLB-, -DELLB-, -SYSABRT-
  163. * 
  164.  LBC      CALL   SYSTEST     SYSTEM LESSONS ONLY
  165.           CALL   FILEBLK     GET ACCOUNT';FILE, BLOCK 
  166.           ZR     X1,ERR2FEW  ERROR IF BLANK TAG 
  167.           CALL   VARDOR      GET LESSON BUFFER TYPE 
  168.           SX1    4           4 ARGUMENTS LEGAL
  169.           EQ     VARFIN 
  170. * 
  171. * 
  172. *         -ADDLB- COMMAND 
  173. * 
  174.  ADDLBC   CALL   SYSTEST     SYSTEM LESSONS ONLY
  175.           CALL   FILEBLK     GET ACCOUNT';FILE, BLOCK 
  176.           ZR     X1,ERR2FEW  ERROR IF BLANK TAG 
  177.           CALL   VARDOR      GET BUFFER TYPE AND LENGTH 
  178.           SX1    5           5 ARGUMENTS LEGAL
  179.           EQ     VARFIN 
  180. * 
  181. * /---   BLOCK      CLEAN      00 000   80/06/24  22.28 
  182. * 
  183. * *       -CLEAN- COMMAND 
  184. * 
  185.  CLEANC   RJ     VARDO       COMMA SEPARATED VARIABLES
  186.           SX1    2           PRESET TO 2 ARGS FOR *VARFIN*
  187.           SA2    VARBUF      CHECK NUMBER OF ARGUMENTS
  188.           ZR     X2,ERR2FEW  MUST BE AT LEAST 1 
  189.           SA3    VARBUF+1 
  190.           NG     X3,ERRSTOR  --- 1ST ARG MUST BE STOREABLE
  191.           SX2    X2-2        CHECK IF 1 OR 2 ARGUMENTS
  192.           ZR     X2,VARFIN   --- DONE IF 2 ARGUMENTS
  193.           PL     X2,ERR2MNY  --- ERROR IF > 2 ARGUMENTS 
  194.           SX6    1
  195.           SA6    VARBUF+2    FAKE 2ND GETVAR CODE = 1 
  196.           SX6    2
  197.           SA6    VARBUF      SET NUMBER OF ARGUMENTS TO 2 
  198.           EQ     VARFIN      --- FINISH UP
  199. * /---   BLOCK      SEND       00 000   80/03/16  06.34 
  200.           TITLE  -SEND- 
  201. * 
  202. *         -SEND- COMMAND
  203. * 
  204. *         SEND    STATION,WHERE,BUFFER,LENGTH 
  205. *         SEND    STATION,BEEP
  206. *         SEND    STATION,ERASE 
  207. * 
  208. *         SEND    STATION,ON,WHERE,BUFFER,LENGTH
  209. *         SEND    STATION,OFF,WHERE,BUFFER,LENGTH 
  210. *         SEND    STATION,ALL,WHERE,BUFFER,LENGTH 
  211. * 
  212. *         SEND    STATION,ON,BEEP 
  213. *         SEND    STATION,OFF,BEEP
  214. *         SEND    STATION,ALL,BEEP
  215. * 
  216. *         SEND    STATION,ON,ERASE
  217. *         SEND    STATION,OFF,ERASE 
  218. *         SEND    STATION,ALL,ERASE 
  219. * 
  220. * 
  221. *         -SEND- IS A SYSTEM COMMAND TO SEND TEXT,
  222. *         BEEPS AND FULL-SCREEN ERASES TO ACTIVE OR 
  223. *         INACTIVE TERMINALS OR BOTH (ONLY ACTIVE 
  224. *         TERMINALS CAN BE BEEPED)
  225. * 
  226. *         THE GETVAR CODES ARE USED AS FOLLOWS -- 
  227. * 
  228. *                CODE 1  --  STATION NUMBER (-1 IF OUTPUT 
  229. *                            IS FOR ALL STATION)
  230. *                CODE 2  --  10/0,5/STYPE,5/SWHO
  231. *                CODE 3  --  SCREEN POSITION IF TEXT OPTION 
  232. *                CODE 4  --  BUFFER WITH TEXT 
  233. *                CODE 5  --  LENGTH OF TEXT IN CHARACTERS 
  234. * 
  235. *                STYPE = 0 = TEXT 
  236. *                        1 = BEEP 
  237. *                        2 = ERASE
  238. * 
  239. *                SWHO = 0 = ACTIVE STATIONS 
  240. *                       1 = BOTH
  241. *                       2 = INACTIVE STATIONS 
  242. * 
  243. *         AT EXECUTION TIME *STYPE* AND *SWHO* ARE
  244. *         CHANGED TO DECREMENTED BY 1.
  245. * 
  246. * /---   BLOCK      SEND       00 000   80/03/16  06.44 
  247.  
  248.  SENDC    CALL   SYSTEST
  249.           CALL   VARDO1      DECODE FIRST ARGUMENT
  250.           SX6    0
  251.           SA6    SWHO        PRESET FOR ACTIVE STATIONS 
  252.           SA1    WORDPT 
  253.           BX6    X1 
  254.           SA6    OLDPT       SAVE CHAR POINTER
  255.           SX6    2           SAVE 2ND VARBUF CODE 
  256.           SA6    VARBUF 
  257.           CALL   NXTNAME     NEXT TAG RETURNED IN X6
  258. *                            SEPARATOR IN X1
  259.           ZR     X1,SBEEP 
  260.           SA1    ONOFFTAB-1  PRESET (A1) FOR SEARCH 
  261.           MX0    48 
  262.  ONOFFL   SA1    A1+1        (X1) = NEXT KEYWORD
  263.           ZR     X1,SENORM   OLD TEXT -SEND- IF END OF TABLE
  264.           BX2    X0*X1
  265.           BX2    X2-X6
  266.           NZ     X2,ONOFFL   --- IF NO MATCH
  267.           BX6    -X0*X1      (X6) = ACTIVE/INACTIVE CODE
  268.           SA6    SWHO 
  269.           SA1    WORDPT 
  270.           BX6    X1 
  271.           SA6    OLDPT       ADVANCE SAVED CHAR POINTER 
  272.           CALL   NXTNAME     (X6) = PARAMETER, (X) = SEP. 
  273.           NZ     X1,SENORM   --- NORMAL TEXT IF NOT EOL 
  274.  SBEEP    SA1    KBEEP
  275.           BX2    X6-X1       SEE IF 4LBEEP
  276.           NZ     X2,SERASE   --- IF NOT BEEP OPTION 
  277.           SX6    1           TYPE 1 = BEEP
  278.           EQ     SENDFIN
  279.  SERASE   SA1    KERASE 
  280.           BX2    X1-X6       SEE IF 5LERASE 
  281.           NZ     X2,ERRTAGS  --- IF NOT ERASE OPTION
  282.           SX6    2           TYPE 2 = ERASE 
  283.           EQ     SENDFIN
  284. * /---   BLOCK      SEND       00 000   80/03/16  06.42 
  285. * 
  286.  BEEPCON  VFD    20/0,1/1,19/1,20/0 
  287.  KBEEP    DATA   0LBEEP 
  288.  KERASE   DATA   0LERASE
  289. * 
  290.  ONOFFTAB VFD    48/0LON,12/0 
  291.           VFD    48/0LALL,12/1
  292.           VFD    48/0LOFF,12/2
  293.           DATA   0           MARK END OF TABLE
  294. * 
  295.  SWHO     BSS    1           FOR ACTIVE/INACTIVE/BOTH INFO
  296.  STYPE    BSS    1           FOR TEXT/SEND/ERASE OPTION 
  297.  
  298. * 
  299. *         CONDENSE NORMAL TEXT -SEND- 
  300. * 
  301.  
  302.  SENORM   SA1    OLDPT       NORMAL SEND CONDENSE 
  303.           BX6    X1 
  304.           SA6    WORDPT      RESTORE WORDPT 
  305. * 
  306.  SGETA    CALL   VARDO2      GET NEXT ARGUMENT
  307.           SA1    LASTKEY
  308.           NZ     X1,SGETA    CONTINUE IF NOT E-O-L
  309. * 
  310.           SA1    VARBUF 
  311.           SX1    X1-5        MUST BE 5 ARGUMENTS
  312.           NZ     X1,ERRTAGS 
  313.           SA1    VARBUF+4    4TH ARG MUST BE STOREABLE
  314.           NG     X1,ERRSTOR 
  315.  
  316.           SX6    0           TYPE 0 = TEXT
  317.  
  318. * 
  319. *         FORMAT SEND GETVAR CODE (10/0,5/STYPE,5/SWHO) 
  320. *         AND EXIT TO *VARFIN*
  321. * 
  322. *         COME HERE WITH (X6) = TYPE OF SEND
  323. * 
  324.  
  325.  SENDFIN  LX6    5
  326.           SA2    SWHO 
  327.           BX6    X6+X2
  328.           SA6    VARBUF+2 
  329.           SA1    VARBUF      (X1) = NUMBER OF VARBUF CODES
  330.           EQ     VARFIN 
  331.  MASREQC  TITLE  -MASREQ- READIN
  332.  MSRQKEY  SPACE  4,15 
  333. **        MSRQKEY - TABLE OF -MASREQ- KEYWORDS. 
  334. * 
  335. *         MSRQKEY KEYWORD,NUMARGS,NUMPUTV,NUMSTOR 
  336. * 
  337. *T        42/7LKEYWORD,6/NUMARGS,6/NUMPUTV,6/NUMSTOR
  338. * 
  339. *         KEYWORD = VALID KEYWORD FOR -MASREQ- COMMAND
  340. *         NUMARGS = TOTAL NUMBER OF ARGUMENTS REQUIRED
  341. *         NUMPUTV = POSITION OF ARGUMENT REQUIRING A PUTVAR 
  342. *                   CODE.  IF = 0, NONE IS REQUIRED.
  343. *         NUMSTOR = POSITION OF ARGUMENT WHICH MUST BE
  344. *                   STOREABLE.  IF = 0, NONE IS REQUIRED. 
  345.  
  346.  
  347.           PURGMAC MSRQKEY 
  348.           MACREF MSRQKEY$ 
  349.  MSRQKEY  MACRO  KEYWORD,NUMARGS,NUMPUTV,NUMSTOR
  350.           MACREF MSRQKEY
  351.           IFC    EQ,*KEYWORD**
  352.           DATA   0
  353.           ELSE
  354.           VFD    42/0L_KEYWORD,6/NUMARGS,6/NUMPUTV,6/NUMSTOR
  355.           ENDIF 
  356.           ENDM
  357.  
  358.  MSRQTAB  MSRQKEY ACTION,5,0,0
  359.           MSRQKEY CONSOLE,7,0,0 
  360.           MSRQKEY JOBLIST,4,0,3 
  361.           MSRQKEY JOBSTAT,4,4,0 
  362.           MSRQKEY PPU,5,0,0 
  363.           MSRQKEY SCR,3,0,3 
  364.           MSRQKEY STATUS,3,3,0
  365.           MSRQKEY CONFIG,3,0,3
  366.           MSRQKEY            END OF MSRQTAB 
  367.  MASREQC  SPACE  4,25 
  368. * /---   BLOCK      SEND       00 000   80/03/16  06.42 
  369. **        MASREQC - PROCESS -MASREQ- COMMAND. 
  370. * 
  371. *         CALLS  ERRSTOR, ERRTERM, ERR2FEW, ERR2MNY, MRKLAST, 
  372. *                NXTNAM, PUTDO2, SYSTEST, VARDO1, VARDO2. 
  373. * 
  374. *         MACROS CALL 
  375.  
  376.  MASREQC  CALL   SYSTEST     CHECK FOR SYSTEM LESSON
  377.           SA1    SYSFLG      (X1) = SYSTEM LESSON ATTRIBUTES
  378.           LX1    ZMASSHF     SHIFT TO *MAS* PERMISSION BIT
  379.           PL     X1,ERRORC   IF NO -MASREQ- PERMISSION
  380.           CALL   VARDO1      PROCESS *MFN* ARGUMENT 
  381.           SA1    WORDPT      (X1) = POINTER TO CURRENT CHAR 
  382.           SA1    X1-1        (X1) = DELIMITER (PREVIOUS CHR)
  383.           ZR     X1,ERR2FEW  IF END OF LINE 
  384.           SX6    X1-1R, 
  385.           NZ     X6,ERRTERM  IF NOT A COMMA 
  386.           CALL   NXTNAM      (X6) = NEXT TAG, (X1) = SEPARATOR
  387.           ZR     X6,ERR2FEW  IF END OF LINE 
  388.           BX7    X1 
  389.           SA7    LASTKEY     SAVE LAST DELIMITER
  390.  
  391. *         SEARCH FOR KEYWORD IN TABLE.
  392.  
  393.           SA1    MSRQTAB-1
  394.           MX0    42 
  395.  MAS1     SA1    A1+1 
  396.           ZR     X1,ERRNAME  IF INVALID KEYWORD 
  397.           BX2    X1*X0
  398.           BX3    X2-X6
  399.           NZ     X3,MAS1     IF KEYWORD NOT FOUND 
  400.           SX7    A1-MSRQTAB+1  STORE KEYWORD ORDINAL
  401.           SA7    VARBUF+2 
  402.           MX0    -6          STORE STOREABLE NUMBER 
  403.           BX7    -X0*X1 
  404.           SA7    NUMSTOR
  405.           LX1    -6          STORE PUTVAR NUMBER
  406.           BX7    -X0*X1 
  407.           SA7    NUMPUTV
  408.           LX1    -6          STORE NUMBER OF ARGUMENTS
  409.           BX7    -X0*X1 
  410.           SA7    NUMARGS
  411.           SX7    2           CURRENT ARGUMENT POSITION
  412.           SA7    VARBUF 
  413.           SA7    ARGCNT 
  414.  MAS3     SA1    ARGCNT      INCREMENT ARGUMENT COUNT 
  415.           SX7    X1+1 
  416.           SA7    ARGCNT 
  417.           SA2    LASTKEY     CHECK DELIMITER
  418.           ZR     X2,ERR2FEW  IF END OF LINE 
  419.           SX6    X2-1R, 
  420.           NZ     X6,ERRTERM  IF NOT A COMMA 
  421.           SA2    NUMPUTV     CHECK FOR PUTVAR REQUIRED
  422.           BX6    X7-X2
  423.           ZR     X6,MAS5     IF PUTVAR REQUIRED 
  424.           CALL   VARDO2      GENERATE GETVAR CODE 
  425.           SA2    NUMSTOR     CHECK IF STORE NEEDED
  426.           SA3    ARGCNT 
  427.           BX6    X3-X2
  428.           NZ     X6,MAS10    IF NO STORE NEEDED 
  429. * /---   BLOCK      SEND       00 000   80/03/16  06.42 
  430.           NG     X1,ERRSTOR  IF NOT STOREABLE 
  431.           EQ     MAS10
  432.  
  433.  MAS5     CALL   PUTDO2      GENERATE PUTVAR CODE 
  434.  MAS10    SA1    ARGCNT      CHECK FOR LAST ARGUMENT
  435.           SA2    NUMARGS
  436.           BX3    X2-X1
  437.           NZ     X3,MAS3     IF MORE ARGUMENTS
  438.           SA1    WORDPT      CHECK FOR END OF LINE
  439.           SA1    X1 
  440.           NZ     X1,ERR2MNY  IF TOO MANY ARGUMENTS
  441.           EQ     MRKLAST     TERMINATE GETVAR TABLE 
  442.  
  443.  ARGCNT   OVDATA 1           CURRENT ARGUMENT NUMBER
  444.  NUMARGS  OVDATA 1           NUMBER OF ARGUMENTS REQUIRED 
  445.  NUMPUTV  OVDATA 1           POSITION OF PUTVAR ARGUMENT
  446.  NUMSTOR  OVDATA 1           POSITION OF STOREABLE ARGUMENT 
  447. * 
  448. * 
  449. * 
  450. * /---   BLOCK      RESERVE    00 000   80/03/12  01.03 
  451. * 
  452.           TITLE  -RESERVE- / -RELEASE- COMMANDS 
  453. * 
  454. * 
  455. * 
  456. *         -RESERVE- / -RELEASE- COMMANDS
  457. * 
  458. *         RESERVE   COMMON
  459. *         RESERVE   FILE
  460. *         RESERVE   RECORDS,BLOCK (,NBLOCKS)
  461. *         RESERVE   NAME
  462. *         RESERVE   SIGNON (,PERMANENT)   $$ SYSTEM LESSONS 
  463. *         RESERVE   DIRECTORY $$ DATASETS, NAMESETS, GROUPS 
  464. *         RESERVE   ATTACH
  465. *         RESERVE   LESLIST 
  466. * 
  467. * 
  468.  RESERVC  CALL   NXTNAME     GET NAME IN X6, SEP. IN X1 
  469.           SA3    KCOMM
  470.           BX3    X3-X6       CHECK FOR *COMMON* 
  471.           ZR     X3,RESVCOM 
  472.           SA3    KFILE
  473.           BX3    X3-X6       CHECK FOR *FILE* 
  474.           ZR     X3,RESVFIL 
  475.           SA3    KRECS
  476.           BX3    X3-X6       CHECK FOR *RECORDS*
  477.           ZR     X3,RESVREC 
  478.           SA3    KNAME
  479.           BX3    X3-X6       CHECK FOR *NAME* 
  480.           ZR     X3,RESVNAM 
  481.           SA3    KSIGNON
  482.           BX3    X3-X6       CHECK FOR *SIGNON* 
  483.           ZR     X3,RESVSIG 
  484.           SA3    KDIRECT
  485.           BX3    X3-X6       CHECK FOR *DIRECTORY*
  486.           ZR     X3,RESVDIR 
  487.           SA3    KATTACH
  488.           BX3    X3-X6       CHECK FOR *ATTACH* 
  489.           ZR     X3,RESVATT 
  490.           SA3    KLESLST
  491.           IX3    X3-X6       CHECK FOR *LESLIST*
  492.           ZR     X3,RESVLST 
  493.           SA3    KSIGNO 
  494.           BX3    X3-X6       CHECK FOR *SIGNOUT*
  495.           ZR     X3,RESVSGN 
  496.           EQ     ERRNAME
  497. * 
  498.  RESVCOM  NZ     X1,ERR2MNY  MUST BE E-O-L
  499.           MX6    0           0 = ENTIRE COMMON
  500.           EQ     PUTCODE
  501. * 
  502.  RESVFIL  NZ     X1,ERR2MNY  MUST HAVE NO ARGUMENTS 
  503.           SX6    1           1 = ENTIRE FILE
  504.           LX6    XCMNDL      SHIFT PAST COMMAND CODE
  505.           EQ     PUTCODE
  506. * 
  507.  RESVNAM  NZ     X1,ERR2MNY  MUST HAVE NO ARGUMENTS 
  508.           SX6    2           2 = ENTIRE NAME (IN NAMESET) 
  509.           LX6    XCMNDL 
  510.           EQ     PUTCODE
  511. * /---   BLOCK      RESERVE    00 000   80/08/07  02.17 
  512. * 
  513. * 
  514.  RESVREC  CALL   VARDO
  515.           SA1    VARBUF 
  516.           SX2    X1-2 
  517.           ZR     X2,RESVD2
  518.           PL     X2,ERR2MNY 
  519.           SX2    X1-1 
  520.           NZ     X2,ERRTAGS 
  521. *         ONLY ONE ARG--SET DEFAULT VALUE 
  522.           SX7    1
  523.           SA7    VARBUF+2 
  524.           IX7    X7+X7
  525.           SA7    VARBUF      RESET ARGUMENT COUNT 
  526.  RESVD2   CALL   VARFEM 
  527.           MX2    -XSPTRL     THIS IS BECAUSE VARFEM ALWAYS
  528.           LX2    XCMNDL      INSERTS THE XSTOR POINTER
  529.           BX6    X2*X6       ZERO OUT EXTRA STORAGE POINTER 
  530.           SX3    3           3 = DATASET RECORDS
  531.           LX3    XCMNDL      SHIFT PAST COMMAND CODE
  532.           BX6    X6+X3       MARK AS A DATASET -RESERVE-
  533.           EQ     PUTCODE
  534. * 
  535.  RESVSIG  NZ     X1,ERR2MNY  --- IF ADDITIONAL TAGS 
  536.           CALL   SYSTST1     SYSTEM LESSONS ONLY
  537.           SX6    4           4 = PLATO SIGNON 
  538.           LX6    XCMNDL 
  539.           EQ     PUTCODE
  540. * 
  541.  RESVDIR  NZ     X1,ERR2MNY  MUST HAVE NO ARGUMENTS 
  542.           SX6    5           5 = DIRECTORY
  543.           LX6    XCMNDL 
  544.           EQ     PUTCODE
  545. * 
  546.  RESVATT  NZ     X1,ERR2MNY  MUST HAVE NO ARGUMENTS 
  547.           CALL   SYSTEST     SYSTEM LESSONS ONLY
  548.           SX6    6           6 = ATTACH 
  549.           LX6    XCMNDL 
  550.           EQ     PUTCODE
  551. * 
  552. * 
  553.  RESVLST  NZ     X1,ERR2MNY  MUST HAVE NO ARGUMENTS 
  554.           SX6    7           7 = LESLIST
  555.           LX6    XCMNDL 
  556.           EQ     PUTCODE
  557. * 
  558.  RESVSGN  NZ     X1,ERR2MNY  MUST HAVE NO ARGUMENTS 
  559.           CALL   SYSTST1     SPECIAL SYSTEM LESSONS ONLY
  560.           SX6    8           6 = SIGNOUT
  561.           LX6    XCMNDL 
  562.           EQ     PUTCODE
  563. * 
  564.  KLESS    DATA   0LLESSON 
  565.  KCOMM    DATA   0LCOMMON 
  566.  KRECS    DATA   0LRECORDS
  567.  KFILE    DATA   0LFILE 
  568.  KNAME    DATA   0LNAME 
  569.  KSIGNON  DATA   0LSIGNON 
  570.  KDIRECT  DATA   0LDIRECTORY
  571.  KATTACH  DATA   0LATTACH 
  572.  KLESLST  DATA   0LLESLIST
  573.  KSIGNO   DATA   0LSIGNOUT
  574. * 
  575. * /---   BLOCK      -SYSDATA-  00 000   81/01/08  01.08 
  576.           TITLE  READ-IN FOR -SYSDATA- COMMAND
  577. * 
  578. * 
  579. * 
  580. *         -SYSDATA- COMMAND 
  581. * 
  582.  SYSDIN   CALL   SYSTEST     SYSTEM LESSONS ONLY
  583.           CALL   NXTNAME      DECODE OPTION NAME **** 
  584.           SA1    KSETF
  585.           IX1    X1-X6
  586.           ZR     X1,SDSET    JUMP IF SETFILE
  587.           SA1    KREW 
  588.           IX1    X1-X6
  589.           ZR     X1,SDREW    JUMP IF REWIND 
  590.           SA1    KCHECK 
  591.           IX1    X1-X6
  592.           ZR     X1,SDCHK    JUMP IF CHECKPT
  593.           EQ     ERRNAME     ERROR IF UNRECOGNIZED OPTION 
  594. * 
  595. *         GET ACCOUNT';FILE FOR -SETFILE- FORM
  596. * 
  597.  SDSET    CALL   ACCFILE,VARBUF+2,0 
  598.           ZR     X1,ERR2FEW  ERROR IF NO FILE GIVEN 
  599.           SA1    LASTKEY
  600.           NZ     X1,ERR2MNY  ERROR IF EXTRA ARGUMENTS 
  601.           SX6    0           SET OPTION NUMBER
  602.           SA6    VARBUF+1 
  603.           SX6    3           THREE ARGUMENTS
  604.           SA6    VARBUF 
  605.           BX1    X6 
  606.           EQ     VARFIN 
  607. * 
  608.  SDREW    SX6    1           REWIND OPTION
  609.           EQ     SDRC 
  610. * 
  611.  SDCHK    SX6    2           CHECKPT OPTION 
  612. * 
  613.  SDRC     LX6    60-XCODEL   POSITION OPTION NUMBER 
  614.           SA1    WORDPT      POINTER TO LAST CHARACTER
  615.           SA1    X1 
  616.           ZR     X1,PUTCODE  EXIT IF END OF LINE
  617.           EQ     ERR2MNY     ERROR IF EXTRA ARGUMENTS 
  618. * 
  619. * 
  620.  KSETF    DATA   0LSETFILE
  621.  KREW     DATA   0LREWIND 
  622.  KCHECK   DATA   0LCHECKPT
  623. * 
  624. * 
  625.           TITLE  READ-IN FOR -FBIT- COMMAND 
  626. * 
  627. * 
  628. * 
  629. *         -FBIT- COMMAND
  630. *         FIRST ARG = FILE NAME 
  631. *         SECOND    = ON OR OFF 
  632. * 
  633. * 
  634.  FBITIN   CALL   SYSTEST     SYSTEM LESSONS ONLY
  635.           CALL   COMPILE     GET -GETVAR- CODE FOR FILE NAME
  636.           LX1    60-XCODEL
  637.           BX6    X1          SAVE 
  638.           SA6    VARBUF 
  639.           CALL   COMPSYM,FBLST,2
  640.           LX1    60-2*XCODEL
  641.           SA2    VARBUF 
  642.           BX6    X1+X2
  643.           EQ     PUTCODE
  644. * 
  645.  FBLST    VFD    42/0LON,18/1 
  646. +         VFD    42/0LOFF,18/0
  647. * 
  648. * 
  649.           TITLE  -TESTBIN-
  650. * 
  651. *         -TESTBIN- COMMAND 
  652. * 
  653. *         CHECK FOR EXISTANCE OF BINARY 
  654. * 
  655. * 
  656.  TSTBINC  CALL   SYSTEST     SYSTEM LESSONS ONLY
  657.           CALL   ACCFILF     GET ACCOUNT';FILE NAME 
  658.           ZR     X1,ERR2FEW  ERROR IF BLANK TAG 
  659.           SA2    LASTKEY
  660.           ZR     X2,MRKLAST  EXIT IF END OF LINE
  661.           CALL   VARDO2 
  662.           SA2    LASTKEY
  663.           ZR     X2,MRKLAST  EXIT IF END OF LINE
  664.           EQ     ERR2MNY     NO MORE THAN 2 ARGUMENTS 
  665. * 
  666. * /---   BLOCK      -ADD1-     00 000   77/04/24  20.21 
  667.           TITLE  ADD1, SUB1, ZERO AND ZERO* COMMANDS
  668. * 
  669. * 
  670. *         -ADD1- AND -SUB1- COMMANDS
  671. * 
  672. * 
  673.  ADD1IN   CALL   TAGSAVE     SAVE *TAG* BUFFER
  674.           SA1    WORDPT 
  675.           BX6    X1          SAVE *WORDPT*
  676.           SA6    VARBUF+1 
  677.           CALL   COMPILE
  678.           BX6    X1          SAVE -GETVAR- CODE 
  679.           SA6    VARBUF 
  680.           CALL   TAGREST     (COMPILE MAY MODIFY *TAG*) 
  681.           SA1    VARBUF+1 
  682.           BX6    X1 
  683.           SA6    WORDPT      RESET *WORDPT* 
  684.           CALL   PUTCOMP
  685.           SA2    VARBUF      LOAD FIRST -GETVAR- CODE 
  686.           LX2    60-XCODEL
  687.           LX1    60-XCODEL-XCODEL 
  688.           BX6    X1+X2       MERGE READ/STORE -GETVAR- CODES
  689.           EQ     PUTCODE
  690. * 
  691. * 
  692. * 
  693. *         -ZERO- COMMAND
  694. * 
  695. * 
  696.  ZEROC    SA1    WORDPT      POINTER TO FIRST CHARACTER 
  697.           MX0    0           NO SPECIAL TERMINATOR
  698.           CALL   PSCAN       FIND END OF FIRST ELEMENT
  699.           NZ     X1,ZERO2A   JUMP IF TWO ARGUMENT COMMAND 
  700.           CALL   PUTCOMP
  701.           BX6    X1          POSITION -GETVAR- CODE 
  702.           LX6    60-XCODEL
  703.           EQ     PUTCODE
  704. * 
  705. * 
  706. * 
  707. *MUST TEST THAT THERE ARE NO MORE THAN 2 ARGS.....
  708. * 
  709.  ZERO2A   CALL   COMPILE     DECODE FIRST VARIABLE
  710.           NZ     B1,ERRSTOR 
  711.           BX6    X1 
  712.           SA6    VARBUF      SAVE -GETVAR- CODE 
  713.           CALL   COMPILE
  714.           SA2    WORDPT      CHECK FOR END-OF-LINE
  715.           SA2    X2          DO INDIRECT ACCESS 
  716.           NZ     X2,ERR2MNY   ERROR IF NOT EOL
  717.           SA2    VARBUF 
  718.           LX2    60-XCODEL   POSITION -GETVAR- CODES
  719.           LX1    60-XCODEL-XCODEL 
  720.           BX6    X1+X2
  721.           SA1    COMNUM 
  722.           SX1    X1+1        INCREMENT COMMAND NUMBER 
  723.           BX6    X1+X6
  724.           EQ     ALTCODE
  725. * 
  726. * 
  727. * /---   BLOCK      ALLOW      00 000   79/07/19  23.15 
  728. * 
  729.           TITLE  -ALLOW-
  730. * 
  731. *         -ALLOW- COMMAND 
  732. * 
  733. *         ALLOW ACCESS TO ROUTER LESSONS COMMON 
  734. * 
  735. * 
  736.  ALLOWC   SA1    ROUTER      MUST BE -ROUTER- LESSON
  737.           ZR     X1,ERROUTR 
  738.           CALL   NXTNAME      GET ALLOW TYPE **** 
  739.           NZ     X1,ERR2MNY   MUST BE END-OF-LINE 
  740.           SB1    B0 
  741.           ZR     X6,ALLW1    JUMP IF BLANK
  742.           SB1    B1+1 
  743.           SA1    KRD
  744.           BX1    X1-X6
  745.           ZR     X1,ALLW1    JUMP IF *READ* 
  746.           SB1    B1+1 
  747.           SA1    KWT
  748.           BX1    X1-X6
  749.           ZR     X1,ALLW1    JUMP IF *WRITE*
  750.           SB1    B1+1 
  751.           SA1    RVREAD 
  752.           BX1    X1-X6
  753.           NZ     X1,ERRNAME   MUST BE *READ RVARS*
  754. * 
  755.  ALLW1    SX6    B1          PICK UP TYPE 
  756.           LX6    60-12
  757.           EQ     PUTCODE     --- ADD COMMAND CODE AND STORE 
  758. * 
  759.  RVREAD   DATA   10LREAD RVARS
  760.  KRD      DATA   0LREAD 
  761.  KWT      DATA   0LWRITE
  762. * 
  763. * 
  764.           TITLE  -PERMIT- 
  765. * 
  766. *         -PERMIT- COMMAND
  767. * 
  768. *         PERMIT VARIOUS THINGS IN A LESSON 
  769. * 
  770. * 
  771.  PERMITC  CALL   NXTNAME      GET ALLOW TYPE **** 
  772.           NZ     X1,ERR2MNY   MUST BE END-OF-LINE 
  773.           SB1    B0 
  774.           ZR     X6,PRMT1    JUMP IF BLANK
  775.           SB1    B1+1 
  776.           SA1    KSR
  777.           BX1    X1-X6
  778.           ZR     X1,PRMT1    JUMP IF *SHORT RECS* 
  779.           SA1    KSRNS
  780.           BX1    X1-X6
  781.           ZR     X1,PRMT1    JUMP IF *SHORTRECS*
  782.           NZ     X1,ERRNAME  MUST BE *SHORTRECS*
  783. * 
  784.  PRMT1    SX6    B1          PICK UP TYPE 
  785.           LX6    60-12
  786.           EQ     PUTCODE     --- ADD COMMAND CODE AND STORE 
  787. * 
  788.  KSR      DATA   10LSHORT RECS
  789.  KSRNS    DATA   0LSHORTRECS
  790. * 
  791. * 
  792.           TITLE  -STEP- 
  793. * 
  794. *         -STEP- COMMAND
  795. * 
  796. *         INITIATE/TERMINATE STEP MODE EXECUTION
  797. * 
  798. * 
  799.  STEPC    CALL   COMPSYM,STEPOPT,2
  800.           EQ     CALCODE
  801. * 
  802.  STEPOPT  VFD    42/2LON,18/1 
  803. +         VFD    42/3LOFF,18/0
  804. * /---   BLOCK      -LESSIN-   00 000   80/02/02  22.08 
  805.           TITLE  -LESSIN- COMMAND 
  806. * 
  807. * 
  808. * 
  809. *         -LESSIN- COMMAND
  810. *         CHECKS TO SEE IF A LESSON IS IN ECS 
  811. * 
  812. * 
  813.  LESSINC  BSS    0
  814. * 
  815. * CONDENSE FILE NAME AS NORMAL TUTOR EXPRESSION 
  816. * 
  817.           CALL   ACCFILE,VARBUF+1,1 
  818.           ZR     X1,ERR2FEW  ERROR IF BLANK TAG 
  819.           SA2    LASTKEY
  820.           NZ     X2,ERR2MNY  ERROR IF EXTRA ARGUMENTS 
  821.           SX1    2           2 ARGUMENTS LEGAL
  822.           BX6    X1 
  823.           SA6    VARBUF      2 ARGUMENTS FOUND
  824.           EQ     VARFIN 
  825. * 
  826. * 
  827. * 
  828. * /---   BLOCK      INDENT     00 000   77/09/15  20.17 
  829.           TITLE  -INDENT- COMMAND READIN
  830.  INDENTC  CALL   VARDO
  831. *         MAKE SURE THAT ARGUMENTS 1,3,4,5,6 ARE STOREABLE
  832.           SA1    VARBUF+1 
  833.           NG     X1,=XERRSTOR 
  834.           SA1    VARBUF+3 
  835.           NG     X1,=XERRSTOR 
  836.           SA1    VARBUF+4 
  837.           NG     X1,=XERRSTOR 
  838.           SA1    VARBUF+5 
  839.           NG     X1,=XERRSTOR 
  840.           SA1    VARBUF+6 
  841.           NG     X1,=XERRSTOR 
  842.           SX1    6           MUST HAVE EXACTLY SIX ARGUMENTS
  843.           EQ     =XVARFIN 
  844. * 
  845. *         -COUNTLN- COMMAND 
  846. * 
  847. *         FORMAT OF COMMAND 
  848. *         COUNTLN START,LENGTH,POS,COUNT,RETURN[,MODS]
  849. *         MAKE SURE THAT ARGUMENTS 1 AND 5 ARE STORABLE 
  850. * 
  851. *******   REMOVED THE CONDENSE ROUTINE FOR -COUNTLN- SINCE
  852. *******   IT SEEMS DOUBTFUL THAT ANYONE WILL EVER FINISH
  853. *******   THIS FOUR YEAR OLD PROJECT. 
  854. *******   D. WOOLLEY  81/08/10
  855. * 
  856. * CNTLNC   BSS    0 
  857. *          RJ     SYSTEST     SYSTEM LESSONS ONLY FOR NOW 
  858. *          CALL   VARDO 
  859. *          SA1    VARBUF+1
  860. *          NG     X1,=XERRSTOR
  861. *          SA1    VARBUF+5
  862. *          NG     X1,=XERRSTOR
  863. *          SA1    VARBUF
  864. *          SX2    X1-5
  865. *          ZR     X2,CNTLNL   JUMP IF NO 6TH
  866. *          SX2    X1-6
  867. *          NZ     X2,=XERRTAGS
  868. * CNTFIN   SX1    6           MUST HAVE EXACTLY SIX ARGUMENTS 
  869. *          EQ     =XVARFIN
  870. **
  871. * CNTLNL   SX6    0 
  872. *          SA6    VARBUF+6    FAKE UP GETVAR CODE = 0.
  873. *          SX6    6 
  874. *          SA6    VARBUF
  875. *          EQ     CNTFIN
  876. * 
  877. * /---   BLOCK      -TEKTRON-  00 000   81/08/10  13.03 
  878.           TITLE  -TEKTRON-
  879. * 
  880. *         -TEKTRON- COMMAND 
  881. * 
  882. *         TEKTRON ON         TOP 2 BITS OF COMMAND WORD SET 
  883. *         TEKTRON OFF        TOP 1 BIT OF COMMAND WORD SET
  884. *         TEKTRON VAR,LTH    JUST TWO NORMAL GETVAR CODES 
  885. * 
  886. * 
  887.  TEKTRON  BSS    0
  888.           SA1    TEKON
  889.           CALL   TAGXACT
  890.           MX6    2
  891.           NG     X1,PUTCODE  IF -TEKTRON ON-
  892.  
  893.           SA1    TEKOFF 
  894.           CALL   TAGXACT
  895.           MX6    1
  896.           NG     X1,PUTCODE  IF -TEKTRON OFF- 
  897.  
  898.           EQ     =XCOLLCTC   GO GET TWO ARGUMENTS, 1ST MUST BE STORABLE 
  899.  
  900.  TEKON    DATA   2LON 
  901.  TEKOFF   DATA   3LOFF
  902. * /---   BLOCK      -REPLACE-  00 000   78/04/14  01.19 
  903.           TITLE  -REPLACE- COMMAND READIN 
  904. * 
  905. *         FORMAT OF COMMAND 
  906. * 
  907. *         REPLACE IN,LTH,OUT,LTH,TABLE,LTH,CHARS,MODE 
  908. * 
  909. *         ARGUMENTS 1,3,5,7 MUST BE STOREABLE 
  910. * 
  911.  REPLACC  CALL   SYSTEST
  912.           CALL   VARDO
  913. *         MAKE SURE THAT ARGUMENTS 1,3,5,7 ARE STOREABLE
  914.           SA1    VARBUF+1 
  915.           NG     X1,=XERRSTOR 
  916.           SA1    VARBUF+3 
  917.           NG     X1,=XERRSTOR 
  918.           SA1    VARBUF+5 
  919.           NG     X1,=XERRSTOR 
  920.           SA1    VARBUF+7 
  921.           NG     X1,=XERRSTOR 
  922.           SX1    8           MUST HAVE EXACTLY 8 ARGUMENTS
  923.           EQ     =XVARFIN 
  924. * /---   BLOCK      -GETCODE-  00 000   78/05/11  18.05 
  925. * 
  926. *         -GETCODE- 
  927. * 
  928. *     FIRST TAG IS VARIABLE TO STORE THE CODEWORD IN. 
  929. *     NEXT (OPTIONAL) IS A LIST OF KEYS THAT TERMINATE
  930. *     THE ENTRY.  THE LIST IS PRECEDED BY ',ENDKEYS=',
  931. * 
  932.           EXT    NKLIST 
  933.           EXT    NKLEND 
  934. * 
  935.  GETCDIN  CALL   COMPILE     COMPILE FIRST TAG
  936.           NZ     B1,ERRSTOR  MUST BE STOREABLE
  937.           BX6    X1          SAVE -GETVAR- CODE 
  938.           SA6    VARBUF 
  939.           CALL   NXTNAM      SEE IF THERE IS ANYTHING ELSE
  940.           ZR     X6,GETCIN3  IF NO SECOND ARGUMENT
  941.           SX1    X1-1R=      TERMINATOR MUST BE ',=', 
  942.           NZ     X1,ERRTERM  WASN'7T
  943.           SA1    GETCDA      WORD MUST BE ',ENDKEYS', 
  944.           BX1    X1-X6
  945.           NZ     X1,ERRNAME  NOT SO 
  946.           MX4    0
  947.  SCAN     CALL   NXTNAM      GET NEXT WORD
  948.           ZR     X6,GETCIN2  --- IF NO MORE 
  949.           SX5    1
  950.           SB1    -1 
  951.           MX0    42          MASK FOR NAMES 
  952.           SA6    NKLEND      PLANT FOR END TEST 
  953.  SCAN2    SB1    B1+1 
  954.           SA1    NKLIST+B1   GET NEXT ENTRY 
  955.           BX1    X1-X6
  956.           BX1    X0*X1       MASK OUT SIGNIFICANT BITS
  957.           NZ     X1,SCAN2    --- IF NO MATCH
  958.           SB2    NKLEND 
  959.           SB2    A1-B2
  960.           ZR     B2,ERRNAME  --- IF BAD KEY NAME
  961.           LX5    B1          POSITION BIT 
  962.           BX4    X4+X5       MERGE IT IN
  963.           EQ     SCAN        DO NEXT ONE
  964. * 
  965.  GETCIN2  SA2    VARBUF      GET GETVAR CODE BACK 
  966.           LX2    2*XCODEL    SHIFT INTO PLACE 
  967.           SX0    1
  968.           LX0    NEXT-FUNKEY FORM BIT FOR -NEXT-
  969.           BX6    X4+X0       SET INTO KEYLIST 
  970.           LX6    XCMNDL      MAKE ROOM FOR COMMAND CODE 
  971.           BX6    X6+X2       MOVE FIRST ARGUMENT IN 
  972.           EQ     PUTCODE     STORE IT 
  973. * 
  974.  GETCIN3  MX4    0
  975.           EQ     GETCIN2     ONE ARGUMENT CASE
  976. * 
  977.  GETCDA   DATA   L*ENDKEYS* 
  978. * /---   BLOCK      -SET-      00 000   80/02/15  22.08 
  979. * 
  980.           TITLE  -SET- COMMAND
  981. * 
  982. *         SET  ARRAY_ARG1,ARG2,ARG3,... 
  983. *         SET  ARRAY(R,C)_ARGI,ARGJ,ARGK,...
  984. *         SET  V1_ARG1,ARG2,... 
  985. * 
  986. *         FILLS CONSECUTIVE VARIABLES WITH ITEMS IN LIST
  987. *         BEGINNING AT FIRST ARGUMENT AND GOING UP
  988. *         GIVES ERROR MSG AT CONDENSE TIME (IF POSSIBLE)
  989. *         OR EXEC TIME IF LIST RUNS OVER PERMISSIBLE BOUNDS 
  990. *         OF ARRAY OR STUDENT VARIABLES 
  991. * 
  992.           EXT    EQERR
  993.           EXT    VARSEP,VARLEX,VARFINM,VARDOC,VARDOCL 
  994.           EXT    ARAYFLG,TSTERR,CPXERR
  995.           EXT    ECSPRTY
  996. * 
  997.  SETIN    SA1    WORDPT 
  998.           BX6    X1 
  999.           MX7    59          -1 
  1000.           SA6    VARBUF      SAVE WORDPT HERE 
  1001.           SA7    VSKMODE     DONT EXPAND DEFINE 
  1002. *         DO SEARCH FOR ASSIGN ARROW, CHANGE TO COMMA 
  1003.           SA1    SEPASGN
  1004.           BX7    X1          SET TO DETECT ASSIGN ARROW 
  1005.           SA7    VARSEP 
  1006.           RJ     VARLEX      SEARCH FOR FIRST ARROW 
  1007.           ZR     X1,NOASSGN  ERROR IF NOT FOUND 
  1008.           SX6    1R,         CHANGE TO COMMA
  1009.           SA6    X7          ADDR OF ARROW LEFT HERE
  1010.           CALL   INITLEX
  1011.           CALL   LEX         GET FIRST LEXICAL ITEM 
  1012.           SA4    VARBUF 
  1013.           BX6    X4 
  1014.           SA6    WORDPT      RESET FOR COMPILATION
  1015. * 
  1016.           SA2    OP 
  1017.           ZR     X2,SET20    JUMP IF ADTYPE LIKE N1,V1
  1018.           SX6    X2-OPDEFN    CHECK FOR DEFINED WORD
  1019.           NZ     X6,SET20    JUMP IF SOME OTHER OP
  1020.           SA1    ADTYPE 
  1021.  SET05    ZR     X1,EQERR    DEFINE MUST HAVE ADTYPE
  1022.           NG     X1,EQERR    ERROR IF UNKNOWN NAME
  1023.           MX0    -XCODEAL 
  1024.           BX3    -X0*X1      ADDRESS
  1025.           AX1    XCODEAL     GETVAR TYPE
  1026.           SX6    X1-6 
  1027.           NZ     X6,SET20    JUMP IF NOT ARRAY DEFINE 
  1028. * 
  1029.  SET10    SA2    ATOKEN      ADDR OF TOKENS 
  1030.           IX0    X3+X2       ECS ADDR OF LITERAL
  1031.           SA0    VARBUF+1    SAVE HERE AS FLAG FOR ARRAY
  1032. +         RE     1           READ LITERAL FROM ECS
  1033.           RJ     ECSPRTY
  1034.           SX7    1
  1035.           SA7    ARAYFLG     ALLOW ARRAY COMPILE
  1036.           EQ     SET30
  1037. * 
  1038.  SET20    SX6    0
  1039.           SA6    VARBUF+1       FLAG NOT ARRAY
  1040.           SA6    ARAYFLG     DONT ALLOW ARRAY COMPILE 
  1041. * 
  1042.  SET30    CALL   COMPILE     GET STARTING ADDR GETVAR 
  1043.           NE     B1,B0,SETER2  ERROR FROM -COMPILE- 
  1044.           BX6    X1 
  1045.           SA6    VARBUF+2    2D ARG = START ADDR GETVAR 
  1046.           SX7    2
  1047.           SA7    VARBUF      2 ARGUMENTS SO FAR 
  1048.           SA7    ARAYFLG     ARAYS NOT ALLOWED IN LIST
  1049.           SA1    SET99
  1050.           BX6    X1          PUT EQ SET40 IN RETURN 
  1051.           SA6    VARDOC 
  1052.           EQ     VARDOCL     CONTINUE READING LIST ITEMS
  1053. * 
  1054. * /---   BLOCK      SET30      00 000   80/02/15  22.08 
  1055. * 
  1056. *         CHECK IF LIST EXCEEDS MAX ADDR IF POSSIBLE
  1057.  SET40    SA1    VARBUF      RETURN FROM PACKING UP LIST
  1058.           SX1    X1-2        NUMBER ITEMS IN LIST 
  1059.           SA2    VARBUF+1    =0 OR =SIZE
  1060.           SA3    VARBUF+2    START GETVAR 
  1061.           MX0    -XCODEAL 
  1062.           ZR     X2,SET50    JUMP IF NOT ARRAY
  1063.           BX6    -X0*X2      START RELATIVE ADDR
  1064.           SA4    ASVARS 
  1065.           PL     X2,SET45    JUMP IF STUDENT BANK 
  1066.           SA4    ACVARS 
  1067.  SET45    BX5    X2 
  1068.           AX5    45 
  1069.           MX7    -9 
  1070.           BX5    -X7*X5      SIZE 
  1071.           IX7    X4+X6       ABS START ADDR 
  1072.           IX7    X7+X5       +SIZE = MAX+1 ADDR 
  1073.           SA7    VARBUF+1    PUT IN LIST
  1074.           MX7    -XCODEL
  1075.           BX7    -X7*X3 
  1076.           AX7    XCODEAL     ISOLATE START GETVAR TYPE
  1077.           SX7    X7-6        =0 IF WHOLE ARRAY
  1078.           ZR     X7,SET60    JUMP IF WHOLE ARRAY
  1079.           RJ     SET80
  1080.           ZR     X7,VARFINM   MUST CHECK BOUNDS AT EXEC TIME
  1081.  SET48    SA2    VARBUF+1    ABS MAX+1
  1082.           IX5    X6+X4       ABS START
  1083.           IX5    X5+X1       +ITEMS 
  1084.           IX6    X2-X5       MAX+1 - END
  1085.           NG     X6,SETERR   ERROR IF ITEMS RUN PAST MAX
  1086.           EQ     VARFINM     GO PACKUP COMMAND WORDS
  1087. * 
  1088.  SET50    RJ     SET80
  1089.           NZ     X7,SET55 
  1090.           SA7    VARBUF+1    MUST FIND ENDLIMIT AT EXECTIME 
  1091.           EQ     VARFINM     GO PACKUP WORDS
  1092. * 
  1093.  SET55    IX7    X4+X7       GET MAX ADDR IN STUD OR COM
  1094.           SA7    VARBUF+1    BANK +1
  1095.           EQ     SET48
  1096. * 
  1097.  SET60    IX5    X5-X1       SIZE-ITEMS 
  1098.           NG     X5,SETERR    JUMP IF TOO MANY ITEMS
  1099.           EQ     VARFINM
  1100. * 
  1101.  SET80    EQ     *           FIND STUD/COM BANK LIMITS
  1102.           BX6    -X0*X3      GETVARCOD IN X3, PUT ADDR IN X6
  1103.           AX3    XCODEAL
  1104.           MX5    -3 
  1105.           BX3    -X5*X3      DISCARD I/F BIT
  1106.           SA4    ASVARS 
  1107.           SX7    VARLIM+1 
  1108.           SX5    X3-2        X3=2 IF STUD BANK
  1109.           ZR     X5,SET80    RETURN STUD BANK LIMITS IF SO
  1110.           SA4    ACVARS 
  1111.           SX7    NCVRLIM+1
  1112.           SX5    X3-3        X3=3 IF COMMON 
  1113.           ZR     X5,SET80    RETURN COMMON BANK LIMITS IF SO
  1114.           SX7    0           CANT CHECK LIMIT AT CONDEN TIME
  1115.           EQ     SET80
  1116. * 
  1117.  SET99    EQ     SET40
  1118. * 
  1119.  NOASSGN  SB1    45          NO ASSIGN
  1120.           EQ     =XERR
  1121. * 
  1122.  SETERR   SB1    58 
  1123.           EQ     =XERR
  1124. * 
  1125.  SETER2   SB1    724
  1126.           EQ     =XERR
  1127. * 
  1128.  SEPASGN  SX1    X1-KASSIGN  USED IN VARLOC SEARCH
  1129. * 
  1130.           ENDOV 
  1131. * 
  1132. * /---   BLOCK      COVL4A     00 000   79/07/06  05.18 
  1133.           TITLE  -COV4A- VARIOUS COMMAND READINS
  1134.  COV4A    OVRLAY
  1135. * 
  1136.           SA1    OVARG1 
  1137.           SB1    X1 
  1138.           JP     B1+*+1 
  1139. * 
  1140. +         EQ     COPYC       -COPY- 
  1141. +         EQ     EDITIN      -EDIT- 
  1142. +         EQ     STORUIN     -STOREU- 
  1143. +         EQ     JKEYC       -JKEY- 
  1144. +         EQ     BUMPC       -BUMP- 
  1145. +         EQ     MOVEC       -MOVE- 
  1146. +         EQ     CIRCLC      -CIRCLE- -RCIRCLE- ETC.
  1147. +         EQ     EXTOUTC     -EXTOUT- 
  1148. +         EQ     STOREAC     -STOREA- 
  1149. +         EQ     LOADAC      -LOADA- -EXACTV- 
  1150. * /---   BLOCK      COPY       00 000   79/07/06  02.56 
  1151.           TITLE  -COPY- 
  1152. *         -COPY-  (CODE=130)
  1153. * 
  1154. *         SPECIFY CHAR STRING, CHAR COUNT FOR 'C'O'P'Y KEY
  1155. * 
  1156.  COPYC    RJ     VARDO       COMMA SEPARATED VARIABLES
  1157.           SA2    VARBUF      X2 = NUMBER OF VARIABLES 
  1158.           SX1    X2-2 
  1159.           NZ     X1,ERRTAGS   JUMP IF NOT TWO ARGUMENTS 
  1160.           SA1    VARBUF+1 
  1161.           NG     X1,ERRSTOR   ERROR IF 1ST VARIABLE CANNOT BE STORED INT
  1162.           MX0    61-XCODEL+XFBIT   MASK OUT I/F BIT 
  1163.           BX1    -X0*X1 
  1164.           BX6    X1          X6 = CLEANED AND POSITIONED -GETVAR- CODE
  1165.           AX1    XCODEAL     CHECK FOR EXPLICIT COMMON ADDRESS
  1166.           SX1    X1-3 
  1167.           ZR     X1,VCOMERR  JUMP IF EXPLICIT COMMON REFERENCE
  1168.           SX1    X1+1 
  1169.           NZ     X1,COPYC1   IF NOT STUDENT VAR 
  1170.           MX2    -XCODEAL 
  1171.           BX2    -X2*X6 
  1172.           SX1    VARLIM+1 
  1173.           IX1    X2-X1
  1174.           PL     X1,VCOMERR  IF NOT STUDENT VAR 
  1175.  COPYC1   LX6    60-XCODEL   POSITION CODE
  1176.           SA2    VARBUF+2    X2 = 2ND VARIABLE
  1177.           MX0    60-XCODEL
  1178.           BX2    -X0*X2 
  1179.           LX2    60-2*XCODEL
  1180.           BX6    X6+X2       ADD 2ND CODE 
  1181.           EQ     PUTCODE
  1182. * 
  1183. * 
  1184. * 
  1185. *         EDIT COMMAND...2 CASES... 
  1186. *         1. NO ARG 
  1187. *         2. ONE ARG
  1188.  EDITIN   SA1    TAGCNT 
  1189.           ZR     X1,PAUSE2   SEE IF NO ARG CASE 
  1190.           RJ     VARDO
  1191.           SA2    VARBUF      X2 = NUMBER OF VARIABLES 
  1192.           SX1    X2-1 
  1193.           NZ     X1,ERR2MNY   JUMP IF NOT ONE ARG 
  1194.           SA1    VARBUF+1 
  1195.           NG     X1,ERRSTOR   ERROR IF 1ST VARIABLE CANNOT BE STOREDINTO
  1196.           MX0    61-XCODEL+XFBIT   MASK OUT I/F BIT 
  1197.           BX1    -X0*X1 
  1198.           BX6    X1          X6 = CLEANED AND POSITIONED -GETVAR- CODE
  1199.           AX1    XCODEAL     CHECK FOR EXPLICIT COMMON ADDRESS
  1200.           SX1    X1-3 
  1201.           ZR     X1,VCOMERR  JUMP IF EXPLICIT COMMON REFERENCE
  1202.           SX1    X1+1 
  1203.           NZ     X1,EDITIN1  IF NOT STUDENT VAR 
  1204.           MX2    -XCODEAL 
  1205.           BX2    -X2*X6 
  1206.           SX1    VARLIM+1 
  1207.           IX1    X2-X1
  1208.           PL     X1,VCOMERR  IF NOT STUDENT VAR 
  1209.  EDITIN1  LX6    60-XCODEL   POSITION CODE
  1210.           EQ     PUTCODE
  1211. * 
  1212. * 
  1213.  VCOMERR  SB1    106         COMMON VARIABLE REFERENCE
  1214.           EQ     ERR
  1215. * /---   BLOCK      STOREU     00 000   76/07/17  06.02 
  1216.           TITLE  STOREU 
  1217. * 
  1218. * 
  1219. * STOREU  NUMBER,UNITS
  1220. *    UNITS ARE THE (FLOATING-POINT) UNIT DIMENSIONS 
  1221. * 
  1222.  STORUIN  CALL   PUTCOMP     COMPILE CODE TO STORE X6 
  1223.           SA2    LASTKEY
  1224.           ZR     X2,ERR2FEW   ERROR IF END-OF-LINE
  1225.           LX1    60-XCODEL   POSITION -GETVAR- CODE 
  1226.           BX6    X1 
  1227.           SA6    VARBUF      SAVE GETVAR CODE 
  1228.           RJ     COMPILE     GET SECOND ARG 
  1229.           NZ     B1,ERRSTOR   MUST BE ABLE TO STORE INTO
  1230.           BX6    X1 
  1231.           AX6    XCODEAL+3   SAVE I/F BIT 
  1232.           ZR     X6,ERRVTYP   DIMENSIONS ARE FLOATING-PT
  1233.           SA2    VARBUF 
  1234.           LX1    60-2*XCODEL   POSITION 2ND GETVAR CODE 
  1235.           BX6    X1+X2
  1236.           SX1    STORE=      USE -STORE- COMMAND CODE 
  1237.           BX6    X1+X6
  1238.           EQ     ALTCODE
  1239. * 
  1240. * /---   BLOCK      JKEY-BUMP  00 000   75/10/04  11.49 
  1241. * 
  1242. *         -JKEY-
  1243. * 
  1244. *     TAG IS NAMES OF KEYS WHICH CAN INITIATE JUDGING 
  1245. * 
  1246.  JKEYC    SB1    NKLIST      START OF TABLE OF LEGAL NAMES
  1247.           SB2    NKLEND      END OF TABLE OF LEGAL NAMES
  1248.           MX5    42          MASK FOR NAMES---BOTTOM 18 BITS ARE KEYCODE
  1249. *          RJ     SCANNER     SCAN FOR KEY NAMES
  1250.           RJ     CSSCAN      SCAN FOR CASE-SENSITIVE NAMES
  1251.           ZR     X0,PUTCODE 
  1252.           EQ     ERRNAME
  1253. * 
  1254. * 
  1255.           TITLE  -BUMP- 
  1256. *         -BUMP-  (CODE=133)
  1257. * 
  1258. *            'THE TAG OF A BUMP COMMAND MUST HAVE FROM 1 TO 
  1259. *         8 BCD CODES.  'THE STORAGE FORMAT OF THE COMMAND
  1260. *         IS TAG CHARS LEFT-JUSTIFIED IN COMMAND WORD WITH
  1261. *         ZERO FILL.
  1262. * 
  1263. * 
  1264.  BUMPC    SA1    TAGCNT 
  1265.           ZR     X1,ERR2FEW   ERROR IF NO TAG 
  1266.           SB2    X1-9 
  1267.           PL     B2,ERR2MNY   TOO MANY CHAR CODES 
  1268.           SB1    B0          CHAR NUMBER
  1269.           SB2    X1          NUMBER OF CHARS
  1270.           SB3    54          POST-SHIFT COUNT 
  1271.           SB4    6           CHAR WIDTH 
  1272.           MX6    0           COMMAND WORD 
  1273.  BUMPLP   SA1    TAG+B1      NEXT CHAR
  1274.           BX6    X6+X1       GET ANOTHER CODE 
  1275.           LX6    6           MOVE OVER
  1276.           SB1    B1+1 
  1277.           SB3    B3-B4       POST-SHIFT DECR. 
  1278.           NE     B1,B2,BUMPLP 
  1279.           LX6    X6,B3       LEFT JUSTIFY 
  1280.           EQ     PUTCODE     ALL GONE 
  1281. * 
  1282. * /---   BLOCK      MOVE       00 000   79/07/06  04.01 
  1283.           TITLE  MOVE 
  1284. *         -MOVE-
  1285. * 
  1286. * 
  1287. *         NORMAL 4 ARG MOVE COMMAND.
  1288. *            INADD,INPOS,OUTADD,OUTPOS
  1289. *         /// IF 5TH ARG GIVEN, IT IS NUMBER OF CHARS /// 
  1290. * 
  1291. * 
  1292.  MOVEC    RJ     VARDO       SET UP VARBUF
  1293.           SA1    VARBUF+1    FROM ADDRESS 
  1294.           PL     X1,MOVC1 
  1295.           MX0    1
  1296.           LX0    XCODEL 
  1297.           BX6    X1+X0
  1298.           SA6    A1 
  1299.  MOVC1    SA1    VARBUF+3    *TO* ADDRESS MUST BE STOREABLE 
  1300.           NG     X1,ERRSTOR 
  1301.           SA1    VARBUF      X1 = NUMBER OF VARIABLES 
  1302.           SX2    X1-6 
  1303.           PL     X2,ERR2MNY   --- FOUR OR FIVE ARGS ONLY
  1304.           SX2    X2+2 
  1305.           ZR     X2,MOVC4    GO TO PACK UP IF NORMAL 4 ARG MOVE COMMAND 
  1306.           NG     X2,ERR2FEW  OTHERWISE MUST BE 5
  1307.           EQ     VARFIN      GO TO PACK UP VARIABLES
  1308. * 
  1309.  MOVC4    MX6    2*XCODEL+1  BIT IN 3RD FIELD ON
  1310.           SA6    VARBUF+5 
  1311.           EQ     VARFIN      GO PACK IT UP
  1312. * 
  1313. * /---   BLOCK      CIRCLE     00 000   77/08/04  04.18 
  1314.           TITLE  CIRCLE 
  1315. * 
  1316. * 
  1317. *         -CIRCLE  R- 
  1318. *         -CIRCLE  R,THETA1,THETA2- 
  1319. * 
  1320. *         IF ONLY ONE TAG, THE TOP BIT IS SET ON THE
  1321. *         SECOND GETVAR CODE. 
  1322. * 
  1323. *         USED BY 
  1324. *         -CIRCLE-
  1325. *         -RCIRCLE- 
  1326. *         -GCIRCLE- 
  1327. *         -CIRCLB-
  1328. * 
  1329.  CIRCLC   RJ     VARDO       GET COMMA-SEPARATED VARS 
  1330.           SA1    VARBUF      SHOULD BE 1 OR 3 ARGUMENTS 
  1331.           SX2    X1-3 
  1332.           ZR     X2,VARFIN   IF THREE ARGS
  1333.           SX2    X1-1 
  1334.           NZ     X2,ERRTAGS   IF WRONG NO. ARGS 
  1335.           SA1    VARBUF+1    RETRIEVE FIRST TAG CODE
  1336.           MX2    1           MAKE SECOND TAG CODE 
  1337.           LX2    XCODEL 
  1338.           EQ     PUTTWO      AND COMPLETE COMMAND WORD
  1339. * /---   BLOCK      EXTOUT     00 000   79/07/06  04.30 
  1340.           TITLE  -EXTOUT- 
  1341. *         -EXTOUT-  (CODE=186)
  1342. * 
  1343. *            'SENDS 16 BITS OF DATA (EQUIVALENT TO EITHER 
  1344. *         AUDIO OR EXT).  'OPTIONAL 2ND ARGUMENT SPECIFIES
  1345. *         LENGTH OF BUFFER TO SEND. 
  1346. * 
  1347. * 
  1348.  EXTOUTC  RJ     VARDO       COMMA SEPARATED VARIABLES
  1349.           SX1    2           2 VARIABLES REQUIRED 
  1350.           SA2    VARBUF      NUMBER OF VARIABLES FOUND
  1351.           SX3    X2-1 
  1352.           ZR     X3,EXTO1    JUMP IF ONLY 1 ARGUMENT
  1353.           SA3    VARBUF+1 
  1354.           PL     X3,VARFIN   --- PACK UP, STORE COMMAND WORD
  1355.           EQ     ERRSTOR     --- ERROR EXIT IF CANNOT BE STORED INTO
  1356. * 
  1357.  EXTO1    BX6    X1 
  1358.           SA6    A2          RESET VARIABLE COUNT TO 2
  1359.           SX7    1           CODE FOR 1 AS LENGTH 
  1360.           SA7    VARBUF+2    STORE AS 2ND VARIABLE
  1361.           EQ     VARFIN      --- PACK UP, STORE COMMAND WORD
  1362. * /---   BLOCK      STOREA     00 000   76/10/01  03.42 
  1363.           TITLE  STOREA 
  1364. * 
  1365. *         -STOREA-  (CODE=68) 
  1366. * 
  1367. * 
  1368.  STOREAC  RJ     VARDO       COMMA SEPARATED VARIABLES
  1369.           SA1    VARBUF+1    PICK UP FIRST GETVAR CODE
  1370.           NG     X1,ERRSTOR  MUST BE STOREABLE
  1371.  STOREA1  MX0    61-XCODEL+XFBIT  MASK OUT I/F BIT
  1372.           BX1    -X0*X1 
  1373.           SA3    VARBUF      X3 = NUMBER OF VARIABLES 
  1374.           SX3    X3-1 
  1375.           SX2    10          -GETVAR- CODE FOR 10 CHARACTERS
  1376.           ZR     X3,PUTTWO   DONE IF ONLY ONE ARGUMENT
  1377.           SX3    X3-1 
  1378.           NZ     X3,ERR2MNY   IF WRONG NO. ARGUMENTS
  1379.           SA2    VARBUF+2    PICK UP SECOND GETVAR CODE 
  1380.           EQ     PUTTWO      NOW COMPLETE COMMAND WORD
  1381. * 
  1382. * 
  1383. * 
  1384. *         -EXACTV-  (CODE=134)
  1385. *         -LOADA-  (CODE=226) 
  1386. * 
  1387.  LOADAC   RJ     VARDO       COMMA SEPARATED VARIABLES
  1388.           SA1    VARBUF+1    PICK UP FIRST GETVAR CODE
  1389.           EQ     STOREA1     1ST ARG NEED NOT BE STOREABLE
  1390. * /---   BLOCK      ENDOV      00 000   79/07/06  02.46 
  1391. * 
  1392.           ENDOV 
  1393. * /---   BLOCK      ACCESS     00 000   79/04/28  16.25 
  1394.           TITLE  ACCESS,  SYSACC  COMMAND READINS 
  1395.  ACCOV    OVRLAY
  1396.           SA1    OVARG1      GET ARGUEMENT
  1397.           SB1    X1 
  1398.           JP     B1+*+1 
  1399. * 
  1400. +         EQ     SYSACCC     0 = -SYSACC- 
  1401. +         EQ     ACCESSC     1 = -ACCESS- 
  1402. * /---   BLOCK      ACCESS     00 000   79/04/28  16.25 
  1403.  
  1404. **
  1405. * 
  1406. *         -SYSACC- COMMAND READ-IN
  1407. * 
  1408. *         SYSACC ACCOUNT';FILE,BLOCK,BUFFER,RETURN,MAXL,RETURNL 
  1409. * 
  1410. *         ACCOUNT     ACCOUNT OF FILE WITH ACCESS BLOCK 
  1411. *         FILE        NAME OF FILE WITH ACCESS BLOCK
  1412. *         BLOCK       NAME OF ACCESS BLOCK
  1413. *         BUFFER      USER SUPPLIED BUFFER TO READ
  1414. *                            NAME (2 WORDS) 
  1415. *                            GROUP
  1416. *                            ACCOUNT
  1417. *                            USER TYPE
  1418. *                            SYSTEM 
  1419. *         RETURN      VARIABLE TO RETURN BITS IN
  1420. *         RETURNL     NUMBER OF BITS RETURNED 
  1421. *         MAXL        MAXIMUM LENGTH TO RETURN
  1422. **
  1423. * 
  1424.  
  1425.  SYSACCC  CALL   SYSTEST     SEE IF SYSTEM LESSONS
  1426.           CALL   FILEBLK     GET ACCOUNT, FILE, AND BLOCK ARGUMENTS 
  1427.           CALL   VARDOR      GET REMAINING ARGUMENTS
  1428. * 
  1429.           SA1    VARBUF      GET NUMBER OF ARGUMENTS
  1430.           SX2    X1-7        NEEDS EXACTLY 7 ARGUMENTS
  1431.           NG     X2,ERR2FEW  NOT ENOUGH ARGUMENTS 
  1432.           NZ     X2,ERR2MNY  TOO MANY ARGUMENTS 
  1433.           SA2    VARBUF+5    5TH ARGUMENT MUST BE STOREABLE 
  1434.           NG     X2,ERRSTOR 
  1435.           SA2    VARBUF+7    7TH ARGUMENT MUST BE STOREABLE 
  1436.           NG     X2,ERRSTOR 
  1437.           EQ     VARFIN      EXIT WITH X1 STILL SET TO 7
  1438. * 
  1439. * /---   BLOCK      + ACCESS   00 000   81/01/18  20.01 
  1440.           TITLE  ACCESS COMMAND.
  1441.  
  1442. **
  1443. *         -ACCESS- COMMAND READ-IN
  1444. * 
  1445. *         ACCESS LESSON;RETURN VARIABLE 
  1446. *         ACCESS FILE;RETURN VARIABLE 
  1447. *         ACCESS ACCOUNT';FILE,BLOCK;RETURN 
  1448.  
  1449.  ACCESSC  BSS    0
  1450.  
  1451. *         SAVE VALUE OF WORDPT TO ALLOW BACKUP
  1452.  
  1453.           SA1    WORDPT 
  1454.           BX6    X1 
  1455.           SA6    SWORDPT
  1456.  
  1457. *         GET FIRST TAG 
  1458.  
  1459.  ACGO     CALL   NXTNAM      GET FIRST TAG
  1460.  
  1461. *         IF SEMICOLON PRESENT, THIS MIGHT BE SPECIAL FORM
  1462.  
  1463.           SX2    X1-KSEMIC
  1464.           NZ     X2,ACRSET   NOT ; -- MUST BE LESSON,BLOCK
  1465.  
  1466. *         SEE IF KEY WORDS -LESSON-  OR  -FILE- 
  1467.  
  1468.           SA2    CFILE
  1469.           BX2    X6-X2       SEE IF KEYWORD OF -FILE- 
  1470.           NZ     X2,ACCLESS 
  1471.  
  1472. *         SET TO KEY WORD FILE
  1473.  
  1474.           SX6    1
  1475.           EQ     ACTWO       TWO TAG FORM FOR -FILE-
  1476.  
  1477.  ACCLESS  SA2    CLESSON     CHECK FOR KEYWORD -LESSON- 
  1478.           BX2    X6-X2
  1479.           NZ     X2,ACRSET   DUNNO; MAYBE IT WAS ACCT';FILE 
  1480.  
  1481. *         SET TO KEY WORD LESSON
  1482.  
  1483.           SX6    2
  1484. * 
  1485.  ACTWO    SA6    SACTYPE     SAVE KEYWORD TYPE
  1486.           CALL   SYSTEST     TWO-ARG FORM FOR SYSTEM LESSONS
  1487.  
  1488. *         SET UP FIRST -GETVAR- CODE TO MARK KEYWORD FORMAT 
  1489.  
  1490.           MX1    1
  1491.           LX1    XCODEL 
  1492.           SA3    SACTYPE     GET KEYWORD TYPE 
  1493.           BX6    X1+X3
  1494.           SA6    VARBUF+1    STORE AS FIRST CODE
  1495.           MX6    0
  1496.           SA6    VARBUF+2    ZERO SECOND, THIRD GETVAR CODES
  1497.           SA6    VARBUF+3 
  1498.           SX6    3
  1499.           SA6    VARBUF      MARK 3 ARGS COMPILED SO FAR
  1500.           SA6    LASTKEY     FAKE OUT -VARDOR-
  1501.           EQ     ACRETRN     PROCESS RETURN ARGUMENT(S) 
  1502. * /---   BLOCK      + ACCESS   00 000   81/01/12  03.31 
  1503.  
  1504. *         LESSON,BLOCK FORMAT 
  1505.  
  1506.  ACRSET   SA1    SWORDPT     RESTORE CHAR POINTER 
  1507.           BX6    X1 
  1508.           SA6    WORDPT 
  1509.  
  1510.           CALL   FILEBLK     GET ACCOUNT, FILE, AND BLOCK NAMES 
  1511.           ZR     X1,ERR2FEW  ERROR IF BLANK TAG 
  1512.           SA1    LASTKEY
  1513.           SX2    X1-KSEMIC   NEXT CHAR SHOULD BE SEMICOLON
  1514.           NZ     X2,ERRTAGS  NOPE; SOMEONE IS CONFUSED
  1515.  
  1516. *         PROCESS RETURN ARGUMENT(S)
  1517. *         EXPECTING ONE OR TWO; FIRST MUST BE STORABLE
  1518.  
  1519.  ACRETRN  CALL   VARDOR      GET REMAINING ARGUMENTS
  1520.           SA1    VARBUF 
  1521.           SX1    X1-4        CHECK TOTAL GETVAR CODES SO FAR
  1522.           NG     X1,ERR2FEW  MUST BE AT LEAST 4 
  1523.           NZ     X1,ACRET2   BUT MIGHT BE 5 
  1524.  
  1525. *         ONE RETURN ARGUMENT SPECIFIED; SET UP 
  1526. *         DUMMY 5TH GETVAR CODE 
  1527.  
  1528.           MX6    1
  1529.           LX6    XCODEL 
  1530.           SA6    VARBUF+5 
  1531.           SX6    5
  1532.           SA6    VARBUF      AND MARK 5 CODES TOTAL 
  1533.           EQ     ACRETST     GO TO CHECK STOREABILITY 
  1534.  
  1535. *         TWO OR MORE RETURN ARGUMENTS PRESENT
  1536.  
  1537.  ACRET2   SX1    X1-1        SEE IF 5 ARGUMENTS TOTAL 
  1538.           NZ     X1,ERR2MNY  ERROR IF MORE THAN 5 
  1539. * 
  1540.           CALL   SYSTEST     ALLOWED IN SYSTEM LESSONS ONLY 
  1541.  
  1542. *         MAKE SURE 4TH ARGUMENT IS STOREABLE 
  1543.  
  1544.  ACRETST  SA1    VARBUF+4 
  1545.           NG     X1,ERRSTOR  ERROR IF NOT 
  1546. * 
  1547.           SX1    5
  1548.           EQ     VARFIN      FINISHED WITH THIS COMMAND 
  1549.  
  1550.  SWORDPT  BSS    1           SAVE WORDPT
  1551.  SACTYPE  BSS    1           SAVE TYPE OF KEYWORD 
  1552.  CFILE    DATA   0LFILE      KEYWORDS 
  1553.  CLESSON  DATA   0LLESSON 
  1554. * 
  1555.           ENDOV 
  1556. * /---   BLOCK      JOINOV     00 000   77/04/24  20.47 
  1557.           TITLE  -JOIN-, -JUMP-, -DO- COMMANDS
  1558. * 
  1559. * 
  1560. * 
  1561.  JOINOV   OVRLAY
  1562.           SA1    OVARG1      GET ARGUMENT 
  1563.           SB1    X1 
  1564.           JP     B1+*+1 
  1565. * 
  1566. +         EQ     JUMPIN      0 = -JUMP- 
  1567. +         EQ     BRANCHI     1 = BRANCHI
  1568. +         EQ     BRANCHQ     2 = BRANCHQ
  1569. +         EQ     GOTOIN      3 = -GOTO- 
  1570. +         EQ     JOININ      4 = -JOIN- 
  1571. +         EQ     DOIN        5 = -DO- 
  1572. +         EQ     FINISC      6 = -FINIS-
  1573. +         EQ     PINIT       7 = FINISH UP BEFORE MTUTOR
  1574. +         EQ     UNITC       8 = -UNIT- 
  1575. +         EQ     ENTRYIN     9 = -ENTRY-
  1576. +         EQ     INITC       10 = -INITIAL- 
  1577. +         EQ     ROUTEC      11 = -ROUTE- 
  1578. +         EQ     TIMERC      12 = -TIMER- 
  1579. +         EQ     TIMELC      13 = -TIMEL- 
  1580. +         EQ     UDONE20     14 = RE-ENTRY FROM -DEFINE-
  1581. +         EQ     UDONE10     15 = RE-ENTRY FROM PURGING SET 
  1582. * 
  1583.           EXT    UNITFLG,AUNUM,ENDPNT 
  1584. +         EQ     RETIN       16 = -NRET-
  1585. +         EQ     RETIN1      17 = -RETURN-
  1586. * 
  1587. * 
  1588. * /---   BLOCK      JOININ     00 000   77/04/24  20.22 
  1589.           TITLE  -JUMPIN- 
  1590. * 
  1591. * 
  1592. *         -JUMPIN-
  1593. *         READIN ROUTINE FOR BRANCHING COMMANDS 
  1594. * 
  1595. * 
  1596.  JUMPIN   MX6    0           MARK UNIT -Q- NOT LEGAL
  1597.           SA6    QOK
  1598.           EQ     JOININ0
  1599. * 
  1600. * 
  1601.  JOININ0  MX6    -1          MARK UNITS WITH ARGUMENTS OK 
  1602.           SA6    ARGOK
  1603. * 
  1604.  JOININ1  SA1    TAGCNT      BLANK TAG IS SAME AS UNIT -Q-
  1605.           ZR     X1,UNCJQ 
  1606.           SA1    NEXTCOM     CHECK FOR CONTINUED COMMAND
  1607.           SA2    COMCONT
  1608.           BX2    X1-X2
  1609.           ZR     X2,CJO      CONDITIONAL IF CONTINUED 
  1610.           SA1    WORDPT 
  1611.           MX0    0           NO SPECIAL TERMINATOR
  1612.           CALL   PSCAN       SCAN FIRST ELEMENT 
  1613.           ZR     X1,UNCJ     JUMP IF UNCONDITIONAL
  1614. * 
  1615.  CJO      CALL   COMPILE     EVALUATE EXPRESSION
  1616.           BX7    X1 
  1617.           LX7    60-XCODEL
  1618.           SA7    BRVAR       SAVE -GETVAR- CODE 
  1619.           MX6    0
  1620.           SA6    JCALL       MARK NOT SPECIAL CALL (-GOTO-) 
  1621.           SA6    SAMEU0      NO SPECIAL SAME UNIT TREATMENT 
  1622. * 
  1623.  JOININ2  MX6    0
  1624.           SA6    UBUFF       INITIALIZE NUMBER OF UNITS 
  1625. * 
  1626.  CJLP     CALL   UNAMA       PROCESS NEXT UNIT NAME 
  1627.           SA1    UARGS       SEE IF ANY ARGUMENTS 
  1628.           ZR     X1,CJLP0 
  1629.           SA1    ARGOK       SEE IF ARGUMENTS LEGAL 
  1630.           ZR     X1,ERRNAME 
  1631. * 
  1632.  CJLP0    SX0    X6-UNQNUM
  1633.           NZ     X0,CJLP1    CHECK FOR UNIT -Q- 
  1634.           SA1    QOK
  1635.           ZR     X1,ERRXORQ   ERROR IF UNIT -Q- NOT LEGAL 
  1636. * 
  1637.  CJLP1    CALL   APACK       PACK UP ANY ARGUMENTS
  1638.           SA1    SAMEU0 
  1639.           ZR     X1,CJLP2    JUMP IF SAME UNIT NOT SPECIAL
  1640.           SA1    UNUMON 
  1641.           BX1    X1-X6       CHECK FOR SAME UNIT
  1642.           NZ     X1,CJLP2 
  1643.           MX6    0           RETURN 0 FOR SAME UNIT 
  1644. * 
  1645.  CJLP2    SA1    UBUFF
  1646.           SX7    X1+1        INCREMENT UNIT COUNT 
  1647.           SA7    A1 
  1648.           SX1    X1-100      ALLOW 100 UNITS
  1649.           PL     X1,ERR2MNY 
  1650.           SA6    X7+UBUFF    STORE THIS UNIT NUMBER 
  1651.           SA1    WORDPT 
  1652.           SA1    X1          LOAD NEXT CHARACTER
  1653.           NZ     X1,CJLP     JUMP IF NOT END OF LINE
  1654.           SA1    NEXTCOM
  1655.           SA2    COMCONT     SEE IF CONTINUED COMMAND 
  1656.           BX2    X1-X2
  1657.           NZ     X2,CJTAB 
  1658.           CALL   GETLINE     GET NEXT LINE OF TEST
  1659.           EQ     CJLP 
  1660. * /---   BLOCK      JOININ     00 000   76/07/24  16.27 
  1661. * 
  1662.  CJTAB    SA4    INX         UNIT EXTRA STORAGE POINTER 
  1663.           SX7    X4 
  1664.           SA1    UBUFF       NUMBER OF UNITS
  1665.           ZR     X1,ERR2MNY 
  1666.           SB1    X1 
  1667.           EQ     CJTLP0 
  1668. * 
  1669.  CJTLP    SA6    X7+INFO     STORE COMPLETED WORD 
  1670.           SX7    X7+1 
  1671. * 
  1672.  CJTLP0   MX6    0           CLEAR WORD BUILDING
  1673.           SB2    45          INITIALIZE SHIFT COUNT 
  1674. * 
  1675.  CJTLP1   SB1    B1-1        DECREMENT UNIT COUNT 
  1676.           NG     B1,CJTFIN
  1677.           SA1    A1+1        LOAD NEXT UNIT NUMBER
  1678.           LX1    X1,B2
  1679.           BX6    X1+X6       MERGE WITH REST OF WORD
  1680.           SB2    B2-15       DECREMENT SHIFT COUNT
  1681.           PL     B2,CJTLP1
  1682.           EQ     CJTLP       JUMP IF WORD COMPLETE
  1683. * 
  1684.  CJTFIN   SB1    B2-45       SEE IF LAST WORD EMPTY 
  1685.           PL     B1,CJTFIN0 
  1686.           SA6    X7+INFO     STORE LAST TABLE WORD
  1687.           SX7    X7+1 
  1688. * 
  1689.  CJTFIN0  SA7    INX         UPDATE EXTRA STORAGE POINTER 
  1690.           SA1    JCALL
  1691.           ZR     X1,CJTFIN1  JUMP IF NOT SPECIAL CALL 
  1692.           SB1    X1 
  1693.           JP     B1          RETURN TO CALLING ROUTINE
  1694. * 
  1695.  CJTFIN1  LX4    12+XCMNDL   POSITION INDEX IN XSTOR
  1696.           SA1    UBUFF       NUMBER OF TABLE ENTRIES
  1697.           LX1    XCMNDL 
  1698.           BX6    X1+X4
  1699.           SA1    BRVAR       -GETVAR- CODE FOR EXPRESSION 
  1700.           BX6    X1+X6
  1701.           SA1    COMNUM      ADD 1 TO COMMAND NUMBER
  1702.           SX1    X1+1 
  1703.           BX6    X1+X6
  1704.           EQ     ALTCODE     EXIT TO STORE COMMAND WORD 
  1705. * 
  1706.  JCALL    BSS    1
  1707.  UBUFF    EQU    SHOWOUT     MUST BE AT LEAST 100 LONG
  1708. * 
  1709. * 
  1710. * /---   BLOCK      JOININ     00 000   81/01/28  15.15 
  1711. * 
  1712. * 
  1713. *         READIN FOR UNCONDITIONAL BRANCHING COMMAND
  1714. * 
  1715.  UNCJ     CALL   UNAMA       GET UNIT NUMBER TO X6
  1716.           SX0    X6-UNXNUM   CHECK FOR UNIT -X- 
  1717.           ZR     X0,ERRXORQ 
  1718.           SX0    X6-UNQNUM   CHECK FOR UNIT -Q- 
  1719.           ZR     X0,UNCJQ 
  1720.           SA1    UARGS       SEE IF ANY ARGUMENTS 
  1721.           ZR     X1,UNCJ1 
  1722.           SA1    ARGOK       SEE IF ARGUMENTS LEGAL 
  1723.           ZR     X1,ERRUARG 
  1724. * 
  1725.  UNCJ1    CALL   APACK
  1726.           LX6    48          POSITION UNIT NUMBER 
  1727.           EQ     PUTCODE
  1728. * 
  1729.  UNCJQ    SA1    QOK         SEE IF UNIT -Q- LEGAL
  1730.           ZR     X1,ERRXORQ 
  1731.           MX6    0           UNIT NUMBER 0 = UNIT -Q- 
  1732.           EQ     PUTCODE
  1733. * 
  1734.  QOK      BSS    1
  1735.  ARGOK    BSS    1
  1736.  SAMEU0   BSS    1
  1737. * 
  1738. * 
  1739.  BRANCHI  SA1    COMNUM      SEE IF -IFERROR- COMMAND 
  1740.           SB1    X1 
  1741.           SB2    =XIFERR= 
  1742.           NE     B1,B2,BI09  IF NOT -IFERROR- COMMAND 
  1743.           SB1    FSIFERR     -IFERROR- IS PUBLISH ERROR 
  1744.           RJ     =XPUBERRS
  1745.           EQ     BI10 
  1746. * 
  1747.  BI09     SB2    =XSTOP1=    CHECK FOR STOP1 COMMAND
  1748.           NE     B1,B2,BI10    BRANCH IF NOT
  1749.           SA1    SYSFLG      CHECK FOR SYSTEM LESSON
  1750.           LX1    ZSLDSHF
  1751.           NG     X1,BI10       BRANCH IF YES (STOP1 OK) 
  1752.           SB1    150         ISSUE NON-FATAL WARNING
  1753.           RJ     =XRJERNOZ
  1754.  
  1755.  BI10     MX6    -1          MARK UNIT -Q- LEGAL
  1756.           SA6    QOK
  1757.           MX6    0           MARK ARGUMENTS NOT LEGAL 
  1758.           SA6    ARGOK
  1759.           EQ     JOININ1
  1760. * 
  1761.  BRANCHQ  MX6    0
  1762.           SA6    QOK         MARK UNIT -Q- NOT LEGAL
  1763.           SA6    ARGOK       MARK ARGUMENTS NOT LEGAL 
  1764.           EQ     JOININ1
  1765. * 
  1766. * 
  1767. * /---   BLOCK      GOTOIN     00 000   77/04/24  20.24 
  1768.           TITLE  -GOTO- COMMAND 
  1769. * 
  1770. * 
  1771. *         -GOTO- AND -GOTO*- COMMANDS 
  1772. * 
  1773. * 
  1774.  GOTOIN   SA1    TAGCNT      BLANK TAG IS SAME AS UNIT -Q-
  1775.           ZR     X1,UNCGQ 
  1776.           SA1    NEXTCOM     CHECK FOR CONTINUED COMMAND
  1777.           SA2    COMCONT
  1778.           BX2    X1-X2
  1779.           ZR     X2,CGO      CONDITIONAL IF CONTINUED 
  1780.           SA1    WORDPT 
  1781.           MX0    0
  1782.           CALL   PSCAN       SCAN FIRST ELEMENT 
  1783.           ZR     X1,UNCG     JUMP IF UNCONDITIONAL
  1784. * 
  1785. *         CONDITIONAL -GOTO- COMMAND
  1786. * 
  1787.  CGO      CALL   GCOMP       COMPILE
  1788.           LX1    60-XCODEL+XFBIT
  1789.           PL     X1,CGO1     JUMP IF INTEGER
  1790.           SX7    0100B
  1791.           LX7    18          FORM AN RJ TO FTOI CONVERTER 
  1792.           SA1    LLFTOI      ADDRESS OF FTOI ROUTINE
  1793.           BX7    X1+X7
  1794.           CALL   LONGI       ADD TO INSTRUCTION STREAM
  1795.           CALL   PAD         FILL OUT REST OF WORD
  1796. * 
  1797.  CGO1     SA1    NINST       POINTER TO CURRENT WORD
  1798.           SA2    X1 
  1799.           MX0    30          SEE IF 30 BITS LEFT
  1800.           BX7    X0*X2
  1801.           ZR     X7,CGO2     JUMP IF ROOM LEFT
  1802.           CALL   PAD
  1803.           SA1    NINST       POINTER TO NEXT FREE WORD
  1804. * 
  1805.  CGO2     SX7    X1+1        RESERVE ANOTHER WORD 
  1806.           MX6    0
  1807.           SA6    X7          CLEAR OUT LAST WORD
  1808.           SX7    X7+1 
  1809.           SA7    A1          UPDATE *NINST* 
  1810.           CALL   MOVCODE     MOVE COMPILED CODE TO XSTOR
  1811.           BX7    X0          RELATIVE ADDR OF COMPILED CODE 
  1812.           LX7    42          MOVE TO TOP 18 BITS
  1813.           SA7    BRVAR
  1814.           SA2    INX
  1815.           BX6    X2 
  1816.           SA6    GCODADD     SAVE ENDING ADDRESS OF CODE
  1817.           MX6    -1 
  1818.           SA6    QOK         MARK UNIT -Q- LEGAL
  1819.           SA6    SAMEU0      GOTO SAME UNIT SPECIAL 
  1820.           SA6    ARGOK       ARGUMENTS LEGAL
  1821.           SX6    GOTOFIN
  1822.           SA6    JCALL       SET RETURN ADDRESS 
  1823.           EQ     JOININ2
  1824. * 
  1825. * /---   BLOCK      GOTOIN     00 000   76/07/24  16.30 
  1826. * 
  1827. *         DONE -- ADD SETUP INSTRUCTIONS AND PACK UP
  1828. *         COMMAND WORD   (X4 = ADDRESS OF TABLE)
  1829. * 
  1830.  GOTOFIN  SA1    GCODADD     SET UP INSTRUCTION POINTER 
  1831.           SB1    X1+INFO-2
  1832.           SX2    6125B       COMPILE A SB2 B5+K 
  1833.           LX2    18 
  1834.           BX7    X2+X4       ATTACH INDEX TO TABLE
  1835.           RJ     IPACK
  1836.           SA2    UBUFF       NUMBER OF ENTRIES IN TABLE 
  1837.           ZR     X2,ERR2FEW 
  1838.           SX7    7120B       COMPILE A SX2 B0+K 
  1839.           LX7    18 
  1840.           BX7    X2+X7       ATTACH NUMBER OF ENTRIES 
  1841.           RJ     IPACK
  1842.           SX7    0400B       SET UP BRANCH TO -GOTO- ROUTINE
  1843.           LX7    18 
  1844.           SA1    LLGOTO 
  1845.           BX7    X1+X7       ATTACH ADDRESS OF ROUTINE
  1846.           RJ     IPACK
  1847.           RJ     ILJUST      LEFT-ADJUST LAST WORD
  1848.           SA4    COMNUM 
  1849.           SX6    X4+1        X6 = COMMAND NUMBER
  1850.           SA1    BRVAR       ADDRESS OF CODE
  1851.           BX6    X6+X1
  1852.           EQ     ALTCODE     STORE COMPLETED COMMAND WORD 
  1853. * 
  1854. * 
  1855. * 
  1856. *         UNCONDITIONAL -GOTO-
  1857. * 
  1858.  UNCGQ    SX6    UNQNUM      SET FOR UNIT -Q- 
  1859.           EQ     UG1
  1860. * 
  1861.  UNCG     CALL   UNAMA       GET UNIT NUMBER
  1862.           CALL   APACK
  1863.           SX0    X6-UNXNUM
  1864.           ZR     X0,ERRXORQ   ERROR IF UNIT -X- 
  1865.           SA1    UNUMON 
  1866.           BX1    X1-X6       SEE IF GOTO UNIT ALREADY IN
  1867.           NZ     X1,UG1 
  1868.           MX6    0           SET FOR SAME UNIT
  1869.  UG1      LX6    48          PUT INTO TOP 12 BITS 
  1870.           EQ     PUTCODE
  1871. * 
  1872.  GCODADD  BSS    1
  1873. * 
  1874. * 
  1875. * /---   BLOCK      GOTOIN     00 000   73/11/11  00.33 
  1876. * 
  1877. * 
  1878. *         -IPACK- 
  1879. *         ADD 30 BIT INSTRUCTION TO STREAM
  1880. * 
  1881.  IPACK    EQ     *
  1882.           MX0    30 
  1883.           SA1    B1          LOAD NEXT INSTRUCTION WORD 
  1884.           BX2    X0*X1
  1885.           ZR     X2,IP1      JUMP IF ENOUGH ROOM
  1886.           MX0    15 
  1887.           BX2    X0*X1       SEE IF ROOM FOR 15 BIT INST
  1888.           NZ     X2,IP0 
  1889.           SX6    46000B 
  1890.           LX1    15          ADD A PASS INSTRUCTION 
  1891.           BX6    X1+X6
  1892.           SA6    B1          STORE COMPLETED WORD 
  1893. * 
  1894.  IP0      SB1    B1+1 
  1895.           MX1    0           SET UP FOR NEW WORD
  1896. * 
  1897.  IP1      LX1    30 
  1898.           BX7    X1+X7       MERGE NEW INSTRUCTION
  1899.           SA7    B1 
  1900.           EQ     IPACK
  1901. * 
  1902. * 
  1903. *         -ILJUST-
  1904. *         LEFT JUSTIFY LAST WORD OF INSTRUCTIONS
  1905. * 
  1906.  ILJUST   EQ     *
  1907.           MX0    15 
  1908.           SA1    B1          LOAD LAST INSTRUCTION WORD 
  1909.  ILJ1     BX2    X0*X1
  1910.           NZ     X2,ILJ2     JUMP IF WORD LEFT-JUSTIFIED
  1911.           LX1    15 
  1912.           EQ     ILJ1 
  1913.  ILJ2     BX6    X1          STORE LEFT-JUSTIFIED WORD
  1914.           SA6    B1 
  1915.           EQ     ILJUST 
  1916. * 
  1917. * /---   BLOCK      -DO-       00 000   77/04/24  20.24 
  1918.           TITLE  -DO- COMMAND 
  1919. * 
  1920. * 
  1921. *         -DO- COMMAND   (REGULAR JOIN) 
  1922. * 
  1923. *         THIS COMMAND MAY TAKE THE FOLLOWING FORMS - 
  1924. *         DO  UNIT
  1925. *         DO  EXPR,UNIT,UNIT.....UNIT 
  1926. *         DO  UNIT,EXPR_EXPR,EXPR,(EXPR)
  1927. *         DO  EXPR,UNIT,UNIT.....UNIT,EXPR_EXPR,EXPR,(EXPR) 
  1928. *         DO  EXPR,EXPR_EXPR,EXPR,(EXPR)
  1929. * 
  1930. * 
  1931.  JOININ   MX6    -1          MARK -JOIN- COMMAND
  1932.           SA6    JOINFLG
  1933.           EQ     DOIN1
  1934. * 
  1935.  DOIN     MX6    0           MARK NOT A -JOIN- COMMAND
  1936.           SA6    JOINFLG
  1937. * 
  1938.  DOIN1    BSS    0
  1939.           SA1    WORDPT      POINTER TO FIRST CHARACTER 
  1940.           MX0    0
  1941.           CALL   PSCAN       SCAN PAST FIRST ENTRY
  1942.           ZR     X1,UNCDO 
  1943.           SX1    B1+1        ADVANCE CHARACTER POINTER
  1944.           SX0    KASSIGN     ACCEPT ASSIGNMENT AS TERMINATOR
  1945.           CALL   PSCAN
  1946.           BX0    X0-X1       CHECK IF ENDED WITH ASSIGNMENT 
  1947.           NZ     X0,DOC 
  1948.           SX6    1R,         REPLACE ASSIGNMENT WITH COMMA
  1949.           SA6    B1 
  1950.           EQ     DOIT        UNCONDITIONAL ITERATED -DO-
  1951. * 
  1952. * 
  1953. *         UNCONDITIONAL -DO- COMMAND
  1954. * 
  1955.  UNCDO    MX6    0           PRESET TO NO RETURN ARGS 
  1956.           SA6    =XRARGFLG
  1957.           CALL   UNAMA1      PROCESS UNIT NAME
  1958.           SX0    X6-UNXNUM
  1959.           ZR     X0,ERRXORQ   ERROR IF UNIT -X- 
  1960.           SX0    X6-UNQNUM
  1961.           ZR     X0,UNCDOQ   SPECIAL FOR UNIT -Q- 
  1962.           LX6    60-12
  1963.           SX1    DOJ=        PRE-SET FOR -DO- COMMAND 
  1964.           SA2    JOINFLG     SEE IF -JOIN- COMMAND
  1965. +         ZR     X2,*+1 
  1966.           SX1    JOIN=       SET COMMAND CODE = JOIN
  1967. +         BX6    X1+X6
  1968.           EQ     UALTC
  1969. * 
  1970.  UNCDOQ   SX6    DOJ=        GET COMMAND NUMBER 
  1971.  UALTC    SA1    =XRARGFLG    SEE IF ANY RETURN ARGUMENTS 
  1972.           ZR     X1,ALTCODE  IF NO RETURN ARGUMENTS 
  1973. * 
  1974.           SA1    ICX         ADD -DO-/-JOIN- COMMAND
  1975.           SX7    X1-1 
  1976.           SA7    A1 
  1977.           SA6    INFO+X7     STORE COMMAND WORD 
  1978.           SX6    =XDOR=     SET CODE FOR RETURN ARGS COMMAND
  1979.           SA1    JOINFLG
  1980. +         ZR     X1,*+1      IF -JOIN- COMMAND
  1981. * 
  1982.           SX6    =XJOINR= 
  1983.           EQ     ALTCODE
  1984. * 
  1985. * 
  1986. * 
  1987. * /---   BLOCK      -DO-       00 000   76/07/25  06.35 
  1988. * 
  1989. * 
  1990. *         CONDITIONAL -DO- COMMAND READIN 
  1991. * 
  1992.  DOC      CALL   COMPILE     EVALUATE EXPRESSION
  1993.           BX6    X1 
  1994.           SA6    BRVAR       SAVE -GETVAR- CODE 
  1995.           MX6    0
  1996.           SA6    UBUFF       INITIALIZE UNIT COUNT
  1997.           SA6    ISITER      PRE-SET NOT ITERATED CASE
  1998.           SA6    =XRARGFLG   PRESET TO NO RETURN ARGUMENTS
  1999. * 
  2000.  DOULP    SA1    WORDPT      POINTER TO NEXT CHARACTER
  2001.           SA2    X1 
  2002.           ZR     X2,DOEOL    JUMP IF END-OF-LINE
  2003.           SX0    KASSIGN     ACCEPT ASSIGNMENT AS TERMINATOR
  2004.           CALL   PSCAN
  2005.           BX0    X0-X1       SEE IF ENDED WITH ASSIGNMENT 
  2006.           ZR     X0,DOCIT 
  2007.           CALL   UNAMA1 
  2008.           SA1    UBUFF
  2009.           SX7    X1+1        INCREMENT UNIT COUNT 
  2010.           SA7    A1 
  2011.           SX1    X1-100      ALLOW 100 UNITS
  2012.           PL     X1,ERR2MNY 
  2013.           SA6    X7+UBUFF    STORE THIS UNIT NUMBER 
  2014.           SA1    WORDPT 
  2015.           SA1    X1 
  2016.           NZ     X1,DOULP    JUMP IF NOT END OF LINE
  2017. * 
  2018.  DOEOL    SA1    NEXTCOM
  2019.           SA2    COMCONT     CHECK IF CONTINUED 
  2020.           BX2    X1-X2
  2021.           NZ     X2,DOUPACK  JUMP IF NOT CONTINUED
  2022.           CALL   GETLINE
  2023.           EQ     DOULP
  2024. * 
  2025.  DOCIT    MX6    -1          MARK ITERATED -DO- 
  2026.           SA6    ISITER 
  2027.           SX6    1R,         REPLACE ASSIGNMENT WITH COMMA
  2028.           SA6    B1 
  2029. * 
  2030. * /---   BLOCK      -DO-       00 000   76/07/25  06.36 
  2031. * 
  2032.  DOUPACK  SA1    UBUFF       GET NUMBER OF UNITS
  2033.           ZR     X1,ERR2FEW 
  2034.           SB1    X1 
  2035.           SA2    INX         INITIALIZE XSTOR POINTER 
  2036.           BX7    X2 
  2037.           SA7    DTABLOC     SAVE ADDRESS OF UNIT TABLE 
  2038. * 
  2039.  DOPACK   MX6    0           CLEAR WORD BUILDING
  2040.           SB2    45          INITIALIZE SHIFT COUNT 
  2041. * 
  2042.  DOPK1    SB1    B1-1        DECREMENT UNIT COUNT 
  2043.           NG     B1,DOPFIN
  2044.           SA1    A1+1        LOAD NEXT UNIT NUMBER
  2045.           LX1    X1,B2
  2046.           BX6    X1+X6       MERGE WITH REST OF WORD
  2047.           SB2    B2-15
  2048.           PL     B2,DOPK1    JUMP IF WORD NOT FULL
  2049.           SA6    X7+INFO
  2050.           SX7    X7+1        INCREMENT XSTOR POINTER
  2051.           EQ     DOPACK 
  2052. * 
  2053.  DOPFIN   SB1    B2-45       SEE IF LAST WORD EMPTY 
  2054.           PL     B1,DOPF1 
  2055.           SA6    X7+INFO     STORE LAST WORD OF UNIT TABLE
  2056.           SX7    X7+1 
  2057. * 
  2058.  DOPF1    SA7    INX         UPDATE EXTRA STORAGE POINTER 
  2059.           SA1    DTABLOC
  2060.           LX1    12+XCMNDL   POSITION ADDRESS OF TABLE
  2061.           SA2    UBUFF
  2062.           LX2    XCMNDL      POSITION NUMBER OF UNITS 
  2063.           BX6    X1+X2
  2064.           SA1    BRVAR
  2065.           LX1    60-XCODEL   POSITION -GETVAR- CODE 
  2066.           BX6    X1+X6
  2067.           SA1    ISITER 
  2068.           NZ     X1,DOPF2    JUMP IF ITERATED 
  2069.           SX1    DOC=        PRE-SET FOR -DO- COMMAND 
  2070.           SA2    JOINFLG
  2071. +         ZR     X2,*+1      CHECK FOR -JOIN- COMMAND 
  2072.           SX1    JOINC= 
  2073. +         BX6    X1+X6       ATTACH COMMAND NUMBER
  2074.           EQ     UALTC       UPDATE BINARY
  2075. * 
  2076.  DOPF2    SA6    X7+INFO     SAVE UNIT TABLE INFO IN XSTOR
  2077.           SX6    7000B
  2078.           BX6    X6+X7       SET UP SPECIAL FAKE UNIT NUMBER
  2079.           LX6    48 
  2080.           SA6    VARBUF 
  2081.           SX7    X7+1 
  2082.           SA7    INX         UPDATE EXTRA STORAGE INDEX 
  2083.           EQ     DOITC       PROCESS INDEX EXPRESSIONS
  2084. * 
  2085. * /---   BLOCK      -DO-       00 000   76/07/25  06.36 
  2086. * 
  2087. * 
  2088. *         UNCONDITIONAL ITERATED -DO- COMMAND READIN
  2089. * 
  2090.  DOIT     CALL   UNAMA1      GET UNIT NUMBER AND ARGS 
  2091.           SX0    X6-UNXNUM
  2092.           ZR     X0,ERRXORQ   ERROR IF UNIT -X- 
  2093.           SX0    X6-UNQNUM
  2094.           ZR     X0,ERRXORQ   ERROR IF UNIT -Q- 
  2095.           LX6    48          PUT INTO TOP 12 BITS 
  2096.           SA6    VARBUF 
  2097. * 
  2098. *         CONDITIONAL ITERATED -DO- COMMAND READIN
  2099. * 
  2100.  DOITC    SX6    DO=         PRE-SET FOR -DO- COMMAND 
  2101.           SA1    JOINFLG
  2102. +         ZR     X1,*+1      CHECK FOR -JOIN- COMMAND 
  2103.           SX6    JDO= 
  2104. +         SA6    COMNUM      SET COMMAND NUMBER 
  2105.           SA1    WORDPT      POINTER TO NEXT CHARACTER
  2106.           BX6    X1 
  2107.           SA6    WPTSAV1     SAVE ADDR OF INDEX EXPRESSION
  2108.           CALL   TAGSAVE     SAVE TAG IN ECS
  2109.           CALL   GCOMP       DECODE INDEX EXPRESSION
  2110.           AX1    XCODEAL+2
  2111.           SX0    2
  2112.           BX6    X0*X1       MASK OFF I/F BIT 
  2113.           SA6    DOVTYPE
  2114.           ZR     X6,DOIT0    JUMP IF INTEGER INDEX
  2115.           SA1    COMNUM 
  2116.           SX6    X1+2        INCREMENT COMMAND NUMBER 
  2117.           SA6    A1 
  2118. * 
  2119.  DOIT0    SX7    10610B 
  2120.           CALL   SHORT       ADD A  BX6  X1 
  2121.           SX7    5160B
  2122.           LX7    18          ADD A  SA6  B0+COMPUSE 
  2123.           SA1    LLCOUSE
  2124.           BX7    X1+X7       ATTACH ADDRESS OF *COMPUSE*
  2125.           CALL   LONGI
  2126. * /---   BLOCK      -DO-       00 000   76/07/25  06.38 
  2127. * 
  2128.           SA1    WORDPT 
  2129.           BX6    X1          SAVE *WORDPT*
  2130.           SA6    WPTSAV2
  2131.           MX0    0           NO SPECIAL TERMINATOR
  2132.           CALL   PSCAN
  2133.           ZR     X1,ERRTERM 
  2134.           SX6    B1+1        ADVANCE CHARACTER POINTER
  2135.           SA6    WORDPT 
  2136.           CALL   GCOMP1      EVALUATE END-TEST EXPRESSION 
  2137.           RJ     ITFFTI      GENERATE I-F F-I INSTRUCTIONS
  2138.           SX7    10610B 
  2139.           CALL   SHORT       ADD A  BX6  X1 
  2140.           SX7    5160B
  2141.           LX7    18          ADD A  SA6  B0+COMPUSE+1 
  2142.           SA1    LLCOUSE
  2143.           SX1    X1+1        *COMPUSE* +1 
  2144.           BX7    X1+X7
  2145.           CALL   LONGI
  2146.           SA1    LASTKEY     SEE IF END OF LINE 
  2147.           NZ     X1,DOIT1 
  2148.           SX7    7110B       FORM A  SX1  B0+1
  2149.           LX7    18 
  2150.           SX6    1
  2151.           BX7    X6+X7       ASSUMED INCREMENT IS +1
  2152.           CALL   LONGI
  2153.           MX1    0           SET FOR INTEGER
  2154.           EQ     DOIT2
  2155. * 
  2156.  DOIT1    CALL   GCOMP1      EVALUATE INCREMENT EXPRESSION
  2157. * 
  2158.  DOIT2    RJ     ITFFTI      GENERATE I-F F-I INSTRUCTIONS
  2159.           SX7    0100B       FORM A  RJ  DOLOC
  2160.           LX7    18 
  2161.           SA1    LLDOLOC
  2162.           BX7    X1+X7       ATTACH ADDRESS OF *DOLOC*
  2163.           CALL   LONGI
  2164.           CALL   PAD         FILL OUT REST OF WORD
  2165.           SA1    WPTSAV1
  2166.           BX6    X1          SET POINTER TO INDEX EXPRESSION
  2167.           SA6    WORDPT 
  2168.           CALL   TAGREST     RESTORE *TAG* BUFFER 
  2169.           CALL   PCOMP1      PRODUCE CODE TO STORE X6 
  2170.           SX7    0230B
  2171.           LX7    18          ADD A  JP  B3+B0 
  2172.           CALL   LONGI
  2173.           CALL   PAD
  2174.           CALL   MOVCODE     MOVE COMPILED CODE TO XSTOR
  2175.           BX6    X0 
  2176.           SA6    VARBUF+1    SAVE ADDRESS OF COMPILED CODE
  2177. * 
  2178. * /---   BLOCK      -DO-       00 000   77/04/24  20.25 
  2179. * 
  2180.           SA1    WPTSAV2     SET POINTER TO INITIAL VALUE 
  2181.           BX6    X1          EXPRESSION 
  2182.           SA6    WORDPT 
  2183.           CALL   COMPILE     DECODE INITIAL EXPRESSION
  2184.           BX6    X1 
  2185.           LX6    60-12-18-XCODEL
  2186.           SA1    VARBUF 
  2187.           BX6    X1+X6       ATTACH UNIT NUMBER 
  2188.           SA1    VARBUF+1 
  2189.           LX1    60-12-18    POSITION ADDRESS OF CODE 
  2190.           BX5    X1+X6
  2191.           SA4    COMNUM 
  2192.           BX6    X4+X5       ATTACH COMMAND NUMBER
  2193.           SA1    ICX
  2194.           SX7    X1-2        UPDATE COMMAND POINTER 
  2195.           SA7    ICX
  2196.           SA6    X7+INFO+1   STORE 2 COMMAND WORDS
  2197.           SX4    X4+1 
  2198.           BX6    X4+X5       ATTACH INCREMENTED COMMAND NUM 
  2199.           SA6    X7+INFO
  2200.           EQ     NXTLINE
  2201. * 
  2202.           EXT    ERRORC,PUTCODE,DATAON=,CALCODE 
  2203.           EXT    COMCONT,VARFIN,NXTLINE,ALTCODE 
  2204.           EXT    ECSPRTY,KEYTYPE,NKLIST,NKLEND
  2205.           EXT    LNGUNIT,COMPNAM
  2206.           EXT    UNIT=,ARGS=,DO=,DOJ=,DOC=,UNITOP=
  2207.           EXT    JOIN=,JOINC=,JDO=,IEUEND=
  2208.           EXT    ITFFTI,DOVTYPE,ERRCALL 
  2209.           EXT    PSCAN,PAUSE2 
  2210.           EXT    ERRTAGS,ERRNAME,ERRSTOR
  2211.           EXT    ERRXYTG,ERR2MNY,ERR2FEW
  2212.           EXT    ERRTERM,ERRUARG,ERRVTYP
  2213.           EXT    ERROUTR,ERRCNTD,ERRXORQ
  2214.           EXT    ERRBAL 
  2215. * 
  2216. * /---   BLOCK      UNIT       00 000   76/11/25  03.26 
  2217.           TITLE  UNIT 
  2218. * 
  2219. *         UNIT COMMAND FORMAT-- 
  2220. *         FIRST 12 BITS = NEXT PHYSICAL UNIT
  2221. *         NEXT  12      = NEXT PHYSICAL UNIT
  2222. *         NEXT  36      = COMMAND NUMBER
  2223. * 
  2224. * 
  2225. * 
  2226.  UNITC    SB1    FSUNIT      -UNIT- FOR PUBLISH TEXT
  2227.           RJ     =XPUBTEXT
  2228.           SA1    INDENT 
  2229.           NZ     X1,=XNOINDT INDENTING IS NOT PERMITTED 
  2230.           CALL   GLOBSYM     FINISH UP GLOBAL CALC BRANCHES 
  2231.           CALL   ULONG       CHECK FOR UNIT TOO LONG
  2232.           CALL   SETARO,B0   PSEUDO -ENDARROW-
  2233.           CALL   UNAM1       PROCESS UNIT NAME
  2234.           SX2    X6-UNXNUM   CHECK FOR ILLEGAL UNIT -X- 
  2235.           ZR     X2,UNITCF   JUMP IF UNIT X 
  2236.           SX2    X6-UNQNUM   CHECK FOR ILLEGAL UNIT -Q- 
  2237.           ZR     X2,UNITCF   JUMP IF UNIT Q 
  2238.           SA1    X6+ULOC
  2239.           PL     X1,UNITCE   ERROR IF DUPLICATE UNIT
  2240. * 
  2241.           RJ     =XUNITLOC   LOG UNIT NAME/LOCATION 
  2242.           SA1    UNUMON 
  2243.           SX2    X1-IEUNUM   SEE IF INITIAL ENTRY UNIT
  2244.           NZ     X2,UNI10 
  2245.           SA2    ICX         GET COMMAND POINTER
  2246.           SX2    X2-1 
  2247.           SA3    INX
  2248.           IX3    X3-X2       CHECK FOR UNIT TOO LONG
  2249.           PL     X3,LNGUNIT 
  2250.           BX7    X2 
  2251.           SA7    A2          UPDATE FOR -IEUEND- COMMAND
  2252.           SX7    IEUEND=
  2253.           SA7    X2+INFO     ADD AN -IEUEND- COMMAND
  2254. * 
  2255.  UNI10    IX7    X6-X1       UNIT A CONTAINING UNIT A 
  2256.           ZR     X7,UNITCE   DUPLICATE UNIT NAME
  2257.           SA6    A1          SET UNIT WORKING ON POINTER
  2258. * 
  2259.           MX7    1           SET THAT A UNIT FOUND
  2260.           SA7    NOUNIT 
  2261. * 
  2262. * /---   BLOCK      UNIT       00 000   81/07/16  04.19 
  2263. * 
  2264.           MX6    0           FLAG AS UNIT 
  2265. * 
  2266.           SA1    COMNUM      GET COMMAND NUMBER 
  2267.           SX3    UNITOP=     GET NUMBER OF UNITOP 
  2268.           BX3    X1-X3
  2269.           NZ     X3,UDONE 
  2270.           MX6    1           IF UNITOP, SET UNITOP BIT
  2271.           LX6    58 
  2272. * 
  2273. * 
  2274. *         FINISH UP CURRENT UNIT
  2275. * 
  2276.  UDONE    SA6    NUEFLAG     SAVE NEW UEFLAG
  2277.           NG     X6,UDONE10  IF -ENTRY- 
  2278. * 
  2279.           SA1    LOCAL
  2280.           ZR     X1,UDONE10  IF NO LOCAL DEFINE SET TO PURGE
  2281. * 
  2282.           SX6    1           PURGE LOCAL SET/REACTIVATE GSET
  2283.           SA6    OVARG1 
  2284.           EXEC   DEFOV       RETURN TO *UDONE10*
  2285. * 
  2286.  UDONE10  SA1    NUEFLAG
  2287.           BX6    X1          X6 = UEFLAG FOR UWRITE 
  2288.           CALL   UWRITE      WRITE UNIT TO ECS
  2289. * 
  2290.           SA1    CUNITS      INCREMENT NUMBER OF UNITS/ENTRIES
  2291.           SX6    X1+1 
  2292.           SA6    A1 
  2293. * 
  2294. *         INITIALIZE FOR NEW UNIT 
  2295. * 
  2296.           SA1    LINENUM     SAVE LINE AND BLOCK NUMBERS
  2297.           SA2    BLKNUM         IN CASE OF ERRORS 
  2298.           BX6    X1 
  2299.           BX7    X2 
  2300.           SA6    =XULINENM
  2301.           SA7    =XUBLKNM 
  2302. * 
  2303.           SX7    INFOLTH
  2304.           SA7    ICX         INITIALIZE COMMAND POINTER 
  2305.           SX7    -1 
  2306.           SA7    ANSABUF     INITIALIZE ANSWERA BUFFER BIAS 
  2307.           SX7    0
  2308.           SA7    INX         INITIALIZE XSTOR POINTER 
  2309.           SA7    NGLOBAL     NUMBER OF GLOBAL SYMBOLS 
  2310.           SA7    NDOOFF      NUMBER OF DEFERRED -DOTO-
  2311.           SA7    DOBFPNT     -DOTO- ECS POINTER 
  2312.           SA7    NDEFERR     NUMBER OF DEFERRED REFERENCES
  2313.           SA7    =XNLABELS   NUMBER OF LABELS 
  2314.           SA7    GSYMERR1    GLOBAL SYMBOL ERROR FLAGS
  2315.           SA7    GSYMERR2 
  2316.           SA1    NUEFLAG     X1 = -UNIT-/-ENTRY- FLAG 
  2317.           NG     X1,UDONE20  IF -ENTRY- 
  2318. * 
  2319.           SA7    LOCAL       FLAG END OF LOCAL SET ACTIVITY 
  2320.           SA7    LVARN       NUMBER OF LOCAL VARIABLES
  2321.           SA1    CONTFLG     X1 = CONTINUATION FLAG 
  2322.           PL     X1,UDONE20   IF NO LOCAL SET 
  2323. * 
  2324.           SX6    1           FLAG LOCAL SET PROCESSING
  2325.           SA6    LOCAL
  2326.           MX6    0
  2327.           SA6    OVARG1 
  2328.           EXEC   DEFOV       PROCESS LOCAL SET
  2329. * 
  2330. * RETURN TO UDONE20 
  2331. * /---   BLOCK      UNIT       00 000   80/03/28  00.28 
  2332. * 
  2333.  UDONE20  SA1    COMMAND     SAVE COMMAND NAME
  2334.           BX6    X1 
  2335.           SA6    =XCMNDTMP
  2336.           SA1    UNITCMD     SET COMMAND = UNIT 
  2337.           SA2    NUEFLAG     X2 = -1 IF -ENTRY
  2338.           PL     X2,UDONE25  IF -UNIT- COMMAND
  2339. * 
  2340.           SA1    NTRYCMD     SET COMMAND = ENTRY
  2341.  UDONE25  BX6    X1 
  2342.           SA6    COMMAND
  2343.           MX6    -1 
  2344.           SA6    UNITFLG     FLAG -UNIT- COMMAND
  2345.           CALL   UNAM2       PROCESS ANY ARGUMENTS
  2346.           SA1    =XCMNDTMP   X1 = SAVED COMMAND NAME
  2347.           BX6    X1 
  2348.           SA6    COMMAND     RESTORE COMMAND NAME 
  2349.           MX6    0
  2350.           SA6    A1          ZERO CMNDTMP 
  2351.           SA1    LOCAL
  2352.           ZR     X1,UDONE30 
  2353. * 
  2354.           SA1    NUEFLAG
  2355.           NG     X1,UDONE30  IF -ENTRY- IN LOCALS UNIT
  2356. * 
  2357.           RJ     =XRSTRTAG   RESTORE TAG AFTER LOCAL SET
  2358.           SA1    VARBUF 
  2359.           ZR     X1,=XNXTC     EXIT IF NO ARGUMENTS 
  2360.           EQ     UDONE40
  2361. * 
  2362.  UDONE30  BSS    0
  2363.           SA1    VARBUF 
  2364.           ZR     X1,NXTLINE  EXIT IF NO ARGUMENTS 
  2365. * 
  2366. * /---   BLOCK      UNIT       00 000   80/03/28  00.24 
  2367.  UDONE40  SA2    UEFLAG      SET ARGS BIT IN UNAM TABLE WORD
  2368.           MX7    1
  2369.           LX7    59 
  2370.           BX7    X2+X7       COMBINE WITH UNIT/ENTRY FLAG 
  2371.           SA7    A2 
  2372. * 
  2373.           CALL   APACK       PACK UP -GETVAR- CODES 
  2374.           MX0    -10
  2375.           BX6    -X0*X6      MASK OFF EXTRA STORAGE POINTER 
  2376.           LX6    48 
  2377.           SX1    ARGS=       SET CODE FOR -ARG- COMMAND 
  2378.           BX6    X1+X6
  2379.           SA2    NUEFLAG
  2380.           NG     X2,ALTCODE  IF -ENTRY- COMMAND 
  2381. * 
  2382.           SA2    LOCAL
  2383.           NZ     X2,=XALTCOD1  SPECIAL ALTCODE FOR LOCAL VARS 
  2384. * 
  2385.           EQ     ALTCODE
  2386. * 
  2387.  UNITCE   SB1    71          DUPLICATE UNIT NAME
  2388.           EQ     =XERR
  2389.  UNITCF   SB1    72          UNIT NAME MAY NOT BE -X- OR -Q-
  2390.           EQ     =XERR
  2391. * 
  2392.  UNITCMD  DATA   8LUNIT 
  2393.  NTRYCMD  DATA   8LENTRY
  2394. * /---   BLOCK      UWRITE     00 000   77/04/21  21.25 
  2395.           TITLE  -UWRITE- 
  2396. * 
  2397. *         -UWRITE-           WRITE LAST UNIT TO ECS 
  2398. * 
  2399.  UWRITE   EQ     *
  2400.           SA3    UEFLAG      GET FLAG FOR PREVIOUS UNIT 
  2401.           SA6    A3          SAVE FLAG FOR NEXT UNIT
  2402.           SA1    UNIT        GET CURRENT UNIT NUMBER
  2403.           SA0    ABEND       WORK BUFFER
  2404.           SA2    AUNAME      GET UNORDERED UNIT NAME TABLE
  2405.           IX0    X1+X2       GET ENTRY OF CURRENT UNIT
  2406. +         RE     1
  2407.           RJ     ECSPRTY
  2408.           SA2    A0          READ UP UNIT NAME
  2409.           BX6    X2+X3       ADD IN BITS FOR'; ENTRY, ARGS
  2410.           SA1    UNUMON      GET NEXT UNIT NUMBER 
  2411.           LX1    48 
  2412.           BX6    X1+X6       PUT TOGETHER 
  2413.           SA6    A0 
  2414. +         WE     1           AND OUT TO TABLE 
  2415.           RJ     ECSPRTY
  2416. * 
  2417. *         FOR FOLLOWING...
  2418. *         X0 HOLDS BINARY INSERT POINTER
  2419. *         X3 HOLDS FORMING TOTAL LENGTH OF UNIT 
  2420. *         X6 HOLDS THE DEVELOPING UNIT-LOC WORD 
  2421. * 
  2422. *         THE FORMAT OF THE UNIT LOCATION INFO WORD IS... 
  2423. *         ULOC1 BITS RELATIVE BIAS TO UNIT IN BINARY
  2424. *         ULOC2 BITS LENGTH OF CENTRAL MEMORY PART OF UNIT
  2425. *         ULOC3 BITS NUMBER OF COMMANDS IN UNIT 
  2426. *         ULOC4 BITS TOTAL LENGTH OF UNIT (CM PART PLUS ECS RES PART) 
  2427. *         ULOC5 BITS NUMBER OF LOCAL VARS IN UNIT 
  2428. * 
  2429. * 
  2430.           SA1    CONBUFF     GET ADDRESS OF CONDENSE BUFFER 
  2431.           SA2    CONDPNT     CURRENT PLACE IN THIS BUFFER 
  2432.           IX6    X2-X1       GET RELATIVE ADDRESS OF START OF UNIT
  2433.           LX6    60-ULOC1    AND PUT INTO ULOC WORD-A-MAKING
  2434.           BX0    X2          POINT AT WHICH TO INSERT IN BINARY 
  2435. * 
  2436.           SA1    ICX
  2437.           SA0    X1+INFO     CM ADDRESS OF COMMANDS 
  2438.           SX4    INFOLTH
  2439.           IX2    X4-X1       GET NUMBER OF COMMANDS 
  2440.           BX3    X2 
  2441.           BX5    X2 
  2442.           LX5    60-ULOC1-ULOC2-ULOC3   POSITION FOR ULOC WORD
  2443.           BX6    X6+X5       ADD NUMBER OF COMMANDS TO ULOC WORD
  2444.           NG     X2,LNGUNIT  TEST FOR UNIT TOO LONG 
  2445.           CALL   WRITECS     WRITE COMMANDS TO BINARY-A-FORMING 
  2446. * 
  2447.           SA2    INX         GET LENGTH OF EXTRA STORAGE
  2448.           SA0    INFO        CM ADDRESS OF EXTRA STORAGE
  2449.           IX3    X3+X2       ADD CM ARGS LENGTH TO FORMING TOTAL LENGTH 
  2450.           BX4    X3 
  2451. * /---   BLOCK      UWRITE     00 000   77/04/21  21.25 
  2452.           LX4    60-ULOC1-ULOC2   PUT CM RES TOTAL LENGTH IN PLACE FOR
  2453.           BX6    X6+X4         ADDING TO FORMING UNIT LOC WORD
  2454.           CALL   WRITECS     PUT CM RES ARGS TO BINARY-A-FORMING
  2455. * /---   BLOCK      UWRITE     00 000   77/03/31  17.49 
  2456. * 
  2457.           SA4    ECSARGS     GET NUMBER OF ECS RESIDENT ARGS
  2458. * 
  2459.           IX3    X3+X4       ADD AMOUNT TO TOTAL LENGTH OF UNIT 
  2460. * 
  2461.           LX3    60-ULOC1-ULOC2-ULOC3-ULOC4   POSITION
  2462.           BX6    X6+X3       ADD TOTAL LENGTH TO UNIT-LOC WORD
  2463. * 
  2464.           SA1    LVARN       X1 = NUMBER OF LOCALS IN UNIT
  2465.           LX1    60-ULOC1-ULOC2-ULOC3-ULOC4-ULOC5 
  2466.           BX6    X6+X1       X6 = ULOC ENTRY + LVARN
  2467. * 
  2468.           SA1    ECSRESB     GET START OF ECS ARGS BUFFER 
  2469.           SA0    INFO          USE CM WORK BUF
  2470. *            COULD USE -WORK- AND -WORKLTH- FOR BIGGER TRANSFER BUFFERS 
  2471. * 
  2472.  UWTOP    ZR     X4,UWDONE   START OF LOOP TO RELOCATE ECS RES PART 
  2473.           BX7    X0          SAVE CURRENT INSERT POINTER IN BINARY
  2474.           BX2    X4          LENGTH OF ECS RES PART OF UNIT 
  2475.           SX4    X4-INFOLTH  SEE IF WILL FIT INTO CM BUFFER 
  2476.           BX0    X1          GET CONDENSOR ADDRESS OF ECS RES PART OF U 
  2477.           NG     X4,UWMID    SEE IF CAN DO IN ONE PASS
  2478.           SX2    INFOLTH     ELSE JUST DO CM BUFFER LENGTH
  2479.  UWMID    SB1    X2          NOW TRANSFER TO CM 
  2480. +         RE     B1 
  2481.           RJ     ECSPRTY
  2482.           IX1    X0+X2       AUGMENT ECS RES ADDRESS FOR NEXT MOVE
  2483.           BX0    X7          GET CURRENT INSERT PLACE IN BINARY 
  2484.           CALL   WRITECS     MOVE INTO BINARY 
  2485.           PL     X4,UWTOP    SEE IF EVERYTHING TRANSFERRED
  2486. * 
  2487. * 
  2488.  UWDONE   BX7    X0          UPDATE POINTER OF CURRENT PLACE
  2489.           SA7    CONDPNT       MATERIAL IS BEING ADDED TO BINARY
  2490.           SA1    UNIT 
  2491.           SA6    X1+ULOC     PUT OUT THIS UNIT-LOC INFORMATION
  2492.           SA2    UNUMON 
  2493.           BX6    X2 
  2494.           SA6    A1          SET NEXT UNIT NUMBER 
  2495.           MX6    0
  2496.           SA6    ECSARGS     INITIALIZE ECS ARGS TO ZERO
  2497.           EQ     UWRITE 
  2498. * 
  2499. * 
  2500. * /---   BLOCK      UNAMA      00 000   73/00/00  00.00 
  2501.           TITLE  -UNAMA-
  2502. * 
  2503. * 
  2504. *         -UNAMA- 
  2505. *         UNIT NAME AND ARGUMENT PROCESSOR
  2506. * 
  2507. *         RETURNS WITH   X6 = UNIT NUMBER 
  2508. *                 VARBUF(0) = NUMBER OF ARGUMENTS 
  2509. *                 VARBUF(N) = -GETVAR- CODES FOR ARGUMENTS
  2510. * 
  2511. * 
  2512.  UNAMA    EQ     *
  2513.           CALL   UNAM1       PROCESS UNIT NAME
  2514.           CALL   UNAM2       PROCESS ARGUMENTS
  2515.           EQ     UNAMA
  2516. * 
  2517. * 
  2518. * /---   BLOCK      UNAM1      00 000   76/07/25  06.40 
  2519.           TITLE  -UNAM1-
  2520. * 
  2521. * 
  2522. *         -UNAM1- 
  2523. *         COLLECT UNIT NAME AND CHECK FOR ARGUMENTS 
  2524. * 
  2525. *         RETURNS X6 = UNIT NUMBER
  2526. *                 *UARGS* = -1 IF ARGUMENTS 
  2527. *                            0 IF NO ARGUMENTS
  2528. * 
  2529. * 
  2530.  UNAM1    EQ     *
  2531.           SA1    WORDPT      POINTER TO FIRST CHARACTER 
  2532.           SB1    X1-1 
  2533.           SB2    60-6        INITIALIZE SHIFT COUNT 
  2534.           MX6    0           INITIALIZE NAME BUILDING 
  2535.           SA6    UNITFLG     CLEAR -UNIT- FLAG
  2536. * 
  2537.  UNLP     SB1    B1+1        ADVANCE CHARACTER POINTER
  2538.           SA1    B1          LOAD NEXT CHARACTER
  2539.           SX2    X1-1R
  2540.           NZ     X2,UNLP0    JUMP IF NOT SPACE
  2541.           ZR     X6,UNLP     JUMP IF LEADING SPACE(S) 
  2542.           SB3    B2-7 
  2543.           NG     B3,UNLP     POSSIBLE TRAILING SPACES 
  2544. * 
  2545.  UNLP0    ZR     X1,UNAGOT
  2546.           SA2    X1+KEYTYPE 
  2547.           NG     X2,UNLP1    JUMP IF ALPHANUMERIC 
  2548.           ZR     X2,UNLP1 
  2549.           SX3    X2-OPCOMMA  CHECK FOR COMMA
  2550.           ZR     X3,UNAGOT1 
  2551.           SX3    X2-OP(      CHECK FOR RIGHT PAREN
  2552.           ZR     X3,UNAGOT2 
  2553.           SX3    X2-OP)      CHECK FOR LEFT PAREN 
  2554.           ZR     X3,ERRTERM 
  2555. * 
  2556.  UNLP1    LX1    X1,B2       POSITION THIS CHARACTER
  2557.           BX6    X1+X6       MERGE WITH REST OF WORD
  2558.           SB2    B2-6 
  2559.           PL     B2,UNLP
  2560.           EQ     ERRNAME
  2561. * /---   BLOCK      UNAM1      00 000   76/07/25  06.41 
  2562. * 
  2563.  UNAGOT   SX7    B1          UPDATE *WORDPT*
  2564.           SA7    WORDPT 
  2565.           MX7    0           MARK NO ARGUMENTS
  2566.           EQ     UAGOT
  2567. * 
  2568.  UNAGOT1  SX7    B1+1        UPDATE *WORDPT*
  2569.           SA7    WORDPT 
  2570.           MX7    0           MARK NO ARGUMENTS
  2571.           EQ     UAGOT
  2572. * 
  2573.  UNAGOT2  SX7    B1+1        UPDATE *WORDPT*
  2574.           SA7    WORDPT 
  2575.           MX7    -1          MARK ARGUMENTS TO UNIT 
  2576. * 
  2577.  UAGOT    ZR     X6,ERRNAME   ERROR IF ZERO NAME
  2578.           SA7    UARGS
  2579.           BX7    X1          SAVE TERMINATOR IN *LASTKEY* 
  2580.           SA7    LASTKEY
  2581.           BX1    X6          SET UP FOR -LJUST- 
  2582.           CALL   LJUST,(1R ),0
  2583.           MX0    -12
  2584.           BX0    -X0*X1      CHECK IF NAME TOO LONG 
  2585.           NZ     X0,ERRNAME 
  2586.           BX6    X1          ZERO FILLED NAME 
  2587.           SA2    UNX         X2 = L.J. X
  2588.           BX2    X6-X2
  2589.           ZR     X2,UAX 
  2590.           SA2    UNQ         X2 = L.J. Q
  2591.           BX2    X6-X2
  2592.           ZR     X2,UAQ 
  2593.           LX6    48          POSITION UNIT NAME 
  2594.           CALL   UNAMX       FIND OR ADD TO UNIT TABLE
  2595.           SA6    AUNUM       SAVE UNIT NUMBER 
  2596.           EQ     UNAM1
  2597. * 
  2598.  UAX      SX6    UNXNUM      SET FOR UNIT -X- 
  2599.           EQ     UAXQ 
  2600. * 
  2601.  UAQ      SX6    UNQNUM      SET FOR UNIT -Q- 
  2602.  UAXQ     SA6    AUNUM
  2603.           SA2    UARGS
  2604.           ZR     X2,UNAM1    JUMP IF NO ARGUMENTS 
  2605.           EQ     ERRUARG
  2606. * 
  2607. * /---   BLOCK      UNAM2      00 000   81/01/08  01.10 
  2608.           TITLE  -UNAM2-
  2609. * 
  2610. *         -UNAM2- 
  2611. *         PROCESS ARGUMENTS OF UNIT 
  2612. * 
  2613. *         RETURNS X6 = UNIT NUMBER
  2614. *                 *VARBUF(0)* = NUMBER OF ARGUMENTS 
  2615. *                 *VARBUF(N)* = -GETVAR- CODES
  2616. * 
  2617.  UNAM2    EQ     *
  2618.           MX0    0           FOR ARGS ENDING AT EOL 
  2619.           RJ     UNAM2A 
  2620.           EQ     UNAM2
  2621. * 
  2622.  UNAM2A   EQ     *
  2623.           MX6    0           INITIALIZE ARGUMENT COUNT
  2624.           SA6    VARBUF 
  2625.           SA1    UARGS       SEE IF ANY ARGUMENTS 
  2626.           ZR     X1,UN290 
  2627.           SA1    WORDPT 
  2628.           NG     X0,UNA0     IF PROCESSING (PBV;RBV)
  2629. * 
  2630.           SX1    X1-1        BACK UP ONE CHARACTER
  2631.           CALL   PSCAN       FIND END OF ARGUMENT(S)
  2632.           NZ     B2,ERRBAL    ERROR IF UNBALANCED PARENS
  2633.           NZ     B3,ERRBAL   ERROR IF UNBALANCED QUOTES 
  2634.           EQ     UNA1 
  2635. * 
  2636.  UNA00    SX1    B1+1        SKIP COMMA 
  2637.  UNA0     CALL   PSCAN
  2638.           SB2    B2+1 
  2639.           ZR     B2,UNA01    IF TERMINATED WITH ) 
  2640. * 
  2641.           SX3    X1-1R, 
  2642.           ZR     X3,UNA00     IF , DELIMITER
  2643. * 
  2644.           SX3    X1-1R; 
  2645.           NZ     X3,ERRTERM  IF BAD TERMINATOR
  2646. * 
  2647.           BX6    X1          SAVE TERMINATOR KEY
  2648.           SA6    ARGKEY 
  2649.           EQ     UN100
  2650. * 
  2651.  UNA01    SB1    B1+1 
  2652.           EQ     UNA1 
  2653. * 
  2654. * 
  2655. *         REMOVE TRAILING SPACES
  2656. * 
  2657.  UNA1     SA3    B1-1 
  2658.           SX6    X3-1R
  2659.           NZ     X6,UNA2     NOT A SPACE
  2660.           SB1    B1-1 
  2661.           EQ     UNA1        CONTINUE BACKSPACING 
  2662.  
  2663.  UNA2     BX6    X3          SAVE TERMINATOR KEY
  2664.           SA6    ARGKEY 
  2665.           SA3    X3+KEYTYPE CHECK ENDED WITH RIGHT PAREN
  2666.           SX3    X3-OP) 
  2667.           NZ     X3,ERRTERM 
  2668.           SX6    1R          REPLACE RIGHT PAREN WITH SPACE 
  2669.           SA6    B1-1 
  2670.  UN100    SX6    B1 
  2671.           SA6    ENDPNT 
  2672. * 
  2673.           CALL   GETARGS     PROCESS ARGUMENTS
  2674. * 
  2675.  UN290    SA1    AUNUM       RETURN UNIT NUMBER IN X6 
  2676.           BX6    X1 
  2677.           EQ     UNAM2A 
  2678. * 
  2679. * 
  2680.  ABEND    BSS    1
  2681.  KCOMM    DATA   0LCOMMON 
  2682.  KLESS    DATA   0LLESSON 
  2683.  UNX      DATA   1LX
  2684.  UNQ      DATA   1LQ
  2685. * /---   BLOCK      FINIS      00 000   81/07/20  21.33 
  2686.           TITLE  FINIS
  2687. * 
  2688. *         FINIS  (CODE=50)
  2689. * 
  2690. *            END OF LESSON PROCESSING 
  2691. * 
  2692. * 
  2693.  FINISC   CALL   GLOBSYM     FINISH UP GLOBAL CALC BRANCHES 
  2694.           CALL   ULONG       CHECK FOR UNIT TOO LONG
  2695.           CALL   SETARO,B0   PSEUDO -ENDARROW-
  2696. * 
  2697.           SA1    NOUNIT      SEE IF ANY UNIT FOUND
  2698.           NZ     X1,FINON8   NON-ZERO MEANS UNIT FOUND ELSE MUST
  2699.           SA1    UNUMON      CREATE A DUMMY UNIT AFTER THE IEU
  2700. *                            THIS FIX ALLOWS A LESSON WITHOUT ANY 
  2701. *                            UNITS TO APPEAR AS A ONE UNIT LESSON 
  2702. *                            AND EXECUTE. 
  2703.           SX2    X1-IEUNUM   SEE IF DOING INITIAL ENTRY UNIT
  2704.           NZ     X2,FINON5   ELSE MUST HAVE PASSED AN ENTRY COMMAND 
  2705.           SA2    ICX         GET COMMAND POINTER
  2706.           SX2    X2-1 
  2707.           SA3    INX
  2708.           IX3    X3-X2       CHECK FOR UNIT TOO LONG
  2709.           PL     X3,LNGUNIT    GIVE FATAL CONDENSE ERROR
  2710.           BX7    X2 
  2711.           SA7    A2          UPDATE FOR -IEUEND- COMMAND
  2712.           SX7    IEUEND=
  2713.           SA7    X2+INFO     ADD AN -IEUEND- COMMAND
  2714. * 
  2715.  FINON5   SA1    UNUMIN      GET LAST UNIT REFERENCED 
  2716.           SX7    X1+1        INCREMENT BY 1 
  2717.           SX2    X7-UTABLTH  ERROR TEST IF TOO MANY UNITS 
  2718.           PL     X2,=XBADIEU --- FATAL CONDENSE ERROR 
  2719. * 
  2720.           SA7    A1          UPDATE NUMBER OF UNITS 
  2721.           MX7    0           AND ZERO UNIT-LOCATION TABLE 
  2722.           SA7    ULOC+X1
  2723.           SX7    3RNOU       SET TO NO UNIT 
  2724.           LX7    30          LEFT-ADJUST UNIT NAME
  2725.           SA7    UNAME+X1    STORE IN UNIT NAME TABLE 
  2726.           SA0    A7          AND PUT INTO NON-ALPHABETIZED TABLE
  2727.           SA2    AUNAME      GET ADDRESS OF TABLE IN ECS
  2728.           IX0    X2+X1       NOW HAVE UNIT ENTRY
  2729. +         WE     1           WRITE OUT UNIT NAME
  2730.           RJ     ECSPRTY
  2731.           BX6    X1 
  2732.           SA6    UNUMON      AND SET THIS TO CURRENT UNIT 
  2733.           EQ     FINON9      FOR -UWRITE- TO PLUCK INTO UNAME TABLE 
  2734. * 
  2735. *         PUT LAST UNIT INTO ECS
  2736. * 
  2737.  FINON8   MX6    0           CLEAR TO END CHAIN IN UNIT NAME TABLE
  2738.           SA6    UNUMON 
  2739. * 
  2740.  FINON9   CALL   UWRITE 
  2741.           RETURN
  2742.           TITLE  COMPLETE PREVIOUS CPU UNIT 
  2743. * /---   BLOCK      PINIT      00 000   81/07/21  03.05 
  2744. *         COMPLETE PREVIOUS CPU UNIT
  2745. * 
  2746. *         FOLLOWING ENTERED DIRECTLY FROM OVERLAY CALL
  2747. *         JUMP TABLE AT BEGINNING OF FILE.  COMPLETES 
  2748. *         PREVIOUS CPU UNIT BEFORE BEGINNING CONDENSE OF
  2749. *         ^MTUTOR UNITS.  CALLED ON FINDING ^MTUTOR COMMAND.
  2750. * 
  2751.  PINIT    SA1    NOUNIT      CHECK IF PREVIOUS CPU UNIT 
  2752.           NZ     X1,PINIT1   IF PREVIOUS CPU UNIT PRESENT 
  2753.           SB1    152
  2754.           EQ     =XERR
  2755.  PINIT1   BSS    0
  2756.           CALL   GLOBSYM     SATISFY GLOBAL CALC BRANCHES 
  2757.           CALL   ULONG       CHECK FOR UNIT TOO LONG
  2758.           CALL   SETARO,B0   PSEUDO -ENDARROW-
  2759.           MX6    0
  2760.           SA6    UNUMON      MARK LAST CPU UNIT 
  2761.           CALL   UWRITE      WRITE UNIT TO ECS
  2762. * 
  2763. *         SETUP PPTVERS FOR LEVEL 1 MICROTUTOR - CHECK
  2764. *         CAN BE TAKEN OUT WHEN LEVEL 1 IS GONE.
  2765. * 
  2766. * 
  2767. *         SET UP PPTVERS INFO  - USED TO BE IN MTUTC
  2768. *         PPTVERS = 0 FOR PRIMITIVE 
  2769. *                   2 FOR -PPTVERS CUT22
  2770. * 
  2771.           SA1    COMMAND
  2772.           SA2    =XMTUTNAM
  2773.           BX0    X1-X2       CHECK COMMAND NAME = ^MTUTOR 
  2774.           ZR     X0,MTUTORC 
  2775.           SA1    MTREL
  2776.           SX0    X1-1        PRIMITIVE ONLY ALLOWED IN LEV 1
  2777.           NZ     X0,MTERR    IF NOT LEVEL 1 
  2778.           MX6    0
  2779.           SA6    PPTVERS     SET FOR PRIMITIVE VERSION
  2780.           EQ     =XMTLOAD 
  2781. * 
  2782. *         PRIMITIVE LEVEL IS NOT ALLOWED IN RELEASE > 1 
  2783. * 
  2784.  MTERR    SB1    123         PRIMITIVE LEVEL NOT ALLOWED
  2785.           RJ     =XRJERR
  2786.           EQ     =XMTFIN
  2787. * 
  2788.  MTUTORC  SX6    2           FORCE NON-PRIMITIVE VERSION
  2789.           SA6    PPTVERS
  2790.           EQ     =XMTLOAD 
  2791. * /---   BLOCK      ENTRY      00 000   80/02/15  22.08 
  2792.           TITLE  ENTRY
  2793. *         -ENTRY-  (CODE=67)
  2794. * 
  2795. *            USED FOR WITHIN AND BETWEEN UNIT BRANCHING.
  2796. *         THIS COMMAND FINISHES UP THE CURRENT UNIT AND STARTS A NEW
  2797. *         ONE WITH THE NAME SPECIFIED IN THE TAG.  THE -ENTRY-
  2798. *         COMMAND ITSELF FUNCTIONS LIKE A -GOTO- THAT IS LEGAL IN 
  2799. *         ALL CONTINGENCIES--THUS THE TWO UNITS BEHAVE AS ONE.
  2800. * 
  2801. *         -ENTRY- COMMAND FORMAT
  2802. *         FIRST 12 BITS = ENTRY UNIT
  2803. *         NEXT  12      = NEXT PHYSICAL UNIT
  2804. *         NEXT  36      = COMMAND NUMBER
  2805. * 
  2806. * 
  2807.  ENTRYIN  SA1    INDENT 
  2808.           NZ     X1,NOINDT   INDENTING IS NOT PERMITTED 
  2809.           CALL   GLOBSYM     FINISH UP GLOBAL CALC BRANCHES 
  2810.           CALL   ULONG       CHECK FOR UNIT TOO LONG
  2811.           CALL   SETARO,B0   PSEUDO -ENDARROW-
  2812.           CALL   UNAM1       GET UNIT NUMBER
  2813.           SX2    X6-UNXNUM   CHECK FOR ILLEGAL UNIT -X- 
  2814.           ZR     X2,UNITCF   JUMP IF ENTRY -X-
  2815.           SX2    X6-UNQNUM   CHECK FOR ILLEGAL UNIT -Q- 
  2816.           ZR     X2,UNITCF   JUMP IF ENTRY -Q-
  2817.           SA1    X6+ULOC
  2818.           PL     X1,UNITCE   ERROR IF DUPLICATE ENTRY 
  2819. * 
  2820.           RJ     =XUNITLOC   LOG ENTRY COMMAND LOCATION 
  2821.           SA1    UNUMON 
  2822.           SX2    X1-IEUNUM   SEE IF INITIAL ENTRY UNIT
  2823.           NZ     X2,ENTRY10 
  2824.           SA2    ICX         GET COMMAND POINTER
  2825.           SX2    X2-1 
  2826.           BX7    X2 
  2827.           SA7    A2          UPDATE FOR -IEUEND- COMMAND
  2828.           SX7    IEUEND=
  2829.           SA7    X2+INFO     ADD AN -IEUEND- COMMAND
  2830. * 
  2831.  ENTRY10  IX7    X6-X1       CHECK FOR UNIT ZONK CONTAINING UNIT ZONK 
  2832.           ZR     X7,UNITCE   DUPLICATE ENTRY NAME 
  2833.           SA6    A1          SET UNIT WORKING ON POINTER
  2834.           SA2    ICX         GET CURRENT COMMAND STORAGE LOC
  2835.           SX7    X2-1 
  2836.           SA7    A2          RETURN CURRENT COMMAND COUNTER 
  2837.           LX6    48          SHIFT UNIT NUMBER TO TOP 12 BITS 
  2838.           SA1    COMNUM      X1 = COMMAND NUMBER
  2839.           BX6    X6+X1
  2840.           SA6    INFO+X7     STORE -ENTRY- COMMAND
  2841. * 
  2842.           MX6    1           FLAG AS ENTRY UNIT 
  2843.           EQ     UDONE       AND GO TO FINISH UNIT
  2844. * /---   BLOCK      -INITIAL-  00 000   79/01/23  02.44 
  2845.           TITLE  -INITIAL- COMMAND
  2846. * 
  2847. * 
  2848. * 
  2849. *         INITIAL   LESSON,UNIT 
  2850. *         INITIAL   COMMON,UNIT 
  2851. * 
  2852. *         EXECUTES SPECIFIED UNIT IF LESSON OR COMMON HAS 
  2853. *         NOT BEEN INITIALIZED
  2854. * 
  2855. * 
  2856.  INITC    CALL   NXTNAM      GET FIRST ENTRY
  2857.           ZR     X6,ERRNAME 
  2858.           MX7    0           INITIALIZE TYPE
  2859.           SA1    KLESS
  2860.           BX1    X1-X6       CHECK IF *LESSON*
  2861.           ZR     X1,INITC1
  2862.           SX7    X7+1        INCREMENT TYPE 
  2863.           SA1    KCOMM
  2864.           BX1    X1-X6       CHECK IF *COMMON*
  2865.           NZ     X1,ERRNAME 
  2866. * 
  2867.  INITC1   LX7    60-12-18    POSITION TYPE CODE 
  2868.           SA7    SHOWOUT
  2869.           CALL   UNAMA       GET UNIT NUMBER TO X6
  2870.           SX0    X6-UNXNUM   CHECK FOR UNIT -X- 
  2871.           ZR     X0,ERRXORQ 
  2872.           SX0    X6-UNQNUM   CHECK FOR UNIT -Q- 
  2873.           ZR     X0,ERRXORQ 
  2874.           CALL   APACK
  2875.           LX6    48          POSITION UNIT NUMBER 
  2876.           SA1    SHOWOUT
  2877.           BX4    X1+X6       ATTACH TYPE CODE 
  2878.           SA1    COMNUM 
  2879.           BX6    X1+X4       ATTACH COMMAND NUMBER
  2880.           SA2    ICX
  2881.           SX7    X2-1        DECREMENT COMMAND INDEX
  2882.           SA7    A2 
  2883.           SA6    X7+INFO     STORE COMPLETED COMMAND WORD 
  2884.           SX1    X1+1        INCREMENT COMMAND NUMBER 
  2885.           BX6    X1+X4
  2886.           EQ     ALTCODE     STORE SECOND COMMAND 
  2887. * 
  2888. * /---   BLOCK      ROUTEC     00 000   84/01/25  12.32 
  2889.           TITLE  -ROUTE-
  2890. * 
  2891. *         -ROUTE- COMMAND 
  2892. * 
  2893. *         SPECIFIES ROUTER EXITS FOR VARIOUS EXIT CONDITIONS
  2894. * 
  2895. *         POSSIBLE EXIT TYPES -- 0 (FINISH) 
  2896. *                                1 (END LESSON) 
  2897. *                                2 (ERROR)
  2898. *                                3 (RESIGNON) 
  2899. *                                4 (CLEAR)
  2900. * 
  2901. *         RESIGNON HAS OPTIONAL SECOND ARGUMENT (UNIT), ALL 
  2902. *         OTHER TYPES REQUIRE UNIT SPECIFICATION. 
  2903. * 
  2904.  ROUTEC   BSS    0
  2905.           SA1    LESSON      NAME OF LESSON BEING CONDENSED 
  2906.           SA2    KPLATO      LESSON *PLATO* 
  2907.           SA3    KNPLATO     LESSON *NPLATO*
  2908.           BX2    X1-X2       COMPARE CURRENT WITH *PLATO* 
  2909.           BX3    X1-X3       COMPARE CURRENT WITH *NPLATO*
  2910.           ZR     X2,ROUTEC0  -- OK IF LESSON *PLATO*
  2911.           ZR     X3,ROUTEC0  -- OK IF LESSON *NPLATO* 
  2912.           SA1    ROUTER      CHECK FOR ROUTER LESSON STATUS 
  2913.           ZR     X1,ERRORC   -- NOT A ROUTER, FLAG AS ERROR 
  2914.  
  2915.  ROUTEC0  BSS    0
  2916. * 
  2917. *         GET FIRST ARGUMENT AND CHECK IT FOR VALIDITY
  2918. * 
  2919.           CALL   NXTNAME     LIT STRING IN X6, DELIM IN X2
  2920.           SA1    RLIST-1     THEN SEARCH *RLIST* FOR STRING 
  2921.  RLOOK    SA1    A1+1        READ NEXT ENTRY IN ROUTE TYPES 
  2922.           ZR     X1,ERRNAME  -- END OF TABLE, NOT FOUND 
  2923.           BX1    X1-X6       COMPARE WITH LITERAL STRING
  2924.           NZ     X1,RLOOK    -- NO MATCH, KEEP SEARCHING
  2925.           SX1    A1-RLIST    ELSE COMPUTE INDEX INTO RLIST
  2926.           BX6    X1          LEAVE -ROUTE- TYPE IN X1 
  2927.           LX6    60-6        THEN MOVE IT TO HIGH ORDER 6 
  2928.           SA6    ILOC        SAVE IT FOR MERGE INTO COMMAND 
  2929. * 
  2930. *         CHECK DELIMITER FOR SECOND ARGUMENT 
  2931. * 
  2932.           SX0    X2-EOL      CHECK FOR SINGLE ARGUMENT
  2933.           ZR     X0,ROUTEC2 
  2934.           SX0    X2-OPCOMMA  MUST END WITH COMMA OR EQUIV 
  2935.           NZ     X0,ERRTERM 
  2936. * 
  2937. *         GET UNIT ARGUMENT AND CHECK FOR SPECIAL UNITS 
  2938. * 
  2939.           MX3    0
  2940.           CALL   UNAM1       GET UNIT NUMBER
  2941.           SA2    UARGS       MAKE SURE NO ARGUMENTS 
  2942.           NZ     X2,ERRUARG 
  2943.           SX0    X6-UNXNUM   CHECK FOR UNIT -X- 
  2944.           ZR     X0,ERRXORQ  -- ERROR, -X- NOT LEGAL
  2945.           SX0    X6-UNQNUM   CHECK FOR UNIT -Q- 
  2946.           NZ     X0,ROUTEC1  -- GO AHEAD, NOT -Q- 
  2947.           MX6    0           UNIT -Q- = UNIT NUMBER 0 
  2948. * 
  2949. *         ASSEMBLE COMMAND WORD WITH TAGS 
  2950. * 
  2951.  ROUTEC1  LX6    60-6-12
  2952.           SA1    ILOC        GET TYPE CODE
  2953.           BX6    X1+X6       AND ATTACH IT
  2954.           EQ     PUTCODE     ADD COMMAND CODE AND STORE 
  2955. * /---   BLOCK      ROUTEC     00 000   84/01/25  12.30 
  2956. * 
  2957. *         PROCESS SINGLE ARGUMENT -ROUTE- 
  2958. * 
  2959.  ROUTEC2  BSS    0
  2960.           SX6    0           UNIT '7Q'7 FOR SINGLE TAG
  2961.           SX0    X1-3        CHECK FOR '7RESIGNON'7 
  2962.           ZR     X0,ROUTEC1  --- FINISH TAG IF RESIGNON 
  2963. * 
  2964.           SX0    X1-4        CHECK FOR '7CLEAR'7
  2965.           NZ     X0,ERRORC   --- MUST BE A 2-ARG WITH ONLY 1
  2966.           SA1    ROUTER      CHECK ROUTER STATUS
  2967.           NZ     X1,ERRORC   -- ERROR, (N)PLATO ONLY
  2968.           EQ     ROUTEC1     --- WRAP-UP COMMAND WORD 
  2969. * 
  2970. *         TABLE OF POSSIBLE -ROUTE- TYPES 
  2971. * 
  2972.  RLIST    DATA   6LFINISH 
  2973.           DATA   10LEND LESSON
  2974.           DATA   5LERROR
  2975.           DATA   8LRESIGNON 
  2976.           DATA   5LCLEAR
  2977.           DATA   0
  2978. * 
  2979.  KPLATO   DATA   5LPLATO
  2980.  KNPLATO  DATA   6LNPLATO 
  2981. * 
  2982.  ILOC     BSS    1           FOR SAVING ROUTE TYPE
  2983. * 
  2984. * /---   BLOCK      TIMERC     00 000   81/01/08  01.06 
  2985.           TITLE  TIMER, TIMEL 
  2986. * 
  2987. * 
  2988. *         -TIMER- 
  2989. *         SPECIFIES SECONDS AND UNIT TO RETURN TO AFTER 
  2990. *             THOSE SECONDS ARE UP. 
  2991. * 
  2992. *         -TIMEL- 
  2993. *         SPECIFIES SECONDS AND UNIT TO GOTO AFTER
  2994. *             THOSE SECONDS ARE UP. 
  2995. * 
  2996. * 
  2997.  TIMERC   SA1    ROUTER      MUST BE -ROUTER- LESSON
  2998.           ZR     X1,ERROUTR 
  2999.  TIMELC   SA1    TAGCNT      SEE IF BLANK TAG 
  3000.           ZR     X1,PAUSE2   IF BLANK, TURN OFF TIMING
  3001.           RJ     COMPILE     OTHERWISE GET CODE FOR TIME
  3002.           BX6    X1          SAVE -GETVAR- CODE 
  3003.           SA6    BRVAR
  3004.           MX3    0
  3005.           CALL   UNAM1       GET UNIT NUMBER
  3006.           SA2    UARGS       MAKE SURE NO ARGS
  3007.           NZ     X2,ERRUARG 
  3008.           SX0    X6-UNXNUM
  3009.           ZR     X0,ERRXORQ   ERROR IF UNIT -X- 
  3010.           SX0    X6-UNQNUM
  3011.           ZR     X0,ERRXORQ   ERROR IF UNIT -Q- 
  3012.           SA1    BRVAR       RETREIVE -GETVAR- CODE 
  3013.           LX6    60-XCODEL   PLACE UNIT NO IN TOP 
  3014.           LX1    60-2*XCODEL   AND GETVAR IN SECOND 
  3015.           BX6    X6+X1
  3016.           EQ     PUTCODE
  3017. * 
  3018.  BRVAR    BSS    1
  3019. * 
  3020. * /---   BLOCK      RETURN     00 000   81/01/08  01.08 
  3021. * 
  3022. *         -RETURN- COMMAND
  3023. * 
  3024. * 
  3025.  RETIN1   SA1    FLEVEL      X1 = FILE UPDATE LEVEL 
  3026.           SX1    X1-5 
  3027.           PL     X1,RETIN2   -- BRANCH IF NEW -RETURN-
  3028. * 
  3029.           SA1    =XBRKCMD      FAKE -BREAK- COMMAND 
  3030.           BX6    X1 
  3031.           SA6    COMMAND
  3032.           EQ     NXTC 
  3033. * 
  3034.  RETIN    SA1    FLEVEL      X1 = UPDATE LEVEL
  3035.           SX1    X1-4 
  3036.           NZ     X1,ERRORC   IF -NRET- NO LONGER LEGAL
  3037. * 
  3038.  RETIN2   SA2    WORDPT      X2 = ADDR OF FIRST WORD OF TAG 
  3039.           SA1    TAGCNT      NUMBER OF CHARACTERS IN TAG
  3040.           IX6    X1+X2       ADDR OF EOL
  3041.           SA6    =XENDPNT 
  3042.           MX6    0
  3043.           SA6    VARBUF 
  3044.           SA6    =XUNITFLG   FLAG NOT A UNIT TYPE ARG LIST
  3045.           ZR     X1,RETIN10  IF BLANK TAG 
  3046. * 
  3047.           CALL   GETARGS     PROCESS ARGUMENT LIST
  3048.           MX6    0           INITIALIZE X6 FOR APACK
  3049.           CALL   APACK       PACK UP THE ARGUMENTS
  3050.           LX6    61-12
  3051.           AX6    1           CLEAR TOP BIT
  3052.           EQ     PUTCODE
  3053.  RETIN10  MX6    1           NO ARGS; SET TOP BIT 
  3054.           EQ     PUTCODE
  3055. * 
  3056. *         -UNAMA1-
  3057. * 
  3058. *         GET UNIT AND ARGUMENTS FOR -DO- 
  3059. * 
  3060. *         ON EXIT RARGFLG = -1 IF RARGS ENCOUNTERED 
  3061. *                           UNCHANGED IF NOT
  3062. *                  X6 = COMMAND WORD WITHOUT COMMAND NUMBER 
  3063. * 
  3064.  UNAMAZZ  SA1    DOCWORD     RESTORE THE COMMAND WORD 
  3065.           BX6    X1 
  3066.  UNAMA1   EQ     *
  3067.           CALL   UNAM1       PROCESS UNIT NAME
  3068.           MX0    -1          SET TO LOOK FOR (;;) SYNTAX
  3069.           CALL   UNAM2A 
  3070.           CALL   APACK       PACK UP ANY ARGUMENTS
  3071.           SA6    DOCWORD     SAVE THE COMMAND WORD FOR -DO- 
  3072.           SA1    =XUARGS
  3073.           ZR     X1,UNAMAZZ  IF NO ARGUMENTS
  3074. * /---   BLOCK      RETURN     00 000   81/01/08  01.07 
  3075. * 
  3076.           SA1    =XARGKEY    CHECK FOR RETURN ARGUMENTS 
  3077.           SX2    X1-1R; 
  3078.           NZ     X2,UNAMAZZ  IF NO RETURN ARGUMENTS 
  3079. * 
  3080.           SA1    ENDPNT      CHECK FOR EOL
  3081.           SA1    X1+1 
  3082.           NZ     X1,UNAMA10  IF NOT EOL 
  3083. * 
  3084.           SA2    CONTFLG
  3085.           PL     X2,UNAMAZZ  IF NOT CONTINUED 
  3086. * 
  3087.           CALL   GETLINE     RARGS MIGHT BE ON NEXT LINE
  3088.  UNAMA10  BSS    0
  3089.           SX6    1R(         FAKE NORMAL CBV ARG LIST 
  3090.           SA6    A1-1 
  3091.           SX6    -1          INDICATE RARGS ENCOUNTERED 
  3092.           SA6    =XRARGFLG
  3093. *          SA1    WORDPT      INCREMENT WORDPT
  3094. *          IX6    X1-X6 
  3095. *          SA6    A1
  3096.           SX6    2000B       CODE FOR RETURN ARGUMENTS
  3097.           SA1    DOCWORD
  3098.           BX6    X6+X1
  3099.           SA6    A1 
  3100.           SA6    =XUNITFLG
  3101.           SA1    INX         SAVE CURRENT INX POINTER 
  3102.           SX6    X1+1        RESERVE POINTER TO RARGS 
  3103.           SA6    A1 
  3104.           BX6    X1 
  3105.           SA6    SAVINX 
  3106.           CALL   UNAM2       PROCESS REST OF ARGUMENTS
  3107.           SA1    INX         X1 = PTR TO RARGS
  3108.           SX7    X1 
  3109.           SA2    SAVINX      X2 = ADDR OF PTR TO RARGS
  3110.           SA7    X2+INFO
  3111.           CALL   APACK       PACK THE ARGS UP 
  3112.           EQ     UNAMAZZ
  3113. * 
  3114.  RARGFLG  BSS    1           FLAG RETURN ARGUMENTS FOUND
  3115.  DOCWORD  BSS    1           TEMP STO FOR DO COMMAND WORD 
  3116.  SAVINX   BSS    1           TEMP STO FOR INX BEORE RETARGS 
  3117. * 
  3118.  ISITER   BSS    1
  3119.  DTABLOC  BSS    1
  3120.  WPTSAV1  BSS    1
  3121.  WPTSAV2  BSS    1
  3122.  JOINFLG  BSS    1
  3123. * 
  3124.           ENDOV 
  3125. * /---   BLOCK      COVL4B     00 000   79/07/20  03.21 
  3126.  COV4B    OVRLAY
  3127.           SA1    OVARG1      GET ARGUMENT 
  3128.           SB1    X1 
  3129.           JP     B1+*+1 
  3130. * 
  3131. +         EQ     ARROWC      0 = -ARROW-
  3132. +         EQ     ENDAROC     1 = -ENDARROW- 
  3133. +         EQ     JARROWC     2 = -JARROW- 
  3134. +         EQ     WRITEIN     3 = -EXACT-
  3135. +         EQ     FINDC       4 = -FIND- 
  3136. +         EQ     FINDAC      5 = -FINDALL-
  3137. * 
  3138. * 
  3139. * /---   BLOCK      ARROW      00 000   79/07/20  03.12 
  3140.           TITLE  ARROW
  3141. * 
  3142. *         ARROW  (CODE=11 OR 12)
  3143. * 
  3144. *            'HOLDS (WHEN COMPLETE) ONE ARGUMENT IF COARSE
  3145. *         GRID OR TWO ARGUMENTS IF FINE GRID PLUS A 
  3146. *         POINTER TO THE NEXT ARROW OR ENDARROW COMMAND,
  3147. *         OR TO THE END OF THE UNIT IF THERE IS NEITHER.
  3148. * 
  3149. * 
  3150.  ARROWC   SA1    INDENT 
  3151.           NZ     X1,NOINDT   INDENTING IS NOT PERMITTED 
  3152.           RJ     VARDO       COMMA SEPARATED VARIABLES
  3153.           SA1    VARBUF      X1 = NUMBER OF VARIABLES 
  3154.           SX1    X1-3 
  3155.           PL     X1,ERR2MNY   --- ERROR IF MORE THAN 2 TAGS 
  3156.           CALL   SETARO,B0   PSEUDO -ENDARROW-
  3157.           SA1    ICX         CURRENT COMMAND POINTER
  3158.           SX7    X1-1        VALUE WHEN THIS COMMAND STORED 
  3159.           SA7    LOCARO      SAVE LOCATION OF THIS ARROW
  3160.           EQ     ONETWO1     --- EXIT TO STORE COMMAND
  3161. * 
  3162. * 
  3163. * 
  3164. * 
  3165. *         ENDARROW  (CODE=40) 
  3166. * 
  3167. *            'PUT PROPER POINTER VALUE IN PRECEDING ARROW 
  3168. *         COMMAND IN THIS UNIT (IF THERE IS ONE). 
  3169. * 
  3170. * 
  3171.  ENDAROC  SA1    INDENT 
  3172.           NZ     X1,NOINDT   INDENTING IS NOT PERMITTED 
  3173.           RJ     NOTAG       BE SURE THERE IS NO TAG
  3174.           CALL   SETARO,-1   REAL -ENDARROW-
  3175.           SX6    0           COMMAND NUMBER ONLY
  3176.           EQ     PUTCODE     --- EXIT TO STORE COMMAND
  3177. * 
  3178. * 
  3179. * 
  3180. *         JARROW
  3181. * 
  3182. *            'INITIATE JUDGING WITHOUT AN ARROW.
  3183. * 
  3184. * 
  3185.  JARROWC  SA1    INDENT 
  3186.           NZ     X1,NOINDT   INDENTING IS NOT PERMITTED 
  3187.           RJ     NOTAG       BE SURE THERE IS NO TAG
  3188.           CALL   SETARO,B0   PSEUDO -ENDARROW-
  3189.           SA1    ICX         CURRENT COMMAND POINTER
  3190.           SX7    X1-1        VALUE WHEN THIS COMMAND STORED 
  3191.           SA7    LOCARO      SAVE LOCATION OF THIS ARROW
  3192.           SX6    0           COMMAND NUMBER ONLY
  3193.           EQ     PUTCODE     --- EXIT TO STORE COMMAND
  3194. * /---   BLOCK      EXACT      00 000   76/07/24  20.01 
  3195.           TITLE  EXACT
  3196. *         -EXACT- 
  3197. * 
  3198. * 
  3199. *            FORMAT OF COMMAND WORD --
  3200. * 
  3201. *         UPPER 18 BITS = RELATIVE ADDRESS OF START OF INFO 
  3202. *          NEXT 18 BITS = NUMBER OF 6 BIT CODES 
  3203. * 
  3204. * 
  3205.  WRITEIN  SA1    INX         XTRA STORAGE POINTER 
  3206.           SB5    X1 
  3207.           SB1    B0          NUMBER 6 BIT CODES 
  3208.           SA2    TAG         CHECK FOR LEFT WRITING 
  3209.           SA1    A2+1        RESET FOR LOOP 
  3210.           LX2    6
  3211.           BX6    X1+X2
  3212.           SX1    X6-KUP*100B-1R0  CHECK FOR LEFT WRITING
  3213.           NZ     X1,WRT100   IF NOT LEFT
  3214.           SX6    KUP*100B+1R1 SET TO NORMAL LEFT
  3215.           LX6    -12         POSITION TO UPPER BITS 
  3216.           SB4    60-12
  3217.           SB1    2           AND 6 6 BIT CODES
  3218.           EQ     WRTLOOP
  3219. * 
  3220.  WRT100   SA1    TAG-1       PRESET FOR LOOP
  3221. * 
  3222.  WRT150   SB4    60          SHIFT COUNT
  3223.           SX6    B0 
  3224. * 
  3225.  WRTLOOP  SA1    A1+1        GET NEXT CHARACTER 
  3226.           ZR     X1,WRTDONE  JUMP IF END OF LINE
  3227. * 
  3228.           SB1    B1+1        NUMBER 6 BIT CODES 
  3229.           SB4    B4-6        SHIFT COUNT
  3230.           LX1    X1,B4
  3231.           BX6    X6-X1       ADD TO CURRENT WORD
  3232.           NZ     B4,WRTLOOP  JUMP WORD NOT DONE 
  3233.           SA6    INFO+B5     PUT IN XTRA STORAGE
  3234.           SB5    B5+1 
  3235.           JP     WRT150 
  3236. * 
  3237.  WRTDONE  SA6    INFO+B5
  3238.           SB5    B5+1 
  3239.           SA1    INX         POINTER TO XTRA
  3240.           LX1    42 
  3241.           SX2    B1          NUM 6 BIT CODES
  3242.           LX2    24 
  3243.           BX6    X1+X2
  3244.           SX7    B5          CURRENT XTRA POINTER 
  3245.           SA7    INX
  3246.           EQ     PUTCODE     GO ATTACH CODE 
  3247. * /---   BLOCK      FIND       00 000   79/07/20  04.24 
  3248.           TITLE  -FIND- 
  3249.  FINDC    RJ     VARDO
  3250.           SA1    VARBUF+2 
  3251.           NG     X1,FINDCE1  IF START NOT STOREABLE 
  3252.           SA1    VARBUF+4 
  3253.           NG     X1,FINDCE   -- ERROR IF RETURN IS NOT STOREABLE
  3254.           SA3    VARBUF      X3 = NUMBER OF VARIABLES 
  3255.           SX1    4           4 ARGS REQUIRED WITHOUT INCREMENT OR MASK
  3256.           IX2    X3-X1
  3257.           ZR     X2,VARFIN   EXIT IF EXACTLY 4
  3258.           MX2    1
  3259.           LX2    XCODEL      PREPARE SPECIAL FLAG 
  3260.           SA1    VARBUF+3 
  3261.           BX6    X1+X2
  3262.           SA6    A1 
  3263.           SX1    5           5 ARGS REQUIRED IF INCREMENT 
  3264.           IX4    X3-X1
  3265.           ZR     X4,VARFIN   EXIT IF EXACTLY 5
  3266.           SA1    VARBUF+5 
  3267.           BX6    X1+X2
  3268.           SA6    A1 
  3269.           SX1    6           7 ARGS REQUIRED IF MASK
  3270.           EQ     VARFIN 
  3271. *   -SEARCH- AND -FINDALL- ALSO COME HERE 
  3272.  FINDCE   SB1    70          NON-STOREABLE VARIABLE 
  3273.           EQ     ERR
  3274. * 
  3275.  FINDCE1  SB1    768         ILLEGAL USE OF SEGMENTS
  3276.           EQ     ERR
  3277. * 
  3278.           TITLE  -FINDALL-
  3279.  FINDAC   RJ     VARDO
  3280.           SA1    VARBUF+2 
  3281.           NG     X1,FINDCE1  IF START NOT STOREABLE 
  3282.           SA1    VARBUF+4 
  3283.           NG     X1,FINDCE   -- ERROR IF RETURN IS NOT STOREABLE
  3284.           SA3    VARBUF      X3 = NUMBER OF VARIABLES 
  3285.           SX1    5           5 ARGS REQUIRED WITHOUT INCREMENT OR MASK
  3286.           IX2    X3-X1
  3287.           ZR     X2,VARFIN   EXIT IF EXACTLY 5
  3288.           MX2    1
  3289.           LX2    XCODEL      PREPARE SPECIAL FLAG 
  3290.           SA1    VARBUF+3 
  3291.           BX6    X1+X2
  3292.           SA6    A1 
  3293.           SX1    6           6 ARGS REQUIRED IF INCREMENT 
  3294.           IX4    X3-X1
  3295.           ZR     X4,VARFIN   EXIT IF EXACTLY SIX
  3296.           SA1    VARBUF+6 
  3297.           BX6    X1+X2
  3298.           SA6    A1 
  3299.           SX1    7           SEVEN ARGS REQUIRED IF MASK
  3300.           EQ     VARFIN 
  3301. * /---   BLOCK      ENDOV      00 000   79/07/20  03.13 
  3302.  
  3303.           ENDOV 
  3304. * /---   BLOCK      END        00 000   77/04/24  20.01 
  3305. * 
  3306. * 
  3307.           OVTABLE 
  3308. * 
  3309. * 
  3310.           END    COVLY4$
plato/source/plaopl/covlay4.txt · Last modified: 2023/08/05 18:54 by Site Administrator