CDC Community

๐Ÿ”น Historical Conservation ๐Ÿ”น

User Tools

Site Tools


plato.source:plaopl:exec1

Table of Contents

EXEC1

Table Of Contents

  • [00005] EXEC1 โ€“ EXECUTION-INTERPRETER
  • [00016] PLATO EXECUTION REGISTER CONVENTIONS
  • [00043] ENTRY POINTS
  • [00075] EXTERNAL SYMBOL DEFINITIONS
  • [00234] JUMP TABLE
  • [00336] RETPROC โ€“ RELOAD UNIT AFTER I/O COMMAND
  • [00362] CKPROC โ€“ RETURN FROM INTERRUPT COMMANDS
  • [00428] RETPRO โ€“ RELOAD UNIT AND CONTINUE
  • [00463] PROCESS โ€“ CHECK IF TIMESLICE OVER
  • [00480] PROC โ€“ EXECUTE NEXT COMMAND
  • [00535] PROCO โ€“ RETURN FROM OUTPUT COMMANDS
  • [00595] PROCOV โ€“ LOAD COMMAND OVERLAY AND EXECUTE
  • [00621] XXSLICE โ€“ END TIME SLICE
  • [00643] PRE-CHECK FOR OUTPUT COMMANDS
  • [00669] COMMAND JUMP TABLE
  • [00712] SECONDARY BRANCHING
  • [00876] GENERAL TWO AND MULTI-VARIABLE PROCESSORS
  • [00980] CHKSET โ€“ SET RECORD CHECKPOINTING STATUS
  • [01007] CHKDEF โ€“ REVERT TO DEFAULT CHECKPT STATUS
  • [01041] WHERE, WHERE(F)
  • [01124] UNIT
  • [01307] WRITE AND CALC
  • [01336] -CUNIT-
  • [01393] JLPACK
  • [01408] UNJOIN
  • [01446] STORE (AND STOREU)
  • [01627] ARROW AND ARROW(F)
  • [01898] JARROW
  • [01990] ENDARROW
  • [02007] CIA - CHECK INHIBIT ARETURN.
  • [02038] EAE - END ARROW EXECUTION.
  • [02076] -LONG-
  • [02152] -LOCK-
  • [02171] CALCC AND CALCS
  • [02302] ERASE
  • [02441] PLOT AND CHAR
  • [02496] -END- -MODE-
  • [02557] INHIBIT
  • [02594] STOREA
  • [02648] SHOWA
  • [03097] -TEXT- COMMAND
  • [03363] TXMIN - INIT FOR OUTPUT.
  • [03382] TXMOUT - COMPLETE OUTPUT.
  • [03510] BOUNDS CHECKERS
  • [03634] JUDGE AND JUDGE*
  • [03795] LANG
  • [03853] NEXTNOW
  • [03886] KEY BRANCHING COMMANDS
  • [04045] ANSWERC/WRONGC
  • [04289] PLATO PROGRAMMABLE TERMINAL COMMANDS
  • [04354] LIBCALL/LIBRET EXECUTION.
  • [04369] LOADMX - LOAD ORIENTAL MODULE TO TERMINAL.
  • [04370] LOADMX - LOAD ORIENTAL MODULE INTO TERMINAL.
  • [04519] SEND EXT CODES TO CLIENT SOFTWARE
  • [04554] MACRO ROUTINES

Source Code

