perm filename SYM.OLD[NEW,AIL] blob
sn#410579 filedate 1979-01-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00037 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 HISTORY
C00012 00003 SCAN
C00015 00004 BITDATA (SCNWRD -- LISTING CONTROL, ETC.)
C00021 00005 DATA (SCANNER PARSE TOKENS)
C00033 00006 DSCR main SCANNER Dispatch loop
C00046 00007 ID -- RESET FOR SCAN
C00054 00008 COMMENT -- throw out everything to next semicolon
C00056 00009 DSCR -- USID
C00063 00010 DSCR -- SCNACT
C00073 00011 PUSH PNT,PNEXTC-1 STRING NUMBER
C00077 00012 DSCR STRNG, etc.
C00081 00013
C00084 00014 DEFCHK:
C00096 00015 DSCR SCNUMB -- number scanner
C00109 00016
C00114 00017 Print the last character, then stack the result
C00118 00018 DSCR CSPEC, SEOL, SEOM, SEOB -- Special handling routines
C00122 00019 Cspec, Seol
C00123 00020 CALL SPECIAL ROUTINE, BUT FIRST MAKE SURE CHARACTER COUNT IS
C00130 00021
C00138 00022 END OF BUFFER CODE.
C00140 00023 Parameter delimiter or end of message
C00148 00024 DSCR ADVBUF -- new input buffer routine
C00160 00025 BAIL <
C00163 00026 DSCR --HERE IS THE CREFFINF STUFF (STRANGE PLACE N'EST CE PAS?)
C00170 00027 DSCR HDR, HDROV
C00181 00028 DSCR ENTERS -- make new symbol entry
C00185 00029 ↑ENTERS:
C00191 00030
C00196 00031
C00197 00032 DSCR ADCINS, CREINT, CONINS
C00201 00033 DSCR SHASH, NHASH -- look up symbol entries in hashed buckets.
C00207 00034 SEMBLK Allocation Routines
C00214 00035 RNGVRB, RNGSTR, etc. -- `Ring' Linkage Routines
C00217 00036
C00220 00037 Mark insertion routine for counter routines
C00223 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 102100000046 ⊗;
COMMENT ⊗
VERSION 17-1(38) 4-14-75 BY JFR ANOTHER PASS AT BAIL COORDINATE FIXES P.6
VERSION 17-1(37) 3-1-75 BY RLS CHECK FOR END OF BUFFER IN TENEX ADVBUF (PROB. SHOULD BE ADDED TO DEC ALSO)
VERSION 17-1(36) 2-8-75 BY JFR BAIL SOURCE POINTERS P.6
VERSION 17-1(35) 11-17-74 BY JFR BAIL SOURCE FILE POINTER BUGS P. 6,21
VERSION 17-1(34) 10-16-74 BY JFR FIX BAIL SOURCE FILE COUNTING
VERSION 17-1(33) 10-10-74 BY JFR REVISE WAY BAIL PUTS OUT TEXT FILE POINTERS
VERSION 17-1(32) 9-26-74 BY JFR BAIL INSTALLED 9-19-74. FIX VERSION, AUTHOR, REASON STUFF
VERSION 17-1(31) 9-15-74 BY HJS BUG #TG# PREVENT PARSE STACK OVERFLOW WHEN SCANNING ACTUAL PARAMETERS TO MACROS
VERSION 17-1(30) 5-30-74 BY RLS TENEX FIX #SI# BETTER LISTING FORMAT
VERSION 17-1(29) 5-30-74
VERSION 17-1(28) 5-28-74 BY RHT BUG #SD# NEEDED A FLAG TO DETECT EXTERNAL-INTERNAL CHANGES
VERSION 17-1(27) 4-12-74 BY RHT %BI% ASS RECORD STUFF TO ENTID
VERSION 17-1(26) 3-17-74 BY RLS INSTALL TENEX
VERSION 17-1(25) 3-17-74
VERSION 17-1(24) 2-5-74 BY HJS BUG #RA# ALLOW TEXT PAST FINAL END OF PROGRAM
VERSION 17-1(23) 1-29-74 BY HJS BUG #QV# ASSIGNC PROBLEMS
VERSION 17-1(22) 1-25-74 BY RHT BUG #QO# PNAME MAY BE SPLIT BY STRING SPACE EXPANSION
VERSION 17-1(21) 1-11-74 BY JRL CHANGE MACRO EXPANSION LIST CHARACTER
VERSION 17-1(20) 12-14-73 BY RHT BUG #PZ# A KLUGE THAT NO LONGER WORKED FIXED BY NEW DCS KLUGE
VERSION 17-1(19) 12-14-73
VERSION 17-1(18) 12-7-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS
VERSION 17-1(17) 11-27-73 BY RLS BUG #PF# AVOID DYING IF SOURCE FILE ENDS IN FF
VERSION 17-1(16) 11-27-73
VERSION 17-1(15) 11-25-73 BY JRL FEAT %AN% HAVE SOURCE!FILE SWITCHING CHECK ARG AS STRING CONSTANT
VERSION 17-1(14) 11-16-73 BY HJS BUG #PC# OVERWRITNG FIRST LINE IN CREF
VERSION 17-1(13) 11-10-73 BY KVL MERGE:CORERR
VERSION 17-1(12) 9-24-73 BY HJS BUG #OH# NO CREFFING OF MACRO FORMALS ALLOWED
VERSION 17-1(11) 9-24-73
VERSION 17-1(10) 9-21-73 BY HJS INHIBIT LISTING IN FALSE PART OF CONDITIONAL COMPILATION
VERSION 17-1(9) 9-21-73 BY RHT PATCH UP VERSION STUFF
VERSION 17-1(7) 9-21-73 BY HJS MAKE BUG OG FIX RIGHT
VERSION 17-1(6) 9-19-73 BY HJS BUG #OG# SAVE PNAME COUNT BEFORE SGCOL
VERSION 17-1(5) 9-19-73
VERSION 17-1(4) 9-17-73 BY HJS BUG #OF# MAKE SURE PARSE TOKEN IN AC A WHEN GOING TO STACK
VERSION 17-1(3) 9-17-73
VERSION 17-1(2) 9-17-73
VERSION 17-1(1) 8-14-73 BY RHT TURN JRST .CORERR AT GETTOP BACK TO JRST CORERR
VERSION 16-2(48) 7-12-73 BY HJS SAVE CHARACTER COUNT IN CASE GARBAGE COLLECTION HAPPENS DURING MACRO ACTUAL SCANNING
VERSION 16-2(47) 6-20-73 BY HJS IFCR, REDEFINE, EVALDEFINE, AND ASSIGNC IMPLEMENTATION
VERSION 16-2(46) 6-10-73 BY JRL BUG #MQ# LPNT NOT PROPERLY SAVED FOR BACKUP WHEN SAVCHR=0
VERSION 16-2(45) 6-1-73 BY DCS BUG #MP# KEEP REMCHR HONEST (STRNGC BUG)
VERSION 16-2(44) 3-19-73 BY HJS ALLOW TEMPORARY OVERRIDING OF NULL DELIMITERS MODE
VERSION 16-2(43) 3-13-73 BY JRL REMOVE REFERENCES TO WOM,SLS,GAG,NODIS
VERSION 16-2(42) 3-12-73 BY RHT BUG #LS# OWN THINGS GETTING THE WRONG LEVEL INFO
VERSION 16-2(41) 1-31-73 BY HJS ADD NOEMIT, ACKSAV, AND SBSAV FOR EXPR!TYPE
VERSION 16-2(40) 1-17-73 BY HJS BUG #LC# MACRO FORMALS ARE NOT MACRO REDEFINTION
VERSION 16-2(39) 1-17-73
VERSION 16-2(38) 12-11-72 BY HJS DISABLE ENDC PARSER SWITCH TRIGGER IN WHILEC, CASEC, FORC, AND FORLC BODIES
VERSION 16-2(37) 12-2-72 BY HJS SAVE BITS DURING CONDITIONAL COMPILATION AND MACRO DEFINITIONS (CBTSTK AND DBTSTK)
VERSION 16-2(36) 11-20-72 BY JRL FIX SUGG BY R. SMITH AT CHKPRC
VERSION 16-2(35) 11-19-72 BY HJS BUG #JZ# CORRECTION - MACRO REDEFINITION AND RESERVED WORD REDEFINITION IN ENTERS
VERSION 16-2(34) 11-15-72 BY HJS INSERT DEFDLM QSTACK FOR DEFLUK BIT OF FF FOR COMPILE-TIME MACROS WITHIN MACROS
VERSION 16-2(33) 11-5-72 BY DCS BUG #JZ# CHANGE MACRO SCOPE RULES
VERSION 16-2(32) 11-3-72 BY DCS SIMILARLY, ALLOW ALL EXTERNALS TO OVERRIDE
VERSION 16-2(31) 11-2-72 BY DCS BUG #JX# ALLOW INTRNL PROC TO OVERRIDE EXTRNL ONE.
VERSION 16-2(30) 10-24-72 BY HJS EMIT ERR MSG FOR UNINIT MACRO VAR USE
VERSION 16-2(29) 7-5-72 BY DCS BUG #IF# FIX SOME GOERGE BUGS
VERSION 15-6(18-28) 7-5-72
VERSION 15-6(17) 3-10-72 BY DCS REPLACE RING,ULINK MACRO WITH VARIOUS ROUTINES
VERSION 15-6(8-16) 3-9-72
VERSION 15-6(7) 2-21-72 BY HJS THE BRAVE NEW PARSER WORLD
VERSION 15-2(6) 2-18-72 BY DCS BUG #GP# CHECK OLD FORMALS AGAINST NEW FORMALS
VERSION 15-2(5) 2-5-72 BY DCS BUG #GJ# ADD LSTON LIST-CONTROL STUFF
VERSION 15-2(4) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR
VERSION 15-2(3) 2-1-72 BY DCS BUG #GE# LPSBOT FROM USER TABLE TO COMPILER DATA
VERSION 15-2(2) 12-22-71 BY DCS BUG #FT# PROVIDE LINE NUMBER IF NOT SOS FILE
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
SUBTTL SCAN
LSTON (SYM)
BEGIN SYM
DSCR SCANNER -- get next "ATOM" from source file
CAL PUSHJ from PARSE (or recursively)
PAR PNEXTC is bp to next input char (from file or macro)
SAVCHR, if non-zero, is a scan-ahead char which should
be considered first.
File variables, Listing variables used by I/O part.
Define stack, variables, macro semantics used when
recurring into macros
RES The ATOM will be either:
1. An operator or other character atom, in which case
the Parse token representing it will be placed in the
parse stack, a 0 in the generator stack (null entry).
2. A reserved word, in which case the Parse token will be
placed on the parse stack from the word's symbol
entry, and again a null semantic entry will be stacked.
3. An IDENTIFIER, in which case the Parse token for the appro-
iate class of IDs will appear on the parse stack, the
Semantics for the symbol on the generator stack. If the
symbol is undefined, a 0 is represents null Semantics.
4. A STRING or numeric constant. These entities are ENTERed
in their respective symbol tables if previously
undefined, and the stacks are set up as above.
In all cases, the semantic entry will be repeated in the cell
NEWSYM. In those cases where a hash was made, the
MOVE or MOVS instr to fetch the list on which the symbol
appears (or will appear after ENTERy) is located in
the cell HPNT. For string constants or identifiers, the
string identifier is left in PNAME, PNAME+1. For numeric
arguments, the value is left in SCNVAL. DBLVAL is zeroed
in these cases.
SID SCANNER uses temporary ACs indiscriminately, so look out for it.
Many variables are changed as a result of calling SCANNER.
⊗
BITDATA (SCNWRD -- LISTING CONTROL, ETC.)
Comment ⊗ SCAN table -- good bits that make the whole thing work ⊗
↑↑LSTEXP←←400000 ;ON IF "<"-">" PAIRS TO BE PRINTED
↑↑MACEXP←←200000 ;EXPAND MACRO TEXTS
↑↑MACLST←←100000 ;LIST MACRO NAMES BEFORE EXPANSION
↑↑LINESO←← 40000 ;ON IF LINE NUMBERS SHOULD BE PRINTED
↑↑PCOUT ←← 20000 ;ON IF PCNT SHOULD BE PRINTED
↑↑CREFIT←← 10000 ;ON IF A CREF S HAPPENING
↑↑MACIN ←← 4000 ;ON IF IN A MACRO EXPANSION
↑↑EOFOK ←← 2000 ;ON IF CAN GET EOF WITHOUT FATALITY
↑↑BACKON←← 1000 ;ON IF LISTING BACK ON AFTER PARAM RESCAN
↑↑LOKPRM←← 400 ;ON IF LOOKING FOR POSSIBLE MACRO PARAM
↑↑RDYPRM←← 200 ;GETTING READY FOR MACRO PARAM (RANSCN)
↑↑INLIN ←← 100 ;TREAT @ AS DELIMITER IN IN-LINE CODE
↑↑INSWT ←← 40 ;WE'RE SCANNING A SWITCHED-TO SOURCE FILE
↑↑NOLIST←← 1 ;ON IN RH IF NO LISTING HAPPENING NOW
BITDATA (SCANNER TABLE)
SPCL ←←400000 ;NOT A LETTER OR DIGIT
ATSIGN←← 20000 ;@ -- REAL EXPONENT COMING
AOSSOS←← 20000 ;BIT DIFFERENTIATING BETWEEN AOS AND SOS FOR NESTING
; DELIMITERS COUNT
DOT ←← 10000 ;. -- DECIMAL POINT
NUMB ←← 4000 ;NUMBER OR NUMBER PART (ONE OF ABOVE TWO)
DIG ←← 2000 ;0 THRU 9
LETDG ←← 1000 ;REQUIRES SPECIAL TREATMENT
QUOTE ←← 400 ;" -- STRING CONSTANT DELIMITER
↑NEST ←← 200 ; NESTABLE CHARACTER
↑LNEST ←← 100 ; LEFT NESTED CHARACTER
QUOCTE←← 40 ;' -- OCTAL NUMBER COMING
; BITS FOR NUMBER SCANNER
INTOV ←←200000 ;INTEGER OVERFLOW
REALOV←←100000 ;REAL OVERFLOW
EXPNEG←← 40000 ;NEGATIVE EXPONENT
NUMNST ←←3 ; NUMBER OF NESTABLE CHARACTERS
RPAROF ←←2 ; RIGHT PAREN OFFSET FOR LOCNST ENSTRY
↑NUMCHA ←←200 ; NUMBER OF CHARACTERS
↑DELNUM ←←4 ; NUMBER OF DELIMITERS AS INPUT TO REQ. DEL.
TABCONDATA (SCANNER CHARACTER TABLE)
DEFINE IGL <XWD SPCL,IGLCHR>
DEFINE OPER <.-SCNTBL>
DEFINE LTR <XWD LETDG,.-SCNTBL>
DEFINE NESTED <<XWD NEST,0>>
DEFINE LNESTD <<XWD NEST+LNEST,0>>
↑SCNTBL:
XWD SPCL,SEOB ;0 -- END OF BUFFER
LTR ;DWNARROW
LTR ;ALPHA
LTR ;BETA
RAND ;AND
RNOT ;NOT
RIN ;ELEMENTOF
REPEAT 2,<LTR > ;PI, LAMBDA
0 ;TAB
XWD SPCL,SEOL ;LF -- END OF LINE
0 ;VTAB
XWD SPCL,SEOP ;FF -- END OF PAGE
0 ;CARRIAGE RETURN
RINF ;INFINITY.
LTR ;PARTIAL, LEFTHORSESHOE,RGHTHORSESHOE
REPEAT 2,<LTR >
RINTER ;INTERSECT
RUNION ;UNION
LTR ;FOREACH
LTR ;EXISTS
RXOR
RSWAP ;BOTHWAYSARROW
LTR ;UNDERLINE ?
LTR ;RGT ARRW
RAND ;STANFORD TILDE (AND)
RNEQ ;NTEQUAL
RLEQ ;LTEQUAL
RGEQ ;GTEQUAL
REQV ;EQUIVALENCE
ROR ;OR
0 ;SPACE
XWD LETDG,30 ;! -- SAME AS UNDERLINE.
XWD QUOTE,.-SCNTBL ; "
LTR ;#
LTR ;$
TPRC ; %
TANDD ;&
XWD LETDG+NUMB+QUOCTE,.-SCNTBL ; '
LNESTD+TLPRN ; (
NESTED+TRPRN ; )
TTIMS ;*
TPLUS ;+
TCOMA ;,
TMINUS ;-
XWD LETDG+NUMB+DOT,.-SCNTBL ; .
TSLSH ; /
REPEAT 12,<XWD LETDG+NUMB+DIG,.-SCNTBL> ;DIGITS
TCOL ; :
TSEMI ; ;
TLES ; <
TEQU ; =
TGRE ; >
TQUES ;?
XWD LETDG+NUMB+ATSIGN,.-SCNTBL ; @
REPEAT =26,<LTR> ;UPPER CASE LETTERS
LNESTD+TLBR ; [
LTR ; TILDE
NESTED+TRBR ; ]
TUPRW ;↑
TLARW ;←
RASSOC ;`
REPEAT =26,<LTR-40> ;LOWER CASE LETTERS
LNESTD+RSETO ; {
TVERT ; |
NESTED+RSETC ; RIGHT CURLY BRACKET
NESTED+RSETC ; RIGHT CURLY BRACKET
; 175 AND 176 WILL BOTH BE CURLY BRACKETS FOR A WHILE.
XWD SPCL,EOM ;177 -- END MACRO OR PARAM
ENDSCN←.
DATA (SCANNER PARSE TOKENS)
COMMENT ⊗
These variables provide symbolic access to the PARSE token
numbers for several delimiter characters -- they are used in
those cases where the SCANNER or some EXEC needs to examine
a value directly
⊗
%ATS: TINDR ;BITS FOR @ DELIMITER IN INLINE(SEE SCNUMB)
%COMMENT: RCOMME+1B0
↑↑%ID: TI
%NUMCON: TICN ;ARITHMETIC CONSTANT.
%SEMICOL: TSEMI
↑↑%STCON:TSTC ;STRING CONSTANT.
ZERODATA (SCANNER VARIABLES)
BAIL<
↑↑BCORDN: 0 ;DEBUGGER COORDINATE NUMBER. RIGHT HALF CONTAINS CURRENT
;COORDINATE, LEFT HALF IS ZERO IF WE ARE NOT NOW PUTTING OUT
;COORDINATES TO THE .SM1 FILE, AND NON-ZERO IF WE ARE.
BCRDW1: 0 ;SPACE TO SAVE COORD INFO TO BE WRITTEN TO .SM1 FILE, SINCE
BCRDW2: 0 ; LOCATION MUST BE MARKED AT BEGINNING OF STATEMENT, BUT
; WE DONT KNOW IF WE WANT A COORD UNTIL THE END OF STATEMENT
>;BAIL
↑↑DEFRN2: 0 ;TEMP RING-VARIABLE WHILE SCANNING MACRO ACTUAL PARAMS
;FLTVAL -- collect floating point equiv while scanning number
?FLTVAL: 0
COMMENT ⊗
HPNT, HSPNT -- When the hashing routines (SHASH, NHASH) locate the
right bucket pointer in the appropriate bucket Semblk, they create
a [HRR LPSA,addr] or [HLR LPSA,addr] instruction which will fetch
this pointer, and put it into HPNT -- also leaving it in LPSA. They
then execute the instruction to begin their lookup phases. ENTERS
again uses this pointer when adding a new Semblk to a bucket -- first
as is, to fetch the old pointer, then modified to HRRM or HRLM, to
update the bucket.
HSPNT is the saved HPNT value for the last string constant scanned.
The "string constant as comment" EXEC uses it to remove the constant
from the bucket (provided, of course, that it hasn't also been used
as a string constant).
⊗
↑HPNT: 0
↑HSPNT: 0
↑↑LOCMBD: BLOCK 2 ; MACRO BODY DELIMITERS BLOCK
↑↑LOCMPR: BLOCK 2 ; MACRO PARAMETER DELIMITERS BLOCK
BAKDLM: 0 ; A FLAG WHICH IS SET TO -1 IF DLMSTG IS ON
; (I.E. ONE WANTS A DELIMITED MACRO BODY)
; AND QUOTES ARE USED INSTEAD BECAUSE A
; REQUIRE NULL DELIMITERS STATEMENT WAS NOT
; USED.
↑↑CURMBG: 0 ; CURRENT MACRO BODY BEGIN DELIMITER
↑↑CURMED: 0 ; CURRENT MACRO BODY END DELIMITER
↑↑CURPBG: 0 ; CURRENT PARAMETER BEGIN DELIMITER
↑↑CURPED: 0 ; CURRENT PARAMETER END DELIMITER
↑↑DELSTK: 0 ; DELIMITER "BLOCK-STRUCTURE" STACK
↑↑LOKDLM: 0 ; DLMSTG (LOOKING FOR DELIMITERS FLAG) QSTACK
↑↑DEFDLM: 0 ; DEFLUK (SCANNING A MACRO BODY OR LOOKING FOR
; ACTUAL PARAMETERS) QSTACK
↑↑CBTSTK: 0 ; POINTER TO QSTACK FOR SAVING BITS WHILE SCANNING
; CONDITIONAL COMPILATION EXPRESSIONS
↑↑DBTSTK: 0 ; POINTER TO QSTACK FOR SAVING BITS WHILE SCANNING
; MACRO DEFINITIONS
↑↑ENDCTR: 0 ; POINTER TO QSTACK INDICATING WHETHER OR NOT ENDC
; SHOULD TRIGGER A PARSER SWITCH (NO IF ONE IS
; SCANNING A WHILEC, CASEC, FORC, OR FORLC BODY)
↑↑REQDLM: 0 ; REQUIRE DELIMITER STATEMENT SEEN FLAG
↑↑SWBODY: 0 ; SPECIAL DELIMITER DEFINITION SEEN
↑↑BNSTCN: 0 ; NESTED DELIMITER COUNT
↑↑LOCNST: BLOCK NUMNST ; NESTABLE CHARACTERS BLOCK
↑↑NSTABL: BLOCK NUMCHA ; NESTABLE CHARACTERS ADDRESS INDEX BLOCK
↑↑NOEMIT: 0 ; DON'T EMIT CODE FLAG FOR THE EMITTER
↑↑ACKSAV: BLOCK 13 ; SAVE ACKTAB HERE WHILE EVALUATING EXPR!TYPE
↑↑SBSAV: BLOCK 13 ; SAVE $SBITS CORRESPONDING TO ACKSAV VALUES WHILE
; EVALUATING EXPR!TYPE (AVOIDS HARMFUL SIDE
; EFFECTS OF CODE GENERATORS)
↑↑ADPTSV: 0 ; ADEPTH VALUE BEFORE EXPR!TYPE PROCESSING
↑↑PCNTSV: 0 ; PCNT VALUE BEFORE EXPR!TYPE PROCESSING
↑↑SDPTSV: 0 ; SDEPTH VALUE BEFORE EXPR!TYPE PROCESSING
↑↑RSTDLM: 0 ; TEMPORARY OVERRIDING OF NULL DELIMITERS MODE FLAG
↑↑RECSTK: 0 ; POINTER TO QSTACK INDICATING WHETHER MACROS SHOULD
; BE EXPANDED IN THE FALSE PART OF CONDITIONAL
; COMPILATION
↑↑IFCREC: 0 ; FLAG INDICATING WHETHER MACROS SHOULD BE EXPANDED IN
; THE FALSE PART OF CONDITIONAL COMPILATION
NULCNT: 0 ; COUNTER INDICATING THE NUMBER OF ACTUAL PARAMETERS
; THAT HAVE NOT BEEN SPECIFIED AT THE END OF THE LIST OF
; ACTUALS IN A MACRO CALL. THEY ARE TREATED AS IF THEY
; HAD BEEN THE NULL STRING (AS DONE AT CMU)
↑↑LPTRSV: 0 ; SAVE WORD FOR LISTING BUFFER POINTER SO THAT
; FALSE PART OF CONDITIONAL COMPILATION DOES NOT
; GET LISTED
↑↑LSTSTK: 0 ; POINTER TO QSTACK INDICATING WHETHER OR NOT ONE
; IS IN THE FALSE PART OF CONDITIONAL COMPILATION
↑↑CNDLST: 0 ; FLAG INDICATING IF ONE IS IN THE FALSE PART OF
; CONDITIONAL COMPILATION
;;%CI% (1/5) JFR 7-18-75
TRKMCR: 0 ;ADDR OF $PNAME+1 OF CURRENT MACRO NAME
TRKMCS: 0 ;SAME FOR LAST MACRO IN SOURCE FILE
TRKM.P: 0 ;PAGE # OF LAST MACRO IN SOURCE FILE
TRKM.L: 0 ;ASCLIN # OF LAST MACRO IN SOURCE FILE
↑↑TRKBEG: 0 ;PTR TO SECOND BLOCK SEMBLK OF CURRENT BLOCK
;FOR INFORMATIVE ERROR MESSAGES, "FATAL EOF"
;;%CI% ↑
;; #RA# (1 OF 2) !
↑↑EOFCEL: 0 ; FLAG INDICATING FINAL END OF PROGRAM SEEN
BAIL <
↑↑BSRCFC: 0 ; BUFFER ADDR,,BLOCK COUNT FOR SOURCE FILE
↑↑BNSRC: 0 ; NUMBER OF SOURCE FILES SEEN
↑↑BSRCFN: 0 ; CURRENT SOURCE FILE NUMBER
↑↑BSRCFQ: 0 ; QSTACK FOR REQUIRE SAVING
↑↑BLSTFC: 0 ; WORD COUNT FOR LISTING FILE
↑↑BPPCNT: 0 ; PREVIOUS PROGRAM COUNTER
>;BAIL
IFN FTL$DBG,<
↑↑L$CNT: 0 ;#CHARS LEFT IN LSTBUF
>;IFN FTL$DBG
ENDDATA
DSCR LSTDPB
⊗
DEFINE LSTDPB < ;OUTPUT CHAR TO LISTING FILE IF REQD
TRNN TBITS2,NOLIST ;IS LISTING HAPPENING, BABY?
ML$CHR ;YES, DO THE REQUIRED THING
>
IFE FTL$DBG,<
DEFINE ML$CHR <IDPB B,LPNT>
DEFINE ML$BAK <MOVEM SBITS2,LPNT>
>;IFE FTL$DBG
IFN FTL$DBG,<
DEFINE ML$CHR <PUSHJ P,L$CHR>
DEFINE ML$BAK <PUSHJ P,L$BAK>
L$CHR: SOSGE L$CNT ;ADD CHAR IN B TO LSTBUF, CHECKING OVERFLOW
ERR <LSTBUF OVERFLOW>,1
IDPB B,LPNT
POPJ P,
5*<POINT 7,0,-1>-5 ↔ 0 ↔ 0 ↔ 0 ↔ 0
L$TAB: 5*<POINT 7,0,34>-4
5*<POINT 7,0,27>-3
5*<POINT 7,0,20>-2
5*<POINT 7,0,13>-1
5*<POINT 7,0,06>-0
L$BAK: ;BACK UP LPNT TO SBITS2, CHECKING AND COUNTING
CAMN SBITS2,LPNT
POPJ P, ;FREQUENT SPECIAL CASE
PUSH P,LPSA
PUSH P,LPSA+1
MOVE LPSA,SBITS2 ;SUPPOSED BACK BP
MULI LPSA,5 ;HAKMEM STRIKES AGAIN (PROG. HAX,ITEM 165-FREIBERG)
SUB LPSA+1,L$TAB(LPSA) ;LPSA+1 IS NOW CHAR ADDR
PUSH P,LPSA+1
MOVE LPSA,LPNT ;CURRENT BP
MULI LPSA,5
SUB LPSA+1,L$TAB(LPSA)
CAML LPSA+1,(P) ;CURRENT CHR ADDR MUST BE ≥ BACKUP
JRST L$BAK1
ERR <LPNT FORWARD "BACKUP">,1
JRST L$BAK2
L$BAK1: MOVEM SBITS2,LPNT ;BACKUP BP
SUB LPSA+1,(P)
ADDM LPSA+1,L$CNT ;AND CNT
L$BAK2: SUB P,X11
POP P,LPSA+1
POP P,LPSA
POPJ P,
>;IFN FTL$DBG
;;#YV# JFR 2-4-77 SET 'NOLIST' FROM ABSOLUTE BEARINGS
↑↑L$SET:TLNE FF,LISTNG ;.LST FILE EXIST?
SKIPE CNDLST ;CHECK FOR EXPLICIT NO LIST OF COND. COMP.
JRST L$NO
MOVE TEMP,FMTWRD
TLNE FF,PRMSCN
TLNE TBITS2,MACLST ;SCANNING PRMS, NOT LISTING MACRO NAMES, DONT LIST ARGS EITHER
TRNE TEMP,40 ;USER MIGHT HAVE EXPLICITLY TURNED IT OFF
JRST L$NO
TLNE TBITS2,MACIN
TLNE TBITS2,MACEXP ;IN A MACRO, NOT LISTING EXPANDED TEXTS
TLNE TBITS2,LOKPRM
L$NO: TROA TBITS2,NOLIST ;HUNTING PRM, OR IN MACRO AND NOT LISTING EXPANSIONS
TRZ TBITS2,NOLIST ;YES LIST
POPJ P,
DSCR main SCANNER Dispatch loop
RES gets first char from SAVCHR or PNEXTC, dispatches to
routine to handle what it found (IDENT, STRING, DELIM, etc.)
⊗
↑SCANNER:
MOVE TBITS2,SCNWRD ; SET UP SCANNER PARAMS
;; #RA# (2 OF 2)
SKIPE EOFCEL ; FINAL END OF PROGRAM SEEN?
JRST [TLO TBITS2,EOFOK ;
MOVEM TBITS2,SCNWRD ;
JRST .+1];
;; #RA#
TLZE FF,BAKSCN ;IS SCANNER BACK ONE CHARACTER ??
JRST GOAGAIN ; DO IT.
MOVE USER,GOGTAB ;USER DATA TABLE ADDR FOR STRING STUFF
TLNE TBITS2,INLIN ;SPECIAL START!CODE FEATURE?
SETZM PNAME ;YES, ASSURE NO PNAME USED
;;#MQ# SET UP SBITS2 FOR BACKING UP LPNT EVEN IF HAVE SAVCHR≠0
MOVE SBITS2,LPNT
MOVEM SBITS2,LPTRSV ; SAVE IN CASE IN FALSE PART OF COND. COMP.
MOVEI C,0 ;WILL COUNT CHARS FOR IDENTS
SKIPE B,SAVCHR ;IS ANYTHING LEFT OVER?
JRST SPCHAR ;YES, DISPATCH AS FIRST CHAR
TLNN FF,PRMSCN ;SCANNING MACRO PARAMETERS?
JRST DISPT ; NO
TRNA ;SKIP IDPB
ML$CHR ;TO LISTING FILE
DSPRM: ILDB B,PNEXTC ;SKIP IGNORABLE CHARACTERS
SKIPGE A,SCNTBL(B) ;ANYTHING SPECIAL REQUIRED?
PUSHJ P,(A) ;YES, DO IT
JUMPE A,DSPRM-1(TBITS2) ;MAYBE LIST, GET NEXT IGNORABLE
DSPR1: TLO FF,PRMXXX ;SET SPECIAL PARAM SCANNING BIT
TLNE A,QUOTE ;DOES HE WANT COMPLETE FREEDOM?
JRST STRLST ; YES, GIVE IT TO HIM (FIRST LIST `"')
PUSHJ P,INSET ;NO, SPECIAL MODE -- "," OR ")" WILL BREAK
JRST BAKSTR ;AROUND QUOTE DELETION
ML$CHR ;TO LIST FILE
DISPT: ILDB B,PNEXTC ;GET FIRST CHAR
SKIPGE A,SCNTBL(B) ;GET GOOD BITS, CHECK SPECIAL
PUSHJ P,(A) ;SPECIAL, HANDLE IT
JUMPE A,DISPT-1(TBITS2) ;BLANKS AND OTHER IGNORABLES
MOVE SBITS2,LPNT ;SAVE IN CASE BACKUP MUST HAPPEN
MOVEM SBITS2,LPTRSV ; SAVE IN CASE IN FALSE PART OF COND. COMP.
STRLST: LSTDPB ;TO LISTING FILE IF REQD
SPCHAR: SETZM SAVCHR ;NOTHING LEFT OVER YET
SETZM LSTCHR
JUMPL B,[TLZN TBITS2,EOFOK ;OK FOR EOF HERE?
ERR <FATAL END OF SOURCE FILE> ;NO
MOVE A,%EOFILE ;YES, RETURN `EOF'
JRST CHAROUT] ;NULL SEMANTICS
SKIPN A,SCNTBL(B) ;GET GOOD BITS (DON'T DISPATCH AGAIN!)
JRST DISPT ; IGNORABLE, FIND ONE THAT ISN'T
SKIPE DLMSTG ; LOOKING FOR SPECIALLY DELIMITED STRING?
CAME B,CURMBG ; POSSIBLY, MACRO BODY BEGIN DELIMITER?
JRST CONCHK ; GO DO A NORMAL SCAN
SETZM BNSTCN ; SET DELIMITER NEST COUNT TO ZERO
JRST STRNG ; GET MACRO BODY
BAIL<
↑↑BMKSRC:
MOVE TEMP,BAILON
TRNN TEMP,BBCRD ;SKIP IF WE WANT COORDS
POPJ P,
PUSH P,A
PUSH P,B
PUSH P,C ;WE ARE IN THE HEART OF THE SCANNER, SO BEWARE
;;%##% 1! JFR 4-18-76
PUSH P,D
MOVE TBITS2,SCNWRD ;PICK UP SCANNER FLAGS
TRNN TBITS2,NOLIST ;LISTING IN PROGRESS?
JRST BCRDLS ;YES
;;#%%# JFR 2-8-75 FIX THIS CRUFFT FOR MACROS AND CONDITIONAL COMPILATION
TLNE TBITS2,MACIN ;IN A MACRO?
JRST BCRDN2 ;YES, UPDATE COUNTERS ONLY, NOT POINTERS
HRRZ TEMP,PNEXTC
HRRZ SBITS,SRCPNT
SUBI TEMP,(SBITS)
CAIL TEMP,1
CAILE TEMP,200 ;SRCPNT IS A WORD EARLY
JRST BCRDN2 ;PNEXTC IS OUT IN THE BOONIES
;;#%%# ↑
MOVE TEMP,PNEXTC
MOVEM TEMP,BPNXTC ;SAVE BYTE POINTER
HRR SBITS,BSRCFC ;BLOCK COUNT FOR SOURCE FILE
HRRZ A,BPNXTC ;ADDR OF CURRENT WORD IN BUFFER
;;#%%# BY JFR 11-17-74 CORRECT COMPUTATION OF WORD OFFSETS
HRRZ B,SRCPNT ;WORD EARLY POINTER
ADDI B,1 ;CORRECT
;;#%%# ↑
LDB C,[POINT 5,BSRCFN,35-0] ;FILE NUMBER
LDB D,[POINT 6,BPNXTC,35-30] ;"P" PORTION OF BYTE POINTER
JRST BCRDN1
BCRDLS:
NOTENX<
LDB SBITS,[POINT 18,BLSTFC,35-7] ;BLOCK COUNT FOR LIST FILE
ADDI SBITS,1 ;FIRST BLOCK IS 1, NOT 0
HRRZ A,LPNT ;ADDR OF CURRENT WORD IN BUFFER
HRRZ B,LSTBUF ;ADDR OF FIRST WORD
LDB D,[POINT 6,LPNT,35-30] ;"P" PORTION OF BYTE POINTER
>;NOTENX
TENX<
MOVE A,BLSTFC ; CHAR COUNT FOR LIST FILE
IDIVI A,5 ;WORD COUNT IN A, REMAINDER IN B
SUBI B,5 ;BEGIN CONSTRUCTION OF "P" OF BYTE POINTER
MOVM D,B
IMULI D,7
ADDI D,1 ;FINISHED
LDB SBITS,[POINT 18,A,35-7] ;BLOCK COUNT FOR FILE
ADDI SBITS,1
ANDI A,177 ;WORD OFFSET IN A
SETZ B, ; FAKE IT FOR BCRND1
>;TENX
SETZ C, ;LIST FILE IS NUMBER 0
BCRDN1: SUBI A,(B) ;WORD OFFSET IN BUFFER
;;
TLCE TBITS2,PCOUT!LINESO
ADDI A,2 ;PC OR SOS LINE NUMBER GIVES 2 EXTRA WDS
TLCN TBITS2,PCOUT!LINESO
ADDI A,1 ;BOTH GIVE 3
;;
DPB A,[POINT 7,SBITS,35-18] ;INSERT WORD OFFSET
DPB C,[POINT 5,SBITS,35-25] ;INSERT FILE NUMBER
DPB D,[POINT 6,SBITS,35-30] ;INSERT "P" POINTER
MOVEM SBITS,BCRDW1 ;SAVE
BCRDN2: HRL SBITS,BCORDN ;COORD NUMBER
;SEE IF ANYTHING IS IN THE ACS
MOVSI TEMP,-20 ;LENGTH OF ACKTAB
MOVE A,ACKTAB(TEMP)
JUMPE A,.+3 ;JUMP IF VACANT
ADDI A,1
JUMPN A,.+3 ;JUMP IF NOT PROTECTED, I.E. BUSY
AOBJN TEMP,.-4 ;LOOP
TLO SBITS,400000 ;MARK AS ALLSTO
HRR SBITS,PCNT
MOVEM SBITS,BCRDW2 ;SAVE
BXCRD:
;;%##% 1! JFR 4-18-76
POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
↑↑BCROUT: ;PUT COORD OUT TO .SM1 FILE IF NECESSARY
;;%##% 1! JFR 4-18-76
SKIPE TEMP,BPNXTC ;DONT PUT ONE OUT IF TEXT NOT MARKED YET
SKIPLE TEMP,BAILON ;SKIP IF BAIL OFF
TRNN TEMP,BBCRD ;SKIP IF WE WANT COORDS
POPJ P,
MOVE TEMP,PCNT
SKIPN NOEMIT ;NO COORDS FOR EXPR TYPE
CAMN TEMP,BPPCNT ;NO SKIP IF PCNT SAME AS BEFORE
BCRPJ: POPJ P,
SETZM BPNXTC ;REMEMBER TO MARK SOURCE AT NEXT TOKEN
EXCH TEMP,BPPCNT ;UPDATE, KEEP OLD VALUE
JUMPE TEMP,BCRPJ ;FIRST TIME THROUGH IS JUST SETUP
PUSH P,A
PUSH P,B
PUSH P,C ;TAKE CARE IN SCANNER
;;%##% 1! JFR 4-18-76
PUSH P,D
AOS A,BCORDN ;INCREMENT COORD COUNT
TLOE A,1 ;IS CURRENT TABLE OF .SM1 FILE A COORD TABLE?
JRST BCROU1 ;YES
MOVEM A,BCORDN ;UPDATE
SETZ SBITS,
PUSHJ P,VALOUT ;END PREVIOUS TABLE OF .SM1 FILE
MOVEI SBITS,BAICRD
PUSHJ P,VALOUT ;START COORD TABLE
BCROU1: MOVE SBITS,BCRDW1
PUSHJ P,VALOUT ;FIRST WORD
MOVE SBITS,BCRDW2
PUSHJ P,VALOUT ;SECOND WORD
JRST BXCRD
>;BAIL
CONCHK:
;;%DI% 3! JFR 12-2-75 CLEAN UP BEGINNING OF COORDINATE, ESP. FOR "CASE"
BAIL< SKIPN BPNXTC ;IF SOURCE NOT MARKED
PUSHJ P,BMKSRC ; THEN DO SO
>;BAIL
TLNE A,LETDG ; LETTER OR NUMBER?
JRST CHKNUM ; YES, GO SEE WHICH
BAIL<
CAIN B,";" ;TEST FOR END OF STATEMENT
PUSHJ P,BCROUT ;YES. PUT OUT COORDINATE
>;BAIL
;;\UR#4\ ALLOW := FOR ←, >= FOR GEQ, <= FOR LEQ , ** FOR ↑
CAIN B,":"
JRST [PUSHJ P,[SNEAKC:
ILDB B,PNEXTC ; PICK UP NEXT CHARACTER
SKIPGE A,SCNTBL(B); MAKE SURE NOT END OF BUFFER ETC.
PUSHJ P,(A) ; IF IS. HANDLE IT.
TRNN TBITS2,-1 ; LISTING?
ML$CHR ; YEP.
POP P,TEMP ;RETRIEVE PTR TO ARGS
MOVE A,@(TEMP) ;ASSUME THIS
CAMN B,1(TEMP) ;DOES 2ND CHAR MATCH?
JRST CHAROUT ;YES, ASSUMPTION CORRECT
MOVEM B,SAVCHR ;ASSUMPTION WRONG. SAVE 2ND CHAR
MOVEM B,LSTCHR
MOVE A,@2(TEMP) ;GET ORIGINAL SEMANTICS
JRST CHAROUT] ;AND LEAVE
SCNTBL+"←" ;ASSUME SEMANTICS OF ←
0,,"=" ;2ND CHAR OF := IS "="
SCNTBL+":" ;SEMANTICS IN CASE ASSUMPTION OF ← FAILS
]
CAIN B,76 ;a GREATER THAN CHAR
JRST [PUSHJ P,SNEAKC
SCNTBL+"≥" ;ASSUME WE REALLY HAVE GEQ
0,,"=" ;2ND CHAR IS "="
SCNTBL+76] ;ASSUMPTION FAILS, WE HAVE GTR
CAIN B,74
JRST [PUSHJ P,SNEAKC
SCNTBL+"≤"
0,,"="
SCNTBL+74]
CAIN B,"*"
JRST [PUSHJ P,SNEAKC
SCNTBL+"↑"
0,,"*"
SCNTBL+"*"]
;;\UR#4\
TLNN A,QUOTE ;STRING CONSTANT?
JRST CHAROUT ; NO, OPERATOR, OUTPUT ID, NULL SEMANTICS
;;#XO# ! JFR 10-14-76
TLZ TBITS2,EOFOK ;saw a " char, must see another
; (particularly after final END "FOO )
SKIPN DLMSTG ; HAS A QUOTE BEEN USED TO DELIMIT A MACRO
; BODY WHILE IN REQUIRE DELIMITERS MODE?
JRST STRNG ; NO, SCAN A STRING CONSTANT IN NORMAL MODE.
SETZM DLMSTG ; YES, TURN OFF DLMSTG FLAG AND TURN ON
SETOM BAKDLM ; BAKDLM FLAG SO THAT WHEN SCANNING THE
JRST STRNG ; MACRO BODY A QUOTE WILL BREAK THE SCAN.
CHKNUM: TLNE A,NUMB ;NUMBER PART?
JRST SCNUMB ; YES, SCAN NUMBER
; ID -- RESET FOR SCAN
DSCAN: PUSHJ P,INSET ;CLEAR PNAMES, COUNT, ALIGN TO FW
BAIL<
SKIPN BPNXTC ;DOES DEBUGGER KNOW WHERE WE ARE?
PUSHJ P,BMKSRC ;NO -- GO MARK PLACE
>;BAIL
MOVE TBITS2,SCNWRD ;MAKE SURE THE BITS ARE RIGHT
TLO TBITS2,EOFOK ;EOF CAN END THE WORLD WITHOUT KILLING IT
MOVEI C,1 ;ACCOUNT FOR FIRST CHARACTER
TRNA
ML$CHR ;TO LISTING FILE
IDSCAN: IDPB A,TOPBYTE(USER) ;STORE CONVERTED CHAR
ILDB B,PNEXTC ; GET NEXT CHARACTER
SKIPGE A,SCNTBL(B) ;GET GOOD BITS, CHECK SPECIAL
PUSHJ P,CSPEC ;SPECIAL, DO SOMETHING
TLNE A,LETDG ;DONE WITH ID?
AOJA C,IDSCAN-1(TBITS2) ;NO, GO GET MORE.
Comment ⊗ Now the symbol is in string space, pointed to
by the string descriptor in PNAME, etc. Store the
count, make the lookup, set up the results ⊗
CAIE B,12 ;IF LF, ALREADY HANDLED, LEAVE SAVCHR 0
MOVEM B,SAVCHR ;SAVE THE BREAK BITS (0 IF BLANK OR CR BROKE)
MOVEM B,LSTCHR ;ALSO HERE ANY TIME
TLZ TBITS2,EOFOK ;DONE WITH THIS MODE
PUSHJ P,UPDCNT ;UPDATE PNAME CNT, REMCHR CNT, COLLECT IF NECC.
MOVE LPSA,SYMTAB ;TRY TO FIND IT
PUSH P,B ;SAVE FOR LATER
PUSHJ P,SHASH ;LIKE SO
POP P,B ;GET IT BACK
MOVEM TBITS2,SCNWRD ;SAVE ANY CHANGES
TLNE TBITS2,LOKPRM ;STACK IT?
POPJ P, ; NO, IN STRING CONSTANT MODE
; GET RELEVANT DATA TO STACKS
MOVE A,%ID ;IT IS AN IDENTIFIER
SKIPG LPSA,NEWSYM ;IF IT IS UNDEFINED,
JRST LSTACK ; PUSH TO STACKS
MOVE TBITS,$TBITS(LPSA)
;IF CREFFING, DO IT NOW...
TLNE FF,CREFSW ;
PUSHJ P,LCREFIT
JUMPGE TBITS,USID ; NO, USER ID
LSTDPB
MOVE A,TBITS ;RESULTANT PL-ID
;;%CI% ! JFR 7-26-75
MOVEI TEMP,$PNAME+1(LPSA) ;ADDR OF B.P. TO RES WORD
MOVEI LPSA,0 ;MAKE NULL SEMANTICS
CAMN A,%COMMENT ; COMMENT?
JRST CHKSAV ; YES, GO PROCESS IT
TLNN TBITS,CONRES ; PARSER SWITCHING RESERVED WORD?
JRST STACK ; NO, RETURN RESERVED WORD
;;%CI%
MOVEM TEMP,TRKMCR ;CURRENT "MACRO"
SKIPN SWCPRS ; YES, NEED TO SWITCH PARSERS?
JRST STACK ; NO, RETURN RESERVED WORD
TLNE TBITS2,MACIN ;IN A MACRO??
JRST .+5 ;YES, DON'T RECORD
MOVEM TEMP,TRKMCS ; SOURCE-FILE TOKEN
MOVEI TEMP,TRKM.P-1
PUSH TEMP,FPAGNO ; PAGE #
PUSH TEMP,ASCLIN ; LINE #
;;%CI% ↑
TLNE TBITS,DEFINT ; PARSER INTERRUPT (I.E. NO SWITCHING)?
JRST[SKIPE NODFSW ; DEFER DEFINE HANDLING FOR BLOCK EXECUTION?
JRST STACK ; YES, RETURN RESERVED WORD
MOVE TEMP,SCNNO ; YES, SAVE NUMBER OF SCANS REMAINING IN LEFT HALF
MOVE B,PCSAV ; OF TOP OF PRODUCTION STACK, UNPACK $TBITS ENTRY
HRLM TEMP,(B) ; OF THE RESERVED WORD TO GET AN INDEX OF ADDRESS
JRST CONDAD] ; TO PUSHJ TO, AND SET SCNNO TO ONE.
TLNE TBITS,CONDIN ; CHECK IF ENDC HAS OCCURRED AS THE END OF A WHILEC,
JRST ENDCOK ; CASEC, FORC, OR FORLC BODY AND IF SO, THEN DO NOT
HLRZ TEMP,ENDCTR ; SWITCH PARSERS. ENDCTR IS A POINTER TO A QSTACK
SKIPE (TEMP) ; INDICATING SUCH INFORMATION.
JRST STACK ;
ENDCOK: MOVEI TEMP,CGPSAV-1 ; DETERMINE WHICH PARSER ONE IS CURRENTLY IN AND
SKIPN PRSCON ; GET THE ADDRESS TO SAVE ITS PARSER DESCRIPTOR.
MOVEI TEMP,SGPSAV-1 ; SAVE SEMANTIC STACK POINTER, PARSE STACK POINTER,
PUSH TEMP,GPSAV ; NUMBER OF SCANS REMAINING IN LEFT HALF OF TOP OF
PUSH TEMP,PPSAV ; PRODUCTION STACK, PRODUCTION STACK POINTER,
MOVE SP,SCNNO ; CURRENT SCNWRD, AND A POINTER TO THE SCNWRD
MOVE B,PCSAV ;
HRLM SP,(B) ; STACK.
PUSH TEMP,PCSAV ;
MOVE B,SCWSV ;
MOVEM TBITS2,(B) ; SAVE SCNWRD
PUSH TEMP,SCWSV ;
HRROI TEMP,SSCWSV ; DETERMINE WHICH PARSER IS TO BE RESUMED AND GET
SKIPN PRSCON ; THE ADDRESS OF ITS PARSER DESCRIPTOR.
HRROI TEMP,CSCWSV ;
POP TEMP,B ; RESTORE SCNWRD STACK POINTER
TLNE TBITS,CONDIN ; IF ONE IS SWITCHING PARSERS VIA A PUSHJ INSTEAD OF
JRST[TLZ TBITS2,INLIN ; PROPER SCANNING OF INLINE STARTCODE. COMPENSATE
TRO TBITS2,NOLIST ; FOR NOT POPPING TEMP.
PUSH B,TBITS2 ;
JRST .+2] ;
MOVE TBITS2,(B) ; RESTORE SCNWRD AND TBITS2
MOVEM B,SCWSV ;
MOVEM TBITS2,SCNWRD ;
ML$BAK ; DON'T LIST PARSER SWITCH TRIGGERING RESERVED WORDS
POP TEMP,B ; RESTORE CONTROL STACK POINTER
POP TEMP,SP ; RESTORE PARSE STACK POINTER. MUST BE IN AC AS
MOVEM SP,PPSAV ; WELL AS IN MEMORY.
POP TEMP,GPSAV ; RESTORE SEMANTIC STACK POINTER
SETCMM PRSCON ; COMPLEMENT PARSER IN CONTROL FLAG
MOVEI C,1001 ; ASSUME A RESUME TYPE SWITCH
TLNN TBITS,CONDIN ; RESUME TYPE SWITCH?
JRST SWTPRE ; YES
CONDAD: HLRZ C,TBITS ; CONDAD IS CALLED WITH THE $TBITS ENTRY
TRZ C,RES+CONBTS ; OF A PARSER INTERRUPT RESERVED WORD IN
LSH C,-IF0SHF ; TBITS. IT INSERTS THE ADDRESS OF THE
MOVEI C,PRODGO(C) ; PRODUCTION WHICH ONE IS TO EXECUTE NEXT
PUSH B,C ; IN THE PRODUCTION CONTROL STACK. TBITS
MOVEI C,4001 ; IS UNPACKED TO GET AN INDEX TO A TABLE
; STARTING AT PRODG0 (BITS 6-8). SET
; REMAINING NUMBER OF CALLS TO SCANNER TO
; ONE SO THAT THE PARSER WILL NOT SCAN
; AGAIN AND SET A BIT TO DO A PUSHJ.
SWTPRE: MOVEM B,PCSAV ; RESTORE CONTROL STACK POINTER IN CORE
MOVEM C,SCNNO ; SET REMAINING NUMBER OF CALLS TO SCANNER
JRST STACK ; GO STACK
Comment ⊗ COMMENT -- throw out everything to next semicolon
⊗
CHKSAV: MOVE B,SAVCHR ;BE SURE SAVCHR IS NOT ";"
SETZM SAVCHR
SETZM LSTCHR
;; #PC#! OVERWRITING FIRST LINE IN CREF
JUMPE B,COMLUP ; NULL HAS ALREADY BEEN HANDLED
SKIPGE A,SCNTBL(B) ;GET BITS, CHECK SPECIAL
PUSHJ P,(A) ;SPECIAL, GET PAST PROBLEM
JRST COMLUP ;GET THEM ALL
ML$CHR ;TO LISTING FILE
NOBAIL<
COMLUP: CAIN B,";" ;DONE?
JRST SCANNER ; YES
>;NOBAIL
BAIL<
COMLUP: CAIE B,";" ;DONE?
JRST COMILD ; NO
SETZM BPNXTC ;YES. MARK SOURCE AT NEXT TOKEN
JRST SCANNER
>;BAIL
COMILD: ILDB B,PNEXTC ;GET NEXT CHAR
SKIPGE A,SCNTBL(B) ;USUAL
PUSHJ P,(A)
JRST COMLUP-1(TBITS2) ;GO PUT AWAY, GET ANOTHER
DSCR -- USID
DES An identifier has been found. If it is a macro name, go
expand it. Otherwise call TYPDEC routine to provide the
proper parse token for this identifier (differentiates
ARRAYS from PROCEDURES from STRINGS from ....
SEE TYPDEC in GEN, for providing correct parse token.
⊗
USID: SKIPN SWCPRS ; IN FALSE PART OF CONDITIONAL COMPILATION?
SKIPN IFCREC ; YES, SHOULD MACROS BE EXPANDED?
JRST TSTDEF ; YES, GO EXPAND MACROS
;; #OF# ! MAKE SURE A IS VALID BEFORE GOING OFF TO STACK
MOVE A,%ID
JRST STACK ; NO, DON'T EXPAND MACROS OR CHECK TYPES AND RETURN
TSTDEF: TLNE TBITS,DEFINE ;NEED TO EXPAND MACRTO?
JRST DEFRG ;YES
GOHEQ: LSTDPB
PUSHJ P,TYPDEC
JRST STACK
DSCR DEFRG -- prepare to expand a macro
DES The Ident is a DEFINE Ident. The steps are
1. Save current Parse and Semantic Stack state,
other state which will be destroyed.
2. If no parameters to get, go to step 5.
3. Get a parameter (special form string constant,
see manual), via SCANNER (recursive call, also
ENTERS); place on special VARB-RING whose ring
variable is VARB, and whose starting element is
in DEFRN2.
4. If comma, go to step 3 for more, else check for
right paren.
5. Save previous SCANNER information on DEFPDP stack,
set up DEFRNG for actuals, put macro body descrip-
tor in PNEXTC, restore stacks and VARB, etc.
6. Handle macro expansions in listing.
7. JRST to SCANNER for another try with the new PNEXTC
⊗
DEFRG: HLRZ A,%TLINK(LPSA) ; CHECK IF MACRO HAS BEEN INITIALIZED.
JUMPN A,DEFRG1 ;
ERR <MACRO WAS NOT INITIALIZED - INITIALIZE TO ZERO AND CONTINUE>,1;
SETZM A ; SOLVES PROBLEMS SUCH AS:
PUSHJ P,CREINT ; DEFINE NAME=NAME+1 WITHOUT A DEFINE NAME=0
MOVE LPSA,PNT ; OR ANOTHER INITIAL VALUE.
MOVE A,%NUMCON ;
JRST STACK ;
DEFRG1: ;CREATE A NEW DEFINE ELEMENT
TLNE FF,NOMACR ;EXPAND MACROS??
JRST [LSTDPB
MOVE A,%ID
JRST STACK];NO -- USER ID.
; IF WE DON'T WANT TO SEE MACRO NAMES IN OUTPUT LISTING, BACK UP OUTPUT PTR.
; ALSO TURN OFF LISTING FOR PARAMS
TLNN TBITS2,MACLST ;LIST MACRO NAMES?
JRST [ML$BAK ;NO, NULLIFY ALL TO DATE
TRO TBITS2,NOLIST ;LIST NO MORE FOR A WHILE
JRST .+1]
PUSHJ P,SCNACT ; GET ACTUAL PARAMETER LIST
PUSHJ P,ACPMED ; FINISH OFF THE MACRO CALL PREPARATION
JRST SCANNER ; TRY AGAIN (SCAN THE MACRO BODY!)
; SPECIAL DELIMITER MODE ACTUAL PARAMETER SCANNING ROUTINE
SCNPMR: PUSHJ P,INSET ; SET UP STRING SPACE ENTRY
TRNA ; SKIP
ML$CHR ; LIST MAYBE
DSPRMS: ILDB B,PNEXTC ; GET NEXT CHAR.
SKIPGE A,SCNTBL(B) ; SPECIAL?
PUSHJ P,CSPEC ; DO IT
JUMPE A,DSPRMS-1(TBITS2) ; AGAIN IF IGNORABLE
CAME B,CURPBG ; PARAMETER BEGIN DELIMITER?
JRST BALCHK ; NO, NESTED-BALANCED COMMA OR RPAR WILL BREAK
LSTDPB ; LIST IT?
SETZM BNSTCN ; SET NEST COUNT TO ZERO
JRST PSCAN+3 ; CONTINUE SCAN
PSCAN: LSTDPB ; LIST IT?
IDPB B,TOPBYTE(USER) ; DEPOSIT
ILDB B,PNEXTC ; GET NEXT CHAR.
SKIPGE A,SCNTBL(B) ; SPECIAL?
PUSHJ P,CSPEC ; DO IT
CAMN B,CURPED ; PARAMETER END DELIMITER?
JRST SPMEND ; YES, CHECK IF DONE
CAMN B,CURPBG ; PARAMETER BEGIN DELIMITER?
AOS BNSTCN ; INCREMENT NEST COUNT
AOJA C,PSCAN ; SCAN AGAIN
SPMEND: SOSL BNSTCN ; DECREMENT NEST COUNT AND CHECK IF DONE
AOJA C,PSCAN ; NO, SCAN AGAIN
ILDB B,PNEXTC ; ADVANCE CHAR. TO KEEP IN SYNCH.
SKIPGE A,SCNTBL(B) ; SPECIAL?
PUSHJ P,CSPEC ; DO IT
JRST ENDSTR ; GO TO END
DEPOSB: CAIN B,")" ; RIGHT PAREN WITH NONZERO NEST COUNT?
SOS LOCNST+RPAROF ; DECREMENT NEST COUNT
DEPOSA: LSTDPB ; LIST IT?
IDPB B,TOPBYTE(USER) ; DEPOSIT
AOJ C, ; INCREMENT CHARACTER COUNT
ILDB B,PNEXTC ; GET NEXT CHAR.
SKIPGE A,SCNTBL(B) ; SPECIAL?
PUSHJ P,CSPEC ; DO IT
BALCHK: CAIE B,"," ; END OF PARAMETER?
CAIN B,")" ;
JRST ENDCHK ; POSSIBLY, GO CHECK
TLNN A,NEST ; NESTED CHARACTER?
JRST DEPOSA ; NO, GO DEPOSIT
MOVE TEMP,[AOS LOCNST-1(LPSA)] ; SET UP INSTRUCTION TO UPDATE APPROP. NEST COUNT
TLNN A,LNEST ; LEFT NESTED?
TLO TEMP,AOSSOS ; NO, CHANGE INSTRUCTION TO SUBTRACT
HRRZ LPSA,NSTABL(B) ; LOAD CHAR'S NESTED COUNT INDEX
XCT TEMP ; MODIFY COUNT
JRST DEPOSA ; GO DEPOSIT
ENDCHK: MOVEI TEMP,NUMNST-1 ; SET UP COUNT
EDLOOP: SKIPN LOCNST(TEMP) ; NEST COUNTEQUAL ZERO?
SOJGE TEMP, EDLOOP ; YES, AND TRY NEXT IF NOT DONE
JUMPGE TEMP,DEPOSB ; GO DEPOSIT IF NOT ALL NEST COUNTS EQUAL ZERO
JRST ENDSTR ; GO TO END
DSCR -- SCNACT
DES This procedure is used to scan a list of actual parmeters for a macro
or a conditional compilation FORLC statement. When the latter happens
SCNACT is called from the EXEC routine GETACT which appears in GEN.
FORLC statements have a body which is scanned as many times as one has
parameters in the actual list; in each case a different actual is used
as the parameter.
PAR LPSA contains the semantics of the macro name or macro pseudonym in
case a FORLC list is being scanned (address of semblk of name).
RES DEFRN2 contains the address of the first actual parameter in the list.
⊗
↑SCNACT: PUSH P,LPSA ;SAVE SEMANTICS OF DEFINE SYMBOL
PUSH P,VARB ;WILL MAKE NEW ONE FOR MACRO ARGUMENTS
PUSH P,PPSAV ;SAVE THE STACKS
PUSH P,GPSAV
SETZM DEFRN2 ;INITIALIZE FOR NEW MACRO
SETZM VARB
;;%CI% (2,3/5) JFR 7-25-75
MOVEI TEMP,$PNAME+1(LPSA) ;ADDR OF B.P. TO MACRO NAME
MOVEM TEMP,TRKMCR ;CURRENT MACRO
TLNE TBITS2,MACIN ;IN A MACRO??
JRST .+5 ;YES, DON'T RECORD SOURCE-FILE INFO
MOVEM TEMP,TRKMCS
MOVEI TEMP,TRKM.P-1
PUSH TEMP,FPAGNO
PUSH TEMP,ASCLIN
;;%CI% ↑
HLRZ TEMP,$VAL(LPSA) ;ANY PARAMETERS NEEDED?
JUMPE TEMP,NOPRMS ; NO
MOVEM TBITS2,SCNWRD ;NOTE CHANGES
SCNAGN: PUSHJ P,SCANNER ;LOOKING FOR "("
MOVE TEMP,(SP) ;SYNTAX OF SCANNED ELEMENT
POP P,GPSAV ;KEEP STACKS IN SYNCH
POP P,PPSAV
ADD P,X22
CAMN TEMP,%STCON ; A SPECIAL DELIMITER DECLARATION?
SKIPE SWBODY ; YES, COULD WE POSSIBLY HAVE SEEN A SPEC DEL DECL.
; I.E. DID WE SEE ONE ALREADY?
JRST TSLPRN ; NO, GET LEFT PAREN.
SKIPN REQDLM ; TRYING TO OVERRIDE NULL DELIMITERS MODE?
SETOM RSTDLM ; YES, SET APPROPRIATE FLAGS
SETOM REQDLM ;
SETOM SWBODY ; SET SWITCH DELIMITER DECLARATION FLAG
MOVE TEMP,[XWD -2,2] ; SET UP A COUNT
MOVE PNT,$PNAME+1(LPSA) ; PNT HAS BYTE POINTER TO DELIM. STRING
HRRZ LPSA,$PNAME(LPSA) ; LPSA HAS DELIMITER STRING LENGTH
PUSHJ P,GETDL2 ; GET SPECIAL DELIMITER DECLARATION
JRST SCNAGN ; GO BACK AND GET LEFT PAREN.
TSLPRN: CAME TEMP,[TLPRN&17777777] ;PARAMS?
;;%CU% (1/2) JFR 8-16-75 make this error continuable
JRST [ERR <MISSING "(" IN MACRO CALL>,1
MOVEI TEMP,SCANNER
MOVEM TEMP,-4(P)
JRST CONACT+2] ; NO
;;%CU% ↑
MOVEI B,"("
LSTDPB
TLO FF,PRMSCN ; PRIME THE SCANNER FOR PARAMETER
PUSHJ P,FFPUSH ; SAVE OLD DEFLUK BIT OF FF AND TURN IT ON IN FF
;;#TG# 9-15-74 HJS RESTORE PARSE STACK POINTER
PRMLUP: MOVE SP,PPSAV ; RESTORE SP SINCE IT POINTS TO THE PARSE STACK
; SINCE OTHERWISE MAY GET OVERFLOW SINCE STACK
; IS CALLED AT THE END OF EACH PARAMETER SCAN
;;#TG#
SKIPN REQDLM ; IN SPECIAL DELIMITER MODE?
JRST PRMOLD ; NO
PUSHJ P,SCNPMR ; YES, GET THE PARAMETERS
TRNA
PRMOLD: PUSHJ P,SCANNER ;GET A PARAMETER
POP P,GPSAV ;SYNCH STACK
POP P,PPSAV
ADD P,X22
; WE KNOW RESULT IS STRING CONSTANT, SCANNER WILL RETURN NO OTHER
SKIPN TEMP,DEFRN2 ;PUT PTR TO FIRST ARG IN DEFRN2
MOVE TEMP,NEWSYM
MOVEM TEMP,DEFRN2
PUSHJ P,SCANNER ;GET NEXT PUNCTUATION
MOVE TEMP,(SP)
POP P,GPSAV
POP P,PPSAV
ADD P,X22 ;SYNCH STACKS
CAMN TEMP,[TCOMA&17777777] ;LOOPING?
JRST PRMLUP ;YES
CAME TEMP,[TRPRN&17777777] ;DONE?
;;%CU% (2/2) JFR 8-16-75 make this error continuable; even recoverable
;; JRST [ERR <MISSING "," OR ")" IN MACRO CALL>,1
;; MOVEI TEMP,SCANNER
;; MOVEM TEMP,-4(P)
;; JRST CONACT]
PUSHJ P,[PUSHJ P,ER40 ;inserted missing )
JRST SCNBAK] ;scanner is ahead
;;%CU% ↑
MOVE LPSA,DEFRN2 ; DETERMINE IF ALL PARAMETERS HAVE BEEN
MOVEI TEMP,0 ; SPECIFIED AND IF NOT FORM NULL'S FOR
DEFLNK: HRRZ LPSA,%RVARB(LPSA); ALL THOSE LEFT OUT SO THAT ASSIGNC
ADDI TEMP,1 ; WILL WORK PROPERLY
JUMPN LPSA,DEFLNK ;
MOVE LPSA,-3(P) ;
HLRZ LPSA,$VAL(LPSA)
SUB TEMP,LPSA ; NUMBER OF UNSPECIFIED PARAMETERS
MOVEM TEMP,NULCNT ;
TSTDON: AOSLE NULCNT ; ALL PARAMETERS SPECIFIED?
JRST CONACT ; YES,
PUSHJ P,INSET ; SET UP STRING SPACE ENTRY
ADDI C,2 ; APPEND 177¬0 TO NULL STRING AND LINK
MOVEI TEMP,177 ; ON VARB AND STRING RINGS
IDPB TEMP,TOPBYTE(USER) ;
MOVEI TEMP,0 ;
IDPB TEMP,TOPBYTE(USER) ;
PUSHJ P,UPDCNT ;
GETBLK NEWSYM ;
HRROI TEMP,PNAME+1 ;
POP TEMP,$PNAME+1(LPSA) ;
POP TEMP,$PNAME(LPSA) ;
MOVE TEMP,[XWD CNST,STRING] ;
MOVEM TEMP,$TBITS(LPSA) ;
PUSHJ P,RNGSTR ;
PUSHJ P,RNGVRB ;
JRST TSTDON ;
CONACT: TLZ FF,PRMSCN ; DONE WITH THESE
PUSHJ P,FFPOP ; RESTORE DEFLUK BIT OF FF
SKIPE REQDLM ; IN SPECIAL DELIMITER MODE?
SKIPN SWBODY ; YES, HAVE TO REVERT TO OLD DELS?
JRST NOPRMS ; NO
SETZM SWBODY ; RESET SWITCH DELIMITER DECLARATION FLAG
SKIPN RSTDLM ; RESTORING NULL DELIMITERS MODE?
JRST .+4 ; NO
SETZM RSTDLM ; YES, RESTORE APPROPRIATE FLAGS
SETZM REQDLM ;
JRST NOPRMS ;
HRROI TEMP,LOCMPR+1 ; GET RESTORING ADDRESS
POP TEMP,CURPED ; RESTORE START DEL.
POP TEMP,CURPBG ; RESTORE END DEL.
NOPRMS: POP P,GPSAV ; GET SEMANTIC STACK BACK
POP P,PPSAV ; GET PARSE STACK BACK
POP P,VARB ; GET OLD VARB BACK
POP P,LPSA ; SEMANTICS FOR DEFINE
MOVE SP,PPSAV ; RESTORE SP IN CASE IT GOT FOULED UP IN
; SCANNER CALLS
POPJ P, ; RETURN
DSCR -- ACPMED
DES ACPMED prepares for a macro call once the actual parameters have been
scanned. It is also used to prepare for the first instantiation of the
body of a conditional compilation WHILEC, CASEC, FORC, or FORLC statement.
PAR LPSA contains the semantics of the macro name or macro pseudonym in
case a conditional compilation WHILEC, CASEC, FORC, or FORLC body is
being scanned for the first time. DEFRN2 contains the address of the
actual parameter list in case of a FORLC statement, the address of the
loop variable semblk in case of a FORC statement, and zero in the case
of a WHILEC or CASEC statement.
RES At the end of this procedure one has effectively switched PNEXTC and
PNEXTC-1 to scan the macro body or the conditional compilation body.
Relevant information is saved on the DEFPDP stack.
⊗
↑ACPMED: MOVE PNT,DEFPDP ;RESTORE NOW
PUSH PNT,DEFRNG ;SAVE OLD RING OF PARAMETERS
PUSH PNT,PNEXTC-1 ;STRING NUMBER
PUSH PNT,PNEXTC ;INSTEAD SAVE THOSE WHICH
PUSH PNT,SAVCHR ; PARAMETERS
MOVEM PNT,DEFPDP
MOVE PNT,PLINE ;WILL SAVE IN IPLINE IF LEAVING INPUT LEVEL
HLRZ LPSA,%TLINK(LPSA) ; STORE THE LENGTH OF THE MACRO BODY IN THE LEFT
HRLZ TEMP,$PNAME(LPSA) ; HALF OF DEFRNG SO THAT WHEN FINISH SCANNING AN
HRR TEMP,DEFRN2 ; ACTUAL PARAMETER THERE WILL BE SOME INDICATION OF
MOVEM TEMP,DEFRNG ; THE MINIMUM AMOUNT OF STRING SPACE NECESSARY FOR
PUSHJ P,CONTX2 ; THE SCANNING OF THE REMAINDER OF THE MACRO
; DECIDE WHETHER MACRO EXPANSION SHOULD BE LISTED.
MOVEI B,"<" ;MARK EXPANSION IF MACRO NAME
;;#YV# JFR 2-4-77
TLNN TBITS2,LSTEXP ; IS ALSO BEING LISTED
JRST ACPM.1
LSTDPB ;LISTING MIGHT BE OFF FOR OTHER REASONS
ACPM.1:
TLON TBITS2,MACIN ;IN A MACRO NOW
MOVEM PNT,IPLINE ;CAN GET CURRENT LINE LOC FROM HERE
;;#ZH# JFR 9-17-77
;; TLNN TBITS2,MACEXP ;IF MACRO EXPANSION SHOULD NOT BE LISTED,
;; TRO TBITS2,NOLIST ; INDICATE IT
PUSHJ P,L$SET ;SET COURSE FROM ABSOLUTE BEARINGS
;;#ZH# ↑
;;#YV# ↑
MOVEM TBITS2,SCNWRD ;UPDATE IN CORE
POPJ P, ; RETURN
DSCR -- CONTXT
DES CONTXT is used to switch the input pointers before a macro call or
prior to each invocation of the body of conditional compilation WHILEC,
CASEC, FORC, or FORLC statement. If conditional compilation is the case
then this is virtually all that need be done for the reinvocation of the
body and thus it is clearly cheaper than calling the macro in the old
sense several times with different variables (this statement is only true
for the WHILEC, FORC, and FORLC statement since the body of a CASEC
statement is only scanned once).
PAR LPSA contains the semantics of the macro name or macro pseudonym in the
case of a conditional compilation WHILEC, CASEC, FORC, or FORLC statement.
RES PNEXTC, PNEXTC-1, PLINE, and PLINE-1 are set.
⊗
↑CONTXT: HLRZ LPSA,%TLINK(LPSA) ;SEMANTICS FOR MACRO BODY
CONTX2: PUSHJ P,SGCOL1 ;MAKE SURE THERE'S ENOUGH ROOM
HLLZ TEMP,$PNAME(LPSA) ;STRING NUMBER -- NULL STRING
MOVEM TEMP,PNEXTC-1
MOVEM TEMP,PLINE-1
MOVEW PNEXTC,$PNAME+1(LPSA) ;SET UP NEW INPUT POINTER
MOVEM TEMP,PLINE
SETZM SAVCHR ; NOTHING SCANNED AHEAD AT THIS LEVEL
SETZM LSTCHR ; NOTHING SCANNED AHEAD AT THIS LEVEL
POPJ P, ; RETURN
DSCR STRNG, etc.
DES Input a string constant. Check all identifiers to see if
they are formal parameters to a DEFINE (macro). If so,
replace them by their internal identifiers (delete <177>
followed by unique code). Store string constant in string
space, place entry in table, results to HPNT and NEWSYM.
SEE Comments on following page for details of actual param thing.
⊗
STRNG:
PUSHJ P,INSET ;CLEAR AND RESET AS ABOVE
TLZ FF,PRMXXX ;IF " WAS FIRST CHAR, NOT IN SPECIAL MODE
STSCAN:
ILDB B,PNEXTC ;PRESERVE NEXT CHARACTER
BAKSTR: SKIPGE A,SCNTBL(B) ;DO SPECIAL THINGS
PUSHJ P,CSPEC ;IF REQUIRED
BAKST1: TLNN A,LETDG ;THINK HARD ONLY ON QUOTE, LETTDIG
JRST MORSTR ; NOT LETTER OR DIGIT
TLNE FF,DEFLUK ; SCANNING A MACRO BODY?
TLNE FF,PRMSCN ; YES, SCANNING MACRO PARAMETERS
JRST MORSTR ; YES, CHECK DELIMITERS
SKIPN REQDLM ; SPECIAL DELIMITER MODE?
JRST DEFCHK ; NO, THINK HARD
CAMN B,CURMED ; MACRO BODY END DELIMITER?
JRST LTDEND ; YES, CHECK IF DONE
CAMN B,CURMBG ; MACRO BODY BEGIN DELIMITER?
AOS BNSTCN ; YES, INCREMENT NEST COUNT
JRST DEFCHK ; THINK HARD
LTDEND: SOSL BNSTCN ; DECREMENT NEST COUNT AND CHECK IF DONE
JRST DEFCHK ; THINK HARD
JRST LTDCON ; TERMINATE MACRO BODY SCAN
MORSTR: TLNN FF,PRMXXX ;IN SPECIAL PARAMETER-SCANNING MODE?
JRST MORST1 ; NO, CONTINUE
CAIE B,"," ;END OF PARAMETER?
CAIN B,")"
JRST ENDSTR ; YES
JRST DEPOSIT ;LET SINGLE QUOTES THRU IN THIS MODE
MORST1: SKIPN DLMSTG ; A SPECIALLY DELIMITED STRING?
JRST MORST2 ; NO, GO CHECK FOR QUOTES
CAMN B,CURMED ; MACRO BODY END DELIMITER?
JRST MBDEND ; YES
CAMN B,CURMBG ; MACRO BEGIN DELIMITER?
AOS BNSTCN ; YES, INCREMENT NEST COUNT
JRST DEPOSIT ; DEPOSIT
MBDEND: SOSL BNSTCN ; DECREMENT NEST COUNT AND CHECK IF DONE
JRST DEPOSIT ; DEPOSIT
LTDCON: LSTDPB ; PUT IT AWAY
ILDB B,PNEXTC ; GET NEXT CHAR. TO KEEP IN SYNCH.
SKIPGE A,SCNTBL(B) ; SPECIAL?
PUSHJ P,CSPEC ;DO IT
JRST ENDSTR ; GO TO END
MORST2: TLNN A,QUOTE ;END OR DOUBLE-QUOTE ?
JRST DEPOSIT ; NO, PUT IT AWAY
LSTDPB ;PUT IT AWAY
ILDB B,PNEXTC ;TRY NEXT
SKIPGE A,SCNTBL(B) ; DO THE USUAL IF SPCL
PUSHJ P,CSPEC
TLNN A,QUOTE ;IS IT ONE?
JRST[SKIPE BAKDLM ; YES, CHECK IF NEED TO RESTORE DLMSTG
SETOM DLMSTG ; YES
SETZM BAKDLM ; TURN OFF BAKDLM
JRST ENDSTR] ; DONE
DEPOSIT:
LSTDPB ;TO LISTING FILE IF REQD
DEPO1: IDPB B,TOPBYTE(USER) ;STORE CHARACTER AS IS
AOJA C,STSCAN ;LOOP ON RANDOM CHARACTERS
COMMENT ⊗
We come here if a letter or number has been seen. If we are not
scanning a macro body, we simply scan the rest of the characters
which could be an identifier into the string constant, and return
to the main string constant scanning loop.
If we are scanning a macro body, this may be a parameter name.
The following algorithm is used:
1. If not a letter, continue as if were not scanning macro body.
2. Save the length of the string up to the start of the ident.
3. Scan this (possible) param into the constant, no case conversion.
4. Save the length of the string up to the end of the ident.
5. Save state of scanner (char, bits), then return PNEXTC to the
ident within the string const. Call DSCAN (ident scanner) to con-
vert and lookup this identifier (some special bits set to avoid
stacking results, etc.)
6. If not a DEFINE parameter, reset TOPBYTE and PNAME pointers to
their state at the end of step 3, clear space used during DSCAN,
and return to main string constant loop.
7. Back TOPBYTE pointer up to the length of step 2, insert '177
(param marker), followed by param number into string, clear space
used during steps 3 and 4, update PNAME count properly, and return
to main loop.
Substring operations are used to retrieve the relevant byte
pointers from the saved lengths, and only when they are really
needed, to avoid the garbage collect problems with multiple
saved pointers which plagued past implementations, and made
the multiple string space implementation impossible.
Be warned (again) that the current setup is the result of several
(+1) killed bugs -- each thought to be the last. No
guarantees are proferred that no more exist, but chances are
(even) better than ever.
⊗
DEFCHK:
TLNE A,NUMB ;MUST BE A LETTER
JRST DEPOSIT ; DIGIT OR OTHER NUMBER PART, GO ON
PUSH P,C ;save length just before scanning ident
RANSCN: ADDI C,1 ;COUNT FIRST CHAR
LSTDPB ;LIST IF NECESSARY
RANSC1: IDPB B,TOPBYTE(USER) ;KNOW FIRST ONE IS OK
ILDB B,PNEXTC
SKIPGE A,SCNTBL(B) ;USUAL TEST
PUSHJ P,CSPEC
TLNN A,LETDG
JRST SEEPRM ; NOT A LETTER OR DIGIT
SKIPN REQDLM ; SPECIAL DELIMITER MODE
JRST CHKCON ; NO
CAMN B,CURMED ; MACRO BODY END DELIMITER
JRST MBEDCK ; YES
CAMN B,CURMBG ; MACRO BODY BEGIN DELIMITER
AOS BNSTCN ; YES, INCREMENT NEST COUNT
JRST CHKCON ; CONTINUE ID SCAN
MBEDCK: SOSL BNSTCN ; DONE WITH MACRO BODY
CHKCON: AOJA C,RANSC1-1(TBITS2) ; COUNT AND LOOP
; NOW CONVERT IDENT TO UPPER CASE, ALIGN, CALL SCANNER TO LOOK IT UP
SEEPRM:
PUSH P,A ;SAVE BITS,
PUSH P,B ; CHARACTER, AND CURRENT TOTAL
PUSH P,C ; MACRO BODY STRING COUNT
HRRM C,PNAME ; END POINTER OVER GC
; P stack is:
; -3 -- length before ident scanned into string const
; -2 -- bits for char after ident.
; -1 -- char after ident.
; 0 -- length after ident scanned into string const
HRRZ TBITS,-3(P);use length(id)+5 for string space need
SUBM C,TBITS
PUSH P,TBITS ;save id length for remchr update
ADDI TBITS,5 ;WILL MOVE OUT TO AVOID A PROBLEM
COLNEC: PUSHJ P,SGCOL2 ;COLLECT IF NECESSARY
; Developing string constant is now at the end of the current
; string space, with room beyond for the identifier scan.
; P Stack as before, with ident length added to top
AOS TOPBYTE(USER) ;IDPB-ILDB GETS INTO LOOP IN DSCAN IF NOT
;;#WN# JFR 3-24-76 THERE ONCE WAS A BIG HAIRY MACRO THAT NEEDED THIS PATCH.
; SEEMS GENERALLY RIGHT, TOO, IN LIGHT OF ABOVE AOS. ONLY POSSIBLE
; SIDE EFFECT IS STRING GARBAGE COLLECTION MORE OFTEN, BUT WATCHING
; CONSOLE LIGHTS INDICATED THAT THIS DID NOT HAPPEN.
MOVEI TEMP,5
ADDM TEMP,REMCHR(USER) ;KEEP COUNT MORE HONEST
;;#WN# ↑
EXCH SP,STPSAV ;save string constant state in preparation for
MOVSS POVTAB+6 ; identifier rescan (as identifier)
PUSH SP,PNEXTC-1 ;Save Scanner input state, and PNAME
PUSH SP,PNEXTC ; (string constant) state.
PUSH SP,PNAME
PUSH SP,PNAME+1
PUSH SP,PNAME ;Now retrieve (possibly moved) bp to beginning
PUSH SP,PNAME+1 ; of potential formal name in constant
PUSH P,[1] ;PNAME[<before id length> for 1]
PUSH P,-5(P)
JSP B,SBSTR
POP SP,TEMP ;resultant bp
SUB SP,X11
MOVSS POVTAB+6
EXCH SP,STPSAV
ILDB B,TEMP ;SET UP FOR SCANNER
MOVEM TEMP,PNEXTC ;SCAN FROM HERE FOR A WHILE
MOVE A,SCNTBL(B) ;GET THE BITS BACK
TLO TBITS2,LOKPRM
TRON TBITS2,NOLIST ;TURN OFF LISTING FOR RESCAN
TLO TBITS2,BACKON ;SAY YOU'VE DONE IT IF STATE CHANGED
MOVEM TBITS2,SCNWRD ;UPDATE
SCNPRM: PUSHJ P,DSCAN ;ID SCANNER -- SCAN AND LOOK IT UP
POP P,TEMP ;fix up REMCHR using saved ident length
MOVNS TEMP
ADDM TEMP,REMCHR(USER)
EXCH SP,STPSAV ;PUT THE SCANNER LOCATION BACK
POP SP,PNAME+1 ;Restore string constant descriptor
POP SP,PNAME
ADD SP,X22 ;Then use to get one or other pointer back (below)
PUSH P,[1] ;Whichever SUBSR is called, it will be [x for 1]
TSTPRM: SKIPG LPSA,NEWSYM ;THESE TESTS DETERMINE IF
JRST NOPAR ; (1) THERE IS A SYMBOL OF THIS NAME
SKIPGE TBITS,$TBITS(LPSA)
JRST NOPAR ; (2) IT IS NOT A RESERVED WORD
TLNE TBITS,FORMAL
TLNN TBITS,DEFINE
JRST NOPAR ; (3) IT IS A MACRO PARAMETER NAME
PUSH P,-4(P) ;We found a param -- retrieve bp to beginning of
JSP B,SBSTR ; original param name, clear string space to end
MOVE TEMP,(SP) ; of space which DSCAN used
PUSHJ P,CLREST
POP SP,C ;Now replace param name with 177, param #
MOVEI TEMP,177 ;(other word of SUBSR result removed at DN below)
IDPB TEMP,C
HRRZ TEMP,$VAL(LPSA) ;PARAM NUMBER
IDPB TEMP,C
MOVEM C,TOPBYTE(USER) ;update end of space
AOS C,-3(P) ;length before id scan, +2 for param spec,
AOJA C,DN ; yields proper current string const. length
NOPAR:
PUSH P,-1(P) ;Was not param, retain (apparent) ident in string,
JSP B,SBSTR ; by retrieving bp to end of original scan,
MOVE TEMP,(SP) ; clearing space to end of DSCAN scan,
PUSHJ P,CLREST ; then restoring TOPBYTE to continue macro body
POP SP,TOPBYTE(USER) ; scan
HRRZ C,(P) ;Restore length after ident scan
DN:
TLZE TBITS2,BACKON ;TURN LISTING BACK ON
TRZ TBITS2,NOLIST ;YES
SUB P,X11 ;Toss end of ident length
POP P,B ;ident terminator
POP P,A ;bits for that terminator
SUB P,X11 ;Beginning of ident length
SUB SP,X11 ;count word from whichever subsr was done
POP SP,PNEXTC ;Finally, restore Scanner input
POP SP,PNEXTC-1
EXCH SP,STPSAV ;ONE MORE TIME
HRRM C,PNAME ;MAKE SURE COUNT IS REALLY HONEST
;A AND B ARE THE APPROPRIATE VALUES FOR THE ORIGINAL BREAK CHAR
TLZ TBITS2,LOKPRM ;LOOK NO MORE
JRST MORSTR ;CONTINUE THE SCAN
CLREST:
;;#WM# JFR 3-22-76 440700 BYTE POINTERS (STRNGC) CAUSE PROBLEMS
SKIPLE C,TOPBYTE(USER) ;BAD GUY?
JRST CLRES1 ;NO
MOVEI C,-1(C) ;MAKE HIM A GOOD GUY
HRLI C,010700
MOVEM C,TOPBYTE(USER)
CLRES1:
;;#WM# ↑
MOVEI C,0 ; BP OF START OF ID IN TEMP
LINLUP: CAMN TEMP,TOPBYTE(USER) ;clear space from temp's bp to
POPJ P, ;current top
IDPB C,TEMP
JRST LINLUP
SBSTR: AOS (P) ;ADAPT TO SAIL CONVENTIONS
MOVE C,LPSA ;SAVE
EXTERN SUBSR
PUSHJ P,SUBSR
MOVE LPSA,C ;RESTORE
MOVE USER,GOGTAB
JRST (B)
Comment ⊗
End of string constant -- set up results for stacking,
go do it ⊗
ENDSTR:
MOVEM TBITS2,SCNWRD ;PUT ALL THE BITS AWAY
LSTDPB ;PUT "," OR ")" AWAY
TLZ FF,PRMXXX
CAIE B,12 ;LF IS SPECIAL PROBLEM!
MOVEM B,SAVCHR ;SAVE BITS FOR NEXT TIME
MOVEM B,LSTCHR ;ALSO HERE ANY TIME
SKIPN SWCPRS ; SWITCHING PARSERS OK?
JRST NOSWCH ; NO,
;; #QV (1 OF 2) WILL NOW USE ENDMAC TO ADD 177-0 TO ASSIGNC BODIES
TLNE FF,PRMSCN ; SCANNING ACTUALS?
JRST ENDACT ; YES, APPEND 177¬0 TO MACRO ACTUALS
JRST NOMACW ; NO,
;; #QV#
NOSWCH: SKIPN IFCREC ; EXPAND MACROS IN FALSE PART OF COND COMP?
TLNN FF,PRMSCN ; YES, SCANNING MACRO ACTUALS?
JRST [PUSHJ P,UPDCNT ; KEEP REMCHR HONEST
JRST STCTYP] ; DON'T ENTER STRING
ENDACT: ADDI C,2 ; FOR ACTUAL PARAMETERS APPEND 177-0 TO END OF
MOVEI TEMP,177 ; STRING, GET A SEMBLK AND PLACE IT ONLY ON
IDPB TEMP,TOPBYTE(USER) ; THE STRING RING. ALL ACTUAL PARAMETERS TO
MOVEI TEMP,0 ; A MACRO ARE LINKED ON THE VARB RING. THUS WHEN
IDPB TEMP,TOPBYTE(USER) ; A MACRO CALL IS FINISHED ALL THAT REMAINS TO
PUSHJ P,UPDCNT ; DO IS TO KILLST ALONG THE VARB RING WHOSE HEAD
GETBLK NEWSYM ; IS POINTED TO BY DEFRNG.
HRROI TEMP,PNAME+1 ;
POP TEMP,$PNAME+1(LPSA) ;
POP TEMP,$PNAME(LPSA) ;
MOVE TEMP,[XWD CNST,STRING] ; MAKE SEMBLK OF ACTUAL PARAMETER LOOK LIKE
MOVEM TEMP,$TBITS(LPSA) ; A STRING CONSTANT SEMBLK EXCEPT FOR THE FACT
PUSHJ P,RNGSTR ; THAT IT IS NOT LINKED ON THE STRING CONSTANT RING
;; #QV (2 OF 2) ! REMOVED TEST ON ASGFLG HERE
PUSHJ P,RNGVRB ;
MOVE LPSA,NEWSYM ;
MOVE A,%STCON ;
JRST STACK ;
NOMACW: PUSHJ P,UPDCNT ; UPDATE PNAME CNT, REMCHR, COLLECT IF NECESSARY
PUSH P,BITS ;
PUSHJ P,STRINS ; CHECK IF STRING HAS ALREADY BEEN ENTERED IN THE
POP P,BITS ; SYMBOL TABLE AND IF NOT THEN ENTER IT
MOVE LPSA,PNT ;
MOVEM LPSA,NEWSYM ;
STCTYP: MOVE A,%STCON ;
JRST STACK ;
DSCR SCNUMB -- number scanner
DES Scan a number -- keep both REAL (floating) and fixed
representations around, use the appropriate one at the end.
A number is composed of integers and various special characters.
See the syntax for a better definition, but here is a summary:
<int><.<int>><@<+|->int>
Common sense should indicate that some of these things must
be present to constitute a legal number. The results
are returned as described on the opening page of SCAN.
⊗
SCNUMB:
; @ CHARACTER TO BE TREATED AS DELIMITER IF INSIDE START!CODE
; BLOCK
TLNN A,ATSIGN ; AT SIGN?
;;#YA# ! (1/2) JFR 1-3-77 CLEAR FLAGS FOR SAFETY
JRST 2,@[SCNM1] ; NO, GET REST OF NUMBER
SKIPN SWCPRS ; YES, IN FALSE PART OF CONDITIONAL COMPILATION?
JRST ATOUT ; YES, TREAT AT SIGN AS A PARSE TOKEN
TLNN TBITS2,INLIN ; NO, IN-LINE CODE?
;;#YA# ! (2/2)
JRST 2,@[SCNM1] ; NO, GET REST OF NUMBER
ATOUT: MOVE A,%ATS ;GET BITS FOR AT SIGN DELIMITER
JRST CHAROUT ;HANDLE AS DELIMITER
SCNM1:
SETZB C,SCNVAL ;DIGITS CTR, VALUE
SETZB SBITS2,DBLVAL ;FLAGS, LOW HALF OF LONG VALUE
TLNN A,QUOCTE ;OCTAL QUOTE MARK (') ?
JRST DECIM ;NO, DECIMAL NUMBER
SETZB LPSA,LPSA+1 ;ACCUMULATE HERE
OCTL: ILDB B,PNEXTC ;GET BACK IN SYNCH
SKIPGE A,SCNTBL(B)
PUSHJ P,(A) ;USUAL SPECIAL TREATMENT
LSTDPB
MOVE LPSA,SCNVAL
MOVE LPSA+1,DBLVAL
TLNE A,DIG
JRST OCTL1
JUMPE LPSA,ENDNUM ;SINGLE PRECISION INTEGER
IORI SBITS2,DBLPRC ;LONG INTEGER
JRST ENDNUM
OCTL1: LSHC LPSA,3
ADDI LPSA+1,-"0"(A)
JOV [ADDI LPSA,1 ;IN CASE SOME JOKER SAYS '777777777778
JOV .+1 ;TOP PART COULD OVERFLOW, TOO
JRST .+1]
MOVEM LPSA,SCNVAL
MOVEM LPSA+1,DBLVAL
AOJA C,OCTL ;COUNT DIGITS TO DETECT LONE '
DECIM:
PUSHJ P,GETINT ;CLEAR COUNT, GET INTEGER
TLNN A,LETDG ;PART OF NUMBER?
JRST ENDNMZ ;NO
;;#XZ# JFR 1-3-77 GET EXPONENT/TERMINATION CONDITIONS STRAIGHT
IORI SBITS2,FLOTNG ;MUST BE REAL
;;#ZD# MWK 4-13-77 FIX TO PREVENT C CLOBBERAGE
; TLNN A,DOT ;DECIMAL POINT?
; SETZ C, ;NO. NO DIGITS AFTER DECIMAL PT.
;;#ZD#
PUSH P,C ;SAVE DIGIT COUNTS
TLNE A,DOT
PUSHJ P,TZ ;TRY FOR MORE INTEGER
HLRZ D,C ;# TRAILING ZEROES
SUBI D,(C) ;-(# DIGITS WHICH ARE NOT TRAILING ZEROES)
ADDM D,(P) ;RH (P) = AMOUNT TO ADD TO EXPONENT
PUSH P,SCNVAL ;SAVE FRACTION VALUE
PUSH P,DBLVAL
SETZM SCNVAL ;INITIAL EXPONENT VALUE
SETZB C,DBLVAL
TLNN A,LETDG
JRST FIXAT1 ;END OF REAL NUMBER
TLNN A,DOT ;MUST BE "." OR "@"
TLNE A,ATSIGN
JRST .+2
ERR <ILLEGAL REAL CONSTANT>,1
;;#XZ# ↑
NODOT1: ILDB B,PNEXTC
SKIPGE A,SCNTBL(B)
PUSHJ P,(A)
LSTDPB
TLNN A,ATSIGN ;SECOND "@"
JRST NODOT2 ;NO
IORI SBITS2,DBLPRC ;YES, LONG PRECISION
JRST NODOT1
NODOT2: PUSH P,[FIXAT]
CAIN B,"-" ;MINUS?
TLOA SBITS2,EXPNEG ; YES, EXPONENT NEGATIVE
CAIN B,"+" ;NO, PLUS?
JRST LGETINT ; PLUS OR MINUS, GET DIGIT
JRST GETINT ; HAVE DIGIT, GO GET NUMBER
FIXAT: PUSHJ P,TZMUL
FIXAT1: SKIPN (P) ;IS RESULT ZERO?
SKIPE -1(P)
JRST .+3 ;NO
SUB P,X33 ;YES, REMOVE 2 VALUE WORDS AND DIGIT CTR WORD
JRST RETZER ;AND MAKE LIFE SIMPLE
SKIPE SCNVAL ;IF THIS IS NOT ZERO
JRST EXPER3 ;THEN WE HAVE A WHOPPING BIG EXPONENT
TLZN SBITS2,EXPNEG ;NEGATIVE EXPONENT?
SKIPA D,DBLVAL ;NO
MOVN D,DBLVAL ;YES
POP P,DBLVAL ;RETRIEVE MANTISSA
POP P,SCNVAL
ADD D,(P)
HRREI D,(D) ;EXPONENT OF 10
SUB P,X11 ;DONE WITH FORMER DIGIT CTR WORD
MOVE LPSA,SCNVAL ;BEGIN CONVERTING MANTISSA TO PURE FRACTION
JFFO LPSA,DFSC
MOVE LPSA,DBLVAL ;HIGH ORDER WORD WAS ALL ZERO
JFFO LPSA,.+1
ADDI LPSA+1,=35 ;HIGH WORD WAS ALL ZERO
DFSC: MOVEI C,-1(LPSA+1) ;# OF PLACES TO SHIFT (REMEMBER SIGN BIT)
MOVE LPSA,SCNVAL ;GET MANTISSA
MOVE LPSA+1,DBLVAL
ASHC LPSA,(C) ;MAKE MANTISSA INTO PURE FRACTION
SUBI C,=70
MOVN C,C ;C=EXPONENT OF 2 OF MANTISSA
JUMPE D,DFSC2 ;EXPONENT OF 10 WAS ZERO
PUSH P,A ;SAVE BITS
MOVE A,[EXP.P1,,FR.P1] ;ASSUME EXPONENT OF 10 IS POSITIVE
JUMPG D,DFSCA
TLO SBITS2,EXPNEG ;EXPONENT WAS NEG
MOVN D,D
MOVE A,[EXP.M1,,FR.M1] ;MULT BY NEG PWRS OF 10
DFSCA: MOVEM LPSA,SCNVAL
MOVEM LPSA+1,DBLVAL
TRNE D,777700 ;CHECK MAGNITUDE OF EXP OF 10
JRST EXPERR ;EXPONENT IS TOO BIG
TRNE D,40 ;E+-32 INVOLVED?
TLNE SBITS2,EXPNEG ;EXPONENT NEGATIVE?
JRST MULOOP ;NO
TRNE D,20 ;OUT OF RANGE IF E-48
JRST EXPERR ;BAD
MULOOP: TRZE D,1 ;SHOULD WE MULTIPLY?
PUSHJ P,DMUL.. ;YES
JUMPE D,DFSC1 ;QUIT IF EXPONENT NOW ZERO
ASH D,-1 ;NEXT BIT INTO POSITION
AOBJN A,.+1 ;ADD 1 TO LH
AOJA A,MULOOP ;AND 2 TO RH
;MULTIPLY TWO DOUBLE-LENGTH PURE FRACTIONS. ONE IS (A), OTHER IS SCNVAL, DBLVAL PAIR
;RETURN DOUBLE-LENGTH RESULT IN SCNVAL, DBLVAL
;SCALE FACTOR KEPT IN C
DMUL..:
NOKL10< PUSH P,SCNVAL ;SAVE HIGH
SETZM SCNVAL ;1ST WORD, FINAL PRODUCT
MOVE LPSA,(A) ;HIGH
MULM LPSA,DBLVAL ;* LOW
;IGNORING 3RD WORDS: 8 EXPONENT BITS TO BURN
MOVE LPSA,1(A) ;LOW
MUL LPSA,(P) ;* HIGH
TLO LPSA,400000 ;PREVENT OVERFLOWS
ADD LPSA,DBLVAL ;ADD 2ND WORDS
TLZN LPSA,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
AOS SCNVAL ;YES, DO CARRY (SETS SCNVAL TO 1)
MOVEM LPSA,DBLVAL ;STORE LOW RESULT
POP P,LPSA ;HIGH
MUL LPSA,(A) ;* HIGH
TLO LPSA+1,400000 ;PREVENT OVERFLOW
ADD LPSA+1,DBLVAL ;COLLECT 2ND WORD
TLZN LPSA+1,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
ADDI LPSA,1 ;YES
ADD LPSA,SCNVAL ;COLLECT 1ST WORD (THIS CAN'T OVERFLOW)
>;NOKL10
KL10<
DMOVE LPSA,SCNVAL
DMOVEM LPSA+2,SCNVAL
DMUL LPSA,(A)
JOV [TLO SBITS2,INTOV
JRST .+1]
DMOVE LPSA+2,SCNVAL
>;KL10
TLNE LPSA,(1B1) ;NORMALIZED FRACTION?
JRST .+3 ;YES
ASHC LPSA,1 ;NO, SHIFT OVER
SUBI C,1 ;AND ADJUST EXPONENT
MOVS A,A ;COLLECT EXPONENT CHANGES
ADD C,(A)
MOVS A,A
MOVEM LPSA,SCNVAL ;STORE RESULT SO FAR
MOVEM LPSA+1,DBLVAL
POPJ P,
DFSC1: POP P,A ;GET BITS BACK
MOVE LPSA,SCNVAL ;GET VALUE
MOVE LPSA+1,DBLVAL
TRNN LPSA+1,400 ;ROUND?
JRST DFSC2 ;NO
TLO LPSA,400000 ;PREVENT
TLO LPSA+1,400000 ; OVERFLOWS
ADDI LPSA+1,400 ;YES
TLZN LPSA+1,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
ADDI LPSA,1 ;YES
TLZE LPSA,400000
JRST DFSC2 ;NO OVERFLOW
MOVSI LPSA,200000 ;HIGH WD EXACTLY .1 (BASE 2)
ADDI C,1 ;EXPONENT HAS INCREASED
LSH LPSA+1,-1 ;KEEP LOW WD ALIGNED PROPERLY
DFSC2: ASHC LPSA,-8 ;MAKE ROOM FOR EXPONENT
FSC LPSA,200(C) ;AND INSERT IT
JFOV EXPERR
JRST ENDNUM ;FINALLY DONE (EXCEPT TEST OVERFLOW FLAGS)
EXPER3: SUB P,X33
EXPERR: ERR <EXPONENT RANGE EXCEEDED>,1
HRLOI LPSA,377777 ;SET UP AN INFINITY
MOVE LPSA+1,LPSA
TLNE SBITS2,EXPNEG
RETZER: SETZB LPSA,LPSA+1 ;BUT USE ZERO IF EXPONENT WAS NEG
JRST ENDNUM
ENDNMZ: PUSHJ P,TZMUL ;TRAILING ZEROES NOW SIGNIF.
MOVE LPSA,SCNVAL
MOVE LPSA+1,DBLVAL
ENDNUM: CAIE B,12 ;EXCEPT FOR LINE FEED,
MOVEM B,SAVCHR ;SAVE FOR NEXT SCAN
MOVEM B,LSTCHR ;ALSO HERE ANY TIME
TLNE A,LETDG ;MUST NOT BE LEETTER OR DIG OR
ERR <ILLEGAL CONSTANT>,1
TRNN SBITS2,FLOTNG ;REAL OR INTEGER?
JRST INTEG
TRNN SBITS2,DBLPRC
SNGL LPSA,LPSA ;ONLY SINGLE ASKED FOR
JRST NUMRET
INTEG: SKIPN C ;MAKE SURE THERE WAS SOMETHING
ERR <ILLEGAL INTEGER CONSTANT>,1
TLNE SBITS2,INTOV ;INTEGER OVERFLOW?
ERR <INTEGER CONSTANT TOO LARGE>,1
TRO SBITS2,INTEGR ;MARK TYPE
NUMRET: SKIPN SWCPRS ; INSIDE FALSE PART OF CONDITIONAL COMPILATION?
JRST NUMTYP ; YES, DON'T ENTER THE NUMBER
HRLI SBITS2,CNST ; MAKE INTO TBITS WORD
PUSH P,BITS ;DON'T EFFECT OUTSIDE WORLD
MOVEM SBITS2,BITS ;SET UP FOR ENTER
JUMPN LPSA,.+2
EXCH LPSA,LPSA+1 ;SINGLE PRECISION INTEGER ONLY
MOVEM LPSA,SCNVAL
MOVEM LPSA+1,DBLVAL
PUSHJ P,NHASH ;LOOK UP THE NUMBER
SKIPG NEWSYM ;WAS IT THERE ALREADY?
PUSHJ P,ENTERS ; NO, BUT IT IS NOW
POP P,BITS ;GET OLD BITS BACK
MOVE LPSA,NEWSYM ;SET UP FOR STACKING
NUMTYP: MOVE A,%NUMCON
JRST STACK ;GO DO IT
Comment ⊗
Get an integer (base 10 only for the present).
C has # trailing zeroes ,, # digits
⊗
LGETINT: ;GET A CHARACTER FIRST
ILDB B,PNEXTC
MGETINT: ;GET BITS FIRST
SKIPGE A,SCNTBL(B)
PUSHJ P,(A) ;SIGH!
LSTDPB
GETINT: JOV .+1 ;GET AN INTEGER
TDZA C,C ;SET # DECIMAL PLACES TO 0
ML$CHR ;PUT AWAY
GETLUP: TLNN A,DIG ;IS IT A DIG?
POPJ P, ; NO, RETURN
CAIN B,"0"
AOBJP C,TZ ;A TRAILING ZERO
TLNN C,-1 ;HAVE DIGIT. WERE THERE TRAILING ZEROES BEFORE IT?
AOJA C,NOTZ ;NO. COUNT DIGIT AND LEAVE
ADDI C,1 ;YES. COUNT DIGIT ANYWAY
PUSHJ P,TZMUL ;TRAILING ZEROES NOW SIGNIF.
NOTZ: PUSHJ P,M10ADA ;MULTIPLY BY 10 AND ADD A
TZ: ILDB B,PNEXTC ; GET ANOTHER
SKIPGE A,SCNTBL(B) ;COULD IT STILL BE A DIGIT?
PUSHJ P,(A)
JRST GETLUP-1(TBITS2);LOOP
TZMUL: HLRZ D,C ;# TRAILING ZEROES
JUMPE D,TZMUL1 ;QUIT IF NONE
CAIN D,(C)
JRST TZMUL1 ;TRAILERS WERE ALSO LEADERS!
PUSH P,A
MOVEI A,"0"
PUSHJ P,M10ADA ;ADJUST VALUE TO ACCOUNT FOR TRAILING ZEROES
SOJG D,.-1
POP P,A
TZMUL1: TLZ C,-1 ;NO TRAILING ZEROES NOW
POPJ P,
M10ADA:
NOKL10< SKIPN LPSA,SCNVAL ;ANY HIGH ORDER PART?
JRST M10A.1 ;NO
IMULI LPSA,=10 ;YES
JOV [TLO SBITS2,INTOV
JRST .+1]
MOVEM LPSA,SCNVAL
M10A.1: MOVE LPSA,DBLVAL ;LOW HALF
MULI LPSA,=10
TLO LPSA+1,400000 ;PREVENT OVERFLOW
ADDI LPSA+1,-"0"(A) ;ADD THE NEW DIGIT
TLZN LPSA+1,400000 ;WOULD THERE HAVE BEEN AN OVERFLOW?
ADDI LPSA,1 ;YES. (THIS CAN'T OVERFLOW; LPSA WAS AT MOST =9)
MOVEM LPSA+1,DBLVAL ;SAVE LOW HALF
TLO LPSA,400000
ADD LPSA,SCNVAL ;TAKE CARE OF HIGH HALF
TLZN LPSA,400000
TLO SBITS2,INTOV
MOVEM LPSA,SCNVAL ;SAVE HIGH HALF
>;NOKL10
KL10<
DMOVE LPSA,SCNVAL ;FETCH ONE VALUE
DMOVEM LPSA+2,SCNVAL ;SAVE 2 REGS CLOBBERED BY DMUL
DMUL LPSA,[0 ↔ =10] ;RESULT SHOULD BE IN LPSA+3,+4
JOV [TLO SBITS2,INTOV
JRST .+1]
JUMPN LPSA,.+2
JUMPE LPSA+1,.+2
TLO SBITS2,INTOV ;BUT IT MIGHT HAVE OVERFLOWED
MOVEI LPSA+1,-"0"(A) ;CONSTRUCT VALUE TO ADD. LPSA HAS 0 ALREADY
DADD LPSA,LPSA+2 ;ADD
JOV [TLO SBITS2,INTOV
JRST .+1]
DMOVE LPSA+2,SCNVAL ;RESTORE 2 REGS
DMOVEM LPSA,SCNVAL
>;KL10
POPJ P,
FR.P1: 240000,,0 ;10↑1 PURE FRACTION PART
0
310000,,0 ;10↑2
0
234200,,0 ;10↑4
0
276570,,200000 ;10↑8
0
216067,,446770 ;10↑16
040000,,0
235613,,266501 ;10↑32
133413,,263574
EXP.P1: 4 ;POWER OF 2 EXPONENT PART
7
16
33
66
153
FR.M1: 314631,,463146 ;10↑-1
146314,,631463
243656,,050753 ;10↑-2
205075,,314217
321556,,135307 ;10↑-4
020626,,245364
253630,,734214 ;10↑-8
043034,,737425
346453,,122766 ;10↑-16
042336,,053314
317542,,172552 ;10↑-32
051631,,227215
EXP.M1: -3
-6
-15
-32
-65
-152
Comment ⊗ Print the last character, then stack the result
⊗
LSTACK: LSTDPB
JRST STACK
Comment ⊗ We have been backed up by the wonderful error routines
in the parser. So now we return things to their normal states:
⊗
GOAGAIN: MOVE LPSA,SAVSEM
SKIPA A,SAVPAR
DSCR CHAROUT -- returns value for single char operator.
DES No Semantic stack entry is necessary (a null pointer
is stacked). The indirect, address, and index fields
of the character comprise its PL-ID.
⊗
CHAROUT:
MOVEI LPSA,0 ;SEMANTICS RETURNED ARE NULL
DSCR STACK
DES All SCANNER sub-sections return here to place Parse
token on parse stack (PPDL) and Semantics on EXEC stack
(GPDL). STACK is bypassed only by the string constant
scanner when calling SCANNER recursively to modify for-
mal parameters.
⊗
STACK: HRRZS LPSA ;MAKE SURE ONLY RH
TLZ A,777740 ;CLEAR SCANNER BITS
PUSH SP,A ;PL ENTRY
EXCH SP,GPSAV ;GET GP POINTER
PUSH SP,LPSA ;SEMANTIC ENTRY
EXCH SP,GPSAV ;PUT AWAY SEMANTIC POINTER
MOVEM SP,PPSAV ;PUT AWAY PARSE POINTER
SKIPN CNDLST ; IN FALSE PART OF COND. COMP.?
POPJ P, ; NO, RETURN
MOVE SBITS2,LPTRSV ; YES, DO NOT LIST - I.E. RESTORE LPNT
ML$BAK
POPJ P,
DSCR INSET
DES prepare for ID or STRING constant scan
RES sets up TOPBYTE, REMCHR, PNAME, TOPSTR, C (char count)
SID Uses TEMP
⊗
↑↑INSET: MOVEI C,0 ;CLEAR CHARACTER COUNT
;;#GI# DCS 2-5-72 REMOVE TOPSTR
MOVSI TEMP,40 ; MOST HARMLESS ¬CONST BIT
;;#GI
MOVEM TEMP,PNAME ;FIRST PNAME DESCRIPTOR WORD
HLL TEMP,TOPBYTE(USER) ;ADJUST REMCHR FOR
HRRI TEMP,[BYTE (7) 0,4,3,2,1,0] ;CHARACTERS SKIPPED
ILDB TEMP,TEMP
ADDM TEMP,REMCHR(USER) ;UPDATE REMCHR
SKIPL TEMP,TOPBYTE(USER) ;ADJUST TOPBYTE TO
ADDI TEMP,1 ; WORD BDRY (440700 OK ALREADY)
HRLI TEMP,440700 ;[POINT 7,WORD]
MOVEM TEMP,PNAME+1 ;BP FOR THIS STRING
MOVEM TEMP,TOPBYTE(USER) ;ADJUSTED TOPBYTE
;NOW GC CAN GO AHEAD AND HAPPEN
POPJ P, ;ALL SET
SUBTTL SCANNER I/O, MACRO EXPANSION
DSCR CSPEC, SEOL, SEOM, SEOB -- Special handling routines
PAR A contains address of appropriate routine. Many SCANNER
state variables are perused and changed.
RES PNEXTC, SAVCHR, and friends are set to proper values after
more file has been read, macro has been returned from, etc.
DES Called by SCANNER routines when an input char is detected
whose SCNTBL entry indicates special conditions. The routine
address is in the right half of this SCNTBL word.
CSPEC is sometimes called to save the char count (C) before dis-
patching to the special routine (for STRINGC integrity)
SEOL is called when the SCANNER is reading from the input file
or a macro and an end of of line condition is detected. A
new line is found and the PNEXTC pointer is reinitialized.
EOM is called when the SCANNER is reading a DEFINE body, and end
of text (177 char) is seen. If the character following the EOT
is non-zero, it indicates the right actual parameter to expand
here. If it is 0, it signals end of macro. Old input values are
restored, things like PNEXTC and SAVCHR.
SEOB is called when a 0 is detected while scanning. This can mean
two things -- a TECO-type file is being read, and a buffer has
ended in the middle of a line, or the string scanner has called
SCANNER recursively to pick up a possible formal param. In either
case the right thing happens.
SEE ADVBUF routine, which these call for for file input
⊗
ZERODATA (SCANNER INPUT/OUTPUT VARIABLES)
;LINNUM -- physical line number of this output line. Used
; to force page ejects and new sub-numbering when too
; many have gone out since last logical page encountered
?LINNUM: 0
?LNCREF: 0 ;IF ON, CREF INFO HAS GONE OUT FOR THIS LINE
COMMENT ⊗
LPNT -- byte pointer used to deposit characters in output
buffer (LSTBUF) -- SEOL code transfers this data, along
with CREF data, to the output file buffers. IDPB B,LPNT
instructions are scattered throughout the SCANNER to build
this output file
⊗
↑↑LPNT: 0
↑↑LSTBUF: 0 ;ADDRESS OF LISTING BUFFER
;LSTCHR -- saved scan-ahead character -- sometimes slightly different
; from SAVCHR -- used for error message (the arrow) output
↑↑LSTCHR: 0
ENDDATA
SUBTTL Cspec, Seol
; CALL SPECIAL ROUTINE, BUT FIRST MAKE SURE CHARACTER COUNT IS
; CORRECT IN "PNAME" (THE DESCRIPTOR FOR THE CURRENTLY DEVELOPING
; IDENTIFIER OR STRING)
CSPEC: HRRM C,PNAME ;UPDATE CHAR COUNT
JRST (A) ;DISPATCH TO SPECIFIED ROUTINE
SEOL:
PUSH P,C ;SAVE CHARACTER COUNT (CLOBBERED BY HDROV)
TRNE TBITS2,NOLIST ;ARE WE LISTING NOW?
JRST NOLST ; NO
ifn 0,<;;JFR 12-11-76 causes Address check for device DSK on PASS1.SAI[PUB,SYS]
;; \UR#5\ BETTER LISTING FOR CONDITIONAL COMPILATION
SKIPE CNDLST ;SUPPRESSING LISTING?
JRST [ MOVE SBITS2,LPTRSV
ML$BAK
JRST NOLST ]
;; \UR#5\
>;ifn 0,
; TIME TO DO A LISTING
MOVE TBITS,LPNT ;PUT THE LINE FEED IN LIST BUFFER
LLL2: IDPB B,TBITS
MOVEI B,0 ;ZERO REMAINING CHARS OF CURRENT WORD
TLNE TBITS,760000 ;ALL DONE?
JRST LLL2 ;NO, PUT OUT ZERO
MOVEM TBITS,LPNT ;SAVE AGAIN FOR A WHILE
;IF CREFING WAS DONE ON THIS LINE, TERMINATE THE CREF STUFF
SKIPN LNCREF ;CREF GONE OUT?
JRST NOLNX ;NOPE
SETZM LNCREF ;RESET.
MOVEI TBITS,177 ;DELETE
PUSHJ P,CHROUT
MOVEI TBITS,"A" ;AND AN A
PUSHJ P,CHROUT
NOLNX:
; IF PCNT OUTPUT DESIRED, DO THAT FIRST
TLNN TBITS2,PCOUT ;WANT TO PRINT PC?
JRST NOPC ; NO
MOVE TBITS,PCNT ;YET ANOTHER FRNP
ADD TBITS,LSTSTRT ;OFFSET BY USER-PROVIDED LOC
MOVEI B,CHROUT ;ROUTINE TO USE
MOVEI PNT2,6 ;ALWAYS DO 6 CHARS
BAIL<
SKIPN BAILON
JRST .+4 ;NO BAIL
HRRZ TBITS,BCORDN ;IF DEBUGGER IN USE, PRINT COORDINATE INSTEAD
PUSHJ P,FRNPD ;IN DECIMAL
JRST .+2 ;AND SKIP OVER PC PRINTER
>;BAIL
PUSHJ P,[
↑FRNP1: SKIPA TEMP,[10]
↑FRNPD: MOVEI TEMP,=10
FRNP3: IDIV TBITS,TEMP
IORI SBITS,"0"
HRLM SBITS,(P)
SOJE PNT2,FRNP2
PUSHJ P,FRNP3
FRNP2: HLRZ TBITS,(P)
JRST (B) ;CHARACTER TO OUTPUT
]
MOVE SBITS,[POINT 7,[ASCII / /]]
PUSHJ P,LL1+1 ;SEE BELOW
; IF LINE NUMBER OUTPUT DESIRED, DO IT NEXT.
NOPC: MOVE SBITS,[POINT 7,ASCLIN] ;ASSUME WANT LINE NUMBER
TLNE TBITS2,LINESO ;IS IT THE CASE
PUSHJ P,[LL1: PUSHJ P,CHROUT ;CHARACTER TO OUTPUT
ILDB TBITS,SBITS ;NEXT CHAR
JUMPN TBITS,LL1
POPJ P,]+1 ;KLUDGE........
; NEXT LINE UP THE BP FOR SOME RAPID-FIRE STUFF
NOTENX <
NLNO: MOVE TBITS,LSTPNT ;LST OUTPUT BYTE POINTER
MOVE SBITS,LSTCNT ;IF ALREADY LINED UP....
HARRY: TLNN TBITS,760000 ;LINED UP WHEN PTR PART IS 01
JRST LNDUP
SOS SBITS,LSTCNT ;DENOTE CHANGE
IBP TBITS ;MAINLY WANT TO ADJUST COUNT
JRST HARRY ;COULD PROBABLY DO CALCULATION
LNDUP: MOVEM TBITS,LSTPNT ;UPDATE
IDIVI SBITS,5 ;#WORDS LEFT, NO REMAINDER GUARANTEED
AOS PNT2,LPNT ;WE GOT THIS FAR
HRRZS PNT2
SUB PNT2,LSTBUF ;HOW MANY WORDS?
CAMGE SBITS,PNT2 ;IS THERE ROOM?
PUSHJ P,LSTDO ; NOW THERE IS
BAIL<
ADDM PNT2,BLSTFC ;WORD COUNT FOR LIST FILE
>;BAIL
MOVNI SBITS,5 ;UPDATE CHAR COUNT
IMUL SBITS,PNT2
ADDM SBITS,LSTCNT
EXCH PNT2,LSTPNT ;AND LSTPNT
ADDM PNT2,LSTPNT ;PREV VERSION IN PNT2
ADDI PNT2,1
HRL PNT2,LSTBUF ;BLT WORD (LSTBUF,,OUTBUF)
BLT PNT2,@LSTPNT ;WRITE THE LINE!
>;NOTENX
TENX<
PUSH P,C
PUSH P,B
HRRZ 2,LPNT
HRRZ 3,LSTBUF
SUBI 3,1(2) ;-#WRDS, INCLUDING CURRENT WORD
IMULI 3,5 ;-#CHRS, INCL. EXTRAS IN CURRENT WRD
SKIPA 2,LPNT
IBP 2
TLNE 2,760000 ;LAST CHAR IN WORD COUNTED?
AOJA 3,.-2 ;UN-COUNT AN EXTRA CHAR
BAIL<
ADDM 3,BLSTFC ; UPDATE COUNT
>;BAIL
EXCH 1,LISJFN
HRRO 2,LSTBUF
JSYS SOUT
EXCH 1,LISJFN
HRRZ 3,LSTBUF ;NOW ZERO LSTBUF, JUST IN CASE.
SETZM (3)
HRLI 3,(3)
ADDI 3,1
BLT 3,(2)
POP P,B
POP P,C
>;TENX
HRRO TEMP,LSTBUF ;ADDR OF FIRST WORD OF BUFFER
SUB TEMP,[XWD 677077,1] ;POINT 5,@LSTBUF,29
MOVEM TEMP,LPNT ;NEW LIST POINTER
IFN FTL$DBG,<
MOVEI TEMP,5*=50
MOVEM TEMP,L$CNT
>;IFN FTL$DBG
MOVE TEMP,[ASCID / /] ;BLANKS IN CASE
MOVEM TEMP,ASCLIN ;IN MACRO AND MORE LINES TO COME
AOS TBITS,LINNUM ;CHECK LINE OVERFLOW
IDIVI TBITS,PGSIZ
SKIPN SBITS
PUSHJ P,HDROV ;PRINT FF
; ENOUGH OUTPUT, NOW FOR SOME INPUT
NOLST:
SKIPE SRCDLY ;SWITCHING SOURCE INPUT?
JRST NXTSRC ; YES
MOVE PNT,PNEXTC
IBP PNT
MOVEM PNT,PLINE ;UPDATE IF MACRO
TLNE TBITS2,MACIN ;DONE IF MACRO
JRST LDO1 ;DONE
; MAKE A LINE NUMBER IN CASE FILE HAS NONE
AOS TBITS,BINLIN ;SEQUENTIAL WITHIN PAGE
;;%DM% CMU =F4= LDE 14-JUN-76 GENERATE MORE LIKELY SOS LINE NUMBERS.
EXPO <
CAIG TBITS,=999 ;HIGHEST LEGAL LINE NUMBER
IMULI TBITS,=100
>;EXPO =F4=
;;%DM% ↑
MOVEI B,[IDPB TBITS,A ;ROUTINE TO DISPENSE CHARS
POPJ P,]
MOVEI PNT2,5 ;5 CHARS ALWAYS
MOVE A,[POINT 7,ASCLIN] ;PUT IT HERE
PUSHJ P,FRNPD ;GET ASCII VERSION
MOVEI TEMP,1
ORM TEMP,ASCLIN ;MAKE ASCID
; ACTUAL LINE NUMBER WILL OVERRIDE THIS IF THERE
LDB TEMP,PNT ;NEXT CHAR.
JUMPE TEMP,NULCHR ;GO FIND NON-NULL
LINCHA: MOVE TEMP,(PNT)
LINCHK: TRNN TEMP,1 ;ARE WE IN LINE NUMBER?
JRST LDUNA ;NO THIS IS THE NEXT CHAR.
BAIL< ;JFR 4-18-76 AT COMPLAINT OF REM
PUSH P,TEMP
SKIPN BPNXTC ;IF SOURCE NOT MARKED
PUSHJ P,BMKSRC ;THEN MARK IT BEGINNING AT LINE NUMBER
POP P,TEMP
>;BAIL
CAME TEMP,[ASCID/ /];IS IT A PAGE MARK PERHAPS
AOJA PNT,LDUN ;NO JUST SKIP LINE NUM AND TAB
MOVEM PNT,PNEXTC ;HDR CLOBBERS THIS
PUSHJ P,HDR ;WRITE PAGE MARK, NEW TITLE LINE
MOVE PNT,PNEXTC ;GET HIM BACK
SKIPN 1(PNT) ;END OF BUFFER?
PUSHJ P,ADVBUF ;YES, GET NEXT.
ADDI PNT,1 ;POINT BEHIND NEXT LINE NUMBER
SKIPN TEMP,1(PNT) ;IS IT IN THIS BUFFER?
PUSHJ P,ADVBUF ;NO.
HRLI PNT,350700 ;POINT TO FIRST CHAR. OF LINE NUMBER
AOJA PNT,LINCHA ;AND DO IT AGAIN (IN CASE 2 PAGE MARKS).
NULCHR: ILDB B,PNT ;MOVE ON UP
MOVE TEMP,(PNT) ;GET COMPLETE WORD
JUMPN B,LINCHK ;FINALLY WE GOT SOMETHING
IBP PNEXTC ;KEEP IN STEP
JUMPN TEMP,NULCHR ;END OF BUFFER?
PUSHJ P,ADVBUF ;YES.
JRST NULCHR ;HERE WE GO LOOP-D-LOOP
LDUN: SKIPE (PNT) ;IS TAB IN THIS BUFFER
JRST LDUN1 ;YES
PUSHJ P,ADVBUF ;NO
IBP PNT ;MAKE IT CURRENT
LDUN1: MOVEM TEMP,ASCLIN ;CURRENT LINE#
MOVEM PNT,PNEXTC ;THIS GUY POINTS TO TAB
LDUNA: MOVE TEMP,PNEXTC ;MAY NOT USE PNT
MOVEM TEMP,PLINE ;BEGINNING OF LINE
IFN FTDEBUG,<
AOS LINCNT ;COUNT NUMBER OF LINES SEEN
SKIPL STPAGE ;ARE WE LOOKING FOR A PAGE/LINE?
PUSHJ P,STPLIN ;LINE BREAK IF NECESSARY.
>
LDO1: MOVEI B,12 ;GET LINE FEED BACK.
MOVEI A,0 ;HARMLESS LF
MOVE USER,GOGTAB
POP P,C ;RESTORE CHARACTER COUNT.
POPJ P, ;WASN'T THAT WONDERFUL
; HERE WE SAVE INFO ABOUT SOURCE FILE, AND PREPARE TO GET INFO
; ABOUT NEW ONE.
NXTSRC:
NOTENX <
MOVE A,AVLSRC ;BITS TELLING FREE CHANNELS
JFFO A,GOTNEW ;FOUND A FREE ONE
ERR <NO MORE AVAILABLE SOURCE CHANNELS>
GOTNEW:
PUSH P,B ;SAVE NEW CHANNEL #
MOVEI C,ENDSRC-SRCCDB+1 ;SIZE OF SAVE AREA
>;NOTENX
TENX <
MOVEI C,ENDSRC-BGNSWA+1 ;SIZE OF SAVE AREA
>;TENX
PUSHJ P,CORGET ;GET ONE
ERR <NO CORE AVAILABLE FOR FILE SWITCH>
HRR TEMP,B ;BLT WORD
NOTENX <
HRLI TEMP,SRCCDB
BLT TEMP,ENDSRC-SRCCDB(B)
>;NOTENX
TENX <
HRLI TEMP,BGNSWA
BLT TEMP,ENDSRC-BGNSWA(B)
>;TENX
HRRZM B,SWTLNK ;SAVE PTR TO SAVE AREA
TLO TBITS2,INSWT ;WE'RE SCANNING SWITCHED-TO FILE
MOVEM TBITS2,SCNWRD
SETZM LSTCHR ;ALWAYS DO IT
SETZM SAVCHR
NOTENX <
SETZM SAVTYI
SETZM EOF
SETZM EOL
POP P,A ;CHANNEL NUMBER
FOR II←0,1 <
DPB A,[POINT 4,SRCOP+II,12]
>
FOR II←0,3 <
DPB A,[POINT 4,INSRC+II,12]
>
NOEXPO <
DPB A,[POINT 4,SRCOP+2,12] ;PUSHJ IF EXPO
>;NOEXPO
MOVN TEMP,A ;-CHANNEL NUMBER
MOVSI LPSA,400000 ;BIT
LSH LPSA,(TEMP)
ANDCAM LPSA,AVLSRC ;THIS CHANNEL UNAVAILABLE
>;NOTENX
;;%CF% JFR 7-8-75
IFN 0,<
AOS TEMP,LININD ;HOW FAR IN TO SPACE ON TTY
CAILE TEMP,MAXIND ;TOO FAR?
SOS LININD ;NOT REALLY
>;IFN 0
MOVEI TEMP,2 ;INDENT ON TTY
ADDM TEMP,LININD
;;%CF% ↑
NOTENX <
SETOM TYICORE ;WILL SCAN FROM STRING
>;NOTENX
MOVE TEMP,GENLEF+2
;; %AN% CHECK TO BE SURE STRING CONSTANT, SINCE PRODUCTIONS NO LONGER CHECK
MOVE TEMP,$TBITS(TEMP)
TRNN TEMP,STRING
ERR <SOURCE!FILE NAME MUST BE STRING>
MOVE TEMP,GENLEF+2
;; %AN%
HRROI TEMP,$PNAME+1(TEMP) ;GET STRING TO BE SCANNED
POP TEMP,PNAME+1
POP TEMP,PNAME ;PUT ER THERE
BAIL<
SKIPN SRCDLY ;SWITCHING SOURCE INPUT?
JRST BNSRCD ;NO
QPUSH BSRCFQ,BSRCFC ;YES. SAVE BUFF. ADDR,,BLOCK COUNT
QPUSH BSRCFQ,BSRCFN ;SAVE FILE NUMBER
;;#%%# ! BY JFR 11-17-74 ZERO THE BLOCK COUNT FOR THE NEW FILE
SETZM BSRCFC
BNSRCD:
>;BAIL
PUSHJ P,ENDSWT ;USE EOF CODE TO GET NEW FILE
;SRCDLY WILL BE TURNED OFF HERE
JRST NOLST ;AND GO BACK TO END OF LINE CODE
; END OF BUFFER CODE.
SEOB: TLNE TBITS2,LOKPRM ;END OF POSSIBLE MACRO PARAM SCAN?
POPJ P, ;YES, IGNORE THE WHOLE THING
MOVE PNT,PNEXTC ;CURRENT BP
JUMPE PNT,ADVIT ;INITIALIZATION TIME
SKIPE TEMP,(PNT) ;REAL END OF BUFFER?
JRST SEOBAK ; NO, WILL COME BACK UNTIL NOT NULL
ADVIT:
;; #PF# SUPPLY CORRECT NUMBER OF THINGS ON STACK IN CASE ADVBUG DOESN'T RETURN
PUSH P,C
PUSHJ P,ADVBUF
POP P,C
;; #PF#
TRNN TEMP,1 ;LINE NUMBER? (INIT SCAN FOR SOS FILES)
JRST SEOBAK ;NO, FIND NEXT CHAR
MOVEM TEMP,ASCLIN ;SAVE LINE NUMBER
IBP PNT ;OVER TAB
ADDI PNT,1 ;BACK IN BUSINESS
SEOBAK: MOVEM PNT,PLINE ;BEGINNING OF LINE
ILDB B,PNT ;GET CHAR
MOVEM PNT,PNEXTC ;UPDATE
SKIPGE A,SCNTBL(B) ;SPECIAL?
JRST (A) ;YES, HANDLE
POPJ P, ;NO, DONE
; END OF PAGE (TECO FILES ONLY)
SEOP: PUSHJ P,HDR ;PRINT FF, TITLE LINE
;; #PC#! OVERWRITING FIRST LINE OF CREF
MOVEI B,0 ;PRETEND A NULL CHARACTER
MOVEI A,0 ;BITS FOR CR
POPJ P,
Comment ⊗ Parameter delimiter or end of message ⊗
EOM: ILDB B,PNEXTC ;CHECK WHICH
SKIPN ASGFLG ;ASSIGNC PARAMETER NUMBER?
JRST CONEOM ;NO,
MOVE LPSA,B ;RETURN THE PARAMETER NUMBER IN THE
MOVE A,%NUMCON ; SEMANTIC STACK
SUB P,X11 ; TO OVERRIDE THE PUSHJ HERE
JRST STACK ;
CONEOM: JUMPE B,RESTOR ;ZERO, END OF MACRO (OR PARAM) TEXT
; PARAMETER NEEDED
SETZM SAVCHR
SETZM LSTCHR
MOVE LPSA,DEFRNG
GETIT: SOJE B,GOTIT ;LOOK FOR THE PARAMETER OF PROPER NUMBER
RIGHT ,%RVARB,<[ERR <NOT ENOUGH ARGUMENTS SUPPLIED TO MACRO>]>
JRST GETIT ;KEEP LOOKING
GOTIT:
DFNEST: MOVE PNT,DEFPDP ;NOW SAVE STATE OF SCANNER AND RECUR
PUSH PNT,DEFRNG ; SAVE DEFRNG WHICH CONTAINS THE LENGTH OF THE
PUSH PNT,PNEXTC-1 ; ACTUAL PARAMETER TO BE EXPANDED. THIS WILL
; ENSURE THAT WHEN A RETURN IS MADE FROM
; EXPANDING THE ACTUAL THERE WILL BE ENOUGH
; STRING SPACE FOR THE REST OF THE MACRO.
PUSH PNT,PNEXTC ;INPUT POINTER
PUSH PNT,SAVCHR ;SCANNED AHEAD
MOVEM PNT,DEFPDP ;SAVE POINTER
PUSHJ P,SGCOL1 ;MAKE SURE ENOUGH ROOM
HLLZ TEMP,$PNAME(LPSA) ;STRING NUMBER
MOVEM TEMP,PNEXTC-1
MOVEM TEMP,PLINE-1
MOVEW PNEXTC,$PNAME+1(LPSA) ;NEW INPUT POINTER
MOVEM TEMP,PLINE
MOVEI B,"<" ;MARKER FOR MACRO EXP
;;#YV# JFR 2-4-77
TLNN TBITS2,LSTEXP ;WANT IT?
JRST DFNE.1 ;SURELY NOT
LSTDPB ;MAYBE
DFNE.1: TLO TBITS2,MACIN ;MARK IN MACRO
TLNN TBITS2,MACEXP ;EXPANDING?
TRO TBITS2,NOLIST ;NO
;;#YV# ↑
MOVEM TBITS2,SCNWRD ;UPDATE
TLNE FF,PRMSCN ; SCANNING PARAMETERS?
SKIPN REQDLM ; YES, IN SPECAIL DELIMITER MODE?
JRST NEWCHR ;GO GET FIRST NEW CHAR, RET
CAIN P,DSPRMS+3 ; IS 177-# FIRST ITEM IN ACTUAL PARAMETER
HRRI P,BALCHK ; YES, CHANGE RETURN ADDRESS TO REFLECT
; THAT UNTESTED COMMAS AND RIGHT PARS. WILL
; BREAK SCAN
DLMPRM: ILDB B,PNEXTC ; SCAN REST OF CHARS. INTO STRING CONSTANT
SKIPGE A,SCNTBL(B) ; SPECIAL?
;; #OG# ! MAKE SURE PNAME COUNT VALID IN CASE OF REAL GARBAGE COLLECT
PUSHJ P,CSPEC ; DO IT
LSTDPB ; PUT IT AWAY
IDPB B,TOPBYTE(USER) ; DEPOSIT IT
AOJA C,DLMPRM ; INCREMENT COUNT AND CONTINUE SCAN
RESTOR: MOVE PNT,DEFPDP
POP PNT,SAVCHR ;CHAR SCANNED AHEAD
POP PNT,PNEXTC ;OLD INPUT POINTER
POP PNT,PNEXTC-1 ;STRING NUMBER
ADD PNT,X22 ;START PLINE HERE
POP PNT,PLINE
POP PNT,PLINE-1
POP PNT,LPSA ;PERHAPS OLD DEFRNG
MOVEM PNT,DEFPDP
HLRZ TBITS,LPSA ; GET LENGTH OF MACRO TO WHICH ONE IS RETURNING AND
PUSHJ P,SGCOL2 ; INSURE ENOUGH ROOM IN STRING SPACE FOR IT
EXCH LPSA,DEFRNG ; GET OLD DEFRNG VALUE AND IF DIFFERENT FROM CURRENT
CAMN LPSA,DEFRNG ; VALUE THEN ONE IS DONE WITH THE MACRO AND THUS
JRST DDUN ; RING OF ACTUAL PARAMETERS (POINTED TO BY DEFRNG)
HRRZS LPSA ; IS REMOVED FROM THE STRING RING. NOTE THAT
PUSHJ P,KILLST ; KILLST EXPECTS LPSA WITH ZERO IN THE LEFT HALF.
DDUN: MOVEI B,">" ;END OF EXPANSION MARKER
;;#YV# JFR 2-4-77
TLNN TBITS2,LSTEXP
JRST DDUN.1
LSTDPB
DDUN.1:
SKIPN PNEXTC-1 ;OUT OF MACROS?
TLZA TBITS2,MACIN ;YES
JRST DUNRST ;NO
PUSHJ P,L$SET ;GET 'NOLIST' FROM ABSOLUTE BEARINGS
;;#YV# ↑
MOVE TEMP,IPLINE ;PLINE TO OUTER LEVEL VALUE
MOVEM TEMP,PLINE
SETZM PLINE-1
DUNRST: MOVEM TBITS2,SCNWRD ;SAFETY FIRST
; NOW GET A CHARACTER FOR THE SCANNER
TLNE FF,PRMSCN ; SCANNING PARAMETERS?
SKIPN REQDLM ; YES, IN SPECIAL DELIMITER MODE?
TRNA ; SKIP
SUB P,X11 ; POP RETURN ADDRESS, AND NOW WILL RETURN
; TO CHECK NESTING INSTEAD OF CONTINUING
; FORMAL PARAMETER SCAN
SKIPN B,SAVCHR ;HAVE IT ALREADY?
JRST NEWCHR ;NO
SETZM SAVCHR ;NO LONGER AHEAD (DCS 5-27-71)******
MOVE A,SCNTBL(B) ;YES, DON'T DISPATCH AGAIN
POPJ P,
NEWCHR: ILDB B,PNEXTC ;GET FROM INPUT
SKIPGE A,SCNTBL(B) ;SPECIAL?
JRST (A) ;YES, DISPATCH
POPJ P, ;NO, DONE
DSCR KILLST
CAL PUSHJ
PAR LPSA ptr to first Semblk to be released
RES Unlinks Semblk from %RSTR, releases it to free
storage, then continues right down %RVARB until
all Semblks on this VARB-Ring are released.
DES THIS ROUTINE IS IN THE WRONG PLACE!
SEE FREBLK, ULINK
⊗
↑KILLST:
PUSH P,LPSA
JUMPE LPSA,KLPDUN
KLLUP:
PUSHJ P,URGSTR ;UNLINK FROM STRING RING
FREBLK
RIGHT ,%RVARB,<[KLPDUN: POP P,LPSA
POPJ P,]>
JRST KLLUP
SUBTTL SCANNER INPUT AND LISTING ROUTINES
DSCR ADVBUF -- new input buffer routine
DES Reads a new input buffer, gets a new source file
if this one is exhausted or if file switching is
happening (prints loser message if no files remain),
and assures that the buffer ends in zero for EOB
detection by SEOL. The buffers were made long enough
to allow the inclusion of an extra word of zero.
SID Saves USER, C -- reinits A,B -- all others vulnerable
SEE SEOL, SEOB, routines which detect EOB and call ADVBUF.
⊗
NOTENX <
ADVBUF:
XCT INSRC ;ADVANCE BUFFER
XCT TSTSRC ;ANY ERRORS?
ERR <I-O ERROR ON SOURCE DEVICE>,1
XCT EOFSRC ;TO ENDFL ON EOF
JRST ENDFL
BAIL <
AOS BSRCFC ; ADD ONE TO SOURCE FILE BLOCK COUNT
>;BAIL
PUSHJ P,SGCHK ;STRING GC, IF NECESSARY, TBITS←SRCCNT
ADDI TBITS,4 ;(CHAR CT+4)/5 IS WORD COUNT
IDIVI TBITS,5
ADD TBITS,SRCPNT ;ADD BASE ADDRESS
IBP TBITS ;PTR TO LAST WORD+1, MAKE 0 TO
SETZM (TBITS) ; DENOTE EOB
MOVE PNT,SRCPNT ;RESET PNT TO CURRENT BP,
MOVEM PNT,PNEXTC ;FIX THIS GUY TOO.
MOVE TEMP,1(PNT) ; TEMP TO WORD NEXT REFERENCED
POPJ P,
; CHECK FOR STRING SPACE FULL, GC IF SO
SGCHK:
HRRZ TBITS,SRCCNT ;GET # OF CHARACTERS
MOVE TEMP,REMCHR(USER) ;TEST ENOUGH ROOM
ADD TEMP,TBITS
SKIPL TEMP ;IS THERE ENOUGH?
JRST SGCOL ;NO, COLLECT SPACE
POPJ P, ;NOT NECESSARY
ENDFL: XCT RELSRC ;RELEASE OLD FILE,
>;NOTENX
TENX <
ADVBUF: PUSH P,1
PUSH P,2
PUSH P,3
SKIPE TTYSRC ;CONTROLLING TERMINAL SOURCE DEVICE?
JRST ADVTTY ;YES
SKIPN TNXBND ;ANYTHING IN THE BUFFER?
JRST ADVBF1 ;NO DONT CHECK
HRRZ 1,PNEXTC ;LOOK AT ADDR
ADVBF2: CAML 1,TNXBND ;BEYOND BUFFER?
JRST ADVBF1 ;YES, CHECK EOF, GET MORE IF THERE
SKIPN 1(1) ;0 WORD?
AOJA 1,ADVBF2 ;YES KEEP LOOKING FOR INFO IN THE BUFFER
HRLI 1,010700
PUSH P,1 ;SAVE NEW BP
PUSHJ P,SGCHK ;CHECK GARBAGE COLLECTION
POP P,PNT ;BP TO PNT
POP P,3 ;RESTORE
POP P,2
POP P,1
MOVEM PNT,PNEXTC
MOVE TEMP,1(PNT) ;WHICH IS NON-ZERO BECAUSE WE JUST CHECKED
POPJ P,
ADVBF1: HRRZ 1,SRCJFN
JSYS GTSTS
TLNE 2,1000 ;EOF?
JRST ENDFL ;YES
BAIL <
AOS BSRCFC ;ADD ONE TO SOURCE FILE BLOCK COUNT
>;BAIL
HRR 2,SRCPNT
ADDI 2,1 ;SRCPNT IS A 7-BIT POINTER THAT IS A WORD EARLY
HRLI 2,444400 ;36-BIT POINTER.
MOVNI 3,SRCBSZ ;SIZE OF SRC BUF IN WRDS, MINUS EOB NULL
JSYS SIN ;SRCJFN OPEN FOR 36BIT INPUT
HRRZM 2,TNXBND ;SAVE END OF BUFFER ADDRESS FOR CHECKS ABOVE
SETZM 1(2) ;EOB NULL.
ADVDUN: PUSHJ P,SGCHK
POP P,3
POP P,2
POP P,1
MOVE PNT,SRCPNT ;RESET PNT TO CURRENT BP,
MOVEM PNT,PNEXTC ;FIX THIS GUY TOO.
MOVE TEMP,1(PNT) ;GET THE FIRST WORD IN TEMP
POPJ P,
; CHECK FOR STRING SPACE FULL, GC IF SO
SGCHK:
MOVEI TBITS,SRCBSZ*5 ;TENEX BUFFER SIZE
MOVE TEMP,REMCHR(USER) ;REMAINING CHARS
ADD TEMP,TBITS
SKIPL TEMP ;ENOUGH?
JRST SGCOL ;NOT ENUF STRNG SPACE FOR A FULL BUFFER
POPJ P, ;NOW THERE IS
DSCR ADVTTY
Since the boys at BBN have seen fit to not provide a standard
line editor into their system, we must resort to using some runtimes
to handle input in the case that the source is a TTY. We confine the
problem to the case that the source is the controlling teletype, as
indicated by the SRCTTY (set in CC), and use INTTY. INTTY at IMSSS
uses the IMSSS PSTIN jsys, otherwise a simulation of same.
⊗;
ADVTTY:
EXTERNAL .SKIP.
EXTERNAL INTTY
EXCH SP,STPSAV
PUSHJ P,INTTY ;GET A STRING USING THE PSTIN JSYS
POP SP,A ;BYTE POINTER
POP SP,C ;XWD -1, LENGTH -- STACKS ARE NOW OK
EXCH SP,STPSAV
MOVE B,.SKIP.
CAIN B,32 ;CONTROL-Z TO INDIATE EOF
JRST ENDFL ;YES END OF FILE
MOVE B,SRCPNT
HRRZ C,C
MOVNS C ;NUMBER OF CHARS TO TRANSFER
JSYS SIN ;USE SIN TO TRANSFER STRING
MOVEI C,15
IDPB C,B
MOVEI C,12
IDPB C,B
SETZ C,
REPEAT 5, <IDPB C,B> ;PUT NULLS THERE
SETZM (B) ;BE SURE TO INDICATE EOF
SETZM 1(B)
JRST ADVDUN ;AND FINISH UP, ABOVE
ENDFL:
HRRZ A,SRCJFN
JSYS CLOSF
JFCL
HRRZ A,SRCJFN
JSYS RLJFN
JFCL
POP P,3
POP P,2
POP P,1
>;TENX
ENDSWT: MOVEM TBITS2,SCNWRD ;UPDATE IN CORE VERSION
PUSHJ P,FILEIN ;FIND AND INIT NEW ONE
JRST [TLNN TBITS2,EOFOK
;;%CI% ! (4/5)
JRST ENDSW1
MOVNI B,1 ;MARK END OF FILE NEXT TIME
MOVEI A,1 ;HARMLESS, BUT BREAKS IGNORABLE
SUB P,X11 ;RETURN EARLY
POP P,C ;CHAR COUNT BACK
POPJ P,]
ENDSW3:
;;%DE% ! JFR 10-25-75 PUSHJ P,MAKT ;PREPARE NEW TITLE LINE
SKIPE SRCDLY ;COMING BACK FROM SWTCHED-TO FILE?
JRST SWTBKP ; YES, DO MORE BOOKKEEPING
SETZM FPAGNO ;FIRST PAGE IN NEW FILE
PUSHJ P,HDR ; , DENOTE IT
JRST ADVBUF ; OR PRINT LOSING MESSAGE, TRY AGAIN
↑↑XTCONT:MOVSI 16,INIACS ;RESTORE
BLT 16,16
JRST ENDSW3
;;%CI% (5/5) JFR 7-18-75
ENDSW1:
MOVEI TEMP,LININD+1 ;MAKE SURE TRKMCS AND TRKMCR POINT A LEGIT STRING
SKIPN TRKMCS
MOVEM TEMP,TRKMCS
SKIPN TRKMCR
MOVEM TEMP,TRKMCR
MOVEI TEMP,0 ;ASSUME FILE JUST RAN OUT
TLNE FF,PRMSCN ;SCANNING MACRO ACTUALS?
MOVEI TEMP,[ASCIZ/macro parameters/]
SKIPE CNDLST
MOVEI TEMP,[ASCIZ/false conditional compilation/]
JUMPN TEMP,.+4 ;IF ALREADY SOME BAD REASON
SKIPE XTFLAG ;ELSE TEST FOR EXTENDED COMPILATION
JRST XTCOMP
MOVEI TEMP,[ASCIZ/file/]
HRLI TEMP,(<POINT 7,0>) ;MAKE BYTE POINTER
;;%DH%
MOVE SBITS,TRKBEG ;SECOND SEMBLK OF CURRENT BEGIN
HLRZ TBITS,(SBITS) ;FIRST SEMBLK OF BEGIN
ERRSPL [[ASCIZ\
Fatal end of source file, scanning @A.
BEGIN @I @E/@D
Last source-file macro: @I @E/@D
Current macro: @I
\]
PWORD TEMP ;MORE EXPLICIT REASON
PWORD $PNAME+1(TBITS) ;BLOCK NAME
PWORD $PNAME+1(SBITS) ;LINE #
PWORD $PNAME(SBITS) ;PAGE #
PWORD @TRKMCS ;MACRO NAME
PWORD TRKM.L ;LINE #
PWORD TRKM.P ;PAGE #
PWORD @TRKMCR] ;MACRO NAME
JRST ENDSW3
XTCOMP:
NOTENX<
;;%DL% JFR 4-30-76 prevent enclobberment if /X and /B
IFN 0,< ;some problems remain
SKIPE BAILON
SKIPN XTFLAG
JRST XTC.NR ;MISSING ONE OR BOTH OF /X, /B
MOVE TEMP,SM1FIL
MOVEM TEMP,NAME
MOVSI TEMP,'SM0' ;NEW EXTENSION
MOVEM TEMP,EXTEN
MOVEM TEMP,SM1EXT
SETZM WORD3
MOVE TEMP,SM1PPN
MOVEM TEMP,PPN
RENAME SM1,NAME
ERR <RENAME error .SM1>,1
XTC.NR:
>;IFN 0,
;;%DL% ↑
PUSH P,SM1DEV ;SAVE NAME OF .SM1 FILE
PUSH P,SM1FIL
PUSH P,SM1EXT
PUSH P,SM1PPN
PUSH P,BINDEV ;AND .REL FILE
PUSH P,BINFIL
PUSH P,BINEXT
PUSH P,BINPPN
>;NOTENX
MOVEI TEMP,INIACS ;SAVE OUR ACS HERE
BLT TEMP,INIACS+17
TENX<
HRROI 1,XTSFIL
SETZ 3,
SKIPN 2,SM1JFN
JRST .+2
JSYS JFNS
HRROI 1,XTBFIL
SETZ 3,
SKIPN 2,BINJFN
JRST .+2
JSYS JFNS
>;TENX
HRLZS XTFLAG ;WHEN WE START AGAIN, WE ARE XTENDED!!!!!
HRROS JOBHRL ;GET RID OF SECOND SEGMENT??
HRRZ TEMP,JOBREL ;HIGHEST LEGAL ADDR IN LOW SEG
MOVSI TEMP,1(TEMP) ;FIRST FREE LOC,,0
HRRI TEMP,XSTART ;NEW START ADDR
MOVEM TEMP,JOBSA ;NOW .SAVE HAD BETTER DO THE RIGHT THING
PUUO 3,[ASCIZ/
SAVE ME FOR USE AS XSAIL./]
JRST RELSE
; WE HAVE OLD SOURCE FILE BACK, FAKE ADVBUF
SWTBKP:
BAIL <
QPOP BSRCFQ,BSRCFN ;RETRIEVE PREVIOUS FILE NUMBER
QPOP BSRCFQ,BSRCFC ;RETRIEVE BUFF.ADDR,,BLOCK COUNT
>;BAIL
PUSHJ P,HDROV ;CONTINUE PAGE NUMBERING FOR FILE
SETZM SRCDLY
PUSHJ P,SGCHK ;CHECK (LIBERALLY) FOR STRING SPACE FULL
MOVE TEMP,PNEXTC ;NOW SET UP PNT, PNEXTC, AND TEMP AS
SWTLUP: SKIPN (TEMP) ; THEY WOULD BE COMING OUT OF ADVBUF
JRST ADVBUF ;WE WERE AT END OF BUFFER ANYWAY
MOVE PNT,TEMP ;WE'RE GOING TO GET AHEAD OF SELVES
ILDB TBITS,TEMP ;CHECK NULLS
JUMPE TBITS,SWTLUP ;ALL THIS UNECESSARY IF SOS FILES, BUT...
MOVEM PNT,PNEXTC ;FAKE ADVBUF
MOVE TEMP,(TEMP) ;WORD WITH NON-NULL CHAR
POPJ P,
;;%CI% ↑
BAIL <
↑↑UPDCNT: HRRM C,PNAME ;UPDATE PNAME
>;BAIL
NOBAIL<
UPDCNT: HRRM C,PNAME ;UPDATE PNAME
>;NOBAIL
ADDB C,REMCHR(USER) ;AND REMCHR
CAMGE C,[-=50] ;ARE WE NEARING CATASTROPHE?
POPJ P, ; NO
;EVEN THIS CANNOT PREVENT OCCASIONAL DEATH
MOVEI TBITS,=50 ;REQUIRE AT LEAST THIS MANY
JRST SGCOL ;GO COLLECT
SGCOL1: HRRZ TBITS,$PNAME(LPSA) ;CHAR COUNT
SGCOL2: MOVE USER,GOGTAB
MOVE TEMP,REMCHR(USER) ;REMAINING CHARS
ADD TEMP,TBITS
SKIPGE TEMP ;NOT ENOUGH?
POPJ P, ;NO, OK
SGCOL: EXCH SP,STPSAV ;GET STRING STACK
MOVSS POVTAB+6 ;calling seq. to .SONTP may oflow
PUSH P,TBITS ;PASS TO STRGC THIS WAY
PUSHJ P,STRGC ;COLLECT STRING SPACE
;;#QO# -- BE SURE PNAME STAYS TOGETHER 1-25-74 RHT
EXTERN .SONTP
PUSH SP,PNAME
PUSH SP,PNAME+1
PUSH P,[0]
PUSHJ P,.SONTP
POP SP,PNAME+1
POP SP,PNAME
;;#QO#
EXCH SP,STPSAV ;GET IT BACK
MOVSS POVTAB+6
POPJ P, ; NO, GO AHEAD
NOTENX <
?CHROUT: SOSG LSTCNT ;ONE CHAR OUTPUT ROUTINE
PUSHJ P,LSTDO ;DO AN OUTPUT
IDPB TBITS,LSTPNT ;DO THE OUTPUT
POPJ P,
?LSTDO: OUT LST,
POPJ P,
ERR <I-O ERROR ON LISTING DEVICE>,1
POPJ P,
>;NOTENX
TENX <
?CHROUT: EXCH TBITS,2
EXCH 1,LISJFN
JSYS BOUT
EXCH 1,LISJFN
EXCH TBITS,2
POPJ P,
>;TENX
DSCR --HERE IS THE CREFFINF STUFF (STRANGE PLACE N'EST CE PAS?)
DES We'll leave it at these comments for the nonce:
For those of you who are interested in what cref output looks like, allow
me to discourse for a while on it. Basically, the output line is
preceeded by a whole mess of garbage. (In the following discussion,
let # stand for delete -- octal 177).
1. The first thing in a line with cref information in it must be
#B . This is handled in crefout.
2. There are two types of symbols:
a. NUMSYM's, which are represented by a six-digit number(decimal)
which is unique to that occurrance of the symbol.
The number is represented by an octal 6 (length of symbol)
followed by the number in ASCII.
b. SYMSYM's, which are the real symbolic symbols. These consist
of one byte of length, followed by the symbol in ASCII
3. When an identifier is seen in the source text, you do one of
several things:
1 followed by the NUMSYM -- a regular identifer seen.
3 followed by the SYMSYM -- a reserved word.
5 followed by the NUMSYM -- a macro use.
-- it is occasionally to flush the last type 1 instance. This is done
by following it immediately with a 7.
4. When defining things, we put out:
1 followed by the NUMSYM followed by 2 -- ordinary identifier
6 followed by NUMSYM -- macro.
5. When beginning a block, we put out a 15 followed by the SYMSYM.
6. When ending a block, we put out a 16 followed by the SYMSYM.
Then come the equivalences of numbers and symbolic names.
7. To equivalence an ordinary symbol, we put out 11 followed by
the NUMSYM followed by the SYMSYM.
8. When all done with the cref information for a line, we put out
#A .
⊗
BEGIN CREF
↑LCREFIT:
TDZA C,C
↑ECREFIT: MOVNI C,1 ;CREF FOR ENTER.
SKIPE CNDLST ; IN FALSE PART OF CONDITIONAL COMPILATION?
POPJ P, ; YES, DO NOT CREF
TLNN TBITS,CNST ;IF A CONSTANT, FORGET IT.
TLNE FF,NOCRFW ;AN EXTERNAL PROCEDURE -- DO NOT CREF;
POPJ P,
MOVE A,X11 ;ORDINARY IDENTIFIER.
TLNE TBITS,DEFINE ;IF THIS IS A MACRO.
MOVE A,[XWD 6,5]
TLNE TBITS,400000 ;RESERVED WORD?
MOVE A,X33
TLNE C,-1 ;ENTER OR LOOKUP?
MOVSS A
PUSHJ P,CREFOUT ;AND PUT OUT THE CHARACTER.
PUSHJ P,CREFSYM ;CREF THE SYMBOL IN LPSA,TBITS.
TLNN A,-2 ;IF REGULAR SYMBOL,
SKIPL C ;BEING DEFINED,
POPJ P,
MOVEI A,2 ;THEN PUT OUT EXTRA THING.
JRST CREFOUT ;....
CREFSYM: PUSH P,TBITS
JUMPL TBITS,ASC1 ;A RESERVED WORD ----
MOVEI TBITS,6
PUSHJ P,CHROUT ;NUMBER OF CHARACTERS.
MOVEI TBITS,(LPSA)
MOVEI PNT2,6 ;FOR THE RECURSIVE NUMBER PRINTER IN SEOL.
;;#MF#! 5-1-73 DCS (1 OF 2) AC B NEEDED IN CALLER OF LCREFIT
PUSH P,B
MOVEI B,CHROUT ;OUTPUT ROUTINE FOR SAME --
PUSHJ P,FRNP1 ; FRNP1 IS IN SEOL ABOVE.
;;#MF#! (2 OF 2) SAVE, RESTORE B
POP P,B
POP P,TBITS
POPJ P, ;GO AWAY.
ASC1: PUSH P,A
PUSHJ P,CREFASC ;ASCII CREF.....
POP P,A
POP P,TBITS
POPJ P,
CREFCHR: CAIN A,30 ;UNDERLINE
MOVEI A,"." ;CHANGE UNDERLINE TO .
↑↑CREFOUT: SKIPE LNCREF ;CREF GONE FOR THIS LINE?
JRST GONEF ;YES
SETOM LNCREF
PUSH P,A
MOVEI A,177
PUSHJ P,CREFOUT
MOVEI A,"B"
PUSHJ P,CREFOUT
POP P,A
NOTENX <
GONEF: SOSG LSTCNT
PUSHJ P,LSTDO
IDPB A,LSTPNT
POPJ P,
>;NOTENX
TENX <
GONEF: EXCH 1,2
EXCH 1,LISJFN
JSYS BOUT
EXCH 1,LISJFN
EXCH 1,2
POPJ P,
>;TENX
↑↑CREFASC: ;CREF THE ASCII FOR A SYMBOL.
HRRZ A,$PNAME(LPSA) ;COUNT.
PUSHJ P,CREFOUT ;AND CREF...
MOVE TEMP,A
MOVE C,$PNAME+1(LPSA) ;BYTE POINTER.
ILDB A,C
PUSHJ P,CREFCHR
SOJG TEMP,.-2
GPOPJ: POPJ P,
↑↑CREFDEF: ;PUT OUT SYMBOL DEFINTION.
MOVEI A,11 ;ORDINARY SYMBOL
MOVE TEMP,$TBITS(LPSA)
TLNE TEMP,DEFINE
MOVEI A,13 ;FOR MACRO
PUSHJ P,CREFOUT
PUSHJ P,CREFSYM
JRST CREFASC ;CODE,SYMBOL,PRINT-NAME.
↑↑CREFBLOCK: ;END OF A BLOCK.
MOVEI A,16
PUSHJ P,CREFOUT
JRST CREFASC ;AND THE NAME.
BEND
DSCR HDR, HDROV
DES List routines for top of (physical page). Reset page,
line counters. Print a page header if listing.
HDR is called when new page (logical) is sensed.
HDROV is called when PGSIZ lines have been printed
since last time a header was printed.
SID Uses D, TEMP,USER -- saves USER, C, others vulnerable.
⊗
↑HDR:
AOS PAGENO ;NEXT PAGE, PLEASE
AOS FPAGNO ;NEXT IN THIS FILE
SETZM PAGINC ;FIRST PHYSICAL PAGE NO
SETZM BINLIN ;SEQUENTIAL LINE #
AOS BINLIN ;ALWAYS STARTS AT 1
MOVE TEMP,[ASCII /00001/]
MOVEM TEMP,ASCLIN ;SO DOES THE SUFF WHICH APPEARS ON LISTING
;;#HU# 6-20-72 DCS BETTER TTY LISTING
SKIPN CRIND ;NEED CRLF/INDENT?
JRST NCRIND ;NO
SETZM CRIND
TERPRI
;;%CF% JFR 7-8-75
SKIPA TEMP,LININD ;HOW MANY
PUUO 1,[" "]
SOJGE TEMP,.-1
;;%CF% ↑
NCRIND: PRINT < >
DECPNT FPAGNO ;JUST KEEP TRACK
;;%CT% warnings if in macro or false conditional scan
MOVEI TEMP,LININD+1 ;TRKMCR AND TRKMCS MUST POINT TO A STRING
SKIPN TRKMCR
MOVEM TEMP,TRKMCR
SKIPN TRKMCS
MOVEM TEMP,TRKMCS
MOVEI TEMP,0
TLNE FF,PRMSCN ;SCANNING MACRO PARAMS?
MOVEI TEMP,[ASCIZ/macro parameters/]
SKIPE CNDLST ;OR FALSE CONDIITIONAL?
MOVEI TEMP,[ASCIZ/false conditional compilation/]
JUMPE TEMP,SEOP1 ;IF OK
HRLI TEMP,440700 ;COMPLETE BYTE POINTER
MOVEI A,[ASCIZ\
WARNING: Form-feed while scanning @A.
Last source-file macro: @I @E/@D
Current macro: @I
\]
MOVEI B,-1+[ PWORD TEMP
PWORD @TRKMCS
PWORD TRKM.L
PWORD TRKM.P
PWORD @TRKMCR]
PUSH P,C ;SAVE THIS
PUSHJ P,SPLPRT
POP P,C
SEOP1:
;;%CT% ↑
NOTENX<
;;%DE% JFR 10-25-75
↑HDROV: SETZM LINNUM
AOS PAGINC ;HERE WHEN LINES OVERFLOW PAGE
MOVE TEMP,TTOP ;CUR BLOCK SEMBLK
MOVEI A,TITPAT
MOVEI B,-1+[
PWORD IPROC+$PNAME+1 ;OUTER BLOCK NAME B.P.
PWORD SRCDEV
PWORD SRCFIL
PLEFT SRCEXT
PWORD SRCPPN
PWORD FPAGNO
PWORD PAGINC
PWORD $PNAME+1(TEMP) ;CURRENT BLOCK NAME B.P.
PWORD ASWITCH ;/A
PWORD BAILON ;/B
POINT 1,SCNWRD,5;/C
PRIGHT DFMAX ;/D
PWORD FMTWRD ;/F
PWORD HISW ;/H
PWORD KOUNT ;/K
PWORD LSTSTRT ;/L
PRIGHT PDLMAX ;/P
PRIGHT SPMAX ;/Q
PRIGHT PPMAX ;/R
PRIGHT STMAXX ;/S
PWORD OVRSAI ;/V
PWORD WHERSW ;/W
PWORD XTFLAG ;/X
]
PUSH P,C
PUSH P,D
MOVSI C,-5*=28
MOVE D,[IPCHAR TITLIN]
EXTERNAL SPLICE
PUSHJ P,SPLICE
HRRZM C,BANMAC+$PNAME ;CHAR COUNT
POP P,D
POP P,C
;;%DF% RHT 10-25-75
MOVE TEMP,FMTWRD ;CHECK FORMAT BITS
TRNN TEMP,140 ; USER REQUESTED LIST OFF (40) OR NO HEADING (100)
;;%DF% ↑
TLNN FF,LISTNG ;LISTING FILE OPEN?
POPJ P, ; NO
MOVE TEMP,SCNWRD
TRNE TEMP,NOLIST ;DID SCANNER TURN LISTING OFF?
POPJ P, ; YES
;;%XM% ! JFR 8-22-76 WAS =5*28+4 28 IS A FUNNY OCTAL CONSTANT!
MOVEI TEMP,5*=28+4 ;MAKE SURE ENOUGH ROOM REMAINS
CAMLE TEMP,LSTCNT ;IS THERE
PUSHJ P,LSTDO ;NOW THERE IS
MOVE TEMP,BANMAC+$PNAME+1 ;B.P.
IBP TEMP ;SKIP OPENING QUOTE
MOVEI D,14
PUSHJ P,HDROV1
MOVEI D,15 ;CR
MOVE TEMP,[POINT 7,[BYTE (7) 12,15,12,42],-1] ;LF CR LF "
HDROV1: IDPB D,LSTPNT
SOS LSTCNT
ILDB D,TEMP ;CHAR FROM BANNER
CAIE D,042
JRST .-4 ;CONTINUE UNTIL 042 CLOSE QUOTE
POPJ P,
;;%DE% ↑
>;NOTENX
TENX<
↑HDROV:
SETZM LINNUM
AOS PAGINC ;HERE WHEN LINES OVERFLOW PAGE
PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
HRROI 2,TITLIN ;DESTINATION
HRROI 1,TITTIM ;SAIL time date
SETZ 3,
JSYS SIN ;COPY INTO MACRO BODY STRING
MOVE 1,2 ;UPDATED DESTINATION
HRRZ 2,SRCJFN
SETZ 3,
JSYS JFNS ;FILE NAME
MOVE D,1 ;UPDATED DESTINATION BYTE POINTER
MOVE TEMP,TTOP ;CUR BLOCK SEMBLK
MOVEI A,TITPAT ;PATTERN FOR REST OF STUFF
MOVEI B,-1+[
PWORD FPAGNO
PWORD PAGINC
PWORD IPROC+$PNAME+1 ;OUTER BLOCK NAME B.P.
PWORD $PNAME+1(TEMP) ;CURRENT BLOCK NAME B.P.
PWORD ASWITCH ;/A
PWORD BAILON ;/B
POINT 1,SCNWRD,5;/C
PRIGHT DFMAX ;/D
PWORD FMTWRD ;/F
PWORD LODMOD ;/G
PWORD HISW ;/H
PWORD KOUNT ;/K
PWORD LSTSTRT ;/L
PRIGHT PDLMAX ;/P
PRIGHT SPMAX ;/Q
PRIGHT PPMAX ;/R
PRIGHT STMAXX ;/S
PWORD LODDDT ;/T
PWORD LODSDT ;/U
PWORD OVRSAI ;/V
PWORD WHERSW ;/W
PWORD XTFLAG ;/X
]
MOVSI C,-5*=28
EXTERNAL SPLICE
PUSHJ P,SPLICE
MOVE C,D ;UPDATED B.P.
SUBI C,TITLIN ;rh(C) has # words
MULI C,5 ;C←4,3,2,1 or 0, rh(D)←5*#words
SUBI D,-4(C) ;rh(D)←# chars
HRRZM D,BANMAC+$PNAME
;;%DF% RHT 10-25-75
MOVE TEMP,FMTWRD ;CHECK FORMAT BITS
TRNN TEMP,140 ; USER REQUESTED LIST OFF (40) OR NO HEADING (100)
;;%DF% ↑
SKIPG A,LISJFN ;LISTING FILE OPEN?
JRST NOHDR ; NO
MOVE TEMP,SCNWRD
TRNE TEMP,NOLIST ;SCANNER TURNED LISTING OFF?
JRST NOHDR ;YES
HRRZI B,14
JSYS BOUT
MOVE B,BANMAC+$PNAME+1 ;B.P.
IBP B ;SKIP OPENNING QUOTE
HRRZ C,BANMAC+$PNAME ;COUNT
SUBI C,4 ;OMIT QUOTES AND 177&0
JSYS SOUT ;DISPOSE OF IT
MOVE B,[POINT 7,[BYTE (7) 15,12,15,12],-1] ;CRLF CRLF
MOVEI C,4
JSYS SOUT
NOHDR: POP P,D
POP P,C
POP P,B
POP P,A
POPJ P,
;;%DE% JFR 10-25-75
DATA(TITLE LINE)
↑BANMAC:0 ;FAKE SEMBLK FOR BODY OF MACRO
0
POINT 7,TITLIN
CNST,,STRING
0
TITLIN: BLOCK =60
TITTIM: BLOCK =10 ;SAIL day time
TITPAT: ASCII / @D-@D @I
@I @BA @BB @DC @DD @BF @DG @DH @DK @BL @DP @DQ @DR @DS @DT @DU @DV @DW @DX"/
BYTE (7) 177,"@",0 ; 177&0=END OF MACRO
>;TENX
NOTENX<
;;%DE% JFR 10-25-75
DATA(TITLE LINE)
↑BANMAC:0 ;FAKE SEMBLK FOR BODY OF MACRO
0
POINT 7,TITLIN
CNST,,STRING
0
TITLIN: BLOCK =28
TITPAT: ASCII /"@I /
NOTYMSHR <ASCII /SAIL />
TYMSHR <ASCII /SAIL-TYMSHARE />
ASCII / dd/
ASCII /-mon-/
ASCII /yr /
ASCII /hr:mn/
ASCII / @F:@F.@F@G @D-@D /
ASCII /
@I @BA @BB @DC @DD @BF @DH @DK @BL @DP @DQ @DR @DS @DV @DW @DX/
BYTE (7) 042,177,"@",0 ;" 177&0=END OF MACRO
0
ENDDATA
; MAKT -- PREPARE A TITLE LINE
↑MAKT: NOTYMSHR <MOVE TEMP,[POINT 7,TITPAT+2,20] ;IDPB POINTER TO DAY OF MONTH>
TYMSHR <MOVE TEMP,[POINT 7,TITPAT+4,20]>
CALL6 C,DATE
IDIVI C,=31 ;DAY IN D
ADDI D,1 ;DAY - 1 THAT IS
PUSHJ P,MAKT.1
IDIVI C,=12 ;MONTH - 1 IN D
MOVE D,[ASCII /-JAN--FEB--MAR--APR--MAY--JUN--JUL-/
ASCII /-AUG--SEP--OCT--NOV--DEC-/](D)
AOJ TEMP,
MOVEM D,(TEMP) ;-mon-
MOVEI D,=64(C) ;YEAR
PUSHJ P,MAKT.1
NOTYMSHR <MOVE TEMP,[POINT 7,TITPAT+5]>
TYMSHR <MOVE TEMP,[POINT 7,TITPAT+7]>
CALL6 C,MSTIME ;TIME IN MS
IDIVI C,=60000
IDIVI C,=60 ;MINUTES IN D
EXCH D,C ;HOURS IN D
PUSHJ P,MAKT.1
IBP TEMP ;COLON
MOVE D,C ;MINUTES
MAKT.1: IDIVI D,=10
ADDI D,"0"
IDPB D,TEMP
ADDI D+1,"0"
IDPB D+1,TEMP
POPJ P,
;;%DE% ↑
>;NOTENX
TENX <
↑MAKT:
HRROI 2,TITTIM ;DEST. DESIGN. FOR ALL THAT FOLLOWS
HRROI 1,[ASCIZ /"SAIL /]
SETZ 3,
JSYS SIN ;MERELY COPY
MOVE 1,2 ;UPDATED DEST
SETO 2, ;CURRENT TIME
SETZ 3, ;KEEP IT SIMPLE
JSYS ODTIM ;APPEND DATE AND TIME
SETZ 2,
IDPB 2,1 ;MAKE SURE ITS ASCIZ
POPJ P,
>;TENX
SUBTTL ENTERS -- ENTER A SYMBOL
DSCR ENTERS -- make new symbol entry
DES Will use existing comments, not use standard form
ENTERS creates a block of proper type for this "ATOM", and
installs the proper links to assure this thing can be found
again. ENTERS can handle the following kinds of things:
1. Variables -- numeric, STRING, ITEM, etc.
2. Labels
3. Procedure identifiers
4. Numeric constants
5. String constants
STEPS:
1-3: Create a block for ID. Check that level is greater
for new symbol if old one was present (FORWARD Procedures
are a special case). Install level, $TBITS, $PNAME; link
to SYMTAB hash table (ptr to instr to fetch right bucket in HPNT).
Link to current VARB structure via %RVARB, to STRRNG via
%RSTR for STRINGC collector. Return ptr to Semantics in NEWSYM
(replaces ptr to found block if redefinition).
4: Insert numeric value entry in CONST bucket. No checking
(level, etc.) is necessary because ENTERS is called for
constants only when the lookup fails. Bucket fetching instr
found in HPNT, new Semantics to NEWSYM.
5: Insert new string constant entry in STRCON bucket. #4
arguments also apply here.
PAR "BITS" -- the TBITS flags for the ATOM. These will be
installed in the entry. They also guide the entry process.
"PNAME" -- String descriptor for $PNAME or String constant.
"SCNVAL" -- value of (1st word of) numeric constant. Second
word, if any, is the adjacent word DBLVAL.
"HPNT" -- The instr which when executed will load LPSA with
the correct bucket in the right half. SHASH, NHASH set up.
"NEWSYM" -- if ≠0, ptr to block matching PNAME or SCNVAL. This ptr
is set by SCAN, STRINS, etc., using SHASH, NHASH. If -0,
this is the first occurrence of the symbol.
"QRCTYP" -- Record class id. ... if not zero, put into lhs of $acno
Also, the prodef bit in ff is used to tell if the symbol is a formal param
RES "NEWSYM"←pointer to new block.
SID Uses A,C, TBITS, LPSA, TEMP; alters symbol table structure
⊗
↑ENTERS:
MOVE TBITS,BITS ;TYPE BITS
TLNE TBITS,CNST ;CONSTANT?
JRST ENCNST ; YES
; ENTER AN IDENTIFIER -- CHECK FOR RESERVED (ERROR), FORWARD
; PROCEDURE BEING DEFINED. CHECK LEVEL VALIDITY FOR REDEFINED
; SYMBOLS
ENIDNT:
MOVE C,LEVEL ;CURRENT LEVEL OF DEFINITION
SKIPG LPSA,NEWSYM ;IS THIS THE FIRST OCCURRENCE?
JRST BRANEW ; YES
;;#JZ# 11-4-72 HJS (1-2) CHANGE MACRO SCOPE
;;#JZ# THIS GROUP AND THE NEXT WERE INTERCHANGED
SETCM TEMP,$TBITS(LPSA);PREVIOUS TYPE BITS, COMPLEMENTED
SKIPL $TBITS(LPSA) ; CHECK FOR REDEFINITION OF A RESERVED WORD AS
; AS A MACRO (HJS 11-19-72)
TLNN TBITS,DEFINE ;SPECIAL TREATMENT FOR REDEFINITION
JRST NODEFN ; IT ISN'T ONE (HJS 11-19-72)
;; #LC# (1-17-73) HJS MACRO FORMAL,NOT MACRO REDEFINITION
TLNE TBITS,FORMAL ;
JRST NODEFN ;MACRO FORMAL, NOT MACRO REDEFINTION
;; #LC#
TLNN TEMP,DEFINE ; WAS PREVIOUS DEFINITION ALSO A MACRO?
SKIPN REDEFN ; YES, MACRO REDEFINITION?
JRST NODEFN ; NO, GO CHECK LEVELS
JRST DFEN1 ; IT IS ONE
;;#JZ# (1-2)
;;#JZ# 11-4-72 HJS (2-2) WAS INTERCHANGED WITH ABOVE
NODEFN: LDB A,PLEVEL ;OLD LEVEL OF DEFINITION (HJS 11-19-72)
SKIPL $TBITS(LPSA) ;IF OLD WAS RESERVED WORD, THEN OK.
CAMLE C,A ;C=CURRENT -- MUST BE GREATER
JRST OKOLD ; AND IS
CAME C,A ;IF =, MAY BE FORWARD COMING
ERR <SAIL IN LEVEL TROUBLE>,1
;;#JZ# 2-2
CHKPRC: SETCM A,TBITS ;NEW BITS
;; SUGG BY R. SMITH LOAD A BEFORE TRNN
TRNN TEMP,PROCED!FORWRD; MUST BE FORWARD PROCEDURE
JRST ISPRC
TLO A,OWN ;THIS IS SORT OF IRRELEVANT
TLO TEMP,OWN
TLOE TEMP,EXTRNL
ERR <DUPLICATE IDENTIFIER DECLARATION>,1,BRANEW ; ISN'T ANY GOOD!
TLC A,INTRNL ;SHOULD BE ON (=0), TURN OFF (=1) OR ON (ERROR)
CAME A,TEMP
ERR <DUPLICATE IDENTIFIER DECLARATION>,1,BRANEW ; ISN'T ANY GOOD!
MOVEM TBITS,$TBITS(LPSA)
REC <
SKIPE C,QRCTYP ;RECORD CLASS ID SPECIFIED
HRLM C,$ACNO(LPSA)
>;REC
PUSHJ P,URGVRB
PUSHJ P,RNGVRB
POPJ P,
ISPRC: TRNN TBITS,PROCED ;THIS SHOULD ALSO BE A PROCEDURE
ERR <DUPLICATE IDENTIFIER DECLARATION FOR >,3,BRANEW
; FORWARD PROCEDURE BEING DEFINED NOW, CHECK VALIDITY, CHANGE BITS
TRZE A,FORWRD ;TO MATCH OLD(COMPLEMENTED)
TLNN A,EXTRNL ;MAKE SURE NOT DUPLICATE EXTERNAL
ERR <DUPLICATE FORWARD/EXTERNAL DECLARATION FOR >,3,NOPROG
;;#JX#2! 11-2-72 DCS ALLOW INTERNAL PROC TO OVERRIDE EXTERNAL PROC.
TLON TEMP,EXTRNL ;Turn off EXTRNL in old, but if it was on, flip
TLC A,INTRNL ; INTRNL in new (will turn it off was on -- correct)
;;#JX#
CAME A,TEMP ;CHECK MATCHING TYPES
ERR <FORWARD TYPE DISAGREES>,1
TRO TBITS,INPROG ;MARK PROCEDURE UNDER DEFINITION
;;#SD# ADD A FLAG IF OLD IS EXTERNAL & NEW IS INTERNAL
MOVE C,$TBITS(LPSA) ; COULD HAVE USED THE HAIR ABOVE, BUT ...
SETOM IEFLAG ;SET THE FLAG
TLNE C,EXTRNL ;RESET IT IF OLD NOT EXTERNAL
TLNN TBITS,INTRNL ;OR NEW NOT INTERNAL
SETZM IEFLAG ;
;;#SD#
MOVEM TBITS,$TBITS(LPSA) ;STORE NEW
REC <
SKIPE C,QRCTYP ;RECORD CLASS ID SPECIFIED
HRLM C,$ACNO(LPSA)
>;REC
NOPROG: PUSHJ P,URGVRB ;REMOVE FROM VARB RING
PUSHJ P,RNGVRB ;PUT BACK ON THE END
LEFT ,%TLINK,LPSERR ;PTR TO SECOND BLOCK
LEFT (,%TLINK)
;;#GP# DCS 2-6-72 (2-4) CHECK OLD FORMALS AGAINST ACTUAL ONES
HRRZM LPSA,OLDPRM ;SAVE OLD FORMALS -- USED TO KILLST HERE
POPJ P, ;FOR A BIT LATER
;;#GP# (2)
; REDEFINITION IF NOT A PARAMETER TO A MACRO
DFEN1: TLNN TEMP,FORMAL ;BITS ARE COMPLEMENTED HERE, CAN'T BE FORMAL
ERR <DUPLICATE IDENTIFIER DECLARATION>,1
POPJ P, ; GET OUT IF MACRO REDEFINITION AT THE SAME
; LEVEL. BODY IS DELETED IN DFENT IF
; %TLINK IS NON-ZERO
; NOW CREATE A NEW BLOCK, PUT STUFF IN IT
BRANEW: ;NO CHECKING WAS DONE
OKOLD: ;IT'S ALL OK
GETBLK NEWSYM ;GET A NEW BLOCK
; INSERT PNAME, BITS -- LINK TO BUCKET, STRING RING,(VARB IF ID)
MOVE LPSA,NEWSYM ;POINTER TO NEW BLOCK
HRROI TEMP,PNAME+1 ;GET PDP FOR POPPING DATA
POP TEMP,$PNAME+1(LPSA) ;STORE STUFF
POP TEMP,$PNAME(LPSA)
;CREFFING FOR THE WORLD.
TLNE FF,CREFSW
;;#OH# -- HJS 9-24-73 DO NOT CREF MACRO FORMALS
PUSHJ P,[ TLNE TBITS,DEFINE ; DO NOT CREF MACRO FORMALS
TLNN TBITS,FORMAL
JRST ECREFIT
POPJ P,]
;;#OH#
TRNN TBITS,PROCED ;PROCEDURE?
JRST NOPROC ;NO
MOVE PNT,LPSA
GETBLK ;SECOND PROCEDURE BLOCK
HRLM LPSA,%TLINK(PNT) ;%TLINK PNTS TO 2D BLOCK
MOVE LPSA,PNT
TRNN TBITS,FORTRAN ;A FORTRAN CALL?
TLNE TBITS,EXTRNL ;OR EXTERNAL
TRO TBITS,FORWRD ;TURN ON FORWARD.
TRNN TBITS,FORWRD ;A FORWARD PROCEDURE?
TRO TBITS,INPROG ;NO -- TURN ON IN PROGRESS.
NOPROC: MOVEM TBITS,$TBITS(LPSA) ;TYPE BITS
REC <
SKIPE C,QRCTYP ;RECORD CLASS ID SPECIFIED
HRLM C,$ACNO(LPSA)
>;REC
SKIPE C,SIMPSW ;IF SIMPLE
AOJA C,FILLEV ;CLEVER TRICK TO LOAD C 0 & GO PUT IN LL
TRNN TBITS,LABEL ;OR NOT A LABEL, DONT CARE
JRST DOLL ;GO DO LEVELS
MOVE C,TPROC ;PICK UP CURRENT PROCEDURE
HRRZ C,$VAL(C) ;PICK UP PD SEMBLK
HRLM C,$ACNO(LPSA) ;PUT AWAY FOR LABEL SEMBLK
;#HY# RHT 6-26-72 OWN WAS BEING TESTED AS A RIGHT HALF BIT
DOLL: SKIPE C,CDLEV ;PICK UP DISPLY LEVEL
;;#IU# 8-12-72 ! RHT PREVENT EXTERNALS FROM BEING REFD (RF)
TLNE TBITS,OWN!EXTRNL;IF NON-ZERO DISPLY LEV, BUT OWN, OK
;;#LS# RHT 2! 3-12-73 WAS GETTING TO FILLEV WITH NOD ZERO C FOR OWN&EXTERNAL
JRST [SETZM C ;NO WORRY, ID IS AT LEVEL 0
JRST FILLEV]
SKIPE RECSW ;IF CURRENT PROC IS RECURSVE
;#HY# RHT HERE IS WHERE OWN WAS BEING TESTED
TRNE TBITS,ITEM!LABEL!PROCED; YES, IF NOT ITEM,LABEL, OR PROC THEN USE
;STACK
TLNE FF,PRODEF ;IF FORMAL USE STACK -- PRODEF SAYS WAS AN ARG LST
LSH C,LLFLDL ;SHIFT LEVEL T RIGHT SPOT
TRZ C,LLFLDM
;MASK OUT LEX LEV FLD AREA
FILLEV: TDO C,LEVEL ;PUT IN THE LEX LEVEL
HRRZM C,$SBITS(LPSA) ;LEVEL OF DEFINITION
; LINK TO BUCKET, STRING RING
MOVEI A,LNKRET+1 ;IN-LINE "CALL"
LNK: MOVE B,HPNT ;WORD SET UP BY HASH
XCT B ;THIS PICKS UP THE TIE INTO LPSA
MOVE TEMP,NEWSYM ;POINTER TO NEW ONE
HRRM LPSA,%TBUCK(TEMP) ;LINK DOWN NEW BLOCK
HRR LPSA,TEMP ;GET LPSA READY TO PUT BACK
TLO B,2000 ;TURN ON "MOVE TO MEMORY" BIT
XCT B
LNKRET: JRST (A) ;ALL DONE
MOVE LPSA,NEWSYM
PUSHJ P,RNGSTR ;PUT ON STRING RING
; IF NOT A CONSTANT, LINK TO VARB LIST -- RETURN
TLNE TBITS,CNST ;NOT ON VARB IF CONST
POPJ P, ; DONE
MOVE LPSA,NEWSYM
JRST RNGVRB ;PUT ON VARB RING
Comment ⊗ Constants, String or Numeric ⊗
ENCNST: TRNN TBITS,STRING ;STRING CONSTANT?
JRST ENNUMB ; NO, NUMERIC
ENSTRNG:
MOVEI C,0 ;STRCONS ARE AT LEVEL 0
PUSHJ P,BRANEW ;USE VARIABLE STUFF TO PERFORM THE ENTER.
MOVE LPSA,NEWSYM ;SEMANTICS OF RESULT
HLLZS $SBITS(LPSA) ;NO LEVELS FOR STRING CONSTANTS
JRST RNGCST ;PUT ON CONSTANT RING.
; NUMERIC CONSTANT
ENNUMB:
GETBLK NEWSYM
HRROI TEMP,DBLVAL ;STORE STUFF
POP TEMP,$VAL+1(LPSA)
POP TEMP,$VAL(LPSA)
POP TEMP,$TBITS(LPSA)
JSP A,LNK ;LINK TO BUCKET LIST
PUSHJ P,RNGCNM ;PUT ON CONSTANT RING
POPJ P,
DSCR ADCINS, CREINT, CONINS
CAL PUSHJ from EXECS which create constants for runtime.
PAR A contains value for CREINT, ADCINS
SCNVAL contains value for CONINS (numeric)
BITS contains type bits for CONINS
PNAME string is value for CONINS (String)
RES Semantics for constant (new or used) in rh of PNT
DES These routines are used to create constants, for
adjusting the stack, doing compile-time computation
of constant expressions, providing address constants, etc.
CONINS uses SCNVAL and BITS to make a constant of the
proper flavor (PNAME string for String constants).
CREINT makes an Integer constant.
ADCINS is CONINS, except it forces a new constant to be
made (code in SCANNER does it). It is used to provide
unique addresses for REFERENCE calls, which might wipe
the values out.
SID All AC's except PNT preserved; lh PNT preserved.
⊗
↑ADCINS:
MOVEM A,SCNVAL ;SPECIAL UNIQUE CONSTANT FOR
MOVE TBITS,[XWD CNST+RECURS,0] ;ADCON MAKER
ORM TBITS,BITS ;(CONSTANT BY REFERENCE)
JRST CONINS ;CONTINUE
↑CREINT: MOVEM A,SCNVAL ;CREATE AN INTEGER
SKIPA TBITS,[XWD CNST,INTEGR]
↑CONINS: MOVE TBITS,BITS
;;# # DCS 3-1-72
TRNE TBITS,STRING ;INSERT A STRING IF REQUESTED
JRST STRINS
;;# #
PUSH P,NUM1 ;FLAGS
PUSH P,NUM2
CINS: MOVE TEMP,[XWD A,CONACS] ; SAVE REGISTERS 1-12
BLT TEMP,CONACS+SBITS2-A
MOVE LPSA,STRCON ;STRING CONSTANT BUCKET.
MOVEM TBITS,BITS
XCT -1(P) ;HASH AND LOOKUP
MOVE TBITS,TBITS+CONACS-A
MOVEM TBITS,BITS
SKIPN NEWSYM ;WAS IT FOUND?
XCT (P) ;NO -- ENTERS
MOVE TEMP,[XWD CONACS,A] ; RESTORE REGISTERS 1-12
BLT TEMP,SBITS2
SUB P,X22 ; ADJUST STACK POINTER TO GET RID OF ROUTINE NAMES
HRR PNT,NEWSYM ;DO NOT CLOBBER LEFT HALF INCASE
; ADCONS ARE BEING MADE.
JRST GETAD ; LOAD SBITS AND TBITS
↑STRINS: PUSHJ P,STRNS1 ;
AOS $VAL2(PNT) ; INCREMENT REFERENCE COUNT
POPJ P, ;
STRNS1: PUSH P,STR1 ;FOR STRINGS
PUSH P,STR2
MOVE TBITS,[XWD CNST,STRING]
JRST CINS ;GO DO IT.
NUM1: PUSHJ P,NHASH
NUM2: PUSHJ P,ENNUMB
STR1: PUSHJ P,SHASH
STR2: PUSHJ P,ENSTRNG
ZERODATA (AC SAVE AREA FOR CONSTANT-MAKERS)
CONACS: BLOCK SBITS2-A+1
ENDDATA
SUBTTL HASH ROUTINES
DSCR SHASH, NHASH -- look up symbol entries in hashed buckets.
PAR LPSA -- ptr to bucket Semblk for SHASH (since there are two).
NHASH supplies its own.
PNAME -- String search argument for SHASH
SCNVAL -- Numeric search argument for NHASH
RES HPNT -- [HRRZ LPSA, bucketaddr] or [HLRZ LPSA, bucketaddr]
as explained in HPNT declaration.
NEWSYM -- 0 if not found, else Semantics of found entity.
SID Uses TEMP, TBITS, A, B, C, D, PNT -- Results in LPSA
SEE HPNT, NEWSYM, Bucket descriptions in main SAIL DATA area
⊗
↑SHASH:
MOVE A,PNAME+1 ;BYTE POINTER
MOVE A,(A) ;1ST STRING WORD
HRRZ TEMP,PNAME ;#CHARACTERS
XOR A,TEMP ;MIX IT UP A BIT
PUSHJ P,HASH ;COMPUTE HASH, GET POINTER, STORE IN HPNT
Comment ⊗ Search for symbol identical to string in pname.
Put pointer to it in NEWSYM if found.
Computed hash pointer is in HPNT on entry ⊗
SFIND: SETZM NEWSYM ;ASSUME NOT FOUND
HRRZ A,PNAME ;LENGTH
JUMPE A,BUKS ;ZERO LENGTH PNAME TEST
MOVEI B,4(A)
IDIVI B,5 ;# WORDS IN B
HRLI PNT,D ;SET UP INDICES
HRR PNT,PNAME+1 ;BYTE POINTER TO NEW NAME
HRLI C,D
MOVE TBITS,(PNT) ;FIRST WORD OF NEW NAME
JRST BUKS ;START AT THIS ONE
BUKLS: RIGHT ,%TBUCK,, ;GO DOWN BUCKET
BUKS: JUMPE LPSA,NOFND ;IN CASE BUCKET WAS EMPTY
JUMPE A,LCOMP ;ZERO LENGTH PNAME TEST
CAME TBITS,@$PNAME+1(LPSA) ;SAME FIRST WORD?
JRST BUKLS ;NO , FAIL
LCOMP: HRR TEMP,$PNAME(LPSA) ;LENGTH OF OBJECT STRING
CAIE A,(TEMP) ;SAME LENGTH?
JRST BUKLS ;NO -- FAILURE
JUMPE A,FND ;IF BOTH LENGTH(0), ASSUME IDENTICAL
HRREI D,-1(B) ;# WORDS-1
JUMPLE D,FND ;SAME SYMBOL, ONE WORD LONG
HRR C,$PNAME+1(LPSA);BYTE POINTER ADDR -- INDEX
SFNLUP: MOVE TEMP,@PNT
CAME TEMP,@C ;SAME WORD?
JRST BUKLS ;FAILURE
SOJG D,SFNLUP ;KEEP AT IT!
FND: MOVEM LPSA,NEWSYM
NOFND: POPJ P,
; USES A,B only -- results in LPSA
↑NHASH: SETZM NEWSYM ;ASSUME FAILURE
MOVE A,SCNVAL ;HASH ON 1ST WORD OF VALUE
MOVE LPSA,CONST ; HASH TO CONST BUCKET
PUSHJ P,HASH
MOVE A,SCNVAL ;GET VALUES FOR COMPARISON
MOVE B,DBLVAL
MOVE TEMP,BITS
TLNE TEMP,RECURS ;WANT UNIQUE CONSTANT?
JRST NOFND ; YES, SAME AS FAILURE
JRST BUK ;START HERE
BUKL: RIGHT ,%TBUCK ;DOWN BUCKET LIST
BUK: JUMPE LPSA,NOFND ;BE SURE TO CHECK THE FIRST ONE
CAME A,$VAL(LPSA) ;FIRST VALUE EQUAL?
JRST BUKL ;NO -- FAILURE
CAME B,$VAL2(LPSA) ;SECOND VALUE EQUAL?
JRST BUKL ;NO -- FAILURE
MOVE TEMP,BITS ;MAKE SURE TYPE IS SAME
CAME TEMP,$TBITS(LPSA)
JRST BUKL ;STILL CAN'T USE IT
JRST FND ;OK, USE IT
JRST FND ;FINISH OUT
Comment ⊗ HASH routine itself --
IN: A -- number to be hashed
LPSA -- bucket pointer
OUT: HPNT contains an instruction which, when executed
will load LPSA with the bucket word in the RH.
See LNK above for the cute way of entering
the new symbol.
ACS: uses A, B -- results in LPSA
⊗
HASH: IDIVI A,BUKLEN ;GET (A mod BUKLEN)
MOVMS B ;USE MAGNITUDE
ROT B,-1 ;DIVIDE BY TWO
ADD LPSA,B ;ADD TO THE BUCKET POINTER
HRLI LPSA,(<MOVE LPSA,0>)
SKIPL B
HRLI LPSA,(<MOVS LPSA,0>)
MOVEM LPSA,HPNT ;AND STORE AWAY
XCT LPSA
HRRZS LPSA ;SO THE JUMPE WILL WORK.
POPJ P,
SUBTTL SEMBLK Allocation Routines
DSCR BLKGET, BLKFRE -- Semblk Allocators
CAL PUSHJ via GETBLK, FREBLK macros.
DES Routines to perform the following:
BLKGET allocates a new 11-word Semblk.
BLKFRE restores such a Semblk to the BLFREE storage list
SETBLK Initializes BLFREE with blocks as determined by
determined by the area allocated in lpsbot, lpstop.
NEEBLK Gets more blocks when you need them
BLKZER Zeroes the block pointed to by LPSA
PAR LPSA is Semblk address for BLKFRE
RES LPSA contains Semblk address from BLKGET
SID USER used for GOGTAB by SET-&NEE- blk
TEMP destroyed by same
LPSA changed by SETBLK and BLKZER, set to good thing by NEEBLK
⊗
ZERODATA (BLOCK-GETTER VARIABLES)
COMMENT ⊗
BLFREE -- Semblk Free Storage List pointer. Points to first Semblk
on list, whose first word points to next, etc. -- 0 terminates.
Semblks are put on the list by BLKZER when allocating more, and
by the BLKFRE (via FREBLK macro) routine. They are removed by
the BLKGET (via GETBLK macro) routine.
⊗
↑↑BLFREE: 0
;FRECNT -- # free blocks when enabled by FTCOUNT switch
IFN FTDEBUG, <
↑↑FRECNT: 0
>
TSTALO←←0 ;SPECIAL TEST MODE FOR BLOCK ALLOCATOR
IFNDEF TSTALO, <TSTALO←←0>
IFE TSTALO,<BLLEN←←BLKLEN; ELSE>BLLEN←←BLKLEN+2 ;SET TOTAL BLOCK SIZE
IFN TSTALO, <BLKUSE: 0>
ENDDATA
↑SETBLK:
IFN TSTALO ,<
MOVEI TEMP,BLKUSE-BLKLEN-1 ;initialize pointer to
HRLS TEMP ;doubly-linked list of IN USE
MOVEM TEMP,BLKUSE ; blocks for finding lacking FREBLKs
>;TSTALO
MOVE TEMP,LPSBOT
SETBL1: MOVEM TEMP,BLFREE ;STARTING ADDRESS
GOK: MOVEI LPSA,BLLEN(TEMP) ;NEXT AREA
CAML LPSA,LPSTOP ;TOO FAR?
JRST SETD
MOVEM LPSA,(TEMP) ;STORE THE POINTER
MOVE TEMP,LPSA
JRST GOK
SETD: SUBI TEMP,BLLEN ;GO BACK AND
SETZM (TEMP) ;TERMINATE LIST
POPJ P,
↑NEEBLK:
PUSH P,B ;NEEDED FOR CORE GETTERS
PUSH P,C
MOVE B,LPSBOT ;TRY TO INCREMENT THIS BLOCK
MOVEI C,=100*BLLEN ;TRY TO INCREMENT THIS BLOCK
PUSHJ P,CANINC ;IS IT POSSIBLE?
JRST NOINC ;NO
JRST INCR3 ;YES, GO DO IT
NOINC:
CAIGE C,=20*BLLEN ;WILL SETTLE FOR THIS
JRST GETTOP ;NO, GET NEW BLOCK
INCR3: PUSHJ P,CORINC ;EXPAND BY ALLOWABLE AMOUNT
ERR <DRYROT> ;CAN'T HAPPEN
EXCH C,LPSTOP ;OLD TOP IS NEW FREE AREA
ADDM C,LPSTOP ;NEW UPPER LIMIT
MOVE TEMP,C ;SO LEAVE IT WHERE IT WILL BE NOTICED
JRST NEERT1 ;NOW GO AND RELINK
GETTOP: MOVEI C,=100*BLLEN ;GET NEW BLOCK THIS SIZE
PUSHJ P,CORGET
CORERR <RAN OUT OF CORE AT GETTOP>
MOVEM B,LPSBOT ;SET LIMITS ANEW
MOVEM B,LPSTOP
ADDM C,LPSTOP
NEERET:
MOVE TEMP,B ;PTR TO BOTTOM OF NEW
NEERT1: POP P,C
POP P,B
PUSHJ P,SETBL1 ;LINK THEM UP
MOVE LPSA,BLFREE ;SO THAT WE CAN CONTINUE
POPJ P,
↑BLKGET:
IFN FTDEBUG,<AOS FRECNT>
SKIPN LPSA,BLFREE
PUSHJ P,NEEBLK ;GET A WHOLE NOTHER SET.
MOVE TEMP,(LPSA)
MOVEM TEMP,BLFREE ;UPDATE FREE STORAGE.
↑BLKZER: SETZM (LPSA) ;FIRST WORD
MOVSI TEMP,(LPSA) ;ZERO THE BLOCK
HRRI TEMP,1(LPSA)
BLT TEMP,BLLEN-1(LPSA)
IFN TSTALO,<
; ADD BLOCK TO DOUBLY-LINKED RING OF IN USE BLOCKS
POP P,BLKLEN(LPSA) ;SAVE RET ADDR FOR HISTORY OF CALL TO BLKGET
HLRZ TEMP,BLKUSE ;GET POINTER TO LAST BLOCK IN RING
HRLM LPSA,BLKUSE ;UPDATE SAID POINTER
HRRM LPSA,BLKLEN+1(TEMP) ;UPDATE FOR'RD PNTR IN OLD LAST BLOCK
HRLM TEMP,BLKLEN+1(LPSA) ;UPDATE BCK'RD PNTR IN NEW (LAST) BLOCK
MOVEI TEMP,BLKUSE-BLKLEN-1 ;UPDATE FOR'RD PNTR IN NEW BLOCK
HRRM TEMP,BLKLEN+1(LPSA)
JRST @BLKLEN(LPSA) ;RETURN DEVIOUSLY
; ELSE >POPJ P,
↑BLKFRE:
IFN FTDEBUG,<SOS FRECNT>
EXCH LPSA,-1(P) ;GET ARG, SAVE LPSA
MOVE TEMP,BLFREE
HRRZM TEMP,(LPSA) ;STRINGOUT FREE STORAGE
HRRM LPSA,BLFREE
IFN TSTALO, <
; REMOVE FROM IN USE RING
MOVE TEMP,BLKLEN+1(LPSA) ;BCK'RD,,FOR'RD
HLLM TEMP,BLKLEN+1(TEMP) ;UPDATE BCK'RD IN NEXT TO PNT TO PREV
MOVSS TEMP
HLRM TEMP,BLKLEN+1(TEMP) ;UPDATE FOR'RD IN LAST TO PNT TO NEXT
>
MOVE LPSA,-1(P) ;GET OLD VALUE BACK
SUB P,X22
JRST @2(P)
SUBTTL RNGVRB, RNGSTR, etc. -- `Ring' Linkage Routines
DSCR RNGSTR, RNGGEN, RNGTMP, RNGCST, RNGVRB, RNGADR, RNGCNM
PAR (Sometimes) LPSA is Semblk address
RES The Semblk is linked onto a `ring' based on a variable
implied by the routine name. RNGSTR uses %RSTR -- all others
use %RVARB. The ring header variables are STRRNG, VARB, TTEMP,
CONINT, CONSTR, ADRTAB.
DES These routines replace the RING macro -- for space efficiency.
⊗
↑RNGDIS:MOVEI TEMP,DISLST ;DISPLAY TEMPS
JRST RNGGEN
↑RNGADR:SKIPA TEMP,[ADRTAB] ;ADDRESS CONSTANTS
↑RNGTMP:MOVEI TEMP,TTEMP ;CORE TEMPS
JRST RNGGEN
↑RNGCNM:SKIPA TEMP,[CONINT] ;NUMERICAL CONSTANTS -- ASSUMES NEWSYM
↑RNGCST:MOVEI TEMP,CONSTR ;STRING CONSTANTS -- ASSUMES NEWSYM
SKIPA LPSA,NEWSYM ;GET SEMBLK FROM HERE
↑RNGVRB:MOVEI TEMP,VARB ;VARB RING
RNGGEN: PUSH P,A
SKIPN A,(TEMP) ;The left half of %RVARB(Semblk) is
JRST .+3 ; made to point to the previous `newest'
HRRM LPSA,%RVARB(A) ; Semblk, if one exists -- the right
HRLZM A,%RVARB(LPSA) ; half of %RVARB(Previous) points to
MOVEM LPSA,(TEMP) ; this one -- the vase vbl (TEMP) always
POP P,A ; indicates the new (right-hand) end
POPJ P, ; of the list -- the oldest lh is always 0
↑RNGSTR:SKIPN TEMP,STRRNG ;String ring linkage -- same business
JRST .+3
HRRM LPSA,%RSTR(TEMP)
HRLZM TEMP,%RSTR(LPSA)
MOVEM LPSA,STRRNG
POPJ P,
DSCR URGVRB, URGADR, URGTMP, URGCST, URGSTR
PAR LPSA is a Semblk Address
The Header vbl is set up by calling the right routine
DES Undoes the damage done by RING
⊗
↑URGDIS:SKIPA TEMP,[DISLST]
↑URGCNM:MOVEI TEMP,CONINT
JRST URGGEN
↑URGVRB:SKIPA TEMP,[VARB]
↑URGTMP:MOVEI TEMP,TTEMP
JRST URGGEN
↑URGADR:SKIPA TEMP,[ADRTAB]
↑URGCST:MOVEI TEMP,CONSTR
URGGEN: PUSH P,A ;If there are no pointers in %RVARB, then
SKIPN A,%RVARB(LPSA) ;1) The Semblk is not on the ring, or:
CAMN LPSA,(TEMP) ;2) It is the only member, in which case its
JRST DOU ; address is that of the header vbl (TEMP)
ENDU: POP P,A ;So you get here immediately in CASE 1 above,
POPJ P, ; and after you've unlinked in other cases.
DOU: TRNE A,-1 ;If there is a younger neighbor, tell him
HLLM A,%RVARB(A) ; you're gone.
TRNN A,-1 ;If there is not a younger neighbor, update
HLRZM A,(TEMP) ; the header, because you were youngest.
MOVSS A
TRNE A,-1 ;If there is an older neigbor, tell him
HLRM A,%RVARB(A) ; you're gone.
JRST ENDU
↑URGSTR:SKIPN TEMP,%RSTR(LPSA);Same stuff for string ring.
CAMN LPSA,STRRNG
JRST DOST
POPJ P,
DOST: TRNE TEMP,-1
HLLM TEMP,%RSTR(TEMP)
TRNN TEMP,-1
HLRZM TEMP,STRRNG
MOVSS TEMP
TRNE TEMP,-1
HLRM TEMP,%RSTR(TEMP)
POPJ P,
SUBTTL Mark insertion routine for counter routines
DSCR LSTOUT -- write to list file
CAL PUSHJ P,LSTOUT
PAR Reg A contains character to be listed
RES The character right justified in A is placed in the output
line of the list file. If the last character was a CR, the character
is inserted before the CR. This routine is called by the exec
routines KOUNT1, KOUNT2, etc. to put markers in the list file
indicating where counters were placed into the object code.
SID the contents of A may be changed.
⊗
↑LSTOUT: PUSH P,B ;SAVE B
LDB B,LPNT ;GET PREV LAST CHAR
CAIE B,15 ;IS IT A CR
JRST .+3 ;NO
DPB A,LPNT ;YES, WIPE IT OUT
MOVEI A,15 ;AND PUT CR AFTER IT
MOVEI B,(A)
ML$CHR
POP P,B ;RESTORE B
POPJ P, ;RETURN
DSCR LSTOU1 -- Write to list file
CAL PUSHJ P,LSTOU1
PAR Reg A contains character to be listed
Reg C contains character that the char in A should follow
RES If the last character in the line matches the one in
C, the character in A is put at the end of the line. If
not, the char in A is placed before the last character.
The necessity for doing this comes from the fact that some
single character tokens are placed in the listing file before
they are parsed.
SID Register A may be changed
⊗
↑LSTOU1: PUSH P,B ;SAVE B
LDB B,LPNT ;GET THE LAST CHAR
CAMN B,C ;IS IT THE ONE WE WANT...
JRST .+8 ;YES, GO STORE CHARACTER
CAIGE C,"A" ;IS THE COMPARE CHAR A LETTER
JRST .+4 ;NO
ADDI C,"a"-"A" ;CONVERT TO LOWERCASE
CAMN B,C ;IS IT THE RIGHT THING?
JRST .+3 ;YES, GO STORE CHARACTER AND RETURN
DPB A,LPNT ;NO, STORE NEW CHAR
MOVEI A,(B) ;THEN OLD CHARACTER
MOVEI B,(A)
ML$CHR
POP P,B ;RESTORE B
POPJ P, ;RETURN
BEND SYM
↑KILLST←KILLST
SUBTTL Generator Data