CDC Community

๐Ÿ”น Historical Conservation ๐Ÿ”น

User Tools

Site Tools


plato.source:plaopl:exec5

Table of Contents

EXEC5

Table Of Contents

  • [00008] EXEC5 OVERLAYS FOR COMMAND EXECUTION
  • [00032] HISTORY
  • [00047] NOTES
  • [00104] CHARACTER STRING SEARCH ROUTINE
  • [00639] REVERSE SEARCH LOOP
  • [00972] -ABORT- COMMAND
  • [01058] -CHECKPT- COMMAND
  • [01109] -STOLOAD- COMMAND
  • [01162] -COMLOAD- COMMAND
  • [01222] -LOADSET-
  • [01357] TIMING COMMANDS
  • [01444] -TIMEL-
  • [01520] -TIMER-
  • [01608] -READECS/WRITECS-
  • [01672] -SBREAD/SBWRITE-
  • [01831] -SBCHANG- / -STCHANG-
  • [01833] SBCHANG - CHANGE A WORD IN A STUDENT BANK
  • [01998] -USERLOC- (CODE = 150)
  • [02143] -READTCM- READ TUTOR CENTRAL MEMORY
  • [02209] -HIDDEN- COMMAND
  • [02428] -SEND- COMMAND EXECUTION OVERLAY
  • [02860] -BEEP-
  • [02878] -ACCESS- AND -SYSACC- COMMAND EXECUTION.
  • [03234] GETACN - GET USERS ACCESS LIST NAME.
  • [03310] PUTACC - RETURN ACCESS BITS TO USER.
  • [03377] GETACC - GET ACCESS ACCESS BITS FOR USER.
  • [03919] ACHECK - CHECK USERS ACCESS
  • [04108] DIRCHK - CHECK TO SEE IF THIS USER IS OWNER
  • [04156] STATE - STATE TABLES TO DEFINE NEXT SEARCH.
  • [04341] EBCHOP - ECS BINARY CHOP.
  • [04479] GBA - GET JUDGE BUFFER ADDRESS
  • [04568] -REPLACE- COMMAND EXECUTION

Source Code

