00272 3D00H:/*RAMAREA BELOW THIS POINT IS USED BY THE MONITOR*/ 00273 00274 DECLARE /*OPERANDS PROCESSED BY CASE ON OPERATOR*/ 00275 VAL1 (0) ADDRESS,(LB1,HB1) BYTE, 00276 VAL2 (0) ADDRESS,(LB2,HB2) BYTE, 00277 DUMMY (0) ADDRESS;/*ALIGNING ABOVE*/ 00278 /*VAL1 AND LB1 ARE EQUIVALENT, 00279 VAL2 AND LB2 ARE EQUIVALENT,*/ 00280 00281 DECLARE TRUE LITERALLY '1', FALSE LITERALLY '0'; 00282 00283 DECLARE /*FLAGS FOR CASE ON OPERATOR*/ INFO BYTE; 00284 00285 DECLARE BP BYTE, MAXBP LITERALLY '8', 00286 (BLKTYP,ASMSUP)(MAXBP) BYTE; 00287 00288 DECLARE (MACDEF,PRMNO)BYTE, 00289 (MACNAM,MACADR BASED MACNAM) ADDRESS, 00290 MACEND ADDRESS,ENDMAC BASED MACEND BYTE; 00291 00292 DECLARE NP BYTE,MAXNP LITERALLY '5', 00293 (MACXPN,MACSUB) BYTE, 00294 (MACBOD,MACPTR,MACPRM,SYMTOP,SYMBOT)(MAXNP) ADDRESS, 00295 MACRO BASED MACPTR BYTE,LINKP ADDRESS,LINK BASED LINKP ADDRESS; 00296 00297 DECLARE FREMEM ADDRESS, MEM BASED FREMEM BYTE, SYMAX ADDRESS; 00298 00299 DECLARE PASS BYTE; /*THE PASS COUNTER: 00300 PASS 1 SYMBOL RESOLUTION 00301 PASS 2 LISTING OUTPUT 00302 PASS 3 OBJECT CODE OUTPUT 00303 PASS 4 COMBINES PASSES 2 AND 3 */ 00304 00305 DECLARE /*BLOCK NUMBERS FOR IDENTIFIER SCOPING*/ 00306 RESERVED LITERALLY '1', 00307 GLOBAL LITERALLY '2', 00308 LOCAL LITERALLY '0'; 00309 00310 DECLARE /*THE CODE BUFFER*/ 00311 CODSIZ LITERALLY '17',CODMAX LITERALLY /*CODSIZ -1 */'16', 00312 (CODTOP,CODLEN,CODCHK,CODEND) BYTE, 00313 CODE (CODSIZ) BYTE, CODLOC ADDRESS; 00314 00315 DECLARE /*THE SYMBOL TABLE POINTERS*/ 00316 (SYM,LOC,LOCVAL BASED LOC) ADDRESS, 00317 SYMSTR BASED SYM BYTE, SYMTAB BASED LOC BYTE; 00318 00319 DECLARE /*'LOOKUP' POINTERS*/ 00320 (UPPER,LOWER) ADDRESS,(I,J)BYTE, 00321 (DST BASED UPPER,SRC BASED LOWER) ADDRESS; 00322 00323 DECLARE /*OPERATOR STACK*/ 00324 OPRL LITERALLY '7',OPR(OPRL)BYTE,OSP LITERALLY 'OPR'; 00325 00326 DECLARE UND/*AN UNDEFINED IDENTIFIER*/LITERALLY '0', 00327 FRM/*A MACRO FORMAL PARAMETER*/ LITERALLY '1', 00328 IDN/*A DEFINED IDENTIFIER*/ LITERALLY '2', 00329 SET/*A REDEFINABLE IDENTIFIER*/ LITERALLY '3', 00330 STR/*A STRING*/ LITERALLY '4', 00331 COD/*A (MACHINE CODE SYMBOL) STRING*/ LITERALLY '5', 00332 ABS/*AN ABSOLUTE VALUE*/ LITERALLY '6', 00333 MAC/*A MACRO NAME*/ LITERALLY '32'; 00334 00335 DECLARE /* SOME CHARACTER TYPES*/ 00336 NUMERIC LITERALLY '8',ALPHANUMERIC LITERALLY '>7'; 00337 00338 DECLARE (TOKEN,RTOKEN,TYPE,CHAR,PREV$CHAR,RADIX, 00339 SIGN,PRINTV,COLUMN) BYTE; 00340 00341 DECLARE (LC,PRINTN) ADDRESS; 00342 00343 DECLARE CR LITERALLY '15Q',LF LITERALLY '12Q',TAB LITERALLY '11Q', 00344 ENDS LITERALLY '1',COMMA LITERALLY '6',LPAR LITERALLY '2', 00345 RPAR LITERALLY '3'; 00346 00347 DECLARE IBP BYTE;/*IBP IS THE INPUT BUFFER INDEX:IT IS USED 00348 IN THE ASSEMBLER ONLY TO RESCAN THE PREVIOUS TEXT CHARACTER,HOWE 00349 IBP IS CONSISTANTLY DECREMENTED IN THE ASSEMBLER TO PERMIT THE 00350 ADDITION OF LINE BUFFERING,*/ 00351 00352 DECLARE ERCHAR BYTE;/*THE ERROR FLAG FOR THE CURRENT SOURCE 00353 LINE (USUALLY CONTAINS A BLANK),*/ 00354 00355 DECLARE /*THE OPERAND STACK*/ 00356 SP BYTE, SPMAX LITERALLY '8', 00357 (VAL,ST)(SPMAX) ADDRESS, (TYP,LEN)(SPMAX) BYTE, 00358 SYMBOL BASED VAL BYTE, 00359 STKMAX LITERALLY '51',(STKBOT,STKTOP) ADDRESS; 00360 /*STACK IS DECLARED NEAR INITIALIZE */ 00361 00362 /*VAL(0)CONTAINS THE ADDRESS OF THE CURRENT SYMBOL'S 00363 VALUE(OR PRINT NAME,IF-IT IS AN IDENTIFIER),DESCRIBED BY 00364 ST(0),TYP(0)AND LEN(0), VAL(SP) CONTAINS THE 00365 ADDRESS OF THE PREVIOUS SYMBOL, VALUES ARE ADDED TO THE 00366 STACK BY INCREMENTING SP THEN MOVING (VAL,ST,TYP,LEN) 00367 (0) TO (VAL,ST,TYP,LEN)(SP),VALUES ARE REMOVED BY 00368 MOVING (VAL,ST,TYP,LEN)(SP)TO (VAL,ST,TYP,LEN)(0) 00369 THEN DECREMENTING SP,*/ 00370 00371 DECLARE /*THE MONITOR INTERFACE PARAMETERS AND PROCEDURES*/ 00372 00373 CI LITERALLY '01D5H',/*CONSOLE INPUT*/ 00374 RI LITERALLY '051CH',/*READER INPUT*/ 00375 CO LITERALLY '01E8H',/*CONSOLE OUTPUT*/ 00376 PO LITERALLY '0570H',/*PUNCH OUTPUT*/ 00377 LO LITERALLY '01E8H',/*LIST OUTPUT*/ 00378 IO LITERALLY '3C63H',/*GET IO DEVICE ASSIGNMENTS*/ 00379 GM LITERALLY '3C50H';/*GET MEMORY SIZE*/ 00380 00381 00382 00383 /* -------------------------------------------------- */ 00384 00385 00386 DECLARE KEYBOARD LITERALLY 'KBY AND 7FH'; 00387 00388 KBY: 00389 PROCEDURE BYTE; 00390 00391 GOTO CI; 00392 END KBY; 00393 00394 /* -------------------------------------------------- */ 00395 00396 00397 00398 READER: 00399 PROCEDURE BYTE; 00400 00401 GOTO RI; 00402 END READER; 00403 00404 00405 DECLARE TEXT LITERALLY 'READER AND 7FH'; 00406 00407 /* -------------------------------------------------- */ 00408 00409 00410 00411 00412 PRINT: 00413 PROCEDURE (CHAR); 00414 DECLARE CHAR BYTE; 00415 00416 GOTO CO; 00417 END PRINT; 00418 00419 /* -------------------------------------------------- */ 00421 00422 PUNCH: 00423 PROCEDURE(CHAR); 00424 DECLARE CHAR BYTE; 00425 00426 GOTO PO; 00427 END PUNCH; 00428 00429 /* -------------------------------------------------- */ 00430 00431 00432 LIST$OUT: 00433 PROCEDURE (CHAR); 00434 DECLARE CHAR BYTE; 00435 00436 GOTO LO; 00437 END LIST$OUT; 00438 00439 /* -------------------------------------------------- */ 00440 00441 00442 IOCHK: 00443 PROCEDURE BYTE; 00444 00445 GOTO IO; 00446 END IOCHK; 00447 00448 /* -------------------------------------------------- */ 00449 00450 00451 MEMTOP: 00452 PROCEDURE ADDRESS; 00453 00454 GOTO GM; 00455 END MEMTOP; 00456 00457 /* -------------------------------------------------- */ 00458 00459 00460 LIST: 00461 PROCEDURE (CHAR); 00462 DECLARE (CHAR,I,J) BYTE; 00463 00464 I = (CHAR = TAB AND (7- (COLUMN AND 7))); 00465 IF CHAR = TAB THEN CHAR =' '; 00466 DO J=0 TO I; 00467 IF CHAR = CR THEN COLUMN = 0; 00468 IF COLUMN <72 THEN 00469 DO; 00470 COLUMN = COLUMN + (1 AND CHAR >=' '); 00471 CALL LIST$OUT (CHAR); 00472 END; 00473 END; 00474 END LIST; 00475 00476 /* -------------------------------------------------- */ 00477 00478 00479 ASSEMBLE: 00480 PROCEDURE; 00481 00482 ERROR: 00483 PROCEDURE (ERCODE); 00484 DECLARE ERCODE BYTE; 00485 00486 IF NOT ASMSUP AND ERCHAR = ' 'THEN ERCHAR = ERCODE; 00487 END ERROR; 00488 00489 /* -------------------------------------------------- */ 00490 00491 00492 QUARTEL: 00493 PROCEDURE (NAME,ITEM) BYTE; 00494 DECLARE NAME ADDRESS,VECTOR BASED NAME BYTE, 00495 (ITEM,I) BYTE; 00496 00497 I = VECTOR (SHR (ITEM,1)); 00498 IF ITEM THEN I=ROR (I,4); 00499 RETURN I AND 0FH; 00500 END QUARTEL; 00501 00502 /* -------------------------------------------------- */ 00503 00504 00505 /* RETURN HEX CHAR */ 00506 00507 HEX: 00508 PROCEDURE (VALUE,NIBBLE) BYTE; 00509 DECLARE (VALUE,NIBBLE) BYTE; 00510 00511 IF NIBBLE THEN VALUE = ROR (VALUE,4); 00512 IF(VALUE :=(VALUE AND 0FH)+'0')>'9' 00513 THEN VALUE = VALUE + 7; 00514 RETURN VALUE; 00515 END HEX; 00516 00517 /* -------------------------------------------------- */ 00518 00519 00520 /* PUNCH BYTE VALUE AS TWO HEX CHARACTERS */ 00521 00522 PUNCH$HEX: 00523 PROCEDURE (VALUE); 00524 DECLARE VALUE BYTE; 00525 00526 CALL PUNCH (HEX (VALUE,1)); 00527 CALL PUNCH (HEX (VALUE,2)); 00528 END PUNCH$HEX; 00529 00530 /* -------------------------------------------------- */ 00531 00532 00533 /*LIST BYTE VALUE AS TWO HEX CHARACTERS*/ 00534 00535 LIST$HEX: 00536 PROCEDURE (VALUE); 00537 DECLARE VALUE BYTE; 00538 00539 CALL LIST (HEX (VALUE,1)); 00540 CALL LIST (HEX (VALUE,2)); 00541 END LIST$HEX; 00542 00543 /* -------------------------------------------------- */ 00544 00545 00546 /*PUNCH A BINARY RECORD (0 => DATA RECORD,1=>END RECORD)*/ 00547 00548 PUNCH$RECORD: 00549 PROCEDURE (TYPE); 00550 DECLARE (TYPE,I) BYTE; 00551 00552 CALL PUNCH (':'); 00553 CALL PUNCH$HEX (CODLEN); 00554 CALL PUNCH$HEX (HIGH(CODLOC)); 00555 CALL PUNCH$HEX (LOW (CODLOC)); 00556 CALL PUNCH$HEX (TYPE); 00557 DO I =1 TO CODLEN; 00558 CALL PUNCH$HEX (CODE(I)); 00559 END; 00560 CODCHK=CODCHK-HIGH (CODLOC)-LOW (CODLOC)-TYPE-CODLEN; 00561 CALL PUNCH$HEX (CODCHK); 00562 CALL PUNCH (CR); 00563 CALL PUNCH (LF); 00564 CODCHK,CODLEN = 0; 00565 CODTOP = CODMAX; 00566 END PUNCH$RECORD; 00567 00568 /* -------------------------------------------------- */ 00569 00570 00571 /*INSTR-VERIFY AND OPERATE ON MACHINE INSTRUCTION 00572 THE SINGLE ARGUMENT SPECIFIES ACTIONS AS FOLLOWS: 00573 BITS 1 AND 0 QUALIFY THE REGISTERS REQUIRED: 00574 00 => NO REGISTER 00575 01 => ANY EVEN REGISTER 00576 10 => ANY REGISTER 00577 11 => EITHER REGISTER B OR REGISTER D 00578 BIT 2 = 1 CAUSES THE REGISTER FIELD TO BE SHIFTED LEFT 3 BITS 00579 BIT 3 = 1 CAUSES THE ARGUMENT TO THE INSTRUCTION TO 00580 BE CHECKED FOR A VALUE OF -256 TO 255 00581 BITS 7 THROUGH 4 SPECIFY THE SUCCESSOR STATE,IF NON-ZERO, 00582 RELATIVE TO THE FIRST CODE STATE NUMBER */ 00583 00584 INSTR: 00585 PROCEDURE (FIELDS); 00586 DECLARE FIELDS BYTE; 00587 00588 IF (FIELDS AND 3)<>0 THEN 00589 DO; 00590 IF HB2<>0 OR LB2 >7 OR (FIELDS AND LB2) OR ((FIELDS AND 3)=3 00591 AND LB2>2) THEN 00592 DO; 00593 LB2=0; 00594 CALL ERROR ('R'); 00595 END; 00596 IF ROR (FIELDS,2) THEN LB2 =ROL (LB2,3); 00597 LB1=LB1 OR LB2; 00598 END; 00599 /*TEST VALUE BETWEEN -256 AND 255*/ 00600 IF SHR (FIELDS,3)THEN IF HB2 +1>1 THEN CALL ERROR ('V'); 00601 /*34 IS THE STATE NUMBER OF THE FIRST MACHINE 00602 INSTRUCTION STATE ()*/ 00603 IF(RTOKEN:=SHR(FIELDS,4)+34)=34 THEN 00604 DO; 00605 IF HB1>0THEN CALL ERROR ('V'); 00606 TYPE = COD; 00607 END; 00608 END INSTR; 00609 00610 /* -------------------------------------------------- */ 00611 00612 00613 /*ENTER AN ASSEMBLY CONTROL BLOCK */ 00614 00615 ENTER$CONTROL$BLOCK: 00616 PROCEDURE (TYPE); 00617 DECLARE TYPE BYTE; 00618 00619 IF (BP:=BP+1)>=MAXBP THEN 00620 DO; 00621 CALL ERROR ('S'); 00622 BP=NP; 00623 END; 00624 BLKTYP (BP)=BLKTYP; 00625 ASMSUP (BP)=ASMSUP; 00626 BLKTYP = TYPE; 00627 END ENTER$CONTROL$BLOCK; 00628 00629 /* -------------------------------------------------- */ 00630 00631 00632 /*EXIT ASSEMBLY CONTROL BLOCK*/ 00633 00634 EXIT$CONTROL$BLOCK: 00635 PROCEDURE (TYPE); 00636 DECLARE TYPE BYTE; 00637 00638 IF TYPE <>BLKTYP THEN CALL ERROR ('N'); 00639 BLKTYP=BLKTYP(BP); 00640 ASMSUP=ASMSUP(BP); 00641 IF BP >0 THEN BP=BP-1; 00642 END EXIT$CONTROL$BLOCK; 00643 00644 /* -------------------------------------------------- */ 00645 00646 00647 /*ENTER A LEXICAL BLOCK*/ 00648 00649 ENTER$BLOCK: 00650 PROCEDURE (TYPE); 00651 DECLARE TYPE BYTE; 00652 00653 CALL ENTER$CONTROL$BLOCK (TYPE); 00654 IF(NP:=NP+1)>=MAXNP THEN 00655 DO; 00656 CALL ERROR ('S'); 00657 NP,BP=2; 00658 END; 00659 ELSE 00660 DO; 00661 MACBOD (NP)=MACBOD; 00662 MACPRM (NP)=MACPRM; 00663 MACPTR (NP)=MACPTR; 00664 SYMBOT (NP)=SYMBOT; 00665 SYMTOP (NP)=SYMTOP; 00666 END; 00667 LINKP=LINKP+LINK; 00668 IF PASS=1 THEN 00669 DO; 00670 SYMAX=(LINKP:=SYMAX)+2; 00671 LINK=2; 00672 END; 00673 SYMBOT=LINKP+2; 00674 SYMTOP=LINKP+LINK; 00675 END ENTER$BLOCK; 00676 00677 /* -------------------------------------------------- */ 00678 00679 00680 /*EXIT A LEXICAL BLOCK*/ 00681 00682 EXIT$BLOCK: 00683 PROCEDURE(TYPE); 00684 DECLARE TYPE BYTE; 00685 00686 IF NP=1 AND TYPE<>2 /*MAIN*/ THEN CALL ERROR ('N'); 00687 ELSE 00688 DO; 00689 CALL EXIT$CONTROL$BLOCK (TYPE); 00690 MACBOD=MACBOD(NP); 00691 MACPRM=MACPRM(NP); 00692 MACPTR=MACPTR(NP); 00693 SYMTOP=SYMTOP(NP); 00694 SYMBOT=SYMBOT(NP); 00695 IF PASS =1 THEN LINKP = SYMBOT-2; 00420 00696 NP = NP-1; 00697 END; 00698 END EXIT$BLOCK; 00699 00700 /* -------------------------------------------------- */ 00701 00702 00703 /*SET SIGN FOR MULTIPLYING OPERATOR*/ 00704 00705 SET$SIGN: 00706 PROCEDURE; 00707 00708 SIGN=ROR(HB1 XOR HB2,1); 00709 IF ROL (HB1,1)THEN VAL1=-VAL1; 00710 IF ROL (HB2,1)THEN VAL2=-VAL2; 00711 END SET$SIGN; 00712 00713 /* -------------------------------------------------- */ 00714 00715 00716 /*GNC RETURNS THE NEXT CHARACTER OF THE TEXT IF IBP=1, 00717 AND THE PREVIOUS TEXT CHARACTER IF IBP=0,*/ 00718 00719 GNC: 00720 PROCEDURE BYTE; 00721 00722 IF IBP <> 0 THEN 00723 DO; 00724 IF MACXPN THEN 00725 DO; 00726 GET$MACRO: 00727 MACPTR=MACPTR+1; 00728 IF (PREV$CHAR:=MACRO)=26/*DNDM EXPONTOKEN*/ 00729 THEN GOTO NO$ECHO$EXIT; 00730 IF PREV$CHAR >7FH THEN 00731 DO; 00732 IF MACSUB THEN 00733 DO; 00734 /*END OF PARAMETER-RESUME SCAN OF MACRO BODY*/ 00735 MACSUB=FALSE; 00736 MACPTR=MACBOD; 00737 END; 00738 ELSE 00739 DO; 00740 /*SUBSTITUTE ACTUAL PARAMETER FOR FORMAL*/ 00741 MACBOD=MACPTR; 00742 MACPTR=MACPRM; 00743 MACSUB=TRUE; 00744 DO WHILE (PREV$CHAR:=PREV$CHAR-1)>=80H; 00745 MACPTR=MACPTR-(MACRO AND 7FH); 00746 END; 00747 END; 00748 GOTO GET$MACRO; 00749 END; 00750 END; 00751 ELSE 00752 DO WHILE (PREV$CHAR:=TEXT)=0 00753 OR PREV$CHAR=LF OR PREV$CHAR=7FH; 00754 END; 00755 IF NOT PASS THEN CALL LIST (PREV$CHAR); 00756 IF MACDEF AND PASS=1 THEN 00757 DO; 00758 IF SYMAXTHE CHARACTER IS ILLEGAL OUTSIDE STRINGS OR COMMENTS 00778 1=>HORIZONTAL TAB OR BLANK 00779 2=>; 00780 3=>: 00781 4=>CARRIAGE RETURN 00782 5=>AN OPERATOR,IE.()+,-/* 00783 6=>$ 00784 7=>' 00785 8=>DECIMAL NUMERAL 00786 9=>ALPHABETIC OR QUESTION MARK OR COMMERCIAL AT*/ 00787 00788 CTYPE: 00789 PROCEDURE BYTE; 00790 00791 /*'CLASS CONTAINS A HEXADECIMAL CLASS NUMBER 00792 FOR EACH OF THE ASCII CHARACTERS BELOW 'QUESTION MARK' 00793 IN THE COLLATION SEQUENCE.*/ 00794 00795 DECLARE CLASS DATA ( 00796 00797 00H,00H,00H,00H,10H,00H,40H,00H, 00798 00H,00H,00H,00H,00H,00H,00H,00H, 00799 01H,00H,06H,70H,55H,55H,55H,50H, 00800 88H,88H,88H,88H,88H,23H,00H,00H ); 00801 00802 DECLARE I BYTE; 00803 00804 IF GNC>'Z'THEN RETURN 0; 00805 IF CHAR >'>'THEN RETURN 9; 00806 RETURN QUARTEL(.CLASS,CHAR); 00807 END CTYPE; 00808 00809 /* -------------------------------------------------- */ 00810 00811 00812 /* MOVE DATA TO TOP OF MEMORY */ 00813 00814 MOVE: 00815 PROCEDURE (BOTTOM,TOP) ADDRESS; 00816 DECLARE (BOTTOM,TOP) ADDRESS,SRC BASED TOP BYTE, 00817 DST BASED FREMEM BYTE; 00818 00819 DO WHILE BOTTOM <=TOP; 00820 DST=SRC; 00821 TOP=TOP-1; 00822 FREMEM=FREMEM-1; 00823 END; 00824 RETURN FREMEM; 00825 END MOVE; 00826 00827 /* -------------------------------------------------- */ 00828 00829 00830 /*STACK CREATES A ZERO LENGH ENTRY IN THE OPERAND STACK 00831 OF THE TYPE SPECIFIED IN CALL.*/ 00832 00833 STACK: 00834 PROCEDURE (TYPE); 00835 DECLARE TYPE BYTE; 00836 00837 SP=SP+1; 00838 IF SP>=SPMAX THEN 00839 DO; 00840 SP=2; 00841 CALL ERROR ('S'); 00842 END; 00843 VAL(SP)=VAL; 00844 ST(SP)=ST; 00845 TYP(SP)=TYP; 00846 LEN(SP)=LEN; 00847 VAL=VAL+LEN; 00848 ST=0; 00849 TYP=TYPE; 00850 LEN=0; 00851 RETURN; 00852 END STACK; 00853 00854 /* -------------------------------------------------- */ 00855 00856 00857 /*PUSH APPENDS THE BYTE VALUE PASSED TO THE TOP OPERAND 00858 STACK ENTRY'S VALUE,AND INCREMENTS THE SYMBOL LENGTH.*/ 00859 00860 PUSH: 00861 PROCEDURE (DATUM); 00862 DECLARE DATUM BYTE; 00863 DECLARE ST BASED VAL BYTE; 00864 00865 IF VAL+LEN < STKTOP THEN 00866 DO; 00867 ST(LEN)=DATUM; 00868 LEN=LEN+1; 00869 END; 00870 ELSE CALL ERROR ('T'); 00871 RETURN; 00872 END PUSH; 00873 00874 /* -------------------------------------------------- */ 00875 00876 00877 /*DELETE REMOVES THE TOP ELEMENT OF THE OPERAND STACK,AND 00878 DEALLOCATES STORAGE FOR ITS VALUE.*/ 00879 00880 DELETE: 00881 PROCEDURE; 00882 00883 VAL=VAL(SP); 00884 ST=ST(SP); 00885 TYP=TYP(SP); 00886 LEN=LEN(SP); 00887 SP=SP-1; 00888 END DELETE; 00889 00890 /* -------------------------------------------------- */ 00891 00892 00893 /*STACKAN COPIES THE INPUT TEXT INTO THE TOP OPERAND STACK 00894 ENTRY'S VALUE UNTIL A NON-ALPHANUMERIC CHARACTER IS 00895 ENCOUNTERED.*/ 00896 00897 STACKAN: 00898 PROCEDURE (TYPE); 00899 DECLARE TYPE BYTE; 00900 00901 CALL STACK (TYPE); 00902 IBP=IBP-1; 00903 DO WHILE CTYPE ALPHANUMERIC; 00904 00905 /*CONVERT FROM LOWER TO UPPER CASE*/ 00906 00907 IF CHAR >'9' THEN CHAR=CHAR AND 0DFH; 00908 CALL PUSH (CHAR); 00909 END; 00910 IBP=IBP-1; 00911 END STACKAN; 00912 00913 /* -------------------------------------------------- */ 00914 00915 00916 /* RETURN PRECEDENCE OF TOKEN.*/ 00917 00918 PRECEDENCE: 00919 PROCEDURE (TOKEN) BYTE; 00920 DECLARE TOKEN BYTE,I BYTE,PRC DATA ( 00921 00H,00H,67H,61H,76H,56H,34H,73H, 00922 77H,11H,11H,11H,11H,00H,11H,11H, 00923 11H,11H,11H,11H,11H,11H,11H); 00936 00924 00925 RETURN QUARTEL(.PRC,TOKEN); 00926 END PRECEDENCE; 00927 00928 /* -------------------------------------------------- */ 00929 00930 00931 /* LOOK UP THE IDENTIFIERS AT STACK TOP AND RETURN ITS 00932 TYPE,IF THE IDENTIFIER DOES NOT EXIST,RETURN 00933 'UNDEFINED.ST(SP)IS SET TO THE SYMBOL TABLE LOCATION 00934 WHERE THE IDENTIFIER IS,OR SHOULD BE INSERTED,ONLY THE 00935 IDENTIFIERS IN THE BLOCK SPECIFIED ARE TESTED.*/ 00937 LOOKUP: 00938 PROCEDURE(BLOCK)BYTE; 00939 DECLARE (BLOCK,FLAG) BYTE,STTYP BASED ST BYTE; 00940 00941 LOWER=SYMBOT(BLOCK); 00942 UPPER,LOC=SYMTOP(BLOCK); 00943 DO WHILE LOC+ 0 /* EVALUATE(LOC)*/ 00944 <>(LOC:=LOWER+SHR(UPPER-LOWER AND 0FFF0H,1)); 00945 SYM=VAL; 00946 DO WHILE (FLAG:=SYMTAB-SYMSTR)=0; 00947 LOC=LOC+1; 00948 IF(SYM:=SYM+1)=VAL+LEN THEN 00949 DO; 00950 IF LEN =5 OR SYMTAB=' 'THEN 00951 DO; 00952 ST=LOC-LEN; 00953 RETURN(TYP:=STTYP(5)); 00954 END; 00955 ELSE GOTO CONTINUE$SEARCH; 00956 END; 00957 END; 00958 CONTINUE$SEARCH: 00959 LOC=LOC-SYM+VAL; 00960 IF ROL(FLAG,1)THEN LOWER=LOC; 00961 ELSE UPPER=LOC; 00962 END; 00963 ST=UPPER; 00964 RETURN UND; 00965 END LOOKUP; 00966 00967 /* -------------------------------------------------- */ 00968 00969 00970 /*ENTER THE IDENTIFIER AT STACK TOP IN THE SYMBOL TABLE 00971 BLOCK SPECIFIED,USING THE VALUE SPECIFIED.*/ 00972 00973 ENTER: 00974 PROCEDURE (VALUE,TYPE,BLOCK); 00975 DECLARE VALUE ADDRESS,(TYPE,BLOCK) BYTE; 00976 DECLARE STVAL BASED ST ADDRESS, STSYM BASED ST BYTE,I BYTE; 00977 00978 IF SP<>1THEN CALL ERROR('F'); 00979 ELSE 00980 DO; 00981 IF TYP=UND THEN 00982 DO; /*ENTER THE PRINT NAME AND TYPE*/ 00983 IF (UPPER:=(LOWER:=SYMAX)+8)>=FREMEM 00984 THEN CALL ERROR('T'); 00985 ELSE 00986 DO; 00987 SYMAX=UPPER; 00988 SYMTOP(BLOCK)=SYMTOP(BLOCK)+8; 00989 LOC=SYMBOT(BLOCK)-2; /*IE.THE BLOCK'S LENGTH*/ 00990 LOCVAL=LOCVAL+8; 00991 /*NOW UPDATE THE SYMBOL TABLE POINTERS FOR ANY OTHER 00992 BLOCKS ABOVE THE SPECIFIED BLOCK.*/ 00993 DO WHILE(BLOCK:=BLOCK+1 AND BLOCK<=NP)<>RESERVED; 00994 SYMBOT(BLOCK)=SYMBOT(BLOCK)+8; 00995 SYMTOP(BLOCK)=SYMTOP(BLOCK)+8; 00996 END; 00997 /*MOVE ALL TABLE ENTRIES UP TO MAKE SPACE FOR NEW ENTR 00998 DO WHILE LOWER>=ST; 00999 DST=SRC; 01000 UPPER=UPPER-2; 01001 LOWER=LOWER-2; 01002 END; 01003 /*INSERT THE PRINT NAME(BLANK PADDED), 01004 SYMBOL TYPE AND VALUE.*/ 01005 DO I=0 TO 4; 01006 BLOCK=' '; 01007 IF I UND THEN CALL ERROR ('M'); 01016 IF STVAL(3)<>VALUE THEN CALL ERROR('P'); 01017 END; 01018 CALL DELETE; 01019 END; 01020 END ENTER; 01021 01022 01023 01024 /* -------------------------------------------------- */ 01025 01026 01027 /*VALUE RETURNS THE VALUE OF THE OPERAND AT STACK TOP 01028 VAL1 IS ALTERED*/ 01029 01030 VALUE: 01031 PROCEDURE ADDRESS; 01032 01033 VAL1=0; 01034 IF SP<1 THEN CALL ERROR ('F'); 01035 ELSE 01036 DO; 01037 IF TYP=UND AND NP>1 THEN TYP=LOOKUP (GLOBAL); 01038 IF TYP=UND THEN CALL ERROR ('U'); 01039 ELSE 01040 DO; 01041 IF TYP<=SET THEN VAL=ST+6; 01042 ELSE IF LEN>2 THEN CALL ERROR ('V'); 01043 LB1=SYMBOL; 01044 IF LEN>1 THEN HB1=SYMBOL(1); 01045 END; 01046 CALL DELETE; 01047 END; 01048 RETURN VAL1; 01049 END VALUE; 01050 01051 /* -------------------------------------------------- */ 01052 01053 01054 DECLARE /*THE OPERAND STACK ONLY AFTER THE PROCEDURES*/ 01055 STK (STKMAX) BYTE; 01056 01057 /*INITIALIZE FOR PASS*/ 01058 01059 ERCHAR=' '; 01060 PREV$CHAR=CR; 0/061 CODLEN,CODCHK,CODEND,IBP,SP,BP,NP,LEN,TYP,OPR(1)=0; 01062 CODTOP=CODMAX; 01063 MACDEF,MACXPN,MACSUB=FALSE; 01064 CALL ENTER$BLOCK (2 /*MAIN*/); 01065 /* SO THAT RESERVED WORDS ARE IN BLOCK 0 */ 01066 LC,CODLOC=0; 01067 STKTOP=(VAL := .STK)+STKMAX; 01068 OSP,TOKEN=1; 01069 01070 OPDCHECK: /*OPERANDS BRANCH HERE BEFORE DROPPING 01071 THROUGH TO SCAN, */ 01072 01073 IF TOKEN=0 THEN CALL ERROR ('E'); 01074 TOKEN=0; 01075 01076 SCAN: /*THE INPUT FOR THE NEXT SYMBOL'S INITIAL CHAR 01077 THEN GO TO THE APPROPRIATE SYMBOL PROCESSOR.*/ 01078 01079 DO CASE CTYPE; 01080 01081 /* ILLEGAL CHARACTERS */ 01082 01083 IF NOT (CHAR=26 /*ENDM EXPN TOKEN*/ AND MACXPN) THEN 01084 DO; 01085 CALL ERROR ('I'); 01086 GO TO SCAN; 01087 END; 01088 01089 /* HORIZONTAL TAB OR BLANK */ 01090 01091 GO TO SCAN; 01092 01093 /* COMMENT*/ 01094 01095 DO; 01096 DO WHILE CTYPE <> 4; /*CARRIAGE RETURN*/ 01097 END; 01098 CHAR=ENDS; 01099 END; 01100 01101 /*COLON*/ 01102 01103 DO; 01104 TOKEN=ENDS; /*ONLY TO INDICATE AN OPERATOR WAS SCANNED*/ 01105 I=LOCAL; 01106 IF GNC<>':'THEN IBP=IBP-1; 01107 ELSE IF NP>1 THEN TYP=LOOKUP(I:=GLOBAL); 01108 IF NOT ASMSUP THEN CALL ENTER (LC,IDN,I); 01109 GO TO SCAN; 01110 END; 01111 01112 /*CARRIAGE RETURN*/ 01113 01114 CHAR=ENDS; 01115 01116 /*OPERATOR I.E.,()+,-/* 01117 NOTE THAT THE TOKENS ARE A FUNCTION OF THE CHARACTER VALUE 01118 01119 DO; 01120 IF(CHAR='+' OR CHAR='-') 01121 AND TOKEN<>0 AND TOKEN <> RPAR THEN 01122 CHAR=CHAR+3; /*UNARY*/ 01123 CHAR=CHAR-'('+LPAR; 01124 END; 01125 01126 /* $= ASSIGN THE CURRENT LOCATION COUNTER TO VALUE */ 01127 01128 DO; 01129 CALL STACK(ABS); 01130 CALL PUSH (LC); 01131 CALL PUSH (HIGH(LC)); 01132 GO TO OPDCHECK; 01133 END; 01134 01135 /* '=COLLECT STRING*/ 01136 01137 DO; 01138 CALL STACK(STR); 01139 DO WHILE GNC<>CR; 01140 IF CHAR=''''THEN 01141 DO; 01142 IF GNC<>''''THEN GO TO ENDSTRING; 01143 END; 01144 CALL PUSH(CHAR); 01145 END; 01146 CALL ERROR ('B'); /*STRING DIDN'T BALENCE.*/ 01147 ENDSTRING: 01148 IBP=IBP-1; 01149 GO TO OPDCHECK; 01150 END; 01151 01152 /* CONVERT NUMERIC STRING TO VALUE */ 01153 01154 DO; 01155 CALL STACKAN(ABS); 01156 RADIX =0; 01157 CHAR=SYMBOL(LEN:=LEN-1); /*LAST CHARACTER IN NUMBER*/ 01158 IF CHAR='H'THEN RADIX=16; 01159 IF CHAR='O'OR CHAR='Q'THEN RADIX=8; 01160 IF CHAR='B'THEN RADIX=2; 01161 IF CHAR='D'THEN RADIX=10; 01162 IF RADIX=0 THEN RADIX=10; 01163 ELSE LEN=LEN-1; 01164 VAL1=0; 01165 DO I=0 TO LEN; 01166 IF (CHAR:=SYMBOL(I)-'0')>9 THEN CHAR=CHAR-7; 01167 IF CHAR >=RADIX THEN 01168 DO; 01169 CHAR=0; 01170 CALL ERROR ('I'); 01171 END; 01172 VAL1=VAL1*RADIX+CHAR; 01173 END; 01174 LEN=0; 01175 CALL PUSH(VAL1); 01176 CALL PUSH(HIGH(VAL1)); 01177 GOTO OPDCHECK; 01178 END; 01179 01180 /*COLLECT AN IDENTIFIER AND CHECK FOR RESERVED WORD*/ 01181 01182 DO; 01183 VAL2=MACPTR-1; /*MAY REPLACE A FORMAL PARAMETER*/ 01184 CALL STACKAN (UND); 01185 IF LEN>5 THEN LEN=5; /*TRUNCATE IF NECESSARY*/ 01186 IF LOOKUP (RESERVED) =UND THEN IF LOOKUP (LOCAL)=FRM THEN 01187 DO; 01188 /* REPLACE A MACRO FORMAL PARAMETER WITH ITS PARAMETER N 01189 MACPTR=(LOC:=VAL2)+2; 01190 SYMTAB=VALUE OR 80H; /*PARAMETER NUMBER*/ 01191 SYMTAB(1)=CHAR; /*MOVE TERMINATOR DOWN TO PARAMETER NO.* 01192 END; 01193 IF TYP=23 /*ENDM*/ THEN MACEND=VAL2; 01194 /* NOW CHECK FOR NESTED MACRO CALLS*/ 01195 IF TYP=UND AND NP>1 THEN 01196 IF LOOKUP(GLOBAL)<>MAC THEN TYP=LOOKUP(LOCAL); 01197 IF(CHAR:=TYP)>=31 THEN TYP=IDN; /*MACHINE INSTRS*/ 01198 IF TYP >10 THEN CALL DELETE; /* DIRECTIVES ARITH OPS*/ 01199 IF CHAR>SET THEN GOTO STACKOPR; /*ANY OPERATOR*/ 01200 GOTO OPDCHECK; 01201 END; 01202 01203 END; /*OF CASE ON SYMBOL'S INITIAL CHARACTER*/ 01204 01205 /* -------------------------------------------------- */ 01206 01207 01208 /*OPERATORS FALL THROUGH THE SCAN INITIAL CASE STATEMENT HER 01209 01210 DECLARE CINFO DATA ( 01211 01212 00000000B, 10000000B, 00000000B, 00000000B, 01213 00001111B, 00001111B, 00000000B, 00001111B, 01214 00001101B, 00001111B, 00001101B, 00001101B, 01215 00001111B, 00001111B, 00001111B, 00001111B, 01216 00001111B, 00001111B, 01000000B, 00000001B, 01217 01001101B, 10000000B, 10000000B, 10000000B, 01218 00000001B, 10000001B, 10000000B, 01000000B, 01219 01000000B, 00000001B, 00000001B, 01000000B, 01220 01000000B, 01000000B, 01000111B, 00000111B, 01221 00000111B, 00000111B, 00010111B, 01000111B, 01222 00000111B, 01000111B, 00110111B, 00000101B ); 01223 01224 STACKOPR: 01225 01226 IF ASMSUP AND CINFO(CHAR)<80H THEN GOTO SCAN; 01227 /* IGNORE TOKENS OTHER THAN IF,END,ENDM, 01228 ENDM EXPN,AND CR DURING CONDITIONAL ASSEMBLY 01229 AND MACRO DEFINITION */ 01230 IF PRECEDENCE (TOKEN:=CHAR)> 01231 PRECEDENCE (RTOKEN:=OPR (OSP)) OR TOKEN=LPAR THEN 01232 DO; 01233 OPR(OSP:=OSP+1)=TOKEN; 01234 GOTO SCAN; 01235 END; 01236 IF RTOKEN=0 THEN RTOKEN=TOKEN; 01237 ELSE OSP=OSP-1; 01238 IF ( INFO := CINFO (RTOKEN )) THEN VAL2=VALUE; 01239 /*VAL1,VAL2 SET TO TOP OF STACK */ 01240 IF (INFO:=ROR(INFO,1))THEN VAL1=VALUE; 01241 /*VAL1 SET TO TOP OF STACK */ 01242 TYPE=ABS; 01243 DO CASE RTOKEN; 01244 01245 01246 /* -------------------------------------------------- */ 01247 01248 /* CASE0 - SYMBOL=BEGINNING OF STATEMENT */ 01249 01250 ; /*CAN'T GET HERE*/ 01251 01252 /* -------------------------------------------------- */ 01253 01254 01255 /*CASE1-SYMBOL = END OF STATEMENT*/ 01256 01257 END$STATEMENT: 01258 01259 DO; 01260 SYM=VAL+LEN; 01261 IF ASMSUP THEN SYM=.STK;/*DELETE ALL VALUES FOR THIS STMT* 01262 DO WHILE SP>0; 01263 IF TYP <> COD THEN CALL ERROR ('Q'); 01264 CALL DELETE; 01265 END; 01266 01267 /* PRODUCE LISTING IF PASS=2 OR PASS=4 */ 01268 01269 LOC=.STK; 01270 I=TRUE; 01271 IF NOT PASS THEN 01272 DO WHILE I; 01273 CALL LIST (CR); 01274 CALL LIST (0); 01275 CALL LIST (ERCHAR); 01276 CALL LIST (' '); 01277 IF (PRINTV :=PRINTV OR LOC<>SYM) THEN 01278 DO; 01279 CALL LIST$HEX (HIGH (PRINTN)); 01280 CALL LIST$HEX (LOW (PRINTN)); 01281 END; 01282 PRINTV=SHL(NOT PRINTV AND TRUE,2); 01283 DO J=0 TO PRINTV; 01284 /*IE.ONE BLANK IF ADDRESS FIELD WAS PRINTED, 01285 OTHERWISE, FIVE BLANKS */ 01286 CALL LIST (' '); 01287 END; 01288 DO J=1 TO 4; 01289 IF LOC 0 THEN 01300 DO; 01301 /*IE.LIST DEVICE OTHER THAN TTY */ 01302 CALL LIST (CR); 01303 CALL LIST (0); 01304 CALL LIST (TAB); 01305 CALL LIST (TAB); 01306 END; 01307 PRINTN=PRINTN+4; 01308 END; 01309 01310 /* PRODUCE OBJECT CODE IF PASS=3 OR PASS=4*/ 01311 01312 IF PASS >2 THEN 01313 DO; 01314 LOC=.STK; 01315 IF LC <> CODLOC+CODLEN OR CODEND THEN 01316 DO; 01317 IF CODLEN<>0 THEN CALL PUNCH$RECORD (0); 01318 CODLOC=LC; 01319 END; 01320 DO WHILE LOC */ 01411 01412 NEGATE: 01413 VAL1=-VAL1; 01414 01415 01416 /* -------------------------------------------------- */ 01417 01418 /*CASE 11 -SYMBOL =NOT */ 01419 01420 VAL1=NOT VAL1; 01421 01422 01423 /* -------------------------------------------------- */ 01424 01425 /* CASE 12-SYMBOL=AND */ 01426 01427 VAL1=VAL1 AND VAL2; 01428 01429 01430 /* -------------------------------------------------- */ 01431 01432 /* CASE 13-SYMBOL=OR */ 01433 01434 VAL1=VAL1 OR VAL2; 01435 01436 01437 /* -------------------------------------------------- */ 01438 01439 /* CASE 14-SYMBOL=XOR */ 01440 01441 VAL1=VAL1 XOR VAL2; 01442 01443 01444 /* -------------------------------------------------- */ 01445 01446 /* CASE 15-SYMBOL=MOD */ 01447 01448 DO; 01449 CALL SET$SIGN; 01450 VAL1 =VAL1 MOD VAL2; 01451 IF SIGN THEN GOTO NEGATE; 01452 END; 01453 01454 01455 /* -------------------------------------------------- */ 01456 01457 /* CASE 16 -SYMBOL=SHL */ 01458 01459 IF LB2<>0 THEN VAL1=SHL(VAL1,LB2); 01460 01461 01462 /* -------------------------------------------------- */ 01463 01464 /* CASE 17 -SYMBOL=SHR */ 01465 01466 IF LB2<>0 THEN VAL1=SHR(VAL1,LB2); 01467 01468 01469 /* -------------------------------------------------- */ 01470 01471 /* CASE 18 -SYMBOL=DB */ 01472 01473 DO; 01474 IF TYP <> STR AND TYP <> COD THEN 01475 DO; 01476 VAL1=VALUE; 01477 IF HB1-1<254 THEN CALL ERROR ('V'); 01478 INFO=00100010B; 01479 END; 01480 TYP,TYPE=COD; 01481 END; 01482 01483 01484 /* -------------------------------------------------- */ 01485 01486 /* CASE 19-SYMBOL=DS */ 01487 01488 DO; 01489 PRINTV=TRUE; 01490 LC=LC+VAL2; 01491 GOTO STACKOPR; 01492 END; 01493 01494 01495 /* -------------------------------------------------- */ 01496 01497 /* CASE 20 -SYMBOL=DW */ 01498 01499 TYPE=COD; 01500 01501 01502 /* -------------------------------------------------- */ 01503 01504 /* CASE 21 -SYMBOL=END */ 01505 01506 DO; 01507 IF SP>0 THEN LC=VALUE; 01508 ELSE VAL1,LC=0; 01509 PRINTV,CODEND=TRUE; 01510 IF PASS=1 THEN 01511 DO; 01512 /*JUST IN CASE BLOCK COUNTS DON'T AGREE DURING PASSES, 01513 A ZERO LINK WILL CAUSE THE SEARCH TO STOP.*/ 01514 LINKP=SYMAX; 01515 LINK=0; 01516 END; 01517 ASMSUP=FALSE; /*ENABLE ERROR CODE PRINTING FOR'N'ERROR */ 01518 CALL EXIT$BLOCK (2/*MAIN*/); 01519 END; 01520 01521 01522 /* -------------------------------------------------- */ 01523 01524 /* CASE 22 -SYMBOL=ENDIF */ 01525 01526 CALL EXIT$CONTROL$BLOCK (0 /*CONDITIONAL*/); 01527 01528 01529 /* -------------------------------------------------- */ 01530 01531 /* CASE 23 -SYMBOL=ENDM */ 01532 01533 IF NOT (BLKTYP=0 AND ASMSUP) THEN 01534 DO; 01535 IF NOT MACDEF THEN CALL ERROR ('N'); 01536 ELSE 01537 DO; 01538 IF PASS=1 THEN 01539 DO; 01540 ENDMAC=26 /*ENDM EXPN TOKEN*/; 01541 /* MARK END OF MACRO BODY*/ 01542 MACADR(3)=MOVE(SYMAX,MACEND); 01543 SYMAX=SYMBOT-2; /*RELEASE S,T,BLOCK FOR FORMALS.*/ 01544 CALL EXIT$BLOCK (3/*MACRO DEF */); 01545 END; 01546 ELSE CALL EXIT$CONTROL$BLOCK (3/*MACRO DEF*/); 01547 MACDEF=FALSE; 01548 END; 01549 END; 01550 01551 01552 /* -------------------------------------------------- */ 01553 01554 /* CASE 24 -SYMBOL=EQU */ 01555 01556 DO; 01557 CALL ENTER (VAL1,IDN,LOCAL); 01558 PRINTV=TRUE; 01559 END; 01560 01561 01562 /* -------------------------------------------------- */ 01563 01564 /* CASE 25 -SYMBOL=IF */ 01565 01566 DO; 01567 CALL ENTER$CONTROL$BLOCK (0 /*CONDITIONAL*/); 01568 ASMSUP=ASMSUP OR VAL1=0; 01569 END; 01570 01571 01572 /* -------------------------------------------------- */ 01573 01574 /* CASE 26 -SYMBOL=ENDM EXPN*/ 01575 01576 DO; 01577 FREMEM=MACPRM;/*RELEASE MEMORY ALLOCATED TO PARAMETERS*/ 01578 CALL EXIT$BLOCK (1/*MACRO*/); 01579 MACXPN=NP>1; 01580 GOTO END$STATEMENT; 01581 END; 01582 01583 01584 /* -------------------------------------------------- */ 01585 01586 /* CASE 27 -SYMBOL=MACRO DEFINITION HEAD*/ 01587 01588 MACRO$DEFINITION: 01589 01590 DO; 01591 IF PASS=1 THEN 01592 DO; 01593 MACNAM=ST;/*ST WAS SET BY LOOKUP */ 01594 CALL ENTER (0,MAC,LOCAL); 01595 CALL ENTER$BLOCK (3/*MACRO DEF*/); 01596 /* ALLOCATE TEMPORARY BLOCK FOR FORMALS.*/ 01597 END; 01598 ELSE 01599 DO; 01600 CALL DELETE; 01601 CALL ENTER$CONTROL$BLOCK (3/*MACRO DEF*/); 01602 END; 01603 CHAR=20/*MDF*/;/*STACK MACRO DEFINITION*/ 01604 PRMNO=0; 01605 END; 01606 01607 01608 /* -------------------------------------------------- */ 01609 01610 /* CASE 28-SYMBOL=MACRO DEFINITION*/ 01611 01612 DO; 01613 IF SP<>0 THEN 01614 DO; 01615 IF PASS=1 THEN CALL ENTER(PRMNO:=PRMNO+1,FRM,LOCAL); 01616 ELSE CALL DELETE; 01617 END; 01618 IF TOKEN=ENDS THEN 01619 DO; 01620 MACDEF,ASMSUP=TRUE; 01621 MACPTR=SYMAX; 01622 END; 01623 END; 01624 01625 01626 /* -------------------------------------------------- */ 01627 01628 /* CASE 29 -SYMBOL=ORG*/ 01629 01630 DO; 01631 PRINTV=TRUE; 01632 LC=VAL1; 01633 GOTO STACKOPR; 01634 END; 01635 01636 01637 /* -------------------------------------------------- */ 01638 01639 /* CASE 30 -SYMBOL=SET*/ 01640 01641 DO; 01642 I=LOCAL; 01643 IF TYP=UND AND NP>1 THEN 01644 DO; 01645 IF LOOKUP(I:=GLOBAL)<>SET AND TYP<>UND THEN 01646 CALL ERROR ('M'); 01647 IF TYP <> SET THEN TYP=LOOKUP (I:=LOCAL); 01648 END; 01649 CALL ENTER (VAL1,SET,I); 01650 PRINTV=TRUE; 01651 END; 01652 01653 01654 /* -------------------------------------------------- */ 01655 01656 /* CASE 31- SYMBOL=TITLE*/ 01657 01658 /* TREAT TITLE AS A COMMENT*/ 01659 01660 DO WHILE SP>0; 01661 CALL DELETE; 01662 END; 01663 01664 01665 /* -------------------------------------------------- */ 01666 01667 /* CASE 32 -SYMBOL=MACRO CALL HEAD*/ 01668 01669 DO; 01670 IF TOKEN =27 /*MDH*/ THEN GOTO MACRO$DEFINITION; 01671 MACNAM=FREMEM; /*SAVE NEXT BLOCK'S MCPRM*/ 01672 RTOKEN=33 /*MCL*/; 01673 GOTO MACRO$CALL; 01674 END; 01675 01676 01677 /* -------------------------------------------------- */ 01678 01679 /* CASE 33 -SYMBOL=MACRO CALL*/ 01680 01681 MACRO$CALL: 01682 01683 DO; 01684 IF SP<2 THEN CALL STACK (STR); 01685 /* INSERT NULL STRING FOR NULL PARM */ 01686 IF TYP<>STR AND TYP>SET THEN 01687 DO; 01688 LOC=VALUE;/*ALSO SETS VAL1 TO VALUE*/ 01689 CALL STACK(STR); 01690 CALL PUSH ('0'); 01691 CALL PUSH (HEX(HB1,1)); 01692 CALL PUSH (HEX(HB1,2)); 01693 CALL PUSH (HEX(LB1,1)); 01694 CALL PUSH (HEX(LB1,2)); 01695 CALL PUSH ('H'); 01696 END; 01697 CALL PUSH ((I:=LEN)+1 OR 80H); 01698 VAL2 =MOVE(VAL,VAL+I); 01699 CALL DELETE; 01700 IF TOKEN = ENDS THEN 01701 DO; 01702 IF SP<>1 THEN CALL ERROR ('F'); 01703 ELSE 01704 DO; 01705 DECLARE PRMEND DATA (80H,81H); 01706 FREMEM =MOVE (.PRMEND,.PRMEND+1); 01707 CALL ENTER$BLOCK (1/*MACRO*/); 01708 MACPRM=MACNAM; 01709 MACPTR=VALUE; 01710 MACXPN=TRUE; 01711 END; 01712 END; 01713 END; 01714 01715 01716 /* -------------------------------------------------- */ 01717 01718 /* CASE 34 -SYMBOL=*/ 01719 01720 CALL INSTR (10000101B); 01721 01722 01723 /* -------------------------------------------------- */ 01724 01725 /* CASE 35 -SYMBOL=*/ 01726 01727 CALL INSTR (00000101B); 01728 01729 01730 /* -------------------------------------------------- */ 01731 01732 /* CASE 36 -SYMBOL=*/ 01733 01734 CALL INSTR (00000111B); 01735 01736 01737 /* -------------------------------------------------- */ 01738 01739 /* CASE 37 -SYMBOL=*/ 01740 01741 CALL INSTR (00000010B); 01742 01743 01744 /* -------------------------------------------------- */ 01745 01746 /* CASE 38 -SYMBOL=*/ 01747 01748 CALL INSTR (00001000B); 01749 01750 01751 /* -------------------------------------------------- */ 01752 01753 /* CASE 39 -SYMBOL=*/ 01754 01755 CALL INSTR (01000110B); 01756 01757 01752 01753 /* CASE 39 -SYMBOL=*/ 01754 01755 CALL INSTR (01000110B); 01756 01757 01758 /* -------------------------------------------------- */ 01759 01760 /* CASE 40 -SYMBOL=*/ 01761 01762 CALL INSTR (00000110B); 01763 01764 01765 /* -------------------------------------------------- */ 01766 01767 /* CASE 41 -SYMBOL=*/ 01768 01769 CALL INSTR (00110110B); 01770 01771 01772 /* -------------------------------------------------- */ 01773 01774 /* CASE 42-SYMBOL=*/ 01775 01776 CALL INSTR (00000000B); 01777 01778 01779 /* -------------------------------------------------- */ 01780 01781 /* CASE 43 -SYMBOL=*/ 01782 01783 CALL INSTR (00000000B); 01784 01785 /* -------------------------------------------------- */ 01786 01787 END; /* OF CASE ON RTOKEN */ 01788 01789 /* -------------------------------------------------- */ 01790 01791 01792 IF PRINTV THEN PRINTN=VAL1; 01793 IF (INFO AND 00011110B) <>0 THEN CALL STACK (TYPE); 01794 DO I=0 TO 3; 01795 IF(INFO:=ROR (INFO,1)) THEN CALL PUSH (LB1 (I)); 01796 END; 01797 IF ROR (INFO,1) THEN 01798 DO; 01799 IF TOKEN=COMMA THEN CHAR = RTOKEN; 01800 END; 01801 GOTO STACKOPR; 01802 01803 END ASSEMBLE; 01804 01805 01806 /* -------------------------------------------------- */ 01807 01808 DECLARE /*THE SYMBOL TABLE */ 01809 01810 SYMFIX LITERALLY '858', SYMBOL$TABLE (SYMFIX) BYTE INITIAL ( 01811 01812 90, 3, /*SYMBOL TABLE BLOCK LENGTH = SYMFIX */ 01813 01814 'A ', 02 /* SET */, 007H, 0, 01815 'ACI ', 38 /* IMM */, 0CEH, 0, 01816 'ADC ', 37 /* REG */, 088H, 0, 01817 'ADD ', 37 /* REG */, 080H, 0, 01818 'ADI ', 38 /* IMM */, 0C6H, 0, 01819 'ANA ', 37 /* REG */, 0A0H, 0, 01820 'AND ', 12 /* OPR */, 000H, 0, 01821 'ANI ', 38 /* IMM */, 0E6H, 0, 01822 'B ', 02 /* SET */, 000H, 0, 01823 'C ', 02 /* SET */, 001H, 0, 01824 'CALL ', 42 /* BRI */, 0CDH, 0, 01825 'CC ', 42 /* BRI */, 0DCH, 0, 01826 'CM ', 42 /* BRI */, 0FCH, 0, 01827 'CMA ', 43 /* ZOP */, 02FH, 0, 01828 'CMC ', 43 /* ZOP */, 03FH, 0, 01829 'CMP ', 37 /* REG */, 0B8H, 0, 01830 'CNC ', 42 /* BRI */, 0D4H, 0, 01831 'CNZ ', 42 /* BRI */, 0C4H, 0, 01832 'CP ', 42 /* BRI */, 0F4H, 0, 01833 'CPE ', 42 /* BRI */, 0ECH, 0, 01834 'CPI ', 38 /* IMM */, 0FEH, 0, 01835 'CPO ', 42 /* BRI */, 0E4H, 0, 01836 'CZ ', 42 /* BRI */, 0CCH, 0, 01837 'D ', 02 /* SET */, 002H, 0, 01838 'DAA ', 43 /* ZOP */, 027H, 0, 01839 'DAD ', 35 /* XRF */, 009H, 0, 01840 'DB ', 18 /* POP */, 000H, 0, 01841 'DCR ', 40 /* RRP */, 005H, 0, 01842 'DCX ', 35 /* XRF */, 00BH, 0, 01843 'DI ', 43 /* ZOP */, 0F3H, 0, 01844 'DS ', 19 /* POP */, 000H, 0, 01845 'DW ', 20 /* POP */, 000H, 0, 01846 'E ', 02 /* SET */, 003H, 0, 01847 'EI ', 43 /* ZOP */, 0FBH, 0, 01848 'END ', 21 /* POP */, 000H, 0, 01849 'ENDIF', 22 /* POP */, 000H, 0, 01850 'ENDM ', 23 /* POP */, 000H, 0, 01851 'EQU ', 24 /* POP */, 000H, 0, 01852 'H ', 02 /* SET */, 004H, 0, 01853 'HLT ', 43 /* ZOP */, 076H, 0, 01854 'IF ', 25 /* POP */, 000H, 0, 01855 'IN ', 38 /* IMM */, 0DBH, 0, 01856 'INR ', 40 /* RRF */, 004H, 0, 01857 'INX ', 35 /* XRF */, 003H, 0, 01858 'JC ', 42 /* BRI */, 0DAH, 0, 01859 'JM ', 42 /* BRI */ , 0FAH, 0, 01860 'JMP ', 42 /* BRI */, 0C3H, 0, 01861 'JNC ', 42 /* BRI */ , 0D2H, 0, 01862 'JNZ ', 42 /* BRI */, 0C2H, 0, 01863 'JP ', 42 /* BRI */, 0F2H, 0, 01864 'JPE ', 42 /* BRI */, 0EAH, 0, 01865 'JPO ', 42 /* BRI */, 0E2H, 0, 01866 'JZ ', 42 /* BRI */, 0CAH, 0, 01867 'L ', 02 /* SET */ , 005H, 0, 01868 'LDA ', 42 /* BRI */, 03AH, 0, 01869 'LDAX ', 36 /* LDX */, 00AH, 0, 01870 'LHLD ', 42 /* BRI */, 02AH, 0, 01871 'LXI ', 34 /* LXH */ , 001H, 0, 01872 'M ', 02 /* SET */, 006H, 0, 01873 'MACRO', 27 /* MDF */, 000H, 0, 01874 'MOD ', 15 /* OPR */, 000H, 0, 01875 'MOV ', 41 /* MRH */ , 040H, 0, 01876 'MVI ', 39 /* MIH */, 006H, 0, 01877 'NOP ', 43 /* ZOP */, 000H, 0, 01878 'NOT ', 11 /* OPR */, 000H, 0, 01879 'OR ', 13 /* OPR */, 000H, 0, 01880 'ORA ', 37 /* REG */ , 0B0H, 0, 01881 'ORG ', 29 /* POP */, 000H, 0, 01882 'ORI ', 38 /* IMM */, 0F6H, 0, 01883 'OUT ', 38 /* IMM */, 0D3H, 0, 01884 'PCHL ', 43 /* ZOP */ , 0E9H, 0, 01885 'POP ', 35 /* XRF */, 0C1H, 0, 01886 'PSW ', 02 /* SET */, 006H, 0, 01887 'PUSH ', 35 /* XRF */, 0C5H, 0, 01888 'RAL ', 43 /* ZOP */, 017H, 0, 01889 'RAR ', 43 /* ZOP */, 01FH, 0, 01890 'RC ', 43 /* ZOP */, 0D8H, 0, 01891 'RET ', 43 /* ZOP */, 0C9H, 0, 01892 'RLC ', 43 /* ZOP */, 007H, 0, 01893 'RM ', 43 /* ZOP */, 0F8H, 0, 01894 'RNC ', 43 /* ZOP */, 0D0H, 0, 01895 'RNZ ', 43 /* ZOP */, 0C0H, 0, 01896 'RP ', 43 /* ZOP */, 0F0H, 0, 01897 'RPE ', 43 /* ZOP */, 0E8H, 0, 01898 'RPO ', 43 /* ZOP */, 0E0H, 0, 01899 'RRC ', 43 /* ZOP */, 00FH, 0, 01900 'RST ', 40 /* RRF */, 0C7H, 0, 01901 'RZ ', 43 /* ZOP */, 0C8H, 0, 01902 'SBB ', 37 /* REG */, 098H, 0, 01903 'SBI ', 38 /* IMM */, 0DEH, 0, 01904 'SET ', 30 /* POP */, 000H, 0, 01905 'SHL ', 16 /* OPR */, 000H, 0, 01906 'SHLD ', 42 /* BRI */, 022H, 0, 01907 'SHR ', 17 /* OPR */, 000H, 0, 01908 'SP ', 02 /* SET */, 006H, 0, 01909 'SPHL ', 43 /* ZOP */, 0F9H, 0, 01910 'STA ', 42 /* BRI */, 032H, 0, 01911 'STAX ', 36 /* LDX */, 002H, 0, 01912 'STC ', 43 /* ZOP */, 037H, 0, 01913 'SUB ', 37 /* REG */, 090H, 0, 01914 'SUI ', 38 /* IMM */, 0D6H, 0, 01915 'TITLE', 31 /* POP */, 000H, 0, 01916 'XCHG ', 43 /* ZOP */, 0EBH, 0, 01917 'XOR ', 14 /* OPR */, 000H, 0, 01918 'XRA ', 37 /* REG */, 0A8H, 0, 01919 'XRI ', 38 /* IMM */, 0EEH, 0, 01920 'XTHL ', 43 /* ZOP */, 0E3H, 0 ); 01921 01922 DECLARE GLOBAL$IDENTIFIERS ADDRESS INITIAL (0); 01923 01924 /* THIS WILL BE SET NON-ZERO WHEN THE FIRST SYMBOL IS ENTERED, 01925 INVALIDATING THE START-UP MESSAGE CONTAINED IN USYM */ 01926 01927 DECLARE USYM (72H) BYTE INITIAL (CR,CR,LF,LF, 01928 ' 8080 MACRO ASSEMBLER,VERSION 2.0',CR,LF,LF,0); 01929 /*USYM VECTOR SIZE IS ADJUSTED TO ALIGN VARIABLES 01930 THE MESSAGE WILL ONLY BE WRITTEN ON START-UP.THE 01931 SPACE IS THEN USED FOR THE USER SYMBOLS.*/ 01932 01933 /* -------------------------------------------------- */ 01934 01935 01936 /* PROGRAM START */ 01937 I=0; 01938 IF GLOBAL$IDENTIFIERS=0 THEN 01939 DO WHILE (J:=USYM (I:=I+1))<>0; 01940 CALL PRINT (J); 01941 END; 01942 01943 DO WHILE TRUE; 01944 CALL PRINT (CR); 01945 CALL PRINT (LF); 01946 CALL PRINT (LF); 01947 CALL PRINT ('P'); 01948 CALL PRINT ('='); 01949 CALL PRINT (PASS:=KEYBOARD); 01950 IF (PASS:=PASS-'0')<>0 AND PASS <5 THEN 01951 DO; 01952 MACDEF,ASMSUP=FALSE; 01953 PRINTN,PRINTV=0; 01954 SYMTOP=(SYMBOT:=(LINKP:=.SYMBOL$TABLE)+2)+SYMFIX-2; 01955 IF PASS=1 THEN 01956 DO; 01957 FREMEM=MEMTOP; 01958 SYMAX=SYMTOP; 01959 END; 01960 CALL PRINT (CR); 01961 CALL PRINT (LF); 01962 CALL PRINT (LF); 01963 01964 CALL ASSEMBLE; 01965 01966 END; 01967 END; 01968 EOF ***F ***F