forked from amberisvibin/chibi-pc09
9944 lines
250 KiB
Plaintext
9944 lines
250 KiB
Plaintext
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 ED PLM
|
||
|
||
ED PLM ! ED PLM "#$%&'()*+,-./01 ED PLM 2 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹TERNAL;
|
||
/* SYSTEM REBOOT */
|
||
END BOOT;
|
||
|
||
/* E D : T H E C P / M C O N T E X T E D I T O R */
|
||
|
||
/* DDT2MON ASM ｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇﾈﾉﾊ DDT2MON ASM ﾋﾌﾍﾎﾏﾐﾑﾒﾓﾔﾕﾖﾗﾘﾙﾚ DDT2MON ASM
|
||
ﾛﾜ ED20PAT ASM
|
||
ﾝﾞ BDISK BYTE EXTERNAL, /* BOOT DISK 0004H */
|
||
MAXB ADDRESS EXTERNAL, /* MAX BASE 0006H */
|
||
FCB (33) BYTE ED LIN O3456789:;< LOAD PLM K=>?@ABCDEF LOAD LIN GH CPMOVE ASM EIJKLMNOPQ 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 COPYRIGHT (C) 1976, 1977, 1978, 1979
|
||
DIGITAL RESEARCH
|
||
BOX 579 PACIFIC GROVE
|
||
CALIFORN DEBLOCK ASM Pﾟ珮粤蒟跚<E8929F> 蘂S2SCAN $$$ 薀EBLOCK ASM O矮聿褂鉅鳰 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 EXTERNAL, /* FCB 005CH */
|
||
BUFF (128)BYTE EXTERNAL, /* BUFFER 0080H */
|
||
SECTSHF LITERALLY '7', /* SHL(1,SECTSH SYSGEN ASM JRSTUVWXYZ[ AS0COM ASM
|
||
\] AS1IO ASM k^_`abcdefghijk AS2SCAN ASM =lmnopqrs 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹IA 93950
|
||
*/
|
||
DECLARE COPYRIGHT(*) BYTE DATA
|
||
(' COPYRIGHT (C) 1979, DIGITAL RESEARCH ');
|
||
|
||
/* COMMAND FUNCT裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹F) = SECTSIZE */
|
||
SECTSIZE LITERALLY '80H'; /* SECTOR SIZE */
|
||
|
||
MON1: PROCEDURE(F,A) EXTERNAL;
|
||
DECLARE F BYTE, A ADD AS3SYM ASM Etuvwxyz{| AS4SEAR ASM M}~≠ヤ<E289A0> AS5OPER ASM X㊧炎旧克署<E5858B> AS6MAIN ASM 駐舶沫<E888B6>圀悃棔<E68283>｡ED:
|
||
DO;
|
||
/* MODIFIED FOR .PRL OPERATION MAY, 1979 */
|
||
/* MODIFIED FOR OPERATION WITH CP/M 2.0 AUGUST 1979 */
|
||
DECLARE
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹ION
|
||
------- --------
|
||
A APPEND LINES OF TEXT TO BUFFER
|
||
B MOVE TO BEGINNING OR EN裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹RESS;
|
||
END MON1;
|
||
|
||
MON2: PROCEDURE(F,A) BYTE EXTERNAL;
|
||
DECLARE F BYTE, A ADDRESS;
|
||
END MON2;
|
||
|
||
BOOT: PROCEDURE EX AS6MAIN ASM ｢｣ DDT0MOV ASM ､･ｦ DDT1ASM ASM ｧｨｩｪｫｬｭｮｯｰｱｲｳｴｵｶ DDT1ASM ASM ｷｸｹｺ /* JMP EDCOMMAND - 3 (TO ADDRESS LXI SP) */
|
||
EDJMP BYTE DATA(0C3H),
|
||
EDADR ADDRESS DATA(.EDCOMMAND-3);
|
||
|
||
DECLARE
|
||
D OF TEXT
|
||
C SKIP CHARACTERS
|
||
D DELETE CHARACTERS
|
||
E END OF EDIT
|
||
F A WHICH
|
||
FOLLOWS IS TRANSLATED TO UPPER CASE. THUS, IF THE "I" COMMAND IS TYPED IN
|
||
UPPER CASE, THEN ALL INPUT IS AUTOMATICALLYNES OF TEXT TO FILE
|
||
X TRANSFER (XFER) LINES TO TEMP FILE
|
||
Z SLEEP FOR 1/2 SECOND (USED IN MACRO E H O Q
|
||
CANNOT BE PRECEDED BY A NUMBER. THE COMMANDS
|
||
F I J M R S
|
||
ARE ALLTHROUGH FILE
|
||
O RE-EDIT OLD FILE
|
||
P PAGE AND DISPLAY (MOVES UP OR DOWN 24 LINES AND
|
||
OMMANDS CAN BE PRECEDED BY A POSITIVE OR
|
||
NEGATIVE INTEGER BETWEEN 0 AND 65535 (1 IS DEFAULT IF NO VALUE
|
||
IS SPECIFIED FIND STRING IN CURRENT BUFFER
|
||
H MOVE TO TOP OF FILE (HEAD)
|
||
I INSERT CHARACTERS FROM KEYB TRANSLATED (ALTHOUGH ECHOED IN
|
||
LOWER CASE, AS TYPED). IF THE "A" COMMAND IS TYPED IN UPPER CASE, THEN ALL
|
||
INPUT IS TRANSLATES TO STOP DISPLAY)
|
||
<CR> MOVE UP OR DOWN AND PRINT ONE LINE
|
||
|
||
|
||
IN GENERAL, THE EDITOR ACCEPTS SINGLE LETTER FOLLOWED BY ONE OR MORE STRINGS OF CHARACTERS WHICH CAN
|
||
BE OPTIONALLY SEPARATED OR TERMINATED BY EITHER <ENDFILE> OR <CR> DISPLAYS 24 LINES)
|
||
Q QUIT EDIT WITHOUT UPDATING THE FILE
|
||
R<FILENAME> READ FROM FILE <FILENAME>.LI). THIS VALUE DETERMINES THE NUMBER OF TIMES THE
|
||
COMMAND IS APPLIED BEFORE RETURNING FOR ANOTHER COMMAND.
|
||
THE COARD
|
||
UP TO NEXT <ENDFILE>
|
||
J JUXTAPOSITION OPERATION - SEARCH FOR FIRST STRING,
|
||
D AS READ FROM THE DISK. GLOBAL TRANSLATION TO UPPER CASE
|
||
CAN BE CONTROLLED BY THE "U" COMMAND (-U TO NEGATE ITS EFFECT). IF COMMANDS WITH OPTIONAL
|
||
INTEGER VALUES PRECEDING THE COMMAND. THE EDITOR ACCEPTS BOTH UPPER AND LOWER
|
||
CASE COMMANDS AND VALUES.
|
||
THE <ENDFILE> IS GENERALLY USED TO SEPARATE THE SEARCH STRINGS
|
||
IN THE S AND J COMMANDS, AND IS USED AT THE END OF B UNTIL <ENDFILE> AND
|
||
INSERT INTO TEXT
|
||
S SEARCH FOR FIRST STRING, REPLACE BY SECOND STRING
|
||
OMMANDS
|
||
C D K L T P U <CR>
|
||
CAN BE PRECEDED BY AN UNSIGNED, POSITIVE, OR NEGATIVE NUMBER,
|
||
TH INSERT SECOND STRING, DELETE UNTIL THIRD STRING
|
||
K DELETE LINES
|
||
L SKIP LINES
|
||
M YOU ARE
|
||
OPERATING WITH AN UPPER CASE ONLY TERMINAL, THEN OPERATION IS AUTOMATIC.
|
||
SIMILARLY, IF YOU ARE OPERATING WITH A LOWER , AND PERFORMS TRANSLATION TO UPPER CASE UNDER THE FOL-
|
||
LOWING CONDITIONS. IF THE COMMAND IS TYPED IN UPPER CASE, THEN THE DATTHE COMMANDS IF
|
||
ADDITIONAL COMMANDS FOLLOW. FOR EXAMPLE, THE FOLLOWING COMMAND
|
||
SEQUENCE SEARCHES FOR THE STRING 'G T TYPE LINES
|
||
U TRANSLATE TO UPPER CASE (-U CHANGES TO NO TRANSLATE)
|
||
W WRITE LIE COMMANDS
|
||
A F J N W Z
|
||
CAN BE PRECEDED BY AN UNSIGNED OR POSITIVE NUMBER,
|
||
THE COMMANDS
|
||
MACRO DEFINITION (SEE COMMENT BELOW)
|
||
N FIND NEXT OCCURRENCE OF STRING
|
||
WITH AUTO SCAN CASE TERMINAL, AND TRANSLATION
|
||
TO UPPER CASE IS NOT SPECIFIED, THEN LOWER CASE CHARACTERS CAN BE ENTERED.
|
||
|
||
A NUMBER OF CAMMA', SUBSTITUTES THE STRING
|
||
'DELTA', AND THEN TYPES THE FIRST PART OF THE LINE WHERE THE
|
||
CHANGE OCCURRED, FOLLOWEDVE INTEGER N, AND <DELIMITER> IS
|
||
<ENDFILE> OR <CR>. THE COMMANDS C1 ... CN FOLLOWING THE M ARE
|
||
EXECUTED N TIMES, SSPLAY - THE MACRO EXPANSION
|
||
STOPS UNTIL A CHARACTER IS READ. IF THE CHARACTER IS NOT A BREAK
|
||
THEN THE MACRO EXPANSIMAND THE NUMBER OF TIMES SPECFIED
|
||
(OCCURS IF SEARCH STRING CANNOT BE FOUND)
|
||
LETTER O CANNOT OPEN <FILENDFILE>. IF SEVERAL LINES OF TEXT ARE TO BE INSERTED,
|
||
THE I CAN BE DIRECTLY FOLLOWED BY AN <ENDFILE> OR <CR> IN WHICH
|
||
FUNCTION IS CONSIDERED TERMINATED, AND CONTROL RETURNS TO THE
|
||
OPERATOR.
|
||
|
||
ERROR CONDITIONS ARE INDICATED BY PRINTI BY THE REMAINDER OF THE LINE WHICH WAS
|
||
CHANGED:
|
||
SGAMMA<ENDFILE>DELTA<ENDFILE>0TT<CR>
|
||
|
||
THE CONTRTARTING AT THE CURRENT POSITION IN THE BUFFER.
|
||
IF N IS 0, 1, OR OMITTED, THE COMMANDS ARE EXECUTED UNTIL THE END
|
||
IF ON CONTINUES NORMALLY).
|
||
|
||
NOTE THAT A POUND SIGN IS TAKEN AS THE NUMBER 65535, ALL
|
||
UNSIGNED NUMBERS ARE ASSUMED ENAME>.LIB IN R COMMAND
|
||
|
||
THE ERROR CHARACTER IS ALSO ACCOMPANIED BY THE LAST CHARACTER
|
||
SCANNED WHEN THE ERROR OCCU CASE THE EDITOR ACCEPTS LINES OF INPUT TO THE NEXT <ENDFILE>.
|
||
THE COMMAND 0T PRINTS THE FIRST PART OF THE CURRENT LINENG ONE OF THE CHARACTERS:
|
||
|
||
SYMBOL ERROR CONDITION
|
||
------ ---------------------------------OL-L CHARACTER IN SEARCH AND SUBSTITUTE STRINGS IS
|
||
REPLACED ON INPUT BY <CR><LF> CHARACTERS. THE CONTROL-I KEY
|
||
IS TTHE BUFFER IS ENCOUNTERED.
|
||
|
||
THE FOLLOWING MACRO, FOR EXAMPLE, CHANGES ALL OCCURRENCES OF
|
||
THE NAME 'GAMMA' TO 'DELTPOSITIVE, AND A SINGLE - IS ASSUMED -1
|
||
|
||
A NUMBER OF COMMANDS CAN BE GROUPED TOGETHER AND EXECUTED
|
||
REPETITIVELY USIRRED. */
|
||
|
||
DECLARE LIT LITERALLY 'LITERALLY',
|
||
DCL LIT 'DECLARE',
|
||
PROC LIT 'PROCEDURE',
|
||
ADD,
|
||
AND THE COMMAND 0L MOVES THE REFERENCE TO THE BEGINNING OF THE
|
||
CURRENT LINE. THE COMMAND 0P PRINTS THE CURRENT PA-------------------
|
||
GREATER FREE MEMORY IS EXHAUSTED - ANY COMMAND CAN BE ISSUED
|
||
WHICH DOES NOT INCRAKEN AS A TAB CHARACTER.
|
||
|
||
THE COMMAND R MUST BE FOLLOWED BY A FILE NAME (WITH ASSUMED FILE
|
||
TYPE OF 'LIB') WITH A', AND PRINTS THE LINES WHICH
|
||
WERE CHANGED:
|
||
|
||
MFGAMMA<ENDFILE>-5DIDELTA<ENDFILE>0LT<CR>
|
||
|
||
(NOTE:NG THE MACRO COMMAND WHICH TAKES THE FORM
|
||
|
||
<NUMBER>MC1C2...CN<DELIMITER>
|
||
|
||
WHERE <NUMBER> IS A NON-NEGATIR LIT 'ADDRESS',
|
||
CTLL LIT '0CH',
|
||
CTLR LIT '12H', /* REPEAT LINE IN INSERT MODE */
|
||
CTLU LIT '15H', /* LINE DELETGE ONLY, WHILE
|
||
THE COMMAND 0Z READS THE CONSOLE RATHER THAN WAITING (THIS IS USED
|
||
AGAIN WITHIN MACROS TO STOP THE DIEASE MEMORY REQUIREMENTS.
|
||
QUESTION UNRECOGNIZED COMMAND OR ILLEGAL NUMERIC FIELD
|
||
POUND CANNOT APPLY THE COMA TRAILING <CR> OR <ENDFILE>. THE COMMAND
|
||
I IS FOLLOWED BY A STRING OF SYMBOLS TO INSERT, TERMINATED BY
|
||
A <CR> OR < AN <ENDFILE> IS THE CP/M END OF FILE MARK - CONTROL-Z)
|
||
|
||
IF ANY KEY IS DEPRESSED DURING TYPING OR MACRO EXPANSION, THE
|
||
E IN INSERT MODE */
|
||
CTLX LIT '18H', /* EQUIVALENT TO CTLU */
|
||
CTLH LIT '08H', /* BACKSPACE */
|
||
TAB LIT '09H', ED SBUFFADR (128) BYTE, /* SOURCE BUFFER */
|
||
|
||
DFCB (FS) BYTE, /* DEST FILE CONTROL BLOCK */
|
||
DFUB BYTE AT(.DFCB EXTENT */
|
||
XFCBM BYTE AT(.XFCB(MD)), /* MODULE NUMBER */
|
||
XFCBR BYTE AT(.XFCB(NR)), /* XFCB RECORD # */
|
||
XBUFF ( DURING BACKSPACE */
|
||
|
||
TTYCHAR: PROCEDURE(CHAR);
|
||
DECLARE CHAR BYTE;
|
||
IF CHAR >= ' ' THEN COLUMN = COLUMN + 1;
|
||
IF UB LITERALLY '13', /* UNFILLED BYTES */
|
||
MD LITERALLY '14', /* MODULE NUMBER POSITION */
|
||
NR LITERALLY '32', /* NEXT TERALLY '0',
|
||
FOREVER LITERALLY 'WHILE TRUE',
|
||
CR LITERALLY '13',
|
||
LF LITERALLY '10',
|
||
WHAT LITERALLY '63';
|
||
|
||
/* TAB CHARACTER */
|
||
LCA LIT '110$0001B', /* LOWER CASE A */
|
||
LCZ LIT '111$1010B', /* LOWER CASE Z */
|
||
ENDFB(UB)), /* UNFILLED BYTES IN LAST RECORD */
|
||
DBUFFADR ADDRESS, /* DESTINATION BUFFER ADDRESS */
|
||
DBUFF BASED DBUSECTSIZE) BYTE, /* XFER BUFFER */
|
||
XBP BYTE, /* XFER POINTER */
|
||
XFERON BYTE, /* TRUE IF XFER ACTCHAR = LF THEN COLUMN = 0;
|
||
CALL PRINTCHAR(CHAR);
|
||
END TTYCHAR;
|
||
|
||
BACKSPACE: PROCEDURE;
|
||
/* MOVE BACK ONE POSITIONRECORD FIELD */
|
||
FS LITERALLY '33', /* FCB SIZE */
|
||
RFCB (FS) BYTE /* READER FILE CONTROL BLOCK */
|
||
INITIAL(0, /DECLARE
|
||
PRINTSUPPRESS BYTE; /* TRUE IF PRINT SUPPRESSED */
|
||
|
||
PRINTCHAR: PROCEDURE(CHAR);
|
||
DECLARE CHAR BYTE;
|
||
IF PRILE LIT '1AH'; /* CP/M END OF FILE */
|
||
|
||
DECLARE
|
||
MAX ADDRESS, /* .MEMORY(MAX)=0 (END) */
|
||
MAXM ADFFADR (128) BYTE, /* DEST BUFFER */
|
||
NSOURCE ADDRESS, /* NEXT SOURCE CHARACTER */
|
||
NDEST ADDRESS; /* NIVE */
|
||
|
||
NBUF BYTE, /* NUMBER OF BUFFERS */
|
||
BUFFLENGTH ADDRESS, /* NBUF * SECTSIZE */
|
||
SFCB */
|
||
IF COLUMN = 0 THEN RETURN;
|
||
CALL TTYCHAR(CTLH); /* COLUMN = COLUMN - 1 */
|
||
CALL TTYCHAR(' ' ); /* COLUMN = COLU* FILE NAME */ ' ',
|
||
/* FILE TYPE */ 'LIB',0,0,0),
|
||
RBP BYTE, /* READ BUFFER POINTER */
|
||
INTSUPPRESS THEN RETURN;
|
||
CALL MON1(2,CHAR);
|
||
END PRINTCHAR;
|
||
|
||
DECLARE
|
||
COLUMN BYTE, /* CONSOLE COLUMN POSITION *DRESS, /* MINUS 1 */
|
||
HMAX ADDRESS; /* = MAX/2 */
|
||
|
||
DECLARE
|
||
RO LITERALLY '9', /* REXT DESTINATION CHAR */
|
||
|
||
DECLARE SDISK BYTE, /* SOURCE FILE DISK */
|
||
DDISK BYTE; /* DESTINATION FILE DISK */
|
||
(FS) BYTE AT(.FCB), /* SOURCE FCB = DEFAULT FCB */
|
||
SBUFFADR ADDRESS, /* SOURCE BUFFER ADDRESS */
|
||
SBUFF BASMN + 1 */
|
||
CALL TTYCHAR(CTLH); /* COLUMN = COLUMN - 1 */
|
||
COLUMN = COLUMN - 2;
|
||
END BACKSPACE;
|
||
|
||
PRINTABS: PROCEDURXFCB (FS) BYTE /* XFER FILE CONTROL BLOCK */
|
||
INITIAL(0, 'X$$$$$$$','LIB',0,0,0),
|
||
XFCBE BYTE AT(.XFCB(EX)), /* XFC/
|
||
SCOLUMN BYTE, /* STARTING COLUMN IN "I" MODE */
|
||
TCOLUMN BYTE, /* TEMP DURING BACKSPACE */
|
||
QCOLUMN BYTE; /* TEMP/O FILE INDICATOR */
|
||
SY LITERALLY '10', /* SYSTEM FILE ATTRIBUTE */
|
||
EX LITERALLY '12', /* EXTENT NUMBER POSITION */
|
||
|
||
|
||
/* IO SECTION */
|
||
|
||
READCHAR: PROCEDURE BYTE; RETURN MON2(1,0);
|
||
END READCHAR;
|
||
|
||
DECLARE TRUE LITERALLY '1', FALSE LIE(CHAR);
|
||
DECLARE (CHAR,I,J) BYTE;
|
||
I = CHAR = TAB AND 7 - (COLUMN AND 7);
|
||
IF CHAR = TAB THEN CHAR = ' ';
|
||
CB);
|
||
DECLARE FCB ADDRESS;
|
||
CALL MON1(23,FCB);
|
||
END RENAME;
|
||
|
||
DECLARE (MAXLEN,COMLEN) BYTE, COMBUFF(128) BYTE,
|
||
: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = MON2(17,FCB);
|
||
END SEARCH;
|
||
|
||
DELETE: PROCEDURE(FCB);
|
||
DECLARE STORAGE,
|
||
ITS DEFINITION IS:
|
||
MOVE: PROCEDURE(COUNT,SOURCE,DEST);
|
||
DECLARE (COUNT,SOURCE,DEST) ADDRESS;
|
||
END CRLF;
|
||
|
||
PRINTM: PROCEDURE(A);
|
||
DECLARE A ADDRESS;
|
||
CALL MON1(9,A);
|
||
END PRINTM;
|
||
|
||
PRINT: PROCEDURE(A);
|
||
|
||
SETDMA: PROCEDURE(A);
|
||
DECLARE A ADDRESS;
|
||
/* SET DMA ADDRESS */
|
||
CALL MON1(26,A);
|
||
END SETDMA;
|
||
|
||
REBOOT: PRODO J = 0 TO I;
|
||
CALL TTYCHAR(CHAR);
|
||
END;
|
||
END PRINTABS;
|
||
|
||
GRAPHIC: PROCEDURE(C) BYTE;
|
||
DECLARE C BYTE (TCBP,CBP) BYTE;
|
||
|
||
READCOM: PROCEDURE;
|
||
MAXLEN = 128; CALL READ(.MAXLEN);
|
||
END READCOM;
|
||
|
||
BREAK$KEY: PROCEDURE BYTFCB ADDRESS;
|
||
CALL MON1(19,FCB);
|
||
END DELETE;
|
||
|
||
DISKREAD: PROCEDURE(FCB) BYTE;
|
||
DECLARE FCB ADDRESS;
|
||
RETURN M/ MOVE DATA FROM SOURCE TO DEST ADDRESSES, FOR COUNT BYTES /
|
||
END MOVE;
|
||
*/
|
||
|
||
ABORT: PROCEDURE(A);
|
||
DECLARE A AD DECLARE A ADDRESS;
|
||
CALL CRLF;
|
||
CALL PRINTM(A);
|
||
END PRINT;
|
||
|
||
READ: PROCEDURE(A);
|
||
DECLARE A ADDRESS;
|
||
CALCEDURE;
|
||
IF XFERON THEN CALL DELETE(.XFCB);
|
||
CALL BOOT;
|
||
END REBOOT;
|
||
|
||
DECLARE /* LINE COUNTERS */
|
||
BASELINE AD;
|
||
/* RETURN TRUE IF GRAPHIC CHARACTER */
|
||
IF C >= ' ' THEN RETURN TRUE;
|
||
RETURN C = CR OR C = LF OR C = TAB;
|
||
EE;
|
||
IF MON2(11,0) THEN
|
||
DO; /* CLEAR CHAR */
|
||
CALL MON1(1,0); RETURN TRUE;
|
||
END;
|
||
RETURN FALSE;
|
||
ON2(20,FCB);
|
||
END DISKREAD;
|
||
|
||
DISKWRITE: PROCEDURE(FCB) BYTE;
|
||
DECLARE FCB ADDRESS;
|
||
RETURN MON2(21,FCB);
|
||
ENDDRESS;
|
||
CALL PRINT(A);
|
||
CALL CRLF;
|
||
CALL REBOOT;
|
||
END ABORT;
|
||
|
||
FERR: PROCEDURE;
|
||
CALL CLOSE(.DFCB); /* ATTEL MON1(10,A);
|
||
END READ;
|
||
|
||
DECLARE DCNT BYTE;
|
||
|
||
|
||
OPEN: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = MON2(15DRESS, /* CURRENT LINE */
|
||
RELLINE ADDRESS, /* RELATIVE LINE IN TYPEOUT */
|
||
LINESET BYTE; /* TRUEND GRAPHIC;
|
||
|
||
PRINTC: PROCEDURE(C);
|
||
DECLARE C BYTE;
|
||
IF NOT GRAPHIC(C) THEN
|
||
DO; CALL PRINTABS('^');
|
||
|
||
END BREAK$KEY;
|
||
|
||
CSELECT: PROCEDURE BYTE;
|
||
/* RETURN CURRENT DRIVE NUMBER */
|
||
RETURN MON2(25,0);
|
||
END CSELECT DISKWRITE;
|
||
|
||
MAKE: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = MON2(22,FCB);
|
||
END MAKE;
|
||
|
||
RENAME: PROCEDURE(FMPT TO CLOSE FILE FOR LATER RECOVERY */
|
||
CALL ABORT (.('DISK OR DIRECTORY FULL$'));
|
||
END FERR;
|
||
|
||
SETTYPE: PROCEDURE(A),FCB);
|
||
END OPEN;
|
||
|
||
CLOSE: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = MON2(16,FCB);
|
||
END CLOSE;
|
||
|
||
SEARCH IF LINE #'S PRINTED */
|
||
|
||
/* INPUT / OUTPUT BUFFERING ROUTINES */
|
||
|
||
/* THE PL/M BUILT-IN PROCEDURE "MOVE" IS USED TO MOVE C = C + '@';
|
||
END;
|
||
CALL PRINTABS(C);
|
||
END PRINTC;
|
||
|
||
CRLF: PROCEDURE;
|
||
CALL PRINTC(CR); CALL PRINTC(LF);
|
||
;
|
||
|
||
SELECT: PROCEDURE(DISK);
|
||
DECLARE DISK BYTE;
|
||
/* SET DRIVE NUMBER */
|
||
CALL MON1(14,DISK);
|
||
END SELECT;
|
||
|
||
;
|
||
DECLARE A ADDRESS;
|
||
CALL MOVE(3,A,.DFCB+9);
|
||
END SETTYPE;
|
||
|
||
SETUP: PROCEDURE;
|
||
NSOURCE = BUFFLENGTH; NDEST TART WITH LINE 1 */
|
||
END SETUP;
|
||
|
||
XCLEAR: PROCEDURE;
|
||
/* CLEAR THE XFER FILE PARAMETERS */
|
||
XFERON, XFCBE, XFCBR, F ROL(FCB(SY),1) THEN
|
||
CALL ABORT(.('"SYSTEM" FILE NOT ACCESSIBLE$'));
|
||
CALL SETTYPE(.('BAK'));
|
||
CALL DELETE(.DFND ZN;
|
||
|
||
CALL SELECT(DDISK);
|
||
IF LOW((N := SHR(NDEST,SECTSHF) - 1)) = 255 THEN RETURN;
|
||
CALL ZN;
|
||
DO I = 0 CALL SEARCH(.FCB);
|
||
IF DCNT <> 255 THEN /* SOURCE FILE PRESENT ON DEST DISK */
|
||
CALL ABORT(.('FILE EXISTS ELSE
|
||
NSOURCE = NSOURCE + SECTSIZE;
|
||
END;
|
||
CALL ZN;
|
||
END FILLSOURCE;
|
||
|
||
GETSOURCE: PROCEDURE BYT= 0;
|
||
SFCB(EX), SFCB(MD), SFCB(NR) = 0;
|
||
/* REEL AND RECORD ZEROED */
|
||
/* COPY NAME TO DESTINATION FCB */
|
||
CALL XBP = 0;
|
||
END XCLEAR;
|
||
|
||
SETXDMA: PROCEDURE;
|
||
CALL SELECT(SDISK);
|
||
CALL SETDMA(.XBUFF);
|
||
END SETXDMA;
|
||
|
||
FILLSOUCB);
|
||
IF SDISK <> DDISK THEN
|
||
DO; /* REMOVE BAK FILES FROM DESTINATION DISK */
|
||
CALL SELECT(DDISK);
|
||
TO N;
|
||
CALL SETDMA(DBUFFADR+NDEST);
|
||
IF DISKWRITE(.DFCB) <> 0 THEN CALL FERR;
|
||
NDEST = NDEST + SECTSIZE, ERASE IT$'));
|
||
END;
|
||
CALL SELECT(SDISK);
|
||
CALL OPEN(.FCB);
|
||
IF DCNT = 255 THEN
|
||
DO; CALL MAKE(.FCBE;
|
||
DECLARE B BYTE;
|
||
IF NSOURCE >= BUFFLENGTH THEN CALL FILLSOURCE;
|
||
IF (B := SBUFF(NSOURCE)) <> ENDFILE THEN
|
||
MOVE(33,.FCB,.DFCB);
|
||
/* SOURCE AND DESTINATION DISKS SET */
|
||
|
||
/* IF SOURCE AND DESTINATION DISKS DIFFER, CHECK FOR
|
||
RCE: PROCEDURE;
|
||
DECLARE I BYTE;
|
||
ZN: PROCEDURE;
|
||
NSOURCE = 0;
|
||
END ZN;
|
||
|
||
CALL ZN;
|
||
CALL SELE CALL DELETE(.DFCB);
|
||
END;
|
||
CALL SETTYPE(.('$$$'));
|
||
CALL DELETE(.DFCB);
|
||
CALL MAKE(.DFCB);
|
||
DFCB(32) = ;
|
||
END;
|
||
CALL ZN;
|
||
END WRITEDEST;
|
||
|
||
PUTDEST: PROCEDURE(B);
|
||
DECLARE B BYTE;
|
||
IF NDEST >= BUFFLENGTH TH);
|
||
IF DCNT = 255 THEN CALL FERR;
|
||
CALL PRINT(.('NEW FILE$'));
|
||
CALL CRLF;
|
||
END; ELSE
|
||
IF RO NSOURCE = NSOURCE + 1;
|
||
RETURN B;
|
||
END GETSOURCE;
|
||
|
||
WRITEDEST: PROCEDURE;
|
||
/* WRITE OUTPUT BUFFER UP TO (NOT IN AN EXISTING SOURCE FILE ON THE DESTINATION DISK - THERE
|
||
COULD BE A FATAL ERROR CONDITION WHICH COULD DESTROY A
|
||
FILE CT(SDISK);
|
||
DO I = 0 TO NBUF;
|
||
CALL SETDMA(SBUFFADR+NSOURCE);
|
||
IF (DCNT := DISKREAD(.FCB)) <> 0 THEN
|
||
0; /* NEXT RECORD IS ZERO */
|
||
IF DCNT = 255 THEN CALL FERR;
|
||
/* THE TEMP FILE IS NOW CREATED */
|
||
BASELINE = 1; /* SEN CALL WRITEDEST;
|
||
DBUFF(NDEST) = B;
|
||
NDEST = NDEST + 1;
|
||
END PUTDEST;
|
||
|
||
PUTXFER: PROCEDURE(C);
|
||
DECLARE C BYL(FCB(RO),1) THEN
|
||
DO;
|
||
CALL PRINT(.('** FILE IS READ/ONLY **$'));
|
||
CALL CRLF;
|
||
END; ELSE
|
||
ICLUDING) NDEST.
|
||
LOW 7 BITS OF NDEST ARE ZERO */
|
||
DECLARE (I,N) BYTE;
|
||
ZN: PROCEDURE;
|
||
NDEST = 0;
|
||
EIF THE USER HAPPENED TO BE ADDRESSING THE WRONG
|
||
DISK */
|
||
IF SDISK <> DDISK THEN
|
||
DO; CALL SELECT(DDISK);
|
||
DO; IF DCNT > 1 THEN CALL FERR;
|
||
SBUFF(NSOURCE) = ENDFILE;
|
||
I = NBUF;
|
||
END;
|
||
TE;
|
||
/* WRITE C TO XFER FILE */
|
||
IF XBP >= SECTSIZE THEN /* BUFFER OVERFLOW */
|
||
DO; CALL SETXDMA;
|
||
IF DI
|
||
READBUFF BYTE; /* TRUE IF END OF READ BUFFER */
|
||
|
||
DECLARE
|
||
EOS LITERALLY '0FFH';
|
||
|
||
|
||
|
||
PRINTNMAC: PROCEDURE(CH MACSIZE LIT '128', /* MAX MACRO SIZE */
|
||
SCRSIZE LIT '100', /* SCRATCH BUFFER SIZE */
|
||
COMSIZE LIT 'ADDRE / 10;
|
||
IF ZERO OR D <> 0 THEN
|
||
DO; ZERO = TRUE;
|
||
CALL PRINTC('0'+D);
|
||
END; ELSE
|
||
L CLOSE(.DFCB);
|
||
IF DCNT = 255 THEN CALL FERR;
|
||
/* RENAME OLD FILE TO BAK */
|
||
CALL SETTYPE(.('BAK')); CALL MOVEUP;
|
||
C TO UPPER CASE */
|
||
IF LOWERCASE(C) THEN RETURN C AND 5FH;
|
||
RETURN C;
|
||
END UCASE;
|
||
|
||
UTRAN: PROCEDURE(C) BYTE;
|
||
SKWRITE(.XFCB) <> 0 THEN CALL FERR;
|
||
XBP = 0;
|
||
END;
|
||
XBUFF(XBP) = C; XBP = XBP + 1;
|
||
END PUTXFER;
|
||
|
||
FINAR);
|
||
DECLARE CHAR BYTE;
|
||
/* PRINT IF NOT IN MACRO EXPANSION */
|
||
IF MP <> 0 THEN RETURN;
|
||
CALL PRINTC(CHAR);
|
||
SS'; /* DETERMINES MAX COMMAND NUMBER*/
|
||
|
||
DCL MACRO(MACSIZE) BYTE,
|
||
SCRATCH(SCRSIZE) BYTE, /* SCRATCH BUFFER FOR F,N, CALL PRINTC(' ');
|
||
END;
|
||
END PRINTVALUE;
|
||
|
||
PRINTLINE: PROCEDURE(V);
|
||
DECLARE V ADDRESS;
|
||
IF NOT LINE CALL SELECT(SDISK);
|
||
CALL MOVE(16,.FCB,.DFCB);
|
||
CALL RENAME(.DFCB);
|
||
CALL MOVEUP;
|
||
/* RENAME $$$ TO OLD NAME DECLARE C BYTE;
|
||
/* TRANSLATE TO UPPER CASE IF ALPHABETIC LOWER AND TRANSLATE */
|
||
IF TRANSLATE THEN RETURN UCASE(C);
|
||
IS: PROCEDURE;
|
||
MOVEUP: PROCEDURE;
|
||
CALL MOVE(16,.DFCB,.DFCB+16);
|
||
END MOVEUP;
|
||
|
||
/* CLEAR OUTPUT */
|
||
DFUB END PRINTNMAC;
|
||
|
||
|
||
|
||
|
||
DECLARE TRANSLATE BYTE, /* TRUE IF TRANSLATION TO UPPER CASE */
|
||
UPPER BYTE; /* TRUE IFS */
|
||
(WBP, WBE, WBJ) BYTE, /* END OF F STRING, S STRING, J STRING */
|
||
(FLAG, MP, MI, XP) BYTE,
|
||
MT COMSIZE;
|
||
SET THEN RETURN;
|
||
CALL PRINTVALUE(V);
|
||
CALL PRINTC(':');
|
||
CALL PRINTC(' ');
|
||
IF INSERTING THEN CALL PRINTC(' '); */
|
||
CALL SETTYPE(.('$$$'));
|
||
CALL SELECT(DDISK);
|
||
CALL RENAME(.DFCB);
|
||
END FINIS;
|
||
|
||
|
||
DECLARE
|
||
LPP LIT ' RETURN C;
|
||
END UTRAN;
|
||
|
||
PRINTVALUE: PROCEDURE(V);
|
||
/* PRINT THE LINE VALUE V */
|
||
DECLARE (D,ZERO) BYTE,
|
||
= 0 ; /* SET UNFILLED BYTES - USED FOR ISIS-II COMPATIBILITY */
|
||
DO WHILE (LOW(NDEST) AND 7FH) <> 0;
|
||
DFUB = DFU GLOBALLY TRANLATING TO UC */
|
||
|
||
LOWERCASE: PROCEDURE(C) BYTE;
|
||
DECLARE C BYTE;
|
||
/* RETURN TRUE IF LOWER CASE ALPHABETI
|
||
DCL (START, RESTART, OVERCOUNT, OVERFLOW, RESET, BADCOM) LABEL;
|
||
|
||
DCL INSERTING BYTE, /* TRUE IF INSERTING CHARACTERS */
|
||
ELSE
|
||
CALL PRINTC('*');
|
||
END PRINTLINE;
|
||
|
||
|
||
PRINTBASE: PROCEDURE;
|
||
CALL PRINTLINE(BASELINE);
|
||
END PRINTBAS23', /* LINES PER PAGE */
|
||
FORWARD LIT '1',
|
||
BACKWARD LIT '0',
|
||
RUBOUT LIT '07FH',
|
||
POUND LIT '23H',
|
||
(K,V) ADDRESS;
|
||
K = 10000;
|
||
ZERO = FALSE;
|
||
DO WHILE K <> 0;
|
||
D = LOW(V/K); V = V MOD K;
|
||
K = KB + 1; /* COUNTS UNFILLED BYTES IN LAST RECORD */
|
||
CALL PUTDEST(ENDFILE);
|
||
END;
|
||
CALL WRITEDEST;
|
||
|
||
CALC */
|
||
RETURN C >= LCA AND C <= LCZ;
|
||
END LOWERCASE;
|
||
|
||
UCASE: PROCEDURE(C) BYTE;
|
||
DECLARE C BYTE;
|
||
/* TRANSLATEE;
|
||
|
||
PRINTNMBASE: PROCEDURE;
|
||
IF MP <> 0 THEN RETURN;
|
||
CALL PRINTBASE;
|
||
END PRINTNMBASE;
|
||
|
||
READC: PROCEDURE BYTE;
|
||
/* RETURN TRUE IF DISTANCE IS ZERO */
|
||
RETURN DISTANCE = 0;
|
||
END DISTZERO;
|
||
|
||
ZERODIST: PROCEDURE;
|
||
DISTANCE = 0;
|
||
ESS */
|
||
CALL SELECT(SDISK);
|
||
CALL SETDMA(.BUFF);
|
||
END SETRDMA;
|
||
|
||
READFILE: PROCEDURE BYTE;
|
||
IF RBP >= SECTSIZE ND; ELSE
|
||
DO; FIRST = BACK + 1; LAST = I + 1;
|
||
END;
|
||
END SETLIMITS;
|
||
|
||
INCFRONT: PROC; FRONT = FRONT + 1;
|
||
DO; READBUFF = FALSE;
|
||
IF LINESET AND COLUMN = 0 THEN
|
||
DO;
|
||
IF BACK >= MAXM THEN
|
||
END;
|
||
|
||
LOOPING = TRUE;
|
||
DO WHILE LOOPING;
|
||
DO WHILE (MIDDLE := I <> L) AND
|
||
MEMO
|
||
/* MAY BE MACRO EXPANSION */
|
||
IF MP > 0 THEN
|
||
DO;
|
||
IF BREAK$KEY THEN GO TO OVERCOUNT;
|
||
IF XP >= END ZERODIST;
|
||
|
||
DISTNZERO: PROCEDURE BYTE;
|
||
/* CHECK FOR ZERO DISTANCE AND DECREMENT */
|
||
IF NOT DISTZERO THEN
|
||
THEN
|
||
DO; CALL SETRDMA;
|
||
IF DISKREAD(.RFCB) <> 0 THEN RETURN ENDFILE;
|
||
RBP = 0;
|
||
END;
|
||
RETUR END INCFRONT;
|
||
INCBACK: PROCEDURE; BACK = BACK + 1;
|
||
END INCBACK;
|
||
DECFRONT: PROC; FRONT = FRONT - 1;
|
||
END DECFRONT; CALL PRINTLINE(0); ELSE
|
||
CALL PRINTBASE;
|
||
END; ELSE
|
||
CALL PRINTC('*');
|
||
CALL RY(M:=I+K) <> LF;
|
||
I = M;
|
||
END;
|
||
RELLINE = RELLINE - 1;
|
||
LOOPING = (DISTANCE := DISTANCE MP THEN
|
||
DO; /* START AGAIN */
|
||
IF MT <> 0 THEN
|
||
DO; IF (MT:=MT-1) = 0 THEN
|
||
DO; DISTANCE = DISTANCE - 1;
|
||
RETURN TRUE;
|
||
END;
|
||
RETURN FALSE;
|
||
END DISTNZERO;
|
||
|
||
SETLIMITS: PROCN UTRAN(BUFF((RBP := RBP + 1) - 1));
|
||
END READFILE;
|
||
|
||
DCL (DISTANCE, TDIST) COMSIZE,
|
||
(DIRECTION, CHAR) BYTE,
|
||
( F
|
||
DECBACK: PROC; BACK = BACK - 1;
|
||
END DECBACK;
|
||
INCBASE: PROCEDURE;
|
||
BASELINE = BASELINE + 1;
|
||
END INCBASE;
|
||
|
||
|
||
MREADCOM; CBP = 0;
|
||
CALL PRINTC(LF);
|
||
COLUMN = 0;
|
||
END;
|
||
IF (READBUFF := CBP = COMLEN ) THEN COMBUFF( - 1) <> 0;
|
||
IF NOT MIDDLE THEN
|
||
DO; LOOPING = FALSE;
|
||
I = I - K;
|
||
END; ELSE
|
||
GO TO OVERCOUNT;
|
||
END;
|
||
XP = 0;
|
||
END;
|
||
RETURN UTRAN(MACRO((XP := XP + ;
|
||
DCL (I,K,L,M) ADDR, (MIDDLE,LOOPING) BYTE;
|
||
RELLINE = 1; /* RELATIVE LINE COUNT */
|
||
IF DIRECTION = BACKWARD THEN
|
||
RONT, BACK, FIRST, LAST) ADDR;
|
||
|
||
SETFF: PROCEDURE;
|
||
DISTANCE = 0FFFFH;
|
||
END SETFF;
|
||
|
||
DISTZERO: PROCEDURE BYTE;
|
||
EM$MOVE: PROC(MOVEFLAG);
|
||
DECLARE (MOVEFLAG,C) BYTE;
|
||
/* MOVE IF MOVEFLAG IS TRUE */
|
||
IF DIRECTION = FORWARD THEN
|
||
CBP) = CR;
|
||
RETURN UTRAN(COMBUFF((CBP := CBP +1) -1));
|
||
END READC;
|
||
|
||
SETRDMA: PROCEDURE;
|
||
/* SET READ LIB DMA ADDR IF LOOPING THEN I = M;
|
||
END;
|
||
|
||
IF DIRECTION = BACKWARD THEN
|
||
DO; FIRST = I; LAST = FRONT - 1;
|
||
E1) - 1));
|
||
END;
|
||
IF INSERTING THEN RETURN UTRAN(READCHAR);
|
||
|
||
/* GET COMMAND LINE */
|
||
IF READBUFF THEN
|
||
|
||
DO; DISTANCE = DISTANCE+1; I = FRONT; L = 0; K = 0FFFFH;
|
||
END; ELSE
|
||
DO; I = BACK; L = MAXM; K = 1;
|
||
DO WHILE BACK < LAST; CALL INCBACK;
|
||
IF MOVEFLAG THEN
|
||
DO;
|
||
IF (C := MEMORY(BACK)) = LF T
|
||
DECLARE B BYTE;
|
||
DO FOREVER;
|
||
IF BACK >= MAXM THEN /* EMPTY */
|
||
DO; CALL ZERODIST; RETURN;
|
||
B BYTE;
|
||
/* CONDITIONALLY TRANSLATE TO UPPER CASE ON INPUT */
|
||
IF UPPER THEN RETURN UTRAN(B);
|
||
RETURN B;EAR BUFFERS */
|
||
CALL CLEARMEM;
|
||
DO WHILE (CHAR := GETSOURCE) <> ENDFILE;
|
||
CALL PUTDEST(CHAR);
|
||
END;
|
||
CALL MOVER;
|
||
END MOVELINES;
|
||
|
||
SETCLIMITS: PROC;
|
||
IF DIRECTION = BACKWARD THEN
|
||
DO; LAST = BACK;
|
||
IF DI 'DISTANCE',
|
||
CALLED FROM W AND E COMMANDS */
|
||
DIRECTION = BACKWARD; FIRST = 1; LAST = BACK;
|
||
CALL MOVER;
|
||
IF DIHEN CALL INCBASE;
|
||
MEMORY(FRONT) = C; CALL INCFRONT;
|
||
END;
|
||
END; ELSE
|
||
DO WHILE FRONT > END;
|
||
CALL INCBACK;
|
||
CALL PUTDEST(B:=MEMORY(BACK));
|
||
IF B = LF THEN
|
||
DO; CALL INCB
|
||
END CTRAN;
|
||
DO FOREVER;
|
||
IF FRONT >= BACK THEN GO TO OVERFLOW;
|
||
IF (B := CTRAN(GETSOURCE)) = ENDFILE THEN
|
||
CALL FINIS;
|
||
END TERMINATE;
|
||
|
||
|
||
INSERT: PROCEDURE;
|
||
/* INSERT CHAR INTO MEMORY BUFFER */
|
||
IF FRONT = BACK THSTANCE > FRONT THEN
|
||
FIRST = 1; ELSE FIRST = FRONT - DISTANCE;
|
||
END; ELSE
|
||
DO; FIRST = FRONT;
|
||
STZERO THEN CALL WRHALF;
|
||
/* DISTANCE = 0 IF CALL WRHALF */
|
||
DO WHILE DISTNZERO;
|
||
CALL WRITELINE;
|
||
EFIRST; CALL DECFRONT;
|
||
IF (C := MEMORY(FRONT)) = LF THEN BASELINE = BASELINE - 1;
|
||
IF MOVEFLAG THEN
|
||
ASE;
|
||
RETURN;
|
||
END;
|
||
END;
|
||
END WRITELINE;
|
||
|
||
WRHALF: PROCEDURE;
|
||
/* WRITE LINES UNTIL
|
||
DO; CALL ZERODIST; RETURN;
|
||
END;
|
||
MEMORY(FRONT) = B;
|
||
CALL INCFRONT;
|
||
IF B = LF THEN
|
||
DO; CEN GO TO OVERFLOW;
|
||
MEMORY(FRONT) = CHAR; CALL INCFRONT;
|
||
IF CHAR = LF THEN CALL INCBASE;
|
||
END INSERT;
|
||
|
||
SCANNING: IF DISTANCE >= MAX - BACK THEN
|
||
LAST = MAXM; ELSE LAST = BACK + DISTANCE;
|
||
END;
|
||
END SETCLIMITS;
|
||
|
||
ND;
|
||
IF BACK < LAST THEN
|
||
DO; DIRECTION = FORWARD; CALL MOVER;
|
||
END;
|
||
END WRITEOUT;
|
||
|
||
CLEARMEM: PROCED DO; MEMORY(BACK) = C; CALL DECBACK;
|
||
END;
|
||
END;
|
||
END MEM$MOVE;
|
||
|
||
MOVER: PROC;
|
||
CALL MEM$MOVE(TRUEAT LEAST HALF THE BUFFER IS EMPTY */
|
||
CALL SETFF;
|
||
DO WHILE DISTNZERO;
|
||
IF HMAX >= (MAXM - BACK) THEN CALL ZALL INCBASE;
|
||
RETURN;
|
||
END;
|
||
END;
|
||
END READLINE;
|
||
|
||
WRITELINE: PROCEDURE;
|
||
/* WRITE ONE LINE OUT */ PROCEDURE BYTE;
|
||
/* READ A CHARACTER AND CHECK FOR ENDFILE OR CR */
|
||
RETURN NOT ((CHAR := READC) = ENDFILE OR
|
||
READLINE: PROCEDURE;
|
||
DECLARE B BYTE;
|
||
/* READ ANOTHER LINE OF INPUT */
|
||
CTRAN: PROCEDURE(B) BYTE;
|
||
DECLARE URE;
|
||
/* CLEAR MEMORY BUFFER */
|
||
CALL SETFF;
|
||
CALL WRITEOUT;
|
||
END CLEARMEM;
|
||
|
||
TERMINATE: PROCEDURE;
|
||
/* CL);
|
||
END MOVER;
|
||
|
||
SETPTRS: PROC;
|
||
CALL MEM$MOVE(FALSE);
|
||
END SETPTRS;
|
||
|
||
MOVELINES: PROC;
|
||
CALL SETLIMITS;
|
||
ERODIST; ELSE
|
||
CALL WRITELINE;
|
||
END;
|
||
END WRHALF;
|
||
|
||
WRITEOUT: PROCEDURE;
|
||
/* WRITE LINES DETERMINED BY (CHAR = CR AND NOT INSERTING));
|
||
END SCANNING;
|
||
|
||
COLLECT: PROCEDURE;
|
||
/* READ COMMAND BUFFER AND INSERT CHA
|
||
END CHKFOUND;
|
||
|
||
|
||
|
||
SETRFCB: PROCEDURE;
|
||
/* PLACE CHAR INTO READ FILE CONTROL BLOCK AND INCREMENT */
|
||
RFCB((RBP MATCHED ONE MORE CHARACTER */
|
||
K = K + 1; LAST = LAST + 1;
|
||
END;
|
||
END;
|
||
IF MATCH THEN /* MO CALL SETLPP;
|
||
CALL MOVELINES;
|
||
I = DIRECTION;
|
||
DIRECTION = FORWARD;
|
||
CALL SETLPP;
|
||
CALL TYPELINES;
|
||
D CALL SETSCR;
|
||
END;
|
||
END COLLECT;
|
||
|
||
FIND: PROCEDURE(PA,PB) BYTE;
|
||
DECLARE (PA,PB) BYTE;
|
||
/* FIND THE STR DO;
|
||
CALL PRINTREL;
|
||
RELLINE = RELLINE + 1;
|
||
IF BREAK$KEY THEN GO TO OVERCOUNT;
|
||
RACTERS INTO
|
||
SCRATCH 'TIL NEXT CONTROL-Z OR CR FOR FIND, NEXT, JUXT, OR
|
||
SUBSTITUTE COMMANDS - FILL AT WBE AND INCREME := RBP + 1) - 1) = UCASE(CHAR);
|
||
END SETRFCB;
|
||
|
||
PRINTREL: PROCEDURE;
|
||
CALL PRINTLINE(BASELINE+RELLINE);
|
||
END PRINVE STORAGE */
|
||
DO; LAST = LAST - 1; CALL MOVER;
|
||
END;
|
||
RETURN MATCH;
|
||
END FIND;
|
||
|
||
SETFIND: PROCEDURE;
|
||
IRECTION = I;
|
||
IF LAST = MAXM OR FIRST = 1 THEN CALL ZERODIST;
|
||
ELSE CALL RESTDIST;
|
||
END PAGE;
|
||
|
||
WAIT: PROCEDUING IN SCRATCH STARTING AT PA AND ENDING AT PB */
|
||
DECLARE J ADDRESS,
|
||
(K, MATCH) BYTE;
|
||
J = BACK ;
|
||
MATCH = END;
|
||
CALL PRINTC(C:=MEMORY(I));
|
||
END;
|
||
END TYPELINES;
|
||
|
||
SETLPP: PROCEDURE;
|
||
/* SET DISTANCE TNT WBE SO IT
|
||
ADDRESSES NEXT EMPTY POSITION OF SCRATCH */
|
||
SETSCR: PROCEDURE;
|
||
SCRATCH(WBE) = CHAR;
|
||
IF TREL;
|
||
|
||
TYPELINES: PROCEDURE;
|
||
DCL I ADDR;
|
||
DCL C BYTE;
|
||
CALL SETLIMITS;
|
||
/* DISABLE THE * PROMPT */
|
||
INSER
|
||
/* SETUP THE SEARCH STRING FOR F,N, AND S COMMANDS */
|
||
WBE = 0; CALL COLLECT; WBP = WBE;
|
||
END SETFIND;
|
||
|
||
CHKFOUNDRE;
|
||
/* 1/2 SECOND TIME OUT */
|
||
DECLARE I BYTE;
|
||
DO I = 0 TO 19;
|
||
IF BREAK$KEY THEN GO TO RESET;
|
||
FALSE;
|
||
DO WHILE NOT MATCH AND (MAXM > J);
|
||
LAST,J = J + 1; /* START SCAN AT J */
|
||
K = PA ; /* ATTEMPT O LINES PER PAGE */
|
||
DISTANCE = LPP;
|
||
END SETLPP;
|
||
|
||
SAVEDIST: PROCEDURE;
|
||
TDIST = DISTANCE;
|
||
END SAVEDIST;
|
||
|
||
(WBE := WBE + 1) >= SCRSIZE THEN GO TO OVERFLOW;
|
||
END SETSCR;
|
||
DO WHILE SCANNING;
|
||
IF CHAR = CTLL THEN
|
||
TING = TRUE;
|
||
IF DIRECTION = FORWARD THEN
|
||
DO; RELLINE = 0; I = FRONT;
|
||
END; ELSE
|
||
I = FIRST;
|
||
I: PROCEDURE;
|
||
/* CHECK FOR FOUND STRING IN F AND S COMMANDS */
|
||
IF NOT FIND(0,WBP) THEN /* NO MATCH */ GO TO OVERCOUNT;
|
||
CALL TIME(250);
|
||
END;
|
||
END WAIT;
|
||
|
||
SETFORWARD: PROCEDURE;
|
||
DIRECTION = FORWARD;
|
||
DISTANCE = 1;
|
||
END STRING MATCH AT K */
|
||
DO WHILE SCRATCH(K) = MEMORY(LAST) AND
|
||
NOT (MATCH := K = PB);
|
||
/*
|
||
RESTDIST: PROCEDURE;
|
||
DISTANCE = TDIST;
|
||
END RESTDIST;
|
||
|
||
PAGE: PROCEDURE;
|
||
DECLARE I BYTE;
|
||
CALL SAVEDIST;
|
||
DO; CHAR = CR; CALL SETSCR;
|
||
CHAR = LF;
|
||
END;
|
||
IF CHAR = 0 THEN GO TO BADCOM;
|
||
F (C := MEMORY(I-1)) = LF AND COLUMN <> 0 THEN
|
||
CALL CRLF;
|
||
DO I = FIRST TO LAST;
|
||
IF C = LF THEN
|
||
SETFORWARD;
|
||
|
||
APPHALF: PROCEDURE;
|
||
/* APPEND 'TIL BUFFER IS AT LEAST HALF FULL */
|
||
CALL SETFF; /* DISTANCE = 0FFFFH */ = SHR(MAX := MAXB - .MEMORY,SECTSHF+3) - 1;
|
||
/* NBUF IS NUMBER OF BUFFERS - 1 */
|
||
BUFFLENGTH = SHL(DOUBLE(NBUF+1),SECTSONLY CHARACTER, NOT IN MACRO, AND
|
||
THE OPERATOR HAS RESPONDED WITH 'Y' TO A Y/N REQUEST */
|
||
IF SINGLECOM(C) THEN
|
||
|
||
MEMORY(0) = LF;
|
||
FRONT = 1; BACK = MAXM;
|
||
COLUMN = 0;
|
||
GO TO START;
|
||
|
||
OVERCOUNT: FLAG = POUND; GO TO RESET;
|
||
UTRAN(CHAR);
|
||
TRANSLATE = UPPER OR NOT T;
|
||
END TESTCASE;
|
||
|
||
READCTRAN: PROCEDURE;
|
||
/* SET TRANSLATE TO FALSE AND RR(MAXM,1);
|
||
/* NO TRANSLATE, WITH LINE NUMBERS */
|
||
UPPER, PRINTSUPPRESS = FALSE;
|
||
LINESET = TRUE;
|
||
/* GET SOURCE
|
||
DO WHILE DISTNZERO;
|
||
IF FRONT >= HMAX THEN CALL ZERODIST; ELSE
|
||
CALL READLINE;
|
||
END;
|
||
END HF+1);
|
||
/* NOW SET MAX AS REMAINDER OF FREE MEMORY */
|
||
IF BUFFLENGTH + 1024 > MAX THEN
|
||
DO; CALL PRINT(.('NO MEM DO; CALL CRLF; CALL PRINTCHAR(C);
|
||
CALL MON1(9,.('-(Y/N)',WHAT,'$'));
|
||
C = UCASE(READCHAR); CALL CRLF;
|
||
|
||
|
||
BADCOM: FLAG = WHAT; GO TO RESET;
|
||
|
||
OVERFLOW: /* ARRIVE HERE ON OVERFLOW CONDITION (I,F,S COMMAND) */
|
||
FLAG = '>';
|
||
|
||
EAD NEXT CHARACTER */
|
||
TRANSLATE = FALSE;
|
||
CHAR = READC;
|
||
CALL TESTCASE;
|
||
END READCTRAN;
|
||
|
||
SINGLECOM: PROCEDUR AND DESTINATION DISKS */
|
||
IF (FCB(1) = ' ') OR (FCB(17) <> ' ') THEN CALL FERR;
|
||
IF (SDISK := FCB(0)) = 0 THEN SDISK = APPHALF;
|
||
|
||
INSCRLF: PROCEDURE;
|
||
/* INSERT CR LF CHARACTERS */
|
||
CHAR = CR; CALL INSERT;
|
||
CHAR = LF; CALL INSERT;
|
||
ORY$'));
|
||
CALL BOOT;
|
||
END;
|
||
/* REMOVE BUFFER SPACE AND 00 AT END OF MEMORY VECTOR */
|
||
MAX = MAX - BUFFLE IF C <> 'Y' THEN GO TO START;
|
||
RETURN TRUE;
|
||
END;
|
||
RETURN FALSE;
|
||
END SINGLERCOM;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
RESET: /* ARRIVE HERE ON ERROR CONDITION */
|
||
PRINTSUPPRESS = FALSE;
|
||
CALL PRINT(.('BREAK "$'));
|
||
CALL PRINTC(FLAG);E(C) BYTE;
|
||
/* RETURN TRUE IF COMMAND IS ONLY CHARACTER, NOT IN MACRO */
|
||
DECLARE C BYTE;
|
||
RETURN CHAR = C AND COMLECSELECT; ELSE
|
||
DO; SDISK = SDISK - 1; FCB(0) = 0; /* CLEAR DISK NAME */
|
||
END;
|
||
IF (DDISK := FCB(16)) = 0 THE END INSCRLF;
|
||
|
||
TESTCASE: PROCEDURE;
|
||
DECLARE T BYTE;
|
||
/* TEST FOR UPPER OR LOWER CASE COMMAND AND SET TRANSLATE
|
||
NGTH - 1;
|
||
/* RESET BUFFER LENGTH FOR I AND O */
|
||
BUFFLENGTH = SHR(BUFFLENGTH,1);
|
||
SBUFFADR = MAXB - BUFFLENGTH;
|
||
/* INITIALIZE THE SYSTEM */
|
||
|
||
EDCOMMAND: /* PAST LXI SP,STACK */
|
||
/* I/O BUFFER REGION IS 1/8 AVAILABLE MEMORY */
|
||
NBUF
|
||
CALL PRINTM(.('" AT $'));
|
||
CALL PRINTC(CHAR);
|
||
CALL CRLF;
|
||
|
||
|
||
START:
|
||
READBUFF = TRUE;
|
||
MP = 0;
|
||
|
||
|
||
N = 1 AND MP = 0;
|
||
END SINGLECOM;
|
||
|
||
SINGLERCOM: PROCEDURE(C) BYTE;
|
||
DECLARE C BYTE;
|
||
/* RETURN TRUE IF COMMAND IS N DDISK = SDISK; ELSE
|
||
DDISK = DDISK - 1;
|
||
/* CLEAR THE XFER FILE */
|
||
CALL XCLEAR;
|
||
|
||
RESTART:
|
||
CALL SETUP; FLAG (USED TO DETERMINE IF CHARACTERS WHICH FOLLOW GO TO UPPER */
|
||
TRANSLATE = TRUE;
|
||
T = LOWERCASE(CHAR);
|
||
CHAR = DBUFFADR = SBUFFADR - BUFFLENGTH;
|
||
MEMORY(MAX) = 0; /* STOPS MATCH AT END OF BUFFER */
|
||
MAXM = MAX - 1;
|
||
HMAX = SH DO FOREVER; /* OR UNTIL THE POWER IS TURNED OFF */
|
||
|
||
/* **************************************************************
|
||
THEN
|
||
DO; CALL CRLF;
|
||
CALL TYPELINES;
|
||
END; ELSE
|
||
THEN /* INSERT CHARACTERS */
|
||
DO;
|
||
IF (INSERTING := (CBP = COMLEN) AND (MP = 0)) THEN
|
||
CALL PRINTNMB= BACKWARD;
|
||
CALL TYPELINES;
|
||
PRINTSUPPRESS = FALSE;
|
||
/* ADDRESS FOR <CR> COMMAND */
|
||
IF SINGLECOM('E') THEN
|
||
DO; CALL TERMINATE;
|
||
IF SDISK <> DDISK THEN /* CHANGE OLUMN) > 0 THEN
|
||
CALL PRINTNMAC(' '); /* RESTORE AFT BACKSP */
|
||
IF FRONT > 1 AND TCOLUMN > S
|
||
SIMPLE COMMANDS (CANNOT BE PRECEDED BY DIRECTION/DISTANCE):
|
||
E END THE EDIT NORMALLY
|
||
H /* LINE DELETE */
|
||
DO; CALL SETLIMITS; CALL SETPTRS;
|
||
IF CHAR = CTLU THEN
|
||
ASE;
|
||
SCOLUMN = COLUMN; /* STARTING COLUMN POSITION */
|
||
DO WHILE SCANNING;
|
||
DO WHILE CHAR <> 0;
|
||
COLUMN POSITION NOW RESET */
|
||
IF (QCOLUMN := COLUMN) < SCOLUMN THEN
|
||
QCOLUMDISKS */
|
||
/* USER CODE IN HIGH NIBBLE */
|
||
BDISK = (BDISK AND 0F0H) OR (DDISK AND 0FH);
|
||
CALL REBCOLUMN THEN
|
||
DO;
|
||
IF MEMORY(FRONT-1) <> LF THEN
|
||
DO; /* CHARACTE MOVE TO HEAD OF EDITED FILE
|
||
I INSERT CHARACTERS
|
||
O RETURN TO THE ORIGINAL FILE
|
||
DO; CALL CRLF; CALL PRINTNMBASE;
|
||
END; ELSE
|
||
/* MUST BE CTLX */
|
||
IF CHAR=CTLU OR CHAR=CTLX OR CHAR=CTLR THEN
|
||
/* LINE DELETE OR RETYPE */
|
||
DO;
|
||
N = SCOLUMN;
|
||
COLUMN = TCOLUMN; /* ORIGINAL VALUE */
|
||
DO WHILE COLUMN > QCOLOOT;
|
||
END; ELSE
|
||
|
||
|
||
IF SINGLECOM('H') THEN /* GO TO TOP */
|
||
DO; CALL TERMINATE;
|
||
CHAR = DDISK; DDR CAN BE ELIMINATED */
|
||
CALL DECFRONT;
|
||
PRINTSUPPRESS = TRUE;
|
||
R READ FROM LIBRARY FILE
|
||
Q QUIT EDIT WITHOUT CHANGES TO ORIGINAL FILE
|
||
*********************** DO WHILE COLUMN > SCOLUMN;
|
||
CALL BACKSPACE;
|
||
END;
|
||
DISTANCE = 0; DIRECTION = BACKWARD;
|
||
/* ELIMINATE OR REPEAT THE LINE */
|
||
IF CHAR = CTLR UMN;
|
||
CALL BACKSPACE;
|
||
END;
|
||
TCOLUMN = COLUMN;
|
||
ISK = SDISK; SDISK = CHAR;
|
||
/* PING - PONG DISKS */
|
||
GO TO RESTART;
|
||
END; ELSE
|
||
|
||
|
||
IF CHAR = 'I' /* BACKSPACE CHARACTER ACCEPTED */
|
||
COLUMN = 0;
|
||
DISTANCE = 0; DIRECTION *************************************** */
|
||
|
||
|
||
|
||
INSERTING = FALSE;
|
||
CALL READCTRAN;
|
||
MI = CBP; /* SAVE STARTING END;
|
||
END; ELSE
|
||
IF CHAR = CTLH THEN
|
||
DO;
|
||
IF (TCOLUMN := C END;
|
||
END;
|
||
CHAR = 0;
|
||
COLUMN = TCOLUMN;
|
||
ROM LIB FILE */
|
||
RBP = 1; CALL SETRDMA;
|
||
DO WHILE SCANNING;
|
||
IF RBP > 8 THEN GO TO OVERCOUNT;
|
||
END;
|
||
IF CHAR = LF THEN CALL PRINTNMBASE;
|
||
IF CHAR = CR THEN
|
||
CALL PRINTNM/
|
||
DO; /* SCAN A SIGNED INTEGER VALUE (IF ANY) */
|
||
DCL I BYTE;
|
||
|
||
DIGIT: PROCEDURE BYTE;
|
||
RECTLL THEN
|
||
CALL INSCRLF; ELSE
|
||
DO; /* COLUMN COUNT GOES UP IF GRAPHIC */
|
||
TO RESET;
|
||
END;
|
||
DO WHILE (CHAR := READFILE) <> ENDFILE;
|
||
CALL INSERT;
|
||
END;
|
||
END; ELSE
|
||
IF CHAR = RUBOUT THEN
|
||
DO; IF FRONT = 1 THEN GO TO RESET;
|
||
CALL DEC CALL SETRFCB;
|
||
END;
|
||
CHAR = ' ';
|
||
IF (FLAG := RBP = 1) THEN /* READ FROM XFER FILE */
|
||
AC(CHAR:=LF); ELSE CHAR = 0;
|
||
END;
|
||
END;
|
||
IF CHAR <> ENDFILE THEN /* MUST HAVE STOPPED ON CR */
|
||
TURN (I := CHAR - '0') <= 9;
|
||
END DIGIT;
|
||
|
||
NUMBER: PROCEDURE;
|
||
DISTANCE = 0;
|
||
D /* COMPUTE OUTPUT COLUMN POSITION */
|
||
IF MP = 0 THEN
|
||
DO; IF CHAR >= ' ' THEN
|
||
I = 0;
|
||
IF FLAG THEN /* MAY BE XFER DATA IN BUFFER */
|
||
DO WHILE I < XBP;
|
||
CHAR = XBUFF(I)FRONT; CALL PRINTC(CHAR:=MEMORY(FRONT));
|
||
IF CHAR = LF THEN BASELINE=BASELINE-1;
|
||
CHAR = 0;
|
||
DO;
|
||
CALL MOVE(8,.XFCB(1),.RFCB(1));
|
||
CALL CLOSE(.XFCB);
|
||
END; ELSE /* LIB NAME SP CALL INSCRLF;
|
||
IF INSERTING AND LINESET THEN CALL CRLF;
|
||
END; ELSE
|
||
|
||
|
||
IF SINGLERCOM('O') THEN /O WHILE DIGIT;
|
||
DISTANCE = SHL(DISTANCE,3) +
|
||
SHL(DISTANCE,1) + I;
|
||
C
|
||
COLUMN = COLUMN + 1; ELSE
|
||
IF CHAR = TAB THEN
|
||
COLUMN =; I = I + 1;
|
||
CALL INSERT;
|
||
END;
|
||
END; ELSE
|
||
|
||
|
||
IF SINGLERCOM('Q') THEN
|
||
DO; CALL END; ELSE
|
||
/* NOT A SPECIAL CASE */
|
||
DO; IF NOT GRAPHIC(CHAR) THEN
|
||
ECIFIED */
|
||
DO WHILE RBP <= 8;
|
||
CALL SETRFCB;
|
||
END;
|
||
RFCB(12), RFCB(32) = 0; /* FILL* FORGET THIS EDIT */
|
||
GO TO RESTART; ELSE
|
||
|
||
|
||
IF CHAR = 'R' THEN
|
||
DO; DECLARE I BYTE;
|
||
/* READ FALL READCTRAN;
|
||
END;
|
||
/* RETURN WITH DISTANCE = NUMBER, CHAR = NEXT */
|
||
END NUMBER;
|
||
|
||
COLUMN + (8 - (COLUMN AND 111B));
|
||
END;
|
||
CALL INSERT;
|
||
END;
|
||
DELETE(.DFCB); CALL REBOOT;
|
||
END; ELSE
|
||
|
||
|
||
|
||
/* MAY BE A COMMAND WHICH HAS AN OPTIONAL DIRECTION AND DISTANCE * DO; CALL PRINTNMAC('^');
|
||
CALL PRINTNMAC(CHAR + '@');
|
||
END;
|
||
IF CHAR = REEL, AND NEXT RECORD */
|
||
CALL OPEN(.RFCB); RBP = SECTSIZE;
|
||
IF DCNT = 255 THEN
|
||
DO; FLAG = 'O'; GO RELDISTANCE: PROCEDURE;
|
||
IF DISTANCE > BASELINE THEN
|
||
DO; DIRECTION = FORWARD;
|
||
V VERIFY LINE NUMBERS
|
||
<CR> MOVE UP OR DOWN LINES AND PRINT LINE
|
||
*********************** AND DISTANCE ARE NOW SET */
|
||
|
||
|
||
/* **************************************************************
|
||
MAY BE A COMMAND = 'U' THEN
|
||
UPPER = DIRECTION = FORWARD; ELSE
|
||
|
||
IF CHAR = 'V' THEN
|
||
DO; /* 0V DISPLAYS BUFFERAY BE ABSOLUTE LINE REFERENCE */
|
||
IF CHAR = ':' THEN
|
||
DO; CHAR = 'L';
|
||
CALL RELDISTA CALL SETPTRS;
|
||
END; ELSE
|
||
|
||
|
||
IF CHAR = 'L' THEN CALL MOVELINES; ELSE
|
||
|
||
IF CHAR = 'P' THEN / DISTANCE = DISTANCE - BASELINE;
|
||
END; ELSE
|
||
DO; DIRECTION = BACKWARD;
|
||
DISTAN*************************************** */
|
||
|
||
|
||
IF CHAR = 'B' THEN
|
||
DO; DIRECTION = 1 - DIRECTION;
|
||
WHICH HAS DIRECTION AND DISTANCE SPECIFIED:
|
||
B BEGINNING/BOTTOM OF BUFFER
|
||
C MOVE CHARACTER STATE */
|
||
IF DISTZERO THEN
|
||
DO; CALL PRINTVALUE(BACK-FRONT);
|
||
CALL PRINTC('/');
|
||
NCE;
|
||
END;
|
||
END; ELSE
|
||
|
||
IF CHAR = ':' THEN /* LEADING COLON */
|
||
DO; CALL READCT* PAGE MODE PRINT */
|
||
DO; IF DISTZERO THEN
|
||
DO; DIRECTION = FORWARD;
|
||
CALL SETLPP; CCE = BASELINE - DISTANCE;
|
||
END;
|
||
END RELDISTANCE;
|
||
|
||
CALL SETFORWARD;
|
||
|
||
IF CHAR = FIRST = 1; LAST = MAXM; CALL MOVER;
|
||
END; ELSE
|
||
|
||
|
||
IF CHAR = 'C' THEN
|
||
DO; CALL SETCLIMPOSITIONS
|
||
D DELETE CHARACTERS
|
||
K KILL LINES
|
||
L MOVE LINE POSITION
|
||
CALL PRINTVALUE(MAXM);
|
||
CALL CRLF;
|
||
END; ELSE
|
||
LINESET = DIRECTION = FRAN; /* CLEAR THE COLON */
|
||
CALL NUMBER;
|
||
CALL RELDISTANCE;
|
||
IF DIRECTION = FORWARD THEN
|
||
ALL TYPELINES;
|
||
END; ELSE
|
||
DO WHILE DISTNZERO; CALL PAGE;
|
||
CALL WAIT;
|
||
'-' THEN
|
||
DO; CALL READCTRAN; DIRECTION = BACKWARD;
|
||
END;
|
||
|
||
IF CHAR = POUND THEN
|
||
ITS; CALL MOVER;
|
||
END; ELSE
|
||
|
||
|
||
IF CHAR = 'D' THEN
|
||
DO; CALL SETCLIMITS;
|
||
CALL SE P PAGE UP OR DOWN (LPP LINES AND PRINT)
|
||
T TYPE LINES
|
||
U UPPER CASE TRANSLATE
|
||
ORWARD;
|
||
END; ELSE
|
||
|
||
IF CHAR = CR THEN /* MAY BE MOVE/TYPE COMMAND */
|
||
DO;
|
||
IF MI DISTANCE = DISTANCE + 1;
|
||
END;
|
||
|
||
IF DISTZERO THEN DIRECTION = BACKWARD;
|
||
/* DIRECTION END;
|
||
END; ELSE
|
||
|
||
|
||
IF CHAR = 'T' THEN
|
||
CALL TYPELINES; ELSE
|
||
|
||
|
||
|
||
IF CHARDO; CALL SETFF; CALL READCTRAN;
|
||
END; ELSE
|
||
|
||
IF DIGIT THEN
|
||
DO; CALL NUMBER;
|
||
/* MTPTRS; /* SETS BACK/FRONT */
|
||
END; ELSE
|
||
|
||
|
||
IF CHAR = 'K' THEN
|
||
DO; CALL SETLIMITS;
|
||
= 1 AND MP = 0 THEN /* FIRST COMMAND */
|
||
DO; CALL MOVELINES; CALL SETFORWARD; CALL TYPELINES;
|
||
EEARCH FOR STRING 0 - WBP-1, INSERT STRING WBP TO WBJ-1,
|
||
AND THEN DELETE UP TO STRING WBJ TO WBE-1 */
|
||
D MOVER;
|
||
/* POINTERS REPOSITIONED */
|
||
END; ELSE
|
||
|
||
|
||
IF CHAR = 'F' THEN
|
||
DO; CALL DO WHILE DISTNZERO;
|
||
/* FIND ANOTHER OCCURRENCE OF STRING */
|
||
DO WHILE NOT FIND(0,WBP); /* N LINES TO TEMP FILE
|
||
Z SLEEP
|
||
************************************************************** */
|
||
|
||
|
||
FRONT = T;
|
||
END;
|
||
END; ELSE
|
||
|
||
|
||
IF CHAR = 'M' AND MP = 0 THEN /* MACRO DEFINITION */
|
||
ND;
|
||
END; ELSE
|
||
|
||
IF DIRECTION = FORWARD OR DISTZERO THEN
|
||
DO;
|
||
|
||
/* *************************O WHILE DISTNZERO; CALL CHKFOUND;
|
||
/* INSERT STRING */ MI = WBP - 1;
|
||
DO WHILE (MI := MI + 1) < WBJ;SETFIND; /* SEARCH STRING SCANNED
|
||
AND SETUP BETWEEN 0 AND WBP-1 IN SCRATCH */
|
||
DO WHILE DISTNZERO; OT IN BUFFER */
|
||
IF BREAK$KEY THEN GO TO RESET;
|
||
CALL SAVEDIST; CALL CLEARMEM;
|
||
|
||
IF CHAR = 'A' THEN
|
||
DO; DIRECTION = FORWARD;
|
||
FIRST = FRONT; LAST = MAXM; CALL MOVER;
|
||
DO; XP = 255;
|
||
IF DISTANCE = 1 THEN CALL ZERODIST;
|
||
DO WHILE (MACRO(XP := XP + 1) := READC) <>*************************************
|
||
COMMANDS WHICH ALLOW ONLY A PRECEDING NUMBER:
|
||
A APPEND LINES
|
||
|
||
CHAR = SCRATCH(MI); CALL INSERT;
|
||
END;
|
||
T = FRONT; /* SAVE POSITION FOR DELETE */
|
||
CALL CHKFOUND;
|
||
END;
|
||
END; ELSE
|
||
|
||
|
||
IF CHAR = 'J' THEN /* JUXTAPOSITION OPERATION */
|
||
/* MEMORY BUFFER WRITTEN */
|
||
CALL APPHALF;
|
||
DIRECTION = BACKWARD; FIRST = 1; /* ALL STORAGE FORWARD */
|
||
IF DISTZERO THEN CALL APPHALF;
|
||
/* DISTANCE = 0 IF APPHALF CALLED */
|
||
CR;
|
||
END;
|
||
MP = XP; XP = 0; MT = DISTANCE;
|
||
END; ELSE
|
||
|
||
|
||
IF CHAR = 'N' THEN F FIND NTH OCCURRENCE
|
||
M APPLY MACRO
|
||
N SAME AS F WITH AUTOSCAN THROUGH FILE
|
||
|
||
IF NOT FIND(WBJ,WBE) THEN GO TO OVERCOUNT;
|
||
/* STRING FOUND, SO MOVE IT BACK */
|
||
FIRST = FR DO; DECLARE T ADDRESS;
|
||
CALL SETFIND; CALL COLLECT;
|
||
WBJ = WBE; CALL COLLECT;
|
||
/* S CALL MOVER;
|
||
CALL RESTDIST; DIRECTION = FORWARD;
|
||
/* MAY BE END OF FILE */
|
||
DO WHILE DISTNZERO;
|
||
CALL READLINE;
|
||
END;
|
||
DIRECTION = BACKWARD; CALL
|
||
DO; /* SEARCH FOR STRING WITH AUTOSCAN */
|
||
CALL SETFIND; /* SEARCH STRING SCANNED */
|
||
S PERFORM N SUBSTITUTIONS
|
||
W WRITE LINES TO OUTPUT FILE
|
||
X TRANSFER (XFER)ONT - (WBE - WBJ);
|
||
DIRECTION = BACKWARD; CALL MOVER;
|
||
/* NOW REMOVE THE INTERMEDIATE STRING */
|
||
IF BACK >= MAXM THEN GO TO OVERCOUNT;
|
||
END;
|
||
END;
|
||
END; ELSE
|
||
|
||
|
||
ELSE
|
||
|
||
IF CHAR = 'Z' THEN /* SLEEP */
|
||
DO;
|
||
IF DISTZERO THEN
|
||
DO; IF READCHAR =I ADDRESS;
|
||
IF NOT XFERON THEN /* CREATE XFER FILE */
|
||
DO; CALL XCLEAR;
|
||
2
|
||
0C22 84 0C2B 85 0C2C 87 0C32 89 0C3E 90
|
||
0C3F 91 0C45 93 0C51 94 0C52 95 0C58 97
|
||
0C64 98 0C65 99 0C6B 101 0C74 102AR = SCRATCH(MI);
|
||
MI = MI + 1; CALL INSERT;
|
||
END;
|
||
END;
|
||
E0000 ED#
|
||
0000 ED#
|
||
0AF3 17 0AF3 18 0AFC 19 0AFC 22 0B00 24
|
||
0B07 25 0B08 26 0B13 27 0B14 29 0B18 31
|
||
0B20 32 0B24 33 IF CHAR = 'S' THEN /* SUBSTITUTE COMMAND */
|
||
DO; CALL SETFIND;
|
||
CALL COLLECT;
|
||
/* FIND ENDFILE THEN GO TO RESET;
|
||
END;
|
||
DO WHILE DISTNZERO; CALL WAIT;
|
||
END;
|
||
XFERON = TRUE;
|
||
CALL DELETE(.XFCB); /* OLD VERSION GONE */
|
||
CALL MAKE(.XFCB);
|
||
0C75 103
|
||
0C7B 105 0C85 106 0C85 107 0C8B 109 0C95 110
|
||
0C95 111 0C9B 113 0CA7 114 0CA8 115 0CAE 117
|
||
0CB7 118 0CB8 120 0CB8 12ND; ELSE
|
||
|
||
|
||
IF CHAR = 'W' THEN
|
||
CALL WRITEOUT; ELSE
|
||
|
||
IF CHAR = 'X' THEN /* TRANSFER LINES */
|
||
0B2C 34 0B31 35 0B38 36
|
||
0B39 37 0B39 38 0B41 39 0B42 40 0B47 41
|
||
0B4C 42 0B51 43 0B56 44 0B57 45 0B5B 47
|
||
0B73 48 0BSTRING FROM 0 TO WBP-1, SUBSTITUTE STRING
|
||
BETWEEN WBP AND WBE-1 IN SCRATCH */
|
||
DO WHILE DISTNZERO;
|
||
END; ELSE
|
||
IF CHAR <> 0 THEN /* NOT BREAK LEFT OVER FROM STOP */
|
||
/* DIRECTION FORWARD, BUT NOT ONE OF THE A IF DCNT = 255 THEN CALL FERR;
|
||
END;
|
||
CALL SETLIMITS;
|
||
DO I =1 0CBD 122 0CC3 123
|
||
0CC4 124 0CC4 125 0CD0 127 0CD8 128 0CDB 129
|
||
0CDB 130 0CDE 131 0CDE 132 0CDE 133 0CE7 134
|
||
0CE7 135 0CEB 1
|
||
DO;
|
||
CALL SETXDMA;
|
||
IF DISTZERO THEN /* CLEAR THE FILE */
|
||
DO; CALL XCLEAR;78 49 0B7D 50 0B8C 51 0B93 52
|
||
0B9A 53 0B9B 54 0B9F 56 0BA7 57 0BAA 58
|
||
0BCB 59 0BCB 60 0BCF 62 0BDA 64 0BDF 65
|
||
0BE7
|
||
CALL CHKFOUND;
|
||
/* FRONT AND BACK NOW POSITIONED AT FOUND
|
||
STRING - REPLACE IT BOVE */
|
||
GO TO BADCOM;
|
||
|
||
|
||
END; ELSE /* DIRECTION NOT FORWARD */
|
||
GO TO BADCOM;
|
||
END;
|
||
FIRST TO LAST;
|
||
CALL PUTXFER(MEMORY(I));
|
||
END;
|
||
END;
|
||
END; 37 0CF6 138 0CF7 139 0CFD 141
|
||
0D06 142 0D07 143 0D07 144 0D0E 145 0D14 146
|
||
0D17 147 0D18 149 0D1E 151 0D26 152 0D29 153
|
||
0D2C
|
||
CALL DELETE(.XFCB);
|
||
END; ELSE
|
||
/* TRANSFER LINES */
|
||
DO; DECLARE 66 0BE7 67 0BEE 68 0BEF 69 0BEF 70
|
||
0BF4 71 0BF9 72 0BFA 73 0C00 75 0C09 76
|
||
0C0A 77 0C10 79 0C13 80 0C1B 81 0C1C 8*/
|
||
FRONT = FRONT - (MI := WBP); /* BACKED UP */
|
||
DO WHILE MI < WBE;
|
||
CH END;
|
||
END;
|
||
154 0D2D 155 0D2D 156 0D33 157 0D39 158
|
||
0D3A 159 0D40 161 0D54 162 0D55 163 0D55 164
|
||
0D5B 165 0D61 166 0D70 167 0D80 168 0D8A 360 1160 361 1161 362 1164 363
|
||
1165 364 1165 365 116E 367 1175 368 1178 369
|
||
1182 371 118E 373 119E 374 11A1 375 11A1 376
|
||
11A1 1004 292 1007 293 100E 294 101E 295
|
||
1024 296 1027 297 102D 298 1034 299 103A 300
|
||
104C 306 1050 308 1058 309 1059 310 1060 3101 141F 502 1422 503 1432 504
|
||
1439 505 1440 507 144B 508 144E 509 144E 510
|
||
1451 511 1452 512 1452 513 1457 514 1458 515
|
||
1458 EC5 231 0ECF 232 0ED2 233 0EDA 234 0EDA 236
|
||
0EE6 237 0EE9 238 0EFA 239 0F01 240 0F05 241
|
||
0F05 242 0F66 244 0F66 245 0F6C 246 012D2 440 12D8 441 12DC 442 12DF 444
|
||
12E5 445 12EB 446 12F1 447 12F1 448 12F6 449
|
||
12FD 450 132A 451 1330 452 1333 453 133A 454
|
||
170
|
||
0D91 171 0D97 172 0D9F 173 0DA5 174 0DA5 175
|
||
0DAC 176 0DB2 177 0DBA 179 0DC0 180 0DC8 181
|
||
0DCB 182 0DD1 183 0DD4 184 0DD76 377 11A6 378 11BA 379 11BA 380 11C1 381
|
||
11C9 382 11D0 384 11D5 385 11E5 387 11F1 388
|
||
11FA 389 11FD 390 1200 391 1205 392 1201
|
||
1061 313 1065 315 1079 316 1079 317 107D 319
|
||
1088 320 108E 321 1092 322 1092 323 1096 325
|
||
109D 326 10A5 327 10A9 328 10A9 3516 145D 517 145E 518 145E 519 1461 520
|
||
1464 521 1465 522 1465 523 146D 525 1473 526
|
||
147F 527 1488 528 1494 529 1497 531 149D F05 247
|
||
0F0C 248 0F20 249 0F21 250 0F24 251 0F33 252
|
||
0F40 253 0F4B 254 0F4E 255 0F58 256 0F62 257
|
||
0F65 258 0F6D 259 0F71 261
|
||
134D 455 1355 457 135A 458 1368 459 136B 460
|
||
1372 461 1378 462 137B 463 1383 465 1389 466
|
||
1390 467 1393 469 139A 470 13A1 471 185 0DDF 187
|
||
0DE5 188 0DE8 189 0DEB 190 0DF3 191 0DF9 192
|
||
0DFF 193 0E05 194 0E0F 196 0E16 197 0E1C 198
|
||
0E1C 199 0E22 200 0E28 393
|
||
120D 394 1212 395 1217 396 1217 397 1228 398
|
||
1233 399 1247 400 1247 401 1247 402 124E 403
|
||
1254 404 1255 405 1255 406 1229 10AF 331
|
||
10B5 332 10BA 333 10C6 334 10D4 335 10E1 336
|
||
10EF 337 10FF 339 1104 340 110D 341 1110 342
|
||
1115 343 1118 344 1119 532
|
||
14AF 533 14B8 534 14C3 535 14C3 536 14C4 537
|
||
1504 539 1508 541 150F 542 1517 543 151B 544
|
||
14C4 545 14C4 546 14D0 547 14D30F7D 262 0F80 263
|
||
0F8C 264 0F93 265 0F94 266 0F98 268 0FA0 270
|
||
0FA3 271 0FAE 272 0FB1 273 0FB6 274 0FB6 275
|
||
0FC3 276 0FCA 277 13A1 472
|
||
13A2 473 13A2 474 13A9 475 13AA 476 13AA 477
|
||
13B1 478 13B2 479 13B2 480 13B9 481 13BA 482
|
||
13BA 483 13C1 484 13C2 488 201 0E2E 202 0E33 203
|
||
0E3B 204 0E3E 205 0E44 206 0E45 207 0E45 208
|
||
0E59 209 0E5A 210 0E5A 211 0E61 212 0E67 213
|
||
0E68 214 0E5D 408 1260 409
|
||
126B 410 126E 411 1273 412 1273 413 1287 414
|
||
1287 416 1287 417 128D 418 128E 419 128E 420
|
||
129B 421 129B 422 1345 111F 347 1127 348
|
||
1128 349 1130 350 1135 351 113A 352 1141 353
|
||
1149 354 114E 355 114F 356 114F 357 1157 358
|
||
1158 359 1158 548 14E2 550
|
||
14E5 551 14E6 552 14E6 553 14F1 554 14F4 555
|
||
14FC 557 14FF 558 1500 559 1500 560 1503 561
|
||
151B 562 151B 564 151 0FCB 278 103B 279 103B 280
|
||
104B 281 0FCB 282 0FD0 283 0FDB 284 0FE2 285
|
||
0FE7 286 0FEA 287 0FED 288 0FF3 289 0FFB 290
|
||
0FFE 295 13C2 486 13C9 487
|
||
13CA 488 13CE 490 13D6 491 13E2 492 13E5 493
|
||
13EC 495 13FC 496 13FF 497 140A 498 140D 499
|
||
140D 500 1413 5D3 216 0ED3 217 0ED9 218 0E68 219
|
||
0E6B 220 0E72 221 0E81 222 0E8E 223 0E9C 225
|
||
0EA5 226 0EA8 227 0EB2 228 0EB8 229 0EBB 230
|
||
029B 423 12A1 424 12A2 425
|
||
12A2 426 12AA 428 12B1 429 12B4 430 12B4 431
|
||
12B7 432 12B7 433 12B7 435 12BD 436 12C5 438
|
||
12CC 439 B 565 1527 567 152A 568
|
||
152B 569 152B 570 152E 571 153D 572 1545 574
|
||
1548 575 1549 576 1549 577 154C 578 154D 579
|
||
154D 580 15CB 760 18D1 761
|
||
18D4 762 18D5 763 18D9 765 18FC 766 18FC 767
|
||
1900 769 190B 771 190E 772 1915 773 191D 774
|
||
1927 775 192A 776 1701 17DA 702 17DA 703
|
||
17E0 704 17E1 705 17E1 706 17E7 707 17E8 708
|
||
17E8 709 17EE 710 17EF 711 17EF 713 17F2 714
|
||
17F5 715 17F8 900 04BC 901
|
||
04C1 902 04C7 903 04CA 904 04D2 906 04DE 907
|
||
04E1 908 04E4 909 04F3 910 04FB 911 0502 912
|
||
0507 913 050A 915 051 1648 639 164B 640 164E 641
|
||
1651 642 166F 643 1675 646 167B 647 1680 648
|
||
1696 649 16A0 650 16A6 651 16D3 652 16DA 653
|
||
16E1 655 0341 836 034B 837
|
||
035C 838 035F 839 0362 840 036B 842 036E 843
|
||
0374 844 037A 845 0380 846 0383 847 0386 848
|
||
038E 850 03AB 850 581 1557 582 1569 583 156F 584
|
||
1572 585 1575 586 1576 587 1576 588 157B 589
|
||
1581 590 1587 591 158A 592 1591 593 1594 594
|
||
1932 777 1935 778 1938 779
|
||
1938 780 193B 781 01C0 782 01DA 783 01E9 784
|
||
01F9 786 01FF 787 0202 788 0202 789 0211 790
|
||
021E 791 716 17FE 717 1803 718 1806 719
|
||
1809 720 180F 721 1830 722 1836 723 1839 724
|
||
183A 725 183A 727 1848 728 184F 729 1852 730
|
||
1856 917 051B 918 0524 919
|
||
0524 920 052C 921 0532 923 053A 925 0542 926
|
||
054C 927 0554 928 0562 929 0562 930 0565 931
|
||
0565 932 054 16E4 655 16E7 656 16EE 658 16F5 659
|
||
16F8 660 16F8 661 16FC 662 16FC 663 16FC 664
|
||
1701 665 1704 666 170A 667 170B 668 170B 6651 03AE 852 03B4 853 03BB 854
|
||
03C3 855 03E7 857 03ED 858 03F2 859 03F9 861
|
||
03FC 862 03FF 863 0402 865 0405 866 0408 867
|
||
0410 59B 595 159E 596 15A1 597 15AD 599 15B2 600
|
||
15B5 601 15B5 602 15B6 603 15B6 604 15B9 605
|
||
15BC 606 15BD 607 15BD 608 15C0 609 1022A 792 0236 793 023F 794 0246 795
|
||
0253 796 025D 797 0262 798 027A 799 027D 800
|
||
0288 801 0291 803 0298 804 029D 805 029D 806
|
||
7 731 1861 732 1862 733 1862 734 1867 735
|
||
186D 736 186E 737 186E 738 1871 739 1878 740
|
||
1884 741 188A 742 188D 743 1890 744 18965 933 056D 934 0570 935 0578 936
|
||
0585 937 058A 938 058D 939 0590 940 0598 941
|
||
059B 942 05A6 943 05A9 944 05AC 945 05B5 946
|
||
09
|
||
1719 670 171C 671 171D 672 171D 673 1737 674
|
||
1738 675 1738 676 1745 677 1746 678 1746 681
|
||
1749 682 174E 683 1756 685 175C 6869 0413 870 0416 871 0419 872 0423 873
|
||
0426 874 0429 875 0429 876 042C 877 0434 879
|
||
0441 880 0446 881 045F 883 046D 885 0470 5CB 610
|
||
15D2 611 15D5 612 15D8 613 15D9 614 15D9 615
|
||
15E6 616 15E9 617 15F4 618 15F7 619 15FF 620
|
||
1602 621 1603 622 1603 623
|
||
02A8 807 02B1 808 02B8 809 02BB 810 02BE 811
|
||
02C3 812 02C9 813 02CF 814 02D4 815 02D7 816
|
||
02DF 817 02E2 818 02EA 819 02ED 8201 745
|
||
1891 746 1896 747 1899 748 189E 749 18A1 750
|
||
18A2 751 18A2 753 18A7 754 18B1 755 18BB 756
|
||
18C5 757 18C6 758 18C6 759 185B8 947 05C0 950 05C5 951 05C8 952 05CF 953
|
||
05D8 954 05DB 955 05DE 956 05E1 957 05E6 958
|
||
05F5 960 0605 961 060B 962 060E 963 086 1762 687
|
||
1765 688 176B 689 178C 690 178F 691 17A1 692
|
||
17A9 694 17AC 695 17B3 696 17BA 697 17BD 698
|
||
17BD 699 17CC 700 17D9 886
|
||
0475 887 047A 888 0480 889 0485 890 0488 891
|
||
048D 892 049A 893 04A0 894 04A6 895 04B0 896
|
||
04B3 897 04B6 898 04BC 899 04BC1624 624 1624 625
|
||
1652 626 1652 627 165F 628 166B 629 166E 630
|
||
1624 631 162B 632 1633 634 1638 635 163B 636
|
||
1640 637 1640 638 02F5 821
|
||
02FD 822 0303 823 030A 824 0310 825 0317 826
|
||
031A 827 0322 828 0327 829 0327 830 032C 831
|
||
032F 832 0335 833 033E 83617 964
|
||
061A 965 061D 966 0627 967 062D 968 0632 969
|
||
063A 971 063F 972 0642 973 0642 974 064D 975
|
||
0650 976 0653 977 0658 978 4 1157 096A 1158 096F 1159 0979 1160 097C 1161
|
||
0984 1163 0987 1164 098E 1165 099C 1166 09A3 1167
|
||
09A6 1168 09A9 1169 09AC 1170822 1101 0825 1102 0825 1103 0828 1104 083B 1106
|
||
0843 1108 0848 1109 084E 1110 0854 1111 0857 1112
|
||
085E 1113 0861 1114 0868 11/
|
||
DFCBA LITERALLY '005CH', /* DEFAULT FILE CONTROL BLOCK */
|
||
DBUFF LITERALLY '0080H'; /* DEFAULT BUFFER ADDRESS */
|
||
06FC 1041 0703 1042 0708 1043 0710 1045 0717 1046
|
||
071D 1047 0723 1048 0726 1049 0729 1050 0731 1052
|
||
0734 1053 0737 1054 073A ACD 1229 0AD4 1230
|
||
0AD7 1231 0ADA 1232 0ADD 1233 0AE5 1234 0AE8 1235
|
||
0AEB 1236 0AEE 1237 0AEE 1238 0AF1 1239
|
||
0000 MODULE#
|
||
|
||
065F 979 0669 980
|
||
0676 981 067D 982 0680 983 0683 984 0686 985
|
||
068F 987 0695 988 0698 989 193B 992 193B 993
|
||
194A 994 194A 995 09AF 1171 09B4 1172
|
||
09BA 1173 09BD 1174 09C0 1175 09C5 1176 09D1 1177
|
||
09D4 1178 09D7 1179 09DA 1180 09DD 1181 09E5 1183
|
||
09E815 086B 1116 086E 1117
|
||
0873 1118 0876 1119 0879 1120 0881 1122 0884 1123
|
||
088B 1124 088E 1125 0891 1126 0894 1127 089C 1130
|
||
08
|
||
|
||
/* JMP LOADCOM TO START LOAD */
|
||
DECLARE JUMP BYTE DATA(0C3H);
|
||
DECLARE JUMPA ADDRESS DATA(.LOADCOM);
|
||
|
||
DECLARE COPYRIGHT(*)1055 0742 1057 0745 1058
|
||
0748 1059 074B 1060 0753 1062 0756 1063 0759 1064
|
||
075C 1065 0764 1066 076A 1067 0772 1069 0779 1071
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 194A 996 1950 997 1957 998
|
||
196F 999 1972 1000 1975 1001 1976 1002 1976 1003
|
||
1982 1005 1987 1006 1995 1007 1998 1009 199D 1010 1184 09EB 1185 09F2 1186 09F5 1187 0A06 1188
|
||
0A10 1189 0A1D 1190 0A24 1191 0A27 1192 0A2A 1193
|
||
0A2D 1194 0A30 1195 0A38 1196 9F 1131 08A2 1132 08A8 1133 08AB 1134 08B2 1135
|
||
08B5 1136 08BC 1137 08CA 1138 08D7 1139 08DA 1140
|
||
08DD 1141 08E3 1142 08F3 114 BYTE DATA
|
||
(' COPYRIGHT (C) 1978, DIGITAL RESEARCH ');
|
||
|
||
MON1: PROCEDURE(F,A) EXTERNAL;
|
||
DECLARE F BYTE, A ADDRESS;
|
||
077E 1072 0781 1073 0784 1074 0787 1075 078E 1076
|
||
0791 1077 0794 1078 0797 1079 079A 1080 07A2 1081
|
||
07A8 1082 07B0 1083 07BE 1LOAD:
|
||
DO;
|
||
/* C P / M C O M M A N D F I L E L O A D E R
|
||
|
||
COPYRIGHT (C) 1976, 1977, 1978
|
||
DIGITAL RESEARCH
|
||
|
||
19A9 1011 19A9 1012 069B 1013 069E 1014 06A6 1016
|
||
06A9 1017 06AE 1018 06AE 1019 06B6 1021 06B9 1022
|
||
06BC 1023 06BF 1024 06C60A3E 1197 0A46 1199
|
||
0A49 1200 0A50 1202 0A53 1203 0A59 1204 0A5C 1207
|
||
0A64 1209 0A67 1210 0A6C 1211 0A72 1212 0A78 1213
|
||
0A80 3 08F6 1144 0906 1145
|
||
090B 1146 090E 1147 0914 1148 0917 1149 091A 1150
|
||
0932 1152 0937 1153 0943 1154 0946 1155 0961 1156
|
||
096 END MON1;
|
||
|
||
MON2: PROCEDURE(F,A) BYTE EXTERNAL;
|
||
DECLARE F BYTE, A ADDRESS;
|
||
END MON2;
|
||
|
||
DECLARE SP ADDRESS;
|
||
|
||
BOO084 07C6 1086 07CD 1088
|
||
07DB 1089 07E0 1090 07E8 1091 07EB 1092 07EE 1093
|
||
07F9 1094 07FC 1095 0804 1097 081C 1099 081F 1100
|
||
0 BOX 579 PACIFIC GROVE
|
||
CALIFORNIA 93950
|
||
|
||
*/
|
||
|
||
DECLARE
|
||
TPA LITERALLY '0100H', /* TRANSIENT PROGRAM AREA * 1026 06C9 1027 06D1 1029
|
||
06D6 1030 06D9 1031 06D9 1032 06DC 1033 06E4 1035
|
||
06E7 1036 06EA 1037 06ED 1038 06F5 1039 06FC 1040
|
||
1214 0A83 1215 0A83 1216 0A86 1217 0A98 1218
|
||
0AA3 1219 0AB0 1220 0AB0 1221 0AB3 1222 0ABB 1224
|
||
0AC2 1226 0ACA 1227 0ACD 1228 0T: PROCEDURE;
|
||
STACKPTR = SP;
|
||
RETURN;
|
||
END BOOT;
|
||
|
||
|
||
LOADCOM: PROCEDURE;
|
||
DECLARE FCB (33) BYTE AT (DFCBA),
|
||
DRESS A UNTIL THE
|
||
NEXT DOLLAR SIGN IS ENCOUNTERED WITH PRECEDING CRLF */
|
||
CALL CRLF;
|
||
CALL PRINTM(A);
|
||
END PRINTHEN CALL PRINTCHAR(N+'A'-10); ELSE
|
||
CALL PRINTCHAR(N+'0');
|
||
END PRINTNIB;
|
||
|
||
PRINTHEX: PROCEDURE(B);
|
||
DECLARE BMON2(22,FCB);
|
||
END MAKE;
|
||
|
||
RENAME: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
CALL MON1(23,FCB);
|
||
END RENAME;
|
||
|
||
LOADER PLACES THE MACHINE
|
||
CODE INTO A FILE WHICH APPEARS IN THE LOADCOM COMMAND */
|
||
|
||
DECLARE
|
||
TRUE LITERALLY '1',
|
||
RE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = MON2(17,FCB);
|
||
END SEARCH;
|
||
|
||
SEARCHN: PROCEDURE;
|
||
DCNT = MON2(18,0);
|
||
FCBA LITERALLY 'DFCBA';
|
||
DECLARE BUFFER (128) BYTE AT (DBUFF),
|
||
BUFFA LITERALLY 'DBUFF';
|
||
DECLARE SFCB(33)T;
|
||
|
||
DECLARE LA ADDRESS; /* CURRENT LOAD ADDRESS */
|
||
|
||
PERROR: PROCEDURE(A);
|
||
/* PRINT ERROR MESSAGE */
|
||
DECLARE A ADD BYTE;
|
||
CALL PRINTNIB(SHR(B,4)); CALL PRINTNIB(B AND 0FH);
|
||
END PRINTHEX;
|
||
|
||
PRINTADDR: PROCEDURE(A);
|
||
DECLARE A MOVE: PROCEDURE(S,D,N);
|
||
DECLARE (S,D) ADDRESS, N BYTE,
|
||
A BASED S BYTE, B BASED D BYTE;
|
||
DO WHILE FALSE LITERALLY '0',
|
||
FOREVER LITERALLY 'WHILE TRUE',
|
||
CR LITERALLY '13',
|
||
LF LITERALLY '10',
|
||
WHAT LITERALLY END SEARCHN;
|
||
|
||
DELETE: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
CALL MON1(19,FCB);
|
||
END DELETE;
|
||
|
||
DISKREAD: PROCED BYTE, /* SOURCE FILE CONTROL BLOCK */
|
||
BSIZE LITERALLY '1024',
|
||
EOFILE LITERALLY '1AH',
|
||
SBUFF(BSIZE) RESS;
|
||
CALL PRINT(.('ERROR: $'));
|
||
CALL PRINTM(A);
|
||
CALL PRINTM(.(', LOAD ADDRESS $'));
|
||
CALL PRINTADDR(LA);
|
||
ADDRESS;
|
||
CALL PRINTHEX(HIGH(A)); CALL PRINTHEX(LOW(A));
|
||
END PRINTADDR;
|
||
|
||
PRINTM: PROCEDURE(A);
|
||
DECLARE A ADDRES (N:=N-1) <> 255;
|
||
B = A; S=S+1; D=D+1;
|
||
END;
|
||
END MOVE;
|
||
|
||
GETCHAR: PROCEDURE BYTE;
|
||
'63';
|
||
|
||
PRINTCHAR: PROCEDURE(CHAR);
|
||
DECLARE CHAR BYTE;
|
||
CALL MON1(2,CHAR);
|
||
END PRINTCHAR;
|
||
|
||
CRLF: PROCEDURE;
|
||
URE(FCB) BYTE;
|
||
DECLARE FCB ADDRESS;
|
||
RETURN MON2(20,FCB);
|
||
END DISKREAD;
|
||
|
||
DISKWRITE: PROCEDURE(FCB) BYTE;
|
||
DEBYTE, /* SOURCE FILE BUFFER */
|
||
RFLAG BYTE, /* READER FLAG */
|
||
SBP ADDRESS; /* SOURCE FILE BUFFE CALL BOOT;
|
||
END PERROR;
|
||
|
||
DECLARE DCNT BYTE;
|
||
|
||
OPEN: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = MON2(15,FCB);S;
|
||
CALL MON1(9,A);
|
||
END PRINTM;
|
||
|
||
PRINT: PROCEDURE(A);
|
||
DECLARE A ADDRESS;
|
||
/* PRINT THE STRING STARTING AT AD /* GET NEXT CHARACTER */
|
||
DECLARE I BYTE;
|
||
IF (SBP := SBP+1) <= LAST(SBUFF) THEN
|
||
RETURN SBUFF(SBP CALL PRINTCHAR(CR);
|
||
CALL PRINTCHAR(LF);
|
||
END CRLF;
|
||
|
||
PRINTNIB: PROCEDURE(N);
|
||
DECLARE N BYTE;
|
||
IF N > 9 CLARE FCB ADDRESS;
|
||
RETURN MON2(21,FCB);
|
||
END DISKWRITE;
|
||
|
||
MAKE: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = R POINTER */
|
||
|
||
/* LOADCOM LOADS TRANSIENT COMMAND FILES TO THE DISK FROM THE
|
||
CURRENTLY DEFINED READER PERIPHERAL. THE
|
||
END OPEN;
|
||
|
||
CLOSE: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = MON2(16,FCB);
|
||
END CLOSE;
|
||
|
||
SEARCH: PROCEDU);
|
||
/* OTHERWISE READ ANOTHER BUFFER FULL */
|
||
DO SBP = 0 TO LAST(SBUFF) BY 128;
|
||
IF (I:=DISKREADR(' ');
|
||
END NEWLINE;
|
||
|
||
/* PRINT DIAGNOSTIC INFORMATION AT THE CONSOLE */
|
||
CALL PRINT(.('LOAD ADDRESS $'))INTO BUFFER */
|
||
BUFFER(I) = MBUFF(LOW(L)); L = L + 1;
|
||
END;
|
||
/* WRITE BUFFER ONTO DIDCS;
|
||
|
||
MAKE$DOUBLE: PROCEDURE(H,L) ADDRESS;
|
||
/* CREATE A BOUBLE BYTE VALUE FROM TWO SINGLE BYTES */
|
||
DECLARS */
|
||
SA ADDRESS, /* START ADDRESS */
|
||
FA ADDRESS, /* FINAL ADDRESS */
|
||
NB ADDRESS, /* NUMBEHEN RETURN H - '0';
|
||
IF H - 'A' > 5 THEN
|
||
DO; CALL PRINT(.('INVALID HEX DIGIT$'));
|
||
CALL DIAGNOS(.SFCB)) = 0 THEN
|
||
CALL MOVE(80H,.SBUFF(SBP),80H); ELSE
|
||
DO;
|
||
IF I<>1 THEN CALL ; CALL PRINTADDR(TA);
|
||
CALL PRINT(.('ERROR ADDRESS $')); CALL PRINTADDR(LA);
|
||
|
||
CALL PRINT(.('BYTES READ:$')); CSK */
|
||
P = P + 1;
|
||
IF DISKWRITE(FCBA) <> 0 THEN
|
||
DO; CALL PERROR(.('DISK WRITE$'));
|
||
E (H,L) BYTE;
|
||
RETURN SHL(DOUBLE(H),8) OR L;
|
||
END MAKE$DOUBLE;
|
||
|
||
|
||
/* INITIALIZE */
|
||
SA, FA, NB = 0;
|
||
R OF BYTES LOADED */
|
||
|
||
MBUFF(256) BYTE,
|
||
P BYTE,
|
||
L ADDRESS;
|
||
|
||
SETMEM: PROCEDURE(B);
|
||
/* SET MBUFF TO E;
|
||
END;
|
||
RETURN H - 'A' + 10;
|
||
END READHEX;
|
||
|
||
READBYTE: PROCEDURE BYTE;
|
||
/* READ TWO HPERROR(.('DISK READ$'));
|
||
SBUFF(SBP) = EOFILE;
|
||
SBP = LAST(SBUFF);
|
||
END;
|
||
ALL NEWLINE;
|
||
DO WHILE TA < LA;
|
||
IF (LOW(TA) AND 0FH) = 0 THEN CALL NEWLINE;
|
||
CALL PRINTHEX(MBUFF(TA-L) END;
|
||
END;
|
||
MBUFF(LOW(LA)) = B;
|
||
END SETMEM;
|
||
|
||
DIAGNOSE: PROCEDURE;
|
||
|
||
DECLARE P = 0; /* PARAGRAPH COUNT */
|
||
TA,L = TPA; /* BASE ADDRESS OF TRANSIENT ROUTINES */
|
||
SBUFF(0) = EOFILE;
|
||
|
||
|
||
/* RB AT LOCATION LA MOD LENGTH(MBUFF) */
|
||
DECLARE (B,I) BYTE;
|
||
IF LA < L THEN
|
||
CALL PERROR(.('INVERTED EX DIGITS */
|
||
RETURN SHL(READHEX,4) OR READHEX;
|
||
END READBYTE;
|
||
|
||
READCS: PROCEDURE BYTE;
|
||
/* READ B END;
|
||
SBP = 0; RETURN SBUFF(0);
|
||
END GETCHAR;
|
||
DECLARE
|
||
STACKPOINTER LITERALLY 'STACKPTR';
|
||
|
||
/* INTE); TA=TA+1;
|
||
CALL PRINTCHAR(' ');
|
||
END;
|
||
CALL CRLF;
|
||
CALL BOOT;
|
||
END DIAGNOSE;
|
||
|
||
READHEX: PROCE M BASED TA BYTE;
|
||
|
||
NEWLINE: PROCEDURE;
|
||
CALL CRLF; CALL PRINTADDR(TA); CALL PRINTCHAR(':');
|
||
CALL PRINTCHAEAD RECORDS UNTIL :00XXXX IS ENCOUNTERED */
|
||
|
||
DO FOREVER;
|
||
/* SCAN THE : */
|
||
DO WHILE GETCHAR <> ':LOAD ADDRESS$'));
|
||
DO WHILE LA > L + LAST(MBUFF); /* WRITE A PARAGRAPH */
|
||
DO I = 0 TO 127; /* COPY YTE WHILE COMPUTING CHECKSUM */
|
||
DECLARE B BYTE;
|
||
CS = CS + (B := READBYTE);
|
||
RETURN B;
|
||
END REAL HEX FORMAT LOADER */
|
||
|
||
RELOC: PROCEDURE;
|
||
DECLARE (RL, CS, RT) BYTE;
|
||
DECLARE
|
||
TA ADDRESS, /* TEMP ADDRESDURE BYTE;
|
||
/* READ ONE HEX CHARACTER FROM THE INPUT */
|
||
DECLARE H BYTE;
|
||
IF (H := GETCHAR) - '0' <= 9 T';
|
||
END;
|
||
|
||
/* SET CHECK SUM TO ZERO, AND SAVE THE RECORD LENGTH */
|
||
CS = 0;
|
||
/* MAY BE THE FCBA+9,3);
|
||
|
||
/* REMOVE ANY EXISTING FILE BY THIS NAME */
|
||
CALL DELETE(FCBA);
|
||
/* THEN OPEN A NEW FILE */
|
||
CALL MAKE(FCBA); ; CALL PRINTHEX(P);
|
||
CALL CRLF;
|
||
|
||
END RELOC;
|
||
|
||
/* ARRIVE HERE FROM THE SYSTEM MONITOR, READY TO READ THE HEX TAPE */
|
||
0000 LOAD#
|
||
0000 LOAD#
|
||
023B 13 023B 14 023F 15 0240 16 0240 17
|
||
02D0 22 02D4 24 02DF 25 02E0 26 02E0 27
|
||
02E5 28 02EA EADBYTE <> 0 THEN
|
||
DO; CALL PRINT(.('CHECK SUM ERROR $'));
|
||
CALL DIAGNOSE;
|
||
END;
|
||
ENEX DIGITS */
|
||
RETURN SHL(READHEX,4) OR READHEX;
|
||
END READBYTE;
|
||
|
||
READCS: PROCEDURE BYTE;
|
||
/* READ BEND OF TAPE */
|
||
IF (RL := READCS) = 0 THEN
|
||
GO TO FIN;
|
||
NB = NB + RL;
|
||
|
||
TA, LA = MAKE$DCALL OPEN(FCBA);
|
||
IF DCNT = 255 THEN CALL PERROR(.('NO MORE DIRECTORY SPACE$')); ELSE
|
||
DO; CALL RELOC;
|
||
CALL CL
|
||
|
||
/* SET UP STACKPOINTER IN THE LOCAL AREA */
|
||
DECLARE STACK(16) ADDRESS;
|
||
SP = STACKPOINTER; STACKPOINTER = .STACK(LENGTH(STA29 02EB 30 02EF 32 02F8 33
|
||
0306 34 030F 35 0310 36 0314 38 0321 39
|
||
032A 40 032B 41 0331 43 0339 44 0341 45
|
||
0342 46D;
|
||
|
||
FIN:
|
||
/* EMPTY THE BUFFERS */
|
||
TA = LA;
|
||
DO WHILE L < TA;
|
||
CALL SETMEM(0); LA = LA+1;
|
||
YTE WHILE COMPUTING CHECKSUM */
|
||
DECLARE B BYTE;
|
||
CS = CS + (B := READBYTE);
|
||
RETURN B;
|
||
END REAOUBLE(READCS,READCS);
|
||
IF SA = 0 THEN SA = LA;
|
||
|
||
|
||
/* READ THE RECORD TYPE (NOT CURRENTLY USED) */
|
||
RT OSE(FCBA);
|
||
IF DCNT = 255 THEN CALL PERROR(.('CANNOT CLOSE FILE$'));
|
||
END;
|
||
CALL CRLF;
|
||
|
||
CALL BOOT;
|
||
END LOADCCK));
|
||
LA = TPA;
|
||
|
||
SBP = LENGTH(SBUFF);
|
||
/* SET UP THE SOURCE FILE */
|
||
CALL MOVE(FCBA,.SFCB,33);
|
||
CALL MOVE(.('HEX', 0348 48 0351 49 0352 50 0358 52
|
||
035B 53 0363 54 0364 56 036A 58 0370 59
|
||
0378 60 037E 61 0386 62 0389 63 038A 65
|
||
END;
|
||
/* PRINT FINAL STATISTICS */
|
||
CALL PRINT(.('FIRST ADDRESS $')); CALL PRINTADDR(SA);
|
||
CALL PRINT(.('LAST ADDRDCS;
|
||
|
||
MAKE$DOUBLE: PROCEDURE(H,L) ADDRESS;
|
||
/* CREATE A BOUBLE BYTE VALUE FROM TWO SINGLE BYTES */
|
||
DECLAR= READCS;
|
||
|
||
/* PROCESS EACH BYTE */
|
||
DO WHILE (RL := RL - 1) <> 255;
|
||
CALL SETMEM(READCS); LA =OM;
|
||
END;
|
||
0),.SFCB(9),4);
|
||
CALL OPEN(.SFCB);
|
||
IF DCNT = 255 THEN CALL PERROR(.('CANNOT OPEN SOURCE$'));
|
||
|
||
CALL MOVE(.('COM'),0390 67 039C 68 039D 69 03A3 71 03AF 72
|
||
03B0 73 03B6 75 03C2 76 03C3 77 03C3 78
|
||
03CE 79 03CF 80 03D5 82 03DE 83 03ESS $')); CALL PRINTADDR(FA);
|
||
CALL PRINT(.('BYTES READ $')); CALL PRINTADDR(NB);
|
||
CALL PRINT(.('RECORDS WRITTEN $'))E (H,L) BYTE;
|
||
RETURN SHL(DOUBLE(H),8) OR L;
|
||
END MAKE$DOUBLE;
|
||
|
||
|
||
/* INITIALIZE */
|
||
SA, FA, NB = 0;
|
||
LA+1;
|
||
END;
|
||
IF LA > FA THEN FA = LA - 1;
|
||
|
||
/* NOW READ CHECKSUM AND COMPARE */
|
||
IF CS + RE;
|
||
END;
|
||
RETURN H - 'A' + 10;
|
||
END READHEX;
|
||
|
||
READBYTE: PROCEDURE BYTE;
|
||
/* READ TWO HDF 84
|
||
03E5 86 03EF 87 03EF 88 03F5 90 03FF 91
|
||
03FF 92 0405 94 0411 95 0412 96 0418 98
|
||
0421 99 0422 100 0431 102 043D 900H TO THE DESTINATION ADDRESS
|
||
;
|
||
; COPYRIGHT (C) 1979
|
||
; DIGITAL RESEARCH
|
||
; BOX 579, PACIFIC GROVE CALIFORNIA
|
||
; 93950
|
||
;
|
||
7
|
||
05D6 228 05DE 229 05E4 230 05EC 231 05F2 232
|
||
05F9 233 05FC 234 0240 236 0247 237 024B 238
|
||
0251 239 0257 240 0263 241 026F 2,L
|
||
MOV C,A
|
||
MVI B,0
|
||
DAD B ;*10+X
|
||
JMP CLOOP
|
||
ECON: ;END OF CONVERSION, CHECK FOR PROPER RANGE
|
||
MOV A,H
|
||
ORA A
|
||
JNZ CERR6DF 167
|
||
06E2 168 06E5 169 06FC 170 06FC 172 070B 173
|
||
0711 174 071D 176 0723 177 0726 178 0726 179
|
||
072E 180 072E 181 072E 182 ULT FCB
|
||
MODULE EQU 900H ;MODULE ADDRESS
|
||
;
|
||
CR EQU 0DH
|
||
LF EQU 0AH
|
||
LXI SP,STACK
|
||
;
|
||
; MAY BE MEMORY SIZE SPECIFIED IN COMMAND 103 0447 104
|
||
044E 105 0455 106 0458 107 0459 108 0459 110
|
||
0469 111 0472 112 0497 113 04A5 114 04BA 116
|
||
04C2 117 04C8 118 04D ORG 100H
|
||
JMP PASTCOPY
|
||
COPY: DB 'COPYRIGHT (C) DIGITAL RESEARCH, 1979 '
|
||
PASTCOPY:
|
||
BIOSWK EQU 03H ;THREE PAGES FOR BIOS 42 0275 243
|
||
027D 244 0283 245 028F 246 0295 247 029B 248
|
||
02A1 249 02A9 250 02B2 252 02B5 253 02BB 254
|
||
02C3 255 02C9 256 02C9 OR
|
||
MOV A,L
|
||
CPI 16
|
||
JC CERROR
|
||
MVI L,0
|
||
MOV H,A
|
||
DAD H ;SHL 1
|
||
DAD H ;SHL 2 FOR KILOBYTES
|
||
; H,L HAVE TOP OF MEMORY+1
|
||
073D 183 073D 184
|
||
073D 186 0748 187 074C 188 074C 189 0752 191
|
||
0763 192 04E4 193 04F0 194 04F4 195 04FD 196
|
||
0502 197 0502 198
|
||
LXI D,FCB+1
|
||
LDAX D
|
||
CPI ' '
|
||
JZ FINDTOP
|
||
CPI '?' ;WAS * SPECIFIED?
|
||
JZ FINDTOP
|
||
;
|
||
; MUST BE MEMORY SIZE SPECIFICATION
|
||
1 119 04D7 120 04D7 121
|
||
04DA 122 04E0 123 04E4 124 04E4 126 05FD 129
|
||
0601 131 060D 132 0613 133 0624 134 0632 135
|
||
064A 136 06WORKSPACE
|
||
STACK EQU 800H
|
||
MODSIZ EQU 801H ;MODULE SIZE IS STORED HERE
|
||
VERSION EQU 22 ;CPM VERSION NUMBER
|
||
BOOTSIZ EQU 100H ;SI257 02CC 258 02CF 259
|
||
0000 MODULE#
|
||
|
||
JMP SETASC
|
||
;
|
||
CERROR:
|
||
LXI D,CONMSG
|
||
CALL PRINT
|
||
JMP BOOT
|
||
CONMSG: DB CR,LF,'INVALID MEMORY SIZE$'
|
||
;
|
||
;
|
||
; FIND END OF MEMO 050A 199 050D 200 0512 201
|
||
051D 202 0520 203 052E 204 0541 205 054D 206
|
||
0553 207 0559 208 0565 209 056C 210 0573 211
|
||
0576 21
|
||
LXI H,0
|
||
CLOOP: ;CONVERT TO DECIMAL
|
||
LDAX D
|
||
INX D
|
||
CPI ' '
|
||
JZ ECON
|
||
ORA A
|
||
JZ ECON
|
||
; MUST BE DECIMAL DIGIT
|
||
SUI '0'
|
||
51 137 0658 138 065C 139 0667 141
|
||
066D 142 066D 143 0670 144 067F 145 0680 146
|
||
06E6 148 06E6 149 06E9 150 06F1 151 06F6 152
|
||
0ZE OF THE COLD START LOADER
|
||
; (MAY HAVE FIRST 80H BYTES = 00H)
|
||
BDOSL EQU 0800H ;RELATIVE LOCATION OF BDOS
|
||
BIOS EQU 1600H ;REL TITLE 'CP/M VERSION 2.2 SYSTEM RELOCATOR - 2/80'
|
||
; CPM RELOCATOR PROGRAM, INCLUDED WITH THE MODULE TO PERFORM
|
||
; THE MOVE FROMRY
|
||
FINDTOP:
|
||
LXI H,0
|
||
FINDM: INR H ;TO NEXT PAGE
|
||
JZ MSIZED ;CAN OVERFLOW ON 64K SYSTEMS
|
||
MOV A,M
|
||
CMA
|
||
MOV M,A
|
||
CMP M
|
||
2 0582 213 0589 214 0595 216 059B 217
|
||
059E 218 059E 219 05A1 220 05A7 221 05B3 222
|
||
05B8 223 05BF 224 05C2 225 05C8 226 05D0 22
|
||
CPI 10
|
||
JNC CERROR
|
||
; DECIMAL DIGIT IS IN A
|
||
DAD H ;*2
|
||
PUSH H
|
||
DAD H ;*4
|
||
DAD H ;*8
|
||
POP B ;*2 IN B,C
|
||
DAD B ;*10 IN H6FB 153 0680 154 0686 155 068E 156 0694 157
|
||
069C 158 06A2 159 06A5 160 06B1 161 06BC 162
|
||
06BF 163 06D0 164 06D7 165 06DC 166 0ATIVE LOCATION OF BIOS
|
||
;
|
||
BOOT EQU 0000H ;REBOOT LOCATION
|
||
BDOS EQU 0005H
|
||
PRNT EQU 9 ;PRINT BUFFER FUNCTION
|
||
FCB EQU 5CH ;DEFACMA
|
||
MOV M,A ;BITS INVERTED FOR RAM OPERATIONAL TEST
|
||
JZ FINDM
|
||
; BITS DIDN'T CHANGE, MUST BE END OF MEMORY
|
||
; ALIGN ON EVEN BI H,PRJMP
|
||
MVI M,CALL ;CHANGE JMP BDOS TO CALL
|
||
LXI D,SYNCMSG-5
|
||
LXI H,5
|
||
DAD D ;TO CONFUSE SEARCHES ON ADDRESSES
|
||
XCHG
|
||
JUSH B
|
||
MVI C,LAMSG ;LENGTH OF SEARCH MESSAGE
|
||
PUSH H ;SAVE BASE ADDRESS OF SEARCH
|
||
CHLOOP: ;CHARACTER LOOP, MATCH ON CONTENTS MODULE;READY FOR THE MOVE
|
||
POP B ;RECOVER ACTUAL MODULE LENGTH
|
||
PUSH B ;SAVE FOR RELOCATION
|
||
LDA FCB+17 ;CHECK FOR NO MOVE COUIVALENT
|
||
INR M
|
||
MOV A,M
|
||
CPI '9'+1
|
||
JC ASC1
|
||
MVI M,'0'
|
||
DCX H
|
||
INR M
|
||
ASC1: DCR B ;COUNT DOWN BY KILOBYTES
|
||
JNZ ASC0
|
||
MVI A,0
|
||
JNZ SETJMP ;BAD SERIALIZATION IF NOT 06
|
||
STAX B ;STORE 00 TO LEAST SIGNIFICANT BYTE
|
||
; **** SERIALIZATION ****
|
||
POPOUNDARY
|
||
MSIZED: MOV A,H
|
||
ANI 1111$1100B ;EVEN 1K BOUNDARY
|
||
MOV H,A
|
||
SETASC: ;SET ASCII VALUE OF MEMORY SIZE
|
||
PUSH H ;SAVE FOMP PRINT
|
||
; **** SERIALIZATION ****
|
||
;
|
||
NOMATCH:
|
||
;NOT FOUND AT THIS ADDRESS, LOOK AT NEXT ADDRESS
|
||
POP H
|
||
INX H
|
||
POP B ;RECOF D,E AND H,L
|
||
LDAX D
|
||
CMP M
|
||
JNZ NOMATCH
|
||
INX D ;TO NEXT SEARCH CHARACTER
|
||
INX H ;TO NEXT MATCH CHARACTER
|
||
DCR C ;COUNT NDITION
|
||
CPI ' '
|
||
JZ MOVE
|
||
; SECOND PARAMETER SPECIFIED, LEAVE THE DATA AT 'MODULE'
|
||
DAD B ;MOVE H,L TO BIT MAP POSITION
|
||
JMLXI D,MEMSG
|
||
CALL PRINT ;MEMORY SIZE MESSAGE
|
||
;
|
||
LXI H,MODSIZ
|
||
MOV C,M
|
||
INX H
|
||
MOV B,M ;B,C CONTAINS MODULE SIZE
|
||
PUSH B ; B ;RECOVER MODULE LENGTH
|
||
POP H ;H,L CONTAINS END OF MEMORY
|
||
PUSH B ;SAVE LENGTH FOR RELOCATION BELOW
|
||
MOV A,B
|
||
ADI BIOSWK R LATER
|
||
; **** SERIALIZATION ****
|
||
LHLD BDOS+1
|
||
SHLD SER1
|
||
; **** SERIALIZATION ****
|
||
POP H
|
||
PUSH H
|
||
MOV A,H
|
||
RRC
|
||
RRC
|
||
ALL MODULE LENGTH
|
||
JMP SLOOP
|
||
;
|
||
FSEAR:
|
||
;FOUND STRING, SET MEMORY SIZE
|
||
POP H ;START ADDRESS OF STRING BEING MATCHED
|
||
POP BLENGTH DOWN
|
||
JZ FSEAR ;FOUND SEARCH STRING
|
||
JMP CHLOOP
|
||
;
|
||
; **** SERIALIZATION ****
|
||
DB LXI ;CONFUSE DISASSEMBLER
|
||
BADSER: ;P RELOC
|
||
;
|
||
; **** SERIALIZATION ****
|
||
SETJMP: LXI H,BADSER ;BAD SERIALIZATION
|
||
SHLD JMPSER+1 ;FILL JUMP INSTRUCTION
|
||
JMP JMPSMODULE SIZE STACKED ON MEM SIZE
|
||
;
|
||
; TRY TO FIND THE ASCII STRING 'K CP/M VER X.X' TO SET SIZE
|
||
LXI H,MODULE
|
||
; B,C CONTAINS M;ADD BIOS WORK SPACE TO MODULE LENGTH
|
||
MOV B,A
|
||
MOV A,L
|
||
SUB C ;COMPUTE MEMTOP-MODULE SIZE
|
||
MOV L,A
|
||
MOV A,H
|
||
SBB B
|
||
MOV ANI 11$1111B ;FOR 1K COUNTS
|
||
JNZ NOT64 ;MAY BE 64 K MEM SIZE
|
||
MVI A,64 ;SET TO LITERAL IF SO
|
||
NOT64: MOV B,A ;READY FOR CO ;CLEAR B,C WHICH WAS STACKED
|
||
DCX H
|
||
LXI D,AMEM+1
|
||
LDAX D
|
||
MOV M,A
|
||
DCX H
|
||
DCX D
|
||
LDAX D
|
||
MOV M,A
|
||
; END OF FILL
|
||
;
|
||
ESBAD SERIAL NUMBER, LOOP TO CONFUSE ICE-80
|
||
XRA A
|
||
BADSER0:
|
||
DCR A
|
||
JNZ BADSER0
|
||
;
|
||
LXI H,DI OR (HLT SHL 8)
|
||
SHLD PRHLT
|
||
LXER ;EVENTUAL JUMP TO MESSAGE
|
||
; **** SERIALIZATION ****
|
||
;
|
||
MOVE:
|
||
MOV A,B ;BC=0?
|
||
ORA C
|
||
JZ RELOC
|
||
DCX B ;COUNT MODULE SIZODULE LENGTH
|
||
SLOOP: ;SEARCH LOOP
|
||
LXI D,AMSG
|
||
MOV A,B
|
||
ORA C
|
||
JZ ESEAR ;END OF SEARCH
|
||
DCX B ;COUNT SEARCH LENGTH DOWN
|
||
PH,A
|
||
; H,L CONTAINS THE BASE OF THE RELOCATION AREA
|
||
SHLD RELBAS ;SAVE THE RELOCATION BASE
|
||
XCHG ;MODULE BASE TO D,E
|
||
LXI H,UNT DOWN
|
||
LXI H,AMEM
|
||
MVI A,'0'
|
||
MOV M,A
|
||
INX H
|
||
MOV M,A ;BOTH ARE SET TO ASCII 0
|
||
ASC0: LXI H,AMEM+1 ;ADDRESS OF ASCII EQEAR: ;END OF SEARCH
|
||
; **** SERIALIZATION ****
|
||
; CHECK FOR LEAST SIGNIFICANT BYTE OF 06 IN SER1
|
||
LXI B,SER1
|
||
LDAX B
|
||
CPI 6
|
||
E DOWN TO ZERO
|
||
MOV A,M ;GET NEXT ABSOLUTE LOCATION
|
||
STAX D ;PLACE IT INTO THE RELOC AREA
|
||
INX D
|
||
INX H
|
||
JMP MOVE
|
||
;
|
||
RELOCATION ****
|
||
;
|
||
LDA FCB+17
|
||
CPI ' '
|
||
JZ TRANSFER
|
||
; DON'T GO TO THE LOADED PROGRAM, LEAVE IN MEMORY
|
||
; MAY HAVE TO MOVE THE PRIP RELOCATION IF CY=0
|
||
;
|
||
; CURRENT ADDRESS REQUIRES RELOCATION
|
||
LDAX D
|
||
ADD H ;APPLY BIAS IN H
|
||
STAX D
|
||
JMP REL2
|
||
;
|
||
REL2:
|
||
; FILL CPMXX.COM FROM SAVMEM
|
||
TRC1: LHLD AMEM
|
||
SHLD SAVM0
|
||
; MESSAGE SET, PRINT IT AND REBOOT
|
||
LXI D,RELOK
|
||
CALL PRINT
|
||
JM,LF,'SYNCRONIZATION ERROR$'
|
||
PASTSYNC:
|
||
; **** SERIALIZATION ****
|
||
;
|
||
; NOT END OF THE RELOCATION, MAY BE INTO NEXT BYTE OF BIT
|
||
DB LXI
|
||
JMPSER: JMP JMPSER ;ADDRESS FIELD FILLED-IN
|
||
; **** SERIALIZATION ****
|
||
;
|
||
TREND: ;SET ASCII MEMORY IMAGE SIZE
|
||
LXI H: ;STORAGE MOVED, READY FOR RELOCATION
|
||
; HL ADDRESSES BEGINNING OF THE BIT MAP FOR RELOCATION
|
||
POP B ;RECALL MODULE LENGTH
|
||
POGRAM IMAGE DOWN 1/2 PAGE
|
||
MVI B,128 ;CHECK FOR 128 ZEROES
|
||
LXI H,MODULE
|
||
TR0: MOV A,M
|
||
ORA A
|
||
JNZ TREND
|
||
INX H
|
||
DCR B
|
||
JINX D ;TO NEXT ADDRESS
|
||
JMP REL0 ;FOR ANOTHER BYTE TO RELOCATE
|
||
;
|
||
ENDREL: ;END OF RELOCATION
|
||
POP D ;CLEAR STACKED ADDRESS
|
||
;P BOOT
|
||
RELOK: DB CR,LF,'READY FOR "SYSGEN" OR'
|
||
DB CR,LF,'"SAVE '
|
||
SAVMEM: DB '00 CPM'
|
||
SAVM0: DB '00.COM"$'
|
||
;
|
||
TRANSFER:
|
||
; MAP
|
||
DCX B ;COUNT LENGTH DOWN
|
||
MOV A,E
|
||
ANI 111B ;0 CAUSES FETCH OF NEXT BYTE
|
||
JNZ REL1
|
||
; FETCH BIT MAP FROM STACKED ADDRES,MODSIZ
|
||
MOV C,M
|
||
INX H
|
||
MOV B,M
|
||
LXI H,MODULE;B,C MODULE SIZE, H,L BASE
|
||
DAD B
|
||
MOV B,H ;B CONTAINS NUMBER OF PAGES TO SAUSH H ;SAVE BIT MAP BASE IN STACK
|
||
LHLD RELBAS
|
||
XCHG
|
||
LXI H,BOOTSIZ
|
||
DAD D ;TO FIND BIAS VALUE
|
||
; REGISTER H CONTAINS BIAS VNZ TR0
|
||
;
|
||
; ALL ZERO FIRST 1/2 PAGE, MOVE DOWN 80H BYTES
|
||
XCHG ;NEXT TO GET IN D,E
|
||
LHLD MODSIZ
|
||
LXI B,-128
|
||
DAD B ;NUMBER **** SERIALIZATION ****
|
||
LXI D,MODULE+BDOSL+BOOTSIZ ;ADDRESSING NEW SERIAL NUMBER
|
||
LHLD SER1 ;ADDRESSING HOST SERIAL NUMBERGO TO THE RELOCATED MEMORY IMAGE
|
||
LXI D,BOOTSIZ+BIOS ;MODULE
|
||
LHLD RELBAS ;RECALL BASE OF RELOC AREA
|
||
DAD D ;INDEX TO 'BOOT'S
|
||
XTHL
|
||
MOV A,M ;NEXT 8 BITS OF MAP
|
||
INX H
|
||
XTHL ;BASE ADDRESS GOES BACK TO STACK
|
||
MOV L,A ;L HOLDS THE MAP AS WE PROCESSVE+1
|
||
LXI H,SAVMEM;ASCII MEMORY SIZE
|
||
MVI A,'0'
|
||
MOV M,A
|
||
INX H
|
||
MOV M,A
|
||
; '00' STORED INTO MESSAGE
|
||
TRCOMP:
|
||
DCR B
|
||
JZ ALUE
|
||
;
|
||
; RELOCATE AT 'MODULE' IF SECOND PARAMETER GIVEN
|
||
LDA FCB+17
|
||
CPI ' '
|
||
JZ REL0
|
||
;
|
||
; IMAGE NOT MOVED, ADJUST VALUES OF BYTES TO MOVE IN H,L
|
||
MOV B,H
|
||
MOV C,L ;TRANSFERRED TO B,C
|
||
LXI H,MODULE;DESTINATION IN H,L
|
||
TRMOV: MOV A,B
|
||
ORA C ;ALL
|
||
MVI C,6 ;LENGTH OF SERIAL NUMBER
|
||
CHKSER: LDAX D
|
||
CMP M
|
||
JNZ SETJMP
|
||
INX H
|
||
INX D
|
||
DCR C
|
||
JNZ CHKSER
|
||
; **** SERIALIZ ENTRY POINT
|
||
PCHL ;GO TO RELOCATED PROGRAM
|
||
;
|
||
; **** SERIALIZATION ****
|
||
PRINT:
|
||
MVI C,PRNT
|
||
PRJMP: JMP BDOS
|
||
PRHLT:
|
||
;
|
||
; 8 LOCATIONS
|
||
REL1: MOV A,L
|
||
RAL ;CY SET TO 1 IF RELOCATION NECESSARY
|
||
MOV L,A ;BACK TO L FOR NEXT TIME AROUND
|
||
JNC REL2 ;SKTRC1
|
||
LXI H,SAVMEM+1 ;ADDRESSING LEAST DIGIT
|
||
INR M
|
||
MOV A,M
|
||
CPI '9'+1
|
||
JC TRCOMP
|
||
MVI M,'0'
|
||
DCX H
|
||
INR M
|
||
JMP TRCOMPAT 'MODULE'
|
||
LXI D,MODULE
|
||
REL0: MOV A,B ;BC=0?
|
||
ORA C
|
||
JZ ENDREL
|
||
; **** SERIALIZATION ****
|
||
JMP PASTSYNC
|
||
SYNCMSG:
|
||
DB CRMOVED?
|
||
JZ TREND
|
||
DCX B
|
||
LDAX D
|
||
MOV M,A ;ONE BYTE TRANSFERRED
|
||
INX D
|
||
INX H
|
||
JMP TRMOV
|
||
;
|
||
;
|
||
; **** SERIALIZATION ****
|
||
DATA AREAS
|
||
SER1: DS 2 ;SERIAL NUMBER ADDRESS FOR HOST
|
||
RELBAS: DS 2 ;RELOCATION BASE
|
||
MEMSG: DB CR,LF,'CONSTRUCTING '
|
||
AMEM: DBR EQU 0DH ;CARRIAGE RETURN
|
||
LF EQU 0AH ;LINE FEED
|
||
STACKSIZE EQU 16 ;SIZE OF LOCAL STACK
|
||
;
|
||
WBOOT EQU 1 ;ADDRESS OF WARM BOOT (QU 1 ;SECTOR SKEW FACTOR
|
||
;
|
||
FCB EQU 005CH ;DEFAULT FCB LOCATION
|
||
FCBCR EQU FCB+32 ;CURRENT RECORD LOCATION
|
||
TPA EQU 0100H ;TRANDM
|
||
;
|
||
; NOW LEAVE SPACE FOR EXTENSIONS TO TRANSLATE TABLE
|
||
IF NSECTS LT 64
|
||
REPT 64-NSECTS
|
||
DB 0
|
||
ENDM
|
||
;
|
||
;
|
||
;
|
||
;
|
||
; UTILI裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹E FOR MISSED SECTORS
|
||
; WHEN SLOW CONTROLLERS ARE INVOLVED. TRANSLATION TAKES
|
||
; PLACE ACCORDING TO THE "SKEW" FACTOR SET ABOVE '00'
|
||
AMSG: DB 'k CP/M vers '
|
||
DB VERSION/10+'0','.',VERSION MOD 10 +'0'
|
||
LAMSG EQU $-AMSG ;LENGTH OF MESSAGE
|
||
DB '$' ;TERMIOTHER PATCH ENTRY
|
||
; POINTS ARE COMPUTED RELATIVE TO WBOOT)
|
||
SELDSK EQU 24 ;WBOOT+24 FOR DISK SELECT
|
||
SETTRK EQU 27 ;WBOOT+27 SIENT PROGRAM AREA
|
||
LOADP EQU 900H ;LOAD POINT FOR SYSTEM DURING LOAD/STORE
|
||
BDOS EQU 5H ;DOS ENTRY POINT
|
||
BOOT EQU 0 ;JMP TO 'BTY SUBROUTINES
|
||
MULTSEC:
|
||
;MULTIPLY THE SECTOR NUMBER IN A BY THE SECTOR SIZE
|
||
MOV L,A! MVI H,0 ;SECTOR NUMBER IN HL
|
||
REPT LO TITLE 'SYSGEN - SYSTEM GENERATION PROGRAM 8/79'
|
||
; SYSTEM GENERATION PROGRAM, VERSION FOR MDS
|
||
VERS EQU 20 ;X.X
|
||
;
|
||
; COPYRIGHT.
|
||
;
|
||
OST: DB NTRKS ;OPERATING SYSTEM TRACKS
|
||
SPT: DB NSECTS ;SECTORS PER TRACK (CAN BE PATCHED)
|
||
TRAN: ;BASE OF TRANSLATE TABNATOR FOR MESSAGE
|
||
END
|
||
FOR SET TRACK FUNCTION
|
||
SETSEC EQU 30 ;WBOOT+30 FOR SET SECTOR FUNCTION
|
||
SETDMA EQU 33 ;WBOOT+33 FOR SET DMA ADDRESS
|
||
READF EQU OOT' TO REBOOT SYSTEM
|
||
CONI EQU 1 ;CONSOLE INPUT FUNCTION
|
||
CONO EQU 2 ;CONSOLE OUTPUT FUNCTION
|
||
SELF EQU 14 ;SELECT DISK
|
||
OPENF G2SEC ;LOG 2 OF SECTOR SIZE
|
||
DAD H
|
||
ENDM
|
||
RET ;WITH HL = SECTOR * SECTOR SIZE
|
||
;
|
||
GETCHAR:
|
||
; READ CONSOLE CHARACTER TO REGIS (C) DIGITAL RESEARCH
|
||
; 1976, 1977, 1978, 1979
|
||
;
|
||
NSECTS EQU 26 ;NO. OF SECTORS PER TRACK
|
||
NTRKS EQU 2 ;NO. OF OPERATLE
|
||
TRELT SET 1 ;FIRST/NEXT TRAN ELEMENT
|
||
TRBASE SET 1 ;BASE FOR WRAPAROUND
|
||
REPT NSECTS ;ONCE FOR EACH SECTOR ON A TRACK
|
||
DB 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹36 ;WBOOT+36 FOR READ FUNCTION
|
||
WRITF EQU 39 ;WBOOT+39 FOR WRITE FUNCTION
|
||
;
|
||
ORG TPA ;TRANSIENT PROGRAM AREA
|
||
JMP START
|
||
DB EQU 15 ;DISK OPEN FUNCTION
|
||
DREADF EQU 20 ;DISK READ FUNCTION
|
||
;
|
||
MAXTRY EQU 10 ;MAXIMUM NUMBER OF RETRIES ON EACH READ/WRITE
|
||
CTER A
|
||
MVI C,CONI! CALL BDOS!
|
||
; CONVERT TO UPPER CASE BEFORE RETURN
|
||
CPI 'A' OR 20H ! RC ;RETURN IF BELOW LOWER CASE A
|
||
CPI ING SYSTEM TRACKS
|
||
NDISKS EQU 4 ;NUMBER OF DISK DRIVES
|
||
SECSIZ EQU 128 ;SIZE OF EACH SECTOR
|
||
LOG2SEC EQU 7 ;LOG 2 SECSIZ
|
||
SKEW ETRELT ;GENERATE FIRST/NEXT SECTOR
|
||
TRELT SET TRELT+SKEW
|
||
IF TRELT GT NSECTS
|
||
TRBASE SET TRBASE+1
|
||
TRELT SET TRBASE
|
||
ENDIF
|
||
EN裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹'COPYRIGHT (C) 1978, DIGITAL RESEARCH '
|
||
;
|
||
; TRANSLATE TABLE - SECTOR NUMBERS ARE TRANSLATED
|
||
; HERE TO DECREASE THE SYSGEN TIM('Z' OR 20H) + 1
|
||
RNC ;RETURN IF ABOVE LOWER CASE Z
|
||
ANI 5FH! RET
|
||
;
|
||
PUTCHAR:
|
||
; WRITE CHARACTER FROM A TO CONSOLE
|
||
MOV E,A!, 1, 2, . . . 25
|
||
STA SECTOR ;SECTOR INCREMENTED BEFORE READ OR WRITE
|
||
;
|
||
RWSEC: ;READ OR WRITE SECTOR
|
||
LDA SPT ;SECTORS PER TET OR PUT CP/M (RW=0 FOR READ, 1 FOR WRITE)
|
||
; DISK IS ALREADY SELECTED
|
||
;
|
||
LXI H,LOADP ;LOAD POINT IN RAM FOR CP/M DURING SYSG
|
||
; OK TO TRY READ OR WRITE
|
||
INR A
|
||
STA RETRY ;RETRY=RETRY+1
|
||
LDA RW ;READ OR WRITE?
|
||
ORA A
|
||
JZ TRYREAD
|
||
;
|
||
; MUST BE WRITE
|
||
LXI D,SETTRK ;OFFSET FOR SETTRK ENTRY
|
||
DAD D
|
||
PCHL ;GONE TO SETTRK
|
||
;
|
||
SEC: ;SET UP SECTOR NUMBER
|
||
LHLD WBOOT
|
||
LXI D,SETS DMADDR ;BASE DMA ADDRESS FOR THIS TRACK
|
||
DAD D ;+(TRAN(SECTOR)-TRAN(0))*SECSIZ
|
||
MOV B,H
|
||
MOV C,L ;TO BC FOR SEC CALL
|
||
CALL MVI C,CONO! CALL BDOS! RET
|
||
;
|
||
CRLF: ;SEND CARRIAGE RETURN, LINE FEED
|
||
MVI A,CR
|
||
CALL PUTCHAR
|
||
MVI A,LF
|
||
CALL PUTCHAR
|
||
RETRACK
|
||
LXI H,SECTOR
|
||
INR M ;TO NEXT SECTOR
|
||
CMP M ;A=26 AND M=0 1 2...25 (USUALLY)
|
||
JZ ENDTRK ;
|
||
;
|
||
; READ OR WRITE SECTOR TOEN
|
||
SHLD DMADDR
|
||
;
|
||
; CLEAR TRACK TO 00
|
||
MVI A,-1 ;START WITH TRACK EQUAL -1
|
||
STA TRACK
|
||
;
|
||
RWTRK: ;READ OR WRITE NEXT TRACK
|
||
|
||
CALL WRITE
|
||
JMP CHKRW ;CHECK FOR ERROR RETURNS
|
||
TRYREAD:
|
||
CALL READ
|
||
CHKRW:
|
||
ORA A
|
||
JZ RWSEC ;ZERO FLAG IF R/W OK
|
||
;
|
||
; EEC
|
||
DAD D
|
||
PCHL
|
||
;
|
||
DMA: ;SET DMA ADDRESS TO VALUE OF B,C
|
||
LHLD WBOOT
|
||
LXI D,SETDMA
|
||
DAD D
|
||
PCHL
|
||
;
|
||
READ: ;PERFORM READ ODMA ;DMA ADDRESS SET FROM B,C
|
||
; DMA ADDRESS SET, CLEAR RETRY COUNT
|
||
XRA A
|
||
STA RETRY ;SET TO ZERO RETRIES
|
||
;
|
||
TRYSEC: ;TRY TO
|
||
;
|
||
CRMSG: ;PRINT MESSAGE ADDRESSED BY H,L TIL ZERO
|
||
;WITH LEADING CRLF
|
||
PUSH H! CALL CRLF! POP H ;DROP THRU TO OUTMSG0
|
||
OUTM OR FROM CURRENT DMA ADDR
|
||
LXI H,SECTOR
|
||
MOV E,M ;SECTOR NUMBER
|
||
MVI D,0 ;TO DE
|
||
LXI H,TRAN
|
||
MOV B,M ;TRAN(0) IN B
|
||
DAD D
|
||
LXI H,TRACK
|
||
INR M ;TRACK = TRACK + 1
|
||
LDA OST ;NUMBER OF OPERATING SYSTEM TRACKS
|
||
CMP M ;= TRACK NUMBER ?
|
||
JZ ENDRW ;END RROR, RETRY OPERATION
|
||
JMP TRYSEC
|
||
;
|
||
; END OF TRACK
|
||
ENDTRK:
|
||
LDA SPT ;SECTORS PER TRACK
|
||
CALL MULTSEC ;*SECSIZ
|
||
XCHG ;TO PERATION
|
||
LHLD WBOOT
|
||
LXI D,READF
|
||
DAD D
|
||
PCHL
|
||
;
|
||
WRITE: ;PERFORM WRITE OPERATON
|
||
LHLD WBOOT
|
||
LXI D,WRITF
|
||
DAD D
|
||
PCHL
|
||
READ OR WRITE CURRENT SECTOR
|
||
LDA RETRY
|
||
CPI MAXTRY ;TOO MANY RETRIES?
|
||
JC TRYOK
|
||
;
|
||
; PAST MAXTRIES, MESSAGE AND IGNORE
|
||
LSG:
|
||
MOV A,M! ORA A! RZ
|
||
; MESSAGE NOT YET COMPLETED
|
||
PUSH H! CALL PUTCHAR! POP H! INX H
|
||
JMP OUTMSG
|
||
;
|
||
SEL:
|
||
; SELECT DISK ;SECTOR TRANSLATED
|
||
MOV C,M ;VALUE TO C READY FOR SELECT
|
||
PUSH B ;SAVE TRAN(0),TRAN(SECTOR)
|
||
CALL SEC ;SET UP SECTOR NUMBER
|
||
OF READ OR WRITE
|
||
;
|
||
; OTHERWISE NOTDONE, GO TO NEXT TRACK
|
||
MOV C,M ;TRACK NUMBER
|
||
CALL TRK ;TO SET TRACK
|
||
MVI A,-1 ;COUNTS 0DE
|
||
LHLD DMADDR ;BASE DMA FOR THIS TRACK
|
||
DAD D ;+SPT*SECSIZ
|
||
SHLD DMADDR ;READY FOR NEXT TRACK
|
||
JMP RWTRK ;FOR ANOTHER TRAC
|
||
;
|
||
DREAD: ;DISK READ FUNCTION
|
||
MVI C,DREADF
|
||
JMP BDOS
|
||
;
|
||
OPEN: ;FILE OPEN FUNCTION
|
||
MVI C,OPENF ! JMP BDOS
|
||
;
|
||
GETPUT:
|
||
; GXI H,ERRMSG
|
||
CALL OUTMSG
|
||
CALL GETCHAR
|
||
CPI CR
|
||
JNZ REBOOT
|
||
;
|
||
; TYPED A CR, OK TO IGNORE
|
||
CALL CRLF
|
||
JMP RWSEC
|
||
;
|
||
TRYOK:GIVEN BY REGISTER A
|
||
MOV C,A! LHLD WBOOT! LXI D,SELDSK! DAD D! PCHL
|
||
;
|
||
TRK: ;SET UP TRACK
|
||
LHLD WBOOT ;ADDRESS OF BOOT ENTRY
|
||
POP B ;RECALL TRAN(0),TRAN(SECTOR)
|
||
MOV A,C ;TRAN(SECTOR)
|
||
SUB B ;-TRAN(0)
|
||
CALL MULTSEC ;*SECTOR SIZE
|
||
XCHG ;TO DE
|
||
LHLDK
|
||
;
|
||
ENDRW: ;END OF READ OR WRITE, RETURN TO CALLER
|
||
RET
|
||
;
|
||
;
|
||
START:
|
||
;
|
||
LXI SP,STACK ;SET LOCAL STACK POINTER
|
||
LXI H,SIGN ;TO SET MESSAGE
|
||
SUI 'A'
|
||
CALL SEL ;TO SELECT THE DRIVE
|
||
; GETSYS, SET RW TO READ AND GET THE SYSTEM
|
||
CALL CRLF
|
||
LXI H,GE; MORE TO READ, CONTINUE
|
||
LXI D,SECSIZ
|
||
DAD D ;HL IS NEW LOAD ADDRESS
|
||
JMP RDINP
|
||
;
|
||
BADRD: ;EOF ENCOUNTERED IN INPUT FILE
|
||
|
||
THEN TYPE RETURN',0
|
||
ASKPUT: DB 'DESTINATION DRIVE NAME (OR RETURN TO REBOOT)',0
|
||
PUTMSG: DB 'DESTINATION ON '
|
||
PDISK: DS 1 ;FIEAD FILE
|
||
PRERD:
|
||
PUSH B ;SAVE COUNT
|
||
LXI D,FCB ;INPUT FILE CONTROL COUNT
|
||
CALL DREAD ;ASSUME SET TO DEFAULT BUFFER
|
||
POP B ;CR
|
||
JNZ REBOOT
|
||
CALL CRLF
|
||
;
|
||
LXI H,RW
|
||
MVI M,1
|
||
CALL GETPUT ;TO PUT SYSTEM BACK ON DISKETTE
|
||
LXI H,DONE
|
||
CALL OUTMSG
|
||
JON
|
||
CALL OUTMSG
|
||
;
|
||
; CHECK FOR DEFAULT FILE LOAD INSTEAD OF GET
|
||
;
|
||
LDA FCB+1 ;BLANK IF NO FILE
|
||
CPI ' '
|
||
JZ GETSYS ;SKIP TTMSG
|
||
CALL OUTMSG
|
||
CALL GETCHAR
|
||
CPI CR
|
||
JNZ REBOOT
|
||
CALL CRLF
|
||
;
|
||
XRA A
|
||
STA RW
|
||
CALL GETPUT
|
||
LXI H,DONE
|
||
CALL OUTMSG
|
||
LXI H,BADFILE
|
||
CALL CRMSG
|
||
JMP REBOOT
|
||
;
|
||
;
|
||
GETSYS:
|
||
LXI H,ASKGET ;GET SYSTEM?
|
||
CALL CRMSG
|
||
CALL GETCHAR
|
||
CPI CR
|
||
JZ PLLED IN AT PUT FUNCTION
|
||
DB ', THEN TYPE RETURN',0
|
||
ERRMSG: DB 'PERMANENT ERROR, TYPE RETURN TO IGNORE',0
|
||
DONE: DB 'FUNCTION CRESTORE COUNT
|
||
ORA A
|
||
JNZ BADRD ;CANNOT ENCOUNTER END-OF FILE
|
||
DCR C ;COUNT DOWN
|
||
JNZ PRERD ;FOR ANOTHER SECTOR
|
||
;
|
||
; SECTORMP PUTSYS ;FOR ANOTHER PUT OPERATION
|
||
;
|
||
REBOOT:
|
||
MVI A,0
|
||
CALL SEL
|
||
CALL CRLF
|
||
JMP BOOT
|
||
BADDISK:
|
||
;BAD DISK NAME
|
||
LXI H,O GET SYSTEM MESSAGE IF BLANK
|
||
LXI D,FCB ;TRY TO OPEN IT
|
||
CALL OPEN ;
|
||
INR A ;255 BECOMES 00
|
||
JNZ RDOK ;OK TO READ IF NOT 25
|
||
;
|
||
; PUT SYSTEM
|
||
PUTSYS:
|
||
LXI H,ASKPUT
|
||
CALL CRMSG
|
||
CALL GETCHAR
|
||
CPI CR
|
||
JZ REBOOT
|
||
SUI 'A'
|
||
CPI NDISKS
|
||
JC PUTC
|
||
;
|
||
UTSYS ;SKIP IF CR ONLY
|
||
;
|
||
SUI 'A' ;NORMALIZE DRIVE NUMBER
|
||
CPI NDISKS ;VALID DRIVE?
|
||
JC GETC ;SKIP TO GETC IF SO
|
||
;
|
||
; INOMPLETE',0
|
||
QDISK: DB 'INVALID DRIVE NAME (USE A, B, C, OR D)',0
|
||
NOFILE: DB 'NO SOURCE FILE ON DISK',0
|
||
BADFILE:
|
||
DB 'SOURCE FS SKIPPED AT BEGINNING OF FILE
|
||
;
|
||
LXI H,LOADP
|
||
RDINP:
|
||
PUSH H
|
||
MOV B,H
|
||
MOV C,L ;READY FOR DMA
|
||
CALL DMA ;DMA ADDRESS SET
|
||
QDISK
|
||
CALL CRMSG
|
||
RET
|
||
;
|
||
;
|
||
;
|
||
; DATA AREAS
|
||
; MESSAGES
|
||
SIGNON: DB 'SYSGEN VER '
|
||
DB VERS/10+'0','.',VERS MOD 10+'0'
|
||
DB 5
|
||
;
|
||
; FILE NOT PRESENT, ERROR AND REBOOT
|
||
;
|
||
LXI H,NOFILE
|
||
CALL CRMSG
|
||
JMP REBOOT
|
||
;
|
||
; FILE PRESENT
|
||
; READ TO LOAD POIN; INVALID DRIVE NAME
|
||
CALL BADDISK
|
||
JMP PUTSYS ;TO TRY AGAIN
|
||
;
|
||
PUTC:
|
||
; SET DISK FROM REGISTER C
|
||
ADI 'A'
|
||
STA PDISK ;MESSVALID DRIVE NUMBER
|
||
CALL BADDISK
|
||
JMP GETSYS ;TO TRY AGAIN
|
||
;
|
||
GETC:
|
||
; SELECT DISK GIVEN BY REGISTER A
|
||
ADI 'A'
|
||
STA GDISKILE INCOMPLETE',0
|
||
;
|
||
; VARIABLES
|
||
SDISK: DS 1 ;SELECTED DISK FOR CURRENT OPERATION
|
||
TRACK: DS 1 ;CURRENT TRACK
|
||
SECTOR: DS 1 ;C
|
||
LXI D,FCB ;READY FOR READ
|
||
CALL DREAD ;
|
||
POP H ;RECALL DMA ADDRESS
|
||
ORA A ;00 IF READ OK
|
||
JNZ PUTSYS ;ASSUME EOF IF NOT.
|
||
0
|
||
ASKGET: DB 'SOURCE DRIVE NAME (OR RETURN TO SKIP)',0
|
||
GETMSG: DB 'SOURCE ON '
|
||
GDISK: DS 1 ;FILLED IN AT GET FUNCTION
|
||
DB ',T
|
||
;
|
||
RDOK:
|
||
XRA A
|
||
STA FCBCR ;CURRENT RECORD = 0
|
||
;
|
||
; PRE-READ AREA FROM TPA TO LOADP
|
||
;
|
||
MVI C,(LOADP-TPA)/SECSIZ
|
||
; PRE-RAGE SET
|
||
SUI 'A'
|
||
CALL SEL ;SELECT DEST DRIVE
|
||
; PUT SYSTEM, SET RW TO WRITE
|
||
LXI H,PUTMSG
|
||
CALL CRMSG
|
||
CALL GETCHAR
|
||
CPI URRENT SECTOR
|
||
RW: DS 1 ;READ IF 0, WRITE IF 1
|
||
DMADDR: DS 2 ;CURRENT DMA ADDRESS
|
||
RETRY: DS 1 ;NUMBER OF TRIES ON THIS SECTOR
|
||
ACCLEN: DS 1 ;ACCUMULATOR LENGTH
|
||
ACMAX EQU 64 ;LENGTH OF ACCUMULATOR
|
||
ACCUM: DS ACMAX ;ACCUMULATOR (MUST FOLLLOW ACCLEN)
|
||
;
|
||
;
|
||
;
|
||
; COMMON DATA FOR CP/M ASSEMBLER MODULE
|
||
ORG 100H
|
||
ENDA EQU 20F0H ;END OF ASSEMBLER PROGRAM
|
||
BDOS EQU 5H ;ENTRY TO DOS, USE裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 DS STACKSIZE*2
|
||
STACK:
|
||
END
|
||
OPERAND EXPRESSION EVALUATOR PARAMETERS
|
||
EVALUE: DS 2 ;VALUE OF EXPRESSION AFTER EVALUATION
|
||
;
|
||
; SYMBOL TABLE MODULE PARAMETERD TO COMPUTE END MEMORY
|
||
LXI SP,ENDMOD
|
||
LHLD BDOS+1
|
||
SHLD SYMAX ;COMPUTE END OF MEMORY
|
||
JMP ENDMOD
|
||
COPY: DB ' COPYRIGHT(C) 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹S
|
||
SYTOP: DW ENDA ;FIRST LOCATION AVAILABLE FOR SYMBOL TABLE
|
||
SYMAX: DS 2 ;LAST AVAILABLE LOCATION FOR SYMBOL TABLE
|
||
;
|
||
; MISCEL1978, DIGITAL RESEARCH '
|
||
ORG COPY
|
||
;
|
||
; PRINT BUFFER AND PRINT BUFFER POINTER
|
||
PBMAX EQU 120 ;MAX PRINT BUFFER
|
||
PBUFF: DS PBMA TITLE 'ASM IO MODULE'
|
||
; I/O MODULE FOR CP/M ASSEMBLER
|
||
;
|
||
ORG 200H
|
||
BOOT EQU 000H ;REBOOT LOCATION
|
||
; I/O MODULE ENTRY POINTS裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹LANEOUS DATA AREAS
|
||
PASS: DS 1 ;PASS # 0,1
|
||
FPC: DS 2 ;FILL ADDRESS FOR NEXT HEX RECORD
|
||
ASPC: DS 2 ;ASSEMBLER'S PSEUDO PC
|
||
SYBAX
|
||
PBP: DS 1 ;PRINT BUFFER POINTER
|
||
;
|
||
; SCANNER PARAMETERS
|
||
TOKEN: DS 1 ;CURRENT TOKEN
|
||
VALUE: DS 2 ;BINARY VALUE FOR NUMBERS
|
||
|
||
JMP INIT ;INITIALIZE, START ASSEMBLER
|
||
JMP SETUP ;FILE SETUP
|
||
JMP GNC ;GET NEXT CHARACTER
|
||
JMP PNC ;PUT NEXT OUTPUT CHARAC TITLE 'ASM COMMON DATA AREA'
|
||
;
|
||
; COPYRIGHT (C) 1977, 1978
|
||
; DIGITAL RESEARCH
|
||
; BOX 579, PACIFIC GROVE
|
||
; CALIFORNIA, 93950
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹S: DW ENDA ;SYMBOL TABLE BASE
|
||
SYADR: DS 2 ;CURRENT SYMBOL BASE
|
||
ENDMOD EQU ($ AND 0FF00H)+100H
|
||
END
|
||
TER
|
||
JMP PNB ;PUT NEXT HEX BYTE
|
||
JMP PCHAR ;PRINT CONSOLE CHARACTER
|
||
JMP PCON ;PRINT CONSOLE BUFFER TO CRLF
|
||
JMP WOBUFF ;WRINSB EQU 8 ;NUMBER OF SOURCE BUFFERS
|
||
NPB EQU 6 ;NUMBER OF PRINT BUFFERS
|
||
NHB EQU 6 ;NUMBER OF HEX BUFFERS
|
||
;
|
||
SSIZE EQU NSB*128
|
||
EQU 1AH ;END OF FILE MARK
|
||
;
|
||
;
|
||
; DOS ENTRY POINTS
|
||
BDOS EQU 5H ;DOS ENTRY POINT
|
||
READC EQU 1 ;READ CONSOLE DEVICE
|
||
WRITC EQU CHAR
|
||
RET
|
||
;
|
||
FNAME: ;FILL NAME FROM DEFAULT FILE CONTROL BLOCK
|
||
LXI D,FCB
|
||
MVI B,FLN
|
||
FNAM0: LDAX D ;GET NEXT FILE CHARACTER;
|
||
TOKEN EQU QBP+1 ;CURRENT TOKEN UDER SCAN
|
||
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
|
||
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTBLOCK ADDRESS
|
||
FNM EQU 1 ;POSITION OF FILE NAME
|
||
FLN EQU 9 ;FILE NAME LENGTH
|
||
BUFF EQU 80H ;INPUT DISK BUFFER ADDRESS
|
||
;
|
||
SEL: ;TE OUTBUFFER
|
||
JMP PERR ;PLACE ERROR CHARACTER INTO PBUFF
|
||
JMP DHEX ;PLACE HEX BYTE INTO OUTPUT BUFFER
|
||
JMP EOR ;END OF ASSEMB
|
||
PSIZE EQU NPB*128
|
||
HSIZE EQU NHB*128
|
||
;
|
||
; FILE CONTROL BLOCKS
|
||
SCB: DS 9 ;FILE NAME
|
||
DB 'ASM' ;FILE TYPE
|
||
SCBR: DS 1 ;REEL NU2 ;WRITE CONSOLE DEVICE
|
||
REDYC EQU 11 ;CONSOLE CHARACTER READY
|
||
SELECT EQU 14 ;SELECT DISK SPECIFIED BY REGISTER E
|
||
OPENF EQU 15
|
||
CPI '?'
|
||
JZ FNERR ;FILE NAME ERROR
|
||
MOV M,A ;STORE TO FILE CNTRL BLOCK
|
||
INX H
|
||
INX D
|
||
DCR B
|
||
JNZ FNAM0 ;FOR NEXT CHARACH
|
||
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
|
||
ACCUM EQU ACCLEN+1
|
||
;
|
||
EVALUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
|
||
;
|
||
SYTOPSELECT DISK IN REG-A
|
||
LXI H,CDISK
|
||
CMP M ;SAME?
|
||
RZ
|
||
MOV M,A ;CHANGE CURRENT DISK
|
||
MOV E,A
|
||
MVI C,SELECT
|
||
CALL BDOS
|
||
RETLY
|
||
; DATA FOR I/O MODULE
|
||
BPC: DS 2 ;BASE PC FOR CURRENT HEX RECORD
|
||
DBL: DS 1 ;HEX BUFFER LENGTH
|
||
DBUFF: DS 16 ;HEX BUFFER
|
||
;
|
||
MBER (ZEROED IN SETUP)
|
||
DS 19 ;MISC AND DISK MAP
|
||
SCBCR: DS 1 ;CURRENT RECORD (ZEROED IN SETUP)
|
||
;
|
||
PCB: DS 9
|
||
DB 'PRN',0
|
||
DS ;OPEN FILE
|
||
CLOSF EQU 16 ;CLOSE FILE
|
||
DELEF EQU 19 ;DELETE FILE
|
||
READF EQU 20 ;READ FILE
|
||
WRITF EQU 21 ;WRITE FILE
|
||
MAKEF EQU 2TER
|
||
RET
|
||
;
|
||
INIT: ;SET UP STACK AND FILES, START ASSEMBLER
|
||
LXI H,TITL
|
||
CALL PCON
|
||
JMP SET0
|
||
;
|
||
OPEN: ;OPEN FILE ADDRESSED EQU EVALUE+2 ;CURRENT SYMBOL TOP
|
||
SYMAX EQU SYTOP+2 ;MAX ADDRESS+1
|
||
;
|
||
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
|
||
FPC EQU PASS+1 ;
|
||
;
|
||
SCNP: ;SCAN THE NEXT PARAMETER
|
||
INX H
|
||
MOV A,M
|
||
CPI ' '
|
||
JZ SCNP0
|
||
SBI 'A' ;NORMALIZE
|
||
RET
|
||
SCNP0: LDA CDISK
|
||
RET
|
||
;
|
||
; DISK NAMES
|
||
CDISK: DS 1 ;CURRENTLY SELECTED DISK
|
||
ADISK: DS 1 ;.ASM DISK
|
||
PDISK: DS 1 ;.PRN DISK
|
||
HDISK: DS 1 ;.HEX DISK
|
||
;
|
||
19
|
||
DB 0 ;RECORD TO WRITE NEXT
|
||
;
|
||
HCB: DS 9
|
||
DB 'HEX',0
|
||
DS 19
|
||
DB 0
|
||
;
|
||
; POINTERS AND BUFFERS
|
||
SBP: DW SSIZE ;NEXT CHARA2 ;MAKE A FILE
|
||
CSEL EQU 25 ;RETURN CURRENTLY SELECTED DISK
|
||
SETDM EQU 26 ;SET DMA ADDRESS
|
||
;
|
||
; FILE AND BUFFERING PARAMETERS
|
||
BY D,E
|
||
MVI C,OPENF
|
||
CALL BDOS
|
||
CPI 255
|
||
RNZ
|
||
; OPEN ERROR
|
||
LXI H,ERROP
|
||
CALL PCON
|
||
JMP BOOT
|
||
;
|
||
CLOSE: ;CLOSE FILE ADDREFILL ADDRESS FOR DHEX ROUTINE
|
||
ASPC EQU FPC+2 ;ASSEMBLER'S PSEUDO PC
|
||
;
|
||
CR EQU 0DH ;CARRIAGE RETURN
|
||
LF EQU 0AH ;LINE FEED
|
||
EOF
|
||
PCON: ;PRINT MESSAGE AT H,L TO CONSOLE DEVICE
|
||
MOV A,M
|
||
CALL PCHAR
|
||
MOV A,M
|
||
INX H
|
||
CPI CR
|
||
JNZ PCON
|
||
MVI A,LF
|
||
CALL P;
|
||
;
|
||
; COMMON EQUATES
|
||
QBMAX EQU 120 ;MAX PRINT SIZE
|
||
QBUFF EQU 10CH ;PRINT BUFFER
|
||
QBP EQU QBUFF+QBMAX ;PRINT BUFFER POINTER
|
||
CTER POSITION TO READ
|
||
SBUFF: DS SSIZE
|
||
;
|
||
PBP: DW 0
|
||
PBUFF: DS PSIZE
|
||
;
|
||
HBP: DW 0
|
||
HBUFF: DS HSIZE
|
||
FCB EQU 5CH ;FILE CONTROL SSED BY D,E
|
||
MVI C,CLOSF
|
||
CALL BDOS
|
||
CPI 255
|
||
RNZ ;CLOSE OK
|
||
LXI H,ERRCL
|
||
CALL PCON
|
||
JMP BOOT
|
||
;
|
||
DELETE: ;DELETE FILE AFNERR: ;FILE NAME ERROR
|
||
LXI H,ERRFN
|
||
CALL PCON
|
||
JMP BOOT
|
||
;
|
||
;
|
||
GCOMP: ;COMPARE D,E AGAINS H,L
|
||
MOV A,D
|
||
CMP H
|
||
RNZ
|
||
MOVOP D ;FCB ADDRESS
|
||
CALL MAKE
|
||
;
|
||
NOPR: ;TEST FOR HEX FILE
|
||
LDA HDISK
|
||
CPI 'Z'-'A'
|
||
JZ NOHEX
|
||
LXI H,HCB
|
||
PUSH H
|
||
PUSH H
|
||
INX H ;READY FOR NEXT READ
|
||
SHLD SBP
|
||
POP H ;RESTORE PREVIOUS SBP
|
||
DAD D ;ABSOLUTE ADDRESS OF CHARACTER
|
||
MOV A,M ;GET IT
|
||
LE NAME ERROR
|
||
MVI C,CSEL ;CURRENT DISK?
|
||
CALL BDOS ;GET IT TO REG-A
|
||
STA CDISK
|
||
;
|
||
; SCAN PARAMETERS
|
||
LXI H,FCB+FLN-1
|
||
CALRMAL READ OCCURRED
|
||
LXI D,BUFF ;SOURCE BUFFER ADDRESS
|
||
MVI C,128
|
||
MOV0: LDAX D ;GET CHARACTER
|
||
MOV M,A ;STORE CHARACTER
|
||
INXDDRESSED BY D,E
|
||
MVI C,DELEF
|
||
JMP BDOS
|
||
;
|
||
MAKE: ;MAKE FILE ADDRESSED BY D,E
|
||
MVI C,MAKEF
|
||
CALL BDOS
|
||
CPI 255
|
||
RNZ
|
||
; MAKE A,E
|
||
CMP L
|
||
RET
|
||
;
|
||
GNC: ;GET NEXT CHARACTER FROM SOURCE BUFFER
|
||
PUSH B
|
||
PUSH D
|
||
PUSH H ;ENVIRONMENT SAVED
|
||
LHLD SBP
|
||
LXCALL FNAME
|
||
CALL SELH
|
||
POP D
|
||
CALL DELETE
|
||
POP D
|
||
CALL MAKE
|
||
;
|
||
; FILES SET UP, CALL ASSEMBLER
|
||
NOHEX: JMP ENDMOD
|
||
;
|
||
SETUPPOP H
|
||
POP D
|
||
POP B
|
||
RET
|
||
;
|
||
FRERR: LXI H,ERRFR
|
||
CALL PCON ;PRINT READ ERROR MESSAGE
|
||
JMP BOOT
|
||
;
|
||
PNC: ;SAME AT PNCF, BUT L SCNP
|
||
STA ADISK
|
||
CALL SCNP
|
||
STA HDISK
|
||
CALL SCNP
|
||
STA PDISK
|
||
;
|
||
LXI H,SCB ;ADDRESS SOURCE FILE CONTROL BLOCK
|
||
CALL FNAM D
|
||
INX H
|
||
DCR C
|
||
JNZ MOV0
|
||
; BUFFER LOADED, TRY NEXT BUFFER
|
||
;
|
||
DCR B
|
||
JNZ GNC0
|
||
JMP GNC2
|
||
;
|
||
GNC1: ;EOF OR ERROR
|
||
CPI 3 ERROR
|
||
LXI H,ERRMA
|
||
CALL PCON
|
||
JMP BOOT
|
||
;
|
||
SELA: LDA ADISK
|
||
CALL SEL
|
||
RET
|
||
;
|
||
NPR: ;RETURN ZERO FLAG IF NO PRINT FILE
|
||
LI D,SSIZE
|
||
CALL GCOMP
|
||
JNZ GNC2
|
||
;
|
||
; READ ANOTHER BUFFER
|
||
CALL SELA
|
||
LXI H,0
|
||
SHLD SBP
|
||
MVI B,NSB ;NUMBER OF SOURCE BUFFE: ;SETUP INPUT FILE FOR SOURCE PROGRAM
|
||
LXI H,SSIZE
|
||
SHLD SBP ;CAUSE IMMEDIATE READ
|
||
XRA A ;ZERO VALUE
|
||
STA SCBR ;CLEAR REELENVIRONMENT IS SAVED FIRST
|
||
PUSH B
|
||
; CHECK FOR CONSOLE OUTPUT / NO OUTPUT
|
||
MOV B,A ;SAVE CHARACTER
|
||
LDA PDISK ;Z OR X?
|
||
CPIE ;FILE NAME OBTAINED FROM DEFAULT FCB
|
||
;
|
||
CALL NPR ;Z OR X?
|
||
JZ NOPR
|
||
LXI H,PCB ;ADDRESS PRINT FILE CONTROL BLOCK
|
||
PUSH H ;ALLOW 0,1,2
|
||
JNC FRERR ;FILE READ ERROR
|
||
GNCE: MVI M,EOF ;STORE AND END OF FILE CHARACTER
|
||
INX H
|
||
DCR C
|
||
JNZ GNCE ;FILL CUDA PDISK
|
||
CPI 'Z'-'A'
|
||
RZ
|
||
CPI 'X'-'A' ;CONSOLE
|
||
RET
|
||
;
|
||
SELP: LDA PDISK
|
||
CALL SEL
|
||
RET
|
||
;
|
||
SELH: LDA HDISK
|
||
CALL SEL
|
||
RRS
|
||
LXI H,SBUFF
|
||
GNC0: ;READ 128 BYTES
|
||
PUSH B ;SAVE COUNT
|
||
PUSH H ;SAVE BUFFER ADDRESS
|
||
MVI C,READF
|
||
LXI D,SCB
|
||
CALL BDOS NUMBER
|
||
STA SCBCR ;CLEAR CURRENT RECORD
|
||
STA DBL ;CLEAR HEX BUFFER LENGTH
|
||
CALL SELA
|
||
LXI D,SCB
|
||
CALL OPEN
|
||
;
|
||
RET
|
||
;
|
||
'Z'-'A' ;Z NO OUTPUT
|
||
JZ PNRET
|
||
;
|
||
CPI 'X'-'A'
|
||
MOV A,B ;RECOVER CHAR FOR CON OUT
|
||
JNZ PNGO
|
||
CALL PCHAR
|
||
JMP PNRET
|
||
;
|
||
; ;SAVE A COPY FOR OPEN
|
||
PUSH H ;SAVE A COPY FOR DELETE
|
||
CALL FNAME ;FILL PCB
|
||
CALL SELP
|
||
POP D ;FCB ADDRESS
|
||
CALL DELETE
|
||
PRRENT BUFFER WITH EOF'S
|
||
;
|
||
GNC2: ;GET CHARACTER TO ACCUMULATOR AND RETURN
|
||
LXI D,SBUFF
|
||
LHLD SBP
|
||
PUSH H ;SAVE CURRENT SBP
|
||
ET
|
||
;
|
||
SET0: ;SET UP FILES FOR INPUT AND OUTPUT
|
||
LDA FCB ;GET FIRST CHARACTER
|
||
CPI ' ' ;MAY HAVE FORGOTTEN NAME
|
||
JZ FNERR ;FI ;PERFORM THE READ
|
||
POP H ;RESTORE BUFFER ADDRESS
|
||
POP B ;RESTORE BUFFER COUNT
|
||
ORA A ;SET FLAGS
|
||
MVI C,128
|
||
JNZ GNC1
|
||
; NONOT X OR Z, SO PRINT IT
|
||
PNGO: PUSH D
|
||
PUSH H
|
||
CALL PNCF
|
||
POP H
|
||
POP D
|
||
PNRET: POP B
|
||
RET
|
||
;
|
||
PNCF: ;PRINT NEXT CHARACTER
|
||
LXI H,HSIZE
|
||
CALL GCOMP ;EQUAL?
|
||
RNZ
|
||
;
|
||
; OVERFLOW, WRITE BUFFERS
|
||
CALL SELH
|
||
LXI H,0
|
||
SHLD HBP
|
||
LXI H,HBUFF
|
||
LXI D,HCB N FLAGS
|
||
JNZ FWERR
|
||
;
|
||
; WRITE OK
|
||
DCR B
|
||
RZ ;RETURN IF NO MORE BUFFERS TO WRITE
|
||
JMP WBUFF
|
||
;
|
||
FWERR: ;ERROR IN WRITE
|
||
LXZ WOB2
|
||
RET
|
||
;
|
||
;
|
||
PERR: ;FILL QBUFF ERROR MESSAGE POSITION
|
||
MOV B,A ;SAVE CHARACTER
|
||
LXI H,QBUFF
|
||
MOV A,M
|
||
CPI ' '
|
||
RNZ ;
|
||
RZ ;DON'T DO THE WRITE
|
||
;
|
||
PUSH B ;SAVE NUMBER OF BUFFERS
|
||
PUSH D ;SAVE FCB ADDRESS
|
||
MVI C,128 ;READY FOR MOVE
|
||
LXI D,BUFTPUT BUFFER TO THE PRINT FILE
|
||
LDA QBP ;GET CHARACTER COUNT
|
||
LXI H,QBUFF ;BASE OF BUFFER
|
||
WOB0: ORA A ;ZERO COUNT?
|
||
JZ WOBE
|
||
LHLD PBP
|
||
XCHG
|
||
LXI H,PBUFF
|
||
DAD D
|
||
MOV M,A ;CHARACTER STORED AT PBP IN PBUFF
|
||
XCHG ;PBP TO H,L
|
||
INX H ;POINT TO NEXT CH;FILE CONTROL BLOCK FOR HEX FILE
|
||
MVI B,NHB
|
||
JMP WBUFF ;WRITE BUFFERS
|
||
;
|
||
PCHAR: ;PRINT CHARACTER IN REGISTER A
|
||
PUSH B
|
||
PUSI H,ERRFW
|
||
CALL PCON ;ERROR MESSAGE OUT
|
||
JMP EORC ;TO CLOSE AND REBOOT
|
||
;
|
||
;
|
||
PNB: ;PUT NEXT HEX BYTE
|
||
PUSH B
|
||
PUSH D
|
||
PUSHDON'T CHANGE IT IF ALREADY SET
|
||
MOV M,B ;STORE ERROR CHARACTER
|
||
RET
|
||
;
|
||
EOR: ;END OF ASSEMBLER
|
||
CALL NPR ;Z OR A?
|
||
JZ EOPR
|
||
F
|
||
WBUF0: ;MOVE TO BUFFER
|
||
MOV A,M ;GET CHARACTER
|
||
STAX D ;PUT CHARACTER
|
||
INX H
|
||
INX D
|
||
DCR C
|
||
JNZ WBUF0
|
||
;
|
||
; WRITE BUFFE; NOT END, SAVE COUNT AND GET CHARACTER
|
||
MOV B,A ;SAVE COUNT
|
||
MOV A,M
|
||
CALL WOCHAR ;WRITE CHARACTER
|
||
INX H ;ADDRESS NEXT CHAARACTER
|
||
SHLD PBP ;REPLACE IT
|
||
XCHG
|
||
LXI H,PSIZE
|
||
CALL GCOMP ;AT END OF BUFFER?
|
||
RNZ ;RETURN IF NOT
|
||
;
|
||
; OVERFLOW, WRITE H D
|
||
PUSH H
|
||
MVI C,WRITC
|
||
MOV E,A
|
||
CALL BDOS
|
||
POP H
|
||
POP D
|
||
POP B
|
||
RET
|
||
;
|
||
WOCHAR: ;WRITE CHARACTER IN REG-A WITH REFLEC H
|
||
CALL PNBF
|
||
POP H
|
||
POP D
|
||
POP B
|
||
RET
|
||
;
|
||
PNBF: ;PUT NEXT BYTE
|
||
; (SIMILAR TO THE PNCF SUBROUTINE)
|
||
LHLD HBP
|
||
XCHG
|
||
LX; FILL OUTPUT FILES WITH EOF'S
|
||
EOR2: LHLD PBP
|
||
MOV A,L
|
||
ORA H ;VALUE ZERO?
|
||
JZ EOPR
|
||
MVI A,EOF ;CTL-Z IS END OF FILE
|
||
CALLR
|
||
POP D ;RECOVER FCB ADDRESS
|
||
PUSH D ;SAVE IT AGAIN FOR LATER
|
||
PUSH H ;SAVE BUFFER ADDRESS
|
||
MVI C,WRITF ;DOS WRITE FUNCTIONRACTER OF BUFFER
|
||
MOV A,B ;GET COUNT
|
||
DCR A
|
||
JMP WOB0
|
||
;
|
||
WOBE: ;END OF PRINT - ZERO QBP
|
||
STA QBP
|
||
; FOLLOW BY CR LF
|
||
MVI ABUFFER
|
||
CALL SELP
|
||
LXI H,0
|
||
SHLD PBP
|
||
LXI H,PBUFF
|
||
LXI D,PCB ;D,E ADDRESS FILE CONTROL BLOCK
|
||
MVI B,NPB ;NUMBER OF BUFFERST AT CONSOLE IF ERROR
|
||
MOV C,A ;SAVE THE CHAR
|
||
CALL PNC ;PRINT CHAR
|
||
LDA QBUFF
|
||
CPI ' '
|
||
RZ
|
||
; ERROR IN LINE
|
||
LDA PDISK
|
||
I H,HBUFF
|
||
DAD D
|
||
MOV M,A ;CHARACTER STORED AT HBP IN HBUFF
|
||
XCHG
|
||
INX H ;HBP INCREMENTED
|
||
SHLD HBP
|
||
XCHG ;BACK TO D,E
|
||
PNC ;PUT ENDFILES IN PRINT BUFFER
|
||
JMP EOR2 ;EVENTUALLY BUFFER IS WRITTEN
|
||
;
|
||
EOPR: ;END OF PRINT FILE, CHECK HEX
|
||
LDA HDISK
|
||
|
||
CALL BDOS
|
||
POP H ;RECOVER BUFFER ADDRESS
|
||
POP D ;RECOVER FCB ADDRESS
|
||
POP B ;RECOVER BUFFER COUNT
|
||
ORA A ;SET ERROR RETUR,CR
|
||
CALL WOCHAR
|
||
MVI A,LF
|
||
CALL WOCHAR
|
||
LXI H,QBUFF
|
||
MVI A,QBMAX ;READY TO BLANK OUT
|
||
WOB2: MVI M,' '
|
||
INX H
|
||
DCR A
|
||
JN TO B
|
||
; (DROP THROUGH TO WBUFF)
|
||
;
|
||
WBUFF: ;WRITE BUFFERS STARTING AT H,L FOR B BUFFERS
|
||
; CHECK FOR EOF'S
|
||
MOV A,M
|
||
CPI EOF
|
||
CPI 'X'-'A'
|
||
RZ ;ALREADY PRINTED IF 'X'
|
||
;
|
||
MOV A,C ;RECOVER CHARACTER
|
||
CALL PCHAR ;PRINT IT
|
||
RET
|
||
;
|
||
WOBUFF: ;WRITE THE OU
|
||
CPI 'Z'-'A'
|
||
JZ EORC
|
||
EOR0: ;WRITE TERMINATING RECORD INTO HEX FILE
|
||
LDA DBL ;MAY BE ZERO ALREADY
|
||
ORA A
|
||
CNZ WHEX ;WRITE A,D ;CHECK HO BYTE
|
||
CMP H
|
||
JZ DHEX4 ;BR IF SAME ADDRESS
|
||
;
|
||
DHEX2: ;NON SEQUENTIAL ADDRESS, DUMP AND CHANGE BASE ADDRESS
|
||
CALCURRENT LENGTH
|
||
MOV A,M ;TO ACCUM
|
||
ORA A ;ZERO?
|
||
JZ DHEX3
|
||
;
|
||
; LENGTH NOT ZERO, MAY BE FULL BUFFER
|
||
CPI 16
|
||
JC DHEX1 ;BR IEX VALUE
|
||
MOV A,H ;HIGH ORDER BASE ADDR
|
||
CALL WRC ;WRITE HO BYTE
|
||
MOV A,L ;LOW ORDER BASE ADDR
|
||
CALL WRC ;WRITE LO BYTE
|
||
XRM ASSEMBLER - VER 1.4',CR
|
||
ERROP: DB 'NO SOURCE FILE PRESENT',CR
|
||
ERRMA: DB 'NO DIRECTORY SPACE',CR
|
||
ERRFN: DB 'SOURCE FILE NAMEN
|
||
ANI 0FH
|
||
CALL HEXC ;WRITE LOW NIBBLE
|
||
POP PSW ;RESTORE BYTE
|
||
ADD D ;COMPUTE CHECKSUM
|
||
MOV D,A ;SAVE CS
|
||
RET
|
||
;
|
||
HEXC: ;HEX BUFFER IF NOT ZERO
|
||
LHLD FPC ;GET CURRENT FPC AS LAST ADDRESS
|
||
SHLD BPC ;RECORD LENGTH ZERO, BASE ADDRESS 0000
|
||
CALL WHEXL WHEX
|
||
DHEX3: ;SET NEW BASE
|
||
LHLD FPC
|
||
SHLD BPC
|
||
;
|
||
DHEX4: ;STORE DATA BYTE AND INC DBL
|
||
LXI H,DBL
|
||
MOV E,M ;LENGTH TO REG-F LESS THAN 16 BYTES
|
||
; BUFFER FULL, DUMP IT
|
||
CALL WHEX ;DBL = 0 UPON RETURN
|
||
JMP DHEX3 ;SET BPC AND DATA BYTE
|
||
;
|
||
DHEX1: ;PARA A ;ZERO TO A
|
||
CALL WRC ;WRITE RECORD TYPE 00
|
||
MOV A,E ;CHECK FOR LENGTH 0
|
||
ORA A
|
||
JZ WHEX1
|
||
;
|
||
; NON - ZERO, WRITE DATA BY ERROR',CR
|
||
ERRFR: DB 'SOURCE FILE READ ERROR',CR
|
||
ERRFW: DB 'OUTPUT FILE WRITE ERROR',CR
|
||
ERRCL: DB 'CANNOT CLOSE FILES',CR
|
||
ENWRITE CHARACTER
|
||
ADI 90H
|
||
DAA
|
||
ACI 40H
|
||
DAA
|
||
JMP PNB ;PUT BYTE
|
||
;
|
||
WHEX: ;WRITE CURRENT HEX BUFFER
|
||
MVI A,':' ;RECORD HEAD ;WRITE HEX BUFFER
|
||
;
|
||
; NOW CLEAR OUTPUT BUFFER FOR HEX FILE
|
||
EOR1: LHLD HBP
|
||
MOV A,L
|
||
ORA H
|
||
JZ EORC
|
||
MVI A,EOF
|
||
CALL PNBE
|
||
INR M ;DBL=DBL+1
|
||
MVI D,0 ;HIGH ORDER ZERO FOR DOUBLE ADD
|
||
LXI H,DBUFF
|
||
DAD D ;DBUFF+DBL TO H,L
|
||
POP PSW ;RESTORE DATA BTIAL BUFFER IN PROGRESS, CHECK FOR SEQUENTIAL BYTE LOAD
|
||
LHLD FPC
|
||
XCHG
|
||
LHLD BPC ;BASE PC IN H,L
|
||
MOV C,A ;CURRENT LENGTH OTES
|
||
LXI H,DBUFF
|
||
WHEX0: MOV A,M ;GET BYTE
|
||
INX H
|
||
CALL WRC ;WRITE DATA BYTE
|
||
DCR E ;END OF BUFFER?
|
||
JNZ WHEX0
|
||
;
|
||
; END OFDA: DB 'END OF ASSEMBLY',CR
|
||
;
|
||
DHEX: ;DATA TO HEX BUFFER (BYTE IN REG-A)
|
||
PUSH B
|
||
MOV B,A ;HOLD CHARACTER FOR 'Z' TEST
|
||
LDA ER
|
||
CALL PNB ;PUT BYTE
|
||
LXI H,DBL ;RECORD LENGTH ADDRESS
|
||
MOV E,M ;LENGTH TO REG-E
|
||
XRA A ;ZERO TO REG-A
|
||
MOV D,A ;CLEAR CH
|
||
JMP EOR1
|
||
;
|
||
; CLOSE FILES AND TERMINATE
|
||
EORC:
|
||
CALL NPR
|
||
JZ EORPC
|
||
CALL SELP
|
||
LXI D,PCB
|
||
CALL CLOSE
|
||
EORPC:
|
||
LDA HDISYTE
|
||
MOV M,A ;INTO DATA BUFFER
|
||
POP D
|
||
DHRET: POP B ;ENVIRONMENT RESTORED
|
||
RET
|
||
;
|
||
WRC: ;WRITE CHARACTER WITH CHECK SUM IN D
|
||
F BUFFER
|
||
MVI B,0 ;IS IN B,C
|
||
DAD B ;BPC+DBL TO H,L
|
||
MOV A,E ;READY FOR COMPARE
|
||
CMP L ;EQUAL?
|
||
JNZ DHEX2 ;BR IF NOT
|
||
MOV DATA BYTES, WRITE CHECK SUM
|
||
WHEX1: XRA A
|
||
SUB D ;COMPUTE CHECKSUM
|
||
CALL WRC
|
||
;
|
||
; SEND CRLF AT END OF RECORD
|
||
MVI A,CR
|
||
CAHDISK
|
||
CPI 'Z'-'A'
|
||
MOV A,B ;RECOVER CHARACTER
|
||
JZ DHRET
|
||
PUSH D ;ENVIRONMENT SAVED
|
||
PUSH PSW ;SAVE DATA BYTE
|
||
LXI H,DBL ;ECKSUM
|
||
MOV M,A ;LENGTH IS ZEROED FOR NEXT WRITE
|
||
LHLD BPC ;BASE ADDRESS FOR RECORD
|
||
MOV A,E ;LENGTH TO A
|
||
CALL WRC ;WRITE HK
|
||
CPI 'Z'-'A'
|
||
JZ EORHC
|
||
CALL SELH
|
||
LXI D,HCB
|
||
CALL CLOSE
|
||
;
|
||
EORHC:
|
||
LXI H,ENDA
|
||
CALL PCON
|
||
JMP BOOT
|
||
;
|
||
TITL: DB 'CP/
|
||
PUSH PSW
|
||
RRC
|
||
RRC
|
||
RRC
|
||
RRC
|
||
ANI 0FH
|
||
CALL HEXC ;OUTPUT HEX CHARACTER
|
||
POP PSW ;RESTORE BYTE
|
||
PUSH PSW ;SAVE A VERSIOLL PNB
|
||
MVI A,LF
|
||
CALL PNB
|
||
RET
|
||
;
|
||
;
|
||
;
|
||
ENDMOD EQU ($ AND 0FFE0H)+20H
|
||
END
|
||
FPC+2 ;ASSEMBLER'S PSEUDO PC
|
||
;
|
||
; GLOBAL EQUATES
|
||
IDEN EQU 1 ;IDENTIFIER
|
||
NUMB EQU 2 ;NUMBER
|
||
STRNG EQU 3 ;STRING
|
||
SPECL EQU 4AX PRINT SIZE
|
||
PBUFF EQU 10CH ;PRINT BUFFER
|
||
PBP EQU PBUFF+PBMAX ;PRINT BUFFER POINTER
|
||
;
|
||
TOKEN EQU PBP+1 ;CURRENT TOKEN UDER SLEAR BUFFER
|
||
MVI A,16 ;START OF PRINT LINE
|
||
STA PBP
|
||
RET
|
||
;
|
||
ZERO: XRA A
|
||
STA ACCLEN
|
||
STA STYPE
|
||
RET
|
||
;
|
||
SAVER: ;STORE THE裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹GNC0
|
||
;
|
||
;NOT A CR OR LF, PLACE INTO BUFFER IF THERE IS ENOUGH ROOM
|
||
LDA PBP
|
||
CPI PBMAX
|
||
JNC GNC0
|
||
; ENOUGH ROOM, PLACE INTO裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 ;SPECIAL CHARACTER
|
||
;
|
||
PLABT EQU 0001B ;PROGRAM LABEL
|
||
DLABT EQU 0010B ;DATA LABEL
|
||
EQUT EQU 0100B ;EQUATE
|
||
SETT EQU 0101B ;SETCAN
|
||
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
|
||
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTH
|
||
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
|
||
NEXT CHARACTER INTO THE ACCUMULATOR AND UPDATE ACCLEN
|
||
LXI H,ACCLEN
|
||
MOV A,M
|
||
CPI ACMAX
|
||
JC SAV1 ;JUMP IF NOT UP TO LAST PO TITLE 'ASM SCANNER MODULE'
|
||
ORG 1100H
|
||
JMP ENDMOD ;END OF THIS MODULE
|
||
JMP INITS ;INITIALIZE THE SCANNER
|
||
JMP SCAN ;CALL TH BUFFER
|
||
MOV E,A
|
||
MVI D,0 ;DOUBLE PRECISION PBP IN D,E
|
||
INR A
|
||
STA PBP ;INCREMENTED PBP IN MEMORY
|
||
LXI H,PBUFF
|
||
DAD D ;PBU裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹
|
||
MACT EQU 0110B ;MACRO
|
||
;
|
||
EXTT EQU 1000B ;EXTERNAL
|
||
REFT EQU 1011B ;REFER
|
||
GLBT EQU 1100B ;GLOBAL
|
||
;
|
||
BINV EQU 2
|
||
OCTV EQU 8
|
||
|
||
ACCUM EQU ACCLEN+1
|
||
;
|
||
EVALUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
|
||
;
|
||
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP
|
||
SYMAXSITION
|
||
MVI M,0
|
||
CALL ERRO
|
||
SAV1: MOV E,M ;D,E WILL HOLD INDEX
|
||
MVI D,0
|
||
INR M ;ACCLEN INCREMENTED
|
||
INX H ;ADDRESS ACCUMULAE SCANNER
|
||
;
|
||
;
|
||
; ENTRY POINTS IN I/O MODULE
|
||
IOMOD EQU 200H
|
||
GNCF EQU IOMOD+6H
|
||
WOBUFF EQU IOMOD+15H
|
||
PERR EQU IOMOD+18H
|
||
;
|
||
LFF(PBP)
|
||
POP PSW
|
||
MOV M,A ;PBUFF(PBP) = CHAR
|
||
RET
|
||
GNC0: ;CHAR NOT PLACED INTO BUFFER
|
||
POP PSW
|
||
RET
|
||
;
|
||
INITS: ;INITIALIZE 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹DECV EQU 10
|
||
HEXV EQU 16
|
||
CR EQU 0DH
|
||
LF EQU 0AH
|
||
EOF EQU 1AH
|
||
TAB EQU 09H ;TAB CHARACTER
|
||
;
|
||
;
|
||
; UTILITY SUBROUTINES
|
||
GNC: ;GE EQU SYTOP+2 ;MAX ADDRESS+1
|
||
;
|
||
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
|
||
FPC EQU PASS+1 ;FILL ADDRESS FOR NEXT HEX BYTE
|
||
ASPC EQUTOR
|
||
DAD D ;ADD INDEX TO ACCUMULATOR
|
||
LDA NEXTC ;GET CHARACTER
|
||
MOV M,A ;INTO ACCUMULATOR
|
||
RET
|
||
;
|
||
TDOLL: ;TEST FOR DOLLAR SASTC: DS 1 ;LAST CHAR SCANNED
|
||
NEXTC: DS 1 ;LOOK AHEAD CHAR
|
||
STYPE: DS 1 ;RADIX INDICATOR
|
||
;
|
||
; COMMON EQUATES
|
||
PBMAX EQU 120 ;MTHE SCANNER
|
||
CALL ZERO
|
||
STA NEXTC ;CLEAR NEXT CHARACTER
|
||
STA PBP
|
||
MVI A,LF ;SET LAST CHAR TO LF
|
||
STA LASTC
|
||
CALL WOBUFF ;C裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹T NEXT CHARACTER AND ECHO TO PRINT FILE
|
||
CALL GNCF
|
||
PUSH PSW
|
||
CPI CR
|
||
JZ GNC0
|
||
CPI LF ;IF LF THEN DUMP CURRENT BUFFER
|
||
JZ IGN, ASSUMING H,L ADDRESS NEXTC
|
||
MOV A,M
|
||
CPI '$'
|
||
RNZ
|
||
XRA A ;TO GET A ZERO
|
||
MOV M,A ;CLEARS NEXTC
|
||
RET ;WITH ZERO FLAG NDL
|
||
DEB0: CALL GNCN ;GET NEXT AND STORE TO NEXTC
|
||
JMP DEBL
|
||
;
|
||
; LINE DEBLANKED, FIND TOKEN TYPE
|
||
FINDL: ;LOOK FOR LETTER, DECT TOKEN IN INPUT STREAM
|
||
XRA A
|
||
STA TOKEN
|
||
CALL ZERO
|
||
;
|
||
; DEBLANK
|
||
DEBL: LDA NEXTC
|
||
CPI TAB ;TAB CHARACTER TREATED AS BLANK
|
||
; NOT END OF THE IDENTIFIER
|
||
JMP SCTOK
|
||
;
|
||
SCT2: ;NOT SPECIAL OR IDENT, CHECK NUMBER
|
||
CPI NUMB
|
||
JNZ SCT3
|
||
;
|
||
; ACCUMULATING TTER
|
||
RNZ
|
||
CALL NUMERIC
|
||
RET
|
||
;
|
||
TRANS: ;TRANSLATE TO UPPER CASE
|
||
LDA NEXTC
|
||
CPI 'A' OR 1100000B ;LOWER CASE A
|
||
RC ;CARSTOKEN: STA TOKEN
|
||
;
|
||
;
|
||
; LOOP WHILE CURRENT ITEM IS ACCUMULATING
|
||
SCTOK: LDA NEXTC
|
||
STA LASTC ;SAVE LAST CHARACTER
|
||
ORA A
|
||
SET
|
||
;
|
||
NUMERIC: ;CHECK NEXTC FOR NUMERIC, RETURN ZERO FLAG IF NOT NUMERIC
|
||
LDA NEXTC
|
||
SUI '0'
|
||
CPI 10
|
||
; CARRY RESET IF NUMEIMAL DIGIT, OR STRING QUOTE
|
||
CALL LETTER
|
||
JZ FIND0
|
||
MVI A,IDEN
|
||
JMP STOKEN
|
||
;
|
||
FIND0: CALL NUMERIC
|
||
JZ FIND1
|
||
MVI A,NUMB
|
||
OUTSIDE STRING
|
||
JZ DEB0
|
||
CPI ';' ;MAY BE A COMMENT
|
||
JZ DEB1 ;DEBLANK THROUGH COMMENT
|
||
CPI '*' ;PROCESSOR TECH COMMENT
|
||
JNZA NUMBER, CHECK FOR $
|
||
CALL TDOLL
|
||
JZ SCTOK ;SKIP IF FOUND
|
||
CALL HEX ;HEX CHARACTER?
|
||
JNZ SCTOK ;STORE IT IF FOUND
|
||
; END OFRY IF LESS THAN LOWER A
|
||
CPI ('Z' OR 1100000B)+1 ;LOWER CASE Z
|
||
RNC ;NO CARRY IF GREATER THAN LOWER Z
|
||
ANI 1011111B ;CONVCNZ SAVER ;STORE CHARACTER INTO ACCUM IF NOT ZERO
|
||
CALL GNCN ;GET NEXT TO NEXTC
|
||
LDA TOKEN
|
||
CPI SPECL
|
||
RZ ;RETURN IF SPECIARIC
|
||
RAL
|
||
ANI 1B ;ZERO IF NOT NUMERIC
|
||
RET
|
||
;
|
||
HEX: ;RETURN ZERO FLAG IF NEXTC IS NOT HEXADECIMAL
|
||
CALL NUMERIC
|
||
RNZ ;RETU JMP STOKEN
|
||
;
|
||
FIND1: LDA NEXTC
|
||
CPI ''''
|
||
JNZ FIND2
|
||
XRA A
|
||
STA NEXTC ;DON'T STORE THE QUOTE
|
||
MVI A,STRNG
|
||
JMP STOKEN
|
||
; DEB2 ;NOT *
|
||
LDA LASTC
|
||
CPI LF ;LAST LINE FEED?
|
||
JNZ DEB2 ;NOT LF*
|
||
; COMMENT FOUND, REMOVE IT
|
||
DEB1: CALL GNCN
|
||
CALL EOLT NUMBER, LOOK FOR RADIX INDICATOR
|
||
;
|
||
LDA NEXTC
|
||
CPI 'O' ;OCTAL INDICATOR
|
||
JZ NOCT
|
||
CPI 'Q' ;OCTAL INDICATOR
|
||
JNZ NUM2
|
||
;
|
||
ERT TO UPPER CASE
|
||
STA NEXTC
|
||
RET
|
||
;
|
||
GNCN: ;GET CHARACTER AND STORE TO NEXTC
|
||
CALL GNC
|
||
STA NEXTC
|
||
CALL TRANS ;TRANSLATE TL CHARACTER
|
||
CPI STRNG
|
||
CNZ TRANS ;TRANSLATE TO UPPER CASE IF NOT IN STRING
|
||
LXI H,NEXTC
|
||
LDA TOKEN
|
||
;
|
||
CPI IDEN
|
||
JNZ SCT2RNS IF 0-9
|
||
LDA NEXTC
|
||
SUI 'A'
|
||
CPI 6
|
||
; CARRY SET IF OUT OF RANGE
|
||
RAL
|
||
ANI 1B
|
||
RET
|
||
;
|
||
LETTER: ;RETURN ZERO FLAG IF NEXT
|
||
FIND2: ;ASSUME IT IS A SPECIAL CHARACTER
|
||
CPI LF ;IF LF THEN DUMP THE BUFFER
|
||
JNZ FIND3
|
||
; LF FOUND
|
||
LDA PASS
|
||
ORA A
|
||
CNZ;CR, EOF, OR !
|
||
JZ FINDL ;HANDLE END OF LINE
|
||
JMP DEB1 ;OTHERWISE CONTINUE SCAN
|
||
DEB2: ORI ' ' ;MAY BE ZERO
|
||
CPI ' '
|
||
JNZ FINOCT: ;OCTAL
|
||
MVI A,OCTV
|
||
JMP SSTYP
|
||
;
|
||
NUM2: CPI 'H'
|
||
JNZ NUM3
|
||
MVI A,HEXV
|
||
SSTYP: STA STYPE
|
||
XRA A
|
||
STA NEXTC ;CLEARS THO UPPER CASE
|
||
RET
|
||
;
|
||
EOLT: ;END OF LINE TEST FOR COMMENT SCAN
|
||
CPI CR
|
||
RZ
|
||
CPI EOF
|
||
RZ
|
||
CPI '!'
|
||
RET
|
||
;
|
||
SCAN: ;FIND NEX
|
||
;
|
||
; ACCUMULATING AN IDENTIFIER
|
||
CALL TDOLL ;$?
|
||
JZ SCTOK ;IF SO, SKIP IT
|
||
CALL ALNUM ;ALPHA NUMERIC?
|
||
RZ ;RETURN IF END
|
||
C IS NOT A LETTER
|
||
LDA NEXTC
|
||
SUI 'A'
|
||
CPI 26
|
||
RAL
|
||
ANI 1B
|
||
RET
|
||
;
|
||
ALNUM: ;RETURN ZERO FLAG IF NOT ALPHANUMERIC
|
||
CALL LE WOBUFF
|
||
LXI H,PBUFF ;CLEAR ERROR CHAR ON BOTH PASSES
|
||
MVI M,' '
|
||
MVI A,16
|
||
STA PBP ;START NEW LINE
|
||
FIND3: MVI A,SPECL
|
||
;
|
||
E LOOKAHEAD CHARACTER
|
||
JMP NCON
|
||
;
|
||
; RADIX MUST COME FROM ACCUM
|
||
NUM3: LDA LASTC
|
||
CPI 'B'
|
||
JNZ NUM4
|
||
MVI A,BINV
|
||
JMP SSTY1 MVI A,'O'
|
||
JMP ERR
|
||
;
|
||
ERR: ;PRINT ERROR MESSAGE
|
||
PUSH B
|
||
PUSH H
|
||
CALL PERR
|
||
POP H
|
||
POP B
|
||
POP PSW
|
||
RET
|
||
;
|
||
ENDMOD EQU LOP4: ;END OF NUMBER CONVERSION
|
||
DAD B ;DIGIT ADDED IN
|
||
SHLD VALUE
|
||
POP B
|
||
POP H
|
||
DCR C ;MORE DIGITS?
|
||
JNZ CLOP
|
||
RET ;DOUE OF NUMBER IN BINARY
|
||
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTH
|
||
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
|
||
ACCUM EQU ACCLEN+1
|
||
;
|
||
EVAPUSH H ;SAVE ACCUM ADDR
|
||
PUSH B ;SAVE CURRENT POSITION
|
||
MOV C,A
|
||
LXI H,STYPE
|
||
CMP M
|
||
CNC ERRV ;VALUE ERROR IF DIGIT>=RADIX
|
||
TITLE 'ASM SYMBOL TABLE MODULE'
|
||
; SYMBOL TABLE MANIPULATION MODULE
|
||
;
|
||
ORG 1340H
|
||
IOMOD EQU 200H ;IO MODULE ENTRY POINT
|
||
PCON
|
||
;
|
||
NUM4: CPI 'D'
|
||
MVI A,DECV
|
||
JNZ SSTY2
|
||
SSTY1: LXI H,ACCLEN
|
||
DCR M ;ACCLEN DECREMENTED TO REMOVE RADIX INDICATOR
|
||
SSTY2: S($ AND 0FFE0H) + 20H
|
||
END
|
||
NE WITH THE NUMBER
|
||
;
|
||
SCT3: ;MUST BE A STRING
|
||
LDA NEXTC
|
||
CPI CR ;END OF LINE?
|
||
JZ ERRO ;AND RETURN
|
||
CPI ''''
|
||
JNZ SCTOK
|
||
LUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
|
||
;
|
||
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP
|
||
SYMAX EQU SYTOP+2 ;MAX ADDRESS+
|
||
MVI B,0 ;DOUBLE PRECISION DIGIT
|
||
MOV A,M ;RADIX TO ACCUMULATOR
|
||
LHLD VALUE
|
||
XCHG ;VALUE TO D,E - ACCUMULATE RESULT IN H,L
|
||
EQU IOMOD+12H
|
||
EOR EQU IOMOD+1EH
|
||
;
|
||
;
|
||
; ENTRY POINTS TO SYMBOL TABLE MODULE
|
||
JMP ENDMOD
|
||
JMP INISY
|
||
JMP LOOKUP
|
||
JMP FOUNDTA STYPE
|
||
;
|
||
NCON: ;NUMERIC CONVERSION OCCURS HERE
|
||
LXI H,0
|
||
SHLD VALUE ;VALUE ACCUMULATES BINARY EQUIVALENT
|
||
LXI H,ACCLEN
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 CALL GNCN
|
||
CPI ''''
|
||
RNZ ;RETURN IF SINGLE QUOTE ENCOUNTERED
|
||
JMP SCTOK ;OTHERWISE TREAT AS ONE QUOTE
|
||
;
|
||
; END OF SCANNER
|
||
1
|
||
;
|
||
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
|
||
FPC EQU PASS+1 ;FILL ADDRESS FOR NEXT HEX BYTE
|
||
ASPC EQU FPC+2 ;ASSEMBLER'S PSEUDO
|
||
LXI H,0 ;ZERO ACCUMULATOR
|
||
CLOP3: ;LOOP UNTIL RADIX GOES TO ZERO
|
||
ORA A
|
||
JZ CLOP4
|
||
RAR ;TEST LSB
|
||
JNC TTWO ;SKIP SUMMING
|
||
JMP ENTER
|
||
JMP SETTY
|
||
JMP GETTY
|
||
JMP SETVAL
|
||
JMP GETVAL
|
||
;
|
||
; COMMON EQUATES
|
||
PBMAX EQU 120 ;MAX PRINT SIZE
|
||
PBUFF EQU 10MOV C,M ;C=ACCLEN
|
||
INX H ;ADDRESSES ACCUM
|
||
CLOP: ;NEXT DIGIT IS PROCESSED HERE
|
||
MOV A,M
|
||
INX H ;READY FOR NEXT LOOP
|
||
CPI 'A'裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹
|
||
;
|
||
; ERROR MESSAGE ROUTINES
|
||
ERRV: ;'V' VALUE ERROR
|
||
PUSH PSW
|
||
MVI A,'V'
|
||
JMP ERR
|
||
;
|
||
ERRO: ;'O' OVERFLOW ERROR
|
||
PUSH PSW
|
||
PC
|
||
SYBAS EQU ASPC+2 ;BASE OF SYMBOL TABLE
|
||
SYADR EQU SYBAS+2 ;CURRENT SYMBOL BEING ACCESSED
|
||
;
|
||
; GLOBAL EQUATES
|
||
IDEN EQU 1 ;IOPERATION IF LSB=0
|
||
DAD D ;ADD IN VALUE
|
||
TTWO: ;MULTIPLY VALUE * 2 FOR SHL OPERATION
|
||
XCHG
|
||
DAD H
|
||
XCHG
|
||
JMP CLOP3
|
||
;
|
||
;
|
||
CCH ;PRINT BUFFER
|
||
PBP EQU PBUFF+PBMAX ;PRINT BUFFER POINTER
|
||
;
|
||
TOKEN EQU PBP+1 ;CURRENT TOKEN UDER SCAN
|
||
VALUE EQU TOKEN+1 ;VAL
|
||
JNC CLOP1 ;NOT HEX A-F
|
||
SUI '0' ;NORMALIZE
|
||
JMP CLOP2
|
||
;
|
||
CLOP1: ;HEX A-F
|
||
SUI 'A'-10
|
||
CLOP2: ;CHECK SIZE AGAINST RADIX
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹DENTIFIER
|
||
NUMB EQU 2 ;NUMBER
|
||
STRNG EQU 3 ;STRING
|
||
SPECL EQU 4 ;SPECIAL CHARACTER
|
||
;
|
||
PLABT EQU 0001B ;PROGRAM LABEL
|
||
DLABT EQUIELD (MACROS ARE NOT CURRENTLY IMPLEMENTED).
|
||
;
|
||
; THE TYPE FIELD CONSISTS OF FOUR BITS WHICH ARE ASSIGNED AS
|
||
; FOLLOWS:
|
||
;
|
||
; DESCRIBES
|
||
; THE ENTRY TYPE (GIVEN BELOW), LENG IS THE NUMBER OF CHARACTERS IN
|
||
; THE SYMBOL PRINTNAME -1 (I.E., LENG=0 IS A SI: INX H ;MOVE TO FIRST/NEXT CHARACTER POSITION
|
||
ADD M ;ADD WITH OVERFLOW
|
||
DCR B
|
||
JNZ CH0
|
||
ANI HMASK ;MASK BITS FOR MODULO HZENTRY FORMAT IS
|
||
; -----------------
|
||
; : HIGH VAL BYTE :
|
||
; -----------------
|
||
; : LOW VAL BYTE :
|
||
; -----------------
|
||
;B ;SET
|
||
MACT EQU 0110B ;MACRO
|
||
;
|
||
EXTT EQU 1000B ;EXTERNAL ATTRIBUTE
|
||
REFT EQU 1011B ;REFER
|
||
GLBT EQU 1100B ;GLOBAL ATTRIBUTE
|
||
; 0010B ;DATA LABEL
|
||
EQUT EQU 0100B ;EQUATE
|
||
SETT EQU 0101B ;SET
|
||
MACT EQU 0110B ;MACRO
|
||
;
|
||
EXTT EQU 1000B ;EXTERNAL
|
||
REFT EQU 10 0000 UNDEFINED SYMBOL
|
||
; 0001 LOCAL LABELLED PROGRAM
|
||
; 0010 LOCAL LABELLED DATA
|
||
; 0011 (UNUSED)
|
||
; 0100 EQUATE
|
||
; 0101 NGLE CHARACTER PRINT-
|
||
; NAME, WHILE LENG=15 INDICATES A 16 CHARACTER NAME). CHARACTER 1
|
||
; THROUGH N GIVE THE PRINTNAME CHARACISE
|
||
STA HASHC ;FILL HASHC WITH RESULT
|
||
RET
|
||
;
|
||
SETLN: ;SET THE LENGTH FIELD OF THE CURRENT SYMBOL
|
||
MOV B,A ;SAVE LENGTH IN B : CHARACTER N :
|
||
; -----------------
|
||
; : ... :
|
||
; -----------------
|
||
; : CHARACTER 1 :
|
||
; -----------------
|
||
; : TY
|
||
;
|
||
INISY: ;INITIALIZE THE SYMBOL TABLE
|
||
LXI H,HASHT ;ZERO THE HASH TABLE
|
||
MVI B,HSIZE
|
||
XRA A ;CLEAR ACCUM
|
||
INI0:
|
||
MOV M,A
|
||
11B ;REFER
|
||
GLBT EQU 1100B ;GLOBAL
|
||
;
|
||
;
|
||
CR EQU 0DH
|
||
;
|
||
; DATA AREAS
|
||
; SYMBOL TABLE BEGINS AT THE END OF THIS MODULE
|
||
FIXD EQU SET
|
||
; 0110 MACRO
|
||
; 0111 (UNUSED)
|
||
;
|
||
; 1000 (UNUSED)
|
||
; 1001 EXTERN LABELLED PROGRAM
|
||
; 1010 EXTERN LABELLED DATA
|
||
; TERS IN ASCII UPPER CASE (ALL
|
||
; LOWER CASE NAMES ARE TRANSLATED ON INPUT), AND THE LOW/HIGH VALUE
|
||
; GIVE THE PARTICULAR ADDRES
|
||
LHLD SYADR
|
||
INX H
|
||
INX H
|
||
MOV A,M ;GET TYPE/LENGTH FIELD
|
||
ANI 0F0H ;MASK OUT TYPE FIELD
|
||
ORA B ;MASK IN LENGTH
|
||
MOV M,APE : LENG :
|
||
; -----------------
|
||
; : HIGH COLLISION:
|
||
; -----------------
|
||
; SYADR= : LOW COLLISION :
|
||
; -----------------
|
||
INX H
|
||
MOV M,A ;CLEAR DOUBLE WORD
|
||
INX H
|
||
DCR B
|
||
JNZ INI0
|
||
;
|
||
; SET SYMBOL TABLE POINTERS
|
||
LXI H,0
|
||
SHLD SYADR
|
||
;
|
||
RET
|
||
5 ;5 BYTES OVERHEAD WITH EACH SYMBOL ENTRY
|
||
; 2BY COLLISION, 1BY TYPE/LEN, 2BY VALUE
|
||
HSIZE EQU 128 ;HASH TABLE SIZE
|
||
HMASK E 1011 REFERENCE TO MODULE
|
||
; 1100 (UNUSED)
|
||
; 1101 GLOBAL UNDEFINED SYMBOL
|
||
; 1110 GLOBAL LABELLED PROGRAM
|
||
; 1111 (UNUSES OR CONSTANT VALUE ASSOCIATED WITH THE
|
||
; NAME. THE REPRESENTATION OF MACROS DIFFERS IN THE FIELDS WHICH
|
||
; FOLLOW THE VALUE F
|
||
RET
|
||
;
|
||
GETLN: ;GET THE LENGTH FIELD TO REG-A
|
||
LHLD SYADR
|
||
INX H
|
||
INX H
|
||
MOV A,M
|
||
ANI 0FH
|
||
INR A ;LENGTH IS STORED AS V
|
||
;
|
||
; WHERE THE LOW/HIGH COLLISION FIELD ADDRESSES ANOTHER ENTRY WITH
|
||
; THE SAME HASH CODE (OR ZERO IF THE END OF CHAIN), TYPE
|
||
;
|
||
CHASH: ;COMPUTE HASH CODE FOR CURRENT ACCUMULATOR
|
||
LXI H,ACCLEN
|
||
MOV B,M ;GET ACCUM LENGTH
|
||
XRA A ;CLEAR ACCUMULATOR
|
||
CH0QU HSIZE-1 ;HASH MASK FOR CODING
|
||
HASHT: DS HSIZE*2 ;HASH TABLE
|
||
HASHC: DS 1 ;HASH CODE AFTER CALL ON LOOKUP
|
||
;
|
||
; SYMBOL TABLE D)
|
||
;
|
||
; TYPE DEFINITIONS
|
||
;
|
||
PLABT EQU 0001B ;PROGRAM LABEL
|
||
DLABT EQU 0010B ;DATA LABEL
|
||
EQUT EQU 0100B ;EQUATE
|
||
SETT EQU 0101ALUE - 1
|
||
RET
|
||
;
|
||
FOUND: ;FOUND RETURNS TRUE IF SYADR IS NOT ZERO (TRUE IS NZ FLAG HERE)
|
||
LHLD SYADR
|
||
MOV A,L
|
||
ORA H
|
||
RET
|
||
ALUE
|
||
MOV A,E
|
||
SUB L ;COMPUTE 16-BIT DIFFERENCE
|
||
MOV A,D
|
||
SBB H
|
||
XCHG ;NEW SYTOP IN H,L
|
||
JNC OVERER ;OVERFLOW IN TABLE
|
||
; RET
|
||
;
|
||
LCOMP: ;NOT FOUND, MOVE SYADR DOWN ONE COLLISION ADDRESS
|
||
LHLD SYADR
|
||
MOV E,M
|
||
INX H
|
||
MOV D,M ;COLLISION ADDRESS IND
|
||
MOV M,A ;STORE LENGTH WITH UNDEFINED TYPE (0000)
|
||
ENT2: INX H
|
||
INX D
|
||
LDAX D
|
||
MOV M,A ;STORE NEXT CHARACTER OF PRINTNAME
|
||
ERWISE EXAMINE CHARACTER STRING FOR MATCH
|
||
CALL GETLN ;GET LENGTH TO REG-A
|
||
LXI H,ACCLEN
|
||
CMP M
|
||
JNZ LCOMP
|
||
;
|
||
; LENGTH MATCEADER TO HASH TABLE
|
||
XCHG ;H,L HOLDS SYMBOL TABLE ADDRESS
|
||
MOV M,C ;LOW ORDER OLD HEADER TO COLLISION FIELD
|
||
INX H
|
||
MOV M,B;
|
||
LOOKUP: ;LOOK FOR SYMBOL IN ACCUMULATOR
|
||
CALL CHASH ;COMPUTE HASH CODE
|
||
; NORMALIZE IDENTIFIER TO 16 CHARACTERS
|
||
LXI H,ACCL
|
||
; OTHERWISE NO ERROR
|
||
SHLD SYTOP ;SET NEW TABLE TOP
|
||
LHLD SYADR ;SET COLLISION FIELD
|
||
XCHG ;CURRENT SYMBOL ADDRESS TO D,E
|
||
D,E
|
||
XCHG
|
||
JMP LOOK0
|
||
;
|
||
;
|
||
ENTER: ;ENTER SYMBOL IN ACCUMULATOR
|
||
; ENSURE THERE IS ENOUGH SPACE IN THE TABLE
|
||
LXI H,ACCLEN
|
||
|
||
DCR B ;LENGTH=LENGTH-1
|
||
JNZ ENT2 ;FOR ANOTHER CHARACTER
|
||
;
|
||
; PRINTNAME COPIED, ZERO THE VALUE FIELD
|
||
XRA A ;ZERO A
|
||
INX H H, TRY TO MATCH CHARACTERS
|
||
MOV B,A ;STRING LENGTH IN B
|
||
INX H ;HL ADDRESSES ACCUM
|
||
XCHG ;TO D,E
|
||
LHLD SYADR
|
||
INX H
|
||
INX ;HIGH ORDER OLD HEADER TO COLLISION FIELD
|
||
;
|
||
; HASH CHAIN NOW REPAIRED FOR THIS ENTRY, COPY THE PRINTNAME
|
||
LXI D,ACCLEN
|
||
LDAEN
|
||
MOV A,M
|
||
CPI 17
|
||
JC LENOK
|
||
MVI M,16
|
||
LENOK:
|
||
; LOOK FOR SYMBOL THROUGH HASH TABLE
|
||
LXI H,HASHC
|
||
MOV E,M
|
||
MVI D,0 ;DOU
|
||
LXI H,HASHC ;HASH CODE FOR CURRENT SYMBOL TO H,L
|
||
MOV C,M ;LOW BYTE
|
||
MVI B,0 ;DOUBLE PRECISION VALUE IN B,C
|
||
LXI H,HASHT ;B MOV E,M
|
||
MVI D,0 ;DOUBLE PRECISION ACCLEN IN D,E
|
||
LHLD SYTOP
|
||
SHLD SYADR ;NEXT SYMBOL LOCATION
|
||
DAD D ;SYTOP+ACCLEN
|
||
LXI D;LOW ORDER VALUE
|
||
MOV M,A
|
||
INX H
|
||
MOV M,A ;HIGH ORDER VALUE
|
||
RET
|
||
;
|
||
OVERER: ;OVERFLOW IN SYMBOL TABLE
|
||
LXI H,ERRO
|
||
CALL PH
|
||
INX H ;ADDRESSES CHARACTERS
|
||
LOOK1: LDAX D ;NEXT CHARACTER FROM ACCUM
|
||
CMP M ;NEXT CHARACTER IN SYMBOL TABLE
|
||
JNZ LCOMP
|
||
;X D ;GET SYMBOL LENGTH
|
||
CPI 17 ;LARGER THAN 16 SYMBOLS?
|
||
JC ENT1
|
||
MVI A,16 ;TRUNCATE TO 16 CHARACTERS
|
||
; COPY LENGTH FIELD, FBLE HASH CODE IN D,E
|
||
LXI H,HASHT ;BASE OF HASH TABLE
|
||
DAD D
|
||
DAD D ;HASHT(HASHC)
|
||
MOV E,M ;LOW ORDER ADDRESS
|
||
INX H
|
||
MOV ASE OF HASH TABLE
|
||
DAD B
|
||
DAD B ;HASHT(HASHC) IN H,L
|
||
; D,E ADDRESSES CURRENT SYMBOL - CHANGE LINKS
|
||
MOV C,M ;LOW ORDER OLD H,FIXD ;FIXED DATA/SYMBOL
|
||
DAD D ;HL HAS NEXT TABLE LOCATION FOR SYMBOL
|
||
XCHG ;NEW SYTOP IN D,E
|
||
LHLD SYMAX ;MAXIMUM SYMTOP VCON
|
||
JMP EOR ;END OF EXECUTION
|
||
ERRO: DB 'SYMBOL TABLE OVERFLOW',CR
|
||
;
|
||
SETTY: ;SET CURRENT SYMBOL TYPE TO VALUE IN REG-A
|
||
RAL CHARACTER MATCHED, INCREMENT TO NEXT
|
||
INX D
|
||
INX H
|
||
DCR B
|
||
JNZ LOOK1
|
||
;
|
||
; COMPLETE MATCH AT CURRENT SYMBOL, SYADR IS SET
|
||
OLLOWED BY PRINTNAME CHARACTERS
|
||
ENT1: MOV B,A ;COPY LENGTH TO B
|
||
DCR A ;1-16 CHANGED TO 0-15
|
||
INX H ;FOLLOWING COLLISION FIELH,M
|
||
MOV L,E ;HEADER TO LIST OF SYMBOLS IS IN H,L
|
||
LOOK0: SHLD SYADR
|
||
CALL FOUND
|
||
RZ ;RETURN IF SYADR BECOMES ZERO
|
||
;
|
||
; OTHEADER
|
||
INX H
|
||
MOV B,M ;HIGH ORDER OLD HEADER
|
||
MOV M,D ;HIGH ORDER NEW HEADER TO HASH TABLE
|
||
DCX H
|
||
MOV M,E ;LOW ORDER NEW H
|
||
RAL
|
||
RAL
|
||
RAL
|
||
ANI 0F0H ;TYPE MOVED TO HIGH ORDER 4-BITS
|
||
MOV B,A ;SAVE IT IN B
|
||
LHLD SYADR ;BASE OF SYMBOL TO ACCESS
|
||
120 ;MAX PRINT SIZE
|
||
PBUFF EQU 10CH ;PRINT BUFFER
|
||
PBP EQU PBUFF+PBMAX ;PRINT BUFFER POINTER
|
||
;
|
||
TOKEN EQU PBP+1 ;CURRENT TOKEN裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹EQU OBASE+3 ;DAD
|
||
O4 EQU OBASE+4 ;PUSH/POP
|
||
O5 EQU OBASE+5 ;JMP/CALL
|
||
O6 EQU OBASE+6 ;MOV
|
||
O7 EQU OBASE+7 ;MVI
|
||
O8 EQU OBASE+8 ;LD
|
||
INX H ;FOR TYPE/LEN FIELD
|
||
RET ;WITH H,L ADDRESSING VALUE FIELD
|
||
;
|
||
SETVAL: ;SET THE VALUE FIELD OF THE CURRENT SYMBOL
|
||
;L EQU 4 ;SPECIAL CHARACTER
|
||
;
|
||
PLABT EQU 0001B ;PROGRAM LABEL
|
||
DLABT EQU 0010B ;DATA LABEL
|
||
EQUT EQU 0100B ;EQUATE
|
||
SETT EQU 010INX H
|
||
INX H ;ADDRESS OF TYPE/LENGTH FIELD
|
||
MOV A,M ;GET IT AND MASK
|
||
ANI 0FH ;LEAVE LENGTH
|
||
ORA B ;MASK IN TYPE
|
||
MOV M,A ; UDER SCAN
|
||
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
|
||
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTH
|
||
ACMAX EQU 64 ;MAX ACCUMULATOR 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹ACC IMMEDIATE
|
||
O9 EQU OBASE+9 ;LDAX/STAX
|
||
O10 EQU OBASE+10 ;LHLD/SHLD/LDA/STA
|
||
O11 EQU OBASE+11 ;ACCUM REGISTER
|
||
O12 EQU OBASE+1 VALUE IS SENT IN H,L
|
||
PUSH H ;SAVE VALUE TO SET
|
||
CALL VALADR
|
||
POP D ;POP VALUE TO SET, HL HAS ADDRESS TO FILL
|
||
MOV M,E
|
||
IN1B ;SET
|
||
MACT EQU 0110B ;MACRO
|
||
;
|
||
EXTT EQU 1000B ;EXTERNAL
|
||
REFT EQU 1011B ;REFER
|
||
GLBT EQU 1100B ;GLOBAL
|
||
;
|
||
;
|
||
CR EQU 0DH ;CASTORE IT
|
||
RET
|
||
;
|
||
GETTY: ;RETURN THE TYPE OF THE VALUE IN CURRENT SYMBOL
|
||
LHLD SYADR
|
||
INX H
|
||
INX H
|
||
MOV A,M
|
||
RAR
|
||
RAR
|
||
RLENGTH
|
||
ACCUM EQU ACCLEN+1
|
||
;
|
||
EVALUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
|
||
;
|
||
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹2 ;INC/DEC
|
||
O13 EQU OBASE+13 ;INX/DCX
|
||
O14 EQU OBASE+14 ;RST
|
||
O15 EQU OBASE+15 ;IN/OUT
|
||
;
|
||
; X1 THROUGH X15 DENOTE OPERATORS
|
||
X1X H
|
||
MOV M,D ;FIELD SET
|
||
RET
|
||
;
|
||
GETVAL: ;GET THE VALUE FIELD OF THE CURRENT SYMBOL TO H,L
|
||
CALL VALADR ;ADDRESS OF VALUE FIERRIAGE RETURN
|
||
;
|
||
;
|
||
; TABLE DEFINITIONS
|
||
;
|
||
; TYPES
|
||
XBASE EQU 0 ;START OF OPERATORS
|
||
; O1 THROUGH O15 DENOTE OPERATIONS
|
||
RT EQAR
|
||
RAR
|
||
ANI 0FH ;TYPE MOVED TO LOW 4-BITS OF REG-A
|
||
RET
|
||
;
|
||
VALADR: ;GET VALUE FIELD ADDRESS FOR CURRENT SYMBOL
|
||
CALL GETLN
|
||
SYMAX EQU SYTOP+2 ;MAX ADDRESS+1
|
||
;
|
||
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
|
||
FPC EQU PASS+1 ;FILL ADDRESS FOR NEXT HEX BYTE
|
||
A TITLE 'ASM TABLE SEARCH MODULE'
|
||
ORG 15A0H
|
||
JMP ENDMOD ;TO NEXT MODULE
|
||
JMP BSEAR
|
||
JMP BGET
|
||
;
|
||
; COMMON EQUATES
|
||
PBMAX EQU EQU XBASE ;*
|
||
X2 EQU XBASE+1 ;/
|
||
X3 EQU XBASE+2 ;MOD
|
||
X4 EQU XBASE+3 ;SHL
|
||
X5 EQU XBASE+4 ;SHR
|
||
X6 EQU XBASE+5 ;+
|
||
X7 EQU XBASELD TO H,L
|
||
MOV E,M
|
||
INX H
|
||
MOV D,M
|
||
XCHG
|
||
RET
|
||
;
|
||
ENDMOD EQU ($ AND 0FFE0H) + 20H
|
||
END
|
||
U 16
|
||
PT EQU RT+1 ;RT IS REGISTER TYPE, PT IS PSEUDO OPERATION
|
||
OBASE EQU PT+1
|
||
O1 EQU OBASE+1 ;SIMPLE
|
||
O2 EQU OBASE+2 ;LXI
|
||
O3 ;PRINTNAME LENGTH TO ACCUM
|
||
LHLD SYADR ;BASE ADDRESS
|
||
MOV E,A
|
||
MVI D,0
|
||
DAD D ;BASE(LEN)
|
||
INX H
|
||
INX H ;FOR COLLISION FIESPC EQU FPC+2 ;ASSEMBLER'S PSEUDO PC
|
||
;
|
||
; GLOBAL EQUATES
|
||
IDEN EQU 1 ;IDENTIFIER
|
||
NUMB EQU 2 ;NUMBER
|
||
STRNG EQU 3 ;STRING
|
||
SPEC+6 ;-
|
||
X8 EQU XBASE+7 ;UNARY -
|
||
X9 EQU XBASE+8 ;NOT
|
||
X10 EQU XBASE+9 ;AND
|
||
X11 EQU XBASE+10;OR
|
||
X12 EQU XBASE+11;XOR
|
||
X13 EQU XB;DB DI
|
||
DB PT,2, PT,3 ;DS DW
|
||
DB O1,0FBH, PT,8 ;EI IF
|
||
DB O15,0DBH, X11,40 ;IN OR
|
||
DB RT,6 ;SP
|
||
;
|
||
;
|
||
TV3: ;TYPE,VALUBSBISETSHL'
|
||
DB 'SHRSTASTCSUB'
|
||
DB 'SUIXORXRAXRI'
|
||
;
|
||
CHAR4: DB 'CALLENDMLDAXLHLDPCHL'
|
||
DB 'PUSHSHLDSPHLSTAX'
|
||
DB 'XCHGXTHL' ;SPHL STAX
|
||
DB O1,0EBH, O1,0E3H ;XCHG XTHL
|
||
;
|
||
TV5: ;TYPE,VALUE PAIRS FOR CHAR5 VECTOR
|
||
DB PT,5, PT,9 ;ENDIF MACRO
|
||
DB PAR6-CHAR5)/5
|
||
;
|
||
TVINX: ;TABLE OF TYPE,VALUE PAIRS FOR EACH RESERVED SYMBOL
|
||
DW TV1
|
||
DW TV2
|
||
DW TV3
|
||
DW TV4
|
||
DW TV5
|
||
;
|
||
; CH ;ORI OUT
|
||
DB O4,0C1H, RT,6 ;POP PSW
|
||
DB O1,17H, O1,1FH ;RAL RAR
|
||
DB O1,0C9H, O1,07H ;RET RLC
|
||
DB O1,0FH, O14,0C7H ;RRASE+12;(
|
||
X14 EQU XBASE+13;)
|
||
X15 EQU XBASE+14;,
|
||
X16 EQU XBASE+15;CR
|
||
;
|
||
;
|
||
;
|
||
;
|
||
; RESERVED WORD TABLES
|
||
;
|
||
; BASE ADDRESS VECE PAIRS FOR CHAR3 VECTOR
|
||
DB O8,0CEH, O11,88H ;ACI ADC
|
||
DB O11,80H, O8,0C6H ;ADD ADI
|
||
DB O11,0A0H, X10,50 ;ANA AND
|
||
DB O8
|
||
;
|
||
CHAR5: DB 'ENDIFMACROTITLE'
|
||
;
|
||
CHAR6: ;END OF CHARACTER VECTOR
|
||
;
|
||
TV1: ;TYPE,VALUE PAIRS FOR CHAR1 VECTOR
|
||
DB X16,10, XT,12 ;TITLE
|
||
;
|
||
SUFTAB: ;TABLE OF SUFFIXES FOR J C AND R OPERATIONS
|
||
DB 'NZZ NCC POPEP M '
|
||
;
|
||
BSEAR: ;BINARY SEARCH MNEMONIHARACTER VECTORS FOR 1,2,3,4, AND 5 CHARACTER NAMES
|
||
CHAR1: DB CR,'()*'
|
||
DB '+'
|
||
DB ',-/A'
|
||
DB 'BCDE'
|
||
DB 'HLM'
|
||
;
|
||
CHAR2: DC RST
|
||
DB O11,098H, O8,0DEH ;SBB SBI
|
||
DB PT,11, X4,80 ;SET SHL
|
||
DB X5,80, O10,32H ;STA STC
|
||
DB O1,37H, O11,90H ;STC STOR FOR CHARACTERS
|
||
CINX: DW CHAR1 ;LENGTH 1 BASE
|
||
DW CHAR2 ;LENGTH 2 BASE
|
||
DW CHAR3 ;LENGTH 3 BASE
|
||
DW CHAR4 ;LENGTH 4 BASE
|
||
,0E6H, O1,2FH ;ANI CMA
|
||
DB O1,3FH, O11,0B8H ;CMC CMP
|
||
DB O8,0FEH, O1,27H ;CPI DAA
|
||
DB O3,09H, O12,05H ;DAD DCR
|
||
DB O13,13,20 ;CR (
|
||
DB X14,30, X1,80 ;) *
|
||
DB X6,70 ;+
|
||
DB X15,10, X7,70 ;, -
|
||
DB X2,80, RT,7 ;/ A
|
||
DB RT,0, RT,1 ;B CC TABLE
|
||
; INPUT: UR = UPPER BOUND OF TABLE (I.E., TABLE LENGTH-1)
|
||
; SR = SIZE OF EACH TABLE ELEMENT
|
||
; H,L ADDRESS BASE OF TB 'DBDIDSDW'
|
||
DB 'EIIFINOR'
|
||
DB 'SP'
|
||
;
|
||
CHAR3: DB 'ACIADCADDADI'
|
||
DB 'ANAANDANICMA'
|
||
DB 'CMCCMPCPIDAA'
|
||
DB 'DADDCRDCXEND'
|
||
UB
|
||
DB O8,0D6H, X12,40 ;SUI XOR
|
||
DB O11,0A8H, O8,0EEH ;XRA XRI
|
||
;
|
||
;
|
||
TV4: ;TYPE,VALUE PAIRS FOR CHAR4 VECTOR
|
||
DB O5,0CDH
|
||
DW CHAR5 ;LENGTH 5 BASE
|
||
DW CHAR6 ;LENGTH 6 BASE
|
||
;
|
||
CMAX EQU ($-CINX)/2-1 ;LARGEST STRING TO MATCH
|
||
;
|
||
CLEN: ;LENGTH VECTOR 0BH, PT,4 ;DCX END
|
||
DB PT,7, O1,76H ;EQU HLT
|
||
DB O12,04H, O13,03H ;INR INX
|
||
DB O5,0C3H, O10,3AH ;JMP LDA
|
||
DB O2,01H, X
|
||
DB RT,2, RT,3 ;D E
|
||
DB RT,4, RT,5 ;H L
|
||
DB RT,6 ;M
|
||
;
|
||
TV2: ;TYPE,VALUE PAIRS FOR CHAR2 VECTOR
|
||
DB PT,1, O1,0F3H ABLE TO SEARCH
|
||
; OUTPUT: ZERO FLAG INDICATES MATCH WAS FOUND, IN WHICH CASE
|
||
; THE ACCUMULATOR CONTAINS AN INDEX TO THE ELEMEN
|
||
DB 'EQUHLTINRINX'
|
||
DB 'JMPLDALXIMOD'
|
||
DB 'MOVMVINOPNOT'
|
||
DB 'ORAORGORIOUT'
|
||
DB 'POPPSWRALRAR'
|
||
DB 'RETRLCRRCRST'
|
||
DB 'SB ;CALL
|
||
DB PT,6, O9,0AH ;ENDM LDAX
|
||
DB O10,02AH, O1,0E9H ;LHLD PCHL
|
||
DB O4,0C5H, O10,22H ;PUSH SHLD
|
||
DB O1,0F9H, O9,02HGIVES THE NUMBER OF ITEMS IN EACH TABLE
|
||
DB CHAR2-CHAR1
|
||
DB (CHAR3-CHAR2)/2
|
||
DB (CHAR4-CHAR3)/3
|
||
DB (CHAR5-CHAR4)/4
|
||
DB (CH3,80 ;LXI MOD
|
||
DB O6,40H, O7,06H ;MOV MVI
|
||
DB O1,00H, X9,60 ;NOP NOT
|
||
DB O11,0B0H, PT,10 ;ORA ORG
|
||
DB O8,0F6H, O15,0D3T
|
||
; NOT ZERO FLAG INDICATES NO MATCH FOUND IN TABLE
|
||
;
|
||
UR EQU B ;UPPER BOUND REGISTER
|
||
LR EQU C ;LOWER BOUND REGISTER
|
||
SR EQUINR A ;SETS NOT ZERO FLAG
|
||
RET
|
||
;
|
||
PREFIX: ;J C OR R PREFIX?
|
||
LDA ACCUM
|
||
LXI B,(0C2H SHL 8) OR O5 ;JNZ OPCODE TO B, TYPE TO CCMP M ;SAME AS TABLE ENTRY?
|
||
INX D
|
||
INX H ;TO NEXT POSITIONS
|
||
JNZ NCOM ;JUMP IF NOT THE SAME
|
||
DCR SP1P ;MORE CHARACTERS?
|
||
JX - SET NON ZERO FLAG
|
||
XRA A
|
||
INR A
|
||
RET
|
||
;
|
||
BGET: ;PERFORM BINARY SEARCH, AND EXTRACT TYPE AND VAL FIELDS FOR
|
||
; THE ITEM.
|
||
PUSH B ;SAVE U,L
|
||
PUSH H ;SAVE ANOTHER COPY OF THE BASE ADDRESS
|
||
MOV SP1,SR ;S' = S
|
||
MOV SP1P,SP1 ;S'' = S'
|
||
MVI SR,0 ;FO MATCH
|
||
LXI D,SUFTAB
|
||
NEXTS: ;LOOK AT NEXT SUFFIX
|
||
LXI H,ACCUM+1 ;SUFFIX POSITION
|
||
LDAX D ;CHARACTER TO ACCUM
|
||
CMP M
|
||
INX D ;SIZE REGISTER
|
||
MR EQU E ;MIDDLE POINTER REGISTER
|
||
SP1 EQU B ;SIZE PRIME, USED IN COMPUTING MIDDLE POSITON
|
||
SP1P EQU C ;ANOTH
|
||
CPI 'J'
|
||
RZ ;RETURN WITH ZERO FLAG SET IF J
|
||
MVI B,0C4H ;CNZ OPCODE TO B, TYPE IS IN C
|
||
CPI 'C'
|
||
RZ
|
||
LXI B,(0C0H SHL 8NZ COMK
|
||
;
|
||
; COMPLETE MATCH AT M
|
||
POP B
|
||
POP D ;M RESTORED
|
||
POP H
|
||
MOV A,MR ;VALUE OF M COPIED IN A
|
||
RET ;WITH ZERO FLAG ZERO FLAG INDICATES MATCH WAS FOUND, WITH TYPE
|
||
; IN THE ACCUMULATOR, AND VAL IN REGISTER B. THE SEARCH IS BASED
|
||
; UPON THE LER DOUBLE ADD OPERATION BELOW (DOUBLE M)
|
||
;
|
||
LXI KR,0 ;K=0
|
||
SUMK: DAD D ;K = K + M
|
||
DCR SP1 ;S' = S' - 1
|
||
JNZ SUMK ;DECREMENT D ;READY FOR NEXT CHARACTER
|
||
JNZ NEXT0 ;JMP IF NO MATCH
|
||
LDAX D ;GET NEXT CHARACTER
|
||
INX H ;READY FOR COMPARE WITH ACCUM
|
||
ER COPY OF SIZE PRIME
|
||
KR EQU H ;K
|
||
;
|
||
MVI MR,255 ;MARK M <> OLD M
|
||
INR UR ;U=U+1
|
||
MVI LR,0 ;L = 0
|
||
;
|
||
; COMPUTE M' = (U+L)/2) OR O1 ;RNZ OPCODE
|
||
CPI 'R'
|
||
RET
|
||
;
|
||
SUFFIX: ;J R OR C RECOGNIZED, LOOK FOR SUFFIX
|
||
LDA ACCLEN
|
||
CPI 4 ;CHECK LENGTH
|
||
JNC NSET
|
||
;
|
||
NCOM: ;NO MATCH, DETERMINE IF LESS OR GREATER
|
||
POP B ;U,L
|
||
POP D ;S,M
|
||
POP H ;TABLE ADDRESS
|
||
JC NCOML
|
||
; ACCUM IS HINGTH OF THE ACCUMULATOR
|
||
LDA ACCLEN ;ITEM LENGTH
|
||
MOV C,A ;SAVE A COPY
|
||
DCR A ;ACCLEN-1
|
||
MOV E,A
|
||
MVI D,0 ;DOUBLE ACCLEN-1 IF SP1 <> 0
|
||
;
|
||
; K IS NOW RELATIVE BYTE POSITION
|
||
POP D ;TABLE BASE ADDRESS
|
||
DAD D ;H,L CONTAINS ABSOLUTE ADDRESS OF BYTE TO
|
||
CMP M ;SAME?
|
||
RZ ;RETURN WITH ZERO FLAG SET, B IS SUFIX
|
||
NEXT0: INX D ;MOVE TO NEXT CHARACTER
|
||
INR B ;COUNT SUFFIX UP
|
||
|
||
NEXT: XRA A
|
||
MOV A,UR ;CY=0, A=U
|
||
ADD LR ;(U+L)
|
||
RAR ;(U+L)/2
|
||
CMP MR ;SAME AS LAST TIME THROUGH?
|
||
JZ NMATCH ;JUMP IF = TSUFF ;CARRY IF 0,1,2,3 IN LENGTH
|
||
CPI 3
|
||
JZ SUF0 ;ASSUME 1 OR 2 IF NO BRANCH
|
||
CPI 2
|
||
JNZ NSUFF ;RETURNS IF 0 OR 1
|
||
LXI H,ACGHER
|
||
MOV LR,MR ;L = M
|
||
JMP NEXT
|
||
;
|
||
NCOML: ;ACCUMULATOR IS LOW
|
||
MOV UR,MR ;U = M
|
||
JMP NEXT
|
||
;
|
||
NMATCH: ;NO MATCH
|
||
XRA A
|
||
TO D,E
|
||
PUSH D ;SAVE A COPY FOR LATER
|
||
CPI CMAX ;TOO LONG?
|
||
JNC NGET ;NOT IN RANGE IF CARRY
|
||
LXI H,CLEN ;LENGTH VECTOR
|
||
DADCOMPARE
|
||
LXI D,ACCUM ;D,E ADDRESS CHARACTERS TO COMPARE
|
||
;
|
||
COMK: ;COMPARE NEXT CHARACTER
|
||
LDAX D ;ACCUM CHARACTER TO REG A
|
||
DCR C ;COUNT TABLE LENGTH DOWN
|
||
JNZ NEXTS
|
||
; END OF TABLE, MARK WITH NON ZERO FLAG
|
||
INR C
|
||
RET
|
||
;
|
||
NSUFF: ;NOT PROPER SUFFIO NO MATCH
|
||
;
|
||
; MORE ELEMENTS TO SCAN
|
||
MOV MR,A ;NEW MIDDLE VALUE
|
||
PUSH H ;SAVE A COPY OF THE BASE ADDRESS
|
||
PUSH D ;SAVE S,MCUM+2
|
||
MVI M,' ' ;BLANK-OUT FOR MATCH ATTEMPT
|
||
SUF0: ;SEARCH 'TIL END OF TABLE
|
||
LXI B,8 ;B=0, C=8 COUNTS TABLE DOWN TO ZERO OR D
|
||
MOV UR,M ;FILL UPPER BOUND FROM MEMORY
|
||
LXI H,CINX
|
||
DAD D
|
||
DAD D ;BASE ADDRESS TO H,L
|
||
MOV D,M
|
||
INX H
|
||
MOV H,M
|
||
MOV 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 RESET
|
||
POP D ;GET THE ELEMENT BACK
|
||
XRA A ;CLEAR
|
||
INR A ;ZERO FLAG RESET
|
||
RET
|
||
;
|
||
;
|
||
ENDMOD EQU ($ AND 0FFE0H) + 20H ;NEXT EXPRESSION ANALYSIS
|
||
;
|
||
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP
|
||
SYMAX EQU SYTOP+2 ;MAX ADDRESS+1
|
||
;
|
||
PASS EQU SYMAX+2 ;CURRENT ESTORE INDEX
|
||
CALL PREFIX
|
||
RNZ ;NOT FOUND AS PREFIX J C OR R IF NOT ZERO FLAG
|
||
PUSH B ;SAVE VALUE AND TYPE
|
||
CALL SUFFIX ;ZETVAL EQU GETTY+3 ;SET VALUE FIELD
|
||
GETVAL EQU SETVAL+3 ;GET VALUE FIELD
|
||
;
|
||
BSEAR EQU BMOD+3 ;BINARY SEARCH ROUTINE
|
||
BGET EQU BL,D ;NOW IN H,L
|
||
MOV SR,C ;FILL THE SIZE REGISTER
|
||
CALL BSEAR ;PERFORM THE BINARY SEARCH
|
||
JNZ SCASE ;ZERO IF FOUND
|
||
POP D ;R TITLE 'ASM OPERAND SCAN MODULE'
|
||
; OPERAND SCAN MODULE
|
||
ORG 1860H
|
||
;
|
||
; EXTERNALS
|
||
IOMOD EQU 200H ;I/O MODULE
|
||
SCMOD EQU 1100HMODULE ADDRESS
|
||
END
|
||
PASS NUMBER
|
||
FPC EQU PASS+1 ;FILL ADDRESS FOR NEXT HEX BYTE
|
||
ASPC EQU FPC+2 ;ASSEMBLER'S PSEUDO PC
|
||
;
|
||
; GLOBAL EQUATES
|
||
IDEN EQRO IF SUFFIX MATCHED
|
||
MOV A,B ;READY FOR MASK IF ZERO FLAG
|
||
POP B ;RECALL VALUE AND TYPE
|
||
RNZ ;RETURN IF NOT ZERO FLAG SET
|
||
SEAR+3 ;GET VALUES WITH SEARCH
|
||
;
|
||
; COMMON EQUATES
|
||
PBMAX EQU 120 ;MAX PRINT SIZE
|
||
PBUFF EQU 10CH ;PRINT BUFFER
|
||
PBP EQU PBUFF+ESTORE INDEX
|
||
LXI H,TVINX
|
||
DAD D
|
||
DAD D ;ADDRESSING PROPER TV ELEMENT
|
||
MOV E,M
|
||
INX H
|
||
MOV D,M
|
||
; D,E IS BASE ADDRESS OF T ;SCANNER MODULE
|
||
SYMOD EQU 1340H ;SYMBOL TABLE MODULE
|
||
BMOD EQU 15A0H ;BINARY SEARCH MODULE
|
||
;
|
||
;
|
||
PERR EQU IOMOD+18H
|
||
SCAN EQU裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹U 1 ;IDENTIFIER
|
||
NUMB EQU 2 ;NUMBER
|
||
STRNG EQU 3 ;STRING
|
||
SPECL EQU 4 ;SPECIAL CHARACTER
|
||
;
|
||
PLABT EQU 0001B ;PROGRAM LABEL
|
||
DLA; MASK IN THE PROPER BITS AND RETURN
|
||
ORA A ;CLEAR CARRY
|
||
RAL
|
||
RAL
|
||
RAL
|
||
ORA B ;VALUE SET TO JNZ ...
|
||
MOV B,A ;REPLACE
|
||
MPBMAX ;PRINT BUFFER POINTER
|
||
;
|
||
TOKEN EQU PBP+1 ;CURRENT TOKEN UDER SCAN
|
||
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
|
||
ACCLEN EYPE/VALUE VECTOR, ADD DISPLACEMENT
|
||
MOV L,A
|
||
MVI H,0
|
||
DAD H ;DOUBLED
|
||
DAD D ;INDEXED
|
||
MOV A,M ;TYPE TO ACC
|
||
INX H
|
||
MOV B, SCMOD+6H ;SCANNER ENTRY POINT
|
||
CR EQU 0DH ;CARRIAGE RETURN
|
||
;
|
||
LOOKUP EQU SYMOD+6H ;LOOKUP
|
||
FOUND EQU LOOKUP+3 ;FOUND SYMBOL IF裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹BT EQU 0010B ;DATA LABEL
|
||
EQUT EQU 0100B ;EQUATE
|
||
SETT EQU 0101B ;SET
|
||
MACT EQU 0110B ;MACRO
|
||
;
|
||
EXTT EQU 1000B ;EXTERNAL
|
||
REFT OV A,C ;RETURN WITH TYPE IN REGISTER A
|
||
CMP A ;CLEAR THE ZERO FLAG
|
||
RET
|
||
;
|
||
NGET: ;CAN'T FIND THE ENTRY, RETURN WITH ZERO FLAGQU VALUE+2 ;ACCUMULATOR LENGTH
|
||
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
|
||
ACCUM EQU ACCLEN+1
|
||
;
|
||
EVALUE EQU ACCUM+ACMAX ;VALUE FROM M ;VALUE TO B
|
||
RET ;TYPE IN ACC, VALUE IN B
|
||
;
|
||
SCASE: ;NAME NOT TOO LONG, BUT NOT FOUND IN TABLES, MAY BE J C OR R
|
||
POP D ;R ZERO FLAG NOT SET
|
||
ENTER EQU FOUND+3 ;ENTER SYMBOL
|
||
SETTY EQU ENTER+3 ;SET TYPE FIELD
|
||
GETTY EQU SETTY+3 ;SET TYPE FIELD
|
||
SEEQU 1011B ;REFER
|
||
GLBT EQU 1100B ;GLOBAL
|
||
;
|
||
;
|
||
; TABLE DEFINITIONS
|
||
XBASE EQU 0 ;START OF OPERATORS
|
||
OPER EQU 15 ;LAST OPERATORW BYTE
|
||
INX H
|
||
MOV H,M
|
||
MOV L,C
|
||
RET
|
||
;
|
||
LODV2: ;LOAD TOP TWO ELEMENTS DE HOLDS TOP, HL HOLDS TOP-1
|
||
CALL LODV1
|
||
XCHG
|
||
CA JC STKO1
|
||
MVI M,0
|
||
CALL ERREX ;OPERATOR STACK OVERFLOW
|
||
STKO1: MOV E,M ;GET OSP
|
||
MVI D,0
|
||
INR M ;OSP=OSP+1
|
||
POP PSW ;RECALIZE RESULT
|
||
PUSH B
|
||
XRA A ;CLEAR FLAGS
|
||
DLOOP:
|
||
MOV A,E ;GET LOW Y BYTE
|
||
RAL
|
||
MOV E,A
|
||
MOV A,D
|
||
RAL
|
||
MOV D,A
|
||
DCR M ;DETER
|
||
VSP: DS 1 ;VALUE STACK POINTER
|
||
;
|
||
;
|
||
;
|
||
STKV: ;PLACE CURRENT H,L VALUE AT TOP OF VSTACK
|
||
XCHG ;HOLD VALUE IN D,E
|
||
LXI H,-15
|
||
ORA A
|
||
JNZ SHERR
|
||
MOV A,E
|
||
CPI 17
|
||
RC ;RETURN IF 0-16 SHIFT
|
||
SHERR: CALL ERREX
|
||
MVI A,16
|
||
RET
|
||
;
|
||
NEGF: ;COMPUTE 0-
|
||
RT EQU 16
|
||
PT EQU RT+1 ;RT IS REGISTER TYPE, PT IS PSEUDO OPERATION
|
||
OBASE EQU PT+1
|
||
;
|
||
PLUS EQU 5
|
||
MINUS EQU 6
|
||
NOTF EQU 8 ;NLL LODV1
|
||
RET
|
||
;
|
||
APPLY: ;APPLY OPERATOR IN REG-A TO TOP OF STACK
|
||
MOV L,A
|
||
MVI H,0
|
||
DAD H ;OPERATOR NUMBER*2
|
||
LXI D,OPTAB
|
||
L OPERATOR
|
||
LXI H,OPERV
|
||
DAD D ;OPERV(OSP)
|
||
MOV M,A ;OPERV(OSP)=OPERATOR
|
||
LXI H,HIERV
|
||
DAD D
|
||
MOV M,B ;HIERV(OSP)=PRIORITYCREMENT BIT COUNT
|
||
POP H ;RESTORE TEMP RESULT
|
||
RZ ;ZERO BIT COUNT MEANS ALL DONE
|
||
MVI A,0 ;ADD IN CARRY
|
||
ACI 0 ;CARRY
|
||
DADVSP
|
||
MOV A,M
|
||
CPI VSMAX
|
||
JC STKV0
|
||
CALL ERREX ;OVERFLOW IN EXPRESSION
|
||
MVI M,0 ;VSP=0
|
||
STKV0: MOV A,M ;GET VSP
|
||
INR M ;VSPH,L TO H,L
|
||
XRA A
|
||
SUB L
|
||
MOV L,A
|
||
MVI A,0
|
||
SBB H
|
||
MOV H,A
|
||
RET
|
||
;
|
||
DIVF: CALL LODV2
|
||
DIVE: ;(EXTERNAL ENTRY FROM MAIN PROT
|
||
LPAR EQU 12
|
||
RPAR EQU 13
|
||
OSMAX EQU 10
|
||
VSMAX EQU 8*2
|
||
;
|
||
;
|
||
; BEGINNING OF MODULE
|
||
JMP ENDMOD ;PAST THIS MODULE
|
||
JMP OPAN
|
||
DAD D ;INDEXED OPTAB
|
||
MOV E,M ;LOW ADDRESS
|
||
INX H
|
||
MOV H,M ;HIGH ADDRESS
|
||
MOV L,E
|
||
PCHL ;SET PC AND GO TO SUBROUTINE
|
||
;
|
||
|
||
RET
|
||
;
|
||
LODV1: ;LOAD TOP ELEMENT FROM VSTACK TO H,L
|
||
LXI H,VSP
|
||
MOV A,M
|
||
ORA A
|
||
JNZ LODOK
|
||
CALL ERREX ;UNDERFLOW
|
||
LXI H H ;SHIFT TEMP RESULT LEFT ONE BIT
|
||
MOV B,H ;COPY HA AND L TO A A ND C
|
||
ADD L
|
||
LHLD DTEMP ;GET ADDRESS OF X
|
||
SUB L ;SUBTRACT=VSP+1
|
||
INR M ;VSP=VSP+2
|
||
MOV C,A ;SAVE VSP
|
||
MVI B,0 ;DOUBLE VSP
|
||
LXI H,VSTACK
|
||
DAD B
|
||
MOV M,E ;LOW BYTE
|
||
INX H
|
||
MOV M,DOGRAM)
|
||
XCHG ;SWAP D,E WITH H,L FOR DIVIDE FUNCTION
|
||
; COMPUTE X/Y WHERE X IS IN D,E AND Y IS IN H,L
|
||
; THE VALUE OF X/Y APPEAD ;SCAN OPERAND FIELD
|
||
JMP MULF ;MULTIPLY FUNCTION
|
||
JMP DIVE ;DIVIDE FUNCTION
|
||
UNARY: DS 1 ;TRUE IF NEXT OPERATOR IS UNARY
|
||
OP
|
||
OPTAB: DW MULOP
|
||
DW DIVOP
|
||
DW MODOP
|
||
DW SHLOP
|
||
DW SHROP
|
||
DW ADDOP
|
||
DW SUBOP
|
||
DW NEGOP
|
||
DW NOTOP
|
||
DW ANDOP
|
||
DW OROP
|
||
,0
|
||
RET
|
||
;
|
||
LODOK: DCR M
|
||
DCR M ;VSP=VSP-2
|
||
MOV C,M ;LOW BYTE
|
||
MVI B,0
|
||
LXI H,VSTACK
|
||
DAD B ;VSTACK(VSP)
|
||
MOV C,M ;GET LO FROM TEMPORARY RESULT
|
||
MOV C,A
|
||
MOV A,B
|
||
SBB H
|
||
MOV B,A
|
||
PUSH B ;SAVE TEMP RESULT IN STACK
|
||
JNC DSKIP ;NO BORROW FROM SUB ;HIGH BYTE
|
||
RET
|
||
;
|
||
STKO: ;STACK OPERATOR (REG-A) AND PRIORITY (REG-B)
|
||
PUSH PSW ;SAVE IT
|
||
LXI H,OSP
|
||
MOV A,M
|
||
CPI OSMAX
|
||
RS IN D,E AND X MOD Y IS IN H,L
|
||
;
|
||
SHLD DTEMP ;SAVE X IN TEMPORARY
|
||
LXI H,BNUM ;STORE BIT COUNT
|
||
MVI M,11H
|
||
LXI B,0 ;INTIALERV: DS OSMAX ;OPERATOR STACK
|
||
HIERV: DS OSMAX ;OPERATOR PRIORITY
|
||
VSTACK: DS VSMAX ;VALUE STACK
|
||
OSP: DS 1 ;OPERATOR STACK POINDW XOROP
|
||
DW ERREX ;(
|
||
;
|
||
; SPECIFIC HANDLERS FOLLOW
|
||
SHFT: ;SET UP OPERANDS FOR SHIFT L AND R
|
||
CALL LODV2
|
||
MOV A,D ;ENSURE 0TRACT
|
||
DAD B ;ADD X BACK IN
|
||
XTHL ;REPLACE TEMP RESULT ON STACK
|
||
DSKIP: LXI H,BNUM ;RESTORE H,L
|
||
CMC
|
||
JMP DLOOP ;REPEAT LOOPNOT END IF NOT SPECIAL
|
||
;
|
||
LDA ACCUM
|
||
CPI CR
|
||
RZ
|
||
CPI ';'
|
||
RZ
|
||
CPI ','
|
||
RZ
|
||
CPI '!'
|
||
RET
|
||
;
|
||
OPAND: ;SCAN THE OPERAND F JMP ADD0
|
||
;
|
||
NEGOP: CALL LODV1
|
||
NEG0: CALL NEGF ;COMPUTE 0-HL
|
||
JMP ENDOP
|
||
;
|
||
NOTOP: CALL LODV1
|
||
INX H ;65536-HL = 65535-(HL+1OV E,M ;LSBYTE
|
||
INX H
|
||
DCR A ;A HAS THE LENGTH
|
||
JZ OP2 ;ONE OR TWO BYTES
|
||
MOV D,M ;FILL HIGH ORDER
|
||
OP2: XCHG ;VALUE TO H,L
|
||
JMP ENDOP
|
||
;
|
||
DIVOP: ;DIVIDE H,L BY D,E
|
||
CALL DIVF
|
||
XCHG ;RESULT TO H,L
|
||
JMP ENDOP
|
||
;
|
||
MODOP: CALL DIVF
|
||
JMP ENDOP
|
||
;
|
||
S OPERATOR
|
||
CALL APPLY ;APPLY OPERATOR
|
||
JMP EMPOP
|
||
;
|
||
CHKVAL:
|
||
LDA VSP ;MUST HAVE ONE ELEMENT IT THE STACK
|
||
CPI 2
|
||
CNZ ERREX STEPS
|
||
;
|
||
DTEMP: DS 2
|
||
BNUM: DS 1
|
||
;
|
||
MULF: ;MULTIPLY D,E BY H,L AND REPLACE H,L WITH RESULT
|
||
MOV B,H
|
||
MOV C,L ;COPY OF 1ST VIELD OF AN INSTRUCTION
|
||
; (NOT A DB WITH FIRST TOKEN STRING > 2 OR 0)
|
||
XRA A
|
||
STA OSP ;ZERO OPERATOR STACK POINTER
|
||
STA VSP
|
||
)
|
||
JMP NEG0
|
||
;
|
||
ANDOP: CALL LODV2
|
||
MOV A,D
|
||
ANA H
|
||
MOV H,A
|
||
MOV A,E
|
||
ANA L
|
||
MOV L,A
|
||
JMP ENDOP
|
||
;
|
||
OROP: CALL LODV2
|
||
MO
|
||
JMP STNUM ;STORE TO STACK
|
||
;
|
||
OP3: ;NOT A STRING, CHECK FOR NUMBER
|
||
CPI NUMB
|
||
JNZ OP4
|
||
LHLD VALUE ;NUMERIC VALUE
|
||
JMP STNHLOP: CALL SHFT ;CHECK VALUES
|
||
SHL0: ORA A ;DONE?
|
||
JZ ENDOP
|
||
DAD H ;HL=HL*2
|
||
DCR A
|
||
JMP SHL0
|
||
;
|
||
SHROP: CALL SHFT
|
||
SHR0: ORA
|
||
LDA PBUFF
|
||
CPI ' '
|
||
RNZ ;EVALUE REMAINS AT ZERO
|
||
LHLD VSTACK ;GET DOUBLE BYTE IN STACK
|
||
SHLD EVALUE
|
||
RET
|
||
;
|
||
OP1: ;MOREALUE TO B,C FOR SHIFT AND ADD
|
||
LXI H,0 ;H,L IS THE ACCUMULATOR
|
||
MUL0: XRA A
|
||
MOV A,B ;CARRY IS CLEARED
|
||
RAR
|
||
MOV B,A
|
||
MOV A DCR A ;255
|
||
STA UNARY
|
||
LXI H,0
|
||
SHLD EVALUE
|
||
;
|
||
OP0: ;ARRIVE HERE WITH NEXT ITEM ALREADY SCANNED
|
||
CALL ENDEXP ;DONE?
|
||
JNZ V A,D
|
||
ORA H
|
||
MOV H,A
|
||
MOV A,E
|
||
ORA L
|
||
MOV L,A
|
||
JMP ENDOP
|
||
;
|
||
XOROP: CALL LODV2
|
||
MOV A,D
|
||
XRA H
|
||
MOV H,A
|
||
MOV A,E
|
||
XRUM
|
||
;
|
||
OP4: ;NOT STRING OR NUMBER, MUST BE ID OR SPECL
|
||
CALL BGET ;BINARY SEARCH, GET ATTRIBUTES
|
||
JNZ OP6 ;MATCH?
|
||
; YES, MAY A ;DONE?
|
||
JZ ENDOP
|
||
PUSH PSW ;SAVE CURRENT COUNT
|
||
XRA A
|
||
MOV A,H
|
||
RAR
|
||
MOV H,A
|
||
MOV A,L
|
||
RAR
|
||
MOV L,A
|
||
POP PSW
|
||
DCR TO SCAN
|
||
LDA PBUFF
|
||
CPI ' '
|
||
JNZ GETOP
|
||
LDA TOKEN
|
||
CPI STRNG ;IS THIS A STRING?
|
||
JNZ OP3
|
||
;
|
||
; STRING - CONVERT TO DOUBLE,C
|
||
RAR
|
||
MOV C,A
|
||
JC MUL1 ;SKIP THIS ADD IF LSB IS ZERO
|
||
ORA B
|
||
RZ ;RETURN WITH H,L
|
||
JMP MUL2 ;SKIP ADD
|
||
MUL1: DAD D ;ADDOP1
|
||
; EMPTY THE OPERATOR STACK
|
||
EMPOP: LXI H,OSP
|
||
MOV A,M ;GET THE OSP AND CHECK FOR EMPTY
|
||
ORA A
|
||
JZ CHKVAL ;JUMP IF EMPTY
|
||
A L
|
||
MOV L,A
|
||
;
|
||
ENDOP: JMP STKV
|
||
;
|
||
;
|
||
;
|
||
ENDEXP: ;RETURNS ZERO FLAG IF SYMBOL IS CR, ;, OR ,
|
||
LDA TOKEN
|
||
CPI SPECL
|
||
RNZ ;BE OPERATOR
|
||
CPI OPER+1
|
||
JNC OP5
|
||
; OPERATOR ENCOUNTERED MS NIBBLE OF B IS PRIORITY NUMBER LS NIBBLE
|
||
; IS THE OPERATOR
|
||
; ACCA
|
||
JMP SHR0
|
||
;
|
||
ADDOP: CALL LODV2
|
||
ADD0: DAD D
|
||
JMP ENDOP
|
||
;
|
||
SUBOP: CALL LODV2
|
||
XCHG ;TREAT AS HL+(-DE)
|
||
CALL NEGF ;0-HL
|
||
PRECISION
|
||
LDA ACCLEN
|
||
ORA A
|
||
CZ ERREX ;ERROR IF LENGTH=0
|
||
CPI 3
|
||
CNC ERREX ;ERROR IF LENGTH>2
|
||
MVI D,0
|
||
LXI H,ACCUM
|
||
M CURRENT VALUE OF D
|
||
MUL2: XCHG ;READY FOR *2
|
||
DAD H
|
||
XCHG
|
||
JMP MUL0
|
||
;
|
||
MULOP: ;MULTIPLY D,E BY H,L
|
||
CALL LODV2
|
||
CALL MULF
|
||
DCR M ;POP ELEMENT
|
||
MOV E,A ;COPY FOR DOUBLE ADD
|
||
DCR E
|
||
MVI D,0
|
||
LXI H,OPERV
|
||
DAD D ;INDEXED - OPERV(OSP)
|
||
MOV A,M ;GET HAS THE OPERATOR NUMBER, B HAS PRIORITY
|
||
CPI LPAR ;(?
|
||
MOV C,A ;SAVE COPY OF OPERATOR NUMBER
|
||
LDA UNARY
|
||
JNZ OPER1 ;JUMP IFMP GETOP ;FOR ANOTHER ELEMENT
|
||
;
|
||
OPER6: ;UNARY SET, MUST BE + OR -
|
||
MOV A,C ;RECALL OPERATOR
|
||
CPI PLUS
|
||
JZ GETOP ;IGNORE UNAOT A RIGHT PAREN
|
||
;
|
||
; RIGHT PAREN FOUND, STACK MUST CONTAIN LEFT PAREN TO DELETE
|
||
LXI H,OSP
|
||
MOV A,M
|
||
ORA A ;ZERO?
|
||
JZ LPERLUE
|
||
;
|
||
GETOP: CALL SCAN
|
||
JMP OP0
|
||
;
|
||
ERREX: ;PUT 'E' ERROR IN OUTPUT BUFFER
|
||
PUSH H
|
||
MVI A,'E'
|
||
CALL PERR
|
||
POP H
|
||
RET
|
||
;
|
||
DAD D ;HL ADDRESSES TOP OF OPERATOR STACK
|
||
MOV A,M ;PRIORITY OF TOP OPERATOR
|
||
CMP B ;CURRENT GREATER?
|
||
JC OPER3 ;JUMP IF SO
|
||
GET CURRENT PC
|
||
JMP STNUM
|
||
;
|
||
OP7: ;NOT $, LOOK IT UP
|
||
CALL LOOKUP
|
||
CALL FOUND
|
||
JNZ FIDENT
|
||
; NOT FOUND IN SYMBOL TABLE, ENT NOT A (
|
||
; ( ENCOUNTERED, UNARY MUST BE TRUE
|
||
ORA A
|
||
CZ ERREX
|
||
MVI A,0FFH
|
||
STA UNARY ;UNARY IS SET TRUE
|
||
MOV A,C ;RECOVER RY PLUS
|
||
CPI MINUS
|
||
JNZ CHKNOT
|
||
INR A ;CHANGE TO UNARY MINUS
|
||
MOV C,A
|
||
JMP OPER2
|
||
CHKNOT: ;UNARY NOT SYMBOL?
|
||
CPI NOTF
|
||
CR ;PAREN ERROR IF SO
|
||
DCR A ;OSP-1
|
||
MOV M,A ;STORED TO MEMORY
|
||
MOV E,A
|
||
MVI D,0
|
||
LXI H,OPERV
|
||
DAD D
|
||
MOV A,M ;TOP OPERATO
|
||
ENDMOD EQU ($ AND 0FFE0H) + 20H ;NEXT HALF PAGE
|
||
END
|
||
; APPLY TOP OPERATOR TO VALUE STACK
|
||
LXI H,OSP
|
||
MOV M,E ;OSP=OSP-1
|
||
LXI H,OPERV
|
||
DAD D
|
||
MOV A,M ;OPERATOR NUMBER TO ACC
|
||
CER IF PASS 1
|
||
MVI A,'P'
|
||
CALL PERR
|
||
CALL ENTER ;ENTER SYMBOL WITH ZERO TYPE FIELD
|
||
JMP FIDE0
|
||
FIDENT: CALL GETTY ;TYPE TO H,OPERATOR
|
||
JMP OPER4 ;CALLS STKO AND SETS UNARY TO TRUE
|
||
;
|
||
;
|
||
OPER1: ;NOT A LEFT PAREN
|
||
ORA A
|
||
JNZ OPER6 ;MUST BE + OR - SINCNZ ERREX
|
||
JMP OPER2
|
||
;
|
||
;
|
||
OP5: ;ELEMENT FOUND IN TABLE, NOT AN OPERATOR
|
||
CPI PT ;PSEUDO OPERATOR?
|
||
CZ ERREX ;ERROR IF SO
|
||
MR IN REG-A
|
||
CPI LPAR
|
||
JZ NLERR ;JMP IF NO ERROR - PARENS BALANCE
|
||
LPERR: CALL ERREX
|
||
NLERR: ;ERROR REPORTING COMPLETE
|
||
XRA A
|
||
TITLE 'ASM MAIN MODULE'
|
||
; CP/M RESIDENT ASSEMBLER MAIN PROGRAM
|
||
;
|
||
; COPYRIGHT (C) 1976, 1977, 1978
|
||
; DIGITAL RESEARCH
|
||
; ALL APPLY
|
||
POP B ;RESTORE OPERATOR NUMBER AND PRIORITY
|
||
JMP OPER2 ;FOR ANOTHER TEST
|
||
;
|
||
OPER3: ;ARRIVE HERE WHEN OPERATOR IS SL
|
||
ANI 111B
|
||
MVI A,'U'
|
||
CZ PERR
|
||
;
|
||
FIDE0:
|
||
CALL GETVAL ;VALUE TO H,L
|
||
;
|
||
STNUM: ;STORE H,L TO VALUE STACK
|
||
LDA UNARY
|
||
ORAE UNARY IS SET
|
||
;
|
||
; UNARY NOT SET, MUST BE BINARY OPERATOR
|
||
OPER2: ;COMPARE HIERARCHY OF TOS
|
||
PUSH B ;SAVE PRIORITY AND OPERATOV L,B ;GET LOW VALUE TO L
|
||
MVI H,0 ;ZERO HIGH ORDER BYTE
|
||
JMP STNUM ;STORE IT
|
||
;
|
||
OP6: ;NOT FOUND IN TABLE SCAN, $?
|
||
LDA TOK
|
||
JMP OPER5 ;TO CLEAR UNARY FLAG
|
||
;
|
||
OPER4: ;ORDINARY OPERATOR
|
||
CALL STKO
|
||
MVI A,0FFH ;TO SET UNARY FLAG
|
||
OPER5: STA UNARY
|
||
J BOX 579, PACIFIC GROVE
|
||
; CALIFORNIA, 93950
|
||
;
|
||
;
|
||
ORG 1BA0H
|
||
; MODULE ENTRY POINTS
|
||
IOMOD EQU 200H ;IO MODULE
|
||
SCMOD EQU 110TACKED
|
||
; CHECK FOR RIGHT PAREN BALANCE
|
||
POP B ;OPERATOR NUMBER IN C, PRIORITY IN B
|
||
MOV A,C
|
||
CPI RPAR
|
||
JNZ OPER4 ;JUMP IF N A ;UNARY OPERATION SET
|
||
CZ ERREX ;OPERAND ENCOUNTERED WITH UNARY OFF
|
||
XRA A
|
||
STA UNARY ;SET TO OFF
|
||
CALL STKV ;STACK THE VAOR NUMBER
|
||
LDA OSP
|
||
ORA A
|
||
JZ OPER3 ;NO MORE OPERATORS IN STACK
|
||
MOV E,A ;OSP TO E
|
||
DCR E ;OSP-1
|
||
MVI D,0
|
||
LXI H,HIERV
|
||
EN
|
||
CPI SPECL
|
||
JNZ OP7
|
||
LDA ACCUM
|
||
CPI '$'
|
||
JZ CURPC ;USE CURRENT PC
|
||
CALL ERREX
|
||
LXI H,0
|
||
JMP STNUM
|
||
CURPC: LHLD ASPC ;0H ;SCANNER MODULE
|
||
SYMOD EQU 1340H ;SYMBOL TABLE MODULE
|
||
BMOD EQU 15A0H ;BINARY SEARCH MODULE
|
||
OPMOD EQU 1860H ;OPERAND SCAN MO+2 ;ASSEMBLER'S PSEUDO PC
|
||
SYBAS EQU ASPC+2 ;BASE OF SYMBOL TABLE
|
||
SYADR EQU SYBAS+2 ;CURRENT SYMBOL ADDRESS
|
||
;
|
||
; GLOBAL EQUATERINT SIZE
|
||
PBUFF EQU 10CH ;PRINT BUFFER
|
||
PBP EQU PBUFF+PBMAX ;PRINT BUFFER POINTER
|
||
;
|
||
TOKEN EQU PBP+1 ;CURRENT TOKEN UDER SCAN
|
||
P LEADING NUMBERS FROM LINE EDITORS
|
||
JZ SCNEXT
|
||
CPI SPECL ;MAY BE PROCESSOR TECH'S COMMENT
|
||
JNZ SCN1
|
||
; SPECIAL CHARACTER, CHBOL IN ACCUMULATOR
|
||
FOUND EQU SYMOD+9H ;FOUND IF NZ FLAG
|
||
ENTER EQU SYMOD+0CH ;ENTER SYMBOL IN ACCUMULATOR
|
||
SETTY EQU SYMOD+0FH ;PSEUDO OPERATOR 'ENDIF'
|
||
OBASE EQU PT+1
|
||
O1 EQU OBASE+1 ;FIRST OPERATOR
|
||
O15 EQU OBASE+15;LAST OPERATOR
|
||
;
|
||
; MAIN STATEMENT PRDULE
|
||
;
|
||
SETUP EQU IOMOD+3H ;FILE SETUP FOR EACH PASS
|
||
PCON EQU IOMOD+12H ;WRITE CONSOLE BUFFER TO CR
|
||
WOBUFF EQU IOMOD+15H ;WRIS
|
||
IDEN EQU 1 ;IDENTIFIER
|
||
NUMB EQU 2 ;NUMBER
|
||
STRNG EQU 3 ;STRING
|
||
SPECL EQU 4 ;SPECIAL CHARACTER
|
||
;
|
||
PLABT EQU 0001B ;PROGRAM
|
||
VALUE EQU TOKEN+1 ;VALUE OF NUMBER IN BINARY
|
||
ACCLEN EQU VALUE+2 ;ACCUMULATOR LENGTH
|
||
ACMAX EQU 64 ;MAX ACCUMULATOR LENGTH
|
||
ACCECK FOR *
|
||
LDA ACCUM
|
||
CPI '*'
|
||
JNZ CHEND ;END OF LINE IF NOT *
|
||
; * FOUND, NO PRECEDING LABEL ALLOWED
|
||
CALL SETLA
|
||
JNZ STER;SET TYPE FIELD
|
||
GETTY EQU SYMOD+12H ;GET TYPE FIELD
|
||
SETVAL EQU SYMOD+15H ;SET VALUE FIELD
|
||
GETVAL EQU SYMOD+18H ;GET VALUE FIEOCESSING LOOP
|
||
XRA A
|
||
STA PASS ;SET TO PASS 0 INITIALLY
|
||
CALL INISY ;INITIALIZE THE SYMBOL TABLE
|
||
RESTART: ;PASS LOOP GOES FRTE PRINT BUFFER AND REINITIALIZE
|
||
PERR EQU IOMOD+18H ;WRITE ERROR CHARACTER TO PRINT BUFFER
|
||
DHEX EQU IOMOD+1BH ;SEND HEX CHARACLABEL
|
||
DLABT EQU 0010B ;DATA LABEL
|
||
EQUT EQU 0100B ;EQUATE
|
||
SETT EQU 0101B ;SET
|
||
MACT EQU 0110B ;MACRO
|
||
;
|
||
EXTT EQU 1000B ;EXTERUM EQU ACCLEN+1
|
||
;
|
||
EVALUE EQU ACCUM+ACMAX ;VALUE FROM EXPRESSION ANALYSIS
|
||
;
|
||
SYTOP EQU EVALUE+2 ;CURRENT SYMBOL TOP
|
||
SYMAX EQUR ;ERROR IF LABEL
|
||
JMP CHEN1 ;SCAN THE COMMENT OTHERWISE
|
||
;
|
||
SCN1: ;NOT NUMBER OR SPECIAL CHARACTER, CHECK FOR IDENTIFIER
|
||
CPILD
|
||
;
|
||
BGET EQU BMOD+6H ;BINARY SEARCH AND GET TYPE/VALUE PAIR
|
||
;
|
||
OPAND EQU OPMOD+3H ;GET OPERAND VALUE TO 'EVALUE'
|
||
MULF EQU OM 0 TO 1
|
||
CALL INITS ;INITIALIZE THE SCANNER
|
||
CALL SETUP ;SET UP THE INPUT FILE
|
||
LXI H,0
|
||
SHLD SYLAB ;ASSUME NO STARTING LATER TO MACHINE CODE FILE
|
||
EOR EQU IOMOD+1EH ;END OF PROCESSING, CLOSE FILES AND TERMINATE
|
||
;
|
||
INITS EQU SCMOD+3H ;INITIALIZE SCANAL
|
||
REFT EQU 1011B ;REFER
|
||
GLBT EQU 1100B ;GLOBAL
|
||
;
|
||
CR EQU 0DH ;CARRIAGE RETURN
|
||
LF EQU 0AH ;LINE FEED
|
||
EOF EQU 1AH ;END OF F SYTOP+2 ;MAX ADDRESS+1
|
||
;
|
||
PASS EQU SYMAX+2 ;CURRENT PASS NUMBER
|
||
FPC EQU PASS+1 ;FILL ADDRESS FOR NEXT HEX BYTE
|
||
ASPC EQU FPC IDEN
|
||
JNZ STERR ;ERROR IF NOT
|
||
;
|
||
; IDENTIFIER FOUND, MAY BE LABEL, OPCODE, OR MACRO
|
||
CALL BGET ;BINARY SEARCH FIXED DATA
|
||
JOPMOD+6H ;MULT D,E BY H,L TO H,L
|
||
DIVF EQU OPMOD+9H ;DIVIDE HL BY DE, RESULT TO DE
|
||
;
|
||
;
|
||
; COMMON EQUATES
|
||
PBMAX EQU 120 ;MAX PBEL
|
||
SHLD FPC
|
||
SHLD ASPC
|
||
SHLD EPC ;END PC
|
||
;
|
||
SCNEXT: ;SCAN THE NEXT INPUT ITEM
|
||
CALL SCAN
|
||
SCN0: LDA TOKEN
|
||
CPI NUMB ;SKINNER MODULE
|
||
SCAN EQU SCMOD+6H ;SCAN NEXT TOKEN
|
||
;
|
||
INISY EQU SYMOD+3H ;INITIALIZE SYMBOL TABLE
|
||
LOOKUP EQU SYMOD+6H ;LOOKUP SYMILE
|
||
NBMAX EQU 16 ;STARTING POSITION OF PRINT LINE
|
||
;
|
||
;
|
||
RT EQU 16 ;REGISTER TYPE
|
||
PT EQU RT+1 ;PSEUDO OPERATION
|
||
PENDIF EQU 5 Z CHKPT ;CHECK FOR PSEUDO OR REAL OPERATOR
|
||
;
|
||
; BINARY SEARCH WAS UNSUCCESSFUL, CHECK FOR MACRO
|
||
CALL LOOKUP
|
||
CALL FOUND
|
||
JNGTH 0,2,... STRING
|
||
MOV B,A
|
||
INR B
|
||
INR B ;BECOMES 1,3,... FOR 0,2,... LENGTHS
|
||
LXI H,ACCUM ;ADDRESS CHARACTERS IN STRING
|
||
SMOV E,M
|
||
INX H
|
||
MOV H,M
|
||
MOV L,E
|
||
PCHL ;JUMP INTO TABLE
|
||
;
|
||
PTTAB: ;PSEUDO OPCODE JUMP TABLE
|
||
DW SDB ;DB
|
||
DW SDS ;DS
|
||
DW
|
||
MOV B,H ;HIGH BYTE NEXT
|
||
CALL FILHB ;SEND HIGH BYTE
|
||
CALL SETAS ;SET ASPC=FPC
|
||
CALL DELIM ;CHECK DELIMITER SYNTAX
|
||
CPI ','D SYLAB ;MARK AS LABEL FOUND
|
||
;
|
||
; LABEL FOUND, SCAN OPTIONAL ':'
|
||
CALL SCAN
|
||
LDA TOKEN
|
||
CPI SPECL
|
||
JNZ SCN0 ;SKIP NEXT SCANPC
|
||
CALL DELIM
|
||
CPI ','
|
||
JZ SDB0 ;FOR ANOTHER ITEM
|
||
JMP CHEND ;CHECK END OF LINE SYNTAX
|
||
;
|
||
SDS:
|
||
CALL FILAB ;HANDLE LABEL Z LFOUN ;NZ FLAG SET IF FOUND
|
||
;
|
||
; NOT FOUND, ENTER IT
|
||
CALL ENTER ;THIS MUST BE PASS 0
|
||
LDA PASS
|
||
ORA A
|
||
CNZ ERRP ;PHASE EDB1: DCR B ;COUNT DOWN TO ZERO
|
||
JZ SDB2 ;SCAN DELIMITER AT END OF STRING
|
||
PUSH B ;SAVE COUNT
|
||
MOV B,M ;GET CHARACTER
|
||
INX H
|
||
SDW ;DW
|
||
DW SEND ;END
|
||
DW SENDIF ;ENDIF
|
||
DW SENDM ;ENDM
|
||
DW SEQU ;EQU
|
||
DW SIF ;IF
|
||
DW SMACRO ;MACRO
|
||
DW SORG ;ORG
|
||
DW S
|
||
JZ SDW0 ;GET MORE DATA
|
||
JMP CHEND
|
||
;
|
||
SEND:
|
||
CALL FILAB
|
||
CALL PADD ;WRITE LAST LOC
|
||
LDA PBUFF
|
||
CPI ' '
|
||
JNZ CHEND
|
||
CAL IF NOT SPECIAL
|
||
LDA ACCUM
|
||
CPI ':'
|
||
JNZ SCN0
|
||
JMP SCNEXT ;TO IGNORE ':'
|
||
;
|
||
; BINARY SEARCH FOUND SYMBOL, CHECK FOR PSEUDO IF IT OCCURRED
|
||
CALL PADD ;PRINT ADDRESS
|
||
CALL EXP16 ;SCAN AND GET 16BIT OPERAND
|
||
XCHG ;TO D,E
|
||
LHLD ASPC ;CURRENT PSEUDO PRROR IF NOT
|
||
JMP SETSY ;SET SYLAB
|
||
;
|
||
; ITEM WAS FOUND, CHECK FOR MACRO
|
||
LFOUN: CALL GETTY
|
||
CPI MACT
|
||
JNZ SETSY
|
||
;
|
||
; MACRO D
|
||
PUSH H ;SAVE ACCUM POINTER
|
||
CALL FILHB ;SEND TO HEX FILE
|
||
POP H
|
||
POP B
|
||
JMP SDB1
|
||
SDB2: CALL SCAN ;TO THE DELIMITER
|
||
JMP SET ;SET
|
||
DW STITLE ;TITLE
|
||
;
|
||
SDB:
|
||
CALL FILAB ;SET LABEL FOR THIS LINE TO ASPC
|
||
SDB0:
|
||
CALL SCAN ;PAST DB TO NEXT ITEM
|
||
LDL EXP16 ;GET EXPRESSION IF IT'S THERE
|
||
LDA PBUFF
|
||
CPI ' '
|
||
JNZ SEND0
|
||
SHLD EPC ;EXPRESSION FOUND, STORE IT FOR LATER
|
||
SEND0:OR REAL OP
|
||
CHKPT: CPI PT ;PSEUDO OPCODE?
|
||
JNZ CHKOT
|
||
;
|
||
; PSEUDO OPCODE FOUND, BRANCH TO CASES
|
||
MOV E,B ;B HAS PARTICULAR OPEC
|
||
DAD D ;+EXPRESSION
|
||
SHLD ASPC
|
||
SHLD FPC ;NEXT TO FILL
|
||
JMP CHEND
|
||
;
|
||
SDW:
|
||
CALL FILAB ;HANDLE OPTIONAL LABEL
|
||
SDW0:
|
||
CAEFINITION FOUND, EXPAND MACRO
|
||
CALL ERRN ;NOT CURRENTLY IMPLEMENTED
|
||
JMP CHEN1 ;SCANS TO END OF CURRENT LINE
|
||
;
|
||
SETSY: ;LABELSDB3
|
||
;
|
||
; NOT A LONG STRING
|
||
SDBC: CALL OPAND ;COMPUTE OPERAND
|
||
LHLD EVALUE ;VALUE TO H,L
|
||
MOV A,H
|
||
ORA A ;HIGH ORDER MUST BA TOKEN ;LOOK FOR LONG STRING
|
||
CPI STRNG
|
||
JNZ SDBC ;SKIP IF NOT STRING
|
||
LDA ACCLEN
|
||
DCR A ;LENGTH 1 STRING?
|
||
JZ SDBC
|
||
; LEN MVI A,' '
|
||
STA PBUFF ;CLEAR ERROR, IF IT OCCURRED
|
||
CALL SCAN ;CLEAR CR
|
||
LDA TOKEN
|
||
CPI SPECL
|
||
JNZ STERR
|
||
LDA ACCUM
|
||
CPI RATOR NUMBER
|
||
MVI D,0 ;DOUBLE PRECISION VALUE TO D,E
|
||
DCX D ;BIASED BY +1
|
||
LXI H,PTTAB ;BASE OF JUMP TABLE
|
||
DAD D
|
||
DAD D
|
||
LL EXP16 ;GET 16BIT OPERAND
|
||
PUSH H ;SAVE A COPY
|
||
MOV B,L ;LOW BYTE FIRST
|
||
CALL FILHB ;SEND LOW BYTE
|
||
POP H ;RECLAIM A COPY
|
||
FOUND - IS IT THE ONLY ONE?
|
||
LHLD SYLAB
|
||
MOV A,L
|
||
ORA H
|
||
CNZ ERRL ;LABEL ERROR IF NOT
|
||
LHLD SYADR ;ADDRESS OF SYMBOL
|
||
SHLE ZERO
|
||
CNZ ERRD ;DATA ERROR
|
||
MOV B,L ;GET LOW BYTE
|
||
CALL FILHB
|
||
SDB3: ;END OF ITEM - UPDATE ASPC
|
||
CALL SETAS ;SET ASPC TO FLF
|
||
JNZ STERR
|
||
JMP ENDAS ;END OF ASSEMBLER
|
||
;
|
||
SENDIF:
|
||
JMP POEND
|
||
;
|
||
SENDM:
|
||
CALL ERRN
|
||
JMP POEND
|
||
;
|
||
SEQU:
|
||
CALL SETLA
|
||
D - SCAN TO NEXT TOKEN
|
||
CALL SCAN
|
||
JMP CHEND
|
||
;
|
||
; NOT A PSEUDO OPCODE, CHECK FOR REAL OPCODE
|
||
CHKOT: SUI O1 ;BASE OF OPCODES
|
||
HLD ASPC ;CHANGE PC
|
||
SHLD FPC ;CHANGE NEXT TO FILL
|
||
CALL FILAB ;IN CASE OF LABEL
|
||
CALL PADD
|
||
JMP CHEND
|
||
;
|
||
SSET:
|
||
CALL SETLER TO A
|
||
CPI 111000B ;MAY BE PSW
|
||
JZ SPU0
|
||
; NOT PSW, MUST BE B,D, OR H
|
||
ANI 001000B ;LOW BIT MUST BE 0
|
||
CNZ ERRR ;REGISTER A TOKEN
|
||
CPI SPECL
|
||
JNZ SIF1
|
||
LDA ACCUM
|
||
CPI EOF
|
||
MVI A,'B' ;BALANCE ERROR
|
||
CZ PERR
|
||
JZ ENDAS
|
||
JMP SIF0 ;FOR ANOTHER
|
||
SI
|
||
DW SINX ;INX/DCX
|
||
DW SRST ;RESTART
|
||
DW SIN ;IN/OUT
|
||
;
|
||
SSIMP: ;SIMPLE OPERATION CODES
|
||
CALL FILHB ;SEND HEX VALUE TO MACHIN JZ STERR ;MUST BE A LABEL
|
||
LHLD ASPC ;HOLD TEMP ASPC
|
||
PUSH H ;IN STACK
|
||
CALL EXP16 ;GET 16BIT OPERAND
|
||
SHLD ASPC ;VALUE OF
|
||
CPI O15 ;PAST LAST OPCODE?
|
||
JNC STERR ;STATEMENT ERROR IF SO
|
||
;
|
||
; FOUND OPCODE, COMPUTE INDEX INTO TABLE AND JUMP TO CASE
|
||
A
|
||
JZ STERR ;MUST BE LABELLED
|
||
;
|
||
CALL GETTY
|
||
CPI SETT
|
||
CNZ ERRL ;LABEL ERROR
|
||
MVI A,SETT
|
||
CALL SETTY ;REPLACE TYPE WITH 'ERROR IF NOT
|
||
SPU0: MOV A,C ;RECALL REGISTER AND MASK IN CASE OF ERROR
|
||
ANI 110000B
|
||
ORA B ;MASK IN OPCODE FOR PUSH OR POP
|
||
JF1: ;NOT A SPECIAL CHARACTER
|
||
CPI IDEN
|
||
JNZ SIF0 ;NOT AN IDENTIFIER
|
||
CALL BGET ;LOOK FOR ENDIF
|
||
JNZ SIF0 ;NOT FOUND
|
||
CPI PTE CODE FILE
|
||
CALL SCAN ;TO NEXT TOKEN
|
||
JMP INCPC
|
||
;
|
||
SLXI: ;LXI H,16B
|
||
CALL SHDREG ;SCAN DOUBLE PRECISION REGISTER
|
||
CALL CHCEXPRESSION
|
||
CALL FILAB
|
||
CALL PADDR ;COMPUTED VALUE
|
||
LXI H,PBUFF+6 ;SPACE AFTER VALUE
|
||
MVI M,'='
|
||
POP H ;REAL ASPC
|
||
SHLD ASMOV E,A
|
||
MVI D,0
|
||
LXI H,OPTAB
|
||
DAD D
|
||
DAD D
|
||
MOV E,M
|
||
INX H
|
||
MOV H,M
|
||
MOV L,E
|
||
PCHL ;JUMP TO CASE
|
||
;
|
||
OPTAB: ;OPCODE CSET'
|
||
CALL EXP16 ;GET THE EXPRESSION
|
||
PUSH H ;SAVE IT
|
||
CALL SETLA ;RE-ADDRESS LABEL
|
||
POP H ;RECLAIM IT
|
||
CALL SETVAL
|
||
LXI HMP FILINC ;FILL HEX VALUE AND INCREMENT PC
|
||
;
|
||
SJMP: ;JMP 16B/ CALL 16B
|
||
CALL FILHB ;EMIT JMP OR CALL OPCODE
|
||
CALL SETADR ;EMI ;PSEUDO OP?
|
||
JNZ SIF0
|
||
MOV A,B ;GET OPERATOR NUMBER
|
||
CPI PENDIF ;ENDIF?
|
||
JNZ SIF0 ;GET ANOTHER TOKEN
|
||
JMP POEND ;OK, CHECKOM ;CHECK FOR COMMA FOLLOWING REGISTER
|
||
CALL SETADR ;SCAN AND EMIT DOUBLE PRECISION OPERAND
|
||
JMP INCPC
|
||
;
|
||
SDAD: ;DAD B
|
||
CALLPC ;CHANGE BACK
|
||
JMP CHEND
|
||
;
|
||
SIF:
|
||
CALL FILAB ;IN CASE OF LABEL
|
||
CALL EXP16 ;GET IF EXPRESSION
|
||
LDA PBUFF
|
||
CPI ' '
|
||
JNZ ATEGORIES
|
||
DW SSIMP ;SIMPLE
|
||
DW SLXI ;LXI
|
||
DW SDAD ;DAD
|
||
DW SPUSH ;PUSH/POP
|
||
DW SJMP ;JMP/CALL
|
||
DW SMOV ;MOV
|
||
DW SMVI ;MV,0
|
||
SHLD SYLAB ;PREVENT LABEL PROCESSING
|
||
JMP CHEND
|
||
;
|
||
;
|
||
STITLE:
|
||
CALL ERRN ;NOT IMPLEMENTED
|
||
;
|
||
POEND: ;PSEUDO OPERATOR ENT 16BIT OPERAND
|
||
JMP INCPC
|
||
;
|
||
SMOV: ;MOV A,B
|
||
CALL SHREG
|
||
ORA B ;MASK IN OPCODE
|
||
MOV B,A ;SAVE IN B TEMPORARILY
|
||
CALL CHCO END OF LINE
|
||
;
|
||
SMACRO:
|
||
CALL ERRN
|
||
JMP CHEND
|
||
;
|
||
SORG:
|
||
CALL EXP16
|
||
LDA PBUFF
|
||
CPI ' '
|
||
JNZ CHEND ;SKIP ORG IF ERROR
|
||
S SHDREG ;SCAN AND EMIT DOUBLE PRECISION REGISTER
|
||
JMP INCPC
|
||
;
|
||
SPUSH: ;PUSH B POP D
|
||
CALL SHREG ;SCAN SINGLE PRECISION REGISTCHEND ;SKIP IF ERROR
|
||
MOV A,L ;GET LSB
|
||
RAR
|
||
JC CHEND ;TRUE IF CARRY BIT SET
|
||
;
|
||
; SKIP TO EOF OR ENDIF
|
||
SIF0: CALL SCAN
|
||
LDI
|
||
DW SACCI ;ACCUM IMMEDIATE
|
||
DW SLDAX ;LDAX/STAX
|
||
DW SLHLD ;LHLD/SHLD/LDA/STA
|
||
DW SACCR ;ACCUM-REGISTER
|
||
DW SINC ;INC/DCR
|
||
M ;MUST BE COMMA SEPARATOR
|
||
CALL EXP3 ;VALUE MUST BE 0-7
|
||
ORA B ;MASK IN OPCODE
|
||
JMP FILINC
|
||
;
|
||
SMVI: ;MVI A,8B
|
||
CALL SHREG
|
||
|
||
CPI CR
|
||
CNZ ERRD
|
||
RET
|
||
;
|
||
EXP16: ;GET 16BIT VALUE TO H,L
|
||
PUSH B
|
||
CALL SCAN ;START SCANNING OPERAND FIELD
|
||
CALL OPAND
|
||
LINC
|
||
;
|
||
SIN: ;IN 8B/OUT 8B
|
||
CALL FILHB ;EMIT OPCODE
|
||
CALL SETBYTE ;EMIT 8BIT OPERAND
|
||
JMP INCPC
|
||
;
|
||
FILINC: ;FILL HEX VALUE SW
|
||
RET
|
||
;
|
||
CHEND: ;END OF LINE CHECK
|
||
CALL FILAB ;IN CASE OF A LABEL
|
||
LDA TOKEN
|
||
CPI SPECL
|
||
JNZ STERR ;MUST BE A SPECIAL C;EMIT OPCODE
|
||
CALL SETADR ;EMIT OPERAND
|
||
JMP INCPC
|
||
;
|
||
SACCR: ;ADD B
|
||
CALL EXP3 ;RIGHT ADJUSTED 3BIT VALUE FOR REGISTER
|
||
ORA;REGISTER ERROR
|
||
MOV A,C ;RECOVER REGISTER
|
||
ANI 110000B ;FIX IT IF ERROR OCCURRED
|
||
ORA B ;MASK OPCODE
|
||
JMP FILHEX ;EMIT IT
|
||
|
||
ORA B ;MASK IN OPCODE
|
||
CALL FILHEX ;EMIT OPCODE
|
||
CALL CHCOM ;SCAN COMMA
|
||
CALL SETBYTE ;EMIT 8BIT VALUE
|
||
JMP INCPC
|
||
;
|
||
SACCLHLD EVALUE ;VALUE TO H,L
|
||
POP B
|
||
RET
|
||
;
|
||
EXP8: ;GET 8BIT VALUE TO REG A
|
||
CALL EXP16
|
||
MOV A,H
|
||
ORA A
|
||
CNZ ERRV ;VALUE ERROFROM A BEFORE INCREMENTING PC
|
||
CALL FILHEX
|
||
;
|
||
INCPC: ;CHANGE ASSEMBLER'S PSEUDO PROGRAM COUNTER
|
||
CALL FILAB ;SET ANY LABELS WHARACTER
|
||
LDA ACCUM
|
||
CPI CR ;CARRIAGE RETURN
|
||
JNZ CHEN0
|
||
; CARRIAGE RETURN FOUND, SCAN PICKS UP LF AND PUSHES LINE
|
||
CALL SCA B ;MASK IN OPCODE
|
||
JMP FILINC
|
||
;
|
||
SINC: ;INR B/DCR D
|
||
CALL SHREG ;GET REGISTER
|
||
ORA B
|
||
JMP FILINC
|
||
;
|
||
SINX: ;INX H/DCX B
|
||
;
|
||
SETBYTE: ;EMIT 16BIT OPERAND
|
||
CALL EXP8
|
||
JMP FILHEX
|
||
;
|
||
SETADR: ;EMIT 16BIT OPERAND
|
||
CALL EXP16
|
||
JMP FILADR
|
||
;
|
||
CHCOM: ;CI: ;ADI 8B
|
||
CALL FILHB ;EMIT IMMEDIATE OPCODE
|
||
CALL SETBYTE ;EMIT 8BIT OPERAND
|
||
JMP INCPC
|
||
;
|
||
SLDAX: ;LDAX B/STAX D
|
||
CALL SHR IF HIGH BYTE NOT ZERO
|
||
MOV A,L
|
||
RET
|
||
;
|
||
EXP3: ;GET 3BIT VALUE TO REG A
|
||
CALL EXP8
|
||
CPI 8
|
||
CNC ERRV ;VALUE ERROR IF >=8
|
||
HICH OCCUR ON THE LINE
|
||
CALL SETAS ;ASPC=FPC
|
||
JMP CHEND ;END OF LINE SCAN
|
||
;
|
||
;
|
||
; UTILITY SUBROUTINES FOR OPERATION CODES
|
||
;
|
||
N
|
||
JMP SCNEXT
|
||
;
|
||
CHEN0: ;NOT CR, CHECK FOR COMMENT
|
||
CPI ';'
|
||
JNZ CHEN2
|
||
CALL FILAB ;IN CASE LABELLED EMPTY LINE
|
||
; CLEAR COCALL SHREG
|
||
ANI 001000B ;MUST BE B D M OR SP
|
||
CNZ ERRR ;REGISTER ERROR IF NOT
|
||
MOV A,C ;RECOVER REGISTER
|
||
ANI 110000B ;IN CAHECK FOR COMMA FOLLOWING EXPRESSION
|
||
PUSH PSW
|
||
PUSH B
|
||
LDA TOKEN
|
||
CPI SPECL
|
||
JNZ COMER
|
||
; SPECIAL CHARACTER, CHECK FOR COMMREG
|
||
ANI 101000B ;MUST BE B OR D
|
||
CNZ ERRR ;REGISTER ERROR IF NOT
|
||
MOV A,C ;RECOVER REGISTER NUMBER
|
||
ANI 010000B ;CHANGE TO ANI 111B ;REDUCE IF ERROR OCCURS
|
||
RET
|
||
;
|
||
SHREG: ;GET 3BIT VALUE AND SHIFT LEFT BY 3
|
||
CALL EXP3
|
||
RAL
|
||
RAL
|
||
RAL
|
||
ANI 111000
|
||
DELIM: ;CHECK DELIMITER SYNTAX FOR DATA STATEMENTS
|
||
LDA TOKEN
|
||
CPI SPECL
|
||
CNZ ERRD
|
||
LDA ACCUM
|
||
CPI ','
|
||
RZ
|
||
CPI ';'
|
||
RZMMENT TO END OF LINE
|
||
CHEN1: CALL SCAN
|
||
LDA TOKEN
|
||
CPI SPECL
|
||
JNZ CHEN1
|
||
LDA ACCUM
|
||
CPI LF
|
||
JZ SCNEXT
|
||
CPI EOF
|
||
JZ ENDASSE OF ERROR
|
||
ORA B ;MASK IN OPCODE
|
||
JMP FILINC
|
||
;
|
||
SRST: ;RESTART 4
|
||
CALL SHREG ;VALUE IS 0-7
|
||
ORA B ;OPCODE MASKED
|
||
JMP FIA
|
||
LDA ACCUM
|
||
CPI ','
|
||
JZ COMRET ;RETURN IF COMMA FOUND
|
||
COMER: ;COMMA ERROR
|
||
MVI A,'C'
|
||
CALL PERR
|
||
COMRET:
|
||
POP B
|
||
POP PB OR D IF ERROR
|
||
ORA B ;MASK IN OPCODE
|
||
JMP FILINC ;EMIT OPCODE
|
||
;
|
||
SLHLD: ;LHLD 16B/ SHLD 16B/ LDA 16B/ STA 16B
|
||
CALL FILHB B
|
||
MOV C,A ;COPY TO C
|
||
RET
|
||
;
|
||
SHDREG: ;GET DOUBLE REGISTER TO A
|
||
CALL SHREG
|
||
ANI 001000B ;CHECK FOR A,C,E, OR L
|
||
CNZ ERRR ;END OF ASSEMBLY IF EOF
|
||
CPI '!'
|
||
JZ SCNEXT ;LOGICAL END OF LINE
|
||
JMP CHEN1 ;NONE OF THE ABOVE
|
||
;
|
||
; NOT CR OR LF, MAY BE LOTED
|
||
;
|
||
; LABEL FOUND, MUST BE DEFINED ON PASS-1
|
||
LXI H,0
|
||
SHLD SYLAB ;TO MARK NEXT STATEMENT WITH NO LABEL
|
||
LDA PASS
|
||
ORA AR',CR,0
|
||
;
|
||
ENDA1: LXI H,PBUFF+2 ;BEGINNING OF RATIO
|
||
CALL PCON
|
||
LHLD EPC
|
||
SHLD FPC ;END PROGRAM COUNTER
|
||
JMP EOR
|
||
;
|
||
; UTILNT LINE
|
||
FILHI: LHLD FPC
|
||
INX H
|
||
SHLD FPC ;READY FOR NEXT BYTE
|
||
RET
|
||
;
|
||
FILADR: ;EMIT DOUBLE PRECISION VALUE FROM H,L
|
||
PUSH F+1
|
||
CALL PCON ;PRINT LAST ADDRESS
|
||
;
|
||
; COMPUTE REMAINING SPACE
|
||
LHLD SYTOP
|
||
XCHG
|
||
LHLD SYBAS
|
||
CALL DIFF ;DIFFERENCE TO H,WRITE HEX BYTE IN REGISTER A TO MACHINE CODE FILE IF PASS-1
|
||
MOV B,A
|
||
FILHB: LDA PASS
|
||
ORA A
|
||
MOV A,B
|
||
JZ FILHI
|
||
;
|
||
; PASS -GICAL END OF LINE
|
||
CHEN2: CPI '!'
|
||
JZ SCNEXT
|
||
CPI EOF
|
||
JZ ENDAS
|
||
;
|
||
; STATEMENT ERROR IN OPERAND FIELD
|
||
STERR: MVI A,'S'
|
||
CA
|
||
JNZ FIL1
|
||
;
|
||
; PASS 0
|
||
CALL GETTY
|
||
PUSH PSW ;SAVE A COPY OF TYPE
|
||
ANI 111B ;CHECK FOR UNDEFINED
|
||
CNZ ERRL ;LABEL ERROR
|
||
ITY SUBROUTINES
|
||
COMDH: ;COMPARE D,E WITH H,L FOR EQUALITY (NZ FLAG IF NOT EQUAL)
|
||
MOV A,D
|
||
CMP H
|
||
RNZ
|
||
MOV A,E
|
||
CMP L
|
||
REH ;SAVE A COPY
|
||
MOV B,L
|
||
CALL FILHB ;LOW BYTE EMITTED
|
||
POP H ;RECOVER A COPY OF H,L
|
||
MOV B,H
|
||
JMP FILHB ;EMIT HIGH BYTE ANDL
|
||
PUSH H ;SYTOP-SYBAS TO STACK
|
||
LHLD SYMAX
|
||
XCHG
|
||
LHLD SYBAS
|
||
CALL DIFF ;SYMAX-SYBAS TO H,L
|
||
MOV E,H
|
||
MVI D,0 ;DIVIDED B 1, WRITE HEX AND PRINT DATA
|
||
PUSH B ;SAVE A COPY
|
||
CALL DHEX ;INTO MACHINE CODE FILE
|
||
; MAY BE COMPLETELY EMPTY LINE, SO CHECKLL PERR
|
||
JMP CHEN1 ;TO DUMP LINE
|
||
;
|
||
DIFF: ;COMPUTE DE-HL TO HL
|
||
MOV A,E
|
||
SUB L
|
||
MOV L,A
|
||
MOV A,D
|
||
SBB H
|
||
MOV H,A
|
||
RET
|
||
POP PSW ;RESTORE TYPE
|
||
ORI PLABT ;SET TO LABEL TYPE
|
||
CALL SETTY ;SET TYPE FIELD
|
||
LHLD ASPC ;GET CURRENT PC
|
||
CALL SETVAL ;PLAT
|
||
;
|
||
SETAS: ;ASPC=FPC
|
||
LHLD FPC
|
||
SHLD ASPC
|
||
RET
|
||
;
|
||
SETLA: ;SYADR=SYLAB, FOLLOWED BY CHECK FOR ZERO
|
||
LHLD SYLAB
|
||
SHLD SYAD RETURN
|
||
;
|
||
; UTILITY FUNCTIONS FOR PRINTING HEX ADDRESSES AND DATA
|
||
CHEX: ;CONVERT TO HEX
|
||
ADI '0'
|
||
CPI '0'+10
|
||
RC
|
||
ADI 'A'Y 256
|
||
POP H ;SYTOP-SYBAS TO H,L
|
||
CALL DIVF ;RESULT TO DE
|
||
XCHG
|
||
CALL PADDR ;PRINT H,L TO PBUFF
|
||
LXI H,PBUFF+5 ;MESSAGE
|
||
L ADDRESS
|
||
LDA PBUFF+1
|
||
CPI ' '
|
||
LHLD ASPC
|
||
CZ PADDR ;PRINT ADDRESS FIELD
|
||
;
|
||
LDA NBP
|
||
CPI NBMAX ;TRUNCATE CODE IF TOO MUCH;
|
||
ENDAS: ;END OF ASSEMBLY FOR THIS PASS
|
||
LXI H,PASS
|
||
MOV A,M
|
||
INR M ;PASS NUMBER INCREMENTED
|
||
ORA A
|
||
JZ RESTART
|
||
CALL SCACE INTO VALUE FIELD
|
||
RET
|
||
;
|
||
FIL1: ;CHECK FOR DEFINED VALUE
|
||
CALL GETTY
|
||
ANI 111B
|
||
CZ ERRP ;PHASE ERROR
|
||
; GET VALUE AND COMR
|
||
CALL FOUND
|
||
RET
|
||
;
|
||
FILAB: ;FILL LABEL VALUE WITH CURRENT ASPC, IF LABEL FOUND
|
||
CALL SETLA
|
||
RZ ;RETURN IF NO LABEL DETEC-'0'-10
|
||
RET
|
||
;
|
||
WHEXN: ;WRITE HEX NIBBLE
|
||
CALL CHEX ;CONVERT TO ASCII FROM HEX
|
||
LXI H,NBP
|
||
MOV E,M ;NEXT POSITION TO PRINT
|
||
XI D,EMSG ;END MESSAGE
|
||
ENDA0: LDAX D
|
||
ORA A ;ZERO?
|
||
JZ ENDA1
|
||
MOV M,A
|
||
INX H
|
||
INX D
|
||
JMP ENDA0
|
||
;
|
||
EMSG: DB 'H USE FACTO ON THIS LINE
|
||
POP B ;RECALL HEX DIGIT
|
||
JNC FILHI
|
||
; ROOM FOR DIGIT ON THIS LINE
|
||
MOV A,B
|
||
CALL WHEXB ;WRITE HEX BYTE TO PRIN ;TO CLEAR LAST LINE FEED
|
||
CALL PADD ;WRITE LAST ADDRESS
|
||
LXI H,PBUFF+5
|
||
MVI M,CR ;SET TO CR FOR END OF MESSAGE
|
||
LXI H,PBUFPARE WITH ASPC
|
||
CALL GETVAL ;TO H,L
|
||
XCHG
|
||
LHLD ASPC
|
||
CALL COMDH
|
||
CNZ ERRP ;PHASE ERROR IF NOT THE SAME
|
||
RET
|
||
;
|
||
FILHEX: ;
|
||
MVI D,0 ;DOUBLE PRECISION
|
||
INR M ;NBP=NBP+1
|
||
LXI H,PBUFF
|
||
DAD D
|
||
MOV M,A ;STORE IN PRINT BUFFER
|
||
RET
|
||
;
|
||
WHEXB: ;WRITE HE.2
|
||
;
|
||
; COPYRIGHT (C) 1976, 1977, 1978, 1979, 1980
|
||
; DIGITAL RESEARCH
|
||
; BOX 579 PACIFIC GROVE
|
||
; CALIFORNIA 93950
|
||
;
|
||
ORG 10ION TO WRITE FOR MACHINE CODE
|
||
END
|
||
ES BEGINNING OF THE BIT MAP FOR RELOCATION
|
||
POP D ;RECALL BASE OF RELOCATION AREA
|
||
POP B ;RECALL MODULE LENGTH
|
||
PUSH H ;SAVE R: ;EMIT REGISTER ERROR
|
||
PUSH PSW
|
||
PUSH B
|
||
MVI A,'R'
|
||
CALL PERR
|
||
POP B
|
||
POP PSW
|
||
RET
|
||
;
|
||
ERRV: ;EMIT VALUE ERROR
|
||
PUSH PEMORY)
|
||
MOV A,M ;A HAS HIGH ORDER ADDRESS OF MEMORY TOP
|
||
DCR A ;PAGE DIRECTLY BELOW BDOS
|
||
SUB B ;A HAS HIGH ORDER ADDRESS OF X BYTE TO PRINT BUFFER
|
||
PUSH PSW
|
||
RAR
|
||
RAR
|
||
RAR
|
||
RAR
|
||
ANI 0FH ;HIGH ORDER NIBBLE NORMALIZE IN A
|
||
CALL WHEXN ;WRITE IT
|
||
P0H
|
||
STACK EQU 200H
|
||
BDOS EQU 0005H
|
||
PRNT EQU 9 ;BDOS PRINT FUNCTION
|
||
MODULE EQU 200H ;MODULE ADDRESS
|
||
;
|
||
db 01h ;lxi instructio裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹BIT MAP BASE IN STACK
|
||
MOV H,D ;RELOCATION BIAS IS IN D
|
||
;
|
||
REL0: MOV A,B ;BC=0?
|
||
ORA C
|
||
JZ ENDREL
|
||
;
|
||
; NOT END OF THE RELOCSW
|
||
PUSH H
|
||
MVI A,'V'
|
||
CALL PERR
|
||
POP H
|
||
POP PSW
|
||
RET
|
||
;
|
||
ERRD: PUSH PSW
|
||
MVI A,'D' ;DATA ERROR
|
||
JMP ERR
|
||
;
|
||
ERRP: PUSH RELOC AREA
|
||
MOV D,A
|
||
MVI E,0 ;D,E ADDRESSES BASE OF RELOC AREA
|
||
PUSH D ;SAVE FOR RELOCATION BELOW
|
||
;
|
||
LXI H,MODULE;READY FOROP PSW
|
||
ANI 0FH
|
||
JMP WHEXN ;WRITE AND RETURN
|
||
;
|
||
PADD: LHLD ASPC
|
||
PADDR: ;PRINT ADDRESS FIELD OF PRINT LINE FROM H,L
|
||
XCHG
|
||
n
|
||
ds 2 ;space for address
|
||
; LXI B,0 ;ADDRESS FIELD FILLED-IN WHEN MODULE BUILT
|
||
JMP START
|
||
DB 'COPYRIGHT (C) 1980, DIGITAL 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹ATION, MAY BE INTO NEXT BYTE OF BIT MAP
|
||
DCX B ;COUNT LENGTH DOWN
|
||
MOV A,E
|
||
ANI 111B ;0 CAUSES FETCH OF NEXT BYTE
|
||
JNZ REL1
|
||
PSW
|
||
MVI A,'P'
|
||
JMP ERR
|
||
;
|
||
ERRL: PUSH PSW
|
||
MVI A,'L' ;LABEL ERROR
|
||
JMP ERR
|
||
;
|
||
ERRN: PUSH PSW
|
||
MVI A,'N' ;NOT IMPLEMENTED
|
||
THE MOVE
|
||
MOVE: MOV A,B ;BC=0?
|
||
ORA C
|
||
JZ RELOC
|
||
DCX B ;COUNT MODULE SIZE DOWN TO ZERO
|
||
MOV A,M ;GET NEXT ABSOLUTE LOCATIONLXI H,NBP ;INITIALIZE NEXT TO FILL
|
||
PUSH H ;SAVE A COPY OF NBP'S ADDRESS
|
||
MVI M,1
|
||
MOV A,D ;PRINT HIGH BYTE
|
||
PUSH D ;SAVE A RESEARCH '
|
||
SIGNON: DB 'DDT VERS '
|
||
DB VERSION/10+'0','.'
|
||
DB VERSION MOD 10 + '0','$'
|
||
START: LXI SP,STACK
|
||
PUSH B
|
||
PU; DDT RELOCATOR PROGRAM, INCLUDED WITH THE MODULE TO PERFORM
|
||
; THE MOVE FROM 200H TO THE DESTINATION ADDRESS
|
||
VERSION EQU 22 ;2
|
||
; FETCH BIT MAP FROM STACKED ADDRESS
|
||
XTHL
|
||
MOV A,M ;NEXT 8 BITS OF MAP
|
||
INX H
|
||
XTHL ;BASE ADDRESS GOES BACK TO STACK
|
||
MO
|
||
;
|
||
ERR:
|
||
CALL PERR
|
||
POP PSW
|
||
RET
|
||
;
|
||
SYLAB: DS 2 ;ADDRESS OF LINE LABEL
|
||
EPC: DS 2 ;END PC VALUE
|
||
NBP: DS 1 ;NEXT BYTE POSIT
|
||
STAX D ;PLACE IT INTO THE RELOC AREA
|
||
INX D
|
||
INX H
|
||
JMP MOVE
|
||
;
|
||
RELOC: ;STORAGE MOVED, READY FOR RELOCATION
|
||
; HL ADDRESSCOPY
|
||
CALL WHEXB
|
||
POP D
|
||
MOV A,E
|
||
CALL WHEXB
|
||
POP H ;ADDRESSING NBP
|
||
INR M ;SKIP A SPACE AFTER ADDRESS FIELD
|
||
RET
|
||
;
|
||
ERRSH B
|
||
LXI D,SIGNON
|
||
MVI C,PRNT
|
||
CALL BDOS
|
||
POP B ;RECOVER LENGTH OF MOVE
|
||
LXI H,BDOS+2;ADDRESS FIELD OF JUMP TO BDOS (TOP MV L,A ;L HOLDS THE MAP AS WE PROCESS 8 LOCATIONS
|
||
REL1: MOV A,L
|
||
RAL ;CY SET TO 1 IF RELOCATION NECESSARY
|
||
MOV L,A ;BACK TO LOR DEBUG
|
||
ELSE
|
||
IF RELOC
|
||
ORG 0000H ;READY FOR RELOCATION
|
||
ELSE
|
||
ORG 0D000H ;DEBUG IN 64K
|
||
ENDIF
|
||
ENDIF
|
||
;
|
||
JLOC1 EQU 0裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹CHAR ;TO PRINT THE CHARACTER
|
||
POP PSW
|
||
RET
|
||
;
|
||
;
|
||
DELIM: ;CHECK FOR DELIMITER
|
||
CPI ' '
|
||
RZ
|
||
CPI TAB
|
||
RZ
|
||
CPI ','
|
||
RZ
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹U 0DH
|
||
LF EQU 0AH
|
||
TAB EQU 09H
|
||
;
|
||
MODLOC: ;MODULE LOCATION
|
||
JMP BEGIN ;ADDRESS FIELD IS ALTERED AT "BEGIN"
|
||
DB 0,0,0 ;FILLER FOR NEXT TIME AROUND
|
||
JNC REL2 ;SKIP RELOCATION IF CY=0
|
||
;
|
||
; CURRENT ADDRESS REQUIRES RELOCATION
|
||
LDAX D
|
||
ADD H ;APPLY BIAS005H ;BDOS JUMP LOCATION
|
||
;
|
||
;
|
||
; ENTRY POINTS FOR DEBUGGING MONITOR
|
||
DEMON EQU $+680H
|
||
BEGIN EQU DEMON+03H ;BEGINNING OF DEBUG; CP/M DEBUGGER DISASSEMBLER/ASSEMBLER MODULE
|
||
TITLE 'CP/M DEBUGGER (ASMOD) 1/78'
|
||
;
|
||
; COPYRIGHT (C) 1976, 1977, 1978
|
||
; DIGITCPI CR
|
||
RZ
|
||
CPI 7FH
|
||
JZ ASMEN ;RESTART CURRENT LINE
|
||
RET
|
||
;
|
||
CRLF: ;RETURN AND LINE FEED
|
||
MVI C,CR
|
||
CALL CO
|
||
MVI C,LF
|
||
C裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹(USED IN SYMBOL TABLE)
|
||
JMP DISENT
|
||
JMP ASMEN ;ENTRY POINT FOR ASSEMBLER
|
||
PC: DS 2 ;CURRENT FAKED PC DURING DISASSEMBLY
|
||
MPC: IN H
|
||
STAX D
|
||
REL2: INX D ;TO NEXT ADDRESS
|
||
JMP REL0 ;FOR ANOTHER BYTE TO RELOCATE
|
||
;
|
||
ENDREL: ;END OF RELOCATION
|
||
POP D ;CLGING MONITOR
|
||
GETBUFF EQU DEMON+9H ;READ BUFFER
|
||
GNC EQU DEMON+0CH
|
||
PCHAR EQU DEMON+0FH ;PRINT CHARACTER IN REG A
|
||
PBYTE EQU DEMAL RESEARCH
|
||
; BOX 579 PACIFIC GROVE, CA
|
||
; 93950
|
||
;
|
||
FALSE EQU 0 ;VALUE OF "FALSE"
|
||
TRUE EQU NOT FALSE ;VALUE OF "TRUE"
|
||
DEBUGALL CO
|
||
RET
|
||
;
|
||
SCAN: ;FILL OPCODE WITH CHARACTERS
|
||
;
|
||
SC1: CALL CI
|
||
SCAN0: ;ENTER HERE IF CHARACTER SCANNED
|
||
CPI CR
|
||
JZ ERR
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹DS 2 ;MAX VALUE FOR PC (STOP ADDRESS)
|
||
PAGM: DS 1 ;PAGE MODE IF NON ZERO
|
||
TPC: DS 2 ;TEMPORARY PC FOR ASSEMBLER RESTORE ON ERROREAR STACKED ADDRESS
|
||
MVI L,0
|
||
PCHL ;GO TO RELOCATED PROGRAM
|
||
END
|
||
ON+12H ;PRINT BYTE
|
||
PADDX EQU DEMON+15H ;PRINT ADDRESS IN REG D,E
|
||
SCANEXP EQU DEMON+18H ;SCAN 0,1, OR 2 EXPRESSIONS
|
||
BREAK EQU EQU FALSE ;TRUE IF CHECK-OUT TIME
|
||
RELOC EQU TRUE ;TRUE IF GENERATING RELOC IMAGE
|
||
;
|
||
IF DEBUG
|
||
ORG 1000H ;IN LOW MEMORY F
|
||
CALL DELIM
|
||
JZ SC1
|
||
;
|
||
; CLEAR BUFFER
|
||
MVI C,4
|
||
LXI H,OPCODE
|
||
SC0: MVI M,' '
|
||
INX H
|
||
DCR C
|
||
JNZ SC0
|
||
;
|
||
; GARBAGE REMOVE裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹
|
||
OLDSP: DS 2 ;ENTRY SP VALUE
|
||
;
|
||
;
|
||
CO: ;PRINT CHARACTER IN REGISTER C
|
||
PUSH PSW
|
||
MOV A,C ;PCHAR EXPECTS VALUE IN C
|
||
CALL P裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹DEMON+1EH ;CHECK FOR BREAK AT CONSOLE
|
||
PRLABEL EQU DEMON+21H ;PRINT SYMBOLIC LABEL
|
||
;
|
||
;
|
||
CI EQU GNC ;SYNONYM FOR GNC
|
||
;
|
||
CR EQD AT BEGINNING OF SCAN
|
||
MVI C,5
|
||
LXI H,OPCODE
|
||
SC2: MOV M,A ;STORE CHARACTER
|
||
CALL CI
|
||
CALL DELIM
|
||
JZ SC3
|
||
INX H
|
||
DCR C
|
||
C
|
||
RET
|
||
;
|
||
;
|
||
SEAR: ;SEARCH FOR MATCH IN OPCODE TABLE, LENGTH OF TABLE IN REG-C
|
||
; D,E CONTAINS ADDRESS OF BINARY EQUIVALENT OFAL
|
||
RAL
|
||
RAL
|
||
RAL
|
||
ANI 110000B
|
||
RET
|
||
;
|
||
SEAR2: ;SAME AS SEAR, EXCEPT 2 CHARACTER MATCH
|
||
; H,L ADDRESS TABLE TO MATCH ON
|
||
X: ;SCAN FOR SIMPLE REGISTER REFERENCE
|
||
PUSH B
|
||
CALL SCAN
|
||
JZ ERR
|
||
MVI C,8 ;8 REGISTERS
|
||
LXI H,SREG ;SIMPLE REGISTERS
|
||
CALLCOPY OF LOW BYTE TO A
|
||
DCR B
|
||
INR B ;SETS ZERO FLAG IF B IS ZERO
|
||
RET
|
||
;
|
||
GBYTE: ;GET BYTE VALUE TO ACCUMULATOR AND C, CHECK R TYPED
|
||
DCR B ;DECREMENT CHARACTER COUNT
|
||
JNZ SE1 ;MORE TO MATCH?
|
||
;
|
||
; COMPLETE MATCH, RETURN WITH D,E ADDRESSING BYTE VALUE JZ ERR ;TOO LONG
|
||
JMP SC2
|
||
;
|
||
SC3: ;END OF CURRENT SCAN, COMPARE FOR EMPTY
|
||
LDA OPCODE
|
||
CPI ' '
|
||
RET
|
||
;
|
||
HEX: ;CONVERT ACCU OPCODE
|
||
; H,L ADDRESS FOUR CHARACTER OPCODE TO MATCH
|
||
; OPCODE CONTAINS FOUR BYTE OPCODE TYPED AT CONSOLE
|
||
; RETURNS WITH ZERO CHG
|
||
LHLD OPCODE ;2ND BYTE IN D, 1ST BYTE IN E
|
||
XCHG ;H,L ADDRESS TABLE
|
||
SEA0: MOV A,E ;GET 1ST BYTE
|
||
CMP M ;MATCH?
|
||
JNZ SE SEAR2 ;LOOK FOR 2 CHAR MATCH
|
||
JNZ ERR
|
||
DCR C
|
||
MOV A,C
|
||
POP B
|
||
RET
|
||
;
|
||
GETD: ;GET DOUBLE PRECISION REGISTER
|
||
PUSH B
|
||
CALLFOR HIGH ORDER ZERO
|
||
CALL GADDR
|
||
JNZ ERR
|
||
RET
|
||
;
|
||
;
|
||
; ************************************************************
|
||
; ******
|
||
POP D
|
||
RET
|
||
;
|
||
; MISMATCH, FINISH COUNT
|
||
SE2: INX H
|
||
DCR B
|
||
JNZ SE2
|
||
;
|
||
; H,L AT END OF FOUR BYTE AREA, MOVE BACK 8
|
||
LXI MULATOR TO HEXADECIMAL
|
||
SUI '0'
|
||
CPI 10
|
||
RC ;'0' - '9'
|
||
ADI ('0'-'A'+10) AND 0FFH
|
||
CPI 16
|
||
RC
|
||
JMP ERR
|
||
;
|
||
GADDR: ;GET AVALUE IF OPCOE FOUND, WITH D,E
|
||
; ADDRESSING PROPER BYTE, NON-ZERO IF NOT FOUND.
|
||
MVI B,4 ;4 CHARACTER MATCH
|
||
;
|
||
PUSH D ;SAVE A1 ;TO ADDRESS NEXT ELT
|
||
INX H ;NEXT TO MATCH
|
||
MOV A,D ;2ND CHAR
|
||
CMP M
|
||
RZ ;MATCH AT CURRENT ENTRY
|
||
DCX H
|
||
SEA1: DCX H
|
||
SCAN
|
||
JZ ERR
|
||
MVI C,5
|
||
LXI H,DREG
|
||
CALL SEAR
|
||
JNZ ERR
|
||
DCR C
|
||
MOV A,C
|
||
POP B
|
||
RET
|
||
;
|
||
GETDR: ;GET DOUBLE REGISTER (BDH*** ASSEMBLER MODULE STARTS HERE *********************
|
||
; ************************************************************
|
||
;
|
||
ADJ: D,-8
|
||
DAD D ;H,L READY FOR NXT MATCH
|
||
;
|
||
POP D ;RESTORE BYTE POINTER
|
||
INX D ;MOVE TO NEXT IN CASE MATCH OK
|
||
DCR C ;MORE OPCODDRESS VALUE TO B (HIGH ORDER) AND C (LOW) WITH COPY OF C IN A
|
||
CALL SCANEXP ;READ 1 EXPRESSION
|
||
DCR A ;GOES TO ZERO
|
||
JNZ ERRTHE CURRENT BYTE VALUE LOCATION
|
||
LXI D,OPCODE ;ADDRESS CHARACTERS TYPED
|
||
SE1: LDAX D ;POINT TO FIRST BYTE TO MATCH
|
||
CMP M ;SAMDCX H ;ADDRESSES NEXT ELEMENT
|
||
DCR C
|
||
JNZ SEA0 ;FOR ANOTHER COMPARE
|
||
;
|
||
; NO MATCH IN TABLE, RETURN WITH NON-ZERO VALUE
|
||
DCR SP)
|
||
CALL GETD
|
||
CPI 4 ;PSW?
|
||
JZ ERR
|
||
RET
|
||
;
|
||
GETPR: ;GET PUSH/POP REGISTER (BDH OR PSW)
|
||
CALL GETD
|
||
CPI 3
|
||
JZ ERR
|
||
CPI 4;MOVE REGISTER INDICATOR TO MIDDLE FIELD OF CODE
|
||
RAL
|
||
RAL
|
||
RAL
|
||
ANI 111000B
|
||
RET
|
||
;
|
||
ADJ4: ;MOVE TO LEFT BY 4 AND MASK
|
||
RDES TO MATCH?
|
||
JNZ SEAR ;LOOK FOR MORE
|
||
;
|
||
; NO MATCH FOUND IN TABLE, SET NON-ZERO VALUE AND RETURN
|
||
DCR C
|
||
RET
|
||
;
|
||
;
|
||
GETREG ;? IF NOT A SINGLE EXPRESSION
|
||
XCHG ;ADDRESS OF EXPRESSION TO HL
|
||
MOV C,M ;LOW BYTE
|
||
INX H
|
||
MOV B,M ;HIGH BYTE
|
||
MOV A,C ;E CHARACTER AS TABLE?
|
||
JNZ SE2 ;NO, SKIP TO NXT TABLE ENTRY
|
||
INX H ;YES, LOOK AT NEXT CHARACTER
|
||
INX D ;MOVE TO NEXT CHARACTE
|
||
RNZ
|
||
DCR A ;PSW MUST BE ADJUSTED
|
||
RET
|
||
;
|
||
GCON: ;GET CONDITION CODE
|
||
; BUFFER IS SCANNED, MOVE LEFT BEFORE COMPARE
|
||
LXI H, JMP SETM ;PUTS BYTE VALUE TO MEMORY AT PC
|
||
;
|
||
; CHECK GROUP-2 OPCODES, REQUIRE DOUBLE BYTE OPERAND
|
||
CHK2: MVI C,6
|
||
LXI H,ETAB3TH NO OPERANDS
|
||
MVI C,17 ;LENGTH OF GROUP-0
|
||
LXI H,ETAB1 ;END OF GROUP-0
|
||
LXI D,TABLE ;FIRST BYTE VALUE
|
||
CALL SEAR ;LOOK FORK6
|
||
;
|
||
; C=2 IF DCR, =1 IF INR
|
||
INR C ;+1
|
||
INR C ;+2
|
||
INR C ;+3
|
||
CALL GETREG ;VALUE TO ACCUM
|
||
CALL ADJ
|
||
ORA C ;FILL PROPERALL GADDR ;VALUE TO B,C
|
||
POP PSW
|
||
; INCLUDE HIGH ORDER 11'S FOR J AND C OPCODES
|
||
ORI 11000000B
|
||
RET
|
||
;
|
||
SETMD: ;SET MEMORY AT CALL GETREG
|
||
ORA C ;SETS HIGH ORDER TWO BITS
|
||
ORA B ;SETS DESTINATION/OPERATOR
|
||
JMP SETM
|
||
;
|
||
CHK4: ;CHECK FOR GROUP-5 (ACCUMOPCODE
|
||
LXI D,OPCODE+1
|
||
MVI C,2 ;MOVE TWO CHARACTERS
|
||
MOP: LDAX D ;LOAD CHARACTER TO MOVE
|
||
MOV M,A ;MOVE LEFT
|
||
INX H ;NEXT D
|
||
CALL SEAR
|
||
JNZ CHK3 ;NO MATCH
|
||
;
|
||
; FOUND MATCH, GET OPCODE BIT PATTERN AND STORE
|
||
CALL SETMD
|
||
OP2: ;ENTER HERE FOR DOUBLE MATCH
|
||
JNZ CHK1 ;NO MATCH, CHECK FOR GROUP-1
|
||
;
|
||
; MATCHED OPCODE, D,E ADDRESS BYTE VALUE
|
||
JMP SETMD ;SET MEMORY AT PC AND IN INSTRUCTION INDICATOR
|
||
JMP SETM
|
||
;
|
||
CHK6: ;MAY BE A MVI INSTRUCTION
|
||
MVI C,1
|
||
LXI H,PMVI
|
||
CALL SEAR
|
||
JNZ CHK7
|
||
;
|
||
; MVI IN LOCATION PC TO VALUE ADDRESSED BY D
|
||
LDAX D ;VALUE TO ACCUM
|
||
;
|
||
SETM: ;SET MEMORY AT LOCATION PC TO VALUE IN ACCUM, INC PC
|
||
L/REG OPERATOR)
|
||
MVI C,8
|
||
LXI H,ETAB5
|
||
CALL SEAR
|
||
JNZ CHK5
|
||
;
|
||
; ACCUM/REG INSTRUCTION, C COUNTS OPERATORS AS SEARCH PROCEEDSESTINATION
|
||
INX D ;NEXT SOURCE
|
||
DCR C
|
||
JNZ MOP
|
||
;
|
||
; MUST BE BLANK AT END
|
||
LDAX D
|
||
CPI ' '
|
||
JNZ ERR
|
||
MOV M,A
|
||
;
|
||
; NOW REBYTE OPERANDS
|
||
CALL GADDR ;VALUE IN B,A
|
||
CALL SETM
|
||
MOV A,B
|
||
JMP SETM
|
||
;
|
||
CHK3: ;CHECK FOR MOV INSTRUCTION
|
||
MVI C,1
|
||
LXI HC PC
|
||
;
|
||
; CHECK GROUP-1 VALUES
|
||
CHK1: MVI C,10 ;LENGTH OF GROUP-1
|
||
LXI H,ETAB2
|
||
CALL SEAR ;D,E REMAIN SET
|
||
JNZ CHK2 ;NO MATCSTRUCTION, GET REGISTER
|
||
CALL GETREG ;VALUE GOES TO ACCUMULATOR
|
||
CALL ADJ
|
||
ORI 110B
|
||
CALL SETM
|
||
CALL GBYTE
|
||
JMP SETM
|
||
;
|
||
CHLD TPC
|
||
MOV M,A ;STORE AT PC
|
||
INX H ;PC=PC+1
|
||
SHLD TPC
|
||
RET
|
||
;
|
||
;
|
||
;
|
||
GETOP: ;PROCESS NEXT OPCODE
|
||
CALL CI
|
||
CPI CR
|
||
JZ G
|
||
DCR C
|
||
MOV A,C
|
||
CALL ADJ
|
||
MOV B,A
|
||
; OPERATOR NUMBER (SHIFTED) SAVED FOR LATER MASK
|
||
MVI C,10000000B ;ACCUM/REG OPERATOR ADY TO DO THE COMPARE
|
||
LXI H,CREG
|
||
MVI C,8
|
||
CALL SEAR2
|
||
JNZ ERR
|
||
DCR C
|
||
MOV A,C
|
||
CALL ADJ ;MOVE TO BITS 3,4,5 OF BYTE (LS,PMOV
|
||
CALL SEAR
|
||
JNZ CHK4
|
||
;
|
||
; MOV INSTRUCTION GET DESTINATION OPERAND
|
||
CALL GETREG ;VALUE TO ACCUMULATOR
|
||
CALL ADJ
|
||
MOV H, CHECK NEXT GROUP
|
||
;
|
||
; MATCH FOUND, SET BYTE AND GET BYTE OPERAND
|
||
CALL SETMD
|
||
CALL GBYTE ;GETS BYTE VALUE TO ACCUMULATOR
|
||
HK7: ;CHECK FOR GROUP-7
|
||
MVI C,6
|
||
LXI H,ETAB7
|
||
CALL SEAR
|
||
JNZ CHK8
|
||
;
|
||
; LXI,STAX,INX,DAD,LDA, OR DCX
|
||
MOV A,C ;A=1...6
|
||
COBACK ;RETURN IF SIMPLE INPUT
|
||
CPI '.' ;ALTERNATE RETURN IS .
|
||
JZ GOBACK
|
||
CALL SCAN0
|
||
JZ ERR
|
||
;
|
||
CHK0: ;CHECK FOR OPCODES WIINDICATOR
|
||
JMP OP1 ;GETS OPERAND AND SAVES BYTE IN MEMORY
|
||
;
|
||
CHK5: ;MAY BE INR/DCR
|
||
MVI C,2
|
||
LXI H,PDCR
|
||
CALL SEAR
|
||
JNZ CHB = 0)
|
||
RET
|
||
;
|
||
GCONA: ;GET CONDITION CODE TO REGISTER A, DOUBLE ADDRESS TO B,C
|
||
CALL GCON ;CONDITION CODE TO A
|
||
PUSH PSW
|
||
CB,A ;SAVE IN B
|
||
MVI C,01000000B ;BIT PATTERN FOR MOV
|
||
;
|
||
OP1: ;GET NEXT OPERAND FOR MOV, FIRST OPERAND FOR ACCUM/REG OPERATOR
|
||
PI 4
|
||
JC IN0
|
||
;
|
||
; MUST BE DAD,LDA, OR DCX
|
||
ADI 5 ;CHANGES ACCUM TO 9,10, OR 11
|
||
IN0: ;ACCUMULATOR CONTAINS CODE, SAVE IT
|
||
MO SHLD PC
|
||
RET
|
||
|
||
RGPRNT: INR A
|
||
ANI 07
|
||
CPI 06
|
||
JC RGP1
|
||
ADI 03
|
||
RGP1: CPI 05
|
||
JC RGP2
|
||
ADI 02
|
||
RGP2: ADI 41H
|
||
MOV C,A
|
||
TM
|
||
;
|
||
; ************************************************************
|
||
; *********** END OF ASSEMBLER MODULE, START DISASSEMBLERE (NUMBER OF LINES TO PRINT)
|
||
ORA A ;SET FLAGS
|
||
JZ DISASM ;NOT PAGE MODE
|
||
;
|
||
; SET MPC TO 0FFFFH
|
||
LXI H,0FFFFH
|
||
SHLD MPC
|
||
; TTERN
|
||
MVI C,11000001B
|
||
JMP PP1
|
||
;
|
||
PP0: ;PUSH
|
||
MVI C,11000101B
|
||
PP1: CALL GETPR ;DOUBLE PUSH/POP REGISTER TO PROPER FIELD
|
||
ALL CO
|
||
MVI C,' '
|
||
CALL CO
|
||
JMP CO
|
||
|
||
; PRINT REGISTER REFERENCE
|
||
RPPRNT: CALL XTRACT
|
||
ANI 06
|
||
CPI 06
|
||
JNZ RGPRNT
|
||
MVI C,V B,A
|
||
CALL GETDR ;DOUBLE REGISTER VALUE TO ACCUM
|
||
CALL ADJ4 ;ADJUST VALUE TO MIDDLE FIELD
|
||
ORA B ;FILLS REMAINING BITS
|
||
CAL
|
||
JMP CO
|
||
|
||
DECODE: MOV B,A
|
||
ANI 0F0H
|
||
RRC
|
||
RRC
|
||
RRC
|
||
RRC
|
||
ADI 90H
|
||
DAA
|
||
ACI 40H
|
||
DAA
|
||
MOV C,A
|
||
CALL CO
|
||
MOV A,B
|
||
****
|
||
; ************************************************************
|
||
;
|
||
RDBYTE: LHLD MPC
|
||
PUSH D ;SAVE DE
|
||
XCHG ;MAX PC TO 255 IMPLIES TRACE MODE
|
||
INR A
|
||
JNZ DISASM ;NOT TRACE MODE IF BR
|
||
; TRACE MODE, SET TO 1 AND IGNORE ADDRESS FIELD
|
||
INR A ;1 INCALL ADJ4 ;MOVE TO FIELD
|
||
ORA C
|
||
JMP SETM
|
||
;
|
||
CHK10: ;J/C/R?
|
||
LDA OPCODE
|
||
CPI 'J'
|
||
JNZ CHK11
|
||
CALL GCONA
|
||
; CONDITION CODE'S'
|
||
CALL CO
|
||
MVI C,'P'
|
||
JMP CO
|
||
;
|
||
;
|
||
PRPC: ;PRINT CRLF FOLLOWED BY PC VALUE
|
||
CALL CRLF
|
||
; (ENTER HERE FROM DISASSEMBLER)
|
||
L SETM
|
||
; MAY BE LXI
|
||
ANI 11001111B
|
||
CPI 1
|
||
RNZ ;NOT LXI
|
||
JMP OP2 ;PICK UP OPERAND
|
||
;
|
||
;
|
||
;
|
||
CHK8: ;RST?
|
||
MVI C,1
|
||
LXI H,P ANI 0FH
|
||
ADI 90H
|
||
DAA
|
||
ACI 40H
|
||
DAA
|
||
MOV C,A
|
||
JMP CO
|
||
|
||
PRINT: MVI B,4
|
||
P1: MOV C,M
|
||
CALL CO
|
||
INX H
|
||
DCR B
|
||
JNZ P1
|
||
D,E
|
||
LHLD PC ;CURRENT PC
|
||
; SUBTRACT PC FROM MPC, STOP IF CARRY GENERATED
|
||
MOV A,E
|
||
SUB L
|
||
MOV A,D
|
||
SBB H
|
||
JNC RD0
|
||
;
|
||
; P ACC
|
||
STA PAGM
|
||
LHLD PC ;RECOVER PC
|
||
JMP DIS1
|
||
;
|
||
;
|
||
DISASM:
|
||
; CHECK FOR BREAK AT CONSOLE
|
||
CALL BREAK
|
||
JNZ GOBACK
|
||
;
|
||
; CH TO FIELD IN ACCUM, ADDRESS TO B,C
|
||
ORI 010B
|
||
JMP FADDR ;FILL ADDRESS
|
||
;
|
||
CHK11: CPI 'C'
|
||
JNZ CHK12
|
||
CALL GCONA
|
||
ORI 100B
|
||
PRPC0: LHLD PC
|
||
MOV A,H
|
||
CALL DECODE
|
||
MOV A,L
|
||
CALL DECODE
|
||
MVI C,' '
|
||
CALL CO
|
||
CALL CO
|
||
RET
|
||
;
|
||
DISENT: ;ENTER HERE FRORST
|
||
CALL SEAR
|
||
JNZ CHK9
|
||
;
|
||
; RST, GET OPERAND
|
||
CALL GBYTE
|
||
CPI 8
|
||
JNC ERR
|
||
CALL ADJ
|
||
ORI 11000111B
|
||
JMP SETM
|
||
;
|
||
CHK9: MVI C,' '
|
||
JMP CO
|
||
;
|
||
; EXTRACT THE REGISTER FIELD FROM THE OPCODE
|
||
XTRACT: MOV A,D
|
||
ANI 0011$1000B
|
||
RRC
|
||
RRC
|
||
RRC
|
||
RET
|
||
C EXCEEDS MPC, RETURN
|
||
LHLD OLDSP
|
||
SPHL ;RESTORE ORIGINAL STACK POINTER
|
||
RET
|
||
;
|
||
RD0: POP D ;RESTORE D,E
|
||
MOV A,M
|
||
INX H
|
||
ECK TO SEE IF ENOUGH LINES PRINTED IN PAGE MODE
|
||
LXI H,PAGM
|
||
MOV A,M
|
||
ORA A ;ZERO?
|
||
JZ DIS0 ;JMP IF NOT PAGE MODE
|
||
;
|
||
; PAGE;
|
||
FADDR: CALL SETM
|
||
MOV A,C
|
||
CALL SETM
|
||
MOV A,B
|
||
JMP SETM
|
||
;
|
||
CHK12: CPI 'R'
|
||
JNZ ERR
|
||
CALL GCON
|
||
ORI 11000000B
|
||
JMP SEM DEBUGGER
|
||
LXI H,0
|
||
DAD SP
|
||
SHLD OLDSP ;SP SAVED FOR LATER RETURN
|
||
;
|
||
; CHECK FOR PAGE MODE DISPLAY
|
||
LDA PAGM ;GET PAGE MOD ;POP/PUSH?
|
||
MVI C,2
|
||
LXI H,PPOP+4
|
||
CALL SEAR
|
||
JNZ CHK10
|
||
;
|
||
; C=2 IF PUSH, 1 IF POP
|
||
DCR C
|
||
JNZ PP0
|
||
;
|
||
; POP, SET BIT PA;
|
||
; PRINT CONDITION CODE
|
||
CCPRNT: CALL XTRACT
|
||
ADD A
|
||
MOV C,A
|
||
LXI H,CCODE
|
||
DAD B
|
||
MOV C,M
|
||
CALL CO
|
||
INX H
|
||
MOV C,M
|
||
C MODE, DECREMENT AND CHECK FOR ZERO
|
||
DCR M
|
||
JZ GOBACK
|
||
;
|
||
DIS0: LHLD PC ;CURRENT PC
|
||
CALL PRLABEL ;OPTIONAL LABEL
|
||
CALL CRLF; OR, INR = 00 RRR 4, DCR = 00 RRR 5, MVI = 00 RRR 6
|
||
ANI 1100$0111B
|
||
SUI 04
|
||
; INR GOES TO ZERO
|
||
JZ INRREG
|
||
; NOT INR, MAY B
|
||
; XX00 0000 IS PRODUCED IN THE ACCUMULATOR
|
||
ANI 0C0H
|
||
; MOV IS GIVEN BY 01 DDD SSS (DDD IS DEST, SSS IS SOURCE)
|
||
CPI 40H
|
||
JZ
|
||
; PUSH = 11 XX0 101 = 5, POP = 11 XX0 001 = 1
|
||
ANI 07
|
||
; USE THE RESULTING VALUE TO INDEX TO REGISTER TABLE
|
||
MOV C,A
|
||
DCR AINX H ;MOVE TO THE NEXT TABLE ELEMENT
|
||
DCR C ;COUNT THE SIMPLE OPCODES DOWN
|
||
JNZ GROUP1 ;TRY FOR ANOTHER
|
||
;
|
||
; NOT A SIMPLE OPTAKE THE FORM 11 XXX 000
|
||
JZ RETCON ;RETURN CONDITIONALLY
|
||
; JUMP CONDITIONALS TAKE THE FORM 11 XXX 010 = 2
|
||
SUI 02
|
||
JZ JMPC ;NEW LINE
|
||
MVI C,' '
|
||
CALL CO
|
||
CALL CO ;TWO LEADING BLANKS
|
||
CALL PRPC0 ;PRINT THE VALUE
|
||
DIS1: CALL RDBYTE
|
||
; SAVE THE OPCOE DCR
|
||
DCR A
|
||
JZ DCRREG
|
||
DCR A
|
||
; NOT DCR, MAY BE MVI
|
||
JZ MVIREG
|
||
; NOT INR, DCR, OR MVI INSTRUCTION
|
||
;
|
||
; RESTORE THE OPCOD MOVOP
|
||
;
|
||
; NOT A MOV INSTRUCTION, CHECK FOR ACCUMLATOR-REGISTER OPS
|
||
; BIT PATTERN 10 CCC RRR CORRESPONDS TO
|
||
; ADD (0), AD ;POP GOES TO 00
|
||
LXI H,PPOP-1
|
||
DAD B
|
||
CALL PRINT
|
||
; GET THE RELEVANT REGISTER
|
||
CALL XTRACT
|
||
; CHECK FOR PSW OPERATION CODE
|
||
ERATION CODE, CHECK FOR IMMEDIATE OP
|
||
; ADI, ACI, OUT, SUI, IN, SBI, ANI, XRI, ORI, CPI
|
||
MVI C,10
|
||
GROUP2: CMP M
|
||
JZ TYPE2
|
||
ION
|
||
; CALL CONDITIONALS TAKE THE FORM 11 XXX 100 = 4 - 2 = 2
|
||
SUI 02
|
||
JZ CALLCON
|
||
; RST'S TAKE THE FORM 11 XXX 111 = 7 - 4 = 3DE IN THE D REGISTER
|
||
MOV D,A
|
||
; SEARCH THE FIRST 17 ITEMS FOR SIMPLE OPCODES
|
||
; EI (FB) THROUGH NOP (00). NOTE THAT THE SEARCE
|
||
MOV A,D
|
||
; LOOK FOR LXI STAX INX DAD LDAX DCX OPCODES
|
||
; LXI = 00 RR 0001,
|
||
; STAX= 00 RR 0010,
|
||
; INX = 00 RR 0011,
|
||
; DAD C (1), SUB (2), SBB (3), ANA (4),
|
||
; XRA (5), ORA (6), CMP (7)
|
||
CPI 80H
|
||
JZ ACCREG
|
||
;
|
||
; NOT ACCUM-REGISTER, RESTORE OPCODE FO
|
||
CPI 06
|
||
JNZ D6
|
||
LXI H,PPSW
|
||
CALL PRINT
|
||
JMP DISASM
|
||
;
|
||
; PRINT RST XXX INSTRUCTION
|
||
RSTOP: LXI H,PRST
|
||
CALL PRINT
|
||
CALL NX H
|
||
DCR C
|
||
JNZ GROUP2
|
||
;
|
||
; NOT AN IMMEDIATE OPERATION, CHECK FOR
|
||
; SHLD LHLD STA LDA JMP OR CALL
|
||
MVI C,6
|
||
GROUP3: CMP M
|
||
|
||
SUI 03
|
||
JZ RSTOP
|
||
;
|
||
; NONE OF THE ABOVE, PUSHES AND POP'S REMAIN
|
||
MOV A,D ;RESTORE OPCODE
|
||
; FIRST CAPTURE REMAINING OPCOH PROCEEDS
|
||
; THROUGH "TABLE" STARTING AT THE BEGINNING, BUT THE OPCODES
|
||
; ARE ACTUALLY STORED IN SYMBOLIC FORM IN REVERSE ORDE= 00 RR 1001,
|
||
; LDAX= 00 RR 1010
|
||
; DCX = 00 RR 1011
|
||
ANI 0C0H
|
||
JZ LXILST ;TO PROCESS FURTHER
|
||
;
|
||
; NOT ONE OF THE ABOVE, CHER FURTHER CHECKS
|
||
MOV A,D
|
||
;
|
||
; LOOK FOR INR, DCR, AND MVI OPERATIONS
|
||
; INR = 00 RRR 100, DCR = 00 RRR 101, MVI = 00 RRR 110
|
||
XTRACT
|
||
CALL DECODE
|
||
JMP DISASM
|
||
;
|
||
; CALL CONDITIONAL 'C'
|
||
CALLCON:
|
||
MVI C,'C'
|
||
CALL CO
|
||
CALL CCPRNT
|
||
JMP PREXT ;TO PRINT
|
||
JZ TYPE3
|
||
INX H
|
||
DCR C
|
||
JNZ GROUP3
|
||
;
|
||
; NOT TYPE3 OPERATION CODE, CHECK FOR MOV
|
||
; BY MASKING THE HIGH ORDER TWO FIBITS -
|
||
DES CB, D9, DD, ED, FD
|
||
ANI 0000$1000B ;THIS BIT RESET FOR POP,PUSH
|
||
JNZ N8080 ;NOT 8080 OPCODE IF SET
|
||
MOV A,D ;RESTORE ITR.
|
||
;
|
||
LXI H,TABLE
|
||
LXI B,17 ;FIRST 17 SIMPLE OPCODES
|
||
GROUP1: CMP M ;TABLE VALUE = OPCODE?
|
||
JZ TYPE1 ;SKIP TO PRINT IF SO
|
||
CK FURTHER
|
||
; MUST BE OF THE FORM - 11 XXX XXX
|
||
MOV A,D
|
||
ANI 0000$0111B ;TO EXTRACT THE RIGHTMOST BITS
|
||
; RETURN CONDITIONALS THE ADDRESS
|
||
;
|
||
; JUMP CONDITIONAL 'J'
|
||
JMPCON:
|
||
MVI C,'J'
|
||
CALL CO
|
||
CALL CCPRNT
|
||
JMP PREXT ;TO PRINT THE ADDRESS
|
||
;
|
||
; RET CALL PRINT
|
||
JMP D9
|
||
;
|
||
; MOV OPERATION FOUND
|
||
MOVOP: LXI H,PMOV
|
||
CALL PRINT
|
||
CALL XTRACT
|
||
CALL RGPRNT
|
||
MVI C,',' ;REGISTERENDED INSTRUCTION
|
||
;
|
||
;
|
||
MVIREG: LXI H,PMVI
|
||
CALL PRINT
|
||
CALL XTRACT
|
||
CALL RGPRNT
|
||
MVI C,','
|
||
CALL CO
|
||
JMP DATA8
|
||
;
|
||
DCRRETION * 4 (FOUR CHAR CODES)
|
||
MOV C,A ;BC IS INDEX * 4 OF OPCODE
|
||
LXI H,TAB1-4
|
||
DAD B ;HL NOW HOLDS ADDRESS OF CODE TO PRINT
|
||
0 = 8
|
||
; LDAX 1010 BECOMES 1001 = 9
|
||
; DCX 1011 BECOMES 1010 = 10
|
||
CPI 03
|
||
JC D4
|
||
; MUST BE DAD, LDAX OR DCX
|
||
SUI 05
|
||
; DAD MOV A,C ;TYPE IMMEDIATE OPERATION CODE
|
||
ADD A ;*2
|
||
ADD A ;*4 FOR LENGTH FOUR CHAR STRING
|
||
MOV C,A ;BC = INDEX * 4 FOR OPCODE
|
||
URN CONDITIONAL 'R'
|
||
RETCON:
|
||
MVI C,'R'
|
||
CALL CO
|
||
CALL CCPRNT
|
||
JMP DISASM
|
||
;
|
||
;
|
||
; PROCESS ONE OF LXI STAX INX DAD LDAX DCX
|
||
DELIMITER
|
||
CALL CO
|
||
D9: MOV A,D
|
||
ANI 07
|
||
CALL RGPRNT
|
||
JMP DISASM
|
||
;
|
||
; TYPE GROUP3: CALL JMP LDA STA LHLD SHLD
|
||
TYPE3:
|
||
MOG: LXI H,PDCR
|
||
JMP D5
|
||
;
|
||
INRREG: LXI H,PINR
|
||
;
|
||
; PRINT THE INSTRUCTION GIVEN BY HL, FOLLOWED BY REGISTER
|
||
D5: CALL PRINT
|
||
CACALL PRINT
|
||
JMP DISASM
|
||
;
|
||
N8080: ;NOT AN 8080 OPERATION CODE
|
||
LXI H,DBOP
|
||
CALL PRINT ;PRINT THE '??='
|
||
MOV A,D ;GET THE OPC8 BECOMES 3
|
||
; LDAX9 BECOMES 4
|
||
; DCX10 BECOMES 5
|
||
; ACCUMULATOR NORMALIZED
|
||
D4: ADD A
|
||
ADD A
|
||
; VALUE IN ACCUM MULTIPLIED BY F
|
||
LXI H,TAB2-4
|
||
DAD B
|
||
CALL PRINT
|
||
;
|
||
; ARRIVE HERE TO PRINT THE IMMEDIATE VALUE
|
||
DATA8: CALL RDBYTE
|
||
CALL PBYTE ;BYTE VALUE
|
||
LXILST: LXI H,PLXI
|
||
; CAPTURE 08, 10, 18, 20, 28, 30, AND 38
|
||
MOV A,D ;GET OPCODE
|
||
ANI 111B ;RIGHTMOST BITS ZERO?
|
||
JZ N8080 V A,C ;*4 FOR LENGTH 4
|
||
ADD A
|
||
ADD A
|
||
MOV C,A
|
||
LXI H,TAB3-4
|
||
DAD B
|
||
CALL PRINT
|
||
;
|
||
; ARRIVE HERE TO PRINT THE ADDRESS FIELLL XTRACT
|
||
D6: CALL RGPRNT
|
||
JMP DISASM
|
||
;
|
||
; FOUND ACCUM REGISTER OPERATION - MIDDLE BITS GIVE PCODE
|
||
ACCREG: MOV A,D
|
||
ANI 38HODE
|
||
CALL PBYTE ;AND PRINT IT
|
||
JMP DISASM
|
||
;
|
||
ERR: ;ENTER HERE FOR ERROR REPORTING
|
||
CALL CRLF
|
||
MVI C,'?'
|
||
CALL CO
|
||
;
|
||
LHLDOUR
|
||
MOV C,A
|
||
DAD B
|
||
CALL PRINT
|
||
; STAX, INX, DAD, LDAX, OR DC X PRINTED, PRINT REGISTER
|
||
CALL RPPRNT
|
||
JMP DISASM
|
||
;
|
||
; PRIPRINTED
|
||
JMP DISASM
|
||
;
|
||
; FOUND OPCODE IN TABLE, POSITION GIVEN
|
||
; BY COUNT IN BC (NOTE THAT C IS COUNTED DOWN, WHILE
|
||
; INDEX ;NOT 8080 IF SO
|
||
; RECALL OPCODE TO DETERMINE WHICH ONE
|
||
MOV A,D
|
||
; FIND THE PARTICULAR OPCODE
|
||
ANI 0FH
|
||
; LXI HAS LEAST SIGNID
|
||
PREXT: CALL RDBYTE ;LOW ADDRESS TO A
|
||
PUSH PSW ;SAVE IT
|
||
CALL RDBYTE
|
||
MOV D,A ;SET HIGH ADDRESS
|
||
POP PSW ;RECALL LOW ADDR ;SELECT OPCODE BITS
|
||
RRC ;OPCODE * 4 FOR LENGTH FOUR STRING
|
||
MOV C,A
|
||
LXI H,PADD ;ADDRESS THE ACCUM-REGISTER LIST
|
||
DAD B
|
||
OLDSP
|
||
SPHL
|
||
; PC REMAINS UNCHANGED
|
||
;
|
||
;
|
||
ASMEN: ;ENTER HERE FROM DEBUGGER
|
||
LXI H,0
|
||
DAD SP
|
||
SHLD OLDSP
|
||
;
|
||
ASM0: CALL PRPNT REGISTER ADDRESSED BY HL (E.G., IN LXI)
|
||
LXIREG: CALL PRINT
|
||
CALL RPPRNT
|
||
MVI C,','
|
||
CALL CO
|
||
JMP PREXT ;TO PRINT THE EXTWAS MOVING UP THE TABLE DURING THE SEARCH)
|
||
TYPE1: MOV A,C ;TYPE SIMPLE OPCODES FROM GROUP 1
|
||
ADD A ;POSITION * 2
|
||
ADD A ;POSIFICANT FOUR BITS = 0001
|
||
DCR A
|
||
JZ LXIREG
|
||
; STAX 0010 BECOMES 0001 = 1
|
||
; INX 0011 BECOMES 0010 = 2
|
||
; DAD 1001 BECOMES 100ESS
|
||
MOV E,A ;DE IS THE ADDRESS TO PRINT
|
||
CALL PADDX
|
||
JMP DISASM
|
||
;
|
||
; TYPE THE IMMEDIATE OPCODES (INCLUDING IN/OUT)
|
||
TYPE2: C ;PRINT PC VALUE
|
||
SHLD TPC ;SAVE PC VALUE
|
||
CALL GETBUFF ;FILL INPUT BUFFER
|
||
CALL GETOP ;GET OPERATION
|
||
; UPDATE PC, MUST BE '
|
||
ETAB5: DB 'CMP '
|
||
|
||
PINR: DB 'INR '
|
||
PDCR: DB 'DCR '
|
||
PMVI: DB 'MVI '
|
||
PLXI: DB 'LXI ','STAX','INX ','DAD '
|
||
|
||
|
||
DB 'LDAX'
|
||
SYSTEM CONSTANTS
|
||
CIF EQU 1
|
||
COF EQU 2
|
||
RIF EQU 3
|
||
POF EQU 4
|
||
LOF EQU 5
|
||
;
|
||
IDS EQU 7
|
||
GETF EQU 10 ;FILL BUFFER FROM CONSOLE
|
||
CH ;XRI ORI
|
||
|
||
DB 022H ;SHLD
|
||
DB 02AH,032H,03AH,0C3H
|
||
DB 0CDH
|
||
TAB1: DB 'EI ','SPHL','DI ','XCHG'
|
||
|
||
|
||
|
||
DB 'PCHL','XTHL' EQU $+1006H
|
||
BDOSE EQU 5H ;ENTRY POINT TO DOS FROM USER PROGRAMS
|
||
PCBASE EQU 100H ;DEFAULT PC
|
||
SPBASE EQU 100H ;DEFAULT SP
|
||
DISCORRECT INPUT
|
||
LHLD TPC
|
||
SHLD PC
|
||
JMP ASM0
|
||
;
|
||
GOBACK: LHLD OLDSP
|
||
SPHL
|
||
RET
|
||
;
|
||
; THE FIRST 17 ITEMS CORRESPOND TO SIMPLE TITLE 'CP/M DEBUGGER (DEMON) 1/80'
|
||
; CP/M DEBUGGER VERSION 2.2
|
||
;
|
||
; COPYRIGHT (C) 1980
|
||
; DIGITAL RESEARCH
|
||
; BOX 579 PACIFICETAB7: DB 'DCX '
|
||
;
|
||
|
||
PRST: DB 'RST '
|
||
PPSW: DB 'PSW '
|
||
PPOP: DB 'POP ','PUSH'
|
||
|
||
CCODE: DB 'NZ','Z ','NC','C '
|
||
|
||
DB 'PO','PKIO EQU 11 ;CHECK IO STATUS
|
||
LIFT EQU 12 ;LIFT HEAD ON DISK
|
||
OPF EQU 15 ;DISK FILE OPEN
|
||
RDF EQU 20 ;READ DISK FILE
|
||
DMAF EQU 26,'RET ','HLT '
|
||
|
||
|
||
DB 'CMC ','STC ','CMA ','DAA '
|
||
|
||
|
||
DB 'RAR ','RAL ','RRC ','RLC '
|
||
|
||
|
||
ETAB1: DB 'NOP '
|
||
TAB2: DB 'CPI ',EN EQU DISIN+3 ;DISASSEMBLER ENTRY POINT
|
||
ASSEM EQU DISEN+3 ;ASSEMBLER ENTRY POINT
|
||
DISPC EQU ASSEM+3 ;DISASSEMBLER PC VALUE
|
||
OPCODES
|
||
; (NOP BACKWARD THROUGH EI)
|
||
TABLE: DB 000H,007H,00FH,017H ;NOP RLC RRC RAL
|
||
DB 01FH,027H,02FH,037H ;RAR DAA CMA STC
|
||
GROVE
|
||
; CALIFORNIA 93950
|
||
;
|
||
FALSE EQU 0
|
||
TRUE EQU NOT FALSE
|
||
DEBUG EQU FALSE ;TRUE IF DEBUGGING
|
||
RELOC EQU TRUE ;TRUE IF RELOE','P '
|
||
CREG: DB 'M '
|
||
|
||
DB 'B ','C ','D ','E '
|
||
DB 'H ','L ','M '
|
||
SREG: DB 'A '
|
||
;
|
||
DB 'B ','D ','H ','SP '
|
||
DREG: ;SET DMA ADDRESS
|
||
;
|
||
DBP EQU 5BH ;DISK BUFFER POINTER
|
||
DBF EQU 80H ;DISK BUFFER ADDRESS
|
||
DFCB EQU 5CH ;DISK FILE CONTROL BLOCK
|
||
'ORI ','XRI ','ANI '
|
||
|
||
|
||
DB 'SBI ','IN ','SUI ','OUT '
|
||
|
||
|
||
DB 'ACI '
|
||
ETAB2: DB 'ADI '
|
||
;
|
||
TAB3: DB 'CALL','JMP ','LDA ','SDISPM EQU DISPC+2 ;DISASSEMBLER PC MAX VALUE
|
||
DISPG EQU DISPM+2 ;DISASSEMBLER PAGE MODE IF NON ZERO
|
||
PSIZE EQU 12 ;NUMBER OF DB 03FH,076H,0C9H,0E3H ;CMC HLT RET XTHL
|
||
DB 0E9H,0EBH,0F3H,0F9H ;PCHL XCHG DI SPHL
|
||
DB 0FBH ;EI
|
||
;
|
||
; THE NEXT 10 ITEMS COCATING
|
||
IF DEBUG
|
||
ORG 1000H
|
||
ELSE
|
||
IF RELOC
|
||
ORG 0000H
|
||
ELSE
|
||
ORG 0D000H ;TESTING IN 64K
|
||
ENDIF
|
||
ENDIF
|
||
;
|
||
MODBAS EQU $DB 'PSW '
|
||
;
|
||
DBOP: DB '??= '
|
||
OPCODE: DS 4
|
||
END
|
||
|
||
FCB EQU DFCB
|
||
FDN EQU 0 ;DISK NAME
|
||
FFN EQU 1 ;FILE NAME
|
||
FFT EQU 9 ;FILE TYPE
|
||
FRL EQU 12 ;REEL NUMBER
|
||
FRC EQU 15 ;RECORD COUTA '
|
||
|
||
|
||
DB 'LHLD'
|
||
ETAB3: DB 'SHLD'
|
||
;
|
||
|
||
PMOV: DB 'MOV '
|
||
PADD: DB 'ADD ','ADC ','SUB ','SBB '
|
||
|
||
|
||
DB 'ANA ','XRA ','ORA ASSEMBLY LINES TO LIST WITH 'L'
|
||
CSIZE EQU 32 ;COMMAND BUFFER SIZE
|
||
SSIZE EQU 50 ;LOCAL STACK SIZE
|
||
;
|
||
; BASIC DISK OPERATING RRESPOND TO THE IMMEDIATE OPCODES
|
||
DB 0C6H,0CEH,0D3H ;ADI ACI OUT
|
||
DB 0D6H,0DBH,0DEH,0E6H ;SUI IN SBI ANI
|
||
DB 0EEH,0F6H,0FEH ;BASE OF ASSEM/DISASSEM MODULE
|
||
DS 680H ;SIZE OF ASSEM/DISASSEM
|
||
DEMON EQU $ ;BASE OF DEMON MODULE
|
||
DISIN EQU MODBAS+3
|
||
BDOSNT
|
||
FCR EQU 32 ;CURRENT RECORD
|
||
FLN EQU 33 ;FCB LENGTH
|
||
;
|
||
DEOF EQU 1AH ;CONTROL-Z (EOF)
|
||
CR EQU 0DH
|
||
LF EQU 0AH
|
||
;
|
||
IF DEBUG
|
||
ALUE FOR DISPLAY
|
||
SHLD MLOAD ;MAX LOAD LOCATION
|
||
;
|
||
; SETUP RESTART TEMPLATE
|
||
SHLD PLOC
|
||
LXI H,SPBASE
|
||
LXI SP,STACK-4
|
||
PUSHIS JUMP TO BDOS IN CASE OF
|
||
; A SOFT INTERRUPT DURING BDOS PROCESSING.
|
||
XTHL ;PC TO HL
|
||
SHLD RETLOC ;MAY NOT NEED IT
|
||
XTHL
|
||
A'+1
|
||
JNC CERROR
|
||
; CHARACTER IN REGISTER A IS COMMAND, MUST BE IN THE RANGE A-Z
|
||
MOV E,A ;INDEX TO E
|
||
MVI D,0 ;DOUBLE PRECISTRAPAD ;TRAP ADDRESS FOR RETURN IN CASE INTERRUPT
|
||
JMP BEGIN
|
||
BREAKA:
|
||
JMP BREAKP
|
||
; USEFUL ENTRY POINTS FOR PROGRAMS RUNNING OOP
|
||
;
|
||
START:
|
||
LXI SP,STACK-12 ;INITIALIZE SP IN CASE OF ERROR
|
||
; CHECK FOR DISASSEMBLER OVERLOAD
|
||
CALL CHKDIS
|
||
JC DISASMOK
|
||
RSTNUM EQU 6 ;USE 6 IF DEBUGGING
|
||
ELSE
|
||
RSTNUM EQU 7 ;RESTART NUMBER
|
||
ENDIF
|
||
RSTLOC EQU RSTNUM*8 ;RESTART LOCATION
|
||
RSTIN EQU H H ;INITIAL SP
|
||
LXI H,10B ;INITIAL PSW
|
||
PUSH H
|
||
DCX H
|
||
DCX H ;CLEARED
|
||
SHLD HLOC ;H,L CLEARED
|
||
PUSH H ;B,C CLEARED
|
||
PUSHTRAPJMP: ;ADDRESS FILLED AT "BEGIN"
|
||
JMP 0000H
|
||
;
|
||
BEGIN:
|
||
;
|
||
LHLD BDOSE+1
|
||
SHLD TRAPJMP+1 ;FILL JUMP TO BDOS
|
||
LXI H,TRAPAD
|
||
ION INDEX
|
||
LXI H,JMPTAB;BASE OF TABLE
|
||
DAD D
|
||
DAD D ;INDEXED
|
||
MOV E,M ;LO BYTE
|
||
INX H
|
||
MOV D,M ;HO BYTE
|
||
XCHG ;TO H,L
|
||
WITH DDT
|
||
JMP GETBUFF ;GET ANOTHER BUFFER FULL
|
||
JMP GNC ;GET NEXT CHARACTER
|
||
JMP PCHAR ;PRINT A CHARACTER FROM A
|
||
JMP PBYTE
|
||
;
|
||
; DISASSEMBLER NOT PRESENT, SET BDOS JMP
|
||
LXI H,DEMON
|
||
SHLD BDOSE+1 ;(RE)SET JMP ADDRESS
|
||
DISASMOK:
|
||
CALL CRLF ;INITIAL C0C7H OR (RSTNUM SHL 3) ;RESTART INSTRUCTION
|
||
;
|
||
; TEMPLATE FOR PROGRAMMED BREAKPOINTS
|
||
; ---------
|
||
; PCH : PCL
|
||
; HLH : HLL
|
||
H ;D,E CLEARED
|
||
SHLD TRACER ;CLEAR TRACE FLAG
|
||
;
|
||
MVI A,0C3H ;(JMP RESTART)
|
||
STA RSTLOC
|
||
LXI H,BREAKA ;BREAK POINT SUBROUTI
|
||
SHLD MODBAS+1 ;ADDRESS FIELD CHANGED
|
||
LXI H,MODBAS
|
||
SHLD BDOSE+1 ;NOW INCLUDES ASSEM/DISASSEM
|
||
;
|
||
XRA A ;ZERO TO ACCUM
|
||
SPCHL ;GONE...
|
||
;
|
||
JMPTAB: ;JUMP TABLE TO SUBROUTINES
|
||
DW ASSM ;A ENTER ASSEMBLER LANGUAGE
|
||
DW CERROR ;B
|
||
DW CERROR ;C
|
||
DW DI;PRINT BYTE IN REGISTER A
|
||
JMP PADDX ;PRINT ADDRESS IN REGISTERS D,E
|
||
JMP SCANEXP ;SCAN 0,1,2, OR 3 EXPRESSIONS
|
||
JMP GETVAL ;RLF
|
||
IF DEBUG
|
||
MVI A,':'
|
||
ELSE
|
||
MVI A,'-'
|
||
ENDIF
|
||
CALL PCHAR ;OUTPUT PROMPT
|
||
;
|
||
; GET INPUT BUFFER
|
||
CALL GETBUFF ;FILL CO
|
||
; SPH : SPL
|
||
; RA : FLG
|
||
; B : C
|
||
; D : E
|
||
; ---------
|
||
; FLG FIELD: MZ0I0E1C (MINUS,ZERO,IDC,EVEN,CARRY)
|
||
;
|
||
AVAL ENE
|
||
SHLD RSTLOC+1 ;RESTART LOCATION ADDRESS FIELD
|
||
;
|
||
; CHECK FOR FILE NAME PASSED TO DEMON, AND LOAD IF PRESENT
|
||
LDA FCB+FFN TA BREAKS ;CLEARS BREAK POINT COUNT
|
||
;
|
||
LXI H,PCBASE
|
||
SHLD DISPC ;INITIAL VALUE FOR DISASSEMBLER PC
|
||
SHLD DISLOC ;INITIAL VSPLAY ;D DISPLAY RAM MEMORY
|
||
DW CERROR ;E
|
||
DW FILL ;F FILL MEMORY
|
||
DW GOTO ;G GO TO MEMORY ADDRESS
|
||
DW HEXARI ;H HEXADECIMALGET VALUE TO H,L
|
||
JMP BREAK ;CHECK BREAK KEY
|
||
RET ;TAKES PLACE OF PRLABEL IN SID
|
||
;
|
||
;
|
||
TRAPAD: ;GET THE RETURN ADDRESS FOR TMMAND BUFFER
|
||
;
|
||
CALL GNC ;GET CHARACTER
|
||
CPI CR
|
||
JZ START
|
||
SUI 'A' ;LEGAL CHARACTER?
|
||
JC CERROR ;COMMAND ERROR
|
||
CPI 'Z'-'QU 5 ;A REGISTER COUNT IN HEADER
|
||
BVAL EQU 6
|
||
DVAL EQU 7
|
||
HVAL EQU 8
|
||
SVAL EQU 9
|
||
PVAL EQU 10
|
||
;
|
||
;
|
||
; DEMON ENTRY POINTS
|
||
JMP ;BLANK IF NO NAME PASSED
|
||
CPI ' '
|
||
JZ START
|
||
;
|
||
; PUSH A ZERO, AND READ
|
||
LXI H,0
|
||
PUSH H
|
||
JMP RINIT
|
||
;
|
||
;
|
||
; MAIN COMMAND L SUM AND DIFFERENCE
|
||
DW INFCB ;I FILL INPUT FILE CONTROL BLOCK
|
||
DW CERROR ;J
|
||
DW CERROR ;K
|
||
DW LASSM ;L LIST ASSEMBLY LANGUA COMMAND
|
||
;
|
||
; DISPLAY MEMORY, FORMS ARE
|
||
; D DISPLAY FROM CURRENT DISPLAY LINE
|
||
; DNNN SET DISPLAY LINE AND ASSUME D
|
||
; DNNN,ASSM PRESENT?
|
||
JNC CERROR
|
||
;
|
||
CALL SCANEXP ;SCAN EXPRESSIONS WHICH FOLLOW
|
||
JZ SPAGE ;BRANCH IF NOT EXPRESSIONS
|
||
CALL GETVAL TER FORM
|
||
SHLD DISLOC ;UPDATE FOR NEXT WRITE
|
||
LHLD TDISP
|
||
XCHG
|
||
CALL BLANK
|
||
;
|
||
DISCH0: LDAX D ;GET BYTE
|
||
CALL PGRAPH ;PRINTSM: ;ASSEMBLER LANGUAGE INPUT
|
||
; CHECK FOR ASSM PRESENT
|
||
CALL CHKDIS ;ASSM/DISASSM PRESENT
|
||
JNC CERROR ;NOT THERE
|
||
;
|
||
CALL SCRT
|
||
MOV L,A
|
||
LXI D,PSIZE*16-1
|
||
DAD D
|
||
DISP2: SHLD DISMAX
|
||
; DISPLAY MEMORY FROM DISLOC TO DISMAX
|
||
DISP3: CALL CRLF
|
||
CALL BREGE
|
||
DW MOVE ;M MOVE MEMORY
|
||
DW CERROR ;N
|
||
DW CERROR ;O
|
||
DW CERROR ;P
|
||
DW CERROR ;Q
|
||
DW READ ;R READ HEXADECIMAL FILE
|
||
DW MMM DISPLAY NNN TO MMM
|
||
; NEW DISPLAY LINE IS SET TO NEXT TO DISPLAY
|
||
;
|
||
DISPLAY:
|
||
CALL SCANEXP ;GET 0,1,OR 2 EXPNS
|
||
JZ DISP1 ;EXP1 TO H,L
|
||
SHLD DISPC ;SETS BASE PC FOR LIST
|
||
DCR A ;ONLY EXPRESSION?
|
||
JZ SPAGE ;SETS SINGLE PAGE MODE
|
||
;
|
||
; ANOTHER EXPRE IF GRAPHIC CHARACTER
|
||
INX D
|
||
LHLD DISLOC ;COMPARE FOR END OF LINE
|
||
MOV A,L
|
||
SUB E
|
||
JNZ DISCH0
|
||
MOV A,H
|
||
SUB D
|
||
JNZ DISCANEXP ;SCAN THE EXPRESSIONS WHICH FOLLOW
|
||
DCR A ;ONE EXPRESSION EXPECTED
|
||
JNZ CERROR
|
||
CALL GETVAL ;GET EXPRESSION TO H,L
|
||
SHAK ;BREAK KEY?
|
||
JNZ START ;STOP CURRENT EXPANSION
|
||
LHLD DISLOC
|
||
SHLD TDISP
|
||
CALL PADDR ;PRINT LINE ADDRESS
|
||
DISP4: CALL BLANSETMEM ;S SET MEMORY COMMAND
|
||
DW TRACE ;T
|
||
DW UNTRACE ;U
|
||
DW CERROR ;V
|
||
DW CERROR ;W
|
||
DW EXAMINE ;X EXAMINE AND MODIFY REGI;ASSUME CURRENT DISLOC
|
||
CALL GETVAL ;GET VALUE TO H,L
|
||
JC DISP0 ;CARRY SET IF ,B FORM
|
||
SHLD DISLOC ;OTHERWISE DISPC ALREADY SSSION FOLLOWS
|
||
CALL GETVAL
|
||
SHLD DISPM ;SETS MAX VALUE
|
||
DCR A
|
||
JNZ CERROR ;ERROR IF MORE EXPN'S
|
||
XRA A ;CLEAR PAGE MODE
|
||
JH0
|
||
;
|
||
; DROP THRU AT END OF CHARACTERS
|
||
LHLD DISLOC
|
||
CALL DISCOM ;END OF DISPLAY?
|
||
JC START
|
||
;
|
||
; NO, CONTINUE WITH NEXT LINLD DISPC
|
||
CALL ASSEM
|
||
JMP START
|
||
;
|
||
LASSM: ;ASSEMBLER LANGUAGE OUTPUT LISTING
|
||
; L<CR> LISTS FROM CURRENT DISASSM PC FOR SEVERK
|
||
MOV A,M ;GET NEXT DATA BYTE
|
||
CALL PBYTE ;PRINT BYTE
|
||
INX H
|
||
CALL DISCOM ;COMPARE H,L WITH DISMAX
|
||
JC DISCH ;CARRY SET IFSTERS
|
||
DW CERROR ;Y
|
||
DW CERROR ;Z
|
||
;
|
||
;
|
||
OPN: ;FILE OPEN ROUTINE. THIS SUBROUTINE OPENS THE DISK INPUT
|
||
PUSH H
|
||
PUSH D
|
||
PUET
|
||
DISP0: ;GET NEXT VALUE
|
||
ANI 7FH ;IN CASE ,B
|
||
DCR A
|
||
JZ DISP1 ;SET HALF PAGE MODE
|
||
CALL GETVAL
|
||
DCR A ;A,B,C NOT ALLOWEDMP SPAG0
|
||
;
|
||
SPAGE: MVI A,PSIZE ;SCREEN SIZE FOR LIST
|
||
SPAG0: STA DISPG
|
||
CALL DISEN ;CALL DISASSEMBLER
|
||
JMP START ;FOR ANOTHERE
|
||
JMP DISP3
|
||
;
|
||
;
|
||
; FILL MEMORY AREA WITH FIXED DATA ELEMENT
|
||
;
|
||
SCAN3: ;SCAN THREE EXPN'S FOR FILL AND MOVE
|
||
CALL SCANEXP
|
||
AL LINES
|
||
; L<NUMBER><CR> LISTS FROM <NUMBER> FOR SEVERAL LINES
|
||
; L<NUMBER>,<NUMBER> LISTS BETWEEN LOCATIONS
|
||
CALL CHKDIS ;DIS H,L > DISMAX
|
||
MOV A,L ;CHECK FOR LINE OVERFLOW
|
||
ANI 0FH
|
||
JNZ DISP4 ;JUMP FOR ANOTHER BYTE
|
||
;
|
||
DISCH: ;DISPLAY AREA IN CHARACSH B
|
||
XRA A
|
||
STA DBP ;CLEAR BUFFER POINTER
|
||
MVI C,OPF
|
||
LXI D,DFCB
|
||
CALL TRAPAD ;TO BDS
|
||
POP B
|
||
POP D
|
||
POP H
|
||
RET
|
||
;
|
||
AS
|
||
JNZ CERROR
|
||
JMP DISP2
|
||
;
|
||
DISP1: ;0 OR 1 EXPN, DISPLAY HALF SCREEN
|
||
LHLD DISLOC
|
||
MOV A,L
|
||
ANI 0F0H ;NORMALIZE TO LINE STA CPI 3
|
||
JNZ CERROR
|
||
CALL GETVAL
|
||
PUSH H
|
||
CALL GETVAL
|
||
PUSH H
|
||
CALL GETVAL
|
||
POP D
|
||
POP B ;BC,DE,HL
|
||
RET
|
||
;
|
||
BCDE: ;COMPA,M ;GET DATA BYTE
|
||
STAX D ;PUT BACK INTO CODE
|
||
SETBK0: INX H ;ADDRESS FIELD
|
||
MOV M,E ;LSB
|
||
INX H
|
||
MOV M,D ;MSB
|
||
INX H ;DATA;INTO USER'S STACK
|
||
LHLD HLOC ;HL RESTORED
|
||
EI
|
||
RET
|
||
;
|
||
SETBK: ;SET BREAK POINT AT LOCATION D,E
|
||
PUSH PSW
|
||
PUSH B
|
||
LXI H,B, BLANK OUT
|
||
; NOT ., MAY BE CR
|
||
CPI CR
|
||
JNZ FLP ;FOR ANOTHER STORE
|
||
;
|
||
; NAME FILLED, EXTEND WITH BLANKS
|
||
FLB: DCR C
|
||
JZ TFTPOP D ;BKPT1
|
||
POP H ;GOTO ADDRESS
|
||
;
|
||
GOPR:
|
||
DI
|
||
JZ GOP1 ;NO BREAK POINTS
|
||
JC GOP0
|
||
; SET PC
|
||
SHLD PLOC ;INTO MACHINE STATE
|
||
MOV L,A ;BACK TO L
|
||
MVI A,0 ;CLEAR IT AGAIN
|
||
SBB H
|
||
MOV H,A
|
||
DAD D ;DIFFERENCE IN HL
|
||
CALL PADDR
|
||
JMP START
|
||
;
|
||
; SET INRE BC > DE (CARRY GEN'D IF TRUE)
|
||
MOV A,E
|
||
SUB C
|
||
MOV A,D
|
||
SBB B
|
||
RET
|
||
;
|
||
FILL:
|
||
CALL SCAN3 ;EXPRESSIONS SCANNED BC , DE , FIELD
|
||
LDAX D ;GET BYTE FROM PROGRAM
|
||
MOV M,A ;TO BREAKS VECTOR
|
||
MVI A,RSTIN ;RESTART INSTRUCTION
|
||
STAX D ;TO CODE
|
||
POP B
|
||
REAKS ;NUMBER OF BREAKS SET SO FAR
|
||
MOV A,M
|
||
INR M ;COUNT BREAKS UP
|
||
ORA A ;ONE SET ALREADY?
|
||
JZ SETBK0
|
||
; ALREADY SET, MOVE
|
||
MVI M,' '
|
||
INX H
|
||
JMP FLB
|
||
;
|
||
; BLANKS FILLED, SCAN FILE TYPE IF '.' FOUND
|
||
TFT: MVI C,4
|
||
CPI '.' ;ENDED WITH . OR CR
|
||
JN
|
||
GOP0: ;SET BREAKS
|
||
ANI 7FH ;CLEAR , BIT
|
||
DCR A ;IF 1 THEN SKIP (2,3 IF BREAKPOINTS)
|
||
JZ GOP1
|
||
CALL SETBK ;BREAK POINT FROMPUT FILE CONTROL BLOCK (AT 5CH) TO SIMULATE CONSOLE COMMAND
|
||
INFCB:
|
||
; FILL FCB AT 5CH
|
||
XRA A
|
||
STA FCB+FCR ;CLEAR CURRENT RECO HL
|
||
MOV A,H ;MUST BE ZERO
|
||
ORA A
|
||
JNZ CERROR
|
||
FILL0: CALL BCDE ;END OF FILL?
|
||
JC START
|
||
MOV A,L ;DATA
|
||
STAX B ;TO MEMORY
|
||
POP PSW
|
||
RET
|
||
;
|
||
;
|
||
; HEXADECIMAL ARITHMETIC
|
||
;
|
||
HEXARI:
|
||
CALL SCANEXP
|
||
CPI 2
|
||
JNZ CERROR
|
||
CALL GETVAL ;FIRST VALUE TO H, PAST ADDR,DATA FIELDS
|
||
INX H
|
||
MOV A,M ;CHECK = ADDRESSES
|
||
INX H
|
||
MOV B,M ;CHECK HO ADDRESS
|
||
INX H
|
||
; DON'T SET TWO BREAKPOZ FLB1 ;FILL REMAINDER WITH BLANKS
|
||
;
|
||
; SCAN FILE TYPE
|
||
LXI H,FCB+FFT
|
||
;
|
||
FLP1: CALL GNC
|
||
CPI CR
|
||
JZ FLB1
|
||
MOV M,A
|
||
INX H
|
||
D,E
|
||
DCR A
|
||
JZ GOP1
|
||
; SECOND BREAK POINT
|
||
MOV E,C
|
||
MOV D,B ;TO D,E
|
||
CALL SETBK ;SECOND BREAK POINT SET
|
||
;
|
||
GOP1: ;RESTORERD
|
||
STA FCB ;CLEAR DISK NUMBER
|
||
CALL GNC ;CHARACTER IN A
|
||
MVI C,9 ;FILE NAME LENGTH+1
|
||
LXI H,FCB+FFN ;START OF NAME
|
||
;
|
||
FLP:
|
||
INX B ;NEXT TO FILL
|
||
JMP FILL0
|
||
;
|
||
; GO COMMAND WITH OPTIONAL BREAKPOINTS
|
||
;
|
||
GOTO:
|
||
CALL CRLF ;READY FOR GO.
|
||
CALL SCANEXPL
|
||
PUSH H
|
||
CALL GETVAL ;SECOND VALUE TO H,L
|
||
POP D ;FIRST VALUE TO D,E
|
||
PUSH H ;SAVE A COPY OF SECOND VAALUE
|
||
CALL CRLF ;NEINTS IF EQUAL
|
||
CMP E ;LOW =?
|
||
JNZ SETBK0
|
||
MOV A,B
|
||
CMP D ;HIGH =?
|
||
JNZ SETBK0
|
||
; EQUAL ADDRESSES, REPLACE REAL DATA
|
||
MOV A
|
||
DCR C
|
||
JZ CERROR ;TOO LONG
|
||
JMP FLP1
|
||
;
|
||
; FILL WITH BLANKS
|
||
FLB1: DCR C
|
||
JZ FLZ
|
||
MVI M,' '
|
||
INX H
|
||
JMP FLB1
|
||
;
|
||
; ZERO MACHINE STATE AND START IT
|
||
LXI SP,STACK-12
|
||
POP D
|
||
POP B
|
||
POP PSW
|
||
POP H ;SP IN HL
|
||
SPHL
|
||
LHLD PLOC ;PC IN HL
|
||
PUSH H ;FILL NAME
|
||
MOV M,A
|
||
INX H
|
||
DCR C
|
||
JZ CERROR ;FILE NAME TOO LONG.
|
||
;
|
||
CALL GNC ;READ NEXT CHAR
|
||
CPI '.'
|
||
JZ FLB ;FOUND . ;0,1, OR 2 EXPS
|
||
CALL GETVAL
|
||
PUSH H ;START ADDRESS
|
||
CALL GETVAL
|
||
PUSH H ;BKPT1
|
||
CALL GETVAL
|
||
MOV B,H ;BKPT2
|
||
MOV C,L
|
||
W LINE
|
||
DAD D ;SUM IN H,L
|
||
CALL PADDR
|
||
CALL BLANK
|
||
POP H ;RESTORE SECOND VALUE
|
||
XRA A ;CLEAR ACCUM FOR SUBTRACTION
|
||
SUB L
|
||
THE EXTENT
|
||
FLZ: MVI M,0
|
||
JMP START
|
||
;
|
||
; MOVE MEMORY
|
||
MOVE:
|
||
CALL SCAN3 ;BC,DE,HL
|
||
MOVE0: ;HAS B,C PASSED D,E?
|
||
CALL BCDE
|
||
H ;BUFFER SIZE
|
||
LCOM1: LDAX D ;LOAD NEXT BYTE
|
||
INX D
|
||
MOV M,A ;STORE NEXT BYTE
|
||
INX H
|
||
DCR C
|
||
JNZ LCOM1
|
||
; LOADED, CHECK ADIF FILE OPEN WENT OK
|
||
; DISK FILE OPENED AND INITIALIZED
|
||
;
|
||
; CHECK FOR 'HEX' FILE AND LOAD DIRECT TIL EOF
|
||
CALL QHEX ;LOOK FO IN REG-D
|
||
PUSH B
|
||
PUSH H
|
||
PUSH D
|
||
;
|
||
CALL DISKR ;GET ONE MORE CHARACTER
|
||
CALL HEXCON ;CONVERT TO HEX (OR ERROR)
|
||
;
|
||
; SHIFV A,H
|
||
SBB D ;MLOAD-OLDHL GENS CARRY IF HL>MLOAD
|
||
XCHG
|
||
RET
|
||
;
|
||
CKMLOAD: ;CHECK FOR HL > MLOAD AND SET MLOAD IF SO
|
||
CALL COMYPE
|
||
; END OF TAPE, SET LOAD ADDRESS
|
||
MOV H,B
|
||
MOV L,C
|
||
SHLD PLOC ;SET PC VALUE
|
||
JMP RLIFT ;FOR ANOTHER COMMAND
|
||
;
|
||
RDTYPE:
|
||
JC START ;END OF MOVE
|
||
LDAX B ;CHAR TO ACCUM
|
||
INX B ;NEXT TO GET
|
||
MOV M,A ;MOVE IT TO MEMORY
|
||
INX H
|
||
JMP MOVE0 ;FOR ANOTHERDRESS AGAINST MLOAD
|
||
CALL CKMLOAD
|
||
JMP LCOM0
|
||
;
|
||
;
|
||
; OTHERWISE ASSUME HEX FILE IS BEING LOADED
|
||
HREAD: CALL DISKR ;NEXT CHAR R 'HEX'
|
||
JZ HREAD
|
||
;
|
||
; COM FILE, LOAD WITH OFFSET GIVEN BY PUSHED REGISTER H
|
||
POP H
|
||
LXI D,100H ;BASE OF TRANSIENT AREA
|
||
DAT LEFT AND MASK
|
||
RLC
|
||
RLC
|
||
RLC
|
||
RLC
|
||
ANI 0F0H
|
||
PUSH PSW ;SAVE FOR A FEW STEPS
|
||
CALL DISKR
|
||
CALL HEXCON
|
||
;
|
||
; OTHERWISE SLOAD ;CARRY IF HL>MLOAD
|
||
RNC
|
||
SHLD MLOAD ;CHANGE IT
|
||
RET
|
||
;
|
||
CHKDIS: ;CHECK FOR DISASSM PRESENT
|
||
PUSH H
|
||
LXI H,MODBAS ;ENTR
|
||
CALL RBYTE ;RECORD TYPE = 0
|
||
;
|
||
; LOAD RECORD
|
||
RED1: CALL RBYTE
|
||
MOV M,A
|
||
INX H
|
||
DCR E
|
||
JNZ RED1 ;FOR ANOTHER BYTE
|
||
; OTHE
|
||
;
|
||
; READ FILES (HEX OR COM)
|
||
;
|
||
QHEX: ;HEX FILE IF ZERO AT END
|
||
LXI H,FCB+FFT
|
||
MOV A,M
|
||
ANI 07FH ;MASK HIGH ORDER BIT
|
||
CPTO ACCUM
|
||
CPI DEOF ;PAST END OF TAPE?
|
||
JZ CERROR ;FOR ANOTHER COMMAND
|
||
SBI ':'
|
||
JNZ HREAD ;LOOKING FOR START OF RECORD
|
||
;
|
||
;D D
|
||
; REG H HOLDS LOAD ADDRESS
|
||
LCOM0: ;LOAD COM FILE
|
||
PUSH H ;SAVE DMA ADDRESS
|
||
LXI D,DFCB
|
||
MVI C,RDF ;READ SECTOR
|
||
CALL TECOND NIBBLE OK, SO MERGE
|
||
POP B ;PREVIOUS NIBBLE TO REG-B
|
||
ORA B
|
||
MOV B,A ;VALUE IS NOW IN B TEMPORARILY
|
||
POP D ;CHECKSUM
|
||
Y POINT
|
||
CALL COMLOAD
|
||
POP H
|
||
RET
|
||
;
|
||
READ:
|
||
CALL SCANEXP
|
||
LXI H,0
|
||
JZ READN
|
||
DCR A ;ONE EXPRESSION?
|
||
JNZ CERROR
|
||
CALL RWISE AT END OF RECORD - CHECKSUM
|
||
CALL RBYTE
|
||
PUSH PSW ;FOR CHECKSUM CHECK
|
||
CALL CKMLOAD ;CHECK AGAINST MLOAD
|
||
POP PSW
|
||
JNI 'H'
|
||
RNZ
|
||
INX H
|
||
MOV A,M
|
||
ANI 07FH ;MASK HIGH ORDER BIT
|
||
CPI 'E'
|
||
RNZ
|
||
INX H
|
||
MOV A,M
|
||
ANI 07FH ;MASK HIGH ORDER BIT
|
||
START FOUND, CLEAR CHECKSUM
|
||
MOV D,A
|
||
POP H
|
||
PUSH H
|
||
CALL RBYTE
|
||
MOV E,A ;SAVE LENGTH
|
||
CALL RBYTE ;HIGH ORDER ADDR
|
||
PUSHRAPAD
|
||
POP H
|
||
ORA A ;SET FLAGS TO CHECK RETURN CODE
|
||
JNZ RLIFT
|
||
; MOVE FROM 80H TO LOAD ADDRESS IN H,L
|
||
LXI D,DBF
|
||
MVI C,80 ADD D ;ACCUMULATING
|
||
MOV D,A ;BACK TO CS
|
||
; ZERO FLAG REMAINS SET
|
||
MOV A,B ;BRING BYTE BACK TO ACCUMULATOR
|
||
POP H
|
||
POP B ;BGETVAL ;EXPRESSION TO H,L
|
||
READN: PUSH H ;SAVE IT FOR BELOW
|
||
RINIT: CALL OPN ;OPEN INPUT FILE
|
||
CPI 255
|
||
JZ CERROR
|
||
; CONTINUE Z CERROR ;CHECKSUM ERROR
|
||
JMP HREAD ;FOR ANOTHER RECORD
|
||
;
|
||
RBYTE: ;READ ONE BYTE FROM BUFF AT WBP TO REG-A
|
||
; COMPUTE CHECKSUM
|
||
CPI 'X'
|
||
RET
|
||
;
|
||
COMLOAD: ;COMPARE HL > MLOAD
|
||
XCHG ;H,L TO D,E
|
||
LHLD MLOAD ;MLOAD TO H,L
|
||
MOV A,L ;MLOAD LSB
|
||
SUB E
|
||
MO PSW
|
||
CALL RBYTE ;LOW ORDER ADDR
|
||
POP B
|
||
MOV C,A
|
||
DAD B ;BIASED ADDR IN H
|
||
MOV A,E ;CHECK FOR LAST RECORD
|
||
ORA A
|
||
JNZ RDTACK TO INITIAL STATE WITH ACCUM SET
|
||
RET
|
||
RLIFT: ;LIFT HEAD ON DISK BEFORE RETURNING
|
||
MVI C,LIFT
|
||
CALL TRAPAD
|
||
; 'NEXT' ' PC' BREAKPOINTS AND STARTS EXECUTION
|
||
;
|
||
; EXAMINE AND MODIFY CPU REGISTERS.
|
||
EXAMINE:
|
||
CALL GNC ;CR?
|
||
CPI CR
|
||
JNZ EXAM0
|
||
CALL ESTORE DATA VALUE
|
||
MOV M,A
|
||
SETM1: INX H ;NEXT ADDRESS READY
|
||
JMP SETM0
|
||
;
|
||
; UNTRACE MODE
|
||
UNTRACE:
|
||
XRA A ;CLEAR TRACE MODEGSHF
|
||
; SHIFT COUNT IN C, D,E ADDRESS FLAG POSITION
|
||
MOV H,A ;FLAGS TO H
|
||
MOV B,C ;SHIFT COUNT TO B
|
||
MVI A,0FEH ;111111110 IN
|
||
POP H ;GET DATA
|
||
MOV A,M
|
||
PUSH H ;SAVE ADDRESS TO FILL
|
||
CALL PBYTE ;PRINT BYTE
|
||
CALL BLANK ;ANOTHER SEPARATOR
|
||
CALL GETBR ELEMENT
|
||
CALL DELT ;ELEMENT WRITTEN
|
||
CALL BLANK
|
||
CALL GETBUFF ;FILL COMMAND BUFFER
|
||
CALL SCANEXP ;GET INPUT EXPRESSION
|
||
O
|
||
LXI H,LMSG ;LOAD MESSAGE
|
||
RLI0: MOV A,M
|
||
ORA A ;LAST CHAR?
|
||
JZ RLI1
|
||
CALL PCHAR
|
||
INX H ;NEXT CHAR
|
||
JMP RLI0
|
||
RLI1: CALL DSTATE ;DISPLAY CPU STATE
|
||
JMP START
|
||
;
|
||
EXAM0: ;REGISTER CHANGE OPERATION
|
||
LXI B,PVAL+1 ;B=0,C=PVAL (MAX REGISTER NUMBER)
|
||
; FLAG
|
||
JMP ETRACE
|
||
;
|
||
; START TRACE
|
||
TRACE: MVI A,0FFH ;SET TRACE MODE FLAG
|
||
ETRACE:
|
||
STA TMODE
|
||
CALL SCANEXP
|
||
LXI H,0
|
||
JZ ACCUM TO ROTATE
|
||
CALL LROTATE ;ROTATE REG-A LEFT
|
||
ANA H ;MASK ALL BUT ALTERED BIT
|
||
MOV B,C ;RESTORE SHIFT COUNT TO B
|
||
MOV HUFF ;FILL INPUT BUFFER
|
||
CALL GNC ;MAY BE EMPTY (NO CHANGE)
|
||
POP H ;RESTORE ADDRESS TO FILL
|
||
CPI CR
|
||
JZ SETM1
|
||
CPI '.'
|
||
JZ RA A ;NONE?
|
||
JZ START
|
||
DCR A ;MUST BE ONLY ONE
|
||
JNZ CERROR
|
||
CALL GETVAL ;VALUE IS IN H,L
|
||
POP B ;RECALL REGISTER NUMBER
|
||
; CRLF
|
||
LHLD MLOAD
|
||
CALL PADDR
|
||
CALL BLANK
|
||
LHLD PLOC
|
||
CALL PADDR
|
||
JMP START
|
||
LMSG: DB CR,LF,'NEXT PC',0
|
||
;
|
||
; SET MEMORY CLOOK FOR REGISTER MATCH IN RVECT
|
||
LXI H,RVECT
|
||
EXAM1: CMP M ;MATCH IN RVECT?
|
||
JZ EXAM2
|
||
INX H ;NEXT RVECT
|
||
INR B ;INCREMENT TRAC0
|
||
; MUST BE T OR TN (N NOT 0)
|
||
DCR A ;COUNT MUST BE ONE
|
||
JNZ CERROR
|
||
CALL GETVAL ;GET VALUE TO HL
|
||
MOV A,L ;CHECK FOR Z,A ;SAVE MASKED FLAGS
|
||
MOV A,L ;0/1 TO LSB OF ACCUM
|
||
CALL LROTATE ;ROTATED TO CHANGED POSITION
|
||
ORA H ;RESTORE ALL OTHER FLAGSTART
|
||
; DATA IS BEING CHANGED
|
||
PUSH H ;SAVE ADDR TO FILL
|
||
CALL SCANEX ;FIRST CHARACTER ALREADY SCANNED
|
||
DCR A ;ONE ITEM?
|
||
JCHECK CASES FOR FLAGS, REG-A, OR DOUBLE REGISTER
|
||
MOV A,B
|
||
CPI AVAL
|
||
JNC EXAM4
|
||
; SETTING FLAGS, MUST BE ZERO OR ONE
|
||
MOV A,OMMAND
|
||
;
|
||
SETMEM: ;ONE EXPRESSION EXPECTED
|
||
CALL SCANEXP ;SETS FLAGS
|
||
DCR A ;ONE EXPRESSION ONLY
|
||
JNZ CERROR
|
||
CALL GETVAL ;COUNT
|
||
DCR C ;END OF RVECT?
|
||
JNZ EXAM1
|
||
; NO MATCH
|
||
JMP CERROR
|
||
;
|
||
EXAM2: ;MATCH IN RVECT, B HAS REGISTER NUMBER
|
||
CALL GNC
|
||
ERO
|
||
ORA H
|
||
JZ CERROR
|
||
DCX H ;TRACE VALUE - 1
|
||
TRAC0: SHLD TRACER
|
||
CALL DSTATE ;STARTING STATE IS DISPLAYED
|
||
JMP GOPR ;SETSS
|
||
STAX D ;BACK TO MACHINE STATE
|
||
JMP START ;FOR ANOTHER COMMAND
|
||
;
|
||
LROTATE: ;LEFT ROTATE FOR FLAG SETTING
|
||
; PATTERN IS IN RNZ CERROR ;MORE THAN ONE
|
||
CALL GETVAL ;VALUE TO H,L
|
||
MOV A,H
|
||
ORA A ;HO ZERO?
|
||
JNZ CERROR ;DATA IS IN L
|
||
MOV A,L
|
||
POP H ;RH
|
||
ORA A
|
||
JNZ CERROR
|
||
MOV A,L
|
||
CPI 2
|
||
JNC CERROR
|
||
; 0 OR 1 IN H,L REGISTERS - GET CURRENT FLAGS AND MASK POSITION
|
||
CALL FLSTART ADDRESS IS IN H,L
|
||
SETM0: CALL CRLF ;NEW LINE
|
||
PUSH H ;SAVE CURRENT ADDRESS
|
||
CALL PADDR ;PRINTED
|
||
CALL BLANK ;SEPARATOR CPI CR ;ONLY CHARACTER?
|
||
JNZ CERROR
|
||
;
|
||
; WRITE CONTENTS, AND GET ANOTHER BUFFER
|
||
PUSH B ;SAVE COUNT
|
||
CALL CRLF ;NEW LINE FOEGISTER A, COUNT IN REGISTER B
|
||
DCR B
|
||
RZ ;ROTATE COMPLETE
|
||
RLC ;END-AROUND ROTATE
|
||
JMP LROTATE
|
||
;
|
||
EXAM4: ;MAY BE ACCUMULATREUSE LOCALLY
|
||
LXI H,CURLEN
|
||
MOV A,M
|
||
ORA A ;ZERO?
|
||
MVI A,CR
|
||
JZ GNCRET ;RETURN WITH CR IF EXHAUSTED
|
||
DCR M ;CURLEN=CURLENETF ;GET BUFFER FUNCTION
|
||
LXI D,COMLEN;START OF COMMAND BUFFER
|
||
CALL TRAPAD ;FILL BUFFER
|
||
LXI H,COMBUF;NEXT TO GET
|
||
SHLD NEXAND
|
||
XCHG
|
||
LHLD DISMAX
|
||
MOV A,L
|
||
SUB E
|
||
MOV L,A ;REPLACE FOR ZERO TESTS LATER
|
||
MOV A,H
|
||
SBB D
|
||
XCHG
|
||
RET
|
||
;
|
||
DELIM: ;CH CHARACTER
|
||
RDC:
|
||
MVI D,0
|
||
MOV E,A
|
||
LXI H,DBF
|
||
DAD D
|
||
MOV A,M
|
||
CPI DEOF
|
||
JZ DEF ;END OF FILE
|
||
LXI H,DBP
|
||
INR M
|
||
ORA A
|
||
L PCHAR
|
||
MVI A,LF
|
||
JMP PCHAR
|
||
;
|
||
BREAK: ;CHECK FOR BREAK KEY
|
||
PUSH B
|
||
PUSH D
|
||
PUSH H
|
||
MVI C,CHKIO
|
||
CALL TRAPAD
|
||
ANI 1B
|
||
OR CHANGE
|
||
JNZ EXAM5
|
||
; MUST BE BYTE VALUE
|
||
MOV A,H
|
||
ORA A
|
||
JNZ CERROR
|
||
MOV A,L ;GET BYTE TO STORE
|
||
LXI H,ALOC ;A REG LOCA-1
|
||
LHLD NEXTCOM
|
||
MOV A,M ;GET NEXT CHARACTER
|
||
INX H ;NEXTCOM=NEXTCOM+1
|
||
SHLD NEXTCOM ;UPDATED
|
||
CALL TRANS
|
||
GNCRET: POP H ;TCOM
|
||
RET
|
||
;
|
||
BLANK:
|
||
MVI A,' '
|
||
;
|
||
PCHAR: ;PRINT CHARACTER TO CONSOLE
|
||
PUSH H
|
||
PUSH D
|
||
PUSH B
|
||
MOV E,A
|
||
MVI C,COF
|
||
CALLECK FOR DELIMITER CHARACTER
|
||
CPI CR
|
||
RZ
|
||
CPI ','
|
||
RZ
|
||
CPI ' '
|
||
RET
|
||
;
|
||
HEXCON: ;CONVERT ACCUMULATOR TO PURE BINARY FROM EX
|
||
JMP RRET
|
||
;
|
||
NDI: ;NEXT BUFFER IN
|
||
MVI C,RDF
|
||
LXI D,DFCB
|
||
CALL TRAPAD
|
||
ORA A
|
||
JNZ DEF
|
||
;
|
||
; BUFFER READ OK
|
||
STA DBP ;STO POP H
|
||
POP D
|
||
POP B
|
||
RET
|
||
;
|
||
PADDX: ;SAME AS PADDR, EXCEPT PRINT VALUE IN D,E
|
||
XCHG
|
||
;
|
||
PADDR: ;PRINT THE ADDRESS VALUE IN TION IN MACHINE STATE
|
||
MOV M,A ;STORE IT AWAY
|
||
JMP START
|
||
;
|
||
EXAM5: ;MUST BE DOUBLE REGISTER PAIR
|
||
PUSH H ;SAVE VALUE
|
||
CALL RESTORE ENVIRONMENT
|
||
RET
|
||
;
|
||
PNIB: ;PRINT NIBBLE IN LO ACCUM
|
||
CPI 10
|
||
JNC PNIBH ;JUMP IF A-F
|
||
ADI '0'
|
||
JMP PCHAR ;RET THRU TRAPAD
|
||
POP B
|
||
POP D
|
||
POP H
|
||
RET
|
||
;
|
||
TRANS:
|
||
; TRANSLATE TO UPPER CASE
|
||
CPI 7FH ;RUBOUT?
|
||
RZ
|
||
CPI ('A' OR 0100000B) ;UPPTERNAL HEX
|
||
SUI '0'
|
||
CPI 10
|
||
RC ;MUST BE 0-9
|
||
ADI ('0'-'A'+10) AND 0FFH
|
||
CPI 16
|
||
RC ;MUST BE 0-15
|
||
JMP CERROR ;BAD HEX RE 00H
|
||
JMP RDC
|
||
;
|
||
DEF: ;SET CARRY AND RETURN (END FILE)
|
||
STC
|
||
RRET:
|
||
POP B
|
||
POP D
|
||
POP H
|
||
RET
|
||
;
|
||
CERROR: ;ERROR IN COMMH,L
|
||
MOV A,H
|
||
CALL PBYTE
|
||
MOV A,L
|
||
JMP PBYTE
|
||
;
|
||
PGRAPH: ;PRINT GRAPHIC CHARACTER IN REG-A OR '.' IF NOT
|
||
CPI 7FH
|
||
JNC PPEGETDBA ;DOUBLE ADDRESS TO HL
|
||
POP D ;VALUE TO D,E
|
||
MOV M,E
|
||
INX H
|
||
MOV M,D ;ALTERED MACHINE STATE
|
||
JMP START
|
||
;
|
||
DISKR: ;DIPCHAR
|
||
PNIBH: ADI 'A'-10
|
||
JMP PCHAR
|
||
;
|
||
PBYTE: PUSH PSW ;SAVE A COPY FOR LO NIBBLE
|
||
RAR
|
||
RAR
|
||
RAR
|
||
RAR
|
||
ANI 0FH ;MASK HO NER CASE A
|
||
RC
|
||
ANI 1011111B ;CLEAR UPPER CASE BIT
|
||
RET
|
||
;
|
||
GNC:
|
||
; GET NEXT BUFFER CHARACTER FROM CONSOLE
|
||
PUSH H ;SAVE FOR DIGIT
|
||
;
|
||
GETVAL: ;GET NEXT EXPRESSION VALUE TO H,L (POINTER IN D,E ASSUMED)
|
||
XCHG
|
||
MOV E,M
|
||
INX H
|
||
MOV D,M
|
||
INX H
|
||
XCHG
|
||
AND
|
||
CALL CRLF
|
||
MVI A,'?'
|
||
CALL PCHAR
|
||
JMP START
|
||
;
|
||
; SUBROUTINES
|
||
GETBUFF: ;FILL COMMAND BUFFER AND SET POINTERS
|
||
MVI C,GRIOD
|
||
CPI ' '
|
||
JNC PCHAR
|
||
PPERIOD:
|
||
MVI A,'.'
|
||
JMP PCHAR
|
||
;
|
||
DISCOM: ;COMPARE H,L AGAINST DISMAX. CARRY SET IF HL > DISMAX SK READ
|
||
PUSH H
|
||
PUSH D
|
||
PUSH B
|
||
;
|
||
RDI: ;READ DISK INPUT
|
||
LDA DBP
|
||
ANI 7FH
|
||
JZ NDI ;GET NEXT DISK INPUT RECORD
|
||
;
|
||
; READIBBLE TO LO NIBBLE
|
||
CALL PNIB
|
||
POP PSW ;RECALL BYTE
|
||
ANI 0FH
|
||
JMP PNIB
|
||
;
|
||
CRLF: ;CARRIAGE RETURN LINE FEED
|
||
MVI A,CR
|
||
CAL RET
|
||
;
|
||
GETEXP: ;GET HEX VALUE TO D,E
|
||
XCHG
|
||
LXI H,0
|
||
GETEXP0:
|
||
CALL HEXCON
|
||
DAD H ;*2
|
||
DAD H ;*4
|
||
DAD H ;*8
|
||
DAD H ;*16OV C,M ;SHIFT COUNT TO C
|
||
LXI H,FLOC ;ADDRESS OF FLAGS
|
||
MOV A,M ;TO REG A
|
||
XCHG ;SAVE ADDRESS
|
||
POP H
|
||
RET
|
||
;
|
||
GETFLG: OK AT COUNT
|
||
LDAX D ;LOAD COUNT TO ACC
|
||
CPI 81H ;, WITHOUT B?
|
||
JZ CERROR
|
||
INX D ;READY TO EXTRACT EXPN'S
|
||
ORA A ;ZERO FLLXI H,ALOC
|
||
MOV A,M
|
||
CALL PBYTE
|
||
RET
|
||
;
|
||
DELT1: ;DOUBLE BYTE DISPLAY
|
||
CALL GETDBL ;TO H,L
|
||
CALL PADDR ;PRINTED
|
||
RET
|
||
;
|
||
DSDY TO FILL EXPRESSION LIST
|
||
CPI CR ;END OF LINE?
|
||
JZ SCANRET
|
||
;
|
||
; NOT CR, MUST BE DIGIT OR COMMA
|
||
CPI ','
|
||
JNZ SCANE0
|
||
; MA
|
||
CALL GETDBA ;ADDRESS OF ELT IN HL
|
||
MOV E,M ;LSB
|
||
INX H
|
||
MOV D,M ;MSB
|
||
XCHG ;BACK TO HL
|
||
RET
|
||
;
|
||
DELT: ;DISPLAY CPU ELEME
|
||
ORA L ;HL=HL+HEX
|
||
MOV L,A
|
||
CALL GNC
|
||
CALL DELIM ;DELIMITER?
|
||
JNZ GETEXP0
|
||
XCHG
|
||
RET
|
||
;
|
||
SCSTORE: ;STORE D,E TO H,L AND ;GET FLAG GIVEN BY REG-B TO REG-A AND MASK
|
||
CALL FLGSHF ;BITS TO SHIFT IN REG-A
|
||
GETFL0: DCR C
|
||
JZ GETFL1
|
||
RAR
|
||
JMP GETFL0
|
||
AG MAY BE SET
|
||
RLC
|
||
RRC ;SET CARRY IF HO BIT SET (,B)
|
||
RET ;WITH FLAGS SET
|
||
;
|
||
;
|
||
; SUBROUTINES FOR CPU STATE DISPLAY
|
||
FLGTATE: ;DISPLAY CPU STATE
|
||
LXI H,RVECT ;REGISTER VECTOR
|
||
MVI B,0 ;REGISTER COUNT
|
||
CALL CRLF
|
||
DSTA0: PUSH B
|
||
PUSH H
|
||
CALL DELRK AS COMMA
|
||
MVI A,80H
|
||
STA EXPLIST
|
||
LXI D,0
|
||
JMP SCANE1
|
||
;
|
||
SCANE0: ;NOT CR OR COMMA
|
||
CALL GETEXP ;EXPRESSION TO D,E
|
||
SCANNT GIVEN BY COUNT IN REG-B, ADDRESS IN H,L
|
||
MOV A,M ;GET CHARACTER
|
||
CALL PCHAR ;PRINT IT
|
||
MOV A,B ;GET COUNT
|
||
CPI AVAL ;PASTINCREMENT ADDRESS
|
||
MOV M,E
|
||
INX H
|
||
MOV M,D
|
||
INX H
|
||
PUSH H
|
||
LXI H,EXPLIST
|
||
INR M ;COUNT NUMBER OF EXPN'S
|
||
POP H
|
||
RET
|
||
;
|
||
GETFL1: ANI 1B
|
||
RET
|
||
;
|
||
GETDBA: ;GET DOUBLE BYTE ADDRESS CORRESPONDING TO REG-A TO HL
|
||
SUI BVAL ;NORMALIZE TO 0,1,...
|
||
LXI H,SHF: ;SHIFT COMPUTATION FOR FLAG GIVEN BY REG-B
|
||
; REG A CONTAINS FLAG UPON EXIT (UNSHIFTED)
|
||
; REG C CONTAINS NUMBER OF SHIFTS T ;ELEMENT DISPLAYED
|
||
POP H ;RVECT ADDRESS RESTORED
|
||
POP B ;COUNT RESTORED
|
||
INR B ;NEXT COUNT
|
||
INX H ;NEXT REGISTER
|
||
MOV A,E1: CALL SCSTORE ;STORE THE EXPRESSION AND INCREMENT H,L
|
||
CPI CR
|
||
JZ SCANRET
|
||
CALL GNC
|
||
CALL GETEXP
|
||
CALL SCSTORE
|
||
; SECOND A?
|
||
JNC DELT0 ;JMP IF NOT FLAG
|
||
;
|
||
; DISPLAY FLAG
|
||
CALL GETFLG ;FLAG TO REG-A
|
||
CALL PNIB
|
||
RET
|
||
;
|
||
DELT0: ;NOT FLAG, DISPLAY
|
||
SCANEXP: ;SCAN EXPRESSIONS - CARRY SET IF ,B
|
||
; ZERO SET IF NO EXPRESSIONS, A SET TO NUMBER OF EXPRESSIONS
|
||
; HI ORDER BIT SET RINX ;INDEX TO STACKED VALUES
|
||
MOV E,A ;INDEX TO E
|
||
MVI D,0 ;DOUBLE PRECISION
|
||
DAD D ;INDEXED INTO VECTOR
|
||
MOV E,M ;OFFSET TREQUIRED+1
|
||
; REGS D,E CONTAIN ADDRESS OF FLAGS IN TEMPLATE
|
||
PUSH H
|
||
LXI H,FLGTAB ;SHIFT TABLE
|
||
MOV E,B
|
||
MVI D,0
|
||
DAD D
|
||
MB ;LAST COUNT?
|
||
CPI PVAL+1
|
||
JNC DSTA1 ;JMP IF PAST END
|
||
CPI AVAL ;BLANK AFTER?
|
||
JC DSTA0
|
||
; YES, BLANK AND GO AGAIN
|
||
CALL B DIGIT SCANNED
|
||
CPI CR
|
||
JZ SCANRET
|
||
CALL GNC
|
||
CALL GETEXP
|
||
CALL SCSTORE
|
||
CPI CR
|
||
JNZ CERROR
|
||
SCANRET:
|
||
LXI D,EXPLIST ;LO = AND DATA
|
||
PUSH PSW
|
||
MVI A,'='
|
||
CALL PCHAR
|
||
POP PSW
|
||
JNZ DELT1 ;JUMP IF NOT REG-A
|
||
;
|
||
; REGISTER A, DISPLAY BYTE VALUE
|
||
IF ,B ALSO
|
||
CALL GNC
|
||
SCANEX: ;ENTER HERE IF CHARACTER ALREADY SCANNED
|
||
LXI H,EXPLIST
|
||
MVI M,0 ;ZERO EXPRESSIONS
|
||
INX H ;REAO E
|
||
MVI D,0FFH ;-1
|
||
LXI H,STACK
|
||
DAD D ;HL HAS BASE ADDRESS
|
||
RET
|
||
;
|
||
GETDBL: ;GET DOUBLE BYTE CORRESPONDING TO REG-A TO HL
|
||
LANK
|
||
JMP DSTA0
|
||
;
|
||
; READY TO SEND DECODED INSTRUCTION
|
||
DSTA1:
|
||
CALL BLANK
|
||
CALL NBRK ;COMPUTE BREAKPOINTS IN CASE OF TRACE
|
||
RETURN ADDRESS
|
||
DCX H ;DECREMENT FOR RESTART
|
||
SHLD PLOC
|
||
; DAD SP BELOW DESTROYS CY, SO SAVE AND RECALL
|
||
PUSH PSW ;INTO USERT: DB 'CZMEIABDHSP'
|
||
RINX: DB (BLOC-STACK) AND 0FFH ;LOCATION OF BC
|
||
DB (DLOC-STACK) AND 0FFH ;LOCATION OF DE
|
||
DB (HLOC-STACK)INSTRUCTION
|
||
XCHG ;TO D,E FOR COMPARE
|
||
LXI H,TRAPJMP+1
|
||
MOV C,M ;LOW BDOS ADDR
|
||
INX H
|
||
MOV B,M ;HIGH BDOS ADDR
|
||
CALL BCDEPBYTE
|
||
INX H ;READY FOR NEXT BYTE
|
||
CALL DISCOM ;ZERO SET IF ONE BYTE TO PRINT, CARRY IF NO MORE
|
||
JC DSTRET
|
||
PUSH PSW ;SAVE RNY MORE?
|
||
JZ CLER1
|
||
DCR A
|
||
MOV B,A ;SAVE COUNT
|
||
INX H ;ADDRESS OF BREAK
|
||
MOV E,M ;LOW ADDR
|
||
INX H
|
||
MOV D,M ;HIGH ADDR
|
||
I
|
||
PUSH PSW ;SAVE EXPRESSION COUNT - B,C AND D,E HAVE BPTS
|
||
PUSH D ;SAVE BP ADDRESS
|
||
PUSH B ;SAVE AUX BREAKPOINT
|
||
CALL CHKDIS 'S STACK
|
||
LXI H,2 ;BIAS SP BY 2 BECAUSE OF PUSH
|
||
DAD SP ;SP IN HL
|
||
POP PSW ;RESTORE CY AND FLAGS
|
||
LXI SP,STACK-4;LOCAL STACK AND 0FFH ;LOCATION OF HL
|
||
DB (SLOC-STACK) AND 0FFH ;LOCATION OF SP
|
||
DB (PLOC-STACK) AND 0FFH ;LOCATION OF PC
|
||
; FLGTAB ELEMEN ;CY IF BDOS>PLOC
|
||
JC BREAK0 ;BRANCH IF PLOC <= BDOS
|
||
;
|
||
; IN THE BDOS, DON'T BREAK UNTIL THE RETURN OCCURS
|
||
CALL CLRTRACE;CLEESULT OF ZERO TEST
|
||
CALL BLANK ;SEPARATOR
|
||
POP PSW ;RECALL ZERO TEST
|
||
ORA E ;ZERO TEST
|
||
JZ DSTA2
|
||
; DISPLAY DOUBLE BYTE
|
||
MONX H
|
||
MOV A,M ;INSTRUCTION
|
||
STAX D ;BACK TO PROGRAM
|
||
MOV A,B ;RESTORE COUNT
|
||
JMP CLER0
|
||
;
|
||
CLER1: ;CLEARED, CONTINUE TRACING;CHECK TO SEE IF DISASSEMBER IS HERE
|
||
JNC DCHEX ;DISPLAY HEX IF NOT
|
||
; DISASSEMBLE CODE
|
||
LHLD PLOC ;GET CURRENT PC
|
||
SHLD DISP
|
||
PUSH H ;SP SAVED
|
||
PUSH PSW
|
||
PUSH B
|
||
PUSH D
|
||
; MACHINE STATE SAVED, CLEAR BREAK POINTS
|
||
LHLD PLOC ;CHECK FOR RST INSTRUCTITS DETERMINE SHIFT COUNT TO SET/EXTRACT FLAGS
|
||
FLGTAB: DB 1,7,8,3,5 ;CY, ZER, SIGN, PAR, IDCY
|
||
;
|
||
CLRTRACE: ;CLEAR THE TRACE FLAAR TRACE FLAGS
|
||
LHLD RETLOC ;TRAPPED RETLOC ON ENTRY TO DOS
|
||
XCHG ;TO D,E READY FOR BREAKPOINT
|
||
MVI A,82H ;LOOKS LIKE G,BBBBV E,M
|
||
INX H
|
||
MOV D,M
|
||
XCHG
|
||
CALL PADDR ;PRINT ADDRESS
|
||
JMP DSTRET
|
||
;
|
||
DSTA2: ;PRINT BYTE VALUE
|
||
MOV A,M
|
||
CALL PBYTE
|
||
DST, OR STOP EXECUTION
|
||
POP H ;RESTORE PLOC
|
||
POP PSW ;RESTORE CONDITION FLAGS
|
||
JZ BREAK0 ;BRANCH IF PROGRAMMED INTERRUPT
|
||
;
|
||
; MC ;SET DISASSM PC
|
||
LXI H,DISPG;PAGE MODE = 0FFH TO TRACE
|
||
MVI M,0FFH
|
||
CALL DISEN
|
||
JMP DSTRET
|
||
;
|
||
DCHEX: ;DISPLAY HEX
|
||
DCX HON
|
||
MOV A,M ;OPCODE TO A
|
||
CPI RSTIN
|
||
; SAVE CONDITION CODES FOR LATER TEST
|
||
PUSH PSW
|
||
; SAVE PLOC FOR LATER INCREMENT OR DECRG
|
||
LXI H,0
|
||
SHLD TRACER
|
||
RET
|
||
;
|
||
BREAKP: ;ARRIVE HERE WHEN PROGRAMMED BREAK OCCURS
|
||
DI
|
||
SHLD HLOC ;HL SAVED
|
||
POP H ;RECALL
|
||
ORA A ;SETS FLAGS
|
||
STC ;SUBSEQUENT TEST FOR CY
|
||
JMP GOPR ;START PROGRAM EXECUTION, WITH BREAKPOINT
|
||
;
|
||
BREAK0: ;NORMAL BRERET:
|
||
POP B ;AUX BREAKPOINT
|
||
POP D ;RESTORE BREAKPOINT
|
||
POP PSW ;RESTORE COUNT
|
||
RET
|
||
;
|
||
; DATA VECTORS FOR CPU DISPLAY
|
||
RVECUST BE FRONT PANEL INTERRUPT, CHECK IF IN BDOS
|
||
INX H ;DON'T DECREMENT ON PANEL INTERRUPT
|
||
SHLD PLOC ;RESTORE TO NEXT LOGICAL ;POINT TO LAST TO WRITE
|
||
SHLD DISMAX ;SAVE FOR COMPARE BELOW
|
||
LHLD PLOC ;START ADDRESS OF TRACE
|
||
MOV A,M ;GET OPCODE
|
||
CALL EMENT
|
||
PUSH H
|
||
;
|
||
; CLEAR BREAKPOINTS WHICH ARE PENDING
|
||
LXI H,BREAKS
|
||
MOV A,M
|
||
MVI M,0 ;SET TO ZERO BREAKS
|
||
CLER0: ORA A ;AAKPOINT
|
||
EI
|
||
LHLD TRACER
|
||
MOV A,H
|
||
ORA L
|
||
JZ STOPEX
|
||
;
|
||
; TRACE IS ON
|
||
DCX H
|
||
SHLD TRACER
|
||
CALL BREAK ;BREAK KEY DEPRESSCATTAB: DW JMPOP ;JUMP OPERATOR
|
||
DW CCOP ;JUMP CONDITIONAL
|
||
DW JMPOP ;CALL OPERATOR (TREATED AS JMP)
|
||
DW CCOP ;CALL CONDITIONS SETUP AS IF USER TYPED G,B1,B2 OR
|
||
; G,B1 DEPENDING UPON OPERATOR CATEGORY. B,C CONTAINS SECOND BP,
|
||
; D,E CONTAINS PRIMARY BFLAG SET
|
||
;
|
||
GETSP: ;GET RETURN ADDRESS FROM USER'S STACK TO D,E
|
||
LHLD SLOC
|
||
MOV E,M
|
||
INX H
|
||
MOV D,M
|
||
RET
|
||
;
|
||
CCOP: ;CALL C OPCODE CATEGORY - CODE IN REGISTER B
|
||
; D,E CONTAIN DOUBLE PRECISION CATEGORY NUMBER ON RETURN
|
||
LXI D,OPMAX ;D=0,E=OPMAX
|
||
LXITHERWISE, TREAT AS A RETURN INSTRUCTION
|
||
RETOP: CALL GETSP ;ADDRESS AT STACKTOP TO D,E
|
||
JMP ENDOP ;TREAT AS SIMPLE OPERATOR
|
||
;
|
||
ED?
|
||
JNZ STOPEX
|
||
LDA TMODE ;TRACE MODE T IF 0FFH
|
||
ORA A
|
||
JNZ BREAK1
|
||
; NOT TRACING, BUT MONITORING, SO SET BREAKPOINTS
|
||
CALAL
|
||
DW RETOP ;RETURN FROM SUBROUTINE
|
||
DW RSTOP ;RESTART
|
||
DW PCOP ;PCHL
|
||
DW IMOP ;SINGLE PRECISION IMMEDIATE (2 BYTE)
|
||
DW IMP. HL ADDRESS NEXT OPCODE BYTE
|
||
LHLD PLOC
|
||
MOV B,M ;GET OPERATOR
|
||
INX H ;HL ADDRESS BYTE FOLLOWING OPCODE
|
||
PUSH H ;SAVE IT ONDITIONAL OPERATOR
|
||
CALL GETOPA ;GET OPERAND ADDRESS TO D,E / COMPARE WITH BDOS
|
||
JZ CCOP1
|
||
; NOT THE BDOS, BREAK AT OPERAND A H,OPLIST
|
||
CAT0: MOV A,M ;MASK TO A
|
||
ANA B ;MASK OPCODE FROM B
|
||
INX H ;READY FOR COMPARE
|
||
CMP M ;SAME AFTER MASK?
|
||
INX H ;R
|
||
CBDOS: ;COMPARE D,E WITH BDOS ADDRESS, RETURN ZERO FLAG IF EQUAL
|
||
LDA TRAPJMP+1
|
||
CMP E
|
||
RNZ
|
||
LDA TRAPJMP+2
|
||
CMP D
|
||
RET
|
||
;L NBRK
|
||
JMP GOPR
|
||
;
|
||
BREAK1: ;TRACING AND MONITORING
|
||
CALL DSTATE ;STATE DISPLAYED, CHECK FOR BREAKPOINTS
|
||
JMP GOPR ;STARTS EOP ;ADI ... CPI
|
||
DW DIMOP ;DOUBLE PRECISION IMMEDIATE (3 BYTES)
|
||
DW DIMOP ;LHLD ... STA
|
||
DW RCOND ;RETURN CONDITIONAL
|
||
DW IMFOR LATER
|
||
CALL CAT ;DETERMINE OPERATOR CATEGORY
|
||
LXI H,CATNO ;SAVE CATEGORY NUMBER
|
||
MOV M,E
|
||
LXI H,CATTAB;CATEGORY TABLE BADDRESS AND NEXT ADDRESS
|
||
POP B ;NEXT ADDRESS TO B,C
|
||
PUSH B ;BACK TO STACK
|
||
MVI A,2 ;TWO BREAKPOINTS
|
||
JMP RETCAT ;RETURN FROEADY FOR NEXT COMPARE
|
||
JZ CAT1 ;EXIT IF COMPARED OK
|
||
INR D ;UP COUNT IF NOT MATCHED
|
||
DCR E ;FINISHED?
|
||
JNZ CAT0
|
||
CAT1: MOV E
|
||
GETOPA: ;GET OPERAND ADDRESS AND COMPARE WITH BDOS
|
||
POP B ;GET RETURN ADDRESS
|
||
POP H ;GET OPERAND ADDRESS
|
||
MOV E,M
|
||
INX H
|
||
XECUTION
|
||
;
|
||
STOPEX:
|
||
CALL CLRTRACE ;TRACE FLAGS GO TO ZERO
|
||
MVI A,'*'
|
||
CALL PCHAR
|
||
LHLD PLOC
|
||
; CHECK TO ENSURE DISASSEMBLEOP ;IN/OUT
|
||
; NEXT DW MUST BE THE LAST IN THE SEQUENCE
|
||
DW SIMOP ;SIMPLE OPERATOR (1 BYTE)
|
||
;
|
||
JMPOP: ;GET OPERAND FIELD, CHECKSE
|
||
DAD D ;INXED
|
||
DAD D ;INXED*2
|
||
MOV E,M ;LOW BYTE TO E
|
||
INX H
|
||
MOV D,M ;HIGH BYTE TO D
|
||
XCHG
|
||
PCHL ;JUMP INTO TABLE
|
||
M NBRK
|
||
;
|
||
CCOP1: ;BREAK ADDRESS AT NEXT LOCATION ONLY, WAIT FOR RETURN FROM BDOS
|
||
POP D
|
||
PUSH D ;BACK TO STACK
|
||
JMP ENDOP ;O,D ;E IS CATEGORY NUMBER
|
||
MVI D,0 ;DOUBLE PRECISION
|
||
RET
|
||
;
|
||
NBRK: ;FIND NEXT BREAK POINT ADDRESS
|
||
; UPON RETURN, REGISTER A I
|
||
MOV D,M
|
||
INX H
|
||
PUSH H ;UPDATED PC INTO STACK
|
||
PUSH B ;RETURN ADDRESS TO STACK
|
||
JMP CBDOS ;RETURN THROUGH CBDOS WITH ZERO R IS PRESENT
|
||
CALL CHKDIS
|
||
JNC STOP0
|
||
SHLD DISPC
|
||
STOP0: CALL PADDR
|
||
LHLD HLOC
|
||
SHLD DISLOC
|
||
JMP START
|
||
;
|
||
CAT: ;DETERMINE FOR BDOS
|
||
CALL GETOPA ;GET OPERAND ADDRESS TO D,E AND COMPARE WITH BDOS
|
||
JNZ ENDOP ;TREAT AS SIMPLE OPERATOR IF NOT BDOS
|
||
; ONE BREAKPOINT ADDRESS
|
||
;
|
||
RSTOP: ;RESTART INSTRUCTION - CHECK FOR RST 7
|
||
MOV A,B
|
||
CPI RSTIN ;RESTART INSTRUCTION USED FOR SOFTEQU ($-OPLIST)/2
|
||
;
|
||
CATNO: DS 1 ;CATEGORY NUMBER SAVED IN NBRK
|
||
RETLOC: DS 2 ;RETURN ADDRESS TO USER FROM BDOS
|
||
TMODE: DS 1 ;TRTABLES
|
||
OPLIST: DB 1111$1111B, 1100$0011B ;0 JMP
|
||
DB 1100$0111B, 1100$0010B ;1 JCOND
|
||
DB 1111$1111B, 1100$1101B ;2 CALL
|
||
DB 1裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹GET RETURN ADDRESS FROM STACK
|
||
POP B ;B,C ALTERNATE LOCATION
|
||
PUSH B ;REPLACE IT
|
||
MVI A,2
|
||
JMP RETCAT ;TO SET FLAGS AND RETULOC EQU STACK-6 ;SP
|
||
ALOC EQU STACK-7 ;A
|
||
FLOC EQU STACK-8 ;FLAGS
|
||
BLOC EQU STACK-10 ;BC
|
||
DLOC EQU STACK-12;D,E
|
||
;
|
||
NOP ;FOR R INT
|
||
JNZ RST0
|
||
;
|
||
; SOFT RST, NO BREAK POINT SINCE IT WILL OCCUR IMMEDIATELY
|
||
XRA A
|
||
JMP RETCAT1 ;ZERO ACCUMULATOR
|
||
RST0: ANACE MODE
|
||
TRACER: DS 2 ;TRACE COUNT
|
||
BREAKS: DS 7 ;#BREAKS/BKPT1/DAT1/BKPT2/DAT2
|
||
EXPLIST:DS 7 ;COUNT+(EXP1)(EXP2)(EXP3)
|
||
DISLOC100$0111B, 1100$0100B ;3 CCOND
|
||
DB 1111$1111B, 1100$1001B ;4 RET
|
||
DB 1100$0111B, 1100$0111B ;5 RST 0..7
|
||
DB 1111$1111B, 1110$裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹RN
|
||
;
|
||
DIMOP: ;DOUBLE PRECISION IMMEDIATE OPERATOR
|
||
POP D
|
||
INX D ;INCREMENTED ONCE, DROP THRU FOR ANOTHER
|
||
PUSH D ;COPY BACK
|
||
ELOCATION BOUNDARY
|
||
END
|
||
I 111000B ;GET RESTART NUMBER
|
||
MOV E,A
|
||
MVI D,0 ;DOUBLE PRECISION BREAKPOINT TO D,E
|
||
JMP ENDOP
|
||
;
|
||
PCOP: ;PCHL
|
||
LHLD HLOC
|
||
: DS 2 ;DISPLAY LOCATION
|
||
DISMAX: DS 2 ;MAX VALUE FOR CURRENT DISPLAY
|
||
TDISP: DS 2 ;TEMP 16 BIT LOCATION
|
||
NEXTCOM:DS 2 ;NEXT LOC1001B ;6 PCHL
|
||
DB 1100$0111B, 0000$0110B ;7 MVI
|
||
DB 1100$0111B, 1100$0110B ;8 ADI...CPI
|
||
DB 1100$1111B, 0000$0001B ;9 LXI
|
||
D裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹
|
||
;
|
||
IMOP: ;SINGLE PRECISION IMMEDIATE
|
||
POP D
|
||
INX D
|
||
PUSH D
|
||
;
|
||
ENDOP: ;END OPERATOR SCAN
|
||
MVI A,1 ;SINGLE BREAKPOINT
|
||
RETCA裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹XCHG ;HL VALUE TO D,E FOR BREAKPOINT
|
||
CALL CBDOS ;BDOS VALUE?
|
||
JNZ ENDOP
|
||
; PCHL TO BDOS, USE RETURN ADDRESS
|
||
JMP RETOP
|
||
;
|
||
ATION FROM COMMAND BUFFER
|
||
COMLEN: DB CSIZE ;MAX COMMAND LENGTH
|
||
CURLEN: DS 1 ;CURRENT COMMAND LENGTH
|
||
COMBUF: DS CSIZE ;COMMANDB 1110$0111B, 0010$0010B ;10 LHLD SHLD LDA STA
|
||
DB 1100$0111B, 1100$0000B ;11 RCOND
|
||
DB 1111$0111B, 1101$0011B ;IN OUT
|
||
OPMAX 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹T: ;RETURN FROM NBRK
|
||
INR A ;COUNT UP FOR G,...
|
||
STC
|
||
RETCAT1:
|
||
POP H ;RECALL NEXT ADDRESS
|
||
RET
|
||
;
|
||
;
|
||
;
|
||
; OPCODE CATEGORY 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹JMP ENDOP
|
||
;
|
||
SIMOP: ;SIMPLE OPERATOR, USE STACKED PC
|
||
POP D
|
||
PUSH D
|
||
JMP ENDOP
|
||
;
|
||
RCOND: ;RETURN CONDITIONAL
|
||
CALL GETSP ; BUFFER
|
||
MLOAD: DS 2 ;MAX LOAD ADDRESS
|
||
DS SSIZE ;STACK AREA
|
||
STACK:
|
||
PLOC EQU STACK-2 ;PC IN TEMPLATE
|
||
HLOC EQU STACK-4 ;HL
|
||
S; assembly language version of mem$move for ed speedup
|
||
; version 2.0 of ED
|
||
;
|
||
mem$move equ 13cah
|
||
moveflag equ 1d34h
|
||
directio裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹d ;cy if true
|
||
jnc emove
|
||
dcx d ;front=front-1
|
||
ldax d ;char to a
|
||
cpi lf
|
||
jnz notlfb
|
||
push h
|
||
lhld baseline
|
||
dcx h ;bas *
|
||
;* *
|
||
;*****************************************************
|
||
blksiz equ
|
||
pop h
|
||
pop d ;bc=last, de=front, hl=back
|
||
movef: mov a,l ;back < last?
|
||
sub c
|
||
mov a,h
|
||
sbb b ;cy if true
|
||
jnc emove
|
||
in**********************
|
||
;
|
||
; utility macro to compute sector mask
|
||
smask macro hblk
|
||
;; compute log2(hblk), return @x as result
|
||
n equ 1d20h
|
||
front equ 1d22h
|
||
back equ 1d24h
|
||
first equ 1d26h
|
||
last equ 1d28h
|
||
baseline equ 1c10h
|
||
memory equ 1d4dh
|
||
;
|
||
for裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹eline=baseline-1
|
||
shld baseline
|
||
pop h
|
||
notlfb: push psw ;save char
|
||
lda moveflag
|
||
rar
|
||
jnc nomove
|
||
pop psw
|
||
mov m,a ;sto 2048 ;CP/M allocation size
|
||
hstsiz equ 512 ;host disk sector size
|
||
hstspt equ 20 ;host disk sectors/trk
|
||
hstblk equ hstsiz/1x h ;back=back+1
|
||
mov a,m ;char to a
|
||
cpi lf ;end of line?
|
||
jnz notlff
|
||
push h
|
||
lhld baseline
|
||
inx h ;baseline=baseline+1
|
||
;; (2 ** @x = hblk on return)
|
||
@y set hblk
|
||
@x set 0
|
||
;; count right shifts of @y until = 1
|
||
rept 8
|
||
if @y = 1
|
||
exitm
|
||
endiward equ 1
|
||
lf equ 0ah
|
||
;
|
||
org mem$move
|
||
lxi h,moveflag
|
||
mov m,c ;1 = move data
|
||
lxi d,memory
|
||
lhld front
|
||
dad d ;memory裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹re to back
|
||
dcx h
|
||
jmp moveb
|
||
nomove: pop psw
|
||
jmp moveb
|
||
;
|
||
emove: push d
|
||
lxi d,-memory
|
||
dad d ;relative value of back
|
||
28 ;CP/M sects/host buff
|
||
cpmspt equ hstblk * hstspt ;CP/M sectors/track
|
||
secmsk equ hstblk-1 ;sector mask
|
||
smask hstblk ;comp
|
||
shld baseline
|
||
pop h
|
||
notlff:
|
||
stax d ;to front
|
||
inx d ;front=front+1
|
||
jmp movef
|
||
|
||
moveback:
|
||
lhld first
|
||
dad d ;memoryf
|
||
;; @y is not 1, shift right one position
|
||
@y set @y shr 1
|
||
@x set @x + 1
|
||
endm
|
||
endm
|
||
;
|
||
;*********************************+front
|
||
push h
|
||
lhld back
|
||
dad d
|
||
push h
|
||
lda direction
|
||
cpi forward
|
||
jnz moveback
|
||
lhld last
|
||
mov a,c ;moveflag to a
|
||
;*****************************************************
|
||
;* *
|
||
;* Sector Dshld back
|
||
pop h
|
||
dad d ;relative value of front
|
||
shld front
|
||
ret
|
||
end
|
||
ute sector mask
|
||
secshf equ @x ;log2(hstblk)
|
||
;
|
||
;*****************************************************
|
||
;* +first
|
||
mov b,h
|
||
mov c,l
|
||
pop h
|
||
pop d ;bc=first, de=front, hl=last
|
||
moveb: mov a,c ;first > front?
|
||
sub e
|
||
mov a,b
|
||
sbb ********************
|
||
;* *
|
||
;* CP/M to host disk constants rar
|
||
jc moveforw
|
||
; set back to last
|
||
shld back
|
||
pop h
|
||
pop h
|
||
ret
|
||
;
|
||
moveforw:
|
||
dad d ;memory+last
|
||
mov b,h
|
||
mov c,l
|
||
eblocking Algorithms for CP/M 2.0 *
|
||
;* *
|
||
;******************************* *
|
||
;* BDOS constants on entry to write *
|
||
;* **************************
|
||
;* *
|
||
;* The READ entry point takes the place of number to HL
|
||
mvi h,0
|
||
rept 4 ;multiply by 16
|
||
dad h
|
||
endm
|
||
lxi d,dpbase ;base of parm block
|
||
dad d ;hl=.dpb(curdsk)
|
||
kdsk ;disk to seek
|
||
sta unadsk ;unadsk = sekdsk
|
||
lhld sektrk
|
||
shld unatrk ;unatrk = sectrk
|
||
lda seksec
|
||
sta unasec ;una;
|
||
; DISKDEF macro, or hand coded tables go here
|
||
dpbase equ $ ;disk param block base
|
||
;
|
||
boot:
|
||
wboot:
|
||
;enter here on systemtry point takes the place of *
|
||
;* the previous BIOS defintion for WRITE. *
|
||
;* *
|
||
;*****************************************************
|
||
wrall equ 0 ;write to allocated
|
||
wrdir equ 1 ;write *
|
||
;* the previous BIOS defintion for READ. *
|
||
;* *
|
||
;*************ret
|
||
;
|
||
settrk:
|
||
;set track given by registers BC
|
||
mov h,b
|
||
mov l,c
|
||
shld sektrk ;track to seek
|
||
ret
|
||
;
|
||
setsec:
|
||
;set sesec = seksec
|
||
;
|
||
chkuna:
|
||
;check for write to unallocated sector
|
||
lda unacnt ;any unalloc remain?
|
||
ora a
|
||
jz alloc ;skip i boot to initialize
|
||
xra a ;0 to accumulator
|
||
sta hstact ;host buffer inactive
|
||
sta unacnt ;clear unalloc count
|
||
ret
|
||
;
|
||
*
|
||
;*****************************************************
|
||
write:
|
||
;write the selected CP/M sector
|
||
xra a ;0 to ato directory
|
||
wrual equ 2 ;write to unallocated
|
||
;
|
||
;*****************************************************
|
||
;* ****************************************
|
||
read:
|
||
;read the selected CP/M sector
|
||
xra a
|
||
sta unacnt
|
||
mvi a,1
|
||
sta readop ;rctor given by register c
|
||
mov a,c
|
||
sta seksec ;sector to seek
|
||
ret
|
||
;
|
||
setdma:
|
||
;set dma address given by BC
|
||
mov h,b
|
||
mf not
|
||
;
|
||
; more unallocated records remain
|
||
dcr a ;unacnt = unacnt-1
|
||
sta unacnt
|
||
lda sekdsk ;same disk?
|
||
lxi h,unadsk
|
||
home:
|
||
;home the selected disk
|
||
home:
|
||
lda hstwrt ;check for pending write
|
||
ora a
|
||
jnz homed
|
||
sta hstact ;clear host activeccumulator
|
||
sta readop ;not a read operation
|
||
mov a,c ;write type in c
|
||
sta wrtype
|
||
cpi wrual ;write unallocated?
|
||
jnz c *
|
||
;* The BDOS entry points given below show the *
|
||
;* code which is relevant to deblocead operation
|
||
sta rsflag ;must read data
|
||
mvi a,wrual
|
||
sta wrtype ;treat as unalloc
|
||
jmp rwoper ;to perform the read
|
||
;
|
||
ov l,c
|
||
shld dmaadr
|
||
ret
|
||
;
|
||
sectran:
|
||
;translate sector number BC
|
||
mov h,b
|
||
mov l,c
|
||
ret
|
||
;
|
||
;***************************cmp m ;sekdsk = unadsk?
|
||
jnz alloc ;skip if not
|
||
;
|
||
; disks are the same
|
||
lxi h,unatrk
|
||
call sektrkcmp ;sektrk = unatrk?
|
||
flag
|
||
homed:
|
||
ret
|
||
;
|
||
seldsk:
|
||
;select disk
|
||
mov a,c ;selected disk number
|
||
sta sekdsk ;seek disk number
|
||
mov l,a ;diskhkuna ;check for unalloc
|
||
;
|
||
; write to unallocated, set parameters
|
||
mvi a,blksiz/128 ;next unalloc recs
|
||
sta unacnt
|
||
lda seking only. *
|
||
;* *
|
||
;*****************************************************
|
||
|
||
;*****************************************************
|
||
;* *
|
||
;* The WRITE enjnz alloc ;skip if not
|
||
;
|
||
; tracks are the same
|
||
lda seksec ;same sector?
|
||
lxi h,unasec
|
||
cmp m ;seksec = unasec?
|
||
jnz allxi h,hstsec ;sekhst = hstsec?
|
||
cmp m
|
||
jz match ;skip if match
|
||
;
|
||
nomatch:
|
||
;proper disk, but not correct sector
|
||
lda hstwa a ;carry = 0
|
||
rar ;shift right
|
||
endm
|
||
sta sekhst ;host sector to seek
|
||
;
|
||
; active host sector?
|
||
lxi h,hstact ;host aced to/from host buffer
|
||
lda wrtype ;write type
|
||
cpi wrdir ;to directory?
|
||
lda erflag ;in case of errors
|
||
rnz ;no furthecum
|
||
sta unacnt ;unacnt = 0
|
||
inr a ;1 to accum
|
||
sta rsflag ;rsflag = 1
|
||
;
|
||
;********************************************** relative host buffer address
|
||
lxi d,hstbuf
|
||
dad d ;hl = host address
|
||
xchg ;now in DE
|
||
lhld dmaadr ;get/put CP/M data
|
||
loc ;skip if not
|
||
;
|
||
; match, move to next sector for future ref
|
||
inr m ;unasec = unasec+1
|
||
mov a,m ;end of track?
|
||
cpi cprt ;host written?
|
||
ora a
|
||
cnz writehst ;clear host buff
|
||
;
|
||
filhst:
|
||
;may have to fill the host buffer
|
||
lda sekdsk
|
||
sta hstive flag
|
||
mov a,m
|
||
mvi m,1 ;always becomes 1
|
||
ora a ;was it already?
|
||
jz filhst ;fill host if not
|
||
;
|
||
; host buffer actir processing
|
||
;
|
||
; clear host buffer for directory write
|
||
ora a ;errors?
|
||
rnz ;skip if so
|
||
xra a ;0 to accum
|
||
sta hstwrt*******
|
||
;* *
|
||
;* Common code for READ and WRITE follows *
|
||
;* mvi c,128 ;length of move
|
||
lda readop ;which way?
|
||
ora a
|
||
jnz rwmove ;skip if read
|
||
;
|
||
; write operation, mark and switchmspt ;count CP/M sectors
|
||
jc noovf ;skip if no overflow
|
||
;
|
||
; overflow to next track
|
||
mvi m,0 ;unasec = 0
|
||
lhld unatrk
|
||
itdsk
|
||
lhld sektrk
|
||
shld hsttrk
|
||
lda sekhst
|
||
sta hstsec
|
||
lda rsflag ;need to read?
|
||
ora a
|
||
cnz readhst ;yes, if 1
|
||
xra ve, same as seek buffer?
|
||
lda sekdsk
|
||
lxi h,hstdsk ;same disk?
|
||
cmp m ;sekdsk = hstdsk?
|
||
jnz nomatch
|
||
;
|
||
; same disk, same ;buffer written
|
||
call writehst
|
||
lda erflag
|
||
ret
|
||
;
|
||
;*****************************************************
|
||
;* *
|
||
;*****************************************************
|
||
rwoper:
|
||
;enter here to per direction
|
||
mvi a,1
|
||
sta hstwrt ;hstwrt = 1
|
||
xchg ;source/dest swap
|
||
;
|
||
rwmove:
|
||
;C initially 128, DE is source, HL is denx h
|
||
shld unatrk ;unatrk = unatrk+1
|
||
;
|
||
noovf:
|
||
;match found, mark as unnecessary read
|
||
xra a ;0 to accumulator
|
||
sta rsfla ;0 to accum
|
||
sta hstwrt ;no pending write
|
||
;
|
||
match:
|
||
;copy data to or from buffer
|
||
lda seksec ;mask buffer number
|
||
anitrack?
|
||
lxi h,hsttrk
|
||
call sektrkcmp ;sektrk = hsttrk?
|
||
jnz nomatch
|
||
;
|
||
; same disk, same track, same buffer?
|
||
lda sekhst
|
||
*
|
||
;* Utility subroutine for 16-bit compare *
|
||
;* form the read/write
|
||
xra a ;zero to accum
|
||
sta erflag ;no errors (yet)
|
||
lda seksec ;compute host sector
|
||
rept secshf
|
||
orst
|
||
ldax d ;source character
|
||
inx d
|
||
mov m,a ;to dest
|
||
inx h
|
||
dcr c ;loop 128 times
|
||
jnz rwmove
|
||
;
|
||
; data has been movag ;rsflag = 0
|
||
jmp rwoper ;to perform the write
|
||
;
|
||
alloc:
|
||
;not an unallocated record, requires pre-read
|
||
xra a ;0 to ac secmsk ;least signif bits
|
||
mov l,a ;ready to shift
|
||
mvi h,0 ;double count
|
||
rept 7 ;shift left 7
|
||
dad h
|
||
endm
|
||
; hl has *
|
||
;*****************************************************
|
||
sektrkcmp:
|
||
;HL = .unatrk or .hsttrk, compare with rk: ds 2 ;last unalloc track
|
||
unasec: ds 1 ;last unalloc sector
|
||
;
|
||
erflag: ds 1 ;error reporting
|
||
rsflag: ds 1 ;read sectorareas *
|
||
;* *
|
||
;*****************************************************
|
||
;ec = host sect #. read "hstsiz" bytes
|
||
;into hstbuf and return error flag in erflag.
|
||
ret
|
||
;
|
||
;************************************************
|
||
writehst:
|
||
;hstdsk = host disk #, hsttrk = host track #,
|
||
;hstsec = host sect #. write "hstsiz" bytes
|
||
;fr *
|
||
;* WRITEHST performs the physical write to *
|
||
;* the host disk, READHST reads the physical *
|
||
;* disk. sektrk
|
||
xchg
|
||
lxi h,sektrk
|
||
ldax d ;low byte compare
|
||
cmp m ;same?
|
||
rnz ;return if not
|
||
; low bytes equal, test high 1s flag
|
||
readop: ds 1 ;1 if read operation
|
||
wrtype: ds 1 ;write operation type
|
||
dmaadr: ds 2 ;last dma address
|
||
hstbuf: ds hsts
|
||
sekdsk: ds 1 ;seek disk number
|
||
sektrk: ds 2 ;seek track number
|
||
seksec: ds 1 ;seek sector number
|
||
;
|
||
hstdsk: ds 1 ;host d**********************
|
||
;* *
|
||
;* Unitialized RAM data areas *
|
||
;* om hstbuf and return error flag in erflag.
|
||
;return erflag non-zero if error
|
||
ret
|
||
;
|
||
readhst:
|
||
;hstdsk = host disk #, hsttrk *
|
||
;* *
|
||
;*****************************************************
|
||
write
|
||
inx d
|
||
inx h
|
||
ldax d
|
||
cmp m ;sets flags
|
||
ret
|
||
;
|
||
;*****************************************************
|
||
;* iz ;host buffer
|
||
;
|
||
;*****************************************************
|
||
;* isk number
|
||
hsttrk: ds 2 ;host track number
|
||
hstsec: ds 1 ;host sector number
|
||
;
|
||
sekhst: ds 1 ;seek shr secshf
|
||
hstact: ds 1 *
|
||
;*****************************************************
|
||
;
|
||
sekdsk: ds 1 ;seek di = host track #,
|
||
;hstsec = host sect #. read "hstsiz" bytes
|
||
;into hstbuf and return error flag in erflag.
|
||
ret
|
||
;
|
||
;*******hst:
|
||
;hstdsk = host disk #, hsttrk = host track #,
|
||
;hstsec = host sect #. write "hstsiz" bytes
|
||
;from hstbuf and return err *
|
||
;* WRITEHST performs the physical write to *
|
||
;* the host disk, READHST reads the p *
|
||
;* The ENDEF macro invocation goes here *
|
||
;* *
|
||
;****************** ;host active flag
|
||
hstwrt: ds 1 ;host written flag
|
||
;
|
||
unacnt: ds 1 ;unalloc rec cnt
|
||
unadsk: ds 1 ;last unalloc disk
|
||
unatsk number
|
||
sektrk: ds 2 ;seek track number
|
||
seksec: ds 1 ;seek sector number
|
||
;
|
||
hstdsk: ds 1 ;host disk number
|
||
hsttrk: ds 2**********************************************
|
||
;* *
|
||
;* Unitialized RAM data or flag in erflag.
|
||
;return erflag non-zero if error
|
||
ret
|
||
;
|
||
readhst:
|
||
;hstdsk = host disk #, hsttrk = host track #,
|
||
;hstshysical *
|
||
;* disk. *
|
||
;* *
|
||
;***********************************************************************
|
||
end
|
||
;host track number
|
||
hstsec: ds 1 ;host sector number
|
||
;
|
||
sekhst: ds 1 ;seek shr secshf
|
||
hstact: ds 1 ;host active flag
|
||
hst裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹invocation goes here *
|
||
;* *
|
||
;******************************************裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹wrt: ds 1 ;host written flag
|
||
;
|
||
unacnt: ds 1 ;unalloc rec cnt
|
||
unadsk: ds 1 ;last unalloc disk
|
||
unatrk: ds 2 ;last unalloc 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹***********
|
||
end
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹track
|
||
unasec: ds 1 ;last unalloc sector
|
||
;
|
||
erflag: ds 1 ;error reporting
|
||
rsflag: ds 1 ;read sector flag
|
||
readop: ds 1 ;1 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹if read operation
|
||
wrtype: ds 1 ;write operation type
|
||
dmaadr: ds 2 ;last dma address
|
||
hstbuf: ds hstsiz ;host buffer
|
||
;
|
||
;**裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹***************************************************
|
||
;* *
|
||
;* The ENDEF macro 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 |