CDC Community

๐Ÿ”น Historical Conservation ๐Ÿ”น

User Tools

Site Tools


plato.source:plaopl:covlay3

COVLAY3

Table Of Contents

  • [00007] OVERLAYS FOR COMMAND READINS
  • [00037] PACK COMMANDS
  • [00638] -SETDAT- COMMAND
  • [00689] -SUBMITM- / -SUBMITX- COMMANDS
  • [00753] -FINDS-/-FINDSA- COMMAND READINS
  • [00942] -INSERTS- COMMAND
  • [00998] -DELETES- COMMAND
  • [01057] -INSERTS- ROUTINES
  • [01253] COVL3 COMMAND READ-INS
  • [01281] -INHIBIT- COMMAND READ-IN
  • [01375] -RANDU- COMMAND READ-IN
  • [01419] -ANSV- COMMAND READIN
  • [01479] -RESTART- COMMAND READ-IN
  • [01516] -STATS- COMMAND READ-IN
  • [01540] -EXCHANG- COMMAND READ-IN
  • [01566] -GETWORD- COMMAND READ-IN
  • [01599] -GETLOC- COMMAND READ-IN
  • [01638] -SEARCH- COMMAND READ-IN
  • [01679] -COMPUTE- COMMAND READ-IN
  • [01737] -CALCS- COMMAND READ-IN
  • [01801] -GETBARG- GET POSSIBLY BLANK ARGUMENT
  • [01841] -CTIME- COMMAND READIN
  • [01888] -COLOR- COMMAND READIN
  • [02069] -TSLINK- COMMAND READIN
  • [02398] NAMESET COMMAND READINS
  • [02593] -SETSYS- COMMAND
  • [02667] -FILENAM- COMMAND
  • [02721] -NVERS- COMMAND
  • [02758] NETWORK I/O COMMAND - NETIO
  • [02829] OTOA/HTOA
  • [02859] DREAD, DWRITE
  • [02897] DATAIOC
  • [03033] -READECS-
  • [03077] -SIZE- COMMAND.
  • [03078] SIZEC - SIZE COMMAND CONDENSE ROUTINE.
  • [03109] TEXTN COMMAND READIN
  • [03133] -TRANSFR-
  • [03252] KEYWORD COMMAND OVERLAY
  • [03574] KEYWORD PROCESSING ROUTINES

Source Code

