;
;
;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>&
>
DEFINE N2(NAM)
<
<373737373737>&
>
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, ; PRODUCE DEBUGGER SYMBOLS (TYPE 1044 BLOCKS)
V NOSYMBOLS,,XCTSW,; NO SYMBOL BLOCKS
V NOERRORS,,XCTSW, ; SUPPRESS ERRORS ON TTY
V NOLIST,,XCTSW, ; TURN OFF LISTING
IFN FTSTATS,<
V STATS,,XCTSW, ; STATISTICS
>
IFE FTSTATS,<
V STATS,,SWNYET
>
V LIST,*,XCTSW, ; 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, ; TELL HIM WHAT TO DO
V TEMPCODE,,SETVAL!VALSW,LTCODE ; TEMPCODE BUFFER SIZE
V NUMBERS,,XCTSW, ; SEQUENCE NUMBERS
V NONUMBERS,,XCTSW, ; NO SEQUENCE NUMBERS
V BUFFERS,,SETVAL!VALSW,<7(A1)> ; # I/O BUFFERS
V TRACE,*,SWVOPT,SWTRAC ; TRACE-BUFFER LENGTH
V PRODUCTION,*,XCTSW,
; SUPPRESS DIAGNOSTIC INFO
V CREF,,XCTSW, ; CROSS-REFERENCE LISTING
V NOCREF,,XCTSW, ; NO CREF LISTING
>
SETVAL==200000
VALSW==100000
XCTSW==40000
SWNYET==20000
SWVOPT==10000!VALSW
DEFINE V(A,B,C,D),<
>
SWTAB: SWS ; GENERATE SWITCH NAME TABLE
SWTABN==.-SWTAB ; GET # SWITCHES
DEFINE V(A,B,C,D),<
.ZZZ==0
IFIDN <*>,<
.ZZZ==400000>
IFNB ,<
.ZZZ==.ZZZ!C>
IFN .ZZZ&XCTSW,< ;; GENERATE INSTR, & POINTER
.ZZZ,,[D]>
IFE .ZZZ&XCTSW,< ;; ELSE JUST ENTER VALUE GIVEN
<.ZZZ_^D18>+> >
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 &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 ( 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"] ; 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 ; A
AOS CRFCNT ; ALLOW FOR 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"] ;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 ; 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] ...
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,25464354760