EXTERNALROUTINE ASS11(STRING (63)FILES)
EXTERNALINTEGERFNSPEC SMADDR(INTEGER CHAN, INTEGERNAME LENGTH)
EXTERNALROUTINESPEC DEFINE(STRING (63)S)
EXTERNALINTEGERFNSPEC UINFI(INTEGER I)
SYSTEMSTRINGFNSPEC ITOS(INTEGER I)
DYNAMICSTRING (8) FN SPEC DATE
DYNAMICINTEGERFNSPEC TIME40(INTEGER IN)
DYNAMICINTEGERFNSPEC TIME03(INTEGER IN)
DYNAMICINTEGERFNSPEC TIME45(INTEGER IN)
EXTERNALROUTINESPEC DUMP BIN(HALFINTEGERARRAYNAME CODE, C
INTEGER START, FINISH, STRINGNAME T, INTEGERNAME FLAG)
!!
INTEGERFNSPEC BREAK UP(BYTEINTEGERARRAYNAME LNE)
ROUTINESPEC OCTAL(INTEGER N)
ROUTINESPEC CODE
INTEGERFNSPEC AN OPND(INTEGER TYPE, STRING (80)OPND)
ROUTINESPEC SET DEF(INTEGER DEF, OPN)
ROUTINESPEC USER DEF(STRINGNAME OPND)
ROUTINESPEC LIST LINE(INTEGER LEN)
INTEGERFNSPEC TEST REG(STRING (80)REG)
INTEGERFNSPEC VALUE(STRINGNAME OPND)
INTEGERFNSPEC TEST NAME(STRINGNAME NAME)
INTEGERFNSPEC BRANCH(INTEGER VAL, HERE)
INTEGERFNSPEC NEW TAG(STRINGNAME A)
INTEGERFNSPEC SEARCH(STRINGNAME A)
INTEGERFNSPEC HASH(STRINGNAME IDENT, BYTEINTEGER FLAG)
ROUTINESPEC WORD(STRING (80)OPND)
ROUTINESPEC FAULT(INTEGER I)
ROUTINESPEC ORIGIN
ROUTINESPEC PSEUDO EVAL
ROUTINESPEC GLOBALS
ROUTINESPEC BYTE(STRINGNAME OPND)
ROUTINESPEC PUSH BYTE(INTEGER N)
ROUTINESPEC ABANDON(STRING (60)S)
ROUTINESPEC SYMBOLS
ROUTINESPEC BIN OUT
ROUTINESPEC REPORT FAULTS
ROUTINESPEC START PASS TWO(INTEGER STR)
!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! !!
!! INSTRUCTION DESCRIPTOR !!
!! !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!
RECORDFORMAT INSTF(BYTEINTEGER TYPE, BYTE, HALFINTEGER CODE)
RECORDNAME INST(INSTF)
!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! !!
!! FORMAT OF DES (NAME DESCRIPTOR) !!
!! !!
!! DES_DEF DES_REG (NAME TYPE) !!
!! 0 NOT DEFINED 0 NOT USED !!
!! 1 DEFINED 1 REGISTER !!
!! 2 GLOBAL !!
!! 128 USED 3 USER DEFINED !!
!! 4 LABEL !!
!! 8 OPERATION !!
!! 9 MACRO !!
!! !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!
RECORDFORMAT DESF(BYTEINTEGER DEF, REG, HALFINTEGER VALUE)
RECORDNAME DES(DESF)
OWNHALFINTEGERARRAY DESA(0:4096)=0(4097)
!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! !!
!! UNDEFINED REFERENCE LINK FORMAT AND ASL LIST !!
!! !!
!! FORMAT: !!
!! LINK - LINK TO NEXT UNDEF. REF !!
!! COT - POSITION TO MODIFY IN CORE ARRAY !!
!! OPN - OPERATION TO DO ON WORD +,-,*,/ ETC!!
!! BYT - INDICATES A BYTE OPERATION !!
!! ADD - ADDRESS IN CORE (LISTING USE ONLY) !!
!! LINO - LINE NUMBER OF REFERENCE !!
!! !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!
INTEGER CURR, CURRP, ASLP, CODE1, INPT, STINPT, PASS
INTEGER CODE2
OWNHALFINTEGERARRAY COT(0:200) = 0(201)
OWNINTEGER COREP=0
HALFINTEGERARRAY NAMES(0:2048)
BYTEINTEGERARRAY LETTERS(0:10000)
INTEGER I, J, LEN, POS, BF, OBF, TOP
OWNBYTEINTEGER SBF=0
OWNINTEGER LINO=0
OWNINTEGER ENDFLAG=0
OWNINTEGER FAULTS=0
OWNINTEGER MON=0
OWNINTEGER TIMER = 0
OWNINTEGER LETTERPT=1
OWNHALFINTEGER DOT=0
OWNBYTEINTEGER BRF=1
OWNBYTEINTEGER LIST=0
OWNBYTEINTEGER ASSMF=0
OWNBYTEINTEGER ABSF=0
OWNBYTEINTEGER MODE=0
OWNINTEGER HASHF=0
OWNINTEGER HASHG=0
OWNINTEGER INPUT=0
OWNINTEGER BSW=0
OWNINTEGER BYTEF=0
OWNINTEGER ENF=1
OWNINTEGER DESAP=0
STRING (80)OPER, OPND
STRING (63) FILE2, FILE3
BYTEINTEGERARRAY LNE(0:132)
!!
!!
OWNHALFINTEGERARRAY INSTAA(-1:114)=0, 0, C
X'0101', X'0A00', X'0101', X'0AC0',
X'0101', X'0A80', X'0101', X'0B00',
X'0101', X'0BC0', X'0101', X'0A40',
X'0101', X'0C80', X'0101', X'0CC0',
X'0101', X'0B40', X'0101', X'0B80',
X'0101', X'0C40', X'0101', X'0C00',
X'0101', X'00C0', X'0201', X'1000',
X'0200', X'6000', X'0200', X'E000',
X'0201', X'2000', X'0201', X'5000',
X'0201', X'3000', X'0201', X'4000',
X'0400', X'0100', X'0400', X'0300',
X'0400', X'0200', X'0400', X'8100',
X'0400', X'8000', X'0400', X'8700',
X'0400', X'8600', X'0400', X'8500',
X'0400', X'8400', X'0400', X'0500',
X'0400', X'0400', X'0400', X'0700',
X'0400', X'0600', X'0400', X'8200',
X'0400', X'8300', X'0400', X'8700',
X'0400', X'8600', X'0100', X'0080',
X'0300', X'0800', X'0500', X'8800',
X'0500', X'8900', X'0000', X'0003',
X'0000', X'0004', X'0000', X'0000',
X'0000', X'0001', X'0000', X'0005',
X'0000', X'0002', X'0100', X'0040',
X'0000', X'00A8', X'0000', X'00A4',
X'0000', X'00A2', X'0000', X'00A1',
X'0000', X'00B8', X'0000', X'00B4',
X'0000', X'00B2', X'0000', X'00B1',
X'0300', X'7400'
!!
OWNHALFINTEGERARRAY BUILT IF(1:130)= C
X'0101', X'0000', X'0101', X'0001',
X'0101', X'0002', X'0101', X'0003',
X'0101', X'0004', X'0101', X'0005',
X'0101', X'0006', X'0101', X'0007',
X'0108', X'0001', X'0108', X'0002',
X'0108', X'0003', X'0108', X'0004',
X'0108', X'0005', X'0108', X'0006',
X'0108', X'0007', X'0108', X'0008',
X'0108', X'0009', X'0108', X'000A',
X'0108', X'000B', X'0108', X'000C',
X'0108', X'000D', X'0108', X'000E',
X'0108', X'000F', X'0108', X'0010',
X'0108', X'0011', X'0108', X'0012',
X'0108', X'0013', X'0108', X'0014',
X'0108', X'0015', X'0108', X'0016',
X'0108', X'0017', X'0108', X'0018',
X'0108', X'0019', X'0108', X'001A',
X'0108', X'001B', X'0108', X'001C',
X'0108', X'001D', X'0108', X'001E',
X'0108', X'001F', X'0108', X'0020',
X'0108', X'0021', X'0108', X'0022',
X'0108', X'0023', X'0108', X'0024',
X'0108', X'0025', X'0108', X'0026',
X'0108', X'0027', X'0108', X'0028',
X'0108', X'0029', X'0108', X'002A',
X'0108', X'002B', X'0108', X'002C',
X'0108', X'002D', X'0108', X'002E',
X'0108', X'002F', X'0108', X'0030',
X'0108', X'0031', X'0108', X'0032',
X'0108', X'0033', X'0108', X'0034',
X'0108', X'0035', X'0108', X'0036',
X'0108', X'0037', X'0108', X'0038',
X'0108', X'0039'
CONSTBYTEINTEGERARRAY BUILT IN(1:259)=2, 82, 48, 2, 82, 49, 2 C
, 82, 50, 2,
82, 51, 2, 82, 52, 2, 82, 53, 2, 83,
80, 2, 80, 67, 3, 67, 76, 82, 3, 68,
69, 67, 3, 73, 78, 67, 3, 78, 69, 71,
3, 84, 83, 84, 3, 67, 79, 77, 3, 65,
83, 82, 3, 65, 83, 76, 3, 65, 68, 67,
3, 83, 66, 67, 3, 82, 79, 76, 3, 82,
79, 82, 3, 83, 87, 65, 3, 77, 79, 86,
3, 65, 68, 68, 3, 83, 85, 66, 3, 67,
77, 80, 3, 66, 73, 83, 3, 66, 73, 84,
3, 66, 73, 67, 2, 66, 82, 3, 66, 69,
81, 3, 66, 78, 69, 3, 66, 77, 73, 3,
66, 80, 76, 3, 66, 67, 83, 3, 66, 67,
67, 3, 66, 86, 83, 3, 66, 86, 67, 3,
66, 76, 84, 3, 66, 71, 69, 3, 66, 76,
69, 3, 66, 71, 84, 3, 66, 72, 73, 4,
66, 76, 79, 83, 3, 66, 76, 79, 4, 66,
72, 73, 83, 3, 82, 84, 83, 3, 74, 83,
82, 3, 69, 77, 84, 4, 84, 82, 65, 80,
3, 66, 80, 84, 3, 73, 79, 84, 4, 72,
65, 76, 84, 4, 87, 65, 73, 84, 5, 82,
69, 83, 69, 84, 3, 82, 84, 73, 3, 74,
77, 80, 3, 67, 76, 78, 3, 67, 76, 90,
3, 67, 76, 86, 3, 67, 76, 67, 3, 83,
69, 78, 3, 83, 69, 90, 3, 83, 69, 86,
3, 83, 69, 67, 3, 65, 83, 72, 128
CONSTHALFINTEGERARRAY BUILT HASH(1:65)=1120, 1122, 1124, C
1126, 1128, 1130, 1696, 134, 2020, 1487,
1258, 1999, 249, 237, 505, 2041, 1228, 710, 749, 1261,
1285, 493, 1996, 2047, 487, 2011, 731, 2012, 1188, 463,
1514, 488, 752, 1993, 1994, 2, 3, 740, 1493, 1508,
725, 472, 1660, 996, 1644, 2044, 1273, 999, 1672, 753,
2029, 596, 597, 1970, 508, 1767, 997, 2021, 998, 741,
975, 2000, 976, 719, 1017
!!
!!
CONSTSTRING (8) ARRAY PSEUDO IN(1:23)="ASCII", "BYTE",
"WORD", "PAGE",
"IFDF", "IFNDF",
"GLOBL", "TITLE",
"ABSOLUTE",
"END",
"LIST", "NOLIST",
"MON", "MOFF",
"ENDC", "PLIST",
"EVEN", "EOT",
"TIME40", "TIME03", "TIME45",
"DATE",
"^ ^"
!!
CONSTBYTEINTEGERARRAY TRANS(0:128)=0(32), 6, 2, 0(2), 10, 0, C
3, 0, 1, 0, 4, 6, 0, 5,
8, 7, 9(10), 0(7), 11(26), 0(38)
!! 0 - RUBBISH
!! 1 - (
!! 2 - !
!! 3 - &
!! 4 - *
!! 5 - -
!! 6 - + AND SPACE
!! 7 - /
!! 8 - .
!! 9 - 0-9
!! 10 - $
!! 11 - A-Z
!!
UNLESS FILES->FILES.(",").FILE2.(",").FILE3 START
PRINTSTRING( "PARAMETERS?
")
RETURN
FINISH
DEFINE("ST2,".FILE3.",".ITOS(UINFI(6))) ;! Allow max size listing file
DEFINE("SQ3,".FILE2.",,F80")
DEFINE("SM1,".FILES)
INPT=SMADDR(1, INPUT); INPUT=INPUT+INPT
STINPT=INPT
SELECT OUTPUT(2)
! SET MARGINS(2, 1, 132)
PRINTSTRING("
SOURCE: ".FILES."
BINARY: ".FILE2."
ERCC PDP11 TWO PASS ASSEMBLER VERSION 1.8
")
!!
DESAP=ADDR(DESA(0))
!!
CURR=1; CURRP=2
OBF=0
CYCLE I=0, 1, 2048; NAMES(I)=0; REPEAT
CYCLE I=1, 1, 259; LETTERS(I)=BUILT IN(I); REPEAT
CYCLE I=1, 1, 65
NAMES(BUILT HASH(I))=LETTERPT
LETTERPT=LETTERPT+LETTERS(LETTERPT)+1
J=BUILT HASH(I)<<1
DESA(J)=BUILT IF(I<<1-1)
DESA(J+1)=BUILT IF(I<<1)
REPEAT
PASS=1
LOOP: COREP=0
UNTIL ENDFLAG#0 CYCLE
LEN=0; BF=0; SBF=1
LINO=LINO+1
IF BREAK UP(LNE)<0 START
ENDFLAG=1; FAULT(2); ! NO '.END'
OPER=".END"
FINISH
IF OPER#"" OR OPND#"" START
CODE
IF OBF#0 AND SBF=0 START
FAULT(18); DOT<-DOT+2
! NOT WORD ALIGNED
BSW=0; ! FOR THE SAKE OF LABELS
FINISH
OBF=BF; ! %IF SBF#0 %AND LEN=0 %THEN
! LEN=1
FINISH
IF PASS=2 START
IF LIST=0 OR (LIST=1 AND ASSMF=0) THEN LIST LINE(LEN)
CURR=CURR+(LEN+1)>>1; CURRP=CURR+1
FINISHELSE CURR=1
DOT<-(DOT+LEN)&X'FFFFFFFE'
IF CURR>80 AND BSW=0 START
BIN OUT; ! OUTPUT THIS BLOCK
COREP=DOT; ! RESET THE BEGINNING OF THE
! BLOCK
FINISH
REPEAT
IF PASS=1 START
PASS=PASS+1
INPT=STINPT
LINO=0
START PASS TWO(0)
START PASS TWO(2)
DOT=0
ENDFLAG=0
ASSMF=0; ABSF=0; LIST=0; OBF = 0; BSW = 0
->LOOP
FINISH
SYMBOLS
BIN OUT
REPORT FAULTS
NEWPAGE
SELECT OUTPUT(0)
REPORT FAULTS
RETURN
!!
INTEGERFN BREAK UP(BYTEINTEGERARRAYNAME LNE)
!!
BYTEINTEGERARRAY L(0:100)
INTEGER I, F, LEN, PT, LP, LP2, S, SC, N, PT2
STRINGNAME LAB
BYTEINTEGERNAME STR
OPER=""; OPND=""
F=0; LEN=0
UNTIL I=NL CYCLE
I=BYTEINTEGER(INPT)
INPT=INPT+1; RESULT =-1 IF INPT>INPUT
UNLESS F=0 AND I=' ' AND LEN<=80 START
LEN=LEN+1; L(LEN)=I; F=1
FINISH
REPEAT
LP=1; LP2=1
IF LEN=1 THEN ->FIN; ! BLANK LINE
L(LEN)=NL
PT=1; IF L(1)=';' THEN ->COM
! SEARCH FOR LABELS
PT2=1; I='A'; ! DUMMY
WHILE TRANS(I)>=7 CYCLE
I=L(PT2); PT2=PT2+1
LNE(LP2)=I; LP2=LP2+1
IF I=':' START
L(0)=PT2-2
IF L(0)>6 AND PASS=2 THEN FAULT(10)
LAB==STRING(ADDR(L(0)))
IF ASSMF=0 START
N=NEWTAG(LAB)
SET DEF(4, DOT+BSW)
FINISH
LP=LP2
PT=PT2
->EXIT1
FINISH
REPEAT
EXIT1: ! ON EXIT, NO NAME=>PT=1
! NAME =>PT=PAST LABEL
!
WHILE LP<9 CYCLE ; LNE(LP)=' '; LP=LP+1; REPEAT
WHILE L(PT)=' ' THEN PT=PT+1
! SCAN PAST SPACES
PT2=PT-1; I=TRANS(L(PT))
IF I>9 OR I=8 START
LNE(LP)=L(PT); LP=LP+1
PT=PT+1
WHILE TRANS(L(PT))>=9 CYCLE
LNE(LP)=L(PT); LP=LP+1; PT=PT+1
REPEAT
FINISH
L(PT2)=PT-PT2-1
OPER=STRING(ADDR(L(PT2)))
WHILE LP<17 CYCLE ; LNE(LP)=' '; LP=LP+1; REPEAT
WHILE L(PT)=' ' THEN PT=PT+1
IF OPER=".ASCII" START
! DEAL WITH .ASCII SEPERATELY
SC=L(PT)
LP2=LP-1; STR==LNE(LP2); S=STR
UNTIL (I=SC AND LP2#LP-2) OR I=NL CYCLE
I=L(PT)
PT=PT+1
LNE(LP)=I; LP=LP+1
REPEAT
IF I=SC START
I=L(PT); PT=PT+1
FINISHELSESTART
LNE(LP)=SC; LP=LP+1; FAULT(16)
FINISH
->OPNDL
FINISH
IF L(PT)=';' START
COM: IF PASS=2 START
IF LP#1 START ; ! NOT AT BEGINNING OF LINE
WHILE LP<37 CYCLE ; LNE(LP)=' '; LP=LP+1; REPEAT
FINISH
UNTIL I=NL CYCLE
I=L(PT); PT=PT+1
LNE(LP)=I; LP=LP+1
REPEAT
LP=LP-1; ! DONT OUTPUT THE NL
FINISH
FINISHELSESTART
LP2=LP-1; STR==LNE(LP2); S=STR
UNTIL I=NL CYCLE
I=L(PT); PT=PT+1
IF I#' ' START
LNE(LP)=I; LP=LP+1
FINISH
IF I=';' AND L(PT-2)#'''' THEN EXIT
REPEAT
LP=LP-1; ! DELETE THE NL
OPNDL: STR=LP-LP2-1
OPND=STRING(ADDR(STR))
STR=S
IF I=';' START ; PT=PT-1; ->COM; FINISH
FINISH
FIN: LNE(0)=LP-1
RESULT =0
!!
END
ROUTINE CODE
INTEGER BYTEFLAG
INTEGER N, M
HALFINTEGERNAME CPT
STRING (80)OPND2, OPERN
SWITCH SW(0:5)
CODE1=-1
OPERN=OPER
BYTEFLAG=0
IF BYTEINTEGER(ADDR(OPERN)+4)='B' AND LENGTH(OPERN)=4 START
BYTEFLAG=X'8000'; BYTEINTEGER(ADDR(OPERN))=3
FINISH
IF OPER->(".").OPER START
!! PSEUDO OP OR JUST .
IF OPER="" START
IF BYTEINTEGER(ADDR(OPND)+1)='=' THEN ORIGIN ELSESTART
OPER="."; ->WORDS
FINISH
FINISHELSE PSEUDO EVAL
RETURN
FINISH
WORDS: RETURNIF ASSMF#0
IF OPND->("=").OPND START
USER DEF(OPND)
RETURN
FINISH
SBF=0; ! OPERATION ON BYTE BDRY NOT
! ALLOWED
N=-1
IF OPERN#"" THEN N=HASH(OPERN, 8)
! HASH WILL SET UP DES
IF N=-1 START ; ! OPER NOT RECOGNISED
WORD(OPER."+".OPND)
RETURN
FINISH
INST==RECORD(ADDR(INSTAA(-1))+DES_VALUE<<2)
! DES_VALUE POINTS TO ENTR
CPT==COT(CURR)
CPT=0; ! ZERO, FOR 'OR' LATER
IF BYTEFLAG=1 AND INST_BYTE=0 THEN FAULT(4)
! ILLEGAL 'BYTE'
LEN=2; ! LENGTH OF INSTR
IF OPERN='SWA' THEN BYTEFLAG=0
CPT<-INST_CODE+BYTE FLAG
->SW(INST_TYPE)
!!
SW(1): ! ONE OPERAND
CPT<-CPT!AN OPND(INST_TYPE, OPND)
RETURN
SW(4): ! BRANCH INSTRUCTION
BRF=5
IF PASS=2 START
CPT<-CPT!BRANCH(VALUE(OPND), DOT)
FINISH
BRF=1; RETURN
SW(2): ! TWO OPERANDS
SW(3): ! REG, OPND
UNLESS OPND->OPND.(",").OPND2 START
FAULT(3); LEN=0
FINISHELSESTART
M=AN OPND(INST_TYPE, OPND)
CPT<-CPT!AN OPND(2, OPND2)!M<<6
FINISH
RETURN
SW(5): ! EMT AND TRAP
IF PASS=2 START
IF OPND#"" THEN CPT<-CPT!(VALUE(OPND)&X'FF')
FINISH
SW(0): ! NO OPERANDS
END
INTEGERFN AN OPND(INTEGER TYPE, STRING (80)OPND)
STRING (16)REG, LAST
INTEGER MINUS
MODE=0; MINUS=0; CODE1=0; CODE2=1
IF OPND->("@").OPND THEN MODE=8
IF OPND->("(").REG.(")").LAST START
MODE=MODE!TEST REG(REG); ! DEAL WITH THE REGISTER FIRST
IF LAST="" START
IF MODE>=8 START ; ! @(R) => @0(R)
CODE1=0; CODE2=0; MODE=MODE!X'38'
FINISH
MODE=MODE!8; ! FOR (R)
FINISHELSESTART
IF LAST#"+" THEN FAULT(5)
! '+' ONLY LEGAL CHAR
MODE=MODE!X'10'; ! (R)+ OR @(R)+
FINISH
FINISHELSESTART
IF OPND->("-(").OPND START
IF OPND->REG.(")").LAST START
MODE=MODE+X'20'+TEST REG(REG)
FINISHELSE FAULT(5)
->DUMP
FINISH
UNLESS OPND->("#").OPND START
! NOT MODE 27
CODE1=VALUE(OPND); ! NOTE R WILL RETURN CODE2=1 AND
! MODE 0
IF OPND->("(").REG.(")").LAST START
! +X(R)
MODE=MODE+X'30'+TEST REG(REG)
FAULT(5) IF LAST#""
FINISHELSESTART
IF CODE2=0 START
! NOT A R OPND
IF ABSF=0 OR MODE#0 THEN MODE=MODE!X'37' C
ELSE MODE=MODE!X'1F'
! MODE 67 OR MODE 37 IF .ABSOLUTE
FINISH
FINISH
FINISHELSESTART
! # TYPE OPERAND
CODE1=VALUE(OPND)
MODE=MODE+X'17'
FINISH
FINISH
DUMP:
IF PASS=2 START
IF TYPE#4 START ; ! NOT BRANCH TYPE
IF TYPE=3 AND MODE&X'38'#0 THEN FAULT(7)
! REG OPERATION
IF CODE2=0 START
IF MODE&X'37'=X'37' THEN CODE1=CODE1-(DOT+LEN+2)
! PC INDEXED OPERATION
COT(CURRP)<-CODE1
CURRP=CURRP+1; LEN=LEN+2
FINISH
FINISHELSESTART
! DEAL WITH BRANCH
IF MODE#X'37' THEN FAULT(6)
FINISH
FINISHELSESTART
IF CODE2=0 THEN LEN=LEN+2
FINISH
RESULT =MODE
END
INTEGERFN TEST REG(STRING (80)REG)
INTEGER N
BYTE INTEGER(ADDR(REG))=6 IF LENGTH(REG)>6
N=SEARCH(REG)
IF N<0 START ; FAULT(7); RESULT =0; FINISH
! REGISTER NAME NOT KNOWN
! SEARCH SETS UP DES
IF DES_REG#1 THEN FAULT(7)
DES_DEF=DES_DEF!X'80'
RESULT =DES_VALUE&7
END
INTEGERFN VALUE(STRINGNAME OPND)
INTEGER OC, DEC, OD, J, PT, B, I, TOTAL, OPL, PTX
BYTEINTEGER MINUS, T
SWITCH CHAR TYPE(0:11)
SWITCH DOPER(2:7)
STRING (6)NAME
BYTEINTEGERNAME F
CODE2=0
MINUS=6; PT=1; TOTAL=0; OPL=LENGTH(OPND)
BYTEINTEGER(ADDR(OPND)+OPL+1)=' '
OUTER:
I=BYTEINTEGER(ADDR(OPND)+PT); PT=PT+1
RESULT =TOTAL IF PT>OPL+1
INNER: T=TRANS(I)
->CHAR TYPE(T) IF T<2 OR T>7
!! CHARTYPE(6): ! '+'
!! CHARTYPE(5): ! '-'
!! CHARTYPE(4): ! '*'
!! CHARTYPE(3): ! '&'
!! CHARTYPE(2): ! '!'
MINUS=T; ->OUTER
!!
CHARTYPE(8): ! '.'
J=DOT&X'FFFF'
JT: I=BYTEINTEGER(ADDR(OPND)+PT); PT=PT+1
->ADDON
CHARTYPE(10): ! '$'
CHARTYPE(11): ! NAME SEARCH
B=PT-2; F==BYTEINTEGER(ADDR(OPND)+B)
WHILE TRANS(I)>=9 CYCLE
I=BYTEINTEGER(ADDR(OPND)+PT); PT=PT+1
REPEAT
F=PT-B-2; NAME<-STRING(ADDR(F))
J=TEST NAME(NAME)
->ADDON
CHARTYPE(9): ! SEARCH FOR NUMBER
OC=0; OD=0
PTX=PT-1
WHILE '0'<=I AND I<='9' CYCLE
J=I-'0'
IF J>7 THEN OD=1
I=BYTEINTEGER(ADDR(OPND)+PT); PT=PT+1
REPEAT
IF I#'.' START
IF OD=1 THEN FAULT(8)
FINISHELSESTART
OD=1
FINISH
I=BYTEINTEGER(ADDR(OPND)+PTX); PTX=PTX+1
WHILE PTX<PT CYCLE
J=I-'0'
IF OD=1 THEN OC=OC*10+J ELSEC
OC=OC<<3+J
I=BYTEINTEGER(ADDR(OPND)+PTX); PTX=PTX+1
REPEAT
IF I='.' START
I=BYTEINTEGER(ADDR(OPND)+PT); PT=PT+1
FINISH
J=OC
->ADDON
CHARTYPE(1): ! '('
B=PT-2; F==BYTEINTEGER(ADDR(OPND)+B)
F=OPL-B
OPND=STRING(ADDR(F))
RESULT =TOTAL
CHARTYPE(0): ! THE REST
IF I='''' START
J=BYTEINTEGER(ADDR(OPND)+PT); PT=PT+1
->JT
FINISH
FAULT(11)
RESULT =TOTAL
!!
ADDON:
->DOPER(MINUS)
DOPER(2):TOTAL=TOTAL!J; ->LAST
DOPER(3):TOTAL=TOTAL&J; ->LAST
DOPER(4):TOTAL=TOTAL*J; ->LAST
DOPER(5):TOTAL<-TOTAL+((-J)&X'FFFF'); ->LAST
DOPER(6):TOTAL=TOTAL+J; -> LAST
DOPER(7): TOTAL=TOTAL//J
!!
LAST: MINUS=6
->INNER UNLESS PT>OPL
RESULT =TOTAL
END
INTEGERFN TEST NAME(STRINGNAME NAME)
STRING (6)R
INTEGER N
R<-NAME
N=NEWTAG(R)
N=0
IF DES_REG=1 START
! REGISTER NAME
MODE=MODE!DES_VALUE; ! IE MODE 0+ VALUE REGISTER
CODE2=1; ! NO EXTRA WORD
FINISHELSESTART
IF DES_DEF&X'7F'#0 START ; ! IS DEFINED
IF DES_REG=5 START
INST==RECORD(ADDR(INSTAA(-1))+DES_VALUE<<2)
N=INST_CODE
FINISHELSE N=DES_VALUE&X'FFFF'
FINISHELSESTART
N=-1
IF PASS=2 AND DES_REG#2 THEN FAULT(15); ! NAME NOT DEFINED
FINISH
FINISH
DES_DEF=DES_DEF!X'80'; ! SET NAME=USED
RESULT =N
END
ROUTINE SET DEF(INTEGER DEF, OPN)
INTEGER I
IF DES_DEF&X'7F'=0 START
! NAME NOT DEFINED
DES_VALUE<-OPN
DES_DEF=DES_DEF!1; ! INDICATE DEFINED
DES_REG=DEF; ! SET UP TYPE OF NAME
FINISHELSESTART
! NAME WAS DEFINED BEFORE
IF DES_VALUE&X'FFFF'#OPN&X'FFFF' START
IF DEF=4 AND PASS=2 THEN I=14 ELSE I=1
FAULT(I)
FINISH
! REDEF
FINISH
END
ROUTINE USER DEF(STRINGNAME OPND)
INTEGER N, M, TEMP
RECORDNAME DES2(DESF)
IF LENGTH(OPER)>6 THEN FAULT(10)
POS=NEW TAG(OPER)
DES2==DES
IF OPND->("%").OPND THEN M=1 ELSE M=0
MODE=0
N=VALUE(OPND)
DES==DES2
IF CODE2+M#0 START
! REGISTER
IF M=1 THEN DES_VALUE=N ELSE DES_VALUE=MODE
DES_REG=1; DES_DEF=DES_DEF!1
FINISHELSESTART
! NAME
SET DEF(3, N)
FINISH
END
ROUTINE OCTAL(INTEGER N)
INTEGER I
N<-N&X'FFFF'
CYCLE I=15, -3, 0
PRINTSYMBOL((N>>I)&7+'0')
REPEAT
END
ROUTINE LIST LINE(INTEGER LEN)
ROUTINESPEC NUMBERS
INTEGER I, L2, T
WRITE(LINO, 4)
SPACES(3)
IF ASSMF=0 THEN OCTAL(DOT) ELSE SPACES(6)
L2 = LEN
IF LEN>0 START
I=0; NUMBERS
SPACES(5)
FINISHELSE SPACES(32)
IF TIMER#0 START
IF L2 > 0 START
IF TIMER = 1 THEN T = TIME40(COT(CURR)) ELSE C
T = TIME03(COT(CURR))
PRINTSYMBOL('('); PRINT(T/100, 2, 2)
PRINTSTRING(') ')
FINISH ELSE SPACES(11)
FINISH
PRINTSTRING(STRING(ADDR(LNE(0))))
WHILE LEN>0 CYCLE
NEWLINE; SPACES(14)
NUMBERS
REPEAT
NEWLINE
!!
ROUTINE NUMBERS
INTEGER J
CYCLE J=I, 1, I+2
SPACES(3)
IF LEN>0 THEN OCTAL(COT(CURR+J)) ELSE SPACES(6)
LEN=LEN-2
REPEAT
I=J+1
END
END
!!
INTEGERFN BRANCH(INTEGER VAL, HERE)
HALFINTEGER X
INTEGER Y
X<-VAL-(HERE+2)
!! %IF MON#0 %START
!! PRINTSTRING('BRANCH: X=')
!! OCTAL(X)
!! PRINTSTRING(' VAL,HERE:')
!! OCTAL(VAL)
!! SPACE
!! OCTAL(HERE); !! NEWLINE
!! %FINISH
Y<-X&X'FF00'
IF Y#0 AND Y#X'FF00' START
FAULT(13); X=X'FF'
FINISHELSE X<-X>>1
RESULT =X&X'FF'
END
INTEGERFN NEW TAG(STRINGNAME A)
RESULT =HASH(A, 128+7)
END
!!
INTEGERFN SEARCH(STRINGNAME A)
RESULT =HASH(A, 7)
END
INTEGERFN HASH(STRINGNAME IDENT, BYTEINTEGER FLAG)
!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! !!
!! NOTE: HASH SETS DES AS A SIDE !!
!! EFFECT !!
!! !!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!
OWNINTEGER CNAME=0
INTEGER HASHC, F8
HALFINTEGER Z, A, B, C
BYTEINTEGER(ADDR(IDENT))=6 IF LENGTH(IDENT)>6
F8=FLAG&8
HASHG=HASHG+1
B=0; C=0; A=0
STRING(ADDR(Z)+1)=IDENT
HASHC=((A+B+C)*LENGTH(IDENT))&2047
WHILE NAMES(HASHC)#0 CYCLE
IF IDENT=STRING(ADDR(LETTERS(NAMES(HASHC)))) START
DES==RECORD(DESAP+HASHC<<2)
IF F8!!DES_REG<8 START
RESULT =HASHC
FINISH
!! IE IF F=8 AND AN OPER OR F<8 AND A LABEL ETC
FINISH
HASHC=(HASHC+1)&2047
HASHF=HASHF+1
REPEAT
RESULT =-1 IF FLAG<128; ! SEARCH
NAMES(HASHC)=LETTERPT
DES==RECORD(DESAP+HASHC<<2)
DES_DEF=0; DES_REG=0; DES_VALUE=0
STRING(ADDR(LETTERS(LETTERPT)))=IDENT
LETTERPT=LETTERPT+LENGTH(IDENT)+1
CNAME=CNAME+1
ABANDON("TOO MANY NAMES") IF CNAME>=2047
ABANDON("NAMES TOO LONG") IF LETTERPT>=10000-10
RESULT =HASHC
END
ROUTINE WORD(STRING (80)OPND)
STRING (60)T
OPND=OPND.","
CURRP=CURR
UNTIL OPND="" CYCLE
OPND->T.(",").OPND
IF PASS=2 START
COT(CURRP)<-VALUE(T)
CURRP=CURRP+1
FINISH
LEN=LEN+2
REPEAT
SBF=0; ! WORD ON BYTE BDRY NOT ALLOWED
END
ROUTINE FAULT(INTEGER I)
OWNSTRING (20) ARRAY FLIST(1:19)= C
"NAME REDEFINITION",
"NO .END",
"TOO FEW OPNDS",
"ILLEGAL BYTE INSTR.",
"BRACKETS?",
"TYPE FAULTY",
"ILLEGAL REG. OPER.",
"NOT OCTAL",
"ILLEGAL NAME",
"NAME TOO LONG",
"ILLEGAL EXPR.",
"ILLEGAL NAME",
"OUT OF RANGE",
"PHASE ERROR",
"NAME NOT DEFINED",
"TERMINATOR?",
"TOO BIG",
"ON BYTE BDRY",
"PSEUDO INSTR.?"
STRING (20)S
IF I=10 THEN S="WARNING" ELSE S="FAULT"
WRITE(LINO, 4)
PRINTSTRING(" ** ".S." ** ")
WRITE(I, 2)
PRINTSTRING("(".FLIST(I).")")
FAULTS=FAULTS+1 UNLESS I=10
NEWLINE
END
ROUTINE ORIGIN
INTEGER I
IF ASSMF=0 START
OPND->("=").OPND
I=VALUE(OPND)
IF CODE2=1 START
!! UNDEFINED NAME OR REGISTER- NOT ALLOWED
FAULT(12)
FINISHELSESTART
BIN OUT
DOT<-I
COREP<-DOT
BSW = 0; OBF = 0; ! ALIGN EVEN
IF I&1#0 START
BSW=1; SBF=1; BF=2
COT(CURR)=0
FINISH
FINISH
FINISH
END
INTEGERFN TRY NAME
INTEGER N, DEF
STRING (6)R
R<-OPND
N=NEWTAG(R)
DEF=DES_DEF&X'7F'
DES_DEF=DES_DEF!X'80'
RESULT =DEF
END
ROUTINE PSEUDO EVAL
INTEGER I, Q
SWITCH PS(1:23)
CYCLE I=1, 1, 23; ->EXIT3 IF OPER=PSEUDO IN(I); REPEAT
EXIT3: IF ASSMF=0 OR I>4 START
->PS(I)
PS(19): ! TIME TO BE PRINTED
TIMER = 1
RETURN
PS(20): ! 11/03 TIME
TIMER = 2
RETURN
PS(23): ; ! ILLEGAL
FAULT(19)
->RET
PS(22): ! .DATE
OPND = DATE
PS(1): ! .ASCII
IF LENGTH(OPND)>2 START
! SET FLAG UNLESS IN BYTE INSTR.
IF OBF=0 THEN BSW=0 ELSESTART
LEN=1
IF OBF=2 THEN BSW=1 ELSE CURR=CURR-1
! OBF=2 IS THE .=ODD FLAG
FINISH
CURRP=CURR
CYCLE I=2, 1, LENGTH(OPND)-1
PUSH BYTE(BYTE INTEGER(ADDR(OPND)+I))
REPEAT
BF=BSW; ! NOTE WHETHER ON BDRY OR NOT
FINISH
->RET
PS(2): ! .BYTE
BYTE(OPND)
->RET
PS(3): ! .WORD
WORD(OPND)
->RET
PS(4): ! .PAGE
NEWPAGE IF LIST<2 AND PASS=2
->RET
PS(5): ! .IFDF
Q=0
PS5:
IF ASSMF>0 THEN ASSMF=ASSMF+1 ELSESTART
IF TRY NAME=Q START
ASSMF=1
IF LIST=1 AND PASS=2 START
LIST LINE(0)
PRINTSTRING("***** CONDITIONAL TEXT OMITTED
")
FINISH
FINISH
FINISH
->RET
PS(6): ! .IFNDF
Q=1
->PS5
PS(7): ! .GLOBL
GLOBALS
->RET
PS(8): ! .TITLE
->RET
PS(9): ! .ABSOLUTE
ABSF=1
->RET
PS(10): ! .END
PS(18): ! .EOT
ENDFLAG=1
IF OPND#"" THEN ENF<-VALUE(OPND)
->PS17
PS(11): ! .LIST
LIST=0; ->RET
PS(12): ! .NOLIST
LIST=2; ->RET
PS(13): ! .MON
MON=1; ->RET
PS(14): ! .MOFF
MON=0; ->RET
PS(15): ! .ENDC
IF ASSMF<=1 START
ASSMF=0
FINISHELSE ASSMF=ASSMF-1
->RET
PS(16): ! .PLIST (PARTIAL LIST (NOT
! CONDITIONALS))
LIST=1
->RET
PS(17): ! .EVEN
PS17:
DOT<-(DOT+BSW+1)&X'FFFFFFFE'
OBF=0; BSW=0; ! TO ALIGN LABELS CORRECTLY
FINISH
RET:
END
ROUTINE GLOBALS
INTEGER N
STRING (30)S
IF PASS=1 START
OPND=OPND.","
WHILE OPND->S.(",").OPND CYCLE
N=NEWTAG(S)
COMPILER BUG: ! OVER OPTIMISATION OF 'DES'
DES_REG=2; ! GLOBAL
REPEAT
FINISH
END
ROUTINE BYTE(STRINGNAME OPND)
STRING (60)T
! SET FLAG UNLESS LAST OPRN.
IF OBF=0 THEN BSW=0 ELSESTART
LEN=1
IF OBF=2 THEN BSW=1 ELSE CURR=CURR-1
FINISH
! WAS BYTE
CURRP=CURR
OPND=OPND.","
UNTIL OPND="" CYCLE
BYTEF=2-BSW
OPND->T.(",").OPND
PUSH BYTE(VALUE(T))
REPEAT
BYTEF=0
BF=BSW; ! REMEMBER ALIGNMENT
END
ROUTINE PUSH BYTE(INTEGER N)
HALFINTEGERNAME CPT
IF N>X'FF' THEN FAULT(17)
N<-N&X'FF'
CPT==COT(CURRP)
IF BSW=0 START
CPT=N
FINISHELSESTART
CPT<-CPT!N<<8; CURRP=CURRP+1
FINISH
BSW=BSW!!1; LEN=LEN+1
END
ROUTINE ABANDON(STRING (60)S)
SELECT OUTPUT(0)
PRINTSTRING('
** ABORT ** ".S." **
')
ENDFLAG=2; ! INDISCATE ABNORMAL STOP
SELECT OUTPUT(2)
END
ROUTINE SYMBOLS
ROUTINESPEC LIST SYMBOL TABLE
ROUTINESPEC CHECK REFS
ROUTINESPEC SORT NAMES(INTEGER A, B)
!!
HALFINTEGERARRAY SORTA(0:2048)
!!
CHECK REFS
LIST SYMBOL TABLE
RETURN
!!
ROUTINE LIST SYMBOL TABLE
INTEGER I, CN, POS
STRINGNAME S
OWNBYTEINTEGERARRAY TYPE(0:5)=' ', 'R', 'G', 'U', 'L', 'S'
OWNBYTEINTEGERARRAY USED(0:1)='*', ' '
NEWPAGE
PRINTSTRING( '
SYMBOL TABLE
SPACE USED ='); WRITE(LETTERPT, 1); PRINTSTRING( ' BYTES
NUMBER OF NAMES ='); WRITE(TOP, 1); PRINTSTRING( '
HASH GOES ='); PRINT(HASHF/HASHG+1, 1, 2); NEWLINE
SORT NAMES(1, TOP)
CN=0
CYCLE I=1, 1, TOP
S==STRING(ADDR(LETTERS(SORTA(I))))
POS=SEARCH(S)
IF POS>=0 START
PRINTSTRING(S); SPACES(7-LENGTH(S))
DES==RECORD(DESAP+POS <<2)
PRINTSYMBOL(TYPE(DES_REG)); SPACE
IF DES_DEF&X'7F'#0 THEN OCTAL(DES_VALUE) ELSE C
PRINTSTRING('UNDFND')
PRINTSYMBOL(USED((DES_DEF&128)>>7))
CN=CN+1
IF CN#6 THEN SPACES(6) ELSESTART
CN=0; NEWLINE
FINISH
FINISH
REPEAT
NEWLINES(5)
END
ROUTINE CHECK REFS
INTEGER I, PT
PT=1; I=1
UNTIL PT>=LETTERPT CYCLE
SORTA(I)=PT
I=I+1
PT=PT+LETTERS(PT)+1
REPEAT
TOP=I-1
END
ROUTINE SORT NAMES(INTEGER A, B)
INTEGER L, U, D
STRING (6)X
RETURNIF A>=B
L=A; U=B; D=SORTA(U)
X=STRING(ADDR(LETTERS(SORTA(U))))
->FIND
!!
UP: L=L+1
->FOUND IF L=U
FIND: ->UP UNLESS STRING(ADDR(LETTERS(SORTA(L))))>=X
SORTA(U)=SORTA(L)
!!
DOWN: U=U-1
->FOUND IF L=U
->DOWN UNLESS STRING(ADDR(LETTERS(SORTA(U))))<=X
SORTA(L)=SORTA(U)
->UP
!!
FOUND: SORTA(U)=D
SORT NAMES(A, L-1)
SORT NAMES(U+1, B)
END
END
ROUTINE BIN OUT
INTEGER I, FLAG
STRING (10)ST
I=1
ST=""; FLAG=0
COT(0)=COREP; ! SET THE START ADDRESS
IF CURR>1 THEN DUMP BIN(COT, 0, CURR-1, ST, FLAG)
ABANDON("BINARY FAULT") IF FLAG#0
IF ENDFLAG#0 START
ST='END'
COT(0)=ENF
DUMP BIN(COT, 0, 0, ST, FLAG) UNLESS OPER='EOT'
DUMP BIN(COT, -1, 200, ST, FLAG)
FINISH
CURRP=2; CURR=1
END
ROUTINE REPORT FAULTS
IF FAULTS=0 START
WRITE(LINO, 6)
PRINTSTRING(' STATEMENTS ASSEMBLED
')
FINISHELSESTART
WRITE(FAULTS, 6); PRINTSTRING(' FAULTS IN PROGRAM
')
FINISH
END
!!
ROUTINE START PASS TWO(INTEGER STR)
SELECT OUTPUT(STR)
PRINTSTRING('
PASS TWO
')
END
END
!!
!!
EXTERNALROUTINE ASS11T(STRING (63) FILES)
ASS11(FILES)
END
ENDOFFILE