PL/Mでコンパイル

2021-11-14 14:26:50 | 日記

もう少しPL/M80で遊んで見る。

オークションで「PL/Mマイクロコンピュータプログラミング」を入手してみたが若干異なる。手続きにREENTRANTをつければ再帰出来るとあるが、うまく動かない。

PLMLANG.DOCを確認すると予約語にないし、また「Procedures may not be recursive. 」とある。8080でスタック上の操作は大変だし、サポートしていないんでしょう。

予約後は以下のとおり。
>The following are all reserved words, and may not be used as
>identifier names:
>
> ADDRESS DATA EOF LABEL PROCEDURE
> AND DECLARE GO LITERALLY RETURN
> BASED DISABLE GOTO MINUS THEN
> BY DO HALT MOD TO
> BYTE ELSE IF NOT WHILE
> CALL ENABLE INITIAL OR XOR
> CASE END INTERRUPT PLUS

本当はCP/MUG030のBASIC.PLMを動かそうと思っていたのだが、BASIC.PLMで使われている$INCLUDEやEXTERNALをサポートしていないようなので諦める。

PL/M80ではどんなコードが出るか興味があったので、簡単なプログラムをコンパイルしてみた。
===ソース======
100H:
DECLARE BDOS LITERALLY '05H';
DECLARE GA8 BYTE;
DECLARE GA16 ADDRESS;

MON1: PROCEDURE(F,A);
DECLARE F BYTE,
A ADDRESS;
GO TO BDOS;
END MON1;

DECLARE
CR LITERALLY '13',
LF LITERALLY '10',
TRUE LITERALLY '1',
FALSE LITERALLY '0';

PRINTCHAR: PROCEDURE(CHAR);
DECLARE CHAR BYTE;
CALL MON1(2,CHAR);
END PRINTCHAR;

CRLF: PROCEDURE;
CALL PRINTCHAR(CR);
CALL PRINTCHAR(LF);
END CRLF;

PRINT: PROCEDURE(A);
DECLARE A ADDRESS;
CALL MON1(9,A);
END PRINT;

RET$CPM: PROCEDURE;
CALL MON1(0,0);
END RESET;

PRINTVALUE: PROCEDURE(V);
DECLARE (D, ZERO) BYTE,
(K, V) ADDRESS;
K = 10000;
ZERO = FALSE;
DO WHILE K <> 0;
D = LOW(V / K); V = V MOD K;
K = K / 10;
IF ZERO OR D <> 0 THEN
DO;
ZERO = TRUE;
CALL PRINTCHAR('0' + D);
END;
ELSE
CALL PRINTCHAR(' ');
END;
END PRINTVALUE;

ARITH:
DECLARE N LITERALLY '4';
DECLARE LA8 BYTE;
DECLARE LA16 ADDRESS;
DO;
GA8 = 100;
GA16 = 200;
LA8 = 3;
LA16 = 4;

/* ADD8 */
CALL PRINT(.'ARITH_ADD8=$');
CALL PRINTVALUE(GA8 + LA8 + 5);
CALL CRLF;
/* ADD16 */
CALL PRINT(.'ARITH_ADD16=$');
CALL PRINTVALUE(GA16 + LA16 + 6);
CALL CRLF;
/* SUB8 */
CALL PRINT(.'ARITH_SUB8=$');
CALL PRINTVALUE(GA8 - LA8 - 7);
CALL CRLF;
/* SUB16 */
CALL PRINT(.'ARITH_SUB16=$');
CALL PRINTVALUE(GA16 - LA16 - 8);
CALL CRLF;
/* MUL8 */
CALL PRINT(.'ARITH_MUL8=$');
CALL PRINTVALUE(GA8 * LA8 * 9);
CALL CRLF;
/* MUL16 */
CALL PRINT(.'ARITH_MUL16=$');
CALL PRINTVALUE(GA16 * LA16 * 10);
CALL CRLF;
/* DIV8 */
CALL PRINT(.'ARITH_DIV8=$');
CALL PRINTVALUE(GA8 / LA8 / 11);
CALL CRLF;
/* MUL16 */
CALL PRINT(.'ARITH_DIV16=$');
CALL PRINTVALUE(GA16 / LA16 / 12);
CALL CRLF;

