CDC Community

๐Ÿ”น Historical Conservation ๐Ÿ”น

User Tools

Site Tools


plato.source:plaopl:calcs

Table of Contents

CALCS

Table Of Contents

  • [00005] CALC / BRANCH / DOTO
  • [00030] -CALC- COMMAND READIN
  • [00113] -BRANCH- COMMAND READIN
  • [00285] -IF- COMMAND READIN
  • [00336] -ELSE- AND -ELSEIF- COMMAND READIN
  • [00409] -ENDIF- COMMAND READIN
  • [00445] -LOOP- COMMAND READIN
  • [00484] -RELOOP-/-OUTLOOP- COMMAND READIN
  • [00530] -ENDDO- COMMAND READIN
  • [00582] -DOTO- COMMAND READIN
  • [00801] CHECK IF COMMAND IS STATEMENT LABEL
  • [00863] ENDDOTO โ€“ INSERT COMPILED CODE FOR END OF -DOTO- LOOP
  • [00950] ERROR EXITS
  • [01012] INITCAL โ€“ INITIALIZATIONS FOR FIRST CALC-TYPE COMMAND
  • [01041] ENDCALC โ€“ TERMINATE CALC AND PROCESS TEMPORARY TABLE
  • [01094] GETSYM โ€“ GET NEXT LABEL FOR -BRANCH- OR -DOTO-
  • [01129] ITFFTI
  • [01166] PROCESS DEFERRED GLOBAL SYMBOL REFERENCES
  • [01225] CHKIND โ€“ CHECK IF INDENTING IS CORRECT
  • [01295] POPTOP โ€“ REMOVE TOP STACK ELEMENT
  • [01355] LABJUMP โ€“ COMPILE BRANCH TO SPECIFIED STATEMENT LABEL
  • [01450] LABFIND โ€“ RETURN INTERNAL NAME FOR LABEL HOLERITH
  • [01489] LABDEF โ€“ DEFINE LABEL FOR UNIT
  • [01565] LABRF โ€“ PROCESS LABEL REFERENCE
  • [01714] CLABREF โ€“ SAVE LABEL REFERENCE IN TEMPORARY TABLE
  • [01751] TEMPREF โ€“ PROCESS THE TEMPORARY TABLE
  • [01791] JPB3 โ€“ COMPUTE POSITION OF NEXT INSTRUCTION
  • [01825] SA5JPB5 โ€“ OLD WAY OF HANDLING DEFERRED REFERENCES

Source Code