EXEC5.txt
  1. EXEC5
  2. * /--- FILE TYPE = E
  3. * /--- BLOCK EXEC5 00 000 78/12/15 10.55
  4. IDENT PLAT4$
  5. LCC OVERLAY(PLATO,1,0)
  6. END
  7. IDENT EXEC5
  8. TITLE EXEC5 OVERLAYS FOR COMMAND EXECUTION
  9. *
  10. *
  11. CST
  12. *
  13. *
  14. EXEC5$ OVFILE
  15. *
  16. *
  17. EXT ECSPRTY,ILOC,INAME,PROCO,ERXNAME
  18. EXT BOUNDS,WORDS,PROCESS,PROCESX,PROC,ERXMXLW
  19. EXT CKPROC,RETPROC,RETPROS,RETPRO
  20. EXT ERROROF,XSLICE
  21. EXT ERXROLC,ERXBADL,ERXROLV,ERXINDL,ERXINDH
  22. EXT ERXPOS,ERXNOCS,ERXVAL,ERXECSB,ERXSTN
  23. EXT GET2
  24. EXT GETN
  25. EXT FODTAB,STSTUD,DST
  26. EXT CHKSET
  27. EXT RCTOXY
  28. EXT LSNADDR
  29. *
  30. *
  31. * /--- BLOCK NOTES 00 000 77/09/13 15.45
  32. TITLE HISTORY
  33. ************************************************************
  34. *
  35. * THE ORIGINAL IDEA FOR, AND IMPLEMENTATION OF,
  36. * THIS SEARCH ROUTINE IS DUE TO JIM PARRY. THE
  37. * CODE WAS MODIFIED AS TO REGISTER USAGE AND
  38. * CALLING PROCEDURE TO CONFORM TO TUTOR EXECUTION
  39. * CONVENTIONS BY RICK BLOMME, JULY 10, 1972.
  40. *
  41. * MULTIPLE SEARCH BY KIM MAST
  42. *
  43. * REVERSE SEARCH AND GENERAL CLEANUP 9/77 BY
  44. * PAUL KONING.
  45. *
  46. ************************************************************
  47. TITLE NOTES
  48. *
  49. * REGISTER USAGE IN ACTUAL SEARCH ROUTINE IS
  50. * A MESS. THE PRIME REGISTER USAGE IS GIVEN
  51. * BELOW';
  52. *
  53. * X0 = OBJECT TO SEARCH FOR
  54. * X1 = TEMPORARY
  55. * X2 = CURRENT WORD BEING CHECKED
  56. * X3 = FOLLOWING WORD
  57. * X4 = 10 COPIES OF COMPLEMENT OF 1ST CHARACTER
  58. * X5 = 10 COPIES OF COMPLEMENT OF 2ND CHARACTER
  59. * X6 = SPECIAL MASK (',SPIKES',)
  60. * X7 = FLAG WORD MARKING POSITIONS WHOSE FIRST
  61. * TWO CHARACTERS MATCH SPECIFIED OBJECT STRING
  62. *
  63. * A0 = BASE ADDRESS OF SEARCH (WORD 1 OF STRING)
  64. * A2 = ADDRESS OF CURRENT WORD BEING CHECKED
  65. * A4 = ADDRESS OF LAST RESULT + 1
  66. * A7 = ADDRESS OF WORD WHERE OBJECT WAS PLANTED
  67. * TO STOP SEARCH FOR INTERRUPT OR TERMINATION
  68. *
  69. * B0 = 0
  70. * B1 = 1
  71. * B2 = 2
  72. * B3 = CHAR POSITION COUNTER
  73. * B4 = TEMPORARY
  74. * B5 = SHIFT COUNT (60-6*OBJECT LENGTH)
  75. * B6 = ^$ SPACES LEFT IN RESULT BUFFER
  76. * B7 = ADDRESS TO STOP SEARCHING ON (MAY BE
  77. * END + 2 OR START - 1 DEPENDING ON DIRECTION)
  78. *
  79. * THE SEARCH ROUTINE INTERRUPTS WHEN THE TIME
  80. * SLICE IS EXCEEDED. IT DOES THIS BY PLANTING
  81. * THE OBJECT EVERY 70 WORDS AND CHECKING THE CLOCK
  82. * WHEN THE PLANTED OBJECT IS HIT. THIS LENGTH OF
  83. * 70 IS DETERMINED BY SYMBOL *NWORDS* AND CAN BE
  84. * CHANGED TO MAKE CHECKS MORE OR LESS FREQUENT.
  85. *
  86. * FORMAT OF THE SEARCH COMMAND';
  87. *
  88. * SEARCH OBJ,OBJLEN,STRING,LEN,START,BUFF[,NUMBER]
  89. *
  90. * OBJ = OBJECT TO SEARCH FOR
  91. * OBJLEN = LENGTH OF OBJECT (1^<OBJLEN^<10)
  92. * STRING = STRING TO SEARCH IN (N OR NC VARS)
  93. * LEN = LENGTH OF STRING, IN CHARS
  94. * START = CHAR POSITION TO START AT (1^<START^<LEN)
  95. * BUFF = BUFFER TO CONTAIN RESULTS (N, V, NC, VC)
  96. * NUMBER = OPTIONAL COUNT OF NUMBER OF OCCURRENCES
  97. * TO BE FOUND. IF OMITTED, ONLY ONE IF
  98. * FOUND, AND SEARCH STOPS WHEN IT IS
  99. * FOUND. OTHERWISE, OCCURRENCES ARE
  100. * COUNTED, AND THE FIRST *NUMBER* ARE
  101. * STORED.
  102. *
  103. * /--- BLOCK SEARCH DEF 00 000 79/11/01 22.57
  104. TITLE CHARACTER STRING SEARCH ROUTINE
  105. *
  106. NWORDS EQU 70 WORDS TO SEARCH UNTIL INTERRUPT
  107. *
  108. STORE MACRO
  109. LOCAL LB1,LB2,LB3
  110. *
  111. PL X1,LB1 FLOAT RESULT IF NECESSARY
  112. PX6 X6
  113. NX6 X6
  114. *
  115. *** NOTE THAT AN AUTHOR CAN HAVE HIS RETURN CELL IN
  116. *** AS PART OF HIS SEARCH STRING (OR ONE WORD AWAY'/)
  117. *** --SO MUST CHECK SO THAT DON'7T CHANGE THE END TEST
  118. *
  119. LB1 SB4 A4-B6
  120. SB4 A7-B4 CHECK STORE ADDRESS AGAINST END TEST
  121. NZ B4,LB2 B4=0 IF RESULT ADR = END TEST
  122. *
  123. SA6 SAVWORD STORE VALUE IN SAVED WORD
  124. EQ LB3 AND CONTINUE
  125. *
  126. LB2 SA6 A4-B6 STORE VALUE IN RESULT BUFFER
  127. BX6 X6 AND CONTINUE
  128. *
  129. LB3 BSS 0 FORCE TO NEXT WORD
  130. ENDM
  131. *
  132. TSRCOBJ EQU TBINTSV SEARCH OBJECT
  133. TSRCMXM EQU TBINTSV+1 ASSORTED JUNK, PART 1
  134. TSRCTC1 EQU TBINTSV+2 TEN COPIES OF COMP. OF CHAR 1
  135. TSRCTC2 EQU TBINTSV+3 TEN COPIES OF COMP. OF CHAR 2
  136. TSRCST EQU TBINTSV+4 START OF THIS PART OF SEARCH
  137. TSRCINX EQU TBINTSV+5 NUMBER OF OCCURRENCES LEFT TO FIND
  138. TSRCEND EQU TBINTSV+6 ASSORTED JUNK, PART 2
  139. *
  140. * SPECIFICS ON ',ASSORTED JUNK', VARIABLES';
  141. * TSRCMXM CONTAINS';
  142. * 1/FP FLAG (1 MEANS STORE FLOATING)
  143. * 1/REPEAT FLAG (1 MEANS NO REPEAT, 6 ARG FORM)
  144. * 4/UNUSED
  145. * 18/START OF RESULT AREA
  146. * 18/CHAR POSITION TO STOP SEARCH ON
  147. * 18/CHAR POSITION TO START SEARCH ON
  148. *
  149. * TSRCEND CONTAINS';
  150. * 1/DIRECTION (1 MEANS BACKWARD SEARCH)
  151. * 5/SHIFT COUNT/2 (30-3*OBJECT LENGTH)
  152. * 18/RESULT BUFFER END
  153. * 18/STRING BASE ADDRESS
  154. * 18/STRING END + 2 OR START - 1
  155. * (DEPENDING ON DIRECTION OF SEARCH)
  156. *
  157. * /--- BLOCK SEARCH 00 000 78/07/05 01.22
  158. SEARCHO OVRLAY
  159. SA1 OVARG1 SEE IF INTERRUPTED
  160. NZ X1,POSTINT IF SO, CONTINUE FROM INT.
  161. MX0 2*XCODEL
  162. BX1 -X0*X5 MASK OUT ARGUMENTS 1 AND 2
  163. AX1 XCMNDL SHIFT OFF COMMAND CODE
  164. SA2 B5+X1 X2 = 1ST EXTRA ARG WORD
  165. BX6 X2
  166. SA3 A2+1 X3 = 2ND EXTRA ARG WORD
  167. BX5 X3 SET FOR NGETVAR
  168. BX7 X3
  169. LX3 XCODEL BRING OPTIONAL ARG. 7 TO TOP
  170. SA6 SRCHSAV STORE FIRST ARG. WORD
  171. SA7 SRCHSV2 AND SECOND ONE
  172. NG X3,SRCHX1 JUMP IF NO 7TH ARGUMENT
  173. *
  174. * CONTINUE IF 7 ARGUMENT FORM (REPEATED SEARCH)
  175. *
  176. NGETVAR 6 A1 = RESULT START ADDRESS
  177. SX6 A1
  178. SA6 SRCHADR SAVE RESULT ADDRESS
  179. SA2 SRCHSV2 BRING 2ND ARG WORD BACK
  180. BX5 X2
  181. LX5 XCODEL
  182. *
  183. * GET NUMBER OF TIMES TO STORE (ARG. 7)
  184. *
  185. NGETVAR INC X1 = NUMBER OF TIMES TO STORE
  186. SA2 SRCHADR
  187. SA0 X2 A0 HAS STARTING ADDRESS
  188. * SX1 X1 USE 18 BIT ARITHMETIC
  189. * NG X1,ERXBADL DISALLOW NEGATIVE COUNT
  190. * SB1 X1+1 B1 CONTAINS LENGTH FOR BOUNDS
  191. NG X1,ERXBADL DISALLOW NEGATIVE COUNT
  192. * EXECERR USES X1
  193. SX6 1
  194. IX1 X1+X6 CHECK BOUNDS FOR STORE COUNT+1
  195. * ZR X1,ERXBADL CHECK THAT STORE COUNT NE -1
  196. CALL BOUNDS PERFORM BOUNDS CHECK
  197. SX6 B1-1 SET ADDRESS OF BUFFER END
  198. * SX7 X1 MOVE STORE COUNT OVER (SMALL INTEGER)
  199. SX7 X1-1 MOVE STORE COUNT OVER (SMALL INTEGER)
  200. MX1 0 X1 = FLAG (0=REPEAT)
  201. EQ SRCHX2
  202. * /--- BLOCK SEARCH 00 000 78/05/02 21.38
  203. *
  204. * 6 ARGUMENT SEARCH - GET RESULT ADDRESS
  205. *
  206. SRCHX1 NGETVAR 6 A1 = RESULT ADDRESS
  207. SX6 A1 COPY TO X6
  208. SA0 A1 AND TO A0
  209. SX7 1 NUMBER OF SEARCHES TO DO
  210. MX1 1 SET FLAG FOR NO REPEAT
  211. LX1 -1 MOVE INTO PROPER PLACE
  212. SRCHX2 SA7 TSRCINX STORE REPEAT COUNT
  213. MX0 -18
  214. BX6 -X0*X6 AVOID EXTENDED SIGNS
  215. LX6 36
  216. SA6 TSRCEND STORE AWAY
  217. SX6 A0 GET COUNTER ADDRESS (7ARG ONLY)
  218. BX6 -X0*X6 WIPE OUT SIGN EXTENSION
  219. LX6 36
  220. BX6 X1+X6 MOVE IN REPEAT FLAG
  221. SA5 A5 RESTORE COMMAND WORD
  222. SA6 TSRCMXM AND STORE
  223. * /--- BLOCK SEARCH 00 000 78/05/02 21.38
  224. *
  225. * GET SEARCH OBJECT (ARG 1)
  226. *
  227. NGETVAR 1 X1 = OBJECT
  228. BX6 X1
  229. SA6 TSRCOBJ STORE OBJECT
  230. MX0 6 MASK FOR FIRST CHARACTER
  231. BX6 X6*X0 X.........
  232. BX2 X6 X.........
  233. LX2 6 .........X
  234. BX2 X2+X6 X........X
  235. LX2 6 ........XX
  236. BX6 X6+X2 X.......XX
  237. LX2 12 ......XX..
  238. BX6 X6+X2 X.....XXXX
  239. BX2 -X6 C;;;;;CCCC
  240. LX2 30 ;CCCCC;;;;
  241. BX6 -X6*X2 GOT 10 COPIES OF CHAR 1 NOW
  242. SA6 TSRCTC1 STORE THAT
  243. LX1 6 REPEAT THIS FOR 2ND CHAR
  244. BX6 X1*X0 X.........
  245. BX2 X6 X.........
  246. LX2 6 .........X
  247. BX2 X2+X6 X........X
  248. LX2 6 ........XX
  249. BX6 X6+X2 X.......XX
  250. LX2 12 ......XX..
  251. BX6 X6+X2 X.....XXXX
  252. BX2 -X6 C;;;;;CCCC
  253. LX2 30 ;CCCCC;;;;
  254. BX6 -X6*X2 GOT 10 COPIES OF CHAR 2
  255. SA6 TSRCTC2 STORE THAT TOO
  256. *
  257. * GET ARGUMENT 2 (OBJECT LENGTH)
  258. *
  259. SA5 A5 GET COMMAND WORD BACK
  260. LX5 XCODEL
  261. NGETVAR INC LENGTH IN X1
  262. SA2 SRCHSAV BRING UP 1ST EXTRA ARG WORD
  263. BX5 X2 FOR NGETVAR
  264. SX6 X1 LENGTH TO X6, 18 BIT ARITHMETIC
  265. NG X6,ERXBADL ERROR IF NEGATIVE
  266. ZR X6,NOSRCH DON'7T SEARCH FOR NOTHING
  267. SX2 X6-11
  268. PL X2,ERXBADL ERROR IF GREATER THAN 10
  269. SA6 SRCHOBL SAVE OBJECT LENGTH
  270. SA1 TSRCEND BRING UP INCOMPLETE TSRCEND
  271. LX6 2 MULTIPLY LENGTH BY 4
  272. SX2 X6-30 4*LENGTH-30
  273. LX6 -2 NOW X6 = LENGTH AGAIN
  274. IX6 X6-X2 X6 = 30-(LENGTH*3)
  275. MX0 -5 MASK FOR SHIFT COUNT
  276. BX6 -X0*X6
  277. LX6 54 MOVE INTO PLACE
  278. BX6 X1+X6 MERGE IN NEW DATA
  279. SA6 A1 STORE RESULT
  280. * /--- BLOCK SEARCH 00 000 78/05/02 21.39
  281. *
  282. * GET BASE ADDRESS OF SEARCH (ARG 3)
  283. *
  284. NGETVAR INC BASE ADDRESS TO A1
  285. SX6 A1
  286. SA6 TSRCST STORE FOR A WHILE
  287. MX0 -18
  288. BX6 -X0*X6 REDUCE TO 18 BITS
  289. LX6 18 MOVE INTO PLACE
  290. SA1 TSRCEND
  291. BX6 X1+X6 MERGE WITH OLDER DATA
  292. SA6 A1 AND STORE BACK
  293. SA1 SRCHSAV GET 1ST ARG WORD AGAIN
  294. BX5 X1
  295. LX5 XCODEL
  296. *
  297. * GET LENGTH IN CHARACTERS (ARG. 4)
  298. *
  299. NGETVAR INC X1 = NUMBER OF CHAR
  300. ZR X1,NOSRCH DON'7T SEARCH THROUGH NOTHING
  301. SA3 SRCHSAV GET EXTRA ARG WORD BACK
  302. SX6 X1 MOVE LENGTH, 18 BIT ARITHMETIC
  303. PL X6,SRCHX3 BRANCH IF FORWARD SEARCH
  304. BX6 -X6 GET ABSOLUTE VALUE
  305. SA1 TSRCEND
  306. MX0 1 FLAG BIT FOR REVERSE SEARCH
  307. BX7 X1+X0 MERGE
  308. SA7 A1 AND STORE THE RESULT
  309. SRCHX3 SA6 SRCHLEN SAVE LENGTH IN CHARS
  310. SA1 TSRCST
  311. SA0 X1
  312. BX1 X6 FOR *WORDS*
  313. CALL WORDS
  314. BX5 X3
  315. LX5 2*XCODEL BRING UP ARGUMENT 5
  316. * /--- BLOCK SEARCH 00 000 78/05/02 21.39
  317. *
  318. * GET STARTING OFFSET (ARGUMENT 5)
  319. *
  320. NGETVAR INC OFFSET TO X1
  321. SB3 X1-1 MAKE 1-BASE INTO 0-BASE OFFSET
  322. NG B3,ERXPOS ERROR IF OFFSET TOO SMALL
  323. SA1 SRCHLEN READ SEARCH LENGTH IN CHARS
  324. SA2 SRCHOBL AND OBJECT LENGTH
  325. SB2 X1 COPY LENGTH
  326. LE B2,B3,SERX ERROR IF OFFSET > MAX
  327. IX2 X1-X2 MAX POSSIBLE CHAR POSITION -1
  328. NG X2,NOSRCH --- IF NO SEARCH POSSIBLE
  329. SB1 X2 TO B1
  330. SX3 B3 X3 = CHAR POS. TO START ON
  331. SA1 TENTH BRING UP 1/10
  332. SA4 TSRCEND GET DIRECTION FLAG
  333. PL X4,SRCHX4 BRANCH IF FORWARD SEARCH
  334. *
  335. * SET UP DATA FOR BACKWARD SEARCH
  336. * X2 = ENDING CHAR POSITION (0-BASED)
  337. * X3 = INITIAL CHAR POSITION (0-BASED)
  338. * X6 = STARTING WORD OFFSET (SET LATER)
  339. * X7 = WORD OFFSET FOR END TEST (END+2 OR END-1)
  340. *
  341. SX7 -1 SEARCH END ADDRESS (RELATIVE)
  342. MX2 0 LAST CHAR POSITION -1
  343. LE B3,B1,SRCHX5 --- IF OFFSET SMALL ENOUGH
  344. SX3 B1 CORRECT OFFSET
  345. EQ SRCHX5 CONTINUE IN COMMON CODE
  346. *
  347. * SAME FOR FORWARD SEARCH
  348. *
  349. SRCHX4 GT B3,B1,NOSRCH --- IF NO SEARCH POSSIBLE
  350. * (X2 ALREADY SET)
  351. PX7 X2 FLOAT ENDING CHAR POSITION
  352. FX7 X1*X7 COMPUTE WORD ENDING OFFSET
  353. SX7 X7+2 SEARCH END ADDRESS (RELATIVE)
  354. * /--- BLOCK SETUP END 00 000 77/09/13 00.00
  355. *
  356. * NOW PACK UP EVERYTHING INTO TBINTSV BUFFER
  357. *
  358. SRCHX5 SX2 X2+1 MAKE CHAR POSITIONS 1-BASED
  359. LX2 18 SHIFT END POSITION OVER
  360. PX6 X3 FLOAT STARTING CHAR POSITION
  361. SX3 X3+1 ADJUST THIS ONE TOO
  362. BX2 X2+X3 PACK UP FOR TSRCMXM
  363. FX6 X1*X6 COMPUTE WORD OFFSET
  364. SX6 X6 TOSS EXPONENT
  365. SA3 TSRCST READ UP BASE ADDRESS
  366. IX6 X6+X3 MAKE STARTING ADDRESS ABSOLUTE
  367. IX7 X7+X3 LIKEWISE FOR ENDING ADDRESS
  368. SA6 A3 STORE STARTING ADDRESS
  369. SA3 TSRCEND GET END ADDRES ETC. WORD
  370. MX0 -18
  371. BX7 -X0*X7 CLEAR SIGN EXTEND
  372. BX7 X7+X3 MERGE WITH ENDING ADDRESS
  373. SA7 A3 AND STORE BACK
  374. SA1 TSRCMXM GET FIRST ASSORTED THINGS WORD
  375. BX6 X1+X2 MERGE IN CHARACTER BOUNDS
  376. SA2 SRCHSV2 READ UP SECOND ARG. WORD
  377. LX2 XFBIT SEE IF ARG. 6 WAS FLOATING
  378. MX0 1
  379. BX2 X0*X2 ISOLATE FLOATING ARG. FLAG
  380. BX6 X6+X2 MERGE WITH TSRCMXM
  381. SA6 A1 STORE EVERYTHING BACK
  382. *
  383. * /--- BLOCK POSTINT 00 000 78/01/07 19.22
  384. *
  385. * ENTER HERE AFTER SETUP OR UPON RETURN FROM INTERRUPT.
  386. * TUTOR'7S B REGISTERS ARE SAVED AND ALL REGISTERS ARE
  387. * SET UP FOR THE MAIN SEARCH LOOP.
  388. *
  389. POSTINT SX6 B5
  390. SX7 B7
  391. SA6 SAVEB5
  392. SA7 SAVEB7
  393. *
  394. * NOW SET UP REGISTERS FOR SEARCH
  395. *
  396. SA1 TSRCINX GET NUMBER OF TIMES LEFT
  397. SA2 TSRCEND SEARCH ENDING ADDRESS
  398. SB6 X1 NUMBER LEFT INTO B6
  399. SB7 X2 ENDING ADDRESS INTO B7
  400. AX2 18 MOVE UP BASE ADDRESS OF SEARCH
  401. SA0 X2 INTO A0
  402. AX2 18 MOVE UP BUFFER END ADDRESS
  403. SA4 X2 INTO A4 (...)
  404. AX2 18 MOVE UP SHIFT COUNT/2
  405. LX2 1 NOW TRUE SHIFT COUNT
  406. SA1 TSRCTC1 TEN COPIES OF COMP. OF CHAR 1
  407. SA3 TSRCOBJ AND SEARCH OBJECT
  408. BX4 X1 CHAR 1 TO X4
  409. BX0 X3 OBJECT TO X0
  410. SA1 TSRCTC2 LIKEWISE FOR CHAR 2
  411. BX5 X1 INTO THE PROPER REGISTER
  412. NG X2,BINIT BRANCH IF REVERSE
  413. SB5 X2 SET UP SHIFT COUNT IN B5
  414. *
  415. * ENTER HERE AFTER OK TIME CHECK (INTERRUPT NOT PERFORMED)
  416. *
  417. NLOOP SB1 1 B1 = 1 (STANDARD INCREMENT)
  418. SA1 TSRCST GET STARTING ADDRESS
  419. *
  420. SB4 X1+NWORDS
  421. SA2 X1-1 A2 = STARTING ADDRESS -1
  422. SB2 B1+B1 B2 = 2 (FOR COMBINING BITS)
  423. LT B4,B7,SETEND JUMP IF NEED INTERRUPT TEST
  424. SB4 B7 B4 = END TEST = LAST SEARCH
  425. * ADDRESS +2
  426. SETEND SX6 B4-B1 RESTART IN WORD PRECEDING END TEST
  427. SA6 A1 STORE BACK FOR NEXT TIME
  428. *
  429. * STORE WORD AT END TO GUARANTEE EXIT
  430. *
  431. SA1 B4
  432. BX6 X1
  433. SA6 SAVWORD
  434. BX7 X0 X7 HAS OBJECT
  435. SA7 B4 STORE AT END
  436. *
  437. * NOTE - - A7 HAS END TEST ADDRESS, (MUST BE SAVED FOR END TEST)
  438. *
  439. SA1 SPIKES READ UP MASK WITH EVERY 6TH BIT ON
  440. BX6 X1 X6 = SPIKE MASK
  441. *
  442. ****************************************************
  443. ************ REPEATED SEARCH LOOP ******************
  444. ****************************************************
  445. *
  446. NSRCH SX1 B5-54 EXAMINE SHIFT COUNT
  447. ZR X1,SINGLE JUMP IF SINGLE CHAR LOOKUP
  448. * /--- BLOCK F-SEARCHLP 00 000 79/10/31 12.14
  449. ******************************************
  450. ********** SEARCH LOOP *************
  451. ******************************************
  452. *
  453. NXTWORD SA2 A2+B1 X2 = NEXT WORD TO SEARCH
  454. ****
  455. * TRAP 10/31/79 FRYE
  456. SB4 A2-B7 SEE IF WE WENT PAST END CHECK
  457. SA3 B1-B4 AND BLOW AWAY IF SO
  458. *
  459. ****
  460. BX1 X2-X4 MAKE 6 1-S EVERYWHERE THE 1ST CHARACTER WAS
  461. LX3 X1,B1 SHIFT A COPY 1 BIT
  462. BX1 X1*X3 COMBINE EVEN AND ODD BITS
  463. LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS
  464. BX3 X1*X3 COMBINE AGAIN
  465. LX1 X3,B2 SHIFT THIS COMBO 2 BITS
  466. BX7 X1*X3 COMBINE ONCE AGAIN
  467. BX7 X6*X7 CLEAR THE JUNK WITH SPIKES
  468. *
  469. * X7 HAS THE TOP BIT OF EACH CHAR THAT MATCHED THE
  470. * 1ST CHAR OF THE STRING SET
  471. *
  472. ZR X7,NXTWORD LOOP IF NO MATCHES
  473. *
  474. * SPECIAL CHECK FOR CHAR IN POSITION 10
  475. *
  476. BX1 X7
  477. LX1 54 MOVE FLAG TEN TO SIGN BIT OF X1
  478. PL X1,CHAR2ND JUMP OVER IF NOT
  479. *
  480. * IF YES THEN SEE IF NEXT WORD HAS 2ND CHAR AT TOP
  481. *
  482. SA3 A2+B1 X3 = FOLLOWING WORD
  483. BX1 -X5-X3 GET 6 ZEROS TO TOP IF MATCH
  484. AX1 54 SHIFT OFF THE REST OF THE JUNK
  485. ZR X1,INORDER JUMP IF MATCH (SKIP INTERMEDIATE TEST)
  486. MX1 54 ELSE WIPE OUT TENTH CHARACTER FLAG
  487. BX7 X1*X7
  488. ZR X7,NXTWORD SEE IF THERE WERE ANY OTHER THAN NO. 10
  489. *
  490. * SEE IF 2ND CHARACTER IS ALSO THERE
  491. *
  492. CHAR2ND BX1 X2-X5 MAKE 6 1-S EVERYWHERE THE 2ND CHARACTER WAS
  493. LX3 X1,B1 SHIFT A COPY 1 BIT
  494. BX1 X1*X3 COMBINE EVEN AND ODD BITS
  495. LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS
  496. BX3 X1*X3 COMBINE AGAIN
  497. LX1 X3,B2 SHIFT THIS COMBO 2 BITS
  498. BX3 X1*X3 COMBINE ONCE AGAIN
  499. LX3 6 MOVE REMAINING BITS FROM CHAR 2
  500. BX7 X3*X7
  501. ZR X7,NXTWORD IF NOT IN SEQUENCE GO TO NEXT WORD
  502. * /--- BLOCK F-IN ORDER 00 000 77/09/04 08.36
  503. **********************************************************
  504. ***** FIRST 2 CHARS ARE PRESENT AND IN ORDER *************
  505. **********************************************************
  506. SA3 A2+B1 X3 = FOLLOWING WORD
  507. *
  508. * IF IN CHAR POSITION 0, NO SHIFTING NECESSARY
  509. *
  510. INORDER SB3 B0 PRESET CHAR POSITION COUNTER
  511. BX1 X2 SET COMPARE WORD (X1)
  512. NG X7,COMPARE JUMP IF CHAR POSITION 0
  513. *
  514. * LOOP TO DETERMINE OTHER 2 CHARACTER MATCHES
  515. *
  516. OCCLOOP SB3 B3+B1 B3 = CHAR POSITION (0-9)
  517. LX7 6 SHIFT FLAG WORD
  518. PL X7,OCCLOOP LOOP IF SIGN BIT OFF
  519. *
  520. * WHEN FLAG COMES INTO SIGN BIT CREATE COMPARE WORD
  521. *
  522. SB4 B3+B3
  523. SB4 B4+B3
  524. SB4 B4+B4 B4 = MASK LENGTH (B3*6)
  525. *
  526. SB4 B4-B1 SUBTRACT INITIAL MASK LENGTH
  527. MX1 1 INITIAL MASK
  528. AX1 X1,B4 FORM MASK IN X1, B4 BITS
  529. BX2 -X1*X2 CLEAR UNEEDED CHARS FROM WORD
  530. BX1 X1*X3 AND UNEEDED CHARS FROM WORD +1
  531. BX1 X1+X2 PUT THEM TOGETHER
  532. SB4 B4+1 RESET B4
  533. LX1 X1,B4 SHIFT TO PROPER POSITION
  534. *
  535. * NOW COMPARE WITH OBJECT
  536. *
  537. COMPARE LX7 1
  538. AX7 1 CLEAR SIGN BIT (OCCLOOP END TEST)
  539. BX1 X1-X0 COMPARE WITH OBJECT
  540. AX1 X1,B5 ONLY AFTER SHIFTING OFF JUNK
  541. ZR X1,FOUNDIT IF PERFECT MATCH
  542. ZR X7,NXTWORD IF NO MORE TO TEST, GO TO NEXT WORD
  543. EQ OCCLOOP OTHERWISE LOOP
  544. * /--- BLOCK F-FOUNDOBJ 00 000 77/09/04 08.42
  545. *********************************************************
  546. *************** FOUND FULL STRING MATCH *****************
  547. *********************************************************
  548. *
  549. * CALCULATE CHARACTER LENGTH FROM BASE ADDRESS
  550. *
  551. FOUNDIT SB4 A0 A0 HAS BASE ADDRESS
  552. SX1 A2-B4 X1 = WORD COUNT
  553. SB4 X1
  554. SB4 B4+X1 MULTIPLY BY 2 TO B4
  555. LX1 3 MULTIPLY BY 8 TO X1
  556. SB4 X1+B4 B4 = WORD COUNT * 10
  557. SB4 B4+B3
  558. SB4 B4+B1 B4 = CHAR LENGTH FROM BASE
  559. *
  560. * TEST TO MAKE SURE IT IS GREATER THAN OFFSET
  561. *
  562. SA1 TSRCMXM RESTORE CHECK WORD
  563. SB2 X1
  564. AX1 18
  565. LT B4,B2,RESRCH1 SEARCH MORE IF NOT
  566. *
  567. * TEST TO SEE IF GREATER THAN MAXIMUM CHAR LENGTH
  568. *
  569. SB2 X1 B2 HAS MAX CHAR COUNT
  570. SX6 -B1 X6 = SET FOR NOT FOUND
  571. GT B4,B2,NOTFND IF NOT FOUND, GO AND EXIT
  572. *
  573. * TEST TO SEE IF PLANTED INTERRUPT TEST (OR WORD BEFORE)
  574. *
  575. SX6 B4 X6 = CHARACTER POSITION OF FOUND MATCH
  576. SB2 A7-B1 SO WILL TEST FOR WORD BEFORE
  577. SB2 A2-B2 SUBTRACT FROM CURRENT ADDRESS
  578. GE B2,B0,TIMETST
  579. * /--- BLOCK F-STO/SNGL 00 000 77/09/04 08.39
  580. *
  581. OKFIND SB6 B6-B1 DECREMENT COUNTER
  582. NG B6,RESRCH IF ONLY COUNT SEARCH
  583. *
  584. *
  585. *
  586. STORE
  587. NZ B6,RESRCH
  588. *
  589. *
  590. *
  591. SA1 A1 RESTORE FLAG WORD
  592. LX1 1
  593. NG X1,EXIT
  594. *
  595. * GET READY TO SEARCH AGAIN
  596. *
  597. RESRCH SA1 SPIKES BRING UP SPIKED WORD
  598. BX6 X1
  599. RESRCH1 SB2 B1+B1 RESET B2
  600. ZR X7,NSRCH
  601. SX1 B5-54
  602. NZ X1,OCCLOOP RETURN TO LOOP IF MULTIPLE CHAR SEARCH
  603. EQ SINGLP OTHERWISE GOTO SINGLE LOOP
  604. *
  605. *
  606. **********************************************************
  607. ************ SINGLE CHARACTER SEARCH *********************
  608. **********************************************************
  609. *
  610. SINGLE SA2 A2+B1 X2 = NEXT WORD TO BE CHECKED
  611. BX1 X2-X4 MAKE 6 1-S EVERYWHERE THE CHARACTER WAS
  612. LX3 X1,B1 SHIFT A COPY 1 BIT
  613. BX1 X1*X3 COMBINE EVEN AND ODD BITS
  614. LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS
  615. BX3 X1*X3 COMBINE AGAIN
  616. LX1 X3,B2 SHIFT THIS COMBO 2 BITS
  617. BX7 X1*X3 COMBINE ONCE AGAIN
  618. BX7 X6*X7 CLEAR THE JUNK WITH SPIKES
  619. *
  620. * NOW HAVE A 1 IN TOP BIT OF ANY CHAR POSITION WHICH
  621. * MATCHED FIRST CHARACTER OF STRING
  622. *
  623. ZR X7,SINGLE LOOP IF NO MATCHES
  624. SB3 B0 PRESET CHAR POSITION COUNT
  625. BX1 X7 SO CAN TEST X1 INSTEAD OF X7
  626. LX7 1
  627. AX7 1 GET RID OF SIGN BIT
  628. NG X1,FOUNDIT IF FOUND IN 1ST CHAR POSITION
  629. *
  630. SINGLP SB3 B3+B1 INCREMENT CHAR POSITION COUNT
  631. LX7 6 SHIFT FLAG REGISTER
  632. PL X7,SINGLP LOOP IF NO SIGN BIT NOT ON
  633. MX1 1
  634. BX7 -X1*X7 GET RID OF SIGN BIT (FOR LOOP END TEST)
  635. EQ FOUNDIT SEEK AND STORE RESULT
  636. *
  637. *
  638. * /--- BLOCK B-NO INTER 00 000 77/09/14 05.42
  639. TITLE REVERSE SEARCH LOOP
  640. *
  641. * ENTER HERE AFTER INTERRUPT OR SETUP
  642. *
  643. BINIT SX1 76B MASK FOR SHIFT COUNT
  644. BX2 X1*X2 CLEAR OUT JUNK BITS
  645. SB5 X2 MOVE SHIFT COUNT TO B5
  646. *
  647. * ENTER HERE AFTER OK TIME CHECK (INTERRUPT NOT PERFORMED)
  648. *
  649. BNLOOP SB1 1 B1 = 1 (STANDARD INCREMENT)
  650. SA1 TSRCST GET STARTING ADDRESS
  651. *
  652. SB4 X1-NWORDS
  653. SA2 X1+1 A2 = STARTING ADDRESS +1
  654. SB2 B1+B1 B2 = 2 (FOR COMBINING BITS)
  655. GT B4,B7,BSETEND JUMP IF NEED INTERRUPT TEST
  656. SB4 B7 B4 = END TEST = LAST SEARCH
  657. * ADDRESS - 1
  658. BSETEND SX6 B4 TO RESTART AT PLANTED WORD
  659. SA6 A1 STORE RESTART ADDRESS
  660. *
  661. * STORE WORD AT END TO GUARANTEE EXIT
  662. *
  663. SA1 B4
  664. BX6 X1
  665. SA6 SAVWORD
  666. BX7 X0 X7 HAS OBJECT
  667. SA7 B4 STORE AT END
  668. *
  669. * NOTE - - A7 HAS END TEST ADDRESS, (MUST BE SAVED FOR END TEST)
  670. *
  671. SA1 SPIKES READ UP MASK WITH EVERY 6TH BIT ON
  672. BX6 X1 X6 = SPIKE MASK
  673. *
  674. ****************************************************
  675. ************ REPEATED SEARCH LOOP ******************
  676. *****************************************************
  677. *
  678. BNSRCH SX1 B5-54 EXAMINE SHIFT COUNT
  679. ZR X1,BSINGLE JUMP IF SINGLE CHAR LOOKUP
  680. * /--- BLOCK B-SEARCHLP 00 000 77/09/04 08.42
  681. ******************************************
  682. ********** SEARCH LOOP *************
  683. ******************************************
  684. *
  685. BNXTWRD SA2 A2-B1 X2 = NEXT WORD TO SEARCH
  686. BX1 X2-X4 MAKE 6 1-S EVERYWHERE THE 1ST CHARACTER WAS
  687. LX3 X1,B1 SHIFT A COPY 1 BIT
  688. BX1 X1*X3 COMBINE EVEN AND ODD BITS
  689. LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS
  690. BX3 X1*X3 COMBINE AGAIN
  691. LX1 X3,B2 SHIFT THIS COMBO 2 BITS
  692. BX7 X1*X3 COMBINE ONCE AGAIN
  693. BX7 X6*X7 CLEAR THE JUNK WITH SPIKES
  694. *
  695. * X7 HAS THE TOP BIT OF EACH CHAR THAT MATCHED THE
  696. * 1ST CHAR OF THE STRING SET
  697. *
  698. ZR X7,BNXTWRD LOOP IF NO MATCHES
  699. *
  700. * SPECIAL CHECK FOR CHAR IN POSITION 10
  701. *
  702. BX1 X7
  703. LX1 54 MOVE FLAG TEN TO SIGN BIT OF X1
  704. PL X1,BCHR2ND JUMP OVER IF NOT
  705. *
  706. * IF YES THEN SEE IF NEXT WORD HAS 2ND CHAR AT TOP
  707. *
  708. SA3 A2+B1 X3 = FOLLOWING WORD
  709. BX1 -X5-X3 GET 6 ZEROS TO TOP IF MATCH
  710. AX1 54 SHIFT OFF THE REST OF THE JUNK
  711. ZR X1,BINORDR JUMP IF MATCH (SKIP INTERMEDIATE TEST)
  712. MX1 54 ELSE WIPE OUT TENTH CHARACTER FLAG
  713. BX7 X1*X7
  714. ZR X7,BNXTWRD SEE IF THERE WERE ANY OTHER THAN NO. 10
  715. *
  716. * SEE IF 2ND CHARACTER IS ALSO THERE
  717. *
  718. BCHR2ND BX1 X2-X5 MAKE 6 1-S EVERYWHERE THE 2ND CHARACTER WAS
  719. LX3 X1,B1 SHIFT A COPY 1 BIT
  720. BX1 X1*X3 COMBINE EVEN AND ODD BITS
  721. LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS
  722. BX3 X1*X3 COMBINE AGAIN
  723. LX1 X3,B2 SHIFT THIS COMBO 2 BITS
  724. BX3 X1*X3 COMBINE ONCE AGAIN
  725. LX3 6 MOVE REMAINING BITS FROM CHAR 2
  726. BX7 X3*X7
  727. ZR X7,BNXTWRD IF NOT IN SEQUENCE GO TO NEXT WORD
  728. * /--- BLOCK B-IN ORDER 00 000 78/01/12 00.59
  729. **********************************************************
  730. ***** FIRST 2 CHARS ARE PRESENT AND IN ORDER *************
  731. **********************************************************
  732. SA3 A2+B1 X3 = FOLLOWING WORD
  733. *
  734. BINORDR SB3 10 PRESET CHAR POSITION COUNTER
  735. *
  736. * LOOP TO FIND 2 CHARACTER MATCHES FROM THE END BACKWARDS
  737. *
  738. BOCLOOP SB3 B3-B1 B3 = CHAR POSITION (0-9)
  739. LX7 -6 SHIFT FLAG WORD
  740. PL X7,BOCLOOP LOOP IF SIGN BIT OFF
  741. ZR B3,B1ST JUMP IF IN 1ST CHAR POSITION
  742. *
  743. * WHEN FLAG COMES INTO SIGN BIT CREATE COMPARE WORD
  744. *
  745. SB4 B3+B3
  746. SB4 B4+B3
  747. SB4 B4+B4 B4 = MASK LENGTH (B3*6)
  748. *
  749. SB4 B4-B1 SUBTRACT INITIAL MASK LENGTH
  750. MX1 1 INITIAL MASK
  751. AX1 X1,B4 FORM MASK IN X1, B4 BITS
  752. BX3 X1*X3 CLEAR UNNEEDED BITS FROM WORD 2
  753. BX1 -X1*X2 AND FROM WORD 1
  754. BX1 X1+X3 PUT THEM TOGETHER
  755. SB4 B4+1 RESET B4
  756. LX1 X1,B4 SHIFT TO PROPER POSITION
  757. *
  758. * NOW COMPARE WITH OBJECT
  759. *
  760. BCOMPAR LX7 1
  761. AX7 1 CLEAR SIGN BIT (BOCLOOP END TEST)
  762. BX1 X1-X0 COMPARE WITH OBJECT
  763. AX1 X1,B5 ONLY AFTER SHIFTING OFF JUNK
  764. ZR X1,BFOUND IF PERFECT MATCH
  765. ZR X7,BNXTWRD IF NO MORE TO TEST, GO TO PRECEDING WORD
  766. EQ BOCLOOP OTHERWISE LOOP
  767. *
  768. B1ST BX1 X2 GET COMPARISON WORD
  769. EQ BCOMPAR NOW DO COMPARE
  770. * /--- BLOCK B-FOUNDOBJ 00 000 77/09/12 12.10
  771. *********************************************************
  772. *************** FOUND FULL STRING MATCH *****************
  773. *********************************************************
  774. *
  775. * CALCULATE CHARACTER LENGTH FROM BASE ADDRESS
  776. *
  777. BFOUND SB4 A0 A0 HAS BASE ADDRESS
  778. SX1 A2-B4 X1 = WORD COUNT
  779. SB4 X1
  780. SB4 B4+X1 MULTIPLY BY 2 TO B4
  781. LX1 3 MULTIPLY BY 8 TO X1
  782. SB4 X1+B4 B4 = WORD COUNT * 10
  783. SB4 B4+B3
  784. SB4 B4+B1 B4 = CHAR LENGTH FROM BASE
  785. *
  786. * TEST TO MAKE SURE IT IS LESS THAN OFFSET
  787. *
  788. SA1 TSRCMXM RESTORE CHECK WORD
  789. SB2 X1
  790. AX1 18
  791. GT B4,B2,BRSRCH1 IF TOO FAR, SEARCH MORE
  792. *
  793. * TEST TO SEE IF LESS THAN LOWEST VALUE
  794. *
  795. SB2 X1 B2 HAS MAX CHAR COUNT
  796. SX6 -B1 X6 = SET FOR NOT FOUND
  797. LT B4,B2,NOTFND EXIT IF TOO SMALL
  798. *
  799. * TEST TO SEE IF PLANTED INTERRUPT TEST
  800. * DON'7T NEED TO CHECK PRECEDING WORD LIKE FORWARD...
  801. *
  802. SX6 B4 X6 = CHARACTER POSITION OF FOUND MATCH
  803. SB2 A7
  804. SB2 A2-B2 SUBTRACT FROM CURRENT ADDRESS
  805. EQ B2,B0,TIMETST
  806. * /--- BLOCK B-STO/SNGL 00 000 77/09/12 12.09
  807. *
  808. BOKFIND SB6 B6-B1 DECREMENT COUNTER
  809. NG B6,BRESRCH IF ONLY COUNT SEARCH
  810. *
  811. *
  812. *
  813. STORE
  814. NZ B6,BRESRCH
  815. *
  816. *
  817. *
  818. SA1 A1 RESTORE FLAG WORD
  819. LX1 1
  820. NG X1,EXIT
  821. *
  822. * GET READY TO SEARCH AGAIN
  823. *
  824. BRESRCH SA1 SPIKES BRING UP SPIKED WORD
  825. BX6 X1
  826. BRSRCH1 SB2 B1+B1 RESET B2
  827. ZR X7,BNSRCH
  828. SX1 B5-54
  829. NZ X1,BOCLOOP RETURN TO LOOP IF MULTIPLE CHAR SEARCH
  830. EQ BSINGLP OTHERWISE GOTO SINGLE LOOP
  831. *
  832. *
  833. **********************************************************
  834. ************ SINGLE CHARACTER SEARCH *********************
  835. **********************************************************
  836. *
  837. BSINGLE SA2 A2-B1 X2 = PREVIOUS WORD BEING CHECKED
  838. BX1 X2-X4 MAKE 6 1-S EVERYWHERE THE CHARACTER WAS
  839. LX3 X1,B1 SHIFT A COPY 1 BIT
  840. BX1 X1*X3 COMBINE EVEN AND ODD BITS
  841. LX3 X1,B2 SHIFT A COPY OF COMBO 2 BITS
  842. BX3 X1*X3 COMBINE AGAIN
  843. LX1 X3,B2 SHIFT THIS COMBO 2 BITS
  844. BX7 X1*X3 COMBINE ONCE AGAIN
  845. BX7 X6*X7 CLEAR THE JUNK WITH SPIKES
  846. *
  847. * NOW HAVE A 1 IN TOP BIT OF ANY CHAR POSITION WHICH
  848. * MATCHED FIRST CHARACTER OF STRING
  849. *
  850. ZR X7,BSINGLE LOOP IF NO MATCHES
  851. SB3 10 PRESET CHAR POSITION COUNT
  852. BSINGLP SB3 B3-B1 DECREMENT CHAR POSITION COUNT
  853. LX7 -6 SHIFT FLAG REGISTER
  854. PL X7,BSINGLP LOOP IF NO SIGN BIT NOT ON
  855. MX1 1
  856. BX7 -X1*X7 GET RID OF SIGN BIT (FOR LOOP END TEST)
  857. EQ BFOUND SEEK AND STORE RESULT
  858. *
  859. *
  860. * /--- BLOCK FINISH/TIM 00 000 80/04/22 01.21
  861. *
  862. * NOT FOUND
  863. *
  864. NOTFND SB6 B6-B1 DECREMENT COUNTER
  865. NG B6,CNTCALC IF COUNT ONLY WAS CALCULATED
  866. STORE
  867. SA1 A1 RESTORE FLAG WORD
  868. LX1 1
  869. NG X1,EXIT
  870. CNTCALC SB6 B6+B1 SET COUNT BACK AGAIN
  871. SA1 A1 RESTORE FLAG WORD
  872. AX1 36 X2 = INITIAL RESULT ADDRESS
  873. *
  874. SB2 X1
  875. SB3 A4-B6
  876. SX6 B3-B2
  877. *
  878. PL X1,STORCNT IF NOT FLOATING, STORE AS INT
  879. PX6 X6
  880. NX6 X6 PACK AND NORMALIZE
  881. STORCNT SA6 X1 STORE COUNT
  882. *
  883. * CLEAN UP AND EXIT
  884. *
  885. EXIT SA2 A7
  886. IX2 X2-X0
  887. NZ X2,NOREST
  888. SA1 SAVWORD
  889. BX6 X1
  890. SA6 A7
  891. NOREST SA1 SAVEB5 AND B REGISTERS
  892. SA2 SAVEB7
  893. SB5 X1
  894. SB7 X2
  895. EQ PROCESX -- AND EXIT
  896. *
  897. * COME HERE AFTER HITTING THE PLANTED OBJECT TO SEE
  898. * IF TIME SLICE IS OVER AND SEARCH SHOULD BE INTERRUPTED
  899. *
  900. TIMETST SA1 A7 FETCH WORD USED FOR END TEST
  901. BX1 X0-X1 COMPARE WITH OBJECT
  902. NZ X1,NOREST2 DONT RESTORE IF NOT EQUAL
  903. SA1 SAVWORD
  904. BX6 X1
  905. SA6 A7 RESTORE WORD DESTROYED BY END TEST
  906. *
  907. NOREST2 SA1 XSLCLOK GET RUNNING CPU CLOCK
  908. SA2 MAXCLOK GET END OF TIME-SLICE
  909. IX2 X1-X2
  910. SA1 TSRCEND GET DIRECTION INDICATION
  911. PL X2,AUTOBRK INTERRUPT IF TOO MUCH TIME
  912. PL X1,NLOOP CONTINUE FORWARD SEARCH
  913. EQ BNLOOP ... OR BACKWARD SEARCH
  914. * /--- BLOCK INTERRUPT 00 000 78/05/17 20.51
  915. *
  916. * PACK UP ALL VITAL REGISTERS TO SAVE DURING INTERRUPT
  917. *
  918. AUTOBRK SX6 B6 NEED TO SAVE STORE INDEX
  919. SA6 TSRCINX SO DO IT
  920. *
  921. * RESTORE B REGISTERS
  922. *
  923. SA1 SAVEB5
  924. SA2 SAVEB7
  925. SB5 X1
  926. SB7 X2
  927. *
  928. *
  929. * PERFORM INTERRUPT
  930. *
  931. RETURN DO THE INTERRUPT
  932. *
  933. * OUT OF LINE ROUTINES, LITERALS AND STORAGE LOCATIONS
  934. *
  935. SPIKES VFD 60/40404040404040404040B
  936. SRCHSAV BSS 1 STORES FIRST ARGUMENT WORD
  937. SRCHSV2 BSS 1 STORES SECOND ARGUMENT WORD
  938. SRCHLEN BSS 1 LENGTH OF SEARCH IN CHARS
  939. SRCHOBL BSS 1 LENGTH OF SEARCH OBJECT
  940. SAVEB5 BSS 1 SAVES B5
  941. SAVEB7 BSS 1 SAVES B7
  942. SAVWORD BSS 1 CONTAINS WORD USED FOR END TEST
  943. SRCHADR BSS 1 RESULT BUFFER ADDRESS
  944. *
  945. * EXEC ERROR FOR OFFSET TOO LARGE
  946. *
  947. SERX SX2 B3+1 SET UP FOR EXEC ERROR ROUTINE
  948. EXECERR 101
  949. *
  950. * EXIT IF NO SEARCH
  951. *
  952. NOSRCH MX6 -1
  953. SA1 TSRCMXM GET WORD CONTAINING RESULT ADDR
  954. BX2 X1
  955. LX2 1 GET MULTIPLE SEARCH BIT TO TOP
  956. AX1 36 BRING ADDRESS DOWN
  957. PL X1,NOSRCH2 BRANCH IF STORING INTEGERS
  958. PX6 X6
  959. NX6 X6 FLOAT THE -1
  960. NOSRCH2 NG X2,NOSRCH3 BRANCH IF SINGLE SEARCH
  961. MX7 0
  962. SA7 X1 SET COUNTER TO 0
  963. SX1 A7+1 UPDATE STORAGE ADDRESS
  964. SA2 TSRCINX CHECK IF COUNT ONLY DESIRED
  965. ZR X2,PROCESX EXIT IF SO
  966. NOSRCH3 SA6 X1 STORE -1 FOR NOT FOUND
  967. EQ PROCESX AND EXIT
  968. *
  969. *
  970. ENDOV
  971. * /--- BLOCK ABORT 00 000 80/07/16 01.35
  972. TITLE -ABORT- COMMAND
  973. *
  974. * -ABORT- COMMAND
  975. * ABORT VARIOUS SYSTEM FUNCTIONS
  976. *
  977. *
  978. ABORTOV OVRLAY
  979. PL X5,ABORTR SEE IF ABORT COMMON
  980. *
  981. *
  982. * ABORT RETURN OF COMMON TO DISK
  983. *
  984. SA1 TBCOMLS GET COMMON LESSON NUMBER
  985. SX0 X1
  986. ZR X0,ABRTER1 EXIT IF NO COMMON
  987. LX1 1
  988. NG X1,ERXROLC EXIT IF READ-ONLY COMMON
  989. SX1 X0 GET *LESNUM*
  990. CALL LSNADDR
  991. SX1 1
  992. IX0 X0+X1 ADVANCE TO LESSON NAME WORD
  993. SA1 CABORT GET *ABORT* CODE WORD
  994. WX1 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*)
  995. *
  996. * /--- BLOCK ABORT 00 000 79/04/07 01.15
  997. ABORTR LX5 1 SEE IF ABORT RECORD
  998. PL X5,ABORTN
  999. MX6 6 MASK TO CHECK TOP CHARACTER
  1000. SA1 TTYPE USER TYPE
  1001. SA2 TYPETAB+UT.STUD
  1002. BX2 X2-X1
  1003. BX2 X2*X6 CHECK ONLY FIRST CHARACTER
  1004. NZ X2,ABORTN --- IGNORE IF NOT STUDENT
  1005. SA2 KABORT X2 = 6LSABORT
  1006. BX6 X2
  1007. SA6 A1 SET RECORDS TO -SABORT-
  1008. EQ ABORTN1 NOW SET CHECKPOINT OFF FLAG
  1009. *
  1010. * 'NOW USER PART OF RECORDS WILL NOT BE UPDATED
  1011. * ON DISK, BUT LAST DATE, CPU USE, ETC. WILL.
  1012. *
  1013. ABORTN LX5 1 SEE IF ABORT AUTO-CHECK-POINT
  1014. PL X5,ABORTL
  1015. SA1 TTYPE USER TYPE
  1016. SA2 TYPETAB+UT.STUD
  1017. BX2 X2-X1
  1018. NZ X2,ABORTL --- IGNORE IF NOT STUDENT
  1019. SA2 KNOCKPT X2 = 7LSNOCKPT
  1020. BX6 X2
  1021. SA6 A1 SET RECORDS TO -SNOCKPT-
  1022. *
  1023. ABORTN1 SA1 TRECBIT GET WORD HOLDING CHECKPT FLAG
  1024. MX6 1
  1025. LX6 60-CCHKSHF POSITION CHECKPOINT BIT
  1026. BX6 -X6*X1 CLEAR BIT (TURN CHECKPOINT OFF)
  1027. MX1 1
  1028. LX1 60-DCHKSHF POSITION BIT FOR DEFAULT
  1029. BX6 -X1*X6 CLEAR CHECKPT DEFAULT
  1030. SA6 A1
  1031. CALL CHKSET SET OVERALL CHECKPT STATUS
  1032. *
  1033. ABORTL LX5 1 SEE IF ABORT LESLIST
  1034. PL X5,ABORTZ
  1035. SA1 TBLLIST GET LESLIST LESSON NUMBER
  1036. SX0 X1
  1037. ZR X0,ABRTER3 EXIT IF NO LESLIST
  1038. SX1 X0 GET *LESNUM*
  1039. CALL LSNADDR
  1040. SX1 1
  1041. IX0 X0+X1 ADVANCE TO LESSON NAME WORD
  1042. SA1 CABORT GET *ABORT* CODE WORD
  1043. WX1 X0 (-WXX- 1 WD WRITE, MAY CHG *A6*)
  1044. *
  1045. ABORTZ EQ PROC
  1046. *
  1047. *
  1048. ABRTER1 EXECERR 53 *NO COMMON*
  1049. *
  1050. ABRTER3 EXECERR 55 *NO LESLIST*
  1051. *
  1052. *
  1053. CABORT VFD 60/9L**ABORT**
  1054. *
  1055. *
  1056. ENDOV
  1057. * /--- BLOCK CHECKPT 00 000 80/03/11 03.01
  1058. TITLE -CHECKPT- COMMAND
  1059. *
  1060. *
  1061. * -CHECKPT- COMMAND
  1062. * TURN STUDENT RECORD CHECKPOINTING ON OR OFF
  1063. *
  1064. * AFTER EXECUTION OF -CHECKPT- COMMAND,
  1065. *
  1066. * ZRETURN = -1 = IT WORKED
  1067. * = 0 = WRONG USER TYPE
  1068. *
  1069. *
  1070. CKPTOV OVRLAY
  1071. SX6 0
  1072. SA6 TRETURN PRESET *ZRETURN* FOR FAILURE
  1073. SA1 TTYPE GET USER TYPE
  1074. SA2 TYPETAB+UT.STUD
  1075. BX2 X1-X2
  1076. ZR X2,CKPT0 --- OK IF STUDENT
  1077. SA2 TYPETAB+UT.INST
  1078. BX2 X1-X2
  1079. NZ X2,PROC --- IGNORE IF NOT INSTRUCTOR
  1080. CKPT0 NGETVAR
  1081. MX6 1
  1082. LX6 60-CCHKSHF POSITION CHECKPOINT BIT
  1083. SA2 TRECBIT WORD HOLDING CHECKPOINT FLAG
  1084. NZ X1,CKPTON --- JUMP IF -CHECKPT ON-
  1085. *
  1086. BX6 -X6*X2 CLEAR BIT (CHECKPOINT OFF)
  1087. EQ CKPT1
  1088. *
  1089. CKPTON BX6 X6+X2 SET BIT (CHECKPOINT ON)
  1090. *
  1091. CKPT1 CALL INROUTE
  1092. PL X1,CKPT2 IF NOT EXECUTING ROUTER
  1093. BX1 X6
  1094. LX1 CCHKSHF SHIFT CURRENT STATUS TO SIGN
  1095. MX0 1
  1096. BX1 X0*X1 X1 = CURRENT CHECKPT STATUS
  1097. LX0 60-DCHKSHF SHIFT BIT TO DEFAULT STATUS
  1098. BX6 -X0*X6 CLEAR DEFAULT STATUS
  1099. LX1 60-DCHKSHF SHIFT CURRENT STATUS TO DEFAULT
  1100. BX6 X1+X6 RESET DEFAULT STATUS
  1101. CKPT2 SA6 A2 UPDATE *TRECBIT*
  1102. CALL CHKSET SET OVERALL CHECKPT STATUS
  1103. SX6 -1
  1104. SA6 TRETURN SET *ZRETURN* TO ALL OK
  1105. EQ PROC
  1106. *
  1107. ENDOV
  1108. * /--- BLOCK STOLOAD 00 000 76/08/17 16.40
  1109. TITLE -STOLOAD- COMMAND
  1110. *
  1111. *
  1112. * -STOLOAD- COMMAND
  1113. * SETS AUTOMATIC LOADING OF -STORAGE-
  1114. *
  1115. *
  1116. STOLOV OVRLAY
  1117. SA1 OVARG1
  1118. NZ X1,COMLOD JUMP IF -COMLOAD- COMMAND
  1119. *
  1120. SA1 TBXSTOR SEE IF ANY -STORAGE-
  1121. ZR X1,SCLONO
  1122. CALL READLES,LHEADER,1
  1123. SX6 2
  1124. IX6 X0+X6 BIAS TO STORAGE
  1125. SA6 LLECSAD
  1126. SA1 INHIBS
  1127. MX6 1 CLEAR -UNLOAD- BIT
  1128. LX6 60-UNLOSHF
  1129. BX6 -X6*X1
  1130. SA6 A1
  1131. LX1 UNLOSHF SEE IF INHIBIT -UNLOAD-
  1132. NG X1,STOLO1
  1133. SA1 TSTOSET
  1134. ZR X1,STOLO1 JUMP IF NO STORAGE AUTO-LOAD
  1135. SA2 TBXSTOR STORAGE LESSON NUMBER
  1136. SX3 2 BIAS FOR STORAGE HEADER
  1137. CALL LESSADD
  1138. RJ ULOADER DO FIRST UNLOAD
  1139. SA1 TSTOSET+1
  1140. ZR X1,STOLO1
  1141. RJ ULOADER DO SECOND UNLOAD
  1142. SA1 TSTOSET+2
  1143. ZR X1,STOLO1
  1144. RJ ULOADER DO THIRD UNLOAD
  1145. *
  1146. STOLO1 MX6 0
  1147. SA6 TSTOSET CLEAR CURRENT SELECTIONS
  1148. SA6 TSTOSET+1
  1149. SA6 TSTOSET+2
  1150. SX6 TSTOSET
  1151. SA6 LBUFF
  1152. CALL LOADSET
  1153. MX6 1
  1154. SA1 INHIBS CLEAR -INHIBIT LOAD- BIT
  1155. LX6 60-LOADSHF
  1156. BX6 -X6*X1
  1157. SA6 A1
  1158. EQ PROCESS
  1159. *
  1160. *
  1161. * /--- BLOCK COMLOAD 00 000 77/07/21 20.50
  1162. TITLE -COMLOAD- COMMAND
  1163. *
  1164. *
  1165. * -COMLOAD- COMMAND
  1166. * SETS AUTOMATIC LOADING OF -COMMON-
  1167. *
  1168. *
  1169. COMLOD SA1 TBCOMLS SEE IF ANY -COMMON-
  1170. SX1 X1
  1171. ZR X1,SCLONO
  1172. CALL READLES,LHEADER,1
  1173. SX6 COMHEAD
  1174. IX6 X0+X6 BIAS TO COMMON
  1175. SA6 LLECSAD
  1176. SA1 INHIBS
  1177. MX6 1 CLEAR -UNLOAD- BIT
  1178. LX6 60-UNLOSHF
  1179. BX6 -X6*X1
  1180. SA6 A1
  1181. LX1 UNLOSHF SEE IF INHIBIT -UNLOAD-
  1182. NG X1,COMLO1
  1183. SA1 TCOMSET
  1184. ZR X1,COMLO1 JUMP IF NO COMMON AUTO-LOAD
  1185. SA3 TBCOMLS
  1186. SX2 X3 PICK OFF LESSON NUMBER
  1187. LX3 1
  1188. NG X3,COMLO1 JUMP IF READ-ONLY COMMON
  1189. SX3 COMHEAD
  1190. CALL LESSADD GET ADDRESS OF COMMON LESSON
  1191. RJ ULOADER DO FIRST UNLOAD
  1192. SA1 TCOMSET+1
  1193. ZR X1,COMLO1
  1194. RJ ULOADER DO SECOND UNLOAD
  1195. SA1 TCOMSET+2
  1196. ZR X1,COMLO1
  1197. RJ ULOADER DO THIRD UNLOAD
  1198. *
  1199. COMLO1 MX6 0
  1200. SA6 TCOMSET CLEAR CURRENT SELECTIONS
  1201. SA6 TCOMSET+1
  1202. SA6 TCOMSET+2
  1203. SX6 TCOMSET
  1204. SA6 LBUFF
  1205. CALL LOADSET
  1206. MX6 1
  1207. SA1 INHIBS CLEAR -INHIBIT LOAD- BIT
  1208. LX6 60-LOADSHF
  1209. BX6 -X6*X1
  1210. SA6 A1
  1211. EQ PROCESS
  1212. *
  1213. *
  1214.  
  1215. SCLONO MX0 XCODEL COMES HERE IF NO COMMON/STORAGE
  1216. BX6 X0*X5 MASK OFF NUMBER OF ARGUMENTS
  1217. ZR X6,PROCESS OKAY IF BLANK TAG
  1218. EQ ERXNOCS
  1219. *
  1220. * /--- BLOCK LOADSET 00 000 79/02/09 13.56
  1221. *
  1222. TITLE -LOADSET-
  1223. *
  1224. *
  1225. * -LOADSET-
  1226. * EXECUTION OF -STOLOAD- AND -COMLOAD- COMMANDS
  1227. *
  1228. *
  1229. LOADSET EQ *
  1230. MX0 XCODEL
  1231. BX6 X0*X5 MASK OFF NUMBER OF ARGUMENTS
  1232. ZR X6,LOADSET
  1233. LX6 XCODEL
  1234. SA6 NLOADS
  1235. MX0 -12
  1236. AX5 XCMNDL
  1237. BX6 -X0*X5 MASK OFF XSTOR ADDRESS
  1238. SX6 X6+B5
  1239. SA6 GVADD SAVE ABSOLUTE ADDRESS
  1240. *
  1241. LOLOOP SA1 GVADD
  1242. SA1 X1 LOAD WORD OF -GETVAR- CODES
  1243. BX5 X1
  1244. NGETVAR
  1245. SX6 A1 SAVE CM ADDRESS FOR LOADING
  1246. SA6 VBUFF
  1247. SX1 NCVRBUF
  1248. IX6 X6-X1 CANNOT LOAD INTO STUDENT BANK
  1249. NG X6,LDERR1 OR ROUTER VARIABLES
  1250. SA1 GVADD
  1251. SA1 X1
  1252. LX1 XCODEL POSITION NEXT -GETVAR- CODE
  1253. BX5 X1
  1254. NGETVAR GET ECS ADDRESS FOR LOADING
  1255. SX6 X1-1 EXECERR USES X1
  1256. NG X6,ERXINDL INDEX ERROR ON LOWER BOUND
  1257. SA6 VBUFF+1
  1258. SA1 GVADD
  1259. SX7 X1+1 ADVANCE POINTER
  1260. SA7 A1
  1261. SA1 X1 LOAD WORD OF -GETVAR- CODES
  1262. LX1 2*XCODEL
  1263. BX5 X1
  1264. NGETVAR GET LENGTH TO LOAD/UNLOAD
  1265. ZR X1,LDSKIP IF LENGTH 0, IGNORE
  1266. NG X1,ERXBADL EXECERR USES X1
  1267. *
  1268. SA2 VBUFF LOAD CM ADDRESS FOR LOADING
  1269. SA0 X2
  1270. CALL BOUNDS CM BOUNDS CHECK
  1271. SX6 X1
  1272. SA1 LHEADER
  1273. SX1 X1 LENGTH OF -STORAGE-
  1274. SA2 VBUFF+1 STARTING ECS ADDRESS OF LOAD
  1275. IX0 X2+X6
  1276. IX0 X1-X0 DO ECS BOUNDS CHECK
  1277. NG X0,ERXECSB1 EXCEEDING BOUNDS
  1278. * /--- BLOCK LOADSET 00 000 77/08/07 21.26
  1279. *
  1280. BX0 X2
  1281. LX2 18 POSITION ECS ADDRESS
  1282. SB1 X6
  1283. LX6 18+18 POSITION LENGTH
  1284. BX6 X2+X6
  1285. SA1 VBUFF
  1286. SA0 X1
  1287. BX6 X1+X6 ATTACH CM ADDRESS
  1288. SA1 INHIBS
  1289. LX1 LOADSHF SEE IF -INHIBIT- LOAD
  1290. NG X1,LOLP1
  1291. SA1 LLECSAD
  1292. IX0 X0+X1 COMPUTE ECS ADDRESS
  1293. + RE B1 DO THE LOAD
  1294. RJ ECSPRTY
  1295. *
  1296. LOLP1 SA1 NLOADS
  1297. SX7 X1-1 NUMBER OF SETS TO DO
  1298. SA7 A1
  1299. SA1 LBUFF *TSTOSET* / *TCOMSET* POINTER
  1300. SA6 X1
  1301. SX6 X1+1
  1302. SA6 A1 UPDATE POINTER
  1303. NG X7,LOADSET
  1304. ZR X7,LOADSET
  1305. EQ LOLOOP
  1306. *
  1307. LDSKIP SA1 NLOADS IF LENGTH=0, SKIP IT
  1308. SX7 X1-1
  1309. SA7 A1 RESET NLOADS
  1310. SB1 X7
  1311. LE B1,LOADSET
  1312. EQ LOLOOP
  1313. *
  1314. *
  1315. LDERR1 EXECERR 67 *NOT NC OR VC VARIABLES*
  1316. *
  1317. ERXECSB1 BX3 X1 LTH OF ECS COM/STO
  1318. BX1 X2 START ADDRESS
  1319. SX1 X1+1
  1320. BX2 X6 TOTAL LTH REQUESTED
  1321. EQ ERXECSB
  1322. *
  1323. * /--- BLOCK LOADSET 00 000 80/02/22 23.37
  1324. LOADER EQ *
  1325. SA0 X1 PICK OFF CM ADDRESS
  1326. AX1 18
  1327. SX2 X1 PICK OFF ECS BIAS
  1328. AX1 18
  1329. SB1 X1 PICK OFF LENGTH TO LOAD
  1330. IX0 X2+X7
  1331. + RE B1
  1332. RJ ECSPRTY
  1333. EQ LOADER
  1334. *
  1335. *
  1336. ULOADER EQ *
  1337. SA0 X1 PICK OFF CM ADDRESS
  1338. AX1 18
  1339. SX2 X1 PICK OFF ECS BIAS
  1340. AX1 18
  1341. SB1 X1 PICK OFF LENGTH TO UNLOAD
  1342. IX0 X2+X7
  1343. + WE B1
  1344. RJ ECSPRTY
  1345. EQ ULOADER
  1346. *
  1347. LBUFF EQU VARBUF
  1348. LLECSAD EQU LBUFF+1
  1349. LHEADER EQU LLECSAD+1
  1350. NLOADS EQU LHEADER+1
  1351. GVADD EQU NLOADS+1
  1352. VBUFF EQU GVADD+1
  1353. *
  1354. *
  1355. ENDOV
  1356. * /--- BLOCK TRANSFER 00 000 78/05/17 20.51
  1357. TITLE TIMING COMMANDS
  1358. *
  1359. *
  1360. TIMOV OVRLAY
  1361. *
  1362. * * ENSURE THAT THERE IS ENOUGH SPACE IN THE ACTION
  1363. * * REQUEST BUFFER--AS OUTPUT OVERFLOW IS FATAL
  1364. *
  1365. EXT RETRNZ
  1366.  
  1367. SA1 AOUTLOC CHECK WHETHER THERE IS
  1368. SX1 X1-AOUTLTH+8 ROOM FOR TWO TIMING REQUESTS
  1369. PL X1,RETRNZ RE-START THIS COMMAND NEXT TIME
  1370. *
  1371. * * IT SHOULD NO LONGER BE POSSIBLE TO GET AN OUTPUT
  1372. * * BUFFER OVERFLOW FROM -TIME- COMMANDS. A NUMBER OF
  1373. * * USERS LOOPING ON -TIME- COMMANDS CAN INTEFERE WITH
  1374. * * THE ORDERLY PROCESSING OF ACTION BUFFER REQUESTS
  1375. * * BY FILLING UP THE BUFFER (THERE WILL BE 4 WORDS LEFT)
  1376. * * CORRECTION BY B. RADER /DMA 3/2/77
  1377. *
  1378.  
  1379. SA1 OVARG1
  1380. SB1 X1
  1381. JP B1+*+1
  1382. *
  1383. + EQ TIMEX
  1384. + EQ TIMELX
  1385. + EQ TIMERX
  1386. *
  1387. *
  1388. * /--- BLOCK TIME 00 000 81/06/24 21.45
  1389. *
  1390. * -TIME-
  1391. * INITIATES TIMING FOR SPECIFIED NUMBER OF SECONDS.
  1392. *
  1393. TIMEX NG X5,TIMEOFF TURN OFF TIMING IN BLANK TAG
  1394. FGETVAR GET TIMING VALUE
  1395. NG X1,TIMEOFF TURN OFF TIMING IF NEGATIVE TAG
  1396. SA2 TK1000 CONVERT TO MILLISECONDS
  1397. FX7 X1*X2
  1398. UX7 X7,B1 CONVERT TO INTEGER
  1399. LX7 X7,B1
  1400. SX2 750 CONVERT SHORTER THAN 3/4 SEC.
  1401. IX2 X7-X2 TO 3/4 SECONDS
  1402. + PL X2,*+1
  1403. SX7 750
  1404. + SA3 AOUTLOC THEN PUT IN TIMING REQUEST
  1405. SX6 X3+4 TAKES FOUR WORDS
  1406. SX2 X3-AOUTLTH OVERFLOW CHECK
  1407. PL X2,ERROROF
  1408. SA6 A3 UPDATE NUMBER OF OUTPUT WORDS
  1409. SX6 RQTIMNG PUT IN TIMING REQUEST CODE
  1410. SA6 X3+ACTOUT
  1411. SA7 A6+1 PUT IN TIME
  1412. SX6 TK.TUP KEY = PTIMEUP
  1413. SA6 A7+1 PUT IN KEY
  1414. SX6 TRT.TIM -TIME- COMMAND REQUEST
  1415. SA6 A6+1 PUT IN REQUEST TYPE
  1416. *
  1417. SA2 TIMING TURN ON TIMING FLAG
  1418. MX6 1
  1419. BX2 X2+X6
  1420. LX6 TMEDONE-59 CLEAR -TIME- UNPROCESSED FLAG
  1421. BX6 -X6*X2
  1422. SA6 A2
  1423. EQ PROCESS
  1424. *
  1425. TIMEOFF SA2 TIMING SEE IF TIMING IN PROGRESS
  1426. PL X2,PROCESS EXIT IF NOT
  1427. MX6 1 TURN OFF TIMING FLAG
  1428. BX2 -X6*X2
  1429. LX6 TMEDONE-59 CLEAR -TIME- UNPROCESSED BIT
  1430. BX6 -X6*X2
  1431. SA6 A2
  1432. *
  1433. SA3 AOUTLOC PUT IN CLEAR TIMING REQUEST
  1434. SX6 X3+2 TAKES TWO WORDS
  1435. SX2 X3-AOUTLTH OVERFLOW CHECK
  1436. PL X2,ERROROF
  1437. SA6 A3 UPDATE NUMBER OF OUTPUT WORDS
  1438. SX6 RQTIMCL
  1439. SA6 X3+ACTOUT
  1440. SX6 TRT.TIM CLEAR -TIME- REQUEST
  1441. SA6 A6+1
  1442. EQ PROCESS
  1443. * /--- BLOCK TIMEL 00 000 81/06/24 21.46
  1444. TITLE -TIMEL-
  1445. *
  1446. * -TIMEL- COMMAND
  1447. *
  1448. * SPECIFIES UNIT OF LESSON TO GO TO AFTER
  1449. * SPECIFIED NUMBER OF SECONDS.
  1450. *
  1451. *
  1452. TIMELX NG X5,TMLOFF TURN OFF TIMEL'/
  1453. MX0 -XCODEL
  1454. LX5 XCODEL POSITION UNIT NUMBER
  1455. BX6 -X0*X5
  1456. SA6 ILOC SAVE UNIT NUMBER
  1457. *
  1458. FGETVAR GET NUMBER OF SECONDS
  1459. NG X1,TMLOFF TURN OFF IF NEGATIVE
  1460. SA2 TK1000 CHANGE SECONDS TO MILLISECONDS
  1461. FX1 X2*X1
  1462. UX1 X1,B1 UNPACK TO INTEGER
  1463. LX6 X1,B1
  1464. SX2 750 3/4 SECOND
  1465. IX1 X6-X2 CONVERT TIMES LESS THAN .75 SEC
  1466. + PL X1,*+1
  1467. SX6 750 TO .75 SECONDS
  1468. + SA6 ILOC+1 SAVE TIME AMOUNT
  1469. *
  1470. SA1 ILOC
  1471. CALL UEXIST CHECK IF UNIT EXISTS
  1472. ZR X6,TMLOFF IF DONT, TURN TIMEL OFF
  1473. SA2 TIMING IF EXISTS, SAVE UNIT NUMBER
  1474. MX6 -12 TURN OFF OLD UNIT NUMBER
  1475. BX2 X2*X6
  1476. BX2 X2+X1 .OR. IN NEW UNIT NUMBER
  1477. MX6 1 CLEAR -TIMEL- UNPROCESSED BIT
  1478. LX6 TMLDONE-59
  1479. BX6 -X6*X2
  1480. SA6 A2
  1481. *
  1482. * SET UP TIMING REQUEST FOR [ILOC+1] MILLISECONDS,
  1483. SA3 AOUTLOC
  1484. SX6 X3+4 TAKES FOUR WORDS
  1485. SX2 X3-AOUTLTH OVERFLOW CHECK
  1486. PL X2,ERROROF
  1487. SA6 A3 UPDATE NUMBER OF OUTPUT WORDS
  1488. SX6 RQTIMNG PUT IN TIMING REQUEST CODE
  1489. SA6 X3+ACTOUT
  1490. SA1 ILOC+1 GET TIME AMOUNT
  1491. BX6 X1
  1492. SA6 A6+1 PUT IN TIME
  1493. SX6 TK.LUP KEY = PLONGUP
  1494. SA6 A6+1 PUT IN KEY
  1495. SX6 TRT.TML -TIMEL- COMMAND REQUEST
  1496. SA6 A6+1
  1497. EQ PROCESS
  1498. *
  1499. *
  1500. TMLOFF SA3 AOUTLOC PUT IN CLEAR TIMING REQUEST
  1501. SX6 X3+2 TAKES TWO WORDS
  1502. SX2 X3-AOUTLTH OVERFLOW CHECK
  1503. PL X2,ERROROF
  1504. SA6 A3 UPDATE NUMBER OF OUTPUT WORDS
  1505. SX6 RQTIMCL
  1506. SA6 X3+ACTOUT
  1507. SX6 TRT.TML CLEAR -TIMEL- REQUEST
  1508. SA6 A6+1
  1509. *
  1510. * CLEAR -TIMEL- UNIT NUMBER FROM *TIMING*
  1511. SA2 TIMING
  1512. MX6 -12 BOTTOM 12 BITS
  1513. BX2 X6*X2
  1514. MX6 1 CLEAR -TIMEL- UNPROCESSED FLAG
  1515. LX6 TMLDONE-59
  1516. BX6 -X6*X2
  1517. SA6 A2
  1518. EQ PROCESS
  1519. * /--- BLOCK TIMER 00 000 81/06/24 21.47
  1520. TITLE -TIMER-
  1521. *
  1522. * -TIMER- COMMAND
  1523. *
  1524. * SPECIFIES UNIT OF ROUTER TO BRANCH TO AFTER
  1525. * SPECIFIED NUMBER OF SECONDS.
  1526. *
  1527. *
  1528. TIMERX CALL INROUTE
  1529. PL X1,PROC IF NOT IN ROUTER LESSON
  1530. NG X5,TMROFF TURN OFF TIMER'/
  1531. MX0 -XCODEL
  1532. LX5 XCODEL POSITION UNIT NUMBER
  1533. BX6 -X0*X5
  1534. SA6 ILOC SAVE UNIT NUMBER
  1535. *
  1536. FGETVAR GET NUMBER OF SECONDS
  1537. NG X1,TMROFF TURN OFF IF NEGATIVE
  1538. SA2 TK1000 CHANGE SECONDS TO MILLISECONDS
  1539. FX1 X2*X1
  1540. UX1 X1,B1 UNPACK TO INTEGER
  1541. LX6 X1,B1
  1542. SA2 TK1MIN 1 MINUTES (IN MILLISECONDS)
  1543. IX1 X6-X2 CONVERT TIMES LESS THAN 1 MIN
  1544. + PL X1,*+1
  1545. BX6 X2 TO 1 MIN
  1546. + SA6 ILOC+1 SAVE TIME AMOUNT
  1547. *
  1548. SA1 ILOC
  1549. CALL UEXIST CHECK IF UNIT EXISTS
  1550. ZR X6,TMROFF IF DONT, TURN TIMER OFF
  1551. SA2 TIMING IF EXISTS, SAVE UNIT NUMBER
  1552. MX6 -12 TURN OFF OLD UNIT NUMBER
  1553. LX1 12 -TIMER- UNIT NEXT TO BOTTOM 12
  1554. LX6 12 MOVE MASK UP TOO
  1555. BX2 X2*X6
  1556. BX2 X2+X1 .OR. IN NEW UNIT NUMBER
  1557. MX6 1 CLEAR -TIMER- UNPROCESSED FLAG
  1558. LX6 TMRDONE-59
  1559. BX6 -X6*X2
  1560. SA6 A2
  1561. *
  1562. * SET UP TIMING REQUEST FOR [ILOC+1] MILLISECONDS,
  1563. SA3 AOUTLOC
  1564. SX6 X3+4 TAKES FOUR WORDS
  1565. SX2 X3-AOUTLTH OVERFLOW CHECK
  1566. PL X2,ERROROF
  1567. SA6 A3 UPDATE NUMBER OF OUTPUT WORDS
  1568. SX6 RQTIMNG PUT IN TIMING REQUEST CODE
  1569. SA6 X3+ACTOUT
  1570. SA1 ILOC+1 GET TIME AMOUNT
  1571. BX6 X1
  1572. SA6 A6+1 PUT IN TIME
  1573. SX6 TK.RUP KEY = PROUTUP
  1574. SA6 A6+1 PUT IN KEY
  1575. SX6 TRT.TMR -TIMER- COMMAND REQUEST
  1576. SA6 A6+1
  1577. EQ PROCESS
  1578. *
  1579. * /--- BLOCK TIMERX 00 000 81/06/24 21.47
  1580. *
  1581. TMROFF SA3 AOUTLOC PUT IN CLEAR TIMING REQUEST
  1582. SX6 X3+2 TAKES TWO WORDS
  1583. SX2 X3-AOUTLTH OVERFLOW CHECK
  1584. PL X2,ERROROF
  1585. SA6 A3 UPDATE NUMBER OF OUTPUT WORDS
  1586. SX6 RQTIMCL
  1587. SA6 X3+ACTOUT
  1588. SX6 TRT.TMR CLEAR -TIMER- REQUEST
  1589. SA6 A6+1
  1590. *
  1591. * CLEAR -TIMER- UNIT NUMBER FROM *TIMING*
  1592. SA2 TIMING
  1593. MX6 -12 NEXT TO BOTTOM 12 BITS
  1594. LX6 12
  1595. BX2 X6*X2
  1596. MX6 1 CLEAR -TIMER- UNPROCESSED FLAG
  1597. LX6 TMRDONE-59
  1598. BX6 -X6*X2
  1599. SA6 A2
  1600. EQ PROCESS
  1601. *
  1602. TK1000 DATA 1000.0
  1603. TK1MIN DATA 60000 EQUALS 1 MINUTE (IN MSEC)
  1604. *
  1605. *
  1606. ENDOV
  1607. * /--- BLOCK READECS 00 000 78/07/05 01.23
  1608. TITLE -READECS/WRITECS-
  1609. *
  1610. *
  1611. * -READECS/WRITECS- COMMANDS
  1612. *
  1613. * READS OR WRITES ECS RELATIVE TO PLATO
  1614. *
  1615. * ON ENTRY,
  1616. *
  1617. * OVARG1 = 0 FOR -READECS-
  1618. * 1 FOR -WRITECS-
  1619. *
  1620. READECS OVRLAY
  1621. NGETVAR A1 = VARIABLE STORAGE ADDRESS
  1622. SX6 A1
  1623. SA6 RVADDR SAVE STARTING VARIABLE ADDRESS
  1624. SA5 A5 RETRIEVE ORIGINAL COMMAND WORD
  1625. LX5 XCODEL
  1626. NGETVAR X1 = ECS ADDRESS
  1627. BX6 X1
  1628. SA6 RABSA SAVE ABSOLUTE ADDRESS
  1629. SA5 A5 RETRIEVE ORIGINAL COMMAND WORD
  1630. MX0 2*XCODEL
  1631. BX5 -X0*X5
  1632. AX5 XCMNDL
  1633. SA1 B5+X5 GET ADDITIONAL INFO WORD
  1634. BX5 X1 MOVE TO REQUIRED X5
  1635. NGETVAR X1 = TRANSFER LENGTH
  1636. ZR X1,PROCESS IGNORE ZERO LENGTH
  1637. SA2 RVADDR
  1638. SA0 X2 A0 = STARTING ADDRESS
  1639. CALL BOUNDS CHECK WITHIN BOUNDS
  1640. SA4 RABSA GET ECS ADDRESS
  1641. NG X4,RERXVAL
  1642. MX0 -24
  1643. BX0 X0*X4 CHECK FOR REASONABLE ECS ADDR
  1644. NZ X0,RERXVAL
  1645. IX5 X1+X4 (X5) = LWA+1 OF ECS TRANSFER
  1646. SX3 1
  1647. IX5 X5-X3 (X5) = LWA OF ECS TRANSFER
  1648. SA3 NLENGTH (X3) = ECS LWA OF PLATO
  1649. IX3 X3-X5 SEE IF BEYOND TUTOR ECS
  1650. NG X3,RERXVAL
  1651. BX0 X4
  1652. SB1 X1 PICK UP LENGTH TO READ
  1653. SA1 OVARG1
  1654. NZ X1,WRTECS JUMP IF -WRITECS-
  1655. + RE B1
  1656. RJ ECSPRTY
  1657. EQ PROCESS
  1658. *
  1659. RERXVAL BX1 X4
  1660. EQ ERXVAL
  1661. *
  1662. WRTECS WE B1
  1663. RJ ECSPRTY
  1664. EQ PROCESS
  1665. *
  1666. RVADDR BSS 1 ADDRESS OF STARTING VARIABLE
  1667. RABSA BSS 1 ECS ADDRESS
  1668. *
  1669. *
  1670. ENDOV
  1671. * /--- BLOCK SBREAD 00 000 77/11/11 05.43
  1672. TITLE -SBREAD/SBWRITE-
  1673. *
  1674. * -SBREAD- (CODE=148)
  1675. * -SBWRITE- (CODE=149)
  1676. *
  1677. * -SBREAD- READS SPECIFIED WORDS FROM STUDENT BANK
  1678. * -SBWRITE- WRITES SPECIFIED WORDS TO STUDENT BANK
  1679. *
  1680. * BOTH COMMANDS HAVE FOLLOWING FORMAT';
  1681. *
  1682. * FOUR ARGUMENTS';
  1683. * ARG1 = STATION WHOSE BANK IS TO BE READ (WRITTEN)
  1684. * ARG2 = OFFSET INTO STUDENT BANK
  1685. * ARG3 = STARTING VAR TO READ INTO (WRITE FROM)
  1686. * ARG4 = NUMBER OF WORDS TO READ (WRITE)
  1687. *
  1688. * RETURNS SYSTEM VARIABLE ERROR =
  1689. * -1 IF SUCCESSFUL READ/WRITE
  1690. * 0 IF NO SUCH STUDENT BANK
  1691. *
  1692. * ON ENTRY,
  1693. *
  1694. * OVARG1 = 0 FOR -SBREAD-
  1695. * 1 FOR -SBWRITE-
  1696. *
  1697. SBREAD OVRLAY
  1698. MX7 2*XCODEL
  1699. MX6 0
  1700. SA6 SOWNFLG MARK NOT OWN STATION
  1701. *
  1702. * GET AND STORE EXTRA STORAGE WORD
  1703. BX1 -X7*X5 MASK OUT VARIABLE CODES
  1704. AX1 XCMNDL SHIFT OFF COMMAND CODE
  1705. SA1 B5+X1 X1 = EXTRA STORAGE WORD
  1706. BX6 X1
  1707. SA6 SAVE1 STORE EXTRA STORAGE WORD
  1708. * /--- BLOCK SBREAD 00 000 81/03/10 01.42
  1709. *
  1710. * PROCESS ARG1
  1711. NGETVAR X1 = STATION
  1712. *
  1713. * CHECK FOR STATION OUT OF RANGE
  1714. * NEED TO LEAVE ORIGINAL ARGUMENT IN X1 AS
  1715. * EXECERR STUFF EXPECTS IT TO BE THERE
  1716. MX0 42
  1717. BX2 X0*X1 CATCH NEGATIVES AND > 18 BITS
  1718. NZ X2,ERXSTN --- STATION OUT OF RANGE
  1719. BX2 -X0*X1 USE ONLY 18 BITS
  1720. SX3 NUMSTAT TOTAL STATIONS DEFINED
  1721. IX3 X2-X3
  1722. PL X3,ERXSTN --- STATION OUT OF RANGE
  1723. * CHECK FOR OWN STATION
  1724. SA3 STATION
  1725. IX3 X2-X3
  1726. NZ X3,SBRX10 JUMP IF NOT OWN STATION
  1727. MX6 -1
  1728. SA6 SOWNFLG MARK OWN STATION
  1729. EQ SBRX15
  1730. *
  1731. SBRX10 SX0 BANKADD-STSTART
  1732. SA1 NSYSBNK ADDRESS OF STATION BANKS
  1733. IX0 X0+X1
  1734. SA1 NSYSLTH LENGTH OF STATION BANKS
  1735. IX1 X1*X2 X1 = OFFSET INTO STATION BANKS
  1736. IX0 X0+X1 X0 = ADDRESS OF STATION BANK
  1737. RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
  1738. CALL BANKLOC COMPUTE ADDRESS OF BANK
  1739. BX6 X0
  1740. SA6 SBADD SAVE ADDRESS OF STUDENT BANK
  1741. *
  1742. * PROCESS ARG2
  1743. SBRX15 SA5 A5 RESET COMMAND WORD
  1744. LX5 XCODEL
  1745. NGETVAR X1 = OFFSET
  1746. SX6 X1
  1747. NG X6,ERXVAL --- OFFSET OUT OF RANGE
  1748. SA6 STOFFS
  1749. *
  1750. * PROCESS ARG4
  1751. SA1 SAVE1 EXTRA STORAGE WORD
  1752. BX5 X1
  1753. LX5 XCODEL
  1754. NGETVAR X1 = LENGTH TO READ
  1755. SX6 X1 18 BITS ONLY
  1756. SA6 STLTH
  1757. *
  1758. * PROCESS ARG3
  1759. SA1 SAVE1 EXTRA STORAGE WORD
  1760. BX5 X1
  1761. NGETVAR A1 = STARTING ADDRESS
  1762. *
  1763. * CHECK IF OWN STUDENT BANK
  1764. SA2 SOWNFLG
  1765. ZR X2,SBRX20 JUMP IF NOT OWN BANK
  1766. SA2 ATEMPEC
  1767. BX0 X2 ADDRESS OF ECS SCRATCH BUFFER
  1768. SA0 SBSTART
  1769. + WE SBMAX COPY BANK TO TEMP ECS BUFFER
  1770. RJ ECSPRTY
  1771. BX6 X2 SET ADDRESS OF BANK
  1772. SA6 SBADD
  1773. *
  1774. * PERFORM CHECK FOR VARIABLE OUT OF RANGE
  1775. SBRX20 SA0 A1 FOR BOUNDS CHECKER
  1776. SA1 STLTH
  1777. CALL BOUNDS --- EXITS IF OUT OF RANGE
  1778. SB1 X1 RESTORE LENGTH TO READ/WRITE
  1779. * /--- BLOCK SBREAD 00 000 81/03/10 01.49
  1780. *
  1781. * CHECK FOR STUDENT BANK OUT OF RANGE
  1782. SA2 STOFFS RESTORE OFFSET INTO BANK
  1783. SX1 X2+B1 ADD OFFSET AND LENGTH
  1784. SX1 X1-TBLTH-1 SUBTRACT LENGTH OF STUDENT BANK
  1785. PL X1,SERXOOR --- ERROR IF OUT OF RANGE
  1786. *
  1787. * ERROR CHECKS ON STUDENT BANK ADDRESS
  1788. SA1 SBADD RESTORE SB RELATIVE ADDRESS
  1789. SX6 0 SET ERROR FLAG FOR NO SB
  1790. ZR X1,SBRX3
  1791. NG X1,SBRX3
  1792. SX6 -1 SET ERROR FLAG FOR SUCCESS
  1793. *
  1794. * READ/WRITE OF STUDENT BANK
  1795. IX0 X1+X2 ADD OFFSET TO SB ADDRESS
  1796. SA2 OVARG1 GET READ/WRITE FLAG
  1797. NZ X2,SBRX2 JUMP IF TO WRITE
  1798. RE B1
  1799. RJ ECSPRTY
  1800. EQ SBRX3 JUMP TO EXIT
  1801. SBRX2 WE B1
  1802. RJ ECSPRTY
  1803. SA2 SOWNFLG CHECK IF WROTE OWN STUDENT BANK
  1804. ZR X2,SBRX3 IF NOT OWN BANK
  1805.  
  1806. * UPDATE CM COPY OF OWN STUDENT BANK
  1807.  
  1808. SA2 STOFFS (X2) = OFFSET INTO STUDENT BANK
  1809. SA0 SBSTART+X2
  1810. RE B1 UPDATE CM COPY
  1811. RJ ECSPRTY
  1812. *
  1813. SBRX3 SA6 TERROR STORE ERROR FLAG
  1814. EQ PROCESS +++ EXIT TO CONTINUE PROCESSING
  1815. *
  1816. SERXOOR SA1 STOFFS OFFSET INTO STUDENT BANK
  1817. SX2 B1 LENGTH
  1818. SX3 TBLTH LENGTH OF STUDENT BANK
  1819. EXECERR 117 SBREAD OUT OF RANGE
  1820. *
  1821. *
  1822. SOWNFLG BSS 1 FLAG FOR OWN STUDENT BANK
  1823. SAVE1 BSS 1 STORAGE FOR EXTRA STORAGE WORD
  1824. SBADD BSS 1 STORAGE FOR RELATIVE SB ADDRESS
  1825. STOFFS BSS 1 STORAGE FOR OFFSET
  1826. STLTH BSS 1 STORAGE FOR LENGTH
  1827. *
  1828. *
  1829. ENDOV
  1830. * /--- BLOCK SBCHANG 00 000 80/08/28 09.33
  1831. TITLE -SBCHANG- / -STCHANG-
  1832.  
  1833. ** SBCHANG - CHANGE A WORD IN A STUDENT BANK
  1834. *
  1835. * STCHANG - CHANGE A WORD IN A STATION BANK
  1836. *
  1837. * SBCHANG STATION,OFFSET,SOURCE,OPERATION
  1838. *
  1839. * OPERATION - '7AND'7, '7OR'7, OR '7SET'7
  1840.  
  1841.  
  1842. SBCHNG OVRLAY
  1843. CALL MXTEST,-1,XR.THR GUARD AGAINST REQ OVRFLOW
  1844. NG X6,=XRETRNZ TRY AGAIN NEXT TIMESLICE
  1845.  
  1846. * GET STATION NUMBER
  1847.  
  1848. NGETVAR
  1849. NG X1,ERXSTN IF STATION ILLEGAL
  1850. SX2 NUMSTAT
  1851. IX2 X1-X2
  1852. PL X2,ERXSTN IF STATION ILLEGAL
  1853. SA2 OVARG1 SET EXECUTOR REQUEST CODE
  1854. SA2 SBCC+X2
  1855. LX1 42
  1856. BX6 X1+X2
  1857. SA6 MASRQ SAVE STATION NUMBER
  1858.  
  1859. * FETCH OFFSET
  1860.  
  1861. LX5 XCODEL
  1862. NGETVAR
  1863. NG X1,ERXVAL IF OFFSET OUT OF RANGE
  1864. SA2 OVARG1
  1865. SA2 SBCA+X2
  1866. IX2 X1-X2
  1867. PL X2,ERXVAL IF OFFSET OUT OF RANGE
  1868. SX6 X1
  1869. SA6 MASRQ+2 SAVE OFFSET
  1870.  
  1871. * FETCH VALUE TO SET
  1872.  
  1873. SA5 A5 RESTORE COMMAND WORD
  1874. MX6 2*XCODEL
  1875. BX1 -X6*X5 (X1) = EXTRA STORAGE POINTER
  1876. AX1 XCMNDL
  1877. SA1 X1+B5 (X1) = EXTRA STORAGE WORD
  1878. BX5 X1
  1879. NGETVAR
  1880. BX6 X1
  1881. SA6 MASRQ+3 SAVE VALUE TO USE
  1882.  
  1883. * FETCH OPERATION TO PERFORM
  1884.  
  1885. LX5 XCODEL
  1886. NGETVAR
  1887. SA2 SBCB SEARCH FOR OPERATION
  1888. MX0 42
  1889. SBC1 BX6 X2*X0
  1890. BX6 X6-X1
  1891. ZR X6,SBC2 IF OPERATION FOUND
  1892. SA2 A2+1
  1893. NZ X2,SBC1 IF MORE ENTRIES IN TABLE
  1894. EQ ERXVAL UNKNOWN OPERATION
  1895.  
  1896. SBC2 SX6 X2
  1897. SA6 MASRQ+1 SAVE OPERATION
  1898. * /--- BLOCK SBCHANG 00 000 81/03/10 02.00
  1899.  
  1900. * CHECK EXECUTOR FOR STATION
  1901.  
  1902. SA3 MASRQ
  1903. AX3 42
  1904. CALL GETEXID,X3
  1905. ZR X1,SBC3 IF ON THIS EXECUTOR
  1906. CALL SETEXID
  1907. CALL MXREQ POST EXECUTOR REQUEST
  1908. SX6 -1 (X6) = SUCCESSFUL
  1909. EQ SBC6
  1910.  
  1911. * HANDLE REQUEST FOR THIS EXECUTOR
  1912.  
  1913. SBC3 SA4 STATION
  1914. BX6 X3-X4
  1915. ZR X6,SBC4 IF FOR THIS STATION
  1916. SA1 NSYSBNK COMPUTE ADDRESS OF /STATION/
  1917. SX2 PSYSLTH
  1918. IX2 X2*X3
  1919. IX0 X1+X2
  1920. SA0 SBCE
  1921. RE PSYSLTH READ STATION BANK
  1922. RJ ECSPRTY
  1923. SA1 OVARG1
  1924. SA2 SBCA+X1
  1925. SB2 X2 (B2) = LENGTH OF BANK
  1926. NZ X1,SBC5 IF -STCHANG-
  1927. SA1 A0+BANKADD-STSTART
  1928. BX6 X1
  1929. SA6 SBBNKA SAVE *BANKADD* IMAGE
  1930. CALL BANKLOC
  1931. SX6 0 (X6) = NO STUDENT BANK
  1932. NG X0,SBC6 IF NO STUDENT BANK
  1933. ZR X0,SBC6
  1934. SA0 SBCE
  1935. RE SBMAX
  1936. RJ ECSPRTY
  1937. SA4 A0+STATION-SBSTART (X4) = STATION NUMBER
  1938. EQ SBC5 PERFORM OPERATION
  1939.  
  1940. SBC4 SA1 OVARG1
  1941. SA1 SBCD+X1
  1942. SA0 X1 (A0) = BASE ADDRESS OF TABLE
  1943. MX0 0 (X0) = MARK THIS STATION
  1944. SBC5 CALL MXCST UPDATE STATION/STUDENT BANK
  1945. SX6 -1 (X6) = NO ERRORS
  1946. ZR X0,SBC6 IF FOR THIS STATION
  1947. SA1 OVARG1
  1948. NZ X1,SBC5.1 IF -STCHANG-
  1949.  
  1950. * WRITE CHANGED WORDS TO ECS
  1951.  
  1952. WE B2
  1953. RJ ECSPRTY
  1954. EQ SBC6
  1955. * /--- BLOCK SBCHANG 00 000 81/03/10 01.55
  1956.  
  1957. * DO NOT WRITE OUT READ-ONLY PART OF STATION BANK
  1958.  
  1959. SBC5.1 SX2 PSYSRLN
  1960. IX0 X0+X2
  1961. SA0 A0+PSYSRLN
  1962. SB2 B2-PSYSRLN
  1963. WE B2
  1964. RJ ECSPRTY
  1965. SBC6 SA6 TERROR SET ERROR FLAG
  1966. EQ PROCESS
  1967.  
  1968.  
  1969. SBBNKA BSSZ 1 HOLD TARGET *BANKADD* IMAGE
  1970.  
  1971. SBCA BSS 0
  1972. CON SBMAX LENGTH OF STUDENT BANK
  1973. CON PSYSLTH LENGTH OF STATION BANK
  1974.  
  1975. SBCB BSS 0
  1976. VFD 42/0LSET,18/0
  1977. VFD 42/0LOR,18/1
  1978. VFD 42/0LAND,18/2
  1979. VFD 42/0LXOR,18/3
  1980. VFD 42/0LTALK,18/4
  1981. DATA 0
  1982.  
  1983. SBCC BSS 0
  1984. CON XR.WRTSB
  1985. CON XR.WRTST
  1986.  
  1987. SBCD BSS 0
  1988. CON SBSTART
  1989. CON STSTART
  1990.  
  1991. .1 MAX SBMAX,PSYSLTH
  1992. SBCE OVDATA .1 TEMPORARY BUFFER
  1993.  
  1994.  
  1995. ENDOV
  1996. * /--- BLOCK USERLOC 00 000 79/10/04 03.56
  1997.  
  1998. TITLE -USERLOC- (CODE = 150)
  1999.  
  2000. * USERLOC NAME,GROUP
  2001. *
  2002. * LOCATES USER *NAME* IN GROUP *GROUP*
  2003. *
  2004. * *NAME* MUST BE STOREABLE AND TWO WORDS LONG.
  2005. *
  2006. * AFTER EXECUTION, *ERROR* IS SET TO
  2007. *
  2008. * -1 IF THE USER IS NOT SIGNED ON, OR
  2009. * THE STATION WHERE THE USER IS SIGNED ON
  2010. *
  2011. * *ZRETURN* IS NOT SET BY THIS COMMAND.
  2012.  
  2013. USERLOC OVRLAY
  2014.  
  2015. SA5 A5 (X5) = COMMAND WORD
  2016. LX5 XCODEL POSITION GETVAR FOR GROUP NAME
  2017. NGETVAR (X1) = GROUP NAME
  2018. ZR X1,NOFIND IF NO GROUP NAME
  2019. MX6 48
  2020. BX6 X6*X1 BOTTOM 48 BITS ONLY
  2021. SA6 ULGROUP SAVE GROUP NAME
  2022.  
  2023. SA5 A5 (X5) = COMMAND WORD
  2024. NGETVAR (A1) = ADDR OF USER NAME
  2025. SX6 A1 (X6) = ADDR OF USER NAME
  2026. SA6 TEMP SAVE OVER CALL TO *WORDS*
  2027. SA0 A1 (A0) = ADDR OF USER NAME
  2028. SX1 18 (X1) = LENGTH OF NAME
  2029. CALL WORDS CHECK BOUNDS ON USER NAME
  2030. SA1 TEMP (X1) = ADDR OF USER NAME
  2031. SA1 X1 (X1) = FIRST WORD OF USER NAME
  2032. BX6 X1
  2033. ZR X1,NOFIND EXIT IF NO NAME
  2034. SA6 ULNAME SAVE FIRST WORD OF NAME
  2035. SA1 A1+1 (X1) = SECOND WORD OF USER NAME
  2036. MX6 48 ONLY WANT 8 CHARACTERS OF IT
  2037. BX6 X6*X1 (X6) = CHARS 11 - 18 OF NAME
  2038. SA6 A6+1 SAVE SECOND WORD OF NAME
  2039.  
  2040. MX7 -1
  2041. SA7 JJSTORE MARK *INFO* BUFFER OVERWRITTEN
  2042.  
  2043. SB1 1 (B1) = 1
  2044. SB2 0 (B2) = STARTING STATION NUMBER
  2045. SB4 NUMSTAT-1 (B4) = MAX POSSIBLE STATION NO
  2046.  
  2047. * SEARCH GROUP NAME BUFFER FOR SAME GROUP.
  2048.  
  2049. ULOC1 SB3 B2+INFOLTH-1 (B3) = LAST STATION THIS PASS
  2050. LE B3,B4,ULOC2 IF IN RANGE
  2051. SB3 B4 ADJUST IF NOT IN RANGE
  2052. ULOC2 SB4 B3-B2
  2053. SB4 B4+B1 (B4) = NO. OF STATIONS TO CHECK
  2054. SA1 AGROUP (X1) = ECS ADDR OF GROUP BUFFER
  2055. SX0 B2 (X0) = FIRST STATION TO CHECK
  2056. * /--- BLOCK USERLOC 00 000 79/10/04 03.56
  2057. IX0 X0+X1 (X0) = ADDR OF FIRST GROUP NAME
  2058. SA0 INFO
  2059. RE B4 READ GROUP NAMES TO INFO BUFFER
  2060. RJ ECSPRTY
  2061. SA1 ULGROUP (X1) = NAME OF GROUP
  2062. SA2 INFO-1 (A2) = BIAS TO INFO BUFFER
  2063. MX0 48
  2064. *
  2065. ULOC10 SA2 A2+1 (X2) = NEXT GROUP NAME
  2066. BX2 X0*X2 MASK OUT TALK OPTIONS
  2067. BX3 X1-X2 CHECK IF CORRECT GROUP
  2068. NZ X3,ULOC40 IF NOT CORRECT GROUP
  2069. * /--- BLOCK USERLOC 00 000 79/10/04 03.56
  2070.  
  2071. * GROUP NAME MATCHED -- SEE IF NAME MATCHES.
  2072.  
  2073. SX6 B2 SAVE CURRENT STATION NUMBER
  2074. SX7 B3 SAVE ENDING STATION NUMBER
  2075. SA6 SAVE.B2
  2076. SA7 SAVE.B3
  2077. SX6 A2 SAVE ADDRESS OF GROUP NAME
  2078. SA6 SAVE.A2
  2079.  
  2080. CALL READSBK,UNAME,SAVE.B2,(TNAME-SBSTART),2
  2081. PL X6,ULOC30 IF NO STUDENT BANK
  2082. SA1 ULNAME
  2083. SA2 UNAME
  2084. BX1 X1-X2 CHECK IF NAMES MATCH
  2085. NZ X1,ULOC30 IF NAMES DIFFERENT
  2086. NG X1,ULOC30 TREAT -0 AS NO MATCH
  2087. SA1 ULNAME+1
  2088. SA2 UNAME+1
  2089. BX1 X1-X2
  2090. MX0 48
  2091. BX1 X0*X1
  2092. NZ X1,ULOC30 IF NAMES DIFFERENT
  2093.  
  2094. * IF MATCH, FETCH STATION NUMBER AND JUMP TO EXIT.
  2095.  
  2096. SA1 SAVE.B2
  2097. SX6 X1+ (X6) = STATION NUMBER
  2098. EQ ULEXIT
  2099.  
  2100. * IF NOT THE ONE WE WANT, RESTORE REGISTERS AND
  2101. * PROCEED TO NEXT STATION.
  2102.  
  2103. ULOC30 SA2 SAVE.B2
  2104. SA3 SAVE.B3
  2105. SB2 X2 RESTORE CURRENT STATION NUMBER
  2106. SB3 X3 RESTORE LAST STATION NUMBER
  2107. SA2 SAVE.A2
  2108. SA2 X2 RESTORE ADDRESS OF GROUP NAME
  2109.  
  2110. SB1 1 (B1) = 1 AGAIN
  2111. MX0 48 (X0) = MASK FOR GROUP NAME
  2112. SA1 ULGROUP (X1) = GROUP NAME
  2113.  
  2114. * END OF LOOPS.
  2115.  
  2116. ULOC40 SB2 B2+1 INCREMENT STATION NUMBER
  2117. LE B2,B3,ULOC10 RELOOP IF NOT YET DONE
  2118. SB4 NUMSTAT-1 (B4) = MAX POSSIBLE STATION NO
  2119. LE B2,B4,ULOC1
  2120.  
  2121. * USER IS NOT SIGNED ON -- RETURN *ERROR* = -1.
  2122.  
  2123. NOFIND SX6 -1
  2124.  
  2125. * SET ERROR AND EXIT TO NEXT COMMAND
  2126.  
  2127. ULEXIT SA6 TERROR
  2128. EQ PROCESS
  2129.  
  2130. ULNAME OVDATA 2 NAME OF USER TO SEARCH FOR
  2131. UNAME OVDATA 2 NAME READ FROM STUDENT BANK
  2132. ULGROUP OVDATA NAME OF GROUP TO SEARCH FOR
  2133.  
  2134. SAVE.B2 OVDATA CURRENT STATION
  2135. SAVE.B3 OVDATA LAST STATION FOR THIS PASS
  2136. * /--- BLOCK USERLOC 00 000 79/10/04 03.56
  2137. SAVE.A2 OVDATA ADDRESS OF CURRENT GROUP NAME
  2138.  
  2139. TEMP OVDATA SCRATCH
  2140.  
  2141. ENDOV
  2142. * /--- BLOCK READTCM 00 000 78/07/05 01.24
  2143. TITLE -READTCM- READ TUTOR CENTRAL MEMORY
  2144. *
  2145. * -READTCM- -WRITTCM-
  2146. * READS OR WRITES CENTRAL INSIDE PLATO*S FL
  2147. *
  2148. *
  2149. * ON ENTRY,
  2150. * OVARG1 = 0 IF READ, 1 IF WRITE
  2151. *
  2152. READTCM OVRLAY
  2153. NGETVAR
  2154. SX6 A1
  2155. SA6 READTC1
  2156. SA5 A5
  2157. LX5 XCODEL
  2158. NGETVAR
  2159. SX6 X1
  2160. SA6 READTC2
  2161. SA5 A5
  2162. MX0 2*XCODEL
  2163. BX5 -X0*X5
  2164. AX5 XCMNDL
  2165. SA1 B5+X5
  2166. BX5 X1
  2167. NGETVAR X1 = LENGTH
  2168. SA2 READTC1 X2 = TO ADDRESS (READ)
  2169. SA3 READTC2 X3 = FROM ADDRESS (READ)
  2170. SA0 X2
  2171. CALL BOUNDS SEE IF IT WILL FIT
  2172. SA4 CMFL
  2173. LX4 30
  2174. SB2 X4
  2175. SB1 X3
  2176. NG B1,RERXTCM ERROR IF NEGATIVE ADDRESS
  2177. SB1 X1+B1
  2178. GT B1,B2,ERXBADL ERR IF MORE THAN FL
  2179. SA4 ATEMPEC
  2180. BX0 X4
  2181. SB1 X1
  2182. SA4 OVARG1 SEE IF READ OR WRITE
  2183. NZ X4,WRTTCM JUMP IF -WRITE-
  2184. SA0 X3
  2185. WE B1
  2186. RJ ECSPRTY
  2187. SA0 X2
  2188. RE B1
  2189. RJ ECSPRTY
  2190. EQ PROC
  2191. *
  2192. RERXTCM SX1 B1
  2193. EQ ERXVAL
  2194. *
  2195. WRTTCM SA0 X2 FROM ADDRESS
  2196. WE B1
  2197. RJ ECSPRTY
  2198. SA0 X3 TO ADDRESS
  2199. RE B1
  2200. RJ ECSPRTY
  2201. EQ PROC
  2202. *
  2203. READTC1 BSS 1
  2204. READTC2 BSS 1
  2205. *
  2206. *
  2207. ENDOV
  2208. * /--- BLOCK HIDDEN 00 000 78/02/16 00.32
  2209. TITLE -HIDDEN- COMMAND
  2210. *
  2211. * -HIDDEN- COMMAND
  2212. *
  2213. *
  2214. * THIS COMMAND WILL DISPLAY TEXT ON THE SCREEN IN THE
  2215. * ',HIDDEN', FORMAT. CHARACTERS CHANGED LISTED BELOW
  2216. * !^O = ZERO (O00) SUB ACCESS O
  2217. * '6 = BLANK (O55) SHIFT 6
  2218. * '" = SUBSCRIPT (O66) SHIFT MULTIPLY
  2219. * '# = SUPERSCRIPT (O67) SHIFT DIVIDE
  2220. * ^'W = SHIFT (O70) ACCESS SHIFT W
  2221. * ^'X = CARRIAGE RETURN (O71) ACCESS SHIFT X
  2222. * ^'A = BACKSPACE (O74) ACCESS SHIFT A
  2223. * ^,@^'A = FONT (O75) ACCESS 'F
  2224. * '#@'" = ACCESS (O76) ACCESS 'O
  2225.  
  2226. * - NOTE -
  2227. * A VARIATION OF THIS ROUTINE AND A COPY OF ITS
  2228. * TABLE IS USED INTERNAL TO THE -PACK- COMMAND FOR
  2229. * EMBEDDED -HIDDEN- COMMANDS. SEE PACKOV / EXEC8.
  2230. *
  2231. *
  2232. HIDDEN OVRLAY
  2233. SA1 MOUTLOC SEE IF MOUT BUFFER PRETTY FULL
  2234. SX1 X1-MOUTLTH+70 SEE IF A SHORT ONE WILL FIT
  2235. NG X1,HIDEX IF ROOM
  2236. SA5 A5+1 BACK UP COMMAND POINTER
  2237. EQ XSLICE END THIS TIME SLICE
  2238. *
  2239. HIDEX MX0 1
  2240. BX5 -X0*X5
  2241. NGETVAR GET FIRST ARGUMENT
  2242. SX6 A1 SAVE ADDRESS
  2243. SA6 HIDADD
  2244. BX6 X1
  2245. SA6 HIDLIT SAVE INCASE OF LITERAL
  2246. SA5 A5 RESTORE COMMAND
  2247. LX5 XCODEL
  2248. NGETVAR GET CHARACTER COUNT
  2249. ZR X1,PROCESS
  2250. NG X1,ERXBADL
  2251. * EXECERR USES X1
  2252. * CHECK TO SEE IF MAXIMUM EXPANSION WILL FIT IN MOUT BUFFER
  2253.  
  2254. * INSURE THAT (X1) IS IN LOW 18 BITS.
  2255.  
  2256. SX0 X1
  2257. IX0 X0-X1
  2258. NZ X0,ERXBADL IF NOT IN LOW 18 BITS
  2259.  
  2260. SX0 X1-1 CONVERT TO WORDS
  2261. SA2 SIXTEN TO GET [(N-1)/10]*6
  2262. PX0 X0
  2263. FX0 X0*X2 X0=(N-1)*(6/10) AND SOME GARBAGE EXPONENT
  2264. SX0 X0+1 X0 = LENGTH (IN WORDS)
  2265. SA2 MOUTLOC
  2266. IX6 X2+X0 OPPPS
  2267. SX3 X6-MOUTLTH+1
  2268. PL X3,PROCESS JUST SKIP IF NOT ENOUGH ROOM
  2269. *ABOVE ABORTS OUTPUT IF IT DON'7T FIT
  2270. SX2 X1-11 SEE IF ONE WORD(LITERAL STUFF)
  2271. PL X2,HIDCHKR OTHERWISE CHECK IF IN BOUNDS
  2272. SA0 HIDLIT
  2273. EQ HIDEDO
  2274. *
  2275. HIDCHKR SA2 HIDADD
  2276. SA0 X2
  2277. CALL WORDS BOUNDS CHECK
  2278. *
  2279. * /--- BLOCK HIDDEN 00 000 78/01/07 19.24
  2280. * COMING HERE
  2281. * A0 = ADDRESS OF FIRST WORD
  2282. * X1 = NUMBER OF CHARACTERS TO DISPLAY
  2283. *
  2284. * REGISTER USAGE';
  2285. * A0 NUMBER OF CHARACTERS IN MOUT WORD
  2286. * A5 RESERVED FOR PLATO USE
  2287. * A6 POINT TO OUTPUT WORD
  2288. *
  2289. * X0 77B SINGLE CHARACTER MASK
  2290. * X1 INPUT WORD
  2291. * X2 = CHARACTER(S) TO PUT IN OUTPUT WORD
  2292. * X3 = NUMBER OF CHARACTERS IN X2
  2293. * X4 = TEMP REGISTER
  2294. * X6 OUTPUT WORD
  2295. * X7 = NEW MOUTLOC
  2296. *
  2297. * B1 UNIVERSAL INCREMENT REGISTER
  2298. * B2 CHARACTER LOOKING AT IN INPUT WORD
  2299. * B3 NUMBER OF CHARACTERS LEFT TO DO
  2300. * B5,B7 RESERVED FOR PLATO USE
  2301. *
  2302. HIDEDO BSS 0
  2303. BX6 X1
  2304. SA6 HIDCHR SAVE FOR XYFIX
  2305. SA2 MOUTLOC FIRST WORD IS A HEADER
  2306. SA3 X2+MOUT
  2307. SX7 X2+1 SAVE MOUTLOC + HEADER
  2308. BX6 X3
  2309. SA6 A3 SET UP OUTPUT STORING
  2310. SB3 X1 NUMBER OF CHARACTERS
  2311. SA1 A0 GET FIRST WORD
  2312. SA0 B0 POSITION OF CHAR BEFORE MOUTPLAC
  2313. MX6 0 ZERO OUTPUT WORD
  2314. SB1 1 UNIVERSAL INCREMENT REGISTER
  2315. SB2 B0 STARTING CHARACTER
  2316. MX0 54 ONE CHARACTER MASK
  2317. BX0 -X0 LESS TYPING
  2318. SX3 B1 NUMBER OF CHARACTERS IN OUTPUT
  2319. HIDGO LX1 6 GET NEXT CHARACTER
  2320. BX2 X1*X0
  2321. ZR X2,HIDNUL IF ZERO, MUST CHANGE
  2322. SX4 X2-55B IF LESS THAN SPACE, CHAR OK
  2323. MI X4,HIDOK
  2324. ZR X4,HIDSPC JUMP IF SPACE
  2325. SX4 X4-11B CHECK FOR SUB
  2326. MI X4,HIDOK
  2327. SA4 X4+HIDTAB
  2328. BX3 X4*X0 CHARACTER COUNT IN X3
  2329. BX2 -X0*X4 GET RID OF CHAR COUNT
  2330. EQ HIDOK1
  2331. *
  2332. HIDNUL SA2 HIDNULC
  2333. SX3 3 SUB ACCESS O
  2334. EQ HIDOK1
  2335. *
  2336. HIDSPC SA2 HIDSPCC
  2337. SX3 2 SHIFT 6
  2338. EQ HIDOK1
  2339. *
  2340. HIDOK1 LX2 6
  2341. HIDOK BX4 X2*X0 GET CHAR TO MERGE
  2342. LX6 6
  2343. BX6 X6+X4
  2344. SA0 A0+B1
  2345. SX4 A0-10
  2346. NZ X4,HIDCNT IF WORD NOT FULL
  2347. SA6 A6+B1 STORE MOUT WORD
  2348. SX7 X7+B1 UPDATE MOUTLOC
  2349. MX6 0
  2350. SA0 B0
  2351. HIDCNT SX3 X3-1
  2352. ZR X3,HIDGO1 IF DONE WITH THIS MOVE
  2353. LX2 6
  2354. EQ HIDOK PUT IN NEXT CHAR
  2355. HIDGO1 SX3 B1
  2356. SB3 B3-B1
  2357. ZR B3,HIDONE CHECK IF DONE
  2358. SB2 B2+B1
  2359. SX4 B2-10
  2360. NZ X4,HIDGO GET NEXT CHARACTER
  2361. SA1 A1+B1
  2362. SB2 B0
  2363. EQ HIDGO
  2364. *
  2365. * /--- BLOCK HIDDEN 00 000 78/03/07 17.00
  2366. *
  2367. HIDONE SX4 A0
  2368. ZR X4,HIDON1
  2369. BX4 -X4 POSITION LAST WORK CORRECTLY
  2370. SX4 X4+10 10-X4
  2371. LX4 1 *2
  2372. SB2 X4 *2
  2373. LX4 1 *4
  2374. SB2 B2+X4 *6
  2375. LX6 X6,B2
  2376. SX7 X7+B1 UPDATE MOUTLOC
  2377. SA6 A6+B1 STORE IN MOUT
  2378. *
  2379. HIDON1 SA1 MOUTLOC GET ORIGINAL MOUTLOC
  2380. SA7 A1 STORE NEW COUNT
  2381. IX5 X7-X1 GET NUMBER OF WORDS
  2382. SX3 X5-1 REMOVE HEADER WORD COUNT
  2383. LX2 X3,B1 *2
  2384. LX3 3 *8
  2385. IX2 X2+X3 *10
  2386. LX2 24 SHIFT INTO PLACE IN HEADER
  2387. LX5 12 SHIFT HEADER ADVANCE INTO PLACE
  2388. SX4 WRSCODE GET WRITE CODE
  2389. BX5 X5+X4
  2390. BX7 X2+X5 PUT ALL PARTS TOGETHER
  2391. SA7 X1+MOUT AND OUTPUT HEADER
  2392. SA1 HIDCHR
  2393. CALL XYFIX
  2394. EQ PROCO
  2395. *
  2396. SIXTEN CON 17174631463146314631B
  2397. *
  2398. HIDLIT BSS 1
  2399. HIDADD BSS 1
  2400. HIDCHR BSS 1
  2401. *
  2402. * -- WARNING --
  2403. * A COPY OF THE FOLLOWING SUBTITUTION CHARS AND
  2404. * TABLE IS USED IN PACKOV / EXEC8 TO ALLOW -HIDDEN-
  2405. * TO BE EMBEDDED IN THE -PACK/C-,-SAY/C- COMMANDS.
  2406. * IF YOU CHANGE THIS HERE, BE SURE TO CHANGE IT
  2407. * THERE ALSO.
  2408. *
  2409. HIDNULC DATA 66761700000000000000B !^O
  2410. HIDSPCC DATA 70410000000000000000B '6
  2411. *
  2412. HIDTAB DATA 70640000000000000002B 66B '"
  2413. DATA 70600000000000000002B 67B '#
  2414. DATA 76702700000000000003B 70B ^'W
  2415. DATA 76703000000000000003B 71B ^'X
  2416. DATA 72000000000000000001B 72B=&lt;
  2417. DATA 73000000000000000001B 73B=>
  2418. DATA 76700100000000000003B 74B ^'A
  2419. * DATA 76567476700100000006B 75B ^,@^'A
  2420. DATA 76700600000000000003B 75B ^'F
  2421. * DATA 70607470640000000005B 76B '#@'"
  2422. DATA 76701700000000000003B 76B ^'O
  2423. DATA 77000000000000000001B 77B=;
  2424. *
  2425. *
  2426. ENDOV
  2427. * /--- BLOCK SEND 00 000 80/03/22 05.48
  2428. TITLE -SEND- COMMAND EXECUTION OVERLAY
  2429. *
  2430. * -SEND- COMMAND (CODE = 274)
  2431. *
  2432. * SENDS OUTPUT TO ANOTHER TERMINAL
  2433. *
  2434. *
  2435. * SEND STATION,WHERE,BUFFER,LENGTH
  2436. * SEND STATION,BEEP
  2437. * SEND STATION,ERASE
  2438. *
  2439. * SEND STATION,ON,WHERE,BUFFER,LENGTH
  2440. * SEND STATION,OFF,WHERE,BUFFER,LENGTH
  2441. * SEND STATION,ALL,WHERE,BUFFER,LENGTH
  2442. *
  2443. * SEND STATION,ON,BEEP
  2444. * SEND STATION,OFF,BEEP
  2445. * SEND STATION,ALL,BEEP
  2446. *
  2447. * SEND STATION,ON,ERASE
  2448. * SEND STATION,OFF,ERASE
  2449. * SEND STATION,ALL,ERASE
  2450. *
  2451. *
  2452. * AFTER EXECUTION,
  2453. *
  2454. * (TERROR) = -1 = IT DID NOT WORK
  2455. * 0 = IT WORKED
  2456. * N = OUTPUT SENT TO N STATIONS
  2457. *
  2458. * (TRETURN) = -1 = IT WORKED
  2459. * 0 = BAD STATION NUMBER
  2460. * 1 = NOT SIGNED ON
  2461. * 2 = (UNUSED)
  2462. * 3 = NON-BEEP-ABLE TERMINAL
  2463. *
  2464. *
  2465. * /--- BLOCK SEND 00 000 80/03/22 05.48
  2466.  
  2467. SENDXV OVRLAY
  2468.  
  2469. FINISH ILLEGAL IN -FINISH- UNIT
  2470.  
  2471. SX6 0 PRESET FOR NO ERROR
  2472. SA6 TERROR
  2473. SA6 SSTATS NO. OF STATIONS SENT TO
  2474. SA6 NSTATN PRESET FOR 1 STATION
  2475. SA6 SSTATUS NO SAVLES/INTRCLR YET
  2476. SX6 -1
  2477. SA6 TRETURN *ZRETURN* PRESET TO OK
  2478.  
  2479. *
  2480. * GET STATION NUMBER TO SEND TO (-1 = ALL STATIONS)
  2481. *
  2482.  
  2483. NGETVAR (X1) = STATION NUMBER
  2484. NG X1,SENDALL -1 = ALL STATIONS
  2485. BX6 X1
  2486. SA6 SSTATN SAVE STATION NUMBER
  2487. SA6 LSTATN LAST STATION = FIRST STATION
  2488. SX0 HRDSTAT CHECK FOR PSEUDO-STATIONS
  2489. IX0 X1-X0
  2490. PL X0,SENDERR0 --- ERROR IF FOR RUNNERS
  2491. SX0 LSTUD CHECK FOR CONSOLE
  2492. IX0 X1-X0
  2493. ZR X0,SENDERR0 --- ERROR IF FOR CONSOLE
  2494. SENDX0 SA2 STATION
  2495. IX0 X1-X2 CHECK FOR THIS STATION
  2496. NZ X0,SENDX1 --- OK IF FOR OTHER STATION
  2497. EQ SENDERR0 --- ERROR IF OWN STATION
  2498.  
  2499. SENDALL SX6 1
  2500. SA6 SSTATN START AT STATION 1
  2501. SX6 HRDSTAT-1
  2502. SA6 LSTATN LAST STATION NUMBER
  2503. SX6 X6-1
  2504. SA6 NSTATN NUMBER OF STATIONS - 1
  2505. * /--- BLOCK SEND 00 000 80/03/22 05.48
  2506.  
  2507. *
  2508. * FIND OUT WHAT TYPE OF -SEND- (-1 = TEXT,
  2509. * 0 = BEEP, 1 = ERASE) AND WHETHER ACTIVE OR
  2510. * INACTIVE STATIONS SHOULD RECEIVE THE
  2511. * OUTPUT (-1 = ACTIVE, 0 = BOTH, 1 = INACTIVE)
  2512. *
  2513.  
  2514. SENDX1 SA5 A5 RESTORE COMMAND WORD
  2515. AX5 XCODEL SHIFT 2ND GETVAR CODE DOWN
  2516. MX0 -5
  2517. BX6 -X0*X5 (X6) = ACTIVE/INACTIVE/BOTH
  2518. AX5 5
  2519. BX7 -X0*X5 (X7) = TEXT/BEEP/ERASE INFO
  2520. SX6 X6-1 -1=ACTIVE, 0=BOTH, 1=INACTIVE
  2521. SX7 X7-1 -1=TEXT, 0=BEEP, 1=ERASE
  2522. SA6 SWHO STORE DESIRED STATION STATUS
  2523. SA7 STYPE STORE OUTPUT TYPE
  2524. PL X7,SENDGO --- IF NOT TEXT
  2525. * /--- BLOCK SEND 00 000 80/03/22 05.48
  2526.  
  2527. *
  2528. * FETCH EXTRA STORAGE WORD
  2529. *
  2530.  
  2531. SA5 A5 RESTORE COMMAND WORD
  2532. MX0 -11
  2533. AX5 9 POSITION INDEX IN XSTOR
  2534. BX5 -X0*X5
  2535. SA1 X5+B5 LOAD XSTOR WORD
  2536. BX6 X1
  2537. SA6 STEMP SAVE FOR LATER GETVAR CALLS
  2538. BX5 X6
  2539.  
  2540. *
  2541. * GET SCREEN POSITION
  2542. *
  2543.  
  2544. NGETVAR DECODE SECOND VARIABLE
  2545. CALL RCTOXY CONVERT TO FINE GRID
  2546. MX0 -9
  2547. BX6 -X0*X6 LIMIT X TO 9 BITS
  2548. BX7 -X0*X7 LIMIT Y TO 9 BITS
  2549. LX6 9
  2550. BX6 X6+X7 MERGE X AND Y
  2551. SA6 SAT SAVE SCREEN POSITION
  2552.  
  2553. *
  2554. * GET ADDRESS OF TEXT BUFFER
  2555. *
  2556.  
  2557. SA1 STEMP (X1) = EXTRA STORAGE WORD
  2558. BX5 X1
  2559. LX5 XCODEL POSITION SECOND GETVAR CODE
  2560. NGETVAR DECODE THIRD VARIABLE
  2561. SX6 A1
  2562. SA6 SBUFFER SAVE BUFFER ADDRESS
  2563.  
  2564. *
  2565. * GET LENGTH OF TEXT IN CHARACTERS
  2566. *
  2567.  
  2568. SA1 STEMP (X1) = EXTRA STORAGE WORD
  2569. BX5 X1
  2570. LX5 2*XCODEL POSITION THIRD GETVAR CODE
  2571. NGETVAR DECODE FOURTH VARIABLE
  2572. SX1 X1
  2573. ZR X1,PROCESS --- IF NOTHING TO SEND
  2574. BX6 X1
  2575. SA6 SCHARS
  2576.  
  2577. *
  2578. * CHECK BOUNDS ON TEXT
  2579. *
  2580.  
  2581. SA2 SBUFFER BUFFER ADDRESS
  2582. SA0 X2
  2583. CALL WORDS CHECK BUFFER BOUNDS
  2584. * /--- BLOCK SENDGO 00 000 80/03/22 05.49
  2585.  
  2586. *
  2587. * PREPARE FOR MAIN -SEND- LOOP
  2588. *
  2589.  
  2590. SENDGO CALL EFORMAT DUMP OWN OUTPUT
  2591. CALL SAVLES UNLOAD COMMON, STORAGE, ETC.
  2592. SX6 -1
  2593. SA6 SSTATUS MARK SAVLES/INTRCLR IN EFFECT
  2594.  
  2595. *
  2596. * LOOP THROUGH STATIONS SENDING THE OUTPUT TO
  2597. * THE SPECIFIED STATIONS
  2598. *
  2599.  
  2600. SENDLOOP SA1 SSTATN (X1) = NO. OF NEXT STATION
  2601. SA2 STATION CHECK FOR OWN STATION
  2602. IX2 X1-X2
  2603. ZR X2,SENDL99 --- SKIP OWN STATION
  2604.  
  2605. * SKIP STATIONS IN TEKTRONIX MODE.
  2606.  
  2607. CALL READTBK,STEMP,SSTATN,(STFLAG1-STSTART)
  2608. SA1 STEMP (X1) = *STFLAG1* FOR RECEIVER
  2609. LX1 60-TEKBIT
  2610. NG X1,SENDL99 SKIP IF IN TEKTRONIX MODE
  2611.  
  2612. *
  2613. * CALL *READSBK* TO SEE IF STATION IS ACTIVE
  2614. * OR NOT -- (X6) = -1 IF ACTIVE, 0 IF INACTIVE
  2615. *
  2616. * SET UP REGISTERS FOR OTHER CHECKS
  2617. *
  2618.  
  2619. CALL READSBK,STEMP,SSTATN,0,0
  2620. SA6 SACTIVE -1 = ACTIVE, 0 = INACTIVE
  2621. SA1 NSTATN (X1) > 0 IF MULTI-STATION
  2622. SA2 STYPE (X2) = TYPE OF OUTPUT
  2623. SA3 SWHO (X3) = ACTIVE/BOTH/INACTIVE
  2624. * /--- BLOCK SENDGO 00 000 80/03/22 05.49
  2625.  
  2626. *
  2627. * CHECK IF ACTIVE/INACTIVE STATUS OF STATION
  2628. * MATCHES THE DESIRED STATUS
  2629. *
  2630.  
  2631. ZR X3,SNDCIU1 --- SKIP CHECK IF BOTH DESIRED
  2632. MX0 1
  2633. BX3 X0*X3
  2634. AX3 58 -1 = ACTIVE, 0 = INACTIVE
  2635. BX4 X3-X6 CHECK IF CORRECT STATUS
  2636. ZR X4,SNDCIU1 --- IF STATUS MATCHES
  2637. NZ X1,SENDL99 --- IF MULTI-STATION -SEND-
  2638. EQ SENDERR1 --- ERROR IF INCORRECT STATUS
  2639.  
  2640. *
  2641. * IF INACTIVE STATION, ONLY SEND MESSAGE IF ON CIU
  2642. *
  2643. SNDCIU1 NG X6,SENDL1 NO NEED TO CHECK IF ACTIVE
  2644. SA3 SSTATN NEXT STATION
  2645. SX4 C0SITE CHECK RANGE OF 1ST CIU SITES
  2646. LX4 5 1ST CIU STATION
  2647. IX0 X3-X4
  2648. NG X0,SNDCIU2 NOT THIS CIU
  2649. SX4 NC0SITE
  2650. LX4 5
  2651. IX0 X0-X4
  2652. NG X0,SENDL1 IF IN RANGE, CONTINUE
  2653. SNDCIU2 SX4 C1SITE CHECK RANGE OF 2ND CIU SITES
  2654. LX4 5
  2655. IX0 X3-X4
  2656. NG X0,SENDL99 NOT ON CIU, SKIP THIS STATION
  2657. SX4 NC1SITE
  2658. LX4 5
  2659. IX0 X0-X4
  2660. NG X0,SENDL1 IF IN RANGE, CONTINUE
  2661. EQ SENDL99 NOT ON CIU, SKIP THIS STATION
  2662.  
  2663. *
  2664. * ONLY ACTIVE BEEP-ABLE STATIONS CAN BE BEEPED
  2665. *
  2666.  
  2667. SENDL1 NZ X2,SENDL20 --- IF NOT BEEP OPTION
  2668. NG X6,SENDL2 --- IF STATION IS ACTIVE
  2669. NZ X1,SENDL99 --- IF MULTI-STATION -SEND-
  2670. EQ SENDERR3 --- ERROR IF NOT BEEP-ABLE
  2671.  
  2672. *
  2673. * COMPUTE ADDRESS OF STATION BANK
  2674. *
  2675.  
  2676. SENDL2 SA3 SSTATN (X3) = STATION NUMBER
  2677. SX4 PSYSLTH (X4) = STATION BANK LENGTH
  2678. IX3 X3*X4 COMPUTE OFFSET FROM BANK 0
  2679. SA4 NSYSBNK GET ABSOLUTE ADDRESS OF BANK 0
  2680. IX3 X3+X4 COMPUTE REAL ADDRESS OF BANK
  2681.  
  2682. *
  2683. * CHECK FOR ATTEMPT TO BEEP UN-BEEP-ABLE TERMINAL
  2684. *
  2685.  
  2686. SX0 STFLAG1-STSTART
  2687. IX0 X0+X3 (X3) = REAL ADDR OF *STFLAG1*
  2688. SA0 STEMP
  2689. RE 1 READ *STFLAG1* TO *STEMP*
  2690. RJ ECSPRTY
  2691. SA3 A0 (X3) = *STFLAG1*
  2692. AX3 4
  2693. MX0 -4
  2694. BX3 -X0*X3 (X3) = TERMINAL TYPE
  2695. SA3 X3+PPTINFO (X3) = TERMINAL ATTRIBUTES
  2696. LX3 1 SHIFT TO BEEP-ABILITY FLAG
  2697. NG X3,SENDL20 --- IF BEEP-ABLE
  2698. NZ X1,SENDL99 --- IF MULTI-STATION SEND
  2699. EQ SENDERR3 --- UN-BEEP-ABILITY ERROR
  2700. * /--- BLOCK SENDGO 00 000 80/08/11 02.55
  2701.  
  2702. *
  2703. * SWITCH OUTPUT TO OTHER STATION AND SEND IT
  2704. *
  2705.  
  2706. SENDL20 MX1 60 -0
  2707. OUTCODE SWTCODE
  2708.  
  2709. SA1 STYPE (X1) = TYPE OF OUTPUT
  2710. ZR X1,SBEEP --- IF BEEP OPTION
  2711. PL X1,SERASE --- IF ERASE OPTION
  2712.  
  2713. SX1 1
  2714. OUTCODE WEFCODE SET TO MODE -REWRITE-
  2715.  
  2716. SA1 SAT (X1) = SCREEN POSITION
  2717. SA2 SACTIVE (X2) = NEG. IF ACTIVE
  2718. NG X2,SENDL25 --- IF STATION IS ACTIVE
  2719. OUTCODE WFMCODE SET MARGINS IF INACTIVE
  2720. EQ SENDL27
  2721. SENDL25 OUTCODE WFCODE LEAVE MARGINS ALONE IF ACTIVE
  2722.  
  2723. SENDL27 SA1 SBUFFER ADDRESS OF BUFFER
  2724. SB1 X1
  2725. SB2 SCHARS CHARACTER COUNT
  2726. CALL AWTOUT WRITE IN STANDARD FONT
  2727. EQ SENDL30
  2728.  
  2729. SBEEP SA1 BEEPCOD
  2730. OUTCODE S19CODE PUT IN MOUT BUFFER
  2731. EQ SENDL30
  2732.  
  2733. SERASE CALL ERSOUT,0 FSERASE--DONT CHANGE SBANK
  2734. * WE/COLOR DATA
  2735.  
  2736. *
  2737. * DUMP OUTPUT
  2738. *
  2739.  
  2740. SENDL30 MX1 -1
  2741. OUTCODE SWTCODE
  2742. SA1 SSTATN
  2743. BX6 X1
  2744. SA6 FORCSTN FORCE DUMPING OF MOUT BUFFER
  2745. CALL EFORMAT
  2746. * /--- BLOCK SENDGO 00 000 80/04/22 01.22
  2747.  
  2748. *
  2749. * INCREMENT STATS IF MULTI-STATION -SEND-
  2750. *
  2751.  
  2752. SA1 NSTATN
  2753. ZR X1,SENDL40 --- IF NOT MULTI-STATION
  2754. SA1 SSTATS
  2755. SX6 X1+1
  2756. SA6 A1
  2757.  
  2758. *
  2759. * IF END OF TIME-SLICE, TAKE A SHORT BREAK
  2760. *
  2761. * UPON RETURN FROM TUTIMING, THE LESSON/COMMON/
  2762. * STATION INTERLOCKS ARE RESTORED
  2763. *
  2764. * MUST KEEP CLEARING COMMON INTERLOCK TO AVOID
  2765. * DEADLOCK BETWEEN YOUR OWN EXECUTOR HAVING A
  2766. * COMMON INTERLOCKED WHEN ASKING TO INTERLOCK
  2767. * ANOTHER STATION BANK, WITH THE OTHER PERSON
  2768. * SIMULTANEOUSLY (ON A DIFFERENT EXECUTOR) TRYING
  2769. * TO INTERLOCK YOUR OWN COMMON
  2770. *
  2771.  
  2772. SENDL40 SA1 XSLCLOK GET RUNNING CPU CLOCK
  2773. SA2 MAXCLOK GET END OF TIME-SLICE
  2774. IX2 X1-X2
  2775. NG X2,SENDL99
  2776. SA1 KEY
  2777. BX6 X1
  2778. SA6 TOKEY SAVE *KEY*
  2779. TUTIM 250,,,STOPCHK
  2780. SA1 TOKEY
  2781. BX6 X1
  2782. SA6 KEY RESTORE *KEY*
  2783. CALL RESTLES ENSURE *NC* VARS VALID
  2784. CALL SAVLES RE-SAVE *NC* VARIABLES
  2785.  
  2786. *
  2787. * EXIT IF DONE, ELSE ADVANCE TO NEXT STATION
  2788. *
  2789.  
  2790. SENDL99 SA1 SSTATN (X1) = CURRENT STATION
  2791. SX6 X1+1 (X6) = NEXT STATION
  2792. SA2 LSTATN (X2) = LAST STATION
  2793. IX2 X2-X6 CHECK IF DONE
  2794. NG X2,SENDFIN --- IF FINISHED
  2795. SA6 A1 STORE NEXT STATION
  2796. EQ SENDLOOP
  2797. * /--- BLOCK SENDEND 00 000 80/03/22 05.49
  2798.  
  2799. *
  2800. * -SEND- COMMAND EXITS
  2801. *
  2802.  
  2803. SENDFIN SA1 NSTATN (X1) = NO. OF STATIONS
  2804. ZR X1,SENDEXIT --- IF NOT MULTI-STATION
  2805. SA1 SSTATS (X1) = STATIONS SENT TO
  2806. BX6 X1
  2807. SA6 TERROR RETURN IN *TERROR*
  2808.  
  2809. SENDEXIT SA1 SSTATUS CHECK FOR SAVLES/INTRCLR
  2810. PL X1,PROCO --- IF NOT IN EFFECT
  2811. CALL RESTLES RESTORE COMMON, STORAGE, ETC.
  2812. EQ PROCO
  2813.  
  2814. *
  2815. * SET RETURNS FOR ERRORS
  2816. *
  2817.  
  2818. SENDERR0 MX6 0 0 = BAD STATION NUMBER
  2819. MX7 -1
  2820. EQ SENDERR
  2821.  
  2822. SENDERR1 SX6 1 1 = NOT SIGNED ON (OR OFF)
  2823. SX7 -1
  2824. EQ SENDERR
  2825.  
  2826. SENDERR3 SX6 3 3 = NOT BEEP-ABLE
  2827. SX7 -1
  2828.  
  2829. SENDERR SA6 TRETURN SET *ZRETURN*
  2830. SA7 TERROR SET *ERROR*
  2831. EQ SENDEXIT
  2832.  
  2833. *
  2834. * DATA DEFINITIONS
  2835. *
  2836.  
  2837. SSTATN EQU TBINTSV CURRENT STATION NUMBER
  2838. LSTATN EQU SSTATN+1 LAST STATION NUMBER
  2839. NSTATN EQU LSTATN+1 NUMBER OF STATIONS - 1
  2840. SSTATS EQU NSTATN+1 NUMBER OF STATIONS SENT TO
  2841.  
  2842. SAT EQU SSTATS+1 SCREEN LOCATION
  2843. SBUFFER EQU SAT+1 ADDRESS OF TEXT BUFFER
  2844. SCHARS EQU SBUFFER+1 LENGTH OF TEXT (CHARS)
  2845.  
  2846. STYPE EQU SCHARS+1 -1=NORMAL, 0=SEND, 1=ERASE
  2847. SWHO EQU STYPE+1 -1=ON, 0=BOTH, 1=OFF
  2848.  
  2849. SACTIVE EQU SWHO+1 NEG. IF ACTIVE, POS. IF NOT
  2850. SSTATUS EQU SACTIVE+1 -1 IF THINGS TO RESTORE
  2851.  
  2852. ERRPL SSTATUS-TBINTSV-TINTSVL
  2853.  
  2854. BEEPCOD VFD 42/0,3/3B,8/0,7/173B
  2855.  
  2856. STEMP OVDATA SCRATCH
  2857.  
  2858. ENDOV
  2859. * /--- BLOCK BEEP 00 000 80/02/08 23.37
  2860. TITLE -BEEP-
  2861. *
  2862. BEEPOV OVRLAY
  2863. SA1 STFLAG1
  2864. AX1 4
  2865. MX0 -4
  2866. BX1 -X0*X1 MASK OFF TERMINAL TYPE CODE
  2867. SA1 X1+PPTINFO GET TERMINAL DESCRIPTION WORD
  2868. LX1 1 CHECK IF BEEP-ABLE
  2869. PL X1,PROCESS
  2870. SA1 BEEPCOD
  2871. OUTCODE S19CODE OUTPUT BEEP REQUEST
  2872. EQ PROCESS
  2873. *
  2874. BEEPCOD VFD 42/0,3/3B,8/0,7/173B
  2875. *
  2876. ENDOV
  2877. * /--- BLOCK ACCESS 00 000 80/04/30 18.55
  2878. TITLE -ACCESS- AND -SYSACC- COMMAND EXECUTION.
  2879. ACCESS SPACE 5,11
  2880. *** ACCESS - EXECUTION ROUTINE FOR -ACCESS- COMMAND.
  2881. *
  2882. * ACCESS LESSON,RETURNVARIABLE
  2883. * ACCESS FILE,RETURNVARIABLE
  2884. * ACCESS ACCOUNT';FILE,BLOCK,RETURNVARIABLE
  2885. *
  2886. * OVARG1 = 0 FOR -ACCESS-
  2887. * OVARG1 = 1 FOR -SYSACC-
  2888. *
  2889. * ENTRY (A5) = ADDRESS OF COMMAND WORD
  2890. * (OVARG1) = COMMAND TYPE
  2891. *
  2892. * EXIT - (TRETURN) = ZRETURN
  2893. * STUDENT BANK HAS USERS ACCESS BITS
  2894. *
  2895. * USES X - 0, 1, 2, 3, 4, 5, 6, 7.
  2896. * A - 0, 1, 2, 3, 4, 6, 7.
  2897. * B - 1, 2, 3.
  2898. *
  2899. * CAN NOT CHANGE B4,B5,B6,B7.
  2900. *
  2901. * MACROS - NGETVAR.
  2902. *
  2903. * CALLS SAVLES, GETCODX, GETACN, SYSACC
  2904. * GETACC, PUTACC, ACTFILE, RETPROC.
  2905. *
  2906. *
  2907. *
  2908. * SUMMARY OF STATE TABLE
  2909. * ------------------------
  2910. * S1) SEARCH FOR SYSTEM
  2911. * S2) SEARCH FOR GROUP
  2912. * S3) SEARCH FOR ACCOUNT
  2913. * S4) SEARCH FOR NAME (NAME/GROUP/SYSTEM)
  2914. * S5) SEARCH FOR TYPE (TYPE/GROUP/SYSTEM)
  2915. * S6) SEARCH FOR OTHER (OTHER/GROUP/SYSTEM)
  2916. * S7) SEARCH FOR TYPE (TYPE/ACCOUNT/SYSTEM)
  2917. * S8) SEARCH FOR OTHER (OTHER/ACCOUNT/SYSTEM)
  2918. * S9) SEARCH FOR ACCOUNT = OTHER
  2919. * S10) SEARCH FOR TYPE (TYPE/OTHER/SYSTEM)
  2920. * S11) SEARCH FOR OTHER (OTHER/OTHER/SYSTEM)
  2921. *
  2922. *
  2923. * /--- BLOCK ACCESS 00 000 81/01/12 21.50
  2924. EJECT
  2925. *** FLOW-CHART OF THE ALGORITHM USED TO DECIDE ACCESS
  2926. *
  2927. * START (ACHECK)
  2928. * V
  2929. * ------ ---------- --------- ----------
  2930. * I I NO I ACH13 I NO I BIT 0 I YES I RETURN I
  2931. * I S1 I--->I RID=A1 I----->I SET I---->I O/O/L I
  2932. * ------ ---------- --------- ----------
  2933. * I YES V YES NO V V
  2934. * I ---------- ---------- --------
  2935. * I<-----I SET TO I I RETURN I I I
  2936. * I I LOCAL I I ZEROS I--->I EXIT I
  2937. * I ---------- ---------- --------
  2938. * V
  2939. * ------ ------ ------ ------
  2940. * I I YES I I NO I I NO I I
  2941. * I S2 I---->I S4 I---->I S5 I---->I S6 I
  2942. * ------ ------ ------ ------
  2943. * I NO I YES I YES YES I I NO
  2944. * I V V V I
  2945. * I ----------------------- I
  2946. * I I RETURN USERS ACCESS I I
  2947. * I I (ACH11) I I
  2948. * I ----------------------- I
  2949. * I A A A I
  2950. * I <---------I-----------I--------I--I
  2951. * V I YES I YES I
  2952. * ------ ------ ------ I
  2953. * I I YES I I NO I I I
  2954. * I S3 I---->I S7 I---->I S8 I I
  2955. * ------ ------ ------ I
  2956. * NO I NO I I
  2957. * I <-------------------- I
  2958. * I I
  2959. * I ----------------------
  2960. * V I YES I YES
  2961. * ------ ------- -------
  2962. * I I YES I I NO I I NO
  2963. * I S9 I---->I S10 I---->I S11 I---I
  2964. * ------ ------- ------- I
  2965. * I NO I
  2966. * I <-----------------------------
  2967. * V
  2968. * ------------- ----------
  2969. * I STATION I YES I RETURN I
  2970. * I =0 (ACH8) I---> I -0 I
  2971. * ------------ ----------
  2972. * NO I I
  2973. * V I
  2974. * ------------ I
  2975. * I RETURN 0 I I
  2976. * ------------ I
  2977. * /--- BLOCK ACCESS 00 000 81/01/12 21.50
  2978. * I I
  2979. * I <--------------
  2980. * V
  2981. * EXIT (ACHECK)
  2982. EJECT
  2983. * /--- BLOCK ACCESS 00 000 81/01/13 00.25
  2984. ACCESX OVRLAY
  2985.  
  2986. ACW8 EQU TBINTSV NUMBER OF WORDS TO RETURN
  2987. ACW14 EQU TBINTSV+1 GETVAR CODE OF WORDS RETURNED
  2988. ACW15 EQU TBINTSV+2 GETVAR CODE OF RETURNED ACCESS
  2989.  
  2990. * CHECK FOR AVAILABLE JUDGE BUFFERS - USED TO SAVE
  2991. * INFO OVER INTERRUPT IN *GETACC* SUBOVERLAY.
  2992.  
  2993. INTLOK X,I.JUDG,W
  2994. SA1 AJBSTAT (X1) = EM FWA OF JBUFF STATS
  2995. BX0 X1
  2996. SA0 JBUFCNT
  2997. + RE 4
  2998. RJ ECSPRTY
  2999. SA2 A0 NUMBER JUDGE BUFFERS IN USE
  3000. SX1 =XJBANKS-1 CHECK FOR 2 LEFT
  3001. IX2 X2-X1
  3002. NG X2,ACC0 IF AVAILABLE
  3003. SA1 JMAXCNT+1 INCREMENT OVERFLOW COUNT
  3004. SX6 1
  3005. IX6 X1+X6
  3006. SA6 A1
  3007. + WE 4
  3008. RJ ECSPRTY
  3009. INTCLR X,I.JUDG
  3010. SA5 A5+1 BACK UP COMMAND POINTER
  3011. EQ =XXSLICE END TIME-SLICE
  3012.  
  3013.  
  3014. * SAVE COMMON
  3015.  
  3016. ACC0 BSS 0
  3017. INTCLR X,I.JUDG
  3018. CALL SAVLES SAVE COMMON PROBABLY NOT NEED
  3019.  
  3020. * CHECK FOR -SYSACC- COMMAND FORM
  3021.  
  3022. SA1 OVARG1
  3023. NZ X1,SYSACC 1 FOR SYSACC
  3024.  
  3025. * STORE A ZERO AS THE NAME AS A FLAG TO GETACC
  3026. * TO USE CURRENT PERSON EXECUTING INFO
  3027.  
  3028. BX6 X6-X6
  3029. SA6 ACP2
  3030.  
  3031. SX7 1
  3032. SA7 ACP8 MAXIMUM WORDS TO RETURN TO USER
  3033. SA7 ACW8
  3034.  
  3035. * MOVE GETVAR CODES INTO *VARBUF*
  3036.  
  3037. SX6 5
  3038. CALL GETCODX 5 ARGUMENTS TOTAL
  3039.  
  3040. * CHECK IF 3 TAG COMMAND FORM
  3041.  
  3042. SA1 VARBUF GET FIRST GETVAR CODE; TOP BIT
  3043. PL X1,ACC4 SET IF LESSON/FILE KEYWORD
  3044.  
  3045. * TWO TAG -ACCESS- COMMAND
  3046. * THE TOP TWO BITS OF THE *GETVAR* CODE ARE SET TO
  3047. * 1 = KEYWORD -FILE- 2 = KEYWORD -LESSON-
  3048.  
  3049. LX1 XCODEL
  3050. SX6 X1-2 (X5) = 0 IF KEYWORD -FILE-
  3051. SA1 VARBUF+3 GET 4TH ARGUMENT (RETURN)
  3052. BX7 X1
  3053. SA7 ACW15 STORE RETURN LOCATION
  3054. ZR X6,ACC2 IF KEYWORD LESSON
  3055.  
  3056. * IF A *FILE* KEYWORD IS BEING PROCESSED, FETCH
  3057. * THE ACTUAL FILE NAME AND FILE NODE LESSON NUMBER
  3058.  
  3059. AFTJMP ACC3,X,ACC1 BRANCH ON ACTIVE FILE TYPE
  3060.  
  3061. SA1 TDSPARM (X1) = NAMESET/DATASET INFO
  3062. EQ ACC1.1
  3063.  
  3064. ACC1 SA1 TAFINF2 (X1) = TUTOR-TYPE FILE INFO
  3065.  
  3066. ACC1.1 BX7 X1 SAVE OVER *ACTFILE* CALL
  3067. CALL ACTFILE,ACP9 GET ACCOUNT/FILE NAMES
  3068. SX1 X7 (X1) = LESSON NUMBER
  3069.  
  3070. * KEYWORD FILE
  3071.  
  3072. * /--- BLOCK ACCESS 00 000 81/01/13 00.25
  3073. RJ GETACN READ ACCESS LESSON FROM HEADER
  3074. EQ ACC5
  3075. * /--- BLOCK ACCESS 00 000 81/01/13 00.25
  3076.  
  3077. * KEYWORD LESSON
  3078. * GET NAME OF ACCESS LIST ASSOCIATED
  3079. * WITH THIS LESSON FROM LESSON DIRECTORY
  3080.  
  3081. ACC2 SA1 TBLESSN GET CURRENT LESSON NAME
  3082. SA2 ILESUN LESSON NUMBER
  3083. AX2 18 SHIFT FOR LESSON NUMBER
  3084. BX6 X1
  3085. SA6 ACP10 STORE LESSON NAME
  3086. SX1 X2 (X1) = LESSON NUMBER
  3087. RJ GETACN READ ACCESS LESSON FROM HEADER
  3088. EQ ACC5
  3089.  
  3090. ACC3 SX6 1 NO FILE ATTACHED
  3091. SA6 TRETURN
  3092. EQ CKPROC EXIT
  3093. * /--- BLOCK ACCESS 00 000 81/01/18 20.04
  3094.  
  3095. * LESSON AND BLOCK NAME SPECIFIED
  3096.  
  3097. ACC4 CALL FILEBLK,VARBUF,ACP9
  3098.  
  3099. SA1 VARBUF+3 GET 4TH ARGUMENT
  3100. BX6 X1
  3101. SA6 ACW15
  3102. ACC5 BX6 X6-X6
  3103. SA6 ACP1 RETURN USER BITS ONLY
  3104. SA1 KEY
  3105. BX6 X1
  3106. SA6 TOKEY
  3107. SA1 XSSTATS *** TEMP STATS
  3108. SX6 1 ***
  3109. IX6 X1+X6 ***
  3110. SA6 A1 ***
  3111. X GETACC,B0 SEARCH ACCESS LIST BY NAME
  3112. RJ PUTACC STORE USERS ACCESS
  3113. EQ CKPROC EXIT
  3114. * /--- BLOCK SYSACC 00 000 80/04/30 19.06
  3115. SYSACC SPACE 5,11
  3116. *** SYSACC - BEGIN -SYSACC- COMMAND PROCESSING.
  3117. *
  3118. * IF INFO IS PASSED SET UP *ACP* BUFFER ELSE SET
  3119. * *ACP2* = 0 (NAME) AS FLAG FOR GETACC TO SUPPLY
  3120. * THE CURRENTLY EXECUTING USERS INFO, I.E. NAME.
  3121. *
  3122. * SYSACC ACCOUNT';FILE,BLOCK,BUFFER,RETURN,MAXL,RETURNL
  3123. *
  3124. * ACCOUNT ACCOUNT OF FILE WITH ACCESS BLOCK
  3125. * FILE NAME OF FILE WITH ACCESS BLOCK
  3126. * BLOCK NAME OF ACCESS BLOCK
  3127. * BUFFER USER SUPPLIED BUFFER TO READ
  3128. * NAME (2 WORDS)
  3129. * GROUP
  3130. * ACCOUNT
  3131. * USER TYPE
  3132. * SYSTEM
  3133. * RETURN VARIABLE TO RETURN BITS IN
  3134. * RETURNL NUMBER OF BITS RETURNED
  3135. * MAXL MAXIMUM LENGTH TO RETURN
  3136. *
  3137. * EXIT - (TRETURN) = ZRETURN
  3138. * (TERROR) = TYPE OF ACCESS BLOCK
  3139.  
  3140. SYSACC SX6 7 GET 7 ARGUMENTS
  3141. CALL GETCODX UNPACK ARGUMENTS TO VARBUF
  3142.  
  3143. CALL FILEBLK,VARBUF,ACP9
  3144.  
  3145. MX6 0
  3146. SA6 SRCHTYP SET SEARCH TYPE / NAME SEARCH
  3147.  
  3148. * GET VALUES FROM PASSED-OFF USER BUFFER
  3149.  
  3150. SA1 VARBUF+3 GET BUFFER LOCATION
  3151. BX5 X1
  3152. NGETVAR
  3153. BX6 X1
  3154. SA6 ACP2 STORE NAME
  3155.  
  3156. ZR X1,SYSAC1 IF USE THIS USERS INFO
  3157. SA0 A1
  3158. SX1 6
  3159. CALL BOUNDS AT LEAST 6 WORDS TO READ FROM
  3160.  
  3161. SA1 A0+1 INCREMENT POINTER INTO BUFFER
  3162. BX6 X1
  3163. SA6 ACP3 STORE SECOND PART OF NAME
  3164.  
  3165. SA1 A1+1 GET GROUP
  3166. BX6 X1
  3167. SA6 ACP4 STORE GROUP
  3168. NZ X6,SYSAC0 IF GROUP=0, MAY BE LESSON SRCH
  3169. SA2 ACP2 GET FIRST WORD OF NAME/LESSON
  3170. NG X2,SYSAC0 IF CAPITALIZED, 'OTHER OR 'USER
  3171. SX6 1
  3172. SA6 SRCHTYP SET SEARCH TYPE / LESSON SEARCH
  3173.  
  3174. SYSAC0 SA1 A1+1 GET ACCOUNT
  3175. BX6 X1
  3176. SA6 ACP5 STORE ACCOUNT NAME
  3177.  
  3178. SA1 A1+1 GET USER TYPE
  3179. BX6 X1
  3180. SA6 ACP6 STORE TYPE
  3181.  
  3182. SA1 A1+1 GET SYSTEM
  3183. MX0 18
  3184. BX1 X1*X0
  3185. SYSAC1 SX6 1
  3186.  
  3187. * THE RIGHTMOST 18 BITS OF ACP1 ARE 1 IF -SYSACC-
  3188.  
  3189. BX6 X1+X6
  3190. * /--- BLOCK SYSACC 00 000 80/04/30 19.06
  3191. SA6 ACP1 STORE SYSTEM
  3192. * /--- BLOCK SYSACC 00 000 81/01/18 20.06
  3193.  
  3194. * STORE REST OF TAGS FROM COMMAND
  3195.  
  3196. SA1 VARBUF+4 FWA TO RETURN BITS IN
  3197. BX6 X1
  3198. SA6 ACW15
  3199.  
  3200. SA1 VARBUF+5 MAXIMUM LENGTH TO RETURN
  3201. BX5 X1
  3202. NGETVAR
  3203. BX6 X1
  3204. SA6 ACP8
  3205. SA6 ACW8
  3206.  
  3207. SA1 VARBUF+6 GETVAR TO STORE LENGTH RETURNED
  3208. BX6 X1
  3209. SA6 ACW14 WORDS RETURNED
  3210. SA1 KEY
  3211. BX6 X1
  3212. SA6 TOKEY
  3213. SA1 XSSTATS+1 *** TEMP STATS
  3214. SX6 1 ***
  3215. IX6 X1+X6 ***
  3216. SA6 A1 ***
  3217. SA1 SRCHTYP X1 = SEARCH TYPE (0/1)
  3218. X GETACC,X1 SEARCH ACCESS LIST
  3219.  
  3220. * SET ERROR TO CONTAIN BLOCK TYPE, GETACC STORES IT
  3221. * IN *ACP1* IN THE LEFTMOST 6 BITS.
  3222.  
  3223. SA1 ACP1 GET TYPE OF ACCESS BLOCK
  3224. MX2 6 ITS IN THE TOP 6 BITS
  3225. BX6 X2*X1
  3226. LX6 6
  3227. SA6 TERROR SET *ERROR* IN STUDENT BANK
  3228. RJ PUTACC RETURN USERS BITS
  3229. EQ CKPROC EXIT
  3230.  
  3231. SRCHTYP BSSZ 1 SEARCH TYPE (TEMP HOLDING CELL)
  3232. * /--- BLOCK GETACN 00 000 80/04/30 18.02
  3233. GETACN SPACE 5,11
  3234. ** GETACN - GET USERS ACCESS LIST NAME.
  3235. *
  3236. * THIS ROUTINES READS A LESSON HEADER
  3237. * DECIDES THE TYPE OF THE LESSON HEADER
  3238. * AND RETURNS THE NAME OF THE ASSOCIATED
  3239. * ACCESS LESSON AND BLOCK NAME.
  3240. *
  3241. * ENTRY - (X1) = LESSON NUMBER
  3242. *
  3243. * EXIT - ACCESS LIST NAME IN *ACACCT*, *ACFILE*, *ACBLOCK*
  3244. *
  3245. * USES X - 1, 2, 6, 7.
  3246. * A - 1, 2, 6, 7.
  3247. * B - 1.
  3248. *
  3249. * CALLS READLES.
  3250. *
  3251. * CALLED BY ACCESX.
  3252.  
  3253. GETACN PS READ LESSON HEADER FOR NAMES
  3254. SX6 0 ALWAYS ZERO ACCOUNT NAME FOR NOW
  3255. SA6 ACP9
  3256. CALL READLES,LHBUFF,LPRMLTH
  3257. SA1 A0 CHECK LESON TYPE
  3258. MX2 12
  3259. BX1 X2*X1
  3260. LX1 12 (X1) = LESSON TYPE
  3261. ZR X1,GETA1 IF LESSON
  3262. SX1 X1-9
  3263. ZR X1,GETA2 IF DATASET FILE NODE
  3264. SX1 X1-10+9
  3265. ZR X1,GETA3 IF TUTOR FILENODE
  3266. SA2 -1 ABORT
  3267.  
  3268. * PROCESS LESSON
  3269.  
  3270. GETA1 RE LESHEAD
  3271. RJ ECSPRTY
  3272. SA1 A0+LACCLN SAVE ACCESS FILE / BLOCK NAME
  3273. SA2 A0+LACCBN
  3274. EQ GETA4
  3275.  
  3276. * PROCESS DATASET FILE NODE
  3277.  
  3278. GETA2 SA0 DSH
  3279. SX1 DSHEAD
  3280. IX0 X0+X1
  3281. RE FPRMLTH
  3282. RJ ECSPRTY
  3283. SA1 ACCLNW
  3284. SA2 ACCBNW
  3285. EQ GETA4
  3286.  
  3287. * PROCESS TUTOR FILE NODE
  3288.  
  3289. GETA3 SX1 TUTHEAD+4+O.ACCLN
  3290. IX0 X0+X1 BIAS PAST HEADER
  3291. RX1 X0
  3292. SX2 O.ACCBN-O.ACCLN
  3293. IX0 X0+X2
  3294. RX2 X0
  3295.  
  3296. GETA4 ZR X2,GETA5
  3297. BX6 X2
  3298. SA6 ACP11
  3299. ZR X1,GETACN
  3300. BX6 X1
  3301. SA6 ACP10
  3302. EQ GETACN
  3303.  
  3304. GETA5 BX6 X6-X6 ZERO X6
  3305. SA6 ACP10
  3306. SA6 ACP11
  3307. EQ GETACN
  3308. * /--- BLOCK PUTACC 00 000 80/05/01 14.16
  3309. PUTACC SPACE 5,11
  3310. ** PUTACC - RETURN ACCESS BITS TO USER.
  3311. *
  3312. * ENTRY - EXIT FROM GETACC OVERLAY
  3313.  
  3314. PUTACC PS
  3315. SA1 TOKEY RESTORE *KEY*
  3316. BX6 X1
  3317. SA6 KEY
  3318.  
  3319. * RESTORE NC VARS BEFORE WRITTING IN NEW VALUES
  3320.  
  3321. CALL RESTLES
  3322. SB1 1 B1=1
  3323. SA1 TRETURN
  3324. PL X1,PUTACC ERROR / NO CHANGE STUDENT VARS
  3325. SA1 ACP1 CHECK FOR MORE THAN ONE WORD
  3326. AX1 18+18
  3327. SX1 X1
  3328. NG X1,PAC4 IF NO WORDS TO RETURN
  3329. ZR X1,PAC4
  3330. SX1 X1-1
  3331. NZ X1,PAC1 IF MORE THAN ONE WORD TO STORE
  3332. SA2 ACP2 GET ACCESS WORD
  3333. BX6 X2 (X6) = VALUE TO STORE
  3334. SA1 ACW15 (X1) = GETVAR CODE
  3335. BX5 X1
  3336. NPUTVAR
  3337. EQ PAC3
  3338.  
  3339. PAC1 SA1 ACW15 (X1) = GETVAR CODE TO STORE
  3340. BX5 X1
  3341. NGETVAR
  3342. SA0 A1
  3343. SA1 ACP1
  3344. AX1 18+18
  3345. SX1 X1
  3346. CALL BOUNDS MAKE SURE LEGAL ADDRESS
  3347. SB2 A0 (B2) = FWA TO STORE
  3348. SA1 ACP2
  3349. PAC2 BX6 X1
  3350. SA6 B2
  3351. SB2 B2+1
  3352. SA1 A1+1
  3353. LT B2,B1,PAC2 IF MORE TO STORE
  3354. PAC3 SA1 ACP1
  3355. SX1 X1
  3356. ZR X1,PUTACC IF NON-SYSTEM VERSION
  3357.  
  3358. * RETURN NUMBER OF WORDS RETURNED
  3359.  
  3360. SA1 ACP1
  3361. AX1 18+18
  3362. SX1 X1
  3363. SA2 ACW14
  3364. BX6 X1
  3365. BX5 X2
  3366. NPUTVAR RETURNED WORD COUNT
  3367. EQ PUTACC EXIT
  3368.  
  3369. PAC4 SX6 0 ERROR = 0 = NO ACCESS BITS
  3370. SA6 TRETURN
  3371. EQ PUTACC
  3372.  
  3373. ENDOV
  3374. * /--- BLOCK GETACC 00 000 80/05/01 10.30
  3375. GETACC TITLE SEARCH ACCESS LIST.
  3376. GETACC SPACE 5,11
  3377. ** GETACC - GET ACCESS ACCESS BITS FOR USER.
  3378. *
  3379. * SEARCH ACCESS LIST.
  3380. *
  3381. * TBINTSV IS SAVED DURING EXECUTION
  3382. *
  3383. * ENTRY - (ACP1) = 18/SYSTEM NAME,
  3384. * 24/0,
  3385. * 18/1 IF SYSTEM SEARCH
  3386. * (ACP2) = USERS NAME OR LESSON ACCOUNT
  3387. * (ACP3) = USERS NAME OR LESSON NAME
  3388. * (ACP4) = USERS GROUP
  3389. * (ACP5) = USERS ACCOUNT
  3390. * (ACP6) = USERS TYPE
  3391. * (ACP7) = 0
  3392. * (ACP8) = NUMBER OF WORDS TO RETURN
  3393. * (ACP9) = ACCOUNT OF ACCESS LIST
  3394. * (ACP10)= FILE OF ACCESS LIST
  3395. * (ACP11)= BLOCK OF ACCESS LIST
  3396. * (OVARG1) = 0 IF SEARCH BY NAME
  3397. * 1 IF SEARCH BY LESSON
  3398. *
  3399. * EXIT - (ACP1) = 6/ACCESS LIST TYPE
  3400. * 18/NUMBER OF WORDS RETURNED
  3401. * 18/
  3402. * 18/1 IF SYSTEM SEARCH
  3403. * (ACP2) = ACCESS BIT FOR (ACP8) WORDS
  3404. * (ZRETURN) = -2 - NO ERRORS, OWNER FOUND
  3405. * -1 - NO ERRORS
  3406. * 0 - NO ACCESS BITS
  3407. * 1 - ACCESS LESSON NOT FOUND
  3408. * 2 - ACCESS BLOCK NOT FOUND
  3409. * 3 - SYSTEM (SUBFILE) ERROR
  3410. *
  3411. * /--- BLOCK GETACC 00 000 80/05/01 14.23
  3412.  
  3413. GETACC OVRLAY
  3414. CALL GJBUF
  3415. NG X6,=XNJBMSG IF NO BUFFER AVAILABLE
  3416. SA1 TJDBUF1 SAVE JUDGE BUFFER NUMBER
  3417. MX0 -18
  3418. BX1 X0*X1
  3419. BX6 X1+X6
  3420. SA6 A1
  3421. CALL GBA GET JUDGE BUFFER ADDRESS
  3422. SA0 TBINTSV
  3423. WE TINTSVL
  3424. RJ ECSPRTY
  3425. SA1 TIOECS SAVE SUBFILE BUFFER
  3426. BX6 X1
  3427. SA6 A0
  3428. SA1 OVRETRN SAVE OVERLAY RETURN INFO
  3429. BX6 X1
  3430. SA6 A0+1
  3431. CALL SSTACK,A0+2
  3432. SX1 TINTSVL
  3433. IX0 X0+X1
  3434. WE TINTSVL
  3435. RJ ECSPRTY
  3436.  
  3437. * MOVE PARAMETER BLOCK TO *TBINTSV*
  3438.  
  3439. SA0 ACP1
  3440. SA1 ATEMPEC
  3441. BX0 X1
  3442. WE TINTSVL
  3443. RJ ECSPRTY
  3444. SA0 ACW1
  3445. RE TINTSVL
  3446. RJ ECSPRTY
  3447. SA1 OVARG1
  3448. MX7 -1
  3449. BX6 X1
  3450. SA7 ACW12 SHOW NO ACCESS BLOCK
  3451. SA6 ACW16
  3452. CALL IOSAV SAVE / CLEAR SUBFILE BUFFER
  3453. BX6 X6-X6
  3454. SA6 TIOECS
  3455. SA1 ACFILE
  3456. ZR X1,AERR1 IF NO ACCESS LESSON
  3457. TUTIM 1
  3458. SX6 11 SET ACCESS LIST TYPE
  3459. LX6 48
  3460. SA6 ACTYPE
  3461. * /--- BLOCK GETACC 00 000 80/05/01 14.23
  3462.  
  3463. * GET USER INFO AND STORE IN *ACW* BUFFER
  3464.  
  3465. SA1 ACW16
  3466. ZR X1,GETN IF SEARCH BY NAME
  3467.  
  3468. * CHECK IF LESSON NAME SPECIFIED
  3469.  
  3470. SA1 ACW3
  3471. NZ X1,GET8 IF LESSON SPECIFIED
  3472. SA2 TBLESAC
  3473. SA3 A2+1
  3474. BX6 X2
  3475. BX7 X3
  3476. SA6 ACW2
  3477. SA6 ACW6 SET ACCOUNT / OTHER SEARCH
  3478. SA2 OTHER
  3479. SA7 A1
  3480. BX6 X2
  3481. SA6 A6+1
  3482. EQ GET8
  3483.  
  3484. * CHECK IF NAME SPECIFIED
  3485.  
  3486. GETN SA1 ACW2
  3487. NZ X1,GET0
  3488. SA1 TNAME GET USERS NAME
  3489. SA2 TNAME1
  3490. MX3 48
  3491. BX6 X1
  3492. BX7 X3*X2 MASK OUT DISK BLOCK NUMBER
  3493. SA6 ACW2 STORE FIRST PART OF NAME
  3494. SA7 ACW3 STORE SECOND PART
  3495. SA2 AGROUP ECS ADDRESS OF GROUP BUFFER
  3496. SA1 STATION ADD BIAS OF THIS STATION
  3497. IX0 X2+X1
  3498. RX1 X0
  3499. BX6 X1*X3 THROW AWAY DISK BLOCK NUMBER
  3500. SA6 ACW4 SAVE GROUP NAME
  3501. SA1 TACCNAM PICK UP ACCOUNT NAME OF USER
  3502. BX6 X1
  3503. SA6 ACW5 STORE ACCOUNT NAME
  3504. SA1 TTYPE GET USER TYPE
  3505. BX6 X1
  3506. SA6 ACW6 STORE USER TYPE
  3507. SA1 =XHOMERID GET SYSTEM NAME
  3508. SA2 ACW1 TO SAVE SYSTEM FLAG
  3509. BX6 X1+X2
  3510. SA6 A2 STORE SYSTEM NAME
  3511. * /--- BLOCK GETACC 00 000 80/05/01 14.21
  3512.  
  3513. * SET USER TYPE TO PSEUDO TYPE STORED ON DISK
  3514.  
  3515. GET0 SA1 ACW6 GET USER TYPE ALREADY STORED
  3516. AX1 56
  3517. SB2 X1
  3518. NG B2,GET3 IF INVALID TYPE
  3519. SB3 B2-4
  3520. GT B3,GET3 IF INVALID TYPE
  3521. JP GET1+B2
  3522.  
  3523. GET1 EQ GET2 AUTHOR
  3524. + EQ GET3 ERROR TYPE DOES NOT EXIST
  3525. + EQ GET4 INSTRUCTOR
  3526. + EQ GET5 MULTIPLE
  3527. + EQ GET6 STUDENT
  3528.  
  3529. GET2 SA2 AUTHOR PSEUDO TYPE AUTHOR
  3530. BX3 X3-X3
  3531. EQ GET7
  3532.  
  3533. GET3 BX2 X2-X2 INVALID TYPE OF USER
  3534. BX3 X3-X3
  3535. EQ GET7
  3536.  
  3537. GET4 SA2 INSTRUC PSEUDO TYPE INSTRUCTOR
  3538. SA3 INSTRU1
  3539. EQ GET7
  3540.  
  3541. GET5 SA2 MULTIP PSEUDO MULTIPLE
  3542. SA3 MULTIP1
  3543. EQ GET7
  3544.  
  3545. GET6 SA2 STUDENT PSEUDO STUDENT
  3546. BX3 X3-X3
  3547.  
  3548. GET7 BX6 X2 STORE THE RESULTS
  3549. BX7 X3
  3550. SA6 ACW6
  3551. SA7 ACW7
  3552. * /--- BLOCK GETACC 00 000 81/03/22 01.12
  3553.  
  3554. * CHECK TO SEE IF ACCESS BLOCK BEING LOADED
  3555.  
  3556. GET8 INTLOK X,I.SIGN,W INTERLOCK
  3557. CALL IOSRCH,ACACCT,ACLIOT
  3558. NG X6,GET10 JUMP IF NOT
  3559.  
  3560. * WAIT FOR I/O TO COMPLETE OR FOR STORAGE
  3561.  
  3562. GET9 INTCLR X,I.SIGN
  3563. CALL IOREL RELEASE BUFFER IF ASSIGNED
  3564. TUTIM 250
  3565. EQ GET8
  3566.  
  3567. * CHECK IF LIST ALREADY IN ECS
  3568.  
  3569. GET10 CALL FINDLES,ACACCT,ACW12
  3570. SA2 ACW12
  3571. PL X2,GET13
  3572.  
  3573. * RESERVE I/O BUFFER.
  3574.  
  3575. CALL IORES,ACACCT,ACLIOT
  3576. PL X6,GET9 JUMP IF NONE AVAILABLE
  3577.  
  3578. * PREPARE TO READ DIRECTORY
  3579.  
  3580. SA1 ACACCT GET ACCOUNT NAME
  3581. BX6 X1
  3582. SA6 ACCNTF
  3583. SA1 ACFILE GET FILE NAME
  3584. BX6 X1
  3585. SA6 LESSONF
  3586. SA1 ACBLOCK GET BLOCK NAME
  3587. BX6 X1
  3588. SA6 BLOCKF
  3589. SA1 ACW1 CHECK COMMAND TYPE
  3590. SX1 X1 CLEAR SYSTEM NAME
  3591. MX6 -1 (X6) = ANY FILE TYPE
  3592. NZ X1,GET11 IF SYSTEM VERSION
  3593. BX6 X6-X6 (X6) = TUTOR FILE ONLY
  3594. GET11 SA6 FILETF
  3595. SX6 1 1 = READ DIRECTORY ONLY
  3596. SA6 IOCODEF
  3597. SX6 10 ACCESS BLOCK
  3598. SA6 BLKTF ACCESS BLOCK TYPE
  3599. INTCLR X,I.SIGN
  3600.  
  3601. * READ LESSON DIRECTORY
  3602.  
  3603. CALLX SUBFILE
  3604. SA1 NERROR GET ERROR RETURN
  3605. NZ X1,AERR0 IF ERROR OCCURRED
  3606.  
  3607. * CHECK NUMBER OF BLOCKS IN SUB-FILE
  3608.  
  3609. SA1 LTHF (X1) = EM LENGTH OF ACCESS LIST
  3610. ZR X1,AERR3S --- IF GARBAGENOUS
  3611. NG X1,AERR3S --- DITTO
  3612. SX2 8000+1 MAXIMUM SIZE IS 8000 WORDS
  3613. IX2 X1-X2 CHECK THAT SIZE .LE. 8000 WORDS
  3614. PL X2,AERR3S --- IF ACCESS LIST TOO LARGE
  3615. SA2 DSKLTHF (X2) = DISK LTH OF ACCESS LIST
  3616. IX2 X1-X2 COMPARE EM AND DISK LENGTHS
  3617. NZ X2,AERR3S --- ERROR IF LENGTHS DIFFERENT
  3618.  
  3619. * GET FULL ACCOUNT NAME RETURNED BY SUBFILE
  3620.  
  3621. SA1 ACCNTF
  3622. BX6 X1
  3623. SA6 ACACCT
  3624. * /--- BLOCK GETACC 00 000 80/07/08 02.41
  3625.  
  3626. * CALCULATE SIZE OF ECS BUFFER NEEDED
  3627.  
  3628. INTLOK X,I.SIGN,W
  3629. SA1 SFNSETF (X1) = NAMESET / TUTOR FLAG
  3630. NG X1,GET11.1 --- IF ACCESS LIST IN NAMESET
  3631. SA1 NBLKF
  3632. SX6 BLKLTH COMPUTE LENGTH OF BUFFER NEEDED
  3633. IX6 X1*X6
  3634. EQ GET11.2
  3635.  
  3636. GET11.1 SA1 LTHF (X1) = LENGTH OF ACCESS LIST
  3637. SX6 X1+
  3638.  
  3639. * WORKS WITH 64 WORD SUBFILE REQUESTS
  3640. * ALLOCATE ECS BUFFER
  3641.  
  3642. GET11.2 CALL XSTOR,ACACCT,X6 GET EM BUFFER
  3643. SA1 LESNUM
  3644. NG X1,GET9 JUMP IF NO ECS AVALIABLE
  3645.  
  3646. GET12 BX6 X1
  3647. SA6 ACW12 SAVE LESSON NUMBER
  3648. * /--- BLOCK GETACC 00 000 82/10/28 16.24
  3649.  
  3650. * SET UP TO READ FROM DISK
  3651.  
  3652. SA1 LESLOC GET ECS ADDRESS OF BUFFER
  3653. SX2 ACCHEAD
  3654. IX6 X1+X2 BIAS PAST HEADER
  3655. SA6 ECSF SET ECS ADDRESS FOR DISK READ
  3656. SX6 2
  3657. SA6 IOCODEF READ - DIRECTORY AVAILABLE
  3658.  
  3659. * SET BUFFER STATUS TO I/O PENDING
  3660.  
  3661. CALL IOLESSN,ACW12,4000B
  3662. INTCLR X,I.ADDL RELEASE LESNAM INTERLOCK
  3663. INTCLR X,I.SIGN
  3664.  
  3665. * CHANGE FROM 320 WORD TO 64 WORD REQUEST
  3666.  
  3667. SA1 SFNSETF (X1) = NAMESET / TUTOR FLAG
  3668. NG X1,GET12.1 --- IF ACCESS LIST IN NAMESET
  3669. SX6 5
  3670. SA1 NBLKF
  3671. IX6 X6*X1
  3672. SA6 A1
  3673.  
  3674. * READ ACCESS LIST INTO ECS
  3675.  
  3676. GET12.1 CALLX SUBFILE
  3677.  
  3678. * UNLOCK ECS BUFFER
  3679.  
  3680. INTLOK X,I.SIGN,W INTERLOCK SIGNIN PROCESS
  3681. CALL IOLESSN,ACW12,-4000B
  3682. * INTCLR X,I.SIGN
  3683. CALL IOREL
  3684.  
  3685. * CHECK SUBFILE RETURN
  3686.  
  3687. SA1 NERROR
  3688. NZ X1,AERR0 IF ERROR OCCURRED
  3689.  
  3690. * SIGN USER INTO LIST
  3691.  
  3692. * GET13 INTLOK X,I.SIGN,W
  3693. GET13 SA1 ACW12 GET LESSON NUMBER
  3694. CALL ALTLES,1
  3695. INTCLR X,I.SIGN
  3696.  
  3697.  
  3698. * READ IN DISK DIRECTORY FROM ECS INTO
  3699. * A CM BUFFER
  3700.  
  3701. SA1 ACW12 GET LESSON NUMBER
  3702. CALL READLES,B0,B0
  3703. SX1 ACCHEAD
  3704. IX0 X0+X1
  3705. SA0 DWD1
  3706. RE DWORDS+1 GET DIRECTORY AND LOCAL SYSTEM
  3707. RJ ECSPRTY
  3708. BX7 X0
  3709. SA7 ECSDIR STORE LOCATION OF ECS DIRECTORY
  3710. * /--- BLOCK GETACC 00 000 80/05/01 12.12
  3711.  
  3712. * INITIALIZE STATE TABLES
  3713. * SET WORDS / ENTRY AND WORDS / ENTRY OF NEXT TABLE
  3714.  
  3715. SA1 DWD3 SET WORDS / SYSTEM
  3716. LX1 29
  3717. MX0 -2
  3718. BX6 -X0*X1
  3719. SA6 S1+SWPE SET WORDS / SYSTEM
  3720. LX1 2
  3721. BX6 -X0*X1
  3722. SA6 S2+SWPE WORDS PER GROUP
  3723. SA6 S3+SWPE WORDS PER ACCOUNT
  3724. SA6 S9+SWPE WORDS PER ACCOUNT
  3725. SA6 S1+SNWE WORD PER ENTRY OF NEXT TABLE
  3726. MX0 -4 SET WORDS / NAME
  3727. LX1 4
  3728. BX6 -X0*X1
  3729. SA6 S2+SNWE WORDS PER GROUP
  3730. SA6 S3+SNWE WORDS PER NEXT ACCOUNT
  3731. SA6 S9+SNWE WORDS PER NEXT ACCOUNT
  3732. SA6 S4+SWPE NAME
  3733. SA6 S5+SWPE TYPE
  3734. SA6 S6+SWPE OTHER
  3735. SA6 S7+SWPE TYPE
  3736. SA6 S8+SWPE OTHER
  3737. SA6 S10+SWPE TYPE
  3738. SA6 S11+SWPE TYPE
  3739. MX0 -3
  3740. LX1 3
  3741. BX6 -X0*X1
  3742. SA6 S12+SWPE WORDS / LESSON
  3743. SA6 S13+SWPE
  3744. SA6 S14+SWPE
  3745. * /--- BLOCK GETACC 00 000 80/05/01 12.22
  3746.  
  3747. * SET FWA AND LWA OF NEXT TABLE
  3748.  
  3749. SX1 DWORDS GET BIAS
  3750. IX6 X7+X1
  3751. SA6 S1+SFWA STORE FWA OF SYSTEMS
  3752. SA1 DWD1
  3753. MX0 -13
  3754. LX1 6+13
  3755. BX6 -X0*X1
  3756. IX6 X7+X6
  3757. SA6 S12+SLWA SET LWA OF LESSONS
  3758. SA6 S13+SLWA
  3759. SA6 S14+SLWA
  3760. LX1 13
  3761. BX6 -X0*X1
  3762. SX6 X6-1
  3763. IX6 X7+X6
  3764. SA6 S1+SLWA SET LWA OF SYSTEMS
  3765. SA6 S2+SFWA SET FWA OF GROUPS / ACCOUNTS
  3766. SA6 S3+SFWA
  3767. SA6 S9+SFWA
  3768. BX2 X6
  3769. LX1 13
  3770. BX6 -X0*X1 SET FWA OF NAMES
  3771. SX6 X6-1
  3772. IX6 X7+X6
  3773. SA6 S4+SFWA
  3774. SA6 S5+SFWA
  3775. SA6 S6+SFWA
  3776. SA6 S7+SFWA
  3777. SA6 S8+SFWA
  3778. SA6 S10+SFWA
  3779. SA6 S11+SFWA
  3780. SA6 S2+SLWA SET LWA OF GROUPS
  3781. SA6 S3+SLWA
  3782. SA6 S9+SLWA
  3783. BX3 X6
  3784. IX6 X6-X2
  3785. SA6 S1+SNWA SET LWA OF NEXT TABLE
  3786. LX1 13
  3787. BX6 -X0*X1 SET LWA OF NAMES
  3788. SX6 X6-1
  3789. IX6 X7+X6
  3790. SA6 S4+SLWA
  3791. SA6 S5+SLWA
  3792. SA6 S6+SLWA
  3793. SA6 S7+SLWA
  3794. SA6 S8+SLWA
  3795. SA6 S10+SLWA
  3796. SA6 S11+SLWA
  3797. SA6 S12+SFWA SET FWA OF LESSONS
  3798. SA6 S13+SFWA
  3799. SA6 S14+SFWA
  3800. IX6 X6-X3
  3801. SA6 S2+SNWA SET LWA OF NEXT TABLE
  3802. SA6 S3+SNWA
  3803. SA6 S9+SNWA
  3804.  
  3805. * INITIALIZE FIRST STATE
  3806.  
  3807. SA1 ACW16
  3808. NZ X1,GET14 IF SEARCH BY LESSON
  3809. SA1 DWD2 GET NUMBER OF SYSTEMS
  3810. LX1 13
  3811. MX0 -13
  3812. SX6 1
  3813. SA6 ACHB SET LOWER LIMIT
  3814. BX6 -X0*X1
  3815. SX6 X6-1
  3816. SA6 A6+1 SET LIMIT FOR FIRST SEARCH
  3817. * /--- BLOCK GETACC 00 000 80/05/01 12.22
  3818. SX6 S1 (X6) = FIRST STATE
  3819. EQ GET15
  3820.  
  3821. GET14 BX6 X6-X6 SET LOWER LIMIT FOR SEARCH
  3822. MX0 -13
  3823. SA1 DWD2
  3824. SA6 ACHB
  3825. LX1 2*13+12+13
  3826. BX6 -X0*X1 (X6) = NUMBER OF LESSONS
  3827. SA6 A6+1
  3828. SX6 S12
  3829. GET15 SA6 ACHA SET FIRST STATE
  3830. RJ ACHECK GET ACCESS CHECK
  3831. * /--- BLOCK GETACC 00 000 80/07/08 00.39
  3832.  
  3833. * SETUP ZRETURN AND DETACH ECS BUFFER AND RETURN
  3834. *
  3835. * THIS CODE ASSUMES THAT YOU HAVE AN ECS COPY
  3836. * OF THE LIST ALREADY ATTACHED BY YOU, YOU CAN
  3837. * NOT CALL THIS ROUTINE IF YOU DO NOT HAVE ONE.
  3838.  
  3839. AEXIT SA1 ACW1 SET ACCESS BLOCK TYPE
  3840. SA2 DWD1
  3841. SA3 ACW8 SET NUMBER OF WORDS
  3842. MX6 6
  3843. BX2 X6*X2 (X2) = ACCESS LIST TYPE
  3844. MX6 6+18
  3845. BX1 -X6*X1
  3846. LX3 18+18
  3847. BX6 X2+X1
  3848. BX6 X3+X6
  3849. SA6 ACP1 SET RETURN VALUE
  3850. MX6 -1 FOR ZRETURN
  3851. SA1 ACW1
  3852. AX1 18
  3853. SX1 X1
  3854. IX6 X6-X1
  3855. EQ AERR4 EXIT PROCESSING
  3856.  
  3857. * /--- BLOCK GETACC 00 000 80/07/08 02.37
  3858. AERR0 SX1 X1+2
  3859. ZR X1,AERR2 IF BLOCK NOT FOUND
  3860. NG X1,AERR3 IF OTHER ERROR
  3861. AERR1 SX6 1 1 = ACCESS LESSON NOT FOUND
  3862. EQ AERR4
  3863.  
  3864. AERR2 SX6 2 2 = ACCESS BLOCK NOT FOUND
  3865. EQ AERR4
  3866.  
  3867. AERR3S SX6 5 (X6) = TERMINATE I/O REQUEST
  3868. SA6 IOCODEF
  3869. CALLX SUBFILE TERMINATE NAMESET I/O
  3870. AERR3 SX6 3 3 = SYSTEM ERROR
  3871.  
  3872. AERR4 SA6 TRETURN
  3873.  
  3874. * RELEASE I/O BUFFER
  3875.  
  3876. CALL IOREL
  3877.  
  3878. * DECREMENT COUNT
  3879.  
  3880. SA1 ACW12
  3881. NG X1,AERR5 IF NOT LOCATED
  3882. INTLOK X,I.SIGN,W
  3883. SA1 ACW12
  3884. CALL ALTLES,-1
  3885. INTCLR X,I.SIGN
  3886.  
  3887. * RESTORE TBINTSV, OVERLAY STACK
  3888. * RELEASE JUDGE BUFFER
  3889.  
  3890. AERR5 CALL GBA (X0) = BUFFER ADDRESS
  3891. SA0 TBINTSV
  3892. SX1 TINTSVL
  3893. IX0 X0+X1
  3894. RE TINTSVL
  3895. RJ ECSPRTY
  3896. SA1 A0 RESTORE SUBFILE BUFFER
  3897. BX6 X1
  3898. SA6 TIOECS
  3899. SA1 A0+1 RESTORE OVERLAY RETURN INFO
  3900. BX6 X1
  3901. SA6 OVRETRN
  3902. CALL RSTACK,A0+2
  3903. SX1 TINTSVL RESTORE *TBINTSV*
  3904. IX0 X0-X1
  3905. RE TINTSVL
  3906. RJ ECSPRTY
  3907. CALL IORST
  3908. SA1 TJDBUF1
  3909. MX6 42 CLEAR ACCESS BUFFER NUMBER
  3910. BX6 X6*X1
  3911. SA6 A1
  3912. SX1 X1
  3913. NG X1,"CRASH"
  3914. ZR X1,"CRASH"
  3915. CALL RJBUF
  3916. AERR6 RETURN
  3917. * /--- BLOCK ACHECK 00 000 80/04/30 19.42
  3918. ACHECK SPACE 5,11
  3919. ** ACHECK - CHECK USERS ACCESS
  3920. *
  3921. * PROCESS STATE TABLES TO LOCATE USERS ACCESS BITS.
  3922. *
  3923. * ENTRY (ACHA) = CURRENT STATE
  3924. * (ACHB) = BIAS INTO TABLE
  3925. * AND STATE TABLES ARE SET UP
  3926. *
  3927. * /--- BLOCK ACHECK 00 000 80/04/30 19.42
  3928.  
  3929. * TEST TO SEE IF ANY SYSTEMS IN LIST
  3930. * (X0) CONTAINS ECS FWA OF DIRECTORY
  3931.  
  3932. ACHECK PS ACCESS CHECKING
  3933. SB1 1 B1=1
  3934.  
  3935. * PROCESS NEXT STATE
  3936.  
  3937. ACH1 SA4 ACHA (X4) = ADDRESS OF CURRENT STATE
  3938. SA1 X4+SITM
  3939. SA1 X1 (X1) = ITEM TO SEARCH FOR
  3940. SA2 A1+B1 (X2) = SECOND WORD OF ITEM
  3941. SA3 X4+SFWA (X5) = FWA OF TABLE
  3942. BX5 X3
  3943. SA3 X4+SWPE
  3944. SB2 X3 (B2) = WORDS / ENTRY
  3945. SA3 ACHB (X3) = BIAS INTO TABLE
  3946. IX5 X5+X3
  3947. SA3 A3+B1 (X3) = NUMBER OF ENTRIES
  3948. SA4 X4+SMSK
  3949. BX6 X4 (X6) = FIRST WORD OF MASK
  3950. SA4 A4+B1
  3951. BX7 X4 (X7) = SECOND HALF OF MSK
  3952. RJ EBCHOP PERFORM BINARY CHOP
  3953. SA4 ACHA
  3954. PL X0,ACH3 IF ENTRY FOUND
  3955. SA4 X4+SNFS GET NOT FOUND STATE
  3956. NG X4,ACH2 IF NEXT STATE DEFINED
  3957. SB3 X4
  3958. JP B3
  3959.  
  3960. ACH2 BX6 -X4 SET NEXT STATE
  3961. SA6 ACHA
  3962. EQ ACH1 PROCESS NEXT STATE
  3963.  
  3964. * PROCESS ITEM FOUND
  3965.  
  3966. ACH3 SA1 X4+SFWA (X1) = FWA OF TABLE
  3967. SA2 X4+SLWA (X2) = LWA OF TABLE
  3968. SX3 B2 (X3) = WORDS / ENTRY
  3969. IX2 X2-X3
  3970. SB3 B2+B2
  3971. RE B3 READ NEXT TWO ENTRIES
  3972. RJ ECSPRTY
  3973. SA1 A0
  3974. MX5 -12
  3975. BX7 -X5*X1
  3976. SA7 ACHB SET BIAS INTO TABLE
  3977. IX1 X0-X2
  3978. ZR X1,ACH4 IF LAST ENTRY IN TABLE
  3979. SA1 A0+B2
  3980. BX1 -X5*X1 LWA OF BIAS
  3981. EQ ACH5
  3982.  
  3983. ACH4 SA1 X4+SNWA LWA OF NEXT TABLE
  3984. ACH5 IX6 X1-X7
  3985. SA3 X4+SNWE (X3) = WORDS/ENTRY OF NEXT TAB
  3986. PX6 IX6 X6/X3
  3987. PX3
  3988. NX6
  3989. NX3
  3990. FX6 X6/X3
  3991. UX6 X6,B3
  3992. LX6 B3
  3993. SA6 A7+B1 SET NUMBER OF ENTRIES
  3994. * /--- BLOCK ACHECK 00 000 80/04/30 19.42
  3995. SX1 X4-S1 CHECK LIMITS SHOULD BE SAVED
  3996. NZ X1,ACH6 IF NOT AT HIGHEST LEVEL
  3997. SA7 ACHC SAVE LIMITS
  3998. SA6 A7+B1
  3999. ACH6 SA4 X4+SFS GET FOUND STATE
  4000. NG X4,ACH7 IF STATE DEFINED
  4001. SB3 X4
  4002. JP B3 PROCESS STATE
  4003.  
  4004. ACH7 BX6 -X4
  4005. SA6 ACHA
  4006. EQ ACH1 PROCESS NEXT STATE
  4007. * /--- BLOCK ACHECK 00 000 80/04/30 19.45
  4008.  
  4009. * NOT FOUND ROUTINE
  4010.  
  4011. ACH8 SA1 ACW1 SET SYSTEM ERROR
  4012. SX6 -4
  4013. MX2 -18
  4014. LX6 18
  4015. LX2 18
  4016. BX1 X2*X1
  4017. BX6 -X2*X6
  4018. BX6 X1+X6
  4019. SA6 A1
  4020. EQ ACHECK
  4021.  
  4022. * SYSTEM NOT FOUND
  4023.  
  4024. ACH10 SA1 AZERBUF RETURN ACCESS OF ZERO
  4025. SB2 377777B RETURN USER SPECIFIED WORD CNT
  4026. BX0 X1
  4027.  
  4028. * FOUND
  4029.  
  4030. ACH11 RJ DIRCHK
  4031. SA0 ACP2
  4032. SX1 B1
  4033. IX0 X0+X1 BIAS PAST NAME / ACCOUNT
  4034. SB2 B2-B1
  4035. SA2 ACW16
  4036. ZR X2,ACH11.1 IF SEARCH BY NAME
  4037. IX0 X0+X1
  4038. SB2 B2-B1
  4039. ACH11.1 SA2 ACW1 CHECK COMMAND TYPE
  4040. SX2 X2
  4041. NZ X2,ACH12 IF SYSTEM VERSION
  4042. IX0 X0+X1 BIAS PAST SYSTEM BITS
  4043. SB2 B2-B1
  4044. ACH12 SX6 B2
  4045. SA1 ACW8 ACW8 = MIN(ACW8,X6)
  4046. IX3 X1-X6
  4047. AX3 59
  4048. BX1 X3*X1
  4049. BX6 -X3*X6
  4050. BX6 X1+X6
  4051. SA6 A1
  4052. SB2 X6
  4053. LE B2,ACHECK IF NO WORDS TO RETURN
  4054. RE B2
  4055. RJ ECSPRTY
  4056. ZR X2,ACHECK IF NON-SYSTEM VERSION
  4057. SA1 A0 MASK OUT ACCESS BITS
  4058. MX6 -12
  4059. BX6 -X6*X1
  4060. SA6 A1
  4061. EQ ACHECK
  4062.  
  4063. * SET TO LOCAL SYSTEM
  4064.  
  4065. ACH13 SA1 ACW1 (X1) = PASSED SYSTEM NAME
  4066. MX4 18
  4067. BX1 X4*X1 GET SYSTEM FROM LEFT 18 BITS
  4068. SA4 =XHOMERID
  4069. BX1 X4-X1
  4070. ZR X1,ACH15 PROCESS AS LOCAL SYSTEM
  4071. SA1 DWD1 GET FIRST WORD
  4072. LX1 59-0 RIGHTMOST BIT IS FLAG
  4073. PL X1,ACH10 IF OTHER/OTHER/LOCAL OFF
  4074.  
  4075. * CLEAR NAME / GROUP / ACCOUNT / TYPE
  4076. * CAUSE A SEARCH FOR LOCAL / OTHER / OTHER
  4077.  
  4078. * /--- BLOCK ACHECK 00 000 80/04/30 19.45
  4079. BX6 X6-X6
  4080. SA6 ACW2
  4081. SA6 A6+B1
  4082. SA6 A6+B1
  4083. SA6 A6+B1
  4084. SA6 A6+B1
  4085. SA6 A6+B1
  4086. EQ ACH15
  4087.  
  4088. * RESET LIMITS, GO ONTO NEXT STATE
  4089.  
  4090. ACH14 SA1 ACHC FETCH SAVED LIMITS
  4091. SA2 A1+B1
  4092. BX6 X1
  4093. BX7 X2
  4094. SA6 ACHB SET AS NEW LIMITS
  4095. SA7 A6+B1
  4096. AX4 30 GET NEXT STATE
  4097. BX6 X4
  4098. SA6 ACHA
  4099. EQ ACH1
  4100.  
  4101. ACH15 SX0 DWORDS DIRECTORY LENGTH
  4102. SA1 ECSDIR LOCATION OF DIRECTORY IN ECS
  4103. IX0 X0+X1
  4104. SA4 ACHA
  4105. EQ ACH3 PROCESS AS FOUND SYSTEM
  4106. * /--- BLOCK DIRCHK 00 000 80/04/30 19.46
  4107. DIRCHK SPACE 5,11
  4108. ** DIRCHK - CHECK TO SEE IF THIS USER IS OWNER
  4109. *
  4110. * DECIDES IF NAME IS DIRECTOR AND IF SO SETS A FLAG
  4111. * IN ACW1
  4112. *
  4113. * (ACW1) = 18/SYSTEM,6/0,18/FLAG IF DIR,18/SYS FLAG
  4114. *
  4115. * ENTRY (B1) = 1
  4116. *
  4117. * USES A - 1, 2, 6
  4118. * X - 1, 2, 6
  4119.  
  4120. DIRCHK PS CHECK FOR DIRECTOR
  4121. SA1 DWD5 CHECK FIRST PART OF NAME
  4122. SA2 ACW2
  4123. BX2 X2-X1
  4124. NZ X2,DIRCHK
  4125.  
  4126. SA1 A1+B1 CHECK SECOND PART OF NAME
  4127. SA2 A2+B1
  4128. BX2 X2-X1
  4129. NZ X2,DIRCHK
  4130.  
  4131. SA1 A1+B1 CHECK GROUP
  4132. SA2 A2+B1
  4133. BX2 X2-X1
  4134. NZ X2,DIRCHK
  4135.  
  4136. * NAME/GROUP MATCH, CHECK SYSTEMS
  4137.  
  4138. SA2 DWD11
  4139. NZ X2,DIR1 IF ACCESS LIST DEFINES A SYSTEM
  4140. SA2 HOMERID USE THIS SYSTEMS ID
  4141. DIR1 SA1 ACW1
  4142. MX6 18
  4143. BX6 X1*X6
  4144. BX6 X6-X2
  4145. NZ X6,DIRCHK IF SYSTEMS TO DO NOT MATCH
  4146.  
  4147. * SET THIS USER AS A DIRECTOR
  4148.  
  4149. SX2 B1
  4150. LX2 18
  4151. BX6 X1+X2
  4152. SA6 A1
  4153. EQ DIRCHK EXIT
  4154. * /--- BLOCK STATE 00 000 79/09/04 17.31
  4155. STATE SPACE 5,11
  4156. ** STATE - STATE TABLES TO DEFINE NEXT SEARCH.
  4157. *
  4158. * THESE CONSTANTS DEFINE WHAT IS TO BE SEARCHED
  4159. * FOR AND WHERE TO GO APON COMPLETION OF THE SEACH
  4160. * THE RESULTS OF THE SEARCH DETERMINE WHERE TO GO
  4161. * RESUME PROCESSING. IF THE STORED CONSTANT IS
  4162. * NEGITIVE THEN THE LOCATION IS THE ADDRESS OF THE
  4163. * NEXT STATE TABLE. THE NON-TERMINAL STATES CONTAIN
  4164. * INFORMATION ABOUT THE NEXT PHYSICAL TABLE, THIS
  4165. * IS TO ALLOW CALCULATING LENGTH OF THE NEXT TABLE
  4166. * TO SEARCH
  4167.  
  4168. SWPE EQU 0 WORDS /ENTRY
  4169. SFWA EQU 1 ECS FWA OF TABLE
  4170. SLWA EQU 2 LENGTH OF TABLE
  4171. SNWA EQU 3 LENGTH OF NEXT TABLE
  4172. SNWE EQU 4 WORDS / ENTRY OF NEXT TABLE
  4173. SITM EQU 5 ADDRESS OF ITEM TO SEARCH
  4174. SMSK EQU 6 MASK TO USE
  4175. * SECOND WORD OF MASK
  4176. SFS EQU 8
  4177. SNFS EQU 9 NEXT STATE IF NOT FOUND
  4178.  
  4179. * SEARCH FOR SYSTEM
  4180.  
  4181. S1 CON 0 WORDS / ENTRY
  4182. CON 0 ECS FWA
  4183. CON 0 LWA + 1 OF THIS TABLE
  4184. CON 0 LENGTH OF NEXT TABLE
  4185. CON 0 WORDS / ENTRY OF NEXT TABLE
  4186. CON ACW1 SYSTEM NAME
  4187. VFD 18/-0,42/0 MASK FOR FIRST WORD
  4188. VFD 60/0 MASK FOR SECOND WORD
  4189. CON -S2 NEXT STATE IF FOUND
  4190. CON ACH13 SET TO LOCAL SYSTEM
  4191.  
  4192. S2 CON 0 SEARCH TABLE FOR GROUP
  4193. CON 0
  4194. CON 0
  4195. CON 0
  4196. CON 0
  4197. CON ACW4 GROUP NAME
  4198. VFD 1/0,47/-0,12/0
  4199. VFD 60/0
  4200. CON -S4
  4201. CON -S3
  4202.  
  4203. S3 CON 0 SEARCH TABLE FOR ACCOUNTS
  4204. CON 0
  4205. CON 0
  4206. CON 0
  4207. CON 0
  4208. CON ACW5 ACCOUNT NAME
  4209. VFD 1/0,47/-0,12/0
  4210. VFD 60/0
  4211. CON -S7
  4212. CON -S9
  4213.  
  4214. * /--- BLOCK STATE 00 000 80/05/01 11.03
  4215. S4 CON 0 SEARCH FOR NAMES
  4216. CON 0
  4217. CON 0
  4218. CON 0
  4219. CON 0
  4220. CON ACW2 SEARCH FOR NAME
  4221. VFD 60/-0
  4222. VFD 48/-0,12/0
  4223. CON ACH11
  4224. CON -S5
  4225.  
  4226. S5 CON 0 SEARCH FOR USER TYPE FOR GROUP
  4227. CON 0
  4228. CON 0
  4229. CON 0
  4230. CON 0
  4231. CON ACW6 USERS TYPE
  4232. VFD 60/-0
  4233. VFD 48/-0,12/0
  4234. CON ACH11
  4235. CON -S6
  4236.  
  4237. S6 CON 0 SEARCH TABLE FOR OTHER (GROUP)
  4238. CON 0
  4239. CON 0
  4240. CON 0
  4241. CON 0
  4242. CON OTHER2 SEARCH FOR OTHER/GROUP
  4243. VFD 60/-0
  4244. VFD 48/-0,12/0
  4245. CON ACH11
  4246. VFD 30/S3,30/ACH14
  4247.  
  4248. S7 CON 0 SEARCH FOR TYPE OF ACCOUNT
  4249. CON 0
  4250. CON 0
  4251. CON 0
  4252. CON 0
  4253. CON ACW6 USER TYPE
  4254. VFD 60/-0
  4255. VFD 48/-0,12/0
  4256. CON ACH11
  4257. CON -S8
  4258.  
  4259. S8 CON 0 SEARCH FOR OTHER OF ACCOUNT
  4260. CON 0
  4261. CON 0
  4262. CON 0
  4263. CON 0
  4264. CON OTHER2 OTHER
  4265. VFD 60/-0
  4266. VFD 48/-0,12/0
  4267. CON ACH11
  4268. VFD 30/S9,30/ACH14
  4269.  
  4270. S9 CON 0 SEARCH FOR OTHER / OTHER
  4271. CON 0
  4272. CON 0
  4273. CON 0
  4274. CON 0
  4275. CON OTHER OTHER
  4276. VFD 1/0,47/-0,12/0
  4277. VFD 60/0
  4278. CON -S10
  4279. CON ACH8
  4280.  
  4281. S10 CON 0 SEARCH FOR TYPE OF ACCOUNT
  4282. CON 0
  4283. CON 0
  4284. CON 0
  4285. CON 0
  4286. CON ACW6 USER TYPE
  4287. VFD 60/-0
  4288. VFD 48/-0,12/0
  4289. CON ACH11
  4290. CON -S11
  4291.  
  4292. S11 CON 0 SEARCH FOR OTHER OF ACCOUNT
  4293. CON 0
  4294. CON 0
  4295. CON 0
  4296. * /--- BLOCK STATE 00 000 80/05/01 11.03
  4297. CON 0
  4298. CON OTHER2 OTHER
  4299. VFD 60/-0
  4300. VFD 48/-0,12/0
  4301. CON ACH11
  4302. CON ACH8
  4303. * /--- BLOCK STATE 00 000 80/05/01 11.12
  4304.  
  4305. * SEARCH BY LESSON
  4306.  
  4307. S12 CON 0 SEARCH FOR ACCOUNT/LESSON
  4308. CON 0
  4309. CON 0
  4310. CON 0
  4311. CON 0
  4312. CON ACW2 LESSON NAME
  4313. VFD 42/-0,18/0
  4314. VFD 60/-0
  4315. CON ACH11
  4316. CON -S13
  4317.  
  4318. S13 CON 0 SEARCH FOR ACCOUNT/OTHER
  4319. CON 0
  4320. CON 0
  4321. CON 0
  4322. CON 0
  4323. CON ACW6 ACCOUNT / OTHER
  4324. VFD 42/-0,18/0
  4325. VFD 60/-0
  4326. CON ACH11
  4327. CON -S14
  4328.  
  4329. S14 CON 0 SEARCH FOR OTHER/OTHER
  4330. CON 0
  4331. CON 0
  4332. CON 0
  4333. CON 0
  4334. CON AOTHER LESSON OTHER
  4335. VFD 42/-0,18/0
  4336. VFD 60/-0
  4337. CON ACH11
  4338. CON ACH8
  4339. * /--- BLOCK EBCHOP 00 000 79/08/10 10.02
  4340. EBCHOP SPACE 5,11
  4341. ** EBCHOP - ECS BINARY CHOP.
  4342. *
  4343. * PERFORMS A BINARY CHOP IN ECS OF A LIST.
  4344. * ALLOWS PASSING THE LENGTH OF A RECORD. THE
  4345. * SEARCH ALLOWS UP TO A TWO WORD OBJECT TO
  4346. * LOCATE. IT ALSO REQUIRES A TWO WORD MASK.
  4347. * IT RETURNS THE ADDRESS OF THE OBJECT IN ECS IN
  4348. * X0, A0 CONTAINS THE ADDRESS OF THE CELL IN CM
  4349. * WHICH HAS A COPY OF THE LOCATED OBJECT FROM ECS.
  4350. *
  4351. * ENTRY (B1) = 1
  4352. * (B2) = WORDS PER RECORD
  4353. *
  4354. * (X1) = FIRST WORD OF OBJECT TO LOACTE
  4355. * (X2) = SECOND WORD OF OBJECT TO LOCATE
  4356. * (X3) = NUMBER OF LOGICAL RECORDS TO SEARCH
  4357. * (X5) = FWA TO SEARCH FROM
  4358. * (X6) = FIRST WORD OF MASK
  4359. * (X7) = SECOND WORD OF MASK
  4360. *
  4361. * EXIT (X0) = ADDRESS OF LOCATION OF OBJECT IN ECS
  4362. * = -1 IF NOT LOCATED
  4363. * (A0) = ADDRESS OF COPY OF OBJECT IN CM
  4364. *
  4365. * USES A - 0, 1, 2, 4, 6, 7.
  4366. * B - 1, 2, 3.
  4367. * X - 0, 1, 2, 3, 4, 5, 6, 7.
  4368. *
  4369. * CALLED BY ACHECK.
  4370. *
  4371. * USAGE X0 = ECS ADDRESS TO TRANSFER FROM
  4372. * X1 = OBJECT TO LOCATE
  4373. * X2 = LOGICAL RECORD NUMBER
  4374. * X3 = MIDDLE POINTER
  4375. * X4 = MASK
  4376. * X5 = FWA-1 TO SEARCH FROM
  4377. * X6 = BOTTOM POINTER
  4378. * X7 = TOP POINTER
  4379. *
  4380. * B1 = 1
  4381. * B2 = WORDS PER RECORD (1,2)
  4382. *
  4383. * TEMPORARY CM CELLS
  4384. * (OBJECT) = FIRST WORD TO SEARCH FOR
  4385. * (OBJECT2) = SECORD WORD TO SEARCH FOR
  4386. * (MASK) = MASK FOR FIRST WORD TO LOCATE
  4387. * (MASK2) = MASK FOR SECOND WORD TO LOCATE
  4388. * (CMLOC) = HOLD ECS TRANSFERD RECORD
  4389. * (CMLOC2) = SECOND WORD OF ECS TRANSFER
  4390. EJECT
  4391. * /--- BLOCK EBCHOP 00 000 79/08/10 10.02
  4392. EX0 SX0 -1 (X0) = NOT FOUND
  4393.  
  4394. EBCHOP PS ECS BINARY CHOP
  4395.  
  4396. * SET UP CM CELLS
  4397.  
  4398. BX1 X1*X6
  4399. BX2 X2*X7
  4400. SA6 MASK STORE MASK USE TO COMPARE
  4401. SA7 MASK2
  4402. BX4 X6 (X4) = MASK
  4403. BX6 X1 (X1) = OBJECT
  4404. BX7 X2
  4405. SA6 OBJECT STORE OBJECT
  4406. SA7 OBJECT2
  4407.  
  4408. * INITIALIZE LOOP PARAMETERS
  4409.  
  4410. SX6 B0 STARTING RECORD NUMBER (0)
  4411. SA0 CMLOC
  4412. SX7 X3-1 (X7) = NUMBER OF RECORDS - 1
  4413.  
  4414. * MAIN LOOP FOR CHOP
  4415.  
  4416. EX1 IX2 X7-X6
  4417. NG X2,EX0 ENDLOOP; OBJECT NOT FOUND
  4418.  
  4419. * CALCULATE NEXT GUESS X3 = INT((X6+X7)/2)
  4420.  
  4421. IX3 X6+X7
  4422. AX3 1 DIVIDE BY 2
  4423.  
  4424. * COMPUTE NEXT ECS ADDRESS X0=B2*X3+X5
  4425.  
  4426. SX0 B2
  4427. IX0 X3*X0
  4428. IX0 X0+X5 STARTING ECS ADDRESS
  4429.  
  4430. * READ RECORD FROM ECS
  4431.  
  4432. RE B2
  4433. RJ ECSPRTY
  4434. SA2 A0
  4435. BX2 X2*X4 MASK OFF WORD FROM CM
  4436. *
  4437. NG X2,EX4 IF TABLE NEGATIVE
  4438. NG X1,EX3 IF OBJECT NEGATIVE
  4439. EX2 IX4 X2-X1
  4440. PL X4,EX5 IF OBJECT &lt; ECS RECORD
  4441. EX3 SX6 X3+B1 RAISE BOTTOM POINTER
  4442. EQ EX14
  4443.  
  4444. EX4 NG X1,EX2 IF BOTH NEGATIVE
  4445. EQ EX6
  4446.  
  4447. EX5 ZR X4,EX7 IF ECS RECORD = OBJECT
  4448. EX6 SX7 X3-1 LOWER TOP POINTER
  4449. EQ EX14
  4450.  
  4451. EX7 SA4 MASK2 FIRST WORDS MATCH
  4452. SA2 A0+B1 SECOND WORD OF ECS RECORD
  4453. BX2 X2*X4
  4454. SA1 OBJECT2 FETCH SECOND WORD OF OBJECT
  4455.  
  4456. NG X2,EX10 IF TABLE NEGATIVE
  4457. NG X1,EX9 IF OBJECT NEGATIVE
  4458. EX8 IX4 X2-X1
  4459. PL X4,EX11 IF OBJECT2 > ECS2
  4460. EX9 SX6 X3+B1 RAISE BOTTOM
  4461. EQ EX14
  4462.  
  4463. * /--- BLOCK EBCHOP 00 000 79/08/10 10.02
  4464. EX10 NG X1,EX8 IF BOTH NEGATIVE
  4465. EQ EX12
  4466.  
  4467. EX11 ZR X4,EX13 IF ECS2 = OBJECT2
  4468. EX12 SX7 X3-1 LOWER TOP
  4469. EQ EX14
  4470.  
  4471. EX13 EQ EBCHOP FOUND OBJECT, EXIT
  4472.  
  4473. EX14 SA1 OBJECT RESTORE OBJECT
  4474. SA4 MASK RESTORE MASK
  4475. EQ EX1
  4476. EJECT
  4477. * /--- BLOCK GBA 00 000 80/04/30 17.18
  4478. GBA SPACE 5,11
  4479. ** GBA - GET JUDGE BUFFER ADDRESS
  4480. *
  4481. * ENTRY - (TJDBUF1) = JUDGE BUFFER NUMBER
  4482. *
  4483. * EXIT - (X0) = ADDRESS OF JUDGE BUFFER
  4484. * (X1) = JUDGE BUFFER NUMBER
  4485.  
  4486.  
  4487. GBA PS
  4488. SA1 TJDBUF1
  4489. SX1 X1
  4490. NG X1,"CRASH"
  4491. ZR X1,"CRASH"
  4492. SX0 JBXSAVE (X0) = LENGTH OF EACH BUFFER
  4493. SX2 X1-1
  4494. IX0 X2*X0
  4495. SA2 XJBANKS
  4496. IX0 X2+X0
  4497. EQ GBA
  4498. * /--- BLOCK STORAGE 00 000 80/05/01 11.08
  4499.  
  4500. * EQU-ED TO LOCATIONS IN USERS STUDENT BANK
  4501.  
  4502. ACW1 EQU TBINTSV 42/SYSTEM NAME
  4503. 18/ZERO IF USER BITS ONLY
  4504. ACW2 EQU TBINTSV+1 NAME TO LOOK UP
  4505. ACW3 EQU TBINTSV+2 NAME CONTINUED
  4506. ACW4 EQU TBINTSV+3 GROUP
  4507. ACW5 EQU TBINTSV+4 ACCOUNT
  4508. ACW6 EQU TBINTSV+5 USER TYPE / OTHER ACCOUNT
  4509. ACW7 EQU TBINTSV+6 SECOND WORD OF USER TYPE
  4510. ACW8 EQU TBINTSV+7 NUMBER OF WORDS TO RETURN
  4511. ACACCT EQU TBINTSV+8 ACCOUNT NAME
  4512. ACFILE EQU TBINTSV+9 FILE NAME
  4513. ACBLOCK EQU TBINTSV+10 BLOCK NAME
  4514. ACTYPE EQU TBINTSV+11 BLOCK TYPE (11)
  4515.  
  4516. ACW12 EQU TBINTSV+12 NUMBER OF ACCESS LESSON
  4517. ACW14 EQU TBINTSV+13 GETVAR OF COUNT OF RETURN WORDS
  4518. ACW15 EQU TBINTSV+14 FWA TO RETURN ACCESS IN
  4519. ACW16 EQU TBINTSV+15 SEARCH TYPE
  4520.  
  4521. * DUMMY USER TYPES (ORDER DEPENDENT)
  4522.  
  4523. AOTHER VFD 60/0
  4524. OTHER VFD 6/0,54/0L'OTHER
  4525. VFD 60/0
  4526. OTHER2 VFD 12/0,48/0L'OTHER
  4527. VFD 60/0
  4528. AUTHOR VFD 6/0,54/0L'AUTHORS
  4529. VFD 60/0
  4530. INSTRUC VFD 6/0,54/0L'INSTRUCT
  4531. INSTRU1 VFD 60/0LORS
  4532. STUDENT VFD 6/0,54/0L'STUDENTS
  4533. VFD 60/0
  4534. MULTIP VFD 6/0,54/0L'MULTIPLE
  4535. MULTIP1 VFD 60/0LS
  4536.  
  4537. * DISK DIRECTORY DEFINES AND TEMPORARY INFO CELLS
  4538.  
  4539. DWORDS EQU 10
  4540. DWD0 OVDATA 1
  4541. DWD1 OVDATA 1
  4542. DWD2 OVDATA 1
  4543. DWD3 OVDATA 1
  4544. DWD4 OVDATA 1
  4545. DWD5 OVDATA 1
  4546. DWD6 OVDATA 1
  4547. DWD7 OVDATA 1
  4548. DWD8 OVDATA 1
  4549. DWD9 OVDATA 1
  4550. DWD10 OVDATA 1
  4551. DWD11 OVDATA 4
  4552. ECSDIR OVDATA 1
  4553.  
  4554. CMLOC OVDATA 10B FIRST WORD OF OBJECT (2 WORDS)
  4555. MASK OVDATA 1 MASK FOR OBJECT
  4556. MASK2 OVDATA 7
  4557. OBJECT OVDATA 1 OBJECT TO LOCATE
  4558. OBJECT2 OVDATA 7
  4559.  
  4560. * TEMP CELLS FOR STATE TABLES
  4561.  
  4562. ACHA OVDATA 1 INITIAL STATE
  4563. ACHB OVDATA 2 LOWER/UPPER BOUND (2 WORDS)
  4564. ACHC OVDATA 2 LOWER/UPPER BOUND (2 WORDS)
  4565.  
  4566. ENDOV
  4567. * /--- BLOCK REPLACE DF 00 000 78/02/11 22.50
  4568. TITLE -REPLACE- COMMAND EXECUTION
  4569.  
  4570. COMPROV OVRLAY
  4571.  
  4572.  
  4573. *** -REPLACE- COMMAND
  4574. *
  4575. * FORMAT--
  4576. * REPLACE IN,LTH,OUT,LTH,TABLE,LTH,CHARS,MODE
  4577. *
  4578. * IN INPUT BUFFER, *LTH* WORDS
  4579. * OUT OUTPUT BUFFER, *LTH* WORDS
  4580. * TABLE REPLACEMENT TABLE, *LTH* WORDS
  4581. * LTH MUST BE ODD; LAST WORD IS SET
  4582. * TO ZERO. TABLE CONTAINS PAIRS--
  4583. * 60/0LOLDNAME,54/0LNEWNAME,6/NEWLTH
  4584. * CHARS ON RETURN, SET TO CHAR COUNT IN OUTPUT
  4585. * MODE -1 FOR EXPRESSION
  4586. * 0 FOR WRITE
  4587. * +N FOR WRITE PRECEDED BY *N* EXPRESSIONS
  4588. *
  4589. * ON EXIT--
  4590. * CHARS NUMBER OF CHARACTERS IN OUTPUT BUFFER
  4591. * (REST OF LAST WORD IS ZERO, FOLLOWING
  4592. * WORDS LEFT ALONE)
  4593. * ZRETURN = 0 IF NO CHANGE
  4594. * =-1 IF SOMETHING CHANGED
  4595. *
  4596. SPACE 3
  4597. ** REGISTER USAGE
  4598. *
  4599. * A0 CHANGE FLAG
  4600. * X0 CHARACTER MASK
  4601. *
  4602. * A1 INPUT POINTER
  4603. * X1 INPUT WORD
  4604. * B1 INPUT CHARACTER COUNT
  4605. *
  4606. * X2 INPUT CHARACTER ASSEMBLY
  4607. * B2 CHARACTER ASSEMBLY CODE
  4608. *
  4609. * X3 SCRATCH
  4610. * B3 SCRATCH
  4611. *
  4612. * X4 NAME ASSEMBLY
  4613. * B4 NAME ASSEMBLY COUNTER
  4614. *
  4615. * X5 MODE
  4616. * B5 FONT FLAG
  4617. *
  4618. * B6 SCRATCH
  4619. * X6 TEMPORARY
  4620. *
  4621. * A7 OUTPUT POINTER
  4622. * X7 OUTPUT WORD ASSEMBLY
  4623. * B7 OUTPUT CHARACTER COUNT
  4624. *
  4625. SPACE 3
  4626. XW1 EQU TBINTSV
  4627. XW2 EQU TBINTSV+1
  4628. TABLTH EQU TBINTSV+2
  4629. ACOUNT EQU TBINTSV+3
  4630. RMODE EQU TBINTSV+4
  4631. AOUT EQU TBINTSV+5
  4632. AIN EQU TBINTSV+6
  4633. INLTH EQU TBINTSV+7
  4634. OUTLTH EQU TBINTSV+8
  4635. ATABLE EQU TBINTSV+9
  4636. BREGS EQU TBINTSV+10
  4637. * /--- BLOCK MACROS 00 000 78/02/10 11.32
  4638. GETCHAR MACRO REG GET 6 BITS, RIGHT JUSTIFIED
  4639. LOCAL AA,BB
  4640. NZ B1,AA
  4641. SA1 A1+1
  4642. SB1 10
  4643. AA LX1 6
  4644. B_REG -X0*X1
  4645. SB1 B1-1
  4646. SX3 REG-FONT
  4647. NZ X3,BB
  4648. SB5 B5-1
  4649. SB5 -B5 FLIP FONT FLAG
  4650. BB BSS 0
  4651. ENDM
  4652.  
  4653. PUTCHAR MACRO REG PUT 6 BITS, RIGHT JUSTIFIED
  4654. LOCAL AA
  4655. NZ B7,AA
  4656. SA7 A7+1
  4657. SB7 10
  4658. SX7 0
  4659. AA LX7 6
  4660. BX7 X7+REG
  4661. SB7 B7-1
  4662. ENDM
  4663.  
  4664. * /--- BLOCK MACROS 00 000 78/02/10 08.35
  4665. GETCODE MACRO REG,BREG GET CHARACTER RIGHT JUSTIFIED
  4666. LOCAL AA,BB
  4667. GETCHAR REG
  4668. S_BREG 1
  4669. BX6 X2
  4670. EQ BB
  4671. AA L_REG 6
  4672. S_BREG BREG+1
  4673. GETCHAR X6
  4674. B_REG REG+X6
  4675. BB SX3 X6-KUP
  4676. ZR X3,AA
  4677. SX3 X6-ACCESS
  4678. ZR X3,AA
  4679. ENDM
  4680.  
  4681. PUTCODE MACRO REG,BREG PUT CHARACTER RIGHT JUSTIFIED
  4682. LJUST REG,BREG
  4683. PUTSTR REG,BREG
  4684. ENDM
  4685.  
  4686. PUTSTR MACRO REG,BREG PUT STRING LEFT JUSTIFIED
  4687. LOCAL AA,BB
  4688. AA ZR BREG,BB
  4689. S_BREG BREG-1
  4690. L_REG 6
  4691. BX6 -X0*REG
  4692. PUTCHAR X6
  4693. EQ AA
  4694. BB BSS 0
  4695. ENDM
  4696.  
  4697. LJUST MACRO REG,BREG LEFT JUSTIFY STRING
  4698. SB6 BREG+BREG
  4699. SB6 B6+B6
  4700. SB6 BREG-B6
  4701. SB6 B6+B6
  4702. SB6 B6+60
  4703. L_REG B6
  4704. ENDM
  4705. * /--- BLOCK REPLACE 00 000 78/02/11 00.50
  4706. MX0 2*XCODEL
  4707. BX1 -X0*X5
  4708. AX1 XCMNDL GET LINK TO EXTRA STORAGE
  4709. SA1 X1+B5
  4710. SA2 A1+1
  4711. BX6 X1
  4712. BX7 X2
  4713. SA6 XW1
  4714. SA7 XW2 SAVE EXTRA STORAGE WORDS
  4715. BX5 X2
  4716. NGETVAR GET ARGUMENT 6 (TABLE LTH)
  4717. BX6 X1
  4718. SA6 TABLTH
  4719. LX6 59
  4720. PL X6,=XERXVAL MUST BE ODD
  4721. SA1 XW2
  4722. LX1 XCODEL
  4723. BX5 X1
  4724. NGETVAR GET ARG. 7 (CHAR COUNT RETURN)
  4725. SX6 A1
  4726. SA6 ACOUNT SAVE ADDRESS
  4727. SA1 XW2
  4728. LX1 2*XCODEL
  4729. BX5 X1
  4730. NGETVAR GET ARG. 8 (MODE)
  4731. BX6 X1
  4732. SA6 RMODE
  4733. SA1 XW1
  4734. BX5 X1
  4735. NGETVAR GET ARG. 3 (OUT ADDRESS)
  4736. SX6 A1
  4737. SA6 AOUT SAVE ADDRESS
  4738. SA1 XW1
  4739. LX1 XCODEL
  4740. BX5 X1
  4741. NGETVAR GET ARG. 4 (OUT LENGTH)
  4742. BX6 X1
  4743. SA6 OUTLTH
  4744. SA1 XW1
  4745. LX1 2*XCODEL
  4746. BX5 X1
  4747. NGETVAR GET ARG. 5 (TABLE ADDRESS)
  4748. SX6 A1
  4749. SA6 ATABLE SAVE ADDRESS
  4750. SA5 A5 RESTORE COMMAND WORD
  4751. NGETVAR GET ARG. 1 (IN ADDRESS)
  4752. SX6 A1
  4753. SA6 AIN SAVE ADDRESS
  4754. SA5 A5
  4755. LX5 XCODEL
  4756. NGETVAR GET ARG. 2 (IN LENGTH)
  4757. BX6 X1
  4758. SA6 INLTH
  4759. * /--- BLOCK REPLACE 00 000 78/02/11 01.14
  4760. SA1 INLTH
  4761. SA2 AIN
  4762. SA0 X2 SET UP FOR *BOUNDS*
  4763. CALL BOUNDS
  4764. MX0 -6
  4765. SA1 B1-1 PICK UP LAST WORD
  4766. BX6 X0*X1 GUARANTEE AN EOL
  4767. SA6 A1 STORE IT BACK
  4768. SA1 OUTLTH
  4769. SA2 AOUT
  4770. SA3 INLTH
  4771. IX3 X3-X1 CHECK OUTLTH>INLTH
  4772. PL X3,=XERXBADL IF NOT
  4773. SA0 X2
  4774. CALL BOUNDS
  4775. SA1 TABLTH
  4776. SA2 ATABLE
  4777. SA0 X2
  4778. CALL BOUNDS
  4779. MX6 0
  4780. SA6 B1-1 CLEAR LAST WORD OF TABLE
  4781. MX0 -18
  4782. SX6 B5
  4783. BX6 -X0*X6 18 BIT LIMIT
  4784. SX1 B7
  4785. BX1 -X0*X1
  4786. LX6 18
  4787. BX6 X1+X6 MERGE
  4788. SA6 BREGS PRESERVE B5, B7
  4789. SA1 RMODE
  4790. BX5 X1 SET MODE
  4791. SB5 B0 CLEAR FONT
  4792. SA1 AOUT
  4793. SA1 X1-1 GET WORD PRECEDING OUT BUFFER
  4794. BX7 X1
  4795. SA7 A1 INIT OUTPUT POINTER
  4796. SA1 AIN
  4797. SA1 X1-1 INIT INPUT POINTER
  4798. SA0 B0
  4799. SB1 B0
  4800. MX7 0 CLEAR OUTPUT ASSEMBLY
  4801. SB7 10 INIT CHAR COUNTERS, CHANGE FLAG
  4802. MX0 -6 INIT MASK
  4803. ZR X5,WLOOP
  4804. EQ NLOOP
  4805. * /--- BLOCK REPLACE 00 000 78/02/11 01.49
  4806. NLP0 PUTCODE X2,B2
  4807. NLOOP GETCODE X2,B2
  4808. NLP0.5 ZR X2,EOL
  4809. BX3 -X0*X2
  4810. SX3 X3-1RZ-1
  4811. PL X3,NLP2
  4812. BX4 X2 ASSEMBLE NAME IN X4
  4813. SB4 B2
  4814. NLP1 GETCODE X2,B2
  4815. ZR X2,NLP1.2
  4816. BX3 -X0*X2
  4817. SX3 X3-1RZ-1 CHECK LETTER
  4818. NG X3,NLP1.1
  4819. SX3 X2-2R'6 SPECIAL CASE
  4820. ZR X3,NLP1.1
  4821. SX3 X2-1R. ANOTHER ONE
  4822. ZR X3,NLP1.1
  4823. SX3 X2-1R9-1 DIGITS ONLY BY THEMSELVES
  4824. PL X3,NLP1.2
  4825. NLP1.1 SB4 B4+B2
  4826. SB6 B4-10-1
  4827. PL B6,NLP1.5
  4828. SB6 B2+B2
  4829. SB6 B2+B6
  4830. SB6 B6+B6
  4831. LX4 B6
  4832. BX4 X4+X2
  4833. EQ NLP1
  4834. NLP1.2 LJUST X4,B4
  4835. SA3 ATABLE FETCH TABLE ADDRESS
  4836. SA3 X3-2 INIT SEARCH POINTER
  4837. NLP1.3 SA3 A3+2
  4838. ZR X3,NLP1.4 END TEST
  4839. BX3 X3-X4
  4840. NZ X3,NLP1.3 (NOTE -0 IS NOT POSSIBLE)
  4841. SA3 A3+1 GET NEW ENTRY
  4842. BX4 X0*X3 REMOVE LENGTH
  4843. BX3 -X0*X3
  4844. SB4 X3 SET LENGTH
  4845. SA0 -1 SET CHANGE FLAG
  4846. NLP1.4 PUTSTR X4,B4
  4847. EQ NLP0.5
  4848. NLP1.5 SB4 B4-B2
  4849. EQ NLP1.4
  4850.  
  4851. NLP2 SX3 X2-2R',
  4852. ZR X3,NLP2.1
  4853. SX3 X2-2R'7
  4854. NZ X3,NLP3
  4855. NLP2.1 BX4 X2 SAVE QUOTE
  4856. NLP2.2 PUTCODE X2,B2
  4857. GETCODE X2,B2
  4858. ZR X2,EOL
  4859. BX3 X2-X4 SEE IF MATCHING QUOTE
  4860. NZ X3,NLP2.2 IF NOT
  4861. EQ NLP0
  4862. * /--- BLOCK REPLACE 00 000 78/02/11 01.31
  4863.  
  4864. NLP3 SX3 X2-1R,
  4865. ZR X3,NLP3.1
  4866. SX3 X2-1R;
  4867. ZR X3,NLP3.1
  4868. SX3 X2-2R^,
  4869. NZ X3,NLP4
  4870. SB5 0 CLEAR FONT FLAG
  4871. NLP3.1 NG X5,NLP0 IF NOT IN WRITEC MODE
  4872. ZR X5,NLP0
  4873. SX5 X5-1 DECREMENT COUNT OF DELIMS LEFT
  4874. ZR X5,WLP0 IF SWITCHING TO WRITE MODE
  4875. EQ NLP0
  4876.  
  4877. NLP4 SX3 X2-2R^1 CHECK FOR CLOSE EMBED
  4878. NZ X3,NLP0
  4879. NZ X5,NLP0 IF NOT IN WRITE MODE
  4880. NZ B5,NLP0 IF FONTED
  4881. * EQ WLP0 FALL THROUGH INTO -WRITE- LOOP
  4882. SPACE 3,10
  4883. WLP0 PUTCODE X2,B2
  4884. WLOOP GETCODE X2,B2
  4885. ZR X2,EOL
  4886. SX3 X2-2R^,
  4887. NZ X3,WLP2
  4888. SB5 0 CLEAR FONT
  4889. EQ WLP0
  4890.  
  4891. WLP2 SX3 X2-2R^0 CHECK FOR OPEN EMBED
  4892. NZ X3,WLP0
  4893. EQ NLP0 TO PROCESSING LOOP
  4894. SPACE 3,10
  4895. EOL SB6 B7+B7
  4896. SB6 B6+B7
  4897. SB6 B6+B6
  4898. LX7 B6 LEFT JUSTIFY LAST WORD
  4899. SA7 A7+1 STORE IT
  4900. SX1 10
  4901. SA2 AOUT
  4902. SX7 A7
  4903. IX7 X7-X2 COMPUTE WORD COUNT
  4904. IX7 X7*X1 COMPUTE CHAR COUNT
  4905. SX1 B7-10
  4906. IX7 X7-X1 FINAL CHAR COUNT
  4907. SA1 ACOUNT FETCH COUNTER ADDRESS
  4908. SA7 X1
  4909. SX6 A0
  4910. SA6 TRETURN SET *ZRETURN*
  4911. SA1 BREGS
  4912. SB7 X1
  4913. AX1 18
  4914. SB5 X1 RESTORE B REGISTERS
  4915. EQ PROCESS
  4916.  
  4917. ENDOV
  4918. * /--- BLOCK END 00 000 80/01/25 01.20
  4919. *
  4920. *
  4921. OVTABLE
  4922. *
  4923. *
  4924. END EXEC5$
plato.source/plaopl/exec5.txt ยท Last modified: 2021/02/06 16:22 by 127.0.0.1