🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: alt.folklore.computers
Article #1740

Another mad programmer strikes...

#1740
From: p... Per Lindberg
Date: Fri, 09 Mar 1990 23:17
84 lines
3663 bytes
(No, *I* didn't write this!!)

001001 IDENTIFICATION DIVISION.
001002 PROGRAM-ID. ACK.
001003 AUTHOR. A.NONYM.
002001 ENVIRONMENT DIVISION.
003001 DATA DIVISION.
003010 WORKING-STORAGE SECTION.
003012 01  N PICTURE IS 9(12) USAGE IS COMPUTATIONAL.
003013 01  M PICTURE IS 9(12) USAGE IS COMPUTATIONAL.
003014 01  R PICTURE IS 9(12) USAGE IS COMPUTATIONAL.
003101 01  STACK  PICTURE IS 9(12) USAGE IS COMPUTATIONAL
003102     OCCURS 32766 TIMES.
003119 01  ELEMENT PICTURE IS 9(12) USAGE IS COMPUTATIONAL.
003200 01  STACK-POINTER PICTURE IS 9999 USAGE IS COMPUTATIONAL.
003900 77  AREA-SIZE PICTURE IS 9(5) VALUE IS 32766.
003999 PROCEDURE DIVISION.
004000 BEGIN.
004002     DISPLAY 'PROGRAM ACKERMANN'.
004003     DISPLAY 'ENTER M,N PLEASE'.
004004     ACCEPT M N.
004005     MOVE ZEROES TO STACK-POINTER.
004006     MOVE 1 TO ELEMENT PERFORM PUSH GO TO ACKERMANN.
004020 HELL.
004021     DISPLAY 'EXECUTION TERMINATED.'
004022     STOP RUN.
004100 PUSH.
004101     ADD 1 TO STACK-POINTER
004102     IF STACK-POINTER IS GREATER THAN AREA-SIZE
004103        DISPLAY '** STACK OVERFLOW ***'
004104        GO TO HELL.
004110     MOVE ELEMENT TO STACK ( STACK-POINTER ).
004200 POP.
004201     IF STACK-POINTER IS LESS THAN 1
004202        DISPLAY '** STACK UNDERFLOW **'
004203        GO TO HELL.
004204     MOVE STACK ( STACK-POINTER ) TO ELEMENT.
004205     SUBTRACT 1 FROM STACK-POINTER.
004300 ACKERMANN.
004301     IF M IS EQUAL TO ZERO ADD N 1 GIVING R
004302     ELSE MOVE 2 TO ELEMENT PERFORM PUSH GO TO ACKERMANN-2.
004303 ACKER-RETUR-2.
004304     PERFORM POP GO TO JUMP-TABLE.
004309 ACKERMANN-2.
004310     IF N IS NOT EQUAL TO ZERO MOVE 4 TO ELEMENT PERFORM PUSH
004311        GO TO ACKERMANN-3.
004312     MOVE M TO ELEMENT PERFORM PUSH MOVE N TO ELEMENT PERFORM PUSH
004313     SUBTRACT 1 FROM M MOVE 1 TO N
004314     MOVE 3 TO ELEMENT PERFORM PUSH GO TO ACKERMANN.
004315 ACKER-RETUR-3.
004316     PERFORM POP MOVE ELEMENT TO N
004317     PERFORM POP MOVE ELEMENT TO M
004320 ACKER-RETUR-4.
004331     PERFORM POP GO TO JUMP-TABLE.
004350 ACKERMANN-3.
004351     MOVE N TO ELEMENT PERFORM PUSH
004352     SUBTRACT 1 FROM N
004353     MOVE 5 TO ELEMENT PERFORM PUSH GO TO ACKERMANN.
004354 ACKER-RETUR-5.
004354     MOVE R TO N
004355     MOVE M TO ELEMENT PERFORM PUSH
004356     SUBTRACT 1 FROM M
004357     MOVE 6 TO ELEMENT PERFORM PUSH GO TO ACKERMANN.
004360 ACKER-RETUR-6.
004361     PERFORM POP MOVE ELEMENT TO M
004362     PERFORM POP MOVE ELEMENT TO N
004364     PERFORM POP GO TO JUMP-TABLE.
004400 JUMP-TABLE.
004401     IF ELEMENT=1 GO TO HUVUD-RETUR.
004402     IF ELEMENT=2 GO TO ACKER-RETUR-2.
004403     IF ELEMENT=3 GO TO ACKER-RETUR-3.
004404     IF ELEMENT=4 GO TO ACKER-RETUR-4.
004405     IF ELEMENT=5 GO TO ACKER-RETUR-5.
004406     IF ELEMENT=6 GO TO ACKER-RETUR-6.
004498     DISPLAY '** INVALID RETURN ADDRESS ** ADDRESS=' ELEMENT
004499     GO TO HELL.
004900 HUVUD-RETUR.
004901     DISPLAY 'RESULT = ' R.
004999     STOP RUN.
-- 
Per Lindberg (The Mad Programmer)  !      __!__
Front Capital Systems              !  _____(_)_____  Ceci n'est pas une Piper
Linneg 5, 11447 Stockholm, Sweden  !     !  !  !
Technical Details
Message-ID: <1038@front.se>
Path: mbox-mo1.pugleaf.net!gmdzi!unido!mcsun!sunic!front.se!per

Show Full Headers
Complete Article Headers
Path: mbox-mo1.pugleaf.net!gmdzi!unido!mcsun!sunic!front.se!per
From: p...@front.se (Per Lindberg)
Newsgroups: alt.folklore.computers
Subject: Another mad programmer strikes...
Keywords: foo!
Message-ID: <1038@front.se>
Date: 9 Mar 90 23:17:21 GMT
Organization: Front Capital Systems, Stockholm, Sweden
Lines: 84
Posted: Sat Mar 10 00:17:21 1990
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 7bit