IMD 1.16: 6/09/2007 17:01:58 sys 2 system   &lŗkm HBf     &  %C e U7F ?IO ERROR WHILE BOOTING? 7$ ?NOT ENOUGH CORE TO BOOT?    e   ևߕ vߕ 7| SYSTEM.PASCAL? w7b SYSTEM.INTERP? @Aw  `! mG~d!~  ^\F C& J&  0  EN  ~  _~U@pe5w E ŋw Ŋw C! @ D~̋   wTwDԤ eeW 7 ?YOU DON'T HAVE A  ߋt_v @ @  SYS2򩝲Z EXTRA.Z80.TEXTl@ ASMZ80.TEXTp@C Z80.OPCODESl8CK Z80.ERRORSlFK SETUP.TEXTn) DEBUG.B.TEXTnƜ DEBUG.C.TEXTn DEBUGGER.TEXTn* DEBUG.A.TEXTnƜ ASM1.TEXTp  ASM2.TEXTp ' ASM3.TEXTn'M ASM4.TEXTp*Mi ASM5.TEXTni ASM6.TEXTn DISASM1.TEXTlɝ DISASM2.TEXTlɝ DISASM.TEXTp OPCODES.I5 SYS2򩝲Z EXTRA.Z80.TEXTl@ ASMZ80.TEXTp@C Z80.OPCODESl8CK Z80.ERRORSlFl`K SETUP.TEXTn) DEBUG.B.TEXTnƜ DEBUG.C.TEXTn DEBUGGER.TEXTn* DEBUG.A.TEXTn NUM<=254 THEN BLK:=8 0ELSE BLK:=10; *IF BLOCKREAD(F,BUF,2,BLK)<>2 THEN PUTNUM *ELSE ,BEGIN .IF BUF[0]=CHR(DLE) THEN PTR:=2 ROR;  BEGIN "ERROR(76{Incorrect operand format}); "PUTBYTE(NOP);  END;   PROCEDURE OPENPARSE;  BEGIN "IF SPCIALSTKINDEXELSE PTR:=0; .D0:=ERRNUM DIV 100; (* convert error number to characters *) .D1:=(ERRNUM-D0*100) DIV 10; .D2:=ERRNUM MOD 10; <>-1 THEN $BEGIN &IF SPECIALSTK[SPCIALSTKINDEX]<>OPENPAREN THEN (ERROR(80{( expected}); &SPCIALSTKINDEX:=SPCIALSTKINDEX-1; .T[0]:=CHR(D0+ORD('0')); T[1]:=CHR(D1+ORD('0')); .T[2]:=CHR(D2+ORD('0')); .REPEAT 0FILLCHAR(C,3,'0'); 0COLON:=SCAN(MAXCHAR,=&LEX; &IF SYM^.ATTRIBUTE=DEFABS THEN (BEGIN *PUTBYTE(SYM^.OFFSETORVALUE); *PUTBYTE(OPBYTE.GOODBYTE); *LEX; *IF LEXTOKEN<>PƜ ASM1.TEXTp  ASM2.TEXTp ' ASM3.TEXTn'M ASM4.TEXTp*Mi ASM5.TEXT':',BUF[PTR]); 0MOVELEFT(BUF[PTR],C[3-COLON],COLON); 0COLON:=COLON+PTR; 0PTR:=SCAN(MAXCHAR,=CHR(EOL),BUF[PTR])+PTR+3 ni ASM6.TEXTn DISASM1.TEXTlɝ DISASM2.TEXTlɝ DISASM.TEXTp OPCODES.I5O^l` SEGMENT PROCEDURE PUTSYNTAX;  VAR "D0,D1,D2,BLK,PTR,COLON: INTEGER; "T,C:PACKED ARRAY [0..2] OF CHAR; "BUF:PACKED ARRAY [0..1023] OF CHAR; "F: FILE;   PROCEDURE PUTNUM;  BEGIN "MSG:='Syntax Error #'; PUTMSG; "WRITE(USERINFO.ERRNUM,'. Type ');  END;   BEGIN (* putsyntax *) "WITH USERINFO DO $BEGIN &OPENOLD(F,'*SYSTEM.SYNTAX'); &IF IORESULT<>0 THEN PUTNUM &ELSE (BEGIN *IF ERRNUM<=109 THEN BLK:=2 *ELSE ,IF ERRNUM<=131 THEN BLK:=4 ,ELSE .IF ERRNUM<=156 THEN BLK:=6 .ELSE 0IF ERR {start of EXTRA.Z80.TEXT}  {Copyright (c) 1978 Regents of University of California}   PROCEDURE OPER YTE:=SYM^.OFFSETORVALUE; "LEX; "IF LEXTOKEN=OPENPAREN THEN $BEGIN &LEX; &IF SYM^.NAME<>'SP ' THEN ERROR(81{SP expected$ EXTRASYM:=SYM; &PUTBYTE(SYM^.OFFSETORVALUE); &OPBYTE.GOODBYTE:=OPBYTE.BADBYTE; $ LEX; &IF LEXTOKEN<>COMMA THEN ERROR(78}); " LEX; &IF LEXTOKEN<>CLOSEPAREN THEN ERROR(77); $ LEX; &IF LEXTOKEN<>COMMA THEN ERROR(78); &LEX; &IF SYM^.NAME='HL); &LEX; &IF (SYM^.ATTRIBUTE=DEFRP) AND (SYM^.NAME<>'HL ') (AND (SYM^.NAME<>'AF ') THEN *OPBYTE.RP:=SYM^.OFFSETORV ' THEN (PUTBYTE(OPBYTE.GOODBYTE) &ELSE IF SYM^.ATTRIBUTE=DEFABS THEN (BEGIN *PUTBYTE(SYM^.OFFSETORVALUE); *PUTBYTE(OPALUE &ELSE IF SYM=EXTRASYM THEN (OPBYTE.RP:=2 &ELSE OPERROR; &PUTBYTE(OPBYTE.GOODBYTE); &LEX; $END "ELSE OPERROR;  END; BYTE.GOODBYTE); (END &ELSE OPERROR; $END "ELSE IF SYM^.NAME='DE ' THEN $BEGIN &PUTBYTE(235);{DE,HL gives EB} &LEX;   PROCEDURE ZOP4;  { ADC SBC }  BEGIN "IF DEBUG THEN WRITELN('Op4');  OPBYTE.BWORD:=SYM^.OFFSETORVALUE; "LEX; "IF SYM&IF LEXTOKEN<>COMMA THEN ERROR(78); &LEX; &IF SYM^.NAME<>'HL ' THEN ERROR(82{HL expected}); " END ^.NAME='A ' THEN $BEGIN $ LEX; &IF LEXTOKEN<>COMMA THEN ERROR(78); &IF EXPRESS(TRUE) THEN (BEGIN *IF RESULT.ATTRIBU"ELSE IF SYM^.NAME='AF ' THEN $PUTBYTE(8) {AF,AF' gives 08} "ELSE OPERROR; "LEX;  END;   PROCEDURE ZOP3;  VAR EXTTE=DEFREG THEN ,BEGIN .OPBYTE.SOURCE:=RESULT.OFFSETORVALUE; .PUTBYTE(OPBYTE.GOODBYTE); ,END *ELSE IF CHECKOPERAND(TRUE,TRUELUS THEN ERROR(79); *IF EXPRESS(TRUE) THEN ,IF CHECKOPERAND(FALSE,TRUE,TRUE,0,255) THEN .PUTBYTE(RESULT.OFFSETORVALUE); *IF RA:BYTESWAP;  EXTRASYM:SYMTABLEPTR;  { ADD }  BEGIN "IF DEBUG THEN WRITELN('Op3');  OPBYTE.BWORD:=SYM^.OFFSETORVALUESPCIALSTKINDEX=-1 THEN ,ERROR(77) *ELSE SPCIALSTKINDEX:=SPCIALSTKINDEX-1; (END &ELSE IF SYM^.NAME='HL ' THEN (BEGIN *; "LEX; "IF SYM^.NAME='A ' THEN $BEGIN $ LEX; &IF LEXTOKEN<>COMMA THEN ERROR(78); &IF EXPRESS(TRUE) THEN (BEGIN *PUTBYTE(OPBYTE.GOODBYTE); *LEX; *IF LEXTOKEN<>CLOSEPAREN THEN ERROR(77); *LEX; (END &ELSE (BEGIN *OPERROR; $ LEX; IF RESULT.ATTRIBUTE=DEFREG THEN ,BEGIN .OPBYTE.SOURCE:=RESULT.OFFSETORVALUE; .PUTBYTE(OPBYTE.GOODBYTE); ,END *ELSE IF CHECK(END $END "ELSE $BEGIN &OPERROR; &LEX; $END;  END;   PROCEDURE ZOP1;  { PUSH POP }  BEGIN OPERAND(TRUE,TRUE,TRUE,-128,255) THEN ,BEGIN .PUTBYTE(198);{A,n gives C6} .EXTRA.GOODBYTE:=RESULT.OFFSETORVALUE; .PUTBYTE(EX IF DEBUG THEN WRITELN('Op1'); "OPBYTE.GOODBYTE:=SYM^.OFFSETORVALUE; "LEX; "IF (SYM^.ATTRIBUTE=DEFRP) AND (SYM^.NAME<>'SP TRA.GOODBYTE); ,END & END &ELSE OPENPARSE; $END "ELSE IF SYM^.NAME='HL ' THEN $BEGIN $ OPBYTE.GOODBYTE:=OPBYTE.BAD ') THEN $OPBYTE.RP:=SYM^.OFFSETORVALUE "ELSE IF SYM^.ATTRIBUTE=DEFABS THEN $PUTBYTE(SYM^.OFFSETORVALUE) "ELSE OPERROR; BYTE; &LEX; &IF LEXTOKEN<>COMMA THEN ERROR(78); &LEX; &IF (SYM^.ATTRIBUTE=DEFRP) AND (SYM^.NAME<>'AF ') THEN (OPBYTE.R"PUTBYTE(OPBYTE.GOODBYTE); "LEX;  END;   PROCEDURE ZOP2;  { EX }  BEGIN "IF DEBUG THEN WRITELN('Op2');  OPBYTE.GOODBP:=SYM^.OFFSETORVALUE &ELSE OPERROR; &PUTBYTE(OPBYTE.GOODBYTE); &LEX; $END "ELSE IF SYM^.ATTRIBUTE=DEFABS THEN $BEGIN  ; &LEX; $END "ELSE OPERROR;  END;   PROCEDURE ZOP5;  { SUB AND OR XOR CP }  BEGIN "IF DEBUG THEN WRITELN('Op5');  O SAVE:INTEGER;  BEGIN "IF DEBUG THEN WRITELN('Op8');  OPBYTE.BWORD:=SYM^.OFFSETORVALUE; "IF EXPRESS(TRUE) THEN PBYTE.GOODBYTE:=SYM^.OFFSETORVALUE; "IF EXPRESS(TRUE) THEN $BEGIN &IF RESULT.ATTRIBUTE=DEFREG THEN (BEGIN *OPBYTE.SOURCE:=R$IF CHECKOPERAND(TRUE,TRUE,TRUE,0,7) THEN &SAVE:=RESULT.OFFSETORVALUE; "IF EXPRESS(TRUE) THEN $BEGIN &IF RESULT.ATTRIBUTE=DESULT.OFFSETORVALUE; *PUTBYTE(OPBYTE.GOODBYTE); (END &ELSE IF CHECKOPERAND(TRUE,TRUE,TRUE,-128,255) THEN (BEGIN *OPBYTE.GOOEFREG THEN (BEGIN *PUTBYTE(OPBYTE.GOODBYTE); *OPBYTE.GOODBYTE:=OPBYTE.BADBYTE; *OPBYTE.SOURCE:=RESULT.OFFSETORVALUE; (END DBYTE:=OPBYTE.GOODBYTE + 64;{bit 7 goes on} *PUTBYTE(OPBYTE.GOODBYTE); *OPBYTE.GOODBYTE:=RESULT.OFFSETORVALUE; *PUTBYTE(OPBYT&ELSE OPERROR;  END "ELSE $BEGIN &OPENPARSE;  OPBYTE.GOODBYTE:=OPBYTE.BADBYTE; $END; "OPBYTE.DEST:=SAVE; "PUTBE.GOODBYTE); (END $END "ELSE OPENPARSE;  END;   PROCEDURE ZOP6;  { INC DEC }  BEGIN "IF DEBUG THEN WRITELN('Op6');  YTE(OPBYTE.GOODBYTE);  END;   PROCEDURE ZOP9;  { JP }  BEGIN "IF DEBUG THEN WRITELN('Op9');  OPBYTE.BWORD:=SYM^.OFFSET OPBYTE.BWORD:=SYM^.OFFSETORVALUE;  IF EXPRESS(TRUE) THEN $BEGIN &IF RESULT.ATTRIBUTE=DEFABS THEN (BEGIN ORVALUE; "IF EXPRESS(TRUE) THEN $BEGIN &IF RESULT.ATTRIBUTE=DEFCC THEN (BEGIN *OPBYTE.GOODBYTE:=194; {cc,nn gives 11xxx010=*PUTBYTE(RESULT.OFFSETORVALUE); *PUTBYTE(OPBYTE.BADBYTE); (END &ELSE IF (RESULT.ATTRIBUTE=DEFRP) AND (SYM^.NAME<>'AF ')C2} *OPBYTE.DEST:=RESULT.OFFSETORVALUE; *PUTBYTE(OPBYTE.GOODBYTE); *IF EXPRESS(TRUE) THEN ,PUTWORD(RESULT.OFFSETORVALUE); ( THEN (BEGIN *OPBYTE.GOODBYTE:=OPBYTE.BADBYTE; *OPBYTE.RP:=RESULT.OFFSETORVALUE; *PUTBYTE(OPBYTE.GOODBYTE); (END &ELSE IF END &ELSE IF (RESULT.ATTRIBUTE=DEFREG) AND (RESULT.OFFSETORVALUE=1) THEN (BEGIN *OPBYTE.GOODBYTE:=194; {cc,nn gives 11xxx010=RESULT.ATTRIBUTE=DEFREG THEN (BEGIN *OPBYTE.DEST:=RESULT.OFFSETORVALUE; *PUTBYTE(OPBYTE.GOODBYTE); (END &ELSE OPERROR; $ENC2} *OPBYTE.DEST:=3; *PUTBYTE(OPBYTE.GOODBYTE); *IF EXPRESS(TRUE) THEN ,PUTWORD(RESULT.OFFSETORVALUE); (END &ELSE ,TRUE,0,255) THEN ,BEGIN .OPBYTE.GOODBYTE:=OPBYTE.GOODBYTE + 64;{bit 7 goes on} .PUTBYTE(OPBYTE.GOODBYTE); .PUTBYTE(RESULT.OD "ELSE OPENPARSE;  END;   PROCEDURE ZOP7;  { RLC RL RRC RR SLA SRA SRL }  BEGIN "IF DEBUG THEN WRITELN('Op7');  OPBYFFSETORVALUE); ,END; $ END &ELSE OPENPARSE; $END "ELSE IF SYM^.NAME='HL ' THEN $BEGIN TE.BWORD:=SYM^.OFFSETORVALUE;  IF EXPRESS(TRUE) THEN $BEGIN &IF RESULT.ATTRIBUTE=DEFREG THEN (BEGIN *PUTBYTE(OPBYTE.GOODB$ PUTBYTE(237); {HL,RP gives ED} &OPBYTE.GOODBYTE:=OPBYTE.BADBYTE; &LEX; &IF LEXTOKEN<>COMMA THEN ERROR(78); &LEX; &IF (SYTE); *OPBYTE.GOODBYTE:=OPBYTE.BADBYTE; *OPBYTE.SOURCE:=RESULT.OFFSETORVALUE; *PUTBYTE(OPBYTE.GOODBYTE); (END &ELSE OPERRORYM^.ATTRIBUTE=DEFRP) AND (SYM^.NAME<>'AF ') THEN (OPBYTE.RP:=SYM^.OFFSETORVALUE &ELSE OPERROR; &PUTBYTE(OPBYTE.GOODBYTE); $END "ELSE $BEGIN &OPENPARSE;  PUTBYTE(OPBYTE.BADBYTE); $END;  END; $  PROCEDURE ZOP8;  { BIT SET RES }  VAR  ]<>OPENPAREN THEN (ERROR(80{( expected}) &ELSE (SPCIALSTKINDEX:=SPCIALSTKINDEX-1; &IF EXPRESS(TRUE) THEN (IF RESULT.ATTRIBUTE=DEFABS THEN *BEGIN ,PUTBYTE(SYM^.OFFSETORVALUE); ,PUTBYTE(OPBYTE.GOODBYTE); *END (ELSE IF (RESULT.ATTRIBUTE=DEFRP) AND (RESULT.OFFSETORVALUE=2) THEN *BEGIN ,PUTBYTE(OPBYTE.GOODBYTE); $ END (ELSE OPERROR; &IF SPECIALSTK[SPCIALSTKINDEX]<>CL {$U-}  {$S+}  {$R-}  {===============================================================}  { OSEPAREN THEN (ERROR(77) &ELSE SPCIALSTKINDEX:=SPCIALSTKINDEX-1; $END;  END;   PROCEDURE ZOP10;  { DJNZ }  BEGIN "IF D }  { UCSD ADAPTABLE ASSEMBLER }  { ---- ---EBUG THEN WRITELN('Op10');  OPBYTE.BWORD:=SYM^.OFFSETORVALUE; "IF EXPRESS(TRUE) THEN $BEGIN $ RELOCATE.OFFSETORVALUE:=REL------ --------- }  { Patterned after The Waterloo Last Assembler (TLA) }  { Core AuthoOCATE.OFFSETORVALUE - 2; &PUTRELWORD(OPBYTE.BWORD,TRUE,FALSE); $END "ELSE PUTBYTE(NOP);  END;  rs: William P. Franks and Dennis Volper }  { }  {  }  { Version : Zilog Z80 }  { 1 2 O^ Date : Sept. 22, 1978 }  { Author : William P. Franks  }  { }  {  }  { Institute for Information Systems }  { UC San Diego, La Jolla, CA }  {  }  { Kenneth L. Bowles, Director }  { (BEGIN *PUTBYTE(OPBYTE.BADBYTE); *PUTWORD(RESULT.OFFSETORVALUE); (END; $END "ELSE " BEGIN &IF SPECIALSTK[SPCIALSTKINDEX  {for debugging Assembler}   { Below constants are Assembler dependent} ' 'NOP =0; {A one byte NOP} 'ASMNSS(TRUE) THEN $IF (RESULT.ATTRIBUTE=DEFCC) OR &((RESULT.ATTRIBUTE=DEFREG) AND (RESULT.OFFSETORVALUE=1)) THEN &BEGIN & IF REAME ='Z80';  BYTEFIT =7; {Bytes that fit on line: 7 Hex, 5 Octal} 'WORDFIT =4; {Words thSULT.OFFSETORVALUE>3 THEN *BEGIN ,ERROR(83{illegal cc}); ,PUTBYTE(NOP); *END; (IF RESULT.ATTRIBUTE=DEFREG THEN RESULT.OFFSE }  { Copyright (C) 1978, }  { Regents of the University of Califat fit on line: 4 Hex, 3 Octal} 'HIBYTEFIRST =FALSE; {First byte is the high-order byte?} ornia, San Diego }  { }  {================================='LISTHIFIRST =FALSE; {High byte comes first in printed listing?} 'LCCHAR ='$'; {Location counter character} 'W==============================}  PROGRAM SYSTEMLEVEL;  TYPE PHYLE=FILE;  VAR FILLER:ARRAY[0..6] OF INTEGER; (USERINFOORDADDRESSED =FALSE; {Word as opposed to byte addressed} 'AFTERPLUS =0; {Char following plus that makes it auto-inc:RECORD *WORKSRC,WORKCODE:^PHYLE; *ERRSYM,ERRBLK,ERRNUM:INTEGER; *SLOWTERM,STUPID:BOOLEAN; *ALTMODE:CHAR; *FILLER2:ARRAY[0.r} 'AFTERMINUS =0; {Char following minus that makes it auto-decr}  DEFRADIX =10; {Default radix} 'L.21] OF INTEGER; {change with care...allows more} *WORKTITLE,SYMTITLE:STRING[15] {compile time space} (END;    SEGMISTRADIX =16; {Printed listing radix} 'HEXSWITCH ='H'; {Char following number which resets radix} 'DECSWITCH ENT PROCEDURE TLA(III,JJJ:INTEGER);  CONST RELEASEVERSION =TRUE; {Is this for the outside world?}  ='.'; 'OCTSWITCH =0; 'BINSWITCH ='B';  RELHI =TRUE; {Relative byte most significant pass'NUMKWORDS =27; {The number of key words in this assembler}  HASHRANGE =128; {The hash table size} 'Hed PUTWORD}   TYPE BITE=0..255; %PACKNAME=PACKED ARRAY[0..7] OF CHAR; %WORDSWAP=PACKED RECORD CASE INTEGER OF .0:(HWORD:INASHTOP =127; {One less than HASHRANGE}  MACROSIZE =19; {The buffer size for a MACRO stored on heap} TEGER); .1:(HIBYTE,LOWBYTE:BITE); .2:(HEX1,HEX2,HEX3,HEX4:0..15); .3:(OCT2,OCT3,OCT4,OCT5,OCT6:0..7; EOCT1:0..1); .4:(BIN:P BUFBLKS =2; {# of blocks for output buffer} 'BUFLIMIT =1023; { (BUFBLKS*512) - 1}  MAXPROC ACKED ARRAY[0..15] OF 0..1) *END; %BYTESWAP=PACKED RECORD CASE INTEGER OF .0:(BWORD:INTEGER); .1:(BADBYTE,GOODBYTE:BITE);  =10; {Maximum # of PROCS per assembly}  PAGESIZE =55; {Lines printed per page} 'CODESIZE =20.2:(DEST,SOURCE:0..7; 1DUM1:0..1023); * 3:(DUM2:0..15; 1RP:0..3; 1DUM3:0..1023) *END; .  (*$I ASM1.TEXT*)  (*$I ASM2; {testing values}  VIEWSTACK =TRUE; {Display stack & heap while assembling?}  DEBUG =FALSE;.TEXT*)  (*$I ASM3.TEXT*)  (*$I EXTRA.Z80*)   PROCEDURE ZOP11;  { JR }  BEGIN "IF DEBUG THEN WRITELN('Op11'); "IF EXPRE IN & OPBYTE.GOODBYTE:=OPBYTE.BADBYTE; (OPBYTE.DEST:=3; (PUTBYTE(OPBYTE.GOODBYTE); (IF EXPRESS(TRUE) THEN *PUTWORD(RESULT.OR(77) (ELSE SPCIALSTKINDEX:=SPCIALSTKINDEX-1; (LEX; (IF SYM^.ATTRIBUTE=DEFREG THEN *BEGIN * OPBYTE.GOODBYTE:=65; {(C),r giFFSETORVALUE) (ELSE PUTBYTE(NOP); &END $ELSE &BEGIN & PUTBYTE(OPBYTE.GOODBYTE); (PUTWORD(RESULT.OFFSETORVALUE); &END "Eves 01xxx001=41} ,OPBYTE.DEST:=SYM^.OFFSETORVALUE; ,PUTBYTE(OPBYTE.GOODBYTE); *END (ELSE *BEGIN * ERROR(85{r expected}); LSE PUTBYTE(NOP);  END;   PROCEDURE ZOP13;  { IN }  VAR A:BOOLEAN;  SAVE:INTEGER;  BEGIN "IF DEBUG THEN WRITELN(',PUTBYTE(NOP); *END; & LEX; &END $ELSE IF CHECKOPERAND(FALSE,TRUE,TRUE,-128,255) THEN &BEGIN (IF SPCIALSTKINDEX=-1 THEN Op13');  OPBYTE.BWORD:=SYM^.OFFSETORVALUE; "LEX; "IF SYM^.ATTRIBUTE<>DEFREG THEN # OPERROR "ELSE $BEGIN *ERROR(77) (ELSE SPCIALSTKINDEX:=SPCIALSTKINDEX-1; & PUTBYTE(OPBYTE.GOODBYTE); (OPBYTE.GOODBYTE:=RESULT.OFFSETORVALUE; (PU&SAVE:=SYM^.OFFSETORVALUE; &A:=(SYM^.NAME='A '); &LEX; &IF LEXTOKEN<>COMMA THEN ERROR(78); &LEX; &IF LEXTOKEN<>OPENPTBYTE(OPBYTE.GOODBYTE); & LEX; (IF SYM^.NAME<>'A ' THEN ERROR(86{A expected}); (LEX; &END $ELSE PUTBYTE(NOP) "ELSE TORVALUE:=3; (CASE RESULT.OFFSETORVALUE OF *0:OPBYTE.GOODBYTE:=32; {NZ,e gives 20xx} *1:OPBYTE.GOODBYTE:=40; {Z,e gives 28xx}AREN THEN ERROR(80{( expected}); &IF EXPRESS(TRUE) THEN (IF RESULT.ATTRIBUTE=DEFREG THEN *BEGIN ,IF RESULT.OFFSETORVALUE=1 { *2:OPBYTE.GOODBYTE:=48; {NC,e gives 30xx} *3:OPBYTE.GOODBYTE:=56 {C,e gives 38xx} (END; & IF EXPRESS(TRUE) THEN *BEGIN register C} THEN .BEGIN 0PUTBYTE(OPBYTE.BADBYTE); 0OPBYTE.GOODBYTE:=64; {r,(C) gives 01xxx000=40} 0OPBYTE.DEST:=SAVE; 0PUTB* RELOCATE.OFFSETORVALUE:=RELOCATE.OFFSETORVALUE - 2; ,PUTRELWORD(OPBYTE.BWORD,TRUE,FALSE); *END (ELSE PUTBYTE(NOP); &END YTE(OPBYTE.GOODBYTE); .END ,ELSE .BEGIN 0ERROR(84{C expected}); 0PUTBYTE(NOP); .END; *END (ELSE IF A THEN *BEGIN ,PUTB$ELSE &BEGIN & OPBYTE.GOODBYTE:=24; {e gives 18xx} (RELOCATE.OFFSETORVALUE:=RELOCATE.OFFSETORVALUE - 2; YTE(OPBYTE.GOODBYTE); ,IF CHECKOPERAND(FALSE,TRUE,TRUE,-128,255) THEN .BEGIN 0OPBYTE.GOODBYTE:=RESULT.OFFSETORVALUE; 0PUTBYT& PUTRELWORD(OPBYTE.BWORD,TRUE,FALSE); &END "ELSE PUTBYTE(NOP);  END;   PROCEDURE ZOP12;  { CALL }  BEGIN "IF DEBUG TE(OPBYTE.GOODBYTE); * END; *END (ELSE OPERROR; &IF SPCIALSTKINDEX=-1 THEN (ERROR(77) ELSE SPCIALSTKINDEX:=SPCIALSHEN WRITELN('Op12');  OPBYTE.BWORD:=SYM^.OFFSETORVALUE; "IF EXPRESS(TRUE) THEN $IF RESULT.ATTRIBUTE=DEFCC THEN &BEGIN & TKINDEX-1; $END;  END;   PROCEDURE ZOP14;  { OUT }  BEGIN "IF DEBUG THEN WRITELN('Op14');  OPBYTE.BWORD:=SYM^.OFFSETOOPBYTE.GOODBYTE:=OPBYTE.BADBYTE; (OPBYTE.DEST:=RESULT.OFFSETORVALUE; (PUTBYTE(OPBYTE.GOODBYTE); (IF EXPRESS(TRUE) THEN *PUTWRVALUE; "LEX; "IF LEXTOKEN<>OPENPAREN THEN ERROR(80{( expected}); "IF EXPRESS(TRUE) THEN $IF RESULT.ATTRIBUTE=DEFREG THEN ORD(RESULT.OFFSETORVALUE) (ELSE PUTBYTE(NOP); &END $ELSE IF (RESULT.ATTRIBUTE=DEFREG) AND (RESULT.OFFSETORVALUE=1) THEN &BEG&BEGIN & IF RESULT.OFFSETORVALUE<>1 THEN ERROR(84{C expected}); (PUTBYTE(OPBYTE.BADBYTE); (IF SPCIALSTKINDEX=-1 THEN *ERRO FFSETORVALUE; "IF EXPRESS(TRUE) THEN $BEGIN &RESULT.OFFSETORVALUE:=RESULT.OFFSETORVALUE DIV 8; &IF CHECKOPERAND(TRUE,TRUE,TR( PUTBYTE(SYM^.OFFSETORVALUE); *LEX; *IF LEXTOKEN<>PLUS THEN ERROR(79); ( IF EXPRESS(TRUE) THEN ,IF CHECKOPERAND(FALSE,TRUE,0,7) THEN (OPBYTE.DEST:=RESULT.OFFSETORVALUE; &PUTBYTE(OPBYTE.GOODBYTE); " END "ELSE PUTBYTE(NOP);  END;   PROCEDUREUE,TRUE,0,255) THEN .BEGIN ( N1:=RESULT.OFFSETORVALUE; 0IF SPCIALSTKINDEX=-1 THEN 2ERROR(77) 0ELSE SPCIALSTKINDEX:=S ZOP18;  { LDI LDIR LDD LDDR CPI CPIR CPD CPDR NEG RLD RRD "RETI RETN INI INIR IND INDR OUTI OTIR OUTD OTDR }  BEGIN "IF DEBPCIALSTKINDEX-1; 0IF EXPRESS(TRUE) THEN 2IF RESULT.ATTRIBUTE=DEFREG THEN 4BEGIN 4 OPBYTE.GOODBYTE:=112; {(IY+n),r gives 011UG THEN WRITELN('Op18');  OPBYTE.BWORD:=SYM^.OFFSETORVALUE; "PUTBYTE(OPBYTE.BADBYTE); "PUTBYTE(OPBYTE.GOODBYTE); "LEX;  E10xxx=70} 6OPBYTE.SOURCE:=RESULT.OFFSETORVALUE; 6PUTBYTE(OPBYTE.GOODBYTE); 6PUTBYTE(N1); 4END 2ELSE IF CHECKOPERAND(TRUE,TRND;   PROCEDURE ZOP19;  { LD }   PROCEDURE OP19OPEN;  VAR N1:INTEGER;   PROCEDURE OPENNN;  BEGIN UE,TRUE,-128,255) THEN 4BEGIN 4 PUTBYTE(54); {(IX+n),n gives 36} 6PUTBYTE(N1); 6OPBYTE.GOODBYTE:=RESULT.OFFSETORVALUE; 6PU"EXPRSSADVANCE:=FALSE; "IF EXPRESS(TRUE) THEN $BEGIN &IF SPCIALSTKINDEX=-1 THEN (ERROR(77) &ELSE SPCIALSTKINDEX:=SPCIALSTKTBYTE(OPBYTE.GOODBYTE); 4END 2ELSE PUTBYTE(NOP) 0ELSE PUTBYTE(NOP); .END ,ELSE PUTBYTE(NOP) *ELSE PUTBYTE(NOP); (END &ELINDEX-1; &LEX; &IF LEXTOKEN=TIDENTIFIER THEN (BEGIN *IF SYM^.ATTRIBUTE=DEFABS THEN ,BEGIN .PUTBYTE(SYM^.OFFSETORVALUE); .SE IF SYM^.NAME='HL ' THEN (BEGIN ( LEX; *IF LEXTOKEN<>CLOSEPAREN THEN ERROR(77); *LEX; *IF LEXTOKEN<>COMMA THEN ERROPUTBYTE(34); {(nn),IX gives 22} .PUTWORD(RESULT.OFFSETORVALUE); ,END *ELSE IF SYM^.NAME='HL ' THEN ,BEGIN .PUTBYTE(34)R(78); ( IF EXPRESS(TRUE) THEN ,IF RESULT.ATTRIBUTE=DEFREG THEN .BEGIN PUTBYTE(NOP);  END;   PROCEDURE ZOP15;  { EXX DAA CPL CCF SCF NOP HALT DI EI RLCA RLA RRCA RRA }  BEGIN "IF DEBUG THEN WR; {(nn),HL gives 22} .PUTWORD(RESULT.OFFSETORVALUE); ,END *ELSE IF (SYM^.ATTRIBUTE=DEFRP) AND (SYM^.NAME<>'AF ') THEN ,ITELN('Op15');  PUTBYTE(SYM^.OFFSETORVALUE); "LEX;  END;   PROCEDURE ZOP16;  { IM }  BEGIN BEGIN .PUTBYTE(237); {(nn),rp gives ED} .OPBYTE.GOODBYTE:=67; {01xx0011=43} .OPBYTE.RP:=SYM^.OFFSETORVALUE; .PUTBYTE(OPBYTE."IF DEBUG THEN WRITELN('Op16');  PUTBYTE(SYM^.OFFSETORVALUE); "IF EXPRESS(TRUE) THEN $IF CHECKOPERAND(TRUE,TRUE,TRUE,0,2) GOODBYTE); .PUTWORD(RESULT.OFFSETORVALUE); ,END *ELSE IF SYM^.NAME='A ' THEN ,BEGIN .PUTBYTE(50); {(nn),A gives 32} THEN &CASE RESULT.OFFSETORVALUE OF (0:PUTBYTE(70); {46} (1:PUTBYTE(86); {56} (2:PUTBYTE(94) {5E} &END $ELSE PUTBYTE(NOP) .PUTWORD(RESULT.OFFSETORVALUE); ,END *ELSE OPERROR; (END &ELSE OPERROR; &LEX; $END "ELSE PUTBYTE(NOP);  END;   BEGIN "ELSE PUTBYTE(NOP);  END;   PROCEDURE ZOP17;  { RST }  BEGIN "IF DEBUG THEN WRITELN('Op17');  OPBYTE.GOODBYTE:=SYM^.O{ OP19OPEN }  LEX; "IF LEXTOKEN=TIDENTIFIER THEN  BEGIN $ IF SYM^.ATTRIBUTE=DEFABS THEN (BEGIN  VALUE; 0PUTBYTE(OPBYTE.GOODBYTE); .END ,ELSE PUTBYTE(NOP) *ELSE PUTBYTE(NOP); (END &ELSE IF (SYM^.NAME='BC ') OR (SYMes 01xxx110=46} 0OPBYTE.DEST:=OPREG1; 0PUTBYTE(OPBYTE.GOODBYTE); 0PUTBYTE(RESULT.OFFSETORVALUE); .END; ^.NAME='DE ') THEN (BEGIN ( IF SYM^.OFFSETORVALUE=0 THEN PUTBYTE(2) {(DE),A gives 12} *ELSE PUTBYTE(18); {(BC),A gives *IF SPCIALSTKINDEX=-1 THEN ,ERROR(77) *ELSE SPCIALSTKINDEX:=SPCIALSTKINDEX-1; (END &ELSE IF (LEXTOKEN=TIDENTIFIER) AND (SYM02} ( LEX; *IF LEXTOKEN<> CLOSEPAREN THEN ERROR(77); *LEX; *IF LEXTOKEN<>COMMA THEN ERROR(78); *LEX; *IF SYM^.NAME<>'A ^.ATTRIBUTE=DEFRP) THEN (BEGIN *IF SYM^.OFFSETORVALUE=0 THEN ,IF OPREG1<>7 THEN OPERROR .ELSE PUTBYTE(10) {A,(BC) gives 0A}  ' THEN ERROR(86{A expected}); *LEX; (END &ELSE OPENNN; $END "ELSE  OPENNN;  END;   PROCEDURE OP19REG;  VAR O*ELSE IF SYM^.OFFSETORVALUE=1 THEN ,IF OPREG1<>7 THEN OPERROR .ELSE PUTBYTE(26) {A,(DE) gives 1A} *ELSE IF SYM^.OFFSETORVALUPREG1:INTEGER;  BEGIN  OPREG1:=SYM^.OFFSETORVALUE; "LEX; "IF LEXTOKEN<>COMMA THEN ERROR(78); "IF EXPRESS(TRUE) THEN $BEGE=2 THEN ,BEGIN .OPBYTE.GOODBYTE:=70; {r,(HL) gives 01xxx110} .OPBYTE.DEST:=OPREG1; .PUTBYTE(OPBYTE.GOODBYTE); ,END *ELSE IN &IF RESULT.ATTRIBUTE=DEFIR THEN (BEGIN *IF OPREG1<>7 THEN ,OPERROR *ELSE ,BEGIN .PUTBYTE(237); {A,I gives ED} PUTBYTE(NOP); *LEX; *IF LEXTOKEN<>CLOSEPAREN THEN ERROR(77); *LEX; (END &ELSE IF OPREG1=7 THEN (BEGIN *EXPRSSADVANCE:=FAL.PUTBYTE(RESULT.OFFSETORVALUE + 16); ,END; (END &ELSE IF RESULT.ATTRIBUTE=DEFREG THEN (BEGIN *OPBYTE.GOODBYTE:=64; {r1,r2 SE; *PUTBYTE(58); {A,(nn) gives 3A} *IF EXPRESS(TRUE) THEN ,PUTWORD(RESULT.OFFSETORVALUE); *IF SPCIALSTKINDEX=-1 THEN ,ERROgives 01xxxyyy=40} *OPBYTE.DEST:=OPREG1; *OPBYTE.SOURCE:=RESULT.OFFSETORVALUE; *PUTBYTE(OPBYTE.GOODBYTE); (END &ELSE IF CHER(77) *ELSE SPCIALSTKINDEX:=SPCIALSTKINDEX-1; (END %ELSE 'BEGIN )OPERROR; )LEX; 'END $END;  END;   PROCEDURE OP19RP;CKOPERAND(TRUE,TRUE,TRUE,-128,255) THEN (BEGIN *OPBYTE.GOODBYTE:=6; {r,n gives 00xxx110=6} *OPBYTE.DEST:=OPREG1; *PUTBYTE(OP  VAR OPRP1:INTEGER;  EXTRASYM:SYMTABLEPTR;  BEGIN  OPRP1:=SYM^.OFFSETORVALUE; "EXTRASYM:=SYM; "LEX; BYTE.GOODBYTE); *OPBYTE.GOODBYTE:=RESULT.OFFSETORVALUE; *PUTBYTE(OPBYTE.GOODBYTE); (END $END "ELSE IF SPCIALSTKINDEX<>-1 TH"IF LEXTOKEN<>COMMA THEN ERROR(78);  LEX; "IF LEXTOKEN=OPENPAREN THEN $BEGIN $ IF EXPRESS(TRUE) THEN (IF EXTRASYM^.NAMEEN $BEGIN &IF SPECIALSTK[SPCIALSTKINDEX]<>OPENPAREN THEN (ERROR(80{( expected}); &SPCIALSTKINDEX:=SPCIALSTKINDEX-1; &LEX; ='HL ' THEN *BEGIN ,PUTBYTE(42); {HL,(nn) gives 2A} ,PUTWORD(RESULT.OFFSETORVALUE); ,IF SPCIALSTKINDEX=-1 THEN .ERROR(. OPBYTE.GOODBYTE:=112; {(HL),r gives 01110xxx=70} 0OPBYTE.SOURCE:=RESULT.OFFSETORVALUE; 0PUTBYTE(OPBYTE.GOODBYTE); .END ,&IF (LEXTOKEN=TIDENTIFIER) AND (SYM^.ATTRIBUTE=DEFABS) THEN (BEGIN *PUTBYTE(SYM^.OFFSETORVALUE); *LEX; *IF LEXTOKEN<>PLUS THELSE IF CHECKOPERAND(TRUE,TRUE,TRUE,-128,255) THEN .BEGIN . PUTBYTE(54); {(HL),n gives 36} 0OPBYTE.GOODBYTE:=RESULT.OFFSETOREN ERROR(79); *IF EXPRESS(TRUE) THEN ,IF CHECKOPERAND(FALSE,TRUE,TRUE,0,255) THEN .BEGIN 0OPBYTE.GOODBYTE:=70; {r,(IX+n) giv  GIN {ZOP19} "IF DEBUG THEN WRITELN('Op19');  LEX; "IF LEXTOKEN=OPENPAREN THEN $OP19OPEN "ELSE IF LEXTOKEN=TIDENTIFIER THENOP SCF 7CCF ?CPL /DAA 'EXX OUT IN CALL JR DJNZ 77) ,ELSE SPCIALSTKINDEX:=SPCIALSTKINDEX-1; *END (ELSE *BEGIN ,PUTBYTE(237); {rp,(nn) gives ED} ,OPBYTE.GOODBYTE:=75; {01xN $BEGIN $ IF SYM^.ATTRIBUTE=DEFREG THEN (OP19REG &ELSE IF (SYM^.ATTRIBUTE=DEFRP) AND (SYM^.NAME<>'AF ') THEN x1011=4B} ,OPBYTE.RP:=OPRP1; ,PUTBYTE(OPBYTE.GOODBYTE); ,PUTWORD(RESULT.OFFSETORVALUE); ,IF SPCIALSTKINDEX=-1 THEN .ERROR(7(OP19RP &ELSE IF SYM^.ATTRIBUTE=DEFABS THEN (OP19ABS &ELSE IF SYM^.ATTRIBUTE=DEFIR THEN (BEGIN *PUTBYTE(237); {I,A gives E7) ,ELSE SPCIALSTKINDEX:=SPCIALSTKINDEX-1; *END &ELSE PUTBYTE(NOP); $END "ELSE IF SYM^.ATTRIBUTE=DEFABS THEN $BEGIN $ IFD} *PUTBYTE(SYM^.OFFSETORVALUE); *LEX; *IF LEXTOKEN<>COMMA THEN ERROR(78); *LEX; *IF SYM^.NAME<>'A ' THEN ERROR(86{A  EXTRASYM^.NAME='SP ' THEN (BEGIN *PUTBYTE(SYM^.OFFSETORVALUE); *PUTBYTE(249); {SP,HL gives F9} & END &ELSE OPERROR; expected}); *LEX; (END &ELSE OPERROR; $END "ELSE OPERROR;  END;   PROCEDURE ZOP20;  { RET }  BEGIN "IF DEBUG THEN WR$ LEX; $END "ELSE IF (SYM^.NAME='HL ') AND (LEXTOKEN=TIDENTIFIER) THEN $BEGIN $ IF EXTRASYM^.NAME='SP ' THEN (ITELN('Op20'); "OPBYTE.BWORD:=SYM^.OFFSETORVALUE;  LEX; "IF LEXTOKEN<>ENDLINE THEN $IF SYM^.ATTRIBUTE=DEFCC THEN $ BEGINPUTBYTE(249) {SP,HL gives F9} &ELSE OPERROR; $ LEX; $END "ELSE $BEGIN &EXPRSSADVANCE:=FALSE; &IF EXPRESS(TRUE) THEN  & OPBYTE.GOODBYTE:=OPBYTE.BADBYTE; & OPBYTE.DEST:=SYM^.OFFSETORVALUE; & PUTBYTE(OPBYTE.GOODBYTE); & LEX; &END $ELSE I(BEGIN *OPBYTE.GOODBYTE:=1; {rp,nn gives 00xx0001} *OPBYTE.RP:=OPRP1; *PUTBYTE(OPBYTE.GOODBYTE); *PUTWORD(RESULT.OFFSETORVAF (SYM^.ATTRIBUTE=DEFREG) AND (SYM^.OFFSETORVALUE=1) THEN &BEGIN & OPBYTE.GOODBYTE:=OPBYTE.BADBYTE; & OPBYTE.DEST:=3; & PLUE); $ END &ELSE PUTBYTE(NOP); $END;  END;   PROCEDURE OP19ABS;  BEGIN "PUTBYTE(SYM^.OFFSETORVALUE); "LEX; "IF LEUTBYTE(OPBYTE.GOODBYTE); & LEX; &END $ELSE OPERROR "ELSE $PUTBYTE(OPBYTE.GOODBYTE);  END;   (*$I ASM4.TEXT*)  (*$I ASXTOKEN<>COMMA THEN ERROR(78); "IF EXPRESS(TRUE) THEN $BEGIN &PUTBYTE(33); {IX,nn gives 21} &PUTWORD(RESULT.OFFSETORVALUE); M5.TEXT*)  (*$I ASM6.TEXT*)   BEGIN {Dummy outer block} END. $END "ELSE IF SPCIALSTKINDEX<>-1 THEN $BEGIN &IF SPECIALSTK[SPCIALSTKINDEX]<>OPENPAREN THEN (ERROR(80{( expected}); &SPCIALLD OTDR OUTD OTIR OUTI INDR IND INIR INI RETN ERETI STKINDEX:=SPCIALSTKINDEX-1; &IF EXPRESS(TRUE) THEN (BEGIN *PUTBYTE(42); {IX,(nn) gives 2A} *PUTWORD(RESULT.OFFSETORVALUE); MRRD gRLD oNEG DCPDR CPD CPIR CPI LDDR LDD LDIR LDI *IF SPCIALSTKINDEX=-1 THEN ,ERROR(77) *ELSE SPCIALSTKINDEX:=SPCIALSTKINDEX-1; (END &ELSE PUTBYTE(NOP); $END;  END;   BE RST IM RET RRA RRCA RLA RLCA EI DI HALT v  ust have procedure name labelsll or intnumber of parameters expectedlsll or intextra garbage on lineexpectedlsll or intinpcharacters 1eillegal use of macro parameterracters 1eno local labels in .ASECTmeterracters 1eexpected key wordn .ASECTmeteut line over 80 characterslsll or intnot enough .IF's80 characterslsll or int&must be declared in .ASECT before usedntidentrracters 1estring expectedrdn .ASECTmeterracters 1ebad block, parity error (CRC)rracters 1ebad unit numberty error (CRC)rrifier previously declaredore usedntimproper formatiously declaredore usednt .EQU expectedatiously declaredore usednt&must .Eacters 1ebad mode, illegal operationC)rracters 1eundefined hardware errorionC)rracters 1e$lost unit, unit is no longer on-lQU before use if not to a labelntmacro identifier expectedot to a labelntword addressed machinetedot to a labelnt#backward ines 1e(lost file, file is no longer in directorbad title, illegal file name in director#no room, insufficient space on disk JP RES ˆ SET BIT F SRL >SRA .SLA &RR RRC RL RLC .ORG currently not allowedbelntidentifier expectedntly not allowedbelntconstant expectededntly not allowedbelntinvalid str DEC 5+INC 4#CP XOR OR AND SUB SBC BADC JADD uctureedntly not allowedbelntextra special symboltly not allowedbelntbranch too farsymboltly not allowedbelntvariable not EX IY IX M P PE PO NC Z NZ A PC relativenot allowedbelntillegal macro parameter indexllowedbelntnot enough macro parametersexllowedbelntoperand not absL H E D C B AF SP HL DE BC oluteametersexllowedbelntillegal use of special symbolslowedbelntill-formed expressionl symbolslowedbelntnot enough operan PUSH POP I GR Odsonl symbolslowedbelnt&cannot handle this relative expressionntconstant overflows relative expressionntillegal decimal constantive expressionntillegal octal constantntive expressionntillegal binary constanttive expressionntinvalid key wordonstanttive expressionnt%unexpected end of input - after macronntinclude files may not be nested macronntunexpected end of inpute nested macronnt(this is a bad place for an .INCLUDE file'only labels & comments may occupy col 1eexpected local labelts ma ust branch backwards to labelsll or intundefined labelkwards to labelsll or intoperand out of ranges to labelsll or intmy occupy col 1elocal label stack overflow occupy col 1e#string constant must be on one lineol 1e%string constant exceeds 80  ot EQU to undefined labelsll or int ay not EQU to undefined labelsll or int ay not EQU to undefined labelsll or intincorrect operand format labelsll or intclose paren ')' expected labelsll or intcomma ',' expectedpected labelsll or intplus '+' expecteddpected labelsll or intopen paren '(' expectedd labelsll or intstack pointer 'SP' expectedbelsll or int 'HL' expected 'SP' expectedbelsll or intillegal 'cc' condition codebelsll or intregister 'C' expectedn codebelsll or intregister expe   (******************************************************************) $(* cted 'r'n codebelsll or intregister 'A' expectedn codebelsll or int *) $(* SETUP System reconfiguration utility *) $(* Author: J. Greg Davidson *) $(* Date: 18 September, 1978 *) $(* Time:  2:45 P.M. *) $(* Version: 1 (for UCSD Pascal system version I.5) *) $(* ectorno unit, no such volume on-linediskectorno file, no such file on volumediskectorduplicate filech file on volumediskector(not closed, attempt to open an open file(not open, attempt to access a closed fil(bad format, error in reading real or inSTART FINISH HERE 1 2 t nested macro definitions illegall or int'=' or '<>' expectedions illegall or intmay not EQU to undefined labelsll or int#m? ay not EQU to undefined labelsll or int ay not EQU to undefined labelsll or int ay not EQU to undefined labelsll or int O^ȝ)'ay not EQU to undefined labelsll or int ay not EQU to undefined labelsll or int ay not EQU to undefined labelsll or int ay not EQU to undefined labelsll or int ay not EQU to undefined labelsll or int ay not EQU to undefined labelsll or int ay n  f the University of California. *) $(* Permission to copy or distribute this software or documen- *) SEARCH(KEY:STRING):BOOLEAN; 'FORWARD; % %PROCEDURE DESPACE(VAR TEMP:STRING;VAR STR:STRING); 'FORWARD; '  {Adjust segm$(* tation in hard or soft copy granted only by written license *) $(* obtained from the Institute for Information Systement numbers so INITS will be number 10} (SEGMENT PROCEDURE NUMBER2; BEGIN END; (SEGMENT PROCEDURE NUMBER3; BEGIN END; (SEs. *) $(* *) $(***************************************GMENT PROCEDURE NUMBER4; BEGIN END; (SEGMENT PROCEDURE NUMBER5; BEGIN END; (SEGMENT PROCEDURE NUMBER6; BEGIN END; (SEGM***************************) $ $ {$U-}  PROGRAM PASCALSYSTEM;  CONST "STARTINDEX = 29; "ENDINDEX = 47; "BITINDMAX = 15ENT PROCEDURE NUMBER7; BEGIN END; (SEGMENT PROCEDURE NUMBER8; BEGIN END; (SEGMENT PROCEDURE NUMBER9; BEGIN END; ' ; "WIDTHMAX = 16; {BITINDMAX + 1} "WRDINDMAX = 95;  TYPE "INFORANGE = STARTINDEX..ENDINDEX; "WORD = PACKED ARRAY[%SEGMENT PROCEDURE INITS; %TYPE 'HEAPMAGIC = RECORD 5CASE INTEGER OF 70:(INT:INTEGER); 71:(PTR:^INTEGER) 3END;{CASERECORD0..15] OF 0..1; "MISCINFOREC = ARRAY[0..WRDINDMAX] OF WORD;  VAR "PSYSCOM: ^MISCINFOREC; "  SEGMENT PROCEDURE SETUP(III,J} %VAR 'HEAP:HEAPMAGIC; 'INDEX: INDEXRANGE; * *PROCEDURE INITASCII; *VAR ,ORDCHR:-1..32; * /PROCEDURE A(MNEMONIC:TRIGRAJJ:INTEGER{NOT USED});  CONST "NEWINFO = '*NEW.MISCINFO'; "BS = '/'; "DEL = '<'; "ESC = '!';  TYPE "TPH); /BEGIN 1ORDCHR := ORDCHR + 1; 1LOWASCIIS[ORDCHR] := MNEMONIC; /END; * *BEGIN {INITASCII} ,ORDCHR := -1; ,A('NUL'); RIGRAPH = STRING[3]; " "SCALVAL = 0..MAXINT; "SCALARS = ^SCALREC; SCALREC = RECORD /LINK: SCALARS; /VAL: SCALVAL; /NAME A('SOH'); A('STX'); A('ETX'); A('EOT'); ,A('ENQ'); A('ACK'); A('BEL'); A('BS' ); A('HT' ); ,A('LF' ); A('VT' ); A('F: STRING -END; " "INDEXRANGE = 0..WRDINDMAX; "BITRANGE = 0..BITINDMAX; "WIDTHRANGE = 0..WIDTHMAX; F' ); A('CR' ); A('SO' ); ,A('SI' ); A('DLE'); A('DC1'); A('DC2'); A('DC3'); ,A('DC4'); A('NAK'); A('SYN'); A('ETB');"TREE = ^TREEREC; TREEREC = RECORD /WORDINDEX: INDEXRANGE; /BITINDEX: BITRANGE; /WIDTH: WIDTHRANGE; /VALNAMES:  A('CAN'); ,A('EM' ); A('SUB'); A('ESC'); A('FS' ); A('GS' ); ,A('RS' ); A('US' ); A('SP' ); *END; {INITASCII} * *PR Institute for Information Systems *) $(* University of California, San Diego  SCALARS; /LEFT,RIGHT: TREE; /NAME: STRING -END;   VAR "CH: CHAR; "DEFRADIX: 8..16; "ABORT: BOOLEA *) $(* La Jolla, California *) $(* Director: Kenneth L. Bowles N;  ROOT,GROUND,TREEPTR,TRAIL: TREE; "SCALGROUND,NUMBER,CHARACTER: SCALARS; "DELTAWORD,DOTCOUNT:INTEGER; "BUFFER :M *) $(* *) $(* Copyright (c) l978 Regents oISCINFOREC; "LOWASCIIS: ARRAY [0..33] OF TRIGRAPH;  %PROCEDURE ASSERT(B:BOOLEAN;NUM:STRING); 'FORWARD; % %FUNCTION TREE OCEDURE INITTREE; *VAR ,SCAL:SCALARS; ,PWIDTH:WIDTHRANGE; * *PROCEDURE CUTHEAP(STR:STRING); *{ ** This procedure assumes: TEMP; *END; * *PROCEDURE SETUP1; *BEGIN ,{Set up the boolean fields} .SCAL := SCALGROUND; .NEXT(1,'T'); .NEXT(0,'F');  ** 1) The last NEW statement allocated a record on the stack. ** 2) The record is not a CASE record. .NEXT(1,'TRUE'); .NEXT(0,'FALSE'); .PWIDTH := 1; .ENTER('HAS CLOCK', 29, 0); .ENTER('HAS 8510A', ** 3) The last field of the record is of type STRING (STRING[80]). ** 4) That last field has been initialized with the strin 29, 1); .ENTER('HAS LOWER CASE', 29, 2); .ENTER('HAS RANDOM CURSOR ADDRESSING', 29, 3g STR. ** 5) That last field will never again be changed. ** 6) This is the only heap diddling code in the program. ** The ); .ENTER('HAS SLOW TERMINAL', 29, 4); , ,{PREFIXED FOR CRTCTRL} .ENTER('PREFIXED[MOVE CURSOR UP]', purpose of this procedure is to deallocate the unused part of ** the string forming the last part of that record. *} *VAR ,H 36, 0); .ENTER('PREFIXED[MOVE CURSOR RIGHT]', 36, 1); EAPTRIX: HEAPMAGIC; *BEGIN ,MARK(HEAPTRIX.PTR); ,HEAPTRIX.INT := HEAPTRIX.INT C+ ((LENGTH(STR) + 1) DIV 2 - 40) * DELTAWORD;.ENTER('PREFIXED[ERASE TO END OF LINE]', 36, 2); .ENTER('PREFIXED[ERASE TO END OF SCREEN]', 36, 3); .ENTER( ,RELEASE(HEAPTRIX.PTR); *END; * *PROCEDURE ENTER(PNAME:STRING;PWRD:INDEXRANGE;PBIT:BITRANGE); *VAR ,B:BOOLEAN; ,TEMP1,TE'PREFIXED[MOVE CURSOR HOME]', 36, 4); .ENTER('PREFIXED[DELETE CHARACTER]', 36, 5); .ENTER('PREFIXEMP2:STRING; *BEGIN ,WRITE('.'); ,DOTCOUNT := DOTCOUNT + 1; ,IF DOTCOUNT = 50 THEN .BEGIN 0WRITELN; 0DOTCOUNT := 0; .END;D[ERASE SCREEN]', 36, 6); .ENTER('PREFIXED[ERASE LINE]', 36, 7); . ,{PREFIXED FOR CRTIN ,DESPACE(TEMP1,PNAME); ,B := TREESEARCH(TEMP1); ,ASSERT(NOT B,CONCAT('ENTER ',PNAME)); ,NEW(TREEPTR); ,WITH TREEPTR^ DO .FO} .ENTER('PREFIXED[KEY FOR MOVING CURSOR RIGHT]', 47, 0); .ENTER('PREFIXED[KEY FOR MOVING CURSOR LEFT]', 47, 1); .BEGIN 0NAME := PNAME; 0CUTHEAP(NAME); 0WORDINDEX := PWRD; 0BITINDEX := PBIT; 0WIDTH := PWIDTH; 0VALNAMES := SCAL; ENTER('PREFIXED[KEY FOR MOVING CURSOR UP]', 47, 2); .ENTER('PREFIXED[KEY FOR MOVING CURSOR DOWN]', 47, 3); .ENTER(0LEFT := GROUND; 0RIGHT := GROUND; .END; ,DESPACE(TEMP1,TRAIL^.NAME); ,DESPACE(TEMP2,PNAME); ,IF TEMP1 > TEMP2 THEN .TRAI'PREFIXED[NON-PRINTING CHARACTER]', 47, 4); .ENTER('PREFIXED[KEY FOR STOP]', 47, 6); .ENTER('PREFIL^.LEFT := TREEPTR ,ELSE .TRAIL^.RIGHT := TREEPTR; *END; * *PROCEDURE NEXT(ORDVAL:SCALVAL;STR:STRING); *VAR ,TEMP:SCALARSXED[KEY FOR BREAK]', 47, 7); .ENTER('PREFIXED[KEY FOR FLUSH]', 47, 8); .ENTER('PREFIXED[KE; *BEGIN ,NEW(TEMP); ,WITH TEMP^ DO .BEGIN 0LINK := SCAL; 0VAL := ORDVAL; 0NAME := STR; 0CUTHEAP(NAME) .END; ,SCAL :=Y TO END FILE]', 47, 9); .ENTER('PREFIXED[EDITOR ''ESCAPE'' KEY]', 47, 10);  .ENTER('KEY FOR STOP', 42,8); .ENTER('NON-PRINTING CHARACTER', 43,8); .ENTER('KEY TO DELETE LINEWILL ALSO'); ,W(' HAVE TO BIND IN THE PROCEDURE GOTOXY IN THE'); ', 44,0); .ENTER('EDITOR "ESCAPE" KEY', 44,8); .ENTER('LEAD-IN CHAR FROM KEYBOARD', 45,0); .,W(' OPERATING SYSTEM. SEE SECTION X OF THE DOCUMENTS.'); *END; % *PROCEDURE PART1; *BEGIN *END; * *PROCEDURE PART2ENTER('EDITOR "ACCEPT" KEY', 45,8); .ENTER('KEY TO DELETE CHARACTER', 46,0); . ,{Set up miscellaneous f; *BEGIN *W('ALL NON-PRINTING CHARACTERS EXCEPT CR WILL ECHO AS "?"'); *W( CONCAT('THE INPUT ABORT CHARACTER "',ESC,'" CAN BE.ENTER('PREFIXED[KEY TO DELETE LINE]', 47, 11); .ENTER('PREFIXED[KEY TO DELETE CHARACTER]', 47, 12); .ENTEields} .SCAL := NUMBER; .ENTER('VERTICAL MOVE DELAY', 34,8); {A number 0..255} *END; {SETUP2} *BEGIN {INITTREE} ,NEW(ROOTR('PREFIXED[EDITOR "ACCEPT" KEY]', 47, 13); *END; {SETUP1} * *PROCEDURE SETUP2; *BEGIN ,{Set up the integer fiel); ,WITH ROOT^ DO .BEGIN 0NAME := ''; 0NEW(RIGHT); .END; ,GROUND := ROOT^.RIGHT; ,NEW(SCALGROUND); ,NEW(NUMBER); ,CUTHEds} .PWIDTH := 16; .SCAL := NUMBER; .ENTER('SCREEN HEIGHT', 37,0); .ENTER('SCREEN WIDTH', 38,0); , ,{Set up the chaAP(''); ,NEW(CHARACTER); ,CUTHEAP(''); ,SETUP1; ,SETUP2; *END; {INITTREE} * %BEGIN {INITS} racter fields} .PWIDTH := 8; .SCAL := CHARACTER; .ENTER('LEAD-IN TO SCREEN', 31,0); .ENTER('MOVE CURSOR HOME''ASSERT(WIDTHMAX = BITINDMAX + 1,'INITS'); 'MARK(HEAP.PTR); 'DELTAWORD := HEAP.INT; 'NEW(HEAP.PTR); 'MARK(HEAP.PTR); 'DELT, 31,8); .ENTER('ERASE TO END OF SCREEN', 32,0); .ENTER('ERASE TO END OF LINE', 32,8); AWORD := HEAP.INT-DELTAWORD; 'FOR INDEX := STARTINDEX TO ENDINDEX DO )BUFFER[INDEX] := PSYSCOM^[INDEX]; 'ABORT := FALSE; 'IN.ENTER('MOVE CURSOR RIGHT', 33,0); .ENTER('MOVE CURSOR UP', 33,8); .ENTER('BACKSPACE', ITASCII; 'WRITE('INITIALIZING'); 'DOTCOUNT := 12; 'INITTREE; 'WRITELN; 'DEFRADIX := 10; %END; {INITS} % %FUNCTION GETCH: 34,0); .ENTER('ERASE LINE', 35,0); .ENTER('ERASE SCREEN', 35,8); .CHAR; 'FORWARD; % %FUNCTION CONTINUE:BOOLEAN; 'FORWARD; % %SEGMENT PROCEDURE TEACHSETUP; %VAR 'LINECNT: INTEGER; % *PRENTER('KEY TO MOVE CURSOR UP', 39,0); .ENTER('KEY TO MOVE CURSOR DOWN', 39,8); OCEDURE W(STR:STRING); *BEGIN ,WRITELN(STR); ,LINECNT := LINECNT + 1; ,IF LINECNT = 10 THEN .IF CONTINUE THEN 0LINECNT := .ENTER('KEY TO MOVE CURSOR LEFT', 40,0); .ENTER('KEY TO MOVE CURSOR RIGHT', 40,8); .ENTER('KEY TO END FILE',0 .ELSE /  { --> } EXIT ( TEACHSETUP ) ; * *END; % *PROCEDURE HASSLEGOTOXY; *BEGIN ,W(' IF YOU HAVE A VIDEO TERMINA 41,0); .ENTER('KEY FOR FLUSH', 41,8); .ENTER('KEY FOR BREAK', 42,0); L AND EXPECT TO USE'); ,W(' THE SCREEN ORIENTED EDITOR, THE CHANGES SETUP'); ,W(' CAN MAKE WILL BE INSUFFICIENT. YOU  '); ' ! !'); *W('------{DEFAULT}-----!------------------>(DIGIT)---->(CR)--'); *W(' ! ! !  ! ! !'); *W(' !-->("H"{HEX})----! !-->("-")--! !--(DIGIT)<-!'); *W(' ! !'); *W(' !->("D"{DECIMAL})-!'); *END; * *PROCEDURE PART5; *BEGIN *W('THE DEFAULT RADIX STARTS AS DECIMAL. NON-PRINTING CHARACTERS'); *W('MAY BE INPUT FROM THE KEYBOARD BY TYPING THE KEY WHICH GENERATES'); *W('THAT VALUE, FOLLOWED BY CARRIAGE RETURN OR IF THERE IS AN ASCII'); *W('MNEMONIC FOR THAT VALUE, JUST TYPE IT IN. MNEMONIC SCALAR VALUES'); *W('ARE INPUT BY TYPING IN THE MNEMONIC FOR THE VALUE DESIRED, E.G.'); *W('FOR BOOLEANS ONE MIGHT TYPE IN THE VALUE TRUE.'); *W('GIVING  TYPED IN') ); *W('RESPONSE TO MOST REQUESTS FOR INPUT AND WILL ESCAPE YOU'); *W('FROM THE SEQUENCE WHICH ASKED THE QUESTION.  FOR EXAMPLE,'); *W( CONCAT('WHEN CHANGING A VALUE, TYPING "',ESC,'" TO THE PROMPT') ); *W('"NEW VALUE" WILL ESCAPE THE SINGLE*W('ANGLE BRACKETS. FOR EXAMPLE, TYPING THE SEQUENCE OF CHARACTERS'); *W( CONCAT('CHARAQF',BS,BS,'CTER') ); *END; * *PROCED OR PROMPTED CHANGE'); *W('SEQUENCE WITHOUT CHANGING THE CURRENT FIELD''S VALUE.'); *END; * *PROCEDURE PART3; *BEGIN *W( CURE PART4; *BEGIN *W('WILL ECHO ON THE SCREEN THE SEQUENCE'); *W('CHARAQFCTER'); *W('AND WILL BE UNDERSTOOD AS THE STRINONCAT('THE LINE DELETE CHARACTER, "', ,DEL,'" ALLOWS YOU TO DELETE A') ); *W('RESPONSE YOU GAVE IF YOU HAVE NOT YET ENDED IT WG "CHARACTER"'); *W('FIELDS ARE EITHER NUMBERS, CHARACTERS OR MNEMONIC SCALARS.'); *W('WHEN YOU ACCESS A FIELD, YOU WILL BE SHITH CARRIAGE'); *W('RETURN. A CARRIAGE RETURN WILL BE SENT TO THE TERMINAL AND'); *W('YOU WILL BE ABLE TO START OVER ON THE NOWN ITS CURRENT'); *W('VALUE. NUMBERS ARE GIVEN IN OCTAL, DECIMAL OR HEXADECIMAL'); *W('RADIX, CHARACTERS ARE GIVEN AS THEIR EW LINE. THE BACKSPACE'); *W( CONCAT('CHARACTER, "',BS, ,'" WILL DELETE YOUR RESPONSE TO A QUESTION') ); ASCII VALUE AS NUMBERS'); *W('AND AS THEIR ASCII MNEMONIC SYMBOL. SCALAR VALUES ARE'); *W('SHOWN BY GIVING THE MNEMONIC FOR T*W('CHARACTER BY CHARACTER, ECHOING EACH CHARACTER AS IT IS'); *W('DELETED. THE ECHOED DELETED CHARACTERS WILL BE ENCLOSED INHE CURRENT VALUE.'); *W('ENTER NUMBERS OR INTEGERS AS CHARACTERS ACCORDING TO THE FORMAT:'); *W(' !-->("O"{OCTAL})--!'); *W( +WRITELN('PLEASE WRITE DOWN THIS NUMBER AND ANY'); +WRITELN('SUPPORTING DETAILS YOU CAN, AND REPORT'); +WRITELN('IT TO THE UCctually a dummy entry which is smaller %* than all entries. This allows TRAIL to be set even in an empty tree %} %VAR 'TEMPSD SUPPORT STAFF AT YOUR'); +WRITELN('EARLIEST CONVENIENCE'); % %{ ---> } EXIT ( SETUP ) ; ) )END; %END; % %FUNCTION GET:STRING; %BEGIN 'GROUND^.NAME := KEY; 'TREEPTR := ROOT; 'TEMP := ''; 'WHILE TEMP <> KEY DO )BEGIN +TRAIL := TREEPTR; +IFCH{:CHAR}; %BEGIN 'READ(KEYBOARD,CH); 'IF EOLN(KEYBOARD) THEN )CH := CHR(13) 'ELSE IF CH IN ['a'..'z'] THEN )CH := CHR( OR TEMP>KEY THEN -TREEPTR := TREEPTR^.LEFT +ELSE -TREEPTR := TREEPTR^.RIGHT; +DESPACE(TEMP,TREEPTR^.NAME); )END; D(CH) - ORD('a') + ORD('A') ); 'IF CH = ESC THEN )ABORT := TRUE; 'GETCH := CH; %END; % %FUNCTION GETSTR(VAR STR:STRING):BO'TREESEARCH := TREEPTR <> GROUND; %END; % %PROCEDURE DESPACE{VAR TEMP:STRING;VAR STR:STRING}; %VAR 'INDEX:INTEGER; %BEGINOLEAN; %VAR 'BACKSPACEING:BOOLEAN; %BEGIN 'GETSTR := TRUE; 'BACKSPACEING := FALSE; 'STR := ''; 'WHILE NOT (GETCH IN [CHR( 'TEMP := STR;  {$R-} 'INDEX := SCAN(ORD(TEMP[0]),=' ',TEMP[1]); 'WHILE INDEX <> ORD(TEMP[0]) DO )BEGIN +MOVELEFT(TEMP[IND13),ESC]) DO )BEGIN +IF (CH <> BS) AND BACKSPACEING THEN -BEGIN /BACKSPACEING := FALSE; /WRITE('>'); -END; +IF CH = DEL TEX+2],TEMP[INDEX+1],ORD(TEMP[0])-INDEX); +TEMP[0] := PRED(TEMP[0]); +INDEX := SCAN(ORD(TEMP[0])-INDEX+1,=' ',TEMP[INDEX]) + INHEN -BEGIN /STR := ''; /WRITELN('<>'); -END +ELSE IF CH = BS THEN -BEGIN /IF LENGTH(STR) > 0 THEN 1BEGIN 3IF NOT BDEX - 1; )END; {$R+} %END;  %PROCEDURE QUIT; %VAR 'INDEX: INDEXRANGE; 'OUTFILE:FILE OF MISCINFOREC; %BEGIN 'REPEAT )WACKSPACEING THEN 5WRITE('<'); 3BACKSPACEING := TRUE; 3IF STR[LENGTH(STR)] IN [' '..'}'] THEN 5WRITE(STR[LENGTH(STR)]) RITELN('QUIT: D(ISK) OR M(EMORY) UPDATE, R(ETURN) H(ELP) E(XIT)'); )CASE GETCH OF +'D': BEGIN 2REWRITE(OUTFILE,NEWINFO); 2OU3ELSE 5WRITE('?'); 3DELETE(STR,LENGTH(STR),1); 1END; -END +ELSE -BEGIN /IF CH IN [' '..'}'] THEN 1WRITE(CH) /ELSE 1WRTFILE^ := BUFFER; 2PUT(OUTFILE); 2CLOSE(OUTFILE,LOCK); 0END; +'M': FOR INDEX := STARTINDEX TO ENDINDEX DO 2PSYSCOM^[INDEX] AN ILLEGAL VALUE WILL CAUSE LISTING OF ALL POSSIBLE'); *W('VALUES. IF YOU FORGET THE NAME OF THE FIELD YOU WISH TO C(HANGE)'); ITE('?'); /STR := CONCAT(STR,'#'); /STR[LENGTH(STR)] := CH; -END; )END; 'IF CH = ESC THEN )GETSTR := FALSE; 'WRITELN; 'D*W('YOU CAN ASK TO BE PROMPTED WITH THE NAMES OF ALL THE FIELDS.'); *W('FOR MORE INFORMATION PLEASE SEE THE SYSTEM DOCUMENTATIESPACE(STR,STR); 'IF LENGTH(STR) = 0 THEN )GETSTR := FALSE; %END; % %FUNCTION TREESEARCH{KEY:STRING):BOOLEAN}; %{ %* ThisON.'); *END; % %BEGIN {TEACHSETUP} % LINECNT := 0; 'HASSLEGOTOXY; 'PART1; 'PART2; 'PART3; 'PART4; 'PART5; %END; %  procedure finds the node with NAME=KEY in the tree with root ROOT %* and sets TREEPTR pointing to that node and TRAIL pointing% %PROCEDURE ASSERT{B:BOOLEAN;NUM:STRING}; %BEGIN 'IF NOT B THEN )BEGIN +WRITELN('BUG NUMBER ',NUM);  to that node's %* parent. Note that all nodes must have their links initialized to the %* sentinel GROUND and that ROOT is a NFO"'); 1WRITELN('M(EMORY) UPDATE CHANGES THE SETUP IN MEMORY '); 1WRITELN(' UNTIL THE NEXT SYSTEM INITIALIZATION'); :8); ,IF ISCHAR THEN .BEGIN /IF ORDCHAR < 33 THEN 1WRITE(LOWASCII[ORDCHAR],' ':9+3-LENGTH(LOWASCII[ORDCHAR])) /ELSE IF ORDC1WRITELN('R(ETURN) TAKES YOU BACK INTO SETUP '); 1WRITELN(' IF YOU''RE NOT DONE'); 1WRITELN('E(XIT) TERMINATES THIS PROGHAR = 127 THEN 1WRITE('DEL',' ':9) /ELSE IF CHR(ORDCHAR) IN ['!'..'}'] THEN 1WRITE(CHR(ORDCHAR),' ':11); /IF ORDCHAR < 32 THRAM'); /END; +'E': + %{ --> } EXIT ( SETUP ) ; - )END; 'UNTIL (CH = 'R') OR ABORT; %END; % %FUNCTION CONTINUE{:BOOLEAEN 1WRITE('^',CHR( ORDCHAR + ORD('@') )); -END; +WRITELN; )END; %END; % %FUNCTION GETORDSTR 2(VAR ORDCHAR:INTEGER;ISCHARN}; %BEGIN 'REPEAT )WRITELN(' C(ONTINUE) Q(UIT)'); 'UNTIL GETCH IN ['C','Q']; 'CONTINUE := CH = 'C'; %END; :BOOLEAN;LOW,HIGH:INTEGER):BOOLEAN; %VAR 'VALID,NEGATE:BOOLEAN; 'INDEX:1..255; 'ORDCH:0..255; 'DIGIT:0..16; % %PROCEDURE SHOWFULL(ORDCHAR:INTEGER;ISCHAR:BOOLEAN); %TYPE 'MANYRADIX = RECORD 5CASE RADIX:INTEGER OF 78:(OCT:PACKED ARRA'RADIX:8..16; 'OKCHS:SET OF CHAR; 'NUMSTR:STRING; %BEGIN 'VALID := TRUE; {INITIAL ASSUMPTION} 'WRITE('NEW VALUE: '); 'IFY[0..4] OF 0..7); 610:(INT:INTEGER); 616:(HEX:PACKED ARRAY[0..3] OF 0..15) 2END;{CASERECORD} %VAR 'CH:CHAR; 'I:INTEGER; ' NOT GETSTR(NUMSTR) THEN )VALID := FALSE 'ELSE )IF (LENGTH(NUMSTR) = 1) AND ISCHAR AND JNOT (NUMSTR[1] IN ['0'..'9']) THEN TRIX:MANYRADIX; %BEGIN 'WITH TRIX DO )BEGIN +INT := ORDCHAR; +WRITE('OCTAL DECIMAL HEXADECIMAL '); +IF ISCHAR TH+ORDCHAR := ORD(NUMSTR[1]) )ELSE +BEGIN -IF ISCHAR AND (LENGTH(NUMSTR)<=3) THEN /BEGIN 1LOWASCIIS[33] := NUMSTR; 1ORDCH :EN -BEGIN /IF ORDCHAR < 128 THEN 1WRITE('ASCII',' ':7); /IF ORDCHAR < 32 THEN 1WRITE('CONTROL'); -END; +WRITELN; +{WRITE= 0; 1WHILE NUMSTR <> LOWASCIIS[ORDCH] DO 3ORDCH := SUCC(ORDCH); 1IF NUMSTR = 'DEL' THEN 3ORDCH := 127; /END; -IF ISCHAR A THE OCTAL VALUE, RIGHT JUSTIFIED} -I := 4; -IF INT<0 THEN /WRITE('1') -ELSE /BEGIN 1WRITE(' '); ND (ORDCH <> 33) AND (LENGTH(NUMSTR) <= 3) THEN /ORDCHAR := ORDCH -ELSE /BEGIN 1IF NOT (NUMSTR[1] IN ['D','O','H']) THEN 3R1WHILE (OCT[I] = 0) AND (I>0) DO 3BEGIN 5I := I - 1; 5WRITE(' '); 3END; /END; -WHILE I >= 0 DO /BEGIN 1WRITE(OCT[I]); ADIX := DEFRADIX 1ELSE 3BEGIN 5CASE NUMSTR[1] OF 7'O':RADIX := 8; 7'D':RADIX := 10; 7'H':RADIX := 16 5END;{CASE} 5DELETE1I := I - 1; /END; -WRITE(' ':6); +{WRITE THE DECIMAL VALUE RIGHT JUSTIFIED} -WRITE(INT:6,' ':6); +{WRITE THE HEXADECIMAL V(NUMSTR,1,1); 3END; 1IF NUMSTR[1] = '-' THEN 3BEGIN 5NEGATE := TRUE; 5DELETE(NUMSTR,1,1); 3END 1ELSE 3NEGATE := FALSE; ALUE RIGHT JUSTIFIED} -I := 3; -WHILE (HEX[I] = 0) AND (I > 0) DO /BEGIN 1I := I - 1; 1WRITE(' '); /END; ,WHILE I >= 0 DO1CASE RADIX OF 38: OKCHS := ['0'..'7']; 310: OKCHS := ['0'..'9']; 316: OKCHS := ['0'..'9','A'..'F'] 1END;{CASE} := BUFFER[INDEX]; +'H':BEGIN 1WRITELN('D(ISK) UPDATE PUTS THE CURRENT SETUP ON DISK '); 1WRITELN(' AS THE FILE "NEW.MISCI .BEGIN 0IF HEX[I] < 10 THEN 2WRITE(HEX[I]) 0ELSE 2WRITE( CHR( HEX[I] - 10 + ORD('A') ) ); 0I := I - 1; .END; ,WRITE(' ' R IF YOUR KEYBOARD CAN GENERATE THE VALUE YOU WANT'); +WRITELN('JUST TYPE THE KEY AND THEN TYPE CARRIAGE RETURN'); +WRITELN('O6I,NUM:INTEGER; 4BEGIN 6NUM := 1; 6FOR I := 1 TO VAL DO 8NUM := NUM*2; 6ALOG2 := NUM; 4END; / /BEGIN {NUMBERCHANGE} 1IR TYPE THE ASCII MNEMONIC FOR THE CHARACTER'); )END; 'WRITELN('C(ONTINUE)'); 'REPEAT 'UNTIL GETCH = 'C'; %END; % %PROCEDUF PTR^.WIDTH = 16 THEN 3BEGIN 5LOW := -32767-1; 5HIGH := 32767; 3END 1ELSE 3BEGIN 5LOW := 0; 5HIGH := ALOG2(PTR^.WIDTH)-1IF LENGTH(NUMSTR) = 0 THEN 3VALID := FALSE 1ELSE 3FOR INDEX := 1 TO LENGTH(NUMSTR) DO 5IF NOT (NUMSTR[INDEX] IN OKCHS) THERE CHANGE; % *FUNCTION DOYOU:BOOLEAN; *BEGIN ,IF NOT ABORT THEN .REPEAT 0WRITELN('DO YOU WISH TO CHANGE THIS FIELD?', 8' N 7VALID := FALSE; 1IF VALID THEN 3BEGIN 5ORDCHAR := 0; 5INDEX := 1; 5IF NUMSTR[INDEX] IN ['0'..'9'] THEN 7DIGIT := ORD(N("Y","N" OR "',ESC,'")'); 0DOYOU := GETCH = 'Y'; .UNTIL (CH IN ['Y','N']) OR ABORT ,ELSE .DOYOU := FALSE; *END; % *PROCEDUMSTR[INDEX]) - ORD('0') 5ELSE 7DIGIT := ORD(NUMSTR[INDEX]) - ORD('A') + 10; 5REPEAT 7ORDCHAR := ORDCHAR * RADIX + DIGIT; 7URE NEWRADIX; * /PROCEDURE SHOWRADIX; /BEGIN 1CASE DEFRADIX OF 48: WRITE('NOW OCTAL'); 310: WRITE('NOW DECIMAL'); INDEX := INDEX + 1; 7IF INDEX <= LENGTH(NUMSTR) THEN 9IF NUMSTR[INDEX] IN ['0'..'9'] THEN ;DIGIT := ORD(NUMSTR[INDEX]) - ORD(316: WRITE('NOW HEXADECIMAL') 1END; /END; * *BEGIN {NEWRADIX} ,REPEAT .SHOWRADIX; .WRITELN(': O(CTAL) D(ECIMAL) H(EXADE'0') 9ELSE ;DIGIT := ORD(NUMSTR[INDEX]) - ORD('A') + 10; 5UNTIL (INDEX > LENGTH(NUMSTR)) FOR (ORDCHAR > (MAXINT - DIGIT) DIVCIMAL) Q(UIT)'); .CASE GETCH OF 0'O': DEFRADIX := 8; 0'D': DEFRADIX := 10; 0'H': DEFRADIX := 16; .END; ,UNTIL (CH IN [' RADIX); 5VALID := INDEX > LENGTH(NUMSTR); 5IF NEGATE THEN 7ORDCHAR := - ORDCHAR; 3END; /END; +END; 'GETORDSTR := VALID AO','D','H','Q']) OR ABORT; ,SHOWRADIX; ,WRITELN; *END; % *PROCEDURE DOIT(PTR:TREE); * /PROCEDURE GETVAL(VAR VAL:INTEGER);ND (ORDCHAR >= LOW) AND (ORDCHAR<=HIGH); %END; {GETORDSTR} ) %PROCEDURE NUMTEACH(ISCHAR:BOOLEAN;LOW,HIGH:INTEGER); %VAR 'CH /VAR 1BIT:INTEGER; /BEGIN 1VAL := 0; 1WITH PTR^ DO 3FOR BIT := BITINDEX + WIDTH - 1 DOWNTO BITINDEX DO 5VAL := VAL + VAL: CHAR; %BEGIN 'WRITELN('INPUT VALUES IN THE DECIMAL RANGE ',LOW,'..',HIGH); 'WRITELN('IN THE FORMAT BELOW:');  + BUFFER[WORDINDEX][BIT]; /END; / /PROCEDURE UPDATE(VAL:INTEGER); /VAR 1BIT:INTEGER; /BEGIN 1WITH PTR^ DO 3BEGIN 5IF V'WRITELN(' !-->("O"{OCTAL})--!'); 'WRITELN(' ! !'); 'WRITELN('------{DEFAULT}-----!------------------>(DIGIAL < 0 THEN 7BEGIN 9BUFFER[WORDINDEX][BITINDEX + WIDTH - 1] := 1; 9VAL := -VAL; 7END; 5FOR BIT := BITINDEX TO BITINDEX + WIT)---->(CR)--'); 'WRITELN(' ! ! ! ! ! !'); 'WRITELN(' !-->("H"{HEX})----! !-->("-")--!DTH - 1 DO 7BEGIN 9BUFFER[WORDINDEX][BIT] := VAL MOD 2; 9VAL := VAL DIV 2; 7END; 3END; /END; / /PROCEDURE NUMBERCHANGE(I !--(DIGIT)<-!'); 'WRITELN(' ! !'); 'WRITELN(' !->("D"{DECIMAL})-!'); 'IF ISCHAR THEN )BEGIN +WRITELN('OSCHAR:BOOLEAN); /VAR 1NUMBER,LOW,HIGH:INTEGER; 1NUMSTR:STRING; / 4FUNCTION ALOG2(VAL:INTEGER):INTEGER; 4VAR  BORT; 5IF NOT ABORT THEN 7UPDATE(NUMBER); 3END /END; / /PROCEDURE SCALARCHANGE; /VAR 1NUMBER:INTEGER; 1SCALSTR:STRING; IN 4WRITELN('DIDN''T FIND ',NAME); 4WRITE('NAME OF FIELD: '); 4IF GETSTR(NAME) THEN; 2END; 0IF NOT ABORT THEN / 4PROCEDURE SHOWSCALAR(NUMBER:INTEGER); 4VAR 6SCAL:SCALARS; 4BEGIN 6SCAL := PTR^.VALNAMES; 6ASSERT(SCAL<>SCALGROUND,'SHO2DOIT(TREEPTR); .END; *END; * *PROCEDURE PROMPTED(ROOT:TREE); *BEGIN ,IF (ROOT <> GROUND) AND NOT ABORT THEN .BEGIN 0PRWSCALAR'); 6WHILE NUMBER <> SCAL^.VAL DO 8BEGIN :SCAL := SCAL^.LINK; :ASSERT(SCAL<>SCALGROUND,'SHOWSCALAR'); 8END; 6WRITELOMPTED(ROOT^.LEFT); 0IF NOT ABORT THEN 2BEGIN 4WRITELN; 4WRITELN('FIELD NAME = ',ROOT^.NAME); 4DOIT(ROOT); 4PROMPTED(ROOT^N('CURRENT VALUE IS ',SCAL^.NAME); 4END; 4 4PROCEDURE SHOWALL; 4VAR 6SCAL:SCALARS; 4BEGIN 6SCAL := PTR^.VALNAMES; 6WRITE.RIGHT); 2END; .END; *END; % %BEGIN {CHANGE} 'REPEAT )ABORT := FALSE; )WRITELN('CHANGE: S(INGLE) P(ROMPTED) R(ADIX) H(ELLN('ALLOWED VALUES ARE:'); 6REPEAT 8ASSERT(SCAL<>SCALGROUND,'SHOWALL'); 8WRITELN(SCAL^.NAME); 8SCAL := SCAL^.LINK; 6UNTIL SP) Q(UIT)'); )CASE GETCH OF +'S': SINGLE; +'P': PROMPTED(ROOT^.RIGHT); +'R': NEWRADIX; +'H': BEGIN 2WRITELN('S(INGLE) ALLO1; 3END; 1GETVAL(NUMBER); CAL = SCALGROUND; 4END; 4 4FUNCTION GETSCALVAL(VAR NUM:INTEGER;STR:STRING):BOOLEAN; 4VAR 6SCAL:SCALARS; 4BEGIN 6SCAL := PTR^.VALNAMES; 6SCALGROUND^.NAME := STR; 6WHILE SCAL^.NAME<>STR DO 8SCAL := SCAL^.LINK; 6NUMBER := SCAL^.VAL; 6GETSCALVAL := SCAL<>SCALGROUND; 4END; / /BEGIN {SCALARCHANGE} 1GETVAL(NUMBER); 1SHOWSCALAR(NUMBER); 1IF DOYOU THEN 3REPEAT 5WRITE('NEW VALUE: '); 5IF GETSTR(SCALSTR) THEN 7BEGIN 9WHILE NOT (GETSCALVAL(NUMBER,SCALSTR) OR ABORT) DO ;BEGIN =SHOWALL; =WRITE('NEW VALUE: '); =IF GETSTR(SCALSTR) THEN; ;END; 7END; 3UNTIL NOT DOYOU OR ABORT; 3IF NOT ABORT AND (SCALSTR<>'') THEN 5UPDATE(NUMBER); /END; {SCALARCHANGE} * *BEGIN {DOIT} ,WITH PTR^ DO .IF VALNAMES = CHARACTER THEN 0NUMBERCHANGE(TRUE1SHOWFULL(NUMBER,ISCHAR); 1IF DOYOU THEN 3BEGIN 5REPEAT 7WHILE NOT GETORDSTR(NUMBER,ISCHAR,LOW,HIGH) `AND NOT ABORT DO 9N) .ELSE IF VALNAMES = NUMBER THEN 0NUMBERCHANGE(FALSE) .ELSE 0SCALARCHANGE; *END; {DOIT} * *PROCEDURE SINGLE; *VAR ,NAMUMTEACH(ISCHAR,LOW,HIGH); 7IF NOT ABORT THEN 9BEGIN ;SHOWFULL(NUMBER,ISCHAR); ;IF DOYOU THEN; 9END; 5UNTIL (CH = 'N') OR AE:STRING; *BEGIN ,WRITE('NAME OF FIELD: '); ,IF GETSTR(NAME) THEN .BEGIN 0WHILE NOT TREESEARCH(NAME) AND NOT ABORT DO 2BEG T; &'T': TEACHSETUP; &'H': BEGIN .WRITELN('C(HANGE) ALLOWS YOU TO CHANGE OR EXAMINE'); .WRITELN(' THE VARIOUS PIECES OF INFORMATION THE'); .WRITELN(' SYSTEM HAS ABOUT YOUR HARDWARE CONFIGURATION'); .WRITELN('T(EACH) TEACHES YOU HOW TO USE THIS PROGRAM'); .WRITELN('Q(UIT) ALLOWS YOU TO MAKE YOUR CHANGES PERMANENT'); .WRITELN(' AND TO LEAVE THIS PROGRAM'); ,END FUNCTION MIN(A, B: INTEGER): INTEGER; BEGIN IF A < B THEN MIN := A ELSE MIN := B END; PROCEDURE PUTCURSOR(LINE, COLUMN: IN; $END;{CASE} "UNTIL FALSE;  END;   BEGIN "{OPERATING SYSTEM}  END.  TEGER); BEGIN FGOTOXY(COLUMN, LINE); END; (* procedure put_cursor *) PROCEDURE CLEARLINE(LINE: INTEGER); BEGIN PUTCURSOR(LINE, 0); WITH SYSCOM^.CRTCTRL DO WRITE(OUTPUT, ESCAPE, ERASEEOL); END; (* procedure clear_line *) PROCEDURE CLEARTHISLINE; BEGIN WITH SYSCOM^.CRTCTRL DO WRITELN(OUTPUT, ESCAPE, ERASEEOL) END; (* procedure clear_this_line *) PROCEDURE MESSAGE(MES: STRING); BEGIN CLEARLINE(BUGCOM^.COMLINE); WRITE(OUTPUT, MES) END; PROCEDURE PROMPT(PL: STRING); BEGIN CLEARLINE(PROMPTLIO^NE+1); CLEARLINE(PROMPTLINE); WRITE(OUTPUT,PL) END; PROCEDURE SHOWNEXTLINE(INDICATOR: CHAR); BEGIN PUTCURSOR(BUGCOM^.DATAPLAWS YOU TO EXAMINE 1 VALUE BY NAME'); 2WRITELN('P(ROMPTED) TAKES YOU THROUGH ALL FIELDS'); 2WRITELN('R(ADIX) ALLOWS YOU TO CHANGE THE ASSUMED RADIX'); 2WRITE(' FROM '); 2CASE DEFRADIX OF 48:WRITE('OCTAL'); 410:WRITE('DECIMAL'); 416:WRITE('HEXADECIMAL') 2END;{CASE} 2WRITE(' TO EITHER '); 2CASE DEFRADIX OF 48: WRITE('DECIMAL OR HEXADECIMAL'); 410:WRITE('OCTAL OR HEXADECIMAL'); 416:WRITE('OCTAL OR DECIMAL'); 2END;{CASE} 2WRITELN; + END; )END; 'UNTIL CH = 'Q'; %END; {CHANGE} %  BEGIN {MAIN} "INITS; "REPEAT $WRITELN('SETUP: C(HANGE) T(EACH) H(ELP) Q(UIT)'); $CASE GETCH OF &'C': CHANGE; &'Q': QUI PROCEDURE DISPLYINFO; VAR DATASZ, PARMSZ, STACKSZ, IPC, PARENTNUM, PARENTSEG, CALLER, CALLSEG: INTEGER; TPPROCINFO,  PUTCURSOR(INFOLINE+2,0); WRITE(OUTPUT, 'Brkpnts: '); N := 0; FOR I := 0 TO 3 DO IF SYSCOM^.BRKPTS[I] > -1 THEN TPLINKINFO: DMSCWP; BEGIN (* Info about current proc *) PROCNUM := PPROCINFO^.MSJTAB^[JTABPROCANDLL].BYTEVAL[LOBYTE]; SEGNBEGIN WRITE(OUTPUT, SYSCOM^.BRKPTS[I]:6); N := N+1 END; WRITE(OUTPUT, ' ': 6*(4-N)) END; (* procedure disply_brk_pts *) PROCUM := PPROCINFO^.MSSEG^.BYTEVAL[LOBYTE]; (* Info about parent *) TPLINKINFO := PLINKINFO^.MSSTAT; TPPROCINFO := PPROCINFOEDURE DISPLYHEADING; BEGIN PUTCURSOR(HEADINGLINE, 0); WRITE(OUTPUT, ; WHILE TPPROCINFO^.MSDYN <> TPLINKINFO DO TPPROCINFO := TPPROCINFO^.MSDYN; PARENTNUM := TPPROCINFO^.MSJTAB^[JTABPROCAND'ID TYPE PROC# OFFSET ADDR INTEGER OCTAL HEX LO HI CHAR'); END; (* procedure disply_heading *) PROCEDURE DLL].BYTEVAL[LOBYTE]; PARENTSEG := TPPROCINFO^.MSSEG^.BYTEVAL[LOBYTE]; (* Info about caller *) CALLER := PLINKINFO^.MSJTABISPLYMEM(WHAT: MEMTYPE; ADDR: INTEGER); VAR I: INTEGER; OUTSTRING: PACKED ARRAY [0..27] OF CHAR; TRICKSTUFF: MEMTYPE; ADDR^[JTABPROCANDLL].BYTEVAL[LOBYTE]; CALLSEG := PLINKINFO^.MSSEG^.BYTEVAL[LOBYTE]; (* More info on current proc *) STACKSZ :STRING: PACKED ARRAY [0..8] OF CHAR; BEGIN WITH TRICKSTUFF, OCTVAL DO BEGIN INTVAL := ADDR; FILLCHAR(ADDRSTRIN= (ORD(PLINKINFO)-ORD(PPROCINFO^.MSSP)) DIV WORDSZ; DATASZ := (PPROCINFO^.MSJTAB^[JTABDATASZ].INTVAL) DIV 2; PARMSZ := (PPROG, 3, ' '); ADDRSTRING[3] := CHR(FIRSTDIGIT+ORD0); ADDRSTRING[4] := CHR(FD0+ORD0); ADDRSTRING[5] := CHR(FD1+ORCINFO^.MSJTAB^[JTABPARMSZ].INTVAL) DIV 2; IPC := PPROCINFO^.MSIPC - (ORD(PPROCINFO^.MSJTAB)+WORDSZ*JTABENTRIC D0); ADDRSTRING[6] := CHR(FD2+ORD0); ADDRSTRING[7] := CHR(FD3+ORD0); ADDRSTRING[8] := CHR(FD4+ORD0); END;  -PPROCINFO^.MSJTAB^[JTABENTRIC].INTVAL); PUTCURSOR(INFOLINE, 0); WRITELN(OUTPUT, 'Proc', PROCNUM: 4, ' Caller', CALLER: WITH WHAT DO BEGIN WRITE(OUTPUT, ADDRSTRING, INTVAL: 9); FILLCHAR(OUTSTRING, 28, ' '); WITH OCTVAL DO B 4, ' Parent', PARENTNUM: 4, ' Param', PARMSZ: 4, ' Data', DATASZ: 6); WRITELN(OUTPUT, ' Seg', SEGNUM: 4, ' EGIN OUTSTRING[2] := CHR(FIRSTDIGIT+ORD0); OUTSTRING[3] := CHR(FD0+ORD0); OUTSTRING[4] := CHR(FD1+ORD0); OUTSTRING[5 Seg', CALLSEG: 4, ' Seg', PARENTSEG: 4, ' Stack', STACKSZ: 4, ' IPC', IPC: 6, ' Depth', LINKLEVE] := CHR(FD2+ORD0); OUTSTRING[6] := CHR(FD3+ORD0); OUTSTRING[7] := CHR(FD4+ORD0); END; FOR I := 0 TO 3 DO CE, 8); WRITE(OUTPUT, INDICATOR) END; PROCEDURE NEXTLINE(VAR CURRLINE: INTEGER); BEGIN IF CURRLINE = BUGCOM^.LASTDATALINE TL: 3); PUTCURSOR(INFOLINE+2, LINKCOLUMN); WRITE(OUTPUT, 'Defaultlink: '); IF LINKDEFAULT = DYNAMIC THEN WRITE(OUTPUT, 'DynHEN BEGIN CURRLINE := FIRSTDATALINE; PUTCURSOR(CURRLINE, 0) END ELSE CURRLINE := CURRLINE + 1 END; amic') ELSE WRITE(OUTPUT, 'Static'); END; (* procedure disply_info *) PROCEDURE DISPLYBRKPTS; VAR I, N: INTEGER; BEGIN  IN S[I] := CH; ZAP := FALSE END; N := N MOD DIVBY; DIVBY := DIVBY DIV 10 END; END; (* procedure int_to_pac *) BEGIN line found in page *) END; (* IF line is in listfile *) END; (*WITH BUGCOM*) END; (* procedure write_list_line *) PROCEDU IF HEXVAL[I] < 10 THEN OUTSTRING[13-I] := CHR(HEXVAL[I]+ORD0) ELSE OUTSTRING[13-I] := CHR(HEXVAL[I]-10+ORD('A')); WITH B LINENUM := SYSCOM^.HLTLINE; "WITH BUGCOM^ DO BEGIN (* Get page number line is on *) PAGENUM := 1; WHILE YTEOCTVAL DO BEGIN OUTSTRING[16] := CHR(LD0+ORD0); OUTSTRING[17] := CHR(LD1+ORD0); OUTSTRING[18] := CHR(LD2+ORD0); LINENUM > PAGETABLE^[PAGENUM, 1] DO (PAGENUM := PAGENUM+1; &IF LINENUM < PAGETABLE^[PAGENUM, 0] THEN WRITEOFFSET ELSE BOUTSTRING[20] := CHR(HD0+ORD0); OUTSTRING[21] := CHR(HD1+ORD0); OUTSTRING[22] := CHR(HD2+ORD0); END; FOR I := 0 TO EGIN *IF CURRPAGE <> PAGENUM THEN BEGIN IF NOT LISTOPEN THEN BEGIN OPENOLD(LISTFILE, '*SYSTEM.LST.TEXT'); 1 DO IF CHARVAL[I] IN [' '..'~', CHR(160)..CHR(254)] THEN OUTSTRING[26+I] := CHARVAL[I] ELSE OUTSTRING[26+I] := SYSCOM^.CRT LISTOPEN := TRUE END; IF BLOCKREAD(LISTFILE, PAGEBUFF, 2, 2*PAGENUM)=2 THEN; CURRPAGE := PAGENUM END; INFO.BADCH; WRITELN(OUTPUT, OUTSTRING); END END; (* procedure disply_mem *) PROCEDURE WRITEOFFSET; VAR IPC, SEG, P (* Get to line within page *) INTTOPAC(LINENUM, S); *BEGINPOS := 0; FOUND := FALSE; WHILE (NOT FOUND) AND (BEGINPOS <=ROC: INTEGER; BEGIN PROC := PPROCINFO^.MSJTAB^[JTABPROCANDLL].BYTEVAL[LOBYTE]; SEG := PPROCINFO^.MSSEG^.BYTEVAL[LOBYTE];  1000) DO BEGIN I := 5; FOUND := TRUE; WHILE FOUND AND (I >= 1) DO IF S[I] <> PAGEBUFF[BEGINPOS+I] THEN FO IPC := PPROCINFO^.MSIPC - (ORD(PPROCINFO^.MSJTAB) +WORDSZ*JTABENTRIC-PPROCINFO^.MSJTAB^[JTABENTRIC].INTVAL); WRITE(OUND := FALSE ELSE I := I-1; .IF NOT FOUND THEN BEGIN BEGINPOS := BEGINPOS + SCAN(1024-BEGINPOS, =CHR(ORDCR), PAUTPUT, 'Line:', SYSCOM^.HLTLINE:5); IF SEG <> 1 THEN WRITE(OUTPUT, ' Seg:', SEG:3); GEBUFF[BEGINPOS]) +1; END END; (* WHILE *) IF NOT FOUND THEN WRITEOFFSET ELSE BEGIN (* Get number  WRITE(OUTPUT, ' Proc:', PROC: 4, ' Offset:', IPC:4); END; (* procedure write_offset *) PROCEDURE WRITELISTLINE; TYPE of chars in this line *) LINELEN := 24; I := BEGINPOS+24; WHILE (PAGEBUFF[I] <> CHR(ORDCR)) AND (LINELEN PACINT = PACKED ARRAY [1..5] OF CHAR; VAR PAGENUM, I, BEGINPOS, LINELEN, LINENUM: INTEGER; FOUND: BOOLEAN; S: PACINT; PR< SYSCOM^.CRTINFO.WIDTH-16) DO IF PAGEBUFF[I] = CHR(DLE) (* blank commpression *) THEN BEGIN LINELEN := LINELEN + OOCEDURE INTTOPAC(N: INTEGER; VAR S: PACINT); VAR I, DIVBY: INTEGER; ZAP: BOOLEAN; CH: CHAR; BEGIN DIVBY := 10000; ZAPRD(PAGEBUFF[I+1])-32; I := I+2 END ELSE BEGIN LINELEN := LINELEN+1; I := I+1 END;  := TRUE; FOR I := 1 TO 5 DO BEGIN CH := CHR(N DIV DIVBY + ORD0); IF ZAP AND (CH = '0') THEN S[I] := ' ' ELSE BEG IF PAGEBUFF[I-2] = CHR(16) THEN I := I-2 ELSE I := I-1; UNITWRITE(1, PAGEBUFF[BEGINPOS], LINELEN) END (* IF   PLINKINFO := PPROCINFO^.MSDYN; FOUND := (PPROCINFO^.MSJTAB^[JTABPROCANDLL].BYTEVAL[LOBYTE] = PROCNUM) AND (PPROCINFO^.MS TRICKSTUFF.INTVAL := HEAPPOINTER; DISPLYMEM(TRICKSTUFF.PTVAL^, HEAPPOINTER) END END; (*CASE*) END; (*WITH*SEG^.BYTEVAL[LOBYTE] = SEGNUM); WHILE (NOT FOUND) AND (PLINKINFO^.MSDYN <> PLINKINFO) DO BEGIN LEVELSUP := LEVELSUP ) SHOWNEXTLINE('*'); END; (* procedure update *) FUNCTION READINTSTRING(VAR S: NUMSTRING): BOOLEAN; VAR OK: BOOLEAN; CH: + 1; PPROCINFO := PLINKINFO; PLINKINFO := PPROCINFO^.MSDYN; FOUND := (PPROCINFO^.MSJTAB^[JTABPROCANDLL].BYTEVACHAR; BEGIN REPEAT READ(KEYBOARD,CH) UNTIL (CH<>' ') OR EOLN(KEYBOARD); S := ''; OK := TRUE; WHILE (CH<>' ') AND NOT EOL[LOBYTE] = PROCNUM) AND (PPROCINFO^.MSSEG^.BYTEVAL[LOBYTE] = SEGNUM); END; FINDPROC := FOUND; END; (* function fiLN(KEYBOARD) AND OK DO BEGIN IF CH IN DIGITS THEN BEGIN WRITE(OUTPUT,CH); IF LENGTH(S) < 6 THEN (* tack on anotRE DISPLYSYSERROR; VAR MSGNUM: INTEGER; MSG: STRING; BEGIN MSGNUM := 0; CASE SYSCOM^.XEQERR OF 1: MESSAGE('Subrange limnd_proc *) PROCEDURE UPDATE; VAR I, J, JUNK: INTEGER; TRICKSTUFF: MEMTYPE; TPPROCINFO, TPLINKINFO: DMSCWP; BEGIN its exceeded'); 2: MESSAGE('Segment not linked in'); 3: MESSAGE('Exitting from procedure never called'); 5: MESSA CLEARSCREEN; DISPLYSYSERROR; DISPLYINFO; DISPLYBRKPTS; DISPLYHEADING; PUTCURSOR(FIRSTDATALINE, 0); FOR I := FIRSTDGE('Integer overflow'); 6: MESSAGE('Integer divide by zero'); 7: MESSAGE('Attempted access to a nil pointer'); 8:ATALINE TO BUGCOM^.LASTDATALINE DO WITH BUGCOM^.SCREENINFO[I] DO BEGIN (WRITE(OUTPUT, ID); WRITE(OUTPUT, ' '); (CA MESSAGE('Break character received'); 10: BEGIN MESSAGE('User I/O error. IORESULT = '); WRITE(OLDIORESULT) END; SE LINETYPE OF EMPTYLINE: WRITELN(OUTPUT); DATALINE: BEGIN WRITE(OUTPUT, 'Data', PROC: 6, DISP: 7); IF FIN11: MESSAGE('Instruction not implemented'); 12: MESSAGE('Floating point over/underflow'); 13: MESSAGE('String too long')DPROC(SEG, PROC, PPROCINFO, TPPROCINFO, TPLINKINFO, JUNK) THEN DISPLYMEM(TPLINKINFO^.MSDATA[DISP], OR; 14: MESSAGE('Uncondition HALT executed'); 15: IF OLDBUGSTATE = RUNNING THEN BEGIN MESSAGE('Brkpnt: '); D(TPLINKINFO)+DELTAMSCW +(DISP-DATAOFFSET)*WORDSZ) ELSE WRITELN(OUTPUT, ' Proc not found') END; STACK IF BUGCOM^.LISTEXISTS THEN WRITELISTLINE ELSE WRITEOFFSET; END ELSE MESSAGE('Stepping ended') END; (* CLINE: BEGIN WRITE(OUTPUT, 'Stack', PROC: 5, DISP: 7); IF FINDPROC(SEG, PROC, PPROCINFO, TPPROCINFO, TPLINKIASE *) END; (* procedure disply_sys_error *) FUNCTION FINDPROC(SEGNUM, PROCNUM: BYTERANGE; STRTPLACE: DMSCWP; VAR PPROCINFNFO, JUNK) THEN DISPLYMEM(TPPROCINFO^.MSSP^[DISP], ORD(TPPROCINFO^.MSSP)+DISP*WORDSZ) ELSE WRITELN(OUTPUT,O, PLINKINFO: DMSCWP; VAR LEVELSUP: INTEGER): BOOLEAN; VAR FOUND: BOOLEAN; BEGIN LEVELSUP := 0; PPROCINFO := STRTPLACE;  ' Proc not found') END; POINTERLINE: BEGIN WRITE(OUTPUT, 'Heap', ' ': 13);  UE END END; (* funtion string_to_int *) FUNCTION OCTSTRTOINT(S: NUMSTRING; VAR N: INTEGER): BOOLEAN; VAR OK: BOOLEAN; IKINFO, JUNK) THEN BEGIN MESSAGE('Proc not found'); GETPARAMS := FALSE END END END END END , EXTRA: INTEGER; BEGIN IF (S > '177777') AND (LENGTH(S) >= 6) THEN OK := FALSE ELSE BEGIN EXTRA := 0; IF (LE END; (* function get_params *) NGTH(S) = 6) AND (S[1] = '1') THEN BEGIN EXTRA := 16384+16384; DELETE(S, 1, 1) END; N := 0; OK := TRUE; I := 1; WHILE OK AND (I<=LENGTH(S)) DO IF S[I] IN ['0'..'7'] THEN BEGIN N := N*8 + ORD(S[I])-ORD0; I := I+1 END ELSE OK := FALSE; N := N+EXTRA; END; IF NOT OK THEN MESSAGE('Bad number'); OCTSTRTOINT := OK END; (* function oct_to_string *) FUNCTION INTREAD(VAR N: INTEGER): BOOLEAN; VAR STRVAL: NUMSTRING; BEGIN INTREAD := FALSE; IF READINTSTRING(STRVAL) THEN  INTREAD := STRTOINT(STRVAL,N); END; (* function int_read *) FUNCTION GETPARAMS(VAR DSEGNUM: SEGRANGE; VAR DPROCNUM: BYTERAher char *) BEGIN S[0] := CHR(LENGTH(S)+1); S[LENGTH(S)] := CH END ELSE OK := FALSE END ELSE IF CH = SYSCOM^.CNGE; VAR OFFSET, DLNGTH: INTEGER; VAR TPPROCINFO, TPLINKINFO: DMSCWP): BOOLEAN; VAR JUNK: INTEGER; BEGIN GETPARAMS :RTINFO.CHARDEL THEN (* junk a char *) BEGIN WITH SYSCOM^.CRTCTRL DO WRITE(OUTPUT, BACKSPACE, ' ', BACKSPACE); DELETE= TRUE; DSEGNUM := SEGNUM; DPROCNUM := PROCNUM; OFFSET := -1; DLNGTH := LNGTH; TPPROCINFO := PPROCINFO; TPLINKINFO :(S, LENGTH(S), 1) END; IF OK THEN READ(KEYBOARD,CH); END; IF NOT OK THEN MESSAGE('Bad number'); READINTSTRING := = PPROCINFO^.MSDYN; PROMPT('Offset: '); IF INTREAD(OFFSET) THEN IF NOT EOLN(KEYBOARD) THEN BEGIN WRITE(OUTPUT, ' OK AND (LENGTH(S) > 0); END; (* function read_int_string *) FUNCTION STRTOINT(VAR S: NUMSTRING; VAR N: INTEGER): BOOLEAN; Length: '); IF INTREAD(DLNGTH) THEN BEGIN LNGTH := DLNGTH; IF NOT EOLN(KEYBOARD) THEN BEGIN WRITE(OUVAR I: INTEGER; BEGIN IF (S > '32767') AND (LENGTH(S) >= 5) THEN " BEGIN MESSAGE('Bad number'); STRTOINT := FALSE END ELSETPUT, ' Proc: '); IF INTREAD(DPROCNUM) THEN BEGIN IF NOT EOLN(KEYBOARD) THEN BEGIN WRITE(OUTPUT, ' S BEGIN N := 0; FOR I := 1 TO LENGTH(S) DO IF S[I] <> ' ' THEN N := N*10 + ORD(S[I])-ORD0; STRTOINT := TReg: '); IF INTREAD(DSEGNUM) THEN; END; IF NOT FINDPROC(DSEGNUM, DPROCNUM, PPROCINFO, TPPROCINFO, TPLIN c links *) ELSE IF DIRECTION = DOWN THEN BEGIN (* traveling down the Dynamic links *) PPROCINFO := DEXERRP; PLINKINFO := PPROCINFO^.MSDYN; NLINKS := LINKLEVEL-NLINKS; LINKLEVEL := 0; IF NLINKS<=0 THEN  MESSAGE('Bottom of link chain') ELSE TRAVERSELINKS(DYNAMIC, NLINKS, UP); (* We have now made it look like it is going up the Dynamic links *) END (*of going down the Dynamic links *) ELSE BEGIN (* going up the Dynamic links *)  WHILE (NLINKS>0) AND (PLINKINFO^.MSDYN<>PLINKINFO) DO BEGIN LINKLEVEL := LINKLEVEL+1; NLINKS := NLINKS-1;  PPROCINFO := PLINKINFO; PLINKINFO := PPROCINFO^.MSDYN; END; IF PLINKINFO^.MSDYN = PLINKINFO THEN MESSAGE('Top of link chain') END; (*of traveling up the dynamic links *) END; (* procedure traverse_links *) PROCEDURE DATAEXPROCEDURE DOEXAMINING; VAR ENDCOMMAND: BOOLEAN; REPROMPT: BOOLEAN; CH: CHAR; PROCEDURE TRAVERSELINKS(LINK: LINKTYPE; NLAMINE; VAR DSEG, DPROC, OFFSET, LEN, DATANDPARMSZ, I, LINE: INTEGER; TPPROCINFO, TPLINKINFO: DMSCWP; BEGIN IINKS: INTEGER; DIRECTION: DIRECTYPE); BEGIN IF LINK = STATIC THEN IF DIRECTION = DOWN THEN MESSAGE('Only traveF GETPARAMS (DSEG, DPROC, OFFSET, LEN, TPPROCINFO, TPLINKINFO) THEN BEGIN DATANDPARMSZ := (TPPROCINFO^.MSJTAB^[JTABDATASZrse UP static links') ELSE BEGIN (* So let's travel up the static links *) WHILE (NLINKS>0) AND (PLINKINFO^.MSDYN<>PLI].INTVAL + TPPROCINFO^.MSJTAB^[JTABPARMSZ].INTVAL) DIV 2; IF OFFSET = -1 THEN OFFSET := DATOFF; NKINFO) DO BEGIN NLINKS := NLINKS-1; PLINKINFO := PLINKINFO^.MSSTAT; END; IF PLINKINFO^.MSDYN = PLINKINFO THEN MESSAGE('Top of link chain'); LINKLEVEL := 0; PPROCINFO := DEXERRP; WHILE PPROCINFO^.MSDYN <> PLINKINFO O^DO BEGIN PPROCINFO := PPROCINFO^.MSDYN; LINKLEVEL := LINKLEVEL+1; END; END (* of traveling up the Stati  DATOFF := MIN(OFFSET+LEN, DATANDPARMSZ+DATAOFFSET); IF OFFSET-DATAOFFSET >= DATANDPARMSZ THEN MESSAGE('Warning - offset tooCINFO^.MSSP^[I], ORD(TPPROCINFO^.MSSP)+I*WORDSZ); NEXTLINE(LINE); END; BUGCOM^.DATAPLACE := LINE; SHOWNEXTLINE('*' large') ELSE IF OFFSET-DATAOFFSET+LEN > DATANDPARMSZ THEN MESSAGE('Warning - length too large'); LINE := BUGCOM^.DATA); END END; (* procedure stack_examine *) PROCEDURE HEAPEXAMINE; VAR STR: NUMSTRING; ADDR, LEN, I: INTEGER; LPLACE; FOR I := OFFSET TO DATOFF-1 DO WITH BUGCOM^.SCREENINFO[LINE] DO BEGIN ID := ' '; .BUGCOM^.BUFFEREINE: INTEGER; TRICKSTUFF: MEMTYPE; BEGIN PROMPT('Octal address: '); IF READINTSTRING(STR) THEN MPTY := FALSE; LINETYPE := DATALINE; SEG := DSEG; PROC := DPROC; DISP := I; PUTCURSOR(LINE, 0 IF OCTSTRTOINT(STR, ADDR) THEN BEGIN WRITE(OUTPUT, ' Length: '); IF INTREAD(LEN) THEN BEGIN LINE := BU); .WRITE(OUTPUT, 'Data': 14, DPROC: 6, I: 7); DISPLYMEM(TPLINKINFO^.MSDATA[I], ORD(TPLINKINFO)+DELTAMSCW+(I-DATAOFFSGCOM^.DATAPLACE; FOR I := 0 TO LEN-1 DO WITH BUGCOM^.SCREENINFO[LINE] DO BEGIN BUGCOM^.BUFFEREMPTY := FALSE; ET)*WORDSZ); NEXTLINE(LINE); END; BUGCOM^.DATAPLACE := LINE; SHOWNEXTLINE('*') END END; (* procedure data_ex ID := ' '; 4LINETYPE := POINTERLINE; HEAPPOINTER := ADDR + WORDSZ*I; PUTCURSOR(LINE, 0); 4WRITE(OUTPUamine *) PROCEDURE STACKEXAMINE; VAR DSEG, DPROC, OFFSET, LEN, STACKSZ, I, LINE: INTEGER; TPPROCINFO, TPLINKINT,'Heap': 14,' ': 13); TRICKSTUFF.INTVAL := HEAPPOINTER; DISPLYMEM(TRICKSTUFF.PTVAL^, HEAPPOINTER); IF LINE = FO: DMSCWP; BEGIN IF GETPARAMS (DSEG, DPROC, OFFSET, LEN, TPPROCINFO, TPLINKINFO) THEN BEGIN BUGCOM^.LASTDATALINE THEN BEGIN LINE := FIRSTDATALINE; PUTCURSOR(FIRSTDATALINE,0) END ELSE LINE := LINE STACKSZ := (ORD(TPLINKINFO) - ORD(TPPROCINFO^.MSSP)) DIV WORDSZ; IF OFFSET = -1 THEN OFFSET := STOFF; STOFF := MIN(OFFSET+LEN+1 END; (* WITH *) BUGCOM^.DATAPLACE := LINE; SHOWNEXTLINE('*'); END (* IF INTREAD *) END (* IF OCTSTRTOINT *) E, STACKSZ); IF OFFSET >= STACKSZ THEN MESSAGE('Warning - offset too large') ELSE IF OFFSET + LEN > STACKSZ THEN MESND; (* procedure heap_examine *) PROCEDURE ENTERID; "VAR S: STRING[12]; 'I: INTEGER; "BEGIN "PROMPT('Id: '); "READLN(ISAGE('Warning - length too large'); LINE := BUGCOM^.DATAPLACE; FOR I := OFFSET TO STOFF-1 DO WITH BUGCOM^.SCREENINFO[LINE] NPUT, S); "IF LENGTH(S) > 8 THEN $MESSAGE('Bad identifier') "ELSE $WITH BUGCOM^ DO &BEGIN &BUFFEREMPTY := FALSE; DO BEGIN BUGCOM^.BUFFEREMPTY := FALSE; ID := ' '; .LINETYPE := STACKLINE; SEG := DSEG; &MOVELEFT(S[1], SCREENINFO[DATAPLACE].ID[0], LENGTH(S)); &FILLCHAR(SCREENINFO[DATAPLACE].ID[LENGTH(S)], 8-LENGTH(S), ' '); &PPROC := DPROC; DISP := I; PUTCURSOR(LINE, 0); .WRITE(OUTPUT, 'Stack': 15, DPROC: 5, I: 7); DISPLYMEM(TPPROUTCURSOR(DATAPLACE, 0); &WRITE(OUTPUT, S); &SHOWNEXTLINE(' '); &NEXTLINE(DATAPLACE); &SHOWNEXTLINE('*'); &END "END; {ente N FOUND := TRUE ELSE WHICH := WHICH + 1; IF FOUND THEN BEGIN SYSCOM^.BRKPTS[WHICH] := -1; DISPLYBRKPTS END EL OR (OLDBUGSTATE = ENDWALKING) THEN BEGIN WRITE(OUTPUT, 'Hit [space] when ready'); CH := GETCHAR(TRUE); END; UPSE MESSAGE('Brkpnt not active') END ELSE IF EOLN(KEYBOARD) THEN BEGIN FOR WHICH := 0 TO 3 DO SYSCOM^.BRKPTS[WHICDATE; SHOWNEXTLINE('*') END; (* procedure init_examine *) BEGIN (* procedure do_examining *) INITEXAMINE; REPEAT H] := -1; DISPLYBRKPTS END END; (* procedure clr_brk_pnt *) BEGIN (* procedure break_points *) PROMPT('S(et  IF REPROMPT THEN BEGIN CLEARLINE(PROMPTLINE); IF DIRECTION = DOWN THEN WRITE(OUTPUT, '<') ELSE WRITE(OUTPUT, '>'); WRIrid} " " "PROCEDURE ERASEBUF; VAR I: INTEGER; BEGIN BUGCOM^.BUFFEREMPTY := TRUE; PUTCURSOR(FIRSTDATALINE, 0); or C(lear breakpoint'); READ(KEYBOARD, CH); IF (CH = 'S') OR (CH = 's') THEN SETBRKPNT  FOR I := FIRSTDATALINE TO BUGCOM^.LASTDATALINE DO BEGIN &BUGCOM^.SCREENINFO[I].ID := ' '; &BUGCOM^.SCREENINFO[I] ELSE IF (CH = 'C') OR (CH = 'c') THEN CLRBRKPNT END; (* procedure break_points *) PROCEDURE MOVETOPROC; VAR PROC, SE.LINETYPE := EMPTYLINE; &CLEARTHISLINE &END; BUGCOM^.DATAPLACE := FIRSTDATALINE; SHOWNEXTLINE('*'); END; (* procedurG, LEVELS: INTEGER; CH: CHAR; TPLINKINFO, TPPROCINFO: DMSCWP; BEGIN SEG := SEGNUM; PROMPT('Proc: '); IF e erase_buf *) PROCEDURE TEXTEXAMINE; BEGIN END; (* procedure text_examine *) PROCEDURE BREAKPOINTS; VAR CH: CHAR;NOT INTREAD(PROC) THEN BEGIN PPROCINFO := DEXERRP; PLINKINFO := PPROCINFO^.MSDYN; LINKLEVEL := 0; DISPLYINFO END PROCEDURE SETBRKPNT; VAR LINE, WHICH: INTEGER; FOUND: BOOLEAN; BEGIN FOUND := FALSE; WHICH := 0;  ELSE BEGIN IF NOT EOLN(KEYBOARD) THEN BEGIN WRITE(OUTPUT, ' Seg: '); IF INTREAD(SEG) THEN; END; IF WHILE NOT FOUND AND (WHICH <= 3) DO IF SYSCOM^.BRKPTS[WHICH] = -1 THEN FOUND := TRUE ELSE WHICH := WHICH + 1;  FINDPROC(SEG, PROC, PLINKINFO, TPPROCINFO, TPLINKINFO, LEVELS) THEN BEGIN LINKLEVEL := LINKLEVEL + LEVELS +1; PPRO IF FOUND THEN BEGIN PROMPT('Set breakpoint at line: '); IF INTREAD(LINE) THEN BEGIN SYSCOM^.BRKPTS[WHICH] := LCINFO := TPPROCINFO; PLINKINFO := TPLINKINFO; DISPLYINFO END ELSE MESSAGE('Proc not found') END; END;(*INE; DISPLYBRKPTS END END ELSE MESSAGE('All brkpnts in use'); END; (* procedure set_brk_pnt *) PROCEDURE CLRB procedure move_to_proc *) PROCEDURE INITEXAMINE; VAR CH: CHAR; BEGIN OLDBUGSTATE := SYSCOM^.BUGSTATE; OLDIORESURKPNT; VAR LINE, WHICH: INTEGER; FOUND: BOOLEAN; BEGIN PROMPT('Clear breakpoint at line: '); IF INTREAD(LINLT := ORD(SYSCOM^.IORSLT); SYSCOM^.BUGSTATE := EXAMINING; DIRECTION := UP; STOFF := 0; E) THEN BEGIN FOUND := FALSE; WHICH := 0; WHILE NOT FOUND AND (WHICH <= 3) DO IF SYSCOM^.BRKPTS[WHICH] = LINE THE LNGTH := BUGCOM^.LASTDATALINE-FIRSTDATALINE+1; ENDCOMMAND := FALSE; REPROMPT := TRUE; IF (OLDBUGSTATE = RUNNING)  FALSE END; 'L': BEGIN PUTCURSOR(INFOLINE+2, LINKCOLUMN+13); IF LINKDEFAULT = DYNAMIC THEN BEGIN  SHOWNEXTLINE('*'); REPROMPT := FALSE END ELSE MESSAGE('Not a command') UNTIL ENDCOMMAND; CLEARSCREEN; WRITEL LINKDEFAULT := STATIC; WRITE(OUTPUT, 'Static ') END ELSE BEGIN LINKDEFAULT := DYNAMIC; N(OUTPUT); END; (* procedure do_examining *) PROCEDURE CRAWLWAIT; VAR CH: CHAR; BEGIN WRITE(OUTPUT, ' [sp] or ''Q''');  WRITE(OUTPUT, 'Dynamic') END; REPROMPT := FALSE END; 'D': DATAEXAMINE; 'H': HEAPEXAMINE; 'S':  CH := GETCHAR(FALSE); WRITELN(OUTPUT); IF CH = 'Q' THEN DOEXAMINING; END; (* procedure crawl_wait *) PROCEDURE WALKWAIT; STACKEXAMINE; 'T': TEXTEXAMINE; 'I': ENTERID; +'W': BEGIN PROMPT('Delay: '); BUGCOM^.WALKDELAY := 0; IF INT VAR I, J: INTEGER; BEGIN FOR I := 0 TO BUGCOM^.WALKDELAY DO FOR J := 0 TO SECDELAY DO; WRITELN(OUTPUT); END; (* procedure READ(BUGCOM^.WALKDELAY) THEN; SYSCOM^.BUGSTATE := WALKING; ENDCOMMAND := TRUE; END; 'C': BEGIN walk_wait *) PROCEDURE HANDLESTEPPING; BEGIN IF SYSCOM^.XEQERR = 15 THEN (* it was a conditional halt*) BEGIN IF B SYSCOM^.BUGSTATE := CRAWLING; ENDCOMMAND := TRUE; END; 'B': BREAKPOINTS; 'U': UPDATE;(* Display *) 'R'UGCOM^.LISTEXISTS THEN WRITELISTLINE ELSE WRITEOFFSET; IF SYSCOM^.BUGSTATE = CRAWLING THEN CRAWLWAIT ELSE WALKWAIT; ETELN(OUTPUT, 'EXAMINE: 1..9 (links, M(ove, <, >, L(ink, D(ata, S(tack, H(eap, I(d'); WRITE(OUTPUT, 'E(rase, U(pdate, , , C(rawl, W(alk, R(esume, '); END ELSE BEGIN FGOTOXY(72,PROMPTLINE+1); REPROMPT := TRUE END; READ(KEYBO := FALSE END END (* CASE *) ELSE IF CH = SYSCOM^.CRTINFO.ALTMODE THEN *BEGIN CLEARSCREEN; EXIT(USERPROGRAM) END ELSARD, CH); IF CH IN ['a'..'z'] THEN CH := CHR(ORD(CH)-32); CLEARLINE(BUGCOM^.COMLINE); IF CH IN ['<', '>', ',', '.',E IF EOLN(KEYBOARD) THEN WITH BUGCOM^ DO ,BEGIN SCREENINFO[DATAPLACE].ID := ' '; ,SCREENINFO[DATAPLACE].LINETYP '0'..'9', 'B', 'C', 'D', 'E', 'H', 'I', 'L', 'M', 'R', 'S', 'T', 'U', 'W'] THEN CASE CH OF E := EMPTYLINE; ,CLEARLINE(DATAPLACE); NEXTLINE(DATAPLACE); SHOWNEXTLINE('*'); REPROMPT := FALSE; END ELSE I '>', '.': BEGIN DIRECTION := UP; FGOTOXY(0,PROMPTLINE); WRITE(OUTPUT, '>'); REPROMPT := FALSE END; F CH = SYSCOM^.CRTINFO.DOWN THEN BEGIN SHOWNEXTLINE(' '); NEXTLINE(BUGCOM^.DATAPLACE); SHOWNEXTLINE('*'); REPROMP '<', ',': BEGIN DIRECTION := DOWN; FGOTOXY(0,PROMPTLINE); WRITE(OUTPUT, '<'); REPROMPT := FALSE END; '0','1'T := FALSE END ELSE IF CH = SYSCOM^.CRTINFO.UP THEN BEGIN SHOWNEXTLINE(' '); IF BUGCOM^.DATAPLACE = FIRSTDATAL,'2','3','4','5','6','7','8','9': BEGIN TRAVERSELINKS(LINKDEFAULT,ORD(CH)-ORD0,DIRECTION); DISPLYINFO; REPROMPT :=INE THEN BUGCOM^.DATAPLACE := BUGCOM^.LASTDATALINE ELSE BUGCOM^.DATAPLACE := BUGCOM^.DATAPLACE-1;  KINFO := PPROCINFO^.MSDYN; LINKLEVEL := 0; LINKDEFAULT := DYNAMIC; DATOFF := FIRSTDATAOFFSET; LISTOPEN := FALSE; IF GETABLE); (* allocate room for one entry *) WHILE BLOCKREAD(LISTFILE, PAGEBUFF, 2, 2*I)=2 DO BEGIN BUGCOM^.BUFFEREMPTY AND (SYSCOM^.BUGSTATE <> AWAKENING) THEN BEGIN DPROC := PPROCINFO^.MSJTAB^[JTABPROCANDLL].BYTEVAL[ TEMPSTR[0] := CHR(5); MOVELEFT(PAGEBUFF[1], TEMPSTR[1], 5); IF STRTOINT(TEMPSTR, PAGETABLE^[I,0]) THEN; LOBYTE]; DSEG := PPROCINFO^.MSSEG^.BYTEVAL[LOBYTE]; SIZE := MIN((PPROCINFO^.MSJTAB^[JTABDATASZ].INTVAL +PPRO EOLL := 1023 + SCAN(-1024, <>CHR(0), PAGEBUFF[1023]); MOVELEFT(PAGEBUFF[EOLL+SCAN(-EOLL, =CHR(13), PAGEBUFF[EOLL-1])+CINFO^.MSJTAB^[JTABPARMSZ].INTVAL) DIV 2, BUGCOM^.LASTDATALINE-FIRSTDATALINE+1); DATOFF := SIZE+DATAOFFSET; BUGCOM1], TEMPSTR[1], 5); IF STRTOINT(TEMPSTR, PAGETABLE^[I,1]) THEN; I := I+1; NEW(JUNKP) (* make room for an^.DATAPLACE := FIRSTDATALINE+SIZE; IF BUGCOM^.DATAPLACE>BUGCOM^.LASTDATALINE THEN BUGCOM^.DATAPLACE := FIRSTDATALINE; other entry *) END; PAGETABLE^[I,0] := 32767; PAGETABLE^[I,1] := 32767; END; (* WITH *) END; (* ELSE *) BUGTOS FOR I := 0 TO SIZE-1 DO WITH BUGCOM^.SCREENINFO[I+FIRSTDATALINE] DO BEGIN ID := ' '; YS.BUGDEBUG := BUGCOM; DEBUGINFO := BUGTOSYS.SYSDEBUG; WITH BUGCOM^ DO BEGIN FOR I := 0 TO 3 DO SYSCOM^.BRKPTS[I] ,LINETYPE := DATALINE; PROC := DPROC; SEG := DSEG; DISP := I+DATAOFFSET; END; FOR I := SIZE+FIRSTDATALI:= -1; LASTDATALINE := MIN(SYSCOM^.CRTINFO.HEIGHT-2, 22); COMLINE := LASTDATALINE + 1; FOR I := FIRSTDATALINE NE TO BUGCOM^.LASTDATALINE DO BEGIN (BUGCOM^.SCREENINFO[I].ID := ' '; (BUGCOM^.SCREENINFO[I].LINETYPE := EMPTYLINE; TO SYSCOM^.CRTINFO.HEIGHT-2 DO BEGIN (SCREENINFO[I].LINETYPE := EMPTYLINE; SCREENINFO[I].ID := ' '; (EN END; $END; END; (* procedure initialize *) PROCEDURE WAKEUPDEBUGGER; VAR I, EOLL: INTEGER; TEMPSTR: STRING[6]; BUGTD; &DATAPLACE := FIRSTDATALINE; BUFFEREMPTY := TRUE; SYSCOM^.BUGSTATE := AWAKENING; END; (*WITH BUGCOM*) ND ELSE DOEXAMINING; END; (* procedure handle_stepping *) PROCEDURE INITIALIZE; VAR SYSTOBUG: RECORD CASE INTEGER OF 0: (SOSYS: RECORD CASE INTEGER OF 0: (SYSDEBUG: ^INTEGER); 1: (BUGDEBUG: ^BUGINFOREC) EYSMSCWP: MSCWP); 1: (BUGMSCWP: DMSCWP); 2: (SYSDEBUGINFO: ^INTEGER); 3: (BUGCOM: ^BUGINFOREC) ND; JUNKP: ^PAGEARRAY; CH: CHAR; BEGIN WRITELN(OUTPUT, 'PASCAL INTERACTIVE DEBUGGER - June 12, 1978'); OPENOLD(LISTF END; (* OLD TO NEW POINTER CONVERSION *) I, SIZE, DPROC, DSEG: INTEGER; BEGIN SYSTOBUG.SYSMSCWP := SYSCOM^.BOMBP; ILE,'*SYSTEM.LST.TEXT'); IF IORESULT <> 0 THEN BEGIN NEW(BUGCOM, FALSE); BUGCOM^.LISTEXISTS := FALSE END ELSE BEG DEXERRP := SYSTOBUG.BUGMSCWP; SYSTOBUG.SYSDEBUGINFO := DEBUGINFO; BUGCOM := SYSTOBUG.BUGCOM; PPROCINFO := DEXERRP; PLININ NEW(BUGCOM, TRUE); WITH BUGCOM^ DO BEGIN LISTEXISTS := TRUE; (* fill in page table *) I := 1; NEW(PA fully sorry, but I''ve discovered an error in myself.'); EXIT(USERPROGRAM); END; (*procedure error_in_debugger *) BEGIN (* segment procedure debugger *) IF SYSCOM^.BUGSTATE = ASLEEP THEN (*Lets wake up *) BEGIN WAKEUPDEBUGGER; USERPROGRAM(NIL, NIL); SYSCOM^.BUGSTATE := ASLEEP; BUGCOM := NIL END ELSE BEGIN INITIALIZE; IF SYSCOM^.XEQERR = 8 THEN (* he hit a break *) CASE SYSCOM^.BUGSTATE OF EXAMINING: MESSAGE('[Break] invalid while EXAMINING');  ENDCRAWLING, ENDWALKING, RUNNING: DOEXAMINING; CRAWLING: SYSCOM^.BUGSTATE := ENDCRAWLING; WALKING: SYSCOM^.BUGSTATE := ENDWALKING END (* CASE *) ELSE CASE SYSCOM^.BUGSTATE OF EXAMINING: ERRORINDEBUGGER; CRAWLING: HANDLESTEPPING; WALKING: HANDLESTEPPING; AWAKENING, ENDCRAWLING, ENDWALKING, RUNNING: DOEXAMINING END; (* CASE *)  IF LISTOPEN THEN CLOSE(LISTFILE); END; (* IF *) END; (* segment procedure debugger *) BEGIN END. (* PASCAL SYSTEM *)  (*$I DEBUG:GLOBALS.TEXT*) (*$I DEBUG:DEBUG.A.TEXT*) (*$I DEBUG:DEBUG.B.TEXT*) (*$I DEBUG:DEBUG.C.TEXT*) END; (* procedure wake_up_debugger *) PROCEDURE ERRORINDEBUGGER; BEGIN CLEARLINE(PROMPTLINE+1); WRITELN(OUTPUT, 'I''m aw  ; BUGINFOREC = RECORD BUFFEREMPTY: BOOLEAN; DATAPLACE: INTEGER; SCREENINFO: ARRAY [8..22] OF PACKED RECORD & ID: PACKED ARRAY [0..7] OF CHAR; (CASE LINETYPE: DEBUGLINE OF *DATALINE, *STACKLINE: (SEG: SEGRANGE; 6PROC: BYTERANGE; 6(* Interactive Pascal Debugger*) (* Version I.4b Released 6/12/78 *) (* Author Joel McCormack *) (* Written Summer 1977 *) (* I.4 modifications made Jan. 1978 *) (* 12-Jun-78 strtotint, octtoint corrected *)  (* 12-Jun-78 writelistline now finds right page *)  (* 12-Jun-78 I command implemented *)  SEGMENT PROCEDURE USERPROGRAM(INPUT, OUTPUT: FIBP); BEGIN END; (* USERPROGRAM *) SEGMENT PROCEDURE FILEHANDLER; BEGIN END; (* FILEHANDLER *) SEGMENT PROCEDURE DEBUGGER; CONST (* Special Characters *) ORDCR = 13; ORD0 = 48; (* Positioning of info on screen *) PROMPTLINE = 0; INFOLINE = 3; HEADINGLINE = 7; FO^IRSTDATALINE = 8; LINKCOLUMN = 40; (* Information about the hardware and implementation *) SECDELAY = 1200; DELTAMSCW = 12; DATAOFFSET = 1; (* The first data offset *) WORDSZ = 2; LOBYTE = 0; HIBYTE = 1; JTABPROCANDLL = 0; (* The offsets by words in the JUMPTABLE. Indexed off of @JTAB *) JTABENTRIC = -1; JTABPARMSZ = -3; JTABDATASZ = -4;  (* BUGSTATES *) ASLEEP = 0; RUNNING = 1; EXAMINING = 2; CRAWLING = 3; WALKING = 4; ENDCRAWLING = 5; ENDWALKING = 6; AWAKENING = 7; TYPE DEBUGLINE = (EMPTYLINE,DATALINE,STACKLINE,POINTERLINE); PAGEARRAY = ARRAY [1..1, 0..1] OF INTEGER! DMSCW = RECORD (* MSCW in convenient format *) MSSTAT: DMSCWP; MSDYN: DMSCWP; MSJTAB: ^MEMARRAY; MSSEG: ^MEMTYPE; MSIPC: INTEGER; MSSP: ^MEMARRAY; MSDATA: ARRAY [DATAOFFSET..DATAOFFSET] OF MEMTYPE END; (* Debug Mark Stack Control Word *) DIRECTYPE = (UP, DOWN); LINKTYPE = (STATIC, DYNAMIC); NUMSTRING = STRING[6]; VAR BUGCOM: ^BUGINFOREC; DEXERRP: DMSCWP; (*Pointer to EXECERROR *) PPROCINFO, PLINKINFO: DMSCWP; (* Pointers to current proc *)  DATOFF, STOFF, (* Default offsets for stack and data *) LNGTH, (* Default length to use *) SEGNUM, PROCNUM, (* Info aboDISP: INTEGER); *POINTERLINE: (HEAPPOINTER: INTEGER) (END; (*CASE LINETYPE*) WALKDELAY: INTEGER; LASTDATALINE, COMLINEut current proc *) LINKLEVEL: INTEGER; (* Number of DYNAMIC links above bombed proc *) LINKDEFAULT: LINKTYPE; DIRECTION: : INTEGER; CASE LISTEXISTS: BOOLEAN OF TRUE: (PAGETABLE: ^PAGEARRAY; CURRPAGE: INTEGER; PAGEBUFF: PACKED ARRAY [0..1023DIRECTYPE; LISTOPEN: BOOLEAN; LISTFILE: FILE; OLDIORESULT, OLDBUGSTATE: INTEGER; ] OF CHAR) END; (*BUGINFOREC*) OCTRANGE = 0..7; HEXRANGE = 0..15; MEMTYPE = RECORD CASE INTEGER OF (* Used to get at memory in various and convenient ways *) 0: (INTVAL: INTEGER);  1: (HEXVAL: PACKED ARRAY[0..3] OF HEXRANGE); 2: (BYTEVAL: PACKED ARRAY[0..1] OF BYTERANGE); 3: (CHARVAL: PACKED ARRAY[0..1] OF CHAR); 4: (OCTVAL: PACKED RECORD FD0, FD1, FD2, FD3, FD4: OCTRANGE; FIRSTDIGIT: 0..1  END); 5: (BYTEOCTVAL: PACKED RECORD LD1, LD2: OCTRANGE; LD0: 0..3; HD1, HD2: OCTRANGE; HD0: 0..3  END); 6: (PTVAL: ^MEMTYPE) END;(* RECORD MEMTYPE *) MEMARRAY = ARRAY [0..0] OF MEMTYPE; DMSCWP = ^DMSCW; 1 2 3 4 UWO^" P3,OP4,OP5,OP6,OP7,OP8,OP9,OP10,OP11,OP12,OP13, 'OP14,OP15,OP16,OP17,OP18,OP19,OP20,ALIGN,TIDENTIFIER, 'TEOF,BLOCK,WORD,BIGHT,)TEMPATRIB:ATRIBUTETYPE &END;  RELTYPE=(LLREL,LABELREL,LCREL,NOTSET); $RESULTREC=RECORD {expression evaluatorENDLINE,TMOD,PROC,FUNC,CONDEND,TELSE,ORG, 'ASCII,MACRODEF,CONDITION,EQU,PUBLIC,PRIVATE,TCONST, 'LIST,NOLIST,ASECT,PSECT,TEND,T result record} )ATTRIBUTE:ATRIBUTETYPE; )OFFSETORVALUE:INTEGER; &END; $RELREC=RECORD {current expression's rePAGE,TITLE, 'LASTOPCODE, 'INCLUDE,TLABEL,LOCLABEL,TSTRING,CONSTANT,STARTFILE,MACROEND,EXPAND, 'TNULL); $CODETYPE=(A,P); $SOlocation info} )TIPE:RELTYPE; )OFFSETORVALUE,TEMPLABEL:INTEGER; )ATTRIBUTE:ATRIBUTETYPE; )SYM:SYMTABLEPTR &END; $BACKLABELURCETYPE=(MACROSOURCE,PARMSOURCE,FILESOURCE); $ATRIBUTETYPE=(DEFABS,PROCS, +OPS1,OPS2,OPS3,OPS4,OPS5,OPS6,OPS7,OPS8,OPS9,OPS10=PACKED RECORD {forward reference record} )WORDLC,BYTESIZE:BOOLEAN; )OFFSET,LC,VALUE:INTEGER; )NEXT:BKLABELPTR &END; $J,OPS11, +OPS12,OPS13,OPS14,OPS15,OPS16,OPS17,OPS18,OPS19,OPS20, +DEFRP,DEFREG,DEFCC,DEFIR, TABREC=ARRAY[0..6] OF INTEGER; {for storage of relocation info}  BUFFERTYPE=PACKED ARRAY[0..511] OF BITE; $SCRATCHREC=+PUBLICS,CONSTS,PRIVATES,REFS,DEFS,FUNCS,ABS,LABELS,UNKNOWN,MACROS); $MACROPTR=^MACROTYPE; $MACROTYPE=PACKED ARRAY[0..MACROSIRECORD {scratch file for temporary storage} )CLASS:INTEGER; )CASE BOOLEAN OF .TRUE:(JUMPS:JTABREC); -FALSE:(FWDREZE] OF CHAR; $JTABPTR=^JTAB; $JTAB=RECORD {Used for linkinfo references} 'PCOFFSET:INTEGER; 'LAST:JTABPTR %ENF:BACKLABEL) $END;   {----------------------------------------------------------------------}   VAR SYM:SYMTABLEPTRD; $BKLABELPTR=^BACKLABEL; $SYMTABLEPTR=^SYMBOLTABLE; $SYMBOLTABLE=RECORD {Symboltable entry} 'NAME:PACKNAME; 'LINK:; {pointer to current symboltable entry}  LEXTOKEN:TOKENS; {current token returned by LEX} SYMTABLEPTR; 'CASE ATTRIBUTE:ATRIBUTETYPE OF ){OPS1,OPS2,OPS3,OPS4,OPS5,OPS6,OPS7,OPS8,OPS9,OPS10, )OPS11,OPS12,OPS13,OPS14,OPS15,OPS16,OPS17,OPS18,OPS19,OPS20, )ABS,DEFABS,DEFRP,DEFREG,DEFCC,DEFIR,LABELS,} ;UNKNOWN:(OFFSETORVALUE:INTEGER; DFWDREF:BK9{start of ASM1} %{Copyright (c) 1978 Regents of the University of California} .  TOKENS=(EQUAL,NOTEQUAL,BITWISEOR,EXCLUSIVELABELPTR); DEFS:(PROCNUM,CODEOFFSET:INTEGER; DDEFFWDREF:BKLABELPTR); &PUBLIOR,DIVIDE,MODULO,ONESCOMPLEMENT,TNOT, 'OPENPAREN,CLOSEPAREN,OPENBRACKET,CLOSEBRACKET,OPNBRACE,CLSBRACE, 'COMMA,OPNBROKEN,CLSBRCS,PRIVATES,REFS,CONSTS:(NREFS,NWORDS:INTEGER; DLINKOFFSET:JTABPTR); 7PROCS,FUNCS:(FUNCNUM,NPARAMS:INTEGER) &END; $TEMPTABLEOKEN,QUERY,PLUS,MINUS, 'ASTERISK,AMPERSAND,ATSIGN,COLON,NUMBERSIGN,AUTOINCR,AUTODECR,LOCCTR, 'FIRSTOPCODE, 'REF,DEF,OP1,OP2,O=RECORD {Temporary table entry} )TEMPNAME:PACKNAME; )DEFOFFSET:INTEGER; )FWDREF:BKLABELPTR; # ymbols} $CODECOUNT:INTEGER; {index into array containing current line's code} $OPBYTE:BYTESWAP; {used exclusively by Z$MACROSTACK:ARRAY[0..5] OF MACROPTR; $PARMSTACK,MCINDEX:ARRAY[0..5] OF INTEGER; $SPECIALSTK:ARRAY[0..5] OF TOKENS; OP1 - ZOP20} $CH:CHAR; $DISPLAY:BOOLEAN; {currently displaying output?} $FULLLABEL:BKLABELPTR; {forward referenced label$TEMP:ARRAY[0..20] OF TEMPTABLE; $HASH,HASHRES:ARRAY[0..HASHTOP] OF SYMTABLEPTR; $LASTSYM:SYMTABLEPTR; $ $ALTFILE:FILE; $Ss still unresolved} $RESULT:RESULTREC; {result of last call to expression evaluator} $ $BUFBOTTOM, {start of BCRATCH:FILE OF SCRATCHREC; $ $KWORDS:ARRAY[0..NUMKWORDS] OF PACKNAME; $KTOKEN:ARRAY [0..NUMKWORDS] OF TOKENS; $XBLOCK:PACKEDUFFER relative to start of output file} $BUFFERPOS, {next output byte relative to start of BUFFER} $BUFFERTOP,  ARRAY[0..1023] OF CHAR; $CONSTID,HEXCHAR:PACKED ARRAY[0..15] OF CHAR; $CODE,BLANKCODE:PACKED ARRAY[0..CODESIZE] OF CHAR;   {next output byte relative to start of file} $MAXBUFTOP, {maximum BUFFERTOP} $OUTBLKTOP, {next bl HEAP:^INTEGER;  SEGNAME,PROCNAME,ID:PACKNAME; $PROCTABLE:ARRAY[0..MAXPROC] OF INTEGER; $   PROCEDURE ERROR(ERRORNUM:ock after current end of output file} $PROCSTART, {start of procedure relative to start of file} INTEGER); FORWARD;  PROCEDURE PATCHCODE(FWDREF:BACKLABEL; BUFINDEX:INTEGER); FORWARD;  PROCEDURE IOCHECK(QUIT:BOOLEAN); FORWAR$JCOUNT1,JCOUNT2,JCOUNT3, {indexes for relocation records JTABREC's} $TEMPTOP,TEMPLABEL, $BLOCKPTR,BNUM,BLOCKNO,ALTBLOCNO,ALTD;  PROCEDURE LLCHECK; FORWARD;  PROCEDURE PRINTPAGE; FORWARD;  PROCEDURE PRINTLINE; FORWARD;  PROCEDURE PRINTNUM(WORD:INTEGBLOCPTR, $PROCNUM,SEGSIZE,PAGENO, $LINENUM,LISTNUM, $NUMERRORS, $OPVAL,CONSTVAL, $PARMPTR,MCSTKINDEX,LINKEND,SCRATCHEND,CONER; BYTESIZE:BOOLEAN); FORWARD;  PROCEDURE PUTBYTE(BYTE:BITE); FORWARD;  PROCEDURE PUTRELWORD(WORD:INTEGER; BYTESIZE,WORDOFFSDINDEX, $LC,ALC,LASTLC,LOWLC :INTEGER; " $SYMLAST,FOUND,CONSOLE,STARTLINE,FROMPUTWORD,NOTSTET:BOOLEAN); FORWARD;  PROCEDURE PUTWORD(WORD:INTEGER); FORWARD;  PROCEDURE GETCHAR; FORWARD;  PROCEDURE LEX; FORWARD; RING,LISTING,JUMPINFO, $ADVANCE,EXPANDMACRO,PARMCHECK,ALTINPUT,EXPRSSADVANCE,DEFMCHOOK :BOOLEAN; $MCPTR:MACROPTR; $BUFFER:^B FUNCTION EXPRESS(OPERANDREQUIRED:BOOLEAN):BOOLEAN; FORWARD;  FUNCTION CHECKOPERAND(CKSPCSTK,CKABS,CKRANGE:BOOLEAN;LO,HI:INTUFFERTYPE; {buffer for output code in core} $TAB:CHAR; $LISTFILE:INTERACTIVE; $TITLELINE,STRVAL,CURFNAME,FIRSTFNAME:STRING;EGER):BOOLEAN; ^FORWARD;   {dummy segments necessary since compiled U-}  SEGMENT PROCEDURE DUMMY2; BEGIN END;  SEGMENT PR$OUTBLKNO, {next output block #} $TEXTINDEX, {index into TEXTLINE, containing line of source text} $MA $TEXTLINE,BLANKLINE:PACKED ARRAY[0..79] OF CHAR; $ $RELOCATE,OPERAND1,OPERAND2,OPERAND3,NULLREL:RELREC; $NEXTJP:JTABPTR; $CROINDEX, {index into macro source sitting on heap} $SPCIALSTKINDEX, {index into stack of outstanding special sJUMP1,JUMP2,JUMP3:JTABREC; $FREELABEL:BKLABELPTR; $ $CURRENTATRIB:ATRIBUTETYPE; $SOURCE:SOURCETYPE; $CODESECTION:CODETYPE; $ T; "KWORDS[22]:='NOLIST '; KTOKEN[22]:=NOLIST; "KWORDS[23]:='ASECT '; KTOKEN[23]:=ASECT; "KWORDS[24]:='PSECT '; KTOKEN[2T('*',OPFILENAME); "RESET(OPFILE,OPFILENAME); "IF IORESULT<>0 THEN $BEGIN &WRITELN(OPFILENAME,' not on vol'); &UNITCLEAR(3)OCEDURE DUMMY3; BEGIN END;  SEGMENT PROCEDURE DUMMY4; BEGIN END;  SEGMENT PROCEDURE DUMMY5; BEGIN END;  SEGMENT PROCEDURE 4]:=PSECT; "KWORDS[25]:='TITLE '; KTOKEN[25]:=TITLE; "KWORDS[26]:='END '; KTOKEN[26]:=TEND; DUMMY6; BEGIN END;  SEGMENT PROCEDURE DUMMY7; BEGIN END;  SEGMENT PROCEDURE DUMMY8; BEGIN END;  SEGMENT PROCEDURE DUMMY9; "KWORDS[27]:='PAGE '; KTOKEN[27]:=TPAGE;  END;   PROCEDURE LEXINIT;  VAR HASHA,HASHB:INTEGER;  BEGIN "FOR COUNT:=0 T BEGIN END;    SEGMENT PROCEDURE INITIALIZE;  TYPE OPREC=RECORD )OPNAME:PACKNAME; )OPVALUE:INTEGER; )OPATRIB:ATRIBUTETO HASHTOP DO HASH[COUNT]:=NIL; "KEYTOKENSET; "REPEAT $ID:=OPFILE^.OPNAME; $HASHA:=0; FOUND:=FALSE; $FOR COUNT:=0 TO 7 DO $YPE &END;   VAR OK:BOOLEAN; %COUNT:INTEGER; %OPFILENAME,LISTNAME:STRING; %OPFILE:FILE OF OPREC;   PROCEDURE KEYTOKENS BEGIN (HASHA:=HASHA + HASHA; {left shift} (HASHB:=ORD(ID[COUNT]); (HASHA:=ORD((NOT ODD(HASHA) AND ODD(HASHB)) OR 3(ODD(HAET;  BEGIN "KWORDS[0] :='ALIGN '; KTOKEN[0] :=ALIGN; "KWORDS[1] :='ASCII '; KTOKEN[1] :=ASCII; "KWORDS[2] :='BLOCK '; SHA) AND NOT ODD(HASHB))); &END; $HASHB:=HASHA MOD HASHRANGE; {lo-order part} $HASHA:=HASHA DIV HASHRANGE; {hi-order part} $KTOKEN[2] :=BLOCK; "KWORDS[3] :='BYTE '; KTOKEN[3] :=BIGHT; "KWORDS[4] :='CONST '; KTOKEN[4] :=TCONST; HASHA:=ORD((NOT ODD(HASHA) AND ODD(HASHB)) OR /(ODD(HASHA) AND NOT ODD(HASHB))); {xor} $HASHA:=HASHA MOD HASHRANGE; $SYM:=HAS"KWORDS[5] :='EQU '; KTOKEN[5] :=EQU; "KWORDS[6] :='FUNC '; KTOKEN[6] :=FUNC; "KWORDS[7] :='PUBLIC '; KTOKEN[7] :=PUBH[HASHA]; $WHILE (NOT FOUND) AND (SYM<>NIL) DO &IF SYM^.NAME=ID THEN FOUND:=TRUE (ELSE SYM:=SYM^.LINK; $IF FOUND THEN WRITELLIC; "KWORDS[8] :='PRIVATE '; KTOKEN[8] :=PRIVATE; "KWORDS[9] :='PROC '; KTOKEN[9] :=PROC; "KWORDS[10]:='WORD '; KTOKENN('Opcode declared twice=',ID) &ELSE (BEGIN *NEW(SYM,UNKNOWN); {using UNKNOWN here is to save compile time space} *SYM^.NAME[10]:=WORD; "KWORDS[11]:='EXPAND '; KTOKEN[11]:=EXPAND; "KWORDS[12]:='MACRO '; KTOKEN[12]:=MACRODEF; "KWORDS[13]:='ENDM :=ID; SYM^.ATTRIBUTE:=OPFILE^.OPATRIB; *SYM^.OFFSETORVALUE:=OPFILE^.OPVALUE; ( SYM^.LINK:=HASH[HASHA]; *HASH[HASHA]:=SYM;  '; KTOKEN[13]:=MACROEND; "KWORDS[14]:='IF '; KTOKEN[14]:=CONDITION; "KWORDS[15]:='ENDC '; KTOKEN[15]:=CONDEND; "KWOR( IF DEBUG THEN WRITELN(ID,HASHA:10); (END; $GET(OPFILE); "UNTIL EOF(OPFILE); "EXPANDMACRO:=TRUE; "PARMCHECK:=FALSE; "CUDS[16]:='ELSE '; KTOKEN[16]:=TELSE; "KWORDS[17]:='REF '; KTOKEN[17]:=REF; "KWORDS[18]:='DEF '; KTOKEN[18]:=DEF; "KRRENTATRIB:=UNKNOWN; "BLOCKNO:=2; "ADVANCE:=TRUE; "MCSTKINDEX:=0; "SOURCE:=FILESOURCE; "BLOCKPTR:=1024; "LEXTOKEN:=ENDLINEWORDS[19]:='ORG '; KTOKEN[19]:=ORG; "KWORDS[20]:='INCLUDE '; KTOKEN[20]:=INCLUDE; "KWORDS[21]:='LIST '; KTOKEN[21]:=LIS;  TEMPTOP:=0;  END; "  BEGIN {Segment INITIALIZE} "(*$I-*) "OPFILENAME:=CONCAT(ASMNAME,'.OPCODES'); "OPFILENAME:=CONCA% ATTRIBUTE:=UNKNOWN; NULLREL.OFFSETORVALUE:=0; "RELOCATE:=NULLREL; "MARK(HEAP); {To initialize MEMAVAIL} "EXPRSSADVANCE:=TRUE; NOTSTRING:=TRUE; DEFMCHOOK:=FALSE; "ALTINPUT:=FALSE; SYMLAST:=FALSE; FROMPUTWORD:=FALSE; "LC:=0; LASTLC:=0; LOWLC:=0; ALC:=0; "CONDINDEX:=-1; "PROCNAME:=' '; "PAGENO:=0; "TITLELINE:=' '; "IF DISPLAY THEN $BEGIN &WRITELN(LISTFILE,'PAGE - ',PAGENO:3); " PAGENO:=PAGENO + 1; $END; "(*$I-*) "REWRITE(SCRATCH,'*LINKER.INFO'); LINKEND:=0; &EXIT(TLA); $END; "FOR COUNT:=0 TO 79 DO BLANKLINE[COUNT]:=CHR(0); "TEXTLINE:=BLANKLINE; "WRITELN(ASMNAME,' Assembler'); "IOCHECK(TRUE); "(*$I+*) "NEW(SYM,UNKNOWN); {extra record on heap to garbage} "LEXINIT; "IF NOT (CONSOLE AND DISPLAY) THE; "FOR COUNT:=0 TO CODESIZE DO BLANKCODE[COUNT]:=' '; "CODE:=BLANKCODE; CODECOUNT:=0; HEXCHAR:='0123456789ABCDEF';  BUFFERPN $BEGIN &WRITELN; &WRITE('< 0>');  END; "CODESECTION:=P;  END;  OS:=0; NUMERRORS:=0;  TAB:=CHR(9); "LINENUM:=0; SPCIALSTKINDEX:=-1; PROCNUM:=0; LISTNUM:=0;  IF LENGTH(USERINFO.WORKTITLE)=0 THEN $FIRSTFNAME:=USERINFO.SYMTITLE "ELSE $FIRSTFNAME:=USERINFO.WORKTITLE; "CURFNAME:=FIRSTFNAME; "REPEAT $WRITE('Output file for assembled listing: ( for none)'); $READLN(LISTNAME); $DISPLAY:=(LISTNAME<>''); LISTING:=DISPLAY; $CONSOLE:=(LISTNAME='CONSOLE:') OR (LISTNAME='#1:'); $IF DISPLAY THEN &IF CONSOLE THEN (OPENNEW(LISTFILE,'CONSOLE:') &ELSE (OPENNEW(LISTFILE,CONCAT(LISTNAME,'.TEXT[*]')); " OK:=(IORESULT=0); $IOCHECK(FALSE); "UNTIL OK; "(*$I+*) "IF NOT RELEASEVERSION THEN $BEGIN &WRITELN('Relocation info at file end?'); &READ(KEYBOARD,CH); &JUMPINFO:=(CH='Y') OR (CH='y'); " END 1 2 LLO^"ELSE JUMPINFO:=TRUE; "FOR COUNT:=1 TO 9 DO WRITELN; "NULLREL.TIPE:=NOTSET; NULLREL.TEMPLABEL:=0; NULLREL.SYM:=NIL; "NULLREL.& EN &BEGIN (NEW(NEWDUMP); (NEWDUMP^.RLINK:=NIL; (NEWDUMP^.LLINK:=NIL; (NEWDUMP^.SYM:=SYM; (SYMDUMP^.RLINK:=NEWDUMP; &END IBUTE OF ,LABELS,ABS,MACROS,PUBLICS,PRIVATES,CONSTS,REFS,DEFS, ,PROCS,FUNCS,UNKNOWN: .ALPHABETIZE(TOPOFDUMP); *END; *SYM:=S$ELSE ALPHABETIZE(SYMDUMP^.RLINK) "ELSE  IF SYMDUMP^.LLINK=NIL THEN &BEGIN (NEW(NEWDUMP); (NEWDUMP^.RLINK:=NIL; (NEWDUYM^.LINK; (END; $END; "SAVETITLE:=TITLELINE; "TITLELINE:='SYMBOLTABLE DUMP'; "PRINTPAGE; "IF PROCNUM=1 THEN $BEGIN &WRIMP^.LLINK:=NIL; (NEWDUMP^.SYM:=SYM; (SYMDUMP^.LLINK:=NEWDUMP; &END $ELSE ALPHABETIZE(SYMDUMP^.LLINK);  END;   PROCEDURE TELN(LISTFILE, *'AB - Absolute LB - Label UD - Undefined MC - Macro'); &WRITELN(LISTFILE, *'RF - Ref DF DUMPTABLE(SYMDUMP:SYMDUMPPTR);  BEGIN  IF SYMDUMP^.LLINK<>NIL THEN DUMPTABLE(SYMDUMP^.LLINK); "SYM:=SYMDUMP^.SYM; - Def PR - Proc FC - Func'); &WRITELN(LISTFILE, *'PB - Public PV - Private CS - Consts'); &WRITELN(LIS"WRITE(LISTFILE,SYM^.NAME); "CASE SYM^.ATTRIBUTE OF )ABS:MSSG:=' AB '; &LABELS:MSSG:=' LB '; 'PROCS:MSSG:=' PR '; 'FUNCS:MTFILE); &WRITELN(LISTFILE); &LISTNUM:=LISTNUM + 5; $END; "DUMPCOUNT:=0; "IF LISTRADIX=8 THEN $BEGIN &FILL:='------| '; SSG:=' FC '; %PUBLICS:MSSG:=' PB '; $PRIVATES:MSSG:=' PV '; (REFS:MSSG:=' RF '; (DEFS:MSSG:=' DF '; %UNKNOWN:MSSG:=' UD '; &SCREENWIDTH:=3; &PAGEWIDTH:=6; $END; "IF LISTRADIX=16 THEN $BEGIN &FILL:='----| '; &SCREENWIDTH:=4; &PAGEWIDTH:=7 $END&MACROS:MSSG:=' MC ' $END; "WRITE(LISTFILE,MSSG); "IF (SYM^.ATTRIBUTE=ABS) OR (SYM^.ATTRIBUTE=LABELS) THEN $BEGIN &PRINTNU; "DUMPTABLE(TOPOFDUMP^.RLINK); "TITLELINE:=SAVETITLE; "WRITELN(LISTFILE); "LISTNUM:=LISTNUM + 1; "PRINTPAGE; M(SYM^.OFFSETORVALUE,FALSE); &WRITE(LISTFILE,'| '); " END "ELSE $WRITE(LISTFILE,FILL); "DUMPCOUNT:=DUMPCOUNT + 1; "IF ((DUMPCOUNT MOD PAGEWIDTH=0) AND NOT CONSOLE) "OR ((DUMPCOUNT MOD SCREENWIDTH=0) AND CONSOLE) THEN $BEGIN &WRITELN(LISTFILE);  {start of ASM2}  {Copyright (c) 1978 Regents of the University of California}    SEGMENT P&LISTNUM:=LISTNUM + 1; &IF (LISTNUM MOD PAGESIZE=0) THEN PRINTPAGE; $END;  IF SYMDUMP^.RLINK<>NIL THEN DUMPTABLE(SYMDUMP^.RROCEDURE SYMTBLDUMP;  TYPE SYMDUMPPTR=^SYMDUMPTYPE; &SYMDUMPTYPE=RECORD *SYM:SYMTABLEPTR; *LLINK,RLINK:SYMDUMPPTR (END;  LINK);  END;   BEGIN{SYMTBLDUMP}  MARK(HEAP); "IF LEXTOKEN=TEND THEN $BEGIN &PRINTLINE; &TEXTLINE:=BLANKLINE; $END;   VAR HEAP:^INTEGER; %BUCKET,DUMPCOUNT,SCREENWIDTH,PAGEWIDTH:INTEGER; %TOPOFDUMP,NEWDUMP:SYMDUMPPTR; %SAVETITLE,FILL,MSSG:S"NEW(SYM); "SYM^.NAME:=' '; "NEW(TOPOFDUMP); "TOPOFDUMP^.SYM:=SYM; "TOPOFDUMP^.LLINK:=NIL; TRING;   PROCEDURE ALPHABETIZE(SYMDUMP:SYMDUMPPTR);  BEGIN "IF SYM^.NAME>SYMDUMP^.SYM^.NAME THEN $IF SYMDUMP^.RLINK=NIL TH"TOPOFDUMP^.RLINK:=NIL; "FOR BUCKET:=0 TO HASHTOP DO $BEGIN &SYM:=HASH[BUCKET]; &WHILE SYM<>NIL DO (BEGIN *CASE SYM^.ATTR' T:(LWORD,LBYTE,LBIG); @NREFS:INTEGER; @NWORDS:INTEGER); 4LGLOBALDEF:(PROCNUM:INTEGER; @CODEOFFSET:INTEGER); -LSEPPROC,LSEPF&BUFFERPOS:=NEWPOS MOD 512; $END "ELSE BUFFERPOS:=NEWPOS - BUFBOTTOM; "IOCHECK(TRUE); "(*$I+*)  END;  PROCEDURE PUTJUMPSUNC:(FUNCNUM:INTEGER; @NPARAMS:INTEGER)); /2:(CLASS:INTEGER; 2CASE BOOLEAN OF 7TRUE:(JUMPS:JTABREC); 6FALSE:(FWDREF:BACKLAB;   PROCEDURE PUTJUMP(CLASS:INTEGER; VAR JUMP:JTABREC);  VAR I,COUNT,LINKCOUNT:INTEGER;  BEGIN "COUNT:=0; "IF JUMPINFO THEL)) *END;   VAR COUNT,PROCOFFSET,OUTBLKS:INTEGER; %SWAPLC:WORDSWAP; %SEGDICT:PACKED ARRAY[0..511] OF CHAR;  LINKINEN $BEGIN &IF LINKEND<>SCRATCHEND THEN (BEGIN *SEEK(LINK,LINKEND); *FOR LINKCOUNT:=LINKEND+1 TO SCRATCHEND DO ,BEGIN .GETFO:FILE; %LINK:FILE OF LINKREC; %VIEWDUMMY:ARRAY[0..0] OF INTEGER; %  PROCEDURE PROCEDE;   PROCEDURE BUFRESET(NEWPOS:INTE(LINK); .IF LINK^.CLASS=CLASS THEN 0FOR I:=0 TO 6 DO 2IF LINK^.JUMPS[I]<>0 THEN 4BEGIN 6PUTWORD(BUFFERTOP - LINK^.JUMPS[I]GER);  VAR OUTBLKS:INTEGER;  BEGIN "(*$I-*) "IF DEBUG THEN WRITELN('Bufreset'); "IF NEWPOS0 THEN *BEGIN ,PUTWORD(BUFFERTOP - JUMP[I]); $ OUTBLKS:=(BUFFERTOP DIV 512 - OUTBLKNO) + 1; &IF OUTBLKS>BUFBLKS THEN OUTBLKS:=BUFBLKS; &IF BLOCKWRITE(USERINFO.WORKCODE^,,COUNT:=COUNT + 1; *END; $END; "PUTWORD(COUNT);  END;   BEGIN {Putjumps} "PUTJUMP(1,JUMP1); {Jumptable entries} "PUTJBUFFER^,OUTBLKS,OUTBLKNO)=0 THEN; &IF OUTBLKNO + OUTBLKS>OUTBLKTOP THEN (OUTBLKTOP:=OUTBLKNO + OUTBLKS; $ OUTBLKNO:=NEWPOS DUMP(2,JUMP2); "PUTJUMP(3,JUMP3);  END;   PROCEDURE LINKSET;  VAR BUCKET:INTEGER;  BEGIN "IF DEBUG THEN WRITELN('Linkset'IV 512; &IF IORESULT=0 THEN IF BLOCKREAD(USERINFO.WORKCODE^,BUFFER^,BUFBLKS,OUTBLKNO)=0 THEN; &BUFBOTTOM:=OUTBLKNO*512; &BUFF); "IF SCRATCHEND<>0 THEN SEEK(LINK,LINKEND); {ie. file not of length 0} "FOR BUCKET:=0 TO HASHTOP DO $BEGIN ERPOS:=NEWPOS MOD 512; $END "ELSE IF NEWPOS>BUFBOTTOM + BUFLIMIT THEN $BEGIN $ OUTBLKS:=(BUFFERTOP DIV 512 - OUTBLKNO) + 1;&SYM:=HASH[BUCKET]; &WHILE SYM<>NIL DO (BEGIN *CASE SYM^.ATTRIBUTE OF (UNKNOWN: ,BEGIN .IF DISPLAY THEN 0BEGIN 2WRITELN &IF OUTBLKS>BUFBLKS THEN OUTBLKS:=BUFBLKS; $ IF BLOCKWRITE(USERINFO.WORKCODE^,BUFFER^,OUTBLKS,OUTBLKNO)=0 THEN; &IF OUTBLKN(LISTFILE); 2WRITE(LISTFILE,'>>>>>',SYM^.NAME); 2LISTNUM:=LISTNUM + 1; 0END; .IF NOT (CONSOLE AND DISPLAY) THEN 0BEGIN 2WR"RELEASE(HEAP);  END;     SEGMENT PROCEDURE PROCEND;  TYPE LITYPES=(INVALID,LMODULE,LGLOBALREF,LPUBLIC,LPRIVATE,LCONO + OUTBLKS>OUTBLKTOP THEN (OUTBLKTOP:=OUTBLKNO + OUTBLKS; $ OUTBLKNO:=NEWPOS DIV 512; &IF OUTBLKNO>=OUTBLKTOP THEN (BEGIN STANT, 1LGLOBALDEF,LPUBLICDEF,LCONSTDEF,LEXTPROC,LEXTFUNC, 1LSEPPROC,LSEPFUNC); 'LINKREC=RECORD CASE INTEGER OF /0:(REFS:ARR*IF IORESULT=0 THEN ,IF BLOCKWRITE(USERINFO.WORKCODE^,BUFFER^,OUTBLKNO-OUTBLKTOP,OUTBLKTOP)=0 THEN; *OUTBLKTOP:=OUTBLKNO; (EAY[0..7] OF INTEGER); + 1:(NAME:PACKNAME; 2CASE LITYPE:LITYPES OF 4LMODULE,LPUBLIC,LPRIVATE,LCONSTANT,LGLOBALREF: ?(FORMAND &ELSE (IF IORESULT=0 THEN *IF BLOCKREAD(USERINFO.WORKCODE^,BUFFER^,BUFBLKS,OUTBLKNO)=0 THEN; &BUFBOTTOM:=OUTBLKNO*512; ( ITELN; 2WRITE('>>>>>',SYM^.NAME); . END; .ERROR(1{Undefined label}); ,END; (PUBLICS,PRIVATES,CONSTS,REFS,DEFS,PROCS,FUNCS:K^.CODEOFFSET:=0; {proc's start at LC=0} 4PUT(LINK); 4LINKEND:=LINKEND + 2; 2END .END;  {Linkfile info} ,BEGIN .FILLCHAR(LINK^,SIZEOF(LINKREC),0); .CASE SYM^.ATTRIBUTE OF 0PUBLICS:LINK^.LITYPE:=LPUBLIC; 0PRIVAT.IF DEBUG THEN WRITELN('link entry:',SYM^.NAME); ,END; ( END; *SYM:=SYM^.LINK; (END; $END;  END; $  PROCEDURE LABELFIXES:LINK^.LITYPE:=LPRIVATE; 0CONSTS:LINK^.LITYPE:=LCONSTANT; 0REFS:LINK^.LITYPE:=LGLOBALREF; 0DEFS:LINK^.LITYPE:=LGLOBALDEF; ; {fix label forward references}  VAR SWAP:WORDSWAP;  FWDREF:BACKLABEL;  LINKCOUNT:INTEGER;  KLUDGEPTR:^0PROCS:LINK^.LITYPE:=LSEPPROC; 0FUNCS:LINK^.LITYPE:=LSEPFUNC .END; .LINK^.NAME:=SYM^.NAME; .CASE SYM^.ATTRIBUTE OF 0PUBLICSINTEGER;  BEGIN "RESET(LINK,'*LINKER.INFO'); "MARK(KLUDGEPTR); "IF (LINKEND<>0) AND (SCRATCHEND<>LINKEND) THEN $BEGIN &SEE,PRIVATES,CONSTS,REFS: 2BEGIN 4LINK^.FORMAT:=LWORD; 4LINK^.NREFS:=SYM^.NREFS; 4LINK^.NWORDS:=SYM^.NWORDS; 4LINKEND:=LINKENDK(LINK,LINKEND); " GET(LINK); $END; "FOR LINKCOUNT:=LINKEND+1 TO SCRATCHEND DO $BEGIN &IF LINK^.CLASS=0 THEN (BEGIN *F + 1; 4PUT(LINK); COUNT:=0; 4WHILE SYM^.LINKOFFSET<>NIL DO 6BEGIN 8LINK^.REFS[COUNT]:=SYM^.LINKOFFSET^.PCOFFSET; WDREF:=LINK^.FWDREF; *BUFRESET(FWDREF.OFFSET); *PATCHCODE(FWDREF,FWDREF.OFFSET-BUFBOTTOM); (END; &GET(LINK); $END;  END; 8COUNT:=COUNT + 1; 8IF COUNT=8 THEN :BEGIN 0 THEN 6BEGIN 8PUT(LINK); 8LINKEND:=LINKEND + 1; 6EN"LLCHECK; "CLOSE(SCRATCH,LOCK); "LABELFIX; "BUFRESET(MAXBUFTOP); "BUFFERTOP:=BUFBOTTOM + BUFFERPOS; {BUFRESET doesn't affectD; 2END; 0DEFS: 2IF SYM^.CODEOFFSET=-1 THEN 4BEGIN 6WRITELN(LISTFILE); 6IF DISPLAY THEN WRITE(LISTFILE,SYM^.NAME); 6IF NO BUFFERTOP} "IF ODD(BUFFERPOS) THEN PUTBYTE(0); "RELOCATE:=NULLREL; "PUTJUMPS; {Jumptable entries} T (CONSOLE AND DISPLAY) THEN 8BEGIN :WRITELN; :WRITE(SYM^.NAME); 6 END; 6ERROR(1{Undefined label}); 4END 2ELSE 4BEGIN "PUTWORD(BUFFERTOP - PROCSTART); {Enter IC} "PUTWORD(0); {Proc #, Lex level} "LINKSET; "PROCTABLE[6LINK^.LITYPE:=LGLOBALDEF; 6LINK^.PROCNUM:=SYM^.PROCNUM; 6LINK^.CODEOFFSET:=SYM^.CODEOFFSET; 6LINKEND:=LINKEND + 1; PUT(LINK)PROCNUM]:=BUFFERTOP - PROCSTART; "SEGSIZE:=SEGSIZE + BUFFERTOP - PROCSTART; "HASH:=HASHRES; "RELEASE(HEAP);  END;   PROCE; 4END; 0PROCS,FUNCS: 2BEGIN 4IF SYM^.ATTRIBUTE=PROCS THEN LINK^.LITYPE:=LSEPPROC 6ELSE LINK^.LITYPE:=LSEPFUNC; 4LINK^.FUNDURE FIRSTPROC; {Set up the buffer for output assembled code}  VAR BUFSETUP:^BUFFERTYPE;  BEGIN "IF DEBUG THEN WRITELN('ProCNUM:=SYM^.FUNCNUM; 4LINK^.NPARAMS:=SYM^.NPARAMS; 4PUT(LINK); 4LINK^.LITYPE:=LGLOBALDEF; 4LINK^.PROCNUM:=SYM^.FUNCNUM; 4LINcstart'); "NEW(BUFSETUP); BUFFER:=BUFSETUP; "HASHRES:=HASH; {For symboltable cutback} "FOR COUNT:=2 TO BUFBLKS DO $NEW(BUFSE) ID; LINKEND:=LINKEND + 1; &PUT(LINK); CLOSE(LINK,LOCK); &RESET(LINKINFO,'*LINKER.INFO'); &COUNT:=((LINKEND*16) + 511) DIV 5IL; &FREELABEL:=NIL; &PROCSTART:=BUFFERTOP; &IF LEXTOKEN=PROC THEN CURRENTATRIB:=PROCS (ELSE CURRENTATRIB:=FUNCS; &LEX; &I12; &IF IORESULT=0 THEN (IF BLOCKREAD(LINKINFO,BUFFER^,COUNT)=0 THEN; F LEXTOKEN<>TIDENTIFIER THEN ERROR(3{Must have procedure name}) (ELSE *BEGIN ,IF PROCNUM=1 THEN SEGNAME:=SYM^.NAME; ,PROCNAM&FILLCHAR(BUFFER^[LINKEND*16],512,0); {for easier linkinfo debugging} &IF IORESULT=0 THEN (IF BLOCKWRITE(USERINFO.WORKCODE^,BE:=SYM^.NAME; ,SYM^.FUNCNUM:=PROCNUM; ,LEX; ,IF LEXTOKEN=COMMA THEN .BEGIN 0LEX; 0IF LEXTOKEN<>CONSTANT THEN 3ERROR(4{NumTUP); "FILLCHAR(BUFFER^,BUFLIMIT,0);{Clear buffer to aid DEBUGGING} "IF DISPLAY THEN WRITELN(LISTFILE, ,BUFBLKS,' blocks for UFFER^,COUNT,OUTBLKNO)=0 THEN; &FILLCHAR(SEGDICT,SIZEOF(SEGDICT),0); &SEGDICT[4]:=CHR(1); {Pointer to starting block} &procedure code ',MEMAVAIL,' words left'); "IF NOT (DISPLAY AND CONSOLE) THEN $BEGIN &WRITELN; &WRITELN(BUFBLKS,' blocks forSWAPLC.HWORD:=SEGSIZE; {Segsize} &IF HIBYTEFIRST THEN (BEGIN ( SEGDICT[6]:=CHR(SWAPLC.HIBYTE); *SEGDICT[7]:=CHR(SWAPLC.L procedure code ',MEMAVAIL,' words left'); " WRITE('<',LINENUM:4,'>'); $END; "BUFBOTTOM:=512; BUFFERTOP:=512; MAXBUFTOP:=OWBYTE); (END &ELSE (BEGIN ( SEGDICT[6]:=CHR(SWAPLC.LOWBYTE); *SEGDICT[7]:=CHR(SWAPLC.HIBYTE); (END; &FILLCHAR(SEGDICT[6512; "OUTBLKNO:=1; OUTBLKTOP:=1; "BUFFERPOS:=0; SEGSIZE:=0; "FILLCHAR(PROCTABLE,SIZEOF(PROCTABLE),0); "(*$I-*) 4],128,' '); &FOR COUNT:=72 TO 79 DO (SEGDICT[COUNT]:=SEGNAME[COUNT-72]; &SEGDICT[194]:=CHR(4); {Segment type SEPRTSEG} &I"IF BLOCKWRITE(USERINFO.WORKCODE^,BUFFER^,1)=0 THEN; {Segment dictionary} "IOCHECK(TRUE); "(*$I+*)  END;   BEGIN {SegmentF IORESULT=0 THEN IF BLOCKWRITE(USERINFO.WORKCODE^,SEGDICT,1,0)=0 THEN; &IF LISTING AND NOT CONSOLE THEN PAGE(LISTFILE); &IF L Procend} "IF VIEWSTACK THEN UNITWRITE(3,VIEWDUMMY[-1600],35); {reset display of heap} "IF DEBUG THEN WRITELN('Procend'); "IFISTING THEN CLOSE(LISTFILE,LOCK); &CLOSE(LINKINFO,PURGE); $ IOCHECK(TRUE); &UNITCLEAR(3); &(*$I+*) &WRITELN; &WRITELN('As PROCNUM>0 THEN PROCEDE $ELSE FIRSTPROC;  IF LEXTOKEN=TEND THEN  BEGIN &PROCOFFSET:=2; {Procedure table} &FOR COUsembly complete:',LINENUM:10,' lines'); &WRITELN(NUMERRORS:6,' Errors flagged on this Assembly'); $END "ELSE $BEGIN NT:=PROCNUM DOWNTO 1 DO (BEGIN *PUTWORD(PROCOFFSET); *PROCOFFSET:=PROCOFFSET + PROCTABLE[COUNT] + 2; (END; &PUTBYTE(1); &MARK(HEAP); &PROCNUM:=PROCNUM + 1; &LC:=0; LASTLC:=0; LOWLC:=0; &FILLCHAR(JUMP1,SIZEOF(JUMP1),0); JCOUNT1:=0; &FILLCHAR(J {Segment #} &PUTBYTE(PROCNUM); {# of Procedures} &SEGSIZE:=PROCOFFSET; &COUNT:=(BUFFERPOS + 511) DIV 512; UMP2,SIZEOF(JUMP2),0); JCOUNT2:=0; &FILLCHAR(JUMP3,SIZEOF(JUMP3),0); JCOUNT3:=0; &SCRATCHEND:=LINKEND; &IF PROCNUM>1 THEN &(*$I-*) &IF BLOCKWRITE(USERINFO.WORKCODE^,BUFFER^,COUNT,OUTBLKNO)=0 THEN; &OUTBLKNO:=OUTBLKNO + COUNT; &LINK^.LITYPE:=INVAL(BEGIN *CLOSE(LINK,LOCK); *RESET(SCRATCH,'*LINKER.INFO'); *SEEK(SCRATCH,LINKEND); (END; &NEW(FULLLABEL); FULLLABEL^.NEXT:=N* OOLEAN;  VAR ISEQUAL,CHECKEQUAL:BOOLEAN; %STRSAVE:STRING; %INTSAVE:INTEGER;  BEGIN "LEX; "IF LEXTOKEN=TSTRING THEN $BEGIN &STRSAVE:=STRVAL; &LEX; &CHECKEQUAL:=(LEXTOKEN=EQUAL); &IF NOT CHECKEQUAL THEN (IF LEXTOKEN<>NOTEQUAL THEN ERROR(62{'=' or '<>' expected}); &LEX; &IF LEXTOKEN=TSTRING THEN (BEGIN *ISEQUAL:=(STRVAL=STRSAVE); *CONDTRUE:=(CHECKEQUAL=ISEQUAL); (EN1 2 3 4 O^D &ELSE (BEGIN *ERROR(46{string expected}); *CONDTRUE:=TRUE; (END; &LEX; $END "ELSE $BEGIN &EXPRSSADVANCE:=FALSE; &IF EXPRESS(TRUE) THEN (IF SPCIALSTKINDEX=-1 THEN *CONDTRUE:=(RESULT.OFFSETORVALUE<>0) (ELSE *BEGIN ,INTSAVE:=RESULT.OFFSETORVALUE; ,CHECKEQUAL:=(SPECIALSTK[SPCIALSTKINDEX]=EQUAL); ,SPCIALSTKINDEX:=SPCIALSTKINDEX-1; ,IF EXPRESS(TRUE) THEN .BEGIN ber of parameters expected}) 0ELSE SYM^.NPARAMS:=CONSTVAL; 0LEX; .END ELSE SYM^.NPARAMS:=0; *END; &CODE:=BLANKCODE; CODECOUNT:=0; &IF DISPLAY THEN PRINTPAGE; &IF (LEXTOKEN<>ENDLINE) AND (LEXTOKEN<>TEOF) THEN (BEGIN *ERROR(5{extra garbage on line}); *WHILE (LEXTOKEN<>ENDLINE) AND (LEXTOKEN<>TEOF) DO LEX; (END; &PRINTLINE; &TEXTLINE:=BLANKLINE; &TEXTINDEX:=-1; &CURRENTATRIB:=UNKNOWN; $END;  END;    {start of ASM3}  {Copyright (c) 1978 Regents of University of California} (  SEGMENT PROCEDURE ASSEMBLE;  VAR VIEWDUMMY:ARRAY[0..0] OF INTEGER;   PROCEDURE ZCOND;  VAR I,CURRENT:INTEGER;   FUNCTION CONDTRUE:B+  EXIT(ZCOND); (GETCHAR; (IF TEXTINDEX>79 THEN ERROR(6{input line over 80 chars}); (IF CH=CHR(13) THEN *BEGIN ,TEXTLINE:=BLA(ENTRY^.VALUE:=ENTRY^.VALUE DIV 2; &IF (BUFINDEX>=0) AND (BUFINDEXUNKNOWN THEN (BEGIN *SYMLAST:=FALSE; *IF SYM^.ATTRIBUTE=DEFS THEN ,BEGIN .SYM^.CODEOFFSET:=LC; .ENTRY:=SYMent from ENDLINE} &LEX; $END;  END; &  PROCEDURE ZELSE;  VAR I,CURRENT:INTEGER;  BEGIN "CURRENT:=CONDINDEX; ID:=' ^.DEFFWDREF; ,END *ELSE ,ERROR(9{identifier previously declared}); (END &ELSE (BEGIN *IF CODESECTION=A THEN ,BEGIN .SYM '; I:=0; "PRINTLINE; "REPEAT $GETCHAR; $IF TEXTINDEX>79 THEN ERROR(6{input line over 80 chars}); $IF CH=CHR(13) THEN &^.ATTRIBUTE:=ABS; .SYM^.OFFSETORVALUE:=ALC; ,END *ELSE ,BEGIN .SYM^.ATTRIBUTE:=LABELS; .SYM^.OFFSETORVALUE:=LC; ,END; BEGIN (TEXTLINE:=BLANKLINE; TEXTINDEX:=-1; $ END $ELSE IF CH='.' THEN &BEGIN (I:=0; (ID:=' '; &END $ELSE IF I<5 *SYMLAST:=TRUE; *LASTSYM:=SYM; *IF (CODESECTION=A) AND (ENTRY<>NIL) THEN ,ERROR(8{must be declared in ASECT before used}) +THEN &BEGIN (ID[I]:=CH; (I:=I + 1; &END; $IF ID='IF ' THEN &CONDINDEX:=CONDINDEX + 1 $ELSE IF ID='ENDC ' THEN &IELSE ENTRY:=SYM^.FWDREF; (END; $END "ELSE $BEGIN {Processing a local label} &SYMLAST:=FALSE; &IF CODESECTION=A THEN (ERR0ISEQUAL:=(RESULT.OFFSETORVALUE=INTSAVE); 0CONDTRUE:=(CHECKEQUAL=ISEQUAL); .END ,ELSE CONDTRUE:=TRUE; *END &ELSE CONDTRUE:F CONDINDEX<0 THEN (BEGIN *ERROR(7{Not enough ifs}); *EXIT(ZCOND); (END &ELSE CONDINDEX:=CONDINDEX - 1; "UNTIL (CURRENT=CO=TRUE;  END;  END;   BEGIN  CONDINDEX:=CONDINDEX + 1; "CURRENT:=CONDINDEX; "IF NOT CONDTRUE THEN $BEGIN &IF (LEXNDINDEX + 1) AND (ID='ENDC ');  LEX;  END;   PROCEDURE COREFIX(ENTRY:BKLABELPTR; ADDVALUE:INTEGER);  VAR BUFINDEX:ITOKEN<>ENDLINE) AND (LEXTOKEN<>TEOF) THEN (BEGIN *ERROR(5{Extra garbage on line}); *WHILE (LEXTOKEN<>ENDLINE) AND (LEXTOKEN<>NTEGER; &NEXTENTRY:BKLABELPTR; &PRINTLC:WORDSWAP;  BEGIN "WHILE ENTRY<>NIL DO $BEGIN &NEXTENTRY:=ENTRY^.NEXT; TEOF) DO LEX; (END; &PRINTLINE; ID:=' '; I:=0; &TEXTLINE:=BLANKLINE; TEXTINDEX:=-1; &REPEAT (IF LEXTOKEN=TEOF THEN&BUFINDEX:=ENTRY^.OFFSET-BUFBOTTOM; &ENTRY^.VALUE:=ENTRY^.VALUE + ADDVALUE; &IF (NOT WORDADDRESSED) AND (ENTRY^.WORDLC) THEN , ELSE (BEGIN *TEMP[TEMPLABEL].TEMPATRIB:=LABELS; *TEMP[TEMPLABEL].DEFOFFSET:=LC; *ENTRY:=TEMP[TEMPLABEL].FWDREF; *TEMP[TEMPL*IF RELOCATE.TIPE=LLREL THEN ,IF TEMP[RELOCATE.TEMPLABEL].TEMPATRIB=UNKNOWN THEN .ERROR(63) ,ELSE LASTSYM^.ATTRIBUTE:=LABELSABEL].FWDREF:=NIL; (END; $END; "IF LEXTOKEN=TLABEL THEN LLCHECK; "LEX; "IF LEXTOKEN<>EQU THEN COREFIX(ENTRY,LC);  END;   *ELSE IF RELOCATE.TIPE=LABELREL THEN ,IF (RELOCATE.SYM^.ATTRIBUTE=LABELS) OR .((RELOCATE.SYM^.ATTRIBUTE=DEFS) AND /(RELOCAT PROCEDURE ZALIGN;  {Align handles the .Align psuedo-op. The operand represents the !boundary multiple on which the next desiE.SYM^.CODEOFFSET<>-1)) THEN 1LASTSYM^.ATTRIBUTE:=LABELS ,ELSE ERROR(63{may not EQU to undefined labels}) *ELSE LASTSYM^.ATTRred code is to start.}  VAR OFFSET,I:INTEGER;  BEGIN "IF EXPRESS(TRUE) THEN $BEGIN &OFFSET:=LC MOD RESULT.OFFSETORVALUE; &IBUTE:=RESULT.ATTRIBUTE (ELSE *LASTSYM^.ATTRIBUTE:=RESULT.ATTRIBUTE; (LASTSYM^.OFFSETORVALUE:=RESULT.OFFSETORVALUE; (IF LASTIF OFFSET>0 THEN (BEGIN *OFFSET:=RESULT.OFFSETORVALUE - OFFSET; *IF WORDADDRESSED THEN ,FOR I:=1 TO OFFSET DO PUTWORD(0) SYM^.FWDREF<>NIL THEN *IF LASTSYM^.ATTRIBUTE=LABELS THEN ,COREFIX(LASTSYM^.FWDREF,LASTSYM^.OFFSETORVALUE) *ELSE ,ERROR(12{mu*ELSE ,FOR I:=1 TO OFFSET DO PUTBYTE(0); $ END; $END;  END;   PROCEDURE ZASCII;  VAR STRINGSIZE,COUNT:INTEGER;  BEGst EQU before use if not a label}); &END;  SYMLAST:=FALSE;  END;   PROCEDURE ZDEFMACRO;  VAR I:INTEGER;  BEGIN "CURRIN "LEX; "IF LEXTOKEN=TSTRING THEN $BEGIN &STRINGSIZE:=LENGTH(STRVAL); &FOR COUNT:=1 TO STRINGSIZE DO (BEGIN *IF DISPLAY ENTATRIB:=MACROS;  IF SOURCE<>FILESOURCE THEN $ERROR(61{nested Macro definitions are senseless}) "ELSE $BEGIN &LEX; &IF THEN ,IF (COUNT MOD BYTEFIT=1) AND (COUNT<>1) THEN .BEGIN 0PRINTLINE; 0TEXTLINE:=BLANKLINE; .END; *PUTBYTE(ORD(STRVAL[COUNNOT (LEXTOKEN IN [OP1,OP2,OP3,OP4,OP5,OP6,OP7,OP8,OP9,OP10, T])); $ END; $END "ELSE $ERROR(10{improper format}); "LEX;  END;   PROCEDURE ZEQU;  BEGIN "IF LEXTOKEN=TIDENTIFIER&OP11,OP12,OP13,OP14,OP15,OP16,OP17,OP18,OP19,OP20,TIDENTIFIER]) THEN ( ERROR(13{macro identifier expected}); &SYM^.EXPANDMCR THEN $IF SYM^.ATTRIBUTE<>UNKNOWN THEN &BEGIN (ERROR(9{identifier previously declared}); (SYMLAST:=FALSE; &END $ELSE &BEGO:=EXPANDMACRO; &SYM^.ATTRIBUTE:=MACROS; &NEW(MCPTR); SYM^.MACRO:=MCPTR; {puts macro on heap} &REPEAT GETCHAR; UNTIL CHIN (SYM^.ATTRIBUTE:=LABELS; (LASTSYM:=SYM; (LEX; (IF LEXTOKEN<>EQU THEN *BEGIN ,ERROR(11{EQU expected}); & SYMLAST:==CHR(13); &ADVANCE:=FALSE; &MACROINDEX:=0; I:=0; ID:=' '; &DEFMCHOOK:=TRUE; &REPEAT (IF MACROINDEX>MACROSIZE THEN FALSE; *END & ELSE SYMLAST:=TRUE; &END; "IF NOT SYMLAST THEN $ERROR(9{identifier previously declared}) "ELSE $IF EXPRESS*BEGIN ,NEW(MCPTR); ,MACROINDEX:=0; *END; (GETCHAR; (IF TEXTINDEX>79 THEN ERROR(6{input line over 80 chars}); (MCPTR^[MACOR(44{no local labels in ASECT}) &ELSE IF TEMP[TEMPLABEL].TEMPATRIB<>UNKNOWN THEN (ERROR(9{identifier previously declared}) &(TRUE) THEN &BEGIN (IF CODESECTION=A THEN *LASTSYM^.ATTRIBUTE:=ABS (ELSE IF RELOCATE<>NULLREL THEN - FALSE) THEN (IF CHECKOPERAND(TRUE,FALSE,FALSE,0,0) THEN *INITVALUE:=RESULT.OFFSETORVALUE; &PUTWORD(INITVALUE); BLIC:CURRENTATRIB:=PUBLICS; $PRIVATE:CURRENTATRIB:=PRIVATES; $REF:CURRENTATRIB:=REFS; $DEF:CURRENTATRIB:=DEFS "END; "REPEAT&IF DISPLAY THEN (BEGIN *COUNT:=COUNT + 1; *IF (COUNT MOD WORDFIT=0) AND (LEXTOKEN=COMMA) THEN ,BEGIN .PRINTLINE; .FILLCH $LEX; $IF LEXTOKEN<>TIDENTIFIER THEN &ERROR(16{Expected identifier}) $ELSE &BEGIN (IF SYM^.ATTRIBUTE<>CURRENTATRIB THEN ROINDEX]:=CH; (IF CH=CHR(13) THEN *BEGIN ,PRINTLINE; ,TEXTLINE:=BLANKLINE; TEXTINDEX:=-1; *END (ELSE IF CH='.' THEN *BEGIAR(TEXTLINE[2],70,' '); ,END; & END; $UNTIL LEXTOKEN<>COMMA;  END;   PROCEDURE ZBYTE;  VAR INITVALUE:WORDSWAP;  N ,I:=0; ,ID:=' '; *END (ELSE IF I<5 THEN *BEGIN ,ID[I]:=CH; ,I:=I + 1; *END; (MACROINDEX:=MACROINDEX + 1; &UNTCOUNT:INTEGER;  BEGIN "IF WORDADDRESSED THEN $ERROR(14{word addressed only}) "ELSE IF CODESECTION=A THEN $BEGIN &ALC:=ALC+IL ID='ENDM '; &IF MACROINDEX<=MACROSIZE THEN MCPTR^[MACROINDEX]:=CHR(13) (ELSE *BEGIN ,NEW(MCPTR); ,MCPTR^[0]:=CHR(13);1; " LEX; $END "ELSE $BEGIN &REPEAT (INITVALUE.HWORD:=0; (IF EXPRESS(FALSE) THEN *IF CHECKOPERAND(TRUE,TRUE,TRUE,-128 *END; &CURRENTATRIB:=UNKNOWN; " DEFMCHOOK:=FALSE; $END; "LEX;  END;   PROCEDURE ZBLOCK; ,255) THEN ,INITVALUE.HWORD:=RESULT.OFFSETORVALUE; (PUTBYTE(INITVALUE.LOWBYTE); (IF DISPLAY THEN *BEGIN ,COUNT:=COUNT + 1;  VAR COUNT,SIZE:INTEGER; %INITVALUE:WORDSWAP;  {handles the .BLOCK psuedo-op, the operand is the number !of bytes/words of ,IF (COUNT MOD BYTEFIT=0) AND (LEXTOKEN=COMMA) THEN .BEGIN 0PRINTLINE; 0FILLCHAR(TEXTLINE[2],70,' '); .END; *END; $ UNTIstorage requested.}  BEGIN "IF EXPRESS(TRUE) THEN $IF CHECKOPERAND(TRUE,TRUE,TRUE,0,BUFLIMIT) THEN  IF CODESECTION=A TL LEXTOKEN<>COMMA; $END;  END;   PROCEDURE ZORG;  VAR I,DIFFERENCE:INTEGER;  BEGIN "IF EXPRESS(TRUE) THEN $IF CHECKOPEHEN (BEGIN *ALC:=ALC + RESULT.OFFSETORVALUE; *LEX; (END &ELSE (BEGIN *SIZE:=RESULT.OFFSETORVALUE; *INITVALUE.HWORD:=0; RAND(TRUE,TRUE,FALSE,0,32767) THEN &IF CODESECTION=A THEN (ALC:=RESULT.OFFSETORVALUE &ELSE (BEGIN *IF LC=0 THEN ,BEGIN *IF LEXTOKEN=COMMA THEN ,IF EXPRESS(FALSE) THEN .IF CHECKOPERAND(TRUE,TRUE,TRUE,-128,255) THEN 0INITVALUE.HWORD:=RESULT.OFFSE.LC:=RESULT.OFFSETORVALUE; .LOWLC:=LC; ,END *ELSE IF RESULT.OFFSETORVALUE=LASTOPCODE) (OR ((PROCNUM=0) AND (LEXTOKEN<=OP20)) THEN &BEGIN (ERROR(18{Invalid structure}); (WHILE (LEXTOKEN<>ENDLINE) AND (LEXTOKEN<>TEOF) DO LEX; (PRINTLINE; &END $ELSE &BEGIN *ERROR(9{Identifier previously declared}) (ELSE IF CURRENTATRIB=PRIVATES THEN *BEGIN ,SAVESYM:=SYM; ,LEX; ,IF LEXTOKEN=COLON THEN .BEGIN 0LEX; 0IF LEXTOKEN=CONSTANT THEN 2SAVESYM^.NWORDS:=CONSTVAL 0ELSE ERROR(17{Constant expected}); 0LEX; .END ,ELSE SAVESYM^.NWORDS:=1; *END (ELSE LEX; &END; "UNTIL LEXTOKEN<>COMMA; "CURRENTATRIB:=UNKNOWN;  END;   PROCEDURE ZTITLE;  BEGIN  LEX; "IF LEXTOKEN=TSTRING THEN TITLELINE:=STRVAL $ELSE ERROR(46{string expected}); "LEX;  END;   PROCEDURE ZEOF;  BEGIN "ERROR(36{Unexpected end of input}); "UNITCLEAR(3); "EXIT(TLA);  END;    {start of ASM4}  {Copyright (c) 1978 Regents of University of California} (  PROCEDURE ZNOLIST;  BEGIN "IF DISPLAY THEN $BEGIN &PRINTLINE; &IF CONSOLE THEN (BEGIN *WRITELN; *WRITE('<',LINENUM:4,'>'); & END; &DISPLAY:=FALSE; $END; "LEX;  END;   PROCEDURE ZLIST;  BEGIN "IF LISTING THEN $BEGIN &IF NOT DISPLAY THEN PRINTPAGE; &/ P4; *OP5:ZOP5; *OP6:ZOP6; *OP7:ZOP7; *OP8:ZOP8; *OP9:ZOP9; *OP10:ZOP10; *OP11:ZOP11; *OP12:ZOP12; *OP13:ZOP13; *OP14:ZMNAME,'.ERRORS" file not around'); & LINES:=4; (END &ELSE LINES:=3; &LISTNUM:=LISTNUM + LINES; $END; "IF NOT (CONSOLE AOP14; *OP15:ZOP15; *OP16:ZOP16; *OP17:ZOP17; *OP18:ZOP18; *OP19:ZOP19; *OP20:ZOP20 *{ENDLINE is legal yet ignored!} (ENDND DISPLAY) THEN $BEGIN &WRITELN; &WRITELN(TEXTLINE); &WRITELN('ERROR #',ERRORNUM:4); &IF EXTRA THEN WRITELN('"',ASMNAME,'.; 'IF SPCIALSTKINDEX<>-1 THEN )BEGIN +SPCIALSTKINDEX:=-1; +ERROR(19{Extra special symbol}); )END; ERRORS" file not around');  END;  END;   PROCEDURE ERROR; {ERRORNUM:INTEGER}  VAR CH:CHAR;  BEGIN "NUMERRORS:=NUMER'IF (LEXTOKEN<>ENDLINE) AND (LEXTOKEN<>TEOF) THEN )BEGIN +ERROR(5{extra garbage on line}); +WHILE (LEXTOKEN<>ENDLINE) AND (LRORS + 1; "IF MEMAVAIL>1800 THEN $PRINTERROR(ERRORNUM) "ELSE $PRERRNUM(ERRORNUM,FALSE);  WITH USERINFO DO $REPEAT &WRITEXTOKEN<>TEOF) DO LEX; )END; 'PRINTLINE; SYMLAST:=FALSE; $ END; $IF LEXTOKEN=TEOF THEN ZEOF; "UNTIL FALSE;  END;   PROELN('E(dit,,'); &READ(KEYBOARD,CH); &IF CH=ALTMODE THEN EXIT(TLA); &IF (CH='E') OR (CH='e') THEN (BEGIN " CEDURE PRERRNUM(ERRORNUM:INTEGER; EXTRA:BOOLEAN); FORWARD;   SEGMENT PROCEDURE PRINTERROR(ERRORNUM:INTEGER);  TYPE ERRORSTR IF ALTINPUT THEN ,BEGIN .ERRSYM:=ALTBLOCPTR; .ERRBLK:=ALTBLOCNO-2; ,END *ELSE ,BEGIN .ERRSYM:=BLOCKPTR; ING=STRING[40];  VAR ERRORFILE:FILE OF ERRORSTRING;  KLUDGEPTR:^INTEGER;   BEGIN  (*$I-*) "RESET(ERRORFILE,CONCAT.ERRBLK:=BLOCKNO-2; ,END; *ERRNUM:=ERRORNUM; *EXIT(TLA); (END; $UNTIL CH=' '; "IF NOT (DISPLAY AND CONSOLE) THEN $BEGIN (ASMNAME,'.ERRORS')); "MARK(KLUDGEPTR); {dumps disk directory so next proc call won't STK-OFLW} "(*$I+*) "IF IORESULT<>0 THEN&WRITELN; &WRITE('<',LINENUM:4,'>');  END; "IF DISPLAY AND (LISTNUM MOD PAGESIZE<4) THEN PRINTPAGE;  END;   PROCEDUR(CASE LEXTOKEN OF *NOLIST:ZNOLIST; *LIST:ZLIST; *ASECT: BEGIN CODESECTION:=A; LEX; END; *PSECT: BEGIN CODESECTION:=P; $PRERRNUM(ERRORNUM,TRUE) "ELSE $BEGIN $ SEEK(ERRORFILE,ERRORNUM); &GET(ERRORFILE); &IF DISPLAY THEN (BEGIN *WRITELN(LI LEX; END; *ALIGN:ZALIGN; *ASCII:ZASCII; *TIDENTIFIER:ZEQU; *EQU:ZEQU; *MACRODEF:ZDEFMACRO; *BLOCK:ZBLOCK; *WORD:ZWORD;STFILE); *WRITELN(LISTFILE,TEXTLINE); *WRITELN(LISTFILE,ERRORFILE^); *LISTNUM:=LISTNUM + 3; (END; &IF NOT (CONSOLE AND DISP *BIGHT:ZBYTE; *ORG:ZORG; *TPAGE:BEGIN 2IF DISPLAY THEN PRINTPAGE; * LEX; 0END; *TITLE:ZTITLE; *TEOF:ZEOF; *PROCLAY) THEN (BEGIN *WRITELN; *WRITELN(TEXTLINE); *WRITELN(ERRORFILE^); $ END; $END;  END;  ,FUNC,TEND:EXIT(ASSEMBLE); *TCONST,PUBLIC,PRIVATE,DEF,REF:ZGLOBAL; *CONDITION:ZCOND; *TELSE:ZELSE; *CONDEND:BEGIN 4IF CONDI PROCEDURE PRERRNUM; {ERRORNUM:INTEGER; EXTRA:BOOLEAN}  VAR LINES:INTEGER;  BEGIN "IF DISPLAY THEN $BEGIN &WRITELN(LISTNDEX<0 THEN ERROR(7{Not enough ifs}) 6ELSE CONDINDEX:=CONDINDEX - 1; 4LEX; 2END; *OP1:ZOP1; *OP2:ZOP2; *OP3:ZOP3; *OP4:ZOFILE); &WRITELN(LISTFILE,TEXTLINE); &WRITELN(LISTFILE,'ERROR #',ERRORNUM:4); &IF EXTRA THEN (BEGIN *WRITELN(LISTFILE,'"',AS0  END;   BEGIN {PATCHCODE} "PRINTLC.HWORD:=FWDREF.VALUE; "IF FWDREF.BYTESIZE THEN $IF (PRINTLC.HWORD>127) OR (PRINTLC.HWORDE); $END "ELSE PAGE(LISTFILE); "WRITE(LISTFILE,'PAGE - ',PAGENO:3,' ',PROCNAME,' FILE:',CURFNAME); "IF DISPLAY AND CONSOLE<-128) THEN &BEGIN (PRINTLC.HWORD:=FWDREF.LC; (WRITELN('Location ',HEXCHAR[PRINTLC.HEX1], *HEXCHAR[PRINTLC.HEX2],HEXCHAR[PRI THEN WRITELN(LISTFILE); "WRITELN(LISTFILE,' ',TITLELINE); "WRITELN(LISTFILE); "WRITELN(LISTFILE); "LISTNUM:=0; "PAGENO:=PNTLC.HEX3], *HEXCHAR[PRINTLC.HEX4]); (ERROR(2{operand out of range}); &END $ELSE &BEGIN (BUFFER^[BUFINDEX]:=PRINTLC.LOWBYTAGENO + 1;  END;   PROCEDURE PRINTLINE;  VAR COUNT:INTEGER;  LISTLINE:STRING;  BEGIN "LINENUM:=LINENUM + 1; "IF NE; (IF DISPLAY THEN PATCHPRINT(TRUE); &END "ELSE $BEGIN &IF HIBYTEFIRST THEN (BEGIN *BUFFER^[BUFINDEX]:=PRINTLC.HIBYTE; OT (DISPLAY AND CONSOLE) THEN $BEGIN &WRITE('.'); &IF (LINENUM MOD 50=0) THEN (BEGIN *WRITELN; *WRITE('<',LINENUM:4,'>'); *BUFFER^[BUFINDEX + 1]:=PRINTLC.LOWBYTE; (END &ELSE (BEGIN *BUFFER^[BUFINDEX]:=PRINTLC.LOWBYTE; *BUFFER^[BUFINDEX + 1]:=PR$ END; $END; "IF DISPLAY THEN $BEGIN &LISTNUM:=LISTNUM + 1; &IF (LISTNUM MOD PAGESIZE=0) THEN PRINTPAGE; &PRINTNUM(LASINTLC.HIBYTE; (END; &IF NOT LISTHIFIRST THEN (BEGIN *SWAP:=PRINTLC.HIBYTE; *PRINTLC.HIBYTE:=PRINTLC.LOWBYTE; *PRINTLC.LOWBTLC,FALSE); &IF CODECOUNT0 THEN $BEGIN &ERROR*LISTLINE[0]:=CHR(CODECOUNT+2); *WRITE(LISTFILE,'| ',LISTLINE); (END &ELSE (WRITE(LISTFILE,'| ',CODE); &IF TEXTINDEX>79 TH(46 + IORESULT); &IF QUIT THEN (BEGIN *UNITCLEAR(3); {remove pretty display of stack & heap on screen} *EXIT(TLA); (END; $EN TEXTINDEX:=79; {caution abounds in unsure minds} &MOVELEFT(TEXTLINE,LISTLINE[1],TEXTINDEX+1); &LISTLINE[0]:=CHR(TEXTINDEX+END;  END;   PROCEDURE LLCHECK;  VAR I:INTEGER;  BEGIN "FOR I:=0 TO TEMPTOP-1 DO $IF TEMP[I].FWDREF<>NIL THEN &BEGIN 1); &IF SOURCE=MACROSOURCE THEN (WRITELN(LISTFILE,'#',LISTLINE) &ELSE (WRITELN(LISTFILE,' ',LISTLINE); " END; "IF (CODESE(IF DISPLAY THEN *BEGIN ,WRITELN(LISTFILE); ,WRITE(LISTFILE,'>>>>>',TEMP[I].TEMPNAME); ( END; (IF NOT (CONSOLE AND DISPLAYCTION=A) THEN LASTLC:=ALC ELSE LASTLC:=LC; "CODE:=BLANKCODE; "CODECOUNT:=0;  END;   PROCEDURE PRINTNUM; {WORD:INTEGER; E PATCHCODE; {FWDREF:BACKLABEL; BUFINDEX:INTEGER}  VAR PRINTLC:WORDSWAP; &SWAP:INTEGER;   PROCEDURE PATCHPRINT(BYTESIZE:B) THEN *BEGIN ,WRITELN; ,WRITE('>>>>>',TEMP[I].TEMPNAME); ( END; (ERROR(1{undefined label}); (TEMP[I].FWDREF:=NIL; OOLEAN);  BEGIN "PRINTNUM(FWDREF.LC,FALSE); "WRITE(LISTFILE,'* '); "PRINTNUM(PRINTLC.HWORD,BYTESIZE); "WRITELN(LISTFILE); &END; "TEMPTOP:=0;  END; "  PROCEDURE PRINTPAGE;  BEGIN  IF CONSOLE THEN $BEGIN &WRITELN(LISTFILE); &WRITELN(LISTFIL1 ,CODE[CODECOUNT + 2]:=CHR(HEX.OCT6 + ORD('0')); ,CODE[CODECOUNT + 3]:=' '; ,CODECOUNT:=CODECOUNT + 4; *END; $END;  END;  }  VAR NUM,SWAP:WORDSWAP;  ASTRKCODE:INTEGER;   PROCEDURE FULLSET;  BEGIN "FULLLABEL^.OFFSET:=BUFFERTOP; "FULLLABEBYTESIZE:BOOLEAN}  VAR NUM:WORDSWAP;  BEGIN  NUM.HWORD:=WORD; "IF BYTESIZE THEN $BEGIN &IF LISTRADIX=16 THEN (WRITE(LIS  PROCEDURE SENDWORD(NUM:WORDSWAP; ASTRKCODE:INTEGER);  VAR SWAP,LISTNUM:WORDSWAP;  BEGIN "SWAP:=NUM; "IF NOT HIBYTEFIRST TFILE,HEXCHAR[NUM.HEX3],HEXCHAR[NUM.HEX4]); &IF LISTRADIX=8 THEN (WRITE(LISTFILE,NUM.OCT4:1,NUM.OCT5:1,NUM.OCT6:1) $END "ELSTHEN $BEGIN &NUM.HIBYTE:=SWAP.LOWBYTE; &NUM.LOWBYTE:=SWAP.HIBYTE; $END; "IF DISPLAY THEN $BEGIN &IF LISTHIFIRST THEN (LIE $BEGIN &IF LISTRADIX=16 THEN WRITE(LISTFILE,HEXCHAR[NUM.HEX1],HEXCHAR[NUM.HEX2], JHEXCHAR[NUM.HEX3],HEXCHAR[NUM.HEX4]); &ISTNUM:=SWAP &ELSE (BEGIN *LISTNUM:=NUM; *ASTRKCODE:=ASTRKCODE DIV 2 + (ASTRKCODE MOD 2)*2; (END; &IF LISTRADIX=16 THEN (IF LISTRADIX=8 THEN WRITE(LISTFILE,NUM.OCT1:1,NUM.OCT2:1,NUM.OCT3:1, INUM.OCT4:1,NUM.OCT5:1,NUM.OCT6:1) $END  END;  F CODECOUNT + 4<=CODESIZE THEN *BEGIN ,FILLCHAR(CODE[CODECOUNT],4,'*'); ,IF ASTRKCODE<2 THEN .BEGIN 0CODE[CODECOUNT]:=HEXCH PROCEDURE PUTBYTE; {BYTE:BITE}  VAR HEX:WORDSWAP;  BEGIN  IF BUFFERPOS>BUFLIMIT THEN $BEGIN &(*$I-*) &IF BLOCKWRITE(AR[LISTNUM.HEX1]; 0CODE[CODECOUNT + 1]:=HEXCHAR[LISTNUM.HEX2]; , END; ,IF (ASTRKCODE MOD 2<>1) THEN .BEGIN 0CODE[CODECOUNTUSERINFO.WORKCODE^,BUFFER^,1,OUTBLKNO)=0 THEN; &IOCHECK(TRUE); &(*$I+*) &OUTBLKNO:=OUTBLKNO + 1; &IF OUTBLKNO>OUTBLKTOP THEN + 2]:=HEXCHAR[LISTNUM.HEX3]; 0CODE[CODECOUNT + 3]:=HEXCHAR[LISTNUM.HEX4]; .END; ,CODE[CODECOUNT + 4]:=' '; ,CODECOUNT:=CODE OUTBLKTOP:=OUTBLKNO; &MOVELEFT(BUFFER^[512],BUFFER^[0],(BUFBLKS -1)*512); &BUFFERPOS:=BUFFERPOS - 512; &BUFBOTTOM:=BUFBOTTOMCOUNT + 5; *END; &IF LISTRADIX=8 THEN (IF CODECOUNT + 6<=CODESIZE THEN *BEGIN ,FILLCHAR(CODE[CODECOUNT],6,'*');  + 512; $END; "BUFFER^[BUFFERPOS]:=BYTE; "BUFFERPOS:=BUFFERPOS + 1; "BUFFERTOP:=BUFBOTTOM + BUFFERPOS; "IF BUFFERTOP>MAXBUF,IF ASTRKCODE<2 THEN .BEGIN 0CODE[CODECOUNT]:=CHR(LISTNUM.OCT1 + ORD('0')); 0CODE[CODECOUNT + 1]:=CHR(LISTNUM.OCT2 + ORD('0'TOP THEN MAXBUFTOP:=BUFFERTOP; "IF NOT WORDADDRESSED THEN LC:=LC + 1; "IF DISPLAY AND NOT FROMPUTWORD THEN $BEGIN &HEX.HWORD)); 0CODE[CODECOUNT + 2]:=CHR(LISTNUM.OCT3 + ORD('0')); .END; ,IF (ASTRKCODE MOD 2<>1) THEN .BEGIN 0CODE[CODECOUNT + 3]:=CH:=BYTE; &IF LISTRADIX=16 THEN (IF CODECOUNT + 2<=CODESIZE THEN *BEGIN ,CODE[CODECOUNT]:=HEXCHAR[HEX.HEX3]; ,CODE[CODECOUNT R(LISTNUM.OCT4 + ORD('0')); 0CODE[CODECOUNT + 4]:=CHR(LISTNUM.OCT5 + ORD('0')); 0CODE[CODECOUNT + 5]:=CHR(LISTNUM.OCT6 + ORD('+ 1]:=HEXCHAR[HEX.HEX4]; ,CODE[CODECOUNT + 2]:=' '; ,CODECOUNT:=CODECOUNT + 3; *END; &IF LISTRADIX=8 THEN (IF CODECOUNT + 30')); .END; ,CODE[CODECOUNT + 6]:=' '; ,CODECOUNT:=CODECOUNT + 7; *END; " END; "IF WORDADDRESSED THEN LC:=LC + 1; "FROMP<=CODESIZE THEN *BEGIN ,CODE[CODECOUNT]:=CHR(HEX.OCT4 + ORD('0')); ,CODE[CODECOUNT + 1]:=CHR(HEX.OCT5 + ORD('0')); UTWORD:=TRUE; "PUTBYTE(NUM.HIBYTE); "PUTBYTE(NUM.LOWBYTE); "FROMPUTWORD:=FALSE;  END;   PROCEDURE PUTWORD; {WORD:INTEGER2 E=DEFS) AND 9(RELOCATE.SYM^.CODEOFFSET<>-1)) THEN 5ELSE 7BEGIN 9FULLSET; 9IF RELOCATE.SYM^.ATTRIBUTE=DEFS THEN :BEGIN ALSE; *IF RELOCATE.ATTRIBUTE=LABELS THEN ,FULLLABEL^.VALUE:=WORD - LASTLC; (END; &FULLLABEL^.NEXT:=TEMP[RELOCATE.TEMPLABEL].;FULLLABEL^.NEXT:=RELOCATE.SYM^.DEFFWDREF; ;RELOCATE.SYM^.DEFFWDREF:=FULLLABEL :END 9ELSE 9 BEGIN ;FULLLABEL^.NEXT:=RELOCAFWDREF; &TEMP[RELOCATE.TEMPLABEL].FWDREF:=FULLLABEL; &IF FREELABEL<>NIL THEN (BEGIN *FULLLABEL:=FREELABEL; *FREELABEL:=FREETE.SYM^.FWDREF; ;RELOCATE.SYM^.FWDREF:=FULLLABEL; :END; 9IF FREELABEL<>NIL THEN ;BEGIN =FULLLABEL:=FREELABEL; =FREELABEL:=LABEL^.NEXT; (END &ELSE NEW(FULLLABEL); $END "ELSE $IF BYTESIZE THEN &BEGIN (IF RELOCATE.ATTRIBUTE=LABELS THEN *SWAP.HWOFREELABEL^.NEXT; ;END 9ELSE NEW(FULLLABEL); 7END; 5JUMPSET(JCOUNT1,JUMP1,1); 3END; /PRIVATES,PUBLICS,CONSTS,REFS: 3BEGIN RD:=RELOCATE.OFFSETORVALUE-LASTLC (ELSE *SWAP.HWORD:=RELOCATE.OFFSETORVALUE; (IF NOT WORDADDRESSED AND WORDOFFSET THEN L^.LC:=LC; "FULLLABEL^.BYTESIZE:=FALSE; "FULLLABEL^.WORDLC:=FALSE; "FULLLABEL^.VALUE:=WORD;  ASTRKCODE:=3;  END;   PRO5RELOCATE.SYM^.NREFS:=RELOCATE.SYM^.NREFS + 1; 5NEW(NEXTJP); NEXTJP^.PCOFFSET:=BUFFERTOP-512; 5NEXTJP^.LAST:=RELOCATE.SYM^.LICEDURE JUMPSET(VAR JCOUNT:INTEGER; VAR JUMP:JTABREC; CLASS:INTEGER);  BEGIN "IF JUMPINFO THEN $BEGIN &IF JCOUNT=7 THEN NKOFFSET; 5RELOCATE.SYM^.LINKOFFSET:=NEXTJP;  CASE RELOCATE.SYM^.ATTRIBUTE OF 7PUBLICS,PRIVATES: JUMPSE(BEGIN *SCRATCH^.CLASS:=CLASS; *SCRATCH^.JUMPS:=JUMP; *PUT(SCRATCH); SCRATCHEND:=SCRATCHEND + 1; *FILLCHAR(JUMP,SIZEOF(JUMPT(JCOUNT3,JUMP3,3); 7REFS: JUMPSET(JCOUNT2,JUMP2,2) 5END; 3END; -END; -RELOCATE:=NULLREL; $ END $END;{Main Case} ),0); *JCOUNT:=0; (END; &JUMP[JCOUNT]:=BUFFERTOP; &JCOUNT:=JCOUNT + 1;  END;  END;   BEGIN {PUTWORD}  ASTRKCODE:"SENDWORD(NUM,ASTRKCODE);  END;   PROCEDURE PUTRELWORD; {WORD:INTEGER; BYTESIZE,WORDOFFSET:BOOLEAN}  VAR NUM,SWAP:WORDSWAP=0; "NUM.HWORD:=WORD; "CASE RELOCATE.TIPE OF $NOTSET:; %LCREL:BEGIN -RELOCATE:=NULLREL; -JUMPSET(JCOUNT1,JUMP1,1); +END; ;  ASTRKCODE:INTEGER;   PROCEDURE FULLRELSET;  BEGIN "FULLLABEL^.OFFSET:=BUFFERTOP; "FULLLABEL^.LC:=LC; %LLREL:BEGIN -IF TEMP[RELOCATE.TEMPLABEL].TEMPATRIB=UNKNOWN THEN /BEGIN 1FULLSET; 1FULLLABEL^.NEXT:=TEMP[RELOCATE.TEMPLABEL"FULLLABEL^.WORDLC:=WORDOFFSET;  END;   PROCEDURE SHORTSPACE;  BEGIN "IF TEMP[RELOCATE.TEMPLABEL].TEMPATRIB=UNKNOWN THEN ].FWDREF; 1TEMP[RELOCATE.TEMPLABEL].FWDREF:=FULLLABEL; 1IF FREELABEL<>NIL THEN 3BEGIN 5FULLLABEL:=FREELABEL; 5FREELABEL:=FR$BEGIN &FULLRELSET; &IF BYTESIZE THEN (BEGIN *IF RELHI THEN ASTRKCODE:=2 ELSE ASTRKCODE:=1; *IF (RELHI AND NOT HIBYTEFIRSTEELABEL^.NEXT; 3END 1ELSE NEW(FULLLABEL); /END; -JUMPSET(JCOUNT1,JUMP1,1); -RELOCATE:=NULLREL; +END; "LABELREL:BEGIN -CA) OR ,(NOT RELHI AND HIBYTEFIRST) THEN /FULLLABEL^.OFFSET:=BUFFERTOP + 1; *FULLLABEL^.BYTESIZE:=TRUE; *IF RELOCATE.ATTRIBUTSE RELOCATE.SYM^.ATTRIBUTE OF /LABELS,UNKNOWN,DEFS: 3BEGIN 5IF (RELOCATE.SYM^.ATTRIBUTE=LABELS) OR 9((RELOCATE.SYM^.ATTRIBUTE=LABELS THEN ,FULLLABEL^.VALUE:=RELOCATE.OFFSETORVALUE - LASTLC; (END &ELSE (BEGIN *ASTRKCODE:=3; *FULLLABEL^.BYTESIZE:=F3 ELS THEN {not ABS} 3SWAP.HWORD:=RELOCATE.OFFSETORVALUE-LASTLC 1ELSE 3SWAP.HWORD:=RELOCATE.OFFSETORVALUE; 1IF NOT WORDADDRESSRELOCATE.SYM^.ATTRIBUTE=DEFS THEN 8BEGIN 9FULLLABEL^.NEXT:=RELOCATE.SYM^.DEFFWDREF; 9RELOCATE.SYM^.DEFFWDREF:=FULLLABEL; 8ENED AND WORDOFFSET THEN 3SWAP.HWORD:=SWAP.HWORD DIV 2; 1IF (SWAP.HWORD>=-128) AND (SWAP.HWORD<=127) THEN D 7ELSE 8BEGIN 9FULLLABEL^.NEXT:=RELOCATE.SYM^.FWDREF; 9RELOCATE.SYM^.FWDREF:=FULLLABEL; 8END; 7IF FREELABEL<>NIL THEN 9B- IF RELHI THEN 5NUM.HIBYTE:=SWAP.LOWBYTE 3ELSE 5NUM.LOWBYTE:=SWAP.LOWBYTE 1ELSE ERROR(20{branch too far}); - END -EGIN ;FULLLABEL:=FREELABEL; ;FREELABEL:=FREELABEL^.NEXT; 9END 7ELSE NEW(FULLLABEL); 5END; / END; /PRIVATES,PUBLICS,CONSTELSE /IF RELOCATE.ATTRIBUTE=LABELS THEN 1NUM.HWORD:=WORD - LASTLC; -RELOCATE:=NULLREL; +END; %LLREL:SHORTSPACE; "LABELREL:S,REFS: 3BEGIN 5IF DISPLAY THEN 7BEGIN 9WRITELN(LISTFILE); 9WRITE(LISTFILE,RELOCATE.SYM^.NAME); 5 END; 5IF NOT (CONSOLE BEGIN -CASE RELOCATE.SYM^.ATTRIBUTE OF /LABELS,UNKNOWN,DEFS: 1BEGIN 3IF (RELOCATE.SYM^.ATTRIBUTE=LABELS) OR 7((RELOCATE.SYMAND DISPLAY) THEN 7BEGIN 9WRITELN; 9WRITE(RELOCATE.SYM^.NAME); 5 END; 5ERROR(21{Variable not PC relative}); 3END -END; ^.ATTRIBUTE=DEFS) AND 7(RELOCATE.SYM^.CODEOFFSET<>-1)) THEN 5BEGIN 7IF BYTESIZE THEN 9BEGIN ;IF RELOCATE.ATTRIBUTE=LABELS " RELOCATE:=NULLREL; $ END $END;{Main Case} "SENDWORD(NUM,ASTRKCODE);  END;   THEN =SWAP.HWORD:=RELOCATE.OFFSETORVALUE-LASTLC ;ELSE =SWAP.HWORD:=RELOCATE.OFFSETORVALUE; ;IF NOT WORDADDRESSED AND WORDOFF*SWAP.HWORD:=SWAP.HWORD DIV 2; (IF (SWAP.HWORD>=-128) AND (SWAP.HWORD<=127) THEN *IF RELHI THEN ,NUM.HIBYTE:=SWAP.LOWBYTE *SET THEN =SWAP.HWORD:=SWAP.HWORD DIV 2; ;IF (SWAP.HWORD>=-128) AND (SWAP.HWORD<=127) THEN =IF RELHI THEN ?NUM.HIBYTE:=SWAP.LELSE ,NUM.LOWBYTE:=SWAP.LOWBYTE (ELSE ERROR(20{branch too far}); &END $ELSE &IF RELOCATE.ATTRIBUTE=LABELS THEN (NUM.HWORD:OWBYTE =ELSE ?NUM.LOWBYTE:=SWAP.LOWBYTE ;ELSE ERROR(20{branch too far}); 9END 7ELSE 9IF RELOCATE.ATTRIBUTE=LABELS THEN ;N=WORD - LASTLC; "RELOCATE:=NULLREL;  END;   BEGIN {PUTRELWORD} "ASTRKCODE:=0; "NUM.HWORD:=WORD; "CASE RELOCATE.TIPE OF UM.HWORD:=WORD - LASTLC; 5END 3ELSE 5BEGIN 7FULLRELSET; 7IF BYTESIZE THEN 9BEGIN $NOTSET:IF BYTESIZE THEN -BEGIN /SWAP.HWORD:=RELOCATE.OFFSETORVALUE; /IF NOT WORDADDRESSED AND WORDOFFSET THEN 1SWAP.HWORD:=;IF RELHI THEN ASTRKCODE:=2 ELSE ASTRKCODE:=1; ;IF (RELHI AND NOT HIBYTEFIRST) OR =(NOT RELHI AND HIBYTEFIRST) THEN ?FULLLASWAP.HWORD DIV 2; /IF (SWAP.HWORD>=-128) AND (SWAP.HWORD<=127) THEN 1IF RELHI THEN 3NUM.HIBYTE:=SWAP.LOWBYTE 1ELSE 3NUM.LOWBEL^.OFFSET:=BUFFERTOP + 1; ;FULLLABEL^.BYTESIZE:=TRUE; ;IF RELOCATE.ATTRIBUTE=LABELS THEN =FULLLABEL^.VALUE:=RELOCATE.OFFSETBYTE:=SWAP.LOWBYTE /ELSE ERROR(20{branch too far}); -END; %LCREL:BEGIN -IF BYTESIZE THEN /BEGIN 1IF RELOCATE.ATTRIBUTE=LABORVALUE-LASTLC; 9END 7ELSE 9BEGIN ;ASTRKCODE:=3; ;FULLLABEL^.BYTESIZE:=FALSE; ;FULLLABEL^.VALUE:=WORD-LASTLC; 9END; 7IF 4 E $BNUM:=BLOCKREAD(USERINFO.WORKSRC^,XBLOCK,2,BLOCKNO); "BLOCKPTR:=0; "BLOCKNO:=BLOCKNO+BNUM; "IF DEBUG THEN %WRITELN('BLOCKREAD=',BLOCKNO); "IF BNUM=0 THEN $IF ALTINPUT THEN &BEGIN (BLOCKNO:=ALTBLOCNO; (BLOCKPTR:=ALTBLOCPTR; (BNUM:=BLOCKREAD(USERINFO.WORKSRC^,XBLOCK,2,BLOCKNO - 2); (ALTINPUT:=FALSE; (CLOSE(ALTFILE); (CURFNAME:=FIRSTFNAME; &END $ELSE &BEGIN (LEXTO1 2 W2W2O^KEN:=TEOF; (EXIT(LEX); &END; "IOCHECK(TRUE); "(*$I+*)  END;   PROCEDURE GETCHAR;  VAR I:INTEGER;  BEGIN  IF DEBUG THEN WRITE(LISTFILE,'Getchar '); "CASE SOURCE OF $MACROSOURCE:BEGIN 2IF ADVANCE THEN 4BEGIN 6MACROINDEX:=MACROINDEX + 1; 6TEXTINDEX:=TEXTINDEX + 1; 4END 2ELSE ADVANCE:=TRUE; 2IF MCPTR^[MACROINDEX]=CHR(16) THEN 4BEGIN 6CH:=MCPTR^[MACROINDEX + 1]; 6STARTLINE:=(ORD(CH) - 32=0); 6IF TEXTINDEX<79 THEN 8BEGIN :TEXTLINE[TEXTINDEX]:=CHR(16); :TEXTLINE[TEXTINDEX + 1]:=CH; :TEXTINDEX:=TEXTINDEX+2; 6 END; 6MACROINDEX:=MACROINDEX + 2; 4END; 2CH:=MCPTR^[MACROINDEX]; 2IF CH='%' THEN 2 BEGIN 4 CH:=MCPTR^[MACROINDEX + 1]; 6MACROINDEX:=MACROINDEX + 2; 6IF (CH<'1') OR (CH>'9') THEN 8ERROR(22{illegal macro parameter index}) 6ELSE 8BEGIN :I:=ORD(CH)-ORD('1'); :PARMPTR:=MCINDEX[MCSTKINDEX-1]; :IF MCSTKINDEX>1 THEN  {starting ASM5}  {Copyright (c) 1978 Regents of University of California}   PROCEDURE NEWFILE;  BEGIN "(*$I-*) "TEXTLINE:=BLANKLINE; TEXTINDEX:=0; "IF ALTINPUT THEN $BNUM:=BLOCKREAD(ALTFILE,XBLOCK,2,BLOCKNO) "ELS5 MCPTR:=MACROSTACK[MCSTKINDEX - 1]; >WHILE (I<>0) AND (MCPTR^[PARMPTR]<>CHR(13)) DO @BEGIN BIF MCPTR^[PARMPTR]=',' THTEXTINDEX<80 THEN TEXTLINE[TEXTINDEX]:=' '; 8TEXTINDEX:=TEXTINDEX + 1; 8PARMPTR:=PARMPTR + 1; 6 IF MCSTKINDEX>1 THEN CH:=MCPEN I:=I-1; BPARMPTR:=PARMPTR + 1; < END; >I:=SCAN(80,<>' ',MCPTR^[PARMPTR]); >PARMPTR:=PARMPTR + I; >CH:=MCPTR^[PARMPTR]TR^[PARMPTR] :ELSE CH:=XBLOCK[PARMPTR]; 6UNTIL CH<>' '; 6CH:=' '; 6PARMPTR:=PARMPTR - 1; 6TEXTINDEX:=TEXTINDEX - 1; 2 END; >IF (CH=CHR(13)) OR (CH=';') THEN @MCPTR:=MACROSTACK[MCSTKINDEX]; WHILE (I<>0) AND (XBLOCK[PARMPTR]<> 2ELSE 4BEGIN 6IF TEXTINDEX<80 THEN TEXTLINE[TEXTINDEX]:=CH; 0 IF CH=TAB THEN CH:=' '; 4END; 0END; %FILESOURCE:BEGINCHR(13)) DO @BEGIN BIF XBLOCK[PARMPTR]=',' THEN I:=I-1; BPARMPTR:=PARMPTR + 1; < END;  2IF ADVANCE THEN 4BEGIN 6BLOCKPTR:=BLOCKPTR + 1; 6TEXTINDEX:=TEXTINDEX + 1; 4END 2ELSE ADVANCE:=TRUE; 2IF BLOCKPTR>1023 >I:=SCAN(80,<>' ',XBLOCK[PARMPTR]); >PARMPTR:=PARMPTR + I; >CH:=XBLOCK[PARMPTR]; 4 END; 9IF (CH<>CHR(13)) AND (CH<>'THEN NEWFILE 2 ELSE IF (XBLOCK[BLOCKPTR]=CHR(0)) THEN NEWFILE; 2IF (XBLOCK[BLOCKPTR]=CHR(16)) AND NOT DEFMCHOOK THEN 4BEGIN ;') THEN SOURCE:=PARMSOURCE; :ADVANCE:=FALSE; :GETCHAR; 8END; 4END 2ELSE IF (CH=' ') AND NOTSTRING THEN 4BEGIN 6I:=SCAN(86CH:=XBLOCK[BLOCKPTR+1]; 6STARTLINE:=(ORD(CH) - 32=0); 6IF TEXTINDEX<79 THEN 8BEGIN :TEXTLINE[TEXTINDEX]:=CHR(16); :TEXTLI0,<>' ',MCPTR^[MACROINDEX]); 6IF TEXTINDEX + I<80 THEN 8BEGIN :FILLCHAR(TEXTLINE[TEXTINDEX],I,' '); :TEXTINDEX:=TEXTINDEX + NE[TEXTINDEX + 1]:=CH; :TEXTINDEX:=TEXTINDEX + 2; 6 END; 6BLOCKPTR:=BLOCKPTR+2; 4END; 2CH:=XBLOCK[BLOCKPTR]; I - 1; 6 END; 6MACROINDEX:=MACROINDEX + I - 1; 4END 2ELSE IF (EXPANDMACRO) AND (CH<>CHR(13)) THEN 4BEGIN 6IF TEXTINDEX<802IF CH=';' THEN 4BEGIN 4 I:=SCAN(80,=CHR(13),XBLOCK[BLOCKPTR]); 6IF TEXTINDEX+I<80 THEN 8BEGIN :MOVELEFT(XBLOCK[BLOCKPTR] THEN TEXTLINE[TEXTINDEX]:=CH; 0 IF CH=TAB THEN CH:=' '; 4END; 0END; %PARMSOURCE:BEGIN 2IF ADVANCE THEN 4BEGIN 6PARM,TEXTLINE[TEXTINDEX],I); :TEXTINDEX:=TEXTINDEX + I - 1; 6 END; 6BLOCKPTR:=BLOCKPTR + I; 6CH:=CHR(13); 4END 2ELSE IF (CH='PTR:=PARMPTR + 1; 6TEXTINDEX:=TEXTINDEX + 1; 4END 2ELSE ADVANCE:=TRUE; 2IF MCSTKINDEX>1 THEN CH:=MCPTR^[PARMPTR] 4ELSE CH:= ') AND NOTSTRING AND NOT DEFMCHOOK THEN 4BEGIN 4 I:=SCAN(80,<>' ',XBLOCK[BLOCKPTR]); 6IF TEXTINDEX+I<80 THEN 8BEGIN :FILLXBLOCK[PARMPTR]; 2IF (CH=',') OR (CH=CHR(13)) OR (CH=';') THEN 4BEGIN 4 IF MCSTKINDEX>1 THEN 8I:=SCAN(-70,<>' ',MCPTR^[PARMCHAR(TEXTLINE[TEXTINDEX],I,' '); :TEXTINDEX:=TEXTINDEX + I - 1; 6 END; 6BLOCKPTR:=BLOCKPTR + I - 1; 2 END 2ELSE IF CH<>CHPTR - 1]) 6ELSE 8I:=SCAN(-70,<>' ',XBLOCK[PARMPTR - 1]); 6TEXTINDEX:=TEXTINDEX + I; 6SOURCE:=MACROSOURCE; R(13) THEN 4BEGIN 6IF TEXTINDEX<80 THEN TEXTLINE[TEXTINDEX]:=CH; 0 IF CH=TAB THEN CH:=' '; 4END; 0END %END;{CASE} "I6MCPTR:=MACROSTACK[MCSTKINDEX]; 6ADVANCE:=FALSE; 6GETCHAR; 4END 2ELSE IF (CH=' ') AND NOTSTRING THEN 4BEGIN 6REPEAT 8IF F DEBUG THEN WRITELN(LISTFILE,'CH=',CH,'|ORD:',ORD(CH), '' FROM:',ORD(SOURCE));  END;   FUNCTION CHECKOPERAND; {CKSPSTK,CKA6 &SPCIALSTKINDEX:=SPCIALSTKINDEX + 1; &SPECIALSTK[SPCIALSTKINDEX]:=LEXTOKEN; $END; "IF STKINDEX=-1 THEN $IF LEXTOKEN=OPENPARATTRIBUTE:=ABS; (BOTHABSOLUTE:=((LATTRIBUTE=ABS) AND (RATTRIBUTE=ABS)); (RVALUE:=STK[STKINDEX].VALUE; (KLUDGETYPE:=STK[STKINDEN THEN &BEGIN (EXPRESS:=FALSE; (EXIT(EXPRESS); &END $ELSE IF OPERANDREQUIRED THEN &BEGIN (ERROR(27{not enough operands})EX-1].TIPE; (WITH STK[STKINDEX-2] DO (BEGIN *IF NOT (KLUDGETYPE IN [PLUS,MINUS,BITWISEOR,AMPERSAND, ,EXCLUSIVEOR,ASTERISK,DI; (EXPRESS:=FALSE; &END $ELSE EXPRESS:=FALSE "ELSE IF (STKINDEX=0) AND (STK[STKINDEX].TIPE=TNULL) THEN $BEGIN &RESULT.OFFSVIDE,MODULO]) THEN .EXPREXIT *ELSE CASE KLUDGETYPE OF ,PLUS:IF (LATTRIBUTE=ABS) OR (RATTRIBUTE=ABS) THEN 3BEGIN BS,CKRANGE:BOOLEAN; LO,HI:INTEGER}  {Tests the result of an operand for correctness}  BEGIN "IF CKABS AND NOT (RESULT.ATTRIBUETORVALUE:=STK[STKINDEX].VALUE; &RESULT.ATTRIBUTE:=STK[STKINDEX].ATRIB; &RELOCATE.ATTRIBUTE:=RESULT.ATTRIBUTE; &RELOCATE.OFFSTE IN [ABS,DEFABS,DEFREG,DEFRP,DEFCC,DEFIR]) #THEN $BEGIN &ERROR(24{operand not absolute}); &CHECKOPERAND:=FALSE; $END ETORVALUE:=RESULT.OFFSETORVALUE; &EXPRESS:=TRUE $END "ELSE IF (STKINDEX=1) AND (STK[0].TIPE=TNULL) AND #(STK[STKINDEX].TIPE "ELSE IF CKRANGE AND (((RESULT.OFFSETORVALUEHI)) THEN $BEGIN &ERROR(2{operand out of range}); IN [PLUS,MINUS,ASTERISK]) THEN $BEGIN &SPCIALSTKINDEX:=SPCIALSTKINDEX + 1; &CASE STK[STKINDEX].TIPE OF (PLUS:SPECIALSTK[SPCI&CHECKOPERAND:=FALSE; $END "ELSE IF CKSPCSTK AND (SPCIALSTKINDEX<>-1) THEN $BEGIN &ERROR(25{illegal use of special symbols}ALSTKINDEX]:=AUTOINCR; (MINUS:SPECIALSTK[SPCIALSTKINDEX]:=AUTODECR; (ASTERISK:SPECIALSTK[SPCIALSTKINDEX]:=LEXTOKEN &END; &RE); &SPCIALSTKINDEX:=-1; &CHECKOPERAND:=TRUE {operand maybe ok - just warning} $END "ELSE CHECKOPERAND:=TRUE;  END;   FUNSULT.OFFSETORVALUE:=STK[0].VALUE; &RESULT.ATTRIBUTE:=STK[0].ATRIB; &RELOCATE.ATTRIBUTE:=RESULT.ATTRIBUTE; CTION EXPRESS; {OPERANDREQUIRED:BOOLEAN}  TYPE STACKTYPE=PACKED RECORD {expression evaluator stack} )TIPE:TOKENS; )ATRIB&RELOCATE.OFFSETORVALUE:=RESULT.OFFSETORVALUE; &EXPRESS:=TRUE; $END "ELSE EXPRESS:=FALSE; "EXIT(EXPRESS);  END;   PROCE:ATRIBUTETYPE; )VALUE:INTEGER &END;  VAR STKINDEX,COUNT:INTEGER;  STK:ARRAY[0..10] OF STACKTYPE; %UNDEFINED:BOOLEAN; DURE OPERFOLD;  VAR LATTRIBUTE,RATTRIBUTE:ATRIBUTETYPE; %KLUDGETYPE:TOKENS; %RVALUE:INTEGER; %BOTHABSOLUTE:BOOLEAN;  BEGIN {The value and type of the calculation should be returned in the !variable record RESULT}   PROCEDURE EXPREXIT;  BEGIN " "IF (STKINDEX=0) THEN $EXIT(OPERFOLD) "ELSE IF (STK[STKINDEX-1].TIPE=OPNBROKEN) THEN $EXIT(OPERFOLD) "ELSE IF STKINDEX>=2 ERROR(26{ill formed expression}); "WHILE (LEXTOKEN<>TEOF) AND (LEXTOKEN<>ENDLINE) DO LEX; "EXPRESS:=FALSE; "EXIT(EXPRESS);  THEN $BEGIN &IF STK[STKINDEX-2].TIPE=TNULL THEN &BEGIN (LATTRIBUTE:=STK[STKINDEX-2].ATRIB; (RATTRIBUTE:=STK[STKINDEX].ATRIBEND;   PROCEDURE EXPREND;  BEGIN "IF (LEXTOKEN IN [OPENPAREN,EQUAL,NOTEQUAL]) THEN $BEGIN ; (IF (LATTRIBUTE IN [DEFABS,DEFRP,DEFREG,DEFCC]) THEN LATTRIBUTE:=ABS; (IF (RATTRIBUTE IN [DEFABS,DEFRP,DEFREG,DEFCC]) THEN R7 K[STKINDEX].ATRIB=ABS THEN {check for unary operator} $BEGIN &CASE STK[STKINDEX-1].TIPE OF NULLREL THEN 5RELOCATE.TIPE:=LCREL 3ELSE IF RELOCATE.TIPE=LCREL THEN 5RELOCATE:=NULLREL; 3STK[STKINDEX].ATRIB:=LABELS; 3STK(MINUS:STK[STKINDEX-1].VALUE:=-STK[STKINDEX].VALUE; (PLUS:STK[STKINDEX-1].VALUE:=STK[STKINDEX].VALUE; (ONESCOMPLEMENT:STK[STK[STKINDEX].TIPE:=TNULL; 1 OPERFOLD; 1END;  CONSTANT,TSTRING:BEGIN 3STKINDEX:=STKINDEX + 1; 3STK[STKINDEX].VALUE:=0; 3IF LINDEX-1].VALUE:=-STK[STKINDEX].VALUE - 1 &END; &STKINDEX:=STKINDEX - 1; &STK[STKINDEX].TIPE:=TNULL; &STK[STKINDEX].ATRIB:=ABEXTOKEN=CONSTANT THEN 5STK[STKINDEX].VALUE:=CONSTVAL 3ELSE IF LENGTH(STRVAL)<=2 THEN 5FOR COUNT:=1 TO LENGTH(STRVAL) DO 7STKS; " END "ELSE EXPREXIT; {whatever he wanted i couldn't do}  END;   BEGIN {EXPRESS} "RELOCATE:=NULLREL; "STKINDEX:=-1;[STKINDEX].VALUE:= 9STK[STKINDEX].VALUE*256 + ORD(STRVAL[COUNT]) 3ELSE EXPREXIT;  "REPEAT $IF EXPRSSADVANCE THEN LEX &ELSE EXPRSSADVANCE:=TRUE; $IF NOT (LEXTOKEN IN [PLUS,MINUS,BITWISEOR,AMPERSAND,EXCLUSIV3STK[STKINDEX].ATRIB:=ABS; {Constants are absolute} 3STK[STKINDEX].TIPE:=TNULL; 3OPERFOLD; 1END; 'LOCLABEL: BEGIN 3IF (RELEOR, &ASTERISK,DIVIDE,MODULO,AUTOINCR,AUTODECR,EQUAL,NOTEQUAL, &ENDLINE,COMMA,OPNBROKEN,OPENPAREN,NUMBERSIGN,ATSIGN,LOCCTR, &OCATE<>NULLREL) AND (RELOCATE.TIPE<>LCREL) THEN 5BEGIN 7IF TEMP[TEMPLABEL].TEMPATRIB=UNKNOWN THEN 9ERROR(28{cannot handle thi5VALUE:=VALUE + RVALUE; 5IF RATTRIBUTE<>ABS THEN ATRIB:=RATTRIBUTE; 3END 1ELSE EXPREXIT; +MINUS:IF (RATTRIBUTE=ABS) OR 3((TNOT,CLOSEPAREN,CLSBROKEN,ONESCOMPLEMENT, &CONSTANT,TSTRING,LOCLABEL,TIDENTIFIER]) THEN EXPREXIT $ELSE $CASE LEXTOKEN OF &PLRATTRIBUTE<>ABS) AND (LATTRIBUTE=RATTRIBUTE)) THEN 3BEGIN 5VALUE:=VALUE - RVALUE; 5IF RATTRIBUTE<>ABS THEN ATRIB:=ABS; 3END US,MINUS,BITWISEOR,AMPERSAND,EXCLUSIVEOR, &DIVIDE,MODULO,OPNBROKEN,ONESCOMPLEMENT: 1BEGIN 3STKINDEX:=STKINDEX + 1; 3STK[STKI1ELSE EXPREXIT; 'BITWISEOR:IF BOTHABSOLUTE THEN 3VALUE:=ORD(ODD(VALUE) OR ODD(RVALUE)) 1ELSE EXPREXIT; 'AMPERSAND:IF BOTHABNDEX].TIPE:=LEXTOKEN; 1END; (ASTERISK:IF STKINDEX=-1 THEN 3IF LCCHAR='*' THEN 5BEGIN 7STKINDEX:=STKINDEX + 1; SOLUTE THEN 3VALUE:=ORD(ODD(VALUE) AND ODD(RVALUE)) 1ELSE EXPREXIT; %EXCLUSIVEOR:IF BOTHABSOLUTE THEN 3VALUE:=ORD((ODD(VALUE7IF CODESECTION=A THEN 9STK[STKINDEX].VALUE:=ALC 7ELSE STK[STKINDEX].VALUE:=LASTLC; 7RELOCATE.TIPE:=LCREL; 7STK[STKINDEX].A) AND NOT ODD(RVALUE)) OR 7(NOT ODD(VALUE) AND ODD(RVALUE))) 1ELSE EXPREXIT; (ASTERISK:IF BOTHABSOLUTE THEN 3VALUE:=VALUE*RVTRIB:=LABELS; 7STK[STKINDEX].TIPE:=TNULL; 5 OPERFOLD; 5END 3ELSE 5BEGIN 7SPCIALSTKINDEX:=SPCIALSTKINDEX + 1; 7SPECIALSTKALUE 1ELSE EXPREXIT; *DIVIDE:IF BOTHABSOLUTE THEN 3VALUE:=VALUE DIV RVALUE 1ELSE EXPREXIT; *MODULO:IF BOTHABSOLUTE THEN 3V[SPCIALSTKINDEX]:=LEXTOKEN; 5END 1ELSE 3BEGIN 5STKINDEX:=STKINDEX + 1; 5STK[STKINDEX].TIPE:=LEXTOKEN; 3END; *LOCCTR:BEGINALUE:=VALUE MOD RVALUE 1ELSE EXPREXIT *END;{CASE} (END;{WITH} (STKINDEX:=STKINDEX-2; &END ELSE EXPREXIT; $END "ELSE IF ST 3STKINDEX:=STKINDEX + 1; 3IF CODESECTION=A THEN 5STK[STKINDEX].VALUE:=ALC 3ELSE STK[STKINDEX].VALUE:=LASTLC; 3IF RELOCATE=8 K[STKINDEX].VALUE:=SYM^.CODEOFFSET 3ELSE 5BEGIN 7STK[STKINDEX].VALUE:=0; 3 UNDEFINED:=TRUE; 5END; 3IF (SYM^.ATTRIBUTE<>UNKNOWN) AND (SYM^.ATTRIBUTE<>DEFS) THEN 5STK[STKINDEX].ATRIB:=SYM^.ATTRIBUTE 3ELSE 5STK[STKINDEX].ATRIB:=LABELS; 3IF NOT (SYM^.ATTRIBUTE IN A[ABS,DEFABS,DEFRP,DEFREG,DEFCC,DEFIR]) 3 THEN 5BEGIN 7IF (RELOCATE<>NULLREL) AND (RELOCATE.TIPE<>LCREL) THEN 9BEGIN ;IF UNDEFINED THEN =ERROR(28{cannot handle this relative}); 7 END 7ELSE 9BEGIN ;RELOCATE.TIPE:=LABELREL; ;RELOCATE.SYM:=SYM; 9END; 5END; 3STK[STKINDEX].TIPE:=TNULL; 3OPERFOLD; 1END; &ENDLINE,COMMA,OPENPAREN,EQUAL,NOTEQUAL: & EXPREND; &NUMBERSIGN,ATSIGN,TNOT,AUTOINCR,AUTODECR,CLOSEPAREN: 1BEGIN 3SPCIALSTKINDEX:=SPCIALSTKINDEX + 1; 8{start of ASM6} ({Copyright (c) 1978 Regents of University of California} ( PROCEDURE LEX; %  PROCEDURE PCONST;  VAR RADI3SPECIALSTK[SPCIALSTKINDEX]:=LEXTOKEN; 1END; 'CLSBROKEN:BEGIN 3IF STKINDEX=0 THEN EXPREXIT; 3IF (STK[STKINDEX-1].TIPE<>OPNBRX,I,NUM:INTEGER;  TEMP,ID:STRING; $VAL:WORDSWAP;  BEGIN "IF DEBUG THEN WRITELN('Pcon'); "TEMP:=' '; ID:=' '; "WHILE ((OKEN) THEN EXPREXIT; 3STK[STKINDEX-1].VALUE:=STK[STKINDEX].VALUE; 3STK[STKINDEX-1].ATRIB:=STK[STKINDEX].ATRIB; 3STK[STKINDEX-(CH>='A') AND (CH<='F')) OR ((CH>='0') AND (CH<='9'))) DO $BEGIN &IF CH>='A' THEN TEMP[1]:=CHR(ORD(CH)-55) (ELSE TEMP[1]:=CHR1].TIPE:=STK[STKINDEX].TIPE; 3STKINDEX:=STKINDEX - 1; 3IF (STK[STKINDEX].TIPE<>TNULL) THEN EXPREXIT; 1 OPERFOLD; 1END $END(ORD(CH)-ORD('0')); &ID:=CONCAT(ID,TEMP); $ GETCHAR; $END; "REPEAT $DELETE(ID,1,1); "UNTIL (ORD(ID[1])<>0) OR (LENGTH(ID)s relative}); 1 END 3ELSE 5BEGIN 7RELOCATE.TIPE:=LLREL; 7RELOCATE.TEMPLABEL:=TEMPLABEL; 5END; 3STKINDEX:=STKINDEX + 1;; {CASE STATEMENT} "UNTIL FALSE;  END;   3STK[STKINDEX].VALUE:=TEMP[TEMPLABEL].DEFOFFSET; 3STK[STKINDEX].ATRIB:=LABELS; 3STK[STKINDEX].TIPE:=TNULL; 3OPERFOLD; 1END1 2 QO^; $TIDENTIFIER: BEGIN 3UNDEFINED:=FALSE; 3STKINDEX:=STKINDEX + 1; 3IF SYM^.ATTRIBUTE IN 5[ABS,DEFABS,DEFRP,DEFREG,DEFCC,DEFIR,LABELS] THEN 7STK[STKINDEX].VALUE:=SYM^.OFFSETORVALUE 3ELSE IF (SYM^.ATTRIBUTE=DEFS) AND (SYM^.CODEOFFSET<>-1) THEN 3 ST9 TCH) THEN $RADIX:=8 "ELSE IF ORD(CH)=ORD(BINSWITCH) THEN $RADIX:=2 "ELSE $BEGIN &RADIX:=DEFRADIX; " ADVANCE:=FALSE; $s up the reserved word in the KWORD array and returns the correct )token for that key word. Only the LEXTOKEN is returned} " END; "LEXTOKEN:=CONSTANT; "TEMP[1]:=CHR(0); "CONSTVAL:=0;  CASE RADIX OF $16:IF LENGTH(ID)>4 THEN )ERROR(29{constant ove PROCEDURE PKWORD;  VAR I:INTEGER; KLUDGEPTR:^INTEGER;  ID:PACKNAME; $TEMP,ALTNAME:STRING;  BEGIN "IF DEBUG THEN WRITELrflow}) 'ELSE )BEGIN +WHILE LENGTH(ID)<4 DO ID:=CONCAT(TEMP,ID); +VAL.HEX1:=ORD(ID[1]); +VAL.HEX2:=ORD(ID[2]); N('PKW'); "GETCHAR;{Skip over the period} "ID:=' '; "I:=0; "WHILE (((CH>='A') AND (CH<='Z')) OR ((CH>='0') AND (CH<='+VAL.HEX3:=ORD(ID[3]); +VAL.HEX4:=ORD(ID[4]); +CONSTVAL:=VAL.HWORD; )END; $10:IF LENGTH(ID)>5 THEN )ERROR(29{constant over9'))) DO $BEGIN &IF I<8 THEN ID[I]:=CH; &I:=I+1; $ GETCHAR; $END; "IF I=0 THEN ERROR(45{Keyword expected}); "I:=-1; "FOflow}) 'ELSE )BEGIN +WHILE LENGTH(ID)<5 DO ID:=CONCAT(TEMP,ID); +NUM:=0; +FOR I:=1 TO 4 DO -IF ORD(ID[I])>9 THEN /BEGIN UND:=FALSE; "WHILE NOT FOUND AND (I3276) OR ((NUM=3276) AND  " WRITELN('>',ID,'<'); $ERROR(33{invalid key word}) #END ELSE $LEXTOKEN:=KTOKEN[I];  ADVANCE:=FALSE; (ORD(ID[5])>7)) THEN -ERROR(29{constant overflow}) +ELSE CONSTVAL:=NUM*10 + ORD(ID[5]); )END; %8:IF (LENGTH(ID)>6) OR ((ORD("IF ID='ENDM ' THEN {macro end} $BEGIN  MCSTKINDEX:=MCSTKINDEX - 1; &IF MCSTKINDEX>0 THEN (BEGIN ( MCPTR:=MACROSID[1])>1) AND (LENGTH(ID)=6)) THEN )ERROR(29{constant overflow}) 'ELSE )BEGIN +WHILE LENGTH(ID)<6 DO ID:=CONCAT(TEMP,ID); +TACK[MCSTKINDEX]; *MACROINDEX:=MCINDEX[MCSTKINDEX]; *WHILE MCPTR^[MACROINDEX]<>CHR(13) DO MACROINDEX:=MACROINDEX + 1; (END &FOR I:=2 TO 6 DO -IF ORD(ID[I])>7 THEN /BEGIN 1ERROR(31{illegal octal constant}); 1EXIT(PCONST); /END; +VAL.OCT1:=ORD(ID[1ELSE (BEGIN *SOURCE:=FILESOURCE; *WHILE XBLOCK[BLOCKPTR]<>CHR(13) DO BLOCKPTR:=BLOCKPTR + 1; & END; &REPEAT (LEX; &UNTIL]); +VAL.OCT2:=ORD(ID[2]); +VAL.OCT3:=ORD(ID[3]); +VAL.OCT4:=ORD(ID[4]); +VAL.OCT5:=ORD(ID[5]); +VAL.OCT6:=ORD(ID[6]); +CO (LEXTOKEN=ENDLINE) OR (LEXTOKEN=TEOF); &IF LEXTOKEN=TEOF THEN (ERROR(34{Unexpected end of input - after macro}) &ELSE LEX; NSTVAL:=VAL.HWORD; )END; %2:IF (LENGTH(ID)>16) THEN )ERROR(29{constant overflow}) 'ELSE )BEGIN $END "ELSE IF LEXTOKEN=INCLUDE THEN $IF ALTINPUT THEN &ERROR(35{Include files may not be nested}) $ELSE IF SOURCE<>FILESOURC+WHILE LENGTH(ID)<16 DO ID:=CONCAT(TEMP,ID); +FOR I:=1 TO 16 DO -IF ORD(ID[I])>1 THEN /BEGIN 1ERROR(32{illegal binary constE THEN &ERROR(37{This is a bad place for an include file}) $ELSE &BEGIN (ALTINPUT:=TRUE; (TEMP:=' '; ALTNAME:=' '; (REPEAT=1); "IF ORD(CH)=ORD(HEXSWITCH) THEN $RADIX:=16 "ELSE IF ORD(CH)=ORD(DECSWITCH) THEN $RADIX:=10 "ELSE IF ORD(CH)=ORD(OCTSWIant}); 1EXIT(PCONST); /END -ELSE VAL.BIN[16 - I]:=ORD(ID[I]); +CONSTVAL:=VAL.HWORD; )END "END; {Case}  END;  % {Look: ;  HASHA:=HASHA MOD HASHRANGE; "SYM:=HASH[HASHA]; "WHILE (NOT FOUND) AND (SYM<>NIL) DO $IF SYM^.NAME=ID THEN FOUND:=TRUE ESE IF (SYM^.ATTRIBUTE=UNKNOWN) OR (SYM^.ATTRIBUTE=DEFS) THEN -LEXTOKEN:=TLABEL .ELSE ERROR(38{only labels & comments may occupLSE SYM:=SYM^.LINK; "IF NOT FOUND THEN $BEGIN &IF DEBUG THEN WRITELN('not found',ORD(CURRENTATRIB):3); -{insert at the top oy column one}); #END $ELSE &IF (SYM^.ATTRIBUTE>=OPS1) AND (SYM^.ATTRIBUTE<=OPS20) THEN (CASE SYM^.ATTRIBUTE OF  *GETCHAR; *IF (CH<>' ') AND (CH<>CHR(13)) THEN ,BEGIN .TEMP[1]:=CH; .ALTNAME:=CONCAT(ALTNAME,TEMP); ,END; (UNTIL CH=CHR(f the list} &CASE CURRENTATRIB OF (MACROS: *BEGIN ,NEW(SYM,MACROS); ,SYM^.EXPANDMCRO:=EXPANDMACRO; *END; (DEFS: *BEGIN 13); (ALTBLOCNO:=BLOCKNO; (ALTBLOCPTR:=BLOCKPTR; ((*$I-*) (RESET(ALTFILE,ALTNAME); (IOCHECK(TRUE); ((*$I+*) & NEW(SYM,DEFS); ,SYM^.PROCNUM:=PROCNUM; ,SYM^.CODEOFFSET:=-1; * SYM^.DEFFWDREF:=NIL; *END; & PUBLICS,PRIVATES,REFS,(MARK(KLUDGEPTR);{dumps disk direc so next proc call won't STK-OFLW} (CURFNAME:=ALTNAME; (BLOCKNO:=2; BLOCKPTR:=1024; (LEXTOCONSTS: *BEGIN ,CASE CURRENTATRIB OF .PUBLICS:NEW(SYM,PUBLICS); .PRIVATES:NEW(SYM,PRIVATES); .REFS:NEW(SYM,REFS); .CONSTS:KEN:=ENDLINE; & IF NOT (CONSOLE AND DISPLAY) THEN *BEGIN ,WRITELN; ,WRITELN(TEXTLINE); ,WRITE('<',LINENUM:4,'>'); & ENNEW(SYM,CONSTS) ,END; ,SYM^.NREFS:=0; ,SYM^.NWORDS:=1; ,SYM^.LINKOFFSET:=NIL; *END; (PROCS:NEW(SYM,PROCS); (FUNCS:NEW(SYMD; &END;  END;  &{Search the symbol tree to locate the identifier and determine 'what it is. The types returned can be: OP,FUNCS); (UNKNOWN: *BEGIN ,NEW(SYM,UNKNOWN); ,SYM^.OFFSETORVALUE:=0; * SYM^.FWDREF:=NIL; *END (END; CODE1..10,TIDENTIFIER, 'if start-line is true then we return the token type of TLABEL}   PROCEDURE PIDENT;  VAR HASHA,HASHB&SYM^.NAME:=ID; SYM^.ATTRIBUTE:=CURRENTATRIB; &SYM^.LINK:=HASH[HASHA]; &HASH[HASHA]:=SYM;  END "ELSE IF SYM^.ATTRIBUTE=,I:INTEGER;   BEGIN "IF DEBUG THEN WRITELN('PID'); "ID:=' '; "I:=0; "WHILE ((CH>='A') AND (CH<='Z')) OR ((CH>='0')MACROS THEN $BEGIN &IF MCSTKINDEX>0 THEN (MCINDEX[MCSTKINDEX]:=MACROINDEX &ELSE (BEGIN *MCINDEX[MCSTKINDEX]:=BLOCKPTR; *E AND (CH<='9')) OR (CH='_') DO $BEGIN &IF I<8 THEN ID[I]:=CH; &I:=I+1; $ GETCHAR; $END;  HASHA:=0; FOUND:=FALSE; "FOR XPANDMACRO:=SYM^.EXPANDMCRO; (END; $ WHILE CH<>CHR(13) DO GETCHAR; &PRINTLINE; &SOURCE:=MACROSOURCE; &MCSTKINDEX:=MCSTKINDI:=0 TO 7 DO $BEGIN &HASHA:=HASHA + HASHA; {left shift} &HASHB:=ORD(ID[I]); &HASHA:=ORD((NOT ODD(HASHA) AND ODD(HASHB)) OR EX + 1; &MACROSTACK[MCSTKINDEX]:=SYM^.MACRO; &MCPTR:=SYM^.MACRO; &MACROINDEX:=0; &LEXTOKEN:=ENDLINE; &LEX; {re-initiate LEX5(ODD(HASHA) AND NOT ODD(HASHB))); {xor} $END; "HASHB:=HASHA MOD HASHRANGE; {lo-order part}  with appropriate SOURCE then exit to return called} &EXIT(LEX); {LEX's LEXTOKEN. style - 0, effeciency - 1} $END; "IF START"HASHA:=HASHA DIV HASHRANGE; {hi-order part} "HASHA:=ORD((NOT ODD(HASHA) AND ODD(HASHB)) OR -(ODD(HASHA) AND NOT ODD(HASHB)))LINE THEN #BEGIN $IF DEBUG THEN WRITELN('STARTLINE true'); $IF CH=':' THEN GETCHAR; $IF NOT FOUND THEN LEXTOKEN:=TLABEL &EL; "WHILE NOT FOUND AND (TEMPLABEL'"') AND (I<80) AND (CH<>CHR(13)) DO  *OPS12: LEXTOKEN:=OP12; *OPS13: LEXTOKEN:=OP13; *OPS14: LEXTOKEN:=OP14; *OPS15: LEXTOKEN:=OP15; *OPS16: LEXTOKEN:=OP16; *"BEGIN $SCH[1]:=CH; $STRVAL:=CONCAT(STRVAL,SCH); $IF SOURCE=PARMSOURCE THEN BACKSCAN:=TRUE; {always true if ever!} OPS17: LEXTOKEN:=OP17; *OPS18: LEXTOKEN:=OP18; *OPS19: LEXTOKEN:=OP19; *OPS20: LEXTOKEN:=OP20 (END *ELSE LEXTOKEN:=TIDENTIF$GETCHAR; $I:=I+1; "END; "NOTSTRING:=TRUE; "IF BACKSCAN THEN $BEGIN &I:=SCAN(-I,<>' ',STRVAL[I]); &STRVAL[0]:=CHR(LENGTHIER; "IF DEBUG THEN WRITELN('PASSED=',SYM^.NAME,' VALUE=', AORD(SYM^.ATTRIBUTE):5,HASHA:10);  ADVANCE:=FALSE;  END; & &{(STRVAL) + I); $END; "IF CH=CHR(13) THEN "BEGIN $LEXTOKEN:=ENDLINE; $ERROR(41{string constant must be on one line}); "END;A $ has been encountered and we are now processing a local label} &  PROCEDURE PLLABEL;  VAR I:INTEGER;  BEGIN "IF DEBUG TH "IF I>80 THEN $ERROR(42{string constant exceeds 80 chars});  END;   BEGIN {Lex} "IF DEBUG THEN WRITELN('Lex'); "STARTLIEN WRITELN('PLLAB'); "ID:=' '; "I:=0; "WHILE (CH>='0') AND (CH<='9') DO $BEGIN &IF I<8 THEN ID[I]:=CH; &I:=I+1; $ NE:=(LEXTOKEN=ENDLINE); "IF STARTLINE THEN $BEGIN &TEXTLINE:=BLANKLINE; &TEXTINDEX:=-1; $END; "GETCHAR; "WHILE CH=' ' DO  GETCHAR; $END; "IF I=0 THEN ERROR(39{expected local label}); "FOUND:=FALSE; "TEMPLABEL:=0; $BEGIN &GETCHAR; " STARTLINE:=FALSE; $END; "IF CH=CHR(13) THEN LEXTOKEN:=ENDLINE ELSE "BEGIN $CASE CH OF &'0','1','2'< &':LEXTOKEN:=AMPERSAND; &'*':LEXTOKEN:=ASTERISK; &'%':LEXTOKEN:=MODULO; &'<':BEGIN ,GETCHAR; ,IF CH='>' THEN .LEXTOKEN:=NOTEQUAL ,ELSE .BEGIN 0LEXTOKEN:=OPNBROKEN; 0ADVANCE:=FALSE; .END; *END; &'>':LEXTOKEN:=CLSBROKEN; &'=':LEXTOKEN:=EQUAL; $END;(*OF CASE STATMENT*) "END; "IF DEBUG THEN WRITELN('LEXTOKEN IS:',ORD(LEXTOKEN));  END; (*of procedure LEX*)   BEGIN {Main Assembler} "INITIALIZE; "REPEAT " ASSEMBLE; $IF (PROCNUM>0) AND LISTING THEN SYMTBLDUMP; $PROCEND; "UNTIL LEXTOKEN=TEND;  END;  {start of DISASM1.TEXT}  {Copyright (c) Regents of University of California at San Diego} (  PROCEDURE PROCEJUR;  VAR HEX:HEXTYPE;  LINENUM,LPROCNUM:INTEGER;   PROCEDURE JUMPINFO;  VAR OTHERBYTE:INTEGER;  BEGIN "BACKJUMP:=0; BYTEPOS:=BYTEPOS - 6; OFFSET:=OFFSET - 6; "REPEAT $BACKJUMP:=BACKJUMP + 1; $OTHERBYTE:=LASTBYTE; $BITE:=LASTBYTE; $IF (SWAP) AND (BITE<128) THEN {jumps relative to start of segment} &JUMPS[BACKJUMP]:=BUFSTART + BYTEPOS - BITE*256 - .GETCHAR; .IF (CH<'0') OR (CH>'9') THEN 0BEGIN 2LEXTOKEN:=LOCCTR; 2ADVANCE:=FALSE; 0END .ELSE PLLABEL; ,END *ELSE ,BEGIN .GETCHAR; .PLLABEL; ,END; &'"':PSTRING; {Process a string} &'/':LEXTOKEN:=DIVIDE; &'!':LEXTOKEN:=TNOT; &'+':BO^EGIN ,GETCHAR; ,IF CH=CHR(ORD(AFTERPLUS)) THEN LEXTOKEN:=AUTOINCR .ELSE LEXTOKEN:=PLUS; {Char after plus isn't eaten} ,ADVANCE:=FALSE; *END; &'-':BEGIN ,GETCHAR; ,IF CH=CHR(ORD(AFTERMINUS)) THEN LEXTOKEN:=AUTODECR .ELSE LEXTOKEN:=MINUS; {Char after minus isn't eaten} ,ADVANCE:=FALSE; *END; &':':LEXTOKEN:=COLON; &'|':LEXTOKEN:=BITWISEOR; &'^':LEXTOKEN:=EXCLUSIVEOR; &'= T(BUFSTART + BYTEPOS,-OFFSET,-1) $ELSE &BYTEPOS:=BYTEPOS - OFFSET; "PROCSTART:=BUFSTART + BYTEPOS; {jumps now relative to staRTOP; 3CMPRSS:CMPRSSOP; 2CMPRSS2:CMPRSS2OP; 6ONE:ONEOP; 5CHRS:CHRSOP; 6BLK:BLKOP; 6OPT:OPTOP; 5LOPT:LOPTOP; 6TWO:TWOOP; rt of procedure} "FOR BACKJUMP:=1 TO JUMPS[0] DO JUMPS[BACKJUMP]:=JUMPS[BACKJUMP] - PROCSTART;  END;   BEGIN (*PROCEJUR*) 4WORDS:WORDSOP; 5WORD:WORDOP .END; *UNTIL DONEPROC; (END;  END;  END; &  PROCEDURE ALLPROCS;  VAR I,J,MAXDIST,INDE"IF PROCS[PROCNUM]=0 THEN $WRITELN('Procedure not in file') "ELSE $BEGIN &BYTEPOS:=SEGSIZE - BUFSTART - 2*(PROCNUM + 1) - PX:INTEGER; $SORTNUMS:ARRAY[0..MAXPROCNUM] OF INTEGER;  SORTPROCS:ARRAY[0..MAXPROCNUM] OF BYTE;  BEGIN "IF DISPLAY THEN ROCS[PROCNUM] - 2; &IF BYTEPOS<0 THEN (BYTEPOS:=BUFRESET(SEGSIZE - 2*(PROCNUM + 1),-PROCS[PROCNUM] - 2,-1) &ELSE IF BYTEPOS>2$BEGIN &SORTNUMS:=PROCS; &FOR I:=1 TO MAXPROCNUM DO SORTPROCS[I]:=I; &FOR I:=1 TO PROCS[0] DO (BEGIN *MAXDIST:=0; *INDEX:=0; *FOR J:=I TO PROCS[0] DO ,IF SORTNUMS[J]>=MAXDIST THEN .BEGIN 0MAXDIST:=SORTNUMS[J]; 0INDEX:=J; .END; TBYTE; &LEXLEVEL:=GETBYTE; &BYTEPOS:=BYTEPOS - 4; &IF LEXLEVEL=255 THEN LEXLEVEL:=-1; &IF NOT (LEXCHECK OR LEXLOOK) THEN (I*SORTNUMS[INDEX]:=SORTNUMS[I]; *SORTNUMS[I]:=SORTPROCS[INDEX]; *SORTPROCS[INDEX]:=SORTPROCS[I]; (END; &FOR I:=1 TO PROCS[0]F LPROCNUM=0 THEN *WRITELN('Procedure ',PROCNUM:3,' is written in Assembly.') (ELSE (BEGIN *JUMPINFO; *DONEPROC:=FALSE; *I DO (BEGIN *PROCNUM:=SORTNUMS[I]; *PROCEJUR; (END; $END "ELSE FOR PROCNUM:=1 TO PROCS[0] DO PROCEJUR;  END;   PROCEDURF DISPLAY THEN WRITELN(LISTFILE, 0' ':10,'BLOCK #',BYTEPOS DIV 512 + BUFSTBLK:3, 0' OFFSET IN BLOCK=',BYTEPOS MOD 512:3,CRE SEGMINT;  BEGIN "IF SWAP THEN $BEGIN &SEGSTBLK:=SEGDIREC[SEGNUM*4 + 1]; &SEGSIZE:=SEGDIREC[SEGNUM*4 + 3] + SEGDIREC[SEGNU, 0'SEGMENT PROC OFFSET#',' ':35,'HEX CODE') ,ELSE IF NOT CONTROL THEN .BEGIN 0WRITE('.'); 0IF PROCNUM=50 THEN WRITE(CRM*4 + 2]*256; $END "ELSE $BEGIN &SEGSTBLK:=SEGDIREC[SEGNUM*4]; &SEGSIZE:=SEGDIREC[SEGNUM*4 + 3]*256 + SEGDIREC[SEGNUM*4 + 2,' '); .END ,ELSE WRITE(CR,'[',PROCNUM:2,']'); *LINENUM:=0; *REPEAT ,HEX.WORD:=BUFSTART + BYTEPOS - PROCSTART; ]; " END; "BUFSTBLK:=SEGSTBLK; "IF SEGSIZE>2560 THEN &BYTEPOS:=BUFRESET(SEGSIZE,-1,1) $ELSE &BYTEPOS:=BUFRESET(SEGSIZE,-1,IF DISPLAY THEN WRITE(LISTFILE,SEGNUM:7,PROCNUM:5,HEX.WORD:6,'(', 0HEXCHAR[HEX.DUM1],HEXCHAR[HEX.HI],HEXCHAR[HEX.LO],'): '),0); "PROCS[0]:=BUFFER[BYTEPOS]; (* number of procs in segment *) "BYTEPOS:=BYTEPOS - 2*PROCS[0] - 1; "FOR PROCNUM:=PROCS[0] OTHERBYTE $ELSE IF (NOT SWAP) THEN &IF OTHERBYTE<128 THEN (JUMPS[BACKJUMP]:=BUFSTART + BYTEPOS - BITE - OTHERBYTE*256 &ELSE; ,IF CONTROL AND NOT CONSOLE THEN .BEGIN 0WRITE('.'); 0LINENUM:=LINENUM + 1; 0IF (LINENUM MOD 50=0) THEN WRITE(CR,' '); BITE:=OTHERBYTE; "UNTIL (BITE>127) OR (BACKJUMP=99); "JUMPS[0]:=BACKJUMP - 1; "IF BYTEPOS - OFFSET<0 THEN &BYTEPOS:=BUFRESE .END; ,HEXCOUNT:=0; ,CODE:=' '; ,BITE:=GETBYTE; ,OPTOTAL:=OPTOTAL + 1; ,CASE RECTYPES[BITE] OF 4SHORT:SHO> ; "WRITELN; "FOR PROCNUM:=1 TO PROCS[0] DO $BEGIN &DATASEGINFO; &GOTOXY(15*((PROCNUM-1) DIV I),5+((PROCNUM-1) MOD I)); &WRDO .BEGIN 0PROCEJUR; 0PROCLEX[PROCNUM]:=LEXLEVEL; .END; ,CH:=CHR(7); *END; &END; "UNTIL (CH='Q') OR (CH=CHR(7));  DOWNTO 1 DO PROCS[PROCNUM]:=GETWORD; "IF NOT (CONTROL OR LEXCHECK) THEN ALLPROCS;  END;  PROCEDURE ACTACCESS; {FINALEX,OFFSITE(PROCNUM:5,':',LEXLEVEL:3,DTSGSZ:6); $END; "FOR J:=1 TO (5 - (PROCS[0] MOD 5)) DO WRITELN; "PROMPT; "LEXLOOK:=FALSE;  ENET:INTEGER;}  VAR FINALPROC,FINALSEG:INTEGER; %INSIDE:BOOLEAN;  BEGIN D;   BEGIN {PROCGUIDE} "SEGMINT; "REPEAT $PAGE(OUTPUT); $WRITE('Procedure guide: #(of procedure),'); $IF LEXCHECK THEN "IF (FINALEX=PROCLEX[DATAPROC]) AND (PROCNUM>=DATAPROC) THEN $IF SEGNUM=DATASEG THEN &BEGIN (INSIDE:=(PROCNUM=DATAPROC); (F&WRITELN('L(isting),Q(uit)') $ELSE &WRITELN('A(ll),L(isting),Q(uit)'); $WRITE(' to segment: '); $FOR I:=1 TO 8 DO WRITE(CHINALPROC:=PROCNUM; (WHILE PROCLEX[FINALPROC]>PROCLEX[DATAPROC] DO FINALPROC:=FINALPROC - 1; (IF FINALPROC=DATAPROC THEN *{$R-R(SEGDIREC[63 + SEGNUM*8 + I])); $PROCNUM:=0; $WRITE(CR,CR,'which procedure '); $IF LEXCHECK THEN &WRITE('data segment to wa} *DSSTART^[OFFSET]:=DSSTART^[OFFSET] + 1; *{$R+} &END $ELSE IF (DATAPROC=1) AND (SEGNUM>DATASEG) THEN &BEGIN (FINALSEG:=Stch?') $ELSE &WRITE('to dis-assemble?'); $READ(CH); $IF (CH='L') THEN (PROCLOOK EGNUM; (WHILE SEGLEX[FINALSEG]>SEGLEX[DATASEG] DO FINALSEG:=FINALSEG - 1; (IF FINALSEG=DATASEG THEN *{$R-} *DSSTART^[OFFSET]$ELSE IF (CH='A') AND (NOT LEXCHECK) THEN &BEGIN & PAGE(OUTPUT); (WRITELN('dis-assembling all',PROCS[0]:3,' procedures',CR,:=DSSTART^[OFFSET] + 1; *{$R+} &END;  END;   PROCEDURE PROCGUIDE;  TYPE SPACEPTR=^SPACE; &SPACE=ARRAY[0..19] OF INTEGERCR); (IF NOT DISPLAY THEN WRITE(CR,CR,'(',SEGNUM:2,')'); (ALLPROCS; & PROMPT; (CH:='Q'; &END $ELSE IF (CH>='0') AND (CH<=;  VAR I,J:INTEGER;  DSSPACE:SPACEPTR;   PROCEDURE DATASEGINFO;  VAR TEMP:INTEGER;  BEGIN "PROCEJUR; "BYTEPOS:'9') THEN &BEGIN (PROCNUM:=ORD(CH)-ORD('0'); (READ(CH); (IF (CH>='0') AND (CH<='9') THEN *PROCNUM:=PROCNUM*10 + ORD(CH) - O=BYTEPOS - 2; "IF SWAP THEN $BEGIN &DTSGSZ:=LASTBYTE; &DTSGSZ:=DTSGSZ + LASTBYTE*256; &TEMP:=LASTBYTE; &DTSGSZ:=DTSGSZ + LRD('0'); (IF (PROCNUM<1) OR (PROCNUM>PROCS[0]) THEN *BEGIN ,WRITELN(CR,'I didn''t say you had THAT procedure!'); ( PROMPTASTBYTE*256 + TEMP; $END "ELSE $BEGIN &DTSGSZ:=LASTBYTE*256; &DTSGSZ:=DTSGSZ + LASTBYTE; &TEMP:=LASTBYTE*256; ; *END (ELSE IF NOT LEXCHECK THEN *BEGIN ,PAGE(OUTPUT); ,WRITELN('dis-assembling procedure',PROCNUM:3,CR); ,PROCEJUR; ,PR&DTSGSZ:=DTSGSZ + LASTBYTE + TEMP; $END; "DTSGSZ:=DTSGSZ DIV 2;  END; "  PROCEDURE PROCLOOK;  BEGIN "GOTOXY(0,3); WRITE(OMPT; ,CH:=' '; *END (ELSE *BEGIN ,DATAPROC:=PROCNUM; ,DATASEG:=SEGNUM; ,DATASEGINFO; ,DATASEGSIZE:=DTSGSZ; ,NEW(DSSTAR' ':50); GOTOXY(0,3); "LEXLOOK:=TRUE; "I:=(PROCS[0] DIV 5) + 1; "FOR J:=0 TO ((PROCS[0]-1) DIV I) DO WRITE(' # LL SIZE')T); ,FOR I:=1 TO ((DATASEGSIZE+19) DIV 20) DO NEW(DSSPACE); ,FILLCHAR(DSSTART^,DATASEGSIZE*2,0); ,FOR PROCNUM:=1 TO PROCS[0] ? watching?'); (READ(KEYBOARD,CH); (IF CH='Y' THEN DATAWATCH:=FALSE; &END; "UNTIL (CH=CHR(7)) OR (NOT DATAWATCH); "IF DATAWATCH THEN $FOR SEGNUM:=0 TO 15 DO &IF SEGDIREC[4*SEGNUM] + SEGDIREC[4*SEGNUM + 1]<>0 THEN (BEGIN *SEGMINT; {Sets up appropiate segment} *PROCNUM:=1; *PROCEJUR; {Sets up procedure to determine segment's lexlevel} *SEGLEX[SEGNUM]:=LEXLEVEL; (END &ELSEO^ SEGLEX[SEGNUM]:=100; "PAGE(OUTPUT); "LEXCHECK:=FALSE;  END;   BEGIN (* SEGMENT DISASSEMBLE *) "PAGE(OUTPUT); "GOTOXY(0, END;   PROCEDURE SEGMTGUIDE;  VAR I,J:INTEGER;  BEGIN "REPEAT $PAGE(OUTPUT); $WRITELN('Segment guide: #(of segment),Q10); "WRITE(' Do you wish to keep track of references',CR, *' to a particular procedure''s data segment?'); (uit)'); $WRITELN(CR,CR,'you have these segments:'); $FOR I:=0 TO 15 DO &BEGIN (WRITE(I:4,' '); (FOR J:=1 TO 8 DO WRIT"READ(KEYBOARD,CH); "DATAWATCH:=(CH='Y'); "IF DATAWATCH THEN LEXGUIDE ELSE LEXCHECK:=FALSE; "PAGE(OUTPUT); "GOTOXY(0,10); "E(CHR(SEGDIREC[63 + I*8 + J])); $ WRITELN; &END;  WRITE(CR,'which segment to look at '); $IF LEXCHECK THEN &WRITE('tWRITE('Do you wish control over dis-assembly?'); "READ(KEYBOARD,CH); "CONTROL:=(CH='Y'); "IF CONTROL THEN $BEGIN o decide on DATA SEGMENT?') $ELSE &WRITE('for possible DIS-ASSEMBLY?'); $READ(CH); $IF CH<>'Q' THEN " BEGIN (SEGNUM:=0;&PAGE(OUTPUT); &GOTOXY(0,7); &WRITE(CHR(7)); &WRITE('*** WARNING - - STATISTICS ARE GATHERED ON DIS-ASSEMBLED'); &WRITEL (IF (CH>='0') AND (CH<='9') THEN SEGNUM:=ORD(CH)-ORD('0'); (READ(CH); (IF (CH>='0') AND (CH<='9') THEN *SEGNUM:=SEGNUM*10 +N(' PROCEDURES ONLY ***'); &IF DATAWATCH THEN WRITELN(CR,CR,' ', 9'*** THIS INCLUDES DATA SEGMENT WATCHING * ORD(CH) - ORD('0'); (IF (SEGDIREC[4*SEGNUM] + SEGDIREC[4*SEGNUM + 1]=0) OR (SEGNUM>15) THEN *BEGIN ,WRITELN(CR,'I didn''t sa**'); &READ(KEYBOARD,CH); &SEGMTGUIDE; $END "ELSE $BEGIN &IF NOT CONSOLE THEN WRITE(CHR(12),CR); &FOR SEGNUM:=0 TO 15 DO y you had THAT segment!'); ,READ(KEYBOARD,CH); *END (ELSE *BEGIN ,PROCGUIDE; ,IF CH<>CHR(7) THEN CH:='A'; *END; " END(BEGIN *IF NOT DISPLAY THEN WRITE(CR,'(',SEGNUM:2,')'); *IF SEGDIREC[4*SEGNUM] + SEGDIREC[4*SEGNUM + 1]<>0 THEN SEGMINT; (EN; "UNTIL (CH='Q') OR (CH=CHR(7));  END;   PROCEDURE LEXGUIDE;  BEGIN "LEXCHECK:=TRUE; "DATASEG:=-1; "REPEAT D;  PROMPT; $END;  END; $SEGMTGUIDE; $IF CH='Q' THEN &BEGIN (PAGE(OUTPUT); (GOTOXY(0,10); (WRITELN('have you changed your mind about data segment @  8{start of DISASM2.TEXT}  {Copyright (c) Regents of University of California at San Diego} (ITELN(LISTFILE,' Segment:',I:4,' Procedure:',J:4, J' Calls:',PROCCALL[I]^[J]:4);  END;   PROCEDURE SHORTSTUFF;  VAR I:  SEGMENT PROCEDURE GATHER;  VAR FILENAME:STRING;   PROCEDURE WRITEHDR(VAR H:INTERACTIVE;HEADER:INTEGER);  BEGIN "CASE INTEGER;   PROCEDURE SHORT1(VAR H:INTERACTIVE);  BEGIN "PCTMAX:=ROUND(SLDC/MAXOP*20); "WRITE(H,CR,'SLDC OPCODE: 0..127 HEADER OF $1: WRITELN(H,' Parameter one'); $2: WRITELN(H,'Bits used Total Percentage'); $3: WRITELN(H,'  TOTAL:', -SLDC:8,SLDC/OPTOTAL*100:16:2,' % '); "FOR I:=1 TO PCTMAX DO WRITE(H,'*'); "IF SLDC<>0 THEN $BEGIN  Parameter one Parameter two '); $4: WRITELN(H,'Bits used Total Percentage Total Percentage'); $&WRITELN(H,CR); WRITEHDR(H,8); &FOR OP:=0 TO 31 DO (WRITELN(H,OP:4,':',OPCODE[OP]^.TOTAL0:7,OPCODE[OP]^.TOTAL0/SLDC*100:7:2, 5: WRITELN(H,' Parameter one Parameter two', O' Case table size'); $6: WRITELN(H,'Bits used Tot)OP+32:4,':',OPCODE[OP+32]^.TOTAL0:7,OPCODE[OP+32]^.TOTAL0/SLDC*100:7:2, )OP+64:4,':',OPCODE[OP+64]^.TOTAL0:7,OPCODE[OP+64]^.Tal Percentage Total Percentage', R' Total Percentage'); $7: WRITELN(H,'Flavor Total Percentage FlavOTAL0/SLDC*100:7:2, )OP+96:4,':',OPCODE[OP+96]^.TOTAL0:7,OPCODE[OP+96]^.TOTAL0/SLDC*100:7:2); " END; "PCTMAX:=ROUND(SLDL/MAXor', P' Total Percentage'); $8: WRITELN(H,' # Total Pct # Total Pct # Total', P' Pct # TotalOP*20); "WRITE(H,CR,CR,'SLDL OPCODE: 216..231 TOTAL:', 1SLDL:8,SLDL/OPTOTAL*100:16:2,' % '); "FOR I:=1 TO PCTMAX DO WRITE(H Pct') "END;  END;   PROCEDURE JUMPSTUFF;  VAR I:INTEGER;  BEGIN  WRITELN(LISTFILE,CR,'Jump statistics on the',JUMPTOTAL:5,' Total jumps'); "IF JUMPTOTAL>0 THEN " BEGIN &WRITELN(LISTFILE,CR, 0' Positive jumps Negative jumps'); &WRITEHDR(LISTFILE,4); &WITH JUMPSTATS DO (FOR I:=0 TO 15 DO *WRITELN(LISTFILE,I:5,POS[I]:13,POS[I]/JUMPTOTAL*100:14:2, 9NEG[I]:9,NEG[I]/JUMPTOTAL*100:14:2);  END "ELSE WRITELN(LISTFILE,CR,'Sorry no jumps today!');  END;   PROCEDURE PROCSTUFF;  VAR I,J:INTEGER;  BEGIN "WRITELN(LISTFILE,CR,'Procedure call statistics'); "FOR I:=0 TO 15 DO $IF PROCCALL[I]<>NIL THEN &FOR J:=1 TO MAXPROCNUM DO (IF PROCCALL[I]^[J]>0 THEN *WRA ND;  END;   PROCEDURE SHORT2(VAR H:INTERACTIVE);  BEGIN "PCTMAX:=ROUND(SLDO/MAXOP*20); OUND(INUM/MAXOP*20); &WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' % '); &IF TOTAL1<>0 THEN (BEGIN *FOR I:=1 TO PCTMAX DO W"WRITE(H,CR,CR,'SLDO OPCODE: 232..247 TOTAL:', 1SLDO:8,SLDO/OPTOTAL*100:16:2,' % '); "FOR I:=1 TO PCTMAX DO WRITE(H,'*'); RITE(LISTFILE,'*'); *WRITELN(LISTFILE,CR); *WRITEHDR(LISTFILE,1); WRITELN(LISTFILE); *WRITEHDR(LISTFILE,2); *FOR I:=0 TO 7 D"IF SLDO<>0 THEN $BEGIN &WRITELN(H,CR); WRITEHDR(H,8); &FOR OP:=232 TO 235 DO (WRITELN(H,OP:4,':',OPCODE[OP]^.TOTAL0:7,OPCODO +WRITELN(LISTFILE,I:5,BYTEONE1[I]:13,BYTEONE1[I]/TOTAL1*100:14:2); (END $ ELSE WRITELN(LISTFILE); $END; "END; &  PROCEE[OP]^.TOTAL0/SLDO*100:7:2, +OP+4:4,':',OPCODE[OP+4]^.TOTAL0:7,OPCODE[OP+4]^.TOTAL0/SLDO*100:7:2, +OP+8:4,':',OPCODE[OP+8]^.TODURE TWOST;  VAR I:INTEGER;  BEGIN "WITH OPCODE[OP]^ DO $BEGIN &PCTMAX:=ROUND(TOTAL2/MAXOP*20); TAL0:7,OPCODE[OP+8]^.TOTAL0/SLDO*100:7:2, +OP+12:4,':',OPCODE[OP+12]^.TOTAL0:7,OPCODE[OP+12]^.TOTAL0/SLDO*100:7:2); $END; "PC&WRITE(LISTFILE,TOTAL2:8,TOTAL2/OPTOTAL*100:16:2,' % '); &FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*'); &WRITELN(LISTFILE,CR); WTMAX:=ROUND(SIND/MAXOP*20); "WRITE(H,CR,CR,'SIND OPCODE: 248..255 TOTAL:', 1SIND:8,SIND/OPTOTAL*100:16:2,' % '); "FOR I:=1 RITEHDR(LISTFILE,3); &WRITELN(LISTFILE); WRITEHDR(LISTFILE,4); &IF TOTAL2=0 THEN (FOR I:=0 TO 7 DO *WRITELN(LISTFILE,I:5,BYTTO PCTMAX DO WRITE(H,'*'); "IF SIND<>0 THEN $BEGIN &WRITELN(H,CR); WRITEHDR(H,8); &FOR OP:=248 TO 249 DO (WRITELN(H,OP:4,':EONE2[I]:13,0.0:14:2,BYTETWO2[I]:9,0.0:14:2) &ELSE (FOR I:=0 TO 7 DO *WRITELN(LISTFILE,I:5,BYTEONE2[I]:13,BYTEONE2[I]/TOTAL2*',OPCODE[OP]^.TOTAL0:7,OPCODE[OP]^.TOTAL0/SIND*100:7:2, -OP+2:4,':',OPCODE[OP+2]^.TOTAL0:7,OPCODE[OP+2]^.TOTAL0/SIND*100:7:2, 100:14:2, 8BYTETWO2[I]:9,BYTETWO2[I]/TOTAL2*100:14:2); &IF OP=205 THEN (BEGIN *WRITELN(LISTFILE); WRITEHDR(LISTFILE,7); *IF-OP+4:4,':',OPCODE[OP+4]^.TOTAL0:7,OPCODE[OP+4]^.TOTAL0/SIND*100:7:2,  TOTAL2=0 THEN ,FOR I:=2 TO 15 DO /WRITELN(LISTFILE,NAMES[56+I],FLAVOR2[I]:9,0.0:14:2,' ', 9NAMES[56+I+14],FLAVOR2[I+14]:-OP+6:4,':',OPCODE[OP+6]^.TOTAL0:7,OPCODE[OP+6]^.TOTAL0/SIND*100:7:2); $END;  WRITELN(H);  END;   BEGIN(* SHORTSTUFF *)9,0.0:14:2) *ELSE ,FOR I:=2 TO 15 DO .WRITELN(LISTFILE,NAMES[56+I],FLAVOR2[I]:9, 8FLAVOR2[I]/TOTAL2*100:14:2,' ', 8NAME,'*'); "IF SLDL<>0 THEN $BEGIN &WRITELN(H,CR); WRITEHDR(H,8); &FOR OP:=216 TO 219 DO (WRITELN(H,OP:4,':',OPCODE[OP]^.TOTAL0 "SHORT1(LISTFILE); "SHORT2(LISTFILE);  END;   PROCEDURE SHORTST;  VAR I:INTEGER;  BEGIN "INUM:=OPCODE[OP]^.TOTAL0; ":7,OPCODE[OP]^.TOTAL0/SLDL*100:7:2, )OP+4:4,':',OPCODE[OP+4]^.TOTAL0:7,OPCODE[OP+4]^.TOTAL0/SLDL*100:7:2, )OP+8:4,':',OPCODE[OPCTMAX:=ROUND(INUM/MAXOP*20); "WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' % '); "FOR I:=1 TO PCTMAX DO WRITE('*'); "WRITELP+8]^.TOTAL0:7,OPCODE[OP+8]^.TOTAL0/SLDL*100:7:2, )OP+12:4,':',OPCODE[OP+12]^.TOTAL0:7,OPCODE[OP+12]^.TOTAL0/SLDL*100:7:2); $EN(LISTFILE);  END;   PROCEDURE ONEST;  VAR I:INTEGER;  BEGIN  WITH OPCODE[OP]^ DO $BEGIN &INUM:=TOTAL1; &PCTMAX:=RB S[56+I+14],FLAVOR2[I+14]:9, 8FLAVOR2[I+14]/TOTAL2*100:14:2); (END; $END;  END;   PROCEDURE WORDST;  VAR I:INTEGER;  B.PARMTWO5[I]:9,PARMTWO5[I]/TOTAL5*100:14:2, .PARMTHREE5[I]:9,PARMTHREE5[I]/TOTAL5*100:14:2); (END &ELSE WRITELN(LISTFILE);  EGIN  WITH OPCODE[OP]^ DO $BEGIN &INUM:=TOTAL3; &PCTMAX:=ROUND(INUM/MAXOP*20);  END;  END;   PROCEDURE CMPRSSST;  VAR I:INTEGER;  BEGIN  WITH OPCODE[OP]^ DO $BEGIN &PCTMAX:=ROUND(TOTAL6/MAXOP&WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' % '); &IF TOTAL3<>0 THEN (BEGIN *FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*'); *20); &WRITE(LISTFILE,TOTAL6:8,TOTAL6/OPTOTAL*100:16:2,' % '); &FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*'); &WRITELN(LISTFILE,*WRITELN(LISTFILE,CR); WRITEHDR(LISTFILE,1); *WRITELN(LISTFILE); WRITEHDR(LISTFILE,2); *FOR I:=0 TO 15 DO ,WRITELN(LISTFILE,ICR); WRITEHDR(LISTFILE,7); &IF TOTAL6=0 THEN (BEGIN *FOR I:=0 TO 19 DO ,WRITELN(LISTFILE,NAMES[86+I],FLAVOR6[I]:9,0.0:14:2,':5,PARMONE3[I]:13,PARMONE3[I]/TOTAL3*100:14:2); (END $ ELSE WRITELN(LISTFILE); $END;  END; %  PROCEDURE LOPTST;  VAR I ', 4NAMES[106+I],FLAVOR6[I+20]:9,0.0:14:2); *WRITELN(LISTFILE,NAMES[126]:44,FLAVOR6[40]:9,0.0:14:2); (END &ELSE :INTEGER;  BEGIN  WITH OPCODE[OP]^ DO $BEGIN &INUM:=TOTAL4; &PCTMAX:=ROUND(INUM/MAXOP*20); &WRITE(LISTFILE,INUM:8,INUM/O(BEGIN *FOR I:=0 TO 19 DO ,WRITELN(LISTFILE,NAMES[86+I],FLAVOR6[I]:9, .FLAVOR6[I]/TOTAL6*100:14:2, .NAMES[106+I]:13,FLAVOR6PTOTAL*100:16:2,' % '); &IF TOTAL4<>0 THEN (BEGIN *FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*'); *WRITELN(LISTFILE,CR); WRITEHD[I+20]:9,FLAVOR6[I+20]/TOTAL6*100:14:2); *WRITELN(LISTFILE,NAMES[126]:44, .FLAVOR6[40]:9,FLAVOR6[40]/TOTAL6*100:14:2); (END; R(LISTFILE,3); *WRITELN(LISTFILE); WRITEHDR(LISTFILE,4); *FOR I:=0 TO 7 DO ,WRITELN(LISTFILE,I:5,BYTEONE4[I]:13,BYTEONE4[I]/T$END;  END;   PROCEDURE CMPRSS2ST;  VAR I:INTEGER;  BEGIN "WITH OPCODE[OP]^ DO "BEGIN $INUM:=TOTAL7; $PCTMAX:=ROUNDOTAL4*100:14:2, .PARMTWO4[I]:9,PARMTWO4[I]/TOTAL4*100:14:2); *FOR I:=8 TO 15 DO ,WRITELN(LISTFILE,I:5,PARMTWO4[I]:36,PARMTWO4(INUM/MAXOP*20); $WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' % '); $FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*'); $WRITELN(LI[I]/TOTAL4*100:14:2); $ END $ ELSE WRITELN(LISTFILE); $END;  END;   PROCEDURE WORDSST;  VAR I:INTEGER;  BEGIN STFILE,CR); WRITEHDR(LISTFILE,7); $FOR I:=1 TO 6 DO &BEGIN (IF INUM<>0 THEN *WRITE(LISTFILE,NAMES[51+I],FLAVOR7[I]:9,FLAVOR7 WITH OPCODE[OP]^ DO $BEGIN &INUM:=TOTAL5; &PCTMAX:=ROUND(INUM/MAXOP*20); &WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' [I]/INUM*100:14:2,' ') (ELSE *WRITE(LISTFILE,NAMES[51+I],FLAVOR7[I]:9,0.0:14:2,' '); (IF (I MOD 2=0) THEN WRITELN(LIS% '); &IF TOTAL5<>0 THEN (BEGIN *FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*'); *WRITELN(LISTFILE,CR); WRITEHDR(LISTFILE,5); *WTFILE); &END; "END;  END;   PROCEDURE GINIT;  BEGIN "MAXOP:=0;  FOR OP:=128 TO 215 DO $WITH OPCODE[OP]^ DO &CASE RERITELN(LISTFILE); WRITEHDR(LISTFILE,6); *FOR I:=0 TO 15 DO ,WRITELN(LISTFILE,I:5,PARMONE5[I]:13,PARMONE5[I]/TOTAL5*100:14:2, CTYPES[OP] OF ,ONE,CHRS,BLK:IF (TOTAL1>MAXOP) THEN MAXOP:=TOTAL1; 5TWO:IF (TOTAL2>MAXOP) THEN MAXOP:=TOTAL2; C R; &FILENAME:STRING; &  PROCEDURE SETORDER;  VAR INDEX:INTEGER;   PROCEDURE DATASET(TREEMARK:ACTPTR);  BEGIN "{$R-} "I  BEGIN (* DATACOUNT *); "MARK(HEAP); "PAGE(OUTPUT); "GOTOXY(0,10); F DSSTART^[INDEX]NIL THEN &DATASET(TREEMARK^.LES) $ELSE &BEGIN (NEW(ENTRY); (ENTR"WRITE(CHR(7),'Output file for data segment statistics( for none): '); "READLN(FILENAME); "DISPLAY:=(FILENAME<>''); "CONY^.OFFSET:=INDEX; (ENTRY^.TOTAL:=DSSTART^[INDEX]; (ENTRY^.LES:=NIL; (ENTRY^.GTR:=NIL; (TREEMARK^.LES:=ENTRY; &END "ELSE IFSOLE:=(FILENAME='CONSOLE:') OR (FILENAME='#1:'); "IF DISPLAY AND (FILENAME<>LASTFILENAME) THEN $BEGIN &CLOSE(LISTFILE,LOCK); 0WORD,OPT:IF (TOTAL3>MAXOP) THEN MAXOP:=TOTAL3; 4LOPT:IF (TOTAL4>MAXOP) THEN MAXOP:=TOTAL4; 3WORDS:IF (TOTAL5>MAXOP) THEN MAX TREEMARK^.GTR<>NIL THEN &DATASET(TREEMARK^.GTR) $ELSE &BEGIN (NEW(ENTRY); (ENTRY^.OFFSET:=INDEX; (ENTRY^.TOTAL:=DSSTART^[OP:=TOTAL5; 2CMPRSS:IF (TOTAL6>MAXOP) THEN MAXOP:=TOTAL6; 1CMPRSS2:IF (TOTAL7>MAXOP) THEN MAXOP:=TOTAL7 'END;  END;   BEGINDEX]; (ENTRY^.LES:=NIL; (ENTRY^.GTR:=NIL; (TREEMARK^.GTR:=ENTRY; &END; "{$R+}  END;   BEGIN "NEW(TREETRUNK); "TREETIN (* SEGMENT PROCEDURE GATHER *) "GINIT; "PAGE(OUTPUT); "GOTOXY(0,10); "WRITE(CHR(7),'Output file for opcode statistics ( for none): '); "READLN(FILENAME); "DISPLAY:=(FILENAME<>''); "CONSOLE:=(FILENAME='CONSOLE:') OR (FILENAME='#1:'); "IF DISP$INDEX:=INDEX + SCAN((DATASEGSIZE-INDEX)*2,<>CHR(0),DSSTART^[INDEX]) DIV 2; $IF DSSTART^[INDEX]>0 THEN &BEGIN (DATASET(TREETLAY THEN $BEGIN &IF (FILENAME<>LASTFILENAME) THEN (BEGIN *CLOSE(LISTFILE,LOCK); *REWRITE(LISTFILE,FILENAME); *LASTFILENAMERUNK); (DATAREF:=DATAREF + DSSTART^[INDEX]; (DSSTART^[INDEX]:=0; &END; ${$R+} "UNTIL INDEX>=DATASEGSIZE;  END;   PROCED:=FILENAME; (END; &PAGE(OUTPUT); &PROCSTUFF; &JUMPSTUFF; &SHORTSTUFF; &FOR OP:=128 TO 215 DO (BEGIN *WRITE(LISTFILE,CR,NURE DATAHEADER(VAR H2:INTERACTIVE);  VAR I:INTEGER;  BEGIN "WRITELN(H2,CR,CR,'Data Segment size:',DATASEGSIZE:6,' Data AMES[OP],' Opcode:',OP:4,' Total:'); *CASE RECTYPES[OP] OF 6SHORT:SHORTST; 3OPT,WORD:WORDST; /ONE,CHRS,BLK:ONEST; 8TWO:Treferences:', 6DATAREF:6,' Lex level',PROCLEX[DATAPROC]:6); "WRITE(H2,CR,CR,'For segment '); "FOR I:=1 TO 8 DO WRITE(H2,WOST; 7LOPT:LOPTST; 6WORDS:WORDSST; 5CMPRSS:CMPRSSST; 4CMPRSS2:CMPRSS2ST ,END; (END; CHR(SEGDIREC[63 + DATASEG*8 +I])); "WRITELN(H2,' Procedure #',DATAPROC:3); "WRITELN(H2,'Offset(word) Total %');  END; &WRITELN(CR,CR,CR,OPTOTAL:20,' Total operators');  END;  END;   SEGMENT PROCEDURE DATACOUNT;  TYPE ACTPTR=^ACTREC;  PROCEDURE PRINTDATA(TREE:ACTPTR);  BEGIN "IF TREE^.GTR<>NIL THEN PRINTDATA(TREE^.GTR); "TOTAL:=TREE^.TOTAL; "IF DISPLAY  &ACTREC=RECORD (OFFSET,TOTAL:INTEGER; (LES,GTR:ACTPTR &END;  VAR TOTAL:INTEGER; &HEAP:^INTEGER; &TREETRUNK,ENTRY:ACTPTTHEN WRITELN(LISTFILE, ,TREE^.OFFSET:9,TOTAL:11,TOTAL/DATAREF*100:9:2); "IF TREE^.LES<>NIL THEN PRINTDATA(TREE^.LES);  END; D  }  { COPYRIGHT (C) 1978, Regents of the }  {  University of California, San Diego }  { }  {========================================================} "  CONST MAXPROCNUM=150;   TYPE NMENONIC=PACKED ARRAY[0..7] OF CHAR; (BYTETYPE=ARRAY[0..7] OF INTEGER; (WORDTYPE=ARRAY[0..15] OF INTEGER; (BYTE=0..255; (OPTYPE=(SHORT,ONE,OPT,TWO,LOPT,WORDS,CHRS,BLK,CMPRSS,CMPRSS2,WORD); (OPREC=RECORD CASE OPTYPE OF 1SHORT:(TOTAL0:INTEGER); *ONE,CHRS,BLK:(TOTAL1:INTEGER; 8BYTEONE1:BYTETYPE); 3TWO:(TOTAL2:INTEGER; 8BYTEONE2:BYTETYPE; 8BYTETWO2:BYTETYPE; 8FLAVOR2:ARRAY[2..29] OF INTEGER); .WOR&REWRITE(LISTFILE,FILENAME); &LASTFILENAME:=FILENAME; $END; "PAGE(OUTPUT); "SETORDER; "IF DISPLAY THEN DATAHEADER(LISTFILE); "IF DATAREF>0 THEN $PRINTDATA(TREETRUNK^.GTR)  ELSE $BEGIN &IF DISPLAY THEN WRITELN(LISTFILE,CR,CR, 0'sorry but there (*$S+*)  PROGRAM CODESTAT;   {========================================================}  {  were no accesses', 0' to this data segment from dis-assembled procedures'); " END;  PROMPT; "RELEASE(HEAP);  END;    }  { UCSD P-CODE DISASSEMBLER }  { PROCEDURE PROMPT;  VAR CH:CHAR;  BEGIN "WRITE(CHR(7),CR,CR,'press spacebar to continue...'); "REPEAT READ(CH) UNTIL CH='  }  { Release level: I.5 Sept, 1978 }  { '; "WRITELN;  END;   }  { Written by William P. Franks }  {  }  { Institute for Information Systems }  { UC San Diego, La Jolla, Ca 1 1 1 1 2 3 K K M 0 THEN %OPENOLD(INPUTFILE,FILENAME); "IF BLOCKREAD(INPUTFILE,SEGDIREC,1)=1 THEN ; "FORD,OPT:(TOTAL3:INTEGER; 8PARMONE3:WORDTYPE); 1 LOPT:(TOTAL4:INTEGER; 8BYTEONE4:BYTETYPE; 8PARMTWO4:WORDTYPE); 1WORDS:(TOTAL5559] OF BYTE; (  SEGMENT PROCEDURE INIT;  VAR I:INTEGER; &FILENAME:STRING; &OPFILE:FILE OF OPFACTS;   PROCEDURE NEWOP(:INTEGER; 8PARMONE5:WORDTYPE; 8PARMTWO5:WORDTYPE; 8PARMTHREE5:WORDTYPE); 0CMPRSS:(TOTAL6:INTEGER; 8FLAVOR6:ARRAY[0..40] OF FLAVOR:OPTYPE);  BEGIN "CASE FLAVOR OF (SHORT:NEW(OPCODE[I],SHORT); *ONE:NEW(OPCODE[I],ONE); *BLK:NEW(OPCODE[I],BLK); )CHRINTEGER); /CMPRSS2:(TOTAL7:INTEGER; 8FLAVOR7:ARRAY[1..6] OF INTEGER) *END; (OPPTR=^OPREC; (OPFACTS=RECORD *NAMES:ARRAY[52.S:NEW(OPCODE[I],CHRS); *OPT:NEW(OPCODE[I],OPT); ) TWO:NEW(OPCODE[I],TWO); )LOPT:NEW(OPCODE[I],LOPT); (WORDS:NEW(OPCODE[I],WO.255] OF NMENONIC; *RECTYPES:ARRAY[0..255] OF OPTYPE (END;  JUMPREC=RECORD *POS,NEG:WORDTYPE (END; RDS); 'CMPRSS:NEW(OPCODE[I],CMPRSS); &CMPRSS2:NEW(OPCODE[I],CMPRSS2); )WORD:NEW(OPCODE[I],WORD) $END; "WITH OPCODE[I]^ DO F ALL[SEGNUM]^,SIZEOF(PRCLARRY),0); &END $ELSE PROCCALL[SEGNUM]:=NIL; "PAGE(OUTPUT); "GOTOXY(0,10); BUFRESET(BUFSTART + BYTEPOS,0,5); "GETBYTE:=BUFFER[BYTEPOS];  IF HEXCOUNT<15 THEN $BEGIN $ HEX.LOWBYTE:=BUFFER[BYTEPOS]; "WRITELN(' ':10,'Is this code file designed for a machine'); "WRITE(' ':7,'where byte zero is the most significant byte ?'); "READ(KEYBOARD,CH); "SWAP:=(CH='Y'); "PAGE(OUTPUT); "GOTOXY(0,10); "WRITE('Dis-assembly output file ( for none+ 1;  END;   FUNCTION GETBIG:INTEGER;  VAR BIG:HEXTYPE; %FIRSTBYTE:BYTE;  BEGIN "FIRSTBYTE:=GETBYTE; "IF FIRSTBYTE>127): '); "READLN(FILENAME); "LASTFILENAME:=FILENAME; "DISPLAY:=(FILENAME<>''); "CONSOLE:=(FILENAME='CONSOLE:') OR (FILENAME='# THEN $BEGIN &BIG.LOWBYTE:=GETBYTE; &BIG.HIBYTE:=FIRSTBYTE - 128; &GETBIG:=BIG.WORD; $END "ELSE GETBIG:=FIRSTBYTE; 1:'); "IF DISPLAY THEN REWRITE(LISTFILE,FILENAME); "SEGNUM:=0;  OPTOTAL:=0;  SLDC:=0; "SLDL:=0; "SLDO:=0; "SIND:=0;  END;   FUNCTION GETWORD:INTEGER;  VAR WERD:HEXTYPE;  BEGIN "IF SWAP THEN $BEGIN &WERD.HIBYTE:=GETBYTE; &WERD.LOWBYTE"JUMPTOTAL:=0; "HEXCOUNT:=0; "CODE:=' '; "HEXCHAR:='0123456789ABCDEF'; "FILLCHAR(JUMPSTATS.POS,32,0); "FILLC:=GETBYTE; $END "ELSE $BEGIN &WERD.LOWBYTE:=GETBYTE; &WERD.HIBYTE:=GETBYTE; $END; "GETWORD:=WERD.WORD;  END;   FUNCTIHAR(JUMPSTATS.NEG,32,0);  LEXLOOK:=FALSE;  END;   PROCEDURE PROMPT; FORWARD;   SEGMENT PROCEDURE DISASSEMBLE;   FUNON MOSTSIGBIT(OPERAND:INTEGER):INTEGER;  VAR BYTESIZE:INTEGER;  BEGIN "IF OPERAND<0 THEN $MOSTSIGBIT:=15 "ELSE $BEGIN &BCTION BUFRESET(BYTEPOS,OFFSET,DIRECTION:INTEGER):INTEGER;  VAR NEWBYTE:INTEGER;  BEGIN "NEWBYTE:=BYTEPOS + OFFSET; "REPEATYTESIZE:=-1; &REPEAT (BYTESIZE:=BYTESIZE + 1; (OPERAND:=OPERAND DIV 2; &UNTIL OPERAND=0; &MOSTSIGBIT:=BYTESIZE; $END;  EN $BUFSTBLK:=BUFSTBLK + DIRECTION; $BUFSTART:=(BUFSTBLK - SEGSTBLK)*512; D;   PROCEDURE ACTACCESS(FINALEX,OFFSET:INTEGER); FORWARD;   PROCEDURE SHORTOP;  {SLDC ABI ABR ADI ADR LAND DIF DVI "UNTIL (NEWBYTE - BUFSTART>=0) AND (NEWBYTE - BUFSTART<2557); "IF BLOCKREAD(INPUTFILE,BUFFER,5,BUFSTBLK)=1 THEN; "BUFRESET:=N DVR CHK FLO FLT INN INT !LOR MODI MPI MPR NGI NGR LNOT SRS SBI SBR SGS SQI SQR STO !IXS UNI S2P LDCN LDP EWBYTE - BUFSTART;  END;   FUNCTION LASTBYTE:BYTE;  VAR CHANGE:INTEGER;  BEGIN "IF BYTEPOS<1 THEN $BEGIN &BYTEPOS:=BUSTP LDB STB EQUI GEQI GTRI LEQI LESI NEQI !S1P IXB BYT XIT SLDL SLDO SIND}   BEGIN "OPCODE[BITE]^.TOTAL0:=OPCODE[BITFRESET(BUFSTART + BYTEPOS,-1,-1); &OFFSET:=OFFSET - 1; $END "ELSE $BEGIN &BYTEPOS:=BYTEPOS - 1; &OFFSET:=OFFSET - 1; $ENDE]^.TOTAL0 + 1; "IF BITE=214 THEN DONEPROC:=TRUE; "IF BITE<128 THEN $BEGIN &SLDC:=SLDC + 1;  SEGNUM:=0 TO 15 DO $IF SEGDIREC[SEGNUM*4] + SEGDIREC[SEGNUM*4 + 1]<>0 THEN $ BEGIN (NEW(PROCCALL[SEGNUM]); (FILLCHAR(PROCC; "LASTBYTE:=BUFFER[BYTEPOS];  END;   FUNCTION GETBYTE:BYTE;  VAR HEX:HEXTYPE;  BEGIN "IF BYTEPOS>2559 THEN $BYTEPOS:=G E; &IF (BITE IN [161,185,211,212]) THEN (BEGIN *BITE:=GETBYTE; *IF BITE<128 THEN * BEGIN .JUMPTOTAL:=JUMPTOTAL + 1; .JUM&IF DISPLAY THEN WRITE(LISTFILE,BITE:6); &LINKS:=BITE; &BYTESIZE:=MOSTSIGBIT(BITE); &BYTEONE4[BYTESIZE]:=BYTEONE4[BYTESIZE] PSIZE:=BITE; .JUMPOPST; .IF DISPLAY THEN WRITELN(LISTFILE, 4BUFSTART + BYTEPOS + BITE - PROCSTART:6,' ':18,CODE); * END *E+ 1; &BIG:=GETBIG; &BYTESIZE:=MOSTSIGBIT(BIG); &PARMTWO4[BYTESIZE]:=PARMTWO4[BYTESIZE] + 1; &IF DATAWATCH THEN ACTACCESS(LEX&IF DISPLAY THEN WRITELN(LISTFILE,NAMES[127],BITE:6,' ':18,CODE); $END "ELSE $BEGIN &IF DISPLAY THEN WRITE(LISTFILE,NAMES[BLSE ,BEGIN .JUMPTOTAL:=JUMPTOTAL + 1; .JUMPSIZE:=JUMPS[(256-BITE-8)DIV 2] - (BUFSTART+BYTEPOS-PROCSTART); .JUMPOPST; .IF DIITE]); &IF BITE>215 THEN (IF BITE<232 THEN *BEGIN ,SLDL:=SLDL + 1; ,IF DATAWATCH THEN ACTACCESS(LEXLEVEL,BITE - 215); ,IF SPLAY THEN WRITELN(LISTFILE, =JUMPS[(256 - BITE - 8) DIV 2]:6,' ':18,CODE); ( END; (END &ELSE (BEGIN *PCALL:=(BITE IN DISPLAY THEN WRITELN(LISTFILE,BITE-215:6,' ':18,CODE); *END (ELSE IF BITE<248 THEN ( BEGIN ,SLDO:=SLDO + 1; ,IF DATAWATCH [174,206,207]); *BITE:=GETBYTE; *IF PCALL THEN ,PROCCALL[SEGNUM]^[BITE]:=PROCCALL[SEGNUM]^[BITE] + 1; THEN ACTACCESS(0,BITE - 231); ,IF DISPLAY THEN WRITELN(LISTFILE,BITE-231:6,' ':18,CODE); *END (ELSE *BEGIN ,SIND:=SIND + 1;*IF DISPLAY THEN WRITELN(LISTFILE,BITE:6,' ':18,CODE); ( IF DONEPROC THEN ,IF DISPLAY THEN WRITELN(LISTFILE); (END; &BYTES ,IF DISPLAY THEN WRITELN(LISTFILE,BITE-248:6,' ':18,CODE);  END &ELSE (IF DISPLAY THEN WRITELN(LISTFILE,' ':24,COIZE:=MOSTSIGBIT(BITE); &BYTEONE1[BYTESIZE]:=BYTEONE1[BYTESIZE] + 1; $END;  END;   PROCEDURE OPTOP;  {INC IND IXA LAO DE); $END;  IF DONEPROC THEN $IF DISPLAY THEN WRITELN(LISTFILE);  END;   PROCEDURE ONEOP;  {ADJ FJP SAS RNP CIP ULDO MOV MVB SRO LLA LDL STL BTP}  VAR BIG:INTEGER;  LOCAL,GLOBAL:BOOLEAN;  BEGIN "WITH OPCODE[BITE]^ DO $BEGJP LDM STM RBP CBP CLP CGP EFJ NFJ}   VAR JUMPSIZE:INTEGER;  PCALL:BOOLEAN;   PROCEDURE JUMPOPST;  VAR IN &TOTAL3:=TOTAL3 + 1; &IF DATAWATCH THEN (BEGIN *LOCAL:=(BITE IN [198,202,204]); *GLOBAL:=(BITE IN [165,167,171]); (END; NEG:BOOLEAN;  BEGIN "NEG:=(JUMPSIZE<0); "IF NEG THEN JUMPSIZE:=-JUMPSIZE; "BYTESIZE:=-1; "REPEAT  &IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]); &BIG:=GETBIG; &BYTESIZE:=MOSTSIGBIT(BIG); &PARMONE3[BYTESIZE]:=PARMONE3[BYTES$BYTESIZE:=BYTESIZE + 1; $JUMPSIZE:=JUMPSIZE DIV 2; "UNTIL JUMPSIZE=0; "IF NEG THEN $JUMPSTATS.NEG[BYTESIZE]:=JUMPSTATS.NEGIZE] + 1; &IF DATAWATCH THEN (IF LOCAL THEN ACTACCESS(LEXLEVEL,BIG) (ELSE IF GLOBAL THEN ACTACCESS(0,BIG); &IF DISPLAY THEN [BYTESIZE] + 1 "ELSE $JUMPSTATS.POS[BYTESIZE]:=JUMPSTATS.POS[BYTESIZE] + 1;  END;   BEGIN(* ONEOP *) "WITH OPCODE[BITE]^ WRITELN(LISTFILE,BIG:6,' ':18,CODE); $END;  END;   PROCEDURE LOPTOP;  {LDA LOD STR}  VAR BIG,LINKS:INTEGER;  BEGIN DO $BEGIN &TOTAL1:=TOTAL1 + 1; &IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]); &IF (BITE=173) OR (BITE=193) THEN DONEPROC:=TRU"WITH OPCODE[BITE]^ DO $BEGIN &TOTAL4:=TOTAL4 + 1; &IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]); &BITE:=GETBYTE; H P;  { LCI }  VAR WERD:INTEGER;  BEGIN "WITH OPCODE[BITE]^ DO $BEGIN &TOTAL3:=TOTAL3+ 1; &IF DISPLAY THEN WRITE(LISTFIIN "WITH OPCODE[BITE]^ DO $BEGIN &TOTAL7:=TOTAL7 + 1; &IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]); &BITE:=GETBYTE; LE,NAMES[BITE]); &WERD:=GETWORD; &IF DISPLAY THEN WRITELN(LISTFILE,WERD:6,' ':18,CODE); &BYTESIZE:=MOSTSIGBIT(WERD); &PARMON&FLAVOR7[BITE DIV 2]:=FLAVOR7[BITE DIV 2] +1; &IF (BITE=10) OR (BITE=12) THEN BIG:=GETBIG; &IF DISPLAY THEN (CASE BITE OF +E3[BYTESIZE]:=PARMONE3[BYTESIZE] + 1; $END;  END;   PROCEDURE WORDSOP;  { XJP }  VAR WORD1,WORD2,WORD3:INTEGER;  BEG2:WRITELN(LISTFILE,'REAL',' ':20,CODE); +4:WRITELN(LISTFILE,'STR ',' ':20,CODE); +6:WRITELN(LISTFILE,'BOOL',' ':20,CODE); +8:IN "WITH OPCODE[BITE]^ DO $BEGIN &TOTAL5:=TOTAL5 + 1; &IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]); &IF ODD(BYTEPOS) THEN BWRITELN(LISTFILE,'POWR',' ':20,CODE); *10:WRITELN(LISTFILE,'BYTE',BIG:6,' ':14,CODE); *12:WRITELN(LISTFILE,'WORD',BIG:6,' ':14ITE:=GETBYTE; &WORD1:=GETWORD; &BYTESIZE:=MOSTSIGBIT(WORD1); &PARMONE5[BYTESIZE]:=PARMONE5[BYTESIZE] + 1; &WORD2:=GETWORD; ,CODE) (END; $END;  END;   PROCEDURE CHRSOP;  { LCA }  VAR SKIPOVER,I:INTEGER;  BEGIN "WITH OPCODE[BITE]^ DO $BEGILEVEL - LINKS,BIG); &IF DISPLAY THEN WRITELN(LISTFILE,BIG:6,' ':12,CODE); $END;  END;   PROCEDURE TWOOP;  {IXP CXP}  VA&BYTESIZE:=MOSTSIGBIT(WORD2); &PARMTWO5[BYTESIZE]:=PARMTWO5[BYTESIZE] + 1; &BYTESIZE:=MOSTSIGBIT(WORD2-WORD1+1); R BYTEONE,BYTETWO:BYTE;  EXTPR:BOOLEAN;  BEGIN "WITH OPCODE[BITE]^ DO $BEGIN &TOTAL2:=TOTAL2+ 1; &IF DISPLAY THEN &PARMTHREE5[BYTESIZE]:=PARMTHREE5[BYTESIZE] + 1; &BITE:=GETBYTE; BITE:=GETBYTE; &IF BITE<128 THEN (WORD3:=BUFSTART + BYTEPWRITE(LISTFILE,NAMES[BITE]); &IF BITE=205 THEN EXTPR:=TRUE ELSE EXTPR:=FALSE; &BYTEONE:=GETBYTE; &BYTESIZE:=MOSTSIGBIT(BYTEONOS + BITE - PROCSTART &ELSE (WORD3:=JUMPS[(256 - BITE - 8) DIV 2]; &IF DISPLAY THEN WRITELN(LISTFILE,WORD1:6,WORD2:6,WORD3:6,E); &BYTEONE2[BYTESIZE]:=BYTEONE2[BYTESIZE] + 1; &BYTETWO:=GETBYTE; &DONEPROC:=(EXTPR) AND (BYTEONE=0) AND (BYTETWO=2); &IF ' ':6,CODE); &WORD2:=WORD2 - WORD1 + 1; &FOR WORD1:=1 TO WORD2 DO (BEGIN *HEXCOUNT:=0; *CODE:=' '; *WORD3:=(EXTPR) AND (BYTEONE=0) AND (BYTETWO>1) AND (BYTETWO<30) THEN (BEGIN *FLAVOR2[BYTETWO]:=FLAVOR2[BYTETWO] + 1; *IF DISPLAY THEGETWORD; *WORD3:=BUFSTART + BYTEPOS - WORD3 - 2 - PROCSTART; & IF DISPLAY THEN WRITELN(LISTFILE,WORD3:41,' ':18,CODE); (ENN WRITELN(LISTFILE,NAMES[56 + BYTETWO],' ':16,CODE); (END &ELSE (BEGIN *IF EXTPR THEN D; $END;  END;   PROCEDURE CMPRSSOP;  { CSP }  BEGIN "WITH OPCODE[BITE]^ DO $BEGIN &TOTAL6:=TOTAL6 + 1; &IF DISPLAY,PROCCALL[BYTEONE]^[BYTETWO]:=PROCCALL[BYTEONE]^[BYTETWO] + 1; *IF DISPLAY THEN WRITELN(LISTFILE,BYTEONE:6,BYTETWO:6,' ':12,CO THEN WRITE(LISTFILE,NAMES[BITE]); &BITE:=GETBYTE; &IF DISPLAY THEN WRITELN(LISTFILE,NAMES[86 + BITE],' ':16,CODE); &FLAVOR6[DE); (END; &BYTESIZE:=MOSTSIGBIT(BYTETWO); &BYTETWO2[BYTESIZE]:=BYTETWO2[BYTESIZE] + 1; $END;  END;    PROCEDURE WORDOBITE]:=FLAVOR6[BITE] + 1; $END;  END;    PROCEDURE CMPRSS2OP;  {EQU GEQ GTR LEQ LES NEQ}  VAR BIG:INTEGER;  BEGI ' ':18,CODE); &BYTESIZE:=MOSTSIGBIT(BITE); &BYTEONE1[BYTESIZE]:=BYTEONE1[BYTESIZE] + 1; &IF ODD(BYTEPOS) THEN SKIPOVER:=GETBYSRS SBI SBR SGS SQI SQR STO IXS UNI S2P CSP LDCN ADJ FJP INC IND TE; &FOR I:=1 TO BITE DO &BEGIN (HEXCOUNT:=0; (CODE:=' '; (WERD:=GETWORD; (IF DISPLAY THEN WRITELN(LISTFILEIXA LAO LCA LDO MOV MVB SAS SRO XJP RNP CIP EQU GEQ GTR LDA LDC ,WERD:41,' ':18,CODE); &END; $END;  END;   (*$I DISASM1.TEXT *)  (*$I DISASM2.TEXT*)   BEGIN(*MAIN STUFF*)  INIT; LEQ LES LOD NEQ STR UJP LDP STP LDM STM LDB STB IXP RBP CBP EQUI "DISASSEMBLE; "IF DATAWATCH THEN DATACOUNT; "GATHER;  IF DISPLAY AND NOT CONSOLE THEN CLOSE(LISTFILE,LOCK);  END. GEQI GTRI LLA LDCI LEQI LESI LDL NEQI STL CXP CLP CGP S1P IXB BYT EFJ NFJ BPT XIT NOP SLDL1 SLDL2 SLDL3 SLDL4 SLDL5 SLDL6 SLDL7 SLDL8 SLDL9 SLDL10 SLDL11 SLDL12 SLDL13 SLDL14 SLDL15 SLDL16 SLDO1 SLDO2 SLDO3 SLDO4 SLDO5 SLDO6 SLDO7 SLDO8 SLDO9 SLDO10 SLDO11 SLDO12 SLDO13 SLDO14 SLDO15 SLDO16 SIND0 SIND1 SIND2 SIND3 SIND4 SIND5 SIND6 SIND7 REAL STRING BOOLEAN POWER BYTE WORD EXEC-ERRINIT RESET OPEN CLOSE GET PUT SEEK EOF EOLN N &TOTAL1:=TOTAL1 + 1; &IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]); &BITE:=GETBYTE; &IF DISPLAY THEN WRITE(LISTFILE,BITE:6,READINT WRITEINTREADREALWRITREALREADCHARWRITCHARREADSTR WRITESTRWRITBYTSREADLNN WRITELN CONCAT INSERT COPY DELETE POS ' '''); &BYTESIZE:=MOSTSIGBIT(BITE); &BYTEONE1[BYTESIZE]:=BYTEONE1[BYTESIZE] + 1; &IF DISPLAY THEN (FOR I:=1 TO BITE DO WRBLOCKIO GOTOXY IOCHECK NEW MOVELEFTMOVERGHTEXIT UREAD UWRITE IDSEARCHTREESRCHTIME FILLCHARSCAN DRAWLINEDRAWBLOCITE(LISTFILE,CHR(GETBYTE)) &ELSE (FOR I:=1 TO BITE DO SKIPOVER:=GETBYTE; $ IF DISPLAY THEN WRITELN(LISTFILE,''''); $END;   TRUNC ROUND SIN COS LOG ATAN LN END;    PROCEDURE BLKOP;  { LDC }  VAR WERD,I,SKIPOVER:INTEGER;  BEGIN "WITH OPCODE[BITE]^ DO $BEGIN EXP SQRT MARK RELEASE IORESULTUBUSY PWROFTENUWAIT UCLEAR HALT MEMAVAL SLDC ABI ABR ADI ADR &TOTAL1:=TOTAL1 + 1; &IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]); &BITE:=GETBYTE; &IF DISPLAY THEN WRITELN(LISTFILE,BITE:6,LAND DIF DVI DVR CHK FLO FLT INN INT LOR MODI MPI MPR NGI NGR LNOT J & Please press to continue. áRۂ8ۂáۂ ۂ á ܕR`ۥ  ۂ  ۂڞڂ ˡ  !Uقčy^ 肾 á ܂ ܂áŧؓɍš  ٚáء  e  ݂ ݂ɡ ݂ ݂  \z f+ EDITOR ەݕ ; Z-š 0ۍ INITIALIOUT COPYFILEENVIRONMPUTSYNTAEDITCOREN bx$Xl~l6jXlRepeatfactor > 10,000 \ 낾 á 킫8ڕ $lڪP--ˡ>-áIllegal file nameNo file OˡjKThere is no room to copy the deletion. Do you wish to delete anyway? (y/n)P Yá*ڕ񧁠 not code{/@"ˡ Bad block #0R.P.PȡB..č/O`.Q/.RQQRQ ڂ ٕ ݞ݂ ˡ !Uɡ š    ڶ>˄KڶPá4ڶZjڡ?١ 1ۥ č%`Pá#ڶNáڶNá ڤjڳ * >پˡȡ3Fڤá ZڤġZڤZڤ؂ ħɄ ؂ Tfګꂾ ء8 پعE٢J٢=٢.٢!٢ MB7*x ꂾ ꂾ 짃áܕ܂ܕ܂  肾 FP    ¥FP    (  ٪P&áERROR: á;K ZޤZޤڕ ڕ  á ۂ ۂɡ-%ߡˡReading Page Zero / /ȡ"F F   ˡWriting Page Zero 肾á肾  肾-á á@肾  ÄRan out of disk roomߓ𧁡ńɄ٫  š6ꕞ߂ŧȍ0 á܂  ۂ܂ߞ á<肾á /ꂾ ꂾÍꕚꕫ H#ƁƂƁƂ   šá ߂  á߂߂܂܂܂  nHr ٪P á  á :ƁƁYB*>XvH f * D 2< 6f what marker? -P,-V,Vȡ-,-, ,,-- -- ~*B J%ڕ ڕ  á ۂ ۂɡ-%ߡ E Bad disk transfer. $ۓKá$oˡ$"oRan out of disk roomߓ𧁡ńɄ٫  š6ꕞˡ$ۓf"çȄçĄۓKá$oˡ$"oˡ$ꕚꕫ H#ƁƂƁƂ   šáۓr!šáǸ ބv!ޡjo o܂ٞȡ/FݤáF á  á :ƁƁYB*>XvH f * D 2< 6fZݤZݤ܂ق.ܫڂǸ ބ|!ޡpo oٕ٤ؚٳ قؚ. ؾ ȡض ض    .TEXTؾؾĄ ؾٕٞȡ1FݤáFݤZݤZݤ܂.ܕۂ镫ܑ۫۞kP.TEXTUPP.BACKUPVˡc ~^򫃂  Xxġۂoەoەە "ȡTFܤåZܤĄZܤȄ-á Fܤ n   CC9tتP:,,š,*á.:.&-FܤZܤZܤە.j %á   ۂ ۂɡ-%ߡ-- d-.8.:hڲ5$55&Ɓ3"ˡCan't open baRan out of disk roomߓÍɡɄ ڕڕڂ ȡ*Fޤáckup file! ڧɡ#Not enough room for backup!  Copying to ڧL Not present. File? P"á𥁤  Í >ĴGʂGʂGʂG Improper marker specification. 0肶肶##@MarkerʂGʂG ʂG :̂GʂGȡܤܚAẐGʂGȡܤAaẑG exceeds file bounds. :蕕,[á$ ʂGȡܤA09̂GʂGȡܤA    oV F P3Qo9l(H0  Щ  Щ]ɍٲˍ.ڕ.P..P,á?&SYSTEM.WRK.TEXT*SYSTEM.WRK.CODE*SYSTEM.WRK.TEXTI ؕ     ۂە ..ȡۂۂ ."ˡBad input file.ˡ@ˡRan out of room."ˡOn backup file.ققNot present. File? P"á𥁤  Í >ĴGʂGʂGʂG áîګ ^>Edit:ReadingتP:,,š,*á.:.&--- d-.8.:?h ؚˡ Reading file.h  ABCDFIJLM N P Q F>Quit:PF# U(pdate the workfile and leave% E(xit (but workfi R SVXZ,>.+-?/=<>á(PNPNV   le not updated)1 R(eturn to the editor without doing anything $ Rá09̂GʂGȡ *    Ʉ?Í ɡ >Eáyšb"á<-Backup file not present (tried to remove it).Edit:T ̂GƂGƂG:ƂG&ƂGP "ˡWorkfile lost.4No workfile is presWriting Cáš LPAGE+1>RPAGE*ent. File? ( for no file ) P P á *SYSTEM.WRK.TEXTP   "ˡˡˡ"ˡ܂܂á̂2ʂ2ȡ,FۤġFۤFۤP"ˡSystem volume not on line5ˡ File system terminal error򥁤ˡThe workfile, , is   blocks long.?&SYSTEM.WRK.TEXT*SYSTEM.WRK.CODE*SYSTEM.WRK.TEXTI š&The backup file is Writing out the filerM`X^