PROGRAM SYSSIM ! 4-May-85 C***************************************************************************** C C A FORTRAN-77 program to simulate various operating systems on RT-11. C C Contributed to DECUS by the RT-11 Steering Committee. C C Principal Author: Robert Walraven C C***************************************************************************** C C This is temporary until I can get the valid syntax for RSX and UNIX C error messages. C -JMC C C***************************************************************************** COMMON JSW,KSW,NOECHO CHARACTER*4 SYSTEM C...... Ask what system we are to simulate. JSW=IPEEK ( "44 ) KSW=JSW.AND."137777 JSW=JSW.OR."40000 NOECHO="10120 TYPE *, 'RT-11 program to simulate other systems.' 10 CALL IPOKE ( "44, KSW ) TYPE *, 'I can simulate TSX, RSX, POS, VMS, UNIX, or CPM.' TYPE *, 'What system would you like?' C READ ( 5, '(A)' ) SYSTEM CALL IPOKE ( "44, JSW ) C...... Jump to the appropriate simulator. IF ( SYSTEM .EQ. 'RT' ) THEN CALL RT SIMULATION ELSE IF ( SYSTEM .EQ. 'TSX' ) THEN CALL TSX SIMULATION ELSE IF ( SYSTEM .EQ. 'RSX' ) THEN CALL RSX SIMULATION ELSE IF ( SYSTEM .EQ. 'POS' ) THEN CALL POS SIMULATION ELSE IF ( SYSTEM .EQ. 'VMS' ) THEN CALL VMS SIMULATION ELSE IF ( SYSTEM .EQ. 'UNIX') THEN CALL UNIX SIMULATION ELSE IF ( SYSTEM .EQ. 'CPM' ) THEN CALL CPM SIMULATION C C...... If we got to here, then the system name was not legal. C ELSE TYPE *, 'I could not recognize what you typed.' TYPE *, ' ' ENDIF GO TO 10 END C***************************************************************************** SUBROUTINE RT SIMULATION TYPE *,'When you have the best little operating system there is,' TYPE *,'why bother to simulate it?' TYPE *,' ' CALL EXIT END C***************************************************************************** SUBROUTINE TSX SIMULATION TYPE *, 'Since there is nobody else on the system, running TSX' TYPE *, 'is just like running RT. So...........' TYPE *, ' ' CALL RT SIMULATION END C***************************************************************************** SUBROUTINE RSX SIMULATION COMMON JSW,KSW,NOECHO CHARACTER*4 RSX PROMPT PARAMETER ( RSX PROMPT = 'MCR>' ) ASSIGN 20 TO MSG 10 WRITE ( 5, '(1H+,A,$)' ) RSX PROMPT READ ( 5, '(A1)' ) I GO TO MSG 20 TYPE *,'INS -- Task active' TYPE *,' ' ASSIGN 30 TO MSG GO TO 10 30 TYPE *,'AST abort. Bad stack' TYPE *,' ' ASSIGN 40 TO MSG GO TO 10 40 TYPE *,32HMCR -- Sorry. You're out of POOL TYPE *,' ' CALL SCCA ( I ) 50 CALL ODT SIMULATION END C***************************************************************************** SUBROUTINE POS SIMULATION TYPE *, 'If you are simple-minded, you will love POS.' TYPE *, 'What a moment while it puts up a screen.....' TYPE *, ' ' 10 I = ISLEEP ( 0, 0, 15, 0 ) TYPE *,'Still there? Well hang on, the fun is about to begin..' TYPE *, ' ' I = ISLEEP ( 0, 0, 15, 0 ) TYPE *,50HIsn't this fun? Pretty soon I'll give you a whole TYPE *,'bunch of menus to wade through.' TYPE *, ' ' I = ISLEEP ( 0, 0, 15, 0 ) TYPE *,54HAre you sure you wouldn't rather be running PRO/RT-11? TYPE *, ' ' GO TO 10 END C***************************************************************************** SUBROUTINE VMS SIMULATION COMMON JSW,KSW,NOECHO CALL IPOKE ( "44, KSW ) TYPE *, ' ' TYPE *, ' WELCOME TO VAXLAND' 10 TYPE *, ' ' TYPE *, ' ' TYPE 1000,'Username: ' ACCEPT 1001,I CALL IPOKE ( "44 , KSW .OR. NOECHO ) TYPE 1000,'Password: ' ACCEPT 1001,I CALL IPOKE ( "44, KSW ) TYPE *, ' ' TYPE *, ' ' I = ISLEEP ( 0, 0, 8, 0 ) TYPE *, 'User authorization failure' GO TO 10 1000 FORMAT ( '+',A,$ ) 1001 FORMAT ( A2 ) END C***************************************************************************** SUBROUTINE UNIX SIMULATION CHARACTER UNIX PROMPT PARAMETER ( UNIX PROMPT = '?' ) NUMBER OF TRIES = 0 10 WRITE ( 5, '(1H+,A,$)' ) UNIX PROMPT READ ( 5, '(A1)' ) I TYPE *,'The command you typed is too understandable.' TYPE *,'Please reexpress it more cryptically.' TYPE *,' ' NUMBER OF TRIES = NUMBER OF TRIES + 1 IF ( NUMBER OF TRIES .LT. 4 ) GO TO 10 TYPE *, 'A disk error just caused all your files to be lost.' TYPE *, 'I hope you had them backed up.' TYPE *, ' ' CALL SCCA ( J ) I = ISLEEP ( 0, 0, 3, 0 ) 20 IF ( J .NE. 0 ) THEN TYPE *, 58HYou don't really think it's going to be THAT easy, do you? CALL ODT SIMULATION ENDIF I = ISLEEP ( 0, 0, 0, 30 ) TYPE *,'UDE_%_%% Disk I/O Error...' GO TO 20 END C***************************************************************************** SUBROUTINE CPM SIMULATION CHARACTER*2 CPM PROMPT PARAMETER ( CPM PROMPT = 'A>' ) TYPE *, 'CP/M - Version 1.0' TYPE *, ' ' WRITE ( 5, '(1H+,A,$)' ) CPM PROMPT READ ( 5, '(A1)' ) I TYPE *, 'BDOS error' TYPE *, ' ' 20 GO TO 20 END C***************************************************************************** SUBROUTINE ODT SIMULATION IMPLICIT INTEGER (A-Z) COMMON JSW,KSW,NOECHO INTEGER*4 ADDRESS,MASK,TOP EQUIVALENCE (ADDRESS,IADDR) PARAMETER ( CTRLC = 3 ) PARAMETER ( ATSIGN = "100 ) PARAMETER ( SLASH = "57 ) PARAMETER ( ZERO = "60 ) PARAMETER ( SEVEN = "67 ) PARAMETER ( LETTRG = "107 ) PARAMETER ( LETTRP = "120 ) PARAMETER ( CRETURN = "15 ) PARAMETER ( LINEFEED = "12 ) PARAMETER ( MASK = 65535 ) PARAMETER ( BOOT = "173000 ) CALL IPOKE ( "44, KSW .OR. NOECHO ) TOP = IPEEK ( "54 ) ! USE BOTTOM OF MONITOR AS LIMIT TOP = TOP .AND. MASK 10 TYPE 1004 15 TYPE 1005 ADDRESS = 0 20 KEY = ITTINR () IF (( KEY .LT. 0 ) .OR. ( KEY .EQ. CTRLC )) GO TO 20 CALL ITTOUR ( KEY ) IF ( KEY .EQ. LETTRP ) GO TO 10 IF ( KEY .EQ. LETTRG ) THEN CALL ITTOUR ( LINEFEED ) IF ( IADDR .EQ. BOOT ) THEN CALL IPOKE ( "44, KSW ) TYPE *,'Whew, for a minute there I thought I was a goner.' CALL SCCA CALL EXIT ENDIF GO TO 10 ELSE IF ( KEY .EQ. SLASH ) THEN 25 IF ( ADDRESS .GE. TOP ) GO TO 45 IF ( (IADDR.AND.1) .NE. 0 ) GO TO 45 J = IPEEK ( IADDR ) TYPE 1000,J GO TO 29 26 IF ( ADDRESS .GE. TOP ) GO TO 45 J = IPEEK ( IADDR ) TYPE 1002,IADDR,J 29 DIGITS=0 30 KEY = ITTINR () IF ( KEY .LT. 0 ) GO TO 30 IF ( KEY .EQ. CRETURN ) THEN 35 KEY = ITTINR () IF ( KEY .NE. LINEFEED ) GO TO 35 GO TO 15 ENDIF IF ( KEY .EQ. LINEFEED ) THEN IADDR = IADDR + 2 CALL ITTOUR ( CRETURN ) GO TO 26 ENDIF 40 CALL ITTOUR ( KEY ) IF (( KEY .LT. ZERO ) .OR. ( KEY .GT. SEVEN )) GO TO 45 DIGITS=DIGITS+1 IF ( DIGITS .GT. 6 ) GO TO 45 GO TO 30 ELSE IF (( KEY .GE. ZERO ) .AND. ( KEY .LE. SEVEN )) THEN ADDRESS = 8 * ADDRESS + KEY - ZERO ADDRESS = ADDRESS .AND. MASK GO TO 20 ELSE 45 TYPE 1003 GO TO 15 ENDIF 1000 FORMAT ( '+', O6.6, ' ', $ ) 1002 FORMAT ( /'+', O6.6, '/ ' O6.6, ' ', $ ) 1003 FORMAT ( '+?' ) 1004 FORMAT ( /' 000002' ) 1005 FORMAT ( /'+@', $ ) END