|
DataMuseum.dkPresents historical artifacts from the history of: CR80 Hard and Floppy Disks |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CR80 Hard and Floppy Disks Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 20320 (0x4f60)
Types: TextFile
Names: »SEMANTICS.S«
└─⟦f81e11cf7⟧ Bits:30005196 8" CR80 Floppy CR80FD_0194 ( CR/D/2497 TEST-TDX VS0102 Source moduler Att. Holger Bay 820208/AEK )
└─⟦d066df9e9⟧
└─ ⟦this⟧ »SEMANTICS.S«
«ff»
"SEMANTICS.S "
"----------------"
PROCEDURE SEMANTICS(ACTION, ATTRIBUTE, STACK_INDEX : INTEGER);
"**********************************************************************
AUTHOR: TLM
DATE: 810316
***********************************************************************
COMMENTS:
***********************************************************************
CHANGE RECORD:
VERSION AUTHOR/DATE DESCRIPTION OF CHANGE
------- ----------- ---------------------
**********************************************************************"
VAR I : INTEGER;
PARAMNAME : NAME_TYPE;
BEGIN
IF (NOT IGNORE_REST_OF_LINE) OR
(IGNORE_REST_OF_LINE AND (ACTION IN [19, 20] "STATEMENT"))
THEN
CASE ACTION OF
1: "IDENTIFIER"
BEGIN
IDENTIFIER.LENGTH := ATTRIBUTE;
IDENTIFIER.STRING := SYMBOLBUF;
END;
2: "CONSTANT"
BEGIN
CONSTANT := ATTRIBUTE;
END;
3: "STRING"
BEGIN
STRING.LENGTH := ATTRIBUTE;
STRING.STRING := SYMBOLBUF;
END;
4: "ERROR"
BEGIN
NO_OF_INTEGERS := 0;
WRITETEXT('?(:7:)(:0:)');
WRITENL;
END;
5: "<GOAL-SYMBOL> --> <commandfile> "
BEGIN
TERMINATE(0);
END;
6:;"<commandfile> --> <procdecls> <body> <nl> "
7:;" --> <body> <nl> "
8:;" --> END <nl> "
9:;"<procdecls> --> <procdecls> <procdecl> "
10:;" --> <procdecl> "
11, "<procdecl> --> <proresword> <procname> <paramlist> <nl> <body> <nl> "
12: " --> <proresword> <procname> <nl> <body> <nl> "
BEGIN
PROCEDURES[PROCEDURECOUNT].NO_OF_PARAMS := PARAMETERCOUNT;
PARAMETERCOUNT := 0;
PROC_DECLARING := FALSE;
"--- GENERATE PROCEDURE RETURN CODE ---"
CODE[CCP] := PROCRETURN_CMD;
CODE[CCP + XVARMASK] := 0;
CODE[CCP + XPARAMS ] := 0;
CCP := CCP + 3;
END;
13: "<proresword> --> PROCEDURE "
BEGIN
PROC_DECLARING := TRUE;
PROC_CODE_PTR := CCP;
PARAMETERCOUNT := 0;
INSTALL_PROCNAME := TRUE;
END;
14: "<procname> --> <identifier> "
BEGIN
PROCNAME := ' ';
I := 0;
REPEAT
I := SUCC(I);
PROCNAME[I] := IDENTIFIER.STRING[I - 1];
UNTIL (I = IDENTIFIER.LENGTH) OR (I = 16);
IF INSTALL_PROCNAME THEN
BEGIN
PROCEDURECOUNT := SUCC(PROCEDURECOUNT);
WITH PROCEDURES[PROCEDURECOUNT] DO
BEGIN
NAME := PROCNAME;
CODE_ADR := PROC_CODE_PTR;
END;
INSTALL_PROCNAME := FALSE;
END;
ACTPARAMETERCOUNT := 0;
PARAMETERS.VARIABLE_MASK := 0;
PARAMETERS.NO_OF_PARAMS := 0;
END;
15:;"<paramlist> --> ( <parameters> ) "
16, "<parameters> --> <parameters> ; <identifier> "
17: " --> <identifier> "
BEGIN
PARAMETERCOUNT := SUCC(PARAMETERCOUNT);
IF PARAMETERCOUNT <= MAX_PARAMETER THEN
BEGIN
FORM_PARAMS[PARAMETERCOUNT].NAME := ' ';
I := 0;
REPEAT
I := SUCC(I);
FORM_PARAMS[PARAMETERCOUNT].NAME[I] :=
IDENTIFIER.STRING[I - 1];
UNTIL (I = IDENTIFIER.LENGTH) OR (I = 16);
END
ELSE
BEGIN
WRITETEXT('*** TOO MANY PARAMETERS ***(:0:)');
WRITENL;
IGNORE_REST_OF_LINE := TRUE;
END;
END;
18:;"<body> --> BEGIN <nl> <statements> END "
19, "<statements> --> <statements> <statement> "
20: " --> <statement> "
BEGIN
IGNORE_REST_OF_LINE := FALSE;
PARAMETERS.VARIABLE_MASK := 0;
PARAMETERS.NO_OF_PARAMS := 0;
END;
21: "<statement> --> <procedurecall> "
BEGIN
CODE[CCP] := PROCCALL_CMD;
CODE[CCP + XVARMASK] :=
LEFTSHIFT(PARAMETERS.VARIABLE_MASK, 1);
CODE[CCP + XPARAMS ] := PARAMETERS.NO_OF_PARAMS + 1;
I := GET_PROCEDURE_ADR(PROCNAME);
IF I <> UNDECLARED THEN
BEGIN
CODE[CCP + XPARAMS + 1] := I;
I := GET_PARAMETER_COUNT(PROCNAME);
IF I = PARAMETERS.NO_OF_PARAMS THEN
BEGIN
FOR I := 1 TO PARAMETERS.NO_OF_PARAMS DO
CODE[CCP + XPARAMS + 1 + I] :=
PARAMETERS.ACT_PARAMS[I];
IF REPEAT_DECLARING OR PROC_DECLARING THEN
BEGIN
CCP := CCP + CODE[CCP + XPARAMS] + 3;
END
ELSE
INTERPRET(CCP, CURR_SP);
END
ELSE
BEGIN
WRITETEXT('*** PARAMETER MISMATCH ***(:0:)');
WRITENL;
IGNORE_REST_OF_LINE := TRUE;
END;
END
ELSE
BEGIN
WRITETEXT('*** UNDECLARED PROCEDURE ***(:0:)');
WRITENL;
IGNORE_REST_OF_LINE := TRUE;
END;
END;
22: " --> <repeatstatement "
BEGIN
CODE[CCP] := ENDREPEAT_CMD;
CODE[CCP + XVARMASK] := 0;
CODE[CCP + XPARAMS ] := 1;
CODE[CCP + XPARAMS + 1] := REPEAT_CODE_PTR;
IF PROC_DECLARING THEN
CCP := CCP + CODE[CCP + XPARAMS] + 3
ELSE
BEGIN
INTERPRET(REPEAT_CODE_PTR, CURR_SP);
CCP := REPEAT_CODE_PTR;
END;
REPEAT_DECLARING := FALSE;
END;
23: " --> <simplecommand> "
BEGIN
IF PROC_DECLARING OR REPEAT_DECLARING THEN
CCP := CCP + CODE[CCP + XPARAMS] + 3
ELSE
INTERPRET(CCP, CURR_SP);
END;
24:;" --> <error> "
25:;"<procedurecall> --> <procname> ( <actualparams> ) <nl> "
26:;" --> <procname> <nl> "
27, "<actualparams> --> <actualparams> , <const_or_var> "
28: " --> <const_or_var> "
BEGIN
ACTPARAMETERCOUNT := SUCC(ACTPARAMETERCOUNT);
IF ANY.VARIABLE THEN
BEGIN
SETBIT(PARAMETERS.VARIABLE_MASK, ACTPARAMETERCOUNT);
END;
PARAMETERS.NO_OF_PARAMS := ACTPARAMETERCOUNT;
PARAMETERS.ACT_PARAMS[ACTPARAMETERCOUNT] := ANY.PARAMETER;
END;
29:;"<repeatstatement --> <repeatresword> <repeats> <nl> <body> <nl> "
30:;" --> <repeatresword> <repeats> <statement> "
31: "<repeatresword> --> REPEAT "
BEGIN
REPEAT_CODE_PTR := CCP;
REPEAT_DECLARING := TRUE;
END;
32: "<repeats> --> <const_or_var> "
BEGIN
REPEATS := ANY;
CODE[CCP] := REPEAT_CMD;
XVM := CCP + XVARMASK;
CODE[XVM] := 0;
IF REPEATS.VARIABLE THEN SETBIT(CODE[XVM], 1);
CODE[CCP + XPARAMS] := 1;
CODE[CCP + XPARAMS + 1] := REPEATS.PARAMETER;
CCP := CCP + CODE[CCP + XPARAMS] + 3;
END;
33: "<simplecommand> --> <driverdefinecom "
BEGIN
CODE[ CCP ] := DRIVERDEFINE_CMD;
CODE[ CCP + XVARMASK ] := 0;
CODE[ CCP + XPARAMS ] := 6;
PACK(STRING.STRING[0], CODE[CCP + XPARAMS + 1], 6);
PACK(STRING.STRING[7], CODE[CCP + XPARAMS + 5], 4);
CODE[CCP + XPARAMS + 4] := 0;
END;
34: "<simplecommand> --> <assigncommand> "
BEGIN
CODE[CCP] := ASSIGN_CMD;
XVM := CCP + XVARMASK;
CODE[XVM] := 0;
IF CR80ADR.VARIABLE THEN SETBIT(CODE[XVM], 1);
IF HOSTNO.VARIABLE THEN SETBIT(CODE[XVM], 2);
CODE[CCP + XPARAMS] := 2;
CODE[CCP + XPARAMS + 1] := CR80ADR.PARAMETER;
CODE[CCP + XPARAMS + 2] := HOSTNO.PARAMETER;
END;
35: "<simplecommand> --> <deassigncommand "
BEGIN
CODE[CCP] := DEASSIGN_CMD;
CODE[CCP + XVARMASK] := 0;
CODE[CCP + XPARAMS ] := 0;
END;
36: "<simplecommand> --> <createcommand> "
BEGIN
CODE[CCP] := CREATE_CMD;
XVM := CCP + XVARMASK;
CODE[XVM] := 0;
IF PROTOCOL.VARIABLE THEN SETBIT(CODE[XVM], 1);
IF CRID.VARIABLE THEN SETBIT(CODE[XVM], 2);
IF SPEED.VARIABLE THEN SETBIT(CODE[XVM], 3);
IF MAXPACKET.VARIABLE THEN SETBIT(CODE[XVM], 4);
CODE[CCP + XPARAMS] := 4;
CODE[CCP + XPARAMS + 1] := PROTOCOL.PARAMETER;
CODE[CCP + XPARAMS + 2] := CRID.PARAMETER;
CODE[CCP + XPARAMS + 3] := SPEED.PARAMETER;
CODE[CCP + XPARAMS + 4] := MAXPACKET.PARAMETER;
END;
37: "<simplecommand> --> <dismantlecomman "
BEGIN
CODE[CCP] := DISMANTLE_CMD;
XVM := CCP + XVARMASK;
CODE[XVM] := 0;
IF CRID.VARIABLE THEN SETBIT(CODE[XVM], 1);
CODE[CCP + XPARAMS] := 1;
CODE[CCP + XPARAMS + 1] := CRID.PARAMETER;
END;
38, "<simplecommand> --> <readcommand> "
39: "<simplecommand> --> <initreadcommand "
BEGIN
IF ACTION = 38 THEN CODE[CCP] := READ_CMD
ELSE CODE[CCP] := INITREAD_CMD;
XVM := CCP + XVARMASK;
CODE[XVM] := 0;
IF CRID.VARIABLE THEN SETBIT(CODE[XVM], 1);
IF NOOFBYTES.VARIABLE THEN SETBIT(CODE[XVM], 2);
CODE[CCP + XPARAMS] := 5;
CODE[CCP + XPARAMS + 1] := CRID.PARAMETER;
CODE[CCP + XPARAMS + 2] := NOOFBYTES.PARAMETER;
IF ACTION = 38 THEN CODE[CCP + XPARAMS + 3] := 1
ELSE CODE[CCP + XPARAMS + 3] := 3;
IF DATA_EXPECTED THEN
BEGIN
IF PATTERNNO.VARIABLE THEN SETBIT(CODE[XVM], 4);
CODE[CCP + XPARAMS + 4] := PATTERNNO.PARAMETER;
END
ELSE CODE[CCP + XPARAMS + 4] := 0;
IF DUMP_AT_COMPLETION THEN CODE[CCP + XPARAMS + 5] := 1
ELSE CODE[CCP + XPARAMS + 5] := 0;
END;
40, "<simplecommand> --> <appendcommand> "
41: "<simplecommand> --> <initappendcomma "
BEGIN
IF ACTION = 40 THEN CODE[CCP] := APPEND_CMD
ELSE CODE[CCP] := INITAPPEND_CMD;
XVM := CCP + XVARMASK;
CODE[XVM] := 0;
IF CRID.VARIABLE THEN SETBIT(CODE[XVM], 1);
IF NOOFBYTES.VARIABLE THEN SETBIT(CODE[XVM], 2);
IF PATTERNNO.VARIABLE THEN SETBIT(CODE[XVM], 4);
CODE[CCP + XPARAMS + 1] := CRID.PARAMETER;
CODE[CCP + XPARAMS + 2] := NOOFBYTES.PARAMETER;
IF ACTION = 40 THEN "APPEND"
CODE[CCP + XPARAMS + 3] := 2 "BUFFER NO"
ELSE "INITAPPEND"
CODE[CCP + XPARAMS + 3] := 4;
CODE[CCP + XPARAMS + 4] := PATTERNNO.PARAMETER;
IF PATTERNNO.PARAMETER = 0 THEN
BEGIN
FOR I := 1 TO NO_OF_INTEGERS DO
CODE[CCP + XPARAMS + 4 + I] := INTEGERS[I];
CODE[CCP + XPARAMS] := NO_OF_INTEGERS + 4;
END
ELSE CODE[CCP + XPARAMS] := 4;
NO_OF_INTEGERS := 0;
END;
42: "<simplecommand> --> <consolecommand> "
BEGIN
"CODE GENERATED IN 62,63"
END;
43: "<simplecommand> --> <definecommand> "
BEGIN
CODE[CCP] := PATTERN_DEFINE_CMD;
XVM := CCP + XVARMASK;
CODE[XVM] := 0;
IF PATTERNNO.VARIABLE THEN SETBIT(CODE[XVM], 1);
CODE[CCP + XPARAMS] := NO_OF_INTEGERS + 1;
CODE[CCP + XPARAMS + 1] := PATTERNNO.PARAMETER;
FOR I := 1 TO NO_OF_INTEGERS DO
CODE[CCP + XPARAMS + 1 + I] := INTEGERS[I];
NO_OF_INTEGERS := 0;
END;
44: "<simplecommand> --> <dumpcommand> "
BEGIN
CODE[CCP] := DUMP_CMD;
XVM := CCP + XVARMASK;
CODE[XVM] := 0;
IF BUFFERNO.VARIABLE THEN SETBIT(CODE[XVM], 1);
IF STARTADDR.VARIABLE THEN SETBIT(CODE[XVM], 2);
IF ENDADDR.VARIABLE THEN SETBIT(CODE[XVM], 3);
IF PATTERNNO.VARIABLE THEN SETBIT(CODE[XVM], 4);
CODE[CCP + XPARAMS] := 4;
CODE[CCP + XPARAMS + 1] := BUFFERNO.PARAMETER;
CODE[CCP + XPARAMS + 2] := STARTADDR.PARAMETER;
CODE[CCP + XPARAMS + 3] := ENDADDR.PARAMETER;
CODE[CCP + XPARAMS + 4] := PATTERNNO.PARAMETER;
END;
45: "<simplecommand> --> <delaycommand> "
BEGIN
CODE[CCP] := DELAY_CMD;
XVM := CCP + XVARMASK;
CODE[XVM] := 0;
IF TIME.VARIABLE THEN SETBIT(CODE[XVM], 1);
CODE[CCP + XPARAMS] := 1;
CODE[CCP + XPARAMS + 1] := TIME.PARAMETER;
END;
46: "<simplecommand> --> <cancelcommand> "
BEGIN
CODE[CCP] := CANCEL_CMD;
XVM := CCP + XVARMASK;
CODE[XVM] := 0;
IF CRID.VARIABLE THEN SETBIT(CODE[XVM], 1);
IF OPREF.VARIABLE THEN SETBIT(CODE[XVM], 2);
CODE[CCP + XPARAMS] := 2;
CODE[CCP + XPARAMS + 1] := CRID.PARAMETER;
CODE[CCP + XPARAMS + 2] := OPREF.PARAMETER;
END;
47: "<simplecommand> --> <listcommand> "
BEGIN
CODE[CCP] := LIST_CMD;
CODE[CCP + XVARMASK] := 0;
CODE[CCP + XPARAMS ] := 0;
END;
48: "<simplecommand> --> <waitinitcommand> "
BEGIN
CODE[CCP] := WAITINIT_CMD;
CODE[CCP + XVARMASK] := 0;
IF TIME.VARIABLE THEN SETBIT(CODE[CCP + XVARMASK], 1);
CODE[CCP + XPARAMS] := 1;
CODE[CCP + XPARAMS + 1] := TIME.PARAMETER;
END;
49:;"<driverdefinecom --> DRIVER = <string> <nl> "
50:;"<assigncommand> --> ASSIGN <cr80adr> <hostno> <nl> "
51:;"<deassigncommand --> DEASSIGN <nl> "
52:;"<createcommand> --> CREATE <protocol> <crid> <speed> <maxpacket> <nl> "
53:;"<dismantlecomman --> DISMANTLE <crid> <nl> "
54:;"<readcommand> --> READ <readparams> <nl> "
55:;"<initreadcommand --> INITREAD <readparams> <nl> "
56: "<readparams> --> <crid> <noofbytes> EXPECT PATTERN <patternno> "
BEGIN
DATA_EXPECTED := TRUE;
END;
57: " --> <crid> <noofbytes> "
BEGIN
DATA_EXPECTED := FALSE;
END;
58:;"<appendcommand> --> APPEND <appendparams> <nl> "
59:;"<initappendcomma --> INITAPPEND <appendparams> <nl> "
60:;"<appendparams> --> <crid> <noofbytes> PATTERN <patternno> "
61: " --> <crid> <noofbytes> ( <integers> ) "
BEGIN
PATTERNNO.VARIABLE := FALSE;
PATTERNNO.PARAMETER := 0;
END;
62, "<integers> --> <integers> <integer> "
63: " --> <integer> "
BEGIN
NO_OF_INTEGERS := SUCC(NO_OF_INTEGERS);
INTEGERS[NO_OF_INTEGERS] := CONSTANT;
END;
64:;"<integer> --> <constant> "
65: "<consolecommand> --> CONSOLE IN <nl> "
BEGIN
CODE[CCP] := CONSOLE_IN_CMD;
CODE[CCP + XVARMASK] := 0;
CODE[CCP + XPARAMS ] := 0;
END;
66: " --> CONSOLE OUT <nl> "
BEGIN
CODE[CCP] := CONSOLE_OUT_CMD;
CODE[CCP + XVARMASK] := 0;
CODE[CCP + XPARAMS ] := 0;
END;
67:;"<definecommand> --> DEFINE PATTERN <patternno> = <pattern> <nl> "
68: "<dumpcommand> --> DUMP BUFFER <bufferno> FROM <startaddr> <nl> "
BEGIN
ENDADDR.VARIABLE := FALSE;
ENDADDR.PARAMETER := MAX_BUFFER_SIZE + 1;
PATTERNNO.VARIABLE := FALSE;
PATTERNNO.PARAMETER := 0;
END;
69: "<dumpcommand> --> DUMP BUFFER <bufferno> FROM <startaddr> TO <endaddr> <nl> "
BEGIN
PATTERNNO.VARIABLE := FALSE;
PATTERNNO.PARAMETER := 0;
END;
70: "<dumpcommand> --> DUMP PATTERN <patternno> <nl> "
BEGIN
STARTADDR.VARIABLE := FALSE;
STARTADDR.PARAMETER := 0;
ENDADDR := STARTADDR;
END;
71:;"<delaycommand> --> DELAY <time> <nl> "
72:;"<listcommand> --> LIST OPERATIONS <nl> "
73: "<cancelcommand> --> CANCEL CRID <crid> <nl> "
BEGIN
OPREF.VARIABLE := FALSE;
OPREF.PARAMETER := 0;
END;
74: "<cancelcommand> --> CANCEL OPERATION <opref> <nl> "
BEGIN
CRID.VARIABLE := FALSE;
CRID.PARAMETER := 0;
END;
75:;"<waitinitcommand> --> WAITINIT <time> <nl> "
76: "<cr80adr> --> <const_or_var> "
CR80ADR := ANY;
77: "<hostno> --> <const_or_var> "
HOSTNO := ANY;
78: "<protocol> --> <const_or_var> "
PROTOCOL := ANY;
79: "<crid> --> <const_or_var> "
CRID := ANY;
80: "<noofbytes> --> <const_or_var> "
NOOFBYTES := ANY;
81: "<speed> --> <const_or_var> "
SPEED := ANY;
82: "<maxpacket> --> <const_or_var> "
MAXPACKET := ANY;
83: "<patternno> --> <const_or_var> "
PATTERNNO := ANY;
84: "<bufferno> --> <const_or_var> "
BUFFERNO := ANY;
85: "<startaddr> --> <const_or_var> "
STARTADDR := ANY;
86: "<endaddr> --> <const_or_var> "
ENDADDR := ANY;
87: "<opref> --> <const_or_var> "
OPREF := ANY;
88: "<time> --> <const_or_var> "
TIME := ANY;
89: "<const_or_var> --> <identifier> "
BEGIN
ANY.VARIABLE := TRUE;
PARAMNAME := ' ';
I := 0;
REPEAT
I := SUCC(I);
PARAMNAME[I] := IDENTIFIER.STRING[I - 1];
UNTIL (I = IDENTIFIER.LENGTH) OR (I = 16);
I := GET_PARAM_INDEX(PARAMNAME);
IF I <> UNDECLARED THEN
BEGIN
ANY.PARAMETER := I;
END
ELSE
BEGIN
WRITETEXT('*** UNDECLARED PARAMETER ***(:0:)');
WRITENL;
IGNORE_REST_OF_LINE := TRUE;
END;
END;
90: " --> <constant> "
BEGIN
ANY.VARIABLE := FALSE;
ANY.PARAMETER := CONSTANT;
END;
91: "<nl> --> (:10:) "
BEGIN
ACTPARAMETERCOUNT := 0;
IGNORE_REST_OF_LINE := FALSE;
END;
92: "<pattern> --> <integers> "
; "DO NOTHING, PATTERN ALREADY IN 'INTEGERS'"
93: " --> <string> "
BEGIN
I := STRING.LENGTH + STRING.LENGTH MOD 2;
PACK(STRING.STRING[0], INTEGERS[1], I);
NO_OF_INTEGERS := I DIV 2;
END;
94: "<dump_at_completion> --> DUMP "
BEGIN
DUMP_AT_COMPLETION := TRUE;
END;
95: "<dump_at_completion> --> " "empty"
BEGIN
DUMP_AT_COMPLETION := FALSE;
END
END; " CASE "
END; " SEMANTICS " «a5»