PROGRAM WIRAP
C
C !-------------------------------------------------------------!
C !								!
C !			PROGRAM WIRAP				!
C !			------- -----				!
C !								!
C !	THIS IS THE ROOT SEGMENT OF THE WIRE-WRAP PROGRAM.	!
C !								!
C !	IT CONSISTS OF THE BASIC FLOW-CONTROL PROCESSING	!
C !	FOR THE WIRE-WRAP LANGUAGE INTERPRETER.			!
C !								!
C !	THE PROGRAM IS EXTENSIVELY DISPATCH-TABLE DRIVEN	!
C !	SO THAT THIS ROOT SEGMENT MAY BE AS SHORT AS POSSIBLE.	!
C !								!
C !-------------------------------------------------------------!


C
C PAGE 1 A - WIRROT - TITLE PAGE.
C
C
C
C ************************************************************************
C                                                                        *
C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY.  DIGITAL  EQUIPMENT *
C COMPUTER USER'S SOCIETY,  DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND *
C THE AUTHOR DISCLAIM  ALL WARRANTIES ON THE PROGRAM,  INCLUDING WITHOUT *
C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS.      *
C									 *
C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS  AND TO THE DECUS *
C SPECIAL INTEREST  GROUPS  TO  REPRODUCE,  DISTRIBUTE,  AND PUBLISH AND *
C PERMIT  OTHERS  TO  REPRODUCE  IN  WHOLE  OR  IN PART, IN ANY FORM AND *
C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO *
C									 *
C ************************************************************************
C
C
C VERSION:	V04.01
C
C AUTHOR:	RL AURBACH	MAPC	31-AUG-78
C
C
C COMPILATION INSTRUCTIONS:
C
C	WIRROT,WIRROT/-SP=WIRROT
C		[FILE WIRCOM.FTN INCLUDED]
C		[FILE IOPAR.COM INCLUDED]
C		[FILE PARSE.COM INCLUDED]
C		[FILE LEXATT.COM INCLUDED]
C		[FILE ALIAS.COM INCLUDED]
C		[FILE CHAINS.COM INCLUDED]
C		[FILE CNPAR.COM INCLUDED]
C		[FILE ELECTR.COM INCLUDED]
C		[FILE PARAM.COM INCLUDED]
C		[FILE PLAIN.COM INCLUDED]
C		[FILE SPCING.COM INCLUDED]
C
C MODIFICATION HISTORY:
C
C	V02.03	EAS	1977		PRODUCTION VERSION
C					    (RUNS USING FOR UNDER RT-11 V2C)
C	V03.00	RLA	18-MAR-78	STRAIGHT FUNCTIONAL TRANSLATION OF
C					    V2.3 TO RUN USING F4P UNDER
C					    RSX-11M V3.0 OR V3.1
C	V04.00	RLA	7-JUN-78	MAJOR FUNCTIONAL MODIFICATIONS:
C					    A) LOCATION SYMBOL SUPPORT
C					    B) POWER AND GROUND PLANE SUPPORT
C					    C) CONNECTOR PIN ALIAS SUPPORT
C					    D) REDESIGNED LISTING OUTPUT
C					    E) REVISION LOG DOCUMENTATION
C					    F) NEW DIRECTIVES TO HANDLE ABOVE.
C	V04.00A	RLA	31-AUG-78	REORGANIZE INCLUDED COMMON AREAS
C	V04.01	RLA	8-DEC-78	CORRECT PROBLEM WITH NEWLIN BEING SET
C						.TRUE. AFTER TRANSITION
C						PROCESSING
C

