projects / pdp8.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
A large commit.
[pdp8.git] / sw / src / pascal / PASCAL.PA
CommitLineData
81e70d48
PH		 1
2/ ############ ######### #########
3/ ############ ######### #########
4/ ### ### ### ### ### ###
5/ ### ### ### ### ### ###
6/ ### ### ### ### ###
7/ ### ### ### ### ###
8/ ############ ############### #########
9/ ############ ############### #########
10/ ### ### ### ###
11/ ### ### ### ###
12/ ### ### ### ### ###
13/ ### ### ### ### ###
14/ ### ### ### #########
15/ ### ### ### #########
16/
17/
18/ ######### ######### ###
19/ ######### ######### ###
20/ ### ### ### ### ###
21/ ### ### ### ### ###
22/ ### ### ### ###
23/ ### ### ### ###
24/ ### ############### ###
25/ ### ############### ###
26/ ### ### ### ###
27/ ### ### ### ###
28/ ### ### ### ### ###
29/ ### ### ### ### ###
30/ ######### ### ### ###############
31/ ######### ### ### ###############
32/
33/
34/ #########
35/ #########
36/ ### ###
37/ ### ###
38/ ###
39/ ###
40/ ######### ######### FROM N.WIRTH
41/ ######### ######### ETH - ZUERICH
42/ ###
43/ ###
44/ ### ###
45/ ### ###
46/ #########
47/ #########
48/
49/
50/IMPLEMENTED ON A PDP-8/E COMPUTER WITH 28K-WORDS OF MEMORY
51/BY
52/PROF. HEINZ STEGBAUER
53/HTL-MOEDLING, IN 1979
54
55EJECT P A S C A L - S
56VERSION=2
57
58/C O R E L A Y O U T :
59
60
61
62/FIELD 0 0000 - 5777 INTERPRETER
63/ 6000 - 6777 FILE- AND DEVICE BUFFERS
64/ 7000 - 7577 COMPILER (INSYMBOL, NEXTCH)
65/ 7600 - 7777 OS/8 - RESIDENT PART
66
67/FIELD 1 0000 - 7577 INTERMEDIATE CODE
68/ 7600 - 7777 OS/8 - RESIDENT PART
69
70/FIELD 2 0000 - 3777 SYMBOL-TABLE
71/ 4000 - XXXX STRING-TABLE
72/ XXXX - 6377 CONSTANT-TABLE
73/ 6400 - 7377 ARRAY-TABLE
74/ 7400 - 7777 BLOCK-TABLE
75
76
77
78/AT COMPILETIME:
79
80/FIELD 3 0000 - 3777 NAMES OF SYMBOL-TABLE
81/ 4000 - 7177 FSYS, SET-CONSTANTS, LISTS AND
82/ TABLES, ERROR ROUTINES
83
84/FIELD 4 0000 - 6377 COMPILER
85/ 6400 - 7777 AUXILIARY ROUTINES
86
87/FIELD 5 0000 - 7777 STACK FOR COMPILER OPERATION
88
89/FIELD 6 0000 - 7777 LONG ERROR MESSAGES
90
91
92
93/AT RUNTIME:
94
95/FIELD 3 0000 - 7777 /S T A C K (4K WORDS OF 48 BITS)
96/FIELD 4 0000 - 7777
97/FIELD 5 0000 - 7777
98/FIELD 6 0000 - 7777
99
100
101CODEFIELD=10
102TABLEFIELD=20
103NAMEFIELD=30
104SETFIELD=30
105COMPFIELD=40
106PUSHFIELD=50
107ERRFIELD=60
108STACKFIELD=30
109\f/S T R U C T U R E O F T A B L E S :
110
111/SYMBOL-TABLE (4 WORDS PER ENTRY, MAX. 512 ENTRIES)
112/------------
113
114TAB=0000
115
116LINK=TAB /WORD 0, BITS 0-11
117OBJ=TAB+1 /WORD 1, BITS 0-5
118TYP=TAB+1 /WORD 1, BITS 6-11
119REF=TAB+2 /WORD 2, BITS 0-5
120NORMAL=TAB+2 /WORD 2, BIT 6
121LEV=TAB+2 /WORD 2, BITS 7-11
122ADR=TAB+3 /WORD 3, BITS 0-11
123
124
125/STRING-TABLE (ARRAY[0:N] OF CHAR, 6 BITS/CHAR,FROM 4000 UPWARDS)
126/------------
127
128
129/CONSTANT-TABLE (4 WORDS PER ENTRY, FROM 6400 DOWNWARDS)
130/--------------
131
132
133/ARRAY-TABLE (8 WORDS PER ENTRY, MAX. 64 ENTRIES)
134/-----------
135
136ATAB=6400
137
138/ /WORD 0 UNUSED!
139INXTYP=ATAB+1 /WORD 1
140ELTYP=ATAB+2 /WORD 2
141ELREF=ATAB+3 /WORD 3
142LOW=ATAB+4 /WORD 4
143HIGH=ATAB+5 /WORD 5
144ELSIZE=ATAB+6 /WORD 6
145SIZE=ATAB+7 /WORD 7
146
147
148/BLOCK-TABLE (4 WORDS PER ENTRY, MAX. 64 ENTRIES)
149/-----------
150
151BTAB=7400
152
153LAST=BTAB /WORD 0
154LASTPAR=BTAB+1 /WORD 1
155PSIZE=BTAB+2 /WORD 2
156VSIZE=BTAB+3 /WORD 3
157\f/A S S E M B L E R D E F I N I T I O N S:
158
159L0001=CLA CLL IAC
160L0002=CLA STL RTL
161L0003=CLA STL IAC RAL
162L0004=CLA CLL IAC RTL
163L0006=CLA STL IAC RTL
164L0100=CLA CLL IAC BSW
165L2000=CLA STL RTR
166L4000=CLA STL RAR
167L7777=CLA CLL CMA
168L7776=CLA CLL CMA RAL
169L7775=CLA CLL CMA RTL
170L3777=CLA CLL CMA RAR
171L5777=CLA CLL CMA RTR
172\f/A R I T H M E T I C D E F I N I T I O N S:
173
174
175/MEMORY REFERENCED INSTRUCTIONS:
176
177FIXMRI GET=0000
178FIXMRI ADD=1000
179FIXMRI SUB=2000
180FIXMRI MUL=3000
181FIXMRI DIV=4000
182FIXMRI MOD=5000 /ALSO: JMP=5000
183FIXMRI PUT=6000
184
185
186
187/OPERATE CLASS INSTRUCTIONS:
188
189NORM=7200 /REAL
190READREAL=7201
191WRITEREAL=7202
192TRUNC=7203
193ROUND=7206
194RSQUARE=7205
195
196ZERO=7204 /BOTH TYPES
197ABSVAL=7000
198NEGATE=7004
199WRITELINE=7006
200
201READINTEGER=7001 /INTEGER
202WRITEINTEGER=7002
203FLOAT=7003
204ISQUARE=7005
205
206
207
208/SKIP - INSTRUCTIONS:
209
210SKIP=SKP
211SKEQ=SZA
212SKNE=SNA
213SKLT=SMA
214SKLE=SMA SZA
215SKGT=SPA SNA
216SKGE=SPA
217
218
219
220AAAAAA=JMS I 44 /ENTER MACRO MODE
221EEEEEE=0000 /RETURN TO PDP8 MODE
222
223INT=0177
224REAL=7777
225\f/C O M P I L E R D E F I N I T I O N S:
226DECIMAL
227/S Y M B O L S:
228
229INTCON=0
230REALCON=1
231CHARCON=2
232STRING=3
233NOTSY=4
234PLUS=5
235MINUS=6
236TIMES=7
237IDIVSY=8
238RDIVSY=9
239IMODSY=10
240ANDSY=11
241ORSY=12
242EQL=13
243NEQ=14
244GTR=15
245GEQ=16
246LSS=17
247LEQ=18
248LPARENT=19
249RPARENT=20
250LBRACK=21
251RBRACK=22
252COMMA=23
253SEMICOLON=24
254PERIOD=25
255COLON=26
256BECOMES=27
257CONSTSY=28
258TYPESY=29
259VARSY=30
260FUNCTIONSY=31
261PROCEDURESY=32
262ARRAYSY=33
263RECRDSY=34
264PROGRAMSY=35
265IDENT=36
266BEGINSY=37
267IFSYM=38
268CASESY=39
269REPTSY=40
270WHILSY=41
271FORSY=42
272ENDSY=43
273ELSESY=44
274UNTILSY=45
275OFSY=46
276DOSY=47
277TOSY=48
278DOWNTOSY=49
279THENSY=50
280
281/O B J E C T S:
282
283KONSTANT=0
284VARIABLE=1
285TYPE1=2
286PROZEDURE=3
287FUNKTION=4
288
289
290
291
292
293/T Y P E S:
294
295NOTYP=0
296INTS=1
297REALS=2
298BOOLS=3
299CHARS=4
300ARRAY=5
301RECORD=6
302
303
304
305
306
307/P R O C E D U R E S:
308
309BLOCK=0
310STATEMENT=1
311ASSIGNMENT=2
312COMPOUNDSTATEMENT=3
313IFSTATEMENT=4
314CASESTATEMENT=5
315REPEATSTATEMENT=6
316WHILESTATEMENT=7
317FORSTATEMENT=8
318STANDPROC=9
319SELECTOR=10
320CALL=11
321STANDFCT=12
322FACTOR=13
323TERM=14
324SIMPLEEXPRESSION=15
325EXPRESSION=16
326CONDECLARE=17
327TYPDECLARE=18
328VARDECLARE=19
329PRODECLARE=20
330CONSTANT=21
331ARRAYTYP=22
332TYPE=23
333PARAMETERLIST=24
334ONECASE=25
335
336
337/P R O G R A M P A R A M E T E R S:
338
339TMAX=512 /MAX. NUMBER OF IDENTIFIERS
340AMAX=64 /MAX. NUMBER OF ARRAYS
341BMAX=64 /MAX. NUMBER OF BLOCKS (PROCEDURES+RECORDS)
342CMAX=1980 /MAX. SIZE OF INTERMEDIATE CODE
343CSMAX=30 /MAX. NUMBER OF CASES
344LMAX=16 /MAX. NUMBER OF LEVELS
345LLNG=80 /MAX. LENGTH OF INPUT LINE
346ALNG=8 /NO. OF SIGNIFICANT CHAR'S IN IDENTIFIERS
347
348OCTAL
349\f FIELD 0
350/P A G E Z E R O :
351
352 *4
353EOF, 0 /END OF FILE SWITCH (BOOLEAN)
354EOLN, 1 /END OF LINE SWITCH ( - " - )
355CC, 0 /CHARACTER-COUNTER
356ERRSW, 0 /ERROR IN LINE SWITCH
357
358 *10
359XR10, 0 /ONE AUTOINDEX REGISTER
360
361 *20
362PC, 0 /P R O G R A M - C O U N T E R
363
364 /I N S T R U C T I O N - R E G I S T E R
365IRF, 0 /OP-CODE
366IRX, 0 /LEVEL
367IRY, 0 /ADDRESS OR VALUE
368
369 /S T A C K - P O I N T E R S
370B, 0 /BASE INDEX
371T, 0 /STACK POINTER (SIMPLE INDEX)
372T3, 0 /= 4*T + 3 (ADDRESS OF WORD 3)
373T3T, 0 /T3 FOR ROUTINE 'TOSTACK'
374LOOK, 240 /NEXT CHARACTER (LOOK AHEAD)
375
376/----------- PAGE 0 LOC'S OF ARITHMETIC PACKAGE ----------------
377 *32
378BCD, 0 /BINARY CODED DECIMAL DIGIT
379CHAR, 240 /CURRENT CHARACTER
380M, 22 /OUTPUT FORMAT PARAMETERS
381N, 0 /(DEFAULT VALUES: M=18, N=0)
382
383ACX, 0 / A C - R E G I S T E R
384ACS, 0
385AC0, 0
386AC1, 0
387AC2, 0
388AC3, 0
389
390 INTERPC /POINTER TO MACRO-INTERPRETER
391
392MQ1, 0 / M Q - R E G I S T E R
393MQ2, 0
394MQ3, 0
395
396OP0, 0 / O P - R E G I S T E R
397OP1, 0
398OP2, 0
399OP3, 0
400OPX, 0
401OPS, 0
402MIN4, -4 /-4 (COUNTING WORDS)
403MIN44, -44 /-36 (COUNTING BITS)
404OS8, 7600
405
406H1, 0 /4 GENERAL TEMPORARIES
407H2, 0
408H3, 0
409H4, 0
410
411/NEW INSTRUCTIONS USED ALSO BY ARITHMETIC PACKAGE:
412
413HALVE=JMS I . /AC:=AC DIV 2 (SHIFT RIGHT)
414 RACR
415DOUBLE=JMS I . /AC:=2*AC (SHIFT LEFT)
416 RACL
417CLEAR=JMS I . /AC := 0
418 CLAC
419LOAD=CLEAR /AC := CONTENTS OF ACCUMULATOR (12 BIT INT.)
420
421READC=JMS I . /GET NEXT CHAR FROM INPUT DEVICE
422PTREAD, XNEXTCH /XREAD AT RUNTIME
423PRINTC=JMS I . /SEND CHAR TO OUTPUT DEVICE
424PTPRINT,XPRINT
425ZPRINT, XPRINT /CONSTANT POINTER TO XPRINT
426CRLF=JMS I .
427 XCRLF
428SNALF=JMS I . /SKIP ON NOT ALFABETIC CHAR. (LETTER)
429 XSNALF
430SKDIG=JMS I . /SKIP ON DIGIT
431 XSKDIG
432BREAK=JMS I . /CHECK FOR CTRL-C
433 XBREAK
434HALT=JMS I . /RUN-TIME ERROR HANDLING
435PTHALT, ERR21 /XHALT AT RUNTIME
436/---------------------------------------------------------------
437
438
439/MACRO INSTRUCTIONS USED BY INTERPRETER:
440
441 *100
442ERROR=JMS I . /NON FATAL COMPILER ERRORS
443 ZERROR
444FATAL=JMS I . /FATAL COMPILER ERRORS
445 ZFATAL
446OFTAB=JMS I . /GET INFO FROM SYMBOL-TABLE
447 ZOFTAB
448OFATAB=JMS I . /GET INFO FROM ARRAY-TABLE
449 ZOFATAB
450OFBTAB=JMS I . /GET INFO FROM BLOCK-TABLE
451 ZOFTAB
452OFDISPLAY=JMS I . /GET INFO FROM DISPLAY
453 ZOFDISP
454TODISPLAY=JMS I . /PUT INFO INTO DISPLAY
455 ZTODISP
456GETCONST=JMS I . /GET CONSTANT
457 ZOFCONST
458CONTINUE=JMP I .
459 ILOOP
460BUMP=JMS I . /MOVE STACK POINTER
461 XBUMP
462
463SDF=JMS . /CHANGE TO TOP OF STACK - DATA FIELD
464 0
465XSDF, CDF /VARIABLE!
466 JMP I .-2
467
468POPONE=JMS I . /POP ONE WORD (WORD 3 INTO AC)
469 XPOPONE
470POPVAL=JMS I . /POP FOUR WORDS
471 XPOPVAL
472POPNUM=JMS I . /POP NUMBER (=POP 4 WORDS AND UNPACK)
473 XPOPNUM
474PUSHONE=JMS I . /PUSH ONE WORD
475 XPUSHONE
476PUSHVAL=JMS I . /PUSH FOUR WORDS
477 XPUSHVAL
478PUSHNUM=JMS I . /PUSH NUMBER (= PACK + PUSHVAL
479 XPUSHNUM
480TOSTACK=JMS I . /INSERT ONE WORD INTO STACK[T3T]
481 XTOSTACK
482OFCODE=JMS I . /GET INTERMEDIATE INSTRUCTION
483 XOFCODE
484
485/LOCATIONS USED BY I/O-FILE HANDLING:
486
487IBUFFER=6000 /INPUT FILE BUFFER
488OBUFFER=7000 /OUTPUT FILE BUFFER
489IDEVBUF=6400 /PAGE OF INPUT DEVICE HANDLER
490ODEVBUF=6600 /PAGE OF OUTPUT DEVICE HANDLER
491
492IDEVH, 0 /ENTRY POINT OF INPUT DEVICE HANDLER
493ODEVH, 0 /ENTRY POINT OF OUTPUT DEVICE HANDLER
494NAME, ZBLOCK 4 /NAME OF OUTPUT FILE
495DEVNO, 0 /OUTPUT DEVICE NUMBER
496LEMPTY, 0 / -LENGTH OF EMPTY
497MBLOCKS,0 /COUNTING WRITTEN BLOCKS
498OBP, OBUFFER /BUFFER POINTER (SEE PUTC)
499OC3, -3 /3-CHARACTER SWITCH (SEE PUTC)
500
501I37, DCA CHAR /HALT PROGRAM - CLOSE OUTPUT FILE
502 TAD [232 /WRITE EOF-MARK
503 PRINTC /FILL REST OF BUFFER WITH ZEROES
504 TAD [OBUFFER
505 CIA
506 TAD OBP
507 SZA CLA
508 JMP .-5
509 L7777 /COMPUTE ACTUAL LENGTH
510 TAD LEMPTY /OF OUTPUT FILE
511 CIA
512 TAD MBLOCKS
513 DCA ALOF
514 CIF 10
515 TAD DEVNO
516 JMS I [7700 /CALL USR TO CLOSE OUTPUT FILE
517 4
518 NAME
519ALOF, 0
520ERRORD, HALT
521 JMP I OS8 /RETURN TO KEYBOARD MONITOR
522\f/INSTRUCTION DECODER AND DISPATCH ROUTINE
523
524 *200
525ISTART, CLA CLL /STARTING ADDRESS
526 DCA EOF
527 L0001
528 DCA EOLN
529 TAD [240
530 DCA CHAR
531 TAD [240
532 DCA LOOK
533 CLEAR
534 DCA T /INITIALIZE THE STACK:
535 BUMP
536 PUSHVAL /S[1].I := 0
537 BUMP
538 PUSHVAL /S[2].I := 0
539 BUMP
540 PUSHVAL /S[3].I := 0
541 BUMP
542 L0001
543 OFBTAB;LAST
544 DCA H4
545 TAD H4
546 PUSHONE /S[4].I := BTAB[1].LAST
547 DCA B /B := 0
548 L0001
549 DCA IRX
550 TODISPLAY /DISPLAY[1] := 0
551 L0002
552 OFBTAB;VSIZE
553 TAD MIN2
554 DCA T
555 BUMP /T := BTAB[2].VSIZE - 1
556 TAD H4
557 OFTAB;ADR
558 DCA PC /PC := TAB[ S[4].I ].ADR
559
560ILOOP, BREAK
561 CLL /GET CURRENT INSTRUCTION
562 TAD PC
563 OFCODE
564 MQL
565 MQA
566 BSW
567 AND [77
568 DCA IRF
569 MQA
570 AND [77
571 DCA IRX
572 STL
573 TAD PC
574 OFCODE
575 DCA IRY
576 ISZ PC /PC := PC + 1
577
578 TAD JUMP
579 TAD IRF
580 DCA .+1
581 HLT /JUMP TO INSTRUCTION ROUTINE
582JUMP, JMP I ILIST
583MIN2, -2
584\f/INSTRUCTIONS OF STACK COMPUTER - ADDRESS TABLE:
585
586ILIST, I00 /LOAD ADDRESS
587 I01 /LOAD VALUE
588 I02 /LOAD INDIRECT
589 I03 /UPDATE DISPLAY
590 ZBLOCK 4 /CODES 4 - 7 UNUSED!
591 I08 /CALL STANDERD FUNCTION
592 I09 /OFFSET
593 I10 /JUMP
594 I11 /CONDITIONAL JUMP
595 I12 /SWITCH CASE
596 ILOOP /CODE 13 USED INTERNALLY!
597 I14 /FOR1UP
598 I15 /FOR2UP
599 I16 /FOR1DOWN
600 I17 /FOR2DOWN
601 I18 /MARK STACK
602 I19 /CALL
603 I20 /INDEX1
604 I21 /INDEX
605 I22 /LOAD BLOCK
606 I23 /COPY BLOCK
607 I24 /LITERAL
608 I25 /LOAD CONSTANT
609 I26 /FLOAT
610 I27 /READ
611 I28 /WRITE STRING
612 I29 /WRITE1 (DEFAULT FIELD WIDTH)
613 I30 /WRITE2 ( :M )
614 I31 /WRITE3 ( :M :N )
615 I32 /EXIT PROCEDURE
616 I33 /EXIT FUNCTION
617 I34 /LOAD ABSOLUTE
618 I35 /LOGICAL NOT
619 I36 /NEGATE
620PTI37, 7600 /HALT (BECOMES I37 IF FILE I/O!)
621 I38 /STORE
622 ZBLOCK 11 /CODES 39 - 47 UNUSED!
623 I48 /ARITHMETIC OPERATIONS
624 I49 /COMPARE INTEGERS
625 I50 /COMPARE REALS
626 I51 /LOGICAL OR
627 I52 /LOGICAL AND
628 ZBLOCK 10 /CODES 53 - 60 UNUSED!
629 I61 /ASCII
630 I62 /READLN
631 I63 /WRITELN
632
633\f/INSTRUCTIONS OF STACK COMPUTER (A)
634
635I00, BUMP /LOAD ADDRESS
636 OFDISPLAY
637 TAD IRY
638 PUSHONE
639 CONTINUE
640
641I01, BUMP /LOAD VALUE
642 OFDISPLAY
643 TAD IRY
644 POPVAL
645 PUSHVAL
646 CONTINUE
647
648I02, BUMP /LOAD INDIRECT
649 OFDISPLAY
650 TAD IRY
651 POPONE
652 POPVAL
653 PUSHVAL
654 CONTINUE
655
656I03, TAD IRX /UPDATE DISPLAY
657 CIA
658 TAD IRY
659 DCA H1
660 TAD B
661 DCA H3
662UPDIS, TAD H3
663 TODISPLAY
664 L7777
665 TAD IRX
666 DCA IRX
667 L0002
668 TAD H3
669 POPONE
670 DCA H3
671 ISZ H1
672 JMP UPDIS
673 CONTINUE
674
675I08, TAD IRY /CALL STANDARD FUNCTION
676 TAD (JMS I STDFUNCT
677 DCA .+2
678 POPNUM
679STFJMS, JMS . / J M S TO REQUESTED FUNCTION
680 PUSHNUM
681 CONTINUE
682
683STDFUNCT,XABS /0
684 XABS /1
685 XISQU /2
686 XRSQU /3
687 XODD /4
688 XCHR /5
689 STFJMS /6
690 XSUCC /7
691 XPRED /8
692 XROUND /9
693 RTRUNC /10
694 XSIN /11
695 XCOS /12
696 XEXP /13
697 XLOG /14
698 XSQRT /15
699 XATN /16
700 XEOF /17
701 XEOLN /18
702 XRAND /19
703
704I09, POPONE /OFFSET
705 TAD IRY
706 PUSHONE
707 CONTINUE
708
709I10, TAD IRY /JUMP
710 DCA PC
711 CONTINUE
712
713I11, POPONE /CONDITIONAL JUMP
714 CLL RAR
715 TAD IRY
716 SNL
717 DCA PC
718 L7777
719 BUMP
720 CONTINUE
721
722I12, POPVAL /SWITCH CASE
723 L4000
724 AND AC1
725 CLL RAL
726 TAD AC3
727 SZL
728 CIA
729 DCA H1
730 L7777
731 BUMP
732SCASE, CLL
733 TAD IRY
734 OFCODE
735 TAD (-1500 /-1300
736 SZA CLA
737ERRORC, HALT /C A S E E R R O R !
738 STL
739 TAD IRY
740 OFCODE
741 CIA
742 TAD H1
743 SNA CLA
744 JMP .+4
745 ISZ IRY
746 ISZ IRY /(INCREMENTS, DOESN'T SKIP!)
747 JMP SCASE
748 IAC STL
749 TAD IRY
750 OFCODE
751 DCA PC
752 CONTINUE
753
754/I13 ... INTERNAL CODE (MARKS CASE SWITCH LIST)
755
756
757XEOF, 0
758 TAD EOF
759 JMP .+3
760XEOLN, 0
761 TAD EOLN
762 LOAD
763 BUMP
764 JMP STFJMS+1
765
766XSUCC, 0
767 L0001
768 JMP XCHR+1
769XPRED, 0
770 L7777
771 JMP XCHR+1
772XCHR, 0
773 TAD AC3
774 AND [77
775 LOAD
776 JMP STFJMS+1
777
778 PAGE
779\f/INSTRUCTIONS OF STACK COMPUTER (B+C)
780
781I14, TAD UPSKIP /FOR1UP
782 SKP
783I16, TAD DOSKIP /FOR1DOWN
784 DCA FORUD1
785 L7777 /COMMON ROUTINE:
786 TAD T
787 POPNUM
788 AAAAAAAAAAAAAAAA
789 PUT INT&FORH1
790 EEEEEEEEEEEEEEEE
791 POPNUM
792 AAAAAAAAAAAAAAAA
793 SUB INT&FORH1
794FORUD1, SKGE /OR SKLE
795 JMP FOR1EX
796 GET INT&FORH1
797 EEEEEEEEEEEEEEEE
798 L7776
799 TAD T
800 POPONE
801 PUSHNUM
802 CONTINUE
803
804FOR1EX, EEEEEEEEEEEEEEEE
805 TAD IRY
806 DCA PC
807 L7775
808 BUMP
809 CONTINUE
810
811/NOTE THE STACK SITUATION:
812/
813/ S[ T ] ... FINAL VALUE
814/ S[T-1] ... INITIAL VALUE
815/ S[T-2] ... ADDRESS OF CONTROL VARIABLE
816
817I15, TAD UPADD /FOR2UP
818 DCA FORUD2
819 TAD UPSKIP
820 JMP .+4
821I17, TAD DOSUB /FOR2DOWN
822 DCA FORUD2
823 TAD DOSKIP
824 DCA FORUD3
825 L7776 /COMMON ROUTINE:
826 TAD T
827 POPONE
828 DCA H2
829 TAD H2
830 POPNUM
831 AAAAAAAAAAAAAAAA
832FORUD2, ADD INT&ONE /OR SUB INT&ONE
833 PUT INT&FORH1
834 EEEEEEEEEEEEEEEE
835 POPNUM
836 AAAAAAAAAAAAAAAA
837 SUB INT&FORH1
838FORUD3, SKGE /OR SKLE
839 JMP FOR2EX
840 GET INT&FORH1
841 EEEEEEEEEEEEEEEE
842 TAD H2
843 PUSHNUM
844 TAD IRY
845 DCA PC
846 CONTINUE
847
848FOR2EX, EEEEEEEEEEEEEEEE
849 L7775
850 BUMP
851 CONTINUE
852
853UPSKIP, SKGE
854DOSKIP, SKLE
855UPADD, ADD INT&ONE
856DOSUB, SUB INT&ONE
857
858ONE, 0;0;0;1
859FORH1, ZBLOCK 4
860MINUS1, -1
861BYTE, 77
862LEVBITS,17
863
864I18, L0004 /MARK STACK
865 BUMP
866 TAD IRY
867 OFTAB;REF
868 BSW
869 AND BYTE
870 OFTAB;VSIZE
871 TAD MINUS1
872 PUSHONE
873 BUMP
874 TAD IRY
875 PUSHONE
876 CONTINUE
877
878I19, TAD IRY /CALL
879 CIA
880 TAD T
881 DCA H1
882 L0004
883 TAD H1
884 POPONE
885 DCA H2
886 TAD H2
887 OFTAB;LEV
888 AND LEVBITS
889 DCA H3
890 L0001
891 TAD H3
892 DCA IRX
893 TAD H1
894 TODISPLAY
895 L0003
896 TAD H1
897 POPONE
898 TAD H1
899 DCA H4
900 L0001
901 TAD H1
902 DCA T3T
903 TAD PC
904 TOSTACK
905 ISZ T3T
906 TAD H3
907 DCA IRX
908 OFDISPLAY
909 TOSTACK
910 ISZ T3T
911 TAD B
912 TOSTACK
913/-------------------- FALL THROUGH PAGE BOUNDARY -------------
914 CLEAR
915 TAD T
916 CMA CLL
917 TAD H4
918 SNL CLA
919 JMP .+4
920 BUMP
921 PUSHVAL
922 JMP .-7
923 TAD H1
924 DCA B
925 TAD H2
926 OFTAB;ADR
927 DCA PC
928 CONTINUE
929
930I20, TAD (NOP /INDEX1
931 SKP
932I21, TAD (JMS MULTY /INDEX
933 DCA INDEX1
934 TAD IRY /COMMON ROUTINE:
935 OFATAB;HIGH
936 CMA
937 DCA H1
938 TAD IRY
939 OFATAB;LOW
940 TAD H1
941 CIA
942 DCA H2
943 POPVAL
944 L4000
945 AND AC1
946 CLL RAL
947 TAD AC3
948 SZL
949 CIA
950 TAD H1
951 CLL
952 TAD H2
953 DCA RELADR
954 SNL
955ERRORB, HALT /INDEX OUT OF BOUNDS!
956INDEX1, NOP /OR JMS MULTY
957 L7777
958 BUMP
959 POPONE
960 TAD RELADR
961 PUSHONE
962 CONTINUE
963
964RELADR=H4
965
966MULTY, 0
967 TAD IRY
968 OFATAB;ELSIZE
969 CLL RAR
970 MQL
971 TAD (-14 /-12 (BITS)
972 DCA H3
973MBIT, SNL
974 JMP .+3
975 CLL
976 TAD RELADR
977 RAR
978 SWP
979 RAR
980 SWP
981 ISZ H3
982 JMP MBIT
983 SWP
984 DCA RELADR
985 JMP I MULTY
986
987I22, POPONE /LOAD BLOCK
988 DCA H1
989 L7777
990 BUMP
991 TAD IRY
992 CMA
993 DCA H2
994 JMP .+6
995 BUMP
996 TAD H1
997 POPVAL
998 PUSHVAL
999 ISZ H1
1000 ISZ H2
1001 JMP .-6
1002 CONTINUE
1003
1004I23, L7777 /COPY BLOCK
1005 TAD T
1006 POPONE
1007 DCA H1
1008 POPONE
1009 DCA H2
1010 TAD IRY
1011 CMA
1012 DCA H3
1013 JMP .+7
1014 TAD H2
1015 POPVAL
1016 TAD H1
1017 PUSHVAL
1018 ISZ H1
1019 ISZ H2
1020 ISZ H3
1021 JMP .-7
1022 L7776
1023 BUMP
1024 CONTINUE
1025
1026I24, BUMP /LITERAL (ADDRESSES ONLY!)
1027 TAD IRY
1028 LOAD
1029 PUSHVAL
1030 CONTINUE
1031
1032I25, BUMP /LOAD CONSTANT
1033 TAD IRY
1034 GETCONSTANT
1035 PUSHVAL
1036 CONTINUE
1037I61, POPONE /WRITE SPECIAL ASCII
1038 PRINTC
1039 L7777
1040 BUMP
1041 CONTINUE
1042
1043
1044 PAGE
1045\f/INSTRUCTIONS OF STACK COMPUTER (D)
1046
1047I26, TAD IRY /FLOAT
1048 CIA
1049 TAD T
1050 DCA H1
1051 TAD H1
1052 POPNUM
1053 JMS IFLOAT
1054 TAD H1
1055 PUSHNUM
1056 CONTINUE
1057
1058I27, TAD (JMS I READX-1 /READ
1059 TAD IRY
1060 DCA .+1
1061 JMS I READX
1062 POPONE
1063 PUSHNUM
1064 JMP EXI27
1065
1066READX, IINP
1067 RINP
1068 NOP
1069 CINP
1070
1071I28, POPONE /WRITE STRING
1072 DCA M
1073 L7777
1074 BUMP
1075 POPONE
1076 CIA
1077 DCA N
1078 TAD IRY
1079 CDF TABLEFIELD
1080 JMS WSTRING
1081 JMP EXI27
1082
1083I29, TAD (TAD DFW-1 /WRITE (STANDARD FIELD WIDTH)
1084 TAD IRY
1085 DCA .+1
1086 TAD DFW
1087 DCA M
1088 JMP WRGO
1089
1090I30, POPONE /WRITE (SPECIFIED FIELD WIDTH)
1091 DCA M
1092 L7777
1093 BUMP
1094WRGO, POPNUM
1095 L7777
1096 BUMP
1097 DCA N
1098 TAD (JMS I WRITEX-1
1099 TAD IRY
1100 DCA .+1
1101 JMS I WRITEX
1102 CONTINUE
1103
1104WRITEX, IOUT
1105 ROUT
1106 BOUT
1107 COUT
1108
1109DFW, 12
1110 22
1111 12
1112 1
1113
1114I31, POPONE /WRITE ( X :M :N )
1115 DCA N
1116 L7777
1117 BUMP
1118 POPONE
1119 DCA M
1120 L7777
1121 BUMP
1122 POPNUM
1123 JMS I WRITEX+1 /REAL ONLY!
1124EXI27, L7777
1125 BUMP
1126 CONTINUE
1127I32, L7776 /EXIT PROCEDURE
1128 SKP
1129I33, L7777 /EXIT FUNCTION
1130 TAD B
1131 DCA T
1132 BUMP
1133 L0001
1134 TAD B
1135 POPONE
1136 DCA PC
1137 L0003
1138 TAD B
1139 POPONE
1140 DCA B
1141 CONTINUE
1142
1143I34, POPONE /LOAD (ABSOLUTE)
1144 POPVAL
1145 PUSHVAL
1146 CONTINUE
1147
1148I35, POPONE /LOGICAL NOT
1149 CLL RAR
1150 CML
1151 RAL
1152 PUSHONE
1153 CONTINUE
1154
1155I36, POPNUM /NEGATE
1156 JMS XNEG
1157 PUSHNUM
1158 CONTINUE
1159
1160I38, POPVAL /STORE
1161 L7777
1162 BUMP
1163 POPONE
1164 PUSHVAL
1165 L7777
1166 BUMP
1167 CONTINUE
1168
1169/I39 - I47 U N U S E D !
1170
1171
1172/B O O L E A N O U T P U T
1173
1174BOUT, 0
1175 TAD AC3
1176 TAD (-5
1177 DCA N
1178 TAD AC3
1179 SNA CLA
1180 L0004
1181 TAD (TRUEFALSE^2
1182 JMS WSTRING
1183 JMP I BOUT
1184
1185 PAGE
1186\f/INSTRUCTIONS OF STACK COMPUTER (E)
1187
1188I48, POPNUM /ARITHMETIC:
1189 JMS ENTR /INTEGER:
1190 L7777 / + 48,1
1191 BUMP / - 48,2
1192 POPNUM / * 48,3
1193 TAD (MRITABL / DIV 48,4
1194 TAD IRY / MOD 48,5
1195 DCA H1
1196 TAD I H1 /REAL:
1197 DCA H1 / + 48,10
1198 JMS I H1 / - 48,11
1199 PUSHNUM / * 48,12
1200 CONTINUE / / 48,13
1201
1202I49, TAD (ISUB-RSUB /COMPARE (INTEGER)
1203I50, TAD (RSUB /COMPARE (REAL)
1204 DCA H1 / = 50,7440
1205 POPNUM / <> 50,7450
1206 JMS ENTR / < 50,7500
1207 L7777 / <= 50,7540
1208 BUMP / > 50,7550
1209 POPNUM / >= 50,7510
1210 JMS I H1 /SUBTRACT
1211 TAD IRY
1212 JMS BOOL
1213 LOAD
1214 PUSHVAL
1215 CONTINUE
1216
1217I51, POPONE /LOGICAL OR
1218 DCA H1
1219 L7777
1220 BUMP
1221 SDF
1222 TAD H1
1223 CMA
1224 AND I T3
1225 TAD H1
1226 DCA I T3
1227 CDF
1228 CONTINUE
1229
1230I52, POPONE /LOGICAL AND
1231 DCA H1
1232 L7777
1233 BUMP
1234 SDF
1235 TAD H1
1236 AND I T3
1237 DCA I T3
1238 CDF
1239 CONTINUE
1240
1241/I53 - I61 U N U S E D !
1242
1243 READC
1244I62, TAD EOLN /READLN
1245 SNA CLA
1246 JMP .-3
1247 READC
1248 CONTINUE
1249
1250I63, CRLF /WRITELN
1251 CONTINUE
1252\f/AUXILIARY ROUTINES FOR 'WRITE STRING' AND 'BOOLEAN OUTPUT'
1253
1254WSTRING,0
1255 DCA H1
1256 RDF
1257 TAD CCDF0
1258 DCA STRFLD
1259CCDF0, CDF 0
1260 TAD M
1261 SNA
1262 JMP NCHAR
1263 TAD N /M-N
1264 SPA SNA
1265 JMP PARTLY
1266 CIA
1267 DCA H2
1268 TAD [240
1269 PRINTC
1270 ISZ H2
1271 JMP .-3
1272 JMP NCHAR
1273PARTLY, CIA / N-M
1274 TAD N /-N
1275 DCA N /= -M
1276NCHAR, TAD H1
1277 STL RAR /STRING TABLE STARTS AT 4000!
1278 DCA H2
1279STRFLD, CDF TABLEFIELD
1280 TAD I H2
1281 CDF 0
1282 SNL
1283 BSW
1284 JMS ASCII
1285 ISZ H1
1286 ISZ N
1287 JMP NCHAR
1288 JMP I WSTRING
1289
1290ASCII, 0
1291 AND [77
1292 TAD [240
1293 AND [77
1294 TAD [240
1295 PRINTC
1296 JMP I ASCII
1297\f/C H A R A C T E R I N P U T AND O U T P U T
1298
1299
1300CINP, 0
1301 READC
1302 TAD CHAR
1303 AND [77
1304 LOAD
1305 JMP I CINP
1306
1307COUT, 0
1308 TAD M
1309 SPA SNA
1310 L0001
1311 CIA
1312 DCA H2
1313 JMP .+3
1314 TAD [240
1315 PRINTC
1316 ISZ H2
1317 JMP .-3
1318 TAD AC3
1319 JMS ASCII
1320 JMP I COUT
1321
1322 PAGE
1323\f/STACK INSTRUCTIONS
1324
1325XBUMP, 0
1326 SNA /IF (AC)=0
1327 L0001 /THEN T:=T+1
1328 CLL /ELSE T:=T+(AC)
1329 SPA
1330 CML
1331 TAD T
1332 DCA T
1333 SZL
1334ERRORA, HALT /S T A C K O V E R F L O W !
1335 TAD T
1336 CLL RAR
1337 BSW
1338 AND (70
1339 TAD (CDF STACKFIELD
1340 DCA XSDF /SETUP CHANGE TO STACK FIELD INSTR.
1341 TAD T /AND BUILD
1342 STL RAL
1343 STL RAL
1344 DCA T3 /ADDRESS OF TOP ENTRY (LS WORD)
1345 JMP I XBUMP
1346
1347ST3,
1348ADDRESS,0 /COMPUTE FULL ADDRESS
1349 MQL /OF STACK LOCATION
1350 MQA /AND CHANGE DATA FIELD
1351 CLL RAR
1352 BSW
1353 AND (70
1354 TAD (CDF STACKFIELD
1355 DCA STCDF
1356 MQA
1357 STL RAL
1358 STL RAL
1359STCDF, CDF STACKFIELD
1360 JMP I ADDRESS
1361
1362PACK, 0 /PACK REAL OR INTEGER NUMBER
1363 TAD ACX /INTO AC0-4 (FOR PUSHING)
1364 DCA AC0
1365 TAD ACS
1366 TAD AC1
1367 DCA AC1
1368 JMP I PACK
1369
1370UNPACK, 0 /UNPACK POPPED NUMBER
1371 L4000 /(EXTRACT SIGN, EXPONENT)
1372 AND AC1
1373 DCA ACS
1374 L3777
1375 AND AC1
1376 DCA AC1
1377 TAD AC0
1378 DCA ACX
1379 DCA AC0
1380 JMP I UNPACK
1381
1382XPOPONE,0
1383 SNA
1384 JMP TOPONE
1385 JMS ADDRESS
1386 DCA ST3
1387 TAD I ST3
1388 CDF
1389 JMP I XPOPONE
1390TOPONE, SDF
1391 TAD I T3
1392 CDF
1393 JMP I XPOPONE
1394
1395XPUSHONE,0
1396 SDF
1397 DCA I T3
1398 CDF
1399 JMP I XPUSHONE
1400
1401XPOPVAL,0
1402 SNA
1403 JMP TOPVAL
1404 JMS ADDRESS
1405 TAD MIN4
1406 DCA XR10
1407 TAD I XR10
1408 DCA AC0
1409 TAD I XR10
1410 DCA AC1
1411 TAD I XR10
1412 DCA AC2
1413 TAD I XR10
1414 DCA AC3
1415 CDF
1416 JMP I XPOPVAL
1417TOPVAL, TAD T3
1418 SDF
1419 JMP XPOPVAL+4
1420
1421XPUSHVAL,0
1422 SNA
1423 JMP ONTOP
1424 JMS ADDRESS
1425 TAD MIN4
1426 DCA XR10
1427 TAD AC0
1428 DCA I XR10
1429 TAD AC1
1430 DCA I XR10
1431 TAD AC2
1432 DCA I XR10
1433 TAD AC3
1434 DCA I XR10
1435 CDF
1436 JMP I XPUSHVAL
1437ONTOP, TAD T3
1438 SDF
1439 JMP XPUSHVAL+4
1440
1441XPOPNUM,0
1442 JMS XPOPVAL
1443 JMS UNPACK
1444 JMP I XPOPNUM
1445
1446XPUSHNUM,0
1447 MQL
1448 JMS PACK
1449 MQA
1450 JMS XPUSHVAL
1451 JMP I XPUSHNUM
1452
1453XTOSTACK,0
1454 DCA PACK /TEMP. SAVE VALUE
1455 TAD T3T
1456 JMS ADDRESS
1457 DCA ST3
1458 TAD PACK
1459 DCA I ST3
1460 CDF
1461 JMP I XTOSTACK
1462
1463 PAGE
1464\f/TABLE INSTRUCTIONS
1465
1466ZOFTAB, / AC := TAB[ AC ].REF
1467ZOFBTAB,0 / AC := BTAB[ AC ].REF
1468 CLL RTL
1469 TAD I ZOFTAB /SELECTOR FOLLOWS CALL
1470 DCA LOC
1471 ISZ ZOFTAB
1472 CDF TABLEFIELD
1473 TAD I LOC
1474 CDF
1475 JMP I ZOFTAB
1476
1477ZOFATAB,0 / AC := ATAB[ AC ].REF
1478 CLL RAL
1479 CLL RTL
1480 TAD I ZOFATAB /SELECTOR FOLLOWS CALL
1481 DCA LOC
1482 ISZ ZOFATAB
1483 CDF TABLEFIELD
1484 TAD I LOC
1485 CDF
1486 JMP I ZOFATAB
1487
1488ZOFDISP,0 / AC := DISPLAY[ IRX ]
1489 TAD (DISPLAY
1490 TAD IRX
1491 DCA LOC
1492 TAD I LOC
1493 JMP I ZOFDISP
1494
1495ZTODISP,0 / DISPLAY[ IRX ] := AC
1496 MQL
1497 TAD (DISPLAY
1498 TAD IRX
1499 DCA LOC
1500 MQA
1501 DCA I LOC
1502 JMP I ZTODISP
1503
1504XOFCODE,0 / AC := CODE[ AC.LINK ]
1505 RAL /LINK=0 ... 1ST WORD
1506 DCA LOC /LINK=1 ... 2ND WORD
1507 CDF CODEFIELD
1508 TAD I LOC
1509 CDF
1510 JMP I XOFCODE
1511
1512LOC, 0 /ADDRESS OF TABLE LOCATION
1513
1514ZOFCONST,0 /ENTER WITH ADDRESS-1 IN AC
1515 DCA XR10
1516 CDF TABLEFIELD
1517 TAD I XR10
1518 DCA AC0
1519 TAD I XR10
1520 DCA AC1
1521 TAD I XR10
1522 DCA AC2
1523 TAD I XR10
1524 DCA AC3
1525 CDF
1526 JMP I ZOFCONST
1527\f/PREDEFINED R A N D O M - NUMBER GENERATOR
1528
1529XRAND, 0
1530 TAD DISMOV /DISABLE INTEGER-
1531 DCA INTMOV /MULTIPLY-OVERFLOW
1532 AAAAAAAAAAAAAAAA
1533 GET INT&RN
1534 MUL INT&ALFA /MOD 2^35 !
1535 PUT INT&RN
1536 NORM /0 < RANDOM: REAL < 1
1537 EEEEEEEEEEEEEEEE
1538 TAD ENAMOV /REENABLE
1539 DCA INTMOV
1540 BUMP
1541 JMP I XRAND
1542
1543DISMOV, DCA AC0
1544ENAMOV, JMSSNAC
1545
1546RN, 0000;3777;7777;7775 /2^35 - 3 (INTEGER)
1547ALFA, 0000;0000;0100;0003 /2^18 + 3 (INTEGER)
1548
1549
1550XODD, 0
1551 L0001
1552 AND AC3
1553 LOAD
1554 JMP I XODD
1555
1556
1557XSKDIG, 0 /SKIP ON DIGIT
1558 TAD CHAR
1559 TAD (-"9-1
1560 CLL
1561 TAD ("9+1-"0
1562 DCA BCD
1563 SZL CLA
1564 ISZ XSKDIG
1565 JMP I XSKDIG
1566
1567XPRINT, 0 /INTERNAL PRINTER HANDLER
1568 SNA
1569 TAD CHAR
1570 TLS
1571 TSF
1572 JMP .-1
1573 TAD [-215
1574 SZA CLA
1575 JMP I XPRINT
1576 TAD [212
1577 JMP XPRINT+3
1578
1579SPRINT, 0 /SILENT PRINTER
1580 CLA CLL
1581 JMP I SPRINT
1582
1583XCRLF, 0 /CARRIAGE RETURN & LINE FEED
1584 TAD [215
1585 PRINTC
1586 JMP I XCRLF
1587
1588XBREAK, 0 /CHECK ^C AND ABORT
1589 KSF
1590 JMP I XBREAK
1591 CLA
1592 KRS
1593 AND [177
1594 TAD (-3
1595 SZA CLA
1596 JMP I XBREAK
1597 JMP I OS8
1598
1599 PAGE
1600\f/ A R I T H M E T I C P A C K A G E
1601
1602INTERPC,0000 /PROGRAM COUNTER FOR MACRO-INSTRUCTIONS
1603CPAGE, 7600
1604 SZA CLA
1605NEXTINSTR, ISZ INTERPC /POINT TO NEXT INSTRUCTION
1606 TAD I INTERPC /GET CODE
1607 SNA /IF CODE=0000
1608 JMP I INTERPC /THEN RETURN TO PDP8-MODE
1609 CLL RTL /ELSE SHIFT CODE NXXX
1610 RTL
1611 AND (7 /TO EXTRACT OPERATION CODE N
1612 DCA OPCODE
1613 TAD I INTERPC /GET CODE AGAIN,
1614 AND (177 /MASK OUT REL.ADDRESS (OR FUNCTION CODE)
1615 MQL
1616 TAD CPAGE
1617C200, AND INTERPC /CURRENT PAGE BITS
1618 MQA /+ RELATIVE ADDRESS
1619 DCA OPADDR /= ABS. ADDRESS OF OPERAND (IF MRI)
1620 SNL /IF D\I-BIT SET
1621 JMP .+3
1622 TAD I OPADDR /THEN DO INDIRECT ADDRESSING
1623 DCA OPADDR
1624 TAD OPCODE
1625 TAD (-7
1626 SNA CLA /IF CODE=7XXX
1627 JMP OPRTYP /THEN OPERATE CLASS INSTRUCTION
1628MRITYP, TAD I OPADDR /ELSE MEMORY REFERENCED INSTR.:
1629 DCA OPX /LOAD AND UNPACK OPERAND
1630 ISZ OPADDR /INTO OP-REGISTER
1631 L4000
1632 AND I OPADDR
1633 DCA OPS
1634 L3777
1635 AND I OPADDR
1636 DCA OP1
1637 ISZ OPADDR
1638 TAD I OPADDR
1639 DCA OP2
1640 ISZ OPADDR
1641 TAD I OPADDR
1642 DCA OP3
1643 TAD I INTERPC /GET INSTRUCTION CODE AGAIN,
1644 AND C200 /CHECK INTEGER\REAL-BIT
1645 SZA CLA /AND BUILD A
1646 TAD (7
1647 TAD OPCODE
1648 TAD (JMS I MRITABL
1649 DCA .+1
1650OPCODE, JMS . / J M S TO THE REQUESTED ROUTINE
1651 JMP NEXTINSTR
1652OPADDR, 0
1653
1654/TABLE OF INTEGER ARITHMETIC ROUTINES:
1655MRITABL,OGET
1656 IADD
1657 ISUB
1658 IMUL
1659 IDIV
1660 IMOD
1661 OPUT
1662
1663/TABLE OF REAL ARITHMETIC ROUTINES:
1664 OGET
1665 RADD
1666 RSUB
1667 RMUL
1668 RDIV
1669 OJUMP
1670 OPUT
1671
1672OPRTYP, TAD I INTERPC /DECODE OPERATE INSTRUCTION
1673 SNL /BIT3 IS IN LINK (COMPLEMENTED!)
1674 JMP SKIPTYP /SKIP INSTR. CODES ARE 74XX, 75XX
1675 BSW /OPERATE INSTR. CODES ARE:
1676 RTR /7000 - 7006 (INTEGER)
1677 CLA MQA /7200 - 7206 (REAL)
1678 AND (7 /EXTENDED FUNCTIONS: 70X7
1679 RAL
1680 TAD (JMS I OPRTABL
1681 DCA .+3
1682 TAD INTERPC /SAVE PC, SINCE OPR'S MAY CAUSE
1683 DCA SAVEPC /RECURSIVE CALL OF INTERPRETER (1 LEVEL)
1684OPRJMS, JMS . / J M S TO APPROPRIATE ROUTINE
1685 TAD SAVEPC /RESTORE PC
1686 DCA INTERPC
1687 JMP NEXTINSTR
1688SAVEPC, 0
1689
1690NOOP=OPCODE
1691
1692/TABLE OF OPERATE CLASS INSTRUCTIONS:
1693OPRTABL,XABS; RNORM
1694 IINP; RINP
1695 IOUT; ROUT
1696 IFLOAT; RTRUNC
1697 XNEG; CLAC
1698 XISQU; XRSQU
1699 XCRLF; XROUND
1700 NOOP /LINK TO FUNCTION DISPATCH ROUTINE
1701IFDEF FUNCTS <
1702 *.-1
1703 FUNCTS /ENABLED ONLY IF FUNCTION PACKAGE PRESENT
1704>
1705
1706SKIPTYP,JMS BOOL /ALL SKIP INSTR. (INT & REAL) DONE HERE
1707 ISZ INTERPC /(SEE ROUTINE 'BOOL' FOR COMMENTS)
1708 JMP NEXTINSTR-1
1709
1710OJUMP, 0 /JUMP (WITHIN MACRO CODE!!!)
1711 L7775
1712 TAD OPADDR
1713 DCA INTERPC
1714 JMP NEXTINSTR+1
1715
1716OPUT, 0 /STORE CONTENTS OF AC-REGISTER
1717 L0004 /AT SPECIFIED MEMORY ADDRESS
1718 CIA /-4 (OPADDR WAS MOVED AT MRITYP)
1719 TAD OPADDR
1720 DCA XR10
1721 TAD ACX
1722 DCA I XR10
1723 TAD ACS
1724 TAD AC1
1725 DCA I XR10
1726 TAD AC2
1727 DCA I XR10
1728 TAD AC3
1729 DCA I XR10
1730 JMP I OPUT
1731
1732 PAGE
1733\f/R E A L N U M B E R I N P U T
1734/
1735/ACCEPTS A DECIMAL NUMBER IN ANY FORMAT,
1736/CONVERTS IT TO INTERNAL BYNARY FLOATING POINT NOTATION
1737/AND LEAVES IT IN THE AC-REGISTER.
1738/LEADING BLANKS ARE IGNORED; THE FIRST
1739/NON ACCEPTABLE CHARACTER TERMINATES THE NUMBER.
1740
1741DC=MQ2 /DIGIT COUNTER
1742OC=MQ3 /DIGIT EXCESS COUNTER
1743DP, 0 /DECIMAL POINT POSITION
1744
1745RINP, RETNUM /RETURN ADDR. SINCE COMPILER ENTERS AT 'FRACTN'
1746 SKP CLA
1747 READC /PASS OVER LEADING BLANKS
1748 TAD CHAR
1749 TAD (-240
1750 SNA CLA
1751 JMP .-4
1752 JMS PMXXX /PROCESS + - I N T E G E R PART
1753 TAD OC /COUNT LOOSEN DIGITS (IF THE INTERNAL
1754 CIA /REPRESENTATION EXCEEDS 35 BITS,
1755 DCA DC /FURTHER DIGITS ARE IGNORED, BUT
1756 TAD CHAR /THEIR CONTRIBUTION TO MAGNITUDE
1757 TAD (-". /MUST BE CONSIDERED!)
1758 SZA CLA /IF INTEGER FOLLOWED BY DECIMAL POINT
1759 JMP .+3
1760 READC
1761FRACTN, JMS BCONV /THEN PROCESS F R A C T I O N PART
1762 TAD DC /COUNT DIGITS AFTER DEC. POINT
1763 CIA
1764 DCA DP /TO REMEMBER POSITION OF DEC. POINT
1765 JMS IFLOAT /NORMALIZE THE NUMBER
1766 TAD CHAR
1767 TAD (-"E
1768 SZA CLA /IF NEXT CHARACTER IS "E"
1769 JMP ADJUST
1770 AAAAAAAAAAAAAAAA
1771 PUT NUMBUF /THEN STORE NUMBER TEMPORARELY
1772 EEEEEEEEEEEEEEEE
1773 READC
1774 JMS PMXXX /AND PROCESS S C A L E - F A C T O R
1775 TAD ACS
1776 CLL RAL
1777 TAD AC3 /GET IT FROM LOW ORDER WORD OF AC
1778 SZL /IF NEGATIVE SIGN
1779 CIA /THEN USE 2'S COMPLEMENT
1780 TAD DP /ADD IT TO CURRENT POS. OF DEC. POINT
1781 DCA DP
1782 AAAAAAAAAAAAAAAA
1783 GET NUMBUF /RECALL STORED MANTISSA
1784 EEEEEEEEEEEEEEEE
1785ADJUST, TAD DP /NOW CONVERT DEC. FLOATING POINT TO
1786 JMS SUP1 /TO BINARY FLOATING POINT NOTATION
1787 JMP I RINP
1788
1789
1790PMXXX, 0 /SIGNED INTEGER INPUT & CONVERSION
1791 CLEAR
1792 DCA DC
1793 DCA OC
1794 TAD CHAR
1795 TAD (-"+
1796 SNA
1797 JMP .+6
1798 CLL RTR
1799 SZA CLA
1800 JMP .+4
1801 L4000
1802 DCA ACS
1803 READC
1804 JMS BCONV
1805 JMP I PMXXX
1806
1807BCONV, 0 /UNSIGNED DIGIT STRING INPUT & CONVERSION
1808 SKDIG
1809 JMP I BCONV
1810 TAD AC0
1811 SZA CLA
1812 JMP OVER
1813 CLL
1814 JMS MUL10
1815 TAD BCD
1816 DCA OP3
1817 DCA OP2
1818 DCA OP1
1819 JMS BADD
1820 ISZ DC
1821 SKP
1822OVER, ISZ OC
1823 READC
1824 JMP BCONV+1
1825\f/F L O A T AND T R U N C ROUTINES
1826
1827
1828DISPLC=.
1829IFLOAT, 0 /COMPENSATE
1830 TAD (43 /35 BITS DISPLACEMENT OF BINARY POINT
1831 DCA ACX /WITH EXPONENT
1832 JMS RNORM /AND NORMALIZE
1833 JMP I IFLOAT
1834
1835RTRUNC, 0
1836 CLA CLL
1837 TAD ACX
1838 SPA SNA /IF ABS(AC)<1 OR AC=0
1839 JMP LESS0 /THEN TRUNC(AC):=0
1840 TAD MIN44
1841 DCA DISPLC /-(DISPLACEMENT OF BINARY POINT + 1)
1842 SZL CLA /IF ABS(AC)>MAXINT
1843 JMP ERROR2 /THEN O V E R F L O W
1844 SKP
1845 HALVE /ELSE ALIGN MANTISSA
1846 ISZ DISPLC
1847 JMP .-2
1848 DCA ACX /EXP=0 FOR INTEGERS
1849 JMP I RTRUNC
1850LESS0, CLA
1851 CLEAR
1852 JMP I RTRUNC
1853
1854XROUND, 0
1855 L2000
1856 DCA OP1
1857 DCA OP2
1858 DCA OP3
1859 DCA OPX /X>=0:
1860 TAD ACS /ROUND(X) = TRUNC(X+0.5)
1861 DCA OPS /X<0:
1862 JMS RADD /ROUND(X) = TRUNC(X-0.5)
1863 JMS RTRUNC
1864 JMP I XROUND
1865
1866 PAGE
1867\f/R E A L N U M B E R O U T P U T
1868/
1869/PRINTS FLOATING POINT NUMBER X (CONTENTS OF AC-REGISTER)
1870/IN THE FORMAT SPECIFIED BY THE PARAMETERS M,N (PAGE 0)
1871/PERFORMS LIKE THE PASCAL-STATEMENT
1872/ W R I T E ( X :M :N )
1873
1874
1875/M /MINIMUM FIELD WIDTH
1876/N /FRACTION LENGTH
1877S=MQ1 /-NUMBER OF LEADING BLANKS
1878P=MQ2 /-NUMBER OF DIGITS PRECEDING THE DEC. POINT
1879F=MQ3 /-NUMBER OF DIGITS FOLLOWING THE DEC. POINT
1880
1881
1882ROUT, 0
1883 JMS FLCONV /BINARY TO DECIMAL FLOATING POINT
1884 JMS EXBCD /EXTRACT BCD-DIGITS OF MANTISSA
1885 TAD N
1886 SPA SNA /WHICH FORMAT REQUESTED?
1887 JMP FLOPNT
1888FIXPNT, CIA / -99999.99999
1889 DCA F /F:=-N
1890 TAD DEXP
1891 SPA /IF DEXP>0
1892 CLA /THEN P:=-(DEXP+1)
1893 CMA /ELSE P:=-1
1894 DCA P
1895 L7776 /S:=-(M-N-P-2)
1896 TAD F
1897 TAD P
1898 TAD M
1899 CIA
1900 DCA S
1901 TAD S
1902 SMA CLA /IF S>=0 THEN USE FLOATING POINT FORMAT
1903 JMP FLOPNT /(NUMBER TOO LARGE FOR FIXED POINT!)
1904 L0002
1905 TAD N /ROUNDUP WITH (N+DEXP+1)TH DIGIT
1906 TAD DEXP
1907 SPA SNA /IF NOT WITHIN THE 11 DIGITS, THEN
1908 JMP .+3
1909 TAD (-13 /ROUNDUP WITH 11TH DIGIT
1910 SMA
1911 CLA
1912 TAD (13
1913 JMS UROUND
1914 JMP FIXPNT+2 /ROUNDED MANTISSA = 10, CHECK WIDTH!
1915 TAD DEXP /BEGINNING AT DIGIT POS. NUMBUF+DEXP
1916 SMA /OR NUMBUF IF NUMBER >= 1
1917 CLA
1918 JMS XOUT /DO THE FIXED POINT OUTPUT
1919 JMP I ROUT
1920
1921
1922FLOPNT, L7777 / -9.999999999E+999
1923 DCA P /P:=-1
1924 TAD M
1925 TAD (-12
1926 SPA
1927 CLA
1928 TAD (12
1929 DCA M /IF M<10 THEN M:=10
1930 TAD (-11
1931 DCA F /F:=-9
1932 TAD M /S:=-(M-17)
1933 TAD (-21
1934 CIA
1935 DCA S
1936 TAD S
1937 SPA CLA /IF S>=0 THEN
1938 JMP .+7
1939 L7777 /S:=-1
1940 DCA S /F:=-(M-9)
1941 TAD M
1942 TAD (-11
1943 CIA
1944 DCA F
1945 L7776
1946 TAD F
1947 CIA
1948 JMS UROUND /ROUNDUP WITH (-F+1)TH DIGIT
1949STFW, 0022 /NOP (CARRY DOESN'T HARM!)
1950 JMS XOUT /OUTPUT THE MANTISSA
1951 TAD ("E
1952 PRINTC /E
1953 TAD DEXP
1954 SPA CLA
1955 L0002
1956 TAD ("+
1957 PRINTC /+ OR -
1958 TAD DEXP
1959 SPA
1960 CIA /MAKE DEXP POSITIVE
1961 JMS LDAC /LOAD IT IN AC-REGISTER (AS INTEGER)
1962 L0003
1963 DCA M /SETUP A FIELD WIDTH OF 3,
1964 TAD ("0-240 /CHANGE LEADING BLANKS TO ZEROES
1965 JMS IOUT /AND USE INTEGER OUTPUT ROUTINE
1966 TAD STFW /TO PRINT THE CHARACTERISTIC.
1967 DCA M /THEN RESET STANDARD FIELD WIDTH
1968 JMP I ROUT
1969
1970
1971
1972
1973/BUFFER FOR BCD-DIGITS:
1974 0 /IMPORTANT! (SEE ROUNDING)
1975NUMBUF, ZBLOCK 13
1976
1977
1978
1979TEN, 0004 /REAL CONSTANT OF 10.0
1980 2400
1981 0000
1982 0000
1983
1984OPTEN, 7775 /REAL CONSTANT OF 0.1 (CURRENTLY NOT USED!)
1985 3146
1986 3146
1987 3146
1988
1989LDAC,
1990CLAC, 0 /LOAD OR CLEAR AC-REGISTER
1991 DCA AC3
1992 DCA AC2
1993 DCA AC1
1994 DCA AC0
1995 DCA ACS
1996 DCA ACX
1997 JMP I CLAC
1998
1999 PAGE
2000\f/REAL NUMBER OUTPUT - AUXILIARY ROUTINES
2001
2002XDPOS=XR10 /AUTOINDEXING DIGITS
2003/DPOS=EXBCD /SIMPLE POINTER TO DIGITS
2004/DIG0=DOUT /NUMBUF-1 OR NUMBUF-2 (FIRST DIGIT OF MANTISSA)
2005DEXP=BCD /DECIMAL CHARACTERISTIC OF X
2006DCNT=. /DIGIT COUNTER
2007
2008FLCONV, 0 /CONVERT X*2^ACX ---> Z*10^DEXP,
2009 DCA DEXP /WITH 1<=Z<10:
2010 TAD AC1
2011 SNA CLA /IF NUMBER=0 THEN NO CONVERSION NECESSARY!
2012 JMP I FLCONV
2013 JMS SUP2 /DO SUPER CONVERSION
2014FLCLP, TAD DEXP
2015 DCA DEXP
2016 TAD ACX
2017 SPA SNA /NOTE INTERNAL BINARY NOTATION:
2018 JMP SMALL
2019 TAD (-4 / 1 ..... 0.1000B+1
2020 SPA /10 ..... 0.1010B+4
2021 JMP .+5
2022 SZA CLA
2023 JMP LARGE
2024 TAD AC1 /HIGH ORDER WORD FOR 10
2025 TAD (-2400 /IS 2400 OCTAL!
2026 SPA CLA
2027 JMP I FLCONV
2028LARGE, AAAAAAAAAAAAAAAA
2029 DIV TEN /:10 (OR 'MUL OPTEN' *0.1)
2030 EEEEEEEEEEEEEEEE
2031 L0001
2032 JMP FLCLP
2033SMALL, AAAAAAAAAAAAAAAA
2034 MUL TEN /*10
2035 EEEEEEEEEEEEEEEE
2036 L7777
2037 JMP FLCLP
2038
2039DPOS=.
2040EXBCD, 0 /EXTRACT BCD-DIGITS OF MANTISSA
2041 TAD ACX
2042 CMA
2043 DCA DCNT
2044 STL /(MIGHT CORRECT ILL 11TH DEC. DIGIT!)
2045 DOUBLE /SHIFT OUT FIRST DIGIT
2046 ISZ DCNT
2047 JMP .-3
2048 TAD (NUMBUF-1
2049 DCA XDPOS
2050 TAD (-12 /10 DIGITS REMAINING
2051 DCA DCNT
2052 DCA I (NUMBUF-1 /LEADING 0 FOR ROUNDING CARRY
2053 SKP
2054 JMS MUL10
2055 TAD AC0
2056 DCA I XDPOS
2057 DCA AC0
2058 ISZ DCNT
2059 JMP .-5
2060 TAD (NUMBUF-1 /POINT TO FIRST DIGIT
2061 DCA DIG0
2062 JMP I EXBCD
2063
2064UROUND, 0 /ROUNDUP. ENTRY WITH DIGIT NO.
2065 TAD DIG0 /WHERE TO START ROUNDING
2066 DCA DPOS /IN HARDWARE AC
2067 TAD (5
2068CARRY, TAD (-12
2069 TAD I DPOS
2070 SPA CLA
2071 JMP OVR10
2072 DCA I DPOS
2073 L7777
2074 TAD DPOS
2075 DCA DPOS
2076 ISZ I DPOS
2077 JMP CARRY
2078OVR10, TAD DIG0
2079 CIA
2080 TAD DPOS
2081 SZA CLA /CARRY TO A NEW FIRST DIGIT?
2082 JMP SKIPEX /NO
2083 L7777
2084 TAD DIG0
2085 DCA DIG0
2086 ISZ DEXP
2087 JMP I UROUND /MANTISSA=10 EXIT
2088SKIPEX, ISZ UROUND /NORMAL EXIT
2089 JMP I UROUND
2090
2091XOUT, 0 /OUTPUT. ENTRY WITH DIGIT NO.
2092 TAD DIG0 /WHERE TO START PRINTING
2093 DCA XDPOS /IN HARDWARE AC
2094 TAD (240
2095 PRINTC / -(S) BLANKS
2096 ISZ S
2097 JMP .-3
2098 TAD ACS
2099 SPA CLA
2100 TAD ("--240
2101 TAD (240
2102 PRINTC / THE SIGN (- OR BLANK)
2103 JMS DOUT / -(P) DIGITS (OR ZERO)
2104 ISZ P
2105 JMP .-2
2106 TAD (". / THE DECIMAL POINT
2107 PRINTC
2108 JMS DOUT / -(F) DIGITS (OR ZEROES)
2109 ISZ F
2110 JMP .-2
2111 JMP I XOUT
2112
2113DIG0=.
2114DOUT, 0 /IF XDPOS POINTS INTO BUFFER
2115 TAD XDPOS /THEN PRINT THE DIGIT
2116 TAD (-NUMBUF-12 /ELSE PRINT A ZERO
2117 CLL
2118 TAD (14
2119 CLA
2120 TAD I XDPOS
2121 SNL
2122 CLA
2123 TAD ("0
2124 PRINTC
2125 JMP I DOUT
2126
2127 PAGE
2128\f/R E A L A R I T H M E T I C
2129/
2130/RADD: AC:=AC+OP
2131/RSUB: AC:=AC-OP
2132/RMUL: AC:=AC*OP
2133/RDIV: AC:=AC/OP
2134/
2135/RNORM: NORMALIZE AC TO STANDARD FLOATING POINT FORMAT
2136
2137
2138RADD, 0
2139 TAD OP1
2140 SNA CLA /IF OP=0 THEN DON'T WASTE TIME!
2141 JMP I RADD
2142 TAD AC1
2143 SNA CLA /IF AC=0 THEN SIMPLY ADD!
2144 JMP OPMAX
2145 TAD ACX /COMPARE MAGNITUDE OF OPERANDS
2146 CIA /AND STORE NEGATIVE DIFFERENCE
2147 TAD OPX
2148 SMA
2149 JMP OPMAX
2150 DCA RDIV /TO USE AS SHIFT COUNTER
2151ACMAX, TAD OP1 /1/ ABS(AC)>ABS(OP) ---> SHIFT OP RIGHT
2152 CLL RAR
2153 DCA OP1
2154 TAD OP2
2155 RAR
2156 DCA OP2
2157 TAD OP3
2158 RAR
2159 DCA OP3
2160 ISZ RDIV
2161 JMP ACMAX
2162 JMP SETSGN
2163OPMAX, CMA /2/ ABS(OP)>=ABS(AC)
2164 DCA RDIV
2165 TAD OPX /RESULT IS OF MAGNITUDE OF OP
2166 DCA ACX
2167 SKP
2168 HALVE /SHIFT AC RIGHT
2169 ISZ RDIV
2170 JMP .-2
2171SETSGN, JMS OADD /MANTISSAS NOW ALIGNED! - ADD.
2172 JMS RNORM /NORMALIZE RESULT
2173 JMP I RADD
2174
2175RSUB, 0
2176 JMS OSUB /OP:=-OP
2177 JMS RADD /AC:=AC+(-OP)
2178 JMP I RSUB
2179OSUB, 0
2180 L4000
2181 TAD OPS
2182 DCA OPS
2183 JMP I OSUB
2184
2185RMUL, 0
2186 TAD OP1
2187 SNA CLA
2188 JMS CLAC
2189 TAD AC1
2190 SNA CLA /IF OP=0 OR AC=0
2191 JMP I RMUL /THEN DON'T WASTE TIME!
2192 DCA MQ1
2193 DCA MQ2 /CLEAR MQ-REGISTER (FOR 'BMUL')
2194 DCA MQ3
2195 TAD OPS /SETUP SIGN OF PRODUCT
2196 TAD ACS
2197 DCA ACS
2198 L7777
2199 TAD OPX /COMPUTE EXPONENT OF PRODUCT
2200 TAD ACX
2201 DCA ACX
2202 L0001
2203 JMS BMUL /MULTIPLY MANTISSAS
2204 JMS RNORM
2205 JMP I RMUL
2206
2207RDIV, 0
2208 TAD OP1
2209 SNA CLA
2210ERROR0, HALT /D I V I S I O N BY Z E R O !
2211 DCA MQ1
2212 DCA MQ2 /CLEAR MQ-REGISTER (FOR 'BDIV')
2213 DCA MQ3
2214 TAD OPS /SETUP SIGN OF QUOTIENT
2215 TAD ACS
2216 DCA ACS
2217 TAD OPX /COMPUTE EXPONENT OF QUOTIENT
2218 CIA
2219 TAD ACX
2220 DCA ACX
2221 JMS BDIV /DIVIDE MANTISSAS
2222 JMS RNORM
2223 JMP I RDIV
2224
2225RNORM, 0
2226 CLA CLL
2227TOOBIG, TAD AC1
2228 AND (4000 /(NO 'L4000' BECAUSE OF LINK!)
2229 TAD AC0
2230 SNA CLA /WHILE MANTISSA TOO BIG (>=1)
2231 JMP ROUNDUP
2232 HALVE /HALVE IT (SHIFT RIGHT)
2233 ISZ ACX /AND CORRECT THE EXPONENT (+1)
2234 NOP
2235 JMP TOOBIG
2236ROUNDUP,SZL /IF A BINARY 1 WAS SHIFTED OUT
2237 ISZ AC3 /THEN ROUND MANTISSA
2238 JMP NULLAC
2239 ISZ AC2
2240 JMP NULLAC
2241 ISZ AC1 /(CAN'T SKIP!)
2242 JMP RNORM+1
2243NULLAC, JMS SNAC /CHECK FOR NULL MANTISSA
2244 JMP ISNULL
2245TOOSMALL,L2000
2246 AND AC1
2247 SZA CLA /WHILE MANTISSA TOO SMALL (<0.5)
2248 JMP ISNULL+1
2249 DOUBLE /DOUBLE IT (SHIFT LEFT)
2250 L7777 /AND CORRECT THE EXPONENT (-1)
2251 TAD ACX
2252 DCA ACX
2253 JMP TOOSMALL
2254ISNULL, JMS CLAC
2255 L2000 /CHECK FOR OVER- OR UNDERFLOW
2256 TAD ACX
2257 SMA CLA
2258 JMP I RNORM /OKAY!
2259 TAD ACX
2260 SPA CLA
2261ERROR1, HALT /U N D E R F L O W !
2262ERROR2, HALT /O V E R F L O W !
2263
2264 PAGE
2265\f/I N T E G E R I N P U T AND O U T P U T
2266/
2267/
2268
2269/M /MINIMUM FIELD WITH
2270DI, 0 /-NUMBER OF DIGITS TO PRINT
2271SI, 0 /-NUMBER OF LEADING BLANKS
2272LDBLANK,240 /OR OTHER LEADING CHARACTER
2273NEGATIV,0 /IF NUMBER NEGATIVE THEN -1 ELSE 0
2274
2275IINP, 0
2276 SKP CLA
2277 READC /IGNORE LEADING BLANKS
2278 TAD CHAR
2279 TAD (-240
2280 SNA CLA
2281 JMP .-4
2282 JMS PMXXX /INPUT +-0123456789 AND CONVERT TO BINARY
2283 JMS INORM /CHECK OVERFLOW (MAXINT=34359738367)
2284 JMP I IINP
2285
2286PTD=IINP
2287
2288IOUT, 0
2289 TAD [240 /KLUDGE! CHOOSE THE LEADING CHARACTER
2290 DCA LDBLANK /WITH A TAD (XXX-240 BEFORE CALLING IOUT
2291 TAD ACS
2292 SPA CLA
2293 L7777
2294 DCA NEGATIV
2295 TAD (NUMBUF+12
2296 DCA PTD /POINT TO RIGHTMOST POS. OF BUFFER
2297 DCA I PTD /STORE A 0 CASE NUMBER=0
2298DECONV, JMS SNAC
2299 JMP OFORM
2300 L7777
2301 TAD PTD /DECREMENT POINTER
2302 DCA PTD
2303 AAAAAAAAAAAAAAAA
2304 DIV INT&IO /AC:=AC DIV 10
2305 EEEEEEEEEEEEEEEE
2306 TAD MQ3
2307 CLL RAR /GET REST OF ABOVE DIVISION
2308 JMP DECONV-1 /AND STORE AS BCD-DIGIT
2309OFORM, TAD (-NUMBUF-12
2310 TAD PTD
2311 SMA
2312 L7777 /AT LEAST ONE DIGIT TO PRINT (THINK OF 0)
2313 DCA DI /DI:=-NUMBER OF DIGITS
2314 TAD NEGATIV /TAKE ACCOUNT OF EV. - SIGN
2315 TAD M
2316 TAD DI
2317 SPA /IF FIELD WIDTH < NO. OF DIGITS
2318 CLA /THEN SI:=-1
2319 CMA /ELSE SI:=-(FIELD WIDTH - DIGITS) - 1
2320 DCA SI
2321 JMP .+3
2322LDCHAR, TAD LDBLANK
2323 PRINTC /LEADING BLANKS
2324 ISZ SI
2325 JMP LDCHAR
2326EVMINS, ISZ NEGATIV
2327 JMP ODIGS
2328 TAD ("-
2329 PRINTC /MINUS SIGN (IF ANY)
2330ODIGS, TAD I PTD
2331 ISZ PTD
2332 TAD ("0
2333 PRINTC /DIGIT STRING
2334 ISZ DI
2335 JMP ODIGS
2336 JMP I IOUT
2337
2338INORM, 0 /INTEGER CLEARING HOUSE ROUTINE
2339 L4000
2340 AND AC1
2341 TAD AC0
2342 SZA CLA /IF AC0<>0 OR AC1>3777 THEN
2343 JMP ERROR2 /O V E R F L O W
2344 JMS SNAC
2345 DCA ACS /DON'T FORGET THE -0 PROBLEM!
2346 JMP I INORM
2347
2348IO, 0000 /INTEGER CONSTANT OF 10
2349 0000
2350 0000
2351 0012
2352\f/VARIOUS SECONDARY ROUTINES:
2353
2354XABS, 0 /AC:=ABS(AC)
2355 DCA ACS
2356 JMP I XABS
2357
2358XNEG, 0 /AC:=-AC (REAL AND INTEGER)
2359 L4000
2360 TAD ACS
2361 DCA ACS
2362 JMS INORM /BUT NOT AC:=-0 !
2363 JMP I XNEG
2364
2365OGET, 0 /COPY CONTENTS OF
2366 DCA AC0 /OP-REGISTER INTO AC-REGISTER
2367 TAD OP1 /(AC0 IS CLEARED!)
2368 DCA AC1
2369 TAD OP2
2370 DCA AC2
2371 TAD OP3
2372 DCA AC3
2373 TAD OPS
2374 DCA ACS
2375 TAD OPX
2376 DCA ACX
2377 JMP I OGET
2378
2379ENTR, 0 /COPY CONTENTS OF
2380 TAD AC1 /AC-REGISTER INTO OP-REGISTER
2381 DCA OP1 /(AC0 UNCHANGED!)
2382 TAD AC2
2383 DCA OP2
2384 TAD AC3
2385 DCA OP3
2386 TAD ACS
2387 DCA OPS
2388 TAD ACX
2389 DCA OPX
2390 JMP I ENTR
2391
2392BOOL, 0 /ENTER WITH SKIP-INSTRUCTION
2393 DCA OSKIP /IN HARDWARE AC
2394 JMS SNAC
2395 SKP
2396 L0001
2397 TAD ACS
2398OSKIP, 0000
2399 SKP CLA
2400 L0001
2401 JMP I BOOL /EXIT WITH HARDWARE AC=1 IF TRUE (SKIP)
2402 /OR AC=0 IF FALSE
2403
2404 PAGE
2405\f/I N T E G E R A R I T H M E T I C
2406/
2407/IADD: AC:=AC+OP
2408/ISUB: AC:=AC-OP
2409/IMUL: AC:=AC*OP
2410/IDIV: AC:=AC DIV OP
2411/IMOD: AC:=AC MOD OP
2412
2413
2414IADD, 0
2415 JMS OADD
2416 JMS INORM
2417 JMP I IADD
2418OADD, 0
2419 TAD ACS
2420 TAD OPS
2421 SNA CLA /IF BOTH OPERANDS HAVE THE SAME SIGN
2422 JMP SAMESGN /THEN SIMPLY ADD THEM
2423 JMS CMOP /ELSE COMPLEMENT ONE OF THEM (OP)
2424 JMS BADD /AND ADD
2425 TAD AC1 /BUT TAKE CARE:
2426 SMA CLA /IF RESULT POSITIVE (IN 2'S COMPLEMENT)
2427 JMP .+4 /THEN OKAY
2428 JMS CMAC /ELSE COMPLEMENT AC
2429 TAD OPS /AND USE SIGN OF OP
2430 DCA ACS
2431 DCA AC0 /NO OVERFLOW IN THIS CASE!
2432 JMP I OADD
2433SAMESGN,JMS BADD
2434 JMP I OADD
2435
2436ISUB, 0
2437 JMS OSUB /OP:=-OP
2438 JMS IADD /AC:=AC+(-OP)
2439 JMP I ISUB
2440
2441IMUL, 0
2442 JMS SNOP /IF OP=0
2443 CLEAR /THEN PRODUCT IS 0
2444 DCA MQ1
2445 DCA MQ2 /CLEAR MQ-REGISTER (BMUL NEEDS THAT!)
2446 DCA MQ3
2447 TAD OPS /SETUP SIGN OF PRODUCT
2448 TAD ACS
2449 DCA ACS
2450 JMS BMUL /MULTIPLY
2451INTMOV, JMS SNAC /IF HIGH ORDER WORDS OF PRODUCT <>0
2452 SKP
2453 JMP ERROR2 /THEN O V E R F L O W !
2454 JMS SWAP /GET LOW ORDER PART INTO AC
2455 HALVE /(BMUL GIVES 2*PRODUCT!)
2456 JMS INORM
2457 JMP I IMUL
2458
2459
2460MODSGN=IMUL
2461
2462IDIV, 0
2463 JMS SNOP
2464 JMP I [ERROR0 /D I V I S I O N BY Z E R O !
2465 DOUBLE
2466 JMS SWAP /PUT 2*DIVIDEND INTO MQ-REGISTER
2467 DCA AC1 /AND CLEAR AC (SEE BDIV INSTRUCTIONS)
2468 DCA AC2
2469 DCA AC3
2470 TAD OPS /SETUP SIGN OF QUOTIENT
2471 TAD ACS
2472 DCA ACS
2473 TAD ACS /PATCH: SERVES
2474 DCA MODSGN /FOR MOD-FUNCTION
2475 JMS BDIV /DIVIDE
2476 JMS INORM
2477 JMP I IDIV
2478
2479IMOD, 0
2480 JMS IDIV /DIVIDE OP INTO AC
2481 JMS SWAP /GET 2*REST FROM MQ-REGISTER
2482 HALVE /AND HALVE IT (SEE BDIV INSTR.)
2483 TAD MODSGN
2484 SPA CLA /IF REST NOT NEGATIVE
2485 JMS SNAC
2486 JMP MODOK /THEN OKAY
2487 JMS BADD /ELSE ADD OP TO MAKE IT POSITIVE
2488 JMS CMAC /MORE PRECISELY: AC:=-(AC-OP)
2489MODOK, DCA ACS /SIGN IS +
2490 DCA AC0
2491 JMP I IMOD
2492\f/FOUR SECONDARY ROUTINES:
2493
2494SNAC, 0 /SKIP ON NONZERO AC
2495 TAD AC3
2496 SNA
2497 TAD AC2
2498 SNA
2499 TAD AC1
2500 SZA CLA
2501 ISZ SNAC
2502 JMP I SNAC
2503
2504SNOP, 0 /SKIP ON NONZERO OP
2505 TAD OP3
2506 SNA
2507 TAD OP2
2508 SNA
2509 TAD OP1
2510 SZA CLA
2511 ISZ SNOP
2512 JMP I SNOP
2513
2514CMAC, 0 /2'S COMPLEMENT OF AC
2515 CLA CLL
2516 TAD AC3
2517 CIA
2518 DCA AC3
2519 TAD AC2
2520 CMA
2521 SZL
2522 IAC CLL
2523 DCA AC2
2524 TAD AC1
2525 CMA
2526 SZL
2527 IAC CLL
2528 DCA AC1
2529 JMP I CMAC
2530
2531CMOP, 0 /2'S COMPLEMENT OF OP
2532 CLA CLL
2533 TAD OP3
2534 CIA
2535 DCA OP3
2536 TAD OP2
2537 CMA
2538 SZL
2539 IAC CLL
2540 DCA OP2
2541 TAD OP1
2542 CMA
2543 SZL
2544 IAC CLL
2545 DCA OP1
2546 JMP I CMOP
2547
2548JMSSNAC=JMS SNAC
2549
2550 PAGE
2551\f
2552
2553/B I N A R Y A D D I T I O N
2554/
2555/AC0!AC1!AC2!AC3 := AC1!AC2!AC3 + OP1!OP2!OP3
2556
2557TEMP3=.
2558
2559BADD, 0
2560 CLA CLL
2561 TAD AC3
2562 TAD OP3
2563 DCA AC3
2564 RAL
2565 TAD AC2
2566 TAD OP2
2567 DCA AC2
2568 RAL
2569 TAD AC1
2570 TAD OP1
2571 DCA AC1
2572 RAL
2573 TAD AC0
2574 DCA AC0
2575 JMP I BADD
2576
2577
2578
2579
2580/B I N A R Y M U L T I P L I C A T I O N
2581/
2582/OP=FACTOR
2583/FLOATING POINT: AC=FACTOR, MQ=0; AC=PRODUCT (HIGH ORDER)
2584/INTEGER: AC=FACTOR, MQ=0; MQ=2*PRODUCT (LOW ORDER)
2585
2586BMUL, 0
2587 TAD MIN44 /-36
2588 DCA BDIV
2589 JMS SWAP
2590MULLP, JMS RACR
2591 TAD MQ1
2592 RAR
2593 DCA MQ1
2594 TAD MQ2
2595 RAR
2596 DCA MQ2
2597 TAD MQ3
2598 RAR
2599 DCA MQ3
2600 SZL
2601 JMS BADD
2602 ISZ BDIV
2603 JMP MULLP
2604 JMP I BMUL
2605\f/B I N A R Y D I V I S I O N
2606/
2607/OP=DIVISOR
2608/FLOATING POINT: AC=DIVIDEND, MQ=0; AC=QUOTIENT
2609/INTEGER: AC=0, MQ=2*DIVIDEND; AC=QUOTIENT, MQ=2*REST
2610
2611BDIV, 0
2612 TAD MIN44 /-36
2613 DCA BMUL
2614 JMS CMOP
2615DIVLP, CLL /COMPARE AC AND OP
2616 TAD AC3
2617 TAD OP3
2618 DCA TEMP3 /SAVE DIFFERENCE
2619 RAL
2620 TAD AC2
2621 TAD OP2
2622 DCA TEMP2
2623 RAL
2624 TAD AC1
2625 TAD OP1
2626 SNL /AC > OP?
2627 JMP .+6
2628 DCA AC1 /YES, SETUP DIFFERENCE
2629 TAD TEMP2
2630 DCA AC2
2631 TAD TEMP3
2632 DCA AC3
2633 CLA
2634 TAD MQ3 /SHIFT IN NEW BIT OF QUOTIENT
2635 RAL /AND DOUBLE DIVIDEND
2636 DCA MQ3
2637 TAD MQ2
2638 RAL
2639 DCA MQ2
2640 TAD MQ1
2641 RAL
2642 DCA MQ1
2643 JMS RACL
2644 ISZ BMUL
2645 JMP DIVLP
2646 JMS SWAP
2647 JMP I BDIV
2648\f/OTHER BINARY OPERATIONS:
2649
2650
2651
2652MUL2,
2653RACL, 0 /SHIFT AC ONE BIT LEFT (=DOUBLE)
2654 TAD AC3 /TAKE CARE OF LINK CALLING RACL!!!
2655 RAL
2656 DCA AC3
2657 TAD AC2
2658 RAL
2659 DCA AC2
2660 TAD AC1
2661 RAL
2662 DCA AC1
2663 TAD AC0
2664 RAL
2665 DCA AC0
2666 JMP I RACL
2667
2668
2669 TEMP2=.
2670
2671MUL10, 0 /AC TIMES 10
2672 JMS ENTR /LINK MUST BE 0 ON ENTRY!!!
2673 JMS MUL2
2674 JMS MUL2
2675 JMS BADD
2676 JMS MUL2
2677 JMP I MUL10
2678
2679
2680
2681
2682RACR, 0 /SHIFT AC ONE BIT RIGHT (=HALVE)
2683 TAD AC0
2684 CLL RAR
2685 DCA AC0
2686 TAD AC1
2687 RAR
2688 DCA AC1
2689 TAD AC2
2690 RAR
2691 DCA AC2
2692 TAD AC3
2693 RAR
2694 DCA AC3
2695 JMP I RACR
2696
2697
2698
2699
2700
2701
2702
2703
2704SWAP, 0 /SWAP AC- AND MQ-REGISTER
2705 TAD AC1
2706 MQL
2707 TAD MQ1
2708 DCA AC1
2709 TAD AC2
2710 SWP
2711 DCA MQ1
2712 TAD MQ2
2713 DCA AC2
2714 TAD AC3
2715 SWP
2716 DCA MQ2
2717 TAD MQ3
2718 DCA AC3
2719 MQA
2720 DCA MQ3
2721 JMP I SWAP
2722
2723 PAGE
2724\f/ A R I T H M E T I C P A C K A G E
2725/OPTION:
2726/ S U P E R C O N V E R S I O N O V E R L A Y
2727
2728
2729/POWERS OF TEN TABLE:
2730
2731P1E1, 0004;2400;0000;0000 / 1.0E+001
2732 0007;3100;0000;0000 / 1.0E+002
2733 0016;2342;0000;0000 / 1.0E+004
2734 0033;2765;7020;0000 / 1.0E+008
2735 0066;2160;6744;6770 / 1.0E+016
2736 0153;2356;1326;6501 / 1.0E+032
2737 0325;3023;6017;5120 / 1.0E+064
2738 0652;2235;6443;7114 / 1.0E+128
2739P1E256, 1523;2523;7565;7735 / 1.0E+256
2740 3245;3430;6320;2565 / 1.0E+512 (SERVES AS A GUARD)
2741
2742P1E2N, 0 /POINTER INTO TABLE
2743DECP, 0 /DECIMAL CHARACTERISTIC
2744/DEXP=BCD / --- " --- (SEE 'FLCONV')
2745
2746SUP1, 0 /INPUT CONVERSION (OVERLAYS 'ADJUST')
2747 SPA /IF DECIMAL CHARACTERISTIC >= 0
2748 JMP .+4
2749 DCA DECP /THEN STORE AS IT IS
2750 TAD (MUL P1E1 /AND SETUP FOR MULTIPLY
2751 JMP .+4 /WITH POWERS OF 10
2752 CIA
2753 DCA DECP /ELSE MAKE IT POSITIVE
2754 TAD (DIV P1E1 /AND SETUP FOR DIVIDE
2755 DCA MD1E2N /BY POWERS OF 10
2756ADJLP, TAD DECP
2757 SNA /WHILE DECP<>0 DO:
2758 JMP I SUP1
2759 CLL RAR /DECP:=DECP DIV 2
2760 DCA DECP
2761 SNL /IF DECP WAS ODD
2762 JMP .+4
2763 AAAAAAAAAAAAAAAA
2764MD1E2N, MUL . /THEN MULTIPLY WITH (DIVIDE BY) 1.0E+2N
2765 EEEEEEEEEEEEEEEE
2766 L0004
2767 TAD MD1E2N /POINT TO NEXT POWER OF TEN
2768 DCA MD1E2N
2769 JMP ADJLP
2770
2771
2772SUP2, 0 /OUTPUT CONVERSION (OVERLAYS 'FLCONV')
2773 AAAAAAAAAAAAAAAA
2774 PUT XAC /SAVE NUMBER IN AC
2775 EEEEEEEEEEEEEEEE
2776 TAD XAC /GET BINARY EXPONENT
2777 SPA /(2'S COMPLEMENT!)
2778 CIA /AND LOAD IT AS POSITIVE INTEGER
2779 LOAD /INTO AC-REGISTER
2780 AAAAAAAAAAAAAAAA/NOTE: LG(2) IS APPROXIMATED BY 1233/4096
2781 MUL INT&O1233 /*1233
2782 EEEEEEEEEEEEEEEE
2783 L4000
2784 AND XAC
2785 CLL RAL
2786 TAD AC2 /DIV 4096
2787 SZL /IF XAC<0
2788 CMA /THEN DEXP := -XAC*1233 DIV 4096 - 1
2789 DCA DEXP /ELSE DEXP := XAC*1233 DIV 4096
2790 AAAAAAAAAAAAAAAA
2791 GET XAC /RESTORE NUMBER
2792 EEEEEEEEEEEEEEEE
2793 TAD DEXP
2794 CIA
2795 JMS SUP1 /DO CONVERSION TO DECIMAL FLOATING POINT
2796 JMP I SUP2
2797
2798XAC, ZBLOCK 4
2799O1233, 0000;0000;0000;2321 /1233 (INTEGER)
2800
2801
2802TRUEFALSE, TEXT /TRUEFALSE/
2803
2804
2805XISQU, 0 /AC := AC^2 (INTEGER)
2806 JMS ENTR
2807 JMS IMUL
2808 JMP I XISQU
2809
2810XRSQU, 0 /AC := AC^2 (REAL)
2811 JMS ENTR
2812 JMS RMUL
2813 JMP I XRSQU
2814
2815 PAGE
2816\f
2817/**********************
2818/ S Q U A R E R O O T
2819/
2820/ AC := SQRT(AC)
2821/**********************
2822
2823
2824XSQRT, 0
2825 TAD ACS
2826 SPA CLA
2827ERROR3, HALT /SQUARE ROOT OF N E G A T I V E NUMBER!
2828 TAD AC1
2829 SNA CLA
2830 JMP I XSQRT /DON'T WASTE TIME FOR SQRT(0)!
2831 L0001
2832 TAD ACX /TRANSFORM ARGUMENT TO THE FORM
2833 SPA SZL / 2^(2*N) * F WITH 0.25 <= F < 1
2834 CML
2835 RAR
2836 DCA ROOTX /SAVE N
2837 SNL /IF ODD(EXPONENT)
2838 L7777 /THEN ACX:=-1 (0.25 <= F < 0.5)
2839 DCA ACX /ELSE ACX:= 0 (0.5 <= F < 1 )
2840 AAAAAAAAAAAAAAAA
2841 PUT SQARG /SAVE F
2842 EEEEEEEEEEEEEEEE
2843 TAD ACX /COMPUTE INITIAL VALUE X0 FOR NEWTON:
2844 DCA OPOINT5 /X0:=F + 0.25 (0.25 <= F < 0.5)
2845 L7777 /X0:=F/2 + 0.5 (0.5 <= F < 1 )
2846 DCA ACX
2847 AAAAAAAAAAAAAAAA
2848 ADD OPOINT5
2849 EEEEEEEEEEEEEEEE
2850 L7775 /3 ITERATION LOOPS GUARANTEE
2851 DCA NEWTON /FULL PRECISION! (MAX. ERROR: 8.0E-13)
2852SQLOOP, AAAAAAAAAAAAAAAA
2853 PUT X123
2854 GET SQARG
2855 DIV X123
2856 ADD X123 /X[I+1] := (F/X[I] + X[I])/2
2857 EEEEEEEEEEEEEEEE
2858 L7777 /HALVE BY ACX:=ACX - 1
2859 TAD ACX
2860 DCA ACX
2861 ISZ NEWTON /IF DONE 3 LOOPS
2862 JMP SQLOOP
2863 TAD ROOTX /THEN INSERT EXPONENT N OF ROOT
2864 TAD ACX
2865 DCA ACX
2866 JMP I XSQRT
2867
2868NEWTON=. /LOOP COUNTER
2869OPOINT5,0000 /CONSTANT OF 0.5 OR 0.25 (EXPONENT WORD
2870 2000 /SET AT EXECUTION TIME)
2871 0000
2872 0000
2873SQARG, 0 /REDUCED ARGUMENT F
2874 0
2875 0
2876 0
2877X123, 0 /TEMPORARY FOR APPROXIMATE VALUE
2878 0
2879 0
2880 0
2881ROOTX, 0 /TEMPORARY FOR ROOT EXPONENT N
2882\f
2883/**********************************
2884/ N A T U R A L L O G A R I T H M
2885/
2886/ AC := LN(AC)
2887/**********************************
2888
2889
2890/TABLE OF CONSTANTS:
2891
2892A0, 0001 /1.84375
2893 3540
2894 0000
2895 0000
2896
2897LNA0, 0000 /0.611801541106
2898 2344
2899 7603
2900 2325
2901
2902A1, 0001 /1.65625
2903 3240
2904 0000
2905 0000
2906
2907LNA1, 0000 /0.504556010752
2908 2011
2909 2512
2910 4551
2911
2912A2, 0001 /1.5
2913 3000
2914 0000
2915 0000
2916
2917LNA2, 7777 /0.405465108108
2918 3174
2919 6217
2920 5457
2921
2922A3, 0001 /1.375
2923 2600
2924 0000
2925 0000
2926
2927LNA3, 7777 /0.318453731119
2928 2430
2929 3057
2930 0207
2931
2932A4, 0001 /1.25
2933 2400
2934 0000
2935 0000
2936
2937LNA4, 7776 /0.223143551314
2938 3443
2939 7737
2940 0746
2941
2942A5, 0001 /1.1875
2943 2300
2944 0000
2945 0000
2946
2947LNA5, 7776 /0.171850256927
2948 2577
2949 6301
2950 6051
2951
2952A6, 0001 /1.09375
2953 2140
2954 0000
2955 0000
2956
2957LNA6, 7775 /0.0896121586897
2958 2674
2959 1512
2960 1271
2961
2962A7, 0001 /1.03125
2963 2040
2964 0000
2965 0000
2966
2967LNA7, 7773 /0.0307716586668
2968 3740
2969 5154
2970 1636
2971
2972
2973 PAGE
2974
2975XLOG, 0
2976 TAD ACS
2977 TAD AC1
2978 SPA SNA CLA
2979ERROR4, HALT /LOGARITHM OF ZERO OR NEGATIVE NUMBER!
2980 AAAAAAAAAAAAAAAA
2981 PUT LNARG /SAVE ARGUMENT X = 2^N * F
2982 EEEEEEEEEEEEEEEE
2983 DCA LNARG /REDUCE TO FRACTION PART (0.5 <= F < 1)
2984 CLL
2985 TAD ACX /GET N (IN TWO'S COMPLEMENT!)
2986 SPA
2987 CIA STL
2988 JMS LDAC /LOAD IT AS INTEGER
2989 RAR
2990 DCA ACS
2991 AAAAAAAAAAAAAAAA
2992 FLOAT /CONVERT TO REAL
2993 MUL LN2 /TIMES LN(2)
2994 PUT LNTEMP /AND SAVE IT
2995 EEEEEEEEEEEEEEEE
2996LNLOOP, TAD LNARG+1 /FOR FURTHER REDUCTION OF THE ARGUMENT
2997 AND BIT234 /SELECT THE APPROPRIATE MULTIPLIERS A(K)
2998 CLL RTR /AND THEIR LOGARITHMS FROM A TABLE,
2999 RTR /ACCORDING TO THE RANGE OF F.
3000 TAD (A0
3001 DCA PTAK
3002 L0004
3003 TAD PTAK
3004 DCA PTLNAK
3005 AAAAAAAAAAAAAAAA
3006 GET LNTEMP
3007 SUB I PTLNAK /SUBTRACT LN( A(K) ) TO COMPENSATE
3008 PUT LNTEMP
3009 GET I PTAK /THE MULTIPLICATION WITH A(K)
3010 MUL LNARG /F' = A(K)* .... *F
3011 PUT LNARG
3012 EEEEEEEEEEEEEEEE
3013 TAD ACX
3014 SNA CLA
3015 JMP LNLOOP /IT IS GUARANTEED, THAT AFTER NO MORE
3016 AAAAAAAAAAAAAAAA/THAN T H R E E E MULTIPLICATIONS
3017 SUB ONEPT0 /F' FITS IN THE RANGE
3018 PUT LNARG / 0 <= F'-1 < 2^(-5)
3019 MUL LTC6 /NOW COMPUTE LN(F') VIA TAYLOR SERIES
3020 ADD LTC5
3021 MUL LNARG
3022 ADD LTC4
3023 MUL LNARG
3024 ADD LTC3
3025 MUL LNARG
3026 ADD LTC2
3027 MUL LNARG
3028 ADD ONEPT0
3029 MUL LNARG
3030 ADD LNTEMP /LN(X) = N*LN(2) - LN(A(K)) ... + LN(F')
3031 EEEEEEEEEEEEEEEE
3032 JMP I XLOG
3033
3034BIT234, 1600 /MASK TO EXTRACT BITS 00XXX0000000
3035PTAK, A0 /POINTER INTO TABLE
3036PTLNAK, LNA0 / --- " ---
3037
3038LNARG, 0 /ARGUMENT REGISTER
3039 0
3040 0
3041 0
3042
3043LNTEMP, 0 /TEMPORARY
3044 0
3045 0
3046 0
3047
3048LN2, 0000 /0.69314718
3049 2613
3050 4413
3051 7676
3052
3053LTC6, 7776 / -1/6
3054 6525
3055 2525
3056 2525
3057
3058LTC5, 7776 / 1/5
3059 3146
3060 3146
3061 3146
3062
3063LTC4, 7777 / -1/4
3064 6000
3065 0000
3066 0000
3067
3068LTC3, 7777 / 1/3
3069 2525
3070 2525
3071 2525
3072
3073LTC2, 0000 / -1/2
3074 6000
3075 0000
3076 0000
3077\f
3078/****************************************
3079/ E X P O N E N T I A L F U N C T I O N
3080/
3081/ AC := EXP(AC)
3082/****************************************
3083
3084
3085ONEPT0,
3086EX0B8, 0001 / 2^(0/8) = 1
3087 2000
3088 0000
3089 0000
3090
3091EX1B8, 0001 / 2^(1/8)
3092 2134
3093 5340
3094 7437
3095
3096EX2B8, 0001 / 2^(2/8)
3097 2301
3098 5770
3099 1214
3100
3101EX3B8, 0001 / 2^(3/8)
3102 2457
3103 7553
3104 2515
3105
3106EX4B8, 0001 / 2^(4/8)
3107 2650
3108 1171
3109 4637
3110
3111EX5B8, 0001 / 2^(5/8)
3112 3053
3113 1625
3114 0212
3115
3116EX6B8, 0001 / 2^(6/8)
3117 3272
3118 1176
3119 3126
3120
3121EX7B8, 0001 / 2^(7/8)
3122 3526
3123 0143
3124 3476
3125
3126
3127 PAGE
3128
3129
3130
3131XEXP, 0
3132 DCA TWO2N
3133 TAD (ONEPT0
3134 DCA TWO2M8
3135 AAAAAAAAAAAAAAAA
3136 SKNE
3137 JMP EXP0 /EXP(0)=1
3138 MUL LOG2E /X*LB(2) .... EXP(X) = 2^(X*LB(2))
3139 PUT EXTEMP
3140 TRUNC /SPLIT PRODUCT INTO
3141 PUT INT&TWO2N-3 /INTEGER PART N
3142 FLOAT
3143 SUB EXTEMP /AND FRACTION F (0 <= F < 1)
3144 NEGATE
3145 SKLT
3146 JMP .+7
3147 ADD ONEPT0
3148 EEEEEEEEEEEEEEEE
3149 TAD TWO2N
3150 CMA
3151 DCA TWO2N
3152 AAAAAAAAAAAAAAAA
3153 SKNE
3154 JMP EXP0
3155 EEEEEEEEEEEEEEEE
3156 L0003
3157 TAD ACX
3158 SPA SNA /IF F>=1/8 THEN SPLIT F INTO
3159 JMP APPROX
3160 CMA CLL / M/8 + R (0 < M < 8, 0 <= R < 1/8)
3161 DCA EXREST
3162 DOUBLE
3163 ISZ EXREST
3164 JMP .-2
3165 TAD AC0
3166 CLL RTL
3167 TAD (ONEPT0
3168 DCA TWO2M8 /POINT TO 2^(M/8) IN TABLE
3169 DCA AC0
3170 TAD (-4
3171 DCA ACX
3172 JMS RNORM /NORMALIZE
3173APPROX, AAAAAAAAAAAAAAAA/COMPUTE 2^R BY A CONTINUED FRACTION
3174 SKNE
3175 JMP EXP0
3176 PUT EXREST
3177 GET EXD3
3178 DIV EXREST
3179 ADD EXREST
3180 PUT EXTEMP
3181 GET EXC3
3182 DIV EXTEMP
3183 SUB EXREST
3184 ADD EXB3
3185 PUT EXTEMP
3186 GET EXA3
3187 DIV EXTEMP
3188 SUB ONEPT0
3189 SKIP
3190EXP0, GET ONEPT0
3191 MUL I TWO2M8 /MULTIPLY WITH 2^(M/8)
3192 EEEEEEEEEEEEEEEE
3193 TAD ACX
3194 TAD TWO2N /INSERT 2^N
3195 DCA ACX
3196 JMS RNORM /CHECK FOR OVERFLOW
3197 JMP I XEXP /EXP(X) = 2^N * 2^(M/8) * 2^R
3198
3199TWO2M8, 0 /POINTER TO TABLE
3200
3201EXTEMP, 0 /ARGUMENT AND TEMPORARY
3202 0
3203 0
3204 0
3205
3206EXREST, 0 /TEMPORARY REGISTER
3207 0
3208 0
3209 0
3210TWO2N, 0000 /HOLDS N (MUST BE HERE!!!)
3211
3212LOG2E, 0001 /1.442695040889
3213 2705
3214 2435
3215 4512
3216
3217EXA3, 0006 /34.624680981335
3218 2123
3219 7726
3220 1367
3221
3222EXB3, 0005 /17.312340490668
3223 2123
3224 7726
3225 1367
3226
3227EXC3, 0007 /-104.068449050280
3228 7201
3229 0605
3230 7007
3231
3232EXD3, 0005 /20.813689810056
3233 2464
3234 0467
3235 7155
3236\f
3237/****************************
3238/ S I N E AND C O S I N E
3239/
3240/ AC := SIN(AC)
3241/ AC := COS(AC) = SIN(AC+PI/2)
3242/****************************
3243
3244
3245XCOS, 0
3246 AAAAAAAAAAAAAAAA
3247 ADD PIS2
3248 EEEEEEEEEEEEEEEE
3249 JMS XSIN
3250 JMP I XCOS
3251
3252OPT5, 0000 /0.5
3253 2000
3254 0000
3255 0000
3256
3257PIS2, 0001 / PI/2
3258 3110
3259 3755
3260 2421
3261
3262PI, 0002 / PI
3263 3110
3264 3755
3265 2421
3266
3267COS2, 0003 /-PI^2/2!
3268 6357
3269 2363
3270 1157
3271
3272SIN3, 0003 /-PI^3/3!
3273 6452
3274 7363
3275 4611
3276
3277 PAGE
3278
3279COS4, 0003 / PI^4/4!
3280 2017
3281 0174
3282 1006
3283
3284SIN5, 0002 / PI^5/5!
3285 2431
3286 5361
3287 4734
3288
3289COS6, 0001 /-PI^6/6!
3290 6527
3291 2361
3292 7617
3293
3294SIN7, 0000 /-PI^7/7!
3295 6313
3296 2263
3297 1630
3298
3299COS8, 7776 / PI^8/8!
3300 3607
3301 6501
3302 5044
3303
3304SIN9, 7775 / PI^9/9!
3305 2501
3306 7015
3307 1040
3308
3309COS10, 7773 /-PI^10/10!
3310 7233
3311 2174
3312 5210
3313
3314SCARG=EXTEMP /ARGUMENT REGISTER
3315
3316
3317XSIN, 0
3318 TAD ACS /SIN(-X) = -SIN(X), THUS
3319 DCA SCS /SAVE SIGN
3320 DCA ACS /AND MAKE ARGUMENT POSITIVE
3321 AAAAAAAAAAAAAAAA/NOW REDUCE ARGUMENT:
3322 DIV PI / X/PI = N + F (0 <= F < 1)
3323 PUT SCARG /SIN(X) = (-1)^N * SIN(PI*F)
3324 TRUNC
3325 EEEEEEEEEEEEEEEE
3326 L0001
3327 AND AC3 /IF ODD(N) THEN CHANGE SIGN
3328 CLL RTR
3329 TAD SCS
3330 DCA SCS
3331 AAAAAAAAAAAAAAAA
3332 FLOAT
3333 SUB SCARG /-F
3334 SKNE
3335 JMP SCRET
3336 EEEEEEEEEEEEEEEE
3337 TAD ACX
3338 SZA CLA /IF F>=0.5 THEN
3339 JMP .+4
3340 AAAAAAAAAAAAAAAA
3341 ADD ONEPT0 /F := 1 - F
3342 EEEEEEEEEEEEEEEE/ SIN(PI*F) = SIN(PI*(1-F))
3343 DCA ACS /NOW ARG. REDUCED TO 0 <= F <= 0.5
3344 L0002
3345 TAD ACX
3346 SPA CLA /IF F<0.125
3347 JMP TAYSIN /THEN USE SINE-SERIES
3348 AAAAAAAAAAAAAAAA/ELSE SIN(PI*F) = COS(PI*(0.5-F))
3349 SUB OPT5
3350 EEEEEEEEEEEEEEEE
3351 DCA ACS /F := 0.5 - F
3352 L0002
3353 TAD ACX
3354 SPA CLA /IF F<0.125
3355 JMP TAYCOS-1 /THEN USE COSINE-SERIES DIRECTLY
3356 L7777 /ELSE COS(PI*F) = 2 * COS(PI*F/2)^2 - 1
3357 TAD ACX
3358 DCA ACX /F := F/2 (1/16 <= F <= 3/16)
3359 L7777
3360 DCA HFLAG /SET HALVE ARGUMENT FLAG
3361TAYCOS, AAAAAAAAAAAAAAAA
3362 PUT SCARG
3363 MUL SCARG
3364 PUT FQU /SQUARE ARG.
3365 MUL COS10
3366 ADD COS8
3367 MUL FQU
3368 ADD COS6
3369 MUL FQU
3370 ADD COS4
3371 MUL FQU
3372 ADD COS2
3373 MUL FQU
3374 ADD ONEPT0
3375 EEEEEEEEEEEEEEEE
3376 ISZ HFLAG /WAS F>=0.125?
3377 JMP SCRET+1
3378 AAAAAAAAAAAAAAAA/YES
3379 PUT FQU
3380 MUL FQU / (COS^2 -
3381 SUB OPT5 / - 0.5)
3382 EEEEEEEEEEEEEEEE
3383 ISZ ACX / *2
3384HFLAG, NOP
3385 JMP SCRET+1
3386TAYSIN, AAAAAAAAAAAAAAAA
3387 PUT SCARG
3388 MUL SCARG
3389 PUT FQU
3390 MUL SIN9
3391 ADD SIN7
3392 MUL FQU
3393 ADD SIN5
3394 MUL FQU
3395 ADD SIN3
3396 MUL FQU
3397 ADD PI
3398 MUL SCARG
3399SCRET, EEEEEEEEEEEEEEEE
3400 TAD AC1
3401 SZA CLA
3402 TAD SCS /INSERT SIGN (AVOID -0 !)
3403 DCA ACS
3404 JMP I XSIN
3405
3406SCS, 0 /SIGN OF RESULT
3407
3408FQU, 0 /TEMPORARY FOR SQUARES ARG.
3409 0
3410 0
3411 0
3412
3413 PAGE
3414\f
3415/********************
3416/ A R C T A N G E N T
3417/
3418/ AC := ARCTAN(AC)
3419/********************
3420
3421
3422
3423XATN, 0
3424 TAD ACX
3425 TAD (14
3426 SPA CLA /IF ARGUMENT VERY SMALL ( < 2^(-12) )
3427 JMP I XATN /THEN ARCTAN(X)=X
3428 TAD ACS
3429 DCA ATNS /SAVE SIGN ... ARCTAN(-X) = -ARCTAN(X)
3430 DCA ACS /AND MAKE ARGUMENT POSITIVE
3431 AAAAAAAAAAAAAAAA
3432 PUT ATARG
3433 EEEEEEEEEEEEEEEE
3434 TAD ACX
3435 SPA SNA CLA /IF X>=1
3436 JMP .+7
3437 AAAAAAAAAAAAAAAA
3438 GET ONEPT0 /THEN X := 1/X
3439 DIV ATARG /ARCTAN(X) = PI/2 - ARCTAN(1/X)
3440 PUT ATARG
3441 EEEEEEEEEEEEEEEE/NOW ARGUMENT REDUCED TO 0 < X <= 1
3442 L7777
3443 DCA GT1FLAG /FLAG ARGUMENT > 1
3444 TAD ACX
3445 SPA CLA /IF X>=0.5 THEN USE ADD.THEOREM:
3446 JMP ATN05
3447 ISZ ATARG /2*X
3448ADDFLAG,NOP
3449 AAAAAAAAAAAAAAAA/ARCTAN(X) = ARCTAN(0.5) + ARCTAN( ... )
3450 ADD TWOPT0 /X := (2*X-1)/(X+2)
3451 PUT EXTEMP
3452 GET ATARG
3453 SUB ONEPT0
3454 DIV EXTEMP
3455 PUT ATARG /ARGUMENT RANGE NOW 0 < X < 0.5
3456 EEEEEEEEEEEEEEEE
3457 L7777
3458ATN05, DCA ADDFLAG
3459 AAAAAAAAAAAAAAAA/COMPUTE ARCTAN(X) BY CONTINUED FRACTION
3460 MUL ATARG
3461 PUT FQU
3462 ADD ATB3
3463 PUT EXTEMP
3464 GET ATA3
3465 DIV EXTEMP
3466 ADD ATB2
3467 ADD FQU
3468 PUT EXTEMP
3469 GET ATA2
3470 DIV EXTEMP
3471 ADD ATB1
3472 ADD FQU
3473 PUT EXTEMP
3474 GET ATA1
3475 DIV EXTEMP
3476 ADD ATB0
3477 ADD FQU
3478 PUT EXTEMP
3479 GET ATA0
3480 MUL ATARG
3481 DIV EXTEMP
3482 EEEEEEEEEEEEEEEE
3483 ISZ ADDFLAG /CORRECT RESULT IF NECESSARY
3484 JMP .+4
3485 AAAAAAAAAAAAAAAA
3486 ADD ATN0P5
3487 EEEEEEEEEEEEEEEE
3488 ISZ GT1FLAG /WAS X>1 ?
3489 JMP .+6
3490 L4000 /YES
3491 DCA ACS / -ARCTAN(X)
3492 AAAAAAAAAAAAAAAA
3493 ADD PIS2 / +PI/2
3494 EEEEEEEEEEEEEEEE
3495 TAD ATNS
3496 DCA ACS /INSERT SIGN
3497 JMP I XATN
3498ATNS, 0 /TEMPORARY FOR SIGN
3499GT1FLAG,0
3500
3501ATARG, 0 /ARGUMENT REGISTER
3502 0
3503 0
3504 0
3505ATA0, 0004 /12.37469388
3506 3057
3507 7537
3508 4017
3509
3510ATA1, 0007 /-80.34270560
3511 6405
3512 3673
3513 4343
3514
3515ATA2, 0001 /-1.191447224
3516 6304
3517 0253
3518 6665
3519
3520ATA3, 7775 /-0.078335428
3521 6403
3522 3451
3523 4461
3524
3525ATB0, 0005 /26.27277525
3526 3221
3527 3522
3528 3121
3529
3530ATB1, 0003 /6.36441688
3531 3135
3532 1757
3533 0565
3534
3535ATB2, 0002 /2.104518952
3536 2065
3537 4070
3538 1015
3539
3540ATB3, 0001 /1.258464113
3541 2410
3542 5255
3543 0370
3544
3545ATN0P5, 7777 /ARCTAN(0.5)
3546 3553
3547 0634
3548 0530
3549
3550TWOPT0, 0002 /2.0
3551 2000
3552 0000
3553 0000
3554
3555 PAGE
3556\f/I N P U T - O U T P U T ROUTINES FOR STANDARD FILES
3557
3558GETC, 0
3559 CLA CLL
3560 TAD LOOK
3561 DCA CHAR
3562 ISZ IC3
3563 JMP G12
3564G3, L7775
3565 DCA IC3
3566 L7776
3567 TAD IBP
3568 DCA IBP
3569 TAD I IBP
3570 ISZ IBP
3571K377, AND (7400 /FIRST LITERAL ON THIS PAGE ---> 0377
3572 CLL RTL
3573 RTL
3574 DCA CHECK
3575 TAD I IBP
3576 AND (7400
3577 TAD CHECK
3578 RTL
3579 RTL
3580 RAL
3581 JMP GEXIT
3582G12, TAD IBP
3583 AND K377
3584 SZA CLA
3585 JMP GEXIT-1
3586 TAD (IBUFFER
3587 DCA IBP
3588 JMS I IDEVH
3589 0200
3590 IBUFFER
3591IBLOCK, 0
3592 JMP RDERR
3593 ISZ IBLOCK
3594 L7776
3595 DCA IC3
3596 TAD I IBP
3597GEXIT, ISZ IBP
3598 JMS CHECK
3599 JMP GETC+4
3600 JMP I GETC
3601RDERR, SMA CLA
3602 JMP GEXIT-3
3603FATAL0, FATAL /FATAL READ ERROR!
3604
3605IC3, -3
3606IBP, IBUFFER
3607
3608PUTC, 0
3609 SNA
3610 TAD CHAR
3611 DCA CHECK
3612 TAD CHECK
3613 ISZ OC3
3614 JMP PUT12
3615 DCA CC
3616 L7776
3617 TAD OBP
3618 DCA OBP
3619 JMS PUT3L
3620 JMS PUT3R
3621 L7775
3622 DCA OC3
3623 TAD OBP
3624 AND K377
3625 SZA CLA
3626 JMP PUXIT
3627 ISZ MBLOCKS
3628 SKP
3629 JMP ERRORD
3630 JMS I ODEVH
3631 4200
3632 OBUFFER
3633OBLOCK, 0
3634 JMP ERRORD
3635 ISZ OBLOCK
3636 TAD [OBUFFER
3637 DCA OBP
3638 JMP PUXIT
3639PUT12, AND K377
3640 DCA I OBP
3641 ISZ OBP
3642PUXIT, TAD CHECK
3643 TAD [-215
3644 SZA CLA
3645 JMP I PUTC
3646 TAD [212
3647 JMP PUTC+1
3648
3649PUT3L,
3650PUT3R, 0
3651 TAD CC
3652 CLL RTL
3653 RTL
3654 DCA CC
3655 TAD CC
3656 AND (7400
3657 TAD I OBP
3658 DCA I OBP
3659 ISZ OBP
3660 JMP I PUT3R
3661
3662/OC3, 0 /ON PAGE 0!
3663/OBP, 0 / - " -
3664CHECK, 0
3665 AND [177
3666 SNA
3667 JMP I CHECK
3668 TAD (-15
3669 SNA
3670 JMP CR
3671 TAD (15-32
3672 SNA
3673 JMP CR-2
3674 TAD (-6
3675 CLL
3676 TAD [240
3677 DCA LOOK
3678CHEXIT, DCA EOLN
3679 SNL
3680 ISZ CHECK
3681 JMP I CHECK
3682
3683 L0001 /END OF FILE
3684 DCA EOF
3685CR, TAD [240 /END OF LINE
3686 DCA LOOK
3687 L0001 /LINK=0!
3688 JMP CHEXIT
3689
3690 PAGE
3691\f/THE ORGANIZATION OF THE FOLLOWING PAGES OF FIELD 0
3692/DEMANDS SOME EXPLANATION:
3693
3694
3695
3696/ AT COMPILE TIME / AT RUNTIME /
3697/ / /
3698/06000--------------------------/-------------------------------/
3699/ STARTUP CODE, THEN / /
3700/ / I N P U T /
3701/06200- I N P U T (SOURCE) -----/----- -----/
3702/ F I L E B U F F E R / F I L E B U F F E R /
3703/ / /
3704/06400--------------------------/-------------------------------/
3705/ / INPUT /
3706/ I N P U T (SOURCE) / DEVICE HANDLER /
3707/06600- -----/-------------------------------/
3708/ D E V I C E / OUTPUT /
3709/ H A N D L E R / DEVICE HANDLER /
3710/07000--------------------------/-------------------------------/
3711/ / /
3712/ COMPILER PROCEDURES: / O U T P U T /
3713/07200----- -----/----- -----/
3714/ I N S Y M B O L / F I L E B U F F E R /
3715/ / /
3716/07400----- AND -----/-------------------------------/
3717/ / RUNTIME ERRORS /
3718/ N E X T C H / /
3719/-------------------------------/-------------------------------/
3720
3721
3722
3723/AT COMPILATION TIME FOUR PAGES OF FIELD 6 ARE USED AS FOLLOWS:
3724
3725/66400--- TEMPORARY STORAGE OF INPUT DEVICE HANDLER
3726/
3727/66600--- TEMPORARY STORAGE OF OUTPUT DEVICE HANDLER
3728/
3729/67400--- RUNTIME ERRORS
3730/
3731/67600--- INITIALIZATION OF RUNTIME SYSTEM
3732
3733
3734
3735/DURING INITIALIZATION OF THE RUNTIME SYSTEM
3736/THE FIRST THREE PAGES ARE SWAPPED INTO THEIR PLACE IN FIELD 0!
3737\f/#############################################################/
3738/#############################################################/
3739/##### #####/
3740/##### S T A R T #####/
3741/##### #####/
3742/#############################################################/
3743/#############################################################/
3744
3745
3746
3747/IMPORTANT POINTS OF PROGRAM FLOW:
3748
3749
3750/S T A R T (06000) /STARTING ADDRESS OF ENTIRE SYSTEM,
3751 /PROCESS I/O-SPECIFICATIONS
3752
3753/M A I N (40200) /START OF COMPILER PROGRAM
3754
3755
3756/E X P L A I N (60200) /COMPILATION REPORT
3757
3758
3759/I N I T (67600) /INITIALIZATION OF RUNTIME SYSTEM
3760
3761
3762/I S T A R T (00200) /START OF INTERPRETER
3763
3764
3765
3766
3767/ONCE ONLY CODE!!!
3768
3769USR=200
3770
3771 *IBUFFER
3772START, CLA CLL /S T A R T I N G A D D R E S S
3773 CIF 10
3774 JMS I [7700 /LOCK USR IN MEMORY
3775 10
3776 TAD (1000 /RESET JOB STATUS WORD
3777 DCA I (7746
3778CD, CIF 10
3779 JMS I (USR /CALL THE COMMAND DECODER
3780 5
3781 2023 /ASSUMED INPUT EXTENSION: .PS
3782 0 /PHPH KEEP TENTATIVE FILES (ZERO)
3783 JMS HEADER
3784 CDF 10
3785 CLA CLL /PHPH
3786 TAD I (7600 /GET FIRST OUTPUT DEVICE AND LENGTH
3787 AND (0017 /MASK OUT A SIZE (DEV:FILE.EX[SIZE])
3788 SNA /OUTPUT FILE SPECIFIED?
3789 JMP NOOUT
3790 DCA DEVNO /YES, SAVE DEVICE NUMBER
3791 TAD (7600
3792 DCA XR10
3793 TAD I XR10 /TRANSFER THE FILENAME
3794 DCA NAME
3795 TAD I XR10
3796 DCA NAME+1
3797 TAD I XR10
3798 DCA NAME+2
3799 TAD I XR10
3800 DCA NAME+3
3801 CDF 0
3802 CIF 10
3803 TAD DEVNO /DEVICE NUMBER
3804 JMS I (USR /FETCH OUTPUT DEVICE HANDLER
3805 1 /OPERATION: FETCH HANDLER
3806OHEP, ODEVBUF /1 PAGE ONLY!
3807 JMP CDERR
3808 CIF 10
3809 TAD DEVNO
3810 JMS I (USR /OPEN OUTPUT FILE
3811 3
3812SBNO, NAME
3813LEMP, 0
3814 JMP CDERR
3815 TAD OHEP /GET ENTRY POINT
3816 DCA ODEVH
3817 TAD SBNO /GET STARTING BLOCK NUMBER
3818 DCA I (OBLOCK
3819 TAD LEMP /GET LENGTH OF EMPTY
3820 DCA LEMPTY
3821 TAD LEMPTY
3822 SZA
3823 TAD (-1 /SETUP BLOCK COUNTER
3824 DCA MBLOCKS /(=0 IF NOT A FILE DEVICE)
3825 SKP
3826NOOUT, ISZ IHEP /ALLOW 2-PAGE INPUT HANDLER
3827 /IF NO OUTPUT FILE SPECIFIED!
3828 CDF 10
3829 TAD I (7621
3830 SNA /INPUT FILE SPECIFIED?
3831 JMP NOINP /NO, USE INTERN KEYBOARD HANDLER!
3832 CDF 0
3833 CIF 10
3834 JMS I (USR /FETCH INPUT DEVICE HANDLER
3835 1
3836IHEP, IDEVBUF
3837 JMP CDERR
3838 CDF 10
3839 TAD I (7622 /GET STARTING BLOCK NUMBER
3840 CDF 60
3841 DCA I (IIBLOCK
3842 TAD IHEP /GET ENTRY POINT
3843 DCA I (IIDEVH
3844NOINP, CDF 0 /SAVE DEVICE HANDLERS
3845 TAD I F0T6 /IN FIELD 6 TO MAKE ROOM
3846 CDF 60 /FOR HANDLER OF SOURCE FILE
3847 DCA I F0T6
3848 ISZ F0T6
3849 ISZ C400
3850 JMP .-6
3851 CDF 10
3852 TAD I (7617
3853 SNA /SOURCE FILE SPECIFIED?
3854 JMP CDERR
3855 CDF 0
3856 CIF 10
3857 JMS I (USR /FETCH HANDLER OF SOURCE FILE
3858 1
3859SHEP, IDEVBUF+1
3860 JMP CDERR
3861 TAD SHEP /GET ENTRY POINT
3862 DCA IDEVH
3863 CDF 10
3864 TAD I (7620
3865 CDF 0
3866 DCA I (IBLOCK
3867 JMP STARTC
3868
3869F0T6, IDEVBUF
3870C400, -400
3871
3872 PAGE
3873\fSTARTC, CDF 10 /CHECK /S - OPTION
3874 TAD I (7644
3875 CDF 0
3876 AND (40
3877 SNA CLA
3878 JMP .+3
3879 TAD (SPRINT
3880 DCA PTPRINT
3881 CDF CIF COMPFIELD
3882 JMP I (MAIN /START COMPILER
3883
3884CDERR, CLA CLL
3885 CDF CIF 0
3886 CRLF
3887 TAD I CTEXT
3888 SNA
3889 JMP .+7
3890 BSW
3891 JMS ASCII
3892 TAD I CTEXT
3893 JMS ASCII
3894 ISZ CTEXT
3895 JMP CDERR+3
3896 CRLF
3897 JMP I (7605
3898CTEXT, .+1
3899TEXT /DATEIANGABEN FEHLERHAFT BZW. UNVOLLSTAENDIG (EV. AUCH SYSTEMFEHLER)!/
3900 0
3901
3902 PAGE
3903\f/K E Y B O A R D I N P U T H A N D L E R
3904
3905 *IDEVBUF
3906XREAD, 0
3907 CLA CLL
3908 TAD LOOK
3909 DCA CHAR
3910 TAD EOLN
3911 SZA CLA
3912 JMP XLINE
3913REXIT, TAD I BP
3914 ISZ BP
3915 JMS CHECK
3916 JMP .-3
3917 JMP I XREAD
3918ERASE, TAD [215
3919 JMS I ZPRINT
3920XLINE, TAD (IBUFFER
3921 DCA BP
3922 TAD ("?
3923 JMS I ZPRINT
3924 TAD [240
3925 JMS I ZPRINT
3926XCHAR, JMS KEYBOARD
3927 DCA I BP
3928 TAD I BP
3929 TAD (-377
3930 SNA CLA / 'RUBOUT'?
3931 JMP RUBOUT
3932 TAD I BP
3933 TAD (-203
3934 SNA / 'CTRL-C'?
3935 JMP I OS8
3936 TAD (203-212
3937 SNA / 'LINE FEED'?
3938 JMP REPLAY
3939 TAD (212-215
3940 SNA / 'RETURN'?
3941 JMP RETURN
3942 TAD (215-225
3943 SNA / 'CTRL-U'?
3944 JMP ERASE
3945 TAD (225-232
3946 SNA / 'CTRL-Z'?
3947 JMP EOFILE
3948 TAD (232-240
3949 SPA CLA
3950 JMP XCHAR
3951 TAD I BP
3952 JMS I ZPRINT
3953 ISZ BP
3954 JMP XCHAR
3955
3956RUBOUT, TAD ("\
3957 JMS I ZPRINT
3958 TAD BP
3959 TAD (-IBUFFER
3960 SNA CLA
3961 JMP YCHAR
3962 L7777
3963 TAD BP
3964 DCA BP
3965 TAD I BP
3966 JMS I ZPRINT
3967YCHAR, JMS KEYBOARD
3968 DCA I BP
3969 TAD I BP
3970 TAD (-377
3971 SNA CLA
3972 JMP RUBOUT+2
3973 TAD ("\
3974 JMS I ZPRINT
3975 JMP XCHAR+2
3976
3977REPLAY, TAD BP
3978 TAD (-IBUFFER
3979 SNA
3980 JMP XCHAR
3981 CIA
3982 DCA RC
3983 TAD (IBUFFER
3984 DCA BP
3985 TAD [215
3986 JMS I ZPRINT
3987 TAD ("?
3988 JMS I ZPRINT
3989 TAD [240
3990 JMS I ZPRINT
3991 TAD I BP
3992 JMS I ZPRINT
3993 ISZ BP
3994 ISZ RC
3995 JMP .-4
3996 JMP XCHAR
3997
3998EOFILE, TAD [240
3999 JMS I ZPRINT
4000 TAD ("E
4001 JMS I ZPRINT
4002 TAD ("O
4003 JMS I ZPRINT
4004 TAD ("F
4005 JMS I ZPRINT
4006RETURN, TAD [215
4007 JMS I ZPRINT
4008 TAD (IBUFFER
4009 DCA BP
4010 JMP REXIT
4011
4012KEYBOARD,0
4013 KSF
4014 JMP .-1
4015 KRB
4016 AND [177
4017 SNA
4018 JMP KEYBOARD+1
4019 TAD (200
4020 JMP I KEYBOARD
4021
4022BP, IBUFFER
4023RC=KEYBOARD
4024
4025 PAGE
4026\f/H E A D E R L I N E
4027
4028 *ODEVBUF
4029HEADER, 0 /ONCE ONLY CODE!
4030 CDF 10
4031 TAD I (7666 /GET DATE WORD FROM MONITOR
4032 CDF 0
4033 SNA
4034 JMP WHEAD-1
4035 MQL
4036 TAD (HDATE
4037 DCA XR10
4038 MQA /YEAR
4039 AND (7
4040 TAD (116 /78
4041 JMS YYMMDD
4042 MQA /MONTH
4043 BSW
4044 RTR
4045 AND (17
4046 JMS YYMMDD
4047 MQA /DAY
4048 RTR
4049 RAR
4050 AND (37
4051 JMS YYMMDD
4052 SKP
4053 DCA HDATE
4054WHEAD, TAD (PASCAL-1
4055 DCA XR10
4056 TAD I XR10
4057 SNA
4058WHEND, JMP .+3 /BECOMES: JMP WHEXIT
4059 PRINTC
4060 JMP .-4
4061 TAD H240
4062 PRINTC
4063 ISZ BLANKS
4064 JMP .-3
4065 TAD (JMP WHEXIT
4066 DCA WHEND
4067 JMP WHEAD+2
4068WHEXIT, CRLF
4069 CRLF
4070 JMP I HEADER
4071
4072YYMMDD, 0
4073 DCA DAT01
4074 DCA DAT10
4075 JMP .+3
4076 DCA DAT01
4077 ISZ DAT10
4078 TAD DAT01
4079 TAD (-12
4080 SMA
4081 JMP .-5
4082 CLA
4083 ISZ XR10
4084 TAD DAT10
4085 TAD H260
4086 DCA I XR10
4087 TAD DAT01
4088 TAD H260
4089 DCA I XR10
4090 JMP I YYMMDD
4091
4092H215=.
4093PASCAL, 215;"P;240;"A;240;"S;240;"C;240;"A;240;"L
4094 240;"-;240;"S;240;240;240
4095 "C;"O;"M;"P;"I;"L;"E;"R
4096H240, 240
4097 "V
4098H260, "0
4099 VERSION+"0
4100 0000
4101HTLMOE, "H;"T;"L;"-;"M;"O;"E;"D;"L;"I;"N;"G
4102HDATE, ", /BECOMES: 0000 IF NO DATE SPECIFIED
4103 240
4104 0000 /YEAR
4105 0000
4106 "-
4107 0000 /MONTH
4108 0000
4109 "-
4110DAT10, 0000 /DAY
4111DAT01, 0000
4112BLANKS, -30 /BECOMES 0000
4113
4114 PAGE
4115\f/BEGIN OF COMPILER PROGRAM: T H E S C A N N E R
4116
4117NEXTCH=READC
4118
4119SY0=H1 /FIELD 0 REPRESENTATIVE OF 'SY'
4120KSY=H2
4121SPS=H3
4122K=H4
4123INTORINP=PC
4124
4125 *7000
4126INSY0, SKP CLA
4127 NEXTCH
4128 TAD CHAR
4129 TAD [-240
4130 SNA CLA
4131 JMP .-4
4132 SNALF
4133 JMP WSYMBOL
4134 SKDIG
4135 JMP SPSYM
4136NUMBER, TAD (FRACTN
4137 DCA INTORINP
4138 DCA SY0 /0=INTCON
4139 JMS IINP
4140 TAD CHAR
4141 TAD (-".
4142 SZA CLA
4143 JMP ECHAR
4144 NEXTCH
4145 TAD CHAR
4146 TAD (-".
4147 SNA CLA
4148 JMP RETNUM-2
4149REALGO, L0001
4150 DCA SY0 /1=REALCON
4151 TAD OC
4152 CIA
4153 DCA DC
4154 JMP I INTORINP
4155ECHAR, ISZ INTORINP
4156 TAD CHAR
4157 TAD (-"E
4158 SNA CLA
4159 JMP REALGO
4160 JMP RETNUM
4161 TAD (":
4162 DCA CHAR
4163RETNUM, JMS PACK
4164 TAD (NUM-1
4165RETID, DCA XR10
4166 CDF COMPFIELD
4167 TAD AC0
4168 DCA I XR10
4169 TAD AC1
4170 DCA I XR10
4171 TAD AC2
4172 DCA I XR10
4173 TAD AC3
4174 DCA I XR10
4175RETSYM, TAD SY0
4176 CDF CIF COMPFIELD
4177 JMP I (EXSY3
4178WSYMBOL,DCA K /USE AC FOR ID IN FIELD 0
4179 CLEAR
4180AZ09, TAD K
4181 TAD (-ALNG
4182 SMA CLA
4183 JMP .+4
4184 L0100 /=2*AC0, LINK=0
4185 JMS CPACK
4186 ISZ K
4187 NEXTCH
4188 SKDIG
4189 SNALF
4190 JMP AZ09
4191 L0001 /BUILD HASH-CODE
4192 TAD AC0
4193 BSW
4194 RTL
4195 CLA
4196 TAD AC0
4197 BSW
4198 TAD AC1
4199 AND [77
4200 RAL
4201 MQL /IN MQ
4202 MQA
4203 TAD (KSYTABLE
4204 DCA KSY
4205 MQA
4206 CLL RTL
4207 TAD (HASHTABLE-1
4208 DCA XR10
4209 CDF NAMEFIELD
4210 TAD I XR10
4211 CIA
4212 TAD AC0
4213 SZA CLA
4214 JMP XIDENT
4215 TAD I XR10
4216 CIA
4217 TAD AC1
4218 SZA CLA
4219 JMP XIDENT
4220 TAD I XR10
4221 CIA
4222 TAD AC2
4223 SZA CLA
4224 JMP XIDENT
4225 TAD I XR10
4226 CIA
4227 TAD AC3
4228 SZA CLA
4229 JMP XIDENT
4230 TAD I KSY
4231 JMP RETSYM+1
4232XIDENT, TAD (IDENT
4233 DCA SY0
4234 TAD (ID-1
4235 JMP RETID
4236
4237 PAGE
4238\fSPSYM, TAD CHAR
4239 TAD (CHARTABLE-240
4240 DCA SPS
4241 CDF NAMEFIELD
4242 TAD I SPS
4243 CDF 0
4244 SNA
4245 JMP ILLCHAR
4246 SPA
4247 JMP DBLCHAR
4248RETSPS, DCA SY0
4249 NEXTCH
4250 TAD SY0
4251RETSNGL,CDF CIF COMPFIELD
4252 JMP I (EXSY3
4253ILLCHAR,ERROR;30 /24
4254 JMP I (INSY0+1
4255DBLCHAR,DCA .+3
4256 NEXTCH
4257 TAD CHAR
4258 HLT /JMP X
4259
4260JMPCOL=JMP .
4261CCOL, TAD (-"=
4262 SZA CLA
4263 JMP .+3
4264 TAD (BECOMES
4265 JMP RETSPS
4266 TAD (COLON
4267 JMP RETSNGL
4268
4269JMPLSS=JMP .
4270CLSS, TAD (-"=
4271 SNA
4272 JMP .+6
4273 TAD ("=-">
4274 SNA CLA
4275 JMP .+4
4276 TAD (LSS
4277 JMP RETSNGL
4278 L0004 /LEQ=NEQ+4
4279 TAD (NEQ
4280 JMP RETSPS
4281
4282JMPGTR=JMP .
4283CGTR, TAD (-"=
4284 SNA CLA
4285 JMP .+3
4286 TAD (GTR
4287 JMP RETSNGL
4288 TAD (GEQ
4289 JMP RETSPS
4290
4291JMPPER=JMP .
4292CPER, TAD (-".
4293 SNA CLA
4294 JMP .+3
4295 TAD (PERIOD
4296 JMP RETSNGL
4297 TAD (COLON
4298 JMP RETSPS
4299
4300JMPLPAR=JMP .
4301CLPAR, TAD (-"*
4302 SNA CLA
4303 JMP .+3
4304 TAD (LPARENT
4305 JMP RETSNGL
4306 NEXTCH
4307 TAD CHAR
4308 TAD (-"*
4309 SZA CLA
4310 JMP .-4
4311 NEXTCH
4312 TAD CHAR
4313 TAD (-")
4314 SZA CLA
4315 JMP .-10
4316 JMP I (INSY0+1
4317
4318
4319JMPAPOS=JMP I .
4320 CAPOS
4321
4322
4323CPACK, 0
4324 TAD K
4325 RAR
4326 DCA CPP
4327 TAD CHAR
4328 AND [77
4329 SZL
4330 JMP .+3
4331 BSW
4332 JMP .+5
4333 MQL
4334 TAD I CPP
4335 AND [7700
4336 MQA
4337 DCA I CPP
4338 CDF 0
4339 JMP I CPACK
4340CPP, 0
4341
4342
4343XSNALF, 0
4344 TAD CHAR
4345 TAD (-"Z-1
4346 CLL
4347 TAD ("Z+1-"A
4348 SNL CLA
4349 ISZ XSNALF
4350 JMP I XSNALF
4351
4352 PAGE
4353\fDISPLAY=7400
4354
4355/-------- D I S P L A Y --------/
4356
4357/DISPLAY,ZBLOCK 20 /AT RUNTIME ONLY
4358
4359/---------------------------------/
4360
4361
4362CAPOS, AND [77
4363 LOAD
4364 DCA K
4365 SKP
4366LBL2, NEXTCH
4367 TAD CHAR
4368 TAD (-""
4369 SZA CLA
4370 JMP .+6
4371 NEXTCH
4372 TAD CHAR
4373 TAD (-""
4374 SZA CLA
4375 JMP LBL3
4376 STL
4377 CDF COMPFIELD
4378 TAD I (SX
4379 CDF TABLEFIELD
4380 JMS CPACK
4381 ISZ K
4382 TAD EOLN
4383 SNA CLA
4384 JMP LBL2
4385 DCA K
4386LBL3, L0002 /2=CHARCON
4387 DCA SY0
4388 L7777
4389 TAD K
4390 SNA
4391 JMP RETNUM
4392 SPA CLA
4393 JMP ERR38
4394 ISZ SY0 /3=STRING
4395 CDF COMPFIELD
4396 TAD I (SX
4397 LOAD
4398 TAD K
4399 DCA I (SLENG
4400 TAD I (SX
4401 TAD K
4402 DCA I (SX
4403 TAD I (SX
4404 STL RAR
4405 CIA
4406 TAD I (C
4407 SPA CLA
4408FATAL7, FATAL
4409 JMP RETNUM
4410ERR38, ERROR;46 /38
4411 JMP .+3
4412ERR21, ERROR;25 /21
4413 CLEAR
4414 JMP RETNUM
4415
4416
4417ZERROR, 0
4418 CLA CLL
4419 TAD I ZERROR
4420 CIF SETFIELD
4421 JMS I (F3ERROR
4422 JMP I ZERROR
4423
4424ZFATAL, 0
4425 TAD ZFATAL
4426 CDF CIF SETFIELD
4427 JMP I (F3FATAL
4428\fXNEXTCH,0
4429 BREAK
4430 ISZ LL
4431 JMP NCH
4432 TAD ERRSW
4433 SNA CLA
4434 JMP NLN
4435 TAD (ERRLINE-1
4436 DCA XR10
4437 CDF SETFIELD
4438 TAD I XR10
4439 CDF 0
4440 TAD [240
4441 PRINTC
4442 ISZ ERRSW
4443 JMP .-6
4444 CRLF
4445NLN, TAD EOF
4446 SZA CLA
4447FATAL9, FATAL /PROGRAM INCOMPLETE!
4448 DCA CC
4449 TAD (5
4450 DCA M
4451 CDF COMPFIELD
4452 TAD I (LC
4453 CDF 0
4454 LOAD
4455 JMS IOUT
4456 PRINTC /CHAR = 240 !
4457 PRINTC
4458NCH, ISZ CC
4459 TAD EOLN
4460 SNA CLA
4461 JMP .+6
4462 CRLF
4463 L7777
4464 DCA LL
4465 JMS GETC
4466 JMP I XNEXTCH
4467 JMS GETC
4468 PRINTC
4469 JMP I XNEXTCH
4470LL, 0
4471
4472 PAGE
4473\f FIELD 2
4474
4475 *TAB
4476
4477/ENTRIES FOR PREDEFINED SYMBOLS:
4478
4479-1; VARIABLE^100+NOTYP; 0040; 0
44800; KONSTANT^100+BOOLS; 0040; 0
44811; KONSTANT^100+BOOLS; 0040; 1
44822; TYPE1^100+REALS; 0040; 1
44833; TYPE1^100+CHARS; 0040; 1
44844; TYPE1^100+BOOLS; 0040; 1
44855; TYPE1^100+INTS; 0040; 1
44866; FUNKTION^100+REALS; 0040; 0
44877; FUNKTION^100+REALS; 0040; 2
448810; FUNKTION^100+BOOLS; 0040; 4
448911; FUNKTION^100+CHARS; 0040; 5
449012; FUNKTION^100+INTS; 0040; 6
449113; FUNKTION^100+CHARS; 0040; 7
449214; FUNKTION^100+CHARS; 0040; 10
449315; FUNKTION^100+INTS; 0040; 11
449416; FUNKTION^100+INTS; 0040; 12
449517; FUNKTION^100+REALS; 0040; 13
449620; FUNKTION^100+REALS; 0040; 14
449721; FUNKTION^100+REALS; 0040; 15
449822; FUNKTION^100+REALS; 0040; 16
449923; FUNKTION^100+REALS; 0040; 17
450024; FUNKTION^100+REALS; 0040; 20
450125; FUNKTION^100+BOOLS; 0040; 21
450226; FUNKTION^100+BOOLS; 0040; 22
450327; PROZEDURE^100+NOTYP; 0040; 1
450430; PROZEDURE^100+NOTYP; 0040; 2
450531; PROZEDURE^100+NOTYP; 0040; 3
450632; PROZEDURE^100+NOTYP; 0040; 4
450733; PROZEDURE^100+NOTYP; 0040; 5
450834; PROZEDURE^100+NOTYP; 0040; 6
450935; FUNKTION^100+REALS; 0040; 23
451036; PROZEDURE^100+NOTYP; 0040; 0
4511\f FIELD 3
4512
4513/N A M E S OF S Y M B O L - T A B L E
4514
4515/THE FOLLOWING NAMES ARE PREDEFINED:
4516 *0
4517TEXT /@@@@@@@@/
4518 *.-1
4519TEXT /FALSE@@@/
4520 *.-1
4521TEXT /TRUE@@@@/
4522 *.-1
4523TEXT /REAL@@@@/
4524 *.-1
4525TEXT /CHAR@@@@/
4526 *.-1
4527TEXT /BOOLEAN@/
4528 *.-1
4529TEXT /INTEGER@/
4530 *.-1
4531TEXT /ABS@@@@@/
4532 *.-1
4533TEXT /SQR@@@@@/
4534 *.-1
4535TEXT /ODD@@@@@/
4536 *.-1
4537TEXT /CHR@@@@@/
4538 *.-1
4539TEXT /ORD@@@@@/
4540 *.-1
4541TEXT /SUCC@@@@/
4542 *.-1
4543TEXT /PRED@@@@/
4544 *.-1
4545TEXT /ROUND@@@/
4546 *.-1
4547TEXT /TRUNC@@@/
4548 *.-1
4549TEXT /SIN@@@@@/
4550 *.-1
4551TEXT /COS@@@@@/
4552 *.-1
4553TEXT /EXP@@@@@/
4554 *.-1
4555TEXT /LN@@@@@@/
4556 *.-1
4557TEXT /SQRT@@@@/
4558 *.-1
4559TEXT /ARCTAN@@/
4560 *.-1
4561TEXT /EOF@@@@@/
4562 *.-1
4563TEXT /EOLN@@@@/
4564 *.-1
4565TEXT /READ@@@@/
4566 *.-1
4567TEXT /READLN@@/
4568 *.-1
4569TEXT /WRITE@@@/
4570 *.-1
4571TEXT /WRITELN@/
4572 *.-1
4573TEXT /HALT@@@@/
4574 *.-1
4575TEXT /ASCII@@@/
4576 *.-1
4577TEXT /RANDOM@@/
4578 *.-1
4579TEXT /@@@@@@@@/
4580\f/F S Y S AND S E T - C O N S T A N T S
4581
4582 *4000
4583/----------------
4584FSYS, ZBLOCK 5 / M U S T BE AT 4000!!!
4585/----------------
4586
4587S1US2, ZBLOCK 5
4588
4589SET0, 0;0;0;0;0
4590SET1,
4591CONBGS, 7140;0000;0000;4000;0000
4592SET2,
4593TYPBGS, 0000;0000;0006;4000;0000
4594SET3,
4595BLOBGS, 0000;0000;0370;2000;0000
4596SET4,
4597FACBGS, 7200;0020;0000;4000;0000
4598SET5,
4599STATBGS,0000;0000;0000;3740;0000
4600SET6, 0000;0001;1000;0000;0000
4601SET7, 0000;0000;0370;6000;0000
4602SET8, 0140;0000;0000;0000;0000
4603SET9, 0000;0012;1000;0002;0000
4604SET10, 0000;0013;0000;0002;0000
4605SET11, 0000;0001;4000;4020;0000
4606SET12, 0000;0000;4000;4020;0000
4607SET13, 0000;0000;0040;4000;0000
4608SET14, 0000;0010;0000;0000;0000
4609SET15, 0000;0010;4000;0000;0000
4610SET16, 0000;0001;0000;4000;0000
4611SET17, 0000;0000;5000;0000;0000
4612SET18, 0000;0000;0000;4000;0000
4613SET19, 0000;0001;4000;4000;0000
4614SET20, 0000;0000;4000;0000;0000
4615SET21, 0000;0003;0000;0000;0000
4616SET22, 0000;0024;2000;0000;0000
4617SET23, 0000;0011;1000;0000;0000
4618SET24, 0000;0011;0000;0000;0000
4619SET25, 7000;0000;0000;0000;0000
4620SET26, 0037;0000;0000;0000;0000
4621SET27, 0140;4000;0000;0000;0000
4622SET28, 0000;3740;0000;0000;0000
4623SET29, 0000;2000;0400;0000;0000
4624SET30, 0000;0000;4000;0020;0000
4625SET31, 0000;0000;4000;3740;0000
4626SET32, 0000;0000;0000;0001;1000
4627SET33, 0000;0000;0000;0010;0000
4628SET34, 0000;0001;1000;0002;0000
4629SET35, 0000;0000;4000;0004;0000
4630SET36, 0000;0000;0000;0001;0000
4631SET37, 0000;0000;0400;0001;6000
4632SET38, 0000;0000;0000;0001;6000
4633SET39, 0000;0000;0000;0000;6000
4634SET40, 0000;0000;0000;7740;0000
4635SET41, 0000;0020;5000;0000;0000
4636SET42, 0000;0000;0030;0000;0000
4637SET43, 0000;0000;0000;2000;0000
4638SET44, 0000;0000;0370;3740;0000
4639SET45, 0000;0000;2000;0000;0000
4640SET46, 0000;0001;4000;4000;0000
4641\f/WORD- AND BIT-POSITION TABLE USED BY SET-ROUTINES:
4642
4643SETTABL,0;4000
4644 0;2000
4645 0;1000
4646 0;0400
4647 0;0200
4648 0;0100
4649 0;0040
4650 0;0020
4651 0;0010
4652 0;0004
4653 0;0002
4654 0;0001
4655
4656 1;4000
4657 1;2000
4658 1;1000
4659 1;0400
4660 1;0200
4661 1;0100
4662 1;0040
4663 1;0020
4664 1;0010
4665 1;0004
4666 1;0002
4667 1;0001
4668
4669 2;4000
4670 2;2000
4671 2;1000
4672 2;0400
4673 2;0200
4674 2;0100
4675 2;0040
4676 2;0020
4677 2;0010
4678 2;0004
4679 2;0002
4680 2;0001
4681
4682 3;4000
4683 3;2000
4684 3;1000
4685 3;0400
4686 3;0200
4687 3;0100
4688 3;0040
4689 3;0020
4690 3;0010
4691 3;0004
4692 3;0002
4693 3;0001
4694
4695 4;4000
4696 4;2000
4697 4;1000
4698 4;0400
4699 4;0200
4700 4;0100
4701 4;0040
4702 4;0020
4703 4;0010
4704 4;0004
4705 4;0002
4706 4;0001
4707\f/H A S H - T A B L E OF K E Y W O R D S
4708
4709HASHTABLE=.
4710
4711DECIMAL /ADDRESSES SPECIFIED IN DECIMAL!
4712
4713 ZBLOCK 128^4 /CLEAR UNUSED LOCATIONS!
4714
4715KSYTABLE=. /REMEMBER END OF HASHTABLE
4716
4717 *2^4+HASHTABLE
4718TEXT /AND/
4719 *5^4+HASHTABLE
4720TEXT /ARRAY/
4721 *8^4+HASHTABLE
4722TEXT /DIV/
4723 *9^4+HASHTABLE
4724TEXT /DO/
4725 *10^4+HASHTABLE
4726TEXT /END/
4727 *13^4+HASHTABLE
4728TEXT /FOR/
4729 *16^4+HASHTABLE
4730TEXT /CASE/
4731 *18^4+HASHTABLE
4732TEXT /IF/
4733 *19^4+HASHTABLE
4734TEXT /FUNCTION/
4735 *20^4+HASHTABLE
4736TEXT /ELSE/
4737 *22^4+HASHTABLE
4738TEXT /BEGIN/
4739 *27^4+HASHTABLE
4740TEXT /MOD/
4741 *29^4+HASHTABLE
4742TEXT /NOT/
4743 *30^4+HASHTABLE
4744TEXT /OF/
4745 *31^4+HASHTABLE
4746TEXT /OR/
4747 *37^4+HASHTABLE
4748TEXT /DOWNTO/
4749 *39^4+HASHTABLE
4750TEXT /PROCEDUR/
4751 *41^4+HASHTABLE
4752TEXT /TO/
4753 *44^4+HASHTABLE
4754TEXT /VAR/
4755 *45^4+HASHTABLE
4756TEXT /CONST/
4757 *46^4+HASHTABLE
4758TEXT /REPEAT/
4759 *47^4+HASHTABLE
4760TEXT /PROGRAM/
4761 *51^4+HASHTABLE
4762TEXT /TYPE/
4763 *60^4+HASHTABLE
4764TEXT /UNTIL/
4765 *66^4+HASHTABLE
4766TEXT /RECORD/
4767 *68^4+HASHTABLE
4768TEXT /THEN/
4769 *70^4+HASHTABLE
4770TEXT /WHILE/
4771\f/S Y M B O L - V A L U E S OF K E Y W O R D S
4772
4773 *KSYTABLE
4774 ZBLOCK 128 /FOR SAFETY!
4775PUSHTABLE=. /REMEMBER END OF KSYTABLE
4776
4777 *2+KSYTABLE
4778ANDSY
4779 *5+KSYTABLE
4780ARRAYSY
4781 *8+KSYTABLE
4782IDIVSY
4783 *9+KSYTABLE
4784DOSY
4785 *10+KSYTABLE
4786ENDSY
4787 *13+KSYTABLE
4788FORSY
4789 *16+KSYTABLE
4790CASESY
4791 *18+KSYTABLE
4792IFSYM
4793 *19+KSYTABLE
4794FUNCTIONSY
4795 *20+KSYTABLE
4796ELSESY
4797 *22+KSYTABLE
4798BEGINSY
4799 *27+KSYTABLE
4800IMODSY
4801 *29+KSYTABLE
4802NOTSY
4803 *30+KSYTABLE
4804OFSY
4805 *31+KSYTABLE
4806ORSY
4807 *37+KSYTABLE
4808DOWNTOSY
4809 *39+KSYTABLE
4810PROCEDURESY
4811 *41+KSYTABLE
4812TOSY
4813 *44+KSYTABLE
4814VARSY
4815 *45+KSYTABLE
4816CONSTSY
4817 *46+KSYTABLE
4818REPTSY
4819 *47+KSYTABLE
4820PROGRAMSY
4821 *51+KSYTABLE
4822TYPESY
4823 *60+KSYTABLE
4824UNTILSY
4825 *66+KSYTABLE
4826RECRDSY
4827 *68+KSYTABLE
4828THENSY
4829 *70+KSYTABLE
4830WHILSY
4831
4832
4833OCTAL
4834\f/P U S H T A B L E
4835
4836/CONTAINS THE NECESSARY INFORMATIONS (USED BY PUSHJUMP AND POPJUMP)
4837/TO CALL THE COMPILER PROCEDURES RECURSIVELY,
4838/TO SAVE THE LOCAL VARIABLES, TO PASS EVENTUAL PARAMETERS
4839/AND RETURN CONTROL TO MAINLINE.
4840/
4841/FOR EACH PROCEDURE THERE IS ONE ENTRY OF 4 WORDS:
4842/WORD 1: ADDRESS OF FIRST LOCAL VARIABLE (= 1ST PARAMETER) - 1
4843/WORD 2: - NUMBER OF LOCAL VAR'S (LOCATIONS) TO SAVE
4844/WORD 3: NUMBER OF PARAMETERS ( + FSYS IF 1ST ONE IS A SET)
4845/ ( + 100*NO. OF VAR-PARAMETERS)
4846/WORD 4: STARTING ADDRESS OF PROCEDURE
4847
4848 *PUSHTABLE
4849
4850/BLOCK
4851 ISFUN-1; -5; FSYS+2; XBLOCK
4852/STATEMENT
4853 0; 0; FSYS; XSTATEMENT
4854/ASSIGNMENT
4855 LV-1; -6; 2; XASSIGNMENT
4856/COMPOUNDSTATEMENT
4857 0; 0; 0; XCOMPOUND
4858/IFSTATEMENT
4859 IXTYP-1; -4; 0; XIFSTATEMENT
4860/CASESTATEMENT
4861 CASETAB-1; -137; 0; XCASESTATEMENT
4862/REPEATSTATEMENT
4863 RXTYP-1; -3; 0; XREPEAT
4864/WHILESTATEMENT
4865 WXTYP-1; -4; 0; XWHILE
4866/FORSTATEMENT
4867 FXTYP-1; -6; 0; XFORSTATEMENT
4868/STANDPROC
4869 PRCN-1; -5; 1; XSTPROC
4870/SELECTOR
4871 SELVAR-1; -5; FSYS+200+1; XSELECT
4872/CALL
4873 CALI-1; -5; FSYS+1; XCALL
4874/STANDFCT
4875 FCTN-1; -2; 1; XSTFUN
4876/FACTOR
4877 FACVAR-1; -3; FSYS+200+1; XFACTOR
4878/TERM
4879 TRMXTYP-1; -4; FSYS+1; XTERM
4880/SIMPLEEXPRESSION
4881 SIMXTYP-1; -4; FSYS+1; XSIMPLE
4882/EXPRESSION
4883 EXPRVAR-1; -6; FSYS+200+1; XEXPRESSION
4884/CONDECLARE
4885 CONREC-1; 0; 0; XCONDECL
4886/TYPDECLARE
4887 DECTP-1; 0; 0; XTYPDECL
4888/VARDECLARE
4889 VARTP-1; 0; 0; XVARDECL
4890/PRODECLARE
4891 PROFUN-1; -1; 0; XPRODECL
4892/CONSTANT
4893 CCON-1; 0; FSYS+1; XCONSTANT
4894/ARRAYTYP
4895 ARRVAR-1; -6; 200+1; XARRAYTYP
4896/TYPE
4897 TYPVAR-1; -12; FSYS+300+1; XTYPE
4898/PARAMETERLIST
4899 PARTP-1; 0; 0; XPARAM
4900/ONECASE
4901 0; 0; 0; XONECASE
4902\f/TABLE OF S P E C I A L S Y M B O L S
4903/
4904/ONE ENTRY FOR EACH ASCII CHARACTER:
4905/ =0 ... FOR ILLEGAL CHAR'S
4906/ >0 ... (=SYMBOL VALUE) FOR SINGLE SPECIAL CHAR'S
4907/ <0 ... (=JMP TO ROUTINE) FOR DOUBLE CHAR'S, COMMENTS OR STRINGS
4908
4909CHARTABLE=.
4910
4911/SPACE ! " # $ % & ' ( ) * + , - . /
49120
49130
4914JMPAPOS
4915NEQ
49160
49170
4918ANDSY
49190
4920JMPLPAR
4921RPARENT
4922TIMES
4923PLUS
4924COMMA
4925MINUS
4926JMPPER
4927RDIVSY
4928
4929ZBLOCK "9-"0+1 /DIGITS ARE PROCESSED SEPARATELY!
4930
4931/: ; < = > ? @
4932JMPCOL
4933SEMICOLON
4934JMPLSS
4935EQL
4936JMPGTR
49370
49380
4939
4940ZBLOCK "Z-"A+1 /LETTERS ARE PROCESSED SEPARATELY!
4941
4942/[ \ ] ^ _
4943LBRACK
49440
4945RBRACK
49460
49470
4948\f/C O M P I L E R E R R O R S (NOT FATAL)
4949
4950/ERROR LINE BUFFER:
4951
4952ERRLINE,"#-240; "#-240; "#-240; "#-240; "#-240; 0; 0
4953 ZBLOCK LLNG
4954
4955
4956 PAGE
4957
4958/ERROR ROUTINE:
4959
4960ERRNO, 0 /ERROR NUMBER
4961ERRN01, 0 /ERROR NUMBER - UNITS
4962ERRN10, 0 /ERROR NUMBER - TENS
4963ERRPOS, 0 /POSITION OF ERROR
4964ERRP, 0
4965ERRC, 0
4966/ERRSW, 0 /IN FIELD 0
4967/ERRSUM,0 /IN FIELD 6
4968
4969F3ERROR,0
4970 DCA ERRNO
4971 RDF
4972 TAD (CDF CIF
4973 DCA ERRCDI
4974 CDF 0
4975 TAD I (CC
4976 TAD (ERRLINE+5
4977 DCA ERRPOS
4978 TAD I (ERRSW
4979 CDF SETFIELD
4980 SZA CLA
4981 JMP ERRENT
4982 TAD (ERRLINE+5
4983 DCA ERRP
4984 TAD (-LLNG
4985 DCA ERRC
4986 ISZ ERRP
4987 DCA I ERRP
4988 ISZ ERRC
4989 JMP .-3
4990ERRENT, TAD ERRNO
4991 DCA ERRN01
4992 DCA ERRN10
4993 JMP .+3
4994 DCA ERRN01
4995 ISZ ERRN10
4996 TAD ERRN01
4997 TAD (-12 /-10
4998 SMA
4999 JMP .-5
5000 CLA
5001 TAD I ERRPOS
5002 SZA CLA
5003 JMP ERREXIT /NO ROOM!
5004 TAD ("#-240
5005 DCA I ERRPOS
5006 ISZ ERRPOS
5007 TAD ERRN10
5008 SNA
5009 JMP .+4
5010 TAD ("0-240
5011 DCA I ERRPOS
5012 ISZ ERRPOS
5013 TAD ERRN01
5014 TAD ("0-240
5015 DCA I ERRPOS
5016 TAD ERRPOS
5017 TAD (-ERRLINE
5018 CMA
5019 CDF 0
5020 DCA I (ERRSW
5021ERREXIT,CDF ERRFIELD
5022 ISZ I ERRNO /REMEMBER THIS ERROR
5023 ISZ I (ERRSUM /COUNT ERRORS
5024ERRCDI, CDF CIF 0
5025 JMP I F3ERROR
5026
5027 PAGE
5028\f/C O M P I L E R E R R O R S (FATAL)
5029
5030FATADR, 0
5031FATPOS, 0
5032
5033F3FATAL,DCA FATADR
5034 TAD FHEAD
5035 DCA FTEXT
5036 JMS FCRLF
5037 JMS FCRLF
5038 JMS FMESG
5039 TAD FLIST
5040 DCA FATPOS
5041 ISZ FATPOS
5042 TAD I FATPOS
5043 TAD FATADR
5044 SZA CLA
5045 JMP .-4
5046 TAD FATPOS
5047 TAD FMFL
5048 DCA FATPOS
5049 TAD I FATPOS
5050 DCA FTEXT
5051 JMS FMESG
5052 JMS FCRLF
5053 CDF CIF ERRFIELD
5054 JMP I .+1
5055 FXPLAIN
5056
5057FPRINT, 0
5058 TLS
5059 TSF
5060 JMP .-1
5061 CLA CLL
5062 JMP I FPRINT
5063
5064FCRLF, 0
5065 TAD F215
5066 JMS FPRINT
5067 TAD F212
5068 JMS FPRINT
5069 JMP I FCRLF
5070
5071FMESG, 0
5072 TAD I FTEXT
5073 BSW
5074 JMS FASCII
5075 TAD I FTEXT
5076 JMS FASCII
5077 ISZ FTEXT
5078 JMP FMESG+1
5079
5080FASCII, 0
5081 AND F77
5082 SNA
5083 JMP I FMESG
5084 TAD F240
5085 AND F77
5086 TAD F240
5087 JMS FPRINT
5088 JMP I FASCII
5089
5090FTEXT, 0
5091
5092FLIST, FATLIST-1
5093FMFL, FATMESG-FATLIST
5094FHEAD, FNN
5095F215, 215
5096F212, 212
5097F240, 240
5098F77, 77
5099
5100FATLIST,-FATAL0-1
5101 -FATAL1-1
5102 -FATAL2-1
5103 -FATAL3-1
5104 -FATAL4-1
5105 -FATAL5-1
5106 -FATAL6-1
5107 -FATAL7-1
5108 -FATAL8-1
5109 -FATAL9-1
5110 -FATALC-1
5111
5112FATMESG,F00
5113 F01
5114 F02
5115 F03
5116 F04
5117 F05
5118 F06
5119 F07
5120 F08
5121 F09
5122 F0C
5123
5124FNN, TEXT /KOMPILATION ABGEBROCHEN - /
5125
5126F00, TEXT /MAGNETBAND-LESEFEHLER!/
5127F01, TEXT /ZU VIELE NAMEN!/
5128F02, TEXT /ZU VIELE PROZEDUREN UND\ODER RECORDS!/
5129F03, TEXT /ZU VIELE KONSTANTE!/
5130F04, TEXT /ZU VIELE ARRAYS!/
5131F05, TEXT /ZU VIELE UNTERPROGRAMMEBENEN!/
5132F06, TEXT /PROGRAMM ZU GROSS!/
5133F07, TEXT /ZU VIEL TEXT!/
5134F08, TEXT /PROGRAMM ZU KOMPLEX!/
5135F09, TEXT /PROGRAMM UNVOLLSTAENDIG!/
5136F0C, TEXT /ZU VIELE CASE-MARKEN!/
5137
5138 PAGE
5139\f FIELD 4
5140
5141/P A G E Z E R O
5142
5143/LOC'S 1 - 7 USED FOR TEMPORARY STORAGE!
5144 *7
5145L, 0
5146 *10
5147/XR10, /AUTOINDEX REGISTER (SEE FIELD 0!)
5148 0
5149XR11, 0 / --- " ---
5150XR12, 0
5151
5152 *20
5153LC, 0 /L O C A T I O N C O U N T E R
5154TEMP, 0
5155 /I N S T R U C T I O N - R E G I S T E R
5156/IRX,
5157 0 /LEVEL
5158/IRY,
5159 0 /ADDRESS OR VALUE
5160
5161 /I N D I C E S T O T A B L E S
5162/B, /BLOCK TABLE
5163 0001
5164/T, /SYMBOL TABLE
5165 0037
5166A, /ARRAY TABLE
5167 0
5168C, /CONSTANT TABLE
5169 ATAB-1
5170SX, /STRING TABLE
5171 0
5172J, 0 /TEMPORARY FOR T
5173JA, 0 /TEMPORARY FOR A
5174JB, 0 /TEMPORARY FOR B
5175
5176LO, 0 /LOW BOUND OF ARRAY
5177HI, 0 /HIGH BOUND OF ARRAY
5178SLENG, 0 /LENGTH OF STRING
5179
5180SY, 0 /C U R R E N T S Y M B O L
5181
5182ID, 0;0;0;0 /C U R R E N T I D E N T I F I E R
5183NUM, 0;0;0;0 /C O N S T A N T N U M B E R
5184
5185 *50 /U N P A C K E D E N T R Y OF SYMBOL TABLE
5186LINK0, 0
5187OBJ0, 0
5188TYP0, 0
5189REF0, 0
5190NORM0, 0
5191LEV0, 0
5192ADR0, 0
5193
5194JW, 0 /ADDRESS OF ENTRY (REMEMBERED FOR 'WITHEND')
5195
5196 *50 /U N P A C K E D E N T R Y OF ARRAY TABLE
5197INXTP0, 0
5198ELTYP0, 0
5199ELREF0, 0
5200LOW0, 0
5201HIGH0, 0
5202ELSIZ0, 0
5203SIZE0, 0
5204
5205JAW, 0 /ADDRESS OF ENTRY (REMEMBERED FOR 'WITHAEND')
5206
5207 /LOCAL VAR'S OF PROCEDURE B L O C K
5208ISFUN, 0
5209LEVEL, 0
5210DX, 0
5211PRT, 0
5212PRB, 0
5213
5214 /LOCAL VAR'S OF PROCEDURE F A C T O R
5215FACVAR, 0
5216FACXTYP,0
5217FACXREF,0
5218
5219 /LOCAL VAR'S OF PROCEDURE C A L L
5220CALI, 0
5221CALXTYP,0
5222CALXREF,0
5223CALASTP,0
5224CALCP, 0
5225
5226 /LOCAL VAR'S OF P U S H J U M P AND P O P J U M P
5227LOCAL, 0
5228LENGTH, 0
5229PARAM, 0
5230
5231/M A C R O I N S T R U C T I O N S USED BY COMPILER
5232
5233 *100
5234/ERROR=JMS I . /PARALLEL DEFINED WITH FIELD 0!
5235 XERROR
5236/FATAL=JMS I . / -"-
5237 XFATAL
5238/OFTAB=JMS I . / -"-
5239 XOFTAB
5240/OFATAB=JMS I . / -"-
5241 XOFATAB
5242/OFBTAB=JMS I . / -"-
5243 XOFBTAB
5244/OFDISPLAY=JMS I . / -"-
5245 XOFDISP
5246/TODISPLAY=JMS I . / -"-
5247 XTODISP
5248/GETCONSTANT=JMS I . / -"-
5249 XOFCONST
5250TOTAB=JMS I . /PUT INFO INTO SYMBOL TABLE
5251 XTOTAB
5252TOATAB=JMS I . /PUT INFO INTO ARRAY TABLE
5253 XTOATAB
5254TOBTAB=JMS I . /PUT INFO INTO BLOCK TABLE
5255 XTOBTAB
5256WITHTABDO=JMS I . /GET AND UNPACK ENTRY OF SYMBOL TABLE
5257 XWITHTAB
5258ENDWITH=JMS I . /PACK AND STORE ENTRY OF SYMBOL TABLE
5259 XENDWITH
5260WITHATABDO=JMS I . /GET AND UNPACK ENTRY OF ARRAY TABLE
5261 XWITHATAB
5262ENDAWITH=JMS I . /PACK AND STORE ENTRY OF ARRAY TABLE
5263 XENDAWITH
5264TOCODE=JMS I . /INSERT ADDRESS INTO CODE[LC].IRY
5265 XTOCODE
5266EMIT=JMS I . /OUTPUT INSTRUCTION OF INTERMEDIATE CODE
5267 XEMIT
5268ENTER=JMS I . /ENTER ITEM INTO SYMBOL TABLE
5269 XENTER
5270ENTERVARIABLE=JMS I . /ENTER VARIABLE INTO SYMBOL TABLE
5271 XENTVAR
5272ENTERARRAY=JMS I . /INTO ARRAY TABLE
5273 XENTARR
5274ENTERBLOCK=JMS I . /INTO BLOCK TABLE
5275 XENTBLO
5276ENTERCONSTANT=JMS I . /INTO CONSTANT TABLE
5277 XENTCON
5278SIGNEDINTEGER=JMS I . /MAKE SIGNED 12-BIT INTEGER OF (NUM)
5279 XSGNINT
5280TEST=JMS I . /CHECK AND SKIP TO LEGAL FOLLOW SYMBOL
5281 XTEST
5282TESTSEMICOLON=JMS I .
5283 XTSTSEM
5284SKIP=JMS I . /SKIP TO LEGAL FOLLOW SYMBOL
5285 XSKIP
5286SKIPIFSYIN=JMS I . /SKIP NEXT INSTR. IF SY IN SETX
5287 INSET
5288UNION=JMS I . /SET UNION
5289 XUNION
5290IFSY=JMS I . /IF SY=SYMBOL THEN NEXT INSTR. ELSE SKIP
5291 XIFSY
5292IFSYNOT=JMS I . /IF SY<>SYMBOL THEN NEXT INSTR. ELSE SKIP
5293 XIFSYNOT
5294LOCATE=JMS I . /LOCATE IDENTIFIER IN SYMBOL TABLE
5295 XLOCATE
5296PUSHJUMP=JMS I . /RECURSIVE PROCEDURE CALL
5297 XPUSHJUMP
5298POPJUMP=JMS I . /RETURN FROM PROCEDURE
5299 XPOPJUMP
5300RESULTTYPE=JMS I .
5301 XRESULT
5302INSYMBOL=JMS I . /SCANNER
5303 XINSYMBOL
5304
5305 /LOCAL VAR'S OF PROCEDURE T Y P E
5306TYPVAR, 0
5307TP, 0
5308RF, 0
5309SZ, 0
5310ELTP, 0
5311ELRF, 0
5312ELSZ, 0
5313OFFSET, 0
5314TT0, 0
5315TT1, 0
5316
5317 /LOCAL VAR'S OF PROCEDURE W H I L E - STATEMENT
5318WXTYP, 0
5319WXREF, 0
5320WLC1, 0
5321WLC2, 0
5322\f/M A I N P R O G R A M OF COMPILER
5323
5324 *200
5325MAIN, INSYMBOL
5326 IFSYNOT;PROGRAMSY;JMP MAIN3
5327 INSYMBOL
5328 IFSYNOT;IDENT;JMP MAIN2
5329 INSYMBOL
5330 IFSY;LPARENT;JMP .+4
5331 ERROR;11 /9
5332 JMP ENDOFH
5333IOFILES,INSYMBOL
5334 IFSY;IDENT;JMP .+4
5335 ERROR;2 /2
5336 SKP
5337 INSYMBOL
5338 IFSY;COMMA;JMP IOFILES
5339ENDOFH, IFSY;RPARENT;JMP .+4
5340 ERROR;4 /4
5341 SKP
5342 INSYMBOL
5343MAINBL, TAD (BTAB+3
5344 DCA XR10
5345 CDF TABLEFIELD
5346 TAD T
5347 DCA I XR10
5348 L0001
5349 DCA I XR10
5350 DCA I XR10
5351 DCA I XR10
5352 CDF COMPFIELD
5353 PUSHJUMP;BLOCK
5354 SET44
5355 0 /FALSE
5356 1
5357
5358 IFSYNOT;PERIOD;ERROR;26 /22
5359 EMIT;45 /(37)
5360 CDF CIF ERRFIELD
5361 JMP I (EXPLAIN /DO THE COMPILATION REPORT
5362
5363MAIN2, ERROR;2 /2
5364 JMP MAINBL
5365
5366MAIN3, ERROR;3 /3
5367 JMP MAINBL
5368\f/EXTENSION OF P U S H J U M P AND P O P J U M P ROUTINES
5369
5370VARIN, 0
5371 TAD PARAM
5372 AND (700
5373 SNA
5374 JMP I VARIN
5375 BSW
5376 CIA
5377 DCA LENGTH
5378 ISZ LOCAL
5379 L7777
5380 TAD I LOCAL
5381 DCA XR11
5382 TAD I XR11
5383 DCA I XR10
5384 ISZ LENGTH
5385 JMP .-3
5386 JMP I VARIN
5387
5388VARTM, 0
5389 DCA VARVAR
5390 TAD PARAM
5391 AND (700
5392 SNA
5393 JMP I VARTM
5394 BSW
5395 CIA
5396 DCA VARIN
5397 TAD VARIN
5398 DCA VARVAR
5399 TAD LOCAL
5400 DCA XR10
5401 L7777
5402 TAD I XR10
5403 DCA XR11
5404 DCA XR12 /USE LOC'S 1 - 7 FOR TEMP. STORAGE
5405 TAD I XR10
5406 DCA I XR12
5407 ISZ VARIN
5408 JMP .-3
5409 JMP I VARTM
5410
5411VAREX, 0
5412 TAD VARVAR
5413 SNA CLA
5414 JMP I VAREX
5415 DCA XR10
5416 TAD I XR10
5417 DCA I XR11
5418 ISZ VARVAR
5419 JMP .-3
5420 JMP I VAREX
5421
5422VARVAR, 0
5423
5424 PAGE
5425\f/PROCEDURE C O N S T A N T
5426/ ---------------
5427/
5428/CALL: PUSHJUMP;CONSTANT
5429/ SETX
5430/ C /ADDRESS
5431/
5432/LOCAL VAR'S: FSYS
5433 CCON, 0
5434 SIGN, 0
5435
5436XCONSTANT, DCA I CCON
5437 TAD CCON
5438 DCA XR10
5439 DCA I XR10
5440 DCA I XR10
5441 DCA I XR10
5442 DCA I XR10
5443 TEST;CONBGS;FSYS;62 /50
5444 SKIPIFSYIN;CONBGS
5445 JMP CON6
5446 IFSYNOT;CHARCON;JMP .+4
5447 L0004 /4=CHARS
5448 DCA I CCON
5449 JMP CON4
5450 DCA SIGN /+
5451 SKIPIFSYIN;SET8
5452 JMP CON1
5453 IFSY;MINUS;L4000
5454 DCA SIGN
5455 INSYMBOL
5456CON1, IFSYNOT;IDENT;JMP CON2
5457 LOCATE
5458 SNA
5459 JMP CON5-1
5460 DCA J
5461 OFTAB;OBJ
5462 MQL
5463 MQA
5464 BSW
5465 AND [77
5466 TAD (-KONSTANT
5467 SNA CLA
5468 JMP .+4
5469 ERROR;31 /25
5470 JMP CON5-1
5471 MQA
5472 AND [77
5473 DCA I CCON
5474 OFTAB;ADR
5475 DCA NUM+3
5476 DCA NUM+2
5477 DCA NUM+1
5478 DCA NUM
5479 L7776 /2=REALS
5480 TAD I CCON
5481 SZA
5482 IAC /1=INTS
5483 SZA CLA
5484 JMP CON3
5485 TAD NUM+3
5486 GETCONSTANT
5487 JMP CON3
5488CON2, IFSY;INTCON;JMP CON3-2
5489 IFSY;REALCON;JMP CON3-3
5490 SKIP;FSYS;62 /50
5491 JMP CON5
5492
5493 L0001
5494 IAC
5495 DCA I CCON
5496CON3, TAD SIGN
5497 TAD NUM+1
5498 DCA NUM+1
5499CON4, TAD CCON
5500 DCA XR10
5501 TAD NUM
5502 DCA I XR10
5503 TAD NUM+1
5504 DCA I XR10
5505 TAD NUM+2
5506 DCA I XR10
5507 TAD NUM+3
5508 DCA I XR10
5509
5510 INSYMBOL
5511CON5, TEST;FSYS;SET0;6 /6
5512CON6, POPJUMP;CONSTANT
5513
5514 PAGE
5515\f/PROCEDURE A R R A Y T Y P
5516/ ---------------
5517/
5518/CALL: PUSHJUMP;ARRAYTYP
5519/ REF /ADDRESS
5520/ SIZE /ADDRESS
5521/
5522/LOCAL VAR'S:
5523 ARRVAR, 0
5524 AREF, 0
5525 ARSZ, 0
5526 ALTP, 0
5527 ALRF, 0
5528 ALSZ, 0
5529
5530 LOWB, ZBLOCK 5
5531 HIGHB, ZBLOCK 5
5532 MULT=HIGHB
5533
5534XARRAYTYP,
5535 PUSHJUMP;CONSTANT
5536 FSYS+SET9
5537 LOWB
5538 L7776 /2=REALS
5539 TAD LOWB
5540 SZA CLA
5541 JMP ARR1
5542 ERROR;33 /27
5543 L0001 /1=INTS
5544 DCA LOWB
5545 DCA LOWB+1
5546 DCA LOWB+2
5547 DCA LOWB+3
5548 DCA LOWB+4
5549ARR1, IFSY;COLON;JMP .+4
5550 ERROR;15 /13
5551 SKP
5552 INSYMBOL
5553 PUSHJUMP;CONSTANT
5554 FSYS+SET10
5555 HIGHB
5556 TAD HIGHB
5557 CIA
5558 TAD LOWB
5559 SNA CLA
5560 JMP ARR2
5561 ERROR;33 /27
5562 TAD LOWB+1
5563 DCA HIGHB+1
5564 TAD LOWB+2
5565 DCA HIGHB+2
5566 TAD LOWB+3
5567 DCA HIGHB+3
5568 TAD LOWB+4
5569 DCA HIGHB+4
5570ARR2, SIGNEDINTEGER;LOWB
5571 DCA LO
5572 SIGNEDINTEGER;HIGHB
5573 DCA HI
5574 TAD LOWB
5575 ENTERARRAY
5576 TAD A
5577 DCA AREF
5578 IFSYNOT;COMMA;JMP ARR3
5579 INSYMBOL
5580 TAD [ARRAY
5581 DCA ALTP
5582 PUSHJUMP;ARRAYTYP
5583 ALRF
5584 /ALSZ
5585 JMP ARR4
5586ARR3, IFSY;RBRACK;JMP .+5
5587 ERROR;14 /12
5588 IFSY;RPARENT;INSYMBOL
5589 IFSY;OFSY;JMP .+4
5590 ERROR;10 /8
5591 SKP
5592 INSYMBOL
5593 PUSHJUMP;TYPE
5594 FSYS
5595 ALTP
5596 /ALRF
5597 /ALSZ
5598ARR4, TAD AREF
5599 DCA JA
5600 WITHATABDO
5601 TAD LOW0
5602 CIA
5603 TAD HIGH0
5604 IAC
5605 DCA TEMP
5606 TAD ALSZ
5607 CIA
5608 DCA MULT
5609 TAD TEMP
5610 ISZ MULT
5611 JMP .-2
5612 DCA ARSZ
5613 TAD ARSZ
5614 DCA SIZE0
5615 TAD ALTP
5616 DCA ELTYP0
5617 TAD ALRF
5618 DCA ELREF0
5619 TAD ALSZ
5620 DCA ELSIZ0
5621 ENDAWITH
5622 POPJUMP;ARRAYTYP
5623
5624 PAGE
5625\f/PROCEDURE T Y P E
5626/ -------
5627/
5628/CALL: PUSHJUMP;TYPE
5629/ SETX
5630/ TYP /ADDRESS
5631/ REF / --"--
5632/ SIZE / --"--
5633/
5634/LOCAL VAR'S (ON PAGE ZERO!):
5635/ FSYS
5636/ TYPVAR, 0
5637/ TP, 0
5638/ RF, 0
5639/ SZ, 0
5640/ ELTP, 0
5641/ ELRF, 0
5642/ ELSZ, 0
5643/ OFFSET, 0
5644/ TT0, 0
5645/ TT1, 0
5646
5647XTYPE, DCA TP /0=NOTYP
5648 DCA RF
5649 DCA SZ
5650 TEST;TYPBGS;FSYS;12 /10
5651 SKIPIFSYIN;TYPBGS
5652 POPJUMP;TYPE
5653 IFSYNOT;IDENT;JMP TYP1
5654 LOCATE
5655 SNA
5656 JMP TYP1-2
5657 DCA J
5658 WITHTABDO
5659 TAD OBJ0
5660 TAD [-TYPE1
5661 SNA CLA
5662 JMP .+4
5663 ERROR;35 /29
5664 JMP TYP1-2
5665 TAD TYP0
5666 DCA TP
5667 TAD REF0
5668 DCA RF
5669 TAD ADR0
5670 DCA SZ
5671 TAD TYP0
5672 SNA CLA
5673 ERROR;36 /30
5674 INSYMBOL
5675 JMP TYP7
5676TYP1, IFSYNOT;ARRAYSY;JMP TYP2
5677 INSYMBOL
5678 IFSY;LBRACK;JMP .+5
5679 ERROR;13 /11
5680 IFSY;LPARENT;INSYMBOL
5681 TAD [ARRAY
5682 DCA TP
5683 PUSHJUMP;ARRAYTYP
5684 RF
5685 /SZ
5686 JMP TYP7
5687TYP2, INSYMBOL
5688 ENTERBLOCK
5689 L0006 /6=RECORD
5690 DCA TP
5691 TAD B
5692 DCA RF
5693 TAD LEVEL
5694 TAD [-LMAX
5695 SNA CLA
5696FATAL5, FATAL
5697 ISZ LEVEL
5698 TAD B
5699 TODISPLAY
5700 DCA OFFSET
5701TYP3, SKIPIFSYIN;SET46;JMP TYP6
5702 IFSYNOT;IDENT;JMP TYP5
5703 TAD T
5704 DCA TT0
5705 SKP
5706 INSYMBOL
5707 ENTERVARIABLE
5708 IFSY;COMMA;JMP .-4
5709 IFSY;COLON;JMP .+4
5710 ERROR;5 /5
5711 SKP
5712 INSYMBOL
5713 TAD T
5714 DCA TT1
5715 PUSHJUMP;TYPE
5716 FSYS+SET11
5717 ELTP
5718 /ELRF
5719 /ELSZ
5720TYP4, TAD TT0
5721 CIA
5722 TAD TT1
5723 SPA SNA CLA
5724 JMP TYP5
5725 ISZ TT0
5726 TAD TT0
5727 WITHTABDO
5728 TAD ELTP
5729 DCA TYP0
5730 TAD ELRF
5731 DCA REF0
5732 TAD [40
5733 DCA NORM0
5734 TAD OFFSET
5735 DCA ADR0
5736 TAD OFFSET
5737 TAD ELSZ
5738 DCA OFFSET
5739 ENDWITH
5740 JMP TYP4
5741
5742 PAGE
5743
5744TYP5, IFSY;ENDSY;JMP TYP6
5745 IFSY;SEMICOLON;JMP .+5
5746 ERROR;16 /14
5747 IFSY;COMMA;INSYMBOL
5748 TEST;SET12;FSYS;6 /6
5749 JMP TYP3
5750TYP6, TAD RF
5751 DCA JB
5752 TAD OFFSET
5753 TOBTAB;VSIZE
5754 TAD OFFSET
5755 DCA SZ
5756 TOBTAB;PSIZE
5757 INSYMBOL
5758 L7777
5759 TAD LEVEL
5760 DCA LEVEL
5761TYP7, TEST;FSYS;SET0;6 /6
5762 POPJUMP;TYPE
5763\f/PROCEDURE C O N D E C L
5764/ -------------
5765/
5766/CALL: PUSHJUMP;CONDECL /NO ARG'S!
5767/
5768/LOCAL VAR'S:
5769 CONREC, ZBLOCK 5
5770
5771XCONDECL, INSYMBOL
5772 TEST;SET18;BLOBGS;2 /2
5773CDEC1, IFSYNOT;IDENT;POPJUMP;CONDECL
5774 ENTER;KONSTANT
5775 INSYMBOL
5776 IFSY;EQL;JMP .+5
5777 ERROR;20 /16
5778 IFSY;BECOMES;INSYMBOL
5779 PUSHJUMP;CONSTANT
5780 FSYS+SET19
5781 CONREC
5782
5783 TAD T
5784 WITHTABDO
5785 TAD CONREC /TYP
5786 DCA TYP0
5787 DCA REF0
5788 L7776
5789 TAD CONREC
5790 SZA
5791 IAC
5792 SZA CLA
5793 JMP .+4
5794 ENTERCONSTANT;CONREC
5795 SKP
5796 TAD CONREC+4
5797 DCA ADR0
5798 ENDWITH
5799 TESTSEMICOLON
5800 JMP CDEC1
5801\f/PROCEDURE T Y P D E C L
5802/ -------------
5803/
5804/CALL: PUSHJUMP;TYPDECL /NO ARG'S!
5805/
5806/LOCAL VAR'S:
5807 DECTP, 0
5808 DECRF, 0
5809 DECSZ, 0
5810 DT1, 0
5811
5812XTYPDECL, INSYMBOL
5813 TEST;SET18;BLOBGS;2 /2
5814TDEC1, IFSYNOT;IDENT;POPJUMP;TYPDECL
5815 ENTER;TYPE1
5816 TAD T
5817 DCA DT1
5818 INSYMBOL
5819 IFSY;EQL;JMP .+5
5820 ERROR;20 /16
5821 IFSY;BECOMES;INSYMBOL
5822 PUSHJUMP;TYPE
5823 FSYS+SET19
5824 DECTP
5825 /DECRF
5826 /DECSZ
5827
5828 TAD DT1
5829 WITHTABDO
5830 TAD DECTP
5831 DCA TYP0
5832 TAD DECRF
5833 DCA REF0
5834 TAD DECSZ
5835 DCA ADR0
5836 ENDWITH
5837 TESTSEMICOLON
5838 JMP TDEC1
5839
5840 PAGE
5841\f/PROCEDURE P A R A M E T E R L I S T
5842/ -------------------------
5843/
5844/CALL: PUSHJUMP;PARAMETERLIST /NO ARG'S!
5845/
5846/LOCAL VAR'S:
5847 PARTP, 0
5848 PARRF, 0
5849 PARSZ, 0
5850 PT0, 0
5851 VALPAR, 0
5852
5853XPARAM, INSYMBOL
5854 DCA PARTP
5855 DCA PARRF
5856 DCA PARSZ
5857 TEST;SET13;FSYS+SET14;7 /7
5858PAR1, SKIPIFSYIN;SET13
5859 JMP PAR5
5860 IFSYNOT;VARSY;JMP .+3
5861 INSYMBOL
5862 SKP
5863 TAD [40
5864 DCA VALPAR
5865 TAD T
5866 DCA PT0
5867 ENTERVARIABLE
5868 IFSYNOT;COMMA;JMP .+4
5869 INSYMBOL
5870 ENTERVARIABLE
5871 JMP .-5
5872 IFSY;COLON;JMP .+4
5873 ERROR;5 /5
5874 JMP PAR3
5875 INSYMBOL
5876 IFSY;IDENT;JMP .+4
5877 ERROR;2 /2
5878 JMP PAR2
5879 LOCATE
5880 DCA J
5881 INSYMBOL
5882 TAD J
5883 SNA CLA
5884 JMP PAR2
5885 WITHTABDO
5886 TAD OBJ0
5887 TAD [-TYPE1
5888 SNA CLA
5889 JMP .+4
5890 ERROR;35 /29
5891 JMP PAR2
5892 TAD TYP0
5893 DCA PARTP
5894 TAD REF0
5895 DCA PARRF
5896 TAD VALPAR
5897 SZA CLA
5898 JMP .+3
5899 L0001
5900 SKP
5901 TAD ADR0
5902 DCA PARSZ
5903PAR2, TEST;SET15;FSYS+SET16;16 /14
5904PAR3, TAD PT0
5905 CIA
5906 TAD T
5907 SPA SNA CLA
5908 JMP PAR4
5909 ISZ PT0
5910 TAD PT0
5911 WITHTABDO
5912 TAD PARTP
5913 DCA TYP0
5914 TAD PARRF
5915 DCA REF0
5916 TAD VALPAR
5917 DCA NORM0
5918 TAD DX
5919 DCA ADR0
5920 TAD LEVEL
5921 DCA LEV0
5922 ENDWITH
5923 TAD DX
5924 TAD PARSZ
5925 DCA DX
5926 JMP PAR3
5927PAR4, IFSY;RPARENT;JMP PAR6
5928 IFSY;SEMICOLON;JMP .+5
5929 ERROR;16 /14
5930 IFSY;COMMA;INSYMBOL
5931 TEST;SET13;FSYS+SET14;6 /6
5932 JMP PAR1
5933PAR5, IFSY;RPARENT;JMP PAR6
5934 ERROR;4 /4
5935 JMP .+6
5936PAR6, INSYMBOL
5937 TEST;SET17;FSYS;6 /6
5938 POPJUMP;PARAMETERLIST
5939
5940 PAGE
5941\f/PROCEDURE V A R D E C L
5942/ -------------
5943/
5944/CALL: PUSHJUMP;VARDECL /NO ARG'S!
5945/
5946/LOCAL VAR'S:
5947 VARTP, 0
5948 VARRF, 0
5949 VARSZ, 0
5950 VT0, 0
5951 VT1, 0
5952
5953XVARDECL, INSYMBOL
5954 IFSYNOT;IDENT;POPJUMP;VARDECL
5955 TAD T
5956 DCA VT0
5957 ENTERVARIABLE
5958 IFSYNOT;COMMA;JMP .+4
5959 INSYMBOL
5960 ENTERVARIABLE
5961 JMP .-5
5962 IFSY;COLON;JMP .+4
5963 ERROR;5 /5
5964 SKP
5965 INSYMBOL
5966 TAD T
5967 DCA VT1
5968 PUSHJUMP;TYPE
5969 FSYS+SET19
5970 VARTP
5971 /VARRF
5972 /VARSZ
5973
5974VAR1, TAD VT0
5975 CIA
5976 TAD VT1
5977 SPA SNA CLA
5978 JMP VAR2
5979 ISZ VT0
5980 TAD VT0
5981 WITHTABDO
5982 TAD VARTP
5983 DCA TYP0
5984 TAD VARRF
5985 DCA REF0
5986 TAD LEVEL
5987 DCA LEV0
5988 TAD DX
5989 DCA ADR0
5990 TAD [40
5991 DCA NORM0
5992 ENDWITH
5993 TAD VARSZ
5994 TAD DX
5995 DCA DX
5996 JMP VAR1
5997VAR2, TESTSEMICOLON
5998 JMP XVARDECL+1
5999\f/PROCEDURE P R O D E C L
6000/ -------------
6001/
6002/CALL: PUSHJUMP;PRODECL /NO ARG'S!
6003/
6004/LOCAL VAR'S: PROFUN, 0 /SEE BELOW!
6005
6006XPRODECL, IFSY;FUNCTIONSY;L0001
6007 DCA PROFUN
6008 INSYMBOL
6009 IFSY;IDENT;JMP .+7
6010 ERROR;2 /2
6011 DCA ID
6012 DCA ID+1
6013 DCA ID+2
6014 DCA ID+3
6015 TAD (PROZEDURE
6016 TAD PROFUN
6017 DCA .+2
6018 ENTER;00 /FUNCTION OR PROCEDURE
6019 TAD T
6020 DCA J
6021 OFTAB;NORMAL
6022 AND (7737
6023 TAD [40
6024 TOTAB;NORMAL
6025 INSYMBOL
6026 L0001
6027 TAD LEVEL
6028 DCA .+5
6029 PUSHJUMP;BLOCK
6030 FSYS+SET20
6031PROFUN, 0
6032 0
6033
6034 IFSY;SEMICOLON;JMP .+4
6035 ERROR;16 /14
6036 SKP
6037 INSYMBOL
6038 TAD [40
6039 TAD PROFUN
6040 DCA .+2
6041 EMIT;00 /*** (32) OR (33) ***/
6042 POPJUMP;PRODECL
6043
6044 PAGE
6045\f/PROCEDURE S E L E C T O R
6046/ ---------------
6047/
6048/CALL: PUSHJUMP;SELECTOR
6049/ SETX
6050/ V /ADDRESS
6051/
6052/LOCAL VAR'S: FSYS
6053 SELVAR, 0
6054 SELVTYP,0
6055 SELVREF,0
6056 SELXTYP,0
6057 SELXREF,0
6058
6059XSELECT, IFSYNOT;PERIOD;JMP SEL2
6060 INSYMBOL /FIELD SELECTOR
6061 IFSY;IDENT;JMP .+4
6062 ERROR;2 /2
6063 JMP SEL5
6064 TAD SELVTYP
6065 TAD [-RECORD
6066 SNA CLA
6067 JMP .+4
6068 ERROR;37 /31
6069 JMP SEL1
6070 TAD SELVREF
6071 OFBTAB;LAST
6072 DCA J
6073 JMS ENTID
6074 JMS CHKID
6075 JMP .+5
6076 OFTAB;LINK
6077 DCA J
6078 JMP .-5
6079 TAD J
6080 SNA CLA
6081 ERROR;0 /0
6082 WITHTABDO
6083 TAD TYP0
6084 DCA SELVTYP
6085 TAD REF0
6086 DCA SELVREF
6087 TAD ADR0
6088 SNA
6089 JMP SEL1
6090 DCA IRY
6091 EMIT;11 /*** (9) ***/
6092SEL1, INSYMBOL
6093 JMP SEL5
6094SEL2, IFSYNOT;LBRACK;ERROR;13 /11
6095SEL3, INSYMBOL
6096 PUSHJUMP;EXPRESSION
6097 FSYS+SET21
6098 SELXTYP
6099
6100 TAD SELVTYP
6101 TAD [-ARRAY
6102 SNA CLA
6103 JMP .+4
6104 ERROR;34 /28
6105 JMP SEL4
6106 TAD SELVREF /ARRAY INDEX
6107 DCA JA
6108 OFATAB;INXTYP
6109 CIA
6110 TAD SELXTYP
6111 SNA CLA
6112 JMP .+4
6113 ERROR;32 /26
6114 JMP SEL6
6115 TAD JA
6116 DCA IRY
6117 OFATAB;ELSIZE
6118 CLL RAR /1 SCOMPARES!
6119 SZA CLA
6120 L0001
6121 TAD (24
6122 DCA .+2
6123 EMIT;00 /*** (20) OR (21) ***/
6124SEL6, OFATAB;ELTYP
6125 DCA SELVTYP
6126 OFATAB;ELREF
6127 DCA SELVREF
6128SEL4, IFSY;COMMA;JMP SEL3
6129 IFSY;RBRACK;JMP .+5
6130 ERROR;14 /12
6131 IFSY;RPARENT;INSYMBOL
6132SEL5, SKIPIFSYIN;SET22
6133 SKP
6134 JMP XSELECT
6135 TEST;FSYS;SET0;6 /6
6136 POPJUMP;SELECTOR
6137
6138 PAGE
6139\f/FUNCTION R E S U L T T Y P E
6140/ -------------------
6141/
6142/CALL: TAD XTYP
6143/ MQL
6144/ TAD YTYP
6145/ RESULTTYPE
6146/
6147/RETURNS RESULTTYPE IN ACCUMULATOR
6148
6149XRESULT,0
6150 SZA
6151 SWP
6152 SNA
6153 JMP I XRESULT
6154 TAD [-2 /HERE: XTYP<>0 AND YTYP<>0, XTYP IN AC
6155 SMA SZA
6156 JMP RES33
6157 SWP /YTYP IN AC
6158 TAD [-2
6159 SMA SZA
6160 JMP RES33
6161 SNA /HERE ONLY INTS OR REALS, YTYP IN AC
6162 JMP .+5 /(7777 ... INTS, 0000 ... REALS)
6163 SWP
6164 SZA CLA
6165 JMP RES1 /INTS - INTS
6166 JMP .+5 /REALS - INTS
6167 SWP
6168 SNA CLA
6169 JMP .+5 /REALS - REALS
6170 L0001 /INTS - REALS
6171 DCA IRY
6172 EMIT;32 /*** (26,0) OR (26,1) ***/
6173 IAC
6174RES1, IAC
6175 JMP I XRESULT
6176RES33, CLA CLL
6177 ERROR;41 /33
6178 JMP I XRESULT
6179\f/PROCEDURE C A L L
6180/ -------
6181/
6182/CALL: PUSHJUMP;CALL
6183/ SETX
6184/ I /VALUE
6185/
6186/LOCAL VAR'S (ON PAGE ZERO!):
6187/ FSYS
6188/ CALI, 0
6189/ CALXTYP,0
6190/ CALXREF,0
6191/ CALASTP,0
6192/ CALCP, 0
6193
6194XCALL, TAD CALI
6195 DCA IRY
6196 EMIT;22 /*** (18,I) ***/
6197 TAD CALI
6198 OFTAB;REF
6199 BSW
6200 AND [77
6201 OFBTAB;LASTPAR
6202 DCA CALASTP
6203 TAD CALI
6204 DCA CALCP
6205 IFSYNOT;LPARENT;JMP CAL5
6206CAL1, INSYMBOL
6207 TAD CALASTP
6208 CIA
6209 TAD CALCP
6210 SMA CLA
6211 JMP CAL4-2
6212 ISZ CALCP
6213 TAD CALCP
6214 OFTAB;NORMAL
6215 AND [40
6216 SNA CLA
6217 JMP CAL3
6218 PUSHJUMP;EXPRESSION /VALUE PARAMETER
6219 FSYS+SET23
6220 CALXTYP
6221
6222 TAD CALCP
6223 OFTAB;TYP
6224 AND [77
6225 DCA TEMP
6226 TAD TEMP
6227 CIA
6228 TAD CALXTYP
6229 SZA CLA
6230 JMP CAL2
6231 TAD CALCP
6232 OFTAB;REF
6233 BSW
6234 AND [77
6235 CIA
6236 TAD CALXREF
6237 SZA CLA
6238 JMP CAL36
6239 TAD CALXTYP
6240 TAD [-ARRAY
6241 SZA
6242 JMP .+5
6243 TAD CALXREF
6244 OFATAB;SIZE
6245 JMP .+7
6246 CLL RAR /6=RECORD
6247 SZA CLA
6248 JMP CAL4
6249 TAD CALXREF
6250 OFBTAB;VSIZE
6251 DCA IRY
6252 EMIT;26 /*** (22,SIZE) ***/
6253 JMP CAL4
6254CAL2, L7777 /1=INTS
6255 TAD CALXTYP
6256 SZA CLA
6257 JMP .+10
6258 L7776 /2=REALS
6259 TAD TEMP
6260 SZA CLA
6261 JMP .+4
6262 EMIT;32 /*** (26,0) ***/
6263 JMP CAL4
6264 TAD CALXTYP
6265 SZA CLA
6266 JMP CAL36
6267 JMP CAL4
6268
6269 PAGE
6270
6271CAL3, IFSY;IDENT;JMP .+4 /VARIABLE PARAMETER
6272 ERROR;2 /2
6273 JMP CAL4
6274 LOCATE
6275 DCA J
6276 INSYMBOL
6277 TAD J
6278 SNA CLA
6279 JMP CAL4
6280 WITHTABDO
6281 L7777 /1=VARIABLE
6282 TAD OBJ0
6283 SZA CLA
6284 ERROR;45 /37
6285 TAD TYP0
6286 DCA CALXTYP
6287 TAD REF0
6288 DCA CALXREF
6289 TAD LEV0
6290 DCA IRX
6291 TAD ADR0
6292 DCA IRY
6293 TAD NORM0
6294 SNA CLA
6295 IAC
6296 DCA .+2
6297 EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/
6298 SKIPIFSYIN;SET22
6299 JMP .+5
6300 PUSHJUMP;SELECTOR
6301 FSYS+SET23
6302 CALXTYP
6303
6304 TAD CALCP
6305 OFTAB;TYP
6306 AND [77
6307 CIA
6308 TAD CALXTYP
6309 SZA CLA
6310 JMP CAL36
6311 TAD CALCP
6312 OFTAB;REF
6313 BSW
6314 AND [77
6315 CIA
6316 TAD CALXREF
6317 SZA CLA
6318CAL36, ERROR;44 /36
6319 JMP CAL4
6320 ERROR;47 /39
6321CAL4, TEST;SET24;FSYS;6 /6
6322 IFSY;COMMA;JMP CAL1
6323 IFSY;RPARENT;JMP .+4
6324 ERROR;4 /4
6325 SKP
6326 INSYMBOL
6327CAL5, TAD CALASTP
6328 CIA
6329 TAD CALCP
6330 SPA CLA
6331 ERROR;47 /39
6332 TAD CALI
6333 OFTAB;REF
6334 DCA TEMP
6335 TAD TEMP
6336 BSW
6337 AND [77
6338 OFTAB;PSIZE
6339 TAD (-1
6340 DCA IRY
6341 EMIT;23 /*** (19,PSIZE-1) ***/
6342 TAD TEMP
6343 AND [17
6344 CIA
6345 TAD LEVEL
6346 SPA SNA CLA
6347 JMP CAL6
6348 TAD LEVEL
6349 DCA IRX /SWAPPED CONTENTS OF IRX AND IRY HERE!
6350 TAD TEMP /(SEE INTERPRETER AT I03)
6351 AND [17
6352 DCA IRY
6353 EMIT;3 /*** (3,LEV1,LEV2) ***/
6354CAL6, POPJUMP;CALL
6355
6356 PAGE
6357\f/PROCEDURE S T A N D F C T
6358/ ---------------
6359/
6360/CALL: PUSHJUMP;STANDFCT
6361/ N /VALUE
6362/
6363/LOCAL VAR'S:
6364 FCTN, 0 /NUMBER OF STANDARD FUNCTION
6365 FCTJ, 0
6366
6367XSTFUN, TAD FCTN
6368 TAD (-20 /-16
6369 SMA SZA CLA
6370 JMP STF17
6371 IFSY;LPARENT;JMP .+4
6372 ERROR;11 /9
6373 SKP
6374 INSYMBOL
6375 TAD J /J IS SET IN FACTOR
6376 DCA FCTJ
6377 PUSHJUMP;EXPRESSION
6378 FSYS+SET14
6379 FACXTYP
6380
6381 TAD FCTJ
6382 DCA J
6383 L7776
6384 TAD FCTN
6385 SMA SZA CLA
6386 JMP STF1
6387 /FCTN: 0,2
6388 L0004 /4=FUNKTION
6389 BSW /(MUST INSERT OBJ
6390 TAD FACXTYP /ALONG WITH TYP!)
6391 TOTAB;TYP
6392 L7776 /2=REALS
6393 TAD FACXTYP
6394 SNA CLA
6395 ISZ FCTN
6396 JMP STF2
6397STF1, TAD FCTN
6398 TAD (-10
6399 SPA SNA CLA
6400 JMP STF2 /FCTN: 4,5,6,7,8
6401 L7777 /FCTN: 9,10,11, ... ,16
6402 TAD FACXTYP /1=INTS
6403 SNA CLA
6404 EMIT;32 /*** (26,0) ***/
6405STF2, TAD (TSET
6406 TAD FCTN
6407 DCA TEMP
6408 TAD FACXTYP
6409 STL RAL
6410 TAD (SETTABLE
6411 DCA ARGXTYP
6412 TAD I TEMP
6413 CDF SETFIELD
6414 AND I ARGXTYP
6415 CDF COMPFIELD
6416 SNA CLA
6417 JMP STF3
6418 TAD FCTN
6419 DCA IRY
6420 EMIT;10 /*** (8,N) ***/
6421 JMP .+5
6422STF3, TAD FACXTYP
6423 SZA CLA
6424 ERROR;60 /48
6425 IFSY;RPARENT;JMP .+4
6426 ERROR;4 /4
6427 SKP
6428 INSYMBOL
6429STF4, OFTAB;TYP /(J STILL OKAY!?)
6430 AND [77
6431 DCA FACXTYP
6432 POPJUMP;STANDFCT
6433
6434STF17, TAD FCTN
6435 DCA IRY
6436 EMIT;10 /*** (8,17) OR (8,18) OR (8,19) ***/
6437 JMP STF4
6438
6439
6440/TABLE OF LEGAL ARGUMENT TYPES:
6441TSET, 3000 /0
6442 3000
6443 3000 /2
6444 3000
6445 2000 /4
6446 2000 /5
6447 2600 /6
6448 0200 /7
6449 0200 /8
6450 3000 /9
6451 3000
6452 3000
6453 3000
6454 3000
6455 3000
6456 3000
6457 3000 /16
6458
6459ARGXTYP,0
6460
6461 PAGE
6462\f/PROCEDURE F A C T O R
6463/ -----------
6464/
6465/CALL: PUSHJUMP;FACTOR
6466/ SETX
6467/ X /ADDRESS
6468/
6469/LOCAL VAR'S (ON PAGE ZERO!):
6470/ FSYS
6471/ FACVAR, 0
6472/ FACXTYP,0
6473/ FACXREF,0
6474
6475XFACTOR,DCA FACXTYP /0=NOTYP
6476 DCA FACXREF
6477 TEST;FACBGS;FSYS;72 /58
6478FAC1, SKIPIFSYIN;FACBGS
6479 POPJUMP;FACTOR
6480 IFSYNOT;IDENT;JMP FAC2
6481 LOCATE
6482 DCA J
6483 INSYMBOL
6484 WITHTABDO
6485 TAD OBJ0
6486 TAD (JMP I FACTABL
6487 DCA .+1
6488 HLT
6489
6490FACTABL,FKON
6491 FVAR
6492 FTYP
6493 FPRO
6494 FFUN
6495
6496FKON, TAD TYP0
6497 DCA FACXTYP
6498 DCA FACXREF
6499 TAD ADR0
6500 DCA IRY
6501 L7777 /1=INTS
6502 TAD TYP0
6503 CLL RAR /2=REALS
6504 SNA CLA
6505 IAC
6506 TAD (30
6507 DCA .+2
6508 EMIT;00 /*** (24,ADR) OR (25,ADR) ***/
6509 JMP FAC3
6510
6511FVAR, TAD TYP0
6512 DCA FACXTYP
6513 TAD REF0
6514 DCA FACXREF
6515 TAD LEV0
6516 DCA IRX
6517 TAD ADR0
6518 DCA IRY
6519 SKIPIFSYIN;SET22
6520 JMP FVAR1
6521 TAD NORM0
6522 SNA CLA
6523 IAC
6524 DCA .+2
6525 EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/
6526 PUSHJUMP;SELECTOR
6527 FSYS
6528 FACXTYP
6529
6530 TAD FACXTYP
6531 TAD [-4 /STANTYPS = NOTYP(0) ... CHAR(4)
6532 SPA SNA CLA
6533 EMIT;42 /*** (34) ***/
6534 JMP FAC3
6535FVAR1, DCA .+11 /F=0
6536 TAD FACXTYP
6537 TAD [-4
6538 SPA SNA CLA
6539 ISZ .+5 /F:=F+1 (IN STANTYPS!)
6540 TAD NORM0
6541 SNA CLA
6542 ISZ .+2 /F:=F+1
6543 EMIT;00 /*** (F,LEV,ADR) ***/
6544 JMP FAC3
6545
6546FTYP,
6547FPRO, ERROR;54 /44
6548 JMP FAC3
6549
6550FFUN, TAD TYP0
6551 DCA FACXTYP
6552 TAD LEV0
6553 SNA CLA
6554 JMP STFUN
6555 TAD J
6556 DCA .+4
6557 PUSHJUMP;CALL
6558 FSYS
6559 0
6560 JMP FAC3
6561STFUN, TAD ADR0
6562 DCA .+3
6563 PUSHJUMP;STANDFCT
6564 0
6565 JMP FAC3
6566
6567 PAGE
6568
6569FAC2, SKIPIFSYIN;SET25
6570 JMP FAC23
6571 L7776 /2=CHARCON
6572 TAD SY
6573 SNA CLA
6574 JMP FAC21
6575 L0001
6576 TAD SY
6577 DCA FACXTYP /INTS OR REALS
6578 ENTERCONSTANT;NUM-1
6579 DCA IRY
6580 EMIT;31 /*** (25,C) ***/
6581 JMP FAC22
6582FAC21, L0004 /4=CHARS
6583 DCA FACXTYP
6584 TAD NUM+3
6585 DCA IRY
6586 EMIT;30 /*** (24,NUM) ***/
6587FAC22, DCA FACXREF
6588 INSYMBOL
6589 JMP FAC3
6590FAC23, IFSYNOT;LPARENT;JMP FAC24
6591 INSYMBOL
6592 PUSHJUMP;EXPRESSION
6593 FSYS+SET14
6594 FACXTYP
6595
6596 IFSY;RPARENT;JMP .+4
6597 ERROR;4 /4
6598 JMP FAC3
6599 INSYMBOL
6600 JMP FAC3
6601FAC24, IFSYNOT;NOTSY;JMP FAC3
6602 INSYMBOL
6603 PUSHJUMP;FACTOR
6604 FSYS
6605 FACXTYP
6606
6607 L7775 /3=BOOLS
6608 TAD FACXTYP
6609 SZA CLA
6610 JMP .+4
6611 EMIT;43 /*** (35) ***/
6612 JMP FAC3
6613 TAD FACXTYP
6614 SZA CLA
6615 ERROR;40 /32
6616FAC3, TEST;FSYS;FACBGS;6 /6
6617 JMP FAC1
6618
6619 PAGE
6620\f/PROCEDURE T E R M
6621/ -------
6622/
6623/CALL: PUSHJUMP;TERM
6624/ SETX
6625/ X /ADDRESS
6626/
6627/LOCAL VAR'S: FSYS
6628 TRMXTYP,0
6629 TRMYTYP,0
6630 TRMYREF,0
6631 TRMOP, 0
6632
6633XTERM, TAD TRMXTYP
6634 DCA .+4
6635 PUSHJUMP;FACTOR
6636 FSYS+SET26
6637 0
6638
6639TRM1, SKIPIFSYIN;SET26
6640 POPJUMP;TERM
6641 TAD SY
6642 DCA TRMOP
6643 INSYMBOL
6644 PUSHJUMP;FACTOR
6645 FSYS+SET26
6646 TRMYTYP
6647
6648 TAD TRMOP
6649 TAD (JMP I OPTABL-TIMES
6650 DCA .+1
6651 HLT
6652
6653OPTABL, XTIMES
6654 XIDIV
6655 XRDIV
6656 XIMOD
6657 XAND
6658
6659XTIMES, TAD I TRMXTYP
6660 MQL
6661 TAD TRMYTYP
6662 RESULTTYPE
6663 DCA I TRMXTYP
6664 TAD I TRMXTYP
6665 SNA
6666 JMP TRM1 /NOTYP
6667 TAD (-1
6668 SZA CLA
6669 TAD (12-3 /REALS
6670 TAD (3 /INTS
6671 DCA IRY
6672 EMIT;60 /*** (48,3) OR (48,12) ***/
6673 JMP TRM1
6674
6675XRDIV, L0001
6676 DCA IRY
6677 L7777 /1=INTS
6678 TAD I TRMXTYP
6679 SZA CLA
6680 JMP .+5
6681 EMIT;32 /*** (26,1) ***/
6682 L0002 /2=REALS
6683 DCA I TRMXTYP
6684 DCA IRY
6685 L7777 /1=INTS
6686 TAD TRMYTYP
6687 SZA CLA
6688 JMP .+5
6689 EMIT;32 /*** (26,0) ***/
6690 L0002 /2=REALS
6691 DCA TRMYTYP
6692 L7776 /2=REALS
6693 TAD I TRMXTYP
6694 SZA CLA
6695 JMP XNOTYP-1
6696 L7776
6697 TAD TRMYTYP
6698 SZA CLA
6699 JMP XNOTYP-1
6700 TAD (13
6701 DCA IRY
6702 EMIT;60 /*** (48,13) ***/
6703 JMP TRM1
6704
6705XIDIV,
6706XIMOD, L7777 /1=INTS
6707 TAD I TRMXTYP
6708 SZA CLA
6709 JMP XNOTYP-2
6710 L7777
6711 TAD TRMYTYP
6712 SZA CLA
6713 JMP XNOTYP-2
6714 TAD TRMOP
6715 CLL RAR
6716 DCA IRY
6717 EMIT;60 /*** (48,4) OR (48,5) ***/
6718 JMP TRM1
6719
6720XAND, L7775 /3=BOOLS
6721 TAD I TRMXTYP
6722 SZA CLA
6723 JMP XNOTYP
6724 L7775
6725 TAD TRMYTYP
6726 SZA CLA
6727 JMP XNOTYP
6728 EMIT;64 /*** (52) ***/
6729 JMP TRM1
6730
6731 CLA IAC
6732 IAC
6733XNOTYP, TAD [40
6734 DCA ERRTYP
6735 TAD I TRMXTYP
6736 SZA CLA
6737 TAD TRMYTYP
6738 SZA CLA
6739 ERROR
6740ERRTYP, 00 /32, 33 OR 34
6741 DCA I TRMXTYP /0=NOTYP
6742 JMP TRM1
6743
6744 PAGE
6745\f/PROCEDURE S I M P L E E X P R E S S I O N
6746/ -------------------------------
6747/
6748/CALL: PUSHJUMP;SIMPLEEXPRESSION
6749/ SETX
6750/ X /ADDRESS
6751/
6752/LOCAL VAR'S: FSYS
6753 SIMXTYP,0
6754 SIMYTYP,0
6755 SIMYREF,0
6756 SIMOP, 0
6757
6758XSIMPLE,SKIPIFSYIN;SET8
6759 JMP SIM1
6760 TAD SY
6761 DCA SIMOP
6762 INSYMBOL
6763 TAD SIMXTYP
6764 DCA .+4
6765 PUSHJUMP;TERM
6766 FSYS+SET8
6767 0
6768
6769 L7776 /2=REALS
6770 TAD I SIMXTYP
6771 SPA SNA CLA
6772 JMP .+4
6773 ERROR;41 /33
6774 JMP SIM2
6775 TAD SIMOP
6776 TAD (-MINUS
6777 SNA CLA
6778 EMIT;44 /*** (36) ***/
6779 JMP SIM2
6780SIM1, TAD SIMXTYP
6781 DCA .+4
6782 PUSHJUMP;TERM
6783 FSYS+SET27
6784 0
6785
6786SIM2, SKIPIFSYIN;SET27
6787 POPJUMP;SIMPLEEXPRESSION
6788 TAD SY
6789 DCA SIMOP
6790 INSYMBOL
6791 PUSHJUMP;TERM
6792 FSYS+SET27
6793 SIMYTYP
6794
6795 TAD SIMOP
6796 TAD (-ORSY
6797 SZA CLA
6798 JMP SIM3
6799 L7775 /3=BOOLS
6800 TAD I SIMXTYP
6801 SZA CLA
6802 JMP NOTBOOL
6803 L7775
6804 TAD SIMYTYP
6805 SZA CLA
6806 JMP NOTBOOL
6807 EMIT;63 /*** (51) ***/
6808 JMP SIM2
6809NOTBOOL,TAD I SIMXTYP
6810 SZA CLA
6811 TAD SIMYTYP
6812 SZA CLA
6813 ERROR;40 /32
6814 DCA I SIMXTYP /0=NOTYP
6815 JMP SIM2
6816SIM3, TAD I SIMXTYP
6817 MQL
6818 TAD SIMYTYP
6819 RESULTTYPE
6820 DCA I SIMXTYP
6821 TAD I SIMXTYP
6822 SNA
6823 JMP SIM2
6824 CLL RAR /NOW: 0...INTS, 1...REALS!
6825 SZA CLA
6826 TAD (7
6827 TAD [-4
6828 TAD SIMOP /+ ... 5, - ... 6
6829 DCA IRY
6830 EMIT;60 /*** (48,1) OR (48,2) OR (48,10) OR (48,11) ***/
6831 JMP SIM2
6832
6833 PAGE
6834\f/PROCEDURE E X P R E S S I O N
6835/ -------------------
6836/
6837/CALL: PUSHJUMP;EXPRESSION
6838/ SETX
6839/ X /ADDRESS
6840/
6841/LOCAL VAR'S: FSYS
6842 EXPRVAR,0
6843 XTYP, 0
6844 XREF, 0
6845 YTYP, 0
6846 YREF, 0
6847 OP, 0
6848
6849XEXPRESSION,
6850 PUSHJUMP;SIMPLEEXPRESSION
6851 FSYS+SET28
6852 XTYP
6853
6854 SKIPIFSYIN;SET28
6855 POPJUMP;EXPRESSION
6856 TAD SY
6857 DCA OP
6858 INSYMBOL
6859 PUSHJUMP;SIMPLEEXPRESSION
6860 FSYS
6861 YTYP
6862
6863 L7776 /2=REALS
6864 TAD XTYP
6865 SNA
6866 JMP EXPR1
6867 TAD [-2 /2+2=4=CHARS
6868 SMA SZA CLA
6869 JMP EXPR1
6870 TAD XTYP
6871 CIA
6872 TAD YTYP
6873 SNA CLA
6874 JMP IEXPR
6875EXPR1, L0001
6876 DCA IRY
6877 L7777 /1=INTS
6878 TAD XTYP
6879 SZA CLA
6880 JMP .+5
6881 EMIT;32 /*** (26,1) ***/
6882 L0002 /2=REALS
6883 DCA XTYP
6884 DCA IRY
6885 L7777 /1=INTS
6886 TAD YTYP
6887 SZA CLA
6888 JMP .+5
6889 EMIT;32 /*** (26,0) ***/
6890 L0002 /2=REALS
6891 DCA YTYP
6892 L7776 /2=REALS
6893 TAD XTYP
6894 SZA CLA
6895 JMP ILLTYP
6896 L7776
6897 TAD YTYP
6898 SZA CLA
6899 JMP ILLTYP
6900REXPR, L0001
6901IEXPR, TAD (61
6902 DCA I61R62
6903 TAD OP
6904 TAD (TAD RELTABL-EQL
6905 DCA .+1
6906 0000 /TAD RELTABL (MODIFIED INSTR.!)
6907 DCA IRY
6908 EMIT
6909I61R62, 00 /*** (49,OP) OR (50,OP) ***/
6910EXPR3, L0003 /3=BOOLS
6911 DCA XTYP
6912 POPJUMP;EXPRESSION
6913
6914ILLTYP, ERROR;43 /35
6915 JMP EXPR3
6916
6917RELTABL,SZA
6918 SNA
6919 SPA SNA
6920 SPA
6921 SMA
6922 SMA SZA
6923
6924 PAGE
6925\f/PROCEDURE A S S I G N M E N T
6926/ -------------------
6927/
6928/CALL: PUSHJUMP;ASSIGNMENT
6929/ LEV /VALUE
6930/ ADR /- " -
6931/
6932/LOCAL VAR'S:
6933 LV, 0
6934 AD, 0
6935 AXTYP, 0
6936 AXREF, 0
6937 AYTYP, 0
6938 AYREF, 0
6939
6940XASSIGNMENT,
6941 OFTAB;TYP /J IS SET IN STATEMENT
6942 AND [77
6943 DCA AXTYP
6944 OFTAB;REF
6945 BSW
6946 AND [77
6947 DCA AXREF
6948 TAD LV
6949 DCA IRX
6950 TAD AD
6951 DCA IRY
6952 OFTAB;NORMAL
6953 AND [40
6954 SNA CLA
6955 IAC
6956 DCA .+2
6957 EMIT;00 /*** (0,LV,AD) OR (1,LV,AD) ***/
6958 SKIPIFSYIN;SET22
6959 JMP .+5
6960 PUSHJUMP;SELECTOR
6961 FSYS+SET29
6962 AXTYP
6963
6964 IFSY;BECOMES;JMP .+5
6965 ERROR;63 /51
6966 IFSY;EQL;INSYMBOL
6967 PUSHJUMP;EXPRESSION
6968 FSYS
6969 AYTYP
6970
6971 TAD AXTYP
6972 CIA
6973 TAD AYTYP
6974 SZA CLA
6975 JMP ASS1
6976 TAD AXTYP
6977 TAD [-ARRAY
6978 SPA CLA
6979 JMP ASS2-2
6980 TAD AXREF /ARRAY- OR RECORD-VARIABLE
6981 CIA
6982 TAD AYREF
6983 SZA CLA
6984 JMP ASSERR
6985 TAD AXTYP
6986 TAD [-ARRAY
6987 SZA CLA
6988 JMP .+5
6989 TAD AXREF /ARRAY
6990 OFATAB;SIZE
6991 JMP .+4
6992 TAD AXREF /RECORD
6993 OFBTAB;VSIZE
6994 DCA IRY
6995 EMIT;27 /*** (23,SIZE) ***/
6996 JMP ASS2
6997ASS1, L7776 /2=REALS
6998 TAD AXTYP
6999 SZA CLA
7000 JMP ASS3
7001 L7777 /1=INTS
7002 TAD AYTYP
7003 SZA CLA
7004 JMP ASS3
7005 EMIT;32 /*** (26,0) ***/
7006 EMIT;46 /*** (38) ***/
7007ASS2, POPJUMP;ASSIGNMENT
7008
7009ASS3, TAD AXTYP
7010 SZA CLA
7011 TAD AYTYP
7012 SZA CLA
7013ASSERR, ERROR;56 /46
7014 JMP ASS2
7015\f/PROCEDURE C O M P O U N D S T A T E M E N T
7016/ ---------------------------------
7017/
7018/CALL: PUSHJUMP;COMPOUNDSTATEMENT /NO ARG'S!
7019/
7020/NO LOCAL VAR'S!
7021
7022XCOMPOUNDSTATEMENT,
7023 INSYMBOL
7024 PUSHJUMP;STATEMENT
7025 FSYS+SET30
7026
7027 SKIPIFSYIN;SET31
7028 JMP CMP1
7029 IFSY;SEMICOLON;JMP XCOMPOUNDSTATEMENT
7030 ERROR;16 /14
7031 JMP XCOMPOUNDSTATEMENT+1
7032CMP1, IFSY;ENDSY;JMP .+4
7033 ERROR;71 /57
7034 SKP
7035 INSYMBOL
7036 POPJUMP;COMPOUNDSTATEMENT
7037
7038 PAGE
7039\f/PROCEDURE C A S E L A B E L
7040/ -----------------
7041/
7042/CALL: JMS CASELABEL /NOT RECURSIVE!
7043/
7044/LOCAL VAR'S:
7045 LAB, ZBLOCK 5
7046
7047CASELABEL, 0
7048 PUSHJUMP;CONSTANT
7049 FSYS+SET6
7050 LAB
7051
7052 TAD LAB
7053 CIA
7054 TAD I CCXTYP
7055 SZA CLA
7056 JMP LABERR
7057 TAD I CCI
7058 DCA XR11
7059 TAD XR11
7060 TAD CLIMIT
7061 SNA CLA
7062FATALC, FATAL /TOO MUCH CASE-LABELS!
7063 SIGNEDINTEGER;LAB
7064 DCA TEMP
7065 TAD TEMP
7066 DCA I XR11
7067 TAD LC
7068 DCA I XR11
7069 TAD XR11
7070 DCA I CCI
7071 TAD CTABM1
7072 DCA XR11
7073 TAD I XR11
7074 ISZ XR11
7075 CIA
7076 TAD TEMP
7077 SZA CLA
7078 JMP .-5
7079 TAD XR11
7080 CIA
7081 TAD I CCI
7082 SZA CLA
7083 ERROR;1 /1
7084 JMP I CASELABEL
7085LABERR, ERROR;57 /47
7086 JMP I CASELABEL
7087CCI, CI
7088CCXTYP, CXTYP
7089CLIMIT, -2^CSMAX-CASETAB+1
7090CTABM1, CASETAB-1
7091\f/PROCEDURE C A S E S T A T E M E N T
7092/ -------------------------
7093/
7094/CALL: PUSHJUMP;CASESTATEMENT /NO ARG'S!
7095/
7096/LOCAL VAR'S:
7097 CASETAB, ZBLOCK CSMAX^2
7098 EXITTAB, ZBLOCK CSMAX
7099 CXTYP, 0
7100 CXREF, 0
7101 CLC1, 0
7102 CI, 0
7103 CJ, 0
7104
7105XCASESTATEMENT, INSYMBOL
7106 TAD (CASETAB-1
7107 DCA CI
7108 TAD (EXITTAB-1
7109 DCA CJ
7110 PUSHJUMP;EXPRESSION
7111 FSYS+SET34
7112 CXTYP
7113
7114 L7776 /2=REALS
7115 TAD CXTYP
7116 SNA
7117 JMP .+3
7118 TAD [-2 /2+2=4=CHARS (LAST STANTYP)
7119 SMA SZA CLA
7120 ERROR;27 /23
7121 TAD LC
7122 DCA CLC1
7123 EMIT;14 /*** (12) ***/
7124 IFSY;OFSY;JMP CAS1
7125 ERROR;10 /8
7126 SKP
7127CAS1, INSYMBOL
7128 PUSHJUMP;ONECASE
7129 IFSY;SEMICOLON;JMP CAS1
7130 TAD CLC1
7131 TOCODE
7132 TAD (CASETAB-1
7133 DCA XR11
7134CAS2, TAD XR11
7135 CIA
7136 TAD CI
7137 SNA CLA
7138 JMP CAS3
7139 TAD I XR11
7140 DCA IRY
7141 EMIT;15 /*** (13) ***/
7142 JMP CAS2
7143CAS3, EMIT;12 /*** (10) ***/
7144 TAD (EXITTAB-1
7145 DCA XR11
7146CAS4, TAD XR11
7147 CIA
7148 TAD CJ
7149 SNA CLA
7150 JMP CAS5
7151 TAD I XR11
7152 TOCODE
7153 JMP CAS4
7154CAS5, IFSY;ENDSY;JMP .+4
7155 ERROR;71 /57
7156 SKP
7157 INSYMBOL
7158 POPJUMP;CASESTATEMENT
7159\f/PROCEDURE O N E C A S E
7160/ -------------
7161/
7162/CALL: PUSHJUMP;ONECASE /NO ARG'S!
7163/
7164/NO LOCAL VAR'S! (USES SOME VAR'S OF 'CASESTATEMENT')
7165
7166XONECASE, SKIPIFSYIN;CONBGS
7167 JMP ONE2
7168 SKP
7169ONE1, INSYMBOL
7170 JMS CASELABEL
7171 IFSY;COMMA;JMP ONE1
7172 IFSY;COLON;JMP .+4
7173 ERROR;5 /5
7174 SKP
7175 INSYMBOL
7176 PUSHJUMP;STATEMENT
7177 FSYS+SET30
7178
7179 ISZ CJ
7180 TAD LC
7181 DCA I CJ
7182 EMIT;12 /*** (10) ***/
7183ONE2, POPJUMP;ONECASE
7184
7185 PAGE
7186\f/PROCEDURE I F S T A T E M E N T
7187/ ---------------------
7188/
7189/CALL: PUSHJUMP;IFSTATEMENT /NO ARG'S!
7190/
7191/LOCAL VAR'S:
7192 IXTYP, 0
7193 IXREF, 0
7194 ILC1, 0
7195 ILC2, 0
7196
7197XIFSTATEMENT,
7198 INSYMBOL
7199 PUSHJUMP;EXPRESSION
7200 FSYS+SET32
7201 IXTYP
7202
7203 TAD IXTYP
7204 SNA
7205 JMP .+5
7206 TAD [-BOOLS
7207 SZA CLA
7208 ERROR;21 /17
7209 TAD LC
7210 DCA ILC1
7211 EMIT;13 /*** (11) ***/
7212 IFSY;THENSY;JMP .+5
7213 ERROR;64 /52
7214 IFSY;DOSY;INSYMBOL
7215 PUSHJUMP;STATEMENT
7216 FSYS+SET33
7217
7218 IFSYNOT;ELSESY;JMP IF1
7219 INSYMBOL
7220 TAD LC
7221 DCA ILC2
7222 EMIT;12 /*** (10) ***/
7223 TAD ILC1
7224 TOCODE /*** CODE[ILC1] := LC ***/
7225 PUSHJUMP;STATEMENT
7226 FSYS
7227
7228 TAD ILC2
7229 TOCODE /*** CODE[ILC2] := LC ***/
7230 POPJUMP;IFSTATEMENT
7231IF1, TAD ILC1
7232 JMP .-4 /*** CODE[ILC1] := LC ***/
7233\f/PROCEDURE R E P E A T S T A T E M E N T
7234/ -----------------------------
7235/
7236/CALL: PUSHJUMP;REPEATSTATEMENT /NO ARG'S!
7237/
7238/LOCAL VAR'S:
7239 RXTYP, 0
7240 RXREF, 0
7241 RLC1, 0
7242
7243XREPEAT,TAD LC
7244 DCA RLC1
7245 INSYMBOL
7246 PUSHJUMP;STATEMENT
7247 FSYS+SET35
7248
7249 SKIPIFSYIN;SET31
7250 JMP REP1
7251 IFSY;SEMICOLON;JMP XREPEAT+2
7252 ERROR;16 /14
7253 JMP XREPEAT+3
7254REP1, IFSYNOT;UNTILSY;JMP REPERR
7255 INSYMBOL
7256 PUSHJUMP;EXPRESSION
7257 FSYS
7258 RXTYP
7259
7260 TAD RXTYP
7261 SNA
7262 JMP .+5
7263 TAD [-BOOLS
7264 SZA CLA
7265 ERROR;21 /17
7266 TAD RLC1
7267 DCA IRY
7268 EMIT;13 /*** (11,RLC1) ***/
7269 JMP .+3
7270REPERR, ERROR;65 /53
7271 POPJUMP;REPEATSTATEMENT
7272\f/PROCEDURE W H I L E S T A T E M E N T
7273/ ---------------------------
7274/
7275/CALL: PUSHJUMP;WHILESTATEMENT /NO ARG'S!
7276/
7277/LOCAL VAR'S (ON PAGE ZERO!):
7278/ WXTYP, 0
7279/ WXREF, 0
7280/ WLC1, 0
7281/ WLC2, 0
7282
7283XWHILESTATEMENT,
7284 INSYMBOL
7285 TAD LC
7286 DCA WLC1
7287 PUSHJUMP;EXPRESSION
7288 FSYS+SET36
7289 WXTYP
7290
7291 TAD WXTYP
7292 SNA
7293 JMP .+5
7294 TAD [-BOOLS
7295 SZA CLA
7296 ERROR;21 /17
7297 TAD LC
7298 DCA WLC2
7299 EMIT;13 /*** (11) ***/
7300 IFSY;DOSY;JMP .+4
7301 ERROR;66 /54
7302 SKP
7303 INSYMBOL
7304 PUSHJUMP;STATEMENT
7305 FSYS
7306
7307 TAD WLC1
7308 DCA IRY
7309 EMIT;12 /*** (10,WLC1) ***/
7310 TAD WLC2
7311 TOCODE /*** CODE[WLC2] := LC ***/
7312 POPJUMP;WHILESTATEMENT
7313
7314 PAGE
7315\f/PROCEDURE F O R S T A T E M E N T
7316/ -----------------------
7317/
7318/CALL: PUSHJUMP;FORSTATEMENT /NO ARG'S!
7319/
7320/LOCAL VAR'S:
7321 FXTYP, 0
7322 FXREF, 0
7323 CVT, 0
7324 FLC1, 0
7325 FLC2, 0
7326 FF, 0
7327
7328XFORSTATEMENT,
7329 INSYMBOL
7330 IFSYNOT;IDENT;JMP FOR2
7331 LOCATE
7332 DCA J
7333 INSYMBOL
7334 TAD J
7335 SNA CLA
7336 JMP FOR1+2
7337 WITHTABDO
7338 L7777 /1=VARIABLE
7339 TAD OBJ0
7340 SZA CLA
7341 JMP FOR1
7342 TAD TYP0
7343 DCA CVT
7344 TAD LEV0
7345 DCA IRX
7346 TAD ADR0
7347 DCA IRY
7348 EMIT;0 /*** (0,LEV,ADR) ***/
7349 L7776 /2=REALS
7350 TAD CVT
7351 SNA
7352 JMP .+3
7353 TAD [-2 /2+2=4=CHARS (LAST STANTYP)
7354 SMA SZA CLA
7355 ERROR;22 /18
7356 JMP FOR3
7357FOR1, ERROR;45 /37
7358 L0001 /1=INTS
7359 DCA CVT
7360 JMP FOR3
7361FOR2, SKIP;FSYS+SET37;2 /2
7362FOR3, IFSYNOT;BECOMES;JMP FOR4
7363 INSYMBOL
7364 PUSHJUMP;EXPRESSION
7365 FSYS+SET38
7366 FXTYP
7367
7368 TAD FXTYP
7369 CIA
7370 TAD CVT
7371 SZA CLA
7372 ERROR;23 /19
7373 JMP FOR5
7374FOR4, SKIP;FSYS+SET38;63 /51
7375FOR5, TAD (16 /14
7376 DCA FF
7377 SKIPIFSYIN;SET39
7378 JMP FOR6
7379 IFSY;DOWNTOSY;L0002
7380 TAD (16
7381 DCA FF
7382 INSYMBOL
7383 PUSHJUMP;EXPRESSION
7384 FSYS+SET36
7385 FXTYP
7386
7387 TAD FXTYP
7388 CIA
7389 TAD CVT
7390 SZA CLA
7391 ERROR;23 /19
7392 JMP FOR7
7393FOR6, SKIP;FSYS+SET36;67 /55
7394FOR7, TAD LC
7395 DCA FLC1
7396 TAD FF
7397 DCA .+2
7398 EMIT;00 /*** (14) OR (16) ***/
7399 IFSY;DOSY;JMP .+4
7400 ERROR;66 /54
7401 SKP
7402 INSYMBOL
7403 TAD LC
7404 DCA FLC2
7405 PUSHJUMP;STATEMENT
7406 FSYS
7407
7408 TAD FLC2
7409 DCA IRY
7410 L0001
7411 TAD FF
7412 DCA .+2
7413 EMIT;00 /*** (15,FLC2) OR (17,FLC2) ***/
7414 TAD FLC1
7415 TOCODE /*** CODE[FLC1] := LC ***/
7416 POPJUMP;FORSTATEMENT
7417
7418 PAGE
7419\f/PROCEDURE S T A N D P R O C
7420/ -----------------
7421/
7422/CALL: PUSHJUMP;STANDPROC
7423/ I /VALUE
7424/
7425/LOCAL VAR'S:
7426 PRCN, 0
7427 SPXTYP, 0
7428 SPXREF, 0
7429 SPYTYP, 0
7430 SPYREF, 0
7431
7432XSTPROC,TAD PRCN
7433 TAD (JMP I STPRTAB-1
7434 DCA .+1
7435 HLT
7436
7437STPRTAB,SPREAD
7438 SPREAD
7439 SPWRITE
7440 SPWRITE
7441 SPHALT
7442 SPASCII
7443
7444SPREAD, IFSYNOT;LPARENT;JMP SPR3
7445SPR1, INSYMBOL
7446 IFSY;IDENT;JMP .+4
7447 ERROR;2 /2
7448 JMP SPR2
7449 LOCATE
7450 DCA J
7451 INSYMBOL
7452 TAD J
7453 SNA CLA
7454 JMP SPR2
7455 WITHTABDO
7456 L7777 /1=VARIABLE
7457 TAD OBJ0
7458 SNA CLA
7459 JMP .+4
7460 ERROR;45 /37
7461 JMP SPR2
7462 TAD TYP0
7463 DCA SPXTYP
7464 TAD REF0
7465 DCA SPXREF
7466 TAD LEV0
7467 DCA IRX
7468 TAD ADR0
7469 DCA IRY
7470 TAD NORM0
7471 SNA CLA
7472 IAC
7473 DCA .+2
7474 EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/
7475 SKIPIFSYIN;SET22
7476 JMP .+5
7477 PUSHJUMP;SELECTOR
7478 FSYS+SET24
7479 SPXTYP
7480
7481 L7775 /3=BOOLS
7482 TAD SPXTYP
7483 SNA
7484 JMP SPR2-2
7485 TAD (-1 /4=CHARS (LAST STANTYP)
7486 SMA SZA CLA
7487 JMP SPR2-2
7488 TAD SPXTYP
7489 DCA IRY
7490 EMIT;33 /*** (27,TYP) ***/
7491 JMP SPR2
7492 ERROR;50 /40
7493SPR2, TEST;SET24;FSYS;6 /6
7494 IFSY;COMMA;JMP SPR1
7495 IFSY;RPARENT;JMP .+4
7496 ERROR;4 /4
7497 SKP
7498 INSYMBOL
7499SPR3, L7776 /-2
7500 TAD PRCN
7501 SNA CLA
7502 EMIT;76 /*** (62) ***/
7503 POPJUMP;STANDPROC
7504\fSPASCII,IFSYNOT;LPARENT;JMP SPASC2
7505SPASC1, INSYMBOL
7506 PUSHJUMP;EXPRESSION
7507 FSYS+SET24
7508 SPXTYP
7509
7510 L7777 /1=INTS
7511 TAD SPXTYP
7512 SZA CLA
7513 ERROR;53 /43
7514 EMIT;75 /*** (61) ***/
7515 IFSY;COMMA;JMP SPASC1
7516 IFSY;RPARENT;JMP .+4
7517 ERROR;4 /4
7518 SKP
7519 INSYMBOL
7520SPASC2, POPJUMP;STANDPROC
7521
7522
7523SPHALT, EMIT;45 /*** (37) ***/
7524 POPJUMP;STANDPROC
7525
7526 PAGE
7527\fSPWRITE,IFSYNOT;LPARENT;JMP SPW5
7528SPW1, INSYMBOL
7529 IFSYNOT;STRING;JMP SPW2
7530 TAD SLENG
7531 DCA IRY
7532 EMIT;30 /*** (24,SLENG) ***/
7533 TAD NUM+3
7534 DCA STRNUM
7535 INSYMBOL
7536 IFSYNOT;COLON;JMP SPW1A
7537 INSYMBOL
7538 PUSHJUMP;EXPRESSION
7539 FSYS+SET24
7540 SPYTYP
7541
7542 L7777 /1=INTS
7543 TAD SPYTYP
7544 SZA CLA
7545 ERROR;53 /43
7546 JMP .+3
7547SPW1A, EMIT;30 /*** (24,0) ***/
7548 TAD STRNUM
7549 DCA IRY
7550 EMIT;34 /*** (28,NUM) ***/
7551 JMP SPW4
7552STRNUM, 0
7553
7554SPW2, PUSHJUMP;EXPRESSION
7555 FSYS+SET23
7556 SPXTYP
7557
7558 TAD SPXTYP
7559 TAD [-CHARS
7560 SMA SZA CLA
7561 ERROR;51 /41
7562 IFSYNOT;COLON;JMP SPW3+1
7563 INSYMBOL
7564 PUSHJUMP;EXPRESSION
7565 FSYS+SET23
7566 SPYTYP
7567
7568 L7777 /1=INTS
7569 TAD SPYTYP
7570 SZA CLA
7571 ERROR;53 /43
7572 IFSYNOT;COLON;JMP SPW3
7573 L7776 /2=REALS
7574 TAD SPXTYP
7575 SZA CLA
7576 ERROR;52 /42
7577 INSYMBOL
7578 PUSHJUMP;EXPRESSION
7579 FSYS+SET24
7580 SPYTYP
7581
7582 L7777 /1=INTS
7583 TAD SPYTYP
7584 SZA CLA
7585 ERROR;53 /43
7586 EMIT;37 /*** (31) ***/
7587 JMP SPW4
7588SPW3, L0001
7589 TAD (35
7590 DCA .+4
7591 TAD SPXTYP
7592 DCA IRY
7593 EMIT;00 /*** (29,TYP) OR (30,TYP) ***/
7594SPW4, IFSY;COMMA;JMP SPW1
7595 IFSY;RPARENT;JMP .+4
7596 ERROR;4 /4
7597 SKP
7598 INSYMBOL
7599SPW5, TAD PRCN
7600 TAD [-4
7601 SNA CLA
7602 EMIT;77 /*** (63) ***/
7603 POPJUMP;STANDPROC
7604
7605 PAGE
7606\f/PROCEDURE S T A T E M E N T
7607/ -----------------
7608/
7609/CALL: PUSHJUMP;STATEMENT
7610/ SETX
7611/
7612/NO LOCAL VAR'S!
7613XSTATEMENT,
7614 SKIPIFSYIN;SET40
7615 JMP STAT2
7616 IFSYNOT;IDENT;JMP STAT1
7617 LOCATE
7618 DCA J
7619 INSYMBOL
7620 TAD J
7621 SNA CLA
7622 JMP STAT2
7623 WITHTABDO
7624 TAD OBJ0
7625 TAD JMPOBJ
7626 DCA .+1
7627 HLT
7628
7629OBJTABL,IDCON
7630 IDVAR
7631 IDTYP
7632 IDPRO
7633 IDFUN
7634
7635JMPOBJ, JMP I OBJTABL
7636
7637IDCON,
7638IDTYP, ERROR;55 /45
7639 JMP STAT2
7640
7641IDVAR, TAD LEV0
7642 DCA .+5
7643 TAD ADR0
7644 DCA .+4
7645 PUSHJUMP;ASSIGNMENT
7646 0
7647 0
7648 JMP STAT2
7649
7650IDPRO, TAD LEV0
7651 SNA CLA
7652 JMP IDPRO1
7653 TAD J
7654 DCA .+4
7655 PUSHJUMP;CALL
7656 FSYS
7657 0
7658 JMP STAT2
7659
7660IDPRO1, TAD ADR0
7661 DCA .+3
7662 PUSHJUMP;STANDPROC
7663 0
7664 JMP STAT2
7665
7666IDFUN, OFDISPLAY
7667 CIA
7668 TAD REF0
7669 SZA CLA
7670 JMP IDTYP
7671 L0001
7672 TAD LEV0
7673 DCA .+3
7674 PUSHJUMP;ASSIGNMENT
7675 0
7676 0000 /ALWAYS 0!
7677 JMP STAT2
7678
7679STAT1, TAD SY
7680 TAD STATNO
7681 DCA .+2
7682 PUSHJUMP;00
7683STAT2, TEST;FSYS;SET0;16 /14
7684 POPJUMP;STATEMENT
7685
7686STATNO, COMPOUNDSTATEMENT-BEGINSY
7687\f/PROCEDURE B L O C K
7688/ ---------
7689/
7690/CALL: PUSHJUMP;BLOCK
7691/ SETX
7692/ ISFUN /VALUE
7693/ LEVEL /VALUE
7694/
7695/LOCAL VAR'S (ON PAGE ZERO!):
7696/ FSYS
7697/ ISFUN, 0
7698/ LEVEL, 0
7699/ DX, 0
7700/ PRT, 0
7701/ PRB, 0
7702
7703MAXLEV, -LMAX /CONSTANT
7704TOFAT5, FATAL5
7705C0005, 5
7706BLK1, BLO1
7707BLK2, BLO2
7708BLK2M2, BLO2-2
7709
7710XBLOCK, TAD C0005
7711 DCA DX
7712 TAD T
7713 DCA PRT
7714 TAD LEVEL
7715 TAD MAXLEV
7716 SMA SZA CLA
7717 JMP I TOFAT5 /TOO MUCH LEVELS!
7718 TEST;SET41;FSYS;7 /7
7719 ENTERBLOCK
7720 TAD B
7721 TODISPLAY
7722 TAD B
7723 DCA PRB
7724 TAD PRT
7725 WITHTABDO
7726 DCA TYP0 /0=NOTYP
7727 TAD PRB
7728 DCA REF0
7729 ENDWITH
7730 IFSY;LPARENT;PUSHJUMP;PARAMETERLIST
7731 TAD PRB
7732 DCA JB
7733 TAD T
7734 TOBTAB;LASTPAR
7735 TAD DX
7736 TOBTAB;PSIZE
7737 TAD ISFUN
7738 SNA CLA
7739 JMP I BLK2
7740 IFSYNOT;COLON;JMP I BLK2M2
7741 INSYMBOL
7742 IFSYNOT;IDENT;JMP I BLK1
7743 LOCATE
7744 DCA J
7745 INSYMBOL
7746 TAD J
7747 SNA CLA
7748 JMP BLO2
7749 OFTAB;OBJ
7750 BSW
7751 AND [77
7752 TAD [-2 /2=TYPE1
7753 SNA CLA
7754 JMP .+4
7755 ERROR;35 /29
7756 JMP BLO2
7757 OFTAB;TYP
7758 AND [77
7759 DCA TEMP
7760 TAD TEMP
7761 TAD [-4
7762 SPA SNA CLA
7763 JMP .+4
7764 ERROR;17 /15
7765 JMP BLO2
7766 TAD PRT
7767 DCA J
7768 L0003 /3=PROZEDURE
7769 TAD ISFUN
7770 BSW
7771 TAD TEMP
7772 TOTAB;TYP
7773 JMP BLO2
7774BLO1, SKIP;FSYS+SET20;2 /2
7775 JMP BLO2
7776 ERROR;5 /5
7777BLO2, IFSY;SEMICOLON;JMP .+4
7778 ERROR;16 /14
7779 SKP
7780 INSYMBOL
7781BLO3, IFSY;CONSTSY;PUSHJUMP;CONDECL
7782 IFSY;TYPESY;PUSHJUMP;TYPDECL
7783 IFSY;VARSY;PUSHJUMP;VARDECL
7784 TAD PRB
7785 DCA JB
7786 TAD DX
7787 TOBTAB;VSIZE
7788BLO4, SKIPIFSYIN;SET42
7789 JMP .+4
7790 PUSHJUMP;PRODECL
7791 JMP BLO4
7792 TEST;SET43;SET44;70 /56
7793 SKIPIFSYIN;STATBGS
7794 JMP BLO3
7795 TAD PRT
7796 DCA J
7797 TAD LC
7798 TOTAB;ADR
7799BLO5, INSYMBOL
7800 PUSHJUMP;STATEMENT
7801 FSYS+SET30
7802 SKIPIFSYIN;SET31
7803 JMP BLO6
7804 IFSY;SEMICOLON;JMP BLO5
7805 ERROR;16 /14
7806 JMP BLO5+1
7807BLO6, IFSY;ENDSY;JMP .+4
7808 ERROR;71 /57
7809 SKP
7810 INSYMBOL
7811 TEST;FSYS+SET45;SET0;6 /6
7812 POPJUMP;BLOCK
7813
7814 PAGE
7815\f/M A C R O - I N S T R U C T I O N S :
7816
7817
7818/P U S H J U M P /RECURSIVE CALL OF COMPILER PROCEDURES
7819 /CALL: PUSHJUMP;NAME
7820/P O P J U M P /RETURN FROM PROCEDURE
7821 /CALL: POPJUMP;NAME
7822
7823
7824/LOCAL, 0 /START OF LOCAL VARIABLES - 1
7825/LENGTH, 0 / - NO. OF LOC'S TO PUSH (EXCL. FSYS)
7826/PARAM, 0 /NO. OF PARAMETERS + 4000 (IF 1ST ONE IS A SET)
7827PSTART, 0 /STARTING ADDRESS OF PROCEDURE
7828
7829PPP, 0 /STACK POINTER (POINTS ALWAYS TO 1ST FREE LOC.)
7830
7831
7832CONTROL,0
7833 CLL RTL
7834 TAD (PUSHTABLE-1
7835 DCA XR10
7836 CDF SETFIELD
7837 TAD I XR10
7838 DCA LOCAL
7839 TAD I XR10
7840 DCA LENGTH
7841 TAD I XR10
7842 DCA PARAM
7843 TAD I XR10
7844 DCA PSTART
7845 CDF COMPFIELD
7846 JMP I CONTROL
7847
7848PUSH, 0
7849 CDF PUSHFIELD
7850 DCA I PPP
7851 CDF COMPFIELD
7852 ISZ PPP
7853 JMP I PUSH
7854FATAL8, FATAL /PROGRAMM TOO COMPLEX ---> STACK FULL!
7855
7856POP, 0
7857 L7777
7858 TAD PPP
7859 DCA PPP
7860 CDF PUSHFIELD
7861 TAD I PPP
7862 CDF COMPFIELD
7863 JMP I POP
7864
7865XPUSHJ, 0
7866 TAD I XPUSHJ
7867 ISZ XPUSHJ
7868 JMS CONTROL
7869 TAD LENGTH
7870 SNA CLA
7871 JMP PUFSYS
7872 TAD LOCAL
7873 DCA XR10
7874 TAD I XR10
7875 JMS PUSH /PUSH LOCAL VARIABLES (IF ANY)
7876 ISZ LENGTH
7877 JMP .-3
7878PUFSYS, TAD PARAM
7879 SMA CLA
7880 JMP GETPAR
7881 L3777 /FSYS-1
7882 DCA XR10
7883 TAD [-5
7884 DCA LENGTH
7885 CDF SETFIELD
7886 TAD I XR10
7887 JMS PUSH /PUSH FSYS (IF NECESSARY)
7888 ISZ LENGTH
7889 JMP .-4
7890GEFSYS, L4000 /GET SET-ARGUMENT (IF PRESENT)
7891 DCA SETA
7892 TAD I XPUSHJ
7893 SPA
7894 DCA SETA /<0: FSYS OR SETX ONLY
7895 TAD SETA />0: FSYS+SETX
7896 DCA SETB
7897 ISZ XPUSHJ
7898 UNION
7899SETA, FSYS
7900SETB, SET0
7901 FSYS
7902GETPAR, TAD PARAM /GET PARAMETERS
7903 AND [77
7904 SNA
7905 JMP RECALL
7906 CIA
7907 DCA LENGTH
7908 TAD LOCAL
7909 DCA XR10
7910 TAD I XPUSHJ
7911 ISZ XPUSHJ
7912 DCA I XR10
7913 ISZ LENGTH
7914 JMP .-4
7915 JMS VARIN /PASS VAR-PARAMETERS (IF ANY)
7916RECALL, TAD XPUSHJ
7917 JMS PUSH /PUSH RETURN ADDRESS
7918 JMP I PSTART /AND J U M P TO PROCEDURE
7919
7920XPOPJUMP,0
7921 TAD I XPOPJUMP
7922 JMS CONTROL
7923 JMS POP /GET RETURN ADDRESS
7924 DCA PSTART
7925 TAD PARAM
7926 SMA CLA
7927 JMP POVAR
7928 TAD (FSYS+4
7929 DCA PUSH /(MIS)USE THIS FREE LOC.
7930 TAD [-5
7931 DCA CONTROL
7932 JMS POP /POP FSYS (IF IT WAS PUSHED)
7933 CDF SETFIELD
7934 DCA I PUSH
7935 L7777
7936 TAD PUSH
7937 DCA PUSH
7938 ISZ CONTROL
7939 JMP .-7
7940 CDF COMPFIELD
7941POVAR, JMS VARTM /TEMP. STORE VAR-PARAMETERS
7942 TAD LENGTH
7943 SNA
7944 JMP I PSTART
7945 CIA
7946 TAD LOCAL
7947 DCA PUSH
7948 JMS POP /POP LOCAL VARIABLES (IF ANY)
7949 DCA I PUSH
7950 L7777
7951 TAD PUSH
7952 DCA PUSH
7953 ISZ LENGTH
7954 JMP .-6
7955 JMS VAREX /PASS VAR-PARAMETERS (IF ANY)
7956 JMP I PSTART /R E T U R N
7957
7958 PAGE
7959\f/M A C R O - I N S T R U C T I O N S :
7960
7961
7962/O F D I S P L A Y /AC := DISPLAY[LEVEL]
7963
7964/T O D I S P L A Y /DISPLAY[LEVEL] := AC
7965
7966/O F T A B /AC := TAB[AC].SEL, IF AC=0 GET TAB[J].SEL
7967
7968/T O T A B /TAB[J].SEL := AC
7969
7970/O F A T A B /AC := ATAB[AC].SEL, IF AC=0 GET ATAB[JA].SEL
7971
7972/T O A T A B /ATAB[JA].SEL := AC
7973
7974/O F B T A B /AC := BTAB[AC].SEL, IF AC=0 GET BTAB[JB].SEL
7975
7976/T O B T A B /BTAB[JB].SEL := AC
7977
7978/W I T H T A B D O /GET AND UNPACK TAB[AC] OR TAB[J]
7979
7980/E N D W I T H /PACK AND STORE UNPACKED ENTRY OF TAB
7981
7982XOFDISP,0
7983 TAD (DISPLAY
7984 TAD LEVEL
7985 DCA QQ
7986 TAD I QQ
7987 JMP I XOFDISP
7988
7989XTODISP,0
7990 MQL
7991 TAD (DISPLAY
7992 TAD LEVEL
7993 DCA QQ
7994 MQA
7995 DCA I QQ
7996 JMP I XTODISP
7997
7998XOFTAB, 0
7999 SNA
8000 TAD J
8001 CLL RTL
8002 TAD I XOFTAB
8003 DCA QQ
8004 ISZ XOFTAB
8005 CDF TABLEFIELD
8006 TAD I QQ
8007 CDF COMPFIELD
8008 JMP I XOFTAB
8009
8010XTOTAB, 0
8011 MQL
8012 TAD J
8013 CLL RTL
8014 TAD I XTOTAB
8015 DCA QQ
8016 ISZ XTOTAB
8017 CDF TABLEFIELD
8018 MQA
8019 DCA I QQ
8020 CDF COMPFIELD
8021 JMP I XTOTAB
8022
8023XOFATAB,0
8024 SNA
8025 TAD JA
8026 CLL RAL
8027 CLL RTL
8028 TAD I XOFATAB
8029 DCA QQ
8030 ISZ XOFATAB
8031 CDF TABLEFIELD
8032 TAD I QQ
8033 CDF COMPFIELD
8034 JMP I XOFATAB
8035
8036QQ=.
8037XTOATAB,0
8038 MQL
8039 TAD XTOATAB
8040 DCA XTOTAB
8041 TAD JA
8042 CLL RAL
8043 JMP XTOTAB+3
8044
8045XOFBTAB,0
8046 SNA
8047 TAD JB
8048 CLL RTL
8049 TAD I XOFBTAB
8050 DCA QQ
8051 ISZ XOFBTAB
8052 CDF TABLEFIELD
8053 TAD I QQ
8054 CDF COMPFIELD
8055 JMP I XOFBTAB
8056
8057XTOBTAB,0
8058 MQL
8059 TAD XTOBTAB
8060 DCA XTOTAB
8061 TAD JB
8062 JMP XTOTAB+3
8063
8064XWITHTAB,0
8065 SNA
8066 TAD J
8067 CLL RTL
8068 DCA JW /SYMBOL TABLE STARTS AT 0000 !
8069 TAD JW
8070 DCA XR10
8071 CDF TABLEFIELD
8072 TAD I JW
8073 DCA LINK0
8074 TAD I XR10
8075 MQL
8076 MQA
8077 BSW
8078 AND [77
8079 DCA OBJ0
8080 MQA
8081 AND [77
8082 DCA TYP0
8083 TAD I XR10
8084 MQL
8085 MQA
8086 BSW
8087 AND [77
8088 DCA REF0
8089 MQA
8090 AND [40
8091 DCA NORM0
8092 MQA
8093 AND [17
8094 DCA LEV0
8095 TAD I XR10
8096 DCA ADR0
8097 CDF COMPFIELD
8098 JMP I XWITHTAB
8099
8100XENDWITH,0
8101 TAD JW
8102 DCA XR10
8103 CDF TABLEFIELD
8104 TAD LINK0
8105 DCA I JW
8106 TAD OBJ0
8107 BSW
8108 TAD TYP0
8109 DCA I XR10
8110 TAD REF0
8111 BSW
8112 TAD NORM0
8113 TAD LEV0
8114 DCA I XR10
8115 TAD ADR0
8116 DCA I XR10
8117 CDF COMPFIELD
8118 JMP I XENDWITH
8119
8120 PAGE
8121\f/M A C R O - I N S T R U C T I O N S :
8122
8123/W I T H A T A B D O /GET AND UNPACK ATAB[JA]
8124
8125/E N D A W I T H /PACK AND STORE UNPACKED ENTRY OF ATAB
8126
8127/E M I T /EMIT INTERMEDIATE CODE (F,IRX,IRY)
8128 /CALL: EMIT;F
8129
8130/T O C O D E /CODE[AC].IRY := LC
8131
8132/E N T E R C O N S T A N T /ENTER REAL OR INTEGER INTO CONSTANT TABLE
8133 /CALL: ENTERCONSTANT;ADDRESS-1
8134
8135
8136XWITHATAB,0
8137 TAD JA
8138 CLL RAL
8139 CLL RTL
8140 TAD (ATAB
8141 DCA JAW
8142 TAD JAW
8143 DCA XR10
8144 TAD [-7
8145 DCA QR
8146 TAD (DCA INXTP0
8147 DCA .+3
8148 CDF TABLEFIELD
8149 TAD I XR10
8150 0000 /DCA INXTP0 (MODIFIED INSTR.!)
8151 ISZ .-1
8152 ISZ QR
8153 JMP .-4
8154 CDF COMPFIELD
8155 JMP I XWITHATAB
8156
8157XENDAW, 0
8158 TAD JAW
8159 DCA XR10
8160 TAD [-7
8161 DCA QR
8162 TAD (TAD INXTP0
8163 DCA .+2
8164 CDF TABLEFIELD
8165 0000 /TAD INXTP0 (MODIFIED INSTR.!)
8166 DCA I XR10
8167 ISZ .-2
8168 ISZ QR
8169 JMP .-4
8170 CDF COMPFIELD
8171 JMP I XENDAW
8172
8173XEMIT, 0
8174 TAD LC
8175 CLL RAL
8176 DCA XTOCODE
8177 TAD I XEMIT /GET OP-CODE
8178 BSW
8179 TAD IRX
8180 CDF CODEFIELD
8181 DCA I XTOCODE
8182 ISZ XTOCODE
8183 TAD IRY
8184 DCA I XTOCODE
8185 CDF COMPFIELD
8186 ISZ LC
8187 TAD LC
8188 TAD (-CMAX
8189 SMA SZA CLA
8190FATAL6, FATAL /PROGRAM TOO LONG!
8191 DCA IRX
8192 DCA IRY
8193 JMP I XEMIT
8194
8195QR=.
8196XTOCODE,0
8197 STL RAL
8198 DCA XEMIT
8199 CDF CODEFIELD
8200 TAD LC
8201 DCA I XEMIT
8202 CDF COMPFIELD
8203 JMP I XTOCODE
8204
8205CENTRY=XWITHATAB
8206CTEMP=XENDAW
8207FOUR=XEMIT
8208
8209XENTCON,0
8210 TAD I XENTCON
8211 DCA XR10
8212 ISZ XENTCON
8213 TAD C
8214 TAD [-4
8215 DCA CENTRY
8216 TAD SX
8217 STL RAR
8218 CIA
8219 TAD CENTRY
8220 SPA CLA
8221FATAL3, FATAL /TOO MUCH CONSTANTS!
8222 TAD [-4
8223 DCA FOUR
8224 TAD CENTRY
8225 DCA XR12
8226 TAD I XR10
8227 CDF TABLEFIELD
8228 DCA I XR12
8229 CDF COMPFIELD
8230 ISZ FOUR
8231 JMP .-5
8232 TAD CENTRY
8233 DCA CTEMP
8234 CDF TABLEFIELD
8235SEARCH, L0004
8236 TAD CTEMP
8237 DCA CTEMP
8238 TAD CTEMP
8239 TAD (-ATAB+1
8240 SMA CLA
8241 JMP NOTFOUND
8242 TAD [-4
8243 DCA FOUR
8244 TAD CENTRY
8245 DCA XR10
8246 TAD CTEMP
8247 DCA XR12
8248 TAD I XR10
8249 CIA
8250 TAD I XR12
8251 SZA CLA
8252 JMP SEARCH
8253 ISZ FOUR
8254 JMP .-6
8255 TAD CTEMP /FOUND
8256 JMP .+4
8257NOTFOUND,TAD CENTRY
8258 DCA C
8259 TAD CENTRY
8260 CDF COMPFIELD
8261 JMP I XENTCON
8262
8263 PAGE
8264\f/M A C R O - I N S T R U C T I O N S :
8265
8266
8267/E N T E R /ENTER OBJEJT INTO SYMBOL TABLE
8268 /CALL: ENTER;OBJ
8269
8270/E N T E R V A R I A B L E
8271
8272/E N T E R B L O C K
8273
8274/E N T E R A R R A Y
8275
8276/S I G N E D I N T E G E R /MAKE 12-BIT SIGNED INTEGER OF CONSTANT
8277 /CALL: SIGNEDINTEGER;ADDRESS-1
8278
8279
8280XENTER, 0
8281 TAD T
8282 TAD (-TMAX
8283 SMA CLA
8284FATAL1, FATAL /SYMBOL TABLE FULL!
8285 JMS ENTID
8286 OFDISPLAY
8287 OFBTAB;LAST
8288 DCA J
8289 TAD J
8290 DCA L
8291 JMS CHKID
8292 JMP .+5
8293 OFTAB;LINK
8294 DCA J
8295 JMP .-5
8296 TAD J
8297 SNA CLA
8298 JMP .+4
8299 ERROR;1 /1
8300 JMP I XENTER
8301 ISZ T
8302 TAD T
8303 JMS ENTID
8304 TAD I XENTER
8305 MQL
8306 L3777
8307 TAD T
8308 STL RTL /4*T - 1
8309 DCA XR10
8310 CDF TABLEFIELD
8311 TAD L /LINK
8312 DCA I XR10
8313 MQA
8314 BSW /OBJ, TYP (0=NOTYP)
8315 DCA I XR10
8316 TAD LEVEL /REF=0, NORMAL=0, LEVEL
8317 DCA I XR10
8318 DCA I XR10 /ADR=0
8319 CDF COMPFIELD
8320 OFDISPLAY
8321 DCA JB
8322 TAD T
8323 TOBTAB;LAST
8324 JMP I XENTER
8325
8326XENTVAR,0
8327 IFSY;IDENT;JMP .+4
8328 ERROR;2 /2
8329 JMP I XENTVAR
8330 ENTER;VARIABLE
8331 INSYMBOL
8332 JMP I XENTVAR
8333
8334XENTBLO,0
8335 TAD B
8336 TAD (-BMAX
8337 SMA CLA
8338FATAL2, FATAL /TOO MUCH BLOCKS!
8339 ISZ B
8340 TAD B
8341 DCA JB
8342 TOBTAB;LAST
8343 TOBTAB;LASTPAR
8344 JMP I XENTBLO
8345
8346ATP=XENTBLO
8347XENTARR,0
8348 DCA ATP
8349 TAD LO
8350 CIA
8351 TAD HI
8352 SPA CLA
8353 ERROR;33 /27
8354 TAD A
8355 TAD (-AMAX
8356 SMA CLA
8357FATAL4, FATAL
8358 ISZ A
8359 TAD A
8360 DCA JA
8361 TAD ATP
8362 TOATAB;INXTYP
8363 TAD LO
8364 TOATAB;LOW
8365 TAD HI
8366 TOATAB;HIGH
8367 JMP I XENTARR
8368
8369XSGNINT,0
8370 L0001 /LINK=0!
8371 TAD I XSGNINT
8372 ISZ XSGNINT
8373 DCA XR10
8374 TAD I XR10
8375 SZA
8376 TAD [4000 /LINK=1? ---> NEGATIVE
8377 SZA CLA
8378 JMP ERR49
8379 TAD I XR10
8380 SZA CLA
8381 JMP ERR49
8382 TAD I XR10
8383 SPA
8384 JMP ERR49
8385 SZL
8386 CIA
8387 JMP I XSGNINT
8388ERR49, ERROR;61 /49
8389 JMP I XSGNINT
8390
8391 PAGE
8392\f/-------- D I S P L A Y --------/
8393/
8394 *7400
8395IFNZRO DISPLAY-. <PARALLEL DEFINED IN FIELD 0 AND FIELD 4 !!!>
8396 1 /DISPLAY[0] := 1
8397 ZBLOCK 17
8398
8399/---------------------------------/
8400
8401
8402/M A C R O - I N S T R U C T I O N S :
8403
8404
8405/L O C A T E /LOCATE IDENTIFIER IN SYMBOL TABLE
8406 /EXITS WITH TABLE INDEX IN AC
8407
8408/E N T I D /TAB[AC].NAME := ID
8409
8410/C H K I D /SKIP IF TAB[J].NAME <> ID
8411
8412/G E T C O N S T A N T /NUM := CTAB[AC]
8413
8414
8415XLOCATE,0
8416 TAD LEVEL
8417 DCA L
8418 JMS ENTID
8419NSCOPE, TAD L
8420 TAD (TAD DISPLAY
8421 DCA .+1
8422 0000 /TAD DISPLAY (MODIFIED INSTR.!)
8423 OFBTAB;LAST
8424 DCA J
8425 JMS CHKID
8426 JMP .+5
8427 OFTAB;LINK
8428 DCA J
8429 JMP .-5
8430 L7777
8431 TAD L
8432 DCA L
8433 TAD J
8434 SZA
8435 JMP I XLOCATE
8436 TAD L
8437 SMA CLA
8438 JMP NSCOPE
8439 ERROR;0 0
8440 JMP I XLOCATE
8441
8442ENTID, 0
8443 CLL RTL
8444 TAD (-1
8445 DCA XR10
8446 CDF NAMEFIELD
8447 TAD ID
8448 DCA I XR10
8449 TAD ID+1
8450 DCA I XR10
8451 TAD ID+2
8452 DCA I XR10
8453 TAD ID+3
8454 DCA I XR10
8455 CDF COMPFIELD
8456 JMP I ENTID
8457
8458CHKID, 0
8459 TAD J
8460 CLL RTL
8461 TAD (-1
8462 DCA XR10
8463 CDF NAMEFIELD
8464 TAD I XR10
8465 CIA
8466 TAD ID
8467 SZA CLA
8468 JMP NOTEQL
8469 TAD I XR10
8470 CIA
8471 TAD ID+1
8472 SZA CLA
8473 JMP NOTEQL
8474 TAD I XR10
8475 CIA
8476 TAD ID+2
8477 SZA CLA
8478 JMP NOTEQL
8479 TAD I XR10
8480 CIA
8481 TAD ID+3
8482 SZA CLA
8483NOTEQL, ISZ CHKID
8484 CDF COMPFIELD
8485 JMP I CHKID
8486
8487XOFCONST,0
8488 DCA XR10
8489 CDF TABLEFIELD
8490 TAD I XR10
8491 DCA NUM
8492 TAD I XR10
8493 DCA NUM+1
8494 TAD I XR10
8495 DCA NUM+2
8496 TAD I XR10
8497 DCA NUM+3
8498 CDF COMPFIELD
8499 JMP I XOFCONST
8500
8501XERROR, 0
8502 CLA CLL
8503 TAD I XERROR
8504 CIF SETFIELD
8505 JMS I (F3ERROR
8506 JMP I XERROR
8507
8508XFATAL, 0
8509 TAD XFATAL
8510 CDF CIF SETFIELD
8511 JMP I (F3FATAL
8512
8513XINSYMBOL,0
8514 CDF CIF 0
8515 JMP I (INSY0
8516EXSY3, DCA SY
8517 JMP I XINSYMBOL
8518
8519 PAGE
8520\f/M A C R O - I N S T R U C T I O N S :
8521
8522
8523/T E S T S E M I C O L O N
8524
8525/S K I P /CALL: SKIP;SETX;N
8526
8527/T E S T /CALL: TEST;SETX;SETY;N
8528
8529/S K I P I F S Y I N /CALL: SKIPIFSYIN;SETX
8530
8531/I F S Y /CALL: IFSY;SYMBOL
8532
8533/I F S Y N O T /CALL: IFSYNOT;SYMBOL
8534
8535/U N I O N /CALL: UNION;SET1;SET2;S1US2
8536
8537XTSTSEM,0
8538 IFSY;SEMICOLON;JMP .+6
8539 ERROR;16 /14
8540 SKIPIFSYIN;SET6
8541 SKP
8542 INSYMBOL
8543 TEST;SET7;FSYS;6 /6
8544 JMP I XTSTSEM
8545
8546XSKIP, 0
8547 TAD I XSKIP
8548 JMS FSYSUSETX
8549 DCA .+11
8550 ISZ XSKIP
8551 TAD I XSKIP
8552 DCA .+2
8553 ERROR;00 /N
8554 SKP
8555 INSYMBOL
8556 SKIPIFSYIN;00
8557 JMP .-3
8558 JMP I XSKIP
8559
8560XTEST, 0
8561 TAD I XTEST
8562 JMS FSYSUSETX
8563 DCA .+3
8564 ISZ XTEST
8565 SKIPIFSYIN;00
8566 SKP
8567 JMP XTST1
8568 TAD .-3
8569 DCA S1
8570 TAD I XTEST
8571 JMS FSYSUSETX
8572 DCA S2
8573 ISZ XTEST
8574 UNION
8575S1, 0
8576S2, 0
8577 S1US2
8578 TAD I XTEST
8579 DCA .+3
8580 SKIP;S1US2;00 /N
8581XTST1, ISZ XTEST
8582 JMP I XTEST
8583
8584FSYSUSETX, 0
8585 SPA
8586 JMP I FSYSUSETX
8587 TAD [4000
8588 DCA .+3
8589 UNION
8590 FSYS
8591 0
8592 S1US2
8593 TAD .-1
8594 JMP I FSYSUSETX
8595
8596INSET, 0
8597 TAD SY
8598 CLL RAL
8599 TAD (SETTABLE
8600 DCA S2
8601 TAD I INSET
8602 ISZ INSET
8603 CDF SETFIELD
8604 TAD I S2
8605 DCA S1 /ADDRESS OF RELATIVE SET WORD
8606 ISZ S2 /ADDRESS OF BIT POS. REL. TO SY
8607 TAD I S1
8608 AND I S2
8609 SZA CLA
8610 ISZ INSET
8611 CDF COMPFIELD
8612 JMP I INSET
8613
8614XIFSY, 0
8615 TAD SY
8616 CIA
8617 TAD I XIFSY
8618 SZA CLA
8619 ISZ XIFSY
8620 ISZ XIFSY
8621 JMP I XIFSY
8622
8623XIFSYNOT,0
8624 TAD SY
8625 CIA
8626 TAD I XIFSYNOT
8627 SNA CLA
8628 ISZ XIFSYNOT
8629 ISZ XIFSYNOT
8630 JMP I XIFSYNOT
8631
8632XSA=XIFSY /NORMAL LOC.
8633XSB=XR10 /AUTO INDEX
8634XSU=XR12 / - " -
8635FIVE=XIFSYNOT
8636
8637XUNION, 0
8638 TAD I XUNION
8639 DCA XSA
8640 ISZ XUNION
8641 L7777
8642 TAD I XUNION
8643 DCA XSB
8644 ISZ XUNION
8645 L7777
8646 TAD I XUNION
8647 DCA XSU
8648 ISZ XUNION
8649 TAD [-5
8650 DCA FIVE
8651 CDF SETFIELD
8652 TAD I XSA
8653 CMA
8654 AND I XSB
8655 TAD I XSA
8656 DCA I XSU
8657 ISZ XSA
8658 ISZ FIVE
8659 JMP .-7
8660 CDF COMPFIELD
8661 JMP I XUNION
8662
8663 PAGE
8664\f/L O N G E R R O R M E S S A G E S
8665
8666 FIELD 6
8667 *0
8668
8669 ZBLOCK 73 /ERROR COUNTERS
8670 7777 /GUARD
8671ERRSUM, 0 /NUMBER OF DETECTED ERRORS
8672
8673 *100 /ADDRESS LIST OF ERROR MESSAGES
8674 E00
8675 E01
8676 E02
8677 E03
8678 E04
8679 E05
8680 E06
8681 E07
8682 E08
8683 E09
8684 E10
8685 E11
8686 E12
8687 E13
8688 E14
8689 E15
8690 E16
8691 E17
8692 E18
8693 E19
8694 E20
8695 E21
8696 E22
8697 E23
8698 E24
8699 E25
8700 E26
8701 E27
8702 E28
8703 E29
8704 E30
8705 E31
8706 E32
8707 E33
8708 E34
8709 E35
8710 E36
8711 E37
8712 E38
8713 E39
8714 E40
8715 E41
8716 E42
8717 E43
8718 E44
8719 E45
8720 E46
8721 E47
8722 E48
8723 E49
8724 E50
8725 E51
8726 E52
8727 E53
8728 E54
8729 E55
8730 E56
8731 E57
8732 E58
8733
8734 *200
8735EXPLAIN,CLA CLL
8736 TAD ERRSUM
8737 SNA CLA
8738 JMP EXCOMP
8739 JMS ECRLF
8740 JMS ECRLF
8741 TAD (EHEAD
8742 DCA ETEXT
8743 JMS EMESG
8744 JMS ECRLF
8745 JMS ECRLF
8746 DCA ENN
8747 SKP
8748ELINE, ISZ ENN
8749 TAD I ENN
8750 SPA
8751 JMP EXOS8
8752 SNA CLA /SKP CLA ---> PRINT ALL!
8753 JMP ELINE
8754 CLA IAC BSW /L0100
8755 TAD ENN
8756 DCA ETEXT
8757 TAD I ETEXT
8758 DCA ETEXT
8759 JMS EMESG
8760 JMS ECRLF
8761 JMP ELINE
8762
8763FXPLAIN,CLA CLL
8764 TAD ERRSUM
8765 SZA CLA
8766 JMP EXPLAIN+5
8767EXOS8, CLA CLL
8768 JMS ECRLF
8769 CDF CIF 0
8770 JMP I (7605
8771ENN, 0
8772
8773EXCOMP, JMS ECRLF
8774 JMS ECRLF
8775 TAD (EOKAY
8776 DCA ETEXT
8777 JMS EMESG
8778 JMS ECRLF
8779 JMS ECRLF
8780 CDF CIF 60
8781 JMP I (INIT /INITIALIZE RUNTIME SYSTEM
8782
8783EPRINT, 0
8784 TLS
8785 TSF
8786 JMP .-1
8787 CLA CLL
8788 JMP I EPRINT
8789
8790ECRLF, 0
8791 TAD (215
8792 JMS EPRINT
8793 TAD (212
8794 JMS EPRINT
8795 JMP I ECRLF
8796
8797EMESG, 0
8798 TAD I ETEXT
8799 BSW
8800 JMS EASCII
8801 TAD I ETEXT
8802 JMS EASCII
8803 ISZ ETEXT
8804 JMP EMESG+1
8805
8806EASCII, 0
8807 AND (77
8808 SNA
8809 JMP I EMESG
8810 TAD (240
8811 AND (77
8812 TAD (240
8813 JMS EPRINT
8814 JMP I EASCII
8815ETEXT, 0
8816
8817EOKAY, TEXT /KOMPILATION EINWANDFREI!/
8818
8819EHEAD, TEXT /ERKLAERUNG DER FEHLER:/
8820
8821 PAGE
8822
8823\f/L O N G E R R O R M E S S A G E S
8824/
8825/(MADE INVISIBLE BY 'XLIST' TO SAVE PAPER IN ASSEMBLY LISTING!)
8826
8827XLIST
8828
8829E00,TEXT / 0 DIESER NAME WURDE NICHT VEREINBART./
8830E01,TEXT / 1 NAME IM GUELTIGKEITSBEREICH MEHRFACH VEREINBART./
8831E02,TEXT / 2 NAME FEHLT!/
8832E03,TEXT / 3 JEDES PROGRAMM MUSS MIT DEM WORTSYMBOL 'PROGRAM' BEGINNE/
8833 *.-1
8834 TEXT /N./
8835E04,TEXT / 4 RUNDE RECHTSKLAMMER FEHLT (ECKIGE KLAMMER HIER FALSCH)./
8836E05,TEXT / 5 DOPPELPUNKT FEHLT. IN VEREINBARUNGEN FOLGT DEM : EIN TYP/
8837 *.-1
8838 TEXT /NAME./
8839E06,TEXT / 6 SYNTAXFEHLER! ANGEZEIGTES SYMBOL HIER NICHT KORREKT./
8840E07,TEXT / 7 LISTE DER FORMALPARAMETER FEHLERHAFT (NAME ODER WORTSYMB/
8841 *.-1
8842 TEXT /OL 'VAR')./
8843E08,TEXT / 8 DAS WORTSYMBOL 'OF' FEHLT./
8844E09,TEXT / 9 RUNDE LINKSKLAMMER FEHLT (ECKIGE KLAMMER HIER FALSCH)./
8845E10,TEXT /10 TYPVEREINBARUNG FEHLERHAFT (NAME, 'ARRAY' ODER 'RECORD')./
8846E11,TEXT /11 ECKIGE LINKSKLAMMER FEHLT (RUNDE KLAMMER HIER FALSCH)./
8847E12,TEXT /12 ECKIGE RECHTSKLAMMER FEHLT (RUNDE KLAMMER HIER FALSCH)./
8848E13,TEXT /13 SYMBOL .. FEHLT (LEERZEICHEN ZWISCHEN DEN PUNKTEN UNZULA/
8849 *.-1
8850 TEXT /ESSIG)./
8851E14,TEXT /14 STRICHPUNKT FEHLT!/
8852E15,TEXT /15 FUNKTIONSWERT KANN NUR VOM TYP INTEGER, REAL, BOOLEAN OD/
8853 *.-1
8854 TEXT /ER CHAR SEIN./
8855E16,TEXT /16 SYMBOL = FEHLT (IN VEREINBARUNGEN IST := UNZULAESSIG)./
8856E17,TEXT /17 NACH 'IF', 'WHILE' ODER 'UNTIL' MUSS EIN BOOL'SCHER AUSD/
8857 *.-1
8858 TEXT /RUCK STEHEN./
8859E18,TEXT /18 ZAEHLVARIABLE BEI 'FOR'-ANWEISUNG MUSS VOM TYP INTEGER, /
8860 *.-1
8861 TEXT /CHAR ODER BOOLEAN SEIN./
8862E19,TEXT /19 ANFANGSWERT, ENDWERT UND ZAEHLVARIABLE MUESSEN VOM GLEIC/
8863 *.-1
8864 TEXT /HEN TYP SEIN./
8865E20,TEXT /20 DER STANDARDNAME 'OUTPUT' MUSS IM PROGRAMMKOPF GESCHRIEB/
8866 *.-1
8867 TEXT /EN WERDEN./
8868E21,TEXT /21 ZAHL IST ZU GROSS! (MAXINT=34359738367, REALS ABS. KLEIN/
8869 *.-1
8870 TEXT /ER ALS 1.0E+308)/
8871E22,TEXT /22 PUNKT AM PROGRAMMENDE FEHLT! (WORTSYMBOLE 'BEGIN' UND 'E/
8872 *.-1
8873 TEXT /ND' NICHT PAARWEISE?)/
8874E23,TEXT /23 AUSDRUCK NACH 'CASE' MUSS VOM TYP INTEGER, CHAR ODER BOO/
8875 *.-1
8876 TEXT /LEAN SEIN./
8877E24,TEXT /24 ILLEGALES ZEICHEN!/
8878E25,TEXT /25 BEI KONSTANTENVEREINBARUNG MUSS NACH = EINE KONSTANTE OD/
8879 *.-1
8880 TEXT /. EIN KONST.NAME STEHEN./
8881E26,TEXT /26 DER AUSDRUCK FUER EINEN FELD-INDEX MUSS VOM VEREINBARTEN/
8882 *.-1
8883 TEXT / INDEX-TYP SEIN./
8884E27,TEXT /27 BEREICHSGRENZEN BEI FELDVEREINBARUNG FEHLERHAFT (UG<=OG?/
8885 *.-1
8886 TEXT / GLEICHER TYP?)/
8887E28,TEXT /28 JEDE INDIZIERTE VARIABLE MUSS ALS ARRAY VEREINBART WERDE/
8888 *.-1
8889 TEXT /N./
8890E29,TEXT /29 TYPNAME FEHLT (IN PARAMETERLISTEN SIND ALLG. TYPVEREINBA/
8891 *.-1
8892 TEXT /RUNGEN VERBOTEN)./
8893E30,TEXT /30 DIESER TYP WURDE NICHT VEREINBART./
8894E31,TEXT /31 JEDE VARIABLE MIT KOMPONENTEN-SELEKTOR MUSS ALS RECORD V/
8895 *.-1
8896 TEXT /EREINBART WERDEN./
8897E32,TEXT /32 'NOT', 'AND' UND 'OR' VERLANGEN OPERANDEN VOM TYP BOOLEA/
8898 *.-1
8899 TEXT /N./
8900E33,TEXT /33 TYP DIESES AUSDRUCKS UNBESTIMMT (GANZES ARRAY IN ARITHM./
8901 *.-1
8902 TEXT /OPERATIONEN UNZULAESSIG)./
8903E34,TEXT /34 'DIV' UND 'MOD' VERLANGEN OPERANDEN VOM TYP INTEGER./
8904E35,TEXT /35 TYPEN DER VERGLEICHSOPERANDEN UNVERTRAEGLICH./
8905E36,TEXT /36 AKTUAL- UND FORMALPARAMETER MUESSEN VOM GLEICHEN TYP SEI/
8906 *.-1
8907 TEXT /N./
8908E37,TEXT /37 VARIABLE ERFORDERLICH!/
8909E38,TEXT /38 EIN STRING MUSS MINDESTENS EIN ZEICHEN ENTHALTEN./
8910E39,TEXT /39 ANZAHL DER AKTUAL- UND FORMALPARAMETER MUSS UEBEREINSTIM/
8911 *.-1
8912 TEXT /MEN./
8913E40,TEXT /40 STANDARDPROZEDUR READ NUR FUER TYP INTEGER, REAL UND CHA/
8914 *.-1
8915 TEXT /R VORGESEHEN./
8916E41,TEXT /41 BEI WRITE SIND NUR DIE TYPEN INTEGER, REAL, BOOLEAN UND /
8917 *.-1
8918 TEXT /CHAR ZULAESSIG./
8919E42,TEXT /42 WRITE(X:M:N) IST NUR FUER WERTE VOM TYP REAL ZULAESSIG./
8920E43,TEXT /43 M UND N BEI WRITE(X:M:N) MUESSEN INTEGER-AUSDRUECKE SEIN./
8921E44,TEXT /44 TYP- ODER PROZEDURNAMEN SIND IN AUSDRUECKEN UNZULAESSIG./
8922E45,TEXT /45 EINE ANWEISUNG KANN NICHT MIT EINEM KONST-, TYP- ODER FU/
8923 *.-1
8924 TEXT /NKTIONSNAMEN BEGINNEN./
8925E46,TEXT /46 TYPUNVERTRAEGLICHKEIT BEI WERTZUWEISUNG./
8926E47,TEXT /47 'CASE'-MARKEN MUESSEN VOM GLEICHEN TYP WIE DER 'CASE'-AU/
8927 *.-1
8928 TEXT /SDRUCK SEIN./
8929E48,TEXT /48 TYP DES ARGUMENTS BEI DIESER STANDARDFUNKTION UNZULAESSI/
8930 *.-1
8931 TEXT /G./
8932E49,TEXT /49 ARRAY-INDIZES UND 'CASE'-MARKEN SIND AUF -2048 < X < 204/
8933 *.-1
8934 TEXT /8 BEGRENZT./
8935E50,TEXT /50 EINE KONSTANTE KANN NICHT MIT DEM BEZEICHNETEN SYMBOL BE/
8936 *.-1
8937 TEXT /GINNEN./
8938E51,TEXT /51 SYMBOL := FEHLT (LEERZEICHEN ZWISCHEN : UND = UNZULAESSI/
8939 *.-1
8940 TEXT /G)./
8941E52,TEXT /52 DAS WORTSYMBOL 'THEN' FEHLT./
8942E53,TEXT /53 DAS WORTSYMBOL 'UNTIL' FEHLT./
8943E54,TEXT /54 DAS WORTSYMBOL 'DO' FEHLT./
8944E55,TEXT /55 DAS WORTSYMBOL 'TO' ODER 'DOWNTO' FEHLT./
8945E56,TEXT /56 DAS WORTSYMBOL 'BEGIN' FEHLT./
8946E57,TEXT /57 DAS WORTSYMBOL 'END' FEHLT./
8947E58,TEXT /58 EIN FAKTOR MUSS MIT NAME, KONSTANTE, 'NOT' ODER LINKSKLA/
8948 *.-1
8949 TEXT /MMER BEGINNEN./
8950
8951XLIST
8952\f/R U N T I M E E R R O R S (ALWAYS FATAL!)
8953
8954 *DISPLAY
8955/-------- D I S P L A Y --------/
8956 ZBLOCK 20
8957/---------------------------------/
8958
8959XHALT, 0
8960 CLA CLL
8961 TAD ZPRINT
8962 DCA PTPRINT /SWITCH TO TERMINAL OUTPUT!
8963 TAD (HLTLIST-1
8964 DCA HTEXT
8965 ISZ HTEXT
8966 TAD I HTEXT
8967 TAD XHALT
8968 SZA CLA
8969 JMP .-4
8970 ISZ HTEXT
8971 TAD I HTEXT
8972 DCA HTEXT
8973 CRLF
8974 CRLF
8975 JMS HMESG
8976 TAD (HLTAT
8977 DCA HTEXT
8978 JMS HMESG
8979 L0001
8980 DCA M
8981 L7777
8982 TAD PC
8983 LOAD
8984 JMS IOUT
8985 CRLF
8986 JMP I OS8
8987
8988HMESG, 0
8989 TAD I HTEXT
8990 SNA
8991 JMP I HMESG
8992 BSW
8993 JMS ASCII
8994 TAD I HTEXT
8995 JMS ASCII
8996 ISZ HTEXT
8997 JMP HMESG+1
8998HTEXT, 0
8999
9000HLTLIST,-ERROR0-1; HLT0
9001 -ERROR1-1; HLT1
9002 -ERROR2-1; HLT2
9003 -ERROR3-1; HLT3
9004 -ERROR4-1; HLT4
9005 -ERRORA-1; HLTA
9006 -ERRORB-1; HLTB
9007 -ERRORC-1; HLTC
9008 -ERRORD-1; HLTD
9009
9010HLT0, TEXT /DIVISION BY 0 /
9011HLT1, TEXT /UNDERFLOW /
9012HLT2, TEXT /OVERFLOW/
9013HLT3, TEXT /SQRT/
9014HLT4, TEXT /LN/
9015HLTA, TEXT /MEMORY FULL /
9016HLTB, TEXT / INDEX/
9017HLTC, TEXT /CASE/
9018HLTD, TEXT /FILE/
9019
9020HLTAT, TEXT / ERROR AT /
9021
9022 PAGE
9023\f/I N I T I A L I Z A T I O N OF R U N T I M E - S Y S T E M
9024
9025INIT, CLA CLL
9026 CDF 10
9027 TAD I (7621
9028 CDF 0
9029 SNA CLA /IF INPUT FILE SPECIFIED
9030 JMP INITKB
9031 TAD IIDEVH /THEN SETUP FILE INPUT
9032 DCA I (IDEVH
9033 TAD IIBLOCK
9034 DCA I (IBLOCK
9035 TAD (JMP ERRORD
9036 DCA I (FATAL0
9037 TAD (IBUFFER
9038 DCA I (IBP
9039 L7775
9040 DCA I (IC3
9041 TAD (GETC
9042 SKP
9043INITKB, TAD (XREAD /ELSE KEYBOARD INPUT
9044 DCA I (PTREAD
9045 CDF 10
9046 TAD I (7600
9047 CDF 0
9048 SNA CLA /IF OUTPUT FILE SPECIFIED
9049 JMP INITPR
9050 TAD (I37 /THEN SETUP FILE OUTPUT
9051 DCA I (PTI37
9052 TAD (PUTC
9053 SKP
9054INITPR, TAD (XPRINT /ELSE USE PRINTER
9055 DCA I (PTPRINT
9056 TAD (XHALT
9057 DCA I (PTHALT /ACTIVATE RUNTIME ERRORS
9058INITDH, CDF 60 /TRANSFER DEVICE HANDLER(S)
9059 TAD I F6T0 /AND RUNTIME ERROR ROUTINE
9060 CDF 0 /TO THEIR PLACE IN FIELD 0
9061 DCA I F6T0
9062 ISZ F6T0
9063 ISZ C1200
9064 JMP .-6
9065INITST, TAD (CDF CIF 0 /CHANGE STARTING ADDRESS
9066 DCA I (7744 /TO START OF INTERPRETER
9067 TAD (ISTART
9068 DCA I (7745
9069 DCA I (7746 /CORRECT JOB STATUS WORD
9070 CDF 10 /(MAKE IT RESTARTABLE)
9071 TAD I (7643
9072 AND (20 /CHECK /H - OPTION
9073 CDF CIF 0
9074 SZA CLA
9075 JMP I (7600 /RETURN TO OS8 MONITOR
9076 JMP I (ISTART /START INTERPRETER
9077
9078IIDEVH, 0
9079IIBLOCK,0
9080F6T0, IDEVBUF
9081C1200, -1200
9082
9083 PAGE
9084
9085 END
9086$
My complete PDP-8 universe