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