///////////////////////////////////////////////////////////////////// // // Sample Program // INTRODUCTION TO PROGRAMMING 1968 p. 5-17 // // The previously described routines for typing text and numeric trans- // lation are combined in the following program example which is similar // to the final program of Chapter 3. This program performs the same // numeric sort; however, the numbers to be placed in order are supplied // from the keyboard. // // Any number of elements may be supplied; the end of input is sig- // naled by typing a dollar sign ($). The program includes routines to // exclude any nonoctal digits from input and type a question mark. Only // positive octal numbers (0-3777) are allowed as input to the program. // // Changes: // // 1) Corrected bug - initial TLS should not be done in the START loop. // Output after printing ordered group results now has two CR LF's. // // This may have been Ok with the original Teletype interface, but // with SIMH, a TLS sending a NULL character immediately after sending // a LF, and not waiting for output to be completed, overwrites the LF // in the output. This may be a bug in SIMH or pidp8i. // // 2a) When running uder OS/8, input from the pseudo Teletype keyboard does // not have bit 8 set, unlike a real Teletype. // Therefore constants for comparison K260 etc have been conitionally // coded as octal 60 etc with IFNDEF DUBL, which is not defined in PAL8 // // 2b) When running under bare metal and assembling with 'palbart' input does // have bit 8 set. Assemble octal 260 with IFDEF DUBL, defined in palbart. // ///////////////////////////////////////////////////////////////////// ///////////////////////////////////////////////////////////////////// // INITIALISATION AND INPUT CODING ///////////////////////////////////////////////////////////////////// *200 INIT, TLS / TLS TO SET PRINTER FLAG START, CLA CLL / no TLS in loop - kills last LF TAD BUFF / SET UP STORAGE AREA DCA BUFFPT DCA AMOUNT / SET AMOUNT TO 0 / ACCEPT ONE DIGIT ACCEPT, JMS CRLF / RETURN CARRIAGE TAD M4 / SET UP COUNTER DCA DIGCTR / FOR 4 DIGITS TAD TEMP1 / SET A POINTER TO DCA TEMP / TO TEMPORARY INPUT STORAGE NEWDIG, JMS LISN / GET A CHARACTER DCA I TEMP / STORE IT / CHECK THE CHARACTER CHECK, TAD I TEMP TAD MDOLAR / IS CHARACTER A $ ? SNA CLA JMP ORDER / YES: ORDER THE INPUT TAD I TEMP / NO: CHECK FOR OCTAL INPUT TAD M260 / IS ASCII LESS THAN 260 ? SPA JMP ERROR / YES: ERROR TAD M10 / NO: SUBTRACT 10 SMA CLA JMP ERROR / ASCII is GREATER THAN 267 ISZ TEMP ISZ DIGCTR / 4 DIGITS YET ? JMP NEWDIG / NO: GET ANOTHER / YES: PACK THE 4 DIGITS INTO ONE NUMBER PACK, TAD TEMP1 / SET POINTER TO STORAGE LOC DCA TEMP DCA HOLD / CLEAR LOCATION HOLD TAD M4 / SET COUNTER FOR 4 DIGITS DCA DIGCTR DIGPCK, TAD HOLD / CONTENTS OF HOLD INTO AC CLL RAL / ROTATE INTO CLEARED LINK RTL / ROTATE TWICE MORE TAD I TEMP / ADD ONE ASCII CHARACTER TAD M260 / SUBTRACT OUT THE 260 DCA HOLD / STORE AC IN HOLD ISZ TEMP / INCREMENT STORAGE POINTER ISZ DIGCTR / PACKED 4 DIGITS YET ? JMP DIGPCK / NO: PACK ANOTHER TAD HOLD / YES: STORE PACKED NUMBER DCA I BUFFPT TAD I BUFFPT / NEGATIVE INPUT ? TAD K4000 SMA CLA JMP ERROR / YES: REJECT ENTRY ISZ AMOUNT / NO: COUNT THE ENTRIES ISZ BUFFPT / SET UP FOR A NEW ENTRY JMP ACCEPT / GET A NEW ENTRY ///////////////////////////////////////////////////////////////////// // PUT THE NUMBERS IN INCREASING ORDER ///////////////////////////////////////////////////////////////////// ORDER, TAD AMOUNT / SET UP A TALLY CIA / TO COUNT THE IAC / NUMBER OF DCA TALLY / COMPARISONS DCA FLAG / CLEAR THE FLAG TAD BUFF / SET THE POINTERS DCA X1 / (X1 and X2) TO THE TAD BUFF / PROPER DATA LOCATIONS IAC / X2=X1+1 DCA X2 TEST, TAD I X2 / COMPARE X1 AND X2 CIA TAD I X1 SMA SZA CLA / REVERSE ENTRIES IF JMS REVERSE / X2 IS LESS THAN X1 ISZ X1 / INCREMENT THE POINTERS ISZ X2 ISZ TALLY / DONE COMPARING YET ? JMP TEST / NO: COMPARE MORE ENTRIES TAD FLAG / YES: IS FLAG SET ? SZA CLA JMP ORDER / YES: MAKE ANOTHER PASS / NO: TYPE THE ORDERED DATA ///////////////////////////////////////////////////////////////////// // PRINT OUT THE ORDERED NUMBERS ///////////////////////////////////////////////////////////////////// JMS CRLF / RETURN THE CARRIAGE TAD BUFF / SET THE BUFFER POINTER DCA BUFFPT TAD AMOUNT / SET LIMIT FOR OUTPUT CIA DCA PRNTCT ANOTHR, JMS CRLF / RETURN CARRIAGE TAD M4 / COUNT THE DIGITS OUTPUT DCA DIGCTR DCA HOLD / CLEAR HOLD LOCATION TAD I BUFFPT / GET A CHARACTER CLL RAL / ROTATE INTO CLEARED LINK MORE, TAD HOLD / ADD HOLD TO AC RAL / ROTATE THREE TIMES LEFT RTL DCA HOLD / STORE AC IN HOLD TAD HOLD AND MASK7 / MASK OUT FIRST 9 BITS TAD K260 JMS TYPE / TYPE OUT ONE DIGIT ISZ DIGCTR / TYPED OUT 4 DIGITS ? JMP MORE / NO: TYPE ANOTHER DIGIT ISZ BUFFPT / YES: INCREMENT BUFFER LOC ISZ PRNTCT / TYPED ALL ENTRIES ? JMP ANOTHR / NO: TYPE ANOTHER ENTRY JMS CRLF / YES: RETURN CARRIAGE AND JMP START / ACCEPT MORE NUMBERS TO SORT ///////////////////////////////////////////////////////////////////// // SUBROUTINEs ///////////////////////////////////////////////////////////////////// ERROR, CLA / TYPE '?' TAD QUEST JMS TYPE JMP ACCEPT / DISREGARDS ILLEGAL ENTRY REVERSE,0 / SWITCH X'S TAD I X1 DCA HOLD TAD I X2 DCA I X1 TAD HOLD DCA I X2 CLA CLL CMA / SET FLAG WHENEVER DCA FLAG / A SWITCH IS MADE JMP I REVERSE END=. ///////////////////////////////////////////////////////////////////// // PAGE 0 SUBROUTINES ///////////////////////////////////////////////////////////////////// *100 TYPE, 0 / TYPE OUTPUT SUBROUTINE TSF / TEST TELETYPE DONE FLAG JMP .-1 / BUSY WAIT TLS / PRINT CHARACTER IN AC CLA JMP I TYPE CRLF, 0 / TYPE CR AND LF TAD K215 JMS TYPE TAD K212 JMS TYPE JMP I CRLF LISN, 0 / LISN INPUT SUBROUTINE KSF / TEST INPUT DONE FLAG JMP .-1 / BUSY WAIT KRB / GET CHARACTER TLS / ECHO CHARACTER (no wait !?) JMP I LISN ///////////////////////////////////////////////////////////////////// // CONSTANTS CODING ///////////////////////////////////////////////////////////////////// BUFF, END / (no test for overflow !?) BUFFPT, 0 M4, 7774 DIGCTR, 0 TEMP1, TEMBUF / INITIAL POINTER TO TEMP BUFFER TEMP, 0 / POINTER TO TEMP BUFFER TEMBUF, 0 / TEMP BUFFER 0 0 0 / ROOM FOR 4 DIGITS M10, -10 K4000, 4000 HOLD, 0 AMOUNT, 0 FLAG, 0 TALLY, 0 X1, 0 X2, 0 PRNTCT, 0 MASK7, 7 IFDEF DUBL < / defined for palbart assembler K260, 260 / '0' K212, 212 / LF K215, 215 / CR QUEST, 277 MDOLAR, -244 M260, -260 > IFNDEF DUBL < / NOT defined for PAL8 assembler K260, 60 / '0' K212, 12 / LF K215, 15 / CR QUEST, 77 MDOLAR, -44 M260, -60 > $