--- /dev/null
+#!/bin/bash
+# Assembler wrapper for simh h316
+
+if [ ! $1 ] ; then
+ echo "Argument fehlt!"
+ exit 2
+fi
+
+name=`basename $1 .asm`
+listfile=$name.lst
+
+cat $1 | tab | paron > $name.par
+rm -f $name.lst
+rm -f $name.obj
+
+echo "rest $H316/sys/dap.sys" > $name.go
+echo "d a 120420" >> $name.go
+echo "at ptr $name.par" >> $name.go
+echo "at ptp $name.obj" >> $name.go
+echo "at tty3 $listfile" >> $name.go
+echo "set tty3 uascii" >> $name.go
+echo "set tty3 start" >> $name.go
+echo "go" >> $name.go
+echo "d ptr pos 0" >> $name.go
+echo "go" >> $name.go
+echo "quit" >> $name.go
+h316 $name.go > /dev/null
+
+rm -f $name.par
+rm -f $name.go
+
+if cat $name.lst | grep "NO ERRORS IN ABOVE ASSEMBLY">/dev/null 2>&1; then
+ if [ ! $2 ]; then
+ rm $name.lst
+ fi
+ echo "DAP-16 assembly successfull :-)"
+ exit 0
+fi
+cat $name.lst
+echo -e "\nDAP-16 assembly FAILED!"
+rm -f $name.obj
+exit 77
+
--- /dev/null
+#!/bin/bash
+# FORTRAN IV compiler wrapper for simh h316
+
+if [ ! $1 ] ; then
+ echo "Argument fehlt!"
+ exit 2
+fi
+
+name=`basename $1 .f`
+listfile=$name.lst
+
+cat $1 | tab | paron > $name.par
+rm -f $name.lst
+rm -f $name.obj
+
+echo "rest $H316/sys/frtn.sys" > $name.go
+
+echo "r" >> $name.go
+
+echo "at ptr $name.par" >> $name.go
+echo "at ptp $name.obj" >> $name.go
+echo "at tty3 $listfile" >> $name.go
+echo "set tty3 uascii" >> $name.go
+echo "set tty3 start" >> $name.go
+
+echo "d a 311" >> $name.go
+echo "d p 1000" >> $name.go
+
+echo "go" >> $name.go
+echo "quit" >> $name.go
+h316 $name.go > /dev/null
+
+rm -f $name.par
+rm -f $name.go
+
+if cat $name.lst | egrep "[*]{36,40}">/dev/null 2>&1; then
+ cat $name.lst
+ echo -e "\n\nFORTRAN IV compilation FAILED!"
+ rm -f $name.obj
+ exit 77
+fi
+
+if [ ! $2 ]; then
+ rm $name.lst
+fi
+echo "FORTRAN IV compilation successfull."
+exit 0
+
+
+
--- /dev/null
+How to build the mandelbrot-demo program
+
+1. Needed
+
+ - source files (found in mandelbrot-demo.tar.gz):
+ apfel.f
+ pchar.asm
+
+ - compiler, assembler, loader, punch program (found in tape-images.new.tar.gz):
+ SLST-FRTN.img
+ SLST-LDR-APM.img
+ OBJECT-PAL-AP.img
+ SLST-DAP-16.img
+
+ - fortran library, 3 files (found in tape-images.new.tar.gz):
+ LIBRARY-FORT_LIB_1.img
+ LIBRARY-FOR_LIB_2S.img
+ LIBRARY-FORT_LIB_3.img
+
+
+1. Prepare source files.
+ - You have to change the source files to <CR><LF> line termination (MS-DOS style)
+ - Then you have to set the 8th bit on all data - yes, you can't it read anymore...
+ There are also some tricks with an & in the emulator...
+
+ - Remove my header from the SLST files. In library files no problem.
+
+ - If you use the Emulator: go to step 2.
+ - If you use the original machine: punch out the source tapes :-)
+
+2. Build pchar routine
+ PCHAR is a little assembler routine allowing simplest unformatted io.
+
+ - Boot SLST-DAP-16.img
+ - MSTCLR
+ - A reg: Set bits:
+ -1 Two-pass assembly
+ -3 Input from high-speed paper tape
+ -11 NO object output
+ -12 Listing on teletype
+ - P reg: '1000
+
+
+ Real machine:
+
+ - Mount the source tape into the high speed reader, turn on ASR
+ - press START and wait.....
+ - Assembly should stop at the end of text on the tape. Tape should not
+ run out.
+ - Reposition tape to the beginning.
+ - Press start again.
+ - After completion the assembler says "AC". With or without errors!!
+
+ Now you have a listing. Let's build the object file:
+
+ - Mount the source tape into the high speed reader, turn on ASR punch
+ - A-reg bits 1-3-7-16 (no listing, object to asr, no listing)
+ - P-REG 1000
+ - Reposition tape to the beginning.
+ - Press start again.
+ - After completion the assembler says "AC". With or without errors!!
+
+ Now you have the pchar object. Need it later.
+
+ Emulator:
+ - Same register settings as on real machine.
+ - Press START, emulator will ask for "ptr" file.
+ - enter "pchar.par" or whatever you have chosen for the converted file.
+ - The assembler will stop.
+ - Press START again.
+ - Will say EOF and ask for more paper. give source file again.
+ - Should print listing and say "AC"
+
+ Make the object:
+ - A-reg 1-3-8-16, P-reg '1000
+ - Same procedure but answer the questions "ptp" with your new
+ object's filename, "pchar.obj" for example.
+ - Notice: look closely if you're asked for PTP or PTR. If you enter your
+ source file name at PTP it will be erased instantly!!
+ - Leave emulator program. Important to really close.
+
+ Now you have the pchar object. Need it later.
+
+ NOTICE: Sometimes the emulator asks for a file
+ and does not echo your keystrokes.
+ BUT IT WORKS!!!!
+
+
+3. Build mail object file
+ - That's easier than using the two-pass assembler....!
+ - Boot SLST-FRTN.img
+ - MSTRCLR
+ - A-reg settings:
+ -'000310: Listing on ASR, suppress verbosity by setting sense switch 2
+ -'000302: Object output to ASR
+ - Operation:
+ -Start at '1000 like with the assembler. But only one pass.
+ -Will type "end of job"....
+ - Now you should have two different object tapes or files.
+ - Leave emulator!!!!
+
+4. Putting all together
+ - Boot SLST-LDR-APM.img
+ - MSTRCLR
+ - Change contents of memory address '15000 to '17777 or '37777
+ - MSTRCLR
+ - A-reg '17000, P-reg '16000
+ - OBJECT-PAL-AP.img needed. Mount tape now if using real hardware
+ - Press START TWICE
+ - if using emulator, enter "OBJECT-PAL-AP.img" at the PTR prompt
+ - LDR-APM now loads PAL-AP. Should say LC when ready. If it says CK you
+ have a checksum error on the tape. If tape runs out you have a problem
+
+ Now load apfel.obj:
+ - MSTRCLR
+ - P-reg '16000 A-reg '1000
+ - now the usual sequence "tape and start" for real machine, and "start and tape"
+ for emulator. using apfel.obj
+ - Will say MR. Means that you have unresolved symbols.
+ - If you like to you can set P-reg to '16002' and start. You'll get a memory map.
+
+ - Go on loading with pchar.obj. Loading continues if START is pressed
+ - Now process the library files the same way. The order is important. 1,2,3
+ - If you have managed this you will get LC (loading complete).
+
+ Now the application is ready to run. But wait! Don't you want to generate a
+ self loading system tape (SLST) with PAL-AP? Sure! So you can always restore the
+ actual state without doing all the patching stuff.
+
+ - Punch on ASR on.
+ - P-reg '17000', A-reg set only bit 1.
+ - Press START. Computer will halt.
+ - Enter '100 to A-reg and press START. Will halt again.
+ - Enter '6700 to A-reg and press START. Will begin to punch
+ self loading tape. (or ask for file etc... ASRPTP)
+
+ Now you have the SLST and can easily load the program by booting the tape.
+
+5. Start the program
+ - When the program is loaded start the computer at '1000. That's all.
+ - When program is ready PA will be printed and CP halts. If you press START
+ it will start a new run.
+
+6. Good luck. I hope I have described enough...
+
+
+
+
+
+
--- /dev/null
+all: *.tex
+ latex main.tex && dvips -omain.ps main.dvi
+
+clean:
+ rm -f *.toc *.ps *.pdf *.dvi *.aux *.log
+
+
+.PHONY: clean
--- /dev/null
+\chapter{DAP-16 Assembler}
+
+\section{Quelltextformat}
+Das meiste Kopfzerbrechen, das mir die Benutzung des Assemblers beschert hat, rührte
+daher, daß ich das Quelltextformat nicht komplett begriffen hatte.\\
+Deswegen möchte ich hier die beiden zulässigen Formate genau beschreiben.
+\subsection{Festformat}
+
+Alles stammt von der Lochkarte ab. Das ist ein immer wieder wichtiger Merksatz.\\
+Im Festformat besteht jede Zeile aus exakt 72 (?) Zeichen, gefolgt von einem \verb:<LF>:
+(ASCII 10) Zeichen.
+Ein dem \verb:<LF>: vorangestelltes \verb:<CR>: wird geduldet, ist aber unnötig.
+Dabei gilt die folgende Zeileneinteilung:\\
+\begin{center}
+\begin{tabular}{r|p{4em}|p{0.1cm}|l|l|l|l }
+ Position: & 1-4 & & 6-10 & & 12-30 & 30-72 \\ \hline
+ Aufgabe: & Marke & & Befehl & & Argumente & Kommentar \\
+\end{tabular}
+\end{center}
+\vspace{1em}
+Beispiel:
+\begin{verbatim}
+STRT LDA OP1 DIES IST EINE ASSEMBLERZEILE
+\end{verbatim}
+
+\subsection{Tabulatorformat}
+Das Tabulatorformat wurde eingeführt, um bei Benutzung von Lochstreifen nicht immer jede Zeile
+komplett vollschreiben bzw. mit Leerzeichen auffüllen zu müssen. Als Tabulatorzeichen wird der
+Backslash (\verb:\:) benutzt. Mit dem Backslash kann man zum nächsten Feld springen, sich also
+die Leerzeichen und die Zählerei sparen. Allerdings sieht eine auf dem ASR geschriebene Codezeile
+im Tabulatorformat nicht sehr übersichtlich aus.\\
+Hier das Beispiel von oben im Tabulatorformat:
+\begin{verbatim}
+STRT\LDA\OP1\DIES IST EINE ASSEMBLERZEILE
+\end{verbatim}
+Wenn Felder leer bleiben sollen, z.B. das Markenfeld am Anfang, muß trotzdem der entsprechende
+Backslash eingefügt werden:
+\begin{verbatim}
+\ICA\\ZEILE OHNE MARKE UND OPERAND
+\end{verbatim}
+
+\subsection{Quelltexte aus dem PC}
+Wenn man DAP-16-Quelltext auf dem PC schreibt, bietet es sich an, echte \verb:<TAB>:-Zeichen zu
+benutzen und diese dann kurz vor der Benutzung automatisiert in Backslashes umzuwandeln.\\
+Wichtig ist auch, daß der Assembler (der FORTRAN IV Compiler auch!)
+alle Eingangsdaten als 7 bit ASCII plus gesetztem achtem Bit erwartet.
+Andere Zeichen werden ignoriert!!\\
+Dafür braucht man ein kleines Filterprogramm.
+
+\section{Assemblieren}
+\begin{enumerate}
+\item Assembler in den Kernspeicher laden.
+\item A-Register mit Einstellungen füllen.
+\item Quelltext in Lochstreifenleser einlegen.
+\item \verb:START: am Computer drücken, warten.
+\item nach dem ersten Durchlauf Band wieder einlegen, wieder \verb:START: drücken.
+\end{enumerate}
+\vspace{0.5cm}
+Einstellungen für's A-Register:
+\begin{verbatim}
+Bit 1: Immer setzen für 2-pass-Assemblierung
+
+Auswahl der Quelle für den Quelltext:
+Bit 2: Teletype
+Bit 3: Lochstreifenleser
+
+Auswahl des Ziels für Objektdaten:
+Bit 7: Teletype
+Bit 8: Locher
+Bit 11: Keinen Objektcode ausgeben
+
+Auswahl des Ziels für das Listing:
+Bit 12: Teletype
+Bit 13: Locher
+Bit 15: Zeilendrucker
+Bit 16: Kein Listing
+\end{verbatim}
--- /dev/null
+\input{assembler}
+\input{compiler}
+
+
+
+
+
--- /dev/null
+\chapter{FORTRAN IV Compiler}
+\section{Kompilieren}
+\subsection{Einstellungen im A-Register}
+\begin{verbatim}
+
+\end{verbatim}
\ No newline at end of file
--- /dev/null
+\documentclass[twoside]{book}
+\usepackage{a4wide}
+\usepackage[latin1]{inputenc}
+\usepackage[german]{babel}
+\usepackage{graphics}
+
+\begin{document}
+\sffamily
+
+\author{Philipp Hachtmann}
+\title{H316 - Kurzanleitung\\{\large - vorl\"aufige Ausgabe -}}
+\maketitle
+\tableofcontents
+\renewcommand{\labelenumi}{\arabic{enumi}. }
+
+\input{body}
+\end{document}
--- /dev/null
+* (F$W1) HACHTI-NACHBAU REV.A
+*
+*
+*
+*
+* PROGRAM TITLE: F$W1
+* OUTPUT BCD ON ASR
+*
+*
+*
+* USE
+*
+* CALLING SEQUENCE
+*
+* CALL F$W1
+* DAC N WHERE N IS THE LOCATION OF THE FORMAT
+* DESCRIPTOR LIST
+*
+ SUBR F$W1,FW1
+ REL
+FW1 DAC **
+ CALL F$IO
+FW1A DAC **
+ LDA* FW1A
+ STA FW1H
+ LDA* FW1H
+*
+ LRL 8
+ CAS ='261
+ JMP FW1B
+ JMP FW1C
+ CAS *+1
+ OCT 260
+ JMP FW1D
+ CAS ='255
+ JMP FW1B
+ JMP FW1F
+ CAS ='253
+ JMP FW1B
+ JMP FW1F
+FW1B JST FW1J
+ JMP FW1G
+FW1C JST FW1J
+ CAS =-60
+ JMP FW1C
+ JMP FW1F
+ JMP FW1C
+FW1D JST FW1J
+FW1E JST FW1J
+FW1F LDA* FW1H
+ ANA ='377
+ ERA ='120000
+ STA* FW1H
+FW1G CALL O$AC
+ CALL O$AP
+FW1H *** **
+ IRS FW1A
+ JMP* FW1A
+FW1J DAC **
+ CALL O$AF
+ IRS CNTR
+ JMP* FW1J
+ LDA =-17
+ STA CNTR
+*
+FW1K CALL O$AF
+ IRS CNTR
+ JMP FW1K
+ LDA =-60
+ STA CNTR
+ JMP* FW1J
+CNTR OCT -60
+FW1L LDA ='377
+ LLL 8
+ STA* FW1H
+ JMP FW1G+1
+ END
+
+
+
--- /dev/null
+* (F$W4) REBUILD 1
+*
+*
+*
+* PROGRAM TITLE: F$W4
+* OUTPUT BCD ON LINE PRINTER
+*
+*
+*
+* USE
+*
+* CALLING SEQUENCE
+*
+* CALL F$W4
+* DAC N WHERE N IS THE LOCATION OF THE FORMAT
+* DESCRIPTOR LIST
+*
+ SUBR F$W4,FW4
+*
+*
+*
+ REL
+FW4 DAC **
+ CALL F$IO
+FW4A DAC **
+ LDA* FW4A
+ STA FW4H
+ LDA* FW4H
+*
+ LRL 8
+ CAS ='261
+ JMP FW4B
+ JMP FW4C
+ CAS *+1
+ OCT 260
+ JMP FW4D
+ CAS ='255
+ JMP FW4B
+ JMP FW4F
+ CAS ='253
+ JMP FW4B
+ JMP FW4F
+FW4B JST FW4J
+ JMP FW4G
+FW4C JST FW4J
+ CAS =-60
+ JMP FW4C
+ JMP FW4F
+ JMP FW4C
+FW4D JST FW4J
+FW4E JST FW4J
+FW4F LDA* FW4H
+ ANA ='377
+ ERA ='120000
+ STA* FW4H
+FW4G CALL O$LC CARRIAGE RETURN ONLY
+ CALL O$LP OUTPUT ONE LINE OF INFORMATION
+FW4H *** **
+ IRS FW4A
+ JMP* FW4A
+FW4J DAC **
+ CALL O$PF LF ONLY
+ IRS CNTR
+ JMP* FW4J
+ LDA =-17
+ STA CNTR
+*
+FW4K CALL O$PF LF ONLY
+ IRS CNTR
+ JMP FW4K
+ LDA =-60
+ STA CNTR
+ JMP* FW4J
+CNTR OCT -60
+FW4L LDA ='377
+ LLL 8
+ STA* FW4H
+ JMP FW4G+1
+ END
--- /dev/null
+* (FPATCH) REV.B (6.2.2005)
+*
+*
+* COMPUTER: H316
+*
+* PROGRAM CATEGORY: I/O LIBRARY
+*
+* PROGRAM TITLE: FPATCH
+* FORTRAN COMPILER PATCH
+*
+*
+* AUTHOR
+*
+* PHILIPP HACHTMANN
+*
+* REVISIONS
+* REV. B (6.2.2005) ADDED CORRECT DATA POOL ENTRY MANIPULATION
+*
+* PURPOSE
+*
+* THIS PATCH IS TO ENABLE THE FORTRAN IV COMPILER TO USE THE
+* O$LA AND O$LH SUBROUTINES
+*
+*
+* RESTRICTIONS
+*
+* DEPENDS ON HACHTI'S HARDWARE AND FORTRAN IV COMPILER TAPE
+*
+*
+* STORAGE
+*
+* 50 (OCTAL)
+* 40 (DECIMAL)
+*
+*
+* USE
+*
+* THE LIBRARY ROUTINES ARE FOR GENERAL PURPOSE.
+* TO APPLY THE PATCH:
+* - BOOT FRTN SYSTEM TAPE
+* - LOAD O$LA AT LOCATION '20000
+* - LOAD FPATCH SOMEWHERE ABOVE
+* - RUN FROM FIRST LOCATION OF FPATCH
+*
+********************************************************************************
+ SUBR FPATCH,PTCH ONLY FOR NAMING PURPOSES
+********************************************************************************
+*
+IOSB EQU '15036 IOS' BASE ADDRESS
+IOSS EQU '36 INNER SECTOR OFFSET
+PT1 EQU '611 FIRST FREELY USABLE ADDRESS IN IOS' SPACE
+PT2 EQU '612 SECOND FREELY USABLE ADDRESS IN IOS' SPACE
+PTE EQU '610 ADDRESS WHICH MUST BE FILLED WITH "V?"
+PTS EQU '635 MESSAGE SIZE OF "DEVICE?" ERROR MESSAGE
+JH EQU '173 ADDRESS OF CALL O$LH INSTRUCTION IN IOS
+JL EQU '252 ADDRESS OF CALL O$LA INSTRUCTIIN IN IOS
+DUM EQU '16612 DUMY OBJECT'S BASE ADDRESS
+DPO EQU '16 ADDRESS OF ORIGINAL DUMY'S OWN BASE POINTER
+*
+JSTI EQU '121000 JST* INSTRUCTION
+*
+ REL LET'S BEGIN RELATIVE
+ SUBR ENDPAL,FNS END OF THE IMPORTANT PART
+ REL RELATIVE MODE
+ND1 *** **
+ *** **
+ *** **
+ *** **
+ND2 *** **
+*
+*
+ ABS ABSOLUTE MODE
+ ORG '21000
+PTCH NOP
+ LDX IOS ADDRESSES WILL BE RELATIVE TO IOS' BEGINNING
+ LDA OLHA O$LH ADDRESS (OK)
+ STA PT1,1 STORE TO POINTER LOCATION (OK)
+ LDA OLLA O$LA ADDRESS (OK)
+ STA PT2,1 STORE TO POINTER LOCATION (OK)
+ LDA VQ LOAD "V?" (OK)
+ STA PTE,1 REPAIR "DEV?" MSG (OK)
+ LDA ='-4
+ STA PTS,1 NEW MESSAGE SIZE (OK)
+*
+ LDA JMP1 NEUER SPRUNG
+ STA JH,1
+ LDA JMP2
+ STA JL,1
+**************
+*
+ LDA ND2P ADDRESS OF NEW "DUMMY ROUTINE"
+ STA* DP STORE TO VARIABLE IN ORIGINAL DUMMY ROUTINE
+ LDA ND1P1
+ STA '100
+ AOA
+ STA '101
+ AOA
+ STA '102
+ AOA
+ STA '103
+ AOA
+ STA '104
+ AOA
+ STA '105
+ AOA
+ STA '106
+ AOA
+ STA '107
+ AOA
+ STA '110
+ AOA
+ STA '111
+ AOA
+ STA '112
+*
+**********
+* READY
+ LDA OK LOAD OK
+ ICA
+ OCP '104
+ OTA 4
+ JMP *-1
+ ICA
+ OTA 4
+ JMP *-1
+ LDA CRLF
+ ICA
+ OTA 4
+ JMP *-1
+ ICA
+ OTA 4
+ JMP *-1
+ HLT
+ JMP *-1
+*
+**********
+*
+* KONSTANTEN
+VQ BCI 1,V?
+CRLF OCT 6412
+OK BCI 1,OK
+OLLA XAC O$LA
+OLHA XAC O$LH
+*
+IOS DAC IOSB IOS BASE ADDRESS
+DP DAC DUM+'52 "DP" VARIABLE ADDRESS
+ND1P DAC ND1,1 NEW DUMMY ROUTINE'S BASE ADDRESS + INDEX BIT
+ND2P DAC ND2 NEW DUMMY ROUTINE'S START ADDRESS
+*
+DUMB DAC DUM ORIGNAL DUMMY'S START ADDRESS
+* POINTER USW
+JMP1 DAC JSTI+PT1+IOSS
+JMP2 DAC JSTI+PT2+IOSS
+*
+*******************************************************************************
+*
+*
+* ORG '100
+* DAC NDUM-4,1
+* DAC NDUM-3,1
+* DAC NDUM-2,1
+* DAC NDUM-1,1
+* DAC NDUM,1
+* DAC NDUM+1,1
+* DAC NDUM+2,1
+* DAC NDUM+3,1
+* DAC NDUM+4,1
+* DAC NDUM+5,1
+* DAC NDUM+6,1
+*
+* PUH.....
+*
+ END
--- /dev/null
+* PRINT CHAR
+*
+*
+****** USAGE
+*
+* JST PCHAR
+* DAC Arg1
+*
+*
+*
+ SUBR PCHAR,P
+ REL
+*
+*
+P DAC **
+ LDA* P ERSTE ARG-ADRESSE
+ STA TMP1 POINTER
+ LDA* TMP1 IN
+**** OCP '104 ASR START
+ SKS 4 WAIT FOR ASR33
+ JMP *-1 TO BECOME READY
+ CAL CLEAR UPPER BITS
+ OTA 4 OUTPUT CHAR
+ JMP *-1 SECURITY
+ IRS P RETURN ADDRESS
+ JMP* P
+*******
+TMP1 DEC 0
+TMP2 DEC 0
+*******
+ END
--- /dev/null
+* PRINT CHAR - ON LINEPRINTER :-)
+*
+*
+****** USAGE
+*
+* JST PCHAR
+* DAC Arg1
+*
+*
+*
+ SUBR PCHAR,P
+ REL
+*
+*
+P DAC **
+ LDA* P ERSTE ARG-ADRESSE
+ STA TMP1 POINTER
+ LDA* TMP1 IN
+ OTA 0 OUTPUT CHAR
+ JMP *-1 SECURITY
+ IRS P RETURN ADDRESS
+ JMP* P
+*******
+TMP1 DEC 0
+TMP2 DEC 0
+*******
+ END
--- /dev/null
+* UPPER CHAR
+* UC(INTEGER) RETURN THE ARGUMENT'S FIRST 8 BIT IN LOWER 8 BIT
+*
+* USAGE:
+* JST UC
+* DAC ARG1
+*
+* RESULT WILL BE IN A-REG
+*
+*
+*******
+ REL
+ SUBR UC
+UC DAC **
+ LDA* UC
+ IRS UC RETURN ADDRESS
+ ICL
+ JMP* UC
+*******
+ END
--- /dev/null
+* (I$PA)
+*
+*
+* COMPUTER: H316
+*
+* PROGRAM CATEGORY: I/O LIBRARY
+*
+* PROGRAM TITLE: I$PA (I$PI)
+*
+*
+* REVISIONS:
+* 0.1 (2005-02.04)
+*
+* AUTHOR
+*
+* PHILIPP HACHTMANN
+*
+*
+* PURPOSE
+*
+* TO READ ASCII SOURCE TEXT FROM HIGH SPEED PAPTER TAPE READER
+*
+*
+* RESTRICTIONS
+*
+* NOT ALL FUNCTIONALITY MAY BE COMPLETELY RECOVERED BECAUSE
+* OF MISSING INFORMATION.
+*
+* STORAGE
+*
+* 176 (OCTAL)
+* 126 (DECIMAL)
+*
+*
+* USE
+*
+* I$PA - READ LINE OF SOURCE CODE USING TAB CHARACTERS
+* CALL I$PA
+* DAC (BUFFER ADDRESS)
+*
+* I$PI - CONFIGURE O$PA
+* CALL O$PI
+* DEC (NUMBER OF WORDS IN DATA BUFFER)
+* DEC (NUMBER OF TABS IN FOLLOWING TABLE, IF ANY)
+* DEC TAB (1)
+* DEC TAB (2)
+* . .
+* . .
+* . .
+* DEC TAB (N)
+*
+*
+********************************************************************************
+*
+* EXPORTED LABELS
+ SUBR I$PA
+ SUBR I$PI
+*
+*
+*
+ REL RELOCATEABLE MODE
+*
+*
+* SETUP READ ROUTINE
+*
+I$PI DAC ** SETUP READ ROUTINE
+ LDA* I$PI WORD COUNT PARAMETER
+ LGL 1 LEFT SHIFT 1
+ STA LIM BUFFER LIMIT
+*
+ IRS I$PI TALLY RETURN ADDRESS
+ LDA* I$PI TAB COUNT PARAMETER
+ STA NTAB TAB COUNT
+*
+ LDA I$PI RETURN ADDRESS
+ AOA TALLY BY 1
+ STA TABL TAB TABLE LINK
+*
+ ADD NTAB TAB COUNT
+ STA I$PI RETURN ADDRESS
+ JMP* I$PI EXIT
+*
+*
+* READ ROUTINE
+*
+I$PA DAC ** READ ROUTINE
+ STX SIR SAVED INDEX REGISTER
+ LDA* I$PA BUFFER ADDRESS PARAMETER
+ LGL 1 LEFT SHIFT 1
+ STA BUFL BUFFER LINK
+*
+RSTR LDA =1 POSITION 1
+ STA CP CHARACTER POSITION
+*
+STSP LDA ='240 SPACE
+ JST NSRT INSERT IN CHARACTER POSITION
+ JMP STSP LOOP AGAIN
+*
+ LDA =1 POSITION 1
+SCP STA CP CHARACTER POSITION
+*
+* INPUT AND TEST FOR SPECIAL CODES
+READ NOP
+RES LDX =-4 INDEX REGISTER = -4
+ JST INPT READ ONE CHARACTER
+*
+ CAS ='337 LEFT ARROW?
+ SKP NO, SKIP
+ JMP DLT YES, DELETE LINE
+*
+ISIT CAS IGNT+4,1 IGNORE TABLE
+ SKP NO, SKIP
+ JMP RES YES, IGNORE IT
+*
+ IRS 0 TALLY INDEX REGISTER
+ JMP ISIT LOOP AGAIN
+*
+ CAS ='215 CARRIAGE RETURN?
+ SKP NO, SKIP
+ JMP EXIT YES, END-OF-RECORD
+*
+ CAS ='334 BACKSLASH?
+ SKP NO, SKIP
+ JMP TAB YES, TAB
+*
+ CAS ='203 END-OF-TEXT?
+ SKP NO, SKP
+ JMP EXIT+1 YES, ETX
+*
+* NO ACTION CHARACTER
+NAC JST NSRT INSERT IN CHARACTER POSITION
+ JMP READ BUFFER NOT FULL, LOOP AGAIN
+ JMP READ BUFFER NOW FULL, LOOP AGAIN
+*
+* TAB ROUTINE
+TAB CRA CLEAR A-REGISTER
+ SUB NTAB TAB COUNT
+ SNZ NZ, SKIP
+ JMP NOTB Z, NO TABS
+*
+ STA 0 INDEX REGISTER
+ LDA TABL TAB TABLE LINK
+ STA TABI TABLE POINTER
+*
+ITAB LDA* TABI TABLE POINTER
+ IRS TABI TALLY TABLE POINTER
+ CAS CP CHARACTER POSITION
+ JMP SCP GR, SET NEW CHARACTER POSITION
+ NOP EQ, LOOP AGAIN
+ IRS 0 LE, TALLY INDEX REGISTER
+ JMP ITAB LOOP AGAIN
+*
+NOTB LDA ='240 SPACE
+ JMP NAC RETURN TO INSERT CHARACTER
+*
+* INSERT IN CHARACTER POSITION
+NSRT DAC ** INSERT IN CHARACTER POSITION
+ LRR 8 RIGHT ROTATE BOTH 8
+ LDA CP CHARACTER POSITION
+ CAS LIM BUFFER LIMIT
+ JMP DNA GR, DO NOT ACCEPT
+ NOP EQ, ACCEPT AND PACK
+* LE, ACCEPT AND PACK
+ SUB =1 SUBSTRACT 1
+ ADD BUFL BUFFER LINK
+ LGR 1 RIGHT SHIFT 1
+ STA TABI TABLE POINTER
+*
+ LDA* TABI TABLE POINTER
+ SSC C SET, SKIP
+ IAB C RESET, INTERCHANGE A AND B
+ LGR 8 SHIFT RIGHT 8
+ LLR 8 LEFT ROTATE BOTH 8
+ STA* TABI TABLE POINTER
+ IRS CP TALLY CHARACTER POSITION
+ JMP* NSRT EXIT
+*
+DNA IRS NSRT TALLY RETURN ADDRESS
+ JMP* NSRT EXIT
+*
+* LEFT-ARROW ROUTINE
+DLT JST INPT READ ONE CHARACTER
+ ERA ='215 CARRIAGE RETURN
+ SZE Z, SKIP
+ JMP DLT NZ, LOOP AGAIN
+*
+ JMP RSTR RESTART
+*
+* RETURN TO CALLING PROGRAM
+EXIT IRS I$PA TALLY RETURN ADDRESS
+ IRS I$PA TALLY RETURN ADDRESS
+*
+ LDX SIR SAVED INDEX REGISTER
+ JMP* I$PA EXIT
+*
+* CHARACTER INPUT ROUTINE
+INPT DAC **
+ OCP 1 START READER
+ INA '1001 READ ONE CHARACTER
+ JMP *-1 WAIT FOR FINISH
+ OCP '101 TURN OFF READER
+*
+ ANA ='177 BITS 10-16
+ ERA ='200 TOGGLE BIT 9
+ JMP* INPT RETURN
+*
+*
+* VARIABLES AND CONSTANTS
+*
+SIR BSZ 1 STORED INDEX REGISTER
+BUFL BSZ 1 BUFFER LINK
+CP BSZ 1 CHARACTER POSITION
+TABI BSZ 1 TABLE POINTER
+*
+* CHANGEABLE PARAMETERS
+LIM DEC 80 BUFFER LIMIT (DEFAULT IS 80)
+NTAB DEC 4 TAB COUNT (DEFAULT IS 4)
+TABL DAC TABS TAB TABLE LINK (DEFAULT IS TABS)
+*
+* DAP-16 TAB SETTINGS
+TABS DEC 6 OPERATION FIELD
+ DEC 12 VARIABLE FIELD
+ DEC 30 COMMENTS FIELD
+ DEC 73 IDENTIFICATION FIELD
+*
+* IGNORABLE CHARACTERS
+IGNT OCT 200 BLANK TAPE
+ OCT 212 LINE FEED
+ OCT 223 X-OFF
+ OCT 377 RUB-OUT
+*
+* LITERALS
+ FIN
+*
+*
+ END END OF I$PA 4.2.2005
--- /dev/null
+* (O$AL) - TYPING ROUTINES
+*
+*
+* PROGRAM TITLE: O$AL (O$AL,O$AE,O$AH,O$AC,O$AF)
+* ASR TYPING ROUTINES
+*
+* REVISIONS:
+* 1.0 (5.2.2005)
+*
+* AUTHOR
+*
+* PHILIPP HACHTMANN
+*
+*
+* PURPOSE
+*
+* ASR OUTPUT ROUTINES FOR LISTING
+*
+*
+* RESTRICTIONS
+*
+* THESE ARE NOT THE ORIGINAL
+*
+*
+* STORAGE
+*
+* 310 (OCTAL)
+* 200 (DECIMAL)
+*
+*
+*
+**********************************************************************
+ SUBR O$AL,OSAL TYPE A COMPLETE LINE WITH CR/LF, HEADING ETC.
+ SUBR O$AH,OSAH INITIALISE HEADING
+ SUBR O$LL,OSAL TYPE A COMPLETE LINE WITH CR/LF, HEADING ETC.
+ SUBR O$HH,OSAH INITIALISE HEADING
+ SUBR O$AP,T1 TYPE A LINE, NO CR
+ SUBR O$AC,T20 RETURN THE CARRIAGE
+ SUBR O$AF,T30 ADVANCE TO NEXT LINE
+ SUBR O$AE,FF EJECT PAGE
+*
+ SUBR O$A1,HDS EMPTY LINES BETWEEN TOP OF PAGE AND HEADING
+ SUBR O$A2,SPC EMPTY LINES BETWEEN HEADING AND MAIN TEXT
+ SUBR O$A3,PGS PURE TEXT LINES PER PAGE
+ SUBR O$A4,WIDH PURE TEXT LINES PER PAGE
+ SUBR O$A5,SFF SKIPS TO SIMULATE FORM FEED
+**********************************************************************
+ REL RELOCATABLE MODE
+*********************************************
+* CONFIGURATION
+HDS DEC 1 EMPTY LINES BEFORE HEADING
+SPC DEC 2 EMPTY LINES BETWEEN HEADING AND TEXT
+PGS DEC 50 DATA LINES PER PAGE (WITHOUT HEADING ETC.)
+WIDH DEC 36 (2-CHAR) WORDS PER LINE
+SFF DEC 4 SKIPS TO SIMULATE FORM FEED
+*
+*
+OSAL DAC **
+ STX XR
+ LDA* OSAL BUFFER ADDRESS
+ STA BUF1 STORE FOR LATER USE
+ LDA LINE LINE COUNTER
+ SZE STILL LINES LEFT?
+ JMP PGOK NO NEW PAGE
+ JST FF
+ JST NP NEW PAGE REQUIRED
+PGOK IRS LINE BUMP COUNTER
+ NOP
+ JST T1 PRINT THE LINE
+BUF1 DAC ** ADDRESS OF LINE BUFFER
+ JST T20 CARRIAGE RETURN
+ JST T30 LINE FEED
+ IRS OSAL MAKE RETURN ADDRESS
+ LDX XR
+ JMP* OSAL RETURN
+*
+*
+OSAH DAC ** INIT HEADING
+ STX XR
+ LDA* OSAH
+ STA P1 POINTER TO SOURCE
+ LDA HBUP
+ STA P2 POINTER TO TARGET
+ LDA WIDH LINE LENGTH
+ TCA COMPLEMENT
+ STA CNT
+HL1 LDA* P1
+ STA* P2
+ IRS P1
+ IRS P2
+ IRS CNT READY?
+ JMP HL1 NO
+ JST NP INIT PAGE
+ IRS OSAH ADJUST ADDRESS
+ LDX XR
+ JMP* OSAH RETURN
+********************************************************************************
+*
+NP DAC ** PREPARE NEW PAGE
+ LDA PGS LOAD LINES PER PAGE
+ TCA NEGATE
+ STA LINE STORE PAGE COUNTER
+ LDA HDS
+ SNZ
+ JMP NHDS NO SPACE BEFORE HEADING
+ TCA
+ STA CNT
+S1 JST T30
+ IRS CNT
+ JMP S1
+NHDS JST T1 TYPE HBUF
+HBUP DAC HBUF ADDRESS OF HEADER BUFFER
+ JST T20 CARRIAGE RETURN
+ LDA SPC NUMBER OF SPACES BEFORE TEXT
+ TCA NEGATE
+ STA CNT TO COUNTER
+SP1 JST T30 LINE FEED
+ IRS CNT DEC COUNTER, SKIP IF READY
+ JMP SP1 NOT READY
+ JMP* NP
+*
+********************************************************************************
+*
+**** FORM FEED ROUTINE
+FF DAC **
+ LDA SFF
+ TCA
+ STA CNT
+ LDA =10
+FF1 OTA 4 SEND LINE FEED
+ JMP *-1 WAIT
+ IRS CNT
+ JMP FF1
+ JMP* FF RETURN
+*
+*
+XR DEC 0 SAVED X REGISTER
+CNT DEC 0
+HBUF BCI 20,
+ BCI 20,
+ BCI 20,
+P1 DEC 0 POINTER 1
+P2 DEC 0 POINTER 2
+LINE DEC -40 NEG LINES LEFT ON PAGE
+*
+*
+********************************************************************************
+*
+*** AB HIER ABGESCHRIEBENER CODE!
+T1 DAC **
+ STX XR
+ LDA* T1
+ ADD WIDH
+ ADD ='40000
+ STA T6
+ IRS T1
+ LDA WIDH
+ TCA
+ STA 0
+T3 LDA* T6
+ CAS ='120240
+ JMP *+2
+*
+ JMP T8
+T4 JST T14
+ IRS 0
+ JMP T3
+ LDX XR
+ JMP* T1
+T6 *** **
+*
+T8 LDA 0
+ STA T12
+T10 IRS 0
+ JMP *+2
+ JMP* T1
+ LDA* T6
+ CAS ='120240
+ JMP *+2
+ JMP T10
+ LDA T12
+ STA 0
+ LDA ='120240
+ JMP T4
+T12 *** **
+*
+T14 DAC **
+ NOP
+ NOP
+ NOP
+ LRL 8
+ OTA 4
+ JMP *-1
+ LLL 8
+ OTA 4
+ JMP *-1
+ JMP* T14
+*
+*
+********************************************************************************
+*
+T20 DAC **
+ LDA =13
+ OTA 4
+ JMP *-1
+ OTA 4
+ JMP *-1
+ JMP* T20
+*
+********************************************************************************
+*
+T30 DAC **
+ LDA =10
+ OTA 4
+ JMP *-1
+ JMP* T30
+*
+*
+ FIN WRITE OUT LITERALS
+*
+* PUH.....
+ END (O$AL)
+
--- /dev/null
+* (O$LA)
+*
+*
+* PROGRAM TITLE: O$LA (O$LA,O$LE,O$LH,O$LC,O$LF)
+* LINE PRINTER ROUTINES
+*
+* REVISIONS:
+* 1.0 (2005-02.04)
+*
+* AUTHOR
+*
+* PHILIPP HACHTMANN
+*
+*
+* PURPOSE
+*
+* THESE ARE THE LIBRARY ROUTINES FOR HACHTI'S LINE PRINTER INTERFACE
+*
+*
+* RESTRICTIONS
+*
+* DEPENDS ON HACHTI'S HARDWARE AND FORTRAN IV COMPILER TAPE
+*
+*
+* STORAGE
+*
+* 420 (OCTAL)
+* 271 (DECIMAL)
+*
+*
+* USE
+*
+* CALL O$LA
+* DAC (BUFFER ADDRESS)
+* NORMAL
+*
+* THIS PRINTS ONE LINE OF LISING TEXT
+* (60 2-CHAR WORDS MAX) TO THE LINE PRINTER.
+*
+*
+* CALL O$LH
+* DAC (HEADING ADDRESS)
+* NORMAL RETURN
+*
+* SETUP THE LISTING HEADER
+* RESETS THE PAGE COUNTER AND SPACES TO THE BEGINNING OF
+* THE NEXT PAGE.
+*
+*
+* CALL O$LP
+* DAC (BUFFER ADDRESS)
+* NORMAL RETURN
+*
+* PRINT TEXT FROM BUFFER. NO CR OR LF IS OUTPUT.
+*
+* CALL O$LC
+* NORMAL RETURN
+*
+* PRODUCE A CARRIAGE RETURN ON THE LINE PRINTER.
+*
+*
+* CALL O$LF
+* NORMAL RETURN
+*
+* SEND A LINE FEED COMMAND TO THE PRINTER.
+*
+*
+* CALL O$LE
+* NORMAL RETURN
+*
+* EJECT CURRENT PAGE
+* SPACES TO THE BEGINNING OF THE NEXT PAGE BY SENDING
+* A FF CHARACTER TO THE PRINTER.
+*
+********************************************************************************
+*
+ SUBR O$LA TYPE A COMPLETE LINE WITH CR/LF, HEADING ETC.
+ SUBR O$LH INITIALISE HEADING
+ SUBR O$LP,T1 TYPE A LINE, NO CR
+ SUBR O$LC,T20 RETURN THE CARRIAGE
+ SUBR O$LF,T30 ADVANCE TO NEXT LINE
+ SUBR O$LE,FF EJECT PAGE
+*
+ SUBR O$LSK1,SKP1 EMPTY LINES BETWEEN TOP OF PAGE AND HEADING
+ SUBR O$LSK2,SKP2 EMPTY LINES BETWEEN HEADING AND MAIN TEXT
+ SUBR O$LLPP,LPP PURE TEXT LINES PER PAGE
+ SUBR O$LRS,RS DISTANCE FROM PAGE NUMBERING TO RIGHT MARGIN
+*
+********************************************************************************
+*
+ REL RELOCATEABLE MODE
+*
+* CONFIGURATION
+SKP1 DEC 1 EMPTY LINES BEFORE HEADING
+SKP2 DEC 3 EMPTY LINES BETWEEN HEADING AND TEXT
+LPP DEC 60 DATA LINES PER PAGE (WITHOUT HEADING ETC.)
+LNW DEC 60 LINE LENGTH IN 2-CHAR WORDS
+RS DEC 1 RIGHT DISTANCE FOR PAGE NUMBERING (2-CHAR WORDS)
+*
+*
+O$LA DAC **
+ LDA* O$LA BUFFER ADDRESS
+ STA LBUF STORE
+ LDA LINE LEFT LINE COUNTER
+ SZE LINES LEFT ON PAGE?
+ JMP PGOK YES, JUMP AWAY
+ JST FF CALL FORM FEED ROUTINE
+PGOK LDA LPP LINES PER PAGE
+ TCA
+ CAS LINES ARE WE ON THE FIRST LINE?
+ JMP *+2 NO, WE ARE NOT.
+ JST NP MAKE HEADER, SPACING ETC.
+ NOP
+ IRS LINE BUMP COUNTER
+ NOP WE DON'T CONTROL THAT HERE ANYMORE
+ JST T1 PRINT THE LINE
+LBUF DAC ** ADDRESS OF LINE BUFFER
+ JST T20 CARRIAGE RETURN
+ JST T30 LINE FEED
+ IRS O$LA MAKE RETURN ADDRESS
+ JMP* O$LA RETURN
+*
+*
+O$LH DAC ** INIT HEADING
+ LDA* O$LH
+ STA P1 POINTER TO SOURCE
+ LDA HBUP
+ STA P2 POINTER TO TARGET
+ LDA LNW LINE LENGTH
+ TCA
+ STA CNT
+HL1 LDA* P1
+ STA* P2
+ IRS P1
+ IRS P2
+ IRS CNT READY?
+ JMP HL1 NO
+ LDA LPP LINES PER PAGE
+ TCA RENEW
+ STA LINE THE LINE COUNTER
+ IRS O$LH ADJUST ADDRESS
+ CRA
+ STA LN1 CLEAR PAGE NUMBERING
+ STA LN2 CLEAR PAGE NUMBERING
+ STA LN3 CLEAR PAGE NUMBERING
+ JMP* O$LH RETURN
+*
+*
+*
+NP DAC ** PREPARE NEW PAGE
+ LDA SKP1 SPACES BEFORE HEADING
+ SNZ SPACING REQUIRED?
+ JMP NHDS NO SPACE BEFORE HEADING
+ TCA
+ STA CNT
+S1 JST T30 LINE FEED
+ IRS CNT
+ JMP S1
+NHDS JST LNNR PREPARE LINE NUMBERING
+ JST T1 TYPE HBUF
+HBUP DAC HBUF ADDRESS OF HEADER BUFFER
+ JST T20 CARRIAGE RETURN
+ JST T30 LINE FEED
+ LDA SKP2 NUMBER OF SPACES BEFORE TEXT
+ SNZ SPACING REQUIRED?
+ JMP NSPC NO, IT'S NOT.
+ TCA NEGATE
+ STA CNT TO COUNTER
+SP1 JST T30 LINE FEED
+ IRS CNT DEC COUNTER, SKIP IF READY
+ JMP SP1 NOT READY
+NSPC JMP* NP RETURN
+*
+* FORM FEED
+FF DAC **
+ LDA LPP REFILL
+ TCA THE
+ STA LINE LINE COUNTER
+*
+ LDA =12 FORM FEED
+ OTA 0 SEND FORMFEED
+ JMP *-1 WAIT
+ JMP* FF RETURN
+*
+*
+* VARIABLES
+XR DEC 0 THE CALLER'S X REGISTER
+CNT DEC 0
+HBP DAC HBUF
+HBUF BCI 20,
+ BCI 20,
+ BCI 20,
+P1 DEC 0 POINTER 1
+P2 DEC 0 POINTER 2
+LINE DEC -40 NEG LINES LEFT ON PAGE
+PGS BCI 5, PAGE XXX
+PGSP DAC PGS POINTER TO PGS
+*
+*
+************************************************************
+*
+* OUTPUT LINE
+T1 DAC **
+ STX XR SAVE CALLER'S INDEX REGISTER
+ LDA* T1
+ ADD LNW LINE WIDTH
+ ADD ='40000 SET TAG
+ STA T6
+ IRS T1
+ LDA LNW LINE WIDTH
+ TCA NEGATE
+ STA 0
+T3 LDA* T6
+ CAS ='120240
+ JMP *+2
+*
+ JMP T8
+T4 JST T14
+ IRS 0
+ JMP T3
+ LDX XR RESTORE CALLER'S INDEX REGISTER
+ JMP* T1
+T6 *** **
+*
+*
+T8 LDA 0
+ STA T12
+T10 IRS 0
+ JMP *+2
+ JMP* T1
+ LDA* T6
+ CAS ='120240
+ JMP *+2
+ JMP T10
+ LDA T12
+ STA 0
+ LDA ='120240
+ JMP T4
+T12 *** **
+*
+*
+T14 DAC **
+ ICA
+ OTA 0
+ JMP *-1
+ ICA
+ OTA 0
+ JMP *-1
+ JMP* T14
+****
+*
+* CARRIAGE RETURN
+T20 DAC **
+ LDA =13 CR CHARACTER
+ OTA 0 OUTPUT
+ JMP *-1
+ JMP* T20 RETURN
+*
+* LINE FEED
+T30 DAC **
+ LDA =10 LF CHARACTER
+ OTA 0 OUTPUT
+ JMP *-1 RETURN
+ JMP* T30
+*
+* PRINT LINE NUMBER TO BUFFER
+LNNR DAC ** INCREMENT LINE NUMBER, PUT TO BUFFER
+ JST LNR INCREMENT DIGIT
+LN1 DEC 0 LEAST SIGNIFICAND DIGIT
+ JMP RDY NO CARRY, COUNTING READY
+ JST LNR INCREMENT DIGIT
+LN2 DEC 0 SECOND DIGIT
+ JMP RDY NO CARRY, COUNTING READY
+ JST LNR INCREMENT DIGIT
+LN3 DEC 0 THIRT DIGIT
+ NOP NO CARRY, FINE
+RDY NOP OVERFLOW, BUT WHAT SHOULD WE DO?
+*
+*
+ LDA LN3 LEFTMOST VALUE (100)
+ JST MDG CONVERT
+ LRR 8 SHIFT DOWN
+ LDA =32 SPACE
+ LLR 8 SHIFT BACK
+ STA PGS+3 STORE
+*
+ LDA LN1 RIGHTMOST DIGIT (1)
+ ADD =48 ZERO CHARACTER
+ LRR 8 SHIFT AWAY
+ LDA LN2 MIDDLE VALUE (10)
+ JST MDG CONVERT
+ LLR 8 SHIFT UP AGAIN
+ STA PGS+4 STORE INTO POSITION
+*
+*
+ LDA HBP HEADER BUFFER ADDRESS
+ ADD LNW PAGE WIDTH
+ SUB RS RIGHT SPACING
+ ADD ='40000 SET INDEX BIT
+ STA P1 TO POINTER
+ LDA PGSP PAGE NUMBER BUFFER ADDRESS
+ ADD =5 ADD PAGE NUMBERING LENGTH
+ ADD ='40000 SET INDEX BIT
+ STA P2 TO POINTER
+ LDA =-5
+ STA 0
+PP1 LDA* P2
+ STA* P1
+ IRS 0
+ JMP PP1
+ JMP* LNNR RETURN
+*
+*
+MDG DAC ** MAKE DIGIT FROM A
+ SZE
+ JMP NZ NO ZERO
+ LDA =32 IS ZERO->SPACE
+ JMP* MDG RETURN
+NZ ADD =48 THE ZERO CHARACTER
+ JMP* MDG
+*
+*
+LNR DAC ** DIGIT SERVICE
+ IRS* LNR INCREMENT DIGIT
+ LDA* LNR LOAD NEW VALUE OF DIGIT
+ SUB =10 TEST IF OVERFLOW
+ SZE OVERFLOW?
+ JMP NOFL NO, TAKE FIRST RETURN
+ STA* LNR YES, CLEAR DIGIT (A WAS ZERO)
+ IRS LNR TALLY RETURN ADDRESS
+NOFL IRS LNR TALLY RETURN ADDRESS
+ JMP* LNR
+*
+ FIN WRITE OUT LITERALS
+*
+* PUH.....
+*
+ END
--- /dev/null
+* (O$PB) - COPY OF O$AB
+*
+*
+* COMPUTER: H316
+*
+* PROGRAM CATEGORY: I/O LIBRARY
+*
+* PROGRAM TITLE: O$PB (O$PS,O$PLDR)
+* TO PUNCH BINARY TAPE ON THE HIGH SPEED PUNCH
+*
+* REVISIONS:
+* 1.0 (2005-02.04)
+*
+* AUTHOR
+*
+* PHILIPP HACHTMANN
+*
+*
+*
+* STORAGE
+*
+* 150 (OCTAL)
+* 104 (DECIMAL)
+*
+*
+* USE
+*
+* CALL O$PB PTP BINARY PUNCH ROUTINE
+* DAC DATA DATA ADDRESS
+* NORMAL RETURN
+*
+* CALL O$PS END OF MESSAGE ROUTINE
+*
+* CALL O$PLDR PUNCH BLANK LEADER
+*
+*
+* CALL O$AB -
+*
+* THIS ROUTINE IS USED TO PUNCH BINARY PAPER TAPE, THE ADDRESS
+* OF THE BINARY WORD COUNT APPEARS IN THE VARIABLE FIELD (DATA)
+* FOLLOWING THE CALL PSEUDO-OP. THE BINARY INFORMATION TO BE
+* PUNCHED MUST START AT DATA+1.
+* THE NORMAL RETURN IS TAKEN WHEN THE NUMBER OF WORDS SPECIFIED
+* BY THE WORD COUNT HAS BEEN PUNCHED.
+*
+* CALL O$AS -
+*
+* EOM (203 OCT), X-OFF (223 OCT), AND RUBOUT (377 OCT) CHARACTERS
+* ARE PUNCHED WHEN THIS ROUTINE IS USED.
+* RETURN IS TO THE CALLING PROGRAMM
+*
+* CALL O$PLDR -
+*
+* PUNCH BLANK LEADER. NORMAL RETURN.
+*
+*
+* METHOD
+*
+* BINARY INFORMATION IS PUNCHED AS IST APPEARS IN THE BUFFER (DATA+1).
+* EACH RECORD ON PAPER TAP EWILL HAVE THE FOLLOWING FORMAT:
+* START OF MESSAGE, BINARY INFORMATION, X-OFF, TWO LEADER CHARS.
+*
+*
+*
+********************************************************************************
+*
+*
+ SUBR O$PB
+ SUBR O$PS
+ SUBR O$PLDR,PLDR
+ REL
+O$PB PZE ** PTP PUNCH ENTRY
+ STX XR SAVE INDEX REGISTER FROM CALLING PROGRAMM
+ OCP 2 ACTIVATE PAPER TAPE PUNCH
+*
+ LDA* O$PB WORD COUNT ADDRESS
+BIN5 STA TMP
+ LDA* TMP
+ TCA TWOS COMPLEMENT BINARY WORD COUNT
+ STA 0
+ LDA* O$PB BINARY DATA ADDRESS
+ ADD* TMP DATA ADDRESS+WORD COUNT
+ ADD ='40001
+ STA DATA DATA ADDRESS + WORD COUNT, 1
+ JST STP
+ LDA ='201 BEGINNING OF MESSAGE
+ JST BCD8
+BIN6 LDA* DATA BINARY WORD TO BE PUNCHED
+ LRL 16 B-REG: BINARY WORD TO BE PUNCHED
+ JST PNCH GO PUNCH BINARY WORD
+ IRS 0
+ JMP BIN6 CONTINUE PUNCHING BINARY CHARACTERS
+ JMP RETN LEAVE ROUTINE
+PNCH PZE ** CONVERT AND PUNCH BINARY CHARACTERS
+ LLL 4
+ JST CHAR PUNCH BINARY WORD (1-4)
+ JST CHAR PUNCH BINARY WORD (5-10)
+ JST CHAR PUNCH BINARY WORD (11-16)
+ JMP* PNCH RETURN FOR ADDITIONAL WORDS
+CHAR PZE **
+ LGL 11
+ CAS WRU
+ JMP *+2
+ LDA WRUX
+ CAS LF
+ JMP *+2
+ LDA LFX
+ CAS XON
+ JMP *+2
+ LDA XONX
+ CAS XOFF
+ JMP *+2
+ LDA XOFX
+ SRC
+ ERA FOUR
+ ALR 5
+OUT JST BCD8
+ LLL 6
+ JMP* CHAR
+WRU OCT 024000
+WRUX OCT 160003
+LF OCT 050000
+LFX OCT 164003
+XON OCT 104000
+XONX OCT 170003
+XOFF OCT 114000
+XOFX OCT 174003
+FOUR OCT 000004
+BCD8 PZE ** ASCII PUNCH ROUTINE
+ OTA 2
+ JMP *-1
+ JMP* BCD8
+RETN LDA ='223 X-OFF
+ JST BCD8
+ LDA ='377 RUBOUT CHARACTER
+ JST BCD8 LEADER CHAR.
+ IRS O$PB INCREMENT FOR NORMAL RETURN
+ LDA XR RESTORE INDEX FOR CALLING PROGRAMM
+ STA 0
+ JMP* O$PB
+*
+O$PS PZE ** PUNCH END OF MESSAGE ENTRY
+ JST STP
+ LDA ='203 PUNCH END OF MESSAGE
+ JST BCD8
+ LDA ='223 PUNCH X-OFF
+ JST BCD8
+ LDA ='377 RUBOUT CHARACTER
+ JST BCD8 LEADER CHAR.
+ JMP* O$PS RETURN TO CALLING PROGRAMM
+*
+STP DAC **
+ LDA ='222
+ JST BCD8
+ LDA ='377
+ JST BCD8
+ JMP* STP
+DATA PZE 0
+XR PZE 0
+TMP PZE 0
+ FIN
+*
+LDRC DEC 150 LENGTH OF LEADER
+PLDR DAC ** PUNCH LEADER ENTRY
+ STX XR SAVE X REGISTER
+ LDA LDRC LENGTH OF LEADER
+ TCA TWOS COMPLEMENT OF LEADER
+ STA 0
+ OCP 2
+ CRA
+LD1 OTA 2 PUNCH!
+ JMP *-1
+ IRS 0
+ JMP LD1
+ LDX XR RESTORE X REGISTER
+ JMP* PLDR RETURN
+*
+ END O$PB
--- /dev/null
+* (O$PL)
+*
+*
+* COMPUTER: H316
+*
+* PROGRAM CATEGORY: I/O LIBRARY
+*
+* PROGRAM TITLE: O$PL (O$PH)
+* PAPER TAPE LISTING ROUTINES
+*
+* REVISIONS:
+* 1.0 (2005-02.04)
+*
+* AUTHOR
+*
+* PHILIPP HACHTMANN
+*
+*
+* PURPOSE
+*
+* PUT LISTINGS ONTO PAPER TAPE. USAGE LIKE O$LA AND O$LH
+*
+*
+*
+* STORAGE
+*
+* 266 (OCTAL)
+* 182 (DECIMAL)
+*
+*
+* USE
+*
+* THE LIBRARY ROUTINES ARE FOR GENERAL PURPOSE.
+*
+**********************************************************************
+ SUBR O$PL TYPE A COMPLETE LINE WITH CR/LF, HEADING ETC.
+ SUBR O$PH INITIALISE HEADING
+ SUBR O$PP,T1 TYPE A LINE, NO CR
+ SUBR O$PC,T20 RETURN THE CARRIAGE
+ SUBR O$PF,T30 ADVANCE TO NEXT LINE
+ SUBR O$PE,SNP PUNCH FORM FEED
+*
+ SUBR O$P1,HDS EMPTY LINES BETWEEN TOP OF PAGE AND HEADING
+ SUBR O$P2,SPC EMPTY LINES BETWEEN HEADING AND MAIN TEXT
+ SUBR O$P3,PGS PURE TEXT LINES PER PAGE
+**********************************************************************
+ REL RELOCATABLE
+*********************************************
+* CONFIGURATION
+HDS DEC 1 EMPTY LINES BEFORE HEADING
+SPC DEC 5 EMPTY LINES BETWEEN HEADING AND TEXT
+PGS DEC 50 DATA LINES PER PAGE (WITHOUT HEADING ETC.)
+*
+*
+O$PL DAC **
+ LDA* O$PL BUFFER ADDRESS
+ STA BUF1 STORE FOR LATER USE
+ OCP 2 ACTIVATE PUNCH
+ IRS LINE COUNT DOWN LEFT LINES ON PAGE
+ JMP PGOK NO NEW PAGE
+ LDA =12 FORM FEED
+ OTA 2 SEND FORMFEED
+ JMP *-1 WAIT
+ JST NP NEW PAGE REQUIRED
+PGOK JST T1 PRINT THE LINE
+BUF1 DAC ** ADDRESS OF LINE BUFFER
+ JST T20 CARRIAGE RETURN
+ JST T30 LINE FEED
+ IRS O$PL MAKE RETURN ADDRESS
+ JMP* O$PL RETURN
+*
+*
+O$PH DAC ** INIT HEADING
+ LDA* O$PH
+ STA P1 POINTER TO SOURCE
+ LDA HBUP
+ STA P2 POINTER TO TARGET
+ LDA =-60 LINE LENGTH
+ STA CNT
+HL1 LDA* P1
+ STA* P2
+ IRS P1
+ IRS P2
+ IRS CNT READY?
+ JMP HL1 NO
+ JST NP INIT PAGE
+ IRS O$PH ADJUST ADDRESS
+ JMP* O$PH RETURN
+**********************************************++
+*
+NP DAC ** PREPARE NEW PAGE
+ LDA PGS LOAD LINES PER PAGE
+ TCA NEGATE
+ STA LINE STORE PAGE COUNTER
+ LDA HDS
+ SNZ
+ JMP NHDS NO SPACE BEFORE HEADING
+ TCA
+ STA CNT
+S1 JST T30
+ IRS CNT
+ JMP S1
+NHDS JST T1 TYPE HBUF
+HBUP DAC HBUF ADDRESS OF HEADER BUFFER
+ JST T20 CARRIAGE RETURN
+ LDA SPC NUMBER OF SPACES BEFORE TEXT
+ TCA NEGATE
+ STA CNT TO COUNTER
+SP1 JST T30 LINE FEED
+ IRS CNT DEC COUNTER, SKIP IF READY
+ JMP SP1 NOT READY
+ JMP* NP
+*
+***********************************++
+*
+**** FORM FEED ROUTINE
+SNP LDA =-1
+ STA LINE
+ OCP 2 ACTIVATE PUNCH
+ LDA =12 FORM FEED
+ OTA 2 SEND FORMFEED
+ JMP *-1 WAIT
+ JMP* SNP RETURN
+********
+*
+*
+CNT DEC 0
+HBUF BCI 20,
+ BCI 20,
+ BCI 20,
+P1 DEC 0 POINTER 1
+P2 DEC 0 POINTER 2
+LINE DEC -40 NEG LINES LEFT ON PAGE
+*
+*
+************************************************************
+*
+*** AB HIER ABGESCHRIEBENER CODE!
+T1 DAC **
+ LDA* T1
+ ADD T5
+ STA T6
+ IRS T1
+ LDA =-60
+ STA 0
+T3 LDA* T6
+ CAS ='120240
+ JMP *+2
+*
+ JMP T8
+T4 JST T14
+ IRS 0
+ JMP T3
+ JMP* T1
+T5 DAC 60,1
+T6 *** **
+*
+T8 LDA 0
+ STA T12
+T10 IRS 0
+ JMP *+2
+ JMP* T1
+ LDA* T6
+ CAS ='120240
+ JMP *+2
+ JMP T10
+ LDA T12
+ STA 0
+ LDA ='120240
+ JMP T4
+T12 *** **
+*
+T14 DAC **
+ OCP 2 ACTIVATE PUNCH
+ NOP
+ NOP
+ LRL 8
+ OTA 2
+ JMP *-1
+ LLL 8
+ OTA 2
+ JMP *-1
+ JMP* T14
+*
+*
+*************************************************
+*
+T20 DAC **
+ LDA ='6400 CR+NULL
+ JST T14
+ JMP* T20
+*
+*******************************************************************************
+*
+T30 DAC **
+ LDA ='5000 LF+NULL
+ JST T14
+ JMP* T30
+*
+ FIN WRITE OUT LITERALS
+*
+* PUH.....
+*
+ END
--- /dev/null
+CHACHTI GOES FORTAN - AND BACK :-)
+C
+ DIMENSION NAME(10)
+100 WRITE (1,10)
+ WRITE (1,20)
+300 READ (1,30) NAME
+ IF (NAME(1).EQ.(2H )) GO TO 1000
+ IF (NAME(1).EQ.(2HXX)) GO TO 9999
+ WRITE (1,40) NAME
+ WRITE (1,50)
+ DO 200 K=1,5
+ WRITE (1,60) K
+200 CONTINUE
+C
+10 FORMAT (35HHACHTI'S "HELLO-WORLD", 28.NOV.2004 )
+20 FORMAT (21HWIE HEISST DU? NAME: )
+30 FORMAT (10A2)
+40 FORMAT (18HNICE TO MEET YOU, ,10A2, 1H!)
+50 FORMAT (44HNOW I WILL LET YOU ALONE. HAVE SOME FUN :-) )
+60 FORMAT (I3,2H: ,10A2,17HIST EIN GUTER :-))
+70 FORMAT (24HOH! DEN NAMEN BITTE! -->)
+C
+ GOTO 100
+1000 WRITE (1, 70)
+ GOTO 300
+9999 WRITE(1,80)
+80 FORMAT (8HGOODBYE.)
+10000 GOTO 10000
+ STOP
+ END
+$0
--- /dev/null
+CHACHTI GOES FORTAN - AND BACK :-)\r
+C\r
+ DIMENSION NAME(10)\r
+C *******************************
+100 WRITE (1,10)\r
+10 FORMAT (36HHACHTI'S "HELLO-WORLD", 28.NOV.2004 )\r
+C *******************************
+ WRITE (1,20)\r
+20 FORMAT (21HWIE HEISST DU? NAME: )\r
+C *******************************
+300 READ (1,30) NAME\r
+30 FORMAT (10A2)\r
+C *******************************
+ IF (NAME(1).EQ.(2H )) GO TO 1000\r
+ IF (NAME(1).EQ.(2HXX)) GO TO 9999\r
+C *******************************
+ WRITE (1,40) NAME\r
+40 FORMAT (18HNICE TO MEET YOU, ,10A2, 1H!)\r
+C *******************************
+ WRITE (1,50)\r
+50 FORMAT (44HNOW I WILL LET YOU ALONE. HAVE SOME FUN :-) )\r
+C *******************************
+ DO 200 K=1,5\r
+ WRITE (1,60) K,NAME\r
+60 FORMAT (I3,2H: ,10A2,17HIST EIN GUTER :-))\r
+200 CONTINUE\r
+C *******************************
+ GOTO 100\r
+C
+C ON EMPTY INPUT
+1000 WRITE (1, 70)\r
+70 FORMAT (24HOH! DEN NAMEN BITTE! -->)\r
+ GOTO 300\r
+C
+C "XX" INPUT
+9999 WRITE(1,80)\r
+80 FORMAT (8HGOODBYE.)\r
+10000 GOTO 10000\r
+ STOP\r
+C *********** ENDE **************
+ END\r
+$0\r
--- /dev/null
+C PHILIPP'S MUNZ-PROGRAMM, KEIN WEITERER ZWECK. EINE VERSION VOM 6.2.2005
+C
+C
+CCCCCC DA SAG ICH NUR: LASS KRACHEN!
+ 33 WRITE(1,10)
+ WRITE(2,20)
+ WRITE(4,30)
+ 10 FORMAT(54HHALLO WELT! DAS SOLLTE AUF DEM ASR RAUSGEKOMMEN SEIN! )
+ 20 FORMAT(54HHALLO WELT! DAS SOLLTE AUF DEM PTP RAUSGEKOMMEN SEIN! )
+ 30 FORMAT(54HHALLO WELT! DAS SOLLTE AUF DEM LPT RAUSGEKOMMEN SEIN! )
+ PAUSE
+ GOTO 33
+$0
+
\ No newline at end of file
--- /dev/null
+CFORTRAN PROGRAM
+C SUBROUTINE MAIN()
+ WRITE (4,33)
+33 FORMAT(43HDIES IST DIE ERSTE ZEILE AUF DEM DRUCKER. )
+ PAUSE 3
+ WRITE (4,34)
+34 FORMAT(43HDIES IST DIE ZWEITE ZEILE AUF DEM DRUCKER. )
+ END
+$0
--- /dev/null
+****
+*HACHTI'S AKTUELLES PROGRAMM.SAGT HALLO AUF DEM TELETYPE UND IST
+*AUCH SONST GANZ TOLL
+*
+*STARTE BEI '1000:
+ ORG '1000
+*
+*LOAD MODUS, DER ASSEMBLER VERBIETET SICH JEDE INTELLIGENZ
+*BEI DER ADRESSIERUNG
+ LOAD
+*
+*ERSTMAL WEGSPRINGEN
+ JMP MAIN
+*
+*GELABER WAR SCHON IMMER MEINE STAERKE :-)
+MOTD BCI 21,HEY, HIER IST HACHTI'S ERSTES PROGRAM :-)
+ DEC 13,10,13,10
+ BCI 9,DAS REICHT ERSTMAL
+ DEC 13,10
+EMO DEC 0
+SP DAC MOTD
+EP DAC EMO
+*
+*
+******************************************************************
+* AUSGABEROUTINE *
+******************************************************************
+PRT DAC **
+*
+*ASR ANSTELLEN:
+ OCP '0104
+*
+*INDEX AKTIVIEREN:
+ LDA* SP
+ STA 0
+*
+*SPIEL BEGINNT:
+RND LDA 0
+ SUB EP
+ SNZ
+* SKIP WENN SP=EP >> FERTIG
+ JMP* PRT
+*
+*
+ LDA* 0
+*
+ ICA
+ OTA '0004
+ JMP *-1
+*
+ ICA
+ OTA '0004
+ JMP *-1
+*
+ IRS 0
+ NOP
+ JMP RND
+*****************************************************
+*****************************************************
+* MAIN ROUTINE
+*
+MAIN JST PRT
+ IAB
+ AOA
+ IAB
+ SR1
+ JMP *-1
+ JMP MAIN
+ END
+*****************************************************
+
+
+
\ No newline at end of file
--- /dev/null
+# Makefile für Apfelmännchenprogramm
+
+ASM=$(H316)/bin/asm
+FRTN=$(H316)/bin/frtn
+
+build/apfel2.obj : src/apfel2.f
+ $(FRTN) src/apfel2.f && mv apfel2.obj build
+
+clean :
+ @rm -f *.obj build/* *.lst *.go *.par
+
+.PHONY: default clean
+
+
+%.obj:%.f
+ $(FRTN) $^
+
+%.obj:%.asm
+ $(ASM) $^
\ No newline at end of file
--- /dev/null
+C APFELMAENNCHEN-PROGRAMM, 30.NOV.2004 PHILIPP HACHTMANN
+C
+C SENSE-SWITCH 1: WENN GESETZT, KONFIGURATION
+C SENSE-SWITCH 2: WENN GESETZT, KEINE AUSGABE
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+ COMPLEX C,Z,CTMP
+C
+ REAL
+ + XIN1,XIN2,YIN1,YIN2,LOWX,LOWY,HIGHX,HIGHY,
+ + XSTEP,YSTEP,MAXVAL,TEMP,
+ + X,Y
+C
+ INTEGER
+ + MAXI,COUNT,WIDTH,
+ + CR,LF,POSI,NEGA, I, N
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C KONSTANTE WERTE
+C
+C (32=LEERZEICHEN, 88=X)
+ DATA
+ + CR/13/,
+ + LF/10/,
+ + POSI/79/,
+ + NEGA/32/,
+ + WIDTH/70/,
+ + MAXI/60/,
+ + MAXVAL/2.0/,
+ + XIN1/-1.45/,XIN2/0.45/,
+ + YIN1/-1.00/,YIN2/1.00/
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C STARTMELDUNG
+ 100 WRITE(1,10)
+ 10 FORMAT(39HMANDELBROT-DEMO, 01.DEC.2004 HACHTI :-) )
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C EINGABEN ANNEHMEN
+C
+ N=1
+ CALL SSWTCH(N,I)
+ IF(I.EQ.1) GO TO 150
+C
+ WRITE(1,11)
+ READ (1,16) XIN1
+ WRITE(1,12)
+ READ (1,16) XIN2
+ WRITE(1,13)
+ READ (1,16) YIN1
+ WRITE(1,14)
+ READ (1,16) YIN2
+ WRITE(1,15)
+ READ (1,17) MAXI
+
+C
+ 11 FORMAT(9H X FROM: )
+ 12 FORMAT(9H TO: )
+ 13 FORMAT(9H Y FROM: )
+ 14 FORMAT(9H TO: )
+ 15 FORMAT(9H MAXIT: )
+ 16 FORMAT(F12.0)
+ 17 FORMAT(I6)
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C STARTWERTE ENDGUELTIG FESTLEGEN
+C
+C EVENTUELL STARTWERTE TAUSCHEN
+C
+CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
+ 150 I F(XIN2.GT.XIN1) GO TO 200
+ TEMP = XIN1
+ XIN1 = XIN2
+ XIN2 = TEMP
+C
+CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
+ 200 IF(YIN2.GT.YIN1) GO TO 201
+ TEMP = YIN1
+ YIN1 = YIN2
+ YIN2 = TEMP
+C
+CCCCCC WERTE UEBERNEHMEN
+ 201 LOWX = XIN1
+ HIGHX = XIN2
+ LOWY = YIN1
+ HIGHY = YIN2
+C
+CCCCCC SCHRITTWEITEN AUSRECHNEN
+ XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
+ YSTEP = 2.0 * XSTEP
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C STARTWERTE AUSGEBEN
+C
+ N=2
+ CALL SSWTCH(N,I)
+ IF(I.EQ.1) GO TO 299
+ WRITE (1,20)
+ 20 FORMAT (9HSETTINGS:)
+ WRITE (1,30) LOWX, HIGHX
+ 30 FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
+ WRITE (1,40) LOWY, HIGHY
+ 40 FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)
+ WRITE (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH
+ 50 FORMAT ( 4HMAX:,I3,
+ + 8H MAXVAL:,F8.5,
+ + 7H XSTEP:,F8.5,
+ + 7H YSTEP:,F8.5,
+ + 7H WIDTH:,I2)
+CCCCCC ZEILENVORSCHUB
+ WRITE (1,55)
+ 55 FORMAT (1H0)
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C EIGENTLICHE BERECHNUNG
+C
+CCCCCC EINSTIEG IN BERECHNUNG
+ 299 X=LOWX
+ Y=HIGHY
+C
+CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
+ 300 C=CMPLX(X,Y)
+ COUNT=0
+ Z=(0.0,0.0)
+C
+CCCCCC HIER DER ITERIERTE TEIL
+ 400 CTMP=Z*Z
+ Z=CTMP+C
+ IF ((CABS(Z)).GE.MAXVAL) GO TO 410
+ COUNT=COUNT+1
+ IF (COUNT.GE.MAXI) GO TO 420
+ GO TO 400
+C
+CCCCCC PUNKT DURCHGEFALLEN
+ 410 CALL PCHAR(NEGA)
+ GO TO 500
+C
+CCCCCC PUNKT HAT MAXI ERREICHT
+ 420 CALL PCHAR(POSI)
+C
+C
+CCCCCC NEUEN PUNKT MACHEN
+ 500 X = X + XSTEP
+CCCCCC ZEILE NOCH NICHT VOLL?
+ IF (X.LT.HIGHX) GO TO 300
+CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN
+ X = LOWX
+ CALL PCHAR(CR)
+ CALL PCHAR(LF)
+CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN
+ Y=Y-YSTEP
+ IF (Y.GT.LOWY) GO TO 300
+C
+CCCCCC HIER IST DAS BILD FERTIG.
+ WRITE(1, 60)
+ 60 FORMAT (6HFERTIG)
+C
+CCCCCC KURZE PAUSE, DANN NEUSTART
+ PAUSE 7
+ GO TO 100
+ END
+$0
--- /dev/null
+C APFELMAENNCHEN-PROGRAMM, 30.NOV.2004 PHILIPP HACHTMANN
+C
+C
+ COMPLEX C,Z,CTMP
+C
+ REAL
+ + XIN1,XIN2,YIN1,YIN2,LOWX,LOWY,HIGHX,HIGHY,
+ + XSTEP,YSTEP,MAXVAL,TEMP,
+ + X,Y
+C
+ INTEGER
+ + MAXI,COUNT,WIDTH,
+ + CR,LF,POSI,NEGA
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C KONSTANTE WERTE
+C
+C (32=LEERZEICHEN, 88=X)
+C
+ CR=13
+ LF=10
+ POSI=88
+ NEGA=46
+C
+CCCCCC SEITENBREITE:
+ WIDTH=70
+C
+CCCCCC MAXIMALE ITERATIONSTIEFE
+ MAXI=100
+C
+CCCCCC AUSSTIEGSWERT
+ MAXVAL=2.0
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C BILDDATEN
+C
+ XIN1 = -1.50
+ XIN2 = 0.50
+C
+ YIN1 = -1.00
+ YIN2 = 1.00
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C STARTMELDUNG
+ 100 WRITE(1,10)
+ 10 FORMAT(40HMANDELBROT 30.NOV.2004 PHILIPP HACHTMANN )
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C STARTWERTE ENDGUELTIG FESTLEGEN
+C
+C EVENTUELL STARTWERTE TAUSCHEN
+C
+CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
+ 150 I F(XIN2.GT.XIN1) GO TO 200
+ TEMP = XIN1
+ XIN1 = XIN2
+ XIN2 = TEMP
+C
+CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
+ 200 IF(YIN2.GT.YIN1) GO TO 201
+ TEMP = YIN1
+ YIN1 = YIN2
+ YIN2 = TEMP
+C
+CCCCCC WERTE UEBERNEHMEN
+ 201 LOWX = XIN1
+ HIGHX = XIN2
+ LOWY = YIN1
+ HIGHY = YIN2
+C
+CCCCCC SCHRITTWEITEN AUSRECHNEN
+ XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
+ YSTEP = 2.0 * XSTEP
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C STARTWERTE AUSGEBEN
+C
+ WRITE (1,20)
+ 20 FORMAT (9HSETTINGS:)
+ WRITE (1,30) LOWX, HIGHX
+ 30 FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
+ WRITE (1,40) LOWY, HIGHY
+ 40 FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)
+ WRITE (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH
+ 50 FORMAT ( 4HMAX:,I3,
+ + 8H MAXVAL:,F8.5,
+ + 7H XSTEP:,F8.5,
+ + 7H YSTEP:,F8.5,
+ + 7H WIDTH:,I2)
+C
+ PAUSE 1
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C EIGENTLICHE BERECHNUNG
+C
+CCCCCC EINSTIEG IN BERECHNUNG
+ X=LOWX
+ Y=HIGHY
+C
+CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
+ 300 C=CMPLX(X,Y)
+ COUNT=0
+ Z=(0.0,0.0)
+C
+CCCCCC HIER DER ITERIERTE TEIL
+ 400 CTMP=Z*Z
+ Z=CTMP+C
+ IF ((CABS(Z)).GE.MAXVAL) GO TO 410
+ COUNT=COUNT+1
+ IF (COUNT.GE.MAXI) GO TO 420
+ GO TO 400
+C
+CCCCCC PUNKT DURCHGEFALLEN
+ 410 CALL PCHAR(NEGA)
+ GO TO 500
+C
+CCCCCC PUNKT HAT MAXI ERREICHT
+ 420 CALL PCHAR(POSI)
+C
+C
+CCCCCC NEUEN PUNKT MACHEN
+ 500 X = X + XSTEP
+CCCCCC ZEILE NOCH NICHT VOLL?
+ IF (X.LT.HIGHX) GO TO 300
+CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN
+ X = LOWX
+ CALL PCHAR(CR)
+ CALL PCHAR(LF)
+CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN
+ Y=Y-YSTEP
+ IF (Y.GT.LOWY) GO TO 300
+C
+CCCCCC HIER IST DAS BILD FERTIG.
+ WRITE(1, 60)
+ 60 FORMAT (6HFERTIG)
+C
+CCCCCC KURZE PAUSE, DANN NEUSTART
+ PAUSE 7
+ GO TO 100
+ END
+$0
--- /dev/null
+C APFELMAENNCHEN-PROGRAMM, 29.DEC.2004 PHILIPP HACHTMANN
+C
+C SENSE-SWITCH 1: WENN GESETZT, KONFIGURATION
+C SENSE-SWITCH 2: WENN GESETZT, KEINE AUSGABE DER EINSTELLUNGEN
+C SENSE-SWITCH 3: WENN GESETZT, STARTWERTE WIEDERHERSTELLEN
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C COMMON BLOCK DEKLARATIONEN
+C
+ INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+C
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C STARTMELDUNG
+ 100 WRITE (1,10)
+ WRITE (1,11)
+ 10 FORMAT (45HMANDELBROT-DEMO NO.2, 29.DEC.2004 HACHTI :-) )
+ 11 FORMAT (26HSEE HTTP://H316.HACHTI.DE )
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C KONFIGURATION
+CCCCCC RUECKSETZEN AUF DEFAULTWERTE?
+ CALL SSWTCH(3,I)
+ IF (I.EQ.1) CALL RST
+C
+C
+CCCCCC BEIM ERSTEN START ODER WENN VERLANGT
+ IF(INIT.EQ.0) CALL STVAL
+C
+C
+CCCCCC EINGABEN VERARBEITEN?
+ CALL SSWTCH(1,I)
+ IF (I.EQ.1) CALL GETCFG
+C
+C
+CCCCCC AUSGABE?
+ CALL SSWTCH(2,I)
+ IF(I.EQ.2) CALL OUTCFG
+C
+ WRITE (1,55)
+ 55 FORMAT (1H0)
+C
+ CALL CALC
+C
+ WRITE(1, 60)
+ 60 FORMAT (6HFERTIG)
+C
+CCCCCC KURZE PAUSE, DANN NEUSTART
+ PAUSE 7
+ GO TO 100
+ END
+C
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C EIGENTLICHE BERECHNUNG
+ SUBROUTINE CALC
+C
+ INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+ COMPLEX C,Z
+ REAL X,Y
+ INTEGER COUNT
+C
+CCCCCC EINSTIEG IN BERECHNUNG
+ 299 X=LOWX
+ Y=HIGHY
+C
+CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
+ 300 C=CMPLX(X,Y)
+ COUNT=0
+ Z=(0.0,0.0)
+C
+CCCCCC HIER DER ITERIERTE TEIL
+C
+ 400 Z=Z*Z+C
+C
+ IF ((CABS(Z)).GE.MAXVAL) GO TO 410
+ COUNT=COUNT+1
+ IF (COUNT.GE.MAXI) GO TO 420
+ GO TO 400
+C
+CCCCCC PUNKT DURCHGEFALLEN
+ 410 CALL PCHAR(NEGA)
+ GO TO 500
+C
+CCCCCC PUNKT HAT MAXI ERREICHT
+ 420 CALL PCHAR(POSI)
+C
+CCCCCC NEUEN PUNKT MACHEN
+ 500 X = X + XSTEP
+CCCCCC ZEILE NOCH NICHT VOLL?
+ IF (X.LT.HIGHX) GO TO 300
+CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN
+ X = LOWX
+ CALL PCHAR(CR)
+ CALL PCHAR(LF)
+CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN
+ Y=Y-YSTEP
+ IF (Y.GT.LOWY) GO TO 300
+C
+CCCCCC HIER IST DAS BILD FERTIG.
+ RETURN
+ END
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC STARTWERTE AUSFUELLEN
+ SUBROUTINE STVAL
+C
+ INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+ CR = 13
+ LF = 10
+ POSI = 79
+ NEGA = 32
+ WIDTH = 70
+ MAXI = 60
+ MAXVAL = 2.0
+ LOWX =-1.45
+ HIGHX = 0.45
+ LOWY =-1.00
+ HIGHY = 1.00
+ INIT = 1
+C
+CCCCCC SCHRITTWEITEN AUSRECHNEN
+ XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
+ YSTEP = 2.0 * XSTEP
+C
+ WRITE (1,1500)
+ 1500 FORMAT (19HSTARTWERTE GESETZT.)
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC EINSTELLUNGEN EINLESEN
+ SUBROUTINE GETCFG
+C
+ INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+ REAL XIN1,XIN2,YIN1,YIN2
+C
+ WRITE(1,11)
+ READ (1,16) XIN1
+ WRITE(1,12)
+ READ (1,16) XIN2
+ WRITE(1,13)
+ READ (1,16) YIN1
+ WRITE(1,14)
+ READ (1,16) YIN2
+ WRITE(1,15)
+ READ (1,17) MAXI
+C
+ 11 FORMAT(14H X FROM : )
+ 12 FORMAT(14H TO : )
+ 13 FORMAT(14H Y FROM : )
+ 14 FORMAT(14H TO : )
+ 15 FORMAT(14H MAXIT (I3): )
+ 16 FORMAT(F12.0)
+ 17 FORMAT(I3)
+C
+CCCCCC EVENTUELL STARTWERTE TAUSCHEN:
+CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
+ 150 I F(XIN2.GT.XIN1) GO TO 200
+ TEMP = XIN1
+ XIN1 = XIN2
+ XIN2 = TEMP
+C
+CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
+ 200 IF(YIN2.GT.YIN1) GO TO 201
+ TEMP = YIN1
+ YIN1 = YIN2
+ YIN2 = TEMP
+C
+CCCCCC WERTE UEBERNEHMEN
+ 201 LOWX = XIN1
+ HIGHX = XIN2
+ LOWY = YIN1
+ HIGHY = YIN2
+C
+CCCCCC SCHRITTWEITEN AUSRECHNEN
+ XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
+ YSTEP = 2.0 * XSTEP
+C
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC EINSTELLUNGEN AUSGEBEN
+ SUBROUTINE OUTCFG
+C
+ INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+ COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
+C
+ WRITE (1,20)
+ 20 FORMAT (9HSETTINGS:)
+ WRITE (1,30) LOWX, HIGHX
+ 30 FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
+ WRITE (1,40) LOWY, HIGHY
+ 40 FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)
+ WRITE (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH
+ 50 FORMAT ( 4HMAX:,I3,
+ + 8H MAXVAL:,F8.5,
+ + 7H XSTEP:,F8.5,
+ + 7H YSTEP:,F8.5,
+ + 7H WIDTH:,I2)
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+CCCCCC RUECKSETZEN
+ SUBROUTINE RST
+C
+ INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+C
+ WRITE(1,245)
+ 245 FORMAT(24HRUECKSETZUNG GEWUENSCHT )
+ INIT=0
+ RETURN
+ END
+C
+C
+CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+C KONSTANTE WERTE
+ BLOCK DATA
+ INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
+ DATA INIT/0/
+ END
+CCCCCCCCCCCCCCCCCCCCCCCC
+$0
--- /dev/null
+* ASR-TESTPROGRAMM
+*
+*
+*
+*
+*STARTE BEI '1000:
+ ORG '1000
+ LOAD
+*
+*ERSTMAL WEGSPRINGEN
+ JMP MAIN
+*
+MOTD BCI 10,ASR-TEST 2004-11-16
+ DEC 13,10
+EMO DEC 0
+SP DAC MOTD
+EP DAC EMO
+VAR DEC 0
+*
+*
+******************************************************************
+* AUSGABEROUTINE *
+******************************************************************
+PRT DAC **
+*
+*ASR ANSTELLEN:
+ OCP '0104
+ SKS '104
+ JMP *-1
+*
+*INDEX AKTIVIEREN:
+ LDA* SP
+ STA 0
+*
+*SPIEL BEGINNT:
+RND LDA 0
+ SUB EP
+ SNZ
+* SKIP WENN SP=EP >> FERTIG
+ JMP* PRT
+*
+*
+ LDA* 0
+*
+ ICA
+ OTA '0004
+ JMP *-1
+*
+ ICA
+ OTA '0004
+ JMP *-1
+*
+ IRS 0
+ NOP
+ JMP RND
+*****************************************************
+*PAUSE
+CYC DEC 0
+CNT DEC **
+PAUS DAC **
+ LDA CYC
+ STA CNT
+CYST NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ NOP
+ IRS CNT
+ JMP CYST
+ JMP* PAUS
+*****************************************************
+*TTY1
+TTY1 DAC **
+ OTA 4
+ JMP *-1
+ JMP* TTY1
+*****************************************************
+* MAIN ROUTINE
+*
+MAIN SR1
+MAIN2 JST PRT
+ SR2
+ JST PAUS
+ SR3
+ JST TTY1
+ SR4
+ HLT
+ IAB
+ AOA
+ IAB
+ JMP MAIN
+ END
+*****************************************************
+.
\ No newline at end of file
--- /dev/null
+* CLEANUP
+*
+* CLEANS UP CORE LOCATIONS '00020-'30777.
+*
+ ORG '31000
+STRT LDA ='20 START ADDRESS
+ STA PTR
+LOOP CRA
+ STA* PTR
+ IRS PTR
+ JMP GO1 NO OVERFLOW
+ HLT OVERFLOW OCCURED
+GO1 LDA PTR
+ SUB ='31000
+ SZE SKIP IF READY
+ JMP LOOP RESTART
+RDY OCP '104 ASR START
+ JST CRLF
+ JST OK
+ HLT
+ JMP STRT RESTART :-)
+*******
+OK DAC **
+ LDA ='117 CHARACTER O
+ JST PRNT
+ LDA ='113 NOW K
+ JST PRNT
+ JMP* OK
+*******
+CRLF DAC **
+ LDA =13 LOAD CR
+ JST PRNT
+ LDA =10 LOAD LF
+ JST PRNT
+ JMP* CRLF
+******
+PRNT DAC **
+ SKS 4 WAIT FOR ASR33
+ JMP *-1 TO BECOME READY
+ OTA 4 OUTPUT CHAR
+ NOP SECURITY
+ JMP* PRNT BACK
+*****
+PTR DEC 0 THE POSITION
+*****
+ END
--- /dev/null
+Super 2 tape:
+31000-31777 Start 31000 : cleanup.obj
+32000-32777 Start 32000 : PRNTZ
+33000-36777 Start 36000 : LDR-APM
+37000-37777 Start 37000 : PAL-AP
projects / h316.git / commitdiff