Trailing-Edge
-
PDP-10 Archives
-
ALGOL-20_1-29-82
-
algol-sources/algcon.mac
There are 8 other files named algcon.mac in the archive. Click here to see a list.
;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
; WRITTEN BY K. NIST, C.M.U./ EDITED BY R. M. DE MORGAN
SEARCH ALGPRM ; MAIN PARAMETER FILE
SALL
%TITLE(ALGCON,ALGOL COMPILER CONTROL MODULE)
TWOSEG
LOC .JBVER ;[171]
VERNO ;[171]
RELOC 400000
MLON
; THIS MODULE CONTAINS THE FOLLOWING ROUTINES:
;
;
; .RINIT ".RINIT" WILL INITIALIZE THE READ MODULE AND WRITE MODULE.
; ".RINIT" WILL SCAN THE COMMAND STRING AND OPEN FILES,
; INITIALIZE VARIABLES, AND ACQUIRE AND ALLOCATE SPACE
; FOR TABLES.
;
; .PINIT ".PINIT" IS CALLED BEFORE EACH ENTRY PROCEDURE TO
; REINITIALIZE VARIABLES AND REALLOCATE TABLES. ".PINIT"
; IS AUTOMATICALLY DONE AS PART OF ".RINIT".
;
; .RUND ".RUND" PERFORM LEXICAL SCANNING. ".RUND" WILL "READ UNTIL
; NEXT DELIMITER" AND THEN SHIFT THE WINDOW. ".RUND" WILL
; COMPUTE "LEXEX" AND "COMPNAME".
;
; .SEARCH ".SEARCH" WILL SEARCH THE SYMBOL TABLE FOR AN IDENTIFIER
; AND, OPTIONALLY, IF NOT FOUND WILL ENTER THE IDENTIFIER
; INTO THE TABLE.
;
; .STADD ".STADD" WILL ADD TO THE SYMBOL TABLE AN ENTRY FOR AN
; IDENTIFIER WHOSE NAME DUPLICATES THE NAME OF AN EXISTING
; IDENTIFIER.
;
; .XTNDLB ".XTNDLB" WILL MAKE THE LAST ENTRY IN THE SYMBOL TABLE AN
; EXTENDED ENTRY.
;
; .TOFIX ".TOFIX" WILL ENTER A TYPE-15 FIXUP INTO THE FIXUP TABLE.
;
; .CON1 ".CON1" WILL ENTER A 1-WORD CONSTANT INTO THE CONSTANTS
; TABLE.
;
; .CON2 ".CON2" WILL ENTER A 2-WORD CONSTANT INTO THE CONSTANTS
; TABLE.
;
; .FAILED ".FAILED" WILL ENTER AN ERROR MESSAGE INTO THE MESSAGE TABLE
; TO BE INCLUDED IN THE LISTING.
; .BLK1 ".BLK1" IS CALLED AT THE BEGINNING OF A BLOCK TO ENTER INTO
; THE LISTING THE MESSAGE "START OF BLOCK N".
;
; .BLK2 ".BLK2" IS CALLED AT THE END OF A BLOCK TO ENTER INTO THE
; LISTING THE MESSAGE "END BLOCK N, CONT M".
;
; .SCRUND ".SCRUND" WILL COMPUTE "LEXEX" AND "COMPNAME".
;
; GETCS "GETCS" WILL READ AND INTERPRET A COMMAND STRING.
;
; LMSGZ "LMSGZ" IS CALLED AT THE END OF A COMPILATION TO PRINT
; THE REMAINING CONTENTS OF THE MESSAGE TABLE.
;
; .STOVER ".STOVER" WILL HANDLE STACK OVERFLOWS.
;
; INS "INS" AND "TCHECK" ARE USED TO INSERT MESSAGES INTO
; TCHECK THE LISTING.
;
; GETSPC "GETSPC" IS USED TO ACQUIRE SPACE IN THE SYMBOL TABLE.
;
; HAL "HAL" WILL COMPUTE THE HASH VALUE AND NAME LENGTH FOR A
; SYMBOL TABLE ENTRY.
; TABLE ALLOCATION:
;
; TEMP SYMBOL FIXUP CONSTANTS STACK
; CODE TABLE TABLE TABLE
;! ! ! ! !
;! \ ! \ / ! \ ! \ !
;!---> !------------> <------!------> !------------------> !
;! / ! / \ ! / ! / !
;! ! ! ! !
; T ST N N FC N CS C
; C YC A A IO A OT O
; B MM S F XN C NA R
; A BA T T UT T EC E
; S OX E E PA E NK N
; E L B DB D
;
;
;
;
; TEMPCODE IS A BUFFER THAT RECEIVES PARTIALLY GENERATED CODE FOR
; EXPRESSIONS. TEMPCODE CAN OVERFLOW IF THE COMPILER ENCOUNTERS
; A SUPER-LARGE EXPRESSION. WHEN THIS HAPPENS THE COMPILATION
; ABORTS. THE DEFAULT LENGTH OF TEMPCODE IS "TEMPL". THE ALGOL
; USER CAN OVER-RIDE THIS WITH THE /T SWITCH.
;
IFNDEF TEMPL,<
TEMPL==400>
;
;
; THE SYMBOL TABLE HAS ENTRIES FOR ALL IDENTIFIERS ACTIVE IN THE
; USER'S PROGRAM. THE FIXUP TABLE CONTAINS THE ACCUMULATED TYPE-15
; LOADER BLOCK FIX-UPS. THE SYMBOL TABLE AND FIXUP TABLE GROW
; TOWARD EACH OTHER. IF THEY SHOULD MEET, CORE WILL BE EXPANDED
; BY AN AMOUNT "DELTA", THE FIXUP TABLE, CONSTANTS TABLE, AND STACK
; WILL BE MOVED UPWARD IN CORE BY AN AMOUNT "DELTA", AND THE COMPILATION
; WILL CONTINUE. THE COMBINED INITIAL LENGTH OF THE SYMBOL TABLE
; AND FIXUP TABLE IS "TABLES".
;
IFNDEF TABLES,<
TABLES==400>
; THE CONSTANTS TABLE CONTAINS WHATEVER SINGLE AND DOUBLE PRECISION
; FIXED AND FLOATING POINT CONSTANTS THAT CANNOT BE EXPRESSED AS
; IMMEDIATES, AND ALSO STRINGS. IF THE CONSTANTS TABLE SHOULD
; OVERFLOW, CORE WILL BE EXPANDED BY AN AMOUNT "DELTA", THE STACK
; WILL BE MOVED UPWARD IN CORE BY AN AMOUNT "DELTA", AND THE
; COMPILATION WILL CONTINUE. THE INITIAL LENGTH OF THE CONSTANTS
; TABLE IS "CONL".
;
IFNDEF CONL,<
CONL==30>
;
;
;
; THE STACK CONTAINS "PUSH" AND "PUSHJ" DATA, AND OTHER BLOCKS OF
; DATA. WHEN THE STACK OVERFLOWS, CORE IS EXPANDED BY AN AMOUNT
; "DELTA". THE INITIAL LENGTH OF THE STACK IS "STACKL".
;
IFNDEF STACKL,<
STACKL==100>
;
;
;
; THE UPPER BOUND OF THE STACK IS "COREND". PLEASE NOTE THAT NOTHING
; CAN GO INTO THE LOW SEGMENT ABOVE "COREND".
;
;
IFNDEF DELTA,<
DELTA==100>
;
;
;
; ALL BUFFER RINGS ARE COMPOSED OF BUFFERS OF STANDARD SIZE
; FOR THE PARTICULAR DEVICE. THE ALGOL USER CAN SELECT THE NUMBER
; OF BUFFERS IN EACH RING WITH THE /B SWITCH. THE DEFAULT NUMBER
; OF BUFFERS IN EACH BUFFER RING IS:
;
IFNDEF SBUF,< ; SOURCE
SBUF==2>
IFNDEF LBUF,< ; LISTING
LBUF==2>
IFNDEF OBUF,< ; OBJECT CODE
OBUF==2>
; REGISTER ASSIGNMENTS:
FL==A0 ; FLAGS REGISTER
; A10-A13 ; SAFE OVER READ MODDULE
A14==14 ; SAFE OVER READ MODULE
DEL==15
SYM==16
SP==17 ; STACK POINTER (SAFE OVER READ MODULE)
STOPS==A7
DBASE==A10
; READ MODULE FLAGS -- BIT ASSIGNMENTS (RFLAGS)
EXISTS==400000 ; LISTING FILE EXISTS
LTTY==200000 ; LISTING DEVICE IS A TTY
CSDONE==100000 ; COMMAND STRING SCANNED, COMPILATION STARTED
SPAREN==40000 ; PARENTHETICAL COMMAND STRING SWITCH
TTY==20000 ; SOURCE DEVICE IS A TTY
ESWIT==10000 ; LINE NUMBERS IN COLS 73-80
NSWIT==4000 ; NO ERROR PRINTOUTS ON TTY
COMPLETE==2000 ; 1 = LISTING COMPLETE AND CLOSED
TMG==1000 ; TERMINATION MESSAGE GIVEN
ELINE==400 ; EDITORS LINE NUMBER SCANNED
BLANKL==200 ; BLANK LINE BEING SCANNED
WITHIN==100 ; WITHIN NEWLINE ROUTINE
ONECHS==40 ; 1 CHARACTER SWITCH SCANNED
STATS==20 ; STATS REQUESTED.
; ACCUMULATOR ZERO -- BIT ASSIGNMENTS
; **************************************************
; * *
; * W A R N I N G ! ! ! ! ! ! ! ! ! ! ! *
; * *
; * THIS M U S T AGREE WITH GB DEFINITIONS *
; * IN FILE ALGMAC !!! *
; * *
; **************************************************
TRLOFF==20000 ; DON'T PLANT TRACE INFO ( IMPLIES TRPOFF)
TRPOFF==10000 ; DON'T MAKE SYMBOL BLOCKS
CREF==4000 ; /CREF - PRODUCE O/P FOR CROSS-REF PROGRAM
ACOFF==2000 ; /CHECKOFF - FORCE NO ARRAY-BOUND CHECKS
ACON==1000 ; /CHECKON - FORCE ARRAY-BOUND CHECKS
OBOO==400 ; OBJECT CODE LISTING ON/OFF FLAG
NOENTR==200 ; 1 => MAKE NO NEW ENTRIES IN SYMBOL TABLE
ACOO==100 ; ARRAY-BOUND CHECKING IN FORCE
LNOO==40 ; LINE-NUMBERS ON/OFF FLAG
LISTOO==20 ; LISTON/LISTOFF SWITCH
DECLAR==10 ; DECLARATION MODE
BPAIR==4 ; SCANNING A BOUND PAIR
ERRF==2 ; FATAL ERROR FOUND. NO CODE GENERATED
ERRL==1 ; SCANNING IN ERROR-LABEL
; OTHER RANDOM BITS
USE==400000 ; BUFFER USE BIT
EXACT==400000 ; USE EXACT POINTER FOR ERROR MSG UP-ARROW
DEVTTY==10 ; DEVCHR TTY BIT
RWTRT==-1
RWTLNK==0
RWTLEN==0
RWTLEX==1
RWTNAM==2
SYMBLK==0
SYMLNK==0
SYMTYP==1
SYMNAM==2
.FAILE=FAILED
INTERN .PINIT
INTERN .BLK1
INTERN .BLK2
INTERN .FAILE
.LSCAN=LSCAN
INTERN .LSCAN
.RINIT=RINIT
INTERN .RINIT
.SEARCH=SEARCH
INTERN .SEARCH
.STADD=STADD
INTERN .STADD
.GETSPC=GETSPC
INTERN .GETSPC
.RUND=RUND
INTERN .RUND
.XTNDL=XTNDLB
INTERN .XTNDL
.HAL=HAL
INTERN .HAL
.CON1=CON1
INTERN .CON1
.CON2=CON2
INTERN .CON2
INTERN .SCRUND
INTERN .TOFIX
INTERN .STOVE
INTERN COREB
INTERN CSBLK
INTERN CHKSUM
INTERN CCLSW
INTERN PRNAME
INTERN OFILE
EXTERN .JBERR
EXTERN .HELPR
EXTERN .JBREL
EXTERN .FAIL
EXTERN .JBAPR
EXTERN .JBTPC
EXTERN .JBFF
EXTERN .JBDDT
BLKLEV=BLOCKL
..HARD==60
..SOFT==0
..FRIED==1040
..IUO==1140
..FATAL==200
..FVARY==400
..SYM==10
..DEL==4
..NSYM==2
..NDEL==1
..IMM==20000
..IUO2==100
SUSPCO==40
RELOC 0
DEFINE FAIL(NNN,ARG1,ARG2,TEXT)
<
PUSHJ SP,FAILX
XWD <<..'ARG1+..'ARG2>&<777777>>,^D'NNN
>
FAILX: BLOCK 5 ; INITIALISED FROM HISEG AT START1.
; PUSH SP,A1 ; SAVE A1
; PUSH SP,A2 ; SAVE A2
; MOVE A1,@-2(SP) ; GET PARAM
; MOVEM A1,FAILX1 ; SAVE IT
; PUSHJ SP,.FAIL ; CALL FAIL ROUTINE
FAILX1: BLOCK 5
; XWD 0,0 ; PARAM WILL BE PUT HERE
; POP SP,A2 ; RESTORE A2
; POP SP,A1 ; RESTORE A1
; AOS (SP) ; SKIP RETURN
; POPJ SP, ; EXIT FAILX
RELOC
$IMM==1 ; CONSTANT, SIMPLE
$CT==3 ; CONSTANT, REGULAR
$ST==7 ; VARIABLE, SIMPLE
$SYMB==4 ; THIS BIT ON IMPLIES A SIMPLE VARIABLE
; FORMAT OF A RESERVED WORD TABLE ENTRY
;
; EACH ENTRY IN THIS TABLE IS LINKED INTO ONE OF 26 SUB-LISTS (ONE
; FOR EACH LETTER OF THE ALPHABET) WHOSE HEADS CAN BE FOUND USING
; THE "RESERVED WORD HASH TABLE". WHICH SUB-LIST THAT AN ENTRY IS LOCATED
; ON DEPENDS UPON THE FIRST LETTER OF THE NAME OF THE DELIMITER WORD.
;
; ALL ENTRIES IN THE TABLE THAT ARE LOCATED BEFORE THE ADDRESS "FRW"
; ARE CONSIDERED FLAGGED, AND THE WORD PRECEDING THESE ENTRIES MUST
; CONTAIN THE ADDRESS OF A ROUTINE THAT WILL PERFORM THE SPECIAL
; PROCESSING FOR THAT DELIMITER WORD. OTHER THAN THIS, NEITHER THE
; POSITION OF A DELIMITER WORD IN THE TABLE NOR ITS POSITION ON A
; DELIMITERS ON A SUB-LIST SHOULD BE ARRANGED IN ORDER OF FREQUENCY
; OF USAGE.
;
; THE RIGHT HALF OF THE FIRST WORD OF AN ENTRY CONTAINS THE SUB-LIST
; LINK. THE LEFT HALF CONTAINS EITHER A 0 OR A -1, DEPENDING ON WHETHER
; THE DELIMITER NAME WILL TAKE UP 1 WORD OR 2, RESPECTIVELY. THE SECOND
; WORD OF THE ENTRY CONTAINS THE COMPLETE LEXEME FOR THE DELIMITER.
; THE THIRD AND FOURTH WORDS OF THE ENTRY CONTAIN THE NAME OF THE
; DELIMITER. THERE IS NO FOURTH WORD IF THE NAME IS ONLY 1 WORD LONG
; (5 CHARACTERS OR LESS).
DEFINE N1(NAM,LN)
<
<373737373737>&<LN-1+SIXBIT/NAM/>
>
DEFINE N2(NAM)
<
<373737373737>&<SIXBIT/NAM/>
>
DEFINE LEX(ROOT)
<
INTERN Z'ROOT
EXTERN L$'ROOT,R$'ROOT
Z'ROOT: XWD L$'ROOT,R$'ROOT>
; *** RESERVED WORD TABLE ***
FBEGIN
FB: FB1 ; BEGIN
LEX(BEGIN)
N1(NIGEB,5)
FEND
FE: FE1 ; END
LEX(END)
N1(DNE,3)
FFALSE
FF1: FF2 ; FALSE
0
N1(ESLAF,5)
FGO
FG1: 0 ; GO
LEX(GOTO)
N1(OG,2)
COMNT2
FC: XWD -1,FC1 ; COMMENT
0
N1(EMMOC,7)
N2(TN)
FTRUE
FT1: 0 ; TRUE
0
N1(EURT,4)
FRW: ; ALL PRECEDING RESERVED WORDS ARE FLAGGED.
FA:
.+3 ; ARRAY
LEX(ARRAY)
N1(YARRA,5)
0 ; AND
LEX(AND)
N1(DNA,3)
FB1:
XWD -1,0 ; BOOLEAN
LEX(BOOLEAN)
N1(ELOOB,7)
N2(NA)
FC1:
XWD -1,.+4 ; COMPLEX
LEX(COMPLEX)
N1(LPMOC,7)
N2(XE)
XWD -1,.+4 ; CHECKON
LEX(CON)
N1(KCEHC,7)
N2(NO)
XWD -1,0 ; CHECKOFF
LEX(COFF)
N1(KCEHC,8)
N2(FFO)
FD:
.+3 ; DO
LEX(DO)
N1(OD,2)
0 ; DIV
LEX(DIV)
N1(VID,3)
FE1:
.+3 ; ELSE
LEX(ELSE)
N1(ESLE,4)
XWD -1,.+4 ; EXTERNAL
LEX(EXTERNAL)
N1(RETXE,8)
N2(LAN)
0 ; EQV
LEX(EQV)
N1(VQE,3)
FF:
FF1 ; FOR
LEX(FOR)
N1(ROF,3)
FF2:
XWD -1,0 ; FORWARD
LEX(FORWARD)
N1(AWROF,7)
N2(DR)
FG:
FG1 ; GOTO
XWD L$GOTO,R$GOTO
N1(OTOG,4)
FI:
.+3 ; IF
LEX(IF)
N1(FI,2)
XWD -1,.+4 ; INTEGER
LEX(INTEGER)
N1(GETNI,7)
N2(RE)
0 ; IMP
LEX(IMP)
N1(PMI,3)
FLL:
.+3 ; LABEL
LEX(LABEL)
N1(LEBAL,5)
.+3 ; LONG
LEX(LONG)
N1(GNOL,4)
XWD -1,.+4 ; LISTON
LEX(LON)
N1(OTSIL,6)
N2(N)
XWD -1,.+4 ; LISTOFF
LEX(LOFF)
N1(OTSIL,7)
N2(FF)
0 ; LINE
LEX(LINE)
N1(ENIL,4)
FN:
0 ; NOT
LEX(NOT)
N1(TON,3)
FO:
.+3 ; OWN
LEX(OWN)
N1(NWO,3)
0 ; OR
LEX(OR)
N1(RO,2)
FP:
XWD -1,0 ; PROCEDURE
LEX(PROCEDURE)
N1(ECORP,9)
N2(ERUD)
FR:
.+3 ; REAL
LEX(REAL)
N1(LAER,4)
0 ; REM
LEX(REM)
N1(MER,3)
FS:
.+3 ; STEP
LEX(STEP)
N1(PETS,4)
XWD -1,.+4 ; STRING
LEX(STRING)
N1(NIRTS,6)
N2(G)
XWD -1,0 ; SWITCH
LEX(SWITCH)
N1(CTIWS,6)
N2(H)
FT:
FT1 ; THEN
LEX(THEN)
N1(NEHT,4)
FU:
0 ; UNTIL
LEX(UNTIL)
N1(LITNU,5)
FV:
0 ; VALUE
LEX(VALUE)
N1(EULAV,5)
FW:
0 ; WHILE
LEX(WHILE)
N1(ELIHW,5)
; ** RESERVED WORD HASH TABLE **
RESWRD: FA
FB
FC
FD
FE
FF
FG
0
FI
0
0
FLL
0
FN
FO
FP
0
FR
FS
FT
FU
FV
FW
0
0
0
; SPECIAL CHARACTERS
.TAB==11
.LF==12
.VT==13
.FF==14
.CR==15
.CZ==32
.ALT1==33
.CLEFT==37
.SPACE==" "
.EXCL=="!"
.DQUOT==""""
.$=="$"
.%=="%"
.AMPER=="&"
.LPAREN=="("
.RPAREN==")"
.STAR=="*"
.PLUS=="+"
.COMMA==","
.MINUS=="-"
.DOT=="."
.SLASH=="/"
.N0=="0"
.N7=="7"
.N9=="9"
.COLON==":"
.SEMI==";"
.EQUAL=="="
.QUESTION=="?"
.AAAAA=="@"
.A=="A"
.B=="B"
.E=="E"
.I=="I"
.O=="O"
.T=="T"
.Z=="Z"
.LBRAC=="["
.RBRAC=="]"
.UP=="^"
.LEFT=="_"
.ALT2==175
.ALT3==176
.CRF==SIXBIT/ CRF/
.LST==SIXBIT/ LST/
.REL==SIXBIT/ REL/
.ALG==SIXBIT/ ALG/
.DSK==SIXBIT/ DSK/
.TMP==SIXBIT/ TMP/
SUBTTL ** RINIT **
; READ MODULE INITIALIZATION ROUTINE
RINIT: MOVEM A1,LINK ; SAVE RETURN LINK
CLOSE 3,0 ; CLOSE SOURCE FILE, IF OPEN
CLOSE 5,0 ; CLOSE COMMAND STRING FILE, IF OPEN
MOVE SP,[ ; LOAD A STACK POINTER
XWD -46,TMPBUF] ; TEMPORARILY USE TMPBUF AS A STACK
; IF THIS IS NOT THE 1ST CALL TO ".RINIT" THEN THE LISTING FROM
; THE PREVIOUS COMPILATION MIGHT NOT YET BE COMPLETE, AND ALSO
; THE REL-FILE MIGHT NOT YET BE CLOSED NOR DELETED IF IT IS TO
; BE DELETED.
MOVE A7,RFLAGS ; GET OLD READ MODULE FLAGS
MOVE A4,COREB ; GET OLD VALUE OF CORE
XORI A4,RANDOM ; CODE IT
CAME A4,CHKSUM ; IF VALUE OF CORE NOT VALID
JRST START1 ; THEN SKIP THIS PART
SKIPL WFLAG ; UNLESS REL-FILE IS TO BE DELETED
JRST START0 ; SKIP OVER THIS PART
; DELETE REL-FILE
SKIPE OFILE ; IF THERE IS NO REL FILE
CLOSE 1,40 ; DON'T SUPERSEDE
SETZM WFLAG ; CLEAR THE WRITE MODULE FLAG
; COMPLETE THE LISTING
START0:; TLNE A7,COMPLETE ; IF PREVIOUS RUN'S LISTING IS COMPLETE
; JRST START ; THEN SKIP THIS PART
PUSHJ SP,CREFNL ; CLOSE OFF ANY CREF INFO
MOVEI A1,NLCHRS ; PUT A BLANK LINE IN LISTING
PUSHJ SP,INSERT
SKIPN A1,.JBERR ; IF THERE ARE NO ERRORS
SKIPA A1,[[ASCIZ/No/]]; THEN SAY SO
PUSHJ SP,LPRINT ; CONVERT TO DECIMAL ASCII
PUSHJ SP,DONE1 ; INCLUDE IT IN LISTING
MOVE A1,.JBERR
CAIN A1,1 ; DON'T USE SOJG - DONE1 NEEDS .JBERR
SKIPA A1,[[ASCIZ/ error
/]]
MOVEI A1,ERRORM ; " ERRORS"
PUSHJ SP,DONE1 ; INCLUDE IN LISTING
SKIPN A1,WRNCNT ;[171] IF THERE ARE NO WARNINGS,
SKIPA A1,[[ASCIZ /No/]] ;[171] THEN SAY SO
PUSHJ SP,LPRINT ;[171] OR ELSE CONVERT NUMBER TO DECIMAL ASCII
PUSHJ SP,DONE1 ;[171] AND INCLUDE IT IN LISTING
MOVE A1,WRNCNT ;[171] GET WARNING COUNT
CAIN A1,1 ;[171] IF IT IS 1, USE THE SINGULAR
SKIPA A1,[[ASCIZ / warning
/]] ;[171] ...
MOVEI A1,[ASCIZ / warnings
/] ;[171] IF NOT, USE THE PLURAL
PUSHJ SP,DONE1 ;[171] AND INCLUDE IT IN LISTING
IFN FTSTATS,<
TLNN A7,STATS ; STATS ?
JRST START3 ; NO
MOVEI A1,[ASCIZ/
Number of identifiers = /] ;
PUSHJ SP,DONE2 ;
MOVE A1,DEFCNT ;
PUSHJ SP,LPRINT ;
PUSHJ SP,DONE2 ;
MOVEI A1,[ASCIZ/
Average characters in each = /] ;
PUSHJ SP,DONE2 ;
MOVE A1,IDCHRS ;
IDIV A1,DEFCNT ;
ADDI A1,1 ;
PUSHJ SP,LPRINT ;
PUSHJ SP,DONE2 ;
MOVEI A1,[ASCIZ/
Number of identifier references = /] ;
PUSHJ SP,DONE2 ;
MOVE A1,REFCNT ;
PUSHJ SP,LPRINT ;
PUSHJ SP,DONE2 ;
MOVEI A1,NLCHRS ;
PUSHJ SP,DONE2 ;
START3: >
MOVEI A1,LINES3 ; PUT 3 BLANK LINES
PUSHJ SP,INSERT ; IN LISTING
TLNE A7,EXISTS ; IF LISTING EXISTS,
PUSHJ SP,WRITEL ; WRITE OUT THIS BUFFER
START: CLOSE 1,0 ; CLOSE REL-FILE
CLOSE 2,0 ; CLOSE LISTING
JRST START1+1 ; SKIP NEXT INSTRUCTION
START1: SETOM CSCOMP ; MARK COMMAND STRING TO BE READ
SKIPN .JBDDT ; UNLESS DDT IS LOADED...
RESET ; RESET IO
MOVE A4,.JBFF ; ADD ADDRESS OF FREE CORE
XORI A4,RANDOM ; HASH IT
MOVEM A4,CHKSUM ; SET CHECK SUM
HRRZ A5,.JBFF ; GET START OF FREE CORE
MOVEM A5,COREB ; SET BASE OF CORE
; *** BEGIN THE CURRENT COMPILATION ***
IFE FTSYM,<
MOVEI FL,TRPOFF ; DEFAULT TO NO SYMBOLS (TYPE 1044 BLOCKS)
>
IFN FTSYM,<
SETZ FL, ; CLEAR FLAG REGISTER>
MOVE A7,IFLAGS ; GET A NEW SET OF FLAGS
SETZB A5,DYNOWN ; CLEAR OUR PROCESSOR TO KA, AND INITIAL HEAP SIZE
MOVEI A4,TEMPL ; DEFAULT LENGTH OF TEMPCODE
MOVEM A4,LTCODE ; SET LENGTH OF TEMPCODE
MOVEI A1,RLIST ; READ MODULE INIT LIST
PUSHJ SP,BMOVE ; INITIALIZE READ MODULE FROM HIGH SEG
MOVEI A4,600000 ; SET PROCESSOR TO TRAP ON
APRENB A4, ; A PUSHDOWN OVERFLOW
SKIPA A4,.+1 ; SET THE RESERVED WORD TABLE POINTER
XWD A1,RESWRD-.A ; TO THE ACTUAL RESERVED WORD TABLE
MOVEM A4,RWS ; SET IT
SKIPE .JBDDT ; SPECIAL MESSAGE IF
SKIPE CCLSW ; NOT CCL-MODE AND
JRST START2
OUTSTR DDTMSG ; DDT HAS BEEN LOADED
; PROCESS COMMAND STRING
START2: MOVEI A4,OBUF ; DEFAULT NUMBER OF OBJECT BUFFERS
MOVEM A4,OLIST+7 ; SET IT
MOVEI A4,LBUF ; DEFAULT NUMBER OF LISTING BUFFERS
MOVEM A4,LLIST+7 ; SET IT
MOVEI A4,SBUF ; DEFAULT NUMBER OF SOURCE BUFFERS
MOVEM A4,SLIST+7 ; SET IT
SKIPN CSCOMP ; IF PREVIOUS COMMAND STRING NOT EMPTY
JRST .+4 ; THEN DONT READ ANOTHER
SKIPGE CCLSW ; IF CCLSW = -1
JRST QUIT ; THEN NOTHING MORE TO COMPILE
PUSHJ SP,GETCS ; READ IN THE COMMAND STRING
; SCAN OBJECT CODE FILE NAME
MOVEI A4,.REL ; EXTENSION NAME DEFAULT
MOVSM A4,OFILE+1 ; SET DEFAULT
MOVEI A1,OLIST ; OBJECT CODE PARAM LIST
PUSHJ SP,SCAN2 ; SCAN NAME
; SCAN LISTING FILE NAME
MOVEI A4,.DSK ; LISTING DEVICE DEFAULT
MOVSM A4,LLIST+1 ; SET IT
EDIT(042); DONT USE OLD LISTING FILE NAME AGAIN
SETZM LFILE ; [E042] CLEAR LISTING FILE NAME
CAIE A6,.LEFT ; _?
CAIN A6,.EQUAL ; OR =?
JRST CS1 ; -YES, NEXT SCAN SOURCE FILES
CAIE A6,.COMMA ; IF TERMINATING CHAR NOT A COMMA
JRST CSER ; THEN COMMAND STRING ERROR
MOVEI A4,777777 ; EXTENSION NAME DEFAULT - GARBAGE
MOVSM A4,LFILE+1 ; SET DEFAULT VALUE
MOVEI A1,LLIST ; LISTING PARAM LIST
PUSHJ SP,SCAN2 ; SCAN NAME
CAIN A6,.LEFT ; _?
JRST CS1 ; YES
CAIE A6,.EQUAL ; =?
JRST CSER ; NO - COMMAND STRING ERROR
; SCAN SOURCE FILE NAME
CS1: TRO FL,LISTOO ; TURN LISTING ON
PUSHJ SP,SCAN3 ; SCAN 1ST SOURCE FILE AND OPEN IT
JRST CS5 ; CONTINUE
; SCAN SOURCE FILE NAME AND OPEN IT. DEV:FILE.EXT[123,456]/A/B
SCAN3: MOVEI A4,.ALG ; EXTENSION NAME DEFAULT
MOVSM A4,SFILE+1 ; SET DEFAULT
MOVEI A1,SLIST ; SOURCE PARAM LIST
PUSHJ SP,SCAN2 ; SCAN NAME
CAIE A6,.COMMA ; IF THE LAST CHAR IS NOT A COMMA
JRST CS12 ; THEN SKIP THIS PART
AOS CSCOMP ; MARK: LINE NOT COMPLETELY SCANNED
JRST CS14 ; CONTINUE
CS12: CAIE A6,.CR ; IF IT IS NOT A CR
JRST CS13 ; THEN SKIP THIS PART
PUSHJ SP,SCANCH ; STEP OVER THE LINE FEED
PUSHJ SP,SCANCH ; READ THE NEXT CHAR
JRST CS12 ; TRY AGAIN
CS13: CAIG A6,0 ; IF IT IS A NULL OR OTHER TERMINATOR
SETOM CSCOMP ; THEN MARK: END OF COMMAND STRING
HRLZI A4,070000 ; BYTE POINTER BACK-UP CONSTANT
ADDM A4,CSP ; BACK UP THE COMMAND STRING POINTER
CS14: TLZ A7,TTY ; CLEAR TTY FLAG
MOVE A5,SLIST+1 ; GET SOURCE DEVICE NAME
DEVCHR A5, ; WHAT IS DEVICE?
TLNE A5,DEVTTY ; IS IT A TTY?
TLO A7,TTY ; YES - SET FLAG BIT
; OPEN SOURCE DEVICE
OPEN 3,SLIST ; OPEN SOURCE DEVICE
JRST DSERR1 ; -SOMETHING WRONG
TLNE A7,CSDONE ; UNLESS THIS IS THE 1ST SOURCE FILE IN
JRST CS11 ; THE COMMAND STRING, SKIP THIS PART
; ESTABLISH SOURCE BUFFER RING
MOVE A5,SLIST+7 ; GET NUMBER OF BUFFERS
MOVEI A1,(A5) ; COPY TO A1
IMULI A1,204 ; EACH BUFFER TAKES UP 204 WORDS
PUSHJ SP,ALLOCATE ; GET SPACE FOR THESE BUFFERS
ADD A1,[ ; SET REGISTER A1 TO LOOK LIKE
XWD 202,1] ; A BUFFER LINK WORD
HRRZM A1,OLDSBR ; SAVE ADDRESS OF SOURCE BUFFER RING
JRST .+3 ; JUMP INTO LOOP
MOVEM A1,204(A1) ; SET NEXT BUFFER TO POINT TO THIS BUFFER
ADDI A1,204 ; STEP TO NEXT BUFFER
SOJG A5,.-2 ; LOOP
MOVEM A1,@OLDSBR ; SET LINK WORD OF 1ST BUFFER
CS11: MOVE A4,OLDSBR ; GET OLD SOURCE BUFFER RING
HRLI A4,400000 ; TURN ON USE BIT
MOVEM A4,BHEAD3 ; USE FOR THE CURRENT FILE ALSO
HRLI A4,000700 ; S-P BITS
MOVEM A4,BHEAD3+1 ; SET UP BYTE POINTER
; FIND SOURCE FILE
CS9: LOOKUP 3,SFILE ; SELECT SOURCE FILE
JRST DSERR2 ; FILE DOESNT EXIST
POPJ SP, ; EXIT SCAN3
SUBTTL ** COMMAND STRING ROUTINES **
; SCAN A FILE NAME ELEMENT (DEV, FILE, OR EXT)
SCAN1: SETZ A3,0 ; CLEAR A3
SKIPA A2,.+1
POINT 6,A3 ; SET UP OUTPUT POINTER
CS8: PUSHJ SP,SCANCH ; GET NEXT CHAR
SKIPL CTABLE(A6) ; IF NOT LETTER OR DIGIT
POPJ SP, ; THEN EXIT
SUBI A6,40 ; ELSE CONVERT TO SIXBIT
TLNE A2,770000 ; MORE THAN SIX CHARS?
IDPB A6,A2 ; DEPOSIT CHAR
JRST CS8 ; YES - IGNORE
; SCAN A FILE NAME OF THE FORM DEV:FILE.EXT[123,456]/A/B
SCAN2: MOVEI A4,.DSK ; "DSK"
MOVSM A4,1(A1) ; SET DEFAULT VALUE
SETZM 5(A1) ; CLEAR TIME/DATE
SETZM 6(A1) ; CLEAR PPN
PUSHJ SP,SCAN1 ; SCAN 1ST STRING
CAIE A6,.COLON ; ENDS IN COLON?
JRST CS2 ; -NO, MUST BE A FILE NAME
MOVEM A3,1(A1) ; SET DEVICE NAME
PUSHJ SP,SCAN1 ; SCAN NEXT STRING
CS2: MOVEM A3,3(A1) ; SET FILENAME
CAIE A6,.DOT ; ENDS IN DOT?
JRST CS10 ; -NO
PUSHJ SP,SCAN1 ; -YES, SCAN EXTENSION NAME
HLLZM A3,4(A1) ; SAVE EXTENSION NAME
CS10: CAIN A6,.EXCL ; IF EXCLAMATION MARK FOUND
JRST RUNUUO ; THEN TRANSFER TO NEXT CUSP
CAIE A6,.LBRAC ; IF IT IS NOT A "["
JRST SWITCH ; EXIT VIA SWITCH
; SCAN PROJECT/PROGRAMMER NUMBERS
PUSHJ SP,SCAN4 ; SCAN 1ST NUMBER
CAIE A6,.COMMA ; IT IS AN ERROR IF THIS
JRST CSER ; CHAR IS NOT A COMMA
HRLZM A5,6(A1) ; SAVE PROJECT NUMBER
PUSHJ SP,SCAN4 ; SCAN 2ND NUMBER
CAIE A6,.RBRAC ; IF IT'S A ]
CAIN A6,.CR ;
SKIPA ;
JRST CSER ;
HRRM A5,6(A1) ; SAVE PROGRAMMER NUMBER
EDIT(022); MAKE SWITCHES AFTER PPN'S WORK.
PUSHJ SP,SCANCH ; [E022] READ NEXT CHAR.
JRST SWITCH ; [E022] PROCESS SWITCHES, EXIT SCAN2.
; SUBROUTINE TO SCAN PROJECT NUMBER OR PROGRAMMER NUMBER
SCAN4: MOVEI A5,0 ; CLEAR A5
PUSHJ SP,SCANCH ; GET NEXT CHAR
CAIL A6,.N0 ; IF IT IS BELOW "0"
CAILE A6,.N7 ; OR ABOVE "7"
POPJ SP, ; THEN EXIT SCAN4
LSH A5,3 ; MULTIPLY BY 8
ADDI A5,-.N0(A6) ; AND ADD IN CURRENT DIGIT
JRST SCAN4+1 ; LOOP
; CHECK FOR, AND PROCESS, A COMMAND SWITCH
SWITCH: CAIN A6,.SLASH ; SWITCH ?
JRST SW13 ; YES
CAIE A6,.LPAREN ; START OF COMPIL SWITCH-STRING ?
POPJ SP, ; NO.
TLO A7,SPAREN ; YES - REMEMBER
SW13: MOVEI A4,6
SETZM SWIT
SKIPA A5,.+1 ;
POINT 6,SWIT ;
SW1: PUSHJ SP,SCANCH ; GET A CHARACTER
SKIPL CTABLE(A6) ; LETTER ?
JRST SW2 ; NO
ADDI A6,40 ; YES - TO SIXBIT
IDPB A6,A5
SOJG A4,SW1 ; GET UP TO 6
MOVE A5,SWIT ; GET SWITCH
CAMN A5,[SIXBIT/CHECKO/] ; /CHECKON OR /CHECKOFF !
JRST SW3 ; YES
PUSHJ SP,SCANCH
SKIPGE CTABLE(A6) ; SKIP REMAINING
JRST .-2 ; LETTERS
SW2: MOVEM A6,SWDEL ; SAVE DELIMITER CHARACTER
CAIN A4,6
JRST SE1 ; ERROR - NOTHING THERE !
CAIN A4,5 ; 1 CHAR SW ?
TLOA A7,ONECHS ; YES - REMEMBER
TLZ A7,ONECHS ; ELSE REMEMBER NOT
IMULI A4,6
SETO A6,
LSH A6,-^D36(A4) ; MAKE MASK
MOVEM A6,SWMASK
HRLZI A6,-SWTABN
SETZ A4,
SW4: MOVE A5,SWTAB(A6) ; GET AN ENTRY FROM SWITCH-TABLE
ANDCM A5,SWMASK ; MASK IT
CAMN A5,SWIT ; WHAT HE TYPED ?
JRST SW5 ; YES
SW9: AOBJN A6,SW4 ; NO - GET NEXT ENTRY
JUMPE A4,SE2 ; RECOGNIZED - ERROR IF NOT
SW11: SETZ A5,
MOVE A6,SWDEL ; RESTORE DELIMITER
TLNE A4,SWNYET ; "NOT IMPLEMENTED YET" ?
JRST NOTIMP ; YES - TELL HIM
TLNN A4,VALSW ; VALUE WANTED ?
JRST SW12 ; NO
CAIN A6,.COLON ; YES - DELIMITER = COLON ?
JRST SW14 ; YES - OK
TLNN A4,SWVOPT-VALSW ; NO - OPTIONAL ?
JRST SE3 ; NO - COMPLAIN
JRST SW6 ; YES - OK (VALUE = 0)
SW14: JFCL 17,.+1 ; CLEAR OVERFLOW FLAG
SW7: PUSHJ SP,SCANCH ; GET DIGIT
CAIL A6,.N0 ; IS
CAILE A6,.N9 ; IT ?
JRST SW6A ; NO - END OF VALUE
IMULI A5,^D10 ; YES - ADD IT IN
ADDI A5,-.N0(A6)
JOV SE4 ; TOO BIG !
JRST SW7
SW12: CAIN A6,.COLON ; NO VALUE WANTED - DID HE GIVE ONE ?
JRST SE6 ; YES - COMPLAIN
JRST SW6 ; NO - GOOD.
SW6A: CAIN A6,"K" ; nK OR
IMULI A5,^D1024
CAIN A6,"P" ; nP ?
IMULI A5,^D512
JOV SE4 ; TOO BIG.
CAIE A6,"K"
CAIN A6,"P" ; & GET NEXT CHAR
PUSHJ SP,SCANCH
SW6: ; HERE, A5 = VALUE, OR 0
; A6 = DELIMITER (OF SWITCH OR VALUE)
; A4 = DISPATCH TABLE ENTRY
TLNN A4,SETVAL ; SET VALUE TYPE ?
JRST SW10 ; NO
MOVEM A5,@A4 ; YES - SET IT !!MUST BE @, NOT ()!!
JRST SWEND ; GET NEXT SWITCH
SW10: TLNE A4,XCTSW ; EXCECUTE INSTRUCTION TYPE ?
XCT @A4 ; YES - DO IT
TLNN A4,XCTSW ; ELSE
PUSHJ SP,@A4 ; JUMP TO ROUTINE
JRST SWEND ; DONE - GET NEXT SWITCH
SW3: ; CHECKO SCANNED - IS IT -N OR -FF ?
PUSHJ SP,SCANCH ; GET 7TH CHARACTER
CAIN A6,"N" ; CHECKON ?
TRO FL,ACON!ACOO ; YES - REMEMBER
CAIN A6,"F" ; CHECKOFF ?
TRO FL,ACOFF
TRNN FL,ACON!ACOFF ; IF NEITHER FLAG WAS SET
JRST SE2 ; IT'S UNRECOGNIZED
PUSHJ SP,SCANCH ; GOBBLE
SKIPGE CTABLE(A6) ; REMAINING
JRST .-2 ; LETTERS
JRST SWEND ; DO NEXT SWITCH
SW5: SKIPGE SWDTAB(A6) ; 1 CHAR FLAG ?
TLNN A7,ONECHS ; YES - ONLY 1 CHAR TYPED ?
JRST SW8 ; NO
MOVE A4,SWDTAB(A6) ; YES - GET ENTRY
JRST SW11 ; AND DISPATCH
SW8: JUMPN A4,SE5 ; UNIQUE ? - ERROR IF NOT
MOVE A4,SWDTAB(A6) ; YES - GET ENTRY
JRST SW9 ; AND GO ON LOOKING
SE1: OUTSTR [ASCIZ/
? Non-alpha switch
/]
JRST CSER+1
SE2: OUTSTR [ASCIZ/
? Unrecognized/]
JRST SE9
SE3: OUTSTR [ASCIZ/
? No value for/]
JRST SE9
SE4: OUTSTR [ASCIZ/
? Value too large for/]
JRST SE9
SE5: OUTSTR [ASCIZ/
? Non-unique/]
JRST SE9
SE6: OUTSTR [ASCIZ/
? No value allowed for/]
JRST SE9
NOTIMP: OUTSTR [ASCIZ/
? Unimplemented/]
SE9: SKIPA A5,.+1 ;
POINT 6,SWIT ;
SKIPA A6,.+1 ;
POINT 7,SWERR+2 ;
ILDB A4,A5 ; MOVE SWITCH TO TYPE-BUFFER
JUMPE A4,.+4 ; NULL - END ?
ADDI A4,40 ; TO ASCII
IDPB A4,A6
JRST .-4 ; GO ON
IDPB A4,A6 ; DEPOSIT THE NULL (AS ASCIZ TERMINATOR)
OUTSTR SWERR
OUTSTR [ASCIZ/
/]
SETZM SWERR+2 ; CLEAR BUFFER
SETZM SWERR+3
JRST CSER+1
SWEND: TLNN A7,SPAREN ; IN A COMPIL SWITCH-STRING ?
JRST SWITCH ; NO
CAIN A6,.RPAREN ; CORRECT TERMINATOR ?
PUSHJ SP,SCANCH ; YES - GOBBLE IT
JRST SWITCH
; SWITCH TABLES
;
; EACH SWITCH HAS A V-MACRO IN THE DEFINITION OF THE SWS-MACRO.
;
; FORMAT OF THE V-MACRO ENTRY:
;
; V NAME,*,ACTIONS,ADDRESS-OR-INSTRUCTION
;
; WHERE:
;
; NAME IS THE SWITCH-NAME (ALPHA) - ONLY
; THE FIRST 6 ARE USED.
;
; * MEANS THIS SWITCH WILL BE RECOGNIZED IN PREFERENCE TO OTHERS
; BEGINNING WITH THE SAME LETTER, IF ONLY 1 CHARACTER IS
; TYPED (E.G. /H MEANS /HELP, NOT /HEAP)
;
; ACTIONS IS A BIT-MASK, AS FOLLOWS:
;
; VALSW A VALUE (/SW:VALUE) IS EXPECTED
; SETVAL A VALUE IS TO BE SET INTO THE ADDRESS SPECIFIED BY
; THE FOURTH PARAMETER (0 IF NOT VALSW)
; XCTSW AN INSTRUCTION, SUPPLIED AS THE FOURTH PARAMETER, IS
; TO BE OBEYED.
; SWVOPT THE VALUE IS OPTIONAL (IMPLIES VALSW)
; SWNYET NOT-YET-IMPLEMENTED: TYPE MESSAGE & GO TO ERROR
;
; ADDRESS-OR-INSTRUCTION
; IS THE ADDRESS OF THE ROUTINE TO OBEY, OR
; IS THE ADDRESS TO SET A VALUE TO (SETVAL), OR
; IS THE INSTRUCTION TO OBEY (XCTSW).
;
;
DEFINE SWS,<
;; V NAME,*,ACTIONS,ADDRESS
V SYMBOLS,,XCTSW,<TRZ FL,TRPOFF> ; PRODUCE DEBUGGER SYMBOLS (TYPE 1044 BLOCKS)
V NOSYMBOLS,,XCTSW,<TRO FL,TRPOFF>; NO SYMBOL BLOCKS
V NOERRORS,,XCTSW,<TLO A7,NSWIT> ; SUPPRESS ERRORS ON TTY
V NOLIST,,XCTSW,<TRZ FL,LISTOO!CREF> ; TURN OFF LISTING
IFN FTSTATS,<
V STATS,,XCTSW,<TLO A7,STATS> ; STATISTICS
>
IFE FTSTATS,<
V STATS,,SWNYET
>
V LIST,*,XCTSW,<TRO FL,LISTOO> ; TURN ON LISTING
V QUOTED,*,SETVAL,RWS ; QUOTED STROP-WORDS
V NOQUOTES,,,SWNOQT ; UNQUOTED STROP-WORDS
V HEAP,,SETVAL!VALSW,DYNOWN ; CHANGE INITIAL HEAP-SIZE
V HELP,*,XCTSW,<JRST HELPER> ; TELL HIM WHAT TO DO
V TEMPCODE,,SETVAL!VALSW,LTCODE ; TEMPCODE BUFFER SIZE
V NUMBERS,,XCTSW,<TLO A7,ESWIT> ; SEQUENCE NUMBERS
V NONUMBERS,,XCTSW,<TLZ A7,ESWIT> ; NO SEQUENCE NUMBERS
V BUFFERS,,SETVAL!VALSW,<7(A1)> ; # I/O BUFFERS
V TRACE,*,SWVOPT,SWTRAC ; TRACE-BUFFER LENGTH
V PRODUCTION,*,XCTSW,<TRO FL,TRLOFF!TRPOFF>
; SUPPRESS DIAGNOSTIC INFO
V CREF,,XCTSW,<TRO FL,CREF!LISTOO> ; CROSS-REFERENCE LISTING
V NOCREF,,XCTSW,<TRZ FL,CREF> ; NO CREF LISTING
>
SETVAL==200000
VALSW==100000
XCTSW==40000
SWNYET==20000
SWVOPT==10000!VALSW
DEFINE V(A,B,C,D),<
<SIXBIT/A/>>
SWTAB: SWS ; GENERATE SWITCH NAME TABLE
SWTABN==.-SWTAB ; GET # SWITCHES
DEFINE V(A,B,C,D),<
.ZZZ==0
IFIDN <B><*>,<
.ZZZ==400000>
IFNB <C>,<
.ZZZ==.ZZZ!C>
IFN .ZZZ&XCTSW,< ;; GENERATE INSTR, & POINTER
.ZZZ,,[D]>
IFE .ZZZ&XCTSW,< ;; ELSE JUST ENTER VALUE GIVEN
<.ZZZ_^D18>+<D>> >
SWDTAB: SWS ; GENERATE SWITCH DISPATCH TABLE
PURGE SWS
PURGE .ZZZ
PURGE V
XALL
SWNOQT: SKIPA A4,.+1 ;
XWD A1,RESWRD-.A ; SET UP RESERVED-WORD-TABLE
MOVEM A4,RWS ; POINTER
POPJ SP,
SWTRAC: SKIPN A5 ; VALUE GIVEN ?
MOVEI A5,^D100 ; NO - GIVE DEFAULT
MOVEM A5,TRACLN
TRZ FL,TRLOFF!TRPOFF ; & ENSURE TRACING ON
POPJ SP,
HELPER: MOVE A1,[SIXBIT/ALGOL/]
PUSHJ SP,.HELPR
JRST CSER+1 ; TREAT AS SWITCH-ERROR (GET NEXT LINE)
;
; SWITCH SCANNER DATA
;
RELOC
SWIT: BLOCK 2 ; BUFFER FOR SWITCH
SWDEL: BLOCK 1 ; SWITCH DELIMITER SAVE
SWMASK: BLOCK 1 ; SAVE FOR UNIQUENESS-TEST MASK
SWERR: BLOCK 3 ; INITIALISED FROM HISEG.
; ASCIZ/ switch: / ; END OF ERROR-MESSAGE
RELOC
; INPUT THE COMMAND STRING
GETCS: SETZM CSFILE ; CLEAR COMMAND STRING FILE NAME
SETZM CSFILE+1 ; CLEAR COMMAND STRING EXTENSION NAME
SETZM CSFILE+3 ; CLEAR PROJECT/PROGRAMMER NUMBER
SKIPN CCLSW ; IF ENTRY WAS NOT FROM CCL
JRST GETCS2 ; THEN SKIP THIS PART
; READ CCL COMMAND STRING WITH TMPCOR UUO
SETOM CCLSW ; MARK: CCL COMMAND STRING HAS BEEN READ
SKIPA A4,.+1 ; GET TMPCOR PARAMETER
XWD 2,TEMPC1 ; READ JUST FOR LENGTH OF FILE
TMPCOR A4, ; READ TEMPORARY CORE FILE
SKIPA A3,[440600,,A1] ; READ ERROR, SEE IF THERE IS A DISK FILE
JRST GETCS3 ; CONTINUE
; READ CCL COMMAND STRING FROM DISK
PJOB A4, ; GET JOB NUMBER
IDIVI A4,^D100 ; GET 1ST DIGIT
ADDI A4,20 ; CONVERT TO SIXBIT
IDPB A4,A3 ; PUT IN A1
IDIVI A5,^D10 ; GET 2ND AND 3RD DIGITS
ADDI A5,20 ; CONVERT 2ND DIGIT TO SIXBIT
IDPB A5,A3 ; PUT IN A1
ADDI A6,20 ; CONVERT THIRD DIGIT TO SIXBIT
IDPB A6,A3 ; PUT IT IN A1
HRRI A1,.ALG ; A1 NOW CONTAINS XXXALG
MOVEM A1,CSFILE ; SET FILE NAME
MOVEI A1,.TMP ; THE EXTENSION NAME IS TMP
MOVSM A1,CSFILE+1 ; SET EXTENSION NAME
MOVEI A1,.DSK ; DEVICE IS DSK
MOVSM A1,CSLIST+1 ; SET DEVICE NAME
; OPEN COMMAND STRING FILE, WRITE A "*"
GETCS2: OPEN 5,CSLIST ; OPEN COM STRING DEVICE
JRST TERMIN ; CANT OPEN, QUIT
LOOKUP 5,CSFILE ; FIND THE FILE IF THERE IS ONE
JRST TERMIN ; FILE CANNOT BE READ
SKIPE CCLSW ; IF CALLED FROM CCL
JRST GETCS4 ; THEN DONT PRINT COMMAND STRING STAR
OUTBUF 5,1 ; GET A BUFFER RING
OUTPUT 5,0 ; GET AN OUTPUT BUFFER
MOVEI A4,.STAR ; "*"
IDPB A4,STHEAD+1 ; PUT IN OUTPUT BUFFER
OUTPUT 5,0 ; WRITE IT TO THE TTY
; READ IN COMMAND STRING
GETCS4: INBUF 5,1 ; GET AN INPUT BUFFER RING
AOS A4,CSBLK ; POINT AT DESIRED BLOCK OF CMD STRING
USETI 5,(A4) ; AND TELL MONITOR TO READ IT
INPUT 5,0 ; READ THE COMMAND STRING
STATO 5,20000 ; DID WE REACH END OF THE COMMAND FILE ?
JRST GETCS5 ; NOT YET
SETZM CSBLK ; YES, MARK END-OF-COMMAND-FILE REACHED
SETZM CSTRIN ; AND ENSURE NULL TERMINATOR IN C.S.
JRST GETCS3 ; NOW PROCEED TO FETCH THE NULL TERMINATOR
GETCS5: MOVE A4,CSHEAD ; BUFFER ADDRESS
HRLZI A4,2(A4) ; WHERE COMMAND STRING SITS NOW
HRRI A4,CSTRIN ; WHERE TO MOVE IT TO
MOVE A5,CSHEAD+2 ; GET LENGTH OF BUFFER
IDIVI A5,5 ; IN WORDS
BLT A4,CSTRIN-1(A5) ; AND SAVE THE COMMAND STRING
SETZM CSTRIN(A5) ; CLOBBER OLD GARBAGE
EDIT(117); CORRECT COMMAND SCANNER TO IGNORE LEADING SPACES
GETCS3: MOVE A5,[POINT 7,CSTRIN]; [E117] GET BYTE POINTER TO A5
MOVEM A5,CSP ; [E117] SAVE IT
SKIPL CSCOMP ; IF CURRENT CMD FILE NOT FINISHED
POPJ SP, ; THEN RETURN NOW
ILDB A6,A5 ; [E117] GET NEXT CHAR
CAIE A6,.SPACE ; [E117] IF CHAR IS SPACE
CAIN A6,.TAB ; [E117] OR TAB,
JRST .-3 ; [E117] SKIP OVER IT
CAIN A6,.CR ; IF THE 1ST CHARACTER IS A CR
JRST GETCS ; THEN READ ANOTHER COMMAND STRING
CAIN A6,.CZ ; CONTROL-Z ?
EXIT ; YES - ALL DONE
JUMPL A6,GETCS ; DITTO FOR OTHER TERMINATOR
SETZM CSCOMP ; MARK: COMMAND STRING YET TO BE SCANNED
POPJ SP, ; RETURN
SCANCH: ILDB A6,CSP ; FETCH NEXT CHAR
CAIG A6,172 ; LOWER CASE ?
CAIGE A6,141
JRST SCANC1
SUBI A6,40 ; CONVERT IT TO UPPER CASE
POPJ SP,
SCANC1: CAIE A6,.SPACE ; IGNORE SPACES AND TABS
CAIN A6,.TAB
JRST SCANCH
CAIE A6,.LF
CAIN A6,.VT
JRST SCANC2
CAIE A6,.FF
CAIN A6,.ALT1
JRST SCANC2
CAIE A6,.ALT2
CAIN A6,.ALT3
SCANC2: MOVNI A6,1
CAIE A6,0
POPJ SP,
SKIPE CSFILE ; ARE WE READING A DISK CMD FILE ?
SKIPN CSBLK ; YES, ANY MORE TO COME ?
POPJ SP, ; NO, RETURN NULL TERMINATOR NOW
SETZM CSFILE+3 ; CLEAR CMD FILE PPN
MOVEI A6,.DSK ; DEVICE MUST BE RESET TO DSK
MOVSM A6,CSLIST+1 ; AFTER CALL TO BMOVE AT START1+14
PUSH SP,A4 ; SAVE A4 AND A5 OVER
PUSH SP,A5 ; CALL TO GETCS2
PUSHJ SP,GETCS2 ; TO READ NEXT CMD FILE BLOCK
POP SP,A5 ; RESTORE A5,A4
POP SP,A4
JRST SCANCH
RELOC
;----------------------------------------------------------
OLIST: BLOCK 3 ; "B" DATA MODE (14)
; SIXBIT DEVICE
; XWD BHEAD1,0 ; BUFFER HEADER
OFILE: BLOCK 1 ; SIXBIT FILENAME
BLOCK 1 ; SIXBIT EXTENSION
BLOCK 1 ; TIME/DATE
BLOCK 1 ; PROJECT/PROGRAMMER
BLOCK 1 ; NUMBER OF RING BUFFERS
BHEAD1: BLOCK 1 ; OBJECT BUFFER HEADER BLOCK
BLOCK 1 ; WRITE POINTER
BLOCK 1 ; COUNT
;----------------------------------------------------------
LLIST: BLOCK 1 ; "A" DATA MODE
BLOCK 2 ; SIXBIT DEVICE
; XWD BHEAD2,0 ; BUFFER HEADER
LFILE: BLOCK 1 ; SIXBIT FILENAME
BLOCK 1 ; SIXBIT EXTENSION
BLOCK 1 ; TIME/DATE
BLOCK 1 ; PROJECT/PROGRAMMER
BLOCK 1 ; NUMBER OF BUFFERS
BHEAD2: BLOCK 1 ; LISTING BUFFER HEADER BLOCK
W: BLOCK 1 ; LISTING POINTER
BLOCK 1 ; COUNT
;----------------------------------------------------------
SLIST: BLOCK 1 ; "A" DATA MODE
BLOCK 2 ; SIXBIT DEVICE
; XWD 0,BHEAD3 ; BUFFER HEADER
SFILE: BLOCK 1 ; SIXBIT FILENAME
BLOCK 1 ; SIXBIT EXTENSION
BLOCK 1 ; TIME/DATE
BLOCK 1 ; PROJECT/PROGRAMMER
BLOCK 1 ; NUMBER OF BUFFERS
BHEAD3: BLOCK 1 ; SOURCE BUFFER HEADER BLOCK
P: BLOCK 1 ; READ POINTER
BLOCK 1 ; COUNT
;----------------------------------------------------------
CSLIST: BLOCK 3
; 1 ; "AL" DATA MODE
; SIXBIT /TTY/ ; DEVICE
; XWD STHEAD,CSHEAD ; BUFFER HEADS
CSFILE: BLOCK 1 ; SIXBIT FILE NAME
BLOCK 1 ; SIXBIT EXTENSION
BLOCK 1 ; TIME/DATE
BLOCK 1 ; PROJECT/PROGRAMMER NUMBER
CSHEAD: BLOCK 1 ; BUFFER
CSP: BLOCK 1 ; POINTER
BLOCK 1 ; COUNT
;--------------------------------------------------------
STHEAD: BLOCK 3 ; BUFFER HEADER FOR COMMAND STRING STAR
CSLEN==201 ; LENGTH OF COMMAND STRING BUFFER
CSTRIN: BLOCK CSLEN ; COMMAND STRING BUFFER
CCLSW: BLOCK 1 ; CCL SWITCH. 1=ENTERED FROM CCL
RFLAGS: BLOCK 1 ; READ-MODULE FLAGS
BLOCK1: BLOCK 1 ; BEGINNING OF SYMBOL TABLE BLOCK 1
STACKB: BLOCK 1 ; BEGINNING OF STACK
COREB: BLOCK 1 ; BEGINNING OF CORE ACQUIRED WITH CORE UUO
COREND: BLOCK 1 ; END OF LOW SEGMENT
LTCODE: BLOCK 1 ; LENGTH OF TEMPCODE
CSCOMP: BLOCK 1 ; -1 = COMMAND STRING COMPLETELY SCANNED
; 0 = COMMAND STRING CONTAINS YET ANOTHER COMP.
; 1 = CURRENT LINE OF COM.STRING NOT COMPLETELY SCAND.
CSBLK: BLOCK 1 ; POINTER TO WHICH CMD FILE BLK WE'RE AT
CHKSUM: BLOCK 1 ; CHECK SUM
PNBUF: BLOCK 2 ; PREPARED NAME BUFFER
RELOC
TEMPC1: XWD .ALG,0 ; TMPCOR READ BLOCK
IOWD CSLEN,CSTRIN
SUBTTL ** A RANDOM COLLECTION OF RANDOM ROUTINES **
; TERMINATE COMPILATION DUE TO ABNORMAL CONDITION
TERMIN: OUTSTR TERMSG ; WRITE TERMINATE MSG
EDIT(001); DON'T DELETE OLD .REL-FILE IF DISASTERS STRIKE.
QUIT: CLOSE 1,40 ; [E001] CLOSE OBJECT FILE
CLOSE 2,0 ; CLOSE LISTING FILE
CLOSE 3,0 ; CLOSE SOURCE FILE
SKIPN CSFILE ; HAVE WE A DSK CMD FILE ?
JRST QUIT1 ; NO SO NO NEED TO DELETE IT !
PUSHJ SP,GETCS ; YES, OPEN IT
SETZM CSFILE ; CLEAR ITS NAME
RENAME 5,CSFILE ; AND DELETE IT
JFCL ; IGNORE ERRORS
CLOSE 5,0 ; CLOSE THE DEVICE
SETZM CSBLK ; MARK IT ABSENT
QUIT1: MOVE A4,COREB ; GET ORIGINAL VALUE OF JOBFF
HRRZM A4,.JBFF ; RETURN CORE USED DURING COMPILATION
SETZM COREB ; MARK: RETURNED
EXIT ; RETURN TO MONITOR
; COMMAND STRING ERROR
CSER: OUTSTR CSERM ; WRITE MSG
SETOM CSCOMP ; MARK: COMMAND STRING FULLY SCANNED
SKIPN CCLSW ; TERMINATE IF CALLED FROM CCL
TLNE A7,CSDONE ; IF COMMAND STRING ONLY PART SCANNED
JRST TERMIN ; THEN TERMINATE
JRST START2 ; ELSE GET ANOTHER COMMAND STRING
; WRITE TO LISTING, GET NEXT OUTPUT BUFFER
WRITEL: HLLZ A3,W ; GET S-P BITS
ROT A3,4 ; PUT 1ST 4 BITS IN RIGHT HALF
SETCM A3,MSKTBL(A3) ; GET A MASK FROM TABLE
ANDM A3,@W ; DELETE TRAILING EXTRA CHARS
OUT 2,0 ; GET NEXT OUTPUT BUFFER
JRST .+3 ; -OK, SKIP
OUTSTR LISTER ; -OUTPUT ERROR
JRST TERMIN ; TERMINATE COMP
; WRITTEN OK, MARK END OF NEW BUFFER
MOVE A6,BHEAD2 ; ADDR OF CURRENT BUFFER
HLRZ A3,(A6) ; LENGTH OF BUFFER
TLZ A6,USE ; ZERO USE BIT
ADDI A6,(A3) ; ADD LENGTH TO ADDRESS
MOVEM A6,OBEND ; SAVE ADDR OF END OF BUFFER DATA
POPJ SP, ; EXIT
; ALLOCATE BUFFER SPACE
ALLOCATE:
PUSH SP,.JBFF ; SAVE ADDRESS OF BUFFER
ADDB A1,.JBFF ; SET NEW VALUE OF FREE SPACE POINTER
CAMGE A1,.JBREL ; IF NOT BEYOND END OF LOW SEGMENT
JRST .+3 ; THEN SKIP THIS
CORE A1, ; MOVE UP THE TOP OF THE LOW SEG
JRST TERMIN ; -CANNOT ACQUIRE MORE CORE
POP SP,A1 ; GET ADDRESS OF BUFFER
POPJ SP, ; EXIT ALLOCATE
; CANNOT OPEN SOURCE DEVICE
DSERR1: SKIPA A1,[ ; INCLUDE DEVICE IN MSG
POINT 6,SLIST+1] ; POINTER TO DEVICE NAME
; CANNOT OPEN LISTING FILE
DSERR3: MOVE A4,[POINT 6,LLIST+1] ; LOAD POINTER TO LISTING DEVICE NAME
DSERR0: MOVEI A6,6 ; 6 CHARS LONG
PUSHJ SP,PRENAM ; WRITE TO TTY
OUTSTR ILLDEV ; WRITE REST OF MSG
JRST CSER+1 ; TERMINATE COMP
; WRITE DEVICE NAME ON TTY
PRENAM: MOVE A5,[ ; POINTER TO WHERE
POINT 7,PNBUF] ; PREPARED NAME WILL GO
MOVEI A3,.QUESTION
IDPB A3,A5 ; OUTPUT A "?"
PNL: ILDB A3,A4 ; GET A CHAR
MOVEI A3,40(A3) ; CONV TO ASCII
IDPB A3,A5 ; PUT IN BUFFER
SOJG A6,PNL ; LOOP
IDPB A6,A5 ; END BUFFER WITH A NULL
OUTSTR PNBUF ; WRITE BUFFER TO TTY
POPJ SP, ; EXIT
; CANNOT READ FROM INDICATED SOURCE FILE
DSERR2: HLRZ A4,SFILE+1 ; IF EXTENSION NAME IS NULL
JUMPE A4,.+3 ; THEN THE ERROR IS REAL
SETZM SFILE+1 ; OTHERWISE CHANGE FROM .ALG TO .
JRST CS9 ; AND TRY AGAIN
MOVE A4,[ ; PUT FILENAME IN MSG
POINT 6,SFILE] ; POINTER TO FILENAME
MOVEI A6,6 ; 6 CHARS LONG
PUSHJ SP,PRENAM ; WRITE FILENAME TO TTY
OUTSTR ..DOT ; WRITE DOT TO TTY
MOVEI A6,3 ; 3 CHAR EXTENSION LENGTH
MOVE A5,[POINT 7,PNBUF]
PUSHJ SP,PNL ; WRITE FILENAME EXT TO TTY
MOVE A6,SFILE+1
ANDI A6,7 ; GET LOOKUP RETURN CODE
CAIN A6,2 ; IF RC=2,
JRST READPR ; THEN FILE READ PROTECTED
OUTSTR NOFILE ; ELSE FILE DOESNT EXIST
JRST CSER+1 ; TERMINATE COMP
READPR: OUTSTR READPM ; WRITE MSG
JRST CSER+1 ; TERMINATE COMP
..DOT: ASCIZ /./ ; DOT
IFLAGS: XWD <WITHIN+COMPLETE>&777777,NORMAL ; INITIAL READ MODULE FLAGS
; UNABLE TO CREATE LISTING FILE
DSERR4: OUTSTR UNLIST ; UNABLE TO CREATE LISTING
JRST CSER+1 ; TERMINATE COMP
; PUT 2-DIGIT DECIMAL NUMBER IN LISTING
DEC2: IDIVI A4,^D10 ; A4=TENS, A5=ONES
MOVEI A4,.N0(A4) ; CONV TO ASCII
IDPB A4,A3 ; MOVE TO LISTING
MOVEI A5,.N0(A5) ; CONV TO ASCII
IDPB A5,A3 ; MOVE TO LISTING
IDPB A14,A3 ; MOVE : OR - TO LISTING
POPJ SP, ; EXIT
; RUN THE NEXT CUSP
RUNUUO: SKIPE .JBERR ; IF THERE WERE ERRORS
JRST QUIT ; THEN ABORT LOADING
MOVSI A3,(SIXBIT /SYS/)
MOVEM A3,LB ; SEARCH DEVICE
MOVE A3,OFILE ; GET NAME OF PROGRAM TO BE CALLED
MOVEM A3,LB+1 ; PUT IN PARAMETER BLOCK
SETZM LB+2
SETZM LB+3
SETZM LB+4
SETZM LB+5 ; CLEAR OUT THE REST
HRLZI A4,1 ; ENTER IT AT ITS CCL ENTRY POINT
HRRI A4,LB ; ADDRESS OF PARAMETER BLOCK
RUN A4, ; LOAD AND RUN NEXT CUSP
JRST TERMIN ; CUSP NOT FOUND, STOP
; PUT CURRENT DATE AND TIME IN LISTING
DATIME: MOVE A3,LBP ; GET BUFFER POINTER
DATE A4, ; GET DATE
IDIVI A4,^D372 ; DIVIDE BY 372 DAYS/YEAR
IDIVI A5,^D31 ; DIVIDE BY 31 DAYS PER MONTH
MOVE A1,A5 ; SAVE ACC A5
MOVE A2,A4 ; SAVE ACC A4
MOVEI A14,.MINUS ; -
MOVEI A4,1(A6) ; DAY
PUSHJ SP,DEC2 ; WRITE 2 DIGITS
ROT A1,-1
MOVEI A4,[SIXBIT /JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/](A1)
JUMPGE A1,.+2
TLOA A4,(POINT 6,0,17)
TLO A4,(POINT 6,0,) ; GET MONTH
MOVEI A5,3
ILDB A6,A4
ADDI A6,40
IDPB A6,A3
SOJG A5,.-3 ; AND WRITE IT
IDPB A14,A3
MOVEI A4,100(A2) ; YEAR
PUSHJ SP,DEC2 ; WRITE 2 DIGITS
MOVEI A1,.SPACE ; BLANK
DPB A1,A3 ; INCLUDE
MOVEI A5,3 ; FOUR
IDPB A1,A3 ; BLANKS.
SOJG A5,.-1 ; PUT A BLANK IN LISTING
MSTIME A4, ; GET TIME OF DAY
IDIVI A4,^D1000 ; CONVERT TO SECONDS
IDIVI A4,^D3600 ; DIVIDE BY 3600 SEC/HOUR
IDIVI A5,^D60 ; DIVIDE BY 60 SEC/MIN
MOVE A2,A5 ; SAVE ACC A5
MOVEI A14,.COLON ; :
PUSHJ SP,DEC2 ; WRITE HOUR AS 2 DIGITS
MOVE A4,A2 ; MINUTE
PUSHJ SP,DEC2 ; WRITE 2 DIGITS
MOVE A4,A6 ; SECOND
PUSHJ SP,DEC2 ; WRITE 2 DIGITS
MOVEI A1,0 ; ASCII NULL
DPB A1,A3 ; PUT NULL AT END OF MESSAGE
MOVEI A1,LB ; ADDR OF BUFFER
PUSHJ SP,INSERT ; INSERT LINE IN LISTING
TLNE A7,LTTY ; IF LISTING IS TO TTY:
JRST DATIM1 ; THEN DON'T DO IT
MOVEI A1,COMSTR
PUSHJ SP,INSERT
MOVEI A1,CSTRIN
PUSHJ SP,INSERT
DATIM1: MOVEI A1,LINES3 ; 3 BLANK LINES
PUSHJ SP,INSERT ; INSERT IN LISTING
JRST ICHECK ; ALIGN TO A FULLWORD, EXIT DATIME
RELOC
LINK: BLOCK 1 ; RETURN LINK
LINK1: BLOCK 1 ; RETURN LINK .PINIT
OLDSBR: BLOCK 1 ; OLD SOURCE BUFFER RING
RELOC
; "DEC" WILL CONVERT THE NUMBER IN A4 TO DECIMAL ASCII CHARACTERS,
; AND PLACE THE RESULT DIRECTLY INTO THE LISTING. "DEC" WILL PRINT
; THE NUMBER RIGHT-JUSTIFIED IN A FIELD WHOSE SIZE IS SPECIFIED IN
; A3. "DEC" WILL PRECEDE THE FIRST PRINTABLE CHARACTER OF THE NUMBER
; WITH THE CHARACTER THAT IS SPECIFIED IN RH A2.
; "CRFDEC" WILL FILL THE FIELD WITH THE CHARACTER IN LH A2,
; INSTEAD OF BLANKS
DEC: HRLI A2," " ; BLANK-FILL
CRFDEC: MOVE A1,A3 ; COPY NUMBER OF CHARS
IDIVI A4,^D10 ; DIVIDE BY 10
LSHC A5,-4 ; MOVE REMAINDER TO ACC A3
SOJG A1,.-2 ; LOOP TILL END OF NUMBER
HLRZ A1,A2 ; PUT FILLER IN ACC A1
DEC1: LSHC A5,4 ; GET NEXT CHAR FROM A6
JUMPN A5,DEC3 ; JUMP IF NON ZERO
EDIT (203); ;[203]
CAIN A3,1 ;[203] LAST CHARACTER AND STILL A ZERO?
JRST DEC3 ;[203] GO PRINT IT THEN
IDPB A1,W ; INCLUDE A LEADING BLANK
SOJG A3,DEC1 ; LOOP TILL END OF NUMBER
DEC3: DPB A2,W ; INCLUDE SPECIAL CHARACTER
MOVEI A5,.N0(A5) ; CONVERT TO ASCII
IDPB A5,W ; PUT NUMBER IN LISTING
MOVEI A5,0 ; CLEAR A5
LSHC A5,4 ; GET NEXT CHAR FROM A6
SOJG A3,DEC3+1 ; LOOP TILL END OF NUMBER
POPJ SP, ; EXIT DEC - A3=0 IS RELIED ON!
; DETERMINE WHETHER NL CHAR IS FOR END OF LINE OR END OF BUFFER
NCHECK: MOVE A1,P ; GET READ POINTER
CAMN A1,IBEND ; IF AT END OF BUFFER
JRST INEND1 ; THEN GET ANOTHER BUFFER
JRST SKRET ; EXIT NCHECK
; COMPUTE LENGTH OF TAB
TAB: MOVE A2,CC ; GET CHAR COUNT
SUB A2,LP1 ; COMPUTE POSITION ON CURRENT LINE
ADDI A2,^D8 ; TAB TO THE NEW POSITION
ANDCMI A2,7 ; BACK UP TO 8-CHAR MULTIPLE
SUBI A2,1 ; BACK UP 1 MORE CHAR
ADD A2,LP1 ; COMPUTE NEW CHARACTER COUNT
MOVEM A2,CC ; SE IT
MOVE A2,CTABLE(A1) ; RELOAD THE TABLE ENTRY VALUE
POPJ SP, ; EXIT TAB
CSERM: ASCIZ /?INVALID COMMAND STRING
/
TERMSG: ASCIZ /?COMPILATION TERMINATED
/
LISTER: ASCIZ /?OUTPUT ERROR ON LISTING
/
ILLDEV: ASCIZ / DEVICE NOT AVAILABLE
/
NOFILE: ASCIZ / FILE DOES NOT EXIST
/
DDTMSG: ASCIZ / DDT is loaded
/
HEADIN: ASCIZ /DECSYSTEM-20 ALGOL-60, Version / ; [274]
READPM: ASCIZ / FILE READ PROTECTED
/
UNLIST: ASCIZ /?CANNOT CREATE LISTING FILE
/
LINES3: ASCIZ /
/
FORM: XWD 060000,0
ERRORM: ASCIZ / errors
/
QUERY: ASCIZ /?/
ALGOL: ASCIZ /ALGOL: / ;[251]
ALGDDT: ASCIZ/ALGDDT: /
COMSTR: ASCIZ/
Command string: /
SUBTTL ** RINIT **
; CREATE OBJECT FILE
CS5: SKIPE OFILE ; IF FILE NAME NOT NULL
JRST NOOBJ-1 ; THEN CREATE THE OBJECT FILE
MOVS A5,OLIST+1 ; GET DEVICE NAME
CAIE A5,.DSK ; UNLESS DEVICE NAME IS DSK
PUSHJ SP,WRITE1 ; CREATE OBJECT FILE
; WRITE "ALGOL: NAME "
NOOBJ: PUSHJ SP,WRITE0 ; ELSE CALL WRITE0
TLO A7,CSDONE ; 1ST PART OF CS DONE
SKIPN CCLSW ; IF THIS IS NOT A CCL RUN
JRST LST1 ; THEN SKIP THIS
SKIPN .JBDDT ; IF NO DDT ..
OUTSTR ALGOL ; WRITE "ALGOL: "
SKIPE .JBDDT ; ELSE..
OUTSTR ALGDDT ; ..WRITE "ALGDDT: "
MOVEI A4,6 ; WRITE 6 CHARACTERS OF FILE NAME
MOVE A5,[ ; LOAD A POINTER TO
XWD 440600,SFILE] ; THE NAME OF THE SOURCE FILE
ILDB A6,A5 ; GET NEXT SIXBIT CHARACTER
ADDI A6,40 ; CONVERT IT TO ASCII
TTCALL 1,A6 ; WRITE IT TO TERMINAL
SOJG A4,.-3 ; LOOP
OUTSTR NLCHRS ; WRITE A CR/LF
; CREATE LISTING
LST1: SETZM W ; ZERO W
SKIPE LFILE ; IS THERE A LISTING?
JRST LST ; -YES
MOVS A5,LLIST+1 ; -MAYBE, CHECK DEVICE
CAIN A5,.DSK ; DSK?
JRST NOLST ; -YES, NO LISTING
LST: MOVE A5,LLIST+1 ; GET DEVICE NAME
DEVCHR A5, ; GET DEVICE CHARACTERISTICS WITH DEVCHR
TLNE A5,DEVTTY ; IF LISTING DEVICE IS A TTY
TLO A7,LTTY!NSWIT ; THEN SET INDICATOR
TLNE A5,DEVTTY ; AND
TRZ FL,CREF ; TURN OFF CREF'ING.
OPEN 2,LLIST ; OPEN LISTING
JRST DSERR3 ; -SOMETHING WRONG
OUTBUF 2,@LLIST+7 ; GET A BUFFER RING
HLRZ A3,LFILE+1 ; GET EXT
CAIE A3,777777 ; STILL GARBAGE ?
JRST LST2 ; NO - USE HIS
MOVEI A3,.LST ; YES USE .LST
TRNE FL,CREF ; UNLESS WE'RE CREF'ING
MOVEI A3,.CRF ; IN WHICH CASE USE .CRF
MOVSM A3,LFILE+1
LST2: ENTER 2,LFILE ; CREATE FILE
JRST DSERR4 ; -CANNOT CREATE
TLO A7,EXISTS ; SET FLAG: FILE EXISTS
SETZM FIVEC ; INIT FIVE CHAR COUNT
; PUT HEADING IN LISTING
PUSHJ SP,WRITEL ; GET THE 1ST LISTING BUFFER
MOVEI A1,FORM ; ADDRESS OF A FORM FEED
TLNE A7,LTTY ; IF LISTING IS SENT TO TTY
PUSHJ SP,INSERT ; THEN SEND A FORM-FEED THERE
MOVEI A1,HEADIN ; ADDR OF HEADING
PUSHJ SP,INSERT ; PUT IN LISTING
MOVE A6,LBP ; PREPARE TO PRINT VERSION NUMBER
LDB A1,[POINT 9,.JBVER,11]
EDIT(111); INSERT VERSION NUMBER IN OCTAL
PUSHJ SP,LST4 ; [E111] INSERT OCTAL VALUE
LDB A1,[POINT 6,.JBVER,17]
JUMPE A1,LST3
IDIVI A1,^D26
JUMPE A1,.+3 ; FIRST LETTER OF..
ADDI A1,.A-1
IDPB A1,A6 ; ..MINOR VERSION NUMBER
ADDI A2,.A-1
IDPB A2,A6 ; ..AND ITS SECOND LETTER
LST3: MOVEI A1,.LPAREN
IDPB A1,A6
HRRZ A1,.JBVER ; [E111] GET EDIT NUMBER
PUSHJ SP,LST4 ; [E111] INSERT IT IN OCTAL
MOVEI A1,.RPAREN
IDPB A1,A6
MOVEI A1,.SPACE
MOVEI A4,3
IDPB A1,A6 ; INSERT THREE SPACES
SOJG A4,.-1
MOVEI A1,0
IDPB A1,A6
MOVEI A1,LB
PUSHJ SP,INSERT
PUSHJ SP,DATIME ; PUT DATE, TIME AND COMMAND-STRING IN LISTING
TLNE A7,LTTY ; IF LISTING IS TO TTY
PUSHJ SP,WRITEL ; THEN CLEAR THE BUFFER
JRST NOLST1 ; CONTINUE
LST4: IDIVI A1,10 ; [E111] SPLIT OFF OCTAL DIGIT
JUMPE A1,LST5 ; [E111] JUMP IF ALL DONE
HRLM A2,(SP) ; [E111] OTHERWISE SAVE DIGIT
PUSHJ SP,LST4 ; [E111] AND INSERT EARLIER
HLRZ A2,(SP) ; [E111] DIGITS FIRST.
LST5: ADDI A2,.N0 ; [E111] CONVERT TO ASCII
IDPB A2,A6 ; [E111] INSERT IN TEXT
POPJ SP, ; [E111] AND RETURN
NOLST: HRRI A7,NLIST1 ; SET FLAGS ADDR
; INITIALIZE VARIABLES AND TABLES
NOLST1: SETZM CC ; INIT CHARACTER COUNT
IFN FTSTATS,<
SETZM DEFCNT ; INIT
SETZM IDCHRS ; STATS
SETZM REFCNT ; COUNTERS.
>
SETZM OLDNO ; INIT OLD LINE NUMBER
SETZM LINE5 ; INIT 5-CHAR LINE NUMBER
SETZM LSBUFP ; INIT NAME BUF LIST POINTER
SETZM BNUM ; INIT BEGIN NUMBER
SETZM LBNUM ; INIT LAST BEGIN NUMBER
SETZM ENUM ; INIT END NUMBER
SETZM LENUM ; INIT LAST END NUMBER
SETZM NSYM ; INIT NSYM
SETZM PLIST+4 ; INIT PLIST+4
SETZM NDEL ; INIT NDEL
SETZM DUBBLE ; INIT DUBBLE
SETZM BLEX ; INIT BUFFERED LEXEME
SETZM .JBERR ; INIT ERROR COUNT
SETZM WRNCNT ;[171] INIT WARNING COUNT
SETZM TBLEN ; INIT TMPBUF DATA LENGTH WORD
SETZM SSTART ; INIT SEGMENT START
SETZM LINENO ; INIT LINENO
SETZM NXTSLN ; CLEAR NEXT STATEMENT NUMBER FOR SYM
SETZM NXTDLN ; AND DEL (WILL BE COPIED BY RUND)
SETOM LSTSLN ; MAKE LAST AN IMPOSSIBLE VALUE
SETOM LASTRA ; MAKE SURE FIRST STN IS SENT
SETZM SENDSN ; MARK NOT SET UP YET
SETZM STCFL ; INIT STRING CHARACTERS FLAG
MOVEI A4,50 ; SET THE BEGIN TABLE INDEX
MOVEM A4,BTI ; TO 50
MOVEI A4,MTABLE ; ADDRESS OF MTABLE
MOVEM A4,NAMTE ; INIT MESSAGE TABLE POINTER
MOVEI A4,PLIST+3 ; ADDR OF POINTER TABLE
MOVEM A4,PLIST ; INIT UP-ARROW LIST
MOVEM A7,RFLAGS ; SAVE THE FLAGS
HRRZ A4,.JBFF ; GET ADDRESS OF FREE SPACE
MOVEM A4,TCBASE ; USE AS BASE FOR ALLOCATION
JSP A1,.PINIT ; ALLOCATE TABLES
MOVEM A7,A7SAV ; SAVE A7
MOVE A7,RFLAGS ; GET FLAGS AGAIN
PUSHJ SP,READ ; READ IN FIRST LINE OF SOURCE
EMPTY: TLZ A7,WITHIN ; MARK: WITHIN NEWLINE
MOVE A2,P ; GET READ POINTER
MOVEM A2,LSTART ; SAVE POINTER TO LINE START
PUSHJ SP,NL11 ; CHECK FOR LINE NUMBERS, ETC
HALT . ; CANT POSSIBLY RETURN HERE
EMPTY1: SETOM NDEL ; MAKE IT LOOK LIKE SOMTHING IS IN NDEL
PUSHJ SP,RUND ; DO AN INITIAL RUND
AOJA DEL,@LINK ; CLEAR DEL AND EXIT
SUBTTL ** PINIT **
.PINIT: MOVEM A1,LINK1 ; SAVE RETURN LINK
; INITIALIZE VARIABLES
SETZM TOFIXI ; INIT FIXUP TABLE HALFWORD INDEX
SETZM RA ; INIT PROGRAM COUNTER
SETZM FNLEVEL ; INIT FUNCTION LEVEL
SETZM BLOCKL ; INIT BLOCK LEVEL
SETZM LEXBLOCK ; INIT LEXICAL BLOCK LEVEL
SETZM CURBLOCK ; INIT CURRENT BLOCK LEVEL
SETZM THUNK ; INIT THUNK
SETOM CAX ; INIT CAX
SETOM PROSKIP ; INIT PROCEDURE SKIP
HRLZI DBASE,400000 ; INIT DISPLAY POINTER
HRLZI DBASE+1,400000 ; INIT DISPLAY POINTER
MOVEI A4,A13+1 ; INIT
MOVEM A4,LAC ; LAC
HRLZI STOPS,160000 ; INIT STOPS
; ACQUIRE SPACE FOR TABLES
MOVE A5,TCBASE ; BASE OF AVAILABLE CORE
ADD A5,LTCODE ; THE LENGTH OF TEMPCODE
ADDI A5,TABLES+CONL+STACKL+1
; PLUS THE LENGTH OF SYMBOL AND FIXUP TABLES
; PLUS LENGTH OF CONSTANT TABLE
; PLUS LENGTH OF STACK
MOVEM A5,COREND ; SAVE THE CALLI PARAMETER
HRRZM A5,.JBFF ; SET NEW VALUE OF JOBFF
CORE A5, ; GET CORE FOR ALL OF THAT
JRST TERMIN ; CORE NOT AVAILABLE, TERMINATE
; ALLOCATE TABLES
MOVE SP,TCBASE ; BASE OF TEMPCODE
MOVEM SP,INDEX ; SET THE TEMPCODE INDEX
ADD SP,LTCODE ; ADD LENGTH OF TEMPCODE
MOVEM SP,TCMAX ; SET END OF TEMPCODE
ADDI SP,1 ; LEAVE 1 WORD BETWEEN SYMBOL TABLE AND TEMPCODE
MOVEM SP,BLOCK1 ; WHICH IS ALSO THE START OF THE SYMBOL TABLE
MOVEM SP,STBB ; START OF CURRENT BLOCK IN SYMBOL TABLE
MOVEM SP,NASTE ; 1ST AVAILABLE ENTRY IN SYMBOL TABLE
ADDI SP,TABLES ; ADD LENGTH OF TABLES
MOVEM SP,CONTAB ; SET BASE OF CONSTANT TABLE
MOVEM SP,FIXUP ; WHICH IS ALSO THE BASE OF THE FIXUP TABLE
MOVEM SP,LASTST ; END OF STRING CHAIN
MOVEI A5,1(SP) ; STEP OVER 1ST WORD OF CONSTANTS TABLE
MOVEM A5,NACTE ; SET NEXT AVAILABLE CONSTANT TABLE ENTRY
MOVEI A5,-1(SP) ; BACK UP 1
MOVEM A5,NAFTE ; SET NEXT AVAILABLE FIX-UP TABLE ENTRY
MOVEM A5,LASTC1 ; SET CONSTANT TABLE POINTER
MOVEI A5,-2(SP) ; BACK UP 1 MORE
MOVEM A5,LASTC2 ; SET CONSTANT TABLE POINTER
ADDI SP,CONL ; ADD LENGTH OF CONSTANT TABLE
MOVEM SP,CONEND ; SET END OF CONSTANT TABLE
MOVEM SP,STACKB ; SAVE BEGINNING ADDR OF STACK
HRLI SP,-STACKL ; SET UP STACK POINTER
MOVE A4,INDEX ; TEMPCODE POINTER
HRLI A4,770000 ; INIT
MOVEM A4,HANDLE ; HANDLE
HRREI A4,-1 ; THE 1ST ENTRY IN THE CONSTANTS TABLE MUST
PUSHJ SP,CON1 ; BE A CONSTANT OF -1
MOVEI A1,B0LIST## ; INIT LIST
PUSHJ SP,BMOVE ; INITIALIZE BLOCK-0 FROM HIGH SEGMENT
JRST @LINK1 ; EXIT .PINIT
SUBTTL ** TABLE OVERFLOW ROUTINES **
; SYMBOL TABLE OR FIXUP TABLE OVERFLOW
OVFL1: PUSHJ SP,OVFLS ; SAVE SOME REGISTERS
MOVE A4,NAFTE ; BASE OF CORE TO MOVE
PUSHJ SP,OVFL ; MOVE IT
ADDM A4,CONTAB ; UPDATE BASE OF CONSTANT TABLE
ADDM A4,FIXUP ; UPDATE BASE OF FIXUP TABLE
ADDM A4,LASTST ; UPDATE STRING CHAIN
ADDM A4,NACTE ; UPDATE CONSTANT TABLE POINTER
ADDM A4,NAFTE ; UPDATE FIXUP TABLE POINTER
ADDM A4,LASTC1 ; UPDATE 1-WORD CONSTANT CHAIN
ADDM A4,LASTC2 ; UPDATE 2-WORD CONSTANT CHAIN
OVFL3: ADDM A4,CONEND ; UPDATE POINTER TO END OF CONSTANT TABLE
ADDM A4,STACKB ; UPDATE BASE OF STACK
MOVE A4,OVA ; RESTORE A4
MOVE A5,OVB ; RESTORE A5
MOVE A6,OVC ; RESTORE A6
MOVE A3,OVD ; RESTORE A3
POPJ SP, ; EXIT OVFL1 OR OVFL2
; CONSTANTS TABLE OVERFLOW
OVFL2: PUSHJ SP,OVFLS ; SAVE SOME REGISTERS
MOVE A4,CONEND ; BASE OF CORE TO MOVE
PUSHJ SP,OVFL ; MOVE IT
JRST OVFL3 ; CONTINUE
OVFL: MOVEI A5,DELTA ; LENGTH OF CORE TO ACQUIRE
ADDB A5,COREND ; NEW END OF LOW SEGMENT
HRRZM A5,.JBFF ; SET JOBFF
CORE A5, ; GET SOME MORE CORE
JRST OVFLX ; -CANT GET IT
MOVE A5,COREND ; GET NEW END OF CORE
ADDI A5,1-DELTA ; BLT "TO" ADDRESS
HRLI A5,-DELTA(A5) ; BLT "FROM" ADDRESS
JRST OVFLL1 ; JUMP INTO MOVE LOOP
OVFLL: MOVE A3,A5 ; COPY BLT PARAM TO A3
BLT A3,DELTA-1(A5) ; MOVE A DELTA OF CORE
SUB A5,[ ; COMPUTE THE NEXT BLT CONSTANT
XWD DELTA,DELTA] ; BACK UP TO NEXT DELTA
OVFLL1: HLRZ A6,A5 ; GET THE "FROM" ADDRESS
CAILE A6,(A4) ; IF ABOVE THE BASE OF CORE TO MOVE
JRST OVFLL ; THEN CONTINUE LOOPING
HRL A4,A4 ; FORM A NEW BLT POINTER FOR
ADDI A4,DELTA ; CORE OF SIZE LESS THAN DELTA
MOVE A3,A4 ; COPY BLT CONSTANT TO A3
BLT A3,DELTA-1(A5) ; MOVE THE LESS THAN DELTA CORE
MOVE A4,[ ; CORRECTION FACTOR FOR DISPLAY POINTERS
XWD DELTA,DELTA] ; VALUE
MOVEI A5,DBASE ; HEAD OF CHAIN
ADDM A4,(A5) ; UPDATE THE POINTER
HLRE A5,(A5) ; LOCATE NEXT DISPLAY POINTER IN CHAIN
JUMPG A5,.-2 ; LOOP UNLESS END OF LIST
MOVEI A5,DBASE+1 ; HEAD OF CHAIN
ADDM A4,(A5) ; UPDATE THE POINTER
HLRE A5,(A5) ; LOCATE NEXT DISPLAY POINTER IN CHAIN
JUMPG A5,.-2 ; LOOP UNLESS END OF LIST
MOVEI A4,DELTA ; UPDATE FACTOR
ADD SP,A4 ; SET POINTER TO NEW LOCATION OF STACK
POPJ SP, ; EXIT OVFL
OVFLX: OUTSTR OVFLXM ; SEND MSG TO TTY
JRST TERMIN ; TERMINATE COMPILATION
OVFLXM: ASCIZ /?MORE CORE REQUIRED
/
OVFLS: MOVEM A4,OVA ; SAVE A4
MOVEM A5,OVB ; SAVE A5
MOVEM A6,OVC ; SAVE A6
MOVEM A3,OVD ; SAVE A3
POPJ SP, ; EXIT OVFLS
; STACK OVERFLOW ALLOCATING STACK LOCALS
OVFL5: MOVEM A4,OVA ; SAVE ACC A4
MOVE A4,.STOVE ; GET RETURN LINK
MOVEM A4,.JBTPC ; SAVE IN JOBTPC
JRST .+2 ; SKIP
; STACK OVERFLOW BY PUSH OR PUSHJ
OVFL4: MOVEM A4,OVA ; SAVE IN ACC A4
MOVEI A4,DELTA ; CORE INCREMENT
ADDB A4,COREND ; NEW END OF LOW SEGMENT
HRRZM A4,.JBFF ; SET JOBFF
CORE A4, ; GET MORE CORE
JRST OVFLX ; -NOT AVAILABLE, TERMINATE
HRLZI A4,-DELTA ; CORRECTION CONSTANT
ADD SP,A4 ; FIX UP STACK POINTER
MOVE A4,OVA ; RESTORE ACC A4
JRST 2,@.JBTPC ; RETURN TO COMPILATION
RELOC
OVA: BLOCK 1
OVB: BLOCK 1
OVC: BLOCK 1
OVD: BLOCK 1
.STOVE: BLOCK 2 ; RETURN LINK
; JRST OVFL5 ; JUMP INTO HIGH SEGMENT
RELOC
SUBTTL ** NEW-LINE **
; *** NEW-LINE ROUTINE ***
;
; THIS ROUTINE IS CALLED WHENEVER A CARRIAGE-RETURN, LINE-FEED,
; OR OTHER SUCH CHARACTER IS SCANNED. NEWLINE PERFORMS ALL I/O
; PROCESSING ASSOCIATED WITH THE SOURCE AND LISTING FILES.
; NEWLINE RETURNS IN REGISTER A1 THE 1ST CHAR OF THE NEXT
; LINE. REGISTERS A1 - A6 ARE NOT SAFE OVER NEWLINE.
;
;
; THROUGHOUT THE COMPILER, CHARACTERS ARE SCANNED WHERE THEY SIT
; IN THE SOURCE BUFFER RING. CHARACTERS ARE READ WITH AN "ILDB".
; THE LISTING IS FORMED BY TRANSFERING CHARACTERS FROM THE SOURCE
; BUFFER RING TO THE LISTING BUFFER RING WITH A "BLT" INSTRUCTION.
; A "BLT" IS 20 TIMES FASTER PER CHARACTER THAN AN "IDPB", ALTHOUGH
; THERE IS A GREATER OVERHEAD INVOLVED AT THE BEGINNING OF EACH LINE.
;
; THE FOLLOWING ARE SOME OF THE CHARACTERISTICS OF THE "NEWLINE" ROUTINE:
;
; 1.) THE POSITIONS OF THE CHARACTERS IN THE WORDS MUST BE THE SAME
; IN THE SOURCE AND LISTING BUFFERS. THEREFORE, ANYTHING ELSE THAT APPEARS
; IN THE LISTING MUST BE ARRANGED IN STRINGS THAT ARE A MULTIPLE OF
; 5 CHARACTERS AND WHICH ARE MOVED TO THE LISTING WITH IDPB'S.
; THIS INCLUDES THE LINE PREFIX (ON THE FRONT OF EACH LINE OF ALGOL
; TEXT IN THE LISTING), WHICH ALSO MUST BE A MULTIPLE OF 8 PRINTABLE
; CHARACTERS SO THAT TABS ALIGN CORRECTLY.
;
; 2.) THE LINE IS MOVED FROM THE SOURCE BUFFER RING TO THE LISTING BUFFER
; RING AFTER THE LINE HAS BEEN SCANNED, SINCE UNTIL THEN THE EXTENT
; OF THE LINE IS NOT KNOWN. WHENEVER A NEW SOURCE BUFFER IS OBTAINED
; FROM THE SOURCE DEVICE, A WORD CONTAINING A CR/LF IS INSERTED AFTER
; THE DATA IN THE BUFFER TO MARK ITS END. THUS, WHENEVER A CR IS SCANNED
; A CHECK MUST BE MADE TO SEE IF IT IS THE END OF THE BUFFER.
; 3.) A CONSIDERABLE AMOUNT OF CODE IS DEDICATED TO HANDLING THE
; FOLLOWING EXCEPTIONAL CASES: WHEN THE LINE WONT FIT IN WHAT IS LEFT
; OF THE OUTPUT BUFFER ("SHOB1" AND "SHOB2"), AND WHEN THE SOURCE
; LINE IS SPLIT OVER TWO INPUT BUFFERS ("INEND" AND "SHIB").
; WHEN THE INPUT LINE IS SPLIT OVER TWO INPUT BUFFERS, THE 1ST PART
; MUST BE SAVED (IN "TMPBUF") WHILE THE 2ND PART IS BEING SCANNED,
; SINCE ONCE THE NEW INPUT BUFFER IS OBTAINED, THE OLD INPUT BUFFER IS
; NO LONGER RELIABLE.
; THE RIGHT HALF OF RFLAGS CONTAINS
; THE ADDRESS OF ONE OF THE FOLLOWING:
; NORMAL:
; NOLIST:
; NLIST1:
; ENDPRG:
NEWLINE: MOVEM A7,A7SAV ; SAVE A7
MOVE A7,RFLAGS ; GET READ MODULE FLAGS
JRST (A7) ; GO TO APPROPRIATE ROUTINE
; LISTING EXISTS AND WAS ON
NORMAL: SETCM A2,A7 ; IF SOURCE
TLNN A2,TTY!LTTY ; AND LISTING ARE TTY
JRST NLIST1 ; THEN SUPRESS LISTING
TRNN FL,LISTOO ; DID HE TURN LISTING OFF?
JRST TURNOF ; -YES
; LISTING EXISTS AND IS ON
TURNON: MOVE A2,P ; PUT READ POINTER IN A2
TLNE A7,ESWIT ; IF LINE NUMBERS IN 73-80
MOVE A2,LINEND ; THEN GET TRUE READ POINTER
MOVEM A2,P ; SAVE TRUE READ POINTER
CAMN A2,IBEND ; AT END OF INPUT BUFFER?
JRST INEND ; -YES, GET ANOTHER
TLO A7,WITHIN ; WE ARE WITHIN THE NEWLINE ROUTINE
; PRINT THE 1ST BATCH OF MESSAGES
MOVEI A5,MTABLE ; ADDR OF MESSAGE TABLE
CAML A5,NAMTE ; IF END OF TABLE
JRST NL2 ; THEN NO MESSAGES TO PRINT
SETZM LMSGS ; SET LMSG SWITCH TO "1ST PASS"
PUSHJ SP,LMSG ; PRINT 1ST GROUP OF MESSAGES
NL2: SKIPLE FFCNT2 ; IF THERE ARE FORM-FEEDS THAT HAVE NOT
PUSHJ SP,INSFF ; YET BEEN PUT IN LISTING, PUT THEM THERE
PUSHJ SP,CREFNL ; IF CREF, DO CREF STUFF
; MAKE SURE THAT THERE IS ROOM IN OUTPUT BUFFER FOR 1ST PART OF LINE
MOVEI A1,.SPACE ; PUT A BLANK IN ACC A1
MOVE A4,W ; GET WRITE POINTER
TLNE A7,LTTY ; IF THE LISTING IS TO THE TTY
JRST NL15 ; THEN PRODUCE A DIFFERENT LISTING
MOVEI A4,5(A4) ; GO AHEAD 5 WORDS
CAML A4,OBEND ; AT END OF BUFFER?
PUSHJ SP,SHOB1 ; -YES, GET ANOTHER
; PRINT PROGRAM COUNTER
SETZM (A4) ; CLEAR 1ST CHARS OF TEXT
MOVEI A5,6 ; PRINT 6 CHARS
TLNE A7,TMG ; IF NO REL FILE
JRST NL18 ; THEN DONT PRINT PC
MOVE A4,[ ; LOAD A POINTER TO
POINT 3,RA,17] ; PROGRAM COUNTER
NL1: ILDB A6,A4 ; GET 3 BITS
MOVEI A6,.N0(A6) ; CONV TO ASCII
IDPB A6,W ; PUT IN LISTING
SOJG A5,NL1 ; LOOP
NL19: IDPB A5,W ; INCLUDE A NULL
; PRINT BEGIN NUMBER
MOVE A4,BNUM ; LOAD BEGIN NUMBER
CAMN A4,LBNUM ; COMPARE TO LAST BEGIN NUMBER
JSP A3,NL3 ; -SAME, PRINT SOME BLANKS
MOVEM A4,LBNUM ; SAVE AS LAST BEGIN NUMBER
MOVEI A2,.B ; WRITE A "B"
MOVEI A3,5 ; WRITE 5 CHARS
PUSHJ SP,DEC ; WRITE IT
; PRINT END NUMBER
MOVE A4,ENUM ; LOAD END NUMBER
CAMN A4,LENUM ; COMPARE TO LST END NUMBER
JSP A3,NL3 ; -SAME, PRINT SOME BLANKS
MOVEM A4,LENUM ; SAVE AS LAST END NUMBER
MOVEI A2,.E ; WRITE AN "E"
MOVEI A3,5 ; WRITE 5 CHARS
PUSHJ SP,DEC ; CONVERT TO DECIMAL
JRST NL6 ; CONTINUE
; SUBROUTINE FOR PUTTING 5 BLANKS IN LISTING INSTEAD OF BEGIN/END NUMBER
NL3: MOVEI A5,5 ; WRITE 5 BLANKS
IDPB A1,W ; INCLUDE A BLANK
SOJG A5,.-1 ; LOOP
JRST 4(A3) ; EXIT
; PUT 6 BLANKS IN LISTING INSTEAD OF PC
NL18: IDPB A1,W ; PUT BLANK IN LISTING
SOJG A5,NL18 ; LOOP 5 MORE TIMES
JRST NL19 ; CONTINUE
; PUT LINE NUMBER IN LISTING
NL6: TLZN A7,ELINE ; IF TEXT HAS A LINE NUMBER
TLNE A7,ESWIT ; OR NUMBERS IN 73-80
JRST NL5 ; THEN DONT GENERATE A LINE NUMBER
MOVE A4,LINENO ; GET LINE NUMBER
MOVEI A2,.SPACE ; ACC A2 = BLANK
MOVEI A3,7 ; PRINT 7 CHARS LONG
PUSHJ SP,DEC ; CONVERT TO DECIMAL
JRST NL7 ; CONTINUE
NL5: MOVEI A3,0
IDPB A3,W ; INSERT A NULL
IDPB A1,W ; INCLUDE ANOTHER SPACE
TLNN A7,ESWIT ; IF NOT NUMBERS IN 73-80
JRST NL7 ; THEN SKIP THIS PART
MOVE A2,CHAR ; GET THE SAVED CHARACTER
DPB A2,CHARP ; REINSERT IT INTO ITS PLACE IN THE LINE
; READ THE LF THAT FOLLOWS THE CR
NL7: IDPB A1,W ; PUT BLANK IN LISTING
MOVE A2,P ; LOAD READ POINTER
PUSHJ SP,GETNL ; READ NEXT CHAR
MOVE A3,CTABLE(A1) ; GET TABLE ENTRY
CAIN A3,4 ; IF IT IS A LF
MOVEM A1,CHAR2 ; THEN SAVE THIS CHAR
CAIE A3,4 ; IS IT A LF?
ADD A2,[ ; BACK UP POINTER
XWD 070000,0] ; POINTER DECREMENT CONSTANT
; PUT 1ST WORD OF LINE TEXT IN OUTPUT BUFFER
MOVE A6,LSTART ; POINTER TO BEGINNING OF LAST LINE
MOVEM A2,LSTART ; SET NEXT LINE START
HLLZ A4,W ; GET WRITE POINTER S-P BITS
ROT A4,4 ; PUT 1ST 4 BITS IN RIGHT HALF
MOVE A4,MSKTBL(A4) ; GET A MASK
AND A4,@A6 ; MASK OFF EXTRANEOUS CHARS
IORM A4,@W ; PUT REMAINING CHARS IN LISTING
; MOVE REMAINDER OF ALGOL TEXT TO OUTPUT BUFFER WITH A BLT
AOS A5,W ; STEP WRITE POINTER AND LOAD IT
HRLI A5,1(A6) ; STEP OLD READ POINTER
SKIPE TBLEN ; IS INPUT LINE SPLIT OVER 2 BUFFERS?
JRST SHIB ; -YES, TREAT SEPARATELY
MOVEI A4,(A2) ; CURRENT READ POINTER ADDRESS
SUBI A4,1(A6) ; CURRENT LINE LENGTH
ADDI A4,@W ; END OF LINE IN WRITE BUFFER
;
; Edit(1005) Deal with very long source lines correctly
;
NL14: CAMGE A4,OBEND ; [E1005] WILL LINE OVERFLOW OUTPUT BUFFER?
JRST .+3 ; [E1005] - NO, SO OK
PUSHJ SP,SHOB2 ; [E1005] - YES, HANDLE WITH CARE
JRST NL14 ; [E1005] TRY AGAIN
CAIL A4,(A5) ; NEGATIVE LENGTH?
NL13: BLT A5,(A4) ; MOVE THE LINE
HLL A4,A2 ; FORM NEW WRITE POINTER
MOVEM A4,W ; SAVE IT
; PRINT 2ND BATCH OF MESSAGES
NL10: PUSHJ SP,GETNL ; STEP TO NEXT CHAR
MOVEI A5,MTABLE ; ADDR OF MESSAGE TABLE
CAML A5,NAMTE ; IF NO MESSAGES IN TABLE
JRST NL9 ; THEN SKIP THIS PART
SETOM LMSGS ; SET LMSG SWITCH TO 2ND PASS
PUSHJ SP,LMSG ; PRINT REST OF MSGS
MOVEI A1,MTABLE ; START OF MESSAGE TABLE
MOVEM A1,NAMTE ; SET POINTER TO START OF TABLE
; PROCESS ANY FORM FEEDS
NL9: LDB A1,A2 ; GET THE NEXT CHAR
JUMPN A1,.+3 ; SKIP THIS IF NOT A NULL
PUSHJ SP,GETNL ; READ THE NEXT CHAR
JUMPE A1,.-1 ; READ ANOTHER IF IT IS A NULL
TLZ A7,WITHIN ; WE ARE ABOUT TO EXIT THE NEWLINE ROUTINE
CAIE A1,.FF ; IF IT IS NOT A FORM-FEED
JRST NL11+1 ; THEN SKIP THIS PART
PUSHJ SP,FFOUND ; PROCESS THE FORM-FEED
JRST NL9+2 ; LOOK FOR ANOTHER FORM-FEED
; SKIP OVER ANY NULLS AT BEGINNING OF NEXT LINE
NL11: PUSHJ SP,GETNL ; READ NEXT CHAR
JUMPE A1,NL11 ; READ AGAIN IF A NULL
; PROCESS LINE NUMBER IF ANY
TLNE A7,ESWIT ; IF NUMBERS IN 73-80
JRST COL73 ; THEN SCAN THE LINE NUMBER
MOVE A4,LINENO ; GET OLD LINE NUMBER
MOVE A5,(A2) ; PICK UP FIRST WORD
TRNN A5,1 ; IS IT A LINE NUMBER?
AOJA A4,NL8 ; -NO, INCREMENT LINE NO. AND SKIP
CAIN A1,.SPACE ; IF LINE NUMBER IS BLANK
JRST BLN ; THEN JUMP
MOVEI A5,4 ; SCAN NEXT 4 CHARS
MOVEI A4,-.N0(A1) ; CONVERT 1ST CHAR TO DECIMAL
PUSHJ SP,GETNL ; GET NEXT CHAR
IMULI A4,^D10 ; MULTIPLY PREVIOUS RESULT BY 10
ADDI A4,-.N0(A1) ; ADD IN CURRENT CHAR
SOJG A5,.-3 ; LOOP
PUSHJ SP,GETNL ; SKIP OVER TAB
SOS CC ; DONT COUNT THIS AS A POSITION
CAIN A1,.FF ; IF IT IS A FORM-FEED
PUSHJ SP,FFOUND ; THEN PROCESS IT
CAIE A1,.TAB ; IF IT IS NOT A TAB
JRST NOTAB ; THEN TREAT SEPARATELY
NL16: PUSHJ SP,GETNL ; GET NEXT CHAR
CAIE A1,.FF ; IF IT IS NOT A FORM-FEED
JRST .+3 ; THEN SKIP THIS PART
PUSHJ SP,FFOUND ; PROCESS IT
JRST NL16 ; READ ANOTHER CHAR
TLO A7,ELINE ; MARK: EDITOR LINE NUMBER SCANNED
; SAVE ALL LINE POINTERS
NL8: MOVE A5,CC ; GET POSITION COUNT
EXCH A4,LINENO ; SET NEW LINE NUMBER
EXCH A5,LP1 ; SET START OF CURRENT LINE
TLZE A7,BLANKL ; IF THIS WAS A BLANK LINE
JRST .+3 ; THEN SKIP
MOVEM A4,OLDNO ; SET OLD LINE NUMBER
MOVEM A5,LP2 ; SET START OF PRECEDING LINE
; CHECK FOR A BLANK LINE
MOVE A5,CTABLE(A1) ; GET CHARS TABLE ENTRY
CAIN A5,4 ; IF IT IS A NEW LINE CHAR
TLO A7,BLANKL ; THEN MARK THIS A BLANK LINE
; EXIT FROM NEWLINE
MOVEM A2,P ; SAVE READ POINTER
PUSHJ SP,CREFST ; O/P CREF START DATA, IF WE'RE CREF'ING
MOVEM A7,RFLAGS ; STORE READ-MODULE FLAGS
MOVE A7,A7SAV ; RESTORE A7
JRST SKRET ; EXIT NEWLINE
SUBTTL ** SUBROUTINES OF NEWLINE **
; ROUTINES FOR CROSS-REFERENCING.
CREFIT: ; ENTER WITH LEXEME OF IDENTIFIER IN A1. CALLED FROM SEARCH.
MOVE A2,SYMNAM(A1) ; GET FIRST WORD OF NAME
ANDI A2,77 ; GET # CHARS - 1
ADDI A2,1
DPB A2,[POINT 7,CREFRF,13] ; PUT INTO CREF DATA
ADDI A2,3 ; ALLOW FOR ^A^? AND POSSIBLE ^B
ADDM A2,CRFCNT ; UPDATE CHAR-COUNTER
PUSHJ SP,NAME ; GET NAME IN ASCIZ
MOVEI A1,CREFRF
EXCH A7,RFLAGS ; GET READ-MODULE FLAGS
PUSHJ SP,INSERT ; OUTPUT (<DEL> B) ^A^?
MOVEI A1,LB ; WHERE NAME ROUTINE LEFT IT
PUSHJ SP,INSERT ; SYMBOL NAME
MOVEI A1,CREFDF ; DEFINITION FLAG
HRRZ A2,NDEL ; GET TERMINATING DELIMITER,
CAIN A2,15 ; AND IF IT IS A COLON THEN
JRST CREFLB ; THIS IS A LABEL DEFINITION
TRNN FL,DECLAR ; DECLARATION ?
SOSA CRFCNT ; NO - DON'T ALLOW FOR ^B IN COUNT OF CHARS
CREFLB: PUSHJ SP,INSERT ; YES - TELL CREF
EXCH A7,RFLAGS ; PUT READ-MODULE FLAGS AWAY.
POPJ SP, ; BACK TO SEARCH
CREFNL: ; CALLED BY NEWLINE JUST BEFORE PRINTING SOURCE-LINE
MOVEI A1,CREFND ; END CREF DATA
JRST CRFNL3
CRFNL2: MOVEI A1,[BYTE(7)177,"D"] ; <DEL>D - END CREF DATA - NO LINE #
CRFNL3: SKIPE CRFCNT ; ANY CREF'ING DONE ON THIS LINE ?
TRNN FL,CREF ; ANY CREF'ING AT ALL ?
POPJ SP, ; NO
PUSHJ SP,INSERT ; <DEL> A
AOS CRFCNT ; ALLOW FOR <DEL>A
AOS A1,CRFCNT ; # OF CHARACTERS OUTPUT BY CREF
IDIVI A1,5 ;
JUMPE A2,CRFNL1 ; WHOLE # OF WORDS ?
SUBI A2,5
MOVEM A2,CRFCNT ; NO - MUST MAKE IT SO
PUSHJ SP,INSNUL ; BY PUTTING IN NULLS
AOSE CRFCNT ; ENOUGH ?
JRST .-2 ; NO
CRFNL1: SETZM CRFCNT ; CLEAR COUNT
POPJ SP,
CREFST: ; OUTPUT START-OF-CREF DATA, IF REQUIRED.
SKIPN CRFCNT ; NOT ALREADY STARTED, AND...
TRNN FL,CREF ; CREF ?
POPJ SP, ; NO
PUSH SP,A1 ; YES - SAVE A1 (USED IN NEWLINE)
MOVEI A1,[BYTE(7)177,"B"] ;<DEL>B - START CREF DATA
PUSHJ SP,INSERT ; OUTPUT IT
MOVEI A1,2 ; UPDATE
ADDM A1,CRFCNT ; CREF COUNTER
POP SP,A1
POPJ SP,
CREFDF: BYTE(7)2,0,0,0,0 ; ^B (DEFINITION FLAG)
CREFND: BYTE(7)177,"A",0,0,0 ; <DEL> A (END OF CREF DATA)
RELOC
CREFRF: BLOCK 1
; BYTE(7)1,0,0,0,0 ; ^A (SYMBOL REF. 2ND BYTE PLUGGED WITH LENGTH)
CRFCNT: BLOCK 1 ; # OF CHARS O/P BY CREF
RELOC
; BRIEF FORM OF LISTING FOR WHEN SENT TO TTY
NL15: TLNN A7,ELINE ; IF THERE IS AN EDITOR'S LINE NUMBER
TLNE A7,ESWIT ; OR NUMBERS IN 73 - 80
JRST NL7+1 ; THEN DONT GENERATE ANOTHER ONE
MOVEI A4,2(A4) ; END OF WHERE LINE PREFIX WILL GO
CAML A4,OBEND ; IF PAST END OF BUFFER
PUSHJ SP,SHOB1 ; THEN GET ANOTHER OUTPUT BUFFER
MOVE A4,LINENO ; GET THE CURRENT LINE NUMBER
MOVEI A2,.SPACE ; PRECEDE WITH A SPACE
MOVEI A3,7 ; FIELD IS 7 CHARS WIDE
PUSHJ SP,DEC ; PUT LINE NUMBER IN LISTING
IDPB A3,W ; PUT AN ASCII NULL IN LISTING
IDPB A3,W ; PUT IN ANOTHER ONE
JRST NL7 ; CONTINUE
; LISTING EXISTS BUT WAS OFF
NOLIST: TRNN FL,LISTOO ; IF SO, IS IT CURRENTLY ON?
JRST NLIST1 ; -NO, CONTINUE WITH NO LISTING
HRRI A7,NORMAL ; TIME TO TURN LISTING BACK ON
;[223] LSTART AND W MUST BE THE SAME BYTE OFFSET WHEN THE LISTING RESUMES.
HLRZ A1,LSTART ;[223] GET THE SOURCE'S OFFSET
SETZ A4, ;[223] CREATE A NULL BYTE
NLIST3: HLRZ A2,W ;[223] GET W'S OFFSET (LISTING'S OFFSET)
CAMN A2,A1 ;[223] ARE THEY THE SAME?
JRST TURNON ;[223] YES, EVERYTHING IS OK
IDPB A4,W ;[223] NO, WRITE A NULL BYTE
JRST NLIST3 ;[223] AND LOOP
; TURN LISTING OFF
TURNOF: HRRI A7,NOLIST ; TURN LISTING OFF
; LISTING IS OFF
NLIST1: MOVE A2,P ; LOAD READ POINTER
TLNE A7,ESWIT ; IF NUMBERS IN 73-80
MOVE A2,LINEND ; GET TRUE READ POINTER
MOVEM A2,P ; SAVE TRUE VALUE
CAMN A2,IBEND ; AT END OF INPUT BUFFER?
JRST INEND ; -YES, GET A NEW INPUT BUFFER
TLO A7,WITHIN ; WE ARE WITHIN THE NEWLINE ROUTINE
MOVEM A2,LSTART ; SAVE POINTER FOR LATER
SETZM SSTART ; CLEAR SEGMENT START MARKER
SETZM TBLEN ; EMPTY OUT TMPBUF
; PRINT 1ST BATCH OF MESSAGES
MOVEI A5,MTABLE ; ADDR OF MESSAGE TABLE
CAML A5,NAMTE ; IF NO MESSAGES IN TABLE
JRST NLIST2 ; THEN SKIP THIS PART
SETZM LMSGS ; SET LMSG SWITCH TO 1ST PASS
PUSHJ SP,LMSG ; PRINT MESSAGES
; READ THE LF THAT FOLLOWS THE CR
NLIST2: PUSHJ SP,GETNL ; GET NEXT CHAR
MOVE A4,CTABLE(A1) ; GET TABLE ENTRY
CAIE A4,4 ; IT IS NORMALLY A LF
JRST NL10+1 ; -NO, CONTINUE WITHOUT STEPPING READ POINTER
MOVEM A2,LSTART ; SAVE READ POINTER
MOVEM A1,CHAR2 ; SAVE THIS CHAR
JRST NL10 ; CONTINUE
; "GETNL" WILL READ THE NEXT CHARACTER OF THE SOURCE TEXT. "GETNL"
; MUST BE USED WHENEVER A CHARACTER IS TO BE READ WITHIN "NEWLINE".
; "GETNL" WILL CALL "INEND" IF AN END OF BUFFER OCCURRS.
GETNL: ILDB A1,A2 ; GET NEXT CHAR
AOS CC ; STEP POSITION COUNT
CAME A2,IBEND ; UNLESS AT END OF INPUT BUFFER
POPJ SP, ; EXIT GETNL
MOVEM A2,P ; INEND WANTS POINTER SET
PUSHJ SP,INEND ; READ NEXT INPUT BUFFER
MOVE A7,RFLAGS ; RELOAD READ MODULE FLAGS
MOVE A2,P ; RELOAD READ POINTER
JRST GETNL+2 ; TEST AGAIN
; "INEND" IS CALLED WHENEVER THE END OF AN INPUT BUFFER IS REACHED.
; "INEND" WILL MOVE THE 1ST PART OF THE SPLIT INPUT LINE TO "TMPBUF"
; AND THEN CALL "READ" TO OBTAIN THE NEXT INPUT BUFFER.
INEND1: MOVEM A2,NLR+4 ; SAVE A2
MOVE A2,A1 ; MOVE READ POINTER TO A2
MOVEM A7,A7SAV ; SAVE A7
MOVE A7,RFLAGS ; GET READ MODULE FLAGS
INEND: MOVEM A4,NLR ; SAVE A4
MOVEM A5,NLR+1 ; SAVE A5
MOVEM A6,NLR+2 ; SAVE A6
MOVEM A3,NLR+3 ; SAVE A3
HRRZ A6,A2 ; GET READ POINTER
SKIPN A5,SSTART ; UNLESS LINE ALREADY BROKEN ONCE
MOVE A5,LSTART ; GET START OF LINE SEGMENT
SUBI A6,(A5) ; LENGTH OF DATA TO MOVE
MOVEI A4,TMPBUF-1(A6) ; END OF LINE IN TEMPBUF
HRLZI A5,(A5) ; MOVE SEGMENT FROM RING BUFFER
HRRI A5,TMPBUF ; TO TEMP BUFFER
HRRM A5,LSTART ; SET NEW VALUE FOR LSTART
ADD A4,TBLEN ; ADD TO WHAT IS IN TMPBUF
EDIT(025); BE MORE INFORMATIVE IF WE ARE GIVING UP
CAIGE A4,BUF0 ; [E025] WILL IT ALL FIT IN TMPBUF ?
JRST INEND2 ; [E025] YES - CARRY ON
OUTSTR [ASCIZ /
? SOURCE STATEMENT TOO LONG /] ; [E025] NO - TELL USER
JRST TERMIN ; THEN GIVE UP
INEND2: ADD A5,TBLEN ; [E025] ADD TO WHAT IS IN TMPBUF
ADDM A6,TBLEN ; ADDITIONAL LENGTH OF TMPBUF
BLT A5,(A4) ; MOVE LINE
PUSHJ SP,READ ; READ NEXT BUFFER
INEND5: MOVE A5,P ; GET NEW POINTER
MOVEI A5,1(A5) ; ADD 1
MOVEM A5,SSTART ; SAVE THIS ADDR
ILDB A1,P ; READ 1ST CHAR
CAIN A1,.CZ ; IF THIS IS A CONTROL-Z
JRST INEND4 ; THEN READ AGAIN
MOVEM A7,RFLAGS ; SAVE READ-MODULE FLAGS
MOVE A7,A7SAV ; RESTORE A7
MOVE A4,NLR ; RESTORE A4
MOVE A5,NLR+1 ; RESTORE A5
MOVE A6,NLR+2 ; RESTORE A6
MOVE A3,NLR+3 ; RESTORE A3
MOVE A2,NLR+4 ; RESTORE A2
POPJ SP, ; EXIT NEWLINE
INEND4: PUSHJ SP,READ1 ; CALL INEND BUT DONT PRINT A LINE NUMBER ON TTY
JRST INEND5 ; CONTINUE
; IF THE SOURCE DEVICE IS A TTY, "READ" WILL SEND THE NEXT LINE NUMBER
; TO THE TTY. THEN "READ" WILL OBTAIN THE NEXT BUFFER FROM THE SOURCE
; DEVICE, AND MARK THE END OF DATA IN IT WITH A WORD CONTAINING A
; CR/LF.
READ: TLNN A7,TTY ; IS SOURCE DEVICE A TTY?
JRST READ1 ; -NO, SKIP WRITING A LINE NUMBER
TLNN A7,WITHIN ; IF WITHIN THE NEWLINE ROUTINE
JRST READ1 ; THEN PRINT NUMBER ELSE SKIP THIS PART
PUSH SP,W ; SAVE W
MOVEI A5,BUF0
HRLI A5,440700
MOVEM A5,W ; SET UP BYTE POINTER
MOVE A4,LINENO ; GET CURRENT LINE NUMBER
ADDI A4,1 ; INCREMENT IT
MOVEI A2,.SPACE
MOVEI A3,7
PUSHJ SP,DEC ; PRINT LINE NO.
MOVEI A4,.SPACE ; LOAD A BLANK
IDPB A4,W ; PUT THE BLANK IN BUFFER
MOVEI A4,0
IDPB A4,W ; AND FINISH WITH A NULL
POP SP,W ; RESTORE W
OUTSTR BUF0 ; OUTPUT LINE NUMBER
READ1: IN 3,0 ; INPUT NEXT BUFFER
JRST INOKA ; -SUCCESSFUL READ
STATO 3,710000 ; WAS IT A READ ERROR?
JRST EOF ; -NO, JUST END OF FILE
OUTSTR INERRM ; WRITE ERROR MSG
JRST TERMIN ; TERMINATE COMP
INERRM: ASCIZ /?INPUT ERROR
/
; INPUT BUFFER READ SUCCESSFULLY
INOKA: MOVE A6,BHEAD3 ; ADDR OF CURRENT BUFFER
HRRZ A5,1(A6) ; LENGTH OF BUFFER IN WORDS
JUMPE A5,READ ; IF EMPTY GET ANOTHER BUFFER
ADD A5,P ; ADDR OF END OF BUFFER
SKIPN (A5) ; BACKUP OVER NULLS
SOJA A5,.-1
MOVE A4,NLCHRS ; LOAD A CR/LF
MOVEM A4,1(A5) ; PUT IT AT END OF BUFFER
ADD A5,[ ; HOW POINTER WILL LOOK AT
XWD 350000,1] ; END OF BUFFER
MOVEM A5,IBEND ; STORE FOR LATER COMPARISON
POPJ SP, ; EXIT INEND
; END-OF-FILE ENCOUNTERED
EOF: MOVE A4,BHEAD3 ; LOCATE CURRENT BUFFER RING
MOVEM A4,OLDSBR ; SAVE ITS ADDRESS
CLOSE 3,0 ; CLOSE SOURCE FILE
SKIPG CSCOMP ; IF NO MORE SOURCE FILES
JRST ENDPRG ; THEN RETURN EOF LEXEME
TLZ A7,ESWIT ; TURN OFF 73-80 INDICATOR
SETZM CSCOMP ; CLEAR SWITCH
PUSHJ SP,SCAN3 ; SCAN NEXT SOURCE FILE AND OPEN IT
JRST READ ; READ 1ST BUFFER
; END OF SOURCE DATA (NO MORE SOURCE FILES)
ENDPRG: HRRI A7,ENDPRG ; LSCAN WILL READ NO MORE
MOVEM A7,RFLAGS ; SAVE READ-MODULE FLAGS
MOVE A7,A7SAV ; RESTORE A7
MOVE A2,[ ; SET UP A POINTER TO
POINT 7,NLCHRS] ; A NEW-LINE CHAR
MOVEM A2,P ; PUT IN READ POINTER
MOVE A3,ZEOF ; OUTPUT END-OF-FILE LEXEME
; RETURN TO CALLER OF LSCAN
EOF5: POP SP,A4 ; GET RETURN LINK
MOVEI A4,(A4) ; CLEAR LEFT HALF
CAIN A4,EMPTY
JRST EMPTY1 ; NULL FILE
CAIE A4,RUND0
CAIN A4,RUND5 ; IF IT IS ONE OF THESE
JRST (A4) ; THEN GO THERE
JRST EOF5 ; ELSE ASCEND ANOTHER LEVEL
NLCHRS: ASCIZ /
/
; NO ROOM IN OUTPUT BUFFER FOR LINE PREFIX
SHOB1: HLRZ A5,W ; GET OLD S-P BITS
PUSHJ SP,WRITEL ; GET NEXT BUFFER
AOS A4,W ; STEP WRITE POINTER, LOAD IT
SETZM (A4) ; ZERO 1ST WORD OF LINE IN BUFFER
SETZM 5(A4) ; ZERO 6TH WORD OF LINE IN BUFFER
HRLM A5,W ; SET NEW WRITE POINTER
POPJ SP, ; CONTINUE
; NO ROOM IN OUTPUT BUFFER FOR THE ALGOL TEXT
SHOB2: SOS A6,OBEND ; LAST WORD IN BUFFER
CAIGE A6,(A5) ; IF FULL UP
JRST SHOB3 ; THEN SKIP THIS
MOVE A3,A5 ; SAVE A5
BLT A5,(A6) ; AND FILL UP BUFFER
MOVE A5,A3 ; RESTORE A5
SHOB3: HRLI A6,010700
MOVEM A6,W ; SET UP W
SUBI A4,(A6) ; REMAINDER
SUBI A6,-1(A5) ; AMOUNT TRANSFERRED
HRLZI A6,(A6)
ADD A5,A6 ; MOVE UP INPUT POINTER
PUSHJ SP,WRITEL ; GET NEW OUTPUT BUFFER
ADDI A4,@W ; STOP ADDRESS FOR BLT
AOS W ; STEP WRITE POINTER
HRR A5,W ; SET UP OUTPUT POINTER
POPJ SP, ; [E1005] AND TRY AGAIN
; INPUT LINE WAS SPLIT OVER 2 INPUT BUFFERS
SHIB: SOS A4,TBLEN ; A4=LENGTH OF FIRST PART
ADDI A4,@W ; STOP ADDR FOR BLT
CAMGE A4,OBEND ; WILL THIS OVERFLOW BUFFER?
JRST SHIB1 ; -NO, SKIP
; 1ST PART OF INPUT LINE WILL NOT FIT IN OUTPUT BUFFER
PUSH SP,A6 ; [E1005] SAVE A6
PUSHJ SP,SHOB2 ; [E1005] SEND WHAT WE CAN
POP SP,A6 ; [E1005] RESTORE A6
JRST SHIB+2 ; [E1005] AND TRY AGAIN
SHIB1: CAIG A4,(A5) ; SKIP BLT IF LENGTH NEGATIVE
JRST .+3 ; -YES, SKIP
MOVE A3,A5 ; MOVE TO ACC A3
BLT A3,-1(A4) ; MOVE 1ST PART OF LINE
MOVEM A4,W ; SET W JUST IN CASE SHOB2 IS CALLED
MOVEI A5,(A4) ; WHERE 2ND PART WILL START
HRL A5,SSTART ; WHERE 2ND PART NOW SITS
ADDI A4,(A2) ; ADD CURRENT POINTER ADDR
SUB A4,SSTART ; STOP ADDR FOR BLT
SETZM TBLEN ; ZERO TBLEN
SETZM SSTART ; CLEAR SSTART
JRST NL14 ; CONTINUE
FFOUND: MOVEI A1,0 ; ASCII NULL
DPB A1,A2 ; DELETE FORM FEED FROM INPUT BUFFER
AOS FFCNT ; STEP FORM FEED COUNNT
AOS FFCNT2 ; STEP OTHER FORM FEED COUNT
POPJ SP, ; EXIT FFOUND
; PUT FORM-FEED IN FRONT OF LINE
;
Edit(165); If CREFing include FF characters in cref count
;
INSFF: PUSH SP,FFCNT2 ; [E162] Save number of FFs sent
MOVEI A1,[BYTE(7)177,"F",14] ; PUT IN "END-OF-CREF",F.F
TRNN FL,CREF ; IF CREF, OTHERWISE
INSFF1: MOVEI A1,FORM ; ADDRESS OF A FORM-FEED
PUSHJ SP,INSERT ; PUT IT IN LISTING
SOSLE FFCNT2 ; IF MORE FORM-FEEDS TO INSERT, THEN
JRST INSFF1 ; LOOP
POP SP,A1 ; [E165] Get saved FF count
TRNN FL,CREF ; IF NOT CREF
JRST [ ; [E165]
PUSHJ SP,IC2 ; [E165] then tidy up
POPJ SP,] ; [E165] and exit
IMULI A1,3 ; [E165] Get actual count of chars sent
ADDI A1,2 ; [E162] and include end of cref chars
ADDM A1,CRFCNT ;
MOVEI A1,[BYTE(7)177,"B"] ; ELSE START CREF DATA FOR NEW LINE
JRST INSERT ; EXIT VIA INSERT
; LINE NUMBER NOT FOLLOWED BY A TAB
NOTAB: CAIN A1,.CR ; IF IT IS A CARRIAGE RETURN
JRST .+4 ; THEN SKIP THIS PART
MOVEI A1,.TAB ; AN ASCII TAB CHARACTER
DPB A1,A2 ; REPLACE THE CHARACTER WITH A TAB
JRST NL16 ; CONTINUE
PUSHJ SP,GETNL ; READ THE NEXT CHARACTER
CAIN A1,.CR ; IF IT IS A CARRIAGE RETURN
JRST NL8-1 ; THEN IT IS PROBABLY THE SEQUENCE: CR CR LF
MOVEI A1,.LF ; LINE-FEED
PUSHJ SP,FFOUND+1 ; REPLACE CR BY LF ETC.
JRST NL8-1 ; CONTINUE
; BLANK LINE NUMBER ENCOUNTERED
BLN: MOVEI A5,7 ; SKIP OVER 7 CHARACTERS
MOVEI A6,0 ; ASCII NULL
DPB A6,A2 ; REPLACE CHARACTER WITH A NULL
PUSHJ SP,GETNL ; READ A CHARACTER
SOJG A5,.-2 ; LOOP
PUSHJ SP,FFOUND ; NULL OUT THE FORM-FEED
JRST NL11 ; CONTINUE
RELOC
IBEND: BLOCK 1 ; END OF INPUT BUFFER
OBEND: BLOCK 1 ; END OF OUTPUT BUFFER
BNUM: BLOCK 1 ; BEGIN NUMBER
LBNUM: BLOCK 1 ; LAST BEGIN NUMBER
ENUM: BLOCK 1 ; END NUMBER
LENUM: BLOCK 1 ; LAST END NUMBER
LINEND: BLOCK 1 ; READ POINTER AT END OF CURRENT LINE
LINE5: BLOCK 1 ; 5 -CHAR DATASET LINE NUMBER
LSTART: BLOCK 1 ; START OF CURRENT LINE
SSTART: BLOCK 1 ; START OF CURRENT LINE SEGMENT
CHAR: BLOCK 1 ; SAVE CHAR FROM 80-COLUMN LINE
CHARP: BLOCK 1 ; SAVED CHARACTER'S RESTORATION POINTER
TBLEN: BLOCK 1 ; LENGTH OF DATA IN TMPBUF
A7SAV: BLOCK 1 ; SAVE AREA FOR A7
NLR: BLOCK 5 ; SAVE AREA FOR REGISTERS OVER NEWLINE
EDIT(025); INCREASE SIZE OF TMPBUF
TMPBUF: BLOCK 200 ; SAVED 1ST PART OF SPLIT SOURCE LINE
BUF0: BLOCK 5
RELOC
; THE "COL73" ROUTINE WAS CONTRIVED AFTER THE REST OF "NEWLINE" WAS
; WRITTEN. "NEWLINE" HAS THE CONVENTION THAT THE LINE NUMBER MUST BE
; KNOWN BEFORE THE LINE IS SCANNED. "COL73" WILL CAUSE THE WHOLE
; LINE TO BE "UNOFFICIALLY" MOVED INTO "TMPBUF" BEFORE SCANNING ANY OF
; IT SO THAT THE LINE NUMBER CAN FIRST BE SCANNED. HOWEVER, IF PART
; OF THE LINE WAS MOVED THERE BY "INEND", ONLY THE LAST PART OF THE LINE
; IS "UNOFFICIAL". BY "UNOFFICIAL" IT IS MEANT THAT THE TEXT IS
; NOT REALLY THERE (NOT INCLUDED IN "TBLEN", WHICH IS THE COUNT
; OF DATA WORDS IN "TMPBUF"), AND THE LISTING WILL BE TAKEN FROM
; TEXT IN THE SOURCE BUFFER RATHER THAN FROM "TMPBUF". HOWEVER
; THE SOURCE BYTE POINTER WILL POINT INTO "TMPBUF". THE 1ST CHARACTER
; OF THE LINE NUMBER IS EXTRACTED AND REPLACED WITH A CR SO THAT
; THE SCANNER WILL NOT RUN INTO THE LINE NUMBER.
; FORM READ POINTER TO TMPBUF
COL73: MOVE A3,A2 ; COPY READ POINTER
HRRI A3,TMPBUF ; POINT IT TO TMPBUF
ADD A3,TBLEN ; IN CASE SOMETHING ALREADY IN TMPBUF
MOVEI A5,^D16 ; PUT NEXT 17 WORDS IN TMPBUF
COL73A: ADDI A5,(A2) ; END OF SOURCE IN RING BUFFER
MOVE A6,IBEND ; END OF RING BUFFER
CAIGE A5,(A6) ; IF THE LINE IS ENTIRELY WITHIN RING BUFFER
JRST COL73B ; THEN SKIP THIS PART
; USE INEND TO PUT PART OF LINE IN TMPBUF
MOVE A2,LSTART ; GET LINE START
SKIPN SSTART ; SKIP IF TMPBUF NOT EMPTY
TLNE A2,760000 ; IF BYTE POINTER NOT AT END OF WORD
JRST .+2 ; THEN SKIP THIS PART
ADDI A3,1 ; THEN IGNORE 1ST WORD OF TMPBUF
SUBI A5,(A6) ; EXCESS LENGTH - 1
MOVEM A6,P ; SET P
MOVE A2,A6 ; COPY TO A2
PUSHJ SP,INEND ; GET NEXT INPUT BUFFER
MOVE A7,RFLAGS ; RE-FETCH READ MODULE FLAGS
MOVE A2,P ; RELOAD POINTER
JRST COL73A ; MOVE REMAINDER TO TMPBUF
; MOVE REMAINDER OF LINE TO TMPBUF "UNOFFICIALLY"
COL73B: MOVEM A5,LINEND ; SAVE END OF TEXT IN RING BUFFER
HRLZ A6,A2 ; "FROM" ADDRESS
HRRI A6,TMPBUF ; "TO" ADDRESS
ADD A6,TBLEN ; IN CASE TMPBUF NOT EMPTY
SUBI A5,(A2) ; LENGTH OF MOVE - 1
JUMPL A5,.+3 ; SKIP IF NOTHING TO MOVE
ADDI A5,(A6) ; "STOP" ADDRESS
BLT A6,(A5) ; MOVE TEXT TO TMPBUF
; REPLACE 1ST DIGIT OF LINE NUMBER WITH A CR
MOVE A2,A3 ; A2 = NEW READ POINTER
IBP A3 ; STEP TO COLUMN 2
IBP A3 ; STEP TO COLUMN 3
ADDI A3,^D14 ; STEP TO COLUMN 73
LDB A4,A3 ; GET THE CHARACTER THAT IS THERE
MOVEM A4,CHAR ; SAVE IT FOR LATER
MOVEI A6,.CR ; ASCII CARRIAGE RETURN CHARACTER
DPB A6,A3 ; PUT IN PLACE OF OTHER CHARACTER
MOVEM A3,CHARP ; SAVE POINTER TO THIS CHARACTER
SUBI A4,.N0 ; CONVERT FROM ASCII TO BINARY
MOVEI A6,7 ; READ 7 MORE CHARACTERS
; SCAN LINE NUMBER
COL73C: ILDB A5,A3 ; READ NEXT CHAR
CAIN A5,.SPACE ; IF IT IS A BLANK
JRST .+3 ; THEN IGNORE IT
IMULI A4,^D10 ; MULT PREVIOUS RESULT BY 10
ADDI A4,-.N0(A5) ; ADD IN CURRENT DIGIT
SOJG A6,COL73C ; LOOP
; FROM TRUE LINE POINTER TO SOURCE BUFFER RING
HRR A3,LINEND ; GET POINTER TO TEXT IN RING BUFFER
TLNN A3,760000 ; STEP POINTER, BUT NOT TO NEXT WORD
SUBI A3,1 ; TRUE POINTER
IBP A3 ; THE NEXT CHARACTER TO BE READ FROM THE RING BUFFER
MOVEM A3,LINEND ; SAVE THIS POINTER
LDB A1,A2 ; READ THE NEXT CHARACTER
JRST NL8 ; CONTINUE
SUBTTL ** ERROR HANDLING ROUTINES **
; ERROR MESSAGES
;
; ERROR MESSAGES ARE NOT PRINTED IMMEDIATELY AS THE ERRORS ARE
; DETECTED. IF THEY WERE THEN, SINCE THE ALGOL TEXT IS NOT MOVED TO
; THE LISTING UNTIL AFTER THE LINE HAS BEEN SCANNED (FOR EFFICIENCY)
; USUALLY THE ERROR CODE WOULD APPEAR BELOW THE ERROR MESSAGE, AND
; OTHER TIMES THE ERROR CODE WOULD APPEAR ABOVE THE ERROR MESSAGE
; BECAUSE THE SCANNER IS USUALLY PROCESSING AHEAD OF THE SYNTAX
; ANALYZERS. TO COMBAT THIS, MESSAGES ARE BUFFERED IN A MESSAGE TABLE.
; THEN, WHEN THE SCANNER REACHES THE END OF A LINE, "NEWLINE" WILL
; 1.) PRINT ALL MESSAGES THAT PERTAIN TO THE PRECEDING LINE OF
; TEXT, 2.) PRINT THE CURRENT LINE OF TEXT, AND 3.) PRINT ALL MESSAGES
; THAT PERTAIN TO THE CURRENT LINE OF TEXT.
;
; EACH TIME THE SCANNER READ A CHARACTER WITH AN "ILDB" IT STEPS
; "CC" WITH AN "AOS". FOR EACH ITEM SCANNED "RUND" WILL STORE "CC"
; IN THE CORRECT WORD OF "PLIST". "PLIST" HAS 4 WORDS, ONE FOR EACH
; PORT OF THE WINDOW. "LP1" AND "LP2" CONTAIN THE CHARACTER NUMBERS
; THAT BEGAN THE CURRENT AND PREVIOUS LINES OF TEXT, RESPECTIVELY.
; USING ALL OF THE ABOVE, THE MESSAGE ROUTINE CAN TELL EXACTLY
; WHERE TO PRINT THE UP-ARROW.
;
; THE MESSAGE ROUTINE USUALLY PRINTS THE UP ARROW 1 POSITION
; TO THE LEFT OF WHERE IT HAS CALCULATED THAT THE UP-ARROW SHOULD GO.
; (THIS IS USUALLY A MORE CORRECT PLACE TO PUT IT.) BUT THIS CAN
; BE PREVENTED BY STORING THE CHARACTER COUNT WORD WITH BIT ZERO
; SET TO ONE.
; ".FAILED" IS CALLED BY THE ".FAIL" ROUTINE WITH A1 CONTAINING
; THE FOLLOWING PARAMETER:
;
;
;
; +----------------------------------------------------------------+
; ! ! ! ! ! !
; ! !F! ! FLAGS ! MESSAGE NUMBER !
; ! ! ! ! ! !
; +----------------------------------------------------------------+
; 4 8 17 18 35
;
; BIT 4: UP-ARROW GOES UNDER READ BYTE POINTER, DONT SHIFT LEFT 1
; BITS 8-9: (OF NO CONCERN TO THIS MODULE)
; BIT 10: FATAL ERROR. HALT IMMEDIATELY
; BIT 11: "ILLEGAL USE OF" TYPE MESSAGE
; BIT 12: DELETE REL-FILE
; BIT 13: (OF NO CONCERN TO THIS MODULE)
; BIT 14: UP-ARROW GOES UNDER SYM
; BIT 15: UP-ARROW GOES UNDER DEL
; BIT 16: UP-ARROW GOES UNDER NSYM
; BIT 17: UP-ARROW GOES UNDER NDEL
; BITS 18-35: MESSAGE NUMBER
; FROM THE ABOVE PARAMETER ".FAILED" WILL COMPUTE A MESSAGE TABLE
; ENTRY AND INSERT IT INTO THE MESSAGE TABLE. THE FORMAT OF A MESSAGE
; TABLE ENTRY IS:
;
;
;
; +-----------------------------------------------------------------+
; ! ! ! ! !
; ! BYTE COUNT !FLAGS !KIND/TYPE! MESSAGE NUMBER !
; ! ! ! ! !
; +-----------------------------------------------------------------+
; 0 7 8 11 12 17 18 35
;
; BITS 0-7: POSITION OF ARROW ON PRINT PAGE
; BIT 8: ERROR ON THE PRECEDING LINE
; BIT 9: ERROR ON SOME PREVIOUS LINE
; BIT 10: "ILLEGAL USE OF" TYPE MESSAGE
; BIT 11: DELETE REL-FILE
; BITS 12-17: KIND AND TYPE EXTRACTED FROM LEXEME IN SYM
; BITS 18-35: MESSAGE NUMBER
; THE MESSAGES "START OF BLOCK N" AND "END BLOCK N, CONT M" ARE
; ALSO BUFFERED IN THE MESSAGE TABLE. ENTRIES FOR THESE HAVE THE
; FOLLOWING FORMAT, WHICH IS DISTINGUISHED FROM THE OTHERS BY HAVING
; A POSITION COUNT OF 377.
;
;
;
; +-----------------------------------------------------------------+
; ! ! ! ! !
; ! 377 ! ! VALUE 1 ! VALUE 2 !
; ! ! ! ! !
; +-----------------------------------------------------------------+
; 0 7 8 9 10 22 23 35
;
;
; BITS 0-7: 377
; BIT 8: MESSAGE ON THE PRECEDING OR SOME PREVIOUS LINE
; BIT 9: MUST BE ZERO
; BITS 10-22: VALUE 1
; BITS 23-35: VALUE 2
;
; IF VALUE2 = 0 THEN PRINT "START OF BLOCK (VALUE1)"
; ELSE PRINT "END BLOCK (VALUE2), CONT (VALUE1)";
..PREC==1000 ; ERROR ON PRECEDING LINE
..PREV==400 ; ERROR ON SOME PREVIOUS LINE
..IUO1==200 ; "ILLEGAL USE OF" FORM
..TERM==100 ; "REL FILE DELETED"
; ".FAIL", ".BLK1", AND ".BLK2" PUT ENTRIES IN THE MESSAGE TABLE,
; "LMSG" TAKES THEM OUT AND PRINTS THEM.
; LMSGS = 0 FOR PASS1, -1 FOR PASS2
; EDIT (1002) Include bad identifiers in error messages.
;
Edit(166); Correct Edit 1002 for errors at block level 1
;
LMSG1: MOVE A1,(A5) ; [E166] Get message entry.
TLC A1,776000 ; [E166] Is this a block begin or end ?
TLCN A1,776000 ; [E166] ...
AOJA A5,LMSG5 ; [E166] Yes - step to next entry
TLNE A1,..IUO1 ; [E166] If IUO or undeclared identifier
JRST LMSG6 ; [E166] ...
HRRZ A1,A1 ; [E166] ...
CAIE A1,1 ; [E166] ...
CAIN A1,^D62 ; [266] CHECK FOR SPECIFIC ERROR MESSAGE #
SKIPA ; [266] MESSAGE HAS MORE TO TYPE, SKIP
AOJA A5,LMSG5 ; [E166] ...
LMSG6: PUSHJ SP,IUOLN ; [E166] then get entry length in A1
ADDM A1,A5 ; [E166] and step extra length.
AOJA A5,LMSG5 ; STEP TO NEXT TABLE ENTRY
LMSG: PUSH SP,A2 ; SAVE A2
LMSG5: CAML A5,NAMTE ; [E166] END OF MESSAGES?
JRST LMSGE ; -YES, DONE
MOVE A2,(A5) ; GET ENTRY CONTENTS
MOVE A4,LMSGS ; LOAD THE SWITCH
TLNN A2,..PREC+..PREV; IF EITHER BIT IS SET
SETCM A4,A4 ; THEN THIS MESSAGE SHOULD BE PRINTED
JUMPN A4,LMSG1 ; ONLY ON THE 1ST PASS THROUGH LMSG
; CHECK FOR "START BLOCK" AND "END BLOCK" ENTRIES
LSH A2,-^D28 ; COLUMN POINTER
CAIN A2,377 ; IF BYTES=255 THEN IT IS
JRST BLK1A ; A BLOCK BEGIN OR END LINE
PUSHJ SP,CRFNL2 ; TERMINATE CREF DATA, IF ANY.
; WRITE: "****** ^"
MOVEI A1,STAR3 ; "*******"
PUSHJ SP,INSERT ; SEND TO LISTING
MOVE A2,(A5) ; GET MESSAGE TABLE ENTRY
TLNE A2,..PREV ; IF ERROR OCCURRED ON A PREVIOUS LINE
JRST LMSG3 ; THEN HANDLE SEPARATELY
LSH A2,-^D28 ; GET ARROW POSITION
JUMPE A2,LMSG2 ; NO ^ IF ZERO
TLNN A7,LTTY ; UNLESS THE LISTING IS GOING TO THE TTY
ADDI A2,^D16 ; PUT 16 MORE BLANKS AT START OF LINE
TLNN A7,EXISTS ; [E134] ARE WE LISTING
JRST LMSG2 ; [E134] NO - DON'T BOTHER
MOVEI A1,(A2) ; [E134] GET THE COUNT
MOVEI A2,.SPACE ; [E134] SPACE CHARACTER
PUSHJ SP,INS7 ; [E134] PUT CHAR IN BUFFER
SOJG A1,.-1 ; [E134]
MOVEI A2,.UP ; [E134]
PUSHJ SP,INS7 ; [E134] OUTPUT ^
SETZ A2, ; [E134]
PUSHJ SP,INS7 ; [E134] AND A NULL
JRST LMSG2 ; [E134]
LMSG4: PUSHJ SP,INSERT ; INSERT LINE IN LISTING
LMSG2: PUSHJ SP,ICHECK ; INCLUDE CR/LF
PUSHJ SP,NPRINT ; PUT ERROR LINE NUMBER IN LISTING
; WRITE ERROR MESSAGE TO LISTING
JSP A6,LMSG0 ; GET ERROR MESSAGE
HLL A1,(A5) ; GET FLAGS
TRNN A1,777777 ; IF NO ENTRY THEN
MOVEI A1,[ ; USE A
ASCIZ //] ; LITERAL NULL STRING
TLNE A1,..IUO1 ; IF "ILLEGAL USE OF"
PUSHJ SP,IUO ; THEN HANDLE SEPARATELY
PUSHJ SP,INSE ; PUT MESSAGE IN LISTING
HRRZ A1,(A5) ; [E1002] If undeclared identifier
CAIE A1,^D62 ; [266] IF MISSING FORWARD, LIST LABEL NAME
CAIN A1,1 ; [E1002] ...
PUSHJ SP,OUTSYM ; [E1002] then list spelling.
PUSHJ SP,KCHECK ; PUT CR/LF IN MESSAGE
; CHECK FOR FATAL ERROR
MOVE A4,(A5) ; GET MESSAGE TABLE ENTRY
TLNN A4,..TERM ; IF OBJECT CODE NOT TERMINATED
JRST [AOS WRNCNT ;[171] THEN INCREMENT WARNING COUNT
JRST LMSG1] ;[171] AND LOOP
AOS .JBERR ; ELSE INCREMENT ERROR COUNT
TLOE A7,TMG ; IF TERM MSG PREV GIVEN
JRST LMSG1 ; THEN LOOP
SETOM WFLAG ; MARK REL FILE TO BE ERASED
EDIT (247) ; [247] FIX COMPILER LOOPING WITH BAD PROG.
MOVEI A1,TERMC ; ADDR OF TERMINATION MESSAGE
PUSHJ SP,INS ; "REL-FILE DELETED"
PUSHJ SP,TCHECK ; CR/LF
JRST LMSG1 ; LOOP
TERMC: ASCIZ /?ALGNRF No .REL file created/
STAR3: ASCIZ /*******/
SPACE2: ASCIZ / /
; "NPRINT" WILL PRINT THE LINE NUMBER OF THE ERROR
NPRINT: MOVEI A1,[ASCIZ/%/] ; [300] DEFAULT TO WARNING
MOVE A4,(A5) ; [300] GET MESSAGE TABLE ENTRY
TLNE A4,..TERM ; [300] IF THIS WAS A FATAL ERROR
MOVEI A1,[ASCIZ/?/] ; [300] THEN USE A QUESTION MARK
PUSHJ SP,INSE ; [300] PUT CORRECT ONE IN LISTING
SKIPN LMSGS ; IF MESSAGE FOR PREVIOUS LINE
SKIPA A1,OLDNO ; THEN GET OLD LINE NUMBER
MOVE A1,LINENO ; ELSE GET LINE NUMBER
PUSHJ SP,LPRINT ; CONVERT IT TO ASCII
PUSHJ SP,INSE ; WRITE LINE NUMBER TO LISTING AND TTY
MOVEI A1,SPACE2 ; WRITE 2 SPACES
JRST INSE ; SEND TO LISTING AND TTY, EXIT NPRINT
; ERROR IS NEITHER ON CURRENT NOR PRECEDING LINE
LMSG3: MOVEI A1,Y19 ; "ERROR ON A PREVIOUS LINE"
JRST LMSG4 ; CONTINUE
; EXIT LMSG
LMSGE: PUSHJ SP,CREFST ; OUTPUT CREF START DATA, IF REQUIRED.
POP SP,A2 ; RESTORE A2
POPJ SP, ; EXIT LMSG
; AN "IUO" MESSAGE IS A MESSAGE OF THE FORM "XXX YYY FOUND WHERE A
; ZZZ WAS EXPECTED". THE ERROR MESSAGE NUMBER SPECIFIES ONLY THE
; TEXT OF ZZZ. XXX AND YYY ARE THE TYPE AND KIND OF WHAT WAS
; FOUND, AND THE TEXT OF THESE MUST BE DETERMINED BY DECODING THE
; LEXEME IN SYM.
IUO: LDB A1,[ ; GET "TYPE" OF ITEM
POINT 3,(A5),14] ; POINTER TO TYPE FIELD IN ENTRY
CAIN A1,4 ; IF IT IS A LABEL
JRST IUOLAB ; THEN HANDLE SEPARATELY
MOVE A1,IUOMT1(A1) ; GET NAME
PUSHJ SP,INS ; PUT IN LISTING
LDB A1,[ ; GET "KIND" OF ITEM
POINT 3,(A5),17] ; POINTER TO KIND FIELD IN ENTRY
MOVE A1,IUOMT2(A1) ; GET NAME
IUO1: PUSHJ SP,INS ; PUT IN LISTING
PUSHJ SP,OUTSYM ; [E1002] Put spelling in listing.
MOVEI A1,Y2 ; " WHERE A "
PUSHJ SP,INS ; PUT IN LISTING
JSP A6,LMSG0 ; GET MESSAGE
PUSHJ SP,INS ; PUT IN LISTING
MOVEI A1,Y3 ; " WAS EXPECTED"
POPJ SP, ; EXIT IUO
IUOLAB: LDB A1,[ ; GET "KIND" OF ITEM
POINT 3,(A5),17] ; POINTER TO KIND FIELD
MOVE A1,IUOMT3(A1) ; GET PROPER NAME
JRST IUO1 ; CONTINUE
LMSG0: HRRZ A1,(A5) ; GET MESSAGE #
ROT A1,-1
JUMPL A1,.+3
HLRZ A1,TTABLE(A1)
JRST (A6)
HRRZ A1,TTABLE(A1)
JRST (A6)
; BLOCK START OR END
BLK1A: TLNE A7,LTTY ; IF LISTING IS ON TTY
JRST LMSG1 ; THEN DONT WRITE BLOCK BEGIN OR END MSG
MOVE A4,(A5) ; RELOAD PARAM WORD
TRNE A4,017777 ; IF RIGHT-MOST 13 BITS NOT ZERO
JRST BLK2A ; THEN THIS IS AN END MESSAGE
; "START OF BLOCK N"
TRNN FL,CREF ; CREF ?
JRST BLK2B ; NO
PUSH SP,A5 ; DEC CLOBBERS THIS
PUSHJ SP,CREFST ; OUTPUT CREF START-DATA, IF NEEDED.
MOVEI A1,BLK2M3 ; START-BLOCK
PUSHJ SP,INSERT
MOVEI A3,5 ; FOR DEC
MOVE A2,["-",,"-"] ; FILLER-CHAR,,RIGHT-MOST FILLER
LDB A4,[POINT 13,(A5),22] ; BLOCK-NUMBER
PUSHJ SP,CRFDEC ; TO DECIMAL TO LISTING
MOVEI A5,^D8 ; UPDATE
ADDM A5,CRFCNT ; CHARACTER-COUNT
POP SP,A5
JRST LMSG1 ; DON'T PRINT 'START OF BLOCK'
BLK2B: MOVEI A1,BLK1M ; "START OF BLOCK "
BLKC: PUSHJ SP,INSERT ; PUT IN LISTING
LDB A1,[ ; GET THE NUMBER STORED IN
POINT 13,(A5),22] ; BITS 10-22
PUSHJ SP,LPRINT ; CONVERT TO DECIMAL ASCII
PUSHJ SP,INSERT ; PUT NUMBER IN LISTING
PUSHJ SP,ICHECK ; CR/LF
JRST LMSG1 ; LOOP
; "END OF BLOCK N, CONT M"
BLK2A: TRNN FL,CREF ; CREF ?
JRST BLK2C ; NO
PUSH SP,A5
PUSHJ SP,CREFST ; OUTPUT CREF START DATA, IF NEEDED.
MOVEI A1,BLK2M4 ; END BLOCK
PUSHJ SP,INSERT
MOVEI A3,5
MOVE A2,["-",,"-"] ; FILLER-CHAR,,RIGHT-MOST-FILLER
LDB A4,[POINT 13,(A5),35] ; BLOCK-NUMBER
PUSHJ SP,CRFDEC ; TO LISTING IN DECIMAL
MOVEI A5,^D8 ; UPDATE
ADDM A5,CRFCNT ; CHAR-COUNT
POP SP,A5
JRST LMSG1 ; DON'T PRINT 'END OF BLOCK'
BLK2C: MOVEI A1,BLK2M1 ; "END BLOCK "
PUSHJ SP,INSERT ; PUT IN LISTING
LDB A1,[ ; GET THE NUMBER STORED IN
POINT 13,(A5),35] ; BITS 23-35
PUSHJ SP,LPRINT ; CONVERT TO DECIMAL ASCII
PUSHJ SP,INSERT ; PUT NUMBER IN LISTING
MOVEI A1,BLK2M2 ; ", CONT "
JRST BLKC ; CONTINUE
BLK1M: ASCIZ /START OF BLOCK /
BLK2M1: ASCIZ /END BLOCK /
BLK2M2: ASCIZ /, CONT /
BLK2M3: BYTE(7)015,6,"B",0 ; CREF START-BLOCK: T15 6CH B
BLK2M4: BYTE(7)016,6,"E",0 ; CREF END BLOCK: T16 6CH E
; "LMSGZ" IS CALLED AT THE END OF THE COMPILATION BY ".ZZEND". "LMSGZ"
; WILL PRINT ALL MESSAGES THAT REMAIN IN THE MESSAGE TABLE THAT
; HAVE NOT YET BEEN PRINTED.
LMSGZ: MOVEM A7,A7SAV ; SAVE A7
MOVE A7,RFLAGS ; FETCH THE READ MODULE FLAGS
MOVEI A5,MTABLE ; ADDR OF MESSAGE TABLE
CAML A5,NAMTE ; IF NO MESSAGES IN MESSAGE TABLE
POPJ SP, ; THEN EXIT LMSGZ
SKIPE LMSGS ; [273] DUMP 1ST GROUP OF MESSAGES, UNLESS DONE
JRST LMSGZ2
PUSHJ SP,LMSG ; PRINT MESSAGES
LMSGZ2: MOVEI A5,MTABLE ; ADDR OF MESSAGE TABLE
SETOM LMSGS ; DUMP 2ND GROUP OF MESSSAGES
PUSHJ SP,LMSG ; PUT THEM IN LISTING
PUSHJ SP,CRFNL2 ; OUTPUT CREF END, & ANY NECESSARY NULLS
MOVEI A1,LINES3 ; PUT 3 BLANK LINES
PUSHJ SP,INSERT ; IN LISTING
JRST ICHECK ; INSERT A CR/LF, EXIT LMSGZ
LBP: POINT 7,LB ; [273] LISTING BUFFER POINTER
RELOC
MTABLE: BLOCK 50 ; MESSAGE TABLE
NAMTE: BLOCK 1
; MTABLE ; NEXT AVAIL MESSAGE TABLE ENTRY
LMSGS: BLOCK 1 ; LMSG SWITCH: 0 FOR PASS1, -1 FOR PASS2
LB: BLOCK 40 ; LISTING BUFFER FOR MESSAGES
OLDNO: BLOCK 1 ; OLD LINE NUMBER
WRNCNT: BLOCK 1 ;[171] WARNING COUNT
RELOC
Y2: ASCIZ / FOUND WHERE A/
Y3: ASCIZ / WAS EXPECTED/
Y4: ASCIZ /STRING/
Y5: ASCIZ /COMPLEX/
Y6: ASCIZ /TYPELESS/
Y7: ASCIZ /BOOLEAN/
Y8: ASCIZ /LONG REAL/
Y9: ASCIZ /REAL/
Y10: ASCIZ /INTEGER/
Y11: ASCIZ / VARIABLE/
Y12: ASCIZ / EXPRESSION/
Y13: ASCIZ / ARRAY IDENTIFIER/
Y14: ASCIZ / PROCEDURE/
Y15: ASCIZ / CONSTANT/
Y16: ASCIZ /LABEL/
Y17: ASCIZ /DESIGNATIONAL EXPRESSION/
Y18: ASCIZ /SWITCH/
IUOMT1: Y4
Y5
Y6
Y7
0
Y8
Y9
Y10
IUOMT2: Y11
Y12
Y13
Y14
Y15
IUOMT3: Y16
Y17
0
Y18
Y19 ;[252] MAKE ENTRY FOR Y19 TOO
Y19: ASCIZ / ERROR ON A PREVIOUS LINE:/
; THE INSERT ROUTINES ("INSERT", "INS", AND "INSE") ARE USED TO INSERT
; MESSAGES INTO THE LISTING. THE CHECK ROUTINES ("ICHECK", "TCHECK",
; AND "KCHECK") WILL INSERT A CR/LF INTO THE LISTING, AND THEN
; INSERT NULLS INTO THE LISTING SO THAT THE TOTAL NUMBER OF CHARACTERS
; INSERTED SINCE THE LAST CHECK ROUTINE WAS CALLED IS A MULTIPLE OF 5.
; WHENEVER AN INSERT ROUTINE IS USED, A CHECK ROUTINE MUST BE CALLED
; BEFORE THE NEXT CALL TO NEWLINE.
;
; "INSERT" AND "ICHECK" WRITE MESSAGES IN THE LISTING. "INS" AND
; "TCHECK" ALSO WRITE THE MESSAGE TO THE TTY. "INSE" AND "KCHECK"
; ARE USED TO WRITE MESSAGES WHEN MESSAGE 98 MIGHT BE ENCOUNTERED.
INSE: HRRZ A3,(A5) ; GET MESSAGE NUMBER
CAIN A3,^D98 ; IF THIS IS MESSAGE 98
JRST INSERT ; THEN DONT WRITE TO TTY
; INSERT LINE IN LISTING, AND ALSO WRITE IT TO TTY
INS: TLNN A7,NSWIT ; IF NO N-SWITCH
OUTSTR (A1) ; THEN WRITE IT TO TTY
JRST INSERT ; INSERT LINE IN LISTING
; PUT DECIMAL NUMBER IN LISTING
LPRINT: MOVE A6,LBP ; GET BUFFER BYTE POINTER
PUSHJ SP,LPR1 ; CONVERT IT TO CHARACTERS
MOVEI A1,0 ; ASCII NULL
IDPB A1,A6 ; END STRING WITH AN ASCII NULL
MOVEI A1,LB ; OUTPUT ADDRESS OF BUFFER
POPJ SP, ; EXIT LPRINT
; CONVERT IT TO DECIMAL
LPR1: IDIVI A1,12 ; DIVIDE BY TEN
PUSH SP,A2 ; PUT DIGIT ON STACK
SKIPE A1 ; SKIP IF END OF NUMBER
PUSHJ SP,LPR1 ; RECURSIVE CALL TO LPR1
POP SP,A1 ; FETCH DIGIT FROM STACK
ADDI A1,.N0 ; CONV TO ASCII
IDPB A1,A6 ; PUT IN BUFFER
POPJ SP, ; ASCEND FROM LPR1
; Write msg to listing, and to TTY if CCL and there were errors,
; or if not CCL (DONE1).
; DONE2 writes msg to listing, and to TTY if not CCL.
; Both used at end, called from START0, to do N Errors, stats, etc.
DONE1: SKIPE WRNCNT ; [300] ANY WARNINGS?
JRST INS ; [300] YES, SEND TO TTY
SKIPN .JBERR
DONE2: SKIPN CCLSW
JRST INS ; TO TTY AS WELL, IF REQUD.
; Insert a message in listing. The address of the message in ASCIZ
; format should be in A1
INSERT: TROA A2,777777 ; SET SWITCH TO SAY INSERT, NOT INSNUL
INSNUL: SETZ A2, ; INSERT ONE NULL
TLNN A7,EXISTS ; IF LISTING DOES NOT EXIST
INS2: POPJ SP, ; THEN DONT SEND MESSAGE THERE
JUMPE A2,INS7 ; IF NOT NULL...
HRLI A1,440700 ; SET UP BYTE POINTER
; CHARACTER TRANSFER LOOP
INS6: ILDB A2,A1 ; GET A CHAR
JUMPE A2,INS2 ; IF NULL, THE END
PUSHJ SP,INS7 ; [E134] OUTPUT THE CHARACTER
JRST INS6 ; [E134] AND LOOP UNTIL DONE
INS7: SOSGE FIVEC ; DECR NO OF REMAINING CHARS
JRST INS3 ; -END OF 5-CHAR GROUP
INS1: IDPB A2,W ; PUT CHAR IN LISTING
POPJ SP, ; DONE
; AT END OF WORD, CHECK FOR END OF LISTING BUFFER
INS3: HRRZ A6,W ; GET LISTING POINTER
ADDI A6,2 ; STEP TO NEXT WORD
CAML A6,OBEND ; IF IT IS NOT WITHIN BUFFER
JRST INS5 ; THEN GET A NEW BUFFER
INS4: MOVEI A6,4 ; 4 CHARS LEFT AFTER THIS ONE
MOVEM A6,FIVEC ; SET 5-CHAR GROUP COUNT
JRST INS1 ; CONTINUE
; END OF BUFFER, GET ANOTHER
INS5: HLRZ A4,W ; SAVE S-P BITS OF LISTING POINTER
PUSHJ SP,WRITEL ; GET A NEW BUFFER
AOS A6,W ; STEP LISTING POINTER
SETZM (A6) ; ZERO 1ST WORD OF BUFFER
HRLM A4,W ; SET S-P BITS
JRST INS4 ; CONTINUE
KCHECK: HRRZ A3,(A5) ; GET MESSAGE NUMBER
CAIN A3,^D98 ; IF IT IS MESSAGE 98
JRST ICHECK ; THEN DONT WRITE CR/LF TO TTY
; WRITE CR/LF TO TTY, THEN CALL "ICHECK"
TCHECK: MOVEI A1,NLCHRS ; PUT A CR/LF
PUSHJ SP,INS ; INTO LISTING
JRST IC2 ; CONTINUE
; "ICHECK MUST BE CALLED AFTER USING "INSERT" TO WRITE THE CR/LF TO
; THE LISTING, AND TO MAKE SURE THAT THE TOTAL INSERTED MESSAGE
; IS A MULTIPLE OF 5 CHARACTERS LONG.
ICHECK: MOVEI A1,NLCHRS ; PUT A CR/LF
PUSHJ SP,INSERT ; INTO LISTING
IC2: TLNN A7,EXISTS ; IF LISTING DOESNT EXIST
POPJ SP, ; THEN SKIP THIS
MOVEI A1,0 ; NULL CHARACTER
IC1: SOSGE FIVEC ; DECR NO OF REMAINING CHARS
POPJ SP, ; EXIT ICHECK IF NONE LEFT
IDPB A1,W ; PUT NULL INTO LISTTIG
JRST IC1 ; LOOP
RELOC
FIVEC: BLOCK 1 ; FIVE CHARACTER COUNT
RELOC
; PUT ENTRY IN MESSAGE TABLE
FAILED: MOVEM A6,REG3+5 ; SAVE A6
MOVE A6,[ ; LOAD BLT WORD
XWD A1,REG3] ; BLT WORD
BLT A6,REG3+4 ; SAVE REGS
; FIND THE BYTE POINTER TO THE ERROR
SETOM BYTES ; ZERO ^ POSITION
SETZB A4,FAILF ; CLEAR FLAGS
TLNN A1,..IMM+17 ; IF THERE IS TO BE NO ^
JRST FAILA ; THEN SKIP THIS PART
TLNN A1,..IMM ; IF NOT ^ WHERE POINTER IS NOW
JRST .+3 ; THEN SKIP
AOS BYTES ; USE EXACT POINTER
MOVE A4,CC ; THEN USE CURRENT READ POINTER
MOVE A5,PLIST ; GET POINTER LIST POINTER
XORI A5,2 ; FLIP IT
TLNE A1,..SYM ; IF ^ UNDER SYM
MOVE A4,(A5) ; THEN GET SYM POINTER
TLNE A1,..DEL ; IF ^ UNDER DEL
MOVE A4,1(A5) ; THEN GET DEL POINTER
XORI A5,2 ; FLIP POINTER SWITCH
TLNE A1,..NSYM ; IF ^ UNDER NSYM
MOVE A4,(A5) ; THEN GET NSYM POINTER
TLNE A1,..NDEL ; IF ^ UNDER NDEL
MOVE A4,1(A5) ; THEN GET NDEL POINTER
JUMPE A4,FAILB ; IF POINTER ZERO, ERROR ON A PREVIOUS LINE
TLZE A4,EXACT ; IF FLAG BIT IS ON
AOS BYTES ; THEN USE EXACT POINTER
; DETERMINE WHAT LINE THE ERROR IS ON
CAMGE A4,LP1 ; IF ERROR NOT ON CURRENT LINE
JRST FAILC ; THEN CHECK PRECEDING LINE
SUB A4,LP1 ; COMPUTE POSITION ON LINE
ADDM A4,BYTES ; SAVE IT
JRST FAILA ; CONTINUE
FAILC: CAMGE A4,LP2 ; IF ERROR NOT ON PRECEDING LINE
JRST FAILB ; THEN DONT PRINT AN ^
SUB A4,LP2 ; COMPUTE POSITION ON LINE
ADDM A4,BYTES ; SAVE IT
AOSA FAILF ; SET FLAG +
FAILB: SETOM FAILF ; SET FLAG -
; CREATE MESSAGE TABLE ENTRY
FAILA: AOS A4,BYTES ; GET UP ARROW POSITION
LDB A5,[ ; GET TYPE FIELD OF SYM
POINT 6,SYM,8] ; POINTER TO TYPE FIELD
CAIN A5,<$L>B44 ; IF TYPE = LABEL
MOVEI A5,4 ; THEN CHANGE TO 04
ANDI A5,7 ; USE ONLY 3 BITS OF TYPE FIELD
LSH A4,7 ; SHIFT 7
ADD A4,A5 ; INCLUDE TYPE FIELD
LSH A4,3 ; SHIFT 3
LDB A5,[ ; GET KIND FIELD OF SYM
POINT 2,SYM,2] ; POINTER TO KIND FIELD
TLNN SYM,$SYMB ; IF SYM IS A CONSTANT
MOVEI A5,4 ; THEN USE AN 04
ADD A4,A5 ; INCLUDE KIND
MOVS A4,A4 ; MOVE IMFO TO FINAL POSITION
MOVE A5,REG3 ; GET PARAMETER TO "FAILED"
HRR A4,A5 ; INCLUDE MESSAGE NUMBER
SKIPLE A6,FAILF ; IF ERROR ON PRECEDING LINE
TLO A4,..PREC ; THEN SET FLAG
SKIPGE A6 ; IF ERROR ON SOME PREVIOUS LINE
TLO A4,..PREV ; THEN SET FLAG
TLNE A5,SUSPCO ; IF TERMINATION BIT ON
TLO A4,..TERM ; THEN TURN ON CORRESPONDING BIT
BLK0: MOVE A6,NAMTE ; NEXT AVAILABLE MSG TABLE ENTRY SPACE
CAIL A6,MTABLE+50 ; IF PAST END OF TABLE
JRST BLK2 ; [E1002] then don't put in table
HRRZ A3,A5 ; [E1002] If undeclared identifier
CAIE A3,^D62 ; [266] CHECK FOR MISSING FORWARD LABEL TOO
CAIN A3,1 ; [E1002] ...
JRST .+4 ; [E1002] ...
TLNN A5,..IUO2 ; [E1002] or IUO
JRST BLK1 ; [E1002] ...
TLO A4,..IUO1 ; [E1002] then enter symbol spelling.
HRRZ A3,SYM ; [E1002] Address of symbol in A3
CAIL A3,MTABLE ; [E1002] In symbol table (best to make sure)?
CAML A3,NASTE ; [E1002] ...
JRST BLK3 ; [E1002] No - enter a null.
HLRZ A1,A4 ; [E1002] Get lexeme kind in A1
ANDI A1,7 ; [E1002] ...
CAIE A1,1 ; [E1002] If kind = expression or constant
CAIN A1,4 ; [E1002] ...
JRST BLK3 ; [E1002] then make a null entry.
MOVEI A3,SYMNAM(A3) ; [E1002] Start of spelling in ST.
HRRZ A1,@A3 ; [E1002] ...
PUSHJ SP,IUOLN1 ; [E1002] Get entry length in A1.
JRST BLK4
BLK3: MOVEI A1,1 ; [E1002] Null entry of length 1.
MOVEI A3,[EXP 0] ; [E1002] and zero value.
BLK4: ADDM A1,A6 ; [E1002] Room for spelling in table ?
CAIL A6,MTABLE+50 ; [E1002] ...
JRST BLK2 ; [E1002] No - don't enter it.
MOVE A6,NAMTE ; [E1002] Save current next entry free.
ADDM A1,NAMTE ; [E1002] Add in spelling entry length.
HRL A2,A3 ; [E1002] Set up BLT word.
HRR A2,A6 ; [E1002] ...
AOJ A2, ; [E1002] ...
BLT A2,@NAMTE ; [E1002] Move spelling into message table.
BLK1: MOVEM A4,(A6) ; [E1002] Put entry into table.
AOS NAMTE ; [E1002] Step table index.
BLK2: TLNE A5,..FATAL ; [E1002] If termination bit is on
JRST FAILT ; THEN STOP COMPILATION
MOVS A6,[ ; GET POINTERS FOR
XWD A1,REG3] ; BLT
BLT A6,A6 ; RESTORE REGISTERS
POPJ SP, ; EXIT FAILED
; FATAL ERROR. STOP COMPILATION IMMEDIATELY.
ILDB A1,P ; READ NEXT CHAR
FAILT: LDB A1,P ; RESD CHAR (FIRST TIME)
MOVE A2,CTABLE(A1) ; GET ITS ENTRY
CAIN A2,4 ; IF IT A NEW-LINE CHAR
PUSHJ SP,NEWLINE ; THEN PRINT LINE AND MESSAGES
JRST FAILT-1 ; ELSE READ ANOTHER CHAR
MOVEI A1,TERMSG ; TERMINATION MESSAGE
PUSHJ SP,INS ; INSERT IT IN LISTING
PUSHJ SP,TCHECK ; CR/LF
JRST RINIT+1 ; GET ANOTHER COMMAND STRING
RELOC
REG3: BLOCK 6 ; REGISTER SAVE AREA
BYTES: BLOCK 1 ; BYTE COUNT FOR ^
FAILF: BLOCK 1 ; FLAG USED BY FAILED
LP1: BLOCK 1 ; POINTER TO START OF CURRENT LINE
LP2: BLOCK 1 ; POINTER TO START OF PRECEDING LINE
BLKF: BLOCK 1 ; .BLK1 .BLK2 FLAG
RELOC
; [E1002] IUOLN - Finds the word length of a spelling in the ST.
IUOLN: HRRZ A1,1(A5) ; [E1002] Get entry length in A1.
IUOLN1: ANDI A1,77 ; [E1002] ...
ADDI A1,2 ; [E1002] ...
IDIVI A1,6 ; [E1002] ...
SKIPE ,A2 ; [E1002] ...
AOJ A1, ; [E1002] ...
POPJ SP, ; [E1002] Return.
; [E1002] OUTSYM - Inserts a spelling from the message table
; into the listing.
OUTSYM: MOVE A1,A5 ; [E1002] Adress of spelling - 1.
SKIPN ,1(A5) ; [E1002] If null entry
POPJ SP, ; [E1002] then don't bother.
PUSH SP,A5 ; [E1002] Convert to ASCIZ in LB.
SOJ A1, ; [E1002] ...
PUSHJ SP,NAME ; [E1002] ...
POP SP,A5 ; [E1002] ...
MOVEI A1,[ASCIZ/ </] ; [E1002] List a '<'.
PUSHJ SP,INS ; [E1002] ...
MOVEI A1,LB ; [E1002] List spelling.
PUSHJ SP,INS ; [E1002] ...
MOVEI A1,[ASCIZ/>/] ; [E1002] List a '>'.
PUSHJ SP,INS ; [E1002] ...
POPJ SP, ; [E1002] Return.
; START OF BLOCK
.BLK1: SETZM BLKF ; ZERO THE FLAG
JRST .+2 ; SKIP
; END OF BLOCK
.BLK2: SETOM BLKF ; SET FLAG NON-ZERO
MOVEM A6,REG3+5 ; SAVE WORD
MOVE A6,[ ; LOAD BLT WORD
XWD A1,REG3] ; BLT WORD
BLT A6,REG3+4 ; SAVE ALL 6 REGS
MOVE A2,CURBLOCK ; GET CURRENT BLOCK NUMBER
SKIPN BLKF ; IF .BLK1 THEN
LSHC A1,^D36 ; MOVE TO A1, CLEAR 2ND PARAM
LSH A2,^D23 ; COMBINE THE PARAM IN A1
LSHC A1,-^D23 ; WITH THE PARAM IN A2
MOVE A5,PLIST ; POINTER BUFFER
XORI A5,2 ; FLIP IT TO SYM AND DEL
MOVE A4,1(A5) ; GET POINTER TO DEL
SKIPN BLKF ; IF .BLK1 THEN
MOVE A4,(A5) ; USE POINTER TO SYM INSTEAD
TLZE A4,EXACT ; IF FLAG BIT IS ON
ADDI A4,1 ; THEN USE EXACT POINTER
CAMG A4,LP1 ; DETERMINE WHICH LINE IT IS ON
TLO A2,..PREC ; MARK: ON PRECEDING LINE
TLO A2,776000 ; SET BYTES=255
MOVE A4,A2 ; MOVE TO A4
MOVEI A5,0 ; CLEAR A5
JRST BLK0 ; CONTINUE
SCDLT=.-43
LEX(NE) ; "#"
BLOCK 4
LEX(LPAR) ; "("
LEX(RPAR) ; ")"
LEX(TIMES) ; "*"
LEX(PLUS) ; "+"
LEX(COM) ; ","
LEX(MINUS) ; "-"
LEX(DOT) ; "."
LEX(SLASH) ; "/"
TCDLT: XWD L$ASS,R$ASS ; ":="
0
LEX(LEQ) ; "<="
0
LEX(GTE) ; ">="
0
LEX(UPLUS)
LEX(UMINUS)
LEX(PHID)
0
LEX(COLON) ; ":"
LEX(SC) ; ";"
LEX(LSS) ; "<"
LEX(EQ) ; "="
LEX(GTR) ; ">"
BLOCK ^D28
LEX(LBRA) ; "["
LEX(EOF) ; END-OF-FILE
LEX(RBRA) ; "]"
LEX(POW) ; "^"
LEX(ASS) ; "_"
SUBTTL ** LSCAN **
; ***** L S C A N *****
;
; "LSCAN" READS ALGOL TEXT FROM A FILE AND
; CONVERTS IT TO AN INTERNAL CODE. EACH CALL TO
; LSCAN PRODUCES THE NEXT ITEM FROM THE ALGOL
; PROGRAM. ITEMS ARE OF THREE TYPES:
;
; 1. IF THE ITEM IS A DELIMITER (EITHER
; SINGLE CHARACTER OR RESERVED WORD) LSCAN SETS
; A3 EQUAL TO THE LEXEME OF THAT DELIMITER.
;
; 2. IF THE ITEM IS A LITERAL CONSTANT
; LSCAN SETS A3 EQUAL THE LEXEME FOR THAT
; CONSTANT (PUTTING THE CONSTANT IN THE OBJECT
; MODULE'S CONSTANT TABLE IF NECESSARY), AND
; SKIP-RETURNS.
;
; 3. IF THE ITEM IS AN IDENTIFIER NAME
; LSCAN PLACES IN A3 A POSITIVE NUMBER (A
; BUFFER ADDRESS), AND SKIP-RETURNS. THIS NUMBER
; IS THE INPUT PARAMETER TO THE ROUTINE "SEARCH"
; WHICH IS USED TO PRODUCE THE LEXEME FOR THE
; IDENTIFIER.
LSCAN: SKIPE A3,BLEX ; IF THERE IS A BUFFERED LEXEME
JRST BLEXR ; THEN TREAT SEPARATELY
LDB A1,P ; PICK UP 1ST CHAR
SKIPE A2,CTABLE(A1) ; LOAD TABLE ENTRY, SKIP IF DELIM
JRST @TABLE1(A2) ; JUMP TO APPROPRIATE ROUTINE
JRST DELIM
DIGITS ; NUMBERS
LETTER ; LETTERS
TABLE1: DELIM ; DELIMITERS
FLAGD ; DELIMITERS (FLAGGED)
SPACE ; IGNORABLES
SPACE ; SPACE & TAB
NEW1 ; NEW-LINE
LOWER ; LOWER CASE
OTHER ; OTHER CHARS
SQUOTE ; SINGLE QUOTE
; SPACE OR TAB
SPACE: CAIN A1,.TAB ; IF IT IS A TAB
PUSHJ SP,TAB ; COMPUTE ITS LENGTH
ILDB A1,P ; GET ANOTHER CHAR
AOSA CC ; STEP POSITION COUNT
; END OF LINE - WATCH THE SPACING HERE !
NEW1: PUSHJ SP,NEWLINE ; PROCESS LISTING, GET NEXT CHAR
JFCL ; NO-OP
NEW3: MOVE A2,CTABLE(A1) ; LOAD TABLE ENTRY
JRST @TABLE1(A2) ; JUMP TO APPROPRIATE ROUTINE
; FLAGGED CHAR: : < > !
FLAGD: CAIN A1,.EXCL ; IF CHAR IS A "!"
JRST COMNT0 ; THEN PROCESS COMMENT
MOVE A4,A1 ; COPY CHARACTER TO A4
JSP A6,IGST ; READ THE NEXT CHARACTER
CAIN A1,.EQUAL ; IS IT AN "=" ??
JRST FLAGD1 ; -YES, ITS A 2-CHAR DELIM
MOVE A3,SCDLT(A4) ; PICK UP LEXEME FOR DELIM
POPJ SP, ; EXIT LSCAN
; :=, <=, OR >=
FLAGD1: MOVE A3,TCDLT-.COLON(A4); GET DELIMETER LEXEME
JRST SQOK2 ; EXIT LSCAN
; A SPECIAL CHARACTER WAS SCANNED
OTHER: HLRZ A2,CTABLE(A1) ; GET LEFT HALF OF CHARS TABLE ENTRY
JRST @TABLE3(A2) ; JUMP THROUGH TABLE 3
TABLE3: ILLEGAL ; ILLEGAL CHARACTER
POWER ; @ &
SCON ; " $ %
DOT ; .
; SPECIAL CONSTANT
SCON: CAIN A1,.% ; A "%" INDICATES
JRST OCTAL ; AN OCTAL CONSTANT
CAIN A1,.$ ; A "$" INDICATES
JRST DOLLAR ; A SYMBOL CONSTANT
JRST STRING ; OTHERWISE, MUST BE A STRING
; A CONSTANTLESS EXPONENT
POWER: SETZB A4,MARKER ; MARK: NO DECIMAL POINT
MOVEI A5,1 ; SET DOUBLE-LENGTH CONSTANT = 1
SETZM FORMAT ; [E044] ASSUME SINGLE PRECISION
JRST C22 ; [E044] AND JUMP INTO DIGITS
; A DOT HAS BEEN SCANNED
DOT: JSP A6,IGST ; GET THE NEXT CHAR
MOVE A3,CTABLE(A1)
AOJGE A3,DOT1 ; IF NOT DIGIT, DELIMITER
MOVEI A3,^D9 ; SET LOOP INDEX
MOVEM A3,MARKER ; SET DECIMAL POINT MARKER
SETZB A4,FORMAT ; [E044] CLEAR HI WORD OF DOUBLE
MOVEI A5,-.N0(A1) ; CONVERT 1ST CHAR TO BINARY
SOJA A3,LLOOP1 ; JUMP INTO "NUMBER"
; THE DOT IS A DELIMITER
DOT1: SKIPA A3,ZDOT ; LOAD ITS LEXEME
BLEXR: SETZM BLEX ; CLEAR INDICATOR
POPJ SP, ; EXIT LSCAN
; AN ILLEGAL CHAR HAS BEEN SCANNED
ILLEGAL: FAIL (93,SOFT,IMM,ILLEGAL CHARACTER)
ILL1: ILDB A1,P ; GET NEXT CHAR
AOS CC ; STEP POSITION COUNT
MOVE A2,CTABLE(A1) ; GET ITS TABLE ENTRY
CAIN A2,6 ; IF IT TOO IS AN ILLEGAL CHARACTER
JRST ILL1 ; THEN LOOP WITHOUT PRINTING ANOTHER MSG
JRST @TABLE1(A2) ; OTHERWISE JUMP THROUGH TABLE 1
; **** CHARACTER TABLE ****
;
; THIS TABLE IS USED TO CLASSIFY EACH OF
; THE ASCII CHARACTERS ACCORDING TO THE
; FOLLOWING TYPES:
;
; -2 DIGIT
; -1 LETTER
; 0 SINGLE-CHARACTER DELIMITERS
; 1 FLAGGED DELIMITERS
; 2 SHOULD BE IGNORED ON INPUT
; 3 SPACE CHARS (SPACE & TAB)
; 4 NEW-LINE CHARS (CR, LF, )
; 5 LOWER CASE LETTERS
; 6 OTHER CHARS.
; LEFT HALF:
; 0 ILLEGAL CHAR
; 1 @ &
; 2 " $ %
; 3 .
; 7 SINGLE QUOTE
0 ; -1 PSEUDO ALTMODE (SCANCH)
CTABLE: 2 ; 0 NULL
6 ; 1 ^A
6 ; 2 ^B
6 ; 3 ^C
6 ; 4 ^D (EOT)
6 ; 5 ^E (WRU)
6 ; 6 ^F
6 ; 7 ^G (BELL)
6 ; 10 ^H (BACKSPACE)
3 ; 11 ^I (TAB)
4 ; 12 ^J (LINE FEED)
6 ; 13 ^K (VERT TAB)
3 ; 14 ^L (FORM)
4 ; 15 ^M (RETURN)
6 ; 16 ^N
6 ; 17 ^O
6 ; 20 ^P
2 ; 21 ^Q (XON)
2 ; 22 ^R (TAPE)
2 ; 23 ^S (XOFF)
2 ; 24 ^T (NOTAPE)
6 ; 25 ^U
6 ; 26 ^V
6 ; 27 ^W
6 ; 30 ^X
6 ; 31 ^Y
4 ; 32 ^Z
6 ; 33 ^LBRAC (ESC)
6 ; 34 ^\
6 ; 35 ^RBRAC
6 ; 36 ^^
6 ; 37 ^_
3 ; 40 SPACE
XWD 1,1 ; 41 !
XWD 2,6 ; 42 "
0 ; 43 #
XWD 2,6 ; 44 $
XWD 2,6 ; 45 %
XWD 1,6 ; 46 &
7 ; 47 '
0 ; 50 (
0 ; 51 )
0 ; 52 *
0 ; 53 +
0 ; 54 ,
0 ; 55 -
XWD 3,6 ; 56 .
0 ; 57 /
-2 ; 60 0
-2 ; 61 1
-2 ; 62 2
-2 ; 63 3
-2 ; 64 4
-2 ; 65 5
-2 ; 66 6
-2 ; 67 7
-2 ; 70 8
-2 ; 71 9
1 ; 72 :
0 ; 73 ;
1 ; 74 LESS THAN
0 ; 75 =
1 ; 76 GRTR THAN
6 ; 77 ?
XWD 1,6 ; 100 @
-1 ; 101 A
-1 ; 102 B
-1 ; 103 C
-1 ; 104 D
-1 ; 105 E
-1 ; 106 F
-1 ; 107 G
-1 ; 110 H
-1 ; 111 I
-1 ; 112 J
-1 ; 113 K
-1 ; 114 L
-1 ; 115 M
-1 ; 116 N
-1 ; 117 O
-1 ; 120 P
-1 ; 121 Q
-1 ; 122 R
-1 ; 123 S
-1 ; 124 T
-1 ; 125 U
-1 ; 126 V
-1 ; 127 W
-1 ; 130 X
-1 ; 131 Y
-1 ; 132 Z
0 ; 133 LBRAC
6 ; 134 \
0 ; 135 RBRAC
0 ; 136 ^
0 ; 137 _
6 ; 140 LEFT SINGLE QUOTE
5 ; 141 LA
5 ; 142 LB
5 ; 143 LC
5 ; 144 LD
5 ; 145 LE
5 ; 146 LF
5 ; 147 LG
5 ; 150 LH
5 ; 151 LI
5 ; 152 LJ
5 ; 153 LK
5 ; 154 LL
5 ; 155 LM
5 ; 156 LN
5 ; 157 LO
5 ; 160 LP
5 ; 161 LQ
5 ; 162 LR
5 ; 163 LS
5 ; 164 LT
5 ; 165 LU
5 ; 166 LV
5 ; 167 LW
5 ; 170 LX
5 ; 171 LY
5 ; 172 LZ
6 ; 173 LEFT BRACE
6 ; 174 VERTICAL BAR
3 ; 175 RIGHT BRACE (ALTMODE)
6 ; 176 NOT
2 ; 177 DELETE
; ***** L E T T E R *****
;
; "LETTER" SCANS IDENTIFIER NAMES AND RESERVED WORDS,
; UNLESS RESERVED WORDS ARE QUOTED. "LETTER" WILL OUTPUT
; THE LEXEME OF A RESERVED WORD OR THE BUFFER ADDRESS OF AN
; IDENTIFIER.
;
; "LETTER" READS CHARACTERS 6 AT A TIME. THE 7-BIT
; CHARACTERS ARE READ INTO REGISTER A1 WITH AN ILDB AND
; THEN 6 OF THESE BITS ARE SHIFTED INTO REGISTER A2 WITH
; A "LSHC A1,-6" . WHEN REGISTER A2 IS FULL IT IS DUMPED
; INTO THE NEXT WORD OF A NAME BUFFER. THUS THE NAME IS
; STORED IN A NAME BUFFER, 6 CHARACTERS PER WORD (NOT
; THE SAME AS "SIXBIT" CHARACTERS), WITH THE CHARACTERS IN
; REVERSE ORDER, AND WITH BLANKS ON THE RIGHT. THE RIGHT-MOST
; 6 BITS OF THE 1ST WORD OF THE NAME IN THE NAME BUFFER
; CONTAIN THE LENGTH OF THE NAME IN CHARACTERS MINUS 1.
; THE WORD IMMEDIATELY PRECEDING THE NAME BUFFER CONTAINS
; THE LENGTH OF THE NAME IN WORDS MINUS 1.
;
; UNLESS RESERVED WORDS ARE QUOTED, THE NAME IS THEN LOOKED
; UP IN THE RESERVED WORD TABLE TO FIND OUT IF IT IS A RESERVED
; WORD. IF IT IS FOUND, THE LEXEME IS OUTPUT, AND THE NAME
; BUFFER WILL BE USED AGAIN AT THE NEXT CALL TO "LETTER".
; IF IT IS NOT FOUND, THE NAME BUFFER ADDRESS IS OUTPUT.
; THIS ADDRESS IS USED BY "SEARCH" TO LOCATE THE IDENTIFIER
; IN THE SYMBOL TABLE. THE NEXT CALL TO "LETTER" WILL NOT
; USE THE SAME NAME BUFFER, THUS "SEARCH" DOES NOT HAVE TO
; BE CALLED IMMEDIATELY. "LETTER" CURRENTLY ROTATES AMONGST
; THREE NAME BUFFERS.
;
LOWER: MOVEI A1,-40(A1) ; CONVERT TO UPPER CASE
LETTER: SKIPE A5,RWS ; IF RESERVED MODE
MOVE A5,@A5 ; LOCATE RESERVED WORD SUBLIST
MOVEM A5,RWSL ; SAVE IT FOR LATER
AOSA A3,LSBUFP ; GET LIST INDEX AND SKIP
SETZM LSBUFP ; ZERO INDEX
SKIPN A3,LSBUFT(A3) ; LOCATE A NAME BUFFER
JRST .-2 ; -RECYCLE
SETZ A2, ; CLEAR A2
HRLZI A5,-5 ; SCAN 1ST 5 CHARS
HRLZI A6,-13 ; BUT NO MORE THAN 65 CHARS
; CHARACTER-READING LOOP
LET1: LSHC A1,-6 ; MOVE CHAR TO ACC A1
ILDB A1,P ; GET NEXT CHAR
AOS CC ; STEP POSITION COUNT
SKIPL A4,CTABLE(A1) ; CHECK IF LETTER OR NUMBER
JRST @TABLE2(A4) ; -NO, GOTO A ROUTINE
LET2: AOBJN A5,LET1 ; LOOP
; END OF 6-CHAR GROUP
MOVEM A2,@A3 ; SAVE CHARS IN NAME BUFFER
SETZ A2, ; CLEAR A2
HRLI A5,-6 ; READ NEXT 6 CHARS
AOBJN A6,LET1 ; BUT NOT PAST 65 CHARS
; LINE EXCEEDS 64 CHARS
LET3: MOVEI A6,-1(A6) ; BACK UP COUNTER
FAIL (91,SOFT,IMM,NAME EXCEEDS 64 CHARACTERS)
PUSHJ SP,ATNAC ; ADVANCE TO NEXT ALPHAMERIC CHARACTER
MOVEI A5,77 ; MAKE NAME 63 CHARACTERS LONG
MOVEI A6,12 ; MAKE NAME 11 WORDS LONG
JRST LET4+3 ; CONTINUE
TABLE2: LET4 ; DELIMITERS
LET4 ; DELIMITERS (FLAGGED)
LET1+1 ; IGNORABLES
LET12 ; SPACE & TAB
LET13 ; NEW-LINE
LET11 ; LOWER CASE
LET14 ; OTHER
LET4 ; SINGLE QUOTE
LET12: SKIPN RWS ; RESERVED WORD MODE?
JRST LET1+1 ; NO - IGNORE
; END OF NAME, CHECK IF RESERVED WORD
LET4: MOVEM A2,@A3 ; SAVE LAST GROUP OF CHARS
TRNE A5,100 ; IF NAME IS 65 CHARACTERS LONG
JRST LET3 ; THEN GIVE ERROR
HRRZM A6,-1(A3) ; PUT LENGTH-IN-WORDS IN BUFFER
MOVEI A6,(A5) ; PUT LENGTH-IN-CHARS IN A6
IORB A6,(A3) ; PUT LENGTH IN BUFFER, PICK UP 1ST WORD
SQ3: SKIPN A5,RWSL ; IS THERE A SUBLIST?
JRST LET9 ; -NO, SKIP EVERY THING
LET7: CAME A6,RWTNAM(A5) ; DO 1ST WORDS MATCH?
JRST LET8 ; -NO, CONTINUE SEARCH
LET5: SKIPL A4,RWTLEN(A5) ; IS NAME 1 WORD LONG?
JRST LET6 ; -NO, 2 WORDS LONG
LET10: MOVE A4,1(A3) ; GET 2ND WORD OF NAME BUFFER
CAME A4,RWTNAM+1(A5) ; DO 2ND WORDS MATCH
JRST LET8 ; -NO, CONTINUE
; NAME FOUND IN RESERVED-WORD TABLE
LET6: MOVE A3,RWTLEX(A5) ; LOAD LEXEME
SKIPE RWS ; IF RESERVED WORD MODE
SOS LSBUFP ; RELEASE BUFFER
CAIGE A5,FRW ; IS RESERVED WORD FLAGGED?
JRST @RWTRT(A5) ; -YES, GOTO ROUTINE
POPJ SP, ; -NO, LSCAN
LET8: HRRZ A5,RWTLNK(A5) ; LOCATE ENTRY ON SUBLIST
JUMPN A5,LET7 ; LOOP UNLESS LINK=0
;;; GENERAL SKIP RETURN POINT
; NAME IS NOT A RESERVED WORD - IS AN IDENTIFIER
LET9: POP SP,A4 ; GET RETURN LINK
JRST 1(A4) ; SKIP RETURN
; LOWER-CASE LETTER SCANNED
LET11: MOVEI A1,-40(A1) ; CONVERT TO UPPER CASE
JRST LET2 ; CONTINUE
LET13: PUSHJ SP,NCHECK ; INPUT NEXT LINE
JRST LET1+3 ; -END OF BUFFER IN MID LINE, CONTINUE
JRST LET4 ; END OF NAME
LET14: CAIE A1,.DOT ; IF THIS IS A DOT
JRST LET4 ; ELSE END OF NAME
PUSH SP,A6 ; SAVE A6
PUSH SP,A2 ; SAVE A2
JSP A6,GETCHR ; READ NEXT CHARACTER
POP SP,A2 ; RESTORE A2
POP SP,A6 ; RESTORE A6
SKIPGE CTABLE(A1) ; IF IT IS A LETTER OR A NUMBER
JRST LET2 ; THEN CONTINUE WITH IDENTIFIER NAME
MOVE A4,ZDOT ; ELSE BUFFER THE LEXEME FOR
MOVEM A4,BLEX ; THE DELIMITER "DOT"
JRST LET4 ; END OF IDENTIFIER NAME
; THE FOLLOWING ROUTINES PROCESS THE FLAGGED RESERVED WORDS
FBEGIN: SOSGE A5,BTI ; DECREMENT BEGIN TABLE INDEX
POPJ SP, ; EXIT LSCAN IF TABLE IS FULL
AOS A4,BNUM ; ADD 1 TO BEGIN NUMBER
MOVEM A4,BTAB(A5) ; STORE NUMBER IN TABLE
POPJ SP, ; EXIT LSCAN
FEND: AOSG A4,BTI ; STEP BEGIN TABLE INDEX
POPJ SP, ; EXIT LSCAN IF TABLE STILL FULL
SKIPE A4,BTAB-1(A4) ; LOAD BEGIN NUMBER (DON'T PRINT E0)
MOVEM A4,ENUM ; SAVE FOR PRINTING
POPJ SP, ; EXIT LSCAN
; A "GO" HAS BEEN SCANNED, NOW SEARCH FOR THE "TO"
FGO: LDB A1,P ; GET LAST CHAR
MOVE A2,CTABLE(A1) ; GET ITS TABLE ENTRY
FGO1: CAIE A2,3 ; IF IT IS NOT A SPACE OR A TAB
JRST GOERR2 ; THEN HE BLEW IT
JSP A6,GETCHR ; GET ANOTHER CHAR
CAIE A1,.T ; IF IT IS NOT A "T"
JRST FGO1 ; THEN SEARCH NEXT CHAR
JSP A6,GETCHR ; GET ANOTHER CHAR
CAIE A1,.O ; IF IT IS NOT A "O"
JRST GOERR1 ; THEN IT IS WRONG
JSP A6,GETCHR ; GET ANOTHER CHAR
CAIE A2,-1 ; THIS CHARACTER MUST NOT BE AN UPPER
CAIN A2,5 ; OR LOWER CASE LETTER
JRST GOERR1 ; OR IT IS AN ERROR
FGO2: MOVE A3,ZGOTO ; LOAD LEXEME
POPJ SP, ; EXIT LSCAN
GOERR1: PUSHJ SP,ATNAC ; ADVANCE TO NON-ALPHAMERIC CHAR
GOERR2: FAIL (99,SOFT,IMM,DID NOT FIND 'TO' IN 'GOTO' STATEMENT) ; [273]
JRST FGO2
COMNT2: SKIPN RWS ; 'COMMENT': IF QUOTED MODE
JRST [POP SP,A1 ; [273] THEN LOSE LINK FROM SQUOTE
JRST COMNT1] ; [273] AND PARSE COMMENT
TDZA A1,A1 ; AND CLEAR A1
COMNT0: MOVEI A1,-1 ; "!": FLAG A1
CAME DEL,ZEND ; IF DEL#END
EDIT(104); Allow comment to go over newlines without error.
JRST COMNT4 ; [E104] THEN PROCEED
;
Edit(161); Accept COMMENT after END without error.
;
SKIPE A1 ; [E161] ELSE if "!" then
JSP A6,GETCHR ; [E161] get next character
JRST LSCAN ; [E161] and let SBEGIN process comment.
COMNT4: PUSHJ SP,COMNT3(A1) ; [E104] DISPATCH TO IGNORE COMMENT
IBP P ; [E104] THEN STEP BYTE POINTER
AOS CC ; [E104] AND CHARACTER COUNT
JRST LSCAN ; [E104] TO IGNORE SEMICOLON
NEW2: PUSHJ SP,NEWLINE ; CALL NEWLINE (SKIP RETURN!)
COMNT1: JSP A6,GETCHR ; GET NEXT CHAR
COMNT3: LDB A1,P ; GET THE CHARACTER
MOVE A2,CTABLE(A1) ; GET ITS TABLE ENTRY
CAIN A2,4 ; IF IT IS A NEW-LINE CHAR
JRST NEW2 ; THEN HANDLE SPECIALLY
CAIN A1,.SEMI ; [273] IF IT'S A SEMI-COLON
POPJ SP, ; [273][E104] THEN RETURN
SKIPE RWS ; [273] ELSE, RESERVED WORD MODE?
JRST COMNT1 ; [273] NO, JUST LOOP UNTIL SEMICOLON FOUND
CAIE A2,7 ; [273] YES, IS CHR. A SINGLE-QUOTE?
JRST COMNT1 ; [273] NO, CONTINUE LOOPING
FAIL (92,SOFT,IMM,RESERVED WORD DELIMITER NOT ALLOWED HERE) ; [273]
JRST COMNT1 ; [273] YES, ERROR AND CONTINUE SCANNING COMMENT
44; ***** D I G I T S *****
;
; "DIGITS" IS USED TO SCAN DECIMAL CONSTANTS. "DIGITS"
; WILL COMPUTE THE VALUE, PUT IT INTO THE CONSTANTS TABLE
; IF NECESSARY, AND PRODUCE THE LEXEME.
;
; "DIGITS" WORKS BY READING THE 1ST 10 DIGITS WITH A
; QUICK 7-INSTRUCTION LOOP (LLOOP1) THAT ALWAYS PRODUCES AN INTEGER.
; IF A DECIMAL POINT IS ENCOUNTERED, THE LOOP INDEX IS SAVED
; IN "MARKER" AND USED LATER TO DETERMINE THE POWER OF TEN,
; THEN CONTROL RETURNS TO THE LOOP. IF THERE ARE MORE THAN
; TEN DIGITS, CONTROL PASSES TO A SECOND LOOP (LLOOP2) THAT
; READS DIGITS INTO THE DOUBLE AC 4-5 ABSORBING A DECIMAL
; POINT IF NECESSARY. FINALLY
; THE CONSTANT IS CONVERTED TO THE INDICATED TYPE.
; SINGLE-PRECISION FLOATING POINT IS FIRST CONVERTED TO
; DOUBLE-PRECISION FLOATING POINT, THEN THE POWER OF TEN
; IS INCLUDED. THIS IS DONE SO THAT ALL 27 BITS OF THE
; FRACTION ARE ACCURATE.
; ROUNDING TO SINGLE-PRECISION IS DONE LATER, IF NECESSARY, BY
; CONVERT.
;
DIGITS:
; SET UP FOR READING DIGITS
MOVEI A3,^D9 ; READ 1ST 9 DIGITS OF NUMBER
SETZB A4,MARKER ; CLEAR DECIMAL POINT MARKER
SETZM EXTRA ; AND EXTRA DIGIT COUNT
EDIT(044); Dont force constants to D.P. unnecessarily
SETZM FORMAT ; [E044] ASSUME IT WILL BE SINGLE PRECISION
MOVEI A5,-.N0(A1) ; CONVERT 1ST CHAR TO BINARY
; MAIN LOOP FOR SCANNING NUMBER
LLOOP1: ILDB A1,P ; READ NEXT CHAR
AOS CC ; STEP POSITION COUNT
C1: MOVE A2,CTABLE(A1) ; GET CHAR'S TABLE ENTRY
JRST @TABLE4(A2) ; JUMP THROUGH TABLE 4
C2: IMULI A5,^D10 ; MULT PREVIOUS RESULT BY TEN
ADDI A5,-.N0(A1) ; ADD IN NEW DIGIT
SOJG A3,LLOOP1 ; LOOP
; NUMBER IS LONGER THAN 10 CHARS
MOVEI A3,30000 ; SET A NEW INDEX
SKIPE MARKER ; IF A DECIMAL POINT HAS OCCURRED
ADDM A3,MARKER ; THEN ADD NEW INDEX TO MARKER
; LOOP THAT READS UNTIL OVERFLOW
LLOOP2: JSP A6,IGST ; READ NEXT CHAR
CAIN A1,.DOT ; IF IT IS A DOT
JRST C3 ; THEN EXIT THIS LOOP
MOVE A2,CTABLE(A1) ; IF CHAR IS NOT NUMERIC
AOJGE A2,@TABLE4(A2) ; GO ELSEWHERE
EXCH A4,A5 ; SWAP TO LONG MULTIPLY
MULI A4,^D10 ; MULTIPLY SUM SO FAR
ADDI A5,-.N0(A1) ; AND ADD THE NUMBER
TLZE A5,(1B0) ; [E044] OVERFLOW INTO TOP BIT ?
AOJA A4,C6D ; [E044] YES - ADD IT IN TO A4
JUMPN A4,C6D ; IF A4 NON-ZERO SUM V. LARGE
SOJA A3,LLOOP2 ; KEEP GOING
C3: MOVEM A3,MARKER ; STORE DECIMAL POINT MARKER
; MAIN LOOP FOR SCANNING LONG NUMBERS
LLOOP3: ILDB A1,P ; GET NEXT CHAR
AOS CC ; STEP POSITION COUNT
C5: MOVE A2,CTABLE(A1) ; GET(TABLE ENTRY
JRST @TABLE5(A2) ; AND USE TABLE5
C6: MOVEM A5,COPY ; LONG INTEGER MULTIPLY
MULI A4,^D10 ; MULTIPLY HIGH-ORDER WORD
JUMPN A4,C6A ; TOO BIG IF NON-ZERO
MOVE A4,COPY ; NOW THE LOW-ORDER
MOVEM A5,COPY ; INTO THE CORRECT HALF
MULI A4,^D10 ; MULTIPLY LOW-ORDER WORD
ADDI A5,-.N0(A1) ; ADD IN THE NEW NUMBER
ADD A4,COPY ; ADD BACK THE HIGH ORDER WORD
TLZE A5,(1B0) ; [E044] CARRY INTO TOP BIT OF LOW WORD ?
ADDI A4,1 ; [E044] YES - ADD IN TO HIGH WORD
C6D: SOJA A3,LLOOP3 ; AND KEEP GOING
C6A: DIVI A4,^D10 ; RESTORE THE ORIGINAL NUMBER
MOVE A5,COPY ; RESTORE LOW-ORDER WORD
SKIPE MARKER ; IF DECIMAL POINT EVER SCANNED
JRST C6C ; DON'T WORRY
;
; OTHERWISE NUMBER IS TOO LARGE - SAY SO
;
CAIL A1,"5" ;
ADDI A5,1 ; ROUND IN IGNORED DIGIT
MOVE A1,[..IMM,,^D98]
PUSHJ SP,.FAILED
AOS EXTRA ; ALLOW FOR DIGIT JUST IGNORED
C6C: AOS CC
ILDB A1,P ; NEXT CHAR
MOVE A2,CTABLE(A1) ; GET ITS TABLE ENTRY
AOJGE A2,@TABLE5(A2)
SKIPN MARKER ; IF NO DECIMAL POINT SEEN,
AOS EXTRA ; COUNT IGNORED DIGITS
JRST C6C ; AND KEEP IGNORING
C2 ; NUMBER
C8 ; LETTER
TABLE4: C8 ; DELIMITER
C8 ; DELIMITER (FLAGGED)
LLOOP1 ; IGNORABLE CHARACTER
LLOOP1 ; SPACE & TAB
C8B ; NEW-LINE
C8 ; LOWER CASE LETTER
C10 ; OTHER (E.G. PERIOD, &, @)
C8 ; SINGLE QUOTE
C8B: PUSHJ SP,NCHECK ; INPUT NEXT LINE
JRST C1 ; -END OF BUFFER IN MID LINE, CONTINUE
; NORMAL END OF NUMBER
C8: SKIPE MARKER ; IF A DECIMAL POINT WAS EVER SCANNED
JRST C18 ; THEN THE NUMBER IS DOUBLE-FLOATING
C8A: TLNE A5,777777 ; IF LEFT HALF OF VALUE IS NON ZERO
JRST C9 ; THEN NUMBER IS NOT INTEGER-IMMEDIATE
; THE CONSTANT IS AN INTEGER-IMMEDIATE
MOVE A3,A5 ; MOVE CONSTANT TO A3 FOR OUTPUT
HRLI A3,$EXP+$I+$SIM+$DEC+$IMM; LEXEME TYPE FIELDS
JRST LET9 ; EXIT LSCAN
; THE CONSTANT IS AN INTEGER FULLWORD
C9: PUSHJ SP,CON1Z ; SEARCH CONSTANTS TABLE
HRLI A3,$EXP+$I+$SIM+$DEC+$CT; LEXEME LEFT HALF
JRST LET9 ; EXIT LSCAN
; A SPECIAL CHARACTER WAS SCANNED
C10: HLRZ A2,CTABLE(A1) ; GET LEFT HALF OF CHAR'S TABLE ENTRY
JRST @TABLE6(A2) ; JUMP THROUGH TABLE 6
TABLE6: C19 ; ILLEGAL CHARACTER
C22 ; [E044] @ &
C20 ; " $ %
C16 ; .
; A DOT WAS SCANNED
C16: SKIPE MARKER ; IF MARKER NOT ZERO THEN THERE ARE
JRST C17 ; TWO DECIMAL POINTS IN THIS CONSTANT
MOVEM A3,MARKER ; SET DECIMAL POINT MARKER
JRST LLOOP1 ; RETURN TO LOOP
; CONSTANT CONTAINS TWO DECIMAL POINTS
C17: PUSHJ SP,BADNAC ; PRINT ERROR MSG, USE ATNAC
; CONVERT CONSTANT TO DOUBLE-FLOATING
C18: SUB A3,MARKER ; FIX SCALING CONSTANT
JRST C13 ; HALVES AND CONTINUE
; AN ILLEGAL CHARACTER WAS SCANNED
C19: PUSHJ SP,BADNAC ; PRINT ERROR MESSAGE, USE ATNAC
JRST C8 ; CONTINUE
C20: PUSHJ SP,BADCON ; PRINT ERROR MSG
JRST C8 ; CONTINUE
C6 ; NUMBER
C30 ; LETTER
TABLE5: C28 ; DELIMITER
C28 ; DELIMITER (FLAGGED)
LLOOP3 ; IGNORABLE
EDIT (215); CHANGE AT TABLE5 + 3 CLRH 17-JULY-79
LLOOP3 ;[215] SPACE AND TAB
;[215] C28 ; SPACE & TAB
C36 ; NEW-LINE
C30 ; LOWER CASE LETTER
C21 ; OTHER
C28 ; SINGLE QUOTE
; A SPECIAL CHAR WAS SCANNED
C21: HLRZ A2,CTABLE(A1) ; GET LEFT HALF OF CHAR'S TABLE ENTRY
JRST @TABLE7(A2) ; JUMP THROUGH TABLE 7
TABLE7: C27 ; ILLEGAL CHARACTER
C22 ; @ &
C30 ; " $ %
C25 ; .
; A @ OR & WAS SCANNED
C22: JSP A6,IGST ; GET NEXT CHAR
CAIE A1,.AAAAA ; IF IT IS A @
CAIN A1,.AMPER ; OR A &
AOSA FORMAT ; [E044] THEN REMEMBER IT WAS
JRST C24 ; [E044] ELSE CARRY ON
JSP A6,IGST ;[215] IGNORE IT
;[215] JSP A6,GETCHR ; [E044] IGNORE IT
;**** JRST C24 ; [E044] FALL THROUGH TO GET EXPONENT
; PRODUCE LEXEME FOR DOUBLE PRECISION CONSTANT
C24: PUSHJ SP,EXPONT ; SCAN THE EXPONENT
C13: PUSHJ SP,FCMML ; INCLUDE CORRECT POWER OF TEN
SKIPE FORMAT ; [E044] IS THIS EXPLICIT DOUBLE PRECISION ?
JRST C13A ; [E044] YES - MUST MAKE DOUBLE-WORD CONSTANT
JUMPE A5,C13B ; [E044] NO - CAN WE USE A SINGLE WORD ?
TLO A5,(1B0) ; [E044] NO - SET SIGN BIT OF SECOND WORD TO 1
C13A: PUSHJ SP,CON2 ; PUT CONSTANT IN CONSTANT TABLE
HRLI A3,$EXP+$LR+$SIM+$DEC+$CT; LEXEME LEFT HALF
JRST LET9 ; EXIT LSCAN
C13B: TRNN A4,-1 ; [E044] CAN THIS BE AN IMMEDIATE CONSTANT ?
JRST C13C ; [E044] YES - GO FORM THE LEXEME
PUSHJ SP,CON1 ; [E044] NO - ENTER IT IN THE TABLE
HRLI A3,$EXP+$R+$SIM+$DEC+$CT; [E044] FORM LEXEME
JRST LET9 ; [E044] EXIT FROM LSCAN
C13C: HLRZ A3,A4 ; [E044] IMMEDIATE REAL CONSTANT - GET VALUE
HRLI A3,$EXP+$R+$SIM+$DEC+$IMM; [E044] SET LEXEME BITS IN L.H.
JRST LET9 ; [E044] AND EXIT FROM LSCAN
; A DOT WAS SCANNED
C25: SKIPE MARKER ; IF MARKER NOT ZERO THEN THERE ARE
JRST C26 ; TWO DECIMAL POINTS IN THIS CONSTANT
MOVEM A3,MARKER ; SET DECIMAL POINT MARKER
JRST LLOOP3 ; RETURN TO LOOP
; EITHER A LETTER OR TWO DECIMAL POINTS APPEARED IN CONSTANT
C26: PUSHJ SP,BADNAC ; PRINT ERROR MSG, USE ATNAC
JSP A6,IGST ; GET NEXT CHAR
CAME A1,.AAAAA ; IF IT IS A @
CAMN A1,.AMPER ; OR A &
JRST C22 ; THEN CONTINUE AS DOUBLE-PRECISION
JRST C28 ; ELSE CONVERT TO SINGLE-PRECISION
; A STRANGE CHAR APPEARED IN CONSTANT
C27: PUSHJ SP,BADNAC ; PRINT ERROR MSG, USE ATNAC
JRST C28 ; CONTINUE
C30: PUSHJ SP,BADCON ; PRINT ERROR MESSAGE
C28: SKIPE MARKER ; IF A DECIMAL POINT WAS EVER SCANNED
JRST C29 ; THEN JUMP OVER THIS PART
; INTEGER TOO LARGE FOR INTEGER
MOVE A1,[ ; LOAD PARAMETER FOR MESSAGE
XWD ..IMM,^D98] ; MSG 98
PUSHJ SP,.FAILED ; "INTEGER CONST CONVERTED TO TYPE REAL"
TDZA A3,A3 ; EXPONENT OF ZERO
C29: SUB A3,MARKER ; FIX SCALING
ADD A3,EXTRA ; ALLOW FOR SKIPPED DIGITS
JRST C13 ; CONTINUE AS DOUBLE PRECISION
BADCON: FAIL (90,FRIED,IMM,INVALID CONSTANT)
POPJ SP, ; EXIT BADCON
; SUBROUTINE TO SCAN POWER OF TEN
EXPONT: SKIPE MARKER ; IF A DECIMAL POINT HAS OCCURRED
SUBM A3,MARKER ; THEN SET CORRECT POWER OF TEN
SETZB A3,SIGN ; CLEAR EXPONENT AND SIGN
CAIN A1,.MINUS ; IF IT IS A MINUS SIGN
JRST C34 ; THEN SET INDICATOR
CAIN A1,.PLUS ; IF IT IS A PLUS SIGN
JRST C35 ; THEN READ NEXT CHAR
LLOOP4: HRRZ A2,CTABLE(A1) ; GET CHAR'S TABLE ENTRY
CAIE A2,-2 ; IF IT IS NOT A DIGIT
JRST C31 ; THEN JUMP OUT OF LOOP
IMULI A3,^D10 ; MULT PREVIOUS RESULT BY TEN
ADDI A3,-.N0(A1) ; ADD IN CURRENT DIGIT
CAILE A3,^D300 ; IF NUMBER IS EXCEEDINGLY LARGE
JRST C33 ; THEN STOP THIS NONSENSE
JSP A6,IGST ; GET NEXT CHAR
JRST LLOOP4 ; LOOP
C31: CAIN A2,6 ; IF IT IS AN ILLEGAL CHAR
JRST C33 ; THEN PRINT ERROR
SKIPE SIGN ; IF SIGN IS NEGATIVE
MOVN A3,A3 ; THEN NEGATE EXPONENT
ADD A3,EXTRA ; ALLOW FOR ANY IGNORED DIGITS
SETZM EXTRA ;
ADD A3,MARKER ; ADD IN DECIMAL POINT CORRECTION
POPJ SP, ; EXIT EXPONT
C33: PUSHJ SP,BADNAC ; PRINT MSG, USE ATNAC
C4: SETZ A3, ; USE A ZERO EXPONENT
POPJ SP, ; EXIT EXPONT
C34: SETOM SIGN ; SET SIGN MINUS
C35: JSP A6,IGST ; GET NEXT CHAR
JRST LLOOP4 ; RETURN TO LOOP
C36: PUSHJ SP,NCHECK ; INPUT NEXT LINE
JRST C5 ; -END OF BUFFER IN MID LINE, CONTINUE
JRST C28 ; TRUE END OF LINE
; UNDERFLOW HANDLERS
FPU1: TLNN A2,000100 ; IF NOT UNDERFLOW
JRST (A2) ; THEN RETURN
TLZ A2,440100 ; CLEAR FLAGS
MOVEM A2,OVA
LDB A2,[POINT 4,-2(A2),12] ; GET RELEVANT ACC. NUMBER
SETZM (A2) ; AND ZERO IT
JRST 2,@OVA ; AND RETURN
FPU2: TLNN A2,000100 ; IF NOT UNDERFLOW
JRST (A2) ; THEN RETURN
TLZ A2,440100 ; CLEAR FLAGS
MOVEM A2,OVA
LDB A2,[POINT 4,-2(A2),12] ; GET RELEVANT ACC. NUMBER
SETZM (A2) ; AND ZERO IT
SETZM 1(A2) ; ALSO ZERO NEXT ACC.
JRST 2,@OVA ; AND RETURN
FPUS: TLNN A2,000100 ; IF NOT UNDERFLOW
JRST (A2) ; THEN RETURN
TLZ A2,440100 ; CLEAR FLAGS
MOVEM A2,OVA
LDB A2,[POINT 4,-2(A2),12] ; GET RELEVANT ACC. NUMBER
MOVEM A2,OVB ; AND SAVE IT
MOVEM A3,OVC ; AND A3
MOVE A2,(A2) ; GET VALUE OF ACC.
HLRE A3,A2 ; GET EXPONENT, EXTENDING SIGN
ASH A3,-11
TSCE A3,A3 ; IF NEGATIVE, COMPLEMENT EXPONENT
TLOA A2,777000 ; NEGATIVE - SET ALL ONES
TLZ A2,777000 ; POSITIVE - SET ALL ZEROS
CAMGE A3,[346,,346] ; WILL ALL OF MANTISSA DISAPPEAR?
TDZA A2,A2 ; YES - SAVE LONG SHIFT
ASH A2,400000(A3) ; DENORMALIZE MANTISSA TO SUIT EXPONENT
MOVEM A2,@OVB ; RESTORE RELEVANT ACC.
MOVE A3,OVC ; RESTORE A3
JRST 2,@OVA ; AND RETURN
RELOC
LSBUFP: BLOCK 2 ; NAME BUFFER POINTER
LSBUF1: BLOCK 14 ; NAME BUFFER
LSBUF2: BLOCK 14 ; NAME BUFFER
LSBUF3: BLOCK 14 ; NAME BUFFER
RWSL: BLOCK 1 ; ADDR OF RESERVED WORD TABLE SUBLIST
BLEX: BLOCK 1 ; BUFFERED LEXEME
CC: BLOCK 1 ; POSITION COUNT
BTI: BLOCK 1 ; BEGIN-TABLE INDEX
BTAB: BLOCK 50 ; BEGIN-TABLE
EXPSAV: BLOCK 1 ; TO SAVE THE EXPONENT
DECEXP: BLOCK 1 ; TO STORE THE DECIMAL EXPONENT
RELOC
LSBUFT: XWD A6,LSBUF1 ; NAME BUFFER LIST
XWD A6,LSBUF2
XWD A6,LSBUF3
0
MSKTBL: 000000000000
000000000000
000000000377
000000077777
000000000000
000017777777
000000000000
003777777777
SUBTTL POWERS OF TEN TABLE
;
;POWER OF TEN TABLE IN DOUBLE PRECISION INTEGER FORMAT,
; EACH WITH 35 BITS OF FRACTION (SIGNS ARE EXLCLUDED), THE
; BINARY POINT IS BETWEEN BITS 0 AND 1 OF THE HIGH ORDER
; WORD, THE EXPONENT (EXCESS 200) FOR THE 70 BIT FRACTION
; IS STORED IN THE SHORT TABLE "EXPTEN"
;
DEFINE .TAB. (A)<
REPEAT 0,<
NUMBER 732,357347511265,056017357445
NUMBER 736,225520615661,074611525567
NUMBER 741,273044761235,213754053125
NUMBER 744,351656155504,356747065752
NUMBER 750,222114704413,025260341562
NUMBER 753,266540065515,332534432117
NUMBER 756,344270103041,121263540543
NUMBER 762,216563051724,322660234335
NUMBER 765,262317664312,007434303425
NUMBER 770,337003641374,211343364332
NUMBER 774,213302304735,325716130610
NUMBER 777,256162766125,113301556752
>
NUMBER 002,331617563552,236162112545
NUMBER 006,210071650242,242707256537
NUMBER 011,252110222313,113471132267
NUMBER 014,324532266776,036407360745
NUMBER 020,204730362276,323044526457
NUMBER 023,246116456756,207655654173
NUMBER 026,317542172552,051631227231
NUMBER 032,201635314542,132077636440
NUMBER 035,242204577672,360517606150
NUMBER 040,312645737651,254643547602
NUMBER 043,375417327624,030014501542
NUMBER 047,236351506674,217007711035
NUMBER 052,306044030453,262611673245
NUMBER 055,367455036566,237354252116
NUMBER 061,232574123152,043523552261
NUMBER 064,301333150004,254450504735
NUMBER 067,361622002005,327562626124
NUMBER 073,227073201203,246647575664
NUMBER 076,274712041444,220421535242
NUMBER 101,354074451755,264526064512
NUMBER 105,223445672164,220725640716
NUMBER 110,270357250621,265113211102
NUMBER 113,346453122766,042336053323
NUMBER 117,220072763671,325412633103
NUMBER 122,264111560650,112715401724
NUMBER 125,341134115022,135500702312
NUMBER 131,214571460113,172410431376
NUMBER 134,257727774136,131112537675
NUMBER 137,333715773165,357335267655
NUMBER 143,211340575011,265512262714
NUMBER 146,253630734214,043034737477
NUMBER 151,326577123257,053644127417
NUMBER 155,206157364055,173306466551
NUMBER 160,247613261070,332170204303
NUMBER 163,321556135307,020626245364
NUMBER 167,203044672274,152375747331
NUMBER 172,243656050753,205075341217
NUMBER 175,314631463146,146314631463
A:
NUMBER 201,200000000000,0
NUMBER 204,240000000000,0
NUMBER 207,310000000000,0
NUMBER 212,372000000000,0
NUMBER 216,234200000000,0
NUMBER 221,303240000000,0
NUMBER 224,364110000000,0
NUMBER 230,230455000000,0
NUMBER 233,276570200000,0
NUMBER 236,356326240000,0
NUMBER 242,225005744000,0
NUMBER 245,272207335000,0
NUMBER 250,350651224200,0
NUMBER 254,221411634520,0
NUMBER 257,265714203644,0
NUMBER 262,343277244615,0
NUMBER 266,216067446770,040000000000
NUMBER 271,261505360566,050000000000
NUMBER 274,336026654723,262000000000
NUMBER 300,212616214044,117200000000
NUMBER 303,255361657055,143040000000
NUMBER 306,330656232670,273650000000
NUMBER 312,207414740623,165311000000
NUMBER 315,251320130770,122573200000
NUMBER 320,323604157166,147332040000
NUMBER 324,204262505412,000510224000
NUMBER 327,245337226714,200632271000
NUMBER 332,316627074477,241000747200
NUMBER 336,201176345707,304500460420
NUMBER 341,241436037271,265620574524
NUMBER 344,311745447150,043164733651
NUMBER 347,374336761002,054022122623
NUMBER 353,235613266501,133413263573
NUMBER 356,305156144221,262316140531
NUMBER 361,366411575266,037001570657
NUMBER 365,232046056261,323301053415
NUMBER 370,300457471736,110161266320
NUMBER 373,360573410325,332215544004
NUMBER 377,226355145205,250330436402
REPEAT 0,<
NUMBER 402,274050376447,022416546102
NUMBER 405,353062476160,327122277522
NUMBER 411,222737506706,206363367623
NUMBER 414,267527430470,050060265567
NUMBER 417,345455336606,062074343124
NUMBER 423,217374313163,337245615764
NUMBER 426,263273376020,327117161361
NUMBER 431,340152275425,014743015655
NUMBER 435,214102366355,050055710514
NUMBER 440,257123064050,162071272637
NUMBER 443,332747701062,216507551406
NUMBER 447,210660730537,231114641743
NUMBER 452,253035116667,177340012333
>
>
DEFINE NUMBER(A,B,C)
<EXP B,C>
TENTAB: .TAB. TENS
XX==<TENS-TENTAB>/2 ; CALCULATE THE NUMBER OF TABLE ENTRIES BEFORE "TENS"
XX==XX-XX/4*4 ; CALC XX=XX MOD 4
BINR1==<BINR2==<BINR3==0>> ; INIT THE BINARY
DEFINE NUMBER (A,B,C)<
IFE XX-1,< BYTE (9) BINR1,BINR2,BINR3,<A>
BINR1==<BINR2==<BINR3==0>> >
IFE XX-2,<BINR3==A>
IFE XX-3,<BINR2==A>
IFE XX,<BINR1==A
XX==4>
XX==XX-1>
POINT ^D9,EXPTEN-1(A6),^D17
POINT ^D9,EXPTEN-1(A6),^D26
POINT ^D9,EXPTEN-1(A6),^D35
BYTAB: POINT ^D9,EXPTEN(A6),^D8
POINT ^D9,EXPTEN(A6),^D17
POINT ^D9,EXPTEN(A6),^D26
POINT ^D9,EXPTEN(A6),^D35
.TAB. EXPTEN
IFN BINR1!BINR2!BINR3,< BYTE (9) BINR1,BINR2,BINR3,0>
SUBTTL FLOATING CONSTANT MAKER
;
; BASED ON FORTRAN ROUTINE FCMML
; TO CONVERT A DOUBLE-LENGTH INTEGER CONSTANT TO A
; DOUBLE PRECISION CONSTANT FOR KA OR KI PROCESSORS
;
FCMML: PUSH SP,A7 ; SAVE A7
MOVEM A3,DECEXP ; HIGH ORDER WORD
MOVE A6,A5 ; LOW ORDER WORD
JFFO A4,FCMML0 ; DOES HIGH WORD HAVE ONES ?
EXCH A4,A6 ; NO, SWAP HIGH AND LOW
MOVEI A2,243 ; SET BIN POINT BETWEEN HALVES
JFFO A4,FCMML0+1 ; ANY ONES NOW ?
JRST FCFML ; NUMBER IS ZERO
FCMML0: MOVEI A2,306 ; MAXIMUM EXPONENT
EXCH A5,A6 ; SWAP LOW WORD AND SHIFT COUNT
ASHC A4,-1(A6) ; LEFT NORMALISE
SUBI A2,-1(A6) ; ADJUST EXPONENT ACCORDINGLY
FCMML2: MOVM A1,A3 ; GET MAGNITUDE OF DECIMAL EXP
CAILE A1,^D100 ; TOO BIG ?
JRST FCMOVR ; YES, OVERFLOW ERROR
JUMPE A1,FCMML6 ; EXP=0
FCMML3: SETZM EXPSAV
CAIG A1,^D38 ; EXPONENT GT 38
JRST FCMML4 ; NO
SUBI A1,^D38 ; REDUCE IT BY 38
MOVEM A1,EXPSAV ; SAVE THE DIFFERENCE
MOVEI A1,^D38 ; SET FOR FIRST * OR /
FCMML4: LSH A1,1 ;
SKIPGE DECEXP ; IS EXPONENT -VE ?
MOVNS A1 ; ADJUST TABLE INDEX
;
; START LONG PRECISION INTEGER MULTIPLY
;
MUL A5,TENS(A1) ; A5 := (A5*H)*H
MOVE A3,A5 ; SAVE RESULT
MOVE A5,A4 ; GET HIGH FRACTION
MUL A5,TENS+1(A1) ; AND MULTIPLY BY LOW TEN
ADD A3,A5 ; ADD HIGH PARTS OF CROSS PRODUCTS
MUL A4,TENS(A1) ; FORM PRODUCT OF THE HIGH PARTS
TLZE A3,(1B0) ; PROPAGATE A CARRY IF REQ'D
ADDI A4,1 ;
ADD A5,A3
TLZE A5,(1B0)
ADDI A4,1
TLNE A4,(1B1) ; IS RESULT NORMALISED ?
JRST .+3 ; YES
ASHC A4,1 ; NO - LEFT SHIFT ONE
SUBI A2,1 ; AND ADJUST EXPONENT
FCMML5: MOVE A6,A1 ; MOVE DECIMAL EXPONENT TO DOUBLE AC
ASH A6,-1 ; RESTORE SIGNED EXPONENT
IDIVI A6,4 ; BYTAB PACKED 4 ENTRIES PER WORD
LDB A6,BYTAB(A7) ; GET BINARY EXPONENT POWER 10
ADD A2,A6 ; ADD IT INTO FINAL BINARY EXPONENT
SUBI A2,200 ; GET RID OF EXCESS 200
SKIPE A1,EXPSAV ;
JRST FCMML3
; We get here with (A4,A5) holding a double precision
; binary fraction (normalized to bit 1 of A4), and A2
; holding the binary exponent.
FCMML6: ADDI A5,200 ; [E056] ROUND LOW ORDER WORD
TLZE A5,(1B0) ; [E056] IF NO CARRY NEEDED
AOSL A4 ; [E056] OR A4 WAS NOT 377777,,777777
JRST FCMML7 ; [E056] THEN CARRY ON
; Adding in a half (to the lowest bit position) caused carry. This can
; only happen if all bits were one, in which case all significant bits
; are now zero.
ADDI A2,1 ; [E056] INCREASE EXPONENT BY ONE, AND SET
MOVSI A4,(1B1) ; [E056] (A4,A5) TO 200000000000000000....
FCMML7: TRNE A2,777400 ; [E056] IS EXPONENT IN RANGE 000-377 ?
JRST FCMOV1 ; [E056] NO - OVERFLOW. SET TO MIN/MAX
ASHC A4,-^D8 ; [E056] YES - MAKE ROOM FOR EXPONENT
DPB A2,[POINT ^D9,A4,^D8] ; [E056] AND INSERT IT
FCFML: POP SP,A7 ; RESTORE A7
POPJ SP,
FCMOVR: MOVE A2,DECEXP
FCMOV1: SKIPGE A2
TDZA A4,A4 ; YES, ZERO ON UNDERFLOW
HRLOI A4,377777 ; NO MAX NUMBER ON OVERFLOW
MOVE A5,A4 ; SAVE PATCHED RESULT AS ANSWER
JRST FCFML
SUBTTL CONSTANT TABLE HANDLING
; CONSTANTS TABLE
;
; THE SIZE OF THE CONSTANTS TABLE ALWAYS INCREASES DURING A COMPILATION.
; NEW ENTRIES ARE PLACED AT THE END, AND ARE ALSO LINKED INTO ONE OF
; THREE CHAINS ACCORDING TO WHETHER IT IS FOR A 1-WORD CONSTANT,
; A 2-WORD CONSTANT, OR A STRING. THEREFORE EACH ENTRY HAS A LINK.
; THIS LINK IS ALWAYS IN THE RIGHT HALF OF THE 1ST WORD OF THE ENTRY.
; THE VALUE OF THE LINK IS EQUAL TO A NUMBER WHICH IF SUBTRACTED
; FROM THE ADDRESS OF THE ENTRY WILL YIELD THE ADDRESS OF THE NEXT
; ENTRY OF THE CHAIN. EACH CHAIN TERMINATES IN A FAKE ENTRY WHOSE
; 1ST DATA WORD IS THE 1ST WORD OF THE CONSTANTS TABLE. BECAUSE
; OF THIS, THE CONSTANTS TABLE CAN BE SEARCHED IN A 3-INSTRUCTION LOOP.
; THE FORMATS OF THE DIFFERENT TYPES OF ENTRIES ARE:
;
;
;
; 1-WORD CONSTANTS 2-WORD CONSTANTS STRINGS
;
; !--------------------! !--------------------! !--------------------!
; ! ! ! ! ! !
; WORD-0 ! LEFT: BACKCHAIN ! ! LEFT: BACKCHAIN 1 ! ! LEFT: BACKCHAIN 1 !
; ! RIGHT: LINK ! ! RIGHT: LINK ! ! RIGHT: LINK !
; ! ! ! ! ! !
; !--------------------! !--------------------! !--------------------!
; ! ! ! ! ! !
; WORD-1 ! VALUE ! ! LEFT: (NOT USED) ! ! LEFT: (NOT USED) !
; ! ! ! RIGHT: BACKCHAIN 2 ! ! RIGHT: BACKCHAIN 2 !
; ! ! ! ! ! !
; !--------------------! !--------------------! !--------------------!
; ! ! ! !
; WORD-2 ! 1ST WORD OF VALUE ! ! LEFT: (NOT USED) !
; ! ! ! RIGHT: # OF BYTES !
; ! ! ! !
; !--------------------! !--------------------!
; ! ! ! !
; WORD-3 ! 2ND WORD OF VALUE ! ! 1ST WORD OF STRING !
; ! ! ! !
; ! ! ! !
; !--------------------! !--------------------!
; ! !
;
; ! !
; !--------------------!
; ! !
; WORD-N+2 ! NTH WORD OF STRING !
; ! !
; ! !
; !--------------------!
; ENTER 1-WORD CONSTANT IN CONSTANTS TABLE
CON1Z: MOVE A4,A5 ; LOAD INTO A4, MOSTLY FOR DIGITS
CON1: MOVEM A4,@CONTAB ; SAVE VALUE IN BEGINNING OF CONSTANTS TABLE
SKIPA A3,LASTC1 ; LOAD LAST 1-WORD CONSTANT, AND SKIP
CON1A: SUB A3,(A3) ; STEP BACK TO PREVIOUS ENTRY
CAME A4,1(A3) ; DO VALUES MATCH?
JRST CON1A ; -NO, LOOP
MOVEI A6,1(A3) ; ADDR OF NEXT WORD
CAME A6,CONTAB ; WAS WORD REALLY IN CONSTANTS TABLE?
JRST CON1B ; YES, STOP SEARCH
MOVEI A6,2 ; NEW ENTRY IS 2 WORDS LONG
PUSHJ SP,GETCTS ; GET SOME SPACE IN CONSTANTS TABLE
MOVEI A6,(A3) ; COPY ADDR OF NEW ENTRY TO A6
SUB A6,LASTC1 ; SUBTRACT FROM LAST 1-WORD ENTRY ADDR
MOVEM A6,(A3) ; SAVE IN NEW ENTRY AS A LINK
MOVEM A4,1(A3) ; PUT VALUE IN ENTRY
MOVEM A3,LASTC1 ; SET NEW LASTC1
CON1B: SUB A3,CONTAB ; CONV FROM ABS TO REL ADDRESS
POPJ SP, ; EXIT CON1
; GET SPACE IN CONSTANTS TABLE
GETCTS: HRRZ A3,NACTE ; ADDR OF NEW ENTRY
ADDB A6,NACTE ; ADD LENGTH OF NEW ENTRY
CAML A6,CONEND ; DOES IT OVERFLOW THE TABLE?
JRST OVFL2 ; -YES, MOVE THE TABLES, EXIT GETCTS
POPJ SP, ; EXIT GETCTS
; ENTER 2-WORD CONSTANT IN CONSTANTS TABLE
CON2: MOVEM A4,@CONTAB ; SAVE VALUE IN BEGINNING OF CONSTANT TABLE
SKIPA A3,LASTC2 ; LOAD ADDR OF LAST 2-WORD CONSTANT AND SKIP
CON2A: SUB A3,(A3) ; STEP BACK TO PREVIOUS ENTRY
CAME A4,2(A3) ; DO VALUES MATCH?
JRST CON2A ; -NO, LOOP
MOVEI A6,2(A3) ; STEP TO NEXT WORD
CAMN A6,CONTAB ; WAS WORD REALLY IN CONSTANTS TABLE?
JRST CON2B ; -NO, ENTER IT
CAME A5,3(A3) ; DO 2ND WORDS MATCH?
JRST CON2A ; -NO, LOOP
JRST CON1B ; EXIT CON2
CON2B: MOVEI A6,4 ; NEW ENTRY IS 4 WORDS LONG
PUSHJ SP,GETCTS ; GET SPACE FOR IT
MOVEI A6,(A3) ; COPY ADDR TO A6
SUB A6,LASTC2 ; SUBTRACT FROM LAST 2-WORD ENTRY ADDR
MOVEM A6,(A3) ; SAVE IN NEW ENTRY AS A LINK
MOVEM A4,2(A3) ; PUT 1ST WORD IN ENTRY
MOVEM A5,3(A3) ; PUT 2ND WORD IN ENTRY
SETZM 1(A3) ; CLEAR BACK-CHAINS
MOVEM A3,LASTC2 ; SET NEW LASTC2
JRST CON1B
RELOC
MARKER: BLOCK 1 ; DECIMAL POINT MARKER
COPY: BLOCK 1 ; TEMPORARY COPY OF VALUE OF CONSTANT
EXTRA: BLOCK 1 ; NUMBER OF DIGITS IGNORED
SIGN: BLOCK 1 ; SIGN OF THE EXPONENT
FORMAT: BLOCK 1 ; [E044] SINGLE/DOUBLE PRECISION FLAG
LASTC1: BLOCK 1 ; LAST 1-WORD CONSTANT IN CONSTANT TABLE
LASTC2: BLOCK 1 ; LAST 2-WORD CONSTANT IN CONSTANT TABLE
CONEND: BLOCK 1 ; END OF CONSTANT TABLE
RELOC
; ***** A T N A C *****
;
; ADVANCE TO NEXT NON-ALPHAMERIC CHARACTER
;
BADNAC: PUSHJ SP,BADCON ; BADCON/ATNAC
JRST ATNAC
ATNAC2: CAIE A1,.DOT ; IF IT IS NOT A DOT
POPJ SP, ; THEN EXIT ATNAC
ATNAC: ILDB A1,P ; LOAD THE NEXT CHAR
AOS CC ; STEP POSITION COUNT
MOVE A2,CTABLE(A1) ; GET ITS TABLE ENTRY
JRST @TABLE9(A2) ; JUMP THROUGH TABLE 9
ATNAC ; NUMBER
ATNAC ; LETTER
TABLE9: ATNAC1 ; DELIMITER
ATNAC1 ; DELIMITER (FLAGGED)
ATNAC ; IGNORABLE CHAR
ATNAC1 ; SPACE & TAB
ATNAC3 ; NEW-LINE CHAR
ATNAC ; LOWER-CASE
ATNAC2 ; OTHER CHAR @ % $ " & . ILLEGALS
ATNAC ; SINGLE QUOTE
ATNAC3: PUSHJ SP,NCHECK ; INPUT NEXT LINE
JRST ATNAC+2 ; -END OF BUFFER IN MID LINE, CONTINUE
ATNAC1: POPJ SP, ; EXIT ATNAC
; ***** OCTAL CONSTANTS *****
OCTAL: SETZB A4,A5 ; CLEAR A4,A5
; CHARACTER READING LOOP
OCTALL: ILDB A1,P ; GET A CHAR
AOS CC ; STEP POSITION COUNT
CAIL A1,.N0 ; IF IT IS BELOW 0
CAILE A1,.N7 ; OR ABOVE 7
JRST OCTALD ; THEN CONSTANT IS FINISHED
LSHC A4,3 ; MULTIPLY BY 8
JUMPN A4,OCTILL ; TEST FOR OVERFLOW
IORI A5,-.N0(A1) ; ADD IN CURRENT DIGIT
JRST OCTALL ; LOOP
OCTALD: MOVE A2,CTABLE(A1) ; GET CHARS TABLE ENTRY
JRST @TABLE8(A2) ; JUMP THROUGH TABLE 8
OCTILL ; NUMBER
OCTOUT ; LETTER
TABLE8: OCTOUT ; DELIM
OCTOUT ; DELIM (FLAGGED)
OCTALL ; IGNORABLE
OCTALL ; SPACE & TAB
OCTNL ; NEW-LINE
OCTOUT ; LOWER CASE
OCTIL1 ; OTHER
OCTOUT ; SINGLE QUOTE
; NEW-LINE CHARACTER SCANNED
OCTNL: PUSHJ SP,NCHECK ; INPUT NEXT LINE
JRST OCTALL+2 ; -END OF BUFFER IN MID LINE, CONTINUE
; END OF OCTAL CONSTANT
OCTOUT: TLNE A5,777777 ; IF LEFT HALF NON-ZERO
JRST OCTFUL ; THEN THE CONSTANT IS A FULLWORD
SKIPA A3,A5 ; MOVE THE CONSTANT TO A3
FFALSE: MOVEI A3,0 ; 'FALSE'
; CONSTANT IS A HALFWORD
FALSE1: HRLI A3,$EXP+$B+$SIM+$DEC+$IMM; LEXEME
JRST LET9 ; EXIT LSCAN
; "TRUE" SCANNED
FTRUE: HRREI A5,-1 ; "TRUE" IS A WORD OF ALL ONES
; CONSTANT IS A FULL WORD
OCTFUL: PUSHJ SP,CON1Z ; PUT IN CONSTANT TABLE
HRLI A3,$EXP+$B+$REG+$DEC+$CT; LEXEME
JRST LET9 ; EXIT LSCAN
; INVALID FORMAT FOR OCTAL CONSTANT
OCTILL: PUSHJ SP,BADNAC ; PRINT ERROR MSG, USE ATNAC
JRST OCTOUT ; CONTINUE
OCTIL1: PUSHJ SP,BADCON ; PRINT ERROR MESSAGE
JRST OCTOUT ; CONTINUE
; ***** SYMBOL CONSTANTS *****
;
;
;
DOLLAR: JSP A6,STCHAR ; GET NEXT CHAR
MOVE A3,A1 ; THIS WILL BE THE TERMINATING CHAR
MOVEI A5,0
MOVEI A4,6 ; READ 6 CHARS
SCLOOP: JSP A6,STCHAR ; READ ANOTHER CHAR
CAIN A1,(A3) ; IF IT IS THE END CHAR
JRST SCDONE ; THEN THE CONSTANT IS DONE
LSH A5,7 ; SHIFT THE CONSTANT OVER 7
IORI A5,(A1) ; INCLUDE THE CURRENT CHAR
SOJG A4,SCLOOP ; LOOP
PUSHJ SP,BADNAC ; PRINT ERROR MSG, USE ATNAC
JRST C8A ; CONTINUE AS IF AN INTEGER
SCDONE: IBP P ; STEP TO NEXT CHAR
AOS CC
JRST C8A ; CONTINUE AS AN INTEGER
; ***** STRINGS *****
;
;
;
; SET UP
STRING: MOVEI A6,3 ; GET 3 WORDS FROM
PUSHJ SP,GETCTS ; THE CONSTANTS TABLE
MOVE A6,A3 ; COPY 1ST WORD ADDRESS TO A6
PUSH SP,LASTST ; SAVE ADDRESS OF STRING CHAIN
SUB A6,LASTST ; COMPUTE DISTANCE BACK TO LAST STRING
MOVEM A3,LASTST ; SET NEW POINTER TO LAST STRING
HRRZM A6,(A3) ; USE AS THE LINK
SETZM 1(A3) ; CLEAR THE BACK CHAIN POINTERS
ADDI A3,2 ; STEP FORWARD 2 WORDS
HRRZM A3,CCOUNT ; SET POINTER TO CHAR COUNT WORD
HRLI A3,000700 ; FORM BUFFER BYTE POINTER
MOVEM A3,STRPNT ; SET POINTER
SETZB A5,BCOUNT ; CLEAR CHARACTER AND BRACKET COUNTS
JRST STR6 ; CONTINUE
; CHARACTER READING LOOP
STR1: JSP A6,STCHAR ; READ A CHARACTER
CAIE A1,.DQUOT ; IF IT IS A "
CAIN A1,.SEMI ; IF IT IS A SEMI-COLON
JRST SPECIAL ; THEN IT IS ILLEGAL
CAIN A1,.CLEFT ; IF IT IS A ^_
JRST CLEFT ; THEN SCAN FOR A LINE-FEED
STR2: IDPB A1,STRPNT ; PUT THE CHAR IN THE CONSTANTS TABLE
ADDI A5,1 ; STEP THE CHARACTER COUNT
SOJG A4,STR1 ; LOOP
; END OF 20-CHARACTER GROUP
STR6: MOVEI A6,4 ; GET 4 MORE WORDS FROM THE
PUSHJ SP,GETCTS ; CONSTANTS TABLE
SUB A3,[ ; SET UP FOR LOOP
XWD 4,4] ; THE 4 WORDS THAT WERE JUST ACQUIRED
SETZM 4(A3) ; MUST BE CLEARED TO ZERO
AOBJN A3,.-1 ; ZERO THE NEXT WORD
MOVEI A4,^D20 ; READ THE NEXT 20 CHARACTERS
JRST STR1 ; LOOP
; A " OR ; WAS SCANNED
SPECIAL:
MOVE A3,A1 ; SAVE THE CHAR
JSP A6,GETCHR ; GET THE NEXT CHARACTER
CAIE A1,(A3) ; IF IT IS NOT A "
JRST STEND ; THEN IT WAS THE END OF THE STRING
JRST STR2 ; AND CONTINUE
; A ^_ WAS ENCOUNTERED
CLEFT: MOVEI A1,.LEFT ; "_"
DPB A1,P ; PUT A _ IN LISTING
JSP A6,STCHAR ; GET THE NEXT CHARACTER
CAIG A1,.FF
CAIGE A1,.LF ; IF LF,FF OR VT
JRST STCHAR ; THEN READ THE NEXT CHAR FOR REAL
JRST STR1 ; OTHERWISE LOOP
; END OF STRING FOUND
STEND: CAIN A3,.SEMI ; IF CHAR IS A SEMICOLON THEN
JRST STERR ; IT IS AN ERROR
HRRZ A4,STRPNT ; GET THE BUFFER STRING POINTER
ADDI A4,1 ; STEP TO NEXT AVAILABLE WORD
MOVEM A4,NACTE ; SAVE IT
MOVEI A4,0 ; LOAD A ZERO
MOVEI A3,4 ; SET COUNT
IDPB A4,STRPNT ; INCLUDE FOUR NULLS
SOJG A3,.-1
MOVE A3,CCOUNT ; GET THE CHARACTER COUNT WORD POINTER
MOVEM A5,@A3 ; SAVE THE CHARACTER COUNT
; SEARCH FOR A DUPLICATE STRING IN CONSTANTS TABLE
SUBI A3,2 ; STEP BACK TO START OF ENTRY
EDIT(040); CALCULATE LENGTH OF NULL STRINGS CORRECTLY
SOSL A5 ; [E040] MAKE DIVISION COME OUT RIGHT
IDIVI A5,5 ; COMPUTE THE NUMBER OF WORDS
MOVN A5,A5 ; NEGATIVE OF LENGTH
HRLZI A5,-2(A5) ; NEGATIVE LENGTH+1 TO LEFT HALF
HRRI A5,2 ; INDEX TO BYTES WORD
HRLI A3,A2 ; LEFT HALF = A2
MOVE A1,A3 ; COPY A3 TO A1
JRST STR4 ; JUMP INTO LOOP
; COMPARE THE 2 STRING ENTRIES
STR3: HRLI A1,A2 ; LEFT HALF = A2
MOVE A2,A5 ; SET COUNT REGISTER
MOVE A4,@A3 ; GET WORD OF ENTRY
CAME A4,@A1 ; IF MISMATCH
JRST STR4 ; THEN QUIT THIS ENTRY
AOBJN A2,.-3 ; LOOP FOR ALL OF STRING
; DUPLICATE FOUND, USE IT INSTEAD
HRRZM A3,NACTE ; RETURN THE NEW ENTRY TO AVAILABLE SPACE
POP SP,LASTST ; RESTORE THE OLD VALUE OF LASTST
MOVE A3,A1 ; -MATCH FOUND, USE IT
JRST STR5 ; CONTINUE
; LOCATE NEXT STRING IN CONSTANTS TABLE
STR4: SUB A1,(A1) ; LOCATE NEXT ENTRY ON CHAIN
MOVEI A1,(A1) ; ZERO LEFT HALF
CAMLE A1,CONTAB ; IF NOT END OF CHAIN
JRST STR3 ; THEN COMPARE THESE ENTRIES
POP SP,A1 ; DISCARD SAVED VALUE OF LASTST
; FORM LEXEME
STR5: SUB A3,CONTAB ; CONVERT TO RELATIVE ADDRESS
HRLI A3,$EXP+$S+$REG+$DEC+$CT; LEXEME
JRST LET9 ; EXIT LSCAN
; INVALID FORMAT FOR STRING CONSTANT
STERR: PUSHJ SP,BADNAC ; PRINT "INVALID CONSTANT" MESSAGE, USE ATNAC
JRST STEND+2 ; COMPLETE CONSTANT AND CONTINUE
RELOC
LASTST: BLOCK 1 ; LAST STRING IN CONSTANTS TABLE
CCOUNT: BLOCK 1 ; CHARACTER COUNT WORD POINTER
BCOUNT: BLOCK 1 ; BRACKET COUNT
STRPNT: BLOCK 1 ; BYTE POINTER INTO BUFFER
RELOC
; THERE ARE THREE ROUTINES THAT WILL READ THE NEXT CHARACTER FROM
; THE SOURCE STREAM. HOWEVER MOST OF THE TIME THE COMPILER DOES NOT
; USE ANY OF THEM BUT INSTEAD HAS THE NECESSARY CODE IN-LINE.
; THESE ROUTINES ARE DESCRIBED:
;
; "GETCHR" IS THE MOST OFTEN USED. "GETCHR" WILL PROCESS IGNORABLE
; CHARACTERS, LOWER CASE LETTERS, TABS, AND CHARACTERS THAT SIGNIFY
; THE END OF THE INPUT BUFFER. "GETCHR" WILL PRESENT ALL OTHER CHARACTERS
; UNCHANGED.
;
; "STCHAR" IS USED TO READ CHARACTERS FOR STRINGS. THE NEWLINE AND
; TAB FUNCTIONS ARE PERFORMED, BUT NEWLINE CHARACTERS ARE ALSO PRESENTED
; AS OUTPUT. IGNORABLE CHARACTERS ARE NOT PRESENTED. LOWER CASE
; LETTERS ARE NOT CONVERTED TO UPPER CASE.
;
; "GETNL" MUST BE USED TO READ CHARACTERS FROM WITHIN THE NEWLINE
; ROUTINE. "GETNL" WILL CHECK FOR END OF INPUT BUFFER, AND READ
; ANOTHER BUFFER IF THIS OCCURRS.
; ** GETCHR **
IGST: MOVEM A6,A6SAV ; SAVE THE LINK
JSP A6,GETCHR ; AND CALL GETCHR
CAIN A2,3 ; IF IT IS A SPACE OR TAB
JRST GETCHR ; THEN TRY AGAIN
JRST @A6SAV ; ELSE EXIT
GETCHR: ILDB A1,P ; GET THE NEXT CHARACTER
AOS CC ; STEP CHARACTER COUNT
MOVE A2,CTABLE(A1) ; GET THE CHARS TABLE ENTRY
XCT TABL11(A2) ; ANALYZE CHARACTER
JRST (A6) ; CHAR OK, EXIT GETCHR
EDIT(073); If chars were split across a buffer, GETCHR did not convert LC
GET.NL: PUSHJ SP,NCHECK ; [E073] DO WE NEED TO CALL NEWLINE ?
JRST GETCHR+2 ; [E073] NO - JUST TEST CHAR FOR LC, ETC.
JSP A2,SAVE ; SAVE SOME REGISTERS
PUSHJ SP,NEWLINE ; CALL NEWLINE
JFCL ; WONT RETURN HERE
JSP A2,REST ; RESTORE THE REGISTERS
JRST GETCHR+2 ; CONTINUE WITH NEW CHARACTER
GETTAB: CAIN A1,.TAB ; IF IT IS A TAB
PUSHJ SP,TAB ; THEN TAKE CARE OF IT
JRST (A6) ; NUMBER
JRST (A6) ; LETTER
TABL11: JRST (A6) ; DELIMITER
JRST (A6) ; FLAGGED DELIMITER
JRST GETCHR ; IGNORABLE CHARACTER
JRST GETTAB ; SPACE & TAB
JRST GET.NL ; [E073] ACTION FOR NEWLINE
SUBI A1,40 ; LOWER CASE
JRST (A6) ; OTHER CHARACTERS
JRST (A6) ; SINGLE QUOTE
; ** STCHAR **
STCHAR: SKIPE A2,STCFL ; IF THERE ARE ANY BUFFERED CHARACTERS
JRST STCNL1 ; THEN USE THEM
; READ THE NEXT CHARACTER
STCHR1: ILDB A1,P ; GET NEXT CHAR
AOS CC ; STEP POSITION COUNT
MOVE A2,CTABLE(A1) ; GET ITS TABLE ENTRY
JRST @TABL10(A2) ; JUMP THROUGH TABLE
STCOK ; NUMBER
STCOK ; LETTER
TABL10: STCOK ; DELIMITER
STCOK ; DELIMITER (FLAGGED)
STCHR1 ; IGNORABLE
STCTAB ; SPACE & TAB
STCNL ; NEW-LINE CHARACTER
STCOK ; LOWER CASE LETTER
STCOK ; OTHER
STCOK ; SINGLE QUOTE
; CHECK FOR A TAB
STCTAB: CAIN A1,.TAB ; IF IT IS A TAB
PUSHJ SP,TAB ; THEN FIND ITS LENGTH
; NOT A SPECIAL CHARACTER
STCOK: SETZM STCFL ; CLEAR THE FLAG
JRST (A6) ; EXIT STCHAR
; A NEW-LINE CHARACTER HAS BEEN SCANNED
STCNL: MOVEM A1,CHAR1 ; SAVE THIS CHARACTER
PUSHJ SP,NCHECK ; IF THIS IS ONLY THE END OF BUFFER
JRST STCHR1+2 ; THEN GET ANOTHER BUFFER AND CONTINUE
AOS STCFL ; SET THE FLAG +
SETZM CHAR2 ; CLEAR 2ND CHAR
SETZM FFCNT ; ZERO FORM-FEED COUNT
JSP A2,SAVE ; SAVE THE REGISTERS
PUSHJ SP,NEWLINE ; PRINT THE LAST LINE
JFCL ; CANT RETURN HERE
JSP A2,REST ; RESTORE THE REGISTERS
EXCH A1,CHAR1 ; GET THE 1ST CHAR
JRST (A6) ; EXIT STCHAR
; 1ST CALL AFTER A NL CHAR: PRESENT 2ND BUFFERED CHAR
STCNL1: JUMPL A2,STCNL2 ; JUMP IF FLAG NEGATIVE
SETOM STCFL ; SET FLAG NEGATIVE
SKIPN A1,CHAR2 ; GET THE 2ND CHAR
JRST STCHR1 ; IF NONE, READ NEXT CHAR
JRST (A6) ; EXIT STCHAR
; 2ND CALL AFTER A NL CHAR: PRESENT ANY FORM-FEEDS
STCNL2: SOSGE FFCNT ; DECREMENT FORM-FEED COUNT
JRST STCNL3 ; JUMP IF NEG (NO MORE FORM FEEDS)
MOVEI A1,.FF ; FORM FEED
JRST (A6) ; EXIT STCHAR
; A SUBSEQUENT CALL: PRESENT 3RD BUFFERED CHAR
STCNL3: SETZM STCFL ; ZERO FLAG
MOVE A1,CHAR1 ; GET THE 3RD CHARACTER
JRST STCHR1+2 ; READ NEXT CHAR
; SAVE A4, A5, A6, AND A3 ON STACK
SAVE: PUSH SP,A4 ; SAVE A4
PUSH SP,A5 ; SAVE A5
PUSH SP,A6 ; SAVE A6
PUSH SP,A3 ; SAVE A3
JRST (A2) ; EXIT SAVE
; RESTORE THEM
REST: POP SP,A3 ; RESTORE A3
POP SP,A6 ; RESTORE A6
POP SP,A5 ; RESTORE A5
POP SP,A4 ; RESTORE A4
JRST (A2) ; EXIT REST
RELOC
CHAR1: BLOCK 1 ; 1ST NL CHAR
CHAR2: BLOCK 1 ; 2ND NL CHAR
FFCNT: BLOCK 1 ; FORM-FEED COUNT
FFCNT2: BLOCK 1 ; FLAG -- NUMBER OF NL CHARS
STCFL: BLOCK 1 ; FLAG -- NUMBER OF NL CHARS
RELOC
; ********* QUOTED DELIMITER WORDS *********
; SET UP
SQUOTE: SKIPE RWS ; IF NO QUOTED RESERVED WORDS
JRST SQ4 ; THEN THIS IS AN ERROR, PROBABLY
JSP A6,IGST ; READ A CHARACTER
MOVE A2,CTABLE(A1) ; GET THE CHARS TABLE ENTRY
AOJN A2,SQILL ; ONLY A LETTER ALLOWED
MOVE A5,RESWRD-.A(A1); GET THE RESERVED WORD TABLE SUBLIST
MOVEM A5,RWSL ; SAVE IT FOR LATER
SETZB A2,SAVED ; ZERO A2 AND SAVED 1ST WORD OF NAME
HRLZI A5,-5 ; READ 5 CHARS
; CHARACTER-READING LOOP
SQ1: LSHC A1,-6 ; SHIFT CHAR INTO A2
ILDB A1,P ; READ NEXT CHAR
AOS CC ; STEP CHAR COUNT
SKIPL A4,CTABLE(A1) ; GET THE CHARS TABLE ENTRY
JRST @TABLE0(A4) ; GOTO ROUTINE IF NOT A LETTER
SQ2: AOBJN A5,SQ1 ; LOOP
; NAME LONGER THAN 1 WORD
SKIPLE SAVED ; IF 2ND TIME HERE THEN
JRST SQILL ; THIS IS AN ERROR
MOVEM A2,SAVED ; SAVE THE 1ST 5 CHARS OF THE NAME
SETZ A2, ; CLEAR F
HRLI A5,-6 ; READ 6 MORE CHARS
JRST SQ1 ; RETURN TO THE LOOP
TABLE0: SQILL ; DELIMITERS
SQILL ; FLAGGED DELIMITERS
SQ1+1 ; IGNORABLE CHARS
SQ1+1 ; SPACE & TAB
SQNL ; NEW-LINE
SQLOW ; LOWER CASE LETTER
SQILL ; OTHER
SQOK ; SINGLE QUOTE
SQ4: SKIPE FNLEVEL ; BEGINNING OF THE WORLD ?
JRST ILLEGAL ; NO - ERROR
SETZM RWS ; YES - PRETEND WE'VE HAD /QUOTE
JRST SQUOTE ; AND TRY AGAIN.
; LOWER CASE LETTER SCANNED
SQLOW: MOVEI A1,-40(A1) ; CONVERT TO UPPER CASE
JRST SQ2 ; RETURN TO LOOP
; A NEW-LINE CHARACTER WAS SCANNED
SQNL: PUSHJ SP,NCHECK ; CHECK IF END OF BUFFER
JRST SQ1+2 ; END OF BUFFER, CONTINUE AS IF NOTHING
SQILL: JSP A6,GETCHR ; READ THE NEXT CHAR
FAIL (130,HARD,IMM,IMPROPER WORD DELIMITER) ; [273]
JRST C4 ; RETURN THE NULL DELIMITER
; MATCHING QUOTE FOUND, LOOK IT UP IN RESERVED WORD TABLE
SQOK: SKIPE A1,SAVED ; FETCH 1ST WORD, SKIP IF NONE
EXCH A1,A2 ; A1=2ND WORD, A2=1ST WORD
MOVE A6,A2 ; MOVE 1ST WORD TO A6
IORI A6,(A5) ; INCLUDE THE CHAR COUNT
MOVEI A3,A1-1 ; LET A3 POINT TO THE 2ND WORD
PUSHJ SP,SQ3 ; SEARCH THE RESERVED WORD TABLE
JRST SQOK2 ; DELIMITER
; PROBABLY "TRUE" OR "FALSE" SCANNED
TLNN A3,40 ; UNLESS IT IS 'TRUE' OR 'FALSE'
JRST SQILL ; IT IS AN ERROR
;
; Edit(1006) Fix compiler crash on multiple 'true' or 'false'.
;
AOSA (SP) ; PREPARE FOR SKIP RETURN
; EXTENSION FROM LSCAN
DELIM: MOVE A3,SCDLT(A1) ; GET THE LEXEME
SQOK2: IBP P ; READ THE NEXT CHAR
AOS CC ; STEP THE CHARACTER COUNT
POPJ SP, ; EXIT
RELOC
SAVED: BLOCK 1 ; SAVED 1ST 5 CHARS OF NAME
RWS: BLOCK 1 ; RESERVED WORD TABLE POINTER
RELOC
SUBTTL ** SEARCH **
; SYMBOL TABLE ENTRY:
;
; !-----------------! WORD 1 BIT 0: DYNAMIC
; ! ! ! BITS 1-2: KIND
; WORD-0 ! BL/PL ! LINK ! BITS 3-8: TYPE
; ! ! ! BITS 9-11: STATUS
; !--------!--------! BIT 12: 1=DECLARED
; ! ! ! BITS 13-17: NUMBER OF ACTUALS
; WORD-1 ! LEXEME ! VALUE !
; ! ! !
; !-----------------! WORD 0 BIT 0: 1=EXTENDED ENTRY
; ! ! BIT 1: 1=MESSAGE GIVEN
; WORD-2 ! NAME ! BIT 2: (NOT USED)
; BITS 3-11: BLOCK LEVEL
; ! ! BITS 12-17: PROCEDURE LEVEL
; ! !
; !-----------------!
; ! !
; ! EXTENSION WORD1 !
; ! !
; !-----------------! NOTE: THE EXTENSION WORDS ARE OPTIONAL
; ! !
; ! EXTENSION WORD2 !
; ! !
; !-----------------!
;
;
;
;
;
; ***** S E A R C H *****
;
; "SEARCH" IS USED TO LOOK UP AN IDENTIFIER IN THE SYMBOL
; TABLE. "SEARCH" USES AS INPUT THE BUFFER ADDRESS CONTAINED
; IN NSYM AND OUTPUTS THE IDENTIFIER'S LEXEME INTO SYM.
;
; IF THE IDENTIFIER IS NOT FOUND IN THE SYMBOL TABLE, "SEARCH"
; WILL AUTOMATICALLY PUT IT INTO THE TABLE UNLESS THE GLOBAL
; BOOLEAN "NOENTRY" IS SET TO 1.
;
; IF THE GLOBAL BOOLEAN "DECLAR" IS SET TO 1 THEN "SEARCH"
; WILL SEARCH ONLY THE CURRENT BLOCK LEVEL PORTION OF THE
; SYMBOL TABLE. "DECLAR" INDICATES DECLARATION MODE.
SEARCH: MOVE A3,NSYM ; GET NSYM
MOVE A2,(A3) ; GET 1ST WORD OF NAME
MOVE A4,A2 ; COPY TO A4
MULI A4,RANDOM ; RANDOMIZE
ANDI A4,177 ; USE 7 BITS FOR HASH INDEX
SKIPN A1,SYMHT##(A4) ; LOCATE 1ST ENTRY IN SUBLIST
JRST NEWSYM ; -NONE, MUST BE A NEW SYMBOL
SERCH1: TRNN FL,DECLAR ; ARE WE IN DECLARATION MODE?
JRST LOOP3+1 ; -NO, GOTO 3-INST LOOP
SKIPA A5,STBB ; LOAD BLOCK POINTER, SKIP
; 4-INST LOOP FOR DECLARATION MODE
LOOP4: HRRZ A1,SYMLNK(A1) ; LOCATE NEXT SUBLIST ENTRY
CAILE A5,(A1) ; WITHIN CURRENT BLOCK?
JRST NEWSYM ; -NO, MUST BE NEW
CAME A2,SYMNAM(A1) ; 1ST WORDS SAME?
JRST LOOP4 ; -NO, LOOP
JRST SERCH2 ; -YES, CHECK REMAINDER
; 3-INST LOOP FOR NORMAL MODE
LOOP3: HRRZ A1,SYMLNK(A1) ; LOCATE NEXT SUBLIST ENTRY
CAME A2,SYMNAM(A1) ; 1ST WORDS MATCH?
JRST LOOP3 ; -NO, LOOP
TRNN A1,777777 ; LINK TO ZERO?
JRST NEWSYM ; -YES, MATCH NOT REALLY FOUND
; MATCH FOUND ON 1ST WORDS
SERCH2: SKIPN A6,-1(A3) ; GET LENGTH OF NAME
JRST SERCH3 ; -IS 1 WORD LONG, DONE
ADD A1,[ ; SET UP REGISTER FOR
XWD A6,SYMNAM] ; INDIRECT ADDRESSING
MOVE A5,@A3 ; GET A WORD FROM BUFFER
CAME A5,@A1 ; COMPARE TO WORD IN ENTRY
JRST SERCH4 ; -MISMATCH
SOJG A6,.-3 ; -MATCH. LOOP
MOVEI A1,-SYMNAM(A1) ; CORRECT ADDRESS
; -END OF NAME, SEARCH COMPLETE
; END OF NAME, SYMBOL FOUND
SERCH3: IFN FTSTATS,<
AOS REFCNT ; INCREMENT STATS COUNTER
>
HLL A1,SYMTYP(A1) ; LOAD LEXEME
MOVE SYM,A1 ; MOVE LEXEME TO SYM
TRNE FL,CREF ; ARE WE CREF'ING ?
PUSHJ SP,CREFIT ; YES - DO IT (CLOBBER AC1-6)
MOVE A1,SYM ; THE RECOVERY ROUTINES IN UTL EXPECT IT!
TLZ SYM,37 ; ZERO THE 5 BITS
TLO SYM,$ST ; MARK LEXEME A VARIABLE, SIMPLE
TRNN FL,BPAIR ; IF NOT SCANNING A BOUND PAIR, THEN
POPJ SP, ; EXIT SEARCH
LDB A4,[ ; GET THE ENTRY'S BLOCK LEVEL
POINT 9,SYMBLK(SYM),11] ; POINTER TO BLOCK LEVEL FIELD
CAME A4,BLOCKL ; IF NOT THE SAME AS CURRENT BLOCK LEVEL
POPJ SP, ; THEN OK, EXIT SEARCH
FAIL (84,HARD,NSYM,VARIABLE CANT BE USED HERE)
POPJ SP, ; EXIT SEARCH
; SYMBOL NOT IN SYMBOL TABLE
NEWSYM: TRNE FL,NOENTR ; SHOULD AN ENTRY BE MADE?
JRST NONEW ; -NO, SKIP
IFN FTSTATS,<
AOS DEFCNT ; INCREMENT STATS COUNTER.
MOVE A1,(A3) ;
ANDI A1,77 ; GET # CHARS -1
ADDM A1,IDCHRS ; ACCUMULATE FOR AVERAGE.
>
MOVE A6,-1(A3) ; GET NAME LENGTH
PUSHJ SP,GETSYM ; GET SOME SPACE IN SYMBOL TABLE
PUSHJ SP,LINKUP ; FILL THE ENTRY AND LINK IT UP
HRLI A1,$ST ; MARK LEXEME A VARIABLE, SIMPLE
MOVE SYM,A1 ; MOVE LEXEME TO SYM
TRNE FL,CREF ; ARE WE CREF'ING ?
PUSHJ SP,CREFIT ; YES - DO IT (& CLOBBER AC1-6)
SKIPA A1,SYM ; THE RECOVERY ROUTINES IN UTL EXPECT IT!
NONEW: MOVEI SYM,0 ; RETURN A NULL SYMBOL
POPJ SP, ; EXIT SEARCH
SERCH4: HRRZ A1,SYMLNK-SYMNAM(A1); LOCATE NEXT ENTRY ON SUBLIST
JRST SERCH1 ; RETURN TO LOOP
GETSYM: MOVEI A5,SYMNAM+1(A6) ; TOTAL LENGTH OF NEW ENTRY
; ACQUIRE SOME SPACE IN SYMBOL TABLE
GETSPC: HRRZ A1,NASTE ; LOCATE NEXT AVAIL ENTRY
ADDB A5,NASTE ; COMPUTE NEW NEXT ENTRY
CAMLE A5,NAFTE ; CHECK FOR TABLE OVERFLOW
JRST OVFL1 ; -OVERFLOW, MOVE THE TABLES, EXIT
POPJ SP, ; EXIT
; COMPUTE AN ENTRY'S HASH VALUE AND NAME LENGTH IN WORDS-1
HAL: MOVE A4,SYMNAM(A3) ; GET 1ST WORD OF NAME
MULI A4,RANDOM ; RANDOMIZE
ANDI A4,177 ; SAVE 7 BITS FOR HASH
MOVE A5,SYMNAM(A3) ; GET 1ST WORD OF NAME
MOVEI A5,1(A5) ; ADD 1
ANDI A5,77 ; SAVE ONLY LENGTH BYTE
IDIVI A5,6 ; DIVIDE BY 6 CHARS/WORD
MOVEI A6,(A5) ; COPY IN A6
POPJ SP, ; EXIT
; LINK NEW ENTRY INTO SYMBOL TABLE
LINKUP: MOVE A5,SYMHT##(A4) ; PUT NEW ENTRY ON TOP OF
MOVEM A1,SYMHT##(A4) ; HASH TABLE SUBLIST
MOVE A2,BLKLEV ; GET BLOCK LEVEL
LSH A2,6 ; SHIFT IT 6
IOR A2,FNLEVE ; INCLUDE FUNCTION LEVEL
HRL A5,A2 ; PUT WITH NEW LINK
MOVEM A5,SYMLNK(A1) ; SET LINK FIELD
SETZM SYMTYP(A1) ; CLEAR TYPE & VALUE
MOVEI A5,SYMNAM(A1) ; SET UP FOR
HRLI A5,A6 ; INDIRECT ADDRESSING
LNKUP1: MOVE A2,@A3 ; GET WORD FROM SOURCE
MOVEM A2,@A5 ; PUT IN SYMBOL TABLE ENTRY
SOJGE A6,LNKUP1 ; LOOP TILL DONE
POPJ SP, ; DONE
IFN FTSTATS,<
RELOC ;
IDCHRS:BLOCK 1 ; # CHARS IN IDENTIFIERS (FOR STATS)
DEFCNT:BLOCK 1 ; # OF IDENTIFIERS DEFINED.
REFCNT: BLOCK 1 ; # OF REFERENCES TO IDENTIFIERS.
RELOC ;
>
SUBTTL ** STADD & XTNDLB & TOFIX **
; ***** S T A D D *****
;
; "STADD" WILL MAKE A NEW ENTRY IN THE SYMBOL TABLE FOR A NEW
; IDENTIFIER WHOSE NAME IS THE SAME AS THE IDENTIFIER NAMED
; IN SYM. SINCE "STADD" IS USED ONLY FOR LABELS, "STADD"
; WILL AUTOMATICALLY EXTEND THIS ENTRY. THE LEXEME FOR THIS
; NEW ENTRY REPLACES THAT WHICH IS IN SYM. THE VALUE FIELD OF THE
; NEW ENTRY WILL POINT TO THE OLD ENTRY.
;
;
STADD: MOVEI A3,(SYM) ; GET ADDR OF OLD ENTRY
PUSHJ SP,HAL ; GET HASH AND LENGTH OF ENTRY
PUSHJ SP,GETSYM ; GET SOME SPACE IN SYMBOL TABLE
MOVEI A3,SYMNAM(A3) ; ADDRES OF NAME FIELD
HRLI A3,A6 ; SET UP FOR INDIRECT ADDRESSING
PUSHJ SP,LINKUP ; LINK UP THE NEW ENTRY
HRRM SYM,1(A1) ; CHAIN NEW ENTRY TO OLD ENTRY
HRRZI SYM,(A1) ; MOVE ADDR TO SYM
; ***** E X T E N D *****
;
; THE ENTRY NAMED IN SYM IS EXTENDED BY 2 WORDS.
;
;
XTNDLB: MOVEI A5,2 ; GET TWO MORE WORDS FROM
PUSHJ SP,GETSPC ; THE SYMBOL TABLE
EDIT (177); DO NOT CLOBBER SYMBOL TABLE IN ERROR CASES
HRRZ A5,SYM ;[177] IN THIS LEVEL?
CAMGE A5,STBB ;[177]
JRST XTNDL1 ;[177] NO! MUST BE ERRONEOUS PROGRAM
EDIT (207); DO NOT CLOBBER SYMBOL TABLE IN ERROR CASES
PUSH SP,A3+1 ;[207] SAVE SOME REGISTERS
PUSH SP,A3 ;[207]
LDB A3,[POINT 6,2(SYM),35] ;[207]
ADDI A3,2+5 ;[207] GET CC FIELD, ADD TWO CHARACTERS
IDIVI A3,6 ;[207] CONVERT TO WORDS
ADD A5,A3 ;[207] GET END ADDRESS
POP SP,A3 ;[207] RESTORE
POP SP,A3+1 ;[207]
CAIE A1,2(A5) ;[207] AT END?
JRST XTNDL1 ;[207] NO, SOME KIND OF AN ERROR
SETZM (A1) ; ZERO 1ST WORD OF EXTENSION
SETZM 1(A1) ; ZERO 2ND WORD OF EXTENSION
HRLZI A5,400000 ; SET EXTEND BIT ON
IORM A5,(SYM) ; PUT IN ENTRY
POPJ SP, ; EXIT EXTEND
; CONTROL ONLY GETS HERE IF WE ARE TRYING TO EXTEND THE SYMBOL TABLE
; ENTRY FOR SOMETHING GLOBAL TO US (YCCH). THIS ONLY HAPPENS IN ERRONEOUS
; PROGRAMS, SINCE ALL FORWARD DECLARATIONS MAKE EXTENDED ENTRIES. WE
; CAN GET HERE, FOR EXAMPLE, IF A PARAMETER TO A PROCEDURE IS NOT DECLARED
; AND TURNS OUT TO BE A LABEL (SOME INNER ROUTINE DOES A GOTO TO IT).
; THIS ROUTINE INVOLVES A LOT OF OVERHEAD TO MOVE THE SYMBOL TABLE UP FOR THE
; EXTENSION, BUT WILL ONLY BE INVOKED FOR PROGRAMS WHICH ALREADY HAVE A FATAL
; ERROR (NO OBJECT CODE BEING PRODUCED) ANYWAYS.
;
; THE ALTERNATIVE WOULD BE TO ALWAYS CREATE EXTENDED SYMBOL TABLE ENTRIES
; IN ALL CASES, BUT THIS MIGHT CAUSE PROGRAMS TO RUN OUT OF CORE WHICH NOW
; COMPILE CORRECTLY.
;
; STEP 1: MOVE THE SYMBOL TABLE UP AND ZERO THE EXTENSION WORDS
;
XTNDL1: PUSH SP,A2 ;[177] SAVE REGISTERS
PUSH SP,A3 ;[177]
PUSH SP,A4 ;[177]
HRLZI A5,400000 ;[177] GET EXTEND BIT
IORM A5,(SYM) ;[177] MARK AS EXTENDED
MOVEI A2,2(SYM) ;[177] GET ADDRESS, PLUS TWO OVERHEAD WORDS
LDB A5,[POINT 6,2(SYM),35] ;[177] GET CC FIELD
ADDI A5,2+5 ;[177] ADD TWO CHARACTERS (ONE IS CC FIELD)
PUSH SP,A5+1 ;[177]
IDIVI A5,6 ;[177] CONVERT TO WORDS, ROUNDING UP
POP SP,A5+1 ;[177]
ADD A2,A5 ;[177] ADD IN, A2 IS FIRST WORD WHICH WILL MOVE
MOVE A5,NASTE ;[177] A5 IS LAST WORD WHICH WILL MOVE
SUBI A5,3 ;[177] MOVE DOWN TO LAST USED WORD
;
; REVERSE BLT SYMBOL TABLE UP
; WE CAN'T DO A REAL BLT, SINCE IT WILL OVERLAP
;
XTNDL2: MOVE A1,(A5) ;[177] GET A WORD
MOVEM A1,2(A5) ;[177] STORE IT UP TWO WORDS
SOJ A5, ;[177] MOVE DOWN A WORD
CAML A5,A2 ;[177] COMPARE WITH LOWEST WORD TO MOVE
JRST XTNDL2 ;[177] LOOP DOWN TO REVERSE BLT
;
; CLEAR EXTENSION WORDS OF SYM
;
SETZM (A2) ;[177]
SETZM 1(A2) ;[177]
;
; FIX BLOCK LEVEL POINTERS IN SYMBOL TABLE
; A2: FIRST WORD (LOWEST ADDRESS) WHICH HAS MOVED
; A5: ADDRESS OF CURRENT BLOCK POINTER (STARTS AT STBB)
; A1: WORDS TO MOVE CONTENTS IN
;
MOVE A5,STBB ;[177] INITIALIZE POINTER TO CURRENT BLOCK
CAMGE A5,A2 ;[207] SHOULD STBB MOVE?
JRST XTNDL3 ;[207] NO
ADDI A5,2 ;[177] RELOCATE IT BY TWO WORDS
MOVEM A5,STBB ;[177] AND REPLACE
;
XTNDL3: MOVE A1,-1(A5) ;[177] GET POINTER
CAMGE A1,A2 ;[177] IF LESS THAN A2 (OR ZERO), DONE
JRST XTNDL4 ;[177]
ADDI A1,2 ;[177] ELSE, RELOCATE BY TWO WORDS
MOVEM A1,-1(A5) ;[177] AND REPLACE
MOVE A5,A1 ;[177] LOOP DOWN BLOCKS
JRST XTNDL3 ;[177]
;
; FIX HASH TABLE POINTERS INTO SYMBOL TABLE
; A5: AOBJN POINTER
; A2: LOWEST ADDRESS WORD WHICH MOVED
;
XTNDL4: HRRI A5,SYMHT ;[177] GET START ADDRESS OF HASH TABLE
HRLI A5,-200 ;[177] GET NEGATIVE WORD COUNT
;
XTNDL5: MOVE A1,(A5) ;[177] GET A HASH POINTER TO SYMBOL TABLE
CAMGE A1,A2 ;[177] NEED TO RELOCATE IT?
JRST XTNDL6 ;[177] NOT IF LESS THAN LOWEST WORD MOVED (OR ZERO)
ADDI A1,2 ;[177] YES, RELOCATE BY TWO WORDS
MOVEM A1,(A5) ;[177] AND REPLACE
;
; FIX LINKS IN SYMBOL TABLE FROM THIS HASH POINTER CHAIN HEAD
;
MOVE A3,A1 ;[177] ADDRESS OF LINK
;
XTNDL7: HRRZ A4,(A3) ;[177] GET LINK
CAMGE A4,A2 ;[177] NEED TO RELOCATE IT?
JRST XTNDL6 ;[177] NO
ADDI A4,2 ;[177] YES, RELOCATE IT BY TWO WORDS
HRRM A4,(A3) ;[177] AND REPLACE IT
MOVE A3,A4 ;[177] ON TO THE NEXT (PREVIOUS IN CHAIN)
JRST XTNDL7 ;[177] LOOP ENDS WHEN HIT ZERO OR BELOW MOVED AREA
;
XTNDL6: AOBJN A5,XTNDL5 ;[177] LOOP THROUGH HASH TABLE
;
POP SP,A4 ;[177] RESTORE REGISTERS
POP SP,A3 ;[177]
POP SP,A2 ;[177]
POPJ SP, ;[177] AND RETURN (WHEW!)
; ***** T O F I X *****
;
; PUT HALFWORD INTO FIX-UP TABLE
;
;
.TOFIX: MOVEI A4,1 ; LOAD A 1
XORB A4,TOFIXI ; DECIDE WHICH HALF
SOJE A4,TOFIX1 ; IF RIGHT HALF, GET ANOTHER WORD
MOVE A4,NAFTE ; LOCATE WORD -1
HRLM A2,1(A4) ; PUT HALFWORD INTO TABLE
POPJ SP, ; EXIT TOFIX
TOFIX1: SOS A4,NAFTE ; STEP TO NEXT AVAIL WORD IN FIX-UP TABLE
CAML A4,NASTE ; IF SUFFICIENT SPACE IN FIXUP TABLE
JRST .+3 ; THEN SKIP THIS PART
PUSHJ SP,OVFL1 ; THEN MOVE THE TABLES
ADDI A4,DELTA ; USE CORRECT POINTER
HRRZM A2,1(A4) ; PUT HALFWORD INTO TABLE
POPJ SP, ; EXIT TOFIX
RELOC
TOFIXI: BLOCK 1 ; "TOFIX" HALFWORD POINTER
RELOC
SUBTTL ** RUND **
; ***** R U N D *****
;
; "RUND" ADVANCES THE WINDOW BY PUTTING NSYM INTO SYM, NDEL
; INTO DEL, AND CALLING "LSCAN" TO OBTAIN NEW LEXEMES FOR
; NSYM AND NDEL. IF NSYM CONTAINED AN IDENTIFIER BUFFER
; ADDRESS, THE LEXEME IS OBTAINED BY CALLING "SEARCH".
; "RUND" WILL INSERT NULL-SYMBOLS BETWEEN CONSECUTIVE
; DELIMITERS, AND WILL INSERT NULL DELIMITERS BETWEEN CONSECUTIVE
; SYMBOLS. "RUND" WILL COMPUTE "LEXEX" AND "COMPNAME", AND
; WILL CORRECTLY BUFFER THE CHARACTER COUNTERS SO THAT THEY CAN
; BE FOUND BY THE ROUTINES THAT PRINT THE UP-ARROWS IN
; ERROR MESSAGES.
;
;
RUND:
; SHIFT WINDOW
MOVE A4,NXTSLN ; GET NSYM LINE NO
MOVEM A4,CURSLN ; AND SAVE AS CURRENT LINE NO
MOVE A4,NXTDLN ; SIMILARLY UPDATE DEL
MOVEM A4,CURDLN ; FROM NDEL LINE NO
MOVE SYM,NSYM ; MOVE NSYM TO SYM
TLNE SYM,$SYMB ; UNLESS THIS IS A CONSTANT
PUSHJ SP,SEARCH ; GET LEXEME, PUT IN SYM
MOVE DEL,NDEL ; THE LEFT
JUMPE DEL,RUND2 ; -RUND PREVIOUSLY SCANNED 2 SYMS IN A ROW
; SCAN NEXT ITEM
PUSHJ SP,LSCAN ; SCAN NEXT ITEM
RUND0: JRST RUND3 ; -A DELIM WAS SCANNED (2ND IN A ROW)
MOVE A2,CC ; LOAD POINTER FOR ERR MSG UP-ARROW
RUND1: MOVE A4,LINENO ; A SYMBOL HAS BEEN SCANNED
MOVEM A4,NXTSLN ; SO REMEMBER WHAT LINE IT WAS ON
MOVEI A4,2
XORB A4,PLIST ; ALTERNATE BETWEEN TWO POINTER BUFFERS
MOVEM A2,(A4) ; SAVE READ POINTER
MOVEM A3,NSYM ; PUT LEXEME IN NSYM
; SCAN ANOTHER ITEM
PUSHJ SP,LSCAN ; SCAN ANOTHER ITEM
RUND5: JRST RUND4 ; -A DELIM WAS SCANNED
; SCANNED 2 NON-DELIMITERS IN A ROW
MOVEM A3,DUBBLE ; -ANOTHER SYM SCANNED, SAVE FOR NEXT RUND
MOVE A2,CC ; LOAD POINTER FOR ERR MSG UP-ARROW
MOVEM A2,DOUBLP ; SAVE THE POINTER FOR LATER TOO
MOVE A4,PLIST ; POINTER BUFFER
MOVE A2,(A4) ; GET POINTER TO SYM
TLO A2,EXACT ; USE EXACT POINTER
SETZM NDEL ; PUT NULL-DELIM INTO NDEL
JRST RUND8+1 ; CONTINUE
; FETCH THE SAVED 2ND SYMBOL
RUND2: MOVE A3,DUBBLE ; RETRIEVE OLD DOUBLE SYM
MOVE A2,DOUBLP ; RETRIEVE ITS POINTER TOO
JRST RUND1 ; CONTINUE ON
; DELIMITER ONLY, NO SYMBOL
; Edit (1003) Make ALGDDT NEXT command work in this case.
RUND3: MOVE A4,LINENO ; [E1003] UPDATE NXTSLN TO BE THE
MOVEM A4,NXTSLN ; [E1003] CURRENT LINE NUMBER
MOVEM A3,NDEL ; [E1003] PUT LEXEME IN NDEL
SETZM NSYM ; PUT NULL SYMBOL IN NSYM
MOVE A4,PLIST ; POINTER BUFFER
MOVE A2,1(A4) ; GET POINTER TO SYM
TLO A2,EXACT ; USE EXACT POINTER
MOVEI A4,2 ; HERE IT IS AGAIN
XORB A4,PLIST ; ALTERNATE BETWEEN TWO POINTER BUFFERS
MOVEM A2,(A4) ; SAVE NULL-SYMBOL POINTER
JRST RUND8
; SCANNED A SYMBOL FOLLOWED BY A DELIMITER
RUND4: MOVEM A3,NDEL ; PUT LEXEME IN NDEL
MOVE A4,PLIST ; RELOAD ADDR OF CURRENT POINTER BUFFER
RUND8: MOVE A2,CC ; LOAD POINTER FOR ERR MSG UP-ARROW
MOVEM A2,1(A4) ; SAVE READ POINTER
MOVE A4,LINENO ; GET LINE NUMBER FOR NDEL
MOVEM A4,NXTDLN ; AND SAVE IT
; COMPUTE LEXEX AND COMPNAME
RUND7: TLNN SYM,$SYMB ; IF CONSTANT OR NULL SYMBOL
JRST RUND6 ; THEN SKIP THIS
LDB A4,[ ; PICK UP THE BLOCK LEVEL
POINT 9,SYMBLK(SYM),11] ; POINTER TO BLOCK LEVEL FIELD
SETCM A5,SYM ; COMPLEMENT THE LEXEME
TLNN A5,$FON ; IF FORMAL-BY-NAME
JRST IRREG ; THEN ONES COMP BL
TLNE A5,$PRO ; IF IT IS NOT A PROCEDURE
JRST REGUL ; THEN POSITIVE BL
HRRZ A5,SYM ; GET SYMBOL TABLE ADDRESS ALONE
CAIGE A5,B0END## ; IF A LIBRARY PROCEDURE
JRST REGUL ; THEN POSITIVE BL
; IF FORMAL BY NAME OR NON-LIBRARY PROCEDURE, LEXEX=-BL-1
IRREG: ADDI A4,1 ; PLUS 1
LSH A4,^D27 ; SHIFT BL+1 TO POSITION
MOVNM A4,LEXEX ; NEGATE AND MOVE TO LEXEME EXTENSION
JRST RUND6+1
; FOR ALL OTHERS, LEXEX=BL, COMPNAME=A RANDOM BIT ON
REGUL: LSH A4,^D27 ; SHIFT BL INTO POSITION
MOVEM A4,LEXEX ; STORE IN LEXEME EXTENSION
MOVE A4,SYM ; GET SYMBOL TABLE ADDRESS
ANDI A4,37 ; SAVE FIVE BITS
MOVEI A5,1 ; PUT A 1 IN ACCUMULATOR
LSH A5,(A4) ; SHIFT IT RANDOMLY
MOVEM A5,COMPNAME ; STORE IT IN COMPNAME
POPJ SP, ; EXIT RUND
; DONT COMPUTE LEXEX OR COMPNAME FOR A CONSTANT OR NULL SYMBOL
RUND6: SETZM LEXEX ; CLEAR LEXEME EXTENSION
SETZM COMPNAME ; CLEAR COMPOSIT NAME
POPJ SP, ; EXIT RUND
.SCRUND:
MOVE A4,PLIST ; ADDRESS OF SAVED POINTER
MOVE A4,(A4) ; TO NSYM. GET IT
MOVEI A5,2 ; ADDRESS OF POINTER BUFFER FOR
XOR A5,PLIST ; SYM
MOVEM A4,(A5) ; SET SYM POINTER
MOVEM A4,1(A5) ; SET DEL POINTER
JRST RUND7
RELOC
DUBBLE: BLOCK 1 ; SAVE AREA FOR CASE OF DOUBLE-SYMBOL
DOUBLP: BLOCK 1 ; SAVE AREA FOR ITS POINTER
RELOC
SUBTTL ** ERROR MESSAGE TEXT TABLE **
TTABLE:
[ASCIZ /SEMICOLON OMITTED/],,
[ASCIZ /UNDECLARED IDENTIFIER/] ; 1
[ASCIZ /INCORRECT STATEMENT/],,
[ASCIZ /INCORRECT EXPRESSION/] ; 3
[ASCIZ /PROBABLY OPERATOR OMITTED/],,
[ASCIZ /IDENTIFIER OR CONSTANT MISSING/] ; 5
[ASCIZ /INCORRECT DESIGNATIONAL EXPRESSION/],,
[ASCIZ /INCORRECT OR UNPARENTHESIZED ASSIGNMENT/] ; 7
[ASCIZ /SYMBOL NOT PERMITTED HERE/],,
[ASCIZ /AMBIGUOUS USE OF COLON/] ; 9
[ASCIZ /SEMICOLON PROBABLY SUPERFLUOUS/],,
[ASCIZ /ONLY LETTER STRING ALLOWED/] ; 11
[ASCIZ /THIS DELIMITER IS NOT PERMITTED BEFORE 'DO'/],,
[ASCIZ /'WHILE' STATEMENT IS NOT ALLOWED BETWEEN 'THEN' AND 'ELSE'/]
; 13
[ASCIZ /'THEN' MUST NOT BE FOLLOWED BY 'IF'/],,
[ASCIZ /'THEN' STATEMENT NOT FOUND/] ; 15
[ASCIZ /DECLARATIONS MUST BE TERMINATED BY SEMICOLON/],,
[ASCIZ /THIS IS NOT ALLOWED AFTER END/] ; 17
[ASCIZ /CANNOT BE USED AS ARGUMENT/],,
[ASCIZ /ARGUMENT TOO LARGE/] ; 19
[ASCIZ /PROBABLY 'END' OMITTED/],,
[ASCIZ /COMPLEX ARITHMETIC NOT IMPLEMENTED/] ; 21
[ASCIZ /DECLARATOR 'LONG' MUST BE FOLLOWED BY 'REAL'/],,
[ASCIZ /NOT PERMITTED AS DECLARATOR/] ; 23
[ASCIZ /NOT PERMITTED AS SPECIFIER/],,
[ASCIZ /INCORRECT DECLARATION OR SPECIFICATION/] ; 25
[ASCIZ /NO DECLARATION SHOULD FOLLOW PROCEDURE OR SWITCH DECLARATION/],,
[ASCIZ /IMPROPER ARRAY DELARATION OR SPECIFICATION/] ; 27
[ASCIZ /DELIMITER MUST NOT BE DECLARED OR SPECIFIED/],,
[ASCIZ /PROBABLY LIST ELEMENT MISSING/] ; 29
[ASCIZ /IMPROPER DECLARATION/],,
[ASCIZ /VALUE WAS ALREADY SPECIFIED/] ; 31
[ASCIZ /IMPROPER TYPE OF FORMAL IN VALUELIST/],,
[ASCIZ /NON-FORMALS MUST NOT BE SPECIFIED/] ; 33
[ASCIZ /BOUND PAIR NOT FOUND/],,
[ASCIZ /INCORRECT BOUND PAIR/] ; 35
[ASCIZ /PROBABLY RIGHT BRACKET OMITTED/],,
[ASCIZ /TYPE DOES NOT MATCH FORWARD DECLARATION/] ; 37
[ASCIZ /:= MISSING IN SWITCH DECLARATION/],,
[ASCIZ /PROCEDURE NESTING TOO DEEP/] ; 39
[ASCIZ /NOT A SIMPLE IDENTIFIER IN FORMAL LIST/],,
[ASCIZ /FORMAL LIST NOT PROPERLY TERMINATED/] ; 41
[ASCIZ /PROBABLY SEMICOLON MISSING IN PROCEDURE HEADING/],,
[ASCIZ /NOT ALL FORMALS HAVE BEEN SPECIFIED/] ; 43
[ASCIZ /INCORRECTLY STRUCTURED FORMAL LIST/],,
[ASCIZ /'UNTIL' EXPRESSION NOT FOUND/] ; 45
[ASCIZ /BYTE NOT PERMITTED AS CONTROL VARIABLE/],,
[ASCIZ /ASSIGNMENT DELIMITER NOT FOUND/] ; 47
[ASCIZ /DELIMITER 'DO' NOT FOUND/],,
[ASCIZ /ASSIGNMENT HAS NON-MATCHING TYPES/] ; 49
[ASCIZ /DELIMITER OMITTED/],,
[ASCIZ /CANNOT BE USED AS UNARY OPERATOR/] ; 51
[ASCIZ /CANNOT BE USED AS BINARY OPERATOR/],,
[ASCIZ /'THEN' EXPRESSION NOT FOUND/] ; 53
[ASCIZ /CONDITIONAL EXPRESSION MUST HAVE 'ELSE' PART/],,
[ASCIZ /CONDITIONAL EXPRESSION MUST BE PARENTHESIZED/] ; 55
[ASCIZ /IMPROPER SEQUENCE OF DELIMITERS/],,
[ASCIZ /WRONG NUMBER OF DIMENSIONS/] ; 57
[ASCIZ /TOO MANY PARAMETERS FOR STANDARD FUNCTION/],,
[ASCIZ /NON-TYPE PROCEDURE IN EXPRESSION/] ; 59
[ASCIZ /MATCHING CLOSE PARENTHESIS NOT FOUND/],,
[ASCIZ /INCORRECT NUMBER OF ACTUAL PARAMETERS/] ; 61
[ASCIZ /NO DECLARATION IN THIS BLOCK FOR FORWARD/],,
[ASCIZ //] ; [266] 63
[ASCIZ /FORWARD DECLARATION WAS REQUIRED/],,
[ASCIZ /TYPES DO NOT MATCH/] ; 65
[ASCIZ /STACK ADDRESS OVERFLOW/],,
[ASCIZ /NON-INTEGER OPERAND FOR OPERATOR 'DIV' OR 'REM'/] ; 67
[ASCIZ /COMPLEX ARITHMETIC NOT IMPLEMENTED/],,
[ASCIZ /NON-ARITHMETIC OPERAND FOR ARITHMETIC OPERATOR/] ; 69
[ASCIZ /NON-ARITHMETIC OPERAND FOR RELATIONAL OPERATOR/],,
[ASCIZ /NON-BOOLEAN OPERAND FOR BOOLEAN OPERATOR/] ; 71
[ASCIZ /DELIMITER 'NOT' REQUIRES BOOLEAN OPERAND/],,
[ASCIZ /UNARY + AND - REQUIRE ARITHMETIC OPERAND/] ; 73
[ASCIZ /OVERFLOW WHILE COMBINING CONSTANTS/],,
[ASCIZ /OVERFLOW IN LONG REAL OPERATION ON CONSTANTS/] ; 75
[ASCIZ /OVERFLOW OR UNDEFINED RESULT FOR "CONSTANT ^ CONSTANT"/],,
[ASCIZ /PARAMETER FOR STANDARD FUNCTION MUST BE ARITHMETIC/] ; 77
[ASCIZ /STANDARD FUNCTION "INT" REQUIRES BOOLEAN PARAMETER/],,
[ASCIZ /STANDARD FUNCTION "BOOL" REQUIRES INTEGER OPERAND/] ; 79
[ASCIZ /PARAMETER MUST BE OF ARITHMETIC TYPE/],,
[ASCIZ /FOR STATEMENT NOT ALLOWED BETWEEN 'THEN' AND 'ELSE'/] ; 81
[ASCIZ /SWITCH IDENTIFIER NOT ALLOWED HERE/],,
[ASCIZ /EXPRESSION TOO LONG/] ; 83
[ASCIZ /IDENTIFIER DECLARED IN THIS BLOCK NOT PERMITTED HERE/],,
[ASCIZ /INCORRECT FILE OR BLOCK STRUCTURE/] ; 85
[ASCIZ /INCORRECT BLOCK STRUCTURE: TOO MANY ENDS/],,
[ASCIZ /PROCEDURE INCORRECTLY TERMINATED/] ; 87
[ASCIZ /INCORRECT FILE STRUCTURE/],,
[ASCIZ /EMPTY SOURCE FILE/] ; 89
[ASCIZ /INVALID CONSTANT/],,
[ASCIZ /IDENTIFIER EXCEEDS 64 CHARACTERS/] ; 91
[ASCIZ /RESERVED WORD DELIMITER NOT ALLOWED HERE/],,
[ASCIZ /CHARACTER NOT LEGAL IN ALGOL/] ; [273] 93
[ASCIZ /EXPONENT TOO SMALL/],,
[ASCIZ /EXPONENT TOO LARGE/] ; 95
[ASCIZ /DECLARATION FOLLOWS STATEMENT/],,
[ASCIZ /IMPROPER USE OF "."/] ; 97
[ASCIZ /INTEGER CONSTANT TOO BIG: CONVERTED TO TYPE REAL/],,
[ASCIZ /DID NOT FIND 'TO' IN 'GOTO' STATEMENT/] ; [273] 99
[ASCIZ /N EXPRESSION/],,
[ASCIZ / STATEMENT/] ; 101
[ASCIZ / BOOLEAN EXPRESSION/],,
[ASCIZ / DESIGNATIONAL EXPRESSION/] ; 103
[ASCIZ / LABEL IDENTIFIER/],,
[ASCIZ / LABEL IDENTIFIER/] ; 105
[ASCIZ /N UNDECLARED (UNSPECIFIED) IDENTIFIER/],,
[ASCIZ /N ARITHMETIC EXPRESSION/] ; 107
[ASCIZ / NEW IDENTIFIER/],,
[ASCIZ /N ARITHMETIC EXPRESSION/] ; 109
[ASCIZ /N ARITHMETIC EXPRESSION/],,
[ASCIZ /N ARITHMETIC EXPRESSION/] ; 111
[ASCIZ /N ARITHMETIC VARIABLE/],,
[ASCIZ / VARIABLE/] ; 113
[ASCIZ / STRING EXPRESSION/],,
[ASCIZ / BOOLEAN OR ARITHMETIC EXPRESSION/] ; 115
[ASCIZ / BOOLEAN OR ARITHMETIC EXPRESSION/],,
[ASCIZ /N ARRAY IDENTIFIER/] ; 117
[ASCIZ /N ARITHMETIC EXPRESSION/],,
[ASCIZ / SWITCH IDENTIFIER/] ; 119
[ASCIZ /N ACTUAL PARAMETER/],,
[ASCIZ / PROCEDURE IDENTIFIER/] ; 121
[ASCIZ /N ARITHMETIC EXPRESSION/],,
[ASCIZ /N ARITHMETIC EXPRESSION/] ; 123
[ASCIZ / STRING VARIABLE/],,
[ASCIZ / BOOLEAN OR ARITHMETIC EXPRESSION/] ; 125
[ASCIZ /NO VALUE ASSIGNED TO TYPED PROCEDURE, OR PROCEDURE NAME CONFLICTS WITH ANOTHER DEFINITION/],,
[ASCIZ/ ASSIGNMENT TO PROCEDURE OUTSIDE ITS BODY/] ; [306] 127
[ASCIZ /INTEGER TOO LARGE - 34 359 738 367 SUPPLIED/],,
[ASCIZ /ILLEGAL USE OF RESERVED WORD/] ; 129
[ASCIZ /IMPROPER WORD DELIMITER/],,
[0] ; [273] 131
; "BMOVE" WITH "RLIST" AS ITS PARAMETER IS USED TO INITIALIZE
; THE READ MODULE'S LOW-SEGMENT FROM THE HIGH-SEGMENT.
RLIST:
XWD FAILX,12
PUSH SP,A1
PUSH SP,A2
MOVE A1,@-2(SP)
MOVEM A1,FAILX1
PUSHJ SP,.FAIL
0
POP SP,A2
POP SP,A1
; GENERAL SKIP RETURN
SKRET: AOS (SP)
POPJ SP,
XWD .STOVE+1,1
JRST OVFL5
XWD .JBAPR,1
JRST OVFL4
XWD OLIST,3
14
0
XWD BHEAD1,0
XWD LLIST,3
0
0
XWD BHEAD2,0
XWD SLIST,3
0
0
XWD 0,BHEAD3
XWD CSLIST,3
1
SIXBIT /TTY/
XWD STHEAD,CSHEAD
XWD SWERR,4
ASCIZ/ switch: /
XWD CREFRF,2
BYTE(7)1,0,0,0,0
0
XWD TRACLN,2
DEC 100
EXP DELTA1
0 ; TERMINATE LIST
SUBTTL OUTPUT MODULE
; THIS MODULE CONTAINS THE FOLLOWING ROUTINES
;
;
; .MABS (MOVE ABSOLUTE) WRITE OUT 1 WORD
; A1=VALUE
; NO RELOCATION
;
; .MREL (MOVE RELOCATED) WRITE OUT 1 WORD
; A1=VALUE
; RELOCATE RIGHT HALF
;
; .RAFIX (REL ADDRESS FIXUP) WRITE OUT 1 TYPE-10 FIXUP
; A1=CHAIN
; PROGRAM COUNTER=VALUE
; RELOCATE BOTH HALVES
;
; .ADRFIX (ADDRESS FIXUP) WRITE OUT 1 TYPE-10 FIXUP
; A1=CHAIN
; A2=VALUE
; RELOCATE BOTH HALVES
;
; .ABSFIX (ABSOLUTE FIXUP) WRITE OUT 1 TYPE-10 FIXUP
; A1=CHAIN
; A2=VALUE
; RELOCATE LEFT HALF (CHAIN)
;
; .FIX50 (RADIX50 FIXUP) WRITE OUT 1 TYPE-2 FIXUP
; A1=LOCATION
; A2=RADIX50 NAME
; RELOCATE LOCATION
;
; .EXTFIX (EXTERNAL FIXUP) WRITE OUT ALL TYPE-2 FIXUPS FOR 1 EXTERNAL
; PROCEDURE
; A5=ADDRESS OF SYMBOL TABLE ENTRY
;
; .ADDFIX (ADDITIVE FIXUP) WRITE OUT 1 TYPE-2 ADDITIVE FIXUP
; A1=LOCATION (RELOCATE)
; RADIX50 NAME IS ALWAYS %ALGDR
;
; .TYPE0 (BLOCK TYPE-0 ENTRY) WRITE OUT 1 TYPE-0 IDENTIFIER ENTRY
; WRITE1 OPEN REL-FILE
;
; WRITE0 CALLED IN PLACE OF WRITE1 WHEN THERE IS NO REL-FILE
;
; .PROGD PREPARE TO COMPILE A MAIN PROGRAM
;
; .PROCD PREPARE TO COMPILE AN EXTERNAL PROCEDURE
;
; BMOVE MOVE BLOCKS OF DATA ACCORDING TO A LIST
; A1=LIST
;
; .ZZEND MOVE CONSTANTS TABLE TO REL-FILE,
; MOVE FIXUP TABLE TO REL-FILE,
; MOVE LIBRARY FIXUPS TO REL-FILE,
; PUT AN END BLOCK IN REL-FILE,
; CLOSE REL-FILE.
;
; DUMP REL-FILE DUMP PROGRAM
;
; NAME EXTRACT FROM SYMBOL TABLE ENTRY THE IDENTIFIER NAME
; IN ASCIZ FORMAT
INTERN .PROGD
INTERN .PROCD
INTERN .RAFIX ; RELOCATABLE FIX-UP ROUTINE
INTERN .ADRFIX ; ADDRESS FIX-UP ROUTINE
INTERN .ABSFIX ; ABSOLUTE FIX-UP ROUTINE
INTERN .ADDFIX ; ADDITIVE FIX-UP ROUTINE
INTERN .EXTFIX ; EXTERNAL NAME FIX-UP ROUTINE
INTERN .FIX50 ; EXTERNAL NAME FIX-UP ROUTINE (RADIX50 INPUT)
INTERN .MREL ; MOVE RELOCATABLE
INTERN .MABS ; MOVE ABSOLUTE
INTERN .ZZEND ; WRITE MODULE PROGRAM END ROUTINE
EXTEN==400000 ; EXTENDED ENTRY FLAG BIT
EXISTS==400000 ; 1 = LISTING FILE EXISTS
COMPLETE==002000 ; 1 = LISTING FILE COMPLETE AND CLOSED
IND==0
ADR==1
PTR==2
BLK==3
EN==4
TYP==5
LEN==6 ;
; INITIALIZE WRITE MODULE, CREATE REL-FILE, PREPARE TO RECEIVE OUTPUT.
WRITE1: OPEN 1,OLIST ; OPEN THE OBJECT FILE
JRST DSERR5 ; CANNOT OPEN DEVICE
OUTBUF 1,@OLIST+7 ; GET A BUFFER RING
ENTER 1,OFILE ; ENTER THE NEW FILE
JRST DSERR6 ; -CANNOT CREATE NEW FILE
PUSHJ SP,WRITE ; INITIALIZE BUFFERS
OUT 1,0 ; GET 1ST OUTPUT BUFFER
JRST .+2 ; -OK
JRST DSERR7 ; ERROR
MOVEI A1,1 ; A 1 MEANS TO OUTPUT OBJECT CODE
MOVEM A1,WFLAG ; SET WRITE MODULE FLAG
JRST SKRET ; EXIT WRITE1
; INITIALIZE WRITE MODULE, DON'T CREATE REL-FILE, PREPARE TO
; RECEIVE OUTPUT.
WRITE0: MOVEI A1,203 ; ALLOCATE A DUMMY BUFFER WHOSE LENGTH
PUSHJ SP,ALLOCATE ; IS 203
ADDI A1,1 ; STEP TO LINK WORD
HRRZM A1,BHEAD1 ; SET BUFFER HEADER
HRLI A1,202 ; BUFFER LENGTH
MOVEM A1,(A1) ; PUT BUFFER RING LINK IN BUFFER
PUSHJ SP,WRITE ; INITIALIZE BUFFERS
SETZM WFLAG ; MARK: NO REL FILE
POPJ SP, ; EXIT WRITE0
; "WRITE" IS CALLED BY "WRITE0" AND "WRITE1". "WRITE" ALLOCATES
; SPACE FOR THE ISOLATED BUFFERS, AND SETS UP ALL OF THE STATUS BLOCKS.
; SET STATUS BLOCKS FROM HIGH SEGMENT
WRITE: HRLZI A1,A3 ; ADDRESS OF A3
MOVEM A1,T0ADR ; INIT T0ADR
MOVEM A1,T1ADR ; INIT T1ADR
MOVEM A1,T2ADR ; INIT T2ADR
MOVEM A1,T10ADR ; INIT T10ADR
HRLZI A1,440200 ; LEFT HALF OF BYTE POINTERS
MOVEM A1,T1PTR ; INIT T1PTR
MOVEM A1,T10PTR ; INIT T10PTR
HRLZI A1,440400 ; LEFT HALF OF TYPE-2 BYTE POINTER
MOVEM A1,T2PTR ; INIT T2PTR
MOVEI A1,2 ; 2
MOVEM A1,T2TYP ; INIT T2TYP
MOVEI A1,1 ; 1
MOVEM A1,T1TYP ; INIT T1TYP
MOVEI A1,NEWT0 ;
MOVEM A1,T0TYP ;
MOVE A2,BHEAD1 ; GET BUFFER ADDRESS
HLRZ A2,(A2) ; GET LENGTH OF BUFFER
SUBI A2,1 ; TRUE USABLE LENGTH
MOVEM A2,BUFLEN ; SAVE THE OUTPUT BUFFER LENGTH
; ACQUIRE SPACE FOR TYPE-2 BUFFER, INITIALIZE ITS STATUS BLOCK
MOVEI A1,600 ; BUFFERS MIGHT USE UP TO #600 WORDS
PUSHJ SP,ALLOCATE ; GET SPACE FOR BUFFERS
EXCH A1,A2 ; SWAP REGS, IE A1=BASE ADDR, A2=LENGTH
MOVEI A3,(A2) ; BUFFER FOR TYPE-2 BLOCKS
ADDI A2,-1(A1) ; STEP POINTER
MOVEM A2,T2END ; MARK END OF TYPE-2 BUFFER
MOVEI A4,TYPE2 ; PARAM FOR INITB
MOVEI A5,^D19 ; LENGTH OF MOST SUB-BLOCKS
MOVEM A5,T2LEN ;
PUSHJ SP,INITB ; INITIALIZE TYPE-2 STATUS BLOCK
; ACQUIRE SPACE FOR TYPE-10 BUFFER, INITIALIZE ITS STATUS BLOCK
MOVEI A3,1(A2) ; BUFFER FOR TYPE-10 BLOCKS
ADD A2,A1 ; STEP POINTER
MOVEM A2,T10END ; MARK END OF TYPE-10 BUFFER
MOVEI A4,TYPE10 ; PARAM FOR INITB
MOVEM A5,T10LEN ;
PUSHJ SP,INITB ; INITIALIZE TYPE-10 STATUS BLOCK
; ACQUIRE SPACE FOR TYPE-0 BUFFER, INITIALIZE ITS STATUS BLOCK
MOVEI A3,1(A2) ; BUFFER FOR TYPE-0 BLOCKS
ADD A2,A1 ; STEP POINTER
MOVEM A2,T0END ; MARK END OF TYPE-0 BUFFER
MOVEI A4,TYPE0 ; PARAM FOR INITB
MOVEI A6,^D127 ; LONG 'SUB'-BLOCK FOR PSEUDO-TYPE0
MOVEM A6,T0LEN ;
PUSHJ SP,INITB ; INITIALIZE TYPE-0 STATUS BLOCK
ADDI A2,1 ; NEW BEGINNING OF FREE SPACE
HRRM A2,.JBFF ; SET JOBFF
; INITIALIZE TYPE-1 STATUS BLOCK
HRRZ A3,BHEAD1 ; GET ADDRESS OF PRIME BUFFER
ADDI A3,1 ; STEP TO NEXT WORD
HRRM A3,T1ADR ; SET T1ADR
ADD A3,A1 ; STEP TO END OF BUFFER
MOVEM A3,T1END ; SET END OF BUFFER
MOVEM A5,T1LEN ;
POPJ SP, ; EXIT WRITE
; CANT OPEN OBJECT FILE DEVICE
DSERR5: MOVE A1,[ ; LOAD A POINTER TO
POINT 6,OLIST+1] ; THE FILE NAME
JRST DSERR0 ; PRINT THE MESSAGE, TERMINATE
; CANNOT CREATE REL-FILE
DSERR6: OUTSTR UNOBJ ; PRINT MSG
JRST TERMIN ; TERMINATE COMPILATION
UNOBJ: ASCIZ /?CANNOT CREATE OBJECT FILE
/
; ERROR ON "OUT" UUO
DSERR7: OUTSTR UNEXP ; PRINT ERROR MSG
JRST TERMIN ; TERMINATE
UNEXP: ASCIZ /OUTPUT ERROR
/
; "BMOVE" WILL MOVE BLOCKS OF DATA AROUND IN CORE ACCORDING TO A
; CONTROL LIST WHOSE ADDRESS IS IN A1. THE FIRST WORD OF THE CONTROL
; LIST IS A CONTROL WORD WHOSE LEFT HALF CONTAINS THE LOCATION
; WHERE THE DATA WILL GO, AND WHOSE RIGHT HALF CONTAINS THE LENGTH OF
; THE BLOCK OF DATA IN WORDS. THE CONTROL WORD IS FOLLOWED IMMEDIATELY
; BY THE BLOCK OF DATA THAT IS TO BE MOVED. THE BLOCK OF DATA IS
; FOLLOWED IMMEDIATELY BY ANOTHER CONTROL WORD AND ANOTHER BLOCK TO
; BE MOVED, ETC. THE CONTROL LIST IS TERMINATED BY AN ALL ZERO
; CONTROL WORD.
BMOVE: SKIPN A2,(A1) ; IF NO MORE BLOCKS THEN
POPJ SP, ; EXIT BMOVE
MOVS A3,A2 ; "TO" ADDRESS TO A3
HRLI A3,1(A1) ; "FROM" ADDRESS
MOVS A4,A2 ; "TO" ADDRESS PLUS
ADD A4,(A1) ; LENGTH OF BLOCK
ADDI A1,1(A2) ; "END" ADDRESS PLUS 1
BLT A3,-1(A4) ; MOVE THE DATA
JRST BMOVE ; PROCESS ANOTHER BLOCK
;
; These are the patterns for the LINK blocks
; output at the beginning of the program. They are
; BLT'd to the low segment before data is written
; in them.
;
XWD LB,WRITE4-WRITE3+1
WRITE3: XWD 0,WRITE4-WRITE3-1
XWD 4,0 ; TYPE-4 BLOCK OF LENGTH 0
XWD 0,0 ; RELOCATION BITS
XWD 6,2 ; TYPE-6 BLOCK OF LENGTH 2
XWD 0,0 ; RELOCATION BITS
PRNAME: RADIX50 0,ALGOBJ ; PROGRAM NAME
XWD 3,1 ; ALGOL, 1 FLAGS MAIN PROGRAM
EDIT(140); Use compiler Version number as program version number
XWD 1,2 ; [E140] Type-1 block of length 2
XWD 0,0 ; [E140] No relocation bits
PRGVER: EXP .JBVER ; [E140] Version word (in JOBDAT)
EXP 0 ; [E140] Fill value in later
XWD 2,20 ; TYPE-2 BLOCK OF LENGTH 16
XWD 040000,0 ; RELOCATION BITS
RADIX50 04,%BEGIN ; PROGRAM ENTRY POINT
XWD 0,0 ; VALUE
RADIX50 60,%ALGDA ; %ALGDA
XWD 0,0 ; NO VALUE
DIR: RADIX50 60,%ALGDR ; %ALGDR
XWD 0,0 ; NO USAGE
HEAP: RADIX50 04,%HEAP ; %HEAP DEFINITION
XWD 0,0 ; VALUE
FLAGS: RADIX50 04,%FLAGS
XWD 0,0 ; RUN-TIME FLAGS
TRACE: RADIX50 04,%TRACE ;
XWD 0,0
VERLHS: RADIX50 04,%JBVER
EXP 0 ; LEFT HALF OF VERSION #
VERRHS: RADIX50 04,%JBEDT
EXP 0 ;
WRITE4: 0
0
MODHDR==SIXBIT/MOD/
WRITE7: XWD LB+WRITE4-WRITE3,14
MODBL: XWD NEWT0,12 ;
EXP MODHDR+12 ; ACTUAL BLOCK HEADER
BLOCK 11
0
0
; ".PROGD" MOVES THE TYPE-4,-6, -2 AND TYPE0 BLOCKS
; THAT START EACH ALGOL MAIN PROGRAM
; TO THE PRIME BUFFER.
.PROGD: MOVEI A1,WRITE3-1 ; PARAM FOR INIT
PUSHJ SP,BMOVE ; MOVE CODE TO BUFFER
TRNE FL,TRPOFF ; UNLESS PRODUCTION
JRST PD1
MOVEI A1,WRITE7 ; TYPE-0 MODULE HEADER
PUSHJ SP,BMOVE ; TO LOW SEGMENT
MOVEI A1,13 ; EXTRA LENGTH
ADDM A1,LB
PD1: HRLZI A1,<<2B23>+3> ; KI-10 ALGOL INDICATOR
HLLM A1,<LB+PRNAME+1-WRITE3>
HRRZ A1,T1ADR ; BEGINNING OF AVAILABLE SPACE IN BUFFER
ADDI A1,1 ; TRUE BEGINNING
MOVEI A5,(A1) ; SAVE FOR LATER IN A5
HRLM A1,LB ; SET DESTINATION PART OF CONTROL WORD
ADDI A1,WRITE4-WRITE3-2
; END OF WHERE THIS BLOCK WILL BE
TRNN FL,TRPOFF ; ADJUST IF NOT PRODUCTION [54]
ADDI A1,13 ; TO INCLUDE MODULE HEADER [54]
CAMG A1,T1END ; IF ENOUGH SPACE IN BUFFER
JRST .+3 ; THEN USE THIS BUFFER
PUSHJ SP,GETBUF ; ELSE GET ANOTHER OUTPUT BUFFER
JRST PD1 ; AND TRY AGAIN
HRRM A1,T1ADR ; SET NEW T1ADR
MOVEI A1,LB ; ADDRESS OF NEW BMOVE LIST
PUSHJ SP,BMOVE ; MOVE INTO FINAL POSITION
MOVE A2,TRACLN ; LENGTH OF TRACE-BUFFER (/T SW)
MOVEM A2,TRACE-WRITE3(A5) ;
MOVE A2,DYNOWN ; LENGTH OF HEAP (/HEAP SWITCH)
CAIGE A2,DELTA1 ; ENSURE IT'S AT LEAST...
MOVEI A2,DELTA1 ; ...THE MINIMUM
MOVEM A2,HEAP-WRITE3(A5)
SETZM A2,FLAGS-WRITE3(A5)
SKIPN A1,OFILE ; GET OBJECT FILE NAME
SKIPA A2,PRNAME ; NONE - USE DEFAULT
PUSHJ SP,RADX50 ; CONVERT TO RADIX50
MOVEM A2,PRNAME-WRITE3-1(A5) ; PUT IN BUFFER
MOVE A1,.JBVER ; LINK-PLANTED VERSION NUMBER
MOVEM A1,PRGVER-WRITE3(A5) ; Save as program version number
HLRZM A1,VERLHS-WRITE3(A5)
HRRZM A1,VERRHS-WRITE3(A5)
TRNE FL,TRPOFF ; ONLY IF REQUIRED
JRST WRITE2
TLZ A2,740000 ; CLEAR CODE BITS
IDIVI A2,50 ; RIGHT-
JUMPE A3,.-1 ; JUSTIFY
IMULI A2,50 ; RADIX-50
ADDI A2,(A3) ; NAME.
MOVEM A2,MODBL-1-WRITE3(A5) ; PUT MODULE TITLE IN BLOCK
MOVE A2,SLIST+1 ; SOURCE DEVICE
MOVEM A2,MODBL+2-WRITE3(A5) ;
MOVE A2,LINENO ; CURRENT LINE NUMBER
MOVEM A2,MODBL-2-WRITE3(A5) ;
HRLI A5,SFILE ; FILE INFO
MOVEI A1,MODBL-WRITE3+6(A5) ; END OF FILE INFO
ADDI A5,MODBL+3-WRITE3
BLT A5,(A1) ; ALL TO TYPE0-BLOCK
JRST WRITE2 ; CONTINUE
;------------------------------------------------
XWD LB,WRITE6-WRITE5+1
WRITE5: XWD 0,WRITE6-WRITE5-1
XWD 4,1 ; TYPE-4 BLOCK OF LENGTH 1
XWD 0,0 ; RELOCATION BITS
PNAME1: XWD 0,0 ; PROCEDURE NAME
XWD 6,2 ; TYPE-6 BLOCK OF LENGTH 2
XWD 0,0 ; RELOCATION BITS
PNAME2: XWD 0,0 ; PROCEDURE NAME
XWD 3,0 ; ALGOL
XWD 2,2 ; TYPE-2 BLOCK OF LENGTH 2
XWD 040000,0 ; RELOCATION BITS
PNAME3: XWD 0,0 ; PROCEDURE ENTRY POINT NAME
PVALUE: XWD 0,0 ; VALUE
WRITE6: 0
0
WRITE8: XWD LB+WRITE6-WRITE5,14
EMODBL: XWD NEWT0,12 ; SUBSEQUENT MODULES
EXP MODHDR+12 ;
BLOCK 11 ;
0
0
; ".PROCD" MOVES TO THE PRIME BUFFER THE TYPE-4,-6, AND -2 BLOCKS
; THAT START EACH ALGOL EXTERNAL PROCEDURE.
.PROCD: MOVEI A1,WRITE5-1 ; PARAM FOR INIT
PUSHJ SP,BMOVE ; MOVE CODE TO BUFFER
TRNE FL,TRPOFF ; UNLESS PRODUCTION
JRST PD2
MOVEI A1,WRITE8 ; LENGTH/DESTN FOR BMOVE
PUSHJ SP,BMOVE
MOVEI A1,13 ; EXTRA LENGTH
ADDM A1,LB
PD2: HRLZI A1,<<2B23>+3> ; KI-10 ALGOL INDICATOR
MOVEM A1,<LB+PNAME2+1-WRITE5>
HRRZ A1,T1ADR ; BEGINNING OF AVAILABLE SPACE IN BUFFER
ADDI A1,1 ; TRUE BEGINNING
PUSH SP,A1 ; SAVE ON STACK FOR LATER
HRLM A1,LB ; SET DESTINATION PART OF CONTROL WORD
ADDI A1,WRITE6-WRITE5-2 ; END OF WHERE THIS BLOCK WILL BE
TRNN FL,TRPOFF ; IF NOT PRODUCTION...
ADDI A1,13 ; ...INCLUDE EXTRA PIECE.
CAMG A1,T1END ; IF THERE IS ENOUGH SPACE IN BUFFER
JRST .+4 ; THEN USE THIS BUFFER
POP SP,A1 ; ELSE LOSE STACKED A1
PUSHJ SP,GETBUF ; AND GET ANOTHER OUTPUT BUFFER
JRST PD2 ; AND TRY AGAIN
HRRM A1,T1ADR ; SET NEW T1ADR
MOVEI A1,LB ; ADDRESS OF NEW BMOVE LIST
PUSHJ SP,BMOVE ; MOVE INTO FINAL POSITION
HRRZ A5,NSYM ; GET ADDR OF BUFFER CONTAINING PROCEDURE NAME
SUBI A5,2 ; MAKE LOOK LIKE SYMBOL TABLE ENTRY
PUSHJ SP,PULL50 ; CONVERT NAME IN ENTRY TO RADIX50
POP SP,A3 ; ADDRESS OF MOVED BLOCK
MOVEM A2,PNAME1-WRITE5-1(A3) ; PUT NAME IN BUFFER
MOVEM A2,PNAME2-WRITE5-1(A3) ; PUT NAME IN BUFFER
TLO A2,040000 ; CODE 04
MOVEM A2,PNAME3-WRITE5-1(A3) ; PUT NAME IN BUFFER
TRNE FL,TRLOFF ; /PRODUCTION ?
JRST WRITE2 ; YES - IMPLIES /NOSYMBOLS
PUSH SP,A2 ; NO - REMEMBER A2
MOVE A1,NSYM ; GET SYMBOL BUFFER ADDRESS
MOVE A1,(A1) ; GET FIRST WORD
ANDI A1,77 ; GET LENGTH IN CHARS - 1
ADDI A1,6+6+2+5 ; LENGTH+1 + ROUNDING + PROFILE & SIZE
IDIVI A1,6 ; GET NUMBER OF SIXBITZ WORDS
MOVEM A1,PVALUE-WRITE5-1(A3) ; SET VALUE WORD
POP SP,A2 ; RESTORE NAME
TRNE FL,TRPOFF ;
JRST WRITE2
TLZ A2,740000 ; CLEAR CODE BITS
MOVEM A2,EMODBL-1-WRITE5(A3) ; PUT MODULE TITLE IN.
MOVE A2,SLIST+1 ; SOURCE DEVICE
MOVEM A2,EMODBL+2-WRITE5(A3) ;
MOVE A2,LINENO ;
MOVEM A2,EMODBL-2-WRITE5(A3) ;
ADDI A3,EMODBL+3-WRITE5
HRLI A3,SFILE ; SOURCE FILE INFO
MOVEI A1,3(A3) ;
BLT A3,(A1) ;
; "WRITE2" IS CALLED BY ".PROGD" AND ".PROCD". "WRITE2" WILL PUT
; THE PROGRAM COUNTER (RA) INTO THE 1ST DATA WORD OF A NEW TYPE-1
; LOADER BLOCK.
WRITE2: PUSHJ SP,FIN1 ; INITIALIZE PRIME BUFFER
MOVEI A4,TYPE1 ; INITIALISE TYPE-1 BLOCK
PUSHJ SP,INITB
AOS A3,T1IND ; GET INDEX
SETZM @T1ADR ; SET START ADDRESS
MOVEI A3,1 ; RELOCATE RIGHT HALF
IDPB A3,T1PTR ; SET RELOCATION BITS
MOVEI A4,10 ; THIS BUFFER IS FOR
MOVEM A4,T10TYP ; TYPE-10 BLOCKS
POPJ SP, ; EXIT .PROGD OR .PROCD
; "PULL50" WILL EXTRACT THE RADIX50 NAME OF AN IDENTIFIER FROM THE
; SYMBOL TABLE ENTRY. A5 SHOULD CONTAIN THE ADDRESS OF THE SYMBOL TABLE
; ENTRY. THE OUTPUT IS IN A2, RIGHT-JUSTIFIED.
PULL50: MOVEI A1,0 ; CLEAR A1
MOVE A2,2(A5) ; GET 1ST WORD OF NAME
MOVEI A3,(A2)
ANDI A3,77 ; #CHARS.-1
MOVEI A4,(A3)
IMULI A4,6 ; COPY*6
CAIGE A3,5 ; IF THERE ARE LESS THAN 6 CHARS
JRST IDL ; THEN SKIP THIS PART
MOVE A1,3(A5) ; PICK UP 2ND WORD
CAIGE A3,^D10 ; IF THERE ARE LESS THAN 11 CHARS
ROT A1,-^D24(A4) ; SHIFT AROUND 6TH CHAR.
ANDI A1,77
XORI A1,40 ; CONVERT TO PROPER SIXBIT
MOVEI A3,4 ; RESET CHAR COUNT
MOVEI A4,^D30 ; SET UP FINAL SHIFT
IDL: ROT A1,-^D12 ; MOVE LAST CHAR TO LEFT SIDE OF A1
LSHC A1,6 ; MOVE NEXT CHAR INTO A1
XORI A1,40 ; CONVERT TO PROPER SIXBIT
SOJGE A3,IDL ; LOOP TILL DONE
ROT A1,(A4) ; RESULT
; "RADX50" WILL CONVERT THE SIXBIT NAME IN A1 TO RADIX50, AND
; OUTPUT THE RESULT IN A2, LEFT-JUSTIFIED.
RADX50: MOVEI A2,0 ; CLEAR A2
MOVEI A3,6 ; SCAN 6 CHARS
MOVE A6,[ ; LOAD A POINTER TO
POINT 6,A1] ; A1
RADIXL: IMULI A2,50 ; MULTIPLY CHAR BY 50
ILDB A4,A6 ; GET NEXT CHAR
JUMPE A4,.+5 ; SKIP IF A NULL CHAR
CAILE A4,40 ; IF THIS IS A LETTER
SUBI A4,7 ; THEN SUB 7
SUBI A4,17 ; CONVERT TO SPECIAL SIXBIT
ADDI A2,(A4) ; ADD INTO PREVIOUS RESULT
SOJG A3,RADIXL ; LOOP
POPJ SP, ; EXIT RADX50
RELOC
WFLAG: BLOCK 1 ; WRITE MODULE FLAG
A1SAV: BLOCK 1 ; SAVE AREA FOR .TYPE0 ACS
A2SAV: BLOCK 1 ; SAVE AREA FOR A2
A4SAV: BLOCK 1 ; SAVE AREA FOR A4
A5SAV: BLOCK 1 ; SAVE AREA FOR A5
A6SAV: BLOCK 1 ; SAVE AREA FOR A6
BUFLEN: BLOCK 1 ; OUTPUT BUFFER LENGTH
WINDEX: BLOCK 1 ; WORD INDEX
TRACLN: BLOCK 1
; ^D100 ; TRACE BUFFER LENGTH (/T SW)
DYNOWN: BLOCK 1 ; LENGTH OF HEAP (/HEAP SWITCH)
;
; TERMINOLOGY
;
;
; LOADER SUB-BLOCK: A WORD OF RELOCATION BITS FOLLOWED BY UP
; TO 18 DATA WORDS.
;
;
; LOADER BLOCK: A DESCRIPTOR WORD FOLLOWED BY ANY NUMBER
; OF LOADER SUB-BLOCKS. ONLY THE LAST SUB-BLOCK
; MAY CONTAIN LESS THAN 18 DATA WORDS.
;
;
; DESCRIPTOR WORD: LEFT HALF CONTAINS LOADER BLOCK TYPE.
; RIGHT HALF CONTAINS THE NUMBER OF DATA WORDS
; IN THE LOADER BLOCK. NOTE THAT THIS NUMBER
; DOES NOT INCLUDE THE DESCRIPTOR WORD OR ANY
; RELOCATION BITS WORDS.
;
;
; BUFFER: A BLOCK OF 200 (OCTAL) WORDS THAT CAN RECIEVE
; OUTPUT.
;
;
; RING BUFFER: A BUFFER, AS DEFINED ABOVE, THAT IS INCLUDED
; IN AN OUTPUT BUFFER-RING ACCEPTABLE TO THE
; OPERATING SYSTEM.
;
;
; BUFFER-RING: A RING OF RING BUFFERS.
;
;
; ISOLATED BUFFER: A BUFFER THAT IS NOT A RING BUFFER. ANY OUTPUT
; DATA THAT IS PLACED IN AN ISOLATED BUFFER
; MUST EVENTUALLY BE MOVED TO A RING BUFFER.
;
;
; PRIME BUFFER: THROUGHOUT MOST OF THE COMPILATION, TYPE-1, TYPE-2,
; TYPE-10, AND TYPE-0 DATA IS PRODUCED SIMULTANEOUSLY.
; BUT DUE TO THE INGENIOUS DESIGN OF THE BUFFER-RING
; CONCEPT IT IS ONLY POSSIBLE TO FILL ONE RING BUFFER
; AT A TIME. THEREFORE TYPE-1 DATA IS PLACED IN THE
; AVAILABLE RING BUFFER, AND THE TYPE-2, TYPE-10, AND TYPE-0
; DATA ARE PLACED IN THREE ISOLATED BUFFERS. WE SHALL
; CALL THE AVAILABLE RING BUFFER THE "PRIME BUFFER".
; STATUS BLOCK THIS MODULE CONTAINS GENERALIZED ROUTINES
; THAT CAN OPERATE ON ANY BUFFER. THE INPUT
; PARAMETER TO THESE ROUTINES IS THE ADDRESS
; OF A "STATUS BLOCK". A STATUS BLOCK IS A BLOCK
; OF WORDS THAT DESCRIBES THE CURRENT STATUS OF THE
; BUFFER. A STATUS BLOCK HAS THE FOLLOWING FORMAT:
;
;
; STATUS BLOCK FORMAT:
;
; WORD 0 (T#IND) LOADER SUB-BLOCK INDEX. THIS WORD NORMALLY
; INDEX WORD CYCLES FROM -18 TO 0. WHEN IT BECOMES +1
; IT IS TIME TO CALL THE ROUTINE "GET" WHICH
; SETS UP THE BUFFER FOR ANOTHER SUB-BLOCK.
; IF, FOR EXAMPLE, "GET" FINDS THAT THERE ARE
; ONLY 7 UNUSED WORDS AT THE END OF THE BUFFER,
; THEN IT WILL SET UP THIS WORD TO CYCLE FROM
; -7 TO 0.
;
;
; WORD 1 (T#ADR) BUFFER POINTER. THE RIGHT HALF OF THIS WORD
; ADDRESS WORD POINTS TO THE EVENTUAL LAST WORD OF THE SUB-BLOCK
; THAT IS BEING FILLED. THE LEFT HALF ALWAYS
; CONTAINS A3. THEN A DATA WORD IS MOVED INTO
; A SUB-BLOCK BY THE FOLLOWING SEQUENCE:
;
; AOSLE A3,T#IND ; STEP AND FETCH THE INDEX
; PUSHJ SP,T#GET ; -NO ROOM IN SUB-BLOCK, CALL GET
; MOVEM A1,@T#ADR ; MOVE DATA WORD INTO SUB-BLOCK
;
;
; WORD 2 (T#PTR) RELOCATION BITS BYTE POINTER. THE RELOCATION
; POINTER WORD BITS ARE INSERTED INTO THE RELOCATION WORD
; USING AN IDPB WITH THIS BYTE POINTER.
;
;
; WORD 3 (T#BLK) THIS WORD POINTS TO THE DESCRIPTOR WORD OF
; BLOCK START OF THE LOADER BLOCK IN THE BUFFER. AFTER
; THE BUFFER IS FILLED THE DESCRIPTOR WORD IS
; SET BY THE SEQUENCE:
;
; (USED LENGTH OF BUFFER) := T#ADR+T#IND-T#BLK ;
; @T#BLK := (USED LENGTH OF BUFFER)-(USED LENGTH OF BUFFER)/19 ;
;
;
; WORD 4 (T#END) THIS WORD POINTS TO THE LAST USABLE WORD
; BUFFER END OF THE BUFFER.
;
;
; WORD 5 (T#TYP) THIS WORD CONTAINS THE LOADER BLOCK TYPE FOR
; BLOCK TYPE WHICH THIS BUFFER IS BEING USED.
; IF AT ANY TIME "GET" DETECTS THAT ANY OF THESE BUFFERS IS FULL,
; "GET" WILL CALL "FIN". "FIN" WILL USE "MOVBLK" TO MOVE THE TYPE-2, TYPE-0
; AND TYPE-10 LOADER BLOCKS FROM THE ISOLATED BUFFERS TO THE PRIME
; BUFFER (AND IN THE PROCESS DO OUT UUO'S WHENEVER THE PRIME BUFFER
; BECOMES FULL). "FIN" WILL THEN USE "INITB" TO INITIALIZE EACH OF
; THE BUFFERS FOR MORE OUTPUT.
; ********* STATUS BLOCKS *********
TYPE1:
T1IND: BLOCK 1 ; INDEX
T1ADR: BLOCK 1 ; (A3) ADDRESS POINTER
T1PTR: BLOCK 1
; XWD 440200,0 ; POINTER TO RELOCATION BITS
T1BLK: BLOCK 1 ; LOCATION OF LOADER BLOCK
T1END: BLOCK 1 ; END OF THAT BUFFER
T1TYP: BLOCK 1 ; TYPE 1
T1LEN: BLOCK 1 ; LENGTH
TYPE2:
T2IND: BLOCK 1 ; -^D18 ; INDEX
T2ADR: BLOCK 1 ; (A3) ; ADDRESS POINTER
T2PTR: BLOCK 1
; XWD 440400,0 ; POINTER TO RELOCATION BITS
T2BLK: BLOCK 1 ; LOCATION OF LOADER BLOCK
T2END: BLOCK 1 ; END OF THAT BUFFER
T2TYP: BLOCK 1 ; TYPE 2
T2LEN: BLOCK 1 ; LENGTH
TYPE10:
T10IND: BLOCK 1 ; -^D18 ; INDEX
T10ADR: BLOCK 1 ; (A3) ; ADDRESS POINTER
T10PTR: BLOCK 1
; XWD 440200,0 ; POINTER TO RELOCATION BITS
T10BLK: BLOCK 1 ; LOCATION OF LOADER BLOCK
T10END: BLOCK 1 ; END OF THAT BUFFER
T10TYP: BLOCK 1 ; TYPE 10
T10LEN: BLOCK 1 ; LENGTH
T1000S:
; *** All headers for new block-types (type .GE. 1000) must follow this label.
TYPE0:
T0IND: BLOCK 1 ; -^D126. ; INDEX
T0ADR: BLOCK 1 ; (A3) ; ADDRESS POINTER
T0PTR: BLOCK 1 ; POINTER TO RELOCATION BITS (UNUSED)
T0BLK: BLOCK 1 ; LOCATION OF LOADER BLOCK
T0END: BLOCK 1 ; END OF THAT BUFFER
T0TYP: BLOCK 1 ; TYPE 0
T0LEN: BLOCK 1 ; LENGTH
TYPE15=TYPE10
T15IND=T10IND
T15ADR=T10ADR
T15PTR=T10PTR
T15BLK=T10BLK
T15END=T10END
T15TYP=15
NEWT0==1044 ; BLOCK TYPE FOR ALGOL SYMBOLS
RELOC
; ********* OUTPUT ROUTINES *********
;--------------------------------------------------------------
.MABS: AOSLE A3,T1IND ; FETCH THE INDEX AND STEP IT
PUSHJ SP,T1GET ; -AT END OF 18-WORD BLOCK
MOVEM A1,@T1ADR ; STORE THE WORD IN THE BUFFER
IBP T1PTR ; RELOCATION BITS ARE ZERO
MABS1: AOS RA ; STEP PROGRAM COUNTER
POPJ SP, ; EXIT .MABS
;--------------------------------------------------------------
.MREL: TRNN A1,777777 ; IF RIGHT HALF OF T IS ZERO
JRST .MABS ; THEN DO A MABS
.MREL0::AOSLE A3,T1IND ; STEP AND FETCH WORD INDEX
PUSHJ SP,T1GET ; -END OF SUB-BLOCK
MOVEM A1,@T1ADR ; STORE THE WORD IN THE BUFFER
MOVEI A3,1 ; RELOCATE RIGHT HALF
IDPB A3,T1PTR ; SET RELOCATION BITS
JRST MABS1 ; EXIT .MREL
;--------------------------------------------------------------
.RAFIX: TRNN A1,777777 ; IF RIGHT HALF ZERO
POPJ SP, ; THEN DO NOTHING
AOSLE A3,T10IND ; STEP AND FETCH WORD INDEX
PUSHJ SP,T10GET ; -END OF SUB-BLOCK
HRL A1,RA ; THE VALUE IS THE CURRENT PROGRAM COUNTER
RAFIX1: MOVSM A1,@T10ADR ; STORE THE WORD IN THE BUFFER
MOVEI A3,3 ; RELOCATE BOTH HALVES
IDPB A3,T10PTR ; SET THE RELOCATION BITS
POPJ SP, ; EXIT .RAFIX
;--------------------------------------------------------------
.ADRFIX:
TRNN A1,777777 ; IF RIGHT HALF ZERO
POPJ SP, ; THEN DO NOTHING
AOSLE A3,T10IND ; STEP AND FETCH WORD INDEX
PUSHJ SP,T10GET ; -END OF SUB-BLOCK
HRL A1,A2 ; PUT VALUE WITH BACK-CHAIN POINTER
JRST RAFIX1 ; EXIT .ADRFIX
;--------------------------------------------------------------
.ABSFIX:
TRNN A1,777777 ; IF RIGHT HALF ZERO
POPJ SP, ; THEN DO NOTHING
AOSLE A3,T10IND ; STEP AND FETCH WORD INDEX
PUSHJ SP,T10GET ; -END OF SUB-BLOCK
HRL A2,A1 ; PUT VALUE WITH BACK-CHAIN POINTER
MOVEM A2,@T10ADR ; PUT WORD INTO BUFFER
MOVEI A3,2 ; RELOCATE THE LEFT HALF
IDPB A3,T10PTR ; SET RELOCATION BITS
POPJ SP, ; EXIT .ABSFIX
;--------------------------------------------------------------
.FIX50: TRNN A1,777777 ; IF RIGHT HALF ZERO
POPJ SP, ; THEN DO NOTHING
MOVEM A5,A5SAV ; SAVE A5
AOSLE A3,T2IND ; STEP AND FETCH WORD INDEX
PUSHJ SP,T2GET ; -END OF SUB-BLOCK
TLO A2,600000 ; INCLUDE THE CODE 60 INDICATOR
MOVEM A2,@T2ADR ; STORE THE WORD IN THE BUFFER
AOSLE A3,T2IND ; STEP AND FETCH THE WORD INDEX
PUSHJ SP,T2GET ; -END OF SUB-BLOCK
HRRZM A1,@T2ADR ; STORE THE WORD IN THE BUFFER
MOVE A5,A5SAV ; RESTORE A5
JRST .ADDF1 ; EXIT VIA ADDFIX
;--------------------------------------------------------------
.EXTFIX:
MOVEM A5,A5SAV ; SAVE A5 BECAUSE PULL50 WILL CLOBBER IT
PUSHJ SP,PULL50 ; EXTRACT NAME AND CONVERT TO RADIX50
MOVE A5,A5SAV ; RESTORE A5
MOVE A1,1(A5) ; LOAD VALUE FIELD OF ENTRY
PUSHJ SP,.FIX50 ; WRITE OUT THIS BACK-CHAIN POINTER
MOVE A3,(A5) ; GET 1ST WORD OF ENTRY
TLNN A3,EXTEN ; IF THIS IS NOT AN EXTENDED ENTRY
POPJ SP, ; THEN EXIT .EXTFIX
MOVE A3,2(A5) ; GET NAME WORD
ADDI A3,1 ; ADD 1 TO BYTE COUNT
ANDI A3,77 ; SAVE ONLY LENGTH BYTE
IDIVI A3,6 ; CONVERT TO A WORD COUNT
ADDI A3,3(A5) ; STEP TO EXTENSION
MOVE A1,(A3) ; GET 1ST WORD OF EXTENSION
JRST .FIX50 ; WRITE OUT THIS BACK-CHAIN POINTER, EXIT .EXTFIX
;--------------------------------------------------------------
.ADDFIX:
AOSLE A3,T2IND ; STEP AND FETCH WORD INDEX
PUSHJ SP,T2GET ; -END OF SUB-BLOCK
MOVE A2,DIR ; ADDITIVE FIX UP TO %ALGDR
MOVEM A2,@T2ADR ; STORE THE WORD IN THE BUFFER
AOSLE A3,T2IND ; STEP AND FETCH THE WORD INDEX
PUSHJ SP,T2GET ; -END OF SUB-BLOCK
HRLI A1,400000 ; INDICATE AN ADDITIVE FIX-UP
MOVEM A1,@T2ADR ; STORE THE WORD IN THE BUFFER
.ADDF1: MOVEI A3,1 ; RELOCATE RIGHT HALF OF SECOND WORD
IDPB A3,T2PTR ; SET THE RELOCATION BITS
POPJ SP, ; EXIT .ADDFIX
;--------------------------------------------------------------
.TYPE0::LDB A2,[POINT 6,2(A1),35] ; LENGTH IN CHARS
IDIVI A2,5 ; THEN WORDS
AOS A2 ; ADJUST
MOVNM A2,A1SAV ; SAVE IT FOR LOOP
ADDI A2,2 ; ADD EXTRA LENGTH
HRLI A2,'SYM' ; AND SET CODE
PUSHJ SP,MOVE0 ; ENTER IT
MOVE A2,1(A1) ; LEXEME,,VALUE
MOVE A4,FNLEVEL ;
SOJG A4,TYPE0A ; IF AT PL = 0
TLC A2,$EXT ; AND STATUS
TLZE A2,$STATUS ; .NE. EXTERNAL,
TLOA A2,$OWN ; FORCE $OWN
TLO A2,$EXT ; LEAVE $EXT ALONE !
TYPE0A: PUSHJ SP,MOVE0
PUSHJ SP,NAME ; CONVERT TO ASCII
HRL A1,A1SAV ; -VE LHS COUNT
HRRI A1,LB ; BEGINNING OF NAME
MOVE A2,(A1)
PUSHJ SP,MOVE0 ; TO BLOCK
AOBJN A1,.-2 ; REST OF NAME TOO
POPJ SP,
.PRSYM::LDB A2,[POINT 6,2(A1),35] ; GET LENGTH IN CHARS
IDIVI A2,5 ; THEN WORDS
AOS A2 ; AND ALLOW FOR EXTRA
MOVNM A2,A1SAV ; SAVE IT FOR LOOP
ADDI A2,2 ; ADD EXTRA LENGTH
HRLI A2,'SYM' ; SET CODE
PUSHJ SP,MOVE0 ; WRITE IT TO THE FILE
MOVE A2,A1 ; GET NEW LEXEME
TLZ A2,$PRO-$VAR ; CHANGE TYPE TO VARIABLE
TLZ A2,$STATUS ; AND STATUS TO SIMPLE
HRR A2,FNLEVEL ; RESULT IS AT FNLEVEL+1(DL)
AOJA A2,TYPE0A ; SO GO INSERT IN BUFFER
.BHDR:: PUSHJ SP,SNDSTN ; MAKE SURE STN ITEM IS SENT
MOVE A2,BHDR ; ALGOL BLOCK SYMBOL HEADER
PUSHJ SP,MOVE0
MOVE A2,BLOCKLEVEL
HRL A2,CURBLOCK ;
PUSHJ SP,MOVE0
MOVE A2,FNLEVEL
HRL A2,CURDLN
JRST MOVE0 ; EXIT VIA MOVE0
.SBHDR::PUSHJ SP,SNDSTN ; MAKE SURE STN ITEM IS SENT
MOVE A2,SBHDR ; BLOCK BEGIN ITEM
JRST MOVE0 ; EXIT VIA MOVE0
BLKH==SIXBIT/BLK/
BHDR: EXP BLKH+3
SBLKH==SIXBIT/BKS/
SBHDR: EXP SBLKH+1
.ESBLK::MOVE A2,CURDLN ; "END" STATEMENT - LINE NO IS DEL
MOVEM A2,CURSLN ; LINE NUMBER (END IS A DELIMITER)
.SNBLK::MOVE A2,RA ; GET ADDRESS.
CAME A2,LASTRA ; IS IT A NEW ADDRESS ?
PUSHJ SP,SNDSTN ; YES - OUTPUT OLD STN BLOCK
MOVE A2,RA ; THEN GET ADDRESS AGAIN
MOVEM A2,LASTRA ; REMEMBER FOR NEXT TIME
MOVE A2,CURSLN ; GET LINE NUMBER
MOVEM A2,SENDLN ; REMEMBER THIS ALSO
SETOM SENDSN ; SAY WE HAVE A BLOCK
POPJ SP, ; AND RETURN
SNDSTN: SKIPN SENDSN ; DO WE NEED TO SEND ONE ?
POPJ SP, ; NO - RETURN
SETZM SENDSN ; YES - SAY WE HAVE DONE SO
MOVE A2,SNHDR ; STATEMENT NUMBER BLOCK.
PUSHJ SP,MOVE0
MOVE A2,LASTRA ; PROGRAM COUNTER
PUSHJ SP,MOVE0
MOVE A2,SENDLN ; GET LINE NUMBER OF STATEMENT
CAMN A2,LSTSLN ; IF SAME AS LAST TIME, THEN
AOSA STMTNO ; INCREMENT STATEMENT WITHIN LINE
SETZM STMTNO ; OTHERWISE RESET TO 0
MOVEM A2,LSTSLN ; REMEMBER LINE NUMBER FOR NEXT TIME
HRL A2,STMTNO ; STATEMENT-WITHIN-LINE-#,,LINE-#
JRST MOVE0 ; TO .REL FILE & POPJ.
STMNTB==SIXBIT/STN/
SNHDR: EXP STMNTB+3
.MRK.0::PUSHJ SP,MRK.XX
.MRK.1::PUSHJ SP,MRK.XX
.MRK.2::PUSHJ SP,MRK.XX
.MRK.3::PUSHJ SP,MRK.XX
.MRK.4::PUSHJ SP,MRK.XX
.MRK.5::PUSHJ SP,MRK.XX
.MRK.6::PUSHJ SP,MRK.XX
.MRK.7::PUSHJ SP,MRK.XX
.MRK.8::PUSHJ SP,MRK.XX
.MRK.9::PUSHJ SP,MRK.XX
MRK.XX: TRNE FL,TRPOFF ; ARE WE SENDING SYMBOLS ?
JRST [
SUB SP,[1,,1] ; NO - CLEAR JUNK FROM STACK
POPJ SP,] ; AND RETURN
PUSHJ SP,SNDSTN ;YES - MAKE SURE STN HAS BEEN SENT
MOVE A2,[XWD 'MRK',2];GET MARKER TYPE CODE
PUSHJ SP,MOVE0 ; AND SEND IT OUT
POP SP,A2 ; THEN GET LINK
SUBI A2,.MRK.1 ; CONVERT TO TYPE CODE
HRL A2,RA ; GET ADDRESS INTO LEFT HALF
; **** JRST MOVE0 ;**** FALL INTO MOVE0 ****
MOVE0: AOSLE A3,T0IND ; GET INDEX
PUSHJ SP,T0GET ; -END OF SUB-BLOCK
MOVEM A2,@T0ADR ; STORE THE WORD IN THE BUFFER
POPJ SP, ; EXIT MOVE0
RELOC
LASTRA: BLOCK 1 ; ADDRESS OF STN BLOCK.
SENDSN: BLOCK 1 ; FLAG TO SAY SEND STN ITEM
SENDLN: BLOCK 1 ; LINE NUMBER FOR STN ITEM
RELOC
;--------------------------------------------------------------
T1GET: MOVEI A4,TYPE1 ; ADDR OF STATUS BLOCK DESCRIBES TYPE-1 BLOCK
JRST GET ; CONTINUE
T2GET: MOVEI A4,TYPE2 ; ADDR OF STATUS BLOCK DESCRIBES TYPE-2 BLOCK
JRST GET ; CONTINUE
T10GET: MOVEI A4,TYPE10 ; ADDR OF STATUS BLOCK DESCRIBES TYPE-10 BLOCK
JRST GET ; CONTINUE
T0GET: MOVEI A4,TYPE0 ; [247] LOAD ADDR OF T0 STATUS BLOCK
; [247] AND FALL THROUGH TO "GET"
;
; "GET" IS CALLED WHEN A SUB-BLOCK IS FULL. "GET" WILL SET UP THE
; STATUS BLOCK FOR THE NEXT SUB-BLOCK. IF THERE IS ROOM LEFT
; IN THE BUFFER FOR MORE THAN 18 DATA WORDS, "GET" WILL SET THE INDEX
; WORD TO CYCLE FROM -18 TO 0. IF THERE IS BETWEEN 3 AND 18 WORDS
; OF SPACE LEFT IN THE BUFFER, "GET" WILL SET THE INDEX WORD SO THAT
; IT BECOMES ZERO WHEN THE BUFFER IS FULL.
;
; IF THERE ARE LESS THAN 3 AVAILABLE WORDS LEFT IN THE BUFFER,
; "GET" WILL NOT START ANOTHER SUB-BLOCK IN THAT BUFFER. INSTEAD,
; "GET" WILL CALL "FIN" TO MOVE THE LOADER BLOCKS TO THE PRIME BUFFER.
; THEN "GET" WILL PUT THE PROGRAM COUNTER (RA) INTO THE 1ST DATA WORD
; OF THE NEW TYPE-1 LOADER BLOCK.
;
GET: MOVE A5,EN(A4) ; COMPUTE THE AMOUNT OF SPACE LEFT
SUB A5,ADR(A4) ; IN THE BUFFER.
MOVEI A5,(A5) ; CLEAR LEFT HALF OF A5
CAIGE A5,3 ; IF LESS THAN 3 WORDS REMAIN
JRST GET1 ; THEN DON'T START ANOTHER SUB-BLOCK.
CAMLE A5,LEN(A4) ; IF MORE THAN LEN WORDS REMAIN
MOVE A5,LEN(A4) ; USE EXACTLY LEN WORDS FOR THIS SUB-BLOCK
MOVE A3,ADR(A4) ; GET OLD ADDRESS POINTER
ADDI A3,1 ; THE NEXT WORD IS THE NEW RELOCATION BITS WORD
HRRM A3,PTR(A4) ; SET POINTER'S ADDRESS FIELD
SETZM (A3) ; CLEAR THE RELOCATION BITS
MOVEI A3,44 ; REINITIALIZE THE P-FIELD OF
DPB A3,[POINT 6,PTR(A4),5] ; THE BYTE POINTER TO THE FIRST BYTE
ADDM A5,ADR(A4) ; LENGTH OF NEW SUB-BLOCK TO OLD ADDR POINTER
MOVN A3,A5 ; NEGATE LENGTH OF NEW SUB-BLOCK
ADDI A3,2 ; BUT DONT COUNT THE RELOCATION WORD
HRREM A3,IND(A4) ; THIS WILL BE THE NEW INDEX WORD
POPJ SP, ; EXIT GET
GET1: MOVEM A2,A2SAV ; SAVE A2
MOVEM A4,A4SAV ; SAVE A4
SOS IND(A4) ; CORRECT END OF DATA
PUSHJ SP,FIN ; FINISH
MOVEI A4,TYPE1
PUSHJ SP,INITB ; INITIALIZE NEW TYPE1
AOS A3,T1IND ; STEP AND FETCH THE INDEX
MOVE A2,RA ; GET PROGRAM COUNTER
TLZE A2,400000 ; IF RA WAS DECREMENTED
ADDI A2,1 ; THEN COMPENSATE
HRRZM A2,@T1ADR ; PUT PROGRAM COUNTER INTO SUB-BLOCK
MOVEI A3,1 ; 2ND HALF IS RELOCATABLE
IDPB A3,T1PTR ; OUTPUT RELOCATION BITS
MOVE A4,A4SAV ; RESTORE A4
MOVE A2,A2SAV ; RESTORE A2
AOSGE A3,IND(A4) ; STEP INDEX
POPJ SP, ; EXIT T1GET, T2GET, OR T10GET
JRST GET1 ; TRY AGAIN IF BLOCK TOO SHORT.
; "COMPL" COMPUTES THE NUMBER OF DATA WORDS IN A LOADER BLOCK.
; "COMPL" EXPECTS A4 TO CONTAIN THE ADDRESS OF THE STATUS BLOCK,
; AND THAT THE STATUS BLOCK ADDRESS WORD (T#ADR) POINT TO THE
; LAST ACTUAL DATA WORD OF THE LOADER BLOCK. "COMPL" WILL INSERT
; THIS NUMBER INTO THE LOADER BLOCK'S DESCRIPTOR WORD.
COMPL: HRRZ A5,ADR(A4) ; GET END OF LOADER BLOCK
SUB A5,BLK(A4) ; LENGTH OF USED BUFFER SPACE
HRL A5,TYP(A4) ; GET TYPE BITS
TLNE A5,1700 ; NO ADJUSTMENT FOR TYPES
JRST COMPL1 ; 1000-1077
MOVEI A2,-1(A5) ; COPY LENGTH-1 TO A2
IDIVI A2,^D19 ; COMPUTE NUMBER OF RELOCATION WORDS
SUBI A5,1(A2) ; ELSE SUB FOR # DATA WORDS
COMPL1: MOVEM A5,@BLK(A4) ; PUT TYPE AND LENGTH AT BEGINNING OF BLOCK
POPJ SP, ; EXIT COMPL
; "GETBUF" WILL GET A NEW PRIME BUFFER, AND THEN UPDATE THE PRIME
; BUFFER STATUS BLOCK TO REFLECT THIS CHANGE.
GETBUF: MOVE A2,T1ADR ; END OF DATA IN BUFFER
HRRM A2,BHEAD1+1 ; MARK IN HEADER
SKIPLE WFLAG ; IF THERE IS AN OBJECT MODULE
OUT 1,0 ; GET ANOTHER BUFFER
JRST .+2 ; -OK
JRST DSERR7 ; -OUTPUT ERROR
HRRZ A2,BHEAD1 ; ADDRESS OF NEW BUFFER
ADDI A2,1 ; STEP OVER 1ST WORD
HRRM A2,T1BLK ; MARK BLOCK BEGINNING
HRRM A2,T1ADR ; SET T1ADR
ADD A2,BUFLEN ; COMPUTE END OF BUFFER
HRRZM A2,T1END ; SAVE THIS ADDRESS
POPJ SP, ; EXIT CHECK3
; "FIN" WILL ADD THE INDEX WORD, T1IND, TO THE ADDRESS WORD, T1ADR,
; AND EXPECT THE SUM TO POINT TO THE LAST DATA WORD IN THE PRIME BUFFER.
; THEN "FIN" WILL COMPUTE THE NUMBER OF DATA WORDS IN THE LOADER BLOCK
; THAT IS BEING FILLED IN THE PRIME BUFFER, AND INSERT THIS NUMBER
; INTO THE LOADER BLOCK'S DESCRIPTOR WORD. THEN "FIN" WILL USE "MOVBLK"
; TO MOVE LOADER BLOCKS FROM THE ISOLATED BUFFERS TO THE PRIME BUFFER.
; FINALLY, "FIN" WILL INITIALIZE THE PRIME BUFFER TO RECEIVE SUB-BLOCKS
; OF A NEW LOADER BLOCK.
FIN: HRRE A4,T1IND ; GET INDEX
ADDM A4,T1ADR ; COMPUTE END OF DATA IN PRIME BUFFER
MOVEI A4,TYPE1 ; PARAM FOR COMPL
PUSHJ SP,COMPL ; LENGTH OF CODE IN BUFFER, PUT IN BUFFER
FIN4: MOVEI A4,TYPE2 ; [302] PARAM FOR MOVBLK
PUSHJ SP,MOVBLK ; MOVE TYPE-2 LOADER BLOCK TO PRIME BUFFER
MOVEI A4,TYPE10 ; PARAM FOR MOVBLK
PUSHJ SP,MOVBLK ; MOVE TYPE-10 LOADER BLOCK TO PRIME BUFFER
MOVEI A4,TYPE0 ; PARAM FOR MOVBLK
TRNN FL,TRPOFF ; UNLESS PRODUCTION SWITCH SET
PUSHJ SP,MOVBLK ; MOVE TYPE-0 LOADER BLOCK TO PRIME BUFFER
FIN1: MOVE A3,T1END ; END OF BUFFER
SUB A3,T1ADR ; COMPUTE REMAINING LENGTH OF BUFFER
MOVEI A3,(A3) ; ZERO LEFT HALF
CAIGE A3,3 ; IF THERE ARE LESS THAN 3 WORDS LEFT
PUSHJ SP,GETBUF ; THEN GET ANOTHER BUFFER
AOS A3,T1ADR ; NEXT AVAILABLE WORD IN PRIME BUFFER
POPJ SP,
; "INITB" INITIALIZES A BUFFER SO THAT IT CAN RECEIVE THE 1ST SUB-BLOCK
; OF A NEW LOADER BLOCK. "INITB" EXPECTS A3 TO CONTAIN THE ADDRESS
; OF THE NEW LOADER BLOCK (ADDRESS OF THE DESCRIPTOR WORD), AND THAT
; A4 CONTAIN THE ADDRESS OF THE STATUS BLOCK.
INITB: HRRZM A3,BLK(A4) ; SET POINTER TO DESCRIPTOR WORD
HRRZS A3 ; CLEAR LHS
ADD A3,LEN(A4) ; STEP TO END OF SUB-BLOCK
CAMLE A3,EN(A4) ; IF PAST END OF BUFFER
MOVE A3,EN(A4) ; THEN BUFFER END BECOMES SUB-BLOCK END
HRRM A3,ADR(A4) ; SET ADDRESS POINTER
SUB A3,BLK(A4) ; COMPUTE LENGTH OF SUB-BLOCK
MOVNM A3,IND(A4) ; SET INDEX WORD
CAIL A4,T1000S ; All this not requ'd for 1000 up,
POPJ SP, ; So skip it
AOS IND(A4) ; Step past relocation word
MOVE A3,BLK(A4) ; Beginning of block
MOVEI A3,1(A3) ; Relocation word
SETZM (A3) ; To zero
HRRM A3,PTR(A4) ; SET ADDR FIELD OF RELOCATION BITS POINTER
MOVEI A3,44 ; BYTE 1
DPB A3,[ ; SET P-FIELD OF RELOCATION
POINT 6,PTR(A4),5] ; BITS BYTE POINTER
POPJ SP, ; EXIT INITB
; "MOVBLK" WILL MOVE A LOADER BLOCK FROM AN ISOLATED BUFFER TO THE
; PRIME BUFFER. "MOVBLK" EXPECTS A4 TO CONTAIN THE ADDRESS OF THE
; STATUS BLOCK, AND THAT T1ADR POINT TO THE LAST ACTUAL DATA WORD
; IN THE PRIME BUFFER. UPON COMPLETION, "MOVBLK" WILL SET T1ADR TO
; POINT TO THE NEW LAST DATA WORD IN THE PRIME BUFFER.
;
; IF THE LOADER BLOCK TO BE MOVED WILL NOT FIT IN THE AVAILABLE SPACE
; IN THE PRIME BUFFER, "MOVBLK" WILL MOVE AS MUCH AS WILL FIT, AND
; THEN PERFORM AN OUT UUO TO GET A NEW PRIME BUFFER, THEN MOVE THE
; REMAINDER OF THE LOADER BLOCK TO THE NEW PRIME BUFFER.
MOVBLK: HRRE A5,IND(A4) ; GET INDEX
ADDM A5,ADR(A4) ; COMPUTE END OF LOADER BLOCK
PUSHJ SP,COMPL ; COMPUTE LENGTH OF BLOCK, PUT IN BLOCK
; COMPUTE LENGTH OF LOADER BLOCK TO MOVE
HRRZ A5,ADR(A4) ; GET END OF USED SPACE
SUB A5,BLK(A4) ; SUBTRACT BEGINNING OF LOADER BLOCK
EDIT(070); Allow only one data word in new block-types
SOJL A5,MBLK2 ; [E070] Exit if no data words
MOVE A3,TYP(A4) ; [E070] Else get Block-Type
TRNN A3,1700 ; [E070] And if not a new block
JUMPE A5,MBLK2 ; [E070] Exit if only one word
ADDI A5,2 ; TRUE LENGTH OF BLOCK TO MOVE
; COMPUTE REMAINING SPACE IN CURRENT OUTPUT BUFFER
MOVE A3,T1END ; END OF OUTPUT BUFFER
SUB A3,T1ADR ; SUBTRACT POINTER
MOVEI A3,(A3) ; ZERO LEFT HALF OF A3
; A5=LENGTH OF LOADER BLOCK TO MOVE
; A3=LENGTH OF AVAIL SPACE IN PRIME BUFFER
JUMPE A3,MBLK3 ; JUMP IF NO SPACE LEFT
CAIGE A3,(A5) ; IF THERE IS NOT ENOUGH SPACE THEN
JRST MBLK4 ; CONTINUE
; MOVE REMAINDER OF LOADER BLOCK TO OUTPUT BUFFER
HRLZ A3,BLK(A4) ; "FROM" ADDRESS
MOVE A2,T1ADR ; END OF DATA IN PRIME BUFFER
MBLK1: HRRI A3,1(A2) ; "TO" ADDRESS
ADDI A2,(A5) ; "END" ADDRESS IN PRIME BUFFER
HRRM A2,T1ADR ; SAVE AS NEW ADDRESS POINER
HRRM A2,T1BLK
AOS T1BLK
BLT A3,(A2) ; MOVE IT
MBLK2: MOVE A3,BLK(A4) ; LOCATE BEGINNING OF LOADER BLOCK
JRST INITB ; INITIALIZE IT, EXIT MOVBLK
; NO SPACE IN PRIME BUFFER
MBLK3: HRL A3,BLK(A4) ; "FROM" ADDRESS
JRST MBLK5 ; CONTINUE
; INSUFFICIENT SPACE IN PRIME BUFFER
MBLK4: SUB A5,A3 ; COMPUTE LENGTH OF 2ND PART
ADD A3,BLK(A4) ; COMPUTE "FROM" ADDRESS FOR 2ND PART
HRLZI A3,(A3) ; SAVE FOR LATER
AOS A2,T1ADR ; "TO" ADDRESS
HRL A2,BLK(A4) ; "FROM" ADDRESS
BLT A2,@T1END ; MOVE 1ST PART OF LOADER BLOCK
MBLK5: MOVE A2,T1END ; END OF PRIME BUFFER
HRRM A2,T1ADR ; SET T1ADR TO IT
PUSHJ SP,GETBUF ; GET ANOTHER PRIME BUFFER
HRRZ A2,T1ADR ; ADDR OF BEGINNING OF NEW BUFFER
JRST MBLK1 ; CONTINUE
.ZZEND: MOVEM A6,A6SAV ; SAVE A6
PUSHJ SP,LMSGZ ; PRINT ANY ERROR MESSAGES LEFT IN TABLE
;--------------------------------------------------------
; SEARCH SYMBOL TABLE FOR UNDEFINED LABELS.
;--------------------------------------------------------
ZLAB: MOVE A1,STBB ; WHERE AN UNDEFINED LABEL ENTRY MIGHT BE
CAML A1,NASTE ; IF NO UNDEFINED LABEL
JRST ZC0 ; THEN SKIP THIS PART
PUSHJ SP,NAME ; EXTRACT FROM SYMBOL TABLE ENTRY THE ASCIZ NAME
MOVE A2,(A1) ; GET 1ST WORD OF ENTRY
TLNE A2,EXTEN ; IF IT IS AN EXTENDED ENTRY
ADDI A6,2 ; THEN ADD 2 TO POINTER
MOVEM A6,STBB ; SAVE FOR LATER
HRRZ A1,-2(A6) ; GET THE CHAIN HEAD
MOVEI A2,777777 ; FIX IT UP TO JUMP TO -1
PUSHJ SP,.ABSFIX ; WRITE OUT THE FIX-UP
MOVEI A1,UNDLAB ; "UNDEFINED LABEL "
PUSHJ SP,INS ; SEND TO LISTING AND TO TTY
MOVEI A1,LB ; ADDRESS OF NAME OF LABEL
PUSHJ SP,INS ; SEND TO LISTING AND TO TTY
MOVEI A1,[ASCIZ/>/] ; END NAME OF LABEL
PUSHJ SP,INS ; ...WITH A ">"
PUSHJ SP,TCHECK ; CR/LF
AOS .JBERR ; ADD 1 TO ACCUMULATED ERROR COUNT
MOVE A1,RFLAGS ; IF TERMINATION MESSAGE GIVEN
TLOE A1,TMG ; ...
JRST ZLAB ; THEN LOOK FOR ANOTHER UNDEFINED LABEL
MOVEM A1,RFLAGS ; ELSE TERMINATE REL FILE
SETOM WFLAG ; MARK .REL FILE TO BE DELETED
MOVEI A1,TERMC ; ADDRESS OF TERMINATION MESSAGE.
PUSHJ SP,INS ; "REL FILE DELETED"
PUSHJ SP,TCHECK ; CR/LF
JRST ZLAB ; LOOK FOR ANOTHER UNDEFINED LABEL
UNDLAB: ASCIZ /?UNDEFINED LABEL </ ;[304]
;--------------------------------------------------------
; MOVE 1-WORD CONSTANTS TO REL-FILE
;--------------------------------------------------------
ZC1: HLRZ A1,(A2) ; IF BACK-CHAIN IS ZERO
JUMPE A1,.+4 ; THEN DONT OUTPUT THIS CONSTANT
MOVE A1,1(A2) ; GET CONSTANTS VALUE
HLRZ A6,(A2) ; GET THE BACK CHAIN
PUSHJ SP,ZZZ ; OUTPUT THE WORD AND THE BACK CHAIN
SUB A2,(A2) ; LOCATE NEXT ENTRY ON CHAIN
TLZA A2,777777 ; ZERO LEFT HALF
ZC0: MOVE A2,LASTC1 ; START OF 1-WORD-CONSTANTS CHAIN
ZC2: CAMLE A2,CONTAB ; UNLESS END OF CHAIN
JRST ZC1 ; LOOP
;--------------------------------------------------------
; MOVE 2-WORD CONSTANTS TO REL-FILE
;--------------------------------------------------------
MOVE A2,LASTC2 ; START OF 2-WORD-CONSTANTS CHAIN
JRST ZC4 ; JUMP INTO LOOP
ZC3: MOVE A1,2(A2) ; GET 1ST WORD OF VALUE
HLRZ A6,(A2) ; GET THE BACK CHAIN
JUMPE A6,ZC4-2 ; IF NO BACK-CHAIN THEN SKIP THIS CONSTANT
PUSHJ SP,ZZZ ; OUTPUT THE WORD AND ITS FIXUP
MOVE A1,3(A2) ; GET 2ND WORD OF VALUE
HRRZ A6,1(A2) ; GET THE BACK CHAIN
PUSHJ SP,ZZZ ; OUTPUT THE WORD AND ITS FIXUP
SUB A2,(A2) ; LOCATE NEXT ENTRY ON CHAIN
MOVEI A2,(A2) ; ZERO LEFT HALF
ZC4: CAMLE A2,CONTAB ; UNLESS END OF CHAIN,
JRST ZC3 ; LOOP
;--------------------------------------------------------
; MOVE ANY ASCII STRINGS FROM CONSTANTS TABLE TO REL-FILE
;--------------------------------------------------------
MOVE A2,LASTST ; ADDR OF LAST STRING
JRST ZC8 ; JUMP INTO LOOP
ZC5: HLLZ A1,(A2) ; GET 1ST BACK-CHAIN
IOR A1,1(A2) ; OR WITH OTHER BACK-CHAINS
JUMPE A1,ZC8-2 ; IF ALL 3 ZERO THEN SKIP THIS STRING
HRRZ A1,RA ; GET ADDRESS OF EVENTUAL
ADDI A1,2 ; STRING ADDRESS
HRLI A1,440700 ; SET POSITION BITS
PUSHJ SP,.MREL ; WRITE 1ST WORD OF STRING HEADER
HLRZ A6,(A2) ; GET THE BACK CHAIN
PUSHJ SP,ZZZ+1 ; WRITE OUT THE FIXUP
MOVE A1,2(A2) ; GET BYTE COUNT
HRRZ A6,1(A2) ; GET THE 2ND BACK CHAIN
PUSHJ SP,ZZZ ; WRITE OUT THE WORD AND ITS FIXUP
SKIPN 2(A2) ; IF STRING IS 0 CHARS LONG
JRST ZC7 ; THEN SKIP THIS PART
PUSH SP,A1 ; SAVE VALUE OF RA FOR LATER
MOVEI A1,2(A2) ; START OF STRING -1
MOVEM A1,TEMP ; PUT IN TEMP
ZC6: AOS A1,TEMP ; GET ADDR OF NEXT WORD OF STRING
MOVE A1,(A1) ; GET NEXT WORD OF STRING
PUSHJ SP,.MABS ; WRITE IT OUT
HRREI A1,-5 ; DECREMENT CHARACTER COUNT
ADDB A1,2(A2) ; BY 5
JUMPG A1,ZC6 ; LOOP IF STILL SOME LEFT
POP SP,A1 ; RETRIEVE OLD VALUE OF RA
ZC7: PUSH SP,RA ; SAVE CURRENT VALUE OF RA
MOVEM A1,RA ; SET RA TO OLD VALUE
HLRZ A1,1(A2) ; GET 3RD BACK-CHAIN POINTER
PUSHJ SP,.RAFIX ; WRITE IT OUT
POP SP,RA ; RESTORE CORRECT VALUE OF RA
SUB A2,(A2) ; STEP TO NEXT STRING
MOVEI A2,(A2) ; ZERO LEFT HALF
ZC8: CAMLE A2,CONTAB ; IF THERE IS ANOTHER STRING
JRST ZC5 ; THEN LOOP
;--------------------------------------------------------
; MOVE CONTENTS OF FIXUP TABLE TO REL-FILE
;--------------------------------------------------------
;
;
; TYPE-15 BLOCKS (NOT MORE THAN 1 PER PROGRAM)
; ARE CREATED AS FOLLOWS -
; THE BLOCK HEADER WORD IS WRITTEN DIRECTLY INTO THE
; CURRENT PRIME BUFFER, SINCE ITS TOTAL LENGTH IS
; KNOWN, THEN ITS CONSTITUENT SUB-BLOCKS ARE BUILT IN
; THE TYPE-10 BUFFER AND MOVED OUT ONE BY ONE INTO THE
; PRIME BUFFER, SO AS TO PRESENT ONE CONTINUOUS STREAM
; TO THE LOADER.
;
;
PUSHJ SP,FIN ; CLEAR OUT ALL OTHER BUFFERS
MOVE A2,FIXUP ; COMPUTE TOTAL LENGTH
SUB A2,NAFTE ; OF THE BLOCK
LSH A2,1 ; SINCE TABLE WAS PACKED
SOJL A2,ZEXIT3-2 ; MAYBE NOTHING
HRLI A2,15 ; BLOCK HEADER
MOVEI A3,0 ; CLEAR A3 'cos T1ADR uses it
MOVEM A2,@T1ADR
SOS A3,T15BLK ; INITIALIZE FIRST S-B
MOVEI A4,TYPE15
PUSHJ SP,INITB ;
AOS T15BLK ; To please future calls
HRL A2,RA
SETZM PTR15
PUSHJ SP,MOV15A ; WRITE OUT RELOC ETC
MOVE A1,FIXUP
ZEXIT1: SUBI A1,1 ; STEP TO NEXT WORD (TABLE GROWS DOWNWARD)
CAMG A1,NAFTE ; IF AT END OF TABLE
JRST ZEXIT2 ; THEN FINISHED PROCESSING TABLE
MOVE A3,(A1) ; GET RIGHT HALF
PUSHJ SP,MOV15 ; PUT INTO TYPE-15 BLOCK
HLRZ A3,(A1) ; GET LEFT HALF
PUSHJ SP,MOV15 ; PUT INTO TYPE-15 BLOCK
JRST ZEXIT1 ; LOOP
;--------------------------------------------------------
; SUBROUTINE FOR MOVING TYPE-15 FIXUPS
;--------------------------------------------------------
MOV15: AOS A2,PTR15 ; GET A VALUE FOR IT
HRL A2,A3 ; PUT VALUE WITH BACK CHAIN POINTER
MOV15A: AOSLE A3,T15IND ; GET INDEX
PUSHJ SP,T15GET ; -END OF SUB-BLOCK
MOVEM A2,@T15ADR ; PUT FIX-UP INTO BUFFER
MOVEI A3,2 ; BACK POINTER IS RELOCATABLE
TLNN A2,777777 ; IF THERE IS NO BACK-CHAIN
MOVEI A3,0 ; THEN BACK POINTER IS NOT RELOCATABLE
IDPB A3,T15PTR ; OUTPUT RELOCATION BITS
POPJ SP, ; EXIT MOV15
;--------------------------------------------------------------
; THIS SECTION OUTPUTS A TYPE15 SUB-BLOCK TO PRIME BUFFER
;----------------------------------------------------------------
T15GET: AOS A5,T1ADR ; UPDATE NEXT LOCN
MOVEI A4,(A5) ; [302] DESTINATION
ADDI A4,^D17(A3) ; PLUS LENGTH OF THIS S-B
HRL A5,T15BLK ; BLOCK BEGINNING
CAMG A4,T1END ; ANY ROOM ?
JRST T15GT1 ; IF SO, JUMP ON
;
; THIS SECTION OUTPUTS AS MUCH OF A SUB-BLOCK AS WILL
; FIT TO THE PRIME BUFFER, PUSHES OUT THE BUFFER
; VIA GETBLK, AND LEAVES THE REMAINDER OF THE SUB-BLOCK
; TO T15GET.
;
BLT A5,@T1END ; SHIFT AS MANY AS POSS.
SUB A4,T1END ; #WORDS STILL TO MOVE
ADDI A3,^D18 ; TOTAL WORDS TO MOVE
SUBI A3,(A4) ; WORDS MOVED
ADDM A3,T1ADR ; UPDATE LAST WORD USED
HRRZ A5,T15BLK ; SET A5 UP FOR LATER
ADDI A5,(A3)
MOVEM A2,A2SAV ; GETBUF DESTROYS IT
PUSHJ SP,GETBUF ; OUTPUT
MOVE A2,A2SAV ; RESTORE A2
HRLI A5,(A5) ; ORIGIN ON LEFT
HRR A5,T1ADR
ADDI A4,(A5)
ADDI A5,1
T15GT1: BLT A5,(A4)
HRRM A4,T1ADR ; UPDATE T1ADR
HRRZ A3,T1ADR ; [302] GET CURRENT POSITION OF T1ADR
SUB A3,T1BLK ; [302] CALCULATE HOW MUCH ROOM IS LEFT NOW
MOVNS A3 ; [302] NEGATE ANSWER
CAMLE A3,T1IND ; [302] IS OUR RESULT LARGER THAN WHAT'S THERE?
MOVEM A3,T1IND ; [302] NO, SET INDEX ACCORDINGLY
SOS A3,T15BLK ;
MOVEI A4,TYPE15
PUSHJ SP,INITB ;
AOS T15BLK ;
AOS A3,T15IND ; FOR MOV15
POPJ SP, ; OR MAYBE ONLY EXIT
; SUBROUTINE FOR MOVING CONSTANTS TO REL-FILE
ZZZ: PUSHJ SP,.MABS ; WRITE OUT THE WORD
SOS A1,RA ; GET AND DECREMENT RA
TLO A1,400000 ; TAG IT
MOVEM A1,RA
MOVE A1,A6 ; MOVE THE CHAIN TO A1
PUSHJ SP,.RAFIX ; WRITE OUT THE FIXUP
AOS A1,RA
HRRZM A1,RA ; INCREMENT RA AND CLEAR FLAG
POPJ SP,
;--------------------------------------------------------
; MOVE TO REL-FILE THE TYPE-2 ENTRIES FOR THE LIBRARY PROCEDURES
;--------------------------------------------------------
ZEXIT2: MOVNI A1,^D18 ; CHECK FOR NULL S-BLK
AOS A3,T15IND
CAME A1,T15IND
PUSHJ SP,T15GET
SETOM ECOUNT ; INITIALIZE ALIAS COUNT
MOVEI A5,BLOCK0## ; 1ST ENTRY IN BLOCK 0
ZEXIT3: AOS A2,ECOUNT ; STEP ALIAS INDEX
MOVE A2,ATABLE##(A2) ; GET ALIAS NAME IN RADIX50
IMULI A2,50 ; APPEND PROCESSOR CHARACTER
ADDI A2,26 ; IE "L" IN RAD 50
MOVE A1,1(A5) ; VALUE FIELD CONTAINS BACK CHAIN
PUSHJ SP,.FIX50 ; WRITE OUT FIX-UP
MOVE A1,(A5) ; GET 1ST WORD OF ENTRY
MOVE A3,2(A5) ; 1ST WORD OF NAME
ADDI A3,1 ; ADD 1 TO CHARACTER COUNT
ANDI A3,77 ; SAVE ONLY CHAR COUNT
IDIVI A3,6 ; CONVERT TO WORD COUNT MINUS 1
ADDI A5,3(A3) ; STEP TO PAST NAME
TLNN A1,EXTEN ; IF THIS IS NOT AN EXTENDED ENTRY
JRST ZEXIT4 ; THEN SKIP THIS PART
MOVE A1,(A5) ; LOAD 1ST WORD OF EXTENSION
MOVE A2,ECOUNT ; GET THE ENTRY COUNT
MOVE A2,AT2##(A2) ; GET 2ND ALIAS NAME IN RADIX50
IMULI A2,50 ; AND ADD PROCESSOR CHARACTER
ADDI A2,26
PUSHJ SP,.FIX50 ; WRITE OUT FIX-UP
ADDI A5,2 ; SET PAST EXTENSION TO NEXT ENTRY
ZEXIT4: CAIGE A5,B0END## ; IF STILL WITHIN BLOCK 0
JRST ZEXIT3 ; THEN LOOP
;--------------------------------------------------------
; WRITE OUT THE TYPE-5 END BLOCK
;--------------------------------------------------------
PUSHJ SP,FIN4 ; [302] FINISH
HRRZ A1,T1ADR ; GET NEXT FREE LOCATION
MOVE A2,[5,,1] ; THIS IS A TYPE-5 BLOCK
MOVEM A2,(A1) ; PUT INTO BUFFER
HRLZI A2,200000 ; RELOCATION BITS
MOVEM A2,1(A1) ; PUT INTO BUFFER
MOVE A2,RA ; GET END OF PROGRAM PLUS 1
HRRZM A2,2(A1) ; PUT INTO BUFFER
ADDI A1,2 ; END OF DATA
HRRM A1,T1ADR ; SET NEW T1ADR
HRRM A1,BHEAD1+1 ; SET END OF DATA
MOVE A6,A6SAV ; RESTORE A6
TLNE A7,EXISTS ; IF THE LISTING EXISTS
TLZ A7,COMPLETE ; THEN MARK IT COMPLETE
MOVEM A7,RFLAGS ; SAVE READ MODULE FLAGS
MOVE A7,A7SAV ; RESTORE A7
POPJ SP, ; EXIT .ZZEND
RELOC
TEMP: BLOCK 1 ; TEMP
PTR15: BLOCK 1 ; STATIC OWN AREA POINTER
ECOUNT: BLOCK 1 ; ENTRY COUNT
RELOC
; "NAME" WILL EXTRACT FROM A SYMBOL TABLE ENTRY THE NAME OF THE
; IDENTIFIER IN ASCIZ FORMAT. A1 SHOULD CONTAIN THE ADDRESS OF
; THE SYMBOL TABLE ENTRY. THE OUTPUT IS IN A BUFFER CALLED "LB"
NAME: MOVE A5,[LB,,LB+1] ; [301] LOAD BLT POINTER
SETZM LB ; CLEAR ENOUGH OF LB
BLT A5,LB+^D14 ; FOR A 64-CHAR NAME.
MOVE A5,LBP ; BYTE POINTER TO OUTPUT BUFFER
MOVEI A6,2(A1) ; STEP TO 1ST NAME WORD OF ENTRY
MOVE A3,(A6) ; LOAD 1ST NAME WORD
LSHC A3,-6 ; PEEL OFF LENGTH COUNT
LSH A4,-36 ; CHAR COUNT -1
MOVEI A2,1(A4) ; A2 = CHAR COUNT
NAMEL: JUMPE A3,EDT301 ; [301] DON'T LOOP FOREVER IF NAME IS NULL
LSHC A3,-6 ; GET NEXT CHAR
LSH A4,-36 ; MOVE TO RIGHT OF REG
JUMPE A4,NAMEL ; IF A NULL THEN GET ANOTHER CHAR
TRNN A4,40 ; IF IT IS A LETTER
IORI A4,100 ; THEN CONVERT IT TO ASCII
IDPB A4,A5 ; PUT IN BUFFER
JUMPN A3,.+3 ; SKIP IF STILL MORE CHARS IN A3
EDT301: ADDI A6,1 ; [301] STEP WORD INDEX
MOVE A3,(A6) ; PICK UP NEXT WORD OF NAME
SOJG A2,NAMEL ; LOOP ONCE FOR EACH CHAR
POPJ SP, ; EXIT NAME
SUBTTL DATA MODULE
DEFINE MOD(N,ALOC)
<INTERN B.'N
INTERN Q.'N;
Q.'N==ALOC
B.'N: BLOCK ALOC
>
;..STORAGE ALLOCATION FOR MODULES
RELOC
MOD(MDEC,0);
MOD(MSTM,0);
MOD(MEXP,0);
MOD(MFOR,12);
MOD(MUTL,2);
MOD(MSER,16);
MOD(MCOD,3);
MOD(MFUN,1);
SUBTTL GLOBAL VARIABLES (FULL WORDS)
DEFINE GLOB(G)
<INTERN G
G: BLOCK 1
>
GLOB NSYM; ;NEXT SYMBOL
GLOB NDEL; ;NEXT DELIMITER
GLOB BLOCKLEVEL; ;CURRENT BLOCKLEVEL
GLOB FNLEVEL; ;CURRENT FUNCTION LEVEL
GLOB STBB; ;SYMBOL TABLE BASE FOR THIS BLOCK
GLOB NASTE; ;NEXT AVAIL. SYMBOL TABLE ENTRY
GLOB NACTE; ;NEXT AVAIL. CONSTANTS TABOL ENTRY
GLOB NAFTE; ;NEXT AVAILABLE FIXUP TABLE ENTRY;
GLOB FIXUP; ;BASE OF FIXUP TABLE;
GLOB CONTAB; ;CONSTANT TABLE BASE;
GLOB CAX; ;PROCEDURE LEVEL OF LAST ACCESSED NON-LOCAL
GLOB RA; ;RELATIVE ADDRESS OF NEXT INSTRUCTION PLACED IN
;OBCODE
GLOB LEXBLOCK; ;MONOTONICALLY INCREASING COUNT OF BLOCKS
GLOB CURBLOCK; ;LEXBLOCK OF CURRENT BLOCK
GLOB ARDEC; ;ARRAY DECLARED IN BLOCK => TRUE; ELSE FALSE
GLOB PROSKIP; ;PROCEDURE FOUND SWITCH (-1 NONE FOUND) OR ADDR
;OF FIRST ONE
GLOB LSTSLN; ; LINE NUMBER OF LAST STN BLOCK
GLOB CURSLN; ; LINE NUMBER FOR SYM
GLOB NXTSLN; ; LINE NUMBER OF NSYM
GLOB CURDLN; ; LINE NUMBER FOR DEL
GLOB NXTDLN; ; LINE NUMBER OF NDEL
GLOB STMTNO; ; STATEMENT # WITHIN A LINE.
GLOB LINENO; ;LINE NUMBER SPECIFIED BY LINE PSEUDO-STATEMENT
GLOB INDEX; ;FIRST AVAILABLE FREE WORD IN TEMPCODE
GLOB HANDLE; ;PORTION POINTER FOR CURRENTLY OPEN PORTION
GLOB LEXEX; ;BLOCKLEVEL & HANDLE FOR SYM * THESE
GLOB COMPNAME; ;COMPOSIT NAME FOR SYM * MUST
GLOB LLEXEX; ;BLOCKLEVEL & HANDLE FOR LEFT OP* APPEAR
GLOB LCOMPNAME; ;COMPOSIT NAME FOR LEFT OP * TOGETHER
GLOB LAC; ;LAST ALLOCATED ACCUMULATOR
GLOB TCBASE; ;THE FIRST LOCATION OF TEMPCODE BUFFER.
GLOB TCMAX; ;THE LAST LOCATION OF TEMPCODE BUFFER.
GLOB THUNK; ;ADDRESS OF JRST OVER THUNKS (0 IF NONE YET.);
GLOB OP; ;CONTAINS THE OPERATOR DURING CODE GENERATION;
GLOB KA; ;COMMUNICATIONS CELL FOR GLOAD AND LOAD;
GLOB FBSYMSAVE; ;SAVED STEP ELEMENT LEXEME
GLOB FBLEXSAVE;
GLOB FBCOMPSAVE;
GLOB PREFACC; ;PREFERED REGISTER FOR CGINCR
;THIS IS LEXICAL SCANNER'S TABLE OF LINE POINTERS.
GLOB PLIST;
BLOCK 6;
RELOC
END