EXEC1.txt
  1. EXEC1
  2. * /--- FILE TYPE = E
  3. * /--- BLOCK EXEC1 00 000 77/08/24 16.02
  4. IDENT EXEC1
  5. TITLE EXEC1 -- EXECUTION-INTERPRETER
  6. *
  7. * THIS IS THE DRIVER FOR EXECUTION OF ALL
  8. * TUTOR COMMANDS.
  9. *
  10. *
  11. * GET COMMON SYMBOL TABLE
  12. *
  13. CST
  14. *
  15. *
  16. TITLE PLATO EXECUTION REGISTER CONVENTIONS
  17. *
  18. * THE FOLLOWING REGISTERS ARE RESERVED DURING THIS
  19. * PROGRAM. THEY MUST BE SAVED AND RESTORED IF ANY
  20. * SUBPROGRAM USES THEM.
  21. *
  22. * A5 - ADDRESS OF COMMAND (X5 HOLDS COMMAND)
  23. * B4 - BASE ADDRESS OF STUDENT VARIABLES (V0)
  24. * B5 - BASE ADDRESS OF EXTRA STORAGE
  25. * B6 - BASE ADDRESS OF COMMON VARIABLES
  26. * B7 - STUDENT CONTINGENCY TYPE CODE
  27. *
  28. *
  29. * NCTYPE HOLDS CONTINGENCY (AS WELL AS B7)
  30. *
  31. * 0 = UNIT-C
  32. * 1 = ARROW-C
  33. * 2 = JUDGE-C
  34. * 3 = ANS-C
  35. * 4 = SEARCH-C
  36. * 5 = TERM FOUND-C
  37. * 6 = NEXT-NOW-C
  38. * 7 = ALL-OK-C
  39. * 8 = ARROW OK-C
  40. * 9 = INITIAL LESSON ENTRY-C
  41. *
  42. * /--- BLOCK ENTRY 00 000 79/02/09 22.12
  43. TITLE ENTRY POINTS
  44. *
  45. *
  46. ENTRY BOUNDS,PROCESS,PROCO,PROC,GETN
  47. ENTRY VARCNT,GETCODX,ILOC
  48. ENTRY VARADD,XDATA,YDATA,EXECSAV
  49. ENTRY CUNIT,GETTAG
  50. ENTRY GET2
  51. ENTRY GETN
  52. ENTRY GET2F
  53. ENTRY XDATA
  54. ENTRY YDATA
  55. ENTRY DOC=
  56. ENTRY DO=
  57. ENTRY JOINC=
  58. ENTRY DOR=
  59. ENTRY JOINR=
  60.  
  61. * ENTRY POINTS NEED BY WRITE STATEMENT
  62.  
  63. ENTRY WRITE5=
  64. ENTRY WRITE6=
  65. *
  66. ENTRY ARGS=,STORE=,ANSV=,WRONGV=,COMPUT=
  67. ENTRY TOUCHW=
  68. *
  69. ENTRY WRONG=,WRONGC= USED IN FILES ANSW1
  70. ENTRY WRONGA= USED IN ANSW1
  71. ENTRY MISCON= IN FILE ANS1
  72. *
  73. *
  74. * /--- BLOCK EXTERNAL 00 000 79/01/20 13.11
  75. TITLE EXTERNAL SYMBOL DEFINITIONS
  76. *
  77. EXT EXCHNX
  78. EXT JOINX,JOINCX,ARGSX,JUMPXX,JUMPXC
  79. EXT IEUENDX
  80. EXT GOTOX,GOTOCX,DOX,DOLX,DOFX,DOFLX
  81. EXT POSTCMS,TOOMUCH
  82. EXT ERXUNUS,ERXCNUM,ERXDFIN,ERXBADL,ERXPOS
  83. EXT ERXSTN,ERXJOIN,ERXOVRT,ERXMXLC
  84. EXT ERXINDL
  85. EXT FINDX,FINDAX,TSTBINX
  86. EXT BLOCKX,ADD1X,SUB1X
  87. EXT CODOUTX,COMMX,SCOMMX,TABX
  88. EXT COPYX,JKEYX,DATEX,CLOCKX
  89. * EXT PLAYX,MIKEX,EXCHANX,CONDENX,DISKX
  90. EXT PLAYX,MIKEX,EXCHANX,CONDENX
  91. EXT ENABLEX,DISABLX
  92. EXT DELAYX,AFONTX
  93. EXT CHECKX,NAMEX,GROUPX,DAYX,ZEROX,ZEROXX
  94. EXT RESTX,ITOAX,EDITX
  95. EXT BUMPX,CODEX
  96. EXT SYSLESX,CONTROX (EXEC2)
  97. EXT ERROROF,RETRNX,RETRNZ
  98. EXT OKWORDX,NOWORDX,CPULIMX
  99. EXT MODESEX,BITSOUX,ZFILLX,SIGNIX
  100. EXT ASCIIX
  101. EXT LOGICX,STOPCHK,CCLRXX
  102. EXT GETCX
  103. EXT PAUSEX,PAUSEH
  104. EXT COLLCTX (LOGICX)
  105. EXT DRAWX,RDRAWX,GDRAWX (EXEC2)
  106. EXT SETX
  107. EXT TWRTCX *** NEW -WRITEC- COMMAND
  108. EXT WRSOUT WRITE (KEYSIN)
  109. EXT MEMOUT LOAD MEMORY (KEYSIN)
  110. EXT ARRPLT PLOT SUPER BIG AND NICE ARROW (KEYSIN)
  111. EXT TUERASE SIZED ERASE (LINWRT)
  112. EXT FAKEPLT RESET X AND Y (KEYSIN)
  113. EXT FIRSTXY GET STARTING ARROW X AND Y (KEYSIN)
  114. EXT XYFIX UPDATE X-Y AND SAVE FOR ANS-C (TUTOUT)
  115. EXT WIPE ERASE ENTIRE ANSWER (KEYSIN)
  116. EXT LWIPE LARGE CHARS ERASE
  117. EXT SIZEX,ROTATEX (LINWRT)
  118. EXT SIMPLOT SIMULATE PLOTTING (SIMPLOT)
  119. *
  120. EXT STORAGX
  121. EXT CHARSET (MICROX)
  122. EXT CHARTST (MICROX)
  123. EXT RQPRINX
  124. EXT CONDRQX
  125. EXT OTOAX
  126. EXT CLEANX
  127. * /--- BLOCK EXTERNAL 00 000 79/01/20 13.23
  128. EXT SYSLOX,AREAX,READSEX
  129. EXT PACKRX
  130. EXT OUTDATX,OUTDATL,SCOREX,LSNX,LSNCX,STLSTAT
  131. EXT OUTDATT
  132. EXT READDX
  133. EXT GETCHRX
  134. EXT REFONTX (IOPUT)
  135. EXT GETUNIT,UNITGOB (GETUNIT)
  136. EXT JOUTX
  137. EXT LINWRT LINE MODE OUTPUT (LINWRT)
  138. EXT RCTOXY USED BY TOUCH AND OTHERS (ARROW)
  139. EXT READRX,RDRINF (DATAX)
  140. EXT ATTACHX,DETACHX (FILEX)
  141. EXT DATAINX,DATOUTX (FILEX)
  142. EXT GETLINX,SETLINX (FILEX)
  143. EXT IOSPECX (FILEX)
  144. EXT MATCHX (ANSWER)
  145. EXT CLOSEX (ANSWER)
  146. EXT SPECX (ANSWER)
  147. EXT EXACTX EXACT STRING MATCH (ANSWER)
  148. EXT ANSXX (ANSWER)
  149. EXT ANSDOS (ANSWER)
  150. EXT WRONG (ANSWER)
  151. EXT WRONGS (ANSWER)
  152. EXT ANSVX (ANSWER)
  153. EXT PANSKEY (ANSWER)
  154. EXT ANSKEYX (ANSWER)
  155. EXT CNCEPTX CONCEPT JUDGER (ANSWER)
  156. EXT LOADAX (ANSWER)
  157. EXT WRONGVX (ANSWER)
  158. EXT OPENX (ANSWER)
  159. EXT STORENX STORE NUMERIC (ANSWER)
  160. EXT GETWDX,GETMKX,COMPX,GETLOCX (ANSWER)
  161. EXT EXACTVX (ANSWER)
  162. EXT EXACTCX CONDITIONAL EXACT
  163. EXT OKX (ANSWER)
  164. EXT ANSEND (ANSWER)
  165. EXT ANSMARK (ANSWER)
  166. EXT JOVER (ANSWER)
  167. *
  168. EXT SHOW SHOW SUBROUTINE (EXEC2)
  169. EXT SHOWT SHOWT SUBROUTINE
  170. EXT SHOWZ SHOWZ SUBROUTINE
  171. *
  172. EXT FGETVAR VARIABLE EVALUATION ROUTINE (GETVAR)
  173. EXT NGETVAR INTEGER GETVAR ROUTINE (GETVAR)
  174. *
  175. EXT ECSPRTY SYSTEM ECS PARITY ROUTINE (ECSPRT)
  176. EXT EXIT EXIT FROM EXECUTION (LOGIC)
  177. EXT PJUDGOO INITIATE JUDGING (LOGIC)
  178. EXT OUTFLOW,FINISH
  179. EXT MOVEX MOVE COMMAND (EXEC3)
  180. EXT TRANSX TRANSFR COMMAND (EXEC3)
  181. EXT KERMITX KERMIT PROTOCOL (EXEC3)
  182. EXT JMPOUTX JUMPOUT (TUTORX)
  183. EXT FEDITX FILEDIT (TUTORX)
  184. EXT FONTX FONT (EXEC3)
  185. EXT STORAGX STORAGE (TUTORX)
  186. EXT SIGNINX SIGNIN (TUTORX)
  187. EXT CONDENX CONDENS (TUTORX)
  188. EXT EXCHANX EXCHANGE (TUTORX)
  189. EXT CCLEARX CCLEAR (TUTORX)
  190. * /--- BLOCK EXTERNAL 00 000 78/12/18 21.19
  191. *
  192. EXT SETRX SETRESV DATAX
  193. *
  194. * NEW DISK SYSTEM COMMANDS IN FILE IOPUT
  195. *
  196. EXT SETPACX SET PACK NAME
  197. EXT SETFILX SET FILE INFO WORD
  198. EXT ATTCHPX,DETCHPX ATTACH, DETACH FILE
  199. EXT ATTFX,DETFX ATTACHF,DETACHF
  200. EXT READFX,WRITEFX READF/WRITEF
  201. EXT RENAMFX RENAME FILE
  202. EXT RETYPFX RETYPE FILE
  203. EXT CREATEX,DESTROX CREATE, DESTROY FILE
  204. EXT DREADX,DWRITEX DISK I/O (RELATIVE)
  205. EXT DINX,DOUTX,DSTATX
  206. EXT DISKIX,DISKOX DISK I/O BY SECTORS (ABSOLUTE)
  207. EXT DSKREAX,DSKWRIX DISK I/O BY SECTORS (RELATIVE)
  208. * EXT DATASEX DATASET
  209. EXT ATTCHX,DETCHX ATTACH/DETACH FILES
  210. *
  211. EXT MOUTX0 WRITE COMMAND
  212. EXT MOUTIT WRITE COMMAND
  213. EXT MOUTX WRITE COMMAND
  214. EXT MOUTMX WRITE COMMAND
  215. EXT EWRITE WRITE COMMAND
  216. EXT EWRITEX WRITE COMMAND
  217. EXT OFFEBX WRITE COMMAND
  218. EXT NEXACTX NEW EXACTC IN ANSWER
  219. *
  220. EXT STEPX
  221. EXT RESIGNX IN FILE LCOMND
  222. EXT OUTACC IN MAIN (FOR USE BY -EXT-)
  223. *
  224. EXT MESSAGX
  225. *
  226. EXT RETARGX NEW -RETURN- COMMAND
  227. EXT DORX,JOINRX PSEUDO COMMANDS FOR RARGS
  228. *
  229. EXT ANSAXXX (ANSWERA)
  230. EXT COLORXX (EXEC7)
  231. EXT TWINDOW (GETVAR)
  232. *
  233. * /--- BLOCK JUMP MACRO 00 000 79/03/21 21.25
  234. TITLE JUMP TABLE
  235. *
  236. * 'FOR COMMANDS WITH ONLY ONE BRANCH, THE BRANCH
  237. * IS EXPLICITLY GIVEN IN THE BOTTOM 18 BITS OF THE
  238. * TABLE ENTRY. 'IF BRANCHES DIFFER WITH CONTINGENCY,
  239. * THE BOTTOM 18 BITS POINT TO A SECONDARY BRANCH
  240. * TABLE. 'SEE BELOW FOR EXPLANATIONS REGARDING
  241. * THE JUMPOV MACRO.
  242. *
  243. JUMP MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L
  244. N1 MICRO 1,1, CONTG
  245. N2 MICRO 2,1, CONTG
  246. N3 MICRO 3,1, CONTG
  247. N4 MICRO 4,1, CONTG
  248. N5 MICRO 5,1, CONTG
  249. VFD 1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2
  250. NN SET NN+1
  251. ENDM
  252. *
  253. * JUMP1 AND ARG1 PERTAIN TO CONDENSE ROUTINE
  254. * AND JUMP2 AND ARG2 TO THE EXECUTION ROUTINE.
  255. * 'IN EACH CASE, IF JUMP IS ',CM', THEN ARG GIVES
  256. * THE CENTRAL MEMORY ADDRESS OF THE PROCESSING
  257. * ROUTINE; OTHERWISE, JUMP IS THE OVERLAY NUMBER
  258. * AND ARG CONTAINS ANY ARGUMENT TO BE PASSED IT.
  259. *
  260. JUMPOV MACRO NAME,NAM,TYPE,JUMP1,ARG1,CONTG,JUMP2,ARG2
  261. N1 MICRO 1,1, CONTG
  262. N2 MICRO 2,1, CONTG
  263. N3 MICRO 3,1, CONTG
  264. N4 MICRO 4,1, CONTG
  265. N5 MICRO 5,1, CONTG
  266. VFD 1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",10/0
  267. IFC NE,*JUMP2*CM*
  268. DD DECMIC JUMP2
  269. IF DEF,D"DD"$,1
  270. ERR NON-EXECUTABLE OVERLAY
  271. VFD 9/JUMP2,18/ARG2,18/PROCOV
  272. ELSE
  273. VFD 27/0,18/ARG2
  274. ENDIF
  275. N6 MICRO 3,8, NAME_=
  276. "N6" EQU NN
  277. NN SET NN+1
  278. ENDM
  279. *
  280. JUMPD MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L
  281. N1 MICRO 1,1, CONTG
  282. N2 MICRO 2,1, CONTG
  283. N3 MICRO 3,1, CONTG
  284. N4 MICRO 4,1, CONTG
  285. N5 MICRO 5,1, CONTG
  286. VFD 1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2
  287. N6 MICRO 3,8, NAME_=
  288. "N6" EQU NN
  289. NN SET NN+1
  290. ENDM
  291. *
  292. JUMP* MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L
  293. N1 MICRO 1,1, CONTG
  294. N2 MICRO 2,1, CONTG
  295. N3 MICRO 3,1, CONTG
  296. N4 MICRO 4,1, CONTG
  297. N5 MICRO 5,1, CONTG
  298. VFD 1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2
  299. NN SET NN+1
  300. ENDM
  301. *
  302. JUMPD* MACRO NAME,NAM,TYPE,JUMP1,CONTG,JUMP2,L
  303. N1 MICRO 1,1, CONTG
  304. N2 MICRO 2,1, CONTG
  305. N3 MICRO 3,1, CONTG
  306. N4 MICRO 4,1, CONTG
  307. N5 MICRO 5,1, CONTG
  308. VFD 1/"N1",1/"N2",1/"N3",1/"N4",1/"N5",55/JUMP2
  309. N6 MICRO 3,8, NAME_=
  310. "N6" EQU NN
  311. NN SET NN+1
  312. ENDM
  313. *
  314. JUMPF MACRO
  315. ENDM
  316. *
  317. JUMPI MACRO
  318. ENDM
  319. *
  320. * USED ONLY IN CONDENSOR FOR NON-EXECUTABLE
  321. * COMMANDS IN OVERLAYS
  322. *
  323. JUMPIO MACRO
  324. ENDM
  325. *
  326. * /--- BLOCK JUMP MACRO 00 000 79/03/21 21.25
  327. JUMPP MACRO
  328. ENDM
  329. *
  330. * /--- BLOCK JUMP MACRO 00 000 79/03/21 21.25
  331. JUMPPO MACRO
  332. ENDM
  333. *
  334. *
  335. * /--- BLOCK RETPROC 00 000 78/04/02 03.16
  336. TITLE RETPROC -- RELOAD UNIT AFTER I/O COMMAND
  337. *
  338. * * * UNFINISHED BUSINESS...
  339. * THIS MIGHT BE A BIT MESSY HERE UNTIL OTHER
  340. * PLACES ARE CLEANED UP. THE IDEA IS THAT ALL
  341. * CHECKS FOR EXCESSIVE DISK ACCESSING SHOULD BE
  342. * HERE. PROBLEMS NEEDING WORK';
  343. *
  344. * NEEDS EXCESSIVE 'D'A'P'M CHECK...LIKE IOCHK...HERE AND
  345. * NOT ALL OVER THE PLACE.
  346. *
  347. * * * RETPROC
  348. *
  349. * ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS.
  350. * RETURN AFTER COMMANDS THAT DID DISK ACCESSES AND
  351. * THAT USED -SAVLES- (OR HAVE UNLOADED'; COMMON,
  352. * STORAGE, ANSWER-JUDGING BUFFERS, UNIT, ETC.).
  353. * -STOP1- KEY WILL BE CHECKED FOR.
  354. * EXCESSIVE PROCESSING WILL BE CHECKED FOR.
  355. * * *
  356. *
  357. ENTRY RETPROC
  358. RETPROC CALL RESTLES RESTORE COMMON, UNIT, ETC
  359. * INFO PREVIOUSLY SAVED BY
  360. * CALL TO SAVLES
  361. * /--- BLOCK CKPROC 00 000 79/10/09 23.45
  362. TITLE CKPROC -- RETURN FROM INTERRUPT COMMANDS
  363. *
  364. * * * CKPROC
  365. *
  366. * ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS.
  367. * RETURN AFTER COMMANDS THAT DO DISK ACCESSES.
  368. * -STOP1- KEY WILL BE CHECKED FOR.
  369. * TOO MUCH PROCESSING WILL BE CHECKED FOR. THIS
  370. * CAN COME ABOUT WHEN SERIES OF COMMANDS INTERNALLY
  371. * INTERRUPT (E.G., DISK ACCESSING) WITHOUT EVER
  372. * CAUSING A TIME-SLICE EXCEEDED BUT USE ENUF CPU
  373. * TIME FREQUENTLY ENUF TO GO OVER THE ALLOWED TIPS.
  374. *
  375. *
  376. ENTRY CKPROC
  377. CKPROC BSS 0
  378. SA1 STFLAGS SEE IF -STOP1- PRESSED SINCE
  379. LX1 -ST1BIT STARTED RUNNING IN THIS LESSON
  380. NG X1,CKPROCA
  381. LX1 ST1BIT-SSBBIT TEST IF BACKOUT IN PROGRESS
  382. NG X1,CKPROC2 (IN SPECIAL STOP1 LESSON)
  383.  
  384. * CHECK FOR UNPROCESSED OUTPUT IN THE PLATO TO
  385. * FORMAT BUFFERS. IF YES, END THIS TIME SLICE.
  386.  
  387. SA1 OUTMOUT
  388. SA2 SUBMOUT
  389. IX1 X1-X2
  390. ZR X1,CKPROC2 IF NO UNPROCESSED OUTPUT
  391. CALL TFIN ELSE, END THIS TIMESLICE
  392. EQ CKPROC TRY AGAIN
  393.  
  394. CKPROCA BSS 0
  395. *
  396. CALL STOPCHK X2=0 IF STOP1 HANDLING LESSON
  397. SX6 STOP1
  398. SA6 KEY MAKE SURE KEY=STOP1
  399. *
  400. ZR X2,CKPROC2 SEPARATE STOP1-LESSONS
  401. *
  402. SA1 STFLAGS SEE IF ALREADY IN FINISH UNIT
  403. LX1 60-FINBIT
  404. PL X1,FINISH --- BRANCH IF NOT FINISH UNIT
  405. *
  406. SA3 TDSKACC IN FINISH UNIT
  407. MX6 1 INCREMENT DISK ACCESS COUNT
  408. LX6 55
  409. IX6 X3+X6
  410. SA6 A3
  411. LX6 6
  412. MX3 54
  413. BX3 -X3*X6
  414. SX3 X3-10-1 NO MORE THAN 10 ACCESSES
  415. PL X3,ERXDFIN CANNOT ALLOW MORE IN FINISH U
  416. *
  417. CKPROC2 CALL COMPTIM CHECK FOR TOO MUCH PROCESSING
  418. NG B2,PROCESS CONTINUE
  419. EQ XSL2 END IF TOO MUCH PROCESSING
  420. * /--- BLOCK PROCESX 00 000 78/05/17 21.08
  421. ENTRY PROCESX
  422. * PROCESS RETURN FOR COMMANDS THAT SET EXECERR
  423. * ARG NUMBER
  424. PROCESX SX6 0
  425. SA6 ERXARGN
  426. EQ PROCESS
  427. * /--- BLOCK RETPRO 00 000 79/09/01 19.35
  428. TITLE RETPRO -- RELOAD UNIT AND CONTINUE
  429. *
  430. * * * RETPROS,RETPRO
  431. *
  432. * ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS.
  433. * RETURN AFTER COMMANDS THAT USED -SAVLES- (OR HAVE
  434. * UNLOADED'; COMMON,STORAGE,ANSWER-JUDGING BUFFERS,
  435. * UNIT (MUST CALL GETUNIT),ETC.)
  436. * THOSE THAT INTERRUPTED SHOULD USE -RETPROS- TO
  437. * IMMEDIATELY CATCH ANY -STOP1- KEYS THE USER MAY
  438. * HAVE PRESSED.
  439. *
  440. * * *
  441. *
  442. ENTRY RETPROS SOME INTERRUPT HAS OCCURRED
  443. * SO -STOP1- MUST BE CHECKED FOR.
  444. RETPROS SA1 STFLAGS SEE IF -STOP1- PRESSED
  445. LX1 -ST1BIT
  446. PL X1,RETPRO
  447. SX6 STOP1 MAKE SURE KEY=STOP1
  448. SA6 KEY
  449. CALL STOPCHK SEE IF LESSON HANDLES STOP1
  450. NZ X2,FINISH IF NOT, START FINISH UNIT
  451. * SA1 STFLAGS CLEAR -STOP1- BIT FOR SYSTEM
  452. * MX6 1 LESSONS THAT HANDLE IT
  453. * LX6 ST1BIT
  454. * BX6 -X6*X1
  455. * SA6 A1
  456. *
  457. ENTRY RETPRO
  458. RETPRO CALL RESTLES RESTORE COMMON, UNIT, ETC
  459. * INFO PREVIOUSLY SAVED BY
  460. * CALL TO SAVLES
  461. * ON TO PROCESS
  462. * /--- BLOCK PROCESS 00 000 80/04/22 00.55
  463. TITLE PROCESS -- CHECK IF TIMESLICE OVER
  464. *
  465. * * * PROCESS
  466. *
  467. * ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS.
  468. * ENTRY AFTER COMMANDS THAT DO NOT DO ANY DISK
  469. * ACCESSES BUT ARE LONG ENOUGH IN PROCESSING (SAY
  470. * OVER 0.1 MS) TO POSSIBLY CAUSE THE TIME-SLICE TO
  471. * BE EXCEEDED. THE STANDARD RETURN FOR COMMANDS.
  472. *
  473. *
  474. ENTRY PROCESS
  475. PROCESS SA1 XSLCLOK GET RUNNING MS CLOCK
  476. SA2 MAXCLOK GET END OF TIME-SLICE
  477. IX2 X1-X2
  478. PL X2,XXSLICE EXIT IF TIME-SLICE OVER
  479. * /--- BLOCK PROC 00 000 80/04/22 00.56
  480. TITLE PROC -- EXECUTE NEXT COMMAND
  481. *
  482. * * * PROC
  483. *
  484. * ENTRY TO CONTINUE PROCESSING TUTOR COMMANDS
  485. * ENTRY AFTER COMMANDS THAT TAKE PRACTICALLY NO
  486. * PROCESSING TIME (SAY A FEW MICROSECONDS) AND MAKE
  487. * NO DISK ACCESSES. A WHOLE UNIT FULL OF THESE
  488. * COMMANDS SHOULD NOT CONSUME A TIME-SLICE.
  489. *
  490. * * *
  491. ENTRY PROC,PROC1
  492. PROC SA1 SCOMFLG STEP MODE OVERWRITES THIS WORD
  493. NZ X1,SPROC SEE IF COMMAND STAT FLAG IS ON
  494. PROC1 SA5 A5-1 LOAD NEXT COMMAND
  495. MX0 60-XCMNDL
  496. BX4 -X0*X5 GET ONLY COMMAND BITS
  497. SA1 X4+JTABLE LOAD COMMAND TABLE ENTRY
  498. SB1 X1 WHERE TO JUMP
  499. LX1 B7,X1 SHIFT TO PROPER CONTINGENCY BIT
  500. PL X1,PROC1 IGNORE IF NOT VALID IN THIS CONTINGENCY
  501. JP B1 JUMP TO EXECUTION ROUTINE
  502. *
  503. *
  504. * SPECIAL PROCESSOR FOR STATISTICS TAKING
  505. * SAVES TIME IN NORMAL NON-STAT LOOP
  506. *
  507. * SEE ALSO -- TUTIM PROCESSING IN TUTORX
  508. *
  509. SPROC PL X1,SPROC1
  510. RJ POSTCMS TAKE COMMAND STAT IF FLAG SET
  511. SPROC1 SA5 A5-1 LOAD NEXT COMMAND
  512. MX0 60-XCMNDL
  513. BX4 -X0*X5 GET ONLY COMMAND BITS
  514. SA1 X4+JTABLE LOAD COMMAND TABLE ENTRY
  515. SB1 X1 WHERE TO JUMP
  516. LX1 B7,X1 SHIFT TO PROPER CONTINGENCY BIT
  517. PL X1,SPROC1 IGNORE IF NOT VALID IN THIS CONTINGENCY
  518. BX6 X4
  519. SA6 SCOMNUM SAVE COMMAND NUMBER
  520. SA2 SCOMLES
  521. ZR X2,SPROC1A 0 INDICATES ALL LESSONS
  522. SA3 TBLESSN
  523. BX2 X2-X3 SEE IF NEEDED FOR THIS LESSON
  524. NZ X2,SPROC2 JUMP TO EXECUTION IF NOT NEEDED
  525. SPROC1A SA2 XSLCLOK
  526. BX6 X2
  527. SA6 SCOMBEG SAVE BEGIN EXECUTION TIME
  528. SA2 SCOMFLG
  529. BX6 -X2 COMPLIMENT FLAG
  530. SA6 A2 SET COMMAND STATISTICS FLAG ON
  531. SPROC2 JP B1 JUMP TO EXECUTION ROUTINE
  532. *
  533. *
  534. * /--- BLOCK PROCO 00 000 78/04/02 03.02
  535. TITLE PROCO -- RETURN FROM OUTPUT COMMANDS
  536. *
  537. * * * PROCO
  538. *
  539. * RETURN FOR COMMANDS THAT PUT OUTPUT INTO -MOUT-
  540. * IT CHECKS WHETHER -MOUT- IS GETTING FULL AND
  541. * DOES AN INTERRUPT IF SO. THIS RETURN AVOIDS
  542. * HAVING ALL THESE COMMANDS DO THIS TEST SOMEWHERE.
  543. *
  544. * * *
  545. ENTRY PROCO
  546. PROCO SA1 AOUTLOC
  547. SX1 X1-AOUTLTH/2
  548. PL X1,PCO10 CHECK ACTION REQ BUFFER FILLING
  549. * IF THIS IS A DSN SITE CHECK IF TOO MUCH OUTPUT
  550. * IN MOUT BUFFER SO THAT PARCEL BUFFER OVERFLOW
  551. * WILL NOT OCCUR WHEN THE DSN OUTPUT SLOWS UP.
  552. DSNMOUT SA1 STATION
  553. AX1 5
  554. SA2 AFRAMID
  555. IX0 X1+X2
  556. RX2 X0
  557. SB2 X2
  558. SB1 DSN0FOD
  559. LT B2,B1,NAMMOUT
  560. SB1 B1+MXDSN
  561. GE B2,B1,NAMMOUT
  562. SA1 MOUTLOC
  563. SX1 X1-MOUTDSN
  564. EQ PCO05
  565.  
  566. * DO THE SAME IF NAM SITE
  567.  
  568. NAMMOUT SB1 NAM0FOD
  569. LT B2,B1,CIUMOUT
  570. SB1 B1+MXNAM
  571. GE B2,B1,CIUMOUT
  572. SA1 MOUTLOC
  573. SX1 X1-MOUTNAM
  574. EQ PCO05
  575.  
  576. * OTHERWISE ITS A CIU SITE
  577.  
  578. CIUMOUT SA1 MOUTLOC
  579. SX1 X1-MOUT200
  580. PCO05 PL X1,PCO10 CHECK IF *MOUT* BUFFER FILLING
  581. CHKPRC SA1 PARCLCNT
  582. SX1 X1-PRCLIM CHECK FOR TOO MUCH ACCUMULATED
  583. NG X1,PROCESS
  584. *
  585. PCO10 SA1 INARGS
  586. NZ X1,PROC EXIT IF ARGUMENTS IN HAND
  587. SA1 TBITS
  588. LX1 BRKBIT CHECK IF AUTO-BREAK SURPRESSED
  589. NG X1,PROCESS
  590. SA1 INEMBED CHECK IF EMBEDDED WRITE
  591. ZR X1,XXSLICE
  592. CALL WINTRP INTERRUPT
  593. EQ PROCESS
  594. * /--- BLOCK PROCOV 00 000 78/04/02 03.01
  595. TITLE PROCOV -- LOAD COMMAND OVERLAY AND EXECUTE
  596. *
  597. * -PROCOV-
  598. *
  599. * LOAD THE COMMAND EXECUTION OVERLAY AND BEGIN
  600. * EXECUTION.
  601. *
  602. * A1 = ADDRESS OF JUMP TABLE ENTRY
  603. *
  604. *
  605. PROCOV SA1 A1 RE-LOAD COMMAND TABLE ENTRY
  606. LX1 -36 SHIFT OVERLAY ARG TO TOP 18
  607. BX6 X1
  608. AX6 -18 EXTEND SIGN BIT OVER WORD
  609. *
  610. * SOME COMMANDS ENTER HERE WITH (X6) = ARGUMENT
  611. * AND (X1) = OVERLAY NUMBER
  612. *
  613. PROCOV1 SA6 OVARG1
  614. MX7 -9
  615. BX7 -X7*X1 MASK OFF OVERLAY NUMBER
  616. MX6 0
  617. SA6 =XOVRSTAK CLEAR OVERLAY STACK
  618. CALL EXECOV0 LOAD AND EXECUTE OVERLAY (X7)
  619. EQ ERXOVRT OVERLAY SHOULD NOT RETURN HERE
  620. * /--- BLOCK XXSLICE 00 000 80/04/22 00.57
  621. TITLE XXSLICE -- END TIME SLICE
  622. *
  623. XXSLICE SA1 INEMBED
  624. NZ X1,PROC EXIT IF IN EMBEDDED WRITE
  625. SA1 INARGS
  626. NZ X1,PROC EXIT IF ARGUMENTS IN HAND
  627. SA1 TBITS
  628. LX1 BRKBIT
  629. NG X1,TOOMUCH JUMP IF AUTO-BREAK SUPPRESSED
  630. *
  631. *
  632. ENTRY XSLICE
  633. *
  634. XSLICE SA1 SCOMFLG
  635. PL X1,XSL2 JUMP IF NO STATISTICS
  636. CALL POSTCMS TAKE COMMAND STATISTICS
  637. *
  638. XSL2 CALL TFIN END THIS TIME SLICE
  639. EQ PROCESS
  640. *
  641. *
  642. *
  643. TITLE PRE-CHECK FOR OUTPUT COMMANDS
  644. *
  645. *
  646. * -OPRECHK-
  647. *
  648. ENTRY OPRECHK
  649. OPRECHK EQ *
  650. SA1 RSIZE
  651. ZR X1,OPRE1 IF SIZE NOT 0
  652. SA1 MOUTLOC
  653. SX2 X1-MOUT200
  654. PL X2,OPREWT JUMP IF MUCH OUTPUT
  655. *
  656. OPRE1 SA1 XSLCLOK GET CPU USE CLOCK
  657. SA2 MAXCLOK GET END OF TIME SLICE
  658. IX2 X1-X2
  659. NG X2,OPRECHK
  660. *
  661. *
  662. OPREWT SA1 TBITS
  663. LX1 BRKBIT CHECK IF AUTO-BREAK SUPPRESSED
  664. NG X1,OPRECHK
  665. SA5 A5+1 BACKSPACE COMMAND POINTER
  666. EQ XXSLICE
  667. *
  668. *
  669. TITLE COMMAND JUMP TABLE
  670. *
  671. *
  672. * COMMAND JUMP TABLE
  673. * THE TOP NTH BIT OF THE WORD IF SET MEANS THE COMMAND IS VALID
  674. * IN CONTINGENCY *N*. THE BOTTOM 18 BITS HOLD THE BRANCH ADDRESS
  675. *
  676. *
  677. *
  678. *
  679. ENTRY JTABLE
  680. JTABLE BSS 0
  681. *
  682. NOREF NN
  683. NN SET 0 DEFINE NAMES
  684.  
  685. *
  686. LIST X,G
  687. *CALL COMNDS
  688. *
  689. * ALLOW A FEW EXTRA ENTRIES SO NEW COMMANDS MAY
  690. * BE ADDED TO CONDENSOR WITHOUT REQUIRING A
  691. * RE-ASSEMBLY OF EXEC1
  692. *
  693. JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS
  694. JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS
  695. JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS
  696. JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS
  697. JUMP* UNUSED,UNUSED,1,ERRORC,11111,ERXUNUS
  698. *
  699. LIST *
  700.  
  701. ENTRY CREATE=
  702. DESTRY= EQU DESTROY=
  703. ENTRY DESTRY=
  704. RENAMF= EQU RENAMEF=
  705. ENTRY RENAMF=
  706. RETYPF= EQU RETYPEF=
  707. ENTRY RETYPF=
  708. SYSFIL= EQU SYSFILE=
  709. ENTRY SYSFIL=
  710.  
  711. * /--- BLOCK SECONDARY 00 000 78/08/14 00.46
  712. TITLE SECONDARY BRANCHING
  713. *
  714. ENTRY UNIT=
  715. COMPUT= EQU COMPUTE=
  716. *
  717. *
  718. ENTRY UNITJ
  719. *
  720. UNITJ SA1 THELPF CHECK IF IN ON-PAGE HELP
  721. NZ X1,UNITXH
  722. SA1 JOIN
  723. UNITJ0 NZ X1,UNJOIN UNJOIN IF IN JOIN
  724. JP B7+*+1
  725. + EQ EXIT
  726. + EQ UNITAX1
  727. + EQ ANSEND
  728. + SX6 EXIT
  729. - EQ CIA
  730. + EQ UNITSX1
  731. *
  732. ENDARJ ZR B7,PROCESS NO PROCESSING YET IN UNIT-C
  733. JP B7+*
  734. + EQ UNITAX1
  735. + EQ ANSEND
  736. + EQ ANSMARK
  737. + EQ ENDARRX
  738. *
  739. ARROWJ ZR B7,ARROWX
  740. JP B7+*
  741. + EQ UNITAX1
  742. + EQ ANSEND
  743. + SX6 ARROWX
  744. - EQ CIA
  745. + EQ ARROWX
  746. ARROWFJ ZR B7,ARROWFX
  747. JP B7+*
  748. + EQ UNITAX1
  749. + EQ ANSEND
  750. + SX6 ARROWFX
  751. - EQ CIA
  752. + EQ ARROWFX
  753. JARROWJ ZR B7,JARROWX
  754. JP B7+*
  755. + EQ UNITAX1
  756. + EQ ANSEND
  757. + SX6 JARROWX
  758. - EQ CIA
  759. *
  760. STOREJ JP B7+*
  761. + EQ UNITAX1
  762. + EQ STORE
  763. + EQ ANSMARK
  764. CLOSEJ JP B7+*
  765. + EQ UNITAX1
  766. + EQ CLOSEX
  767. + EQ ANSMARK
  768. PUTJ JP B7+*
  769. + EQ UNITAX1
  770. + EQ PUTX
  771. + EQ ANSMARK
  772. SPECSJ JP B7+*
  773. + EQ UNITAX1
  774. + EQ SPECX
  775. + EQ ANSMARK
  776. EXACTJ JP B7+*
  777. + EQ UNITAX1
  778. + EQ EXACTX
  779. + EQ ANSMARK
  780. STOREAJ JP B7+*
  781. + EQ UNITAX1
  782. + EQ STOREAX
  783. + EQ ANSMARK
  784. * /--- BLOCK -SECONDARY 00 000 79/10/28 21.50
  785. ANSVJP JP B7+*
  786. + EQ UNITAX1
  787. + EQ ANSVX
  788. + EQ ANSMARK
  789. CONCEPTJ JP B7+*
  790. + EQ UNITAX1
  791. + EQ CNCEPTX
  792. + EQ ANSMARK
  793. TOUCHJ JP B7+*
  794. + EQ UNITAX1
  795. + EQ TOUCHX
  796. + EQ ANSMARK
  797. LOADAJ JP B7+*
  798. + EQ UNITAX1
  799. + EQ LOADAX
  800. + EQ ANSMARK
  801. WRONGVJ JP B7+*
  802. + EQ UNITAX1
  803. + EQ WRONGVX
  804. + EQ ANSMARK
  805. ANSKEYJ JP B7+*
  806. + EQ PANSKEY
  807. + EQ ANSKEYX
  808. + EQ ANSMARK
  809. OPENJ JP B7+*
  810. + EQ UNITAX1
  811. + EQ OPENX
  812. + EQ ANSMARK
  813. OKJ JP B7+*
  814. + EQ UNITAX1
  815. + EQ OKX
  816. + EQ ANSMARK
  817. STORENJ JP B7+*
  818. + EQ UNITAX1
  819. + EQ STORENX
  820. + EQ ANSMARK
  821. EXACTVJ JP B7+*
  822. + EQ UNITAX1
  823. + EQ EXACTVX
  824. + EQ ANSMARK
  825. BUMPJ JP B7+*
  826. + EQ UNITAX1
  827. + EQ BUMPX
  828. + EQ ANSMARK
  829. ORJ JP B7+*-1
  830. EQ DECANSCT DECREMENT ANSCNT IF STILL IN JUDGE-C
  831. * THE FOLLOWING IS TO MAKE SURE THE COMMAND WHICH
  832. * FOLLOWS THE -OR- IS A JUDGING COMMAND.
  833. SA1 A5-1 GET NEXT COMMAND WORD
  834. MX0 60-XCMNDL
  835. BX1 -X0*X1 COMMAND BITS
  836. SA2 X1+JTABLE
  837. MX0 5
  838. BX2 X0*X2 MASK OFF CONTINGENCY BITS
  839. LX2 5
  840. SX2 X2-16B CHECK IF JUDGING COMMAND
  841. NZ X2,PROCESS IGNORE THIS COMMAND IF NOT
  842. SA5 A1 SKIP NEXT COMMAND
  843. EQ PROCESS
  844. *
  845. DECANSCT SA3 TANSCNT DECREMENT ANSWER COUNTER
  846. SX7 X3-1
  847. SA7 A3
  848. EQ PROCESS
  849. *
  850. EXCJ JP B7+*
  851. + EQ UNITAX1
  852. + EQ EXACTCX
  853. + EQ ANSMARK
  854. PUTVJ JP B7+*
  855. + EQ UNITAX1
  856. + EQ PUTVX
  857. + EQ ANSMARK
  858. XMATCH JP B7+*
  859. + EQ UNITAX1
  860. + EQ XMATCHX
  861. + EQ ANSMARK
  862. XANS JP B7+*
  863. + EQ UNITAX1
  864. + EQ XANSX
  865. + EQ ANSMARK
  866. * /--- BLOCK SECONDARY 00 000 78/08/14 00.47
  867. ANSCX JP B7+*
  868. + EQ UNITAX1
  869. + EQ ANSCXX
  870. + EQ ANSMARK
  871. XANSA JP B7+*
  872. + EQ UNITAX1
  873. + EQ XANSAX
  874. + EQ ANSMARK
  875. * /--- BLOCK GET2 00 000 74/09/05 15.53
  876. TITLE GENERAL TWO AND MULTI-VARIABLE PROCESSORS
  877. * GENERAL ROUTINE TO DECODE TWO VARIABLES WHOSE
  878. * GETVAR CODES ARE PACKED IN THE TOP 2*XCODEL BITS
  879. * OF THE COMMAND WORD. THE RESULTANT VALUES ARE
  880. * STORED IN *XDATA* AND *YDATA* ON EXIT.
  881. * ALSO THE FIRST ARG IS IN X1 AND X6, SECOND IN X7.
  882. *
  883. GET2 EQ *
  884. NGETVAR
  885. BX7 X1
  886. SA7 XDATA
  887. SA5 A5 RETRIEVE COMMAND WORD
  888. LX5 XCODEL MOVE 2ND VARIABLE TO TOP
  889. NGETVAR
  890. BX7 X1
  891. SA7 YDATA
  892. SA1 XDATA
  893. BX6 X1 RETURN VALUES IN X1-X6, X7
  894. EQ GET2
  895. *
  896. *
  897. * SUBROUTINE TO GET TWO FLOATING POINT VARIABLES
  898. *
  899. GET2F EQ *
  900. BX6 X5 SAVE X5 IN CASE IS XSTOR WD
  901. SA6 VARBUF+9
  902. FGETVAR
  903. BX7 X1
  904. SA7 XDATA
  905. SA1 VARBUF+9 RETRIEVE COMMAND WORD
  906. BX5 X1 POSITION FOR GETVAR
  907. LX5 XCODEL MOVE 2ND VARIABLE TO TOP
  908. FGETVAR
  909. BX7 X1
  910. SA7 YDATA
  911. EQ GET2F
  912. *
  913. XDATA BSS 1
  914. YDATA BSS 1
  915. *
  916. *
  917. * GENERAL ROUTINE TO DECODE MORE THAN TWO VARIABLES. THE
  918. * FIRST TWO VARIABLE CODES ARE ASSUMED PACKED IN THE TOP
  919. * 2*XCODEL BITS OF THE COMMAND WORD. THE REMAINING BITS OF
  920. * THE COMMAND WORD NOT USED BY THE COMMAND NUMBER ARE ASSUMED
  921. * TO POINT TO THE STARTING EXTRA STORAGE ADDRESS WHERE THE
  922. * REMAINING VARIABLE CODES ARE STORED.
  923. *
  924. * ENTER WITH X6 = NUMBER OF VARIABLES TO BE DECODED. ON EXIT
  925. * THE VECTOR *VARBUF* WILL CONTAIN THE ROUNDED INTEGER VALUES.
  926. *
  927. GETN EQ *
  928. RJ GETCODX GETVAR CODES IN VARBUF
  929. SX6 VARBUF
  930. SA6 VARADD INITIALIZE CURRENT VARIABLE ADDRESS
  931. SA1 X6
  932. BX5 X1
  933. GETN2 NGETVAR ROUNDS TO INTEGER IN X1
  934. SA2 VARADD X2 = CURRENT *VARBUF* ADDRESS
  935. BX7 X1
  936. SA7 X2 REPLACE VARIABLE CODE WITH VALUE
  937. SA1 VARCNT
  938. SX6 X1-1 DECREMENT COUNT OF VARIABLES TO BE DECODED
  939. ZR X6,GETN --- EXIT IF ALL VARIABLES DECODED
  940. SA6 A1
  941. SX7 X2+1 INCREMENT *VARBUF* ADDRESS
  942. SA7 A2
  943. SA1 X7 X1 = NEXT VARIABLE CODE WORD
  944. BX5 X1
  945. EQ GETN2
  946. *
  947. *
  948. *
  949. * /--- BLOCK GETCODX 00 000 80/02/07 02.32
  950. GETCODX EQ *
  951. SA6 VARCNT SAVE VARIABLE COUNT
  952. SB1 1 B1 = 1
  953. SB3 X6 B3 = COUNT
  954. BX7 X5
  955. SA7 VARBUF STORE WITH 1ST VARIABLE CODE LEFT-JUSTIFIED
  956. LX7 XCODEL
  957. SA7 VARBUF+1 STORE WITH 2ND VARIABLE CODE LEFT-JUSTIFIED
  958. LX7 60-XCMNDL-XCODEL
  959. MX0 2*XCODEL+XCMNDL
  960. BX7 -X0*X7 X7 = EXTRA STORAGE POINTER
  961. SA1 B5+X7 X1 = 1ST WORD OF EXTRA STORAGE
  962. SB2 B1+B1 B2 = CURRENT STORAGE INDEX (2)
  963. GETCOD1 BX6 X1
  964. SA6 VARBUF+B2
  965. SB2 B2+B1
  966. LX6 XCODEL
  967. SA6 VARBUF+B2
  968. SB2 B2+B1
  969. LX6 XCODEL
  970. SA6 VARBUF+B2
  971. SB2 B2+B1
  972. SA1 A1+B1 X1 = NEXT EXTRA STORAGE WORD
  973. LT B2,B3,GETCOD1 CONTINUE IF ANOTHER WORD REQUIRED
  974. EQ GETCODX
  975. *
  976. VARCNT BSS 1 NUMBER OF VARIABLES TO DECODE
  977. VARADD BSS 1 CURRENT *VARBUF* ADDRESS BEING PROCESSED
  978. * /--- BLOCK CHKSET/DEF 00 000 80/03/11 23.54
  979.  
  980. TITLE CHKSET -- SET RECORD CHECKPOINTING STATUS
  981. *
  982. * * CHKSET
  983. * *
  984. * * IF CHECKPOINTING IS ALLOWED, SET BIT IN *TRECBIT*
  985. * * THAT WILL PERMIT LESSON *CHECKPT* TO RETURN THE
  986. * * SIGNON RECORD TO DISK
  987. *
  988.  
  989. ENTRY CHKSET
  990. EXT TCHECK IN FILE GETVAR
  991.  
  992. CHKSET EQ *
  993. CALL TCHECK (X1) = -1 IF CHECKPOINTING OK
  994. SA2 TRECBIT (X2) = VARIOUS FLAGS
  995. MX0 1
  996. LX0 60-CKPTSHF POSITION CHECKPOINTING BIT
  997. PL X1,CHKOFF --- IF CHECKPOINTING OFF
  998. BX6 X2+X0 TURN CHECKPOINTING ON
  999. SA6 A2
  1000. EQ CHKSET
  1001.  
  1002. CHKOFF BX6 -X0*X2 TURN CHECKPOINTING OFF
  1003. SA6 A2
  1004. EQ CHKSET
  1005.  
  1006.  
  1007. TITLE CHKDEF -- REVERT TO DEFAULT CHECKPT STATUS
  1008. *
  1009. * * CHKDEF
  1010. * *
  1011. * * UPON EXIT FROM A NON-SYSTEM LESSON, REVERT TO
  1012. * * THE DEFAULT CHECKPOINTING STATUS AS SPECIFIED
  1013. * * BY THE ROUTER LESSON (OR BY LESSON *PLATO* IF
  1014. * * THE USER IS UNROUTED); INSTRUCTORS ALWAYS REVERT
  1015. * * TO THE DEFAULT CHECKPOINGINT STATUS
  1016. *
  1017.  
  1018. ENTRY CHKDEF
  1019.  
  1020. CHKDEF EQ *
  1021. SA1 TTYPE (X1) = USER TYPE
  1022. SA2 TYPETAB+UT.INST
  1023. BX1 X1-X2 CHECK IF INSTRUCTOR
  1024. ZR X1,CHKDEF1 --- IF INSTRUCTOR
  1025. SA1 LESSCM+LSTOUSE
  1026. NG X1,CHKDEF --- DO NOTHING IF SYSTEM LESSON
  1027. CHKDEF1 SA1 TRECBIT (X1) = VARIOUS FLAGS
  1028. BX6 X1 SAVE COPY IN X6
  1029. LX1 DCHKSHF SHIFT CHECKPT DEFAULT TO SIGN
  1030. MX0 1
  1031. BX1 X0*X1 (X1) = CHECKPT DEFAULT
  1032. LX0 60-CCHKSHF SHIFT TO CURRENT CHECKPT STATUS
  1033. BX6 -X0*X6 CLEAR CURRENT CHECKPT STATUS
  1034. LX1 60-CCHKSHF
  1035. BX6 X1+X6 AND RESET TO CHECKPT DEFAULT
  1036. SA6 A1
  1037. CALL CHKSET SET OVERALL CHECKPT STATUS
  1038. EQ CHKDEF
  1039. * /--- BLOCK -WHERE- 00 000 80/02/07 02.34
  1040. *
  1041. TITLE WHERE, WHERE(F)
  1042. * -WHERE- (CODE=0)
  1043. *
  1044. * SINGLE VARIABLE (ROW-COLUMN POSITION) WHERE.
  1045. *
  1046. WHEREX NG X5,WHRCON JUMP IF PRE-CONVERTED
  1047. NGETVAR ROUNDS TO INTEGER IN X1
  1048. RJ RCTOXY GET INTO FINE GRID
  1049. WHRXX MX0 -18 LIMIT NX AND NY TO 18 BITS
  1050. BX6 -X0*X6
  1051. BX7 -X0*X7
  1052. SA6 NX UPDATE WHEREX
  1053. SA7 NY AND WHEREY
  1054. MX0 -9 POSITION ON SCREEN
  1055. BX6 -X0*X6
  1056. BX7 -X0*X7
  1057. SA6 TBMARG SET X-MARGIN
  1058. LX6 9 SHIFT X UP 9 BITS
  1059. BX1 X6+X7 COMBINE WITH Y
  1060. BX4 X1
  1061. LX4 7+3 POSITION X/Y MARGIN FOR SIZE
  1062. MX0 -18
  1063. LX0 7+3 POSITION MASK
  1064. SA2 TBWRITE
  1065. BX2 X0*X2 CLEAR OUT OLD X/Y MARGIN
  1066. BX6 X2+X4
  1067. SA6 A2 SET NEW X/Y MARGIN
  1068. OUTCODE WFMCODE FINE WHERE THAT SETS MARGINS
  1069. EQ PROC
  1070. *
  1071. WHRCON LX5 10 POSITION X COORDINATE
  1072. MX0 -9
  1073. BX6 -X0*X5
  1074. LX5 9 POSITION Y COORDINATE
  1075. BX7 -X0*X5
  1076. EQ WHRXX
  1077. *
  1078. *
  1079. * -WHERE(F)- (CODE=1)
  1080. *
  1081. * TWO VARIABLE (FINE GRID) WHERE.
  1082. *
  1083. WHEREFX RJ GET2 GET VALUES OF 2 VARIABLES
  1084. EQ WHRXX
  1085. *
  1086. *
  1087. * /--- BLOCK ATNM/UNIT 00 000 76/07/04 21.27
  1088. *
  1089. * -ATNM- = -AT- WHICH USES OLD MARGINS
  1090. *
  1091. ATNMX NG X5,ATNM2 JUMP IF PRE-CONVERTED
  1092. NGETVAR ROUNDS TO INTEGER IN X1
  1093. RJ RCTOXY GET INTO FINE GRID
  1094. ATNM1 MX0 -18
  1095. BX6 -X0*X6 LIMIT X AND Y TO 18 BITS
  1096. BX7 -X0*X7
  1097. SA6 NX STORE NX
  1098. SA7 NY STORE NY
  1099. MX0 -9
  1100. BX6 -X0*X6
  1101. BX7 -X0*X7 SCREEN SETTING CAN ONLY HAVE 9
  1102. LX6 9 SHIFT X UP 9 BITS
  1103. BX1 X6+X7 COMBINE WITH Y
  1104. OUTCODE WFCODE FINE WHERE DOES NOT SET MARGIN
  1105. EQ PROC
  1106. *
  1107. ATNM2 LX5 10 POSITION X COORDINATE
  1108. MX0 -9
  1109. BX6 -X0*X5
  1110. LX5 9 POSITION Y COORDINATE
  1111. BX7 -X0*X5
  1112. EQ ATNM1
  1113. *
  1114. *
  1115. * -ATNM(F)-
  1116. *
  1117. * TWO VARIABLE (FINE GRID) AT--USES OLD MARGIN
  1118. *
  1119. ATNMFX RJ GET2 GET VALUES OF 2 VARIABLES
  1120. EQ ATNM1
  1121. *
  1122. * /--- BLOCK UNIT 00 000 79/05/16 16.00
  1123. *
  1124. TITLE UNIT
  1125. * -UNIT- (CODE=3)
  1126. *
  1127. * ARROW CONTINGENCY
  1128. *
  1129. ENTRY UNITAX1
  1130. *
  1131. UNITAX1 SA2 TBITS CHECK TYPE OF ARROW
  1132. SA1 TIARROW FOR NORMAL ARROW
  1133. LX2 ARRTPBT SET IF ARROWA
  1134. PL X2,UNITAXX IF ARROW
  1135. SA1 TIARROWA
  1136.  
  1137. UNITAXX ZR X1,UNITAX2 IF NO -IARROW/A- UNIT
  1138. LX1 60-12 SET UP UNIT NUMBER FOR -JOIN-
  1139. BX7 X1 SAVE UNIT NUMBER
  1140. MX0 1 SET UP MASK FOR -IARROW- BIT
  1141. LX0 -IARRBIT
  1142. SA1 TBITS WORD CONTAINING -IARROW- BIT
  1143. BX6 X0*X1
  1144. NZ X6,UNITAX2 JUMP IF UNIT ALREADY EXECUTED
  1145. BX6 X0+X1
  1146. SA6 A1 SET BIT TO MARK UNIT EXECUTED
  1147. SA5 A5+1 BACK UP FOR RETURN FROM JOIN
  1148. BX5 X7 UNIT IN X5
  1149. EQ JOINX
  1150.  
  1151. UNITAX2 SA1 TBARROW
  1152. MX0 -18 MASK OFF X/Y COORDS
  1153. BX1 -X0*X1 GET X/Y COORDINATES
  1154. OUTCODE WFMCODE RESET -AT- FOR ARROW
  1155.  
  1156. SA1 LIMIT GET -LONG- FOR ARROW
  1157. CALL CLIENT,4500B,X1 SEND -ARROW- EXT + LONG
  1158.  
  1159. SA1 TBARROW
  1160. PL X1,UNITAX3 IF ARROW ALREADY PLOTTED, SKIP
  1161. MX0 1 SET UP FOR NEGATIVE MASK
  1162. BX6 -X0*X1 CLEAR PLOT BIT
  1163. SA6 A1 SAVE IT
  1164. OUTARR PLOT ARROW
  1165.  
  1166. * START INPUT AT ARROW BY GOING INTO *JUDGEC* STATE
  1167.  
  1168. UNITAX3 SB7 XJUDGEC ENTER JUDGE-C
  1169. EQ EXIT
  1170. *
  1171. * SEARCH CONTINGENCY
  1172. *
  1173. UNITSX1 SB7 XALLOKC SET TO ALL-OK-CONTINGENCY
  1174. SA1 TLVLESS
  1175. ZR X1,EXIT IF NO LVARS, EXIT
  1176. *
  1177. SA5 A5+1 BACK UP A COMMAND
  1178. EQ ENDARRX
  1179. * /--- BLOCK UNIT 00 000 80/03/27 17.23
  1180. *
  1181. * 'N'E'W -- INCLUDES CORRECTION TO FIX NEXTNOW/TIMEL
  1182. * INTERACTION PROBLEM
  1183. *
  1184. * ON-PAGE HELP
  1185. *
  1186. ENTRY UNITXH
  1187. UNITXH SA1 JOIN GET CURRENT JOIN DEPTH
  1188. NZ X1,UNJOIN BACK OUT ONE JOIN LEVEL
  1189. JP B7+*+1
  1190. *
  1191. + EQ UXH10 UNIT-C
  1192. + EQ UNITAX1 ARROW-C
  1193. + EQ ANSEND JUDGE-C
  1194. + EQ ANSMARK ANSWER-C
  1195. + EQ UXH10 SEARCH-C
  1196. *
  1197. *
  1198. UXH10 SB1 JOINLTH LENGTH OF JOIN STACK
  1199. UHJ SA1 B1+HJOIN LOAD SAVED JOIN STACK ENTRY
  1200. BX6 X1
  1201. SA6 B1+JOIN RESTORE JOIN STACK
  1202. SB1 B1-1
  1203. PL B1,UHJ END TEST
  1204. SX6 X6 X6 = JOIN STACK POINTER ONLY
  1205. SA6 A6
  1206. AX1 18 X1 = LVAR STACK POINTER
  1207. SA2 TLVLESS RESTORE LVAR STACK POINTER
  1208. AX2 18
  1209. LX2 18
  1210. BX6 X1+X2
  1211. SA6 A2
  1212. *
  1213. SA4 THELPF LOAD ON-PAGE-HELP FLAG
  1214. MX6 0
  1215. SA6 A4 CLEAR FLAG
  1216. BX6 X4
  1217. MX0 -6
  1218. SA6 ILOC SAVE ON-PAGE-HELP FLAG
  1219. BX1 -X0*X4 MASK OFF OLD CONTINGENCY
  1220. SB7 X1
  1221. BX1 X4 GET ARROW ENCOUNTERED FLAG
  1222. LX1 2
  1223. PL X1,UH150 JUMP IF NO ARROW ENCOUNTERED
  1224. SB1 B7-XUNITC CHECK IF WERE IN UNIT-C
  1225. ZR B1,UH100
  1226. SB1 B7-XNEXTLK OR NEXTNOW-C
  1227. ZR B1,UH100
  1228. *
  1229. SA2 JOIN LOAD CURRENT JOIN LEVEL
  1230. ZR X2,UNERR1 SUPPOSED TO BE A JOIN STACK
  1231. SX7 X2-1 BACK-UP ONE JOIN LEVEL
  1232. SA7 A2
  1233. UH60 MX0 -12
  1234. SA1 X7+JOINL JOIN STACK ENTRY OF ARROW
  1235. BX4 X0*X1 MASK ALL BUT COMMAND BIAS
  1236. BX1 -X0*X1
  1237. SX1 X1-1 BACK-UP COMMAND PTR BY ONE
  1238. NG X1,UNERR2 SHOULD BE A COMND FOLLOWING
  1239. * EXECERR USES X1
  1240. BX4 X4+X1 RE-ATTACH COMMAND BIAS
  1241. SB7 XUNITC RE-SET TO UNIT-C
  1242. EQ UNJOIN1 GO TO RE-EXECUTE ARROW COMMAND
  1243. *
  1244. * /--- BLOCK UNIT 00 000 79/05/05 22.48
  1245. *
  1246. * 'N'E'W -- INCLUDES CORRECTION TO FIX NEXTNOW/TIMEL
  1247. * INTERACTION PROBLEM
  1248. *
  1249.  
  1250. *
  1251. UH100 SA1 TBARROW CHECK IF ANY ARROW TO ERASE
  1252. ZR X1,UH150
  1253. MX6 0 CLEAR OUT ARROW FLAG
  1254. SA6 A1
  1255. SA3 INHIBS CHECK FOR -INHIBIT ARRPLT-
  1256. LX3 ARRSHIF
  1257. NG X3,UH150
  1258. OUTCODE WFCODE OUTPUT WHERE
  1259. OUTARR E ERASE ARROW
  1260. *
  1261. UH150 SB1 B7-XNEXTLK IF IN NEXTNOW-C,
  1262. ZR B1,UH170 GO BACK TO ORIGINAL COMMAND
  1263. SA1 ILOC
  1264. LX1 1 POSITION -PAUSE- BIT
  1265. PL X1,UH200 JUMP IF HELPOP NOT FROM PAUSE
  1266. SB1 B7-XUNITC
  1267. ZR B1,UH170 JUMP IF WERE IN UNIT-C
  1268. MX6 0
  1269. SA6 JOIN CLEAR JOIN STACK POINTER
  1270. SB1 B7-XANSC ANSWER-C
  1271. ZR B1,JEXITX
  1272. SB1 B7-XARROWC ARROW-C
  1273. ZR B1,UNITAX1
  1274. EQ WRONGC ALL ELSE ARE ERRORS
  1275. *
  1276. *
  1277. UH170 SX7 JOINLTH-1 SET TO LAST WORD OF JOIN STACK
  1278. EQ UH60 GO TO RE-EXECUTE THE ORIGINAL PAUSE COMMAND
  1279. *
  1280. *
  1281. UH200 JP B7+*+1
  1282. *
  1283. + EQ UH300 UNIT-C
  1284. + EQ WRONGC ARROW-C
  1285. + EQ JEXITX JUDGE-C
  1286. + EQ UH300 ANSWER-C
  1287. + EQ WRONGC SEARCH-C
  1288. + EQ WRONGC *** UNUSED ***
  1289. + EQ WRONGC NEXT-NOW-C (SHOULDNT GET HERE)
  1290. + EQ UH300 ALL-OK-C
  1291. + EQ WRONGC *** UNUSED ***
  1292. + EQ WRONGC INITIAL-ENTRY-C
  1293. *
  1294. *
  1295. UH300 MX6 0
  1296. SA6 JOIN CLEAR JOIN STACK POINTER
  1297. EQ EXIT
  1298. *
  1299. WRONGC SX1 B7
  1300. EXECERR 907 *WRONG CONTINGENCY*
  1301. *
  1302. UNERR1 EXECERR 916 NO JOIN STACK
  1303. *
  1304. * EXECERR USES X1
  1305. UNERR2 EXECERR 917 BAD COMND POINTER AFTER UNJOIN
  1306. * /--- BLOCK WRITE 00 000 75/12/09 15.04
  1307. TITLE WRITE AND CALC
  1308. *
  1309. *
  1310. * TUTOR WRITE ROUTINE
  1311. * B1 = ADDRESS OF WRITE INFO
  1312. * B2 = ADDRESS OF CHARACTER COUNT
  1313. *
  1314. ENTRY TUTWRT
  1315. TUTWRTT RJ WRSOUT OUTPUT WRITING NORMAL SIZE
  1316. TUTWRT EQ *
  1317. SA1 RSIZE
  1318. ZR X1,TUTWRTT IF SIZE 0
  1319. MX6 -7-3
  1320. SA2 TBWRITE CLEAR SIZE WRITE INFO
  1321. BX6 X6*X2
  1322. SA6 A2
  1323. RJ LINWRT
  1324. EQ TUTWRT
  1325. *
  1326. *
  1327. * -CALC- (CODE=4)
  1328. *
  1329. CALC AX5 60-XCODEL PERFORM THE CALC
  1330. SB1 X5+B5
  1331. SB3 PROCESS
  1332. JP B1 GO DO CALC
  1333. *
  1334. *
  1335. * /--- BLOCK CUNIT 00 000 73/00/00 00.00
  1336. TITLE -CUNIT-
  1337. *
  1338. *
  1339. * -CUNIT-
  1340. * GENERAL ROUTINE TO LOCATE UNIT FOR CONDITIONAL COMMANDS.
  1341. * ON EXIT B1 = VALUE OF CONDITION INDEX
  1342. *
  1343. ENTRY CUNIT
  1344. CUNIT EQ *
  1345. NGETVAR ROUNDS TO INTEGER IN X1
  1346. PL X1,CUNIT1 IF NEGATIVE, MAKE -1
  1347. ZR X1,CUNIT1 PREVENT -0 FROM TAKING NEGATIVE BRANCH
  1348. SX1 -1
  1349. CUNIT1 SX0 1
  1350. IX1 X1+X0 MAKE SO GOES FROM 0 TO N-1
  1351. SA5 A5 RELOAD COMMAND WORD
  1352. RJ CUNIT1A
  1353. EQ CUNIT
  1354. *
  1355. ENTRY CUNIT1A
  1356. CUNIT1A EQ * ENTRY WITH X1 = NORMALIZED COND
  1357. * AND A/X5 = COMMAND WORD
  1358. MX0 48 SET FOR 12 BIT MASK
  1359. AX5 XCMNDL
  1360. BX2 -X0*X5 X2 = NUMBER OF ENTRIES IN TABLE
  1361. AX5 12
  1362. BX3 -X0*X5 X3 = RELATIVE START OF TABLE
  1363. SB2 B5+X3 B2 = ABSOLUTE START OF TABLE
  1364. MX0 58 MASK TO EXTRACT 2 BITS OF INFO
  1365. IX3 X1-X2 SEE IF NUMBER IN BOUNDS
  1366. NG X3,CUNIT2 JUMP IF OK
  1367. SX1 X2-1 ELSE SET FOR LAST ENTRY
  1368. CUNIT2 BX2 -X0*X1 X2 = INTRA-WORD POSITION
  1369. SB1 X1-1 B1 = -1 TO N-2
  1370. BX3 X2
  1371. LX2 4 *16
  1372. IX3 X2-X3 *15
  1373. SB3 X3 B3 = SHIFT COUNT
  1374. AX1 2 GET WORD BIAS (4-15 BIT PACKS/WORD)
  1375. SA3 X1+B2 X3 = PACKED WORD
  1376. LX5 X3,B3 POSITION CORRECT 15 BIT PACKAGE AT TOP
  1377. LX5 3 ONLY 12 BITS OF UNIT INFO
  1378. PL X5,CUNIT1A EXIT IF NORMAL UNIT
  1379. *
  1380. MX0 12
  1381. BX3 X0*X5 MASK OFF UNIT NUMBER
  1382. LX3 12
  1383. SX0 X3-UNXNUM
  1384. ZR X0,PROCESS JUMP IF SPECIAL UNIT -X-
  1385. SX0 X3-UNQNUM
  1386. NZ X0,CUNIT1A EXIT IF NOT UNIT -Q-
  1387. *
  1388. MX5 0 CLEAR UNIT NUMBER
  1389. EQ CUNIT1A
  1390. *
  1391. *
  1392. * /--- BLOCK JLPACK 00 000 76/05/14 03.08
  1393. TITLE JLPACK
  1394. *
  1395. * PACK UP JOIN LIST INFO INTO X6
  1396. *
  1397. ENTRY JLPACK
  1398. *
  1399. JLPACK EQ *
  1400. SA4 ILESUN LESSON AND UNIT NUMBERS
  1401. LX4 12
  1402. SB1 A5
  1403. SX3 B5-B1 COMMAND BIAS
  1404. BX6 X3+X4 COMBINE
  1405. PL X6,JLPACK --- RETURN IF ALL OK
  1406. SA1 333333B /// ELSE BOMB OFF ///
  1407. * /--- BLOCK UNJOIN 00 000 80/08/09 02.18
  1408. TITLE UNJOIN
  1409. *
  1410. *
  1411. * BACK OUT OF ONE JOIN
  1412. *
  1413. ENTRY UNJOIN
  1414. *
  1415. UNJOIN SA1 JOIN GET JOIN COUNT
  1416. SX6 X1-1 SUBTRACT ONE
  1417. SA6 A1 AND PUT BACK
  1418. SA4 JOINL+X6 GET LIST WORD
  1419. *
  1420. *
  1421. * UNJOIN USING CONTENTS OF X4
  1422. *
  1423. ENTRY UNJOIN1
  1424. *
  1425. UNJOIN1 MX0 48
  1426. BX3 -X0*X4 PICK OFF COMMAND BIAS
  1427. SB3 X3 FOR UNITGOB
  1428. LX4 12 SHIFT OFF CONDITIONAL INDEX
  1429. AX4 24 AND COMMAND BIAS
  1430. BX6 X4
  1431. SA6 ILESUN CURRENT LESSON POINTER
  1432. *
  1433. * SET LOCAL VAR POP FLAG IN STUDENT BANK
  1434. *
  1435. SA4 TLVLESS LOCAL VAR LESSON + SP
  1436. ZR X4,UNITGOB IF NO LOCALS
  1437. *
  1438. MX0 1 SIGN BIT = POP FLAG
  1439. BX6 X0+X4 ADD FLAG TO WORD
  1440. SA6 A4 STORE IN STUDENT BANK
  1441. EQ UNITGOB GO EXECUTE TUTOR UNIT WITH B3 SET
  1442. *
  1443. ENTRY UNJXX
  1444. UNJXX BSS 1
  1445. * /--- BLOCK STORE 00 000 80/04/22 00.59
  1446. TITLE STORE (AND STOREU)
  1447. * -STORE- (CODE=10) AND -STOREU-
  1448. *
  1449. USTORE BSS 1 SAVE SECOND ARG OF STOREU
  1450. *
  1451. STORE SA1 XSLCLOK SAVE TIME ON ENTRY
  1452. BX6 X1
  1453. SA6 STORTIM
  1454. BX7 X5
  1455. LX7 XCODEL SECOND ARG AT TOP
  1456. MX6 XCODEL
  1457. BX7 X6*X7 SAVE SECOND ARG
  1458. SA7 USTORE
  1459. SA1 JJSTORE CHECK WHETHER STUDENT ANS ALREADY COMPILED
  1460. PL X1,STREADY JUMP IF ALREADY COMPILED
  1461. SX1 X1+1 JJSTORE=-1 IF NOT COMPILED
  1462. ZR X1,STORE1
  1463. * JJSTORE = -2 MEANS STUDENT ANS WILL NOT COMPILE.
  1464. * FORMOK CONTAINS WHATEVER WAS LEFT IN IT FROM LAST
  1465. * COMPILATION ATTEMPT.
  1466. STORNO SB7 XANSC PUT INTO ANSWER CONTINGENCY
  1467. SX7 1
  1468. SA7 TJUDGED SET JUDGMENT=NO (UNIVERSAL)
  1469. MX7 0 SET ANSCNT=0
  1470. SA7 TANSCNT
  1471. EQ PROCESS
  1472. STORE1 SX7 JUDGE INITIALIZE STRING ADDRESS
  1473. SA7 WORDPT
  1474. MX7 0 ZERO INX TO BEGIN EXTRA STORAGE IN INFO
  1475. SA7 INX
  1476. *
  1477. EXT GETNDFU
  1478. *
  1479. RJ GETNDFU GET NDEFU INITIALIZED
  1480. SA1 NDEFU
  1481. SX7 -2 NO UNIT DIMENSIONS
  1482. ZR X1,STORE1B JUMP IF NO UNITS
  1483. SX7 -1 KEEP TRACK OF UNIT DIMENSIONS
  1484. STORE1B SA7 NUNITS
  1485. CALL QUIKCMP GENERATE MACHINE CODE IN INFO
  1486. * GETVAR CODE RETURNED IN X1
  1487. * WILL EXIT THROUGH -CALCERR- IF COMPILATION ERROR
  1488. * LEX CALLS POSTOR TO RESTORE PRESENT UNIT IF STUDENT
  1489. * DEFINE SET WAS BROUGHT INTO CM
  1490. BX7 X1 SAVE GETVAR CODE FOR POSSIBLE RE-USE
  1491. SA7 JJSTORE
  1492. SA5 A5 RESTORE X5
  1493. * /--- BLOCK STORE 00 000 80/04/22 00.58
  1494. STREADY SA2 USTORE CHECK FOR -STOREU- COMMAND
  1495. ZR X2,STREDY2
  1496. BX5 X2
  1497. FGETVAR SET A1 TO STOREU ARRAY
  1498. SA0 UADS
  1499. SA2 ATEMPEC
  1500. BX0 X2
  1501. SA2 NDEFU LENGTH OF UNITS ARRAY
  1502. SB3 X2
  1503. + WE B3
  1504. RJ ECSPRTY
  1505. SA0 A1
  1506. SX1 B3 LENGTH TO CHECK
  1507. RJ BOUNDS USES B1 AND B2
  1508. + RE B3
  1509. RJ ECSPRTY
  1510. SA5 A5 RESTORE X5
  1511. STREDY2 SA1 JJSTORE
  1512. LX5 XFBIT I/F BIT OF -GETVAR- CODE TO TOP
  1513. BX2 X5 PRESERVE IN X2 FOR LATER TEST
  1514. LX1 60-XCODEL LEFT-ADJUST -GETVAR- CODE
  1515. BX5 X1 MOVE TO REQUIRED X5
  1516. SB1 A5
  1517. SX7 B5-B1 SAVE COMMAND BIAS
  1518. SA7 OLDB5
  1519. MX7 59 FORM -1
  1520. SA7 TFORMOK SET OK--WILL BE SET ZERO IF EXEC ERROR
  1521. SB5 INFO SET UP B5 FOR EXTRA STORAGE IN INFO
  1522. NG X2,FLTSTOR JUMP IF FLOATING POINT
  1523. NGETVAR ROUND TO INTEGER
  1524. BX7 X1
  1525. SA7 STORVAL SAVE RESULT
  1526. RJ POSTOR2
  1527. SA1 STORVAL
  1528. BX6 X1
  1529. NPUTVAR STORE
  1530. EQ STOTIME
  1531. *
  1532. FLTSTOR FGETVAR EVALUATE STUDENT EXPRESSION
  1533. BX7 X1 VALUE RETURNED IN X1
  1534. SA7 STORVAL SAVE VALUE
  1535. RJ POSTOR2
  1536. SA1 STORVAL
  1537. BX6 X1
  1538. FPUTVAR STORE
  1539. STOTIME SA1 XSLCLOK SEE IF TOO MUCH PROCESSING GOING ON
  1540. SA2 STORTIM
  1541. IX2 X1-X2 COMPUTE TIME REQ TO COMPILE
  1542. SX7 30 MAXIMUM ELAPSED TIME
  1543. PX7 X7 FLOAT IT
  1544. NX7 X7
  1545. SA1 CPSPD SCALE BY CPU-SPEED FACTOR
  1546. FX1 X7/X1
  1547. UX1,B1 X1
  1548. LX1 B1
  1549. IX2 X2-X1
  1550. NG X2,PROCESS IF LESS THAN 30 MILLISECONDS
  1551. SX7 16
  1552. SA7 TFORMOK TIME-SLICE ERROR, LONG COMPILE
  1553. EQ STORNO
  1554. *
  1555. STORTIM BSS 1
  1556. *
  1557. *
  1558. * /--- BLOCK POSTOR 00 000 77/07/20 12.31
  1559. *
  1560. * -POSTOR-
  1561. * USED TO RESTORE A5 - B5 AFTER COMPILATION
  1562. *
  1563. ENTRY POSTOR
  1564. *
  1565. POSTOR EQ *
  1566. SA5 ILESUN LOAD LESSON/UNIT NUMBERS
  1567. CALL GETUNIT
  1568. SA1 OLDB5 LOAD COMMAND BIAS
  1569. MX6 59 -1
  1570. SA6 A1
  1571. SB1 X1
  1572. SA5 B5-B1 RELOAD COMMAND WORD
  1573. EQ POSTOR
  1574. *
  1575. POSTOR2 EQ * RESTORE X5/B5'; UNIT ALREADY IN
  1576. SA1 OLDB5 LOAD COMMAND BIAS
  1577. MX6 59 -1
  1578. SA6 A1
  1579. SA5 A5 RESTORE X5
  1580. SB5 X1
  1581. SB5 A5+B5
  1582. EQ POSTOR2
  1583. *
  1584. *
  1585. *
  1586. EXECSAV BSS 1
  1587. *
  1588. *
  1589. ENTRY CSPREAD ALSO USED BY -COMPUTE-
  1590. *
  1591. CSPREAD EQ * STRING STARTS AT A0, CHAR COUNT IN X1
  1592. *CHECK STRING BOUNDS AND SPREAD PACKED CHARS INTO SHOWOUT
  1593. SX2 CSPWDS+1 ALLOW 100 CHARS
  1594. IX2 X1-X2 CHECK FOR POSSIBLE SHOW BUFFER OVERFLOW
  1595. PL X2,CSERXMX 101 SPREAD CHARS IS TOO MUCH
  1596. * EXECERR USES X1
  1597. RJ WORDS CHECK STORE BOUNDS
  1598. SB3 X1 END CHECK
  1599. SB1 1
  1600. SA1 A0-B1 INITIALIZE READING REGISTER
  1601. SA7 SHOWOUT-1 INITIALIZE WRITING REGISTER
  1602. MX0 54 MASK FOR CHAR
  1603. STORA0 SB2 10 CHARS PER WORD
  1604. SA1 A1+B1 GET NEXT WORD
  1605. STORA1 LX1 6 RIGHT-ADJUST NEXT CHAR
  1606. BX7 -X0*X1 PICK OUT CHAR
  1607. SA7 A7+B1 ADD CHAR TO BUFFER
  1608. SB3 B3-B1 COUNT CHARACTERS
  1609. ZR B3,STORA2
  1610. SB2 B2-B1 COUNT CHARS PER WORD
  1611. NZ B2,STORA1
  1612. EQ STORA0 GET NEXT WORD
  1613. STORA2 MX7 0 TERMINATE WITH 0 CHAR----END OF LINE
  1614. SA7 A7+B1
  1615. SX7 SHOWOUT INITIALIZE WORDPT
  1616. SA7 WORDPT
  1617. EQ CSPREAD
  1618. *
  1619. CSERXMX SX2 CSPWDS MAXIMUM LIMIT
  1620. EQ ERXMXLC MAXIMUM CHAR LIMIT EXCEEDED
  1621. *
  1622. STORVAL BSS 1 STUDENT RESULT TO STORE
  1623. CSPWDS EQU 100 NUMBER OF CHARS MAX
  1624. *
  1625. *
  1626. * /--- BLOCK ARROW 00 000 76/07/24 21.53
  1627. TITLE ARROW AND ARROW(F)
  1628. * -ARROW- (CODE=11)
  1629. *
  1630. * SINGLE VARIABLE (ROW-COLUMN POSITION) ARROW.
  1631. * SETS STARTING SCREEN POSITION FOR ENTRY OF
  1632. * STUDENT ANSWER AND INITIALIZES ANSWER STORAGE
  1633. * POINTERS.
  1634. *
  1635. *
  1636. *
  1637. ARROWX SA1 THELPF CHECK IF IN ON-PAGE HELP STATE
  1638. ZR X1,AWX1
  1639. RJ ARROWUH
  1640. AWX1 NGETVAR ROUNDS TO INTEGER IN X1
  1641. RJ RCTOXY GET INTO X AND Y
  1642. ARROWXX MX0 -9 FORCE LEGAL SCREEN POSITION
  1643. BX6 -X0*X6
  1644. BX7 -X0*X7
  1645. LX6 9
  1646. BX7 X6+X7 PACK UP THIS X AND Y
  1647. OUTCODE WFCODE OUTPUT WHERE
  1648. MX2 1 SET TOP BIT -- NOT PLOTTED
  1649. BX7 X7+X2
  1650. SA1 TBARROW SEE IF ANY PRIOR ARROW TO ERASE
  1651. SA7 A1 SET FINE GRID ARROW POSITION
  1652. ZR X1,ARR25 IF ZERO, THIS IS FIRST ARROW
  1653. SA3 INHIBS READ THE INHIBIT FLAG WORD
  1654. LX3 ARRSHIF SHIFT IT TO THE SIGN BIT
  1655. NG X3,ARR25 DONT BOTHER IF NO ARROW PLOTTED
  1656. OUTCODE WFCODE OUTPUT WHERE
  1657. OUTARR E ERASE ARROW
  1658. * /--- BLOCK ARROW 00 000 80/08/04 22.56
  1659. *
  1660. ARR25 SA5 A5 GET COMMAND
  1661. MX2 -XCMNDL
  1662. BX2 -X2*X5
  1663. MX1 60 SET TO ARROWA
  1664. SX2 X2-ARROWA=
  1665. ZR X2,ARR26 IF ARROWA
  1666. SX2 X2-1
  1667. ZR X2,ARR26 IF ARROWA FINE GIRD
  1668. MX1 0 FOR NORMAL ARROW
  1669. ARR26 SA2 TBITS BIT IN TBITS
  1670. MX6 1
  1671. LX6 -ARRTPBT SET TYPE OF ARROW BIT(1=ARROWA)
  1672. BX1 X1*X6 PICK BIT
  1673. BX2 -X6*X2 CLEAR BIT
  1674. BX6 X1+X2
  1675. SA6 A2
  1676.  
  1677. SB7 XARROWC SET TO ARROW-C
  1678. SA1 TBITS
  1679. MX6 1
  1680. LX6 -JUDGBIT
  1681. BX6 -X6*X1 JUDGING BIT = 0 FOR ARROW
  1682. SA6 A1
  1683. SA1 RSIZE SAVE SIZE
  1684. SA2 ROTATE AND ROTATE
  1685. BX6 X1
  1686. BX7 X2
  1687. SA6 TBSIZE
  1688. SA7 TBROTATE
  1689. SA3 TBEDIT CLEAR ANY EDIT FEATURE
  1690. MX6 36+1
  1691. LX6 36
  1692. BX6 -X6*X3
  1693. SA6 A3
  1694. NZ X6,ARROWED JUMP IF EDIT BUFFER ALREADY SET
  1695. SX6 ANSINF+ANSLIM/2 MIDDLE OF ANS BUFFER
  1696. LX6 36
  1697. SA6 A3 INITIALIZE TBEDIT
  1698. ARROWED MX6 0 CLEAR COPY OPTION
  1699. MX0 2
  1700. SA6 TBCOPY
  1701. SA6 TJKEYS CLEAR JKEY SPECIFICATIONS
  1702. SA6 TWCOUNT CLEAR WORD COUNT
  1703. SA6 TBLDATA+1 CLEAR DATA FLAGS
  1704. SA3 TBMICRO CLEAR MICRO SWITCHES
  1705. BX6 -X0*X3
  1706. SA6 A3
  1707. * /--- BLOCK ARROWEXT 00 000 78/12/18 21.20
  1708. *
  1709. *
  1710. CLRFBIT ENABLT TOUCH
  1711. *
  1712. * SAVE JOIN STRUCTURE AT ARROW
  1713. *
  1714. RJ JLPACK PACK UP JOIN INFO IN X6
  1715. SB1 1 B1 = CONSTANT 1
  1716. SA1 JOIN
  1717. SX0 X1-JOINLTH CHECK IF TOO DEEP IN JOINS
  1718. PL X0,ERXJOIN --- ERROR EXIT
  1719. SA6 AJOIN+1+X1 STORE AWAY THIS JOIN (THE ARROW)
  1720. SB2 X1 B2 = CURRENT JOIN DEPTH
  1721. SX6 X1+B1 INCREMENT JOIN COUNT BY 1
  1722. SA6 AJOIN AND STORE AWAY THE NEW JOIN COUNT
  1723. ZR B2,AJDN DONE IF NO OTHER JOINS
  1724. AJSAVE SA1 A1+B1 BRING UP NEXT JOIN WORD
  1725. BX6 X1
  1726. SA6 A6+B1 STORE IN ARROW JOIN WORD
  1727. SB2 B2-B1
  1728. NZ B2,AJSAVE
  1729. EQ AJDN
  1730. *
  1731. SX7 X1+B1 ADD ONE TO JOIN COUNTER
  1732. SA7 A1 STORE NEW COUNT
  1733. SA7 AJOIN SET ARROW JOIN MARKER
  1734. SA6 JOIN+X7 SAVE THE JOIN INFO FOR ARROW
  1735. *
  1736. AJDN SA1 TLVLESS SEE IF LOCAL VAR LESSON
  1737. ZR X1,AJDN5 IF NO LOCAL VARS
  1738. *
  1739. SX6 X1 SAVE LOCAL VARIABLE SP
  1740. SA2 LVUCNT X2 = LVARS IN ARROW UNIT
  1741. IX6 X6+X2
  1742. SA1 AJOIN WITH ARROW JOIN SP
  1743. LX6 18
  1744. BX6 X6+X1
  1745. SA6 A1
  1746. MX6 0 PSEUDO MAIN UNIT
  1747. SA6 JOIN
  1748. AJDN5 SX6 MAXLONG/2 HALF MAX LONG TO ALLOW EDIT
  1749. SA6 LIMIT
  1750. SX6 ANSINF SET TO POINT TO ANSWER BUFFER
  1751. SA6 TBINPUT
  1752. SX6 0
  1753. SA6 LONG SET INPUT TO ZERO
  1754. SA6 TBANSWT MARK NO ANS-C WRITING
  1755. SA6 THELPWT MARK NO ON-PAGE-HELP WRITING
  1756. SX7 2
  1757. SA7 TJUDGED SET JUDGMENT=UNJUDGED
  1758. *
  1759. ZERO ANSINF,ANSLIM ZERO ANSWER BUFFER
  1760. CALL AREAINC,0,0 **** DATA ****
  1761. SA1 THELPF
  1762. NZ X1,ARR40 JUMP IF IN ON-PAGE-HELP
  1763. MX6 18
  1764. SA2 TBNARGS CLEAR OUT -PHELP- COUNTER
  1765. BX6 -X6*X2
  1766. SA6 A2
  1767. * /--- BLOCK ARROW 00 000 77/03/19 20.35
  1768. *
  1769. ARR40 SA2 CLRBITS CLEAR VARIOUS BITS IN TBITS
  1770. SA1 TBITS
  1771. BX6 -X2*X1
  1772. SA6 A1
  1773. SA1 TBARROW ALL NORMAL ARROWS ARE PLOTTED
  1774. SA2 TBWRITE
  1775. MX3 -18
  1776. BX6 X3*X2 CLEAR OLD MARGIN
  1777. BX6 X1+X6 SET NEW MARGIN
  1778. SA6 A2
  1779. OUTP WFCODE HERE. SYSTEM ARROWS USE ARRPLT
  1780. SA1 TBARROW GET ARROW COORDINATES
  1781. MX3 -9
  1782. BX7 -X3*X1 PICK NY
  1783. AX1 9
  1784. BX6 -X3*X1 PICK NX
  1785. SA6 TBMARG SET MARGIN
  1786. NG X2,ARR42
  1787. SX6 X6+10B IF PLOTTING ARROW
  1788. BX6 -X3*X6
  1789. ARR42 SA6 NX UPDATE NX, NY
  1790. SA7 NY
  1791. SA2 INHIBS
  1792. LX2 ARRSHIF CHECK INHIBIT ARROW BIT
  1793. PL X2,PROCESS IF ARROW NOT INHIBITED
  1794.  
  1795. * CLEAR ARROW PLOT BECAUSE OF -INHIBIT ARROW-
  1796.  
  1797. SA1 TBARROW GET -ARROW- INFO
  1798. MX0 1 SET UP FOR NEGATIVE MASK
  1799. BX7 -X0*X1 CLEAR ',PLOT', FLAG
  1800. SA7 A1 SAVE IT
  1801. EQ PROCESS CONTINUE
  1802.  
  1803. * BITS TO CLEAR IARROW, IARROWA, AND QUIT IN TBITS
  1804. * -CLRBITS- TELLS WHICH OF THE BITS OF -TBITS-
  1805. * ARE TO BE CLEARED AT EACH NEW ARROW.
  1806.  
  1807. CLRBITS BSS 0
  1808. POS 60-IARRBIT
  1809. VFD 1/1 SET IARRBIT
  1810. POS 60-QUITBIT
  1811. VFD 1/1 SET QUIT BIT
  1812. * POS 60-MTABBIT
  1813. * VFD 1/1 CLEAR MICRO-TAB BIT
  1814. POS 0
  1815. BSS 0 FORCE WORD OUT
  1816. * /--- BLOCK ARROWFX 00 000 78/02/14 11.07
  1817. *
  1818. *
  1819. * -ARROW(F)- (CODE=12)
  1820. *
  1821. * TWO VARIABLE (FINE GRID) ARROW.
  1822. *
  1823. *
  1824. ARROWFX SA1 THELPF CHECK IF IN ON-PAGE HELP STATE
  1825. ZR X1,AWX2
  1826. RJ ARROWUH
  1827. AWX2 RJ GET2 GET X AND Y
  1828. EQ ARROWXX
  1829. *
  1830. *
  1831. *
  1832. ARROWUH EQ *
  1833. BX2 X1 CHECK IF ALREADY ANOTHER ARROW
  1834. LX2 2
  1835. NG X2,ARROWUH EXIT IF WAS ANOTHER
  1836. MX6 1
  1837. LX6 58 POSITION ARROW ENCOUNTERED BIT
  1838. BX6 X1+X6
  1839. SA6 A1 MARK ARROW ENCOUNTERED
  1840. MX6 0
  1841. SA6 TBANSWT MARK NO ANS-C WRITING
  1842. SA6 THELPWT MARK NO ON-PAGE-HELP WRITING
  1843. SA1 TBARROW
  1844. ZR X1,ARROWUH
  1845. SA1 NX SAVE CURRENT X/Y POSITION
  1846. LX1 18
  1847. SA2 NY
  1848. BX6 X1+X2
  1849. SA6 TBINTSV+5
  1850. CALL OFFIT ERASE ANSWER MARK-UP
  1851. SA5 A5
  1852. SA1 RSIZE SEE IF LARGE SIZE CHARACTERS
  1853. NZ X1,AWUH100
  1854. CALL WIPE
  1855. CALL OFFOKNO ERASE OK OR NO
  1856. EQ AWUH200
  1857. *
  1858. AWUH100 SA2 ARROWUH
  1859. BX6 X2 SAVE RETURN ADDRESS
  1860. * TBINTSV+0 - TBINTSV+3 ARE RESERVED FOR -LWIPE-
  1861. SA6 TBINTSV+4
  1862. CALL LWIPE
  1863. SA1 TBINTSV+4 RESTORE RETURN ADDRESS
  1864. BX6 X1
  1865. SA6 ARROWUH
  1866. *
  1867. AWUH200 SA1 TBINTSV+5 LOAD NX/NY
  1868. MX0 -9
  1869. BX6 -X0*X1 RESTORE NY
  1870. SA6 NY
  1871. AX1 18
  1872. BX6 -X0*X1
  1873. SA6 NX RESTORE NX
  1874. EQ ARROWUH
  1875. *
  1876. *
  1877. ACHARA TITLE SET THE ARROW CHARACTER FOR -ARROWA-
  1878. *
  1879. * NAME OF COMMAND HAS BEEN CHANGED TO -ARHEADA-
  1880. *
  1881. * SET UP USER ARROW CHARACTER FOR ARROWA
  1882. *
  1883. *
  1884.  
  1885.  
  1886.  
  1887. ACHARAX AX5 XCMNDL GET BIAS
  1888. SA1 B5+X5
  1889. MX0 30
  1890. SA2 ARRCHRS UPPER 30 BITS FOR NORMAL ARROW
  1891. * LX1 30 POSITION FIRST 5 CHARS LOWER
  1892. BX6 X0*X2 PICK NORMAL ARROW
  1893. BX1 -X0*X1 CLEAN UP USER ARROW
  1894. BX6 X1+X6
  1895. SA6 A2
  1896. EQ PROCESS
  1897. * /--- BLOCK JARROW 00 000 80/08/04 20.22
  1898. TITLE JARROW
  1899. *
  1900. * JARROW
  1901. *
  1902. * 'MARKER FOR INITIATING JUDGING WITHOUT AN
  1903. * ARROW.
  1904. *
  1905. JARROWX CALL NOJBUF MAKE SURE DO NOT HAVE ECS JUDGE BUF
  1906. *
  1907. INTLOK X,I.JUDG,W
  1908. SA1 AJBSTAT (X1) = EM FWA OF JBUFF STATS
  1909. BX0 X1
  1910. SA0 JBUFCNT
  1911. + RE 4
  1912. RJ ECSPRTY
  1913. SA2 A0 NUMBER JUDGE BUFFERS IN USE
  1914. SX1 JBANKS MAXIMUM POSSIBLE
  1915. IX2 X2-X1
  1916. NG X2,JARR1 IF ONE LEFT
  1917. SA1 JMAXCNT UP OVERFLOW COUNT
  1918. SX6 1
  1919. IX6 X1+X6
  1920. SA6 A1
  1921. + WE 4
  1922. RJ ECSPRTY
  1923. INTCLR X,I.JUDG
  1924. EQ RETRNZ RE-DO COMMAND A LITTLE LATER
  1925. *
  1926. JARR1 BSS 0
  1927. INTCLR X,I.JUDG
  1928. SX6 0
  1929. SA6 TBARROW CLEAR SCREEN POSITION FOR ARROW
  1930. SA6 LONG GUARANTEE CHAR COUNT = 0
  1931. SA1 TBITS
  1932. MX6 1
  1933. LX6 -JUDGBIT
  1934. BX6 X1+X6 JUDGING BIT = 1 FOR JARROW
  1935. SA6 A1
  1936. *
  1937. * SAVE CURRENT SIZE AND ROTATE SO THAT THE RESTORE
  1938. * THAT OCCURS AT VARIOUS EXITS IS OK.
  1939. *
  1940. SA1 RSIZE
  1941. SA2 ROTATE
  1942. BX6 X1
  1943. BX7 X2
  1944. SA6 TBSIZE
  1945. SA7 TBROTATE
  1946. * /--- BLOCK JARROW 00 000 80/08/04 20.22
  1947. *
  1948. * SAVE CURRENT JOIN STRUCTURE (USE STACK FOR ARROW)
  1949. *
  1950. RJ JLPACK PACK UP JOIN INFO IN X6
  1951. SB1 1 B1 = CONSTANT 1
  1952. SA1 JOIN
  1953. SX0 X1-JOINLTH CHECK IF TOO DEEP IN JOINS
  1954. PL X0,ERXJOIN --- ERROR EXIT
  1955. *
  1956. SA6 AJOIN+1+X1 STORE AWAY INFO (THE JARROW)
  1957. SB2 X1 B2 = CURRENT JOIN COUNT
  1958. SX6 X1+B1 INCREMENT JOIN COUNT BY 1
  1959. SA6 AJOIN STORE THE NEW JOIN COUNT
  1960. ZR B2,JAGO --- GO ON LIKE REJUDGE
  1961. MX7 0
  1962. SA7 A1 CLEAR CURRENT JOIN COUNT
  1963. JSAVE SA1 A1+B1
  1964. BX6 X1
  1965. SA6 A6+B1
  1966. SB2 B2-B1
  1967. NZ B2,JSAVE
  1968. EQ JAGO --- GO ON LIKE REJUDGE
  1969. *
  1970. SX7 X1+B1 ADD ONE TO JOIN COUNTER
  1971. SA7 A1 STORE NEW COUNT
  1972. SA7 AJOIN SET JARROW JOIN MARKER
  1973. SA6 JOIN+X7 SAVE THE JOIN INFO FOR JARROW
  1974. JAGO SA1 TLVLESS SEE IF LOCAL VARS LESSON
  1975. ZR X1,PJUDGOO --- GO ON LIKE REJUDGE
  1976. *
  1977. SX6 X1 SAVE LOCALS SP
  1978. SA2 LVUCNT X2 = LVARS IN ARROW UNIT
  1979. IX6 X6+X2
  1980. SA1 AJOIN WITH ARROW JOIN SP
  1981. LX6 18
  1982. BX6 X6+X1
  1983. SA6 A1
  1984. MX6 0 PSEUDO MAIN UNIT
  1985. SA6 JOIN
  1986. EQ PJUDGOO --- GO ON LIKE REJUDGE
  1987. * /--- BLOCK JARROW 00 000 77/08/19 00.52
  1988. *
  1989. * /--- BLOCK ENDARROW 00 000 79/06/06 02.32
  1990. TITLE ENDARROW
  1991. * ENDARROW (CODE=40)
  1992. *
  1993. * 'THE ONLY PROCESSING NEEDED HERE IS TO ERASE
  1994. * THE PREVIOUS ARROW, IF ANY, AND CLEAR SOME
  1995. * STATUS INFORMATION.
  1996. *
  1997. *
  1998. ENDARRX BSS 0
  1999.  
  2000. * END ARROW EXECUTION.
  2001.  
  2002. RJ EAE
  2003.  
  2004. EQ PROCESS EXIT
  2005.  
  2006. CIA SPACE 4,10
  2007. ** CIA - CHECK INHIBIT ARETURN.
  2008. *
  2009. * IF -INHIBIT ARETURN- BIT IS SET, END ARROW
  2010. * EXECUTION AND CONTINUE. OTHERWISE, PROCESS
  2011. * NORMALLY.
  2012. *
  2013. * ENTRY (X6) = NEXT EXECUTION ADDRESS IF INHIBIT
  2014. * ARROW IS IN EFFECT.
  2015.  
  2016. CIA BSS 0 ENTRY
  2017.  
  2018. * CHECK FOR -INHIBIT ARROW-.
  2019.  
  2020. SA1 INHIBS
  2021. LX1 ARETSHF
  2022. PL X1,ANSMARK IF NO -INHIBIT ARETURN-.
  2023.  
  2024. * END ARROW EXECUTION AND CONTUNUE.
  2025.  
  2026. SA6 CIAA SAVE RETURN ADDRESS
  2027.  
  2028. RJ EAE END ARROW EXECUTION
  2029.  
  2030. SA1 CIAA (X1) = NEXT ADDRESS
  2031. SB1 X1
  2032. JP B1 CONTINUE
  2033.  
  2034. CIAA BSS 1 RETURN ADDRESS
  2035.  
  2036.  
  2037. EAE SPACE 4,10
  2038. ** EAE - END ARROW EXECUTION.
  2039. *
  2040. * ERASE THE PREVIOUS ARROW AND CLEAR STATUS INFO.
  2041.  
  2042.  
  2043. EAE PS ENTRY / EXIT
  2044.  
  2045. SB7 XUNITC SET TO UNIT-C
  2046. CALL NOJBUF DROP JUDGE BUFFERS
  2047.  
  2048.  
  2049. * ERASE THE ARROW IF NECESSARY.
  2050.  
  2051. SA1 TBARROW
  2052. ZR X1,EAE1 IF NO ARROW TO ERASE
  2053.  
  2054. MX6 0
  2055. SA6 A1
  2056. SA3 INHIBS
  2057. LX3 ARRSHIF
  2058. NG X3,EAE1 IF NO ARROW TO ERASE
  2059.  
  2060. OUTCODE WFCODE
  2061. OUTARR E ERASE ARROW
  2062.  
  2063. * CLEAR STATUS INFORMATION.
  2064.  
  2065. EAE1 SX6 0
  2066. SA6 TBANSWT CLEAR ANS-C ERASE
  2067. SA1 TBLDATA+1
  2068. MX0 -9
  2069. BX6 -X0*X1
  2070. SA6 A1 CLEAR *NTRIES*
  2071. CLRFBIT ENABLT TOUCH
  2072.  
  2073. EQ EAE RETURN
  2074.  
  2075. * /--- BLOCK LONG/MARKU 00 000 81/02/28 20.29
  2076. TITLE -LONG-
  2077. * -LONG- (CODE=17)
  2078. *
  2079. LONGX NGETVAR ROUNDS TO INTEGER IN X1
  2080. NG X1,ERXBADL ERROR IF NEGATIVE
  2081. * EXECERR USES X1
  2082. BX7 X1
  2083. SA7 LIMIT
  2084. SX1 MAXLONG+1
  2085. IX1 X7-X1
  2086. PL X1,LERXMAX
  2087. * EXECERR USES X7, X1
  2088. SX1 MAXLONG/2+1
  2089. IX1 X7-X1
  2090. NG X1,PROC
  2091. SA1 TBEDIT LONG GT MAXLONG/2---CHECK FOR EDIT BUFFER
  2092. AX1 36 ADDRESS OF EDIT BUFFER
  2093. ZR X1,PROC
  2094. SB1 X1
  2095. SB2 STUDVAR
  2096. GE B1,B2,PROC
  2097. MX7 0 WAS IN ANS BUFFER, SO CLEAR
  2098. SA7 A1 TBEDIT=0
  2099. EQ PROC
  2100. *
  2101. LERXMAX BX1 X7
  2102. SX2 MAXLONG
  2103. EQ ERXMXLC
  2104. *
  2105. *
  2106. MARKUPY NGETVAR MARKUP-Y BIAS
  2107. MX6 48
  2108. BX6 -X6*X1 LIMIT TO BOTTOM 12 BITS
  2109. *
  2110. * SA6 TMARKUY RESET ERROR MARKUP BIAS
  2111. *
  2112. LX6 48 SHIFT TO TOP OF WORD
  2113. SA1 TBWHERE (X1)=12/MARKUP Y BIAS,48/OTHER
  2114. MX0 12
  2115. BX7 -X0*X1 CLEAR OUT OLD MARKUP Y BIAS
  2116. BX7 X6+X7 MERGE WITH NEW
  2117. SA7 A1 STORE
  2118. EQ PROC
  2119. * /--- BLOCK EXT 00 000 80/08/22 02.06
  2120. *
  2121. EXTMUCH EXECERR 124 TOO MANY -EXT-S IN FINISH UNIT
  2122. *
  2123. * CHECK IF WE ARE IN A FINISH UNIT. IF NOT,
  2124. * RETURN X2=0. OTHERWISE, INCREMENT -EXT-
  2125. * COUNT AND RETURN X2^=0. EXEC ERROR IF TOO
  2126. * MANY -EXT-S OR WHATEVER.
  2127. * THIS ROUTINE MAY NOT DESTROY X1.
  2128. *
  2129. ENTRY TESTFIN
  2130. TESTFIN PS
  2131. SA2 STFLAGS
  2132. MX0 1
  2133. LX0 FINBIT
  2134. BX2 X0*X2 TEST FINISH UNIT FLAG
  2135. ZR X2,TESTFIN --- IF NOT
  2136. SA2 AUTKEY
  2137. LX2 60-18-18-6 BRING -EXT- COUNT DOWN
  2138. MX0 -12
  2139. BX6 -X0*X2
  2140. SX6 X6+1 INCREMENT COUNT
  2141. BX2 X0*X2 CLEAR OLD COUNT
  2142. SX0 X6-21 CHECK AGAINST LIMIT OF 20
  2143. PL X0,EXTMUCH --- IF TOO MUCH
  2144. BX6 X6+X2 RECOMBINE STUFF
  2145. LX6 18+18+6 POSITION BACK
  2146. SA6 A2 STORE BACK
  2147. MX6 0
  2148. SA6 MOUTLOC DISCARD ANY PENDING OUTPUT
  2149. MX2 -1 FLAG FINISH UNIT
  2150. EQ TESTFIN
  2151. * /--- BLOCK CATCH/LOCK 00 000 79/08/18 19.00
  2152. TITLE -LOCK-
  2153. * -LOCK- (CODE=196)
  2154. * FIRST ARG....STATION NUMBER
  2155. * SECOND ARG...WORD TO STUFF INTO LOCK BUFFER
  2156. LOCKX RJ GET2 GET TWO ARGS
  2157. NG X1,ERXSTN STATION NUMBER IN X1,X6
  2158. * EXECERR USES X1
  2159. SX2 NUMSTAT
  2160. IX2 X1-X2
  2161. PL X2,ERXSTN
  2162. * EXECERR USES X1
  2163. SA7 ITEMP
  2164. SA2 ALOCK ADDRESS OF *LOCK* BUFFER
  2165. IX0 X1+X2
  2166. SA0 A7
  2167. + WE 1 REWRITE ENTRY
  2168. RJ ECSPRTY
  2169. EQ PROC
  2170. * /--- BLOCK CALCC 00 000 78/05/18 21.45
  2171. TITLE CALCC AND CALCS
  2172. * -CALCC- (CODE=34)
  2173. *
  2174. * CONDITIONAL CALC. COMMA SEPARATED EXPRESSIONS
  2175. * ARE COMPUTATIONS.
  2176. *
  2177. CALCC LX5 XCODEL GET 2ND PACKAGE
  2178. NGETVAR 1
  2179. SX6 X1+3 BIAS PROPERLY
  2180. SA6 ERXARGN SET EXECERR ARGUMENT NUMBER
  2181. SB2 -2 ARG. FOR CALCCJ
  2182. RJ CALCCJ ACQUIRE APPROPRIATE GTVAR CODE IN X5
  2183. NG X5,PROCESX EXIT IF NO-OP
  2184. FGETVAR DO CORRECT CALCULATION
  2185. EQ PROCESX
  2186. *
  2187. ILOC BSS 2 FOR TEMP USE BY ANY INDIVIDUAL COMMAND
  2188. *
  2189. *
  2190. * -CALCS- (CODE=35)
  2191. *
  2192. * COMMA SEPARATED EXPRESSIONS ARE (1) STORAGE
  2193. * VARIABLE AND THEREAFTER THE VALUES TO BE STORED
  2194. * IN THE VARIABLE.
  2195. *
  2196. CALCSX LX5 XCODEL GET 2ND PACKAGE
  2197. NGETVAR 1
  2198. SX6 X1+4 BIAS PROPERLY
  2199. SA6 ERXARGN SET EXECERR ARGUMENT NUMBER
  2200. SB2 -1 ARG. FOR CALCCJ
  2201. RJ CALCCJ ACQUIRE GETVAR CODE
  2202. NG X5,PROCESX EXIT IF NO-OP
  2203. SA4 A5 RESTORE COMMAND WORD
  2204. AX4 XCMNDL
  2205. MX2 2*XCODEL+XCMNDL
  2206. BX2 -X2*X4
  2207. SA4 X2+B5 GET FIRST XSTO WORD
  2208. BX6 X4
  2209. SA6 ILOC SAVE STORAGE ADDRESS GETVAR CODE
  2210. LX4 XFBIT CHECK FOR STORE INTO I OR F VARIABLE
  2211. PL X4,IGVAR JUMP IF INTEGER STORE
  2212. FGETVAR GET ADR OF WHERE TO STORE RESULT
  2213. EQ IGVAR2
  2214. *
  2215. IGVAR NGETVAR GET ROUNDED RESULT
  2216. IGVAR2 SA2 ILOC GET STORAGE GETVAR CODE
  2217. BX5 X2
  2218. LX2 XFBIT POSITION I/F BIT
  2219. BX6 X1
  2220. NG X2,IGVARF JUMP IF FLOATING POINT
  2221. NPUTVAR 2 STORE
  2222. EQ PROCESX
  2223. *
  2224. IGVARF FPUTVAR
  2225. EQ PROCESX
  2226. *
  2227. *
  2228. * SUBROUTINE FOR CALCS AND CALCC COMMANDS
  2229. *
  2230. * SET B2=-1 FOR CALCS COMMAND
  2231. * SET B2=-2 FOR CALCC COMMAND
  2232. * SET X1= VALUE OF CONDITIONAL VAR
  2233. *
  2234. * DOES CORRECT CONDITIONAL CALC AND RETURNS RESULT IN X1
  2235. *
  2236. * COMMAND WORD CONTAINS ARGUMENT COUNT (XCODEL BITS),
  2237. * CONDITIONAL VAR (XCODEL BITS),
  2238. * EXTRA STORAGE POINTER (60-2*XCODEL-XCMNDL BITS), AND
  2239. * THE COMMAND NO. (XCMNDL BITS).
  2240. *
  2241. *
  2242. * ****NOTE**** READIN MUST GUARANTEE AT LEAST
  2243. * 2 VARS FOR CALCC, 3 FOR CALCS.
  2244. *
  2245. * /--- BLOCK CALCCJ 00 000 76/05/17 20.58
  2246. CALCCJ EQ *
  2247. MX2 0
  2248. IX1 X1+X2 TREAT -0 AS +0
  2249. SA5 A5
  2250. AX5 XCMNDL SHIFT OUT COMMAND NO.
  2251. MX2 2*XCODEL+XCMNDL
  2252. BX2 -X2*X5 X2 HOLDS X-STO POINTER
  2253. SB1 1 B1 HOLDS INCREMENT OF 1
  2254. NG X1,CALCCJA USE FIRST X-STO WORD IF NEG.
  2255. SB3 -3 B3 HOLDS INCREMENT OF -3
  2256. SB2 B2+B1 B2 HOLDS -1 FOR CALCC, 0 FOR CALCS
  2257. SX4 B2
  2258. AX5 60-XCODEL-XCMNDL GET NO. OF VARS
  2259. IX5 X5-X4
  2260. SX5 X5-4 X5 HOLDS END TEST VALUE
  2261. + IX4 X5-X1 TEST IF PAST MAXIMUM
  2262. PL X4,*+1 JUMP IF CONDITIONAL VAR IS IN RANGE
  2263. BX1 X5 X1 HOLDS MAXIMUM VALUE
  2264. + SB2 B2+X1 B2 HOLDS WHICH VAR PACKAGE TO GET
  2265. LE B2,CALCCJA JUMP IF X2 HOLDS CORRECT X-STO POINTER
  2266. + SB2 B2+B3 DECREMENT BY 3
  2267. SX2 X2+B1 INCREMENT X-STO POINTER
  2268. GT B2,*
  2269. CALCCJA SA4 X2+B5 CORRECT X-STO WORD TO X4
  2270. NE B2,*+1 B2=0 IF THIRD PACKAGE NEEDED
  2271. LX4 2*XCODEL THIRD PACKAGE TO TOP OF X4
  2272. + SB2 B2+B1
  2273. NE B2,*+1 B2=-1 IF 2ND PACKAGE NEEDED
  2274. LX4 XCODEL SHIFT TO 2ND PACKAGE OF WORD
  2275. + BX5 X4 MOVE TO X5 FOR GETVAR
  2276. EQ CALCCJ RETURN WITH X5 SET DO CALL GETVAR
  2277. * /--- BLOCK LVCNTU 00 000 80/11/04 23.22
  2278. *
  2279. * -LVCNTU-
  2280. *
  2281. * RETRIEVE NUMBER OF LOCAL VARIABLES FROM ULOC
  2282. * ON ENTRY X4 = LESSON/UNIT
  2283. * ON EXIT X4 = NUMBER OF LOCAL VARS
  2284. *
  2285. * USES A/0,4,5
  2286. *
  2287. * -EXIT- PROCESSING DEPENDS ON X1 AND X2 NOT
  2288. * BEING CHANGED BY THIS ROUTINE.
  2289. *
  2290. ENTRY LVCNTU
  2291. LVCNTU EQ *
  2292. SX4 X4 UNIT INFO ONLY
  2293. SA5 ECSULOC GET ADDRESS OF -ULOC- TABLE
  2294. IX0 X4+X5 INDEX TO THIS UNIT
  2295. RX4 X0 (-RXX- 1 WD READ, MAY CHG *A4*)
  2296. AX4 60-ULOC1-ULOC2-ULOC3-ULOC4-ULOC5
  2297. MX0 -ULOC5
  2298. BX4 -X0*X4 GET NUMBER OF LOCALS IN UNIT
  2299. EQ LVCNTU
  2300. *
  2301. * /--- BLOCK ERASE 00 000 80/08/11 02.16
  2302. TITLE ERASE
  2303. * -ERASE- (CODE=36)
  2304. *
  2305. * -ERASE N1- ERASES N1 CHARS IF N1 +, NONE IF N1=0
  2306. * DOES FULL-SCREEN ERASE IF N1 IS NEGATIVE.
  2307. * -ERASE N1,N2- ERASES N1 CHARS ON NEXT N2 LINES
  2308. * -ERASE BLANK- PRODUCES FULL-SCREEN ERASE,
  2309. * -ERASE ABORT- DOES F.S. ERASE AND ALSO ABORTS
  2310. * OUTPUT PENDING IN MOUT BUFFER.
  2311. *
  2312. ERASEX NG X5,ERASEFS TAG EITHER BLANK OR -ABORT-
  2313. NGETVAR ROUNDS TO INTEGER IN X1
  2314. SX5 0 FLAG FOR NO ABORT OUTPUT
  2315. ZR X1,PROC --- IGNORE IF ZERO
  2316. NG X1,ERASEFS FS ERASE DONT ABORT OUTPUT
  2317. SA2 RSIZE
  2318. NZ X2,ERASEX2 IF NOT SIZE 0
  2319. BX6 X1
  2320. SA6 XDATA SAVE NUMBER OF SPACES
  2321. SA2 A5
  2322. LX2 XCODEL 2D ARG CODE AT LEFT
  2323. MX0 XCODEL
  2324. BX2 X0*X2 ISOLATE 2D ARG
  2325. NZ X2,ERASEY JUMP IF WAS A 2D ARGUMENT
  2326. LX1 3 SPACES * 8
  2327. SA3 NX CURRENT X POSITION
  2328. IX1 X1+X3 NEW X POSITION
  2329. SX2 X1-513 CHECK FOR OVERFLOW
  2330. MX1 0 SET LINE COUNT TO ZER
  2331. NG X2,ERASEY1 JUMP IF NO OVERFLOW
  2332. SA1 XDATA
  2333. *
  2334. ERASEX0 OUTCODE ERSCODE OUTPUT THE ERASE
  2335. EQ ERASEY2
  2336. *
  2337. * FULL SCREEN ERASE HAS +-0 TAG IN OUTPUT CODE
  2338. ERASEFS LX5 1 SECOND BIT SET IF ABORTS
  2339. AX5 59 EXTEND SIGN FOR ABORT FLAG
  2340. * SETXBIT EXTOFF UPDATE *STFLAGS* NO EXT INPUT
  2341. * CLEAR ENABLE TOUCH,PAUSE=TOUCH,PAUSE=EXT
  2342. CLRFBIT ENABLT,ENABLPT,ENABLPX
  2343. CALL DWECOLR RESET SBANK WE/COLOR TO DEFAULT
  2344. BX1 X5 -0 FOR ABORT, 0 FOR NO ABORT
  2345. EQ ERASEX0
  2346. *
  2347. ERASEX2 RJ TUERASE GO ERASE BIG CHARACTERS
  2348. EQ PROCO
  2349. *
  2350. ERASEY BX5 X2
  2351. NGETVAR X1_LINES
  2352. SX2 X1-1
  2353. NG X2,PROC IGNORE IF LINES < 1
  2354. SX2 X1-33
  2355. NG X2,ERASEY1 IF LINES>32
  2356. SX1 32 ONLY ERASE 32 LINES
  2357. ERASEY1 SA4 XDATA GET NUMBER OF SPACES
  2358. LX4 18 POSITION CHARACTER COUNT
  2359. BX1 X1+X4 COMBINE LINE AND CHAR. COUNTS
  2360. OUTCODE BERCODE ERASE SPACES IN 1ST TAG
  2361. *
  2362. ERASEY2 BSS 0
  2363. SA1 NX RESET TERMINAL TO ORIGINAL
  2364. SA2 NY POSITION.
  2365. LX1 9
  2366. BX1 X1+X2 COMBINE X,Y
  2367. OUTCODE WFCODE PUT CODE IN MOUT BUFFER.
  2368. EQ PROCO
  2369.  
  2370. * /--- BLOCK ERASE 00 000 79/04/23 01.21
  2371. *
  2372. * -DWECOLR-
  2373. *
  2374. * SET MODE TO WRITE AND OUTPUT CURRENT DEFAULT
  2375. * FOREGROUND AND BACKGROUND COLORS AS SPECIFIED
  2376. * IN STATION BANK LOCATION *COLORS*.
  2377. * J R SCHRAMM 83/03/04
  2378. *
  2379. ENTRY DWECOLR
  2380. DWECOLR EQ *
  2381. MX6 -3 FORM MASK FOR CURRENT MODE
  2382. LX6 6
  2383. SA1 TBNARGS
  2384. BX6 X6*X1 CLEAR OLD MODE
  2385. SX1 300B MODE WRITE
  2386. BX6 X6+X1
  2387. SA6 A1 STORE MODE WRITE IN *TBNARGS*
  2388. EQ DWECOLR -> EXIT
  2389.  
  2390. ENTRY OUTCOLR
  2391. OUTCOLR EQ *
  2392. *
  2393. * SEND COLORS TO COLOR TERMINAL
  2394. *
  2395. * ENTER'; X1 = COLORS -- 12/0,24/BGND COLOR,24/FGND COLOR
  2396. *
  2397. BX6 X1 (X6) = BGND/FGND COLORS
  2398. SA6 XCOLORS SAVE EXECUTOR COLOR SETTINGS
  2399. MX0 -24 COLOR MASK
  2400. BX1 -X0*X1 X1 = FOREGROUND COLOR
  2401. AX6 24D MOVE BGND COLOR TO LOW ORDER
  2402. BX3 -X0*X6 X3 = BACKGROUND COLOR
  2403. MX0 1
  2404. LX0 25D X0 = BACKGROUND FLAG
  2405. BX3 X0+X3 ADD COLOR + FLAG
  2406. OUTCODE RBGCODE SEND FOREGROUND (X3 PRESERVED)
  2407. BX1 X3 X1 = BACKGROUND COLOR
  2408. OUTCODE RBGCODE SEND BACKGROUND COLOR
  2409. EQ OUTCOLR -> EXIT
  2410.  
  2411. * /--- BLOCK DOT 00 000 77/06/06 20.54
  2412. *
  2413. * -DOT- (CODE=44)
  2414. *
  2415. * SINGLE VARIABLE (ROW-COLUMN POSITION) DOT.
  2416. *
  2417. DOTX NGETVAR ROUNDS TO INTEGER IN X1
  2418. RJ RCTOXY GET INTO X -Y FORMAT
  2419. BX1 X6
  2420. EQ DOTFXX
  2421. *
  2422. *
  2423. * /--- BLOCK PLOT, CHAR 00 000 79/01/19 19.45
  2424. * -DOT(F)- (CODE=45)
  2425. *
  2426. * TWO VARIABLE (FINE GRID) DOT.
  2427. *
  2428. DOTFX RJ GET2 GET VALUES OF 2 VARIABLES
  2429. **NXNY FIXED**
  2430. DOTFXX MX0 -9
  2431. BX1 -X0*X1
  2432. BX7 -X0*X7
  2433. SA6 NX UPDATE NX,NY
  2434. SA7 NY
  2435. LX1 9 SHIFT UP 9
  2436. BX1 X1+X7 COMBINE WITH Y
  2437. OUTCODE DFCODE
  2438. EQ PROCO
  2439. *
  2440. *
  2441. TITLE PLOT AND CHAR
  2442. * -PLOT- (CODE=260)
  2443. *
  2444. * THE TAG SPECIFIES THE NUMBER (0-127) OF THE LOADABLE
  2445. * CHARACTER TO BE PLOTTED. NUMBERS 0-62 REFERENCE CHARACTER
  2446. * MEMORY 2, 64-126 REFERENCE CHARACTER MEMORY 3.
  2447. *
  2448. * SPECIAL ADDITION--RWB
  2449. * NUMBERS 128-191 REFERENCE CHAR MEM 0
  2450. * NUMBERS 192-255 REFERENCE CHAR MEM 1
  2451. *
  2452. PLOTX NGETVAR ROUNDS TO INTEGER IN X1
  2453. BX2 X1
  2454. AX2 8 *** CHANGED TO 8 FROM 7-RWB
  2455. *** NOTE. IF YOU CHANGE THE 8 BITS, YOU WILL HAVE
  2456. *** TO CHANGE THE EXECUTION ERROR MESSAGE
  2457. NZ X2,PLERXLMT DO NOT ALLOW OVER 8 BITS
  2458. NG X2,PLERXLMT DO NOT ALLOW NEGATIVE VALUES
  2459. OUTCODE PLTCODE
  2460. SA1 NX UPDATE NX
  2461. SX2 8
  2462. IX1 X1+X2
  2463. MX7 51
  2464. BX7 -X7*X1 9-BIT NX
  2465. SA7 A1
  2466. EQ PROCO
  2467. **NXNY FIX NEEDED ABOVE**
  2468. *
  2469. PLERXLMT EXECERR 92 EXCEEDING 8 BIT LIMIT
  2470. *
  2471. *
  2472. * -CHAR- (CODE=48)
  2473. *
  2474. * LOAD CHARACTER INTO CHARACTER MEMORY.
  2475. *
  2476. CHARX SX6 9 NUMBER OF VARIABLES TO DECODE
  2477. RJ GETN GET 9 VALUES
  2478. SA4 VARBUF
  2479. X MTCHRV,1,X4 PROCESSING FOR PPT-TUTOR
  2480. SA1 VARBUF GET CHARACTER NUMBER
  2481. LX1 3 MULTIPLY BY 8 TO GET MEMORY ADDRESS
  2482. BX6 X1
  2483. SA6 A1
  2484. SB1 A1
  2485. SB2 VARBUF+1
  2486. RJ MEMOUT MEMORY LOAD REQUEST TO OUTPUT BUFFER
  2487. SA1 INHIBS
  2488. LX1 CCLRSHF SEE IF SHOULD CLEAR CHARSET FLAGS
  2489. NG X1,PROCO
  2490. SX6 0 FLAG NO CHARACTER SET LOADED
  2491. SA6 TBCSETA
  2492. SA6 TBCSET
  2493. SA6 TBCSET+1
  2494. EQ PROCO
  2495. * /--- BLOCK END,MODE 00 000 76/11/09 09.40
  2496. TITLE -END- -MODE-
  2497. *
  2498. *
  2499. * -END- (CODE=112)
  2500. *
  2501. ENDX NG X5,ENDLES JUMP IF END LESSON
  2502. SA1 TBASE SEE WHETHER IN HELP SEQUENCE
  2503. ZR X1,PROCESS IGNORE IF NOT IN HELP
  2504. BX6 X1 ELSE SET TBNEXT
  2505. SA6 TNEXT
  2506. EQ UNITJ
  2507. *
  2508. ENDLES SA1 ILESUN PRESENT LESSON AND UNIT POINTERS
  2509. MX0 42
  2510. BX6 X0*X1 LESSON NUMBER
  2511. SA6 TNEXT SET TO UNIT ZERO
  2512. MX0 5
  2513. SA2 TBSCORE
  2514. BX6 -X0*X2 CLEAR OUT OLD *LDONE* INFO
  2515. SX2 1 SET FOR -COMPLETED-
  2516. LX2 -5 PUT IN UPPER 5 BITS
  2517. BX2 X0*X2 LIMIT TO 5 BITS
  2518. BX6 X6+X2 ADD IN TO *TBSCORE*
  2519. SA6 TBSCORE
  2520. EQ UNITJ
  2521. *
  2522. *
  2523. * -MODE- (CODE=50)
  2524. *
  2525. * SELECTS TERMINAL WRITE/ERASE FUNCTION.
  2526. *
  2527. MODECX CALL GETTAG CONDITIONAL CASE, GET TAG
  2528. MODEX LX5 XJDGL TOP XJDGL BITS OF COMMAND WORD= W/E FUN.
  2529. MX0 60-XJDGL
  2530. BX1 -X0*X5
  2531. SX2 X1-7
  2532. PL X2,PROC --- EXIT IF -X- OPTION
  2533. *
  2534. SX2 X1-4 CHECK IF XOR MODE
  2535. NZ X2,MCWS0 NO, SO SKIP TERMINAL CHECK
  2536. SX0 X1 SAVE MODE VALUE
  2537. *
  2538. * TWINDOW USES X1 AND X2
  2539. *
  2540. RJ TWINDOW CHECK IF TERM SUPPORTS XOR
  2541. NZ X1,MCWS2 XOR OK
  2542. SX1 1 XOR NOT SUPPORTED, SET REWRITE
  2543. EQ MCWS0
  2544. MCWS2 SX1 X0 RESTORE X1
  2545. *
  2546. MCWS0 MX0 -3
  2547. LX0 6 POSITION MASK
  2548. SA2 TBNARGS
  2549. BX6 X0*X2 CLEAR OUT OLD MODE
  2550. BX2 X1
  2551. LX2 6 POSITION NEW TERMINAL MODE
  2552. BX6 X2+X6
  2553. SA6 A2 SAVE IN *TBNARGS*
  2554. OUTCODE WEFCODE
  2555. EQ PROCO
  2556. * /--- BLOCK INHIBIT 00 000 77/04/28 23.56
  2557. TITLE INHIBIT
  2558. * -INHIBIT- (CODE=66)
  2559. *
  2560. * INHIBITS CERTAIN STANDARD TUTOR FEATURES.
  2561. * (FULL SCREEN ERASE, ANS-C ERASE, SHOWING ARROW)
  2562. *
  2563. INHIBX MX0 -XCMNDL MASK OUT COMMAND NUMBER
  2564. BX5 X0*X5 RETAIN ONLY INHIBIT BITS
  2565. MX2 LNGSHIF-1 MASK FOR INHIBIT BITS ONLY
  2566. BX2 -X2
  2567. SA1 INHIBS READ UP THE OLD INHIBS FLAG WORD
  2568. SB2 ICLRSHIF CHECK CLEAR BEFORE SET
  2569. LX3 X5,B2
  2570. PL X3,INHIBX1
  2571. BX1 X2*X1 CLEAR FIRST
  2572. INHIBX1 BX6 X5+X1 COMBINE NEW WITH OLD FLAGS
  2573. NZ X5,INHIBX2 JUMP IF NON-BLANK INHIBIT
  2574. BX6 X2*X6 BLANK CLEARS INHIBIT OR FORCE BITS
  2575. INHIBX2 SA6 A1 PUT IT BACK IN INHIBS
  2576. EQ PROC
  2577. *
  2578. *
  2579. * -FORCE- COMMAND
  2580. *
  2581. * LIKE INHIBIT BUT IN A POSITIVE WAY
  2582. *
  2583. FORCEX MX0 -XCMNDL
  2584. BX5 X0*X5
  2585. LX5 -LNGSHIF TO ADJUST FOR MULTIPLE USE OF -INHIBS-
  2586. MX2 LNGSHIF-1 MASK FOR INHIBIT BITS ONLY
  2587. SA1 INHIBS READ UP THE OLD INHIBS FLAG WORD
  2588. SB2 FCLRSHIF CHECK CLEAR BEFORE SET
  2589. LX3 X5,B2
  2590. PL X3,INHIBX1
  2591. BX1 X2*X1 CLEAR FIRST
  2592. EQ INHIBX1
  2593. * /--- BLOCK STOREA 00 000 76/06/14 22.33
  2594. TITLE STOREA
  2595. * -STOREA- (CODE=68)
  2596. *
  2597. * STORES ALPHANUMERIC CHARACTER STRING FROM JUDGE BUFFER.
  2598. *
  2599. STOREAX NGETVAR GET STORAGE ADDRESS
  2600. SX6 A1 SAVE ADDRESS
  2601. SA6 EXECSAV
  2602. SA5 A5 RESTORE COMMAND WORD
  2603. LX5 XCODEL
  2604. NGETVAR X1 = NUMBER OF CHARS REQUESTED
  2605. ZR X1,PROCESS --- EXIT IF NO CHARS
  2606. SA2 EXECSAV
  2607. SA0 X2 PICK UP ADDRESS
  2608. RJ WORDS CHECK STORE BOUNDS
  2609. SB1 1
  2610. SB3 X1-1 CHARS-1
  2611. SA2 JUDGE-1 A2 = ADDRESS OF STUDENT CHARS
  2612. SA3 TJCOUNT X3 = COUNT OF STUDENT CHARS
  2613. SX6 0 (NEEDED IN CASE NO CHARS)
  2614. SB2 10 (NEEDED IN CASE NO CHARS)
  2615. ZR X3,STA3 JUMP IF NO STUDENT CHARS
  2616. BX1 -X1 X1 = -(CHARS REQUESTED)
  2617. IX4 X3+X1 X4 = STUDENT CHAR COUNT - CHARS REQUESTED
  2618. PL X4,STA2 JUMP IF STUDENT CHAR COUNT GREATER OR EQUAL
  2619. BX1 -X3 X1 = -(STUDENT CHAR COUNT)
  2620. STA1 SX6 0 CLEAR CHAR ACCUMULATING WORD
  2621. SB2 10 B2 = CHARS LEFT TO GO IN WORD
  2622. STA2 SA2 A2+B1 X2 = NEXT STUDENT CHAR
  2623. LX6 6
  2624. BX6 X6+X2
  2625. SB2 B2-B1 DECREMENT COUNT OF CHARS TO PUT IN WORD
  2626. SB3 B3-B1 DECREMENT COUNT OF CHARS REQUESTED
  2627. SX1 X1+B1 INCREMENT END TEST MARKER
  2628. PL X1,STA3 JUMP IF AT END
  2629. NZ B2,STA2 JUMP IF WORD NOT COMPLETE
  2630. SA6 A0 STORE PACKED CHARACTER STRING
  2631. SA0 A0+B1 INCREMENT STORAGE ADDRESS
  2632. EQ STA1 INITIALIZE FOR NEXT WORD
  2633. STA3 ZR B2,STA5 JUMP IF WORD COMPLETE
  2634. MX2 0 NEW ZERO FILL
  2635. STA4 LX6 6
  2636. BX6 X6+X2
  2637. SB3 B3-B1 DECREMENT COUNT OF CHARS REQUESTED
  2638. SB2 B2-B1 DECREMENT COUNT OF CHARS TO PUT IN WORD
  2639. NZ B2,STA4
  2640. STA5 SA6 A0 STORE NEXT WORD
  2641. NG B3,PROCESS --- EXIT IF DONE
  2642. MX6 0 ZERO FILL
  2643. STA6 SA6 A6+1
  2644. SB3 B3-10
  2645. PL B3,STA6
  2646. EQ PROCESS --- EXIT
  2647. * /--- BLOCK SHOWA 00 000 77/07/20 13.47
  2648. TITLE SHOWA
  2649. * -SHOWA-
  2650. *
  2651. * SHOWS VARIABLE(S) IN ALPHANUMERIC FORM.
  2652. *
  2653. * SHOWA EXPR[,LENGTH]
  2654. *
  2655. * INTERNALLY, THERE ARE TWO CASES. IF EXPR IS
  2656. * NON-STORABLE (IN THE SENSE USED BY COMPILE), THEN
  2657. * THE 60-BIT VALUE RETURNED BY GETVAR IS USED AS
  2658. * THE DATA TO DISPLAY, AND LENGTH MUST BE ^<10.
  2659. * IF EXPR IS STORABLE, THEN EXPR IS INTERPRETED AS
  2660. * THE FIRST WORD OF A STRING WHICH CAN POTENTIALLY
  2661. * EXTEND OVER MULTIPLE WORDS.
  2662. *
  2663. * IN THE LATTER CASE, ARRAYSEGV PRESENTS A PROBLEM
  2664. * BECAUSE IT IS CONSIDERED STORABLE BY THE REST OF
  2665. * THE CONDENSOR, YET IT SHOULD BEHAVE AS A SEGMENT
  2666. * RATHER THAN A STRING. A KLUDGE IS USED TO HANDLE
  2667. * ARRAYSEGV PROPERLY.
  2668. *
  2669. SHOWAX SX6 0
  2670. SA6 ARAYFLG PREPARE FOR ARRAY CHECK
  2671. SA6 SHOWVAL PRE-CLEAR FOR LITERAL CHECK
  2672. SA6 STORFLG SHOW NOT STORABLE
  2673. MX0 1
  2674. BX5 -X0*X5 MASK OFF STORABLE BIT
  2675. NGETVAR PROCESS FIRST SHOWA ARGUMENT
  2676. SA5 A5
  2677. NG X5,SHALIT --- IF FIRST ARG NON-STORABLE
  2678. SA2 A1 KLUDGE TO DISTINGUISH ARRAYSEGV
  2679. BX2 X2-X1
  2680. NZ X2,SHALIT --- IF ARRAYSEGV
  2681. MX6 -1
  2682. SA6 STORFLG
  2683. SX6 A1 (X6) = ADDRESS OF FIRST ARG
  2684. EQ SHARENT
  2685.  
  2686. * SHOW LITERAL (NON-STORABLE 60-BIT EXPRESSION)
  2687.  
  2688. SHALIT NG X1,SHOWA01
  2689. ZR X1,PROCO --- IF EXPR=0, NOTHING TO SHOW
  2690. SHOWA01 BX6 X1
  2691. SA6 SHOWVAL
  2692. SX6 A6
  2693.  
  2694. * PROCESS LENGTH ARGUMENT AND BOUNDS CHECK IT.
  2695.  
  2696. SHARENT SA6 EXECSAV ADDRESS IN EXECSAV
  2697. SA5 A5 READ COMMAND WORD
  2698. LX5 XCODEL
  2699. NGETVAR SECOND ARGUMENT
  2700. ZR X1,PROCESS --- IF LENGTH = 0
  2701. SA2 EXECSAV (X2) = ADDRESS OF STRING
  2702. SA3 ARAYFLG
  2703. NZ X3,SHAREN1 --- IF ARRAY SHOWA
  2704. SA3 STORFLG
  2705. ZR X3,SHAREN1 --- IF NON-STORABLE
  2706.  
  2707. SA0 X2 PICK UP ADDRESS
  2708. RJ WORDS CHECK ADDRESS BOUNDS
  2709. SB1 A0 ADDRESS OF STRING
  2710. EQ SHAREN2 MORE COMMON CODE
  2711. *
  2712. SHAREN1 SB1 X2 SET B1 TO STRING ADDRESS
  2713. NG X1,ERXBADL
  2714. SX2 11 LIMIT TO 10 CHARACTERS
  2715. IX2 X1-X2
  2716. PL X2,SHERXARR CANNOT SHOWA MORE THAN 10
  2717. * CHARS WITH ARRAY SHOWA
  2718. * EXECERR USES X1
  2719. * /--- BLOCK SHOWA 00 000 77/07/20 13.46
  2720. SHAREN2 BX6 X1 SAVE NCHARS IN X1 FOR XYFIX
  2721. SA6 NCHAR PLANT COUNT, SAVE X6 FOR LATER
  2722. SB2 A6 ADDRESS OF CHARACTER COUNT
  2723. SA4 ARAYFLG
  2724. NZ X4,ASHOWA
  2725. SA5 A5 RE-FETCH
  2726. LX5 2*XCODEL
  2727. NG X5,SHOWAS CHECK FOR EMBEDDED SHOWA(S)
  2728. RJ XYFIX
  2729. EQ SHOWAW
  2730. *
  2731. EXT ASHOW2,ASHOWIN,ARAYFLG
  2732. EXT ASHOWEF
  2733. *
  2734. ASHOWA SA3 SHOWA1 PLANT EQ ASHOW2 IN LOOP
  2735. BX1 X4 X1 MUST BE ARAYFLG
  2736. SA6 ASHOWEF SAVE FORMAT IN X6
  2737. SX6 2 FLAG FOR NGETVAR ADDR
  2738. EQ ASHOWIN SETUP LOOP
  2739. *
  2740. SHOWA1 EQ SHOWA2
  2741. SHOWA2 SA1 ASHOWEF X1 USED IN XYFIX
  2742. BX6 X1
  2743. SA6 NCHAR RESTORE CHARCOUNT
  2744. SB2 A6 PTR TO COUNT
  2745. EQ ASHOW2
  2746. *
  2747. SHOWAS SX7 B1 SAVE B1
  2748. SA7 SHOWOUT
  2749. SX7 B2
  2750. SA7 SHOWOUT+1 SAVE B2
  2751. SA1 RSIZE
  2752. NZ X1,SHOWAW IF NOT SIZE 0
  2753. RJ SIMPLOT UPDATE NX, NY CORRECTLY
  2754. SA2 SHOWOUT RESTORE B1
  2755. SB1 X2
  2756. SA2 SHOWOUT+1 RESTORE B2
  2757. SB2 X2
  2758. EQ SHOWAW
  2759. * /--- BLOCK SHOWA 00 000 80/04/22 01.00
  2760. *
  2761. SHOWAW SA1 SHOWVAL CHECK FOR LITERAL SHOW
  2762. NG X1,SW110 CHECK FOR -0
  2763. ZR X1,SW120
  2764. *
  2765. SW110 CALL TUTWRT SHOW LITERAL
  2766. EQ PROCO
  2767. *
  2768. SW120 SA1 RSIZE CHECK IF SIZED WRITTING
  2769. NZ X1,SW200
  2770. SA4 B2 LOAD CHARACTER COUNT
  2771. SX1 X4+9 ROUND FOR WORD COUNT
  2772. PX1 X1
  2773. SA2 TENTH
  2774. FX1 X1*X2 COMPUTE WORD COUNT
  2775. SX1 X1
  2776. SA2 MOUTLOC
  2777. IX1 X1+X2 CHECK IF ROOM IN *MOUT* BUFFER
  2778. SX1 X1-MOUTLTH+1
  2779. NG X1,SW150 JUMP IF ENOUGH ROOM
  2780. SX6 B1
  2781. SA6 SHARE+1 SAVE POINTER TO TEXT
  2782. SX6 X4
  2783. SA6 SHARE+2 SAVE CHARACTER COUNT
  2784. CALL WINTRP INTERRUPT
  2785. SA1 SHARE+1
  2786. SB1 X1 RESTORE POINTER TO TEXT
  2787. SB2 SHARE+2 RESTORE POINTER TO CHAR COUNT
  2788. *
  2789. SW150 CALL WRSOUT OUTPUT TO *MOUT* BUFFER
  2790. EQ PROCO
  2791. *
  2792. SW200 MX6 -7-3
  2793. SA2 TBWRITE CLEAR SIZE WRITE INFO
  2794. BX6 X6*X2
  2795. SA6 A2
  2796. SX6 B1 X6 = POINTER TO NEXT TEXT WORD
  2797. SA6 SHARE+2
  2798. SA1 B2
  2799. BX7 X1 X7 = CHARACTER COUNTER
  2800. SA7 SHARE+1
  2801. *
  2802. SW210 SA1 MOUTLOC SEE HOW MUCH OUTPUT SO FAR
  2803. SX1 X1-MOUT200
  2804. PL X1,SW250
  2805. SA1 XSLCLOK GET CPU USE CLOCK
  2806. SA2 MAXCLOK
  2807. IX2 X1-X2
  2808. PL X2,SW250
  2809. *
  2810. SA1 PARCLCNT SEE IF TOO MUCH CUMULATIVE
  2811. SX1 X1-PRCLIM
  2812. PL X1,SW250
  2813. SB1 X6 POINTER TO NEXT WORD OF TEXT
  2814. SB2 =10 PRE-SET CHARACTER COUNT
  2815. SX0 X7-11 CHECK NUMBER CHARS LEFT TO DO
  2816. + PL X0,*+1
  2817. SB2 SHARE+1 SPECIAL FOR LAST WORD
  2818. + CALL LINWRT
  2819. SA1 SHARE+1
  2820. SX7 X1-10 UPDATE CHARACTER COUNT
  2821. NG X7,PROCO
  2822. SA7 A1
  2823. SA1 SHARE+2
  2824. SX6 X1+1 UPDATE TEXT POINTER
  2825. SA6 A1
  2826. EQ SW210
  2827. *
  2828. SW250 CALL WINTRP INTERRUPT
  2829. SA1 SHARE+1
  2830. SX7 X1 RESTORE X7 = CHARACTER COUNT
  2831. SA1 SHARE+2
  2832. SX6 X1 RESTORE X6 = POINTER TO TEXT
  2833. EQ SW210
  2834. *
  2835. *
  2836. SHERXARR EXECERR 93 TRYING TO SHOWA MORE THAN 10
  2837. * CHARS PER ARRAY ELEMENT
  2838. STORFLG DATA 0
  2839. * /--- BLOCK SHOWK 00 000 80/04/22 01.00
  2840. SHOWK TITLE -SHOWK-
  2841. *
  2842. * -SHOWK-
  2843. *
  2844. * ARGUMENT = INTERNAL KEY CODE.
  2845. *
  2846. * DISPLAYS THE APPROPRIATE STRING, IF ANY, FOR THE
  2847. * GIVEN KEY CODE AND TERMINAL TYPE. IF KEY CODE IS
  2848. * NOT WITHIN THE RANGE OF THE TABLE, BUT IS A
  2849. * DISPLAYABLE KEY, IT WILL BE PLOTTED. OTHERWISE,
  2850. * NOTHING WILL BE SHOWN. THE VALUES IN THIS TABLE
  2851. * CAN BE EDITED USING LESSON *S0TTYPE*.
  2852.  
  2853. ENTRY SKPACK ENTRY FROM -PACK- COMMAND
  2854.  
  2855. SKPACK EQ * ENTRY/EXIT FOR -PACK- COMMAND
  2856. MX7 1
  2857. EQ SHOWK10
  2858.  
  2859. SHOWKX MX7 0 ENTRY FOR -SHOWK- EXECUTION
  2860. SHOWK10 SA7 SKPTYPE FLAG TO INDICATE CALLER
  2861. NGETVAR (X1) = INTERNAL KEY CODE
  2862. BX7 X1
  2863. SA7 SHKKEY SAVE INTERNAL KEY CODE
  2864. SX7 -1 DEFAULT TO NO COLOR SET
  2865. SA1 SKPTYPE SEE IF -SHOWK- OR -PACK-
  2866. NZ X1,SHOWK13 IF NOT -SHOWK-, SKIP
  2867. LX5 XCODEL SHIFT TO NEXT PARAM
  2868. SX7 -1 DEFAULT TO NO COLOR SET
  2869. NG X5,SHOWK13 IF NEGATIVE, NO COLOR PASSED
  2870. NGETVAR
  2871. BX7 X1
  2872. SHOWK13 SA7 SHKCOLR SAVE COLOR TO DISPLAY KEY
  2873. SA1 SHKKEY RESTORE *X1*
  2874. NG X1,SHOWK70 IF NEGATIVE VALUE, IGNORE
  2875. SB3 6 CHECK FOR 70XX KEY CODE
  2876. AX3 X1,B3
  2877. SX2 X3-70B
  2878. NZ X2,SHOWK15 IF NOT 70XX KEY CODE
  2879. SX1 X1-6700B CONVERT TO INTERNAL CODE
  2880.  
  2881. SHOWK15 BX7 X1 SAVE FOR LATER
  2882. SA7 SHOWKEY
  2883. SA1 TTPARAM+1 (X1) = 48/OTHER,12/TERM. CLASS
  2884. MX0 -12
  2885. BX3 -X0*X1 (X3) = TERMINAL CLASS ORDINAL
  2886. SX1 TTWPTT CALCULATE OFFSET IN TABLE
  2887. IX2 X1*X3 (X2) = START OF PARAMETERS
  2888. SX1 X2+TTPARMW (X1) = START OF POINTERS
  2889. SA2 ATTPARM (X2) = EM KEY TABLE ADDRESS
  2890. NG X2,SHOWK50 IF COMMON NOT LOADED, RETURN
  2891. IX6 X1+X2 (X6) = KEY TABLE ENTRY ADDRESS
  2892. SA6 SHOWTAB SAVE ENTRY ADDRESS
  2893.  
  2894. * CHECK RANGE OF KEY AND CALCULATE OFFSET IN POINTER
  2895. * TABLE.
  2896.  
  2897. SX2 X7-KDIV SEE IF .LT. MINIMUM
  2898. NG X2,SHOWK45 IF NO STRING FOR THIS CODE
  2899. SX2 X7-TAB-1 SEE IF .GT. MAXIMUM
  2900. PL X2,SHOWK45 IF NO STRING FOR THIS CODE
  2901. SX2 X7-KSEMIC-1
  2902. PL X2,SHOWK20 IF NOT IN LOWER RANGE
  2903. SX6 X7-KDIV (X6) = OFFSET IN POINTER TABLE
  2904. EQ SHOWK30 GET POINTER
  2905.  
  2906. SHOWK20 SX2 X7-KUNDER SEE IF IN UPPER RANGE
  2907. NG X2,SHOWK45 IF NO STRING FOR THIS CODE
  2908. SX6 X7-KUNDER+KSEMIC-KDIV+1 (X6) = OFFSET
  2909.  
  2910. * /--- BLOCK SHOWK 00 000 83/09/14 08.42
  2911. * GET POINTER AND SEE IF DEFAULT OR ALTERNATE KEY
  2912. * NAME IS TO BE PLOTTED.
  2913.  
  2914. SHOWK30 SX3 TTPPW
  2915. PX1 X6 PREPARE FOR FLOATING DIVIDE
  2916. PX2 X3
  2917. NX1 X1 (X1) = POINTER OFFSET
  2918. NX2 X2 (X2) = POINTERS PER WORD
  2919. FX5 X1/X2 (X5) = FLOATING WORD OFFSET
  2920. UX5 X5,B2 RETURN TO INTEGER
  2921. LX5 B2 (X5) = INTEGER WORD OFFSET
  2922. IX3 X5*X3
  2923. IX4 X6-X3 (X4) = REMAINDER
  2924. SX3 TTWIDTH
  2925. SX4 X4+1
  2926. IX3 X3*X4 (X3) = SHIFT COUNT
  2927.  
  2928. SA1 SHOWTAB (X1) = START OF TABLE ENTRY
  2929. IX0 X1+X5 (X0) = WORD FROM TABLE ENTRY
  2930. RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
  2931. SB2 X3
  2932. LX1 B2 SHIFT POINTER TO LOWER BITS
  2933. MX0 -TTWIDTH
  2934. BX2 -X0*X1 (X2) = POINTER
  2935. ZR X2,SHOWK35 IF DEFAULT STRING
  2936.  
  2937. * GET ALTERNATE STRING FROM EM.
  2938.  
  2939. SX2 X2-1 ORDINAL OF 1 = OFFSET OF ZERO
  2940. LX2 1 COMPENSATE FOR 2-WORD ENTRIES
  2941. SA1 ATTPARM (X1) = START OF EM TABLE
  2942. SX2 X2+TTALT (X2) = OFFSET TO STRING
  2943. IX0 X1+X2
  2944. SA0 SKTEMP
  2945. + RE 2
  2946. RJ ECSPRTY
  2947. EQ SHOWK37 PLOT STRING
  2948.  
  2949. * GET DEFAULT STRING FROM EM.
  2950.  
  2951. * /--- BLOCK SHOWK 00 000 83/09/14 08.59
  2952. SHOWK35 LX6 1 (X6) = ENTRY ORDINAL * 2
  2953. SX2 X6+TTDEFLT (X2) = OFFSET TO DEFAULT STRING
  2954. SA1 ATTPARM (X1) = START OF EM TABLE
  2955. IX0 X1+X2 (X0) = ADDRESS OF STRING IN EM
  2956. SA0 SKTEMP
  2957. + RE 2
  2958. RJ ECSPRTY
  2959.  
  2960. * PLOT OR -PACK- THE ALTERNATE OR DEFAULT STRING.
  2961.  
  2962. SHOWK37 SA1 SKTEMP CHECK FOR 1ST CHARACTER = 00
  2963. MX0 6
  2964. BX2 X0*X1 (X2) = 6/1ST CHAR, 54/0
  2965. NZ X2,SHOWK38 IF NOT ENCODED *SHIFT-*
  2966. SX3 1R- REPLACE 00 WITH HYPHEN
  2967. LX3 54
  2968. BX6 X3+X1
  2969. SA6 SKTEMP SAVE UPDATED WORD
  2970. SX7 30D (X7) = STRING LENGTH
  2971. SB3 0 (B3) = OFFSET FROM SKSHIFT
  2972. SA7 SKCHARS SAVE STRING LENGTH
  2973. EQ SHOWK39
  2974.  
  2975. SHOWK38 SX7 20D (X7) = STRING LENGTH
  2976. SB3 1 (B3) = OFFSET FROM SKSHIFT
  2977. SA7 SKCHARS SAVE STRING LENGTH
  2978.  
  2979. * /--- BLOCK SHOWK 00 000 80/03/01 11.03
  2980. SHOWK39 SA2 SKPTYPE CHECK COMMAND TYPE
  2981. NG X2,SHOWK40 IF -PACK- COMMAND
  2982.  
  2983. SA1 SHKCOLR GET COLOR OF FUNCTION KEY
  2984. NG X1,SHOK39Y IF NO COLOR SPECIFIED
  2985. MX0 36 SEE IF COLOR OVERFLOWS
  2986. BX0 X0*X1
  2987. ZR X0,SHOK39X IF COLOR OK, SEND IT OUT
  2988. SX6 -1 NOTE COLOR NOT SENT
  2989. SA6 A1 RESTORE NEW VALUE
  2990. EQ SHOK39Y CONTINUE
  2991.  
  2992. SHOK39X MX0 -3 MODE
  2993. SA2 TBNARGS
  2994. AX2 6 POSITION TERMINAL W/E MODE
  2995. BX2 -X0*X2
  2996. SX2 X2-2 SEE IF -MODE ERASE-
  2997. ZR X2,SHOK39Y IF ERASE, DONT CHANGE COLOR
  2998.  
  2999. OUTCODE RBGCODE 12/0,24/COLOR,24/RBGCODE
  3000.  
  3001. SHOK39Y SX6 B3 SAVE OFFSET
  3002. SA6 SKOFF
  3003. SB1 SKSHIFT+B3 (B1) = ADDRESS OF STRING
  3004. SB2 SKCHARS (B2) = ADDRESS OF CHAR COUNT
  3005. SA1 RSIZE
  3006. NZ X1,SHOK39A IF SIZE NOT ZERO
  3007. RJ SIMPLOT
  3008. SA1 SKOFF
  3009. SB1 SKSHIFT+X1 (B1) = ADDRESS OF STRING
  3010. SB2 SKCHARS (B2) = ADDRESS OF CHAR COUNT
  3011.  
  3012. SHOK39A CALL TUTWRT WRITE THE STRING
  3013.  
  3014. SHOK39B SA1 SHKCOLR GET COLOR OF FUNCTION KEY
  3015. NG X1,PROCO IF NO COLOR SPECIFIED
  3016.  
  3017. SA1 XCOLORS EXECUTOR COLOR SETTINGS
  3018.  
  3019. MX0 -3 MODE
  3020. SA2 TBNARGS
  3021. AX2 6 POSITION TERMINAL W/E MODE
  3022. BX2 -X0*X2
  3023. SX2 X2-2 SEE IF -MODE ERASE-
  3024. ZR X2,PROCO IF ERASE, GO TO PROCESS
  3025. MX0 -24D
  3026. BX1 -X0*X1 X1 = FOREGROUND COLOR
  3027. OUTCODE RBGCODE 12/0,24/COLOR,24/RBGCODE
  3028. EQ PROCO RETURN
  3029.  
  3030. SHOWK40 SA1 SKSHIFT+B3 (A1) = ADDRESS OF STRING
  3031. SA2 SKCHARS (X2) = CHARACTER COUNT
  3032. SB2 X2 (B2) = CHARACTER COUNT
  3033. SB3 -1 INDICATE JUMP TO *PACK2A*
  3034. EQ SKPACK RETURN
  3035.  
  3036. * /--- BLOCK SHOWK 00 000 83/09/07 09.36
  3037. * PLOT OR -PACK- KEY WHICH HAS NO STRING, CONVERTING
  3038. * FROM INTERNAL TO EXTERNAL CODE, IF NECESSARY.
  3039.  
  3040. SHOWK45 SB3 6
  3041. SA1 SHOWKEY (X1) = INTERNAL KEY CODE
  3042. AX2 X1,B3 SEE WHAT CONVERSION NEEDED
  3043. ZR X2,SHOWK60 IF 00XX CODE
  3044. SX3 X2-70B
  3045. ZR X3,SHOWK50 IF 70XX CODE
  3046. SX3 X2-1
  3047. NZ X3,SHOWK70 IF NOT 01XX CODE, GIVE UP
  3048. SX1 X1+6700B CONVERT 01XX CODE TO EXTERNAL
  3049. SHOWK50 LX1 59-11 (X1) = 12/EXTERNAL CODE, 48/0
  3050. SX7 2 (X7) = CHARACTER COUNT
  3051. EQ SHOWK65 PLOT KEY
  3052.  
  3053. SHOWK60 LX1 59-5 (X1) = 6/KEY CODE, 54/0
  3054. SX7 1 (X7) = CHARACTER COUNT
  3055.  
  3056. SHOWK65 SA2 SKPTYPE CHECK FOR COMMAND TYPE
  3057. BX6 X1 (X6) = SHIFTED KEY CODE
  3058. SA7 SKCHARS
  3059. SA6 SHOWKEY
  3060. NG X2,SHOWK67 IF -PACK- COMMAND
  3061. SB1 A6 (B1) = ADDRESS OF CHARACTER
  3062. SB2 A7 (B2) = ADDRESS OF CHAR COUNT
  3063. SA1 RSIZE
  3064. NZ X1,SHOK65A IF SIZE NOT ZERO
  3065. RJ SIMPLOT
  3066. SB1 SHOWKEY (B1) = ADDRESS OF CHARACTER
  3067. SB2 SKCHARS (B2) = ADDRESS OF CHAR COUNT
  3068. SHOK65A CALL TUTWRT WRITE THE CHARACTER
  3069. EQ PROCO RETURN
  3070.  
  3071. SHOWK67 SA1 SHOWKEY (A1) = ADDRESS OF CHARACTER
  3072. SB2 X7 (B2) = CHARACTER COUNT
  3073. SB3 -1 INDICATE JUMP TO *PACK2A*
  3074. EQ SKPACK RETURN
  3075.  
  3076. * FOR KEYS WHICH CANNOT BE PLOTTED, AND WHICH HAVE
  3077. * NO STRINGS ATTACHED, RETURN AFTER DOING NOTHING.
  3078.  
  3079. SHOWK70 SA1 SKPTYPE DETERMINE RETURN DESTINATION
  3080. PL X1,PROC IF NOT PROCESSING -PACK-
  3081. SB3 0 INDICATE JUMP TO *PACK1A*
  3082. EQ SKPACK RETURN
  3083.  
  3084. * MISCELLANEOUS VARIABLES.
  3085.  
  3086. SHOWKEY BSS 1 INTERNAL KEY CODE
  3087. SHOWTAB BSS 1 TABLE ENTRY ADDRESS
  3088. SKSHIFT DATA 0L'S'H'I'F'T
  3089. SKTEMP BSS 2 USED FOR EM READS
  3090. SKPTYPE BSS 1 NEGATIVE IF -PACK- COMMAND
  3091. SKCHARS BSS 1 NUMBER OF CHARACTERS TO PLOT
  3092. SKOFF BSS 1
  3093. SHKKEY BSS 1 INTERNAL KEY TO BE SHOWN
  3094. SHKCOLR BSS 1 COLOR TO DISPLAY KEY IN
  3095. *
  3096. * /--- BLOCK -TEXT- 00 000 83/09/07 09.37
  3097. TITLE -TEXT- COMMAND
  3098. ** TEXT COMMAND PROCESSING.
  3099. *
  3100. * FORMAT'; TEXT BUFFER,LENGTH <,LINES>
  3101. *
  3102. * WHERE'; BUFFER = INPUT TEXT BUFFER ADDRESS
  3103. * LENGTH = LENGTH OF BUFFER IN WORDS,
  3104. * LINES = MAX NO. OF LOGICAL '# PHYSICAL LINES
  3105. * TO BE DISPLAYED (OPTIONAL).
  3106. *
  3107. * THE PRESENCE OF THE *LINES* TAG IS REFERRED TO AS
  3108. * THE NEW FORMAT, W/O *LINES* AS THE OLD FORMAT.
  3109. *
  3110. * THE OLD FORMAT DISPLAYS THE ENTIRE BUFFER.
  3111. *
  3112. * THE NEW FORMAT INVOKES *SIMPLOT* TO SIMULATE THE
  3113. * PLOTTING OF EACH LINE, TO CHECK FOR THE PHYSICAL
  3114. * (SCREEN) BOUNDARY. ONLY THE NEW FORMAT SETS
  3115. * ZRETURN = -1 = DISPLAYED ENTIRE BUFFER.
  3116. * 0 = DISPLAYED NOTHING.
  3117. * +N = DISPLAYED *N* WORDS.
  3118. *
  3119. *
  3120. *
  3121. * NEED TO SET A LIMIT ON THE MAXIMUM LINE LENGTH,
  3122. * OTHERWISE WE COULD BE DEADLOCKED WAITING TO PLACE
  3123. * IT IN *MOUT* (IF IT WAS LARGER THAN *MOUTLTH*,
  3124. * FOR INSTANCE). NOTE THAT WE'7LL TRY TO PUT LARGER
  3125. * LINES IN, BUT IF WE RUN OUT OF ROOM, WE'7LL JUST
  3126. * HEAVE WHAT WE'7VE GOT INTO *MOUT*.
  3127. *
  3128. * THIS IS PERFECTLY OK FOR THE OLD VERSION, BUT
  3129. * WILL COUNT THE PARTIAL LINE AS A LOGICAL LINE
  3130. * IN THE NEW VERSION.
  3131. *
  3132. * ALL THESE NUMBERS ARE ARBITRARY AT THIS TIME.
  3133. *
  3134. MAXLINE EQU 50 MAX LTH OF A LOG. LINE (WORDS)
  3135. MXMXL. SET MOUTLTH/8 FRAC OF MOUT FOR SINGLE LINE
  3136. ERRNG MXMXL.-MAXLINE MOUTLTH MAY BE TOO SMALL
  3137.  
  3138. *
  3139. * DATA CELL DEFINITIONS.
  3140. *
  3141. TXTYPE EQU TBINTSV+0 OLD/NEW FORMAT FLAG + LINE CNT
  3142. TXBADDR EQU TXTYPE+1 CURRENT INPUT TEXT BUFFER ADDR
  3143. TXSTART EQU TXBADDR+1 ORIG. INPUT TEXT BUFFER ADDR
  3144. TXTLTH EQU TXSTART+1 INPUT TEXT LENGTH IN WORDS
  3145. TXLLINE EQU TXTLTH+1 MAX NO. OF LOGICAL LINES
  3146. TXYTARG EQU TXLLINE+1 LOWER BOUND FOR Y SCREEN POS.
  3147. TXMHDR EQU TXYTARG+1 ORIG MOUTLOC = INDEX TO HEADER
  3148. TXSAVB2 EQU TXMHDR+1 CELL TO SAVE B2 ACROSS SIMPLOT
  3149. *
  3150. * /--- BLOCK TEXT INIT 00 000 83/09/07 09.37
  3151.  
  3152. TEXTX BSS 0 ENTRY POINT FOR -TEXT- COMMAND
  3153. SX6 3 MAXIMUM NUMBER OF ARGS (TAGS)
  3154. CALL GETARGS MOVE ARGS TO VARBUF, GET COUNT
  3155. SX6 X6-3 CHECK FOR OLD/NEW FORMAT
  3156. SA6 TXTYPE -1 FOR OLD, 0 FOR NEW (SIMPLOT)
  3157. NG X6,OTEXT0 -- DON'7T SET *ZRETURN* IF OLD
  3158. SA6 TRETURN ZRETURN=0 = NOTHING DISPLAYED
  3159. OTEXT0 BSS 0
  3160.  
  3161. SA1 VARBUF GET FIRST ARG -- BUFFER ADDRESS
  3162. BX5 X1 MOVE TO X5 FOR GETVAR
  3163. NGETVAR
  3164. SX6 A1 SAVE ADDRESS OF BUFFER
  3165. SA6 TXBADDR MOVING POINTER
  3166. SA6 TXSTART CONSTANT
  3167.  
  3168. SA1 VARBUF+1 GET SECOND ARG = LENGTH OF TEXT
  3169. BX5 X1
  3170. NGETVAR
  3171. NG X1,PROCESS -- NEGATIVE LENGTH
  3172. ZR X1,PROCESS -- ZERO LENGTH
  3173. BX6 X1 SAVE TEXT LENGTH (WORDS)
  3174. SA6 TXTLTH
  3175.  
  3176. SA2 TXBADDR GET BUFFER ADDRESS
  3177. SA0 X2 A0=ADDR, X1=LTH
  3178. CALL BOUNDS CHECK BUFFER VALIDITY
  3179.  
  3180. SA1 TXTYPE CHECK OLD/NEW FORMAT
  3181. NG X1,TXGO -- OLD FORMAT ALL SET
  3182. SA1 VARBUF+2 ELSE GET THIRD ARG = MAX LINES
  3183. BX5 X1
  3184. NGETVAR
  3185. SX6 X1 USE 18-BIT ARITHMETIC
  3186. NG X6,OTEXT1 -- NEGATIVE LINE COUNT
  3187. ZR X6,OTEXT1 -- ZERO LINE COUNT
  3188. SA6 TXLLINE SAVE AS MAX LOGICAL LINES ALSO
  3189. SA1 NY GET CURRENT Y SCREEN POSITION
  3190. LX6 4 LOG. LINES * 16 = DELTA Y
  3191. IX6 X1-X6 CURRENT - DELTA = Y TARGET
  3192. PL X6,TXDY0 -- STORE VALUE IF POSITIVE
  3193. SX6 0 ELSE USE 0 AS LOWER BOUND
  3194. TXDY0 BSS 0
  3195. SA6 TXYTARG STORE LOWER BOUND FOR *NY*
  3196. EQ TXGO -- ALL SET, LET '7ER RIP
  3197. *
  3198. OTEXT1 BSS 0
  3199. MX6 -1
  3200. SA6 TXTYPE PROCESS AS OLD FORMAT -TEXT-
  3201. SA6 TRETURN AND SET ZRETURN TO *ALL DONE*
  3202.  
  3203. TXGO BSS 0 ARGUMENTS SET, FIRE AWAY
  3204. CALL TXMIN SET UP FOR *MOUT* (B1=1 TOO)
  3205.  
  3206. * /--- BLOCK TEXT LOOP 00 000 83/09/07 09.46
  3207. *
  3208. * GET NEXT LINE TO BE DISPLAYED. (OUTER LOOP)
  3209. * NOTE THAT ALL THE INFORMATION IS READ FROM
  3210. * *TBINTSV* CELLS AND THE CURRENT *MOUTLOC* SINCE
  3211. * WE MAY HAVE INTERRUPTED (*MOUT* WAS FULL).
  3212. *
  3213. TXLINE BSS 0
  3214. SA2 MOUTLOC CURRENT INDEX INTO *MOUT*
  3215. SX1 MOUTLTH TOTAL LENGTH OF *MOUT*
  3216. IX1 X1-X2 SUBTRACT CURRENT FROM TOTAL
  3217. SB3 X1 B3 = REMAINING WORDS IN *MOUT*
  3218. SB2 B3-B1 SO WE CAN CHECK FOR ZR/NG
  3219. MX0 -12D MASK FOR END-OF-LINE BYTE
  3220. NG B2,TXINTRP -- NO ROOM LEFT IN *MOUT*
  3221. SX3 X2+MOUT X3 = ADDR OF NEXT WD IN *MOUT*
  3222. SX4 KCR X4 = CARRIAGE RETURN
  3223. SA2 TXBADDR X2 = INPUT TEXT BUFFER ADDRESS
  3224. SA1 TXTLTH
  3225. SB4 X1 B4 = REMAINING WDS OF INPUT
  3226. SB2 B0 B2 = WORD INDEX INTO LINE
  3227.  
  3228. *
  3229. * GET NEXT WORD OF LINE (INNER LOOP).
  3230. * EVERYTHING HERE IS IN REGISTERS, SO YOU CAN'7T
  3231. * COME HERE FROM ANYWHERE BUT TXLINE.
  3232. *
  3233. TXWORD BSS 0
  3234. SA1 X2+B2 READ (LINE ADDR + INDEX)
  3235. SB3 B3-B1 DECREMENT WORDS LEFT IN *MOUT*
  3236. SB4 B4-B1 DECREMENT WORDS LEFT TO DISPLAY
  3237. BX5 -X0*X1 MASK OF END-OF-LINE BYTE
  3238. NZ X5,TXWD1 -- BRIF NOT END-OF-LINE
  3239. BX1 X1+X4 ELSE INSERT CARRIAGE RETURN
  3240. TXWD1 BSS 0
  3241. BX6 X1 MOVE WORD TO STORE REGISTER
  3242. SA6 X3+B2 STORE IN *MOUT*
  3243. SB2 B2+B1 INCREMENT LINE INDEX (LENGTH)
  3244. ZR X5,TXEOB -- BRIF END-OF-LINE
  3245. ZR B4,TXEOB -- BRIF END-OF-BUFFER
  3246. NZ B3,TXWORD -- BRIF STILL ROOM IN *MOUT*
  3247.  
  3248. SX1 B2-MAXLINE CHECK FOR HUGE LINE LENGTH
  3249. PL X1,TXEOB -- TREAT IT AS A LOGICAL LINE
  3250.  
  3251. TXINTRP BSS 0 WAIT FOR *MOUT* TO BE FLUSHED
  3252. CALL TXMOUT SET UP *MOUT* HEADER
  3253. CALL WINTRP INTERRUPT FOR DISPLAY
  3254. CALL TXMIN INITIALIZE FOR *MOUT*
  3255.  
  3256. EQ TXLINE -- TRY SAME LINE AGAIN
  3257.  
  3258. * /--- BLOCK TEXT EOB 00 000 83/09/07 09.39
  3259. *
  3260. * END-OF-LINE OR END-OF-BUFFER (NO DIFFERENCE).
  3261. * WE HAVE NOT UPDATED ANY OF THE POINTERS YET,
  3262. * SO WE CAN SKIP THIS LINE AFTER SIMPLOTTING
  3263. * SIMPLY BY JUMPING TO THE EXIT PROCESSING.
  3264. *
  3265. TXEOB BSS 0
  3266. SA1 TXTYPE OLD/NEW -TEXT- FORMAT
  3267. NG X1,OTEXT2 -- BRIF IF NOT SIMPLOTTING
  3268.  
  3269. SX6 B2 SAVE B2 ACROSS SIMPLOT
  3270. SA6 TXSAVB2
  3271. SB2 B2+B2 B2*2
  3272. LX6 3 B2*8
  3273. SB2 X6+B2 B2*10 = NO. OF CHARACTERS
  3274.  
  3275. SA1 MOUTLOC CURRENT POSITION IN *MOUT*
  3276. SB1 X1+MOUT = STARTING POSITION OF LINE
  3277.  
  3278. CALL TEXTSTR *** SIMPLOT LINE ***
  3279.  
  3280. SB1 1 RESTORE B1
  3281. SA1 TXSAVB2 RESTORE B2
  3282. SB2 X1
  3283.  
  3284. MX1 -9 MASK X,Y TO 9 BITS
  3285. BX3 -X1*X3 VALUE OF *NX* IF LINE PLOTTED
  3286. BX4 -X1*X4 VALUE OF *NY* IF LINE PLOTTED
  3287.  
  3288. SA1 TXTYPE ABUSE OLD/NEW -TEXT- FLAG
  3289. ZR X1,TXFIRST -- ALWAYS PLOT FIRST LINE
  3290.  
  3291. SA1 TXYTARG LOWER BOUND FOR *NY*
  3292. IX1 X4-X1 SUBTRACT TARGET FROM NEW
  3293. NG X1,TXEND -- BRIF RUNS BELOW *Y* TARGET
  3294.  
  3295. *
  3296. * UPDATE NX,NY (*WHERE*) IN STUDENT BANK.
  3297. * THIS IS CRITICAL, OR SIMPLOT WILL NOT SEE
  3298. * THE ACCUMULATION OF LINES. WHEN SKIPPING,
  3299. * THESE MUST NOT BE UPDATED OR IT WILL SEEM
  3300. * THAT A PHANTOM LINE HAS BEEN PLOTTED.
  3301. *
  3302. TXFIRST BSS 0
  3303. BX6 X3
  3304. SA6 NX
  3305. BX6 X4
  3306. SA6 NY
  3307.  
  3308. * /--- BLOCK TEXT END 00 000 83/09/07 09.38
  3309. *
  3310. * GOING TO DISPLAY THIS LINE, UPDATE POINTERS
  3311. *
  3312. OTEXT2 BSS 0
  3313. SA1 MOUTLOC INCREMENT *MOUTLOC*
  3314. SX6 X1+B2
  3315. SA6 A1
  3316.  
  3317. SA1 TXBADDR INCR INPUT TEXT BUFFER ADDR
  3318. SX6 X1+B2
  3319. SA6 A1
  3320.  
  3321. SA1 TXTLTH DECREMENT REMAINING TEXT
  3322. SX6 B2
  3323. IX6 X1-X6
  3324. SA6 A1
  3325. ZR X6,TXEND -- NO TEXT REMAINING
  3326.  
  3327. *
  3328. * IF NEW FORMAT, COUNT LOGICAL LINES AND CHECK
  3329. * FOR MAX LOGICAL LINES. (DONE HERE BECAUSE
  3330. * FIRST LINE MUST ALWAYS BE DISPLAYED)
  3331. *
  3332. SA1 TXTYPE GET OLD/NEW FLAG (LOG. LINE)
  3333. NG X1,TXLINE -- CONTINUE PLOTTING IF OLD
  3334. SX6 X1+B1 ELSE INCR FLAG AS LOGICAL
  3335. SA6 A1 LINE COUNTER
  3336. SA1 TXLLINE MAX NO. OF LOGICAL LINES
  3337. IX1 X6-X1 COMPARE WITH CURRENT COUNT
  3338. NG X1,TXLINE -- NOT AT LIMIT, CONTINUE
  3339.  
  3340. *
  3341. * THAT'7S ALL FOLKS, FINISH IT UP AND EXIT.
  3342. *
  3343. TXEND BSS 0
  3344. CALL TXMOUT SET UP *MOUT* HEADER
  3345.  
  3346. SA1 TXTYPE CHECK FOR OLD/NEW FORMAT
  3347. NG X1,PROCO -- IF OLD, JUST EXIT W/OUTPUT
  3348.  
  3349. MX6 -1 PREPARE FOR *ALL DONE* RETURN
  3350. SA1 TXTLTH GET LENGTH OF REMAINING TEXT
  3351. ZR X1,TXDONE -- NONE LEFT, SHOW *ALL DONE*
  3352. SA1 TXBADDR ELSE FIND OUT HOW MUCH WAS
  3353. SA2 TXSTART BY COMPARING CURRENT-START
  3354. IX6 X1-X2 NUMBER OF WORDS OUTPUT
  3355. TXDONE BSS 0
  3356. SA6 TRETURN SET *ZRETURN*
  3357. EQ PROCO -- EXIT WITH OUTPUT
  3358. *
  3359. *
  3360. *
  3361. * /--- BLOCK TEXT SUBR 00 000 83/09/07 09.39
  3362.  
  3363. ** TXMIN - INIT FOR OUTPUT.
  3364. *
  3365. * PREPARE TO COPY LINES TO THE *MOUT* BUFFER
  3366. * BY SAVING THE CURRENT *MOUTLOC*, WHICH WILL
  3367. * BE THE HEADER LOCATION (SEE TXMOUT). ALSO
  3368. * INITIALIZES B1=1.
  3369. *
  3370. TXMIN PS ENTRY/EXIT
  3371. SB1 1 B1 = CONSTANT B1
  3372. SA1 MOUTLOC GET CURRENT *MOUT* INDEX
  3373. BX6 X1
  3374. SA6 TXMHDR SAVE AS INDEX TO HEADER
  3375. SX6 X1+B1 INCREMENT PAST HEADER WORD
  3376. SA6 A1 REWRITE *MOUTLOC*
  3377. EQ TXMIN -- EXIT
  3378. *
  3379. *
  3380.  
  3381.  
  3382. ** TXMOUT - COMPLETE OUTPUT.
  3383. *
  3384. * CONSISTS MOSTLY OF COUNTING NUMBER OF WORDS
  3385. * PLACED IN *MOUT* AND CHECKING FOR ZERO WORDS.
  3386. * IF ZERO, MOUTLOC IS RESET TO WHAT IT WAS ON
  3387. * ENTRY, AS IF WE HAD NEVER BEEN HERE. IF NOT
  3388. * ZERO, THE NUMBER OF CHARACTERS IS COMPUTED
  3389. * AND PLACED IN THE HEADER IN *MOUT*.
  3390. *
  3391. TXMOUT0 BSS 0 IF NOTHING OUTPUT
  3392. SX6 X2 ORIGINAL VALUE OF *MOUTLOC*
  3393. SA6 A1 RESET IT
  3394.  
  3395. TXMOUT PS ENTRY/EXIT
  3396. SA1 MOUTLOC GET CURRENT *MOUT* INDEX
  3397. SA2 TXMHDR GET INDEX TO HEADER IN *MOUT*
  3398. IX6 X1-X2 NUMBER OF WORDS WE'7VE OUTPUT
  3399. SX6 X6-1 MINUS ONE WORD FOR THE HEADER
  3400. ZR X6,TXMOUT0 -- NOTHING OUTPUT YET
  3401. LX6 1 NUMBER OF WORDS OUTPUT * 2
  3402. BX1 X6
  3403. LX1 2 (NWORDS*2)*4 = (NWORDS*8)
  3404. IX6 X1+X6 (*8)+(*2) = NUMBER OF CHARS
  3405. SX1 WRSCODE MOUT CMND = WRITE, STD FONT
  3406. LX6 24D SHIFT NCHARS TO PARAM FIELD
  3407. BX6 X1+X6 MERGE NCHARS AND WRSCODE
  3408. SA6 X2+MOUT WRITE HEADER TO *MOUT*
  3409. EQ TXMOUT -- EXIT
  3410. *
  3411. *
  3412. * /--- BLOCK TEXTN TABL 00 000 77/07/20 13.06
  3413. *
  3414. * TABLE FOR TEXTN COMMAND
  3415. * FIRST 6 CHARS = BORDER RETURN AND LINE NUMBER
  3416. * NEXT 2 CHARS = MONTH/DAY CHARACTERS (LEADING 0)
  3417. * NEXT 2 CHARS = YEAR SINCE 1973 (5 BITS, GOES TO 2004)
  3418. *
  3419. ENTRY SHLN0 USED IN FILE *FILEX*
  3420. SHLN0 DATA 76655555555533334236B ACCESS-ASSIGN-4SP
  3421. DATA 76655534555533344237B ACCESS-ASSIGN-NUM1-NUM2-SP-SP
  3422. DATA 76655535555533354240B
  3423. DATA 76655536555533364241B
  3424. DATA 76655537555533374242B
  3425. DATA 76655540555533404243B
  3426. DATA 76655541555533414244B
  3427. DATA 76655542555533424333B
  3428. DATA 76655543555533434334B
  3429. DATA 76655544555533444335B
  3430. DATA 76653433555534334336B 10 -- 1983
  3431. DATA 76653434555534344337B
  3432. DATA 76653435555534354340B
  3433. DATA 76653436555534364341B
  3434. DATA 76653437555534374342B
  3435. DATA 76653440555534404343B
  3436. DATA 76653441555534414344B
  3437. DATA 76653442555534424433B
  3438. DATA 76653443555534434434B
  3439. DATA 76653444555534444435B
  3440. DATA 76653533555535334436B 20 -- 1993
  3441. DATA 76653534555535344437B
  3442. DATA 76653535555535354440B
  3443. DATA 76653536555535364441B
  3444. DATA 76653537555535374442B
  3445. DATA 76653540555535404443B
  3446. DATA 76653541555535414444B 1999
  3447. DATA 76653542555535423333B 2000
  3448. DATA 76653543555535433334B
  3449. DATA 76653544555535443335B
  3450. DATA 76653633555536333336B 30 -- 2003
  3451. DATA 76653634555536343337B 31 -- 2004
  3452. *
  3453. * /--- BLOCK GETARGS 00 000 78/03/03 02.41
  3454. *
  3455. * -GETARGS-
  3456. *
  3457. * ROUTINE TO UNPACK ALL GETVAR CODES FOR A
  3458. * COMMAND INTO *VARBUF* FOR COMMANDS WHICH
  3459. * USE ROUTINE *MRKLAST* TO MARK OFF THE LAST
  3460. * GETVAR CODE OF A VARIABLE-ARGUMENT COMMAND
  3461. *
  3462. * ON ENTRY'; X6 = MAXIMUM NUMBER DESIRED
  3463. * X5 = COMMAND WORD
  3464. * ON EXIT '; X6 = NUMBER OF ARGUMENTS FOUND
  3465. *
  3466. *
  3467. ENTRY GETARGS
  3468. *
  3469. GETARGS EQ *
  3470. SB3 X6 B3 = NUMBER OF ARGS TO GET
  3471. SB1 1 B1 = 1
  3472. BX6 X5
  3473. SB2 B0 B2 = CURRENT VARBUF BIAS
  3474. NG X6,MRKFND IF NEGATIVE THEN MARK IS FOUND
  3475. SA6 VARBUF STORE WITH 1ST VAR CODE LJUST
  3476. SB2 B1 BIAS = 1
  3477. LX6 XCODEL
  3478. NG X6,MRKFND IF NEGATIVE THEN MARK IS FOUND
  3479. SA6 VARBUF+1 STORE WITH 2ND VAR CODE LJUST
  3480. SB2 B2+B1 BIAS = 2
  3481. LX6 60-XCMNDL-XCODEL
  3482. MX0 2*XCODEL+XCMNDL
  3483. BX6 -X0*X6 X6 = EXTRA STORAGE POINTER
  3484. SA1 B5+X6 X1 = 1ST WORD OF EXTRA STORAGE
  3485. GETARG1 BX6 X1
  3486. NG X6,MRKFND IF NEGATIVE THEN MARK IS FOUND
  3487. SA6 VARBUF+B2
  3488. SB2 B2+B1 NEXT ARGUMENT
  3489. LX6 XCODEL
  3490. NG X6,MRKFND IF NEGATIVE THEN MARK IS FOUND
  3491. SA6 VARBUF+B2
  3492. SB2 B2+B1 NEXT ARGUMENT
  3493. LX6 XCODEL
  3494. NG X6,MRKFND IF NEGATIVE THEN MARK IS FOUND
  3495. SA6 VARBUF+B2
  3496. SB2 B2+B1 NEXT ARGUMENT
  3497. SA1 A1+B1 X1 = NEXT EXTRA STORAGE WORD
  3498. LT B2,B3,GETARG1 LOOP IF MORE TO GO...
  3499. MRKFND MX0 1 FORM SIGN BIT MASK
  3500. BX6 -X0*X6 MASK TOP BIT OFF GETVAR CODE
  3501. SA6 VARBUF+B2 STORE THE UNMARKED CODE
  3502. SX6 B2+B1 CURRENT COUNT OF ARGUMENTS
  3503. EQ GETARGS
  3504. *
  3505. * /--- BLOCK WORDS 00 000 80/07/19 22.18
  3506. ***
  3507. *** NEW BOUNDS ROUTINES THAT USE X1 AS LENGTH PARAMETER
  3508. ***
  3509. ***
  3510. TITLE BOUNDS CHECKERS
  3511. *
  3512. * WORDS (PERFORMS BOUNDS CHECK USING CHAR COUNT)
  3513. *
  3514. * ON ENTRY--
  3515. * A0 = INITIAL ADDRESS
  3516. * X1 = CHARACTER POSITION OR COUNT
  3517. * ON EXIT--
  3518. * B1 = ADDRESS OF LAST WORD + 1
  3519. * A2,B2,X0,X2 ARE DESTROYED
  3520. * ** WARNING ** MOVE COMMAND USES THE CURRENT
  3521. * VALUE OF X0 RETURNED (N-1)(1/10)
  3522. *
  3523. ENTRY WORDS
  3524. *
  3525. WORDS EQ *
  3526. NG X1,ERXPOS --- IF NEGATIVE POSITION/COUNT
  3527. ZR X1,ERXPOS --- IF ZERO POSITION/COUNT
  3528. SB1 X1
  3529. AX1 18 CHECK FOR LENGTH > 18 BITS
  3530. NZ X1,BOUERR0 RECONSTRUCT X1 FOR EXECERR
  3531. SX0 B1-1 X0 = NCHARS-1
  3532. SA2 TENTH TO GET (N-1)/10
  3533. PX0 X0
  3534. FX0 X0*X2 X0=(N-1)*(1/10) AND SOME GARBAGE EXPONENT
  3535. SX1 X0+1 ADD 1 FOR CORRECT LENGTH
  3536. SX2 B1 SAVE ORIGINAL X1
  3537. RJ BOUNDS CHECK ADDRESS BOUNDS
  3538. BX1 X2 RESTORE X1
  3539. EQ WORDS
  3540. * /--- BLOCK BOUNDS 00 000 79/02/09 12.13
  3541. *
  3542. * BOUNDS (CHECKS BOUNDS USING LENGTH IN WORDS)
  3543. *
  3544. * ON ENTRY--
  3545. * A0 = INITIAL ADDRESS
  3546. * X1 = LENGTH (IN WORDS)
  3547. * ON EXIT--
  3548. * B1 = FINAL ADDRESS + 1
  3549. * B2,B3,B4 ARE DESTROYED
  3550. *
  3551. * A0 DETERMINES WHETHER STUDENT OR COMMON.
  3552. * NOTE THAT TUTOR WILL INSURE THAT A0 IS IN
  3553. * BOUNDS, BUT WITH A LONG LENGTH A USER CAN
  3554. * PRODUCE AN END ADDRESS WHICH IS NEGATIVE.
  3555. *
  3556. ENTRY BOUNDS
  3557. *
  3558. BOUNDS EQ *
  3559. NG X1,ERXBADL --- ERROR IF NEGATIVE LENGTH
  3560. SB1 X1
  3561. NG B1,ERXBADL --- ERROR IF NEGATIVE LENGTH
  3562. AX1 18 CHECK FOR LENGTH > 18 BITS
  3563. NZ X1,BOUERR0
  3564. SX1 B1 RESTORE X1
  3565. *
  3566. SB2 NCVRBUF STARTING ADDR FOR NC VARS
  3567. SB1 A0+B1 B1 = 1ST ADDRESS AFTER END
  3568. SB2 A0-B2 CHECK STUDENT, ROUTER OR COMMON
  3569. NG B1,BOUERR1 --- ERROR IF BAD ADDRESS
  3570. PL B2,CBOUND COMMON VARS ARE AFTER LOCALS
  3571. SB2 LVARBUF
  3572. SB2 A0-B2 CHECK IF LOCAL VARIABLES
  3573. PL B2,LBOUND LOCAL VARS ARE AFTER ROUTER
  3574. SB2 RVARBUF
  3575. SB2 A0-B2 CHECK FOR STUDENT OR ROUTER
  3576. PL B2,RBOUND ROUTER VARS ARE AFTER STUDENT
  3577. SB2 STUDVAR
  3578. SB2 A0-B2 CHECK IF STUDENT
  3579. NG B2,BOUERR2 --- ERROR IF NOT STUDENT
  3580. *
  3581. * 'STUDENT VARIABLE BOUNDS CHECKING
  3582. SB2 STUDVAR+VARLIM
  3583. LE B1,B2,BOUNDS
  3584. *
  3585. SB2 STUDVAR
  3586. SX3 VARLIM MAXIMUM LIMIT OF VARIABLES
  3587. SA4 =7LSTUDENT
  3588. EQ BOUERR --- ERROR EXIT IF OUT-OF-BOUNDS
  3589. *
  3590. RBOUND SB2 RVARBUF+RVARLIM
  3591. LE B1,B2,BOUNDS
  3592. *
  3593. SB2 RVARBUF
  3594. SX3 RVARLIM MAXIMUM LIMIT OF VARIABLES
  3595. SA4 =6LROUTER
  3596. EQ BOUERR --- ERROR EXIT IF OUT-OF-BOUNDS
  3597. *
  3598. LBOUND SB3 X1 SAVE X1
  3599. SB4 A1 SAVE A1
  3600. SA1 LVUCNT X1 = NUM LV IN THIS UNIT
  3601. SB2 X1+LVARBUF B2 = ADDR OF WORD AFTER LVARS
  3602. SA1 B4 RESTORE A1
  3603. SX1 B3 RESTORE X1
  3604. LE B1,B2,BOUNDS
  3605. *
  3606. SB2 LVARBUF
  3607. SA3 LVUCNT X3 = LVARS IN THIS UNIT
  3608. SA4 =5LLOCAL
  3609. EQ BOUERR --- ERROR EXIT IF OUT-OF-BOUNDS
  3610. *
  3611. CBOUND SB2 NCVRBUF+NCVRLIM
  3612. LE B1,B2,BOUNDS
  3613. *
  3614. SB2 NCVRBUF STARTING ADDR FOR NC VARS
  3615. SX3 NCVRLIM MAX LIMIT OF CM COMMON
  3616. SA4 =5LNC/VC
  3617. * /--- BLOCK BOUNDS 00 000 80/03/23 04.46
  3618. BOUERR SX1 A0-B2 STARTING LOCATION
  3619. SX1 X1+1 START AT N1, NOT N0
  3620. SB2 A0
  3621. SX2 B1-B2 LENGTH
  3622. EXECERR 52
  3623. *
  3624. BOUERR2 SX1 B2
  3625. EQ ERXINDL INDEX TOO LOW
  3626. BOUERR1 SX1 B1
  3627. EQ ERXINDL INDEX TOO LOW
  3628. *
  3629. BOUERR0 LX1 18 RECONSTRUCT X1
  3630. SX2 B1 BOTTOM 18 BITS
  3631. BX1 X1+X2 MERGE
  3632. EQ ERXBADL
  3633. * /--- BLOCK JUDGE 00 000 78/07/18 14.43
  3634. TITLE JUDGE AND JUDGE*
  3635. * -JUDGE- (CODE=70)
  3636. *
  3637. * 'MODIFIES JUDGMENT OR CONDITIONS OF JUDGING.
  3638. * 'THE TOP *XJDGL* BITS OF THE COMMAND WORD HOLD THE
  3639. * NUMBER OF THE JUDGE TYPE. 'THE FOLLOWING TAGS ARE
  3640. * CURRENTLY PERMITTED--
  3641. * OK
  3642. * WRONG
  3643. * NO
  3644. * CONTINUE
  3645. * IGNORE
  3646. * EXIT
  3647. * REJUDGE
  3648. * X
  3649. * OKQUIT
  3650. * NOQUIT
  3651. * QUIT
  3652. *
  3653. *
  3654. JUDGECX CALL GETTAG CONDITIONAL JUDGE...GET TAG
  3655. JUDGEX SA1 TBITS DO NOT ALLOW -JUDGE- IN ERASE-UNIT-CONTNGY
  3656. LX1 ERSUBIT
  3657. NG X1,JERXERU --- EXECUTION ERROR IF SO
  3658. LX5 XJDGL
  3659. MX0 -XJDGL
  3660. BX5 -X0*X5 EXTRACT CODE
  3661. SB2 X5
  3662. JP JXTAB+B2 JUMP THROUGH TABLE TO PROPER ROUTINE
  3663. *
  3664. JXTAB EQ JOKX 0 OK
  3665. EQ JWRONGX 1 NO (SPECIFIC)
  3666. EQ JNOX 2 NO (UNIVERSAL)
  3667. EQ JCONTX 3 CONTINUE
  3668. EQ JIGNRX 4 IGNORE
  3669. EQ JEXITX 5 EXIT
  3670. EQ PJUDGOO 6 REJUDGE
  3671. EQ PROCESS 7 X
  3672. EQ JOKQ 8 OKQUIT
  3673. EQ JNOQ 9 NOQUIT
  3674. EQ JQUIT 10 QUIT
  3675. *
  3676. *
  3677. JOKX SX6 -1 SET JUDGMENT=OK
  3678. SA6 TJUDGED
  3679. SA6 TANSOK SET ANSOK TRUE
  3680. EQ PROCESS
  3681. *
  3682. JWRONGX SX6 0 SET JUDGMENT=NO (SPECIFIC)
  3683. SA6 TJUDGED
  3684. SA6 TANSOK SET ANSOK FALSE
  3685. SA6 JJSBUFA KILL ANY JUDGEMENT ON WORDS
  3686. EQ PROCESS
  3687. *
  3688. JNOX SX6 1 SET JUDGMENT=NO (UNIVERSAL)
  3689. SA6 TJUDGED
  3690. SX6 0
  3691. SA6 TANSOK SET ANSOK FALSE
  3692. SA6 JJSBUFA KILL ANY JUDGEMENT ON WORDS
  3693. EQ PROCESS
  3694. *
  3695. JCONTX SB7 XJUDGEC SWITCH TO JUDGE-C LEAVING BUFFERS INTACT
  3696. SX7 -1
  3697. SA7 JJSTORE FLAG NO COMPILED CODE
  3698. EQ PROCESS
  3699. *
  3700. JERXERU EXECERR 90 -JUDGE- NOT ALLOWED IN ERASEU
  3701. * /--- BLOCK JIGNRX 00 000 78/11/08 20.44
  3702. *
  3703. *
  3704. ENTRY JIGNRX USED BY IGNORE COMMAND
  3705. *
  3706. JIGNRX CALL ARESET RESTORE ARROW SIZE AND ROTATE
  3707. SA1 TBITS
  3708. LX1 JUDGBIT
  3709. NG X1,JOVER --- EXIT IF JARROW TYPE JUDGING
  3710. SB7 XJUDGEC SET TO JUDGE CONTINGENCY
  3711. SX6 0
  3712. SA6 TJUDGED SPECIFIC -NO-
  3713. *** FOLLOWING LINE ADDED 3/15/76--'R'W'B
  3714. SA6 TBANSWT MARK NO ANS-C WRITING (HELPOPS)
  3715. CALL ANSDAT
  3716. SA1 RSIZE
  3717. NZ X1,JJ1 IF NOT SIZE 0
  3718. * *TBPAUSE* = NEGATIVE IF PAUSE ENCOUNTERED
  3719. * = *MOUTLOC* OF OK/NO IF NO PAUSE
  3720. SA1 TBPAUSE SEE IF PASSED THROUGH A PAUSE
  3721. NG X1,JJ1
  3722. ZR X1,JJ1
  3723. SA1 LONG SEE IF JUDGING FORCED
  3724. SA2 LIMIT
  3725. IX3 X1-X2
  3726. NG X3,JJ1
  3727. SX3 X2-1
  3728. NZ X3,JJ1 EXIT IF NOT LONG 1
  3729. SX3 X1-3
  3730. PL X3,JJ1 EXIT IF MORE THAN 2 CHARS
  3731. SA3 INHIBS
  3732. LX3 FNTSHIF CHECK FOR -FORCE FONT-
  3733. NG X3,JJ1
  3734. SA3 KEY
  3735. SX3 X3-FUNKEY CHECK IF REALLY A LETTER
  3736. PL X3,JJ1 (FOR JUDGE EXIT CASES)
  3737. SA2 INHIBS
  3738. LX2 FTESHIF SEE IF FORCE FIRSTERASE IN OPERATION
  3739. NG X2,JJ1
  3740. MX6 0 CLEAR OUT -MOUT-
  3741. SA6 MOUT CLEAR -AT-
  3742. SA6 MOUT+1 CLEAR DIRECTION
  3743. SA6 MOUT+2
  3744. SA6 MOUT+3
  3745. SA6 MOUT+4
  3746. SA6 MOUT+5
  3747. SA6 MOUT+6
  3748. SA6 A1 ALSO ZERO -LONG-
  3749. EQ EXIT
  3750. *
  3751. JJ1 SA1 RSIZE
  3752. NZ X1,JJ2 IF NOT SIZE 0
  3753. RJ WIPE
  3754. EQ EXIT
  3755. *
  3756. JJ2 RJ LWIPE
  3757. EQ EXIT
  3758. * /--- BLOCK JEXITX 00 000 78/11/08 20.47
  3759. *
  3760. * NOTE--THE CODE FOR -JUDGE EXIT- IS ALSO JUMPED TO AT THE
  3761. * END OF -HELPOP- UNITS (AT ARROWS) AND -ERASEU- UNITS, SO
  3762. * ANY CHANGES TO -JUDGE EXIT- WILL ALSO AFFECT -HELPOP-S
  3763. * AND -ERASEU-S
  3764. *
  3765. ENTRY JEXITX
  3766. *
  3767. JEXITX CALL ARESET RESTORE ARROW SIZE AND ROTATE
  3768. SA1 TBITS
  3769. LX1 JUDGBIT
  3770. NG X1,JOVER --- EXIT IF JARROW TYPE JUDGING
  3771. SB7 XJUDGEC SWITCH TO JUDGE-C
  3772. CALL SETLC SET SCREEN LOC TO LAST CHAR
  3773. CALL ANSDAT
  3774. EQ EXIT AND EXIT LEAVING ANS INTACT
  3775. *
  3776. *
  3777. JOKQ SX6 -1 OKQUIT
  3778. SA6 TJUDGED
  3779. SA6 TANSOK
  3780. EQ ANSMARK
  3781. *
  3782. JNOQ SX6 1 NOQUIT
  3783. SA6 TJUDGED
  3784. MX6 0
  3785. SA6 TANSOK
  3786. EQ ANSMARK
  3787. *
  3788. JQUIT MX6 1 SET UP -QUIT- BIT
  3789. LX6 -QUITBIT
  3790. SA1 TBITS
  3791. BX6 X1+X6 SET -QUIT- BIT
  3792. SA6 A1
  3793. EQ ANSMARK
  3794. * /--- BLOCK LANG 00 000 79/08/13 08.09
  3795. TITLE LANG
  3796. * -LANG- COMMAND
  3797. * SETS -ZLANG- FOR APPROPRIATE LANGUAGE
  3798. *
  3799. LANGXC CALL GETTAG CONDITIONAL -LANG-
  3800. LANGX NG X5,PROCESS SKIP IF X-OPTION
  3801. LX5 1 ADJUST FOR 1 BIT LESS THEN NORM
  3802. MX2 LANGBTN LANGUAGE BITS FIELD LENGTH
  3803. BX6 X5*X2 CLEAR OFF OTHER BITS
  3804. LX2 LANGBTS MOVE BITS TO RIGHT PLACE
  3805. LX6 LANGBTS
  3806. SA1 STFLAG1 GET FLAG WORD
  3807. BX1 -X2*X1 CLEAR OUT OLD LANG SETTING
  3808. BX6 X6+X1 PUT IN NEW LANG SETTING
  3809. SA6 A1 STORE
  3810. EQ PROCESS ON TO NEXT COMMAND
  3811. *
  3812. *
  3813. * GETTAG IS USED FOR GETTING THE SPECIFIC VALUE
  3814. * FOR THE CONDITIONAL COMMANDS...
  3815. * LANG,SAYLANG,MODE,JUDGE,LESSON
  3816. *
  3817. *
  3818. GETTAG EQ *
  3819. *
  3820. NGETVAR EVALUATE CONDITION
  3821. * ROUNDS TO INTEGER IN -X1-
  3822. *
  3823. *
  3824. PL X1,GETTAG1
  3825. ZR X1,GETTAG1 TREAT -0 AS +0
  3826. SX1 -1 IF NEGATIVE, MAKE -1
  3827. GETTAG1 SX0 1
  3828. IX1 X1+X0 ADJUST VALUE TO RANGE FROM 0 TO N-1
  3829. SA5 A5 RETRIEVE COMMAND WORD
  3830. MX0 48 X0 = MASK TO LIMIT INFO TO 12 BITS
  3831. AX5 XCMNDL
  3832. BX2 -X0*X5 X2 = NUMBER OF ENTRIES IN TABLE
  3833. AX5 12
  3834. BX3 -X0*X5 X3 = RELATIVE START OF TABLE
  3835. SB2 B5+X3 B2 = ABSOLUTE START OF TABLE
  3836. IX3 X1-X2 SEE IF NUMBER IN BOUNDS
  3837. NG X3,GETTAG2 JUMP IF OK
  3838. SX1 X2-1 ELSE SET FOR LAST ENTRY
  3839. GETTAG2 SB1 1 B1 = CONSTANT 1
  3840. SX2 XJDGL
  3841. DX1 X1*X2 X1= TOTAL SHIFT COUNT REQUIRED
  3842. SB2 B2-B1 DECREMENT BEFORE STARTING LOOP
  3843. SX2 60
  3844. GETTAG3 IX1 X1-X2
  3845. SB2 B2+B1 ADVANCE WORD ADDRESS
  3846. PL X1,GETTAG3 JUMP IF NOT IN THIS WORD
  3847. IX1 X1+X2 RESTORE FINAL SHIFT COUNT
  3848. SA3 B2 X3 = WORD HOLDING CODE
  3849. SB2 X1 B2 = SHIFT COUNT
  3850. LX5 X3,B2 POSITION PROPER CODE AT TOP
  3851. EQ GETTAG RETURN
  3852. * /--- BLOCK NEXTNOW 00 000 79/05/05 22.49
  3853. TITLE NEXTNOW
  3854. *
  3855. * 'N'E'W -- INCLUDES CORRECTION TO FIX NEXTNOW/TIMEL
  3856. * INTERACTION PROBLEM
  3857. *
  3858.  
  3859. *
  3860. *
  3861. * -NEXTNOW- (CODE=73,74*)
  3862. *
  3863. NXTLKCX RJ CUNIT GET CONDITIONAL UNIT
  3864. NXTLKX AX5 48 NEXTNOW UNIT NUMBER
  3865. SA1 ILESUN LOAD PRESENT LESSON AND UNIT POINTERS
  3866. MX0 42
  3867. BX1 X0*X1 LESSON NUMBER
  3868. BX6 X1+X5 COMBINE
  3869. SA6 TNEXT STORE IN NEXT UNIT POINTER
  3870. *
  3871. * SAVE CURRENT LESSON/UNIT/COMMAND POINTER FOR
  3872. * RE-EXECUTION FOLLOWING A -TIMEL- BRANCH THAT
  3873. * MIGHT BREAK THROUGH THE -NEXTNOW-.
  3874. *
  3875. RJ JLPACK
  3876. SA6 AJOIN+JOINLTH SAVE IN ARROW JSTACK SO IT
  3877. * IS COPIED CORRECTLY
  3878. *
  3879. SX1 B7-XANSC SEE WHAT CONTINGENCY NOW IN
  3880. SB7 XNEXTLK SET TO NEXT-NOW-C
  3881. NZ X1,EXIT EXIT IF NOT IN ANS-C
  3882. MX7 0
  3883. SA7 TSPLOC CLEAR SPECS POINTER
  3884. EQ ANSMARK IF IN ANS-C GO ON TO MARK UP ANSWER
  3885. * /--- BLOCK KEY BRANCH 00 000 76/07/02 23.18
  3886. TITLE KEY BRANCHING COMMANDS
  3887. *
  3888. NEXTCX RJ CUNIT GET CONDITIONAL UNIT
  3889. NEXTX SB1 TNEXT SET NEXT KEY BRANCH
  3890. EQ TSTUFF
  3891. *
  3892. NEXT1CX RJ CUNIT
  3893. NEXT1X SB1 TNEXT1 SET NEXT1 KEY BRANCH
  3894. EQ TSTUFF
  3895. *
  3896. BACKCX RJ CUNIT
  3897. BACKX SB1 TBACK SET BACK KEY BRANCH
  3898. EQ TSTUFF
  3899. *
  3900. BACK1CX RJ CUNIT
  3901. BACK1X SB1 TBACK1 SET BACK1 KEY BRANCH
  3902. EQ TSTUFF
  3903. *
  3904. STOPCX RJ CUNIT
  3905. STOPX SB1 TSTOP SET STOP KEY BRANCH
  3906. EQ TSTUFF
  3907. *
  3908. STOP1CX RJ CUNIT
  3909. STOP1X SB1 TSTOP1 SET STOP1 KEY BRANCH
  3910. EQ TSTUFF
  3911. *
  3912. *
  3913. HELPCX RJ CUNIT
  3914. HELPX SB1 THELP SET HELP KEY BRANCH
  3915. EQ TSTUFF
  3916. *
  3917. HELP1CX RJ CUNIT
  3918. HELP1X SB1 THELP1 SET HELP1 KEY BRANCH
  3919. EQ TSTUFF
  3920. *
  3921. LABCX RJ CUNIT
  3922. LABX SB1 TLAB SET LAB KEY BRANCH
  3923. EQ TSTUFF
  3924. *
  3925. LAB1CX RJ CUNIT
  3926. LAB1X SB1 TLAB1 SET LAB1 KEY BRANCH
  3927. EQ TSTUFF
  3928. *
  3929. DATACX RJ CUNIT
  3930. DATAX SB1 TDATA SET DATA KEY BRANCH
  3931. EQ TSTUFF
  3932. *
  3933. DATA1CX RJ CUNIT
  3934. DATA1X SB1 TDATA1 SET DATA1 KEY BRANCH
  3935. EQ TSTUFF
  3936. *
  3937. *
  3938. BASECX RJ CUNIT
  3939. BASEX SB1 TBASE SET BASE UNIT
  3940. EQ TSTUFF
  3941. *
  3942. *
  3943. FINISCX RJ CUNIT
  3944. FINISHX SB1 TFINISH SET FINISH UNIT
  3945. EQ TSTUFF
  3946. *
  3947. *
  3948. IMAINCX RJ CUNIT
  3949. IMAINX SB1 TIMAIN
  3950. EQ TSTUFF
  3951. *
  3952. IARROCX RJ CUNIT
  3953. IARROWX SB1 TIARROW
  3954. EQ TSTUFF
  3955. *
  3956. IARROCAX RJ CUNIT
  3957. IARROWAX SB1 TIARROWA
  3958. EQ TSTUFF
  3959. *
  3960. EARROCX RJ CUNIT
  3961. EARROWX SB1 TEARROW
  3962. EQ TSTUFF
  3963. *
  3964. *
  3965. ERASUCX RJ CUNIT
  3966. ERASUX SB1 TERASE
  3967. EQ TSTUFF
  3968. * /--- BLOCK KEY BRANCH 00 000 78/02/17 13.47
  3969. *
  3970. *
  3971. HELPOCX RJ CUNIT
  3972. HELPOPX SB1 THELP
  3973. EQ TSTUFF1
  3974. *
  3975. HLP1OCX RJ CUNIT
  3976. HELP1OX SB1 THELP1
  3977. EQ TSTUFF1
  3978. *
  3979. *
  3980. LABOPCX RJ CUNIT
  3981. LABOPX SB1 TLAB
  3982. EQ TSTUFF1
  3983. *
  3984. LAB1OCX RJ CUNIT
  3985. LAB1OPX SB1 TLAB1
  3986. EQ TSTUFF1
  3987. *
  3988. *
  3989. DATAOCX RJ CUNIT
  3990. DATAOPX SB1 TDATA
  3991. EQ TSTUFF1
  3992. *
  3993. DAT1OCX RJ CUNIT
  3994. DATA1OX SB1 TDATA1
  3995. EQ TSTUFF1
  3996. *
  3997. *
  3998. NEXTOCX RJ CUNIT
  3999. NEXTOPX SB1 TNEXT
  4000. EQ TSTUFF1
  4001. *
  4002. NXT1OCX RJ CUNIT
  4003. NEXT1OX SB1 TNEXT1
  4004. EQ TSTUFF1
  4005. *
  4006. *
  4007. BACKOCX RJ CUNIT
  4008. BACKOPX SB1 TBACK
  4009. EQ TSTUFF1
  4010. *
  4011. BCK1OCX RJ CUNIT
  4012. BACK1OX SB1 TBACK1
  4013. EQ TSTUFF1
  4014. *
  4015. IFERRCX RJ CUNIT IFERROR COMMAND
  4016. IFERRX SB1 ERRUNIT
  4017. EQ TSTUFF
  4018. *
  4019. *
  4020. *
  4021. TSTUFF1 MX0 1 SET ON-PAGE UNIT BIT
  4022. EQ TSTUFF2
  4023. *
  4024. TSTUFF MX0 0 NOT ON-PAGE UNIT
  4025. EQ TSTUFF2
  4026. *
  4027. TSTUFF2 AX5 48 POINTER UNIT NUMBER
  4028. ZR X5,TBZERO CLEAR POINTER IF UNIT 0
  4029. NG X5,TBZERO NO SPECIAL UNITS HERE
  4030. BX5 X0+X5
  4031. MX0 42
  4032. SA1 ILESUN LOAD PRESENT LESSON AND UNIT POINTERS
  4033. BX1 X0*X1 LESSON NUMBER
  4034. BX6 X1+X5 COMBINE
  4035. SA6 B1 AND STORE IN SPECIFIED WORD
  4036. *
  4037. BX1 X5
  4038. CALL UEXIST SEE IF UNIT REALLY EXISTS
  4039. NG X6,PROC
  4040. *
  4041. TBZERO MX6 0 CLEAR POINTER
  4042. SA6 B1 STORE
  4043. EQ PROC --- RETURN
  4044. * /--- BLOCK ANSWERC 00 000 76/10/12 17.29
  4045. TITLE ANSWERC/WRONGC
  4046. *
  4047. ANSCXX NGETVAR OBTAINS CONDITION AND ROUNDS TO INTEGER
  4048. PL X1,ASC1 CLEAR UP NEGATIVE OUT OF BOUNDS
  4049. ZR X1,ASC1 TREAT -0 AS +0
  4050. SX1 -1 MAKE ALL NEGATIVES -1
  4051. ASC1 SX0 1
  4052. IX1 X1+X0 MAKE RANGE GO FROM 0 TO N+1
  4053. MX0 48
  4054. SA5 A5 MAKE SURE HAVE COMMAND WORD
  4055. AX5 12
  4056. BX2 -X0*X5 GET NUMBER OF ENTRIES IN TABLE
  4057. AX5 12
  4058. BX3 -X0*X5 GET RELATIVE START OF TABLE
  4059. SB2 B5+X3 ABSOLUTE START OF TABLE
  4060. IX3 X1-X2 SEE IF MAXIMUM NUMBER IN BOUNDS
  4061. NG X3,ANSC2
  4062. SX1 X2-1 IF NOT, SET TO END OF TABLE
  4063. ANSC2 SA1 B2+X1 GET TABLE ENTRY
  4064. BX5 X1 MAKE LIKE ANSWER CASE
  4065. PL X5,ASC9 IF REAL, PROCESS LIKE ANSWER COMMAND
  4066. * NEGATIVE FLAGS NULL CASE
  4067. SA3 TANSCNT IF NULL, MUST INCREMENT ANSWER COMMAND
  4068. SX7 X3+1 COUNTER
  4069. SA7 A3
  4070. EQ PROCESS AND THEN EXIT
  4071. *
  4072. ASC9 X NANSOV
  4073. *
  4074. * /--- BLOCK SAY 00 000 78/07/18 22.32
  4075. *
  4076. .SAYCMD IFNE SAYASSM,0
  4077. NSAYX SX6 2 -SAY-
  4078. NSAYX1 SA1 TBNARGS
  4079. LX1 51 POSITION LANGUAGE NUMBER LOWER
  4080. MX0 54
  4081. BX7 -X0*X1 EXTRACT LANGUAGE NUMBER
  4082. ZR X7,PROCESS 0 MEANS IGNORE
  4083. SA7 OVARG2 SAVE HERE FOR RETURN
  4084. SA1 MOUTLOC SEE IF MOUT HAS 100 WORDS LEFT
  4085. SX1 X1-MOUTLTH+100
  4086. PL X1,RETRNZ END TIME SLICE (BACK UP A5)
  4087. SA6 OVARG1
  4088. EXEC EXEC8,PACKOV
  4089. *
  4090. NSAYCX SX6 3 -SAYC-
  4091. EQ NSAYX1
  4092. *
  4093. * PACK ROUTINES RETURN HERE WITH OVARG1=CHAR COUNT, STRING
  4094. * STARTING AT INFO+0, ENDING WITH ZERO.
  4095. .SAYCMD ENDIF
  4096. ENTRY NSAYDO
  4097. .SAYCMD IFNE SAYASSM,0
  4098. NSAYDO SA1 OVARG2
  4099. SX2 X1-1
  4100. ZR X2,NSAYWES OVARG2=1 FOR WES (WORLD ENGLISH SPELLING)
  4101. SX2 X1-2
  4102. ZR X2,NSAYESP =2 FOR ESPERANTO
  4103. SX2 X1-3
  4104. ZR X2,NSAYIPA =3 FOR IPA
  4105. SX2 X1-4
  4106. ZR X2,NSAYSP =4 FOR SPANISH
  4107. EQ PROCESS **ADD MORE LANGUAGES HERE**
  4108. NSAYWES EXEC SAYX,WSAYOV
  4109. NSAYESP EXEC SAYX,ESAYOV
  4110. NSAYIPA EXEC SAYX,IPSAYOV
  4111. NSAYSP EXEC SAYX,SSAYOV
  4112. *
  4113. *PT 78/7/17
  4114. * SAYLX AX5 2*XCODEL GET LANGUAGE NUMBER (<64)
  4115. *PT
  4116. SAYLXC CALL GETTAG CONDITIONAL CASE
  4117. SAYLX NG X5,PROCESS SEE IF -X- OPTION
  4118. MX0 XJDGL
  4119. BX5 X0*X5 CLEAR OFF OTHER BITS
  4120. LX5 XJDGL
  4121. *PT
  4122. SA1 TBNARGS
  4123. LX1 51 POSITION LANGUAGE NUMBER LOWER
  4124. MX0 54
  4125. BX6 X0*X1 DELETE OLD NUMBER
  4126. BX6 X6+X5 INSERT NEW NUMBER
  4127. LX6 9 REPOSITION
  4128. SA6 A1
  4129. .SAYCMD ELSE
  4130. NSAYX BSS 0
  4131. NSAYCX BSS 0
  4132. NSAYDO BSS 0
  4133. SAYLXC BSS 0
  4134. SAYLX BSS 0
  4135. .SAYCMD ENDIF
  4136. EQ PROCESS
  4137. * /--- BLOCK OVERLAYS 00 000 80/02/10 05.10
  4138. *
  4139. * -INITIAL*-
  4140. *
  4141. INIT1X SX6 1
  4142. SX1 INITXOV
  4143. EQ PROCOV1
  4144. *
  4145. * -PUT- -PUTV-
  4146. *
  4147. PUTX MX6 0
  4148. PUTX1 SX1 PUTOV
  4149. EQ PROCOV1
  4150. *
  4151. PUTVX SX6 1
  4152. EQ PUTX1
  4153. *
  4154. * -SEARCH-
  4155. *
  4156. SEARCHX MX6 0 MARK FIRST CALL TO OVERLAY
  4157. SEARCH1 SA6 OVARG1
  4158. X SEARCHO
  4159. CALL TFIN INTERUPT
  4160. MX6 -1 MARK NOT FIRST CALL
  4161. EQ SEARCH1
  4162. *
  4163. * -SORTA- -SORT-
  4164. *
  4165. * RETURN TO -TEKTRON- COMMAND AFTER INTERRUPT
  4166. *
  4167. ENTRY TEKBRK
  4168. TEKBRK CALL TFIN
  4169. SX1 TEKTROV
  4170. SX6 1 VALUE FOR *OVARG1*
  4171. EQ PROCOV1
  4172. *
  4173. SORTAX MX6 0 -SORTA-
  4174. EQ SORT1
  4175. *
  4176. SORTX SX6 1 -SORT-
  4177. SORT1 SA6 OVARG1
  4178. X SORTOV
  4179. CALL TFIN INTERRUPT
  4180. SX6 2
  4181. EQ SORT1
  4182. *
  4183. * RETURN TO -LLFIND- OVERLAY AFTER INTERRUPT
  4184. *
  4185. ENTRY LLFBRK
  4186. LLFBRK CALL TFIN
  4187. SX1 LLFIND
  4188. EQ PROCOV1
  4189. *
  4190. * -COMPUTE- (LEVEL 1 OVERLAY)
  4191. * -SETSITE- (LEVEL 1 OVERLAY)
  4192. * -MATCH-
  4193. * -ANSWER-
  4194. * -CONTAIN-
  4195. * -CANT-
  4196. * -DISCARD-
  4197. *
  4198. COMPUTX X COMPTOV
  4199. *
  4200. SETSITX X SETSIOV
  4201. *
  4202. XMATCHX SX1 NMATOV
  4203. EQ PROCOV1
  4204. *
  4205. XANSX SX1 NANSOV
  4206. EQ PROCOV1
  4207. *
  4208. XANSAX SX1 ANSAOV
  4209. EQ PROCOV1
  4210. *
  4211. * -MARKUP-
  4212. *
  4213. MARKUPX SA1 TBERRMK ONLY NEGATIVE MEANS HOLDMARK
  4214. NG X1,MARKXXX
  4215. SA1 TSPECS OTHERWISE, CLEAR -SPECS HOLDMARK- BIT
  4216. MX6 1 SO MARKUP APPEARS NORMALLY...THE
  4217. LX6 60-HOLDMK MARKUP COMMAND OVER-RIDES ANY
  4218. BX6 -X6*X1 -SPECS HOLDMARK- ENCOUNTERED
  4219. SA6 A1
  4220. EQ PROCESS
  4221. *
  4222. MARKXXX SX1 MARKUP DELAYED MARKUP OF ANSWER
  4223. EQ PROCOV1
  4224. *
  4225. * -TOUCH(W)-
  4226. *
  4227. TOUCHX SX1 TOUCHOV
  4228. EQ PROCOV1
  4229. *///
  4230. *
  4231. * -SUBMITM-
  4232. *
  4233. * /--- BLOCK OVERLAYS 00 000 81/04/30 21.55
  4234. SUBXX SX6 1 -SUBMITX-
  4235. SA6 OVARG1
  4236. SUBX10 X SUBTMOV
  4237. CALL XSTOR,SBXNAM,BLKLTH ALLOCATE ECS
  4238. EQ SUBX10
  4239. *
  4240. *
  4241. * -NOBREAK-
  4242. *
  4243. NBREAKX X INTLOKV,2
  4244. *
  4245. *
  4246. * * -RECORDS RESTORE-
  4247. *
  4248. ENTRY RESTREC
  4249. EXT AREAOUT
  4250. RESTREC CALL AREAOUT
  4251. SA5 A5 RESTORE CURRENT COMMAND WORD
  4252. X RECORDS,1 FINISH -RECORDS RESTORE-
  4253. *
  4254. * VARIOUS GRAPHING COMMANDS
  4255. *
  4256. * -AXES- (FINE GRID)
  4257. * -BOUNDS- (FINE GRID)
  4258. *
  4259. AXESXF SX6 3
  4260. EQ BOUND1
  4261. *
  4262. BOUNDXF SX6 24
  4263. BOUND1 SX1 GRAFSOV
  4264. EQ PROCOV1
  4265. *
  4266. * INTERRUPT ROUTINES FOR GRAPHING OVERLAYS
  4267. *
  4268. ENTRY GRAFINT
  4269. ENTRY LABLINT
  4270. ENTRY BARINT
  4271.  
  4272. GRAFINT RJ TFIN FUNCT INTERRUPT
  4273. SX6 23
  4274. EQ BOUND1
  4275. *
  4276. *
  4277. LABLINT RJ TFIN LABEL INTERRUPT
  4278. SX6 25
  4279. EQ BOUND1
  4280. *
  4281. *
  4282. BARINT RJ TFIN BAR INTERRUPT
  4283. SX6 1
  4284. SX1 GRAF2OV
  4285. EQ PROCOV1
  4286. *
  4287. *
  4288. * /--- BLOCK PPTX1 00 000 77/09/15 20.04
  4289. TITLE PLATO PROGRAMMABLE TERMINAL COMMANDS
  4290. *
  4291. * VARIOUS PPT-RELATED COMMANDS
  4292. *
  4293. PPTA SA6 OVARG1
  4294. X PPT1OV
  4295. CALL TFIN INTERRUPT PROCESSING
  4296. BX6 X1 PASS X1 AS AN ARGUMENT
  4297. SA6 OVARG2
  4298. MX6 0
  4299. EQ PPTA
  4300. *
  4301. PPTADRX SX6 1
  4302. EQ PPTA
  4303. *
  4304. PPTDATX SX6 2
  4305. EQ PPTA
  4306. *
  4307. PPTRUNX SX6 3
  4308. EQ PPTA
  4309. *
  4310. EXTOUTX SX6 4
  4311. EQ PPTA
  4312. *
  4313. PPTOUTX SX6 5
  4314. EQ PPTA
  4315. *
  4316. PPTHLTX SX6 6
  4317. EQ PPTA
  4318. * /--- BLOCK PPTX2 00 000 80/02/06 05.21
  4319. *
  4320. PPTB SA6 OVARG1
  4321. X PPT2OV
  4322. CALL TFIN INTERRUPT PROCESSING
  4323. PPTRTNX BX6 X1 PASS X1 AS AN ARGUMENT
  4324. SA6 OVARG2
  4325. MX6 0
  4326. EQ PPTB
  4327. *
  4328. PPTLDX SX6 1
  4329. EQ PPTB
  4330. *
  4331. PPTTSTX SX6 2
  4332. EQ PPTB
  4333. *
  4334. PPTCLRX SX6 3
  4335. EQ PPTB
  4336. *
  4337. *
  4338. * -ASMBIT-
  4339. * SET FLAG TO MARK ASSEMBLY LANGUAGE PROGRAM MAY
  4340. * HAVE BEEN EXECUTED - CAUSES -CLEAR- KEY TO ACT
  4341. * AS -STOP1- KEY
  4342. *
  4343. ENTRY ASMBIT
  4344. ASMBIT EQ *
  4345. MX6 1
  4346. LX6 ASMPBIT POSITION ASSEMBLY PROG BIT
  4347. SA1 STFLAG1
  4348. BX6 X1+X6 SET BIT IN STATION BANK
  4349. SA6 A1
  4350. EQ ASMBIT
  4351. *
  4352. **
  4353. * /--- BLOCK LIBXXXX 00 000 82/06/28 10.43
  4354. TITLE LIBCALL/LIBRET EXECUTION.
  4355.  
  4356. * SET UP -SYSLIB- CALL. UNIT NAME RETURNED
  4357. * IN (OVARG1).
  4358.  
  4359. LIBCALX X LIBCALL PROCESS COMMAND ARGUMENTS
  4360. CALL SYSLIB,OVARG1,-1
  4361. SX6 B1
  4362. SA6 TRETURN STORE ERROR STATUS
  4363. EQ =XPROCESS
  4364.  
  4365. LIBRETX X LIBRET
  4366. EQ PROCESS
  4367.  
  4368.  
  4369. TITLE LOADMX - LOAD ORIENTAL MODULE TO TERMINAL.
  4370. ** LOADMX - LOAD ORIENTAL MODULE INTO TERMINAL.
  4371. *
  4372. * WORKS JUST LIKE *NTOSYS* IN DECK TUTORX.
  4373. *
  4374.  
  4375. LOADMX CALL SYSLIB,KLOADM,-1
  4376. EQ =XRETRNX FORCE TIME-SLICE AND EXIT
  4377.  
  4378. KLOADM DATA 5LLOADM
  4379.  
  4380.  
  4381. *
  4382. * -SUBMITX- BUFFER -- LESNAM TABLE ENTRY.
  4383. *
  4384. SBXNAM DATA 0 -SUBMITX- BUFFER NAME
  4385. DATA 0LSUBMITX
  4386. + VFD 60/6RBUFFER
  4387. + VFD 12/1,48/0
  4388. *
  4389. * /--- BLOCK OUTPUT 00 000 79/04/23 10.06
  4390. SPACE 3
  4391. *** OUTARRX OUTPUT ARROW
  4392. *
  4393. * PLOTS THE ARROW FOR TUTOR LESSONS.
  4394. * SHOULD NOT BE USED TO PLOT ARROWS FOR SYSTEM
  4395. * CALLS (LIKE IN SYSLIB FOR TERM ETC.)
  4396. *
  4397. ENTRY OUTARRX
  4398. OUTARRX EQ * ENTRY/EXIT
  4399. SA1 TBITS CHECK ARROW/ARROWA
  4400. LX1 ARRTPBT
  4401. SA3 ARRCHRS GET ARROW
  4402. SX2 5 PLOT 5 CHARS
  4403. PL X1,OUTARRL IF ARROW
  4404. LX3 30
  4405. OUTARRL SA4 INHIBS
  4406. LX4 BLDSHIF CHECK FOR BOLD
  4407. PL X4,OUTARRM
  4408. MX4 30
  4409. BX3 X3*X4 CLEAN UP CHARS
  4410. SX4 KUP*100B+1R8
  4411. BX3 X3+X4
  4412. LX3 -12
  4413. SX2 7
  4414. OUTARRM SA4 MOUTLOC
  4415. SX6 X4+2 INCREMENT OUTPUT POINTER
  4416. SA6 A4 NO OVERFLOW TESTS MADE
  4417. LX2 24 SHIFT COUNT UP
  4418. EQ OUTARRX -- EXIT
  4419.  
  4420.  
  4421. SPACE 3
  4422. *** OUTNX OUTPUT WITH TRUNCATION
  4423. *
  4424. * IDENTICAL TO -OUTPUT- EXCEPT THAT IN
  4425. * CASE OF OVERFLOW THE CODE IS SIMPLY
  4426. * NOT PUT INTO THE OUTPUT BUFFER (RATHER THAN
  4427. * BRANCHING TO AN ERROR EXIT) AND PROCESSING
  4428. * CONTINUES.
  4429. *
  4430. * 'USES REGISTERS X1,X2,X6 AND A2,A6.
  4431. *
  4432. ENTRY OUTNX
  4433. OUTNX EQ * ENTRY/EXIT
  4434. SA2 MOUTLOC
  4435. SX6 X2-MOUTLTH
  4436. PL X6,OUTNX -- RETURN
  4437. SX6 X2+1
  4438. SA6 A2
  4439. MX6 36 SETS *MOUT* CHECK OK (NEG)
  4440. LX1 24
  4441. BX1 X1*X6
  4442. EQ OUTNX -- EXIT
  4443.  
  4444.  
  4445. * /--- BLOCK OUTPUT 00 000 79/04/23 10.06
  4446. SPACE 3
  4447. *** OUTPX OUTPUT WITHOUT OVERFLOW CHECKS
  4448. *
  4449. * IDENTICAL TO -OUTPUT- EXCEPT THAT NO
  4450. * OVERFLOW CHECK IS MADE AND NO MASKING
  4451. * IS DONE FOR PROTECTION. 'FOR USE WHEN
  4452. * EVERYTHING IS KNOWN TO BE OK.
  4453. *
  4454. * 'USES REGISTERS X1,X2,X6 AND A2,A6.
  4455. *
  4456. ENTRY OUTPX
  4457. OUTPX EQ * ENTRY/EXIT
  4458. SA2 MOUTLOC
  4459. SX6 X2+1
  4460. SA6 A2
  4461. LX1 24
  4462. EQ OUTPX -- EXIT
  4463.  
  4464.  
  4465. SPACE 3
  4466. *** OUTPUTX OUTPUT DATA TO FORMATTER
  4467. *
  4468. * 'EXPECTS X1 TO HOLD PARAMETER INFO TO COMBINE
  4469. * WITH THE OUTPUT CODE -ARG- AND PUTS THE RESULTANT
  4470. * CODE INTO THE OUTPUT BUFFER *MOUT*.
  4471. *
  4472. * 'THE FOLLOWING REGISTERS ARE USED--
  4473. * X1,X2,X6 AND A2,A6 (X1 IS SHIFTED UP 24 BITS
  4474. * BY THIS ROUTINE).
  4475. *
  4476. ENTRY OUTPUTX
  4477. OUTPUTX EQ * ENTRY/EXIT
  4478. RJ OUTCODX SEND OUTPUT CODE
  4479. EQ OUTPUTX -- EXIT
  4480.  
  4481.  
  4482. SPACE 3
  4483. *** OUTCODX OUTPUT CODE TO FORMATTER
  4484. *
  4485. ENTRY OUTCODX
  4486. OUTCODX EQ * ENTRY/EXIT
  4487. SA2 MOUTLOC
  4488. SX6 X2-MOUTLTH
  4489. PL X6,=XERROROF
  4490. SX6 X2+1
  4491. SA6 A2
  4492. MX6 36
  4493. LX1 24
  4494. BX1 X1*X6
  4495. EQ OUTCODX -- EXIT
  4496.  
  4497. SPACE 3
  4498. *** OUTPTWX OUTPUT WORD TO FORMATTER
  4499. *
  4500. * OUTPUT A WORD TO THE FORMATTER.
  4501. *
  4502. * X2 HOLDS CHAR. COUNT TO OUTPUT (LESS THAN 11)
  4503. * X3 HOLDS CHARS TO OUTPUT (LEFT JUSTIFIED)
  4504. *
  4505. ENTRY OUTPTWX
  4506. OUTPTWX EQ * ENTRY/EXIT
  4507. SA4 MOUTLOC
  4508. SX6 X4+2
  4509. SA6 A4
  4510. LX2 24
  4511. SX6 20000B+WRTCODE
  4512. BX6 X2+X6
  4513. SA6 MOUT+X4
  4514. BX6 X3
  4515. SA6 A6+1
  4516. EQ OUTPTWX -- EXIT
  4517.  
  4518. * /--- BLOCK END 00 000 79/04/22 03.56
  4519. TITLE SEND EXT CODES TO CLIENT SOFTWARE
  4520. *** CLIENT - SENDS EXT CODES TO CLIENT SOFTWARE
  4521. *
  4522. * USES A - 1
  4523. * B - 1,2
  4524. * X - 0,1
  4525. *
  4526. * INPUT'; B1 = EXT CODE
  4527. * B2 = VALUE TO BE ADDED TO EXT
  4528. *
  4529. *
  4530. ENTRY CLIENT
  4531. CLIENT EQ * ENTRY/EXIT
  4532. SA1 STFLAG1 GET TERMINAL INFO WORD
  4533. MX0 -TTBTN SET MASK FOR TERM TYPE FIELD
  4534. LX1 TTBTN-TTBTS POSITION TERM TYPE FIELD
  4535. BX0 -X0*X1 GET TERM TYPE
  4536. SX0 X0-ASCTYPE SEE IF ASCII TERM (ZTTTYPE=12)
  4537. NZ X0,CLIENT IF NOT ASCII, EXIT
  4538. SA1 BANKADD GET WORD HOLDING TERM SUBTYPE
  4539. MX0 -TSBTN SET MASK TO GET DATA
  4540. LX1 TSBTN-TSBTS POSITION DATA TO END OF WORD
  4541. BX1 -X0*X1 MASK OUT TERM SUBTYPE
  4542. SX0 X1-SBTWIN SEE IF WINDOWS TERMINAL
  4543. ZR X0,CLIENT1 SEND -EXT- CODE
  4544. SX0 X1-SBTMAC SEE IF MACINTOSH SYSTEM
  4545. ZR X0,CLIENT1 SEND -EXT- CODE
  4546. EQ CLIENT -- RETURN
  4547.  
  4548. CLIENT1 SX1 B1 -EXT- CODE
  4549. SX1 X1+B2 ADD ADDITIONAL VALUE TO -EXT-
  4550. OUTCODE EXTCODE OUTPUT CODE TO FORMATTER
  4551. EQ CLIENT RETURN
  4552. *
  4553. * /--- BLOCK END 00 000 79/04/22 03.56
  4554. TITLE MACRO ROUTINES
  4555. *** GETSEG - GET SEGMENT FROM 15-BIT SEGMENT ARAY
  4556. *
  4557. * ROUTINE USED BY *DISKFIO*, *FILEX*, *NAMEX*
  4558. * *RECORDX*, AND *RESERV*
  4559. *
  4560. ENTRY GETSEG
  4561. GETSEG EQ * ENTRY/EXIT
  4562. SX7 X1-1 RECORD NUMBER RELATIVE TO ZERO
  4563. MX6 -2
  4564. BX2 -X6*X7 GET LOWER 2 BITS OF REC. NO.
  4565. SX6 15
  4566. IX6 X2*X6 0,15,30,45
  4567. AX7 2 GET BIAS TO RAT WORD
  4568. SX2 45
  4569. IX6 X2-X6 45,30,15,0
  4570. SB1 X7
  4571. SA2 A0+B1 GET ALLOCATION WORD
  4572. SB1 X6 RETURN SHIFT COUNT TO CALLER
  4573. AX2 X2,B1 NEXT POINTER TO LOWER 15 BITS
  4574. MX7 -15
  4575. BX2 -X7*X2 EXTRACT NEXT RECORD NUMBER
  4576. EQ GETSEG -- RETURN
  4577. *
  4578. * /--- BLOCK END 00 000 79/04/22 03.56
  4579. *
  4580. END
plato.source/plaopl/exec1.txt ยท Last modified: 2021/02/06 16:22 by 127.0.0.1