Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/forflo.fai
There are no other files named forflo.fai in the archive.
TITLE FORFLO FLOWCHART AND REFORMAT FORTRAN SOURCE PROGRAMS
SUBTTL Ralph E. Gorin, Stanford Artificial Intelligence Project.
stansw==-1 ;LOTS lineprinter
COMMENT $
Program history:
The reformatting program was written by R. E. Gorin in May 1970
This first program was written in fortran.
'NEAT' Original Macro program: 1 September 1970.
FORFLO Version 1. Flowchart feature added March 24, 1971
FORFLO Version 2. Internal structure reorganized July 6, 1971
FORFLO Version 3. Bugs fixed. See below.
-------------------------------------------------------------------------
Acknowledgements:
This program was first created while the author was an
undergraduate at Rensselaer Polytechnic Institute, Troy, New York.
In September, 1970, the author converted the program, which was then
called "Neat" to MACRO-10.
During March, 1971 while a graduate student in the Computer
Science department of Stanford University, Stanford California, the
author added the flowcharting feature.
The author has been supported as an NSF Fellow; Computer
facilities have been made available by the Advanced Research Projects
Agency of the Department of Defense under contract SD-183.
The author expresses his appreciation for the support
provided by those organizations mentioned above.
-------------------------------------------------------------------------
ASSEMBLY TIME SWITCHES:
STANSW, SET TO 1 FOR STANFORD LPT AND UUOs.
SET TO 0 FOR "STANDARD" LPT AND TOPS-10 UUOs.
SET TO -1 FOR LOTS LPT.
SANSW, SET TO 1 FOR DECIMAL PPN, 0 FOR OCTAL, -1 FOR SIXBIT.
SEGSW SET TO 1 FOR TWO SEGMENT SHARABLE PROGRAM.
DEFAULTS: STANSW=1 => SEGSW=0,SANSW=-1
STANSW.NE.1 => SEGSW=1,SANSW=0
-------------------------------------------------------------------------
SUPPORT OF THIS PROGRAM
Please report any problems with this program to:
R. E. Gorin
Stanford University
Stanford, California 94305
$
; Changes between FORFLO versions 2 and 3 and 4 and 5.
COMMENT $
29 March 1973
The following changes have been made:
1. Internal Documentation has been changed in some places to
explain more.
2. Coding changes in some areas have been made to increase efficiency.
3. Bugs fixed.
a. at error conditions, tty output is forced before halt.
b. The general treatment of continuation lines in the source
file is improved in the following ways.
GO
1 TO 10
was not formerly recognized as a GOTO statement.
IF(FOO.EQ.0)
1 WRITE(1,20) A
was formerly output on one line, it will now be
output on two lines.
c. The flowchart routines are smarter now about determining
whether control can fall through a statement.
GOTO 1
1 CONTINUE
did not work before.
GOTO 1
C THIS IS A COMMENT
1 CONTINUE
formerly, this made a jump line out of the goto
now Forflo recognizes this as not a real jump.
d. Certain flowchart errors would cause unintelligable
error messages, due to calling a simple decimal
printer with a negative argument.
e. Empty lines following a continution line were processed
wrong.
4. The flowchart output routine has been modified to turn multiple
blanks into tabs, and to suppress trailing blanks. This reduces
the size of the output by 40 or 50%.
$
; Changes between FORFLO versions 3 and 4 and 5.
COMMENT %
JAN 4,1974
1. CALL statements which specify statement number arguments
(i.e., a statement number preceded by &, # or *) are handled
properly
FEB 14,1974
1. D, $, /, and ! in column 1 as comment statement
2. Bug fixed in TYPE with format array
3. Bug fixed in logical IF with a CALL consequence which specifies
a statement number argument.
4. END= and ERR= are implemented for WRITE
The following deficiencies are known:
1. ENTRY statement.
2. ! in the text of a line signifying that the remainder is a comment
3. ; in the text of a line signifying a multi-statement line
4. Trailing blanks in holleriths are deleted.
March 17,1974
1. REREAD,8,A generates a warning message.
2. Bug regarding short, but not empty, blank lines fixed.
September 2, 1975
1. ENCODE/DECODE with an I/O list in parentheses has been fixed.
June 18, 1977 (JQJOHNSON)
1. Revised treatment of STANSW,SANSW,SEGSW
%
SUBTTL DEFINITIONS
IFDEF FOR,<MACRO__0;>MACRO==1 ;SELECT ASSEMBLER
IFE MACRO,<
DEFINE DEF(A,B)
<A_B>
DEFINE SDEF(A,B)
<A__B>
>
IFN MACRO,<
DEFINE DEF(A,B)
<A=B>
DEFINE SDEF(A,B)
<A==B>
>
IFNDEF STANSW,<SDEF(STANSW,0)> ;DEFAULT IS NO STANFORD FEATURES.
IFNDEF SANSW,<
IFG STANSW,<SDEF(SANSW,-1) ;STANFORD HAS SIXBIT>
IFLE STANSW,<SDEF(SANSW,0) ;EVERYONE ELSE IS NORMALLY OCTAL>
>
IFGE SANSW,<SDEF(PPNMUL,4+4+SANSW+SANSW) ;CALCULATE PPN BASE >
IFNDEF SEGSW,<
IFG STANSW,<SDEF(SEGSW,0) ;STANFORD IS ONE-SEGMENT >
IFLE STANSW,<SDEF(SANSW,1) ;EVERYONE ELSE IS NORMALLY TWO >
>
IFNDEF SEGSW,<SDEF(SEGSW,1)> ;ELSEWHERE DEFAULT TO TWO SEGMENTS
EXTERN JOBDDT,JOBFF,JOBREL
; AC DEFINITIONS.
; MOST AC'S ARE USED AS IF THEY ARE VERY TEMPORARY.
; EXCEPTIONS ARE FL AND P
DEF(FL,0) ;FLAGS
DEF(A,1)
DEF(B,2) ;A,B,C,D FORM SCRATCH BLOCK 1.
DEF(C,3)
DEF(D,4)
DEF(W,5) ;W,X,Y,Z FORM SCRATCH BLOCK 2
DEF(X,6)
DEF(Y,7)
DEF(Z,10)
DEF(COL,11) ;USED FOR COLUMN POSITION ON CARD
DEF(S,12)
DEF(T,13)
DEF(U,14)
DEF(V,15)
DEF(P,17) ;PUSH DOWN REGISTER.
COMMENT/
I-O CHANNEL UTILIZATION
/
SDEF(CDR,1) ;SOURCE FILE INPUT
SDEF(CDP,2) ;REVISED SOURCE OUTPUT
SDEF(LPT,3) ;LISTING OUTPUT FILE
SDEF(DSK1,4) ;WRITE SCRATCH FROM PASS 1 TO PASS 2
SDEF(TTY,5) ;FOR COMMANDS. THIS MAY BE TTY OR DSK.
SDEF(DSK2,6) ;FORMAT FILE IN PASS1.
;SCRATCH FROM PASS 2 TO PASS 3.
SDEF(PDLEN,40) ;PUSHDOWN LENGTH
LOC 137 ;SET JOBVER.
5 ;VERSION 5 (14 FEB 1974)
LOC 124 ;SET JOBREN
FINISH ;REENTRY POINT
LOC 41 ;SET UP UUO TRAP
PUSHJ P,DOUUO ;AS A SIMPLE PUSHJ
IFE SEGSW,< RELOC 0 ;BACK TO NORMAL FOR 1 SEG>
IFG SEGSW,< TWOSEG 400010 ;SET TWOSEG>
OPDEF LPCALL [1B8] ;OUTPUT TO LPT. USE AC=1 OR 3, LIKE TTCALL
OPDEF BCALL [2B8] ;LIKE LPCALL BUT BOTH LPT AND TTY.
OPDEF MESS [3B8] ;MESSAGE FOR TTY, ONLY IF TTYF IS CLEAR
OPDEF MATCH [4B8] ;STRING MATCH UUO
OPDEF RESET [CALLI]
OPDEF DEVCHR [CALLI 4]
OPDEF CORE [CALLI 11]
OPDEF EXIT [CALLI 12]
OPDEF PJOB [CALLI 30]
SUBTTL MORE DEFINITIONS
COMMENT /
FLOWCHARTING CHARACTERS ARE DEFINED HERE
/
SDEF (UPARR,<"^">)
SDEF (BLANK,<" ">)
IFL STANSW,< ;PRINTRONIX
SDEF (LEFARR,74) ;SO "_" CAN BE UNDERSCORE
SDEF (USCORE,<"_">) ;NOT LEFT ARROW!
SDEF (DWNARR,<"V">) ;SORRY, NO DOWN ARROW
SDEF (VBAR,174) ;VERTICAL BAR DOES NOT MEAN ALT TO ME!
SDEF (RGTARR,76) ;LESS THAN
SDEF (CHARO,<"O">)
>
IFE STANSW,< ;LOSING LPTS
SDEF (LEFARR,"_") ;LEFT ARROW RATHER THAN UNDERSCORE
SDEF (DWNARR,<"V">)
SDEF (USCORE,<"-">) ;MINUS INSTEAD OF UNDERSCORE
SDEF (VBAR,<"I">) ;UPPER CASE I INSTEAD OF VBAR
SDEF (RGTARR,76) ;YOU KNOW WHAT CHARACTER I CAN'T WRITE HERE.
SDEF (CHARO,<"O">)
>
IFG STANSW,< ;SUPER SAIL LPT
SDEF (LEFARR,<"_">)
SDEF (USCORE,<"">)
SDEF (DWNARR,<"">)
SDEF (RGTARR,<"">)
SDEF (CHARO,<"">)
SDEF (VBAR,<"|">)
>
COMMENT/
FIXED BUFFER SIZES ARE DEFINED HERE
/
RADIX 5+5
SDEF (CONTMX,20) ;MAX NO. OF CONTINUATION CARDS IN A SINGLE STATEMENT
SDEF (BUFLEN,<72+<CONTMX*67>+4>/5) ;LENGTH OF BUFFERS (OBUF AND IBUF)
SDEF (JREFTL,100) ;LENGTH OF STATEMENT REFERENCE TABLE
;THIS IS ACTUALLY ALLOCATED AT
;OBUF (AND IBUF) TO SAVE SPACE
SDEF (%RCMAX,64) ;SIZE OF ALL RIGHT COLUMNS, THIS BETTER
;BE GREATER THAN %RCOLS
SDEF (%LCMAX,64) ;SIZE OF ALL LEFT COLUMNS, REAL+IMAGINARIES
;MUST BE GREATER THAN %LCOLS
COMMENT /
DEFINE LINE PRINTER WIDTH AND RELATED PARAMETERS IN THE PROGRAM
IF LINE PRINTER HAS 120 COLUMNS, SET %LPT TO 0
FOR 132 COLUMN PRINTERS SET %LPT TO 1
PARAMETERS %LCOLS AND %RCOLS DEFINE THE
NUMBER OF COLUMNS FOR FLOW LINES ON THE LEFT AND RIGHT SIDES
OF THE PAPER.
THE PARAMETERS %RCMAX AND %LCMAX GOVERN THE SIZE
OF THE FIXED TABLE SPACE FOR FLOW LINES. THE TABLE
SIZE MUST BE STRICTLY LARGER THAN THE NUMBER OF PHYSICAL
FLOW LINES AVAILABLE ON THE PRINTER. ANY FLOW LINES THAT
FIT IN THE TABLE BUT NOT ON THE PAPER ARE CALLED IMAGINARY
FLOW LINES. THESE IMAGINARY FLOWLINES HAVE ALL THE ATTRIBUTES
OF REAL FLOW LINES, BUT THEY DON'T APPEAR ON THE LISTING.
IF THE TABLE SPACE FOR FLOW LINES IS EXCEEDED THEN
THE PROGRAM WILL TERMINATE ABNORMALLY. IMAGINARY FLOW LINES
CAN BE ADDED BY INCREASING THE TABLE SIZE PARAMETERS %RCMAX
AND %LCMAX.
/
IFN STANSW,<SDEF(%LPT,0)>
IFNDEF %LPT,<SDEF(%LPT,1)> ;MOST PEOPLE HAVE WIDE LPTS
IFE %LPT,<SDEF(%LCOLS,12) ;NARROW LPTS HAVE FEWER REAL COLUMNS
SDEF(%RCOLS,<120-80-%LCOLS>) ;SIZE ON RIGHT>
IFG %LPT,<SDEF(%LCOLS,18) ;WIDER LPTS HAVE MORE
SDEF(%RCOLS,<132-80-%LCOLS>) ;SIZE ON THE RIGHT>
SDEF (COLCEN,<41+%LCOLS>) ;POSITION OF LOGICAL CENTER
RADIX 4+4
; FLAG DEFINITIONS
; FL RIGHT
SDEF RPGSW,1 ;STARTED IN RPG MODE
SDEF LIST,2 ;WE ARE DOING LISTING
SDEF PUNCH,4 ;WE ARE MAKING A REVISED SOURCE
SDEF STARSW,10 ;SET IF STARTED AT C(JOBSA)+1
SDEF EOFFLG,20 ;WE HAVE SEEN END OF SOURCE FILE
SDEF ENDPRG,40 ;WE HAVE SEEN AN END STATEMENT IN PROGRAM
SDEF TTYF,100 ;LIST DEVICE IS LOGICAL TTY, SO SUPPRESS
;DUPLICATE ERROR MESSAGES.
SDEF CREF,200 ;WE WERE ASKED FOR A CREF
SDEF CRDSN,400 ;SOME NON-EMPTY LINE HAS BEEN SEEN.
SDEF URR,1000 ;UNRESOLVED REFERENCE ERROR
SDEF ILLIFF,2000 ;ILLEGAL IF CONSEQUENCE
SDEF TXTBUF,4000 ;TEXT IN BUFFER.
SDEF TABSW,10000 ;LEAVE TABS IN COLS 7-72
SDEF BSW,20000 ;DELETE BLANK LINES.
SDEF FORMAT,40000 ;SHUFFLE FORMATS
SDEF FLOW,100000 ;DO FLOWCHART
SDEF QUIET,200000 ;SHUTUP EXCEPT FOR FLOWCHART
SDEF KEYS,400000 ;DO KEYPUNCH CONVERSION IF SET.
; FL LEFT
SDEF ILFMT,1 ;ILLEGAL LINE FORMAT
SDEF SHORT,2 ;SHORT LINE, BUT NOT ILLEGAL
SDEF ILCS,4 ;ILLEGAL CHARACTER IN SCAN
SDEF FRSTOP,10 ;FIRST OPERATION ON A NEW SUBROUTINE
SDEF QUOTE,20 ;WE SAW A SINGLE QUOTE
SDEF SWSN,40 ;WE SAW A SWITCH IN COMMAND
SDEF RENUMS,200 ;WE ARE RENUMBERING BRANCH LABELS, SO LIST
;THEM IN THE PASS 2 TEMP FILE.
SDEF FALL,400 ;IF SET THEN WE ARE FALLING INTO THE NEXT BOX
SDEF NEEDTP,1000 ;WE NEED A BOXTOP BEFORE THE NEXT SOURCE LINE
;IS OUTPUT
SDEF NEEDBT,2000 ;NEED BOX BOTTOM BEFORE THE NEXT LINE GOES OUT
SDEF NOLOAD,4000 ;DON'T DO A LINLOD
SDEF FLOWP,20000 ;FLOWCHART IS CURRENTLY IN PROGRESS
SDEF TRUNC,40000 ;LINE TOO LONG & TRUNCATED.
SDEF TRUSUP,100000 ;SUPPRESS WARNING ABOUT LINE TRUNCATION
SDEF SHORTX,200000 ;SHORT LINE FLAG FOR PASS 2 ONLY
SUBTTL USER DOCUMENTATION
COMMENT $
Copy the rest of this comment to the file HLP:FORFLO.HLP, to make
the help command, /H, work.
FORFLO: Help & Documentation.
FORFLO is started by the command R FORFLO.
FORFLO performs many functions on FORTRAN source files:
1. Relabel FORTRAN source statements. Statements are
given new numbers in ascending sequence. As a part of this process,
FORMAT statements may be moved to the end of the program and
relabeled.
2. Create a flowchart of the source program
3. Optionally, reformat the source file into 80 column
card images, suitable for batch oriented compilers.
---------------------------------------------------------------------
FORFLO commands have the following form:
revision,listing_source
Each of the terms in a command takes the form of:
DEV:NAME.EXT,
where DEV is a device name, NAME and EXT are the file name
and extension of the file to be written on the device.
The "revision" term denotes the output file where the revised
source will be written. If no extension is given then ".FOR" will be
used.
The "listing" term denotes the destination of the listing
file. This can be LPT: or it may be a disk file. If no extension is
given ".LST" is assumed.
The "source" term names the file that is to be processed. A
project-programmer number, enclosed in square brackets is permitted
in the source term. If no extension is given with the source file
name and if the file named (with blank extension) can not be found,
then the extension ".F4" is tried.
If the DEVice term is omitted anywhere, the device DSK is
assumed.
If "NAME." appears, this forces a blank extension.
If the "revision" term is omitted then no revised source file
will be created. The command
,listing_source
will produce only a listing file.
If the listing term is omitted, then no flowchart or cross
reference can be made. The revised file only is created by the
command:
revision_source.
If both the listing and revision terms are omitted, then the
input file will be checked for those errors that FORFLO can detect.
Error messages will be sent to the user console. Note the command
_source without switches is illegal because (see below) the absence
of switches in the command implies flowcharting, but no flowchart
occurs without a listing device. (This also applies to the command:
revision_source without switches.)
Switches are used to change the default operation of the
program. All switches are in the form of "/nnnL" where nnn is a
(possibly empty, empty = 0) string of digits and L stands for a
particular switch letter.
If no switches are seen in the command then the following
adefaults are specified:
Cross Reference, relabeling (increment=10), no tab conversion,
Format shuffle (first Format number = 10010)
If any switch is seen then the program will be set for
relabeling (by 10) only. Switches are then used to specify further
actions to be performed by the program. Switches may appear anywhere
in the command string as long as they do not break any name
specification.
The available switches are:
/nnnS
Use nnn as the increment in sequence numbering. The default
increment is zero. If the increment is zero then DEC format will be
used in the revision file. If the increment is non-zero then 80
column card image output will be prepared. Sequenceing is done in
columns 73-80. Columns 73-76 contain a four letter subroutine name;
Columns 77-80 contain a four digit number that counts multiples of
the sequencing increment
/nnnL
Use nnn as the increment in renumbering the statement labels.
/L OR /0L implies no renumbering of statements. The default increment
is 10.
/A
Make a Flowchart (implies /C). A listing device is required.
/H
Type the Help Listing (This listing). The Help file should
be on SYS:FORFLO.HLP.
/T
No Tab conversion. Tabs that occur in the source file will
not be converted to spaces. /0S is implied by /T. If conversion to
card images is requested, then tabs will be changed to blanks.
/B
This switch causes blank lines in the source to be deleted.
/K
Keypunch conversion. The following substitutions are made:
( FOR %
) FOR <
= FOR #
' FOR @
+ FOR &
This is provided to aid the conversion of decks punched on
026 keypunches to 029 character codes.
/nnnF
Format Shuffle: All the FORMAT statements in the program
will be moved to the end of the program. The argument, nnn, is used
to specify the number with which the first format should be
relabeled.
/C
Make a Cross Reference table. A listing device is required.
/Q
QUIET. Suppress all of the listing except for the flowchart.
/X
Flowchart only. This is the same as /L/A/S/T/Q. No source
modification is done; the listing includes only the Flowchart.
/Y
Do everything. The effect is:
1. Move FORMATs to the end of the program.
2. Resequence the statement numbers
3. Flowchart the revised program.
(No sequencing is done. Tabs are preserved.)
/W
No warnings: if this switch is set then no warning messages
about line truncation will be typed. Lines that exceed 72 columns
(counting tabs as occupying multiple columns) are truncated to 72
columns. Whenever line truncation occurs a message is typed. If
this switch is set then the message is suppressed.
---------------------------------------------------------------------
Command abbreviation. The command:
source
is an abbreviation of the command
name,name_source
where "name" is the name of the source file found in "source".
The command:
NAME!
will cause the core image file named NAME to be loaded from
device SYS and started. See the Time-Sharing Monitor manual,
DEC-T9-MTZA-D, Addendum 1, section 6.3 for details.
$
SUBTTL THE UUO HANDLER
ILLUUO: TTCALL 3,[ASCIZ/ILLEGAL UUO AT: /]
MOVEI B,@.-1 ;GET ADDRESS OF THAT MESSAGE
TRNE FL,LIST ;LIST UP?
PUSHJ P,OSTRL ;WRITE STRING ON LPT
HRRZ A,(P) ;LOAD THE STACK ADDRESS
SUBI A,1 ;SUBTRACT 1 TO GET REAL PC
PUSHJ P,OCTPTR ;TYPE LOSER'S ADDRESS
UUORET: MOVSI 16,SAVEAC ;LOAD BLT POINTER
BLT 16,16 ;RESTORE ALL AC'S FROM CORE
POPJ P, ;RETURN
DOUUO: MOVEM 16,SAVEAC+16 ;SAVE 16 IN CORE
MOVEI 16,SAVEAC ;LOAD 16 WITH BLT POINTER
BLT 16,SAVEAC+15 ;SAVE 0-15 IN CORE
HRRZ B,40 ;LOAD THE ADDRESS OF UUO OPERAND
CAIG B,16 ;SKIP IF ADDRESS > 16
ADDI B,SAVEAC ;ADDRESS IN AC'S, ADD CORE DISPLACEMENT
LDB W,[POINT 9,40,8] ;LOAD W WITH THE OP CODE
LDB Y,[POINT 4,40,12] ;AND Y WITH THE AC FIELD
CAIGE W,MAXUUO ;COMPARE UUO NUMBER AGAINST OUR MAXIMUM
JRST @UUOTAB(W) ;IF LESS THAN MAX, DISPATCH THRU TABLE
UUOTAB: JRST ILLUUO ;UUO 0 AND MAXUUO ARE ALL LOSERS
JUMP LPUUO ;LPCALL UUO [UUO # 1]
JUMP BCUUO ;BCALL UUO [UUO # 2]
JUMP MSUUO ;MESSAGE UUO [UUO #3]
JUMP MATCHU ;MATCH UUO
SDEF MAXUUO,.-UUOTAB ;DEFINE MAXUUO AS TABLE SIZE
LPUUO: TRNN FL,LIST ;TEST TO SEE IF LIST FLAG IS UP
JRST UUORET ;NOPE, WE DO NO WORK!
TRNE FL,QUIET ;TEST QUIET
TLNE FL,FLOWP ;QUIET SET, HOW ABOUT FLOWP?
JRST .+2 ;EITHER NOT QUIET, OR FLOWP ON.
JRST UUORET ;NO WORK IF QUIET AND NOT FLOWP
CAIN Y,1 ;IS THIS LPCALL 1,?
JRST LPU1 ;YES GO DO THE 1 CHARACTER THING
CAIE Y,3 ;IS THIS LPCALL 3,
JRST ILLUUO ;NO, THEN IT'S ILLEGAL
PUSHJ P,OSTRL ;B ALREADY CONTAINS ADDRESS OF STRING
JRST UUORET ;RETURN
LPU1: MOVE A,(B) ;LOAD ONE CHARACTER FROM WHERE B POINTS
PUSHJ P,PUTLPT ;WRITE ONE character FROM A.
JRST UUORET ;RETURN
BCUUO: CAIN Y,1 ;IS THIS BCALL 1,?
JRST BU1 ;YES, GO DO THE ONE CHARACTER THING
CAIE Y,3 ;IS THIS BCALL 3,?
JRST ILLUUO ;NOPE, ILLEGAL
TRNN FL,TTYF ;SKIP IF WE ARE LISTING ON TTY
TTCALL 3,(B) ;NOPE, NOT LISTING ON TTY SO SEND IT
TRNE FL,LIST ;ARE WE LISTING IN GENERAL?
PUSHJ P,OSTRL ;YES, WRITE STRING
JRST UUORET ;RETURN
BU1: MOVE A,(B) ;PICKUP CHARACTER INTO A.
TRNN FL,TTYF ;SKIP IF USING TTY AS LIST DEV
TTCALL 1,A ;WRITE CHARACTER
TRNE FL,LIST ;SKIP IF NOT LISTING
PUSHJ P,PUTLPT ;WRITE ON LPT
JRST UUORET ;RETURN
OSTRL: HRLI B,(<POINT 7,0>) ;LOAD A BYTE POINTER INTO THE LEFT
OSTRL1: ILDB A,B ;LOAD BYTE
JUMPE A,CPOPJ ;NULL TERMINATES THE STRING
PUSHJ P,PUTLPT ;WRITE ON LPT
JRST OSTRL1 ;BACK FOR THE REST
MSUUO: TRNE FL,TTYF ;DO NOTHING IF FLAG SET
JRST UUORET ;RETURN TO USER
CAIN Y,1 ;MESS 1, ?
JRST MSU1 ;YES
CAIE Y,3 ;MESS 3, ?
JRST ILLUUO ;NO, ERROR
TTCALL 3,(B) ;WRITE STRING
JRST UUORET ;RETURN
MSU1: TTCALL 1,(B) ;WRITE CHARACTER
JRST UUORET ;RETURN
MATCHU: PUSHJ P,UUORET ;FORCE USER AC'S BACK
HRR B,40 ;LOAD STRING ADDRESS
HRLI B,(<POINT 7,0>) ;MAKE IT A STRING POINTER
PUSHJ P,MATCHS ;CALL SEARCH
POPJ P, ;LOSE
JRST CPOPJ1 ;WIN
SUBTTL THE LOW-LEVEL I/O DRIVERS FOR ALL THE WORLD.
DEFINE GIN(LABELX,CHAN,BUFFXX,LL)<
LABELX: SOSLE BUFFXX+2 ;DECREMENT CHARACTER COUNT
JRST LL ;THERE'S STILL SOME LEFT
IN CHAN, ;ASK SYSTEM TO GET MORE
JRST LL ;INPUT OK
STATO CHAN,20000 ;SKIP IF END OF FILE SET
PUSHJ P,DIE ;DEVICE INPUT ERROR
POPJ P, ;END OF DATA, DIRECT RETURN
LL: ILDB A,BUFFXX+1 ;LOAD NEXT CHARACTER INTO A
JUMPE A,LABELX ;THROW AWAY NULLS
JRST CPOPJ1 ;DO A SKIP-RETURN
>
DEFINE GOUT(LABEL,CHAN,BUFFXX,LL)<
LABEL: SOSLE BUFFXX+2 ;DECREMENT COUNT OF SPACE LEFT
JRST LL ;STILL SPACE IN BUFFER
OUT CHAN, ;ASK SYSTEM TO OUTPUT BUFFER
JRST LL ;OUTPUT OK
PUSHJ P,DDE ;DEVICE DATA ERROR
LL: IDPB A,BUFFXX+1 ;DEPOSIT CHARACTER IN BUFFER
POPJ P, ;RETURN TO CALLER
>
GIN (GETTTY,TTY,TTYBUF,LL1) ;COMMAND INPUT FILE/TTY
GIN (GETDK1,DSK1,DK1BUF,LL2) ;SCRATCH(1) INPUT
GIN (GETDK2,DSK2,DK2BUF,LL3) ;SCRATCH(2) INPUT
GIN (GETCDR,CDR,CDRBUF,LL4) ;SOURCE FILE INPUT
GOUT (PUTDK1,DSK1,DK1BUF,LL5) ;SCRATCH(1) OUTPUT
GOUT (PUTDK2,DSK2,DK2BUF,LL6) ;SCRATCH(2) OUTPUT
GOUT (PUTCDP,CDP,CDPBUF,LL7) ;TEXT OUTPUT
GOUT (PUTLPT,LPT,LPTBUF,LL8) ;LIST OUTPUT
SUBTTL COMMAND INPUT ROUTINE (TTY OR DSK)
GNCH: PUSHJ P,GETTTY ;GET CHARACTER FROM TTY OR COMMAND FILE
JRST TTYEOF ;END OF FILE ON COMMAND FILE.
MOVE Y,@TTYBUF+1 ;LOAD A WITH THE CURRENT WORD
TRNN Y,1 ;CHECK LAST BIT
JRST GNCHOK ;IS OK
MOVNI A,5 ;IS SEQUENCE #. DELETE NEXT 5 CHARS
ADDM A,TTYBUF+2 ;DECREASE COUNT THIS WAY
AOS TTYBUF+1 ;PUSH BYTE POINTER PAST LOSERS
JRST GNCH ;GET NEXT CHARACTER
GNCHOK: CAIN A," " ;THROW OUT BLANKS
JRST GNCH ;BY ASKING FOR ANOTHER CHARACTER
CAIG A,"z" ;CHARS ABOVE 172 ==> ALTMODE
CAIN A,33 ;33 IS ALSO ALTMODE
JRST SETALT ;CONVERT TO LF AT SETALT
CAIL A,"a" ;SKIP IF UPPER CASE
TRZ A,40 ;MAKE LOWER CASE UPPER (ALSO 173-177)
POPJ P, ;NOT LOWER CASE
SETALT: MOVEI A,12 ;LOAD A WITH 12
TTCALL 3,ASCRLF ;TYPE CRLF
POPJ P, ;RETURN
FLUTTY: PUSHJ P,GNCH ;FLUSH THRU NEXT LF
CAIN A,12 ;CHECK FOR LF
POPJ P, ;ENOUGH
JRST FLUTTY ;FLUSH MORE.
TTYEOF: CLOSE TTY, ;CLOSE CHANNEL
SETZB A,B ;ZERO FOUR REGISTERS
SETZB C,D ;...
RENAME TTY,A ;DELETE COMMAND FILE
JFCL ;IGNORE FAILURE
RELEAS TTY, ;GIVE UP CHANNEL
EXIT ;GO AWAY
SUBTTL COMMAND SCANNER (LOW LEVEL)
SCAN: SETZM SCANT ;ZERO STUFF WITH A BLT
MOVE B,[XWD SCANT,SCANT+1] ;BLT POINTER
BLT B,SCANX+3 ;ZERO TO 5 WORDS
SCAN1: MOVE B,[POINT 6,SCANT] ;ACCUMULATE 6BIT IN SCANT
SETZB C,SCANT ;ZERO COUNT AND SCANT
SCAN2: PUSHJ P,GNCH ;GET A CHARACTER FROM COMMAND LINE
CAIN A,15 ;IGNORE CR
JRST SCAN2 ;BY getting NEXT CHARACTER
CAIN A,12 ;LF TERMINATES A COMMAND
JRST SCAND1 ;SO GO DO A DELIMITER
CAIN A,"/" ;SLASH precedes A SWITCH
JRST SCND0 ;SO FIND WHICH SWITCH TO SWITCH
CAIN A,"!" ;MEANS TO GO OFF AND RUN ANOTHER
JRST RUNIT ;SO GO RUN OFF WITH ANOTHER PROGRAM
CAIN A,"," ;WE WILL SEE LISTING SPECIFIER NEXT
JRST SCAND1 ;OFF TO SAY WE'VE SEEN A DELIMITER
CAIN A,"=" ;CONVERT = TO _ , SOURCE SPECIFIER
MOVEI A,"_" ;= BECOMES _
CAIN A,"_" ;THIS IS THE SOURCE TERM SPECIFIER
JRST SCAND1 ;OFF TO DELIMITER ROUTINES
CAIN A,"." ;THING WE JUST SAW WAS A FILE NAME
JRST SCAND2 ;OFF TO SPECIAL DELIMITER
CAIN A,":" ;THING JUST SEEN WAS A DEVICE
JRST SCAND3 ;SO GO OFF AND SAVE THE DEVICE
CAIN A,"[" ;WE ARE GOING TO SEE PPN
JRST SCPPN ;SO SCAN PPN
SUBI A," " ;MAKE CHARACTER TO SIXBIT
JUMPL A,ILC ;ILLEGAL CHARACTER
CAILE A,77 ;MAKE SURE IN RANGE
JRST ILC ;ALSO ILLEGAL
ADDI C,1 ;COUNT CHARACTERS
CAIG C,6 ;MAKE SURE IN RANGE
IDPB A,B ;IF IN RANGE, DEPOSIT
JRST SCAN2 ;BACK FOR MORE
SAVEFE: JUMPE C,CPOPJ ;QUICK RETURN TO CALLER
SETZ C, ;USING C AS INDEX
MOVE A,SCANT ;LOAD THE SIXBIT PART
SKIPE SCANX+1 ;SKIP IF NO FILE NAME
MOVEI C,1 ;WE HAVE FILE NAME
MOVEM A,SCANX+1(C) ;SAVE SIXBIT AS FILE OR EXT
POPJ P, ;RETURN TO CALLER
SCAND1: MOVE X,A ;SAVE DELIMITER CHARACTER
PUSHJ P,SAVEFE ;SAVE PRESENT TEXT
JRST SCNRET ;AND RETURN
SCAND2: MOVE A,SCANT ;PICKUP SIXBIT
MOVEM A,SCANX+1 ;SAVE AS FILE NAME
AOS SCANX+2 ;KLUGE FOR EXPLICIT .
JRST SCAN1 ;GO BACK FOR MORE
SCAND3: MOVE A,SCANT ;LOAD SIXBIT
MOVEM A,SCANX ;SAVE AS DEVICE NAME
JRST SCAN1 ;AND GET MORE
SCPPN: PUSHJ P,SAVEFE ;SAVE ANY TEXT OUTSTANDING
SCPPN0: SETZ B, ;ZERO PPN ACCUMULATOR
SCPPN1: PUSHJ P,GNCH ;GET A CHARACTER
CAIN A,"]" ;THIS TERMINATES
JRST SCPPN3 ;THE PPN SCAN
CAIE A,"," ;THIS DELIMITS ONE SIDE
CAIN A,"/" ;ALTERNATIVE DELIMITER FOR PROJ
JRST SCPPN2 ;SO GO OFF TO SAY WE'VE SEEN PROJ
IFGE SANSW,< ;FOR OCTAL OR DECIMAL PPN'S
CAIL A,"0" ;THIS IS SUPPOSED TO BE A DIGIT
CAIL A,"0"+PPNMUL ;SKIP IF WE HAVE AN OK DIGIT
JRST ILC ;SCAN ERROR
IMULI B,PPNMUL ;MULTIPLY BY THE BASE
ADDI B,-"0"(A) ;ADD IN THE LATEST DIGIT
> ;END OF SANSW GE 0
IFL SANSW,< ;SIXBIT PPN'S
CAIL A," " ;MAKE SURE THAT WE'RE IN SIXBIT
CAIL A,140 ;RANGE
JRST ILC ;LOSER.
LSH B,6 ;SHIFT accumulated CHARACTERS
ADDI B,-" "(A) ;ADD IN THE NEW CHARACTER
> ;END OF SIXBIT PPN STUFF
JRST SCPPN1 ;BACK FOR MORE
SCPPN2: HRLZ C,B ;LOAD PROJ INTO C(LEFT)
JRST SCPPN0 ;BACK FOR MORE
SCPPN3: HRR C,B ;LOAD PROG INTO C(RIGHT)
MOVEM C,SCANX+3 ;SAVE AS PPN IN FILE BLOCK
JRST SCAN1 ;MAYBE MORE (SWITCHES, SAY)
SCNRET: SKIPE SCANX ;CHECK IF WE HAVE DEVICE
JRST CPOPJ1 ;WE HAVE DEVICE, DO A SKIP RETURN
MOVSI C,'DSK' ;SET UP DEFAULT DEVICE
MOVEM C,SCANX ;SAVE AS DEVICE
SKIPE SCANX+1 ;WE HAD NO DEVICE, HAVE WE A NAME
CPOPJ1: AOS (P) ;WE HAVE DEVICE OR FILE NAME
CPOPJ: POPJ P, ;RETURN.
; NOTE THAT CPOPJ IS AN ORDINARY POPJ INSTRUCTION
; SUITABLE FOR USE IN "JUMPE A,CPOPJ", ETC.
; CPOPJ1 WILL CAUSE THE ROUTINE THAT USES IT TO SKIP
; PAST ONE INSTRUCTION AFTER THE CALL (A SKIP RETURN)
RUNIT: PUSHJ P,SAVEFE ;SAVE ANY TEXT
SKIPN A,SCANX ;CHECK DEVICE
MOVSI A,'SYS' ;DEFAULT IT TO SYS
MOVE B,SCANX+1 ;LOAD A FILE NAME
HLLZ C,SCANX+2 ;AND POSSIBLY AN EXTENSION
SETZB D,X ;ZERO OTHER PLACES
MOVE W,SCANX+3 ;PPN OF FILE
MOVEI Y,A ;ADDRESS OF RUN BLOCK
TRNE FL,STARSW ;CHECK THE WAY WE WERE STARTED
IFLE STANSW,< HRLI Y,1 ;MARK ENTRY OFFSET FOR RUN UUO
RUN Y, ;GO RUN IT >
IFG STANSW,< MOVEI D,1 ;LOAD STARTING INCREMENT INTO D
CALL Y,[SIXBIT/SWAP/] ;USE THE STANFORD UUO >
HALT ;WE CANT GET HERE UNLESS UUO FAILS
SCND0: PUSHJ P,SAVEFE ;SAVE ANY TEXT
SETZ C, ;USING C TO ACCUMULATE NUMBER
SCND1: PUSHJ P,GNCH ;GET A CHARACTER
CAIL A,"0" ;SKIP IF TOO SMALL FOR DIGIT
CAILE A,"9" ;SKIP IF IT IS A DIGIT
JRST SCND2 ;NO DIGIT MUST BE SWITCH NAME
IMULI C,12 ;ACCUMULATE NUMBER IN C
ADDI C,-"0"(A) ;ADD IN NEW DIGIT
JRST SCND1 ;BACK FOR MORE
SCND2: MOVSI B,-SWTBL ;LOAD WITH SWITCH TABLE LENGTH
HLRZ D,SWTB(B) ;LOAD D WITH SWITCH LETTER
CAME A,D ;COMPARE WITH THING WE SCANNED
AOBJN B,.-2 ;NO MATCH, INCREMENT B AND JUMP
JUMPL B,[HRRZ B,SWTB(B) ;IF B<0 THEN WE FOUND ONE
TLO FL,SWSN ;ANNOUNCE WE HAVE SEEN SWITCH
XCT (B) ;EXECUTE THE APPROPRIATE ROUTINE
JRST SCAN1] ;AND JUMP BACK TO SCAN1
TTCALL 3,[ASCIZ/UNRECOGNIZED SWITCH/]
JRST ILC ;THE LOSER LOSES
DEFINE CTB(A,B) < XWD "A",B> ;DEFINE THE SWITCH TABLE/DISPATCH
SWTB: CTB(H,HELP) ;H FOR HELP
CTB(S,SSWTCH) ;SET COL 77-80 SEQUENCE INCREMENT
CTB(L,LSWTCH) ;SET LABEL INCREMENT
CTB(T,TABSET) ;SET TO LEAVE TABS ALONE IN COL 7-72
CTB(B,BSET) ;DELETE BLANK LINES IF SET
CTB(K,KSET) ;CONVERT 026 TO 029 KEYPUNCHES
CTB(C,CSET) ;ASK FOR CREF
CTB(F,SETF) ;SET FIRST LABEL FOR FORMATS
CTB(A,SETFLO) ;ASK FOR FLOWCHART
CTB(Q,SETQU) ;QUIET EXCEPT FOR FLOWCHART
CTB(X,SETXS) ;SAME AS /L/A/S/T/Q
CTB(Y,SETYS) ;SAME AS /F/A/S/T
CTB(W,SETWS) ;SUPPRESS LINE TRUNCATION MESSAGE
SDEF SWTBL,.-SWTB ;LENGTH OF TABLE
SSWTCH: MOVEM C,SEQINC ;SAVE C AS SEQUENCE INCREMENT
LSWTCH: MOVEM C,SNO ;SAVE C AS LABEL INCREMENT
TABSET: JRST .+1 ;TAKE CONTROL AWAY FROM XCT
TRO FL,TABSW ;SET TABSW
SETZM SEQINC ;NO SEQUENCING IN COLS 73-80
JRST SCAN1 ;RETURN
BSET: TRO FL,BSW ;SET BSW
KSET: TRO FL,KEYS ;SWITCH ON KEYS FOR CONVERSION
CSET: TRO FL,CREF ;CREF ON
setws: tlo fl,trusup ;no truncation messages
SETF: JRST .+1 ;TAKE CONTROL AWAY FROM XCT
MOVEM C,FMTFNO ;SAVE FIRST NUMBER FOR FORMATS
TRO FL,FORMAT ;SWITCH ON
JRST SCAN1 ;RETURN
SETFLO: TRO FL,FLOW!CREF ;ASK FOR FLOW AND CREF
SETQU: TRO FL,FLOW!QUIET!CREF ;ASK FOR FLOW,CREF AND QUIET
SETXS: JRST .+1 ;SEIZE CONTROL FROM XCT
TRO FL,FLOW!QUIET!CREF!TABSW ;SET LOTS
SETZM SEQINC ;NO SEQUENCING
SETZM SNO ;NO RELABELING
JRST SCAN1 ;RETURN
SETYS: JRST .+1 ;SEIZE CONTROL
TRO FL,FLOW!FORMAT!CREF!TABSW ;SET STUFF
SETZM SEQINC ;NO SEQUENCING
SETZM FMTFNO ;DEFAULT FOR RELABELING FORMATS
JRST SCAN1 ;RETURN
SUBTTL HELP COMMAND
HELP: JRST .+1 ;SEIZE CONTROL FROM XCT
INIT DSK1,1 ;OPEN SCRATCH CHANNEL
IFLE STANSW,< SIXBIT /HLP/ ;USE HLPTEM DEVICE>
IFG STANSW,< SIXBIT /DSK/ ;USE DISK>
XWD 0,DK1BUF ;USING AN INPUT BUFFER
PUSHJ P,NODSK ;INIT FAILED ON DSK?
PUSH P,JOBFF ;SAVE PRESENT JOBFF ON STACK.
INBUF DSK1,2 ;ASK FOR TWO BUFFERS (JOBFF IS A
;PARAMETER TO THIS CALL AND IS CHANGED
MOVE A,[SIXBIT/FORFLO/] ;LOAD REGISTERS WITH FILE NAME
IFLE STANSW,< MOVSI B,'HLP' ;AND EXTENSION>
IFG STANSW,< MOVSI B,'REG' ;AND EXTENSION>
SETZB C,D ;AND BLANK PPN OF HELP FILE
IFG STANSW,< MOVE D,[SIXBIT/ UPDOC/] ;DOCUMENTATION PPN>
LOOKUP DSK1,A ;LOOK FOR IT
JRST NOHELP ;I CAN'T FIND THE FILE
HELP1: PUSHJ P,GETDK1 ;READ A CHARACTER FROM THE FILE
JRST HELP2 ;EOF
TTCALL 1,A ;WRITE ON USER CONSOLE
JRST HELP1 ;LOOP FOR MORE
NOHELP: TTCALL 3,HELPM
HELP2: RELEAS DSK1, ;END OF FILE, RELEASE CHANNEL
POP P,JOBFF ;RESTORE JOBFF FROM STACK
JRST SCAN1 ;RETURN
HELPM: ASCIZ/
The FORFLO help file cannot be located. Page 6 of the FORFLO source
file contains the user documentation. This should be copied to
HLP:FORFLO.HLP to make this help command work.
/
SUBTTL INITIALIZATION
BEGIN: TRZA FL,STARSW ;MARK SWITCH AS NORMAL
TRO FL,STARSW ;MARK AS SPECIAL START UP
RESET ;RESET ALL I/O AND CORE SIZE
ANDI FL,STARSW ;ZERO ALL FLAGS, EXCEPT STARSW
MOVE P,[IOWD PDLEN,PDLIST] ;INITIALIZE PUSH DOWN LIST
TTCALL 3,ASCRLF ;TYPE SOMETHING TO SAY WE LIVE
MOVEI A,LOWEND+1 ;READY TO DEFINE JOBFF
SKIPE JOBDDT ;TEST TO SEE IF WE HAVE DDT
HRRZ A,JOBFF ;YES, GET THE LOADER'S VERSION OF JOBFF
HRRM A,JOBFF ;SAVE AS JOBFF
PUSH P,A ;SAVE JOBFF ON THE STACK
INIT TTY,1 ;FIRST, LOOKUP RPG FILE.
SIXBIT /DSK/ ;USE DEVICE DSK
XWD 0,TTYBUF ;INPUT ONLY
PUSHJ P,NODSK ;THIS IS NOT SUPPOSED TO HAPPEN
INBUF TTY,2 ;ASK FOR TTY BUFFERS
PJOB A, ;GET THE FILE NAME
IDIVI A,144 ;MAKE UP NAME
ADDI A,20 ;###FOR.TMP
IDIVI B,12 ;WHERE ### IS THE DECIMAL JOB NUMBER
LSH A,6 ;...
ADDI A,20(B) ;...
LSH A,6 ;...
ADDI A,20(C) ;...
MOVSS A ;MOVE ### TO LEFT SIDE
HRRI A,'FF1' ;CREATE TWO TEMP NAMES
MOVEM A,TMPNAM ;SAVE FIRST NAME
HRRI A,'FF2' ;...
MOVEM A,FMTNAM ;SECOND NAME
IFLE STANSW,< ;FOR LOSERS
HRRI A,'FOR' ;USE ###FOR.TMP AS COMMAND FILE
MOVSI B,'TMP' ;LOAD EXT
> ;END OF CCL CODE
IFG STANSW,< ;GOOD GUYS
MOVE A,[SIXBIT/QQFORF/] ;USE QQFORF.RPG AS FILE
MOVSI B,'RPG' ;FOR STANFORD RPG
> ;END OF RPG CODE
SETZB C,D ;DEFAULT PPN
LOOKUP TTY,A ;LOOKUP
JRST BEGIN0 ;NO FILE, LET GUY TYPE COMMANDS
POP P,(P) ;DELETE JOBFF ENTRY FROM STACK
MOVE A,JOBFF ;LOAD PRESENT JOBFF
MOVEM A,BEGFF ;SAVE AS BEGINNING JOBFF
TRO FL,RPGSW ;SET UP TO SAY WE ARE READING DSK
JRST BEGINA ;OFF TO READ THE COMMANDS
BEGIN0: INIT TTY,1 ;WE SHALL USE THE TTY
SIXBIT /TTY/ ;INIT USER'S CONSOLE IN MODE
XWD 0,TTYBUF ;1 FOR INPUT ONLY
PUSHJ P,NOTTY ;THIS CAN'T HAPPEN EITHER
POP P,A ;GET ORIGINAL VALUE OF JOBFF
HRRM A,JOBFF ;RESET JOBFF
INBUF TTY,2 ;GET SOME BUFFERS FOR THE TTY
TTCALL 3,[ASCIZ/FORFLO V.0/] ;TELL USER THAT WE LIVE
MOVE A,137 ;PICKUP VERSION NUMBER
PUSHJ P,OCTPTR ;WRITE IN OCTAL
TTCALL 3,[ASCIZ " /H FOR HELP.
"] ;THE REST OF OUR MESSAGE
MOVE A,JOBFF ;PICKUP PRESENT VALUE OF JOBFF
MOVEM A,BEGFF ;SAVE AS BEGINNING JOBFF
JRST BEGINA ;OFF TO SEE THE WIZARD
ASCRLF: BYTE(7)15,12 ;ASCII CARRIAGE RETURN LINE FEED
ASCRFF: BYTE(7)15,14 ;ASCII CARRIAGE RETURN FORM FEED
ASC5SP: BYTE(7)40,40,40,40,40 ;ASCII 5 SPACES
SUBTTL PARSE THE COMMAND LINE
BEGINA: HRRZ A,BEGFF ;RESET TO SIZE GIVEN BY BEGFF
MOVEM A,JOBFF ;RESET JOBFF TO BEGFF
CORE A, ;POSSIBLY SHRINK BACK TO STARTING SIZE
JRST COREX. ;THIS CAN'T HAPPEN ON A SHRINK
ANDI FL,RPGSW!STARSW ;ZERO ALL FLAGS EXCEPT RPGSW AND STARSW
MOVE P,[IOWD PDLEN,PDLIST] ;REINITIALIZE THE PUSH DOWN LIST
TRNN FL,RPGSW ;CHECK FLAG
TTCALL 3,[ASCIZ/*/] ;TYPE * IF WE WANT COMMAND FROM TTY
SETZM SRCDEV ;PREPARE TO ZERO FILE DESCRIPTORS
MOVE A,[XWD SRCDEV,SRCDEV+1] ;SET UP BLT POINTER
BLT A,PCHEXT ;ZERO ALL FILE DESCRIPTIONS
MOVEI A,12 ;LOAD DEFAULT INCREMENT
MOVEM A,SNO ;FOR LABELS
SETZM SEQINC ;ZERO SEQUENCE INCREMENT
PUSHJ P,SCAN ;SCAN PUNCH FILE
JRST [CAIN X,12 ;NOTHING THERE
JRST BEGINA ;WAS EMPTY COMMAND
JRST BEGINB] ;JUST NOT A PUNCH FILE
CAIN X,12 ;SPECIAL COMMAND?
JRST SPECMD ;YUP
TRO FL,PUNCH ;SET UP PUNCH FLAG
SKIPN A,SCANX+2 ;LOAD AND TEST EXTENSION
MOVSI A,'FOR' ;THE DEFAULT FILE EXTENSION
MOVEM A,SCANX+2 ;SAVE AS FILE EXTENSION
MOVE B,[XWD SCANX,PCHDEV] ;PREPARE TO BLT THE
BLT B,PCHEXT ;FILE SPECIFIER TO PUNCH DEV ...EXT
MOVEI A,1 ;MODE 1 FOR OPEN
MOVE B,PCHDEV ;PCHDEV AS DEVICE NAME
MOVSI C,CDPBUF ;OUTPUT ONLY
OPEN CDP,A ;TRY TO INIT THE DEVICE
PUSHJ P,NODEV. ;OPEN FAILED
OUTBUF CDP,2 ;ESTABLISH BUFFERS
BEGINB: CAIN X,"_" ;IS THIS SOURCE TERM NEXT?
JRST BEGINC ;YES, THERE'S NO LIST FILE
CAIE X,"," ;THIS SPECIFIES THE LISTING FILE
JRST ILC ;WE HAVE AN ILLEGAL COMMAND
PUSHJ P,SCAN ;SCAN THE LISTING SPECIFIER
JRST BEGINC ;THERE WASN'T A LIST AFTER ALL
SKIPN A,SCANX+2 ;LOAD AND TEST EXTENSION
MOVSI A,'LST' ;USE DEFAULT EXTENSION
MOVEM A,SCANX+2 ;SAVE IT BACK AT SCANX+2
MOVE A,[XWD SCANX,LSTDEV] ;PREPARE TO BLT FILE DESCRIPTOR
BLT A,LSTEXT ;TO LSTDEV ... LSTEXT
MOVEI A,1 ;PREPARE AN OPEN. MODE 1
MOVE B,LSTDEV ;DEVICE NAME
MOVSI C,LPTBUF ;OUTPUT ONLY
OPEN LPT,A ;ASK TO OPEN CHANNEL
PUSHJ P,NODEV. ;DEVICE NOT AVAILABLE
OUTBUF LPT,2 ;ASK FOR SOME BUFFERS
TRO FL,LIST ;WE ARE LISTING
BEGINC: CAIN X,"_" ;DO WE HAVE SOURCE SPECIFIER?
PUSHJ P,SCAN ;SCAN SOURCE
JRST ILC ;EMPTY SOURCE OR NO _
JRST BEGC1 ;JUMP AROUND SPECIAL KLUGE
SPECMD: MOVSI A,'DSK' ;DSK FOR PUNCH/LIST
MOVE B,SCANX+1 ;LOAD FILE NAME
IFLE STANSW,< ;NO SOURCE AT STANFORD
MOVEM A,PCHDEV ;SET DEVICE NAME
MOVEM B,PCHNAM ;AND NAME
MOVSI C,'FOR' ;LOAD EXTENSION
MOVEM C,PCHEXT ;SAVE EXTENSION
INIT CDP,1 ;OPEN PUNCH CHANNEL
SIXBIT /DSK/ ;DISK IN ASCII MODE
XWD CDPBUF,0 ;OUTPUT ONLY
PUSHJ P,NODSK ;LOSSAGE?
OUTBUF CDP,2 ;GET SOME BUFFERS
TRO FL,PUNCH ;SAY WE ARE PUNCHING
> ;ALL THIS NOT AT STANFORD
MOVEM A,LSTDEV ;SAVE LIST DEVICE NAME
MOVEM B,LSTNAM ;AND FILE NAME
MOVSI C,'LST' ;LOAD EXTENSION
MOVEM C,LSTEXT ;SAVE
INIT LPT,1 ;OPEN LIST CHANNEL
SIXBIT /DSK/
XWD LPTBUF,0 ;OUT ONLY
PUSHJ P,NODSK ;LOSER
OUTBUF LPT,2 ;GET SOME BUFFERS
TRO FL,LIST ;SET FLAG
;FALL INTO CODE TO OPEN SOURCE FILE
BEGC1: MOVE A,[XWD SCANX,SRCDEV] ;PREPARE A BLT
BLT A,SRCPPN ;TO SAVE SOURCE FILE DESCRIPTION
MOVEI A,1 ;PREPARE AN OPEN. MODE 1
MOVE B,SRCDEV ;USING SRCDEV AS DEVICE
MOVEI C,CDRBUF ;AND INPUT ONLY
OPEN CDR,A ;OPEN CHANNEL
PUSHJ P,NODEV. ;OPEN HAS FAILED
INBUF CDR,2 ;ASK MONITOR FOR BUFFERS
DEVCHR B, ;GET DEVICE CHARACTERISTICS
TLNN B,4 ;CHECK TO SEE IF IT'S DIRECTORY DEV
JRST BEGIND ;NON-DIRECTORY
MOVE A,SRCNAM ;FOR DIRECTORY DEVICE, WE NEED LOOKUP
HLLZ B,SRCEXT ;LOAD A WITH NAME, B WITH EXT
SETZ C, ;ZERO C AND
MOVE D,SRCPPN ;LOAD D WITH THE PPN
LOOKUP CDR,A ;SELECT FILE FOR INPUT
JRST .+2 ;FAILED. TRY SOME MORE
JRST BEGIND ;LOOKUP SUCCEEDS
SKIPE SRCEXT ;SKIP IF SOURCE EXT WAS ZERO
PUSHJ P,NOLOK. ;I MAKE NO ASSUMPTIONS
MOVSI B,'F4 ' ;NOTE THAT 'F4 ' IS RIGHT JUSTIFIED
SETZ C, ;ZERO C AGAIN
MOVE D,SRCPPN ;RELOAD WITH PPN
LOOKUP CDR,A ;TRY AGAIN
JRST [SETZ B, ;RESTORE ORIGINAL
PUSHJ P,NOLOK.] ;AND LOSE
BEGIND: INIT DSK1,1 ;OPEN TEMP1 CHANNEL
SIXBIT /DSK/ ;DISK IN MODE 1
XWD 0,DK1BUF ;IRRELEVANT BUFFER HEADER
PUSHJ P,NODSK ;THIS IS NOT SUPPOSED TO HAPPEN
MOVE A,JOBFF ;GET PRESENT JOBFF
MOVEM A,DSKFF ;SAVE AS PLACE TO START DSK1 BUFFERS
INBUF DSK1,2 ;GET BUFFERS SO WE KNOW WHAT WE NEED
TLNN FL,SWSN ;ANY SWITCHES SEEN?
JRST [TRO FL,FORMAT!CREF!TABSW ;NO--SET SOME
MOVEI A,^D10010 ;FIRST FORMAT
MOVEM A,FMTFNO ;SAVE
JRST .+1] ;RETURN
TRNN FL,FORMAT+FLOW ;IF EITHER SET THEN WE NEED DSK2
JRST BEGINF ;SKIP THIS NEXT STUFF SINCE NO DSK2
INIT DSK2,1 ;OPEN DISK 2 IN MODE 1
SIXBIT /DSK/ ;DISK
XWD 0,DK2BUF ;IRRELEVANT BUFFER
PUSHJ P,NODSK ;CAN'T HAPPEN
MOVE A,JOBFF ;LOAD JOBFF
MOVEM A,FMTFF ;STORE AS FIRST FREE FOR DSK2
INBUF DSK2,2 ;ASK FOR BUFFERS SO WE KNOW WHERE
BEGINF: MOVE A,JOBFF ;FIRST FREE STORAGE LIVES
RELEAS DSK1, ;GIVE UP SCRATCH CHANNEL
RELEAS DSK2, ;GIVE UP SCRATCH CHANNEL
TRNN FL,PUNCH ;CHECK TO SEE IF MAKE PUNCH FILE
JRST BEGING ;NOPE, SKIP THE ENTER
MOVE B,PCHDEV ;GET NAME OF PUNCH DEVICE
DEVCHR B, ;I HOPE B STILL HAS THE NAME
TLNN B,4 ;SKIP IF IT IS A DIRECTORY DEVICE
JRST BEGING ;SKIP THE ENTER FOR NON-DIRECTORY
MOVE A,PCHNAM ;LOAD FILE NAME
HLLZ B,PCHEXT ;AND EXTENSION
SETZB C,D ;DEFAULT THE REST
ENTER CDP,A ;DO ENTER
PUSHJ P,NOENT. ;FAILURE
BEGING: TRNN FL,LIST ;ARE WE LISTING?
JRST BEGINH ;NOPE
MOVE B,LSTDEV ;GET THE NAME OF LIST DEVICE
DEVCHR B, ;AND IT'S CHARACTERISTICS
TLNN B,4 ;SKIP IF DIRECTORY DEVICE
JRST [TLNE B,10 ;SKIP IF NOT TTY
TRO FL,TTYF ;SET FLAG TO SAY WE ARE LISTING ON TTY
JRST BEGINH] ;JUMP PAST ENTER
MOVE A,LSTNAM ;GET FILE NAME
HLLZ B,LSTEXT ;AND EXTENSION
SETZB C,D ;DEFAULT THE REST
ENTER LPT,A ;ENTER
PUSHJ P,NOENT. ;ENTER FAILED
BEGINH: SKIPE SEQINC ;SKIP UNLESS SEQUENCING
TRO FL,BSW ;BLANK LINES DELETED IF SEQUENCING
TRNN FL,LIST ;SKIP IF LISTING
TRNN FL,CREF ;SKIP IF NOT LISTING BUT CREFing
JRST BEGINI ;OK, NOT CREF WITHOUT LIST
TTCALL 3,[ASCIZ/
? Flowchart or Cref requested and no list device
/]
RELEAS CDR,
RELEAS CDP,
JRST BEGINA ;DO NOT PASS GO.
BEGINI: TRZ FL,EOFFLG!TXTBUF ;CLEAR EOF AND BUFFER FULL
PUSHJ P,WORKER ;DO ALL THE WORK IN THE WORLD
CLOSE DSK1, ;CLOSE TEMP1
SETZB A,B ;ZERO FOUR REGISTERS
SETZB C,D ;FOR RENAME THAT DELETES
RENAME DSK1,A ;DELETE TEMP1 FILE
JFCL ;IGNORE DELETE FAILURE
FINISH: RELEAS CDR, ;END OF DATA. RETURN TO COMMAND MODE
RELEAS DSK1, ;RELEASE ALL DEVICES (EXCEPT TTY)
TRNN FL,PUNCH ;IF WE WERE PUNCHING
JRST FINI.1 ;WE WERE NOT PUNCHING
CLOSE CDP, ;CLOSE PUNCH FILE
STATZ CDP,740000 ;CHECK I/O STATUS
PUSHJ P,DDE ;LOSE AT THIS LATE DATE
RELEAS CDP, ;GIVE UP CDP CHANNEL
FINI.1: TRNN FL,LIST ;WERE WE LISTING?
JRST BEGINA ;NOPE, QUICK BACK TO COMMAND LEVEL
CLOSE LPT, ;CLOSE LPT
STATZ LPT,740000 ;CHECK STATUS
PUSHJ P,DDE ;LOSING STATUS
RELEAS LPT, ;RELEASE CHANNEL
JRST BEGINA ;GET ANOTHER COMMAND
SUBTTL INITIALIZE PASS1, INTERPASS INTERFACE, FINAL CLEANUP.
WORKER: TRNE FL,EOFFLG ;HAVE WE SEEN EOF
POPJ P, ;RETURN. WE ARE DONE.
INIT DSK1,1 ;OPEN CHANNEL FOR SCRATCH FILE
SIXBIT /DSK/ ;DISK, CHANNEL NAME DSK1, MODE 1
XWD DK1BUF,0 ;OUTPUT SIDE ONLY
PUSHJ P,NODSK ;THIS ISN'T EVER SUPPOSED TO HAPPEN
MOVE A,DSKFF ;LOAD WITH THE ADDRESS TO PUT BUFFERS
EXCH A,JOBFF ;EXCHANGE WITH JOBFF
OUTBUF DSK1,2 ;ASK FOR BUFFERS
MOVEM A,JOBFF ;RESTORE JOBFF (THE SECRET PARAMETER)
MOVE A,TMPNAM ;SET UP AN ENTER. USE NAME
MOVSI B,'TMP' ;IN TMPNAME AND .TMP EXTENSION
SETZB C,D ;DEFAULT EVERYTHING ELSE
ENTER DSK1,A ;DO AN ENTER
PUSHJ P,SFLU ;PUBLISH THE HORROR STORY
TRNN FL,FORMAT ;TEST THE FORMAT FLAG
JRST WORK.1 ;NOT DOING FORMAT SHUFFLE
INIT DSK2,1 ;WE ARE DOING FORMAT SHUFFLE, OPEN
SIXBIT /DSK/ ;ANOTHER SCRATCH FILE USING
XWD DK2BUF,0 ;DSK2 IN MODE 1, OUTPUT ONLY
PUSHJ P,NODSK ;THIS IS NOT SUPPOSED TO HAPPEN
MOVE A,FMTFF ;LOAD ADDRESS FOR MORE BUFFERS
EXCH A,JOBFF ;EXCHANGE WITH JOBFF
OUTBUF DSK2,2 ;ASK FOR BUFFERS
MOVEM A,JOBFF ;AND RESTORE JOBFF
MOVE A,FMTNAM ;PREPARE ENTER. FILE NAME IN A
MOVSI B,'TMP' ;EXTENSION IN B
SETZB C,D ;DEFAULT C,D
ENTER DSK2,A ;SELECT FILE FOR OUTPUT
PUSHJ P,SFLU ;PUBLISH FAILURE
WORK.1: HRRZ A,JOBFF ;GET ADDRESS OF FREE AREA
MOVEM A,TABSP ;SAVE AS ADDRESS OF TABLE SPACE
CORE A, ;SHRINK TO SIZE OF JOBFF
JRST COREX. ;OUGHT NOT HAPPEN ON A SHRINK
MOVE A,SNO ;TAKE STMT NO INCREMENT
MOVEM A,FNO ;AND SAVE AS FIRST NUMBER
SETZM KEY ;ZERO KEY
SETZM NAME ;PROGRAM NAME
SETZM NAME+1 ;...
SETZM ERRCNT ;ERROR COUNT
SETZM NUMLAB ;COUNT OF LABELED STATEMENTS
TRZ FL,CRDSN!ENDPRG ;ZERO FLAGS
TLO FL,FRSTOP ;FIRST OPERATION IN SUBROUTINE ON
PUSHJ P,PASS1 ;DO ALL OF PASS 1
TRNN FL,CRDSN ;TEST TO SEE IF THERE WAS A PROGRAM
POPJ P, ;NOPE, NOTHING THERE
CLOSE DSK1, ;CLOSE PASS1 TEMP FILE
STATZ DSK1,740000 ;CHECK CHANNEL STATUS
PUSHJ P,DDE ;LOSER STATUS
RELEAS DSK1, ;RELEAS CHANNEL
INIT DSK1,1 ;AND GET IT BACK FOR PASS2
SIXBIT /DSK/ ;DISK, MODE 1 USING CHANNEL DSK1
XWD 0,DK1BUF ;INPUT ONLY
PUSHJ P,NODSK ;THIS IS NOT SUPPOSED TO HAPPEN
MOVE A,DSKFF ;LOAD ADDRESS FOR BUFFERS
EXCH A,JOBFF ;NEW BUFFERS OVERLAY THE OLD
INBUF DSK1,2 ;GET SOME INPUT BUFFERS
MOVEM A,JOBFF ;RESTORE JOBFF TO IT'S FORMER VALUE
MOVE A,TMPNAM ;PREPARE A LOOKUP.
MOVSI B,'TMP' ;USING TMPNAM AND .TMP EXTENSION
SETZB C,D ;DEFAULT THE REST
LOOKUP DSK1,A ;SELECT FILE FOR INPUT
PUSHJ P,SFLU ;FAILED HORRIBLY
TRNN FL,FLOW ;CHECK FOR FLOWCHART
JRST WORK.2 ;NO FLOWCHART, SKIP THIS
INIT DSK2,1 ;GET DSK2 FOR OUTPUT OF TEMP2
SIXBIT /DSK/ ;DISK IN MODE 1
XWD DK2BUF,0 ;OUTPUT ONLY
PUSHJ P,NODSK ;THIS IS NOT SUPPOSED TO HAPPEN
MOVE A,FMTFF ;GET A PLACE FOR MY BUFFERS
EXCH A,JOBFF ;EXCHANGE WITH JOBFF
OUTBUF DSK2,2 ;ASK FOR SOME BUFFERS
MOVEM A,JOBFF ;RESTORE JOBFF
MOVE A,FMTNAM ;PREPARE AN ENTER, USE
MOVSI B,'TMP' ;FMTNAM AND TMP EXTENSION
SETZB C,D ;DEFAULT
ENTER DSK2,A ;SELECT OUTPUT FILE
PUSHJ P,SFLU ;FAILURE
WORK.2: LPCALL 3,ASCRFF ;OUTPUT TO GET A NEW PAGE
LPCALL 3,[ASCIZ/ REVISED PROGRAM
/] ;PRINT HEADING
SETZM SEQ ;ZERO STUFF FOR PASS2
SETZM LINUM ;LINE COUNT FOR CREF. SEQ IS SEQUENCE #
SETZM LASTNM ;LAST NUMBER WRITTEN IN CREF
SETZM SNSEEN ;STATEMENT LABELS SEEN
TRNN FL,CREF ;TEST FOR DOING CREF
JRST WORK.3 ;SKIP THE REST OF THIS KLUGE
MOVE A,NUMLAB ;NUMBER OF LABELED STATEMENTS
MOVE B,A ;COPY TO B
ADD A,TABSP ;ADD BASE OF TABLE TO NUMBER OF LABELS
;GIVING FIRST FREE LOCATION IN TABLE2
ADD B,A ;ADD TO B, MAKES FIRST FREE FOR CREF
MOVEM B,FREPTR ;SAVE AS FIRST FREE LOCATION FOR CREF
MOVEM B,CORREQ ;PARAMETER TO GETCOR
PUSHJ P,GETCOR ;GETCORE USES CORREQ AS A PARAMETER
SETZM (A) ;ZERO FIRST LOCATION OF TABLE2
HRL A,A ;COPY TO LEFT SIDE
AOS A ;READY FOR A BLT
BLT A,-1(B) ;ZERO ALL OF TABLE2
TRNN FL,FLOW ;SKIP IF FLOWCHARTING
JRST WORK.3 ;NO FLOWCHART
MOVE A,FREPTR ;GET THE FREE POINTER
MOVE B,NUMLAB ;NUMBER OF LABELS
ADD B,A ;MAKE NEW FIRST FREE LOCATION
MOVEM B,FREPTR ;SAVE IT
MOVEM B,CORREQ ;ASK FOR ENOUGH CORE
PUSHJ P,GETCOR ;...
SETZM (A) ;ZERO FOR TABLE3
HRL A,A ;MAKE A BLT POINTER
ADDI A,1 ;TABLE3,,TABLE3+1
BLT A,-1(B) ;ZERO ALL OF TABLE3
WORK.3: PUSHJ P,PASS2 ;DO ALL OF PASS2
CLOSE DSK1, ;CLOSE THE TEMPORARY FILE
SETZB A,B ;AND PREPARE TO DELETE
SETZB C,D ;BY RENAME UUO, SETTING
RENAME DSK1,A ;NAME TO 0
JFCL ;DON'T CARE IF IT FAILS
TRNE FL,CREF ;ARE WE GOING TO DO A CREF
PUSHJ P,DOCREF ;YES, DO ALL OF PASS 2.5
TRNE FL,FLOW ;ARE WE DOING A FLOWCHART?
PUSHJ P,DOFLOW ;DO ALL OF PASS3
LPCALL 3,ASCRLF ;PRINT CRLF
SKIPG A,ERRCNT ;DO WE HAVE ANY ERRORS
JRST WORK.4 ;NOPE
BCALL 3,[ASCIZ/?/] ;TYPE ON BOTH
PUSHJ P,DECPB ;TYPE # OF ERRORS ON BOTH
BCALL 3,[ASCIZ/ ERRORS DETECTED
/]
TRNE FL,FLOW ;WERE WE DOING A FLOWCHART?
BCALL 3,[ASCIZ/No flowchart because of errors
/]
JRST WORK.5
WORK.4: PUSH P,FL ;SAVE FLAG REGISTER
TRO FL,TTYF ;SUPPRESS TTY OUTPUT
BCALL 3,[ASCIZ/No source errors.
/] ;THE GOOD NEWS
POP P,FL ;RESTORE FLAGS
WORK.5: HRRZ A,JOBREL ;TYPE THE CORE NEEDED
ADDI A,1 ;GET CORESIZE AND ADD 1
LSH A,-12 ;SHIFT TO DIVIDE BY 1024
PUSH P,FL ;SAVE FLAGS AGAIN
TRO FL,TTYF ;SUPRESS TTY OUTPUT
PUSHJ P,DECPB ;WRITE CORE SIZE
BCALL 3,[ASCIZ/ K CORE USED
/] ;AND MESSAGE
POP P,FL ;RESTORE FLAGS
JRST WORKER ;CHECK FOR ANOTHER PROGRAM
SUBTTL CARD CONVERTS TO CARD IMAGES
CARD: TLZ FL,ILCS!ILFMT!SHORT!TRUNC ;START WITH CLEAR FLAGS
TRNE FL,EOFFLG ;HAVE WE SEEN EOF ALREADY?
JRST PAS1EF ;YES, RETURN BLANK LINES
TRO FL,TXTBUF ;ANNOUNCE THAT THERE IS TEXT IN BUFFER
SETZ COL, ;ZERO COLUMN COUNTER
MOVE Y,[POINT 7,LINEBX] ;TEXT FOR LPT ACCUMULATES IN LINEBX
MOVEM Y,LPTPTR ;SAVE AS ACCUMULATOR POINTER
MOVE Y,[POINT 7,TXLIN] ;TXLIN IS WHERE INTERNAL TEXT LIVES
CARD.1: PUSHJ P,GNCHS ;GET A CHARACTER
JRST PAS1EF ;END OF FILE
CARD.2: CAIG A,15 ;COMPARE AGAINST CR
JRST CARD.3 ;IT'S A SMALL CHARACTER
ADDI COL,1 ;INCREMENT COLUMN POSITION
PUSHJ P,TRUCTS ;TEST LINE OVERFLOW. PLUNK IF OK
JRST CARD.1 ;BACK FOR MORE
CARD.3: CAIN A,11 ;DO WE HAVE A TAB
JRST CARD.5 ;YES
CAIN A,15 ;CR IS IGNORED
JRST CARD.1 ;SO BACK TO CARD.1
CAIGE A,12 ;12,13,14 WILL STOP LINE
JRST CARD.4 ;ILLEGAL CHARACTER SEEN (1..10)
SKIPG COL ;SKIP IF LINE IS NOT EMPTY
IDPB A,Y ;EMPTY LINE, SAVE SPECIAL TERMINATOR
SETZ A, ;DEPOSIT ZERO TO TERMINATE LINE
IDPB A,Y ;DEPOSIT ..
IDPB A,LPTPTR ;ZERO FOR LPT LINE TOO
JUMPE COL,CARD10 ;SHORT STATEMENT
CAILE COL,5 ;NO FORTRAN STATEMENT IS THIS SHORT
POPJ P, ;STATEMENT IS OK
LDB A,[POINT 7,TXLIN,6] ;LOAD FIRST CHARACTER OF STATEMENT
PUSHJ P,CMNTST ;IS IT A COMMENT?
POPJ P, ;YES, RETURN OK.
JUMPE A,CARD10 ;SHORT LINE
MOVE A,ASC5SP ;FIVE BLANKS
ANDCA A,TXLIN ;AND COMPLEMENT OF BLANKS WITH
JUMPE A,CARD12 ;NOTHING BUT SOME BLANKS. PASS AS BARE LF
TLO FL,ILFMT ;ILLEGAL LINE FORMAT
JRST CARD11 ;BLANK THE LINE AND RETURN
CARD.4: TLO FL,ILCS ;SET ILLEGAL CHARACTER FLAG
JRST CARD.1 ;IGNORE THE CHARACTER
CARD.5: ADDI COL,1 ;TAB HAS JUST BEEN SEEN
CAILE COL,6 ;SPECIAL TREATMENT IN COLS 1-6
JRST CARD.8 ;TAB IN COLS 7-72
CAIN COL,1 ;EXTRA SPECIAL FOR COLUMN 1
JRST CARD.6 ;FOR TAB IN COLUMN 1
LDB A,[POINT 7,TXLIN,6] ;GET FIRST COLUMN
PUSHJ P,CMNTST ;IS IT A COMMENT
JRST CARD.8 ;YES. WE HAVE A TAB IN COMMENT
MOVEI A," " ;SPACES OUT TO COLUMN 7
IDPB A,Y ;IN A DEPOSIT LOOP
CAIGE COL,6 ;CHECK COLUMN SPACING
AOJA COL,.-2 ;INCREMENT COLUMN AND GO BACK
JRST CARD.1 ;BACK FOR THE REST OF THE LINE
CARD.6: PUSHJ P,GNCHS ;PEEK AT NEXT CHARACTER
JRST PAS1EF ;THIS IS A FUNNY PLACE FOR EOF
MOVEI COL,6 ;WE'LL WIND UP FILLING COLUMN 6
MOVE B,ASC5SP ;LOAD WITH 5 SPACES
MOVEM B,TXLIN ;SAVE IN TXLIN
CAIL A,"1" ;SKIP IF TOO SMALL
CAILE A,"9" ;SKIP IF IT'S A DIGIT
JRST CARD.7 ;NOT A CONTINUATION
ADDI Y,1 ;PUSH BYTE POINTER
IDPB A,Y ;IN COLUMN 6.
JRST CARD.1 ;OFF TO GET MORE
CARD.7: MOVEM B,TXLIN+1 ;AND COLUMN 6 (ALSO 7-10)
MOVE Y,[POINT 7,TXLIN+1,6] ;PUSH Y TO COLUMN 6
JRST CARD.2 ;GO BACK DO THE HONEST THING
CARD.8: MOVEI B,-1(COL) ;LOAD COL-1 INTO B
TRO B,7 ;MAKE INTO A MULTIPLE OF 8,-1
ADDI B,1 ;MAKE INTO A MULTIPLE OF 8
TRNN FL,TABSW ;ARE WE leaving TABS ALONE?
JRST CARD.9 ;NO CHANGE TO SPACES
MOVE COL,B ;REPLACE COL BY B
MOVEI A,11 ;AND PLUNK A TAB
PUSHJ P,TRUCTS ;TEST FOR LINE OVERFLOW. DEPOSIT IF OK
JRST CARD.1 ;BACK AND DO MORE
CARD.9: MOVEI A," " ;LOAD A WITH A BLANK
PUSHJ P,TRUCTS ;TEST FOR LINE OVERFLOW. DEPOSIT IF OK
CAMGE COL,B ;COMPARE TO SEE IF WE FILLED ENOUGH
AOJA COL,.-2 ;LOOP BACK AND DEPOSIT BLANKS
JRST CARD.1 ;BACK FOR ANOTHER CHARACTER
CARD12: MOVSI A,(<BYTE(7)12>) ;PASS A SHORT LINE AS A LF
MOVEM A,TXLIN ;TO AVOID LATER CONFUSION.
CARD10: TLO FL,SHORT ;TURN ON SHORT FLAG
POPJ P, ;AND RETURN
PAS1EF: TRO FL,EOFFLG ;TURN ON EOF FLAG
TRZ FL,TXTBUF ;SAY THAT BUFFER IS EMPTY
SETZM LINEBX ;EMPTY LPT LINE
CARD11: MOVE B,ASC5SP ;MAKE BUFFER CONTAIN
MOVEM B,TXLIN ;TEN SPACES
MOVEM B,TXLIN+1 ;...
SETZM TXLIN+2 ;AND A NULL
POPJ P, ;BACK TO PASS1
TRUCTS: CAILE COL,110 ;ARE WE IN BOUNDS?
JRST TRUCT1 ;NO
IDPB A,Y ;PLUNK CHARACTER IN LINE
POPJ P, ;RETURN
TRUCT1: CAIE A," " ;NOT SET OVERFLOW IF ONLY BLANK
CAIN A,11 ;NOT SET OVERFLOW IF ONLY A TAB
POPJ P, ;RETURN
TLO FL,TRUNC ;SET LINE TRUNCATION FLAG
POPJ P, ;RETURN
;TEST IF THIS IS A COMMENT. SKIPS IF NOT. C,D,$,*, AND / DENOTE COMMENT.
CMNTST: CAIE A,"C"
CAIN A,"D"
POPJ P,
CAIE A,"C"+40
CAIN A,"D"+40
POPJ P,
CAIE A,"/"
CAIN A,"*"
POPJ P,
CAIE A,"$"
CAIN A,"!"
POPJ P,
AOS (P)
POPJ P,
SUBTTL PASS1
PASS1: TRNN FL,TXTBUF!EOFFLG ;LOAD LINE UNLESS EOF OR TEXT THERE NOW
PUSHJ P,CARD ;LOAD A CARD IMAGE INTO TXLIN
TRNE FL,EOFFLG ;EOF?
JRST ENDFIL ;YES, DO EOF THING
TLNN FL,FRSTOP ;IF FIRST OP, THEN DO HEADER
JRST PSS1.0 ;NOT FIRST OP.
TLNE FL,SHORT!ILFMT ;TEST LINE FOR VALIDITY
JRST PSS1.1 ;INVALID, SKIP HEADING AND DON'T PRINT
TLZ FL,FRSTOP ;SHUT OFF FIRST OP FLAG
LPCALL 3,ASCRFF ;CR-FF
LPCALL 3,[ASCIZ/ ORIGINAL PROGRAM
/] ;THE HEADING
PSS1.0: PUSHJ P,PRNTBF ;ALSO PRINT BUFFER
JRST PASS1 ;ILLEGAL LINE FORMAT
PSS1.1: SETZM CONTS ;ZERO COUNT OF CONTINUATIONS
TLZE FL,SHORT ;DO WE HAVE A SHORT LINE?
JRST PS1.14 ;YES. FLUSH IT QUICK
TRO FL,CRDSN ;ANNOUNCE THAT HONEST CARD IS SEEN
PSS1.2: MOVE Y,[POINT 7,TXLIN] ;LOAD UP A BYTE POINTER TO THE LINE
ILDB A,Y ;LOAD A CHARACTER
PUSHJ P,CMNTST ;IS IT A COMMENT?
JRST PS1.14 ;YES. QUICK FLUSH
AOS Y ;NOW POINT TO COLUMN 6
LDB A,Y ;COLUMN 6 IN A.
CAIE A," " ;IS IT BLANK
CAIN A,"0" ;OR "0"
JRST PSS1.3 ;YES, NOT A CONTINUATION CARD
MESS 3,LINEBX ;WRITE LINE UNLESS TTY=LIST DEV
BCALL 3,[ASCIZ/
ERROR ILLEGAL CONTINUATION CARD
/]
AOS ERRCNT ;COUNT AS AN ERROR
JRST PS1.14 ;FLUSH IT
PSS1.3: MOVE X,ASC5SP ;PICKUP 5 BLANKS
CAMN X,TXLIN ;COMPARE TO COLS 1-5
JRST PSS1.8 ;YES THEY ARE
SETZ B, ;LOOKING FOR A STATEMENT LABEL
MOVEI W,4 ;INITIALIZE COUNT
MOVE Y,[POINT 7,TXLIN] ;SETUP TO PICKUP TEXT
PSS1.4: ILDB A,Y ;LOAD CHARACTER
CAIN A," " ;IGNORE BLANKS
JRST PSS1.5 ;BY SKIPPING THIS KLUGE
CAIL A,"0" ;SKIP IF TOO SMALL FOR A DIGIT
CAILE A,"9" ;SKIP IF AN OK DIGIT
JRST PS1.7A ;GO COMPLAIN
IMULI B,12 ;MULTIPLY THE ACCUMULATOR
ADDI B,-"0"(A) ;ADD IN THE NEW CHARACTER
PSS1.5: SOJGE W,PSS1.4 ;DECREMENT COUNT AND GET MORE
MOVE C,NUMLAB ;LOAD LABEL COUNT
MOVEI D,TXLIN ;ADDRESS OF BUFFER
PUSHJ P,LABDEF ;COMMON FOR THIS AND RDFMTS
JFCL ;IGNORE ERROR RETURN
JRST PSS1.8 ;JUMP AROUND NEXT
PS1.7A: PUSHJ P,ERMSG2 ;WRITE ERROR MESSAGE
PSS1.8: MOVE Y,[POINT 7,TXLIN] ;LOAD POINTER TO THE LINE
MOVE Z,[POINT 7,IBUF] ;AND POINTER TO LINE BUFFER
PS1.10: ILDB A,Y ;COPY FROM Y
IDPB A,Z ;TO Z
JUMPN A,.-2 ;AND REPEAT UNTIL NULL FOUND
MOVEM Z,SAVEZ ;SAVE END OF LINE POINTER
PUSHJ P,CARD ;GET A NEW LINE INTO TXLIN
LDB A,[POINT 7,TXLIN,6] ;LOAD COLUMN 1
TLNN FL,SHORT ;FLUSH SHORT LINES QUICK.
PUSHJ P,CMNTST ;CHECK FOR A COMMENT
JRST PS1.11 ;YES. IT IS A COMMENT
LDB A,[POINT 7,TXLIN+1,6] ;LOAD CONTINUATION COLUMN
CAIE A," " ;IS IT BLANK?
CAIN A,"0" ;OR "0"
JRST PS1.11 ;YES, PROCESS CONTENTS OF IBUF
PUSHJ P,PRNTBF ;PRINT LINE
JRST PASS1 ;LINE WAS ILLEGAL
MOVE X,ASC5SP ;LOAD 5 BLANKS
CAME X,TXLIN ;COMPARE TO COLS 1-5
PUSHJ P,ERMSG2 ;CONTINUATION SET, BUT NOT BLANK
AOS A,CONTS ;INCREMENT COUNT OF CONTINUATIONS
CAILE A,CONTMX ;COMPARE TO MAXIMUM
JRST CONTSR ;TOO MANY CONTINUATIONS
MOVE Y,[POINT 7,TXLIN+1,6] ;LOAD POINTER TO LINE
MOVE Z,SAVEZ ;LOAD POINTER TO END OF LINE
MOVEI A,1 ;MARK THE CONTINUATION LINE WITH ^A
DPB A,Z ;DEPOSITED AT BREAK IN TEXT
JRST PS1.10 ;APPEND TO PRESENT IBUF
PS1.11: MOVE Y,[POINT 7,IBUF+1,6] ;TO PICKUP COLUMN 7
SKIPN NAME ;HAVE WE GOT A NAME YET?
PUSHJ P,GETNAM ;DEFINE A NAME FOR THIS PROGRAM
PUSHJ P,LSCAN ;DEFINE THE VALUE OF KEY
JRST .+2 ;NORMAL
JRST PASS1 ;FORMATS WITH SPECIAL TREATMENT
SKIPL KEY ;IF KEY=-1 THEN END STATEMENT
JRST PS1.12 ;WE ARE OK
TRNE FL,FORMAT ;IF WE ARE DOING FORMATS
PUSHJ P,RDFMTS ;THEN IT'S TIME TO READ THEM IN
PS1.12: MOVE A,KEY ;LOAD A WITH KEY
MOVE Y,[POINT 7,IBUF] ;AND Y WITH TEXT POINTER
PUSHJ P,WRTTMP ;WRITE ON TEMP1
TRNE FL,ENDPRG ;IS ENDPRG UP?
POPJ P, ;YES, RETURN. END OF PASS 1
TLZN FL,SHORT ;IS IT A SHORT LINE?
JRST PASS1 ;NO, BACK FOR MORE
LPCALL 3,LINEBX ;WRITE LINE
PS1.14: SETZ A, ;SET A TO ZERO, AS STATEMENT KEY
TRZ FL,TXTBUF ;SHUT OFF TEXT IN BUFFER FLAG
MOVE Y,[POINT 7,TXLIN] ;LOAD POINTER TO THE LINE
PUSHJ P,WRTTMP ;OFF AND WRITE IT IN TEMP1
JRST PASS1 ;BACK FOR MORE
ENDFIL: TRNN FL,CRDSN ;IF A REAL CARD SEEN, THEN NO END STMT
POPJ P, ;END OF ALL DATA
BCALL 3,[ASCIZ/
WARNING: NO END STATEMENT. END STATEMENT INSERTED.
/] ;WRITE NASTY MESSAGE
MOVE B,ASC5SP ;LOAD 5 SPACES
MOVEM B,TXLIN ;FOR COLS 1-5
MOVE B,[ASCII/ END/] ;SPACE-E-N-D-NULL
MOVEM B,TXLIN+1 ;COLS 6-7-8-9. 10 IS NULL
TRO FL,TXTBUF ;FLAG TEXT IN BUFFER
JRST PSS1.2 ;FORCE IT TO BE SCANNED
LABDEF: IMUL C,SNO ;COMPUTE NEW LABEL VALUE
ADD C,FNO ;ADD IN LABEL BASE
SKIPG SNO ;SKIP IF WE'RE RELABELING
MOVE C,B ;NOT RELABELING
AOS W,NUMLAB ;INCREMENT AND LOAD LABEL COUNT
ADD W,TABSP ;ADD BASE OF THE TABLE
MOVEM W,CORREQ ;SAVE AS REQUEST FOR CORE
PUSHJ P,GETCOR ;CHECK CORE LIMITS
HRLM B,-1(W) ;SAVE OLD LABEL
HRRM C,-1(W) ;SAVE NEW LABEL
SUBI W,2 ;POINT TO NEXT TO LAST ENTRY
LABDF1: CAMGE W,TABSP ;COMPARE TO TABLE BOTTOM
JRST CPOPJ1 ;NO MORE TABLE. SUCCESS
HLRZ A,0(W) ;LOAD LABEL VALUE FROM TABLE
CAME A,B ;COMPARE WITH THIS VALUE
SOJA W,LABDF1 ;WE ARE OK. DECREMENT W AND TRY ANOTHER
BCALL 3,(D) ;WRITE OFFENDING LINE
BCALL 3,[ASCIZ/
ERROR MULTIPLY DEFINED LABEL: /] ;WRITE ERROR MESSAGE
PUSHJ P,DECPB ;WRITE LABEL NUMBER
BCALL 3,ASCRLF ;END OF LINE
AOS ERRCNT ;COUNT AN ERROR
SOS NUMLAB ;TAKE BACK COUNT OF LABEL
MOVE A,ASC5SP ;LOAD 5 BLANKS
MOVEM A,(D) ;BLANK LABEL FIELD (COLS 1-5)
POPJ P, ;RETURN TO CALLER
SUBTTL PRNTBF AND GETCOR
PRNTBF: LPCALL 3,LINEBX ;WRITE LINE
TLNE FL,TRUSUP ;SUPPRESS LINE TRUNCATION MESSAGE?
TLZ FL,TRUNC ;YES, SET FLAG TO ZERO
TLNN FL,ILCS!ILFMT!TRUNC ;TEST FLAGS
JRST CPOPJ1 ;RETURN OK
MESS 3,LINEBX ;WRITE LINE ON TTY TOO
TLZE FL,ILCS ;ILLEGAL CHARACTER IN LINE?
BCALL 3,[ASCIZ/
ILLEGAL CHARACTER(S) IN LINE HAVE BEEN DELETED
/] ;WRITE MESSAGE
TLZE FL,TRUNC ;DID WE HAVE TO TRUNCATE LINE?
BCALL 3,[ASCIZ/
LINE HAS BEEN TRUNCATED TO 72 COLUMNS
/] ;WRITE MESSAGE
TLZN FL,ILFMT ;ILLEGAL FORMAT?
JRST CPOPJ1 ;NOPE, RETURN
BCALL 3,[ASCIZ/
ERROR ILLEGAL LINE FORMAT. LINE DELETED.
/] ;EVIL EVIL
AOS ERRCNT ;INCREMENT ERROR
TRZ FL,TXTBUF ;NO TEXT IN BUFFER
POPJ P, ;EVIL RETURN
GETCOR: PUSH P,A ;SAVE REGISTER
MOVE A,CORREQ ;GET DESIRED CORE SIZE
TRO A,1777 ;ROUND UP TO NEAREST BOUNDARY
CAMG A,JOBREL ;COMPARE TO OUR PRESENT LIMIT
JRST GCOR1 ;WE ARE SAFE
CORE A, ;WE ASK FOR MORE
PUSHJ P,COREX. ;CORE EXCEEDED
GCOR1: POP P,A ;RESTORE A
POPJ P, ;RETURN TO CALLER
SUBTTL STUFF TO READ THE FORMATS BACK IN
RDFMTS: CLOSE DSK2, ;CLOSE FORMAT FILE
STATZ DSK2,740000 ;CHECK OUTPUT STATUS
PUSHJ P,DDE ;LOSER STATUS
RELEAS DSK2, ;GIVE UP CHANNEL
INIT DSK2,1 ;BUT GET IT BACK
SIXBIT /DSK/ ;DISK IN MODE 1 ON CHANNEL DSK2
XWD 0,DK2BUF ;INPUT ONLY
PUSHJ P,NODSK ;THIS CAN'T HAPPEN, IT SAYS
MOVE A,FMTFF ;ADDRESS OF DSK2 BUFFERS
EXCH A,JOBFF ;SWAP WITH JOBFF
INBUF DSK2,2 ;AND ASK SYSTEM FOR BUFFERS
MOVEM A,JOBFF ;RESTORE JOBFF
MOVE A,FMTNAM ;LOAD FILE NAME
MOVSI B,'TMP' ;AND EXTENSION
SETZB C,D ;DEFAULT PPN
LOOKUP DSK2,A ;SELECT FILE FOR INPUT
PUSHJ P,SFLU ;IT'S NOT THERE, I GIVE UP
MOVE B,SNO ;LOAD STATEMENT INCREMENT
IMUL B,NUMLAB ;TIMES (NUMBER OF LABELS)-1
ADD B,FNO ;MAKES THE NEXT AVAILABLE LABEL NUMBER
CAMGE B,FMTFNO ;COMPARE TO DESIRED FIRST LABEL
MOVE B,FMTFNO ;FIRST FORMAT LABEL IS BIGGER
MOVEM B,FNO ;SAVE AS FIRST LABEL FOR FORMATS
SETOM FMTCNT ;COUNT OF FORMATS PROCESSED (SET TO -1)
RDFMT1: PUSHJ P,RDFMTL ;LOAD LINE INTO OBUF
JRST EOFFMT ;END OF FILE
MOVE A,OBUF ;LOAD COLUMNS 1-5
CAMN A,ASC5SP ;DO WE HAVE 5 SPACES?
JRST RDFMT5 ;NOPE. DUMP LINE.
SETZ B, ;ACCUMULATE NUMBER HERE
MOVEI W,4 ;COLUMN COUNT
MOVE Y,[POINT 7,OBUF] ;POINTER TO LINE
RDFMT2: ILDB A,Y ;GRAB CHARACTER
CAIN A," " ;BLANK?
JRST RDFMT3 ;YES, SKIP THIS
IMULI B,12 ;MULTIPLY LABEL ACCUMULATOR
ADDI B,-"0"(A) ;SUPPOSED TO BE VALID DIGIT
RDFMT3: SOJGE W,RDFMT2 ;DECREMENT AND BACK IF NEED MORE
AOS C,FMTCNT ;INCREMENT AND LOAD FORMAT COUNT
MOVEI D,OBUF ;ADDRESS OF BUFFER
PUSHJ P,LABDEF ;LABEL DEFINITION ROUTINE
SOS FMTCNT ;DECREMENT DUE TO LOSSAGE
RDFMT5: MOVEI A,"@"+16 ;LOAD KEY TO FORMAT STATEMENT
PUSHJ P,PUTDK1 ;WRITE ON TEMP 1
MOVE Y,[POINT 7,OBUF] ;LOAD BYTE POINTER
RDFMT6: ILDB A,Y ;LOAD FROM LINE
JUMPE A,RDFMT1 ;END OF THIS LINE
PUSHJ P,PUTDK1 ;WRITE ON TEMP 1
JRST RDFMT6 ;BACK FOR MORE
EOFFMT: CLOSE DSK2, ;FINISHED WITH FORMAT FILE
SETZB A,B ;LOAD 4 WORDS WITH
SETZB C,D ;ZEROS FOR A RENAME
RENAME DSK2,A ;THAT DELETES THE
JFCL ;FORMAT FILE
RELEAS DSK2, ;GIVE UP CHANNEL
POPJ P, ;RETURN TO THE WORLD
RDFMTL: MOVE Y,[POINT 7,OBUF] ;LOADING LINE INTO OBUF
RDFTL1: PUSHJ P,GETDK2 ;GET CHARACTER FROM DISK 2
POPJ P, ;END OF FILE
IDPB A,Y ;SAVE CHARACTER
CAIE A,12 ;END OF LINE?
JRST RDFTL1 ;NOPE. GET MORE
SETZ A, ;YES. DEPOSIT
IDPB A,Y ;NULL
JRST CPOPJ1 ;AND SKIP RETURN
SUBTTL SOME ERROR ROUTINES
ILC: TTCALL 3,[ASCIZ/COMMAND ERROR
/] ;COMMAND LINE IN IMPROPER FORMAT
PUSHJ P,FLUTTY ;FLUSH LINE TO LINE FEED
JRST FINISH ;RELEASE ANY IO DEVICES
DIE: BCALL 3,[ASCIZ/DEVICE INPUT ERROR
/] ;A STATZ DETECTED ERROR BITS
HALT CPOPJ ;WAIT HERE, FOREVER
NOLOK.: TTCALL 3,[ASCIZ/LOOKUP FAILED ON: /]
PUSHJ P,TYFNAM ;TYPE THE FILE NAME
JRST FINISH ;GO CLOSE THE WORLD
NOENT.: TTCALL 3,[ASCIZ/ENTER FAILED ON: /]
PUSHJ P,TYFNAM ;TYPE NAME
JRST FINISH ;BACK AND CLOSE WORLD
TYFNAM: MOVE X,A ;NAME IN A
PUSHJ P,SIXOUT ;TYPE NAME
HLLZ X,B ;EXTENSION IN B
JUMPE X,TYFNNN ;NO EXTENSION
TTCALL 3,[ASCIZ/./] ;WRITE DOT
PUSHJ P,SIXOUT ;AND EXTENSION
TYFNNN: TTCALL 3,ASCRLF ;WRITE RETURN,LINEFEED
POPJ P, ;RETURN TO CALLER
NODEV.: TTCALL 3,[ASCIZ/DEVICE UNAVAILABLE: /] ;OPEN UUO FAILED
MOVE X,B ;DEVICE NAME
PUSHJ P,SIXOUT ;WRITE IT
PUSHJ P,FLUTTY ;FLUSH THIS COMMAND LINE
JRST FINISH ;GO CLOSE ALL IO
SIXOUT: MOVE W,[POINT 6,X] ;THE SIXBIT OUTPUT ROUTINE
ILDB Y,W ;QUITE TRIVIAL
JUMPE Y,CPOPJ ;END OF STUFF
ADDI Y," " ;MAKE IT ASCII
TTCALL 1,Y ;AND TYPE IT
TLNN W,770000 ;END OF WORD YET?
POPJ P, ;YES (BYTE POSITION = 0)
JRST SIXOUT+1 ;BACK FOR MORE
NODSK: BCALL 3,[ASCIZ/DSK INIT LOST!
/] ;ONLY TO THE WORST OF LOSERS
EXIT ;END IT ALL
NOTTY: TTCALL 3,[ASCIZ/CAN'T INIT TTY!
/] ;HOW THE HELL CAN THIS HAPPEN?
EXIT ;GO AWAY
DDE: BCALL 3,[ASCIZ/OUTPUT ERROR.
/] ;STATZ ON OUTPUT SHOWS ERROR BITS UP
HALT CPOPJ ;STOP THE WORLD
SFLU: BCALL 3,[ASCIZ/CAN'T FIND OR ENTER MY SCRATCH FILE!
/] ;I DON'T KNOW WHY
HALT CPOPJ ;SO HALT
ERMSG2: MESS 3,LINEBX ;WRITE OFFENSIVE LINE
BCALL 3,[ASCIZ/ ILLEGAL CHARACTERS IN COLUMNS 1-5
/] ;AND MESSAGE
AOS ERRCNT ;COUNT AN ERROR
MOVEM X,TXLIN ;X IS ASSUMED TO HAVE ASC5SP
POPJ P, ;RETURN TO LOSER
UEOF: BCALL 3,[ASCIZ/UNEXPECTED EOF ON SCRATCH FILE!
/] ;INTERNAL CONFUSION
HALT CPOPJ ;I CANT FIGURE OUT WHAT TO DO
LINC.L: BCALL 3,[ASCIZ/RELABELING INCREMENT TOO BIG. TRY A SMALLER INCREMENT
/] ;I GIVE UP
JRST FINISH ;GO FINISH ALL IO
CONTSR: BCALL 3,[ASCIZ/TOO MANY CONTINUATION CARDS.
/] ;MAXIMUM IS 20
EXIT ;GO AWAY
INTCFN: BCALL 3,[ASCIZ/Internal/]
INTCF1: BCALL 3,[ASCIZ/ Confusion: called from user location: /]
PUSH P,A ;SAVE ON STACK
PUSH P,B ;SAVE ON STACK
HRRZ A,-2(P) ;PICK UP THE ADDRESS OF THE CALL
SUBI A,1 ;DECREMENT TO GET ACTUAL ADDRESS
PUSHJ P,OCTPTR ;WRITE AS OCTAL
BCALL 3,[ASCIZ/
Notify a systems programmer.
/]
POP P,B ;RESTORE
POP P,A ;RESTORE
TRNE FL,TTYF ;LISTING ON TTY?
CLOSE LPT, ;YES. FLUSH DATA BEFORE MESSAGE
HALT CPOPJ ;AT HIS OWN RISK, HE MAY CONTINUE
OCTPTR: IDIVI A,10 ;ORDINARY RADIX 8 PRINTER
PUSH P,B ;STACK REMAINDER
SKIPE A ;SKIP IF THAT'S THE LAST DIGIT
PUSHJ P,OCTPTR ;CALL SELF RECURSIVELY
POP P,A ;LOAD A FROM STACK
ADDI A,"0" ;MAKE IT A DIGIT
BCALL 1,A
POPJ P, ;RETURN
DECPB: IDIVI A,12 ;DECIMAL PRINT ON BOTH
PUSH P,B ;SAVE REMAINDER
SKIPE A ;HAVE WE ENOUGH?
PUSHJ P,DECPB ;NO, CALL SELF, RECURSIVELY
POP P,A ;POP DIGIT INTO A
ADDI A,"0" ;MAKE IT ASCII
BCALL 1,A ;WRITE ON BOTH
POPJ P, ;RETURN ONE LEVEL
COREX.: BCALL 3,[ASCIZ/CORE EXCEEDED
/] ;ANNOUNCE FAILURE
HALT CPOPJ ;QUIT
SUBTTL SOURCE INPUT, TEMP1 AND TEMP2 OUTPUTS FOR PASS1.
GNCHS: PUSHJ P,GETCDR ;GET A CHARACTER FROM SOURCE FILE
POPJ P, ;NO MORE LEFT
IDPB A,LPTPTR ;SAVE FOR PRINTING LATER
MOVE X,@CDRBUF+1 ;SEE IF WE HAVE SEQUENCE NUMBER
TRNN X,1 ;TEST SEQUENCE NUMBER BIT
JRST GNCHS1 ;NO PROBLEM
MOVEI X,5 ;WE WILL SKIP NEXT FIVE AND PASS
GNCHS0: PUSHJ P,GETCDR ;THE SIXTH ALONG
POPJ P, ;EMBARASSING TIME FOR EOF
IDPB A,LPTPTR ;SAVE FOR LPT
SOJGE X,GNCHS0 ;BACK, SKIPPING CHARACTERS
GNCHS1: TRNN FL,KEYS ;SEE IF KEYPUNCH CONVERSION REQUIRED
JRST CPOPJ1 ;NO CONVERSION DESIRED
CAILE A," " ;SKIP SMALLER THAN A BLANK
CAIL A,"A" ;SKIP IF SMALLER THAN A LETTER
JRST CPOPJ1 ;QUICK RETURN FOR MOST CHARACTERS
CAIL A,"0" ;SKIP IF TOO SMALL FOR A DIGIT
CAILE A,"9" ;SKIP IF IT'S A DIGIT
JRST .+2 ;CHECK FOR POSSIBLE CONVERSION
JRST CPOPJ1 ;QUICK RETURN FOR DIGITS.
CAIN A,"<" ;CONVERT < TO )
MOVEI A,")" ;BY A VERY SIMPLE SCHEME
CAIN A,"@" ;@ CONVERTS TO
MOVEI A,"'" ; APOSTROPHE
CAIN A,"#" ; # (SHARP) CONVERTS TO =
MOVEI A,"="
CAIN A,"%" ;% CONVERTS TO (
MOVEI A,"("
CAIN A,"&" ;AND AMPERSAND TO +
MOVEI A,"+"
JRST CPOPJ1 ;RETURN AFTER HAVING DONE CONVERSION
; WRTTMP WILL WRITE A WHOLE LINE INTO TEMP1. FIRST CHARACTER IS A KEY
;USE BYTE POINTER IN Y. SOME CHARACTER <15 (BUT NOT 1 OR 11) WILL
;TERMINATE LINE. NULL-->CRLF, OTHER CHARACTERS, LIKE 14 GO TO 15,<CHAR>
WRTTMP: ADDI A,"@" ;A CONTAINS KEY. MAKE IT PRINTABLE
PUSHJ P,PUTDK1 ;WRITE ON TEMP1
WRTTM1: ILDB A,Y ;LOAD A FROM THE LINE THAT Y POINTS TO
CAILE A,14 ;SPECIAL TEST IF 14
JRST WRTTIT ;UNSPECIAL
CAIE A,1 ;1 MARKS A CONTINUATION PLACE
CAIN A,11 ;11 IS JUST A TAB
JRST WRTTIT ;SO THEY GO OUT AS NORMAL
PUSH P,A ;SPECIAL. SAVE THE CHARACTER
MOVEI A,15 ;LOAD A CR
PUSHJ P,PUTDK1 ;AND WRITE IT
POP P,A ;RESTORE THE CHARACTER
SKIPG A ;SKIP UNLESS A NULL
MOVEI A,12 ;NULL REPLACE BY LINE FEED
PUSHJ P,PUTDK1 ;WRITE IT
POPJ P, ;AND RETURN TO CALLER
WRTTIT: PUSHJ P,PUTDK1 ;WRITE UNSPECIAL CHARACTER
JRST WRTTM1 ;GO BACK FOR MORE
;WRTFMT WILL WRITE A FORMAT STATEMENT INTO TEMP2. TERMINATED BY A
;NULL, THE FORMAT STATEMENT IS POINTED TO BY B. CRLF IS APPENDED.
WRTFMT: ILDB A,B ;LOAD FROM B
JUMPE A,WRTFM1 ;END OF STATEMENT
PUSHJ P,PUTDK2 ;DEPOSIT IN TEMP2
JRST WRTFMT ;BACK FOR MORE
WRTFM1: MOVEI A,15 ;LOAD CR
PUSHJ P,PUTDK2 ;AND WRITE
MOVEI A,12 ;AND LF
PUSHJ P,PUTDK2 ;AND WRITE
POPJ P, ;RETURN
SUBTTL PASS 1 LINE SCAN ROUTINES
NXTCHR: LDB A,Y ;LOAD LAST CHARACTER
JUMPE A,CPOPJ ;IF NULL THE END OF LINE
NXTCH1: ILDB A,Y ;LOAD NEXT CHARACTER
CAIE A," " ;DON'T REPORT BLANKS
CAIN A,11 ;OR TABS
JRST NXTCH1 ;BACK AND GET NEXT
CAIN A,1 ;IS THIS OUR SPECIAL CONTINUATION MARK?
JRST NXTCH1 ;YES. DON'T REPORT IT!
CAIL A,"A"+40 ;CHECK FOR LOWER CASE LETTERS
CAILE A,"Z"+40 ;SKIP IF LOWER CASE
POPJ P, ;RETURN
TRZ A,40 ;MAKE IT UPPER CASE
POPJ P, ;IN CASE THEY CHANGE FORTRAN TOMORROW
MATCHS: ILDB C,B ;STRING MATCH. C GETS NEXT TO MATCH
JUMPE C,CPOPJ1 ;END OF STRING TO MATCH. SUCCESS
PUSHJ P,NXTCHR ;GRAB NEXT CHARACTER
CAMN A,C ;COMPARE SOURCE AND STRING-TO-MATCH
JRST MATCHS ;OK
POPJ P, ;DIFFERENT, NON-SKIP RETURN
NSEPX: PUSHJ P,NXTCHR ;IS NEXT CHARACTER A SEPARATOR
JUMPE A,CPOPJ ;SEPARATOR
CAIE A,"=" ;SEPARATOR
CAIN A,"(" ;ALSO SEPARATOR
POPJ P, ;NON SKIP FOR SEPARATORS
JRST CPOPJ1 ;SKIP RETURN
SCANEQ: PUSHJ P,NXTCHR ;SCAN THE REST FOR = SIGN. SKIP IF
JUMPE A,CPOPJ1 ;NONE FOUND
CAIE A,"=" ;LOOK FOR =
JRST SCANEQ ;OK, CONTINUE SCAN
POPJ P, ;= WAS FOUND
SUBTTL STATEMENT CLASSIFICATION ROUTINES
LSCAN: SETZM PARCT ;INITIALIZE VALUE OF parenthesis COUNT
MOVEM Y,TSAVE ;ANOTHER LONESOME CELL
PUSHJ P,NXTCHR ;GET THE FIRST CHARACTER
CAIL A,"A" ;COMPARE AGAINST SMALLEST LETTER
CAILE A,"W" ;SKIP IF IT'S AN IMPORTANT LETTER
JRST LSCAN1 ;NOT A LETTER
PUSHJ P,@LSTAB-"A"(A) ;DISPATCH TO LINE ANALYSIS
LSCAN1: SETZ A, ;NOT RECOGNIZED
MOVEM A,KEY ;SAVE AS VALUE OF KEY
POPJ P, ;RETURN
COMMENT/
NOTE THAT IF A FORMAT STATEMENT IS SEEN AND FORMAT FLAG IS SET THEN
THIS GUY (LSCAN) WILL DO A SKIP RETURN DUE TO VERY CRUFTY CODE AT FLSC1
/
LSTAB: ALSC ;ACCEPT, ASSIGN
CPOPJ ;B
CLSC ;CALL EXIT == STOP FOR FLOWCHART
;ALSO CALL (VERSION 4)
DLSC ;DO, DECODE
ELSC ;END, ENCODE
FLSC ;FORMAT (/F AND FLOWCHART)
GLSC ;GOTO
CPOPJ ;H
ILSC ;IF
CPOPJ ;J
CPOPJ ;K
CPOPJ ;L
CPOPJ ;M
CPOPJ ;N
CPOPJ ;O
PLSC ;PRINT, PUNCH
CPOPJ ;Q
RLSC ;READ, REREAD
SLSC ;STOP
TLSC ;TYPE
CPOPJ ;U
CPOPJ ;V
WLSC ;WRITE
COMMENT/
NOTE THAT X,Y,Z ARE NOT IN TABLE.
NO IMPORTANT FORTRAN KEYWORD USES THESE LETTERS.
IF THEY ARE ADDED TO THE TABLE, YOU MUST CHANGE THE LINE
CAILE A,"W" TO CAILE A,"Z"
/
SUBTTL LINE SCAN STATEMENT ANALYSIS
ALSC: PUSHJ P,NXTCHR ;"A" SEEN. GET NEXT CHARACTER
CAIN A,"S" ;HAVE WE GOT "AS"?
JRST ASLSC ;YES, MAYBE "ASSIGN"
CAIE A,"C" ;HAVE WE GOT "AC"?
POPJ P, ;NOPE. RETURN
MATCH [ASCII/CEPT/] ;SEARCH FOR TEXT
POPJ P, ;SEARCH FAILS
MOVEI Z,1 ;
;ACCEPT PRINT PUNCH REREAD TYPE
ALSC1: PUSHJ P,NXTCHR ;GET NEXT
CAIN A,","
JRST ALSC2 ;"ACCEPT ," IS ILLEGAL
JRST .+2
ALSC4: PUSHJ P,NXTCHR
CAIE A,"="
CAIN A,"("
POPJ P, ;THIS IS PROBABLY AN ASSIGNMENT STATEMENT
CAIE A,"," ;"ACCEPT 69,A,B,C"
JUMPN A,ALSC4 ;LOOP UNTIL END OF LINE, LOOKING FOR COMMA
;(THIS ACCEPTS "TYPE 67")
MOVEI A,(Z) ;LOAD UP CODE FOR ACCEPT,PRINT,PUNCH, ETC.
JRST CPOPJ1 ;SUCCESS RETURN
ALSC2: MOVE Y,TSAVE ;THIS POINTS SOMEWHERE NEAR THE RIGHT PLACE
ILDB A,Y
JUMPE A,ALSC3
MESS 1,A
JRST ALSC2+1 ;LOOP TYPING LOSE MESSAGE
ALSC3: BCALL 3,[ASCIZ/
WARNING: THIS STATEMENT ISN'T IN THE RIGHT FORM.
/]
POPJ P, ;FAILURE RETURN
ASLSC: MATCH [ASCII/SIGN/] ;SEARCH FOR ASSIGN STATEMENT
POPJ P, ;SEARCH FAILS
PUSHJ P,SCANEQ ;MAKE SURE OF NO = IN TEXT
POPJ P, ;LOSE
MOVEI A,2 ;SET CODE FOR KEY
JRST CPOPJ1 ;SKIP RETURN FOR SUCCESS
DLSC: PUSHJ P,NXTCHR ;"D" SEEN. GET NEXT
CAIN A,"E" ;IS IT "DE"?
JRST DLSCD ;YES, TRY DECODE
CAIE A,"O" ;"DO"?
POPJ P, ;NOPE
PUSHJ P,NXTCHR ;MUST GET SOME NUMBER
CAIL A,"0" ;SKIP IF NOT A DIGIT
CAILE A,"9" ;SKIP IF IT IS A DIGIT
POPJ P, ;NO DIGIT
DLSC1: PUSHJ P,NSEPX ;GET NEXT. BE SURE IT'S NOT = OR (
POPJ P, ;LOSER. NOT ANY DO STATEMENT
CAIE A,"$" ;$ IS VALID FIRST CHARACTER FOR ID
JRST DLSC3 ;SO GO TO HAVE SEEN ID BEGINNING
CAIL A,"A" ;SKIP IF NOT LETTER
CAILE A,"Z" ;SKIP IF IT IS A LETTER
JRST DLSC1 ;GET MORE
DLSC3: PUSHJ P,NSEPX ;LOOKING FOR "=" WITHOUT (
JRST .+2 ;= OR NULL OR ( SEEN
JRST DLSC3 ;BACK UNTIL WE GET SEPARATOR
CAIE A,"=" ;TEST FOR = SIGN
POPJ P, ;NOT A DO STATEMENT
DLSC4: PUSHJ P,NXTCHR ;GET A CHARACTER
JUMPE A,CPOPJ ;END OF LINE. WE WANTED A COMMA
CAIN A,"(" ;TEST FOR FLAVORS OF (
AOS PARCT ;INCREMENT PARENTHESIS COUNT
CAIN A,")" ;TEST OTHER FLAVOR
SOS PARCT ;DECREMENT.
SKIPE PARCT ;SKIP IF COUNT IS AT GROUND LEVEL
JRST DLSC4 ;NOPE, GET MORE
CAIE A,"," ;YES. DO WE HAVE A COMMA
JRST DLSC4 ;NOPE, GET MORE
MOVEI A,3 ;SET STATEMENT CODE
JRST CPOPJ1 ;GIVE SUCCESS RETURN
DLSCD: MOVEI Z,13 ;DECODE STATEMENT?
MATCH [ASCIZ/CODE(/] ;SEARCH FOR KEYWORD
POPJ P, ;FAILURE
DLSCE: PUSHJ P,NXTCHR ;GRAB CHARACTER
JUMPE A,CPOPJ ;TOO BAD
CAIN A,"(" ;OPEN?
AOS PARCT ;YES, INCREMENT
CAIN A,")" ;CLOSE?
SOSL PARCT ;YES. DECREMENT. SKIP IF HIT THE GROUND
JRST DLSCE ;NOPE, KEEP CUTTING
PUSHJ P,NSEPX ;MAKE SURE THAT WE DON'T HAVE = OR (
CAIE A,"=" ;IS IT = WE HAVE? ENCODE CAN TAKE A LIST
SKIPA A,Z ;OTHER THAN AN = WAS SEEN. A_STATEMENT CODE
POPJ P, ;LOSE
JRST CPOPJ1 ;SUCCESS RETURN
ELSC1: MOVEI Z,14 ;LOAD CODE FOR ENCODE
MATCH [ASCIZ/ODE(/] ;TRY TO MATCH
POPJ P, ;FAILURE
JRST DLSCE ;GO TO COMMON STUFF FOR DECODE/ENCODE
ELSC: PUSHJ P,NXTCHR ;WE SAW "E"
CAIE A,"N" ;HAVE WE GOT "EN"
POPJ P, ;NOPE
PUSHJ P,NXTCHR ;GET ANOTHER
CAIN A,"C" ;DO WE HAVE "ENC"
JRST ELSC1 ;YES. TRY ENCODE
CAIE A,"D" ;NO. MAYBE "END" ?
POPJ P, ;NOPE, NOTHING
PUSHJ P,NXTCHR ;GET NEXT
JUMPN A,CPOPJ ;IF NOT NULL THEN NOT END STMT
TRO FL,ENDPRG ;TURN ON THE FLAG
SOJA A,CPOPJ1 ;SET CODE TO -1 AND RETURN
GLSC: MATCH [ASCII/OTO/] ;WE HAVE "G" LOOK FOR "GOTO"
POPJ P, ;FAILED
PUSHJ P,SCANEQ ;MAKE SURE OF NO = IN TEXT
POPJ P, ;FAILURE
MOVEI A,4 ;CODE FOR GOTO
JRST CPOPJ1 ;SUCCESS
ILSC: MATCH [ASCII/F(/] ;"I" SEEN. SEEK "IF(...."
POPJ P, ;FAILURE
TLZ FL,QUOTE ;NO QUOTES SEEN
ILSC1: PUSHJ P,NXTCHR ;GET A CHARACTER
JUMPE A,CPOPJ ;LOSE
CAIN A,"'" ;IS IT A QUOTE
TLC FL,QUOTE ;YES. COMPLEMENT QUOTE FLAG
TLNE FL,QUOTE ;IS FLAG SET?
JRST ILSC1 ;YES IT IS, QUICK LOOP AND GET MORE
CAIN A,"(" ;OPENING PARENTHESIS?
AOS PARCT ;YUP, INCREMENT PARCT
CAIN A,"H" ;PERHAPS WE HAVE A HOLERITH?
PUSHJ P,HOLER ;GO WORRY. RETURN POINTER PAST HOLERITH
CAIN A,")" ;CLOSING?
SOSL PARCT ;YES. DECREASE. SKIP IF HIT THE GROUND
JRST ILSC1 ;NOPE, GO ON BACK
MOVEM Y,SAVEY ;YES. SAVE THIS BYTE POINTER
PUSHJ P,NSEPX ;IS NEXT CHARACTER AN = ( OR NULL
POPJ P, ;YES. LOSE
MOVE Y,SAVEY ;GET BACK THE POINTER TO THE )
ILDB A,Y ;LOAD UP CHARACTER INTO A
MOVEI B,31 ;LOAD B WITH ^Y MARKER TO END OF COND.
DPB B,Y ;PLUNK THE ^Y
ARRRGH: MOVEI B,(A) ;TRANSFER DISPLACED CHARACTER TO B
ILDB A,Y ;LOAD NEXT CHARACTER
DPB B,Y ;PLUNK B
JUMPN B,ARRRGH ;BACK UNTIL AFTER A NULL IS PLUNKED
MOVEI A,5 ;CODE FOR IF
JRST CPOPJ1 ;RETURN WITH SUCCESS
PLSC: PUSHJ P,NXTCHR ;GET A CHARACTER
CAIN A,"U" ;WE HAVE "P". DO WE HAVE "PU"
JRST PLSCU ;YES. TRY PUNCH STATEMENT
CAIE A,"R" ;HAVE WE GOT "PR"?
POPJ P, ;NOPE
MATCH [ASCII/INT/] ;TRY TO MATCH FOR "PRINT"
POPJ P, ;NOPE
MOVEI Z,6 ;YES SET CODE FOR PRINT AND MAKE SURE
JRST ALSC1
PLSCU: MATCH [ASCII/NCH/] ;MATCH FOR "PUNCH"
POPJ P, ;FAILURE
MOVEI Z,7
JRST ALSC1
RLSC: PUSHJ P,NXTCHR ;"R" SEEN. GET NEXT
CAIE A,"E" ;"RE"?
POPJ P, ;NOPE
PUSHJ P,NXTCHR ;GET ANOTHER
CAIN A,"R" ;"RER"?
JRST RLSCR ;YES. TRY "REREAD"
CAIN A,"T" ;"RET"?
JRST RETSC1 ;TRY A RETURN STATEMENT
CAIE A,"A" ;"REA"?
POPJ P, ;NO MORE CHOICES
PUSHJ P,NXTCHR ;GET ANOTHER CHARACTER
CAIE A,"D" ;IT HAD BETTER BE A "D"
POPJ P, ;NOPE
MOVEI Z,10 ;CODE FOR "READ"
RLSC0: PUSHJ P,NXTCHR ;GET MORE
JUMPE A,CPOPJ ;THAT'S ALL, LOSE
CAIE A,"(" ;IS IT (
JRST RLSCX ;POSSIBLE READ WITHOUT UNIT NUMBER
RLSC1: PUSHJ P,NXTCHR ;LOOK AT NEXT
JUMPE A,CPOPJ ;LOSE
CAIN A,"(" ;COUNT PARENTHESIS
AOS PARCT ;INCREMENT
CAIN A,")" ;IF CLOSE
SOSL PARCT ;THEN DECREMENT. SKIP IF AT THE GROUND
JRST RLSC1 ;NOPE
PUSHJ P,NXTCHR ;GET THE NEXT
CAIN A,"=" ;IS IT =
POPJ P, ;YES. LOSE
RLSC2: MOVEI A,(Z) ;LOAD CODE
JRST CPOPJ1 ;SUCCESS RETURN
RLSCX: CAIE A,"(" ;ANOTHER PARENS IS ILLEGAL.
CAIN A,"=" ;LOOK TO BE SURE
POPJ P, ;THAT IT'S NOT = SIGN
JUMPE A,RLSC2 ;WE ARE OK
CAIN A,"," ;COMMA IS A GOOD SIGN
JRST RLSC2 ;SO RETURN
PUSHJ P,NXTCHR ;GET ANOTHER
JRST RLSCX ;AND LOOP BACK
RLSCR: MATCH [ASCIZ/EAD/] ;TRY TO MATCH REREAD
POPJ P, ;LOSE
MOVEI Z,15
JRST ALSC1
RETSC1: MATCH [ASCIZ/URN/] ;MATCH FOR "RETURN"
POPJ P, ;LOSE
PUSHJ P,NXTCHR ;THIS BETTER BE NULL
JUMPN A,CPOPJ ;LOSE
MOVEI A,17 ;LOAD CODE
JRST CPOPJ1 ;SUCCESS RETURN
TLSC: MATCH [ASCII/YPE/] ;TRY "TYPE"
POPJ P, ;FAIL
MOVEI Z,11
JRST ALSC1
WLSC: MATCH [ASCIZ/RITE(/] ;TRY "WRITE"
POPJ P, ;LOSE
MOVEI Z,12 ;CODE FOR WRITE
JRST RLSC0 ;USE SAME ANALYSIS AS READ
FLSC: MATCH [ASCIZ/ORMAT(/] ;MATCH "FORMAT"
POPJ P, ;LOSE
TLZ FL,QUOTE ;ZERO QUOTE FLAG
FLSC1: PUSHJ P,NXTCHR ;GRAB CHARACTER
JUMPE A,CPOPJ ;LOSE
CAIN A,"'" ;QUOTE?
TLC FL,QUOTE ;YES. COMPLEMENT FLAG
TLNE FL,QUOTE ;FLAG ON?
JRST FLSC1 ;YES. SWALLOW CHARACTERS
CAIN A,"(" ;OPEN?
AOS PARCT ;COUNT IT
CAIN A,"H" ;POSSIBLE HORRORITH
PUSHJ P,HOLER ;GET POINTER PAST HOLERITH
CAIN A,")" ;COUNT CLOSES
SOSL PARCT ;DECREMENT AND SKIP IF IT GROUNDS
JRST FLSC1 ;NOPE. BACK FOR MORE
PUSHJ P,NXTCHR ;GET MORE
JUMPN A,CPOPJ ;LOSE IF THERE'S ANY MORE
MOVEI A,16 ;LOAD CODE
TRNN FL,FORMAT ;ARE WE DOING wierdness
JRST CPOPJ1 ;NO. QUICK SUCCESS RETURN
MOVE A,IBUF ;LOAD THE FIRST FIVE CHARS OF LINE
CAME A,ASC5SP ;ARE THEY BLANK?
SOS NUMLAB ;NOPE. TAKE BACK LABEL
MOVE B,[POINT 7,IBUF] ;WRITING ON TEMP2
PUSHJ P,WRTFMT ;RUN OUT AND WRITE ON FILE
MOVEI A,16 ;LOAD CODE
AOS -1(P) ;DIRTY TRICK DEPARTMENT
;THIS WILL FORCE CALLER (I.E. LSCAN)
;TO SKIP RETURN TO his CALLER
JRST CPOPJ1 ;RETURN WITH SUCCESS AND CONFUSION
SLSC: MATCH [ASCIZ/TOP/] ;SEARCH FOR "STOP"
POPJ P, ;LOSE
PUSHJ P,SCANEQ ;LOOK FOR = IN TEXT
POPJ P, ;LOSE: THERE WAS ONE
SLSC0: MOVEI A,20 ;LOAD CODE
JRST CPOPJ1 ;SUCCESS RETURN
CLSC: PUSH P,Y
MATCH [ASCIZ/ALLEXIT/] ;"CALL EXIT"
JRST CLSC1 ;LOSE
SUB P,[1,,1] ;ADJUST STACK
PUSHJ P,NXTCHR ;SEEK NEXT CHARACTER
JUMPE A,SLSC0 ;JUMP IF THERE AREN'T ANY: CALL EXIT SEEN
CLSC1: POP P,Y ;REINITIALIZE FOR RESCAN
MATCH [ASCIZ/ALL/] ;REMATCH FOR CALL.
POPJ P, ;FAILED TO MATCH "CALL"
CLSC2: PUSHJ P,NXTCHR ;READ CHARACTER
JUMPE A,CPOPJ ;JUMP IF NOTHING SEEN (UNINTERESTING)
CAIN A,"=" ;LOOK FOR = (E.G. CALLBA=0)
POPJ P,
CAIE A,"(" ;ARGUMENT LIST?
JRST CLSC2 ;NOT YET.
TLZ FL,QUOTE
CLSC3: PUSHJ P,NXTCHR ;GET A CHARACTER
JUMPE A,CPOPJ ;LOSE
CAIN A,"'" ;IS IT A QUOTE
TLC FL,QUOTE ;YES. COMPLEMENT QUOTE FLAG
TLNE FL,QUOTE ;IS FLAG SET?
JRST CLSC3 ;YES IT IS, QUICK LOOP AND GET MORE
CAIN A,"(" ;OPENING PARENTHESIS?
AOS PARCT ;YUP, INCREMENT PARCT
CAIN A,"H" ;PERHAPS WE HAVE A HOLERITH?
PUSHJ P,HOLER ;GO WORRY. RETURN POINTER PAST HOLERITH
CAIN A,")" ;CLOSING?
SOSL PARCT ;YES. DECREASE. SKIP IF HIT THE GROUND
JRST CLSC3 ;NOPE, GO ON BACK
PUSHJ P,NXTCHR ;GET ONE MORE
JUMPN A,CPOPJ ;SHOULD HAVE BEEN NULL.
MOVEI A,21 ;ASSUME REAL CALL STATEMENT
JRST CPOPJ1
SUBTTL THE STUFF THAT WORRIES ABOUT HOLERITHS
HOLER: PUSH P,Y ;SAVE OLD BYTE POINTER
PUSHJ P,BACKUP ;SCAN BACKWARDS IN LINE
JRST HOLRET ;NOTHING OF INTEREST
PUSHJ P,BACKUP ;GO ON BACK,
JRST .+2 ;NOT A DIGIT
JRST .-2 ;DIGIT SEEN. CONTINUE BACKSCAN
PUSHJ P,DELIM ;LOOK AT CHARACTER IN A IS IT DELIM?
JRST HOLER1 ;YES IT IS
CAIE A,"(" ;NOPE. HOW ABOUT (
CAIN A,"." ;OR A DOT?
JRST HOLER1 ;OK TREAT AS A DELIM
CAIE A,"'" ;EVEN A QUOTE
JRST HOLRET ;NONE OF THESE
HOLER1: SETZ B, ;ACCUMULATE COUNT OF CHARS TO SKIP
HOLER2: ILDB A,Y ;LOAD A CHARACTER
CAIE A,1 ;SKIP OVER CONTINUATION MARK
CAIN A," " ;AND BLANKS
JRST HOLER2 ;...SKIP
CAIN A,11 ;AND TABS
JRST HOLER2 ;ARE SKIPED
CAIN A,"H" ;H WILL TERMINATE FORWARD ACCUMULATION
JRST HOLER3 ;ACCUMULATION DONE
IMULI B,12 ;THIS CHARACTER MUST BE A DIGIT
ADDI B,-"0"(A) ;SO ACCUMULATE IT
JRST HOLER2 ;BACK UNTIL "H" IS SEEN
HOLER3: JUMPE B,HOLRET ;0H IS UNINTERESTING
POP P,(P) ;DELETE OLD LINE POINTER FROM STACK
ILDB A,Y ;LOAD CHARACTERS
JUMPE A,CPOPJ ;THEY'LL KNOW WHAT TO DO, I HOPE
SOJG B,.-2 ;SCAN PAST ENOUGH CHARACTERS
JRST HOLRT1 ;RETURN UPDATED Y
HOLRET: POP P,Y ;RESTORE OLD BYTEPOINTER
HOLRT1: SETZ A, ;RETURN NULL CHARACTER
POPJ P, ;AND RETURN
BACKUP: SETZ A, ;DEFAULT IS ZERO CHARACTER
CAMN Y,[POINT 7,IBUF+1,6] ;ARE WE AT BEGINING OF BUFFER
POPJ P, ;YES, LOSE.
ADD Y,[XWD 70000,0] ;BACKUP THE BYTE POINTER
JUMPGE Y,.+2 ;SKIP IF Y>0
SUB Y,[XWD 430000,1] ;PAST BOUNDARY
LDB A,Y ;LOAD BYTE POINTER
CAIE A,1 ;GO BACK OVER LINE CONTINUATION MARK
CAIN A," " ;AND SPACES
JRST BACKUP ;CONTINUE SCAN
CAIN A,11 ;ALSO BACK PAST TABS
JRST BACKUP ;CONTINUE
CAIL A,"0" ;HAVE WE GOT A DIGIT?
CAILE A,"9" ;....
POPJ P, ;NOPE. FAILURE RETURN
JRST CPOPJ1 ;YES WIN!
SUBTTL FIND THE PROGRAM NAME
GETNAM: PUSH P,Y ;SAVE PRESENT BYTE POINTER
MESS 3,[ASCIZ/FORFLO: /] ;WRITE ON TTY (ONLY IF TTYF=0)
MOVEI B,[ASCIZ/SUBROUTINE/] ;LOAD SEARCH STRING
PUSHJ P,SEARCH ;RUN OFF AND SEARCH
JRST GETNMW ;SUCCESS
MOVE Y,0(P) ;RELOAD ORIGINAL POINTER
MOVEI B,[ASCIZ/FUNCTION/] ;LOAD A SEARCH STRING
PUSHJ P,SEARCH ;GO FISH
JRST GETNMW ;WIN, I THINK
MOVE Y,0(P) ;RELOAD POINTER
MOVEI B,[ASCIZ/BLOCK/] ;LOAD ADDRESS OF SEARCH STRING
PUSHJ P,SEARCH ;GO FISH
JRST GETNM1 ;LOOK AT STUFF FOUND BY SUCCESS
JRST GETNML ;LOSE EVERYWHERE
GETNM1: MOVE B,NAME ;THIS OUGHT TO BE "DATA"
CAME B,[ASCIZ/DATA/] ;COMPARE?
JRST GETNML ;VERY STRANGE
MOVE B,[ASCIZ/BLKD/] ;USE NAME FOR SEQUENCING
MOVEM B,NAME ;SAVE AS NAME
MOVE B,[XWD [ASCIZ/BLOCK DATA/],NAMEX] ;LOAD BLT POINTER
BLT B,NAMEX+2 ;BEATS THE 3 LOAD STORE PAIRS
GETNMX: MESS 3,NAMEX ;WRITE FULL NAME
MESS 3,ASCRLF ;AND NEW LINE
POP P,Y ;RESTORE FOR CALLER
POPJ P, ;RETURN TO THE WORLD
GETNMW: SKIPE NAME ;RETURN FROM SEARCH. GOT NAME?
JRST GETNMX ;YES. GO ANNOUNCE IT
GETNML: MOVE B,[ASCIZ/MAIN/] ;DEFAULT NAME OF EVERYTHING
MOVEM B,NAME ;SAVE NAME
MOVEM B,NAMEX ;SAVE AS FULL NAME
JRST GETNMX ;GO TYPE STUFF AND RETURN
COMMENT/
SEARCH: SEARCH TEXT THAT Y POINTS TO FOR STRING THAT B POINTS TO.
CALLER MUST SAVE Y. SKIP RETURN=LOSE. NON-SKIP=WIN! /
SEARCH: HRLI B,(<POINT 7,0>) ;CONVERT B TO A BYTE POINTER
MOVE Z,B ;SAVE AS POINTER TO STRING
SERCH1: MOVE B,Z ;LOAD SEARCH STRING POINTER
ILDB C,B ;LOAD SEARCH CHARACTER INTO C
SERCH2: PUSHJ P,NXTCHR ;GET A CHARACTER FROM THE TEXT
JUMPE A,CPOPJ1 ;END OF SOURCE TEXT AND NO MATCH
CAME A,C ;COMPARE TEXT CHARACTER VS STRING
JRST SERCH2 ;NO MATCH, GET NEXT FROM TEXT
MOVE D,Y ;SAVE TEXT POINTER IF RESUMPTION NEEDED
SERCH3: ILDB C,B ;GET NEXT CHARACTER TO MATCH
JUMPE C,SERCH4 ;SEARCH STRING EMPTY. WIN.
PUSHJ P,NXTCHR ;GET ANOTHER CHARACTER
JUMPE A,CPOPJ1 ;SOURCE EXHAUSTED. LOSE
CAMN A,C ;COMPARE TEXT VS SEARCH STRING
JRST SERCH3 ;WINNING SO FAR
MOVE Y,D ;RESTORE Y FROM TEMPORARY
JRST SERCH1 ;PICK UP THE SEARCH
SERCH4: MOVE B,[POINT 7,NAME] ;POINTER TO DEPOSIT TEXT WITH
SETZM NAME ;ZERO PROGRAM NAME
SETZM NAME+1 ;CLEAR OUT THE NAME FIELD
MOVEI Z,6 ;COUNT OF CHARACTERS THAT WE ACCEPT
SERCH5: PUSHJ P,NXTCHR ;GET CHARACTER
JUMPE A,SERCH6 ;END OF LINE
CAIN A,"(" ;( STOPS WORLD
JRST SERCH6 ;STOP HERE
IDPB A,B ;DEPOSIT THIS CHARACTER
SOJG Z,SERCH5 ;BACK FOR MORE, AS LONG AS COUNT OK
SERCH6: SUBI Z,6 ;Z = 6-# OF CHARACTERS
MOVM Z,Z ;= # OF CHARACTERS IN NAME
MOVE C,[XWD NAME,NAMEX] ;LOAD BLT POINTER
BLT C,NAMEX+1 ;MOVE TWO WORDS
CAIG Z,4 ;CHECK LENGTH
POPJ P, ;WINNING RETURN
COMMENT /NOW WE HAVE TO SELECT A FOUR LETTER NAME FROM 5 OR 6 LETTERS
KEEP THE FIRST LETTER, THROW OUT THE FIRST VOWELS./
MOVE B,[POINT 7,NAME,6] ;LOAD POINTER TO SECOND LETTER
MOVE C,B ;IN TWO PLACES
SERCH7: ILDB A,B ;LOAD NEXT CHARACTER FROM NAME
CAIE A,"A" ;"A" IS VOWEL
CAIN A,"E" ;AND SO IS "E"
JRST VOWEL1 ;OFF TO SEEN VOWEL
CAIE A,"I" ;"I" IS VOWEL
CAIN A,"O" ;AND "O"
JRST VOWEL1 ;OFF TO HAVE SEEN VOWEL
CAIE A,"U" ;SO IS "U" BUT NOT "Y"
JRST VOWEL2 ;NOT A VOWEL
VOWEL1: SUBI Z,1 ;DECREASE COUNT OF CHARACTERS IN NAME
CAIGE Z,4 ;COMPARE NEW LENGTH
VOWEL2: IDPB A,C ;STORE CHARACTER
JUMPN A,SERCH7 ;BACK FOR MORE
DPB A,[POINT 7,NAME,34] ;DEPOSIT NULL IN NAME
POPJ P, ;RETURN
SUBTTL PASS2
COMMENT /
READA WILL LOAD THE NEXT STATEMENT AND READ IN THE VALUE OF KEY
IF KEY > 0 THEN WE WILL DISPATCH THRU SCNTAB
TO ROUTINE TO PROCESS EACH TYPE OF STATEMENT
ALL ROUTINES WILL RETURN TO PASS2
/
PA2.11: MOVE B,[POINT 7,IBUF] ;END/UNSPECIAL/FORMAT, ETC.
PUSHJ P,FLUSH ;JUST FLUSH THEM PLAINLY
SKIPGE KEY ;CHECK THE VALUE OF KEY
POPJ P, ;END, RETURN TO SENDER
PASS2: PUSHJ P,READA ;LOAD UP A NEW LINE
SKIPG A,KEY ;TEST KEY VALUE
JRST PA2.11 ;UNSPECIAL LINE.
MOVE C,[XWD IBUF,OBUF] ;LOAD C WITH A BLT POINTER
BLT C,OBUF+1 ;COLS 1-10 ARE COPIED
MOVE C,[POINT 7,IBUF+1,6] ;BUT POINTERS WILL OVER WRITE
MOVE D,[POINT 7,OBUF+1,6] ;COLUMNS 7-ONWARDS.
TRZ FL,URR ;FLAG OFF EACH TIME WE START
CAIGE A,TABMAX ;COMPARE TO TABLE BOUNDS
JRST @SCNTAB(A) ;DISPATCH
PA299: PUSHJ P,INTCFN ;INTERNAL CONFUSION
HALT .-1
SCNTAB: JRST PA299 ;LOSER.
JRST SCNTYP ;ACCEPT
JRST SCNDO ;ASSIGN
JRST SCNDO ;DO
JRST SCNGO ;GOTO
JRST SCNIF ;IF STATEMENT
JRST SCNTYP ;PRINT
JRST SCNTYP ;PUNCH
JRST SCNRED ;READ
JRST SCNTYP ;TYPE
JRST SCNWRT ;WRITE
JRST SCNCDE ;ENCODE
JRST SCNCDE ;DECODE
JRST SCNTYP ;REREAD
JRST PA2.11 ;FORMAT, OF INTEREST TO PASS3 ONLY
JRST PA2.11 ;RETURN, OF INTEREST TO PASS3 ONLY
JRST PA2.11 ;STOP OR CALL EXIT FOR PASS3 ONLY
JRST SCNCAL ;CALL
SDEF TABMAX,.-SCNTAB
NCH: ILDB A,C ;RETURN SIGNIFICANT CHARACTER FROM IBUF
CAIE A," " ;SKIP BLANKS
CAIN A,11 ;AND TABS
JRST NCH1 ;GO WRITE IN OBUF
CAIE A,1 ;OR IS THIS THE LINE CONTINUE CHARACTER?
POPJ P, ;THIS IS SIGNIFICANT: RETURN CHARACTER
NCH1: IDPB A,D ;WRITE IN OBUF
JRST NCH ;LOOP SKIPPING BLANKS/TABS
SUBTTL PASS2: ACCEPT REREAD PRINT PUNCH TYPE. DO ASSIGN AND SCN.DN
TYP.1: IDPB A,D ;WRITE CHARACTER IN OBUF
CAIE A,"(" ;IF IT IS (
CAIN A,"," ;OR COMMA
JRST TYP.2 ;THEN TERMINATE SCAN PREMATURELY
SCNTYP: PUSHJ P,NCH ;GET THE NEXT CHARACTER FROM IBUF
JUMPE A,TYP.5 ;END OF WORLD
TYP.0: CAIL A,"0" ;IS IT A DIGIT?
CAILE A,"9" ;SKIP IF IT'S A DIGIT
JRST TYP.1 ;NOT DIGIT
TYP.4: PUSHJ P,RENUM ;C POINTS TO DIGIT. D FOR DEPOSIT
JRST TYP.2 ;FINISH UP
TYP.3: IDPB A,D ;WRITE IN OBUF
TYP.2: ;COPY INPUT TO OUTPUT
LDB A,C ;LOAD THIS BYTE
SKIPE A ;SKIP IF ZERO
ILDB A,C ;INCREMENT AND LOAD
TYP.5: IDPB A,D ;DEPOSIT IN OUTPUT
JUMPN A,.-2 ;REPEAT UNTIL NULL
SCN.DN: MOVE B,[POINT 7,OBUF] ;FINISHED SCAN
PUSHJ P,FLUSH ;LOAD POINTER AND GO TO FLUSH
TRZN FL,URR ;CHECK FLAGS
JRST SCNDN1 ;URR CLEAR. CHECK OTHERS
AOS ERRCNT ;INCREMENT ERROR COUNT
MESS 3,IBUF ;WRITE BUFFER FULL
BCALL 3,[ASCIZ/
ERROR UNRESOLVED REFERENCE /] ;WRITE MESSAGE
MOVE A,URREF ;LOAD REFERENCE NUMBER
PUSHJ P,DECPB ;PRINT IT
BCALL 3,ASCRLF ;END THE LINE
SCNDN1: TRZN FL,ILLIFF ;CHECK ILLIFF FLAG
JRST PASS2 ;WE ARE OK
AOS ERRCNT ;COUNT AN ERROR
MESS 3,IBUF ;WRITE BUFFER
BCALL 3,[ASCIZ/
ERROR ILLEGAL CONSEQUENCE OF AN 'IF' STATEMENT
/] ;AND THE MESSAGE
JRST PASS2 ;RETURN
SCNDO1: IDPB A,D ;DEPOSIT IN OBUF
SCNDO: PUSHJ P,NCH ;LOAD CHARACTER
CAIL A,"0" ;LOOKING FOR DIGIT
CAILE A,"9" ;SKIP IF WE HAVE ONE
JRST SCNDO1 ;NOT A DIGIT
MOVEI A,2 ;LOAD WITH ^B CODE
PUSHJ P,PUTTM2 ;WRITE ON TEMP2 FOR FLOWCHART
LDB A,C ;RESTORE CHARACTER
PUSHJ P,RENUMX ;RENUMBER AND WRITE ON TEMP2
MOVEI A,2 ;LOAD MARK CODE
PUSHJ P,PUTTM2 ;WRITE ON TEMP2
JRST TYP.2 ;GO FINISH UP
SUBTTL PASS2: READ AND WRITE STATEMENTS ALSO ENCODE/DECODE
SCNWRT: PUSHJ P,NCH ;GET CHARACTER FROM IBUF
IDPB A,D ;DEPOSIT IN OBUF
CAIE A,"E" ;IS IT "E" OF "WRITE"
JRST SCNWRT ;NOPE, LOOP
JRST SCNRD0 ;YES. MAKE IT LOOK LIKE READ NEXT.
SCNRED: PUSHJ P,NCH ;GET CHARACTER FROM IBUF
IDPB A,D ;DEPOSIT IN OBUF
CAIE A,"D" ;IS IT "D"?
JRST SCNRED ;NOPE, LOOP
SCNRD0: PUSHJ P,NCH ;GET NEXT SIGNIFICANT CHARACTER
CAIE A,"(" ;HAVE GOT AN OPEN?
JRST TYP.0 ;THIS MUST BE: READ F,LIST
IDPB A,D ;DEPOSIT THE CHARACTER IN OBUF
SETZM PARCT ;COUNT OF PARENS, -1
SCNRD1: PUSHJ P,NCH ;GET NEXT SIGNIFICANT CHARACTER
IDPB A,D ;DEPOSIT IT
CAIN A,"(" ;COUNT DEPTH
AOS PARCT ;...
CAIN A,")" ;IS IT A CLOSE?
SOSL PARCT ;DECREMENT PARCT
JRST .+2 ;NOT ) OR NOT OUT OF NEST
JRST TYP.2 ;MUST BE: READ (U)LIST
CAIE A,"," ;IS IT A COMMA?
JRST SCNRD1 ;NOPE, LOOP BACK
PUSHJ P,NCH ;LOOKING FOR FORMAT: GET NEXT
CAIL A,"0" ;LOOKING FOR NUMBER
CAILE A,"9" ;SKIP IF WE HAVE DIGIT
JRST SCNRD3 ;NO DIGIT. MUST BE FORMAT ARRAY
PUSHJ P,RENUM ;RELABEL THIS FORMAT
SCNRD2: PUSHJ P,NCH ;GET NEXT CHARACTER
SCNRD3: IDPB A,D ;LOOKING FOR CLOSE OR COMMA
CAIN A,")" ;CLOSE?
JRST TYP.2 ;YUP FINISH UP
CAIN A,"=" ;THING FOLLOWING IS A LABEL
JRST SCNRD4 ;DO LABEL THING
JUMPE A,SCN.DN ;EXHAUSTED (NULL HAS BEEN WRITTEN)
JRST SCNRD2 ;AND LOOP BACK
SCNRD4: PUSHJ P,NCH ;LOOKING FOR LABEL
CAIL A,"0" ;HAVE WE GOT A NUMBER?
CAILE A,"9" ;SKIP IF NUMBER
JRST TYP.3 ;PLUNK CHARACTER AND FINISH UP
MOVEI A,2 ;LOAD SPECIAL CODE
PUSHJ P,PUTTM2 ;WRITE ON TEMP2
LDB A,C ;RESTORE A
PUSHJ P,RENUMX ;RENUMBER
SCNRD5: PUSHJ P,NCH ;GET MORE
IDPB A,D ;DEPOSIT CHARACTER
CAIN A,")" ;PARENS WILL END ALL
JRST SCNRD7 ;GO OFF AND FINISH
CAIN A,"=" ;= SIGN WILL START IT ALL OFF
JRST SCNRD6 ;AGAIN
JUMPE A,SCN.DN ;ALL DONE IF NULL (NULL HAS BE WRITTEN)
JRST SCNRD5 ;LOOP
SCNRD6: PUSHJ P,NCH ;GET STILL MORE
CAIL A,"0" ;LOOK FOR DIGIT
CAILE A,"9" ;...
JRST TYP.3 ;FINISH THIS ALL
PUSHJ P,RENUMX ;RENUMBER THIS TOO
SCNRD7: MOVEI A,2 ;LOAD UP SPECIAL CODE
PUSHJ P,PUTTM2 ;WRITE
JRST TYP.2 ;FINISH UP
SCNCDE: PUSHJ P,NCH ;GET CHARACTER
IDPB A,D ;STORE
CAIE A,"(" ;LOOKING FOR OPEN PARENS
JRST SCNCDE ;NOT YET
SETZM PARCT ;ZERO COUNTER
SCNCD1: PUSHJ P,NCH ;GET MORE
IDPB A,D ;SAVE
JUMPE A,SCN.DN ;FINISH UP ON NULL (NULL WAS WRITTEN)
CAIN A,"(" ;OPEN ADDS
AOS PARCT ;ONE TO PARCT
CAIN A,")" ;CLOSE
SOS PARCT ;DECREMENTS ONE
SKIPE PARCT ;SKIP IF WITHIN ONE LEVEL
JRST SCNCD1 ;TOO DEEP
CAIE A,"," ;SEEKING COMMA AT THIS LEVEL
JRST SCNCD1 ;NOT YET
PUSHJ P,NCH ;GET ANOTHER
CAIL A,"0" ;LOOKING FOR DIGIT HERE
CAILE A,"9" ;SKIP IF DIGIT
JRST TYP.3 ;PLUNK CHARACTER IN OBUF AND QUIT
JRST TYP.4 ;RENUMBER AND FINISH
SUBTTL PASS2: IF AND GO TO STATEMENTS.
SCNIF0: IDPB A,D ;SAVE CHARACTER IN OUTPUT
SCNIF: PUSHJ P,NCH ;GET A CHARACTER
CAIE A,31 ;^Y MARKS THE END OF THE CONDITION
JRST SCNIF0 ;LOOP SEEKING END OF CONDITION
PUSH P,C ;SAVE BYTE POINTER TO END OF CONDITION
PUSH P,D ;SAVE POINTER TO OUTPUT STRING
PUSHJ P,NCH ;GET NEXT SIGNIFICANT CHARACTER
CAIL A,"0" ;SEEKING DIGITS
CAILE A,"9" ;SKIP IF DIGIT
JRST SCNIF3 ;NO DIGIT: MUST BE A LOGICAL.
COMMENT/
THIS IS AN ARITHMETIC IF. FOR FLOWCHARTING, IT'S CONVENIENT TO MAKE
THIS INTO A GOTO, BECAUSE FALL MUST BE SHUT OFF WHEN ARITHMETIC IF IS SEEN.
WE FAKE THIS BY DEPOSITING THE CODE "D" IN PLACE OF THE "E" THAT MARKS
THE IF STATEMENT IN THE DKS2 OUTPUT BUFFER. (I THINK IT'S STILL THERE).
/
MOVEI A,"D" ;LOAD UP GOTO CODE
DPB A,DK2BUF+1 ;(NOTE: DEPOSIT WITHOUT INCREMENT)
POP P,D ;RECOVER OUTPUT BYTE POINTER
POP P,C ;RECOVER POINTER TO LABELS
;FALL INTO NMSCAN. CONVERT LABELS
; NMSCAN SCANS NUMBERS SEPARATED BY COMMAS AND STOPS AT EITHER
; NULL OR CLOSE PARENS. USED FOR LISTS IN COMPUTED AND ASSIGNED
; GOTOS AND IN ARITHMETIC IFS. NMSCAN OUTPUTS ^B TO THE TEMP FILE
; PRECEDING AND FOLLOWING THE LIST OF NUMBERS. RENUMX PUTS OUT:
; "NEWNUM," INTO THE TEMP FILE, SO WE CAN EXPECT TO FIND:
; ^BNUM,NUM,NUM,^B IN THE TEMP FILE.
NMSCAN: MOVEI A,2 ;LOAD WITH ^B CODE
PUSHJ P,PUTTM2 ;WRITE IN FILE
LDB A,C ;IN CASE A IS NULL.
NMSC0: PUSHJ P,NCH ;GET NEXT
JUMPE A,NMSC2 ;ALL DONE, I GUESS
CAIL A,"0" ;LOOK FOR DIGIT
CAILE A,"9" ;SKIP IF DIGIT
JRST NMSC1 ;NOT A DIGIT
PUSHJ P,RENUMX ;RENUMBER THIS LABEL
JRST NMSC0 ;LOOP BACK
NMSC1: IDPB A,D ;SAVE CHARACTER
CAIE A,")" ;CLOSE PARENS STOPS THIS
JRST NMSC0 ;BACK FOR MORE
NMSC2: MOVEI A,2 ;LOAD CODE
PUSHJ P,PUTTM2 ;WRITE
JRST TYP.2 ;FINISH THE REST OF THE LINE
COMMENT/
WE HAVE A LOGICAL IF. WE ARE ABOUT TO SCAN THE CONSEQUENCE
THINGS OF IMPORTANCE ARE THE INBUF AND OUTBUF
POINTERS C AND D. THE SCAN CHARACTER IS IN A
RIGHT NOW.
/
SCNIF3: MOVE Y,-1(P) ;LOAD POINTER TO END OF CONDITION
PUSH P,KEY ;SAVE KEY. REDEFINED BY LSCAN
PUSHJ P,LSCAN ;PASS1 SCAN OF THE REST OF THE LINE
JFCL ;POSSIBLE SKIP RETURN
MOVE A,KEY ;LOAD A WITH NEW KEY VALUE
POP P,KEY ;POP OLD KEY FROM STACK
POP P,D ;AND D
POP P,C ;POINTER TO CONDITION END
JUMPE A,TYP.2 ;ALL DONE. JUST COPY & FINISH
CAIN A,3 ;IS A DO THE CONSEQUENCE
JRST ILLIF ;YES: ILLEGAL IF CONSEQUENCE
CAIN A,5 ;IS THIS THE CODE FOR IF?
JRST SCNIF4 ;BETTER BE AN ARITHMETIC IF.
CAIE A,21 ;CODE FOR "CALL"
CAIG A,15 ;SKIP IF GREATER THAN CODE FOR REREAD
JRST @SCNTAB(A) ;OFF AND DO YOUR THING
JRST TYP.2 ;NO-OP FOR RETURN, ETC
;HERE THE CONSEQUENCE OF A LOGICAL 'IF' IS ANOTHER IF.
;I CAN'T BELEIVE THAT I WROTE THIS. (REG 3-26-73)
SCNIF4: PUSHJ P,NCH ;GRAB NEXT CHARACTER
CAIN A,31 ;LOOKING FOR END OF CONDITION
JRST SCNIF6 ;FOUND IT
IDPB A,D ;SAVE CHARACTER IN OBUF
JRST SCNIF4 ;LOOP
SCNIF6: PUSH P,C ;SAVE POINTER ON STACK
PUSH P,D
PUSHJ P,NCH ;GET A CHARACTER
POP P,D
POP P,C ;RESTORE POINTER
CAIL A,"0" ;SEEK A DIGIT
CAILE A,"9" ;SKIP IF A DIGIT
ILLIF: TROA FL,ILLIFF ;SET COMPLAIN FLAG: ILLEGAL IF. SKIP
JRST NMSCAN ;CONVERT ALL LABELS
JRST TYP.2 ;FINISHED: ILLEGAL IF
SCNGO: PUSHJ P,NCH ;LOAD CHARACTER
IDPB A,D ;SAVE
CAIE A,"T" ;SEEKING "T"
JRST SCNGO ;LOOP
PUSHJ P,NCH ;LOAD CHARACTER
IDPB A,D ;SAVE (THIS MUST BE THE "O")
PUSHJ P,NCH ;LOAD CHARACTER
CAIL A,"0" ;SEEKING DIGIT
CAILE A,"9" ;SKIP IF DIGIT
JRST SCNG3 ;NOT A DIGIT
MOVEI A,2 ;LOAD LABEL USE LIST CODE
PUSHJ P,PUTTM2 ;WRITE FOR PASS3
LDB A,C ;RESTORE CHARACTER TO A
PUSHJ P,RENUMX ;RENUMBER THIS LABEL
MOVEI A,2 ;LOAD CODE
PUSHJ P,PUTTM2 ;WRITE ON DISK FOR FLOWCHART
JRST TYP.2 ;AND FINISH UP
;HERE FOR COMPUTED GO TO OR ASSIGNED GO TO.
SCNG3: IDPB A,D ;SAVE FOR OUTPUT
JUMPE A,SCN.DN ;FINISH IF NULL (NULL WAS WRITTEN)
CAIN A,"(" ;OPEN MEANS LABEL LIST NEXT
JRST NMSCAN ;GO PROCESS THE LIST
PUSHJ P,NCH ;GET MORE CHARACTERS
JRST SCNG3 ;AND LOOP BACK
SUBTTL SCNCAL SCAN "CALL" STATEMENT FOR STATEMENT NUMBER ACTUALS
SCNCAL: PUSHJ P,NCH ;READ CHARACTERS
IDPB A,D ;STUFF BYTE
JUMPE A,SCN.DN
CAIE A,"("
JRST SCNCAL ;LOOP UNTIL ( SEEN
SETZM PARCT ;COUNT NESTING
TLZ FL,QUOTE
SCNCA1: PUSHJ P,NCH ;GET A CHARACTER
CAIE A,"&"
CAIN A,"$"
JRST SCNCA2 ;THIS IS A SPECIAL
CAIE A,"*"
JRST SCNCAY
SCNCA2: IDPB A,D ;STUFF SPECIAL CHARACTER
PUSHJ P,NCH
CAIL A,"0"
CAILE A,"9"
JRST SCNCAY ;IT WASN'T A NUMBER?
MOVEI A,2 ;WRITE ^B IN FILE
PUSHJ P,PUTTM2
LDB A,C ;GET CHARACTER BACK
PUSHJ P,RENUMX ;RENUMBER
MOVEI A,2 ;WRITE FINAL ^B
PUSHJ P,PUTTM2
SCNCAX: PUSHJ P,NCH
SCNCAY: IDPB A,D
JUMPE A,SCN.DN ;FINISH UP. NULL WAS WRITTEN.
CAIN A,"'"
TLC FL,QUOTE
TLNE FL,QUOTE
JRST SCNCAX ;GOBBLE IN QUOTE MODE
CAIN A,"," ;DELIMITER?
SKIPE PARCT
JRST .+2 ;NOT COMMA, OR NOT AT GROUND LEVEL
JRST SCNCA1 ;TIME FOR A NEW ARGUMENT
CAIN A,"H" ;THIS IS UNBELIVABLE
PUSHJ P,HOLLY ;POSSIBLE HOLLERITH LITERAL
CAIN A,"(" ;OPEN PARENS?
AOS PARCT ;COUNT DEPTH
CAIN A,")" ;CLOSE?
SOSL PARCT
JRST SCNCAX ;GOBBLE MORE
JRST TYP.2 ;FINISH COPYING.
HOLLY: MOVE Y,C
PUSHJ P,HOLER
CAMN C,Y ;CHECK TO SEE IF WE NEED TO
POPJ P, ;NO. EASY.
HOLLY1: ILDB A,C
IDPB A,D
CAMN C,Y
JRST HOLLY1
JUMPE A,SCN.DN ;(NULL WAS WRITTEN)
POPJ P,
SUBTTL SOME USEFUL ROUTINES FOR PASS 2
;RENUMBER REFERENCES.
RENUM: TLZA FL,RENUMS ;CLEAR FLAG FOR TEMP2 OUTPUT
RENUMX: TLO FL,RENUMS ;SET FOR TEMP2 OUTPUT
LDB B,C ;WE ARE PROMISED A DIGIT
SUBI B,"0" ;MAKE CHARACTER INTO DIGIT VALUE
PUSH P,C ;SAVE POINTER TO LAST DIGIT
RENM.0: ILDB A,C ;PICKUP NEXT CHARACTER
CAIE A,11 ;TEST FOR TAB
CAIN A," " ;OR BLANK
JRST RENM.0 ;GET ANOTHER
CAIN A,1 ;LINE CONTINUATION?
JRST RENM.0 ;YES. GET ANOTHER CHARACTER.
CAIL A,"0" ;LOOK FOR DIGIT
CAILE A,"9" ;SKIP IF DIGIT
JRST RENM.1 ;NOT ANY DIGIT
IMULI B,12 ;MULTIPLY
ADDI B,-"0"(A) ;AND ADD IN THE DIGIT
MOVEM C,0(P) ;SAVE POINTER TO LAST DIGIT
JRST RENM.0 ;GO BACK FOR MORE
RENM.1: POP P,C ;RESTORE POINTER TO LAST DIGIT
;SELECT A NEW NUMBER.
FINDN: MOVE A,NUMLAB ;LOAD NUMBER OF LABELS
ADD A,TABSP ;ADD TABLE BASE
FINDNX: SUBI A,1 ;BACKUP THE POINTER
CAMGE A,TABSP ;COMPARE WITH TABLE BASE
JRST FINDN0 ;OUT OF RANGE
HLRZ X,0(A) ;LOAD LABEL
CAME X,B ;ARGUMENT IN B
JRST FINDNX ;BACK AGAIN
TRNE FL,CREF ;GOT A LABEL
PUSHJ P,USE ;USE OF A LABEL FOR CREF
JRST FINDN1 ;RELABEL OBUF
FINDN0: TRO FL,URR ;UNRESOLVED REFERENCE
MOVEM B,URREF ;SAVE REFERENCE NUMBER FOR LATER
SKIPA X,B ;LOAD IT INTO X AND SKIP
FINDN1: HRRZ X,0(A) ;LOAD NEW NUMBER INTO X
PUSHJ P,JBUFF ;PLACE LABEL IN BUFFER
TLNN FL,RENUMS ;CHECK FLAG
POPJ P, ;RETURN - NOT DOING A FLOWCHART
MOVEI A,"," ;LOAD A WITH A COMMA
JRST PUTTM2 ;WRITE INTO TEMP 2 FILE FOR FLOWCHART
SUBTTL JBUFF
JBUFF: IDIVI X,12 ;RECURSIVE WISDOM
PUSH P,Y ;STACK REMAINDER
SKIPE X ;SKIP IF THAT'S ALL
PUSHJ P,JBUFF ;CALL SELF RECURSIVELY
POP P,A ;POP DIGIT INTO A
ADDI A,"0" ;MAKE IT A CHARACTER
IDPB A,D ;DEPOSIT IN OBUF
TLNE FL,RENUMS ;CHECK FLAG
PUSHJ P,PUTTM2 ;ALSO WRITE FOR FLOWCHART
POPJ P, ;RETURN
SUBTTL FLUSH THE STUFF THAT B POINTS TO.
FLUSH: AOS LINUM ;COUNT A NEW LINE NUMBER
SETZB COL,CONTS ;COLUMN AND CONTINUATION COUNT
SETZM OLDCOL ;COLUMN WHERE LAST DELIM SEEN
MOVE C,[POINT 7,BUFA] ;POINTER TO CARD OUTPUT BUFFER
TLZ FL,SHORTX ;FLAG OFF
MOVE A,B ;GET THE BYTE POINTER
ILDB A,A ;LOAD FIRST CHARACTER
CAIG A,14 ;IS THIS A SPECIAL CHARACTER
JRST FLU.5 ;DO SHORT LINE THING
MOVE W,(B) ;LOAD UP THE FIRST WORD
TRZ W,1 ;"but you don't know where its been"
PUSHJ P,CMNTST ;HAVE WE GOT A COMMENT?
SOSA LINUM ;YES DON'T COUNT COMMENTS AS LINES.(3-26-73)
CAMN W,ASC5SP ;OR ARE COLS 1-5 BLANK?
JRST FLU.0 ;COMMENT OR NO LABEL
AOS A,SNSEEN ;INCREMENT AND LOAD LABEL COUNT
CAMLE A,NUMLAB ;COMPARE TO NUMBER OF LABELS
PUSHJ P,INTCFN ;MORE THAN THERE WERE IN PASS 1
ADD A,TABSP ;ADD POINTER TO THE TABLE
TRNE FL,CREF ;ARE WE CREFING?
PUSHJ P,DEFINE ;DEFINE LABEL (PARAMETER IN A)
HRRZ Y,-1(A) ;PICK UP WHAT THIS BECOMES
PUSHJ P,CONVRT ;ARG IN Y. ASCII RETURNED IN A.
FLU.0: MOVEM B,FLUSVB ;SAVE THE CURRENT INPUT POINTER
FLU.1: ILDB A,B ;PICKUP CHARACTER
CAIN A,1 ;SPECIAL: PAD THE LINE NOW
JRST FLU04 ;FORCE LINE BREAK HERE
JUMPE A,FLU.6 ;END OF LINE
IDPB A,C ;WRITE CHARACTER IN BUFA
CAIN A,11 ;SPECIAL COUNT FOR TABS
TRO COL,7 ;MAKE TO (MULTIPLE OF 8)-1
ADDI COL,1 ;INCREMENT COLUMN COUNTER
PUSHJ P,DELIM ;ARE WE AT A DELIMITER?
JRST [MOVEM B,FLUSVB ;POINTS AT THIS DELIM
MOVEM C,SAVEC ;POINTS IN OUTPUT BUFFER
MOVEM COL,OLDCOL ;SAVE COLUMN NUMBER
JRST .+1] ;RETURN
CAIGE COL,110 ;COMPARE COLUMN VS MAX
JRST FLU.1 ;WE ARE OK
MOVE W,B ;MAY HAVE TO MAKE CONTINUATION
ILDB A,W ;TEST NEXT BYTE
JUMPE A,FLU.6 ;LUCK OUT. WE JUST MADE IT.
CAIN A,1 ;SPECIAL IF THIS IS ^A
JRST [MOVE B,W ;PUSH POINTER PAST IT
JRST FLU04] ;FLUSH AND CONTINUATION
SKIPG OLDCOL ;HAVE WE SEEN ANY DELIMS?
JRST [MOVEM COL,OLDCOL ;SET OLDCOL AS THIS COLUMN
MOVEM B,FLUSVB ;SAVE B AS FLUSVB
MOVEM C,SAVEC ;AND SAVE C
JRST .+1] ;THIS IS DEPRESSING
MOVE B,FLUSVB ;LOAD B WITH BYP PAST DELIM
MOVE COL,OLDCOL ;RELOAD COL
MOVE C,SAVEC ;RESTORE C TOO
FLU04: MOVEM B,FLUSVB ;SAVE POINTER TO LAST USED BYTE
PUSHJ P,PADDER ;PAD TO 80 COLS. ARGS: C COL.
MOVE B,FLUSVB ;POINTS TO CONTINUATION LINE
SUBI B,1 ;BACK UP 5 CHARACTERS
ADD B,[XWD 70000,0] ;MODIFY THE BYTE POINTER
JUMPGE B,.+2 ;SKIP NEXT IF NOT NEGATIVE
SUB B,[XWD 430000,1] ;BACKS PAST BOUNDARY.
;WE ARE SIX CHARACTERS BEFORE FLUSVB
MOVEM B,FLUSVB ;SAVE BYTE POINTER
MOVEI W,5 ;LOAD COUNT INTO W
MOVEI A," " ;LOAD BLANK INTO A
IDPB A,B ;DEPOSIT 5 TIMES
SOJG W,.-1 ;LOOP
MOVEI A,"%" ;SPECIAL CONTINUE MARK
PUSHJ P,PUTTM2 ;FOR THE FLOWCHART
AOS A,CONTS ;INCREMENT NEW CONTINUE COUNT
CAILE A,11 ;COMPARE TO 9
MOVEI A,1 ;REDUCE TO 1
MOVEM A,CONTS ;AND STORE AGAIN
ADDI A,"0" ;MAKE IT A DIGIT
IDPB A,B ;DEPOSIT IN CONTINUATION COLUMN
MOVE B,FLUSVB ;LOAD UP POINTER
MOVE C,[POINT 7,BUFA] ;ASSEMBLE OUTPUT LINE HERE
SETZB COL,OLDCOL ;COLUMN COUNT
JRST FLU.1 ;AND GO DO MORE.
FLU.5: TLO FL,SHORTX ;MARK SHORT LINE
SOS LINUM ;DON'T COUNT A CREF LINE NUMBER.
JUMPE A,FLU.6 ;DON'T DEPOSIT IF W IS NULL.
IDPB A,C ;DEPOSIT SPECIALS
FLU.6: PUSHJ P,PADDER ;RUSH OFF AND PAD LINE
POPJ P, ;THAT'S ALL FOLKS
SUBTTL ROUTINES TO BUILD CREF TABLE
COMMENT/
CREF TABLE FORMAT:
THE CREF USES TWO TABLES AND A SET OF LINKED LISTS.
THE TABLES ARE ALL ALLOCATED AT THE HI END OF CORE, ABOVE ALL
POSSIBLE IO BUFFERS.
TABLE 1
TABLE 1 IS BUILT DURING PASS 1. AS EACH NUMBERED STATEMENT IS
SEEN, THE COUNT NUMLAB IS INCREMENTED AND THE DATA WORD:
XWD ORIGINAL NUMBER, NEW NUMBER
IS ADDED TO TABLE 1.
THE BEGINNING ADDRESS OF TABLE 1 IS FOUND IN TABSP.
AT THE END OF PASS 1 THERE ARE ENTRIES FROM
(TABSP) THRU (TABSP)+(NUMLAB)-1, CORRESPONDING TO EACH LABEL DEFINED.
IF A CREF IS DESIRED THEN AT THE BEGINNING OF PASS 2 , ANOTHER
BLOCK OF NUMLAB WORDS IS RESERVED IMMEDIATELY FOLLOWING THE
DATA IN TABLE 1.
THE ADDRESS OF THE BEGINING OF TABLE 2 IS: (TABSP)+(NUMLAB).
TABLES 2 AND 3 ARE BUILT CORRESPONDING TO TABLE 1 SO THAT THE ADDRESS
OF THE ENTRY FOR THE I'TH LABEL (WHERE 1<=I<=(NUMLAB))
IS GIVEN BY:
TABLE 1 (TABSP)+I-1
TABLE 2 (TABSP)+(NUMLAB)+I-1
TABLE 3 (TABSP)+2*(NUMLAB)+I-1
FOR EACH LABEL, TABLE 2 IS THE FIRST ELEMENT IN THE
LIST OF PLACES WHERE THAT LABEL IS USED OR DEFINED.
TABLE 3 IS SIMILAR TO TABLE 2 EXCEPT THAT ALL USES OF
FORMAT LABELS AS FORMAT REFERENCES ARE REMOVED FROM TABLE 3.
IF ANY FORMAT IS A TRANSFER TARGET THEN SUCH USES WILL BE RECORDED.
THE ENTRY YOU GET FROM TABLE 2 WILL HAVE THE FORMAT:
XWD USE DATA,,LINK.
IF LINK ISN'T ZERO THEN LINK IS THE ADDRESS OF ANOTHER WORD THAT
CONTAINS THE SAME FORMAT OF DATA. 0 LINK STOPS THE LIST.
USE DATA IS SIMPLY THE CREF LINE NUMBER ON WHICH THIS LABEL
IS USED, OR IF BIT 0 IS SET THEN THE HALFWORD YOU GET BY ZEROING
BIT 0 IS THE CREF LINE NUMBER OF THE DEFINITION OF THE LABEL.
ENTRIES ARE ALWAYS ADDED AT THE FAR END OF THE LIST, SO THAT
BY SCANNING THE LIST IN ORDER YOU PRODUCE THE CREF IN STANDARD
ORDER.
DURING FLOWCHARTING, THESE LISTS ARE DESTROYED IN THE FOLLOWING MANNER:
WHEN A LABEL IS EITHER USED OR DEFINED THEN THE FIRST ENTRY IN
THE LIST (FOR THAT LABEL) IS REMOVED. WE CHECK AT THIS TIME
TO SEE THAT THE ENTRY REMOVED ACTUALLY CORRESPONDS TO THE
USE WE HAVE (I.E. DEFINITION OR REFERENCE).
WHEN THE LABEL IS DEFINED WE SET A FLAG IN ALL ENTRIES TO SAY THAT
THIS LABEL IS DEFINED ABOVE. THIS FLAG IS BIT 1 OF THE LIST ENTRY.
WHEN, AT LAST THE LIST BECOMES EMPTY, WE KNOW THAT NO MORE LINES
GOING UPWARDS HAVE TO BE DRAWN TO THAT LABEL.
/
DEFINE: PUSH P,A ;SAVE ARRAY ADDRESS IN STACK
ADD A,NUMLAB ;MAKE A POINTER TO TABLE 2
SKIPE W,-1(A) ;LOOK AT TABLE 2 ENTRY
JRST DEFIN1 ;NOT EMPTY. CHASE CHAINS
MOVE W,LINUM ;GET PRESENT LINE NUMBER
TRO W,400000 ;SET DEFINE BIT IN LINE NUMBER
HRLZM W,-1(A) ;STORE IN LEFT HALF OF TABLE 2
JRST DEFRET ;TO RETURN SEQUENCE
DEFIN1: HRRZ W,-1(A) ;LOAD POINTER TO NEXT LINK
JUMPE W,DEFIN2 ;FOUND THE LAST ONE
MOVEI A,1(W) ;FAKE THIS AS ONE BIGGER
JRST DEFIN1 ;SEARCH FOR NEXT LINK
DEFIN2: HLRZ W,-1(A) ;PICKUP LAST LINK
CAMN W,LINUM ;IS THIS A USE ON THIS VERY LINE?
TLOA FL,NEEDTP ;YES IT IS, SET FLAG
TLZ FL,NEEDTP ;NOT SUCH A NASTY USAGE
MOVSI W,400000 ;LOAD UP DEFINE BIT
TLNE FL,NEEDTP ;HAVE WE USE AND DEFINE BOTH HERE?
IORM W,-1(A) ;YES: THEN THE USE ENTRY IS FIRST
MOVE W,FREPTR ;GET ADDRESS OF FREE CORE
MOVEM W,CORREQ ;SAVE AS CORE SIZE REQUEST
PUSHJ P,GETCOR ;RUN OFF AND GET ENOUGH
HRRM W,-1(A) ;SAVE THIS ADDRESS AS LINK FIELD
MOVE A,LINUM ;LOAD THIS LINE NUMBER
TLZN FL,NEEDTP ;HAVE WE JUST DONE TRICK?
TRO A,400000 ;NOPE, SET THE DEFINE BIT
HRLZM A,0(W) ;STASH IT AWAY
AOS FREPTR ;INCREMENT FREE POINTER
DEFRET: TRNN FL,FLOW ;SKIP IF FLOWCHARTING
JRST POPA ;RETURN IF NO FLOWCHART
MOVE A,(P) ;RETRIEVE A FROM STACK
ADD A,NUMLAB ;ADD TO GET TO TABLE 2
ADD A,NUMLAB ;ADD TO GET TO TABLE 3
SKIPE W,-1(A) ;LOOK AT TABLE 3 ENTRY
JRST DEFIN3 ;NOT EMPTY AT THIS TIME
MOVE W,LINUM ;LOAD CURRENT LINE
TRO W,400000 ;TURN ON DEFINITION BIT
HRLZM W,-1(A) ;STUFF IT IN LIST
JRST POPA ;RETURN
DEFIN3: HRRZ W,-1(A) ;LOAD LINK
JUMPE W,DEFIN4 ;END OF LIST?
MOVEI A,1(W) ;LOAD A WITH LINK+1
JRST DEFIN3 ;LOOP THRU LIST
DEFIN4: HLRZ W,-1(A) ;LOAD LAST ENTRY
CAMN W,LINUM ;WAS THIS USE ON THIS LINE?
TLOA FL,NEEDTP ;YES. FLAG IT AND SKIP
TLZ FL,NEEDTP ;NO
MOVSI W,400000 ;LOAD MARKING BIT
TLNE FL,NEEDTP ;SPECIAL KLUGE?
IORM W,-1(A) ;YES
MOVE W,FREPTR ;GET ADDRESS OF FREE
MOVEM W,CORREQ ;SAVE AS NEEDED CORE AMOUNT
PUSHJ P,GETCOR ;MAKE SURE WE HAVE ENOUGH
HRRM W,-1(A) ;STUFF LINK
MOVE A,LINUM ;GET THE LINE NUMBER
TLZN FL,NEEDTP ;ZERO FLAG AND SKIP IF SET
TRO A,400000 ;SET DEFINE BIT
HRLZM A,0(W) ;SAVE NEW ITEM
AOS FREPTR ;POINT TO NEXT FREE
JRST POPA ;RETURN
USE: PUSH P,A ;SAVE A IN THE STACK
ADD A,NUMLAB ;MAKE POINTER TO TABLE 2
SKIPE W,0(A) ;IS THIS ENTRY EMPTY
JRST USE1 ;NOPE
MOVE W,LINUM ;GET LINE NUMBER
ADDI W,1 ;BUT WE WANT NEXT LINE
HRLZM W,0(A) ;STUFF IN TABLE
JRST USERET ;RETURN
USE1: HRRZ W,(A) ;PICK UP LINK
JUMPE W,USE2 ;END OF CHAIN
MOVE A,W ;MOVE LINK IN AS ADDRESS
JRST USE1 ;LOOP
USE2: HLRZ W,(A) ;GET LINE NUMBER WHERE THIS USED LAST
TRZ W,400000 ;CLEAR DEFINE BIT
SUB W,LINUM ;REMEMBER, WE REALLY ARE ON LINUM+1
JUMPG W,USERET ;WE ALREADY HAVE ENTRY FOR THIS LINE
MOVE W,FREPTR ;PICKUP FREE POINTER
MOVEM W,CORREQ ;SAVE FOR CORE REQUEST
PUSHJ P,GETCOR ;CHECK CORE
HRRM W,0(A) ;STUFF LINK IN LAST NODE
MOVE A,LINUM ;PICK UP THIS LINE NUMBER
ADDI A,1 ;ADD 1
HRLZM A,(W) ;STUFF IT IN NEW NODE
AOS FREPTR ;USE UP SOME FREE STORAGE
USERET: TRNE FL,FLOW ;SKIP IF NO FLOWCHART
TLNN FL,RENUMS ;SKIP IF NOT A FORMAT REF
JRST POPA ;RETURN
MOVE A,0(P) ;RETRIEVE FROM STACK
ADD A,NUMLAB ;POINTER TO TABLE2
ADD A,NUMLAB ;POINTER TO TABLE3
SKIPE W,(A) ;EMPTY?
JRST USE3 ;NOPE.
MOVE W,LINUM ;GET LINE NUMBER
ADDI W,1 ;LINUM IS # OF LAST LINE
HRLZM W,(A) ;STUFF AS THE BASE OF THE CHAIN
POPA: POP P,A ;RESTORE A FROM THE STACK
POPJ P, ;RETURN TO USER
USE3: HRRZ W,(A) ;GET LINK TO NEXT
JUMPE W,USE4 ;END OF LIST?
MOVE A,W ;NOPE SHUFFLE LINK
JRST USE3 ;SCAN CHAIN
USE4: HLRZ W,(A) ;GET LAST
TRZ W,400000 ;SHUT OFF DEFINE BIT
SUB W,LINUM ;WE ARE USING ON LINUM+1
JUMPG W,POPA ;USED ON THIS LINE BEFORE
MOVE W,FREPTR ;GET FREE POINTER
MOVEM W,CORREQ ;SAVE AS NEEDED AMOUNT
PUSHJ P,GETCOR ;BE SURE WE HAVE ENOUGH
HRRM W,(A) ;SAVE FREPOINTER AS LINK
MOVE A,LINUM ;GET PRESENT LINE
ADDI A,1 ;INCREMENT IT
HRLZM A,(W) ;SAVE IT
AOS FREPTR ;INCREMENT FREE COUNT
JRST POPA ;RETURN
SUBTTL PRINT THE CREF
DOCREF: SKIPG NUMLAB ;ANY LABELS DEFINED?
POPJ P, ;NO LABELS: NO CREF
PUSHJ P,CRFHED ;WRITE PAGE HEADING
SETZB C,REFLIN ;LET C POINT TO THE CURRENT LABEL
CREF1: CAML C,NUMLAB ;COMPARE IN TABLE BOUNDS
POPJ P, ;ALL DONE
LPCALL 3,ASCRLF ;WRITE NEW LINE
AOS W,REFLIN ;INCREMENT AND LOAD LINE COUNT
CAILE W,62 ;TEST FOR PAGE BOUNDARY
PUSHJ P,CRFHED ;DO PAGE HEADING
MOVE A,C ;LOAD THE INDEX
ADD A,TABSP ;ADD TABLE BASE
HRRZ W,(A) ;LOAD NEW LABEL NUMBER
PUSHJ P,PADNUM ;WRITE NEW LABEL
HLRZ W,(A) ;LOAD OLD LABEL
PUSHJ P,PADNUM ;WRITE OLD LABEL
SETZM REFCOL ;COLUMN NUMBER TO WHICH WE HAVE GOTTEN
ADD A,NUMLAB ;ADD TO MAKE POINTER TO TABLE 2
CREF2: SKIPN (A) ;TEST TO SEE IF STUFF
AOJA C,CREF1 ;NONE THERE GET ANOTHER
HLRZ W,(A) ;LOAD LINE NUMBER
PUSHJ P,PADNUM ;WRITE IT
HRRZ A,(A) ;LOAD LINK
SKIPN A ;ALL DONE?
AOJA C,CREF1 ;GET NEXT LINE
AOS W,REFCOL ;COUNT THAT LAST GUY
CAIGE W,15 ;MAXIMUM ON LINE?
JRST CREF2 ;WE ARE OK
SETZM REFCOL ;ZERO COLUMN
LPCALL 3,[BYTE(7)15,12,11,11] ;WRITE STUFF
AOS W,REFLIN ;COUNT A LINE
CAILE W,62 ;CHECK LIMIT
PUSHJ P,CRFHED ;WRITE HEADING
JRST CREF2 ;BACK FOR MORE
CRFHED: SETZM REFLIN ;ZERO LINE NUMBER
LPCALL 3,ASCRFF ;FORM FEED
LPCALL 3,CREFHD ;PAGE HEADING
POPJ P, ;RETURN
CREFHD: ASCIZ/
NEW OLD USE LINE NUMBERS # = DEFINITION LINE NUMBER
/
SUBTTL LINE PADDER.
; ARGUMENTS ARE COL, THE COLUMN POSITION, AND C A BYTE POINTER.
; PAD TO COLUMN 72 WITH BLANKS, ADD 4 LETTER I.D AND 4 DIGITS.
PADDER: SKIPG SEQINC ;SKIP IF WE'RE SEQUENCING
JRST PADD.4 ;NOT SEQUENCING
MOVEI A," " ;LOAD A BLANK INTO A
PADD.1: CAIL COL,110 ;CHECK COLUMN POSITION
JRST PADD.2 ;AT BOUNDARY
IDPB A,C ;STUFF THE CHARACTER
AOJA COL,PADD.1 ;LOOP BACK
PADD.2: MOVE W,[POINT 7,NAME] ;LOAD POINTER TO THE NAME
ILDB A,W ;RUMMAGE THRU IT
JUMPE A,PADD.3 ;ALL DONE
IDPB A,C ;STUFF IT
JRST PADD.2+1 ;LOOP BACK
PADD.3: MOVE X,SEQINC ;LOAD UP THE SEQUENCE INCREMENT
ADDB X,SEQ ;ADD TO THE SEQUENCE NUMBER
PUSHJ P,SEQOUT ;WRITE THE SEQUENCE NUMBER
PADD.4: MOVE W,[POINT 7,ASCRLF] ;LOAD POINTER TO CRLF
ILDB A,W ;LOAD
IDPB A,C ;DEPOSIT
JUMPN A,.-2 ;LOOP UNTIL AFTER NULL
TRNN FL,CREF ;ARE WE DOING A CREF?
JRST PADD.5 ;NOPE
MOVE W,LINUM ;LOAD LINE NUMBER
CAMG W,LASTNM ;COMPARE TO MAX
TDZA W,W ;SET W TO ZERO AND SKIP
MOVEM W,LASTNM ;SAVE THIS AS LAST NUMBER
PUSHJ P,PADNUM ;RUSH OUT AND PAD THE NUMBER
PADD.5: MOVE C,[POINT 7,BUFA] ;LOAD POINTER TO THE OUTPUT BUFFER
SETZ COL, ;ZERO COLUMN COUNT
TRNE FL,FLOW ;SKIP IF NO FLOW
PUSHJ P,PCHFLO ;WRITE FLOWCHART FILE
PUSHJ P,PNCHIT ;WRITE PUNCH AND LISTING
POPJ P, ;RETURN
PADNUM: JUMPN W,PADNM1 ;JUMPIF ARGUMENT IS NOT ZERO
LPCALL 3,[ASCIZ/ /] ;FOR ZERO ARGUMENT, DO 5 BLANKS AND TAB
POPJ P, ;RETURN TO CALLER
PADNM1: MOVEI Z,5 ;5 CHARACTERS IN OUTPUT STREAM
PUSH P,W ;SAVE W ON STACK: SAVE SIGN BIT
TRZ W,400000 ;ZAP MARK BIT
PUSHJ P,PADNM2 ;CONVERT TO 5 CHARACTERS AND OUTPUT
POP P,W ;RESTORE W
TRNE W,400000 ;TEST THE BIT
LPCALL 3,[ASCIZ/#/] ;IT'S ON: TYPE SHARP SIGN
LPCALL 3,[ASCIZ/ /] ;PRINT TAB
POPJ P, ;RETURN
PADNM2: IDIVI W,12 ;RECURSIVE DECIMAL PRINTER
PUSH P,X ;SAVE REMAINDER
SUBI Z,1 ;DECREMENT CHARACTER COUNT
SKIPE W ;IS QUOTIENT ZERO?
PUSHJ P,PADNM2 ;NOPE. CALL SELF RECURSIVELY
JUMPE Z,PADNM3 ;WRITE NEXT IF THIS IS ZERO
LPCALL 3,[ASCIZ/ /] ;WRITE A BLANK
SOJG Z,.-1 ;AND COUNT UNTIL Z=0
PADNM3: POP P,W ;GET NUMBER FORM STACK
ADDI W,"0" ;CONVERT TO ASCII
LPCALL 1,W ;WRITE ON LINE
POPJ P, ;RETURN
SUBTTL WEIRD ROUTINES
SEQOUT: CAIGE X,144*144 ;ARG IN X POINTER IN C.
JRST SEQUT1 ;ARGUMENT IS OK
BCALL 3,[ASCIZ/
WRAP AROUND IN SEQUENCE NUMBERS
/] ;WRITE WARNING
MOVE X,SEQINC ;LOAD SEQUENCE INCREMENT
MOVEM X,SEQ ;SET SEQUENCE NUMBER TO THIS VALUE
SEQUT1: IDIVI X,1750 ;GET FIRST DIGIT
ADDI X,"0" ;MAKE ASCII
IDPB X,C ;STUFF
MOVE X,Y ;RELOAD X WITH REMAINDER
IDIVI X,144 ;DIVIDE
ADDI X,"0" ;MAKE DIGIT
IDPB X,C ;PLUNK
MOVE X,Y ;SHUFFLE
IDIVI X,12 ;DIVIDE
ADDI X,"0" ;MAKE ASCII
IDPB X,C ;STUFF
ADDI Y,"0" ;MAKE ASCII
IDPB Y,C ;STUFF
POPJ P, ;RETURN
CONVRT: CAILE Y,<144*1750>-1 ;ARGUMENT IN Y.
JRST LINC.L ;LABEL INCREMENT TOO LARGE
MOVEI A,3 ;LOAD WITH MAJIC CHARACTER
PUSHJ P,PUTTM2 ;STUFF IN TEMP2
PUSHJ P,CNVRT1 ;RUSH OFF AND MAKE ASCII
MOVEI A,3 ;LOAD MAJIC
PUSHJ P,PUTTM2 ;STUFF FOR FLOWCHART
POPJ P, ;RETURN TO CALLER
CNVRT1: MOVEI W,5 ;HAVE TO MAKE 5 CHARACTERS
MOVE X,[POINT 7,0(B)] ;DEPOSIT IN SOURCE
CNVRT2: IDIVI Y,12 ;DIVIDE
PUSH P,Z ;STACK REMAINDER
SUBI W,1 ;DECREASE COUNT
SKIPE Y ;SKIP IF QUOTIENT ZERO
PUSHJ P,CNVRT2 ;RECURSIVE CALL
JUMPE W,CNVRT3 ;GO OUTPUT A DIGIT
MOVEI Z," " ;LOAD BLANK
IDPB Z,X ;STUFF IN LINE
SOJG W,.-1 ;UNTIL COUNT IS ZERO
CNVRT3: POP P,A ;GET A DIGIT FROM STACK
ADDI A,"0" ;MAKE ASCII
PUSHJ P,PUTTM2 ;WRITE ON TEMP2
IDPB A,X ;WRITE IN LINE
POPJ P, ;RETURN
;DELIM SKIP RETURN IF CHARACTER IS NOT IN THE TABLE
;
DELIM: MOVSI X,-DLIMTL ;TABLE LENGTH
CAME A,DLIMT(X) ;LOOK FOR CHARACTER
AOBJN X,.-1 ;NOPE
JUMPL X,CPOPJ ;GOT ONE IF X<0
JRST CPOPJ1 ;NOPE NOT A DELIM
DLIMT: "+"
"="
"-"
"*"
")"
"/"
","
SDEF DLIMTL,.-DLIMT
SUBTTL I/O ROUTINES FOR PASS 2
PUTTM2: TRNE FL,FLOW ;ARE WE DOING FLOWCHART
PUSHJ P,PUTDK2 ;YES WE ARE
POPJ P, ;RETURN
READA: MOVE Y,[POINT 7,IBUF] ;POINTER WHERE WE DEPOSIT STUFF
MOVEM Y,SAVEME ;SAVE THIS POINTER
PUSHJ P,GETDK1 ;GET A CHARACTER
PUSHJ P,UEOF ;THIS IS NOT SUPPOSED TO HAPPEN
PUSHJ P,PUTTM2 ;WRITE THE CHARACTER FOR FLOWCHART
SUBI A,"@" ;DECREASE TO GET KEY VALUE
MOVEM A,KEY ;SAVE AS KEY
READ2: PUSHJ P,GETDK1 ;GET MORE
PUSHJ P,UEOF ;NOT SUPPOSED TO EOF
CAIN A,1 ;SPECIAL MARK BEFORE A CONTINUED LINE
JRST RD2.1 ;PASS AS A BLANK CHARACTER...
CAIN A,15 ;RETURN?
JRST READ2 ;IGNORE RETURN
CAIE A,11 ;TAB?
CAILE A,14 ;NOT TAB: SPECIAL OF SOME SORT?
JRST RD2.1 ;UNSPECIAL OR TAB
JRST READ3 ;SPECIAL TERMINATOR
RD2.1: IDPB A,Y ;STUFF CHARACTER
CAIE A," " ;IS IT BLANK?
CAIN A,11 ;OR TAB
JRST READ2 ;YES BLANK-TAB
CAIE A,1 ;SKIP IF LINE-CONTINUE MARK.
MOVEM Y,SAVEME ;SIGNIFICANT CHARACTER: SAVE POINTER
JRST READ2 ;BACK FOR MORE
READ3: MOVE B,SAVEME ;LOAD POINTER TO LAST SIGNIFICANT CHARACTER
CAME B,[POINT 7,IBUF] ;SAME AS ORIGINAL?
JRST READ5 ;NO. WE MUST HAVE SOME REAL TEXT HERE.
SETZ B, ;ZAP B
TRNE FL,FLOW ;DOING FLOW?
DPB B,DK2BUF+1 ;YES: WIPE THE LAST CHARACTER
TRNE FL,BSW ;ARE WE DELETING BLANK LINES?
JRST READA ;YES!
READ4: CAIE A,12 ;DID WE HAVE A LINE FEED
IDPB A,Y ;NOPE. STUFF IT
SETZ A, ;ZERO REGISTER
IDPB A,Y ;AND STUFF IT
POPJ P, ;RETURN
READ5: MOVE Y,SAVEME ;CLOBBER THIS INSTRUCTION TO
;PRESERVE TRAILING BLANKS
JRST READ4 ;
;ROUTINE TO WRITE UPDATE FILE:
PNCH: TRNE FL,PUNCH ;ARE WE PUNCHING?
PUSHJ P,PUTCDP ;WRITE ON PUNCH FILE
POPJ P, ;RETURN
PCHFLO: ILDB A,C ;LOAD CHARACTER
ADDI COL,1 ;COUNT COLUMN
JUMPE A,CPOPJ ;NULL ENDS LINE
TLNE FL,SHORTX ;SHORT UP?
JRST PCHFLO ;SHORT LINE. DO NOT WRITE
CAIN A,11 ;IS IT A TAB
PUSHJ P,PNCHIX ;YES IT IS.
PUSHJ P,PUTTM2 ;NO WRITE IT
JRST PCHFLO ;BACK FOR MORE
PNCHIX: MOVEI A," " ;TAB SEEN. LOAD A BLANK
TRNN COL,7 ;SKIP UNLESS TAB STOP?
POPJ P, ;END OF TAB STUFF
PUSHJ P,PUTTM2 ;WRITE ON TEMP 2
AOJA COL,.-3 ;BACK FOR MORE
PNCHIT: MOVE C,[POINT 7,BUFA] ;GET POINTER TO LINE
ILDB A,C ;GRAB FIRST
SKIPN SEQINC ;SKIP IF SEQUENCING
PUSHJ P,CMNTST ;SKIP IF NOT SEQ AND NOT COMMENT
JRST PCHALL ;COMMENT OR CARD IMAGES
TLNE FL,SHORTX ;SHORT LINE?
JRST PCHALL ;YES, WRITE ALL
MOVE B,ASC5SP ;LOAD 5 BLANKS
CAMN B,BUFA ;COMPARE TO MEMORY
JRST PCHTAB ;EQUALS, PUNCH A TAB
MOVEI B,5 ;SEE 5 CHARACTERS
PCHSB: CAIE A," " ;WE HAVE RIGHT JUST. NUMBER
JRST PCHNUM ;NOT BLANK MUST BE DIGIT
ILDB A,C ;BLANK. GET NEXT
SOJG B,PCHSB ;SKIP BLANKS
PUSHJ P,INTCFN ;LOGICAL LOSSAGE
PCHNUM: LPCALL 1,A ;WRITE DIGIT
PUSHJ P,PNCH ;PUNCH DIGIT
ILDB A,C ;GET NEXT
SOJG B,PCHNUM ;BACK FOR MORE
MOVEI A,11 ;LOAD TAB THERE
JRST PCHALL ;PUNCH THE REST OF IT
PCHTAB: MOVEI A,11 ;LOAD A TAB
LPCALL 1,A ;LIST
PUSHJ P,PNCH ;PUNCH IT
ADDI C,1 ;PUSH POINTER TO COLUMN 6
LDB A,C ;GRAB COLUMN 6
CAIE A," " ;LOOK FOR BLANK OR
CAIN A,"0" ;ZERO
ILDB A,C ;SKIP PAST A BLANK OR 0
PCHALL: LPCALL 1,A ;LIST
PUSHJ P,PNCH ;PUNCH
ILDB A,C ;GET MORE
JUMPN A,PCHALL ;LOOP ON NOT NULL
POPJ P, ;RETURN
SUBTTL FLOWCHART STUFF
DOFLOW: CLOSE DSK2, ;CLOSE DISK CHANNEL
STATZ DSK2,740000 ;CHECK OUTPUT STATUS
PUSHJ P,DDE ;LOSE
RELEAS DSK2, ;GIVE UP THE CHANNEL
MOVEM P,SAVEPD ;SAVE STACK DEPTH
INIT DSK2,1 ;GRAB THE CHANNEL
SIXBIT /DSK/ ;DISK. MODE 1. CHANNEL DSK2
XWD 0,DK2BUF ;INPUT ONLY
PUSHJ P,NODSK ;LOSE
MOVE A,FMTFF ;GET ADDRESS FOR BUFFERS
EXCH A,JOBFF ;SWAP WITH JOBFF
INBUF DSK2,2 ;ASK FOR INPUT BUFFERS
MOVEM A,JOBFF ;RESTORE JOBFF
MOVE A,FMTNAM ;LOAD FILE NAME
MOVSI B,'TMP' ;AND EXTENSION
SETZB C,D ;DEFAULT PPN
LOOKUP DSK2,A ;SELECT FILE FOR INPUT
PUSHJ P,SFLU ;LOSE
SKIPE ERRCNT ;ANY SOURCE ERRORS?
JRST FLOWRT ;YES: DON'T DO FLOWCHART
TLO FL,FLOWP!NEEDTP!FALL ;SET FLAGS
LPCALL 3,ASCRFF ;NEW PAGE
MOVEI A,BLANK ;LOAD A BLANK
MOVEI B,COLCEN-8 ;THE NUMBER OF BLANKS TO WRITE
LPCALL 1,A ;WRITE A BLANK
SOJG B,.-1 ;REPEAT UNTIL GROKKING IS FULL
LPCALL 3,[ASCIZ/<Entry: /] ;WRITE HEADING
LPCALL 3,NAMEX ;FIRST LINE, NAME
LPCALL 3,[ASCIZ/>
/] ;REST OF THE FIRST LINE
PUSHJ P,DBLANK ;BLANK THE LINE BUFFER
MOVEI A,DWNARR ;LOAD DOWNARROW
MOVEI B,COLCEN ;INTO THE CENTER
PUSHJ P,DEPCHR ;COLUMN OF THE LINE
PUSHJ P,PRNTLB ;COMPRESS AND WRITE
LPCALL 3,LINEBZ ;WRITE AGAIN
TLZ FL,NEEDBT+NOLOAD ;CLEAR FLAGS
SETZM KEY ;ZERO KEY
SETZM RCOLS ;ZERO RCOLS AND LCOLS ARRAYS
MOVE A,[XWD RCOLS,RCOLS+1] ;SET UP BLT POINTER
BLT A,BLTSTP ;AND BLT THRU LCOLS
DOFLO1: PUSHJ P,TOPBOT ;GO DO THE WORK
JRST DOFLO1 ;LOOP
MOVEI B,%LCMAX-1 ;LOOK THRU LCOLS
SKIPE A,LCOLS(B) ;...
PUSHJ P,LWARN ;WARNING ABOUT FLOW LOSSAGE
SOJGE B,.-2 ;LOOP THRU ALL
MOVEI B,%RCMAX-1 ;LOOK AT RIGHT
SKIPE A,RCOLS(B) ;...
PUSHJ P,RWARN ;WRITE ERRORS
SOJGE B,.-2 ;LOOP
FLOWRT: MOVE P,SAVEPD ;RESTORE STACK TO OLD DEPTH
CLOSE DSK2, ;CLOSE SCRATCH CHANNEL
SETZB A,B ;ZERO THE FILE NAME
SETZB C,D ;ETC
RENAME DSK2,A ;DELETE FILE
JFCL ;IGNORE DELETE FAILURE
TLZ FL,FLOWP ;NOT FLOWCHARTING ANY MORE
RELEAS DSK2, ;GIVE UP THIS CHANNEL
POPJ P, ;RETURN TO USER
LWARN: BCALL 3,LOSSM ;TYPE LOSSAGE MESSAGE
BCALL 3,[ASCIZ/ open DO loop /]
LWARN1: PUSH P,B ;SAVE B
MOVM A,A ;MAKE SURE ARGUMENT IS POSITIVE.
PUSHJ P,DECPB ;PRINT ON BOTH
POP P,B ;RESTORE B
BCALL 3,ASCRLF ;WRITE CRLF
AOS ERRCNT ;COUNT AN ERROR
POPJ P, ;RETURN
RWARN: BCALL 3,LOSSM
BCALL 3,[ASCIZ/ unresolved transfer /]
JRST LWARN1
LOSSM: ASCIZ /Forflo internal error while flowcharting: /
SUBTTL TOPBOT
; THIS ROUTINE DECIDES WHEN TO PRINT A BOX TOP, BOX BOTTOM ETC.
; WHEN IT DECIDES TO DO A TOP OR BOTTOM IT WILL WRITE IT AND
; IN GENERAL SUCK UP THE NEXT SOURCE LINE INTO NLBUF
TOPBOT: TLON FL,NOLOAD ;SET NOLOAD AND SKIP IF IT HAS BEEN SET
PUSHJ P,LINLOD ;OFF AND LOAD A LINE.
TLNE FL,NEEDTP ;ARE WE BEING FORCED TO DO TOP?
JRST TOPDO ;YES: GO OFF AND DO THE TOP,
TLNE FL,NEEDBT ;ARE WE FORCING A BOTTOM?
JRST BOTDO ;FORCE A BOTTOM, BUT CHECK THAT LINE
;IS NOT CONTINUATION
; WE HAVE A LINE; WE ARE IN THE MIDDLE OF A BOX,
; AND WE MUST DECIDE IF IT IS TIME TO END THE BOX WE ARE DOING NOW.
; WE END THE PRESENT BOX IF
; 1. THE LINE JUST LOADED IS LABELED (BUT NOT A FORMAT)
; 2. THE LINE JUST LOADED IS EITHER STOP, END OR RETURN.
; 3. THE LINE JUST LOADED IS A DO
SKIPLE STMTNO ;SKIP IF STATEMENT IS UNLABELED
JRST BOTDO ;LABELED STMT: NEED A BOTTOM
MOVE A,KEY ;LOAD THE KEY FOR THIS STATEMENT
JUMPL A,BOTDO ;END STMT NEXT. PUT IN A BOTTOM
;NOTE FALL IS NOT CLEARED UNTIL
;AFTER THE END STMT IS SLAPPED INTO
;THE OUTPUT STRING
CAIN A,3 ;IS IT A DO?
JRST BOTDO ;YES FORCE BOTTOM
CAILE A,16 ;LOOK FOR SPECIALS THAT WE FORCE
CAILE A,20 ;SKIP IF NEED FORCE
JRST .+2 ;ORDINARY
JRST BOTDO ;STOP OR RETURN (OR CALL EXIT)
; APPARENTLY WE DON'T HAVE TO PUT OUT A BOX BOTTOM. COPY THE CONTENTS OF
; NLBUF INTO LINEBF AND DUMP THE LINE. ASSUME THAT NLBUF IS THE LINE OF
; INTEREST AND LINEBF IS FREE. WE SET UP THE OUTPUT LINE AND PRINT IT.
; THIS ROUTINE MAY SET NEEDBT. IT WILL CALL NOUTCP.
PUSHJ P,OUTFLO ;CHECK FOR ANY OUTTRANSFER
JRST TOPBOT ;LOOP BACK FOR MORE
BOTDO: SKIPGE STMTNO ;ARE WE IN CONTINUATION LINE?
JRST [PUSHJ P,NOUTCP ;CAN'T DO IT YET SINCE WE ARE
TLO FL,NEEDBT ;IN A CONTINUATION STMT
POPJ P,] ;RETURN TO GUY
TLO FL,NEEDTP ;DOING THE BOTTOM. SET TO NEED TOP SOON
MOVEI A,USCORE ;LOAD UNDERSCORE CHARACTER
MOVEI B,%LCOLS+4 ;DEPOSIT HERE FOR 74 COLUMNS
PUSHJ P,DEPCHR ;STUFF IN HERE (BYTE POINTER IN B)
MOVEI C,111 ;WE WANT TO PUT IN 73 MORE
IDPB A,B ;DEPOSIT
SOJG C,.-1 ;BACK FOR A TOTAL OF 74 USCORES
PUSHJ P,NOUTCX ;OUTPUT LINE, SORT OF
TLZ FL,NEEDBT ;SHUT OFF NEED BOTTOM FLAG
MOVEI B,%LCOLS+3 ;BLANKS HERE NOW
MOVEI A," " ;LOAD BLANK
PUSHJ P,DEPCHR ;DEPOSIT THE FIRST
MOVEI C,113 ;CLEARING UNDER THE BOX
IDPB A,B ;STUFF
SOJG C,.-1 ;BACK FOR MORE
MOVEI A,DWNARR ;LOAD DOWNARROW
TLNN FL,FALL ;IF FALL IS OFF THEN
MOVEI A,BLANK ;BLANK INSTEAD OF DOWN ARROWS
MOVEI B,COLCEN ;INTO CENTER COLUMN
PUSHJ P,DEPCHR ;PLUNK
PUSHJ P,PRNTLB ;COMPRESS LINE AND PRINT
LPCALL 3,LINEBZ ;WRITE AGAIN
SKIPGE KEY ;TEST KEY
TLNE FL,NOLOAD ;MUST BE EOF
POPJ P, ;RETURN TO WORLD
JRST CPOPJ1 ;END OF EVERYTHING
;HERE TO PUT OUT A BOX TOP.
TOPDO: SKIPGE A,STMTNO ;HAVE WE A STATEMENT NUMBER
PUSHJ P,INTCFN ;TOP REQUEST BEFORE CONTINUATION LINE
SKIPE A ;SKIP IF NO LABEL
PUSHJ P,INFLO ;GRAB INCOMING FLOW LINES.
PUSHJ P,PRNTLB ;COMPRESS AND PRINT
LPCALL 3,LINEBZ ;WRITE AGAIN
MOVEI A,USCORE ;UNDERSCORE FOR BOX TOP
MOVEI C,111 ;A TOTAL OF 74 OF THEM
MOVEI B,%LCOLS+3 ;WE START HERE
IFG STANSW,< ADDI B,1 ;EXCEPT WHERE WE HAVE UNDERLINE>
PUSHJ P,DEPCHR ;STUFF THE FIRST
IDPB A,B ;STUFF
SOJG C,.-1 ;COUNT
IFE STANSW,< IDPB A,B
IDPB A,B ;KLUGE FOR NO UNDERLINE>
PUSHJ P,PRNTLB ;COMPRESS AND WRITE BOXTOP.
MOVEI A,VBAR ;NOW LOAD VBAR
MOVEI B,%LCOLS+3 ;DEPOSIT FIRST ONE VERTICAL
MOVEI C,111 ;COUNT
PUSHJ P,DEPCHR ;DEPOSIT VBAR
MOVEI A,BLANK ;BLANK NOW
IDPB A,B ;STUFF
SOJGE C,.-1 ;COUNT
MOVEI A,VBAR ;LOAD BAR
IDPB A,B ;STUFF
PUSHJ P,PRNTLB ;COMPRESS AND WRITE
TLZ FL,NEEDTP ;SHUT OFF FLAG
; NOW I OUTPUT THE PRESENT CONTENTS OF NLBUF AND MARK NOLOAD OFF.
; I LOOK AT THE LINE BEING OUTPUT TO DETERMINE IF I NEED A BOX BOTTOM
; IMMEDIATELY FOLLOWING IT.
MOVE A,KEY ;LOAD KEY VALUE
JUMPL A,TOPDO0 ;HAVE TO DO IT FOR END
CAIL A,17 ;CHECK KEY TYPE
CAILE A,20 ;SKIP IF 15-16
JRST OUTFLO ;KEYS 0-14. CHECK OUT-TRANSFERS
TOPDO0: TLO FL,NEEDBT ;NEED A BOTTOM AFTER THIS
TLZ FL,FALL ;FALL IS OFF TOO
JRST OUTFLO ;DO OUT-TRANSFERS.
SUBTTL OUTFLO TRACE OUT TRANSFERS
OUTFLO: MOVE A,KEY ;LOAD KEY VALUE
CAIE A,21 ;CALL?
CAIN A,10 ;READ?
JRST OUTFO0 ;YES: CHECK OUTER REFERENCE
CAIL A,3 ;CHECK FOR RANGE
CAILE A,5 ;SKIP IF 3,4,5
JRST OUTFLX ;ORDINARY
OUTFO0: SKIPLE REFCT ;TEST REFERENCE COUNT
JRST OUTFO1 ;WE HAVE WORK TO DO
CAIN A,4 ;SKIP UNLESS A GOTO STATEMENT
TLZ FL,FALL ;SHUT OFF FALL AT AN ASSIGNED GOTO
OUTFLX: SOSGE A,REFCT ;PICKUP REFERENCE COUNT
JRST NOUTCP ;ALL DONE. CALL AND RETURN
MOVE B,JREF(A) ;LOAD THE REFERENCE
PUSHJ P,UNUSE ;DELETE THE LABEL
JRST OUTFLX ;LOOP FOR MORE
OUTFO1: TLO FL,NEEDBT ;SET FLAG. WE'LL NEED BOTTOM AFTER THIS
PUSHJ P,NOUTC1 ;COPY BUFFER TO OUTPUT LINE
PUSHJ P,NOUTC2 ;SETUP STUFF
MOVE A,KEY ;LOAD KEY TYPE
CAIE A,3 ;DO LOOP?
JRST OUTFO2 ;NOT A DO LOOP. IS 'IF' OR 'GO TO'
PUSHJ P,FFLCOL ;GET ME A COLUMN ON THE LEFT SIDE
MOVE B,JREF ;LOAD FROM REFERENCE TABLE
PUSHJ P,UNUSE ;DELETE THIS LABEL USE FROM CREF TABLE
MOVNM B,LCOLS(A) ;SAVE NEGATIVE OF TARGET IN LEFT COLS
CAIL A,%LCOLS ;ARE WE IN THE REAL COLUMNS?
JRST LIMAG ;NO WE ARE IN LEFT IMAGINARIES
MOVEI C,1(A) ;WRITE RGTARR FOR COLS C THRU %LCOLS+2
MOVEI A,CHARO ;LOAD JOINT INTO A
MOVE B,C ;LOAD DESIRED COLUMN
PUSHJ P,DEPCHR ;STUFF THE JOINT
MOVEI A,RGTARR ;LOAD RIGHT ARROW
IDPB A,B ;STUFF
CAIGE C,%LCOLS ;DONE ENOUGH? (NOTE C IS 1 TOO SMALL)
AOJA C,.-2 ;NOPE, KEEP IT UP
LPBRK: MOVEI A,">" ;LOAD POINTY BRACKET
IDPB A,B ;STUFF IN COLUMN %LCOLS+2
JRST PRNTLB ;WRITE LINE BUFFER AND RETURN
LIMAG: MOVEI B,%LCOLS+1 ;LOAD IMAGINARY NUMBER
MOVEI A,CHARO ;JOINT CHARACTER
PUSHJ P,DEPCHR ;STUFF IT
JRST LPBRK ;STUFF THE POINTY BRACKET
; FOR GOTO AND ARITHMETIC IF WE DECIDE THE FLOW LINES AND WHETHER FLOW
; CAN FALL THRU THE BOX BOTTOM.
; THE FALL THRU DECISION IS MADE HERE, WHILE EVERYTHING
; ELSE IS POSTPONED UNTIL LATER, WHERE THE LOGICAL IF WITH GOTO
; CONSEQUENCE PATH JOINS US.
OUTFO2: CAIN A,4 ;CHECK KEY VALUE OF THIS GUY
TLZ FL,FALL ;THIS IS ARITHMETIC IF OR SOME GOTO.
;ASSUME NO FALL.
;SAVE JREF DATA IN IBUF AND REFCT IN REFCTX
SETZM REFCTX ;COUNT OF REAL OUT-TRANSFERS
REFUSE: SOSGE C,REFCT ;DECREMENT COUNT OF JREF.
JRST OTF2.1 ;DONE.
MOVE B,JREF(C) ;LOAD LABEL NUMBER.
AOS C,REFCTX ;GET INDEX TO IBUF
MOVEM B,IBUF-1(C) ;STORE LABEL
PUSHJ P,UNUSEA ;REMOVE LABEL FROM CREF TABLES
SOSA C,REFCTX ;OOPS. WE REALLY CAN FALL FOR THIS.
JRST REFUSE ;AND LOOP.
TLO FL,FALL ;WE CAN FALL FOR THIS.
JRST REFUSE
OTF2.0: PUSHJ P,PRNTLB ;PRINT THIS LINE: LEAVE ROOM FOR CONT.
PUSHJ P,NOUTC1 ;REINITIALIZE THE
PUSHJ P,NOUTC2 ;LINE BUFFER
OTF2.1: PUSHJ P,LINLOD ;LOAD THE NEXT LINE TO PEEK AT
TLO FL,NOLOAD ;MARK FLAG: DON'T LOAD OVER THIS
MOVE A,STMTNO ;HAVE WE GOT A CONTINUATION?
JUMPL A,OTF2.0 ;CONTINUATION LINE. GO WRITE THIS LINE
; WE MUST INITIATE AN OUTFLOW LINE FOR (REFCTX) DISTINCT DESTINATIONS.
; FOR EACH LINE, WE SELECT A FLOW COLUMN AND DRAW A PATH TO THAT COLUMN,
; AND OUTPUT THE BUFFER. THEN WE BLANK THE LINE AND CONTINUE
OUTFO4: MOVE D,REFCTX ;LOAD THE COUNT OF OUT TRANSFERS
JUMPE D,PRNTLB ;IF NONE THEN PRINT BUFFER.
OUTFO5: MOVE C,IBUF-1(D) ;LOAD A TARGET INTO C
MOVEI B,%RCMAX-1 ;SELECT A COLUMN: LOAD MAXIMUM INDEX
MOVM A,RCOLS(B) ;LOAD MAGNITUDE OF OCCUPANT
CAMN A,C ;COMPARE
JRST RCSEL2 ;WE HAVE ONE
SOJGE B,.-3 ;DECREASE B AND TRY AGAIN
PUSHJ P,FFRCOL ;WE SEEK A VIRGIN COLUMN
MOVEM C,RCOLS(A) ;MARK COLUMN IN USE
MOVE B,A ;MOVE THE INDEX TO B
RCSEL2: CAIL B,%RCOLS ;ARE WE IN A REAL COLUMN?
JRST RIMAG ;NO: IN A RIGHT SIDE IMAGINARY
ADDI B,121+%LCOLS ;MAKE IT INTO A COLUMN NUMBER
MOVEI C,-1(B) ;SAVE B-1 IN C.
MOVEI A,CHARO ;LOAD A WITH THE JOINT CHARACTER
PUSHJ P,DEPCHR ;STUFF IT IN COLUMN B.
MOVEI A,">" ;STUFF ARROW HEAD
MOVE B,C ;IN COLUMN B-1
PUSHJ P,DEPCHR ;.. STUFF IT
MOVEI A,RGTARR ;LOAD A WITH RIGHT ARROW CHARACTER
CAILE C,117+%LCOLS ;ARE WE BACK FAR ENOUGH?
SOJA C,.-4 ;NOPE. LOOP. COLS 91 TO B-2 FILLED
JRST RCSEL3 ;LOOP AROUND IMAGINARY CRUFT
RIMAG: MOVEI A,RGTARR ;DOING RIGHT ARROW
MOVEI B,117+%LCOLS ;COLUM TO START AT
PUSHJ P,DEPCHR ;DEPOSIT A CHARACTER
MOVEI C,%RCOLS ;NUMBER OF TIMES TO DEPOSIT
IDPB A,B ;STUFF IT
SOJG C,.-1 ;UP TO RIGHT MARGIN-1
MOVEI A,">" ;LOAD A POINTY ONE
IDPB A,B ;STUFF IT AS THE LAST
RCSEL3: PUSHJ P,PRNTLB ;COMPRESS AND WRITE LINE
MOVEI A,BLANK ;BLANK COLUMNS %LCOLS+4 - %LCOLS+^D77
MOVEI B,%LCOLS+4 ;FIRST ONE TO BLANK
PUSHJ P,DEPCHR
MOVEI C,110 ;COUNT OF NUMBER TO DEPOSIT
IDPB A,B ;STUFF IT
SOJGE C,.-1 ;LOOP
PUSHJ P,NOUTC2 ;FIX THE REST OF THE LINE
MOVE B,IBUF-1(D) ;LOAD THIS OUTTRANSFER LABEL
PUSHJ P,FINDEC ;GET THE ADDRESS OF TABLE2 ENTRY
SKIPN (A) ;ARE WE AT THE END OF CREF LIST?
PUSHJ P,MAKFRE ;YES: FREE THIS LABEL'S COLUMN
SOJG D,OUTFO5 ;DECREASE COUNT OF OUTLABELS AND JUMP
POPJ P, ;NONE LEFT. RETURN.
SUBTTL INFLO TRACE IN TRANSFERS:
COMMENT/
IT IS KNOWN A PRIORI THAT WE HAVE A LABEL DEFINED HERE ABOUTS, WHOSE VALUE
IS IN STMTNO. WE WISH TO DRAW A FLOW LINE INTO THIS LOCATION FROM THE
APPROPRIATE COLUMN ON THE RIGHT.
/
INFLO: MOVE B,KEY ;LOAD THE STATEMENT KEY
CAIN B,16 ;SKIP UNLESS FORMAT
TRNN FL,FORMAT ;SKIP IF SHUFFLED FORMAT
JRST .+2 ;NOT FORMAT OR NO SHUFFLE
BCALL 3,SHUFMS ;TELL HIM THAT HE JUST PROBABLY LOST
MOVE B,STMTNO ;LOAD THIS STATEMENT'S LABEL
PUSHJ P,UNDEFN ;DELETE A DEFINITION ENTRY FROM CREF
PUSH P,A ;A=0 MEANS LAST MENTION OF LABEL
COMMENT/
A=0 IMPLIES THAT THIS IS THE LAST MENTION OF THIS LABEL. EITHER LABEL
IS SUPERFLUOUS OR WE'LL FIND A (POSITIVE ENTRY) FOR IT IN RCOLS
THE LAST POSSIBILITY IS THAT THIS IS THE END OF A DO LOOP RANGE/
MOVEI A,%RCMAX-1 ;SEARCH THRU ALL RIGHT COLUMNS
INFLO0: CAMN B,RCOLS(A) ;COMPARE STMTNO VS. VALUE IN RCOLS
JRST INFLO2 ;A HAS INDEX TO RCOLS
SOJGE A,INFLO0 ;LOOP BACK
SKIPN 0(P) ;TEST: HAVE WE GOT FUTURE USE
JRST POPA ;NO FUTURE USES: QUICK RETURN
PUSHJ P,FFRCOL ;GET A COLUMN FOR CONTROL LINE
INFLO2: MOVNM B,RCOLS(A) ;STORE NEGATIVE IN RCOLS
COMMENT/
FIRST WE BLANK EVERYTHING THEN COPY THE EDGES CORRECTLY THEN PLUNK
AN "O" AT CENCOL AND AT COLUMN ^D92+(A) AND CONNECT THE INTERVENING SPACES WITH
LEFARR THEN PRINT THE LINE THEN TURN ON FALL
/
MOVEM A,0(P) ;STUFF CURRENT VALUE OF A ON STACK
PUSHJ P,DBLANK ;BLANK THE ENTIRE LINE
PUSHJ P,NOUTC2 ;SET UP EXISTING COLUMNS
MOVEI A,BLANK ;LOAD A WITH A BLANK
MOVEI B,%LCOLS+3 ;COLUMN TO BLANK
PUSHJ P,DEPCHR ;STUFF BLANK IN THERE
MOVEI A,CHARO ;LOAD JOINT CHARACTER
MOVE B,(P) ;LOAD B FROM THE STACK
CAIL B,%RCOLS ;SKIP UNLESS IMAGINARY
JRST INIMAG ;INFLOW FROM IMAGINARY LINE
ADDI B,121+%LCOLS ;ADD BASE OF RIGHT COLUMNS
PUSHJ P,DEPCHR ;STUFF THE O THERE TOO
JRST INFLO3 ;SKIP AROUND KLUGE
INIMAG: MOVEI B,%RCOLS ;LOAD A NASTY SURPRISE!!!
MOVEM B,(P) ;STUFF ON THE STACK
INFLO3: MOVEI B,COLCEN ;ADDRESS OF CENTER COLUMN
PUSHJ P,DEPCHR ;STUFF "O" IN THE CENTER
MOVEI A,"<" ;LOAD A POINTY BRACKET
IDPB A,B ;STUFF IN COLCEN+1
POP P,C ;POP COLUMN NUMBER INTO C
ADDI C,117-COLCEN+%LCOLS ;ADD TO GET COLUMN COUNT
MOVEI A,LEFARR ;USING LEFT ARROWS
IDPB A,B ;STUFF THE LINE WITH LEFT ARROWS
SOJG C,.-1 ;LOOP AND STUFF
PUSHJ P,PRNTLB ;WRITE LINE
TLO FL,FALL ;TURN ON FALLING THRU BIT
PUSHJ P,DBLANK ;BLANK THE LINE
MOVE B,STMTNO ;LOAD THE STATEMENT LABEL
PUSHJ P,FINDEC ;FIND IT'S TABLE2 ADDRESS
SKIPN (A) ;ARE WE AT THE END?
PUSHJ P,MAKFRE ;YES: NO MORE REFS TO LABEL: FREE COL
PUSHJ P,NOUTC2 ;LOAD ALL THE SILLY ARROWS
MOVEI A,BLANK ;BLANKS IN
MOVEI B,%LCOLS+3 ;HERE
PUSHJ P,DEPCHR ;STUFF
MOVEI B,116+%LCOLS ;AND HERE TOO
PUSHJ P,DEPCHR ;THIS LIKE BELT AND SUSPENDERS
MOVEI A,DWNARR ;DOWN ARROWS IN COLCEN
MOVEI B,COLCEN ;
JRST DEPCHR ;STUFF AND RETURN
MAKFRE: PUSH P,C ;FREE A FLOW COLUMN: SAVE C
MOVEI A,%RCMAX-1 ;SEARCH ALL THE DAMN RCOLS
MOVM C,RCOLS(A) ;LOAD IT'S MAGNITUDE
CAMN B,C ;COMPARE TO LABEL IN B
JRST MAKFR1 ;OK: FOUND IT
SOJGE A,.-3 ;KEEP looking
JRST .+2 ;RAN OUT OF THEM
MAKFR1: SETZM RCOLS(A) ;ZERO APPROPRIATE PLACE
POP P,C ;RESTORE C
POPJ P, ;RETURN
SHUFMS: ASCIZ /Warning: A FORMAT statement that is used as a jump target has been shuffled
/
SUBTTL CHKDOR CHECK FOR THE END OF A DO RANGE
CHKDOR: SKIPG STMTNO ;IS THIS GUY LABELED?
POPJ P, ;NOPE: RETURN QUICK
SETZ B, ;ZERO REGISTER
CHKDR0: MOVM A,LCOLS(B) ;LOAD A LEFT COLUMN
CAMN A,STMTNO ;EQUALS THIS NUMBER?
AOJA B,CHKDR1 ;YES: FOUND IT
CAIGE B,%LCMAX-1 ;END OF RANGE?
AOJA B,CHKDR0 ;NOPE. INCREMENT BACK FOR MORE
POPJ P, ;RETURN IF NOT FOUND
CHKDR1: TLO FL,NEEDBT ;TURN ON A FLAG
SETZM LCOLS-1(B) ;ZERO STUFF
MOVE D,B ;LOAD THE COLUMN NUMBER INTO D
MOVEI A,CHARO ;LOAD THE JOINT CHARACTER
CAILE B,%LCOLS ;SKIP IF REAL
MOVEI B,%LCOLS+1 ;LOAD IMAGINARY
PUSHJ P,DEPCHR ;STUFF IT
CHKDR2: MOVM C,LCOLS(D) ;LOAD FROM COLUMN D+1
JUMPE C,CHKDR3 ;ALL THRU
CAME C,STMTNO ;MUST BE EQUAL
JRST ILLDON ;ILLEGAL DO LOOP NESTING
SETZM LCOLS(D) ;ZAP THAT COLUMN
CAIGE D,%LCOLS ;SKIP IF IMAGINARY
IDPB A,B ;WRITE JOINT CHARACTER
CAIGE D,%LCMAX-1 ;ARE WE AT THE END?
AOJA D,CHKDR2 ;NOPE: LOOP BACK
CHKDR3: MOVEI A,"<" ;LOAD THE BIG ARROW
IDPB A,B ;STUFF IT
ADDI D,1 ;INCREMENT D.
MOVEI A,LEFARR ;LOAD SMALL ARROW
CHKDR4: CAILE D,%LCOLS+1 ;COMPARE TO THE END
POPJ P, ;ALL DONE
IDPB A,B ;STUFF IT
AOJA D,CHKDR4 ;RUN BACK FOR MORE
ILLDON: BCALL 3,[ASCIZ/
ERROR IMPROPER NESTING OF DO LOOPS
/] ;WRITE NASTY MESSAGE
AOS ERRCNT ;COUNT AN ERROR
JRST FLOWRT ;END IT ALL
SUBTTL UNUSE, UNDEFN AND FINDEC
;DELETE THE FIRST ELEMENT IN THE CREF LIST OF THE LABEL IN B.
UNUSE: PUSH P,A ;SAVE A ON THE STACK
PUSHJ P,FINDEC ;LOAD ADDRESS OF TABLE 2 ENTRY INTO C
MOVE A,(C) ;LOAD THE ENTRY
JUMPLE A,UNUSEU ;UNUSE UNHAPPYNESS (DEFINITION OR EMPTY)
HRRZ A,A ;GET JUST THE RIGHT SIDE
JUMPE A,.+2 ;LIST BECOMES EMPTY
MOVE A,(A) ;SHORTEN LIST
MOVEM A,(C) ;SHORTEN THE LIST BY REMOVING FIRST GUY
JRST POPA ;RESTORE A AND RETURN
;SPECIAL VERSION. SKIPS UNLESS THE DEFININITION OF THIS LABEL OCCURS
;ON THE NEXT LINE AFTER THIS USE. (DOES STATEMENT REALLY FALL THRU).
UNUSEA: PUSH P,A ;SAVE A ON THE STACK
PUSHJ P,FINDEC ;LOAD ADDRESS OF TABLE 2 ENTRY INTO C
MOVE A,(C) ;LOAD THE ENTRY
JUMPLE A,UNUSEU ;UNUSE UNHAPPYNESS (DEFINITION OR EMPTY)
TRNN A,-1 ;SKIP IF THERE IS A LINK HERE.
JRST UNUSEB ;LIST BECOMES EMPTY
HLRZM A,1(P) ;SAVE DATUM.
AOS 1(P) ;INCREMENT DATUM
MOVE A,(A) ;LOAD THE NEXT ELEMENT OF THE LIST
MOVEM A,(C) ;AND SAVE IT AS THE FIRST.
HLRZ A,A ;GET DATUM
TRZE A,400000 ;SKIP IF THIS IS A USE (NOT DEFINITION)
CAME A,1(P) ;DEFINITION. SKIP IF THIS IS THE SAME
AOS -1(P) ;NOT SAME, NOT DEFINITION. SKIP RETURN.
JRST POPA ;RESTORE A AND RETURN
UNUSEB: SETZM (C) ;LIST IS NOW EMPTY
AOS -1(P) ;GIVE THE SKIP RETURN
JRST POPA
;ERRORS FROM UNUSE,UNDEFN,FINDEC
UNUSEU: BCALL 3,[ASCIZ/UNUSE/] ;WRITE THE FIRST PART
UNUSE1: PUSHJ P,INTCF1 ;THE REST
AOS ERRCNT ;COUNT AN ERROR
JRST FLOWRT ;CANCEL FLOWCHART
UNDEFU: BCALL 3,[ASCIZ/UNDEFN/] ;SHORT MESSAGE
JRST UNUSE1
;REWRITTEN 3-29-73. INNER LOOP REDUCED TO 3 INSTRUCTIONS FROM 6.
FINDEC: MOVN A,NUMLAB ;FIND ADDRESS OF TABLE ENTRY LABEL IN B
JUMPE A,FINDC2
MOVSI A,(A)
HRR A,TABSP ;-COUNT,,BASE OF TABLE
FINDC1: HRRZ C,(A) ;GET DATA FROM TABLE
CAIN B,(C) ;SAME AS THE ONE WE WANT?
JRST FINDC3 ;YES.
AOBJN A,FINDC1 ;NO. LOOP IN TABLE
FINDC2: BCALL 3,[ASCIZ/FINDEC/] ;LEADER FOR ERROR MESSAGE
JRST UNUSE1 ;GIVE UP
FINDC3: ANDI A,-1 ;ADDRESS ONLY, PLEASE.
ADD A,NUMLAB ;ADD TO GET ADDRESS IN TABLE 2
ADD A,NUMLAB ;ADD TO GET ADDRESS IN TABLE 3
MOVEI C,(A) ;RETURN IN BOTH A AND C
POPJ P, ;RETURN, SMILING
UNDEFN: PUSH P,C ;DELETE A DEFINITION ENTRY
PUSHJ P,FINDEC ;FIND THE ADDRESS OF THIS GUY
MOVE A,(C) ;LOAD WITH THE LIST ENTRY THERE
JUMPGE A,UNDEFU ;UNDEFINE UNHAPPY
HRRZ A,A ;PICKUP LINK FIELD
SKIPE A ;IF 0 THEN EMPTY LIST
MOVE A,(A) ;LOAD NEXT GUY
MOVEM A,(C) ;STUFF IN THE TABLE
POP P,C ;RESTORE C
POPJ P, ;A=0 NOW IMPLIES LIST JUST EMPTIED
SUBTTL COPY STUFF TO LINEBF
NOUTC1: TLZ FL,NOLOAD ;SHUT OFF LOAD PREVENTION FLAG
MOVE C,[POINT 7,NLBUF] ;POINTER TO SOURCE
MOVEI B,%LCOLS+5 ;COLUMN TO DEPOSIT IN
ILDB A,C ;GET FIRST
PUSHJ P,DEPCHR ;DEPOSIT AND FALL INTO LOOP
ILDB A,C ;LOAD
JUMPE A,CPOPJ ;END OF LINE
IDPB A,B ;STORE
JRST .-3 ;LOOP
NOUTC2: MOVEI C,%LCOLS ;LOAD MAXIMUM COLUMN
MOVE B,LCOLS-1(C) ;LOAD LABEL NUMBER FROM LCOLS
PUSHJ P,ACHR ;SELECT A CHARACTER
MOVE B,C ;LOAD COLUMN NUMBER TO B
PUSHJ P,DEPCHR ;STUFF CHARACTER
SOJG C,.-4 ;DECREMENT C AND DO IT ALL
MOVEI A,VBAR ;GET A VERTICAL BAR
MOVEI B,%LCOLS+3 ;FOR COLUMN
PUSHJ P,DEPCHR ;STUFF IT
MOVEI B,116+%LCOLS ;ALSO
PUSHJ P,DEPCHR ;STUFF IN HERE
MOVEI C,%RCOLS ;SCAN THE RIGHT COLUMNS
MOVE B,RCOLS-1(C) ;LOAD IT
PUSHJ P,ACHR ;CONVERT TO CHARACTER
MOVEI B,120+%LCOLS(C) ;LOAD B
PUSHJ P,DEPCHR ;STUFF IT
SOJG C,.-4 ;LOOP BACK
MOVEI A,BLANK ;LOAD A WITH A BLANK
MOVEI B,%LCOLS+1 ;STUFF IT
PUSHJ P,DEPCHR ;
IDPB A,B ;IN TWO COLUMNS
MOVEI B,117+%LCOLS ;HERE TOO
PUSHJ P,DEPCHR ;STUFF IT
IDPB A,B ;AND HERE
TLNN FL,NOLOAD ;IS NOLOAD UP?
JRST CHKDOR ;NOPE: CHECK FOR DO TERMINATION
POPJ P, ;RETURN
NOUTCP: PUSHJ P,NOUTC1 ;DO LINE LOAD
NOUTCX: PUSHJ P,NOUTC2 ;DO VERTICAL DEFINITION
PRNTLB: PUSHJ P,LINCMP ;COMPRESS LINE.
LPCALL 3,LINEBZ ;PRINT THE LINE
POPJ P, ;RETURN
ACHR: MOVEI A,BLANK ;LOAD WITH A BLANK
JUMPE B,CPOPJ ;RETURN IF ZERO
MOVEI A,UPARR
JUMPL B,CPOPJ ;RETURN UPARROW IF <0
MOVEI A,DWNARR ;DOWN ARROW OTHERWISE
POPJ P,
;LINCMP COMPRESSES THE TEXT IN LINEBF BY CHANGING BLANKS TO TABS,
;DELETING TRAILING BLANKS. USEFUL IF OUTPUT DEVICE IS A DISK FILE.
LINCMP: MOVE T,[POINT 7,LINEBF] ;SOURCE
MOVE U,[POINT 7,LINEBZ] ;DESTINATION
MOVEI S,0 ;COLUMN COUNT (SOURCE)
LINCM1: ILDB A,T ;READ CHARACTER FROM SOURCE
LINC1A: CAIE A,11
CAIN A,15 ;RETURN?
JRST LINCM3 ;YES.
CAIN A," " ;BLANK?
AOJA S,LINCM4 ;YES.
IDPB A,U ;DEPOSIT
AOJA S,LINCM1 ;LOOP.
LINCM2: ILDB A,T ;LOAD MORE
LINCM3: IDPB A,U ;STUFF
JUMPN A,LINCM2 ;LOOP UNTIL NULL.
POPJ P, ;RETURN.
LINCM4: MOVEI V,-1(S) ;COLUMN NUMBER OF LAST DATA ITEM.
LINCM5: ILDB A,T ;LOAD MORE
CAIN A," " ;BLANK?
AOJA S,LINCM5
CAIN A,15
JRST LINCM3 ;FINISH FOR RETURN.
LINCM6: MOVEI A,10(V) ;GET LAST COLUMN+8
TRZ A,7 ;MAKE MULTIPLE OF 8
CAIGE S,(A) ;IS THERE ROOM TO ADD A TAB?
JRST LINCM7 ;NO.
MOVEI V,(A) ;UPDATE DESTINATION COLUMN
MOVEI A,11
IDPB A,U
JRST LINCM6 ;LOOP FILLING WITH TABS.
LINCM7: MOVEI A," "
LINCM8: CAIG S,(V)
JRST LINCM9
IDPB A,U
AOJA V,LINCM8
LINCM9: LDB A,T
JRST LINC1A
SUBTTL FLOWCHART INPUT FILE FORMAT
COMMENT/
WE HAVE THE FOLLOWING MAGICAL THINGS WORKING FOR US:
1. THIS FILE THAT WE ARE READING HAS ALL THE STATEMENTS
PREDIGESTED, AS FOLLOWS:
THE FIRST CHARACTER IN A LINE IS A CODE;
% MEANS THAT THIS IS A CONTINUATION OF THE PREVIOUS LINE
ANYTHING ELSE, FROM ?, @, A, B, M,N,O IS TO BE INTERPRETED
AS FOLLOWS: SUBTRACT "@" FROM THE CHARACTER AND CALL THE
RESULT KEY; THE FOLLOWING IS A TABLE:
KEY MEANING
-1 END
0 ANY STATEMENT CLASS NOT LISTED BELOW
1 ASSIGN
2 ACCEPT
3 DO
4 GO TO AND ARITHMETIC IF
5 LOGICAL IF
6 PRINT
7 PUNCH
8 READ
9 TYPE
10 WRITE
11 DECODE
12 ENCODE
13 REREAD
14 FORMAT
15 RETURN
16 STOP
2. ALSO WE HAVE THE CREF THAT WAS PRODUCED DURING
PASS 2. THIS TELLS US THE EARLIEST REFERENCE,
THE LATEST REFERENCE AND THE DEFINITION POINT
OF EACH LABEL.
/
SUBTTL ALLOCATION OF FLOW COLUMNS
COMMENT/
FREE COLUMNS ARE THOSE WITH ZERO ENTRIES IN RCOLS. COLUMNS IN USE ARE MARKED
WITH THE STATEMENT NUMBER OF THEIR TARGET: POSITIVE FOR FORWARD (DOWNARROW)
NEGATIVE IF BACKWARD TARGET (UPARROW).
FFRCOL FINDS FIRST AVAILABLE RIGHT SIDE COLUMN AND RETURNS IT'S INDEX
NUMBER (0-%RCOLS) IN A.
FFLCOL FINDS FIRST FREE ON LEFT AND RETURNS IT IN A.
/
FFRCOL: PUSH P,B ;STUFF B ON THE STACK
SETZM HSIZ ;LARGEST HOLE IS SIZE 0
SETZB A,B ;B STEPS THRU RCOLS, A FOR HOLE SIZE
FFRCL1: SKIPN RCOLS(B) ;SKIP IF COLUMN IN USE
AOJA A,FFRCL4 ;VACANT COLUMN, COUNT IT
JUMPLE A,FFRCL4 ;JUMP IF NO HOLE HERE
CAMG A,HSIZ ;WE HAVE A HOLE, SKIP IF BIGGEST
JRST FFRCL3 ;A SMALL HOLE
MOVEM A,HSIZ ;SAVE HOLE SIZE
MOVEM A,HLOC ;AND SET UP HOLE LOCATION
SUBM B,HLOC ;BY POSITION-SIZE=BEGINNING
FFRCL3: SETZ A, ;ZERO HOLE COUNTER
FFRCL4: CAIGE B,%RCOLS-1 ;SKIP IF WE'VE SEEN ALL REALS
AOJA B,FFRCL1 ;NOT SEEN THEM ALL
CAMG A,HSIZ ;SKIP IF THIS IS BIGGER HOLE
JRST FFRCL2 ;SMALL HOLE
MOVEM A,HSIZ ;SAVE AS LARGEST HOLE
SUBI A,1 ;DECREASE A BY 1
MOVEM A,HLOC ;SAVE AS H LOC
SUBM B,HLOC ;SUBTRACT FROM B (B IS 1 TOO SMALL)
FFRCL2: SKIPG A,HSIZ ;SKIP IF WE HAVE NON-EMPTY HOLE
AOJA B,FFRCL6 ;LOOK THRU IMAGINARIES
LSH A,-1 ;HALVE THE HOLE SIZE
ADD A,HLOC ;ADD THE HOLE LOCATION
FFRCL5: POP P,B ;RETURN B FROM THE STACK
POPJ P, ;ANSWER IN A
FFRCL6: MOVE A,B ;LOAD A WITH INDEX TO SMALLEST IMAG
FFRCL7: SKIPN RCOLS(A) ;SKIP IF COLUMN IN USE
JRST FFRCL5 ;FOUND ONE. RETURN.
CAIGE A,%RCMAX-1 ;RUN OUT YET?
AOJA A,FFRCL7 ;LOOP LOOKING FOR FREE ONE
BCALL 3,[ASCIZ/
FLOWCHART: NO SPACE FOR FLOW LINES.
/] ;LOSSAGE MESSAGE
JRST FLOWRT ;EXIT FROM FLOWCHART
FFLCOL: SETZ A, ;ZAP A
FFLCL1: SKIPN LCOLS(A) ;LOOK FOR THE FIRST FREE COLUMN
POPJ P, ;FOUND IT. RETURN
CAIGE A,%LCMAX-1 ;STILL LOOKING
AOJA A,FFLCL1 ;INCREMENT A AND JUMP
BCALL 3,[ASCIZ/
FLOWCHART: NO SPACE FOR LOOP FLOW LINES.
/] ;LOSSAGE MESSAGE
JRST FLOWRT ;STOP THIS FLOWCHART
SUBTTL DBLANK DEPCHR
DBLANK: MOVE A,ASC5SP ;LOAD 5 BLANKS INTO A
MOVEM A,LINEBF ;STUFF IN LINE BUFFER
MOVE A,[XWD LINEBF,LINEBF+1] ;A BLT POINTER
BLT A,LINEBF+32 ;BLT THE BLANKS THRU THE LINE
MOVE A,ASCRLF ;LOAD LINE TERMINATOR
TRNN FL,TTYF ;SKIP IF LISTING ON TTY
IFG STANSW,< MOVE A,[BYTE(7) 15,177,21]> ;SPACE OVER LPT PAGE BOUNDARIES
IFE STANSW,<
IFE %LPT,<MOVE A,[BYTE(7)15,23]> ;SPACE OVER PAPER BREAK SHORT LPT
IFG %LPT,<MOVE A,[BYTE(7)40,40,15,23] ;LONG LPTS>
>
IFL STANSW,<
IFE %LPT,<MOVE A,[BYTE(7)15,12]>
IFG %LPT,<MOVE A,[BYTE(7)40,40,15,12]>
>
IFE %LPT,<MOVEM A,LINEBF+30 ;STUFF IT INTO THE END OF LINEBF>
IFG %LPT,<MOVEM A,LINEBF+32 ;......,LONG LPT>
POPJ P, ;RETURN
DEPCHR: PUSH P,C ;GIVEN CHARACTER IN A, COLUMN NUMBER
SUBI B,1 ;IN B, STUFF CHARACTER. DECREASE B BY 1
IDIVI B,5 ;DIVIDE BY 5
ADD B,MBYTE1(C) ;ADD TO QUOTIENT THE BYTEPOINTER
POP P,C ;RESTORE C
IDPB A,B ;STUFF THE CHARACTER
POPJ P, ;RETURN TO CALLER
MBYTE1: POINT 7,LINEBF ;FIRST BYTE POINTER
POINT 7,LINEBF,6
POINT 7,LINEBF,13
POINT 7,LINEBF,20
POINT 7,LINEBF,27
SUBTTL LINLOD LOAD A SOURCE LINE AND SET STUFF
COMMENT/ LOAD THE NEXT LINE INTO NLBUF; RECORD IN YOUR MAJIC PLACES:
1. STMT LABEL, IF RELEVANT, IN STMTNO. NEGATIVE IMPLIES CONT. CARD
2. THE OUTTRANSFER LABELS SAVED IN JREF. REFCT IS THE COUNT
3. TEXT IN NLBUF, EXACTLY 72 CHARACTERS LONG./
LINLOD: SKIPGE KEY ;TEST KEY. SKIP IF NOT ENDPROG
JRST [TLZ FL,NOLOAD ;END OF PROGRAM
POPJ P,] ;RETURN
SETZB COL,STMTNO ;DEFAULT THE STATEMENT NUMBER
SETZM REFCT ;ZERO THE REFERENCE COUNTER
SETZM KEY ;AND KEY
MOVE A,ASC5SP ;LOAD SPACES INTO A
MOVEM A,NLBUF ;STASH IN NLBUF
MOVE A,[XWD NLBUF,NLBUF+1] ;AND LOAD A BLT POINTER
BLT A,NLBUF+15 ;BLT SPACES THRU NLBUF
MOVE A,[ASCII/ /] ;TWO MORE SPACES THEN NULLS
MOVEM A,NLBUF+16 ;STUFF IT
MOVE A,[POINT 7,NLBUF] ;LOAD A POINTER TO BUFFER
MOVEM A,NLPTR ;STUFF IT IN CORE
PUSHJ P,GETLIN ;GET A CHARACTER FROM THE TEMP FILE
CAIN A,"%" ;CONTINUATION CARD?
JRST [SETOM STMTNO ;YES: SET STATEMENT TO -1
JRST LINLD0] ;SKIP TO READER
SUBI A,"@" ;GET THE VALUE OF KEY
MOVEM A,KEY ;STASH IT
LINLDX: PUSHJ P,GETLIN ;GET NEXT
CAIE A,2 ;CODE FOR USE LIST
JRST LNLDGS ;NO USE LIST. GET STMT NUMBER
GETJTA: PUSHJ P,GETLIN ;READ DISK. WE ARE PROMISED A DIGIT
CAIN A,2 ;LOOK FOR THE END MARKER
JRST LINLDX ;THAT'S ALL: JUMP TO MAIN SEQUENCE
SETZ B, ;B ACCUMULATES LABEL
GTJTA0: CAIN A,"," ;HAVE WE GOT A COMMA?
JRST GTJTA1 ;YES WE HAVE
IMULI B,12 ;NOPE. ASSUME A DIGIT. MULTIPLY B
ADDI B,-"0"(A) ;ADD IN THE DIGIT
PUSHJ P,GETLIN ;LOOK FOR MORE DIGITS
JRST GTJTA0 ;LOOP BACK
GTJTA1: SKIPG C,REFCT ;LOAD C WITH COUNT
JRST GTJTA2 ;EMPTY LIST. ADD THIS GUY
CAMN B,JREF-1(C) ;SHUFFLE THRU LIST LOOKING
JRST GETJTA ;FOR ANY DUPLICATIONS.
SOJG C,.-2 ;DECREMENT C AND LOOP
GTJTA2: AOS C,REFCT ;HAVE TO ADD THIS GUY
CAILE C,JREFTL ;ARE WE IN RANGE?
JRST GTJTA3 ;NO: WE ARE IN TROUBLE
MOVEM B,JREF-1(C) ;SAVE THIS REFERENCE
JRST GETJTA ;LOOK FOR MORE
GTJTA3: BCALL 3,[ASCIZ/
FLOWCHART: JUMP TARGET TABLE OVERFLOW
/] ;THE NASTY MESSAGE
JRST FLOWRT ;ABORT THE FLOWCHART
LNLDGS: CAIE A,3 ;LOOK FOR STATEMENT NUMBER TOO
JRST LINLD1 ;A NOW HAS THE FIRST SOURCE CHARACTER
SETZ B, ;ACCUMULATE STATEMENT LABEL
LNLDG0: PUSHJ P,GETLIN ;READ CHARACTER
CAIN A,3 ;THIS WILL STOP THE LINE
JRST LNLDG1 ;GOT A STATEMENT NUMBER
IMULI B,12 ;ASSUME WE HAVE A DIGIT
ADDI B,-"0"(A) ;ADD IN THE DIGIT
JRST LNLDG0 ;LOOP
LNLDG1: MOVEM B,STMTNO ;STUFF B INTO STATEMENT NUMBER FIELD
LINLD0: PUSHJ P,GETLIN ;READ A CHARACTER
LINLD1: CAIN A,15 ;IGNORE CR
JRST LINLD0 ;BY GETTING ANOTHER
CAIN A,12 ;LF WILL STOP THIS
JRST LINLD2 ;ALL DONE
ADDI COL,1 ;INCREMENT COLUMN
CAIG COL,110 ;CHECK FOR IN RANGE
IDPB A,NLPTR ;OK. STUFF IT
JRST LINLD0 ;LOOP BACK
LINLD2: SKIPG B,STMTNO ;TEST STATEMENT NUMBER
POPJ P, ;RETURN QUICK
PUSHJ P,FINDEC ;LOOK FOR THIS GUY IN THE TABLE
HRRZ A,0(A) ;GET THIS GUY'S LINK
JUMPG A,CPOPJ ;NOT LAST IN LIST
MOVEI C,%RCMAX-1 ;LOOK THRU RCOLS
LINLD3: CAMN B,RCOLS(C) ;SEE IF ANY COLUMN IS ACTIVE
POPJ P, ;WITH THIS LABEL
SOJGE C,LINLD3 ;LOOK THRU ALL THE RIGHT
SKIPG C,REFCTX ;LOAD UP THE CURRENT REFERENCE COUNT
JRST LINLD4 ;NO REFERENCES IN PROGRESS
CAMN B,IBUF-1(C) ;CHECK HERE
POPJ P, ;OK. WE NEED THIS LABEL. RETURN
SOJG C,.-2 ;LOOP THRU THIS STUFF
LINLD4: MOVN B,B ;NEGATE STMTNO
MOVEI C,%LCMAX-1 ;LOOK THRU LCOLS
CAMN B,LCOLS(C) ;SEEK EQUALS MATCH
POPJ P, ;MATCHES OK.
SOJGE C,.-2 ;DECREMENT C AND JUMP BACK
SETZM STMTNO ;NON-EFFECTIVE LABEL
POPJ P, ;RETURN
GETLIN: PUSHJ P,GETDK2 ;GET FROM TEMP2 FILE
PUSHJ P,UEOF ;UNEXPECTED END OF FILE
POPJ P, ;RETURN
SUBTTL THE LITERALS
XLIST ;THE LITERALS ONLY
LIT ;FORCE THE LITERALS OUT
LIST ;RESUME THE LISTING
SUBTTL STORAGE ALLOCATION: LOWSEGMENT STRUCTURE
IFG SEGSW,<RELOC 0> ;ASSEMBLE AT 140
TSAVE: BLOCK 1
SCANT: BLOCK 1 ;TABLE FOR SCANNER
SCANX: BLOCK 4 ;...DEVICE FILE EXT PPN
SRCDEV: BLOCK 1 ;SOURCE DEVICE. FROM HERE THRU PCHEXT
SRCNAM: BLOCK 1 ;IS ZEROED BEFORE EACH COMMAND
SRCEXT: BLOCK 1 ;SOURCE FILE NAME AND EXT
SRCPPN: BLOCK 1 ;SOURCE PPN
LSTDEV: BLOCK 1 ;LIST DEVICE
LSTNAM: BLOCK 1 ;LIST FILE NAME
LSTEXT: BLOCK 1 ;EXTENSION (NO PPN ON OUTPUT FILES)
PCHDEV: BLOCK 1 ;PUNCH FILE DEVICE
PCHNAM: BLOCK 1 ;FILE
PCHEXT: BLOCK 1 ;AND EXT
PDLIST: BLOCK PDLEN ;PUSH DOWN STORAGE
LPTBUF: BLOCK 3 ;DEVICE BUFFERS. LPT
CDRBUF: BLOCK 3 ;SOURCE
CDPBUF: BLOCK 3 ;PUNCH OUTPUT
DK1BUF: BLOCK 3 ;DISK 1
DK2BUF: BLOCK 3 ;DISK 2
TTYBUF: BLOCK 3 ;TTY OR COMMAND FILE
TMPNAM: BLOCK 1 ;NAME-1 FOR INPUT/OUTPUT ON SCRATCH
BUFA: ;CARD OUTPUT BUFFER FOR PASS2
NLBUF: BLOCK 21 ;LINE INPUT BUFFER FOR FLOWCHART
TXLIN: BLOCK 24 ;LINE BUFFER FOR SOURCE INPUT
SAVEAC: BLOCK 20 ;SAVE AC'S HERE DURING UUO
NUMLAB: BLOCK 1 ;NUMBER OF LABELED STATEMENTS
KEY: BLOCK 1 ;CODE FOR STATEMENT TYPE
CORREQ: BLOCK 1 ;REQUESTED SIZE TO GETCOR
NLPTR: BLOCK 1 ;POINTER TO NLBUF IN LODLIN
STMTNO: BLOCK 1 ;LABEL OF THIS STATEMENT FOR FLOWCHART
REFCT: BLOCK 1 ;COUNT OF OUT REFERENCES FOR THIS
REFCTX: BLOCK 1 ;ALTERNATE REFERENCE COUNT
FNO: BLOCK 1 ;FIRST LABEL FOR RELABELING
SNO: BLOCK 1 ;INCREMENT FOR RELABELING
PARCT: BLOCK 1 ;PARENTHESIS COUNT
SAVEY: BLOCK 1 ;PLACE TO SAVE AC
SAVEZ: BLOCK 1 ;PLACE TO SAVE AN AC
NAME: BLOCK 2 ;PLACE FOR PROGRAM NAME
IBUF: BLOCK BUFLEN ;STATEMENT INPUT BUFFER (PASS2)
JREF: ;OUTREFERENCES (FLOWCHART)
OBUF: BLOCK BUFLEN ;STATEMENT OUTPUT BUFFER FOR PASS2
SEQ: BLOCK 1 ;LAST SEQUENCE NUMBER USED
SNSEEN: BLOCK 1 ;NUMBER OF LABELS DEFINED SO FAR(PASS2)
CONTS: BLOCK 1 ;NUMBER OF CONTINUATION CARDS
FLUSVB: BLOCK 1 ;SAVE BYTE POINTER DURING FLUSH
SAVEC: BLOCK 1 ;PLACE TO SAVE ANOTHER BYTE POINTER
OLDCOL: BLOCK 1 ;LAST DELIMITER DUMPED BY FLUSH
SAVEME: BLOCK 1 ;SAVE A BYTE POINTER TO DETECT EMPTY
SEQINC: BLOCK 1 ;INCREMENT FOR SEQUENCING
URREF: BLOCK 1 ;PLACE TO SAVE UNRESOLVED LABEL
NAMEX: BLOCK 3 ;ASCII PROGRAM NAME
ERRCNT: BLOCK 1 ;COUNT OF ERRORS
BEGFF: BLOCK 1 ;BEGINING JOBFF.USE TO SHRINK AT BEGINA
DSKFF: BLOCK 1 ;ADDRESS FOR DISK BUFFERS
TABSP: BLOCK 1 ;BASE OF LABEL TABLE
LPTPTR: BLOCK 1 ;BYTE POINTER FOR PASS1
LINEBF: BLOCK 33 ;LINE BUFFER FOR FLOWCHART
LINEBX: BLOCK 36 ;LINE BUFFER FOR PASS1
LINEBZ: BLOCK 33 ;COMPRESSED LINE BUFFER FOR FLOWCHART
LINUM: BLOCK 1 ;LINE NUMBER FOR CREF
LASTNM: BLOCK 1 ;LAST NUMBER DONE FOR CREF
FREPTR: BLOCK 1 ;FIRST FREE LOCATION FOR CREF
REFCOL: BLOCK 1 ;
REFLIN: BLOCK 1 ;CROSS REFERENCE COLUMN AND LINE
FMTFF: BLOCK 1 ;LOCATION FOR DSK2 BUFFERS
FMTNAM: BLOCK 1 ;NAME FOR DISK2 FILE
FMTFNO: BLOCK 1 ;FIRST NUMBER FOR FORMATS
FMTCNT: BLOCK 1 ;COUNT OF FORMAT STATEMENTS
RCOLS: BLOCK %RCMAX ;RIGHT SIDE LABEL TO COLUMN ASSIGNMENTS
LCOLS: BLOCK %LCMAX ;LEFT SIDE LABEL TO COLUMN ASSIGNMENTS
SDEF BLTSTP,.-1 ;STOPPING PLACE FOR BLT
HSIZ: BLOCK 1 ;SIZE OF BIGGEST HOLE IN RCOLS
HLOC: BLOCK 1 ;LOCATION OF BIGGEST HOLE IN RCOLS
SAVEPD: BLOCK 1 ;SAVE P FOR FLOWCHART ABEND
PATCH1: BLOCK 20 ;PATCHING AREA
PATCH2: BLOCK 20 ;PATCHES, I'LL ALWAYS BE TRUE...
PATCH3: BLOCK 20
LOWEND: ;END OF LOW STORAGE
END BEGIN ;BEGIN AT THE BEGINNING