diff options
Diffstat (limited to 'devel/misc/unknown/src/DS4.ELA')
| -rw-r--r-- | devel/misc/unknown/src/DS4.ELA | 268 |
1 files changed, 268 insertions, 0 deletions
diff --git a/devel/misc/unknown/src/DS4.ELA b/devel/misc/unknown/src/DS4.ELA new file mode 100644 index 0000000..6ebcf2d --- /dev/null +++ b/devel/misc/unknown/src/DS4.ELA @@ -0,0 +1,268 @@ +PACKET ds 4 access DEFINES ds 4 :
+
+PROC ds 4 :
+ INT VAR segment, block nr , i , adr , byte ;
+ TEXT VAR key , eingabe ;
+ BOOL VAR new headline ;
+ page ;
+ put ("Segment:") ;
+ get (segment) ;
+ ROW 256 INT VAR space ;
+ block nr := 0 ;
+ new headline := FALSE ;
+ REP
+ IF new headline THEN out (""1""5"")
+ ELSE page
+ FI ;
+ put (" Segment:") ; put (text(segment,5)) ; (* Cursor 1-16 *)
+ put (", Block:") ; put (text(block nr,5)) ; (* Cursor 17-31 *)
+ put (", Wortaddr:") ; out (hex8 (segment)) ;
+ put (text(hex16((""0""+code(blocknr))ISUB1),5)) ;
+ put ("Wahl : + - e s b w a h d o") ; (* ^ Cursor 32 - 51 *)
+ IF NOT new headline THEN
+ line ; (* ^ 52 - 77 *)
+ adr := (""0"" + code (block nr)) ISUB 1 ;
+ FOR i FROM 0 UPTO 255 REP
+ space (i+1) := get word (segment, i + adr)
+ PER ;
+ dump (space)
+ FI ;
+ out (""1"") ;
+ new headline := FALSE ;
+ inchar (key) ;
+ out (key) ;
+ IF key = "+" THEN IF block nr = 255
+ THEN block nr := 0 ;
+ segment INCR 1
+ ELSE block nr INCR 1
+ FI
+ ELIF key = "-" THEN IF block nr = 0 AND segment > 0
+ THEN block nr := 255 ;
+ segment DECR 1
+ ELIF block nr > 0 THEN block nr DECR 1
+ FI
+ ELIF key = "s" THEN cursor (11,1) ;
+ eingabe := text (segment) ;
+ editget (eingabe, 1000, 5) ;
+ segment := int (eingabe)
+ ELIF key = "b" THEN cursor (26,1) ;
+ eingabe := hex8 (block nr) ;
+ editget (eingabe, 1000, 5) ;
+ block nr := integer (eingabe)
+ ELIF key = "w" THEN cursor (44,1) ;
+ eingabe := hex16 (adr) ;
+ edit get (eingabe, 1000, 5) ;
+ adr := integer (eingabe) ;
+ eingabe := hex16 (get word (segment, adr)) ;
+ cursor (32,1) ;
+ put (",NeuesWort:") ;
+ editget (eingabe, 1000,5) ;
+ put word (segment, adr, integer (eingabe)) ;
+ ELIF key = "d" THEN cursor (32,1) ;
+ new headline := TRUE ;
+ put (", Dez->Hex:") ;
+ REAL VAR r ;
+ get (r) ;
+ cursor (32,1) ;
+ put (", - Taste - Hex:") ;
+ IF r < 256.0 AND r >= 0.0 THEN put (hex8 (int(r)))
+ ELIF r < 0.0 THEN put (hex16 (int (r)))
+ ELIF r < 32768.0 THEN put (hex16 (int(r)))
+ ELSE put (hex16 (int (r - 65536.0)))
+ FI ; pause
+ ELIF key = "h" THEN cursor (32,1) ;
+ new headline := TRUE ;
+ put (", Hex->Dez:") ;
+ getline (eingabe) ;
+ cursor (32,1) ;
+ put (", - Taste - Dez:") ;
+ put (integer (eingabe)) ;
+ IF integer (eingabe) < 0 THEN put (", Positiv:") ;
+ put (positiv (eingabe))
+ FI ; pause
+ ELIF key = "a" THEN cursor (32,1) ;
+ new headline := TRUE ;
+ put (", ASCII->Hex (Taste)"5"") ;
+ inchar (eingabe) ;
+ put (" = ") ; put (hex8 (code (eingabe))) ;
+ put ("- Taste -") ;
+ pause
+ ELIF key = "o" THEN cursor (32,1) ;
+ new headline := TRUE ;
+ put (", Hex->0Opcde:") ;
+ getline (eingabe) ;
+ cursor (32,1) ;
+ put (", - Taste - :") ;
+ put (eumel0 opcode (integer (eingabe))) ;
+ pause
+ FI ;
+ UNTIL key = "e" PER ;
+
+ENDPROC ds 4 ;
+
+PROC dump (ROW 256 INT CONST page) :
+ INT VAR i,j ,k ;
+ TEXT VAR t := " " ;
+ k := 1 ; j := 1 ;
+ put ("00:") ;
+ FOR i FROM 1 UPTO 256 WHILE incharety <> ""27""REP
+ put hex16 (page (i)) ;
+ replace (t, j, ascii (page (i))) ;
+ j := j + 2 ;
+ IF ((j-1) MOD 8) = 0 THEN out (" ") FI ;
+ IF k = 22 AND j = 9 THEN j := 25 ; 34 TIMESOUT " " FI ;
+ IF j = 25 THEN
+ out (" ") ; out (t) ;
+ replace (t, 1, " ") ;
+ IF k < 22 THEN
+ line ;
+ out(hex8 (i)); put (":")
+ FI ;
+ k := k + 1 ;
+ j := 1
+ FI ;
+PER ;
+ENDPROC dump ;
+
+
+TEXT PROC ascii (INT CONST wert) :
+ TEXT VAR t := " " ;
+ replace (t, 1, wert) ;
+ IF (t SUB 1) < " " OR (t SUB 1) > ""126"" THEN replace (t, 1, ".") FI ;
+ IF (t SUB 2) < " " OR (t SUB 2) > ""126"" THEN replace (t, 2, ".") FI ;
+ t
+ENDPROC ascii ;
+
+PROC put hex16 (INT CONST wert) :
+ TEXT VAR t := " " ;
+ replace (t, 1, wert) ;
+ out hex digit (code (t SUB 1) DIV 16) ;
+ out hex digit (code (t SUB 1) AND 15) ;
+ out hex digit (code (t SUB 2) DIV 16) ;
+ out hex digit (code (t SUB 2) AND 15) ;
+ENDPROC put hex16 ;
+
+PROC out hex9 (INT CONST wert) :
+ out hex digit (wert DIV 256) ;
+ out hex digit (wert DIV 16 AND 15) ;
+ out hex digit (wert AND 15)
+ENDPROC out hex9 ;
+
+TEXT PROC hex8 (INT CONST wert) :
+ hex digit (wert DIV 16) +
+ hex digit (wert AND 15)
+ENDPROC hex8 ;
+
+TEXT PROC hex16 (INT CONST wert) :
+ TEXT VAR t := " " ;
+ replace (t, 1, wert) ;
+ hex digit (code (t SUB 2) DIV 16) +
+ hex digit (code (t SUB 2) AND 15) +
+ hex digit (code (t SUB 1) DIV 16) +
+ hex digit (code (t SUB 1) AND 15)
+ENDPROC hex16 ;
+
+TEXT PROC hex digit (INT CONST wert) :
+ IF wert < 10 THEN code (wert + 48)
+ ELSE code (wert + 55)
+ FI
+ENDPROC hex digit ;
+
+PROC out hex digit (INT CONST wert) :
+ IF wert < 10 THEN out (code (wert + 48))
+ ELSE out (code (wert + 55))
+ FI
+ENDPROC out hex digit ;
+
+INT PROC integer (TEXT CONST hex addr) :
+ INT VAR i ;
+ REAL VAR summe := 0.0 ;
+ FOR i FROM 1 UPTO length (hex addr) REP
+ summe := summe * 16.0 ;
+ summe INCR real (digit)
+ PER ;
+ IF summe > 32767.0 THEN int (summe - 65536.0)
+ ELSE int (summe)
+ FI.
+
+digit :
+ TEXT CONST char := hex addr SUB i ;
+ IF char >= "a" THEN code (char) - 87
+ ELIF char >= "A" THEN code (char) - 55
+ ELSE code (char) - 48
+ FI
+ENDPROC integer ;
+
+REAL PROC positiv (TEXT CONST wert) :
+ INT VAR i ;
+ REAL VAR summe := 0.0 ;
+ FOR i FROM 1 UPTO length (wert) REP
+ summe := summe * 16.0 ;
+ summe INCR real (digit)
+ PER ;
+ summe .
+
+digit :
+ TEXT CONST char := wert SUB i ;
+ IF char >= "a" THEN code (char) - 87
+ ELIF char >= "A" THEN code (char) - 55
+ ELSE code (char) - 48
+ FI
+ENDPROC positiv ;
+
+TEXT PROC eumel0 opcode (INT CONST word) :
+ INT VAR op1 := (word AND 31744) DIV 1024 ,
+ op2 := (word AND 768) DIV 128 ,
+ low := word AND 255 ,
+ long data := (word AND 768) * 2 + (word AND 255) ;
+ IF word < 0 THEN op2 INCR 1 ; long data INCR 256 FI ;
+ SELECT op1 OF
+ CASE 0 : "LN " + text (low)
+ CASE 1 : "LN " + text (long data)
+ CASE 2 : "MOV "
+ CASE 3 : "INC1 "
+ CASE 4 : "DEC1 "
+ CASE 5 : "INC "
+ CASE 6 : "DEC "
+ CASE 7 : "ADD "
+ CASE 8 : "SUB "
+ CASE 9 : "CLEAR "
+ CASE 10 : "TEST "
+ CASE 11 : "EQU "
+ CASE 12 : "LSEQ "
+ CASE 13 : "FMOV "
+ CASE 14 : "FADD "
+ CASE 15 : "FSUB "
+ CASE 16 : "FMULT "
+ CASE 17 : "FDIV "
+ CASE 18 : "FLSEQ "
+ CASE 19 : "TMOV "
+ CASE 20 : "TEQU "
+ CASE 21 : "LSEQU "
+ CASE 22 : "ACCDS "
+ CASE 23 : "REF "
+ CASE 24 : "SUBS "
+ CASE 25 : "SEL "
+ CASE 26 : "PPV "
+ CASE 27 : "PP "
+ CASE 28 : "BR " + hex8 (low)
+ CASE 29 : "BR " + hex16 (long data)
+ CASE 30 : "CALL "
+ OTHERWISE op 31
+ ENDSELECT.
+
+op31 :
+SELECT op 2 OF
+ CASE 0 : "IS """ + code (low) + """"
+ CASE 1 : "STIM " + hex8 (low)
+ CASE 2 : "MOVX "
+ CASE 3 : "PW "
+ CASE 4 : "GW "
+ CASE 5 : "PENTER " + hex8 (low)
+ CASE 6 : "ESC " + text (low)
+ CASE 7 : "LONGA " + eumel 0 opcode ((low AND 124) * 256)
+ OTHERWISE "?????"
+ENDSELECT
+ENDPROC eumel 0 opcode
+
+ENDPACKET ds 4 access
|