C
C PAGE 2 - WIRROT - DOCUMENTATION.
C
C THE FOLLOWING DESCRIBES THE BASIC PROGRAM FLOW (IGNORING ERROR HANDLING,
C TERMINATION PROCESSING, ETC.
C
C THE PROGRAM INITIALIZES ITSELF, OPENS THE LISTING FILE, AND OPENS THE FIRST
C INPUT FILE.  THE PROGRAM THEN ENTERS A MAJOR LOOP WHICH CONTINUES UNTIL
C AN $END DIRECTIVE IS PROCESSED.
C
C A LINE IS READ AND ANALYZED TO VERIFY THAT IT IS A DIRECTIVE LINE.  IF THE
C ATTEMPT TO READ THE LINE RESULTED IN AN END-OF-FILE DETECTION, THE INPUT
C FILE IS CLOSED AND THE NEXT INPUT FILE IS READ IN.  THE DIRECTIVE LEVEL
C IS COMPARED WITH THE CURRENT STATE OF THE PROCESSOR.  IF THE DIRECTIVE IS AT
C THE CURRENT PROCESS STATE, CONTROL IS DISPATCHED TO THE SUBROUTINE WHICH
C PROCESSES THE DIRECTIVE.  IF THE DIRECTIVE IS AT A LEVEL ONE HIGHER THAN
C THE CURRENT PROCESS STATE, THE PROCESS STATE IS INCREMENTED, AND CONTROL
C IS DISPATCHED TO THE TRANSITION-PROCESSING ROUTINE APPROPRIATE FOR THAT
C TRANSITION.  AFTER THE TRANSITION HAS BEEN PROCESSED, CONTROL IS DISPATCHED
C TO THE DIRECTIVE PROCESSING ROUTINE AS BEFORE.  WHEN THE DIRECTIVE PROCESSING
C IS COMPLETE, THE ROUTINE FETCHES THE NEXT INPUT LINE.
C
C ERROR CONDITIONS:
C
C	ALL MAJOR SYNTAX ERRORS ASSOCIATED WITH THE FORMATION OF A DIRECTIVE
C	LINE ARE CAUGHT AND FLAGGED HERE.
C

C
C PAGE 3 - WIRROT - DATA STORAGE DESCRIPTIONS.
C
C PARAMETER STATEMENTS
C
	INCLUDE 'WIRCOM.FTN'
	INCLUDE 'IOPAR.COM'
	INCLUDE 'PARSE.COM'
	INCLUDE 'LEXATT.COM'
	INCLUDE 'ALIAS.COM'
	INCLUDE 'CHAINS.COM'
	INCLUDE 'CNPAR.COM'
	INCLUDE 'ELECTR.COM'
	INCLUDE 'PARAM.COM'
	INCLUDE 'PLAIN.COM'
	INCLUDE 'SPCING.COM'
C
C LOCAL VARIABLE AND ARRAY DEFINITIONS:
C
	INTEGER ISTATE		!CURRENT WIRAP STATE
	INTEGER IERR		!ERROR FLAG
	LOGICAL INDRCT		!IF .T., AN $INCLUDED FILE IS OPEN
	INTEGER INDSYS		!TEMPORARY STORAGE FOR ISYSIN
	INTEGER INDCOD		!TEMPORARY STORAGE FOR ICODE
	INTEGER ITMP		!GETLEX ASSOCIATED VARIABLE
	INTEGER ICMD		!INDEX OF CURRENT COMMAND
	INTEGER LEVEL(NMCMDS)	!COMMAND-LEVEL TABLE
	REAL*8 CMTBL(NMCMDS+1)	!COMMAND-NAME TABLE
	REAL*8 CMBUF		!COMMAND BUFFER
	INTEGER BUFCHR		!BUFFER FOR NEXCHR FOR TRANSITION PROCESSING
	INTEGER BUFTOK		!BUFFER FOR TOKEN FOR TRANSITION PORCESSING
	BYTE BUF(IBF)		!BUFFER FOR LINBUF FOR TRANSITION PROCESSING
C
C COMMON AREAS
C
C
C LOCAL VARIABLE AND ARRAY INITIALIZATION:
C
	DATA CMTBL / 'TITLE', 'COMMENT', 'CREATED', 'REVISED', 'SLACK',
	1	'COLORS', 'MESSAGE', 'INCLUDE', 'MAP', 'PLANE', 'CONNECTO',
	2	'CHAINS', 'END', 0 /
C
	DATA LEVEL / 1, 1, 1, 1, 1, 1, 3, -1, 2, 2, 2, 3, 4 /

C
C PAGE 4 - WIRROT
C
C
C  ***	THIS IS THE START OF THE PROGRAM.  CONTROL RETURNS HERE WHEN ALL
C	PROCESSING OF A CARD IS COMPLETE IN ORDER TO PROCESS THE NEXT CARD.
C
C	WE CLOSE ALL FILES (JUST IN CASE), INITIALIZE THE COMMON AREAS,
C	AND REQUEST THE LISTING FILE.
C
100	CLOSE (UNIT=ISYSIN)
	CLOSE (UNIT=ISYSOU)
	CLOSE (UNIT=ISYS2)
	CLOSE (UNIT=ISYSER)
	CLOSE (UNIT=ISYSAT)
	CLOSE (UNIT=ISYSDK)
	CALL ASSIGN(ISYSIN,'SY:')
	CALL ASSIGN(ISYSOU,'SY:')
	CALL ASSIGN(ISYS2, 'SY:')
	CALL ASSIGN(ISYSER,'SY:')
	CALL ASSIGN(ISYSAT,'SY:')
	CALL ASSIGN(ISYSDK,'SY:')
	CLOSE (UNIT=ISYSIN)
	CLOSE (UNIT=ISYSOU)
	CLOSE (UNIT=ISYS2)
	CLOSE (UNIT=ISYSER)
	CLOSE (UNIT=ISYSAT)
	CLOSE (UNIT=ISYSDK)
C
C
	CALL INIT
	ISTATE=0
	INDRCT=.FALSE.
C
C
	TYPE 9000, VERSN
	CALL FILIO(ISYSOU,'LIST',IERR)
C
C	FILE ERRORS-- IF USER TYPES ^Z, EXIT TASK.
C	IF THE FILE IS NOT OPENED CORRECTLY, REPORT THE ERROR AND START OVER.
C
	IF (IERR .EQ. 3) CALL EXIT
	IF (IERR .LT. 2) GOTO 200
	CALL DSKMSG(1,2)
	GOTO 100

C
C PAGE 5 - WIRROT
C
C
C  ***	INPUT FILE OPENER -- MAJOR LOOP POINT
C
C	IF AN INDIRECT FILE ($INCLUDE COMMAND) IS OPEN, CLOSE IT AND RESTORE
C	PREVIOUS VALUES OF ISYSIN AND ICODE.  CONTINUE TO PROCESS MAIN INPUT
C	FILE.
C
200	NEWLIN=.TRUE.
	IF (.NOT. INDRCT) GOTO 250
	CLOSE (UNIT=ISYSAT)
	ISYSIN=INDSYS
	ICODE=INDCOD
	INDRCT=.FALSE.
	GOTO 300
C
C	IF NO INDIRECT FILE IS OPEN, OPEN THE NEXT INPUT FILE.
C
C	IF THERE IS AN ERROR WHILE ATTEMPTING TO OPEN THE FILE, REPORT IT
C	AND TRY AGAIN.
C
C	IF THE USER TYPES ^Z, REPORT THAT NO $END DIRECTIVE WAS SEEN AND
C	FAKE AN END DIRECTIVE.
C
250	CALL FILIO(ISYSIN,'DATA',IERR)
	IF (IERR .NE. 2) GOTO 260
	CALL DSKMSG(2,0)
	GOTO 250
C
260	IF (IERR .NE. 3) GOTO 300
	CALL DSKMSG(3,0)
	GOTO 1000

C
C PAGE 6 - WIRROT
C
C
C  ***	COMMAND DECODER
C
C  ***	GET A $ (COMMAND PREFIX FLAG)
C
300	CALL GETLEX(ITMP)
	GOTO (200, 400, 310, 320, 320) ITMP
C
C	IF $ SEEN, CONTINUE.  ELSE ISSUE ERROR MESSAGE,
C	CLEAN UP, AND TRY AGAIN.
C
310	IF (LINBUF(NEXCHR-1) .EQ. '$') GOTO 500
C
320	CALL DSKMSG(4,3)
C
C  ***	GENERAL COMMAND CLEANUP CODE.
C
C	REQUEST A NEW LINE.
C	CLEAN UP THE LEXICAL STACK.
C	GET NEW LINE OR FILE (DEPENDING ON THE VALUE OF ICODE)
C
400	NEWLIN=.TRUE.
	LEXSP=LEXMX+1
	IF (ICODE .EQ. 0) GOTO 300
	GOTO 200


C
C PAGE 6 A - WIRROT
C
C
C  ***	GET COMMAND NAME
C
C	IF THE SYMBOL IS NOT ALPHAMERIC, THERE IS AN ERROR.
C
500	CALL GETLEX(ITMP)
	GOTO (510, 510, 510, 520, 510) ITMP
C
510	CALL DSKMSG(5,3)
	GOTO 400
C
C	COMMAND FOUND.  LOOK IT UP IN THE COMMAND TABLE.  IF IT IS NOT
C	FOUND IN THE TABLE, PRINT AN ERROR MESSAGE.
C
520	CALL TRANS(CMBUF)
	CALL SEARCH(CMTBL,NMCMDS,CMBUF,ICMD)
	IF (ICMD .NE. 0) GOTO 550
	CALL DSKMSG(6,3)
	GOTO 400
C
C  ***	CHECK ON THE DIRECTIVE LEVEL.  IF THE DIRECTIVE LEVEL IS LOWER THAN
C	THE CURRENT STATE OR IF IT IS GREATER THAN THE NEXT STATE, THIS IS
C	AN ERROR.
C
550	IF ((LEVEL(ICMD) .EQ. ISTATE) .OR. (LEVEL(ICMD) .LT. 0)) GOTO 700
	IF (LEVEL(ICMD) .EQ. ISTATE+1) GOTO 600
	CALL DSKMSG(7,3)
	GOTO 400

C
C PAGE 7 - WIRROT
C
C
C  ***	STATE TRANSISTION HANDLER.
C
C	UPDATE ISTATE.
C	PERFORM THE TRANSISTION PROCESS.
C
C	SAVE THE CURRENT LINE BUFFER FIRST IN CASE TRANSITION PROCESSING
C	USES IT FOR AUXILIARY-FILE INPUT.
C
600	BUFCHR=NEXCHR
	BUFTOK=TOKEN
	DO 601 I=1,IBF
	  BUF(I)=LINBUF(I)
601	CONTINUE
	ISTATE=ISTATE+1
	GOTO (1100, 1200, 1300, 1400) LEVEL(ICMD)
C
C  ***	TRANSITION HANDLER RETURN POINT.
C
C	IF A FATAL ERROR OCCURRED, END THE RUN.
C
C	FIRST RESTORE THE SAVED LINE BUFFER.
C
650	NEXCHR=BUFCHR
	TOKEN=BUFTOK
	DO 651 I=1,IBF
	  LINBUF(I)=BUF(I)
651	CONTINUE
	NEWLIN=.FALSE.
	IF (.NOT. IFATAL) GOTO 700
	ISTATE=4
	GOTO 1000
C
C  ***	PROCESS THE COMMAND.
C
700	GOTO (2100,2200,2300,2400,2500,2600,2700,2800,2900,3000,
	1	3100,3200,1000) ICMD
C
C  ***	COMMAND HANDLER RETURN POINT.
C  ***	RETURN HERE IF THE DIRECTIVE IS OF THE SINGLE-LINE-ONLY TYPE.
C
725	IF (.NOT. IFATAL) GOTO 400
C
C  ***	COMMAND HANDLER RETURN POINT.
C  ***	RETURN HERE IF THE DIRECTIVE PROCESSOR READS THE $ OF THE
C  ***		NEXT DIRECTIVE (MOST DIRECTIVE PROCESSORS DO).
C
750	IF (IFATAL) GOTO 1000
	IF (ICODE .NE. 0) GOTO 200
	GOTO 500
C
C  ***	$END PROCESSOR
C
1000	CALL MSGPRT
	CALL STATS
	GOTO 100

C
C PAGE 8 - WIRROT
C
C
C  ***	STATE TRANSITION PROCESSORS
C
C
C	STATE 0 TO STATE 1 TRANSITION
C
1100	CALL COVER			!INITIALIZE THE COVER PAGE.
	GOTO 650
C
C	STATE 1 TO STATE 2 TRANSITION
C
1200	CALL LIBIN			!READ IN USER SYMBOL TABLE.
	GOTO 650
C
C	STATE 2 TO STATE 3 TRANSITION
C
1300	CALL BUILDS			!BUILD THE SPACING TABLE.
	CALL BUILDE			!BUILD THE ELECTRICAL TABLE.
	CALL BUILDC			!BUILD THE CONNECTOR PIN-ALIAS TABLE.
	CALL COMPLE			!FINISH THE TABLE-BUILD PROCESS.
	CALL CONFIG			!CHECK LAYOUT FOR LEGAL CONFIGURATION.
	CALL PLCHAN			!BUILD THE PLANE CHAINS.
	GOTO 650
C
C	STATE 3 TO STATE 4 TRANSITION
C
1400	CALL EDCHAN			!EDIT THE CHAIN LIST
	CALL CHACHK			!CHECK FOR LOGICALLY ILLEGAL CHAINS
	CALL CHACHP			!CHECK FOR ELECTRICAL ERRORS
	CALL MINI			!MINIMIZE CHAIN LENGTH
	CALL COLOUR			!ASSIGN COLORS TO THE CHAINS
	CALL MSGPRT			!PRINT ERROR MESSAGE PAGE
	CALL WIRLEN			!PRINT WIRE INVENTORY
	CALL WIRLST			!PRINT THE WIRING LISTS
	CALL CREF			!PRINT THE CROSS-REFERENCE LISTING
	GOTO 650

C
C PAGE 9 - WIRROT
C
C
C  ***	DIRECTIVE PROCESSORS
C
C
C	$TITLE DIRECTIVE
C
2100	CALL TITSET
	GOTO 725
C
C	$COMMENT DIRECTIVE
C
2200	CALL COMENT
	GOTO 750
C
C	$CREATED DIRECTIVE
C
2300	CALL CREATE
	GOTO 750
C
C	$REVISED DIRECTIVE
C
2400	CALL REVISE
	GOTO 750
C
C	$SLACK DIRECTIVE
C
2500	CALL SLKSET
	GOTO 725
C
C	$COLORS DIRECTIVE
C
2600	CALL CLRSET
	GOTO 725
C
C	$MESSAGE DIRECTIVE
C
2700	CALL MSGSET
	GOTO 750

C
C PAGE 10 - WIRROT
C
C
C	$INCLUDE DIRECTIVE
C
2800	IF (INDRCT) CALL DSKMSG(8,4)
	INDRCT=.TRUE.
	INDSYS=ISYSIN
	INDCOD=ICODE
	ISYSIN=ISYSAT
	ICODE=0
	CALL INCSET
	GOTO 725
C
C	$MAP DIRECTIVE
C
2900	CALL MAP
	GOTO 750
C
C	$PLANE DIRECTIVE
C
3000	CALL PLANE
	GOTO 750
C
C	$CONNECTO DIRECTIVE
C
3100	CALL CNECTR
	GOTO 750
C
C	$CHAINS DIRECTIVE
C
3200	CALL RDCHAN
	GOTO 750

C
C PAGE 11 - WIRROT
C
C
C  ***	FORMAT STATEMENT
C
9000	FORMAT (1H0,T8, '***   WIRAP  V', A8//)
C
C
	END