CALL RET$CPM;
END ARITH;
EOF
=======================

実行結果と逆アセンブル結果(わかりやすくするため対応するソースを記載)
=======================
>DDT ARITH.HEX
DDT VERS 1.4
NEXT PC
03BF 0000
-G100
ARITH ADD8= 108
ARITH ADD16= 210
ARITH SUB8= 90
ARITH SUB16= 188
ARITH MUL8= 2700
ARITH MUL16= 8000
ARITH DIV8= 3
ARITH DIV16= 4

RunCPM Version 5.3 (CP/M 2.2 60K)

>DDT ARITH.HEX
DDT VERS 1.4
NEXT PC
03BF 0000
-L100,3BE
0100 LXI SP,03E6
0103 JMP 01F2
/*
MON1: PROCEDURE(F,A);
DECLARE F BYTE,
A ADDRESS;
GO TO BDOS;
END MON1;
*/
0106 LXI H,03EF
0109 MOV M,C
010A INR L
010B MOV M,E
010C INX H
010D MOV M,D
010E JMP 0005
0111 RET
/*
PRINTCHAR: PROCEDURE(CHAR);
DECLARE CHAR BYTE;
CALL MON1(2,CHAR);
END PRINTCHAR;
*/
0112 LXI H,03F3
0115 MOV M,C
0116 MVI C,02
0118 MOV E,M
0119 MVI D,00
011B CALL 0106
011E RET
/*
CRLF: PROCEDURE;
CALL PRINTCHAR(CR);
CALL PRINTCHAR(LF);
END CRLF;
*/
011F MVI C,0D
0121 CALL 0112
0124 MVI C,0A
0126 CALL 0112
0129 RET
/*
PRINT: PROCEDURE(A);
DECLARE A ADDRESS;
CALL MON1(9,A);
END PRINT;
*/
012A LXI H,03F4
012D MOV M,C
012E INX H
012F MOV M,B
0130 MVI C,09
0132 DCR L
0133 MOV E,M
0134 INR L
0135 MOV D,M
0136 CALL 0106
0139 RET
/*
RET$CPM: PROCEDURE;
CALL MON1(0,0);
END RESET;
*/
013A MVI C,00
013C MVI E,00
013E MVI D,00
0140 CALL 0106
0143 RET
/*
PRINTVALUE: PROCEDURE(V);
DECLARE (D, ZERO) BYTE,
(K, V) ADDRESS;
K = 10000;
ZERO = FALSE;
DO WHILE K <> 0;
D = LOW(V / K); V = V MOD K;
K = K / 10;
IF ZERO OR D <> 0 THEN
DO;
ZERO = TRUE;
CALL PRINTCHAR('0' + D);
END;
ELSE
CALL PRINTCHAR(' ');
END;
END PRINTVALUE;
*/
0144 LXI H,03F6
0147 MOV M,C /* V */
0148 INX H
0149 MOV M,B
014A MVI L,FA /* K = 10000 */
014C MVI M,10
014E INX H
014F MVI M,27
0151 MVI L,F9 /* ZERO = FALSE */
0153 MVI M,00
0155 LXI H,03FA /* K */
0158 MOV A,M
0159 INR L
015A MOV B,M
015B SUI 00
015D MOV C,A
015E MOV A,B
015F SBI 00
0161 ORA C
0162 JZ 01F1 /* K == 0 */
0165 LXI H,03FA /* K */
0168 MOV E,M
0169 INR L
016A MOV D,M
016B MVI L,F6 /* V */
016D MOV C,M
016E INR L
016F MOV B,M
0170 JMP 01A0
/*
DIV BC = BC / DE
*/
0173 MOV A,D
0174 CMA
0175 MOV D,A
0176 MOV A,E
0177 CMA
0178 MOV E,A
0179 INX D
017A LXI H,0000
017D MVI A,11
017F PUSH H
0180 DAD D
0181 JNC 0185
0184 XTHL
0185 POP H
0186 PUSH PSW
0187 MOV A,C
0188 RAL
0189 MOV C,A
018A MOV A,B
018B RAL
018C MOV B,A
018D MOV A,L
018E RAL
018F MOV L,A
0190 MOV A,H
0191 RAL
0192 MOV H,A
0193 POP PSW
0194 DCR A
0195 JNZ 017F
0198 ORA A
0199 MOV A,H
019A RAR
019B MOV D,A
019C MOV A,L
019D RAR
019E MOV E,A
019F RET
/*
*/
01A0 CALL 0173 /* DIV V/K */
01A3 LXI H,03F8 /* D */
01A6 MOV M,C
01A7 LXI H,03FA /* K */
01AA MOV E,M
01AB INR L
01AC MOV D,M
01AD MVI L,F6 /* V */
01AF MOV C,M
01B0 INR L
01B1 MOV B,M
01B2 CALL 0173 /* DIV */
01B5 LXI H,03F6 /* V */
01B8 MOV M,E
01B9 INX H
01BA MOV M,D
01BB MVI E,0A /* 10 */
01BD MVI D,00
01BF LXI H,03FA /* K */
01C2 MOV C,M
01C3 INR L
01C4 MOV B,M
01C5 CALL 0173 /* DIV */
01C8 LXI H,03FA /* K */
01CB MOV M,C
01CC INX H
01CD MOV M,B
01CE MVI L,F8 /* D */
01D0 MOV A,M
01D1 SUI 00
01D3 ADI FF
01D5 SBB A
01D6 INR L
01D7 ORA M
01D8 RRC
01D9 JNC 01E9
01DC MVI M,01
01DE DCR L
01DF MOV A,M
01E0 ADI 30 /* ' ' */
01E2 MOV C,A
01E3 CALL 0112
01E6 JMP 0155
01E9 MVI C,20
01EB CALL 0112
01EE JMP 0155
01F1 RET
/*
GA8 = 100;
GA16 = 200;
LA8 = 3;
LA16 = 4;
*/
01F2 LXI H,03EB /* GA8 = 100(64H) */
01F5 MVI M,64
01F7 INR L
01F8 MVI M,C8 /* GA16 = 200(0C8H) */
01FA INX H
01FB MVI M,00
01FD MVI L,FD /* LA8 = 3 */
01FF MVI M,03
0201 INR L
0202 MVI M,04 /* LA16 = 4 */
0204 INX H
0205 MVI M,00
0207 JMP 0216
/*
CALL PRINT(.'ARITH_ADD8=');
CALL PRINTVALUE(GA8 + LA8 + 5);
CALL CRLF;
*/
020A MOV B,C
020B MOV D,D
020C MOV C,C
020D MOV D,H
020E MOV C,B
020F ??= 20 /* _はスペースになる */
0210 MOV B,C
0211 MOV B,H
0212 MOV B,H
0213 ??= 38
0214 DCR A
0215 INR H
/*
*/
0216 LXI B,020A
0219 CALL 012A
021C LXI H,03FD /* LA8 */
021F MOV A,M
0220 MVI L,EB /* GA8 */
0222 ADD M
0223 ADI 05 /* 5 */
0225 MVI B,00
0227 MOV C,A
0228 CALL 0144
022B CALL 011F
022E JMP 023E
/*
CALL PRINT(.'ARITH_ADD16=');
CALL PRINTVALUE(GA16 + LA16 + 6);
CALL CRLF;
*/
0231 MOV B,C
0232 MOV D,D
0233 MOV C,C
0234 MOV D,H
0235 MOV C,B
0236 ??= 20
0237 MOV B,C
0238 MOV B,H
0239 MOV B,H
023A LXI SP,3D36
023D INR H
/*
*/
023E LXI B,0231
0241 CALL 012A
0244 LXI H,03EC /* GA16 */
0247 MOV C,M
0248 INR L
0249 MOV B,M
024A LHLD 03FE /* LA16 */
024D DAD B
024E XCHG
024F LXI B,0006 /* 6 */
0252 XCHG
0253 DAD B
0254 XCHG
0255 MOV C,E
0256 MOV B,D
0257 CALL 0144
025A CALL 011F
025D JMP 026C
/*
CALL PRINT(.'ARITH_SUB8=');
CALL PRINTVALUE(GA8 - LA8 - 7);
CALL CRLF;
*/
0260 MOV B,C
0261 MOV D,D
0262 MOV C,C
0263 MOV D,H
0264 MOV C,B
0265 ??= 20
0266 MOV D,E
0267 MOV D,L
0268 MOV B,D
0269 ??= 38
026A DCR A
026B INR H
/*
*/
026C LXI B,0260
026F CALL 012A
0272 LXI H,03EB /* GA8 */
0275 MOV A,M
0276 MVI L,FD /* LA8 */
0278 SUB M
0279 SUI 07 /* 7 */
027B MVI B,00
027D MOV C,A
027E CALL 0144
0281 CALL 011F
0284 JMP 0294
/*
CALL PRINT(.'ARITH_SUB16=');
CALL PRINTVALUE(GA16 - LA16 - 8);
CALL CRLF;
*/
0287 MOV B,C
0288 MOV D,D
0289 MOV C,C
028A MOV D,H
028B MOV C,B
028C ??= 20
028D MOV D,E
028E MOV D,L
028F MOV B,D
0290 LXI SP,3D36
0293 INR H
/*
*/
0294 LXI B,0287
0297 CALL 012A
029A LXI H,03EC /* GA16 */
029D MOV A,M
029E INR L
029F MOV B,M
02A0 MVI L,FE /* LA16 */
02A2 SUB M
02A3 INR L
02A4 MOV C,A
02A5 MOV A,B
02A6 SBB M
02A7 MOV B,A
02A8 MOV A,C
02A9 SUI 08 /* 8 */
02AB MOV C,A
02AC MOV A,B
02AD SBI 00
02AF MOV B,A
02B0 CALL 0144
02B3 CALL 011F
02B6 JMP 02C5
/*
CALL PRINT(.'ARITH_MUL8=');
CALL PRINTVALUE(GA8 * LA8 * 9);
CALL CRLF;
*/
02B9 MOV B,C
02BA MOV D,D
02BB MOV C,C
02BC MOV D,H
02BD MOV C,B
02BE ??= 20
02BF MOV C,L
02C0 MOV D,L
02C1 MOV C,H
02C2 ??= 38
02C3 DCR A
02C4 INR H
/*
*/
02C5 LXI B,02B9
02C8 CALL 012A
02CB LXI H,03FD /* GA8 */
02CE MOV E,M
02CF MVI D,00
02D1 MVI L,EB /* LA8 */
02D3 MOV C,M
02D4 MVI B,00
02D6 JMP 02FC
/*
MUL DE = BC * DE
*/
02D9 MOV A,C
02DA SUB E
02DB MOV A,B
02DC SBB D
02DD JP 02E5
02E0 MOV H,B
02E1 MOV L,C
02E2 XCHG
02E3 MOV B,H
02E4 MOV C,L
02E5 LXI H,0000
02E8 XCHG
02E9 MOV A,B
02EA ORA C
02EB RZ
02EC XCHG
02ED MOV A,B
02EE RAR
02EF MOV B,A
02F0 MOV A,C
02F1 RAR
02F2 MOV C,A
02F3 JNC 02F7
02F6 DAD D
02F7 XCHG
02F8 DAD H
02F9 JMP 02E9
/*
*/
02FC CALL 02D9 /* MUL (LA8 * GA8) */
02FF LXI H,03E8 /* WK */
0302 MOV M,E
0303 INR L
0304 MOV M,D
0305 MVI E,09 /* 9 */
0307 MVI D,00
0309 LXI H,03E8 /* WK */
030C MOV C,M
030D INR L
030E MOV B,M
030F CALL 02D9 /* MUL (WK * 9) */
0312 MOV C,E
0313 MOV B,D
0314 CALL 0144
0317 CALL 011F
031A JMP 032A
/*
CALL PRINT(.'ARITH_MUL16=');
CALL PRINTVALUE(GA16 * LA16 * 10);
CALL CRLF;
*/
031D MOV B,C
031E MOV D,D
031F MOV C,C
0320 MOV D,H
0321 MOV C,B
0322 ??= 20
0323 MOV C,L
0324 MOV D,L
0325 MOV C,H
0326 LXI SP,3D36
0329 INR H
/*
*/
032A LXI B,031D
032D CALL 012A
0330 LXI H,03FE /* LA16 */
0333 MOV E,M
0334 INR L
0335 MOV D,M
0336 MVI L,EC /* GA16 */
0338 MOV C,M
0339 INR L
033A MOV B,M
033B CALL 02D9 /* MUL (GA16 * LA16) */
033E LXI H,03E6 /* WK */
0341 MOV M,E
0342 INR L
0343 MOV M,D
0344 MVI E,0A /* 10 */
0346 MVI D,00
0348 LXI H,03E6 /* WK */
034B MOV C,M
034C INR L
034D MOV B,M
034E CALL 02D9 /* MUL (WK * 10) */
0351 MOV C,E
0352 MOV B,D
0353 CALL 0144
0356 CALL 011F
0359 JMP 0368
/*
CALL PRINT(.'ARITH_DIV8=');
CALL PRINTVALUE(GA8 / LA8 / 11);
CALL CRLF;
*/
035C MOV B,C
035D MOV D,D
035E MOV C,C
035F MOV D,H
0360 MOV C,B
0361 ??= 20
0362 MOV B,H
0363 MOV C,C
0364 MOV D,M
0365 ??= 38
0366 DCR A
0367 INR H
/*
*/
0368 LXI B,035C
036B CALL 012A
036E LXI H,03FD /* LA8 */
0371 MOV E,M
0372 MVI D,00
0374 MVI L,EB /* GA8 */
0376 MOV C,M
0377 MVI B,00
0379 CALL 0173 /* DIV (GA8 / LA8) */
037C MVI E,0B /* 11 */
037E MVI D,00
0380 CALL 0173 /* DIV (WK / 11) */
0383 CALL 0144
0386 CALL 011F
0389 JMP 0399
/*
CALL PRINT(.'ARITH_DIV16=');
CALL PRINTVALUE(GA16 / LA16 / 12);
CALL CRLF;
*/
038C MOV B,C
038D MOV D,D
038E MOV C,C
038F MOV D,H
0390 MOV C,B
0391 ??= 20
0392 MOV B,H
0393 MOV C,C
0394 MOV D,M
0395 LXI SP,3D36
0398 INR H
/*
*/
0399 LXI B,038C
039C CALL 012A
039F LXI H,03FE /* LA16 */
03A2 MOV E,M
03A3 INR L
03A4 MOV D,M
03A5 MVI L,EC /* GA16 */
03A7 MOV C,M
03A8 INR L
03A9 MOV B,M
03AA CALL 0173 /* DIV (GA16 / LA16) */
03AD MVI E,0C /* 12 */
03AF MVI D,00
03B1 CALL 0173 /* DIV (WK / 12) */
03B4 CALL 0144
03B7 CALL 011F
03BA CALL 013A
03BD EI
03BE HLT
03BF
-

特徴的なのは、掛け算・割り算のコードがランタイムではなく、コンパイル時に埋め込まれる点。掛け算や割り算が使われた時点でルーチンが埋め込まれ、他の場所からも使用されている点である。
ローカルの変数も静的に領域を確保しており再帰は無理。最適化なのか普通なら INX H となるところに INR L を使っているのではあるが、CALLのあとのRETとかJMPのあとのRETとか、人だったら書かないだろうなあというコードではある。

	ブログを読むだけ。毎月の訪問日数に応じてポイント進呈
	【集まれ！野鳥ブロガー】あなたのブログを紹介しませんか？
	訪問者数に応じてdポイント最大1,000pt当たる！
	dポイントが当たる！無料『毎日くじ』

石原博の覚書

電子工作に関する日々の覚書を記載します