Initial commit
This commit is contained in:
commit
65ee0cd1f4
80 changed files with 27856 additions and 0 deletions
20
.gitignore
vendored
Normal file
20
.gitignore
vendored
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
*.s
|
||||
*.o
|
||||
*.exe
|
||||
*.bin
|
||||
*.sym
|
||||
*.swp
|
||||
*.prog
|
||||
*.out
|
||||
*.dis
|
||||
*.sasmout
|
||||
*.lib
|
||||
*.img
|
||||
*.lsym
|
||||
*.zip
|
||||
sine.pas
|
||||
graph.pas
|
||||
graph2.pas
|
||||
chase.pas
|
||||
*.img
|
||||
!runtime.s
|
||||
17
LICENSE.md
Normal file
17
LICENSE.md
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
# Copyright and Licensing
|
||||
|
||||
All files, except where explicitly stated otherwise, are licensed according to the BSD-3-Clause license as follows:
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
Copyright 2024 Sebastian Lederer
|
||||
|
||||
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
|
||||
|
||||
3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
58
README.md
Normal file
58
README.md
Normal file
|
|
@ -0,0 +1,58 @@
|
|||
# Tridora
|
||||
- the Tridora CPU and the Tridora System
|
||||
- creating everything from the ground up (except soldering stuff)
|
||||
- make it useful, but as simple as possible
|
||||
|
||||
## Overview
|
||||
- Homebrew CPU
|
||||
- Verilog/FPGA SoC
|
||||
- 32-bit word-oriented stack machine architecture
|
||||
- has its own instruction set architecture, compatible with nothing
|
||||
- additional IO controllers on FPGA: UART (serial console), SD-Card, VGA
|
||||
- Pascal compiler written from zero
|
||||
- CPU and compiler were designed together
|
||||
- minimal operating system
|
||||
- editor, compiler, assembler run natively
|
||||
- so you can develop programs directly on the machine
|
||||
- small: CPU has 760 lines of verilog, compiler ~9000 LoC
|
||||
- Compiler written in Pascal and can compile itself
|
||||
- Cross-compiler/-assembler can be compiled with FPC
|
||||
- Compiler does its own Pascal dialect with some restrictions and some extensions
|
||||
- Emulator available
|
||||
|
||||
## Demo
|
||||
- (Video hello world)
|
||||
- (Video lines)
|
||||
- (Screenshot mandelbrot)
|
||||
- (Screenshot conway)
|
||||
- (Screenshot image viewer)
|
||||
|
||||
## Supported Boards
|
||||
- Arty A7
|
||||
- Nexys A7?
|
||||
|
||||
## Pascal Language
|
||||
- Wirth Pascal
|
||||
- no function types/parameters
|
||||
- arbitrary length strings (2GB)
|
||||
- safe strings (runtime information about max/current size)
|
||||
- tiny sets (machine word sized), that means no SET OF CHAR
|
||||
- array literals with IN-operator, which can replace most uses of SET OF CHAR
|
||||
- nested procedures with some limitations
|
||||
- 32 bit software floating point with low precision (5-6 digits)
|
||||
- break and exit statements, no continue yet
|
||||
- static variable initialization for global variables
|
||||
- non-standard file i/o (because the standard sucks, obl. XKCD reference)
|
||||
|
||||
## Standard Library
|
||||
- everything from Wirth Pascal
|
||||
- some things from TP3.0
|
||||
- some graphics functionality (to be expanded in the future)
|
||||
|
||||
## Operating System
|
||||
- not a real operating system, more of a program loader
|
||||
- some assembly routines for I/O resident in memory
|
||||
- one program image loaded at a time at a fixed address
|
||||
- most parts of the operating system are contained in the program image
|
||||
- file system is very primitive: only contiguous blocks, no subdirectories
|
||||
- Simple shell reminiscent of TP3.0, edit, compile, run programs
|
||||
48
doc/irqctrl.md
Normal file
48
doc/irqctrl.md
Normal file
|
|
@ -0,0 +1,48 @@
|
|||
# Interrupt Controller
|
||||
The interrupt controller uses a single register at address: $980
|
||||
|
||||
## Reading the status register
|
||||
|
||||
|_bit_ |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|t |t |t |t |t |t |t |t |t |t|t |t |t |t |t |t |
|
||||
|
||||
|_bit_ |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|t |t |t |t |t |t |t |t |- |- |- |- |- |- |p1 |p0 |
|
||||
|
||||
|
||||
|Bitfields|Description|
|
||||
|---------|-----------|
|
||||
| _t_ | unsigned 24 bit counter of timer ticks since reset
|
||||
| _p1_ | IRQ 1 (timer tick) interrupt pending if 1
|
||||
| _p0_ | IRQ 0 (UART) interrupt pending if 1
|
||||
|
||||
|
||||
|
||||
## Writing the status register
|
||||
|
||||
|_bit_ |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|
||||
|_bit_ |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|- |- |- |- |- |- |- |- |i |- |- |- |- |- |- |- |
|
||||
|
||||
|
||||
|Bitfields|Description|
|
||||
|---------|-----------|
|
||||
| _i_ | 1 = interrupts enabled, 0 = interrupts disabled
|
||||
|
||||
|
||||
## Notes
|
||||
Interrupt processing is disabled on reset and needs to be enabled by writing a value with
|
||||
bit 7 set to the status register (i.e. 127).
|
||||
|
||||
An interrupt is only signaled once to the CPU whenever one of the IRQ signals becomes active.
|
||||
|
||||
Reading the status register will reflect all pending interrupts since enabling interrupt processing.
|
||||
|
||||
Interrupt processing needs to be re-enabled after an interrupt occurs by setting bit 7 in the status register again. This will also clear all pending interrupts.
|
||||
|
||||
37
doc/mem.md
Normal file
37
doc/mem.md
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
# Memory Layout
|
||||
|
||||
The Tridora system uses the following memory layout:
|
||||
|
||||
|Address (hex) |Address (decimal)|Description|
|
||||
|-------|-----------|------------------------|
|
||||
|$00000000| 0 | ROM |
|
||||
|$00000800| 2048 | I/O area|
|
||||
|$00001000| 4096 | RAM (SRAM)|
|
||||
|$00010000| 65536 | RAM (DRAM)|
|
||||
|
||||
## Accessing Words and Bytes
|
||||
Memory is word-oriented, so there is no access to individual bytes. Memory transfers always use 32 bits.
|
||||
Word addresses in RAM and ROM use an increment of 4, so the first memory word is at address 0, the second is at address 4 etc.
|
||||
|
||||
This way, you can express a pointer to a specific byte within a word.
|
||||
The lower two bits of the address are ignored when accessing RAM or ROM. So if you use 1 as a memory address, you still get the memory word at address 0.
|
||||
The lower two bits of the address can be viewed as a byte address (0-3) within the word.
|
||||
|
||||
The _BSEL_ and _BPLC_ instructions are designed to assist with accessing bytes within a word.
|
||||
|
||||
Because memory is always accessed in words, the CPU is neither big-endian nor little-endian. However, the _BSEL_ and _BPLC_
|
||||
instructions are big-endian when accessing bytes within a word, so the system can be considered big-endian.
|
||||
|
||||
## Accessing the I/O Area
|
||||
The I/O area organizes memory slightly different. Here, pointing out individual bytes is not very useful, so the I/O controllers use register addresses with increments of one. In practice, there is only the VGA framebuffer controller which uses multiple registers.
|
||||
|
||||
The individual I/O controllers each have a memory area of 128 bytes, so there is a maximum number of 16 I/O controllers.
|
||||
|
||||
Currently, only I/O slots 0-3 are being used.
|
||||
|
||||
|I/O slot| Address | Controller |
|
||||
|--------|---------|------------|
|
||||
| 0 | $800 | UART |
|
||||
| 1 | $880 | VGA |
|
||||
| 2 | $900 | SPI-SD |
|
||||
| 3 | $980 | IRQC |
|
||||
67
doc/spisd.md
Normal file
67
doc/spisd.md
Normal file
|
|
@ -0,0 +1,67 @@
|
|||
# SPI SD-Card Controller
|
||||
The SPI-SD-Card controller uses a single register at address $880.
|
||||
|
||||
## Reading the register
|
||||
|_bit_ |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|- |- |- |- |- |- |- |- |- |-|- |- |- |- |- |- |
|
||||
|
||||
|_bit_ |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|- |cd |cc |cb |tr |te |ra |ro |d |d |d |d |d |d |d |d |
|
||||
|
||||
|
||||
|Bitfields|Description|
|
||||
|---------|-----------|
|
||||
| _cd_ | card detect |
|
||||
| _cc_ | card changed |
|
||||
| _cb_ | card busy |
|
||||
| _tr_ | transmitter ready |
|
||||
| _te_ | transmitter fifo empty |
|
||||
| _ra_ | received byte available |
|
||||
| _ro_ | receiver overrun |
|
||||
| _d_ | received byte data |
|
||||
|
||||
Reading the register does not advance to the next byte in the read fifo. This is done by using the DR bit on a register write (see below).
|
||||
|
||||
## Writing the register
|
||||
|
||||
|_bit_ |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|- |- |- |- |- |- |- |- |- |-|- |- |- |- |- |- |
|
||||
|
||||
|_bit_ |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|- |CW |CF |Cx |Cc |Cd |DR |DW |D |D |D |D |D |D |D |D |
|
||||
|
||||
|
||||
|Bitfields|Description|
|
||||
|---------|-----------|
|
||||
| _CW_ | control write |
|
||||
| _CF_ | enable receive filter |
|
||||
| _Cx_ | enable transceiver |
|
||||
| _Cc_ | force spi clock on |
|
||||
| _Cd_ | write clock divider |
|
||||
| _DR_ | read acknowledge |
|
||||
| _DW_ | data write |
|
||||
| _D_ | byte data |
|
||||
|
||||
* CF, Cx and Cc flags are used together with CW
|
||||
* Cd together with d sets the clock divider
|
||||
* DW together with d writes a data byte
|
||||
* if the receive filter is set, all received bytes are ignored until a byte is received that is not $FF
|
||||
* receiving a byte that is not $FF disables the receive filter
|
||||
* Cc is used to enable the clock without sending/receiving anything - used for card initialization
|
||||
|
||||
Example transaction:
|
||||
|
||||
1. read register, loop until _te_ is set
|
||||
1. write command bytes to register (_DW_ | data)
|
||||
1. write _Cx_|_CF_ to register
|
||||
1. read register, loop until _ra_ is set
|
||||
1. process data byte
|
||||
1. write _DR_ to register
|
||||
1. repeat last three steps until complete response has been read
|
||||
1. wait a bit/send a few more $FF bytes
|
||||
1. disable transceiver, write _CW_ to register (Cx = 0)
|
||||
|
||||
1300
doc/tridoracpu.md
Normal file
1300
doc/tridoracpu.md
Normal file
File diff suppressed because it is too large
Load diff
83
doc/vga.md
Normal file
83
doc/vga.md
Normal file
|
|
@ -0,0 +1,83 @@
|
|||
# VGA Controller
|
||||
|
||||
Registers
|
||||
|Name|Address|Description|
|
||||
|----|-------|-----------|
|
||||
|_FB_RA_ | $900 | Read Address |
|
||||
|_FB_WA_ | $901 | Write Address |
|
||||
| _FB_IO_ | $902 | I/O Register |
|
||||
| _FB_PS_ | $903 | Palette Select |
|
||||
| _FB_PD_ | $904 | Palette Data |
|
||||
| _FB_CTL_ | $905 | Control Register |
|
||||
|
||||
|
||||
|
||||
## Pixel Data
|
||||
Pixel data is organized in 32-bit-words. With four bits per pixel, one word
|
||||
contains eight pixels.
|
||||
|
||||
|_bit_ |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|p0 | p0 | p0 | p0 | p1 | p1 | p1 | p1 | p2 | p2 | p2 | p2 | p3 | p3 | p3 | p3 |
|
||||
|
||||
|_bit_ |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|p4 | p4 | p4 | p4 | p5 | p5 | p5 | p5 | p6 | 62 | p6 | p6 | p7 | p7 | p7 | p7 |
|
||||
|
||||
|Bitfields|Description|
|
||||
|---------|-----------|
|
||||
| _p0_ | 4 bits color value (leftmost pixel) |
|
||||
| _p1_ | 4 bits color value |
|
||||
| _p2_ | 4 bits color value |
|
||||
| _p3_ | 4 bits color value |
|
||||
| _p4_ | 4 bits color value |
|
||||
| _p5_ | 4 bits color value |
|
||||
| _p6_ | 4 bits color value |
|
||||
| _p7_ | 4 bits color value (rightmost pixel) |
|
||||
|
||||
Video memory uses a linear layout, with words using an address increment of one.
|
||||
The first word (horizontal pixel coordinates 0-3) is at address 0, the second (coordinates 4-7) at address 1 etc.
|
||||
The first line starts at address 0, the second at address 80 etc.
|
||||
|
||||
To access video memory, the corresponding video memory address must be written to a latch register, then pixel data can be read or written by the I/O register. Reading and writing uses separate latch registers (the "Read Adress" and "Write Address" registers. To read the same word and write it back, both addresses need to be set.
|
||||
Both registers have an auto-increment function. After reading the I/O register, the FB_RA register is ingremented by one. After writing to the I/O register, the FB_WA register is incremented by one.
|
||||
|
||||
## Palette Data
|
||||
The VGA controller uses a 16 color palette. The palette can be changed with the FB_PS and FB_PD registers. Writing to the FB_PS register selects a palette slot. Valid values are 0-15. After a palette slot is selected, color data can be read from and written to the FB_PD register. Color data is organized as follows:
|
||||
|
||||
|_bit_ |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|
||||
|_bit_ |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|- |- |- |- |r |r |r |r |g |g |g |g |b |b |b |b |
|
||||
|
||||
| _Bitfields_| Description |
|
||||
|------------|--------------|
|
||||
| _r_ | 4 bits red intensity |
|
||||
| _g_ | 4 bits green intensity |
|
||||
| _b_ | 4 bits blue intensity |
|
||||
|
||||
The FB_PS and PB_FD registers cannot be read.
|
||||
|
||||
## Control Register
|
||||
The control register contains status information. It can only be read.
|
||||
|
||||
|_bit_ |31|30|29|28|27|26|25|24|23|22|21|20|19|18|17|16|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|m |m |m |m |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|
||||
|_bit_ |15|14|13|12|11|10|09|08|07|06|05|04|03|02|01|00|
|
||||
|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |
|
||||
|_Value_|- |- |- |- |- |- |- |- |- |- |- |- |- |- |- |vb |
|
||||
|
||||
|
||||
| _Bitfields_| Description |
|
||||
|------------|--------------|
|
||||
| _m_ | 4 bits mode indicator |
|
||||
| _vb_ | vertical blank |
|
||||
|
||||
The _m_ field indicates the current graphics mode. At the time of writing, it is
|
||||
always 1 which denotes a 640x400x4 mode.
|
||||
The _vb_ bit is 1 when the video signal generator is in its vertical blank phase.
|
||||
81
examples/3dcube.pas
Normal file
81
examples/3dcube.pas
Normal file
|
|
@ -0,0 +1,81 @@
|
|||
program cube;
|
||||
const Cw = 640;
|
||||
Ch = 400;
|
||||
Vw = 4;
|
||||
Vh = 3;
|
||||
D = 3.5;
|
||||
|
||||
RED = 2;
|
||||
GREEN = 3;
|
||||
BLUE = 4;
|
||||
|
||||
type point2d = record x,y:real; end;
|
||||
point3d = record x,y,z:real; end;
|
||||
|
||||
var vAf,vBf,vCf,vDf:point3d;
|
||||
vAb,vBb,vCb,vDb:point3d;
|
||||
|
||||
function viewportToCanvas(x,y:real):point2d;
|
||||
begin
|
||||
viewportToCanvas.x := x * Cw/Vw;
|
||||
viewportToCanvas.y := y * Ch/Vh;
|
||||
end;
|
||||
|
||||
function projectVertex(v:point3d):point2d;
|
||||
begin
|
||||
projectVertex := viewportToCanvas(v.x * D / v.z, v.y * D / v.z);
|
||||
end;
|
||||
|
||||
procedure initPoint3d(var p:point3d;x,y,z:real);
|
||||
begin
|
||||
p.x := x;
|
||||
p.y := y;
|
||||
p.z := z;
|
||||
end;
|
||||
|
||||
procedure DrawLine2d(p1,p2:point2d; color:integer);
|
||||
begin
|
||||
drawline(Cw div 2 + trunc(p1.x),Ch div 2 + trunc(p1.y),
|
||||
Cw div 2 + trunc(p2.x), Ch div 2 + trunc(p2.y),
|
||||
color);
|
||||
end;
|
||||
|
||||
begin
|
||||
initGraphics;
|
||||
|
||||
(* The four "front" vertices *)
|
||||
initPoint3d(vAf,-2.0, -0.5, 5.0);
|
||||
initPoint3d(vBf,-2.0, 0.5, 5.0);
|
||||
initPoint3d(vCf,-1.0, 0.5, 5.0);
|
||||
initPoint3d(vDf,-1.0, -0.5, 5.0);
|
||||
|
||||
(* The four "back" vertices *)
|
||||
(*
|
||||
vAb = [-2, -0.5, 6]
|
||||
vBb = [-2, 0.5, 6]
|
||||
vCb = [-1, 0.5, 6]
|
||||
vDb = [-1, -0.5, 6] *)
|
||||
|
||||
initPoint3d(vAb,-2.0, -0.5, 6.0);
|
||||
initPoint3d(vBb,-2.0, 0.5, 6.0);
|
||||
initPoint3d(vCb,-1.0, 0.5, 6.0);
|
||||
initPoint3d(vDb,-1.0, -0.5, 6.0);
|
||||
|
||||
(* The front face *)
|
||||
DrawLine2d(ProjectVertex(vAf), ProjectVertex(vBf), BLUE);
|
||||
DrawLine2d(ProjectVertex(vBf), ProjectVertex(vCf), BLUE);
|
||||
DrawLine2d(ProjectVertex(vCf), ProjectVertex(vDf), BLUE);
|
||||
DrawLine2d(ProjectVertex(vDf), ProjectVertex(vAf), BLUE);
|
||||
|
||||
(* The back face *)
|
||||
DrawLine2d(ProjectVertex(vAb), ProjectVertex(vBb), RED);
|
||||
DrawLine2d(ProjectVertex(vBb), ProjectVertex(vCb), RED);
|
||||
DrawLine2d(ProjectVertex(vCb), ProjectVertex(vDb), RED);
|
||||
DrawLine2d(ProjectVertex(vDb), ProjectVertex(vAb), RED);
|
||||
|
||||
(* The front-to-back edges *)
|
||||
DrawLine2d(ProjectVertex(vAf), ProjectVertex(vAb), GREEN);
|
||||
DrawLine2d(ProjectVertex(vBf), ProjectVertex(vBb), GREEN);
|
||||
DrawLine2d(ProjectVertex(vCf), ProjectVertex(vCb), GREEN);
|
||||
DrawLine2d(ProjectVertex(vDf), ProjectVertex(vDb), GREEN);
|
||||
end.
|
||||
253
examples/5cubes.pas
Normal file
253
examples/5cubes.pas
Normal file
|
|
@ -0,0 +1,253 @@
|
|||
program five_cubes_in_a_row;
|
||||
const MAX_Y = 400;
|
||||
pi = 3.1415926;
|
||||
|
||||
type pointtype = record x,y:integer end;
|
||||
|
||||
var cube:array[1..6] of record
|
||||
position:array[1..5] of record x,y,z:real end;
|
||||
end;
|
||||
c:char;
|
||||
pcos,ncos,psin,nsin:real;
|
||||
|
||||
procedure rotx(dir:integer);
|
||||
var y1,z1:real;i,o:integer;
|
||||
begin
|
||||
if dir=1 then
|
||||
for i:=1 to 6 do
|
||||
for o:=1 to 5 do
|
||||
begin
|
||||
y1:=pcos*cube[i].position[o].y-psin*cube[i].position[o].z;
|
||||
z1:=psin*cube[i].position[o].y+pcos*cube[i].position[o].z;
|
||||
cube[i].position[o].y:=y1;
|
||||
cube[i].position[o].z:=z1;
|
||||
end
|
||||
else
|
||||
for i:=1 to 6 do
|
||||
for o:=1 to 5 do
|
||||
begin
|
||||
y1:=ncos*cube[i].position[o].y-nsin*cube[i].position[o].z;
|
||||
z1:=nsin*cube[i].position[o].y+ncos*cube[i].position[o].z;
|
||||
cube[i].position[o].y:=y1;
|
||||
cube[i].position[o].z:=z1
|
||||
end
|
||||
end;
|
||||
|
||||
procedure roty(dir:integer);
|
||||
var x1,z1:real;i,o:integer;
|
||||
begin
|
||||
if dir=1 then
|
||||
for i:=1 to 6 do
|
||||
for o:=1 to 5 do
|
||||
begin
|
||||
x1:=pcos*cube[i].position[o].x-psin*cube[i].position[o].z;
|
||||
z1:=psin*cube[i].position[o].x+pcos*cube[i].position[o].z;
|
||||
cube[i].position[o].x:=x1;
|
||||
cube[i].position[o].z:=z1;
|
||||
end
|
||||
else
|
||||
for i:=1 to 6 do
|
||||
for o:=1 to 5 do
|
||||
begin
|
||||
x1:=ncos*cube[i].position[o].x-nsin*cube[i].position[o].z;
|
||||
z1:=nsin*cube[i].position[o].x+ncos*cube[i].position[o].z;
|
||||
cube[i].position[o].x:=x1;
|
||||
cube[i].position[o].z:=z1
|
||||
end
|
||||
end;
|
||||
|
||||
procedure rotz(dir:integer);
|
||||
var y1,x1:real;i,o:integer;
|
||||
begin
|
||||
if dir=1 then
|
||||
for i:=1 to 6 do
|
||||
for o:=1 to 5 do
|
||||
begin
|
||||
y1:=pcos*cube[i].position[o].y-psin*cube[i].position[o].x;
|
||||
x1:=psin*cube[i].position[o].y+pcos*cube[i].position[o].x;
|
||||
cube[i].position[o].y:=y1;
|
||||
cube[i].position[o].x:=x1;
|
||||
end
|
||||
else
|
||||
for i:=1 to 6 do
|
||||
for o:=1 to 5 do
|
||||
begin
|
||||
y1:=ncos*cube[i].position[o].y-nsin*cube[i].position[o].x;
|
||||
x1:=nsin*cube[i].position[o].y+ncos*cube[i].position[o].x;
|
||||
cube[i].position[o].y:=y1;
|
||||
cube[i].position[o].x:=x1
|
||||
end
|
||||
end;
|
||||
|
||||
procedure display_cube(col:integer);
|
||||
var i,o,a:integer;c:integer;
|
||||
stran:array[1..4] of pointtype;
|
||||
color:integer;
|
||||
begin
|
||||
for i:=1 to 6 do
|
||||
if cube[i].position[5].z>0 then
|
||||
with cube[i] do
|
||||
begin
|
||||
for a:=1 to 5 do
|
||||
begin
|
||||
if col>0 then c:=a else c:=0;
|
||||
if((a=4)and(c>0))then color :=6 else color:= c;
|
||||
for o:=1 to 4 do
|
||||
begin
|
||||
stran[o].x:=a*100+round(position[o].x);
|
||||
stran[o].y:=MAX_Y div 2+round(position[o].y);
|
||||
end;
|
||||
drawline(stran[1].x,stran[1].y,stran[2].x,stran[2].y,color);
|
||||
drawline(stran[2].x,stran[2].y,stran[3].x,stran[3].y,color);
|
||||
drawline(stran[3].x,stran[3].y,stran[4].x,stran[4].y,color);
|
||||
drawline(stran[4].x,stran[4].y,stran[1].x,stran[1].y,color);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure init;
|
||||
var i,gm,gd:integer;
|
||||
entrance:array[1..11]of integer;
|
||||
begin
|
||||
entrance := [ 1,2,3,4,5,20,7,56,57,58,59 ];
|
||||
InitGraphics;
|
||||
ClearGraphics;
|
||||
pcos:=cos(6*2*pi/360);
|
||||
ncos:=cos(-6*2*pi/360);
|
||||
psin:=sin(6*2*pi/360);
|
||||
nsin:=sin(-6*2*pi/360);
|
||||
setpalette(1,$700);
|
||||
with cube[1] do
|
||||
begin
|
||||
position[1].x:=-25;
|
||||
position[1].y:=-25;
|
||||
position[1].z:=+25;
|
||||
position[2].x:=+25;
|
||||
position[2].y:=-25;
|
||||
position[2].z:=+25;
|
||||
position[3].x:=+25;
|
||||
position[3].y:=+25;
|
||||
position[3].z:=+25;
|
||||
position[4].x:=-25;
|
||||
position[4].y:=+25;
|
||||
position[4].z:=+25;
|
||||
position[5].x:=0;
|
||||
position[5].y:=0;
|
||||
position[5].z:=25;
|
||||
end;
|
||||
with cube[2] do
|
||||
begin
|
||||
position[1].x:=-25;
|
||||
position[1].y:=-25;
|
||||
position[1].z:=-25;
|
||||
position[2].x:=+25;
|
||||
position[2].y:=-25;
|
||||
position[2].z:=-25;
|
||||
position[3].x:=+25;
|
||||
position[3].y:=-25;
|
||||
position[3].z:=+25;
|
||||
position[4].x:=-25;
|
||||
position[4].y:=-25;
|
||||
position[4].z:=+25;
|
||||
position[5].x:=0;
|
||||
position[5].z:=0;
|
||||
position[5].y:=-25;
|
||||
end;
|
||||
with cube[3] do
|
||||
begin
|
||||
position[1].x:=-25;
|
||||
position[1].y:=+25;
|
||||
position[1].z:=+25;
|
||||
position[2].x:=+25;
|
||||
position[2].y:=+25;
|
||||
position[2].z:=+25;
|
||||
position[3].x:=+25;
|
||||
position[3].y:=+25;
|
||||
position[3].z:=-25;
|
||||
position[4].x:=-25;
|
||||
position[4].y:=+25;
|
||||
position[4].z:=-25;
|
||||
position[5].x:=0;
|
||||
position[5].z:=0;
|
||||
position[5].y:=25;
|
||||
end;
|
||||
with cube[4] do
|
||||
begin
|
||||
position[1].x:=-25;
|
||||
position[1].y:=-25;
|
||||
position[1].z:=-25;
|
||||
position[2].x:=-25;
|
||||
position[2].y:=-25;
|
||||
position[2].z:=+25;
|
||||
position[3].x:=-25;
|
||||
position[3].y:=+25;
|
||||
position[3].z:=+25;
|
||||
position[4].x:=-25;
|
||||
position[4].y:=+25;
|
||||
position[4].z:=-25;
|
||||
position[5].y:=0;
|
||||
position[5].z:=0;
|
||||
position[5].x:=-25;
|
||||
end;
|
||||
with cube[5] do
|
||||
begin
|
||||
position[1].x:=+25;
|
||||
position[1].y:=-25;
|
||||
position[1].z:=+25;
|
||||
position[2].x:=+25;
|
||||
position[2].y:=-25;
|
||||
position[2].z:=-25;
|
||||
position[3].x:=+25;
|
||||
position[3].y:=+25;
|
||||
position[3].z:=-25;
|
||||
position[4].x:=+25;
|
||||
position[4].y:=+25;
|
||||
position[4].z:=+25;
|
||||
position[5].x:=25;
|
||||
position[5].y:=0;
|
||||
position[5].z:=0;
|
||||
end;
|
||||
with cube[6] do
|
||||
begin
|
||||
position[1].x:=-25;
|
||||
position[1].y:=+25;
|
||||
position[1].z:=-25;
|
||||
position[2].x:=+25;
|
||||
position[2].y:=+25;
|
||||
position[2].z:=-25;
|
||||
position[3].x:=+25;
|
||||
position[3].y:=-25;
|
||||
position[3].z:=-25;
|
||||
position[4].x:=-25;
|
||||
position[4].y:=-25;
|
||||
position[4].z:=-25;
|
||||
position[5].x:=0;
|
||||
position[5].y:=0;
|
||||
position[5].z:=-25;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
init;
|
||||
repeat
|
||||
display_cube(1);
|
||||
repeat
|
||||
c:=conin;
|
||||
until(upcase(c)in['E','Q','S','W','D','A','J','K','L','U','I','O'])or(c=#27);
|
||||
display_cube(0);
|
||||
case upcase(c) of
|
||||
'E':rotz(0);
|
||||
'Q':rotz(1);
|
||||
'S':rotx(0);
|
||||
'W':rotx(1);
|
||||
'D':roty(0);
|
||||
'A':roty(1);
|
||||
'J':begin rotx(1);roty(1);rotz(1);end;
|
||||
'L':begin rotx(0);roty(0);rotz(0);end;
|
||||
'K':begin rotx(1);roty(0);rotz(1);end;
|
||||
'I':begin rotx(0);roty(1);rotz(0);end;
|
||||
'U':begin rotx(0);roty(1);rotz(1);end;
|
||||
'O':begin rotx(1);roty(0);rotz(0);end;
|
||||
end;
|
||||
until c=#27;
|
||||
end.
|
||||
8
examples/LICENSES.md
Normal file
8
examples/LICENSES.md
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
# Attributions for included media files
|
||||
* ara.pict: Tuxyso / Wikimedia Commons / CC-BY-SA-3.0
|
||||
https://commons.wikimedia.org/wiki/File:Ara-Zoo-Muenster-2013.jpg
|
||||
* snow_leopard.pict: Tambako The Jaguar, CC BY-SA 2.0 <https://creativecommons.org/licenses/by-sa/2.0>, via Wikimedia Commons
|
||||
https://commons.wikimedia.org/wiki/File:Snow_leopard_portrait.jpg
|
||||
* shinkansen.pict: 投稿者が撮影, CC BY-SA 3.0 <http://creativecommons.org/licenses/by-sa/3.0/>, via Wikimedia Commons
|
||||
https://commons.wikimedia.org/wiki/File:0key22-86.JPG
|
||||
|
||||
BIN
examples/ara.pict
Normal file
BIN
examples/ara.pict
Normal file
Binary file not shown.
116
examples/conway.pas
Normal file
116
examples/conway.pas
Normal file
|
|
@ -0,0 +1,116 @@
|
|||
program conway;
|
||||
const cellwidth = 4;
|
||||
cellheight = 4;
|
||||
cols = 40;
|
||||
rows = 25;
|
||||
|
||||
WHITE = 1;
|
||||
BLACK = 0;
|
||||
|
||||
type gridType = array [1..rows, 1..cols] of integer;
|
||||
|
||||
var grid:gridType;
|
||||
ch:char;
|
||||
|
||||
procedure initGrid(var g:gridType);
|
||||
var x,y:integer;
|
||||
begin
|
||||
randomize;
|
||||
for y := 1 to rows do
|
||||
for x := 1 to cols do
|
||||
if (random and 1024) > 512 then
|
||||
grid[y,x] := 1;
|
||||
end;
|
||||
|
||||
procedure updateGrid;
|
||||
var oldGrid:gridType;
|
||||
neighbors:integer;
|
||||
x,y:integer;
|
||||
wasAlive:boolean;
|
||||
isAlive:boolean;
|
||||
gen:integer;
|
||||
begin
|
||||
oldGrid := grid;
|
||||
for y := 1 to rows do
|
||||
for x := 1 to cols do
|
||||
begin
|
||||
wasAlive := oldGrid[y,x] > 0;
|
||||
isAlive := false;
|
||||
|
||||
neighbors := 0;
|
||||
|
||||
if y > 1 then
|
||||
begin
|
||||
if x > 1 then
|
||||
if oldGrid[y-1,x-1] > 0 then neighbors := neighbors + 1;
|
||||
|
||||
if oldGrid[y-1,x] > 0 then neighbors := neighbors + 1;
|
||||
|
||||
if x < cols then
|
||||
if oldGrid[y-1,x+1] > 0 then neighbors := neighbors + 1;
|
||||
end;
|
||||
|
||||
if x > 1 then
|
||||
if oldGrid[y,x-1] > 0 then neighbors := neighbors + 1;
|
||||
if x < cols then
|
||||
if oldGrid[y,x+1] > 0 then neighbors := neighbors + 1;
|
||||
|
||||
if y < rows then
|
||||
begin
|
||||
if x > 1 then
|
||||
if oldGrid[y+1,x-1] > 0 then neighbors := neighbors + 1;
|
||||
|
||||
if oldGrid[y+1,x] > 0 then neighbors := neighbors + 1;
|
||||
|
||||
if x < cols then
|
||||
if oldGrid[y+1,x+1] > 0 then neighbors := neighbors + 1;
|
||||
end;
|
||||
|
||||
if wasAlive then
|
||||
begin
|
||||
if (neighbors = 2) or (neighbors = 3) then
|
||||
isAlive := true;
|
||||
end
|
||||
else
|
||||
if neighbors = 3 then
|
||||
isAlive := true;
|
||||
if isAlive then
|
||||
begin
|
||||
gen := grid[y,x];
|
||||
if gen < 8 then gen := gen + 1;
|
||||
grid[y,x] := gen;
|
||||
end
|
||||
else
|
||||
grid[y,x] := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure drawGrid;
|
||||
var x,y:integer;
|
||||
color:integer;
|
||||
screenx,screeny:integer;
|
||||
begin
|
||||
for x := 1 to cols do
|
||||
for y := 1 to rows do
|
||||
begin
|
||||
color := grid[y,x];
|
||||
|
||||
screenx := x * cellwidth;
|
||||
screeny := y * cellheight;
|
||||
putpixel(screenx,screeny,color);
|
||||
putpixel(screenx+1,screeny,color);
|
||||
putpixel(screenx,screeny+1,color);
|
||||
putpixel(screenx+1,screeny+1,color);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
initGraphics;
|
||||
initGrid(grid);
|
||||
repeat
|
||||
drawGrid;
|
||||
updateGrid;
|
||||
{ delay(100); }
|
||||
until conavail;
|
||||
read(ch);
|
||||
end.
|
||||
19
examples/graph1.pas
Normal file
19
examples/graph1.pas
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
{ program 4.9
|
||||
graphic representation of a function
|
||||
f(x) = exp(-x) * sin(2*pi*x) }
|
||||
|
||||
program graph1;
|
||||
const d = 0.0625; {1/16, 16 lines for interval [x,x+1]}
|
||||
s = 32; {32 character widths for interval [y,y+1]}
|
||||
h = 34; {character position of x-axis}
|
||||
c = 6.28318; {2*pi} lim = 32;
|
||||
var x,y : real; i,n : integer;
|
||||
begin
|
||||
for i := 0 to lim do
|
||||
begin x := d*i; y := exp(-x)*sin(c*x);
|
||||
n := round(s*y) + h;
|
||||
repeat write(' '); n := n-1
|
||||
until n=0;
|
||||
writeln('*')
|
||||
end
|
||||
end.
|
||||
15
examples/hellop.pas
Normal file
15
examples/hellop.pas
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
(* a simple test program to say
|
||||
hello to the world *)
|
||||
|
||||
program hello;
|
||||
begin
|
||||
(* if there is an argument, use it *)
|
||||
if ParamCount > 0 then
|
||||
writeln('Hello ', ParamStr(1))
|
||||
else
|
||||
writeln('Hello World!');
|
||||
end.
|
||||
{ Note that the last END needs to be followed by the . character,
|
||||
not by a ; character. This is because ; means that there is
|
||||
another statement. It does not mark the end of the statement
|
||||
like in other languages. The . marks the end of the program text. }
|
||||
70
examples/lines.pas
Normal file
70
examples/lines.pas
Normal file
|
|
@ -0,0 +1,70 @@
|
|||
PROGRAM lines;
|
||||
|
||||
PROCEDURE movinglines(max_x, max_y, max_col, ms:INTEGER);
|
||||
VAR x1,y1:INTEGER;
|
||||
VAR x2,y2:INTEGER;
|
||||
VAR delta_x1, delta_y1:INTEGER;
|
||||
VAR delta_x2, delta_y2:INTEGER;
|
||||
VAR col:INTEGER;
|
||||
BEGIN
|
||||
|
||||
x1 := 120;
|
||||
y1 := 90;
|
||||
|
||||
x2 := 340;
|
||||
y2 := 220;
|
||||
|
||||
delta_x1 := 9;
|
||||
delta_y1 := 4;
|
||||
|
||||
delta_x2 := 3;
|
||||
delta_y2 := 7;
|
||||
|
||||
col := 1;
|
||||
|
||||
WHILE NOT CONAVAIL DO
|
||||
BEGIN
|
||||
x1 := x1 + delta_x1;
|
||||
y1 := y1 + delta_y1;
|
||||
|
||||
x2 := x2 + delta_x2;
|
||||
y2 := y2 + delta_y2;
|
||||
|
||||
IF (x1 > max_x) OR (x1 < 0) THEN
|
||||
BEGIN
|
||||
delta_x1 := -delta_x1;
|
||||
x1 := x1 + delta_x1;
|
||||
END;
|
||||
|
||||
IF (y1 > max_y) OR (y1 < 0) THEN
|
||||
BEGIN
|
||||
delta_y1 := -delta_y1;
|
||||
y1 := y1 + delta_y1;
|
||||
END;
|
||||
|
||||
IF (x2 > max_x) OR (x2 < 0) THEN
|
||||
BEGIN
|
||||
delta_x2 := -delta_x2;
|
||||
x2 := x2 + delta_x2;
|
||||
END;
|
||||
|
||||
IF (y2 > max_y) OR (y2 < 0) THEN
|
||||
BEGIN
|
||||
delta_y2 := -delta_y2;
|
||||
y2 := y2 + delta_y2;
|
||||
END;
|
||||
|
||||
col := col + 1;
|
||||
|
||||
IF col > max_col THEN col := 1;
|
||||
|
||||
DRAWLINE(x1,y1,x2,y2,col);
|
||||
|
||||
delay(ms);
|
||||
END;
|
||||
END;
|
||||
|
||||
BEGIN
|
||||
initgraphics;
|
||||
movinglines(639,399,15,0);
|
||||
END.
|
||||
63
examples/mandelbrot.pas
Normal file
63
examples/mandelbrot.pas
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
program mandelbrot;
|
||||
|
||||
const width = 459; height = 405;
|
||||
xstart = -2.02; xend = 0.7;
|
||||
ystart = -1.2; yend = 1.2;
|
||||
maxIterations = 25;
|
||||
maxColors = 15;
|
||||
|
||||
var dx,dy:real;
|
||||
col,row:integer;
|
||||
cx,cy:real;
|
||||
iterations:integer;
|
||||
colors:array[0..15] of integer = { ($000, $020, $031, $042,
|
||||
$053, $064, $075, $086,
|
||||
$097, $0A8, $0B9, $0CA,
|
||||
$0DB, $0EC, $0FD, $0FF); }
|
||||
|
||||
($000, $100, $200, $411,
|
||||
$522, $633, $744, $855,
|
||||
$966, $A77, $B88, $C99,
|
||||
$DAA, $EBB, $FCC, $FDD);
|
||||
c:integer;
|
||||
|
||||
function iterate(x,y:real):integer;
|
||||
var zx,zy:real;
|
||||
tmp:real;
|
||||
count:integer;
|
||||
begin
|
||||
zx := 0.0; zy := 0.0; count := 0;
|
||||
|
||||
repeat
|
||||
tmp := zx*zx - zy*zy + x;
|
||||
zy := 2.0*zx*zy + cy;
|
||||
zx := tmp;
|
||||
count := count + 1;
|
||||
until (zx*zx + zy*zy > 4.0) or (count = MaxIterations);
|
||||
|
||||
iterate := count;
|
||||
end;
|
||||
|
||||
begin
|
||||
initgraphics;
|
||||
for c:=0 to 15 do
|
||||
setpalette(c, colors[c]);
|
||||
|
||||
dx := (xend - xstart) / (width - 1);
|
||||
dy := (yend - ystart) / (height - 1);
|
||||
|
||||
for col := 0 to width - 1 do
|
||||
begin
|
||||
cx := xstart + col * dx;
|
||||
for row := 0 to height - 1 do
|
||||
begin
|
||||
cy := yend - row * dy;
|
||||
iterations := iterate(cx, cy);
|
||||
if iterations = MaxIterations then
|
||||
c := 0
|
||||
else
|
||||
c := iterations mod MaxColors + 1;
|
||||
putpixel(col, row, c);
|
||||
end;
|
||||
end;
|
||||
end.
|
||||
110
examples/rtpair.pas
Normal file
110
examples/rtpair.pas
Normal file
|
|
@ -0,0 +1,110 @@
|
|||
{ Raytracer for a scene with a pair of spheres and multiple reflections }
|
||||
program RtPair;
|
||||
const MaxX = 639;
|
||||
MaxY = 399;
|
||||
HalfX = 320;
|
||||
HalfY = 200;
|
||||
|
||||
var
|
||||
gd, gm: Integer;
|
||||
N, M: Integer;
|
||||
X, Y, Z: Real;
|
||||
U, V, W: Real;
|
||||
I, E, F, P, D, T, R, G: Real;
|
||||
stopReflection: Boolean;
|
||||
C: Integer;
|
||||
|
||||
function Sign(x: Real): Real;
|
||||
begin
|
||||
if x>0 then
|
||||
Sign := 1
|
||||
else
|
||||
Sign := -1;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
InitGraphics;
|
||||
SetPalette(0, $000);
|
||||
SetPalette(4, $A00);
|
||||
SetPalette(11, $0FF);
|
||||
SetPalette(15, $FFF);
|
||||
|
||||
for N:=0 to MaxY do
|
||||
for M:=0 to MaxX do
|
||||
begin
|
||||
{ Rays' origin point }
|
||||
X := 0;
|
||||
Y := -0.1;
|
||||
Z := 3;
|
||||
|
||||
U := (M - 318) / HalfX;
|
||||
V := (HalfY - N) / 321.34;
|
||||
|
||||
W := 1 / Sqrt(U*U + V*V + 1);
|
||||
U := U*W;
|
||||
V := V*W;
|
||||
|
||||
{ I is the horizontal direction of ray }
|
||||
{ based on whether it is in left (U<0) or right (U>0) half of the screen }
|
||||
I := Sign(U);
|
||||
G := 1;
|
||||
|
||||
{ Start the reflection cycle. }
|
||||
{ A ray may reflect between one sphere and another multiple times before hitting floor or sky. }
|
||||
repeat
|
||||
stopReflection := True;
|
||||
E := X-I;
|
||||
F := Y-I;
|
||||
P := U*E + V*F - W*Z;
|
||||
D := P*P - E*E - F*F - Z*Z + 1;
|
||||
|
||||
{ If ray reflects from a sphere one more time }
|
||||
if D>0 then
|
||||
begin
|
||||
T := -P - Sqrt(D);
|
||||
if T>0 then
|
||||
begin
|
||||
X := X + T*U;
|
||||
Y := Y + T*V;
|
||||
Z := Z - T*W;
|
||||
E := X - I;
|
||||
F := Y - I;
|
||||
G := Z;
|
||||
P := 2*(U*E + V*F - W*G);
|
||||
U := U - P*E;
|
||||
V := V - P*F;
|
||||
W := W + P*G;
|
||||
|
||||
{ Invert ray's direction and continue the reflection cycle }
|
||||
I := -I;
|
||||
stopReflection := False;
|
||||
end;
|
||||
end;
|
||||
until stopReflection;
|
||||
|
||||
{ If Y<0 (V<0) a ray hits the floor }
|
||||
if V<0 then
|
||||
begin
|
||||
P := (Y+2)/V;
|
||||
{ Select checkers floor with Black (0) and Red (4) tiles }
|
||||
C := (1 And (Round(X - U*P) + Round(Z + W*P))) * 4;
|
||||
end else begin
|
||||
{ If Y>0 (V>0) a ray hits the sky }
|
||||
{ Default sky color is Cyan (11) }
|
||||
C := 11;
|
||||
{ Condition for using color White (15) to create fancy Cyan-White horizon }
|
||||
R := ArcTan(U/W);
|
||||
R := 0.2+0.1*Cos(3*R)*Abs(Sin(5*R));
|
||||
if Abs(G)<0.35 then
|
||||
R := R + 1;
|
||||
if V<R then
|
||||
C := 15;
|
||||
end;
|
||||
|
||||
{ Draw current pixel }
|
||||
PutPixel(M, N, C);
|
||||
end;
|
||||
|
||||
repeat until ConAvail;
|
||||
end.
|
||||
BIN
examples/shinkansen.pict
Normal file
BIN
examples/shinkansen.pict
Normal file
Binary file not shown.
BIN
examples/snow_leopard.pict
Normal file
BIN
examples/snow_leopard.pict
Normal file
Binary file not shown.
143
examples/test.txt
Normal file
143
examples/test.txt
Normal file
|
|
@ -0,0 +1,143 @@
|
|||
|
||||
|
||||
THE ELEMENTS OF STYLE
|
||||
|
||||
BY
|
||||
WILLIAM STRUNK, Jr.
|
||||
|
||||
PROFESSOR OF ENGLISH
|
||||
IN
|
||||
CORNELL UNIVERSITY
|
||||
|
||||
NEW YORK
|
||||
HARCOURT, BRACE AND COMPANY
|
||||
|
||||
|
||||
COPYRIGHT, 1918, 1919, BY
|
||||
WILLIAM STRUNK, JR.
|
||||
|
||||
COPYRIGHT, 1920, BY
|
||||
HARCOURT, BRACE AND HOWE, INC.
|
||||
|
||||
|
||||
THE MAPLE PRESS YORK PA
|
||||
|
||||
|
||||
|
||||
|
||||
CONTENTS
|
||||
|
||||
|
||||
Page
|
||||
|
||||
I. Introductory 5
|
||||
|
||||
II. Elementary Rules of Usage 7
|
||||
|
||||
1. Form the possessive singular of nouns by adding _'s_ 7
|
||||
|
||||
2. In a series of three or more terms with a single
|
||||
conjunction, use a comma after each term except the last 7
|
||||
|
||||
3. Enclose parenthetic expressions between commas 8
|
||||
|
||||
4. Place a comma before a conjunction introducing a
|
||||
co-ordinate clause 10
|
||||
|
||||
5. Do not join independent clauses by a comma 11
|
||||
|
||||
6. Do not break sentences in two 12
|
||||
|
||||
7. A participial phrase at the beginning of a sentence must
|
||||
refer to the grammatical subject 13
|
||||
|
||||
III. Elementary Principles of Composition 15
|
||||
|
||||
8. Make the paragraph the unit of composition: one paragraph
|
||||
to each topic 15
|
||||
|
||||
9. As a rule, begin each paragraph with a topic sentence; end
|
||||
it in conformity with the beginning 17
|
||||
|
||||
10. Use the active voice 19
|
||||
|
||||
11. Put statements in positive form 21
|
||||
|
||||
12. Use definite, specific, concrete language 22
|
||||
|
||||
13. Omit needless words 24
|
||||
|
||||
14. Avoid a succession of loose sentences 25
|
||||
|
||||
15. Express co-ordinate ideas in similar form 26
|
||||
|
||||
16. Keep related words together 28
|
||||
|
||||
17. In summaries, keep to one tense 29
|
||||
|
||||
18. Place the emphatic words of a sentence at the end 31
|
||||
|
||||
IV. A Few Matters of Form 33
|
||||
|
||||
V. Words and Expressions Commonly Misused 36
|
||||
|
||||
VI. Spelling 48
|
||||
|
||||
VII. Exercises on Chapters II and III 50
|
||||
|
||||
|
||||
|
||||
|
||||
I. INTRODUCTORY
|
||||
|
||||
|
||||
This book aims to give in brief space the principal requirements of
|
||||
plain English style. It aims to lighten the task of instructor and
|
||||
student by concentrating attention (in Chapters II and III) on a few
|
||||
essentials, the rules of usage and principles of composition most
|
||||
commonly violated. In accordance with this plan it lays down three rules
|
||||
for the use of the comma, instead of a score or more, and one for the
|
||||
use of the semicolon, in the belief that these four rules provide for
|
||||
all the internal punctuation that is required by nineteen sentences out
|
||||
of twenty. Similarly, it gives in Chapter III only those principles of
|
||||
the paragraph and the sentence which are of the widest application. The
|
||||
book thus covers only a small portion of the field of English style. The
|
||||
experience of its writer has been that once past the essentials,
|
||||
students profit most by individual instruction based on the problems of
|
||||
their own work, and that each instructor has his own body of theory,
|
||||
which he may prefer to that offered by any textbook.
|
||||
|
||||
The numbers of the sections may be used as references in correcting
|
||||
manuscript.
|
||||
|
||||
The writer's colleagues in the Department of English in Cornell
|
||||
University have greatly helped him in the preparation of his manuscript.
|
||||
Mr. George McLane Wood has kindly consented to the inclusion under
|
||||
Rule 10 of some material from his _Suggestions to Authors_.
|
||||
|
||||
The following books are recommended for reference or further study: in
|
||||
connection with Chapters II and IV, F. Howard Collins, _Author and
|
||||
Printer_ (Henry Frowde); Chicago University Press, _Manual of Style_;
|
||||
T. L. De Vinne, _Correct Composition_ (The Century Company); Horace
|
||||
Hart, _Rules for Compositors and Printers_ (Oxford University Press);
|
||||
George McLane Wood, _Extracts from the Style-Book of the Government
|
||||
Printing Office_ (United States Geological Survey); in connection with
|
||||
Chapters III and V, _The King's English_ (Oxford University Press); Sir
|
||||
Arthur Quiller-Couch, _The Art of Writing_ (Putnam), especially the
|
||||
chapter, Interlude on Jargon; George McLane Wood, _Suggestions to
|
||||
Authors_ (United States Geological Survey); John Lesslie Hall, _English
|
||||
Usage_ (Scott, Foresman and Co.); James P. Kelley, _Workmanship in
|
||||
Words_ (Little, Brown and Co.). In these will be found full discussions
|
||||
of many points here briefly treated and an abundant store of
|
||||
illustrations to supplement those given in this book.
|
||||
|
||||
It is an old observation that the best writers sometimes disregard the
|
||||
rules of rhetoric. When they do so, however, the reader will usually
|
||||
find in the sentence some compensating merit, attained at the cost of
|
||||
the violation. Unless he is certain of doing as well, he will probably
|
||||
do best to follow the rules. After he has learned, by their guidance, to
|
||||
write plain English adequate for everyday uses, let him look, for the
|
||||
secrets of style, to the study of the masters of literature.
|
||||
|
||||
|
||||
|
||||
44
examples/viewpict.pas
Normal file
44
examples/viewpict.pas
Normal file
|
|
@ -0,0 +1,44 @@
|
|||
program viewpict;
|
||||
type PictData = record
|
||||
magic, mode:integer;
|
||||
palette: array [0..15] of integer;
|
||||
pixeldata: array [0..31999] of integer;
|
||||
end;
|
||||
|
||||
|
||||
var pic:PictData;
|
||||
filename:string;
|
||||
infile:file;
|
||||
ch:char;
|
||||
|
||||
procedure loadPalette(var pic:PictData);
|
||||
var i:integer;
|
||||
begin
|
||||
for i := 0 to 15 do
|
||||
setpalette(i, pic.palette[i]);
|
||||
end;
|
||||
|
||||
procedure loadPic(var pic:PictData);
|
||||
begin
|
||||
PutScreen(pic.pixeldata);
|
||||
end;
|
||||
|
||||
begin
|
||||
if ParamCount > 0 then
|
||||
filename := ParamStr(1)
|
||||
else
|
||||
begin
|
||||
write('Filename> ');
|
||||
readln(filename);
|
||||
end;
|
||||
|
||||
open(infile, filename, ModeReadonly);
|
||||
read(infile, pic);
|
||||
close(infile);
|
||||
|
||||
writeln('magic: ', pic.magic, ' mode:', pic.mode);
|
||||
|
||||
loadPalette(pic);
|
||||
loadPic(pic);
|
||||
read(ch);
|
||||
end.
|
||||
1939
lib/runtime.s
Normal file
1939
lib/runtime.s
Normal file
File diff suppressed because it is too large
Load diff
285
lib/stdlib.inc
Normal file
285
lib/stdlib.inc
Normal file
|
|
@ -0,0 +1,285 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
{ const pi = 3.14169253; }
|
||||
const MaxInt = 2147483647;
|
||||
|
||||
const MaxVolumes = 32;
|
||||
DefaultBufSize = 4096;
|
||||
DefaultBufBlocks = 8;
|
||||
DirSlotSize = 64;
|
||||
|
||||
const IONoError = 0;
|
||||
IOFileNotFound = 1;
|
||||
IOVolNotFound = 2;
|
||||
IOPathInvalid = 3;
|
||||
IOFileExists = 4;
|
||||
IOFileClosed = 5;
|
||||
IOSeekInvalid = 6;
|
||||
IONoSpace = 7;
|
||||
IOReadOnly = 8;
|
||||
IOInvalidOp = 9;
|
||||
IOInvalidFormat = 10;
|
||||
IOUserIntr = 11;
|
||||
IOMaxErr = 11;
|
||||
|
||||
const PArgMax = 7;
|
||||
|
||||
type IOBlock = array [0..127] of integer;
|
||||
type IOBuffer = array [0..7] of IOBlock;
|
||||
|
||||
type filetype = (IOChannel, IODiskFile);
|
||||
type filemode = (ModeReadonly, ModeCreate, ModeModify, ModeOverwrite, ModeAppend);
|
||||
type file = record
|
||||
mode: filemode;
|
||||
lastError: integer;
|
||||
errorAck: boolean;
|
||||
ateoln:boolean;
|
||||
case typ:filetype of
|
||||
IOChannel: (channelid:integer;
|
||||
bufchar:char; buflen:integer;
|
||||
ateof:boolean;
|
||||
noecho:boolean; (* read chars are not echoed *)
|
||||
raw:boolean; (* turn off backspace processing on input, CR processing on output *)
|
||||
nointr: boolean); (* turn off keyboard interrupt character processing *)
|
||||
|
||||
IODiskFile: (volumeid: integer;fileno: integer; filpos:integer; bufStart:integer;
|
||||
size:integer; sizeExtents:integer;
|
||||
bufBlocks, extentBlocks:integer;
|
||||
changed: boolean;
|
||||
buffer: ^IOBuffer;
|
||||
bufpos: integer;
|
||||
bufsize: integer;
|
||||
needsflush: boolean;
|
||||
);
|
||||
end;
|
||||
type text = file;
|
||||
|
||||
type fscanmode = (ScanInteger, ScanReal, ScanString);
|
||||
|
||||
type filenamestr = string[32];
|
||||
type pathnamestr = string[68];
|
||||
type volumenamestr = string[32];
|
||||
|
||||
type PartFlags = set of (PartEnabled, PartBoot, PartLast, PartPhysical, PartDefault);
|
||||
|
||||
type Partition = record
|
||||
name: volumenamestr;
|
||||
flags: PartFlags;
|
||||
startBlock: integer;
|
||||
blocks: integer;
|
||||
extentSize: integer; (* size of an extent in bytes, power of two > 512 *)
|
||||
dirSize: integer; (* number of directory slots *)
|
||||
bootBlocks: integer;
|
||||
end;
|
||||
|
||||
type PartitionTableBlock = array[0..7] of Partition;
|
||||
|
||||
type Volume = record
|
||||
part: Partition;
|
||||
deviceId: integer;
|
||||
partitionId: integer;
|
||||
startSlot: integer; (* first directory slot known to be in use *)
|
||||
freeSlot: integer; (* a directory slot that is probably free *)
|
||||
(* dirFile: ^file; (* pseudo-file for accessing the directory *)
|
||||
dirCache: ^DirBlock;
|
||||
cachedBlock: integer; (* cached volume block number in dirCache *)
|
||||
cacheDirty: boolean;
|
||||
openFilesCount: integer;
|
||||
end;
|
||||
|
||||
type DirSlotFlags = set of (SlotFree, SlotReserved, SlotDeleted, SlotEndScan, SlotFirst, SlotExtent, SlotReadonly);
|
||||
|
||||
type Timestamp = integer;
|
||||
|
||||
type DirectorySlot = record
|
||||
name: filenamestr; (* the name of the file *)
|
||||
flags: DirSlotFlags; (* see above *)
|
||||
sizeBytes: integer; (* the size of the file in bytes *)
|
||||
createTime: Timestamp; (* creation time of the file *)
|
||||
modTime: Timestamp; (* time of last file modification *)
|
||||
generation: integer; (* increased each time a file is overwritten *)
|
||||
owner: integer; (* unused *)
|
||||
end;
|
||||
|
||||
DirBlock = array [0..7] of DirectorySlot;
|
||||
|
||||
type PArgVec = array[0..PArgMax] of string;
|
||||
|
||||
type DateTime = record
|
||||
year:integer;
|
||||
month: 1..12;
|
||||
day: 1..31;
|
||||
hours: 0..23;
|
||||
minutes: 0..59;
|
||||
seconds: 0..59;
|
||||
end;
|
||||
|
||||
var input,output:file external;
|
||||
var DefaultVolumeId:integer external; (* do we need this here? *)
|
||||
VolumeTable: array [1..MaxVolumes] of Volume external; (* and this *)
|
||||
VolumeCount: integer external; (* and this *)
|
||||
|
||||
DefaultVolume: volumenamestr external;
|
||||
|
||||
SysBootTicks, SysLastTicks:integer external;
|
||||
SysClock:DateTime external;
|
||||
|
||||
(* from graphics.s *)
|
||||
PROCEDURE DRAWLINE(x1,y1,x2,y2, color:INTEGER); EXTERNAL;
|
||||
PROCEDURE PUTPIXEL(x,y, color:INTEGER); EXTERNAL;
|
||||
PROCEDURE CLEARGRAPHICS; EXTERNAL;
|
||||
PROCEDURE INITGRAPHICS; EXTERNAL;
|
||||
PROCEDURE SETPALETTE(slot, color:INTEGER);EXTERNAL;
|
||||
PROCEDURE PUTSCREEN(VAR pixeldata: ARRAY [0..31999] OF INTEGER); EXTERNAL;
|
||||
|
||||
function conin():char; external;
|
||||
procedure conout(c:char); external;
|
||||
FUNCTION CONAVAIL:BOOLEAN; EXTERNAL;
|
||||
PROCEDURE WAIT1MSEC; EXTERNAL;
|
||||
function upcase(aChar:char):char; external;
|
||||
function getticks():integer; external;
|
||||
|
||||
(* from float32.s *)
|
||||
function shiftfloat32(aReal:real; shiftCount:integer):real; external;
|
||||
function getfloat32exp(aReal:real):integer; external;
|
||||
|
||||
(* from runtime.s *)
|
||||
FUNCTION LENGTH(s:STRING):INTEGER; EXTERNAL;
|
||||
FUNCTION MAXLENGTH(s:STRING):INTEGER; EXTERNAL;
|
||||
procedure appendchar(var s:string; aChar:char); external;
|
||||
procedure strmoveup(var s:string;index,length,delta:integer); external;
|
||||
procedure strmovedown(var s:string;index,length,delta:integer); external;
|
||||
procedure RuntimeError(var s:string); external;
|
||||
|
||||
(* from stdlib *)
|
||||
function copy(s:string;index,count:integer):string; external;
|
||||
procedure insert(ins: string; var dest: string; position:integer); external;
|
||||
procedure delete(var s:string; from:integer; count:integer); external;
|
||||
function pos(substr:string;var s:string):integer; external;
|
||||
function pwroften(exp:integer):real; external;
|
||||
function exp(exponent:real):real; external;
|
||||
function ln(power:real):real; external;
|
||||
function sqrt(n:real):real; external;
|
||||
function floor(x:real):integer; external;
|
||||
function round(x:real):integer; external;
|
||||
function sin(x:real):real; external;
|
||||
function cos(x:real):real; external;
|
||||
function arctan(x:real):real; external;
|
||||
function tan(x:real):real; external;
|
||||
function cotan(x:real):real; external;
|
||||
|
||||
procedure fillchar(var s:string; startpos,count:integer; theChar:char); external;
|
||||
|
||||
procedure cardinitv2; external;
|
||||
function cardsize:integer; external;
|
||||
function cardchanged:boolean; external;
|
||||
|
||||
procedure readpartblk(blkno:integer;var partblk:PartitionTableBlock;
|
||||
var error:integer;devid: integer); external;
|
||||
procedure readdirblk(blkno:integer;var dirblk:DirBlock;
|
||||
var error:integer;devid: integer); external;
|
||||
procedure readblock(blkno:integer;var buf:IOBlock;
|
||||
var error:integer; devid: integer); external;
|
||||
|
||||
procedure writedirblk(blkno:integer;var dirblk:DirBlock;
|
||||
var error:integer;devid: integer); external;
|
||||
procedure writepartblk(blkno:integer;var partblk:PartitionTableBlock;
|
||||
var error:integer;devid: integer); external;
|
||||
procedure writeblock(blkno:integer;var buf:IOBlock;
|
||||
var error:integer; devid: integer); external;
|
||||
|
||||
procedure copybuf(dest:^IOBuffer;destOffset:integer; src:^IOBuffer; srcOffset:integer; length: integer); external;
|
||||
function readfschar(var f:file):char; external;
|
||||
procedure writefschar(var f:file; aChar:char); external;
|
||||
procedure writefsstring(var f:file; var s:string); external;
|
||||
|
||||
procedure conoutw(w:integer); external;
|
||||
function coninw():integer; external;
|
||||
|
||||
procedure SetDefaultVolume(volname:volumenamestr); external;
|
||||
procedure addPartitions(devid:integer; var partblk:PartitionTableBlock; var isLast:boolean); external;
|
||||
procedure readPartitions(devid: integer); external;
|
||||
procedure initDevices; external;
|
||||
procedure readdevice(deviceId:integer;blockNo:integer;var buf:IOBlock; var error:integer); external;
|
||||
procedure writedevice(deviceId:integer;blockNo:integer;var buf:IOBlock; var error:integer); external;
|
||||
procedure readvolumeblks(volumeid:integer; destbuf:^iobuffer; blkno:integer; blkCount: integer; var error:integer);
|
||||
external;
|
||||
procedure writevolumeblks(volumeid:integer; srcbuf:^iobuffer; blkno:integer; blkCount: integer; var error:integer);
|
||||
external;
|
||||
function findvolume(name:string):integer; external;
|
||||
procedure openvolumeid(volid:integer); external;
|
||||
procedure closevolumeid(volid:integer); external;
|
||||
function IOResult(var fil:file):integer; external;
|
||||
function ErrorStr(err:integer):string; external;
|
||||
function eof(var fil:file):boolean; external;
|
||||
function eoln(var fil:file):boolean; external;
|
||||
procedure readfs(var fil:file; destbuf:^IOBuffer; len:integer); external;
|
||||
procedure flushfile(var fil:file); external;
|
||||
procedure seek(var fil:file; position:integer); external;
|
||||
function filepos(var fil:file):integer; external;
|
||||
function filesize(var fil:file):integer; external;
|
||||
procedure extendfile(var fil:file; newSize:integer); external;
|
||||
procedure writefs(var fil:file; srcbuf:^IOBuffer; len:integer); external;
|
||||
procedure close(var aFile:file); external;
|
||||
procedure readdirnext(volid:integer; var index:integer; var dirslot:DirectorySlot; var error:integer); external;
|
||||
procedure readdirfirst(volid:integer; var index:integer; var dirslot:DirectorySlot; var error:integer); external;
|
||||
function charpos(searchChar:char; var s:string):integer; external;
|
||||
procedure rename(oldname:filenamestr; newname:filenamestr; var error:integer); external;
|
||||
procedure erase(name:pathnamestr; var error:integer); external;
|
||||
function readchannel(var f:file):char; external;
|
||||
procedure writechannel(var f:file; aChar:char); external;
|
||||
function freadchar(var f:file):char; external;
|
||||
procedure fwritechar(aChar:char; var f:file); external;
|
||||
procedure fwritestring(var aString:string; var f:file; w:integer); external;
|
||||
procedure fwriteint(v:integer; var f:file; w:integer); external;
|
||||
procedure fwritereal(v:real; var f:file; w,d:integer); external;
|
||||
procedure pushback(var aFile:file; aChar:char); external;
|
||||
procedure skipeoln(var aFile:file); external;
|
||||
procedure fscanbuf(var aFile:file; mode: fscanmode; var buf:string); external;
|
||||
procedure freadint(var v:integer;var f:file); external;
|
||||
procedure freadreal(var v:real;var f:file); external;
|
||||
|
||||
procedure openchannel(name:filenamestr; var f:file; mode:filemode; var error:integer); external;
|
||||
procedure open(var f:file; name:pathnamestr; mode: filemode); external;
|
||||
procedure noecho(var f:file; noecho:boolean; var old:boolean); external;
|
||||
|
||||
procedure intstr(v:integer; fieldWith:integer; var rbuf:string);
|
||||
external;
|
||||
procedure realstr(x:real; w, d: integer; var s: string[30]); external;
|
||||
procedure intval(s:string; var value,code:integer); external;
|
||||
procedure realval(s:string; var value:real;var code:integer); external;
|
||||
function isdigit(aChar:char):boolean; external;
|
||||
function iswhite(aChar:char):boolean; external;
|
||||
|
||||
procedure halt; external;
|
||||
|
||||
function random:integer; external;
|
||||
procedure randomize; external;
|
||||
|
||||
(* from stdterm.inc *)
|
||||
procedure ClrScr; external;
|
||||
procedure ClrEol; external;
|
||||
procedure CrtInit; external;
|
||||
procedure GotoXY(x,y:integer); external;
|
||||
procedure InsLine; external;
|
||||
procedure DelLine; external;
|
||||
procedure GetCursorPos(var x,y:integer); external;
|
||||
procedure GetTermSize(var maxx,maxy:integer); external;
|
||||
procedure TextColor(col:integer); external;
|
||||
procedure TextBackground(bgcol:integer); external;
|
||||
procedure TextDefault; external;
|
||||
|
||||
procedure PTerm; external; (* from runtime.s *)
|
||||
procedure PExec(prgfile:pathnamestr; var args:PArgVec; argCount:integer;var error:integer); external;
|
||||
procedure PExec2(prgfile:pathnamestr; arg1:string; var error:integer); external;
|
||||
procedure PExec3(prgfile:pathnamestr; arg1, arg2:string; var error:integer); external;
|
||||
function ParamStr(i:integer):string; external;
|
||||
function ParamCount():integer; external;
|
||||
|
||||
procedure SetShellCmd(cmd:string[40];arg:integer); external;
|
||||
|
||||
function GetTime:DateTime; external;
|
||||
function TimeStr(d:DateTime;showSeconds:boolean):string; external;
|
||||
function DateStr(d:DateTime):string; external;
|
||||
function GetTimestamp(var d:DateTime):integer; external;
|
||||
function GetDateTime(ts:Timestamp):DateTime; external;
|
||||
procedure delay(ms:integer); external;
|
||||
2710
lib/stdlib.pas
Normal file
2710
lib/stdlib.pas
Normal file
File diff suppressed because it is too large
Load diff
57
lib/stdterm.inc
Normal file
57
lib/stdterm.inc
Normal file
|
|
@ -0,0 +1,57 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
procedure ClrScr;
|
||||
begin
|
||||
write(#27, '[2J');
|
||||
write(#27, '[H');
|
||||
end;
|
||||
|
||||
procedure ClrEol;
|
||||
begin
|
||||
write(#27, '[K');
|
||||
end;
|
||||
|
||||
procedure CrtInit;
|
||||
begin
|
||||
write(#27, 'c');
|
||||
end;
|
||||
|
||||
procedure GotoXY(x,y:integer);
|
||||
begin
|
||||
write(#27,'[', y, ';', x, 'H');
|
||||
end;
|
||||
|
||||
procedure InsLine;
|
||||
begin
|
||||
write(#27,'[L');
|
||||
end;
|
||||
|
||||
procedure DelLine;
|
||||
begin
|
||||
write(#27,'[M');
|
||||
end;
|
||||
|
||||
procedure GetCursorPos(var x,y:integer); external; (* from corelib.s *)
|
||||
|
||||
procedure GetTermSize(var maxx,maxy:integer);
|
||||
var x,y:integer;
|
||||
begin
|
||||
GetCursorPos(x,y);
|
||||
GotoXY(9999,9999);
|
||||
GetCursorPos(maxx,maxy);
|
||||
GotoXY(x,y);
|
||||
end;
|
||||
|
||||
procedure TextColor(col:integer);
|
||||
begin
|
||||
write(#27,'[38;5;',col,'m');
|
||||
end;
|
||||
|
||||
procedure TextBackground(bgcol:integer);
|
||||
begin
|
||||
write(#27,'[48;5;',bgcol,'m');
|
||||
end;
|
||||
|
||||
procedure TextDefault;
|
||||
begin
|
||||
write(#27,'[0m');
|
||||
end;
|
||||
17
pcomp/.vscode/tasks.json
vendored
Normal file
17
pcomp/.vscode/tasks.json
vendored
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
{
|
||||
// See https://go.microsoft.com/fwlink/?LinkId=733558
|
||||
// for the documentation about the tasks.json format
|
||||
"version": "2.0.0",
|
||||
"tasks": [
|
||||
{
|
||||
"label": "pcomp",
|
||||
"type": "shell",
|
||||
"command": "fpc -Mobjfpc -gl pcomp.pas",
|
||||
"problemMatcher": [],
|
||||
"group": {
|
||||
"kind": "build",
|
||||
"isDefault": true
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
1620
pcomp/emit.pas
Normal file
1620
pcomp/emit.pas
Normal file
File diff suppressed because it is too large
Load diff
95
pcomp/float32+.pas
Normal file
95
pcomp/float32+.pas
Normal file
|
|
@ -0,0 +1,95 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
function encodefloat32(r:real):integer;
|
||||
var intpart:real;
|
||||
fract: real;
|
||||
exponent:integer;
|
||||
sign:integer;
|
||||
i:integer;
|
||||
digit, bitpos:integer;
|
||||
intlength,fractlength:integer;
|
||||
intbin:integer;
|
||||
fractbin:integer;
|
||||
floatbin:integer;
|
||||
begin
|
||||
intbin := 0; fractbin := 0; floatbin := 0;
|
||||
|
||||
if r<0 then
|
||||
begin
|
||||
r := abs(r);
|
||||
sign := 1;
|
||||
end
|
||||
else
|
||||
sign := 0;
|
||||
|
||||
if r = 0.0 then
|
||||
begin
|
||||
intpart := 0.0;
|
||||
fract := 0.0;
|
||||
intlength := 0;
|
||||
fractlength := 0;
|
||||
intbin := 0;
|
||||
fractbin := 0;
|
||||
floatbin := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
intpart := r;
|
||||
fract := frac(r);
|
||||
exponent := floor(log2(intpart));
|
||||
|
||||
intlength := exponent+1;
|
||||
fractlength := wordbits - intlength - Float32ExpBits - 1;
|
||||
end;
|
||||
(* FIXME: log2 gives division by zero on zero arg *)
|
||||
|
||||
|
||||
(* process bits before the point *)
|
||||
for i := 1 to intlength do
|
||||
begin
|
||||
(* digit := round(intpart mod 2.0); *)
|
||||
(* calculate real remainder in a portable way *)
|
||||
digit := floor(intpart - 2 * Int(intpart / 2));
|
||||
|
||||
(* if we used up all the bits in the fraction part of
|
||||
the float32 encoding, shift everything right
|
||||
and put bit at the top *)
|
||||
if i > Float32FractBits then
|
||||
begin
|
||||
bitpos := Float32FractBits-1;
|
||||
intbin := intbin shr 1;
|
||||
end
|
||||
else
|
||||
bitpos := i - 1;
|
||||
|
||||
if digit > 0 then intbin := intbin + (1 << bitpos);
|
||||
|
||||
intpart := intpart / 2.0;
|
||||
end;
|
||||
|
||||
(* limit the integer bits *)
|
||||
if intlength > Float32FractBits then intlength := Float32FractBits;
|
||||
|
||||
(* process bits after the point, if we have any bits left *)
|
||||
if fractlength > 0 then
|
||||
begin
|
||||
for i := 1 to fractlength do
|
||||
begin
|
||||
fract := fract * 2;
|
||||
digit := trunc(fract) and 1;
|
||||
fractbin := (fractbin shl 1) + digit;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
floatbin := (intbin << (Float32FractBits - intlength)) + fractbin;
|
||||
|
||||
if floatbin = 0 then (* if mantissa is zero, return a clean zero value *)
|
||||
encodefloat32 := 0
|
||||
else
|
||||
begin
|
||||
exponent := exponent + Float32ExpBias;
|
||||
if (exponent > Float32ExpMax) or (exponent < 0) then
|
||||
errorExit2('float exponent overflow','');
|
||||
encodefloat32 := (sign shl (wordBits-1)) + (floatbin << Float32ExpBits) + exponent;
|
||||
end;
|
||||
end;
|
||||
2
pcomp/float32+tdr.pas
Normal file
2
pcomp/float32+tdr.pas
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
function encodefloat32(r:real):integer; external;
|
||||
304
pcomp/libgen.pas
Normal file
304
pcomp/libgen.pas
Normal file
|
|
@ -0,0 +1,304 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
program libgen;
|
||||
|
||||
const shortcutChar = '`';
|
||||
firstShCChar = 'A';
|
||||
lastShCChar = 'i';
|
||||
|
||||
OutfileSuffix = '.lib';
|
||||
|
||||
{$I 'platfile-types+.pas'}
|
||||
|
||||
type
|
||||
InsString = string[24];
|
||||
|
||||
var shortcuts:array [firstShCChar..lastShCChar] of InsString;
|
||||
infile:TextFile;
|
||||
outfile:TextFile;
|
||||
infileName:string;
|
||||
outfileName:string;
|
||||
lineCount:integer;
|
||||
|
||||
procedure errorExit2(reason:string;arg:string); forward;
|
||||
|
||||
{$I 'platfile+.pas'}
|
||||
|
||||
procedure errorExit2(reason:string;arg:string);
|
||||
begin
|
||||
writeln;
|
||||
writeln('Error: ', reason, ' ', arg);
|
||||
halt;
|
||||
end;
|
||||
|
||||
procedure addShortcut(ch:char; dest:InsString);
|
||||
begin
|
||||
shortcuts[ch] := dest;
|
||||
end;
|
||||
|
||||
function findShortcut(ins:InsString):char;
|
||||
var ch:char;
|
||||
begin
|
||||
findShortCut := #0;
|
||||
|
||||
for ch := firstShCChar to lastShCChar do
|
||||
begin
|
||||
if shortcuts[ch] = ins then
|
||||
begin
|
||||
findShortcut := ch;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
{ if findShortCut = #0 then writeln('findShortcut:#0'); }
|
||||
end;
|
||||
|
||||
procedure initShortcuts;
|
||||
begin
|
||||
addShortcut('A', 'ADD');
|
||||
addShortcut('B', 'BRANCH');
|
||||
addShortcut('C', 'CALL');
|
||||
addShortcut('D', 'DUP');
|
||||
addShortcut('E', 'LOADREL');
|
||||
addShortcut('F', 'LOAD');
|
||||
addShortcut('G', 'LOADREG');
|
||||
addShortcut('H', 'SHL');
|
||||
addShortcut('I', 'LOADI');
|
||||
addShortcut('J', 'JUMP');
|
||||
addShortcut('K', 'LOADC');
|
||||
addShortcut('L', 'LOADCP');
|
||||
addShortcut('M', 'STORE');
|
||||
addShortcut('N', 'NIP');
|
||||
addShortcut('O', 'OR');
|
||||
addShortcut('P', 'DROP');
|
||||
(* Q is unused *)
|
||||
addShortcut('R', 'RET');
|
||||
addShortcut('S', 'STOREI');
|
||||
addShortcut('T', 'NOT');
|
||||
addShortcut('U', 'CMPU');
|
||||
addShortcut('V', 'OVER');
|
||||
addShortcut('W', 'SWAP');
|
||||
addShortcut('X', 'XOR');
|
||||
(* Y is ununsed *)
|
||||
addShortcut('Z', 'SUB');
|
||||
addShortcut('a', 'AND');
|
||||
addShortcut('b', 'CBRANCH');
|
||||
addShortcut('c', 'CMP');
|
||||
addShortcut('d', 'DEC');
|
||||
(* e is unused *)
|
||||
addShortcut('f', 'FPADJ');
|
||||
addShortcut('g', 'STOREREG');
|
||||
addShortcut('h', 'SHR');
|
||||
addShortcut('i', 'INC');
|
||||
end;
|
||||
|
||||
procedure processLine(var linebuf:string);
|
||||
var labelEnd:integer;
|
||||
dotPos:integer;
|
||||
endPos:integer;
|
||||
insStart:integer;
|
||||
insEnd:integer;
|
||||
labelBuf:string;
|
||||
insBuf:string;
|
||||
restBuf:string;
|
||||
short:char;
|
||||
|
||||
procedure scanLine;
|
||||
var c:char;
|
||||
i:integer;
|
||||
begin
|
||||
labelEnd := 0;
|
||||
dotPos := 0;
|
||||
endPos := 0;
|
||||
insStart := 0;
|
||||
insEnd := 0;
|
||||
|
||||
i := 1;
|
||||
for c in linebuf do
|
||||
begin
|
||||
if (labelEnd = 0) and (c = ':') then
|
||||
begin
|
||||
insStart := 0;
|
||||
insEnd := 0;
|
||||
labelEnd := i;
|
||||
end
|
||||
else
|
||||
if (dotPos = 0) and (c = '.') then
|
||||
begin
|
||||
insEnd := i - 1;
|
||||
dotPos := i;
|
||||
end
|
||||
else
|
||||
if c = ';' then break
|
||||
else
|
||||
if c in [ ' ', #9 ] then
|
||||
begin
|
||||
if (insStart <> 0 ) and (insEnd = 0) then
|
||||
insEnd := i - 1;
|
||||
end
|
||||
else
|
||||
if c in [ '''', '"' ] then
|
||||
begin
|
||||
(* we do not want to deal with string quoting,
|
||||
so if we encounter some quotes,
|
||||
just do nothing *)
|
||||
insStart := 0;
|
||||
insEnd := 0;
|
||||
labelEnd := 0;
|
||||
endPos := length(linebuf);
|
||||
break;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if insStart = 0 then
|
||||
insStart := i;
|
||||
endPos := i;
|
||||
{ writeln('c:', c, ' i:', i, ' insStart:', insStart); }
|
||||
end;
|
||||
|
||||
i := i + 1;
|
||||
end;
|
||||
if insEnd = 0 then insEnd := endPos;
|
||||
end;
|
||||
|
||||
begin
|
||||
if length(linebuf) > 0 then
|
||||
if linebuf[1] <> '%' then
|
||||
begin
|
||||
scanLine;
|
||||
if labelEnd > 0 then
|
||||
labelBuf := copy(linebuf,1,labelEnd)
|
||||
else
|
||||
labelBuf := '';
|
||||
|
||||
if insStart > 0 then
|
||||
insBuf := copy(linebuf, insStart, insEnd - insStart + 1)
|
||||
else
|
||||
insBuf := '';
|
||||
|
||||
if endPos <> insEnd then
|
||||
restBuf := copy(linebuf, insEnd + 1, endPos - insEnd + 1)
|
||||
else
|
||||
restBuf := '';
|
||||
{
|
||||
writeln('ins ', insBuf);
|
||||
writeln('label ', labelBuf);
|
||||
writeln('rest ', restBuf);
|
||||
writeln('insStart ', insStart);
|
||||
writeln('insEnd ', insEnd);
|
||||
writeln('dotPos ', dotPos);
|
||||
writeln('endPos ', endPos);
|
||||
}
|
||||
short := #0;
|
||||
if length(insBuf) > 0 then
|
||||
begin
|
||||
(* if we found an instruction, try to find a shortcut *)
|
||||
short := findShortcut(insBuf);
|
||||
|
||||
if short <> #0 then
|
||||
writeln(outfile, labelBuf, '`', short, restBuf)
|
||||
else
|
||||
(* if no shortcut, we still remove comments and whitespace *)
|
||||
writeln(outfile, labelBuf, ' ', insBuf, restBuf);
|
||||
end
|
||||
else
|
||||
(* no instruction found, probably a directive, so
|
||||
no change *)
|
||||
writeln(outfile, linebuf);
|
||||
end
|
||||
else
|
||||
writeln(outfile, linebuf);
|
||||
end;
|
||||
|
||||
procedure processAllLines;
|
||||
var linebuf:string;
|
||||
begin
|
||||
while not eof(infile) do
|
||||
begin
|
||||
readln(infile, linebuf);
|
||||
lineCount := lineCount + 1;
|
||||
if (lineCount and 255) = 1 then
|
||||
write(lineCount, ' lines', #13);
|
||||
processLine(linebuf);
|
||||
end;
|
||||
writeln(lineCount, ' lines');
|
||||
end;
|
||||
|
||||
procedure test;
|
||||
var buf:string;
|
||||
begin
|
||||
outfile := output;
|
||||
|
||||
buf := 'LABEL: SOMEINS.MOD1.MOD2 ARG ; a comment';
|
||||
processLine(buf);
|
||||
buf := ' SOMEINS.MOD1.MOD2 ARG ; a comment';
|
||||
processLine(buf);
|
||||
buf := ' LOADCP 1';
|
||||
processLine(buf);
|
||||
buf := ' JUMP';
|
||||
processLine(buf);
|
||||
buf := 'LABEL: FPADJ -20';
|
||||
processLine(buf);
|
||||
buf := 'LABEL: .BYTE ":;123"';
|
||||
processLine(buf);
|
||||
buf := 'LABEL: .LCBRANCH SOMEWHERE';
|
||||
processLine(buf);
|
||||
buf := 'LABEL: LOADC '';''';
|
||||
processLine(buf);
|
||||
end;
|
||||
|
||||
function changeSuffix(var fname:string):string;
|
||||
var dotPos:integer;
|
||||
found:boolean;
|
||||
begin
|
||||
found := false;
|
||||
|
||||
for dotPos := length(fname) downto 1 do
|
||||
if fname[dotPos] = '.' then
|
||||
begin
|
||||
found := true;
|
||||
break;
|
||||
end;
|
||||
|
||||
if found then
|
||||
changeSuffix := copy(fname,1, dotPos - 1) + OutfileSuffix
|
||||
else
|
||||
changeSuffix := fname + OutfileSuffix;
|
||||
end;
|
||||
|
||||
begin
|
||||
initShortcuts;
|
||||
|
||||
{ test;
|
||||
halt; }
|
||||
|
||||
outfileName := '';
|
||||
|
||||
case ParamCount of
|
||||
0: begin
|
||||
write('Source file: ');
|
||||
readln(infileName);
|
||||
end;
|
||||
1: infileName := ParamStr(1);
|
||||
2: begin
|
||||
infileName := ParamStr(1);
|
||||
outfileName := ParamStr(2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
writeln('Invalid arguments.');
|
||||
halt;
|
||||
end;
|
||||
end;
|
||||
|
||||
if length(outfileName) = 0 then
|
||||
outfileName := changeSuffix(infileName);
|
||||
|
||||
writeln('Output file: ', outfileName);
|
||||
|
||||
openTextFile(infile, infileName);
|
||||
overwriteTextFile(outfile, outfileName);
|
||||
|
||||
processAllLines;
|
||||
|
||||
close(infile);
|
||||
close(outfile);
|
||||
end.
|
||||
111
pcomp/lsymgen.pas
Normal file
111
pcomp/lsymgen.pas
Normal file
|
|
@ -0,0 +1,111 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
program lsymgen;
|
||||
|
||||
const OutfileSuffix = '.lsym';
|
||||
|
||||
{$I 'platfile-types+.pas'}
|
||||
|
||||
var
|
||||
outfile:TextFile;
|
||||
infile:TextFile;
|
||||
lineno:integer;
|
||||
|
||||
procedure errorExit2(reason:string;arg:string); forward;
|
||||
|
||||
{$I 'platfile+.pas'}
|
||||
|
||||
procedure errorExit2(reason:string;arg:string);
|
||||
begin
|
||||
writeln;
|
||||
writeln('Error: ', reason, ' ', arg);
|
||||
writeln('at ', lineno);
|
||||
halt;
|
||||
end;
|
||||
|
||||
function rpos(c:char; var s:string):integer;
|
||||
var i:integer;
|
||||
begin
|
||||
for i := length(s) downto 1 do
|
||||
if s[i] = '.' then break;
|
||||
if i = 1 then
|
||||
rpos := 0
|
||||
else
|
||||
rpos := i;
|
||||
end;
|
||||
|
||||
function strcontains(var s:string; c:char):boolean;
|
||||
begin
|
||||
strcontains := pos(c, s) > 0;
|
||||
end;
|
||||
|
||||
function getOutfileName(infileName:string):string;
|
||||
var p:integer;
|
||||
begin
|
||||
p := rpos('.', infileName);
|
||||
if p > 1 then
|
||||
getOutfileName := copy(infileName, 1, p - 1)
|
||||
else
|
||||
getOutfileName := infileName;
|
||||
|
||||
getOutfileName := getOutfileName + OutfileSuffix;
|
||||
end;
|
||||
|
||||
procedure splitLine(var line:string; var addr:string; var name:string;
|
||||
var clean:boolean);
|
||||
var n,l:integer;
|
||||
begin
|
||||
n := pos(' ', line);
|
||||
|
||||
if n <= 1 then
|
||||
errorExit2('invalid syntax:', line);
|
||||
|
||||
addr := copy(line, 1, n - 1);
|
||||
|
||||
l := length(line);
|
||||
while (n < l) and (line[n] = ' ') do
|
||||
n := n + 1;
|
||||
|
||||
name := copy(line, n, l - n + 1);
|
||||
|
||||
|
||||
(* symbols starting with '!' are explicitly exported *)
|
||||
if name[1] = '!' then
|
||||
begin
|
||||
clean := true;
|
||||
name := copy(name, 2, length(name) - 1);
|
||||
end
|
||||
else
|
||||
clean := (not strcontains( name, '_')) and (name[1] <> '=');
|
||||
end;
|
||||
|
||||
procedure processFile(inpath,outpath:string);
|
||||
var line:string;
|
||||
addr,name:string;
|
||||
clean:boolean;
|
||||
begin
|
||||
lineno := 0;
|
||||
writeln('writing file ', outpath);
|
||||
|
||||
openTextFile(infile, inpath);
|
||||
|
||||
overwriteTextFile(outfile, outpath);
|
||||
|
||||
while not eof(infile) do
|
||||
begin
|
||||
readln(infile, line);
|
||||
splitLine(line, addr, name, clean);
|
||||
if clean then
|
||||
writeln(outfile, #9, '.EQU ', name, ' $', addr);
|
||||
end;
|
||||
close(infile);
|
||||
close(outfile);
|
||||
end;
|
||||
|
||||
begin
|
||||
if ParamCount > 0 then
|
||||
begin
|
||||
processFile(ParamStr(1), getOutfileName(ParamStr(1)));
|
||||
end
|
||||
else
|
||||
writeln('No file name given.');
|
||||
end.
|
||||
34
pcomp/make.bat
Normal file
34
pcomp/make.bat
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
fpc -Mobjfpc -gl pcomp.pas
|
||||
fpc -gl sasm.pas
|
||||
fpc -gl lsymgen.pas
|
||||
|
||||
sasm ..\lib\coreloader.s
|
||||
lsymgen ..\lib\coreloader.sym
|
||||
py pcomp.py -n stdlib.pas
|
||||
libgen ..\lib\stdlib.s
|
||||
libgen ..\lib\runtime.s
|
||||
libgen ..\lib\float32.s
|
||||
|
||||
py pcomp.py sasm.pas
|
||||
py pcomp.py pcomp.pas
|
||||
py pcomp.py lsymgen.pas
|
||||
py pcomp.py libgen.pas
|
||||
|
||||
rem exit /b
|
||||
|
||||
py pcomp.py ..\progs\shell.pas
|
||||
py pcomp.py ..\progs\editor.pas
|
||||
py pcomp.py ..\progs\reclaim.pas
|
||||
py pcomp.py ..\progs\dumpdir.pas
|
||||
py pcomp.py ..\progs\partmgr.pas
|
||||
py pcomp.py ..\progs\xfer.pas
|
||||
|
||||
rem exit /b
|
||||
|
||||
py pcomp.py ..\tests\readtest.pas
|
||||
py pcomp.py ..\tests\readchartest.pas
|
||||
py pcomp.py ..\tests\timetest.pas
|
||||
py pcomp.py ..\tests\test133.pas
|
||||
py pcomp.py ..\tests\chase.pas
|
||||
py pcomp.py ..\tests\cchangetest.pas
|
||||
py pcomp.py ..\tests\tree.pas
|
||||
6452
pcomp/pcomp.pas
Normal file
6452
pcomp/pcomp.pas
Normal file
File diff suppressed because it is too large
Load diff
102
pcomp/pcomp.py
Normal file
102
pcomp/pcomp.py
Normal file
|
|
@ -0,0 +1,102 @@
|
|||
#!/usr/bin/python3
|
||||
# vim: tabstop=8 expandtab shiftwidth=4 softtabstop=4
|
||||
# Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
|
||||
import sys
|
||||
import subprocess
|
||||
import os
|
||||
|
||||
suffixes = [ '.teeny', '.pas' ]
|
||||
compiler = 'pcomp'
|
||||
#assembler = '..\sasm\sasm.py'
|
||||
assembler = 'sasm'
|
||||
emulator = 's4emu.py'
|
||||
|
||||
asm_include_path = '../lib'
|
||||
|
||||
def run_compiler(filename, opts):
|
||||
print("compiling {}...".format(filename))
|
||||
args = [compiler]
|
||||
args.extend(opts)
|
||||
args.append(filename)
|
||||
#print("args:",args)
|
||||
status = subprocess.call(args)
|
||||
if status != 0:
|
||||
sys.exit(2)
|
||||
|
||||
|
||||
def run_assembler(filename):
|
||||
print("assembling {}...".format(filename))
|
||||
args = [assembler]
|
||||
# args.extend([ '-I', asm_include_path])
|
||||
args.append(filename)
|
||||
status = subprocess.call(args)
|
||||
if status != 0:
|
||||
sys.exit(3)
|
||||
|
||||
|
||||
def run_emulator(filename, extra_args):
|
||||
args = ['py', emulator, '-a', '24576', filename ]
|
||||
args.extend(extra_args)
|
||||
status = subprocess.call(args)
|
||||
if status != 0:
|
||||
sys.exit(4)
|
||||
|
||||
|
||||
def get_compiler_options():
|
||||
comp_options = [ "-n", "-s", "-e", "-R", "-S", "-H" ]
|
||||
result = []
|
||||
while len(sys.argv) > 1 and sys.argv[1] in comp_options:
|
||||
result.append(sys.argv[1])
|
||||
if sys.argv[1] == "-H":
|
||||
sys.argv.pop(1)
|
||||
result.append(sys.argv[1])
|
||||
sys.argv.pop(1)
|
||||
# print("Compiler options:",result, sys.argv[1])
|
||||
return result
|
||||
|
||||
|
||||
def main():
|
||||
do_compile = True
|
||||
do_assemble = True
|
||||
do_emulator = False
|
||||
if len(sys.argv) < 2:
|
||||
print("Usage: {} <input file>".format(sys.argv[0]))
|
||||
sys.exit(1)
|
||||
|
||||
compiler_options = get_compiler_options()
|
||||
infilename = sys.argv[1]
|
||||
basename = infilename
|
||||
|
||||
if infilename.endswith('.s'):
|
||||
do_compile = False
|
||||
basename = infilename[:-2]
|
||||
elif infilename.endswith('.bin') or infilename.endswith('.prog'):
|
||||
do_compile = False
|
||||
do_assemble = False
|
||||
do_emulator = True
|
||||
basename = infilename[:-4]
|
||||
else:
|
||||
fname, suffix = os.path.splitext(infilename)
|
||||
if suffix in suffixes:
|
||||
print("#############",fname, "####",suffix)
|
||||
basename = fname
|
||||
|
||||
asmfilename = basename + '.s'
|
||||
#binfilename = basename + '.bin'
|
||||
binfilename = basename + '.prog'
|
||||
|
||||
if "-n" in compiler_options:
|
||||
# Assembling stdlib won't work
|
||||
do_assemble = False
|
||||
do_emulator = False
|
||||
|
||||
if do_compile:
|
||||
run_compiler(infilename, compiler_options)
|
||||
if do_assemble:
|
||||
run_assembler(asmfilename)
|
||||
if do_emulator:
|
||||
run_emulator(binfilename, sys.argv[2:])
|
||||
|
||||
if __name__ == '__main__':
|
||||
main()
|
||||
17
pcomp/platfile+.pas
Normal file
17
pcomp/platfile+.pas
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
procedure openTextFile(var f:TextFile; filename:string);
|
||||
begin
|
||||
{$I-}
|
||||
assign(f, filename);
|
||||
reset(f);
|
||||
|
||||
if IOResult <> 0 then
|
||||
errorExit2('cannot open file', filename);
|
||||
{$I+}
|
||||
end;
|
||||
|
||||
procedure overwriteTextFile(var f:TextFile; filename:string);
|
||||
begin
|
||||
assign(f, filename);
|
||||
rewrite(f);
|
||||
end;
|
||||
12
pcomp/platfile+tdr.pas
Normal file
12
pcomp/platfile+tdr.pas
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
procedure openTextFile(var f:TextFile; filename:string);
|
||||
begin
|
||||
open(f, filename, ModeReadOnly);
|
||||
if IOResult(f) <> 0 then
|
||||
errorExit2('cannot open file', filename);
|
||||
end;
|
||||
|
||||
procedure overwriteTextFile(var f:TextFile; filename:string);
|
||||
begin
|
||||
open(f, filename, ModeOverwrite);
|
||||
end;
|
||||
2
pcomp/platfile-types+.pas
Normal file
2
pcomp/platfile-types+.pas
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
type TextFile = text;
|
||||
2
pcomp/platfile-types+tdr.pas
Normal file
2
pcomp/platfile-types+tdr.pas
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
type TextFile = file;
|
||||
53
pcomp/platform+.pas
Normal file
53
pcomp/platform+.pas
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
procedure initPlatform;
|
||||
begin
|
||||
outputPrefix := '';
|
||||
includePrefix := '..\lib\';
|
||||
end;
|
||||
|
||||
procedure newString(var s:StringRef;len:integer);
|
||||
begin
|
||||
new(s);
|
||||
end;
|
||||
|
||||
procedure openFileWithDefault(var f:InputFileType; filename:string);
|
||||
begin
|
||||
{$I-}
|
||||
assign(f, filename);
|
||||
reset(f);
|
||||
|
||||
if IOResult <> 0 then
|
||||
begin
|
||||
assign(f, includePrefix + '/' + filename);
|
||||
reset(f);
|
||||
if IOResult <> 0 then
|
||||
errorExit2('cannot open file', filename);
|
||||
end;
|
||||
{$I+}
|
||||
end;
|
||||
|
||||
procedure overwriteFile(var f:OutputFileType; filename:string);
|
||||
begin
|
||||
assign(f, outputPrefix + filename);
|
||||
rewrite(f);
|
||||
end;
|
||||
|
||||
function isdigit(aChar:char):boolean;
|
||||
begin
|
||||
isdigit := (ord(aChar) >= ord('0')) and (ord(aChar) <= ord('9'));
|
||||
end;
|
||||
|
||||
procedure ExecEditor(var filename:string; lineno:integer; errormsg:string);
|
||||
begin
|
||||
halt;
|
||||
end;
|
||||
|
||||
procedure ExecAssembler(var filename:string; doRun:boolean; editOnError:boolean);
|
||||
begin
|
||||
halt;
|
||||
end;
|
||||
|
||||
procedure ExecProgram(var filename:string);
|
||||
begin
|
||||
halt;
|
||||
end;
|
||||
76
pcomp/platform+tdr.pas
Normal file
76
pcomp/platform+tdr.pas
Normal file
|
|
@ -0,0 +1,76 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
procedure initPlatform;
|
||||
begin
|
||||
outputPrefix := '';
|
||||
includePrefix := '#SYSTEM:';
|
||||
end;
|
||||
|
||||
procedure newString(var s:StringRef;len:integer);
|
||||
begin
|
||||
new(s,len);
|
||||
end;
|
||||
|
||||
procedure openFileWithDefault(var f:InputFileType; filename:string);
|
||||
begin
|
||||
open(f, filename, ModeReadOnly);
|
||||
if IOResult(f) <> 0 then
|
||||
begin
|
||||
open(f, includePrefix + filename, ModeReadOnly);
|
||||
if IOResult(f) <> 0 then
|
||||
errorExit2('cannot open file', filename);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure overwriteFile(var f:OutputFileType; filename:string);
|
||||
begin
|
||||
open(f, outputPrefix + filename, ModeOverwrite);
|
||||
end;
|
||||
|
||||
procedure printExecErr(filename:string; error:integer);
|
||||
begin
|
||||
writeln('PExec failed for ', filename, ': ', ErrorStr(error));
|
||||
end;
|
||||
|
||||
procedure ExecEditor(var filename:string; lineno:integer; errormsg:string);
|
||||
var args:PArgVec;
|
||||
error:integer;
|
||||
digits:string[12];
|
||||
begin
|
||||
str(lineno, digits);
|
||||
args[0] := '-l'; args[1] := digits;
|
||||
args[2] := '-E'; args[3] := errormsg;
|
||||
args[4] := filename;
|
||||
PExec('#SYSTEM:editor.prog', args, 5, error);
|
||||
printExecErr('#SYSTEM:editor.prog', error);
|
||||
end;
|
||||
|
||||
procedure ExecAssembler(var filename:string; doRun:boolean; editOnError:boolean);
|
||||
var args:PArgVec;
|
||||
argPos:integer;
|
||||
error:integer;
|
||||
begin
|
||||
if doRun then
|
||||
begin
|
||||
args[0] := '-R';
|
||||
argPos := 1;
|
||||
end
|
||||
else
|
||||
argPos := 0;
|
||||
if editOnError then
|
||||
begin
|
||||
args[argPos] := '-e';
|
||||
argPos := argPos + 1;
|
||||
end;
|
||||
args[argPos] := filename;
|
||||
PExec('#SYSTEM:sasm.prog', args, argPos + 1, error);
|
||||
printExecErr('#SYSTEM:editor.prog', error);
|
||||
end;
|
||||
|
||||
procedure ExecProgram(var filename:string);
|
||||
var args:PArgVec;
|
||||
error:integer;
|
||||
begin
|
||||
writeln('Running ', filename, '...');
|
||||
PExec(filename, args, 0, error);
|
||||
printExecErr(filename, error);
|
||||
end;
|
||||
7
pcomp/platform-types+.pas
Normal file
7
pcomp/platform-types+.pas
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
type
|
||||
OutputFileType = text;
|
||||
InputFileType = file of char;
|
||||
SymFileType = text;
|
||||
|
||||
ExecAction = (Edit, Assemble, Run);
|
||||
6
pcomp/platform-types+tdr.pas
Normal file
6
pcomp/platform-types+tdr.pas
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
OutputFileType = file;
|
||||
InputFileType = file;
|
||||
SymFileType = file;
|
||||
|
||||
ExecAction = (Edit, Assemble, Run);
|
||||
2650
pcomp/sasm.pas
Normal file
2650
pcomp/sasm.pas
Normal file
File diff suppressed because it is too large
Load diff
884
pcomp/sdis.pas
Normal file
884
pcomp/sdis.pas
Normal file
|
|
@ -0,0 +1,884 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
program sdis;
|
||||
{$R+}
|
||||
{$MODE objfpc}
|
||||
type
|
||||
InputFileType = file of char;
|
||||
OutputFileType = text;
|
||||
|
||||
KeywordString = string[128];
|
||||
IdentString = string[80];
|
||||
|
||||
SymbolType = (ConstSymbol, LabelSymbol, SpecialSymbol);
|
||||
|
||||
|
||||
Symbol = record
|
||||
name:KeywordString;
|
||||
value:integer;
|
||||
typ:SymbolType;
|
||||
end;
|
||||
|
||||
HashEntry = record
|
||||
key:integer;
|
||||
data:IdentString;
|
||||
next:^HashEntry;
|
||||
end;
|
||||
|
||||
HashRef = ^HashEntry;
|
||||
HashBucket = ^HashEntry;
|
||||
HashTable = array [0..255] of HashBucket;
|
||||
|
||||
var infile:InputfileType;
|
||||
filename:string;
|
||||
pc:integer;
|
||||
symbolTable: HashTable;
|
||||
|
||||
procedure errorExit;
|
||||
begin
|
||||
close(infile);
|
||||
halt;
|
||||
end;
|
||||
|
||||
procedure errorExit2(message1, message2: string);
|
||||
begin
|
||||
writeln;
|
||||
writeln('Error: ', message1, ' ', message2);
|
||||
errorExit;
|
||||
end;
|
||||
|
||||
procedure openFile(var f:InputFileType;var filename:string);
|
||||
begin
|
||||
{$I-}
|
||||
assign(f, filename);
|
||||
reset(f);
|
||||
|
||||
if IOResult <> 0 then
|
||||
errorExit2('cannot open file ', filename);
|
||||
{$I+}
|
||||
end;
|
||||
|
||||
function readChar:char;
|
||||
var c:char;
|
||||
begin
|
||||
read(infile,c);
|
||||
readChar := c;
|
||||
end;
|
||||
|
||||
procedure readEol;
|
||||
var c:char;
|
||||
begin
|
||||
c := readChar;
|
||||
if c = #13 then
|
||||
begin
|
||||
c := readChar;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function readBin(len:integer):integer;
|
||||
var i,v:integer;
|
||||
c:char;
|
||||
begin
|
||||
v := 0;
|
||||
for i := 1 to len do
|
||||
begin
|
||||
c := readChar;
|
||||
v := v shl 8;
|
||||
v := v or ord(c);
|
||||
end;
|
||||
readBin := v;
|
||||
end;
|
||||
|
||||
function readAsciiBin(len:integer):integer;
|
||||
var i:integer;
|
||||
w:integer;
|
||||
c:char;
|
||||
bits:integer;
|
||||
begin
|
||||
bits := len * 8;
|
||||
w := 0;
|
||||
for i := 1 to bits do
|
||||
begin
|
||||
w := w shl 1;
|
||||
c := readChar;
|
||||
if c = '1' then
|
||||
w := w or 1
|
||||
else
|
||||
if c = '0' then begin end;
|
||||
end;
|
||||
readAsciiBin := w;
|
||||
|
||||
(* read end of line *)
|
||||
if (pc and 3) = 2 then
|
||||
readEol;
|
||||
end;
|
||||
|
||||
function readBytes(len:integer):integer;
|
||||
var w:integer;
|
||||
c:char;
|
||||
i:integer;
|
||||
begin
|
||||
w := 0;
|
||||
for i := 1 to len do
|
||||
begin
|
||||
read(infile, c);
|
||||
w := (w shl 8) or ord(c);
|
||||
end;
|
||||
|
||||
readBytes := w;
|
||||
writeln('readBytes ',len, ': ', w);
|
||||
end;
|
||||
|
||||
function readInstruction:integer;
|
||||
begin
|
||||
(* readInstruction := readBytes(2); *)
|
||||
readInstruction := readBin(2);
|
||||
end;
|
||||
|
||||
function readWord:integer;
|
||||
begin
|
||||
readWord := readBin(4);
|
||||
end;
|
||||
|
||||
function convertHex(var digits:KeywordString):integer;
|
||||
var i,v,len:integer;
|
||||
c:char;
|
||||
begin
|
||||
len := length(digits);
|
||||
|
||||
i := 1;
|
||||
convertHex := 0;
|
||||
|
||||
while i <= len do
|
||||
begin
|
||||
convertHex := convertHex shl 4;
|
||||
c := UpCase(digits[i]);
|
||||
if (c >= 'A') and (c <= 'F') then
|
||||
v := ord(c) - ord('A') + 10
|
||||
else
|
||||
if (c >= '0') and (c <= '9') then
|
||||
v := ord(c) - ord('0')
|
||||
else
|
||||
errorExit2('invalid number',digits);
|
||||
convertHex := convertHex + v;
|
||||
i := i + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure hexstr(value:integer;var output:string);
|
||||
var i:integer;
|
||||
nibble:integer;
|
||||
c:char;
|
||||
begin
|
||||
output := '00000000';
|
||||
|
||||
for i := 8 downto 1 do
|
||||
begin
|
||||
nibble := value and $F;
|
||||
if nibble > 9 then
|
||||
c := chr( ord('A') + nibble - 10)
|
||||
else
|
||||
c := chr( ord('0') + nibble);
|
||||
|
||||
output[i] := c;
|
||||
value := value shr 4;
|
||||
if value = 0 then break;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure writeHex(value:integer);
|
||||
var s:string;
|
||||
begin
|
||||
hexstr(value,s);
|
||||
write('$',s);
|
||||
end;
|
||||
|
||||
procedure printAsciiWord(w:integer);
|
||||
var i:integer;
|
||||
c:char;
|
||||
begin
|
||||
write('"');
|
||||
for i := 1 to 4 do
|
||||
begin
|
||||
c := chr(((w shr 24) and $FF));
|
||||
w := w shl 8;
|
||||
if (c < ' ') or (c > '~') then
|
||||
c := '.';
|
||||
write(c);
|
||||
end;
|
||||
write('"');
|
||||
end;
|
||||
|
||||
|
||||
{$R-}
|
||||
(* disable range checks for 32-bit hash functions *)
|
||||
|
||||
(* hash a 32-bit integer into an 8-bit integer *)
|
||||
function hashint(value:integer):integer;
|
||||
var i:integer;
|
||||
begin
|
||||
hashint := 0;
|
||||
value := value xor $B298AB49; (* some random 32-bit constant *)
|
||||
for i := 1 to 4 do
|
||||
begin
|
||||
hashint := hashint xor (value and $FF);
|
||||
value := value shr 8;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$R+}
|
||||
|
||||
procedure putHashed(var t:HashTable;key:integer;var data:KeywordString);
|
||||
var i:integer;
|
||||
newEntry:^HashEntry;
|
||||
bucket:HashBucket;
|
||||
begin
|
||||
new(newEntry);
|
||||
newEntry^.data := data;
|
||||
newEntry^.key := key;
|
||||
|
||||
i := hashint(key);
|
||||
bucket := t[i];
|
||||
newEntry^.next := bucket;
|
||||
t[i] := newEntry;
|
||||
end;
|
||||
|
||||
function getHashed(var t:HashTable;key:integer):HashRef;
|
||||
var bucket:HashBucket;
|
||||
current:^HashEntry;
|
||||
found:boolean;
|
||||
begin
|
||||
getHashed := nil;
|
||||
bucket := t[hashint(key)];
|
||||
current := bucket;
|
||||
found := false;
|
||||
|
||||
while (current <> nil) and not found do
|
||||
begin
|
||||
if current^.key = key then
|
||||
begin
|
||||
getHashed := current;
|
||||
found := true;
|
||||
end;
|
||||
current := current^.next;
|
||||
end;
|
||||
end;
|
||||
|
||||
function getHashBucket(var t:HashTable;key:integer):HashRef;
|
||||
begin
|
||||
getHashBucket := t[hashint(key)];
|
||||
end;
|
||||
|
||||
procedure dumpHash(var t:HashTable);
|
||||
var i:integer;
|
||||
bucket:HashBucket;
|
||||
current:HashRef;
|
||||
begin
|
||||
for i := 0 to 255 do
|
||||
begin
|
||||
write('bucket ',i:4, ' ');
|
||||
bucket := t[i];
|
||||
current := bucket;
|
||||
while current <> nil do
|
||||
begin
|
||||
write(current^.key, ':', current^.data, ' ');
|
||||
current := current^.next;
|
||||
end;
|
||||
writeln;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure printEol;
|
||||
begin
|
||||
writeln;
|
||||
end;
|
||||
|
||||
procedure printHex(value:integer);
|
||||
var s:string[8];
|
||||
begin
|
||||
write('$');
|
||||
hexstr(value, s);
|
||||
write(s);
|
||||
end;
|
||||
|
||||
procedure printOperand(operand:integer);
|
||||
var sym:HashRef;
|
||||
begin
|
||||
sym := getHashed(symbolTable, operand);
|
||||
if sym <> nil then
|
||||
begin
|
||||
write(sym^.data);
|
||||
write(' ; ');
|
||||
end;
|
||||
|
||||
printHex(operand);
|
||||
end;
|
||||
|
||||
procedure printSpacedOperand(operand:integer);
|
||||
begin
|
||||
write(' ');
|
||||
printOperand(operand);
|
||||
end;
|
||||
|
||||
(* operates on numbers with less than 32 bits, signmask indicates the
|
||||
highest bit which is the sign *)
|
||||
function makepositive(operand, signmask:integer):integer;
|
||||
begin
|
||||
if (operand and signmask) <> 0 then
|
||||
makepositive := signmask - (operand and (not signmask))
|
||||
else
|
||||
makepositive := operand;
|
||||
end;
|
||||
|
||||
function signExtend(operand, signmask:integer):integer;
|
||||
begin
|
||||
if (operand and signmask) <> 0 then
|
||||
signExtend := -(signmask - (operand and (not signmask)))
|
||||
else
|
||||
signExtend := operand;
|
||||
end;
|
||||
|
||||
procedure printSignedOperand(operand, signmask:integer);
|
||||
var sym:HashRef;
|
||||
begin
|
||||
write(' ');
|
||||
sym := getHashed(symbolTable, operand);
|
||||
if sym <> nil then
|
||||
write(sym^.data)
|
||||
else
|
||||
begin
|
||||
if operand and signmask <> 0 then
|
||||
begin
|
||||
write('-');
|
||||
operand := makepositive(operand, signmask);
|
||||
end;
|
||||
printHex(operand);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure decodeBranch(operand:integer);
|
||||
begin
|
||||
write('BRANCH');
|
||||
printSpacedOperand(pc + signExtend(operand, $1000));
|
||||
end;
|
||||
|
||||
procedure decodeCbranch(operand:integer);
|
||||
begin
|
||||
write('CBRANCH');
|
||||
if (operand and 1) = 1 then
|
||||
write('.NZ')
|
||||
else
|
||||
write('.Z');
|
||||
|
||||
printSpacedOperand(pc + signExtend((operand and $FFFE), $100));
|
||||
end;
|
||||
|
||||
|
||||
procedure decodeLoadc(operand:integer);
|
||||
begin
|
||||
write('LOADC');
|
||||
printSignedOperand(operand, $1000);
|
||||
end;
|
||||
|
||||
procedure decodeLoadStore(name:string; operand:integer);
|
||||
begin
|
||||
write(name);
|
||||
if (operand and 1) = 1 then
|
||||
write('.B');
|
||||
|
||||
printSpacedOperand(operand and $FFFE);
|
||||
end;
|
||||
|
||||
procedure decodeModifier(name:string;value, mask:integer; operand:integer; visible:boolean);
|
||||
begin
|
||||
if (operand and mask) = value then
|
||||
if visible then
|
||||
write('.',name);
|
||||
end;
|
||||
|
||||
procedure decodeXfer(operand:integer);
|
||||
begin
|
||||
write('XFER');
|
||||
decodeModifier('RSM1', $0300, $0300, operand, true);
|
||||
decodeModifier('RS0', $0000, $0300, operand, false);
|
||||
decodeModifier('RS1', $0100, $0300, operand, true);
|
||||
decodeModifier('R2P', $0080, $0080, operand, true);
|
||||
decodeModifier('P2R', $0040, $0040, operand, true);
|
||||
decodeModifier('SM1', $0030, $0030, operand, true);
|
||||
decodeModifier('S0', $0000, $0030, operand, false);
|
||||
decodeModifier('S1', $0010, $0030, operand, true);
|
||||
decodeModifier('X2P', $0001, $0001, operand, true);
|
||||
end;
|
||||
|
||||
procedure printCmpOperand(operand:integer);
|
||||
begin
|
||||
case operand of
|
||||
2: write('EQ');
|
||||
6: write('NE');
|
||||
1: write('LT');
|
||||
3: write('LE');
|
||||
5: write('GE');
|
||||
7: write('GT');
|
||||
else write('<unknown:',operand,'>');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure decodeAlu(operand:integer);
|
||||
var aluop:integer;
|
||||
begin
|
||||
write('ALU');
|
||||
decodeModifier('ADD', $0000, $1e00, operand, true);
|
||||
decodeModifier('SUB', $0200, $1e00, operand, true);
|
||||
decodeModifier('NOT', $0400, $1e00, operand, true);
|
||||
decodeModifier('AND', $0600, $1e00, operand, true);
|
||||
decodeModifier('OR', $0800, $1e00, operand, true);
|
||||
decodeModifier('XOR', $0a00, $1e00, operand, true);
|
||||
decodeModifier('CMP', $0c00, $1e00, operand, true);
|
||||
decodeModifier('Y', $0e00, $1e00, operand, true);
|
||||
decodeModifier('SHR', $1000, $1e00, operand, true);
|
||||
decodeModifier('SHL', $1200, $1e00, operand, true);
|
||||
decodeModifier('INC', $1400, $1e00, operand, true);
|
||||
decodeModifier('DEC', $1600, $1e00, operand, true);
|
||||
decodeModifier('BPLC', $1a00, $1e00, operand, true);
|
||||
decodeModifier('BROT', $1c00, $1e00, operand, true);
|
||||
decodeModifier('BSEL', $1e00, $1e00, operand, true);
|
||||
decodeModifier('CMPU', $1800, $1e00, operand, true);
|
||||
|
||||
decodeModifier('SM1', $0030, $0030, operand, true);
|
||||
decodeModifier('S0', $0000, $0030, operand, false);
|
||||
decodeModifier('S1', $0010, $0030, operand, true);
|
||||
decodeModifier('X2Y', $0040, $0040, operand, true);
|
||||
decodeModifier('NX2Y', $0000, $0040, operand, false);
|
||||
decodeModifier('XT', $0080, $0080, operand, true);
|
||||
|
||||
aluop := operand and $1e00;
|
||||
operand := operand and 15;
|
||||
|
||||
if (aluop = $1800) or (aluop = $0c00) then
|
||||
begin
|
||||
write(' ');
|
||||
printCmpOperand(operand);
|
||||
end
|
||||
else
|
||||
if operand > 0 then
|
||||
printSpacedOperand(operand);
|
||||
end;
|
||||
|
||||
procedure decodeLoadrel(offset:integer);
|
||||
begin
|
||||
write('LOADREL');
|
||||
printSpacedOperand(pc + offset);
|
||||
end;
|
||||
|
||||
procedure decodeMem(operand:integer);
|
||||
begin
|
||||
if (operand and $0200) <> 0 then
|
||||
begin
|
||||
write('STOREI');
|
||||
decodeModifier('SM1', $0030, $0030, operand, false);
|
||||
decodeModifier('S0', $0000, $0030, operand, true);
|
||||
decodeModifier('S1', $0010, $0030, operand, true);
|
||||
decodeModifier('X2Y', $0040, $0040, operand, true);
|
||||
decodeModifier('NX2Y', $0000, $0040, operand, false);
|
||||
decodeModifier('XT', $0080, $0080, operand, true);
|
||||
end
|
||||
else
|
||||
begin
|
||||
write('LOADI');
|
||||
decodeModifier('SM1', $0030, $0030, operand, true);
|
||||
decodeModifier('S0', $0000, $0030, operand, false);
|
||||
decodeModifier('S1', $0010, $0030, operand, true);
|
||||
decodeModifier('X2Y', $0040, $0040, operand, true);
|
||||
decodeModifier('NX2Y', $0000, $0040, operand, false);
|
||||
decodeModifier('XT', $0080, $0080, operand, true);
|
||||
end;
|
||||
operand := operand and 15;
|
||||
if operand > 0 then
|
||||
printSpacedOperand(operand);
|
||||
end;
|
||||
|
||||
procedure printRegOperand(operand:integer);
|
||||
begin
|
||||
case operand of
|
||||
0: write('FP');
|
||||
1: write('BP');
|
||||
2: write('RP');
|
||||
3: write('IV');
|
||||
4: write('IR');
|
||||
5: write('ESP');
|
||||
else write('<unknown:',operand,'>');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure decodeReg(operand:integer);
|
||||
begin
|
||||
if (operand and $0200) <> 0 then
|
||||
write('STOREREG ')
|
||||
else
|
||||
write('LOADREG ');
|
||||
|
||||
operand := operand and 15;
|
||||
printRegOperand(operand);
|
||||
end;
|
||||
|
||||
procedure decodeExt(operand:integer);
|
||||
var extop:integer;
|
||||
begin
|
||||
extop := (operand and $1C00) shr 10;
|
||||
|
||||
if extop = 0 then
|
||||
decodeReg(operand)
|
||||
else
|
||||
if extop = 1 then
|
||||
decodeMem(operand)
|
||||
(*
|
||||
else
|
||||
if extop = 2 then
|
||||
begin
|
||||
{ unused }
|
||||
end *)
|
||||
else
|
||||
if extop = 3 then
|
||||
begin
|
||||
write('FPADJ ');
|
||||
printSignedOperand(operand and $03FF, $200);
|
||||
end
|
||||
else
|
||||
if extop = 5 then
|
||||
decodeLoadrel(operand and $03FF)
|
||||
else
|
||||
write('<EXT unknown:', extop,'>');
|
||||
end;
|
||||
|
||||
procedure decodeInstruction(w:integer);
|
||||
var baseIns:integer;
|
||||
baseOperand:integer;
|
||||
begin
|
||||
baseIns := (w and $E000) shr 13;
|
||||
baseOperand := (w and $1FFF);
|
||||
|
||||
(* writeln(baseIns, ' ', baseOperand); *)
|
||||
|
||||
if baseIns = 0 then
|
||||
decodeBranch(baseOperand)
|
||||
else
|
||||
if baseIns = 1 then
|
||||
decodeAlu(baseOperand)
|
||||
else
|
||||
if baseIns = 2 then
|
||||
decodeLoadStore('STORE', baseOperand)
|
||||
else
|
||||
if baseIns = 3 then
|
||||
decodeXfer(baseOperand)
|
||||
else
|
||||
if baseIns = 4 then
|
||||
decodeLoadStore('LOAD', baseOperand)
|
||||
else
|
||||
if baseIns = 5 then
|
||||
decodeCbranch(baseOperand)
|
||||
else
|
||||
if baseIns = 6 then
|
||||
decodeLoadc(baseOperand)
|
||||
else
|
||||
if baseIns = 7 then
|
||||
decodeExt(baseOperand)
|
||||
else
|
||||
write('???');
|
||||
|
||||
pc := pc + 2;
|
||||
|
||||
(* write(' (', baseIns, ')');
|
||||
writeHex(w); *)
|
||||
|
||||
printEol;
|
||||
end;
|
||||
|
||||
function isConstantPool(sym:HashRef):boolean;
|
||||
begin
|
||||
isConstantPool := false;
|
||||
|
||||
if sym <> nil then
|
||||
begin
|
||||
if length(sym^.data) >= 4 then
|
||||
isConstantPool :=
|
||||
(sym^.data[1] = '_') and
|
||||
(sym^.data[2] = 'C') and
|
||||
(sym^.data[3] = 'P') and
|
||||
(sym^.data[4] = '_');
|
||||
end;
|
||||
end;
|
||||
|
||||
function isStringConstant(sym:HashRef):boolean;
|
||||
begin
|
||||
isStringConstant := false;
|
||||
|
||||
if sym <> nil then
|
||||
begin
|
||||
if length(sym^.data) >= 5 then
|
||||
isStringConstant :=
|
||||
(sym^.data[1] = '_') and
|
||||
(sym^.data[2] = 'C') and
|
||||
(sym^.data[3] = '_') and
|
||||
(sym^.data[4] = 'S') and
|
||||
(sym^.data[5] = '_');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure decodeIntConstant(upperHalf:integer);
|
||||
var lowerHalf:integer;
|
||||
w:integer;
|
||||
begin
|
||||
{$R-}
|
||||
pc := pc + 2;
|
||||
(* need to increment pc in two steps
|
||||
because readBin uses the pc to detect line endings
|
||||
(which is probably a bad idea *)
|
||||
|
||||
lowerHalf := readInstruction;
|
||||
w := (upperHalf shl 16) or lowerHalf;
|
||||
|
||||
pc := pc + 2;
|
||||
|
||||
write('.WORD ');
|
||||
printOperand(w);
|
||||
writeln;
|
||||
|
||||
{$R+}
|
||||
end;
|
||||
|
||||
procedure printPaddedLabel(sym:HashRef); forward;
|
||||
procedure printPc; forward;
|
||||
|
||||
procedure printLeadin;
|
||||
begin
|
||||
printPc;
|
||||
printPaddedLabel(nil);
|
||||
end;
|
||||
|
||||
procedure decodeString(upperHalf:integer);
|
||||
var lowerHalf:integer;
|
||||
curLength,maxLength:integer;
|
||||
i,wordCount:integer;
|
||||
w:integer;
|
||||
begin
|
||||
pc := pc + 2;
|
||||
lowerHalf := readInstruction;
|
||||
pc := pc + 2;
|
||||
curLength := (upperHalf shl 16) or lowerHalf;
|
||||
maxLength := readWord;
|
||||
|
||||
write('.WORD ');
|
||||
printHex(curLength);
|
||||
writeln;
|
||||
|
||||
printLeadin;
|
||||
write('.WORD ');
|
||||
printHex(maxLength);
|
||||
writeln;
|
||||
pc := pc + 4;
|
||||
|
||||
wordCount := curLength;
|
||||
if maxLength > curLength then
|
||||
wordCount := maxLength;
|
||||
|
||||
wordCount := (wordCount + 3) shr 2;
|
||||
|
||||
for i := 1 to wordCount do
|
||||
begin
|
||||
w := readWord;
|
||||
printLeadin;
|
||||
write('.BYTE ');
|
||||
printAsciiWord(w);
|
||||
writeln;
|
||||
pc := pc + 4;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure printPaddedLabel(sym:HashRef);
|
||||
var pad:integer;
|
||||
begin
|
||||
pad := 24;
|
||||
if sym <> nil then
|
||||
begin
|
||||
write(sym^.data);
|
||||
write(':');
|
||||
|
||||
pad := pad - length(sym^.data) - 1;
|
||||
end;
|
||||
|
||||
while pad > 0 do
|
||||
begin
|
||||
write(' ');
|
||||
pad := pad - 1;
|
||||
end;
|
||||
write(' ');
|
||||
end;
|
||||
|
||||
procedure printPc;
|
||||
var hexaddr:string[8];
|
||||
begin
|
||||
hexstr(pc, hexaddr);
|
||||
write(hexaddr, ' ');
|
||||
end;
|
||||
|
||||
procedure printLabels(adr:integer);
|
||||
var bucket:HashBucket;
|
||||
current:HashRef;
|
||||
first:boolean;
|
||||
begin
|
||||
(* there can be multiple labels
|
||||
at an instruction address,
|
||||
so go through all elements
|
||||
in the corresponding hash bucket *)
|
||||
first := true;
|
||||
bucket := getHashBucket(symbolTable, adr);
|
||||
current := bucket;
|
||||
while current <> nil do
|
||||
begin
|
||||
if current^.key = adr then
|
||||
begin
|
||||
if not first then
|
||||
begin
|
||||
writeln;
|
||||
(* printPc; *)
|
||||
write(' ');
|
||||
end
|
||||
else
|
||||
first := false;
|
||||
|
||||
printPaddedLabel(current);
|
||||
end;
|
||||
current := current^.next;
|
||||
end;
|
||||
|
||||
if first then
|
||||
printPaddedLabel(nil);
|
||||
end;
|
||||
|
||||
procedure decodeFile;
|
||||
var w:integer;
|
||||
sym:HashRef;
|
||||
begin
|
||||
while not eof(infile) do
|
||||
begin
|
||||
printPc;
|
||||
printLabels(pc);
|
||||
|
||||
w := readInstruction;
|
||||
|
||||
sym := getHashed(symbolTable, pc);
|
||||
if isConstantPool(sym) then
|
||||
decodeIntConstant(w)
|
||||
else
|
||||
if isStringConstant(sym) then
|
||||
decodeString(w)
|
||||
else
|
||||
decodeInstruction(w);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure testHash;
|
||||
var s:string;
|
||||
result:HashRef;
|
||||
i:integer;
|
||||
begin
|
||||
s := 'einszweidrei';
|
||||
putHashed(symbolTable, 123, s);
|
||||
s := 'vierfuenf';
|
||||
putHashed(symbolTable, 45, s);
|
||||
s := 'null';
|
||||
putHashed(symbolTable, 0, s);
|
||||
s := '0x7FFF1234';
|
||||
putHashed(symbolTable, $7FFF1234, s);
|
||||
|
||||
result := getHashed(symbolTable, 123);
|
||||
writeln('getHashed 123:', result^.data);
|
||||
|
||||
result := getHashed(symbolTable, 45);
|
||||
writeln('getHashed 45:', result^.data);
|
||||
|
||||
result := getHashed(symbolTable, 0);
|
||||
writeln('getHashed 0:', result^.data);
|
||||
|
||||
result := getHashed(symbolTable, $7FFF1234);
|
||||
writeln('getHashed $7FFF1234:', result^.data);
|
||||
|
||||
for i := 1 to 5000 do
|
||||
begin
|
||||
str(i,s);
|
||||
putHashed(symbolTable,i,s);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure readKeyword(var fil:InputFileType; var wordBuf:string);
|
||||
var c:char;
|
||||
skipWhite:boolean;
|
||||
done:boolean;
|
||||
begin
|
||||
wordBuf := '';
|
||||
done := false;
|
||||
skipWhite := true;
|
||||
|
||||
repeat
|
||||
read(fil,c);
|
||||
if c in [ ' ', #9, #13, #10, #0 ] then
|
||||
begin
|
||||
if not skipWhite then
|
||||
done := true;
|
||||
end
|
||||
else
|
||||
begin
|
||||
wordBuf := wordBuf + c;
|
||||
skipWhite := false;
|
||||
end;
|
||||
until done or eof(fil);
|
||||
if c = #13 then (* skip over CR/LF *)
|
||||
read(fil,c);
|
||||
end;
|
||||
|
||||
procedure readSymbolTable(var filename:string);
|
||||
var buf:string;
|
||||
fil:InputFileType;
|
||||
symStr:string;
|
||||
num:integer;
|
||||
begin
|
||||
openFile(fil, filename);
|
||||
while not eof(fil) do
|
||||
begin
|
||||
readKeyword(fil,buf);
|
||||
readKeyword(fil,symStr);
|
||||
num := convertHex(buf);
|
||||
putHashed(symbolTable, num, symStr);
|
||||
end;
|
||||
|
||||
close(fil);
|
||||
end;
|
||||
|
||||
function parseOrigin(s:string):integer;
|
||||
var i,c:integer;
|
||||
begin
|
||||
val(s,i,c);
|
||||
if c > 0 then
|
||||
errorExit2('invalid number',s);
|
||||
parseOrigin := i;
|
||||
end;
|
||||
|
||||
begin
|
||||
if paramCount < 1 then halt;
|
||||
|
||||
if paramCount >= 2 then
|
||||
begin
|
||||
filename := paramStr(2);
|
||||
readSymbolTable(filename);
|
||||
end;
|
||||
|
||||
if paramCount >= 3 then
|
||||
pc := parseOrigin(paramStr(3));
|
||||
|
||||
filename := paramStr(1);
|
||||
openFile(infile, filename);
|
||||
decodeFile;
|
||||
close(infile);
|
||||
|
||||
(* dumpHash(symbolTable); *)
|
||||
end.
|
||||
289
pcomp/treeimpl.pas
Normal file
289
pcomp/treeimpl.pas
Normal file
|
|
@ -0,0 +1,289 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
function makeTreeNode(var d:TreeData;var key:string;nparent:TreeRef):TreeRef;
|
||||
var newNode:TreeRef;
|
||||
newKey:^string;
|
||||
begin
|
||||
new(newNode);
|
||||
{ new(newKey,length(key)); }
|
||||
newString(newKey, length(key));
|
||||
new(newNode^.data);
|
||||
newKey^ := key;
|
||||
with newNode^ do
|
||||
begin
|
||||
key := newKey;
|
||||
parent := nparent;
|
||||
left := nil;
|
||||
right := nil;
|
||||
height := 1;
|
||||
data^ := d;
|
||||
end;
|
||||
makeTreeNode := newNode;
|
||||
end;
|
||||
|
||||
function MeasureTree(root:TreeRef):integer;
|
||||
var leftHeight, rightHeight:integer;
|
||||
begin
|
||||
if root = nil then
|
||||
MeasureTree := 0
|
||||
else
|
||||
begin
|
||||
if root^.left <> nil then
|
||||
leftHeight := root^.left^.height
|
||||
else
|
||||
leftHeight := 0;
|
||||
if root^.right <> nil then
|
||||
rightHeight := root^.right^.height
|
||||
else
|
||||
rightHeight := 0;
|
||||
if rightHeight > leftHeight then
|
||||
MeasureTree := rightHeight + 1
|
||||
else
|
||||
MeasureTree := leftHeight + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetTreeBalance(root:TreeRef):integer;
|
||||
begin
|
||||
if root = nil then
|
||||
GetTreeBalance := 0
|
||||
else
|
||||
GetTreeBalance := MeasureTree(root^.left) - MeasureTree(root^.right);
|
||||
end;
|
||||
|
||||
function RotateTreeRight(x:TreeRef):TreeRef;
|
||||
var z,tmp:TreeRef;
|
||||
begin
|
||||
(* writeln('RotateTreeRight at ', x^.key^); *)
|
||||
z := x^.left;
|
||||
tmp := z^.right;
|
||||
z^.right := x;
|
||||
z^.parent := x^.parent;
|
||||
x^.parent := z;
|
||||
x^.left := tmp;
|
||||
if tmp <> nil then
|
||||
tmp^.parent := x;
|
||||
x^.height := MeasureTree(x);
|
||||
z^.height := MeasureTree(z);
|
||||
RotateTreeRight := z;
|
||||
end;
|
||||
|
||||
function RotateTreeLeft(x:TreeRef):TreeRef;
|
||||
var z,tmp:TreeRef;
|
||||
begin
|
||||
(* writeln('RotateTreeLeft at ', x^.key^); *)
|
||||
z := x^.right;
|
||||
tmp := z^.left;
|
||||
z^.left := x;
|
||||
z^.parent := x^.parent;
|
||||
x^.parent := z;
|
||||
x^.right := tmp;
|
||||
if tmp <> nil then
|
||||
tmp^.parent := x;
|
||||
x^.height := MeasureTree(x);
|
||||
z^.height := MeasureTree(z);
|
||||
RotateTreeLeft := z;
|
||||
end;
|
||||
|
||||
function TreeInsert4(root:TreeRef;var key:string;var data:TreeData;
|
||||
parent:TreeRef):TreeRef;
|
||||
var balance:integer;
|
||||
begin
|
||||
if root = nil then
|
||||
root := makeTreeNode(data, key, parent)
|
||||
else
|
||||
if key < root^.key^ then
|
||||
root^.left := TreeInsert4(root^.left, key, data, root)
|
||||
else
|
||||
root^.right := TreeInsert4(root^.right, key, data, root);
|
||||
|
||||
root^.height := MeasureTree(root);
|
||||
|
||||
balance := GetTreeBalance(root);
|
||||
if balance > 1 then
|
||||
begin
|
||||
if key < root^.left^.key^ then
|
||||
root := RotateTreeRight(root)
|
||||
else
|
||||
begin
|
||||
root^.left := RotateTreeLeft(root^.left);
|
||||
root := RotateTreeRight(root);
|
||||
end;
|
||||
end
|
||||
else
|
||||
if balance < -1 then
|
||||
begin
|
||||
if key > root^.right^.key^ then
|
||||
root := RotateTreeLeft(root)
|
||||
else
|
||||
begin
|
||||
root^.right := RotateTreeRight(root^.right);
|
||||
root := RotateTreeLeft(root);
|
||||
end;
|
||||
end;
|
||||
|
||||
TreeInsert4 := root;
|
||||
end;
|
||||
|
||||
procedure TreeInsert(var root:TreeRef;var key:string;var data:TreeData);
|
||||
begin
|
||||
root := TreeInsert4(root,key,data,nil);
|
||||
end;
|
||||
|
||||
procedure DisposeTreeNode(node:TreeRef);
|
||||
begin
|
||||
dispose(node^.key);
|
||||
dispose(node^.data);
|
||||
dispose(node);
|
||||
end;
|
||||
|
||||
function TreeLeftmost(node:TreeRef):TreeRef;
|
||||
begin
|
||||
TreeLeftmost := nil;
|
||||
if node <> nil then
|
||||
begin
|
||||
repeat
|
||||
TreeLeftmost := node;
|
||||
node := node^.left;
|
||||
until node = nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TreeDeleteFn(root:TreeRef;var key:string):TreeRef;
|
||||
var tmp,oldParent:TreeRef;
|
||||
balance:integer;
|
||||
begin
|
||||
if root <> nil then
|
||||
begin
|
||||
if key < root^.key^ then
|
||||
root^.left := TreeDeleteFn(root^.left, key)
|
||||
else
|
||||
if key > root^.key^ then
|
||||
root^.right := TreeDeleteFn(root^.right, key)
|
||||
else
|
||||
begin
|
||||
if root^.left = nil then
|
||||
begin
|
||||
tmp := root;
|
||||
oldParent := root^.parent;
|
||||
root := root^.right;
|
||||
if root <> nil then
|
||||
root^.parent := oldParent;
|
||||
DisposeTreeNode(tmp);
|
||||
end
|
||||
else
|
||||
if root^.right = nil then
|
||||
begin
|
||||
tmp := root;
|
||||
oldParent := root^.parent;
|
||||
root := root^.left;
|
||||
if root <> nil then
|
||||
root^.parent := oldParent;
|
||||
DisposeTreeNode(tmp);
|
||||
end
|
||||
else
|
||||
begin
|
||||
tmp := TreeLeftmost(root^.right);
|
||||
root^.key^ := tmp^.key^;
|
||||
root^.data^ := tmp^.data^;
|
||||
oldParent := tmp^.parent;
|
||||
if oldParent^.left = tmp then
|
||||
oldParent^.left := TreeDeleteFn(oldParent^.left, tmp^.key^)
|
||||
else
|
||||
if oldParent^.right = tmp then
|
||||
oldParent^.right := TreeDeleteFn(oldParent^.right, tmp^.key^)
|
||||
else
|
||||
begin
|
||||
writeln('TreeDelete internal error at', root^.key^);
|
||||
end;
|
||||
end;
|
||||
|
||||
if root <> nil then
|
||||
begin
|
||||
root^.height := MeasureTree(root);
|
||||
balance := GetTreeBalance(root);
|
||||
if balance > 1 then
|
||||
begin
|
||||
if GetTreeBalance(root^.left) >=0 then
|
||||
root := RotateTreeRight(root)
|
||||
else
|
||||
begin
|
||||
root^.left := RotateTreeLeft(root^.left);
|
||||
root := RotateTreeRight(root);
|
||||
end;
|
||||
end
|
||||
else
|
||||
if balance < -1 then
|
||||
begin
|
||||
if GetTreeBalance(root^.right) <= 0 then
|
||||
root := RotateTreeLeft(root)
|
||||
else
|
||||
begin
|
||||
root^.right := RotateTreeRight(root^.right);
|
||||
root := RotateTreeLeft(root);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
TreeDeleteFn := root;
|
||||
end;
|
||||
|
||||
procedure TreeDelete(var root:TreeRef;var key:string);
|
||||
begin
|
||||
root := TreeDeleteFn(root,key);
|
||||
end;
|
||||
|
||||
function TreeSearch(root:TreeRef;var key:string):TreeDataRef;
|
||||
begin
|
||||
if root <> nil then
|
||||
begin
|
||||
if key = root^.key^ then
|
||||
TreeSearch := root^.data
|
||||
else
|
||||
if key < root^.key^ then
|
||||
TreeSearch := TreeSearch(root^.left, key)
|
||||
else
|
||||
TreeSearch := TreeSearch(root^.right, key);
|
||||
end
|
||||
else
|
||||
TreeSearch := nil;
|
||||
end;
|
||||
|
||||
procedure TreeWalkStart(t:TreeRef; var state:TreeWalkState);
|
||||
begin
|
||||
(* start at leftmost node of the tree *)
|
||||
state.currentNode := TreeLeftmost(t);
|
||||
end;
|
||||
|
||||
procedure TreeWalkNext(var state:TreeWalkState;var res:TreeRef);
|
||||
var last,current,right:TreeRef;
|
||||
begin
|
||||
current := state.currentNode;
|
||||
|
||||
res := current;
|
||||
|
||||
if current <> nil then
|
||||
begin
|
||||
(* descending right *)
|
||||
if current^.right <> nil then
|
||||
begin
|
||||
state.currentNode := TreeLeftmost(current^.right);
|
||||
end
|
||||
else (* ascending *)
|
||||
begin
|
||||
repeat
|
||||
last := current;
|
||||
current := current^.parent;
|
||||
if current <> nil then
|
||||
right := current^.right;
|
||||
until (right <> last) or (current = nil); (* ascend left edges *)
|
||||
state.currentNode := current;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TreeWalkFirst(t:TreeRef; var state:TreeWalkState; var first:TreeRef);
|
||||
begin
|
||||
TreeWalkStart(t, state);
|
||||
TreeWalkNext(state, first);
|
||||
end;
|
||||
26
pcomp/treetypes.pas
Normal file
26
pcomp/treetypes.pas
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
{
|
||||
type TreedataType = (TDString, TDInteger);
|
||||
|
||||
type Treedata = record
|
||||
case typ:Treedatatype of
|
||||
TDString:(stringdata:string);
|
||||
TDInteger:(intdata:integer);
|
||||
end;
|
||||
}
|
||||
type StringRef = ^string;
|
||||
|
||||
type TreeNode = record
|
||||
parent: ^TreeNode;
|
||||
left,right: ^TreeNode;
|
||||
height: integer;
|
||||
key: StringRef;
|
||||
data: ^Treedata;
|
||||
end;
|
||||
|
||||
type TreeRef = ^TreeNode;
|
||||
TreeDataRef = ^Treedata;
|
||||
|
||||
type TreeWalkState = record
|
||||
currentNode:TreeRef;
|
||||
end;
|
||||
52
progs/dumpdir.pas
Normal file
52
progs/dumpdir.pas
Normal file
|
|
@ -0,0 +1,52 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
program dumpdir;
|
||||
var volname:string;
|
||||
volid:integer;
|
||||
|
||||
(* we use some stuff internal to stdlib.pas *)
|
||||
procedure getdirslot(volumeid:integer;slotNo:integer;var result:DirectorySlot;var error:integer);
|
||||
external;
|
||||
|
||||
procedure dumpdir(volid:integer);
|
||||
var dirs:DirectorySlot;
|
||||
i:integer;
|
||||
lastSlot:integer;
|
||||
error:integer;
|
||||
begin
|
||||
lastSlot := volumeTable[volid].part.dirSize - 1;
|
||||
openvolumeid(volid);
|
||||
|
||||
for i := 0 to lastSlot do
|
||||
begin
|
||||
getdirslot(volid, i, dirs, error);
|
||||
with dirs do
|
||||
begin
|
||||
write('slot ', i, ' ', name, ' ', sizeBytes, ' G', generation);
|
||||
if SlotFirst in flags then write(' First');
|
||||
if SlotExtent in flags then write(' Extent');
|
||||
if SlotReserved in flags then write(' Resvd');
|
||||
if SlotDeleted in flags then write(' Del');
|
||||
if SlotFree in flags then write(' Free');
|
||||
if SlotEndScan in flags then write(' End');
|
||||
writeln;
|
||||
if SlotEndScan in flags then break;
|
||||
end;
|
||||
end;
|
||||
|
||||
closevolumeid(volid);
|
||||
end;
|
||||
|
||||
begin
|
||||
if ParamCount > 0 then
|
||||
volname := ParamStr(1)
|
||||
else
|
||||
begin
|
||||
write('Volume name> ');
|
||||
readln(volname);
|
||||
end;
|
||||
volid := findvolume(volname);
|
||||
if volid < 1 then
|
||||
writeln('Volume not found.')
|
||||
else
|
||||
dumpdir(volid);
|
||||
end.
|
||||
2491
progs/editor.pas
Normal file
2491
progs/editor.pas
Normal file
File diff suppressed because it is too large
Load diff
742
progs/partmgr.pas
Normal file
742
progs/partmgr.pas
Normal file
|
|
@ -0,0 +1,742 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
program partmgr;
|
||||
const MaxPartitions = 32;
|
||||
LastPartBlock = 7;
|
||||
PartsPerBlock = 8;
|
||||
|
||||
var partTable:array[0..LastPartBlock] of PartitionTableBlock;
|
||||
changed:array[0..LastPartBlock] of boolean;
|
||||
detectedCardSize:integer;
|
||||
cmd:char;
|
||||
done:boolean;
|
||||
lastPartNo:integer;
|
||||
|
||||
function flags2str(flags:PartFlags):string;
|
||||
begin
|
||||
flags2str := '';
|
||||
|
||||
if PartEnabled in flags then flags2str := flags2str + 'E ';
|
||||
if PartBoot in flags then flags2str := flags2str + 'B ';
|
||||
if PartLast in flags then flags2str := flags2str + 'L ';
|
||||
if PartPhysical in flags then flags2str := flags2str + 'P ';
|
||||
if PartDefault in flags then flags2str := flags2str + 'D ';
|
||||
end;
|
||||
|
||||
function str2flags(var s:string):PartFlags;
|
||||
begin
|
||||
str2flags := [];
|
||||
|
||||
if 'E' in s then str2flags := str2flags + [PartEnabled];
|
||||
if 'B' in s then str2flags := str2flags + [PartBoot];
|
||||
if 'L' in s then str2flags := str2flags + [PartLast];
|
||||
if 'P' in s then str2flags := str2flags + [PartPhysical];
|
||||
if 'D' in s then str2flags := str2flags + [PartDefault];
|
||||
end;
|
||||
|
||||
function sanitizeName(var name:string):string;
|
||||
begin
|
||||
if (length(name) <= 32) and (maxlength(name) = 32) then
|
||||
sanitizeName := name
|
||||
else
|
||||
sanitizeName := '<invalid>';
|
||||
end;
|
||||
|
||||
procedure changeNumber(prompt:string; var num:integer);
|
||||
var buf:string;
|
||||
err:integer;
|
||||
digits:string;
|
||||
begin
|
||||
str(num, digits);
|
||||
buf := prompt + ' [' + digits + ']> ';
|
||||
write(buf:30);
|
||||
readln(buf);
|
||||
val(buf,num,err);
|
||||
end;
|
||||
|
||||
|
||||
procedure readPartTable;
|
||||
var done:boolean;
|
||||
curblk:integer;
|
||||
error:integer;
|
||||
devid:integer;
|
||||
begin
|
||||
done := false;
|
||||
curblk := 0;
|
||||
devid := 0; (* we only support one device *)
|
||||
|
||||
while not done do
|
||||
begin
|
||||
changed[curBlk] := false;
|
||||
|
||||
readPartBlk(curblk, partTable[curblk], error, devid);
|
||||
if error <> 0 then
|
||||
begin
|
||||
done := true;
|
||||
writeln('Error ', error,
|
||||
' reading partition block ', curblk);
|
||||
end
|
||||
else
|
||||
curblk := curblk + 1;
|
||||
|
||||
|
||||
if curBlk > LastPartBlock then
|
||||
done := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure writePartBlock(no:integer);
|
||||
var error:integer;
|
||||
devid:integer;
|
||||
begin
|
||||
devid := 0;
|
||||
writePartBlk(no, partTable[no], error, devid);
|
||||
if error <> 0 then
|
||||
writeln('Error ', error,
|
||||
' reading partition block ', no);
|
||||
end;
|
||||
|
||||
procedure writePartitions;
|
||||
var blkNo:integer;
|
||||
begin
|
||||
for blkNo := 0 to LastPartBlock do
|
||||
begin
|
||||
if changed[blkNo] then
|
||||
begin
|
||||
writeln('Writing back partition block ',blkNo);
|
||||
writePartBlock(blkNo);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function getPartition(partNo:integer):Partition;
|
||||
var blkNo:integer;
|
||||
begin
|
||||
blkNo := partNo div PartsPerBlock;
|
||||
if (blkNo < 0) or (blkNo > LastPartBlock) then
|
||||
writeln('internal error: invalid part no in getPartition')
|
||||
else
|
||||
getPartition := partTable[blkNo][partNo mod PartsPerBlock];
|
||||
{ writeln('** getPartition: ', blkNo, ' ', partNo mod PartsPerBlock); }
|
||||
end;
|
||||
|
||||
procedure putPartition(var part:Partition; partNo:integer);
|
||||
var blkNo:integer;
|
||||
begin
|
||||
blkNo := partNo div PartsPerBlock;
|
||||
{ writeln('** putPartition: ', blkNo, ' ', partNo mod PartsPerBlock); }
|
||||
if (blkNo < 0) or (blkNo > LastPartBlock) then
|
||||
writeln('internal error: invalid part no in getPartition')
|
||||
else
|
||||
begin
|
||||
partTable[blkNo][partNo mod PartsPerBlock] := part;
|
||||
changed[blkNo] := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function isEmptyPart(var part:Partition):boolean;
|
||||
begin
|
||||
isEmptyPart := (part.startBlock = 0) and (part.blocks = 0);
|
||||
end;
|
||||
|
||||
procedure printPartTable;
|
||||
var blkNo, partNo:integer;
|
||||
partBlk:PartitionTableBlock;
|
||||
part:Partition;
|
||||
totalPartNo:integer;
|
||||
begin
|
||||
totalPartNo := 0;
|
||||
|
||||
writeln('Partition Table:');
|
||||
writeln('No. ', 'Flags':11, 'Name':32, 'Start':10, 'Size':10);
|
||||
|
||||
for blkNo := 0 to LastPartBlock do
|
||||
begin
|
||||
partBlk := partTable[blkNo];
|
||||
for partNo := 0 to PartsPerBlock - 1 do
|
||||
begin
|
||||
part := partBlk[partNo];
|
||||
|
||||
if not isEmptyPart(part) then
|
||||
begin
|
||||
write(totalPartNo:3, ': ', flags2Str(part.flags):11,
|
||||
sanitizeName(part.name):32,
|
||||
part.startBlock:10,
|
||||
part.blocks:10);
|
||||
if PartBoot in part.flags then write(' ', part.bootBlocks);
|
||||
writeln;
|
||||
lastPartNo := totalPartNo;
|
||||
end;
|
||||
totalPartNo := totalPartNo + 1;
|
||||
end;
|
||||
end;
|
||||
writeln('Flags: P=Physical B=Boot E=Enabled L=Last D=Default');
|
||||
end;
|
||||
|
||||
function askPartNo:integer;
|
||||
var i:integer;
|
||||
s:string;
|
||||
begin
|
||||
askPartNo := -1;
|
||||
write('Enter partition number (0-', lastPartNo, ')> ');
|
||||
readln(s);
|
||||
if length(s) > 0 then
|
||||
begin
|
||||
val(s,askPartNo,i);
|
||||
if i > 0 then
|
||||
writeln('Invalid partition number');
|
||||
end;
|
||||
end;
|
||||
|
||||
function askConfirmPartNo:integer;
|
||||
var partNo:integer;
|
||||
part:Partition;
|
||||
answer:char;
|
||||
begin
|
||||
askConfirmPartNo := -1;
|
||||
|
||||
partNo := askPartNo;
|
||||
|
||||
if partNo >= 0 then
|
||||
begin
|
||||
part := getPartition(partNo);
|
||||
write('Any data on partition ', partNo,
|
||||
' (', sanitizeName(part.name), ') ',
|
||||
'will be destroyed. Sure [y/n]? ');
|
||||
readln(answer);
|
||||
if upcase(answer) = 'Y' then
|
||||
askConfirmPartNo := partNo;
|
||||
end;
|
||||
end;
|
||||
|
||||
function guessExtentSize(blocks:integer):integer;
|
||||
begin
|
||||
if blocks >= 4194304 then (* 2 GB *)
|
||||
guessExtentSize := 1048576 (* use 1MB extents *)
|
||||
else
|
||||
if blocks >= 1048576 then (* 512 MB *)
|
||||
guessExtentSize := 524288 (* use 512K extents *)
|
||||
else
|
||||
if blocks >= 524288 then (* 256 MB *)
|
||||
guessExtentSize := 131072
|
||||
else
|
||||
if blocks >= 262144 then (* 128 MB *)
|
||||
guessExtentSize := 65536
|
||||
else
|
||||
if blocks >= 32768 then (* 16 MB *)
|
||||
guessExtentSize := 16384
|
||||
else
|
||||
guessExtentSize := 8192;
|
||||
end;
|
||||
|
||||
function getDirSize(extentSize,blocks:integer):integer;
|
||||
begin
|
||||
getDirSize := blocks div (extentSize div 512);
|
||||
end;
|
||||
|
||||
procedure createFilesystem(partNo:integer); forward;
|
||||
|
||||
procedure addVolume;
|
||||
var nextFreeBlock:integer;
|
||||
nextBlock:integer;
|
||||
extentSize:integer;
|
||||
size:integer;
|
||||
i:integer;
|
||||
part:Partition;
|
||||
maxBlocks:integer;
|
||||
freeBlocks:integer;
|
||||
newPartNo:integer;
|
||||
newPart:Partition;
|
||||
begin
|
||||
part := getPartition(0);
|
||||
maxBlocks := part.blocks;
|
||||
nextFreeBlock := 0;
|
||||
(* read all partitions *)
|
||||
for i := 1 to lastPartNo do
|
||||
begin
|
||||
part := getPartition(i);
|
||||
nextBlock := part.startBlock + part.blocks;
|
||||
if nextBlock > nextFreeBlock then
|
||||
nextFreeBlock := nextBlock;
|
||||
end;
|
||||
(* remember last used block *)
|
||||
writeln('next free partition: ', lastPartNo + 1,
|
||||
' next free block: ', nextFreeBlock);
|
||||
|
||||
freeBlocks := maxBlocks - nextFreeBlock;
|
||||
|
||||
if freeBlocks < 1 then
|
||||
writeln('Cannot add partition - no free blocks after last partition.')
|
||||
else
|
||||
begin
|
||||
newPartNo := lastPartNo + 1;
|
||||
(* remove last partition flag on previous last partition *)
|
||||
part.flags := part.flags - [PartLast];
|
||||
putPartition(part, lastPartNo);
|
||||
|
||||
(* create new partition *)
|
||||
size := freeBlocks;
|
||||
changeNumber('Size (blocks)', size);
|
||||
write('Name> ':30);
|
||||
readln(newPart.name);
|
||||
|
||||
newPart.startBlock := nextFreeBlock;
|
||||
newPart.blocks := size;
|
||||
newPart.extentSize := guessExtentSize(size);
|
||||
newPart.dirSize := getDirSize(newPart.extentSize, size);
|
||||
newPart.bootBlocks := 0;
|
||||
(* mark new partition as last partition *)
|
||||
newPart.flags := [ PartEnabled, PartLast ];
|
||||
putPartition(newPart, newPartNo);
|
||||
|
||||
writeln('Partition ', newPartNo, ' created, extent size:', newPart.extentSize,
|
||||
' directory size: ', newPart.dirSize);
|
||||
createFilesystem(newPartNo);
|
||||
|
||||
lastPartNo := lastPartNo + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure renameVolume;
|
||||
var partNo:integer;
|
||||
newName:string;
|
||||
part:Partition;
|
||||
|
||||
begin
|
||||
partNo := askPartNo;
|
||||
if partNo >= 0 then
|
||||
begin
|
||||
part := getPartition(partNo);
|
||||
writeln('Old partition/volume name: ', sanitizeName(part.name));
|
||||
write('New partion/volume name: ');
|
||||
readln(newName);
|
||||
if length(newName) > 0 then
|
||||
begin
|
||||
part.name := newName;
|
||||
putPartition(part, partNo);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure toggleDefaultFlag;
|
||||
var partNo:integer;
|
||||
part:Partition;
|
||||
|
||||
begin
|
||||
partNo := askPartNo;
|
||||
if partNo >= 0 then
|
||||
begin
|
||||
part := getPartition(partNo);
|
||||
write('Default flag ');
|
||||
if PartDefault in part.flags then
|
||||
begin
|
||||
part.flags := part.flags - [PartDefault];
|
||||
write('cleared');
|
||||
end
|
||||
else
|
||||
begin
|
||||
part.flags := part.flags + [PartDefault];
|
||||
write('set');
|
||||
end;
|
||||
writeln(' on partition ', partNo, ' (', sanitizeName(part.name), ').');
|
||||
putPartition(part, partNo);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure deleteVolume;
|
||||
var partNo:integer;
|
||||
part:Partition;
|
||||
begin
|
||||
partNo := askConfirmPartNo;
|
||||
if partNo >= 0 then
|
||||
begin
|
||||
part := getPartition(partNo);
|
||||
part.flags := [];
|
||||
part.name := '';
|
||||
part.startBlock := 0;
|
||||
part.blocks := 0;
|
||||
part.extentSize := 0;
|
||||
part.dirSize := 0;
|
||||
part.bootBlocks := 0;
|
||||
putPartition(part, partNo);
|
||||
|
||||
writeln('Partition ', partNo, ' deleted.');
|
||||
|
||||
(* try to fix last partition flag *)
|
||||
(* only works if the previous entry has
|
||||
a valid partition *)
|
||||
if partNo = lastPartNo then
|
||||
begin
|
||||
lastPartNo := lastPartNo - 1;
|
||||
part := getPartition(lastPartNo);
|
||||
part.flags := part.flags + [PartLast];
|
||||
putPartition(part, lastPartNo);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure validatePartTable;
|
||||
var partNo:integer;
|
||||
phys:Partition;
|
||||
part,part2:Partition;
|
||||
answer:char;
|
||||
p,p2:integer;
|
||||
valid:boolean;
|
||||
begin
|
||||
valid := true;
|
||||
|
||||
phys := getPartition(0);
|
||||
if not (PartPhysical in phys.flags) then
|
||||
begin
|
||||
writeln('PHYS partition missing, initialize card first!');
|
||||
exit;
|
||||
end;
|
||||
|
||||
if phys.blocks <> detectedCardSize then
|
||||
begin
|
||||
write('PHYS partition size does not match detected card size, fix? [y/n]');
|
||||
readln(answer);
|
||||
if upcase(answer) = 'Y' then
|
||||
begin
|
||||
phys.blocks := detectedCardSize;
|
||||
putPartition(phys,0);
|
||||
end
|
||||
else
|
||||
valid := false;
|
||||
end;
|
||||
|
||||
for p := 1 to lastPartNo do
|
||||
begin
|
||||
part := getPartition(p);
|
||||
if (part.startBlock < 0) or (part.startBlock + part.blocks > phys.blocks) then
|
||||
begin
|
||||
writeln('Partition ', p, ' outside of physical bounds.');
|
||||
valid := false;
|
||||
end;
|
||||
|
||||
if PartEnabled in part.flags then
|
||||
if part.dirSize <> getDirSize(part.extentSize, part.blocks) then
|
||||
begin
|
||||
write('Partition ', p, ' has an invalid directory size (is ');
|
||||
writeln(part.dirSize, ', should be ',
|
||||
getDirSize(part.extentSize, part.blocks), ').');
|
||||
valid := false;
|
||||
end;
|
||||
|
||||
for p2 := 1 to lastPartNo do
|
||||
begin
|
||||
part2 := getPartition(p2);
|
||||
if (p <> p2) then
|
||||
begin
|
||||
if ((part.startBlock >= part2.startBlock) and
|
||||
(part.startBlock < part2.startBlock + part2.blocks)) or
|
||||
((part2.startBlock > part.startBlock) and
|
||||
(part2.startBlock < part.startBlock + part.blocks))
|
||||
then
|
||||
begin
|
||||
writeln('Partition ',p ,' overlaps with partition ', p2);
|
||||
valid := false;
|
||||
end;
|
||||
|
||||
if (part.name = part2.name) and (p > p2) then
|
||||
begin
|
||||
writeln('Duplicate volume name ', part.name);
|
||||
valid := false;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
write('Partition table is ');
|
||||
if not valid then write('in');
|
||||
writeln('valid.');
|
||||
end;
|
||||
|
||||
procedure checkNewCard; forward;
|
||||
|
||||
procedure initializeCard;
|
||||
var part:Partition;
|
||||
answer:char;
|
||||
p:integer;
|
||||
begin
|
||||
writeln('Initializing a card will create an empty partition table with');
|
||||
writeln('the standard PHYS and BOOT partitions.');
|
||||
write('This will likely destroy any data on the card - sure? [y/n] ');
|
||||
readln(answer);
|
||||
if upcase(answer) <> 'Y' then exit;
|
||||
|
||||
(* create PHYS partition using detectedcardblocks *)
|
||||
part.name := 'PHYS';
|
||||
part.startBlock := 0;
|
||||
part.blocks := detectedCardSize;
|
||||
part.flags := [PartPhysical];
|
||||
part.extentSize := 0;
|
||||
part.dirSize := 0;
|
||||
part.bootBlocks := 0;
|
||||
putPartition(part,0);
|
||||
|
||||
(* create BOOT partition without PartBoot flag *)
|
||||
part.name := 'BOOT';
|
||||
part.startBlock := 16; (* 16 possible partition blocks with 8 partitions each *)
|
||||
part.blocks := 8192 - 16; (* align first volume to 4MB *)
|
||||
part.flags := [PartBoot, PartLast];
|
||||
putPartition(part,1);
|
||||
|
||||
part.name := '';
|
||||
part.startBlock := 0;
|
||||
part.blocks := 0;
|
||||
part.flags := [];
|
||||
|
||||
for p := 2 to 7 do
|
||||
putPartition(part,p);
|
||||
|
||||
writeln('Empty partition table created.');
|
||||
end;
|
||||
|
||||
procedure createFilesystem(partNo:integer);
|
||||
var firstDirBlock:integer;
|
||||
slot:DirectorySlot;
|
||||
dirblk:DirBlock;
|
||||
dirblockCount:integer;
|
||||
metaSlotsCount:integer;
|
||||
dirSlotsPerBlock:integer;
|
||||
dirSlotsPerExtent:integer;
|
||||
part:Partition;
|
||||
ts:Timestamp;
|
||||
i,b:integer;
|
||||
error,devid:integer;
|
||||
begin
|
||||
devid := 0;
|
||||
ts := 0;
|
||||
|
||||
part := getPartition(partNo);
|
||||
firstDirBlock := part.startBlock;
|
||||
dirSlotsPerBlock := 512 div 64;
|
||||
dirSlotsPerExtent := part.extentSize div 64;
|
||||
dirblockCount := (part.dirSize - 1) div dirSlotsPerBlock + 1;
|
||||
metaSlotsCount := (part.dirSize - 1) div dirSlotsPerExtent + 1;
|
||||
|
||||
writeln('partition size: ', part.blocks);
|
||||
writeln('extent size: ', part.extentSize);
|
||||
writeln('directory size: ', part.dirSize);
|
||||
{ writeln('dirslots per extent:', dirSlotsPerExtent);
|
||||
writeln('dirblocks: ', dirblockCount);
|
||||
writeln('metaslots: ', metaSlotsCount);
|
||||
writeln('first dir block: ', firstDirBlock);
|
||||
}
|
||||
for b := firstDirBlock to firstDirBlock + dirblockCount - 1 do
|
||||
begin
|
||||
for i := 0 to dirSlotsPerBlock - 1 do
|
||||
begin
|
||||
if metaSlotsCount > 0 then
|
||||
begin
|
||||
(* write DIR/Reserved directory slots *)
|
||||
slot.name := 'DIR';
|
||||
slot.flags := [ SlotReserved ];
|
||||
metaSlotsCount := metaSlotsCount - 1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
(* write Free + EndScan directory slots *)
|
||||
slot.name := '';
|
||||
slot.flags := [ SlotFree , SlotEndScan ];
|
||||
end;
|
||||
slot.sizeBytes := 0;
|
||||
slot.createTime := ts;
|
||||
slot.modTime := ts;
|
||||
slot.generation := 0;
|
||||
slot.owner := 0;
|
||||
|
||||
dirBlk[i] := slot;
|
||||
end;
|
||||
writedirblk(b, dirBlk, error, devid);
|
||||
if error > 0 then
|
||||
writeln('error writing block ', b, ': ', error);
|
||||
end;
|
||||
writeln('Volume ', part.name, ' initialized.');
|
||||
end;
|
||||
|
||||
procedure initializeVolume;
|
||||
var partNo:integer;
|
||||
part:Partition;
|
||||
begin
|
||||
partNo := askConfirmPartNo;
|
||||
if partNo >= 0 then
|
||||
begin
|
||||
part := getPartition(partNo);
|
||||
if not (PartEnabled in part.flags) then
|
||||
writeln('Wrong partition flags (must be Enabled)')
|
||||
else
|
||||
createFilesystem(partNo);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure rawEdit;
|
||||
var partNo:integer;
|
||||
newName:string;
|
||||
part:Partition;
|
||||
buf:string;
|
||||
begin
|
||||
writeln('Raw editing partition entry - use caution!');
|
||||
|
||||
partNo := askPartNo;
|
||||
if partNo >= 0 then
|
||||
begin
|
||||
part := getPartition(partNo);
|
||||
writeln('Volume name: ', sanitizeName(part.name));
|
||||
write('Flags> ':30);
|
||||
readln(buf);
|
||||
if length(buf) > 0 then
|
||||
part.flags := str2flags(buf);
|
||||
changeNumber('Start block', part.startBlock);
|
||||
changeNumber('Size (blocks)', part.blocks);
|
||||
changeNumber('Extent size (blocks)', part.extentSize);
|
||||
changeNumber('Dir size (slots)', part.dirSize);
|
||||
changeNumber('Boot blocks', part.bootBlocks);
|
||||
|
||||
putPartition(part, partNo);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure installBoot;
|
||||
var bootfile:file;
|
||||
name:string;
|
||||
part:Partition;
|
||||
partNo:integer;
|
||||
buf:IOBlock;
|
||||
b,blkCount:integer;
|
||||
devId:integer;
|
||||
error:integer;
|
||||
|
||||
procedure readWordsIntoBuf;
|
||||
var i:integer;
|
||||
w:integer;
|
||||
c1,c2,c3,c4:char;
|
||||
begin
|
||||
for i := 0 to 127 do
|
||||
begin
|
||||
if not eof(bootfile) then
|
||||
begin
|
||||
read(bootfile, c1, c2, c3, c4);
|
||||
w := (ord(c1) shl 24) or
|
||||
(ord(c2) shl 16) or
|
||||
(ord(c3) shl 8) or
|
||||
ord(c4);
|
||||
end
|
||||
else
|
||||
w := 0;
|
||||
buf[i] := w;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
devId := 0; (* only one device supported *)
|
||||
partNo := 1; (* BOOT partition is always at position 1 *)
|
||||
|
||||
part := getPartition(partNo);
|
||||
if part.name <> 'BOOT' then
|
||||
begin
|
||||
writeln('No BOOT partition at position 1.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
write('Boot file name> ');
|
||||
readln(name);
|
||||
if length(name) > 0 then
|
||||
begin
|
||||
open(bootfile, name, ModeReadonly);
|
||||
if IOResult(bootfile) <> 0 then
|
||||
writeln('Error opening file: ', ErrorStr(IOResult(bootfile)))
|
||||
else
|
||||
begin
|
||||
blkCount := filesize(bootfile) div 512 + 1;
|
||||
if blkCount > part.blocks then
|
||||
writeln('Boot partition too small, need ', blkCount)
|
||||
else
|
||||
begin
|
||||
part.bootBlocks := blkCount;
|
||||
if not (PartBoot in part.flags) then
|
||||
begin
|
||||
write('Boot flag set');
|
||||
writeln(' on partition ', partNo,
|
||||
' (', sanitizeName(part.name), ').');
|
||||
part.flags := part.flags + [PartBoot];
|
||||
end;
|
||||
putPartition(part, partNo);
|
||||
for b := 0 to blkCount - 1 do
|
||||
begin
|
||||
readWordsIntoBuf;
|
||||
writeblock(part.startBlock + b, buf, error, devId);
|
||||
if error <> 0 then
|
||||
writeln('Error in writeblock ', b, ': ', error);
|
||||
end;
|
||||
writeln(blkCount, ' boot blocks written.');
|
||||
end;
|
||||
close(bootfile);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure showMenu;
|
||||
begin
|
||||
writeln;
|
||||
writeln('L)ist partitions V)alidate partition table T)oggle default volume flag');
|
||||
writeln('A)dd volume R)ename volume D)elete volume I)nitialize volume');
|
||||
writeln('Read N)ew card Initialize C)ard');
|
||||
writeln('E)dit partition Install B)oot file eX)it');
|
||||
write('> ');
|
||||
end;
|
||||
|
||||
procedure invalidCommand;
|
||||
begin
|
||||
writeln('Invalid command.');
|
||||
end;
|
||||
|
||||
procedure command(cmd:char; var done:boolean);
|
||||
begin
|
||||
case cmd of
|
||||
'L': printPartTable;
|
||||
'A': addVolume;
|
||||
'R': renameVolume;
|
||||
'D': deleteVolume;
|
||||
'V': validatePartTable;
|
||||
'T': toggleDefaultFlag;
|
||||
'I': initializeVolume;
|
||||
'N': checkNewCard;
|
||||
'C': initializeCard;
|
||||
'B': installBoot;
|
||||
'E': rawEdit;
|
||||
'X',#24: done := true;
|
||||
else invalidCommand;
|
||||
end;
|
||||
end;
|
||||
|
||||
function changesPending:boolean;
|
||||
var i:integer;
|
||||
begin
|
||||
changesPending := false;
|
||||
for i := 0 to LastPartBlock do
|
||||
if changed[i] then changesPending := true;
|
||||
end;
|
||||
|
||||
procedure checkNewCard;
|
||||
begin
|
||||
if changesPending then
|
||||
writeln('WARNING: Discarding partition table changes.');
|
||||
initDevices;
|
||||
detectedCardSize := cardsize;
|
||||
writeln('Detected card size: ', detectedCardSize);
|
||||
readPartTable;
|
||||
printPartTable;
|
||||
end;
|
||||
|
||||
begin
|
||||
checkNewCard;
|
||||
|
||||
repeat
|
||||
showMenu;
|
||||
read(cmd);
|
||||
writeln;
|
||||
command(Upcase(cmd), done);
|
||||
until done;
|
||||
writePartitions;
|
||||
end.
|
||||
221
progs/reclaim.pas
Normal file
221
progs/reclaim.pas
Normal file
|
|
@ -0,0 +1,221 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
program reclaim;
|
||||
var volname:string;
|
||||
ch:char;
|
||||
count:integer;
|
||||
|
||||
(* we use some stuff internal to stdlib.pas *)
|
||||
procedure getdirslot(volumeid:integer;slotNo:integer;var result:DirectorySlot;var error:integer);
|
||||
external;
|
||||
procedure putdirslot(volumeid:integer;slotNo:integer;var dirslot:DirectorySlot;var error:integer);
|
||||
external;
|
||||
|
||||
procedure scanVolume(volname:string;dryrun:boolean;verbose:boolean;var reclaimCount:integer);
|
||||
var volid:integer;
|
||||
i:integer;
|
||||
error:integer;
|
||||
dirslot:DirectorySlot;
|
||||
done:boolean;
|
||||
fileCount, deletedCount:integer;
|
||||
freeCount:integer;
|
||||
fileSlotCount:integer;
|
||||
reservedCount:integer;
|
||||
freeAreaCount:integer;
|
||||
inFreeArea:boolean;
|
||||
endSlot:integer;
|
||||
lastUsed:integer;
|
||||
deletedExtent:boolean;
|
||||
|
||||
procedure clearDirSlot;
|
||||
begin
|
||||
reclaimCount := reclaimCount + 1;
|
||||
|
||||
if not dryrun then
|
||||
begin
|
||||
dirslot.name := '';
|
||||
dirslot.flags := [SlotFree];
|
||||
dirslot.sizeBytes := 0;
|
||||
dirslot.createTime := 0;
|
||||
dirslot.modTime := 0;
|
||||
dirslot.generation := 0;
|
||||
|
||||
putdirslot(volid, i, dirslot, error);
|
||||
if error <> IONoError then
|
||||
begin
|
||||
write('Error writing directory slot ',i);
|
||||
writeln(': ', ErrorStr(error));
|
||||
done := true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure markLastSlot;
|
||||
var slotNo:integer;
|
||||
begin
|
||||
(* we actually mark the slot after the last used slot *)
|
||||
if not dryrun then
|
||||
begin
|
||||
if lastUsed < endSlot then
|
||||
begin
|
||||
writeln('Updating directory...');
|
||||
slotNo := lastUsed + 1;
|
||||
getdirslot(volid, slotNo, dirslot, error);
|
||||
if error <> IONoError then
|
||||
begin
|
||||
write('Error reading directory slot ', slotNo);
|
||||
writeln(': ', ErrorStr(error));
|
||||
end;
|
||||
|
||||
if not (SlotEndScan in dirslot.flags) then
|
||||
dirslot.flags := dirslot.flags + [SlotEndScan];
|
||||
|
||||
putdirslot(volid, slotNo, dirslot, error);
|
||||
if error <> IONoError then
|
||||
begin
|
||||
write('Error writing directory slot ', lastUsed);
|
||||
writeln(': ', ErrorStr(error));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure beginFreeArea;
|
||||
begin
|
||||
freeCount := freeCount + 1;
|
||||
if not inFreeArea then
|
||||
begin
|
||||
inFreeArea := true;
|
||||
freeAreaCount := freeAreaCount + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure endFreeArea;
|
||||
begin
|
||||
if inFreeArea then
|
||||
inFreeArea := false;
|
||||
end;
|
||||
|
||||
begin
|
||||
volid := findvolume(volname);
|
||||
if volid < 1 then
|
||||
writeln('Volume ', volname, ' not found.')
|
||||
else
|
||||
begin
|
||||
done := false;
|
||||
deletedExtent := false;
|
||||
inFreeArea := false;
|
||||
fileCount := 0;
|
||||
deletedCount := 0;
|
||||
reclaimCount := 0;
|
||||
freeCount := 0;
|
||||
reservedCount := 0;
|
||||
fileSlotCount := 0;
|
||||
freeAreaCount := 0;
|
||||
lastUsed := 0;
|
||||
|
||||
openvolumeid(volid);
|
||||
i := volumeTable[volid].startSlot;
|
||||
endSlot := volumeTable[volid].part.dirSize - 1;
|
||||
|
||||
if verbose then
|
||||
begin
|
||||
write('Volume ', volname);
|
||||
write(' start slot:', i);
|
||||
write(' dir size: ', endSlot + 1);
|
||||
writeln(' extent size: ', volumeTable[volid].part.extentSize);
|
||||
end;
|
||||
|
||||
writeln('Reading directory...');
|
||||
repeat
|
||||
getdirslot(volid, i, dirslot, error);
|
||||
if error <> IONoError then
|
||||
begin
|
||||
write('Error reading directory slot ',i);
|
||||
writeln(': ', ErrorStr(error));
|
||||
done := true;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if SlotEndScan in dirslot.flags then
|
||||
done := true;
|
||||
if SlotFirst in dirslot.flags then
|
||||
begin
|
||||
lastUsed := i;
|
||||
fileCount := fileCount + 1;
|
||||
deletedExtent := false;
|
||||
endFreeArea;
|
||||
end
|
||||
else
|
||||
if SlotDeleted in dirslot.flags then
|
||||
begin
|
||||
deletedCount := deletedCount + 1;
|
||||
deletedExtent := true;
|
||||
clearDirSlot;
|
||||
(* we consider a deleted file
|
||||
as a free area here *)
|
||||
if not dryrun then
|
||||
beginFreeArea;
|
||||
end
|
||||
else
|
||||
if SlotExtent in dirslot.flags then
|
||||
begin
|
||||
if deletedExtent then
|
||||
clearDirSlot
|
||||
else
|
||||
lastUsed := i;
|
||||
end
|
||||
else
|
||||
if SlotReserved in dirslot.flags then
|
||||
reservedCount := reservedCount + 1
|
||||
else
|
||||
if SlotFree in dirslot.flags then
|
||||
beginFreeArea;
|
||||
end;
|
||||
if i = endSlot then
|
||||
done := true;
|
||||
i := i + 1;
|
||||
until done;
|
||||
|
||||
markLastSlot;
|
||||
closevolumeid(volid);
|
||||
i := i - 1;
|
||||
|
||||
if verbose then
|
||||
begin
|
||||
writeln('last used slot: ', lastUsed);
|
||||
writeln('max slots: ', endSlot + 1);
|
||||
writeln('free slots: ', endSlot - i + freeCount);
|
||||
writeln('reserved slots: ', reservedCount);
|
||||
writeln;
|
||||
end;
|
||||
|
||||
write(fileCount, ' files, ', deletedCount, ' deleted files, ');
|
||||
write(reclaimCount);
|
||||
if dryrun then
|
||||
writeln(' reclaimable slots, ', freeAreaCount, ' free regions.')
|
||||
else
|
||||
writeln(' reclaimed slots, ', freeAreaCount, ' free regions.');
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if ParamCount > 0 then
|
||||
volname := ParamStr(1)
|
||||
else
|
||||
begin
|
||||
write('Volume name> ');
|
||||
readln(volname);
|
||||
end;
|
||||
|
||||
initDevices;
|
||||
scanVolume(volname, true, true, count);
|
||||
|
||||
if count > 0 then
|
||||
begin
|
||||
write('Proceed with reclaim (y/n)? ');
|
||||
read(ch);
|
||||
writeln;
|
||||
if upcase(ch) = 'Y' then
|
||||
scanVolume(volname, false, false, count);
|
||||
end;
|
||||
end.
|
||||
481
progs/shell.pas
Normal file
481
progs/shell.pas
Normal file
|
|
@ -0,0 +1,481 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
program shell;
|
||||
const EDITORPROG = '#SYSTEM:editor.prog';
|
||||
COMPILERPROG = '#SYSTEM:pcomp.prog';
|
||||
ASMPROG = '#SYSTEM:sasm.prog';
|
||||
RECLAIMPROG = '#SYSTEM:reclaim.prog';
|
||||
|
||||
const PageMargin = 3;
|
||||
MenuHeight = 6;
|
||||
|
||||
var cmd:char;
|
||||
ShellWorkfile:pathnamestr external;
|
||||
ShellCmd:string[40] external;
|
||||
ShellArg:integer external;
|
||||
|
||||
procedure checkClock;
|
||||
var line:string;
|
||||
digits:string[4];
|
||||
error:integer;
|
||||
yy,mm,dd,h,m,s:integer;
|
||||
isValid:boolean;
|
||||
|
||||
function lineIsValid:boolean;
|
||||
var c:char;
|
||||
begin
|
||||
lineIsValid := false;
|
||||
|
||||
if length(line) = 14 then
|
||||
begin
|
||||
for c in line do
|
||||
if not isDigit(c) then
|
||||
break;
|
||||
lineIsValid := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function isInRange(v,lo,hi:integer):boolean;
|
||||
begin
|
||||
isInRange := (v>=lo) and (v<=hi);
|
||||
end;
|
||||
|
||||
begin
|
||||
if SysClock.year = 0 then
|
||||
begin
|
||||
writeln('System clock not set - please enter date and time:');
|
||||
repeat
|
||||
isValid := false;
|
||||
write('YYYYMMDDHHMMSS> ');
|
||||
readln(line);
|
||||
|
||||
if lineIsValid then
|
||||
begin
|
||||
isValid := true;
|
||||
digits := copy(line,1,4);
|
||||
val(digits, yy, error);
|
||||
isValid := isValid and isInRange(yy, 1950, 3000);
|
||||
|
||||
digits := copy(line,5,2);
|
||||
val(digits, mm, error);
|
||||
isValid := isValid and isInRange(mm, 1, 12);
|
||||
|
||||
digits := copy(line,7,2);
|
||||
val(digits, dd, error);
|
||||
isValid := isValid and isInRange(dd, 1, 31);
|
||||
|
||||
digits := copy(line,9,2);
|
||||
val(digits, h, error);
|
||||
isValid := isValid and isInRange(h, 0, 23);
|
||||
|
||||
digits := copy(line,11,2);
|
||||
val(digits, m, error);
|
||||
isValid := isValid and isInRange(m, 0, 59);
|
||||
|
||||
digits := copy(line,13,2);
|
||||
val(digits, s, error);
|
||||
isValid := isValid and isInRange(s, 0, 59);
|
||||
end;
|
||||
until isValid;
|
||||
|
||||
SysClock.year := yy;
|
||||
SysClock.month := mm;
|
||||
SysClock.day := dd;
|
||||
SysClock.hours := h;
|
||||
SysClock.minutes := m;
|
||||
SysClock.seconds := s;
|
||||
|
||||
writeln('System clock is ', DateStr(SysClock), ' ', TimeStr(SysClock, true));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure writew(s:string;width:integer);
|
||||
var w,i:integer;
|
||||
begin
|
||||
write(s);
|
||||
w := width - length(s);
|
||||
if w > 0 then
|
||||
for i := 1 to w do
|
||||
write(' ');
|
||||
end;
|
||||
|
||||
procedure splitFilename(var n:filenamestr;
|
||||
var basename:filenamestr;var extension:filenamestr);
|
||||
var i:integer;
|
||||
begin
|
||||
for i := length(n) downto 1 do
|
||||
begin
|
||||
if n[i] = '.' then
|
||||
break;
|
||||
end;
|
||||
if i > 1 then
|
||||
begin
|
||||
basename := copy(n, 1, i - 1);
|
||||
extension := copy(n, i, length(n) - i + 1);
|
||||
{ writeln('** splitFilename ',basename, ' ', extension); }
|
||||
end
|
||||
else
|
||||
begin
|
||||
basename := n;
|
||||
extension := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
function replaceExtension(var n:pathnamestr; newExt:filenamestr):pathnamestr;
|
||||
var basename:filenamestr;
|
||||
ext:filenamestr;
|
||||
begin
|
||||
splitFilename(n, basename, ext);
|
||||
replaceExtension := basename + newExt;
|
||||
end;
|
||||
|
||||
procedure waitForKey; forward;
|
||||
|
||||
procedure listDirectory;
|
||||
var volid:integer;
|
||||
error:integer;
|
||||
index:integer;
|
||||
dirs:DirectorySlot;
|
||||
ftime:DateTime;
|
||||
screenW,screenH:integer;
|
||||
count:integer;
|
||||
begin
|
||||
GetTermSize(screenW, screenH);
|
||||
|
||||
volid := findvolume(DefaultVolume);
|
||||
if volid < 1 then
|
||||
writeln('Volume ', DefaultVolume, ' not found.')
|
||||
else
|
||||
begin
|
||||
count := PageMargin;
|
||||
|
||||
writeln('reading directory of ', DefaultVolume);
|
||||
openvolumeid(volid);
|
||||
readdirfirst(volid, index, dirs, error);
|
||||
while index > 0 do
|
||||
begin
|
||||
if dirs.modTime = 0 then
|
||||
begin
|
||||
ftime.year := 1970;
|
||||
ftime.month := 1;
|
||||
ftime.day := 1;
|
||||
ftime.hours := 0;
|
||||
ftime.minutes := 0;
|
||||
ftime.seconds := 0;
|
||||
end
|
||||
else
|
||||
ftime := GetDateTime(dirs.modTime);
|
||||
writew(dirs.name, 34);
|
||||
writew(DateStr(ftime) + ' ' + TimeStr(ftime,false), 22);
|
||||
writeln(dirs.sizeBytes:12, ' ', dirs.generation);
|
||||
|
||||
count := count + 1;
|
||||
if count >= screenH then
|
||||
begin
|
||||
count := PageMargin;
|
||||
waitForKey;
|
||||
end;
|
||||
|
||||
readdirnext(volid, index, dirs, error);
|
||||
end;
|
||||
closevolumeid(volid);
|
||||
|
||||
if count + MenuHeight >= screenH then
|
||||
waitForKey;
|
||||
end;
|
||||
end;
|
||||
|
||||
function volumeExists(var n:volumenamestr):boolean;
|
||||
var volid:integer;
|
||||
begin
|
||||
volid := findvolume(n);
|
||||
if volid < 1 then
|
||||
volumeExists := false
|
||||
else
|
||||
begin
|
||||
closevolumeid(volid);
|
||||
volumeExists := true;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure listVolumes;
|
||||
var i:integer;
|
||||
begin
|
||||
InitDevices;
|
||||
writeln('Available volumes:');
|
||||
for i := 1 to VolumeCount do
|
||||
writeln(VolumeTable[i].part.name);
|
||||
end;
|
||||
|
||||
procedure changeVolume;
|
||||
var n:volumenamestr;
|
||||
begin
|
||||
listVolumes;
|
||||
write('Enter volume name: ');
|
||||
readln(n);
|
||||
if length(n) > 0 then
|
||||
if volumeExists(n) then
|
||||
SetDefaultVolume(n)
|
||||
else
|
||||
writeln('Volume ', n , ' not found.');
|
||||
end;
|
||||
|
||||
procedure removeFile;
|
||||
var n:filenamestr;
|
||||
error:integer;
|
||||
begin
|
||||
write('File to delete: ');
|
||||
readln(n);
|
||||
|
||||
if length(n) > 0 then
|
||||
begin
|
||||
erase(n, error);
|
||||
|
||||
if error <> 0 then
|
||||
writeln('Error deleting ', n, ': ', ErrorStr(error));
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure renameFile;
|
||||
var n1,n2:filenamestr;
|
||||
error:integer;
|
||||
begin
|
||||
write('File to rename: ');
|
||||
readln(n1);
|
||||
write('New name: ');
|
||||
readln(n2);
|
||||
rename(n1, n2, error);
|
||||
|
||||
if error <> 0 then
|
||||
writeln('Error renaming ', n1, ': ', ErrorStr(error));
|
||||
end;
|
||||
|
||||
procedure copyFile;
|
||||
var n1,n2:filenamestr;
|
||||
error:integer;
|
||||
src,dst:file;
|
||||
ch:char;
|
||||
count:integer;
|
||||
begin
|
||||
write('File to copy: ');
|
||||
readln(n1);
|
||||
write('New file name: ');
|
||||
readln(n2);
|
||||
|
||||
open(src, n1, ModeReadonly);
|
||||
if IOResult(src) <> 0 then
|
||||
begin
|
||||
writeln('Error opening ', n1, ': ', ErrorStr(IOResult(src)));
|
||||
exit;
|
||||
end;
|
||||
|
||||
open(dst, n2, ModeCreate);
|
||||
if IOResult(dst) <> 0 then
|
||||
begin
|
||||
writeln('Error opening ', n2, ': ', ErrorStr(IOResult(dst)));
|
||||
close(src);
|
||||
exit;
|
||||
end;
|
||||
|
||||
write('Copying ',n1, ' to ', n2, '...');
|
||||
count := 0;
|
||||
while not eof(src) do
|
||||
begin
|
||||
read(src,ch); (* not efficient but keep it simple *)
|
||||
write(dst,ch);
|
||||
count := count + 1;
|
||||
if (count and 8191) = 0 then write('.');
|
||||
end;
|
||||
|
||||
close(dst);
|
||||
close(src);
|
||||
|
||||
writeln;
|
||||
end;
|
||||
|
||||
procedure setWorkfile;
|
||||
var n:filenamestr;
|
||||
begin
|
||||
write('Enter workfile name: ');
|
||||
readln(n);
|
||||
|
||||
ShellWorkfile := n;
|
||||
ShellCmd := '';
|
||||
ShellArg := 0;
|
||||
end;
|
||||
|
||||
procedure requireWorkfile;
|
||||
begin
|
||||
while length(ShellWorkFile) = 0 do
|
||||
setWorkfile;
|
||||
end;
|
||||
|
||||
procedure edit(gotoLine:integer);
|
||||
var error:integer;
|
||||
digits:string[10];
|
||||
args:PArgVec;
|
||||
begin
|
||||
requireWorkfile;
|
||||
if gotoLine > 0 then
|
||||
begin
|
||||
str(gotoLine,digits);
|
||||
args[0] := '-l';
|
||||
args[1] := digits;
|
||||
args[2] := ShellWorkFile;
|
||||
PExec(EDITORPROG, args, 3, error);
|
||||
end
|
||||
else
|
||||
PExec2(EDITORPROG, ShellWorkFile, error);
|
||||
writeln('PExec error ', error);
|
||||
end;
|
||||
|
||||
procedure assemble;
|
||||
var filename:filenamestr;
|
||||
error:integer;
|
||||
begin
|
||||
requireWorkfile;
|
||||
filename := replaceExtension(ShellWorkFile, '.s');
|
||||
PExec2(ASMPROG, filename, error);
|
||||
writeln('PExec error ', error);
|
||||
end;
|
||||
|
||||
procedure compile;
|
||||
var filename:filenamestr;
|
||||
error:integer;
|
||||
begin
|
||||
requireWorkfile;
|
||||
filename := replaceExtension(ShellWorkFile, '.pas');
|
||||
PExec3(COMPILERPROG, '-S', filename, error);
|
||||
writeln('PExec error ', error);
|
||||
end;
|
||||
|
||||
procedure build;
|
||||
var filename:filenamestr;
|
||||
error:integer;
|
||||
begin
|
||||
requireWorkfile;
|
||||
filename := replaceExtension(ShellWorkFile, '.pas');
|
||||
PExec2(COMPILERPROG, filename, error);
|
||||
writeln('PExec error ', error);
|
||||
end;
|
||||
|
||||
procedure run;
|
||||
var args:PArgVec;
|
||||
error:integer;
|
||||
prgname:pathnamestr;
|
||||
begin
|
||||
requireWorkfile;
|
||||
prgname := replaceExtension(ShellWorkfile, '.prog');
|
||||
writeln('Running ', prgname);
|
||||
PExec(prgname, args, 0, error);
|
||||
writeln('Pexec failed, error ', error);
|
||||
end;
|
||||
|
||||
procedure krunch;
|
||||
var error:integer;
|
||||
begin
|
||||
PExec2(RECLAIMPROG, DefaultVolume, error);
|
||||
writeln('PExec error ', error);
|
||||
end;
|
||||
|
||||
procedure runProgram;
|
||||
var args:PArgVec;
|
||||
argCount:integer;
|
||||
error:integer;
|
||||
prgname:pathnamestr;
|
||||
a:string;
|
||||
begin
|
||||
write('Enter program file name: ');
|
||||
readln(prgname);
|
||||
|
||||
if length(prgname) > 0 then
|
||||
begin
|
||||
if pos('.', prgname) = 0 then prgname := prgname + '.prog';
|
||||
|
||||
writeln('Enter program arguments line-by-line, empty line to finish.');
|
||||
|
||||
(* entering the arguments line by line is ugly, but it saves us from
|
||||
the hassle of dealing with word boundary detection and quoting *)
|
||||
argCount := 0;
|
||||
repeat
|
||||
write('arg ', argCount + 1, ': ');
|
||||
readln(a);
|
||||
if length(a) > 0 then
|
||||
begin
|
||||
args[argCount] := a;
|
||||
argCount := argCount + 1;
|
||||
end;
|
||||
until (length(a) = 0) or (argCount > PArgMax);
|
||||
|
||||
writeln('Running ', prgname);
|
||||
PExec(prgname, args, argCount, error);
|
||||
writeln('Pexec failed, error ', error);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure showMenu;
|
||||
begin
|
||||
writeln;
|
||||
writeln('W)orkfile: ', ShellWorkfile);
|
||||
writeln('V)olume: ', DefaultVolume);
|
||||
writeln('L)ist directory K)runch volume O)ther program');
|
||||
writeln('D)elete file RenaM)e file coP)y file');
|
||||
writeln('E)dit C)ompile A)ssemble B)uild R)un');
|
||||
write('> ');
|
||||
end;
|
||||
|
||||
procedure command(cmd:char;arg:integer);
|
||||
begin
|
||||
case cmd of
|
||||
'L': listDirectory;
|
||||
'V': changeVolume;
|
||||
'W': setWorkfile;
|
||||
'R': run;
|
||||
'A': assemble;
|
||||
'C': compile;
|
||||
'B': build;
|
||||
'E': edit(arg);
|
||||
'D': removeFile;
|
||||
'M': renameFile;
|
||||
'P': copyFile;
|
||||
'K': krunch;
|
||||
'O': runProgram;
|
||||
else ;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure waitForKey;
|
||||
var c:char;
|
||||
begin
|
||||
writeln;
|
||||
writeln('-- press any key to continue --');
|
||||
c := conin;
|
||||
end;
|
||||
|
||||
begin
|
||||
if length(DefaultVolume) = 0 then
|
||||
SetDefaultVolume('SYSTEM');
|
||||
|
||||
checkClock;
|
||||
|
||||
if length(ShellCmd) > 0 then
|
||||
begin
|
||||
if ShellCmd[1] = 'W' then
|
||||
begin
|
||||
waitForKey;
|
||||
delete(Shellcmd,1,1);
|
||||
end;
|
||||
|
||||
if length(ShellCmd) > 0 then
|
||||
command(ShellCmd[1], ShellArg);
|
||||
|
||||
ShellCmd := '';
|
||||
end;
|
||||
|
||||
while true do
|
||||
begin
|
||||
showMenu;
|
||||
read(cmd);
|
||||
writeln;
|
||||
command(Upcase(cmd), ShellArg);
|
||||
end;
|
||||
end.
|
||||
431
progs/xfer.pas
Normal file
431
progs/xfer.pas
Normal file
|
|
@ -0,0 +1,431 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
program xfer;
|
||||
|
||||
const CksumPattern = $AFFECAFE;
|
||||
SOH = #1;
|
||||
STX = #2;
|
||||
EOT = #4;
|
||||
ENQ = #5;
|
||||
ACK = #6;
|
||||
BEL = #7;
|
||||
NAK = #21;
|
||||
|
||||
TimeoutTicks = 200;
|
||||
|
||||
var blockNo:integer;
|
||||
buf:^string;
|
||||
invalid:boolean;
|
||||
cmd:char;
|
||||
filename:string;
|
||||
size:integer;
|
||||
done:boolean;
|
||||
xferFile:file;
|
||||
|
||||
function calcChksum(last,this:integer):integer;
|
||||
begin
|
||||
calcChksum := ((last + this) xor CksumPattern) shl 1;
|
||||
end;
|
||||
|
||||
function readword:integer;
|
||||
var b3,b2,b1,b0:char;
|
||||
begin
|
||||
b3 := conin;
|
||||
b2 := conin;
|
||||
b1 := conin;
|
||||
b0 := conin;
|
||||
|
||||
readword := (ord(b3) shl 24) or
|
||||
(ord(b2) shl 16) or
|
||||
(ord(b1) shl 8) or
|
||||
ord(b0);
|
||||
end;
|
||||
|
||||
procedure serReadBlock(var success:boolean);
|
||||
var w0,w1,w2,w3,w4,w5,w6,w7,w8:integer;
|
||||
chksum:integer;
|
||||
s:integer;
|
||||
|
||||
procedure writeByte(b:char);
|
||||
begin
|
||||
if size <> 0 then
|
||||
begin
|
||||
write(xferFile,b);
|
||||
size := size - 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure appendWordToFile(w:integer);
|
||||
var b3,b2,b1,b0:char;
|
||||
begin
|
||||
b0 := chr(w and 255);
|
||||
w := w shr 8;
|
||||
|
||||
b1 := chr(w and 255);
|
||||
w := w shr 8;
|
||||
|
||||
b2 := chr(w and 255);
|
||||
w := w shr 8;
|
||||
|
||||
b3 := chr(w);
|
||||
|
||||
writeByte(b3);
|
||||
writeByte(b2);
|
||||
writeByte(b1);
|
||||
writeByte(b0);
|
||||
end;
|
||||
|
||||
procedure calcChksum(d:integer);
|
||||
begin
|
||||
chksum := ((chksum + d) xor CksumPattern) shl 1;
|
||||
end;
|
||||
|
||||
begin
|
||||
chksum := 0;
|
||||
|
||||
w0 := readword;
|
||||
w1 := readword;
|
||||
w2 := readword;
|
||||
w3 := readword;
|
||||
w4 := readword;
|
||||
w5 := readword;
|
||||
w6 := readword;
|
||||
w7 := readword;
|
||||
|
||||
s := readword;
|
||||
|
||||
calcChksum(w0);
|
||||
calcChksum(w1);
|
||||
calcChksum(w2);
|
||||
calcChksum(w3);
|
||||
calcChksum(w4);
|
||||
calcChksum(w5);
|
||||
calcChksum(w6);
|
||||
calcChksum(w7);
|
||||
|
||||
if s <> chksum then
|
||||
begin
|
||||
success := false;
|
||||
write(NAK);
|
||||
{ writeln('invalid chksum ', s, ' ', chksum); }
|
||||
end
|
||||
else
|
||||
begin
|
||||
success := true;
|
||||
appendWordToFile(w0);
|
||||
appendWordToFile(w1);
|
||||
appendWordToFile(w2);
|
||||
appendWordToFile(w3);
|
||||
appendWordToFile(w4);
|
||||
appendWordToFile(w5);
|
||||
appendWordToFile(w6);
|
||||
appendWordToFile(w7);
|
||||
blockNo := blockNo + 1;
|
||||
write(ACK);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure waitForByte(var byteReceived:char; var timeoutReached:boolean);
|
||||
var ticks:integer;
|
||||
done:boolean;
|
||||
begin
|
||||
timeoutReached := true;
|
||||
ticks := getticks;
|
||||
done := false;
|
||||
|
||||
repeat
|
||||
if conavail then
|
||||
begin
|
||||
done := true;
|
||||
timeoutReached := false;
|
||||
byteReceived := conin;
|
||||
end;
|
||||
until done or (getticks > ticks + TimeoutTicks);
|
||||
end;
|
||||
|
||||
procedure waitForHeader(var invalid:boolean);
|
||||
var done:boolean;
|
||||
timedOut:boolean;
|
||||
ch:char;
|
||||
begin
|
||||
waitForByte(ch, timedOut);
|
||||
invalid := (ch <> STX) or timedOut;
|
||||
end;
|
||||
|
||||
procedure receiveHeader(var invalid:boolean);
|
||||
var ch:char;
|
||||
timedOut:boolean;
|
||||
w:integer;
|
||||
cksum:integer;
|
||||
begin
|
||||
{ send protocol version, then wait for size header }
|
||||
write('1');
|
||||
|
||||
waitForByte(ch, timedOut);
|
||||
if timedOut or (ch <> SOH) then
|
||||
begin
|
||||
invalid := true;
|
||||
exit;
|
||||
end;
|
||||
|
||||
cksum := 0;
|
||||
|
||||
w := readword;
|
||||
cksum := readword;
|
||||
|
||||
if w <> (not cksum) then
|
||||
begin
|
||||
write(NAK);
|
||||
w := 0;
|
||||
writeln('h chksum error');
|
||||
end
|
||||
else
|
||||
write(ACK);
|
||||
|
||||
if w > 0 then
|
||||
begin
|
||||
size := w;
|
||||
waitForHeader(invalid);
|
||||
end
|
||||
else
|
||||
invalid := true;
|
||||
end;
|
||||
|
||||
procedure receiveFile;
|
||||
var ch:char;
|
||||
invalid, timedOut:boolean;
|
||||
ok:boolean;
|
||||
done:boolean;
|
||||
errorCount:integer;
|
||||
begin
|
||||
if length(filename) = 0 then
|
||||
begin
|
||||
writeln('Filename not set.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
errorCount := 0;
|
||||
|
||||
waitForByte(ch, timedOut);
|
||||
if timedOut then
|
||||
begin
|
||||
writeln('Timeout waiting for transmission start (ENQ or STX).');
|
||||
exit;
|
||||
end;
|
||||
|
||||
if ch = ENQ then
|
||||
receiveHeader(invalid)
|
||||
else
|
||||
if ch = STX then
|
||||
begin
|
||||
size := -1;
|
||||
invalid := false;
|
||||
end
|
||||
else
|
||||
invalid := true;
|
||||
|
||||
if not invalid then
|
||||
begin
|
||||
open(xferFile, filename, ModeOverwrite);
|
||||
done := false;
|
||||
repeat
|
||||
serReadBlock(ok);
|
||||
if not ok then errorCount := errorCount + 1;
|
||||
|
||||
waitForByte(ch, timedOut);
|
||||
if timedOut then
|
||||
writeln('Timeout waiting for next block (STX)');
|
||||
if ch = EOT then
|
||||
done := true
|
||||
else
|
||||
if ch <> STX then
|
||||
begin
|
||||
writeln('Invalid header byte (expected STX)');
|
||||
done := true;
|
||||
end;
|
||||
until done or timedOut;
|
||||
|
||||
close(xferFile);
|
||||
|
||||
writeln(blockNo, ' blocks received, ', errorCount, ' checksum errors. ', ord(ch));
|
||||
end
|
||||
else
|
||||
writeln('Invalid or no header received.', size);
|
||||
end;
|
||||
|
||||
function getWordFromFile:integer;
|
||||
|
||||
function getCharFromFile:integer;
|
||||
var c:char;
|
||||
begin
|
||||
if size > 0 then
|
||||
begin
|
||||
read(xferFile,c);
|
||||
size := size - 1;
|
||||
end
|
||||
else
|
||||
c := #0;
|
||||
|
||||
getCharFromFile := ord(c);
|
||||
end;
|
||||
|
||||
begin
|
||||
getWordFromFile := getCharFromFile shl 8;
|
||||
getWordFromFile := (getWordFromFile or getCharFromFile) shl 8;
|
||||
getWordFromFile := (getWordFromFile or getCharFromFile) shl 8;
|
||||
getWordFromFile := (getWordFromFile or getCharFromFile);
|
||||
end;
|
||||
|
||||
procedure sendword(w:integer);
|
||||
var b3,b2,b1,b0:char;
|
||||
begin
|
||||
b0 := chr(w and 255);
|
||||
w := w shr 8;
|
||||
|
||||
b1 := chr(w and 255);
|
||||
w := w shr 8;
|
||||
|
||||
b2 := chr(w and 255);
|
||||
w := w shr 8;
|
||||
|
||||
b3 := chr(w and 255);
|
||||
|
||||
write(b3,b2,b1,b0);
|
||||
end;
|
||||
|
||||
procedure sendFile;
|
||||
var ch:char;
|
||||
w,cksum:integer;
|
||||
wordCount:integer;
|
||||
lastSize,lastPos:integer;
|
||||
timedOut:boolean;
|
||||
done:boolean;
|
||||
begin
|
||||
if length(filename) = 0 then
|
||||
begin
|
||||
writeln('Filename not set.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ wait for start byte }
|
||||
ch := conin;
|
||||
if ch <> BEL then
|
||||
begin
|
||||
writeln('Invalid start character received.');
|
||||
exit;
|
||||
end;
|
||||
|
||||
open(xferFile, filename, ModeReadonly);
|
||||
if IOResult(xferFile) <> 0 then
|
||||
begin
|
||||
writeln('Error opening file: ', ErrorStr(IOResult(xferFile)));
|
||||
exit;
|
||||
end;
|
||||
|
||||
size := filesize(xferFile);
|
||||
done := false;
|
||||
|
||||
{ send size header: SOH, size word, inverted size word }
|
||||
write(SOH);
|
||||
sendword(size);
|
||||
sendword(not size);
|
||||
|
||||
{ check for ACK }
|
||||
waitForByte(ch, timedOut);
|
||||
|
||||
if timedOut then
|
||||
writeln('Timeout sending size header ')
|
||||
else
|
||||
if ch <> ACK then
|
||||
writeln('Error sending size header ', ord(ch))
|
||||
else
|
||||
repeat
|
||||
lastPos := filepos(xferFile);
|
||||
lastSize := size;
|
||||
|
||||
write(STX);
|
||||
{ send a block: STX, 8 words, checksum word }
|
||||
cksum := 0;
|
||||
for wordCount := 1 to 8 do
|
||||
begin
|
||||
w := getWordFromFile;
|
||||
cksum := calcChkSum(cksum, w);
|
||||
sendword(w);
|
||||
end;
|
||||
sendword(cksum);
|
||||
|
||||
{ check for ACK/NAK }
|
||||
waitForByte(ch, timedOut);
|
||||
if timedOut then
|
||||
begin
|
||||
writeln('Timeout waiting for ACK');
|
||||
done := true;
|
||||
end
|
||||
else
|
||||
if ch = NAK then
|
||||
begin
|
||||
seek(xferFile, lastPos);
|
||||
size := lastSize;
|
||||
end
|
||||
else
|
||||
if ch = ACK then
|
||||
begin
|
||||
if size = 0 then done := true;
|
||||
end
|
||||
else
|
||||
begin
|
||||
writeln('Invalid reply after sending block');
|
||||
done := true;
|
||||
end;
|
||||
until done;
|
||||
write(EOT);
|
||||
close(xferFile);
|
||||
end;
|
||||
|
||||
procedure setFilename;
|
||||
begin
|
||||
write('Filename> ');
|
||||
readln(filename);
|
||||
end;
|
||||
|
||||
procedure listDirectory;
|
||||
var volid:integer;
|
||||
error:integer;
|
||||
index:integer;
|
||||
dirs:DirectorySlot;
|
||||
begin
|
||||
volid := findvolume(DefaultVolume);
|
||||
if volid < 1 then
|
||||
writeln('Volume ', DefaultVolume, ' not found.')
|
||||
else
|
||||
begin
|
||||
openvolumeid(volid);
|
||||
readdirfirst(volid, index, dirs, error);
|
||||
while (index > 0) and (error = 0) do
|
||||
begin
|
||||
writeln(dirs.name);
|
||||
readdirnext(volid, index, dirs, error);
|
||||
end;
|
||||
end;
|
||||
writeln;
|
||||
end;
|
||||
|
||||
begin
|
||||
writeln('L) upload (receive) D) download (send).');
|
||||
writeln('S) set filename Y) directory X) exit');
|
||||
|
||||
done := false;
|
||||
|
||||
repeat
|
||||
write('> ');
|
||||
read(cmd);
|
||||
writeln;
|
||||
case upcase(cmd) of
|
||||
'L': receiveFile;
|
||||
'D': sendFile;
|
||||
'S': setFilename;
|
||||
'X': done := true;
|
||||
'Y': listDirectory;
|
||||
else writeln('?');
|
||||
end;
|
||||
until done;
|
||||
end.
|
||||
8
tests/cchangetest.pas
Normal file
8
tests/cchangetest.pas
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
program cchangetest;
|
||||
var c:char;
|
||||
begin
|
||||
repeat
|
||||
writeln('cardchanged: ', cardchanged);
|
||||
read(c);
|
||||
until c = #27;
|
||||
end.
|
||||
12
tests/readchartest.pas
Normal file
12
tests/readchartest.pas
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
program readchartest;
|
||||
var c:char;
|
||||
kbd:file;
|
||||
begin
|
||||
open(kbd, '%KBD', ModeReadonly);
|
||||
while true do
|
||||
begin
|
||||
read(kbd, c);
|
||||
writeln(ord(c));
|
||||
end;
|
||||
close(kbd);
|
||||
end.
|
||||
25
tests/readtest.pas
Normal file
25
tests/readtest.pas
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
program readtest;
|
||||
var filename:string;
|
||||
buf:char;
|
||||
f:file;
|
||||
count:integer;
|
||||
t:DateTime;
|
||||
begin
|
||||
write('Enter filename: ');
|
||||
readln(filename);
|
||||
|
||||
t := GetTime;
|
||||
writeln('start:', TimeStr(t, true));
|
||||
open(f, filename, ModeReadOnly);
|
||||
|
||||
count := 0;
|
||||
while not eof(f) do
|
||||
begin
|
||||
read(f,buf);
|
||||
count := count + 1;
|
||||
end;
|
||||
close(f);
|
||||
t := GetTime;
|
||||
writeln('end:', TimeStr(t, true));
|
||||
writeln(count, ' bytes read.');
|
||||
end.
|
||||
111
tests/test109.pas
Normal file
111
tests/test109.pas
Normal file
|
|
@ -0,0 +1,111 @@
|
|||
program test109;
|
||||
|
||||
const screenwidth = 640;
|
||||
screenheight = 400;
|
||||
screenmidx = 319;
|
||||
screenmidy = 199;
|
||||
|
||||
xrange = 14.0;
|
||||
yrange = 3.0;
|
||||
|
||||
xmin = -7.0;
|
||||
xmax = 7.0;
|
||||
ymin = -1.5;
|
||||
ymax = 1.5;
|
||||
|
||||
xstep = 0.005;
|
||||
|
||||
|
||||
var scalex,scaley: real;
|
||||
value:real;
|
||||
curx:real;
|
||||
|
||||
testcounter:integer;
|
||||
|
||||
function screenx(x:real):integer;
|
||||
begin
|
||||
screenx := trunc((x + xmax) * scalex);
|
||||
{ writeln(x, ' -x-> ', screenx);}
|
||||
end;
|
||||
|
||||
function screeny(y:real):integer;
|
||||
begin
|
||||
screeny := trunc((ymax - y) * scaley);
|
||||
{ writeln(y, ' -y-> ', screeny); }
|
||||
end;
|
||||
|
||||
procedure drawCoords;
|
||||
begin
|
||||
drawline(screenx(xmin), screeny(0), screenx(xmax), screeny(0), 8);
|
||||
drawline(screenx(0), screeny(ymin), screenx(0), screeny(ymax), 8);
|
||||
end;
|
||||
|
||||
procedure plot(x,y:real;nr:integer);
|
||||
begin
|
||||
if (x>=xmin) and (x<=xmax)
|
||||
and (y>=ymin) and (y<=ymax) then
|
||||
putpixel( screenx(x), screeny(y), 3 + nr);
|
||||
end;
|
||||
|
||||
procedure test(x:real; delta:real);
|
||||
begin
|
||||
writeln('-----------test-----------------');
|
||||
end;
|
||||
|
||||
function squareroot(x:real):real;
|
||||
begin
|
||||
if x = 0.0 then
|
||||
squareroot := 0.0
|
||||
else
|
||||
squareroot := sqrt(x);
|
||||
end;
|
||||
|
||||
function logn(x:real):real;
|
||||
begin
|
||||
if x <= 0.0 then
|
||||
logn := 0.0
|
||||
else
|
||||
logn := ln(x);
|
||||
end;
|
||||
|
||||
function dafunc(x:real;nr:integer):real;
|
||||
begin
|
||||
{
|
||||
testcounter := testcounter + 1;
|
||||
if testcounter = 20 then
|
||||
test(x, xstep); }
|
||||
{ writeln('dafunc ', testcounter, ' x:', x, ' + 0.1:', x + 0.1); }
|
||||
case nr of
|
||||
0: dafunc := sin(x);
|
||||
1: dafunc := cos(x);
|
||||
2: dafunc := arctan(x);
|
||||
3: dafunc := tan(x);
|
||||
4: dafunc := cotan(x);
|
||||
5: dafunc := logn(x);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure graph(nr:integer);
|
||||
begin
|
||||
curx := xmin;
|
||||
{ curx := 0.0; }
|
||||
while curx < xmax do
|
||||
begin
|
||||
value := dafunc(curx, nr);
|
||||
plot(curx, value, nr);
|
||||
curx := curx + xstep;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
initgraphics;
|
||||
scalex := screenwidth / xrange;
|
||||
scaley := screenheight / yrange;
|
||||
drawCoords;
|
||||
graph(0);
|
||||
graph(1);
|
||||
graph(2);
|
||||
graph(3);
|
||||
graph(4);
|
||||
graph(5);
|
||||
end.
|
||||
17
tests/test133.pas
Normal file
17
tests/test133.pas
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
program test133;
|
||||
var f:file;
|
||||
buf:string;
|
||||
begin
|
||||
open(f, 'newfile.text', ModeOverwrite);
|
||||
writeln(f,'This is a test file created by a Pascal program.');
|
||||
writeln(f,'There is nothing else of interest here.');
|
||||
close(f);
|
||||
|
||||
open(f, 'newfile.text', ModeReadonly);
|
||||
while not eof(f) do
|
||||
begin
|
||||
readln(f,buf);
|
||||
writeln(buf);
|
||||
end;
|
||||
close(f);
|
||||
end.
|
||||
28
tests/test159.pas
Normal file
28
tests/test159.pas
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
program test159;
|
||||
var s:string[131072];
|
||||
i:integer;
|
||||
c:char;
|
||||
buf:string;
|
||||
begin
|
||||
writeln('creating test string...');
|
||||
c := 'A';
|
||||
for i := 1 to maxlength(s) do
|
||||
begin
|
||||
appendchar(s,c);
|
||||
c := succ(c);
|
||||
if c = 'z' then
|
||||
c := 'A';
|
||||
end;
|
||||
|
||||
writeln('string length: ', length(s));
|
||||
|
||||
writeln(s[1], s[2], s[3]);
|
||||
|
||||
writeln('moving stuff...');
|
||||
repeat
|
||||
write('>');
|
||||
readln(buf);
|
||||
strmoveup(s, 1,100000,1);
|
||||
writeln(s[1], s[2], s[3]);
|
||||
until buf = 'x';
|
||||
end.
|
||||
12
tests/timetest.pas
Normal file
12
tests/timetest.pas
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
program timetest;
|
||||
var time:DateTime;
|
||||
begin
|
||||
while true do
|
||||
begin
|
||||
writeln('ticks: ', GetTicks);
|
||||
time := GetTime;
|
||||
writeln('h:', time.hours, ' m:', time.minutes, ' s:', time.seconds);
|
||||
writeln(DateStr(time), ' ', TimeStr(time,true));
|
||||
readln;
|
||||
end;
|
||||
end.
|
||||
479
tests/tree.pas
Normal file
479
tests/tree.pas
Normal file
|
|
@ -0,0 +1,479 @@
|
|||
program tree;
|
||||
type TreedataType = (TDString, TDInteger);
|
||||
type Treedata = record
|
||||
case typ:Treedatatype of
|
||||
TDString:(stringdata:string);
|
||||
TDInteger:(intdata:integer);
|
||||
end;
|
||||
type TreeNode = record
|
||||
parent: ^TreeNode;
|
||||
left,right: ^TreeNode;
|
||||
height: integer;
|
||||
key: ^string;
|
||||
data: ^Treedata;
|
||||
end;
|
||||
|
||||
type TreeRef = ^TreeNode;
|
||||
|
||||
type TreeWalkState = record
|
||||
currentNode:TreeRef;
|
||||
end;
|
||||
|
||||
var t:TreeRef;
|
||||
k:string;
|
||||
d:TreeData;
|
||||
i:integer;
|
||||
searchres:^Treedata;
|
||||
walkState:TreeWalkState;
|
||||
walkRes:TreeRef;
|
||||
|
||||
procedure mem_dump; external;
|
||||
|
||||
function makeTreeNode(var d:TreeData;var key:string;nparent:TreeRef):TreeRef;
|
||||
var newNode:TreeRef;
|
||||
newKey:^string;
|
||||
begin
|
||||
new(newNode);
|
||||
new(newKey,length(key));
|
||||
{ new(newKey); }
|
||||
new(newNode^.data);
|
||||
newKey^ := key;
|
||||
with newNode^ do
|
||||
begin
|
||||
key := newKey;
|
||||
parent := nparent;
|
||||
left := nil;
|
||||
right := nil;
|
||||
height := 1;
|
||||
data^ := d;
|
||||
end;
|
||||
makeTreeNode := newNode;
|
||||
end;
|
||||
|
||||
function MeasureTree(root:TreeRef):integer;
|
||||
var leftHeight, rightHeight:integer;
|
||||
begin
|
||||
if root = nil then
|
||||
MeasureTree := 0
|
||||
else
|
||||
begin
|
||||
if root^.left <> nil then
|
||||
leftHeight := root^.left^.height
|
||||
else
|
||||
leftHeight := 0;
|
||||
if root^.right <> nil then
|
||||
rightHeight := root^.right^.height
|
||||
else
|
||||
rightHeight := 0;
|
||||
if rightHeight > leftHeight then
|
||||
MeasureTree := rightHeight + 1
|
||||
else
|
||||
MeasureTree := leftHeight + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetTreeBalance(root:TreeRef):integer;
|
||||
begin
|
||||
if root = nil then
|
||||
GetTreeBalance := 0
|
||||
else
|
||||
GetTreeBalance := MeasureTree(root^.left) - MeasureTree(root^.right);
|
||||
end;
|
||||
|
||||
function RotateTreeRight(x:TreeRef):TreeRef;
|
||||
var z,tmp:TreeRef;
|
||||
begin
|
||||
writeln('RotateTreeRight at ', x^.key^);
|
||||
z := x^.left;
|
||||
tmp := z^.right;
|
||||
z^.right := x;
|
||||
z^.parent := x^.parent;
|
||||
x^.parent := z;
|
||||
x^.left := tmp;
|
||||
if tmp <> nil then
|
||||
tmp^.parent := x;
|
||||
x^.height := MeasureTree(x);
|
||||
z^.height := MeasureTree(z);
|
||||
RotateTreeRight := z;
|
||||
end;
|
||||
|
||||
function RotateTreeLeft(x:TreeRef):TreeRef;
|
||||
var z,tmp:TreeRef;
|
||||
begin
|
||||
writeln('RotateTreeLeft at ', x^.key^);
|
||||
z := x^.right;
|
||||
tmp := z^.left;
|
||||
z^.left := x;
|
||||
z^.parent := x^.parent;
|
||||
x^.parent := z;
|
||||
x^.right := tmp;
|
||||
if tmp <> nil then
|
||||
tmp^.parent := x;
|
||||
x^.height := MeasureTree(x);
|
||||
z^.height := MeasureTree(z);
|
||||
RotateTreeLeft := z;
|
||||
end;
|
||||
|
||||
function TreeInsert4(root:TreeRef;var key:string;var data:TreeData;
|
||||
parent:TreeRef):TreeRef;
|
||||
var balance:integer;
|
||||
begin
|
||||
if root = nil then
|
||||
root := makeTreeNode(data, key, parent)
|
||||
else
|
||||
if key < root^.key^ then
|
||||
root^.left := TreeInsert4(root^.left, key, data, root)
|
||||
else
|
||||
root^.right := TreeInsert4(root^.right, key, data, root);
|
||||
|
||||
root^.height := MeasureTree(root);
|
||||
|
||||
balance := GetTreeBalance(root);
|
||||
if balance > 1 then
|
||||
begin
|
||||
if key < root^.left^.key^ then
|
||||
root := RotateTreeRight(root)
|
||||
else
|
||||
begin
|
||||
root^.left := RotateTreeLeft(root^.left);
|
||||
root := RotateTreeRight(root);
|
||||
end;
|
||||
end
|
||||
else
|
||||
if balance < -1 then
|
||||
begin
|
||||
if key > root^.right^.key^ then
|
||||
root := RotateTreeLeft(root)
|
||||
else
|
||||
begin
|
||||
root^.right := RotateTreeRight(root^.right);
|
||||
root := RotateTreeLeft(root);
|
||||
end;
|
||||
end;
|
||||
|
||||
TreeInsert4 := root;
|
||||
end;
|
||||
|
||||
procedure TreeInsert(var root:TreeRef;var key:string;var data:TreeData);
|
||||
begin
|
||||
root := TreeInsert4(root,key,data,nil);
|
||||
end;
|
||||
|
||||
procedure DisposeTreeNode(node:TreeRef);
|
||||
begin
|
||||
dispose(node^.key);
|
||||
dispose(node^.data);
|
||||
dispose(node);
|
||||
end;
|
||||
|
||||
function TreeLeftmost(node:TreeRef):TreeRef;
|
||||
begin
|
||||
TreeLeftmost := nil;
|
||||
if node <> nil then
|
||||
begin
|
||||
repeat
|
||||
TreeLeftmost := node;
|
||||
node := node^.left;
|
||||
until node = nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure PrintTreeRef(node:TreeRef);
|
||||
begin
|
||||
if node = nil then
|
||||
write('nil')
|
||||
else
|
||||
write(node^.key^);
|
||||
end;
|
||||
|
||||
procedure PrintTreeNode(node:TreeRef);
|
||||
begin
|
||||
write(' -');
|
||||
PrintTreeRef(node);
|
||||
if node <> nil then
|
||||
begin
|
||||
write(' ^');
|
||||
PrintTreeRef(node^.parent);
|
||||
write(' <');
|
||||
PrintTreeRef(node^.left);
|
||||
write(' >');
|
||||
PrintTreeRef(node^.right);
|
||||
end;
|
||||
writeln;
|
||||
end;
|
||||
|
||||
function TreeDeleteFn(root:TreeRef;var key:string):TreeRef;
|
||||
var tmp,oldParent:TreeRef;
|
||||
balance:integer;
|
||||
begin
|
||||
if root <> nil then
|
||||
begin
|
||||
if key < root^.key^ then
|
||||
root^.left := TreeDeleteFn(root^.left, key)
|
||||
else
|
||||
if key > root^.key^ then
|
||||
root^.right := TreeDeleteFn(root^.right, key)
|
||||
else
|
||||
begin
|
||||
if root^.left = nil then
|
||||
begin
|
||||
tmp := root;
|
||||
oldParent := root^.parent;
|
||||
root := root^.right;
|
||||
if root <> nil then
|
||||
root^.parent := oldParent;
|
||||
DisposeTreeNode(tmp);
|
||||
end
|
||||
else
|
||||
if root^.right = nil then
|
||||
begin
|
||||
tmp := root;
|
||||
oldParent := root^.parent;
|
||||
root := root^.left;
|
||||
if root <> nil then
|
||||
root^.parent := oldParent;
|
||||
DisposeTreeNode(tmp);
|
||||
end
|
||||
else
|
||||
begin
|
||||
writeln('TreeDelete search leftmost from ', root^.key^);
|
||||
PrintTreeNode(root);
|
||||
tmp := TreeLeftmost(root^.right);
|
||||
if maxlength(tmp^.key^) <> maxlength(root^.key^) then
|
||||
begin (* reallocate key, the swapped key might have a different length *)
|
||||
write('reallocating key ', length(root^.key^));
|
||||
dispose(root^.key);
|
||||
new(root^.key, length(tmp^.key^));
|
||||
writeln(' -> ', maxlength(root^.key^));
|
||||
end;
|
||||
root^.key^ := tmp^.key^;
|
||||
root^.data^ := tmp^.data^;
|
||||
writeln('TreeDelete delete leftmost ', tmp^.key^);
|
||||
PrintTreeNode(tmp);
|
||||
writeln('oldParent: ');
|
||||
PrintTreeNode(tmp^.parent);
|
||||
oldParent := tmp^.parent;
|
||||
if oldParent^.left = tmp then
|
||||
oldParent^.left := TreeDeleteFn(oldParent^.left, tmp^.key^)
|
||||
else
|
||||
if oldParent^.right = tmp then
|
||||
oldParent^.right := TreeDeleteFn(oldParent^.right, tmp^.key^)
|
||||
else
|
||||
writeln('TreeDelete internal error');
|
||||
end;
|
||||
|
||||
if root <> nil then
|
||||
begin
|
||||
root^.height := MeasureTree(root);
|
||||
balance := GetTreeBalance(root);
|
||||
if balance > 1 then
|
||||
begin
|
||||
if GetTreeBalance(root^.left) >=0 then
|
||||
root := RotateTreeRight(root)
|
||||
else
|
||||
begin
|
||||
root^.left := RotateTreeLeft(root^.left);
|
||||
root := RotateTreeRight(root);
|
||||
end;
|
||||
end
|
||||
else
|
||||
if balance < -1 then
|
||||
begin
|
||||
if GetTreeBalance(root^.right) <= 0 then
|
||||
root^.right := RotateTreeLeft(root)
|
||||
else
|
||||
begin
|
||||
root^.right := RotateTreeRight(root^.right);
|
||||
root := RotateTreeLeft(root);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
TreeDeleteFn := root;
|
||||
end;
|
||||
|
||||
procedure TreeDelete(var root:TreeRef;var key:string);
|
||||
begin
|
||||
root := TreeDeleteFn(root,key);
|
||||
end;
|
||||
|
||||
function TreeSearch(root:TreeRef;var key:string):^TreeData;
|
||||
begin
|
||||
if root <> nil then
|
||||
begin
|
||||
if key = root^.key^ then
|
||||
TreeSearch := root^.data
|
||||
else
|
||||
if key < root^.key^ then
|
||||
TreeSearch := TreeSearch(root^.left, key)
|
||||
else
|
||||
TreeSearch := TreeSearch(root^.right, key);
|
||||
end
|
||||
else
|
||||
TreeSearch := nil;
|
||||
end;
|
||||
|
||||
procedure TreeWalkStart(t:TreeRef; var state:TreeWalkState);
|
||||
begin
|
||||
(* start at leftmost node of the tree *)
|
||||
state.currentNode := TreeLeftmost(t);
|
||||
end;
|
||||
|
||||
procedure TreeWalkNext(var state:TreeWalkState;var res:TreeRef);
|
||||
var last,current,old,right:TreeRef;
|
||||
begin
|
||||
current := state.currentNode;
|
||||
|
||||
res := current;
|
||||
|
||||
if current <> nil then
|
||||
begin
|
||||
(* descending right *)
|
||||
if current^.right <> nil then
|
||||
begin
|
||||
state.currentNode := TreeLeftmost(current^.right);
|
||||
end
|
||||
else (* ascending *)
|
||||
begin
|
||||
old := current;
|
||||
repeat
|
||||
last := current;
|
||||
current := current^.parent;
|
||||
if current <> nil then
|
||||
right := current^.right;
|
||||
until (right <> last) or (current = nil); (* ascend left edges *)
|
||||
state.currentNode := current;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure indent(i:integer);
|
||||
var c:integer;
|
||||
begin
|
||||
for c := 1 to i do
|
||||
write(' ');
|
||||
end;
|
||||
|
||||
procedure PrintStringTree(node:TreeRef;level:integer);
|
||||
begin
|
||||
if node <> nil then
|
||||
begin
|
||||
if node^.left <> nil then
|
||||
PrintStringTree(node^.left, level + 1);
|
||||
indent(level);
|
||||
PrintTreeNode(node);
|
||||
if node^.right <> nil then
|
||||
PrintStringTree(node^.right, level + 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoASearch(t:TreeRef; s:string);
|
||||
var res:^TreeData;
|
||||
begin
|
||||
res := TreeSearch(t, s);
|
||||
write('searching for ',s);
|
||||
if res = nil then
|
||||
writeln(' nil')
|
||||
else
|
||||
writeln(res^.stringdata);
|
||||
end;
|
||||
|
||||
begin
|
||||
mem_dump;
|
||||
{
|
||||
t := nil;
|
||||
k := 'test1';
|
||||
d.typ := TDString;
|
||||
d.stringdata := 'data1';
|
||||
TreeInsert(t,k,d);
|
||||
|
||||
k := 'test0';
|
||||
d.typ := TDString;
|
||||
d.stringdata := 'data0';
|
||||
TreeInsert(t,k,d);
|
||||
|
||||
k := 'test3';
|
||||
d.typ := TDString;
|
||||
d.stringdata := 'data3';
|
||||
TreeInsert(t,k,d);
|
||||
|
||||
k := 'test2';
|
||||
d.typ := TDString;
|
||||
d.stringdata := 'data2';
|
||||
TreeInsert(t,k,d);
|
||||
|
||||
k := 'test4';
|
||||
d.typ := TDString;
|
||||
d.stringdata := 'data4';
|
||||
TreeInsert(t,k,d);
|
||||
|
||||
writeln('root: ', t^.key^);
|
||||
|
||||
PrintStringTree(t,1);
|
||||
}
|
||||
writeln('------------');
|
||||
|
||||
t := nil;
|
||||
d.typ := TDString;
|
||||
d.stringdata := 'data';
|
||||
|
||||
for i := 1 to 30 do
|
||||
begin
|
||||
str(i,k);
|
||||
d.stringdata := 'data' + k;
|
||||
k := 'test' + k;
|
||||
TreeInsert(t,k,d);
|
||||
|
||||
if i >99 then
|
||||
begin
|
||||
writeln('root: ', t^.key^);
|
||||
PrintStringTree(t,1);
|
||||
writeln('------------');
|
||||
readln;
|
||||
end;
|
||||
end;
|
||||
|
||||
writeln('root: ', t^.key^);
|
||||
PrintStringTree(t,1);
|
||||
writeln('------------');
|
||||
|
||||
|
||||
DoASearch(t,'test21');
|
||||
DoASearch(t,'test2');
|
||||
DoASearch(t,'test17');
|
||||
|
||||
k := 'test17';
|
||||
TreeDelete(t,k);
|
||||
writeln('root: ', t^.key^);
|
||||
PrintStringTree(t,1);
|
||||
writeln('------------');
|
||||
DoASearch(t,'test17');
|
||||
|
||||
|
||||
|
||||
TreeWalkStart(t, walkState);
|
||||
repeat
|
||||
TreeWalkNext(walkState, walkRes);
|
||||
if walkRes <> nil then
|
||||
writeln(walkRes^.data^.stringdata);
|
||||
until walkRes = nil;
|
||||
|
||||
|
||||
|
||||
for i := 1 to 30 do
|
||||
begin
|
||||
str(i,k);
|
||||
k := 'test' + k;
|
||||
writeln('deleting ', k);
|
||||
TreeDelete(t,k);
|
||||
end;
|
||||
if t <> nil then
|
||||
writeln('root: ', t^.key^)
|
||||
else
|
||||
writeln('root: nil');
|
||||
PrintStringTree(t,1);
|
||||
writeln('------------');
|
||||
|
||||
mem_dump;
|
||||
end.
|
||||
288
tests/treeimpl.pas
Normal file
288
tests/treeimpl.pas
Normal file
|
|
@ -0,0 +1,288 @@
|
|||
function makeTreeNode(var d:TreeData;var key:string;nparent:TreeRef):TreeRef;
|
||||
var newNode:TreeRef;
|
||||
newKey:^string;
|
||||
begin
|
||||
new(newNode);
|
||||
{ new(newKey,length(key)); }
|
||||
newString(newKey, length(key));
|
||||
new(newNode^.data);
|
||||
newKey^ := key;
|
||||
with newNode^ do
|
||||
begin
|
||||
key := newKey;
|
||||
parent := nparent;
|
||||
left := nil;
|
||||
right := nil;
|
||||
height := 1;
|
||||
data^ := d;
|
||||
end;
|
||||
makeTreeNode := newNode;
|
||||
end;
|
||||
|
||||
function MeasureTree(root:TreeRef):integer;
|
||||
var leftHeight, rightHeight:integer;
|
||||
begin
|
||||
if root = nil then
|
||||
MeasureTree := 0
|
||||
else
|
||||
begin
|
||||
if root^.left <> nil then
|
||||
leftHeight := root^.left^.height
|
||||
else
|
||||
leftHeight := 0;
|
||||
if root^.right <> nil then
|
||||
rightHeight := root^.right^.height
|
||||
else
|
||||
rightHeight := 0;
|
||||
if rightHeight > leftHeight then
|
||||
MeasureTree := rightHeight + 1
|
||||
else
|
||||
MeasureTree := leftHeight + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetTreeBalance(root:TreeRef):integer;
|
||||
begin
|
||||
if root = nil then
|
||||
GetTreeBalance := 0
|
||||
else
|
||||
GetTreeBalance := MeasureTree(root^.left) - MeasureTree(root^.right);
|
||||
end;
|
||||
|
||||
function RotateTreeRight(x:TreeRef):TreeRef;
|
||||
var z,tmp:TreeRef;
|
||||
begin
|
||||
(* writeln('RotateTreeRight at ', x^.key^); *)
|
||||
z := x^.left;
|
||||
tmp := z^.right;
|
||||
z^.right := x;
|
||||
z^.parent := x^.parent;
|
||||
x^.parent := z;
|
||||
x^.left := tmp;
|
||||
if tmp <> nil then
|
||||
tmp^.parent := x;
|
||||
x^.height := MeasureTree(x);
|
||||
z^.height := MeasureTree(z);
|
||||
RotateTreeRight := z;
|
||||
end;
|
||||
|
||||
function RotateTreeLeft(x:TreeRef):TreeRef;
|
||||
var z,tmp:TreeRef;
|
||||
begin
|
||||
(* writeln('RotateTreeLeft at ', x^.key^); *)
|
||||
z := x^.right;
|
||||
tmp := z^.left;
|
||||
z^.left := x;
|
||||
z^.parent := x^.parent;
|
||||
x^.parent := z;
|
||||
x^.right := tmp;
|
||||
if tmp <> nil then
|
||||
tmp^.parent := x;
|
||||
x^.height := MeasureTree(x);
|
||||
z^.height := MeasureTree(z);
|
||||
RotateTreeLeft := z;
|
||||
end;
|
||||
|
||||
function TreeInsert4(root:TreeRef;var key:string;var data:TreeData;
|
||||
parent:TreeRef):TreeRef;
|
||||
var balance:integer;
|
||||
begin
|
||||
if root = nil then
|
||||
root := makeTreeNode(data, key, parent)
|
||||
else
|
||||
if key < root^.key^ then
|
||||
root^.left := TreeInsert4(root^.left, key, data, root)
|
||||
else
|
||||
root^.right := TreeInsert4(root^.right, key, data, root);
|
||||
|
||||
root^.height := MeasureTree(root);
|
||||
|
||||
balance := GetTreeBalance(root);
|
||||
if balance > 1 then
|
||||
begin
|
||||
if key < root^.left^.key^ then
|
||||
root := RotateTreeRight(root)
|
||||
else
|
||||
begin
|
||||
root^.left := RotateTreeLeft(root^.left);
|
||||
root := RotateTreeRight(root);
|
||||
end;
|
||||
end
|
||||
else
|
||||
if balance < -1 then
|
||||
begin
|
||||
if key > root^.right^.key^ then
|
||||
root := RotateTreeLeft(root)
|
||||
else
|
||||
begin
|
||||
root^.right := RotateTreeRight(root^.right);
|
||||
root := RotateTreeLeft(root);
|
||||
end;
|
||||
end;
|
||||
|
||||
TreeInsert4 := root;
|
||||
end;
|
||||
|
||||
procedure TreeInsert(var root:TreeRef;var key:string;var data:TreeData);
|
||||
begin
|
||||
root := TreeInsert4(root,key,data,nil);
|
||||
end;
|
||||
|
||||
procedure DisposeTreeNode(node:TreeRef);
|
||||
begin
|
||||
dispose(node^.key);
|
||||
dispose(node^.data);
|
||||
dispose(node);
|
||||
end;
|
||||
|
||||
function TreeLeftmost(node:TreeRef):TreeRef;
|
||||
begin
|
||||
TreeLeftmost := nil;
|
||||
if node <> nil then
|
||||
begin
|
||||
repeat
|
||||
TreeLeftmost := node;
|
||||
node := node^.left;
|
||||
until node = nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TreeDeleteFn(root:TreeRef;var key:string):TreeRef;
|
||||
var tmp,oldParent:TreeRef;
|
||||
balance:integer;
|
||||
begin
|
||||
if root <> nil then
|
||||
begin
|
||||
if key < root^.key^ then
|
||||
root^.left := TreeDeleteFn(root^.left, key)
|
||||
else
|
||||
if key > root^.key^ then
|
||||
root^.right := TreeDeleteFn(root^.right, key)
|
||||
else
|
||||
begin
|
||||
if root^.left = nil then
|
||||
begin
|
||||
tmp := root;
|
||||
oldParent := root^.parent;
|
||||
root := root^.right;
|
||||
if root <> nil then
|
||||
root^.parent := oldParent;
|
||||
DisposeTreeNode(tmp);
|
||||
end
|
||||
else
|
||||
if root^.right = nil then
|
||||
begin
|
||||
tmp := root;
|
||||
oldParent := root^.parent;
|
||||
root := root^.left;
|
||||
if root <> nil then
|
||||
root^.parent := oldParent;
|
||||
DisposeTreeNode(tmp);
|
||||
end
|
||||
else
|
||||
begin
|
||||
tmp := TreeLeftmost(root^.right);
|
||||
root^.key^ := tmp^.key^;
|
||||
root^.data^ := tmp^.data^;
|
||||
oldParent := tmp^.parent;
|
||||
if oldParent^.left = tmp then
|
||||
oldParent^.left := TreeDeleteFn(oldParent^.left, tmp^.key^)
|
||||
else
|
||||
if oldParent^.right = tmp then
|
||||
oldParent^.right := TreeDeleteFn(oldParent^.right, tmp^.key^)
|
||||
else
|
||||
begin
|
||||
writeln('TreeDelete internal error at', root^.key^);
|
||||
end;
|
||||
end;
|
||||
|
||||
if root <> nil then
|
||||
begin
|
||||
root^.height := MeasureTree(root);
|
||||
balance := GetTreeBalance(root);
|
||||
if balance > 1 then
|
||||
begin
|
||||
if GetTreeBalance(root^.left) >=0 then
|
||||
root := RotateTreeRight(root)
|
||||
else
|
||||
begin
|
||||
root^.left := RotateTreeLeft(root^.left);
|
||||
root := RotateTreeRight(root);
|
||||
end;
|
||||
end
|
||||
else
|
||||
if balance < -1 then
|
||||
begin
|
||||
if GetTreeBalance(root^.right) <= 0 then
|
||||
root := RotateTreeLeft(root)
|
||||
else
|
||||
begin
|
||||
root^.right := RotateTreeRight(root^.right);
|
||||
root := RotateTreeLeft(root);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
TreeDeleteFn := root;
|
||||
end;
|
||||
|
||||
procedure TreeDelete(var root:TreeRef;var key:string);
|
||||
begin
|
||||
root := TreeDeleteFn(root,key);
|
||||
end;
|
||||
|
||||
function TreeSearch(root:TreeRef;var key:string):TreeDataRef;
|
||||
begin
|
||||
if root <> nil then
|
||||
begin
|
||||
if key = root^.key^ then
|
||||
TreeSearch := root^.data
|
||||
else
|
||||
if key < root^.key^ then
|
||||
TreeSearch := TreeSearch(root^.left, key)
|
||||
else
|
||||
TreeSearch := TreeSearch(root^.right, key);
|
||||
end
|
||||
else
|
||||
TreeSearch := nil;
|
||||
end;
|
||||
|
||||
procedure TreeWalkStart(t:TreeRef; var state:TreeWalkState);
|
||||
begin
|
||||
(* start at leftmost node of the tree *)
|
||||
state.currentNode := TreeLeftmost(t);
|
||||
end;
|
||||
|
||||
procedure TreeWalkNext(var state:TreeWalkState;var res:TreeRef);
|
||||
var last,current,right:TreeRef;
|
||||
begin
|
||||
current := state.currentNode;
|
||||
|
||||
res := current;
|
||||
|
||||
if current <> nil then
|
||||
begin
|
||||
(* descending right *)
|
||||
if current^.right <> nil then
|
||||
begin
|
||||
state.currentNode := TreeLeftmost(current^.right);
|
||||
end
|
||||
else (* ascending *)
|
||||
begin
|
||||
repeat
|
||||
last := current;
|
||||
current := current^.parent;
|
||||
if current <> nil then
|
||||
right := current^.right;
|
||||
until (right <> last) or (current = nil); (* ascend left edges *)
|
||||
state.currentNode := current;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TreeWalkFirst(t:TreeRef; var state:TreeWalkState; var first:TreeRef);
|
||||
begin
|
||||
TreeWalkStart(t, state);
|
||||
TreeWalkNext(state, first);
|
||||
end;
|
||||
25
tests/treetypes.pas
Normal file
25
tests/treetypes.pas
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
{
|
||||
type TreedataType = (TDString, TDInteger);
|
||||
|
||||
type Treedata = record
|
||||
case typ:Treedatatype of
|
||||
TDString:(stringdata:string);
|
||||
TDInteger:(intdata:integer);
|
||||
end;
|
||||
}
|
||||
type StringRef = ^string;
|
||||
|
||||
type TreeNode = record
|
||||
parent: ^TreeNode;
|
||||
left,right: ^TreeNode;
|
||||
height: integer;
|
||||
key: StringRef;
|
||||
data: ^Treedata;
|
||||
end;
|
||||
|
||||
type TreeRef = ^TreeNode;
|
||||
TreeDataRef = ^Treedata;
|
||||
|
||||
type TreeWalkState = record
|
||||
currentNode:TreeRef;
|
||||
end;
|
||||
15
tests/umlaut.pas
Normal file
15
tests/umlaut.pas
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
(*
|
||||
test program for
|
||||
multibyte characters
|
||||
and tabs
|
||||
*)
|
||||
program umlaut;
|
||||
var s:string = 'ÄÖÜß';
|
||||
begin
|
||||
writeln('Falsches Üben von');
|
||||
writeln('Xylophonmusik quält jeden');
|
||||
writeln('größeren Zwerg.');
|
||||
writeln;
|
||||
writeln(s);
|
||||
writeln(length(s));
|
||||
end.
|
||||
BIN
tridoraemu.zip
Normal file
BIN
tridoraemu.zip
Normal file
Binary file not shown.
7
tridoraemu/IOHandler.go
Normal file
7
tridoraemu/IOHandler.go
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
// Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
package main
|
||||
|
||||
type IOHandler interface {
|
||||
read(byteaddr word) (word, error)
|
||||
write(value word, byteaddr word) (error)
|
||||
}
|
||||
17
tridoraemu/LICENSE.md
Normal file
17
tridoraemu/LICENSE.md
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
# Copyright and Licensing
|
||||
|
||||
All files, except where explicitly stated otherwise, are licensed according to the BSD-3-Clause license as follows:
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
Copyright 2024 Sebastian Lederer
|
||||
|
||||
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
|
||||
|
||||
3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
53
tridoraemu/README.md
Normal file
53
tridoraemu/README.md
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
# Tridora Emulator
|
||||
- an emulator for the Tridora CPU / System
|
||||
- emulates the CPU, UART, SD-Card controller, VGA controller
|
||||
- supports reading the tick counter from the interrupt controller, but does not support any interrupts
|
||||
- written in Golang
|
||||
|
||||
## Getting started
|
||||
From the command line, run the *tridoraemu* or *tridoraemu.exe* program inside the *tridoraemu* directory (see below for details).
|
||||
|
||||
A precompiled binary for Windows is provided.
|
||||
|
||||
To build the program yourself, you need to have the Go language installed on your system. Building has been tested on Windows and Linux.
|
||||
|
||||
## Building
|
||||
Run the following commands inside the *tridoraemu* directory:
|
||||
|
||||
go get
|
||||
go build
|
||||
|
||||
On the first run, this may take a while as the go build system fetches some external libraries and compiles them.
|
||||
|
||||
## Running the emulator
|
||||
Start the *tridoraemu* binary in the same directory as the SD-Card image file (*sdcard.img*) and the ROM file (*rommon.prog*). It needs to be started on the command line as it uses the terminal window for the serial console. On startup, the emulator opens the VGA framebuffer window which is only used for graphics output.
|
||||
|
||||
|
||||
The Tridora software (esp. the editor) requires a decent vt100-compatible (plus colors) terminal emulator. It has been successfully tested with (new) Windows Terminal, WezTerm and xterm.
|
||||
|
||||
The color scheme in the editor is meant for a dark terminal background.
|
||||
|
||||
The runtime system expects the Backspace key to send the DEL character (ASCII 127).
|
||||
|
||||
## Stopping the emulator
|
||||
To stop the emulator, close the VGA framebuffer window.
|
||||
The emulator will also stop if it encounters an infinite loop (a BRANCH @+0 instruction).
|
||||
|
||||
## Things to try out
|
||||
On the ROM monitor prompt, press *B* to boot from the SD-card image. This should boot into the shell, which will first require you to enter the current date and time.
|
||||
|
||||
In the shell, try the *L* command to list directories and the *V* command to change volumes. The *Example* volume contains some example programs in source form.
|
||||
|
||||
The programs *lines*, *conway* and *mandelbrot*, among others, show some (hopefully) interesting VGA graphics. The *viewpict* program can show image files (*.pict files) which contain 640x400x4 bitmaps. A few sample image files are provided.
|
||||
|
||||
To compile a program, set the file name (e.g. *lines.pas*) with the *W* command in the shell. Then, use *B* and *R* to build and run the program.
|
||||
|
||||
To edit the source file, have the name set with *W* and then use the *E* shell command. Inside the editor, press F1 for the help screen (and RETURN to leave the help screen). Control-X exits the editor, abandoning any changes.
|
||||
|
||||
The volume *Testvolume 1* (note the space) contains a precompiled game called *chase*. This is a game that was written for UCSD Pascal around 1980, and compiles with a few lines of changes with the Tridora Pascal compiler. The source code is also provided on that volume.
|
||||
|
||||
You can run the program with the *O* command in the shell (just press Return for the program arguments), or you can set the workfile name with *W* and then use the *R* command.
|
||||
|
||||
The *K* command in the shell is used to reclaim the space occupied by deleted or overwritten files.
|
||||
|
||||
A running program can be terminated by pressing Control-C, but only if the program is expecting keyboard input at that time.
|
||||
35
tridoraemu/console.go
Normal file
35
tridoraemu/console.go
Normal file
|
|
@ -0,0 +1,35 @@
|
|||
// +build !windows
|
||||
// Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
|
||||
package main
|
||||
|
||||
import (
|
||||
"os"
|
||||
"golang.org/x/term"
|
||||
)
|
||||
|
||||
type ConsoleState struct {
|
||||
state term.State
|
||||
}
|
||||
|
||||
func SetRawConsole() (*ConsoleState, error) {
|
||||
oldState, err := term.MakeRaw(int(os.Stdin.Fd()))
|
||||
|
||||
return &ConsoleState{*oldState}, err
|
||||
}
|
||||
|
||||
func RestoreConsole(st *ConsoleState) error {
|
||||
return term.Restore(int(os.Stdin.Fd()), &st.state)
|
||||
}
|
||||
|
||||
func ConsoleRead(buf []byte) (count int, err error) {
|
||||
n, e := os.Stdin.Read(buf)
|
||||
return n, e
|
||||
}
|
||||
|
||||
func ConsoleWrite(char byte) (err error) {
|
||||
buf := make([] byte, 1)
|
||||
buf[0] = char
|
||||
_ , e := os.Stdout.Write(buf)
|
||||
return e
|
||||
}
|
||||
75
tridoraemu/console_windows.go
Normal file
75
tridoraemu/console_windows.go
Normal file
|
|
@ -0,0 +1,75 @@
|
|||
// +build windows
|
||||
// Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
|
||||
package main
|
||||
|
||||
import (
|
||||
"io"
|
||||
"os"
|
||||
"golang.org/x/sys/windows"
|
||||
)
|
||||
|
||||
type ConsoleState struct {
|
||||
modeStdin uint32
|
||||
modeStdout uint32
|
||||
}
|
||||
|
||||
func SetRawConsole() (*ConsoleState, error) {
|
||||
var stIn uint32
|
||||
var stOut uint32
|
||||
|
||||
stdinFd := os.Stdin.Fd()
|
||||
|
||||
if err := windows.GetConsoleMode(windows.Handle(stdinFd), &stIn); err != nil {
|
||||
return nil, err
|
||||
}
|
||||
raw := stIn &^ (windows.ENABLE_ECHO_INPUT | windows.ENABLE_PROCESSED_INPUT | windows.ENABLE_LINE_INPUT | windows.ENABLE_PROCESSED_OUTPUT)
|
||||
raw |= windows.ENABLE_VIRTUAL_TERMINAL_INPUT
|
||||
if err := windows.SetConsoleMode(windows.Handle(stdinFd), raw); err != nil {
|
||||
return nil, err
|
||||
}
|
||||
|
||||
/*
|
||||
stdoutFd := os.Stdout.Fd()
|
||||
|
||||
if err := windows.GetConsoleMode(windows.Handle(stdoutFd), &stOut); err != nil {
|
||||
return nil, err
|
||||
}
|
||||
raw = stOut | windows.ENABLE_VIRTUAL_TERMINAL_INPUT | windows.ENABLE_PROCESSED_OUTPUT
|
||||
if err := windows.SetConsoleMode(windows.Handle(stdoutFd), raw); err != nil {
|
||||
return nil, err
|
||||
}
|
||||
*/
|
||||
return &ConsoleState{stIn,stOut}, nil
|
||||
}
|
||||
|
||||
func RestoreConsole(st *ConsoleState) error {
|
||||
stdinFd := os.Stdin.Fd()
|
||||
stdoutFd := os.Stdout.Fd()
|
||||
|
||||
err := windows.SetConsoleMode(windows.Handle(stdinFd), st.modeStdin)
|
||||
if err != nil { return err }
|
||||
err = windows.SetConsoleMode(windows.Handle(stdoutFd), st.modeStdin)
|
||||
return err
|
||||
}
|
||||
|
||||
func ConsoleRead(buf []byte) (count int, err error) {
|
||||
n, e := os.Stdin.Read(buf)
|
||||
if e == io.EOF { // ugly hack to handle ^Z on windows
|
||||
// this can probably be done in a better way
|
||||
// but tbh I am glad it works and I don't
|
||||
// have to dig deeper into that windows
|
||||
// console i/o crap
|
||||
n = 1; buf[0] = 26
|
||||
return n, nil
|
||||
}
|
||||
return n, e
|
||||
}
|
||||
|
||||
func ConsoleWrite(char byte) (err error) {
|
||||
buf := make([] byte, 1)
|
||||
buf[0] = char
|
||||
_ , err = os.Stdout.Write(buf)
|
||||
return err
|
||||
}
|
||||
|
||||
467
tridoraemu/cpu.go
Normal file
467
tridoraemu/cpu.go
Normal file
|
|
@ -0,0 +1,467 @@
|
|||
// Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
package main
|
||||
|
||||
import (
|
||||
"fmt"
|
||||
"strings"
|
||||
)
|
||||
|
||||
type word uint32
|
||||
const wordbits = 32
|
||||
const wordbytes = 4
|
||||
const wordmask = 0xFFFFFFFF
|
||||
const hsbmask = 0x80000000
|
||||
const estackDepth = 64
|
||||
type CPU struct {
|
||||
ESP word;
|
||||
X word;
|
||||
PC, FP,BP,RP word;
|
||||
IR,IV word;
|
||||
|
||||
estack [estackDepth] word;
|
||||
|
||||
mem *Mem;
|
||||
|
||||
stopped bool
|
||||
trace bool
|
||||
singlestep bool
|
||||
}
|
||||
|
||||
func sign_extend(bits word, wordbits int) int {
|
||||
signmask := word(1 << (wordbits - 1))
|
||||
signbit := (bits & signmask) != 0
|
||||
// fmt.Printf("sign_extend %b %v signmask %08X signbit %v\n", bits, wordbits, signmask, signbit)
|
||||
if signbit {
|
||||
return int(bits & ^signmask) - int(signmask)
|
||||
} else {
|
||||
return int(bits)
|
||||
}
|
||||
}
|
||||
|
||||
func (c *CPU) initialize() {
|
||||
c.ESP = 0
|
||||
c.PC = 0
|
||||
c.X = 0
|
||||
c.FP = 65020 // these are the values set by the ROM monitor
|
||||
c.RP = 65024 // for FP and RP
|
||||
|
||||
c.singlestep = false
|
||||
}
|
||||
|
||||
func (c *CPU) printEstack() {
|
||||
fmt.Printf("[")
|
||||
for i := word(1); i <= c.ESP; i++ {
|
||||
fmt.Printf(" %08X", c.estack[i])
|
||||
}
|
||||
fmt.Printf(" %08X ] (%v)\n", c.X, c.ESP)
|
||||
}
|
||||
|
||||
func (c *CPU) showStep(desc string, operand int, opWidth int) {
|
||||
if !c.trace { return }
|
||||
|
||||
var opStr string
|
||||
if opWidth == 0 {
|
||||
opStr = ""
|
||||
} else {
|
||||
opStr = fmt.Sprintf(" %04X", operand)
|
||||
}
|
||||
|
||||
fmt.Printf("%08x %-10s%5s ", c.PC, desc, opStr)
|
||||
c.printEstack()
|
||||
}
|
||||
|
||||
func (c *CPU) getOperand(insWord word, bits int) int {
|
||||
return int(insWord & word((1 << bits) - 1))
|
||||
}
|
||||
|
||||
func (c *CPU) getSignedOperand(insWord word, bits int) int {
|
||||
bitValue := (1 << (bits - 1))
|
||||
signBit := insWord & word(bitValue)
|
||||
bitMask := (bitValue << 1) - 1
|
||||
//fmt.Printf("getSignedOperand bitValue: %v, bitMask: %v\n", bitValue, bitMask)
|
||||
o := int(insWord & word(bitMask))
|
||||
if signBit != 0 {
|
||||
o = int(o) - (bitValue << 1)
|
||||
}
|
||||
//fmt.Printf("getSignedOperand: %v %v -> %d\n",insWord, bits, o)
|
||||
return o
|
||||
}
|
||||
|
||||
func (c *CPU) getBit(insWord word, bitnum int) int {
|
||||
return int(insWord >> bitnum) & 1
|
||||
}
|
||||
|
||||
func (c *CPU) getBits(insWord word, mask word, shiftCount int) word {
|
||||
return (insWord & mask) >> shiftCount
|
||||
}
|
||||
|
||||
func (c *CPU) getSignedBits(insWord word, mask word, shiftCount int) int {
|
||||
result := (insWord & mask) >> shiftCount
|
||||
signMask := ((mask >> shiftCount) + 1) >> 1
|
||||
//fmt.Printf("getSignedBits %016b signMask %v signBit %v\n", insWord, signMask, insWord & signMask)
|
||||
if result & signMask != 0 {
|
||||
return - int(result & ^signMask)
|
||||
} else {
|
||||
return int(result)
|
||||
}
|
||||
}
|
||||
|
||||
func (c * CPU) addToWord(v word, offset int) word {
|
||||
if offset < 0 {
|
||||
v -= word(-offset)
|
||||
} else {
|
||||
v += word(offset)
|
||||
}
|
||||
return v
|
||||
}
|
||||
|
||||
func (c *CPU) step() error {
|
||||
nPC := c.PC
|
||||
nFP := c.FP
|
||||
nBP := c.BP
|
||||
nRP := c.RP
|
||||
nX := c.X
|
||||
nESP := c.ESP
|
||||
|
||||
Y := c.estack[c.ESP]
|
||||
|
||||
insWord, err := c.mem.read(c.PC)
|
||||
if err != nil { return err }
|
||||
if c.PC % 4 == 0 {
|
||||
insWord = insWord >> 16
|
||||
} else {
|
||||
insWord = insWord & 0xFFFF
|
||||
}
|
||||
|
||||
baseIns := insWord >> 13
|
||||
|
||||
nPC += 2
|
||||
|
||||
x2y := false
|
||||
deltaESP := 0
|
||||
|
||||
oplen := 0
|
||||
|
||||
switch baseIns {
|
||||
// BRANCH
|
||||
case 0b000:
|
||||
operand := c.getSignedOperand(insWord, 13)
|
||||
|
||||
c.showStep("BRANCH", operand, 13)
|
||||
|
||||
nPC = word(int(c.PC) + operand)
|
||||
|
||||
if operand == 0 {
|
||||
fmt.Printf("BRANCH 0 encountered - stopped at PC %08X\n", nPC)
|
||||
c.stopped = true
|
||||
}
|
||||
// ALU
|
||||
case 0b001:
|
||||
aluop := c.getBits(insWord, 0b0001111000000000, 9)
|
||||
deltaESP = c.getSignedBits(insWord, 0b0000000000110000, 4)
|
||||
ext := c.getBit(insWord, 7) != 0
|
||||
x2y = c.getBit(insWord, 6) != 0
|
||||
operand := c.getOperand(insWord, 4)
|
||||
// fmt.Printf("aluop %v %v %v %v %v\n", aluop, s, ext, x2y, operand)
|
||||
name := "ALU"
|
||||
switch aluop {
|
||||
case 0:
|
||||
name = "ADD"
|
||||
nX = c.X + Y
|
||||
case 1:
|
||||
name = "SUB"
|
||||
nX = Y - c.X
|
||||
case 2:
|
||||
name = "NOT"
|
||||
nX = ^ c.X
|
||||
case 3:
|
||||
name = "AND"
|
||||
nX = c.X & Y
|
||||
case 4:
|
||||
name = "OR"
|
||||
nX = c.X | Y
|
||||
case 5:
|
||||
name = "XOR"
|
||||
nX = c.X ^ Y
|
||||
case 6:
|
||||
name = "CMP"
|
||||
oplen = 2
|
||||
cmp_i := c.getBit(insWord,2) != 0
|
||||
cmp_eq := c.getBit(insWord,1) != 0
|
||||
cmp_lt := c.getBit(insWord,0) != 0
|
||||
s_x := sign_extend(c.X, wordbits)
|
||||
s_y := sign_extend(Y, wordbits)
|
||||
result := (cmp_eq && (s_x == s_y)) || (cmp_lt && (s_y < s_x))
|
||||
if cmp_i { result = !result }
|
||||
if result { nX = 1 } else { nX = 0 }
|
||||
case 7:
|
||||
name = "Y"
|
||||
if !x2y && (deltaESP == -1) { name = "DROP" }
|
||||
if x2y && (deltaESP == 0) { name = "SWAP" }
|
||||
nX = Y
|
||||
case 8:
|
||||
name = "SHR"
|
||||
nX = c.X >> 1
|
||||
if ext {
|
||||
nX = nX | (c.X & hsbmask)
|
||||
}
|
||||
case 9:
|
||||
name = "SHL"
|
||||
nX = c.X << 1
|
||||
if operand & 2 != 0 {
|
||||
nX = nX << 1
|
||||
}
|
||||
oplen = 2
|
||||
case 10:
|
||||
name = "INC"
|
||||
oplen = 4
|
||||
if (operand == 0) && (deltaESP == 1) && x2y { name = "DUP" }
|
||||
nX = c.X + word(operand)
|
||||
case 11:
|
||||
name = "DEC"
|
||||
oplen = 4
|
||||
nX = c.X - word(operand)
|
||||
case 12:
|
||||
name = "CMPU"
|
||||
oplen = 2
|
||||
cmp_i := c.getBit(insWord,2) != 0
|
||||
cmp_eq := c.getBit(insWord,1) != 0
|
||||
cmp_lt := c.getBit(insWord,0) != 0
|
||||
result := (cmp_eq && (c.X == Y)) || (cmp_lt && (Y < c.X))
|
||||
if cmp_i { result = !result }
|
||||
if result { nX = 1 } else { nX = 0 }
|
||||
case 13:
|
||||
name = "BPLC"
|
||||
nX = (c.X & 0xFF) << ((3 - (Y & 3)) * 8)
|
||||
case 14:
|
||||
name = "BROT"
|
||||
nX = ((c.X & 0x00FFFFFF) << 8 ) | ((c.X & 0xFF000000) >> 24)
|
||||
case 15:
|
||||
name = "BSEL"
|
||||
shift := (3 - (Y & 3)) * 8
|
||||
nX = (c.X >> shift) & 0xFF
|
||||
}
|
||||
c.showStep(name, operand, oplen)
|
||||
// STORE
|
||||
case 0b010:
|
||||
operand := c.getOperand(insWord, 13)
|
||||
var ea word
|
||||
var name string
|
||||
if (insWord & 1) == 1 {
|
||||
name = "STORE.B"
|
||||
ea = c.BP + word(operand)
|
||||
} else {
|
||||
name = "STORE"
|
||||
ea = c.FP + word(operand)
|
||||
}
|
||||
|
||||
c.showStep(name, operand, oplen)
|
||||
|
||||
err = c.mem.write(c.X, ea)
|
||||
if err != nil { return err }
|
||||
|
||||
deltaESP = -1
|
||||
nX = Y
|
||||
// XFER
|
||||
case 0b011:
|
||||
var name string
|
||||
|
||||
deltaRP := c.getSignedBits(insWord, 0b0000001100000000, 8)
|
||||
deltaESP = c.getSignedBits(insWord, 0b0000000000110000, 4)
|
||||
r2p := c.getBit(insWord, 7) != 0
|
||||
p2r := c.getBit(insWord, 6) != 0
|
||||
x2p := c.getBit(insWord, 0) != 0
|
||||
|
||||
if deltaRP >= 0 {
|
||||
nRP = c.RP + word(deltaRP * wordbytes)
|
||||
} else {
|
||||
nRP = c.RP - word(-deltaRP * wordbytes)
|
||||
}
|
||||
|
||||
if (deltaRP == 1) && (deltaESP == -1) && p2r && x2p {
|
||||
name = "CALL"
|
||||
} else
|
||||
if (deltaRP == -1) && (deltaESP == 0) && r2p {
|
||||
name = "RET"
|
||||
} else
|
||||
if (deltaRP == 0) && (deltaESP == -1) && x2p && !p2r {
|
||||
name = "JUMP"
|
||||
} else {
|
||||
var b strings.Builder
|
||||
b.WriteString("XFER")
|
||||
if deltaRP == -1 { b.WriteString(".RSM1") }
|
||||
if deltaRP == 1 { b.WriteString(".RS1") }
|
||||
if deltaESP == -1 { b.WriteString(".SM1") }
|
||||
if deltaESP == 1 { b.WriteString(".S1") }
|
||||
if r2p { b.WriteString(".R2P") }
|
||||
if p2r { b.WriteString(".P2R") }
|
||||
if x2p { b.WriteString(".X2P") }
|
||||
name = b.String()
|
||||
}
|
||||
|
||||
c.showStep(name, 0, 0)
|
||||
|
||||
if r2p {
|
||||
nPC, err = c.mem.read(c.RP)
|
||||
if err != nil { return err }
|
||||
}
|
||||
if p2r {
|
||||
err = c.mem.write(nPC, nRP)
|
||||
if err != nil { return err }
|
||||
}
|
||||
if x2p {
|
||||
nPC = c.X
|
||||
nX = Y
|
||||
}
|
||||
|
||||
// LOAD
|
||||
case 0b100:
|
||||
operand := c.getOperand(insWord, 13)
|
||||
var ea word
|
||||
var name string
|
||||
if (insWord & 1) == 1 {
|
||||
name = "LOAD.B"
|
||||
operand &= ^1
|
||||
ea = c.BP + word(operand)
|
||||
} else {
|
||||
name = "LOAD"
|
||||
ea = c.FP + word(operand)
|
||||
}
|
||||
|
||||
c.showStep(name, operand, oplen)
|
||||
|
||||
deltaESP = 1
|
||||
x2y = true
|
||||
|
||||
nX, err = c.mem.read(ea)
|
||||
if err != nil { return err }
|
||||
// CBRANCH
|
||||
case 0b101:
|
||||
operand := c.getSignedOperand(insWord, 13)
|
||||
var name string
|
||||
invert := (operand & 1) == 0
|
||||
operand = operand & -2 // clear bit 0
|
||||
|
||||
if invert { name = "CBRANCH.Z" } else { name = "CBRANCH" }
|
||||
|
||||
c.showStep(name, operand, 13)
|
||||
|
||||
deltaESP = -1
|
||||
nX = Y
|
||||
|
||||
if (c.X != 0 && !invert) || (c.X == 0 && invert) {
|
||||
nPC = word(int(c.PC) + operand)
|
||||
}
|
||||
// LOADC
|
||||
case 0b110:
|
||||
operand := c.getSignedOperand(insWord, 13)
|
||||
oplen = 13
|
||||
|
||||
c.showStep("LOADC", operand, oplen)
|
||||
|
||||
deltaESP = 1
|
||||
x2y = true
|
||||
nX = word(operand)
|
||||
// EXT
|
||||
case 0b111:
|
||||
extop := c.getBits(insWord, 0b0001111000000000, 10)
|
||||
deltaESP = c.getSignedBits(insWord, 0b0000000000110000, 4)
|
||||
writeFlag := c.getBit(insWord, 9) != 0
|
||||
// signExtend := c.getBit(insWord,7) != 0
|
||||
x2y = c.getBit(insWord, 6) != 0
|
||||
operand := c.getOperand(insWord, 4)
|
||||
|
||||
var name string
|
||||
|
||||
switch extop {
|
||||
// LOADREG/STOREREG
|
||||
case 0:
|
||||
oplen = 4
|
||||
if writeFlag {
|
||||
name = "STOREREG"
|
||||
switch operand {
|
||||
case 0: nFP = c.X
|
||||
case 1: nBP = c.X
|
||||
case 2: nRP = c.X
|
||||
case 3: c.IV = c.X // should be nIV
|
||||
case 4: c.IR = c.X // should be nIR
|
||||
default: fmt.Errorf("Invalid STOREREG operand %v at %08X", operand, c.PC)
|
||||
}
|
||||
|
||||
c.showStep(name, operand, oplen)
|
||||
deltaESP = -1
|
||||
x2y = false
|
||||
nX = Y
|
||||
} else {
|
||||
name = "LOADREG"
|
||||
switch operand {
|
||||
case 0: nX = c.FP
|
||||
case 1: nX = c.BP
|
||||
case 2: nX = c.RP
|
||||
case 3: nX = c.IV
|
||||
case 4: nX = c.IR
|
||||
case 5: nX = c.ESP
|
||||
default: fmt.Errorf("Invalid LOADREG operand %v at %08X", operand, c.PC)
|
||||
}
|
||||
c.showStep(name, operand, oplen)
|
||||
deltaESP = 1
|
||||
x2y = true
|
||||
}
|
||||
// LOADI/STOREI
|
||||
case 1:
|
||||
if writeFlag { name = "STOREI" } else { name = "LOADI" }
|
||||
c.showStep(name, operand, oplen)
|
||||
|
||||
if writeFlag {
|
||||
oplen = 4
|
||||
err = c.mem.write(c.X, Y)
|
||||
if err != nil { return err }
|
||||
nX = Y + word(operand)
|
||||
} else {
|
||||
nX, err = c.mem.read(c.X)
|
||||
if err != nil { return err }
|
||||
}
|
||||
|
||||
// FPADJ
|
||||
case 3:
|
||||
operand := c.getSignedOperand(insWord, 10)
|
||||
oplen = 10
|
||||
nFP = c.FP + word(operand)
|
||||
deltaESP = 0
|
||||
x2y = false
|
||||
c.showStep("FPADJ", operand, oplen)
|
||||
// LOADREL
|
||||
case 5:
|
||||
offset := c.getOperand(insWord, 10)
|
||||
|
||||
c.showStep("LOADREL", offset, 10)
|
||||
|
||||
nX, err = c.mem.read(c.PC + word(offset))
|
||||
if err != nil { return err }
|
||||
x2y = true
|
||||
deltaESP = 1
|
||||
default:
|
||||
return fmt.Errorf("Invalid EXT instruction %v at %08X", extop, c.PC)
|
||||
}
|
||||
default:
|
||||
return fmt.Errorf("Invalid instruction %04X at %08X", insWord, c.PC)
|
||||
}
|
||||
|
||||
nESP = c.addToWord(nESP, deltaESP)
|
||||
if nESP < 0 || nESP >= estackDepth {
|
||||
return fmt.Errorf("estack overflow %v at %08X", nESP, c.PC)
|
||||
}
|
||||
|
||||
if x2y {
|
||||
c.estack[nESP] = c.X
|
||||
}
|
||||
|
||||
c.PC = nPC
|
||||
c.FP = nFP
|
||||
c.BP = nBP
|
||||
c.X = nX
|
||||
c.RP = nRP
|
||||
c.ESP = nESP
|
||||
|
||||
return nil
|
||||
}
|
||||
131
tridoraemu/framebuffer.go
Normal file
131
tridoraemu/framebuffer.go
Normal file
|
|
@ -0,0 +1,131 @@
|
|||
// Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
package main
|
||||
|
||||
import (
|
||||
// "fmt"
|
||||
"image/color"
|
||||
"github.com/hajimehoshi/ebiten/v2"
|
||||
)
|
||||
|
||||
const VmemWords = 32768
|
||||
const PaletteSlots = 16
|
||||
const FB_RA = 0
|
||||
const FB_WA = 1
|
||||
const FB_IO = 2
|
||||
const FB_PS = 3
|
||||
const FB_PD = 4
|
||||
const FB_CTL= 5
|
||||
|
||||
const PixelMask = 0b11110000000000000000000000000000
|
||||
const PixelPerWord = 8
|
||||
const VmemWidth = 32
|
||||
const BitsPerPixel = 4
|
||||
const ScreenWidth = 640
|
||||
const ScreenHeight = 400
|
||||
const WordsPerLine = ScreenWidth / PixelPerWord
|
||||
|
||||
type Framebuffer struct {
|
||||
framebuffer *ebiten.Image
|
||||
palette [PaletteSlots] color.Color
|
||||
readAddr word
|
||||
writeAddr word
|
||||
paletteSlot word
|
||||
vmem [VmemWords]word
|
||||
readCount int
|
||||
}
|
||||
|
||||
func (f *Framebuffer) initialize() {
|
||||
f.framebuffer = ebiten.NewImage(ScreenWidth, ScreenHeight)
|
||||
for i := 0; i <PaletteSlots; i++ {
|
||||
f.palette[i] = color.RGBA{0,0,0,0}
|
||||
}
|
||||
}
|
||||
|
||||
func (f *Framebuffer) read(byteaddr word) (word, error) {
|
||||
result := word(0)
|
||||
|
||||
addr := byteaddr & 0x7F
|
||||
switch addr {
|
||||
case FB_RA: result = f.readAddr
|
||||
case FB_WA: result = f.writeAddr
|
||||
case FB_IO: result = f.readVmem()
|
||||
case FB_PS: result = f.paletteSlot
|
||||
case FB_PD: result = f.readPalette()
|
||||
case FB_CTL: result = f.readCtl()
|
||||
default:
|
||||
}
|
||||
return result, nil
|
||||
}
|
||||
|
||||
func (f *Framebuffer) write(value word, byteaddr word) (error) {
|
||||
addr := byteaddr & 0x7F
|
||||
switch addr {
|
||||
case FB_RA: f.readAddr = value
|
||||
case FB_WA: f.writeAddr = value
|
||||
case FB_IO: f.writeVmem(value)
|
||||
case FB_PS: f.paletteSlot = value
|
||||
case FB_PD: f.writePalette(value)
|
||||
case FB_CTL: f.writeCtl(value)
|
||||
default:
|
||||
}
|
||||
|
||||
idle(false)
|
||||
|
||||
return nil
|
||||
}
|
||||
|
||||
func (f *Framebuffer) readVmem() word {
|
||||
result := f.vmem[f.readAddr]
|
||||
f.readAddr += 1
|
||||
return result
|
||||
}
|
||||
|
||||
func (f *Framebuffer) writeVmem(value word) {
|
||||
f.vmem[f.writeAddr] = value
|
||||
|
||||
y := f.writeAddr / WordsPerLine
|
||||
x := f.writeAddr % WordsPerLine * PixelPerWord
|
||||
|
||||
for i := 0; i < PixelPerWord; i++ {
|
||||
pixel := (value & PixelMask) >> (VmemWidth - BitsPerPixel)
|
||||
value = value << BitsPerPixel
|
||||
|
||||
col := f.palette[pixel]
|
||||
//fmt.Printf("set pixel %v, %v\n", x,y)
|
||||
f.framebuffer.Set(int(x), int(y), col)
|
||||
x = x + 1
|
||||
}
|
||||
|
||||
f.writeAddr += 1
|
||||
}
|
||||
|
||||
func (f *Framebuffer) readPalette() word {
|
||||
return word(0)
|
||||
}
|
||||
|
||||
func (f *Framebuffer) writePalette(value word) {
|
||||
// 4 bits per color channel
|
||||
r := uint8((value & 0b111100000000) >> 8)
|
||||
g := uint8((value & 0b000011110000) >> 4)
|
||||
b := uint8((value & 0b000000001111) >> 0)
|
||||
|
||||
// scale to 0-255
|
||||
r = r << 4
|
||||
g = g << 4
|
||||
b = b << 4
|
||||
|
||||
f.palette[f.paletteSlot] = color.RGBA{r,g,b,0}
|
||||
}
|
||||
|
||||
func (f *Framebuffer) readCtl() word {
|
||||
if f.readCount == 0 {
|
||||
f.readCount = 1000
|
||||
return word(0)
|
||||
} else {
|
||||
f.readCount -= 1
|
||||
return word(1)
|
||||
}
|
||||
}
|
||||
|
||||
func (f *Framebuffer) writeCtl(value word) {
|
||||
}
|
||||
30
tridoraemu/go.mod
Normal file
30
tridoraemu/go.mod
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
module tridoraemu
|
||||
|
||||
go 1.22.5
|
||||
|
||||
require (
|
||||
atomicgo.dev/keyboard v0.2.9
|
||||
github.com/eiannone/keyboard v0.0.0-20220611211555-0d226195f203
|
||||
github.com/gopxl/pixel v1.0.0
|
||||
github.com/hajimehoshi/ebiten/v2 v2.7.8
|
||||
github.com/nsf/termbox-go v1.1.1
|
||||
golang.org/x/image v0.18.0
|
||||
golang.org/x/sys v0.22.0
|
||||
golang.org/x/term v0.22.0
|
||||
)
|
||||
|
||||
require (
|
||||
github.com/containerd/console v1.0.3 // indirect
|
||||
github.com/ebitengine/gomobile v0.0.0-20240518074828-e86332849895 // indirect
|
||||
github.com/ebitengine/hideconsole v1.0.0 // indirect
|
||||
github.com/ebitengine/purego v0.7.0 // indirect
|
||||
github.com/faiface/glhf v0.0.0-20211013000516-57b20770c369 // indirect
|
||||
github.com/faiface/mainthread v0.0.0-20171120011319-8b78f0a41ae3 // indirect
|
||||
github.com/go-gl/gl v0.0.0-20211210172815-726fda9656d6 // indirect
|
||||
github.com/go-gl/glfw/v3.3/glfw v0.0.0-20221017161538-93cebf72946b // indirect
|
||||
github.com/go-gl/mathgl v1.1.0 // indirect
|
||||
github.com/jezek/xgb v1.1.1 // indirect
|
||||
github.com/mattn/go-runewidth v0.0.13 // indirect
|
||||
github.com/pkg/errors v0.9.1 // indirect
|
||||
golang.org/x/sync v0.7.0 // indirect
|
||||
)
|
||||
96
tridoraemu/go.sum
Normal file
96
tridoraemu/go.sum
Normal file
|
|
@ -0,0 +1,96 @@
|
|||
atomicgo.dev/keyboard v0.2.9 h1:tOsIid3nlPLZ3lwgG8KZMp/SFmr7P0ssEN5JUsm78K8=
|
||||
atomicgo.dev/keyboard v0.2.9/go.mod h1:BC4w9g00XkxH/f1HXhW2sXmJFOCWbKn9xrOunSFtExQ=
|
||||
github.com/MarvinJWendt/testza v0.1.0/go.mod h1:7AxNvlfeHP7Z/hDQ5JtE3OKYT3XFUeLCDE2DQninSqs=
|
||||
github.com/MarvinJWendt/testza v0.2.1/go.mod h1:God7bhG8n6uQxwdScay+gjm9/LnO4D3kkcZX4hv9Rp8=
|
||||
github.com/MarvinJWendt/testza v0.2.8/go.mod h1:nwIcjmr0Zz+Rcwfh3/4UhBp7ePKVhuBExvZqnKYWlII=
|
||||
github.com/MarvinJWendt/testza v0.2.10/go.mod h1:pd+VWsoGUiFtq+hRKSU1Bktnn+DMCSrDrXDpX2bG66k=
|
||||
github.com/MarvinJWendt/testza v0.2.12/go.mod h1:JOIegYyV7rX+7VZ9r77L/eH6CfJHHzXjB69adAhzZkI=
|
||||
github.com/MarvinJWendt/testza v0.3.0/go.mod h1:eFcL4I0idjtIx8P9C6KkAuLgATNKpX4/2oUqKc6bF2c=
|
||||
github.com/MarvinJWendt/testza v0.4.2/go.mod h1:mSdhXiKH8sg/gQehJ63bINcCKp7RtYewEjXsvsVUPbE=
|
||||
github.com/atomicgo/cursor v0.0.1/go.mod h1:cBON2QmmrysudxNBFthvMtN32r3jxVRIvzkUiF/RuIk=
|
||||
github.com/containerd/console v1.0.3 h1:lIr7SlA5PxZyMV30bDW0MGbiOPXwc63yRuCP0ARubLw=
|
||||
github.com/containerd/console v1.0.3/go.mod h1:7LqA/THxQ86k76b8c/EMSiaJ3h1eZkMkXar0TQ1gf3U=
|
||||
github.com/davecgh/go-spew v1.1.0/go.mod h1:J7Y8YcW2NihsgmVo/mv3lAwl/skON4iLHjSsI+c5H38=
|
||||
github.com/davecgh/go-spew v1.1.1/go.mod h1:J7Y8YcW2NihsgmVo/mv3lAwl/skON4iLHjSsI+c5H38=
|
||||
github.com/ebitengine/gomobile v0.0.0-20240518074828-e86332849895 h1:48bCqKTuD7Z0UovDfvpCn7wZ0GUZ+yosIteNDthn3FU=
|
||||
github.com/ebitengine/gomobile v0.0.0-20240518074828-e86332849895/go.mod h1:XZdLv05c5hOZm3fM2NlJ92FyEZjnslcMcNRrhxs8+8M=
|
||||
github.com/ebitengine/hideconsole v1.0.0 h1:5J4U0kXF+pv/DhiXt5/lTz0eO5ogJ1iXb8Yj1yReDqE=
|
||||
github.com/ebitengine/hideconsole v1.0.0/go.mod h1:hTTBTvVYWKBuxPr7peweneWdkUwEuHuB3C1R/ielR1A=
|
||||
github.com/ebitengine/purego v0.7.0 h1:HPZpl61edMGCEW6XK2nsR6+7AnJ3unUxpTZBkkIXnMc=
|
||||
github.com/ebitengine/purego v0.7.0/go.mod h1:ah1In8AOtksoNK6yk5z1HTJeUkC1Ez4Wk2idgGslMwQ=
|
||||
github.com/eiannone/keyboard v0.0.0-20220611211555-0d226195f203 h1:XBBHcIb256gUJtLmY22n99HaZTz+r2Z51xUPi01m3wg=
|
||||
github.com/eiannone/keyboard v0.0.0-20220611211555-0d226195f203/go.mod h1:E1jcSv8FaEny+OP/5k9UxZVw9YFWGj7eI4KR/iOBqCg=
|
||||
github.com/faiface/glhf v0.0.0-20211013000516-57b20770c369 h1:gv4BgP50atccdK/1tZHDyP6rMwiiutR2HPreR/OyLzI=
|
||||
github.com/faiface/glhf v0.0.0-20211013000516-57b20770c369/go.mod h1:dDdUO+G9ZnJ9sc8nIUvhLkE45k8PEKW6+A3TdWsfpV0=
|
||||
github.com/faiface/mainthread v0.0.0-20171120011319-8b78f0a41ae3 h1:baVdMKlASEHrj19iqjARrPbaRisD7EuZEVJj6ZMLl1Q=
|
||||
github.com/faiface/mainthread v0.0.0-20171120011319-8b78f0a41ae3/go.mod h1:VEPNJUlxl5KdWjDvz6Q1l+rJlxF2i6xqDeGuGAxa87M=
|
||||
github.com/go-gl/gl v0.0.0-20210905235341-f7a045908259/go.mod h1:wjpnOv6ONl2SuJSxqCPVaPZibGFdSci9HFocT9qtVYM=
|
||||
github.com/go-gl/gl v0.0.0-20211210172815-726fda9656d6 h1:zDw5v7qm4yH7N8C8uWd+8Ii9rROdgWxQuGoJ9WDXxfk=
|
||||
github.com/go-gl/gl v0.0.0-20211210172815-726fda9656d6/go.mod h1:9YTyiznxEY1fVinfM7RvRcjRHbw2xLBJ3AAGIT0I4Nw=
|
||||
github.com/go-gl/glfw v0.0.0-20210727001814-0db043d8d5be/go.mod h1:vR7hzQXu2zJy9AVAgeJqvqgH9Q5CA+iKCZ2gyEVpxRU=
|
||||
github.com/go-gl/glfw/v3.3/glfw v0.0.0-20221017161538-93cebf72946b h1:GgabKamyOYguHqHjSkDACcgoPIz3w0Dis/zJ1wyHHHU=
|
||||
github.com/go-gl/glfw/v3.3/glfw v0.0.0-20221017161538-93cebf72946b/go.mod h1:tQ2UAYgL5IevRw8kRxooKSPJfGvJ9fJQFa0TUsXzTg8=
|
||||
github.com/go-gl/mathgl v1.0.0/go.mod h1:yhpkQzEiH9yPyxDUGzkmgScbaBVlhC06qodikEM0ZwQ=
|
||||
github.com/go-gl/mathgl v1.1.0 h1:0lzZ+rntPX3/oGrDzYGdowSLC2ky8Osirvf5uAwfIEA=
|
||||
github.com/go-gl/mathgl v1.1.0/go.mod h1:yhpkQzEiH9yPyxDUGzkmgScbaBVlhC06qodikEM0ZwQ=
|
||||
github.com/gookit/color v1.4.2/go.mod h1:fqRyamkC1W8uxl+lxCQxOT09l/vYfZ+QeiX3rKQHCoQ=
|
||||
github.com/gookit/color v1.5.0/go.mod h1:43aQb+Zerm/BWh2GnrgOQm7ffz7tvQXEKV6BFMl7wAo=
|
||||
github.com/gopxl/pixel v1.0.0 h1:ZON6ll6/tI6sO8fwrlj93GVUcXReTST5//iKv6lcd8g=
|
||||
github.com/gopxl/pixel v1.0.0/go.mod h1:kPUBG2He7/+alwmi5z0IwnpAc6pw2N7eA08cdBfoE/Q=
|
||||
github.com/hajimehoshi/ebiten/v2 v2.7.8 h1:QrlvF2byCzMuDsbxFReJkOCbM3O2z1H/NKQaGcA8PKk=
|
||||
github.com/hajimehoshi/ebiten/v2 v2.7.8/go.mod h1:Ulbq5xDmdx47P24EJ+Mb31Zps7vQq+guieG9mghQUaA=
|
||||
github.com/jezek/xgb v1.1.1 h1:bE/r8ZZtSv7l9gk6nU0mYx51aXrvnyb44892TwSaqS4=
|
||||
github.com/jezek/xgb v1.1.1/go.mod h1:nrhwO0FX/enq75I7Y7G8iN1ubpSGZEiA3v9e9GyRFlk=
|
||||
github.com/klauspost/cpuid/v2 v2.0.9/go.mod h1:FInQzS24/EEf25PyTYn52gqo7WaD8xa0213Md/qVLRg=
|
||||
github.com/klauspost/cpuid/v2 v2.0.10/go.mod h1:g2LTdtYhdyuGPqyWyv7qRAmj1WBqxuObKfj5c0PQa7c=
|
||||
github.com/klauspost/cpuid/v2 v2.0.12/go.mod h1:g2LTdtYhdyuGPqyWyv7qRAmj1WBqxuObKfj5c0PQa7c=
|
||||
github.com/kr/pretty v0.1.0/go.mod h1:dAy3ld7l9f0ibDNOQOHHMYYIIbhfbHSm3C4ZsoJORNo=
|
||||
github.com/kr/pty v1.1.1/go.mod h1:pFQYn66WHrOpPYNljwOMqo10TkYh1fy3cYio2l3bCsQ=
|
||||
github.com/kr/text v0.1.0/go.mod h1:4Jbv+DJW3UT/LiOwJeYQe1efqtUx/iVham/4vfdArNI=
|
||||
github.com/mattn/go-runewidth v0.0.9 h1:Lm995f3rfxdpd6TSmuVCHVb/QhupuXlYr8sCI/QdE+0=
|
||||
github.com/mattn/go-runewidth v0.0.9/go.mod h1:H031xJmbD/WCDINGzjvQ9THkh0rPKHF+m2gUSrubnMI=
|
||||
github.com/mattn/go-runewidth v0.0.13/go.mod h1:Jdepj2loyihRzMpdS35Xk/zdY8IAYHsh153qUoGf23w=
|
||||
github.com/nsf/termbox-go v1.1.1 h1:nksUPLCb73Q++DwbYUBEglYBRPZyoXJdrj5L+TkjyZY=
|
||||
github.com/nsf/termbox-go v1.1.1/go.mod h1:T0cTdVuOwf7pHQNtfhnEbzHbcNyCEcVU4YPpouCbVxo=
|
||||
github.com/pkg/errors v0.9.1 h1:FEBLx1zS214owpjy7qsBeixbURkuhQAwrK5UwLGTwt4=
|
||||
github.com/pkg/errors v0.9.1/go.mod h1:bwawxfHBFNV+L2hUp1rHADufV3IMtnDRdf1r5NINEl0=
|
||||
github.com/pmezard/go-difflib v1.0.0/go.mod h1:iKH77koFhYxTK1pcRnkKkqfTogsbg7gZNVY4sRDYZ/4=
|
||||
github.com/pterm/pterm v0.12.27/go.mod h1:PhQ89w4i95rhgE+xedAoqous6K9X+r6aSOI2eFF7DZI=
|
||||
github.com/pterm/pterm v0.12.29/go.mod h1:WI3qxgvoQFFGKGjGnJR849gU0TsEOvKn5Q8LlY1U7lg=
|
||||
github.com/pterm/pterm v0.12.30/go.mod h1:MOqLIyMOgmTDz9yorcYbcw+HsgoZo3BQfg2wtl3HEFE=
|
||||
github.com/pterm/pterm v0.12.31/go.mod h1:32ZAWZVXD7ZfG0s8qqHXePte42kdz8ECtRyEejaWgXU=
|
||||
github.com/pterm/pterm v0.12.33/go.mod h1:x+h2uL+n7CP/rel9+bImHD5lF3nM9vJj80k9ybiiTTE=
|
||||
github.com/pterm/pterm v0.12.36/go.mod h1:NjiL09hFhT/vWjQHSj1athJpx6H8cjpHXNAK5bUw8T8=
|
||||
github.com/pterm/pterm v0.12.40/go.mod h1:ffwPLwlbXxP+rxT0GsgDTzS3y3rmpAO1NMjUkGTYf8s=
|
||||
github.com/rivo/uniseg v0.2.0/go.mod h1:J6wj4VEh+S6ZtnVlnTBMWIodfgj8LQOQFoIToxlJtxc=
|
||||
github.com/sergi/go-diff v1.2.0/go.mod h1:STckp+ISIX8hZLjrqAeVduY0gWCT9IjLuqbuNXdaHfM=
|
||||
github.com/stretchr/objx v0.1.0/go.mod h1:HFkY916IF+rwdDfMAkV7OtwuqBVzrE8GR6GFx+wExME=
|
||||
github.com/stretchr/testify v1.4.0/go.mod h1:j7eGeouHqKxXV5pUuKE4zz7dFj8WfuZ+81PSLYec5m4=
|
||||
github.com/stretchr/testify v1.6.1/go.mod h1:6Fq8oRcR53rry900zMqJjRRixrwX3KX962/h/Wwjteg=
|
||||
github.com/stretchr/testify v1.7.0/go.mod h1:6Fq8oRcR53rry900zMqJjRRixrwX3KX962/h/Wwjteg=
|
||||
github.com/xo/terminfo v0.0.0-20210125001918-ca9a967f8778/go.mod h1:2MuV+tbUrU1zIOPMxZ5EncGwgmMJsa+9ucAQZXxsObs=
|
||||
golang.org/x/image v0.0.0-20190321063152-3fc05d484e9f/go.mod h1:kZ7UVZpmo3dzQBMxlp+ypCbDeSB+sBbTgSJuh5dn5js=
|
||||
golang.org/x/image v0.18.0 h1:jGzIakQa/ZXI1I0Fxvaa9W7yP25TqT6cHIHn+6CqvSQ=
|
||||
golang.org/x/image v0.18.0/go.mod h1:4yyo5vMFQjVjUcVk4jEQcU9MGy/rulF5WvUILseCM2E=
|
||||
golang.org/x/sync v0.7.0 h1:YsImfSBoP9QPYL0xyKJPq0gcaJdG3rInoqxTWbfQu9M=
|
||||
golang.org/x/sync v0.7.0/go.mod h1:Czt+wKu1gCyEFDUtn0jG5QVvpJ6rzVqr5aXyt9drQfk=
|
||||
golang.org/x/sys v0.0.0-20201119102817-f84b799fce68/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs=
|
||||
golang.org/x/sys v0.0.0-20210124154548-22da62e12c0c/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs=
|
||||
golang.org/x/sys v0.0.0-20210330210617-4fbd30eecc44/go.mod h1:h1NjWce9XRLGQEsW7wpKNCjG9DtNlClVuFLEZdDNbEs=
|
||||
golang.org/x/sys v0.0.0-20210615035016-665e8c7367d1/go.mod h1:oPkhp1MJrh7nUepCBck5+mAzfO9JrbApNNgaTdGDITg=
|
||||
golang.org/x/sys v0.0.0-20211013075003-97ac67df715c/go.mod h1:oPkhp1MJrh7nUepCBck5+mAzfO9JrbApNNgaTdGDITg=
|
||||
golang.org/x/sys v0.0.0-20220319134239-a9b59b0215f8/go.mod h1:oPkhp1MJrh7nUepCBck5+mAzfO9JrbApNNgaTdGDITg=
|
||||
golang.org/x/sys v0.22.0 h1:RI27ohtqKCnwULzJLqkv897zojh5/DwS/ENaMzUOaWI=
|
||||
golang.org/x/sys v0.22.0/go.mod h1:/VUhepiaJMQUp4+oa/7Zr1D23ma6VTLIYjOOTFZPUcA=
|
||||
golang.org/x/term v0.0.0-20210220032956-6a3ed077a48d/go.mod h1:bj7SfCRtBDWHUb9snDiAeCFNEtKQo2Wmx5Cou7ajbmo=
|
||||
golang.org/x/term v0.0.0-20210615171337-6886f2dfbf5b/go.mod h1:jbD1KX2456YbFQfuXm/mYQcufACuNUgVhRMnK/tPxf8=
|
||||
golang.org/x/term v0.0.0-20210927222741-03fcf44c2211/go.mod h1:jbD1KX2456YbFQfuXm/mYQcufACuNUgVhRMnK/tPxf8=
|
||||
golang.org/x/term v0.22.0 h1:BbsgPEJULsl2fV/AT3v15Mjva5yXKQDyKf+TbDz7QJk=
|
||||
golang.org/x/term v0.22.0/go.mod h1:F3qCibpT5AMpCRfhfT53vVJwhLtIVHhB9XDjfFvnMI4=
|
||||
golang.org/x/text v0.3.0/go.mod h1:NqM8EUOU14njkJ3fqMW+pc6Ldnwhi/IjpwHt7yyuwOQ=
|
||||
gopkg.in/check.v1 v0.0.0-20161208181325-20d25e280405/go.mod h1:Co6ibVJAznAaIkqp8huTwlJQCZ016jof/cbN4VW5Yz0=
|
||||
gopkg.in/check.v1 v1.0.0-20190902080502-41f04d3bba15/go.mod h1:Co6ibVJAznAaIkqp8huTwlJQCZ016jof/cbN4VW5Yz0=
|
||||
gopkg.in/yaml.v2 v2.2.2/go.mod h1:hI93XBmqTisBFMUTm0b8Fm+jr3Dg1NNxqwp+5A1VGuI=
|
||||
gopkg.in/yaml.v2 v2.2.4/go.mod h1:hI93XBmqTisBFMUTm0b8Fm+jr3Dg1NNxqwp+5A1VGuI=
|
||||
gopkg.in/yaml.v3 v3.0.0-20200313102051-9f266ea9e77c/go.mod h1:K4uyk7z7BCEPqu6E+C64Yfv1cQ7kz7rIZviUmN+EgEM=
|
||||
gopkg.in/yaml.v3 v3.0.0-20210107192922-496545a6307b/go.mod h1:K4uyk7z7BCEPqu6E+C64Yfv1cQ7kz7rIZviUmN+EgEM=
|
||||
29
tridoraemu/irqc.go
Normal file
29
tridoraemu/irqc.go
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
// Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
package main
|
||||
import (
|
||||
"time"
|
||||
// "fmt"
|
||||
)
|
||||
|
||||
const MSecsPerTick = 50
|
||||
|
||||
type IRQC struct {
|
||||
start time.Time
|
||||
}
|
||||
|
||||
func (i *IRQC) initialize() {
|
||||
i.start = time.Now()
|
||||
}
|
||||
|
||||
func (i *IRQC) read(byteaddr word) (word, error) {
|
||||
elapsedms := time.Since(i.start).Milliseconds()
|
||||
elapsedTicks := elapsedms / MSecsPerTick
|
||||
result := word((elapsedTicks & 0x0FFFFFFF) << 8)
|
||||
//fmt.Printf("** IRQC read: %08X (%v)\n", result, elapsedms)
|
||||
return result, nil
|
||||
}
|
||||
|
||||
func (i *IRQC) write(value word, byteaddr word) (error) {
|
||||
return nil
|
||||
}
|
||||
|
||||
117
tridoraemu/mem.go
Normal file
117
tridoraemu/mem.go
Normal file
|
|
@ -0,0 +1,117 @@
|
|||
// Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
package main
|
||||
import (
|
||||
"fmt"
|
||||
"log"
|
||||
"os"
|
||||
"io"
|
||||
"bufio"
|
||||
"encoding/binary"
|
||||
)
|
||||
|
||||
const IOStartAddr = 2048
|
||||
|
||||
const RAMStartAddr = 4096
|
||||
|
||||
const IOSlotSize = 128
|
||||
|
||||
const IOSlotCount = 16
|
||||
|
||||
type Mem struct {
|
||||
ram [] word
|
||||
iohandler [IOSlotCount] IOHandler
|
||||
}
|
||||
|
||||
func (m *Mem) wordAddr(byteaddr word) (int, error) {
|
||||
wordaddr := int(byteaddr / 4)
|
||||
if wordaddr >= len(m.ram) {
|
||||
return 0, fmt.Errorf("Invalid address %08X", byteaddr)
|
||||
}
|
||||
return wordaddr, nil
|
||||
}
|
||||
|
||||
func (m *Mem) initialize(sizewords int) {
|
||||
m.ram = make([] word, sizewords)
|
||||
for i := 0; i < len(m.ram); i++ {
|
||||
m.ram[i] = 0
|
||||
}
|
||||
}
|
||||
|
||||
func (m *Mem) loadFromFile(path string, startAddr int) {
|
||||
f, err := os.Open(path)
|
||||
if err != nil {
|
||||
panic(err)
|
||||
}
|
||||
defer f.Close()
|
||||
|
||||
buf := make([]byte,4)
|
||||
|
||||
reader := bufio.NewReader(f)
|
||||
count := 0
|
||||
wordaddr := startAddr / 4
|
||||
for {
|
||||
n, e := reader.Read(buf)
|
||||
if e != nil && e != io.EOF {
|
||||
panic(e)
|
||||
}
|
||||
if n < 4 {
|
||||
if n == 2 {
|
||||
m.ram[wordaddr] = word(binary.BigEndian.Uint32(buf) & 0xFFFF0000)
|
||||
count += 2
|
||||
}
|
||||
|
||||
fmt.Printf("%v bytes read at %08X from %v\n", count, startAddr, path)
|
||||
break
|
||||
} else {
|
||||
m.ram[wordaddr] = word(binary.BigEndian.Uint32(buf))
|
||||
// fmt.Printf("%08X %08X\n", addr, m.ram[addr])
|
||||
count += 4
|
||||
wordaddr += 1
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
func (m *Mem) attachIO(h IOHandler, slot int) {
|
||||
if m.iohandler[slot] != nil {
|
||||
log.Panicf("I/O handler %d already attached", slot)
|
||||
}
|
||||
|
||||
m.iohandler[slot] = h
|
||||
}
|
||||
|
||||
func (m *Mem) read(byteaddr word) (word, error) {
|
||||
if byteaddr >= IOStartAddr && byteaddr < RAMStartAddr {
|
||||
ioslot := (byteaddr - IOStartAddr) / IOSlotSize
|
||||
if m.iohandler[ioslot] != nil {
|
||||
return m.iohandler[ioslot].read(byteaddr)
|
||||
}
|
||||
return 42, nil
|
||||
}
|
||||
|
||||
wordaddr, err := m.wordAddr(byteaddr)
|
||||
if err == nil {
|
||||
return m.ram[wordaddr], err
|
||||
} else {
|
||||
return 0, err
|
||||
}
|
||||
}
|
||||
|
||||
func (m *Mem) write(value word, byteaddr word) error {
|
||||
if byteaddr < IOStartAddr {
|
||||
return fmt.Errorf("Write to ROM area at %08X value %08X", byteaddr, value)
|
||||
}
|
||||
|
||||
if byteaddr >= IOStartAddr && byteaddr < RAMStartAddr {
|
||||
ioslot := (byteaddr - IOStartAddr) / IOSlotSize
|
||||
if m.iohandler[ioslot] != nil {
|
||||
return m.iohandler[ioslot].write(value, byteaddr)
|
||||
}
|
||||
return nil
|
||||
}
|
||||
|
||||
wordaddr, err := m.wordAddr(byteaddr)
|
||||
if err == nil {
|
||||
m.ram[wordaddr] = value
|
||||
}
|
||||
return err
|
||||
}
|
||||
272
tridoraemu/sdspi.go
Normal file
272
tridoraemu/sdspi.go
Normal file
|
|
@ -0,0 +1,272 @@
|
|||
// Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
package main
|
||||
|
||||
import (
|
||||
"os"
|
||||
"io"
|
||||
"encoding/binary"
|
||||
"fmt"
|
||||
)
|
||||
|
||||
type SDState uint
|
||||
|
||||
const (
|
||||
IDLE SDState = iota
|
||||
WRCMD
|
||||
WRDATA
|
||||
RDDATA
|
||||
)
|
||||
|
||||
const (
|
||||
CTRL_WRITE = 0b100000000000000
|
||||
RX_FILTER_EN = 0b010000000000000
|
||||
TXRX_EN = 0b001000000000000
|
||||
CLK_F_EN = 0b000100000000000
|
||||
CLK_DIV_WR = 0b000010000000000
|
||||
RX_RD = 0b000001000000000
|
||||
TX_WR = 0b000000100000000
|
||||
|
||||
C_D = 0b100000000000000
|
||||
C_CHG = 0b010000000000000
|
||||
C_BUSY = 0b001000000000000
|
||||
TX_RDY = 0b000100000000000
|
||||
TX_EMPTY = 0b000010000000000
|
||||
RX_AVAIL = 0b000001000000000
|
||||
RX_OVR = 0b000000100000000
|
||||
)
|
||||
|
||||
type SDSPI struct {
|
||||
state SDState
|
||||
ksectors uint
|
||||
lastSector uint
|
||||
imgfile *os.File
|
||||
cmd uint
|
||||
cmdcount uint
|
||||
arg uint
|
||||
receiving bool
|
||||
blockaddr uint
|
||||
readbuf []byte
|
||||
readpos int
|
||||
writebuf []byte
|
||||
writepos int
|
||||
debug bool
|
||||
dbgwaiten bool
|
||||
}
|
||||
|
||||
func (s *SDSPI) openImage(filename string) error {
|
||||
var err error
|
||||
s.imgfile, err = os.OpenFile(filename, os.O_RDWR, 0644)
|
||||
if err != nil { return err }
|
||||
|
||||
buf := make([]byte,4)
|
||||
_, err = s.imgfile.ReadAt(buf, 48)
|
||||
if err != nil { return err }
|
||||
|
||||
blocks := binary.BigEndian.Uint32(buf)
|
||||
|
||||
s.ksectors = uint(blocks / 1024)
|
||||
s.lastSector = uint(blocks - 1)
|
||||
|
||||
fmt.Printf("opened SD card image %v, PHYS blocks: %v\n", filename, blocks)
|
||||
|
||||
return nil
|
||||
}
|
||||
|
||||
func (s *SDSPI) closeImage() {
|
||||
s.imgfile.Close()
|
||||
}
|
||||
|
||||
func (s *SDSPI) read(byteaddr word) (word, error) {
|
||||
result := word(0)
|
||||
|
||||
// always detect a card, transmitter always ready
|
||||
result = C_D | TX_RDY
|
||||
|
||||
if s.debug {
|
||||
fmt.Printf("** SDSPI read readbuf len: %v receiving: %v readpos: %v\n",
|
||||
len(s.readbuf), s.receiving, s.readpos)
|
||||
}
|
||||
|
||||
if s.receiving && len(s.readbuf) > 0 {
|
||||
if s.debug { fmt.Printf(" byte: %02X\n", s.readbuf[s.readpos]) }
|
||||
result |= RX_AVAIL // there is data to be read
|
||||
result |= word(s.readbuf[s.readpos])
|
||||
// the read position is advanced only by writing RX_RD to the
|
||||
// SDSPI register
|
||||
|
||||
} else {
|
||||
result |= 0xFF
|
||||
}
|
||||
|
||||
|
||||
// always signal TX_EMPTY since we immediately process
|
||||
// all written data
|
||||
result |= TX_EMPTY
|
||||
|
||||
return result, nil
|
||||
}
|
||||
|
||||
func (s *SDSPI) sendIdleResponse() {
|
||||
s.readbuf = []byte{0x01}
|
||||
}
|
||||
|
||||
func (s *SDSPI) sendOkResponse() {
|
||||
s.readbuf = []byte{0x00}
|
||||
}
|
||||
|
||||
func (s *SDSPI) sendDataResponse() {
|
||||
s.readbuf = []byte{0b00101}
|
||||
}
|
||||
|
||||
func (s *SDSPI) sendBusy() {
|
||||
s.readbuf = append(s.readbuf, 0xFF, 0x00, 0xFF)
|
||||
}
|
||||
|
||||
func (s *SDSPI) sendDataPkt(dataBytes []byte) {
|
||||
s.readbuf = append(s.readbuf, 0xFE) // data token
|
||||
s.readbuf = append(s.readbuf, dataBytes...) // data block
|
||||
s.readbuf = append(s.readbuf, 0, 0) // crc/unused in SPI mode
|
||||
}
|
||||
|
||||
func (s *SDSPI) sendCSD() {
|
||||
size := s.ksectors - 1
|
||||
|
||||
sizehi := byte((size & 0b1111110000000000000000) >> 16)
|
||||
sizemid := byte((size & 0b0000001111111100000000) >> 8)
|
||||
sizelow := byte((size & 0b0000000000000011111111))
|
||||
|
||||
s.sendDataPkt( []byte{0b01000000,
|
||||
0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6,
|
||||
sizehi, sizemid, sizelow,
|
||||
0xCA, 0xCB, 0xCC, 0xCD, 0xCE, 0xCF})
|
||||
}
|
||||
|
||||
func (s *SDSPI) readSendBlock() {
|
||||
buf := make([]byte, 512)
|
||||
|
||||
if s.arg <= s.lastSector {
|
||||
s.imgfile.Seek(int64(s.arg) * 512, 0)
|
||||
_, err := s.imgfile.Read(buf)
|
||||
if err != nil && err != io.EOF { panic(err) }
|
||||
}
|
||||
|
||||
s.sendDataPkt(buf)
|
||||
}
|
||||
|
||||
func (s *SDSPI) writeBlock() {
|
||||
if s.arg <= s.lastSector {
|
||||
s.imgfile.Seek(int64(s.arg) * 512, 0)
|
||||
_, err := s.imgfile.Write(s.writebuf)
|
||||
if err != nil { panic(err) }
|
||||
}
|
||||
s.writebuf = make([]byte, 0)
|
||||
s.writepos = 0
|
||||
}
|
||||
|
||||
func (s *SDSPI) write(value word, byteaddr word) (error) {
|
||||
if (value & CTRL_WRITE) != 0 {
|
||||
s.receiving = (value & TXRX_EN) != 0
|
||||
}
|
||||
|
||||
if s.debug { fmt.Printf("** SDSPI write %032b\n", value) }
|
||||
|
||||
if (value & CLK_DIV_WR) != 0 {
|
||||
if s.debug {
|
||||
fmt.Printf("** SDSPI clock divider set to %v\n", value & 0xFF)
|
||||
}
|
||||
}
|
||||
|
||||
if (value & RX_RD) != 0 {
|
||||
// advance read position when RX_RD i set
|
||||
s.readpos += 1
|
||||
if s.readpos >= len(s.readbuf) {
|
||||
s.readbuf = make([]byte, 0)
|
||||
s.readpos = 0
|
||||
// if in WRDATA state, do not go IDLE when all data has been read.
|
||||
// In that case, we just read the R1 response for the write command
|
||||
// and after that the data packet will be written.
|
||||
if s.state != WRDATA { s.state = IDLE }
|
||||
}
|
||||
}
|
||||
|
||||
if (value & TX_WR) != 0 {
|
||||
// we ignore the TXRX_EN flag for the transmitter and
|
||||
// always process data written with TX_WR
|
||||
value8 := value & 0xFF
|
||||
switch s.state {
|
||||
case IDLE:
|
||||
if value8 != 0xFF {
|
||||
s.state = WRCMD
|
||||
s.cmd = uint(value & 0x3F)
|
||||
s.arg = 0
|
||||
s.cmdcount = 5
|
||||
if s.debug {
|
||||
fmt.Printf(" cmd: %02d\n", s.cmd)
|
||||
}
|
||||
}
|
||||
case WRCMD:
|
||||
if s.cmdcount > 0 { // any more argument bytes to be received?
|
||||
s.cmdcount -= 1
|
||||
if s.cmdcount == 0 {
|
||||
s.state = RDDATA
|
||||
switch s.cmd {
|
||||
case 0: s.sendIdleResponse() // GO_IDLE_STATE
|
||||
case 8: s.readbuf = []byte{0x01, 0xA1, 0xA2, 0xA3, 0xA4} // SEND_IF_COND
|
||||
case 9: s.sendOkResponse() // SEND_CSD
|
||||
s.sendCSD()
|
||||
case 16: s.sendOkResponse() // SET_BLOCKLEN, ignored
|
||||
case 17: s.sendOkResponse() // READ_SINGLE_BLOCK
|
||||
s.readSendBlock()
|
||||
case 24: s.sendOkResponse() // WRITE_SINGLE_BLOCK
|
||||
s.sendOkResponse()
|
||||
s.state = WRDATA
|
||||
case 58: s.readbuf = []byte{0x01, 0xB1, 0xB2, 0xB3, 0xB4} // READ_OCR
|
||||
case 55: s.sendIdleResponse() // APP_CMD, we just ignore it and treat CMD41 as ACMD41
|
||||
case 41: s.sendOkResponse() // APP_SEND_OP_COND
|
||||
default:
|
||||
if s.debug {
|
||||
fmt.Printf("** SDSPI invalid CMD %v\n", s.cmd)
|
||||
}
|
||||
}
|
||||
} else {
|
||||
// process an argument byte
|
||||
s.arg = uint((s.arg << 8)) | uint(value8)
|
||||
}
|
||||
} else {
|
||||
if s.debug {
|
||||
fmt.Printf("** SDSPI extra bytes in command %v\n", value8)
|
||||
}
|
||||
}
|
||||
case WRDATA:
|
||||
if len(s.writebuf) == 0 {
|
||||
// wait for data token
|
||||
if value8 == 0xFE { // data token found
|
||||
s.writebuf = make([]byte, 512)
|
||||
s.writepos = 0
|
||||
}
|
||||
} else { // collecting data bytes to write
|
||||
if s.writepos < 512 {
|
||||
s.writebuf[s.writepos] = byte(value8)
|
||||
}
|
||||
s.writepos += 1
|
||||
// after getting and ignoring two crc bytes, write block
|
||||
// and return to idle state
|
||||
if s.writepos >= 514 {
|
||||
s.state = IDLE
|
||||
s.writeBlock()
|
||||
s.sendDataResponse()
|
||||
s.sendBusy()
|
||||
}
|
||||
}
|
||||
default:
|
||||
if value8 != 0xFF {
|
||||
if s.debug {
|
||||
fmt.Printf("** SDSPI invalid state %v on TX_WR byte %v\n", s.state, value8)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return nil
|
||||
}
|
||||
|
||||
159
tridoraemu/tridoraemu.go
Normal file
159
tridoraemu/tridoraemu.go
Normal file
|
|
@ -0,0 +1,159 @@
|
|||
// Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
package main
|
||||
|
||||
import (
|
||||
"fmt"
|
||||
"log"
|
||||
"errors"
|
||||
"flag"
|
||||
"time"
|
||||
"github.com/hajimehoshi/ebiten/v2"
|
||||
// "github.com/hajimehoshi/ebiten/v2/ebitenutil"
|
||||
// "image/color"
|
||||
)
|
||||
|
||||
const IdleTicks = 1000
|
||||
|
||||
var consoleChan chan byte
|
||||
var cpu CPU
|
||||
var mem Mem
|
||||
var uart UART
|
||||
var framebuffer Framebuffer
|
||||
var sdspi SDSPI
|
||||
var irqc IRQC
|
||||
|
||||
var Terminated = errors.New("terminated")
|
||||
|
||||
var idleCounter int = IdleTicks
|
||||
|
||||
func idle(canGoIdle bool) {
|
||||
if canGoIdle {
|
||||
if idleCounter > 0 { idleCounter -= 1 }
|
||||
} else {
|
||||
if idleCounter != IdleTicks { idleCounter = IdleTicks }
|
||||
}
|
||||
}
|
||||
|
||||
type Game struct{
|
||||
x,y int
|
||||
stepsPerFrame int
|
||||
lastFrameDuration time.Duration
|
||||
}
|
||||
|
||||
func (g *Game) Update() error {
|
||||
startTime := time.Now()
|
||||
|
||||
for i := 0; i < g.stepsPerFrame; i++ {
|
||||
err := cpu.step()
|
||||
if err != nil {
|
||||
log.Printf("Stopped by error at PC %08X",cpu.PC)
|
||||
log.Print(err)
|
||||
return Terminated
|
||||
}
|
||||
|
||||
if cpu.stopped { return Terminated }
|
||||
|
||||
if idleCounter == 0 { break }
|
||||
}
|
||||
g.lastFrameDuration = time.Since(startTime)
|
||||
|
||||
return nil
|
||||
}
|
||||
|
||||
func (g *Game) Draw(screen *ebiten.Image) {
|
||||
screen.DrawImage(framebuffer.framebuffer, nil)
|
||||
|
||||
/*
|
||||
buf := fmt.Sprintf("PC: %08X FP: %08X RP: %08X ESP: %2X\n%v", cpu.PC, cpu.FP, cpu.RP, cpu.ESP, g.lastFrameDuration)
|
||||
ebitenutil.DebugPrint(screen, buf)
|
||||
|
||||
screen.Set(g.x, g.y, color.RGBA{255,0,0,0})
|
||||
screen.Set(g.x, g.y+1, color.RGBA{0,255,0,0})
|
||||
screen.Set(g.x, g.y+2, color.RGBA{0,255,255,0})
|
||||
screen.Set(g.x, g.y+3, color.RGBA{255,255,255,0})
|
||||
g.x += 1
|
||||
if g.x > 319 { g.x = 0 }
|
||||
*/
|
||||
|
||||
// if idleCounter == 0 { ebitenutil.DebugPrint(screen, "idle") }
|
||||
}
|
||||
|
||||
func (g *Game) Layout(outsideWidth, outsideHeight int) (screenWidth, screenHeight int) {
|
||||
return 640, 400
|
||||
}
|
||||
|
||||
func main() {
|
||||
var codefile string = ""
|
||||
|
||||
addrPtr := flag.Int("a",0,"starting address")
|
||||
tracePtr := flag.Bool("t",false,"trace")
|
||||
cardImgPtr := flag.String("i", "sdcard.img", "SD card image file")
|
||||
flag.Parse()
|
||||
if len(flag.Args()) > 0 {
|
||||
codefile = flag.Args()[0]
|
||||
} else {
|
||||
codefile = "rommon.prog"
|
||||
}
|
||||
|
||||
log.SetFlags(0)
|
||||
oldState, err := SetRawConsole()
|
||||
if err != nil {
|
||||
panic(err)
|
||||
}
|
||||
defer RestoreConsole(oldState)
|
||||
|
||||
cpu.initialize()
|
||||
mem.initialize(4096 * 1024 / 4)
|
||||
|
||||
uart.cpu = &cpu
|
||||
mem.attachIO(&uart, 0)
|
||||
|
||||
err = sdspi.openImage(*cardImgPtr)
|
||||
if err != nil {
|
||||
panic(err)
|
||||
}
|
||||
defer sdspi.closeImage()
|
||||
//sdspi.debug = true
|
||||
mem.attachIO(&sdspi, 1)
|
||||
|
||||
framebuffer.initialize()
|
||||
mem.attachIO(&framebuffer, 2)
|
||||
|
||||
irqc.initialize()
|
||||
mem.attachIO(&irqc, 3)
|
||||
|
||||
cpu.mem = &mem
|
||||
cpu.PC = word(*addrPtr)
|
||||
|
||||
if codefile != "" {
|
||||
mem.loadFromFile(codefile, *addrPtr)
|
||||
}
|
||||
|
||||
consoleChan = make(chan byte)
|
||||
uart.consoleChan = make(chan byte)
|
||||
|
||||
ebiten.SetWindowSize(800, 600)
|
||||
ebiten.SetWindowTitle("Tridora Framebuffer")
|
||||
|
||||
g := Game{}
|
||||
cpu.trace = *tracePtr
|
||||
g.stepsPerFrame = 166666
|
||||
// g.stepsPerFrame = 1
|
||||
|
||||
go func(ch chan byte) {
|
||||
for {
|
||||
buf := make([] byte,1);
|
||||
n, err := ConsoleRead(buf)
|
||||
if err != nil {
|
||||
fmt.Println("read error on stdin, closing channel")
|
||||
close(ch)
|
||||
return
|
||||
}
|
||||
if n > 0 {ch <- buf[0] }
|
||||
}
|
||||
}(uart.consoleChan)
|
||||
|
||||
if err := ebiten.RunGame(&g); err != Terminated && err != nil {
|
||||
log.Panic(err)
|
||||
}
|
||||
}
|
||||
59
tridoraemu/uart.go
Normal file
59
tridoraemu/uart.go
Normal file
|
|
@ -0,0 +1,59 @@
|
|||
// Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
package main
|
||||
import (
|
||||
// "fmt"
|
||||
"os"
|
||||
"errors"
|
||||
)
|
||||
|
||||
type UART struct {
|
||||
available bool
|
||||
buf [] byte
|
||||
consoleChan chan byte
|
||||
cpu *CPU
|
||||
}
|
||||
|
||||
func (u *UART) read(byteaddr word) (word, error) {
|
||||
var result word = 0
|
||||
|
||||
if len(u.buf) > 0 {
|
||||
result = word(u.buf[0])
|
||||
result |= 512
|
||||
} else {
|
||||
select {
|
||||
case inbyte, ok := <-u.consoleChan:
|
||||
if ! ok {
|
||||
return 0, errors.New("console channel error")
|
||||
} else {
|
||||
u.buf = make([]byte, 1)
|
||||
u.buf[0] = inbyte
|
||||
// fmt.Println("Read input:", inbyte)
|
||||
idle(false)
|
||||
}
|
||||
default:
|
||||
idle(true)
|
||||
}
|
||||
}
|
||||
|
||||
return result, nil
|
||||
}
|
||||
|
||||
func (u *UART) write(value word, byteaddr word) (error) {
|
||||
var err error = nil
|
||||
|
||||
idle(false)
|
||||
|
||||
if value & 512 != 0 {
|
||||
u.buf = u.buf[1:]
|
||||
// fmt.Println("rx_clear: len ", len(u.buf))
|
||||
}
|
||||
|
||||
if value & 1024 != 0 {
|
||||
buf := make([] byte, 1)
|
||||
buf[0] = byte(value & 255)
|
||||
_ , err = os.Stdout.Write(buf)
|
||||
}
|
||||
|
||||
return err
|
||||
}
|
||||
|
||||
567
utils/tdrimg.py
Normal file
567
utils/tdrimg.py
Normal file
|
|
@ -0,0 +1,567 @@
|
|||
#!/usr/bin/python3
|
||||
# vim: tabstop=8 expandtab shiftwidth=4 softtabstop=4
|
||||
# Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
|
||||
|
||||
import struct
|
||||
import sys
|
||||
from collections import namedtuple
|
||||
import os
|
||||
|
||||
MaxPartitions = 8
|
||||
SlotFree = 1
|
||||
SlotReserved = 2
|
||||
SlotDeleted = 4
|
||||
SlotEndScan = 8
|
||||
SlotFirst = 16
|
||||
SlotExtent = 32
|
||||
SlotReadonly = 64
|
||||
|
||||
PartEnabled = 1
|
||||
PartBoot = 2
|
||||
PartLast = 4
|
||||
PartPhysical = 8
|
||||
PartDefault = 16
|
||||
|
||||
part_fmt = ">ii32siiiiii"
|
||||
dirslot_fmt = ">ii32siiiiii"
|
||||
|
||||
PartSlot = namedtuple("PartSlot", "namelength maxlength name flags startBlock blocks extentSize dirSize bootBlocks")
|
||||
DirSlot = namedtuple("DirSlot", "namelength maxlength name flags sizeBytes createTime modTime generation owner")
|
||||
|
||||
def createpart(name, flags, start_block, blocks, extent_size, dir_size, boot_blocks=0):
|
||||
b = struct.pack(part_fmt, len(name), 32, bytes(name, 'utf8'), flags, start_block, blocks,
|
||||
extent_size, dir_size, boot_blocks)
|
||||
return b
|
||||
|
||||
|
||||
def decodepart(data):
|
||||
return struct.unpack(part_fmt, data)
|
||||
|
||||
|
||||
def getpartslot(img, partno):
|
||||
img.seek(partno * 64)
|
||||
fields = decodepart(img.read(64))
|
||||
name = getname(fields)
|
||||
fields = list(fields)
|
||||
fields[2] = name
|
||||
return PartSlot._make(fields)
|
||||
|
||||
|
||||
def createdirslot(name, flags, size, create_time, mod_time, generation, owner):
|
||||
return struct.pack(dirslot_fmt, len(name), 32, bytes(name, 'utf8'), flags, size, create_time,
|
||||
mod_time, generation, owner)
|
||||
|
||||
|
||||
def decodedirslot(data):
|
||||
return struct.unpack(dirslot_fmt, data)
|
||||
|
||||
|
||||
def putdirslot(img, partstart, slotno, slotdata):
|
||||
img.seek(partstart * 512 + slotno * 64)
|
||||
img.write(slotdata)
|
||||
|
||||
|
||||
def getdirslot(img, part, slotno):
|
||||
partstart = part.startBlock
|
||||
img.seek(partstart * 512 + slotno * 64)
|
||||
fields = decodedirslot(img.read(64))
|
||||
name = getname(fields)
|
||||
fields = list(fields)
|
||||
fields[2] = name
|
||||
return DirSlot._make(fields)
|
||||
|
||||
|
||||
def writefile(img, part, slotno, databytes):
|
||||
partstart = part.startBlock
|
||||
extent_size = part.extentSize
|
||||
pos = partstart * 512 + slotno * extent_size
|
||||
|
||||
print("writefile: slot", slotno, len(databytes), "bytes at block", partstart + slotno * extent_size // 512, " pos",
|
||||
pos)
|
||||
img.seek(pos)
|
||||
img.write(databytes)
|
||||
extendfile(img, part, slotno, len(databytes))
|
||||
|
||||
|
||||
def write_bootimage(img, startblock, data):
|
||||
pos = startblock * 512
|
||||
img.seek(pos)
|
||||
img.write(data)
|
||||
|
||||
|
||||
def extendfile(img, part, slotno, newSize):
|
||||
dirslot = getdirslot(img, part, slotno)
|
||||
extent_size = part.extentSize
|
||||
old_extents = dirslot.sizeBytes // extent_size + 1
|
||||
new_extents = newSize // extent_size + 1
|
||||
old_last_slot = slotno + 1
|
||||
new_last_slot = slotno + new_extents - 1
|
||||
print("extendfile old_last_slot {} new_last_slot {} old_ext {} new_ext {} ".format(
|
||||
old_last_slot, new_last_slot, old_extents, new_extents), end="")
|
||||
|
||||
for i in range(old_last_slot, new_last_slot + 1):
|
||||
d = getdirslot(img, part, i)
|
||||
if d.flags & SlotFree:
|
||||
print(i," ", sep="", end="")
|
||||
d = createdirslot("", SlotExtent, 0, 0, 0, 0, 0)
|
||||
putdirslot(img, part.startBlock, i, d)
|
||||
else:
|
||||
print("Cannot extend file at dirslot",i, "- wanted size:", newSize)
|
||||
listdir(img, part)
|
||||
sys.exit(3)
|
||||
print()
|
||||
if old_extents != new_extents:
|
||||
print("file at dirslot",slotno, "extended to", new_extents, "extents")
|
||||
|
||||
firstslot = createdirslot(dirslot.name, dirslot.flags, newSize, dirslot.createTime, dirslot.modTime,
|
||||
dirslot.generation, dirslot.owner)
|
||||
putdirslot(img, part.startBlock, slotno, firstslot)
|
||||
|
||||
|
||||
def findslots(img, part, size):
|
||||
size_in_extents = (size + part.extentSize - 1) // part.extentSize
|
||||
last_slot = part.dirSize - 1
|
||||
|
||||
found = False
|
||||
firstslot = 0
|
||||
|
||||
slotno = 0
|
||||
|
||||
while slotno <= last_slot and not found:
|
||||
dirslot = getdirslot(img, part, slotno)
|
||||
if dirslot.flags & SlotFree:
|
||||
found = True
|
||||
firstslot = slotno
|
||||
print("found free slot at",slotno, ":", dirslot)
|
||||
if size_in_extents > 1:
|
||||
print("checking slot ", end='')
|
||||
for s in range(1, size_in_extents):
|
||||
slotno += 1
|
||||
print(slotno, " ", end='')
|
||||
dirslot = getdirslot(img, part, slotno)
|
||||
if not (dirslot.flags & SlotFree):
|
||||
print("wanted slot",slotno,"not free")
|
||||
found = False
|
||||
break
|
||||
print()
|
||||
else:
|
||||
slotno += 1
|
||||
|
||||
if found:
|
||||
return firstslot
|
||||
else:
|
||||
return 0
|
||||
|
||||
|
||||
def putfile(infilename, filename, img, part, partstart, slotnr):
|
||||
if filename is None:
|
||||
filename = os.path.basename(infilename)
|
||||
try:
|
||||
extent_size = part.extentSize
|
||||
|
||||
with open(infilename,"rb") as infile:
|
||||
print("creating file", filename, "at slot", slotnr)
|
||||
content = infile.read()
|
||||
d = createdirslot(filename, SlotFirst, len(content), 0, 0, 0, 0)
|
||||
putdirslot(img, partstart, slotnr, d)
|
||||
writefile(img, part, slotnr, content)
|
||||
slotnr += len(content) // extent_size + 1
|
||||
except Exception as e:
|
||||
print("error reading file", infilename, "skipping", e)
|
||||
return slotnr
|
||||
|
||||
|
||||
def getname(data):
|
||||
length = data[0]
|
||||
name = data[2][:length].decode('utf8')
|
||||
return name
|
||||
|
||||
|
||||
def flags2str(flags):
|
||||
result = ""
|
||||
if flags & SlotFree:
|
||||
result += "F"
|
||||
if flags & SlotReserved:
|
||||
result += "R"
|
||||
if flags & SlotDeleted:
|
||||
result += "D"
|
||||
if flags & SlotEndScan:
|
||||
result += "E"
|
||||
if flags & SlotFirst:
|
||||
result += "1"
|
||||
if flags & SlotExtent:
|
||||
result += "+"
|
||||
if flags & SlotReadonly:
|
||||
result += "o"
|
||||
return result
|
||||
|
||||
|
||||
def findvolume(img, volname):
|
||||
part = None
|
||||
partno = 0
|
||||
|
||||
while True:
|
||||
part = getpartslot(img, partno)
|
||||
if part.flags & PartEnabled:
|
||||
if part.name == volname:
|
||||
break
|
||||
|
||||
partno += 1
|
||||
if (part.flags & PartLast) or partno >= MaxPartitions:
|
||||
part = None
|
||||
break
|
||||
|
||||
return part
|
||||
|
||||
|
||||
def listvolumes(img):
|
||||
firstvolume = None
|
||||
partno = 0
|
||||
done = False
|
||||
while not done:
|
||||
part = getpartslot(img, partno)
|
||||
print(part)
|
||||
|
||||
if part.flags & PartEnabled:
|
||||
print("part", partno, " enabled")
|
||||
print("\tvolume name\t", part.name)
|
||||
print("\tstart block\t", part.startBlock)
|
||||
print("\tblocks\t\t", part.blocks)
|
||||
print("\textentSize\t", part.extentSize)
|
||||
print("\tdirSize\t\t", part.dirSize)
|
||||
if firstvolume is None :
|
||||
firstvolume = part
|
||||
|
||||
partno += 1
|
||||
if (part.flags & PartLast) or partno >= MaxPartitions:
|
||||
done = True
|
||||
|
||||
return firstvolume
|
||||
|
||||
|
||||
def listdir(img, part, verbose=False):
|
||||
print("Directory of {}:".format(part.name))
|
||||
slotno = 0
|
||||
done = False
|
||||
while not done:
|
||||
slot = getdirslot(img, part, slotno)
|
||||
if (slot.flags & SlotFirst):
|
||||
print(slot.name, slot.sizeBytes, slotno)
|
||||
else:
|
||||
if verbose:
|
||||
print(flags2str(slot.flags))
|
||||
slotno += 1
|
||||
#if (slot.flags & SlotEndScan) or (slotno >= part.dirSize):
|
||||
# done = True
|
||||
if (slotno >= part.dirSize):
|
||||
done = True
|
||||
|
||||
|
||||
def findfile(img, part, name):
|
||||
slotno = 0
|
||||
done = False
|
||||
while not done:
|
||||
slot = getdirslot(img, part, slotno)
|
||||
if (slot.flags & SlotFirst) and not (slot.flags & SlotDeleted):
|
||||
if slot.name == name:
|
||||
return slotno
|
||||
slotno += 1
|
||||
if (slot.flags & SlotEndScan) or (slotno >= part.dirSize):
|
||||
done = True
|
||||
|
||||
return None
|
||||
|
||||
|
||||
def readfile(img, part, slotno):
|
||||
pos = part.startBlock * 512 + slotno * part.extentSize
|
||||
dirslot = getdirslot(img, part, slotno)
|
||||
size = dirslot.sizeBytes
|
||||
|
||||
print("readfile", dirslot.name, size,"bytes from",pos)
|
||||
|
||||
img.seek(pos)
|
||||
return img.read(size)
|
||||
|
||||
|
||||
def parsepath(img, pathname):
|
||||
volname = "SYSTEM"
|
||||
if pathname.startswith("#"):
|
||||
volname, filename = pathname.split(':')
|
||||
volname = volname[1:]
|
||||
vol = findvolume(img, volname)
|
||||
if vol is None:
|
||||
print("Volume {} not found".format(volname))
|
||||
return (None, None)
|
||||
else:
|
||||
filename = pathname
|
||||
vol = listvolumes(img)
|
||||
|
||||
return (vol, filename)
|
||||
|
||||
|
||||
def readfromimg(img, pathname,outfilepath):
|
||||
vol, filename = parsepath(img, pathname)
|
||||
if vol is None:
|
||||
return
|
||||
|
||||
listdir(img, vol)
|
||||
|
||||
slotno = findfile(img, vol, filename)
|
||||
if slotno is None:
|
||||
print("File", filename,"not found")
|
||||
return
|
||||
|
||||
data = readfile(img, vol, slotno)
|
||||
|
||||
with open(outfilepath, "wb") as f:
|
||||
f.write(data)
|
||||
|
||||
|
||||
def writetoimg(img, pathname, infilepath):
|
||||
vol, filename = parsepath(img, pathname)
|
||||
if vol is None:
|
||||
return
|
||||
|
||||
existing_slot = findfile(img, vol, filename)
|
||||
if existing_slot is not None:
|
||||
print("Filename", filename, "already exists on", vol.name)
|
||||
return
|
||||
|
||||
filesize = os.path.getsize(infilepath)
|
||||
|
||||
slotno = findslots(img, vol, filesize)
|
||||
if slotno < 1:
|
||||
print("No space on volume", vol.name)
|
||||
return
|
||||
|
||||
putfile(infilepath, filename, img, vol, vol.startBlock, slotno)
|
||||
|
||||
|
||||
def create_image_with_stuff():
|
||||
imgfile = "sdcard.img"
|
||||
bootimage = "../lib/coreloader.prog"
|
||||
dir_slots = 256
|
||||
extent_size = 8192
|
||||
slots_per_extent = extent_size // 64
|
||||
reserved_slots = dir_slots // slots_per_extent
|
||||
|
||||
f = open(imgfile,"w+b")
|
||||
|
||||
b = createpart("PHYS", PartPhysical, 0, 12288, 4096, 0, 0)
|
||||
#print(b)
|
||||
f.write(b)
|
||||
|
||||
with open(bootimage, "rb") as bf:
|
||||
bootdata = bf.read()
|
||||
bootBlocks = len(bootdata) // 512 + 1
|
||||
b = createpart("BOOT", PartBoot, 16, 112, 0, 0, bootBlocks)
|
||||
f.write(b)
|
||||
b = createpart("Testvolume 1", PartEnabled, 128, 3968, 8192, 248)
|
||||
f.write(b)
|
||||
|
||||
b = createpart("SYSTEM", PartEnabled, 4096, 4096, 8192, 256)
|
||||
f.write(b)
|
||||
|
||||
b = createpart("Examples", PartEnabled + PartLast, 8192, 4096, 8192, 256)
|
||||
f.write(b)
|
||||
|
||||
part = getpartslot(f, 2)
|
||||
partstart = part.startBlock
|
||||
dir_slots = part.dirSize
|
||||
|
||||
print("creating",reserved_slots, "reserved directory slots")
|
||||
for a in range(0,reserved_slots):
|
||||
d = createdirslot("DIR", SlotReserved, 0, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, a, d)
|
||||
|
||||
print("creating", dir_slots - reserved_slots, "free slots")
|
||||
|
||||
for a in range(reserved_slots, dir_slots):
|
||||
d = createdirslot("", SlotFree, 0, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, a, d)
|
||||
|
||||
#d = createdirslot("obstacle", SlotFirst , 0, 0, 0, 0, 0)
|
||||
#putdirslot(f, partstart, reserved_slots + 2, d)
|
||||
|
||||
|
||||
slotnr = reserved_slots
|
||||
|
||||
if True:
|
||||
data = bytes("ABCDEFGHIJKLMNOPQRST", "ASCII") * 410 + bytes('1234','ASCII')
|
||||
d = createdirslot("A Testfile.text", SlotFirst, 0, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, slotnr, d)
|
||||
writefile(f, part, slotnr, data)
|
||||
slotnr += len(data) // extent_size + 1
|
||||
|
||||
|
||||
d = createdirslot("", SlotFree, 0, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, slotnr, d)
|
||||
slotnr += 1
|
||||
|
||||
d = createdirslot("Another_file.text", SlotFirst, 20, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, slotnr, d)
|
||||
slotnr += 1
|
||||
|
||||
for a in range(0,20):
|
||||
d = createdirslot("", SlotFree, 0, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, slotnr, d)
|
||||
slotnr += 1
|
||||
|
||||
if True:
|
||||
d = createdirslot("test3.text", SlotFirst, 20, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, slotnr, d)
|
||||
slotnr += 1
|
||||
|
||||
d = createdirslot("test1.text", SlotFirst, 20, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, slotnr, d)
|
||||
slotnr += 1
|
||||
|
||||
d = createdirslot("test2.text", SlotFirst, 20, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, slotnr, d)
|
||||
slotnr += 1
|
||||
|
||||
slotnr = putfile("../examples/test.txt", "sometext.text" , f, part, partstart, slotnr)
|
||||
|
||||
# slotnr = putfile("chase.prog", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../examples/chase.pas", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../examples/sine.pas", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../examples/graph2.pas", None , f, part, partstart, slotnr)
|
||||
|
||||
while slotnr < dir_slots:
|
||||
d = createdirslot("", SlotFree + SlotEndScan , 0, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, slotnr, d)
|
||||
slotnr += 1
|
||||
|
||||
|
||||
# second partition (SYSTEM)
|
||||
part = getpartslot(f, 3)
|
||||
partstart = part.startBlock
|
||||
dir_slots = part.dirSize
|
||||
|
||||
print()
|
||||
print("Partition {} at {}".format(part.name, part.startBlock))
|
||||
print("creating",reserved_slots, "reserved directory slots")
|
||||
for a in range(0,reserved_slots):
|
||||
d = createdirslot("DIR", SlotReserved, 0, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, a, d)
|
||||
|
||||
print("creating", dir_slots - reserved_slots, "free slots")
|
||||
|
||||
for a in range(reserved_slots, dir_slots):
|
||||
d = createdirslot("", SlotFree + SlotEndScan, 0, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, a, d)
|
||||
|
||||
slotnr = reserved_slots
|
||||
|
||||
slotnr = putfile("../progs/shell.prog", "shell.prog", f, part, partstart, slotnr)
|
||||
slotnr = putfile("../lib/coreloader.lsym", "coreloader.lsym", f, part, partstart, slotnr)
|
||||
slotnr = putfile("../lib/coreloader.prog", "coreloader.prog", f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../lib/float32.lib", "float32.lib", f, part, partstart, slotnr)
|
||||
slotnr = putfile("../lib/runtime.lib", "runtime.lib", f, part, partstart, slotnr)
|
||||
slotnr = putfile("../lib/stdlib.lib", None, f, part, partstart, slotnr)
|
||||
slotnr = putfile("../lib/stdlib.inc", None, f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../pcomp/sasm.prog", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../pcomp/pcomp.prog", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../pcomp/lsymgen.prog", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../pcomp/libgen.prog", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../progs/reclaim.prog", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../progs/dumpdir.prog", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../progs/partmgr.prog", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../progs/editor.pas", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../progs/editor.prog", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../progs/xfer.prog", None , f, part, partstart, slotnr)
|
||||
|
||||
listdir(f, part)
|
||||
|
||||
# third partition
|
||||
part = getpartslot(f, 4)
|
||||
partstart = part.startBlock
|
||||
dir_slots = part.dirSize
|
||||
|
||||
print()
|
||||
print("Partition {} at {}".format(part.name, part.startBlock))
|
||||
|
||||
print("creating",reserved_slots, "reserved directory slots")
|
||||
for a in range(0,reserved_slots):
|
||||
d = createdirslot("DIR", SlotReserved, 0, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, a, d)
|
||||
|
||||
slotnr = reserved_slots
|
||||
|
||||
print("creating", dir_slots - reserved_slots, "free slots")
|
||||
|
||||
for a in range(reserved_slots, dir_slots):
|
||||
d = createdirslot("", SlotFree + SlotEndScan, 0, 0, 0, 0, 0)
|
||||
putdirslot(f, partstart, a, d)
|
||||
|
||||
slotnr = putfile("../examples/helloasm.s", None, f, part, partstart, slotnr)
|
||||
# slotnr = putfile("helloasm.prog", "helloasm.prog", f, part, partstart, slotnr)
|
||||
|
||||
# slotnr = putfile("hello.prog", None , f, part, partstart, slotnr)
|
||||
# slotnr = putfile("hellop.s", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../examples/hellop.pas", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../tests/timetest.pas", None , f, part, partstart, slotnr)
|
||||
# slotnr = putfile("../tests/timetest.prog", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../tests/readtest.pas", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../tests/readtest.prog", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../tests/readchartest.pas", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../tests/readchartest.prog", None , f, part, partstart, slotnr)
|
||||
|
||||
# slotnr = putfile("cchangetest.pas", None , f, part, partstart, slotnr)
|
||||
# slotnr = putfile("cchangetest.prog", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../tests/test109.pas", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../tests/test133.pas", None , f, part, partstart, slotnr)
|
||||
# slotnr = putfile("../tests/test133.prog", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../tests/test159.pas", None , f, part, partstart, slotnr)
|
||||
# slotnr = putfile("../tests/test159.prog", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../tests/umlaut.pas", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../examples/rtpair.pas", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../examples/5cubes.pas", None , f, part, partstart, slotnr)
|
||||
# slotnr = putfile("../examples/5cubes.prog", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../examples/3dcube.pas", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../examples/conway.pas", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../examples/mandelbrot.pas", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../examples/lines.pas", None , f, part, partstart, slotnr)
|
||||
|
||||
slotnr = putfile("../examples/viewpict.pas", None , f, part, partstart, slotnr)
|
||||
# slotnr = putfile("viewpict.prog", None , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../examples/ara.pict", "ara.pict" , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../examples/shinkansen.pict", "shinkansen.pict" , f, part, partstart, slotnr)
|
||||
slotnr = putfile("../examples/snow_leopard.pict", "snow_leopard.pict" , f, part, partstart, slotnr)
|
||||
|
||||
listdir(f, part)
|
||||
|
||||
write_bootimage(f, 16, bootdata)
|
||||
|
||||
f.close()
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
if len(sys.argv) > 1:
|
||||
if sys.argv[1] == "get":
|
||||
f = open(sys.argv[2], "rb")
|
||||
readfromimg(f, sys.argv[3], sys.argv[4])
|
||||
elif sys.argv[1] == "put":
|
||||
imgfile = open(sys.argv[2], "r+b")
|
||||
infilepath = sys.argv[3]
|
||||
destfilename = sys.argv[4]
|
||||
writetoimg(imgfile, destfilename, infilepath)
|
||||
elif sys.argv[1] == "createimg":
|
||||
create_image_with_stuff()
|
||||
sys.exit(0)
|
||||
Loading…
Add table
Add a link
Reference in a new issue