CDC Community

๐Ÿ”น Historical Conservation ๐Ÿ”น

User Tools

Site Tools


plato.source:plaopl:deflex

DEFLEX

Table Of Contents

  • [00006] INTERPRETATION OF DEFINE
  • [00034] DEFNLEX
  • [00079] PROCESS PRIMITIVE DEFINE
  • [00276] PROCESS NORMAL DEFINE
  • [00418] PROCESS FUNCTION DEFINE
  • [00759] DEFINE INFO STORAGE / RETRIEVAL
  • [01150] -VSEEK- IDENTIFY DEFINED NAME

Source Code

DEFLEX.txt
  1. DEFLEX
  2. * /--- FILE TYPE = E
  3. * /--- BLOCK DEFNLEX 00 000 78/12/18 21.16
  4. IDENT DEFLEX
  5. ***NOTE THERE IS ANOTHER IDENT VSEEK IN THIS FILE....
  6. TITLE INTERPRETATION OF DEFINE
  7. *
  8. *
  9. * -DEFNLEX-
  10. * CALLED BY -VSEEK- WHEN A DEFINED NAME IS FIRST
  11. * RECOGNIZED .. -DEFNLEX- IDENTIFIES THE TYPE OF
  12. * DEFINE (PRIMITIVE,NORMAL OR FUNCTION) AND PASSES
  13. * TO THE PROPER INTERPRETATION ROUTINE
  14. *
  15. *
  16. CST
  17. *
  18. *
  19. IFPLT PLATO
  20. EXT WHATSIN
  21. *
  22. *CALL LEXTXT
  23. *
  24. IFPLT ENDIF
  25. *
  26. EXT CHARERR,BADPAR,DECERR,VARERR
  27. EXT LOGERR,FORMERR,EQERR,OCTERR
  28. EXT ALFERR,INDXERR,DEFERR,SEGERR,MATERR
  29. EXT COMPERR,LNGERR,LITERR,TEMPERR
  30. EXT ALLERR,ECSPRTY,TSTERR
  31. EXT LEX,LEXADD,KEYTYPE
  32. *
  33. * /--- BLOCK DEFNLEX 00 000 78/12/18 21.17
  34. TITLE DEFNLEX
  35. *
  36. *
  37. ENTRY DEFNLEX
  38. DEFNLEX ZERO UADTYPE,NUMAX ZERO *UADTYPE*
  39. SA3 ADTYPE *GETVAR* CODE
  40. NG X3,ERR6
  41. MX0 60-XCODEAL
  42. BX1 -X0*X3 MASK OFF ADDRESS
  43. AX3 XCODEAL
  44. MX7 -4 4 BIT MASK
  45. BX2 -X7*X3 MASK OFF TYPE AND I/F BIT
  46. SB1 X2
  47. JP B1+*+1
  48. *
  49. * SEPARATE NORMAL / PRIMITIVE DEFINES
  50. *
  51. + EQ ADDRDEF SHORT LITERAL
  52. + EQ LITDEF LONG LITERAL
  53. + EQ ADDRDEF STUDENT
  54. + EQ ADDRDEF COMMON
  55. + EQ NORMDEF NORMAL (OR FUNCTION) DEFINE
  56. + EQ SEGDEF SEGMENT
  57. + EQ ARAYDEF ARRAY/COMPLEX
  58. + EQ ERR6 IMPOSSIBLE CODE TYPE
  59. *
  60. + EQ UNITDEF UNIT
  61. + EQ LITDEF LONG LITERAL
  62. + EQ ADDRDEF STUDENT
  63. + EQ ADDRDEF COMMON
  64. + EQ ERR6 IMPOSSIBLE CODE TYPE
  65. + EQ ERR6 IMPOSSIBLE CODE TYPE
  66. + EQ ERR6 IMPOSSIBLE CODE TYPE
  67. + EQ ERR6 IMPOSSIBLE CODE TYPE
  68. *
  69. *
  70. * SEPARATE FUNCTION / NORMAL DEFINES
  71. *
  72. NORMDEF RJ SETDEF SET POINTERS TO DEFINE INFO
  73. RJ GETDEF GET NUMBER OF ARGUMENTS
  74. ZR X1,DEFINIT NORMAL IF NO ARGUMENTS
  75. EQ FUNDEF
  76. *
  77. *
  78. * /--- BLOCK PRIMITIVE 00 000 77/02/25 03.55
  79. TITLE PROCESS PRIMITIVE DEFINE
  80. *
  81. *
  82. * RETRIEVE LONG LITERAL
  83. *
  84. LITDEF BSS 0
  85. RJ LITRAL PUT LITERAL IN X7
  86. SA1 ADTYPE
  87. BX6 X1
  88. EQ ADDRDEF
  89. *
  90. *
  91. * ROUTINE TO ADD LITERAL TO LIT TABLE
  92. * RETURNS X1,X7 WITH LIT, X6 WITH ADDRESS
  93. * DO NOT DESTROY X3 OR A0
  94. *
  95. * LITRAL SEEMS UNUSED OUTSIDE (BAS 1/26/77)
  96. * ENTRY LITRAL USED IN DEFINE/SEGMENT/ARRAY
  97. *
  98. LITRAL EQ *
  99. SA2 ATOKEN ADDRESS OF TOKEN TABLE
  100. IX0 X1+X2 ECS ADDRESS OF LITERAL
  101. SX2 A0 SAVE -A0-
  102. SA0 IWK
  103. + RE 1 READ LITERAL FROM ECS
  104. RJ ECSPRTY
  105. SA0 X2 RESTORE -A0-
  106. BX6 X1 (X6) = ADDRESS OF LITERAL
  107. SA1 IWK LOAD LITERAL
  108. BX7 X1 (X7) = LITERAL
  109. EQ LITRAL
  110. *
  111. * /--- BLOCK SEGMENT 00 000 78/12/12 23.17
  112. *
  113. * PROCESS SEGMENT DEFINE
  114. *
  115. SEGDEF BSS 0
  116. RJ LITRAL (X7) = SEGMENT WORD, (X6) =ADDR
  117. SA7 SEGLIT SAVE LITERAL
  118. SX1 5
  119. LX1 XCODEAL TYPE 5 = SEGMENT
  120. BX6 X6+X1
  121. SA6 SEGADD SAVE
  122. SX6 OPSEG
  123. SA6 OP ALSO RETURN OP CODE
  124. LX7 3
  125. NG X7,SEGD3 IF SEGMENTF
  126. SEGD2 SA1 LASTKEY
  127. NG X1,ERR7
  128. SA1 X1+KEYTYPE
  129. SX2 X1-OP( MUST BE INDEXED
  130. NZ X2,ERR7
  131. SEGD3 SA1 LEXADD MUST SAVE BRANCH ADDRESS
  132. BX6 X1
  133. SA6 LEADDSV
  134. SX6 SEGD1 LEX WILL BRANCH TO -SEGD1-
  135. SA6 LEXADD
  136. EQ LEX RETURN
  137. *
  138. SEGD1 SA1 SEGADD RESTORE *ADTYPE*
  139. SA2 SEGLIT FETCH LITERAL
  140. BX6 X1
  141. LX2 3
  142. NG X2,SEGF1 IF SEGMENTF
  143. SA1 LEADDSV
  144. BX7 X1 RESTORE -LEXADD-
  145. SA7 LEXADD
  146. EQ ADRET RETURN
  147. *
  148. * PROCESS SEGMENTF
  149. *
  150. SEGF1 SX7 SEGF2 SET NEXT RETURN POINT
  151. SA7 LEXADD
  152. EQ ADRET
  153. *
  154. SEGF2 SX6 OP( RETURN A (
  155. SX7 SEGF3
  156. SA7 LEXADD SET NEXT RETURN POINT
  157. EQ OPRET
  158. *
  159. SEGF3 SX6 1 RETURN A *1* AS A SHORT LITERAL
  160. SX7 SEGF4
  161. SA7 LEXADD SET NEXT RETURN POINT
  162. EQ ADRET
  163. *
  164. SEGF4 SX6 OP) RETURN A )
  165. SA1 LEADDSV RESTORE *LEXAD*
  166. BX7 X1
  167. SA7 LEXADD
  168. SA6 OP SAVE OPERATOR TYPE
  169. MX6 0
  170. SA6 ADTYPE CLEAR ADDRESS TYPE
  171. EQ IMMULT CHECK FOR IMPLIED MULTIPLY
  172. * /--- BLOCK ARRAY 00 000 78/12/12 00.30
  173. *
  174. * PROCESS ARRAY/COMPLEX DEFINE
  175. *
  176. ARAYDEF SA0 X1 SAVE LITERAL ADDRESS
  177. RJ LITRAL (X7) = LITERAL, (X6) = ADDRESS
  178. SX4 6 6=GETVARTYPE FOR ARRAY/COMPLEX
  179. LX4 XCODEAL
  180. BX6 X6+X4 MERGE CODE AND LITERAL ADDRESS
  181. SA6 SEGADD SAVE FOR NEXT LEX PASS
  182. LX1 6 ISOLATE DIMENSIONS
  183. MX2 58
  184. BX1 -X2*X1
  185. BX6 X6-X6 CLEAR SEGLIT FOR RE-ENTRY
  186. SA6 SEGLIT
  187. SX6 OPSCAL MARK AS SCALAR
  188. ZR X1,ARAYD0 JUMP IF SCALAR
  189. SX1 X1-2
  190. SX6 OPMAT MARK AS MATRIX
  191. ZR X1,ARAYD0 JUMP IF MATRIX
  192. PL X1,MATERR NO 3-D ALLOWED YET
  193. SX6 OPVEC IS VECTOR
  194. ARAYD0 SA6 OP RETURN PROPER ARRAY OPCODE
  195. LX7 4
  196. MX0 58
  197. BX0 -X0*X7
  198. ZR X0,SEGD3 JUMP IF NO ARAYWD2,SETUP RETURN
  199. SX1 A0+1 GET DEFLIT ADDR OF 2D LITERAL
  200. RJ LITRAL (X7) = SECOND 2D DESCRIPTOR WD
  201. EQ SEGD3 SETUP RETURN FROM -LEX-J
  202. *
  203. * /--- BLOCK PRIMITIVE 00 000 78/12/18 21.18
  204. *
  205. * PROCESS UNIT (DIMENSION) DEFINE
  206. *
  207. UNITDEF RJ UNITD PROCESS UNIT DEFINE
  208. EQ ADDRDEF
  209. *
  210. *
  211. UNITD EQ *
  212. SA1 UDMODE SEE IF SHOULD INTERPRET UNIT
  213. ZR X1,UNITD
  214. SA1 NLITS
  215. SX6 X1+1 INCREMENT COUNT
  216. SX2 X1-LITL CHECK FOR BUFFER FULL
  217. PL X2,LITERR NO ROOM FOR NEW LIT
  218. SA6 A1
  219. SA2 =1.0 VALUE OF UNIT IS 1.0
  220. BX7 X2
  221. SA7 X6+LITS STORE LITERAL
  222. MX6 -1 MARK UNIT ENCOUNTERED
  223. SA6 UAD
  224. ZERO UADTYPE,NUMAX PRE-CLEAR *UADTYPE*
  225. SA1 NUNITS
  226. PL X1,UD100 JUMP IF PROCESSING UNITS
  227. SX2 X1+2
  228. ZR X2,UD200 EXIT IF UNITS NOT DESIRED
  229. SA2 NDEFU
  230. BX6 X2 SET *NUNITS* = UNITS DEFINED
  231. SA6 A1
  232. ZERO UADS,UADSMAX PRE-CLEAR *UADS* BUFFER
  233. *
  234. UD100 MX0 -XCODEAL MASK FOR ADDRESS PORTION
  235. SA1 ADTYPE
  236. BX1 -X0*X1 MASK OFF INDEX IN *UADTYPE*
  237. SA7 X1+UADTYPE STORE 1.0 IN *UADTYPE*
  238. *
  239. UD200 SX6 411B LONG FLOATING LIT IN *LITS*
  240. LX6 XCODEAL CODE FOR LONG FLOATING LITERAL
  241. SA3 NLITS
  242. BX6 X3+X6 ATTACH INDEX IN *LITS*
  243. SA6 ADTYPE
  244. EQ UNITD
  245. *
  246. * /--- BLOCK PRIMITIVE 00 000 74/03/06 17.52
  247. *
  248. ADDRDEF MX6 0
  249. SA6 OP CLEAR OP FOR ADDRESS
  250. IMMULT SA1 LASTKEY
  251. NG X1,LEX JUMP IF LASTKEY NOT AVAILABLE
  252. SX2 X1-1R( CHECK FOR IMPLIED MULT
  253. ZR X2,MULTY GO INSERT A *
  254. SX2 X1-KLBRACK
  255. ZR X2,MULTY
  256. SA2 X1+KEYTYPE
  257. ZR X2,MULTY JUMP IF NUMBER
  258. NG X2,MULTY JUMP IF ALPHA
  259. EQ LEX RETURN
  260. *
  261. MULTY SA1 LEXADD MUST SAVE BRANCH ADDRESS
  262. BX6 X1
  263. SA6 LEADDSV
  264. SX6 MULT LEX WILL BRANCH TO -MULT-
  265. SA6 LEXADD
  266. EQ LEX RETURN
  267. *
  268. MULT SA1 LEADDSV
  269. BX6 X1 RESTORE -LEXADD-
  270. SA6 LEXADD
  271. SX6 OPMULT RETURN A *
  272. EQ OPRET
  273. *
  274. *
  275. * /--- BLOCK EXPRESSION 00 000 74/02/24 04.45
  276. TITLE PROCESS NORMAL DEFINE
  277. *
  278. *
  279. * BEGIN PROCESSING OF NORMAL DEFINE
  280. *
  281. DEFINIT SA1 LEXADD MUST SAVE BRANCH ADDRESS
  282. BX6 X1
  283. SA6 OLDADD
  284. SX6 DEFLEX LEX WILL CALL DEFLEX
  285. SA6 LEXADD
  286. MX6 1
  287. LX6 XCODEAL FORM MASK FOR *UNIT* BIT
  288. SA1 ADTYPE
  289. BX1 X6*X1 SEE IF THIS DEFINE INVOLVES
  290. ZR X1,DEFI10 A UNIT (DIMENSION)
  291. MX6 -1
  292. SA6 UAD FLAG *UNIT* ENCOUNTERED
  293. *
  294. DEFI10 SX6 OP( START WITH LEFT PAREN
  295. EQ OPRET
  296. *
  297. * /--- BLOCK EXPRESSION 00 000 78/12/18 21.18
  298. *
  299. * -DEFLEX- PROCESS NORMAL DEFINE
  300. *
  301. DEFLEX RJ GETDEF GET NEXT ITEM OF DEFN
  302. NG X1,DFLADD JUMP IF ADDRESS
  303. SX2 X1-EOL
  304. ZR X2,EXIT JUMP IF END OF LINE
  305. BX6 X1
  306. *
  307. OPRET SA6 OP RETURN OPCODE
  308. MX6 0 CLEAR *ADTYPE*
  309. SA6 ADTYPE
  310. EQ LEX RETURN TO *LEX*
  311. *
  312. DFLADD ZERO UADTYPE,NUMAX ZERO *UADTYPE*
  313. MX0 60-XCODEL+1
  314. BX6 -X0*X1 CLEAR EXTENDED SIGN
  315. MX0 -4
  316. AX1 XCODEAL POSITION I/F BIT AND TYPE
  317. BX1 -X0*X1
  318. SB1 X1
  319. JP B1+*+1 JUMP BY TYPE CODE
  320. *
  321. + EQ ADRET SHORT LITERAL
  322. + EQ DLLIT LONG LITERAL
  323. + EQ ADRET STUDENT
  324. + EQ ADRET COMMON
  325. + EQ ERR6 IMPOSSIBLE
  326. + EQ SEGAD SEGMENT
  327. + EQ ARAYAD ARRAY
  328. + EQ ERR6 IMPOSSIBLE
  329. *
  330. + EQ UNITAD UNIT
  331. + EQ DLLIT LONG LITERAL
  332. + EQ ADRET STUDENT
  333. + EQ ADRET COMMON
  334. + EQ ERR6 IMPOSSIBLE
  335. *+ EQ SEGAD SEGMENT REPLACED BY FOLLOWING LINE - BAS
  336. + EQ ERR6 IMPOSSIBLE
  337. + EQ ERR6 IMPOSSIBLE
  338. + EQ ERR6 IMPOSSIBLE
  339. *
  340. * /--- BLOCK EXPRESSION 00 000 78/12/12 23.17
  341. *
  342. DLLIT BSS 0
  343. MX0 -XCODEAL
  344. BX1 -X0*X6 FORMER ADDRESS
  345. BX7 X1 (X7) = NEW ADDR SAME AS OLD
  346. SA2 ATOKEN POINTER TO TOKEN BUFFER
  347. IX0 X1+X2
  348. SA0 IWK
  349. + RE 1 READ LITERAL FROM ECS TABLE
  350. RJ ECSPRTY
  351. SA1 A0 LOAD LITERAL
  352. MX0 -XCODEAL
  353. BX2 X0*X6 THROW AWAY ADDRESS
  354. BX6 X2+X7 CODE + ADDRESS
  355. *
  356. ADRET SA6 ADTYPE RETURN *GETVAR* CODE
  357. ADRET1 MX6 0
  358. SA6 OP CLEAR *OP* FOR ADDRESS
  359. EQ LEX
  360. *
  361. SEGAD MX0 -XCODEAL MASK OFF ADDRESS
  362. BX1 -X0*X6
  363. RJ LITRAL (X7) = SEG DESCRIPTOR,(X6)=ADDR
  364. SX7 5
  365. LX7 XCODEAL TYPE 5 = SEGMENT
  366. BX6 X6+X7
  367. EQ ADRET
  368. *
  369. ARAYAD MX0 -XCODEAL MASK OFF ADDRESS
  370. BX1 -X0*X6
  371. SA0 X1 SAVE LIT ADDRESS
  372. RJ LITRAL GET LITERAL ARRAY WORD
  373. LX7 4 CHECK FOR NEEDING 2ND INFO WD
  374. MX0 58
  375. BX0 -X0*X7
  376. ZR X0,ARAYAD1 ONLY ONE INFO WORD
  377. SX1 A0+1
  378. RJ LITRAL GET 2ND WORD
  379. SX6 X6-1 BACK UP NLITS POINTER
  380. ARAYAD1 SX7 6
  381. LX7 XCODEAL TYPE 6 = ARRAY
  382. BX6 X6+X7
  383. EQ ADRET
  384. *
  385. UNITAD SA6 ADTYPE PRE-SET *ADTYPE*
  386. RJ UNITD PROCESS *UNIT*
  387. EQ ADRET1
  388. *
  389. EXIT SA2 LASTKEY
  390. NG X2,EXIT2 JUMP IF LASTKEY NOT AVAILABLE
  391. SX1 X2-1R( CHECK FOR LEFT PARENS
  392. ZR X1,MULTYD THEN NEED *
  393. SX1 X2-KLBRACK CHECK FOR LEFT BRACKET
  394. ZR X1,MULTYD
  395. SA1 X2+KEYTYPE
  396. NG X1,MULTYD NEED * IF ALPHA
  397. ZR X1,MULTYD NEED * IF NUMBER
  398. *
  399. EXIT2 SA1 OLDADD
  400. BX6 X1 RESTORE *LEX*
  401. SA6 LEXADD
  402. SX6 OP) END WITH RIGHT PAREN
  403. EQ OPRET
  404. *
  405. MULTYD SX6 MULTD INSERT IMPLICIT *
  406. SA6 LEXADD
  407. SX6 OP) END DEFINE WITH RIGHT PAREN
  408. EQ OPRET
  409. *
  410. MULTD SA1 OLDADD
  411. BX6 X1 RESTORE
  412. SA6 LEXADD
  413. SX6 OPMULT RETURN A *
  414. EQ OPRET
  415. *
  416. *
  417. * /--- BLOCK FUNDEF 00 000 77/01/30 11.52
  418. TITLE PROCESS FUNCTION DEFINE
  419. *
  420. *
  421. * FUNCTION DEFINES ARE HANDLED BY A TWO PASS
  422. * PROCEEDURE - IN THE FIRST PASS -LEX- IS DRIVEN
  423. * TO CONVERT THE RAW SOURCE OF THE FUNCTION
  424. * ARGUMENT(S) TO TOKENS - THE SECOND PASS RETURNS
  425. * THE TOKENS OF THE FUNCTION THROUGH -LEX- AND
  426. * INSERTS THE ARGUMENT TOKENS WHEN NEEDED
  427. *
  428. *
  429. * -FUNDEF-
  430. * BEGIN PROCESSING OF FUNCTION DEFINES
  431. *
  432. FUNDEF SA1 LEX SAVE RJ ADDRESS OF LEX
  433. BX6 X1
  434. SA6 LEXSAV
  435. *
  436. PLATO
  437. FBFL SET MAXLEV*LEVLTH
  438. 1 ERRPL FBFL-LV0LTH+1 BUFFER TOO SMALL
  439. MX7 -1 LEVEL 0 OVERLAY BUFFER USED
  440. * (LEVEL 1 OVERLAY CONTAINS ANSV, ETC., OR COMPUTE)
  441. SA7 WHATSIN+0
  442. ****
  443. SA1 65B ADDRESS OF BLANK COMMON
  444. SX7 X1+LV0ADD+1 ADDRESS FOR BUFFERS
  445. ENDIF
  446. *
  447. CONDEN
  448. SX7 DEFNBUF
  449. ENDIF
  450. *
  451. SA7 DEFNCM SAVE ADDRESS OF BUFFER
  452. SX6 1
  453. SA6 VSKMODE DONT EXPAND FUNCTION DEFINES
  454. MX6 0
  455. SA6 UDMODE NO INTERPRETATION OF *UNITS*
  456. SA6 LEXADD SET LEX TO NORMAL MODE
  457. SA6 DEPTH CLEAR NESTING LEVEL
  458. SA1 DEFNCM
  459. BX7 X1 ADD OF WORK AREA IN UNIT BUFF
  460. SA7 FUNLST FIRST FUNCTION ADDRESS
  461. SB1 B0
  462. SB2 MAXLEV
  463. *
  464. PRECLR SA7 B1+LOCS INITIALIZE POINTERS
  465. SX7 X7+LEVLTH
  466. SA7 B1+LIMS SET END TEST FOR LEVEL
  467. SB1 B1+1
  468. LT B1,B2,PRECLR
  469. SB1 B0 INITIALIZE DEPTH
  470. RJ PREFUN INITIALIZE FIRST FUNCTION
  471. SX1 EOL
  472. RJ PREPUT ADD AN END OF LINE CODE
  473. SX6 1
  474. SA6 DEPTH ADVANCE DEPTH FOR ARGS
  475. *
  476. *
  477. * -PREPASS-
  478. * PERFORM LEXICAL ANALYSIS OF FUNCTION ARGUMENTS
  479. * ANALYSES NESTING OF FUNCTIONS
  480. *
  481. PREPASS RJ LEX GET NEXT LEXICAL ITEM
  482. SA1 DEPTH FUNCTION NESTING LEVEL
  483. SB1 X1
  484. SA1 OP
  485. ZR X1,PREADD JUMP IF ADDRESS
  486. SX2 X1-OPCOMMA CHECK FOR COMMA
  487. ZR X2,PRECOMA
  488. SX2 X1-OPDEFN CHECK FOR FUNCTION DEFINE
  489. ZR X2,PRENEST
  490. SX2 X1-EOL CHECK FOR END OF LINE
  491. ZR X2,ERR3
  492. * /--- BLOCK PREADD 00 000 74/09/02 11.50
  493. RJ PREPUT STORE OP CODE
  494. SX2 X1-OP( CHECK FOR LEFT PAREN
  495. ZR X2,PRELP
  496. SX2 X1-OP) CHECK FOR RIGHT PAREN
  497. ZR X2,PRERP
  498. EQ PREPASS
  499. *
  500. PREADD SA1 ADTYPE GETVAR CODE
  501. NG X1,PREARG
  502. MX2 1
  503. BX1 X1+X2 SET SIGN BIT FOR ADDRESS
  504. RJ PREPUT STORE CODE
  505. EQ PREPASS
  506. *
  507. PREARG SX1 OPARG UNDEFINED NAME ASSUMED ARG
  508. RJ PREPUT
  509. SX1 -1
  510. RJ PREPUT
  511. SA1 AD STORE ARGUMENT NAME
  512. RJ PREPUT
  513. EQ PREPASS
  514. *
  515. PRECOMA SX7 -1 KILL *LASTKEY*
  516. SA7 LASTKEY
  517. SX1 OP) INSERT PAREN
  518. RJ PREPUT
  519. SX1 EOL INSERT AN END OF LINE CODE
  520. RJ PREPUT
  521. SA1 B1+NUMARGS-1 CURRENT ARGUMENT COUNT
  522. SX2 X1-MAXARG SEE IF TOO MANY ARGS
  523. PL X2,ERR1
  524. SX6 X1+1 INCREASE COUNT
  525. SA6 A1
  526. SA2 B1+LOCS ADDRESS OF ARGUMENT
  527. SA1 B1+FUNLST-1 ADDRESS OF ARGUMENT TABLE
  528. IX1 X1+X6 INDEX INTO TABLE BY ARG NUM
  529. BX6 X2
  530. SA6 X1 STORE ADDRESS OF ARGUMENT
  531. SX1 OP(
  532. RJ PREPUT START NEXT ARG WITH L PAREN
  533. EQ PREPASS
  534. *
  535. PRENEST SX1 B1+1-MAXLEV
  536. PL X1,ERR2 TOO DEEP IN FUNCTIONS
  537. SA1 B1+LOCS ADDRESS OF FUNCTION OP CODE
  538. BX6 X1
  539. SA6 B1+FUNLST SAVE ADDR OF FUNCTION
  540. RJ PREFUN INITIALIZE ARGUMENT INFO
  541. SX6 B1+1
  542. SA6 DEPTH ONE LEVEL DEEPER
  543. EQ PREPASS
  544. *
  545. PREXPN1 MX6 0
  546. SA6 LEXADD RESTORE LEX TO NORMAL
  547. SX6 1R(
  548. SA6 LASTKEY RESTORE -LASTKEY-
  549. SA1 DEPTH
  550. SB1 X1 PICK UP NESTING DEPTH
  551. *
  552. PREFUN EQ *
  553. SA1 LASTKEY
  554. SA2 X1+KEYTYPE MUST BE LEFT PAREN
  555. SX2 X2-OP(
  556. NZ X2,ERR3
  557. SX6 -1 KILL -LASTKEY-
  558. SA6 A1
  559. SX1 OPDEFN STORE OP CODE FOR DEFINE
  560. RJ PREPUT
  561. SA1 B1+LOCS+1
  562. RJ PREPUT STORE ADDR OF FIRST ARG
  563. SA1 B1+LOCS
  564. SX6 X1+MAXARG-1 RESERVE SPACE FOR ARG TABLE
  565. * /--- BLOCK PREXPAN 00 000 74/09/02 21.16
  566. SA6 A1
  567. MX6 0 INITIALIZE PAREN COUNT
  568. SA6 B1+PARENS
  569. SX6 1 INITIALIZE ARGUMENT COUNT
  570. SA6 B1+NUMARGS
  571. SX1 OP( START WITH L PAREN
  572. RJ PREPUT
  573. SX6 PREXPN1 RETURN TO -PREXPN1-
  574. SA6 OLDADD
  575. SX6 DEFLEX
  576. SA6 LEXADD LEX WILL CALL -DEFLEX-
  577. SA1 ADTYPE
  578. RJ SETDEF SET POINTERS TO THIS FUNCTION
  579. RJ GETDEF NUMBER OF ARGUMENTS
  580. SA2 DEPTH
  581. BX6 X1
  582. SA6 X2+DEFARGS STORE EXPECTED ARGUMENT COUNT
  583. *
  584. PREXPAN RJ LEX GET NEXT ITEM OF FUNCTION
  585. SA1 DEPTH FUNCTION NESTING LEVEL
  586. SB1 X1
  587. SA1 OP SEE IF OP OR ADD
  588. SX2 X1-OPARG
  589. ZR X2,PREXARG JUMP IF ARGUMENT OF FUNCTION
  590. NZ X1,PREXPN
  591. SA1 ADTYPE
  592. MX2 1 SET SIGN BIT FOR ADDRESS
  593. BX1 X1+X2
  594. *
  595. PREXPN RJ PREPUT
  596. EQ PREXPAN
  597. *
  598. PREXARG RJ PREPUT STORE OP CODE FOR ARGUMENT
  599. RJ GETDEF GET ARGUMENT NUMBER
  600. SA2 DEPTH
  601. SB1 X2 RESET B1
  602. RJ PREPUT
  603. EQ PREXPAN
  604. *
  605. PRELP SA1 B1+PARENS-1 GET CURRENT PAREN COUNT
  606. SX6 X1+1
  607. SA6 A1 INCREMENT FOR L PAREN
  608. EQ PREPASS
  609. *
  610. PRERP SA1 B1+PARENS-1 GET PAREN COUNT
  611. SX6 X1-1 DECREMENT FOR R PAREN
  612. NG X6,ERR3 UNBALANCED PARENS
  613. SA6 A1
  614. NZ X6,PREPASS NOT YET BALANCED
  615. SX1 EOL
  616. RJ PREPUT INSERT AN END OF LINE CODE
  617. SA2 B1+NUMARGS-1 ARGUMENT COUNT
  618. SA3 B1+DEFARGS-1 DEFINE READIN ARGUMENT COUNT
  619. BX3 X3-X2
  620. NZ X3,ERR4 UNREFERENCED OR UNDEFINED ARG
  621. SX6 B1-1
  622. SA6 DEPTH BACK OUT ONE LEVEL
  623. ZR X6,ENDPASS ALL DONE IF NO LONGER NESTED
  624. EQ PREPASS
  625. *
  626. ENDPASS SA1 LEXSAV RESTORE RJ ADDRESS
  627. BX6 X1
  628. SA6 LEX
  629. * GENREAD IN COMPILE DECREMENTS NLITS IF A LITERAL IS
  630. * AT THE TOP OF THE LITS STACK. SO WE MUST INCREMENT NLITS
  631. * TO PREVENT CLOBBERING AN ARGUMENT LIT USED MORE THAN ONCE
  632. SA1 NLITS
  633. SX6 X1+1
  634. SA6 A1
  635. SA1 DEFNCM GET ADDRESS OF TOKEN BUFFER
  636. SX6 X1+1 INITIALIZE PROCESSING ADDRESS
  637. SA6 LOCS
  638. MX6 0
  639. SA6 VSKMODE RESET -VSEEK- MODE
  640. SX6 1
  641. SA6 UDMODE RESET *UNITS* MODE
  642. *
  643. *
  644. * /--- BLOCK FUNLEX 00 000 78/12/18 21.18
  645. * -FUNLEX-
  646. * RETURNS RESULTS OF LEXICAL ANALYSIS OF FUNCTION AND AGUMENTS
  647. *
  648. FUNLEX SA1 DEPTH CURRENT NESTING DEPTH
  649. SA2 X1+LOCS ADDRESS OF FUNCTION
  650. SX6 X2-1
  651. SA6 X1+FUNLST ADD TO FUNCTION LIST
  652. SX6 X2+MAXARG
  653. SA6 A2 STARTING ADD OF TOKENS
  654. SX6 FUNLX
  655. SA6 LEXADD LEX WILL CALL -FUNLX-
  656. *
  657. *
  658. * -FUNLX-
  659. * CALLED BY LEX TO GET NEXT ITEM OF FUNCTION
  660. *
  661. FUNLX RJ GETFUN GET NEXT ITEM OF FUNCTION
  662. NG X1,FUNADD JUMP IF ADDRESS
  663. SX2 X1-OPARG
  664. ZR X2,FUNARG JUMP IF ARGUMENT
  665. SX2 X1-OPDEFN
  666. ZR X2,FUNLEX JUMP IF NESTED FUNCTION
  667. SX2 X1-EOL
  668. ZR X2,EXITF DONE IF END OF LINE
  669. BX6 X1
  670. EQ OPRET RETURN OP CODE
  671. *
  672. FUNADD MX0 60-XCODEL+1
  673. MX6 59 SAVE ONLY GETVAR AND *LITS* BIT
  674. LX6 LITSHFT
  675. BX0 X0*X6
  676. BX6 -X0*X1 CLEAR UPPER BITS
  677. SA6 ADTYPE
  678. MX0 -4 MASK FOR I/F BIT AND TYPE
  679. AX6 XCODEAL
  680. BX0 -X0*X6 MASK OFF TYPE CODE
  681. SX0 X0-10B
  682. NZ X0,FUNADD1 JUMP IF NOT *UNIT*
  683. CALL UNITD PROCESS *UNIT*
  684. EQ ADRET1
  685. *
  686. FUNADD1 ZERO UADTYPE,NUMAX ZERO *UADTYPE*
  687. EQ ADRET1
  688. *
  689. * /--- BLOCK FUNARG 00 000 76/12/09 16.56
  690. *
  691. FUNARG RJ GETFUN GET ARGUMENT NUMBER
  692. NG X1,FUNARG1 JUMP IF IN -DEFINE- COMMAND
  693. SA2 DEPTH CURRENT NESTING LEVEL
  694. SA3 X2+FUNLST ADDRESS OF FUNCTION INFO
  695. SB1 X3+1
  696. SA3 X1+B1 ADDRESS OF ARGUMENT
  697. BX6 X3
  698. SA6 X2+LOCS+1 SET PROCESSING ADDRESS
  699. SX6 X2+1
  700. SA6 A2 ONE LEVEL DEEPER
  701. EQ FUNLX
  702. *
  703. FUNARG1 RJ GETFUN
  704. BX6 X1 GET UNRECOGNIZED NAME
  705. SA6 AD
  706. SX6 -1 NEGATIVE = NOT FOUND
  707. EQ ADRET
  708. *
  709. EXITF SA1 DEPTH SEE HOW DEEP IN ARGS
  710. NZ X1,EXIT1
  711. MX6 0 RESTORE LEX TO NORMAL
  712. SA6 LEXADD
  713. EQ LEX+1 CONTINUE PROCESSING
  714. *
  715. EXIT1 SX6 X1-1 BACK UP ONE LEVEL
  716. SA6 A1
  717. EQ FUNLX CONTINUE PROCESSING
  718. *
  719. * /--- BLOCK ERR 00 000 77/08/07 19.37
  720. PLATO
  721. *
  722. ERR1 COMPERR 671,64 (MORE THAN 6 ARGS)
  723. *
  724. ERR2 COMPERR 672,17 TOO DEEP IN FUNCTION ARGUMENTS
  725. *
  726. ERR3 EQ BADPAR
  727. *
  728. ERR4 COMPERR 673,18 WRONG NUMBER OF FUNCTION ARGS
  729. *
  730. ERR5 COMPERR 674,64 TOO MANY FUNCTION TOKENS
  731. *
  732. ERR6 COMPERR 675,64 DEFINE (SYSTEM) FAILURE
  733. *
  734. ERR7 EQ ERR4 NO INDEX IN SEGMENT REF.
  735. ENDIF
  736. *
  737. CONDEN
  738. ERR1 SB1 35 MANY ARGS
  739. EQ =XERR
  740. *
  741. ERR2 SB1 36 TOO DEEP
  742. EQ =XERR
  743. *
  744. ERR3 EQ BADPAR
  745. *
  746. ERR4 SB1 37 IMPROPER NUMBER OF FUNCT. ARGS.
  747. EQ =XERR
  748. *
  749. ERR5 SB1 38 BUFF FULL
  750. EQ =XERR
  751. *
  752. ERR6 SB1 39 DEFN FAIL
  753. EQ =XERR
  754. *
  755. ERR7 SB1 40 NO INDEX
  756. EQ =XERR
  757. ENDIF
  758. * /--- BLOCK PREPUT 00 000 75/05/28 21.17
  759. TITLE DEFINE INFO STORAGE / RETRIEVAL
  760. *
  761. *
  762. PREPUT EQ *
  763. SA2 B1+LOCS POINTER TO NEXT FREE WORD
  764. SA3 B1+LIMS END TEST
  765. SX6 X2+1 ADVANCE POINTER
  766. IX3 X6-X3
  767. PL X3,ERR5 TOO MANY TOKENS
  768. SA6 A2 STORE UPDATED POINTER
  769. BX6 X1
  770. SA6 X2 STORE THE TOKEN
  771. EQ PREPUT
  772. *
  773. GETFUN EQ *
  774. SA1 DEPTH CURRENT NESTING LEVEL
  775. SA1 X1+LOCS BUFFER POSITION
  776. SX6 X1+1 ADVANCE POINTER
  777. SA6 A1
  778. SA1 X1 GET NEXT WORD
  779. EQ GETFUN
  780. *
  781. * /--- BLOCK SETDEF 00 000 75/02/10 21.31
  782. *
  783. *
  784. ENTRY SETDEF
  785. SETDEF EQ *
  786. MX6 60-XCODEAL+1
  787. BX6 -X6*X1 MASK OFF ADDRESS PORTION
  788. SA1 ATOKEN POINTER TO ECS TOKEN BUFFER
  789. IX6 X1+X6 FORM ABSOLUTE ADDRESS
  790. SA6 TWORD SET WORD POINTER
  791. SX6 60
  792. SA6 TSHIFT SET SHIFT COUNT
  793. EQ SETDEF
  794. *
  795. *
  796. *
  797. ENTRY GETDEF
  798. GETDEF EQ *
  799. SA1 TSHIFT GET SHIFT COUNT
  800. SA2 TWORD POINTER TO CURRENT WORD
  801. BX0 X2
  802. SB1 X1-12
  803. PL B1,GETDEF1 JUMP IF DONT NEED NEW WORD
  804. SX6 1
  805. IX0 X0+X6 ADVANCE TO NEXT WORD
  806. SB1 48 INITIALIZE SHIFT COUNT
  807. *
  808. GETDEF1 SA0 TWW
  809. + RE 1 READ CURRENT TOKEN WORD
  810. RJ ECSPRTY
  811. SA3 A0 LOAD TOKEN WORD
  812. AX1 X3,B1 POSITION BYTE
  813. LX1 48
  814. AX1 48 EXTEND BIT 12
  815. PL X1,GETDEF3 JUMP IF ONLY ONE BYTE
  816. *
  817. SB1 B1-12 COMPUTE SHIFT COUNT
  818. PL B1,GETDEF2 JUMP IF DONT NEED NEW WORD
  819. *
  820. SX6 1
  821. IX0 X0+X6 ADVANCE TO NEXT WORD
  822. + RE 1 READ NEXT TOKEN WORD
  823. RJ ECSPRTY
  824. SA3 A0 LOAD NEW WORD
  825. SB1 48 REINTIALIZE SHIFT COUNT
  826. *
  827. GETDEF2 AX2 X3,B1 POSITION SECOND BYTE
  828. LX1 12 POSITION FIRST BYTE
  829. MX3 -12 ISOLATE BYTES FOR BOOL. +
  830. BX1 X3*X1 HIGH ORDER WITH EXTENDED SIGN
  831. BX2 -X3*X2 LOW ORDER
  832. BX1 X1+X2 FORM COMPLETE ADTYPE
  833. BX3 X1 SAVE ADTYPE
  834. LX3 60-LITSHF1 22ND BIT IN SIGN POSITION
  835. PL X3,GETDEF3 IF NOT IMMEDIATE LITERAL, EXIT
  836. *
  837. SX6 1
  838. LX3 1 MOVE BIT TO 2**0TH POSITION
  839. BX1 X3-X6 TURN *LITS* FLAG OFF
  840. LX1 LITSHFT RESTORE SHIFT POSITION
  841. IX0 X0+X6 POINT TO NEXT WORD
  842. SB1 B0 INDICATE NO BITS AVAILABLE HERE
  843. *
  844. GETDEF3 SX6 B1 STORE CURRENT SHIFT COUNT
  845. SA6 TSHIFT
  846. BX6 X0 STORE CURRENT WORD ADDRESS
  847. SA6 A2
  848. EQ GETDEF
  849. * /--- BLOCK FINDSET 00 000 75/02/11 03.55
  850. *
  851. *
  852. *
  853. * -FINDSET-
  854. * SEARCHES THE DEFN GROUP LIST FOR THE NAME IN X6
  855. * B1 IS RETURNED WITH THE INDEX OF THE NAME IN THE
  856. * GROUP TABLES OR -1 IF THE NAME WAS NOT FOUND
  857. *
  858. ENTRY FINDSET
  859. FINDSET EQ *
  860. SB1 MAXSET-1 LENGTH TO SEARCH
  861. *
  862. FINDS1 SA1 B1+SETNAMS GET NEXT GROUP NAME
  863. BX1 X1-X6 SEE IF MATCHES
  864. ZR X1,FINDSET FOUND A MATCH
  865. SB1 B1-1
  866. PL B1,FINDS1 KEEP LOOKING / EXIT
  867. EQ FINDSET
  868. *
  869. CONDEN
  870. *
  871. * -GETSET-
  872. * READS FROM ECS THE DEFINE SET INDICATED BY
  873. * THE INDEX CONTAINED IN B1
  874. *
  875. * /--- BLOCK GETSET 00 000 79/03/06 23.04
  876. *
  877. * -GETSET -
  878. * MOVE OPEN SPACE BETWEEN TOKENS AND NAMES
  879. * OF DSET (B1) AND MAKE DSET READY FOR PROCESSING
  880. *
  881. * ON ENTRY - (*DSET*) = CURRENTLY OPEN SET
  882. * (B1) = SET TO OPEN
  883. * ON EXIT - (*DSET*) = NEW OPEN SET
  884. * *NAMADDS*/*TOKADDS* UPDATED
  885. * *SETSET* EXECUTED
  886. *
  887. ENTRY GETSET
  888. GETSET EQ *
  889. SA1 DSET CURRENT DSET
  890. SB2 X1 (B2) = OLD DSET
  891. NG B2,OPNS10 IF NULL SET WAS OPEN
  892. *
  893. RJ RTOKNAM RETURN ODSET TOK/NAM PARMS
  894. OPNS10 BSS 0
  895. SX6 B1 (B1) BECOMES
  896. SA6 DSET CURRENT DSET
  897. EQ B1,B2,OPN30 IF SAME SET, ALREADY OPEN
  898. *
  899. GT B1,B2,OPN10 IF MV OPEN SPACE TO HIGHER ADDR
  900. *
  901. * MOVE OPEN SPACE TO LOWER ADDR
  902. SA1 NAMADDS+B1 START OF MOVE***
  903. SA2 TOKADDS+B2 OLD TOKEN ADDR
  904. SA3 TOKLENS+B2 OLD TOKEN LEN
  905. IX3 X3+X2 END ADDR OF MOVE +1
  906. IX3 X3-X1 LEN OF MOVE***
  907. SA2 NAMADDS+B2 END OF DESTINATION OF MOVE + 1
  908. IX2 X2-X3 DESTINATION OF MOVE***
  909. SB3 B1 DSET INDEX
  910. SB4 B2 END DSET
  911. RJ UPDNT UPDATE *NAMADDS*/*TOKADDS*
  912. EQ OPN20
  913. *
  914. OPN10 BSS 0 MOVE OPEN SPACE TO HIGHER ADDR
  915. SA1 NAMADDS+B2 START LOC OF MOVE***
  916. SA2 TOKADDS+B2 TOKEN ADDR OF OLD SET
  917. SA3 TOKLENS+B2 TOKEN LENGTH OF OLD SET
  918. IX2 X2+X3 DESTINATION OF MOVE***
  919. SA3 TOKADDS+B1 ADDR OF NEW DSET TOKENS
  920. SA4 TOKLENS+B1 LENGTH OF NEW DSET TOKENS
  921. IX3 X3+X4 END LOC OF MOVE +1
  922. IX3 X3-X1 LENGTH OF MOVE***
  923. SB3 B2 (B3) = DSET INDEX
  924. SB4 B1 (B4) = END DSET
  925. RJ UPDNT UPDATE *NAMADDS*/*TOKADDS*
  926. *
  927. OPN20 BSS 0 OPEN NEW/CLOSE OLD
  928. SA0 VARS MOVE BUFFER LOC
  929. SB1 VARLONG MOVE BUFFER LEN
  930. RJ =XMVECS DO THE MOVE
  931. OPN30 RJ SETSET SET UP THE DSET IN CM
  932. EQ GETSET
  933. *
  934. * /--- BLOCK RTOKNAM 00 000 79/03/06 22.28
  935. *
  936. * -RTOKNAM-
  937. * RETURN LOCAL TOKEN/NAME PARAMETERS
  938. *
  939. * ON ENTRY - *DSET* = DEFINE SET TO RETURN PARMS TO
  940. * USES A/X1, B2, A/X6
  941. *
  942. ENTRY RTOKNAM
  943. RTOKNAM EQ *
  944. SA1 DSET
  945. SB2 X1 (B2) = *DSET*
  946. SA1 ATOKEN UPDATE *TOKADDS*
  947. BX6 X1
  948. SA6 TOKADDS+B2
  949. SA1 AVAR UPDATE *NAMADDS*
  950. BX6 X1
  951. SA6 NAMADDS+B2
  952. SA1 TOKWRD UPDATE *TOKLENS*
  953. BX6 X1
  954. SA6 TOKLENS+B2
  955. SA1 NDEFN UPDATE *NAMLENS*
  956. BX6 X1
  957. SA6 NAMLENS+B2
  958. SA1 NDEFU UPDATE *UNTLENS*
  959. BX6 X1
  960. SA6 UNTLENS+B2
  961. EQ RTOKNAM
  962. *
  963. * -UPDTN-
  964. * UPDATE *TOKADDS* AND *NAMADDS*
  965. * FOR ALL BUFFERS MOVED
  966. *
  967. * ON ENTRY - (B3) = SET TO BEGIN AT
  968. * (B4) = SET TO QUIT AT
  969. * (X1) = START OF MOVE, (X2) = DESTINATION OF MOVE
  970. *
  971. * MUST PRESERVE X1-3
  972. *
  973. ENTRY UPDNT
  974. UPDNT EQ *
  975. IX4 X2-X1 (X4) = DISPLACEMENT OF MOVE
  976. UNT10 BSS 0 UPDATE *TOKADDS*/*NAMADDS*
  977. SA5 NAMADDS+B3 UPDATE *NAMADDS*
  978. IX6 X5+X4
  979. SA6 A5
  980. SB3 B3+1 POINT TO NEXT DSET TO UPDATE
  981. SA5 TOKADDS+B3 UPDATE *TOKADDS*
  982. IX6 X5+X4
  983. SA6 A5
  984. NE B3,B4,UNT10 IF NOT ALL NAM/TOK ADDRS DONE
  985. *
  986. EQ UPDNT
  987. * /--- BLOCK SETSET 00 000 79/02/28 11.05
  988. *
  989. * -SETSET-
  990. * SET UP LOCAL PARAMETERS FOR DEFINE SET PROCESSING
  991. *
  992. * ON ENTRY - *DSET* ASSUMED TO BE OPEN
  993. * ON EXIT - *ATOKEN*, *TOKWRD*, *AVAR*
  994. * *NDEFN*, *NDEFU*
  995. * SET
  996. * *GPGTBL* AND *READNM* EXECUTED
  997. *
  998. ENTRY SETSET
  999. SETSET EQ *
  1000. SA1 DSET
  1001. SB1 X1
  1002. SA1 NAMLENS+B1
  1003. BX6 X1
  1004. SA6 NDEFN INITIALIZE NUMBER OF DEFNS
  1005. SA1 TOKLENS+B1
  1006. BX6 X1
  1007. SA6 TOKWRD INITIALIZE NUMBER OF TOKENS
  1008. SA1 UNTLENS+B1
  1009. BX6 X1
  1010. SA6 NDEFU INITIALIZE NUMBER OF DEFD UNITS
  1011. SA1 TOKADDS+B1
  1012. BX6 X1
  1013. SA6 ATOKEN INITIALIZE ADDRESS OF TOKBUF
  1014. SA1 NAMADDS+B1
  1015. BX6 X1
  1016. SA6 AVAR INITIALIZE ADDRESS OF DEFNS
  1017. RJ GPGTBL UPDATE *PGTBL*
  1018. RJ READNM READ IN PAGE1
  1019. EQ SETSET
  1020. *
  1021. * /--- BLOCK GPGTBL 00 000 79/02/20 11.30
  1022. *
  1023. * -GPGTBL-
  1024. * PUT CONTENTS OF LAST NAME IN EACH PAGE INTO
  1025. * *PGTBL*
  1026. *
  1027. * ON ENTRY - *SETSET* DATA ASSUMED INTACT
  1028. *
  1029. ENTRY GPGTBL
  1030. GPGTBL EQ *
  1031. SA0 PGTBL
  1032. SB2 VARLONG
  1033. SA1 NDEFN NUMBER OF DEFINED NAMES
  1034. SA2 AVAR ECS ADDR OF NAME TABLE
  1035. IX1 X1+X2 ADDRESS OF LAST NAME + 1
  1036. BX0 X2 INDEX INTO NAME TABLE
  1037. SX3 B2-1 OFFSET TO LAST NAME IN PAGE1
  1038. IX0 X0+X3 ADDR OF LAST NAME OF PAGE1
  1039. SX3 B2 (X3) = VARLONG (PAGE INCREMENT)
  1040. GPT10 IX4 X0-X1
  1041. PL X4,GPGTBL IF NO MORE FULL PAGES
  1042. + RE 1 READ UP LAST NAME IN PAGE
  1043. RJ ECSPRTY
  1044. SA0 A0+1 NEXT PAGE
  1045. IX0 X0+X3
  1046. EQ GPT10
  1047. *
  1048. * /--- BLOCK READNM 00 000 79/02/20 11.36
  1049. *
  1050. * -READNM-
  1051. * READS THE FIRST PAGE OF THE CURRENT DEFINE
  1052. * SET NAME TABLE INTO ECS
  1053. *
  1054. * ON ENTRY - DSET MUST BE OPEN AND SET
  1055. * (*PVARS*) = ADDR OF CM NAME TABLE
  1056. * ON EXIT - CM CONTAINS DEFN PAGE 1
  1057. * *VLOBEC*, *VUPBEC* AND *VUPBCM* SET
  1058. *
  1059. * USES - X0, A/B/X1, B2, A/X6
  1060. *
  1061. ENTRY READNM
  1062. READNM EQ *
  1063. MX6 0
  1064. SA6 VARS0 ZERO OUT IN CASE OF NO NAMES
  1065. SA1 AVAR ADDRESS OF DEFN PAGE 1
  1066. BX0 X1
  1067. SA0 VARS CM ADDRESS TO PUT NAME PAGE
  1068. SA1 NDEFN NUMBER OF DEFINED NAMES
  1069. SB1 X1
  1070. SB2 VARLONG
  1071. LE B1,B2,RNM10 IF ALL FITS IN ONE PAGE
  1072. *
  1073. SB1 B2
  1074. RNM10 RE B1 READ IN NAMES
  1075. RJ ECSPRTY
  1076. SX6 A0+B1 ADDR OF LAST NAME IN PAGE + 1
  1077. SX6 X6-1 ADDR OF LAST NAME IN PAGE
  1078. SA6 VUPBCM
  1079. BX6 X0 ADDRESS OF LOW CM NAME IN ECS
  1080. SA6 VLOBEC
  1081. SX0 B1-1 ADDRESS OF HI CM NAME IN ECS
  1082. IX6 X6+X0
  1083. SA6 VUPBEC
  1084. EQ READNM
  1085. *
  1086. ENDIF
  1087. * /--- BLOCK INITDEF 00 000 79/02/20 12.23
  1088. *
  1089. * -INITDEF-
  1090. * INITIALIZES DEFINE VARIABLES AND BRINGS IN THE
  1091. * PROPER DEFINE SET FROM ECS
  1092. *
  1093. ENTRY INITDEF
  1094. INITDEF EQ *
  1095. MX6 -1
  1096. SA6 UDMODE INTERPRET *UNITS*
  1097. MX6 0
  1098. SA6 VSKMODE SET VSEEK MODE
  1099. SA6 PFRST
  1100. *
  1101. PLATO
  1102. RJ GETNDFU GET NDEFU INTIALIZED
  1103. EQ INITDEF
  1104. ENDIF
  1105. *
  1106. CONDEN
  1107. SX6 VARS
  1108. SA6 PVARS POINTER TO DEFN NAME LIST
  1109. RJ =XSETSET BRING IN CURRENT DEFN SET
  1110. EQ INITDEF
  1111. *
  1112. ENDIF
  1113. *
  1114. *
  1115. PLATO
  1116. *
  1117. * -GETNDFU-
  1118. * GETS NUMBER OF UNITS DEFINED
  1119. * SETS NDEFN,NDEFU
  1120. *
  1121. ENTRY GETNDFU
  1122. GETNDFU EQ *
  1123. SA1 LESSCM+LDEFNWD
  1124. SX6 X1
  1125. SA6 NDEFN NUMBER OF DEFINITIONS
  1126. AX1 18+18 POSITION NUMBER OF UNITS
  1127. SX6 X1
  1128. SA6 NDEFU SET NUMBER OF UNITS
  1129. EQ GETNDFU
  1130. ENDIF
  1131. *
  1132. *
  1133. *
  1134. LEADDSV BSS 1
  1135. OLDADD BSS 1
  1136. LEXSAV BSS 1
  1137. *
  1138. SEGADD BSS 1
  1139. SEGLIT BSS 1
  1140. *
  1141. TWORD BSS 1 WORD COUNT
  1142. TSHIFT BSS 1 SHIFT COUNT
  1143. TWW BSS 1 CURRENT WORD
  1144. *
  1145. IWK BSS 1
  1146. *
  1147. *
  1148. * /--- BLOCK VSEEK 00 000 81/07/27 21.51
  1149. *
  1150. TITLE -VSEEK- IDENTIFY DEFINED NAME
  1151. *
  1152. * -VSEEK-
  1153. * SEARCHES THE DEFINED NAME TABLE FOR THE
  1154. * NAME HELD IN X6 (AND IN -AD- IF IN EXEC MODE)
  1155. *
  1156. * *ADTYPE* IS RETURNED WITH THE *GETVAR* CODE
  1157. * OR -1 IF THE NAME IS NOT FOUND
  1158. *
  1159. * *VSKMODE* CONTROLS ACTION WHEN A NAME IS FOUUND
  1160. * - = OP RETURNED WITH THE OPCODE FOR DEFINE
  1161. * 0 = OP UNCHANGED (0 IF CALLED FROM -LEX-)
  1162. * + = OP SET TO *OPDEFN* FOR FUNCTION DEFINE ONLY
  1163. *
  1164. * IF NO EXACT MATCH IS FOUND IN EXEC MODE IMPLIED
  1165. * MULTIPLICATION IS ASSUMED IF A PARTIAL MATCH
  1166. * CAN BE FOUND (SEE DESCRIPTION IN -LEX-)
  1167. *
  1168. *
  1169. .IFVSK PLATO
  1170. *CALL LEXTXT
  1171. .IFVSK ENDIF
  1172. *
  1173. CONDEN
  1174. EXT TVARCNT (LOCAL TO LEX FOR CONDEN)
  1175. ENDIF
  1176. *
  1177. *
  1178. EXT ECSPRTY
  1179. EXT LEX
  1180. *
  1181. * /--- BLOCK VSEEK 00 000 81/07/27 21.51
  1182. ENTRY VSEEK
  1183. VSEEK EQ *
  1184. PLATO
  1185. EQ VSEEK1
  1186. ENDIF
  1187. *
  1188. CONDEN
  1189. MX0 42 SEVEN CHAR MASK
  1190. BX6 X0*X6 MASK TO 7 CHARS
  1191. *
  1192. *
  1193. * SET UP FOR BINARY CHOP
  1194. *
  1195. LX6 60-18 RIGHT JUSTIFY NAME
  1196. SB1 1 (B1) = 1
  1197. SB7 -B1 (B7) = -1
  1198. SA2 VUPBCM ADDR OF HI CM VARNAME
  1199. SA3 X2 HI VAR NAME/GETVAR
  1200. BX3 X0*X3 ISOLATE NAME
  1201. LX3 60-18 RIGHT JUSTIFY NAME
  1202. IX3 X3-X6
  1203. NG X3,PAGENM1 IF KEY.GT.HICMNAME, PAGE ECS
  1204. *
  1205. SB2 A3 (B2) = HI
  1206. SA3 VARS LO VARNAME/GETVAR
  1207. BX3 X0*X3 ISOLATE NAME
  1208. LX3 60-18 RIGHT JUSTIFY NAME
  1209. IX3 X6-X3
  1210. NG X3,PAGENM IF KEY.LT.LOCMNAME, PAGE ECS
  1211. *
  1212. SB3 A3 (B3) = LO
  1213. *
  1214. * BINARY CHOP TO FIND VAR NAME IN X6
  1215. * IN ALPHABETICALLY ORDERED TABLE IN CM
  1216. * ON EXIT'; IF FOUND'; *ADTYPE* = GETVAR
  1217. * IF NOT FOUND'; *ADTYPE* = -1 AND
  1218. * (X7) = ECS LOC TO INSERT NEW NAME AT
  1219. *
  1220. VBCHOP SX7 B2+B3 I = HI+LO
  1221. AX7 B1 I = INT(I/2)
  1222. SA1 X7 (X1) = NAME/GETVAR
  1223. BX2 X0*X1 ISOLATE NAME
  1224. LX2 60-18 RIGHT JUSTIFY NAME
  1225. IX4 X6-X2 NEGATIVE IF KEY.LT.NAME
  1226. ZR X4,VFOUND IF KEY = NAME, FOUND
  1227. *
  1228. LE B2,B3,NOFIND IF HI = LO, SEARCH END, NOFIND
  1229. *
  1230. PL X4,TOOLO IF LO TOO LOW
  1231. *
  1232. TOOHI SB2 X7+B7 HI = I-1
  1233. EQ VBCHOP
  1234. *
  1235. TOOLO SB3 X7+B1 LO = I+1
  1236. EQ VBCHOP
  1237. *
  1238. * /--- BLOCK VSEEK 00 000 79/02/18 13.23
  1239. *
  1240. NOFIND SX6 -1 SET ADTYPE = -1
  1241. SA6 ADTYPE
  1242. SX1 VARS
  1243. IX7 X7-X1 MAKE INSERT LOC RELATIVE
  1244. AX4 60 FORM A -1 IF KEY.LT.NAME
  1245. MX6 59
  1246. BX4 X6*X4
  1247. IX7 X7+X4 IF KEY.LT.NAME, I = I-1
  1248. SA1 VLOBEC
  1249. IX7 X7+X1 X7 = ABS ECS LOC TO INSERT NAME
  1250. EQ VSEEK
  1251. *
  1252. ENDIF
  1253. *
  1254. VFOUND BX6 -X0*X1 ISOLATE GETVAR CODE
  1255. SA6 ADTYPE
  1256. VFOUNDB SA2 TVARCNT
  1257. SX7 X2+1 COUNT VARIABLE REFERENCES
  1258. SA7 A2
  1259. SA1 VSKMODE SEE IF MUST EXPAND DEFINE
  1260. ZR X1,DEFNLEX GO PROCESS DEFN
  1261. PL X1,VFOUND1
  1262. SX6 OPDEFN
  1263. SA6 OP RETURN OP CODE FOR DEFINE
  1264. EQ VSEEK
  1265. * /--- BLOCK VFOUND1 00 000 76/12/02 10.44
  1266. *
  1267. VFOUND1 BX1 X6 TRANSFER DEFINE ADDRESS
  1268. AX6 XCODEAL SHIFT OFF ADDRESS
  1269. MX0 57 3 BIT MASK
  1270. BX6 -X0*X6
  1271. SX6 X6-4 SEE IF TYPE 4 (CALC)
  1272. NZ X6,DEFNLEX CANT BE FUNCTION IF NOT CALC
  1273. RJ SETDEF SET POINTERS TO DEFINE
  1274. RJ GETDEF NUMBER OF ARGUMENTS
  1275. ZR X1,DEFNLEX NOT A FUNCTION
  1276. SX6 OPDEFN
  1277. SA6 OP RETURN OP CODE FOR DEFINE
  1278. EQ VSEEK
  1279. *
  1280. CONDEN
  1281. *
  1282. * (X6) IS NOT IN RANGE OF VARNAMES IN CM
  1283. * SO FIND CORRECT PAGE AND MOVE IT TO CM
  1284. * IF CORRECT PAGE DOES NOT EXIST, RETURN NOT FOUND
  1285. *
  1286. PAGENM1 BX3 -X3 KEY-NAME
  1287. PAGENM BSS 0
  1288. SB2 VARLONG (B2) = LENGTH OF CM NAME BUFFER
  1289. SA2 NDEFN
  1290. SB4 X2 (B4) = LENGTH OF ECS NAME TABLE
  1291. LE B4,B2,PNOFIND
  1292. *
  1293. SB4 B4+B7 (B4) = NDEFN-1
  1294. *
  1295. SB2 B0 (B2) = INDEX INTO PAGE TABLE
  1296. SB3 VARLONG-1 (B3) = PAGE POINTER
  1297. *
  1298. * SEARCH DEFINE NAME PAGE TABLE TO FIND WHICH
  1299. * PAGE, IF ANY, SHOULD BE SEARCHED VIA *VBCHOP*
  1300. * AND PULL IT INTO CM
  1301. *
  1302. PAGELP BSS 0
  1303. SA1 PGTBL+B2 HI NAME/GETVER IN PAGE(B2)
  1304. BX1 X0*X1 ZERO OUT GETVAR
  1305. LX1 60-18 RIGHT JUSTIFY NAME
  1306. IX2 X1-X6
  1307. PL X2,PGFND0 IF HI NAME IS.GE.KEY, THIS PAGE
  1308. *
  1309. SB3 B3+VARLONG POINT TO NEXT PAGE
  1310. GT B3,B4,LASTPG IF PAGE POINTER.GT.NDEFN-1
  1311. *
  1312. SB2 B2+B1 POINT TO NEXT ENTRY IN PAGE TBL
  1313. EQ PAGELP
  1314. *
  1315. PGFND0 SB4 VARLONG-1
  1316. PGFND SX0 B3-B4 (X0) = REL. ECS ADDR OF PAGE
  1317. SA1 AVAR (X1) = ECS ADDR OF NAME TABLE
  1318. IX0 X0+X1 (X0) = ECS ADDR OF PAGE
  1319. SA0 VARS (A0) = CM ADDR OF PAGE
  1320. RE B4+1 READ IN NEW PAGE
  1321. RJ ECSPRTY
  1322. BX7 X0
  1323. SA7 VLOBEC STORE ECS ADDR OF LOWER BOUNDS
  1324. SX7 A0+B4
  1325. SA7 VUPBCM STORE CM ADDR OF HI BOUNDS
  1326. SB2 X7
  1327. SB3 VARS
  1328. MX0 42 RESTORE MASK FOR *VBCHOP*
  1329. EQ VBCHOP
  1330. *
  1331. PNOFIND SB4 B4+B7 (B4) = NDEFN-1
  1332. SB3 B4
  1333. EQ PGFND
  1334. *
  1335. LASTPG SB3 B4 (B3) POINTS TO HIGHEST ECS NAME
  1336. EQ PGFND0
  1337. *
  1338. ENDIF
  1339. * /--- BLOCK VFOUND 00 000 79/02/12 11.08
  1340. *
  1341. *
  1342. * COMES HERE IF IN -EXEC- MODE
  1343. *
  1344. PLATO
  1345. EXT VARTERR VAR FOUND WITH SPECS NOVARS
  1346. EXT SEEKFCT IN FILE LEX
  1347. *
  1348. VSEEK1 SA1 LASTKEY SAVE ORIGINAL LASTKEY
  1349. BX7 X1
  1350. SA7 SAVELK
  1351. SA1 WORDPT SAVE ORIGINAL WORDPT
  1352. BX7 X1
  1353. SA7 SAVEWP
  1354. RJ SEEKFCT MAY BE FUNCTION
  1355. SA1 OP NON-ZERO IF FOUND SOMETHING
  1356. BX7 X1
  1357. SA7 SAVOP
  1358. MX7 0
  1359. SA7 A1 CLEAR OP
  1360. SA1 WORDPT POINTS AT 2 IN SIN2X
  1361. SA2 SAVEWP ORIGINAL WORDPT
  1362. BX7 X1
  1363. SA7 A2
  1364. BX7 X2
  1365. SA7 A1
  1366. SA1 LASTKEY IN COS(X), LASTKEY IS (
  1367. SA2 SAVELK ORIGINAL LASTKEY
  1368. BX7 X1
  1369. SA7 A2
  1370. BX7 X2
  1371. SA7 A1 RESTORE ORIGINAL LASTKEY
  1372. MX7 59 -1
  1373. SA7 ADTYPE PRESET TO NOT FOUND
  1374. SA1 AD RESTORE NAME STRING
  1375. BX6 X1
  1376. RJ VSEEKX LOOK FOR DEFINED NAME
  1377. SA1 SAVOP SEEKFCT OP
  1378. SA2 ADTYPE -1 IF NOT FOUND
  1379. NG X2,NODEF JUMP IF NO DEFINED NAME
  1380. ZR X1,VFOUNDB DEFINED NAME, NO SYSTEM FUNCT
  1381. * BOTH -- FIND WHICH IS LONGER, DEFINED NAME OR SYSTEM FUNCT
  1382. SA2 WORDPT POINTER AFTER VSEEKX
  1383. SA3 SAVEWP POINTER AFTER SEEKFCT
  1384. IX7 X2-X3
  1385. PL X7,VFOUNDB VSEEK NAME LONG OR LONGER THAN SEEKFCT NAME
  1386. *
  1387. NODEF ZR X1,VSEEK NEITHER SYSTEM FUNCT NOR DEFINED NAME
  1388. BX7 X1
  1389. SA7 OP
  1390. SA1 SAVEWP RESTORE WORDPT TO WHERE SEEKFCT LEFT IT
  1391. BX7 X1
  1392. SA7 WORDPT
  1393. SA1 SAVELK
  1394. BX7 X1
  1395. SA7 LASTKEY
  1396. EQ VSEEK
  1397. *
  1398. SAVOP BSS 1 SAVE OP FOUND BY SEEKFCT
  1399. SAVEWP BSS 1 SAVE WORDPT AT END OF SEEKFCT
  1400. SAVELK BSS 1 SAVE LASTKEY AT END OF SEEKFCT
  1401. *
  1402. * /--- BLOCK VSEEKX 00 000 79/12/04 00.23
  1403. VSEEKX EQ * EXEC-TIME NAME LOOKUP
  1404. SA2 COMSPEC LOAD SPECS BITS
  1405. LX2 NOVARS SEE IF -SPECS NOVARS-
  1406. PL X2,VSEEKX2 JUMP IF VARS ALLOWED
  1407. SA2 SAVOP SEE WHETHER SEEKFCT FOUND SOMETHING
  1408. ZR X2,VARTERR NO VARS ERROR (IF SEEKFCT FAILED TOO)
  1409. EQ VSEEKX
  1410. VSEEKX2 SA2 NDEFN NUMBER OF DEFINITIONS
  1411. ZR X2,VSEEKX
  1412. SA2 PFRST SEE IF UNIT ALREADY IN
  1413. NZ X2,VSK100
  1414. SB1 A5
  1415. SX7 B5-B1 SAVE COMMAND BIAS
  1416. SA7 OLDB5
  1417. SX5 1 DEFINE UNIT = UNIT 1
  1418. CALL GETUNIT
  1419. BX2 X0 X2 = ECS ADDRESS OF DEFINE SET
  1420. SX6 B5+1
  1421. SA6 PFRST ADDRESS OF DIRECTORY
  1422. SA6 PVARS ADDRESS OF DEFINED NAMES
  1423. SA1 B5 HEADER WORD
  1424. SB2 X1 *NDEFN*
  1425. SX1 B2+1 RELATIVE ADDR OF TOKEN BUFFER
  1426. IX6 X2+X1
  1427. SA6 ATOKEN ECS ADDRESS OF TOKENS
  1428. SA1 AD RESTORE DEFN NAME
  1429. BX6 X1
  1430. VSK100 BSS 0
  1431. SB1 B0 BEGINNING OF SEARCH
  1432. SA2 B5
  1433. SB2 X2 END OF SEARCH
  1434. SA1 PVARS
  1435. SA0 X1 BASE OF SEARCH
  1436. MX0 42 7 CHAR MASK
  1437. BX4 X0 INITIALIZE
  1438. *
  1439. * /--- BLOCK VLOOP1 00 000 76/12/09 16.35
  1440. VLOOP1 GE B1,B2,VSK300
  1441. SA1 B1+A0 GET NEXT NAME AND CODE
  1442. SB1 B1+1
  1443. BX2 X0*X1 MASK OFF NAME
  1444. BX3 X6-X2 COMPARE NAMES
  1445. ZR X3,VEXACT JUMP IF EXACT MATCH
  1446. BX3 -X6*X2 QUICK CHECK
  1447. NZ X3,VLOOP1 NOT A POSSIBLE MATCH
  1448. MX3 6 ONE CHAR MASK
  1449. SB3 B0 CHARACTER COUNT
  1450. *
  1451. VLOOP2 SB3 B3+1 INCREMENT CHAR COUNT
  1452. BX7 -X3*X2 BUILD A MASK FOR THIS NAME
  1453. ZR X7,VSK200 JUMP IF HAVE COMPLETE MASK
  1454. AX3 6 EXTEND BY ONE CHAR POSITION
  1455. EQ VLOOP2
  1456. *
  1457. VSK200 BX7 X6*X3 TRUNCATE OBJECT NAME
  1458. BX7 X2-X7 SEE IF MATCHES
  1459. NZ X7,VLOOP1
  1460. SX3 B3
  1461. IX7 X4-X3 SEE WHICH MATCH IS BEST
  1462. PL X7,VLOOP1
  1463. BX4 X3 SAVE CHAR COUNT
  1464. BX5 X1 SAVE NAME + CODE
  1465. EQ VLOOP1
  1466. *
  1467. * IF EXACT MATCH, DO NOT HAVE TO CALL -ADVANCE-
  1468. VEXACT BX6 -X0*X1 MASK OFF GETVAR CODE
  1469. SA6 ADTYPE
  1470. EQ VSEEKX
  1471. *
  1472. VSK300 NG X4,VSEEKX NO IMPLIED MULT POSSIBLE
  1473. BX6 -X0*X5 MASK OFF GETVAR CODE
  1474. SA6 ADTYPE
  1475. SB1 X4
  1476. CALL ADVANCE ADVANCE B1 CHARS ACROSS FOUND STRING
  1477. SX7 1R*
  1478. SA7 LASTKEY FAKE UP MULTIPLY
  1479. EQ VSEEKX
  1480. *
  1481. *
  1482. *
  1483. ENDIF
  1484. *
  1485. *
  1486. *
  1487. END
plato.source/plaopl/deflex.txt ยท Last modified: 2021/02/06 16:22 by 127.0.0.1