C SYSSIM.FOR ! 22-May-85 PROGRAM SYSSIM 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***************************************************************************** CHARACTER*4 SYSTEM INCLUDE 'SYSERV.DEF' INCLUDE 'VTSERV.DEF' C...... Identify ourselves CALL VT SERVICE ( clear screen ) TYPE *, 'RT-11 program to simulate other systems.' C...... Ask what system we are to simulate. 10 TYPE *, 'I can simulate CPM, POS, RSTS, RSX, TSX, UNIX, or VMS.' TYPE *, 'What system would you like?' CALL VT SERVICE ( upper case input only ) READ ( 5, '(A)' ) SYSTEM CALL VT SERVICE ( lower case input allowed ) CALL VT SERVICE ( clear screen ) C...... For more realistic simulation, include the next line C CALL SYS SERVICE ( disable control C ) C...... Jump to the appropriate simulator. IF ( SYSTEM .EQ. 'CPM' ) CALL CPM SIMULATION IF ( SYSTEM .EQ. 'POS' ) CALL POS SIMULATION IF ( SYSTEM .EQ. 'RSTS') CALL RSTS SIMULATION IF ( SYSTEM .EQ. 'RSX' ) CALL RSX SIMULATION IF ( SYSTEM .EQ. 'RT' ) CALL RT SIMULATION IF ( SYSTEM .EQ. 'TSX' ) CALL TSX SIMULATION IF ( SYSTEM .EQ. 'UNIX') CALL UNIX SIMULATION IF ( SYSTEM .EQ. 'VMS' ) CALL VMS SIMULATION C...... If we got to here, then the system name was not legal. TYPE *, 'I could not recognize what you typed.' TYPE *, ' ' GO TO 10 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 POS SIMULATION TYPE *, 'If you are simple-minded, you will love POS.' TYPE *, 'What a moment while it puts up a screen.....' TYPE *, ' ' I = ISLEEP ( 0, 0, 10, 0 ) TYPE *,'Still there? Well hang on, the fun is about to begin..' TYPE *, ' ' I = ISLEEP ( 0, 0, 5, 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, 5, 0 ) TYPE *,54HAre you sure you wouldn't rather be running PRO/RT-11? TYPE *, ' ' 10 GO TO 10 END C***************************************************************************** SUBROUTINE RSTS SIMULATION CHARACTER*5 REPLY C...... Indentify ourselves and find out what environment is desired TYPE *, 'RSTS V531.2' 10 TYPE *, ' ' TYPE *, 'Do you want an RT, RSX, or BASIC environment?' CALL VT SERVICE ( upper case input only ) READ ( 5, '(A)' ) REPLY CALL VT SERVICE ( lower case input allowed ) C...... RT simulation IF ( REPLY .EQ. 'RT' ) CALL RT SIMULATION C...... RSX simulation IF ( REPLY .EQ. 'RSX' ) THEN N = 1 20 WRITE ( 5, '(/1X,5HMCR> ,$)' ) READ ( 5, '(A)' ) REPLY IF ( N .LT. 3 ) THEN TYPE *, '?WHAT?' N = N + 1 ELSE TYPE *, '?Disk error during swap' TYPE *, 'Program lost - Sorry' N = 1 ENDIF GO TO 20 ENDIF C...... BASIC simulation IF ( REPLY .EQ. 'BASIC' ) THEN 30 TYPE *, 'Ready' TYPE *, ' ' READ ( 5, '(A)' ) REPLY GO TO 30 ENDIF C...... All other replies GO TO 10 END C***************************************************************************** SUBROUTINE RSX SIMULATION CHARACTER*7 BOOT,ODT CHARACTER*2 RSX PROMPT PARAMETER ( RSX PROMPT = '$ ' ) PARAMETER ( BOOT = '173000G' ) WRITE ( 5, '(1H+,A,$)' ) RSX PROMPT READ ( 5, '(A1)' ) I TYPE *, 'DCL -- Task already running' TYPE *,' ' WRITE ( 5, '(1H+,A,$)' ) RSX PROMPT READ ( 5, '(A1)' ) I TYPE *, 'DCL -- Task not in system' TYPE *, ' ' WRITE ( 5, '(1H+,A,$)' ) RSX PROMPT READ ( 5, '(A1)' ) I TYPE *, 'Sorry. You''re out of POOL' TYPE *, ' ' CALL SY SERVICE ( disable control C ) CALL VT SERVICE ( upper case input only ) 50 WRITE ( 5, '(2H @,$)' ) READ ( 5, '(A)' ) ODT IF ( ODT .NE. BOOT ) THEN TYPE *,'?' GO TO 50 ENDIF TYPE *,'Whew, for a minute there I thought I was a goner.' CALL EXIT 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 *, ' ' I = ISLEEP ( 0, 0, 3, 0 ) CALL RT SIMULATION 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. 3 ) GO TO 10 TYPE *, 'A disk error just caused all your files to be lost.' TYPE *, 'I hope you had them backed up.' TYPE *, ' ' I = ISLEEP ( 0, 0, 2, 0 ) 20 TYPE *,'UDE_%_%% Disk I/O Error...' GO TO 20 END C***************************************************************************** SUBROUTINE VMS SIMULATION TYPE *, ' WELCOME TO VAXLAND' TYPE *, ' ' TYPE *, ' ' TYPE 1000, 'Username: ' ACCEPT '(A2)',I TYPE 1000,'Password: ' I = ISLEEP ( 0, 0, 5, 0 ) TYPE *, ' ' TYPE *, 'User authorization failure' TYPE *, ' ' 10 GO TO 10 1000 FORMAT('+',A,$) END C***************************************************************************** C C The following subroutines are RT-11 specific C C***************************************************************************** SUBROUTINE VT SERVICE ( service code ) INCLUDE 'VTSERV.DEF' INTEGER service code BYTE CLEAR (8) DATA CLEAR / "33, '[', 'H', "33, '[', '2', 'J', "200 / IF ( service code .EQ. clear screen ) THEN CALL PRINT ( CLEAR ) ELSE IF ( service code .EQ. lower case input allowed ) THEN CALL IPOKE ( "44, IPEEK("44).OR.'40000'O ) ELSE IF ( service code .EQ. upper case input only ) THEN CALL IPOKE ( "44, IPEEK("44).AND.'137777'O ) ENDIF END C***************************************************************************** SUBROUTINE SY SERVICE ( service code ) INCLUDE 'SYSERV.DEF' INTEGER SERVICE CODE IF ( service code .EQ. disable control C ) THEN CALL SCCA (I) ENDIF END