2 / ############ ######### #########
3 / ############ ######### #########
4 / ### ### ### ### ### ###
5 / ### ### ### ### ### ###
8 / ############ ############### #########
9 / ############ ############### #########
14 / ### ### ### #########
15 / ### ### ### #########
18 / ######### ######### ###
19 / ######### ######### ###
24 / ### ############### ###
25 / ### ############### ###
30 / ######### ### ### ###############
31 / ######### ### ### ###############
40 / ######### ######### FROM N.WIRTH
41 / ######### ######### ETH - ZUERICH
50 /IMPLEMENTED ON A PDP-8/E COMPUTER WITH 28K-WORDS OF MEMORY
52 /PROF. HEINZ STEGBAUER
53 /HTL-MOEDLING, IN 1979
58 /C O R E L A Y O U T :
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
67 /FIELD 1 0000 - 7577 INTERMEDIATE CODE
68 / 7600 - 7777 OS/8 - RESIDENT PART
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
80 /FIELD 3 0000 - 3777 NAMES OF SYMBOL-TABLE
81 / 4000 - 7177 FSYS, SET-CONSTANTS, LISTS AND
82 / TABLES, ERROR ROUTINES
84 /FIELD 4 0000 - 6377 COMPILER
85 / 6400 - 7777 AUXILIARY ROUTINES
87 /FIELD 5 0000 - 7777 STACK FOR COMPILER OPERATION
89 /FIELD 6 0000 - 7777 LONG ERROR MESSAGES
95 /FIELD 3 0000 - 7777 /S T A C K (4K WORDS OF 48 BITS)
109 \f/S T R U C T U R E O F T A B L E S :
111 /SYMBOL-TABLE (4 WORDS PER ENTRY, MAX. 512 ENTRIES)
116 LINK=TAB /WORD 0, BITS 0-11
117 OBJ=TAB+1 /WORD 1, BITS 0-5
118 TYP=TAB+1 /WORD 1, BITS 6-11
119 REF=TAB+2 /WORD 2, BITS 0-5
120 NORMAL=TAB+2 /WORD 2, BIT 6
121 LEV=TAB+2 /WORD 2, BITS 7-11
122 ADR=TAB+3 /WORD 3, BITS 0-11
125 /STRING-TABLE (ARRAY[0:N] OF CHAR, 6 BITS/CHAR,FROM 4000 UPWARDS)
129 /CONSTANT-TABLE (4 WORDS PER ENTRY, FROM 6400 DOWNWARDS)
133 /ARRAY-TABLE (8 WORDS PER ENTRY, MAX. 64 ENTRIES)
139 INXTYP=ATAB+1 /WORD 1
144 ELSIZE=ATAB+6 /WORD 6
148 /BLOCK-TABLE (4 WORDS PER ENTRY, MAX. 64 ENTRIES)
154 LASTPAR=BTAB+1 /WORD 1
157 \f/A S S E M B L E R D E F I N I T I O N S:
161 L0003=CLA STL IAC RAL
162 L0004=CLA CLL IAC RTL
163 L0006=CLA STL IAC RTL
164 L0100=CLA CLL IAC BSW
168 L7776=CLA CLL CMA RAL
169 L7775=CLA CLL CMA RTL
170 L3777=CLA CLL CMA RAR
171 L5777=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:
175 /MEMORY REFERENCED INSTRUCTIONS:
182 FIXMRI MOD=5000 /ALSO: JMP=5000
187 /OPERATE CLASS INSTRUCTIONS:
196 ZERO=7204 /BOTH TYPES
201 READINTEGER=7001 /INTEGER
208 /SKIP - INSTRUCTIONS:
220 AAAAAA=JMS I 44 /ENTER MACRO MODE
221 EEEEEE=0000 /RETURN TO PDP8 MODE
225 \f/C O M P I L E R D E F I N I T I O N S:
307 /P R O C E D U R E S:
337 /P R O G R A M P A R A M E T E R S:
339 TMAX=512 /MAX. NUMBER OF IDENTIFIERS
340 AMAX=64 /MAX. NUMBER OF ARRAYS
341 BMAX=64 /MAX. NUMBER OF BLOCKS (PROCEDURES+RECORDS)
342 CMAX=1980 /MAX. SIZE OF INTERMEDIATE CODE
343 CSMAX=30 /MAX. NUMBER OF CASES
344 LMAX=16 /MAX. NUMBER OF LEVELS
345 LLNG=80 /MAX. LENGTH OF INPUT LINE
346 ALNG=8 /NO. OF SIGNIFICANT CHAR'S IN IDENTIFIERS
353 EOF, 0 /END OF FILE SWITCH (BOOLEAN)
354 EOLN, 1 /END OF LINE SWITCH ( - " - )
355 CC, 0 /CHARACTER-COUNTER
356 ERRSW, 0 /ERROR IN LINE SWITCH
359 XR10, 0 /ONE AUTOINDEX REGISTER
362 PC, 0 /P R O G R A M - C O U N T E R
364 /I N S T R U C T I O N - R E G I S T E R
367 IRY, 0 /ADDRESS OR VALUE
369 /S T A C K - P O I N T E R S
371 T, 0 /STACK POINTER (SIMPLE INDEX)
372 T3, 0 /= 4*T + 3 (ADDRESS OF WORD 3)
373 T3T, 0 /T3 FOR ROUTINE 'TOSTACK'
374 LOOK, 240 /NEXT CHARACTER (LOOK AHEAD)
376 /----------- PAGE 0 LOC'S OF ARITHMETIC PACKAGE ----------------
378 BCD, 0 /BINARY CODED DECIMAL DIGIT
379 CHAR, 240 /CURRENT CHARACTER
380 M, 22 /OUTPUT FORMAT PARAMETERS
381 N, 0 /(DEFAULT VALUES: M=18, N=0)
383 ACX, 0 / A C - R E G I S T E R
390 INTERPC /POINTER TO MACRO-INTERPRETER
392 MQ1, 0 / M Q - R E G I S T E R
396 OP0, 0 / O P - R E G I S T E R
402 MIN4, -4 /-4 (COUNTING WORDS)
403 MIN44, -44 /-36 (COUNTING BITS)
406 H1, 0 /4 GENERAL TEMPORARIES
411 /NEW INSTRUCTIONS USED ALSO BY ARITHMETIC PACKAGE:
413 HALVE=JMS I . /AC:=AC DIV 2 (SHIFT RIGHT)
415 DOUBLE=JMS I . /AC:=2*AC (SHIFT LEFT)
417 CLEAR=JMS I . /AC := 0
419 LOAD=CLEAR /AC := CONTENTS OF ACCUMULATOR (12 BIT INT.)
421 READC=JMS I . /GET NEXT CHAR FROM INPUT DEVICE
422 PTREAD, XNEXTCH /XREAD AT RUNTIME
423 PRINTC=JMS I . /SEND CHAR TO OUTPUT DEVICE
425 ZPRINT, XPRINT /CONSTANT POINTER TO XPRINT
428 SNALF=JMS I . /SKIP ON NOT ALFABETIC CHAR. (LETTER)
430 SKDIG=JMS I . /SKIP ON DIGIT
432 BREAK=JMS I . /CHECK FOR CTRL-C
434 HALT=JMS I . /RUN-TIME ERROR HANDLING
435 PTHALT, ERR21 /XHALT AT RUNTIME
436 /---------------------------------------------------------------
439 /MACRO INSTRUCTIONS USED BY INTERPRETER:
442 ERROR=JMS I . /NON FATAL COMPILER ERRORS
444 FATAL=JMS I . /FATAL COMPILER ERRORS
446 OFTAB=JMS I . /GET INFO FROM SYMBOL-TABLE
448 OFATAB=JMS I . /GET INFO FROM ARRAY-TABLE
450 OFBTAB=JMS I . /GET INFO FROM BLOCK-TABLE
452 OFDISPLAY=JMS I . /GET INFO FROM DISPLAY
454 TODISPLAY=JMS I . /PUT INFO INTO DISPLAY
456 GETCONST=JMS I . /GET CONSTANT
460 BUMP=JMS I . /MOVE STACK POINTER
463 SDF=JMS . /CHANGE TO TOP OF STACK - DATA FIELD
468 POPONE=JMS I . /POP ONE WORD (WORD 3 INTO AC)
470 POPVAL=JMS I . /POP FOUR WORDS
472 POPNUM=JMS I . /POP NUMBER (=POP 4 WORDS AND UNPACK)
474 PUSHONE=JMS I . /PUSH ONE WORD
476 PUSHVAL=JMS I . /PUSH FOUR WORDS
478 PUSHNUM=JMS I . /PUSH NUMBER (= PACK + PUSHVAL
480 TOSTACK=JMS I . /INSERT ONE WORD INTO STACK[T3T]
482 OFCODE=JMS I . /GET INTERMEDIATE INSTRUCTION
485 /LOCATIONS USED BY I/O-FILE HANDLING:
487 IBUFFER=6000 /INPUT FILE BUFFER
488 OBUFFER=7000 /OUTPUT FILE BUFFER
489 IDEVBUF=6400 /PAGE OF INPUT DEVICE HANDLER
490 ODEVBUF=6600 /PAGE OF OUTPUT DEVICE HANDLER
492 IDEVH, 0 /ENTRY POINT OF INPUT DEVICE HANDLER
493 ODEVH, 0 /ENTRY POINT OF OUTPUT DEVICE HANDLER
494 NAME, ZBLOCK 4 /NAME OF OUTPUT FILE
495 DEVNO, 0 /OUTPUT DEVICE NUMBER
496 LEMPTY, 0 / -LENGTH OF EMPTY
497 MBLOCKS,0 /COUNTING WRITTEN BLOCKS
498 OBP, OBUFFER /BUFFER POINTER (SEE PUTC)
499 OC3, -3 /3-CHARACTER SWITCH (SEE PUTC)
501 I37, DCA CHAR /HALT PROGRAM - CLOSE OUTPUT FILE
502 TAD [232 /WRITE EOF-MARK
503 PRINTC /FILL REST OF BUFFER WITH ZEROES
509 L7777 /COMPUTE ACTUAL LENGTH
510 TAD LEMPTY /OF OUTPUT FILE
516 JMS I [7700 /CALL USR TO CLOSE OUTPUT FILE
521 JMP I OS8 /RETURN TO KEYBOARD MONITOR
522 \f/INSTRUCTION DECODER AND DISPATCH ROUTINE
525 ISTART, CLA CLL /STARTING ADDRESS
534 DCA T /INITIALIZE THE STACK:
546 PUSHONE /S[4].I := BTAB[1].LAST
550 TODISPLAY /DISPLAY[1] := 0
555 BUMP /T := BTAB[2].VSIZE - 1
558 DCA PC /PC := TAB[ S[4].I ].ADR
561 CLL /GET CURRENT INSTRUCTION
581 HLT /JUMP TO INSTRUCTION ROUTINE
584 \f/INSTRUCTIONS OF STACK COMPUTER - ADDRESS TABLE:
586 ILIST, I00 /LOAD ADDRESS
590 ZBLOCK 4 /CODES 4 - 7 UNUSED!
591 I08 /CALL STANDERD FUNCTION
594 I11 /CONDITIONAL JUMP
596 ILOOP /CODE 13 USED INTERNALLY!
612 I29 /WRITE1 (DEFAULT FIELD WIDTH)
614 I31 /WRITE3 ( :M :N )
620 PTI37, 7600 /HALT (BECOMES I37 IF FILE I/O!)
622 ZBLOCK 11 /CODES 39 - 47 UNUSED!
623 I48 /ARITHMETIC OPERATIONS
624 I49 /COMPARE INTEGERS
628 ZBLOCK 10 /CODES 53 - 60 UNUSED!
633 \f/INSTRUCTIONS OF STACK COMPUTER (A)
635 I00, BUMP /LOAD ADDRESS
641 I01, BUMP /LOAD VALUE
648 I02, BUMP /LOAD INDIRECT
656 I03, TAD IRX /UPDATE DISPLAY
675 I08, TAD IRY /CALL STANDARD FUNCTION
679 STFJMS, JMS . / J M S TO REQUESTED FUNCTION
713 I11, POPONE /CONDITIONAL JUMP
722 I12, POPVAL /SWITCH CASE
737 ERRORC, HALT /C A S E E R R O R !
746 ISZ IRY /(INCREMENTS, DOESN'T SKIP!)
754 /I13 ... INTERNAL CODE (MARKS CASE SWITCH LIST)
779 \f/INSTRUCTIONS OF STACK COMPUTER (B+C)
781 I14, TAD UPSKIP /FOR1UP
783 I16, TAD DOSKIP /FOR1DOWN
785 L7777 /COMMON ROUTINE:
794 FORUD1, SKGE /OR SKLE
804 FOR1EX, EEEEEEEEEEEEEEEE
811 /NOTE THE STACK SITUATION:
813 / S[ T ] ... FINAL VALUE
814 / S[T-1] ... INITIAL VALUE
815 / S[T-2] ... ADDRESS OF CONTROL VARIABLE
817 I15, TAD UPADD /FOR2UP
821 I17, TAD DOSUB /FOR2DOWN
825 L7776 /COMMON ROUTINE:
832 FORUD2, ADD INT&ONE /OR SUB INT&ONE
838 FORUD3, SKGE /OR SKLE
848 FOR2EX, EEEEEEEEEEEEEEEE
864 I18, L0004 /MARK STACK
913 /-------------------- FALL THROUGH PAGE BOUNDARY -------------
930 I20, TAD (NOP /INDEX1
932 I21, TAD (JMS MULTY /INDEX
934 TAD IRY /COMMON ROUTINE:
955 ERRORB, HALT /INDEX OUT OF BOUNDS!
956 INDEX1, NOP /OR JMS MULTY
987 I22, POPONE /LOAD BLOCK
1004 I23, L7777 /COPY BLOCK
1026 I24, BUMP /LITERAL (ADDRESSES ONLY!)
1032 I25, BUMP /LOAD CONSTANT
1037 I61, POPONE /WRITE SPECIAL ASCII
1045 \f/INSTRUCTIONS OF STACK COMPUTER (D)
1058 I27, TAD (JMS I READX-1 /READ
1071 I28, POPONE /WRITE STRING
1083 I29, TAD (TAD DFW-1 /WRITE (STANDARD FIELD WIDTH)
1090 I30, POPONE /WRITE (SPECIFIED FIELD WIDTH)
1114 I31, POPONE /WRITE ( X :M :N )
1123 JMS I WRITEX+1 /REAL ONLY!
1127 I32, L7776 /EXIT PROCEDURE
1129 I33, L7777 /EXIT FUNCTION
1143 I34, POPONE /LOAD (ABSOLUTE)
1148 I35, POPONE /LOGICAL NOT
1169 /I39 - I47 U N U S E D !
1172 /B O O L E A N O U T P U T
1186 \f/INSTRUCTIONS OF STACK COMPUTER (E)
1188 I48, POPNUM /ARITHMETIC:
1193 TAD (MRITABL / DIV 48,4
1202 I49, TAD (ISUB-RSUB /COMPARE (INTEGER)
1203 I50, TAD (RSUB /COMPARE (REAL)
1206 JMS ENTR / < 50,7500
1217 I51, POPONE /LOGICAL OR
1230 I52, POPONE /LOGICAL AND
1241 /I53 - I61 U N U S E D !
1244 I62, TAD EOLN /READLN
1252 \f/AUXILIARY ROUTINES FOR 'WRITE STRING' AND 'BOOLEAN OUTPUT'
1277 STL RAR /STRING TABLE STARTS AT 4000!
1279 STRFLD, CDF TABLEFIELD
1297 \f/C H A R A C T E R I N P U T AND O U T P U T
1323 \f/STACK INSTRUCTIONS
1334 ERRORA, HALT /S T A C K O V E R F L O W !
1340 DCA XSDF /SETUP CHANGE TO STACK FIELD INSTR.
1344 DCA T3 /ADDRESS OF TOP ENTRY (LS WORD)
1348 ADDRESS,0 /COMPUTE FULL ADDRESS
1349 MQL /OF STACK LOCATION
1350 MQA /AND CHANGE DATA FIELD
1359 STCDF, CDF STACKFIELD
1362 PACK, 0 /PACK REAL OR INTEGER NUMBER
1363 TAD ACX /INTO AC0-4 (FOR PUSHING)
1370 UNPACK, 0 /UNPACK POPPED NUMBER
1371 L4000 /(EXTRACT SIGN, EXPONENT)
1454 DCA PACK /TEMP. SAVE VALUE
1464 \f/TABLE INSTRUCTIONS
1466 ZOFTAB, / AC := TAB[ AC ].REF
1467 ZOFBTAB,0 / AC := BTAB[ AC ].REF
1469 TAD I ZOFTAB /SELECTOR FOLLOWS CALL
1477 ZOFATAB,0 / AC := ATAB[ AC ].REF
1480 TAD I ZOFATAB /SELECTOR FOLLOWS CALL
1488 ZOFDISP,0 / AC := DISPLAY[ IRX ]
1495 ZTODISP,0 / DISPLAY[ IRX ] := AC
1504 XOFCODE,0 / AC := CODE[ AC.LINK ]
1505 RAL /LINK=0 ... 1ST WORD
1506 DCA LOC /LINK=1 ... 2ND WORD
1512 LOC, 0 /ADDRESS OF TABLE LOCATION
1514 ZOFCONST,0 /ENTER WITH ADDRESS-1 IN AC
1527 \f/PREDEFINED R A N D O M - NUMBER GENERATOR
1530 TAD DISMOV /DISABLE INTEGER-
1531 DCA INTMOV /MULTIPLY-OVERFLOW
1534 MUL INT&ALFA /MOD 2^35 !
1536 NORM /0 < RANDOM: REAL < 1
1538 TAD ENAMOV /REENABLE
1546 RN, 0000;3777;7777;7775 /2^35 - 3 (INTEGER)
1547 ALFA, 0000;0000;0100;0003 /2^18 + 3 (INTEGER)
1557 XSKDIG, 0 /SKIP ON DIGIT
1567 XPRINT, 0 /INTERNAL PRINTER HANDLER
1579 SPRINT, 0 /SILENT PRINTER
1583 XCRLF, 0 /CARRIAGE RETURN & LINE FEED
1588 XBREAK, 0 /CHECK ^C AND ABORT
1600 \f/ A R I T H M E T I C P A C K A G E
1602 INTERPC,0000 /PROGRAM COUNTER FOR MACRO-INSTRUCTIONS
1605 NEXTINSTR, ISZ INTERPC /POINT TO NEXT INSTRUCTION
1606 TAD I INTERPC /GET CODE
1608 JMP I INTERPC /THEN RETURN TO PDP8-MODE
1609 CLL RTL /ELSE SHIFT CODE NXXX
1611 AND (7 /TO EXTRACT OPERATION CODE N
1613 TAD I INTERPC /GET CODE AGAIN,
1614 AND (177 /MASK OUT REL.ADDRESS (OR FUNCTION CODE)
1617 C200, AND INTERPC /CURRENT PAGE BITS
1618 MQA /+ RELATIVE ADDRESS
1619 DCA OPADDR /= ABS. ADDRESS OF OPERAND (IF MRI)
1622 TAD I OPADDR /THEN DO INDIRECT ADDRESSING
1626 SNA CLA /IF CODE=7XXX
1627 JMP OPRTYP /THEN OPERATE CLASS INSTRUCTION
1628 MRITYP, TAD I OPADDR /ELSE MEMORY REFERENCED INSTR.:
1629 DCA OPX /LOAD AND UNPACK OPERAND
1630 ISZ OPADDR /INTO OP-REGISTER
1643 TAD I INTERPC /GET INSTRUCTION CODE AGAIN,
1644 AND C200 /CHECK INTEGER\REAL-BIT
1645 SZA CLA /AND BUILD A
1650 OPCODE, JMS . / J M S TO THE REQUESTED ROUTINE
1654 /TABLE OF INTEGER ARITHMETIC ROUTINES:
1663 /TABLE OF REAL ARITHMETIC ROUTINES:
1672 OPRTYP, 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
1682 TAD INTERPC /SAVE PC, SINCE OPR'S MAY CAUSE
1683 DCA SAVEPC /RECURSIVE CALL OF INTERPRETER (1 LEVEL)
1684 OPRJMS, JMS . / J M S TO APPROPRIATE ROUTINE
1685 TAD SAVEPC /RESTORE PC
1692 /TABLE OF OPERATE CLASS INSTRUCTIONS:
1700 NOOP /LINK TO FUNCTION DISPATCH ROUTINE
1703 FUNCTS /ENABLED ONLY IF FUNCTION PACKAGE PRESENT
1706 SKIPTYP,JMS BOOL /ALL SKIP INSTR. (INT & REAL) DONE HERE
1707 ISZ INTERPC /(SEE ROUTINE 'BOOL' FOR COMMENTS)
1710 OJUMP, 0 /JUMP (WITHIN MACRO CODE!!!)
1716 OPUT, 0 /STORE CONTENTS OF AC-REGISTER
1717 L0004 /AT SPECIFIED MEMORY ADDRESS
1718 CIA /-4 (OPADDR WAS MOVED AT MRITYP)
1733 \f/R E A L N U M B E R I N P U T
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.
1741 DC=MQ2 /DIGIT COUNTER
1742 OC=MQ3 /DIGIT EXCESS COUNTER
1743 DP, 0 /DECIMAL POINT POSITION
1745 RINP, RETNUM /RETURN ADDR. SINCE COMPILER ENTERS AT 'FRACTN'
1747 READC /PASS OVER LEADING BLANKS
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
1761 FRACTN, JMS BCONV /THEN PROCESS F R A C T I O N PART
1762 TAD DC /COUNT DIGITS AFTER DEC. POINT
1764 DCA DP /TO REMEMBER POSITION OF DEC. POINT
1765 JMS IFLOAT /NORMALIZE THE NUMBER
1768 SZA CLA /IF NEXT CHARACTER IS "E"
1771 PUT NUMBUF /THEN STORE NUMBER TEMPORARELY
1774 JMS PMXXX /AND PROCESS S C A L E - F A C T O R
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
1783 GET NUMBUF /RECALL STORED MANTISSA
1785 ADJUST, TAD DP /NOW CONVERT DEC. FLOATING POINT TO
1786 JMS SUP1 /TO BINARY FLOATING POINT NOTATION
1790 PMXXX, 0 /SIGNED INTEGER INPUT & CONVERSION
1807 BCONV, 0 /UNSIGNED DIGIT STRING INPUT & CONVERSION
1825 \f/F L O A T AND T R U N C ROUTINES
1829 IFLOAT, 0 /COMPENSATE
1830 TAD (43 /35 BITS DISPLACEMENT OF BINARY POINT
1831 DCA ACX /WITH EXPONENT
1832 JMS RNORM /AND NORMALIZE
1838 SPA SNA /IF ABS(AC)<1 OR AC=0
1839 JMP LESS0 /THEN TRUNC(AC):=0
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
1845 HALVE /ELSE ALIGN MANTISSA
1848 DCA ACX /EXP=0 FOR INTEGERS
1860 TAD ACS /ROUND(X) = TRUNC(X+0.5)
1862 JMS RADD /ROUND(X) = TRUNC(X-0.5)
1867 \f/R E A L N U M B E R O U T P U T
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 )
1875 /M /MINIMUM FIELD WIDTH
1877 S=MQ1 /-NUMBER OF LEADING BLANKS
1878 P=MQ2 /-NUMBER OF DIGITS PRECEDING THE DEC. POINT
1879 F=MQ3 /-NUMBER OF DIGITS FOLLOWING THE DEC. POINT
1883 JMS FLCONV /BINARY TO DECIMAL FLOATING POINT
1884 JMS EXBCD /EXTRACT BCD-DIGITS OF MANTISSA
1886 SPA SNA /WHICH FORMAT REQUESTED?
1888 FIXPNT, CIA / -99999.99999
1892 CLA /THEN P:=-(DEXP+1)
1895 L7776 /S:=-(M-N-P-2)
1902 SMA CLA /IF S>=0 THEN USE FLOATING POINT FORMAT
1903 JMP FLOPNT /(NUMBER TOO LARGE FOR FIXED POINT!)
1905 TAD N /ROUNDUP WITH (N+DEXP+1)TH DIGIT
1907 SPA SNA /IF NOT WITHIN THE 11 DIGITS, THEN
1909 TAD (-13 /ROUNDUP WITH 11TH DIGIT
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
1918 JMS XOUT /DO THE FIXED POINT OUTPUT
1922 FLOPNT, L7777 / -9.999999999E+999
1929 DCA M /IF M<10 THEN M:=10
1937 SPA CLA /IF S>=0 THEN
1948 JMS UROUND /ROUNDUP WITH (-F+1)TH DIGIT
1949 STFW, 0022 /NOP (CARRY DOESN'T HARM!)
1950 JMS XOUT /OUTPUT THE MANTISSA
1960 CIA /MAKE DEXP POSITIVE
1961 JMS LDAC /LOAD IT IN AC-REGISTER (AS INTEGER)
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
1973 /BUFFER FOR BCD-DIGITS:
1974 0 /IMPORTANT! (SEE ROUNDING)
1979 TEN, 0004 /REAL CONSTANT OF 10.0
1984 OPTEN, 7775 /REAL CONSTANT OF 0.1 (CURRENTLY NOT USED!)
1990 CLAC, 0 /LOAD OR CLEAR AC-REGISTER
2000 \f/REAL NUMBER OUTPUT - AUXILIARY ROUTINES
2002 XDPOS=XR10 /AUTOINDEXING DIGITS
2003 /DPOS=EXBCD /SIMPLE POINTER TO DIGITS
2004 /DIG0=DOUT /NUMBUF-1 OR NUMBUF-2 (FIRST DIGIT OF MANTISSA)
2005 DEXP=BCD /DECIMAL CHARACTERISTIC OF X
2006 DCNT=. /DIGIT COUNTER
2008 FLCONV, 0 /CONVERT X*2^ACX ---> Z*10^DEXP,
2009 DCA DEXP /WITH 1<=Z<10:
2011 SNA CLA /IF NUMBER=0 THEN NO CONVERSION NECESSARY!
2013 JMS SUP2 /DO SUPER CONVERSION
2017 SPA SNA /NOTE INTERNAL BINARY NOTATION:
2019 TAD (-4 / 1 ..... 0.1000B+1
2020 SPA /10 ..... 0.1010B+4
2024 TAD AC1 /HIGH ORDER WORD FOR 10
2025 TAD (-2400 /IS 2400 OCTAL!
2028 LARGE, AAAAAAAAAAAAAAAA
2029 DIV TEN /:10 (OR 'MUL OPTEN' *0.1)
2033 SMALL, AAAAAAAAAAAAAAAA
2040 EXBCD, 0 /EXTRACT BCD-DIGITS OF MANTISSA
2044 STL /(MIGHT CORRECT ILL 11TH DEC. DIGIT!)
2045 DOUBLE /SHIFT OUT FIRST DIGIT
2050 TAD (-12 /10 DIGITS REMAINING
2052 DCA I (NUMBUF-1 /LEADING 0 FOR ROUNDING CARRY
2060 TAD (NUMBUF-1 /POINT TO FIRST DIGIT
2064 UROUND, 0 /ROUNDUP. ENTRY WITH DIGIT NO.
2065 TAD DIG0 /WHERE TO START ROUNDING
2066 DCA DPOS /IN HARDWARE AC
2081 SZA CLA /CARRY TO A NEW FIRST DIGIT?
2087 JMP I UROUND /MANTISSA=10 EXIT
2088 SKIPEX, ISZ UROUND /NORMAL EXIT
2091 XOUT, 0 /OUTPUT. ENTRY WITH DIGIT NO.
2092 TAD DIG0 /WHERE TO START PRINTING
2093 DCA XDPOS /IN HARDWARE AC
2095 PRINTC / -(S) BLANKS
2102 PRINTC / THE SIGN (- OR BLANK)
2103 JMS DOUT / -(P) DIGITS (OR ZERO)
2106 TAD (". / THE DECIMAL POINT
2108 JMS DOUT / -(F) DIGITS (OR ZEROES)
2114 DOUT, 0 /IF XDPOS POINTS INTO BUFFER
2115 TAD XDPOS /THEN PRINT THE DIGIT
2116 TAD (-NUMBUF-12 /ELSE PRINT A ZERO
2128 \f/R E A L A R I T H M E T I C
2135 /RNORM: NORMALIZE AC TO STANDARD FLOATING POINT FORMAT
2140 SNA CLA /IF OP=0 THEN DON'T WASTE TIME!
2143 SNA CLA /IF AC=0 THEN SIMPLY ADD!
2145 TAD ACX /COMPARE MAGNITUDE OF OPERANDS
2146 CIA /AND STORE NEGATIVE DIFFERENCE
2150 DCA RDIV /TO USE AS SHIFT COUNTER
2151 ACMAX, TAD OP1 /1/ ABS(AC)>ABS(OP) ---> SHIFT OP RIGHT
2163 OPMAX, CMA /2/ ABS(OP)>=ABS(AC)
2165 TAD OPX /RESULT IS OF MAGNITUDE OF OP
2168 HALVE /SHIFT AC RIGHT
2171 SETSGN, JMS OADD /MANTISSAS NOW ALIGNED! - ADD.
2172 JMS RNORM /NORMALIZE RESULT
2177 JMS RADD /AC:=AC+(-OP)
2190 SNA CLA /IF OP=0 OR AC=0
2191 JMP I RMUL /THEN DON'T WASTE TIME!
2193 DCA MQ2 /CLEAR MQ-REGISTER (FOR 'BMUL')
2195 TAD OPS /SETUP SIGN OF PRODUCT
2199 TAD OPX /COMPUTE EXPONENT OF PRODUCT
2203 JMS BMUL /MULTIPLY MANTISSAS
2210 ERROR0, HALT /D I V I S I O N BY Z E R O !
2212 DCA MQ2 /CLEAR MQ-REGISTER (FOR 'BDIV')
2214 TAD OPS /SETUP SIGN OF QUOTIENT
2217 TAD OPX /COMPUTE EXPONENT OF QUOTIENT
2221 JMS BDIV /DIVIDE MANTISSAS
2228 AND (4000 /(NO 'L4000' BECAUSE OF LINK!)
2230 SNA CLA /WHILE MANTISSA TOO BIG (>=1)
2232 HALVE /HALVE IT (SHIFT RIGHT)
2233 ISZ ACX /AND CORRECT THE EXPONENT (+1)
2236 ROUNDUP,SZL /IF A BINARY 1 WAS SHIFTED OUT
2237 ISZ AC3 /THEN ROUND MANTISSA
2241 ISZ AC1 /(CAN'T SKIP!)
2243 NULLAC, JMS SNAC /CHECK FOR NULL MANTISSA
2247 SZA CLA /WHILE MANTISSA TOO SMALL (<0.5)
2249 DOUBLE /DOUBLE IT (SHIFT LEFT)
2250 L7777 /AND CORRECT THE EXPONENT (-1)
2255 L2000 /CHECK FOR OVER- OR UNDERFLOW
2261 ERROR1, HALT /U N D E R F L O W !
2262 ERROR2, HALT /O V E R F L O W !
2265 \f/I N T E G E R I N P U T AND O U T P U T
2269 /M /MINIMUM FIELD WITH
2270 DI, 0 /-NUMBER OF DIGITS TO PRINT
2271 SI, 0 /-NUMBER OF LEADING BLANKS
2272 LDBLANK,240 /OR OTHER LEADING CHARACTER
2273 NEGATIV,0 /IF NUMBER NEGATIVE THEN -1 ELSE 0
2277 READC /IGNORE LEADING BLANKS
2282 JMS PMXXX /INPUT +-0123456789 AND CONVERT TO BINARY
2283 JMS INORM /CHECK OVERFLOW (MAXINT=34359738367)
2289 TAD [240 /KLUDGE! CHOOSE THE LEADING CHARACTER
2290 DCA LDBLANK /WITH A TAD (XXX-240 BEFORE CALLING IOUT
2296 DCA PTD /POINT TO RIGHTMOST POS. OF BUFFER
2297 DCA I PTD /STORE A 0 CASE NUMBER=0
2301 TAD PTD /DECREMENT POINTER
2304 DIV INT&IO /AC:=AC DIV 10
2307 CLL RAR /GET REST OF ABOVE DIVISION
2308 JMP DECONV-1 /AND STORE AS BCD-DIGIT
2309 OFORM, TAD (-NUMBUF-12
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
2317 SPA /IF FIELD WIDTH < NO. OF DIGITS
2319 CMA /ELSE SI:=-(FIELD WIDTH - DIGITS) - 1
2323 PRINTC /LEADING BLANKS
2329 PRINTC /MINUS SIGN (IF ANY)
2333 PRINTC /DIGIT STRING
2338 INORM, 0 /INTEGER CLEARING HOUSE ROUTINE
2342 SZA CLA /IF AC0<>0 OR AC1>3777 THEN
2343 JMP ERROR2 /O V E R F L O W
2345 DCA ACS /DON'T FORGET THE -0 PROBLEM!
2348 IO, 0000 /INTEGER CONSTANT OF 10
2352 \f/VARIOUS SECONDARY ROUTINES:
2354 XABS, 0 /AC:=ABS(AC)
2358 XNEG, 0 /AC:=-AC (REAL AND INTEGER)
2362 JMS INORM /BUT NOT AC:=-0 !
2365 OGET, 0 /COPY CONTENTS OF
2366 DCA AC0 /OP-REGISTER INTO AC-REGISTER
2367 TAD OP1 /(AC0 IS CLEARED!)
2379 ENTR, 0 /COPY CONTENTS OF
2380 TAD AC1 /AC-REGISTER INTO OP-REGISTER
2381 DCA OP1 /(AC0 UNCHANGED!)
2392 BOOL, 0 /ENTER WITH SKIP-INSTRUCTION
2393 DCA OSKIP /IN HARDWARE AC
2401 JMP I BOOL /EXIT WITH HARDWARE AC=1 IF TRUE (SKIP)
2405 \f/I N T E G E R A R I T H M E T I C
2410 /IDIV: AC:=AC DIV OP
2411 /IMOD: AC:=AC MOD OP
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)
2425 TAD AC1 /BUT TAKE CARE:
2426 SMA CLA /IF RESULT POSITIVE (IN 2'S COMPLEMENT)
2428 JMS CMAC /ELSE COMPLEMENT AC
2429 TAD OPS /AND USE SIGN OF OP
2431 DCA AC0 /NO OVERFLOW IN THIS CASE!
2438 JMS IADD /AC:=AC+(-OP)
2443 CLEAR /THEN PRODUCT IS 0
2445 DCA MQ2 /CLEAR MQ-REGISTER (BMUL NEEDS THAT!)
2447 TAD OPS /SETUP SIGN OF PRODUCT
2451 INTMOV, JMS SNAC /IF HIGH ORDER WORDS OF PRODUCT <>0
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!)
2464 JMP I [ERROR0 /D I V I S I O N BY Z E R O !
2466 JMS SWAP /PUT 2*DIVIDEND INTO MQ-REGISTER
2467 DCA AC1 /AND CLEAR AC (SEE BDIV INSTRUCTIONS)
2470 TAD OPS /SETUP SIGN OF QUOTIENT
2473 TAD ACS /PATCH: SERVES
2474 DCA MODSGN /FOR MOD-FUNCTION
2480 JMS IDIV /DIVIDE OP INTO AC
2481 JMS SWAP /GET 2*REST FROM MQ-REGISTER
2482 HALVE /AND HALVE IT (SEE BDIV INSTR.)
2484 SPA CLA /IF REST NOT NEGATIVE
2486 JMP MODOK /THEN OKAY
2487 JMS BADD /ELSE ADD OP TO MAKE IT POSITIVE
2488 JMS CMAC /MORE PRECISELY: AC:=-(AC-OP)
2489 MODOK, DCA ACS /SIGN IS +
2492 \f/FOUR SECONDARY ROUTINES:
2494 SNAC, 0 /SKIP ON NONZERO AC
2504 SNOP, 0 /SKIP ON NONZERO OP
2514 CMAC, 0 /2'S COMPLEMENT OF AC
2531 CMOP, 0 /2'S COMPLEMENT OF OP
2553 /B I N A R Y A D D I T I O N
2555 /AC0!AC1!AC2!AC3 := AC1!AC2!AC3 + OP1!OP2!OP3
2580 /B I N A R Y M U L T I P L I C A T I O N
2583 /FLOATING POINT: AC=FACTOR, MQ=0; AC=PRODUCT (HIGH ORDER)
2584 /INTEGER: AC=FACTOR, MQ=0; MQ=2*PRODUCT (LOW ORDER)
2605 \f/B I N A R Y D I V I S I O N
2608 /FLOATING POINT: AC=DIVIDEND, MQ=0; AC=QUOTIENT
2609 /INTEGER: AC=0, MQ=2*DIVIDEND; AC=QUOTIENT, MQ=2*REST
2615 DIVLP, CLL /COMPARE AC AND OP
2618 DCA TEMP3 /SAVE DIFFERENCE
2628 DCA AC1 /YES, SETUP DIFFERENCE
2634 TAD MQ3 /SHIFT IN NEW BIT OF QUOTIENT
2635 RAL /AND DOUBLE DIVIDEND
2648 \f/OTHER BINARY OPERATIONS:
2653 RACL, 0 /SHIFT AC ONE BIT LEFT (=DOUBLE)
2654 TAD AC3 /TAKE CARE OF LINK CALLING RACL!!!
2671 MUL10, 0 /AC TIMES 10
2672 JMS ENTR /LINK MUST BE 0 ON ENTRY!!!
2682 RACR, 0 /SHIFT AC ONE BIT RIGHT (=HALVE)
2704 SWAP, 0 /SWAP AC- AND MQ-REGISTER
2724 \f/ A R I T H M E T I C P A C K A G E
2726 / S U P E R C O N V E R S I O N O V E R L A Y
2729 /POWERS OF TEN TABLE:
2731 P1E1, 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
2739 P1E256, 1523;2523;7565;7735 / 1.0E+256
2740 3245;3430;6320;2565 / 1.0E+512 (SERVES AS A GUARD)
2742 P1E2N, 0 /POINTER INTO TABLE
2743 DECP, 0 /DECIMAL CHARACTERISTIC
2744 /DEXP=BCD / --- " --- (SEE 'FLCONV')
2746 SUP1, 0 /INPUT CONVERSION (OVERLAYS 'ADJUST')
2747 SPA /IF DECIMAL CHARACTERISTIC >= 0
2749 DCA DECP /THEN STORE AS IT IS
2750 TAD (MUL P1E1 /AND SETUP FOR MULTIPLY
2751 JMP .+4 /WITH POWERS OF 10
2753 DCA DECP /ELSE MAKE IT POSITIVE
2754 TAD (DIV P1E1 /AND SETUP FOR DIVIDE
2755 DCA MD1E2N /BY POWERS OF 10
2757 SNA /WHILE DECP<>0 DO:
2759 CLL RAR /DECP:=DECP DIV 2
2761 SNL /IF DECP WAS ODD
2764 MD1E2N, MUL . /THEN MULTIPLY WITH (DIVIDE BY) 1.0E+2N
2767 TAD MD1E2N /POINT TO NEXT POWER OF TEN
2772 SUP2, 0 /OUTPUT CONVERSION (OVERLAYS 'FLCONV')
2774 PUT XAC /SAVE NUMBER IN AC
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
2788 CMA /THEN DEXP := -XAC*1233 DIV 4096 - 1
2789 DCA DEXP /ELSE DEXP := XAC*1233 DIV 4096
2791 GET XAC /RESTORE NUMBER
2795 JMS SUP1 /DO CONVERSION TO DECIMAL FLOATING POINT
2799 O1233, 0000;0000;0000;2321 /1233 (INTEGER)
2802 TRUEFALSE, TEXT /TRUEFALSE/
2805 XISQU, 0 /AC := AC^2 (INTEGER)
2810 XRSQU, 0 /AC := AC^2 (REAL)
2817 /**********************
2818 / S Q U A R E R O O T
2821 /**********************
2827 ERROR3, HALT /SQUARE ROOT OF N E G A T I V E NUMBER!
2830 JMP I XSQRT /DON'T WASTE TIME FOR SQRT(0)!
2832 TAD ACX /TRANSFORM ARGUMENT TO THE FORM
2833 SPA SZL / 2^(2*N) * F WITH 0.25 <= F < 1
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 )
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 )
2850 L7775 /3 ITERATION LOOPS GUARANTEE
2851 DCA NEWTON /FULL PRECISION! (MAX. ERROR: 8.0E-13)
2852 SQLOOP, AAAAAAAAAAAAAAAA
2856 ADD X123 /X[I+1] := (F/X[I] + X[I])/2
2858 L7777 /HALVE BY ACX:=ACX - 1
2861 ISZ NEWTON /IF DONE 3 LOOPS
2863 TAD ROOTX /THEN INSERT EXPONENT N OF ROOT
2868 NEWTON=. /LOOP COUNTER
2869 OPOINT5,0000 /CONSTANT OF 0.5 OR 0.25 (EXPONENT WORD
2870 2000 /SET AT EXECUTION TIME)
2873 SQARG, 0 /REDUCED ARGUMENT F
2877 X123, 0 /TEMPORARY FOR APPROXIMATE VALUE
2881 ROOTX, 0 /TEMPORARY FOR ROOT EXPONENT N
2883 /**********************************
2884 / N A T U R A L L O G A R I T H M
2887 /**********************************
2890 /TABLE OF CONSTANTS:
2897 LNA0, 0000 /0.611801541106
2907 LNA1, 0000 /0.504556010752
2917 LNA2, 7777 /0.405465108108
2927 LNA3, 7777 /0.318453731119
2937 LNA4, 7776 /0.223143551314
2947 LNA5, 7776 /0.171850256927
2957 LNA6, 7775 /0.0896121586897
2967 LNA7, 7773 /0.0307716586668
2979 ERROR4, HALT /LOGARITHM OF ZERO OR NEGATIVE NUMBER!
2981 PUT LNARG /SAVE ARGUMENT X = 2^N * F
2983 DCA LNARG /REDUCE TO FRACTION PART (0.5 <= F < 1)
2985 TAD ACX /GET N (IN TWO'S COMPLEMENT!)
2988 JMS LDAC /LOAD IT AS INTEGER
2992 FLOAT /CONVERT TO REAL
2993 MUL LN2 /TIMES LN(2)
2994 PUT LNTEMP /AND SAVE IT
2996 LNLOOP, 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.
3007 SUB I PTLNAK /SUBTRACT LN( A(K) ) TO COMPENSATE
3009 GET I PTAK /THE MULTIPLICATION WITH A(K)
3010 MUL LNARG /F' = A(K)* .... *F
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
3030 ADD LNTEMP /LN(X) = N*LN(2) - LN(A(K)) ... + LN(F')
3034 BIT234, 1600 /MASK TO EXTRACT BITS 00XXX0000000
3035 PTAK, A0 /POINTER INTO TABLE
3036 PTLNAK, LNA0 / --- " ---
3038 LNARG, 0 /ARGUMENT REGISTER
3043 LNTEMP, 0 /TEMPORARY
3048 LN2, 0000 /0.69314718
3078 /****************************************
3079 / E X P O N E N T I A L F U N C T I O N
3082 /****************************************
3086 EX0B8, 0001 / 2^(0/8) = 1
3091 EX1B8, 0001 / 2^(1/8)
3096 EX2B8, 0001 / 2^(2/8)
3101 EX3B8, 0001 / 2^(3/8)
3106 EX4B8, 0001 / 2^(4/8)
3111 EX5B8, 0001 / 2^(5/8)
3116 EX6B8, 0001 / 2^(6/8)
3121 EX7B8, 0001 / 2^(7/8)
3138 MUL LOG2E /X*LB(2) .... EXP(X) = 2^(X*LB(2))
3140 TRUNC /SPLIT PRODUCT INTO
3141 PUT INT&TWO2N-3 /INTEGER PART N
3143 SUB EXTEMP /AND FRACTION F (0 <= F < 1)
3158 SPA SNA /IF F>=1/8 THEN SPLIT F INTO
3160 CMA CLL / M/8 + R (0 < M < 8, 0 <= R < 1/8)
3168 DCA TWO2M8 /POINT TO 2^(M/8) IN TABLE
3172 JMS RNORM /NORMALIZE
3173 APPROX, AAAAAAAAAAAAAAAA/COMPUTE 2^R BY A CONTINUED FRACTION
3191 MUL I TWO2M8 /MULTIPLY WITH 2^(M/8)
3194 TAD TWO2N /INSERT 2^N
3196 JMS RNORM /CHECK FOR OVERFLOW
3197 JMP I XEXP /EXP(X) = 2^N * 2^(M/8) * 2^R
3199 TWO2M8, 0 /POINTER TO TABLE
3201 EXTEMP, 0 /ARGUMENT AND TEMPORARY
3206 EXREST, 0 /TEMPORARY REGISTER
3210 TWO2N, 0000 /HOLDS N (MUST BE HERE!!!)
3212 LOG2E, 0001 /1.442695040889
3217 EXA3, 0006 /34.624680981335
3222 EXB3, 0005 /17.312340490668
3227 EXC3, 0007 /-104.068449050280
3232 EXD3, 0005 /20.813689810056
3237 /****************************
3238 / S I N E AND C O S I N E
3241 / AC := COS(AC) = SIN(AC+PI/2)
3242 /****************************
3267 COS2, 0003 /-PI^2/2!
3272 SIN3, 0003 /-PI^3/3!
3279 COS4, 0003 / PI^4/4!
3284 SIN5, 0002 / PI^5/5!
3289 COS6, 0001 /-PI^6/6!
3294 SIN7, 0000 /-PI^7/7!
3299 COS8, 7776 / PI^8/8!
3304 SIN9, 7775 / PI^9/9!
3309 COS10, 7773 /-PI^10/10!
3314 SCARG=EXTEMP /ARGUMENT REGISTER
3318 TAD ACS /SIN(-X) = -SIN(X), THUS
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)
3327 AND AC3 /IF ODD(N) THEN CHANGE SIGN
3338 SZA CLA /IF F>=0.5 THEN
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
3347 JMP TAYSIN /THEN USE SINE-SERIES
3348 AAAAAAAAAAAAAAAA/ELSE SIN(PI*F) = COS(PI*(0.5-F))
3351 DCA ACS /F := 0.5 - F
3355 JMP TAYCOS-1 /THEN USE COSINE-SERIES DIRECTLY
3356 L7777 /ELSE COS(PI*F) = 2 * COS(PI*F/2)^2 - 1
3358 DCA ACX /F := F/2 (1/16 <= F <= 3/16)
3360 DCA HFLAG /SET HALVE ARGUMENT FLAG
3361 TAYCOS, AAAAAAAAAAAAAAAA
3364 PUT FQU /SQUARE ARG.
3376 ISZ HFLAG /WAS F>=0.125?
3378 AAAAAAAAAAAAAAAA/YES
3386 TAYSIN, AAAAAAAAAAAAAAAA
3399 SCRET, EEEEEEEEEEEEEEEE
3402 TAD SCS /INSERT SIGN (AVOID -0 !)
3406 SCS, 0 /SIGN OF RESULT
3408 FQU, 0 /TEMPORARY FOR SQUARES ARG.
3415 /********************
3416 / A R C T A N G E N T
3419 /********************
3426 SPA CLA /IF ARGUMENT VERY SMALL ( < 2^(-12) )
3427 JMP I XATN /THEN ARCTAN(X)=X
3429 DCA ATNS /SAVE SIGN ... ARCTAN(-X) = -ARCTAN(X)
3430 DCA ACS /AND MAKE ARGUMENT POSITIVE
3435 SPA SNA CLA /IF X>=1
3438 GET ONEPT0 /THEN X := 1/X
3439 DIV ATARG /ARCTAN(X) = PI/2 - ARCTAN(1/X)
3441 EEEEEEEEEEEEEEEE/NOW ARGUMENT REDUCED TO 0 < X <= 1
3443 DCA GT1FLAG /FLAG ARGUMENT > 1
3445 SPA CLA /IF X>=0.5 THEN USE ADD.THEOREM:
3449 AAAAAAAAAAAAAAAA/ARCTAN(X) = ARCTAN(0.5) + ARCTAN( ... )
3450 ADD TWOPT0 /X := (2*X-1)/(X+2)
3455 PUT ATARG /ARGUMENT RANGE NOW 0 < X < 0.5
3459 AAAAAAAAAAAAAAAA/COMPUTE ARCTAN(X) BY CONTINUED FRACTION
3483 ISZ ADDFLAG /CORRECT RESULT IF NECESSARY
3488 ISZ GT1FLAG /WAS X>1 ?
3491 DCA ACS / -ARCTAN(X)
3496 DCA ACS /INSERT SIGN
3498 ATNS, 0 /TEMPORARY FOR SIGN
3501 ATARG, 0 /ARGUMENT REGISTER
3505 ATA0, 0004 /12.37469388
3510 ATA1, 0007 /-80.34270560
3515 ATA2, 0001 /-1.191447224
3520 ATA3, 7775 /-0.078335428
3525 ATB0, 0005 /26.27277525
3530 ATB1, 0003 /6.36441688
3535 ATB2, 0002 /2.104518952
3540 ATB3, 0001 /1.258464113
3545 ATN0P5, 7777 /ARCTAN(0.5)
3556 \f/I N P U T - O U T P U T ROUTINES FOR STANDARD FILES
3571 K377, AND (7400 /FIRST LITERAL ON THIS PAGE ---> 0377
3603 FATAL0, FATAL /FATAL READ ERROR!
3685 CR, TAD [240 /END OF LINE
3691 \f/THE ORGANIZATION OF THE FOLLOWING PAGES OF FIELD 0
3692 /DEMANDS SOME EXPLANATION:
3696 / AT COMPILE TIME / AT RUNTIME /
3698 /06000--------------------------/-------------------------------/
3699 / STARTUP CODE, THEN / /
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 /
3704 /06400--------------------------/-------------------------------/
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--------------------------/-------------------------------/
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 /
3716 /07400----- AND -----/-------------------------------/
3717 / / RUNTIME ERRORS /
3719 /-------------------------------/-------------------------------/
3723 /AT COMPILATION TIME FOUR PAGES OF FIELD 6 ARE USED AS FOLLOWS:
3725 /66400--- TEMPORARY STORAGE OF INPUT DEVICE HANDLER
3727 /66600--- TEMPORARY STORAGE OF OUTPUT DEVICE HANDLER
3729 /67400--- RUNTIME ERRORS
3731 /67600--- INITIALIZATION OF RUNTIME SYSTEM
3735 /DURING INITIALIZATION OF THE RUNTIME SYSTEM
3736 /THE FIRST THREE PAGES ARE SWAPPED INTO THEIR PLACE IN FIELD 0!
3737 \f/#############################################################/
3738 /#############################################################/
3740 /##### S T A R T #####/
3742 /#############################################################/
3743 /#############################################################/
3747 /IMPORTANT POINTS OF PROGRAM FLOW:
3750 /S T A R T (06000) /STARTING ADDRESS OF ENTIRE SYSTEM,
3751 /PROCESS I/O-SPECIFICATIONS
3753 /M A I N (40200) /START OF COMPILER PROGRAM
3756 /E X P L A I N (60200) /COMPILATION REPORT
3759 /I N I T (67600) /INITIALIZATION OF RUNTIME SYSTEM
3762 /I S T A R T (00200) /START OF INTERPRETER
3772 START, CLA CLL /S T A R T I N G A D D R E S S
3774 JMS I [7700 /LOCK USR IN MEMORY
3776 TAD (1000 /RESET JOB STATUS WORD
3779 JMS I (USR /CALL THE COMMAND DECODER
3781 2023 /ASSUMED INPUT EXTENSION: .PS
3782 0 /PHPH KEEP TENTATIVE FILES (ZERO)
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?
3790 DCA DEVNO /YES, SAVE DEVICE NUMBER
3793 TAD I XR10 /TRANSFER THE FILENAME
3803 TAD DEVNO /DEVICE NUMBER
3804 JMS I (USR /FETCH OUTPUT DEVICE HANDLER
3805 1 /OPERATION: FETCH HANDLER
3806 OHEP, ODEVBUF /1 PAGE ONLY!
3810 JMS I (USR /OPEN OUTPUT FILE
3815 TAD OHEP /GET ENTRY POINT
3817 TAD SBNO /GET STARTING BLOCK NUMBER
3819 TAD LEMP /GET LENGTH OF EMPTY
3823 TAD (-1 /SETUP BLOCK COUNTER
3824 DCA MBLOCKS /(=0 IF NOT A FILE DEVICE)
3826 NOOUT, ISZ IHEP /ALLOW 2-PAGE INPUT HANDLER
3827 /IF NO OUTPUT FILE SPECIFIED!
3830 SNA /INPUT FILE SPECIFIED?
3831 JMP NOINP /NO, USE INTERN KEYBOARD HANDLER!
3834 JMS I (USR /FETCH INPUT DEVICE HANDLER
3839 TAD I (7622 /GET STARTING BLOCK NUMBER
3842 TAD IHEP /GET ENTRY POINT
3844 NOINP, CDF 0 /SAVE DEVICE HANDLERS
3845 TAD I F0T6 /IN FIELD 6 TO MAKE ROOM
3846 CDF 60 /FOR HANDLER OF SOURCE FILE
3853 SNA /SOURCE FILE SPECIFIED?
3857 JMS I (USR /FETCH HANDLER OF SOURCE FILE
3861 TAD SHEP /GET ENTRY POINT
3873 \fSTARTC, CDF 10 /CHECK /S - OPTION
3882 JMP I (MAIN /START COMPILER
3899 TEXT /DATEIANGABEN FEHLERHAFT BZW. UNVOLLSTAENDIG (EV. AUCH SYSTEMFEHLER)!/
3903 \f/K E Y B O A R D I N P U T H A N D L E R
4026 \f/H E A D E R L I N E
4029 HEADER, 0 /ONCE ONLY CODE!
4031 TAD I (7666 /GET DATE WORD FROM MONITOR
4054 WHEAD, TAD (PASCAL-1
4058 WHEND, JMP .+3 /BECOMES: JMP WHEXIT
4093 PASCAL, 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
4101 HTLMOE, "H;"T;"L;"-;"M;"O;"E;"D;"L;"I;"N;"G
4102 HDATE, ", /BECOMES: 0000 IF NO DATE SPECIFIED
4112 BLANKS, -30 /BECOMES 0000
4115 \f/BEGIN OF COMPILER PROGRAM: T H E S C A N N E R
4119 SY0=H1 /FIELD 0 REPRESENTATIVE OF 'SY'
4178 WSYMBOL,DCA K /USE AC FOR ID IN FIELD 0
4184 L0100 /=2*AC0, LINK=0
4191 L0001 /BUILD HASH-CODE
4251 RETSNGL,CDF CIF COMPFIELD
4253 ILLCHAR,ERROR;30 /24
4355 /-------- D I S P L A Y --------/
4357 /DISPLAY,ZBLOCK 20 /AT RUNTIME ONLY
4359 /---------------------------------/
4386 LBL3, L0002 /2=CHARCON
4447 FATAL9, FATAL /PROGRAM INCOMPLETE!
4456 PRINTC /CHAR = 240 !
4477 /ENTRIES FOR PREDEFINED SYMBOLS:
4479 -1; VARIABLE^100+NOTYP; 0040; 0
4480 0; KONSTANT^100+BOOLS; 0040; 0
4481 1; KONSTANT^100+BOOLS; 0040; 1
4482 2; TYPE1^100+REALS; 0040; 1
4483 3; TYPE1^100+CHARS; 0040; 1
4484 4; TYPE1^100+BOOLS; 0040; 1
4485 5; TYPE1^100+INTS; 0040; 1
4486 6; FUNKTION^100+REALS; 0040; 0
4487 7; FUNKTION^100+REALS; 0040; 2
4488 10; FUNKTION^100+BOOLS; 0040; 4
4489 11; FUNKTION^100+CHARS; 0040; 5
4490 12; FUNKTION^100+INTS; 0040; 6
4491 13; FUNKTION^100+CHARS; 0040; 7
4492 14; FUNKTION^100+CHARS; 0040; 10
4493 15; FUNKTION^100+INTS; 0040; 11
4494 16; FUNKTION^100+INTS; 0040; 12
4495 17; FUNKTION^100+REALS; 0040; 13
4496 20; FUNKTION^100+REALS; 0040; 14
4497 21; FUNKTION^100+REALS; 0040; 15
4498 22; FUNKTION^100+REALS; 0040; 16
4499 23; FUNKTION^100+REALS; 0040; 17
4500 24; FUNKTION^100+REALS; 0040; 20
4501 25; FUNKTION^100+BOOLS; 0040; 21
4502 26; FUNKTION^100+BOOLS; 0040; 22
4503 27; PROZEDURE^100+NOTYP; 0040; 1
4504 30; PROZEDURE^100+NOTYP; 0040; 2
4505 31; PROZEDURE^100+NOTYP; 0040; 3
4506 32; PROZEDURE^100+NOTYP; 0040; 4
4507 33; PROZEDURE^100+NOTYP; 0040; 5
4508 34; PROZEDURE^100+NOTYP; 0040; 6
4509 35; FUNKTION^100+REALS; 0040; 23
4510 36; PROZEDURE^100+NOTYP; 0040; 0
4513 /N A M E S OF S Y M B O L - T A B L E
4515 /THE FOLLOWING NAMES ARE PREDEFINED:
4580 \f/F S Y S AND S E T - C O N S T A N T S
4584 FSYS, ZBLOCK 5 / M U S T BE AT 4000!!!
4591 CONBGS, 7140;0000;0000;4000;0000
4593 TYPBGS, 0000;0000;0006;4000;0000
4595 BLOBGS, 0000;0000;0370;2000;0000
4597 FACBGS, 7200;0020;0000;4000;0000
4599 STATBGS,0000;0000;0000;3740;0000
4600 SET6, 0000;0001;1000;0000;0000
4601 SET7, 0000;0000;0370;6000;0000
4602 SET8, 0140;0000;0000;0000;0000
4603 SET9, 0000;0012;1000;0002;0000
4604 SET10, 0000;0013;0000;0002;0000
4605 SET11, 0000;0001;4000;4020;0000
4606 SET12, 0000;0000;4000;4020;0000
4607 SET13, 0000;0000;0040;4000;0000
4608 SET14, 0000;0010;0000;0000;0000
4609 SET15, 0000;0010;4000;0000;0000
4610 SET16, 0000;0001;0000;4000;0000
4611 SET17, 0000;0000;5000;0000;0000
4612 SET18, 0000;0000;0000;4000;0000
4613 SET19, 0000;0001;4000;4000;0000
4614 SET20, 0000;0000;4000;0000;0000
4615 SET21, 0000;0003;0000;0000;0000
4616 SET22, 0000;0024;2000;0000;0000
4617 SET23, 0000;0011;1000;0000;0000
4618 SET24, 0000;0011;0000;0000;0000
4619 SET25, 7000;0000;0000;0000;0000
4620 SET26, 0037;0000;0000;0000;0000
4621 SET27, 0140;4000;0000;0000;0000
4622 SET28, 0000;3740;0000;0000;0000
4623 SET29, 0000;2000;0400;0000;0000
4624 SET30, 0000;0000;4000;0020;0000
4625 SET31, 0000;0000;4000;3740;0000
4626 SET32, 0000;0000;0000;0001;1000
4627 SET33, 0000;0000;0000;0010;0000
4628 SET34, 0000;0001;1000;0002;0000
4629 SET35, 0000;0000;4000;0004;0000
4630 SET36, 0000;0000;0000;0001;0000
4631 SET37, 0000;0000;0400;0001;6000
4632 SET38, 0000;0000;0000;0001;6000
4633 SET39, 0000;0000;0000;0000;6000
4634 SET40, 0000;0000;0000;7740;0000
4635 SET41, 0000;0020;5000;0000;0000
4636 SET42, 0000;0000;0030;0000;0000
4637 SET43, 0000;0000;0000;2000;0000
4638 SET44, 0000;0000;0370;3740;0000
4639 SET45, 0000;0000;2000;0000;0000
4640 SET46, 0000;0001;4000;4000;0000
4641 \f/WORD- AND BIT-POSITION TABLE USED BY SET-ROUTINES:
4707 \f/H A S H - T A B L E OF K E Y W O R D S
4711 DECIMAL /ADDRESSES SPECIFIED IN DECIMAL!
4713 ZBLOCK 128^4 /CLEAR UNUSED LOCATIONS!
4715 KSYTABLE=. /REMEMBER END OF HASHTABLE
4771 \f/S Y M B O L - V A L U E S OF K E Y W O R D S
4774 ZBLOCK 128 /FOR SAFETY!
4775 PUSHTABLE=. /REMEMBER END OF KSYTABLE
4834 \f/P U S H T A B L E
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.
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
4851 ISFUN-1; -5; FSYS+2; XBLOCK
4853 0; 0; FSYS; XSTATEMENT
4855 LV-1; -6; 2; XASSIGNMENT
4859 IXTYP-1; -4; 0; XIFSTATEMENT
4861 CASETAB-1; -137; 0; XCASESTATEMENT
4863 RXTYP-1; -3; 0; XREPEAT
4865 WXTYP-1; -4; 0; XWHILE
4867 FXTYP-1; -6; 0; XFORSTATEMENT
4869 PRCN-1; -5; 1; XSTPROC
4871 SELVAR-1; -5; FSYS+200+1; XSELECT
4873 CALI-1; -5; FSYS+1; XCALL
4875 FCTN-1; -2; 1; XSTFUN
4877 FACVAR-1; -3; FSYS+200+1; XFACTOR
4879 TRMXTYP-1; -4; FSYS+1; XTERM
4881 SIMXTYP-1; -4; FSYS+1; XSIMPLE
4883 EXPRVAR-1; -6; FSYS+200+1; XEXPRESSION
4885 CONREC-1; 0; 0; XCONDECL
4887 DECTP-1; 0; 0; XTYPDECL
4889 VARTP-1; 0; 0; XVARDECL
4891 PROFUN-1; -1; 0; XPRODECL
4893 CCON-1; 0; FSYS+1; XCONSTANT
4895 ARRVAR-1; -6; 200+1; XARRAYTYP
4897 TYPVAR-1; -12; FSYS+300+1; XTYPE
4899 PARTP-1; 0; 0; XPARAM
4902 \f/TABLE OF S P E C I A L S Y M B O L S
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
4911 /SPACE ! " # $ % & ' ( ) * + , - . /
4929 ZBLOCK "9-"0+1 /DIGITS ARE PROCESSED SEPARATELY!
4940 ZBLOCK "Z-"A+1 /LETTERS ARE PROCESSED SEPARATELY!
4948 \f/C O M P I L E R E R R O R S (NOT FATAL)
4952 ERRLINE,"#-240; "#-240; "#-240; "#-240; "#-240; 0; 0
4960 ERRNO, 0 /ERROR NUMBER
4961 ERRN01, 0 /ERROR NUMBER - UNITS
4962 ERRN10, 0 /ERROR NUMBER - TENS
4963 ERRPOS, 0 /POSITION OF ERROR
4966 /ERRSW, 0 /IN FIELD 0
4967 /ERRSUM,0 /IN FIELD 6
5003 JMP ERREXIT /NO ROOM!
5021 ERREXIT,CDF ERRFIELD
5022 ISZ I ERRNO /REMEMBER THIS ERROR
5023 ISZ I (ERRSUM /COUNT ERRORS
5028 \f/C O M P I L E R E R R O R S (FATAL)
5093 FMFL, FATMESG-FATLIST
5124 FNN, TEXT /KOMPILATION ABGEBROCHEN - /
5126 F00, TEXT /MAGNETBAND-LESEFEHLER!/
5127 F01, TEXT /ZU VIELE NAMEN!/
5128 F02, TEXT /ZU VIELE PROZEDUREN UND\ODER RECORDS!/
5129 F03, TEXT /ZU VIELE KONSTANTE!/
5130 F04, TEXT /ZU VIELE ARRAYS!/
5131 F05, TEXT /ZU VIELE UNTERPROGRAMMEBENEN!/
5132 F06, TEXT /PROGRAMM ZU GROSS!/
5133 F07, TEXT /ZU VIEL TEXT!/
5134 F08, TEXT /PROGRAMM ZU KOMPLEX!/
5135 F09, TEXT /PROGRAMM UNVOLLSTAENDIG!/
5136 F0C, TEXT /ZU VIELE CASE-MARKEN!/
5143 /LOC'S 1 - 7 USED FOR TEMPORARY STORAGE!
5147 /XR10, /AUTOINDEX REGISTER (SEE FIELD 0!)
5153 LC, 0 /L O C A T I O N C O U N T E R
5155 /I N S T R U C T I O N - R E G I S T E R
5161 /I N D I C E S T O T A B L E S
5172 J, 0 /TEMPORARY FOR T
5173 JA, 0 /TEMPORARY FOR A
5174 JB, 0 /TEMPORARY FOR B
5176 LO, 0 /LOW BOUND OF ARRAY
5177 HI, 0 /HIGH BOUND OF ARRAY
5178 SLENG, 0 /LENGTH OF STRING
5180 SY, 0 /C U R R E N T S Y M B O L
5182 ID, 0;0;0;0 /C U R R E N T I D E N T I F I E R
5183 NUM, 0;0;0;0 /C O N S T A N T N U M B E R
5185 *50 /U N P A C K E D E N T R Y OF SYMBOL TABLE
5194 JW, 0 /ADDRESS OF ENTRY (REMEMBERED FOR 'WITHEND')
5196 *50 /U N P A C K E D E N T R Y OF ARRAY TABLE
5205 JAW, 0 /ADDRESS OF ENTRY (REMEMBERED FOR 'WITHAEND')
5207 /LOCAL VAR'S OF PROCEDURE B L O C K
5214 /LOCAL VAR'S OF PROCEDURE F A C T O R
5219 /LOCAL VAR'S OF PROCEDURE C A L L
5226 /LOCAL VAR'S OF P U S H J U M P AND P O P J U M P
5231 /M A C R O I N S T R U C T I O N S USED BY COMPILER
5234 /ERROR=JMS I . /PARALLEL DEFINED WITH FIELD 0!
5236 /FATAL=JMS I . / -"-
5238 /OFTAB=JMS I . / -"-
5240 /OFATAB=JMS I . / -"-
5242 /OFBTAB=JMS I . / -"-
5244 /OFDISPLAY=JMS I . / -"-
5246 /TODISPLAY=JMS I . / -"-
5248 /GETCONSTANT=JMS I . / -"-
5250 TOTAB=JMS I . /PUT INFO INTO SYMBOL TABLE
5252 TOATAB=JMS I . /PUT INFO INTO ARRAY TABLE
5254 TOBTAB=JMS I . /PUT INFO INTO BLOCK TABLE
5256 WITHTABDO=JMS I . /GET AND UNPACK ENTRY OF SYMBOL TABLE
5258 ENDWITH=JMS I . /PACK AND STORE ENTRY OF SYMBOL TABLE
5260 WITHATABDO=JMS I . /GET AND UNPACK ENTRY OF ARRAY TABLE
5262 ENDAWITH=JMS I . /PACK AND STORE ENTRY OF ARRAY TABLE
5264 TOCODE=JMS I . /INSERT ADDRESS INTO CODE[LC].IRY
5266 EMIT=JMS I . /OUTPUT INSTRUCTION OF INTERMEDIATE CODE
5268 ENTER=JMS I . /ENTER ITEM INTO SYMBOL TABLE
5270 ENTERVARIABLE=JMS I . /ENTER VARIABLE INTO SYMBOL TABLE
5272 ENTERARRAY=JMS I . /INTO ARRAY TABLE
5274 ENTERBLOCK=JMS I . /INTO BLOCK TABLE
5276 ENTERCONSTANT=JMS I . /INTO CONSTANT TABLE
5278 SIGNEDINTEGER=JMS I . /MAKE SIGNED 12-BIT INTEGER OF (NUM)
5280 TEST=JMS I . /CHECK AND SKIP TO LEGAL FOLLOW SYMBOL
5282 TESTSEMICOLON=JMS I .
5284 SKIP=JMS I . /SKIP TO LEGAL FOLLOW SYMBOL
5286 SKIPIFSYIN=JMS I . /SKIP NEXT INSTR. IF SY IN SETX
5288 UNION=JMS I . /SET UNION
5290 IFSY=JMS I . /IF SY=SYMBOL THEN NEXT INSTR. ELSE SKIP
5292 IFSYNOT=JMS I . /IF SY<>SYMBOL THEN NEXT INSTR. ELSE SKIP
5294 LOCATE=JMS I . /LOCATE IDENTIFIER IN SYMBOL TABLE
5296 PUSHJUMP=JMS I . /RECURSIVE PROCEDURE CALL
5298 POPJUMP=JMS I . /RETURN FROM PROCEDURE
5302 INSYMBOL=JMS I . /SCANNER
5305 /LOCAL VAR'S OF PROCEDURE T Y P E
5317 /LOCAL VAR'S OF PROCEDURE W H I L E - STATEMENT
5322 \f/M A I N P R O G R A M OF COMPILER
5326 IFSYNOT;PROGRAMSY;JMP MAIN3
5328 IFSYNOT;IDENT;JMP MAIN2
5330 IFSY;LPARENT;JMP .+4
5338 IFSY;COMMA;JMP IOFILES
5339 ENDOFH, IFSY;RPARENT;JMP .+4
5358 IFSYNOT;PERIOD;ERROR;26 /22
5361 JMP I (EXPLAIN /DO THE COMPILATION REPORT
5368 \f/EXTENSION OF P U S H J U M P AND P O P J U M P ROUTINES
5404 DCA XR12 /USE LOC'S 1 - 7 FOR TEMP. STORAGE
5425 \f/PROCEDURE C O N S T A N T
5428 /CALL: PUSHJUMP;CONSTANT
5436 XCONSTANT, DCA I CCON
5443 TEST;CONBGS;FSYS;62 /50
5446 IFSYNOT;CHARCON;JMP .+4
5456 CON1, IFSYNOT;IDENT;JMP CON2
5488 CON2, IFSY;INTCON;JMP CON3-2
5489 IFSY;REALCON;JMP CON3-3
5511 CON5, TEST;FSYS;SET0;6 /6
5512 CON6, POPJUMP;CONSTANT
5515 \f/PROCEDURE A R R A Y T Y P
5518 /CALL: PUSHJUMP;ARRAYTYP
5549 ARR1, IFSY;COLON;JMP .+4
5570 ARR2, SIGNEDINTEGER;LOWB
5578 IFSYNOT;COMMA;JMP ARR3
5586 ARR3, IFSY;RBRACK;JMP .+5
5588 IFSY;RPARENT;INSYMBOL
5625 \f/PROCEDURE T Y P E
5628 /CALL: PUSHJUMP;TYPE
5634 /LOCAL VAR'S (ON PAGE ZERO!):
5647 XTYPE, DCA TP /0=NOTYP
5650 TEST;TYPBGS;FSYS;12 /10
5653 IFSYNOT;IDENT;JMP TYP1
5676 TYP1, IFSYNOT;ARRAYSY;JMP TYP2
5680 IFSY;LPARENT;INSYMBOL
5701 TYP3, SKIPIFSYIN;SET46;JMP TYP6
5702 IFSYNOT;IDENT;JMP TYP5
5744 TYP5, IFSY;ENDSY;JMP TYP6
5745 IFSY;SEMICOLON;JMP .+5
5748 TEST;SET12;FSYS;6 /6
5761 TYP7, TEST;FSYS;SET0;6 /6
5763 \f/PROCEDURE C O N D E C L
5766 /CALL: PUSHJUMP;CONDECL /NO ARG'S!
5772 TEST;SET18;BLOBGS;2 /2
5773 CDEC1, IFSYNOT;IDENT;POPJUMP;CONDECL
5778 IFSY;BECOMES;INSYMBOL
5794 ENTERCONSTANT;CONREC
5801 \f/PROCEDURE T Y P D E C L
5804 /CALL: PUSHJUMP;TYPDECL /NO ARG'S!
5813 TEST;SET18;BLOBGS;2 /2
5814 TDEC1, IFSYNOT;IDENT;POPJUMP;TYPDECL
5821 IFSY;BECOMES;INSYMBOL
5841 \f/PROCEDURE P A R A M E T E R L I S T
5842 / -------------------------
5844 /CALL: PUSHJUMP;PARAMETERLIST /NO ARG'S!
5857 TEST;SET13;FSYS+SET14;7 /7
5858 PAR1, SKIPIFSYIN;SET13
5860 IFSYNOT;VARSY;JMP .+3
5868 IFSYNOT;COMMA;JMP .+4
5903 PAR2, TEST;SET15;FSYS+SET16;16 /14
5927 PAR4, IFSY;RPARENT;JMP PAR6
5928 IFSY;SEMICOLON;JMP .+5
5931 TEST;SET13;FSYS+SET14;6 /6
5933 PAR5, IFSY;RPARENT;JMP PAR6
5937 TEST;SET17;FSYS;6 /6
5938 POPJUMP;PARAMETERLIST
5941 \f/PROCEDURE V A R D E C L
5944 /CALL: PUSHJUMP;VARDECL /NO ARG'S!
5954 IFSYNOT;IDENT;POPJUMP;VARDECL
5958 IFSYNOT;COMMA;JMP .+4
5999 \f/PROCEDURE P R O D E C L
6002 /CALL: PUSHJUMP;PRODECL /NO ARG'S!
6004 /LOCAL VAR'S: PROFUN, 0 /SEE BELOW!
6006 XPRODECL, IFSY;FUNCTIONSY;L0001
6018 ENTER;00 /FUNCTION OR PROCEDURE
6034 IFSY;SEMICOLON;JMP .+4
6041 EMIT;00 /*** (32) OR (33) ***/
6045 \f/PROCEDURE S E L E C T O R
6048 /CALL: PUSHJUMP;SELECTOR
6059 XSELECT, IFSYNOT;PERIOD;JMP SEL2
6060 INSYMBOL /FIELD SELECTOR
6091 EMIT;11 /*** (9) ***/
6094 SEL2, IFSYNOT;LBRACK;ERROR;13 /11
6106 TAD SELVREF /ARRAY INDEX
6118 CLL RAR /1 SCOMPARES!
6123 EMIT;00 /*** (20) OR (21) ***/
6128 SEL4, IFSY;COMMA;JMP SEL3
6131 IFSY;RPARENT;INSYMBOL
6132 SEL5, SKIPIFSYIN;SET22
6139 \f/FUNCTION R E S U L T T Y P E
6140 / -------------------
6147 /RETURNS RESULTTYPE IN ACCUMULATOR
6154 TAD [-2 /HERE: XTYP<>0 AND YTYP<>0, XTYP IN AC
6161 SNA /HERE ONLY INTS OR REALS, YTYP IN AC
6162 JMP .+5 /(7777 ... INTS, 0000 ... REALS)
6165 JMP RES1 /INTS - INTS
6166 JMP .+5 /REALS - INTS
6169 JMP .+5 /REALS - REALS
6172 EMIT;32 /*** (26,0) OR (26,1) ***/
6179 \f/PROCEDURE C A L L
6182 /CALL: PUSHJUMP;CALL
6186 /LOCAL VAR'S (ON PAGE ZERO!):
6196 EMIT;22 /*** (18,I) ***/
6205 IFSYNOT;LPARENT;JMP CAL5
6218 PUSHJUMP;EXPRESSION /VALUE PARAMETER
6252 EMIT;26 /*** (22,SIZE) ***/
6262 EMIT;32 /*** (26,0) ***/
6271 CAL3, IFSY;IDENT;JMP .+4 /VARIABLE PARAMETER
6297 EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/
6321 CAL4, TEST;SET24;FSYS;6 /6
6323 IFSY;RPARENT;JMP .+4
6341 EMIT;23 /*** (19,PSIZE-1) ***/
6349 DCA IRX /SWAPPED CONTENTS OF IRX AND IRY HERE!
6350 TAD TEMP /(SEE INTERPRETER AT I03)
6353 EMIT;3 /*** (3,LEV1,LEV2) ***/
6357 \f/PROCEDURE S T A N D F C T
6360 /CALL: PUSHJUMP;STANDFCT
6364 FCTN, 0 /NUMBER OF STANDARD FUNCTION
6371 IFSY;LPARENT;JMP .+4
6375 TAD J /J IS SET IN FACTOR
6389 BSW /(MUST INSERT OBJ
6390 TAD FACXTYP /ALONG WITH TYP!)
6400 JMP STF2 /FCTN: 4,5,6,7,8
6401 L7777 /FCTN: 9,10,11, ... ,16
6404 EMIT;32 /*** (26,0) ***/
6420 EMIT;10 /*** (8,N) ***/
6425 IFSY;RPARENT;JMP .+4
6429 STF4, OFTAB;TYP /(J STILL OKAY!?)
6436 EMIT;10 /*** (8,17) OR (8,18) OR (8,19) ***/
6440 /TABLE OF LEGAL ARGUMENT TYPES:
6462 \f/PROCEDURE F A C T O R
6465 /CALL: PUSHJUMP;FACTOR
6469 /LOCAL VAR'S (ON PAGE ZERO!):
6475 XFACTOR,DCA FACXTYP /0=NOTYP
6477 TEST;FACBGS;FSYS;72 /58
6478 FAC1, SKIPIFSYIN;FACBGS
6480 IFSYNOT;IDENT;JMP FAC2
6508 EMIT;00 /*** (24,ADR) OR (25,ADR) ***/
6525 EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/
6531 TAD [-4 /STANTYPS = NOTYP(0) ... CHAR(4)
6533 EMIT;42 /*** (34) ***/
6535 FVAR1, DCA .+11 /F=0
6539 ISZ .+5 /F:=F+1 (IN STANTYPS!)
6543 EMIT;00 /*** (F,LEV,ADR) ***/
6569 FAC2, SKIPIFSYIN;SET25
6577 DCA FACXTYP /INTS OR REALS
6580 EMIT;31 /*** (25,C) ***/
6582 FAC21, L0004 /4=CHARS
6586 EMIT;30 /*** (24,NUM) ***/
6590 FAC23, IFSYNOT;LPARENT;JMP FAC24
6596 IFSY;RPARENT;JMP .+4
6601 FAC24, IFSYNOT;NOTSY;JMP FAC3
6611 EMIT;43 /*** (35) ***/
6616 FAC3, TEST;FSYS;FACBGS;6 /6
6620 \f/PROCEDURE T E R M
6623 /CALL: PUSHJUMP;TERM
6639 TRM1, SKIPIFSYIN;SET26
6649 TAD (JMP I OPTABL-TIMES
6659 XTIMES, TAD I TRMXTYP
6672 EMIT;60 /*** (48,3) OR (48,12) ***/
6681 EMIT;32 /*** (26,1) ***/
6689 EMIT;32 /*** (26,0) ***/
6702 EMIT;60 /*** (48,13) ***/
6706 XIMOD, L7777 /1=INTS
6717 EMIT;60 /*** (48,4) OR (48,5) ***/
6720 XAND, L7775 /3=BOOLS
6728 EMIT;64 /*** (52) ***/
6740 ERRTYP, 00 /32, 33 OR 34
6741 DCA I TRMXTYP /0=NOTYP
6745 \f/PROCEDURE S I M P L E E X P R E S S I O N
6746 / -------------------------------
6748 /CALL: PUSHJUMP;SIMPLEEXPRESSION
6758 XSIMPLE,SKIPIFSYIN;SET8
6778 EMIT;44 /*** (36) ***/
6786 SIM2, SKIPIFSYIN;SET27
6787 POPJUMP;SIMPLEEXPRESSION
6807 EMIT;63 /*** (51) ***/
6809 NOTBOOL,TAD I SIMXTYP
6814 DCA I SIMXTYP /0=NOTYP
6824 CLL RAR /NOW: 0...INTS, 1...REALS!
6828 TAD SIMOP /+ ... 5, - ... 6
6830 EMIT;60 /*** (48,1) OR (48,2) OR (48,10) OR (48,11) ***/
6834 \f/PROCEDURE E X P R E S S I O N
6835 / -------------------
6837 /CALL: PUSHJUMP;EXPRESSION
6850 PUSHJUMP;SIMPLEEXPRESSION
6859 PUSHJUMP;SIMPLEEXPRESSION
6867 TAD [-2 /2+2=4=CHARS
6881 EMIT;32 /*** (26,1) ***/
6889 EMIT;32 /*** (26,0) ***/
6904 TAD (TAD RELTABL-EQL
6906 0000 /TAD RELTABL (MODIFIED INSTR.!)
6909 I61R62, 00 /*** (49,OP) OR (50,OP) ***/
6910 EXPR3, L0003 /3=BOOLS
6914 ILLTYP, ERROR;43 /35
6925 \f/PROCEDURE A S S I G N M E N T
6926 / -------------------
6928 /CALL: PUSHJUMP;ASSIGNMENT
6941 OFTAB;TYP /J IS SET IN STATEMENT
6957 EMIT;00 /*** (0,LV,AD) OR (1,LV,AD) ***/
6964 IFSY;BECOMES;JMP .+5
6980 TAD AXREF /ARRAY- OR RECORD-VARIABLE
6995 EMIT;27 /*** (23,SIZE) ***/
6997 ASS1, L7776 /2=REALS
7005 EMIT;32 /*** (26,0) ***/
7006 EMIT;46 /*** (38) ***/
7007 ASS2, POPJUMP;ASSIGNMENT
7013 ASSERR, ERROR;56 /46
7015 \f/PROCEDURE C O M P O U N D S T A T E M E N T
7016 / ---------------------------------
7018 /CALL: PUSHJUMP;COMPOUNDSTATEMENT /NO ARG'S!
7029 IFSY;SEMICOLON;JMP XCOMPOUNDSTATEMENT
7031 JMP XCOMPOUNDSTATEMENT+1
7032 CMP1, IFSY;ENDSY;JMP .+4
7036 POPJUMP;COMPOUNDSTATEMENT
7039 \f/PROCEDURE C A S E L A B E L
7042 /CALL: JMS CASELABEL /NOT RECURSIVE!
7062 FATALC, FATAL /TOO MUCH CASE-LABELS!
7085 LABERR, ERROR;57 /47
7089 CLIMIT, -2^CSMAX-CASETAB+1
7091 \f/PROCEDURE C A S E S T A T E M E N T
7092 / -------------------------
7094 /CALL: PUSHJUMP;CASESTATEMENT /NO ARG'S!
7097 CASETAB, ZBLOCK CSMAX^2
7098 EXITTAB, ZBLOCK CSMAX
7105 XCASESTATEMENT, INSYMBOL
7118 TAD [-2 /2+2=4=CHARS (LAST STANTYP)
7123 EMIT;14 /*** (12) ***/
7129 IFSY;SEMICOLON;JMP CAS1
7141 EMIT;15 /*** (13) ***/
7143 CAS3, EMIT;12 /*** (10) ***/
7154 CAS5, IFSY;ENDSY;JMP .+4
7158 POPJUMP;CASESTATEMENT
7159 \f/PROCEDURE O N E C A S E
7162 /CALL: PUSHJUMP;ONECASE /NO ARG'S!
7164 /NO LOCAL VAR'S! (USES SOME VAR'S OF 'CASESTATEMENT')
7166 XONECASE, SKIPIFSYIN;CONBGS
7182 EMIT;12 /*** (10) ***/
7183 ONE2, POPJUMP;ONECASE
7186 \f/PROCEDURE I F S T A T E M E N T
7187 / ---------------------
7189 /CALL: PUSHJUMP;IFSTATEMENT /NO ARG'S!
7211 EMIT;13 /*** (11) ***/
7218 IFSYNOT;ELSESY;JMP IF1
7222 EMIT;12 /*** (10) ***/
7224 TOCODE /*** CODE[ILC1] := LC ***/
7229 TOCODE /*** CODE[ILC2] := LC ***/
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 / -----------------------------
7236 /CALL: PUSHJUMP;REPEATSTATEMENT /NO ARG'S!
7251 IFSY;SEMICOLON;JMP XREPEAT+2
7254 REP1, IFSYNOT;UNTILSY;JMP REPERR
7268 EMIT;13 /*** (11,RLC1) ***/
7270 REPERR, ERROR;65 /53
7271 POPJUMP;REPEATSTATEMENT
7272 \f/PROCEDURE W H I L E S T A T E M E N T
7273 / ---------------------------
7275 /CALL: PUSHJUMP;WHILESTATEMENT /NO ARG'S!
7277 /LOCAL VAR'S (ON PAGE ZERO!):
7299 EMIT;13 /*** (11) ***/
7309 EMIT;12 /*** (10,WLC1) ***/
7311 TOCODE /*** CODE[WLC2] := LC ***/
7312 POPJUMP;WHILESTATEMENT
7315 \f/PROCEDURE F O R S T A T E M E N T
7316 / -----------------------
7318 /CALL: PUSHJUMP;FORSTATEMENT /NO ARG'S!
7330 IFSYNOT;IDENT;JMP FOR2
7348 EMIT;0 /*** (0,LEV,ADR) ***/
7353 TAD [-2 /2+2=4=CHARS (LAST STANTYP)
7361 FOR2, SKIP;FSYS+SET37;2 /2
7362 FOR3, IFSYNOT;BECOMES;JMP FOR4
7374 FOR4, SKIP;FSYS+SET38;63 /51
7393 FOR6, SKIP;FSYS+SET36;67 /55
7398 EMIT;00 /*** (14) OR (16) ***/
7413 EMIT;00 /*** (15,FLC2) OR (17,FLC2) ***/
7415 TOCODE /*** CODE[FLC1] := LC ***/
7416 POPJUMP;FORSTATEMENT
7419 \f/PROCEDURE S T A N D P R O C
7422 /CALL: PUSHJUMP;STANDPROC
7433 TAD (JMP I STPRTAB-1
7444 SPREAD, IFSYNOT;LPARENT;JMP SPR3
7474 EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/
7485 TAD (-1 /4=CHARS (LAST STANTYP)
7490 EMIT;33 /*** (27,TYP) ***/
7493 SPR2, TEST;SET24;FSYS;6 /6
7495 IFSY;RPARENT;JMP .+4
7502 EMIT;76 /*** (62) ***/
7504 \fSPASCII,IFSYNOT;LPARENT;JMP SPASC2
7514 EMIT;75 /*** (61) ***/
7515 IFSY;COMMA;JMP SPASC1
7516 IFSY;RPARENT;JMP .+4
7520 SPASC2, POPJUMP;STANDPROC
7523 SPHALT, EMIT;45 /*** (37) ***/
7527 \fSPWRITE,IFSYNOT;LPARENT;JMP SPW5
7529 IFSYNOT;STRING;JMP SPW2
7532 EMIT;30 /*** (24,SLENG) ***/
7536 IFSYNOT;COLON;JMP SPW1A
7547 SPW1A, EMIT;30 /*** (24,0) ***/
7550 EMIT;34 /*** (28,NUM) ***/
7554 SPW2, PUSHJUMP;EXPRESSION
7562 IFSYNOT;COLON;JMP SPW3+1
7572 IFSYNOT;COLON;JMP SPW3
7586 EMIT;37 /*** (31) ***/
7593 EMIT;00 /*** (29,TYP) OR (30,TYP) ***/
7594 SPW4, IFSY;COMMA;JMP SPW1
7595 IFSY;RPARENT;JMP .+4
7602 EMIT;77 /*** (63) ***/
7606 \f/PROCEDURE S T A T E M E N T
7609 /CALL: PUSHJUMP;STATEMENT
7616 IFSYNOT;IDENT;JMP STAT1
7635 JMPOBJ, JMP I OBJTABL
7683 STAT2, TEST;FSYS;SET0;16 /14
7686 STATNO, COMPOUNDSTATEMENT-BEGINSY
7687 \f/PROCEDURE B L O C K
7690 /CALL: PUSHJUMP;BLOCK
7695 /LOCAL VAR'S (ON PAGE ZERO!):
7703 MAXLEV, -LMAX /CONSTANT
7717 JMP I TOFAT5 /TOO MUCH LEVELS!
7718 TEST;SET41;FSYS;7 /7
7730 IFSY;LPARENT;PUSHJUMP;PARAMETERLIST
7740 IFSYNOT;COLON;JMP I BLK2M2
7742 IFSYNOT;IDENT;JMP I BLK1
7774 BLO1, SKIP;FSYS+SET20;2 /2
7777 BLO2, IFSY;SEMICOLON;JMP .+4
7781 BLO3, IFSY;CONSTSY;PUSHJUMP;CONDECL
7782 IFSY;TYPESY;PUSHJUMP;TYPDECL
7783 IFSY;VARSY;PUSHJUMP;VARDECL
7788 BLO4, SKIPIFSYIN;SET42
7792 TEST;SET43;SET44;70 /56
7804 IFSY;SEMICOLON;JMP BLO5
7807 BLO6, IFSY;ENDSY;JMP .+4
7811 TEST;FSYS+SET45;SET0;6 /6
7815 \f/M A C R O - I N S T R U C T I O N S :
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
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)
7827 PSTART, 0 /STARTING ADDRESS OF PROCEDURE
7829 PPP, 0 /STACK POINTER (POINTS ALWAYS TO 1ST FREE LOC.)
7854 FATAL8, FATAL /PROGRAMM TOO COMPLEX ---> STACK FULL!
7875 JMS PUSH /PUSH LOCAL VARIABLES (IF ANY)
7887 JMS PUSH /PUSH FSYS (IF NECESSARY)
7890 GEFSYS, L4000 /GET SET-ARGUMENT (IF PRESENT)
7894 DCA SETA /<0: FSYS OR SETX ONLY
7895 TAD SETA />0: FSYS+SETX
7902 GETPAR, TAD PARAM /GET PARAMETERS
7915 JMS VARIN /PASS VAR-PARAMETERS (IF ANY)
7917 JMS PUSH /PUSH RETURN ADDRESS
7918 JMP I PSTART /AND J U M P TO PROCEDURE
7923 JMS POP /GET RETURN ADDRESS
7929 DCA PUSH /(MIS)USE THIS FREE LOC.
7932 JMS POP /POP FSYS (IF IT WAS PUSHED)
7941 POVAR, JMS VARTM /TEMP. STORE VAR-PARAMETERS
7948 JMS POP /POP LOCAL VARIABLES (IF ANY)
7955 JMS VAREX /PASS VAR-PARAMETERS (IF ANY)
7956 JMP I PSTART /R E T U R N
7959 \f/M A C R O - I N S T R U C T I O N S :
7962 /O F D I S P L A Y /AC := DISPLAY[LEVEL]
7964 /T O D I S P L A Y /DISPLAY[LEVEL] := AC
7966 /O F T A B /AC := TAB[AC].SEL, IF AC=0 GET TAB[J].SEL
7968 /T O T A B /TAB[J].SEL := AC
7970 /O F A T A B /AC := ATAB[AC].SEL, IF AC=0 GET ATAB[JA].SEL
7972 /T O A T A B /ATAB[JA].SEL := AC
7974 /O F B T A B /AC := BTAB[AC].SEL, IF AC=0 GET BTAB[JB].SEL
7976 /T O B T A B /BTAB[JB].SEL := AC
7978 /W I T H T A B D O /GET AND UNPACK TAB[AC] OR TAB[J]
7980 /E N D W I T H /PACK AND STORE UNPACKED ENTRY OF TAB
8068 DCA JW /SYMBOL TABLE STARTS AT 0000 !
8121 \f/M A C R O - I N S T R U C T I O N S :
8123 /W I T H A T A B D O /GET AND UNPACK ATAB[JA]
8125 /E N D A W I T H /PACK AND STORE UNPACKED ENTRY OF ATAB
8127 /E M I T /EMIT INTERMEDIATE CODE (F,IRX,IRY)
8130 /T O C O D E /CODE[AC].IRY := LC
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
8150 0000 /DCA INXTP0 (MODIFIED INSTR.!)
8165 0000 /TAD INXTP0 (MODIFIED INSTR.!)
8177 TAD I XEMIT /GET OP-CODE
8190 FATAL6, FATAL /PROGRAM TOO LONG!
8221 FATAL3, FATAL /TOO MUCH CONSTANTS!
8264 \f/M A C R O - I N S T R U C T I O N S :
8267 /E N T E R /ENTER OBJEJT INTO SYMBOL TABLE
8270 /E N T E R V A R I A B L E
8272 /E N T E R B L O C K
8274 /E N T E R A R R A Y
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
8284 FATAL1, FATAL /SYMBOL TABLE FULL!
8314 BSW /OBJ, TYP (0=NOTYP)
8316 TAD LEVEL /REF=0, NORMAL=0, LEVEL
8338 FATAL2, FATAL /TOO MUCH BLOCKS!
8376 TAD [4000 /LINK=1? ---> NEGATIVE
8392 \f/-------- D I S P L A Y --------/
8395 IFNZRO DISPLAY-. <PARALLEL DEFINED IN FIELD 0 AND FIELD 4 !!!>
8399 /---------------------------------/
8402 /M A C R O - I N S T R U C T I O N S :
8405 /L O C A T E /LOCATE IDENTIFIER IN SYMBOL TABLE
8406 /EXITS WITH TABLE INDEX IN AC
8408 /E N T I D /TAB[AC].NAME := ID
8410 /C H K I D /SKIP IF TAB[J].NAME <> ID
8412 /G E T C O N S T A N T /NUM := CTAB[AC]
8422 0000 /TAD DISPLAY (MODIFIED INSTR.!)
8520 \f/M A C R O - I N S T R U C T I O N S :
8523 /T E S T S E M I C O L O N
8525 /S K I P /CALL: SKIP;SETX;N
8527 /T E S T /CALL: TEST;SETX;SETY;N
8529 /S K I P I F S Y I N /CALL: SKIPIFSYIN;SETX
8531 /I F S Y /CALL: IFSY;SYMBOL
8533 /I F S Y N O T /CALL: IFSYNOT;SYMBOL
8535 /U N I O N /CALL: UNION;SET1;SET2;S1US2
8538 IFSY;SEMICOLON;JMP .+6
8605 DCA S1 /ADDRESS OF RELATIVE SET WORD
8606 ISZ S2 /ADDRESS OF BIT POS. REL. TO SY
8632 XSA=XIFSY /NORMAL LOC.
8633 XSB=XR10 /AUTO INDEX
8664 \f/L O N G E R R O R M E S S A G E S
8669 ZBLOCK 73 /ERROR COUNTERS
8671 ERRSUM, 0 /NUMBER OF DETECTED ERRORS
8673 *100 /ADDRESS LIST OF ERROR MESSAGES
8752 SNA CLA /SKP CLA ---> PRINT ALL!
8781 JMP I (INIT /INITIALIZE RUNTIME SYSTEM
8817 EOKAY, TEXT /KOMPILATION EINWANDFREI!/
8819 EHEAD, TEXT /ERKLAERUNG DER FEHLER:/
8823 \f/L O N G E R R O R M E S S A G E S
8825 /(MADE INVISIBLE BY 'XLIST' TO SAVE PAPER IN ASSEMBLY LISTING!)
8829 E00,TEXT / 0 DIESER NAME WURDE NICHT VEREINBART./
8830 E01,TEXT / 1 NAME IM GUELTIGKEITSBEREICH MEHRFACH VEREINBART./
8831 E02,TEXT / 2 NAME FEHLT!/
8832 E03,TEXT / 3 JEDES PROGRAMM MUSS MIT DEM WORTSYMBOL 'PROGRAM' BEGINNE/
8835 E04,TEXT / 4 RUNDE RECHTSKLAMMER FEHLT (ECKIGE KLAMMER HIER FALSCH)./
8836 E05,TEXT / 5 DOPPELPUNKT FEHLT. IN VEREINBARUNGEN FOLGT DEM : EIN TYP/
8839 E06,TEXT / 6 SYNTAXFEHLER! ANGEZEIGTES SYMBOL HIER NICHT KORREKT./
8840 E07,TEXT / 7 LISTE DER FORMALPARAMETER FEHLERHAFT (NAME ODER WORTSYMB/
8843 E08,TEXT / 8 DAS WORTSYMBOL 'OF' FEHLT./
8844 E09,TEXT / 9 RUNDE LINKSKLAMMER FEHLT (ECKIGE KLAMMER HIER FALSCH)./
8845 E10,TEXT /10 TYPVEREINBARUNG FEHLERHAFT (NAME, 'ARRAY' ODER 'RECORD')./
8846 E11,TEXT /11 ECKIGE LINKSKLAMMER FEHLT (RUNDE KLAMMER HIER FALSCH)./
8847 E12,TEXT /12 ECKIGE RECHTSKLAMMER FEHLT (RUNDE KLAMMER HIER FALSCH)./
8848 E13,TEXT /13 SYMBOL .. FEHLT (LEERZEICHEN ZWISCHEN DEN PUNKTEN UNZULA/
8851 E14,TEXT /14 STRICHPUNKT FEHLT!/
8852 E15,TEXT /15 FUNKTIONSWERT KANN NUR VOM TYP INTEGER, REAL, BOOLEAN OD/
8854 TEXT /ER CHAR SEIN./
8855 E16,TEXT /16 SYMBOL = FEHLT (IN VEREINBARUNGEN IST := UNZULAESSIG)./
8856 E17,TEXT /17 NACH 'IF', 'WHILE' ODER 'UNTIL' MUSS EIN BOOL'SCHER AUSD/
8859 E18,TEXT /18 ZAEHLVARIABLE BEI 'FOR'-ANWEISUNG MUSS VOM TYP INTEGER, /
8861 TEXT /CHAR ODER BOOLEAN SEIN./
8862 E19,TEXT /19 ANFANGSWERT, ENDWERT UND ZAEHLVARIABLE MUESSEN VOM GLEIC/
8864 TEXT /HEN TYP SEIN./
8865 E20,TEXT /20 DER STANDARDNAME 'OUTPUT' MUSS IM PROGRAMMKOPF GESCHRIEB/
8868 E21,TEXT /21 ZAHL IST ZU GROSS! (MAXINT=34359738367, REALS ABS. KLEIN/
8870 TEXT /ER ALS 1.0E+308)/
8871 E22,TEXT /22 PUNKT AM PROGRAMMENDE FEHLT! (WORTSYMBOLE 'BEGIN' UND 'E/
8873 TEXT /ND' NICHT PAARWEISE?)/
8874 E23,TEXT /23 AUSDRUCK NACH 'CASE' MUSS VOM TYP INTEGER, CHAR ODER BOO/
8877 E24,TEXT /24 ILLEGALES ZEICHEN!/
8878 E25,TEXT /25 BEI KONSTANTENVEREINBARUNG MUSS NACH = EINE KONSTANTE OD/
8880 TEXT /. EIN KONST.NAME STEHEN./
8881 E26,TEXT /26 DER AUSDRUCK FUER EINEN FELD-INDEX MUSS VOM VEREINBARTEN/
8883 TEXT / INDEX-TYP SEIN./
8884 E27,TEXT /27 BEREICHSGRENZEN BEI FELDVEREINBARUNG FEHLERHAFT (UG<=OG?/
8886 TEXT / GLEICHER TYP?)/
8887 E28,TEXT /28 JEDE INDIZIERTE VARIABLE MUSS ALS ARRAY VEREINBART WERDE/
8890 E29,TEXT /29 TYPNAME FEHLT (IN PARAMETERLISTEN SIND ALLG. TYPVEREINBA/
8892 TEXT /RUNGEN VERBOTEN)./
8893 E30,TEXT /30 DIESER TYP WURDE NICHT VEREINBART./
8894 E31,TEXT /31 JEDE VARIABLE MIT KOMPONENTEN-SELEKTOR MUSS ALS RECORD V/
8896 TEXT /EREINBART WERDEN./
8897 E32,TEXT /32 'NOT', 'AND' UND 'OR' VERLANGEN OPERANDEN VOM TYP BOOLEA/
8900 E33,TEXT /33 TYP DIESES AUSDRUCKS UNBESTIMMT (GANZES ARRAY IN ARITHM./
8902 TEXT /OPERATIONEN UNZULAESSIG)./
8903 E34,TEXT /34 'DIV' UND 'MOD' VERLANGEN OPERANDEN VOM TYP INTEGER./
8904 E35,TEXT /35 TYPEN DER VERGLEICHSOPERANDEN UNVERTRAEGLICH./
8905 E36,TEXT /36 AKTUAL- UND FORMALPARAMETER MUESSEN VOM GLEICHEN TYP SEI/
8908 E37,TEXT /37 VARIABLE ERFORDERLICH!/
8909 E38,TEXT /38 EIN STRING MUSS MINDESTENS EIN ZEICHEN ENTHALTEN./
8910 E39,TEXT /39 ANZAHL DER AKTUAL- UND FORMALPARAMETER MUSS UEBEREINSTIM/
8913 E40,TEXT /40 STANDARDPROZEDUR READ NUR FUER TYP INTEGER, REAL UND CHA/
8915 TEXT /R VORGESEHEN./
8916 E41,TEXT /41 BEI WRITE SIND NUR DIE TYPEN INTEGER, REAL, BOOLEAN UND /
8918 TEXT /CHAR ZULAESSIG./
8919 E42,TEXT /42 WRITE(X:M:N) IST NUR FUER WERTE VOM TYP REAL ZULAESSIG./
8920 E43,TEXT /43 M UND N BEI WRITE(X:M:N) MUESSEN INTEGER-AUSDRUECKE SEIN./
8921 E44,TEXT /44 TYP- ODER PROZEDURNAMEN SIND IN AUSDRUECKEN UNZULAESSIG./
8922 E45,TEXT /45 EINE ANWEISUNG KANN NICHT MIT EINEM KONST-, TYP- ODER FU/
8924 TEXT /NKTIONSNAMEN BEGINNEN./
8925 E46,TEXT /46 TYPUNVERTRAEGLICHKEIT BEI WERTZUWEISUNG./
8926 E47,TEXT /47 'CASE'-MARKEN MUESSEN VOM GLEICHEN TYP WIE DER 'CASE'-AU/
8929 E48,TEXT /48 TYP DES ARGUMENTS BEI DIESER STANDARDFUNKTION UNZULAESSI/
8932 E49,TEXT /49 ARRAY-INDIZES UND 'CASE'-MARKEN SIND AUF -2048 < X < 204/
8935 E50,TEXT /50 EINE KONSTANTE KANN NICHT MIT DEM BEZEICHNETEN SYMBOL BE/
8938 E51,TEXT /51 SYMBOL := FEHLT (LEERZEICHEN ZWISCHEN : UND = UNZULAESSI/
8941 E52,TEXT /52 DAS WORTSYMBOL 'THEN' FEHLT./
8942 E53,TEXT /53 DAS WORTSYMBOL 'UNTIL' FEHLT./
8943 E54,TEXT /54 DAS WORTSYMBOL 'DO' FEHLT./
8944 E55,TEXT /55 DAS WORTSYMBOL 'TO' ODER 'DOWNTO' FEHLT./
8945 E56,TEXT /56 DAS WORTSYMBOL 'BEGIN' FEHLT./
8946 E57,TEXT /57 DAS WORTSYMBOL 'END' FEHLT./
8947 E58,TEXT /58 EIN FAKTOR MUSS MIT NAME, KONSTANTE, 'NOT' ODER LINKSKLA/
8949 TEXT /MMER BEGINNEN./
8952 \f/R U N T I M E E R R O R S (ALWAYS FATAL!)
8955 /-------- D I S P L A Y --------/
8957 /---------------------------------/
8962 DCA PTPRINT /SWITCH TO TERMINAL OUTPUT!
9000 HLTLIST,-ERROR0-1; HLT0
9010 HLT0, TEXT /DIVISION BY 0 /
9011 HLT1, TEXT /UNDERFLOW /
9012 HLT2, TEXT /OVERFLOW/
9015 HLTA, TEXT /MEMORY FULL /
9020 HLTAT, TEXT / ERROR AT /
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
9029 SNA CLA /IF INPUT FILE SPECIFIED
9031 TAD IIDEVH /THEN SETUP FILE INPUT
9043 INITKB, TAD (XREAD /ELSE KEYBOARD INPUT
9048 SNA CLA /IF OUTPUT FILE SPECIFIED
9050 TAD (I37 /THEN SETUP FILE OUTPUT
9054 INITPR, TAD (XPRINT /ELSE USE PRINTER
9057 DCA I (PTHALT /ACTIVATE RUNTIME ERRORS
9058 INITDH, CDF 60 /TRANSFER DEVICE HANDLER(S)
9059 TAD I F6T0 /AND RUNTIME ERROR ROUTINE
9060 CDF 0 /TO THEIR PLACE IN FIELD 0
9065 INITST, TAD (CDF CIF 0 /CHANGE STARTING ADDRESS
9066 DCA I (7744 /TO START OF INTERPRETER
9069 DCA I (7746 /CORRECT JOB STATUS WORD
9070 CDF 10 /(MAKE IT RESTARTABLE)
9072 AND (20 /CHECK /H - OPTION
9075 JMP I (7600 /RETURN TO OS8 MONITOR
9076 JMP I (ISTART /START INTERPRETER
projects / pdp8.git / blob