|
DataMuseum.dkPresents historical artifacts from the history of: RegneCentralen RC700 "Piccolo" |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RegneCentralen RC700 "Piccolo" Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 5504 (0x1580)
Types: TextFile
Names: »BSORT2.MAC«
└─⟦2a24d2e1b⟧ Bits:30003042 Programmer fra Aarhus kursus
└─ ⟦this⟧ »BSORT2.MAC«
TITLE BUBBLE
.Z80 ; Brug Z80-ordrekoder
; *******************************************
; * Erik Jacobsen, DAIMI, 11. november 1984 *
; *******************************************
; ***********************************************************************
; * Standard procedurer til læsning og skrivning af tegn og tekster *
; * findes i Pascal: READ, READLN, WRITE, WRITELN. *
; * CP/M har læsning og skrivning af tegn (RDCH og WRCH). *
; * Vi skal selv lave læsning og skrivning af tekster. *
; ***********************************************************************
WRCH EQU X'DA0C' ; BIOS-rutine WRITE CONSOLE CHARACTER OUT
RDCH EQU X'DA09' ; BIOS-rutine READ CONSOLE CHARACTER IN
CR EQU 0DH ; CR = carriage return (^M, dvs. = 13 dec.)
LF EQU 0AH ; LF = line feed (^J, dvs. = 10 dec.)
CRLF: LD C,CR
CALL WRCH ; skriv "carriage return"
LD C,LF
CALL WRCH ; skriv "line feed"
RET
FALSE EQU 0H
TRUE EQU 1H
READLN: CALL RDCH ; læs et tegn ind i reg. A
CP CR ; var det en <cr> ?
JP Z,STOPR ; ja, så er vi færdige med indlæsning
LD C,A ; reg. C husker indlæst tegn
LD HL,LEN ; hvor mange tegn har vi allerede læst?
INC (HL) ; vi har læst eet mere
LD IX,STR-1 ; hvor starter strengen (minus 1) ?
LD E,(HL) ; HL peger stadig paa LEN
LD D,0 ; reg. DE (16 bit) := reg. A (8 bit)
ADD IX,DE ; reg. IX er nu positionen i strengen
LD (IX),C ; gem tegnet i strengen
CALL WRCH ; skriv tegnet i reg. C på CONSOLE
JP READLN ; læs næste tegn
STOPR: CALL CRLF ; skift linie
RET
WRITELN: LD A,(LEN) ; længden af strengen
LD IX,STR ; starten af strengen
WRNEXT: CP 0 ; er alle tegn læst ud ?
JP Z,STOPW ; jo, vi standser
LD C,(IX) ; næste tegn hentes ned i reg. C
CALL WRCH ; skriv tegnet
INC IX ; gør klar til næste tegn
DEC A ; der er et tegn mindre nu
JP WRNEXT ; skriv næste tegn
STOPW: CALL CRLF ; skift linie
RET
; ***********************************************************************
; * BUBBLESORT *
; * Programmet svarer til BUBBLESORT i COMPAS-Pascal, men med følgende *
; * ændringer: *
; * 1) Variabel I er erstattet af register B, der altså løber fra *
; * 1 til J. Samtidig indeholder register IX adressen på *
; * STR(.i.). *
; * 2) Vores konstruktion af FOR-løkke virker ikke hvis *
; * "til-værdi" bliver negativ. Dette checkes direkte. *
; * 3) Parametrene til BYT gives indirekte, idet IX og IX+1 peger *
; * på de tegn der skal ombyttes. *
; ***********************************************************************
LEN: DB 0 ; længde (startværdi = 0)
STR: DS 100H ; afsæt plads til 100H (=256 dec.) bytes
CHANGE: DB 0 ; change: boolean
J: DB 0 ; j: integer
BYT: LD A,(IX) ; A:=str(.i.)
LD D,(IX+1)
LD (IX),D ; str(.i.):=str(.i+1.)
LD (IX+1),A ; str(.i+1.):=A
LD A,TRUE
LD (CHANGE),A ; change := true
PUSH IX
CALL WRITELN
POP IX
RET
BUBBLE: CALL READLN ; læs linien der skal sorteres
LD A,(LEN)
LD (J),A ; j := len(str)
CP 0 ; hvis længden var 0 ...
JP Z,Skip ; ... så skip FOR-løkke (se note 2)
REPEAT: LD A,FALSE
LD (CHANGE),A ; change := false
LD HL,J
DEC (HL) ; j := j - 1
LD B,1 ; i := 1 (se note 1)
LD IX,STR ; IX := adresse( str(.1.) ) (se note 1)
FOR: LD A,(J) ; sammenlign j ...
CP B ; ... med i ...
JP C,UNTIL ; ... og hvis "til-grænse" nået, så hop
LD A,(IX) ; sammenlign str(.i.) ...
CP (IX+1) ; ... med str(.i+1.)
CALL C,BYT ; byt tegn hvis nødvendigt (se note 3)
INC B ; i := i + 1
INC IX ; IX := adresse( str(.i.) )
JP FOR
UNTIL: LD A,(CHANGE)
CP FALSE ; hvis change<>false ...
JP NZ,REPEAT ; ... saa udføres repeatløkken igen
SKIP: CALL WRITELN
RET ; retur til CP/M
END BUBBLE
«eof»