CALCS.txt
  1. CALCS
  2. * /--- FILE TYPE = E
  3. * /--- BLOCK EXT 00 000 76/11/25 03.28
  4. IDENT CALCS
  5. TITLE CALC / BRANCH / DOTO
  6. *
  7. * GET COMMON SYMBOL TABLE
  8. *
  9. CST
  10. *
  11. *
  12. EXT GETLINE,ECSPRTY,CALC=
  13. EXT COMCONT,CALCNAM
  14. EXT BRANNAM,DOTONAM
  15. EXT CONTCOM,COMPARG,NOTLITS
  16. EXT PAD,LONGI,SHORT
  17. *
  18. * -CALCACT- IS USED AS A FLAG TO TELL
  19. * WHETHER A -CALC- IS ACTIVE. -NXTLINE-
  20. * (IN CONDEN) LOOKS AT -CALCACT- AND
  21. * TERMINATES THE CALC IF THE NEXT
  22. * COMMAND IS NOT A CALC-TYPE COMMAND
  23. * (I.E. -BRANCH-, -DOTO-, -IF-, ETC...).
  24. * 'THE STANDARD CONDENSE ERROR ROUTINES
  25. * ALWAYS CLEAR -CALCACT-. 'THUS, BE
  26. * VERY CAREFUL ABOUT USING THE -RJERR-
  27. * ROUTINES, AS YOU MAY NEED TO RESTORE
  28. * -CALCACT-.
  29. * /--- BLOCK CALC 00 000 76/12/22 12.42
  30. TITLE -CALC- COMMAND READIN
  31. * -CALCS- ENTRY FOR -CALC- COMMAND
  32. *
  33. ENTRY CALCS
  34. CALCS RJ INITCAL DO INITIALIZATIONS
  35. SA1 TAGCNT
  36. ZR X1,OKCONT JUMP IF BLANK LINE
  37. * CHECK IF MIGHT HAVE -BRANCH- OR -DOTO-
  38. SA1 TAG CHECK FOR *BRANCH*
  39. SX0 X1-1RB DOES IT START WITH A B
  40. ZR X0,CKBRDT
  41. SX0 X1-1RD CHECK IF STARTS WITH A D
  42. ZR X0,CKBRDT
  43. * COMPILE CODE AND CHECK FOR ASSIGNMENT CALC
  44. CALCGO RJ CALCINS
  45. SA1 LASTKEY SHOULD BE END OF LINE
  46. ZR X1,OKCONT GO CHECK FOR CONTINUED CALC
  47. EQ CALCE1 ***TEMP NAME ONLY***
  48. * FINISH CHECK FOR -BRANCH- AND -DOTO-
  49. CKBRDT SB1 1
  50. SB2 5 SET TO LOOK AT FIRST 5 CHARS
  51. MX0 0
  52. CKBRDT1 LX0 6
  53. BX0 X0+X1 MERGE IN NEW CHARACTER
  54. SA1 A1+B1 LOAD NEXT CHAR
  55. SB2 B2-B1
  56. NZ B2,CKBRDT1 LOOP UNTIL ALL CHARS IN
  57. SA2 =5RDOTO CHECK FOR -DOTO-
  58. BX2 X2-X0
  59. NZ X2,CKBRDT2
  60. SX6 A1 MOVE WORDPT PAST *DOTO*
  61. SA6 WORDPT
  62. EQ DOTO
  63. CKBRDT2 LX0 6
  64. BX0 X0+X1 MERGE 6TH CHAR
  65. SA2 =6RBRANCH
  66. BX2 X2-X0 CHECK FOR BRANCH
  67. NZ X2,CALCGO JUMP IF REGULAR CALC LINE
  68. SX6 A1+B1 MOVE WORDPT PAST *BRANCH*
  69. SA6 WORDPT
  70. EQ BRANCH
  71. *
  72. * CHECK FOR CONTINUED (BLANK) -CALC-
  73. OKCONT SA2 NEXTCOM PICK UP COMMAND NAME
  74. NOCONT EQU OKCONT FOR NOW, JUST USE OKCONT
  75. SA3 COMCONT CHECK AGAINST CONTINUATION COMMAND (BLANKS)
  76. BX3 X3-X2
  77. ZR X3,CALCONTB JUMP IF CONTINUED CALC
  78. SA1 IBRAN
  79. ZR X1,=XNXTLINE EXIT IF NO BRANCH -Q-
  80. SA4 CALCNAM CHECK AGAINST -CALC- COMMAND
  81. BX4 X4-X2
  82. ZR X4,NXTLINE JUMP IF -CALC- COMMAND
  83. MX0 6 CHECK FOR STATEMENT LABEL
  84. BX7 X0*X2
  85. LX7 6
  86. SX3 X7-1R0 CHECK FIRST CHAR GT OR EQ TO 0
  87. NG X3,CALCONTA JUMP IF NOT
  88. SX3 X7-1R9-1 CHECK ALSO LT EQ TO 9
  89. NG X3,NXTLINE IF SO, GO PROCESS THE LABEL
  90. CALCONTA RJ ENDCALC TERMINATE THE CALC
  91. EQ =XNXTLINE GO PROCESS NEXT COMMAND
  92. CALCONTB RJ GETLINE GET NEXT LINE
  93. EQ CALCS
  94. * /--- BLOCK CALCINS 00 000 76/08/30 15.03
  95. *
  96. * SUBROUTINE TO COMPILE NEXT CALC
  97. CALCINS EQ * COMPILE CODE AND CHECK FOR ASSIGNMENT CALC
  98. MX7 0
  99. SA7 COMPALL RE-INITIALIZE COMPILE VARIABLES
  100. SX7 1
  101. SA7 RSULTX1
  102. SA7 CMOVFLG
  103. RJ CONTCOM COMPILE, RETURN X1 AND B1 INFORMATION
  104. ZR B1,CALCE2 ERROR IF CAN STORE INTO EXPRESSION
  105. BX2 X1
  106. AX2 XCODEAL GET GETVAR TYPE
  107. MX0 57
  108. BX2 -X0*X2 THROW AWAY I/F BIT
  109. SX2 X2-4 SHOULD BE CALC TYPE
  110. NZ X2,CALCE3 ***TEMP NAME ONLY***
  111. EQ CALCINS
  112. * /--- BLOCK BRANCH 00 000 76/08/30 21.34
  113. TITLE -BRANCH- COMMAND READIN
  114. * -BRANI- ENTRY FOR -BRANCH- COMMAND
  115. *
  116. ENTRY BRANI
  117. BRANI RJ INITCAL DO INITIALIZATIONS
  118. SA1 TAGCNT
  119. ZR X1,NOTAG ERROR IF BLANK TAG
  120. * -BRANCH- IN CALC TAG ENTERS HERE
  121. BRANCH SX6 -1
  122. SA6 XBRAN MARK NO -BRANCH X- ENCOUNTERED
  123. SA1 COMACNT CHECK FOR UNCONDITIONAL BRANCH
  124. ZR X1,UBRANCH
  125. *
  126. * TIME TEST IS DONE AFTER COMPUTING BRANCH ADDRESS
  127. *
  128. RJ BRANCMP PROCESS CONDITIONAL PART
  129. *
  130. *GETLINE COUNTS ALL COMMAS, INCLUDING SHIFTED COMMAS
  131. *(QUOTE MARKS), AND COMMAS INSIDE MULTI-ARG FUNCTIONS.
  132. *SO WE MUST CORRECT THE COMMA COUNT.
  133. SA1 LASTKEY
  134. ZR X1,BDBRNCH CONDITIONAL BRANCH MUST HAVE LABELS
  135. SB1 1 (COMACNT WRONG IF FUNCTIONS CONTAIN COMMAS)
  136. SX7 1 COUNT INITIAL COMMA
  137. SX0 1R, X0 CONTAINS TEST CHAR
  138. SA1 WORDPT PREPARE TO COUNT COMMAS
  139. SA1 X1-1
  140. COUNTC SA1 A1+B1 PICK UP CHAR
  141. ZR X1,CNTDONE JUMP IF END OF LINE
  142. IX1 X1-X0 CHECK FOR COMMA
  143. NZ X1,COUNTC JUMP IF NOT COMMA
  144. SX7 X7+B1 COUNT THE COMMA
  145. EQ COUNTC
  146. CNTDONE SA7 COMACNT CORRECT COMMA COUNT
  147. *
  148. SX1 X7-2 UPPER BOUND IS COMMA COUNT MINUS 2
  149. * /--- BLOCK BRANCH2 00 000 78/12/13 01.46
  150. NG X1,UBRANCH UNCONDITIONAL IF ONLY ONE LABEL
  151. SX7 710B TRANSMIT UPPER BOUND IN X0
  152. LX7 21
  153. BX7 X1+X7
  154. RJ LONGI
  155. SX1 1 COMPILE RETURN JUMP TO *CONDITIONAL BRANCH*
  156. LX1 24
  157. SA2 LLBRAN ADDRESS OF -BRANFNC-
  158. BX7 X1+X2
  159. RJ LONGI PUT IN INSTRUCTION STREAM
  160. RJ PAD BE SURE AT WORD BOUNDRY FOR FOLLOWING JUMPS
  161. * NAMELY, NINST MUST HAVE CORRECT COUNT
  162. *
  163. SA2 TAGCNT CHECK FOR LAST BRANCH BEING A FALL THROUGH
  164. SA1 X2+TAG-1 LOAD LAST CHAR OF LINE
  165. SX3 X1-1R, IF COMMMA, IS FALL THROUGH
  166. ZR X3,LASTFALL
  167. SX3 X1-1RX IS LAST CHAR AN X
  168. NZ X3,BRANCHL NO, LAST CANNOT BE A FALL THROUGH
  169. SA1 A1-1 LOAD PRECEEDING CHAR
  170. SX3 X1-1R, IF IT IS COMMA, LAST BRANCH IS FALL THROUGH
  171. NZ X3,BRANCHL
  172. LASTFALL MX7 0 CONVERT LAST COMMA TO END OF LINE
  173. SA7 A1
  174. SA2 COMACNT AND REDUCE COMMA COUNT
  175. SX7 X2-1
  176. SA7 A2
  177. BRANCHL RJ PAD PAD OUT INSTRUCTION WORD
  178. RJ GETSYM GET NEXT STATEMENT NUMBER
  179. LX1 B2,X0 LEFT JUSTIFY SYMBOL INTO X1
  180. SX6 X4 SAVE LAST CHARACTER FOUND
  181. SA6 SAVLAST
  182. ZR X0,BRANCHX ZERO SYMBOL IS FALL THROUGH
  183. SX2 X0-1RX SO IS AN *X*
  184. ZR X2,BRANCHX
  185. * ONE ARGUMENT BRANCH ENTERS HERE
  186. BRANCHB MX0 6
  187. BX2 X0*X1 MUST START WITH A NUMBER
  188. LX2 6
  189. SX3 X2-1R0
  190. NG X3,BADLABL
  191. SX3 X2-1R9-1
  192. PL X3,BADLABL
  193. MX0 42
  194. BX1 X0*X1 MASK SYMBOL TO 7 CHARS
  195. RJ LABFIND B1 = NUMBER FOR THIS LABEL
  196. SA1 NINST LOAD CURRENT INSTRUCTION WORD POINTER
  197. SX6 INST AWKWARDNESS OF LOADER
  198. IX1 X1-X6 RELATIVE ADDRESS
  199. RJ SA5JPB5 GENERATE DEFERRED JUMP TO THIS LABEL
  200. * FILL WORD WITH A -JP B3- IN CASE LABEL NOT FOUND
  201. BRANJP3 SX7 23B COMPILE A CALC EXIT JUMP... MAY BE
  202. LX7 21
  203. RJ LONGI COMPILE
  204. SA4 SAVLAST
  205. NZ X4,BRANCHL JUMP IF MORE TEXT TO GO
  206. RJ PAD
  207. SA1 XBRAN CHECK IF THERE WAS A -BRANCH X-
  208. NG X1,OKCONT EXIT IF NOT
  209. SB1 X1+0
  210. RJ LABDEF DEFINE THE IMAGINARY -X- LABEL
  211. + LT B1,* HANG IF DUPLICATE LABEL
  212. EQ OKCONT
  213. *
  214. * /--- BLOCK BRANCH3 00 000 79/12/02 03.53
  215. BRANCHX SA5 XBRAN
  216. SB1 X5 IMAGINARY LABEL NUMBER FOR -X-
  217. SX1 B0 SET ARGUMENT FOR -LABFIND-
  218. PL X5,BRANCHXX JUMP IF ALREADY HAVE LABEL NUMBER
  219. RJ LABFIND GENERATE IMAGINARY LABEL NUMBER
  220. SX6 B1
  221. SA6 A5 SAVE LABEL NUMBER IN -XBRAN-
  222. BRANCHXX SB2 2 TYPE = 2
  223. SB3 30 UPPER INSTRUCTION
  224. SX2 0255B JP B5+* (UPPER 12 BITS)
  225. SA1 NINST COMPUTE DISPLACEMENT IN -INST-
  226. SX6 INST
  227. IX1 X1-X6
  228. RJ CLABREF PROCESS DEFERRED REFERENCE
  229. EQ BRANJP3 GO INCREMENT -NINST-
  230. *
  231. * PROCESS ONE ARGUMENT BRANCH
  232. UBRANCH SX7 0100B SET UP A *RJ BREAK*
  233. SA1 LLBREAK ADDRESS OF EXECUTION ROUTINE
  234. LX7 18
  235. BX7 X1+X7
  236. CALL LONGI
  237. CALL PAD FORCE NEXT INSTRUCTION UPPER
  238. RJ GETSYM GET STATEMENT NUMBER
  239. LX1 X0,B2 LEFT JUSTIFY SYMBOL INTO X1
  240. MX6 0 MARK END-OF-LINE
  241. SA6 SAVLAST
  242. ZR X0,BDBRNCH ERROR IF ZERO SYMBOL
  243. SX2 X0-1RX
  244. ZR X2,BDBRNCH ERROR IF -X-
  245. EQ BRANCHB
  246. *
  247. * -BRANCMP-
  248. *
  249. * 'THIS SUBROUTINE PROCESSES THE CONDITIONAL
  250. * PART OF THE -BRANCH-, -IF-, AND -ELSEIF- COMMANDS.
  251. *
  252. BRANCMP DATA 0
  253. SX7 1 ELSE, SET UP PARAMETERS FOR SPECIAL CALC
  254. SA7 COMPALL SET TO *COMPILE* EVEN SIMPLE LITERAL LOAD
  255. MX7 0
  256. SA7 RSULTX1 SET TO LEAVE CALC RESULT IN X1
  257. RJ CONTCOM COMPILE CALC PART OF CODITIONAL BRANCH
  258. LX1 62-XCODEL SHIFT I/F BIT TO SIGN POS
  259. PL X1,BRANCMPA ALREADY INTEGER, OK
  260. SX7 10210B BX2 X1
  261. RJ SHORT
  262. SX7 21274B AX2 60
  263. RJ SHORT
  264. SX1 7130B MAKE A *SX3 .5 SHR 45*
  265. SX7 17174B
  266. LX1 18
  267. BX7 X7+X1
  268. RJ LONGI
  269. SX7 20355B LX3 45
  270. RJ SHORT
  271. SX7 13332B BX3 X3-X2
  272. RJ SHORT
  273. SX7 30113B FX1 X1+X3
  274. RJ SHORT
  275. SX7 26111B UX1 X1,B1
  276. RJ SHORT
  277. SX7 22111B LX1 X1,B1
  278. RJ SHORT
  279. BRANCMPA SX7 1
  280. SA7 RSULTX1 RESET COMPILE PARAMETERS
  281. MX7 0
  282. SA7 COMPALL
  283. EQ BRANCMP
  284. * /--- BLOCK IF 00 000 77/01/06 01.33
  285. TITLE -IF- COMMAND READIN
  286. * -IF- ENTRY FOR -IF- COMMAND
  287. *
  288. ENTRY IFIN
  289. IFIN RJ INITCAL DO INITIALIZATIONS
  290. SA1 TAGCNT
  291. ZR X1,NOTAG ERROR IF BLANK TAG
  292. * PROCESS TAG
  293. RJ BRANCMP
  294. * SET UP AND STORE -ISTACK- INFO
  295. SX1 0 GENERATE IMAGINARY LABEL
  296. RJ LABFIND FOR FALSE BRANCH
  297. SB5 B1 B5 = LABEL FOR FALSE BRANCH
  298. SX1 B0 GENERATE IMAGINARY LABEL
  299. RJ LABFIND FOR END BRANCH
  300. SX6 10000B TYPE = 1 FOR -IF- COMMAND
  301. PX6 X6,B1 PACK UP -TYPE- AND END LABEL
  302. LX6 -12 -TYPE- FIELD IS SIX BITS
  303. * 'CALLING -CHKIND- USING THE INDENT LEVEL OF
  304. * THE CURRENT LINE AS AN ARGUMENT GUARENTEES
  305. * THAT THE STACK IS NOT FULL. 'THUS, WE DO NOT
  306. * NEED TO CHECK FOR STACK OVERFLOW. (-GETLINE-
  307. * DISCARDS LINES WITH TOO MANY INDENTS.)
  308. SA1 PISTACK CURRENT LENGTH OF -ISTACK-
  309. SX7 X1+1 INCREMENT -PISTACK-
  310. SA7 A1 STORE UPDATED VALUE
  311. PX6 X6,B5 ADD -FALSE- LABEL
  312. SA6 ISTACK+X1 STORE -IF- COMMAND INFO
  313. * COMPILE CODE FOR BRANCH X,FALSE (B5 HAS LABEL)
  314. * -ELSEIF- COMMAND ENTERS HERE (WITH B5 SET)
  315. IFGO RJ JPB3 PUT JPB3 IN INSTRUCTION STREAM
  316. SX2 7105B SX0 B5+0*
  317. SB2 1 TYPE = 1 (COMMAND PART)
  318. SB1 B5 LABEL NUMBER
  319. RJ CLABREF X0 WILL HOLD NEW VALUE FOR A5
  320. RJ JPB3 NEXT INSTRUCTION
  321. SX2 6115B SB1 B5+0*
  322. SB2 2 TYPE = 2 (EXTRA STORAGE PART)
  323. SB1 B5 LABEL NUMBER
  324. RJ CLABREF B1 WILL HOLD JUMP ADDRESS
  325. SA5 LLSYSNT ADDRESS OF -SYSJPNT- (NO TIME CHECK DONE)
  326. SX7 0321B PL X1,SYSJPNT
  327. LX7 18
  328. BX7 X7+X5
  329. RJ LONGI PRESERVES X5
  330. SX7 0301B ZR X1,SYSJPNT
  331. LX7 18
  332. BX7 X7+X5
  333. RJ LONGI
  334. EQ NOCONT
  335. * /--- BLOCK ELSE 00 000 77/01/06 01.34
  336. TITLE -ELSE- AND -ELSEIF- COMMAND READIN
  337. * -ELSE- ENTRY FOR -ELSE- COMMAND
  338. *
  339. ENTRY ELSEC
  340. ELSEC RJ IFCHECK INITIAL PROCESSING
  341. SA1 TAGCNT
  342. NZ X1,IFERR94 ERROR IF TAG
  343. RJ ELSEDO
  344. * CHANGE TYPE FIELD FROM 1 TO 2
  345. MX0 -6
  346. BX5 X0*X5 CLEAR OLD *TYPE*
  347. SX6 2 NEW TYPE = 2
  348. BX5 X6+X5
  349. PX6 X5,B5 PACK IN NEW -FALSE- LABEL
  350. SA6 A5 STORE -ISTACK- INFO
  351. EQ NOCONT
  352. *
  353. * -ELSEIF- ENTRY FOR -ELSEIF- COMMAND
  354. *
  355. ENTRY ELSEIFC
  356. ELSEIFC RJ IFCHECK INITIAL PROCESSING
  357. SA1 TAGCNT
  358. ZR X1,NOTAG ERROR IF BLANK TAG
  359. RJ ELSEDO
  360. PX6 X5,B5 PACK IN NEW -FALSE- LABEL
  361. SA6 A5 STORE -ISTACK- INFO
  362. * PROCESS TAG
  363. RJ BRANCMP
  364. * -CHKIND- GUARENTEED THAT PISTACK = INDENT+1
  365. SA1 PISTACK CURRENT LENGTH OF -ISTACK-
  366. SA1 ISTACK-1+X1 GET TOP STACK ELEMENT
  367. UX1,B5 X1 SET B5 FOR -IFGO-
  368. EQ IFGO JUMP INTO -IF- PROCESSOR
  369. *
  370. * THIS SUBROUTINE DOES SPECIAL PROCESSING
  371. * FOR THE -ELSE- AND -ELSEIF- COMMANDS.
  372. *
  373. * B5 IS RETURNED WITH NEXT -FALSE- BRANCH
  374. * A5,X5 HOLDS REMAINDER OF ISTACK INFO
  375. *
  376. ELSEDO DATA 0
  377. * MAKE SURE AN -IF- IS ACTIVE
  378. * -CHKIND- GUARENTEED THAT PISTACK = INDENT+1
  379. SA5 PISTACK CURRENT LENGTH OF -ISTACK-
  380. SA5 ISTACK-1+X5 GET TOP STACK ELEMENT
  381. MX1 -6
  382. BX1 -X1*X5 GET -TYPE- FIELD
  383. SX1 X1-1 CHECK FOR TYPE = 1
  384. NZ X1,IFERR91 ERROR IF NO -IF- IS ACTIVE
  385. * COMPILE A DIRECT BRANCH TO END-OF-CASE LABEL
  386. RJ JPB3 FIND LOC OF NEXT INSTRUCTION
  387. SX2 5155B SA5 B5+0*
  388. SB2 1 TYPE = 1 (COMMAND PART)
  389. UX5,B5 X5 B5 = LABEL FOR FALSE BRANCH
  390. LX5 12
  391. UX5,B1 X5 END LABEL NUMBER
  392. PX5 X5,B1 PRESERVE IT
  393. RJ CLABREF A5 WILL BE UPDATED PROPERLY
  394. RJ JPB3 NEXT INSTRUCTION
  395. SX2 0255B JP B5+0*
  396. SB2 2 TYPE = 2 (EXTRA STORAGE PART)
  397. * /--- BLOCK ENDIF 00 000 77/01/06 15.49
  398. UX5,B1 X5
  399. PX5 X5,B1
  400. RJ CLABREF WILL DO DIRECT JUMP INTO X-STOR
  401. * DEFINE LABEL FOR FALSE BRANCH OF PREVIOUS -IF-
  402. SB1 B5 LABEL NUMBER OF FALSE BRANCH
  403. RJ LABDEF
  404. SX1 0 GENERATE IMAGINARY LABEL
  405. RJ LABFIND FOR NEXT FALSE BRANCH
  406. SB5 B1 RETURN IN B5
  407. LX5 -12
  408. EQ ELSEDO
  409. TITLE -ENDIF- COMMAND READIN
  410. * -ENDIF- ENTRY FOR -ENDIF- COMMAND
  411. *
  412. ENTRY ENDIFC
  413. ENDIFC SA1 TAGCNT
  414. NZ X1,IFERR94 ERROR IF TAG
  415. RJ IFCHECK INITIAL PROCESSING
  416. RJ POPTOP TERMINATE THE -IF- STRUCTURE
  417. EQ NOCONT DISALLOW CONTINUED ENDIF'7S
  418. *
  419. * -IFCHECK-
  420. *
  421. * 'THIS ROUTINE IS USED BY THE -ELSEIF-,
  422. * -ELSE-, AND -ENDIF- COMMANDS. 'IT MAKES
  423. * SURE THAT AN -IF- COMMAND IS ACTIVE, AND
  424. * CALLS -CHKIND- TO VERIFY THAT THE USER
  425. * HAS DECREASED HIS INDENTING EXACTLY ONE
  426. * LEVEL.
  427. *
  428. IFCHECK DATA 0
  429. RJ INITCAL DO INITIALIZATIONS
  430. * MAKE SURE AN -IF- STRUCTURE IS ACTIVE
  431. SA1 INDENT INDENT LEVEL OF CURRENT COMMAND
  432. SA2 PISTACK CURRENT LENGTH OF -ISTACK-
  433. IX3 X1-X2 SEE IF -ISTACK- IS FULL ENOUGH
  434. PL X3,IFERR91 JUMP IF CAN'7T HAVE -IF- STRUCTURE
  435. SA2 ISTACK+X1 STACK ELEMENT FOR THIS LEVEL
  436. MX0 -6
  437. BX2 -X0*X2 GET -TYPE- FIELD
  438. ZR X2,IFERR91
  439. SX2 X2-3 ALLOW ONLY TYPES 1 AND 2
  440. PL X2,IFERR91 JUMP IF NO -IF- COMMAND
  441. SX1 X1+1 CURRENT STACK LEVEL MUST BE ONE MORE
  442. RJ CHKIND VERIFY PROPER INDENTING
  443. EQ IFCHECK
  444. * /--- BLOCK LOOP 00 000 77/01/06 16.27
  445. TITLE -LOOP- COMMAND READIN
  446. * -LOOP- ENTRY FOR -LOOP- COMMAND
  447. *
  448. ENTRY DOUNTOC
  449. DOUNTOC BSS 0
  450. SX5 30000B TYPE = 3 FOR LOOP STRUCTURES
  451. RJ INITCAL DO INITIALIZATIONS
  452. SX1 0 GENERATE IMAGINARY LABEL
  453. RJ LABFIND FOR *END* BRANCH
  454. PX5 X5,B1 ATTACH *END* LABEL
  455. SX1 B0 GENERATE IMAGINARY LABEL
  456. RJ LABFIND FOR *LOOP* BRANCH
  457. AX5 12
  458. PX6 X5,B1 ATTACH *LOOP* LABEL
  459. SA6 LOOPTEMP LOOPTEMP = INFO FOR -STACK-
  460. RJ LABDEF DEFINE *LOOP* LABEL
  461. + NZ B1,* SYSTEM ERROR PROTECTION
  462. SA1 TAGCNT
  463. ZR X1,LOOPFIN JUMP IF NO TAG
  464. RJ BRANCMP PROCESS TAG
  465. SA1 LASTKEY CHECK TERMINATING CHAR
  466. NZ X1,=XERRTERM ERROR IF NOT E-O-L
  467. SA1 LOOPTEMP STACK INFO
  468. LX1 12
  469. UX1,B1 X1 B1 = LABEL FOR *END* BRANCH
  470. SA1 PLX1ZRX1 PL X1,*END* ZR X1,*END*
  471. RJ LABJUMP COMPILE JUMP TO *END* LABEL
  472. *
  473. * -LOOPTEMP- HOLDS INFO FOR UPDATING THE STACK
  474. *
  475. LOOPFIN SA1 LOOPTEMP LOAD STACK INFO
  476. SA2 PISTACK CURRENT LENGTH OF -ISTACK-
  477. SX6 X2+1 INCREMENT -PISTACK-
  478. SA6 A2
  479. BX6 X1
  480. SA6 ISTACK+X2 STORE NEW INFO IN -ISTACK-
  481. EQ NOCONT DISALLOW CONTINUED LINES
  482. LOOPTEMP BSS 1
  483. * /--- BLOCK EXITLP 00 000 80/05/06 00.08
  484. TITLE -RELOOP-/-OUTLOOP- COMMAND READIN
  485. *
  486. ENTRY REDOC -RELOOP-
  487. REDOC RJ LPCHECK INITIAL PROCESSING
  488. SA2 INDENT INDENT LEVEL OF CURRENT COMMAND
  489. SA1 ISTACK+X2 X1 = INFO FOR THIS LOOP
  490. UX1,B1 X1 B1 = LABEL FOR -LOOP- BRANCH
  491. EQ REOUTC
  492. *
  493. ENTRY EXITDOC -OUTLOOP-
  494. EXITDOC RJ LPCHECK
  495. SA2 INDENT
  496. SA1 ISTACK+X2
  497. LX1 12
  498. UX1,B1 X1 B1 = LABEL FOR -END- BRANCH
  499. *
  500. * -REOUTC-
  501. * COMMON READIN FOR -RELOOP- / -OUTLOOP-
  502. *
  503. REOUTC SX6 B1 SAVE BRANCH DESTINATION
  504. SA6 LPINFO OVER COMPILE
  505. SA1 EQ ASSUME NO TAG
  506. SA2 TAGCNT SEE IF TAG PRESENT
  507. ZR X2,REOUTC2 EMIT BRANCH IF NOT
  508. *
  509. * COMPILE EXPRESSION
  510. *
  511. RJ BRANCMP COMPILE CODE FOR TAG
  512. * ADD 0 TO X1, IN CASE EXPRESSION = -0
  513. SX7 76000B SX0 B0
  514. RJ SHORT
  515. SX7 36110B IX1 X1+X0
  516. RJ SHORT
  517. SA1 NGX1 NG X1,-END-
  518. *
  519. * EMIT BRANCH, USING LABEL IN *LPINFO*
  520. * AND BRANCH TYPE IN X1
  521. *
  522. REOUTC2 SA2 LPINFO
  523. SB1 X2 B1 = LABEL TO BRANCH TO
  524. RJ LABJUMP COMPILE JUMP
  525. EQ NOCONT
  526. *
  527. LPINFO BSS 1 SAVED BRANCH DESTINATION
  528. *
  529. * /--- BLOCK +ENDLP 00 000 81/04/09 23.12
  530. TITLE -ENDDO- COMMAND READIN
  531. * -ENDDO- ENTRY FOR -ENDDO- COMMAND
  532. *
  533. ENTRY ENDDOC
  534. ENDDOC SA1 TAGCNT
  535. NZ X1,IFERR94 ERROR IF TAG
  536. RJ LPCHECK INITIAL PROCESSING
  537. SA1 INDENT INDENT LEVEL OF CURRENT COMMAND
  538. SX1 X1+1 CURRENT STACK LEVEL MUST BE ONE MORE
  539. RJ CHKIND VERIFY PROPER INDENTING
  540. SA1 EQ SET FOR UNCONDITIONAL BRANCH
  541. EQ ENDUNTC AND FINISH COMMAND
  542. *
  543. * ENTRY UNTILC
  544. * UNTILC RJ LPCHECK INITIAL PROCESSING
  545. * SA1 INDENT INDENT LEVEL OF CURRENT COMMAND
  546. * SX1 X1+1 CURRENT STACK SHOULD BE 1 MORE
  547. * RJ CHKIND VERIFY PROPER INDENTING
  548. * RJ BRANCMP COMPILE CODE FOR TAG
  549. * SA1 LASTKEY CHECK TERMINATING CHAR
  550. * NZ X1,=XERRTERM ERROR IF NOT E-O-L
  551. * SA1 PLX1ZRX1 SET BRANCH TYPE
  552. *
  553. * END-OF-LOOP PROCESSING
  554. *
  555. ENDUNTC BX6 X1
  556. SA6 LPINFO SAVE END-OF-LOOP BRANCH TYPE
  557. RJ POPTOP TERMINATE THE -LOOP- STRUCTURE
  558. EQ NOCONT DISALLOW CONTINUED ENDDO'7S
  559. *
  560. * -LPCHECK-
  561. *
  562. * 'THIS ROUTINE IS USED BY THE -REDO-,
  563. * -EXITDO-, AND -ENDDO- COMMANDS. 'IT MAKES
  564. * SURE THAT A -LOOP- STRUCTURE IS ACTIVE
  565. * AT THE INDENT LEVEL OF THE CURRENT COMMAND.
  566. *
  567. LPCHECK DATA 0
  568. RJ INITCAL DO INITIALIZATIONS
  569. * MAKE SURE A -LOOP- STRUCTURE IS ACTIVE
  570. SA1 INDENT INDENT LEVEL OF CURRENT COMMAND
  571. SA2 PISTACK CURRENT LENGTH OF -ISTACK-
  572. IX3 X1-X2 SEE IF -ISTACK- IS FULL ENOUGH
  573. PL X3,LPERR97 JUMP IF CAN'7T HAVE -LOOP- STRUCTURE
  574. SA2 ISTACK+X1 STACK ELEMENT FOR THIS LEVEL
  575. MX0 -6
  576. BX2 -X0*X2 GET -TYPE- FIELD
  577. SX2 X2-3 ALLOW ONLY TYPE 3
  578. ZR X2,LPCHECK
  579. LPERR97 SB1 97 NO -DOUNTO- COMMAND
  580. EQ =XERR
  581. * /--- BLOCK DOTO 00 000 76/08/30 21.35
  582. TITLE -DOTO- COMMAND READIN
  583. *
  584. *
  585. * DOTO LABEL,INDEX_INITIAL,END,(INCREMENT)
  586. *
  587. *
  588. ENTRY DOTOI ENTRY FOR -DOTO- COMMAND
  589. DOTOI RJ INITCAL DO INITIALIZATIONS
  590. SA1 TAGCNT
  591. ZR X1,NOTAG ERROR IF BLANK TAG
  592. * -DOTO- IN CALC TAG ENTERS HERE
  593. DOTO CALL TAGSAVE SAVE *TAG* (COMPILE MAY MODIFY)
  594. RJ GETSYM
  595. LX1 X0,B2 LEFT-JUSTIFY LABEL
  596. MX0 -18
  597. BX1 X0*X1 LIMIT SYMBOL TO 7 CHARS
  598. MX0 6
  599. BX2 X0*X1 GET TOP CHAR
  600. LX2 6
  601. SX3 X2-1R0 MAKE SURE FIRST CHAR IS NUMERIC
  602. NG X3,LABLERR ERROR IF LESS THAN ZERO
  603. SX3 X2-1R9-1
  604. PL X3,LABLERR ERROR IF GREATER THAN NINE
  605. RJ LABFIND LOCATE LABEL NAME
  606. SA1 LABADDR+B1 INFO FOR THIS LABEL
  607. BX0 X1
  608. AX0 18 CHECK IF LABEL IS DEFINED
  609. NZ X0,DTOE78 ERROR IF LABEL ALREADY DEFINED
  610. *
  611. * COMPILE CODE TO INITIALIZE INDEX (INDEX_INITIAL)
  612. *
  613. SA1 WORDPT
  614. BX6 X1 SAVE *WORDPT* OF INDEX
  615. SA6 DOSAVE1
  616. SX6 B1
  617. SA6 DOLABEL SAVE LABEL NUMBER
  618. RJ CALCINS COMPILE INDEX_INITIAL
  619. SA1 WORDPT
  620. BX6 X1 SAVE *WORDPT* OF END-TEST
  621. SA6 DOSAVE3
  622. SX7 67303B ADD A SB3 B0-B3
  623. CALL SHORT
  624. CALL PAD FINISH UP CURRENT WORD
  625. *
  626. SA1 NINST RESERVE WORD FOR INITIAL JUMP
  627. SB3 DTO30 -UPNINST- WILL RETURN HERE
  628. SX7 X1+1 -UPNINST- PRESERVES X7
  629. EQ =XUPNINST INCREMENT -NINST-
  630. * /--- BLOCK DOTO 00 000 76/11/25 03.29
  631. DTO30 SA7 DOSAVE2 SAVE ADDRESS FOR LATER
  632. SA2 JPB3A PRESET TO SB3 -B3 JP B3
  633. BX6 X2
  634. SA6 X7-1 STORE PRESET VALUE FOR INITIAL JUMP
  635. SX1 INST+1
  636. IX7 X7-X1 DISPLACEMENT TO WORD HOLDING INITIAL JUMP
  637. SX1 B0 GENERATE IMAGINARY LABEL FOR
  638. RJ LABFIND START OF ENDTEST CODING
  639. BX1 X7
  640. SX7 B1
  641. RJ SA5JPB5 GENERATE DEFERRED JUMP TO ENDTEST CODING
  642. SA5 DOLABEL NUMBER OF -DOTO- LABEL
  643. LX5 12
  644. SX1 B0 GENERATE IMAGINARY LABEL
  645. RJ LABFIND FOR START OF LOOP
  646. SX1 B1
  647. BX5 X5+X1 COMBINE WITH -DOTO- LABEL
  648. RJ LABDEF DEFINE LABEL FOR START OF LOOP
  649. + LT B1,* HANG IF DUPLICATE LABEL
  650. LX5 12
  651. BX7 X5+X7 COMBINE WITH ENDTEST LABEL
  652. SA1 INDENT CURRENT INDENT LEVEL
  653. LX7 6
  654. BX7 X1+X7 COMBINE LABELS AND INDENT LEVEL
  655. LX7 18 MOVE TO TOP OF WORD
  656. SA7 A5 SAVE FOR LATER
  657. *
  658. * COMPILE CODE TO STORE INDEX IN *COMPUSE(0)*
  659. *
  660. CALL TAGREST
  661. SA1 DOSAVE1 RE-SET *WORDPT* TO INDEX
  662. BX6 X1
  663. SA6 WORDPT
  664. SX0 KASSIGN ACCEPT ASSIGNMENT AS TERMINATOR
  665. CALL PSCAN FIND END OF INDEX EXPRESSION
  666. BX0 X0-X1
  667. NZ X0,=XERRTERM ERROR IF TERMINATOR NOT ASSIGN
  668. SX6 1R,
  669. SA6 B1 REPLACE ASSIGNMENT WITH COMMA
  670. SX6 B1
  671. SA6 DOSAVE4 SAVE ADDRESS OF TERMINATOR
  672. CALL GCOMP1 COMPILE INDEX EXPRESSION
  673. AX1 XCODEAL+2
  674. SX0 2 SAVE I/F TYPE OF INDEX
  675. BX6 X0*X1
  676. SA6 DOVTYPE
  677. SX7 10610B
  678. CALL SHORT ADD A BX6 X1
  679. SX7 5160B
  680. LX7 18 ADD A SA6 COMPUSE
  681. SA1 LLCOUSE
  682. BX7 X1+X7 ATTACH ADDRESS OF *COMPUSE*
  683. CALL LONGI
  684. *
  685. * COMPILE CODE TO STORE END-TEST IN *COMPUSE(1)*
  686. *
  687. SA1 DOSAVE3 RE-SET *WORDPT*
  688. BX6 X1
  689. SA6 WORDPT
  690. CALL GCOMP1 EVALUATE END-TEST EXPRESSION
  691. RJ ITFFTI DO ANY I-F OR F-I CONVERSIONS
  692. SX7 10610B
  693. CALL SHORT ADD A BX6 X1
  694. SX7 5160B
  695. LX7 18 ADD A SA6 COMPUSE+1
  696. SA1 LLCOUSE
  697. SX1 X1+1
  698. BX7 X1+X7 ATTACH ADDRESS OF *COMPUSE* +1
  699. CALL LONGI
  700. *
  701. * /--- BLOCK DOTO 00 000 76/07/18 19.15
  702. *
  703. * COMPILE CODE TO GET INCREMENT TO X1
  704. *
  705. SA1 LASTKEY SEE IF AT END-OF-LINE
  706. NZ X1,DTO100
  707. SX7 7110B ASSUMED INCREMENT IS +1.0
  708. LX7 18
  709. SX0 1 ADD A SX1 B0+1
  710. BX7 X0+X7
  711. CALL LONGI
  712. EQ DTO110
  713. *
  714. DTO100 CALL GCOMP1 EVALUATE INCREMENT EXPRESSION
  715. DTO110 RJ ITFFTI
  716. *
  717. * COMPILE RETURN JUMP TO PROPER -DO- EXECUTOR
  718. *
  719. SX7 0100B SET UP RJ INSTRUCTION
  720. LX7 18
  721. SA1 DOVTYPE GET I/F INDEX FLAG
  722. NZ X1,DTO112
  723. SA1 LLDOTOI INTEGER INDEX ROUTINE
  724. EQ DTO114
  725. *
  726. DTO112 SA1 LLDOTOF FLOATING INDEX ROUTINE
  727. *
  728. DTO114 BX7 X1+X7 ADD AN RJ DOX
  729. CALL LONGI
  730. CALL PAD
  731. SA1 NINST RESERVE WORD FOR END LOOP JUMP
  732. BX6 X1 SAVE ADDRESS OF EXIT JUMP
  733. SA6 DOSAVE3
  734. SB3 DTO115 -UPNINST- RETURNS TO DTO115
  735. EQ =XUPNINST INCREMENT -NINST-
  736. DTO115 BSS 0
  737. *
  738. * COMPILE CODE TO STORE INDEX
  739. *
  740. SA1 DOSAVE1 RE-SET *WORDPT* TO INDEX
  741. BX6 X1
  742. SA6 WORDPT
  743. SA1 DOSAVE4 REPLACE ASSIGMENT WITH COMMA
  744. SX6 1R,
  745. SA6 X1
  746. CALL PCOMP1 COMPILE CODE TO STORE INDEX
  747. CALL PAD FILL OUT REST OF WORD
  748. *
  749. * /--- BLOCK DOTO 00 000 77/12/02 21.05
  750. *
  751. * SET UP *DOOFF* TABLE ENTRIES
  752. *
  753. SA1 NINST RESERVE WORD FOR LOOPING JUMP
  754. SX7 X1+0 -UPNINST- PRESERVES X7
  755. SB3 DTO116 -UPNINST- RETURNS TO DTO116
  756. EQ =XUPNINST INCREMENT -NINST-
  757. DTO116 SA2 DOSAVE2 BEGINNING ADDRESS OF CODE
  758. SA0 X2 SET UP CM ADDRESS
  759. IX6 X7-X2 DISPLACEMENT TO LOOPING JUMP
  760. SB1 X6+1 SAVE LENGTH OF COMPILED CODE
  761. SA1 DOSAVE3 ADDRESS OF END-LOOP JUMP
  762. IX1 X1-X2
  763. LX1 18 POSITION RELATIVE JUMP ADDRESS
  764. BX6 X1+X6
  765. SA1 IDOOFF
  766. SX7 X1+1 INCREMENT -DOTO- STACK
  767. SA7 A1
  768. SX7 X7-DOLIM CHECK FOR TABLE OVERFLOW
  769. PL X7,OVRERR
  770. LX1 1 INDEX INTO *DOOFF* TABLE
  771. SA6 X1+DOOFF+1 STORE JUMP ADDRESSES
  772. SA3 IDOPNT POINTER IN -DOTO- ECS BUFFER
  773. SX7 X3+B1
  774. SX0 X7-CDOLTH CHECK FOR BUFFER FULL
  775. PL X0,OVRERR
  776. SA7 A3 UPDATE ECS BUFFER POINTER
  777. SA2 DOLABEL
  778. BX7 X2+X3 COMBINE LABEL/ECS ADDRESS
  779. SA7 X1+DOOFF
  780. SA1 ADOBUFF ADDRESS OF ECS BUFFER
  781. IX0 X1+X3
  782. + WE B1 WRITE COMPILED CODE TO ECS
  783. RJ ECSPRTY
  784. SX6 A0 BACK UP *NINST*
  785. SA6 NINST
  786. MX6 0 PRE-CLEAR FIRST WORD
  787. SA6 A0
  788. * TIME CHECK NOW DONE IN EXECUTION ROUTINE.... GPK
  789. **
  790. ** ADD CALL TO -BREAK- ROUTINE AT BEGIN OF LOOP
  791. **
  792. * SX7 0100B
  793. * LX7 18 ADD AN RJ BREAK
  794. * SA1 LLBREAK
  795. * BX7 X1+X7
  796. * CALL LONGI ADD CALL TO -BREAK-
  797. * CALL PAD
  798. EQ OKCONT
  799. *
  800. * /--- BLOCK LABEL 00 000 76/12/22 12.44
  801. TITLE CHECK IF COMMAND IS STATEMENT LABEL
  802. ENTRY LABELI
  803. LABELI SA1 COMMAND GET POSSIBLE STATEMENT LABEL
  804. MX0 6
  805. BX7 X0*X1 MUST START WITH A NUMBER
  806. LX7 6
  807. SX3 X7-1R CHECK IF FIRST CHAR IS A SPACE
  808. ZR X3,BADINDT
  809. SX3 X7-1R0 CHECK FIRST CHAR GT OR EQ TO 0
  810. NG X3,BADCMND
  811. SX3 X7-1R9-1 CHECK ALSO LT EQ TO 9
  812. PL X3,BADCMND
  813. CALL LJUST,(1R ),0
  814. MX0 42
  815. BX3 -X0*X1 MUST BE 7 CHARACTERS OR LESS
  816. NZ X3,BADLABL
  817. BX5 X1 PRESERVE LABEL NAME
  818. RJ INITCAL INITIALIZE THE CALC
  819. BX1 X5 RESTORE LABEL NAME TO X1
  820. RJ LABFIND LOCATE NUMBER FOR THIS LABEL
  821. SX7 B1 X7 = LABEL NUMBER
  822. RJ LABDEF DEFINE THE LABEL
  823. LT B1,OKCONT EXIT IF DUPLICATE LABEL
  824. * CHECK IF LABEL IS THE END OF A -DOTO- LOOP
  825. SA1 IDOOFF SEE IF ANY UNFINISHED -DOTO-
  826. ZR X1,CALCS TREAT AS -CALC- IF NONE
  827. SB7 B0 MARK NO MATCH FOUND
  828. LX7 48 POSITION NUMBER IN TOP 12 BITS
  829. MX0 12
  830. LX1 1
  831. SB2 X1-2 PICK UP STARTING INDEX
  832. SA1 B2+DOOFF
  833. BX1 X0*X1 SEE IF MATCHES LATEST -DOTO-
  834. BX1 X1-X7
  835. NZ X1,CHKDOTO2 GO TO SEARCH PREVIOUS LABELS
  836. SB7 -1
  837. *
  838. * BACK UP THRU -DOTO-(S) SATISFIED BY THIS LABEL
  839. *
  840. CHKDOTO1 SB2 B2-2 DECREMENT INDEX
  841. NG B2,CHKDOTO3
  842. SA1 B2+DOOFF LOAD NEXT -DOTO- LABEL
  843. BX1 X0*X1
  844. BX1 X1-X7 SEE IF MATCHES IN-HAND LABEL
  845. ZR X1,CHKDOTO1
  846. *
  847. * SEARCH THRU PREVIOUS -DOTO- LABELS
  848. * NESTING ERROR IF ANY SATISFIED
  849. *
  850. CHKDOTO2 SB2 B2-2 DECREMENT INDEX
  851. NG B2,CHKDOTO3
  852. SA1 B2+DOOFF
  853. BX1 X0*X1
  854. BX1 X1-X7 SEE IF MATCHES IN-HAND LABEL
  855. NZ X1,CHKDOTO2
  856. EQ NESTERR ERROR IF FIND A MATCH
  857. *
  858. CHKDOTO3 ZR B7,CALCS EXIT IF NO -DOTO-S MATCHED
  859. SA2 TAGCNT COUNT OF CHARS IN TAG
  860. NZ X2,DTOE82 LABEL OF DOTO MUST HAVE NO TAG
  861. EQ ENDDOTO
  862. * /--- BLOCK ENDDOTO 00 000 76/12/22 12.44
  863. TITLE ENDDOTO -- INSERT COMPILED CODE FOR END OF -DOTO- LOOP
  864. *
  865. * FINISH COMPILING CODE FOR ALL -DOTOS- SATISFIED
  866. * X7 HAS LABEL NUMBER IN UPPER 12 BITS
  867. *
  868. ENDDOTO CALL PAD -PAD- PRESERVES X7
  869. SA1 IDOOFF NUMBER OF -DOTO-S OUTSTANDING
  870. NZ X1,ENDDOTOA
  871. SX6 0 RE-SET ECS BUFFER POINTER
  872. SA6 IDOPNT
  873. EQ OKCONT
  874. ENDDOTOA BX5 X1
  875. LX5 1 COMPUTE INDEX IN -DOTO- TABLE
  876. SA5 X5+DOOFF-2 X5 = FIRST WORD OF DOOFF TABLE
  877. MX0 12
  878. BX2 X0*X5 X2 = LABEL NUMBER
  879. MX4 6
  880. LX4 -36
  881. BX4 X4*X5
  882. AX4 18 X4 = AMOUNT -DOTO- WAS INDENTED
  883. SA3 INDENT AMOUNT LABEL IS INDENTED
  884. BX4 X4-X3 CHECK IF SAME INDENTING
  885. BX2 X2-X7 SEE IF LABELS MATCH
  886. NZ X2,OKCONT DONE IF DIFFERENT LABELS
  887. NZ X4,DTOE83 ERROR IF NOT SAME INDENTING
  888. SX6 X1-1
  889. SA6 A1 UPDATE -IDOOFF-
  890. LX0 -24
  891. BX1 X0*X5
  892. AX1 24
  893. SB1 X1 B1 = LABEL FOR START OF ENDTEST CODING
  894. RJ LABDEF
  895. + LT B1,* HANG IF DUPLICATE LABEL
  896. MX0 12
  897. LX0 -12
  898. BX3 X0*X5
  899. AX3 36
  900. SB1 X3 B1 = START-OF-LOOP LABEL
  901. SA3 ADOBUFF
  902. SX6 X5 DISPLACEMENT TO CODE IN ADOBUFF
  903. IX0 X3+X6 X0 = ECS ADDRESS OF COMPILED CODE
  904. SA6 IDOPNT BACK BUFFER POINTER
  905. SA5 A5+1 LOAD SECOND WORD OF TABLE ENTRY
  906. SB2 X5+1 B2 = LENGTH OF COMPILED CODE
  907. SA1 NINST
  908. AX5 18
  909. IX5 X5+X1 X5 = POINTS TO END-OF-LOOP JUMP
  910. SA0 X1 CM ADDRESS TO BRING CODE TO
  911. SX1 X1+B2 X1 = NEW VALUE FOR -NINST-
  912. SX3 INST+INSTLNG-1
  913. IX3 X1-X3
  914. PL X3,OVRERR ERROR IF TOO MUCH CODE
  915. SX6 X1
  916. SA6 A1 UPDATE -NINST-
  917. SX6 B0
  918. SA6 X1 PRE-CLEAR NEXT WORD
  919. + RE B2 BRING IN COMPILED CODE
  920. RJ ECSPRTY
  921. SX0 INST+1
  922. IX1 X1-X0 DISPLACEMENT TO WORD HOLDING LOOPING JUMP
  923. IX5 X5-X0 ADJUST END-OF-LOOP JUMP
  924. SX5 X5+1
  925. RJ SA5JPB5 GENERATE JUMP TO START OF LOOP
  926. * /--- BLOCK ENDDOTO2 00 000 76/08/30 22.41
  927. SX1 0 GENERATE IMAGINARY LABEL
  928. RJ LABFIND FOR END OF LOOP
  929. SB5 B1 PRESERVE LABEL NUMBER
  930. SX1 X5
  931. RJ SA5JPB5 GENERATE DEFERRED JUMP TO END OF LOOP
  932. SB1 B5
  933. RJ LABDEF DEFINE END-OF-LOOP LABEL
  934. + LT B1,* HANG IF DUPLICATE LABEL
  935. EQ ENDDOTO CHECK NEXT -DOTO-
  936. *
  937. ENTRY DOVTYPE
  938. DOVTYPE BSS 1
  939. *
  940. JPB3A SB3 -B3
  941. JP B3
  942. SJP VFD 12/5155B,18/0,12/0250B,18/0
  943. *
  944. DOLABEL BSS 1
  945. DOSAVE1 BSS 1
  946. DOSAVE2 BSS 1
  947. DOSAVE3 BSS 1
  948. DOSAVE4 BSS 1
  949. * /--- BLOCK ERRORS 00 000 81/07/28 01.05
  950. TITLE ERROR EXITS
  951. NOTAG SB1 41 NO TAG
  952. EQ =XERR
  953. *
  954. BADLABL SB1 42 BAD LABEL
  955. EQ =XERR
  956. *
  957. BDBRNCH SB1 43 BAD BRANCH
  958. EQ =XERR
  959. *
  960. BADSYM SB1 44 BAD SYMBOL
  961. EQ =XERR
  962. *
  963. CALCE1 SB1 46 CALCERR1
  964. EQ =XERR
  965. *
  966. CALCE2 SB1 47 CALCERR2
  967. EQ =XERR
  968. *
  969. CALCE3 SB1 48 CALCERR3
  970. EQ =XERR
  971. *
  972. BADCMND SB1 73 BAD COMMAND NAME
  973. EQ =XERR
  974. *
  975. BADINDT SB1 75 ILLEGAL INDENTING
  976. EQ =XERR
  977. *
  978. NESTERR SB1 55 DOTO NESTING ERROR
  979. EQ =XERR
  980. *
  981. LABLERR SB1 56 DOTO STATEMENT LABEL ERROR
  982. EQ =XERR
  983. *
  984. OVRERR SB1 57 DOTO BUFFER OVERFLOW
  985. EQ =XERR
  986. *
  987. DTOE78 SB1 78 LABEL OF -DOTO- ALREADY DEFINED
  988. EQ =XERR
  989. *
  990. DTOE82 SB1 82 LABEL OF DOTO MAY NOT HAVE TAG
  991. EQ =XERR
  992. *
  993. DTOE83 SB1 83 LABEL OF DOTO HAS BAD INDENTING
  994. EQ =XERR
  995. *
  996. IFERR91 SB1 91 NO -IF- COMMAND
  997. EQ =XERR
  998. *
  999. IFERR94 SB1 94 COMMAND MUST HAVE NO TAG
  1000. EQ =XERR
  1001. *
  1002. *
  1003. SAVLAST BSS 1
  1004. XBRAN BSS 1 -1 IF NO BRANCH X YET
  1005. IBRAN BSS 1 -1 IF -BRANCH Q- ENCOUNTERED
  1006. IDOOFF BSS 1
  1007. IDOPNT BSS 1
  1008. *
  1009. EXT CALCACT,NLABELS MOVED TO COND
  1010. TDEFER BSS 1 POINTER TO TEMPORARY BUFFER
  1011. * /--- BLOCK INITCALC 00 000 76/08/30 21.35
  1012. TITLE INITCAL -- INITIALIZATIONS FOR FIRST CALC-TYPE COMMAND
  1013. * THIS ROUTINE PRESERVES ALL 4, 5, AND 7 REGISTERS
  1014. INITCAL DATA 0
  1015. SA1 CALCACT
  1016. NG X1,INITCAL EXIT IF CALC IS ALREADY ACTIVE
  1017. MX6 -1
  1018. SA6 A1 MARK CALC ACTIVE
  1019. SX6 LABLIM MAXIMUM NUMBER OF LABELS
  1020. SA6 TDEFER INIT. POINTER TO DEFERRED TEMPS
  1021. SX6 0
  1022. SA6 IBRAN MARK NO -BRANCH Q- ENCOUNTERED
  1023. SA6 COMPALL SET NO COMPILE OF SIMPLE REF
  1024. SA6 INST CLEAR FIRST INSTRUCTION WORD
  1025. SX6 INST
  1026. SA6 NINST INITIALIZE INST POINTER
  1027. SX6 X6+INSTLNG
  1028. SA6 NINSTLIM LIMIT ON ADVANCE OF NINST
  1029. SX6 1
  1030. SA6 RSULTX1 SET RESULT NOT NEEDED IN X1
  1031. SA6 CMOVFLG SET NOT TO MOVE CODE AFTER EACH LINE
  1032. SA6 NOTLITS FOR ROUTINE -SHORT-
  1033. SA1 DOBFPNT
  1034. BX6 X1 SAVE COMPILED CODE POINTER
  1035. SA6 IDOPNT
  1036. SA1 NDOOFF
  1037. BX6 X1 SAVE VALUE OF *NDOOFF* AT ENTRY
  1038. SA6 IDOOFF
  1039. EQ INITCAL
  1040. * /--- BLOCK ENDCALC 00 000 79/08/08 10.45
  1041. TITLE ENDCALC -- TERMINATE CALC AND PROCESS TEMPORARY TABLE
  1042. *
  1043. * 'THIS ROUTINE PRESERVES A5,B5, AND X5
  1044. *
  1045. ENTRY ENDCALC
  1046. ENDCALC DATA 0
  1047. SA1 CALCACT
  1048. PL X1,ENDCALC EXIT IF NO -CALC- ACTIVE
  1049. SX6 B0
  1050. SA6 A1 MARK -CALC- NOT ACTIVE
  1051. * COMPILE A JP B3
  1052. SX7 23B
  1053. LX7 21
  1054. RJ LONGI
  1055. RJ PAD
  1056. * MOVE COMPILED CODE INTO -INFO- BUFFER
  1057. SA1 ATEMPEC ECS WORK BUFFER POINTER
  1058. SX3 INST FIRST WORD OF CODE
  1059. BX0 X1
  1060. SA0 X3
  1061. SA1 NINST ONE PAST LAST WORD OF CODE
  1062. IX3 X1-X3
  1063. SB1 X3 B1 = LENGTH OF COMPILED CODE
  1064. SA2 ICX
  1065. WE B1
  1066. RJ =XECSPRTY
  1067. SX2 X2-1 NEW VALUE FOR -ICX-
  1068. SA1 INX
  1069. SA0 INFO+X1 WHERE CODE GOES IN INFO BUFFER
  1070. IX6 X1+X3 NEW VALUE FOR -INX-
  1071. IX3 X6-X2 COMPARE
  1072. PL X3,=XLNGUNIT ERROR EXIT IF UNIT TOO LONG
  1073. SA6 A1 UPDATE -INX-
  1074. BX6 X2
  1075. SA6 A2 UPDATE -ICX-
  1076. SX3 CALC=
  1077. SB7 X1 SET ARGUMENT FOR -TEMPREF-
  1078. LX1 60-XCODEL BEGINNING OF CALC IN XSTOR
  1079. BX6 X1+X3 FORM COMPLETE COMMAND WORD
  1080. SA6 INFO+X2 STORE COMMAND WORD
  1081. RE B1
  1082. RJ =XECSPRTY
  1083. * PROCESS THE TEMPORARY TABLE
  1084. RJ TEMPREF
  1085. * UPDATE -DOTO- POINTERS AND WRITE -DOOFF- TO ECS
  1086. SA2 IDOOFF CURRENT INDEX IN *DOOFF* TABLE
  1087. SA3 IDOPNT
  1088. BX6 X2
  1089. SA6 NDOOFF UPDATE *NDOOFF*
  1090. BX6 X3
  1091. SA6 DOBFPNT UPDATE -DOTO- CODE POINTER
  1092. EQ ENDCALC
  1093. * /--- BLOCK GETSYM 00 000 77/12/13 16.07
  1094. TITLE GETSYM -- GET NEXT LABEL FOR -BRANCH- OR -DOTO-
  1095. GETSYM EQ * GET NEXT SYMBOL
  1096. SA4 WORDPT
  1097. SB2 60 KEEP LEFT JUSTIFY COUNT IN B2
  1098. SB1 1
  1099. SA4 X4 LOAD FIRST CHAR
  1100. MX0 0
  1101. EQ GETSYM1
  1102. *
  1103. GETSYML LX0 6
  1104. BX0 X0+X4 MERGE IN NEW CHAR
  1105. SB2 B2-6
  1106. GETSYL1 SA4 A4+B1 LOAD NEXT CHAR
  1107. GETSYM1 ZR X4,GETSEOL JUMP IF END OF LINE
  1108. SX7 X4-1R REMOVE ANY SPACES
  1109. ZR X7,GETSYL1
  1110. SX7 X4-1R9-1 MUST BE A LETTER OR NUM IF PART OF SYMBOL
  1111. NG X7,GETSYML OK
  1112. * SX7 X4-1R. PERIOD IS ALSO OK
  1113. * ZR X7,GETSYML
  1114. SX7 A4+B1 MOVE WORDPT PAST COMMA
  1115. SA7 WORDPT
  1116. SX7 X4-1R, ELSE CHECK FOR COMMA
  1117. NZ X7,=XERRTERM TOO BAD, FORM ERROR
  1118. MX7 18
  1119. BX7 X7*X0 MASK OFF TOP 3 CHARACTERS
  1120. NZ X7,=XERRNAME ERROR IF NAME TOO LONG
  1121. EQ GETSYM
  1122. GETSEOL SX7 A4 LEAVE WORDPT AT EOL
  1123. SA7 WORDPT
  1124. MX7 18
  1125. BX7 X7*X0 MASK OFF TOP 3 CHARACTERS
  1126. NZ X7,=XERRNAME ERROR IF NAME TOO LONG
  1127. EQ GETSYM
  1128. * /--- BLOCK ITFFTI 00 000 77/01/06 18.12
  1129. TITLE ITFFTI
  1130. *
  1131. *
  1132. * -ITFFTI-
  1133. * GENERATE INSTRUCTIONS TO CONVERT FROM INTEGER TO
  1134. * FLOATING OR FROM FLOATING TO INTEGER
  1135. *
  1136. *
  1137. ENTRY ITFFTI
  1138. ITFFTI EQ *
  1139. MX0 -1
  1140. AX1 XCODEAL+3 POSITION I/F BIT
  1141. BX1 -X0*X1
  1142. SA2 DOVTYPE LOAD I/F BIT OF INDEX
  1143. BX1 X1+X2 MERGE I/F BITS
  1144. SB1 X1
  1145. JP B1+*+1 JUMP ON COMBINED I/F BITS
  1146. *
  1147. + EQ ITFFTI 0 = I TO I
  1148. + EQ FTI 1 = F TO I
  1149. + EQ ITF 2 = I TO F
  1150. + EQ ITFFTI 3 = F TO F
  1151. *
  1152. FTI SX7 0100B ADD A RJ XGFTOI
  1153. LX7 18
  1154. SA1 LLFTOI ADDRESS OF F TO I ROUTINE
  1155. BX7 X1+X7
  1156. CALL LONGI
  1157. CALL PAD FILL OUT REST OF WORD
  1158. EQ ITFFTI
  1159. *
  1160. ITF SX7 27101B ADD A PX1 X1,B0
  1161. CALL SHORT
  1162. SX7 24101B ADD A NX1 X1,B0
  1163. CALL SHORT
  1164. EQ ITFFTI
  1165. * /--- BLOCK GLOBSYM 00 000 77/05/06 00.12
  1166. TITLE PROCESS DEFERRED GLOBAL SYMBOL REFERENCES
  1167. *
  1168. *
  1169. *
  1170. * -GLOBSYM-
  1171. * CALLED ON COMPLETION OF UNIT TO SATISFY DEFERRED
  1172. * REFERENCES TO STATEMENT LABELS
  1173. *
  1174. *
  1175. ENTRY GLOBSYM
  1176. GLOBSYM EQ *
  1177. SX6 0 MARK NO MISSING LABELS
  1178. SA6 GLOBMISS
  1179. SA1 NDEFERR SEE IF ANY DEFERRED REFERENCES
  1180. ZR X1,GLOBSYM EXIT IF NONE
  1181. SB5 X1 B5 = NUMBER OF DEFERRED SYMBOLS
  1182. *
  1183. * PROCESS EACH DEFERRED REFERENCE
  1184. GLOBSYMA SA2 LDEFER-1+B5 LOAD NEXT REFERENCE
  1185. UX2,B1 X2 B1 = LABEL NUMBER
  1186. MX0 -24
  1187. BX1 -X0*X2 LOWER 24 BITS TO X1
  1188. BX2 X0*X2
  1189. LX1 -12 X1 = POINTER INTO -INST- BUFFER
  1190. LX2 -36 X2 = OTHER INFO (DEPENDS ON TYPE)
  1191. UX1,B2 X1 B2 = TYPE OF TABLE ENTRY
  1192. UX2,B3 X2 B3 = SHIFT COUNT (FOR MOST TYPES)
  1193. * CHECK IF LABEL IS DEFINED
  1194. SA3 LABADDR+B1
  1195. AX3 19 SHIFT TEMP+XSTOR
  1196. NZ X3,GLOBSYMB JUMP IF LABEL DEFINED
  1197. SX6 -1 MARK MISSING LABELS
  1198. SA6 GLOBMISS
  1199. EQ GLOBSYMC
  1200. GLOBSYMB RJ LABRF PROCESS THE DEFERRED REFERENCE
  1201. GLOBSYMC SB5 B5-1 END TEST
  1202. GT B5,GLOBSYMA
  1203. SA1 GLOBMISS
  1204. ZR X1,GLOBSYM EXIT IF NO MISSING LABELS
  1205. * SEARCH LABEL TABLE FOR UNDEFINED LABELS
  1206. SA1 NLABELS
  1207. SB7 X1 B7 = NUMBER OF LABELS
  1208. SB5 B0
  1209. GLOBSYMD SB5 B5+1
  1210. GT B5,B7,GLOBSYM
  1211. CALL UERRSET SET EDIT CONNECT GOTO UNIT CMD
  1212. SA2 LABADDR-1+B5 CHECK NEXT LABEL
  1213. AX2 19 SHIFT TEMP+XSTOR
  1214. NZ X2,GLOBSYMD CONTINUE IF LABEL DEFINED
  1215. * OUTPUT ',MISSING LABEL', MESSAGE
  1216. SA1 LABELS-1+B5 GET LABEL NAME
  1217. ZR X1,GLOBSYMD SKIP ANY IMAGINARY LABELS
  1218. SB2 -1 NO BAD LINE TO SAVE
  1219. SB1 912 MISSING LABEL MESSAGE
  1220. RJ =XRJERR2
  1221. EQ GLOBSYMD CONTINUE SEARCH
  1222. *
  1223. GLOBMISS BSS 1 TEMPORARY
  1224. * /--- BLOCK +CHKIND 00 000 80/05/06 01.20
  1225. TITLE CHKIND -- CHECK IF INDENTING IS CORRECT
  1226. * -CHKIND-
  1227. *
  1228. * 'THIS ROUTINE VERIFIES THAT THE USER
  1229. * IS INDENTING HIS CODE PROPERLY. 'CHANGING
  1230. * THE STACK WHEN IMPROPER INDENTING IS
  1231. * DETECTED MAKES IT SO THAT ERRORS LIKE
  1232. * ',MISSING ENDIF COMMAND', DO NOT PROPAGATE
  1233. * THEMSELVES OVER MANY LINES OF CODE.
  1234. *
  1235. * 'ON 'ENTRY -- X1 HOLDS HOW MANY ELEMENTS
  1236. * THE STACK SHOULD HAVE IN IT
  1237. * IF THE USER HAS INDENTED THE
  1238. * CURRENT LINE CORRECTLY.
  1239. *
  1240. * 'ON 'EXIT -- 'THE STACK IS CHANGED TO HOLD
  1241. * WHAT IS SHOULD HOLD. 'APPROPRIATE
  1242. * ERROR MESSAGES ARE OUTPUT.
  1243. *
  1244. * 'THIS ROUTINE PRESERVES A5,B5, AND X5
  1245. *
  1246. ENTRY CHKIND
  1247. CHKIND DATA 0
  1248. SA2 PISTACK CURRENT LENGTH OF -ISTACK-
  1249. IX7 X1-X2 COMPARE WITH DESIRED VALUE
  1250. SX6 B0
  1251. ZR X7,CHKIND IMMEDIATE EXIT IF THE SAME
  1252. + NG X1,* SYSTEM ERROR PROTECTION
  1253. SX3 X1-ISTACKL-1 CAN'7T BE MORE THAN -ISTACKL-
  1254. + PL X3,* SYSTEM ERROR PROTECTION
  1255. NG X7,CHKINDB JUMP IF -ISTACK- IS TOO FULL
  1256. * INCREASE -STACK- BY INSERTING ZERO ELEMENTS
  1257. CHKINDA SA6 ISTACK+X2 CLEAR NEXT -ISTACK- ELEMENT
  1258. SX2 X2+1 ADVANCE POINTER
  1259. SX7 X7-1
  1260. NZ X7,CHKINDA LOOP UNTIL ALL WORDS ARE ZEROED
  1261. SX6 X2
  1262. SA6 A2 UPDATE -PISTACK-
  1263. SB1 74 ILLEGAL INDENTING
  1264. RJ =XRJERR OUTPUT CONDENSE ERROR MESSAGE
  1265. EQ CHKIND
  1266. * DECREASE -ISTACK- BY TERMINATING ANY ACTIVE STRUCTURES
  1267. CHKINDB BX6 X1
  1268. SA6 CHKTEMP SAVE ARGUMENT FOR LATER
  1269. RJ INITCAL MAKE SURE -CALC- IS INITIALIZED
  1270. CHKINDC SA2 PISTACK
  1271. SA1 CHKTEMP
  1272. IX7 X2-X1
  1273. ZR X7,CHKIND EXIT IF -ISTACK- LENGTH IS NOW CORRECT
  1274. SA2 ISTACK-1+X2 LOAD TOP -ISTACK- ELEMENT
  1275. MX0 -6
  1276. BX2 -X0*X2 GET -TYPE- FIELD
  1277. ZR X2,CHKINDD NO ERROR MESSAGE IF TYPE ZERO
  1278. SA1 CHKTAB-1+X2 GET ERROR MESSAGE FOR THIS TYPE
  1279. SB1 X1
  1280. RJ =XRJERR OUTPUT CONDENSE ERROR MESSAGE
  1281. * /--- BLOCK +CHKIND 00 000 81/03/18 20.43
  1282. CHKINDD SA1 EQ SET ENDLOOP BRANCH TYPE
  1283. BX6 X1
  1284. SA6 LPINFO
  1285. RJ POPTOP DECREMENT THE STACK
  1286. EQ CHKINDC
  1287. *
  1288. CHKTEMP BSS 1
  1289. * ERROR MESSAGES FOR EACH TYPE (EXCEPT ZERO)
  1290. CHKTAB DATA 92 MISSING -ENDIF- COMMAND
  1291. DATA 92 MISSING -ENDIF- COMMAND
  1292. DATA 96 MISSING -ENDDO- COMMAND
  1293. ***NOTE***ADD ENTRIES TO THE ABOVE TABLE FOR EACH NEW -TYPE-
  1294. * /--- BLOCK +POPTOP 00 000 81/03/18 20.45
  1295. TITLE POPTOP -- REMOVE TOP STACK ELEMENT
  1296. * -POPTOP-
  1297. *
  1298. * 'THIS ROUTINE REMOVES THE TOP ELEMENT
  1299. * OF -ISTACK- BY PROPERLY TERMINATING WHATEVER
  1300. * STRUCTURE WAS ACTIVE.
  1301. *
  1302. * 'THIS ROUTINE PRESERVES A5,B5, AND X5
  1303. *
  1304. POPTOP DATA 0
  1305. SA2 PISTACK CURRENT STACK POINTER
  1306. SX6 X2-1 DECREMENT BY ONE
  1307. + NG X6,* SYSTEM ERROR PROTECTION
  1308. SA1 ISTACK+X6 LOAD TOP ELEMENT OF STACK
  1309. SA6 A2 UPDATE -PISTACK-
  1310. SX6 B0
  1311. SA6 A1 CLEAR THIS -ISTACK- POSITION
  1312. MX0 -6
  1313. BX0 -X0*X1 LOWER 6 BITS ARE -TYPE- FIELD
  1314. SB1 X0
  1315. SB2 POPTOPK-POPTOPJ LENGTH OF TABLE
  1316. + GE B1,B2,* SYSTEM ERROR PROTECTION
  1317. JP POPTOPJ+B1 DO JUMP ON -TYPE-
  1318. POPTOPJ EQ POPTOP 0 = NOTHING IN STACK
  1319. EQ POPENDIF 1 = -IF- COMMAND IS ACTIVE
  1320. EQ POPENDIF 2 = -ELSE- COMMAND ENCOUNTERED
  1321. EQ POPENDLP 3 = -LOOP- OR -FOR- COMMAND IS ACTIVE
  1322. ***NOTE*** 'EACH TIME A NEW -TYPE- IS DEFINED, BE SURE TO
  1323. ***NOTE*** UPDATE THE TABLE -CHKTAB- IN ROUTINE -CHKIND-.
  1324. POPTOPK BSS 0 MARKER FOR END OF TABLE
  1325. *
  1326. * 'TERMINATE THE -IF- STRUCTURE.
  1327. * X1 HAS STACK INFO.
  1328. POPENDIF UX7,B7 X1 B7 = LABEL FOR -FALSE- BRANCH
  1329. RJ INITCAL DO INITIALIZATIONS
  1330. SB1 B7
  1331. RJ LABDEF DEFINE -FALSE- LABEL
  1332. LX7 12
  1333. UX7,B1 X7 B1 = LABEL FOR -END- BRANCH
  1334. RJ LABDEF DEFINE -END- BRANCH
  1335. EQ POPTOP
  1336. *
  1337. * 'TERMINATE THE -LOOP- STRUCTURE.
  1338. * X1 HAS STACK INFO.
  1339. * *LPINFO* HAS END-OF-LOOP BRANCH TYPE
  1340. POPENDLP UX7,B7 X1 B7 = LABEL FOR -LOOP- BRANCH
  1341. RJ INITCAL DO INITIALIZATIONS
  1342. SA7 POPTEMP SAVE LABEL FOR -END- BRANCH
  1343. SA1 LPINFO X1 = BRANCH TYPE
  1344. SB1 B7 LABEL NUMBER
  1345. RJ LABJUMP OUTPUT BRANCH TO START OF LOOP
  1346. SA2 POPTEMP
  1347. LX2 12
  1348. UX2,B1 X2 B1 = LABEL FOR -END- BRANCH
  1349. RJ LABDEF DEFINE THE LABEL
  1350. EQ POPTOP
  1351. *
  1352. POPTEMP BSS 1
  1353. *
  1354. * /--- BLOCK LABJUMP 00 000 79/08/08 11.48
  1355. TITLE LABJUMP -- COMPILE BRANCH TO SPECIFIED STATEMENT LABEL
  1356. * -LABJUMP-
  1357. *
  1358. * 'THIS ROUTINE COMPILES A BRANCH TO A
  1359. * SPECIFIED STATEMENT LABEL. 'IT CHECKS
  1360. * FOR FORWARDS BRANCHES (NO TIME CHECK
  1361. * NEEDED) AND FOR A LABEL WITHIN THE SAME
  1362. * CALC (NO RESET OF -A5- NEEDED). 'THE
  1363. * GENERATED CODE (ALWAYS) SETS B1 TO THE
  1364. * EXTRA STORAGE PART OF THE LABEL AND
  1365. * (SOMETIMES) SETS X0 TO THE COMMAND PART
  1366. * OF THE LABEL. 'IT THEN COMPILES A BRANCH
  1367. * TO ONE OF THE FOLLOWING CENTRAL MEMORY
  1368. * LOCATIONS';
  1369. * A) -SYSJP-, IF THE BRANCH IS BACKWARDS
  1370. * AND WITHIN THE SAME CALC. 'DOES A TIME
  1371. * CHECK BUT DOES NOT RESET A5.
  1372. * B) -SYSJPA5-, IF THE BRANCH IS BACKWARDS
  1373. * BUT IN A DIFFERENT CALC. 'DOES A TIME
  1374. * CHECK AND RESETS A5 (TO X0).
  1375. * C) -SYSJPNT-, IF THE BRANCH IS FORWARDS.
  1376. * 'RESETS A5 BUT DOES NO TIME CHECKS.
  1377. *
  1378. * 'ON 'ENTRY --
  1379. * B1 = LABEL NUMBER
  1380. * X1 = 6400 INSTRUCTIONS TELLING WHEN
  1381. * THE BRANCHES ARE TO BE TAKEN.
  1382. * 'THE LOWER 12 BITS HOLD THE FIRST
  1383. * INSTRUCTION. 'IF THE SAME BRANCH
  1384. * IS TO BE TAKEN FOR SEVERAL CONDITIONS,
  1385. * THE UPPER BITS MAY HOLD ADDITIONAL
  1386. * INSTRUCTIONS. (LIMIT'; 4 INSTRUCTIONS
  1387. * IN LOWER 48 BITS)
  1388. *
  1389. * 'THIS ROUTINE PRESERVES A5,B5, AND X5
  1390. *
  1391. LABJUMP DATA 0
  1392. + SA2 CALCACT A -CALC- MUST BE ACTIVE
  1393. * PL X2,* SYSTEM ERROR PROTECTION
  1394. PL X2,=XERRORC IF NOT ACTIVE
  1395. PX6 X1,B1 SAVE ARGUMENTS IN -LJTEMP-
  1396. SA6 LJTEMP
  1397. * GENERATE SB1 TO X-STOR PART OF LABEL
  1398. RJ JPB3 PUT JPB3 IN INSTRUCTION STREAM
  1399. SX2 6115B SB1 B5+0*
  1400. SB2 2 TYPE = 2 (EXTRA STORAGE PART)
  1401. SA3 LJTEMP
  1402. UX3,B1 X3 LABEL NUMBER
  1403. SB7 B1 SAVE IN B7
  1404. RJ CLABREF B1 WILL HOLD JUMP ADDRESS
  1405. * CHECK FOR BACKWARDS BRANCH WITHIN THE SAME CALC
  1406. SA1 LABADDR+B7 LOAD INFO FOR THIS LABEL
  1407. AX1 18 COMMAND PART OF LABEL
  1408. SX1 X1-1 *1* MEANS LABEL IS TEMP DEFINED
  1409. SX7 LLSYSJP TO -SYSJP- IF SAME CALC
  1410. ZR X1,LABJUMPA JUMP IF LABEL IS IN SAME CALC
  1411. * /--- BLOCK LABJUMP2 00 000 77/01/09 21.39
  1412. * GENERATE SX0 TO COMMAND PART OF LABEL
  1413. RJ JPB3 NEXT INSTRUCTION
  1414. SX2 7105B SX0 B5+0*
  1415. SB2 1 TYPE = 1 (COMMAND PART)
  1416. SA3 LJTEMP
  1417. UX3,B1 X3 LABEL NUMBER
  1418. SB7 B1 SAVE IN B7
  1419. RJ CLABREF X0 WILL HOLD NEW VALUE FOR A5
  1420. * CHECK FOR FORWARDS BRANCH
  1421. SA1 LABADDR+B7 LOAD INFO FOR THIS LABEL
  1422. AX1 18 COMMAND PART OF LABEL
  1423. SX7 LLSYSNT TO -SYSJPNT- IF FORWARDS BRANCH
  1424. ZR X1,LABJUMPA JUMP IF LABEL IS NOT DEFINED
  1425. SX7 LLSYSA5 TO -SYSJPA5- IF BACKWARDS
  1426. LABJUMPA SA2 X7 GET CM ADDRESS
  1427. BX6 X2
  1428. SA6 LJTEMP2 SAVE IN LJTEMP2
  1429. LABJUMPB SA1 LJTEMP
  1430. MX0 -12
  1431. UX6 X1
  1432. BX1 -X0*X1 GET NEXT INSTRUCTION
  1433. LX1 18 POSITION
  1434. ZR X1,LABJUMP EXIT IF NO MORE INSTRUCTIONS
  1435. AX6 12 DISCARD CURRENT INSTRUCTION
  1436. SA6 A1 STORE NEW LJTEMP
  1437. SA2 LJTEMP2 CM LOCATION
  1438. BX7 X1+X2 COMBINE WITH OP CODE
  1439. RJ =XLONGI OUTPUT DESIRED INSTRUCTION
  1440. EQ LABJUMPB
  1441. *
  1442. LJTEMP BSS 1
  1443. LJTEMP2 BSS 1
  1444. *
  1445. EQ DATA 0400B EQ *
  1446. NGX1 DATA 0331B NG X1,*
  1447. PLX1ZRX1 DATA 03010321B PL X1,* ZR X1,*
  1448. *
  1449. * /--- BLOCK LABFIND 00 000 79/08/08 14.51
  1450. TITLE LABFIND -- RETURN INTERNAL NAME FOR LABEL HOLERITH
  1451. * -LABFIND-
  1452. *
  1453. * 'THIS ROUTINE SEARCHES THE LABEL TABLE
  1454. * FOR SPECIFIED NAME. 'IF NOT FOUND, IT ADDS
  1455. * THE NAME TO THE END OF THE TABLE. 'A ZERO
  1456. * NAME MEANS TO CREATE AN IMAGINARY LABEL.
  1457. *
  1458. * 'ON ENTRY --
  1459. * X1 = LABEL HOLERITH (ZERO IF CREATING IMAGINARY LABEL)
  1460. *
  1461. * 'ON EXIT --
  1462. * B1 = POSITION OF LABEL IN TABLE (INTERNAL NAME)
  1463. *
  1464. * 'THIS ROUTINE PRESERVES ALL 4, 5 AND 7 REGISTERS.
  1465. *
  1466. LABFIND DATA 0
  1467. SA2 NLABELS NUMBER OF LABELS NOW IN TABLE
  1468. MX0 42
  1469. BX6 X0*X1 GET TOP SEVEN CHARS ONLY
  1470. ZR X6,LABFINDB JUMP TO CREATE NEW LABEL
  1471. SB1 X2+0
  1472. LABFINDA LE B1,LABFINDB CREATE NEW LABEL IF NOT FOUND
  1473. SB1 B1-1
  1474. SA3 LABELS+B1 LOAD NEXT TABLE ENTRY
  1475. BX3 X3-X6 CHECK IF SAME
  1476. NZ X3,LABFINDA CONTINUE SEARCH IF NOT
  1477. EQ LABFIND EXIT IF NAME FOUND IN TABLE
  1478. LABFINDB SA3 TDEFER POINTER TO MOST RECENT DEFERRED TEMPORARY
  1479. IX3 X2-X3
  1480. SB1 X2 B1 = POSITION FOR NEXT ENTRY
  1481. PL X3,LABFULL ERROR IF TABLE IS FULL
  1482. SA6 LABELS+B1 STORE NEW LABEL NAME
  1483. MX6 0 ZERO LABEL ADDRESS WORD
  1484. SA6 LABADDR+B1 STORE ADDRESS
  1485. SX6 X2+1
  1486. SA6 NLABELS UPDATE NLABELS
  1487. EQ LABFIND
  1488. * /--- BLOCK LABDEF 00 000 76/08/31 02.14
  1489. TITLE LABDEF -- DEFINE LABEL FOR UNIT
  1490. * -LABDEF-
  1491. *
  1492. * 'ON ENTRY, B1 HOLDS THE NUMBER OF
  1493. * THE LABEL WHICH IS TO BE DEFINED.
  1494. * 'THIS LABEL BECOMES ASSOCIATED WITH THE
  1495. * 'N'E'X'T COMMAND THAT IS STORED IN THE UNIT.
  1496. * (-ICX- IS USED TO DETERMINE THIS.)
  1497. *
  1498. * 'IF A CALC IS ACTIVE (AS SHOWN BY -CALCACT-),
  1499. * -PAD- IS CALLED AND THE LABEL IS ALSO
  1500. * ASSOCIATED WITH THE NEXT WORD OF -INST- BUFFER.
  1501. * 'THE *TEMP* BIT IN THE LABEL TABLE IS SET
  1502. * AND THE ACTUAL LABEL DEFINITION IS DEFERRED
  1503. * UNTIL THE CALC IS COMPLETED.
  1504. *
  1505. * 'IF A CALC IS NOT ACTIVE, THE LABEL IS
  1506. * NOT ASSOCIATED WITH EXTRA STORAGE AND ITS
  1507. * DEFINITION IS DONE IMMEDIATELY.
  1508. *
  1509. * 'ON ENTRY, -B1-, -CALCACT-, AND -ICX- MUST
  1510. * BE SET PROPERLY AS DESCRIBED ABOVE.
  1511. *
  1512. * 'ON EXIT, B1 = 0 IF NO ERROR
  1513. * = -1 IF DUPLICATE LABEL
  1514. *
  1515. * 'THIS ROUTINE PRESERVES ALL 5 AND 7 REGISTERS.
  1516. *
  1517. LABDEF DATA 0
  1518. SA2 CALCACT X2 = CALCACT
  1519. * CHECK IF LABEL ALREADY DEFINED
  1520. SA1 LABADDR+B1 LOAD INFO FOR THE LABEL
  1521. BX0 X1
  1522. AX0 1 REMAINING BITS MUST BE ZERO
  1523. NZ X0,LABDUP JUMP IF DUPLICATE LABEL
  1524. SA4 ICX POINTER TO LAST COMMAND
  1525. SX4 X4-INFOLTH ZERO IF NO COMMANDS YET
  1526. SX4 X4-2 X4 IS MINUS TWO OR LESS
  1527. PL X2,LABDEFA JUMP IF NO CALC ACTIVE
  1528. * IF IN CALC, MUST STORE IN TEMPORARY TABLE
  1529. SB4 B1+0 PRESERVE B1
  1530. RJ PAD SAVES ALL 4, 5, AND 7 REGISTERS
  1531. SA1 NINST POINTER TO NEXT WORD OF -INST-
  1532. SX2 INST-1 WORD BEFORE FIRST INSTRUCTION
  1533. IX1 X1-X2 RELATIVE LABEL ADDRESS (+1)
  1534. BX2 -X4 X2 = COMMAND LABEL IS AT (+1)
  1535. SB1 B4 B1 = LABEL NUMBER
  1536. SB3 B0 B3 IS NOT USED
  1537. SB2 4 TYPE = 4
  1538. RJ CLABREF STORE IN TEMPORARY TABLE
  1539. SX6 1 MARK LABEL AS TEMP. DEFINED
  1540. LX6 18 POSITION TO TEMP DEFINE BIT
  1541. SA6 LABADDR+B4 SAVE TEMP DEFINE
  1542. SB1 0 MARK NO ERROR
  1543. EQ LABDEF
  1544. * IF NOT IN CALC, DEFINE LABEL IMMEDIATELY
  1545. LABDEFA LX4 18 POSITION COMMAND DISPLACEMENT
  1546. BX6 -X4 SAVE COMMAND DISPLACEMENT
  1547. SA6 LABADDR+B1 STORE NEW LABEL ADDRESS
  1548. SB1 0 MARK NO ERROR
  1549. EQ LABDEF
  1550. * /--- BLOCK LABDEF2 00 000 79/08/08 14.46
  1551. * DUPLICATE LABEL ENCOUNTERED
  1552. LABDUP BX6 X2
  1553. SA6 LABTEMP PRESERVE -CALCACT-
  1554. SA1 LABELS+B1 GET LABEL NAME
  1555. SX2 B0 SAVE UNIT NAME
  1556. SB2 0 SAVE BAD LINE
  1557. SB1 911 DUPLICATE UNIT MESSAGE
  1558. RJ =XRJERR2
  1559. SA1 LABTEMP RESTORE -CALCACT-, SINCE IT
  1560. BX6 X1 IS CLEARED BY -RJERR2-
  1561. SA6 CALCACT
  1562. SB1 -1 RETURN B1=-1 IF DUPLICATE LABEL
  1563. EQ LABDEF
  1564. * /--- BLOCK LABREF 00 000 77/05/06 00.13
  1565. TITLE LABRF -- PROCESS LABEL REFERENCE
  1566. * -LABRF-
  1567. *
  1568. * 'THE MAIN PURPOSE OF THIS ROUTINE
  1569. * IS TO PROCESS REFERENCES TO LABELS.
  1570. * 'IT ALSO HANDLES LABEL DEFINITIONS WHICH
  1571. * HAD TO BE DEFERRED BECAUSE THEY OCCURRED
  1572. * IN A CALC.
  1573. *
  1574. * ON ENTRY --
  1575. * B1 = LABEL NUMBER
  1576. * B2 = TYPE OF REFERENCE';
  1577. * 1 IF INSTRUCTION AND COMMAND PART OF LABEL
  1578. * 2 IF INSTRUCTION AND EXTRA STORAGE PART OF LABEL
  1579. * 3 IF 9 BIT COMMAND PART OF LABEL
  1580. * 4 IF TEMPORARY LABEL DEFINITION
  1581. * 5 IF BRANCH X
  1582. * B3 = SHIFT COUNT FOR POSITIONING NEW INFO
  1583. * (COUNT OF BITS TO THE RIGHT OF INFO
  1584. * THAT IS TO BE UPDATED)
  1585. * X1 = DISPLACEMENT IN INFO BUFFER OF WORD
  1586. * THAT NEEDS UPDATING
  1587. * X2 = EXTRA INFO DEPENDING ON TYPE';
  1588. * TYPE 1'; UPPER 12 BITS OF INSTRUCTION
  1589. * 2'; UPPER 12 BITS OF INSTRUCTION
  1590. * 3'; UNUSED
  1591. * 4'; COMMAND DISPLACEMENT (B3 IS UNUSED)
  1592. *
  1593. * ON EXIT --
  1594. * 'IF THE LABEL IS DEFINED THE REFERENCE
  1595. * IS UPDATED IMMEDIATELY. 'IF THE LABEL IS
  1596. * NOT DEFINED THE REFERENCE IS SAVED IN A
  1597. * DEFER BUFFER AND PROCESSED UPON COMPLETION
  1598. * OF THE UNIT.
  1599. *
  1600. * 'THIS ROUTINE PRESERVES ALL 5 AND 7 REGISTERS.
  1601. *
  1602. LABRF DATA 0
  1603. + LT B2,* SYSTEM ERROR IF B2 OUT-OF-RANGE
  1604. SB4 4
  1605. + GT B2,B4,*
  1606. JP *+B2 JUMP ON TYPE
  1607. EQ LABREF1 DO INDIVIDUALIZED PROCESSING
  1608. EQ LABREF2
  1609. EQ * LABREF3
  1610. EQ LABREF4
  1611. EQ * LABREF5
  1612. *
  1613. * TYPE = 1
  1614. * 30 BIT INSTRUCTION, ADDRESS PORTION
  1615. * IS SET TO THE COMMAND PART OF LABEL.
  1616. *
  1617. * B1 = LABEL NUMBER
  1618. * B3 = SHIFT COUNT TO POSITION INSTRUCTION
  1619. * X1 = DISPLACEMENT IN INFO BUFFER OF WORD
  1620. * THAT NEEDS UPDATING
  1621. * X2 = UPPER 12 BITS OF INSTRUCTION
  1622. LABREF1 SA3 LABADDR+B1 GET ENTRY FOR THIS LABEL
  1623. BX0 X3
  1624. AX0 19 DISCARD *TEMP DEFINED* BIT
  1625. ZR X0,LABREFD JUMP IF LABEL NOT YET DEFINED
  1626. MX6 -18
  1627. AX3 18 GET COMMAND PART OF LABEL (+1)
  1628. SX3 X3-1 FIRST COMMAND GIVES X0 = 1
  1629. BX3 -X3 COMMANDS GO BACKWARDS
  1630. BX0 -X6*X3 CLEAR TOP BITS
  1631. LX2 18 SHIFT UPPER BITS OF INSTRUCTION
  1632. BX2 X2+X0 COMBINE WITH ADDRESS PART
  1633. MX0 30 MASK FOR 30 BIT INSTRUCTION
  1634. LX0 30
  1635. EQ LABREFS GO TO STORE THE INFO
  1636. *
  1637. * /--- BLOCK LABREF2 00 000 79/08/08 12.28
  1638. *
  1639. * TYPE = 2
  1640. * 30 BIT INSTRUCTION, ADDRESS PORTION
  1641. * IS SET TO THE EXTRA STORAGE PART OF LABEL.
  1642. *
  1643. * B1 = LABEL NUMBER
  1644. * B3 = SHIFT COUNT TO POSITION INSTRUCTION
  1645. * X1 = DISPLACEMENT IN INFO BUFFER OF WORD
  1646. * THAT NEEDS UPDATING
  1647. * X2 = UPPER 12 BITS OF INSTRUCTION
  1648. *
  1649. * 'FOR NOW, IT IS ILLEGAL TO USE THIS TYPE
  1650. * WITH A LABEL WHICH HAS NO EXTRA STORAGE.
  1651. LABREF2 SA3 LABADDR+B1 GET INFO FOR THIS LABEL
  1652. BX0 X3
  1653. AX0 19 DISCARD *TEMP DEFINED* BIT
  1654. ZR X0,LABREFD JUMP IF LABEL NOT YET DEFINED
  1655. MX0 -18 LOWER 9 BITS HOLD X-STOR INFO
  1656. BX0 -X0*X3 GET EXTRA STORAGE POINTER (+1)
  1657. + ZR X0,* HANG IF LABEL NOT IN X-STOR
  1658. SX0 X0-1 LOWEST POSSIBLE VALUE IS ZERO
  1659. LX2 18 SHIFT UPPER BITS OF INSTRUCTION
  1660. BX2 X2+X0 COMBINE WITH ADDRESS BITS
  1661. MX0 30 SET MASK FOR 30 BIT INSTRUCTION
  1662. LX0 30
  1663. EQ LABREFS GO TO STORE THE INFO
  1664. *
  1665. * TYPE = 4
  1666. * 'LABEL OCCURRED INSIDE A CALC, AND
  1667. * HENCE WAS ONLY TEMPORARILY DEFINED. 'COME
  1668. * HERE TO DEFINE IT PERMANENTLY.
  1669. *
  1670. * B1 = LABEL NUMBER
  1671. * B3 = 0 (UNUSED)
  1672. * X1 = LOCATION OF LABEL IN EXTRA STORAGE (+1)
  1673. * X2 = LOCATION OF LABEL IN COMMAND STORAGE (+1)
  1674. LABREF4 LX2 18 POSITION COMMAND LABEL IS AT
  1675. BX6 X1+X2 ATTACH TO X-STOR DISPLACEMENT
  1676. SA6 LABADDR+B1 STORE DEFINED LABEL INFO
  1677. EQ LABRF EXIT
  1678. * /--- BLOCK LABREF3 00 000 80/03/20 11.35
  1679. *
  1680. * 'COME HERE IF LABEL IS UNDEFINED.
  1681. * 'THE REFERENCE IS PROCESSED WHEN THE UNIT
  1682. * IS COMPLETED.
  1683. LABREFD PX1 X1,B2 PACK REGISTERS INTO ONE WORD
  1684. PX2 X2,B3
  1685. LX1 12
  1686. LX2 36
  1687. BX6 X1+X2
  1688. PX6 X6,B1
  1689. SA3 NDEFERR CHECK IF STILL ROOM IN TABLE
  1690. SX3 X3+1
  1691. SX0 X3-DEFRLIM
  1692. PL X0,LABFULL JUMP IF -DEFERR- IS FULL
  1693. SA6 LDEFER-1+X3 SAVE TEMP LABEL
  1694. SX6 X3
  1695. SA6 A3 UPDATE TABLE POINTER
  1696. EQ LABRF
  1697. *
  1698. * 'COME HERE TO PROCESS THE LABEL REFERENCE
  1699. * X0 = MASK
  1700. * X1 = INFO WORD THAT NEEDS UPDATING
  1701. * X2 = NEW INFO
  1702. * B3 = SHIFT COUNT FOR INFO AND MASK
  1703. LABREFS LX0 X0,B3 POSITION MASK
  1704. LX2 X2,B3 POSITION NEW INFO
  1705. SA3 INFO+X1 WORD THAT NEEDS UPDATING
  1706. BX3 -X0*X3 CLEAR OLD INFO
  1707. BX6 X2+X3 INSERT NEW INFO
  1708. SA6 INFO+X1 STORE UPDATED WORD
  1709. EQ LABRF
  1710. *
  1711. LABTEMP BSS 1
  1712. *
  1713. * /--- BLOCK CLABREF 00 000 79/08/08 12.40
  1714. TITLE CLABREF -- SAVE LABEL REFERENCE IN TEMPORARY TABLE
  1715. * -CLABREF-
  1716. * 'THIS ROUTINE IS CALLED WHEN THE
  1717. * INSTRUCTION WHICH REFERENCES THE LABEL
  1718. * IS IN THE -INST- BUFFER. 'THE INFO IS
  1719. * STORED TEMPORARILY AT THE END OF THE
  1720. * LABEL TABLE AND PROCESSED WHEN -INST-
  1721. * IS MOVED INTO EXTRA STORAGE (SEE -TEMPREF-).
  1722. *
  1723. * 'ON ENTRY --
  1724. * 'ARGUMENTS ARE EXACTLY AS IN -LABREF-,
  1725. * 'E'X'C'E'P'T -- X1 HOLDS THE DISPLACEMENT INTO
  1726. * -INST-, NOT -INFO-.
  1727. *
  1728. * 'THIS ROUTINE PRESERVES ALL 5 AND 7 REGISTERS
  1729. * 'IT ALSO PRESERVES ALL INPUT ARGS. (B1,B2,B3,X1,X2)
  1730. *
  1731. CLABREF DATA 0
  1732. PX0 X1,B2 BEGIN PACKING REGISTERS
  1733. PX3 X2,B3
  1734. LX3 24
  1735. BX0 X0+X3
  1736. * CHECK IF STILL ROOM IN LABEL TABLE
  1737. SA3 TDEFER POINTER TO LAST TEMP ENTRY
  1738. SA4 NLABELS NUMBER OF LABEL NAMES
  1739. IX4 X4-X3
  1740. PL X4,LABFULL JUMP IF TABLE IS FULL
  1741. SX6 X3-1
  1742. SA6 A3 UPDATE -TDEFER-
  1743. LX0 12 FINISH PACKING REGISTERS
  1744. PX6 X0,B1
  1745. SA6 LABADDR-1+X3 STORE THE REFERENCE
  1746. EQ CLABREF
  1747. * FOR NOW, GIVE ',LONG UNIT', IF TABLE IS FULL
  1748. LABFULL EQ =XLNGUNIT
  1749. *
  1750. * /--- BLOCK TEMPREF 00 000 79/08/08 12.41
  1751. TITLE TEMPREF -- PROCESS THE TEMPORARY TABLE
  1752. * -TEMPREF-
  1753. *
  1754. * 'THIS ROUTINE IS CALLED UPON COMPLETION
  1755. * OF A CALC TO PROCESS THE DEFERRED REFERENCE
  1756. * ENTRIES THAT ARE SAVED TEMPORARILY AT THE
  1757. * END OF THE LABEL TABLE. 'THE MAIN REASON
  1758. * FOR THIS IS BECAUSE CODE IS GENERATED INTO
  1759. * THE -INST- BUFFER; WE DO NOT KNOW ITS
  1760. * LOCATION IN EXTRA STORAGE UNTIL THE CALC
  1761. * IS COMPLETED.
  1762. *
  1763. * 'ON ENTRY --
  1764. * B7 = DISPLACEMENT TO WHERE THE -INST-
  1765. * BUFFER WAS PUT IN EXTRA STORAGE.
  1766. *
  1767. * 'THIS ROUTINE PRESERVES A5,B5, AND X5
  1768. *
  1769. TEMPREF DATA 0
  1770. SA1 TDEFER POINTER TO LAST TEMP ENTRY
  1771. SX6 LABLIM LENGTH OF -LABELS-
  1772. SA6 A1 RESET -TDEFER- TO -LABLIM-
  1773. SX7 X1 X7 = POINTER TO NEXT ENTRY
  1774. TEMPREFL SB1 X7-LABLIM CHECK IF NO MORE TO DO
  1775. GE B1,TEMPREF
  1776. SA2 LABADDR+X7 LOAD NEXT ENTRY
  1777. UX2,B1 X2 B1 = LABEL NUMBER
  1778. MX0 -24
  1779. BX1 -X0*X2 LOWER 24 BITS TO X1
  1780. BX2 X0*X2
  1781. LX1 -12 X1 = POINTER INTO -INST- BUFFER
  1782. LX2 -36 X2 = OTHER INFO (DEPENDS ON TYPE)
  1783. UX1,B2 X1 B2 = TYPE OF TABLE ENTRY
  1784. UX2,B3 X2 B3 = SHIFT COUNT (FOR MOST TYPES)
  1785. SX1 X1+B7 UPDATE X1 TO POINT INTO X-STOR
  1786. RJ LABRF PROCESS ENTRY (SAVES B7 AND X7)
  1787. SX7 X7+1
  1788. EQ TEMPREFL
  1789. *
  1790. * /--- BLOCK JP B3 00 000 79/08/08 12.42
  1791. TITLE JPB3 -- COMPUTE POSITION OF NEXT INSTRUCTION
  1792. * -JPB3-
  1793. *
  1794. * 'THIS ROUTINE OUTPUTS A -JP B3- INSTRUCTION
  1795. * AND COMPUTES ITS POSITION IN THE -INST- BUFFER.
  1796. *
  1797. * 'ON 'EXIT --
  1798. * X1 = INST DISPLACEMENT TO WORD WITH THE -JP B3-
  1799. * B3 = SHIFT COUNT GIVING BIT POSITION OF -JP B3-
  1800. *
  1801. * 'THIS ROUTINE PRESERVES A5,B5, AND X5
  1802. *
  1803. JPB3 DATA 0
  1804. SX7 0233B JP B3+0
  1805. LX7 18
  1806. RJ LONGI
  1807. * FIGURE OUT WHERE THE INSTRUCTION WAS PUT
  1808. SA1 NINST
  1809. SX0 INST
  1810. SA2 X1 CURRENT INSTRUCTION WORD
  1811. IX1 X1-X0 DISPLACEMENT TO CURRENT WORD
  1812. ZR X2,JPB3C JUMP IF EMPTY
  1813. MX0 30
  1814. BX2 X0*X2 CHECK TOP 30 BITS
  1815. NZ X2,JPB3B JUMP IF ONLY 15 BITS LEFT
  1816. SB3 30 TOP HALF OF WORD
  1817. EQ JPB3
  1818. JPB3C SX1 X1-1 BACK UP TO PREVIOUS WORD
  1819. SB3 0 LOWER HALF OF WORD
  1820. EQ JPB3
  1821. JPB3B SB3 15 MIDDLE OF WORD
  1822. EQ JPB3
  1823. *
  1824. * /--- BLOCK SA5 JP B5 00 000 79/08/08 12.43
  1825. TITLE SA5JPB5 -- OLD WAY OF HANDLING DEFERRED REFERENCES
  1826. * -SA5JPB5-
  1827. *
  1828. * 'THIS ROUTINE SETS UP DEFERRED
  1829. * PROCESSING FOR A ',SA5 B5+(COMMAND
  1830. * DISPLACEMENT OF LABEL)', AND A
  1831. * ',JP B5+(X-STOR DISPLACEMENT OF LABEL)',
  1832. * 'IT IS USED BY ROUTINES WHICH WERE
  1833. * USING THE OLD DEFERRED REFERENCE STUFF.
  1834. *
  1835. * 'ON ENTRY --
  1836. * B1 = LABEL NUMBER
  1837. * X1 = INST DISPLACEMENT TO WORD WHICH
  1838. * IS TO BRANCH TO THE LABEL IN (B1).
  1839. *
  1840. * 'THIS ROUTINE PRESERVES ALL 5 AND 7 REGISTERS.
  1841. *
  1842. SA5JPB5 DATA 0
  1843. * CHECK IF LABEL IS DEFINED WITHIN THIS CALC
  1844. SA3 LABADDR+B1 LOAD INFO FOR THIS LABEL
  1845. AX3 18
  1846. SX3 X3-1 *1* MEANS TEMP DEFINED
  1847. SB3 30 SET FOR UPPER INSTRUCTION
  1848. ZR X3,SA5JPA JUMP IF LABEL IS IN THIS CALC
  1849. * PUT IN A *SA5* DEFERRED REFERENCE
  1850. SB2 1 TYPE = 1
  1851. SX2 5155B SA5 B5+* (UPPER 12 BITS)
  1852. RJ CLABREF STORE IN TEMP TABLE
  1853. SB3 0 SET FOR LOWER INSTRUCTION
  1854. * PUT IN A *JP B5* DEFERRED REFERENCE
  1855. SA5JPA SB2 2 TYPE = 2
  1856. SX2 0255B JP B5+* (UPPER 12 BITS)
  1857. RJ CLABREF STORE IN TEMP TABLE
  1858. EQ SA5JPB5
  1859. *
  1860. * /--- BLOCK END 00 000 79/08/08 12.43
  1861. *
  1862. END
plato.source/plaopl/calcs.txt ยท Last modified: 2021/02/06 16:21 by 127.0.0.1