COVLAY3.txt
  1. COVLAY3
  2. * /--- FILE TYPE = E
  3. * /--- BLOCK COVLAY3 00 000 81/07/13 01.09
  4. IDENT COVLAY3
  5. LCC OVERLAY(1,1)
  6. *
  7. TITLE OVERLAYS FOR COMMAND READINS
  8. *
  9. *
  10. CST
  11. *
  12. *
  13. COVLY3$ OVFILE
  14. *
  15. *
  16. EXT ECSPRTY
  17. EXT KEYTYPE,VARFIN,VARFINM
  18. EXT ERRORC,PUTCODE,ALTCODE,CALCODE
  19. EXT NXTNAM,SYSTEST,SYSTST1
  20. EXT LNGUNIT
  21. EXT COMCONT
  22. EXT ERRTAGS,ERRNAME,ERRSTOR
  23. EXT ERRXYTG,ERR2MNY,ERR2FEW
  24. EXT ERRTERM,ERRUARG,ERRVTYP
  25. EXT ERROUTR,ERRCNTD,ERRXORQ
  26. EXT ERRBAL,ERR
  27. EXT NXTNAMP,MRKLAST
  28. EXT VARDO,VARDO1,COMPILE,NXTNAME
  29. EXT ADDLES=
  30. EXT ONE2IN
  31. *
  32. *
  33. * /--- BLOCK PACK 00 000 77/06/12 16.40
  34. **
  35. **
  36. **
  37. TITLE PACK COMMANDS
  38. *
  39. PACKOV OVRLAY
  40. SB1 FSPACK LOG TEXT FOR PUBLICATION
  41. RJ =XPUBTEXT
  42. *
  43. * TO DO';
  44. * RETURN SCREEN LENGTH
  45. * ALLOW 5000 CHARS (MAYBE) BY PACKING IN *INFO*
  46. * MULTIPLE LINES FOR *PACK*
  47. *
  48. * PACK COMMAND WITH EMBEDS';
  49. *
  50. *
  51. * FIRST *XCODEL* BITS ARE VAR STORING INTO
  52. * SECOND *XCODEL* BITS ARE CHAR COUNT (0 IF NO)
  53. * NEXT 11 BITS LOCATION OF TABLE IN EXTRA STORAGE
  54. * NEXT *XCMNDL* BITS ARE COMMAND CODE NUMBER
  55. *
  56. * TABLE ENTRIES ARE SET UP IN ROUTINE -PACKER-
  57. *
  58. SA1 TAGCNT MAKE SURE SOME TAG
  59. ZR X1,ERR2FEW
  60. *
  61. * OVARG1 = 0 (PACK), 1 (PACKC), 2 (SAY), 3 (SAYC)
  62. SA1 OVARG1
  63. SB1 X1
  64. JP PACKOJ+B1
  65. PACKOJ EQ PACK00 PACK
  66. + EQ PACKC0 PACKC
  67. + EQ SAY00 SAY
  68. + EQ SAYC0 SAYC
  69. *
  70. SAY00 MX7 0 NO GETVAR CODES FOR -SAY-
  71. SA7 PCWORD
  72. EQ PACK0
  73. *
  74. PACK00 CALL COMPILE EVALUATE FIRST TAG
  75. NZ B1,ERRSTOR MAKE SURE ITS STORABLE
  76. LX1 60-XCODEL LEFT JUSTIFY GETVAR CODE
  77. MX7 1
  78. LX7 2*XCODEL FAKE GVAR CODE FOR SECOND ARG
  79. BX7 X1+X7 MERGE LOC GVAR + FAKE GVAR
  80. SA7 PCWORD SAVE CODES
  81. *
  82. * SEE IF TWO COMMAS NEXT TO EACH OTHER (TWO ARG COMMAND)
  83. *
  84. *
  85. SA1 WORDPT SAVE CURRENT POSITION
  86. BX6 X1
  87. SA6 OLDPT
  88. CALL NEXTKEY
  89. SA1 X2+KEYTYPE LOAD KEYTYPE FOR NEXT KEY
  90. SX3 X1-OPCOMMA
  91. ZR X3,PACK0 IF SEPARATER
  92. *
  93. *
  94. SA1 OLDPT
  95. BX6 X1 RESTORE WORDPT
  96. SA6 WORDPT
  97. *
  98. CALL PUTCOMP
  99. NG B1,ERRSTOR MAKE SURE SECOND ARG STORABLE
  100. LX1 60-2*XCODEL AND PUT IN CENTER
  101. SA2 PCWORD FETCH LOC GVAR CODE
  102. MX7 XCODEL
  103. BX7 X7*X2 INCLUDE ONLY 1ST GETVAR CODE
  104. BX7 X7+X1 MERGE THEM
  105. SA7 PCWORD AND STORE
  106. *
  107. PACK0 CALL PACKER RETURNS START OF TABLE IN B3
  108. ZR B2,ERR2FEW AND LENGTH IN B2
  109. *
  110. SA1 PCWORD
  111. SX2 B3 GET SAVED START OF TABLE
  112. LX2 XCMNDL
  113. BX6 X2+X1
  114. EQ PUTCODE AND PUT IN COMMAND CODE
  115. *
  116. *
  117. * /--- BLOCK PACKC0 00 000 77/06/19 12.56
  118. *
  119. * PACKC COMMAND'; ( MAX OF 100 CHAR STRINGS )
  120. *
  121. * COMMAND WORD';
  122. * FIRST *XCODEL* BITS'; STRING DESTINATION
  123. * NEXT *XCODEL* BITS'; CHAR CNT RETURN
  124. * NEXT 11 BITS'; START OF TAG TABLE
  125. * LAST *XCMNDL* BITS'; COMMAND NUMBER
  126. **
  127. * FIRST WORD OF TAG TABLE';
  128. * FIRST *XCODEL* BITS'; CONDITIONAL EXPRESSSION GVAR
  129. * BOTTOM 10 BITS'; NUMBER OF TAG ENTRIES
  130. *
  131. * TAG TABLE ENTRIES';
  132. * 30 BIT ENTRIES, TWO PER WORD
  133. *
  134. * BOTTOM 12 BITS'; ADDRESS OF SECONDARY TABLE
  135. * NEXT 9 BITS'; NUMBER OF ENTRIES IN SEC. TABLE
  136. *
  137. * TAG TABLE IS FORMATTED INTO BUFFER '7SHOWOUT'7 (100WDS LONG)
  138. *
  139. * (SECONDARY TABLE SET UP IN ROUTINE -PACKER-)
  140. *
  141. SAYC0 CALL COMPILE GET CONDITIONAL EXPRESSION
  142. BX6 X1
  143. SA6 PCWORD
  144. EQ PACKC4
  145. *
  146. PACKC0 CALL VARDO1 FIRST EXPRESSION
  147. CALL VARDO2 SECOND EXPRESSION
  148. *
  149. * CHECK FOR ADJACENT SEPARATORS'; NOT RETURNING CCOUNT
  150. *
  151. SA1 WORDPT SAVE CURRENT POSITION
  152. BX6 X1
  153. SA6 OLDPT
  154. CALL NEXTKEY
  155. SA1 X2+KEYTYPE LOAD KEYTYPE FOR NEXT KEY
  156. *
  157. SX3 X1-OPCOMMA
  158. ZR X3,PACKC1 IF A SEPARATOR
  159. *
  160. SX3 X1-EOL
  161. NZ X3,PACKC2 IF NOT END OF LINE
  162. *
  163. PACKC1 BX7 X2
  164. SA7 LASTKEY
  165. MX3 1
  166. LX3 XCODEL FAKE GVAR CODE FOR THIRD ARG
  167. EQ PACKC3
  168. *
  169. * RESTORE WORDPT AND PROCESS CHAR COUNT DESTINATION
  170. *
  171. PACKC2 SA1 OLDPT
  172. BX6 X1
  173. SA6 WORDPT
  174. *
  175. CALL PUTCOMP
  176. NG B1,ERRSTOR MUST STORE INTO-ABLE
  177. BX3 X1 SAVE IT
  178. *
  179. * /--- BLOCK PACKC3 00 000 77/06/12 17.11
  180. *
  181. * STORE THREE GVAR CODES IN *PCWORD* FOR NOW
  182. *
  183. PACKC3 SA1 VARBUF+1 CONDITIONAL EXPRESSION
  184. MX0 -XCODEL
  185. BX1 -X0*X1 MASK OFF TOP BIT
  186. *
  187. SA2 VARBUF+2 STRING DESTINATION
  188. NG X2,ERRSTOR CANNOT BE STORED INTO
  189. LX2 XCODEL+XCODEL PUT ON FAR LEFT SIDE
  190. *
  191. LX3 XCODEL PUT IN MIDDLE
  192. *
  193. BX6 X1+X2 NOW MERGE ALL THREE
  194. BX6 X6+X3
  195. SA6 PCWORD
  196. *
  197. * DETERMINE STRING TERMINATOR
  198. *
  199. PACKC4 SA2 LASTKEY
  200. ZR X2,PACKC5 IF TERMINATOR IS END-OF-LINE
  201. *
  202. SA1 WORDPT POINTS JUST PAST LAST CHAR
  203. SA3 X1-2 CHAR PRECEDING LASTKEY
  204. SX4 X3-ACCESS
  205. NZ X4,PACKC5 IF ACCESS NOT PART OF TERMINATR
  206. *
  207. LX3 6
  208. BX2 X2+X3 MERGE ACCESS+LAST CHAR
  209. *
  210. PACKC5 BX7 X2
  211. SA7 TERMSAV AND STORE IT
  212. *
  213. * INITIALIZATIONS BEFORE MAIN LOOP
  214. *
  215. MX6 0
  216. SA6 SHOWOUT INITIALIZE TAG TABLE COUNTER
  217. ZR X7,PLINE0 IF EOL TERMINATOR, NEXT LINE
  218. SA2 X1 GET LAST CHAR
  219. NZ X2,PLINE1 JUMP IF LINE NOT EXHAUSTED
  220. *
  221. * /--- BLOCK PACKC 00 000 76/07/25 08.46
  222. *
  223. * BRINGS IN CONTINUATION LINE IF THERE IS ONE
  224. *
  225. PLINE0 SA1 NEXTCOM CHECK IF CONTINUATION
  226. SA2 COMCONT
  227. BX2 X1-X2
  228. NZ X2,PCEND0 DONE PROCESSING IF NOT CONT.
  229. *
  230. CALL GETLINE READ IN NEXT LINE
  231. *
  232. *
  233. * MAIN LOOP. -PACKER- RETURNS'; B3=TABLE START, B2=LENGTH
  234. *
  235. *
  236. PLINE1 CALL PACKER EVALUATE NEXT CHAR STRING
  237. *
  238. SA1 SHOWOUT
  239. SX7 X1+1 INCREMENT SHOWOUT COUNTER
  240. SA7 SHOWOUT AND STORE INCREMENTED COUNTER
  241. *
  242. SX2 X1-100 LENGTH OF SHOWOUT = 100 WORDS
  243. PL X2,ERR2MNY TOO MANY TAGS
  244. *
  245. SX5 B3 START OF TABLE IN BOTTOM 12 BTS
  246. SX6 B2 LENGTH OF TABLE
  247. LX6 12
  248. BX6 X5+X6 MERGE LENGTH + INDEX
  249. SA6 X7+SHOWOUT AND STORE ENTRY
  250. *
  251. * FIND OUT WHETHER IT NEEDS NEW LINE OR NOT
  252. *
  253. SA1 WORDPT
  254. SA2 X1
  255. ZR X2,PLINE0 -PACKER- STOPPED ON EOL
  256. *
  257. SX7 X1+1 INCREMENT WORDPT
  258. SA2 X7 AND READ NEXT CHAR
  259. ZR X2,PLINE0 IF EMPTY, READ NEXT LINE
  260. SA7 WORDPT OTHERWISE, UPDATE WORDPT
  261. EQ PLINE1
  262. *
  263. *
  264. * /--- BLOCK PACKC 00 000 76/07/25 08.47
  265. *
  266. * ALL DONE'; STORE FIRST WORD OF TABLE, AND COMMAND WORD
  267. *
  268. PCEND0 SA1 PCWORD
  269. LX1 XCODEL+XCODEL GET COND. EXPR. ON TOP
  270. MX0 XCODEL
  271. BX6 X0*X1 AND PUT IT INTO X6
  272. SA2 SHOWOUT
  273. BX7 X6+X2 MERGE GVAR + NUMBER OF ENTRIES
  274. SA2 INX
  275. SA7 X2+INFO STORE AS 1ST WORD OF TABLE
  276. SX7 X2+1 INCREMENT XSTOR POINTER
  277. SA7 INX
  278. *
  279. BX1 X1-X6 REMOVE GVAR CODE FROM CMND WD.
  280. LX1 XCODEL AND RESTORE WORD
  281. LX2 XCMNDL MERGE WITH LOC OF TABLE
  282. BX6 X1+X2
  283. SA6 PCWORD AND STORE IT AGAIN
  284. *
  285. * NOW PUT TAG TABLE INTO XSTORAGE
  286. *
  287. SA1 ICX
  288. SA0 X1-1 MARKER FOR END OF UNIT
  289. SA1 SHOWOUT LOAD NUMBER OF ENTRIES
  290. ZR X1,ERR2FEW NOTHING THERE
  291. MX6 0
  292. SA6 X1+SHOWOUT+1 CLEAR LAST WORD
  293. SB4 X1-1 B4=END TEST
  294. SA2 INX
  295. SB2 X2 B2=INDEX INTO XSTORAGE
  296. SA2 SHOWOUT-1 A2=INDEX INTO SHOWOUT BUFFER
  297. *
  298. *
  299. PCEND1 SA2 A2+2
  300. LX2 30
  301. SA3 A2+1
  302. BX6 X2+X3 MERGE TWO TABLE ENTRIES
  303. SA6 B2+INFO B2 IS INDEX INTO XSTOR
  304. *
  305. SX3 A0-B2
  306. NG X3,LNGUNIT
  307. *
  308. SB2 B2+1 INCREMENT POINTER INTO SHOWOUT
  309. SB4 B4-2 DECREMENT END TEST
  310. PL B4,PCEND1 AND LOOP BACK
  311. *
  312. *
  313. SX6 B2
  314. SA6 INX UPDATE XSTOR POINTER
  315. *
  316. SA1 PCWORD
  317. BX6 X1
  318. EQ PUTCODE DONE
  319. *
  320. *
  321. * /--- BLOCK PACKER 00 000 78/11/02 11.27
  322. *
  323. * PACKER EVALUATES LAST TAG (TEXT) OR CONTINUATION LINE';
  324. * RETURNS START OF TABLE IN B3, LENGTH IN B2
  325. *
  326. *
  327. * TABLE ENTRIES'; 30 BITS APIECE';
  328. *
  329. * FOR PACK, FIRST ENTRY IS NUMBER OF ENTRIES ( NOT SO,PACKC)
  330. *
  331. *
  332. * FOR TEXT';
  333. * BOTTOM 12 BITS'; INDEX OF TEXT IN XSTORAGE
  334. * NEXT 6 BITS '; 0 ( AS FLAG THAT THIS IS TEXT )
  335. * NEXT 9 BITS '; LENGTH OF TEXT
  336. * FOR SHOWS';
  337. * BOTTOM 12 BITS'; INDEX OF GETVAR CODES IN XSTORAGE
  338. * NEXT 6 BITS '; TYPE OF SHOW (1 TO 6)
  339. * NEXT 6 BITS'; NUMBER OF GETVAR CODES IN XSTOR WORD
  340. *
  341. * GETVAR CODES IN XSTORAGE ARE THREE PER WORD
  342. * SIGN BIT ON MEANS GETVAR ENTITY CAN BE STORED INTO
  343. * NOTE ASSUMPTION THAT SHOW COMMANDS HAVE NO MORE
  344. * THAN THREE ARGUMENTS
  345. *
  346. *
  347. * OVARG1 = 0 (PACK), 1 (PACKC), 2 (SAY), 3 (SAYC)
  348. *
  349. PACKER EQ *
  350. MX6 0
  351. SA6 VARBUF INITIALIZE ^$ OF ENTRIES
  352. *
  353. PL SA1 INX INX IS BUFFER
  354. SB2 X1 B2= XSTORAGE POINTER
  355. SB3 B0 B3= WORD COUNT
  356. SA1 WORDPT
  357. SX7 X1-1 X7= WORDPT POINTER
  358. SA1 OVARG1
  359. MX0 59
  360. BX0 -X0*X1 X0=0 (PACK,SAY), =1 (PACKC, SAYC)
  361. SA1 TERMSAV X1= TERMINATOR (FOR PACKC)
  362. SA2 ICX
  363. SA0 X2-1 A0= END OF UNIT
  364. SB7 1 B7=FONT FLAG, 1=NORM,-1=ALT
  365. *
  366. * /--- BLOCK PL0 00 000 78/11/01 11.17
  367. *
  368. * NOW FOR MAIN LOOP
  369. *
  370. PL0 MX6 0 X6= WORD BUILDING VAR
  371. SB1 60 B1= SHIFT COUNTER
  372. *
  373. *
  374. PL1 SX7 X7+1 NEXT CHARACTER
  375. SA2 X7 X2=NEXT CHARACTER
  376. ZR X2,PEOL FOUND END OF LINE
  377. *
  378. *
  379. ZR X0,PL1B FOLLOWING CHECKS FOR TERMINATOR
  380. BX3 X1-X2 CHECK FOR SINGLE CHAR TERMNTR
  381. ZR X3,PEOL FOUND TERMINATOR
  382. *
  383. *
  384. PL1B SX3 X2-FONT CHECK FOR FONT
  385. NZ X3,PL1C
  386. SB7 -B7 FLIP FONT FLAG
  387. *
  388. PL1C SX3 X2-ACCESS START CHECK FOR EMBEDS
  389. NZ X3,PL2
  390. SA3 X7+1
  391. *
  392. NG B7,PL1D DO NOT CHECK FOR ^0 IN ALT.FONT
  393. *
  394. SX4 X3-1R0 LEFT EMBED SYMBOL
  395. ZR X4,PEMBED FOUND EMBED SYMBOL
  396. *
  397. PL1D ZR X0,PL2 FOR PACKC ONLY
  398. SX4 X2 COPY
  399. LX4 6 MOVE ACCESS OVER
  400. BX4 X3+X4 MERGE ACCESS + NEXT CHAR
  401. BX4 X4-X1 COMPARE WITH 2-CHAR TEMINATOR
  402. NZ X4,PL2 FOUND TERMINATOR'/
  403. SX7 X7+1 INCREMENT WORDPT
  404. EQ PEOL
  405. *
  406. *
  407. PL2 SB1 B1-6 SHIFT COUNT
  408. LX2 X2,B1 SHIFT KEY OVER
  409. BX6 X2+X6 MERGE WITH WORD BUFFER
  410. NZ B1,PL1 GET NEXT KEY IF WORD NOT DONE
  411. *
  412. SX3 A0-B2 AT END OF UNIT'/
  413. NG X3,LNGUNIT
  414. *
  415. SA6 B2+INFO STORE COMPLETED TEXT WORD
  416. SB2 B2+1 INCREMENT XSTOR POINTER
  417. SB3 B3+1 INCREMENT WORD COUNT
  418. EQ PL0 END OF MAIN LOOP
  419. *
  420. *
  421. * /--- BLOCK PEMBED 00 000 76/07/25 08.47
  422. *
  423. * HIT EMBED SYMBOL'; PROCESS WHATEVER IS INSIDE
  424. *
  425. PEMBED SX7 X7+2 UPDATE WORDPT
  426. SA7 WORDPT
  427. CALL PTEXT UPDATES CURRENT TEXT
  428. *
  429. CALL NXTNAME GET TAG OF EMBED (RETURNS X6)
  430. ZR X6,BADEMB IF NO TAG
  431. SB4 0 LOOP COUNTER
  432. MX0 42 FIRST MASK
  433. MX1 6 SECOND MASK
  434. *
  435. * FIND MATCH IN SHOW TABLE OF FIRST TAG
  436. *
  437. PE2 SA2 PACKLST+B4 READ NEXT ENTRY
  438. ZR X2,BADEMB IF NO MATCH
  439. BX3 X0*X2 MASK OFF TOP 7 CHARS
  440. BX3 X6-X3 AND COMPARE WITH NXTNAM
  441. ZR X3,PE3
  442. LX2 54 TAKE A LOOK AT BOTTOM CHAR
  443. BX2 X1*X2 MASK OFF ONE CHAR
  444. BX2 X6-X2 AND MATCH IT
  445. ZR X2,PE3
  446. SB4 B4+1
  447. EQ PE2
  448. *
  449. * /--- BLOCK PE3 00 000 78/11/02 13.49
  450. *
  451. PE3 SX6 B4+1 *SHOW* CODE FOR TABLE
  452. SA6 PSHOW
  453. SX6 0 GETVAR COUNT
  454. SA6 PCODES
  455. SA6 PTEMP GETVAR CODES
  456. SX6 60 SHIFT COUNT
  457. SA6 PSHFT
  458. *
  459. *
  460. PE4 CALL COMPILE EVALUATE NEXT TAG
  461. *
  462. SA2 LASTKEY
  463. ZR X2,ERRTERM HIT EOL INSTEAD OF R. EMBED
  464. *
  465. MX0 -XCODEL MASK
  466. BX2 -X0*X1 MASK OFF GETVAR CODE
  467. *
  468. ZR B1,PE5 WAS EXPRESSION STORABLE'/
  469. MX1 1
  470. LX1 XCODEL SET TOP BIT OF GVAR CODE
  471. BX2 X2+X1 AS A FLAG
  472. *
  473. PE5 SA1 PCODES GETVAR COUNTER
  474. SX6 X1+1 AND UPDATE IT
  475. SA6 PCODES
  476. *
  477. SA1 PSHFT SHIFT COUNTER
  478. SX6 X1-XCODEL UPDATE IT
  479. SB1 X6 AND SAVE IT IN B1
  480. NG B1,ERRTAGS MORE THAN 3 TAGS
  481. SA6 PSHFT
  482. *
  483. SA1 PTEMP CONTAINS GETVAR CODES
  484. LX6 X2,B1 SHIFT CURRENT GETVAR CODE
  485. BX6 X6+X1 AND MERGE WITH OLD GVAR CODES
  486. SA6 A1
  487. *
  488. *
  489. SA1 WORDPT CHECK IF HIT R. EMBED OR NOT
  490. SA2 X1-2 BACK UP TWO CHARS
  491. SX2 X2-ACCESS
  492. NZ X2,PE4 NEXT TO LAST SYMBOL NOT EMBED
  493. SA2 X1-1
  494. SX2 X2-1R1 CHECK FOR ACCESS 1 (RT. EMBED)
  495. NZ X2,PE4 IF CHECKS, THEN DONE
  496. *
  497. * MAKE TABLE ENTRY FOR *SHOW*
  498. *
  499. SA1 PTEMP
  500. BX6 X1
  501. SA1 INX
  502. SA6 X1+INFO ADD GETVAR CODES TO CM ARGS
  503. SX6 X1+1 INCREMENT CM ARG POINTER
  504. SA6 A1
  505. *
  506. SX6 X1 BOTTOM 12 BITS'; ADDR OF GVARS
  507. *
  508. SA1 PSHOW NEXT 6 BITS'; TYPE OF SHOW
  509. LX1 12
  510. BX6 X1+X6
  511. *
  512. SA1 PCODES NEXT 6 BITS'; NUMBR OF GVARS
  513. LX1 12+6
  514. BX6 X1+X6
  515. *
  516. SA1 VARBUF
  517. SX7 X1+1 INCREMENT NUMBER OF TABLE ENTRY
  518. SA7 VARBUF
  519. *
  520. SA6 X7+VARBUF NOW WRITE WORD TO TABLE
  521. *
  522. SX1 X7-VARBUFL+2
  523. PL X1,ERR2MNY MAKE SURE TABLE DOESNT OVERFLOW
  524. EQ PL
  525. *
  526. * /--- BLOCK PEOL 00 000 76/05/26 16.27
  527. *
  528. * REACHED END OF LINE, OR TERMINATOR (FOR PACKC)'; PUT
  529. * VARBUF TABLE INTO XSTORAGE, TWO PER WORD
  530. * EXPECTS X0= PACKC FLAG, A0 = END OF UNIT MARKER
  531. * AND B2= XSTORAGE POINTER
  532. *
  533. PEOL SA7 WORDPT UPDATE WORDPT
  534. CALL PTEXT UPDATE TEXT
  535. *
  536. SA1 VARBUF LOAD NUMBER OF ENTRIES
  537. ZR X1,PO4 NOTHING HERE
  538. MX6 0
  539. SA6 X1+VARBUF+1 CLEAR LAST WORD
  540. SB3 B2 B3= START OF TABLE
  541. SB4 X1 B4= END TEST
  542. SA2 VARBUF-2 A2= INDEX INTO VARBUF BUFFER
  543. *
  544. ZR X0,PO3 -PACK- COMMAND
  545. SA2 A2+1 DO NOT RETURN LENGTH
  546. SB4 B4-1 IN FIRST TABLE ENTRY
  547. *
  548. *
  549. PO3 SA2 A2+2
  550. LX2 30
  551. SA3 A2+1
  552. BX6 X2+X3 MERGE TWO TABLE ENTRIES
  553. *
  554. SA6 B2+INFO B2= INDEX INTO XSTORAGE
  555. *
  556. SX3 A0-B2 STILL IN UNIT'/
  557. NG X3,LNGUNIT
  558. *
  559. SB2 B2+1
  560. SB4 B4-2 DECREMENT END TEST
  561. PL B4,PO3 AND LOOP BACK
  562. *
  563. *
  564. SX6 B2 UPDATE XSTOR POINTER
  565. SA6 INX
  566. *
  567. PO4 SA1 VARBUF GET NUMBER OF ENTRIES
  568. SB2 X1
  569. EQ PACKER DONE
  570. *
  571. *
  572. * BAD FORMAT SPECIFICATION
  573. *
  574. BADEMB SB1 154
  575. EQ =XERR
  576. *
  577. *
  578. * /--- BLOCK PTEXT 00 000 78/09/12 00.28
  579. *
  580. * STORES LAST TEXT WORD, UPDATES TABLE ENTRY
  581. *
  582. * ENTERS WITH X6=LAST TEXT WD, B3=WORD CNT, B2=XSTORAGE INDX
  583. * A0= END OF UNIT MARKER, X0 = PACKC FLAG
  584. *
  585. PTEXT EQ *
  586. ZR X6,PT0 JUMP IF CURRENT WORD EMPTY
  587. *
  588. SX4 A0-B2 AT END OF UNIT'/
  589. NG X4,LNGUNIT
  590. *
  591. SA6 B2+INFO DUMP CURRENT WORD INTO XSTOR
  592. SB2 B2+1 UPDATE XSTOR COUNTER
  593. SB3 B3+1 UPDATE WORD COUNTER
  594. *
  595. PT0 ZR B3,PT1 NO TEXT HERE
  596. SA1 VARBUF UPDATE NUMBER OF TABLE ENTRIES
  597. SX6 X1+1
  598. SA6 A1
  599. *
  600. SA1 INX BEGINNING INDEX OF TEXT
  601. SX2 B3 NUMBER OF WORDS OF TEXT
  602. LX2 12+6
  603. BX7 X1+X2 MERGE INDEX AND LENGTH
  604. SA7 X6+VARBUF AND PUT INTO TABLE
  605. *
  606. SX1 X6-VARBUFL+2
  607. PL X1,ERR2MNY MAKE SURE TABLE DOESNT OVERFLOW
  608. *
  609. PT1 SX6 B2 UPDATE XSTOR POINTER
  610. SA6 INX
  611. *
  612. EQ PTEXT
  613. *
  614. *
  615. PACKLST VFD 42/0LSHOWZ,18/1RZ
  616. VFD 42/0LSHOW,18/1RS
  617. VFD 42/0LSHOWT,18/1RT
  618. VFD 42/0LSHOWO,18/1RO
  619. VFD 42/0LSHOWE,18/1RE
  620. VFD 42/0LSHOWA,18/1RA
  621. VFD 42/0LSHOWH,18/1RH
  622. VFD 42/0LHIDDEN,18/0
  623. VFD 42/0LSHOWK,18/1RK
  624. ZR DATA 0
  625. *
  626. PCWORD BSS 1 COMMAND WORD
  627. PCODES BSS 1 NUMBER OF GETVAR CODES
  628. PSHFT BSS 1 SHIFT COUNT
  629. PSHOW BSS 1 SHOW CODE
  630. PTEMP BSS 2 TEMPORARIES
  631. TERMSAV BSS 1 SAVE TERMINATOR CODE(S)
  632. *
  633. *
  634. ENDOV
  635.  
  636. * /--- BLOCK SETDAT 00 000 76/07/25 08.49
  637. *
  638. TITLE -SETDAT- COMMAND
  639. *
  640. * SET VALUE OF STUDENT DATA RESERVED WORD
  641. * SETDAT WORD_EXPRESSION
  642. *
  643. SETROV OVRLAY
  644. CALL NXTNAME GET TAG ****
  645. * RETURNS TAG ENTRY IN X6,
  646. * SEPARATOR IN X1, SEPARATOR TYPE IN X2
  647. SX1 X1-KASSIGN CHECK FOR ASSIGN ARROW
  648. NZ X1,ERRTERM IF NOT GIVE CONDENSE ERROR
  649. MX0 6*7
  650. BX2 -X0*X6 CHECK FOR OVER 7 CHARS
  651. NZ X2,ERRNAME
  652. SA6 ENDLST PLANT END TEST FOR SEARCH
  653. SA2 RSVLST-1 INITIALIZE SEARCH
  654. RSV100 SA2 A2+1
  655. IX3 X6-X2
  656. NZ X3,RSV100
  657. SB1 A2-ENDLST
  658. ZR B1,ERRNAME NOT FOUND IN LIST
  659. SB1 A2-RSVLST COMPUTE INDEX IN LIST
  660. SX7 B1 STORE INDEX IN LIST
  661. SA7 SRTEMP
  662. CALL COMPILE GET VALUE OF NEXT ARGUMENT
  663. MX0 -XCODEL
  664. BX6 -X0*X1 ONLY GETVAR CODE
  665. LX6 60-2*XCODEL
  666. SA1 SRTEMP PICK UP WORD NUMBER
  667. SX1 X1 LIMIT TO 18 BITS
  668. LX1 60-XCODEL PUT IN TOP BITS
  669. BX6 X6+X1 COMBINE WITH GETVAR CODE
  670. EQ PUTCODE
  671. *
  672. RSVLST DATA 7LAARROWS
  673. DATA 3LAOK
  674. DATA 6LAOKIST
  675. DATA 4LASNO
  676. DATA 4LAUNO
  677. DATA 5LAHELP
  678. DATA 6LAHELPN
  679. DATA 5LATERM
  680. DATA 6LATERMN
  681. DATA 5LAAREA
  682. DATA 5LATIME
  683. ENDLST BSS 1
  684. *
  685. SRTEMP BSS 1
  686. *
  687. ENDOV
  688. * /--- BLOCK SUBMITM 00 000 80/12/15 22.22
  689. TITLE -SUBMITM- / -SUBMITX- COMMANDS
  690. *
  691. *
  692. *
  693. * -SUBMITM- COMMAND
  694. * 1ST ARGUMENT = MAIN-FRAME NUMBER
  695. * 2ND = ACCOUNT NAME
  696. * 3RD = FILE NAME
  697. * 4TH = BLOCK NAME
  698. * 5TH (OPT) = SECURITY INFORMATION BUFFER
  699. *
  700. * -SUBMITX- COMMAND
  701. * 1ST ARGUMENT = MAIN-FRAME NUMBER
  702. * 2ND = CONTROL CARD BUFFER
  703. * 3RD = LENGTH OF CONTROL CARD BUFFER
  704. * 4TH = (UNUSED)
  705. * 5TH (OPT) = SECURITY INFORMATION BUFFER
  706. *
  707. *
  708. SUBMOV OVRLAY
  709. CALL VARDO1 GET MAINFRAME ARGUMENT
  710. SX6 0 PRE-ZERO 4TH AND 5TH ARGUMENTS
  711. SA6 VARBUF+4
  712. SA6 VARBUF+5
  713. SA1 OVARG1
  714. NZ X1,SUBMITX --- JUMP IF SUBMITX
  715. *
  716. * -SUBMITM- COMMAND
  717. *
  718. CALL ACCFILE,VARBUF+2,0
  719. ZR X1,ERR2FEW
  720. CALL COMPNAM GET BLOCK NAME
  721. BX6 X1
  722. SA6 VARBUF+4
  723. EQ SECURE
  724. *
  725. * -SUBMITX- COMMAND
  726. *
  727. SUBMITX CALL VARDO2 CONTROL CARD BUFFER
  728. NG X6,ERRSTOR --- ERROR IF NOT STOREABLE
  729. CALL VARDO2 BUFFER LENGTH
  730. *
  731. *
  732. * CHECK FOR SECURITY INFORMATION BUFFER ARGUMENT
  733. *
  734. SECURE SX6 4 4 ARGUMENTS SO FAR
  735. SA6 VARBUF
  736. SA1 LASTKEY
  737. ZR X1,SBMEND --- IF END OF LINE
  738. CALL VARDO2
  739. NG X6,ERRSTOR --- ERROR IF NOT STOREABLE
  740. SA1 LASTKEY
  741. NZ X1,ERR2MNY
  742. *
  743. SBMEND SX6 5 5 ARGUMENTS
  744. SA6 VARBUF
  745. BX1 X6
  746. EQ VARFIN
  747. ENDOV
  748. *
  749. *
  750. * /--- BLOCK FINDS 00 000 76/08/29 21.54
  751. *
  752. *
  753. TITLE -FINDS-/-FINDSA- COMMAND READINS
  754. *
  755. * -FINDS-
  756. *
  757. * READIN IS MODIFIED FROM -SORT- COMMAND READIN
  758. *
  759. * COMMAND WORD CONSISTS OF';
  760. * 6 BITS TYPE'; 0 N,NC VAR
  761. * 1 ECS COMMON VAR
  762. * 2 ECS STORAGE VAR
  763. * *XCODEL* BITS LIST GETVAR CODE'; ADDRESS IN CM/ECS
  764. * 12 BITS POSITION OF EXTRA GETVAR CODES IN XSTORAGE
  765. *
  766. * 3 WORDS OF EXTRA STORAGE GVAR CODES';
  767. * OBJECT,LENGTH,INCREMENT,1STBIT,NUMBITS,RETURN,MASK
  768. *
  769. *
  770. * FINDS OBJECT,LIST;LTH,INC,1ST BIT,NUM BITS,RETURN,MASK
  771. * FINDSA OBJECT,LIST;LTH,INC,1ST CHAR,NUM CHARS,RETURN,MASK
  772. *
  773. * NOTE THAT ONLY THE LAST ARGUMENT, *MASK*, IS OPTIONAL
  774. *
  775. * NOTE ALSO THAT TOP BIT OF OBJECT GETVAR CODE IS SET IF
  776. * IT IS NON-STORABLE
  777. *
  778. *
  779. FINDSOV OVRLAY
  780. *
  781. CALL VARDO1 EVALUATE OBJECT GVAR CODE
  782. *
  783. SA1 WORDPT SAVE *WORDPT*
  784. BX6 X1
  785. SA6 OLDPT
  786. *
  787. MX6 0
  788. SA6 VARBUF+7 INITIALIZE MASK ENTRY
  789. *
  790. * EVALUATE LIST TYPE / LOCATION
  791. *
  792. CALL NXTNAM GET FIRST ENTRY
  793. SX0 X1-1R,
  794. NZ X0,FIND150 JUMP IF MAY BE CM BUFFER
  795. MX0 42
  796. SA1 FINDLST-1 SET UP FOR BUFFER TYPE SEARCH
  797. *
  798. FIND110 SA1 A1+1 LOAD NEXT LIST ENTRY
  799. ZR X1,FIND150 CHECK IF CM BUFFER
  800. BX2 X0*X1 MASK OFF BUFFER TYPE NAME
  801. IX2 X2-X6 COMPARE WITH NXTNAM RETURN
  802. NZ X2,FIND110 LOOP BACK
  803. *
  804. * PROCESS HERE IF FORM -FINDS S,3;- OR -FINDS C,10;-
  805. *
  806. SX6 X1 PICK UP BUFFER TYPE NAME
  807. LX6 60-6 AND LEFT-JUST IT
  808. SA6 FINDWK
  809. *
  810. CALL COMPILE EVALUATE POSITION EXPRESSION
  811. LX1 60-6-XCODEL POSITION GVAR CODE
  812. *
  813. SA2 FINDWK
  814. BX6 X1+X2 MERGE TYPE/POSITION
  815. SA6 A2 STORE IT
  816. *
  817. SA1 LASTKEY MUST END WITH SEMI-COLON
  818. SX0 X1-KSEMIC
  819. ZR X0,FIND200
  820. EQ ERRTERM SEMICOLON NOT FOUND
  821. * /--- BLOCK FINDS 00 000 76/09/12 21.14
  822. *
  823. * PROCESS HERE IF OF FORM -FINDS N1;- OR -FINDS NC1;-
  824. *
  825. FIND150 SA1 OLDPT RESTORE WORDPT
  826. BX6 X1
  827. SA6 WORDPT
  828. *
  829. CALL COMPILE EVALUATE BUFFER EXPRESSION
  830. NZ B1,ERRSTOR ERROR IF NOT STORABLE
  831. LX1 60-6-XCODEL POSITION GVAR CODE
  832. *
  833. BX6 X1
  834. SA6 FINDWK AND STORE IT
  835. *
  836. SA1 LASTKEY MUST END WITH SEMI-COLON
  837. SX0 X1-KSEMIC
  838. NZ X0,ERRTERM SEMI-COLON NOT FOUND
  839. *
  840. *
  841. * PROCESS REMAINING ARGUMENTS
  842. *
  843. FIND200 CALL VARDO2 LENGTH
  844. CALL VARDO2 INCREMENT
  845. CALL VARDO2 1ST BIT
  846. CALL VARDO2 NUM BITS
  847. *
  848. CALL PUTCOMP *RETURN*
  849. NG B1,ERRSTOR MUST BE STORABLE
  850. BX6 X1 STORE CODE IN VARBUF
  851. SA6 VARBUF+6
  852. SX6 6 INCREMENT VARBUF
  853. SA6 VARBUF
  854. *
  855. SA1 LASTKEY SEE IF ANOTHER ARGMUENT
  856. ZR X1,FIND210 NO MORE ARGUMENTS
  857. CALL VARDO2 GET MASK GETVAR CODE
  858. *
  859. SA1 VARBUF+7
  860. MX0 -XCODEL
  861. BX1 -X0*X1 GIVE ERROR IF MASK IS ZERO
  862. ZR X1,ERRORC
  863. *
  864. SA1 LASTKEY
  865. NZ X1,ERR2MNY TOO MANY TAGS
  866. *
  867. FIND210 SA1 VARBUF+1 FETCH OBJECT GVAR CODE
  868. MX0 1 SET TOP BIT IF NOT STORABLE
  869. BX2 X0*X1 GET TOP BIT
  870. LX2 XCODEL
  871. BX6 X1+X2 AND MERGE WITH GVAR CODE
  872. SA6 VARBUF+1
  873. *
  874. * /--- BLOCK FINDS 00 000 76/09/12 21.09
  875. *
  876. * NOW STORE ALL GVAR CODES AND WRAP IT UP
  877. *
  878. SA1 INX GET INDEX IN EXTRA STORAGE
  879. BX6 X1 X1 = INX
  880. LX6 60-6-XCODEL-12 POSITION XSTOR INDEX
  881. SA2 FINDWK
  882. BX6 X2+X6 X6 = COMMAND WORD
  883. MX0 -XCODEL X0 = XCODEL MASK
  884. *
  885. SA2 VARBUF+1 OBJECT GVAR CODE
  886. SA3 VARBUF+2 LENGTH GVAR CODE
  887. SA4 VARBUF+3 INCREMENT GVAR CODE
  888. *
  889. BX2 -X0*X2 MASK OFF
  890. BX3 -X0*X3
  891. BX4 -X0*X4
  892. *
  893. LX2 60-1*XCODEL AND POSITION THEM
  894. LX3 60-2*XCODEL
  895. LX4 60-3*XCODEL
  896. *
  897. BX7 X2+X3 NOW MERGE AND STORE
  898. BX7 X7+X4
  899. SA7 X1+INFO STORE
  900. *
  901. SA2 VARBUF+4 1ST BIT GVAR CODE (1ST CHAR)
  902. SA3 VARBUF+5 NUM BITS GVAR CODE (NUM CHARS)
  903. SA4 VARBUF+6 *RETURN* GVAR CODE
  904. *
  905. BX2 -X0*X2 MASK
  906. BX3 -X0*X3
  907. BX4 -X0*X4
  908. *
  909. LX2 60-1*XCODEL POSITION
  910. LX3 60-2*XCODEL
  911. LX4 60-3*XCODEL
  912. *
  913. BX7 X2+X3 MERGE AND STORE
  914. BX7 X7+X4
  915. SA7 X1+INFO+1
  916. *
  917. SA2 VARBUF+7 FIND MASK GVAR CODE
  918. BX7 -X0*X2 MASK MASK CODE (HEHE)
  919. LX7 60-XCODEL POSITION IT
  920. SA7 X1+INFO+2 STORE
  921. *
  922. SX7 X1+3 INCREMENT INX POINTER
  923. SA7 INX
  924. SA1 ICX
  925. IX1 X7-X1 CHECK FOR UNIT BUFFER OVERFLOW
  926. PL X1,LNGUNIT
  927. EQ PUTCODE EXIT
  928. *
  929. * FINDLST IS USED BY FINDS,FINDSA,INSERTS,DELETES
  930. *
  931. FINDLST VFD 42/0LSTORAGE,18/2
  932. VFD 42/0LS,18/2
  933. VFD 42/0LCOMMON,18/1
  934. VFD 42/0LC,18/1
  935. DATA 0
  936. *
  937. FINDWK BSS 1
  938. *
  939. ENDOV
  940. * /--- BLOCK INSERTS 00 000 77/01/11 17.12
  941. *
  942. TITLE -INSERTS- COMMAND
  943. *
  944. * READIN IS MODIFIED FROM -SORT- COMMAND READIN
  945. *
  946. *INSERTS BUFFER,LIST;LENGTH,INCREMENT,POSIT,NUMBER (OPT.)
  947. * BUFF2,LIST2;INC2
  948. *
  949. * COMMAND WD'; 6 BITS LIST TYPE CODE
  950. * 20 BITS LIST GVAR CODE
  951. * 12 BITS XSTOR POSIT OF GVAR CDS
  952. * 6 BITS ASSOC. LIST TYPE CODE
  953. *
  954. * TYPE CODE IS 0=CM,1=ECS COMMON,2=ECS STORAGE
  955. * ASSOCIATED LIST TYPE CODE IS SAME AS ABOVE, EXCEPT TOP
  956. * BIT OF 6 BIT CODE IS SET AS FLAG THAT THERE IS ASSOC. LIST
  957. *
  958. *XSTOR GETVAR WORDS (3)
  959. *
  960. * WD1'; BUFFER,LENGTH,INCREMENT
  961. * WD2'; POSIT,NUMBER,BUFFER2
  962. * WD3'; LIST2,INCREMENT2
  963. *
  964. *
  965. INSRTOV OVRLAY
  966. *
  967. SA1 OVARG1
  968. NZ X1,DELETOV FOR -DELETES- COMMAND
  969. *
  970. CALL VARDO1 EVALUATE OBJECT GVAR CODE
  971. SA1 VARBUF+1
  972. NG X1,ERRSTOR BUFFER MUST BE LOCATION
  973. CALL SLINE1 EVALUATE REST OF LINE
  974. *
  975. *
  976. SA1 NEXTCOM
  977. SA2 COMCONT SEE IF CONTINUED
  978. BX2 X1-X2
  979. NZ X2,INSRT10 NOT CONTINUED
  980. *
  981. CALL GETLINE GET NEXT LINE OF TEXT
  982. SA1 NEXTCOM
  983. SA2 COMCONT SEE IF CONTINUED
  984. BX2 X1-X2
  985. ZR X2,ERRCNTD ERROR IF CONTINUED FURTHER
  986. *
  987. *
  988. CALL VARDO2 EVALUATE ASSOC. LIST OBJECT
  989. SA1 VARBUF
  990. SA1 X1+VARBUF
  991. NG X1,ERRSTOR BUFFER MUST BE LOCATION
  992. CALL SLINE2 EVALUATE REST OF ASSOC. LIST
  993. *
  994. INSRT10 EQ LSTFIN STORE GVAR CODES AND WRAP UP
  995. *
  996. * /--- BLOCK DELETES 00 000 77/01/11 17.15
  997. *
  998. TITLE -DELETES- COMMAND
  999. *
  1000. * READIN IS MODIFIED FROM -SORT- COMMAND READIN
  1001. *
  1002. *DELETES LIST;LENGTH,INCREMENT,POSIT,NUMBER (OPT.)
  1003. * LIST2;INC2
  1004. *
  1005. * COMMAND WD'; 6 BITS LIST TYPE CODE
  1006. * 20 BITS LIST GVAR CODE
  1007. * 12 BITS XSTOR POSIT OF GVAR CDS
  1008. * 3 BITS 0
  1009. * 6 BITS ASSOC. LIST TYPE CODE
  1010. * 9 BITS COMMAND NUMBER
  1011. *
  1012. * TYPE CODE IS 0=CM,1=ECS COMMON,2=ECS STORAGE
  1013. * ASSOCIATED LIST TYPE CODE IS SAME AS ABOVE, EXCEPT TOP
  1014. * BIT OF 6 BIT CODE IS SET AS FLAG THAT THERE IS ASSOC. LIST
  1015. *
  1016. *XSTOR GETVAR WORDS (3)
  1017. *
  1018. * WD1'; 0,LENGTH,INCREMENT
  1019. * WD2'; POSIT,NUMBER,0
  1020. * WD3'; LIST2,INCREMENT2
  1021. *
  1022. * THE 0 GETVAR CODES ARE SO FORMAT IS EXACTLY LIKE THE
  1023. * -INSERTS- COMMAND
  1024. *
  1025. *
  1026. *
  1027. DELETOV SX6 1
  1028. SA6 VARBUF INCREMENT VARBUF CAUSE NO BUFF
  1029. MX6 0
  1030. SA6 A6+1 ZERO BUFFER GVAR CODE
  1031. CALL SLINE1 EVALUATE FIRST LINE
  1032. *
  1033. *
  1034. SA1 NEXTCOM
  1035. SA2 COMCONT SEE IF CONTINUED
  1036. BX2 X1-X2
  1037. NZ X2,DELET10 NOT CONTINUED
  1038. *
  1039. CALL GETLINE GET NEXT LINE OF TEXT
  1040. SA1 NEXTCOM
  1041. SA2 COMCONT SEE IF CONTINUED
  1042. BX2 X1-X2
  1043. ZR X2,ERRCNTD ERROR IF CONTINUED FURTHER
  1044. *
  1045. *
  1046. SA1 VARBUF
  1047. SX6 X1+1 INCREMENT VARBUF (NO BUFF2)
  1048. SA6 VARBUF
  1049. MX7 0
  1050. SB1 A6
  1051. SA7 X6+B1 STORE ZERO AS GVAR CODE
  1052. CALL SLINE2 EVALUATE REST OF ASSOC. LIST
  1053. *
  1054. DELET10 EQ LSTFIN STORE XSTOR GVARS AND WRAP UP
  1055. *
  1056. * /--- BLOCK INSERTS-1 00 000 77/03/30 22.24
  1057. TITLE -INSERTS- ROUTINES
  1058. *
  1059. * PROCESS FIRST LINE OF INSERTS AND DELETES COMMANDS
  1060. *
  1061. SLINE1 EQ *
  1062. *
  1063. SA1 WORDPT
  1064. BX6 X1
  1065. SA6 OLDPT SAVE WORDPT
  1066. *
  1067. CALL NXTNAM GET FIRST ENTRY
  1068. SX0 X1-1R,
  1069. NZ X0,SLIN150 JUMP IF MAY BE CM BUFFER
  1070. MX0 42
  1071. SA1 INSTLST-1 SET UP FOR BUFFER TYPE SEARCH
  1072. *
  1073. SLIN110 SA1 A1+1 LOAD NEXT ENTRY
  1074. ZR X1,SLIN150 CHECK IF CM BUFFER
  1075. BX2 X0*X1 MASK OFF BUFFER TYPE NAME
  1076. IX2 X2-X6
  1077. NZ X2,SLIN110
  1078. *
  1079. SX6 X1 PICK UP BUFFER TYPE CODE
  1080. LX6 60-6
  1081. SA6 CMNDWD STORE FOR NOW
  1082. CALL COMPILE EVALUATE POSITION EXPRESSION
  1083. LX1 60-6-XCODEL POSITION GVAR CODE
  1084. SA2 CMNDWD
  1085. BX6 X1+X2 MERGE TYPE/POSITION
  1086. SA6 A2
  1087. SA1 LASTKEY MUST END WITH SEMICOLON
  1088. SX0 X1-KSEMIC
  1089. ZR X0,SLIN200
  1090. EQ ERRTERM
  1091. *
  1092. *
  1093. SLIN150 SA1 OLDPT RESTORE WORDPT
  1094. BX6 X1
  1095. SA6 WORDPT
  1096. CALL COMPILE EVALUATE BUFFER EXPRESSION
  1097. NZ B1,ERRSTOR ERROR IF NOT STORABLE
  1098. BX6 X1
  1099. LX6 60-6-XCODEL POSITION GVAR CODE
  1100. SA6 CMNDWD SAVE
  1101. SA1 LASTKEY MUST END WITH A SEMI-COLON
  1102. SX0 X1-KSEMIC
  1103. NZ X0,ERRTERM
  1104. *
  1105. * PROCESS REMAINING ARGUMENTS
  1106. *
  1107. SLIN200 CALL VARDO2 LENGTH OF LIST
  1108. CALL VARDO2 INCREMENT OF EACH ENTRY
  1109. CALL VARDO2 POSITION TO ADD
  1110. SA1 LASTKEY
  1111. NZ X1,SLIN201 GET LAST ARGUMENT
  1112. *
  1113. SA1 VARBUF
  1114. SX6 X1+1 INCREMENT VARBUF (NO NUMBER)
  1115. SA6 VARBUF
  1116. SX7 1 DEFAULT OF 1 ITEM TO INSERT
  1117. SB1 A6
  1118. SA7 X6+B1 STORE ZERO FOR NUMBER
  1119. EQ SLINE1 DONE
  1120. *
  1121. *
  1122. SLIN201 CALL VARDO2 GET NUMBER GVAR CODE
  1123. SA1 LASTKEY
  1124. NZ X1,ERR2MNY TOO MANY TAGS
  1125. EQ SLINE1
  1126. *
  1127. *
  1128. * /--- BLOCK INSERTS-2 00 000 76/09/13 13.45
  1129. *
  1130. * PROCESS THE SECOND LINE FOR INSERTS AND DELETES
  1131. *
  1132. SLINE2 EQ *
  1133. *
  1134. SA1 WORDPT SAVE WORDPT
  1135. BX6 X1
  1136. SA6 OLDPT
  1137. *
  1138. CALL NXTNAM GET FIRST ENTRY
  1139. SX0 X1-1R,
  1140. NZ X0,SLIN250 JUMP IF MAY BE CM BUFFER
  1141. MX0 42
  1142. SA1 INSTLST-1 SET UP FOR BUFFER TYPE SEARCH
  1143. *
  1144. SLIN220 SA1 A1+1 LOAD NEXT LIST ENTRY
  1145. ZR X1,SLIN250 CHECK IF CM BUFFER
  1146. BX2 X0*X1 MASK OFF BUFFER TYPE NAME
  1147. IX2 X2-X6
  1148. NZ X2,SLIN220
  1149. *
  1150. SX6 X1+40B PICK UP BUFFER TYPE CODE
  1151. LX6 XCMNDL
  1152. SA1 CMNDWD PICK UP COMMAND WORD
  1153. BX6 X1+X6 MERGE
  1154. SA6 CMNDWD AND STORE
  1155. CALL VARDO2 EVALUATE LOCATION ARGUMENT
  1156. EQ SLIN260
  1157. *
  1158. *
  1159. SLIN250 SA1 OLDPT RESTORE WORDPT
  1160. BX6 X1
  1161. SA6 WORDPT
  1162. *
  1163. SX6 40B SET BUFFER TYPE CODE
  1164. LX6 XCMNDL MOVE OVER
  1165. SA1 CMNDWD PICK UP COMMAND WORD
  1166. BX6 X1+X6 MERGE
  1167. SA6 CMNDWD AND STORE
  1168. *
  1169. CALL VARDO2 EVALUATE BUFFER EXPRESSION
  1170. SA1 VARBUF
  1171. SA1 X1+VARBUF LOAD BUFFER GETVAR CODE
  1172. NG X1,ERRSTOR MUST BE STOREABLE
  1173. *
  1174. SLIN260 SA1 LASTKEY MUST END IWTH A SEMICOLON
  1175. SX0 X1-KSEMIC
  1176. NZ X0,ERRTERM
  1177. *
  1178. * EVALUATE ENTRY DIMENSION EXPRESSION
  1179. *
  1180. CALL VARDO2 EVALUATE DIMENSION EXPRESSION
  1181. SA1 LASTKEY
  1182. NZ X1,ERRTERM ERROR IF NOT END OF LINE
  1183. EQ SLINE2
  1184. *
  1185. *
  1186. *
  1187. * /--- BLOCK INSERTS-3 00 000 77/01/11 17.22
  1188. *
  1189. * FINAL PROCESSING FOR INSERTS AND DELETES COMMANDS
  1190. *
  1191. LSTFIN SA1 INX GET INDEX IN EXTRA STORAGE
  1192. BX6 X1
  1193. LX6 60-6-XCODEL-12 POSITION XSTOR INDEX
  1194. SA2 CMNDWD
  1195. BX6 X2+X6 X6 = PARTIAL COMMAND WORD
  1196. *
  1197. * PACK UP REMAINING GETVAR CODES
  1198. *
  1199. MX0 -XCODEL
  1200. *
  1201. SA2 VARBUF+1 LOAD BUFFER -GETVAR- CODE
  1202. SA3 VARBUF+2 LOAD LENGTH -GETVAR- CODE
  1203. SA4 VARBUF+3 LOAD INCREMENT -GETVAR- CODE
  1204. BX2 -X0*X2
  1205. BX3 -X0*X3
  1206. BX4 -X0*X4
  1207. LX2 60-XCODEL POSITION -GETVAR- CODES
  1208. LX3 60-2*XCODEL
  1209. LX4 60-3*XCODEL
  1210. BX7 X2+X3 COMBINE -GETVAR- CODES
  1211. BX7 X4+X7
  1212. SA7 X1+INFO STORE 1ST XSTOR WORD
  1213. *
  1214. SA2 VARBUF+4 LOAD POSITION -GETVAR- CODE
  1215. SA3 VARBUF+5 LOAD NUMBER -GETVAR- CODE
  1216. SA4 VARBUF+6 LOAD ASSOC BUFF -GETVAR- CODE
  1217. BX2 -X0*X2
  1218. BX3 -X0*X3
  1219. BX4 -X0*X4
  1220. LX2 60-XCODEL POSITION -GETVAR- CODES
  1221. LX3 60-2*XCODEL
  1222. LX4 60-3*XCODEL
  1223. BX7 X2+X3 COMBINE -GETVAR- CODES
  1224. BX7 X4+X7
  1225. SA7 X1+INFO+1 STORE 2ND XSTOR WORD
  1226. *
  1227. SA2 VARBUF+7 LOAD ASSOC LST -GETVAR- CODE
  1228. SA3 VARBUF+8 LOAD ASSOC INCREMNT GETVAR CODE
  1229. BX2 -X0*X2
  1230. BX3 -X0*X3
  1231. LX2 60-XCODEL POSITION -GETVAR- CODE
  1232. LX3 60-2*XCODEL
  1233. BX7 X2+X3
  1234. SA7 X1+INFO+2 AND STORE IT
  1235. *
  1236. SX7 X1+3
  1237. SA7 INX INCREMENT *INX*
  1238. SA1 ICX
  1239. IX1 X7-X1 CHECK FOR UNIT BUFFER OVERFLOW
  1240. PL X1,LNGUNIT
  1241. EQ PUTCODE EXIT
  1242. *
  1243. INSTLST VFD 42/0LSTORAGE,18/2
  1244. VFD 42/0LS,18/2
  1245. VFD 42/0LCOMMON,18/1
  1246. VFD 42/0LC,18/1
  1247. DATA 0
  1248. *
  1249. CMNDWD BSS 1 PARTIAL COMMAND WORD
  1250. *
  1251. ENDOV
  1252. * /--- BLOCK COVL3 00 000 80/10/01 03.12
  1253. TITLE COVL3 COMMAND READ-INS
  1254. *
  1255. *
  1256. *
  1257. COVL3 OVRLAY
  1258. SA1 OVARG1 GET OVERLAY ARGUMENT
  1259. SB1 X1
  1260. JP B1+*+1 JUMP TO APPROPRIATE COMMAND
  1261. *
  1262. + EQ INHIBC 0 = -INHIBIT- COMMAND
  1263. + EQ FORCEIN 1 = -FORCE- COMMAND
  1264. + EQ RANDUIN 2 = -RANDU- COMMAND
  1265. + EQ RANDPIN 3 = -RANDP- COMMAND
  1266. + EQ ANSVC 4 = -ANSV- COMMAND
  1267. + EQ RESTIN 5 = -RESTART- COMMAND
  1268. + EQ EXCHIN 6 = -EXCHANG- COMMAND
  1269. + EQ STATSIN 7 = -STATS- COMMAND
  1270. + EQ GETWDC 8 = -GETWORD- COMMAND
  1271. + EQ GETLOCC 9 = -GETLOC- COMMAND
  1272. + EQ SEARCHC 10 = -SEARCH- COMMAND
  1273. + EQ COMPUIN 11 = -COMPUTE- COMMAND
  1274. + EQ CALCSIN 12 = -CALCS- COMMAND
  1275. + EQ CSLOOP 13 = *CSLOOP* ROUTINE
  1276. + EQ COLORIN 14 = -COLOR- COMMAND
  1277. + EQ CTIMEIN 15 = -CTIME-, -CDATE- COMMANDS
  1278. *
  1279. *
  1280. * /--- BLOCK -INHIBIT- 00 000 79/01/05 01.47
  1281. TITLE -INHIBIT- COMMAND READ-IN
  1282. *
  1283. *
  1284. *
  1285. * -INHIBIT- COMMAND READ-IN
  1286. *
  1287. INHIBC SB1 HIBLIST SET UP ARGUMENTS
  1288. SB2 HIBEND
  1289. MX5 60 FULL WORD MASK
  1290. CALL SCANNER SCAN INHIBIT NAME LIST
  1291. NZ X0,ERRNAME SEE IF ANY ERROR
  1292.  
  1293. * CHECK FOR SYSTEM-LESSON-ONLY KEYWORDS.
  1294.  
  1295. SA1 SYSHIBS
  1296. BX1 X1*X6
  1297. ZR X1,PUTCODE IF NO SYSTEM-LESSON-ONLY BITS
  1298.  
  1299. * SYSTEM-LESSON-ONLY KEYWORDS SELECTED - MAKE SURE
  1300. * THIS IS A SYSTEM LESSON.
  1301.  
  1302. RJ SYSTEST
  1303.  
  1304. EQ PUTCODE
  1305.  
  1306.  
  1307. PURGMAC INHIB
  1308. MACREF INHIB$
  1309. INHIB MACRO NAME,SYS
  1310. MACREF INHIB
  1311. + VFD 60/0L_NAME
  1312. SYSHIB RMT
  1313. SYSIF IFC EQ,*SYS**
  1314. VFD 1/0
  1315. SYSIF ELSE
  1316. VFD 1/1
  1317. SYSIF ENDIF
  1318. SYSHIB RMT
  1319. ENDM
  1320.  
  1321. HIBLIST INHIB ERASE DONT DO FULL SCREEN ERASE
  1322. INHIB ARROW DONT PLOT ARROW
  1323. INHIB ANSERASE ANS CONTG WRITING ERASURE
  1324. INHIB NEXT NEXT
  1325. INHIB NOMOVE DONT MOVE ARROW UNTIL ANS OK
  1326. INHIB BLANKS DISALLOW BLANK STUDENT INPUT
  1327. INHIB CHARCLEAR DONT UNSET CHARSET FLAG ON -CHAR- COMMAND
  1328. INHIB DROPSTOR DONT DROP XSTOR ON JUMPOUT
  1329. INHIB UNLOAD DONT UNLOAD ON CON/STO LOAD
  1330. INHIB LOAD DONT LOAD ON CON/STO LOAD
  1331. INHIB JUMPCHK DONT DO ECS CHECK ON JUMPOUT
  1332. INHIB EDIT DISABLE -EDIT- KEY FUNCTIONS
  1333. INHIB FROM DONT SET *FROM* ON JUMPOUT
  1334. INHIB TERM DISABLE -TERM- FUNCTIONS
  1335. INHIB ADVANCE NO AUTO ADVANCE WHEN ARROW SATISFIED
  1336. INHIB CLEAR CLEAR BEFORE SET
  1337. INHIB DROPFILE DONT DROP DATASET/NAMESET
  1338. INHIB DROPCOM DONT DROP COMMON
  1339. INHIB DROPLIST,SYS DONT DROP LESLIST
  1340. INHIB ARETURN,SYS DISABLE RETURNING TO ARROW
  1341. HIBEND BSS 1 SCRATCH FOR SCANNER ROUTINE
  1342.  
  1343. * SYSTEM-LESSON-ONLY FLAGS.
  1344.  
  1345. SYSHIBS BSS 0
  1346. LIST G
  1347. SYSHIB HERE
  1348. LIST *
  1349. * /--- BLOCK -INHIBIT- 00 000 81/07/22 20.52
  1350. *
  1351. *
  1352. * -FORCE- COMMAND READ-IN
  1353. * SAME FORMAT AS -INHIBIT- BUT ENABLES RATHER THAN
  1354. * DISABLES
  1355. *
  1356. FORCEIN SB1 FOLIST
  1357. SB2 FOEND
  1358. MX5 60 FULL WORD MASK
  1359. RJ SCANNER
  1360. ZR X0,PUTCODE SEE IF ANY ERROR
  1361. EQ ERRNAME ELSE ERROR
  1362. *
  1363. FOLIST VFD 60/4LLONG FORCE JUDGING ON CHAR LIMIT
  1364. VFD 60/4LFONT FORCE FONT AS CHAR 1
  1365. VFD 60/5LMICRO FORCE CONTINUOUS MICRO OPTION
  1366. VFD 60/10LFIRSTERASE IF ANSWER WRONG, ERASE
  1367. * ENTIRE INPUT WHEN NEXT CHARACTER IS ENTERED
  1368. VFD 60/4LLEFT FORCE LEFT WRITING
  1369. VFD 60/0LCLEAR CLEAR BEFORE SET
  1370. VFD 60/0LBOLD FORCE BOLD WRITTING
  1371. VFD 60/0LCAPS ALL CAPS
  1372. FOEND BSS 1
  1373. *
  1374. * /--- BLOCK -RANDU- 00 000 79/01/05 01.59
  1375. TITLE -RANDU- COMMAND READ-IN
  1376. *
  1377. *
  1378. *
  1379. * -RANDU- COMMAND READ-IN
  1380. * IF ONE VARIABLE, SPECIFIES A VARIABLE
  1381. * IN WHICH A RANDOM NUMBER IN (0,1) IS TO BE
  1382. * STORED. IF TWO VARIABLES, THE FIRST IS
  1383. * A STORAGE VARIABLE FOR AN INTEGER BETWEEN
  1384. * ONE AND THE VALUE OF THE SECOND VARIABLE.
  1385. *
  1386. RANDUIN CALL PUTCOMP COMPILE FIRST TAG
  1387. SA2 LASTKEY
  1388. ZR X2,CALCODE DONE IF ONE TAG--CODE IN X1
  1389. BX6 X1
  1390. LX6 -XCODEL POSITION -PUTVAR- CODE
  1391. SA6 VARBUF AND SAVE IT.
  1392. CALL COMPILE COMPILE NEXT TAG
  1393. RANDU1 SA2 LASTKEY *** ENTRY FROM RANDPIN
  1394. NZ X2,ERR2MNY ERROR IF MORE THAN 2 TAGS
  1395. SA2 VARBUF PREPARE COMMAND WORD
  1396. LX1 -XCODEL-XCODEL
  1397. BX6 X1+X2 WITH BOTH CODES
  1398. SA1 COMNUM AND INCREMENTED COMMAND NUMBER
  1399. SX1 X1+1
  1400. BX6 X6+X1
  1401. EQ ALTCODE
  1402. *
  1403. *
  1404. *
  1405. * -RANDP- COMMAND READ-IN
  1406. *
  1407. RANDPIN CALL PUTCOMP COMPILE FIRST TAG
  1408. SA2 LASTKEY
  1409. ZR X2,CALCODE DONE IF ONE TAG--CODE IN X1
  1410. BX6 X1
  1411. LX6 -XCODEL POSITION -PUTVAR- CODE
  1412. SA6 VARBUF AND SAVE IT.
  1413. CALL COMPILE COMPILE NEXT TAG
  1414. NZ B1,ERRSTOR ERROR IF NON-STOREABLE
  1415. EQ RANDU1 OTHERWISE FINISH COMPILING
  1416. *
  1417. *
  1418. * /--- BLOCK -ANSV- 00 000 79/01/05 02.22
  1419. TITLE -ANSV- COMMAND READIN
  1420. *
  1421. *
  1422. *
  1423. * -ANSV- COMMAND READ-IN
  1424. *
  1425. ANSVC SA1 TAGCNT X1 = NUM CHARACTERS IN TAG
  1426. ZR X1,ERR2FEW ERROR EXIT IF NO TAG
  1427. SX6 0
  1428. SA6 APTSW PRE-SET TO ABS TOLERANCE
  1429. SA2 TAG-1+X1 X2 = LAST CHARACTER
  1430. SX3 X2-KPCT CHECK FOR PER CENT SIGN
  1431. NZ X3,ANSVIN1 JUMP IF ABSOLUTE TOLERANCE
  1432. MX7 0
  1433. SA7 A2 OVERWRITE PERCENT SIGN WITH EOL
  1434. MX6 1
  1435. LX6 60-2*XCODEL
  1436. SA6 A6 RE-SET TO PERCENT TOLERANCE
  1437. ANSVIN1 SA1 OVARG2 CHECK FOR ANSU OR ANSV
  1438. ZR X1,ANSVIN2 JUMP IF ANSV
  1439. CALL COMPILU COMPILE UNIT DIMENSIONS
  1440. EQ ANSVIN3
  1441. ANSVIN2 CALL COMPILE COMPILE WITHOUT UNIT DIMENSIONS
  1442. ANSVIN3 SA2 LASTKEY
  1443. LX1 60-XCODEL
  1444. ZR X2,ANSVIN4 JUMP IF END OF LINE
  1445. BX7 X1
  1446. SA7 VARBUF SAVE GETVAR CODE
  1447. RJ COMPILE GET SECOND ARG (TOLERANCE)
  1448. SA2 LASTKEY
  1449. NZ X2,ERR2MNY TWO ARGS MAX
  1450. SA2 VARBUF FIRST ARG
  1451. LX1 60-2*XCODEL
  1452. ANSVIN4 BX6 X1+X2 MERGE BOTH ARGS
  1453. SA3 APTSW
  1454. BX6 X6+X3 ADD ABS/PERCENT TOLERANCE FLAG
  1455. SA1 OVARG2
  1456. ZR X1,PUTCODE JUMP IF ANSV
  1457. BX6 X1+X6 MERGE COMMAND NUMBER
  1458. SA1 NDEFU NUMBER OF UNITS DEFINED
  1459. SB1 X1
  1460. SA1 ATEMPEC
  1461. BX0 X1
  1462. SA0 UADS UNIT COEFFICIENTS
  1463. + WE B1
  1464. RJ ECSPRTY
  1465. SA1 INX
  1466. SX7 X1+B1 INCREMENT INX
  1467. SA7 A1
  1468. SA0 X1+INFO ADDRESS FOR UNIT COEFFS
  1469. + RE B1
  1470. RJ ECSPRTY
  1471. SX1 X1+1 INSURE NZ TO DISTINGUISH ANSU
  1472. LX1 XCMNDL POSITION POINTER TO UNIT COEFFS
  1473. BX6 X1+X6 MERGE WITH ARGS
  1474. EQ ALTCODE
  1475. *
  1476. APTSW BSS 1 ABSOLUTE / PERCENT TOLER FLAG
  1477. *
  1478. * /--- BLOCK -RESTART- 00 000 80/02/02 23.45
  1479. TITLE -RESTART- COMMAND READ-IN
  1480. *
  1481. *
  1482. *
  1483. * -RESTART- COMMAND READ-IN
  1484. * A. NO ARGS. MEANS USE CURRENT LESSON, CURRENT UNIT
  1485. * B. ONE ARG. MEANS USE CURRENT LESSON, THIS UNIT
  1486. * C. TWO ARGS. MEANS USE THIS LESSON, THIS UNIT
  1487. *
  1488. RESTIN CALL ACCFILE,VARBUF+1,0
  1489. ZR X1,=XPAUSE2 --- IF BLANK TAG
  1490. SA2 LASTKEY
  1491. NZ X2,REST2 --- IF MORE THAN ONE ARGUMENT
  1492. *
  1493. * SINGLE-ARGUMENT FORM (UNIT NAME ONLY)
  1494. *
  1495. SX0 X1-1
  1496. NZ X0,ERRTAGS ERROR IF ARGUMENT IS LESSON NAME
  1497. SA2 VARBUF+2 LOAD GETVAR CODE
  1498. LX2 60-XCODEL POSITION GETVAR CODE
  1499. LX1 58
  1500. BX6 X1+X2 SET 2ND BIT OF GETVAR CODE
  1501. EQ PUTCODE
  1502. *
  1503. * LESSON AND UNIT SPECIFIED
  1504. *
  1505. REST2 CALL COMPNAM GET UNIT NAME
  1506. BX6 X1
  1507. SA6 VARBUF+3
  1508. SA1 LASTKEY
  1509. NZ X1,ERR2MNY ERROR IF NOT END-OF-LINE
  1510. SX6 3
  1511. SA6 VARBUF SET NUMBER OF ARGUMENTS
  1512. BX1 X6
  1513. EQ VARFIN
  1514. *
  1515. * /--- BLOCK -STATS- 00 000 80/04/07 21.32
  1516. TITLE -STATS- COMMAND READ-IN
  1517. *
  1518. *
  1519. *
  1520. STATSIN CALL SYSTEST
  1521. CALL VARDO1 GET TYPE OF STATISTICS
  1522. SA2 LASTKEY SEE IF EOL
  1523. NZ X2,STATS1 IF ACCOUNT';FILE PRESENT
  1524. SA1 VARBUF+1
  1525. MX6 1
  1526. LX6 XCODEL
  1527. BX6 X1+X6 SET TOP BIT IF ONLY ONE ARG.
  1528. SA6 A1
  1529. SX1 1 ONE GETVAR CODE
  1530. EQ =XVARFIN
  1531.  
  1532. STATS1 CALL ACCFILE,(VARBUF+2),0 PROCESS ACCOUNT';FILE
  1533. SA1 LASTKEY
  1534. NZ X1,ERR2MNY ERROR IF NOT EOL
  1535. SX6 3
  1536. SA6 VARBUF ADJUST NUMBER OF ARGUMENTS
  1537. SX1 3 THREE GETVAR CODES
  1538. EQ =XVARFIN
  1539. * /--- BLOCK -EXCHANG- 00 000 80/05/15 20.20
  1540. TITLE -EXCHANG- COMMAND READ-IN
  1541. *
  1542. *
  1543. * TAG ON -EXCHANG- COMMAND SPECIFIES IF THE
  1544. * LOGICAL SITE CONTROLLER IS TO BE BYPASSED.
  1545. *
  1546. EXCHIN CALL SYSTEST
  1547. SA1 LESSON
  1548. SA2 KPLAT CHECK FOR LESSON -PLATO-
  1549. BX2 X1-X2
  1550. ZR X2,EXCHANC
  1551. SA2 KNPLAT
  1552. BX2 X1-X2 CHECK FOR LESSON -NPLATO-
  1553. NZ X2,ERRORC
  1554. *
  1555. EXCHANC MX6 0 PRESET X6
  1556. SA1 TAGCNT CHECK FOR BLANK TAG
  1557. ZR X1,PUTCODE -- ASSUME BLANK = 0
  1558. EQ ONE2IN IN ',CONDC',
  1559. EQ PUTCODE
  1560. *
  1561. KPLAT DATA 5LPLATO
  1562. KNPLAT DATA 6LNPLATO
  1563. *
  1564. *
  1565. * /--- BLOCK -GETWORD- 00 000 79/01/23 01.06
  1566. TITLE -GETWORD- COMMAND READ-IN
  1567. *
  1568. *
  1569. *
  1570. * -GETWORD- COMMAND READ-IN
  1571. * GET THE N-TH WORD OUT OF THE STUDENT ANSWER
  1572. * AND PUT INTO THE STATED BUFFER.
  1573. *
  1574. * GETWORD VAR1,VAR2,VAR3,VAR4
  1575. * VAR1 = WORD WANTED
  1576. * VAR2 = ADDRESS TO PUT WORD PACKED 10 CHARS / WORD
  1577. * VAR3 = RETURN ACTUAL CHARACTER COUNT
  1578. * VAR4 = MAXIMUM ALLOWABLE NUMBER OF CHARACTERS
  1579. * (IF ABSENT, SET TO DEFAULT 10)
  1580. *
  1581. GETWDC CALL VARDO GET COMMA SEPARATED VARS
  1582. SA1 VARBUF+2 VAR2 MUST BE STORABLE
  1583. NG X1,ERRSTOR
  1584. SA1 VARBUF+3 DITTO FOR VAR3
  1585. NG X1,ERRSTOR
  1586. SA1 VARBUF SEE IF RIGHT NUMBER OF ARGS
  1587. SX2 X1-4
  1588. ZR X2,VARFIN GO TO STANDARD PACK-UP ROUTINE
  1589. SX2 X1-3 SEE IF NEED TO GENERATE 4TH ARG
  1590. NZ X2,ERRTAGS ALL ELSE AN ERROR IN FORM
  1591. SX6 10 SET DEFAULT SMALL CONSTANT 10
  1592. SA6 VARBUF+4 AS FOURTH ARG
  1593. SX6 4 AND RESET VARBUF TO 4 ARGS
  1594. SA6 VARBUF
  1595. BX1 X6 AND X1 ALSO SET TO 4 ARGS
  1596. EQ VARFIN EXIT TO STANDARD PACK ROUTINE
  1597. *
  1598. * /--- BLOCK -GETLOC- 00 000 79/01/23 01.08
  1599. TITLE -GETLOC- COMMAND READ-IN
  1600. *
  1601. *
  1602. *
  1603. * -GETLOC- COMMAND READ-IN
  1604. * GET THE SCREEN LOCATION OF STUDENT WORDS
  1605. *
  1606. * GETLOC ARG1,ARG2,ARG3,(ARG4,ARG5)
  1607. * ARG1 = WORD WANTED
  1608. * ARG2 = STARTING X
  1609. * ARG3 = STARTING Y
  1610. * ARG4 = ENDING X --OPTIONAL
  1611. * ARG5 = ENDING Y --OPTIONAL
  1612. *
  1613. GETLOCC CALL VARDO GET COMMA SEPARATED VARS
  1614. SA1 VARBUF+2 VAR2 MUST BE STORABLE
  1615. NG X1,ERRSTOR
  1616. SA1 VARBUF+3 DITTO FOR VAR3
  1617. NG X1,ERRSTOR
  1618. SA1 VARBUF SEE IF RIGHT NUMBER OF ARGS
  1619. SX2 X1-3
  1620. NZ X2,GETLC1 IF 3 ARGS MUST ADD DUMMY 2 MORE
  1621. MX6 0
  1622. SA6 VARBUF+4
  1623. SA6 VARBUF+5
  1624. SX6 5
  1625. SA6 VARBUF
  1626. BX1 X6
  1627. EQ VARFIN
  1628. *
  1629. GETLC1 SX2 X1-5 SEE IF ENDING LOCATION WANTED
  1630. NZ X2,ERRTAGS ALL ELSE AN ERROR IN FORM
  1631. SA2 VARBUF+4 VAR4 MUST BE STORABLE
  1632. NG X2,ERRSTOR
  1633. SA2 VARBUF+5 DITTO FOR VAR5
  1634. NG X2,ERRSTOR
  1635. EQ VARFIN
  1636. *
  1637. * /--- BLOCK -SEARCH- 00 000 79/01/23 01.19
  1638. TITLE -SEARCH- COMMAND READ-IN
  1639. *
  1640. *
  1641. *
  1642. * -SEARCH- COMMAND READ-IN
  1643. *
  1644. * TAG HAS 6 (OR OPTIONALLY, 7) ENTRIES.
  1645. * 1ST = OBJECT (LEFT-JUSTIFIED)
  1646. * 2ND = OBJECT LENGTH IN CHARS
  1647. * 3RD = BASE ADDRESS FOR SEARCH
  1648. * 4TH = INFORMATION LENGTH IN CHARS
  1649. * 5TH = STARTING CHAR FOR SEARCH (OFFSET FROM BASE)
  1650. * 6TH = VARIABLE FOR STORAGE OF RETURN CODE--
  1651. * -1=NOT FOUND 1-N=FOUND STARTING AT CHAR N
  1652. * 7TH = LENGTH OF RETURN LIST (REPEATED SEARCHES)
  1653. *
  1654. SEARCHC CALL VARDO COMMA SEPARATED VARIABLES
  1655. SA1 VARBUF+3 BASE ADDRESS
  1656. NG X1,SCERR ERROR IF NOT STORE-ABLE
  1657. SA1 VARBUF+6 CODE FOR RETURN VARIABLE
  1658. NG X1,SCERR ERROR IF NOT STORE-ABLE
  1659. SA1 VARBUF+1 CODE FOR STRING
  1660. MX0 1
  1661. LX0 XCODEL-XFBIT
  1662. BX6 -X0*X1 MASK OUT I/F BIT (SET INTEGER)
  1663. SA6 A1
  1664. SX1 7 7 VARIABLES REQUIRED
  1665. SA2 VARBUF X2 = NUMBER OF VARIABLES
  1666. SX3 X2-6
  1667. NZ X3,VARFIN EXIT IF NOT 6 VARIABLES
  1668. BX6 X1
  1669. SA6 A2 RESET VARIABLE COUNT TO 7
  1670. MX7 1
  1671. LX7 XCODEL PREPARE DUMMY CODE FOR 7TH ARG
  1672. SA7 VARBUF+7 STORE AS 7TH ARGUMENT
  1673. EQ VARFIN
  1674. *
  1675. SCERR SB1 70 NON-STOREABLE VARIABLE
  1676. EQ ERR
  1677. *
  1678. * /--- BLOCK -COMPUTE- 00 000 79/07/15 15.19
  1679. TITLE -COMPUTE- COMMAND READ-IN
  1680. *
  1681. *
  1682. *
  1683. * -COMPUTE- COMMAND READ-IN
  1684. * COMPUTE RESULT,STRING,CHAR COUNT,POINTER
  1685. * (OPTIONAL)
  1686. *
  1687. * THE 4 TAG COMPUTE COMMAND IS SIMILAR TO A STORE COMMAND,
  1688. * EXCEPT THE COMPILED MACHINE CODE IS SAVED IN AN ECS
  1689. * BUFFER FOR LATER REUSE. POINTER IS SET TO POINT AT THIS
  1690. * COMPILED CODE, AND SUCCEEDING EXECUTIONS OF THE COMPUTE
  1691. * COMMAND WITH THIS POINTER WILL CAUSE SIMPLE FETCHES OF
  1692. * THE MACHINE CODE FROM ECS.
  1693. *
  1694. * THE 3 TAG VERSION FUNCTIONS THE SAME AS THE 4 TAG VERSION,
  1695. * EXCEPT THAT THE CODE IS NOT STORED FOR LATER REUSE. 'IT
  1696. * PROVIDES A WAY OF EVALUATING EXPRESSIONS OUTSIDE OF JUDGE
  1697. * STATE.
  1698. COMPUIN CALL PUTCOMP DECODE FIRST VARIABLE
  1699. BX6 X1
  1700. SA6 VARBUF+1 STORE FIRST -GETVAR- CODE
  1701. SX6 1
  1702. SA6 VARBUF INITIALIZE *VARBUF*
  1703. MX6 0
  1704. SA6 VARBUF+5
  1705. CALL VARDO2 DECODE REMAINING VARS
  1706. CALL VARDO2
  1707. SA2 LASTKEY CHECK FOR E-O-L
  1708. ZR X2,ONLY3 JUMP IF ONLY 3 ARGS
  1709. CALL VARDO2
  1710. SA1 LASTKEY MUST BE END-OF-LINE
  1711. NZ X1,ERR2MNY
  1712. SB1 4 CHECK POINTER ADDRESS
  1713. RJ JUSTAD CHECK FOR STORABILITY
  1714. ALLDONE SB1 2 CHECK STRING ADDRESS
  1715. RJ JUSTAD
  1716. SX1 4
  1717. EQ VARFIN
  1718. *
  1719. ONLY3 SX6 4
  1720. SA6 VARBUF SET ARGUMENT COUNT IN VARBUF
  1721. MX6 0 SET 4TH GETVAR CODE TO 0 TO
  1722. SA6 VARBUF+4 INDICATE LACK OF 4TH ARGUMENT
  1723. EQ ALLDONE
  1724. *
  1725. JUSTAD EQ * CHECK (VARBUF+B1) STORE-ABLE
  1726. * AND CLEAN OUT I/F BIT, SINCE AT EXECUTION TIME WE NEED
  1727. * ONLY THE ADDRESS, NOT THE VALUE.
  1728. SA1 VARBUF+B1 GET THE CODE
  1729. NG X1,ERRSTOR ERROR IF NOT STORE-ABLE
  1730. MX6 61-XCODEL+XFBIT MASK OUT I/F BIT
  1731. BX6 -X6*X1
  1732. SA6 A1
  1733. EQ JUSTAD
  1734. *
  1735. *
  1736. * /--- BLOCK -CALCS- 00 000 80/10/01 04.18
  1737. TITLE -CALCS- COMMAND READ-IN
  1738. *
  1739. *
  1740. *
  1741. * -CALCS- COMMAND READ-IN
  1742. * FOUR TO N VARS LEGAL
  1743. *
  1744. * EXAMPLE OF USAGE -
  1745. * CALCS V2+2,V1= 5,7,V8
  1746. * V1 IS SET TO 5 IF (V2+2) IS NEQATIVE
  1747. * V1 IS SET TO 7 IF (V2+2) IS ZERO
  1748. * V1 IS SET TO V8 IF (V2+2) IS POSITIVE
  1749. *
  1750. CALCSIN CALL VARDO1 GET FIRST VAR
  1751. SA1 WORDPT POINTER TO NEXT CHARACTER
  1752. SX0 KASSIGN ACCEPT ASSIGNMENT AS TERMINATOR
  1753. CALL PSCAN
  1754. ZR X1,ERR2FEW ERROR IF END OF LINE
  1755. SX6 1R,
  1756. SA6 B1 REPLACE WITH COMMA
  1757. CALL PUTCOMP DECODE VARIABLE TO STORE INTO
  1758. BX6 X1
  1759. SA6 VARBUF+2 STORE -GETVAR- CODE
  1760. SX6 2
  1761. SA6 VARBUF UPDATE NUMBER OF CODES
  1762.  
  1763. *
  1764. * -CSLOOP-
  1765. * BUILD LIST OF EXPRESSIONS INTO *VARBUF*, ASSUMING
  1766. * THAT 1) THE ARGUMENTS CAN BE BLANK, IN WHICH CASE
  1767. * A SPECIAL BIT IS SET, AND 2) THE COMMAND MAY BE
  1768. * CONTINUED ACROSS SOURCE LINES
  1769. *
  1770. * EXITS TO -VARFINM- WHEN DONE
  1771. *
  1772. CSLOOP CALL GETBARG GET (POSSIBLY BLANK) ARGUMENT
  1773. NZ X3,CSLOOP AND LOOP WHILE ARGUMENTS FOUND
  1774. ZR X2,CSNEXT GET NEW LINE IF E-O-L
  1775. *
  1776. * PUT DUMMY GETVAR CODE (1/1,19/0) INTO *VARBUF*
  1777. *
  1778. SA1 VARBUF
  1779. SX6 X1+1 ADVANCE *VARBUF* POINTER
  1780. SX1 X6-VARBUFL
  1781. PL X1,ERR2MNY ERROR IF BUFFER FULL
  1782. SA6 A1
  1783. MX7 1 SET UP SPECIAL GETVAR CODE
  1784. LX7 XCODEL
  1785. SA7 X6+VARBUF STORE IT
  1786. EQ CSLOOP
  1787. *
  1788. CSNEXT SA1 NEXTCOM CHECK FOR CONTINUATION
  1789. SA2 COMCONT
  1790. BX3 X1-X2
  1791. NZ X3,CSEND JUMP IF NOT CONTINUED
  1792. CALL GETLINE READ IN NEXT LINE
  1793. EQ CSLOOP
  1794. *
  1795. CSEND SA1 VARBUF
  1796. SX1 X1-3 MUST BE AT LEAST 3 VARS
  1797. PL X1,VARFINM
  1798. EQ ERR2FEW
  1799. *
  1800. * /--- BLOCK GETBARG 00 000 80/10/01 04.19
  1801. TITLE -GETBARG- GET POSSIBLY BLANK ARGUMENT
  1802. *
  1803. * -GETBARG-
  1804. * READ NEXT EXPRESSION, WHICH MAY BE BLANK, AND
  1805. * ASSEMBLE GETVAR CODE IN *VARBUF* IF PRESENT.
  1806. *
  1807. * ON ENTRY -- *WORDPT* SET
  1808. *
  1809. * ON EXIT -- X2 = NEXT CHARACTER (0 IF E-O-L)
  1810. * X3 = 0 IF NO ARGUMENT COMPILED
  1811. *
  1812. * USES -- PRETTY MUCH EVERYTHING
  1813. *
  1814.  
  1815. GETBARG EQ *
  1816. SX3 0 SET TO NO ARGUMENT COMPILED
  1817. SA1 WORDPT X1 = POINTER TO NEXT CHARACTER
  1818. GBA1 SA2 X1 X2 = NEXT CHARACTER
  1819. ZR X2,GETBARG DONE IF E-O-L
  1820. SX0 X2-1R IGNORE LEADING SPACES
  1821. NZ X0,GBA2
  1822. SX1 X1+1 MOVE PAST SPACE
  1823. EQ GBA1 AND CONTINUE
  1824. *
  1825. GBA2 SA3 X2+KEYTYPE
  1826. SX0 X3-OPCOMMA CHECK FOR COMMA
  1827. NZ X0,GBA3 COMPILE IT IF SOMETHING ELSE
  1828. *
  1829. SX6 X1+1 COMMA FOUND -- BLANK EXPRESSION
  1830. SA6 A1 UPDATE *WORDPT*
  1831. MX3 0 FLAG NO EXPRESSION FOUND
  1832. EQ GETBARG -- EXIT
  1833. *
  1834. GBA3 CALL VARDO2 GET CODE FOR NEXT VARIABLE
  1835. SA1 WORDPT
  1836. SA2 X1 SET TO NEXT CHARACTER
  1837. SX3 1 FLAG EXPRESSION COMPILED
  1838. EQ GETBARG -- EXIT
  1839. *
  1840. * /--- BLOCK -CTIME- 00 000 80/10/01 03.05
  1841. TITLE -CTIME- COMMAND READIN
  1842. * CONDENSE ROUTINE FOR -CTIME- (CODE = 180)
  1843. * 1ST ARGS ARE INPUT PARAMETERS (UP TO 3)
  1844. * 2ND ARG IS OUTPUT WORD TO HOLD RESULTS
  1845. * 3RD ARG IS FORMAT FOR TRANSLATION (OPTIONAL)
  1846. * 12=12 HOUR FORMAT
  1847. * 24=24 HOUR FORMAT
  1848. ***
  1849. * THE FIRST GETVAR CODE CONTAINS NUMBER OF
  1850. * INPUT PARAMETERS
  1851.  
  1852. CTIMEIN SX6 1
  1853. SA6 VARBUF SET UP DUMMY FIRST ARGUMENT
  1854. CALL VARDO2 GET FIRST REAL ARGUMENT
  1855.  
  1856. CTIMES SA1 LASTKEY
  1857. SX1 X1-KSEMIC (KSEMIC) = SEMI-COLON
  1858. ZR X1,STORETC END OF INPUT PARAMS
  1859. CALL VARDO2
  1860. SA2 VARBUF GET NUMBER OF TAGS
  1861. SX2 X2-5 POSITIVE IF X2 .GT. MAX INPUT
  1862. NG X2,CTIMES IS - IF MORE TAGS TO FETCH
  1863. EQ ERR2MNY MAXIMUM OF 3 TAGS FOR INPUT
  1864.  
  1865. STORETC SA3 VARBUF X3 = NUMBER TAGS SO FAR
  1866. SX6 X3-1 DO NOT COUNT DUMMY ARGS
  1867. SA6 VARBUF+1 SAVE NO. INPUT ARGS AS 1ST ARG
  1868. CALL VARDO2
  1869. NG X6,ERRSTOR NOT STOREABLE
  1870. SA1 VARBUF+1 GET NUMBER OF INPUT TAGS
  1871. SX1 X1-1
  1872. NZ X1,CTNEXT MORE THEN ONE TAG
  1873. *
  1874. SA1 VARBUF+2 GET FIRST FLOATING POINT
  1875. MX6 61-XCODEL+XFBIT
  1876. BX6 -X6*X1 GET RID OF FLOATING POINT BIT
  1877. SA6 A1 REWRITE WORD WITHOUT F BIT
  1878. CTNEXT SA1 LASTKEY
  1879. ZR X1,MRKLAST IF NO FORMAT TAG EXIT
  1880. SX1 X1-KSEMIC
  1881. NZ X1,ERR2MNY ONLY SEMI COLONS
  1882. CALL VARDO2
  1883. SA1 LASTKEY
  1884. ZR X1,MRKLAST THIS IS LAST LEGAL TAG
  1885. EQ ERR2MNY TOO MANY TAGS
  1886.  
  1887. *
  1888. TITLE -COLOR- COMMAND READIN
  1889. *
  1890. * -COLOR- COMMAND (NUMBER 158)
  1891. *
  1892. * COLOR DEFINE;(VAR),REDVAL,GREENVAL,BLUEVAL
  1893. *
  1894. * READS IN THE VALUES SPECIFIED FOR
  1895. * COLOR INTENSITIES IN THE RANGE 0..1,
  1896. * CONVERTS THEM TO A 24-BIT INTEGER,
  1897. * AND STORES THE RESULT IN THE SPECIFIED
  1898. * VARIABLE.
  1899. *
  1900. * COLOR DISPLAY;FOREGND,BACKGND
  1901. * COLOR DISPLAY;FOREGND
  1902. * COLOR DISPLAY;,BACKGND
  1903. *
  1904. * TAKES THE 24-BIT COLOR VALUE(S)
  1905. * SPECIFIED FOR FOREGROUND AND BACKGROUND
  1906. * COLOR(S) AND SENDS THE INFORMATION TO
  1907. * THE TERMINAL.
  1908. *
  1909. * COMMAND WORD FORMAT';
  1910. * 20/GETVAR,20/GETVAR,11/EXSTO ADDR,9/COMMAND NUMBER
  1911. *
  1912. * THE FIRST GETVAR CODE IS THE COMMAND EXECUTION
  1913. * ROUTINE NUMBER --
  1914. * 0 = -COLOR DEFINE-
  1915. * 1 = -COLOR DISPLAY-
  1916. *
  1917. * /--- BLOCK -CTIME- 00 000 80/10/01 03.05
  1918. * IF THE COMMAND IS -COLOR DISPLAY-, THE SECOND
  1919. * GETVAR CODE IS THE FOREGROUND COLOR AND THE
  1920. * THIRD GETVAR CODE (FIRST IN EXTRA STORAGE) IS
  1921. * THE BACKGROUND COLOR. SINCE EITHER (BUT NOT
  1922. * BOTH) MAY BE OMITTED, AN OMITTED COLOR IS
  1923. * SIGNALLED BY THE GETVAR CODE 200 000B.
  1924. *
  1925. EJECT
  1926. COLORIN BSS 0
  1927. *
  1928. * PROCESS FIRST TAG -- TYPE OF -COLOR- REQUEST
  1929. *
  1930. RJ NXTNAM X6 = TAG, X1 = DELIMITER CHAR
  1931. ZR X6,ERR2FEW -> NOT ENOUGH TAGS
  1932. BX7 X1 SAVE DELIMITER
  1933. SX2 X1-KSEMIC SEE IF DELIMITER = SEMICOLON
  1934. SA7 LASTKEY SAVE DELIMITER
  1935. NZ X2,ERRTERM -> BAD DELIMITER CHARACTER
  1936. SB1 1 B1 = CONSTANT 1
  1937. SA2 KCDEF START OF KEYWORDS
  1938.  
  1939. TAGCHEK ZR X2,ERRNAME -> KEYWORD NOT FOUND
  1940. BX3 X2-X6 CHECK KEYWORD
  1941. SA2 A2+B1 X2 = NEXT KEYWORD IN LIST
  1942. NZ X3,TAGCHEK -> NOT A MATCH
  1943. SB1 A2-KCDEF-1 B1 = JUMP TABLE INDEX
  1944. SX6 B1 X6 = COMMAND TYPE
  1945. SA6 VARBUF+1
  1946. SX6 1 ONE ENTRY IN VARBUF
  1947. SA6 VARBUF
  1948. + JP B1+*+1
  1949.  
  1950. + EQ CDEFINE -> PROCESS DEFINE KEYWORD
  1951. + EQ CDISPLY -> PROCESS DISPLAY KEYWORD
  1952.  
  1953. KCDEF DATA 0LDEFINE
  1954. DATA 0LDISPLAY
  1955. DATA 0 MUST END IN 0 WORD
  1956.  
  1957. KCOMMA EQU 56B COMMA CHARACTER
  1958. EJECT
  1959. *
  1960. * PROCESS DEFINE KEYWORD
  1961. *
  1962. CDEFINE BSS 0
  1963. RJ CARGS GET ARGUMENTS
  1964. SA1 VARBUF MUST BE 4 ARGUMENTS + KEYWORD
  1965. SX1 X1-5
  1966. NG X1,ERR2FEW -> NOT ENOUGH TAGS
  1967. NZ X1,ERR2MNY -> TOO MANY TAGS
  1968. SA1 VARBUF+2 X1 = VAR TAG GETVAR CODE
  1969. NG X1,ERRSTOR -> MUST BE STOREABLE
  1970. SA1 VARBUF+3 X1 = RED TAG GETVAR CODE
  1971. RJ CHKVALU CHECK VALIDITY
  1972. SA1 VARBUF+4 X1 = GREEN TAG GETVAR CODE
  1973. RJ CHKVALU CHECK VALIDITY
  1974. SA1 VARBUF+5 X1 = BLUE TAG GETVAR CODE
  1975. RJ CHKVALU CHECK VALIDITY
  1976. EQ CEND -> ALL OK; FINISH COMMAND
  1977. *
  1978. * PROCESS DISPLAY KEYWORD
  1979. *
  1980. CDISPLY BSS 0
  1981. MX6 1 PRESTORE BOTH ARGS OMITTED
  1982. LX6 XCODEL
  1983. SA6 VARBUF+2
  1984. SA6 VARBUF+3
  1985. RJ GETBARG GET FOREGROUND ARG
  1986. ZR X2,CDISP1 -> ONLY ONE ARGUMENT
  1987. NZ X3,CDISP0 -> CHECK BGND IF FGND COMPILED
  1988. SA1 VARBUF ELSE INCREMENT *VARBUF* OVER
  1989. SX6 X1+1 OMITTED FGND ARGUMENT
  1990. SA6 VARBUF
  1991. CDISP0 BSS 0
  1992. RJ GETBARG GET BACKGROUND ARG
  1993. CDISP1 BSS 0
  1994. * /--- BLOCK -CTIME- 00 000 80/10/01 03.05
  1995. SA1 VARBUF CHECK FOR .LT. 4 ARGS
  1996. SX1 X1-4
  1997. PL X1,ERR2MNY -> TOO MANY ARGUMENTS
  1998. SX6 3 SET TO EXACTLY 3 ARGS
  1999. SA6 VARBUF
  2000. SA1 VARBUF+2 CHECK FOR BOTH ARGS OMITTED
  2001. SA2 VARBUF+3
  2002. MX0 1
  2003. LX0 XCODEL X0 = OMITTED ARG MASK
  2004. BX1 X0*X1 X1 .NZ. IF OMITTED
  2005. BX2 X0*X2 X2 .NZ. IF OMITTED
  2006. BX2 X1*X2 X2 .NZ. IF BOTH OMITTED
  2007. NZ X2,ERR2FEW -> ERROR IF BOTH OMITTED
  2008. CEND SA1 VARBUF X1 = NUMBE OF VARBUF ENTRIES
  2009. EQ VARFIN -> BUILD COMMAND WORD
  2010. *
  2011. * CARGS -- GET ALL THE TAGS IN THE COMMAND.
  2012. * IF A TAG IS OMITTED, INSERT A GETVAR CODE
  2013. * OF 200 000B.
  2014. *
  2015. CARGS EQ *
  2016. CGET RJ GETBARG GET NEXT TAG
  2017. NZ X3,CGET -> NOT OMITTED, GET NEXT
  2018. ZR X2,CARGS -> EOL; EXIT
  2019. MX6 1
  2020. LX6 XCODEL X6 = OMITTED TAG CODE
  2021. SA1 VARBUF X1 = CURRENT ENTRIES COUNT
  2022. SX1 X1+1 INCREMENT COUNT
  2023. SA6 VARBUF+X1 STORE OMITTED ARG
  2024. BX6 X1
  2025. SA6 VARBUF STORE NEW COUNT
  2026. EQ CGET GET NEXT TAG
  2027. *
  2028. * CHKVALU -- MAKE SURE CONSTANT IS IN
  2029. * RANGE 0..1.
  2030. *
  2031. * ENTER'; X1 = GETVAR CODE FROM *VARBUF*
  2032. *
  2033. CHKVALU EQ *
  2034. PL X1,CHKVALU -> STOREABLE; NO TEST
  2035. MX0 1
  2036. LX0 XCODEL X0 = OMITTED TAG CODE
  2037. BX2 X0*X1 X2 .NZ. IF OMITTED
  2038. MX0 60-XCODEAL X0 = ADDRESS MASK
  2039. NZ X2,ERRTAGS -> ERROR IN TAGS COUNT
  2040. BX6 -X0*X1 X6 = SHORT LIT OR ADDRESS
  2041. BX2 X1 SAVE ORIGINAL GETVAR CODE IN X1
  2042. AX2 XCODEAL MOVE TYPE CODE TO LOW ORDER
  2043. BX0 -X0*X2 X0 = TYPE CODE (0 OR 1)
  2044. SX0 X0-1 0 = SHORT LIT, 1 = LONG LIT
  2045. PL X0,CHKLONG -> CHECK LONG LIT
  2046. PX1 X6 ELSE FLOAT SHORT LIT
  2047. NX1 X1
  2048. EQ CHKRANGE -> CHECK RANGE
  2049. CHKLONG BSS 0
  2050. SA1 INFO+X6 GET LONG LIT FROM *INFO*
  2051. CHKRANGE BSS 0
  2052. SA2 ONEP0 X2 = 1.0
  2053. NG X1,COLROOR -> COLOR NEGATIVE
  2054. FX2 X2-X1 X2 <= 1.0 - COLOR
  2055. PL X2,CHKVALU -> COLOR OK; EXIT
  2056. COLROOR BSS 0 CONDENSE ERROR IF OOR
  2057. SB1 500 B1 = CONDENSE ERROR NUMBER
  2058. EQ =XERR -> GENERATE CONDENSE ERROR
  2059.  
  2060. ONEP0 DATA 1.0 CONSTANT 1.0
  2061. *
  2062. * /--- BLOCK ENDOV 00 000 79/01/05 02.22
  2063. *
  2064. ENDOV ENDOV
  2065. *
  2066. *
  2067. * /--- BLOCK TSLINKC 00 000 80/08/28 09.33
  2068. TSLINKC SPACE 4,10
  2069. TITLE -TSLINK- COMMAND READIN
  2070. ** COMMAND READIN FROM -TSLINK-
  2071. *
  2072. * 1ST ARG IS KEYWORD
  2073. * 2ND - 4TH ARG EXTRA TAGS (ALL OPTIONAL)
  2074. *
  2075. * TSLINK LOGIN;MAINFRAME,PASSWORD
  2076. * TSLINK RECOVER
  2077. * TSLINK COMMAND;S,X;WORDS
  2078. * TSLINK SEND;S,X;WORDS
  2079. * TSLINK RECEIVE;S,X;MAX ALLOWED;WORDS RETURNED
  2080. * TSLINK STATUS;WORD
  2081. * TSLINK MESSAGE;MESSAGE
  2082. * TSLINK CONTINUE
  2083. * TSLINK STOP
  2084. * TSLINK CSET;VALUE
  2085. * TSLINK LOGOUT
  2086. * TSLINK NOLOG
  2087. *
  2088.  
  2089. TSLINKC OVRLAY
  2090. .TSL IFEQ 0,1
  2091.  
  2092. * FOR NOW -TSLINK- CAN BE USED IN NORMAL LESSONS
  2093. * ON THE SYSTEMS SPECIFIED BELOW, AND IN SYSTEM
  2094. * LESSONS ON ANY SYSTEM.
  2095.  
  2096. SA1 CSYSNAM (X1) = THIS SYSTEMS ROUTING ID
  2097. SA2 MNE
  2098. BX2 X1-X2
  2099. ZR X2,TSOK IF MINNE
  2100. SA2 PCA
  2101. BX2 X1-X2
  2102. ZR X2,TSOK IF PCA
  2103. SA2 PEA
  2104. BX2 X1-X2
  2105. ZR X2,TSOK IF PEA
  2106. SA2 PWA
  2107. BX2 X1-X2
  2108. ZR X2,TSOK IF PWA
  2109. SA2 S1
  2110. BX2 X1-X2
  2111. ZR X2,TSOK IF S1
  2112.  
  2113. CALL SYSTEST ELSE MUST BE SYSTEM LESSON
  2114.  
  2115. TSOK BSS 0
  2116. CALL NXTNAM
  2117. BX7 X1
  2118. SA7 LASTKEY
  2119.  
  2120. * IDENTIFY KEYWORD
  2121.  
  2122. SB2 B0
  2123.  
  2124. TLOOP SA2 TSTABLE+B2 FETCH TABLE ENTRY
  2125. ZR X2,ERRNAME KEYWORD NOT IN TABLE
  2126. IX3 X6-X2
  2127. ZR X3,FOUND =0 IF EXACT MATCH
  2128. SB2 B2+1 INCREMENT LOOP POINTER
  2129. EQ TLOOP
  2130. * /--- BLOCK TSLINKC 00 000 80/08/28 09.33
  2131.  
  2132. * FOUND SO FETCH DESCRIPTOR WORD
  2133.  
  2134. FOUND SA2 TSDES+B2
  2135. SX6 B2 KEYWORD NUMBER
  2136. SA6 VARBUF+1
  2137. SX6 1
  2138. SA6 VARBUF COUNT OF TAGS
  2139. MX0 3 TAG DESCRIPTORS ARE 3 BITS
  2140. BX3 X0*X2 (X3) = SYSTEM LESSON FLAG
  2141. LX2 6 PUT 1ST TAG BITS IN BITS 2-0
  2142. BX6 X2
  2143. SA6 XTEMP
  2144. ZR X3,FOUND.1 IF ALLOWED IN USER LESSONS
  2145. CALL SYSTEST
  2146. SA2 XTEMP RETRIEVE DESCRIPTOR WORD
  2147. FOUND.1 MX0 -3
  2148. BX3 -X0*X2
  2149.  
  2150. * PROCESS DESCRIPTOR
  2151.  
  2152. DLOOP ZR X3,LASTCHK CHECK IF END OF INPUT
  2153. SA1 LASTKEY
  2154. ZR X1,ERR2FEW IF NO MORE CHARS
  2155. SA4 STORCO3 1R; IS ONLY LEGAL SEPERATOR
  2156. IX1 X1-X4
  2157. NZ X1,ERRTERM IF NOT ;
  2158. SX3 X3-1
  2159. NZ X3,NREAD (1) = READABLE
  2160. CALL VARDO2
  2161. EQ STORE
  2162.  
  2163. NREAD SX3 X3-1
  2164. NZ X3,NWRITE (2) = STOREABLE
  2165. CALL VARDO2
  2166. SA1 VARBUF GET CURRENT NUMBER OF TAG
  2167. SA1 VARBUF+X1 FETCH ENTRY
  2168. NG X1,=XERRSTOR TEST IF STOREABLE
  2169. EQ STORE
  2170.  
  2171. NWRITE BSS 0
  2172. CALL NXTNAM GET NEXT LITERAL
  2173. BX7 X1
  2174. SA7 LASTKEY
  2175. SA2 STORCON
  2176. IX4 X6-X2
  2177. SB1 155 BAD STORAGE LOCATION
  2178. ZR X4,NWRITEY IS S, FORM
  2179. SA2 STORCO4 NOW TRY STORAGE,
  2180. IX4 X6-X2
  2181. * /--- BLOCK TSLINKC 00 000 80/08/28 09.33
  2182. ZR X4,NWRITEY IS STORAGE FORM SO CONTINUE
  2183. EQ ERR
  2184.  
  2185. NWRITEY SA2 STORCO2
  2186. IX6 X1-X2
  2187. NZ X6,ERR IF NOT 2R
  2188. SA1 LASTKEY
  2189. ZR X1,ERR2FEW IF NO MORE CHARS
  2190. CALL VARDO2
  2191. STORE SA2 XTEMP
  2192. LX2 3
  2193. MX0 3
  2194. LX0 3
  2195. BX3 X2*X0
  2196. BX6 X2
  2197. SA6 XTEMP
  2198. EQ DLOOP
  2199. * /--- BLOCK TSLINKC 00 000 80/08/28 09.33
  2200.  
  2201. LASTCHK SA3 LASTKEY
  2202. NZ X3,ERR2MNY TOO MANY TAGS
  2203.  
  2204. EQ MRKLAST MARK AS LAST FLAG
  2205.  
  2206. * /--- BLOCK TSLINKC 00 000 80/08/28 09.33
  2207. STORCON CON 1LS
  2208. STORCO2 CON 1R,
  2209. STORCO3 CON 1R;
  2210. STORCO4 CON 0LSTORAGE
  2211. XTEMP BSSZ 1
  2212. *
  2213. * TO ADD A KEYWORD';
  2214. *
  2215. * ADD THE LITERAL STRING TO THE *KEYWORD* TABLE AND
  2216. * ADD THE DESCRIPTOR WORD TO THE *PROCESS WORD*
  2217. * TABLE. (MATCHING THE OFFSET INTO EACH)
  2218. * THE END OF TABLE IS LOCATED BY THE LAST ENTRY = 0
  2219. *
  2220.  
  2221. * KEYWORD TABLE
  2222.  
  2223. TSTABLE DATA 0LLOGIN
  2224. DATA 0LRECOVER
  2225. DATA 0LCOMMAND
  2226. DATA 0LSEND
  2227. DATA 0LRECEIVE
  2228. DATA 0LSTATUS
  2229. DATA 0LCONTINUE
  2230. DATA 0LSTOP
  2231. DATA 0LCSET
  2232. DATA 0LLOGOUT
  2233. DATA 0LNOLOG
  2234. DATA 0LMESSAGE
  2235. DATA 0 END OF TABLE
  2236.  
  2237. * DESCRIPTOR WORD TABLE
  2238. *
  2239. * THE FORMAT OF EACH WORD IS
  2240. * EACH COMMAND MUST HAVE SEMI-COLONS FOR EACH
  2241. * TAG DIVISOR, EXCEPT FOR THE STORAGE, FORMAT
  2242. * WHICH HAS A COMMA AFTER THE S OR STORAGE
  2243. * 3/0, = NON-SYSTEM KEYWORD
  2244. * 3/1, = SYSTEM LESSON ONLY KEYWORD
  2245. * THE FOLLOWING 3 BIT FIELDS DESCRIBE THE
  2246. * FORMAT OF THE USERS TAG
  2247. * 0 = END OF TAGS
  2248. * 1 = READABLE USER VARIABLE (I.E. WHERE)
  2249. * 2 = STORABLE USER VARIABLE (I.E. N1)
  2250. * 3 = STORAGE DEFINITION
  2251. * THIS MEANS S, OR STORAGE,
  2252.  
  2253. TSDES VFD 3/0,3/1,3/1,3/0,48/0
  2254. VFD 3/0,3/0,3/0,3/0,48/0
  2255. VFD 3/0,3/3,3/1,3/0,48/0
  2256. VFD 3/0,3/3,3/1,3/0,48/0
  2257. VFD 3/0,3/3,3/1,3/2,48/0
  2258. VFD 3/0,3/2,3/0,3/0,48/0
  2259. VFD 3/0,3/0,3/0,3/0,48/0
  2260. VFD 3/0,3/0,3/0,3/0,48/0
  2261. VFD 3/0,3/1,3/0,3/0,48/0
  2262. VFD 3/0,3/0,3/0,3/0,48/0
  2263. VFD 3/0,3/0,3/0,3/0,48/0
  2264. VFD 3/0,3/2,3/0,3/0,48/0
  2265. VFD 60/0
  2266.  
  2267.  
  2268. * SYSTEM NAMES FOR WHICH -TSLINK- IS ALLOWED
  2269.  
  2270. MNE DATA 0LMNE
  2271. PCA DATA 0LPCA
  2272. PEA DATA 0LPEA
  2273. PWA DATA 0LPWA
  2274. S1 DATA 0LA02
  2275. .TSL ELSE
  2276. SB1 73 BAD COMMAND NAME
  2277. EQ =XERR
  2278. .TSL ENDIF
  2279. ENDOV
  2280. IPCC TITLE -IPC- / -CHARCNV- COMMAND READ IN
  2281. ** COMMAND READIN FOR -IPC- / -CHARCNV-
  2282. *
  2283. * IPC CONNECT
  2284. * IPC DISCONNECT
  2285. * IPC SEND,MESSAGE,LENGTH,ID,ADDRESS
  2286. * IPC GET,MESSAGE,LENGTH,ID,ADDRESS
  2287. * IPC STATUS,NUMBER,INMSG,OUTMSG
  2288. * IPC RESET
  2289. *
  2290. * CHARCNV PLATO,BUF1,LEN1,BUF2,LEN2,LEN3
  2291. * CHARCNV ASCII,BUF1,LEN1,BUF2,LEN2,LEN3
  2292. *
  2293. * LEN1 = SOURCE BUFFER LENGTH IN SOURCE CHARACTERS
  2294. * LEN2 = MAXIMUM DESTINATION BUFFER LENGTH IN WORDS
  2295. * /--- BLOCK TSLINKC 00 000 80/08/28 09.33
  2296. * LEN3 = DESTINATION BUFFER LENGTH IN CHARACTERS
  2297. SPACE 5,11
  2298. IPCC OVRLAY
  2299.  
  2300. * /--- BLOCK TSLINKC 00 000 80/08/28 09.33
  2301. CALL SYSTEST VERIFY A SYSTEM LESSON
  2302.  
  2303. * DETERMINE IPC KEYWORD
  2304.  
  2305. CALL NXTNAM
  2306. BX7 X1
  2307. SA7 LASTKEY
  2308. SB2 B0
  2309. SA2 IPCCA -IPC- KEYWORD TABLE
  2310. SA1 OVARG1
  2311. ZR X1,IPCC1 IF IPC COMMAND
  2312. SA2 IPCCB -CHARCNV- KEYWORD TABLE
  2313. IPCC1 ZR X2,ERRNAME IF KEYWORD NOT FOUND
  2314. IX3 X6-X2
  2315. ZR X3,IPCC2 IF KEYWORD FOUND
  2316. SB2 B2+1
  2317. SA2 A2+2
  2318. EQ IPCC1 CHECK NEXT ENTRY
  2319.  
  2320. IPCC2 SX6 1 COUNT TAGS IN VARBUF
  2321. SA6 VARBUF
  2322. SX6 B2
  2323. SA6 VARBUF+1 SET IPC COMMAND TYPE
  2324. SA2 A2+1 (X2) = COMMAND DESCRIPTOR
  2325. MX0 -6
  2326. LX2 6
  2327. BX6 X2
  2328. SA6 IPCCC SAVE DESCRIPTOR WORD
  2329. BX6 -X0*X2
  2330. SA6 IPCCD SAVE ARGUMENT COUNT
  2331.  
  2332. * PROCESS ARGUMENTS
  2333.  
  2334. IPC3 SA1 IPCCD
  2335. NZ X1,IPC4 IF MORE ARGUMENTS
  2336. SA1 LASTKEY VERIFY NOT TOO MANY ARGUMENTS
  2337. NZ X1,ERR2MNY IF MORE ARGUMENTS
  2338. EQ MRKLAST PACK COMMAND ARGUMENTS
  2339.  
  2340. IPC4 SX6 X1-1 DECREMENT ARGUMENTS LEFT
  2341. SA6 A1
  2342. SA1 IPCCC
  2343. MX0 -6
  2344. LX1 6
  2345. BX6 X1
  2346. SA6 A1 SAVE DESCRIPTOR WORD
  2347. BX1 -X0*X1
  2348. SA2 LASTKEY
  2349. ZR X2,ERR2FEW IF NO MORE ARGUMENTS
  2350. SX2 X2-1R,
  2351. NZ X2,ERRTERM IF NO A COMMA SEPARATOR
  2352. ZR X1,IPC5 IF READ-ONLY ARGUMENT OKAY
  2353.  
  2354. * PROCESS STOREABLE ARGUMENTS
  2355.  
  2356. CALL VARDO2
  2357. SA1 VARBUF
  2358. SA1 VARBUF+X1 (X1) = LAST ARGUMENT
  2359. NG X1,ERRSTOR IF NOT STORABLE
  2360. EQ IPC3 PROCESS NEXT ARGUMENT
  2361.  
  2362. * PROCESS READ-ONLY ARGUMENTS
  2363.  
  2364. IPC5 CALL VARDO2
  2365. EQ IPC3
  2366.  
  2367. * IPC KEYWORD / ARGUMENT TABLE
  2368. *
  2369. * 6/ARGUMENT COUNT
  2370. * 6/0 - READ-ONLY, 1 - STORABLE
  2371.  
  2372. IPCCA DATA 0LCONNECT
  2373. VFD 6/0,54/0
  2374. DATA 0LDISCONNECT
  2375. VFD 6/0,54/0
  2376. DATA 0LSEND
  2377. VFD 6/4,6/1,6/0,6/0,6/0,30/0
  2378. DATA 0LGET
  2379. VFD 6/4,6/1,6/1,6/1,6/1,30/0
  2380. DATA 0LSTATUS
  2381. VFD 6/3,6/1,6/1,6/1,36/0
  2382. DATA 0LRESET
  2383. VFD 6/0,54/0
  2384. DATA 0
  2385.  
  2386. IPCCB DATA 0LPLATO
  2387. VFD 6/5,6/1,6/0,6/1,6/0,6/1,24/0
  2388. DATA 0LASCII
  2389. VFD 6/5,6/1,6/0,6/1,6/0,6/1,24/0
  2390. DATA 0
  2391.  
  2392. * /--- BLOCK TSLINKC 00 000 80/08/28 09.33
  2393. IPCCC DATA 0 DESCRIPTOR WORD
  2394. IPCCD DATA 0 ARGUMENT COUNT
  2395.  
  2396. ENDOV
  2397. * /--- BLOCK NSETOV 00 000 79/02/04 15.42
  2398. TITLE NAMESET COMMAND READINS
  2399. *
  2400. *
  2401. NSETOV OVRLAY
  2402. *
  2403. SA1 OVARG1 GET OVARLAY ARGUMENT
  2404. SB1 X1
  2405. JP B1+*+1 JUMP TO ROUTINE FOR COMMAND
  2406. *
  2407. + EQ SETNAMC 0 = -SETNAME- COMMAND
  2408. + EQ GETNAMC 1 = -GETNAME- COMMAND
  2409. + EQ RENAMEC 2 = -RENAME- COMMAND
  2410. + EQ ADDNAMC 3 = -ADDNAME- COMMAND
  2411. + EQ NAMESC 4 = -NAMES- COMMAND
  2412. + EQ DELRECC 5 = -DELRECS- COMMAND
  2413. + EQ ADDRECC 6 = -ADDRECS- COMMAND
  2414. * /--- BLOCK SETNAME 00 000 79/02/04 15.35
  2415. *
  2416. * SETNAME HAS THE FOLLOWING FORMS --
  2417. *
  2418. * -SETNAME <VAR>- VAR CONTAINS FIRST WORD OF NAME
  2419. * -SETNAME NEXTNAME- SET TO NEXT NAME IN SEQUENCE
  2420. * -SETNAME BACKNAME- SET TO PREVIOUS NAME IN SEQ.
  2421. * -SETNAME (BLANK)- INDICATE NO NAME SELECTED
  2422. *
  2423. SETNAMC CALL NXTNAMP GET NEXT TAG IN X6
  2424. * X6 = TAG, WORDPT NOT UPDATED IN CASE TAG NOT -NEXTNAME-
  2425. SX7 1 1 = NEXTNAME TAG
  2426. SA1 NEXTNAME X1 = 8LNEXTNAME
  2427. BX1 X6-X1
  2428. ZR X1,SETNAM2 --- IF SO, SET TYPE CODE
  2429. SX7 2 2 = BACKNAME TAG
  2430. SA1 BACKNAME X1 = 8LBACKNAME
  2431. BX1 X6-X1
  2432. ZR X1,SETNAM2 --- IF SO, SET TYPE CODE
  2433. SX7 3 3 = BLANK TAG
  2434. SA1 TAGCNT GET NUMBER OF TAGS
  2435. ZR X1,SETNAM2 --- IF NONE, SET TYPE CODE
  2436. CALL VARDO1 GET ARGUMENT
  2437. SA1 VARBUF+1 GET FIRST GETVAR CODE
  2438. PL X1,SETNAM1 --- JUMP IF STOREABLE ADDRESS
  2439. MX0 -XCODEL MASK FOR GETVAR CODE
  2440. BX1 -X0*X1 MASK OFF STORABILITY FLAG
  2441. MX6 1
  2442. LX6 XCODEL SHIFT TO TOP BIT OF GETVAR
  2443. BX1 X6+X1 INSERT TOP BIT = NOT STORABLE
  2444. *
  2445. SETNAM1 BX6 X1 0 = NAME SPECIFIED
  2446. LX6 -2*XCODEL SHIFT TO SECOND 20 BITS
  2447. SA2 LASTKEY
  2448. NZ X2,ERR2MNY ONLY ALLOW ONE ARGUMENT
  2449. EQ PUTCODE
  2450. *
  2451. SETNAM2 BX6 X7
  2452. LX6 -XCODEL SHIFT TO TOP 20 BITS
  2453. EQ PUTCODE
  2454. *
  2455. NEXTNAME DATA 8LNEXTNAME
  2456. BACKNAME DATA 8LBACKNAME
  2457. * /--- BLOCK GETNAME 00 000 79/02/04 15.35
  2458. *
  2459. *
  2460. * GETNAME HAS ONE OR TWO ARGUMENTS --
  2461. * 1ST = STARTING VARIABLE IN WHICH TO STORE NAME
  2462. * 2ND = (OPTIONAL) LOCATION TO STORE EXTRA INFO
  2463. *
  2464. GETNAMC CALL VARDO GET ARGUMENTS
  2465. SA1 VARBUF CHECK NUMBER OF TAGS
  2466. SX2 X1-3
  2467. PL X2,ERR2MNY --- ERROR IF TOO MANY TAGS
  2468. SA2 VARBUF+1 CHECK IF STORABLE
  2469. NG X2,ERRSTOR --- 1ST ARG MUST BE STORABLE
  2470. SX2 X1-2 CHECK IF TWO ARGUMENTS
  2471. NG X2,MRKLAST --- PACK UP SINGLE ARGUMENT
  2472. SA2 VARBUF+2 CHECK IF STORABLE
  2473. NG X2,ERRSTOR --- 2ND ARG MUST BE STORABLE
  2474. EQ MRKLAST EXIT TO PACK UP TAGS
  2475. *
  2476. *
  2477. *
  2478. * RENAME HAS ONE OR TWO ARGUMENTS --
  2479. * 1ST = STARTING VARIABLE IN WHICH TO STORE NAME
  2480. * 2ND = (OPTIONAL) LOCATION OF NEW EXTRA INFO
  2481. *
  2482. RENAMEC CALL VARDO OBTAIN ARGUMENTS
  2483. SA1 VARBUF CHECK NUMBER OF TAGS
  2484. SX2 X1-3
  2485. NG X2,RENAME1 OK IF .LE. 2 ARGS
  2486. SA2 SYSFLG (X2) = SYSTEM LESSON FLAGS
  2487. LX2 ZSLDSHF POSITION SYSTEM COMMAND FLAG
  2488. PL X2,ERR2MNY --- ERROR IF NOT SYSTEM LESSON
  2489. SX2 X1-4 3 ARGS IS OK FOR SYSTEM LESSON
  2490. PL X2,ERR2MNY --- ERROR IF .GT. 3 ARGS
  2491. RENAME1 SA2 VARBUF+1 (X2) = FIRST ARG
  2492. NG X2,ERRSTOR --- 1ST ARG MUST BE STORABLE
  2493. EQ MRKLAST EXIT TO PACK UP TAGS
  2494. * /--- BLOCK ADDNAME 00 000 79/09/11 03.13
  2495. *
  2496. * ADDNAME HAS UP TO THREE ARGUMENTS--
  2497. * 1ST = STARTING VARIABLE CONTAINING NAME
  2498. * 2ND = NUMBER OF RECORDS (OPTIONAL)
  2499. * 3RD = EXTRA INFO (OPTIONAL)
  2500. *
  2501. ADDNAMC RJ VARDO COMMA SEPARATED VARIABLES
  2502. SA1 VARBUF GET NUMBER OF ARGS FOUND
  2503. SX2 X1-4
  2504. NG X2,ADDNAM1 OK IF .LE. 3 ARGS
  2505. SA2 SYSFLG (X2) = SYSTEM LESSON FLAGS
  2506. LX2 ZSLDSHF POSITION SYSTEM COMMAND FLAG
  2507. PL X2,ERR2MNY --- ERROR IF NOT SYSTEM LESSON
  2508. SX2 X1-5 4 ARGS IS OK FOR SYSTEM LESSON
  2509. PL X2,ERR2MNY --- ERROR IF .GT. 4 ARGS
  2510. ADDNAM1 SA2 VARBUF+1 (X2) = FIRST ARG
  2511. NG X2,ERRSTOR --- 1ST ARG MUST BE STOREABLE
  2512. EQ MRKLAST FINISH PROCESSING
  2513. *
  2514. * -NAMES- HAS FOUR ARGUMENTS-
  2515. *
  2516. * 1ST = ORDINAL NUMBER OF FIRST NAME
  2517. * ...OR IT CAN BE OMITTED.
  2518. * 2ND = STARTING LOCATION OF USER BUFFER
  2519. * 3RD = SIZE OF USER BUFFER IN WORDS
  2520. * 4TH = VARIABLE TO RETURN COUNT
  2521. *
  2522. NAMESC RJ VARDO COMMA SEPARATED VARIABLES
  2523. SA1 VARBUF GET NUMBER OF ARGS FOUND
  2524. SX2 X1-3 SEE IF 1ST ARG IS TO BE OMITTED
  2525. NZ X2,NAMES4 --- BRIF IF NOT 3 ARG CASE
  2526. SX6 X1+1 RESET *VARBUF* TO A 4 ARG CASE
  2527. SA6 A1
  2528. *
  2529. SA1 VARBUF+3 ... SHUFFLE OTHER ARGS DOWN
  2530. SA2 A1-1
  2531. BX7 X1
  2532. BX6 X2
  2533. SA7 A1+1 VARBUF+4 _ VARBUF+3
  2534. SA6 A1 VARBUF+3 _ VARBUF+2
  2535. SA1 VARBUF+1
  2536. BX6 X1
  2537. SA6 A2 VARBUF+2 _ VARBUF+1
  2538.  
  2539. MX6 1 NOW MARK FIRST ARGUMENT OMITTED
  2540. LX6 XCODEL
  2541. SA6 VARBUF+1 STORE AS A DUMMY ARGUMENT
  2542. SA1 VARBUF
  2543. EQ NAMES2 ... NOW CHECK OTHER ARGUMENTS
  2544. *
  2545. NAMES4 SX2 X1-4
  2546. NZ X2,ERRTAGS --- IS NO GOOD IF NOT 3 OR 4 ARGS
  2547. NAMES2 SA2 VARBUF+2
  2548. NG X2,ERRSTOR --- 2ND ARG MUST BE STOREABLE
  2549. SA2 VARBUF+4
  2550. NG X2,ERRSTOR --- 4TH ARG MUST BE STOREABLE
  2551. EQ VARFIN FINISH PROCESSING
  2552. *
  2553. * ADDRECS, DELRECS CAN HAVE 1 OR 2 ARGUMENTS--
  2554. * 1ST = NUMBER OF RECORDS TO ADD (AT END)
  2555. * OR
  2556. * 1ST = RECORD NUMBER THAT NEW RECORDS START AT
  2557. * 2ND = NUMBER OF RECORDS
  2558. *
  2559. DELRECC BSS 0
  2560. ADDRECC RJ VARDO GET COMMA SEPARATED VARIABLES
  2561. SA1 VARBUF GET NUMBER OF ARGS FOUND
  2562. SX2 X1-3
  2563. PL X2,ERR2MNY
  2564. EQ MRKLAST FINISH PROCESSING
  2565. * /--- BLOCK ENDOV 00 000 79/02/04 15.39
  2566. *
  2567. ENDOV
  2568. * /--- BLOCK COVL3B 00 000 81/05/12 15.01
  2569. *
  2570. COVL3B OVRLAY
  2571. SA1 OVARG1
  2572. SB1 X1
  2573. JP B1+*+1
  2574. *
  2575. + EQ SETSYSC 0 = -SETSYS- COMMAND
  2576. + EQ FILNAMC 1 = -FILENAM- COMMAND
  2577. + EQ NVERSC 2 = -NVERS- COMMAND
  2578. + EQ NETIOC 3 = -NETIO- COMMAND
  2579. + EQ ITOAC 4 = -ITOA- COMMAND
  2580. + EQ OTOAIN 5 = -OTOA- -HTOA- COMMANDS
  2581. + EQ DIOC 6 = -DREAD- -DWRITE- COMMANDS
  2582. + EQ DATAIOC 7 = -DATAIN- -DATAOUT- COMMANDS
  2583. + EQ FIOC 8 = -READF- -WRITEF- COMMANDS
  2584. + EQ READIN 9 = -READECS- -READTCM-
  2585. + EQ WREADIN 10 = -WRITECS- -WRITTCM-
  2586. + EQ SBREADC 11 = -SBREAD- -READLES-
  2587. + EQ SBWRITC 12 = -SBWRITE- -WRITLES-
  2588. + EQ SBCHANC 13 = -SBCHANG- -STCHANG-
  2589. + EQ SIZEC 14 = -SIZE-
  2590. + EQ TEXTNIN 15 = TEXTN
  2591. + EQ TRANSIN 16 = TRANSFR
  2592. * /--- BLOCK SETSYS 00 000 85/07/29 15.37
  2593. TITLE -SETSYS- COMMAND
  2594. *
  2595. * -SETSYS- HAS THE FOLLOWING FORMS --
  2596. *
  2597. * SETSYS NEXTSYS,(BUFFER),(LTH)
  2598. * SETSYS BACKSYS,(BUFFER),(LTH)
  2599. * SETSYS (SYSTEM),(BUFFER),(LTH)[,RID]
  2600. *
  2601. SETSYSC CALL SYSTEST MUST BE SYSTEM LESSON
  2602. *
  2603. SA1 TAGCNT
  2604. ZR X1,ERR2FEW -- ERROR EXIT
  2605. *
  2606. CALL NXTNAMP GET FIRST TAG IN X6
  2607. * X6 = TAG, B1 = NEXT *WORDPT*, X1 = TERMINATOR CHARACTER
  2608. *
  2609. MX7 0 0 = NEXTSYS TAG
  2610. SA2 NEXTSYS X2 = 7LNEXTSYS
  2611. BX2 X6-X2
  2612. ZR X2,SETSYS2
  2613. *
  2614. SX7 1 1 = BACKSYS TAG
  2615. SA2 BACKSYS X2 = 7LBACKSYS
  2616. BX2 X6-X2
  2617. NZ X2,SETSYS3 NOT *NEXTSYS* OR *BACKSYS*
  2618. *
  2619. SETSYS2 MX6 1 BUILD SPECIAL CODE
  2620. LX6 XCODEL
  2621. BX6 X6+X7
  2622. SX7 B1 UPDATE *WORDPT*
  2623. SA6 VARBUF+1
  2624. SA7 WORDPT
  2625. SX6 1
  2626. SA6 VARBUF SHOW ONE ARGUMENT SO FAR
  2627. EQ SETSYS4 CONTINUE TO SECOND TAG
  2628. *
  2629. SETSYS3 CALL VARDO1 GET SYSTEM NAME AS FIRST ARG
  2630. SA1 LASTKEY GET DELIMITER
  2631. *
  2632. SETSYS4 ZR X1,ERR2FEW --- ERROR IF NO BUFFER GIVEN
  2633. *
  2634. CALL VARDO2 GET BUFFER ADDRESS
  2635. NZ B1,ERRSTOR -- ERROR IF NOT STORABLE
  2636. SA1 LASTKEY CHECK IF DONE
  2637. ZR X1,ERR2FEW -- MUST SPECIFY BUFFER LTH
  2638. *
  2639. CALL VARDO2 GET BUFFER LENGTH
  2640. SA2 LASTKEY CHECK IF MORE ARGS
  2641. MX7 0
  2642. ZR X2,SETSYS9 -- EXIT IF DONE
  2643. *
  2644. CALL NXTNAM CHECK FOR RID KEYWORD
  2645. NZ X1,ERR2MNY --- ERROR IF MORE ARGS
  2646. SA1 RIDTAG
  2647. BX1 X1-X6
  2648. SX7 1
  2649. NZ X1,ERRNAME --- ERROR IF NOT -RID-
  2650. SETSYS9 BSS 0
  2651. MX6 1
  2652. LX6 XCODEL FLAG SPECIAL ARG
  2653. BX6 X6+X7
  2654. SA6 VARBUF+4
  2655. SX1 4 (VARFIN REQUIRES NUM OF TAGS)
  2656. BX6 X1
  2657. SA6 VARBUF ALSO SET TO 4
  2658. EQ VARFIN -- EXIT
  2659. *
  2660. *
  2661. NEXTSYS DATA 7LNEXTSYS
  2662. BACKSYS DATA 7LBACKSYS
  2663. RIDTAG DATA 3LRID
  2664. *
  2665. *
  2666. * /--- BLOCK FILENAM 00 000 85/07/29 15.34
  2667. TITLE -FILENAM- COMMAND
  2668. *
  2669. * -FILENAM- HAS TWO POSSIBLE FORMS --
  2670. *
  2671. * FILENAM ACCOUNT';FILE,ONEWORD (FORM 0)
  2672. * FILENAM ONEWORD,ACCOUNT';FILE (FORM 1)
  2673. *
  2674. * THE FIRST GETVAR CODE IS SET UP AS A FAKE ARGUMENT
  2675. * TO INDICATE WHICH FORM IS USED.
  2676. *
  2677.  
  2678. FILNAMC BSS 0
  2679. SA1 TAGCNT
  2680. ZR X1,ERR2FEW IF BLANK TAG
  2681.  
  2682. * LOOK FOR COLON TO DETERMINE WHICH FORM IS USED
  2683.  
  2684. CALL COLONCK SEE IF COLON AFTER FIRST ARG
  2685. ZR X6,FN10 IF FIRST SEPARATOR IS COLON
  2686. SX6 1 SET TO FORM 1
  2687. FN10 SA6 VARBUF+1 SET UP FIRST GETVAR CODE
  2688. SX6 1
  2689. SA6 VARBUF INITIALIZE TO 1 ARGUMENT SO FAR
  2690.  
  2691. * COMPILE FIRST REAL ARGUMENT
  2692.  
  2693. CALL VARDO2
  2694. SA1 LASTKEY CHECK FOR END OF LINE
  2695. ZR X1,ERR2FEW IF ONLY ONE ARGUMENT
  2696. CALL COLONCK SEE IF NEXT SEPARATOR IS COLON
  2697. SA1 VARBUF+1 RETRIEVE COMMAND FORM
  2698. ZR X1,FN15 IF FIRST SEPARATOR WAS COLON
  2699. ZR X6,FN20 IF SECOND SEPARATOR WAS COLON
  2700. EQ ERRTERM IF NO COLON AT ALL
  2701.  
  2702. FN15 ZR X6,ERRTERM IF BOTH SEPARATORS ARE COLONS
  2703.  
  2704. * COMPILE SECOND ARGUMENT
  2705.  
  2706. CALL VARDO2 GENERATE GETVAR CODE
  2707. EQ FN30
  2708. FN20 CALL PUTDO2 GENERATE PUTVAR CODE
  2709.  
  2710. * COMPILE THIRD ARGUMENT
  2711.  
  2712. FN30 SA1 LASTKEY CHECK FOR END OF LINE
  2713. ZR X1,ERR2FEW IF NO THIRD ARGUMENT
  2714. CALL PUTDO2 ALWAYS PUTVAR CODE FOR 3RD ARG
  2715.  
  2716. SA1 LASTKEY
  2717. NZ X1,ERR2MNY IF MORE THAN 3 ARGUMENTS
  2718. SX1 4 NUMBER OF GETVAR CODES ALLOWED
  2719. EQ VARFIN
  2720. * /--- BLOCK NVERS 00 000 85/07/29 15.34
  2721. TITLE -NVERS- COMMAND
  2722. *
  2723. * -NVERS- COMMAND
  2724. *
  2725. * NVERS ACCOUNT';FILE,ACCOUNT';FILE
  2726. *
  2727. * CONVERTS SPECIFIED FILE NAME TO ITS N-VERSION FORM.
  2728. *
  2729. NVERSC BSS 0
  2730.  
  2731. CALL SYSTEST SYSTEM LESSONS ONLY
  2732.  
  2733. CALL ACCFILE,VARBUF+1,0 GET FIRST FILE NAME
  2734.  
  2735. SA1 LASTKEY
  2736. ZR X1,ERR2FEW
  2737. CALL COLONCK LOOK FOR COLON IN 2ND NAME
  2738. NZ X6,NV20 IF NO COLON
  2739.  
  2740. SX6 2
  2741. SA6 VARBUF 2 ARGUMENTS SO FAR
  2742. CALL VARDO2 VAR FOR ACCOUNT NAME RETURN
  2743. NG X6,ERRSTOR IF NOT STOREABLE
  2744.  
  2745. NV10 CALL VARDO2 VAR FOR FILE NAME RETURN
  2746. NG X6,ERRSTOR IF NOT STOREABLE
  2747. SA1 LASTKEY
  2748. NZ X1,ERR2MNY IF EXTRA ARGUMENTS
  2749. SX1 4 4 ARGUMENTS
  2750. EQ VARFIN
  2751.  
  2752. NV20 SX6 0 FAKE UP 3RD ARGUMENT
  2753. SA6 VARBUF+3
  2754. SX6 3
  2755. SA6 VARBUF
  2756. EQ NV10
  2757. * /--- BLOCK NETIO 00 000 79/02/04 23.36
  2758. TITLE NETWORK I/O COMMAND - NETIO
  2759. *
  2760. * -NETIO- (CODE = 107)
  2761. *
  2762. * NETIO REQUEST,RESPONSE
  2763. *
  2764. * REQUEST AND RESPONSE MUST BE STOREABLE VAIABLES.
  2765. *
  2766. NETIOC BSS 0
  2767.  
  2768. * ALLOW ONLY SYSTEM LESSONS WITH -NETIO- PERMISSION.
  2769.  
  2770. SA1 SYSFLG
  2771. LX1 ZSLDSHF
  2772. PL X1,ERRORC IF NOT A SYSTEM LESSON
  2773. LX1 ZNIOSHF-ZSLDSHF
  2774. PL X1,ERRORC IF NO -NETIO- PERMISSION
  2775. *
  2776. * * * COMPILE PARAMETERS
  2777. CALL VARDO
  2778. *
  2779. * * * CHECK NUMBER OF ARGUEMENTS, MUST BE TWO
  2780. SA1 VARBUF VARIABLE COUNT
  2781. SX2 X1-2
  2782. NG X2,ERR2FEW JUMP IF NOT ENOUGH
  2783. NZ X2,ERR2MNY JUMP IF TOO MANY
  2784. *
  2785. * * * BOTH ARGUEMENTS MUST BE STOREABLE
  2786. SA2 VARBUF+1 FIRST VARIABLE
  2787. NG X2,ERRSTOR JUMP IF NOT STOREABLE
  2788. SA2 VARBUF+2 SECOND VARIABLE
  2789. NG X2,ERRSTOR JUMP IF NOT STOREABLE
  2790. *
  2791. * * * PACK VARBUF VARIABLES (X1=VARIABLE COUNT)
  2792. EQ VARFIN
  2793. *
  2794. *
  2795. * /--- BLOCK OTOAIN 00 000 77/02/18 21.40
  2796. *
  2797. * -ITOA- (CODE=220)
  2798. *
  2799. * 1ST ENTRY=INTEGER,
  2800. * 2ND ENTRY=ALPHA STORAGE LOCATION
  2801. * 3RD ENTRY=RETURN ALPHA CHARACTER COUNT
  2802. *
  2803. ITOAC RJ VARDO ENCODE VARIABLES
  2804. SA1 VARBUF X1 = NUMBER OF VARIABLES
  2805. SX2 X1-2
  2806. NZ X2,ITOAC1 JUMP IF NOT 2 VARIABLES
  2807. SA1 VARBUF+1
  2808. SA2 VARBUF+2
  2809. NG X2,ERRSTOR MUST BE ABLE TO STORE INTO
  2810. MX0 -XCODEL
  2811. BX1 -X0*X1
  2812. BX2 -X0*X2
  2813. LX1 60-XCODEL
  2814. LX2 60-2*XCODEL
  2815. BX6 X1+X2
  2816. MX1 1
  2817. LX1 60-2*XCODEL
  2818. BX6 X6+X1 SET BIT TO FLAG 2 ARGS
  2819. EQ PUTCODE --- EXIT TO ADD COMMAND CODE AND STORE
  2820. ITOAC1 SX2 X2-1
  2821. NZ X2,ERRTAGS --- ERROR EXIT IF NOT 3 VARIABLES
  2822. SA2 VARBUF+2
  2823. NG X2,ERRSTOR MUST BE ABLE TO STORE INTO ALPHA STORAGE
  2824. SA2 VARBUF+3
  2825. NG X2,ERRSTOR MUST BE ABLE TO STORE CHAR COUNT
  2826. EQ VARFIN --- EXIT TO PACK UP VARIABLES
  2827. *
  2828. *
  2829. TITLE OTOA/HTOA
  2830. *
  2831. * -OTOA-
  2832. * -HTOA-
  2833. *
  2834. * FIRST ARG IS OCTAL WORD
  2835. * 2ND ARG GIVES FWA OF 2 WORD STOREABLE BUFFER
  2836. * TO CONTAIN THE 20 CHAR ALPHA STRING.
  2837. * OPTIONAL 3RD ARGUMENT IS CHARACTER COUNT
  2838. *
  2839. * FORCES GETVAR CODE OF 1ST ARG TO INTEGER
  2840. * CHECKS TO SEE THAT 2ND ARG IS STOREABLE
  2841. *
  2842. OTOAIN RJ VARDO
  2843. SA1 VARBUF X1= NO. OF ARGS
  2844. SX2 X1-2
  2845. ZR X2,OKTAGS --- IF 2 ARGS IT IS OK
  2846. SX2 X1-3
  2847. NZ X2,ERRTAGS --- ERROR IF NOT 2 OR 3 TAGS
  2848. OKTAGS SA2 VARBUF+1
  2849. MX0 1
  2850. LX0 18 2**17 BIT IS I/F FLAG
  2851. BX6 -X0*X2 MAKE GETVAR CODE INTEGER
  2852. SA6 A2 PUT IT BACK FOR VARFIN
  2853. SA2 VARBUF+2
  2854. NG X2,ERRSTOR --- ERROR IF 2ND NOT STOREABLE
  2855. EQ MRKLAST --- EXIT AND MARK LAST CODE
  2856. *
  2857. *
  2858. * /--- BLOCK DREAD 00 000 79/07/12 04.51
  2859. TITLE DREAD, DWRITE
  2860. * -DREAD- (CODE=193)
  2861. * -DWRITE- (CODE=194)
  2862. *
  2863. * MAY HAVE 2 OR 3 ARGUMENTS
  2864. *
  2865. *
  2866. DIOC RJ SYSTEST SYSTEM LESSON CHECK
  2867. *
  2868. DIOC1 SX6 1 SET UP SHORT LITERAL
  2869. SA6 VARBUF+3
  2870. RJ VARDO DECODE VARIABLES TO *VARBUF*
  2871. SA1 VARBUF
  2872. SX2 X1-2
  2873. ZR X2,DIOC2 OK IF 2 ARGUMENTS
  2874. SX2 X1-3
  2875. NZ X2,ERRTAGS --- ERROR IF NOT 3 ARGUMENTS
  2876. *
  2877. DIOC2 MX0 -XCODEL
  2878. SA1 VARBUF+1 LOAD 1ST -GETVAR- CODE
  2879. BX6 -X0*X1
  2880. LX6 60-XCODEL
  2881. SA1 VARBUF+2 LOAD 2ND -GETVAR- CODE
  2882. BX1 -X0*X1
  2883. LX1 60-2*XCODEL
  2884. BX6 X1+X6 COMBINE
  2885. SA1 VARBUF+3 LOAD 3RD -GETVAR- CODE
  2886. BX1 -X0*X1
  2887. LX1 60-3*XCODEL
  2888. BX6 X6+X1 FINISH UP XSTOR WORD
  2889. SA1 INX
  2890. SA6 X1+INFO PUT -GETVAR- CODES IN XSTOR
  2891. SX6 X1+1
  2892. SA6 A1 UPDATE XSTOR POINTER
  2893. BX6 X1
  2894. LX6 60-18 POSITION XSTOR POINTER
  2895. EQ PUTCODE
  2896. * /--- BLOCK DATAIOC 00 000 81/04/27 23.28
  2897. TITLE DATAIOC
  2898. *
  2899. *
  2900. * CONDENSE ROUTINE FOR -DATAIN- AND -DATAOUT-
  2901. * 1ST ARG = BLOCK NUMBER
  2902. * 2ND ARG = DATA LOCATION
  2903. * 3RD ARG = NUMBER OF RECORDS (OPTIONAL)
  2904. *
  2905. * DATA LOCATION CAN BE OF FOLLOWING TYPES -
  2906. *
  2907. * N1 STUDENT BANK (TYPE 0)
  2908. * V1 STUDENT BANK (TYPE 0)
  2909. * C,1 COMMON (TYPE 1)
  2910. * COMMON,1 COMMON (TYPE 1)
  2911. * S,1 STORAGE (TYPE 2)
  2912. * STORAGE,1 STORAGE (TYPE 2)
  2913. * NC1 CM VARIABLES (TYPE 3)
  2914. * VC1 CM VARIABLES (TYPE 3)
  2915. *
  2916. * REFERENCES TO NC/VC VARIABLES (TYPE 3) ARE
  2917. * CONDENSED AS N/V VARIABLES (TYPE 0). DURING THE
  2918. * BOUNDS CHECKS AT EXECUTION TIME THE NC/VC
  2919. * REFERENCES ARE DETECTED AND THE TYPE IS CHANGED.
  2920. * THIS IS NECESSARY SINCE REFERENCES LIKE NC(N1)
  2921. * ARE CONDENSED WITH COMPILED CODE AND CANNOT BE
  2922. * DETECTED EASILY HERE.
  2923. *
  2924. *
  2925. DATAIOC SA1 COMNUM -DATAOUT- IS PUBLISH ERROR
  2926. SB1 =XDATOT=
  2927. SB2 X1
  2928. NE B1,B2,DATIOC0 IF NOT -DATAOUT-
  2929. *
  2930. SB1 FSDATOT LOG PUBLISH ERROR
  2931. RJ =XPUBERRS
  2932. DATIOC0 CALL VARDO1 GET BLOCK NUMBER
  2933. SA1 LASTKEY GET TERMINATOR
  2934. SX1 X1-1R; INSIST ON PROPER SYNTAX
  2935. NZ X1,ERRTERM ERROR IF BAD SEPARATOR
  2936. SX7 DIO.SV PRESET FOR STUDENT VARIABLES
  2937. SA7 VARBUF+2 PRESET TYPE IN 2ND ARG
  2938. CALL NXTNAMR GET ANY SYMBOL
  2939. SX4 X1-1R, CHECK FOR COMMA
  2940. NZ X4,DATIOC3 JUMP IF NOT C,S
  2941. SX7 DIO.COM PRESET FOR COMMON
  2942. SA2 KCOM
  2943. BX2 X3*X2
  2944. IX2 X2-X6
  2945. ZR X2,DATIOC2 IF COMMON
  2946. SX7 DIO.STO PRESET FOR STORAGE
  2947. SA2 KSTO
  2948. BX2 X3*X2
  2949. IX2 X2-X6
  2950. NZ X2,DATIOC3 IF NOT STORAGE
  2951. DATIOC2 SA7 VARBUF+2 STORE TYPE AS 2ND ARG
  2952. SX7 B1 B1 HAS BEEN SAVED TO HERE
  2953. SA7 WORDPT
  2954. DATIOC3 SX6 2
  2955. SA6 VARBUF RESET ARGS TO 2
  2956. CALL VARDO2 GET DATA LOCATION
  2957. SA2 VARBUF+2 TYPE CODE
  2958. NZ X2,DATIOC4 IF NOT STUDENT BANK
  2959. NZ B1,ERRSTOR ERROR IF NOT STOREABLE
  2960. DATIOC4 SX6 1 CONSTANT 1
  2961. SA6 VARBUF+4 PRESET NUMBER OF RECORDS
  2962. SA1 LASTKEY GET TERMINATOR
  2963. ZR X1,DATIOC5 IF ONLY 2 ARGS
  2964. SX1 X1-1R; INSIST ON PROPER SYNTAX
  2965. NZ X1,ERRTERM ERROR IF BAD SEPARATOR
  2966. CALL VARDO2 GET NUMBER OF RECORDS
  2967. SA1 LASTKEY GET FINAL TERMINATOR
  2968. * /--- BLOCK DATAIOC 00 000 81/04/27 23.28
  2969. NZ X1,ERR2MNY ERROR IF NOT E-O-L
  2970. DATIOC5 SX1 4 4 ARGS REQUIRED
  2971. BX6 X1
  2972. SA6 VARBUF AND GUARANTEED IN ALL CASES
  2973. EQ VARFIN
  2974. *
  2975. KCOM DATA 6LCOMMON
  2976. KSTO DATA 7LSTORAGE
  2977. *
  2978. * /--- BLOCK FIOC 00 000 77/03/10 00.15
  2979. EJECT
  2980. *
  2981. * -READF- (CODE = 450)
  2982. * -WRITEF- (CODE = 451)
  2983. *
  2984. * READF FIP,BLOCK NUMBER,STORAGE ADDRESS,NO. BLOCKS
  2985. *
  2986. * NO. OF BLOCKS IS AN OPTIONAL PARAMETER WHICH IS
  2987. * ASSUMED ONE IF MISSING. FILE INFORMATION
  2988. * PACKET(FIP) MUST BE A STOREABLE VARIABLE.
  2989. *
  2990. FIOC BSS 0
  2991. *
  2992. * * * MUST BE SYSTEM LESSON
  2993. CALL SYSTEST
  2994. *
  2995. * * * INITIALIZE NO. OF BLOCKS AND NO. OF ARGUMENTS TO 1
  2996. SX6 1
  2997. SA6 VARBUF+4 PUT IN FOURTH PARAMETER SLOT
  2998. SA6 VARBUF NUMBER OF ARGUMENTS
  2999. *
  3000. * * * EVALUATE THE FIRST ARGUMENT
  3001. CALL COMPILE
  3002. NZ B1,ERRSTOR ERROR IF NOT STOREABLE
  3003. *
  3004. * * * PUT GETVAR CODE INTO BUFFER.
  3005. BX6 X1
  3006. SA6 VARBUF+1
  3007. *
  3008. * * * COMPILE THE REMAINING ARGUMENTS
  3009. FIOC1 BSS 0
  3010. SA1 LASTKEY WAS THAT THE LAST ONE
  3011. ZR X1,FIOC2 JUMP IF NO MORE
  3012. CALL VARDO2 COMPILE NEXT ARGUMENT
  3013. EQ FIOC1
  3014. *
  3015. * * * CHECK FOR CORRECT NUMBER OF ARGUMENTS
  3016. FIOC2 BSS 0
  3017. SA1 VARBUF ARGUMENT COUNT
  3018. SX2 X1-4
  3019. ZR X2,FIOC3 JUMP IF 4
  3020. SX2 X1-3
  3021. NZ X2,ERRTAGS ERROR IF NOT 3 OR 4
  3022. *
  3023. * * * ONLY THREE ARGUMENTS FORCE TO FOUR
  3024. SX1 X1+1
  3025. *
  3026. * * * SET NUMBER OF VARIABLES AND GO PACK CODES
  3027. FIOC3 BSS 0
  3028. BX6 X1
  3029. SA6 VARBUF
  3030. EQ VARFIN
  3031. * /--- BLOCK READECS 00 000 79/03/20 20.14
  3032. *
  3033. TITLE -READECS-
  3034. * -READECS- (CODE=182)
  3035. * -READTCM- (CODE=248)
  3036. *
  3037. READIN RJ SYSTEST CHECK IF SYSTEM LESSON
  3038. READIN1 RJ VARDO COMMA SEPARATED VARIABLES
  3039. SA1 VARBUF+1
  3040. NG X1,ERRSTOR ERROR IF VARIABLE NOT STOREABLE
  3041. SX1 3 MUST BE 3 VARIABLES
  3042. EQ VARFIN --- EXIT TO STORE CODE
  3043. *
  3044. *
  3045. * -WRITECS- (CODE=219)
  3046. * -WRITTCM- (CODE=250)
  3047. *
  3048. WREADIN RJ SYSTST1 CHECK IF SPECIAL SYSTEM LESSON
  3049. EQ READIN1
  3050. *
  3051. *
  3052. *
  3053. * -SBREAD- (CODE=148)
  3054. * -READLES-
  3055. *
  3056. SBREADC RJ SYSTEST CHECK IF SYSTEM LESSON
  3057. SBREAD1 RJ VARDO COMMA SEPARATED VARIABLES
  3058. SA1 VARBUF+3
  3059. NG X1,ERRSTOR 3RD ARG MUST BE STORABLE
  3060. SX1 4 MUST BE 4 VARIABLES
  3061. EQ VARFIN --- EXIT TO STORE CODE
  3062. *
  3063. * -SBWRITE- (CODE=149)
  3064. * -WRITLES-
  3065. *
  3066. SBWRITC RJ SYSTST1 CHECK IF SPECIAL SYSTEM LESSON
  3067. EQ SBREAD1
  3068.  
  3069. * -SBCHANG- (CODE = 314)
  3070. * -STCHANG- (CODE = 315)
  3071.  
  3072. SBCHANC RJ SYSTST1 CHECK IF SPECIAL SYSTEM LESSON
  3073. RJ VARDO PROCESS COMMA-SEPARATED ARGS
  3074. SX1 4 THERE MUST BE 4 ARGUMENTS
  3075. EQ VARFIN PACK UP GETVAR CODES AND EXIT
  3076.  
  3077. TITLE -SIZE- COMMAND.
  3078. ** SIZEC - SIZE COMMAND CONDENSE ROUTINE.
  3079. *
  3080. * COMMAND SYNTAX -
  3081. * SIZE <BLANK>
  3082. * SIZE 2
  3083. * SIZE 2,1.5
  3084. * SIZE BOLD
  3085.  
  3086. * CHECK FOR -BOLD- KEYWORD. IF NOT BOLD, JUMP
  3087. * TO STANDARD CONDENSE ROUTINE ',ONE2IN0', TO
  3088. * PROCESS ZERO TO TWO ARGUMENT COMMANDS.
  3089.  
  3090. SIZEC RJ NXTNAMP
  3091. SA1 BOLDNAM
  3092. BX1 X6-X1
  3093. NZ X1,=XONE2IN0 IF NOT -BOLD-
  3094.  
  3095. * MAKE SURE THERE ARE NO MORE TAGS.
  3096.  
  3097. SX2 X2-EOL
  3098. NZ X2,ERR2MNY IF NOT END OF LINE
  3099.  
  3100. * SET BIT 58 TO INDICATE THAT THIS IS A -SIZE BOLD-.
  3101.  
  3102. MX6 1
  3103. LX6 58-59+60
  3104. EQ PUTCODE
  3105.  
  3106. BOLDNAM DATA 4LBOLD
  3107.  
  3108. * /--- BLOCK TEXTN 00 000 83/06/13 11.57
  3109. TITLE TEXTN COMMAND READIN
  3110. *
  3111. * ALLOWS 4 OR 5 OR 6 OR 7 ARGUMENTS WITH LAST
  3112. * ARGUMENT MARKED WITH SIGN BIT SET.
  3113. * FIRST AND SECOND ARGUMENTS MUST BE STOREABLE.
  3114. *
  3115. *
  3116. TEXTNIN RJ VARDO COMMA SEPARATED VARIABLES
  3117. SA1 VARBUF+1 FIRST GETVAR WORD
  3118. NG X1,ERRSTOR MUST BE STOREABLE
  3119. SA1 VARBUF+2 SECOND GETVAR WORD
  3120. NG X1,ERRSTOR MUST BE STOREABLE
  3121. SA1 VARBUF X1= NO. OF ARGS
  3122. SX2 X1-4
  3123. ZR X2,MRKLAST --- IF 4 ARGS IT IS OK
  3124. SX2 X1-5
  3125. ZR X2,MRKLAST --- IF 5 ARGS IT IS OK
  3126. SX2 X1-6
  3127. ZR X2,MRKLAST --- IF 6 ARGS IT IS OK
  3128. SX2 X1-7
  3129. ZR X2,MRKLAST --- IF 7 ARGS IT IS OK
  3130. EQ ERRTAGS --- EXIT TO CONDENSE ERROR
  3131. *
  3132. * /--- BLOCK TRANSFR 00 000 79/07/12 05.23
  3133. TITLE -TRANSFR-
  3134. *
  3135. *
  3136. *
  3137. * -TRANSFR- COMMAND READIN
  3138. *
  3139. TRANSIN SX6 2
  3140. SA6 VARBUF SET ARGS TO 2
  3141. MX6 0
  3142. SA6 VARBUF+2 CLEAR TRANSFER TYPE TO 0
  3143. CALL NXTNAMR GET FIRST SYMBOL
  3144. ZR X1,SYNERR CHECK FOR PREMATURE EOL
  3145. SX4 X1-1R, CHECK FOR COMMA
  3146. NZ X4,TRANSFR GO GET -FROM- IF NOT C,S
  3147. SB3 1 SET TYPE
  3148. SA2 KCOM
  3149. BX2 X3*X2
  3150. IX2 X2-X6
  3151. ZR X2,TRANSFC COMMON
  3152. SB3 B3+B3
  3153. SA2 KSTO
  3154. BX2 X3*X2
  3155. IX2 X2-X6
  3156. ZR X2,TRANSFC STORAGE
  3157. SB3 B3+1
  3158. SA2 KROUT
  3159. BX2 X3*X2
  3160. IX2 X2-X6
  3161. ZR X2,TFCR JUMP IF -ROUTER-
  3162. SB3 B3+1
  3163. SA2 KROUTV
  3164. BX2 X3*X2
  3165. IX2 X2-X6
  3166. NZ X2,TRANSFR NOT -ROUTVARS-
  3167. *
  3168. * /--- BLOCK TRANSFR 00 000 79/07/12 05.07
  3169. *
  3170. TFCR SA2 ROUTER
  3171. NZ X2,ERROUTR ERROR IF THIS IS A ROUTER
  3172. *
  3173. TRANSFC SX7 B3 PICK UP FLAG
  3174. SA7 VARBUF+2 STORE IN SECOND ARGUMENT
  3175. SX7 B1 B1 HAS BEEN SAVED TO HERE
  3176. SA7 WORDPT
  3177. *
  3178. *
  3179. TRANSFR CALL VARDO2 GET -FROM- VARIABLE
  3180. SA1 LASTKEY GET TERMINATOR
  3181. SX1 X1-1R; FORCE SYNTAX
  3182. NZ X1,ERRTERM TO BE CLEAR
  3183. EQ B1,B0,TRANST OK IF STOREABLE
  3184. SA3 VARBUF+2 GET TYPE OF TRANSFER
  3185. ZR X3,ERRSTOR ERROR IF -CM FROM- NOT A USER
  3186. * ARRAY ADDRESS
  3187. *
  3188. TRANST CALL NXTNAMR SCAN FOR NEXT TERMINATOR
  3189. ZR X1,SYNERR CHECK FOR PREMATURE EOL
  3190. SX4 X1-1R, CHECK FOR COMMA
  3191. NZ X4,TRANSTO GO GET -TO- IF NOT C,S
  3192. SB3 1 SET TYPE
  3193. SA2 KCOM
  3194. BX2 X3*X2
  3195. IX2 X2-X6
  3196. ZR X2,TRANSTC COMMON
  3197. SB3 B3+B3
  3198. SA2 KSTO
  3199. BX2 X3*X2
  3200. IX2 X2-X6
  3201. ZR X2,TRANSTC STORAGE
  3202. SB3 B3+1
  3203. SA2 KROUT
  3204. BX2 X3*X2
  3205. IX2 X2-X6
  3206. NZ X2,TRANSTO NOT ROUTER
  3207. SA2 ROUTER
  3208. NZ X2,ERROUTR ERROR IF THIS IS A ROUTER
  3209. *
  3210. * /--- BLOCK TRANSFR 00 000 79/07/12 05.08
  3211. *
  3212. TRANSTC SX7 B3 PICK UP TYPE
  3213. SA3 VARBUF+2
  3214. LX7 3 MOVE -TO- TYPE INTO PLACE
  3215. IX7 X7+X3 ADD IT IN
  3216. SA7 A3 RE-STORE
  3217. SX7 B1 B1 HAS BEEN PRESERVED
  3218. SA7 WORDPT
  3219. *
  3220. TRANSTO RJ VARDO2 GET -TO- ARGUMENT
  3221. SA1 LASTKEY GET TERMINATOR
  3222. SX1 X1-1R; FORCE SYNTAX
  3223. NZ X1,ERRTERM TO BE CLEAR
  3224. EQ B1,B0,TRANSL OK IF STOREABLE
  3225. SA3 VARBUF+2 GET TRANSFER TYPE
  3226. AX3 3 OF -TO- ARG
  3227. ZR X3,ERRSTOR ERROR IF -CM TO- ADDRESS NOT
  3228. * STOREABLE
  3229. *
  3230. TRANSL RJ VARDO2 GET -LENGTH-
  3231. SA1 LASTKEY CHECK FINAL TERMINATOR
  3232. NZ X1,ERR2MNY
  3233. SA1 VARBUF+5 PICK UP LENGTH
  3234. BX6 X1
  3235. SA6 VARBUF+1 MOVE INTO SAVED SLOT
  3236. SX1 4 HAVE 4 ARGUMENTS (SURE)
  3237. BX6 X1
  3238. SA6 VARBUF ENSURE THAT ARG CHECK IS OK
  3239. EQ VARFIN GO PACK IT ALL UP
  3240. *
  3241. SYNERR SX7 B1 UPDATE CHARACTER POINTER
  3242. SA7 WORDPT
  3243. EQ ERR2FEW
  3244. *
  3245. KROUT DATA 6LROUTER
  3246. KROUTV DATA 8LROUTVARS
  3247. *
  3248. * /--- BLOCK ENDOV 00 000 79/02/04 23.39
  3249. *
  3250. ENDOV
  3251. * /--- BLOCK KEYWDOV 00 000 79/11/15 20.36
  3252. TITLE KEYWORD COMMAND OVERLAY
  3253.  
  3254. KEYWDOV OVRLAY
  3255. *
  3256. * * OVERLAY TO CONDENSE KEYWORD-ORIENTED COMMANDS
  3257. * *
  3258. * * KEYWD MACRO
  3259. * *
  3260. * * KEYWD NUMBER,NAME,ADDRESS,FLPTFLG
  3261. * *
  3262. * * NUMBER = NUMBER OF KEYWORD
  3263. * * NAME = NAME OF KEYWORD
  3264. * * ADDRESS = ADDRESS OF ROUTINE TO PROCESS TAG
  3265. * * FLPTFLG = ALPHA TO SUPPRESS F/I CONVERSION
  3266. *
  3267. PURGMAC KEYWD
  3268.  
  3269. KEYWD MACRO NUMBER,NAME,ADDRESS,FLPTFLG
  3270. LOCAL FICONV,UNUSED
  3271. UNUSED SET 0
  3272. IFC EQ,*FLPTFLG*ALPHA*
  3273. FICONV SET 1
  3274. ELSE
  3275. FICONV SET 0
  3276. ENDIF
  3277. DATA L*NAME*
  3278. VFD 1/FICONV,14/UNUSED,9/0,18/ADDRESS,18/NUMBER
  3279. ENDM
  3280. * /--- BLOCK COMMANDS 00 000 80/02/08 23.45
  3281.  
  3282. SA1 OVARG1
  3283. SB1 X1
  3284. JP B1+*+1 JUMP TO ROUTINE FOR COMMAND
  3285.  
  3286. + EQ ATTF 0 = -ATTACHF-
  3287. + EQ DETF 1 = -DETACHF-
  3288. + EQ FILEF 2 = -FILEF-
  3289. + EQ SYSFILE 3 = -SYSFILE-
  3290. *
  3291. * * -ATTACHF- COMMAND
  3292. *
  3293. ATTF CALL SYSTEST
  3294. CALL VARDO1 GET FIP
  3295. NG X1,ERRSTOR --- ERROR IF NOT STORABLE
  3296. CALL KEYWORDS,ATTFTAB,0
  3297. EQ MRKLAST --- PACK UP VARBUF AND EXIT
  3298.  
  3299. ATTFTAB BSS 0 TABLE OF -ATTACHF- KEYWORDS
  3300.  
  3301. KEYWD 0,FILE,FILE,ALPHA
  3302. KEYWD 1,PACK,WORD,ALPHA
  3303. KEYWD 2,MODE,WORD
  3304.  
  3305. DATA 0 MARK END OF TABLE
  3306. *
  3307. * * -DETACHF- COMMAND
  3308. *
  3309. DETF CALL SYSTEST
  3310. CALL VARDO1 GET FIP
  3311. NG X1,ERRSTOR --- ERROR IF NOT STORABLE
  3312. CALL KEYWORDS,DETFTAB,0
  3313. EQ MRKLAST --- PACK UP VARBUF AND EXIT
  3314.  
  3315. DETFTAB BSS 0 TABLE OF -DETACHF- KEYWORDS
  3316.  
  3317. KEYWD 0,FILE,FILE,ALPHA
  3318. KEYWD 1,PACK,WORD,ALPHA
  3319. KEYWD 2,STATION,NEXTKEYW
  3320. KEYWD 3,MASTER,NEXTKEYW
  3321.  
  3322. DATA 0 MARK END OF TABLE
  3323. *
  3324. * * -FILEF- COMMAND (KEYWORDS MUST CORRESPOND TO
  3325. * * THE KEYWORDS FOR -ATTACHF-)
  3326. *
  3327. FILEF CALL SYSTEST
  3328. CALL VARDO1 GET FIP
  3329. NG X1,ERRSTOR --- ERROR IF NOT STORABLE
  3330. CALL KEYWORDS,FILEFTAB,0
  3331. EQ MRKLAST --- PACK UP VARBUF AND EXIT
  3332.  
  3333. FILEFTAB BSS 0 TABLE OF -FILEF- KEYWORDS
  3334.  
  3335. KEYWD 0,FILE,FILE,ALPHA
  3336. KEYWD 1,PACK,WORD,ALPHA
  3337.  
  3338. DATA 0 MARK END OF TABLE
  3339. EJECT
  3340. *
  3341. * * -SYSFILE- COMMAND
  3342. * *
  3343. * * PRIMARY FUNCTIONS -
  3344. * *
  3345. * * ATTACH
  3346. * * DETACH
  3347. * * CHECK EXISTENCE OF A FILE
  3348. * * READ
  3349. * * WRITE
  3350. * * CREATE
  3351. * * DESTROY
  3352. * * RENAME
  3353. * * CHANGE FILE TYPE
  3354. * *
  3355. * * EACH PRIMARY FUNCTION IS FOLLOWED BY SECONDARY
  3356. * * KEYWORDS OR ARGUMENTS
  3357. *
  3358. SYSFILE CALL SYSTEST ERROR IF NOT SYSTEM LESSON
  3359. CALL VARDO1 GET FIP
  3360. NG X1,ERRSTOR --- ERROR IF NOT STORABLE
  3361. CALL GET1ARG (X6) = PRIMARY KEYWORD
  3362. ZR X6,ERR2FEW --- ERROR IF NO KEYWORD
  3363. * /--- BLOCK COMMANDS 00 000 80/02/08 23.45
  3364. SA1 SYSFPTAB-1 (A1) = ADDR. OF 0TH KEYWORD
  3365. MX0 48 (X0) = MASK FOR KEYWORD NAME
  3366.  
  3367. SYSFIL1 SA1 A1+1 (X1) = NEXT KEYWORD TABLE ENTRY
  3368. ZR X1,ERRNAME --- ERROR IF END OF TABLE
  3369. BX2 X0*X1 (X2) = NEXT KEYWORD
  3370. BX2 X2-X6 TEST IF SAME
  3371. NZ X2,SYSFIL1 --- RELOOP IF NO MATCH
  3372.  
  3373. BX1 -X0*X1 (X1) = TYPE OF KEYWORD
  3374. SX6 A1-SYSFPTAB (X6) = PRIMARY KEYWORD NUMBER
  3375. SA2 VARBUF (X2) = CURRENT VARBUF POINTER
  3376. SX7 X2+1 UPDATE VARBUF POINTER
  3377. SA7 A2+0 STORE INCREMENTED POINTER
  3378. SA6 VARBUF+X7 STORE KEYWORD NUMBER
  3379.  
  3380. NZ X1,SYSFIL2 --- READ/WRITE ARE SPECIAL
  3381. SB1 SYSFSTAB (B1) = ADDR OF SECONDARY KEYWDS
  3382. SB2 X6+13 (B2) = KEYWORD SHIFT
  3383. RJ KEYWORDS PROCESS SECONDARY KEYWORDS
  3384. EQ MRKLAST --- PACK UP VARBUF AND EXIT
  3385.  
  3386.  
  3387. SYSFIL2 CALL NEXTARG GET STARTING SECTOR NUMBER
  3388. CALL NEXTARG GET STORAGE INDEX
  3389. SA1 LASTKEY (X1) = LAST CHARACTER PROCESSED
  3390. ZR X1,SYSFIL3 --- IF END-OF-LINE REACHED
  3391. SX1 X1-KSEMIC CHECK IF SEMI-COLON
  3392. ZR X1,SYSFIL3 IF MORE KEYWORDS ARE PRESENT
  3393. CALL NEXTARG PROCESS NUMBER OF SECTORS
  3394. EQ SYSFIL4
  3395.  
  3396. SYSFIL3 CALL OMITTED MARK NO. OF SECTORS OMITTED
  3397.  
  3398. SYSFIL4 CALL GET1ARG (X6) = NEXT KEYWORD
  3399. ZR X6,MRKLAST IF NO MORE KEYWORDS
  3400. SA1 KMSG (X1) = 7LMESSAGE
  3401. IX6 X1-X6
  3402. NZ X6,ERRNAME IF NOT MESSAGE KEYWORD
  3403. CALL NEXTARG GET VAR FOR ERROR MESSAGE
  3404. SA1 LASTKEY (X1) = LAST KEY PROCESSED
  3405. NZ X1,ERR2MNY ERROR IF NOT END-OF-LINE
  3406. SYSFIL5 SA1 NEXTCOM (X1) = NEXT COMMAND
  3407. SA2 COMCONT (X2) = CURRENT COMMAND
  3408. BX1 X1-X2 TEST IF CONTINUED
  3409. NZ X1,MRKLAST --- FINISH UP IF ALL OK
  3410. EQ ERR2MNY --- ERROR IF CONTINUED COMMAND
  3411. *
  3412. * * PRIMARY -SYSFILE- KEYWORDS
  3413. * *
  3414. * * *SYSFIL* MACRO PARAMETERS --
  3415. * *
  3416. * * PRIMARY = PRIMARY KEYWORD (ATTACH, ETC.)
  3417. * * TYPE = 0 IF SECONDARY KEYWORDS, 1 IF
  3418. * * SPECIAL HANDLING
  3419. *
  3420. PURGMAC SYSFIL
  3421. MACREF SYSFIL$
  3422. SYSFIL MACRO PRIMARY,TYPE
  3423. MACREF SYSFIL
  3424. VFD 48/0L_PRIMARY,12/TYPE
  3425. ENDM
  3426.  
  3427. SYSFPTAB SYSFIL ATTACH,0 ATTACH FILE
  3428. * /--- BLOCK COMMANDS 00 000 80/02/08 23.45
  3429. SYSFIL DETACH,0 DETACH FILE
  3430. SYSFIL CHECK,0 CHECK EXISTENCE OF A FILE
  3431. SYSFIL READ,1 READ FILE
  3432. SYSFIL WRITE,1 WRITE FILE
  3433. SYSFIL CREATE,0 CREATE FILE
  3434. SYSFIL DESTROY,0 DESTROY FILE
  3435. SYSFIL RENAME,0 RENAME FILE
  3436. SYSFIL RETYPE,0 CHANGE FILE TYPE
  3437. SYSFIL FBIT,0 SET/CLEAR BACKUP BIT
  3438. SYSFIL RECREATE,0
  3439.  
  3440. DATA 0 MARK END OF TABLE
  3441.  
  3442.  
  3443. PURGMAC SELECT
  3444. MACREF SELECT$
  3445. SELECT MACRO ATR
  3446. MACREF SELECT
  3447. IRP ATR
  3448. ATR SET 1
  3449. IRP
  3450. ENDM
  3451.  
  3452. PURGMAC CLEAR
  3453. MACREF CLEAR$
  3454. CLEAR MACRO ATR
  3455. MACREF CLEAR
  3456. IRP ATR
  3457. ATR SET 0
  3458. IRP
  3459. ENDM
  3460.  
  3461. *
  3462. * * SECONDARY KEYWORD TABLE
  3463. * *
  3464. * * *SYSFKEY* MACRO PARAMETERS
  3465. * *
  3466. * * NUMBER = NUMBER OF KEYWORD
  3467. * * NAME = NAME OF KEYWORD
  3468. * * ADDRESS = ADDRESS OF ROUTINE TO PROCESS TAG
  3469. * * FLPTFLG = ALPHA TO SUPPRESS F/I CONVERSION
  3470. * * OPTS = COMMAND OPTIONS FOR WHICH THIS
  3471. * * SECONDARY KEYWORD IS AVAILABLE
  3472. *
  3473.  
  3474. PURGMAC SYSFKEY
  3475.  
  3476. SYSFKEY MACRO NUMBER,NAME,ADDRESS,FLPTFLG,OPTS
  3477.  
  3478. LOCAL FICONV,UNUSED
  3479. LOCAL FATTACH,FDETACH,FCHECK,FREAD,FWRITE
  3480. LOCAL FCREATE,FDEST,FRENAME,FRETYPE
  3481. LOCAL FFBIT
  3482. LOCAL FRECRE
  3483.  
  3484. UNUSED SET 0
  3485.  
  3486. IFC EQ,*FLPTFLG*ALPHA*
  3487. FICONV SET 1
  3488. ELSE
  3489. FICONV SET 0
  3490. ENDIF
  3491.  
  3492. CLEAR (FATTACH,FDETACH,FCHECK,FREAD,FWRITE)
  3493. CLEAR (FCREATE,FDEST,FRENAME,FRETYPE)
  3494. CLEAR FFBIT
  3495. CLEAR FRECRE
  3496.  
  3497. IRP OPTS
  3498.  
  3499. ALLIF IFC EQ,*OPTS*ALL*
  3500.  
  3501. SELECT (FATTACH,FDETACH,FCHECK,FREAD,FWRITE)
  3502. SELECT (FCREATE,FDEST,FRENAME,FRETYPE)
  3503. SELECT FFBIT
  3504. SELECT FRECRE
  3505.  
  3506. ALLIF ELSE
  3507.  
  3508. IFC EQ,*OPTS*ATTACH*,1
  3509. SELECT FATTACH
  3510. * /--- BLOCK COMMANDS 00 000 80/02/08 23.45
  3511. IFC EQ,*OPTS*DETACH*,1
  3512. SELECT FDETACH
  3513. IFC EQ,*OPTS*CHECK*,1
  3514. SELECT FCHECK
  3515. * /--- BLOCK COMMANDS 00 000 80/02/08 23.45
  3516. IFC EQ,*OPTS*READ*,1
  3517. ERR NOT WITH THIS FUNCTION, TURKEY.
  3518. IFC EQ,*OPTS*WRITE*,1
  3519. ERR NOT WITH THIS FUNCTION, TURKEY.
  3520. IFC EQ,*OPTS*CREATE*,1
  3521. SELECT FCREATE
  3522. IFC EQ,*OPTS*DESTROY*,1
  3523. SELECT FDEST
  3524. IFC EQ,*OPTS*RENAME*,1
  3525. SELECT FRENAME
  3526. IFC EQ,*OPTS*RETYPE*,1
  3527. SELECT FRETYPE
  3528. IFC EQ,*OPTS*FBIT*,1
  3529. SELECT FFBIT
  3530. IFC EQ,*OPTS*RECREATE*,1
  3531. SELECT FRECRE
  3532.  
  3533. ALLIF ENDIF
  3534.  
  3535. IRP
  3536.  
  3537. DATA L*NAME*
  3538. VFD 1/FICONV,12/UNUSED
  3539. VFD 1/FATTACH,1/FDETACH,1/FCHECK,1/FREAD
  3540. VFD 1/FWRITE,1/FCREATE,1/FDEST,1/FRENAME
  3541. VFD 1/FRETYPE
  3542. VFD 1/FFBIT
  3543. VFD 1/FRECRE
  3544. VFD 18/ADDRESS,18/NUMBER
  3545.  
  3546. ENDM
  3547.  
  3548. SYSFSTAB SYSFKEY 0,FILE,FILE,ALPHA,(ALL)
  3549. SYSFKEY 1,PACK,WORD,ALPHA,(ALL)
  3550. SYSFKEY 2,DIRECTORY,WORD,ALPHA,(ALL)
  3551. SYSFKEY 3,MODE,WORD,,(ATTACH)
  3552. SYSFKEY 4,STATION,NEXTKEYW,,(DETACH)
  3553. SYSFKEY 5,MASTER,NEXTKEYW,,(DETACH)
  3554. SYSFKEY 6,TYPE,WORD,,(ALL)
  3555. SYSFKEY 7,LENGTH,WORD,,(CREATE,RECREATE)
  3556. SYSFKEY 8,NPDWRITE,NEXTKEYW,,(CREATE)
  3557. SYSFKEY 9,NEWNAME,FILE,ALPHA,(RENAME)
  3558. SYSFKEY 9,(NEW NAME),FILE,ALPHA,(RENAME)
  3559. SYSFKEY 10,DIRSIZE,WORD,,(CREATE,RECREATE)
  3560. SYSFKEY 10,(DIR SIZE),WORD,,(CREATE,RECREATE)
  3561. SYSFKEY 11,RMTSIZE,WORD,,(CREATE,RECREATE)
  3562. SYSFKEY 11,(RMT SIZE),WORD,,(CREATE,RECREATE)
  3563. SYSFKEY 12,ON,NEXTKEYW,,(FBIT)
  3564. SYSFKEY 13,OFF,NEXTKEYW,,(FBIT)
  3565. SYSFKEY 14,OLDPACK,WORD,ALPHA,(ALL)
  3566. SYSFKEY 15,MESSAGE,WORD,ALPHA,(ALL)
  3567. SYSFKEY 16,NOATTACH,NEXTKEYW,,(CHECK)
  3568. SYSFKEY 17,ACCTRES,WORD,ALPHA,(ALL)
  3569. SYSFKEY 18,SUBACCT,WORD,ALPHA,(CREATE,RECREATE,RENAME)
  3570. SYSFKEY 19,ORIGINAL,WORD,,(CREATE,RECREATE,RENAME)
  3571.  
  3572. DATA 0 MARK END OF TABLE
  3573. * /--- BLOCK KEYWORDS 00 000 79/10/28 04.23
  3574. TITLE KEYWORD PROCESSING ROUTINES
  3575. *
  3576. * * -KEYWORDS- SUBROUTINE
  3577. * *
  3578. * * SEARCHES TABLE OF KEYWORDS AND JUMPS TO
  3579. * * APPROPRIATE ROUTINES FOR PROCESSING
  3580. * *
  3581. * * ON ENTRY, B1 = ADDRESS OF KEYWORD TABLE
  3582. * * B2 = PRIMARY KEYWORD SHIFT, 0 IF
  3583. * * DOES NOT APPLY
  3584. *
  3585.  
  3586. KEYWORDS EQ *
  3587. SX6 B1
  3588. SX7 B2 (X7) = PRIMARY KEYWORD SHIFT
  3589. SA6 KEYWTAB SAVE ADDR. OF KEYWORD TABLE
  3590. SA7 KEYWSHF STORE KEYWORD SHIFT
  3591. NEXTKEYW CALL GET1ARG (X6) = NEXT KEYWORD
  3592. ZR X6,KEYWORDS --- IF ALL KEYWORDS PROCESSED
  3593. SA1 KEYWTAB X1 = ADDR. OF KEYWORD TABLE
  3594. SA1 X1-2 INITIALIZE FOR KEYWORD SEARCH
  3595. NEXTKEY2 SA1 A1+2 (X1) = NEXT KEYWORD
  3596. ZR X1,ERRNAME --- ERROR IF END OF TABLE
  3597. BX1 X1-X6 CHECK IF SAME
  3598. NZ X1,NEXTKEY2 --- IF NO MATCH
  3599. SA1 A1+1 X1 = KEYWORD INFO WORD
  3600. SA2 KEYWSHF (X2) = KEYWORD SHIFT
  3601. ZR X2,NEXTKEY3 --- IF NOT TO CHECK
  3602. SB2 X2
  3603. LX2 X1,B2 SHIFT COMMAND BIT TO SIGN
  3604. PL X2,ERRNAME --- IF THIS KEYWORD ILLEGAL
  3605. NEXTKEY3 BX6 X1 (X6) = KEYWORD INFO WORD
  3606. SA6 KEYWINFO SAVE A COPY
  3607. SX6 X6 X6 = KEYWORD NUMBER
  3608. SA2 VARBUF X2 = GETVAR CODE COUNTER
  3609. SX7 X2+1 INCREMENT COUNTER
  3610. SX3 X7-VARBUFL TEST IF VARBUF FULL
  3611. PL X3,ERR2MNY --- ERROR IF VARBUF FULL
  3612. SA7 A2 STORE UPDATE COUNTER
  3613. SA6 VARBUF+X7 STORE KEYWORD NUMBER
  3614. AX1 18 SHIFT TO ADDR. FIELD
  3615. SB1 X1 B1 = ADDR OF PROCESSING ROUTINE
  3616. JP B1 --- PROCESS KEYWORD ARGUMENT
  3617. * /--- BLOCK KEYWORDS 00 000 80/02/08 23.45
  3618. *
  3619. * * ROUTINE TO PROCESS SINGLE ARGUMENT KEYWORDS
  3620. *
  3621. WORD CALL NEXTARG PROCESS NEXT ARGUMENT
  3622. CALL CHKFLOAT FLOATING POINT CHECK
  3623. EQ NEXTKEYW --- PROCESS NEXT KEYWORD
  3624. *
  3625. * * PROCESS ACCOUNT';FILE AND <LESLIST> ARGUMENTS
  3626. *
  3627. FILE SB1 1
  3628. SA1 WORDPT X1 = ADDR OF NEXT CHAR
  3629. SX1 X1-1 BACK UP FOR LOOP
  3630. FILE1 SX1 X1+B1 X1 = ADDR OF NEXT CHAR
  3631. SA2 X1 X2 = NEXT CHAR
  3632. SX0 X2-1R CHECK IF BLANK
  3633. ZR X0,FILE1 SKIP BLANKS
  3634. ZR X2,ERR2FEW --- ERROR IF END OF LINE
  3635. SX0 X2-KLT CHECK FOR LESLIST BRACKET
  3636. ZR X0,FILE5 --- IF LESLIST BRACKET
  3637. SA3 X2+KEYTYPE
  3638. SX0 X3-OPCOMMA CHECK IF SEPARATOR
  3639. ZR X0,ERR2FEW --- IF SEPARATOR REACHED
  3640. SX0 0 X0 = 0 = NO SPECIAL TERMINATOR
  3641. CALL PSCAN FIND END OF FIRST NAME
  3642. SX0 X1-KSEMIC CHECK IF SEMI-COLON
  3643. NZ X0,FILE2 --- IF NOT SEMI-COLON
  3644. SA3 B1-1 X3 = PRECEDING CHAR
  3645. SX0 X3-KUP CHECK IF SHIFT CODE
  3646. NZ X0,FILE2 --- IF NOT SHIFT CODE
  3647. EQ FILE3 --- IF ACCOUNT NAME PRESENT
  3648. *
  3649. * * ACCOUNT NAME OMITTED
  3650. *
  3651. FILE2 CALL OMITTED STORE OMITTED ARG GETVAR CODE
  3652. EQ FILE4 --- PROCESS FILE NAME
  3653. *
  3654. * * PROCESS ACCOUNT NAME
  3655. *
  3656. FILE3 SX6 1R X6 = BLANK
  3657. SA6 A3 REPLACE SHIFT CODE WITH BLANK
  3658. *////// TEMPORARY -- ACCOUNT NAME LEGAL ONLY IN SYSTEM LESSONS
  3659. SA1 SYSFLG
  3660. LX1 ZSLDSHF
  3661. PL X1,ERRNAME ERROR IF NOT SYSTEM LESSON
  3662. *////// END TEMPORARY
  3663. CALL NEXTARG PROCESS ACCOUNT NAME
  3664. CALL CHKFLOAT MASK OUT FLOATING POINT BIT
  3665. *
  3666. * * PROCESS FILE NAME
  3667. *
  3668. FILE4 CALL NEXTARG PROCESS FILE NAME
  3669. CALL CHKFLOAT MASK OUT FLOATING POINT BIT
  3670. EQ NEXTKEYW --- ADVANCE TO NEXT KEYWORD
  3671. * /--- BLOCK KEYWORDS 00 000 80/02/08 23.45
  3672. *
  3673. * * PROCESS <LESLIST> REFERENCE
  3674. *
  3675. FILE5 SX1 X1+B1 ADVANCE PAST LEFT BRACKET
  3676. BX6 X1
  3677. SA6 WORDPT UPDATE POINTER TO NEXT CHAR
  3678. SX0 KGT SCAN FOR RIGHT BRACKET
  3679. CALL PSCAN
  3680. SX0 X1-KGT CHECK IF RIGHT BRACKET FOUND
  3681. NZ X0,ERRTERM --- IF RIGHT BRACKET NOT FOUND
  3682. SX6 1R
  3683. SA6 B1 REPLACE RIGHT BRACKET W/BLANK
  3684. SA1 VARBUF X1 = CURRENT VARBUF INDEX
  3685. SX7 X1+1
  3686. SX2 X7-VARBUFL CHECK IF OVERFLOWING VARBUF
  3687. PL X2,ERR2MNY --- IF VARBUF FULL
  3688. SA7 A1 UPDATE VARBUF INDEX
  3689. SA2 LESLCOD X2 = LESLIST GETVAR CODE
  3690. BX6 X2
  3691. SA6 VARBUF+X7 STORE LESLIST CODE
  3692. CALL NEXTARG
  3693. EQ NEXTKEYW --- PROCESS NEXT KEYWORD
  3694.  
  3695. LESLCOD VFD 60/LLCODE
  3696. * /--- BLOCK KEYWORDS 00 000 80/02/08 23.45
  3697. *
  3698. * * -NEXTARG-
  3699. * *
  3700. * * PROCESSES NEXT VARIABLE ARGUMENT
  3701. *
  3702. NEXTARG EQ *
  3703. SA1 WORDPT CURRENT POSITION
  3704. SA1 X1
  3705. ZR X1,ERR2FEW --- IF END OF LINE REACHED
  3706. CALL VARDO2
  3707. EQ NEXTARG
  3708. *
  3709. * * -GET1ARG-
  3710. * *
  3711. * * GET NEXT KEYWORD
  3712. * *
  3713. * * ON ENTRY, (WORDPT) = ADDR. OF NEXT CHARACTER
  3714. * * (LASTKEY) = PREVIOUS DELIMITER
  3715. * *
  3716. * * ON EXIT, (X6) = NEXT KEYWORD, 0 IF NO MORE
  3717. *
  3718. GET1ARG EQ *
  3719. SA1 WORDPT CHECK NEXT CHARACTER
  3720. SA1 X1 (X1) = NEXT CHARACTER
  3721. ZR X1,GET1ARG2 --- IF EOL, READ NEXT LINE
  3722. SA1 LASTKEY (X1) = DELIMITER
  3723. SX6 X1-KSEMIC CHECK FOR SEMI-COLON
  3724. ZR X6,GET1ARG3 --- GO READ NEXT LINE
  3725. EQ ERR2MNY --- ERROR IF NO DELIMITER
  3726.  
  3727. GET1ARG2 SA1 NEXTCOM (X1) = COMMAND FOR NEXT LINE
  3728. SA2 COMCONT (X2) = CURRENT COMMAND
  3729. BX3 X1-X2 CHECK IF CONTINUED COMMAND
  3730. NZ X3,GET1ARG4 --- IF NOT CONTINUED LINE
  3731. CALL GETLINE READ NEXT LINE
  3732.  
  3733. GET1ARG3 CALL NXTNAM (X6) = TAG, (X1) = SEPARATOR
  3734. ZR X6,ERRNAME --- ERROR IF NONE OR TOO LONG
  3735. BX7 X1 (X7) = SEPARATOR
  3736. SA7 LASTKEY SAVE DELIMITER
  3737. EQ GET1ARG --- RETURN
  3738.  
  3739. GET1ARG4 MX6 0 (X6) = 0 IF NO MORE KEYWORDS
  3740. EQ GET1ARG --- RETURN
  3741. *
  3742. * * CHKFLOAT MASKS OUT THE FLOATING POINT BIT SO THAT
  3743. * * ALPHAMERIC FIELDS WILL NOT BE CONVERTED TO
  3744. * * INTEGER IF DEFINED IN V-TYPE VARIABLES
  3745. *
  3746. CHKFLOAT EQ *
  3747. SA1 KEYWINFO X1 = KEYWORD INFO WORD
  3748. PL X1,CHKFLOAT --- IF NOT ALPHAMERIC
  3749. SA1 VARBUF X1 = NO. OF GETVAR CODES
  3750. SB2 X1
  3751. SA1 A1+B2 X1 = LAST GETVAR CODE
  3752. MX0 61-XCODEL+XFBIT
  3753. BX6 -X0*X1 GET RID OF FLOATING POINT BIT
  3754. SA6 A1 PUT GETVAR CODE BACK IN PLACE
  3755. EQ CHKFLOAT --- RETURN
  3756. *
  3757. * * STORE SPECIAL CODE FOR OMITTED ARGUMENTS
  3758. *
  3759. OMITTED EQ *
  3760. MX6 1
  3761. LX6 19 SET 19TH BIT = OMITTED ARGUMENT
  3762. SA1 VARBUF CURRENT VARBUF INDEX
  3763. SX7 X1+1
  3764. * /--- BLOCK KEYWORDS 00 000 80/02/08 23.45
  3765. SX2 X7-VARBUFL SUBTRACT OFF SIZE OF VARBUF
  3766. PL X2,ERR2MNY EXIT IF VARBUF BUFFER FULL
  3767. SA7 A1
  3768. SA6 VARBUF+X7 STORE DUMMY ARGUMENT
  3769. EQ OMITTED
  3770. *
  3771. * * VARIABLES
  3772. *
  3773. KEYWTAB BSS 1 ADDRESS OF KEYWORD TABLE
  3774. KEYWSHF BSS 1 PRIMARY KEYWORD NUMBER/SHIFT
  3775. KEYWINFO BSS 1 1/ALPHA FLAG,23/0,18/ADDR,18/NO
  3776. KMSG DATA 7LMESSAGE
  3777.  
  3778. ENDOV
  3779. * /--- BLOCK END 00 000 76/07/21 20.45
  3780. *
  3781. *
  3782. OVTABLE
  3783. *
  3784. *
  3785. END COVLY3$
plato.source/plaopl/covlay3.txt ยท Last modified: 2021/02/06 16:22 by 127.0.0.1