File: PASCAL.PA of Tape: Various/Decus/decus-3
(Source file text)
/ ############ ######### #########
/ ############ ######### #########
/ ### ### ### ### ### ###
/ ### ### ### ### ### ###
/ ### ### ### ### ###
/ ### ### ### ### ###
/ ############ ############### #########
/ ############ ############### #########
/ ### ### ### ###
/ ### ### ### ###
/ ### ### ### ### ###
/ ### ### ### ### ###
/ ### ### ### #########
/ ### ### ### #########
/
/
/ ######### ######### ###
/ ######### ######### ###
/ ### ### ### ### ###
/ ### ### ### ### ###
/ ### ### ### ###
/ ### ### ### ###
/ ### ############### ###
/ ### ############### ###
/ ### ### ### ###
/ ### ### ### ###
/ ### ### ### ### ###
/ ### ### ### ### ###
/ ######### ### ### ###############
/ ######### ### ### ###############
/
/
/ #########
/ #########
/ ### ###
/ ### ###
/ ###
/ ###
/ ######### ######### FROM N.WIRTH
/ ######### ######### ETH - ZUERICH
/ ###
/ ###
/ ### ###
/ ### ###
/ #########
/ #########
/
/
/IMPLEMENTED ON A PDP-8/E COMPUTER WITH 28K-WORDS OF MEMORY
/BY
/PROF. HEINZ STEGBAUER
/HTL-MOEDLING, IN 1979
EJECT P A S C A L - S
VERSION=2
/C O R E L A Y O U T :
/FIELD 0 0000 - 5777 INTERPRETER
/ 6000 - 6777 FILE- AND DEVICE BUFFERS
/ 7000 - 7577 COMPILER (INSYMBOL, NEXTCH)
/ 7600 - 7777 OS/8 - RESIDENT PART
/FIELD 1 0000 - 7577 INTERMEDIATE CODE
/ 7600 - 7777 OS/8 - RESIDENT PART
/FIELD 2 0000 - 3777 SYMBOL-TABLE
/ 4000 - XXXX STRING-TABLE
/ XXXX - 6377 CONSTANT-TABLE
/ 6400 - 7377 ARRAY-TABLE
/ 7400 - 7777 BLOCK-TABLE
/AT COMPILETIME:
/FIELD 3 0000 - 3777 NAMES OF SYMBOL-TABLE
/ 4000 - 7177 FSYS, SET-CONSTANTS, LISTS AND
/ TABLES, ERROR ROUTINES
/FIELD 4 0000 - 6377 COMPILER
/ 6400 - 7777 AUXILIARY ROUTINES
/FIELD 5 0000 - 7777 STACK FOR COMPILER OPERATION
/FIELD 6 0000 - 7777 LONG ERROR MESSAGES
/AT RUNTIME:
/FIELD 3 0000 - 7777 /S T A C K (4K WORDS OF 48 BITS)
/FIELD 4 0000 - 7777
/FIELD 5 0000 - 7777
/FIELD 6 0000 - 7777
CODEFIELD=10
TABLEFIELD=20
NAMEFIELD=30
SETFIELD=30
COMPFIELD=40
PUSHFIELD=50
ERRFIELD=60
STACKFIELD=30
/S T R U C T U R E O F T A B L E S :
/SYMBOL-TABLE (4 WORDS PER ENTRY, MAX. 512 ENTRIES)
/------------
TAB=0000
LINK=TAB /WORD 0, BITS 0-11
OBJ=TAB+1 /WORD 1, BITS 0-5
TYP=TAB+1 /WORD 1, BITS 6-11
REF=TAB+2 /WORD 2, BITS 0-5
NORMAL=TAB+2 /WORD 2, BIT 6
LEV=TAB+2 /WORD 2, BITS 7-11
ADR=TAB+3 /WORD 3, BITS 0-11
/STRING-TABLE (ARRAY[0:N] OF CHAR, 6 BITS/CHAR,FROM 4000 UPWARDS)
/------------
/CONSTANT-TABLE (4 WORDS PER ENTRY, FROM 6400 DOWNWARDS)
/--------------
/ARRAY-TABLE (8 WORDS PER ENTRY, MAX. 64 ENTRIES)
/-----------
ATAB=6400
/ /WORD 0 UNUSED!
INXTYP=ATAB+1 /WORD 1
ELTYP=ATAB+2 /WORD 2
ELREF=ATAB+3 /WORD 3
LOW=ATAB+4 /WORD 4
HIGH=ATAB+5 /WORD 5
ELSIZE=ATAB+6 /WORD 6
SIZE=ATAB+7 /WORD 7
/BLOCK-TABLE (4 WORDS PER ENTRY, MAX. 64 ENTRIES)
/-----------
BTAB=7400
LAST=BTAB /WORD 0
LASTPAR=BTAB+1 /WORD 1
PSIZE=BTAB+2 /WORD 2
VSIZE=BTAB+3 /WORD 3
/A S S E M B L E R D E F I N I T I O N S:
L0001=CLA CLL IAC
L0002=CLA STL RTL
L0003=CLA STL IAC RAL
L0004=CLA CLL IAC RTL
L0006=CLA STL IAC RTL
L0100=CLA CLL IAC BSW
L2000=CLA STL RTR
L4000=CLA STL RAR
L7777=CLA CLL CMA
L7776=CLA CLL CMA RAL
L7775=CLA CLL CMA RTL
L3777=CLA CLL CMA RAR
L5777=CLA CLL CMA RTR
/A R I T H M E T I C D E F I N I T I O N S:
/MEMORY REFERENCED INSTRUCTIONS:
FIXMRI GET=0000
FIXMRI ADD=1000
FIXMRI SUB=2000
FIXMRI MUL=3000
FIXMRI DIV=4000
FIXMRI MOD=5000 /ALSO: JMP=5000
FIXMRI PUT=6000
/OPERATE CLASS INSTRUCTIONS:
NORM=7200 /REAL
READREAL=7201
WRITEREAL=7202
TRUNC=7203
ROUND=7206
RSQUARE=7205
ZERO=7204 /BOTH TYPES
ABSVAL=7000
NEGATE=7004
WRITELINE=7006
READINTEGER=7001 /INTEGER
WRITEINTEGER=7002
FLOAT=7003
ISQUARE=7005
/SKIP - INSTRUCTIONS:
SKIP=SKP
SKEQ=SZA
SKNE=SNA
SKLT=SMA
SKLE=SMA SZA
SKGT=SPA SNA
SKGE=SPA
AAAAAA=JMS I 44 /ENTER MACRO MODE
EEEEEE=0000 /RETURN TO PDP8 MODE
INT=0177
REAL=7777
/C O M P I L E R D E F I N I T I O N S:
DECIMAL
/S Y M B O L S:
INTCON=0
REALCON=1
CHARCON=2
STRING=3
NOTSY=4
PLUS=5
MINUS=6
TIMES=7
IDIVSY=8
RDIVSY=9
IMODSY=10
ANDSY=11
ORSY=12
EQL=13
NEQ=14
GTR=15
GEQ=16
LSS=17
LEQ=18
LPARENT=19
RPARENT=20
LBRACK=21
RBRACK=22
COMMA=23
SEMICOLON=24
PERIOD=25
COLON=26
BECOMES=27
CONSTSY=28
TYPESY=29
VARSY=30
FUNCTIONSY=31
PROCEDURESY=32
ARRAYSY=33
RECRDSY=34
PROGRAMSY=35
IDENT=36
BEGINSY=37
IFSYM=38
CASESY=39
REPTSY=40
WHILSY=41
FORSY=42
ENDSY=43
ELSESY=44
UNTILSY=45
OFSY=46
DOSY=47
TOSY=48
DOWNTOSY=49
THENSY=50
/O B J E C T S:
KONSTANT=0
VARIABLE=1
TYPE1=2
PROZEDURE=3
FUNKTION=4
/T Y P E S:
NOTYP=0
INTS=1
REALS=2
BOOLS=3
CHARS=4
ARRAY=5
RECORD=6
/P R O C E D U R E S:
BLOCK=0
STATEMENT=1
ASSIGNMENT=2
COMPOUNDSTATEMENT=3
IFSTATEMENT=4
CASESTATEMENT=5
REPEATSTATEMENT=6
WHILESTATEMENT=7
FORSTATEMENT=8
STANDPROC=9
SELECTOR=10
CALL=11
STANDFCT=12
FACTOR=13
TERM=14
SIMPLEEXPRESSION=15
EXPRESSION=16
CONDECLARE=17
TYPDECLARE=18
VARDECLARE=19
PRODECLARE=20
CONSTANT=21
ARRAYTYP=22
TYPE=23
PARAMETERLIST=24
ONECASE=25
/P R O G R A M P A R A M E T E R S:
TMAX=512 /MAX. NUMBER OF IDENTIFIERS
AMAX=64 /MAX. NUMBER OF ARRAYS
BMAX=64 /MAX. NUMBER OF BLOCKS (PROCEDURES+RECORDS)
CMAX=1980 /MAX. SIZE OF INTERMEDIATE CODE
CSMAX=30 /MAX. NUMBER OF CASES
LMAX=16 /MAX. NUMBER OF LEVELS
LLNG=80 /MAX. LENGTH OF INPUT LINE
ALNG=8 /NO. OF SIGNIFICANT CHAR'S IN IDENTIFIERS
OCTAL
FIELD 0
/P A G E Z E R O :
*4
EOF, 0 /END OF FILE SWITCH (BOOLEAN)
EOLN, 1 /END OF LINE SWITCH ( - " - )
CC, 0 /CHARACTER-COUNTER
ERRSW, 0 /ERROR IN LINE SWITCH
*10
XR10, 0 /ONE AUTOINDEX REGISTER
*20
PC, 0 /P R O G R A M - C O U N T E R
/I N S T R U C T I O N - R E G I S T E R
IRF, 0 /OP-CODE
IRX, 0 /LEVEL
IRY, 0 /ADDRESS OR VALUE
/S T A C K - P O I N T E R S
B, 0 /BASE INDEX
T, 0 /STACK POINTER (SIMPLE INDEX)
T3, 0 /= 4*T + 3 (ADDRESS OF WORD 3)
T3T, 0 /T3 FOR ROUTINE 'TOSTACK'
LOOK, 240 /NEXT CHARACTER (LOOK AHEAD)
/----------- PAGE 0 LOC'S OF ARITHMETIC PACKAGE ----------------
*32
BCD, 0 /BINARY CODED DECIMAL DIGIT
CHAR, 240 /CURRENT CHARACTER
M, 22 /OUTPUT FORMAT PARAMETERS
N, 0 /(DEFAULT VALUES: M=18, N=0)
ACX, 0 / A C - R E G I S T E R
ACS, 0
AC0, 0
AC1, 0
AC2, 0
AC3, 0
INTERPC /POINTER TO MACRO-INTERPRETER
MQ1, 0 / M Q - R E G I S T E R
MQ2, 0
MQ3, 0
OP0, 0 / O P - R E G I S T E R
OP1, 0
OP2, 0
OP3, 0
OPX, 0
OPS, 0
MIN4, -4 /-4 (COUNTING WORDS)
MIN44, -44 /-36 (COUNTING BITS)
OS8, 7600
H1, 0 /4 GENERAL TEMPORARIES
H2, 0
H3, 0
H4, 0
/NEW INSTRUCTIONS USED ALSO BY ARITHMETIC PACKAGE:
HALVE=JMS I . /AC:=AC DIV 2 (SHIFT RIGHT)
RACR
DOUBLE=JMS I . /AC:=2*AC (SHIFT LEFT)
RACL
CLEAR=JMS I . /AC := 0
CLAC
LOAD=CLEAR /AC := CONTENTS OF ACCUMULATOR (12 BIT INT.)
READC=JMS I . /GET NEXT CHAR FROM INPUT DEVICE
PTREAD, XNEXTCH /XREAD AT RUNTIME
PRINTC=JMS I . /SEND CHAR TO OUTPUT DEVICE
PTPRINT,XPRINT
ZPRINT, XPRINT /CONSTANT POINTER TO XPRINT
CRLF=JMS I .
XCRLF
SNALF=JMS I . /SKIP ON NOT ALFABETIC CHAR. (LETTER)
XSNALF
SKDIG=JMS I . /SKIP ON DIGIT
XSKDIG
BREAK=JMS I . /CHECK FOR CTRL-C
XBREAK
HALT=JMS I . /RUN-TIME ERROR HANDLING
PTHALT, ERR21 /XHALT AT RUNTIME
/---------------------------------------------------------------
/MACRO INSTRUCTIONS USED BY INTERPRETER:
*100
ERROR=JMS I . /NON FATAL COMPILER ERRORS
ZERROR
FATAL=JMS I . /FATAL COMPILER ERRORS
ZFATAL
OFTAB=JMS I . /GET INFO FROM SYMBOL-TABLE
ZOFTAB
OFATAB=JMS I . /GET INFO FROM ARRAY-TABLE
ZOFATAB
OFBTAB=JMS I . /GET INFO FROM BLOCK-TABLE
ZOFTAB
OFDISPLAY=JMS I . /GET INFO FROM DISPLAY
ZOFDISP
TODISPLAY=JMS I . /PUT INFO INTO DISPLAY
ZTODISP
GETCONST=JMS I . /GET CONSTANT
ZOFCONST
CONTINUE=JMP I .
ILOOP
BUMP=JMS I . /MOVE STACK POINTER
XBUMP
SDF=JMS . /CHANGE TO TOP OF STACK - DATA FIELD
0
XSDF, CDF /VARIABLE!
JMP I .-2
POPONE=JMS I . /POP ONE WORD (WORD 3 INTO AC)
XPOPONE
POPVAL=JMS I . /POP FOUR WORDS
XPOPVAL
POPNUM=JMS I . /POP NUMBER (=POP 4 WORDS AND UNPACK)
XPOPNUM
PUSHONE=JMS I . /PUSH ONE WORD
XPUSHONE
PUSHVAL=JMS I . /PUSH FOUR WORDS
XPUSHVAL
PUSHNUM=JMS I . /PUSH NUMBER (= PACK + PUSHVAL
XPUSHNUM
TOSTACK=JMS I . /INSERT ONE WORD INTO STACK[T3T]
XTOSTACK
OFCODE=JMS I . /GET INTERMEDIATE INSTRUCTION
XOFCODE
/LOCATIONS USED BY I/O-FILE HANDLING:
IBUFFER=6000 /INPUT FILE BUFFER
OBUFFER=7000 /OUTPUT FILE BUFFER
IDEVBUF=6400 /PAGE OF INPUT DEVICE HANDLER
ODEVBUF=6600 /PAGE OF OUTPUT DEVICE HANDLER
IDEVH, 0 /ENTRY POINT OF INPUT DEVICE HANDLER
ODEVH, 0 /ENTRY POINT OF OUTPUT DEVICE HANDLER
NAME, ZBLOCK 4 /NAME OF OUTPUT FILE
DEVNO, 0 /OUTPUT DEVICE NUMBER
LEMPTY, 0 / -LENGTH OF EMPTY
MBLOCKS,0 /COUNTING WRITTEN BLOCKS
OBP, OBUFFER /BUFFER POINTER (SEE PUTC)
OC3, -3 /3-CHARACTER SWITCH (SEE PUTC)
I37, DCA CHAR /HALT PROGRAM - CLOSE OUTPUT FILE
TAD [232 /WRITE EOF-MARK
PRINTC /FILL REST OF BUFFER WITH ZEROES
TAD [OBUFFER
CIA
TAD OBP
SZA CLA
JMP .-5
L7777 /COMPUTE ACTUAL LENGTH
TAD LEMPTY /OF OUTPUT FILE
CIA
TAD MBLOCKS
DCA ALOF
CIF 10
TAD DEVNO
JMS I [7700 /CALL USR TO CLOSE OUTPUT FILE
4
NAME
ALOF, 0
ERRORD, HALT
JMP I OS8 /RETURN TO KEYBOARD MONITOR
/INSTRUCTION DECODER AND DISPATCH ROUTINE
*200
ISTART, CLA CLL /STARTING ADDRESS
DCA EOF
L0001
DCA EOLN
TAD [240
DCA CHAR
TAD [240
DCA LOOK
CLEAR
DCA T /INITIALIZE THE STACK:
BUMP
PUSHVAL /S[1].I := 0
BUMP
PUSHVAL /S[2].I := 0
BUMP
PUSHVAL /S[3].I := 0
BUMP
L0001
OFBTAB;LAST
DCA H4
TAD H4
PUSHONE /S[4].I := BTAB[1].LAST
DCA B /B := 0
L0001
DCA IRX
TODISPLAY /DISPLAY[1] := 0
L0002
OFBTAB;VSIZE
TAD MIN2
DCA T
BUMP /T := BTAB[2].VSIZE - 1
TAD H4
OFTAB;ADR
DCA PC /PC := TAB[ S[4].I ].ADR
ILOOP, BREAK
CLL /GET CURRENT INSTRUCTION
TAD PC
OFCODE
MQL
MQA
BSW
AND [77
DCA IRF
MQA
AND [77
DCA IRX
STL
TAD PC
OFCODE
DCA IRY
ISZ PC /PC := PC + 1
TAD JUMP
TAD IRF
DCA .+1
HLT /JUMP TO INSTRUCTION ROUTINE
JUMP, JMP I ILIST
MIN2, -2
/INSTRUCTIONS OF STACK COMPUTER - ADDRESS TABLE:
ILIST, I00 /LOAD ADDRESS
I01 /LOAD VALUE
I02 /LOAD INDIRECT
I03 /UPDATE DISPLAY
ZBLOCK 4 /CODES 4 - 7 UNUSED!
I08 /CALL STANDERD FUNCTION
I09 /OFFSET
I10 /JUMP
I11 /CONDITIONAL JUMP
I12 /SWITCH CASE
ILOOP /CODE 13 USED INTERNALLY!
I14 /FOR1UP
I15 /FOR2UP
I16 /FOR1DOWN
I17 /FOR2DOWN
I18 /MARK STACK
I19 /CALL
I20 /INDEX1
I21 /INDEX
I22 /LOAD BLOCK
I23 /COPY BLOCK
I24 /LITERAL
I25 /LOAD CONSTANT
I26 /FLOAT
I27 /READ
I28 /WRITE STRING
I29 /WRITE1 (DEFAULT FIELD WIDTH)
I30 /WRITE2 ( :M )
I31 /WRITE3 ( :M :N )
I32 /EXIT PROCEDURE
I33 /EXIT FUNCTION
I34 /LOAD ABSOLUTE
I35 /LOGICAL NOT
I36 /NEGATE
PTI37, 7600 /HALT (BECOMES I37 IF FILE I/O!)
I38 /STORE
ZBLOCK 11 /CODES 39 - 47 UNUSED!
I48 /ARITHMETIC OPERATIONS
I49 /COMPARE INTEGERS
I50 /COMPARE REALS
I51 /LOGICAL OR
I52 /LOGICAL AND
ZBLOCK 10 /CODES 53 - 60 UNUSED!
I61 /ASCII
I62 /READLN
I63 /WRITELN
/INSTRUCTIONS OF STACK COMPUTER (A)
I00, BUMP /LOAD ADDRESS
OFDISPLAY
TAD IRY
PUSHONE
CONTINUE
I01, BUMP /LOAD VALUE
OFDISPLAY
TAD IRY
POPVAL
PUSHVAL
CONTINUE
I02, BUMP /LOAD INDIRECT
OFDISPLAY
TAD IRY
POPONE
POPVAL
PUSHVAL
CONTINUE
I03, TAD IRX /UPDATE DISPLAY
CIA
TAD IRY
DCA H1
TAD B
DCA H3
UPDIS, TAD H3
TODISPLAY
L7777
TAD IRX
DCA IRX
L0002
TAD H3
POPONE
DCA H3
ISZ H1
JMP UPDIS
CONTINUE
I08, TAD IRY /CALL STANDARD FUNCTION
TAD (JMS I STDFUNCT
DCA .+2
POPNUM
STFJMS, JMS . / J M S TO REQUESTED FUNCTION
PUSHNUM
CONTINUE
STDFUNCT,XABS /0
XABS /1
XISQU /2
XRSQU /3
XODD /4
XCHR /5
STFJMS /6
XSUCC /7
XPRED /8
XROUND /9
RTRUNC /10
XSIN /11
XCOS /12
XEXP /13
XLOG /14
XSQRT /15
XATN /16
XEOF /17
XEOLN /18
XRAND /19
I09, POPONE /OFFSET
TAD IRY
PUSHONE
CONTINUE
I10, TAD IRY /JUMP
DCA PC
CONTINUE
I11, POPONE /CONDITIONAL JUMP
CLL RAR
TAD IRY
SNL
DCA PC
L7777
BUMP
CONTINUE
I12, POPVAL /SWITCH CASE
L4000
AND AC1
CLL RAL
TAD AC3
SZL
CIA
DCA H1
L7777
BUMP
SCASE, CLL
TAD IRY
OFCODE
TAD (-1500 /-1300
SZA CLA
ERRORC, HALT /C A S E E R R O R !
STL
TAD IRY
OFCODE
CIA
TAD H1
SNA CLA
JMP .+4
ISZ IRY
ISZ IRY /(INCREMENTS, DOESN'T SKIP!)
JMP SCASE
IAC STL
TAD IRY
OFCODE
DCA PC
CONTINUE
/I13 ... INTERNAL CODE (MARKS CASE SWITCH LIST)
XEOF, 0
TAD EOF
JMP .+3
XEOLN, 0
TAD EOLN
LOAD
BUMP
JMP STFJMS+1
XSUCC, 0
L0001
JMP XCHR+1
XPRED, 0
L7777
JMP XCHR+1
XCHR, 0
TAD AC3
AND [77
LOAD
JMP STFJMS+1
PAGE
/INSTRUCTIONS OF STACK COMPUTER (B+C)
I14, TAD UPSKIP /FOR1UP
SKP
I16, TAD DOSKIP /FOR1DOWN
DCA FORUD1
L7777 /COMMON ROUTINE:
TAD T
POPNUM
AAAAAAAAAAAAAAAA
PUT INT&FORH1
EEEEEEEEEEEEEEEE
POPNUM
AAAAAAAAAAAAAAAA
SUB INT&FORH1
FORUD1, SKGE /OR SKLE
JMP FOR1EX
GET INT&FORH1
EEEEEEEEEEEEEEEE
L7776
TAD T
POPONE
PUSHNUM
CONTINUE
FOR1EX, EEEEEEEEEEEEEEEE
TAD IRY
DCA PC
L7775
BUMP
CONTINUE
/NOTE THE STACK SITUATION:
/
/ S[ T ] ... FINAL VALUE
/ S[T-1] ... INITIAL VALUE
/ S[T-2] ... ADDRESS OF CONTROL VARIABLE
I15, TAD UPADD /FOR2UP
DCA FORUD2
TAD UPSKIP
JMP .+4
I17, TAD DOSUB /FOR2DOWN
DCA FORUD2
TAD DOSKIP
DCA FORUD3
L7776 /COMMON ROUTINE:
TAD T
POPONE
DCA H2
TAD H2
POPNUM
AAAAAAAAAAAAAAAA
FORUD2, ADD INT&ONE /OR SUB INT&ONE
PUT INT&FORH1
EEEEEEEEEEEEEEEE
POPNUM
AAAAAAAAAAAAAAAA
SUB INT&FORH1
FORUD3, SKGE /OR SKLE
JMP FOR2EX
GET INT&FORH1
EEEEEEEEEEEEEEEE
TAD H2
PUSHNUM
TAD IRY
DCA PC
CONTINUE
FOR2EX, EEEEEEEEEEEEEEEE
L7775
BUMP
CONTINUE
UPSKIP, SKGE
DOSKIP, SKLE
UPADD, ADD INT&ONE
DOSUB, SUB INT&ONE
ONE, 0;0;0;1
FORH1, ZBLOCK 4
MINUS1, -1
BYTE, 77
LEVBITS,17
I18, L0004 /MARK STACK
BUMP
TAD IRY
OFTAB;REF
BSW
AND BYTE
OFTAB;VSIZE
TAD MINUS1
PUSHONE
BUMP
TAD IRY
PUSHONE
CONTINUE
I19, TAD IRY /CALL
CIA
TAD T
DCA H1
L0004
TAD H1
POPONE
DCA H2
TAD H2
OFTAB;LEV
AND LEVBITS
DCA H3
L0001
TAD H3
DCA IRX
TAD H1
TODISPLAY
L0003
TAD H1
POPONE
TAD H1
DCA H4
L0001
TAD H1
DCA T3T
TAD PC
TOSTACK
ISZ T3T
TAD H3
DCA IRX
OFDISPLAY
TOSTACK
ISZ T3T
TAD B
TOSTACK
/-------------------- FALL THROUGH PAGE BOUNDARY -------------
CLEAR
TAD T
CMA CLL
TAD H4
SNL CLA
JMP .+4
BUMP
PUSHVAL
JMP .-7
TAD H1
DCA B
TAD H2
OFTAB;ADR
DCA PC
CONTINUE
I20, TAD (NOP /INDEX1
SKP
I21, TAD (JMS MULTY /INDEX
DCA INDEX1
TAD IRY /COMMON ROUTINE:
OFATAB;HIGH
CMA
DCA H1
TAD IRY
OFATAB;LOW
TAD H1
CIA
DCA H2
POPVAL
L4000
AND AC1
CLL RAL
TAD AC3
SZL
CIA
TAD H1
CLL
TAD H2
DCA RELADR
SNL
ERRORB, HALT /INDEX OUT OF BOUNDS!
INDEX1, NOP /OR JMS MULTY
L7777
BUMP
POPONE
TAD RELADR
PUSHONE
CONTINUE
RELADR=H4
MULTY, 0
TAD IRY
OFATAB;ELSIZE
CLL RAR
MQL
TAD (-14 /-12 (BITS)
DCA H3
MBIT, SNL
JMP .+3
CLL
TAD RELADR
RAR
SWP
RAR
SWP
ISZ H3
JMP MBIT
SWP
DCA RELADR
JMP I MULTY
I22, POPONE /LOAD BLOCK
DCA H1
L7777
BUMP
TAD IRY
CMA
DCA H2
JMP .+6
BUMP
TAD H1
POPVAL
PUSHVAL
ISZ H1
ISZ H2
JMP .-6
CONTINUE
I23, L7777 /COPY BLOCK
TAD T
POPONE
DCA H1
POPONE
DCA H2
TAD IRY
CMA
DCA H3
JMP .+7
TAD H2
POPVAL
TAD H1
PUSHVAL
ISZ H1
ISZ H2
ISZ H3
JMP .-7
L7776
BUMP
CONTINUE
I24, BUMP /LITERAL (ADDRESSES ONLY!)
TAD IRY
LOAD
PUSHVAL
CONTINUE
I25, BUMP /LOAD CONSTANT
TAD IRY
GETCONSTANT
PUSHVAL
CONTINUE
I61, POPONE /WRITE SPECIAL ASCII
PRINTC
L7777
BUMP
CONTINUE
PAGE
/INSTRUCTIONS OF STACK COMPUTER (D)
I26, TAD IRY /FLOAT
CIA
TAD T
DCA H1
TAD H1
POPNUM
JMS IFLOAT
TAD H1
PUSHNUM
CONTINUE
I27, TAD (JMS I READX-1 /READ
TAD IRY
DCA .+1
JMS I READX
POPONE
PUSHNUM
JMP EXI27
READX, IINP
RINP
NOP
CINP
I28, POPONE /WRITE STRING
DCA M
L7777
BUMP
POPONE
CIA
DCA N
TAD IRY
CDF TABLEFIELD
JMS WSTRING
JMP EXI27
I29, TAD (TAD DFW-1 /WRITE (STANDARD FIELD WIDTH)
TAD IRY
DCA .+1
TAD DFW
DCA M
JMP WRGO
I30, POPONE /WRITE (SPECIFIED FIELD WIDTH)
DCA M
L7777
BUMP
WRGO, POPNUM
L7777
BUMP
DCA N
TAD (JMS I WRITEX-1
TAD IRY
DCA .+1
JMS I WRITEX
CONTINUE
WRITEX, IOUT
ROUT
BOUT
COUT
DFW, 12
22
12
1
I31, POPONE /WRITE ( X :M :N )
DCA N
L7777
BUMP
POPONE
DCA M
L7777
BUMP
POPNUM
JMS I WRITEX+1 /REAL ONLY!
EXI27, L7777
BUMP
CONTINUE
I32, L7776 /EXIT PROCEDURE
SKP
I33, L7777 /EXIT FUNCTION
TAD B
DCA T
BUMP
L0001
TAD B
POPONE
DCA PC
L0003
TAD B
POPONE
DCA B
CONTINUE
I34, POPONE /LOAD (ABSOLUTE)
POPVAL
PUSHVAL
CONTINUE
I35, POPONE /LOGICAL NOT
CLL RAR
CML
RAL
PUSHONE
CONTINUE
I36, POPNUM /NEGATE
JMS XNEG
PUSHNUM
CONTINUE
I38, POPVAL /STORE
L7777
BUMP
POPONE
PUSHVAL
L7777
BUMP
CONTINUE
/I39 - I47 U N U S E D !
/B O O L E A N O U T P U T
BOUT, 0
TAD AC3
TAD (-5
DCA N
TAD AC3
SNA CLA
L0004
TAD (TRUEFALSE^2
JMS WSTRING
JMP I BOUT
PAGE
/INSTRUCTIONS OF STACK COMPUTER (E)
I48, POPNUM /ARITHMETIC:
JMS ENTR /INTEGER:
L7777 / + 48,1
BUMP / - 48,2
POPNUM / * 48,3
TAD (MRITABL / DIV 48,4
TAD IRY / MOD 48,5
DCA H1
TAD I H1 /REAL:
DCA H1 / + 48,10
JMS I H1 / - 48,11
PUSHNUM / * 48,12
CONTINUE / / 48,13
I49, TAD (ISUB-RSUB /COMPARE (INTEGER)
I50, TAD (RSUB /COMPARE (REAL)
DCA H1 / = 50,7440
POPNUM / <> 50,7450
JMS ENTR / < 50,7500
L7777 / <= 50,7540
BUMP / > 50,7550
POPNUM / >= 50,7510
JMS I H1 /SUBTRACT
TAD IRY
JMS BOOL
LOAD
PUSHVAL
CONTINUE
I51, POPONE /LOGICAL OR
DCA H1
L7777
BUMP
SDF
TAD H1
CMA
AND I T3
TAD H1
DCA I T3
CDF
CONTINUE
I52, POPONE /LOGICAL AND
DCA H1
L7777
BUMP
SDF
TAD H1
AND I T3
DCA I T3
CDF
CONTINUE
/I53 - I61 U N U S E D !
READC
I62, TAD EOLN /READLN
SNA CLA
JMP .-3
READC
CONTINUE
I63, CRLF /WRITELN
CONTINUE
/AUXILIARY ROUTINES FOR 'WRITE STRING' AND 'BOOLEAN OUTPUT'
WSTRING,0
DCA H1
RDF
TAD CCDF0
DCA STRFLD
CCDF0, CDF 0
TAD M
SNA
JMP NCHAR
TAD N /M-N
SPA SNA
JMP PARTLY
CIA
DCA H2
TAD [240
PRINTC
ISZ H2
JMP .-3
JMP NCHAR
PARTLY, CIA / N-M
TAD N /-N
DCA N /= -M
NCHAR, TAD H1
STL RAR /STRING TABLE STARTS AT 4000!
DCA H2
STRFLD, CDF TABLEFIELD
TAD I H2
CDF 0
SNL
BSW
JMS ASCII
ISZ H1
ISZ N
JMP NCHAR
JMP I WSTRING
ASCII, 0
AND [77
TAD [240
AND [77
TAD [240
PRINTC
JMP I ASCII
/C H A R A C T E R I N P U T AND O U T P U T
CINP, 0
READC
TAD CHAR
AND [77
LOAD
JMP I CINP
COUT, 0
TAD M
SPA SNA
L0001
CIA
DCA H2
JMP .+3
TAD [240
PRINTC
ISZ H2
JMP .-3
TAD AC3
JMS ASCII
JMP I COUT
PAGE
/STACK INSTRUCTIONS
XBUMP, 0
SNA /IF (AC)=0
L0001 /THEN T:=T+1
CLL /ELSE T:=T+(AC)
SPA
CML
TAD T
DCA T
SZL
ERRORA, HALT /S T A C K O V E R F L O W !
TAD T
CLL RAR
BSW
AND (70
TAD (CDF STACKFIELD
DCA XSDF /SETUP CHANGE TO STACK FIELD INSTR.
TAD T /AND BUILD
STL RAL
STL RAL
DCA T3 /ADDRESS OF TOP ENTRY (LS WORD)
JMP I XBUMP
ST3,
ADDRESS,0 /COMPUTE FULL ADDRESS
MQL /OF STACK LOCATION
MQA /AND CHANGE DATA FIELD
CLL RAR
BSW
AND (70
TAD (CDF STACKFIELD
DCA STCDF
MQA
STL RAL
STL RAL
STCDF, CDF STACKFIELD
JMP I ADDRESS
PACK, 0 /PACK REAL OR INTEGER NUMBER
TAD ACX /INTO AC0-4 (FOR PUSHING)
DCA AC0
TAD ACS
TAD AC1
DCA AC1
JMP I PACK
UNPACK, 0 /UNPACK POPPED NUMBER
L4000 /(EXTRACT SIGN, EXPONENT)
AND AC1
DCA ACS
L3777
AND AC1
DCA AC1
TAD AC0
DCA ACX
DCA AC0
JMP I UNPACK
XPOPONE,0
SNA
JMP TOPONE
JMS ADDRESS
DCA ST3
TAD I ST3
CDF
JMP I XPOPONE
TOPONE, SDF
TAD I T3
CDF
JMP I XPOPONE
XPUSHONE,0
SDF
DCA I T3
CDF
JMP I XPUSHONE
XPOPVAL,0
SNA
JMP TOPVAL
JMS ADDRESS
TAD MIN4
DCA XR10
TAD I XR10
DCA AC0
TAD I XR10
DCA AC1
TAD I XR10
DCA AC2
TAD I XR10
DCA AC3
CDF
JMP I XPOPVAL
TOPVAL, TAD T3
SDF
JMP XPOPVAL+4
XPUSHVAL,0
SNA
JMP ONTOP
JMS ADDRESS
TAD MIN4
DCA XR10
TAD AC0
DCA I XR10
TAD AC1
DCA I XR10
TAD AC2
DCA I XR10
TAD AC3
DCA I XR10
CDF
JMP I XPUSHVAL
ONTOP, TAD T3
SDF
JMP XPUSHVAL+4
XPOPNUM,0
JMS XPOPVAL
JMS UNPACK
JMP I XPOPNUM
XPUSHNUM,0
MQL
JMS PACK
MQA
JMS XPUSHVAL
JMP I XPUSHNUM
XTOSTACK,0
DCA PACK /TEMP. SAVE VALUE
TAD T3T
JMS ADDRESS
DCA ST3
TAD PACK
DCA I ST3
CDF
JMP I XTOSTACK
PAGE
/TABLE INSTRUCTIONS
ZOFTAB, / AC := TAB[ AC ].REF
ZOFBTAB,0 / AC := BTAB[ AC ].REF
CLL RTL
TAD I ZOFTAB /SELECTOR FOLLOWS CALL
DCA LOC
ISZ ZOFTAB
CDF TABLEFIELD
TAD I LOC
CDF
JMP I ZOFTAB
ZOFATAB,0 / AC := ATAB[ AC ].REF
CLL RAL
CLL RTL
TAD I ZOFATAB /SELECTOR FOLLOWS CALL
DCA LOC
ISZ ZOFATAB
CDF TABLEFIELD
TAD I LOC
CDF
JMP I ZOFATAB
ZOFDISP,0 / AC := DISPLAY[ IRX ]
TAD (DISPLAY
TAD IRX
DCA LOC
TAD I LOC
JMP I ZOFDISP
ZTODISP,0 / DISPLAY[ IRX ] := AC
MQL
TAD (DISPLAY
TAD IRX
DCA LOC
MQA
DCA I LOC
JMP I ZTODISP
XOFCODE,0 / AC := CODE[ AC.LINK ]
RAL /LINK=0 ... 1ST WORD
DCA LOC /LINK=1 ... 2ND WORD
CDF CODEFIELD
TAD I LOC
CDF
JMP I XOFCODE
LOC, 0 /ADDRESS OF TABLE LOCATION
ZOFCONST,0 /ENTER WITH ADDRESS-1 IN AC
DCA XR10
CDF TABLEFIELD
TAD I XR10
DCA AC0
TAD I XR10
DCA AC1
TAD I XR10
DCA AC2
TAD I XR10
DCA AC3
CDF
JMP I ZOFCONST
/PREDEFINED R A N D O M - NUMBER GENERATOR
XRAND, 0
TAD DISMOV /DISABLE INTEGER-
DCA INTMOV /MULTIPLY-OVERFLOW
AAAAAAAAAAAAAAAA
GET INT&RN
MUL INT&ALFA /MOD 2^35 !
PUT INT&RN
NORM /0 < RANDOM: REAL < 1
EEEEEEEEEEEEEEEE
TAD ENAMOV /REENABLE
DCA INTMOV
BUMP
JMP I XRAND
DISMOV, DCA AC0
ENAMOV, JMSSNAC
RN, 0000;3777;7777;7775 /2^35 - 3 (INTEGER)
ALFA, 0000;0000;0100;0003 /2^18 + 3 (INTEGER)
XODD, 0
L0001
AND AC3
LOAD
JMP I XODD
XSKDIG, 0 /SKIP ON DIGIT
TAD CHAR
TAD (-"9-1
CLL
TAD ("9+1-"0
DCA BCD
SZL CLA
ISZ XSKDIG
JMP I XSKDIG
XPRINT, 0 /INTERNAL PRINTER HANDLER
SNA
TAD CHAR
TLS
TSF
JMP .-1
TAD [-215
SZA CLA
JMP I XPRINT
TAD [212
JMP XPRINT+3
SPRINT, 0 /SILENT PRINTER
CLA CLL
JMP I SPRINT
XCRLF, 0 /CARRIAGE RETURN & LINE FEED
TAD [215
PRINTC
JMP I XCRLF
XBREAK, 0 /CHECK ^C AND ABORT
KSF
JMP I XBREAK
CLA
KRS
AND [177
TAD (-3
SZA CLA
JMP I XBREAK
JMP I OS8
PAGE
/ A R I T H M E T I C P A C K A G E
INTERPC,0000 /PROGRAM COUNTER FOR MACRO-INSTRUCTIONS
CPAGE, 7600
SZA CLA
NEXTINSTR, ISZ INTERPC /POINT TO NEXT INSTRUCTION
TAD I INTERPC /GET CODE
SNA /IF CODE=0000
JMP I INTERPC /THEN RETURN TO PDP8-MODE
CLL RTL /ELSE SHIFT CODE NXXX
RTL
AND (7 /TO EXTRACT OPERATION CODE N
DCA OPCODE
TAD I INTERPC /GET CODE AGAIN,
AND (177 /MASK OUT REL.ADDRESS (OR FUNCTION CODE)
MQL
TAD CPAGE
C200, AND INTERPC /CURRENT PAGE BITS
MQA /+ RELATIVE ADDRESS
DCA OPADDR /= ABS. ADDRESS OF OPERAND (IF MRI)
SNL /IF D\I-BIT SET
JMP .+3
TAD I OPADDR /THEN DO INDIRECT ADDRESSING
DCA OPADDR
TAD OPCODE
TAD (-7
SNA CLA /IF CODE=7XXX
JMP OPRTYP /THEN OPERATE CLASS INSTRUCTION
MRITYP, TAD I OPADDR /ELSE MEMORY REFERENCED INSTR.:
DCA OPX /LOAD AND UNPACK OPERAND
ISZ OPADDR /INTO OP-REGISTER
L4000
AND I OPADDR
DCA OPS
L3777
AND I OPADDR
DCA OP1
ISZ OPADDR
TAD I OPADDR
DCA OP2
ISZ OPADDR
TAD I OPADDR
DCA OP3
TAD I INTERPC /GET INSTRUCTION CODE AGAIN,
AND C200 /CHECK INTEGER\REAL-BIT
SZA CLA /AND BUILD A
TAD (7
TAD OPCODE
TAD (JMS I MRITABL
DCA .+1
OPCODE, JMS . / J M S TO THE REQUESTED ROUTINE
JMP NEXTINSTR
OPADDR, 0
/TABLE OF INTEGER ARITHMETIC ROUTINES:
MRITABL,OGET
IADD
ISUB
IMUL
IDIV
IMOD
OPUT
/TABLE OF REAL ARITHMETIC ROUTINES:
OGET
RADD
RSUB
RMUL
RDIV
OJUMP
OPUT
OPRTYP, TAD I INTERPC /DECODE OPERATE INSTRUCTION
SNL /BIT3 IS IN LINK (COMPLEMENTED!)
JMP SKIPTYP /SKIP INSTR. CODES ARE 74XX, 75XX
BSW /OPERATE INSTR. CODES ARE:
RTR /7000 - 7006 (INTEGER)
CLA MQA /7200 - 7206 (REAL)
AND (7 /EXTENDED FUNCTIONS: 70X7
RAL
TAD (JMS I OPRTABL
DCA .+3
TAD INTERPC /SAVE PC, SINCE OPR'S MAY CAUSE
DCA SAVEPC /RECURSIVE CALL OF INTERPRETER (1 LEVEL)
OPRJMS, JMS . / J M S TO APPROPRIATE ROUTINE
TAD SAVEPC /RESTORE PC
DCA INTERPC
JMP NEXTINSTR
SAVEPC, 0
NOOP=OPCODE
/TABLE OF OPERATE CLASS INSTRUCTIONS:
OPRTABL,XABS; RNORM
IINP; RINP
IOUT; ROUT
IFLOAT; RTRUNC
XNEG; CLAC
XISQU; XRSQU
XCRLF; XROUND
NOOP /LINK TO FUNCTION DISPATCH ROUTINE
IFDEF FUNCTS <
*.-1
FUNCTS /ENABLED ONLY IF FUNCTION PACKAGE PRESENT
>
SKIPTYP,JMS BOOL /ALL SKIP INSTR. (INT & REAL) DONE HERE
ISZ INTERPC /(SEE ROUTINE 'BOOL' FOR COMMENTS)
JMP NEXTINSTR-1
OJUMP, 0 /JUMP (WITHIN MACRO CODE!!!)
L7775
TAD OPADDR
DCA INTERPC
JMP NEXTINSTR+1
OPUT, 0 /STORE CONTENTS OF AC-REGISTER
L0004 /AT SPECIFIED MEMORY ADDRESS
CIA /-4 (OPADDR WAS MOVED AT MRITYP)
TAD OPADDR
DCA XR10
TAD ACX
DCA I XR10
TAD ACS
TAD AC1
DCA I XR10
TAD AC2
DCA I XR10
TAD AC3
DCA I XR10
JMP I OPUT
PAGE
/R E A L N U M B E R I N P U T
/
/ACCEPTS A DECIMAL NUMBER IN ANY FORMAT,
/CONVERTS IT TO INTERNAL BYNARY FLOATING POINT NOTATION
/AND LEAVES IT IN THE AC-REGISTER.
/LEADING BLANKS ARE IGNORED; THE FIRST
/NON ACCEPTABLE CHARACTER TERMINATES THE NUMBER.
DC=MQ2 /DIGIT COUNTER
OC=MQ3 /DIGIT EXCESS COUNTER
DP, 0 /DECIMAL POINT POSITION
RINP, RETNUM /RETURN ADDR. SINCE COMPILER ENTERS AT 'FRACTN'
SKP CLA
READC /PASS OVER LEADING BLANKS
TAD CHAR
TAD (-240
SNA CLA
JMP .-4
JMS PMXXX /PROCESS + - I N T E G E R PART
TAD OC /COUNT LOOSEN DIGITS (IF THE INTERNAL
CIA /REPRESENTATION EXCEEDS 35 BITS,
DCA DC /FURTHER DIGITS ARE IGNORED, BUT
TAD CHAR /THEIR CONTRIBUTION TO MAGNITUDE
TAD (-". /MUST BE CONSIDERED!)
SZA CLA /IF INTEGER FOLLOWED BY DECIMAL POINT
JMP .+3
READC
FRACTN, JMS BCONV /THEN PROCESS F R A C T I O N PART
TAD DC /COUNT DIGITS AFTER DEC. POINT
CIA
DCA DP /TO REMEMBER POSITION OF DEC. POINT
JMS IFLOAT /NORMALIZE THE NUMBER
TAD CHAR
TAD (-"E
SZA CLA /IF NEXT CHARACTER IS "E"
JMP ADJUST
AAAAAAAAAAAAAAAA
PUT NUMBUF /THEN STORE NUMBER TEMPORARELY
EEEEEEEEEEEEEEEE
READC
JMS PMXXX /AND PROCESS S C A L E - F A C T O R
TAD ACS
CLL RAL
TAD AC3 /GET IT FROM LOW ORDER WORD OF AC
SZL /IF NEGATIVE SIGN
CIA /THEN USE 2'S COMPLEMENT
TAD DP /ADD IT TO CURRENT POS. OF DEC. POINT
DCA DP
AAAAAAAAAAAAAAAA
GET NUMBUF /RECALL STORED MANTISSA
EEEEEEEEEEEEEEEE
ADJUST, TAD DP /NOW CONVERT DEC. FLOATING POINT TO
JMS SUP1 /TO BINARY FLOATING POINT NOTATION
JMP I RINP
PMXXX, 0 /SIGNED INTEGER INPUT & CONVERSION
CLEAR
DCA DC
DCA OC
TAD CHAR
TAD (-"+
SNA
JMP .+6
CLL RTR
SZA CLA
JMP .+4
L4000
DCA ACS
READC
JMS BCONV
JMP I PMXXX
BCONV, 0 /UNSIGNED DIGIT STRING INPUT & CONVERSION
SKDIG
JMP I BCONV
TAD AC0
SZA CLA
JMP OVER
CLL
JMS MUL10
TAD BCD
DCA OP3
DCA OP2
DCA OP1
JMS BADD
ISZ DC
SKP
OVER, ISZ OC
READC
JMP BCONV+1
/F L O A T AND T R U N C ROUTINES
DISPLC=.
IFLOAT, 0 /COMPENSATE
TAD (43 /35 BITS DISPLACEMENT OF BINARY POINT
DCA ACX /WITH EXPONENT
JMS RNORM /AND NORMALIZE
JMP I IFLOAT
RTRUNC, 0
CLA CLL
TAD ACX
SPA SNA /IF ABS(AC)<1 OR AC=0
JMP LESS0 /THEN TRUNC(AC):=0
TAD MIN44
DCA DISPLC /-(DISPLACEMENT OF BINARY POINT + 1)
SZL CLA /IF ABS(AC)>MAXINT
JMP ERROR2 /THEN O V E R F L O W
SKP
HALVE /ELSE ALIGN MANTISSA
ISZ DISPLC
JMP .-2
DCA ACX /EXP=0 FOR INTEGERS
JMP I RTRUNC
LESS0, CLA
CLEAR
JMP I RTRUNC
XROUND, 0
L2000
DCA OP1
DCA OP2
DCA OP3
DCA OPX /X>=0:
TAD ACS /ROUND(X) = TRUNC(X+0.5)
DCA OPS /X<0:
JMS RADD /ROUND(X) = TRUNC(X-0.5)
JMS RTRUNC
JMP I XROUND
PAGE
/R E A L N U M B E R O U T P U T
/
/PRINTS FLOATING POINT NUMBER X (CONTENTS OF AC-REGISTER)
/IN THE FORMAT SPECIFIED BY THE PARAMETERS M,N (PAGE 0)
/PERFORMS LIKE THE PASCAL-STATEMENT
/ W R I T E ( X :M :N )
/M /MINIMUM FIELD WIDTH
/N /FRACTION LENGTH
S=MQ1 /-NUMBER OF LEADING BLANKS
P=MQ2 /-NUMBER OF DIGITS PRECEDING THE DEC. POINT
F=MQ3 /-NUMBER OF DIGITS FOLLOWING THE DEC. POINT
ROUT, 0
JMS FLCONV /BINARY TO DECIMAL FLOATING POINT
JMS EXBCD /EXTRACT BCD-DIGITS OF MANTISSA
TAD N
SPA SNA /WHICH FORMAT REQUESTED?
JMP FLOPNT
FIXPNT, CIA / -99999.99999
DCA F /F:=-N
TAD DEXP
SPA /IF DEXP>0
CLA /THEN P:=-(DEXP+1)
CMA /ELSE P:=-1
DCA P
L7776 /S:=-(M-N-P-2)
TAD F
TAD P
TAD M
CIA
DCA S
TAD S
SMA CLA /IF S>=0 THEN USE FLOATING POINT FORMAT
JMP FLOPNT /(NUMBER TOO LARGE FOR FIXED POINT!)
L0002
TAD N /ROUNDUP WITH (N+DEXP+1)TH DIGIT
TAD DEXP
SPA SNA /IF NOT WITHIN THE 11 DIGITS, THEN
JMP .+3
TAD (-13 /ROUNDUP WITH 11TH DIGIT
SMA
CLA
TAD (13
JMS UROUND
JMP FIXPNT+2 /ROUNDED MANTISSA = 10, CHECK WIDTH!
TAD DEXP /BEGINNING AT DIGIT POS. NUMBUF+DEXP
SMA /OR NUMBUF IF NUMBER >= 1
CLA
JMS XOUT /DO THE FIXED POINT OUTPUT
JMP I ROUT
FLOPNT, L7777 / -9.999999999E+999
DCA P /P:=-1
TAD M
TAD (-12
SPA
CLA
TAD (12
DCA M /IF M<10 THEN M:=10
TAD (-11
DCA F /F:=-9
TAD M /S:=-(M-17)
TAD (-21
CIA
DCA S
TAD S
SPA CLA /IF S>=0 THEN
JMP .+7
L7777 /S:=-1
DCA S /F:=-(M-9)
TAD M
TAD (-11
CIA
DCA F
L7776
TAD F
CIA
JMS UROUND /ROUNDUP WITH (-F+1)TH DIGIT
STFW, 0022 /NOP (CARRY DOESN'T HARM!)
JMS XOUT /OUTPUT THE MANTISSA
TAD ("E
PRINTC /E
TAD DEXP
SPA CLA
L0002
TAD ("+
PRINTC /+ OR -
TAD DEXP
SPA
CIA /MAKE DEXP POSITIVE
JMS LDAC /LOAD IT IN AC-REGISTER (AS INTEGER)
L0003
DCA M /SETUP A FIELD WIDTH OF 3,
TAD ("0-240 /CHANGE LEADING BLANKS TO ZEROES
JMS IOUT /AND USE INTEGER OUTPUT ROUTINE
TAD STFW /TO PRINT THE CHARACTERISTIC.
DCA M /THEN RESET STANDARD FIELD WIDTH
JMP I ROUT
/BUFFER FOR BCD-DIGITS:
0 /IMPORTANT! (SEE ROUNDING)
NUMBUF, ZBLOCK 13
TEN, 0004 /REAL CONSTANT OF 10.0
2400
0000
0000
OPTEN, 7775 /REAL CONSTANT OF 0.1 (CURRENTLY NOT USED!)
3146
3146
3146
LDAC,
CLAC, 0 /LOAD OR CLEAR AC-REGISTER
DCA AC3
DCA AC2
DCA AC1
DCA AC0
DCA ACS
DCA ACX
JMP I CLAC
PAGE
/REAL NUMBER OUTPUT - AUXILIARY ROUTINES
XDPOS=XR10 /AUTOINDEXING DIGITS
/DPOS=EXBCD /SIMPLE POINTER TO DIGITS
/DIG0=DOUT /NUMBUF-1 OR NUMBUF-2 (FIRST DIGIT OF MANTISSA)
DEXP=BCD /DECIMAL CHARACTERISTIC OF X
DCNT=. /DIGIT COUNTER
FLCONV, 0 /CONVERT X*2^ACX ---> Z*10^DEXP,
DCA DEXP /WITH 1<=Z<10:
TAD AC1
SNA CLA /IF NUMBER=0 THEN NO CONVERSION NECESSARY!
JMP I FLCONV
JMS SUP2 /DO SUPER CONVERSION
FLCLP, TAD DEXP
DCA DEXP
TAD ACX
SPA SNA /NOTE INTERNAL BINARY NOTATION:
JMP SMALL
TAD (-4 / 1 ..... 0.1000B+1
SPA /10 ..... 0.1010B+4
JMP .+5
SZA CLA
JMP LARGE
TAD AC1 /HIGH ORDER WORD FOR 10
TAD (-2400 /IS 2400 OCTAL!
SPA CLA
JMP I FLCONV
LARGE, AAAAAAAAAAAAAAAA
DIV TEN /:10 (OR 'MUL OPTEN' *0.1)
EEEEEEEEEEEEEEEE
L0001
JMP FLCLP
SMALL, AAAAAAAAAAAAAAAA
MUL TEN /*10
EEEEEEEEEEEEEEEE
L7777
JMP FLCLP
DPOS=.
EXBCD, 0 /EXTRACT BCD-DIGITS OF MANTISSA
TAD ACX
CMA
DCA DCNT
STL /(MIGHT CORRECT ILL 11TH DEC. DIGIT!)
DOUBLE /SHIFT OUT FIRST DIGIT
ISZ DCNT
JMP .-3
TAD (NUMBUF-1
DCA XDPOS
TAD (-12 /10 DIGITS REMAINING
DCA DCNT
DCA I (NUMBUF-1 /LEADING 0 FOR ROUNDING CARRY
SKP
JMS MUL10
TAD AC0
DCA I XDPOS
DCA AC0
ISZ DCNT
JMP .-5
TAD (NUMBUF-1 /POINT TO FIRST DIGIT
DCA DIG0
JMP I EXBCD
UROUND, 0 /ROUNDUP. ENTRY WITH DIGIT NO.
TAD DIG0 /WHERE TO START ROUNDING
DCA DPOS /IN HARDWARE AC
TAD (5
CARRY, TAD (-12
TAD I DPOS
SPA CLA
JMP OVR10
DCA I DPOS
L7777
TAD DPOS
DCA DPOS
ISZ I DPOS
JMP CARRY
OVR10, TAD DIG0
CIA
TAD DPOS
SZA CLA /CARRY TO A NEW FIRST DIGIT?
JMP SKIPEX /NO
L7777
TAD DIG0
DCA DIG0
ISZ DEXP
JMP I UROUND /MANTISSA=10 EXIT
SKIPEX, ISZ UROUND /NORMAL EXIT
JMP I UROUND
XOUT, 0 /OUTPUT. ENTRY WITH DIGIT NO.
TAD DIG0 /WHERE TO START PRINTING
DCA XDPOS /IN HARDWARE AC
TAD (240
PRINTC / -(S) BLANKS
ISZ S
JMP .-3
TAD ACS
SPA CLA
TAD ("--240
TAD (240
PRINTC / THE SIGN (- OR BLANK)
JMS DOUT / -(P) DIGITS (OR ZERO)
ISZ P
JMP .-2
TAD (". / THE DECIMAL POINT
PRINTC
JMS DOUT / -(F) DIGITS (OR ZEROES)
ISZ F
JMP .-2
JMP I XOUT
DIG0=.
DOUT, 0 /IF XDPOS POINTS INTO BUFFER
TAD XDPOS /THEN PRINT THE DIGIT
TAD (-NUMBUF-12 /ELSE PRINT A ZERO
CLL
TAD (14
CLA
TAD I XDPOS
SNL
CLA
TAD ("0
PRINTC
JMP I DOUT
PAGE
/R E A L A R I T H M E T I C
/
/RADD: AC:=AC+OP
/RSUB: AC:=AC-OP
/RMUL: AC:=AC*OP
/RDIV: AC:=AC/OP
/
/RNORM: NORMALIZE AC TO STANDARD FLOATING POINT FORMAT
RADD, 0
TAD OP1
SNA CLA /IF OP=0 THEN DON'T WASTE TIME!
JMP I RADD
TAD AC1
SNA CLA /IF AC=0 THEN SIMPLY ADD!
JMP OPMAX
TAD ACX /COMPARE MAGNITUDE OF OPERANDS
CIA /AND STORE NEGATIVE DIFFERENCE
TAD OPX
SMA
JMP OPMAX
DCA RDIV /TO USE AS SHIFT COUNTER
ACMAX, TAD OP1 /1/ ABS(AC)>ABS(OP) ---> SHIFT OP RIGHT
CLL RAR
DCA OP1
TAD OP2
RAR
DCA OP2
TAD OP3
RAR
DCA OP3
ISZ RDIV
JMP ACMAX
JMP SETSGN
OPMAX, CMA /2/ ABS(OP)>=ABS(AC)
DCA RDIV
TAD OPX /RESULT IS OF MAGNITUDE OF OP
DCA ACX
SKP
HALVE /SHIFT AC RIGHT
ISZ RDIV
JMP .-2
SETSGN, JMS OADD /MANTISSAS NOW ALIGNED! - ADD.
JMS RNORM /NORMALIZE RESULT
JMP I RADD
RSUB, 0
JMS OSUB /OP:=-OP
JMS RADD /AC:=AC+(-OP)
JMP I RSUB
OSUB, 0
L4000
TAD OPS
DCA OPS
JMP I OSUB
RMUL, 0
TAD OP1
SNA CLA
JMS CLAC
TAD AC1
SNA CLA /IF OP=0 OR AC=0
JMP I RMUL /THEN DON'T WASTE TIME!
DCA MQ1
DCA MQ2 /CLEAR MQ-REGISTER (FOR 'BMUL')
DCA MQ3
TAD OPS /SETUP SIGN OF PRODUCT
TAD ACS
DCA ACS
L7777
TAD OPX /COMPUTE EXPONENT OF PRODUCT
TAD ACX
DCA ACX
L0001
JMS BMUL /MULTIPLY MANTISSAS
JMS RNORM
JMP I RMUL
RDIV, 0
TAD OP1
SNA CLA
ERROR0, HALT /D I V I S I O N BY Z E R O !
DCA MQ1
DCA MQ2 /CLEAR MQ-REGISTER (FOR 'BDIV')
DCA MQ3
TAD OPS /SETUP SIGN OF QUOTIENT
TAD ACS
DCA ACS
TAD OPX /COMPUTE EXPONENT OF QUOTIENT
CIA
TAD ACX
DCA ACX
JMS BDIV /DIVIDE MANTISSAS
JMS RNORM
JMP I RDIV
RNORM, 0
CLA CLL
TOOBIG, TAD AC1
AND (4000 /(NO 'L4000' BECAUSE OF LINK!)
TAD AC0
SNA CLA /WHILE MANTISSA TOO BIG (>=1)
JMP ROUNDUP
HALVE /HALVE IT (SHIFT RIGHT)
ISZ ACX /AND CORRECT THE EXPONENT (+1)
NOP
JMP TOOBIG
ROUNDUP,SZL /IF A BINARY 1 WAS SHIFTED OUT
ISZ AC3 /THEN ROUND MANTISSA
JMP NULLAC
ISZ AC2
JMP NULLAC
ISZ AC1 /(CAN'T SKIP!)
JMP RNORM+1
NULLAC, JMS SNAC /CHECK FOR NULL MANTISSA
JMP ISNULL
TOOSMALL,L2000
AND AC1
SZA CLA /WHILE MANTISSA TOO SMALL (<0.5)
JMP ISNULL+1
DOUBLE /DOUBLE IT (SHIFT LEFT)
L7777 /AND CORRECT THE EXPONENT (-1)
TAD ACX
DCA ACX
JMP TOOSMALL
ISNULL, JMS CLAC
L2000 /CHECK FOR OVER- OR UNDERFLOW
TAD ACX
SMA CLA
JMP I RNORM /OKAY!
TAD ACX
SPA CLA
ERROR1, HALT /U N D E R F L O W !
ERROR2, HALT /O V E R F L O W !
PAGE
/I N T E G E R I N P U T AND O U T P U T
/
/
/M /MINIMUM FIELD WITH
DI, 0 /-NUMBER OF DIGITS TO PRINT
SI, 0 /-NUMBER OF LEADING BLANKS
LDBLANK,240 /OR OTHER LEADING CHARACTER
NEGATIV,0 /IF NUMBER NEGATIVE THEN -1 ELSE 0
IINP, 0
SKP CLA
READC /IGNORE LEADING BLANKS
TAD CHAR
TAD (-240
SNA CLA
JMP .-4
JMS PMXXX /INPUT +-0123456789 AND CONVERT TO BINARY
JMS INORM /CHECK OVERFLOW (MAXINT=34359738367)
JMP I IINP
PTD=IINP
IOUT, 0
TAD [240 /KLUDGE! CHOOSE THE LEADING CHARACTER
DCA LDBLANK /WITH A TAD (XXX-240 BEFORE CALLING IOUT
TAD ACS
SPA CLA
L7777
DCA NEGATIV
TAD (NUMBUF+12
DCA PTD /POINT TO RIGHTMOST POS. OF BUFFER
DCA I PTD /STORE A 0 CASE NUMBER=0
DECONV, JMS SNAC
JMP OFORM
L7777
TAD PTD /DECREMENT POINTER
DCA PTD
AAAAAAAAAAAAAAAA
DIV INT&IO /AC:=AC DIV 10
EEEEEEEEEEEEEEEE
TAD MQ3
CLL RAR /GET REST OF ABOVE DIVISION
JMP DECONV-1 /AND STORE AS BCD-DIGIT
OFORM, TAD (-NUMBUF-12
TAD PTD
SMA
L7777 /AT LEAST ONE DIGIT TO PRINT (THINK OF 0)
DCA DI /DI:=-NUMBER OF DIGITS
TAD NEGATIV /TAKE ACCOUNT OF EV. - SIGN
TAD M
TAD DI
SPA /IF FIELD WIDTH < NO. OF DIGITS
CLA /THEN SI:=-1
CMA /ELSE SI:=-(FIELD WIDTH - DIGITS) - 1
DCA SI
JMP .+3
LDCHAR, TAD LDBLANK
PRINTC /LEADING BLANKS
ISZ SI
JMP LDCHAR
EVMINS, ISZ NEGATIV
JMP ODIGS
TAD ("-
PRINTC /MINUS SIGN (IF ANY)
ODIGS, TAD I PTD
ISZ PTD
TAD ("0
PRINTC /DIGIT STRING
ISZ DI
JMP ODIGS
JMP I IOUT
INORM, 0 /INTEGER CLEARING HOUSE ROUTINE
L4000
AND AC1
TAD AC0
SZA CLA /IF AC0<>0 OR AC1>3777 THEN
JMP ERROR2 /O V E R F L O W
JMS SNAC
DCA ACS /DON'T FORGET THE -0 PROBLEM!
JMP I INORM
IO, 0000 /INTEGER CONSTANT OF 10
0000
0000
0012
/VARIOUS SECONDARY ROUTINES:
XABS, 0 /AC:=ABS(AC)
DCA ACS
JMP I XABS
XNEG, 0 /AC:=-AC (REAL AND INTEGER)
L4000
TAD ACS
DCA ACS
JMS INORM /BUT NOT AC:=-0 !
JMP I XNEG
OGET, 0 /COPY CONTENTS OF
DCA AC0 /OP-REGISTER INTO AC-REGISTER
TAD OP1 /(AC0 IS CLEARED!)
DCA AC1
TAD OP2
DCA AC2
TAD OP3
DCA AC3
TAD OPS
DCA ACS
TAD OPX
DCA ACX
JMP I OGET
ENTR, 0 /COPY CONTENTS OF
TAD AC1 /AC-REGISTER INTO OP-REGISTER
DCA OP1 /(AC0 UNCHANGED!)
TAD AC2
DCA OP2
TAD AC3
DCA OP3
TAD ACS
DCA OPS
TAD ACX
DCA OPX
JMP I ENTR
BOOL, 0 /ENTER WITH SKIP-INSTRUCTION
DCA OSKIP /IN HARDWARE AC
JMS SNAC
SKP
L0001
TAD ACS
OSKIP, 0000
SKP CLA
L0001
JMP I BOOL /EXIT WITH HARDWARE AC=1 IF TRUE (SKIP)
/OR AC=0 IF FALSE
PAGE
/I N T E G E R A R I T H M E T I C
/
/IADD: AC:=AC+OP
/ISUB: AC:=AC-OP
/IMUL: AC:=AC*OP
/IDIV: AC:=AC DIV OP
/IMOD: AC:=AC MOD OP
IADD, 0
JMS OADD
JMS INORM
JMP I IADD
OADD, 0
TAD ACS
TAD OPS
SNA CLA /IF BOTH OPERANDS HAVE THE SAME SIGN
JMP SAMESGN /THEN SIMPLY ADD THEM
JMS CMOP /ELSE COMPLEMENT ONE OF THEM (OP)
JMS BADD /AND ADD
TAD AC1 /BUT TAKE CARE:
SMA CLA /IF RESULT POSITIVE (IN 2'S COMPLEMENT)
JMP .+4 /THEN OKAY
JMS CMAC /ELSE COMPLEMENT AC
TAD OPS /AND USE SIGN OF OP
DCA ACS
DCA AC0 /NO OVERFLOW IN THIS CASE!
JMP I OADD
SAMESGN,JMS BADD
JMP I OADD
ISUB, 0
JMS OSUB /OP:=-OP
JMS IADD /AC:=AC+(-OP)
JMP I ISUB
IMUL, 0
JMS SNOP /IF OP=0
CLEAR /THEN PRODUCT IS 0
DCA MQ1
DCA MQ2 /CLEAR MQ-REGISTER (BMUL NEEDS THAT!)
DCA MQ3
TAD OPS /SETUP SIGN OF PRODUCT
TAD ACS
DCA ACS
JMS BMUL /MULTIPLY
INTMOV, JMS SNAC /IF HIGH ORDER WORDS OF PRODUCT <>0
SKP
JMP ERROR2 /THEN O V E R F L O W !
JMS SWAP /GET LOW ORDER PART INTO AC
HALVE /(BMUL GIVES 2*PRODUCT!)
JMS INORM
JMP I IMUL
MODSGN=IMUL
IDIV, 0
JMS SNOP
JMP I [ERROR0 /D I V I S I O N BY Z E R O !
DOUBLE
JMS SWAP /PUT 2*DIVIDEND INTO MQ-REGISTER
DCA AC1 /AND CLEAR AC (SEE BDIV INSTRUCTIONS)
DCA AC2
DCA AC3
TAD OPS /SETUP SIGN OF QUOTIENT
TAD ACS
DCA ACS
TAD ACS /PATCH: SERVES
DCA MODSGN /FOR MOD-FUNCTION
JMS BDIV /DIVIDE
JMS INORM
JMP I IDIV
IMOD, 0
JMS IDIV /DIVIDE OP INTO AC
JMS SWAP /GET 2*REST FROM MQ-REGISTER
HALVE /AND HALVE IT (SEE BDIV INSTR.)
TAD MODSGN
SPA CLA /IF REST NOT NEGATIVE
JMS SNAC
JMP MODOK /THEN OKAY
JMS BADD /ELSE ADD OP TO MAKE IT POSITIVE
JMS CMAC /MORE PRECISELY: AC:=-(AC-OP)
MODOK, DCA ACS /SIGN IS +
DCA AC0
JMP I IMOD
/FOUR SECONDARY ROUTINES:
SNAC, 0 /SKIP ON NONZERO AC
TAD AC3
SNA
TAD AC2
SNA
TAD AC1
SZA CLA
ISZ SNAC
JMP I SNAC
SNOP, 0 /SKIP ON NONZERO OP
TAD OP3
SNA
TAD OP2
SNA
TAD OP1
SZA CLA
ISZ SNOP
JMP I SNOP
CMAC, 0 /2'S COMPLEMENT OF AC
CLA CLL
TAD AC3
CIA
DCA AC3
TAD AC2
CMA
SZL
IAC CLL
DCA AC2
TAD AC1
CMA
SZL
IAC CLL
DCA AC1
JMP I CMAC
CMOP, 0 /2'S COMPLEMENT OF OP
CLA CLL
TAD OP3
CIA
DCA OP3
TAD OP2
CMA
SZL
IAC CLL
DCA OP2
TAD OP1
CMA
SZL
IAC CLL
DCA OP1
JMP I CMOP
JMSSNAC=JMS SNAC
PAGE
/B I N A R Y A D D I T I O N
/
/AC0!AC1!AC2!AC3 := AC1!AC2!AC3 + OP1!OP2!OP3
TEMP3=.
BADD, 0
CLA CLL
TAD AC3
TAD OP3
DCA AC3
RAL
TAD AC2
TAD OP2
DCA AC2
RAL
TAD AC1
TAD OP1
DCA AC1
RAL
TAD AC0
DCA AC0
JMP I BADD
/B I N A R Y M U L T I P L I C A T I O N
/
/OP=FACTOR
/FLOATING POINT: AC=FACTOR, MQ=0; AC=PRODUCT (HIGH ORDER)
/INTEGER: AC=FACTOR, MQ=0; MQ=2*PRODUCT (LOW ORDER)
BMUL, 0
TAD MIN44 /-36
DCA BDIV
JMS SWAP
MULLP, JMS RACR
TAD MQ1
RAR
DCA MQ1
TAD MQ2
RAR
DCA MQ2
TAD MQ3
RAR
DCA MQ3
SZL
JMS BADD
ISZ BDIV
JMP MULLP
JMP I BMUL
/B I N A R Y D I V I S I O N
/
/OP=DIVISOR
/FLOATING POINT: AC=DIVIDEND, MQ=0; AC=QUOTIENT
/INTEGER: AC=0, MQ=2*DIVIDEND; AC=QUOTIENT, MQ=2*REST
BDIV, 0
TAD MIN44 /-36
DCA BMUL
JMS CMOP
DIVLP, CLL /COMPARE AC AND OP
TAD AC3
TAD OP3
DCA TEMP3 /SAVE DIFFERENCE
RAL
TAD AC2
TAD OP2
DCA TEMP2
RAL
TAD AC1
TAD OP1
SNL /AC > OP?
JMP .+6
DCA AC1 /YES, SETUP DIFFERENCE
TAD TEMP2
DCA AC2
TAD TEMP3
DCA AC3
CLA
TAD MQ3 /SHIFT IN NEW BIT OF QUOTIENT
RAL /AND DOUBLE DIVIDEND
DCA MQ3
TAD MQ2
RAL
DCA MQ2
TAD MQ1
RAL
DCA MQ1
JMS RACL
ISZ BMUL
JMP DIVLP
JMS SWAP
JMP I BDIV
/OTHER BINARY OPERATIONS:
MUL2,
RACL, 0 /SHIFT AC ONE BIT LEFT (=DOUBLE)
TAD AC3 /TAKE CARE OF LINK CALLING RACL!!!
RAL
DCA AC3
TAD AC2
RAL
DCA AC2
TAD AC1
RAL
DCA AC1
TAD AC0
RAL
DCA AC0
JMP I RACL
TEMP2=.
MUL10, 0 /AC TIMES 10
JMS ENTR /LINK MUST BE 0 ON ENTRY!!!
JMS MUL2
JMS MUL2
JMS BADD
JMS MUL2
JMP I MUL10
RACR, 0 /SHIFT AC ONE BIT RIGHT (=HALVE)
TAD AC0
CLL RAR
DCA AC0
TAD AC1
RAR
DCA AC1
TAD AC2
RAR
DCA AC2
TAD AC3
RAR
DCA AC3
JMP I RACR
SWAP, 0 /SWAP AC- AND MQ-REGISTER
TAD AC1
MQL
TAD MQ1
DCA AC1
TAD AC2
SWP
DCA MQ1
TAD MQ2
DCA AC2
TAD AC3
SWP
DCA MQ2
TAD MQ3
DCA AC3
MQA
DCA MQ3
JMP I SWAP
PAGE
/ A R I T H M E T I C P A C K A G E
/OPTION:
/ S U P E R C O N V E R S I O N O V E R L A Y
/POWERS OF TEN TABLE:
P1E1, 0004;2400;0000;0000 / 1.0E+001
0007;3100;0000;0000 / 1.0E+002
0016;2342;0000;0000 / 1.0E+004
0033;2765;7020;0000 / 1.0E+008
0066;2160;6744;6770 / 1.0E+016
0153;2356;1326;6501 / 1.0E+032
0325;3023;6017;5120 / 1.0E+064
0652;2235;6443;7114 / 1.0E+128
P1E256, 1523;2523;7565;7735 / 1.0E+256
3245;3430;6320;2565 / 1.0E+512 (SERVES AS A GUARD)
P1E2N, 0 /POINTER INTO TABLE
DECP, 0 /DECIMAL CHARACTERISTIC
/DEXP=BCD / --- " --- (SEE 'FLCONV')
SUP1, 0 /INPUT CONVERSION (OVERLAYS 'ADJUST')
SPA /IF DECIMAL CHARACTERISTIC >= 0
JMP .+4
DCA DECP /THEN STORE AS IT IS
TAD (MUL P1E1 /AND SETUP FOR MULTIPLY
JMP .+4 /WITH POWERS OF 10
CIA
DCA DECP /ELSE MAKE IT POSITIVE
TAD (DIV P1E1 /AND SETUP FOR DIVIDE
DCA MD1E2N /BY POWERS OF 10
ADJLP, TAD DECP
SNA /WHILE DECP<>0 DO:
JMP I SUP1
CLL RAR /DECP:=DECP DIV 2
DCA DECP
SNL /IF DECP WAS ODD
JMP .+4
AAAAAAAAAAAAAAAA
MD1E2N, MUL . /THEN MULTIPLY WITH (DIVIDE BY) 1.0E+2N
EEEEEEEEEEEEEEEE
L0004
TAD MD1E2N /POINT TO NEXT POWER OF TEN
DCA MD1E2N
JMP ADJLP
SUP2, 0 /OUTPUT CONVERSION (OVERLAYS 'FLCONV')
AAAAAAAAAAAAAAAA
PUT XAC /SAVE NUMBER IN AC
EEEEEEEEEEEEEEEE
TAD XAC /GET BINARY EXPONENT
SPA /(2'S COMPLEMENT!)
CIA /AND LOAD IT AS POSITIVE INTEGER
LOAD /INTO AC-REGISTER
AAAAAAAAAAAAAAAA/NOTE: LG(2) IS APPROXIMATED BY 1233/4096
MUL INT&O1233 /*1233
EEEEEEEEEEEEEEEE
L4000
AND XAC
CLL RAL
TAD AC2 /DIV 4096
SZL /IF XAC<0
CMA /THEN DEXP := -XAC*1233 DIV 4096 - 1
DCA DEXP /ELSE DEXP := XAC*1233 DIV 4096
AAAAAAAAAAAAAAAA
GET XAC /RESTORE NUMBER
EEEEEEEEEEEEEEEE
TAD DEXP
CIA
JMS SUP1 /DO CONVERSION TO DECIMAL FLOATING POINT
JMP I SUP2
XAC, ZBLOCK 4
O1233, 0000;0000;0000;2321 /1233 (INTEGER)
TRUEFALSE, TEXT /TRUEFALSE/
XISQU, 0 /AC := AC^2 (INTEGER)
JMS ENTR
JMS IMUL
JMP I XISQU
XRSQU, 0 /AC := AC^2 (REAL)
JMS ENTR
JMS RMUL
JMP I XRSQU
PAGE
/**********************
/ S Q U A R E R O O T
/
/ AC := SQRT(AC)
/**********************
XSQRT, 0
TAD ACS
SPA CLA
ERROR3, HALT /SQUARE ROOT OF N E G A T I V E NUMBER!
TAD AC1
SNA CLA
JMP I XSQRT /DON'T WASTE TIME FOR SQRT(0)!
L0001
TAD ACX /TRANSFORM ARGUMENT TO THE FORM
SPA SZL / 2^(2*N) * F WITH 0.25 <= F < 1
CML
RAR
DCA ROOTX /SAVE N
SNL /IF ODD(EXPONENT)
L7777 /THEN ACX:=-1 (0.25 <= F < 0.5)
DCA ACX /ELSE ACX:= 0 (0.5 <= F < 1 )
AAAAAAAAAAAAAAAA
PUT SQARG /SAVE F
EEEEEEEEEEEEEEEE
TAD ACX /COMPUTE INITIAL VALUE X0 FOR NEWTON:
DCA OPOINT5 /X0:=F + 0.25 (0.25 <= F < 0.5)
L7777 /X0:=F/2 + 0.5 (0.5 <= F < 1 )
DCA ACX
AAAAAAAAAAAAAAAA
ADD OPOINT5
EEEEEEEEEEEEEEEE
L7775 /3 ITERATION LOOPS GUARANTEE
DCA NEWTON /FULL PRECISION! (MAX. ERROR: 8.0E-13)
SQLOOP, AAAAAAAAAAAAAAAA
PUT X123
GET SQARG
DIV X123
ADD X123 /X[I+1] := (F/X[I] + X[I])/2
EEEEEEEEEEEEEEEE
L7777 /HALVE BY ACX:=ACX - 1
TAD ACX
DCA ACX
ISZ NEWTON /IF DONE 3 LOOPS
JMP SQLOOP
TAD ROOTX /THEN INSERT EXPONENT N OF ROOT
TAD ACX
DCA ACX
JMP I XSQRT
NEWTON=. /LOOP COUNTER
OPOINT5,0000 /CONSTANT OF 0.5 OR 0.25 (EXPONENT WORD
2000 /SET AT EXECUTION TIME)
0000
0000
SQARG, 0 /REDUCED ARGUMENT F
0
0
0
X123, 0 /TEMPORARY FOR APPROXIMATE VALUE
0
0
0
ROOTX, 0 /TEMPORARY FOR ROOT EXPONENT N
/**********************************
/ N A T U R A L L O G A R I T H M
/
/ AC := LN(AC)
/**********************************
/TABLE OF CONSTANTS:
A0, 0001 /1.84375
3540
0000
0000
LNA0, 0000 /0.611801541106
2344
7603
2325
A1, 0001 /1.65625
3240
0000
0000
LNA1, 0000 /0.504556010752
2011
2512
4551
A2, 0001 /1.5
3000
0000
0000
LNA2, 7777 /0.405465108108
3174
6217
5457
A3, 0001 /1.375
2600
0000
0000
LNA3, 7777 /0.318453731119
2430
3057
0207
A4, 0001 /1.25
2400
0000
0000
LNA4, 7776 /0.223143551314
3443
7737
0746
A5, 0001 /1.1875
2300
0000
0000
LNA5, 7776 /0.171850256927
2577
6301
6051
A6, 0001 /1.09375
2140
0000
0000
LNA6, 7775 /0.0896121586897
2674
1512
1271
A7, 0001 /1.03125
2040
0000
0000
LNA7, 7773 /0.0307716586668
3740
5154
1636
PAGE
XLOG, 0
TAD ACS
TAD AC1
SPA SNA CLA
ERROR4, HALT /LOGARITHM OF ZERO OR NEGATIVE NUMBER!
AAAAAAAAAAAAAAAA
PUT LNARG /SAVE ARGUMENT X = 2^N * F
EEEEEEEEEEEEEEEE
DCA LNARG /REDUCE TO FRACTION PART (0.5 <= F < 1)
CLL
TAD ACX /GET N (IN TWO'S COMPLEMENT!)
SPA
CIA STL
JMS LDAC /LOAD IT AS INTEGER
RAR
DCA ACS
AAAAAAAAAAAAAAAA
FLOAT /CONVERT TO REAL
MUL LN2 /TIMES LN(2)
PUT LNTEMP /AND SAVE IT
EEEEEEEEEEEEEEEE
LNLOOP, TAD LNARG+1 /FOR FURTHER REDUCTION OF THE ARGUMENT
AND BIT234 /SELECT THE APPROPRIATE MULTIPLIERS A(K)
CLL RTR /AND THEIR LOGARITHMS FROM A TABLE,
RTR /ACCORDING TO THE RANGE OF F.
TAD (A0
DCA PTAK
L0004
TAD PTAK
DCA PTLNAK
AAAAAAAAAAAAAAAA
GET LNTEMP
SUB I PTLNAK /SUBTRACT LN( A(K) ) TO COMPENSATE
PUT LNTEMP
GET I PTAK /THE MULTIPLICATION WITH A(K)
MUL LNARG /F' = A(K)* .... *F
PUT LNARG
EEEEEEEEEEEEEEEE
TAD ACX
SNA CLA
JMP LNLOOP /IT IS GUARANTEED, THAT AFTER NO MORE
AAAAAAAAAAAAAAAA/THAN T H R E E E MULTIPLICATIONS
SUB ONEPT0 /F' FITS IN THE RANGE
PUT LNARG / 0 <= F'-1 < 2^(-5)
MUL LTC6 /NOW COMPUTE LN(F') VIA TAYLOR SERIES
ADD LTC5
MUL LNARG
ADD LTC4
MUL LNARG
ADD LTC3
MUL LNARG
ADD LTC2
MUL LNARG
ADD ONEPT0
MUL LNARG
ADD LNTEMP /LN(X) = N*LN(2) - LN(A(K)) ... + LN(F')
EEEEEEEEEEEEEEEE
JMP I XLOG
BIT234, 1600 /MASK TO EXTRACT BITS 00XXX0000000
PTAK, A0 /POINTER INTO TABLE
PTLNAK, LNA0 / --- " ---
LNARG, 0 /ARGUMENT REGISTER
0
0
0
LNTEMP, 0 /TEMPORARY
0
0
0
LN2, 0000 /0.69314718
2613
4413
7676
LTC6, 7776 / -1/6
6525
2525
2525
LTC5, 7776 / 1/5
3146
3146
3146
LTC4, 7777 / -1/4
6000
0000
0000
LTC3, 7777 / 1/3
2525
2525
2525
LTC2, 0000 / -1/2
6000
0000
0000
/****************************************
/ E X P O N E N T I A L F U N C T I O N
/
/ AC := EXP(AC)
/****************************************
ONEPT0,
EX0B8, 0001 / 2^(0/8) = 1
2000
0000
0000
EX1B8, 0001 / 2^(1/8)
2134
5340
7437
EX2B8, 0001 / 2^(2/8)
2301
5770
1214
EX3B8, 0001 / 2^(3/8)
2457
7553
2515
EX4B8, 0001 / 2^(4/8)
2650
1171
4637
EX5B8, 0001 / 2^(5/8)
3053
1625
0212
EX6B8, 0001 / 2^(6/8)
3272
1176
3126
EX7B8, 0001 / 2^(7/8)
3526
0143
3476
PAGE
XEXP, 0
DCA TWO2N
TAD (ONEPT0
DCA TWO2M8
AAAAAAAAAAAAAAAA
SKNE
JMP EXP0 /EXP(0)=1
MUL LOG2E /X*LB(2) .... EXP(X) = 2^(X*LB(2))
PUT EXTEMP
TRUNC /SPLIT PRODUCT INTO
PUT INT&TWO2N-3 /INTEGER PART N
FLOAT
SUB EXTEMP /AND FRACTION F (0 <= F < 1)
NEGATE
SKLT
JMP .+7
ADD ONEPT0
EEEEEEEEEEEEEEEE
TAD TWO2N
CMA
DCA TWO2N
AAAAAAAAAAAAAAAA
SKNE
JMP EXP0
EEEEEEEEEEEEEEEE
L0003
TAD ACX
SPA SNA /IF F>=1/8 THEN SPLIT F INTO
JMP APPROX
CMA CLL / M/8 + R (0 < M < 8, 0 <= R < 1/8)
DCA EXREST
DOUBLE
ISZ EXREST
JMP .-2
TAD AC0
CLL RTL
TAD (ONEPT0
DCA TWO2M8 /POINT TO 2^(M/8) IN TABLE
DCA AC0
TAD (-4
DCA ACX
JMS RNORM /NORMALIZE
APPROX, AAAAAAAAAAAAAAAA/COMPUTE 2^R BY A CONTINUED FRACTION
SKNE
JMP EXP0
PUT EXREST
GET EXD3
DIV EXREST
ADD EXREST
PUT EXTEMP
GET EXC3
DIV EXTEMP
SUB EXREST
ADD EXB3
PUT EXTEMP
GET EXA3
DIV EXTEMP
SUB ONEPT0
SKIP
EXP0, GET ONEPT0
MUL I TWO2M8 /MULTIPLY WITH 2^(M/8)
EEEEEEEEEEEEEEEE
TAD ACX
TAD TWO2N /INSERT 2^N
DCA ACX
JMS RNORM /CHECK FOR OVERFLOW
JMP I XEXP /EXP(X) = 2^N * 2^(M/8) * 2^R
TWO2M8, 0 /POINTER TO TABLE
EXTEMP, 0 /ARGUMENT AND TEMPORARY
0
0
0
EXREST, 0 /TEMPORARY REGISTER
0
0
0
TWO2N, 0000 /HOLDS N (MUST BE HERE!!!)
LOG2E, 0001 /1.442695040889
2705
2435
4512
EXA3, 0006 /34.624680981335
2123
7726
1367
EXB3, 0005 /17.312340490668
2123
7726
1367
EXC3, 0007 /-104.068449050280
7201
0605
7007
EXD3, 0005 /20.813689810056
2464
0467
7155
/****************************
/ S I N E AND C O S I N E
/
/ AC := SIN(AC)
/ AC := COS(AC) = SIN(AC+PI/2)
/****************************
XCOS, 0
AAAAAAAAAAAAAAAA
ADD PIS2
EEEEEEEEEEEEEEEE
JMS XSIN
JMP I XCOS
OPT5, 0000 /0.5
2000
0000
0000
PIS2, 0001 / PI/2
3110
3755
2421
PI, 0002 / PI
3110
3755
2421
COS2, 0003 /-PI^2/2!
6357
2363
1157
SIN3, 0003 /-PI^3/3!
6452
7363
4611
PAGE
COS4, 0003 / PI^4/4!
2017
0174
1006
SIN5, 0002 / PI^5/5!
2431
5361
4734
COS6, 0001 /-PI^6/6!
6527
2361
7617
SIN7, 0000 /-PI^7/7!
6313
2263
1630
COS8, 7776 / PI^8/8!
3607
6501
5044
SIN9, 7775 / PI^9/9!
2501
7015
1040
COS10, 7773 /-PI^10/10!
7233
2174
5210
SCARG=EXTEMP /ARGUMENT REGISTER
XSIN, 0
TAD ACS /SIN(-X) = -SIN(X), THUS
DCA SCS /SAVE SIGN
DCA ACS /AND MAKE ARGUMENT POSITIVE
AAAAAAAAAAAAAAAA/NOW REDUCE ARGUMENT:
DIV PI / X/PI = N + F (0 <= F < 1)
PUT SCARG /SIN(X) = (-1)^N * SIN(PI*F)
TRUNC
EEEEEEEEEEEEEEEE
L0001
AND AC3 /IF ODD(N) THEN CHANGE SIGN
CLL RTR
TAD SCS
DCA SCS
AAAAAAAAAAAAAAAA
FLOAT
SUB SCARG /-F
SKNE
JMP SCRET
EEEEEEEEEEEEEEEE
TAD ACX
SZA CLA /IF F>=0.5 THEN
JMP .+4
AAAAAAAAAAAAAAAA
ADD ONEPT0 /F := 1 - F
EEEEEEEEEEEEEEEE/ SIN(PI*F) = SIN(PI*(1-F))
DCA ACS /NOW ARG. REDUCED TO 0 <= F <= 0.5
L0002
TAD ACX
SPA CLA /IF F<0.125
JMP TAYSIN /THEN USE SINE-SERIES
AAAAAAAAAAAAAAAA/ELSE SIN(PI*F) = COS(PI*(0.5-F))
SUB OPT5
EEEEEEEEEEEEEEEE
DCA ACS /F := 0.5 - F
L0002
TAD ACX
SPA CLA /IF F<0.125
JMP TAYCOS-1 /THEN USE COSINE-SERIES DIRECTLY
L7777 /ELSE COS(PI*F) = 2 * COS(PI*F/2)^2 - 1
TAD ACX
DCA ACX /F := F/2 (1/16 <= F <= 3/16)
L7777
DCA HFLAG /SET HALVE ARGUMENT FLAG
TAYCOS, AAAAAAAAAAAAAAAA
PUT SCARG
MUL SCARG
PUT FQU /SQUARE ARG.
MUL COS10
ADD COS8
MUL FQU
ADD COS6
MUL FQU
ADD COS4
MUL FQU
ADD COS2
MUL FQU
ADD ONEPT0
EEEEEEEEEEEEEEEE
ISZ HFLAG /WAS F>=0.125?
JMP SCRET+1
AAAAAAAAAAAAAAAA/YES
PUT FQU
MUL FQU / (COS^2 -
SUB OPT5 / - 0.5)
EEEEEEEEEEEEEEEE
ISZ ACX / *2
HFLAG, NOP
JMP SCRET+1
TAYSIN, AAAAAAAAAAAAAAAA
PUT SCARG
MUL SCARG
PUT FQU
MUL SIN9
ADD SIN7
MUL FQU
ADD SIN5
MUL FQU
ADD SIN3
MUL FQU
ADD PI
MUL SCARG
SCRET, EEEEEEEEEEEEEEEE
TAD AC1
SZA CLA
TAD SCS /INSERT SIGN (AVOID -0 !)
DCA ACS
JMP I XSIN
SCS, 0 /SIGN OF RESULT
FQU, 0 /TEMPORARY FOR SQUARES ARG.
0
0
0
PAGE
/********************
/ A R C T A N G E N T
/
/ AC := ARCTAN(AC)
/********************
XATN, 0
TAD ACX
TAD (14
SPA CLA /IF ARGUMENT VERY SMALL ( < 2^(-12) )
JMP I XATN /THEN ARCTAN(X)=X
TAD ACS
DCA ATNS /SAVE SIGN ... ARCTAN(-X) = -ARCTAN(X)
DCA ACS /AND MAKE ARGUMENT POSITIVE
AAAAAAAAAAAAAAAA
PUT ATARG
EEEEEEEEEEEEEEEE
TAD ACX
SPA SNA CLA /IF X>=1
JMP .+7
AAAAAAAAAAAAAAAA
GET ONEPT0 /THEN X := 1/X
DIV ATARG /ARCTAN(X) = PI/2 - ARCTAN(1/X)
PUT ATARG
EEEEEEEEEEEEEEEE/NOW ARGUMENT REDUCED TO 0 < X <= 1
L7777
DCA GT1FLAG /FLAG ARGUMENT > 1
TAD ACX
SPA CLA /IF X>=0.5 THEN USE ADD.THEOREM:
JMP ATN05
ISZ ATARG /2*X
ADDFLAG,NOP
AAAAAAAAAAAAAAAA/ARCTAN(X) = ARCTAN(0.5) + ARCTAN( ... )
ADD TWOPT0 /X := (2*X-1)/(X+2)
PUT EXTEMP
GET ATARG
SUB ONEPT0
DIV EXTEMP
PUT ATARG /ARGUMENT RANGE NOW 0 < X < 0.5
EEEEEEEEEEEEEEEE
L7777
ATN05, DCA ADDFLAG
AAAAAAAAAAAAAAAA/COMPUTE ARCTAN(X) BY CONTINUED FRACTION
MUL ATARG
PUT FQU
ADD ATB3
PUT EXTEMP
GET ATA3
DIV EXTEMP
ADD ATB2
ADD FQU
PUT EXTEMP
GET ATA2
DIV EXTEMP
ADD ATB1
ADD FQU
PUT EXTEMP
GET ATA1
DIV EXTEMP
ADD ATB0
ADD FQU
PUT EXTEMP
GET ATA0
MUL ATARG
DIV EXTEMP
EEEEEEEEEEEEEEEE
ISZ ADDFLAG /CORRECT RESULT IF NECESSARY
JMP .+4
AAAAAAAAAAAAAAAA
ADD ATN0P5
EEEEEEEEEEEEEEEE
ISZ GT1FLAG /WAS X>1 ?
JMP .+6
L4000 /YES
DCA ACS / -ARCTAN(X)
AAAAAAAAAAAAAAAA
ADD PIS2 / +PI/2
EEEEEEEEEEEEEEEE
TAD ATNS
DCA ACS /INSERT SIGN
JMP I XATN
ATNS, 0 /TEMPORARY FOR SIGN
GT1FLAG,0
ATARG, 0 /ARGUMENT REGISTER
0
0
0
ATA0, 0004 /12.37469388
3057
7537
4017
ATA1, 0007 /-80.34270560
6405
3673
4343
ATA2, 0001 /-1.191447224
6304
0253
6665
ATA3, 7775 /-0.078335428
6403
3451
4461
ATB0, 0005 /26.27277525
3221
3522
3121
ATB1, 0003 /6.36441688
3135
1757
0565
ATB2, 0002 /2.104518952
2065
4070
1015
ATB3, 0001 /1.258464113
2410
5255
0370
ATN0P5, 7777 /ARCTAN(0.5)
3553
0634
0530
TWOPT0, 0002 /2.0
2000
0000
0000
PAGE
/I N P U T - O U T P U T ROUTINES FOR STANDARD FILES
GETC, 0
CLA CLL
TAD LOOK
DCA CHAR
ISZ IC3
JMP G12
G3, L7775
DCA IC3
L7776
TAD IBP
DCA IBP
TAD I IBP
ISZ IBP
K377, AND (7400 /FIRST LITERAL ON THIS PAGE ---> 0377
CLL RTL
RTL
DCA CHECK
TAD I IBP
AND (7400
TAD CHECK
RTL
RTL
RAL
JMP GEXIT
G12, TAD IBP
AND K377
SZA CLA
JMP GEXIT-1
TAD (IBUFFER
DCA IBP
JMS I IDEVH
0200
IBUFFER
IBLOCK, 0
JMP RDERR
ISZ IBLOCK
L7776
DCA IC3
TAD I IBP
GEXIT, ISZ IBP
JMS CHECK
JMP GETC+4
JMP I GETC
RDERR, SMA CLA
JMP GEXIT-3
FATAL0, FATAL /FATAL READ ERROR!
IC3, -3
IBP, IBUFFER
PUTC, 0
SNA
TAD CHAR
DCA CHECK
TAD CHECK
ISZ OC3
JMP PUT12
DCA CC
L7776
TAD OBP
DCA OBP
JMS PUT3L
JMS PUT3R
L7775
DCA OC3
TAD OBP
AND K377
SZA CLA
JMP PUXIT
ISZ MBLOCKS
SKP
JMP ERRORD
JMS I ODEVH
4200
OBUFFER
OBLOCK, 0
JMP ERRORD
ISZ OBLOCK
TAD [OBUFFER
DCA OBP
JMP PUXIT
PUT12, AND K377
DCA I OBP
ISZ OBP
PUXIT, TAD CHECK
TAD [-215
SZA CLA
JMP I PUTC
TAD [212
JMP PUTC+1
PUT3L,
PUT3R, 0
TAD CC
CLL RTL
RTL
DCA CC
TAD CC
AND (7400
TAD I OBP
DCA I OBP
ISZ OBP
JMP I PUT3R
/OC3, 0 /ON PAGE 0!
/OBP, 0 / - " -
CHECK, 0
AND [177
SNA
JMP I CHECK
TAD (-15
SNA
JMP CR
TAD (15-32
SNA
JMP CR-2
TAD (-6
CLL
TAD [240
DCA LOOK
CHEXIT, DCA EOLN
SNL
ISZ CHECK
JMP I CHECK
L0001 /END OF FILE
DCA EOF
CR, TAD [240 /END OF LINE
DCA LOOK
L0001 /LINK=0!
JMP CHEXIT
PAGE
/THE ORGANIZATION OF THE FOLLOWING PAGES OF FIELD 0
/DEMANDS SOME EXPLANATION:
/ AT COMPILE TIME / AT RUNTIME /
/ / /
/06000--------------------------/-------------------------------/
/ STARTUP CODE, THEN / /
/ / I N P U T /
/06200- I N P U T (SOURCE) -----/----- -----/
/ F I L E B U F F E R / F I L E B U F F E R /
/ / /
/06400--------------------------/-------------------------------/
/ / INPUT /
/ I N P U T (SOURCE) / DEVICE HANDLER /
/06600- -----/-------------------------------/
/ D E V I C E / OUTPUT /
/ H A N D L E R / DEVICE HANDLER /
/07000--------------------------/-------------------------------/
/ / /
/ COMPILER PROCEDURES: / O U T P U T /
/07200----- -----/----- -----/
/ I N S Y M B O L / F I L E B U F F E R /
/ / /
/07400----- AND -----/-------------------------------/
/ / RUNTIME ERRORS /
/ N E X T C H / /
/-------------------------------/-------------------------------/
/AT COMPILATION TIME FOUR PAGES OF FIELD 6 ARE USED AS FOLLOWS:
/66400--- TEMPORARY STORAGE OF INPUT DEVICE HANDLER
/
/66600--- TEMPORARY STORAGE OF OUTPUT DEVICE HANDLER
/
/67400--- RUNTIME ERRORS
/
/67600--- INITIALIZATION OF RUNTIME SYSTEM
/DURING INITIALIZATION OF THE RUNTIME SYSTEM
/THE FIRST THREE PAGES ARE SWAPPED INTO THEIR PLACE IN FIELD 0!
/#############################################################/
/#############################################################/
/##### #####/
/##### S T A R T #####/
/##### #####/
/#############################################################/
/#############################################################/
/IMPORTANT POINTS OF PROGRAM FLOW:
/S T A R T (06000) /STARTING ADDRESS OF ENTIRE SYSTEM,
/PROCESS I/O-SPECIFICATIONS
/M A I N (40200) /START OF COMPILER PROGRAM
/E X P L A I N (60200) /COMPILATION REPORT
/I N I T (67600) /INITIALIZATION OF RUNTIME SYSTEM
/I S T A R T (00200) /START OF INTERPRETER
/ONCE ONLY CODE!!!
USR=200
*IBUFFER
START, CLA CLL /S T A R T I N G A D D R E S S
CIF 10
JMS I [7700 /LOCK USR IN MEMORY
10
TAD (1000 /RESET JOB STATUS WORD
DCA I (7746
CD, CIF 10
JMS I (USR /CALL THE COMMAND DECODER
5
2023 /ASSUMED INPUT EXTENSION: .PS
JMS HEADER
CDF 10
TAD I (7600
SNA /OUTPUT FILE SPECIFIED?
JMP NOOUT
DCA DEVNO /YES, SAVE DEVICE NUMBER
TAD (7600
DCA XR10
TAD I XR10 /TRANSFER THE FILENAME
DCA NAME
TAD I XR10
DCA NAME+1
TAD I XR10
DCA NAME+2
TAD I XR10
DCA NAME+3
CDF 0
CIF 10
TAD DEVNO
JMS I (USR /FETCH OUTPUT DEVICE HANDLER
1
OHEP, ODEVBUF /1 PAGE ONLY!
JMP CDERR
CIF 10
TAD DEVNO
JMS I (USR /OPEN OUTPUT FILE
3
SBNO, NAME
LEMP, 0
JMP CDERR
TAD OHEP /GET ENTRY POINT
DCA ODEVH
TAD SBNO /GET STARTING BLOCK NUMBER
DCA I (OBLOCK
TAD LEMP /GET LENGTH OF EMPTY
DCA LEMPTY
TAD LEMPTY
SZA
TAD (-1 /SETUP BLOCK COUNTER
DCA MBLOCKS /(=0 IF NOT A FILE DEVICE)
SKP
NOOUT, ISZ IHEP /ALLOW 2-PAGE INPUT HANDLER
/IF NO OUTPUT FILE SPECIFIED!
CDF 10
TAD I (7621
SNA /INPUT FILE SPECIFIED?
JMP NOINP /NO, USE INTERN KEYBOARD HANDLER!
CDF 0
CIF 10
JMS I (USR /FETCH INPUT DEVICE HANDLER
1
IHEP, IDEVBUF
JMP CDERR
CDF 10
TAD I (7622 /GET STARTING BLOCK NUMBER
CDF 60
DCA I (IIBLOCK
TAD IHEP /GET ENTRY POINT
DCA I (IIDEVH
NOINP, CDF 0 /SAVE DEVICE HANDLERS
TAD I F0T6 /IN FIELD 6 TO MAKE ROOM
CDF 60 /FOR HANDLER OF SOURCE FILE
DCA I F0T6
ISZ F0T6
ISZ C400
JMP .-6
CDF 10
TAD I (7617
SNA /SOURCE FILE SPECIFIED?
JMP CDERR
CDF 0
CIF 10
JMS I (USR /FETCH HANDLER OF SOURCE FILE
1
SHEP, IDEVBUF+1
JMP CDERR
TAD SHEP /GET ENTRY POINT
DCA IDEVH
CDF 10
TAD I (7620
CDF 0
DCA I (IBLOCK
JMP STARTC
F0T6, IDEVBUF
C400, -400
PAGE
STARTC, CDF 10 /CHECK /S - OPTION
TAD I (7644
CDF 0
AND (40
SNA CLA
JMP .+3
TAD (SPRINT
DCA PTPRINT
CDF CIF COMPFIELD
JMP I (MAIN /START COMPILER
CDERR, CLA CLL
CDF CIF 0
CRLF
TAD I CTEXT
SNA
JMP .+7
BSW
JMS ASCII
TAD I CTEXT
JMS ASCII
ISZ CTEXT
JMP CDERR+3
CRLF
JMP I (7605
CTEXT, .+1
TEXT /DATEIANGABEN FEHLERHAFT BZW. UNVOLLSTAENDIG (EV. AUCH SYSTEMFEHLER)!/
0
PAGE
/K E Y B O A R D I N P U T H A N D L E R
*IDEVBUF
XREAD, 0
CLA CLL
TAD LOOK
DCA CHAR
TAD EOLN
SZA CLA
JMP XLINE
REXIT, TAD I BP
ISZ BP
JMS CHECK
JMP .-3
JMP I XREAD
ERASE, TAD [215
JMS I ZPRINT
XLINE, TAD (IBUFFER
DCA BP
TAD ("?
JMS I ZPRINT
TAD [240
JMS I ZPRINT
XCHAR, JMS KEYBOARD
DCA I BP
TAD I BP
TAD (-377
SNA CLA / 'RUBOUT'?
JMP RUBOUT
TAD I BP
TAD (-203
SNA / 'CTRL-C'?
JMP I OS8
TAD (203-212
SNA / 'LINE FEED'?
JMP REPLAY
TAD (212-215
SNA / 'RETURN'?
JMP RETURN
TAD (215-225
SNA / 'CTRL-U'?
JMP ERASE
TAD (225-232
SNA / 'CTRL-Z'?
JMP EOFILE
TAD (232-240
SPA CLA
JMP XCHAR
TAD I BP
JMS I ZPRINT
ISZ BP
JMP XCHAR
RUBOUT, TAD ("\
JMS I ZPRINT
TAD BP
TAD (-IBUFFER
SNA CLA
JMP YCHAR
L7777
TAD BP
DCA BP
TAD I BP
JMS I ZPRINT
YCHAR, JMS KEYBOARD
DCA I BP
TAD I BP
TAD (-377
SNA CLA
JMP RUBOUT+2
TAD ("\
JMS I ZPRINT
JMP XCHAR+2
REPLAY, TAD BP
TAD (-IBUFFER
SNA
JMP XCHAR
CIA
DCA RC
TAD (IBUFFER
DCA BP
TAD [215
JMS I ZPRINT
TAD ("?
JMS I ZPRINT
TAD [240
JMS I ZPRINT
TAD I BP
JMS I ZPRINT
ISZ BP
ISZ RC
JMP .-4
JMP XCHAR
EOFILE, TAD [240
JMS I ZPRINT
TAD ("E
JMS I ZPRINT
TAD ("O
JMS I ZPRINT
TAD ("F
JMS I ZPRINT
RETURN, TAD [215
JMS I ZPRINT
TAD (IBUFFER
DCA BP
JMP REXIT
KEYBOARD,0
KSF
JMP .-1
KRB
AND [177
SNA
JMP KEYBOARD+1
TAD (200
JMP I KEYBOARD
BP, IBUFFER
RC=KEYBOARD
PAGE
/H E A D E R L I N E
*ODEVBUF
HEADER, 0 /ONCE ONLY CODE!
CDF 10
TAD I (7666 /GET DATE WORD FROM MONITOR
CDF 0
SNA
JMP WHEAD-1
MQL
TAD (HDATE
DCA XR10
MQA /YEAR
AND (7
TAD (116 /78
JMS YYMMDD
MQA /MONTH
BSW
RTR
AND (17
JMS YYMMDD
MQA /DAY
RTR
RAR
AND (37
JMS YYMMDD
SKP
DCA HDATE
WHEAD, TAD (PASCAL-1
DCA XR10
TAD I XR10
SNA
WHEND, JMP .+3 /BECOMES: JMP WHEXIT
PRINTC
JMP .-4
TAD H240
PRINTC
ISZ BLANKS
JMP .-3
TAD (JMP WHEXIT
DCA WHEND
JMP WHEAD+2
WHEXIT, CRLF
CRLF
JMP I HEADER
YYMMDD, 0
DCA DAT01
DCA DAT10
JMP .+3
DCA DAT01
ISZ DAT10
TAD DAT01
TAD (-12
SMA
JMP .-5
CLA
ISZ XR10
TAD DAT10
TAD H260
DCA I XR10
TAD DAT01
TAD H260
DCA I XR10
JMP I YYMMDD
H215=.
PASCAL, 215;"P;240;"A;240;"S;240;"C;240;"A;240;"L
240;"-;240;"S;240;240;240
"C;"O;"M;"P;"I;"L;"E;"R
H240, 240
"V
H260, "0
VERSION+"0
0000
HTLMOE, "H;"T;"L;"-;"M;"O;"E;"D;"L;"I;"N;"G
HDATE, ", /BECOMES: 0000 IF NO DATE SPECIFIED
240
0000 /YEAR
0000
"-
0000 /MONTH
0000
"-
DAT10, 0000 /DAY
DAT01, 0000
BLANKS, -30 /BECOMES 0000
PAGE
/BEGIN OF COMPILER PROGRAM: T H E S C A N N E R
NEXTCH=READC
SY0=H1 /FIELD 0 REPRESENTATIVE OF 'SY'
KSY=H2
SPS=H3
K=H4
INTORINP=PC
*7000
INSY0, SKP CLA
NEXTCH
TAD CHAR
TAD [-240
SNA CLA
JMP .-4
SNALF
JMP WSYMBOL
SKDIG
JMP SPSYM
NUMBER, TAD (FRACTN
DCA INTORINP
DCA SY0 /0=INTCON
JMS IINP
TAD CHAR
TAD (-".
SZA CLA
JMP ECHAR
NEXTCH
TAD CHAR
TAD (-".
SNA CLA
JMP RETNUM-2
REALGO, L0001
DCA SY0 /1=REALCON
TAD OC
CIA
DCA DC
JMP I INTORINP
ECHAR, ISZ INTORINP
TAD CHAR
TAD (-"E
SNA CLA
JMP REALGO
JMP RETNUM
TAD (":
DCA CHAR
RETNUM, JMS PACK
TAD (NUM-1
RETID, DCA XR10
CDF COMPFIELD
TAD AC0
DCA I XR10
TAD AC1
DCA I XR10
TAD AC2
DCA I XR10
TAD AC3
DCA I XR10
RETSYM, TAD SY0
CDF CIF COMPFIELD
JMP I (EXSY3
WSYMBOL,DCA K /USE AC FOR ID IN FIELD 0
CLEAR
AZ09, TAD K
TAD (-ALNG
SMA CLA
JMP .+4
L0100 /=2*AC0, LINK=0
JMS CPACK
ISZ K
NEXTCH
SKDIG
SNALF
JMP AZ09
L0001 /BUILD HASH-CODE
TAD AC0
BSW
RTL
CLA
TAD AC0
BSW
TAD AC1
AND [77
RAL
MQL /IN MQ
MQA
TAD (KSYTABLE
DCA KSY
MQA
CLL RTL
TAD (HASHTABLE-1
DCA XR10
CDF NAMEFIELD
TAD I XR10
CIA
TAD AC0
SZA CLA
JMP XIDENT
TAD I XR10
CIA
TAD AC1
SZA CLA
JMP XIDENT
TAD I XR10
CIA
TAD AC2
SZA CLA
JMP XIDENT
TAD I XR10
CIA
TAD AC3
SZA CLA
JMP XIDENT
TAD I KSY
JMP RETSYM+1
XIDENT, TAD (IDENT
DCA SY0
TAD (ID-1
JMP RETID
PAGE
SPSYM, TAD CHAR
TAD (CHARTABLE-240
DCA SPS
CDF NAMEFIELD
TAD I SPS
CDF 0
SNA
JMP ILLCHAR
SPA
JMP DBLCHAR
RETSPS, DCA SY0
NEXTCH
TAD SY0
RETSNGL,CDF CIF COMPFIELD
JMP I (EXSY3
ILLCHAR,ERROR;30 /24
JMP I (INSY0+1
DBLCHAR,DCA .+3
NEXTCH
TAD CHAR
HLT /JMP X
JMPCOL=JMP .
CCOL, TAD (-"=
SZA CLA
JMP .+3
TAD (BECOMES
JMP RETSPS
TAD (COLON
JMP RETSNGL
JMPLSS=JMP .
CLSS, TAD (-"=
SNA
JMP .+6
TAD ("=-">
SNA CLA
JMP .+4
TAD (LSS
JMP RETSNGL
L0004 /LEQ=NEQ+4
TAD (NEQ
JMP RETSPS
JMPGTR=JMP .
CGTR, TAD (-"=
SNA CLA
JMP .+3
TAD (GTR
JMP RETSNGL
TAD (GEQ
JMP RETSPS
JMPPER=JMP .
CPER, TAD (-".
SNA CLA
JMP .+3
TAD (PERIOD
JMP RETSNGL
TAD (COLON
JMP RETSPS
JMPLPAR=JMP .
CLPAR, TAD (-"*
SNA CLA
JMP .+3
TAD (LPARENT
JMP RETSNGL
NEXTCH
TAD CHAR
TAD (-"*
SZA CLA
JMP .-4
NEXTCH
TAD CHAR
TAD (-")
SZA CLA
JMP .-10
JMP I (INSY0+1
JMPAPOS=JMP I .
CAPOS
CPACK, 0
TAD K
RAR
DCA CPP
TAD CHAR
AND [77
SZL
JMP .+3
BSW
JMP .+5
MQL
TAD I CPP
AND [7700
MQA
DCA I CPP
CDF 0
JMP I CPACK
CPP, 0
XSNALF, 0
TAD CHAR
TAD (-"Z-1
CLL
TAD ("Z+1-"A
SNL CLA
ISZ XSNALF
JMP I XSNALF
PAGE
DISPLAY=7400
/-------- D I S P L A Y --------/
/DISPLAY,ZBLOCK 20 /AT RUNTIME ONLY
/---------------------------------/
CAPOS, AND [77
LOAD
DCA K
SKP
LBL2, NEXTCH
TAD CHAR
TAD (-""
SZA CLA
JMP .+6
NEXTCH
TAD CHAR
TAD (-""
SZA CLA
JMP LBL3
STL
CDF COMPFIELD
TAD I (SX
CDF TABLEFIELD
JMS CPACK
ISZ K
TAD EOLN
SNA CLA
JMP LBL2
DCA K
LBL3, L0002 /2=CHARCON
DCA SY0
L7777
TAD K
SNA
JMP RETNUM
SPA CLA
JMP ERR38
ISZ SY0 /3=STRING
CDF COMPFIELD
TAD I (SX
LOAD
TAD K
DCA I (SLENG
TAD I (SX
TAD K
DCA I (SX
TAD I (SX
STL RAR
CIA
TAD I (C
SPA CLA
FATAL7, FATAL
JMP RETNUM
ERR38, ERROR;46 /38
JMP .+3
ERR21, ERROR;25 /21
CLEAR
JMP RETNUM
ZERROR, 0
CLA CLL
TAD I ZERROR
CIF SETFIELD
JMS I (F3ERROR
JMP I ZERROR
ZFATAL, 0
TAD ZFATAL
CDF CIF SETFIELD
JMP I (F3FATAL
XNEXTCH,0
BREAK
ISZ LL
JMP NCH
TAD ERRSW
SNA CLA
JMP NLN
TAD (ERRLINE-1
DCA XR10
CDF SETFIELD
TAD I XR10
CDF 0
TAD [240
PRINTC
ISZ ERRSW
JMP .-6
CRLF
NLN, TAD EOF
SZA CLA
FATAL9, FATAL /PROGRAM INCOMPLETE!
DCA CC
TAD (5
DCA M
CDF COMPFIELD
TAD I (LC
CDF 0
LOAD
JMS IOUT
PRINTC /CHAR = 240 !
PRINTC
NCH, ISZ CC
TAD EOLN
SNA CLA
JMP .+6
CRLF
L7777
DCA LL
JMS GETC
JMP I XNEXTCH
JMS GETC
PRINTC
JMP I XNEXTCH
LL, 0
PAGE
FIELD 2
*TAB
/ENTRIES FOR PREDEFINED SYMBOLS:
-1; VARIABLE^100+NOTYP; 0040; 0
0; KONSTANT^100+BOOLS; 0040; 0
1; KONSTANT^100+BOOLS; 0040; 1
2; TYPE1^100+REALS; 0040; 1
3; TYPE1^100+CHARS; 0040; 1
4; TYPE1^100+BOOLS; 0040; 1
5; TYPE1^100+INTS; 0040; 1
6; FUNKTION^100+REALS; 0040; 0
7; FUNKTION^100+REALS; 0040; 2
10; FUNKTION^100+BOOLS; 0040; 4
11; FUNKTION^100+CHARS; 0040; 5
12; FUNKTION^100+INTS; 0040; 6
13; FUNKTION^100+CHARS; 0040; 7
14; FUNKTION^100+CHARS; 0040; 10
15; FUNKTION^100+INTS; 0040; 11
16; FUNKTION^100+INTS; 0040; 12
17; FUNKTION^100+REALS; 0040; 13
20; FUNKTION^100+REALS; 0040; 14
21; FUNKTION^100+REALS; 0040; 15
22; FUNKTION^100+REALS; 0040; 16
23; FUNKTION^100+REALS; 0040; 17
24; FUNKTION^100+REALS; 0040; 20
25; FUNKTION^100+BOOLS; 0040; 21
26; FUNKTION^100+BOOLS; 0040; 22
27; PROZEDURE^100+NOTYP; 0040; 1
30; PROZEDURE^100+NOTYP; 0040; 2
31; PROZEDURE^100+NOTYP; 0040; 3
32; PROZEDURE^100+NOTYP; 0040; 4
33; PROZEDURE^100+NOTYP; 0040; 5
34; PROZEDURE^100+NOTYP; 0040; 6
35; FUNKTION^100+REALS; 0040; 23
36; PROZEDURE^100+NOTYP; 0040; 0
FIELD 3
/N A M E S OF S Y M B O L - T A B L E
/THE FOLLOWING NAMES ARE PREDEFINED:
*0
TEXT /@@@@@@@@/
*.-1
TEXT /FALSE@@@/
*.-1
TEXT /TRUE@@@@/
*.-1
TEXT /REAL@@@@/
*.-1
TEXT /CHAR@@@@/
*.-1
TEXT /BOOLEAN@/
*.-1
TEXT /INTEGER@/
*.-1
TEXT /ABS@@@@@/
*.-1
TEXT /SQR@@@@@/
*.-1
TEXT /ODD@@@@@/
*.-1
TEXT /CHR@@@@@/
*.-1
TEXT /ORD@@@@@/
*.-1
TEXT /SUCC@@@@/
*.-1
TEXT /PRED@@@@/
*.-1
TEXT /ROUND@@@/
*.-1
TEXT /TRUNC@@@/
*.-1
TEXT /SIN@@@@@/
*.-1
TEXT /COS@@@@@/
*.-1
TEXT /EXP@@@@@/
*.-1
TEXT /LN@@@@@@/
*.-1
TEXT /SQRT@@@@/
*.-1
TEXT /ARCTAN@@/
*.-1
TEXT /EOF@@@@@/
*.-1
TEXT /EOLN@@@@/
*.-1
TEXT /READ@@@@/
*.-1
TEXT /READLN@@/
*.-1
TEXT /WRITE@@@/
*.-1
TEXT /WRITELN@/
*.-1
TEXT /HALT@@@@/
*.-1
TEXT /ASCII@@@/
*.-1
TEXT /RANDOM@@/
*.-1
TEXT /@@@@@@@@/
/F S Y S AND S E T - C O N S T A N T S
*4000
/----------------
FSYS, ZBLOCK 5 / M U S T BE AT 4000!!!
/----------------
S1US2, ZBLOCK 5
SET0, 0;0;0;0;0
SET1,
CONBGS, 7140;0000;0000;4000;0000
SET2,
TYPBGS, 0000;0000;0006;4000;0000
SET3,
BLOBGS, 0000;0000;0370;2000;0000
SET4,
FACBGS, 7200;0020;0000;4000;0000
SET5,
STATBGS,0000;0000;0000;3740;0000
SET6, 0000;0001;1000;0000;0000
SET7, 0000;0000;0370;6000;0000
SET8, 0140;0000;0000;0000;0000
SET9, 0000;0012;1000;0002;0000
SET10, 0000;0013;0000;0002;0000
SET11, 0000;0001;4000;4020;0000
SET12, 0000;0000;4000;4020;0000
SET13, 0000;0000;0040;4000;0000
SET14, 0000;0010;0000;0000;0000
SET15, 0000;0010;4000;0000;0000
SET16, 0000;0001;0000;4000;0000
SET17, 0000;0000;5000;0000;0000
SET18, 0000;0000;0000;4000;0000
SET19, 0000;0001;4000;4000;0000
SET20, 0000;0000;4000;0000;0000
SET21, 0000;0003;0000;0000;0000
SET22, 0000;0024;2000;0000;0000
SET23, 0000;0011;1000;0000;0000
SET24, 0000;0011;0000;0000;0000
SET25, 7000;0000;0000;0000;0000
SET26, 0037;0000;0000;0000;0000
SET27, 0140;4000;0000;0000;0000
SET28, 0000;3740;0000;0000;0000
SET29, 0000;2000;0400;0000;0000
SET30, 0000;0000;4000;0020;0000
SET31, 0000;0000;4000;3740;0000
SET32, 0000;0000;0000;0001;1000
SET33, 0000;0000;0000;0010;0000
SET34, 0000;0001;1000;0002;0000
SET35, 0000;0000;4000;0004;0000
SET36, 0000;0000;0000;0001;0000
SET37, 0000;0000;0400;0001;6000
SET38, 0000;0000;0000;0001;6000
SET39, 0000;0000;0000;0000;6000
SET40, 0000;0000;0000;7740;0000
SET41, 0000;0020;5000;0000;0000
SET42, 0000;0000;0030;0000;0000
SET43, 0000;0000;0000;2000;0000
SET44, 0000;0000;0370;3740;0000
SET45, 0000;0000;2000;0000;0000
SET46, 0000;0001;4000;4000;0000
/WORD- AND BIT-POSITION TABLE USED BY SET-ROUTINES:
SETTABL,0;4000
0;2000
0;1000
0;0400
0;0200
0;0100
0;0040
0;0020
0;0010
0;0004
0;0002
0;0001
1;4000
1;2000
1;1000
1;0400
1;0200
1;0100
1;0040
1;0020
1;0010
1;0004
1;0002
1;0001
2;4000
2;2000
2;1000
2;0400
2;0200
2;0100
2;0040
2;0020
2;0010
2;0004
2;0002
2;0001
3;4000
3;2000
3;1000
3;0400
3;0200
3;0100
3;0040
3;0020
3;0010
3;0004
3;0002
3;0001
4;4000
4;2000
4;1000
4;0400
4;0200
4;0100
4;0040
4;0020
4;0010
4;0004
4;0002
4;0001
/H A S H - T A B L E OF K E Y W O R D S
HASHTABLE=.
DECIMAL /ADDRESSES SPECIFIED IN DECIMAL!
ZBLOCK 128^4 /CLEAR UNUSED LOCATIONS!
KSYTABLE=. /REMEMBER END OF HASHTABLE
*2^4+HASHTABLE
TEXT /AND/
*5^4+HASHTABLE
TEXT /ARRAY/
*8^4+HASHTABLE
TEXT /DIV/
*9^4+HASHTABLE
TEXT /DO/
*10^4+HASHTABLE
TEXT /END/
*13^4+HASHTABLE
TEXT /FOR/
*16^4+HASHTABLE
TEXT /CASE/
*18^4+HASHTABLE
TEXT /IF/
*19^4+HASHTABLE
TEXT /FUNCTION/
*20^4+HASHTABLE
TEXT /ELSE/
*22^4+HASHTABLE
TEXT /BEGIN/
*27^4+HASHTABLE
TEXT /MOD/
*29^4+HASHTABLE
TEXT /NOT/
*30^4+HASHTABLE
TEXT /OF/
*31^4+HASHTABLE
TEXT /OR/
*37^4+HASHTABLE
TEXT /DOWNTO/
*39^4+HASHTABLE
TEXT /PROCEDUR/
*41^4+HASHTABLE
TEXT /TO/
*44^4+HASHTABLE
TEXT /VAR/
*45^4+HASHTABLE
TEXT /CONST/
*46^4+HASHTABLE
TEXT /REPEAT/
*47^4+HASHTABLE
TEXT /PROGRAM/
*51^4+HASHTABLE
TEXT /TYPE/
*60^4+HASHTABLE
TEXT /UNTIL/
*66^4+HASHTABLE
TEXT /RECORD/
*68^4+HASHTABLE
TEXT /THEN/
*70^4+HASHTABLE
TEXT /WHILE/
/S Y M B O L - V A L U E S OF K E Y W O R D S
*KSYTABLE
ZBLOCK 128 /FOR SAFETY!
PUSHTABLE=. /REMEMBER END OF KSYTABLE
*2+KSYTABLE
ANDSY
*5+KSYTABLE
ARRAYSY
*8+KSYTABLE
IDIVSY
*9+KSYTABLE
DOSY
*10+KSYTABLE
ENDSY
*13+KSYTABLE
FORSY
*16+KSYTABLE
CASESY
*18+KSYTABLE
IFSYM
*19+KSYTABLE
FUNCTIONSY
*20+KSYTABLE
ELSESY
*22+KSYTABLE
BEGINSY
*27+KSYTABLE
IMODSY
*29+KSYTABLE
NOTSY
*30+KSYTABLE
OFSY
*31+KSYTABLE
ORSY
*37+KSYTABLE
DOWNTOSY
*39+KSYTABLE
PROCEDURESY
*41+KSYTABLE
TOSY
*44+KSYTABLE
VARSY
*45+KSYTABLE
CONSTSY
*46+KSYTABLE
REPTSY
*47+KSYTABLE
PROGRAMSY
*51+KSYTABLE
TYPESY
*60+KSYTABLE
UNTILSY
*66+KSYTABLE
RECRDSY
*68+KSYTABLE
THENSY
*70+KSYTABLE
WHILSY
OCTAL
/P U S H T A B L E
/CONTAINS THE NECESSARY INFORMATIONS (USED BY PUSHJUMP AND POPJUMP)
/TO CALL THE COMPILER PROCEDURES RECURSIVELY,
/TO SAVE THE LOCAL VARIABLES, TO PASS EVENTUAL PARAMETERS
/AND RETURN CONTROL TO MAINLINE.
/
/FOR EACH PROCEDURE THERE IS ONE ENTRY OF 4 WORDS:
/WORD 1: ADDRESS OF FIRST LOCAL VARIABLE (= 1ST PARAMETER) - 1
/WORD 2: - NUMBER OF LOCAL VAR'S (LOCATIONS) TO SAVE
/WORD 3: NUMBER OF PARAMETERS ( + FSYS IF 1ST ONE IS A SET)
/ ( + 100*NO. OF VAR-PARAMETERS)
/WORD 4: STARTING ADDRESS OF PROCEDURE
*PUSHTABLE
/BLOCK
ISFUN-1; -5; FSYS+2; XBLOCK
/STATEMENT
0; 0; FSYS; XSTATEMENT
/ASSIGNMENT
LV-1; -6; 2; XASSIGNMENT
/COMPOUNDSTATEMENT
0; 0; 0; XCOMPOUND
/IFSTATEMENT
IXTYP-1; -4; 0; XIFSTATEMENT
/CASESTATEMENT
CASETAB-1; -137; 0; XCASESTATEMENT
/REPEATSTATEMENT
RXTYP-1; -3; 0; XREPEAT
/WHILESTATEMENT
WXTYP-1; -4; 0; XWHILE
/FORSTATEMENT
FXTYP-1; -6; 0; XFORSTATEMENT
/STANDPROC
PRCN-1; -5; 1; XSTPROC
/SELECTOR
SELVAR-1; -5; FSYS+200+1; XSELECT
/CALL
CALI-1; -5; FSYS+1; XCALL
/STANDFCT
FCTN-1; -2; 1; XSTFUN
/FACTOR
FACVAR-1; -3; FSYS+200+1; XFACTOR
/TERM
TRMXTYP-1; -4; FSYS+1; XTERM
/SIMPLEEXPRESSION
SIMXTYP-1; -4; FSYS+1; XSIMPLE
/EXPRESSION
EXPRVAR-1; -6; FSYS+200+1; XEXPRESSION
/CONDECLARE
CONREC-1; 0; 0; XCONDECL
/TYPDECLARE
DECTP-1; 0; 0; XTYPDECL
/VARDECLARE
VARTP-1; 0; 0; XVARDECL
/PRODECLARE
PROFUN-1; -1; 0; XPRODECL
/CONSTANT
CCON-1; 0; FSYS+1; XCONSTANT
/ARRAYTYP
ARRVAR-1; -6; 200+1; XARRAYTYP
/TYPE
TYPVAR-1; -12; FSYS+300+1; XTYPE
/PARAMETERLIST
PARTP-1; 0; 0; XPARAM
/ONECASE
0; 0; 0; XONECASE
/TABLE OF S P E C I A L S Y M B O L S
/
/ONE ENTRY FOR EACH ASCII CHARACTER:
/ =0 ... FOR ILLEGAL CHAR'S
/ >0 ... (=SYMBOL VALUE) FOR SINGLE SPECIAL CHAR'S
/ <0 ... (=JMP TO ROUTINE) FOR DOUBLE CHAR'S, COMMENTS OR STRINGS
CHARTABLE=.
/SPACE ! " # $ % & ' ( ) * + , - . /
0
0
JMPAPOS
NEQ
0
0
ANDSY
0
JMPLPAR
RPARENT
TIMES
PLUS
COMMA
MINUS
JMPPER
RDIVSY
ZBLOCK "9-"0+1 /DIGITS ARE PROCESSED SEPARATELY!
/: ; < = > ? @
JMPCOL
SEMICOLON
JMPLSS
EQL
JMPGTR
0
0
ZBLOCK "Z-"A+1 /LETTERS ARE PROCESSED SEPARATELY!
/[ \ ] ^ _
LBRACK
0
RBRACK
0
0
/C O M P I L E R E R R O R S (NOT FATAL)
/ERROR LINE BUFFER:
ERRLINE,"#-240; "#-240; "#-240; "#-240; "#-240; 0; 0
ZBLOCK LLNG
PAGE
/ERROR ROUTINE:
ERRNO, 0 /ERROR NUMBER
ERRN01, 0 /ERROR NUMBER - UNITS
ERRN10, 0 /ERROR NUMBER - TENS
ERRPOS, 0 /POSITION OF ERROR
ERRP, 0
ERRC, 0
/ERRSW, 0 /IN FIELD 0
/ERRSUM,0 /IN FIELD 6
F3ERROR,0
DCA ERRNO
RDF
TAD (CDF CIF
DCA ERRCDI
CDF 0
TAD I (CC
TAD (ERRLINE+5
DCA ERRPOS
TAD I (ERRSW
CDF SETFIELD
SZA CLA
JMP ERRENT
TAD (ERRLINE+5
DCA ERRP
TAD (-LLNG
DCA ERRC
ISZ ERRP
DCA I ERRP
ISZ ERRC
JMP .-3
ERRENT, TAD ERRNO
DCA ERRN01
DCA ERRN10
JMP .+3
DCA ERRN01
ISZ ERRN10
TAD ERRN01
TAD (-12 /-10
SMA
JMP .-5
CLA
TAD I ERRPOS
SZA CLA
JMP ERREXIT /NO ROOM!
TAD ("#-240
DCA I ERRPOS
ISZ ERRPOS
TAD ERRN10
SNA
JMP .+4
TAD ("0-240
DCA I ERRPOS
ISZ ERRPOS
TAD ERRN01
TAD ("0-240
DCA I ERRPOS
TAD ERRPOS
TAD (-ERRLINE
CMA
CDF 0
DCA I (ERRSW
ERREXIT,CDF ERRFIELD
ISZ I ERRNO /REMEMBER THIS ERROR
ISZ I (ERRSUM /COUNT ERRORS
ERRCDI, CDF CIF 0
JMP I F3ERROR
PAGE
/C O M P I L E R E R R O R S (FATAL)
FATADR, 0
FATPOS, 0
F3FATAL,DCA FATADR
TAD FHEAD
DCA FTEXT
JMS FCRLF
JMS FCRLF
JMS FMESG
TAD FLIST
DCA FATPOS
ISZ FATPOS
TAD I FATPOS
TAD FATADR
SZA CLA
JMP .-4
TAD FATPOS
TAD FMFL
DCA FATPOS
TAD I FATPOS
DCA FTEXT
JMS FMESG
JMS FCRLF
CDF CIF ERRFIELD
JMP I .+1
FXPLAIN
FPRINT, 0
TLS
TSF
JMP .-1
CLA CLL
JMP I FPRINT
FCRLF, 0
TAD F215
JMS FPRINT
TAD F212
JMS FPRINT
JMP I FCRLF
FMESG, 0
TAD I FTEXT
BSW
JMS FASCII
TAD I FTEXT
JMS FASCII
ISZ FTEXT
JMP FMESG+1
FASCII, 0
AND F77
SNA
JMP I FMESG
TAD F240
AND F77
TAD F240
JMS FPRINT
JMP I FASCII
FTEXT, 0
FLIST, FATLIST-1
FMFL, FATMESG-FATLIST
FHEAD, FNN
F215, 215
F212, 212
F240, 240
F77, 77
FATLIST,-FATAL0-1
-FATAL1-1
-FATAL2-1
-FATAL3-1
-FATAL4-1
-FATAL5-1
-FATAL6-1
-FATAL7-1
-FATAL8-1
-FATAL9-1
-FATALC-1
FATMESG,F00
F01
F02
F03
F04
F05
F06
F07
F08
F09
F0C
FNN, TEXT /KOMPILATION ABGEBROCHEN - /
F00, TEXT /MAGNETBAND-LESEFEHLER!/
F01, TEXT /ZU VIELE NAMEN!/
F02, TEXT /ZU VIELE PROZEDUREN UND\ODER RECORDS!/
F03, TEXT /ZU VIELE KONSTANTE!/
F04, TEXT /ZU VIELE ARRAYS!/
F05, TEXT /ZU VIELE UNTERPROGRAMMEBENEN!/
F06, TEXT /PROGRAMM ZU GROSS!/
F07, TEXT /ZU VIEL TEXT!/
F08, TEXT /PROGRAMM ZU KOMPLEX!/
F09, TEXT /PROGRAMM UNVOLLSTAENDIG!/
F0C, TEXT /ZU VIELE CASE-MARKEN!/
PAGE
FIELD 4
/P A G E Z E R O
/LOC'S 1 - 7 USED FOR TEMPORARY STORAGE!
*7
L, 0
*10
/XR10, /AUTOINDEX REGISTER (SEE FIELD 0!)
0
XR11, 0 / --- " ---
XR12, 0
*20
LC, 0 /L O C A T I O N C O U N T E R
TEMP, 0
/I N S T R U C T I O N - R E G I S T E R
/IRX,
0 /LEVEL
/IRY,
0 /ADDRESS OR VALUE
/I N D I C E S T O T A B L E S
/B, /BLOCK TABLE
0001
/T, /SYMBOL TABLE
0037
A, /ARRAY TABLE
0
C, /CONSTANT TABLE
ATAB-1
SX, /STRING TABLE
0
J, 0 /TEMPORARY FOR T
JA, 0 /TEMPORARY FOR A
JB, 0 /TEMPORARY FOR B
LO, 0 /LOW BOUND OF ARRAY
HI, 0 /HIGH BOUND OF ARRAY
SLENG, 0 /LENGTH OF STRING
SY, 0 /C U R R E N T S Y M B O L
ID, 0;0;0;0 /C U R R E N T I D E N T I F I E R
NUM, 0;0;0;0 /C O N S T A N T N U M B E R
*50 /U N P A C K E D E N T R Y OF SYMBOL TABLE
LINK0, 0
OBJ0, 0
TYP0, 0
REF0, 0
NORM0, 0
LEV0, 0
ADR0, 0
JW, 0 /ADDRESS OF ENTRY (REMEMBERED FOR 'WITHEND')
*50 /U N P A C K E D E N T R Y OF ARRAY TABLE
INXTP0, 0
ELTYP0, 0
ELREF0, 0
LOW0, 0
HIGH0, 0
ELSIZ0, 0
SIZE0, 0
JAW, 0 /ADDRESS OF ENTRY (REMEMBERED FOR 'WITHAEND')
/LOCAL VAR'S OF PROCEDURE B L O C K
ISFUN, 0
LEVEL, 0
DX, 0
PRT, 0
PRB, 0
/LOCAL VAR'S OF PROCEDURE F A C T O R
FACVAR, 0
FACXTYP,0
FACXREF,0
/LOCAL VAR'S OF PROCEDURE C A L L
CALI, 0
CALXTYP,0
CALXREF,0
CALASTP,0
CALCP, 0
/LOCAL VAR'S OF P U S H J U M P AND P O P J U M P
LOCAL, 0
LENGTH, 0
PARAM, 0
/M A C R O I N S T R U C T I O N S USED BY COMPILER
*100
/ERROR=JMS I . /PARALLEL DEFINED WITH FIELD 0!
XERROR
/FATAL=JMS I . / -"-
XFATAL
/OFTAB=JMS I . / -"-
XOFTAB
/OFATAB=JMS I . / -"-
XOFATAB
/OFBTAB=JMS I . / -"-
XOFBTAB
/OFDISPLAY=JMS I . / -"-
XOFDISP
/TODISPLAY=JMS I . / -"-
XTODISP
/GETCONSTANT=JMS I . / -"-
XOFCONST
TOTAB=JMS I . /PUT INFO INTO SYMBOL TABLE
XTOTAB
TOATAB=JMS I . /PUT INFO INTO ARRAY TABLE
XTOATAB
TOBTAB=JMS I . /PUT INFO INTO BLOCK TABLE
XTOBTAB
WITHTABDO=JMS I . /GET AND UNPACK ENTRY OF SYMBOL TABLE
XWITHTAB
ENDWITH=JMS I . /PACK AND STORE ENTRY OF SYMBOL TABLE
XENDWITH
WITHATABDO=JMS I . /GET AND UNPACK ENTRY OF ARRAY TABLE
XWITHATAB
ENDAWITH=JMS I . /PACK AND STORE ENTRY OF ARRAY TABLE
XENDAWITH
TOCODE=JMS I . /INSERT ADDRESS INTO CODE[LC].IRY
XTOCODE
EMIT=JMS I . /OUTPUT INSTRUCTION OF INTERMEDIATE CODE
XEMIT
ENTER=JMS I . /ENTER ITEM INTO SYMBOL TABLE
XENTER
ENTERVARIABLE=JMS I . /ENTER VARIABLE INTO SYMBOL TABLE
XENTVAR
ENTERARRAY=JMS I . /INTO ARRAY TABLE
XENTARR
ENTERBLOCK=JMS I . /INTO BLOCK TABLE
XENTBLO
ENTERCONSTANT=JMS I . /INTO CONSTANT TABLE
XENTCON
SIGNEDINTEGER=JMS I . /MAKE SIGNED 12-BIT INTEGER OF (NUM)
XSGNINT
TEST=JMS I . /CHECK AND SKIP TO LEGAL FOLLOW SYMBOL
XTEST
TESTSEMICOLON=JMS I .
XTSTSEM
SKIP=JMS I . /SKIP TO LEGAL FOLLOW SYMBOL
XSKIP
SKIPIFSYIN=JMS I . /SKIP NEXT INSTR. IF SY IN SETX
INSET
UNION=JMS I . /SET UNION
XUNION
IFSY=JMS I . /IF SY=SYMBOL THEN NEXT INSTR. ELSE SKIP
XIFSY
IFSYNOT=JMS I . /IF SY<>SYMBOL THEN NEXT INSTR. ELSE SKIP
XIFSYNOT
LOCATE=JMS I . /LOCATE IDENTIFIER IN SYMBOL TABLE
XLOCATE
PUSHJUMP=JMS I . /RECURSIVE PROCEDURE CALL
XPUSHJUMP
POPJUMP=JMS I . /RETURN FROM PROCEDURE
XPOPJUMP
RESULTTYPE=JMS I .
XRESULT
INSYMBOL=JMS I . /SCANNER
XINSYMBOL
/LOCAL VAR'S OF PROCEDURE T Y P E
TYPVAR, 0
TP, 0
RF, 0
SZ, 0
ELTP, 0
ELRF, 0
ELSZ, 0
OFFSET, 0
TT0, 0
TT1, 0
/LOCAL VAR'S OF PROCEDURE W H I L E - STATEMENT
WXTYP, 0
WXREF, 0
WLC1, 0
WLC2, 0
/M A I N P R O G R A M OF COMPILER
*200
MAIN, INSYMBOL
IFSYNOT;PROGRAMSY;JMP MAIN3
INSYMBOL
IFSYNOT;IDENT;JMP MAIN2
INSYMBOL
IFSY;LPARENT;JMP .+4
ERROR;11 /9
JMP ENDOFH
IOFILES,INSYMBOL
IFSY;IDENT;JMP .+4
ERROR;2 /2
SKP
INSYMBOL
IFSY;COMMA;JMP IOFILES
ENDOFH, IFSY;RPARENT;JMP .+4
ERROR;4 /4
SKP
INSYMBOL
MAINBL, TAD (BTAB+3
DCA XR10
CDF TABLEFIELD
TAD T
DCA I XR10
L0001
DCA I XR10
DCA I XR10
DCA I XR10
CDF COMPFIELD
PUSHJUMP;BLOCK
SET44
0 /FALSE
1
IFSYNOT;PERIOD;ERROR;26 /22
EMIT;45 /(37)
CDF CIF ERRFIELD
JMP I (EXPLAIN /DO THE COMPILATION REPORT
MAIN2, ERROR;2 /2
JMP MAINBL
MAIN3, ERROR;3 /3
JMP MAINBL
/EXTENSION OF P U S H J U M P AND P O P J U M P ROUTINES
VARIN, 0
TAD PARAM
AND (700
SNA
JMP I VARIN
BSW
CIA
DCA LENGTH
ISZ LOCAL
L7777
TAD I LOCAL
DCA XR11
TAD I XR11
DCA I XR10
ISZ LENGTH
JMP .-3
JMP I VARIN
VARTM, 0
DCA VARVAR
TAD PARAM
AND (700
SNA
JMP I VARTM
BSW
CIA
DCA VARIN
TAD VARIN
DCA VARVAR
TAD LOCAL
DCA XR10
L7777
TAD I XR10
DCA XR11
DCA XR12 /USE LOC'S 1 - 7 FOR TEMP. STORAGE
TAD I XR10
DCA I XR12
ISZ VARIN
JMP .-3
JMP I VARTM
VAREX, 0
TAD VARVAR
SNA CLA
JMP I VAREX
DCA XR10
TAD I XR10
DCA I XR11
ISZ VARVAR
JMP .-3
JMP I VAREX
VARVAR, 0
PAGE
/PROCEDURE C O N S T A N T
/ ---------------
/
/CALL: PUSHJUMP;CONSTANT
/ SETX
/ C /ADDRESS
/
/LOCAL VAR'S: FSYS
CCON, 0
SIGN, 0
XCONSTANT, DCA I CCON
TAD CCON
DCA XR10
DCA I XR10
DCA I XR10
DCA I XR10
DCA I XR10
TEST;CONBGS;FSYS;62 /50
SKIPIFSYIN;CONBGS
JMP CON6
IFSYNOT;CHARCON;JMP .+4
L0004 /4=CHARS
DCA I CCON
JMP CON4
DCA SIGN /+
SKIPIFSYIN;SET8
JMP CON1
IFSY;MINUS;L4000
DCA SIGN
INSYMBOL
CON1, IFSYNOT;IDENT;JMP CON2
LOCATE
SNA
JMP CON5-1
DCA J
OFTAB;OBJ
MQL
MQA
BSW
AND [77
TAD (-KONSTANT
SNA CLA
JMP .+4
ERROR;31 /25
JMP CON5-1
MQA
AND [77
DCA I CCON
OFTAB;ADR
DCA NUM+3
DCA NUM+2
DCA NUM+1
DCA NUM
L7776 /2=REALS
TAD I CCON
SZA
IAC /1=INTS
SZA CLA
JMP CON3
TAD NUM+3
GETCONSTANT
JMP CON3
CON2, IFSY;INTCON;JMP CON3-2
IFSY;REALCON;JMP CON3-3
SKIP;FSYS;62 /50
JMP CON5
L0001
IAC
DCA I CCON
CON3, TAD SIGN
TAD NUM+1
DCA NUM+1
CON4, TAD CCON
DCA XR10
TAD NUM
DCA I XR10
TAD NUM+1
DCA I XR10
TAD NUM+2
DCA I XR10
TAD NUM+3
DCA I XR10
INSYMBOL
CON5, TEST;FSYS;SET0;6 /6
CON6, POPJUMP;CONSTANT
PAGE
/PROCEDURE A R R A Y T Y P
/ ---------------
/
/CALL: PUSHJUMP;ARRAYTYP
/ REF /ADDRESS
/ SIZE /ADDRESS
/
/LOCAL VAR'S:
ARRVAR, 0
AREF, 0
ARSZ, 0
ALTP, 0
ALRF, 0
ALSZ, 0
LOWB, ZBLOCK 5
HIGHB, ZBLOCK 5
MULT=HIGHB
XARRAYTYP,
PUSHJUMP;CONSTANT
FSYS+SET9
LOWB
L7776 /2=REALS
TAD LOWB
SZA CLA
JMP ARR1
ERROR;33 /27
L0001 /1=INTS
DCA LOWB
DCA LOWB+1
DCA LOWB+2
DCA LOWB+3
DCA LOWB+4
ARR1, IFSY;COLON;JMP .+4
ERROR;15 /13
SKP
INSYMBOL
PUSHJUMP;CONSTANT
FSYS+SET10
HIGHB
TAD HIGHB
CIA
TAD LOWB
SNA CLA
JMP ARR2
ERROR;33 /27
TAD LOWB+1
DCA HIGHB+1
TAD LOWB+2
DCA HIGHB+2
TAD LOWB+3
DCA HIGHB+3
TAD LOWB+4
DCA HIGHB+4
ARR2, SIGNEDINTEGER;LOWB
DCA LO
SIGNEDINTEGER;HIGHB
DCA HI
TAD LOWB
ENTERARRAY
TAD A
DCA AREF
IFSYNOT;COMMA;JMP ARR3
INSYMBOL
TAD [ARRAY
DCA ALTP
PUSHJUMP;ARRAYTYP
ALRF
/ALSZ
JMP ARR4
ARR3, IFSY;RBRACK;JMP .+5
ERROR;14 /12
IFSY;RPARENT;INSYMBOL
IFSY;OFSY;JMP .+4
ERROR;10 /8
SKP
INSYMBOL
PUSHJUMP;TYPE
FSYS
ALTP
/ALRF
/ALSZ
ARR4, TAD AREF
DCA JA
WITHATABDO
TAD LOW0
CIA
TAD HIGH0
IAC
DCA TEMP
TAD ALSZ
CIA
DCA MULT
TAD TEMP
ISZ MULT
JMP .-2
DCA ARSZ
TAD ARSZ
DCA SIZE0
TAD ALTP
DCA ELTYP0
TAD ALRF
DCA ELREF0
TAD ALSZ
DCA ELSIZ0
ENDAWITH
POPJUMP;ARRAYTYP
PAGE
/PROCEDURE T Y P E
/ -------
/
/CALL: PUSHJUMP;TYPE
/ SETX
/ TYP /ADDRESS
/ REF / --"--
/ SIZE / --"--
/
/LOCAL VAR'S (ON PAGE ZERO!):
/ FSYS
/ TYPVAR, 0
/ TP, 0
/ RF, 0
/ SZ, 0
/ ELTP, 0
/ ELRF, 0
/ ELSZ, 0
/ OFFSET, 0
/ TT0, 0
/ TT1, 0
XTYPE, DCA TP /0=NOTYP
DCA RF
DCA SZ
TEST;TYPBGS;FSYS;12 /10
SKIPIFSYIN;TYPBGS
POPJUMP;TYPE
IFSYNOT;IDENT;JMP TYP1
LOCATE
SNA
JMP TYP1-2
DCA J
WITHTABDO
TAD OBJ0
TAD [-TYPE1
SNA CLA
JMP .+4
ERROR;35 /29
JMP TYP1-2
TAD TYP0
DCA TP
TAD REF0
DCA RF
TAD ADR0
DCA SZ
TAD TYP0
SNA CLA
ERROR;36 /30
INSYMBOL
JMP TYP7
TYP1, IFSYNOT;ARRAYSY;JMP TYP2
INSYMBOL
IFSY;LBRACK;JMP .+5
ERROR;13 /11
IFSY;LPARENT;INSYMBOL
TAD [ARRAY
DCA TP
PUSHJUMP;ARRAYTYP
RF
/SZ
JMP TYP7
TYP2, INSYMBOL
ENTERBLOCK
L0006 /6=RECORD
DCA TP
TAD B
DCA RF
TAD LEVEL
TAD [-LMAX
SNA CLA
FATAL5, FATAL
ISZ LEVEL
TAD B
TODISPLAY
DCA OFFSET
TYP3, SKIPIFSYIN;SET46;JMP TYP6
IFSYNOT;IDENT;JMP TYP5
TAD T
DCA TT0
SKP
INSYMBOL
ENTERVARIABLE
IFSY;COMMA;JMP .-4
IFSY;COLON;JMP .+4
ERROR;5 /5
SKP
INSYMBOL
TAD T
DCA TT1
PUSHJUMP;TYPE
FSYS+SET11
ELTP
/ELRF
/ELSZ
TYP4, TAD TT0
CIA
TAD TT1
SPA SNA CLA
JMP TYP5
ISZ TT0
TAD TT0
WITHTABDO
TAD ELTP
DCA TYP0
TAD ELRF
DCA REF0
TAD [40
DCA NORM0
TAD OFFSET
DCA ADR0
TAD OFFSET
TAD ELSZ
DCA OFFSET
ENDWITH
JMP TYP4
PAGE
TYP5, IFSY;ENDSY;JMP TYP6
IFSY;SEMICOLON;JMP .+5
ERROR;16 /14
IFSY;COMMA;INSYMBOL
TEST;SET12;FSYS;6 /6
JMP TYP3
TYP6, TAD RF
DCA JB
TAD OFFSET
TOBTAB;VSIZE
TAD OFFSET
DCA SZ
TOBTAB;PSIZE
INSYMBOL
L7777
TAD LEVEL
DCA LEVEL
TYP7, TEST;FSYS;SET0;6 /6
POPJUMP;TYPE
/PROCEDURE C O N D E C L
/ -------------
/
/CALL: PUSHJUMP;CONDECL /NO ARG'S!
/
/LOCAL VAR'S:
CONREC, ZBLOCK 5
XCONDECL, INSYMBOL
TEST;SET18;BLOBGS;2 /2
CDEC1, IFSYNOT;IDENT;POPJUMP;CONDECL
ENTER;KONSTANT
INSYMBOL
IFSY;EQL;JMP .+5
ERROR;20 /16
IFSY;BECOMES;INSYMBOL
PUSHJUMP;CONSTANT
FSYS+SET19
CONREC
TAD T
WITHTABDO
TAD CONREC /TYP
DCA TYP0
DCA REF0
L7776
TAD CONREC
SZA
IAC
SZA CLA
JMP .+4
ENTERCONSTANT;CONREC
SKP
TAD CONREC+4
DCA ADR0
ENDWITH
TESTSEMICOLON
JMP CDEC1
/PROCEDURE T Y P D E C L
/ -------------
/
/CALL: PUSHJUMP;TYPDECL /NO ARG'S!
/
/LOCAL VAR'S:
DECTP, 0
DECRF, 0
DECSZ, 0
DT1, 0
XTYPDECL, INSYMBOL
TEST;SET18;BLOBGS;2 /2
TDEC1, IFSYNOT;IDENT;POPJUMP;TYPDECL
ENTER;TYPE1
TAD T
DCA DT1
INSYMBOL
IFSY;EQL;JMP .+5
ERROR;20 /16
IFSY;BECOMES;INSYMBOL
PUSHJUMP;TYPE
FSYS+SET19
DECTP
/DECRF
/DECSZ
TAD DT1
WITHTABDO
TAD DECTP
DCA TYP0
TAD DECRF
DCA REF0
TAD DECSZ
DCA ADR0
ENDWITH
TESTSEMICOLON
JMP TDEC1
PAGE
/PROCEDURE P A R A M E T E R L I S T
/ -------------------------
/
/CALL: PUSHJUMP;PARAMETERLIST /NO ARG'S!
/
/LOCAL VAR'S:
PARTP, 0
PARRF, 0
PARSZ, 0
PT0, 0
VALPAR, 0
XPARAM, INSYMBOL
DCA PARTP
DCA PARRF
DCA PARSZ
TEST;SET13;FSYS+SET14;7 /7
PAR1, SKIPIFSYIN;SET13
JMP PAR5
IFSYNOT;VARSY;JMP .+3
INSYMBOL
SKP
TAD [40
DCA VALPAR
TAD T
DCA PT0
ENTERVARIABLE
IFSYNOT;COMMA;JMP .+4
INSYMBOL
ENTERVARIABLE
JMP .-5
IFSY;COLON;JMP .+4
ERROR;5 /5
JMP PAR3
INSYMBOL
IFSY;IDENT;JMP .+4
ERROR;2 /2
JMP PAR2
LOCATE
DCA J
INSYMBOL
TAD J
SNA CLA
JMP PAR2
WITHTABDO
TAD OBJ0
TAD [-TYPE1
SNA CLA
JMP .+4
ERROR;35 /29
JMP PAR2
TAD TYP0
DCA PARTP
TAD REF0
DCA PARRF
TAD VALPAR
SZA CLA
JMP .+3
L0001
SKP
TAD ADR0
DCA PARSZ
PAR2, TEST;SET15;FSYS+SET16;16 /14
PAR3, TAD PT0
CIA
TAD T
SPA SNA CLA
JMP PAR4
ISZ PT0
TAD PT0
WITHTABDO
TAD PARTP
DCA TYP0
TAD PARRF
DCA REF0
TAD VALPAR
DCA NORM0
TAD DX
DCA ADR0
TAD LEVEL
DCA LEV0
ENDWITH
TAD DX
TAD PARSZ
DCA DX
JMP PAR3
PAR4, IFSY;RPARENT;JMP PAR6
IFSY;SEMICOLON;JMP .+5
ERROR;16 /14
IFSY;COMMA;INSYMBOL
TEST;SET13;FSYS+SET14;6 /6
JMP PAR1
PAR5, IFSY;RPARENT;JMP PAR6
ERROR;4 /4
JMP .+6
PAR6, INSYMBOL
TEST;SET17;FSYS;6 /6
POPJUMP;PARAMETERLIST
PAGE
/PROCEDURE V A R D E C L
/ -------------
/
/CALL: PUSHJUMP;VARDECL /NO ARG'S!
/
/LOCAL VAR'S:
VARTP, 0
VARRF, 0
VARSZ, 0
VT0, 0
VT1, 0
XVARDECL, INSYMBOL
IFSYNOT;IDENT;POPJUMP;VARDECL
TAD T
DCA VT0
ENTERVARIABLE
IFSYNOT;COMMA;JMP .+4
INSYMBOL
ENTERVARIABLE
JMP .-5
IFSY;COLON;JMP .+4
ERROR;5 /5
SKP
INSYMBOL
TAD T
DCA VT1
PUSHJUMP;TYPE
FSYS+SET19
VARTP
/VARRF
/VARSZ
VAR1, TAD VT0
CIA
TAD VT1
SPA SNA CLA
JMP VAR2
ISZ VT0
TAD VT0
WITHTABDO
TAD VARTP
DCA TYP0
TAD VARRF
DCA REF0
TAD LEVEL
DCA LEV0
TAD DX
DCA ADR0
TAD [40
DCA NORM0
ENDWITH
TAD VARSZ
TAD DX
DCA DX
JMP VAR1
VAR2, TESTSEMICOLON
JMP XVARDECL+1
/PROCEDURE P R O D E C L
/ -------------
/
/CALL: PUSHJUMP;PRODECL /NO ARG'S!
/
/LOCAL VAR'S: PROFUN, 0 /SEE BELOW!
XPRODECL, IFSY;FUNCTIONSY;L0001
DCA PROFUN
INSYMBOL
IFSY;IDENT;JMP .+7
ERROR;2 /2
DCA ID
DCA ID+1
DCA ID+2
DCA ID+3
TAD (PROZEDURE
TAD PROFUN
DCA .+2
ENTER;00 /FUNCTION OR PROCEDURE
TAD T
DCA J
OFTAB;NORMAL
AND (7737
TAD [40
TOTAB;NORMAL
INSYMBOL
L0001
TAD LEVEL
DCA .+5
PUSHJUMP;BLOCK
FSYS+SET20
PROFUN, 0
0
IFSY;SEMICOLON;JMP .+4
ERROR;16 /14
SKP
INSYMBOL
TAD [40
TAD PROFUN
DCA .+2
EMIT;00 /*** (32) OR (33) ***/
POPJUMP;PRODECL
PAGE
/PROCEDURE S E L E C T O R
/ ---------------
/
/CALL: PUSHJUMP;SELECTOR
/ SETX
/ V /ADDRESS
/
/LOCAL VAR'S: FSYS
SELVAR, 0
SELVTYP,0
SELVREF,0
SELXTYP,0
SELXREF,0
XSELECT, IFSYNOT;PERIOD;JMP SEL2
INSYMBOL /FIELD SELECTOR
IFSY;IDENT;JMP .+4
ERROR;2 /2
JMP SEL5
TAD SELVTYP
TAD [-RECORD
SNA CLA
JMP .+4
ERROR;37 /31
JMP SEL1
TAD SELVREF
OFBTAB;LAST
DCA J
JMS ENTID
JMS CHKID
JMP .+5
OFTAB;LINK
DCA J
JMP .-5
TAD J
SNA CLA
ERROR;0 /0
WITHTABDO
TAD TYP0
DCA SELVTYP
TAD REF0
DCA SELVREF
TAD ADR0
SNA
JMP SEL1
DCA IRY
EMIT;11 /*** (9) ***/
SEL1, INSYMBOL
JMP SEL5
SEL2, IFSYNOT;LBRACK;ERROR;13 /11
SEL3, INSYMBOL
PUSHJUMP;EXPRESSION
FSYS+SET21
SELXTYP
TAD SELVTYP
TAD [-ARRAY
SNA CLA
JMP .+4
ERROR;34 /28
JMP SEL4
TAD SELVREF /ARRAY INDEX
DCA JA
OFATAB;INXTYP
CIA
TAD SELXTYP
SNA CLA
JMP .+4
ERROR;32 /26
JMP SEL6
TAD JA
DCA IRY
OFATAB;ELSIZE
CLL RAR /1 SCOMPARES!
SZA CLA
L0001
TAD (24
DCA .+2
EMIT;00 /*** (20) OR (21) ***/
SEL6, OFATAB;ELTYP
DCA SELVTYP
OFATAB;ELREF
DCA SELVREF
SEL4, IFSY;COMMA;JMP SEL3
IFSY;RBRACK;JMP .+5
ERROR;14 /12
IFSY;RPARENT;INSYMBOL
SEL5, SKIPIFSYIN;SET22
SKP
JMP XSELECT
TEST;FSYS;SET0;6 /6
POPJUMP;SELECTOR
PAGE
/FUNCTION R E S U L T T Y P E
/ -------------------
/
/CALL: TAD XTYP
/ MQL
/ TAD YTYP
/ RESULTTYPE
/
/RETURNS RESULTTYPE IN ACCUMULATOR
XRESULT,0
SZA
SWP
SNA
JMP I XRESULT
TAD [-2 /HERE: XTYP<>0 AND YTYP<>0, XTYP IN AC
SMA SZA
JMP RES33
SWP /YTYP IN AC
TAD [-2
SMA SZA
JMP RES33
SNA /HERE ONLY INTS OR REALS, YTYP IN AC
JMP .+5 /(7777 ... INTS, 0000 ... REALS)
SWP
SZA CLA
JMP RES1 /INTS - INTS
JMP .+5 /REALS - INTS
SWP
SNA CLA
JMP .+5 /REALS - REALS
L0001 /INTS - REALS
DCA IRY
EMIT;32 /*** (26,0) OR (26,1) ***/
IAC
RES1, IAC
JMP I XRESULT
RES33, CLA CLL
ERROR;41 /33
JMP I XRESULT
/PROCEDURE C A L L
/ -------
/
/CALL: PUSHJUMP;CALL
/ SETX
/ I /VALUE
/
/LOCAL VAR'S (ON PAGE ZERO!):
/ FSYS
/ CALI, 0
/ CALXTYP,0
/ CALXREF,0
/ CALASTP,0
/ CALCP, 0
XCALL, TAD CALI
DCA IRY
EMIT;22 /*** (18,I) ***/
TAD CALI
OFTAB;REF
BSW
AND [77
OFBTAB;LASTPAR
DCA CALASTP
TAD CALI
DCA CALCP
IFSYNOT;LPARENT;JMP CAL5
CAL1, INSYMBOL
TAD CALASTP
CIA
TAD CALCP
SMA CLA
JMP CAL4-2
ISZ CALCP
TAD CALCP
OFTAB;NORMAL
AND [40
SNA CLA
JMP CAL3
PUSHJUMP;EXPRESSION /VALUE PARAMETER
FSYS+SET23
CALXTYP
TAD CALCP
OFTAB;TYP
AND [77
DCA TEMP
TAD TEMP
CIA
TAD CALXTYP
SZA CLA
JMP CAL2
TAD CALCP
OFTAB;REF
BSW
AND [77
CIA
TAD CALXREF
SZA CLA
JMP CAL36
TAD CALXTYP
TAD [-ARRAY
SZA
JMP .+5
TAD CALXREF
OFATAB;SIZE
JMP .+7
CLL RAR /6=RECORD
SZA CLA
JMP CAL4
TAD CALXREF
OFBTAB;VSIZE
DCA IRY
EMIT;26 /*** (22,SIZE) ***/
JMP CAL4
CAL2, L7777 /1=INTS
TAD CALXTYP
SZA CLA
JMP .+10
L7776 /2=REALS
TAD TEMP
SZA CLA
JMP .+4
EMIT;32 /*** (26,0) ***/
JMP CAL4
TAD CALXTYP
SZA CLA
JMP CAL36
JMP CAL4
PAGE
CAL3, IFSY;IDENT;JMP .+4 /VARIABLE PARAMETER
ERROR;2 /2
JMP CAL4
LOCATE
DCA J
INSYMBOL
TAD J
SNA CLA
JMP CAL4
WITHTABDO
L7777 /1=VARIABLE
TAD OBJ0
SZA CLA
ERROR;45 /37
TAD TYP0
DCA CALXTYP
TAD REF0
DCA CALXREF
TAD LEV0
DCA IRX
TAD ADR0
DCA IRY
TAD NORM0
SNA CLA
IAC
DCA .+2
EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/
SKIPIFSYIN;SET22
JMP .+5
PUSHJUMP;SELECTOR
FSYS+SET23
CALXTYP
TAD CALCP
OFTAB;TYP
AND [77
CIA
TAD CALXTYP
SZA CLA
JMP CAL36
TAD CALCP
OFTAB;REF
BSW
AND [77
CIA
TAD CALXREF
SZA CLA
CAL36, ERROR;44 /36
JMP CAL4
ERROR;47 /39
CAL4, TEST;SET24;FSYS;6 /6
IFSY;COMMA;JMP CAL1
IFSY;RPARENT;JMP .+4
ERROR;4 /4
SKP
INSYMBOL
CAL5, TAD CALASTP
CIA
TAD CALCP
SPA CLA
ERROR;47 /39
TAD CALI
OFTAB;REF
DCA TEMP
TAD TEMP
BSW
AND [77
OFTAB;PSIZE
TAD (-1
DCA IRY
EMIT;23 /*** (19,PSIZE-1) ***/
TAD TEMP
AND [17
CIA
TAD LEVEL
SPA SNA CLA
JMP CAL6
TAD LEVEL
DCA IRX /SWAPPED CONTENTS OF IRX AND IRY HERE!
TAD TEMP /(SEE INTERPRETER AT I03)
AND [17
DCA IRY
EMIT;3 /*** (3,LEV1,LEV2) ***/
CAL6, POPJUMP;CALL
PAGE
/PROCEDURE S T A N D F C T
/ ---------------
/
/CALL: PUSHJUMP;STANDFCT
/ N /VALUE
/
/LOCAL VAR'S:
FCTN, 0 /NUMBER OF STANDARD FUNCTION
FCTJ, 0
XSTFUN, TAD FCTN
TAD (-20 /-16
SMA SZA CLA
JMP STF17
IFSY;LPARENT;JMP .+4
ERROR;11 /9
SKP
INSYMBOL
TAD J /J IS SET IN FACTOR
DCA FCTJ
PUSHJUMP;EXPRESSION
FSYS+SET14
FACXTYP
TAD FCTJ
DCA J
L7776
TAD FCTN
SMA SZA CLA
JMP STF1
/FCTN: 0,2
L0004 /4=FUNKTION
BSW /(MUST INSERT OBJ
TAD FACXTYP /ALONG WITH TYP!)
TOTAB;TYP
L7776 /2=REALS
TAD FACXTYP
SNA CLA
ISZ FCTN
JMP STF2
STF1, TAD FCTN
TAD (-10
SPA SNA CLA
JMP STF2 /FCTN: 4,5,6,7,8
L7777 /FCTN: 9,10,11, ... ,16
TAD FACXTYP /1=INTS
SNA CLA
EMIT;32 /*** (26,0) ***/
STF2, TAD (TSET
TAD FCTN
DCA TEMP
TAD FACXTYP
STL RAL
TAD (SETTABLE
DCA ARGXTYP
TAD I TEMP
CDF SETFIELD
AND I ARGXTYP
CDF COMPFIELD
SNA CLA
JMP STF3
TAD FCTN
DCA IRY
EMIT;10 /*** (8,N) ***/
JMP .+5
STF3, TAD FACXTYP
SZA CLA
ERROR;60 /48
IFSY;RPARENT;JMP .+4
ERROR;4 /4
SKP
INSYMBOL
STF4, OFTAB;TYP /(J STILL OKAY!?)
AND [77
DCA FACXTYP
POPJUMP;STANDFCT
STF17, TAD FCTN
DCA IRY
EMIT;10 /*** (8,17) OR (8,18) OR (8,19) ***/
JMP STF4
/TABLE OF LEGAL ARGUMENT TYPES:
TSET, 3000 /0
3000
3000 /2
3000
2000 /4
2000 /5
2600 /6
0200 /7
0200 /8
3000 /9
3000
3000
3000
3000
3000
3000
3000 /16
ARGXTYP,0
PAGE
/PROCEDURE F A C T O R
/ -----------
/
/CALL: PUSHJUMP;FACTOR
/ SETX
/ X /ADDRESS
/
/LOCAL VAR'S (ON PAGE ZERO!):
/ FSYS
/ FACVAR, 0
/ FACXTYP,0
/ FACXREF,0
XFACTOR,DCA FACXTYP /0=NOTYP
DCA FACXREF
TEST;FACBGS;FSYS;72 /58
FAC1, SKIPIFSYIN;FACBGS
POPJUMP;FACTOR
IFSYNOT;IDENT;JMP FAC2
LOCATE
DCA J
INSYMBOL
WITHTABDO
TAD OBJ0
TAD (JMP I FACTABL
DCA .+1
HLT
FACTABL,FKON
FVAR
FTYP
FPRO
FFUN
FKON, TAD TYP0
DCA FACXTYP
DCA FACXREF
TAD ADR0
DCA IRY
L7777 /1=INTS
TAD TYP0
CLL RAR /2=REALS
SNA CLA
IAC
TAD (30
DCA .+2
EMIT;00 /*** (24,ADR) OR (25,ADR) ***/
JMP FAC3
FVAR, TAD TYP0
DCA FACXTYP
TAD REF0
DCA FACXREF
TAD LEV0
DCA IRX
TAD ADR0
DCA IRY
SKIPIFSYIN;SET22
JMP FVAR1
TAD NORM0
SNA CLA
IAC
DCA .+2
EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/
PUSHJUMP;SELECTOR
FSYS
FACXTYP
TAD FACXTYP
TAD [-4 /STANTYPS = NOTYP(0) ... CHAR(4)
SPA SNA CLA
EMIT;42 /*** (34) ***/
JMP FAC3
FVAR1, DCA .+11 /F=0
TAD FACXTYP
TAD [-4
SPA SNA CLA
ISZ .+5 /F:=F+1 (IN STANTYPS!)
TAD NORM0
SNA CLA
ISZ .+2 /F:=F+1
EMIT;00 /*** (F,LEV,ADR) ***/
JMP FAC3
FTYP,
FPRO, ERROR;54 /44
JMP FAC3
FFUN, TAD TYP0
DCA FACXTYP
TAD LEV0
SNA CLA
JMP STFUN
TAD J
DCA .+4
PUSHJUMP;CALL
FSYS
0
JMP FAC3
STFUN, TAD ADR0
DCA .+3
PUSHJUMP;STANDFCT
0
JMP FAC3
PAGE
FAC2, SKIPIFSYIN;SET25
JMP FAC23
L7776 /2=CHARCON
TAD SY
SNA CLA
JMP FAC21
L0001
TAD SY
DCA FACXTYP /INTS OR REALS
ENTERCONSTANT;NUM-1
DCA IRY
EMIT;31 /*** (25,C) ***/
JMP FAC22
FAC21, L0004 /4=CHARS
DCA FACXTYP
TAD NUM+3
DCA IRY
EMIT;30 /*** (24,NUM) ***/
FAC22, DCA FACXREF
INSYMBOL
JMP FAC3
FAC23, IFSYNOT;LPARENT;JMP FAC24
INSYMBOL
PUSHJUMP;EXPRESSION
FSYS+SET14
FACXTYP
IFSY;RPARENT;JMP .+4
ERROR;4 /4
JMP FAC3
INSYMBOL
JMP FAC3
FAC24, IFSYNOT;NOTSY;JMP FAC3
INSYMBOL
PUSHJUMP;FACTOR
FSYS
FACXTYP
L7775 /3=BOOLS
TAD FACXTYP
SZA CLA
JMP .+4
EMIT;43 /*** (35) ***/
JMP FAC3
TAD FACXTYP
SZA CLA
ERROR;40 /32
FAC3, TEST;FSYS;FACBGS;6 /6
JMP FAC1
PAGE
/PROCEDURE T E R M
/ -------
/
/CALL: PUSHJUMP;TERM
/ SETX
/ X /ADDRESS
/
/LOCAL VAR'S: FSYS
TRMXTYP,0
TRMYTYP,0
TRMYREF,0
TRMOP, 0
XTERM, TAD TRMXTYP
DCA .+4
PUSHJUMP;FACTOR
FSYS+SET26
0
TRM1, SKIPIFSYIN;SET26
POPJUMP;TERM
TAD SY
DCA TRMOP
INSYMBOL
PUSHJUMP;FACTOR
FSYS+SET26
TRMYTYP
TAD TRMOP
TAD (JMP I OPTABL-TIMES
DCA .+1
HLT
OPTABL, XTIMES
XIDIV
XRDIV
XIMOD
XAND
XTIMES, TAD I TRMXTYP
MQL
TAD TRMYTYP
RESULTTYPE
DCA I TRMXTYP
TAD I TRMXTYP
SNA
JMP TRM1 /NOTYP
TAD (-1
SZA CLA
TAD (12-3 /REALS
TAD (3 /INTS
DCA IRY
EMIT;60 /*** (48,3) OR (48,12) ***/
JMP TRM1
XRDIV, L0001
DCA IRY
L7777 /1=INTS
TAD I TRMXTYP
SZA CLA
JMP .+5
EMIT;32 /*** (26,1) ***/
L0002 /2=REALS
DCA I TRMXTYP
DCA IRY
L7777 /1=INTS
TAD TRMYTYP
SZA CLA
JMP .+5
EMIT;32 /*** (26,0) ***/
L0002 /2=REALS
DCA TRMYTYP
L7776 /2=REALS
TAD I TRMXTYP
SZA CLA
JMP XNOTYP-1
L7776
TAD TRMYTYP
SZA CLA
JMP XNOTYP-1
TAD (13
DCA IRY
EMIT;60 /*** (48,13) ***/
JMP TRM1
XIDIV,
XIMOD, L7777 /1=INTS
TAD I TRMXTYP
SZA CLA
JMP XNOTYP-2
L7777
TAD TRMYTYP
SZA CLA
JMP XNOTYP-2
TAD TRMOP
CLL RAR
DCA IRY
EMIT;60 /*** (48,4) OR (48,5) ***/
JMP TRM1
XAND, L7775 /3=BOOLS
TAD I TRMXTYP
SZA CLA
JMP XNOTYP
L7775
TAD TRMYTYP
SZA CLA
JMP XNOTYP
EMIT;64 /*** (52) ***/
JMP TRM1
CLA IAC
IAC
XNOTYP, TAD [40
DCA ERRTYP
TAD I TRMXTYP
SZA CLA
TAD TRMYTYP
SZA CLA
ERROR
ERRTYP, 00 /32, 33 OR 34
DCA I TRMXTYP /0=NOTYP
JMP TRM1
PAGE
/PROCEDURE S I M P L E E X P R E S S I O N
/ -------------------------------
/
/CALL: PUSHJUMP;SIMPLEEXPRESSION
/ SETX
/ X /ADDRESS
/
/LOCAL VAR'S: FSYS
SIMXTYP,0
SIMYTYP,0
SIMYREF,0
SIMOP, 0
XSIMPLE,SKIPIFSYIN;SET8
JMP SIM1
TAD SY
DCA SIMOP
INSYMBOL
TAD SIMXTYP
DCA .+4
PUSHJUMP;TERM
FSYS+SET8
0
L7776 /2=REALS
TAD I SIMXTYP
SPA SNA CLA
JMP .+4
ERROR;41 /33
JMP SIM2
TAD SIMOP
TAD (-MINUS
SNA CLA
EMIT;44 /*** (36) ***/
JMP SIM2
SIM1, TAD SIMXTYP
DCA .+4
PUSHJUMP;TERM
FSYS+SET27
0
SIM2, SKIPIFSYIN;SET27
POPJUMP;SIMPLEEXPRESSION
TAD SY
DCA SIMOP
INSYMBOL
PUSHJUMP;TERM
FSYS+SET27
SIMYTYP
TAD SIMOP
TAD (-ORSY
SZA CLA
JMP SIM3
L7775 /3=BOOLS
TAD I SIMXTYP
SZA CLA
JMP NOTBOOL
L7775
TAD SIMYTYP
SZA CLA
JMP NOTBOOL
EMIT;63 /*** (51) ***/
JMP SIM2
NOTBOOL,TAD I SIMXTYP
SZA CLA
TAD SIMYTYP
SZA CLA
ERROR;40 /32
DCA I SIMXTYP /0=NOTYP
JMP SIM2
SIM3, TAD I SIMXTYP
MQL
TAD SIMYTYP
RESULTTYPE
DCA I SIMXTYP
TAD I SIMXTYP
SNA
JMP SIM2
CLL RAR /NOW: 0...INTS, 1...REALS!
SZA CLA
TAD (7
TAD [-4
TAD SIMOP /+ ... 5, - ... 6
DCA IRY
EMIT;60 /*** (48,1) OR (48,2) OR (48,10) OR (48,11) ***/
JMP SIM2
PAGE
/PROCEDURE E X P R E S S I O N
/ -------------------
/
/CALL: PUSHJUMP;EXPRESSION
/ SETX
/ X /ADDRESS
/
/LOCAL VAR'S: FSYS
EXPRVAR,0
XTYP, 0
XREF, 0
YTYP, 0
YREF, 0
OP, 0
XEXPRESSION,
PUSHJUMP;SIMPLEEXPRESSION
FSYS+SET28
XTYP
SKIPIFSYIN;SET28
POPJUMP;EXPRESSION
TAD SY
DCA OP
INSYMBOL
PUSHJUMP;SIMPLEEXPRESSION
FSYS
YTYP
L7776 /2=REALS
TAD XTYP
SNA
JMP EXPR1
TAD [-2 /2+2=4=CHARS
SMA SZA CLA
JMP EXPR1
TAD XTYP
CIA
TAD YTYP
SNA CLA
JMP IEXPR
EXPR1, L0001
DCA IRY
L7777 /1=INTS
TAD XTYP
SZA CLA
JMP .+5
EMIT;32 /*** (26,1) ***/
L0002 /2=REALS
DCA XTYP
DCA IRY
L7777 /1=INTS
TAD YTYP
SZA CLA
JMP .+5
EMIT;32 /*** (26,0) ***/
L0002 /2=REALS
DCA YTYP
L7776 /2=REALS
TAD XTYP
SZA CLA
JMP ILLTYP
L7776
TAD YTYP
SZA CLA
JMP ILLTYP
REXPR, L0001
IEXPR, TAD (61
DCA I61R62
TAD OP
TAD (TAD RELTABL-EQL
DCA .+1
0000 /TAD RELTABL (MODIFIED INSTR.!)
DCA IRY
EMIT
I61R62, 00 /*** (49,OP) OR (50,OP) ***/
EXPR3, L0003 /3=BOOLS
DCA XTYP
POPJUMP;EXPRESSION
ILLTYP, ERROR;43 /35
JMP EXPR3
RELTABL,SZA
SNA
SPA SNA
SPA
SMA
SMA SZA
PAGE
/PROCEDURE A S S I G N M E N T
/ -------------------
/
/CALL: PUSHJUMP;ASSIGNMENT
/ LEV /VALUE
/ ADR /- " -
/
/LOCAL VAR'S:
LV, 0
AD, 0
AXTYP, 0
AXREF, 0
AYTYP, 0
AYREF, 0
XASSIGNMENT,
OFTAB;TYP /J IS SET IN STATEMENT
AND [77
DCA AXTYP
OFTAB;REF
BSW
AND [77
DCA AXREF
TAD LV
DCA IRX
TAD AD
DCA IRY
OFTAB;NORMAL
AND [40
SNA CLA
IAC
DCA .+2
EMIT;00 /*** (0,LV,AD) OR (1,LV,AD) ***/
SKIPIFSYIN;SET22
JMP .+5
PUSHJUMP;SELECTOR
FSYS+SET29
AXTYP
IFSY;BECOMES;JMP .+5
ERROR;63 /51
IFSY;EQL;INSYMBOL
PUSHJUMP;EXPRESSION
FSYS
AYTYP
TAD AXTYP
CIA
TAD AYTYP
SZA CLA
JMP ASS1
TAD AXTYP
TAD [-ARRAY
SPA CLA
JMP ASS2-2
TAD AXREF /ARRAY- OR RECORD-VARIABLE
CIA
TAD AYREF
SZA CLA
JMP ASSERR
TAD AXTYP
TAD [-ARRAY
SZA CLA
JMP .+5
TAD AXREF /ARRAY
OFATAB;SIZE
JMP .+4
TAD AXREF /RECORD
OFBTAB;VSIZE
DCA IRY
EMIT;27 /*** (23,SIZE) ***/
JMP ASS2
ASS1, L7776 /2=REALS
TAD AXTYP
SZA CLA
JMP ASS3
L7777 /1=INTS
TAD AYTYP
SZA CLA
JMP ASS3
EMIT;32 /*** (26,0) ***/
EMIT;46 /*** (38) ***/
ASS2, POPJUMP;ASSIGNMENT
ASS3, TAD AXTYP
SZA CLA
TAD AYTYP
SZA CLA
ASSERR, ERROR;56 /46
JMP ASS2
/PROCEDURE C O M P O U N D S T A T E M E N T
/ ---------------------------------
/
/CALL: PUSHJUMP;COMPOUNDSTATEMENT /NO ARG'S!
/
/NO LOCAL VAR'S!
XCOMPOUNDSTATEMENT,
INSYMBOL
PUSHJUMP;STATEMENT
FSYS+SET30
SKIPIFSYIN;SET31
JMP CMP1
IFSY;SEMICOLON;JMP XCOMPOUNDSTATEMENT
ERROR;16 /14
JMP XCOMPOUNDSTATEMENT+1
CMP1, IFSY;ENDSY;JMP .+4
ERROR;71 /57
SKP
INSYMBOL
POPJUMP;COMPOUNDSTATEMENT
PAGE
/PROCEDURE C A S E L A B E L
/ -----------------
/
/CALL: JMS CASELABEL /NOT RECURSIVE!
/
/LOCAL VAR'S:
LAB, ZBLOCK 5
CASELABEL, 0
PUSHJUMP;CONSTANT
FSYS+SET6
LAB
TAD LAB
CIA
TAD I CCXTYP
SZA CLA
JMP LABERR
TAD I CCI
DCA XR11
TAD XR11
TAD CLIMIT
SNA CLA
FATALC, FATAL /TOO MUCH CASE-LABELS!
SIGNEDINTEGER;LAB
DCA TEMP
TAD TEMP
DCA I XR11
TAD LC
DCA I XR11
TAD XR11
DCA I CCI
TAD CTABM1
DCA XR11
TAD I XR11
ISZ XR11
CIA
TAD TEMP
SZA CLA
JMP .-5
TAD XR11
CIA
TAD I CCI
SZA CLA
ERROR;1 /1
JMP I CASELABEL
LABERR, ERROR;57 /47
JMP I CASELABEL
CCI, CI
CCXTYP, CXTYP
CLIMIT, -2^CSMAX-CASETAB+1
CTABM1, CASETAB-1
/PROCEDURE C A S E S T A T E M E N T
/ -------------------------
/
/CALL: PUSHJUMP;CASESTATEMENT /NO ARG'S!
/
/LOCAL VAR'S:
CASETAB, ZBLOCK CSMAX^2
EXITTAB, ZBLOCK CSMAX
CXTYP, 0
CXREF, 0
CLC1, 0
CI, 0
CJ, 0
XCASESTATEMENT, INSYMBOL
TAD (CASETAB-1
DCA CI
TAD (EXITTAB-1
DCA CJ
PUSHJUMP;EXPRESSION
FSYS+SET34
CXTYP
L7776 /2=REALS
TAD CXTYP
SNA
JMP .+3
TAD [-2 /2+2=4=CHARS (LAST STANTYP)
SMA SZA CLA
ERROR;27 /23
TAD LC
DCA CLC1
EMIT;14 /*** (12) ***/
IFSY;OFSY;JMP CAS1
ERROR;10 /8
SKP
CAS1, INSYMBOL
PUSHJUMP;ONECASE
IFSY;SEMICOLON;JMP CAS1
TAD CLC1
TOCODE
TAD (CASETAB-1
DCA XR11
CAS2, TAD XR11
CIA
TAD CI
SNA CLA
JMP CAS3
TAD I XR11
DCA IRY
EMIT;15 /*** (13) ***/
JMP CAS2
CAS3, EMIT;12 /*** (10) ***/
TAD (EXITTAB-1
DCA XR11
CAS4, TAD XR11
CIA
TAD CJ
SNA CLA
JMP CAS5
TAD I XR11
TOCODE
JMP CAS4
CAS5, IFSY;ENDSY;JMP .+4
ERROR;71 /57
SKP
INSYMBOL
POPJUMP;CASESTATEMENT
/PROCEDURE O N E C A S E
/ -------------
/
/CALL: PUSHJUMP;ONECASE /NO ARG'S!
/
/NO LOCAL VAR'S! (USES SOME VAR'S OF 'CASESTATEMENT')
XONECASE, SKIPIFSYIN;CONBGS
JMP ONE2
SKP
ONE1, INSYMBOL
JMS CASELABEL
IFSY;COMMA;JMP ONE1
IFSY;COLON;JMP .+4
ERROR;5 /5
SKP
INSYMBOL
PUSHJUMP;STATEMENT
FSYS+SET30
ISZ CJ
TAD LC
DCA I CJ
EMIT;12 /*** (10) ***/
ONE2, POPJUMP;ONECASE
PAGE
/PROCEDURE I F S T A T E M E N T
/ ---------------------
/
/CALL: PUSHJUMP;IFSTATEMENT /NO ARG'S!
/
/LOCAL VAR'S:
IXTYP, 0
IXREF, 0
ILC1, 0
ILC2, 0
XIFSTATEMENT,
INSYMBOL
PUSHJUMP;EXPRESSION
FSYS+SET32
IXTYP
TAD IXTYP
SNA
JMP .+5
TAD [-BOOLS
SZA CLA
ERROR;21 /17
TAD LC
DCA ILC1
EMIT;13 /*** (11) ***/
IFSY;THENSY;JMP .+5
ERROR;64 /52
IFSY;DOSY;INSYMBOL
PUSHJUMP;STATEMENT
FSYS+SET33
IFSYNOT;ELSESY;JMP IF1
INSYMBOL
TAD LC
DCA ILC2
EMIT;12 /*** (10) ***/
TAD ILC1
TOCODE /*** CODE[ILC1] := LC ***/
PUSHJUMP;STATEMENT
FSYS
TAD ILC2
TOCODE /*** CODE[ILC2] := LC ***/
POPJUMP;IFSTATEMENT
IF1, TAD ILC1
JMP .-4 /*** CODE[ILC1] := LC ***/
/PROCEDURE R E P E A T S T A T E M E N T
/ -----------------------------
/
/CALL: PUSHJUMP;REPEATSTATEMENT /NO ARG'S!
/
/LOCAL VAR'S:
RXTYP, 0
RXREF, 0
RLC1, 0
XREPEAT,TAD LC
DCA RLC1
INSYMBOL
PUSHJUMP;STATEMENT
FSYS+SET35
SKIPIFSYIN;SET31
JMP REP1
IFSY;SEMICOLON;JMP XREPEAT+2
ERROR;16 /14
JMP XREPEAT+3
REP1, IFSYNOT;UNTILSY;JMP REPERR
INSYMBOL
PUSHJUMP;EXPRESSION
FSYS
RXTYP
TAD RXTYP
SNA
JMP .+5
TAD [-BOOLS
SZA CLA
ERROR;21 /17
TAD RLC1
DCA IRY
EMIT;13 /*** (11,RLC1) ***/
JMP .+3
REPERR, ERROR;65 /53
POPJUMP;REPEATSTATEMENT
/PROCEDURE W H I L E S T A T E M E N T
/ ---------------------------
/
/CALL: PUSHJUMP;WHILESTATEMENT /NO ARG'S!
/
/LOCAL VAR'S (ON PAGE ZERO!):
/ WXTYP, 0
/ WXREF, 0
/ WLC1, 0
/ WLC2, 0
XWHILESTATEMENT,
INSYMBOL
TAD LC
DCA WLC1
PUSHJUMP;EXPRESSION
FSYS+SET36
WXTYP
TAD WXTYP
SNA
JMP .+5
TAD [-BOOLS
SZA CLA
ERROR;21 /17
TAD LC
DCA WLC2
EMIT;13 /*** (11) ***/
IFSY;DOSY;JMP .+4
ERROR;66 /54
SKP
INSYMBOL
PUSHJUMP;STATEMENT
FSYS
TAD WLC1
DCA IRY
EMIT;12 /*** (10,WLC1) ***/
TAD WLC2
TOCODE /*** CODE[WLC2] := LC ***/
POPJUMP;WHILESTATEMENT
PAGE
/PROCEDURE F O R S T A T E M E N T
/ -----------------------
/
/CALL: PUSHJUMP;FORSTATEMENT /NO ARG'S!
/
/LOCAL VAR'S:
FXTYP, 0
FXREF, 0
CVT, 0
FLC1, 0
FLC2, 0
FF, 0
XFORSTATEMENT,
INSYMBOL
IFSYNOT;IDENT;JMP FOR2
LOCATE
DCA J
INSYMBOL
TAD J
SNA CLA
JMP FOR1+2
WITHTABDO
L7777 /1=VARIABLE
TAD OBJ0
SZA CLA
JMP FOR1
TAD TYP0
DCA CVT
TAD LEV0
DCA IRX
TAD ADR0
DCA IRY
EMIT;0 /*** (0,LEV,ADR) ***/
L7776 /2=REALS
TAD CVT
SNA
JMP .+3
TAD [-2 /2+2=4=CHARS (LAST STANTYP)
SMA SZA CLA
ERROR;22 /18
JMP FOR3
FOR1, ERROR;45 /37
L0001 /1=INTS
DCA CVT
JMP FOR3
FOR2, SKIP;FSYS+SET37;2 /2
FOR3, IFSYNOT;BECOMES;JMP FOR4
INSYMBOL
PUSHJUMP;EXPRESSION
FSYS+SET38
FXTYP
TAD FXTYP
CIA
TAD CVT
SZA CLA
ERROR;23 /19
JMP FOR5
FOR4, SKIP;FSYS+SET38;63 /51
FOR5, TAD (16 /14
DCA FF
SKIPIFSYIN;SET39
JMP FOR6
IFSY;DOWNTOSY;L0002
TAD (16
DCA FF
INSYMBOL
PUSHJUMP;EXPRESSION
FSYS+SET36
FXTYP
TAD FXTYP
CIA
TAD CVT
SZA CLA
ERROR;23 /19
JMP FOR7
FOR6, SKIP;FSYS+SET36;67 /55
FOR7, TAD LC
DCA FLC1
TAD FF
DCA .+2
EMIT;00 /*** (14) OR (16) ***/
IFSY;DOSY;JMP .+4
ERROR;66 /54
SKP
INSYMBOL
TAD LC
DCA FLC2
PUSHJUMP;STATEMENT
FSYS
TAD FLC2
DCA IRY
L0001
TAD FF
DCA .+2
EMIT;00 /*** (15,FLC2) OR (17,FLC2) ***/
TAD FLC1
TOCODE /*** CODE[FLC1] := LC ***/
POPJUMP;FORSTATEMENT
PAGE
/PROCEDURE S T A N D P R O C
/ -----------------
/
/CALL: PUSHJUMP;STANDPROC
/ I /VALUE
/
/LOCAL VAR'S:
PRCN, 0
SPXTYP, 0
SPXREF, 0
SPYTYP, 0
SPYREF, 0
XSTPROC,TAD PRCN
TAD (JMP I STPRTAB-1
DCA .+1
HLT
STPRTAB,SPREAD
SPREAD
SPWRITE
SPWRITE
SPHALT
SPASCII
SPREAD, IFSYNOT;LPARENT;JMP SPR3
SPR1, INSYMBOL
IFSY;IDENT;JMP .+4
ERROR;2 /2
JMP SPR2
LOCATE
DCA J
INSYMBOL
TAD J
SNA CLA
JMP SPR2
WITHTABDO
L7777 /1=VARIABLE
TAD OBJ0
SNA CLA
JMP .+4
ERROR;45 /37
JMP SPR2
TAD TYP0
DCA SPXTYP
TAD REF0
DCA SPXREF
TAD LEV0
DCA IRX
TAD ADR0
DCA IRY
TAD NORM0
SNA CLA
IAC
DCA .+2
EMIT;00 /*** (0,LEV,ADR) OR (1,LEV,ADR) ***/
SKIPIFSYIN;SET22
JMP .+5
PUSHJUMP;SELECTOR
FSYS+SET24
SPXTYP
L7775 /3=BOOLS
TAD SPXTYP
SNA
JMP SPR2-2
TAD (-1 /4=CHARS (LAST STANTYP)
SMA SZA CLA
JMP SPR2-2
TAD SPXTYP
DCA IRY
EMIT;33 /*** (27,TYP) ***/
JMP SPR2
ERROR;50 /40
SPR2, TEST;SET24;FSYS;6 /6
IFSY;COMMA;JMP SPR1
IFSY;RPARENT;JMP .+4
ERROR;4 /4
SKP
INSYMBOL
SPR3, L7776 /-2
TAD PRCN
SNA CLA
EMIT;76 /*** (62) ***/
POPJUMP;STANDPROC
SPASCII,IFSYNOT;LPARENT;JMP SPASC2
SPASC1, INSYMBOL
PUSHJUMP;EXPRESSION
FSYS+SET24
SPXTYP
L7777 /1=INTS
TAD SPXTYP
SZA CLA
ERROR;53 /43
EMIT;75 /*** (61) ***/
IFSY;COMMA;JMP SPASC1
IFSY;RPARENT;JMP .+4
ERROR;4 /4
SKP
INSYMBOL
SPASC2, POPJUMP;STANDPROC
SPHALT, EMIT;45 /*** (37) ***/
POPJUMP;STANDPROC
PAGE
SPWRITE,IFSYNOT;LPARENT;JMP SPW5
SPW1, INSYMBOL
IFSYNOT;STRING;JMP SPW2
TAD SLENG
DCA IRY
EMIT;30 /*** (24,SLENG) ***/
TAD NUM+3
DCA STRNUM
INSYMBOL
IFSYNOT;COLON;JMP SPW1A
INSYMBOL
PUSHJUMP;EXPRESSION
FSYS+SET24
SPYTYP
L7777 /1=INTS
TAD SPYTYP
SZA CLA
ERROR;53 /43
JMP .+3
SPW1A, EMIT;30 /*** (24,0) ***/
TAD STRNUM
DCA IRY
EMIT;34 /*** (28,NUM) ***/
JMP SPW4
STRNUM, 0
SPW2, PUSHJUMP;EXPRESSION
FSYS+SET23
SPXTYP
TAD SPXTYP
TAD [-CHARS
SMA SZA CLA
ERROR;51 /41
IFSYNOT;COLON;JMP SPW3+1
INSYMBOL
PUSHJUMP;EXPRESSION
FSYS+SET23
SPYTYP
L7777 /1=INTS
TAD SPYTYP
SZA CLA
ERROR;53 /43
IFSYNOT;COLON;JMP SPW3
L7776 /2=REALS
TAD SPXTYP
SZA CLA
ERROR;52 /42
INSYMBOL
PUSHJUMP;EXPRESSION
FSYS+SET24
SPYTYP
L7777 /1=INTS
TAD SPYTYP
SZA CLA
ERROR;53 /43
EMIT;37 /*** (31) ***/
JMP SPW4
SPW3, L0001
TAD (35
DCA .+4
TAD SPXTYP
DCA IRY
EMIT;00 /*** (29,TYP) OR (30,TYP) ***/
SPW4, IFSY;COMMA;JMP SPW1
IFSY;RPARENT;JMP .+4
ERROR;4 /4
SKP
INSYMBOL
SPW5, TAD PRCN
TAD [-4
SNA CLA
EMIT;77 /*** (63) ***/
POPJUMP;STANDPROC
PAGE
/PROCEDURE S T A T E M E N T
/ -----------------
/
/CALL: PUSHJUMP;STATEMENT
/ SETX
/
/NO LOCAL VAR'S!
XSTATEMENT,
SKIPIFSYIN;SET40
JMP STAT2
IFSYNOT;IDENT;JMP STAT1
LOCATE
DCA J
INSYMBOL
TAD J
SNA CLA
JMP STAT2
WITHTABDO
TAD OBJ0
TAD JMPOBJ
DCA .+1
HLT
OBJTABL,IDCON
IDVAR
IDTYP
IDPRO
IDFUN
JMPOBJ, JMP I OBJTABL
IDCON,
IDTYP, ERROR;55 /45
JMP STAT2
IDVAR, TAD LEV0
DCA .+5
TAD ADR0
DCA .+4
PUSHJUMP;ASSIGNMENT
0
0
JMP STAT2
IDPRO, TAD LEV0
SNA CLA
JMP IDPRO1
TAD J
DCA .+4
PUSHJUMP;CALL
FSYS
0
JMP STAT2
IDPRO1, TAD ADR0
DCA .+3
PUSHJUMP;STANDPROC
0
JMP STAT2
IDFUN, OFDISPLAY
CIA
TAD REF0
SZA CLA
JMP IDTYP
L0001
TAD LEV0
DCA .+3
PUSHJUMP;ASSIGNMENT
0
0000 /ALWAYS 0!
JMP STAT2
STAT1, TAD SY
TAD STATNO
DCA .+2
PUSHJUMP;00
STAT2, TEST;FSYS;SET0;16 /14
POPJUMP;STATEMENT
STATNO, COMPOUNDSTATEMENT-BEGINSY
/PROCEDURE B L O C K
/ ---------
/
/CALL: PUSHJUMP;BLOCK
/ SETX
/ ISFUN /VALUE
/ LEVEL /VALUE
/
/LOCAL VAR'S (ON PAGE ZERO!):
/ FSYS
/ ISFUN, 0
/ LEVEL, 0
/ DX, 0
/ PRT, 0
/ PRB, 0
MAXLEV, -LMAX /CONSTANT
TOFAT5, FATAL5
C0005, 5
BLK1, BLO1
BLK2, BLO2
BLK2M2, BLO2-2
XBLOCK, TAD C0005
DCA DX
TAD T
DCA PRT
TAD LEVEL
TAD MAXLEV
SMA SZA CLA
JMP I TOFAT5 /TOO MUCH LEVELS!
TEST;SET41;FSYS;7 /7
ENTERBLOCK
TAD B
TODISPLAY
TAD B
DCA PRB
TAD PRT
WITHTABDO
DCA TYP0 /0=NOTYP
TAD PRB
DCA REF0
ENDWITH
IFSY;LPARENT;PUSHJUMP;PARAMETERLIST
TAD PRB
DCA JB
TAD T
TOBTAB;LASTPAR
TAD DX
TOBTAB;PSIZE
TAD ISFUN
SNA CLA
JMP I BLK2
IFSYNOT;COLON;JMP I BLK2M2
INSYMBOL
IFSYNOT;IDENT;JMP I BLK1
LOCATE
DCA J
INSYMBOL
TAD J
SNA CLA
JMP BLO2
OFTAB;OBJ
BSW
AND [77
TAD [-2 /2=TYPE1
SNA CLA
JMP .+4
ERROR;35 /29
JMP BLO2
OFTAB;TYP
AND [77
DCA TEMP
TAD TEMP
TAD [-4
SPA SNA CLA
JMP .+4
ERROR;17 /15
JMP BLO2
TAD PRT
DCA J
L0003 /3=PROZEDURE
TAD ISFUN
BSW
TAD TEMP
TOTAB;TYP
JMP BLO2
BLO1, SKIP;FSYS+SET20;2 /2
JMP BLO2
ERROR;5 /5
BLO2, IFSY;SEMICOLON;JMP .+4
ERROR;16 /14
SKP
INSYMBOL
BLO3, IFSY;CONSTSY;PUSHJUMP;CONDECL
IFSY;TYPESY;PUSHJUMP;TYPDECL
IFSY;VARSY;PUSHJUMP;VARDECL
TAD PRB
DCA JB
TAD DX
TOBTAB;VSIZE
BLO4, SKIPIFSYIN;SET42
JMP .+4
PUSHJUMP;PRODECL
JMP BLO4
TEST;SET43;SET44;70 /56
SKIPIFSYIN;STATBGS
JMP BLO3
TAD PRT
DCA J
TAD LC
TOTAB;ADR
BLO5, INSYMBOL
PUSHJUMP;STATEMENT
FSYS+SET30
SKIPIFSYIN;SET31
JMP BLO6
IFSY;SEMICOLON;JMP BLO5
ERROR;16 /14
JMP BLO5+1
BLO6, IFSY;ENDSY;JMP .+4
ERROR;71 /57
SKP
INSYMBOL
TEST;FSYS+SET45;SET0;6 /6
POPJUMP;BLOCK
PAGE
/M A C R O - I N S T R U C T I O N S :
/P U S H J U M P /RECURSIVE CALL OF COMPILER PROCEDURES
/CALL: PUSHJUMP;NAME
/P O P J U M P /RETURN FROM PROCEDURE
/CALL: POPJUMP;NAME
/LOCAL, 0 /START OF LOCAL VARIABLES - 1
/LENGTH, 0 / - NO. OF LOC'S TO PUSH (EXCL. FSYS)
/PARAM, 0 /NO. OF PARAMETERS + 4000 (IF 1ST ONE IS A SET)
PSTART, 0 /STARTING ADDRESS OF PROCEDURE
PPP, 0 /STACK POINTER (POINTS ALWAYS TO 1ST FREE LOC.)
CONTROL,0
CLL RTL
TAD (PUSHTABLE-1
DCA XR10
CDF SETFIELD
TAD I XR10
DCA LOCAL
TAD I XR10
DCA LENGTH
TAD I XR10
DCA PARAM
TAD I XR10
DCA PSTART
CDF COMPFIELD
JMP I CONTROL
PUSH, 0
CDF PUSHFIELD
DCA I PPP
CDF COMPFIELD
ISZ PPP
JMP I PUSH
FATAL8, FATAL /PROGRAMM TOO COMPLEX ---> STACK FULL!
POP, 0
L7777
TAD PPP
DCA PPP
CDF PUSHFIELD
TAD I PPP
CDF COMPFIELD
JMP I POP
XPUSHJ, 0
TAD I XPUSHJ
ISZ XPUSHJ
JMS CONTROL
TAD LENGTH
SNA CLA
JMP PUFSYS
TAD LOCAL
DCA XR10
TAD I XR10
JMS PUSH /PUSH LOCAL VARIABLES (IF ANY)
ISZ LENGTH
JMP .-3
PUFSYS, TAD PARAM
SMA CLA
JMP GETPAR
L3777 /FSYS-1
DCA XR10
TAD [-5
DCA LENGTH
CDF SETFIELD
TAD I XR10
JMS PUSH /PUSH FSYS (IF NECESSARY)
ISZ LENGTH
JMP .-4
GEFSYS, L4000 /GET SET-ARGUMENT (IF PRESENT)
DCA SETA
TAD I XPUSHJ
SPA
DCA SETA /<0: FSYS OR SETX ONLY
TAD SETA />0: FSYS+SETX
DCA SETB
ISZ XPUSHJ
UNION
SETA, FSYS
SETB, SET0
FSYS
GETPAR, TAD PARAM /GET PARAMETERS
AND [77
SNA
JMP RECALL
CIA
DCA LENGTH
TAD LOCAL
DCA XR10
TAD I XPUSHJ
ISZ XPUSHJ
DCA I XR10
ISZ LENGTH
JMP .-4
JMS VARIN /PASS VAR-PARAMETERS (IF ANY)
RECALL, TAD XPUSHJ
JMS PUSH /PUSH RETURN ADDRESS
JMP I PSTART /AND J U M P TO PROCEDURE
XPOPJUMP,0
TAD I XPOPJUMP
JMS CONTROL
JMS POP /GET RETURN ADDRESS
DCA PSTART
TAD PARAM
SMA CLA
JMP POVAR
TAD (FSYS+4
DCA PUSH /(MIS)USE THIS FREE LOC.
TAD [-5
DCA CONTROL
JMS POP /POP FSYS (IF IT WAS PUSHED)
CDF SETFIELD
DCA I PUSH
L7777
TAD PUSH
DCA PUSH
ISZ CONTROL
JMP .-7
CDF COMPFIELD
POVAR, JMS VARTM /TEMP. STORE VAR-PARAMETERS
TAD LENGTH
SNA
JMP I PSTART
CIA
TAD LOCAL
DCA PUSH
JMS POP /POP LOCAL VARIABLES (IF ANY)
DCA I PUSH
L7777
TAD PUSH
DCA PUSH
ISZ LENGTH
JMP .-6
JMS VAREX /PASS VAR-PARAMETERS (IF ANY)
JMP I PSTART /R E T U R N
PAGE
/M A C R O - I N S T R U C T I O N S :
/O F D I S P L A Y /AC := DISPLAY[LEVEL]
/T O D I S P L A Y /DISPLAY[LEVEL] := AC
/O F T A B /AC := TAB[AC].SEL, IF AC=0 GET TAB[J].SEL
/T O T A B /TAB[J].SEL := AC
/O F A T A B /AC := ATAB[AC].SEL, IF AC=0 GET ATAB[JA].SEL
/T O A T A B /ATAB[JA].SEL := AC
/O F B T A B /AC := BTAB[AC].SEL, IF AC=0 GET BTAB[JB].SEL
/T O B T A B /BTAB[JB].SEL := AC
/W I T H T A B D O /GET AND UNPACK TAB[AC] OR TAB[J]
/E N D W I T H /PACK AND STORE UNPACKED ENTRY OF TAB
XOFDISP,0
TAD (DISPLAY
TAD LEVEL
DCA QQ
TAD I QQ
JMP I XOFDISP
XTODISP,0
MQL
TAD (DISPLAY
TAD LEVEL
DCA QQ
MQA
DCA I QQ
JMP I XTODISP
XOFTAB, 0
SNA
TAD J
CLL RTL
TAD I XOFTAB
DCA QQ
ISZ XOFTAB
CDF TABLEFIELD
TAD I QQ
CDF COMPFIELD
JMP I XOFTAB
XTOTAB, 0
MQL
TAD J
CLL RTL
TAD I XTOTAB
DCA QQ
ISZ XTOTAB
CDF TABLEFIELD
MQA
DCA I QQ
CDF COMPFIELD
JMP I XTOTAB
XOFATAB,0
SNA
TAD JA
CLL RAL
CLL RTL
TAD I XOFATAB
DCA QQ
ISZ XOFATAB
CDF TABLEFIELD
TAD I QQ
CDF COMPFIELD
JMP I XOFATAB
QQ=.
XTOATAB,0
MQL
TAD XTOATAB
DCA XTOTAB
TAD JA
CLL RAL
JMP XTOTAB+3
XOFBTAB,0
SNA
TAD JB
CLL RTL
TAD I XOFBTAB
DCA QQ
ISZ XOFBTAB
CDF TABLEFIELD
TAD I QQ
CDF COMPFIELD
JMP I XOFBTAB
XTOBTAB,0
MQL
TAD XTOBTAB
DCA XTOTAB
TAD JB
JMP XTOTAB+3
XWITHTAB,0
SNA
TAD J
CLL RTL
DCA JW /SYMBOL TABLE STARTS AT 0000 !
TAD JW
DCA XR10
CDF TABLEFIELD
TAD I JW
DCA LINK0
TAD I XR10
MQL
MQA
BSW
AND [77
DCA OBJ0
MQA
AND [77
DCA TYP0
TAD I XR10
MQL
MQA
BSW
AND [77
DCA REF0
MQA
AND [40
DCA NORM0
MQA
AND [17
DCA LEV0
TAD I XR10
DCA ADR0
CDF COMPFIELD
JMP I XWITHTAB
XENDWITH,0
TAD JW
DCA XR10
CDF TABLEFIELD
TAD LINK0
DCA I JW
TAD OBJ0
BSW
TAD TYP0
DCA I XR10
TAD REF0
BSW
TAD NORM0
TAD LEV0
DCA I XR10
TAD ADR0
DCA I XR10
CDF COMPFIELD
JMP I XENDWITH
PAGE
/M A C R O - I N S T R U C T I O N S :
/W I T H A T A B D O /GET AND UNPACK ATAB[JA]
/E N D A W I T H /PACK AND STORE UNPACKED ENTRY OF ATAB
/E M I T /EMIT INTERMEDIATE CODE (F,IRX,IRY)
/CALL: EMIT;F
/T O C O D E /CODE[AC].IRY := LC
/E N T E R C O N S T A N T /ENTER REAL OR INTEGER INTO CONSTANT TABLE
/CALL: ENTERCONSTANT;ADDRESS-1
XWITHATAB,0
TAD JA
CLL RAL
CLL RTL
TAD (ATAB
DCA JAW
TAD JAW
DCA XR10
TAD [-7
DCA QR
TAD (DCA INXTP0
DCA .+3
CDF TABLEFIELD
TAD I XR10
0000 /DCA INXTP0 (MODIFIED INSTR.!)
ISZ .-1
ISZ QR
JMP .-4
CDF COMPFIELD
JMP I XWITHATAB
XENDAW, 0
TAD JAW
DCA XR10
TAD [-7
DCA QR
TAD (TAD INXTP0
DCA .+2
CDF TABLEFIELD
0000 /TAD INXTP0 (MODIFIED INSTR.!)
DCA I XR10
ISZ .-2
ISZ QR
JMP .-4
CDF COMPFIELD
JMP I XENDAW
XEMIT, 0
TAD LC
CLL RAL
DCA XTOCODE
TAD I XEMIT /GET OP-CODE
BSW
TAD IRX
CDF CODEFIELD
DCA I XTOCODE
ISZ XTOCODE
TAD IRY
DCA I XTOCODE
CDF COMPFIELD
ISZ LC
TAD LC
TAD (-CMAX
SMA SZA CLA
FATAL6, FATAL /PROGRAM TOO LONG!
DCA IRX
DCA IRY
JMP I XEMIT
QR=.
XTOCODE,0
STL RAL
DCA XEMIT
CDF CODEFIELD
TAD LC
DCA I XEMIT
CDF COMPFIELD
JMP I XTOCODE
CENTRY=XWITHATAB
CTEMP=XENDAW
FOUR=XEMIT
XENTCON,0
TAD I XENTCON
DCA XR10
ISZ XENTCON
TAD C
TAD [-4
DCA CENTRY
TAD SX
STL RAR
CIA
TAD CENTRY
SPA CLA
FATAL3, FATAL /TOO MUCH CONSTANTS!
TAD [-4
DCA FOUR
TAD CENTRY
DCA XR12
TAD I XR10
CDF TABLEFIELD
DCA I XR12
CDF COMPFIELD
ISZ FOUR
JMP .-5
TAD CENTRY
DCA CTEMP
CDF TABLEFIELD
SEARCH, L0004
TAD CTEMP
DCA CTEMP
TAD CTEMP
TAD (-ATAB+1
SMA CLA
JMP NOTFOUND
TAD [-4
DCA FOUR
TAD CENTRY
DCA XR10
TAD CTEMP
DCA XR12
TAD I XR10
CIA
TAD I XR12
SZA CLA
JMP SEARCH
ISZ FOUR
JMP .-6
TAD CTEMP /FOUND
JMP .+4
NOTFOUND,TAD CENTRY
DCA C
TAD CENTRY
CDF COMPFIELD
JMP I XENTCON
PAGE
/M A C R O - I N S T R U C T I O N S :
/E N T E R /ENTER OBJEJT INTO SYMBOL TABLE
/CALL: ENTER;OBJ
/E N T E R V A R I A B L E
/E N T E R B L O C K
/E N T E R A R R A Y
/S I G N E D I N T E G E R /MAKE 12-BIT SIGNED INTEGER OF CONSTANT
/CALL: SIGNEDINTEGER;ADDRESS-1
XENTER, 0
TAD T
TAD (-TMAX
SMA CLA
FATAL1, FATAL /SYMBOL TABLE FULL!
JMS ENTID
OFDISPLAY
OFBTAB;LAST
DCA J
TAD J
DCA L
JMS CHKID
JMP .+5
OFTAB;LINK
DCA J
JMP .-5
TAD J
SNA CLA
JMP .+4
ERROR;1 /1
JMP I XENTER
ISZ T
TAD T
JMS ENTID
TAD I XENTER
MQL
L3777
TAD T
STL RTL /4*T - 1
DCA XR10
CDF TABLEFIELD
TAD L /LINK
DCA I XR10
MQA
BSW /OBJ, TYP (0=NOTYP)
DCA I XR10
TAD LEVEL /REF=0, NORMAL=0, LEVEL
DCA I XR10
DCA I XR10 /ADR=0
CDF COMPFIELD
OFDISPLAY
DCA JB
TAD T
TOBTAB;LAST
JMP I XENTER
XENTVAR,0
IFSY;IDENT;JMP .+4
ERROR;2 /2
JMP I XENTVAR
ENTER;VARIABLE
INSYMBOL
JMP I XENTVAR
XENTBLO,0
TAD B
TAD (-BMAX
SMA CLA
FATAL2, FATAL /TOO MUCH BLOCKS!
ISZ B
TAD B
DCA JB
TOBTAB;LAST
TOBTAB;LASTPAR
JMP I XENTBLO
ATP=XENTBLO
XENTARR,0
DCA ATP
TAD LO
CIA
TAD HI
SPA CLA
ERROR;33 /27
TAD A
TAD (-AMAX
SMA CLA
FATAL4, FATAL
ISZ A
TAD A
DCA JA
TAD ATP
TOATAB;INXTYP
TAD LO
TOATAB;LOW
TAD HI
TOATAB;HIGH
JMP I XENTARR
XSGNINT,0
L0001 /LINK=0!
TAD I XSGNINT
ISZ XSGNINT
DCA XR10
TAD I XR10
SZA
TAD [4000 /LINK=1? ---> NEGATIVE
SZA CLA
JMP ERR49
TAD I XR10
SZA CLA
JMP ERR49
TAD I XR10
SPA
JMP ERR49
SZL
CIA
JMP I XSGNINT
ERR49, ERROR;61 /49
JMP I XSGNINT
PAGE
/-------- D I S P L A Y --------/
/
*7400
IFNZRO DISPLAY-. <PARALLEL DEFINED IN FIELD 0 AND FIELD 4 !!!>
1 /DISPLAY[0] := 1
ZBLOCK 17
/---------------------------------/
/M A C R O - I N S T R U C T I O N S :
/L O C A T E /LOCATE IDENTIFIER IN SYMBOL TABLE
/EXITS WITH TABLE INDEX IN AC
/E N T I D /TAB[AC].NAME := ID
/C H K I D /SKIP IF TAB[J].NAME <> ID
/G E T C O N S T A N T /NUM := CTAB[AC]
XLOCATE,0
TAD LEVEL
DCA L
JMS ENTID
NSCOPE, TAD L
TAD (TAD DISPLAY
DCA .+1
0000 /TAD DISPLAY (MODIFIED INSTR.!)
OFBTAB;LAST
DCA J
JMS CHKID
JMP .+5
OFTAB;LINK
DCA J
JMP .-5
L7777
TAD L
DCA L
TAD J
SZA
JMP I XLOCATE
TAD L
SMA CLA
JMP NSCOPE
ERROR;0 0
JMP I XLOCATE
ENTID, 0
CLL RTL
TAD (-1
DCA XR10
CDF NAMEFIELD
TAD ID
DCA I XR10
TAD ID+1
DCA I XR10
TAD ID+2
DCA I XR10
TAD ID+3
DCA I XR10
CDF COMPFIELD
JMP I ENTID
CHKID, 0
TAD J
CLL RTL
TAD (-1
DCA XR10
CDF NAMEFIELD
TAD I XR10
CIA
TAD ID
SZA CLA
JMP NOTEQL
TAD I XR10
CIA
TAD ID+1
SZA CLA
JMP NOTEQL
TAD I XR10
CIA
TAD ID+2
SZA CLA
JMP NOTEQL
TAD I XR10
CIA
TAD ID+3
SZA CLA
NOTEQL, ISZ CHKID
CDF COMPFIELD
JMP I CHKID
XOFCONST,0
DCA XR10
CDF TABLEFIELD
TAD I XR10
DCA NUM
TAD I XR10
DCA NUM+1
TAD I XR10
DCA NUM+2
TAD I XR10
DCA NUM+3
CDF COMPFIELD
JMP I XOFCONST
XERROR, 0
CLA CLL
TAD I XERROR
CIF SETFIELD
JMS I (F3ERROR
JMP I XERROR
XFATAL, 0
TAD XFATAL
CDF CIF SETFIELD
JMP I (F3FATAL
XINSYMBOL,0
CDF CIF 0
JMP I (INSY0
EXSY3, DCA SY
JMP I XINSYMBOL
PAGE
/M A C R O - I N S T R U C T I O N S :
/T E S T S E M I C O L O N
/S K I P /CALL: SKIP;SETX;N
/T E S T /CALL: TEST;SETX;SETY;N
/S K I P I F S Y I N /CALL: SKIPIFSYIN;SETX
/I F S Y /CALL: IFSY;SYMBOL
/I F S Y N O T /CALL: IFSYNOT;SYMBOL
/U N I O N /CALL: UNION;SET1;SET2;S1US2
XTSTSEM,0
IFSY;SEMICOLON;JMP .+6
ERROR;16 /14
SKIPIFSYIN;SET6
SKP
INSYMBOL
TEST;SET7;FSYS;6 /6
JMP I XTSTSEM
XSKIP, 0
TAD I XSKIP
JMS FSYSUSETX
DCA .+11
ISZ XSKIP
TAD I XSKIP
DCA .+2
ERROR;00 /N
SKP
INSYMBOL
SKIPIFSYIN;00
JMP .-3
JMP I XSKIP
XTEST, 0
TAD I XTEST
JMS FSYSUSETX
DCA .+3
ISZ XTEST
SKIPIFSYIN;00
SKP
JMP XTST1
TAD .-3
DCA S1
TAD I XTEST
JMS FSYSUSETX
DCA S2
ISZ XTEST
UNION
S1, 0
S2, 0
S1US2
TAD I XTEST
DCA .+3
SKIP;S1US2;00 /N
XTST1, ISZ XTEST
JMP I XTEST
FSYSUSETX, 0
SPA
JMP I FSYSUSETX
TAD [4000
DCA .+3
UNION
FSYS
0
S1US2
TAD .-1
JMP I FSYSUSETX
INSET, 0
TAD SY
CLL RAL
TAD (SETTABLE
DCA S2
TAD I INSET
ISZ INSET
CDF SETFIELD
TAD I S2
DCA S1 /ADDRESS OF RELATIVE SET WORD
ISZ S2 /ADDRESS OF BIT POS. REL. TO SY
TAD I S1
AND I S2
SZA CLA
ISZ INSET
CDF COMPFIELD
JMP I INSET
XIFSY, 0
TAD SY
CIA
TAD I XIFSY
SZA CLA
ISZ XIFSY
ISZ XIFSY
JMP I XIFSY
XIFSYNOT,0
TAD SY
CIA
TAD I XIFSYNOT
SNA CLA
ISZ XIFSYNOT
ISZ XIFSYNOT
JMP I XIFSYNOT
XSA=XIFSY /NORMAL LOC.
XSB=XR10 /AUTO INDEX
XSU=XR12 / - " -
FIVE=XIFSYNOT
XUNION, 0
TAD I XUNION
DCA XSA
ISZ XUNION
L7777
TAD I XUNION
DCA XSB
ISZ XUNION
L7777
TAD I XUNION
DCA XSU
ISZ XUNION
TAD [-5
DCA FIVE
CDF SETFIELD
TAD I XSA
CMA
AND I XSB
TAD I XSA
DCA I XSU
ISZ XSA
ISZ FIVE
JMP .-7
CDF COMPFIELD
JMP I XUNION
PAGE
/L O N G E R R O R M E S S A G E S
FIELD 6
*0
ZBLOCK 73 /ERROR COUNTERS
7777 /GUARD
ERRSUM, 0 /NUMBER OF DETECTED ERRORS
*100 /ADDRESS LIST OF ERROR MESSAGES
E00
E01
E02
E03
E04
E05
E06
E07
E08
E09
E10
E11
E12
E13
E14
E15
E16
E17
E18
E19
E20
E21
E22
E23
E24
E25
E26
E27
E28
E29
E30
E31
E32
E33
E34
E35
E36
E37
E38
E39
E40
E41
E42
E43
E44
E45
E46
E47
E48
E49
E50
E51
E52
E53
E54
E55
E56
E57
E58
*200
EXPLAIN,CLA CLL
TAD ERRSUM
SNA CLA
JMP EXCOMP
JMS ECRLF
JMS ECRLF
TAD (EHEAD
DCA ETEXT
JMS EMESG
JMS ECRLF
JMS ECRLF
DCA ENN
SKP
ELINE, ISZ ENN
TAD I ENN
SPA
JMP EXOS8
SNA CLA /SKP CLA ---> PRINT ALL!
JMP ELINE
CLA IAC BSW /L0100
TAD ENN
DCA ETEXT
TAD I ETEXT
DCA ETEXT
JMS EMESG
JMS ECRLF
JMP ELINE
FXPLAIN,CLA CLL
TAD ERRSUM
SZA CLA
JMP EXPLAIN+5
EXOS8, CLA CLL
JMS ECRLF
CDF CIF 0
JMP I (7605
ENN, 0
EXCOMP, JMS ECRLF
JMS ECRLF
TAD (EOKAY
DCA ETEXT
JMS EMESG
JMS ECRLF
JMS ECRLF
CDF CIF 60
JMP I (INIT /INITIALIZE RUNTIME SYSTEM
EPRINT, 0
TLS
TSF
JMP .-1
CLA CLL
JMP I EPRINT
ECRLF, 0
TAD (215
JMS EPRINT
TAD (212
JMS EPRINT
JMP I ECRLF
EMESG, 0
TAD I ETEXT
BSW
JMS EASCII
TAD I ETEXT
JMS EASCII
ISZ ETEXT
JMP EMESG+1
EASCII, 0
AND (77
SNA
JMP I EMESG
TAD (240
AND (77
TAD (240
JMS EPRINT
JMP I EASCII
ETEXT, 0
EOKAY, TEXT /KOMPILATION EINWANDFREI!/
EHEAD, TEXT /ERKLAERUNG DER FEHLER:/
PAGE
/L O N G E R R O R M E S S A G E S
/
/(MADE INVISIBLE BY 'XLIST' TO SAVE PAPER IN ASSEMBLY LISTING!)
XLIST
E00,TEXT / 0 DIESER NAME WURDE NICHT VEREINBART./
E01,TEXT / 1 NAME IM GUELTIGKEITSBEREICH MEHRFACH VEREINBART./
E02,TEXT / 2 NAME FEHLT!/
E03,TEXT / 3 JEDES PROGRAMM MUSS MIT DEM WORTSYMBOL 'PROGRAM' BEGINNE/
*.-1
TEXT /N./
E04,TEXT / 4 RUNDE RECHTSKLAMMER FEHLT (ECKIGE KLAMMER HIER FALSCH)./
E05,TEXT / 5 DOPPELPUNKT FEHLT. IN VEREINBARUNGEN FOLGT DEM : EIN TYP/
*.-1
TEXT /NAME./
E06,TEXT / 6 SYNTAXFEHLER! ANGEZEIGTES SYMBOL HIER NICHT KORREKT./
E07,TEXT / 7 LISTE DER FORMALPARAMETER FEHLERHAFT (NAME ODER WORTSYMB/
*.-1
TEXT /OL 'VAR')./
E08,TEXT / 8 DAS WORTSYMBOL 'OF' FEHLT./
E09,TEXT / 9 RUNDE LINKSKLAMMER FEHLT (ECKIGE KLAMMER HIER FALSCH)./
E10,TEXT /10 TYPVEREINBARUNG FEHLERHAFT (NAME, 'ARRAY' ODER 'RECORD')./
E11,TEXT /11 ECKIGE LINKSKLAMMER FEHLT (RUNDE KLAMMER HIER FALSCH)./
E12,TEXT /12 ECKIGE RECHTSKLAMMER FEHLT (RUNDE KLAMMER HIER FALSCH)./
E13,TEXT /13 SYMBOL .. FEHLT (LEERZEICHEN ZWISCHEN DEN PUNKTEN UNZULA/
*.-1
TEXT /ESSIG)./
E14,TEXT /14 STRICHPUNKT FEHLT!/
E15,TEXT /15 FUNKTIONSWERT KANN NUR VOM TYP INTEGER, REAL, BOOLEAN OD/
*.-1
TEXT /ER CHAR SEIN./
E16,TEXT /16 SYMBOL = FEHLT (IN VEREINBARUNGEN IST := UNZULAESSIG)./
E17,TEXT /17 NACH 'IF', 'WHILE' ODER 'UNTIL' MUSS EIN BOOL'SCHER AUSD/
*.-1
TEXT /RUCK STEHEN./
E18,TEXT /18 ZAEHLVARIABLE BEI 'FOR'-ANWEISUNG MUSS VOM TYP INTEGER, /
*.-1
TEXT /CHAR ODER BOOLEAN SEIN./
E19,TEXT /19 ANFANGSWERT, ENDWERT UND ZAEHLVARIABLE MUESSEN VOM GLEIC/
*.-1
TEXT /HEN TYP SEIN./
E20,TEXT /20 DER STANDARDNAME 'OUTPUT' MUSS IM PROGRAMMKOPF GESCHRIEB/
*.-1
TEXT /EN WERDEN./
E21,TEXT /21 ZAHL IST ZU GROSS! (MAXINT=34359738367, REALS ABS. KLEIN/
*.-1
TEXT /ER ALS 1.0E+308)/
E22,TEXT /22 PUNKT AM PROGRAMMENDE FEHLT! (WORTSYMBOLE 'BEGIN' UND 'E/
*.-1
TEXT /ND' NICHT PAARWEISE?)/
E23,TEXT /23 AUSDRUCK NACH 'CASE' MUSS VOM TYP INTEGER, CHAR ODER BOO/
*.-1
TEXT /LEAN SEIN./
E24,TEXT /24 ILLEGALES ZEICHEN!/
E25,TEXT /25 BEI KONSTANTENVEREINBARUNG MUSS NACH = EINE KONSTANTE OD/
*.-1
TEXT /. EIN KONST.NAME STEHEN./
E26,TEXT /26 DER AUSDRUCK FUER EINEN FELD-INDEX MUSS VOM VEREINBARTEN/
*.-1
TEXT / INDEX-TYP SEIN./
E27,TEXT /27 BEREICHSGRENZEN BEI FELDVEREINBARUNG FEHLERHAFT (UG<=OG?/
*.-1
TEXT / GLEICHER TYP?)/
E28,TEXT /28 JEDE INDIZIERTE VARIABLE MUSS ALS ARRAY VEREINBART WERDE/
*.-1
TEXT /N./
E29,TEXT /29 TYPNAME FEHLT (IN PARAMETERLISTEN SIND ALLG. TYPVEREINBA/
*.-1
TEXT /RUNGEN VERBOTEN)./
E30,TEXT /30 DIESER TYP WURDE NICHT VEREINBART./
E31,TEXT /31 JEDE VARIABLE MIT KOMPONENTEN-SELEKTOR MUSS ALS RECORD V/
*.-1
TEXT /EREINBART WERDEN./
E32,TEXT /32 'NOT', 'AND' UND 'OR' VERLANGEN OPERANDEN VOM TYP BOOLEA/
*.-1
TEXT /N./
E33,TEXT /33 TYP DIESES AUSDRUCKS UNBESTIMMT (GANZES ARRAY IN ARITHM./
*.-1
TEXT /OPERATIONEN UNZULAESSIG)./
E34,TEXT /34 'DIV' UND 'MOD' VERLANGEN OPERANDEN VOM TYP INTEGER./
E35,TEXT /35 TYPEN DER VERGLEICHSOPERANDEN UNVERTRAEGLICH./
E36,TEXT /36 AKTUAL- UND FORMALPARAMETER MUESSEN VOM GLEICHEN TYP SEI/
*.-1
TEXT /N./
E37,TEXT /37 VARIABLE ERFORDERLICH!/
E38,TEXT /38 EIN STRING MUSS MINDESTENS EIN ZEICHEN ENTHALTEN./
E39,TEXT /39 ANZAHL DER AKTUAL- UND FORMALPARAMETER MUSS UEBEREINSTIM/
*.-1
TEXT /MEN./
E40,TEXT /40 STANDARDPROZEDUR READ NUR FUER TYP INTEGER, REAL UND CHA/
*.-1
TEXT /R VORGESEHEN./
E41,TEXT /41 BEI WRITE SIND NUR DIE TYPEN INTEGER, REAL, BOOLEAN UND /
*.-1
TEXT /CHAR ZULAESSIG./
E42,TEXT /42 WRITE(X:M:N) IST NUR FUER WERTE VOM TYP REAL ZULAESSIG./
E43,TEXT /43 M UND N BEI WRITE(X:M:N) MUESSEN INTEGER-AUSDRUECKE SEIN./
E44,TEXT /44 TYP- ODER PROZEDURNAMEN SIND IN AUSDRUECKEN UNZULAESSIG./
E45,TEXT /45 EINE ANWEISUNG KANN NICHT MIT EINEM KONST-, TYP- ODER FU/
*.-1
TEXT /NKTIONSNAMEN BEGINNEN./
E46,TEXT /46 TYPUNVERTRAEGLICHKEIT BEI WERTZUWEISUNG./
E47,TEXT /47 'CASE'-MARKEN MUESSEN VOM GLEICHEN TYP WIE DER 'CASE'-AU/
*.-1
TEXT /SDRUCK SEIN./
E48,TEXT /48 TYP DES ARGUMENTS BEI DIESER STANDARDFUNKTION UNZULAESSI/
*.-1
TEXT /G./
E49,TEXT /49 ARRAY-INDIZES UND 'CASE'-MARKEN SIND AUF -2048 < X < 204/
*.-1
TEXT /8 BEGRENZT./
E50,TEXT /50 EINE KONSTANTE KANN NICHT MIT DEM BEZEICHNETEN SYMBOL BE/
*.-1
TEXT /GINNEN./
E51,TEXT /51 SYMBOL := FEHLT (LEERZEICHEN ZWISCHEN : UND = UNZULAESSI/
*.-1
TEXT /G)./
E52,TEXT /52 DAS WORTSYMBOL 'THEN' FEHLT./
E53,TEXT /53 DAS WORTSYMBOL 'UNTIL' FEHLT./
E54,TEXT /54 DAS WORTSYMBOL 'DO' FEHLT./
E55,TEXT /55 DAS WORTSYMBOL 'TO' ODER 'DOWNTO' FEHLT./
E56,TEXT /56 DAS WORTSYMBOL 'BEGIN' FEHLT./
E57,TEXT /57 DAS WORTSYMBOL 'END' FEHLT./
E58,TEXT /58 EIN FAKTOR MUSS MIT NAME, KONSTANTE, 'NOT' ODER LINKSKLA/
*.-1
TEXT /MMER BEGINNEN./
XLIST
/R U N T I M E E R R O R S (ALWAYS FATAL!)
*DISPLAY
/-------- D I S P L A Y --------/
ZBLOCK 20
/---------------------------------/
XHALT, 0
CLA CLL
TAD ZPRINT
DCA PTPRINT /SWITCH TO TERMINAL OUTPUT!
TAD (HLTLIST-1
DCA HTEXT
ISZ HTEXT
TAD I HTEXT
TAD XHALT
SZA CLA
JMP .-4
ISZ HTEXT
TAD I HTEXT
DCA HTEXT
CRLF
CRLF
JMS HMESG
TAD (HLTAT
DCA HTEXT
JMS HMESG
L0001
DCA M
L7777
TAD PC
LOAD
JMS IOUT
CRLF
JMP I OS8
HMESG, 0
TAD I HTEXT
SNA
JMP I HMESG
BSW
JMS ASCII
TAD I HTEXT
JMS ASCII
ISZ HTEXT
JMP HMESG+1
HTEXT, 0
HLTLIST,-ERROR0-1; HLT0
-ERROR1-1; HLT1
-ERROR2-1; HLT2
-ERROR3-1; HLT3
-ERROR4-1; HLT4
-ERRORA-1; HLTA
-ERRORB-1; HLTB
-ERRORC-1; HLTC
-ERRORD-1; HLTD
HLT0, TEXT /DIVISION BY 0 /
HLT1, TEXT /UNDERFLOW /
HLT2, TEXT /OVERFLOW/
HLT3, TEXT /SQRT/
HLT4, TEXT /LN/
HLTA, TEXT /MEMORY FULL /
HLTB, TEXT / INDEX/
HLTC, TEXT /CASE/
HLTD, TEXT /FILE/
HLTAT, TEXT / ERROR AT /
PAGE
/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
INIT, CLA CLL
CDF 10
TAD I (7621
CDF 0
SNA CLA /IF INPUT FILE SPECIFIED
JMP INITKB
TAD IIDEVH /THEN SETUP FILE INPUT
DCA I (IDEVH
TAD IIBLOCK
DCA I (IBLOCK
TAD (JMP ERRORD
DCA I (FATAL0
TAD (IBUFFER
DCA I (IBP
L7775
DCA I (IC3
TAD (GETC
SKP
INITKB, TAD (XREAD /ELSE KEYBOARD INPUT
DCA I (PTREAD
CDF 10
TAD I (7600
CDF 0
SNA CLA /IF OUTPUT FILE SPECIFIED
JMP INITPR
TAD (I37 /THEN SETUP FILE OUTPUT
DCA I (PTI37
TAD (PUTC
SKP
INITPR, TAD (XPRINT /ELSE USE PRINTER
DCA I (PTPRINT
TAD (XHALT
DCA I (PTHALT /ACTIVATE RUNTIME ERRORS
INITDH, CDF 60 /TRANSFER DEVICE HANDLER(S)
TAD I F6T0 /AND RUNTIME ERROR ROUTINE
CDF 0 /TO THEIR PLACE IN FIELD 0
DCA I F6T0
ISZ F6T0
ISZ C1200
JMP .-6
INITST, TAD (CDF CIF 0 /CHANGE STARTING ADDRESS
DCA I (7744 /TO START OF INTERPRETER
TAD (ISTART
DCA I (7745
DCA I (7746 /CORRECT JOB STATUS WORD
CDF 10 /(MAKE IT RESTARTABLE)
TAD I (7643
AND (20 /CHECK /H - OPTION
CDF CIF 0
SZA CLA
JMP I (7600 /RETURN TO OS8 MONITOR
JMP I (ISTART /START INTERPRETER
IIDEVH, 0
IIBLOCK,0
F6T0, IDEVBUF
C1200, -1200
PAGE